Tcl Source Code

Changes On Branch core-8-5-branch
Login

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

Changes In Branch core-8-5-branch Excluding Merge-Ins

This is equivalent to a diff from e784d77fd7 to f472941c43

2024-04-26
13:47
(backported from tclSE) avoid multi-threaded vulnerability of system encoding (see tcl bug [f2ff05fc... check-in: a1c84c8069 user: sebres tags: sebres-encoding-perf-branch
2024-04-12
22:58
merge 8.5 (minor backport from my core) simple speed-up if searching for the key from hash itself (i... check-in: 3307793b00 user: sebres tags: core-8-6-branch
22:55
minor backport from my core: simple speed-up if searching for the key from hash itself (it is safe t... Leaf check-in: f472941c43 user: sebres tags: core-8-5-branch
21:13
amend to [295b0570ff660950]: the bug was fixed incompletely, this is full bug fix now - don't allow ... check-in: 969a185ea4 user: sebres tags: core-8-5-branch
2020-10-30
14:09
Rename "trunk" to "main", but with new propagating tag "trunk" check-in: 40014cd0fa user: jan.nijtmans tags: trunk, main
2020-10-29
21:09
merge trunk check-in: b5e7f9da2b user: dgp tags: dgp-refactor
21:09
merge trunk check-in: 9ef0a76b94 user: dgp tags: dgp-properbytearray
21:08
merge trunk check-in: af4787a970 user: dgp tags: novem
11:40
Merge 8.7 Closed-Leaf check-in: e784d77fd7 user: jan.nijtmans tags: trunk
11:18
Merge 8.6 check-in: 642317cdbc user: jan.nijtmans tags: core-8-branch
2020-10-27
21:36
merge 8.7 check-in: de3076b8ab user: dgp tags: trunk

Changes to .fossil-settings/crlf-glob.

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

10
11
12
13
14
15
16
17
18










-









-
compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
compat/zlib/contrib/vstudio/readme.txt
compat/zlib/contrib/vstudio/*/zlib.rc
compat/zlib/contrib/vstudio/*/*.sln
compat/zlib/win32/*.txt
compat/zlib/win64/*.txt
libtommath/*.dsp
libtommath/*.sln
libtommath/*.vcproj
tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.vc
win/rules.vc
win/rules-ext.vc
win/targets.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in

Changes to .fossil-settings/encoding-glob.

1
2
3
4

5
6
7
8
9
1
2
3
4
5
6
7
8
9
10




+





tools/tcl.hpj.in
tools/tcl.wse.in
win/buildall.vc.bat
win/coffbase.txt
win/makefile.bc
win/makefile.vc
win/rules.vc
win/tcl.dsp
win/tcl.dsw
win/tcl.hpj.in

Changes to .fossil-settings/ignore-glob.

20
21
22
23
24
25
26
27


28
29
30
31
32
33
34
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
35







-
+
+







*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
*/version.vc
*/libtcl.vfs
*/libtcl_*.zip
*/libtcl*.zip
*/tclUuid.h
html
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
libtommath/tommath.src
libtommath/*.log
libtommath/*.pdf

Deleted .github/ISSUE_TEMPLATE.md.

1
2
3



-
-
-
Important Note
==========
Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.

Deleted .github/PULL_REQUEST_TEMPLATE.md.

1
2
3



-
-
-
Important Note
==========
Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.

Changes to .gitignore.

22
23
24
25
26
27
28
29

30
31
32
33


34
35
36
37
38
39
40
22
23
24
25
26
27
28

29
30
31
32

33
34
35
36
37
38
39
40
41







-
+



-
+
+







config.status
config.status.lineno
html
manifest.uuid
_FOSSIL_
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/tcltest
*/versions.vc
*/version.vc
*/libtcl.vfs
*/libtcl_*.zip
*/libtcl*.zip
*/tclUuid.h
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
libtommath/tommath.src
libtommath/*.log
libtommath/*.pdf
libtommath/*.pl

Changes to .project.

1
2
3

4
5
6
7
8
9
10
1
2

3
4
5
6
7
8
9
10


-
+







<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
	<name>tcl9</name>
	<name>tcl8.5</name>
	<comment></comment>
	<projects>
	</projects>
	<buildSpec>
	</buildSpec>
	<natures>
	</natures>

Deleted .travis.yml.

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
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






















































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
language: c
addons:
  apt:
    sources:
      - ubuntu-toolchain-r-test
    packages:
      - binutils-mingw-w64-i686
      - binutils-mingw-w64-x86-64
      - gcc-mingw-w64
      - gcc-mingw-w64-base
      - gcc-mingw-w64-i686
      - gcc-mingw-w64-x86-64
      - gcc-multilib
jobs:
  include:
# Testing on Linux GCC
    - name: "Linux/GCC/Shared"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC/Shared: UTF_MAX=3"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
    - name: "Linux/GCC/Shared: NO_DEPRECATED"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
    - name: "Linux/GCC/Static"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - CFGOPT="--disable-shared"
        - BUILD_DIR=unix
    - name: "Linux/GCC/Debug"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols"
    - name: "Linux/GCC/Mem-Debug"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols=mem"
# C++ build.
    - name: "Linux/G++/Shared"
      os: linux
      dist: focal
      compiler: g++
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=g++ CFLAGS=-Dregister=dont+use+register"
# Newer/Older versions of GCC
    - name: "Linux/GCC 10/Shared"
      os: linux
      dist: focal
      compiler: gcc-10
      addons:
        apt:
          packages:
            - g++-10
      env:
        - BUILD_DIR=unix
    - name: "Linux/GCC 5/Shared"
      os: linux
      dist: bionic
      compiler: gcc-5
      addons:
        apt:
          packages:
            - g++-5
      env:
        - BUILD_DIR=unix
# Testing on Linux Clang
    - name: "Linux/Clang/Shared"
      os: linux
      dist: focal
      compiler: clang
      env:
        - BUILD_DIR=unix
    - name: "Linux/Clang/Static"
      os: linux
      dist: focal
      compiler: clang
      env:
        - CFGOPT="--disable-shared"
        - BUILD_DIR=unix
    - name: "Linux/Clang/Debug"
      os: linux
      dist: focal
      compiler: clang
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols"
    - name: "Linux/Clang/Mem-Debug"
      os: linux
      dist: focal
      compiler: clang
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-symbols=mem"
# Testing on Mac, various styles
    - name: "macOS/Clang/Xcode 12/Shared"
      os: osx
      osx_image: xcode12.2
      env:
        - BUILD_DIR=macosx
      install: []
      script: &mactest
        - make all
        # The styles=develop avoids some weird problems on OSX
        - make test styles=develop
    - name: "macOS/Clang/Xcode 12/Shared/Unix-like"
      os: osx
      osx_image: xcode12.2
      env:
        - BUILD_DIR=unix
        - CFGOPT="--enable-dtrace"
    - name: "macOS/Clang/Xcode 12/Shared/libtommath"
      os: osx
      osx_image: xcode12.2
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
      addons:
        homebrew:
          packages:
            - libtommath
    - name: "macOS/Clang++/Xcode 12/Shared"
      os: osx
      osx_image: xcode12.2
      env:
        - BUILD_DIR=unix
        - CFGOPT="CC=clang++ --enable-framework --enable-dtrace CFLAGS=-Dregister=dont+use+register CPPFLAGS=-D__private_extern__=extern"
      script:
        - make all tcltest
# Newer MacOS versions
    - name: "macOS/Clang/Xcode 12/Universal Apps/Shared"
      os: osx
      osx_image: xcode12u
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
# Older MacOS versions
    - name: "macOS/Clang/Xcode 11/Shared"
      os: osx
      osx_image: xcode11.7
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
    - name: "macOS/Clang/Xcode 10/Shared"
      os: osx
      osx_image: xcode10.3
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
    - name: "macOS/Clang/Xcode 9/Shared"
      os: osx
      osx_image: xcode9.4
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
    - name: "macOS/Clang/Xcode 8/Shared"
      os: osx
      osx_image: xcode8.3
      env:
        - BUILD_DIR=macosx
      install: []
      script: *mactest
# Test with mingw-w64 cross-compile
# Doesn't run tests because wine is only an imperfect Windows emulation
    - name: "Linux-cross-Windows/GCC/Shared/no test"
      os: linux
      dist: focal
      compiler: x86_64-w64-mingw32-gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
      script: &crosstest
        - make all tcltest
        # Include a high visibility marker that tests are skipped outright
        - >
          echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`"
# Test with mingw-w64 (32 bit) cross-compile
# Doesn't run tests because wine is only an imperfect Windows emulation
    - name: "Linux-cross-Windows-32/GCC/Shared/no test"
      os: linux
      dist: focal
      compiler: i686-w64-mingw32-gcc
      env:
        - BUILD_DIR=win
        - CFGOPT=--host=i686-w64-mingw32
      script: *crosstest
# Test on Windows with MSVC native
    - name: "Windows/MSVC/Shared"
      os: windows
      compiler: cl
      env: &vcenv
        - BUILD_DIR=win
        - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build"
      before_install: &vcpreinst
        - rm -rf tests/safe-stock8*.test
        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - PATH="$PATH:$VCDIR"
        - cd ${BUILD_DIR}
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test
    - name: "Windows/MSVC/Shared: NO_DEPRECATED"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test
    - name: "Windows/MSVC/Static"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
    - name: "Windows/MSVC/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test
    - name: "Windows/MSVC/Mem-Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test
# Test on Windows with MSVC native (32-bit)
    - name: "Windows/MSVC-x86/Shared"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=nodep' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Static"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static,msvcrt' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test
    - name: "Windows/MSVC-x86/Mem-Debug"
      os: windows
      compiler: cl
      env: *vcenv
      before_install: *vcpreinst
      install: []
      script:
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest
        - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test
# Test on Windows with GCC native
    - name: "Windows/GCC/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit"
      before_install: &makepreinst
        - rm -rf tests/safe-stock8*.test
        - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
        - choco install -y make zip
        - cd ${BUILD_DIR}
    - name: "Windows/GCC/Shared: UTF_MAX=3"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
      before_install: *makepreinst
    - name: "Windows/GCC/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst
    - name: "Windows/G++/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++ --enable-64bit"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit --disable-shared"
      before_install: *makepreinst
    - name: "Windows/GCC/Debug"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit --enable-symbols"
      before_install: *makepreinst
    - name: "Windows/GCC/Mem-Debug"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-64bit --enable-symbols=mem"
      before_install: *makepreinst
# Test on Windows with GCC native (32-bit)
    - name: "Windows/GCC-x86/Shared"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
      before_install: *makepreinst
    - name: "Windows/GCC-x86/Shared: UTF_MAX=3"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
      before_install: *makepreinst
    - name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
      before_install: *makepreinst
    - name: "Windows/G++-x86/Shared"
      os: windows
      compiler: g++
      env:
        - BUILD_DIR=win
        - CFGOPT="CC=g++"
      before_install: *makepreinst
      script:
        - make all tcltest
    - name: "Windows/GCC-x86/Static"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--disable-shared"
      before_install: *makepreinst
    - name: "Windows/GCC-x86/Debug"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-symbols"
      before_install: *makepreinst
    - name: "Windows/GCC-x86/Mem-Debug"
      os: windows
      compiler: gcc
      env:
        - BUILD_DIR=win
        - CFGOPT="--enable-symbols=mem"
      before_install: *makepreinst
# "make dist" only
    - name: "Linux: make dist"
      os: linux
      dist: focal
      compiler: gcc
      env:
        - BUILD_DIR=unix
      script:
        - make dist
before_install:
  - rm -rf tests/safe-stock8*.test
  - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
  - cd ${BUILD_DIR}
install:
  - mkdir "$HOME/install dir"
  - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
before_script:
  - export ERROR_ON_FAILURES=1
script:
  - make all tcltest || echo "Something wrong, maybe a hickup, let's try again"
  - make test
  - make install

Changes to ChangeLog.

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
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









-
+

-
-
-
+

+

-

+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
+
+
+







A NOTE ON THE CHANGELOG:
Starting in early 2011, Tcl source code has been under the management of
fossil, hosted at https://core.tcl-lang.org/tcl/ .  Fossil presents a "Timeline"
view of changes made that is superior in every way to a hand edited log file.
Because of this, many Tcl developers are now out of the habit of maintaining
this log file.  You may still find useful things in it, but the Timeline is
a better first place to look now.
============================================================================

2013-09-19  Don Porter  <dgp@users.sourceforge.net>
2013-08-30  Don Porter  <dgp@users.sourceforge.net>

	*** 8.6.1 TAGGED FOR RELEASE ***

	* generic/tcl.h:	Bump version number to 8.6.1.
	* generic/tcl.h:	Bump to 8.5.15 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* win/configure.in:
	* README:

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

2013-09-19  Donal Fellows  <dkf@users.sf.net>

	* doc/next.n (METHOD SEARCH ORDER): Bug [3606943]: Corrected
	description of method search order.

2013-09-18  Donal Fellows  <dkf@users.sf.net>

	Bump TclOO version to 1.0.1 for release.

2013-09-17  Donal Fellows  <dkf@users.sf.net>

	* generic/tclBinary.c (BinaryEncodeUu, BinaryDecodeUu): [Bug 2152292]:
	Corrected implementation of the core of uuencode handling so that the
	line length processing is correctly applied.
	***POTENTIAL INCOMPATIBILITY***
	Existing code that was using the old versions and working around the
	limitations will now need to do far less. The -maxlen option now has
	strict limits on the range of supported lengths; this is a limitation
	of the format itself.

2013-09-09  Donal Fellows  <dkf@users.sf.net>

	* generic/tclOOMethod.c (CloneProcedureMethod): [Bug 3609693]: Strip
	the internal representation of method bodies during cloning in order
	to ensure that any bound references to instance variables are removed.

2013-09-01  Donal Fellows  <dkf@users.sf.net>

	* generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that
	whitespace at the end of a string don't cause the decoder to drop the
	last decoded byte.

2013-08-03  Donal Fellows  <dkf@users.sf.net>

	* library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found
	by the autoloading mechanism.

2013-08-02  Donal Fellows  <dkf@users.sf.net>

	* generic/tclOODefineCmds.c (ClassSuperSet): Bug [9d61624b3d]: Stop
	crashes when emptying the superclass slot, even when doing elaborate
	things with metaclasses.

2013-08-01  Harald Oehlmann  <oehhar@users.sf.net>

	* tclUnixNotify.c (Tcl_InitNotifier): Bug [a0bc856dcd]: Start notifier
	thread again if we were forked, to solve Rivet bug 55153.
	* tclUnixNotify.c Tcl_InitNotifier: Bug [a0bc856dcd]
	  Start notifier thread again if we were forked, to solve Rivet bug
	  55153.

2013-07-05  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Asuncion:
	* library/tzdata/Antarctica/Macquarie:
	* library/tzdata/Asia/Gaza:
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
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







-
-
+
+



-
+
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-
-
-
-
-
-
-
+


-
-
+
+


-
-
-
-
-






-
-
-
-
-
-
-
-
-
-





-
-
-
-
-


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





-
-
-
-
+
+
+
+




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





-
-
+
+
-
-




-
-
+
+








-
-
-
-
+
+
+
+




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







2013-07-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4:  Bug [32afa6e256]: dirent64 check is incorrect in tcl.m4
	* unix/configure: (thanks to Brian Griffin)

2013-06-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs
	* generic/tclMain.c:   initialized encodings.
	* generic/tclConfig.c: Bug [9b2e636361]: Tcl_CreateInterp() needs initialized
	* generic/tclMain.c:   encodings.

2013-06-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread
	* generic/tclEvent.c: Bug [3611974]: InitSubsystems multiple thread issue.
	issue.

2013-06-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/regc_locale.c: Bug [a876646efe]: re_expr character class
	[:cntrl:] should contain \u0000 - \u001f

2013-06-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmdsSZ.c (TclCompileTryCmd): [Bug 779d38b996]:
	Rewrote the [try] compiler to generate better code in some cases and
	to behave correctly in others; when an error happens during the
	processing of an exception-trap clause or a finally clause, the
	*original* return options are now captured in a -during option, even
	when fully compiled.

2013-06-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (INST_EXPAND_DROP): [Bugs 2835313, 3614226]:
	New opcode to allow resetting the stack to get rid of an expansion,
	restoring the stack to a known state in the process.
	* generic/tclCompile.c, generic/tclCompCmds.c: Adjusted the compilers
	for [break] and [continue] to get stack cleanup right in the majority
	of cases.
	* tests/for.test (for-7.*): Set of tests for these evil cases.

2013-06-04  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4: Eliminate NO_VIZ macro as current zlib uses HAVE_HIDDEN
	instead. One more last-moment fix for FreeBSD by Pietro Cerutti

2013-06-03  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c: fix for perf bug detected by Kieran
	(https://groups.google.com/forum/?fromgroups#!topic/comp.lang.tcl/vfpI3bc-DkQ),
	diagnosed by dgp to be a close relative of [Bug 781585], which was
	fixed by commit	[f46fb50cb3]. This bug was introduced by myself in
	commit [cbfe055d8c].

2013-06-03  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileBreakCmd, TclCompileContinueCmd):
	Added code to allow [break] and [continue] to be issued as a jump (in
	the most common cases) rather than using the more expensive exception
	processing path in the bytecode engine. [Bug 3614226]: Partial fix for
	the issues relating to cleaning up the stack when dealing with [break]
	and [continue].

2013-05-27 Harald Oehlmann  <oehhar@users.sf.net>
2013-05-28 Harald Oehlmann  <oehhar@users.sf.net>

	* library/msgcat/msgcat.tcl: [Bug 3036566]: Also get locale from
	registry key HCU\Control Panel\Desktop : PreferredUILanguages to honor
	installed language packs on Vista+.
	registry key HCU\Control Panel\Desktop : PreferredUILanguages to
	honor installed language packs on Vista+.
	Bumped msgcat version to 1.5.2

2013-05-22  Andreas Kupries  <andreask@activestate.com>

	* tclCompile.c: Removed duplicate const qualifier causing the HP
	native cc to error out.

2013-05-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclUtf.c (TclUtfCasecmp): [Bug 3613609]: Replace problematic
	uses of strcasecmp with a proper UTF-8-aware version. Affects both
	[lsearch -nocase] and [lsort -nocase].

2013-05-22  Donal K. Fellows  <dkf@users.sf.net>

	* doc/file.n: [Bug 3613671]: Added note to portability section on the
	fact that [file owned] does not produce useful results on Windows.

2013-05-20  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixFCmd.c (DefaultTempDir): [Bug 3613567]: Corrected logic
	for checking return code of access() system call, which was inverted.

2013-05-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4:     Fix for FreeBSD, and remove support for older
	* unix/configure:  FreeBSD versions. Patch by Pietro Cerutti.

2013-05-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmdsGR.c: Split tclCompCmds.c again to keep size of
	code down.

2013-05-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBasic.c: Add panic in order to detect incompatible
	mingw32 sys/stat.h and sys/time.h headers.
	* generic/tclBasic.c: Add panic in order to detect
	incompatible mingw32 sys/stat.h and sys/time.h headers,

2013-05-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/zlib/*: Upgrade to zlib 1.2.8

2013-05-10  Donal K. Fellows  <dkf@users.sf.net>

	Optimizations and general bytecode generation improvements.
	* generic/tclCompCmds.c (TclCompileAppendCmd, TclCompileLappendCmd):
	(TclCompileReturnCmd): Make these generate bytecode in more cases.
	(TclCompileListCmd): Make this able to push a literal when it can.
	* generic/tclCompile.c (TclSetByteCodeFromAny, PeepholeOptimize):
	Added checks to see if we can apply some simple cross-command-boundary
	optimizations, and defined a small number of such optimizations.
	(TclCompileScript): Added the special ability to compile the list
	command with expansion ([list {*}blah]) into bytecode that does not
	call an external command.

2013-05-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclStubInit.c: Add support for Cygwin64, which has a 64-bit
	* generic/tclDecls.h: "long" type. Binary compatibility with win64
	requires that all stub entries use 32-bit long's, therefore the need
	for various wrapper functions/macros. For Tcl 9 a better solution is
	needed, but that cannot be done without introducing binary
	incompatibility.
	requires that all stub entries use 32-bit long's, therefore the
	need for various wrapper functions/macros. For Tcl 9 a better
	solution is needed, but that cannot be done without introducing
	binary incompatibility.

2013-04-30  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl (::platform::LibcVersion):
	* library/platform/pkgIndex.tcl: Followup to the 2013-01-30 change.
	The RE become too restrictive again. SuSe added a timestamp after the
	version. Loosened up a bit. Bumped package to version 1.0.12.

	* library/platform/pkgIndex.tcl: Followup to the 2013-01-30
	  change. The RE become too restrictive again. SuSe added a
	  timestamp after the version. Loosened up a bit. Bumped package
	  to version 1.0.12.
2013-04-29  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileArraySetCmd): Generate better code
	when the list of things to set is a literal.

2013-04-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDecls.h: Implement Tcl_NewBooleanObj, Tcl_DbNewBooleanObj
	and Tcl_SetBooleanObj as macros using Tcl_NewIntObj, Tcl_DbNewLongObj
	and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same, it
	only eliminates code duplication.
	and Tcl_SetIntObj. Starting with Tcl 8.5, this is exactly the same,
	it only eliminates code duplication.
	* generic/tclInt.h: Eliminate use of NO_WIDE_TYPE everywhere: It's
	exactly the same as TCL_WIDE_INT_IS_LONG

2013-04-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDecls.h: Implement many Tcl_*Var* functions and
	Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp their
	Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct.
	Tcl_GetIndexFromObj as (faster/stack-saving) macros around resp
	their Tcl_*Var*2 equivalent and Tcl_GetIndexFromObjStruct.

2013-04-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDecls.h: Implement Tcl_Pkg* functions as
	(faster/stack-saving) macros around Tcl_Pkg*Ex functions.

2013-04-08  Don Porter  <dgp@users.sourceforge.net>

	* generic/regc_color.c:	[Bug 3610026]: Stop crash when the number of
	* generic/regerrs.h:	"colors" in a regular expression overflows a
	* generic/regex.h:	short int.  Thanks to Heikki Linnakangas for
	* generic/regguts.h:	the report and the patch.
	* generic/regc_color.c:	[Bug 3610026] Stop crash when the number of
	* generic/regerrs.h:	"colors" in a regular expression overflows
	* generic/regex.h:	a short int.  Thanks to Heikki Linnakangas
	* generic/regguts.h:	for the report and the patch.
	* tests/regexp.test:

2013-04-04  Reinhard Max  <max@suse.de>

	* library/http/http.tcl (http::geturl): Allow URLs that don't have a
	path, but a query query, e.g. http://example.com?foo=bar
	* Bump the http package to 2.8.7.
        * library/http/http.tcl (http::geturl): Allow URLs that don't have
        a path, but a query query, e.g. http://example.com?foo=bar .
        * Bump the http package to 2.7.12.

2013-04-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixInit.c: [Bug 3205320]: stack space detection
	defeated by inlining. Now fixed in the cross-compile
	case as well.

2013-04-03  Don Porter  <dgp@users.sourceforge.net>

	*** 8.5.14 TAGGED FOR RELEASE ***

	* generic/tcl.h:	Bump to 8.5.14 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:
	* README:

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

2013-03-22  Venkat Iyer <venkat@comit.com>
	* library/tzdata/Africa/Cairo: Update to tzdata2013b.
	* library/tzdata/Africa/Casablanca:
	* library/tzdata/Africa/Gaborone:
	* library/tzdata/Africa/Tripoli:
	* library/tzdata/America/Asuncion:
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
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
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
611
612
613
614
615
616
617
618

619
620
621
622
623
624
625
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
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
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
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
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
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
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







-
-
+
+



-
+




-
-
+
+











-
-
-
-
-


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







-
-
-
-
-





-
-
-
-
-





-
-
-
-
-


-
-
-
+
+
+







-
-
-
-
-


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-
-
-
-








-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-




+









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



















-
-
-
-
-


-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
+
+

-
+

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

+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















+
+
+
+
+







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



-
-
+
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
+
+
+






-
-
-
-
-






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

-
+

-
-
-
+
+
+
+
+

-
+

-
-
+
-
-
+
-
-
-
-








-
-
+
+







	* library/tzdata/Pacific/Fiji:
	* library/tzdata/Asia/Khandyga: (new)
	* library/tzdata/Asia/Ust-Nera: (new)
	* library/tzdata/Europe/Busingen: (new)

2013-03-21  Don Porter  <dgp@users.sourceforge.net>

	* library/auto.tcl: [Bug 2102614]: Add ensemble indexing support to
	* tests/autoMkindex.test: [auto_mkindex].  Thanks Brian Griffin.
	* library/auto.tcl: [Bug 2102614] Add ensemble indexing support
	* tests/autoMkindex.test: to [auto_mkindex].  Thanks Brian Griffin.

2013-03-19  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFCmd.c: [Bug 3597000]: Consistent [file copy] result.
	* generic/tclFCmd.c: [Bug 3597000] Consistent [file copy] result.
	* tests/fileSystem.test:

2013-03-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFile.c: [Bug 3608360]: Incompatible behaviour of "file
	exists".
	* win/tclWinFile.c: [Bug 2893771]: file stat fails on locked files
	on win32.

2013-03-18  Donal K. Fellows  <dkf@users.sf.net>

	* tests/cmdAH.test (cmdAH-19.12): [Bug 3608360]: Added test to ensure
	that we never ever allow [file exists] to do globbing.

2013-03-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4: Patch by Andrew Shadura, providing better support for
	three architectures they have in Debian.

2013-03-11  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompile.c:	[Bugs 3607246,3607372]: Unbalanced refcounts
	* generic/tclLiteral.c:	of literals in the global literal table.

2013-03-06  Don Porter  <dgp@users.sourceforge.net>

	* generic/regc_nfa.c:	[Bugs 3604074,3606683]: Rewrite of the
	* generic/regcomp.c:	fixempties() routine (and supporting routines)
	to completely eliminate the infinite loop hazard. Thanks to Tom Lane
	for the much improved solution.
	* generic/regc_nfa.c:	[Bugs 3604074,3606683] Rewrite of the
	* generic/regcomp.c:	fixempties() routine (and supporting
	routines) to completely eliminate the infinite loop hazard.
	Thanks to Tom Lane for the much improved solution.

2013-02-28  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclLiteral.c:	Revise TclReleaseLiteral() to tolerate a NULL
	interp argument.

	* generic/tclCompile.c:	Update callers and revise mistaken comments.
	* generic/tclProc.c:

2013-02-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/regcomp.c:	[Bug 3606139]: missing error check allows
	* tests/regexp.test:    regexp to crash Tcl. Thanks to Tom Lane for
	providing the test-case and the patch.

2013-02-26  Donal K. Fellows  <dkf@users.sf.net>

	* tests/chanio.test (chan-io-28.7): [Bug 3605120]: Stop test from
	hanging when run standalone.

2013-02-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclObj.c: Don't panic if Tcl_ConvertToType is called for a
	type that doesn't have a setFromAnyProc, create a proper error message.

2013-02-25  Donal K. Fellows  <dkf@users.sf.net>

	* tests/binary.test (binary-41.*): [Bug 3605721]: Test independence
	fixes. Thanks to Rolf Ade for pointing out the problem.

2013-02-25  Don Porter  <dgp@users.sourceforge.net>

	* tests/assocd.test:	[Bugs 3605719,3605720]: Test independence.
	* tests/basic.test:	Thanks Rolf Ade for patches.

2013-02-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/fake-rfc2553.c: [Bug 3599194]: compat/fake-rfc2553.c is
	broken.

2013-02-22  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclAssembly.c:	Shift more burden of smart cleanup
	* generic/tclCompile.c:		onto the TclFreeCompileEnv() routine.
	Stop crashes when the hookProc raises an error.
	* generic/tclCompile.c:	Shift more burden of smart cleanup onto the
	TclFreeCompileEnv() routine.  Stop crashes when the hookProc raises
	an error.

2013-02-20  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclNamesp.c:	[Bug 3605447]: Make sure the -clear option
	* tests/namespace.test:	to [namespace export] always clears, whether
	or not new export patterns are specified.

2013-02-20  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c: [Bug 3605401]: Compiler error with latest mingw-w64
	headers.

2013-02-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTrace.c:  [Bug 2438181]: Incorrect error reporting in
	* tests/trace.test:    traces. Test-case and fix provided by Poor
	Yorick.

2013-02-15  Don Porter  <dgp@users.sourceforge.net>

	* generic/regc_nfa.c:	[Bug 3604074]: Fix regexp optimization to
	* tests/regexp.test:	stop hanging on the expression
	((((((((a)*)*)*)*)*)*)*)* .  Thanks to Bjørn Grathwohl for discovery.

2013-02-14  Harald Oehlmann  <oehhar@users.sf.net>

	* library/msgcat/msgcat.tcl: [Bug 3604576]: Catch missing registry
	entry "HCU\Control Panel\International".
	Bumped msgcat version to 1.5.1

2013-02-11  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ZlibTransformOutput): [Bug 3603553]: Ensure that
	data gets written to the underlying stream by compressing transforms
	when the amount of data to be written is one buffer's-worth; problem
	was particularly likely to occur when compressing large quantities of
	not-very-compressible data. Many thanks to Piera Poggio (vampiera) for
	reporting.

2013-02-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 3603695]: Change
	the way that the 'varname' method is implemented so that there are no
	longer problems with interactions due to the resolver. Thanks to
	Taylor Venable <tcvena@gmail.com> for identifying the problem.

2013-02-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/regc_nfa.c (duptraverse): [Bug 3603557]: Increase the
	maximum depth of recursion used when duplicating an automaton in
	response to encountering a "wild" RE that hit the previous limit.
	Allow the limit (DUPTRAVERSE_MAX_DEPTH) to be set by defining its
	value in the Makefile. Problem reported by Jonathan Mills.

2013-02-05  Don Porter  <dgp@users.sourceforge.net>

	* win/tclWinFile.c:	[Bug 3603434]: Make sure TclpObjNormalizePath()
	properly declares "a:/" to be normalized, even when no "A:" drive is
	present on the system.

2013-02-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclLoadNone.c (TclpLoadMemory): [Bug 3433012]: Added dummy
	version of this function to use in the event that a platform thinks it
	can load from memory but cannot actually do so due to it being
	disabled at configuration time.

2013-02-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileArraySetCmd): [Bug 3603163]: Stop
	crash in weird case where [eval] is used to make [array set] get
	confused about whether there is a local variable table or not. Thanks
	to Poor Yorick for identifying a reproducible crashing case.

2013-01-30  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl (::platform::LibcVersion): See
	* library/platform/pkgIndex.tcl: [Bug 3599098]: Fixed the RE
	* unix/Makefile.in: extracting the version to avoid issues with
	* win/Makefile.in: recent changes to the glibc banner. Now targeting a
	less variable part of the string. Bumped package to version 1.0.11.

2013-01-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileArraySetCmd)
	(TclCompileArrayUnsetCmd, TclCompileDictAppendCmd)
	(TclCompileDictCreateCmd, CompileDictEachCmd, TclCompileDictIncrCmd)
	(TclCompileDictLappendCmd, TclCompileDictMergeCmd)
	(TclCompileDictUnsetCmd, TclCompileDictUpdateCmd)
	(TclCompileDictWithCmd, TclCompileInfoCommandsCmd):
	* generic/tclCompCmdsSZ.c (TclCompileStringMatchCmd)
	(TclCompileStringMapCmd): Improve the code generation in cases where
	full compilation is impossible but a full ensemble invoke is provably
	not necessary.

2013-01-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixCompat.c: [Bug 3601804]: platformCPUID segmentation
	fault on Darwin.

2013-01-23  Donal K. Fellows  <dkf@users.sf.net>

	* library/http/http.tcl (http::geturl): [Bug 2911139]: Do not do vwait
	for connect to avoid reentrancy problems (except when operating
	without a -command option). Internally, this means that all sockets
	created by the http package will always be operated in asynchronous
	mode.

2013-01-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls: Put back Tcl[GS]etStartupScript(Path|FileName)
	in private stub table, so extensions using this (like Tk 8.4) will
	continue to work in all Tcl 8.x versions. Extensions using this
	still cannot be compiled against Tcl 8.6 headers.

2013-01-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPort.h: [Bug 3598300]: unix: tcl.h does not include
	sys/stat.h

2013-01-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (PushVarName): [Bug 3600328]: Added mechanism
	for suppressing compilation of variables when we couldn't cope with
	the results. Useful for some [array] subcommands.
	* generic/tclEnsemble.c (CompileToCompiledCommand): Must restore the
	compilation environment when a command compiler fails.

2013-01-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (TclZlibInit): [Bug 3601086]: Register the config
	info in the iso8859-1 encoding as that is guaranteed to be present.

2013-01-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* Makefile.in:   Allow win32 build with -DTCL_NO_DEPRECATED, just as
	* generic/tcl.h: in the UNIX build. Define Tcl_EvalObj and
	* generic/tclDecls.h: Tcl_GlobalEvalObj as macros, even when
	* generic/tclBasic.c: TCL_NO_DEPRECATED is defined, so Tk can benefit
	from it too.

2013-01-14  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tcl.m4: More flexible search for win32 tclConfig.sh, backported
	from TEA (not actually used in Tcl, only for Tk)

2013-01-14  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls: Put back Tcl_[GS]etStartupScript in internal
	stub table, so extensions using this, compiled against 8.5 headers
	still run in Tcl 8.6.

2013-01-13  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* doc/fileevent.n: [Bug 3436609]: Clarify readable fileevent "false
	positives" in the case of multibyte encodings/transforms.

2013-01-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make sure
	that TIP #139 functions all are taken from the public stub table, even
	if the inclusion is through tclInt.h.

2013-01-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls: Put back TclBackgroundException in internal
	stub table, so extensions using this, compiled against 8.5 headers
	still run in Tcl 8.6.

2013-01-09  Jan Nijtmans  <nijtmans@users.sf.net>

	* library/http/http.tcl: [Bug 3599395]: http assumes status line is a
	proper Tcl list.
	Bump http package to 2.7.11.

2013-01-08  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path
	components.	[Bug 3587096]: win vista/7: "can't find init.tcl" when
	called via junction without folder list access.

2013-01-07  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclOOStubLib.c: Restrict the stub library to only use
	* generic/tclTomMathStubLib.c: Tcl_PkgRequireEx, Tcl_ResetResult and
	Tcl_AppendResult, not any other function. This puts least restrictions
	on eventual Tcl 9 stubs re-organization, and it works on the widest
	range of Tcl versions.

	* generic/tcl.decls: Extend the public stub table with dummy NULL
2013-01-06  Jan Nijtmans  <nijtmans@users.sf.net>

	entries, up to the size of the Tcl 8.6 stub tables. This makes it
	* library/http/http.tcl: Don't depend on Spencer-specific regexp
	* tests/env.test: syntax (/u and /U) any more in unrelated places.
	* tests/exec.test:
	Bump http package to 2.8.6.

	easier to debug extensions which use Tcl 8.6 features but (erroneously)
2013-01-04  Donal K. Fellows  <dkf@users.sf.net>

	are attempted to be loaded in Tcl 8.5.
	* generic/tclEnsemble.c (CompileBasicNArgCommand): Added very simple
	compiler (which just compiles to a normal invoke of the implementation
	command) for many ensemble subcommands where we can prove that there
	is no way for scripts to detect the difference even through error
	handling or [info level]/[info frame]. This improves the code produced
	from some ensembles (e.g., [info], [string]) to the point where the
	ensemble is now not normally seen at the bytecode level at all.

2013-01-04  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclInt.h:      Insure that PURIFY builds cannot exploit the
	* generic/tclExecute.c:  Tcl stack to hide mem defects.

2013-01-03  Donal K. Fellows  <dkf@users.sf.net>

	* doc/fconfigure.n, doc/CrtChannel.3: Updated to reflect the fact that
	the minimum buffer size is one byte, not ten. Identified by Schelte
	Bron on the Tcler's Chat.

	* generic/tclExecute.c (TEBCresume:INST_INVOKE_REPLACE):
	* generic/tclEnsemble.c (TclCompileEnsemble): Added new mechanism to
	allow for more efficient dispatch of non-bytecode-compiled subcommands
	of bytecode-compiled ensembles. This can provide substantial speed
	benefits in some cases.

2013-01-02  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclEnsemble.c:  Remove stray calls to Tcl_Alloc and friends:
	* generic/tclExecute.c:   the core should only use ckalloc to allow
	* generic/tclIORTrans.c:  MEM_DEBUG to work properly.
	* generic/tclTomMathInterface.c:

2012-12-31  Donal K. Fellows  <dkf@users.sf.net>

	* doc/string.n: Noted the obsolescence of the 'bytelength',
	'wordstart' and 'wordend' subcommands, and moved them to later in the
	file.

2012-12-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release
	deleted elements too early.

2012-12-22  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclUtil.c: [Bug 3598150]: Stop leaking allocated space when
	objifying a zero-length DString. Spotted by afredd.

2012-12-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/dltest/pkgb.c:  Inline compat Tcl_GetDefaultEncodingDir.
	* unix/dltest/pkgb.c:  Make pkgb.so loadable in Tcl 8.4 as well.
	* generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport()
	and isDigit() functions, just do the same inline.

2012-12-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmdsSZ.c (TclSubstCompile): Improved the sequence of
	instructions issued for [subst] when dealing with simple variable
	references.

2012-12-14  Don Porter  <dgp@users.sourceforge.net>

	*** 8.6.0 TAGGED FOR RELEASE ***

	* changes: updates for 8.6.0

2012-12-13  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclZlib.c:	Repair same issue with misusing the
	* tests/zlib.test:	'fire and forget' nature of Tcl_ObjSetVar2
	in the new TIP 400 implementation.

2012-12-13  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCmdAH.c:	(CatchObjCmdCallback): do not decrRefCount
	* tests/cmdAH.test:	the newValuePtr sent to Tcl_ObjSetVar2:
	TOSV2 is 'fire and forget', it decrs on its own.
	Fix for [Bug 3595576], found by andrewsh.

2012-12-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it doesn't
	access its objPtr parameter twice any more.
	* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it
	doesn't access its objPtr parameter twice any more.

2012-12-11  Don Porter  <dgp@users.sourceforge.net>
2012-12-07  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/dltest/pkgb.c:  Turn pkgb.so into a Tcl9 interoperability test
        library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should
        either result in an error-message, either succeed, but never crash.

2012-11-14  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixPipe.c (DefaultTempDir): [Bug 2933003]: Allow overriding
	of the back-stop default temporary file location at compile time by
	setting the TCL_TEMPORARY_FILE_DIRECTORY #def to a string containing
	the directory name (defaults to "/tmp" as that is the most common
	default).

2012-11-13  Joe Mistachkin  <joe@mistachkin.com>

	* win/tclWinInit.c: also search for the library directory (init.tcl,
	encodings, etc) relative to the build directory associated with the
	source checkout.

2012-11-09  Don Porter  <dgp@users.sourceforge.net>

	*** 8.5.13 TAGGED FOR RELEASE ***

	* generic/tcl.h:	Bump version number to 8.6.0.
	* generic/tcl.h:	Bump to 8.5.13 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* README:

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

2012-12-10  Donal K. Fellows  <dkf@users.sf.net>

	* tools/tcltk-man2html.tcl (plus-pkgs): Increased robustness of
	version number detection code to deal with packages whose names are
	prefixes of other packages.
	* unix/Makefile.in (dist): Added pkgs/package.list.txt to distribution
	builds to ensure that 'make html' will work better.

2012-12-09  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tests/chan.test: Clean up unwanted eofchar side-effect of chan-4.6
	leading to a spurious "'" at end of chan.test under certain conditions
	(see [Bug 3389289] and [Bug 3389251]).

	* doc/expr.n: [Bug 3594188]: Clarifications about commas.

2012-12-08  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c: Fix busyloop at exit under TCL_FINALIZE_ON_EXIT
	when there are unflushed nonblocking channels.  Thanks Miguel for
	spotting.

2012-12-07  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/dltest/pkgb.c:  Turn pkgb.so into a Tcl9 interoperability test
        library: Whatever Tcl9 looks like, loading pkgb.so in Tcl 9 should
        either result in an error-message, either succeed, but never crash.

2012-11-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ZlibStreamSubcmd): [Bug 3590483]: Use a mechanism
	for complex option resolution that has fewer problems with more
	finicky compilers.

2012-11-26  Reinhard Max  <max@suse.de>

	* unix/tclUnixSock.c: Factor out creation of the -sockname and
	-peername lists from TcpGetOptionProc() to TcpHostPortList().  Make it
	robust against implementations of getnameinfo() that error out if
	reverse mapping fails instead of falling back to the numeric
	representation.

2012-11-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBinary.c (BinaryDecode64): [Bug 3033307]: Corrected
	handling of trailing whitespace when decoding base64. Thanks to Anton
	Kovalenko for reporting, and Andy Goth for the fix and tests.

2012-11-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (INST_STR_RANGE_IMM): [Bug 3588366]: Corrected
	implementation of bounds restriction for end-indexed compiled [string
	range]. Thanks to Emiliano Gavilan for diagnosis and fix.

2012-11-15  Jan Nijtmans  <nijtmans@users.sf.net>

	IMPLEMENTATION OF TIP#416

	New Options for 'load': -global and -lazy

	* generic/tcl.h:
	* generic/tclLoad.c
	* unix/tclLoadDl.c
	* unix/tclLoadDyld.c
	* tests/load.test
	* doc/Load.3
	* doc/load.n

2012-11-14  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixFCmd.c (TclUnixOpenTemporaryFile): [Bug 2933003]: Factor
	out all the code to do temporary file creation so that it is possible
	to make it correct in one place. Allow overriding of the back-stop
	default temporary file location at compile time by setting the
	TCL_TEMPORARY_FILE_DIRECTORY #def to a string containing the directory
	name (defaults to "/tmp" as that is the most common default).

2012-11-13  Joe Mistachkin  <joe@mistachkin.com>

	* win/tclWinInit.c: also search for the library directory (init.tcl,
	encodings, etc) relative to the build directory associated with the
	source checkout.

2012-11-10  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   re-enable bcc-tailcall, after fixing an
	* generic/tclExecute.c: infinite loop in the TCL_COMPILE_DEBUG mode


2012-11-07  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Araguaina:
	* library/tzdata/America/Bahia:
	* library/tzdata/America/Havana:
	* library/tzdata/Asia/Amman:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Hebron:
	* library/tzdata/Asia/Jerusalem:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Fakaofo:
	* library/tzdata/Pacific/Fiji:		Import tzdata2012i.

2012-11-07  Don Porter  <dgp@users.sourceforge.net>

	* win/tclWinSock.c:	[Bug 3574493] Avoid hanging on exit due to
	use of synchronization calls in routines called by DllMain().

2012-11-06  Donal K. Fellows  <dkf@users.sf.net>

	* library/http/http.tcl (http::Finish): [Bug 3581754]: Ensure that
	callbacks are done at most once to prevent problems with timeouts on a
	keep-alive connection (combined with reentrant http package use)
	causing excessive stack growth. Not a fix for the underlying problem,
	but ensures that pain will be mostly kept away from users.
	Bump http package to 2.8.5.
	Bump http package to 2.7.10.

2012-11-05  Donal K. Fellows  <dkf@users.sf.net>

	Added bytecode compilation of many Tcl commands. Some of these are
	total compilations and some are only partial (i.e., only compile in
	some cases). The (sub-)commands affected are:
	* array: exists, set, unset
	* dict: create, exists, merge
	* format: (simple cases only)
	* info: commands, coroutine, level, object
	* info object: class, isa object, namespace
	* namespace: current, code, qualifiers, tail, which
	* regsub: (only cases convertable to simple [string map])
	* self: (only no-argument and [self object] cases)
	* string: first, last, map, range
	* tailcall:
	* yield:

	[This was work originally done on the 'dkf-compile-misc-info' branch.]

2012-11-05  Jan Nijtmans  <nijtmans@users.sf.net>

	IMPLEMENTATION OF TIP#413

	Align the [string trim] and [string is space] commands, such that
	[string trim] by default trims all characters for which [string is
	space] returns 1, augmented with the NUL character.

	* generic/tclUtf.c: Add NEL, BOM and two more characters to [string is
	space]
	* generic/tclCmdMZ.c: Modify [string trim] for Unicode modifications.
	* generic/regc_locale.c: Regexp engine must match [string is space]
	* doc/string.n
	* tests/string.test
	***POTENTIAL INCOMPATIBILITY***
	Code that relied on characters not previously trimmed being not
	removed will notice a difference; it is believed that this is rare,
	but a workaround to get the behavior in Tcl 8.5 is to use " \t\n\r" as
	an explicit trim set.

2012-10-31  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in:   Dde version number to 1.4.0, ready for Tcl 8.6.0rc1
	* win/makefile.vc
	* win/tclWinDde.c
	* library/dde/pkgIndex.tcl
	* tests/winDde.test

2012-10-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileDictUnsetCmd): Added compilation of
	the [dict unset] command (for scalar var in LVT only).

2012-10-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.h:       Add "flags" parameter from Tcl_LoadFile to
	* generic/tclIOUtil.c:    to various internal functions, so these
	* generic/tclInt.h:    Remove unused TclpLoadFile function.
	* generic/tclIOUtil.c
	* generic/tclLoadNone.c:  flags are available through the whole
	* unix/tclLoad*.c:        filesystem for (future) internal use.
	* win/tclWinLoad.c:

2012-10-17  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c (TclNRCoroutineObjCmd): insure that numlevels
	are properly set, fix bug discovered by dkf and reported at
	http://code.activestate.com/lists/tcl-core/12213/

2012-10-16  Donal K. Fellows  <dkf@users.sf.net>

	IMPLEMENTATION OF TIP#405

	New commands for applying a transformation to the elements of a list
	to produce another list (the [lmap] command) and to the mappings of a
	dictionary to produce another dictionary (the [dict map] command). In
	both cases, a [continue] will cause the skipping of an element/pair,
	and a [break] will terminate the construction early and successfully.

	* generic/tclCmdAH.c (Tcl_LmapObjCmd, TclNRLmapCmd): Implementation of
	the new [lmap] command, based on (and sharing much of) [foreach].
	* generic/tclDictObj.c (DictMapNRCmd): Implementation of the new [dict
	map] subcommand, based on (and sharing much of) [dict for].
	* generic/tclCompCmds.c (TclCompileLmapCmd, TclCompileDictMapCmd):
	Compilation engines for [lmap] and [dict map].

	IMPLEMENTATION OF TIP#400

	* generic/tclZlib.c: Allow the specification of a compression
	dictionary (a binary blob used to seed the compression engine) in both
	streams and channel transformations. Also some reorganization to allow
	for getting gzip header dictionaries and controlling buffering levels
	in channel transformations (allowing a trade-off between formal
	correctness and speed).
	(Tcl_ZlibStreamSetCompressionDictionary): New C API to allow setting
	the compression dictionary without using a Tcl script.

2012-10-14  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDictObj.c: [Bug 3576509]: ::tcl::Bgerror crashes with
	* generic/tclEvent.c:    invalid arguments. Better fix, which helps
	for all Tcl_DictObjGet() calls in Tcl's source code.
	* generic/tclDictObj.c: [Bug 3576509]: tcl::Bgerror crashes with invalid
	* generic/tclEvent.c:    arguments. Better fix, which helps for all
	Tcl_DictObjGet() calls in Tcl's source code.

2012-10-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclEvent.c: [Bug 3576509]: tcl::Bgerror crashes with invalid
	arguments

2012-10-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in: [Bug 2459774]: tcl/win/Makefile.in not compatible
	with msys 0.8.

2012-10-03  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIO.c:	When checking for std channels being closed,
	compare the channel state, not the channel itself so that stacked
	channels do not cause trouble.

2012-09-26  Reinhard Max  <max@suse.de>

	* generic/tclIOSock.c (TclCreateSocketAddress): Work around a bug in
	getaddrinfo() on OSX that caused name resolution to fail for [socket
	-server foo -myaddr localhost 0].

2012-09-20  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/configure.in: New import libraries for zlib 1.2.7, usable for
	* win/configure:    all win32/win64 compilers
	* compat/zlib/win32/zdll.lib:
	* compat/zlib/win64/zdll.lib:

	* win/tclWinDde.c: [FRQ 3527238]: Full unicode support for dde. Dde
	version is now 1.4.0b2.
	***POTENTIAL INCOMPATIBILITY***

2012-09-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:  Make Tcl_Interp a fully opaque structure if
	TCL_NO_DEPRECATED is set (TIP 330 and 336).
	* win/nmakehlp.c: Let "nmakehlp -V" start searching digits after the
	found match (suggested by Harald Oehlmann).

2012-09-19  Harald Oehlmann  <oehhar@users.sf.net>
2012-09-07  Harald Oehlmann  <oehhar@users.sf.net>

	IMPLEMENTATION OF TIP#412.
	IMPLEMENTATION OF TIP#404.

	* library/msgcat/msgcat.tcl:	dynamic locale change with mc file
	* library/clock.tcl:            load on locale change.
	clock uses new msgcat features.
	* library/msgcat/msgcat.tcl:	[FRQ 3544988]: (Backport from Tcl 8.6)
	* library/msgcat/pkgIndex.tcl:	New commands [mcflset] and [mcflmset]
	* unix/Makefile.in:		to set mc entries with implicit message
	* win/Makefile.in:		file locale. Bump to 1.5.0.
	* tests/msgcat.test:

2012-09-07  Harald Oehlmann  <oehhar@users.sf.net>
2012-09-07  Alexandre Ferrieux <ferrieux@users.sourceforge.net>

	*** 8.6b3 TAGGED FOR RELEASE ***

	* unix/tclUnixNotfy.c Backport of 2008-12-12 8.6 commit: Fix
	IMPLEMENTATION OF TIP#404.

	missing CLOEXEC on internal pipes [2417695]
	* library/msgcat/msgcat.tcl:	[FRQ 3544988]: New commands [mcflset]
	* library/msgcat/pkgIndex.tcl:	and [mcflmset] to set mc entries with
	* unix/Makefile.in:		implicit message file locale.
	* win/Makefile.in:		Bump to 1.5.0.

2012-08-25  Donal K. Fellows  <dkf@users.sf.net>

	* library/msgs/uk.msg: [Bug 3561330]: Use the correct full name of
	March in Ukrainian. Thanks to Mikhail Teterin for reporting.

2012-08-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBinary.c: [Bug 3496014]: Unecessary memset() in
	Tcl_SetByteArrayObj().
	* generic/tclBinary.c: [Bug 3496014]: (Backport from Tcl 8.6) Protect
	Tcl_SetByteArrayObj for invalid values.

2012-08-20  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c:	[Bug 3559678]: Fix bad filename normalization
	when the last component is the empty string.

2012-08-20  Jan Nijtmans  <nijtmans@users.sf.net>
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
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
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
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
595
596
597
598





599
600
601
602
603









604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622












623
624
625
626
627
628
629
630
631
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
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







-
+
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
-


-
-
-
-
+
-
-
+
-
-
-












-
+

-
+
-

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

-
-
-
-
-
+
+
-

-
-
+


















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



















-
-
-
-
-





-
-
-
-
-
-
-
-
-



















-
-
-
-
-
-
-
-
-
-
-
-
















-
+






-
-
-
-
-
-




+


















-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-


-
-
-
-

-
+
-
-
-






-
-
-
-
-
-
-
-
-
-
-






-
-
-
-














-
+


+

-
+


-

-
-
-
-
-
-
-


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








	* win/nmakehlp.c: Add "-V<num>" option, in order to be able to detect
	partial version numbers.

2012-08-15  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/buildall.vc.bat: Only build the threaded builds by default
	* win/rules.vc:        Some code cleanup
	* win/rules.vc:        Backport some improvements from Tcl 8.6
	* win/makefile.vc:

2010-08-13  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/tclUnixCompat.c: [Bug 3555454]: Rearrange a bit to quash
	'declared but never defined' compiler warnings.

2012-08-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/zlib/win64/zlib1.dll:  Add 64-bit build of zlib1.dll, and use
	* compat/zlib/win64/zdll.lib:   it for the dynamic mingw-w64 build.
	* win/Makefile.in:
	* win/configure.in:
	* win/configure:

2012-08-09  Reinhard Max  <max@suse.de>

	* tests/http.test: Fix http-3.29 for machines without IPv6 support.

2010-08-08  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/tclUnixCompat.c: Change one '#ifdef' to '#if defined()' for
	improved consistency within the file.

2012-08-08  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclfileName.c: [Bug #1536227]: Cygwin network pathname
	* tests/fileName.test:   support

2012-08-07  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIOUtil.c:	[Bug 3554250]: Overlooked one field of cleanup
	in the thread exit handler for the filesystem subsystem.

2012-07-31  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclInterp.c (Tcl_GetInterpPath):
	* unix/tclUnixPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
	* win/tclWinPipe.c (TclGetAndDetachPids, Tcl_PidObjCmd):
	Purge use of Tcl_AppendElement, and corrected conversion of PIDs to
	integer objects.

2012-07-31  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/nmakehlp.c:  Add -Q option from sampleextension.
	* win/Makefile.in: [FRQ 3544967]: Missing objectfiles in static lib
	* win/makefile.vc: (Thanks to Jos Decoster).

	* win/nmakehlp.c: Backport from Tcl 8.6, but add -Q option from
2012-07-29  Jan Nijtmans  <nijtmans@users.sf.net>

	sampleextension.
	* win/Makefile.in:  No longer build tcltest.exe to run the tests,
	but use tclsh86.exe in combination with tcltest86.dll to do that.
	* tests/*.test:     load tcltest86.dll if necessary.

2012-07-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* tests/clock.test:    [Bug 3549770]: Multiple test failures running
	* tests/registry.test: tcltest outside build tree
	* tests/winDde.test:

2012-07-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclUniData.c:   Support Unicode 6.2 (Add Turkish lira sign)
	* generic/regc_locale.c:

2012-07-25  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
2012-07-24  Don Porter  <dgp@users.sourceforge.net>

	* win/tclWinPipe.c: [Bug 3547994]: Abandon the synchronous Windows
	*** 8.5.12 TAGGED FOR RELEASE ***
	pipe driver to its fate when needed to honour TIP#398.

	* generic/tcl.h:	Bump to 8.5.12 for release.
2012-07-24  Trevor Davel  <twylite@crypt.co.za>

	* win/tclWinSock.c: [Bug: 3545363]: Loop over multiple underlying file
	descriptors for a socket where required (TcpCloseProc, SocketProc).
	Refactor socket/descriptor setup to manage linked list operations in
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:
	one place. Fix memory leak in socket close (TcpCloseProc) and related
	dangling pointers in SocketEventProc.

	* README:
2012-07-19  Reinhard Max  <max@suse.de>

	* win/tclWinSock.c (TcpAccept): [Bug: 3545363]: Use a large enough
	buffer for accept()ing IPv6 connections. Fix conversion of host and
	port for passing to the accept proc to be independent of the IP
	version.

	* unix/configure:	autoconf-2.59
	* win/configure:
2012-07-23  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c: [Bug 3545365]: Never try a bg-flush  on a dead
	channel, just like before 2011-08-17.
	* changes:	Update for 8.5.12 release.

2012-07-19  Joe Mistachkin  <joe@mistachkin.com>

	* generic/tclTest.c: Fix several more missing mutex-locks in
	TestasyncCmd.

2012-07-19  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclTest.c: [Bug 3544685]: Missing mutex-lock in
	TestasyncCmd since 2011-08-19. Unbounded gratitude to Stuart
	Cassoff for spotting it.

2012-07-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/makefile.vc: [Bug 3544932]: Visual studio compiler check fails

2012-07-16  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixCompat.c (TclpGetPwNam, TclpGetPwUid, TclpGetGrNam)
	* generic/tclUtil.c (UpdateStringOfEndOffset): [Bug 3544658]: Stop
	(TclpGetGrGid): [Bug 3544683]: Use the elaborate memory management
	1-byte overrun in memcpy, that object placement rules made harmless
	but which still caused compiler complaints.

2012-07-16  Jan Nijtmans  <nijtmans@users.sf.net>

	scheme outlined on http://www.opengroup.org/austin/docs/austin_328.txt
	to handle Tcl's use of standard reentrant versions of the passwd/group
	access functions so that everything can work on all BSDs. Problem
	identified by Stuart Cassoff.
	* library/reg/pkgIndex.tcl:  Make registry 1.3 package dynamically
	loadable when ::tcl::pkgconfig is available.

2012-07-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinReg.c: [Bug 3362446]: registry keys command fails
	with 8.5/8.6. Follow Microsofts example better in order to prevent
	problems when using HKEY_PERFORMANCE_DATA.

2012-07-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixNotfy.c: [Bug 3541646]: Don't panic on triggerPipe
	overrun.

2012-07-10  Donal K. Fellows  <dkf@users.sf.net>

	* win/tclWinSock.c (InitializeHostName): Corrected logic that
	extracted the name of the computer from the gethostname call so that
	it would use the name on success, not failure. Also ensured that the
	buffer size is exactly that recommended by Microsoft.

2012-07-08  Reinhard Max  <max@suse.de>

	* library/http/http.tcl: [Bug 3531209]: Add fix and test for URLs that
	* tests/http.test: 	 contain literal IPv6 addresses.

2012-07-05  Don Porter  <dgp@users.sourceforge.net>

	* unix/tclUnixPipe.c:	[Bug 1189293]: Make "<<" binary safe.
	* win/tclWinPipe.c:

2012-07-03  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclUtil.c (TclDStringAppendObj, TclDStringAppendDString):
	* generic/tclInt.h (TclDStringAppendLiteral, TclDStringClear):
	* generic/tclCompile.h (TclDStringAppendToken): Added wrappers to make
	common cases of appending to Tcl_DStrings simpler to write. Prompted
	by looking at [FRQ 1357401] (these are an _internal_ implementation of
	that FRQ).

2012-06-29  Jan Nijtmans  <nijtmans@users.sf.net>

	* library/msgcat/msgcat.tcl:   Add tn, ro_MO and ru_MO to msgcat.

2012-06-29  Harald Oehlmann <oehhar@users.sf.net>

	* library/msgcat/msgcat.tcl:	[Bug 3536888]: Locale guessing of
	* library/msgcat/pkgIndex.tcl:	msgcat fails on (some) Windows 7. Bump
	* unix/Makefile.in:		to 1.4.5
	* win/Makefile.in:

2012-06-29  Donal K. Fellows  <dkf@users.sf.net>

	* doc/GetIndex.3: Reinforced the description of the requirement for
	the tables of names to index over to be static, following posting to
	tcl-core by Brian Griffin about a bug caused by Tktreectrl not obeying
	this rule correctly. This does not represent a functionality change,
	merely a clearer documentation of a long-standing constraint.

2012-06-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4:       Let Cygwin shared build link with
	* unix/configure.in: zlib1.dll, not cygz.dll (two less
	* unix/configure:    dependencies on cygwin-specific dll's)
	* unix/Makefile.in:

2012-06-26  Reinhard Max  <max@suse.de>

	* generic/tclIOSock.c: Use EAI_SYSTEM only if it exists.
	* unix/tclUnixSock.c:

2012-06-25  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFileSystem.h:	[Bug 3024359]: Make sure that the
	* generic/tclIOUtil.c:	per-thread cache of the list of file systems
	* generic/tclPathObj.c:	currently registered is only updated at times
	when no active loops are traversing it.  Also reduce the amount of
	epoch storing and checking to where it can make a difference.

2012-06-25  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right
	thing when reporting errors with the number of arguments.

2012-06-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclfileName.c: [Patch 1536227]: Cygwin network pathname
	* tests/fileName.test:   support.
	* tests/fileName.test:   support

2012-06-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixNotfy.c: [Bug 3508771]: Cygwin notifier for handling
	win32 events.

2012-06-22  Reinhard Max  <max@suse.de>

	* generic/tclIOSock.c: Rework the error message generation of [socket],
	* unix/tclUnixSock.c:  so that the error code of getaddrinfo is used
	* win/tclWinSock.c:    instead of errno unless it is EAI_SYSTEM.

2012-06-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinReg.c:	[Bug 3362446]: registry keys command fails
	* tests/registry.test:	with 8.5/8.6
	* library/reg/pkgIndex.tcl: registry version to 1.2.2

2012-06-11  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c:	[Bug 3532959]: Make sure the lifetime
	* generic/tclProc.c:	management of entries in the linePBodyPtr
	* tests/proc.test:	hash table can tolerate either order of
	teardown, interp first, or Proc first.

2012-06-08  Don Porter  <dgp@users.sourceforge.net>

	* unix/configure.in:	Update autogoo for gettimeofday().
	* unix/tclUnixPort.h:	Thanks Joe English.
	* unix/configure:	autoconf 2.13

	* unix/tclUnixPort.h:	[Bug 3530533]: Centralize #include <pthread.h>
	* unix/tclUnixThrd.c:	in the tclUnixPort.h header so that old unix
	systems that need inclusion in all compilation units are supported.

2012-06-08  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:    Revise the "null data" check: null strings are
	possible, but empty binary arrays are not.
	* tests/winDde.test:  Add test-case (winDde-9.4) for transferring
	null-strings with dde. Convert tests to tcltest-2 syntax.

2012-06-06  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (TclZlibInit): Declare that Tcl is publishing the
	zlib package (version 2.0) as part of its bootstrap process. This will
	have an impact on tclkit (which includes zlib 1.1) but otherwise be
	very low impact.

2012-06-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixInit.c: On Cygwin, use win32 API in stead of uname()
	to determine the tcl_platform variables.

2012-05-31  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclZlib.c:  [Bug 3530536]: zlib-7.4 fails on IRIX64
	* tests/zlib.test:
	* doc/zlib.n:         Document that [stream checksum] doesn't do
	what's expected for "inflate" and "deflate" formats

2012-05-31  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (safe::AliasFileSubcommand): Don't assume that
	slaves have corresponding commands, as that is not true for
	sub-subinterpreters (used in Tk's test suite).

	* doc/safe.n: [Bug 1997845]: Corrected formatting so that generated
	HTML can link properly.
	* tools/tcltk-man2html.tcl (cross-reference): HTML can link properly.

	* tests/socket.test (socket*-13.1): Prevented intermittent test
	failure due to race condition.

2012-05-29  Donal K. Fellows  <dkf@users.sf.net>

	* doc/expr.n, doc/mathop.n: [Bug 2931407]: Clarified semantics of
	division and remainder operators.

2012-05-29  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:    [Bug 3525762]: Encoding handling in dde.
	* win/Makefile.in:    Fix "make genstubs" when cross-compiling on UNIX

2012-05-28  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (safe::AliasFileSubcommand): [Bug 3529949]: Made a
	more sophisticated method for preventing information leakage; it
	changes references to "~user" into "./~user", which is safe.

2012-05-25  Donal K. Fellows  <dkf@users.sf.net>

	* doc/namespace.n, doc/Ensemble.3: [Bug 3528418]: Document what is
	going on with respect to qualification of command prefixes in ensemble
	subcommand maps.

	* generic/tclIO.h (SYNTHETIC_EVENT_TIME): Factored out the definition
	of the amount of time that should be waited before firing a synthetic
	event on a channel.

2012-05-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c: [Bug 473946]: Special characters were not correctly
	sent, now for XTYP_EXECUTE as well as XTYP_REQUEST.
	* win/Makefile.in: Fix "make genstubs" when cross-compiling on UNIX

2012-05-24  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl:  Take cygwin handling of X11 into account.
	* generic/tcl*Decls.h: re-generated
	* generic/tclStubInit.c:  Implement TclpIsAtty, Cygwin only.
	* doc/dde.n: Doc fix: "dde execute iexplore" doesn't work
	without -async, because iexplore doesn't return a value

2012-05-24  Jan Nijtmans  <nijtmans@users.sf.net>
2012-05-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl:   Let cygwin share stub table with win32
	* win/Makefile.in:      Don't hardcode dde and reg dll version numbers
	* win/tclWinSock.c:     implement TclpInetNtoa for win32
	* generic/tclInt.decls: Revert most of [3caedf05df], since when
	* generic/tclInt.decls: Revert most of [fcc5957e59], since when
	  we let cygwin share the win32 stub table this is no longer necessary
	* generic/tcl*Decls.h:  re-generated
	* doc/dde.n:            1.3 -> 1.4

2012-05-23  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ZlibTransformInput): [Bug 3525907]: Ensure that
	decompressed input is flushed through the transform correctly when the
	input stream gets to the end. Thanks to Alexandre Ferrieux and Andreas
	Kupries for their work on this.

2012-05-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFileName.c:	When using Tcl_SetObjLength() calls to
	* generic/tclPathObj.c:		grow and shrink the objPtr->bytes
	buffer, care must be taken that the value cannot possibly become pure
	Unicode.  Calling Tcl_AppendToObj() has the possibility of making such
	a conversion.  Bug found while valgrinding the trunk.
	* generic/tclFileName.c: When using Tcl_SetObjLength() calls to grow
	* generic/tclIOUtil.c:	 and shrink the objPtr->bytes buffer, care must
	be taken that the value cannot possibly become pure Unicode.  Calling
	Tcl_AppendToObj() has the possibility of making such a conversion.  Bug
	found while valgrinding the trunk.

2012-05-21  Jan Nijtmans  <nijtmans@users.sf.net>

	IMPLEMENTATION OF TIP#106

	* win/tclWinDde.c:		Added encoding-related abilities to
	* library/dde/pkgIndex.tcl:	the [dde] command. The dde package's
	* tests/winDde.test:		version is now 1.4.0.
	* doc/dde.n:

2012-05-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOBasic.c (TclOO_Class_Constructor): [Bug 2023112]: Cut
	the amount of hackiness in class constructors, and refactor some of
	the error message handling from [oo::define] to be saner in the face
	of odd happenings.

2012-05-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd): [Bug 3106532]: Corrected
	resulting indexes from -indexvar option to be usable with [string
	range]; this was always the intention (and is consistent with [regexp
	-indices] too).
1332
1333
1334
1335
1336
1337
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
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
1439

1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451

1452
1453
1454
1455



1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546

1547
1548
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
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
1631
1632
1633
1634
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







-
-
-
-
-
-
-
-











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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















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



-
+
-
-
-
-
+
+
+



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
+
-

-
-
-
-
-
-
+















-
-

-
-
-
-
-
-
-
-
-
-
-
-




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







	(safe::AliasGlob): [Bug 2964715]: More extensive handling of what
	globbing is required to support package loading.

	* doc/expr.n: [Bug 3525462]: Corrected statement about what happens
	when comparing "0y" and "0x12"; the previously documented behavior was
	actually a subtle bug (now long-corrected).

2012-05-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3445787]: Improve
	the compatibility of safe interpreters' version of 'file' with that of
	unsafe interpreters.
	* library/safe.tcl (::safe::InterpInit): Teach the safe-interp scripts
	about how to expose 'file' properly.

2012-05-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:   Protect against receiving strings without ending
	\0, as external applications (or Tcl with TIP #106) could generate
	that.

2012-05-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c: [Bug 473946]: Special characters not correctly sent
	* library/dde/pkgIndex.tcl:  Increase version to 1.3.3

2012-05-10  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* {win,unix}/configure{,.in}: [Bug 2812981]: Clean up bundled
	packages' build directory from within Tcl's ./configure, to avoid
	stale configuration.

2012-05-09  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORChan.c: [Bug 3522560]: Fixed the crash, enabled the
	test case. Modified [chan postevent] to properly inject the event(s)
	into the owner thread's event queue for execution in the correct
	context. Renamed the ForwardOpTo...Thread() function to match with our
	terminology.

	* tests/ioCmd.test: [Bug 3522560]: Added a test which crashes the core
	if it were not disabled as knownBug. For a reflected channel
	transfered to a different thread the [chan postevent] run in the
	handler thread tries to execute the owner threads's fileevent scripts
	by itself, wrongly reaching across thread boundaries.

2012-04-28  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c: Properly close nonblocking channels even when
	not flushing them.

2012-05-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/zlib/*: Upgrade to zlib 1.2.7 (pre-built dll is still 1.2.5,
	will be upgraded as soon as the official build is available)

2012-05-03  Don Porter  <dgp@users.sourceforge.net>

	* tests/socket.test:	[Bug 3428754]: Test socket-14.2 tolerate
	[socket -async] connection that connects synchronously.

	* unix/tclUnixSock.c:	[Bug 3428753]: Fix [socket -async] connections
	that manage to connect synchronously.

2012-05-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/configure.in:    Better detection and implementation for
	* generic/configure:       cpuid instruction on Intel-derived
	* generic/tclUnixCompat.c: processors, both 32-bit and 64-bit.
	* generic/tclTest.c:       Move cpuid testcase from win-specific to
	* win/tclWinTest.c:        generic tests, as it should work on all
	* tests/platform.test:     Intel-related platforms now.
	* generic/configure.in:		Better detection and implementation for
	* generic/configure:		cpuid instruction on Intel-derived
	* generic/tclUnixCompat.c:	processors, both 32-bit and 64-bit.
	* generic/tclTest.c:		Move cpuid testcase from win-specific
	* win/tclWinTest.c:		to generic tests, as it should work on
	* tests/platform.test:		all Intel-related platforms now

2012-04-30  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tests/ioCmd.test: [Bug 3522560]: Tame deadlocks in broken refchan
	tests.

2012-04-28  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	IMPLEMENTATION OF TIP#398

	* generic/tclIO.c: Quickly Exit with Non-Blocking Blocked Channels
	* tests/io.test  : *** POTENTIAL INCOMPATIBILITY ***
	* doc/close.n    : (compat flag available)

2012-04-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPort.h:    Move CYGWIN-specific stuff from tclPort.h to
	* generic/tclEnv.c:     tclUnixPort.h, where it belongs.
	* unix/tclUnixPort.h:
	* unix/tclUnixFile.c:

2012-04-27  Donal K. Fellows  <dkf@users.sf.net>

	* library/init.tcl (auto_execok): Allow shell builtins to be detected
	even if they are upper-cased.

2012-04-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclStubInit.c:    Get rid of _ANSI_ARGS_ and CONST
	* generic/tclIO.c:
	* generic/tclStubInit.c:    get rid of _ANSI_ARGS_
	* generic/tclIntPlatDecls.h
	* generic/tclIOCmd.c:
	* generic/tclTest.c:
	* unix/tclUnixChan.c:

	* unix/tclUnixPort.h
	* unix/tclAppInit.c
2012-04-25  Donal K. Fellows  <dkf@users.sf.net>

	* win/tclAppInit.c
	* generic/tclUtil.c (TclDStringToObj): Added internal function to make
	the fairly-common operation of converting a DString into an Obj a more
	efficient one; for long strings, it can just transfer the ownership of
	the buffer directly. Replaces this:
	   obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	   Tcl_DStringFree(&ds);
	with this:
	   obj=TclDStringToObj(&ds);

2012-04-24  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls:      [Bug 3508771]: load tclreg.dll in cygwin
	* generic/tclInt.decls:		[Bug 3508771]: load tclreg.dll in
				     tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt,
	* generic/tclStubInit.c:     TclWinGetServByName and TclWinCPUID for
	* generic/tclUnixCompat.c:   Cygwin.
	* generic/tclIntPlatDecls.h:	cygwin tclsh. Implement
	* generic/tclStubInit.c:	TclWinGetSockOpt, TclWinGetServByName
	* generic/tclUnixCompat.c:	and TclWinCPUID for Cygwin.
	* unix/configure.in:
	* unix/configure:
	* unix/tclUnixCompat.c:

2012-04-18  Kevin B. Kenny  <kennykb@acm.org>

	* 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  <dkf@users.sf.net>

	* 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  <dkf@users.sf.net>

	* 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  <nijtmans@users.sf.net>

	* 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  <nijtmans@users.sf.net>

	* 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  <dkf@users.sf.net>

	* 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  <dkf@users.sf.net>

	* 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  <dkf@users.sf.net>

	* 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  <nijtmans@users.sf.net>

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

2012-04-03  Jan Nijtmans  <nijtmans@users.sf.net>

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

	* generic/tcl.decls:		cleanup unnecessary "generic" argument
2012-04-02  Donal K. Fellows  <dkf@users.sf.net>

	IMPLEMENTATION OF TIP#396.

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

2012-04-02  Jan Nijtmans  <nijtmans@users.sf.net>
2012-03-30  Jan Nijtmans  <nijtmans@users.sf.net>

	* 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  <nijtmans@users.sf.net>

	* 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  <nijtmans@users.sf.net>

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

2012-03-27  Donal K. Fellows  <dkf@users.sf.net>

	IMPLEMENTATION OF TIP#395.

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

2012-03-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* 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).
	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  <dkf@users.sf.net>

	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  <dkf@users.sf.net>

	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  <nijtmans@users.sf.net>

	* 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
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
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
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







-
-
-
-
-
-
-
-













-
-
-
-
-
-
-
-
-




-
+













-
-
-
-
-
-
-








-
+







-
-
-
-
-
-


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



-
-
-
+
+
+



-
+







	* 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  <max@suse.de>

	* 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  <nijtmans@users.sf.net>

	* 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  <nijtmans@users.sf.net>

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

2012-03-11  Donal K. Fellows  <dkf@users.sf.net>

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

2012-03-08  Donal K. Fellows  <dkf@users.sf.net>

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

2012-03-07  Andreas Kupries  <andreask@activestate.com>

	* 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.
	* tests/http.test: with RFC 3986. Bumped version to 2.7.9.
	* unix/Makefile.in:
	* win/Makefile.in:

2012-03-06  Jan Nijtmans  <nijtmans@users.sf.net>

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

2012-03-04  Jan Nijtmans  <nijtmans@users.sf.net>

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

2012-03-02  Donal K. Fellows  <dkf@users.sf.net>

	* 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  <nijtmans@users.sf.net>

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

2012-02-23  Donal K. Fellows  <dkf@users.sf.net>

	* tests/reg.test (14.21-23): Add tests relating to Bug 1115587. Actual
	* 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  <nijtmans@users.sf.net>

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

2012-02-16  Donal K. Fellows  <dkf@users.sf.net>

	* 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  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileLreplaceCmd): Added a compilation
	* generic/tclCompCmds.c (TclCompileDictForCmd): [Bug 3487626]: Fix
	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.
	crash in compilation of [dict for] when its implementation command is
	used directly rather than through the ensemble.

2012-02-09  Don Porter  <dgp@users.sourceforge.net>

	* 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.
	* generic/tclStringObj.c:	[Bug 3484402]: Correct Off-By-One
	error appending unicode. Thanks to Poor Yorick. Also corrected test
	for when growth is needed.

2012-02-06  Don Porter  <dgp@users.sourceforge.net>

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

2012-02-06  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclTrace.c:  [Bug 3484621]: Ensure that execution traces on
	* tests/trace.test:    bytecoded commands bump the interp's compile
	epoch.
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
998
999
1000
1001
1002
1003
1004














1005
1006
1007
1008
1009
1010






1011
1012
1013
1014
1015
1016
1017







-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-







	operations are possible, especially when the file resides on a Samba
	share.

2012-02-01  Donal K. Fellows  <dkf@users.sf.net>

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

2012-01-30  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileCatchCmd): Added a more efficient
	bytecode generator for the case where 'catch' is used without any
	variable arguments; don't capture the result just to discard it.

2012-01-26  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCmdAH.c:		[Bug 3479689]: New internal routine
	* generic/tclFCmd.c:		TclJoinPath(). Refactor all the
	* generic/tclFileName.c:	*Join*Path* routines to give them more
	* generic/tclInt.h:		useful interfaces that are easier to
	* generic/tclPathObj.c:		manage getting the refcounts right.

2012-01-26  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c:	[Bug 3475569]: Add checks for unshared values
	before calls demanding them.  [Bug 3479689]: Stop memory corruption
	when shimmering 0-refCount value to "path" type.

2012-01-25  Donal K. Fellows  <dkf@users.sf.net>

	* 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  <nijtmans@users.sf.net>

	* 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)
1872
1873
1874
1875
1876
1877
1878







1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
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







+
+
+
+
+
+
+






-
-
-
-







	* generic/tclCmdMZ.c:	[Bug 3475667]: Prevent buffer read overflow.
	Thanks to "sebres" for the report and fix.

2012-01-17  Donal K. Fellows  <dkf@users.sf.net>

	* doc/dict.n (dict with): [Bug 3474512]: Explain better what is going
	on when a dictionary key and the dictionary variable collide.

2012-01-17  Don Porter  <dgp@users.sourceforge.net>

	* library/http/http.tcl:	Bump to version 2.7.8
	* library/http/pkgIndex.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:

2012-01-13  Donal K. Fellows  <dkf@users.sf.net>

	* library/http/http.tcl (http::Connect): [Bug 3472316]: Ensure that we
	only try to read the socket error exactly once.

2012-01-12  Donal K. Fellows  <dkf@users.sf.net>

	* doc/tclvars.n: [Bug 3466506]: Document more environment variables.

2012-01-09  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclUtf.c:      [Bug 3464428]: [string is graph \u0120] was
	* generic/regc_locale.c: wrong. Add table for Unicode [:cntrl:] class.
	* tools/uniClass.tcl:    Generate Unicode [:cntrl:] class table.
	* tests/utf.test:

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
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
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
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




























1348
1349


1350
1351



















1352
1353
1354
1355
1356




1357
1358
1359
1360
1361
1362
1363







-
-
-
-
-
-


















+
+
+


-
-
-
-
-
-
-
-
-
-
-
-







-
+

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

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

-
-
+
-
-
-
+

-
-
+
-
-
-
-
-
-



-
+




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



















-
-
-
-
-
-


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















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
-
-
-





-
-
-
-
-
-













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-






-
-
-
-
-
-
-
-
-





-
+

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








+

+
+



-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-



















-
-
-
-
-
-










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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





-
-
-
-







	* generic/tclUtf.c: [Bug 3464428]: [string is graph \u0120] is wrong.
	* generic/tclUniData.c:
	* generic/regc_locale.c:
	* tests/utf.test:
	* tools/uniParse.tcl:   Clean up some unused stuff, and be more robust
	against changes in UnicodeData.txt syntax

2011-12-13  Andreas Kupries  <andreask@activestate.com>

	* generic/tclCompile.c (TclInitAuxDataTypeTable): Extended to register
	the DictUpdateInfo structure as an AuxData type. For use by tbcload,
	tclcompiler.

2011-12-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/regc_locale.c: [Bug 3457031]: Some Unicode 6.0 chars not
	* tests/utf.test:        in [:print:] class

2011-12-07  Jan Nijtmans  <nijtmans@users.sf.net>

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

2011-11-30  Jan Nijtmans  <nijtmans@users.sf.net>

	* library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work
	when tclsh is compiled without using the setargv() function on mingw.

2011-11-29  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/tclsh.1:  Use the same shebang comment everywhere.
	* tools/str2c
	* tools/tcltk-man2html.tcl
	* 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  <dkf@users.sf.net>

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

2011-11-22  Donal K. Fellows  <dkf@users.sf.net>

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

2011-11-22  Jan Nijtmans  <nijtmans@users.sf.net>

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

2011-11-20  Joe Mistachkin  <joe@mistachkin.com>
2011-11-04  Don Porter  <dgp@users.sourceforge.net>

	* 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
	thread testing related variables.  Revise results of the thread-7.28
	through thread-7.31 tests to account for the fact they are canceled
	via a script sent to the thread asynchronously, which then impacts the
	error message handling.  Attempt to manually drain the event queue for
	the main thread after joining the test thread to make sure no stray
	events are processed at the wrong time on the main thread.  Revise all
	the synchronization and comparison semantics related to the thread id
	and error message.

	*** 8.5.11 TAGGED FOR RELEASE ***
2011-11-18  Joe Mistachkin  <joe@mistachkin.com>

	* tests/thread.test: Remove all use of thread::release from the thread
	7.x tests, replacing it with a script that can easily cause "stuck"
	threads to self-destruct for those test cases that require it.  Also,
	make the error message handling far more robust by keeping track of
	every asynchronous error.

	* generic/tcl.h:	Bump to 8.5.11 for release.
2011-11-17  Joe Mistachkin  <joe@mistachkin.com>

	* library/init.tcl:
	* tests/thread.test: Refactor all the remaining thread-7.x tests that
	were using [testthread].  Note that this test file now requires the
	very latest version of the Thread package to pass all tests.  In
	addition, the thread-7.18 and thread-7.19 tests have been flagged as
	knownBug because they cannot pass without modifications to the [expr]
	command, persuant to TIP #392.

	* tools/tcl.wse.in:
	* unix/configure.in:
2011-11-17  Joe Mistachkin  <joe@mistachkin.com>

	* unix/tcl.spec:
	* generic/tclThreadTest.c: For [testthread cancel], avoid creating a
	new Tcl_Obj when the default script cancellation result is desired.

	* win/configure.in:
2011-11-11  Donal K. Fellows  <dkf@users.sf.net>

	* README:
	* win/tclWinConsole.c: Refactor common thread handling patterns.

2011-11-11  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* unix/configure:	autoconf-2.59
	* tests/zlib.test: [Bug 3428756]: Use nonblocking writes in
	single-threaded IO tests to avoid deadlocks when going beyond OS
	buffers.  Tidy up [chan configure] flags across zlib.test.
	* win/configure:

2011-11-03  Donal K. Fellows  <dkf@users.sf.net>

	* changes:	Update for 8.5.11 release.
	* unix/tclUnixCompat.c (TclpGetPwNam, TclpGetPwUid, TclpGetGrNam)
	(TclpGetGrGid): Use the elaborate memory management scheme outlined on
	http://www.opengroup.org/austin/docs/austin_328.txt to handle Tcl's
	use of standard reentrant versions of the passwd/group access
	functions so that everything can work on all BSDs. Problem identified
	by Stuart Cassoff.

2011-10-20  Don Porter  <dgp@users.sourceforge.net>

	* library/http/http.tcl:        Bump to version 2.8.3
	* library/http/http.tcl:	Bump to version 2.7.7
	* library/http/pkgIndex.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:

	* changes:	Updates toward 8.6b3 release.
	* changes:	Updates for 8.5.11 release.

2011-10-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclLiteral.c (TclInvalidateCmdLiteral): [Bug 3418547]:
	Additional code for handling the invalidation of literals.
	* generic/tclBasic.c (Tcl_CreateObjCommand, Tcl_CreateCommand)
	(TclRenameCommand, Tcl_ExposeCommand): The four additional places that
	need extra care when dealing with literals.
	* generic/tclTest.c (TestInterpResolverCmd): Additional test machinery
	for interpreter resolvers.

2011-10-18  Reinhard Max  <max@suse.de>

	* library/clock.tcl (::tcl::clock::GetSystemTimeZone): Cache the time
	zone only if it was detected by one of the expensive methods.
	Otherwise after unsetting TCL_TZ or TZ the previous value will still
	be used.

2011-10-15  Venkat Iyer <venkat@comit.com>

	* library/tzdata/America/Sitka: Update to Olson's tzdata2011l
	* library/tzdata/Pacific/Fiji:
	* library/tzdata/Asia/Hebron: (New)

2011-10-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFile.c:    [Bug 2935503]: Incorrect mode field returned by
	[file stat] command.

2011-10-09  Donal K. Fellows  <dkf@users.sf.net>

	* 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  <nijtmans@users.sf.net>

	* 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.

	* generic/tclIORChan.c:	Fix gcc warning (discovered with latest
	mingw, based on gcc 4.6.1)
	* tests/env.test:	Fix env.test running under wine 1.3 (partly
	backported from Tcl 8.6)
2011-10-06  Donal K. Fellows  <dkf@users.sf.net>

	* 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.

2011-10-05  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinInt.h:   Remove tclWinProcs, as it is no longer
	* win/tclWin32Dll.c: being used.

2011-10-03  Venkat Iyer <venkat@comit.com>

	* library/tzdata/Africa/Dar_es_Salaam: Update to Olson's tzdata2011k
	* library/tzdata/Africa/Kampala:
	* library/tzdata/Africa/Nairobi:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Europe/Kaliningrad:
	* library/tzdata/Europe/Kiev:
	* library/tzdata/Europe/Minsk:
	* library/tzdata/Europe/Simferopol:
	* library/tzdata/Europe/Uzhgorod:
	* library/tzdata/Europe/Zaporozhye:
	* library/tzdata/Pacific/Apia:

2011-09-29  Donal K. Fellows  <dkf@users.sf.net>

	* tools/tcltk-man2html.tcl, tools/tcltk-man2html-utils.tcl: More
	refactoring so that more of the utility code is decently out of the
	way. Adjusted the header-material generator so that version numbers
	are only included in locations where there is room.

2011-09-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclOO.h:      [RFE 3010352]: make all TclOO API functions
	* generic/tclOODecls.h: MODULE_SCOPE
	* generic/tclOOIntDecls.h:

2011-09-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclIndexObj.c (Tcl_ParseArgsObjv): [Bug 3413857]: Corrected
	the memory management for the code parsing arguments when returning
	"large" numbers of arguments. Also unbroke the TCL_ARGV_AUTO_REST
	macro in passing.

2011-09-26  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c (TclMakeFileCommandSafe): [Bug 3211758]: Also
	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  <dgp@users.sourceforge.net>

	* 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  <dgp@users.sourceforge.net>

	* generic/tclCmdIL.c:	Revise [info frame] so that it stops creating
	cycles in the iPtr->cmdFramePtr stack.

2011-09-22  Donal K. Fellows  <dkf@users.sf.net>

	* doc/re_syntax.n: [Bug 2903743]: Add more magic so that we can do at
	least something sane on Solaris.
	* tools/tcltk-man2html-utils.tcl (process-text): Teach the HTML
	generator how to handle this magic.

2011-09-21  Don Porter  <dgp@users.sourceforge.net>

	* 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  <ferrieux@users.sourceforge.net>

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

2011-09-21  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORTrans.c (ForwardOpToOwnerThread): Fixed the missing
	initialization of the 'dsti' field. Reported by Don Porter, on chat.

2011-09-20  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIORChan.c: Re-using the "interp" field to signal a dead
	channel (via NULL value) interfered with conditional cleanup tasks
	testing for "the right interp". Added a new field "dead" to perform
	the dead channel signalling task so the corrupted logic is avoided.

	* generic/tclIORTrans.c: Revised ReflectClose() and
	FreeReflectedTransform() so that we stop leaking ReflectedTransforms,
	yet free all Tcl_Obj values in the same thread that alloced them.

2011-09-19  Don Porter  <dgp@users.sourceforge.net>

	* tests/ioTrans.test:	Conversion from [testthread] to Thread package
	stops most memory leaks.

	* tests/thread.test:	Plug most memory leaks in thread.test.
	Constrain the rest to be skipped during `make valgrind'.  Tests using
	the [testthread cancel] testing command are leaky.  Corrections wait
	for either addition of [thread::cancel] to the Thread package, or
	improvements to the [testthread] testing command to make leak-free
	versions of these tests possible.

	* generic/tclIORChan.c:	Plug all memory leaks in ioCmd.test exposed
	* tests/ioCmd.test:	by `make valgrind'.
	* unix/Makefile.in:

2011-09-16  Jan Nijtmans  <nijtmans@users.sf.net>

	IMPLEMENTATION OF TIP #388

	* doc/Tcl.n:
	* doc/re_syntax.n:
	* generic/regc_lex.c:
	* generic/regcomp.c:
	* generic/regcustom.h:
	* generic/tcl.h:
	* generic/tclParse.c:
	* tests/reg.test:
	* tests/utf.test:

2011-09-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
	Corrected the handling of procedure error messages (found by TclOO).

2011-09-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:        Don't change Tcl_UniChar type when
	* generic/regcustom.h:  TCL_UTF_MAX == 4 (not supported anyway)

2011-09-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]:
	Ensemble-like rewriting of error messages is complex, and TclOO (in
	combination with iTcl) hits the most tricky cases.

	* library/http/http.tcl (http::geturl): [Bug 3391977]: Ensure that the
	-headers option overrides the -type option (important because -type
	has a default that is not always appropriate, and the header must not
	be duplicated).

2011-09-15  Don Porter  <dgp@users.sourceforge.net>

	* 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  <dgp@users.sourceforge.net>

	* 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  <nijtmans@users.sf.net>

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

2011-09-11  Don Porter  <dgp@users.sourceforge.net>

	* 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  <dgp@users.sourceforge.net>

	* tests/chanio.test:	[Bug 3389733]: Convert [testthread] use to
	* tests/io.test:	Thread package use in *io-70.1.  Eliminates a
	memory leak in `make valgrind`.

2011-09-07  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompExpr.c: [Bug 3401704]: Allow function names like
	* tests/parseExpr.test:	 influence(), nanobot(), and 99bottles() that
	have been parsed as missing operator syntax errors before with the
	form NUMBER + FUNCTION.
	***POTENTIAL INCOMPATIBILITY***

2011-09-06  Venkat Iyer <venkat@comit.com>

	* library/tzdata/America/Goose_Bay: Update to Olson's tzdata2011i
	* library/tzdata/America/Metlakatla:
	* library/tzdata/America/Resolute:
	* library/tzdata/America/St_Johns:
	* library/tzdata/Europe/Kaliningrad:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Honolulu:
	* library/tzdata/Africa/Juba: (new)

2011-09-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:   [RFE 1711975]: Tcl_MainEx() (like Tk_MainEx())
	* generic/tclDecls.h:
	* generic/tclMain.c:

2011-09-02  Don Porter  <dgp@users.sourceforge.net>

	* tests/http.test:	Convert [testthread] use to Thread package use.
	Eliminates memory leak seen in `make valgrind`.

2011-09-01  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* unix/tclUnixSock.c: [Bug 3401422]: Cache script-level changes to the
	nonblocking flag of an async client socket in progress, and commit
	them on completion.

2011-09-01  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStrToD.c:	[Bug 3402540]: Corrections to TclParseNumber()
	* tests/binary.test:	to make it reject invalid Nan(Hex) strings.

	* tests/scan.test:	[scan Inf %g] is portable; remove constraint.

2011-08-30  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclInterp.c (SlaveCommandLimitCmd, SlaveTimeLimitCmd):
	[Bug 3398794]: Ensure that low-level conditions in the limit API are
	enforced at the script level through errors, not a Tcl_Panic. This
	means that interpreters cannot read their own limits (writing already
	did not work).

2011-08-30  Reinhard Max  <max@suse.de>

	* unix/tclUnixSock.c (TcpWatchProc): [Bug 3394732]: Put back the check
	for server sockets.

2011-08-29  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIORTrans.c: Leak of ReflectedTransformMap.

2011-08-27  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:  [RFE 3396731]: Revise the [string reverse]
	* tests/string.test:	implementation to operate on the representation
	that comes in, avoid conversion to other reps.

2011-08-23  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIORChan.c:	[Bug 3396948]: Leak of ReflectedChannelMap.

2011-08-19  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIORTrans.c: [Bugs 3393279, 3393280]: ReflectClose(.) is
	missing Tcl_EventuallyFree() calls at some of its exits.

	* generic/tclIO.c: [Bugs 3394654, 3393276]: Revise FlushChannel() to
	account for the possibility that the ChanWrite() call might recycle
	the buffer out from under us.

	* generic/tclIO.c: Preserve the chanPtr during FlushChannel so that
	channel drivers don't yank it away before we're done with it.

2011-08-19  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclTest.c: [Bug 2981154]: async-4.3 segfault.
	* tests/async.test:  [Bug 1774689]: async-4.3 sometimes fails.

2011-08-18  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c: [Bug 3096275]: Sync fcopy buffers input.

2011-08-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclUniData.c: [Bug 3393714]: Overflow in toupper delta
	* tools/uniParse.tcl:
	* tests/utf.test:

2011-08-17  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c:  [Bug 2946474]: Consistently resume backgrounded
	* tests/ioCmd.test: flushes+closes when exiting.

2011-08-17  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* doc/interp.n: Document TIP 378's one-way-ness.

2011-08-17  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclGet.c: [Bug 3393150]: Overlooked free of intreps.
	(It matters for bignums!)

2011-08-16  Don Porter  <dgp@users.sourceforge.net>
2011-08-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCompile.c: [Bug 3392070]: More complete prevention of
	Tcl_Obj reference cycles when producing an intrep of ByteCode.

	* generic/tclCmdAH.c:    [Bug 3388350]: mingw64 compiler warnings
	* generic/tclFCmd.c      In mingw, sys/stat.h must be included
	* generic/tclFileName.c  before winsock2.h, so make sure of that.
2011-08-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclListObj.c (TclLindexList, TclLsetFlat): Silence warnings
	* generic/tclIOUtil.c
	* generic/tclBasic.c
	about (unreachable) cases of uninitialized variables.
	* generic/tclCmdIL.c (SelectObjFromSublist): Improve the generation of
	* generic/tclIndexObj.c (Tcl_ParseArgsObjv): messages through the use
	* generic/tclVar.c (ArrayStartSearchCmd):    of Tcl_ObjPrintf.
	* generic/tclBinary.c
	* generic/tclHash.c
	* generic/tclTest.c
	* win/tclWinChan.c
	* win/tclWinConsole.c
	* win/tclWinDde.c
	* win/tclWinFile.c
	* win/tclWinReg.c
	* win/tclWinSerial.c
	* win/tclWinSock.c
	* win/tclWinThrd.c

2011-08-15  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c: [Bug 3390272]: Leak of [info script] value.

2011-08-15  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPosixStr.c:    [Bug 3388350]: mingw64 compiler warnings
	* generic/tclStrToD.c
	* win/tclWinPort.h:
	* win/tclWinPipe.c:
	* win/tclWinSock.c:
	* win/configure.in:
	* win/configure:

2011-08-14  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/FindExec.3: [Patch 3124554]: Move WishPanic from Tk to Tcl
	* doc/Panic.3     Added Documentation

2011-08-12  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c:	[Bug 3389764]: Eliminate possibility that dup
	of a "path" value can create reference cycle.

2011-08-12  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ZlibTransformOutput): [Bug 3390073]: Return the
	correct length of written data for a compressing transform.

2011-08-10 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclTestObj.c: [Bug 3386721]: Allow multiple [load]ing of the
	Tcltest package.

2011-08-09 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclBasic.c: [Bug 2919042]: Restore "valgrindability" of Tcl
	* generic/tclEvent.c: that was lost by the streamlining of [exit], by
	* generic/tclExecute.c: conditionally forcing a full Finalize:
	* generic/tclInt.h:  use -DPURIFY or ::env(TCL_FINALIZE_ON_EXIT)

2011-08-09 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclCompCmds.c: [Bug 3386417]: Avoid a reference loop between
	* generic/tclInt.h:      the bytecode and its companion errostack
	* generic/tclResult.c:   when compiling a syntax error.

2011-08-09  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinConsole.c: [Bug 3388350]: mingw64 compiler warnings
	* win/tclWinDde.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:

2011-08-09  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.h: Change the signature of TclParseHex(), such that
	* generic/tclParse.c: it can now parse up to 8 hex characters.

2011-08-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ZlibStreamCmd): Make the -buffersize option to
	'$zstream add' function correctly instead of having its value just be
	discarded unceremoniously. Also generate error codes from more of the
	code, not just the low-level code but also the Tcl infrastructure.

2011-08-07  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory
	leak in call chain introspection.

2011-08-06  Kevin B, Kenny  <kennykb@acm.org>

	* generic/tclAssemnbly.c: [Bug 3384840]: Plug another memory leak.
	* generic/tclStrToD.c: [Bug 3386975]: Plug another memory leak.

2011-08-05  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclStrToD.c: [Bug 3386975]: Plugged a memory leak in
	double->string conversion.

2011-08-05  Don Porter  <dgp@users.sourceforge.net>

	*** 8.6b2 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6b2 release.

2011-08-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclAssembly.c (AssembleOneLine): Ensure that memory isn't
	leaked when an unknown instruction is encountered. Also simplify code
	through use of Tcl_ObjPrintf in error message generation.

	* generic/tclZlib.c (ZlibTransformClose): [Bug 3386197]: Plug a memory
	leak found by Miguel with valgrind, and ensure that the correct
	direction's buffers are released.

2011-08-04  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclVar.c (TclPtrSetVar): Fix valgrind-detected error when
	newValuePtr is the interp's result obj.

2011-08-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclAssembly.c (FreeAssemblyEnv): [Bug 3384840]: Plug another
	possible memory leak due to over-complex code for freeing the table of
	labels.

2011-08-04  Reinhard Max  <max@suse.de>

	* generic/tclIOSock.c (TclCreateSocketAddress): Don't bother using
	AI_ADDRCONFIG for now, as it was causing problems in various
	situations.

2011-08-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand)
	(GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]:
	A Tcl_Obj is allocated by GetNextOperand, so callers of it must not
	hold a reference to one in the 'out' parameter when calling it. This
	was causing a great many memory leaks.
	* tests/assemble.test (assemble-51.*): Added group of memory leak
	tests.

2011-08-02  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6b2 release.
	* tools/tcltk-man2html.tcl: Variable substitution botch.

2011-08-02  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclObj.c (Tcl_DbIncrRefCount, Tcl_DbDecrRefCount)
	(Tcl_DbIsShared): [Bug 3384007]: Fix the panic messages so they share
	what should be shared and have the right number of spaces.

2011-08-01  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclProc.c (TclProcCompileProc): [Bug 3383616]: Fix for leak
	of resolveInfo when recompiling procs. Thanks go to Gustaf Neumann for
	detecting the bug and providing the fix.

2011-08-01  Donal K. Fellows  <dkf@users.sf.net>

	* doc/tclvars.n (EXAMPLES): Added some examples of how some of the
	standard global variables can be used, following prompting by a
	request by Robert Hicks.

	* tools/tcltk-man2html.tcl (plus-pkgs): [Bug 3382474]: Added code to
	determine the version number of contributed packages from their
	directory names so that HTML documentation builds are less confusing.

2011-07-29  Donal K. Fellows  <dkf@users.sf.net>

	* tools/tcltk-man2html.tcl (ensemble_commands, remap_link_target):
	Small enhancements to improve cross-linking with contributed packages.
	* tools/tcltk-man2html-utils.tcl (insert-cross-references): Enhance to
	cope with contributed packages' C API.

2011-07-28  Reinhard Max  <max@suse.de>

	* unix/tcl.m4 (SC_TCL_IPV6): Fix AC_DEFINE invocation for
	NEED_FAKE_RFC2553.
	* unix/configure:	autoconf-2.59

2011-07-28  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6b2 release.

	* library/tzdata/Asia/Anadyr: Update to Olson's tzdata2011h
	* library/tzdata/Asia/Irkutsk:
	* library/tzdata/Asia/Kamchatka:
	* library/tzdata/Asia/Krasnoyarsk:
	* library/tzdata/Asia/Magadan:
	* library/tzdata/Asia/Novokuznetsk:
	* library/tzdata/Asia/Novosibirsk:
	* library/tzdata/Asia/Omsk:
	* library/tzdata/Asia/Sakhalin:
	* library/tzdata/Asia/Vladivostok:
	* library/tzdata/Asia/Yakutsk:
	* library/tzdata/Asia/Yekaterinburg:
	* library/tzdata/Europe/Kaliningrad:
	* library/tzdata/Europe/Moscow:
	* library/tzdata/Europe/Samara:
	* library/tzdata/Europe/Volgograd:
	* library/tzdata/America/Kralendijk: (new)
	* library/tzdata/America/Lower_Princes: (new)

2011-07-26  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (initScript): Ensure that TclOO is properly found by
	all the various package mechanisms (by adding a dummy ifneeded script)
	and not just some of them.

2011-07-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinPort.h: [Bug 3372130]: Fix hypot math function with MSVC10

2011-07-19  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclUtil.c:	[Bug 3371644]: Repair failure to properly handle
	* tests/util.test: (length == -1) scanning in TclConvertElement().
	Thanks to Thomas Sader and Alexandre Ferrieux.

2011-07-19  Donal K. Fellows  <dkf@users.sf.net>

	* doc/*.3, doc/*.n: Many small fixes to documentation as part of
	project to improve quality of generated HTML docs.

	* tools/tcltk-man2html.tcl (remap_link_target): More complete set of
	definitions of link targets, especially for major C API types.
	* tools/tcltk-man2html-utils.tcl (output-IP-list, cross-reference):
	Update to generation to produce proper HTML bulleted and enumerated
	lists.

2011-07-19 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* doc/upvar.n: Undocument long gone limitation of [upvar].

2011-07-18  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump version number to 8.6b2.
	* library/init.tcl:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* tools/tcl.wse.in:
	* README:

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

2011-07-15  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is
	called in a deleted interp.
	* 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  <dkf@users.sf.net>

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

2011-07-12  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclUnixSock.c:  [Bug 3364777]: Stop segfault caused by
	reading from struct after it had been freed.

2011-07-11  Joe Mistachkin  <joe@mistachkin.com>

	* generic/tclExecute.c: [Bug 3339502]: Correct cast for CURR_DEPTH to
	silence compiler warning.

2011-07-08  Donal K. Fellows  <dkf@users.sf.net>

	* doc/http.n: [FRQ 3358415]: State what RFC defines HTTP/1.1.

2011-07-07  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c: Add missing INT2PTR

2011-07-03  Donal K. Fellows  <dkf@users.sf.net>

	* doc/FileSystem.3: Corrected statements about ctime field of 'struct
	stat'; that was always the time of the last metadata change, not the
	time of creation.

2011-07-02  Kevin B. Kenny  <kennykb@acm.org>
2659
2660
2661
2662
2663
2664
2665
2666

2667
2668
2669
2670
2671





2672

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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761




2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
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
1439




1440
1441
1442
1443












1444
1445
1446
1447
1448





1449
1450
1451
1452
1453
1454
1455
1456
1457
1458







1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471







1472
1473
1474
1475
1476





1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491


1492
1493
1494
1495
1496
1497
1498







-
+

-
-
-
-
+
+
+
+
+

+
-
-
+
+











-
+

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

-
+
+









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-
-





-
-
-
-
-
-
-
-


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





-
-
-
-
-










-
-
-
-
-
-
-













-
-
-
-
-
-
-





-
-
-
-
-















-
-







	* unix/Makefile.in:
	* win/Makefile.in:
	* win/Makefile.vc:
	[Bug 3349507]: Fix a bug where bignum->double conversion is "round up"
	and not "round to nearest" (causing expr double(1[string repeat 0 23])
	not to be 1e+23).

2011-06-28  Reinhard Max  <max@suse.de>
2011-06-30  Reinhard Max  <max@suse.de>

	* 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].
	* unix/configure.in: Add a volatile declaration to the test for
	TCL_STACK_GROWS_UP to prevent gcc 4.6 from producing invalid
	results due to aggressive optimisation.

2011-06-23  Don Porter  <dgp@users.sourceforge.net>

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

	* changes:	Update for 8.5.10 release.

2011-06-22  Andreas Kupries  <andreask@activestate.com>

	* 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  <max@suse.de>
2011-06-21  Don Porter  <dgp@users.sourceforge.net>

	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.
	* changes:	Update for 8.5.10 release.

	* library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter):
	* library/tcltest/pkgIndex.tcl: Backport tcltest 2.3.3 for release
	* unix/Makefile.in: with Tcl 8.5.*.
	* win/Makefile.in:
	* 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  <dgp@users.sourceforge.net>
	* tests/init.test:	Update test files to use new command.
	* tests/pkg.test:

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

2011-06-13  Don Porter  <dgp@users.sourceforge.net>

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

2011-06-08  Andreas Kupries  <andreask@activestate.com>

	* 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  <dkf@users.sf.net>

	* 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  <nijtmans@users.sf.net>

	* 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  <dgp@users.sourceforge.net>

	* 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  <dkf@users.sf.net>

	* 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  <msofer@users.sf.net>

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

2011-06-01  Jan Nijtmans  <nijtmans@users.sf.net>

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

2011-05-31  Don Porter  <dgp@users.sourceforge.net>

	* 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  <dgp@users.sourceforge.net>

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

2011-05-25  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.h (TCLOO_VERSION): Bump version.

	IMPLEMENTATION OF TIP#381.

	* doc/next.n, doc/ooInfo.n, doc/self.n, generic/tclOO.c,
	* generic/tclOOBasic.c, generic/tclOOCall.c, generic/tclOOInfo.c,
	* generic/tclOOInt.h, tests/oo.test, tests/ooNext2.test: Added
	introspection of call chains ([self call], [info object call], [info
	class call]) and ability to skip ahead in chain ([nextto]).

2011-05-24  Venkat Iyer <venkat@comit.com>

	* library/tzdata/Africa/Cairo: Update to Olson tzdata2011g

2011-05-24  Donal K. Fellows  <dkf@users.sf.net>

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

2011-05-17  Andreas Kupries  <andreask@activestate.com>

	* 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  <max@suse.de>

	* 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  <dgp@users.sourceforge.net>

	* 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:

2011-05-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclNamesp.c (NamespacePathCmd): Convert to use Tcl_Obj API
	* generic/tclPkg.c (Tcl_PackageObjCmd):   for result generation in
	* generic/tclTimer.c (Tcl_AfterObjCmd):   [after info], [namespace
	path] and [package versions].

2011-05-09  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclListObj.c:	Revise empty string tests so that we avoid
	potentially expensive string rep generations, especially for dicts.

2011-05-07  Donal K. Fellows  <dkf@users.sf.net>

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

2011-05-07  Miguel Sofer  <msofer@users.sf.net>

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

2011-05-05  Don Porter  <dgp@users.sourceforge.net>

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

2011-05-03  Don Porter  <dgp@users.sourceforge.net>

	* 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  <dgp@users.sourceforge.net>

	* 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
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
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
1508
1509
1510
1511
1512
1513
1514

1515
1516
1517
1518
1519
1520

1521
1522



1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538

1539
1540

1541
1542


1543
1544
1545
1546




1547
1548
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
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

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
1668
1669
1670










1671
1672
1673
1674
1675
1676
1677
1678
1679























1680
1681
1682

1683
1684
1685
1686
1687
1688
1689
1690







-
+





-
+

-
-
-
+
+
+













-
+

-
+

-
-
+
+
+

-
-
-
-
+
+
+
+
+
+



-
-








-

















+
+
+
+
+
+
+
+
















-
-
-
-
-


-
-
+
+
+
-
+

















-
-
-
-
-
-


+
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+







	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
	* generic/tclCompCmds.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/tclCompCmds.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.
	* generic/tclCompCmds.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  <dgp@users.sourceforge.net>

	* 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  <dgp@users.sourceforge.net>

2011-04-27  Don Porter  <dgp@users.sourceforge.net>
	* generic/tclListObj.c:	FreeListInternalRep() cleanup.

	* generic/tclCmdMZ.c:	TclFreeIntRep() correction & cleanup.
	* generic/tclExecute.c:
	* generic/tclBinary.c:	Backport fix for [Bug 2857044].
	* generic/tclDictObj.c:	All freeIntRepProcs set typePtr to NULL.
	* generic/tclEncoding.c:
	* generic/tclIndexObj.c:
	* generic/tclInt.h:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclResult.c:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclPathObj.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclStringObj.c:
	* generic/tclVar.c:

	* generic/tclListObj.c:	FreeListInternalRep() cleanup.

2011-04-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclInt.h:	Use macro to set List intreps.
	* generic/tclListObj.c:

	* generic/tclCmdIL.c:	Limits on list length were too strict.
	* generic/tclInt.h:	Revised panics to errors where possible.
	* generic/tclListObj.c:
	* tests/lrepeat.test:

	* generic/tclCompile.c:	Make sure SetFooFromAny routines react
	* generic/tclIO.c:	reasonably when passed a NULL interp.
	* generic/tclIndexObj.c:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* macosx/tclMacOSXFCmd.c:

2011-04-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:       fix for [Bug 3288345]: Wrong Tcl_StatBuf
	* generic/tclInt.h:    used on MinGW. Make sure that all _WIN32
	* win/tclWinFile.c:    compilers use exactly the same layout
	* win/configure.in:    for Tcl_StatBuf - the one used by MSVC6 -
	* win/configure:       in all situations.

2011-04-20  Andreas Kupries  <andreask@activestate.com>

	* generic/tclFCmd.c (TclFileAttrsCmd): Added commands to reset the
	typePtr of the Tcl_Obj* whose int-rep was just purged. Required to
	prevent a dangling IndexRep* to reused, smashing the heap. See
	also the entries at 2011-04-16 and 2011-03-24 for the history of
	the problem.

2011-04-19  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclConfig.c:	Reduce internals access in the implementation
	of [<foo>::pkgconfig list].

2011-04-18  Don Porter  <dgp@users.sourceforge.net>

	* 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  <dkf@users.sf.net>

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

2011-04-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclFCmd.c (TclFileAttrsCmd): Add comments to make this code
	easier to understand. Added a panic to handle the case where the VFS
	* generic/tclFCmd.c (TclFileAttrsCmd): Tidied up the memory management
	a bit to try to ensure that the dynamic and static cases don't get
	confused while still promoting caching where possible. Added a panic
	layer does something odd.
	to trap problems in the case where an extension is misusing the API.

2011-04-13  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclUtil.c:	[Bug 3285375]: Rewrite of Tcl_Concat*()
	routines to prevent segfaults on buffer overflow.  Build them out of
	existing primitives already coded to handle overflow properly.  Uses
	the new TclTrim*() routines.

	* generic/tclCmdMZ.c:	New internal utility routines TclTrimLeft()
	* generic/tclInt.h:	and TclTrimRight().  Refactor the
	* generic/tclUtil.c:	[string trim*] implementations to use them.

2011-04-13  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclVar.c: [Bug 2662380]: Fix crash caused by appending to a
	variable with a write trace that unsets it.

2011-04-13  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclUtil.c (Tcl_ConcatObj): [Bug 3285375]: Make the crash
	less mysterious through the judicious use of a panic. Not yet properly
	fixed, but at least now clearer what the failure mode is.

2011-04-12  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	[Bug 3285472]: Repair corruption in
	* tests/string.test:	Test for [Bug 3285472]. Not buggy in trunk.
	* tests/string.test:	[string reverse] when string rep invalidation
	failed to also reset the bytes allocated for string rep to zero.

2011-04-12  Venkat Iyer <venkat@comit.com>

	* library/tzdata/Atlantic/Stanley: Update to Olson tzdata2011f

2011-04-12  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c: Fix for [Bug 2440625], kbk's patch

2011-04-11  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:
	* tests/coroutine.test: [Bug 3282869]: Ensure that 'coroutine eval'
	runs the initial command in the proper context.

2011-04-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:    Fix for [Bug 3281728]: Tcl sources from 2011-04-06
	* unix/tcl.m4:      do not build on GCC9 (RH9)
	* unix/configure:

2011-04-08  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinPort.h: Fix for [Bug 3280043]: win2k: unresolved DLL
	* win/configure.in: imports.
	* win/configure

2011-04-06  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (TclCompileObj): Earlier return if Tip280
	* generic/tclExecute.c (TclCompEvalObj): Earlier return if Tip280
	gymnastics not needed.

	* generic/tclExecute.c: Fix for [Bug 3274728]: making *catchTop an
	unsigned long.

2011-04-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclAppInit.c:  Make symbols "main" and "Tcl_AppInit"
	MODULE_SCOPE: there is absolutely no reason for exporting them.
	* unix/tcl.m4:        Don't use -fvisibility=hidden with static
	* unix/configure      libraries (--disable-shared)

2011-04-06  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclFCmd.c, macosx/tclMacOSXFCmd.c, unix/tclUnixChan.c,
	* unix/tclUnixFCmd.c, win/tclWinChan.c, win/tclWinDde.c,
	* win/tclWinFCmd.c, win/tclWinLoad.c, win/tclWinPipe.c,
	* win/tclWinReg.c, win/tclWinSerial.c, win/tclWinSock.c: More
	generation of error codes (most platform-specific parts not already
	using Tcl_PosixError).

2011-04-05  Venkat Iyer <venkat@comit.com>

	* library/tzdata/Africa/Casablanca: Update to Olson's tzdata2011e
	* library/tzdata/America/Santiago:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/America/Metlakatla: (new)
	* library/tzdata/America/North_Dakota/Beulah: (new)
	* library/tzdata/America/Sitka: (new)

2011-04-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c, generic/tclOOBasic.c, generic/tclOODefineCmds.c
	* generic/tclOOInfo.c, generic/tclOOMethod.c: More generation of
	error codes (TclOO miscellany).

	* generic/tclCmdAH.c, generic/tclCmdIL.c: More generation of error
	codes (miscellaneous commands mostly already handled).

2011-04-04  Don Porter  <dgp@users.sourceforge.net>

	* README:	[Bug 3202030]: Updated README files, repairing broken
	* macosx/README:URLs and removing other bits that were clearly wrong.
	* unix/README:	Still could use more eyeballs on the detailed build
	* win/README:	advice on various plaforms.

2011-04-04  Donal K. Fellows  <dkf@users.sf.net>

	* library/init.tcl (tcl::mathfunc::rmmadwiw): Disable by default to
	make test suite work.

	* generic/tclBasic.c, generic/tclStringObj.c, generic/tclTimer.c,
	* generic/tclTrace.c, generic/tclUtil.c: More generation of error
	codes ([format], [after], [trace], RE optimizer).

2011-04-04  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCmdAH.c:  Better error-message in case of errors
	* generic/tclCmdIL.c:  related to setting a variable. This fixes
	* generic/tclDictObj.c: a warning: "Why make your own error
	* generic/tclScan.c:   message? Why?"
	* generic/tclTest.c:
	* test/error.test:
	* test/info.test:
	* test/scan.test:
	* unix/tclUnixThrd.h:  Remove this unused header file.

2011-04-03  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclNamesp.c, generic/tclObj.c, generic/tclPathObj.c:
	* generic/tclPipe.c, generic/tclPkg.c, generic/tclProc.c:
	* generic/tclScan.c: More generation of error codes (namespace
	creation, path normalization, pipeline creation, package handling,
	procedures, [scan] formats)

2011-04-02  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclStrToD.c (QuickConversion): Replaced another couple
	of 'double' declarations with 'volatile double' to work around
	misrounding issues in mingw-gcc 3.4.5.

2011-04-02  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclInterp.c, generic/tclListObj.c, generic/tclLoad.c:
	More generation of errorCodes ([interp], [lset], [load], [unload]).

	* generic/tclEvent.c, generic/tclFileName.c: More generation of
	errorCode information (default [bgerror] and [glob]).

2011-04-01  Reinhard Max  <max@suse.de>

	* library/init.tcl: TIP#131 implementation.

2011-03-31  Donal K. Fellows  <dkf@users.sf.net>

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

2011-03-28  Donal K. Fellows  <dkf@users.sf.net>

	* 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  <msofer@users.sf.net>

	* 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  <dkf@users.sf.net>

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

	* generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c:
	* generic/tclListObj.c, generic/tclNamesp.c, generic/tclObj.c:
	* generic/tclStringObj.c, generic/tclUtil.c: Reduce the number of
	casts used to manage Tcl_Obj internal representations.

2011-03-24  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h (ckfree,etc.): Restored C++ usability to the memory
	allocation and free macros.

2011-03-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclFCmd.c (TclFileAttrsCmd): Ensure that any reference to
	temporary index tables is squelched immediately rather than hanging
	around to trip us up in the future.

2011-03-23  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclObj.c: Exploit HAVE_FAST_TSD for the deletion context in
	TclFreeObj()

2011-03-22  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclThreadAlloc.c: Simpler initialization of Cache under
	HAVE_FAST_TSD, from mig-alloc-reform.

2011-03-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclLoadDl.c:    [Bug 3216070]: Loading extension libraries
	* unix/tclLoadDyld.c:  from embedded Tcl applications.
	***POTENTIAL INCOMPATIBILITY***
	For extensions which rely on symbols from other extensions being
	present in the global symbol table. For an example and some discussion
	of workarounds, see http://stackoverflow.com/q/8330614/301832

2011-03-21  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCkAlloc.c:
	* generic/tclInt.h: Remove one level of allocator indirection in
	non-memdebug builds, imported from mig-alloc-reform.

2011-03-20  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclThreadAlloc.c: Imported HAVE_FAST_TSD support from
	mig-alloc-reform. The feature has to be enabled by hand: no autoconf
	support has been added. It is not clear how universal a build using
	this will be: it also requires some loader support.

2011-03-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompExpr.c (ParseExpr): Generate errorCode information on
	failure to parse expressions.

2011-03-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclMain.c: [Patch 3124683]: Reorganize the platform-specific
	stuff in (tcl|tk)Main.c.

2011-03-16  Jan Nijtmans  <nijtmans@users.sf.net>

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

2011-03-16  Don Porter  <dgp@users.sourceforge.net>

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

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
3775
3776
3777


3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796












3797
3798
3799
3800
3801
3802

3803
3804
3805





3806
3807

3808

3809

3810


3811
3812
3813




3814

3815
3816
3817

3818
3819

3820
3821
3822
3823
3824
3825
3826

3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852

3853
3854
3855
3856
3857

3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
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
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


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
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







-
-
-
-
-
-
-

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










-
-
-
-
-



-
-
-
-
-









-
-
-
-
-




-











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







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



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





-
-
+
-
-
+




+
+
+
















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




-
+

-
+

-
-
-
+
-
-
+
-
-

-
+

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





-
-
-
-
-
-








-
+

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






-
-
-
-
-
-
-
-
-
-


-
-
+
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-








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

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







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





-
+

-
-
+
+
+
+
+

-
+

+
-
+
-
+
+



+
+
+
+
-
+


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





-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
+




-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	* library/tzdata/America/Juneau:
	* library/tzdata/America/Santiago:
	* library/tzdata/Europe/Istanbul:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Honolulu:  tzdata2011d

	* generic/tclAssembly.c (BBEmitInstInt1): Changed parameter data types
	in an effort to silence a MSVC warning reported by Ashok P. Nadkarni.
	Unable to test, since both forms work on my machine in VC2005, 2008,
	2010, in both release and debug builds.
	* tests/tclTest.c (TestdstringCmd): Restored MSVC buildability broken
	by [5574bdd262], which changed the effective return type of 'ckalloc'
	from 'char*' to 'void*'.

2011-03-13  Miguel Sofer  <msofer@users.sf.net>

	* unix/configure.in: [Bug 3205320]: stack space detection defeated by inlining
	* generic/tclExecute.c: remove TEBCreturn()

	* unix/configure:    (autoconf-2.59)
2011-03-12  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tcl.h (ckalloc,ckfree,ckrealloc): Moved casts into these
	macro so that they work with VOID* (which is a void* on all platforms
	which Tcl actually builds on) and unsigned int for the length
	parameters, removing the need for MANY casts across the rest of Tcl.
	Note that this is a strict source-level-only change, so size_t cannot
	be used (would break binary compatibility on 64-bit platforms).

2011-03-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFile.c: [Bug 3185609]: File normalization corner case
	of ... broken with -DUNICODE

2011-03-11  Donal K. Fellows  <dkf@users.sf.net>

	* tests/unixInit.test: Make better use of tcltest2.

2011-03-10  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c, generic/tclCompCmds.c, generic/tclEnsemble.c:
	* generic/tclInt.h, generic/tclNamesp.c, library/auto.tcl:
	* tests/interp.test, tests/namespace.test, tests/nre.test:
	Converted the [namespace] command into an ensemble. This has the
	consequence of making it vital for Tcl code that wishes to work with
	namespaces to _not_ delete the ::tcl namespace.
	***POTENTIAL INCOMPATIBILITY***

	* library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter): Added this
	command to handle connecting tcltest to a slave interpreter. This adds
	in the hook (inside the tcltest namespace) that allows the tests run
	in the child interpreter to be reported as part of the main sequence
	of test results. Bumped version of tcltest to 2.3.3.
	* tests/init.test, tests/package.test: Adapted these test files to use
	the new feature.

	* generic/tclAlloc.c, generic/tclCmdMZ.c, generic/tclCompExpr.c:
	* generic/tclCompile.c, generic/tclEnv.c, generic/tclEvent.c:
	* generic/tclIO.c, generic/tclIOCmd.c, generic/tclIORChan.c:
	* generic/tclIORTrans.c, generic/tclLiteral.c, generic/tclNotify.c:
	* generic/tclParse.c, generic/tclStringObj.c, generic/tclUtil.c:
	* generic/tclZlib.c, unix/tclUnixFCmd.c, unix/tclUnixNotfy.c:
	* unix/tclUnixPort.h, unix/tclXtNotify.c: Formatting fixes, mainly to
	comments, so code better fits the style in the Engineering Manual.

2011-03-09  Donal K. Fellows  <dkf@users.sf.net>

	* tests/incr.test: Update more of the test suite to use Tcltest 2.

2011-03-09  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclNamesp.c:	[Bug 3202171]: Tighten the detector of nested
	* tests/namespace.test:	[namespace code] quoting that the quoted
	scripts function properly even in a namespace that contains a custom
	"namespace" command.

	* doc/tclvars.n:	Formatting fix.  Thanks to Pat Thotys.

2011-03-09  Donal K. Fellows  <dkf@users.sf.net>

	* tests/dstring.test, tests/init.test, tests/link.test: Update more of
	the test suite to use Tcltest 2.

2011-03-08  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBasic.c: Fix gcc warnings: variable set but not used
	* generic/tclProc.c:
	* generic/tclIORChan.c:
	* generic/tclIORTrans.c:
	* generic/tclAssembly.c:  Fix gcc warning: comparison between signed
	and unsigned integer expressions

2011-03-08  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclInt.h:	Remove TclMarkList() routine, an experimental
	* generic/tclUtil.c:	dead-end from the 8.5 alpha days.

	* generic/tclResult.c (ResetObjResult): [Bug 3202905]: Correct failure
	to clear invalid intrep.  Thanks to Colin McDonald.

2011-03-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclAssembly.c, tests/assemble.test: Migrate to use a style
	more consistent with the rest of Tcl.

2011-03-06  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c:	More replacements of Tcl_UtfBackslash() calls
	* generic/tclCompile.c:	with TclParseBackslash() where possible.
	* generic/tclCompCmdsSZ.c:
	* generic/tclParse.c:
	* generic/tclUtil.c:

	* generic/tclUtil.c (TclFindElement):	[Bug 3192636]: Guard escape
	sequence scans to not overrun the string end.

2011-03-05  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclParse.c (TclParseBackslash): [Bug 3200987]: Correct
	* tests/parse.test:	trunction checks in \x and \u substitutions.

2011-03-05  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (TclStackFree): insure that the execStack
	satisfies "at most one free stack after the current one" when
	consecutive reallocs caused the creation of intervening stacks.

2011-03-05  Kevin B. Kenny  <kennykb@acm.org>

	* 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  <msofer@users.sf.net>

	* 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  <dkf@users.sf.net>

	* 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  <msofer@users.sf.net>

	* 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  <dgp@users.sourceforge.net>

	* 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.

2011-03-01  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCompCmdsSZ.c (TclCompileThrowCmd, TclCompileUnsetCmd):
	fix leaks

	* generic/tclBasic.c:       This is [Patch 3168398],
	* generic/tclCompCmdsSZ.c:  Joe Mistachkin's optimisation
	* generic/tclExecute.c:     of Tip #285
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclInterp.c:
	* generic/tclOODecls.h:
	* generic/tclStubInit.c:
	* win/makefile.vc:

	* 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  <dkf@users.sf.net>

	* generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance)
	(TclOOObjectCmdCore, FinalizeObjectCall):
	* generic/tclOOBasic.c (TclOO_Object_Destroy, AfterNRDestructor):
	* generic/tclOOCall.c (TclOODeleteContext, TclOOGetCallContext):
	Reorganization of call context reference count management so that code
	is (mostly) simpler.

2011-01-26  Donal K. Fellows  <dkf@users.sf.net>

	* doc/RegExp.3: [Bug 3165108]: Corrected documentation of description
	of subexpression info in Tcl_RegExpInfo structure.

2011-01-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPreserve.c:  Don't miss 64-bit address bits in panic
	* generic/tclCkalloc.c:  [Bug 3129448]: Possible over-allocation on
				  message.
	* win/tclWinChan.c:       Fix various gcc-4.5.2 64-bit warning
	* win/tclWinConsole.c:    messages, e.g. by using full 64-bits for
	* win/tclWinDde.c:	  socket fd's
	* win/tclWinPipe.c:
	* win/tclWinReg.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* win/tclWinThrd.c:
	* generic/tclHash.c:     64-bit platforms, part 2, backported
	* generic/tclProc.c:     strcpy->memcpy change but not change in any
				 struct.

2011-01-19 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclExecute.c: [Bug 3138178]: Backport of Miguel's 2010-09-22
	fix on 8.6 branch (decache stack info wherever ::errorInfo may be
	updated, for trace sanity).

2011-01-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl: [FRQ 3159920]: Tcl_ObjPrintf() crashes with
	* tools/genStubs.tcl:       Make sure to use CONST/VOID in stead of
	* generic/tcl.decls   bad format specifier.
	* generic/tcl.h:
	* generic/tclDecls.h:

	* generic/tclIntDecls.h:    const/void when appropriate. This allows to
	* generic/tclIntPlatDecls.h:use const/void in the *.decls file always,
	* generic/tclTomMathDecls.h:genStubs will do the right thing.
2011-01-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make
	sure that the cmdPtr field of the procPtr is correct and relevant at
	all times so that [info frame] can report sensible information about a
	frame after a return to it from a recursive call, instead of probably
	crashing (depending on what else has overwritten the Tcl stack!)

2011-01-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBasic.c:      Various mismatches between Tcl_Panic
	* generic/tclCompCmds.c:   format string and its arguments,
	* generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920]
	* generic/tclCompExpr.c:
	* generic/tclCompExpr.c:   discovered thanks to [Bug 3159920]
	* generic/tclEnsemble.c:
	* generic/tclPreserve.c:
	* generic/tclPreserve.c:   (Backported)
	* generic/tclTest.c:

2011-01-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tcl.m4:         handle --enable-64bit=ia64 for gcc. BACKPORT.
	* win/configure:      (autoconf-2.59)
	* win/tclWin32Dll.c:  [Patch 3059922]: fixes for mingw64 - gcc4.5.1
	* generic/tclIOCmd.c: [Bug 3148192]: Commands "read/puts" incorrectly
	* tests/chanio.test:  interpret parameters. Improved error-message
	* tests/io.test       regarding legacy form.
	* tests/ioCmd.test

2011-01-15  Kevin B. Kenny  <kennykb@acm.org>

	* doc/tclvars.n:
	* generic/tclStrToD.c:
	* generic/tclUtil.c (Tcl_PrintDouble):
	* tests/util.test (util-16.*): [Bug 3157475]: Restored full Tcl 8.4
	compatibility for the formatting of floating point numbers when
	$::tcl_precision is not zero. Added compatibility tests to make sure
	that excess trailing zeroes are suppressed for all eight major code
	paths.

2011-01-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFile.c:   Use _vsnprintf in stead of vsnprintf, because
	MSVC 6 doesn't have it. Reported by andreask.
	* win/tcl.m4:         handle --enable-64bit=ia64 for gcc
	* win/configure.in:   more accurate test for correct <intrin.h>
	* 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  <kennykb@acm.org>

	* 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  <dkf@users.sf.net>

	* 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
	tcltest2 properly.

2011-01-01  Donal K. Fellows  <dkf@users.sf.net>

	* tests/cmdAH.test, tests/cmdMZ.test, tests/compExpr.test,
	* tests/compile.test, tests/concat.test, tests/eval.test,
	* tests/fileName.test, tests/fileSystem.test, tests/interp.test,
	* tests/lsearch.test, tests/namespace-old.test, tests/namespace.test,
	* tests/oo.test, tests/proc.test, tests/security.test,
	* tests/switch.test, tests/unixInit.test, tests/var.test,
	* tests/winDde.test, tests/winPipe.test: Clean up of tests and
	conversion to tcltest 2. Target has been to get init and cleanup code
	out of the test body and into the -setup/-cleanup stanzas.

	* tests/execute.test (execute-11.1): [Bug 3142026]: Added test that
	fails (with a crash) in an unfixed memdebug build on 64-bit systems.

2010-12-31  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdIL.c (SortElement): Use unions properly in the
	definition of this structure so that there is no need to use nasty
	int/pointer type punning. Made it clearer what the purposes of the
	various parts of the structure are.

2010-12-31  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/dltest/*.c: [Bug 3148192]: Fix broken [load] tests by ensuring
	that the affected files are never compiled with -DSTATIC_BUILD.

2010-12-30  Miguel Sofer  <msofer@users.sf.net>
2011-01-13  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (GrowEvaluationStack): Off-by-one error in
	sizing the new allocation - was ok in comment but wrong in the code.
	Triggered by [Bug 3142026] which happened to require exactly one more
	than what was in existence.
	than what was in existence. BACKPORT.

2010-12-26  Donal K. Fellows  <dkf@users.sf.net>
2011-01-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Fix crash when multiple -index
	options are used. Simplified memory handling logic.

	* tools/genStubs.tcl:  Fix "make genstubs", which was broken
2010-12-20  Jan Nijtmans  <nijtmans@users.sf.net>

	since 2010-11-30, the TclDoubleDigits backport.
	* win/tclWin32Dll.c:    [Patch 3059922]: fixes for mingw64 - gcc4.5.1
	tdm64-1: completed for all environments.

2010-12-20  Jan Nijtmans  <nijtmans@users.sf.net>
2010-12-31  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/configure.in:   Explicitely test for intrinsics support in
	compiler, before assuming only MSVC has it.
	* win/configure:      (autoconf-2.59)
	* generic/tclPanic.c:

	* generic/tclHash.c: [Bug 3007895]: Tcl_(Find|Create)HashEntry
	stub entries can never be called. They still cannot be called
2010-12-19  Jan Nijtmans  <nijtmans@users.sf.net>

	(no change in functionality), but at least they now do
	* win/tclWin32Dll.c:    [Patch 3059922]: fixes for mingw64 - gcc4.5.1
	tdm64-1: Fixed for gcc, not yet for MSVC 64-bit.
	exactly the same as the Tcl_(Find|Create)HashEntry macro's,
	so the confusion addressed in this Bug report is gone.
	(Backported from Tcl 8.6)

2010-12-17  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/Makefile.in:  Remove unwanted/obsolete 'ddd' target.

2010-12-17  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/Makefile.in:	Clean up '.PHONY:' targets: Arrange those
				common to Tcl and Tk as in Tk's Makefile.in,
				add any missing ones and remove duplicates.

2010-12-17  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/Makefile.in:  [Bug 2446711]: Remove 'allpatch' target.

2010-12-17  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/Makefile.in:  [Bug 2537626]: Use 'rpmbuild', not 'rpm'.

2010-12-16  Jan Nijtmans  <nijtmans@users.sf.net>
2010-12-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPanic.c:  [Patch 3124554]: Move WishPanic from Tk to Tcl
	* win/tclWinFile.c:    Better communication with debugger, if present.

	* unix/tcl.m4:    Cross-compile support for Win and UNIX (backported)
2010-12-15  Kevin B. Kenny  <kennykb@acm.org>

	* unix/configure: (autoconf-2.59)
	[dogeen-assembler-branch]

	* tclAssembly.c:
	* assemble.test: 	Reworked beginCatch/endCatch handling to
	enforce the more severe (but more correct) restrictions on catch
	handling that appeared in the discussion of [Bug 3098302] and in
	tcl-core traffic beginning about 2010-10-29.

2010-12-15  Jan Nijtmans  <nijtmans@users.sf.net>

	* 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  <nijtmans@users.sf.net>

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

2010-12-14  Reinhard Max  <max@suse.de>

	* win/tclWinSock.c (CreateSocket):         Swap the loops over
	* win/tcl.m4:
	* 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.

	* win/configure.in:
2010-12-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:    [Bug 3135271]: Link error due to hidden
	* unix/tcl.m4:      symbols (CentOS 4.2)
	* unix/configure:   (autoconf-2.59)
	* win/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  <stwo@users.sourceforge.net>

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

2010-12-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:       [Bug 3129448]: Possible over-allocation on
	* generic/tclCkalloc.c: 64-bit platforms, part 2
	* generic/tclCompile.c:
	* generic/tclHash.c:
	* generic/tclInt.h:
	* generic/tclIO.h:
	* generic/tclProc.c:

2010-12-10 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c: Make sure [fcopy -size ... -command ...] always
	* tests/io.test:   calls the callback asynchronously, even for size
	* generic/tclIO.c: [backport] Make sure [fcopy -size ... -command ...] always
	* tests/io.test:   calls the callback asynchronously, even for size zero.
			   zero.

2010-12-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBinary.c:  Fix gcc -Wextra warning: missing initializer
	* generic/tclCmdAH.c:
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclDictObj.c:
	* generic/tclIndexObj.c:
	* generic/tclIOCmd.c:
	* generic/tclVar.c:
	* win/tcl.m4:               Fix manifest-generation for 64-bit gcc
				    (mingw-w64)
	* win/configure.in:         Check for availability of intptr_t and
				    uintptr_t
	* win/configure:            (autoconf-2.59)
	* generic/tclInt.decls:     Change 1st param of TclSockMinimumBuffers
	* generic/tclIntDecls.h:    to ClientData, and TclWin(Get|Set)SockOpt
	* generic/tclIntPlatDecls.h:to SOCKET, because on Win64 those are
	* generic/tclIOSock.c:	    64-bit, which does not fit.
	* win/tclWinSock.c:
	* unix/tclUnixSock.c:

2010-12-09  Donal K. Fellows  <dkf@users.sf.net>

	* tests/fCmd.test: Improve sanity of constraints now that we don't
	support anything before Windows 2000.

	* generic/tclCmdAH.c (TclInitFileCmd, TclMakeFileCommandSafe, ...):
	Break up [file] into an ensemble. Note that the ensemble is safe in
	itself, but the majority of its subcommands are not.
	* generic/tclFCmd.c (FileCopyRename,TclFileDeleteCmd,TclFileAttrsCmd)
	(TclFileMakeDirsCmd): Adjust these subcommand implementations to work
	inside an ensemble.
	(TclFileLinkCmd, TclFileReadLinkCmd, TclFileTemporaryCmd): Move these
	subcommand implementations from tclCmdAH.c, where they didn't really
	belong.
	* generic/tclIOCmd.c (TclChannelNamesCmd): Move to more appropriate
	source file.
	* generic/tclEnsemble.c (TclMakeEnsemble): Start of code to make
	partially-safe ensembles. Currently does not function as expected due
	to various shortcomings in how safe interpreters are constructed.
	* tests/cmdAH.test, tests/fCmd.test, tests/interp.test: Test updates
	to take into account systematization of error messages.

	* tests/append.test, tests/appendComp.test: Clean up tests so that
	they don't leave things in the global environment (detected when doing
	-singleproc testing).

2010-12-07  Donal K. Fellows  <dkf@users.sf.net>

	* tests/fCmd.test, tests/safe.test, tests/uplevel.test,
	* tests/upvar.test, tests/var.test: Convert more tests to tcltest2 and
	factor them to be easier to understand.

	* generic/tclStrToD.c: Tidy up code so that more #ifdef-fery is
	quarantined at the front of the file and function headers follow the
	modern Tcl style.

2010-12-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBinary.c:  [Bug 3129448]: Possible over-allocation on
	* generic/tclCkalloc.c: 64-bit platforms.
	* generic/tclTrace.c:

2010-12-05  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4: [Patch 3116490]: Cross-compile support for unix
	* unix/configure: (autoconf-2.59)

2010-12-03  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclUtil.c (TclReToGlob): Add extra check for multiple inner
	*s that leads to poor recursive glob matching, defer to original RE
	instead.  tclbench RE var backtrack.

2010-12-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclUtil.c:   Silence gcc warning when using -Wwrite-strings
	* generic/tclStrToD.c: Silence gcc warning for non-IEEE platforms
	* win/Makefile.in:  [Patch 3116490]: Cross-compile Tcl mingw32 on unix
	* win/tcl.m4:       This makes it possible to cross-compile Tcl/Tk for
	* win/configure.in: Windows (either 32-bit or 64-bit) out-of-the-box
	* win/configure:    on UNIX, using mingw-w64 build tools (If Itcl,
	tdbc and Thread take over the latest tcl.m4, they can do that too).

2010-12-01  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclStrToD.c (SetPrecisionLimits, TclDoubleDigits):
	[Bug 3124675]: Added meaningless initialization of 'i', 'ilim' and
	'ilim1' to silence warnings from the C compiler about possible use of
	uninitialized variables, Added a panic to the 'switch' that assigns
	them, to assert that the 'default' case is impossible.

2010-12-01  Jan Nijtmans  <nijtmans@users.sf.net>

2010-11-30  Andreas Kupries  <andreask@activestate.com>
	* generic/tclBasic.c: Fix gcc 64-bit warnings: cast from pointer to
	* generic/tclHash.c:  integer of different size.
	* generic/tclTest.c:
	* generic/tclThreadTest.c:
	* generic/tclStrToD.c: Fix gcc(-4.5.2) warning: 'static' is not at
	beginning of declaration.
	* generic/tclPanic.c: Allow Tcl_Panic() to enter the debugger on win32
	* generic/tclCkalloc.c: Use Tcl_Panic() in stead of duplicating the
	code.

2010-11-30  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclInt.decls, generic/tclInt.h, generic/tclIntDecls.h:
	* generic/tclStubInit.c: TclFormatInt restored at slot 24
	* generic/tclUtil.c (TclFormatInt): restore TclFormatInt func from
	2005-07-05 macro-ization. Benchmarks indicate it is faster, as a key
	int->string routine (e.g. int-indexed arrays).

2010-11-29 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclBasic.c: Patch by Miguel, providing a
	[::tcl::unsupported::inject coroname command args], which prepends
	("injects") arbitrary code to a suspended coro's future resumption.
	Neat for debugging complex coros without heavy instrumentation.

2010-11-29  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclInt.decls: Backport of Kevin B. Kenny's work on
	* generic/tclInt.h: the Tcl Head, with help from Jeff Hobbs.
	* generic/tclStrToD.c:
	* generic/tclTest.c:
	* generic/tclTomMath.decls:
	* generic/tclUtil.c:
	* tests/util.test:
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc: Rewrite of Tcl_PrintDouble and TclDoubleDigits that
	(a) fixes a severe performance problem with floating point shimmering
	reported by Karl Lehenbauer, (b) allows TclDoubleDigits to generate
	the digit strings for 'e' and 'f' format, so that it can be used for
	tcl_precision != 0 (and possibly later for [format]), (c) fixes [Bug
	3120139] by making TclPrintDouble inherently locale-independent, (d)
	adds test cases to util.test for correct rounding in difficult cases
	of TclDoubleDigits where fixed- precision results are requested. (e)
	adds test cases to util.test for the controversial aspects of [Bug
	3105247]. As a side effect, two more modules from libtommath
	(bn_mp_set_int.c and bn_mp_init_set_int.c) are brought into the build,
	since the new code uses them.
	* win/makefile.vc: Rewrite of Tcl_PrintDouble and TclDoubleDigits
	that (a) fixes a severe performance problem with floating point
	shimmering reported by Karl Lehenbauer, (b) allows TclDoubleDigits
	to generate the digit strings for 'e' and 'f' format, so that it
	can be used for tcl_precision != 0 (and possibly later for [format]),
	(c) fixes [Bug 3120139] by making TclPrintDouble inherently
	locale-independent, (d) adds test cases to util.test for
	correct rounding in difficult cases of TclDoubleDigits where fixed-
	precision results are requested. (e) adds test cases to util.test for
	the controversial aspects of [Bug 3105247]. As a side effect, two
	more modules from libtommath (bn_mp_set_int.c and bn_mp_init_set_int.c)
	are brought into the build, since the new code uses them.

	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclTomMathDecls.h:	Regenerated.

2010-11-24  Donal K. Fellows  <dkf@users.sf.net>
2010-11-30  Jeff Hobbs  <jeffh@ActiveState.com>

	* tests/chanio.test, tests/iogt.test, tests/ioTrans.test: Convert more
	tests to tcltest2 and factor them to be easier to understand.
	* generic/tclInt.decls, generic/tclInt.h, generic/tclIntDecls.h:
	* generic/tclStubInit.c: TclFormatInt restored at slot 24
	* generic/tclUtil.c (TclFormatInt): restore TclFormatInt func from
	2005-07-05 macro-ization. Benchmarks indicate it is faster, as a
	key int->string routine (e.g. int-indexed arrays).

2010-11-20  Donal K. Fellows  <dkf@users.sf.net>
2010-11-23  Andreas Kupries  <andreask@activestate.com>

	* generic/tclVar.c (VarHashInvalidateEntry): Removed obsolete
	* tests/chanio.test: Converted many tests to tcltest2 by marking the
	  patch for AIX defining this macro as function. This is not
	setup and cleanup parts as such.
	  necessary anymore. See ChangeLog entry 2010-07-28 (Bug 3037525)
	  for the actual bug and fix the patch was a workaround for.

2010-11-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInterp.c:  fix gcc warning: passing argument 3 of
	'Tcl_GetIndexFromObj' discards qualifiers from pointer target type
	* generic/tclWinInit.c: fix gcc warning: dereferencing pointer
	'oemId' does break strict-aliasing rules
	* win/tclWin32Dll.c: Fix gcc warnings: unused variable 'registration'
	* win/tclWin32Dll.c:    fix gcc warnings: unused variable 'registration'
	* win/tclWinChan.c:
	* win/tclWinFCmd.c:

	* win/configure.in:	    Allow cross-compilation by default. (backported)
2010-11-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tcl.m4:		    Use -pipe for gcc on win32 (backported)
	* win/tclAppInit.c: [FRQ 491789]: "setargv() doesn't support a unicode
	cmdline" now implemented for cygwin and mingw32 too.
	* tests/main.test: No longer disable tests Tcl_Main-1.4 and 1.6 on
	Windows, because those now work on all supported platforms.
	* win/configure.in:  Set NO_VIZ=1 when zlib is compiled in libtcl,
	this resolves compiler warnings in 64-bit and static builds.
	* win/configure (regenerated)
	* win/configure:        (regenerated)

2010-11-18  Donal K. Fellows  <dkf@users.sf.net>

	* doc/file.n: [Bug 3111298]: Typofix.

	* tests/oo.test: [Bug 3111059]: Added testing that neatly trapped this
	issue.

2010-11-18  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclNamesp.c: [Bug 3111059]: Fix leak due to bad looping
	construct.

2010-11-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tcl.m4: [FRQ 491789]: "setargv() doesn't support a unicode
	cmdline" now implemented for mingw-w64
	* win/configure    (re-generated)

2010-11-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclAppInit.c:Bring compilation under mingw-w64 a bit closer
	* win/cat.c:       to reality. See for what's missing:
	* win/tcl.m4:      <https://sourceforge.net/apps/trac/mingw-w64/wiki/Unicode%20apps>
	* win/configure:   (re-generated)
	* win/tclWinPort.h: [Bug 3110161]: Extensions using TCHAR don't
	* generic/tclPlatDecls.h: [Bug 3110161]: Extensions using TCHAR don't
	compile on VS2005 SP1

2010-11-15  Andreas Kupries  <andreask@activestate.com>

	* doc/interp.n: [Bug 3081184]: TIP #378.
	* doc/interp.n: [Bug 3081184]: TIP #378 backport.
	* doc/tclvars.n: Performance fix for TIP #280.
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* tests/info.test:
	* tests/interp.test:

2010-11-10  Andreas Kupries  <andreask@activestate.com>

	* changes:	Updates for 8.6b2 release.

2010-11-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOMethod.c (ProcedureMethodVarResolver): [Bug 3105999]:
	* tests/oo.test:	Make sure that resolver structures that are
				only temporarily needed get squelched.

2010-11-05  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclMain.c: Thanks, Kevin, for the fix, but this how it was
	supposed to be (TCL_ASCII_MAIN is only supposed to be defined on
	WIN32).

2010-11-05  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclMain.c: Added missing conditional on _WIN32 around code
	that messes around with the definition of _UNICODE, to correct a badly
	broken Unix build from Jan's last commit.

2010-11-04  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDecls.h:	[FRQ 491789]: "setargv() doesn't support a
	* generic/tclMain.c:	unicode cmdline" implemented for Tcl on MSVC++
	* doc/Tcl_Main.3:
	* win/tclAppInit.c:
	* win/makefile.vc:
	* win/Makefile.in:
	* win/tclWin32Dll.c:	Eliminate minor MSVC warning TCHAR -> char
				conversion

2010-11-04  Reinhard Max  <max@suse.de>

	* tests/socket.test: Run the socket tests three times with the address
	family set to any, inet, and inet6 respectively. Use constraints to
	skip the tests if a family is found to be unsupported or not
	configured on the local machine. Adjust the tests to dynamically adapt
	to the address family that is being tested.

	Rework some of the tests to speed them up by avoiding (supposedly)
	unneeded [after]s.

2010-11-04  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/Makefile.in:	[Patch 3101127]: Installer Improvements.
	* unix/install-sh:

2010-11-04  Donal K. Fellows  <dkf@users.sf.net>

	* tests/error.test (error-19.13): Another variation on testing for
	issues in [try] compilation.

	* doc/Tcl.n (Variable substitution): [Bug 3099086]: Increase clarity
	of explanation of what characters are actually permitted in variable
	substitutions. Note that this does not constitute a change of
	behavior; it is just an improvement of explanation.

2010-11-04  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6b2 release.  (Thanks Andreas Kupries)

2010-11-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFcmd.c:    [FRQ 2965056]: Windows build with -DUNICODE
	* win/tclWinFile.c:    (more clean-ups for pre-win2000 stuff)
	* win/tclWinReg.c:

2010-11-03  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (TryPostBody):  Ensure that errors when setting
	* tests/error.test (error-19.1[12]): message/opt capture variables get
					     reflected properly to the caller.

2010-11-03  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclCompCmds.c (TclCompileCatchCmd): [Bug 3098302]:
	* tests/compile.test (compile-3.6): Reworked the compilation of the
	[catch] command so as to avoid placing any code that might throw an
	exception (specifically, any initial substitutions or any stores to
	result or options variables) between the BEGIN_CATCH and END_CATCH but
3955
3956
3957
3958
3959
3960
3961
3962
3963

3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477

4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489

4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500

4501
4502
4503
4504
4505
4506
4507












4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522




4523
4524
4525
4526
4527
4528
4529
4530

4531
4532

4533
4534
4535
4536
4537
4538
4539
4540
4541



4542
4543

4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597

4598
4599
4600
4601
4602

4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
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

4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026


5027
5028
5029


5030
5031

5032
5033
5034

5035
5036

5037
5038
5039
5040




5041
5042
5043



5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125

5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
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







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

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






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






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

-
-
+
-
-
-
-
-





-
+

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















+
+
+
+








+

-
+

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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

















-
+

-
-
-
-
+
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+

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










-
-
-
-
-
-





-
+

-
+



-
-
-
-
-
-
-
-
-
-









+


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



-
-
+
+
-






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












-
-
-
-





-
+

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

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

-
-
-
+
+








-
+

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









-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
+
-
-
-
-
-
-

-
-
+
-
-
-
+
-

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

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



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

-
+

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








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








2010-11-01  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Asia/Hong_Kong:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Fiji:   Olson's tzdata2010o.

2010-10-29  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

2010-10-23  Jan Nijtmans  <nijtmans@users.sf.net>
	* generic/tclTimer.c:	[Bug 2905784]: Stop small [after]s from
				wasting CPU while keeping accuracy.

2010-10-28  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]
	* generic/tclAssembly.c:
	* tests/assembly.test (assemble-31.*): Added jump tables.

2010-10-28  Don Porter  <dgp@users.sourceforge.net>

	* tests/http.test:	[Bug 3097490]: Make http-4.15 pass in
				isolation.

	* unix/tclUnixSock.c:	[Bug 3093120]: Prevent calls of
				freeaddrinfo(NULL) which can crash some
				systems.  Thanks Larry Virden.

2010-10-26  Reinhard Max  <max@suse.de>

	* Changelog.2008: Split off from Changelog.
	* generic/tclIOSock.c (TclCreateSocketAddress): The interp != NULL
	check is needed for ::tcl::unsupported::socketAF as well.

2010-10-26  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixSock.c (TcpGetOptionProc): Prevent crash if interp is
	* win/tclWinSock.c (TcpGetOptionProc):   NULL (a legal situation).

2010-10-26  Reinhard Max  <max@suse.de>

	* unix/tclUnixSock.c (TcpGetOptionProc): Added support for
	::tcl::unsupported::noReverseDNS, which if set to any value, prevents
	[fconfigure -sockname] and [fconfigure -peername] from doing
	reverse DNS queries.

2010-10-24  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]
	* generic/tclAssembly.c:
	* tests/assembly.test (assemble-17.15): Reworked branch handling so
	that forward branches can use jump1 (jumpTrue1, jumpFalse1). Added
	test cases that the forward branches will expand to jump4, jumpTrue4,
	jumpFalse4 when needed.

2010-10-23  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]
	* generic/tclAssembly.h (removed):
				Removed file that was included in only one
				source file.
	* generictclAssembly.c:	Inlined tclAssembly.h.

2010-10-17  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* doc/info.n:            [Patch 2995655]:
	* generic/tclBasic.c:    Report inner contexts in [info errorstack]
	* generic/tclCompCmds.c:
	* generic/tclCompile.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* tests/error.test:
	* tests/result.test:

2010-10-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileDictForCmd): Update the compilation
	* generic/tclCompile.c (tclInstructionTable):	of [dict for] so that
	* generic/tclExecute.c (TEBCresume):		it no longer makes any
	use of INST_DICT_DONE now that's not needed, and make it clearer in
	the implementation of the instruction that it's just a deprecated form
	of unset operation. Followup to my commit of 2010-10-16.

2010-10-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (Tcl_ZlibStreamGet): [Bug 3081008]: Ensure that
	when a bytearray gets its internals entangled with zlib for more than
	a passing moment, that bytearray will never be shimmered away. This
	increases the amount of copying but is simple to get right, which is a
	reasonable trade-off.

	* generic/tclStringObj.c (Tcl_AppendObjToObj): Added some special
	cases so that most of the time when you build up a bytearray by
	appending, it actually ends up being a bytearray rather than
	shimmering back and forth to string.

	* tests/http11.test (check_crc): Use a simpler way to express the
	functionality of this procedure.

	* generic/tclZlib.c: Purge code that wrote to the object returned by
	Tcl_GetObjResult, as we don't want to do that anti-pattern no more.

2010-10-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/uniParse.tcl:   [Bug 3085863]: tclUniData was 9 years old;
	* tools/uniParse.tcl:   [Bug 3085863]: tclUniData 9 years old
	Ignore non-BMP characters and fix comment about UnicodeData.txt file.
	* generic/regcomp.c:    Fix comment
	* tests/utf.test:       Add some Unicode 6 testcases

	* tools/uniClass.tcl:   Upgrade everything to Unicode 6.0, except
2010-10-17  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tests/utf.test:       non-BMP characters > 0xFFFF
	* doc/info.n:           Document [info errorstack] faithfully.

2010-10-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (ReleaseDictIterator): Factored out the release
	of the bytecode-level dictionary iterator information so that the
	side-conditions on instruction issuing are simpler.

2010-10-15  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/reg_locale.c: [Bug 3085863]: tclUniData 9 years old: Updated
	* generic/tclUniData.c: Unicode tables to latest UnicodeData.txt,
	* generic/tclUniData.c: (re-generated)
	* tools/uniParse.tcl:   corresponding with Unicode 6.0 (except for
				out-of-range chars > 0xFFFF)

2010-10-13  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompile.c:	Alternative fix for [Bugs 467523,983660] where
	* generic/tclExecute.c:	sharing of empty scripts is allowed again.

2010-10-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinThrd.h: (removed) because it is just empty en used nowhere
	* win/tcl.dsp

2010-10-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/uniClass.tcl:    Spacing and comments: let uniClass.tcl
	* generic/regc_locale.c: generation match better the current
	* generic/regc_locale.c:(re-generated)
				 (hand-modified) regc_locale.c
	* tools/uniParse.tcl:    Generate proper const qualifiers for
	* generic/tclUniData.c:  tclUniData.c

	* generic/regcomp.c:    fix comment
2010-10-12  Reinhard Max  <max@suse.de>

	* unix/tclUnixSock.c (CreateClientSocket): [Bug 3084338]: Fix a
	memleak and refactor the calls to freeaddrinfo().

2010-10-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:    [FRQ 2965056]: Windows build with -DUNICODE
	* win/tclWinReg.c:
	* win/tclWinTest.c:   More cleanups
	* win/tclWinFile.c:   Add netapi32 to the link line, so we no longer
	* win/tcl.m4:         have to use LoadLibrary to access those
			      functions.
	* win/makefile.vc:
	* win/configure:      (Re-generate with autoconf-2.59)
	* win/rules.vc        Update for VS10
	* win/rules.vc          Update for VS10

2010-10-09  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c: Fix overallocation of exec stack in TEBC (due
	to mixing numwords and numbytes)

2010-10-08  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIOSock.c: On Windows, use gai_strerrorA

2010-10-06  Don Porter  <dgp@users.sourceforge.net>

	* tests/winPipe.test:	Test hygiene with makeFile and removeFile.

	* generic/tclCompile.c:	[Bug 3081065]: Prevent writing to the intrep
	* tests/subst.test:	fields of a freed Tcl_Obj.

2010-10-06  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* generic/tclAssembly.c:
	* generic/tclAssembly.h:
	* tests/assemble.test: Added catches. Still needs a lot of testing.

2010-10-02  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* generic/tclAssembly.c:
	* generic/tclAssembly.h:
	* tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
	dictSet, dictUnset, nop, regexp, nsupvar, upvar, and variable.

2010-10-02  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TEBCresume): [Bug 3079830]: Added invalidation
	of string representations of dictionaries in some cases.

2010-10-01  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclExecute.c (EvalStatsCmd): change 'evalstats' to return
	data to interp by default, or if given an arg, use that as filename to
	output to (accepts 'stdout' and 'stderr').  Fix output to print used
	inst count data.
	* generic/tclCkalloc.c: Change TclDumpMemoryInfo sig to allow objPtr
	* generic/tclInt.decls: as well as FILE* as output.
	* generic/tclIntDecls.h:

2010-10-01  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c, generic/tclClock.c, generic/tclEncoding.c,
	* generic/tclEnv.c, generic/tclLoad.c, generic/tclNamesp.c,
	* generic/tclObj.c, generic/tclRegexp.c, generic/tclResolve.c,
	* generic/tclResult.c, generic/tclUtil.c, macosx/tclMacOSXFCmd.c:
	More purging of strcpy() from locations where we already know the
	length of the data being copied.

2010-10-01  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* tests/assemble.test:
	* generic/tclAssemble.h:
	* generic/tclAssemble.c:  Added listIn, listNotIn, and dictGet.

2010-09-30  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* tests/assemble.test:   Added tryCvtToNumeric and several more list
	* generic/tclAssemble.c: operations.
	* generic/tclAssemble.h:

2010-09-29  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* tests/assemble.test:   Completed conversion of tests to a
	* generic/tclAssemble.c: "white box" structure that follows the
	C code. Added missing safety checks on the operands of 'over' and
	'reverse' so that negative operand counts don't smash the stack.

2010-09-29  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/configure:	Re-generate with autoconf-2.59
	* win/configure:
	* generic/tclMain.c:	Make compilable with -DUNICODE as well

2010-09-28  Reinhard Max  <max@suse.de>

	TIP #162 IMPLEMENTATION

	* doc/socket.n:		Document the changes to the [socket] and
				[fconfigure] commands.

	* generic/tclInt.h:	Introduce TclCreateSocketAddress() as a
	* generic/tclIOSock.c:	replacement for the platform-dependent
	* unix/tclUnixSock.c:	TclpCreateSocketAddress() functions. Extend
	* unix/tclUnixChan.c:	the [socket] and [fconfigure] commands to
	* unix/tclUnixPort.h:	behave as proposed in TIP #162. This is the
	* win/tclWinSock.c:	core of what is required to support the use of
	* win/tclWinPort.h:	IPv6 sockets in Tcl.

	* compat/fake-rfc2553.c: A compat implementation of the APIs defined
	* compat/fake-rfc2553.h: in RFC-2553 (getaddrinfo() and friends) on
				 top of the existing gethostbyname() etc.
	* unix/configure.in:	 Test whether the fake-implementation is
	* unix/tcl.m4:		 needed.
	* unix/Makefile.in:	 Add a compile target for fake-rfc2553.

	* win/configure.in:	Allow cross-compilation by default.

	* tests/socket.test:	Improve the test suite to make more use of
	* tests/remote.tcl:	randomized ports to reduce interference with
				tests running in parallel or other services on
				the machine.

2010-09-28  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* tests/assemble.test: Added more "white box" tests.
	* generic/tclAssembly.c: Added the error checking and reporting
	for undefined labels. Revised code so that no pointers into the
	bytecode sequence are held (because the sequence can move!),
	that no Tcl_HashEntry pointers are held (because the hash table
	doesn't guarantee their stability!) and to eliminate the BBHash
	table, which is merely additional information indexed by jump
	labels and can just as easily be held in the 'label' structure.
	Renamed shared structures to CamelCase, and renamed 'label' to
	JumpLabel because other types of labels may eventually be possible.

2010-09-27  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* tests/assemble.test: Added more "white box" tests.
	* generic/tclAssembly.c: Fixed bugs exposed by the new tests.
	(a) [eval] and [expr] had incorrect stack balance computed if
	the arg was not a simple word. (b) [concat] accepted a negative
	operand count. (c) [invoke] accepted a zero or negative operand
	count. (d) more misspelt error messages.
	Also replaced a funky NRCallTEBC with the new call
	TclNRExecuteByteCode, necessitated by a merge with changes on the
	HEAD.

2010-09-26  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:    [Patch 3072080] (minus the itcl
	* generic/tclCmdIL.c:    update): a saner NRE.
	* generic/tclCompExpr.c:
	* generic/tclCompile.c:  This makes TclNRExecuteByteCode (ex TEBC)
	* generic/tclCompile.h:  to be a normal NRE citizen: it loses its
	* generic/tclExecute.c:  special status.
	* generic/tclInt.decls:  The logic flow within the BC engine is
	* generic/tclInt.h:      simplified considerably.
	* generic/tclIntDecls.h:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* generic/tclTest.c:

	* generic/tclVar.c: Use the macro HasLocalVars everywhere

2010-09-26  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclOOMethod.c (ProcedureMethodVarResolver): avoid code
	duplication, let the runtime var resolver call the compiled var
	resolver.

2010-09-26  Kevin B. Kenny  <kennykb@acm.org>

	[dogeen-assembler-branch]

	* tests/assemble.test:	Added many new tests moving toward a more
	comprehensive test suite for the assembler.
	* generic/tclAssembly.c:	Fixed bugs exposed by the new tests:
	(a) [bitnot] and [not] had incorrect operand counts. (b)
	INST_CONCAT cannot concatenate zero objects. (c) misspelt error
	messages. (d) the "assembly code" internal representation lacked
	a duplicator, which caused double-frees of the Bytecode object
	if assembly code ever was duplicated.

2010-09-25  Kevin B. Kenny   <kennykb@acm.org>

	[dogeen-assembler-branch]

	* generic/tclAssembly.c:	Massive refactoring of the assembler
	* generic/tclAssembly.h:	to use a Tcl-like syntax (and use
	* tests/assemble.test:		Tcl_ParseCommand to parse it). The
	* tests/assemble1.bench:	refactoring also ensures that
	Tcl_Tokens in the assembler have string ranges inside the source
	code, which allows for [eval] and [expr] assembler directives
	that simply call TclCompileScript and TclCompileExpr recursively.

2010-09-24  Jeff Hobbs  <jeffh@ActiveState.com>

	* tests/stringComp.test: improved string eq/cmp test coverage
	* generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP and
	INST_STR_EQ/INST_STR_NEQ paths.  Speeds up eq/ne/[string eq] with
	obj-aware comparisons and eq/==/ne/!= with length equality check.

2010-09-24  Andreas Kupries  <andreask@activestate.com>

	* tclWinsock.c: [Bug 3056775]: Fixed race condition between thread and
	internal co-thread access of a socket's structure because of the
	thread not using the socketListLock in TcpAccept(). Added
	documentation on how the module works to the top.

2010-09-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDecls.h: Make Tcl_SetPanicProc and Tcl_GetStringResult
	* unix/tclAppInit.c:  callable without stubs, just as Tcl_SetVar.
	* win/tclAppInit.c:

2010-09-23  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCmdAH.c:   Fix cases where value returned by
	* generic/tclEvent.c:   Tcl_GetReturnOptions() was leaked.
	* generic/tclMain.c:    Thanks to Jeff Hobbs for discovery of the
	anti-pattern to seek and destroy.

2010-09-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclAppInit.c:  Make compilable with -DUNICODE (not activated
	* win/tclAppInit.c:   yet), many clean-ups in comments.

2010-09-22  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute: [Bug 3072640]: One more DECACHE_STACK_INFO() was
	missing.

	* tests/execute.test: Added execute-10.3 for [Bug 3072640]. The test
	causes a mem failure.

	* generic/tclExecute: Protect all possible writes to ::errorInfo or
	::errorCode with DECACHE_STACK_INFO(), as they could run traces. The
	new calls to be protected are Tcl_ResetResult(), Tcl_SetErrorCode(),
	IllegalExprOperandType(), TclExprFloatError(). The error was triggered
	by [Patch 3072080].

2010-09-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tcl.m4:		Add kernel32 to LIBS, so the link line for
	* win/configure:	mingw is exactly the same as for MSVC++.

2010-09-21  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclExecute.c (TclExecuteByteCode):
	* generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect):
	* generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys):
	* generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths):
	* generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt
	* generic/tclResult.c (TclMergeReturnOptions): Use memcmp where
	applicable as possible speedup on some libc variants.

2010-09-21  Kevin B. Kenny  <kennykb@acm.org>

	[BRANCH: dogeen-assembler-branch]

	* generic/tclAssembly.c (new file):
	* generic/tclAssembly.h:
	* generic/tclBasic.c (builtInCmds, Tcl_CreateInterp):
	* generic/tclInt.h:
	* tests/assemble.test (new file):
	* tests/assemble1.bench (new file):
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/Makefile.vc:
		Initial commit of Ozgur Dogan Ugurlu's (SF user: dogeen)
		assembler for the Tcl bytecode language.

2010-09-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFile.c:   Fix declaration after statement.
	* win/tcl.m4:         Add -Wdeclaration-after-statement, so this
	* win/configure:      mistake cannot happen again.
	* win/tclWinFCmd.c:   [Bug 3069278]: Breakage on head Windows
	* win/tclWinPipe.c:   triggered by install-tzdata, final fix

2010-09-20  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFCmd.c: Eliminate tclWinProcs->useWide everywhere, since
	* win/tclWinFile.c: the value is always "1" on platforms >win95
	* win/tclWinPipe.c:

2010-09-19  Donal K. Fellows  <dkf@users.sf.net>

	* doc/file.n (file readlink): [Bug 3070580]: Typofix.

2010-09-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinFCmd.c [Bug 3069278]: Breakage on head Windows triggered
	by install-tzdata. Temporary don't compile this with -DUNICODE, while
	investigating this bug.

2010-09-16  Jeff Hobbs  <jeffh@ActiveState.com>

	* win/tclWinFile.c: Remove define of FINDEX_INFO_LEVELS as all
	supported versions of compilers should now have it.

	* unix/Makefile.in: Do not pass current build env vars when using
	NATIVE_TCLSH in targets.

2010-09-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDecls.h:    Make Tcl_FindExecutable() work in UNICODE
	* generic/tclEncoding.c: compiles (windows-only) as well as ASCII.
	* generic/tclStubInit.c: Needed for [FRQ 491789]: setargv() doesn't
	support a unicode cmdline.

2010-09-15  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 3067036]: Make
	sure we never try to double zero repeatedly to get a buffer size. Also
	added a check for sanity on the size of buffer being appended.

2010-09-15  Don Porter  <dgp@users.sourceforge.net>

	* unix/Makefile.in:	Revise `make dist` target to tolerate the
	case of zero bundled packages.

2010-09-15  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl:   [Patch 3034251]: Backport ttkGenStubs.tcl
	* generic/tcl.decls:    features to genStubs.tcl. Make the "generic"
	* generic/tclInt.decls: argument in the *.decls files optional
	* generic/tclOO.decls:  (no change to any tcl*Decls.h files)
	* generic/tclTomMath.decls:
	This allows genStubs.tcl to generate the ttk stub files as well, while
	keeping full compatibility with existing *.decls files.

2010-09-14  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinPort.h:  Allow all Win2000+ API entries in Tcl
	* win/tclWin32Dll.c: Eliminate dynamical loading of advapi23 and
	kernel32 symbols.

2010-09-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinChan.c:      Various clean-ups, converting from
	* win/tclWinConsole.c:   tclWinProc->xxxProc directly to Xxx
	* win/tclWinInit.c:      (no change in functionality)
	* win/tclWinLoad.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* tools/genStubs.tcl:    Add scspec feature from ttkGenStubs.tcl
	  (no change in output for *Decls.h files)

2010-09-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWin32Dll.c: Partly revert yesterday's change, to make it work
	on VC++ 6.0 again.

2010-09-10  Donal K. Fellows  <dkf@users.sf.net>

	* doc/regsub.n: [Bug 3063568]: Fix for gotcha in example due to Tcl's
	special handling of backslash-newline. Makes example slightly less
	pure, but more useful.

2010-09-09  Jan Nijtmans  <nijtmans@users.sf.net>

2010-09-08  Andreas Kupries  <andreask@activestate.com>
	* win/makefile.vc:   Mingw should always link with -ladvapi32.
	* win/tcl.m4:
	* win/configure:     (regenerated)
	* win/tclWinInt.h:   Remove ascii variant of tkWinPocs table, it is
	* win/tclWin32Dll.c: no longer necessary. Fix CreateProcess signature
	* win/tclWinPipe.c:  and remove unused GetModuleFileName and lstrcpy.
	* win/tclWinPort.h:  Mingw/cygwin fixes: <tchar.h> should always be
	included, and fix conflict in various macro values: Always force the
	same values as in VC++.

2010-09-08  Don Porter  <dgp@users.sourceforge.net>

	*** 8.5.9 TAGGED FOR RELEASE ***
	* win/tclWinChan.c:	[Bug 3059922]: #ifdef protections to permit
	* win/tclWinFCmd.c:     builds with mingw on amd64 systems. Thanks to
				"mescalinum" for reporting and testing.

2010-09-08  Andreas Kupries  <andreask@activestate.com>

	* doc/tm.n: Added underscore to the set of characters accepted in
	module names. This is true for quite some time in the code, this
	change catches up the documentation.

2010-09-03  Donal K. Fellows  <dkf@users.sf.net>
2010-09-08  Don Porter  <dgp@users.sourceforge.net>

	* tools/tcltk-man2html.tcl (plus-pkgs): Improve the package
	documentation search pattern to support the doctoos-generated
	directory structure.
	* tools/tcltk-man2html-utils.tcl (output-name): Made this more
	resilient against misformatted NAME sections, induced by import of
	Thread package documentation into Tcl doc tree.
	* changes:	Update for 8.5.9 release.

	* win/tclWin32Dll.c:	#ifdef protections to permit builds with
	* win/tclWinChan.c:	mingw on amd64 systems. Thanks to "mescalinum"
	* win/tclWinFCmd.c:	for reporting and testing.

2010-09-06  Stuart Cassoff  <stwo@users.sourceforge.net>

	* unix/configure.in, generic/tclIOUtil.c (Tcl_Stat): Updated so that
	we do not assume that all unix systems have the POSIX blkcnt_t type,
	since OpenBSD apparently does not. Backported from HEAD (2010-02-16).
	* unix/configure:	autoconf-2.59

2010-09-02  Andreas Kupries  <andreask@activestate.com>

	* doc/glob.n: Fixed documentation ambiguity regarding the handling
	of -join.

	* library/safe.tcl (safe::AliasGlob): Fixed another problem, the
	option -join does not stop option processing in the core builtin, so
	the emulation must not do that either.

2010-09-01  Andreas Kupries  <andreas_kupries@users.sourceforge.net>

	* library/safe.tcl (safe::AliasGlob): Moved the command extending the
	actual glob command with a -directory flag to when we actually have a
	proper untranslated path,

2010-09-01  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Update for 8.5.9 release.

2010-09-01  Andreas Kupries  <andreask@activestate.com>

	* generic/tclExecute.c: [Bug 3057639]: Applied patch by Jeff to make
	* generic/tclVar.c:	the behaviour of lappend in bytecompiled mode
	* tests/append.test:	consistent with direct-eval and 'append'
	* tests/appendComp.test: generally. Added tests (append*-9.*)
	showing the difference.
	***POTENTIAL INCOMPATIBILITY***

2010-08-31  Jan Nijtmans  <nijtmans@users.sf.net>
2010-09-01  Donal K. Fellows  <dkf@users.sf.net>

	* win/rules.vc:               Typo (thanks to Twylite discovering
				      this)
	* generic/tclStubLib.c:       Revert to previous version: MSVC++ 6.0
	* generic/tclTomMathStubLib.c:cannot handle the new construct.
	* generic/tcl.decls           [Patch 2997642]: Many type casts needed
	* generic/tclDecls.h:         when using Tcl_Pkg* API. Remaining part.
	* generic/tclPkg.c:
	* generic/tclBasic.c:
	* tools/tcltk-man2html.tcl: Improve handling of cross-links for
	options between Ttk manual pages.

	* generic/tclTomMathInterface.c:
	* doc/PkgRequire.3
	* doc/Tcl.n: Avoid nroff hazards when generating documentation.

2010-08-31  Andreas Kupries  <andreask@activestate.com>

	* win/tcl.m4: Applied patch by Jeff fixing issues with the manifest
	handling on Win64.
	* win/configure: Regenerated.

2010-08-30  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:    [Bugs 3046594,3047235,3048771]: New
	* generic/tclCmdAH.c:    implementation for [tailcall] command: it now
	* generic/tclCmdMZ.c:    schedules the command and returns TCL_RETURN.
	* generic/tclExecute.c:  This fixes all issues with [catch] and [try].
	* generic/tclInt.h:      Thanks dgp for exploring the dark corners.
	* generic/tclNamesp.c:   More thorough testing is required.
	* tests/tailcall.test:

2010-08-30  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in:   [FRQ 2965056]: Windows build with -DUNICODE
	* win/rules.vc:
	* win/tclWinFCmd.c:  Make sure that allocated TCHAR arrays are
	* win/tclWinFile.c:  always properly aligned as wchar_t, and
	* win/tclWinPipe.c:  not bigger than necessary.
	* win/tclWinSock.c:
	* win/tclWinDde.c:   Those 3 files are not converted yet to be
	* win/tclWinReg.c:   built with -DUNICODE, so add a TODO.
	* win/tclWinTest.c:
	* generic/tcl.decls:  [Patch 2997642]: Many type casts needed when
	* generic/tclDecls.h: using Tcl_Pkg* API. Partly.
	* generic/tclPkg.c:
	* generic/tclStubLib.c: Demonstration how this change can benefit
				code.
	* generic/tclTomMathStubLib.c:
	* doc/PkgRequire.3:

2010-08-29  Donal K. Fellows  <dkf@users.sf.net>

	* doc/dict.n: [Bug 3046999]: Corrected cross reference to array
	manpage to refer to (correct) existing subcommand.

2010-08-26  Jeff Hobbs  <jeffh@ActiveState.com>

	* unix/configure, unix/tcl.m4: SHLIB_LD_LIBS='${LIBS}' for OSF1-V*.
	Add /usr/lib64 to set of auto-search dirs. [Bug 1230554]
	(SC_PATH_X): Correct syntax error when xincludes not found.

	* win/Makefile.in (VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE):
	* win/configure, win/configure.in, win/tcl.m4: SC_EMBED_MANIFEST
	macro and --enable-embedded-manifest configure arg added to support
	manifest embedding where we know the magic.  Help prevents DLL hell
	with MSVC8+.

2010-08-24  Jan Nijtmans  <nijtmans@users.sf.net>
2010-08-24  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.decls: [Bug 3007895]: Tcl_(Find|Create)HashEntry
	* generic/tclHash.c: stub entries can never be called.
	* generic/tclDecls.h:
	* generic/tclStubInit.c: [Patch 2994165]: Change signature of
	* changes:	Update for 8.5.9 release.
	Tcl_FSGetNativePath and TclpDeleteFile follow-up: move stub entry back
	to original location.

2010-08-23  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/Asia/Gaza: Olson's tzdata2010l.

2010-08-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBasic.c:  [Patch 3009403]: Signature of Tcl_GetHashKey,
	* generic/tclBinary.c: Tcl_(Create|Find)HashEntry follow-up:
	* generic/tclCmdIL.c:  Remove many type casts which are no longer
	* generic/tclCompile.c:necessary as a result of this signature change.
	* generic/tclDictObj.c:
	* generic/tclEncoding.c:
	* generic/tclExecute.c:
	* generic/tclInterp.c:
	* generic/tclIOCmd.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* generic/tclTest.c:
	* generic/tclTrace.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:

2010-08-21  Donal K. Fellows  <dkf@users.sf.net>

	* doc/linsert.n: [Bug 3045123]: Make description of what is actually
	happening more accurate.

2010-08-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl
	features to genStubs.tcl, partly: Use void (*reserved$i)(void) = 0
	instead of void *reserved$i = NULL for unused stub entries, in case
	pointer-to-function and pointer-to-object are different sizes.
	* generic/tcl*Decls.h:   (regenerated)
	* generic/tcl*StubInit.c:(regenerated)

2010-08-20  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/Method.3:   Fix definition of Tcl_MethodType.

2010-08-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclTrace.c (TraceExecutionObjCmd, TraceCommandObjCmd)
	(TraceVariableObjCmd): [Patch 3048354]: Use memcpy() instead of
	strcpy() to avoid buffer overflow; we have the correct length of data
	to copy anyway since we've just allocated the target buffer.

2010-08-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl: [Patch 3034251]: Backport ttkGenStubs.tcl
	features to genStubs.tcl, partly: remove unneeded ifdeffery and put
	C++ guard around stubs pointer definition.
	* generic/*Decls.h:   (regenerated)

2010-08-18  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   New redesign of [tailcall]: find
	* generic/tclExecute.c: errors early on, so that errorInfo
	* generic/tclInt.h:     contains the proper info [Bug 3047235]
	* generic/tclNamesp.c:

	* generic/tclCmdAH.c (TclNRTryObjCmd): [Bug 3046594]: Block
	tailcalling out of the body of a non-bc'ed [try].

	* generic/tclBasic.c:    Redesign of [tailcall] to
	* generic/tclCmdAH.c:    (a) fix [Bug 3047235]
	* generic/tclCompile.h:  (b) enable fix for [Bug 3046594]
	* generic/tclExecute.c:  (c) enable recursive tailcalls
	* generic/tclInt.h:
	* generic/tclNamesp.c:
	* tests/tailcall.test:

2010-08-18  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (AliasGlob): [Bug 3004191]: Restore safe [glob] to
	working condition.

2010-08-15  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclProc.c (ProcWrongNumArgs): [Bug 3045010]: Make the
	handling of passing the wrong number of arguments to [apply] somewhat
	less verbose when a lambda term is present.

2010-08-14  Jan Nijtmans  <nijtmans@users.sf.net>
2010-08-12  Donal K. Fellows  <dkf@users.sf.net>

	* compat/unicows:    Remove completely, see [FRQ 2819611].
	* doc/FileSystem.3: [Patch 2994165]: Change signature of
	* generic/tcl.decls  Tcl_FSGetNativePath and TclpDeleteFile
	* generic/tclDecls.h:
	* generic/tclIOUtil.c:
	* generic/tclStubInit.c:
	* generic/tclInt.h:
	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): [Bug 2826551, Patch 2948425]:
	* unix/tclUnixFCmd.c:
	* win/tclWinFCmd.c:
	* doc/Hash.3: [Patch 3009403]: Signature of Tcl_GetHashKey,
	* generic/tcl.h:     Tcl_(Create|Find)HashEntry
	Backport of updates to make handling of RE line anchors correct.

2010-08-11  Jeff Hobbs  <jeffh@ActiveState.com>

	* unix/ldAix: Remove ancient (pre-4.2) AIX support
	* unix/configure: Regen with ac-2.59
	* unix/configure.in, unix/tclConfig.sh.in, unix/Makefile.in:
	* unix/tcl.m4 (AIX): Remove the need for ldAIX, replace with
	-bexpall/-brtl.  Remove TCL_EXP_FILE (export file) and other baggage
	that went with it.  Remove pre-4 AIX build support.

2010-08-11  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c (TclNRYieldToObjCmd):
	* tests/coroutine.test: Fixed bad copypasta snafu. Thanks to Andy Goth
	for finding the bug.

2010-08-10  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclUtil.c (TclByteArrayMatch): Patterns may not be
	null-terminated, so account for that.

2010-08-09  Don Porter  <dgp@users.sourceforge.net>
2010-08-05  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6b2 release.
	* changes:	Update for 8.5.9 release.

2010-08-04  Jeff Hobbs  <jeffh@ActiveState.com>

	* win/Makefile.in, win/makefile.bc, win/makefile.vc, win/tcl.dsp:
	* win/tclWinPipe.c (TclpCreateProcess):
	* win/stub16.c (removed): Removed Win9x tclpip8x.dll build and 16-bit
	application loader stub support.  Win9x is no longer supported.

	* win/tclWin32Dll.c (TclWinInit): Hard-enforce Windows 9x as an
	unsupported platform with a panic.  Code to support it still exists in
	other files (to go away in time), but new APIs are being used that
	don't exist on Win9x.

	* unix/tclUnixFCmd.c: Adjust license header as per
	ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change

	* license.terms: Fix DFARs note for number-adjusted rights clause

	* win/tclWin32Dll.c (asciiProcs, unicodeProcs):
	* win/tclWinLoad.c (TclpDlopen): 'load' use LoadLibraryEx with
	* win/tclWinInt.h (TclWinProcs): LOAD_WITH_ALTERED_SEARCH_PATH to
	prefer dependent DLLs in same dir as loaded DLL.
	***POTENTIAL INCOMPATIBILITY***

	* win/Makefile.in (%.${OBJEXT}): better implicit rules support

2010-08-04  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump to 8.5.9 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:
	* README:

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

	* changes:	Update for 8.5.9 release.

2010-08-04  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting in
	* generic/tclIORTrans.c: InvokeTclMethod and callers.
	* generic/tclIORChan.c: [Bug 3034840]: Fixed reference counting
	* tests/ioCmd.test: in InvokeTclMethod and callers.
	* tests/ioTrans.test:

2010-08-03  Andreas Kupries  <andreask@activestate.com>

	* tests/var.test (var-19.1): [Bug 3037525]: Added test demonstrating
	the local hashtable deletion crash and fix.

	* tests/info.test (info-39.1): Added forward copy of test in 8.5
	branch about [Bug 2933089]. Should not fail, and doesn't, after
	updating the line numbers to the changed position.
	* tests/info.test (info-39.1, test_info_frame): Changed absolute to
	relative frame adressing to handle difference between testing with
	-singleproc 1 vs. the default -singleproc 0. Plus comment fix. The
	test and issue are not relevant to the trunk, forward porting is not
	required.

2010-08-03  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Update for 8.5.9 release.

2010-08-02  Kevin B. Kenny  <kennykb@users.sf.net>

	* library/tzdata/America/Bahia_Banderas:
	* library/tzdata/Pacific/Chuuk:
	* library/tzdata/Pacific/Pohnpei:
	* library/tzdata/Africa/Cairo:
	* library/tzdata/Europe/Helsinki:
	* library/tzdata/Pacific/Ponape:
	* library/tzdata/Pacific/Truk:
	* library/tzdata/Pacific/Yap:			Olson's tzdata2010k.

2010-08-02  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclVar.c: Correcting bad port of [Bug 3037525] fix

2010-07-28  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclVar.c: [Bug 3037525]: Lose fickle optimisation in
	TclDeleteVars (used for runtime-created locals) that caused crash.

2010-07-29  Jan Nijtmans  <nijtmans@users.sf.net>
2010-07-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/zlib/win32/README.txt: Official build of zlib1.dll 1.2.5 is
	* compat/zlib/win32/USAGE.txt:  finally available, so put it in.
	* compat/zlib/win32/zlib1.dll:

	* generic/tclInt.h: [Bug 3030870]: Make itcl 3.x built with pre-8.6
2010-07-25  Donal K. Fellows  <dkf@users.sf.net>

	* doc/http.n: Corrected description of location of one of the entries
	in the state array.

2010-07-24  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDecls.h: [Bug 3029891]: Functions that don't belong in
	* generic/tclTest.c:  the stub table.
	* generic/tclBasic.c: From [Bug 3030870] make itcl 3.x built with
	pre-8.6 work in 8.6: Relax the relation between Tcl_CallFrame and
	* generic/tclBasic.c: work in 8.6 revert tclInt.h to what it was
	before, and relax the relation between Tcl_CallFrame and CallFrame.
	CallFrame.

2010-07-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c: Added more errorCode setting.

2010-07-15  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Ensure that [dict get]
	* generic/tclDictObj.c (DictGetCmd): always generates an errorCode on
	a failure to look up an entry.

2010-07-11  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* unix/configure: (regenerated)
	* unix/configure.in: For the NATIVE_TCLSH variable use the autoconf
	* unix/Makefile.in:  SC_PROG_TCLSH to try and find a locally installed
	native binary. This avoids manually fixing up when cross compiling. If
	there is not one, revert to using the build product.

2010-07-02  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclInt.decs:	Reverted to the original TIP 337
	implementation on what to do with the obsolete internal stub for
	TclBackgroundException() (eliminate it!)
	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2010-07-02  Jan Nijtmans  <nijtmans@users.sf.net>
2010-07-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls:  [Bug 803489]: Tcl_FindNamespace problem in
	* generic/tclIntDecls.h: the Stubs table
	* generic/tclStubInit.c:
	* generic/tcl.h: [Bug 3030870]: Make itcl 3.x built with pre-8.6
	* generic/tclInt.h:		work in 8.6

2010-07-02  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (IllegalExprOperandType): [Bug 3024379]: Made
	sure that errors caused by an argument to an operator being outside
	the domain of the operator all result in ::errorCode being ARITH
	DOMAIN and not NONE.

2010-07-01  Jan Nijtmans  <nijtmans@users.sf.net>
2010-07-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/rules.vc:              [Bug 3020677]: wish can't link reg1.2
	* generic/tclIntDecls.h: [Bug 803489]: Tcl_FindNamespace problem in
	* tools/checkLibraryDoc.tcl: formatting, spacing, cleanup unused
	* tools/eolFix.tcl:          variables; no change in generated output
	* tools/fix_tommath_h.tcl:
	* tools/genStubs.tcl:
	the Stubs table.
	* tools/index.tcl:
	* tools/man2help2.tcl:
	* tools/regexpTestLib.tcl:
	* tools/tsdPerf.tcl:
	* tools/uniClass.tcl:
	* tools/uniParse.tcl:

2010-07-01  Donal K. Fellows  <dkf@users.sf.net>

	* doc/mathop.n: [Bug 3023165]: Fix typo that was preventing proper
	rendering of the exclusive-or operator.

2010-06-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPosixStr.c: [Bug 3019634]: errno.h and tclWinPort.h have
	conflicting definitions. Added messages for ENOTRECOVERABLE, EOTHER,
	ECANCELED and EOWNERDEAD, and fixed various typing mistakes in other
	messages.

2010-06-25  Reinhard Max  <max@suse.de>

	* tests/socket.test: Prevent a race condition during shutdown of the
	remote test server that can cause a hang when the server is being run
	in verbose mode.

2010-06-24  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinPort.h: [Bug 3019634]: errno.h and tclWinPort.h have
	conflicting definitions.

		***POTENTIAL INCOMPATIBILITY***
	On win32, the correspondence between errno and the related error
	message, as handled by Tcl_ErrnoMsg() changes. The error message is
	kept the same, but the corresponding errno value might change.

2010-06-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdIL.c (Tcl_LsetObjCmd): [Bug 3019351]: Corrected wrong
	args message.

2010-06-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclLoadDl.c:    Eliminate various unnecessary type casts, use
	* unix/tclLoadNext.c:  function typedefs whenever possible
	* unix/tclUnixChan.c:
	* unix/tclUnixFile.c:
	* unix/tclUnixNotfy.c:
	* unix/tclUnixSock.c:
	* unix/tclUnixTest.c:
	* unix/tclXtTest.c:
	* generic/tclZlib.c:   Remove hack needed for zlib 1.2.3 on win32

2010-06-18  Donal K. Fellows  <dkf@users.sf.net>

	* library/init.tcl (auto_execok): [Bug 3017997]: Add .cmd to the
	default list of extensions that we can execute interactively.

2010-06-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/loadICU.tcl:   [Bug 3016135]: Traceback using clock format
	* library/msgs/he.msg: with locale of he_IL.

	* generic/tcl.h:       Simplify Tcl_AppInit and *_Init definitions,
	* generic/tclInt.h:    spacing. Change TclpThreadCreate and
	* generic/tcl.decls:   Tcl_CreateThread signature, making clear that
	* generic/tclDecls.h:  "proc" is a function pointer, as in all other
	* generic/tclEvent.c:  "proc" function parameters.
	* generic/tclTestProcBodyObj.c:
	* win/tclWinThrd.c:
	* unix/tclUnixThrd.c:
	* doc/Thread.3:
	* doc/Class.3:         Fix Tcl_ObjectMetadataType definition.

2010-06-14  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/Makefile.in:    Fix compilation of xttest with 8.6 changes
	* unix/tclXtNotify.c:
	* unix/tclXtTest.c:
	* generic/tclPipe.c:   Fix gcc warning (with -fstrict-aliasing=2)
	* library/auto.tcl:    Spacing and style fixes.
	* library/history.tcl:
	* library/init.tcl:
	* library/package.tcl:
	* library/safe.tcl:
	* library/tm.tcl:

2010-06-13  Donal K. Fellows  <dkf@users.sf.net>

	* tools/tcltk-man2html.tcl (make-man-pages): [Bug 3015327]: Make the
	title of a manual page be stored relative to its resulting directory
	name as well as its source filename. This was caused by both Tcl and a
	contributed package ([incr Tcl]) defining an Object.3. Also corrected
	the joining of strings in titles to avoid extra braces.

2010-06-09  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl: Added OSX Intel 64bit
	* library/platform/pkgIndex.tcl: Package updated to version 1.0.9.
	* unix/Makefile.in:
	* win/Makefile.in:

2010-06-09  Jan Nijtmans  <nijtmans@users.sf.net>

2010-05-26  Donal K. Fellows  <dkf@users.sf.net>
	* tools/tsdPerf.c:    Fix export of symbol Tsdperf_Init, when using
	-fvisibility=hidden. Make two functions static, eliminate some
	unnecessary type casts.
	* tools/configure.in: Update to Tcl 8.6
	* tools/configure:    (regenerated)
	* tools/.cvsignore    new file

2010-06-07  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* doc/socket.n: [Bug 3007442]: Server sockets never took a host
	* generic/tclExecute.c: Ensure proper reset of [info errorstack] even
	* generic/tclNamesp.c:  when compiling constant expr's with errors.

	argument, so the list of options must precede the port argument.
2010-06-05  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   [Bug 3008307]: make callerPtr chains be
	* generic/tclExecute.c: traversable accross coro boundaries. Add the
	special coroutine CallFrame (partially reverting commit of
	2009-12-10), as it is needed for coroutines that do not push a CF, eg,
	those with [eval] as command. Thanks to Colin McCormack (coldstore)
	and Alexandre Ferrieux for the hard work on this.

2010-06-03  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclNamesp.c: Safer (and faster) computation of [uplevel]
	* tests/error.test:    offsets in TIP 348. Toplevel offsets no longer
	* tests/result.test:   overestimated.

2010-06-02  Jan Nijtmans  <nijtmans@users.sf.net>
2010-05-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclOO.h:  BUILD_tcloo is never defined (leftover)
	* win/makefile.bc:  Don't set BUILD_tcloo (leftover)
	See also entry below: 2008-06-01  Joe Mistachkin

	* unix/tclUnixPort.h: [Bug 2991415]: tclport.h #included before
2010-06-01  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* win/tclWinPort.h:		     limits.h
	* generic/tclNamesp.c: Fix computation of [uplevel] offsets in TIP 348
	* tests/error.test:    Only depend on callerPtr chaining now.
	* tests/result.test:   Needed for upcoming coro patch.

2010-05-31  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclVar.c:        Eliminate some casts to (Tcl_HashTable *)
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* tests/fileSystem.test:   Fix filesystem-5.1 test failure on CYGWIN

2010-05-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.h: [Patch 3008541]: Order of TIP #348 fields in
	Interp structure

2010-05-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions): [3007374]:
	Corrected error in handling of catch contexts to prevent crash with
	chained handlers.

	* generic/tclExecute.c (TclExecuteByteCode): Restore correct operation
	of instruction-level execution tracing (had been broken by NRE).

2010-05-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* library/opt/optParse.tcl: Don't generate spaces at the end of a
	* library/opt/pkgIndex.tcl: line, eliminate ';' at line end, bump to
	* tools/uniParse.tcl:       v0.4.6
	* generic/tclUniData.c:
	* tests/opt.test:
	* tests/safe.test:

2010-05-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/installData.tcl: Make sure that copyDir only receives
	normalized paths, otherwise it might result in a crash on CYGWIN.
	* tools/installData.tcl:  Make sure that copyDir only receives
	normalized paths. Backported from trunk.
	Restyle according to the Tcl style guide.
	* generic/tclStrToD.c: [Bug 3005233]: Fix for build on OpenBSD vax

	* generic/tclPlatDecls.h: Fix <tchar.h> inclusion for CYGWIN.
	Backported from trunk (although for trunk this was moved to
2010-05-19  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	tclWinPort.h)
	* tests/dict.test: Add missing tests for [Bug 3004007], fixed under
	the radar on 2010-02-24 (dkf): EIAS violation in list-dict conversions

	* generic/tclPathObj.c:   Fix Tcl_SetStringObj usage for CYGWIN. This
2010-05-19  Jan Nijtmans  <nijtmans@users.sf.net>

	function can only be used with unshared objects. This causes a crash
	* generic/regcomp.c:     Don't use arrays of length 1, just use a
	* generic/tclFileName.c: single element then, it makes code more
	* generic/tclLoad.c:     readable. (Here it even prevents a type cast)

	on CYGWIN. (backported from trunk)
	* generic/tclFileName.c:  Don't declare cygwin_conv_to_win32_path here
	* win/tclWinChan.c:       Fix various minor other gcc warnings, like
	* win/tclWinConsole.c:    signed<->unsigned mismatch. Backported from
2010-05-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclStrToD.c: [Bug 2996549]: Failure in expr.test on Win32
	* win/tclWinDde.c:        trunk.
	* win/tclWinNotify.c:
	* generic/tclStrToD.c:    [Bug 3005233]: fix for build on OpenBSD vax

2010-05-17  Donal K. Fellows  <dkf@users.sf.net>
2010-05-19 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclCmdIL.c (TclInfoFrame): Change this code to use
	Tcl_GetCommandFullName rather than rolling its own. Discovered during
	the hunting of [Bug 3001438] but unlikely to be a fix.

	* generic/tclDictObj.c: Backport of fix for [Bug 3004007], EIAS
2010-05-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* tests/dict.test:      violation in list-dict conversions.
	* win/tclWinConsole.c: [Patch 2997087]: Unnecessary type casts.
	* win/tclWinDde.c:
	* win/tclWinLoad.c:
	* win/tclWinNotify.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* win/tclWinTime.c:
	* win/tclWinPort.h: Don't duplicate CYGWIN timezone #define from
			    tclPort.h

2010-05-07  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl: Fix cpu name for Solaris/Intel 64bit.
	* library/platform/pkgIndex.tcl: Package updated to version 1.0.8.
	* unix/Makefile.in:
	* win/Makefile.in:

2010-05-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPkg.c:   Unnecessary type casts, see [Patch 2997087]

2010-05-04  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinNotify.c:	TCHAR-related fixes, making those two files
	* win/tclWinSock.c:	compile fine when TCHAR != char. Please see
	comments in [FRQ 2965056] (2965056-1.patch).

2010-05-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIORChan.c:   Use "tclIO.h" and "tclTomMathDecls.h"
	* generic/tclIORTrans.c:  everywhere
	* generic/tclTomMath.h:
	* tools/fix_tommath_h.tcl:
	* libtommath/tommath.h:   Formatting (# should always be first char on
				  line)
	* win/tclAppInit.c:       For MINGW/CYGWIN, use GetCommandLineA
				  explicitly.
	* unix/.cvsignore:        Add pkg, *.dll

	* libtommath/tommath.h:       CONSTify various useful internal
	* libtommath/bn_mp_cmp_d.c:   functions (TclBignumToDouble, TclCeil,
	* libtommath/bn_mp_cmp_mag.c: TclFloor), and related tommath functions
	* libtommath/bn_mp_cmp.c:
	* libtommath/bn_mp_copy.c:
	* libtommath/bn_mp_count_bits.c:
	* libtommath/bn_mp_div_2d.c:
	* libtommath/bn_mp_mod_2d.c:
	* libtommath/bn_mp_mul_2d.c:
	* libtommath/bn_mp_neg.c:
	* generic/tclBasic.c:        Handle TODO: const correctness ?
	* generic/tclInt.h:
	* generic/tclStrToD.c:
	* generic/tclTomMath.decls:
	* generic/tclTomMath.h:
	* generic/tclTomMathDecls.h:

2010-04-30  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump patchlevel to 8.6b1.2 to distinguish
	* library/init.tcl:	CVS snapshots from earlier snapshots as well
	* unix/configure.in:	as the 8.6b1 and 8.6b2 releases.
	* win/configure.in:

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

	* generic/tclBinary.c (TclAppendBytesToByteArray):	Add comments
	* generic/tclInt.h (TclAppendBytesToByteArray):	placing overflow
	protection responsibility on caller.  Convert "len" argument to signed
	int which any value already vetted for overflow issues will fit into.
	* generic/tclStringObj.c:	Update caller; standardize panic msg.

	* generic/tclBinary.c (UpdateStringOfByteArray): [Bug 2994924]:	Add
	* generic/tclBinary.c (UpdateStringOfByteArray): [Bug 2994924]: Add
	panic when the generated string representation would grow beyond Tcl's
	size limits.

2010-04-30  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBinary.c (TclAppendBytesToByteArray): Add extra armour
	against buffer overflows.

	* generic/tclBasic.c (NRInterpCoroutine): Corrected handling of
	* tests/coroutine.test (coroutine-6.4):   arguments to deal with
						  trickier cases.

2010-04-30  Miguel Sofer  <msofer@users.sf.net>

	* tests/coroutine.test: testing coroutine arguments after [yield]:
	check that only 0/1 allowed

2010-04-30  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c (NRInterpCoroutine): Corrected handling of
	arguments to deal with trickier cases.

	* generic/tclCompCmds.c (TclCompileVariableCmd): Slightly tighter
	issuing of instructions.

	* generic/tclExecute.c (TclExecuteByteCode): Add peephole optimization
	of the fact that INST_DICT_FIRST and INST_DICT_NEXT always have a
	conditional jump afterwards.

	* generic/tclBasic.c (TclNRYieldObjCmd, TclNRYieldmObjCmd)
	(NRInterpCoroutine): Replace magic values for formal argument counts
	for coroutine command implementations with #defines, for an increase
	in readability.

2010-04-30  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclMain.c: Unnecessary TCL_STORAGE_CLASS re-definition. It
	was used for an ancient dummy reference to Tcl_LinkVar(), but that's
	already gone since 2002-05-29.

2010-04-29  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCompExpr.c: Slight change in the literal sharing
	* generic/tclCompile.c:  mechanism to avoid shimmering of
	* generic/tclCompile.h:  command names.
	* generic/tclLiteral.c:

2010-04-29  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl: Another stab at getting the /lib,
	* library/platform/pkgIndex.tcl: /lib64 difference right for linux.
	* unix/Makefile.in:		 Package updated to version 1.0.7.
	* win/Makefile.in:

5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208

5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307

5308
5309

5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379

5380
5381
5382
5383
5384
5385

5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397

5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408

5409
5410
5411

5412
5413

5414
5415
5416

5417
5418

5419
5420
5421
5422
5423
5424

5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589

5590
5591
5592
5593
5594
5595
5596
5597

5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
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







-
-
-
-
-
-
-
-
+

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





-
-
-
-
-
-
-
-
-
-
-









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

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

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

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



-
-



-
-
-
-
-
-
-
-
-
-
-















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-







	* library/tzdata/Asia/Karachi:
	* library/tzdata/Asia/Taipei:
	* library/tzdata/Europe/Samara:
	* library/tzdata/Pacific/Apia:
	* library/tzdata/Pacific/Easter:
	* library/tzdata/Pacific/Fiji:   Olson's tzdata2010i.

2010-04-29  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBinary.c (TclAppendBytesToByteArray): [Bug 2992970]: Make
	* generic/tclStringObj.c (Tcl_AppendObjToObj): an append of a byte
	array to another into an efficent operation. The problem was the (lack
	of) a proper growth management strategy for the byte array.

2010-04-29  Jan Nijtmans  <nijtmans@users.sf.net>
2010-04-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/dirent2.h:	Include "tcl.h", not <tcl.h>, like everywhere
	* compat/dlfcn.h:	else, to ensure that the version in the Tcl
	* compat/stdlib.h:	distribution is used, not some version from
	* compat/string.h:	somewhere else.
	* compat/unistd.h:

2010-04-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in:	Remove unused @MAN2TCLFLAGS@
	* win/tclWinPort.h:	Move <limits.h> include from tclInt.h to
	* generic/tclInt.h:	tclWinPort.h, and eliminate unneeded
	* generic/tclEnv.c:	<stdlib.h>, <stdio.h> and <string.h>, which
				are already in tclInt.h
	* generic/regcustom.h:	Move "tclInt.h" from regcustom.h up to
	* generic/regex.h:	regex.h.
	* generic/tclAlloc.c:	Unneeded <stdio.h> include.
	* generic/tclExecute.c:	Fix gcc warning: comparison between signed and
				unsigned.

2010-04-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclInt.h (TclIsVarDirectUnsettable): Corrected flags so that
	deletion of traces is not optimized out...

	* generic/tclExecute.c (ExecuteExtendedBinaryMathOp)
	(TclCompareTwoNumbers,ExecuteExtendedUnaryMathOp,TclExecuteByteCode):
	[Patch 2981677]: Move the less common arithmetic operations (i.e.,
	exponentiation and operations on non-longs) out of TEBC for a big drop
	in the overall size of the stack frame for most code. Net effect on
	speed is minimal (slightly faster overall in tclbench). Also extended
	the number of places where TRESULT handling is replaced with a jump to
	dedicated code.

2010-04-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Rearrange location of an
	assignment to shorten the object code.

2010-04-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIOUtil.c (Tcl_FSGetNativePath): [Bug 2992292]:
	tclIOUtil.c assignment type mismatch compiler warning
	* generic/regguts.h:     If tclInt.h or tclPort.h is already
	* generic/tclBasic.c:    included, don't include <limits.h>
	* generic/tclExecute.c:  again. Follow-up to [Bug 2991415]:
	* generic/tclIORChan.c:  tclport.h #included before limits.h
	* generic/tclIORTrans.c: See comments in [Bug 2991415]
	* generic/tclObj.c:
	* generic/tclOOInt.h:
	* generic/tclStrToD.c:
	* generic/tclTomMath.h:
	* generic/tclTomMathInterface.c:
	* generic/tclUtil.c:
	* compat/strtod.c:
	* compat/strtol.c:

2010-04-27  Kevin B. Kenny  <kennykb@acm.org>

	* unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Simplified the logic
	so that the casts added in Donal Fellows's change for the same bug are
	no longer necessary.

2010-04-26  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclLoadDl.c (FindSymbol): [Bug 2992295]: Added an explicit cast
	because auto-casting between function and non-function types is never
	naturally warning-free.

	* generic/tclStubInit.c:   Add a small amount of gcc-isms (with #ifdef
	* generic/tclOOStubInit.c: guards) to ensure that warnings are issued
	when these files are older than the various *.decls files.

2010-04-25  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:    Add unsupported [yieldm] command. Credit
	* generic/tclInt.h:      Lars Hellstrom for the basic idea.

2010-04-24  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:    Modify api of TclSpliceTailcall() to fix
	* generic/tclExecute.c:  [yieldTo], which had not survived the latest
	* generic/tclInt.h:      mods to tailcall. Thanks kbk for detecting
	the problem.

2010-04-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixPort.h: [Bug 2991415]: tclport.h #included before
	limits.h

2010-04-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclPlatDecls.h:  Move TCHAR fallback typedef from tcl.h to
	* generic/tcl.h:           tclPlatDecls.h (as suggested by dgp)
	* generic/tclInt.h:        fix typo
	* generic/tclIOUtil.c:     Eliminate various unnecessary
	* unix/tclUnixFile.c:      type casts.
	* unix/tclUnixPipe.c:
	* win/tclWinChan.c:
	* win/tclWinPort.h: [Patch 2986105]: Conditionally defining
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinFile.c: strcasecmp/strncasecmp
	* win/tclWinLoad.c:
	* win/tclWinPipe.c:

2010-04-20  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTest.c:  Use function prototypes from the FS API.
	* compat/zlib/*:      Upgrade to zlib 1.2.5

2010-04-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Improve commenting and
	reduce indentation for the Invocation Block.

2010-04-18  Donal K. Fellows  <dkf@users.sf.net>

	* doc/unset.n: [Bug 2988940]: Fix typo.

2010-04-15  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinPort.h:       Move inclusion of <tchar.h> from
	* generic/tcl.h:          tclPlatDecls.h to tclWinPort.h, where it
	* generic/tclPlatDecls.h: belongs. Add fallback in tcl.h, so TCHAR is
				  available in win32 always.

2010-04-15  Donal K. Fellows  <dkf@users.sf.net>

	* doc/try.n: [Bug 2987551]: Fix typo.

2010-04-14  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl: Linux platform identification:
	* library/platform/pkgIndex.tcl: Check /lib64 for existence of files
	* unix/Makefile.in: matching libc* before accepting it as base
	* win/Makefile.in:  directory. This can happen on weirdly installed
	32bit systems which have an empty or partially filled /lib64 without
	an actual libc. Bumped to version 1.0.6.

2010-04-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinPort.h: Fix [Patch 2986105]: conditionally defining
	* win/tclWinFile.c: strcasecmp/strncasecmp
	* win/tclWinLoad.c: Fix gcc warning: comparison of unsigned expression
	>= 0 is always true

2010-04-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmdsSZ.c (TclSubstCompile): If the first token does
	not result in a *guaranteed* push of a Tcl_Obj on the stack, we must
	push an empty object. Otherwise it is possible to get to a 'concat1'
	or 'done' without enough values on the stack, resulting in a crash.
	Thanks to Joe Mistachkin for identifying a script that could trigger
	this case.

2010-04-07  Donal K. Fellows  <dkf@users.sf.net>

	* doc/catch.n, doc/info.n, doc/return.n: Formatting.

2010-04-06  Donal K. Fellows  <dkf@users.sf.net>

	* doc/Load.3: Minor corrections of formatting and cross links.

2010-04-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/configure:       (regenerate with autoconf-2.59)
	* unix/configure:
	* unix/installManPage: [Bug 2982540]: configure and install* script
	* unix/install-sh:     files should always have LF line ending.
	* doc/Load.3:          Fix signature of Tcl_LoadFile in documentation.

2010-04-05  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
2010-04-03  Zoran Vasiljevic <vasiljevic@users.sourceforge.net>

	TIP #348 IMPLEMENTATION

	* generic/tclBasic.c: [Patch 2868499]: Substituted error stack
	* generic/tclCmdIL.c:
	* generic/tclInt.h:
	* generic/tclStringObj.c: (SetStringFromAny): avoid trampling
	* generic/tclNamesp.c:
	* generic/tclResult.c:
	* doc/catch.n:
	* doc/info.n:
	* doc/return.n:
	* tests/cmdMZ.test:
	* tests/error.test:
	* tests/execute.test:
	* tests/info.test:
	* tests/init.test:
	* tests/result.test:

	over the tclEmptyStringRep as it is thread-shared.
2010-04-05  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tcl.m4 (SC_ENABLE_THREADS): Flip the default for whether to
	* win/tcl.m4 (SC_ENABLE_THREADS):  build in threaded mode. Part of
	* win/rules.vc:			   TIP #364.

	* unix/tclLoadDyld.c (FindSymbol): Better human-readable error message
	generation to match code in tclLoadDl.c.

2010-04-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclThreadStorage.c (ThreadStorageGetHashTable):
	* generic/tclIOUtil.c, unix/tclLoadDl.c: Minor changes to enforce
	Engineering Manual style rules.

	avoid accessing shared table index w/o mutex protection
	* doc/FileSystem.3, doc/Load.3: Documentation for TIP#357.

	if VALGRIND defined on compilation time. This rules out
	* macosx/tclMacOSXBundle.c (OpenResourceMap): [Bug 2981528]: Only
	define this function when HAVE_COREFOUNDATION is defined.

	helgrind complains about potential race-conditions at
2010-04-02  Jan Nijtmans  <nijtmans@users.sf.net>

	that place.
	* generic/tcl.decls (Tcl_LoadFile): Add missing "const" in signature,
	* generic/tclIOUtil.c (Tcl_LoadFile): and some formatting fixes
	* generic/tclDecls.h:  (regenerated)

2010-04-02  Donal K. Fellows  <dkf@users.sf.net>

	Thanks to Gustaf Neumann for the (hard) work.
	* generic/tclIOUtil.c (Tcl_LoadFile): Corrections to previous commit
	* unix/tclLoadDyld.c (TclpDlopen):    to make it build on OSX.

2010-04-02  Kevin B. Kenny  <kennykb@acm.org>

	TIP #357 IMPLEMENTATION
	TIP #362 IMPLEMENTATION

	* generic/tclStrToD.c: [Bug 2952904]: Defer creation of the smallest
	floating point number until it is actually used. (This change avoids a
	bogus syslog message regarding a 'floating point software assist
	fault' on SGI systems.)

	* library/reg/pkgIndex.tcl:	[TIP #362]: Fixed first round of bugs
	* tests/registry.test:		resulting from the recent commits of
	* win/tclWinReg.c:		changes in support of the referenced
					TIP.

	* generic/tcl.decls:		[TIP #357]: First round of changes
	* generic/tclDecls.h:		to export Tcl_LoadFile,
	* generic/tclIOUtil.c:		Tcl_FindSymbol, and Tcl_FSUnloadFile
	* generic/tclInt.h:		to the public API.
	* generic/tclLoad.c:
	* generic/tclLoadNone.c:
	* generic/tclStubInit.c:
	* tests/fileSystem.test:
	* tests/load.test:
	* tests/unload.test:
	* unix/tclLoadDl.c:
	* unix/tclLoadDyld.c:
	* unix/tclLoadNext.c:
	* unix/tclLoadOSF.c:
	* unix/tclLoadShl.c:
	* unix/tclUnixPipe.c:
	* win/Makefile.in:
	* win/tclWinLoad.c:

2010-03-31  Donal K. Fellows  <dkf@users.sf.net>

	* doc/registry.n: Added missing documentation of TIP#362 flags.

	* doc/package.n: [Bug 2980210]: Document the arguments taken by
	the [package present] command correctly.

	* doc/Thread.3: Added some better documentation of how to create and
	use a thread using the C-level thread API, based on realization that
	no such tutorial appeared to exist.

2010-03-31  Jan Nijtmans  <nijtmans@users.sf.net>

	* test/cmdMZ.test:    [FRQ 2974744]: share exception codes (ObjType?):
	* test/error.test:    Revised test cases, making sure that abbreviated
	* test/proc-old.test: codes are checked resulting in an error, and
	                      checking for the exact error message.

2010-03-30  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORChan.c (ReflectClose, ReflectInput, ReflectOutput,
	(ReflectSeekWide, ReflectWatch, ReflectBlock, ReflectSetOption,
	(ReflectGetOption, ForwardProc): [Bug 2978773]: Preserve
	ReflectedChannel* structures across handler invokations, to avoid
	crashes when the handler implementation induces nested callbacks and
	destruction of the channel deep inside such a nesting.

2010-03-30  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclObj.c (Tcl_GetCommandFromObj):     [Bug 2979402]: Reorder
	the validity tests on internal rep of a "cmdName" value to avoid
	invalid reads reported by valgrind.

2010-03-30  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIndexObj:	[FRQ 2974744]: share exception codes
	* generic/tclResult.c:	further optimization, making use of indexType.
	* generic/tclZlib.c:    [Bug 2979399]: uninitialized value troubles

2010-03-30  Donal K. Fellows  <dkf@users.sf.net>

	TIP #362 IMPLEMENTATION

	* win/tclWinReg.c: [Patch 2960976]: Apply patch from Damon Courtney to
	* tests/registry.test:	allow the registry command to be told to work
	* win/Makefile.in:	with both 32-bit and 64-bit registries. Bump
	* win/configure.in:	version of registry package to 1.3.
	* win/makefile.bc:
	* win/makefile.vc:
	* win/configure:	autoconf-2.59

2010-03-29  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4:            Only test for -visibility=hidden with gcc
	                          (Second remark in [Bug 2976508])
	* unix/configure:         regen

2010-03-29  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:       Fix array overrun in test format-1.12
	caught by valgrind testing.

2010-03-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.h:	[FRQ 2974744]: share exception codes
	* generic/tclResult.c:	(ObjType?)
	* generic/tclCmdMZ.c:
	* generic/tclCompCmdsSZ.c:

2010-03-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclExecute.c: [Bug 2976508]: Tcl HEAD fails on HP-UX

2010-03-25  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixFCmd.c (TclUnixCopyFile): [Bug 2976504]: Corrected
	number of arguments to fstatfs() call.

	* macosx/tclMacOSXBundle.c, macosx/tclMacOSXFCmd.c:
	* macosx/tclMacOSXNotify.c: Reduce the level of ifdeffery in the
	functions of these files to improve readability. They need to be
	audited for whether complexity can be removed based on the minimum
	supported version of OSX, but that requires a real expert.

2010-03-24  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclResult.c:  [Bug 2383005]: Revise [return -errorcode] so
	* tests/result.test:    that it rejects illegal non-list values.

2010-03-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOInfo.c (InfoObjectMethodTypeCmd)
	(InfoClassMethodTypeCmd): Added introspection of method types so that
	it is possible to find this info out without using errors.
	* generic/tclOOMethod.c (procMethodType): Now that introspection can
	reveal the name of method types, regularize the name of normal methods
	to be the name of the definition type used to create them.

	* tests/async.test (async-4.*): Reduce obscurity of these tests by
	putting the bulk of the code for them inside the test body with the
	help of [apply].

	* generic/tclCmdMZ.c (TryPostBody, TryPostHandler): Make sure that the
	[try] command does not trap unwinding due to limits.

2010-03-23  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCmdMZ.c:	[Bug 2973361]: Revised fix for computing
	indices of script arguments to [try].

2010-03-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCmdMZ.c:      Make error message in "try" implementation
	* generic/tclCompCmdsSZ.c: exactly the same as the one in "return"
	* tests/error.test:
	* libtommath/mtests/mpi.c: Single "const" addition

2010-03-22  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCmdMZ.c:	[Bug 2973361]: Compute the correct integer
	values to identify the argument indices of the various script
	arguments to [try]. Passing in -1 led to invalid memory reads.

2010-03-20  Donal K. Fellows  <dkf@users.sf.net>

	* doc/exec.n: Make it a bit clearer that there is an option to run a
	pipeline in the background.

	* generic/tclIO.c (CopyData): Allow the total number of bytes copied
	* generic/tclIOCmd.c (Tcl_FcopyObjCmd):		Lift the restriction
	* generic/tclIO.c (TclCopyChannel, CopyData):	on the [fcopy] command
	* generic/tclIO.h (CopyState):			that forced it to only
	copy up to 2GB per script-level callback. Now it is anything that can
	fit in a (signed) 64-bit integer. Problem identified by Frederic
	Bonnet on comp.lang.tcl. Note that individual low-level reads and
	writes are still smaller as the optimal buffer size is smaller.

	by [fcopy] to exceed 2GB. Can happen when no -size parameter given.
2010-03-20  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/stub16.c:         Don't hide that we use the ASCII API here.
	                        (does someone still use that?)
	* win/tclWinPipe.c:     2 unnecessary type casts.

2010-03-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmdsSZ.c (TclCompileThrowCmd): Added compilation for
	the [throw] command.

2010-03-18  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclListObj.c:	[Bug 2971669]: Prevent in overflow trouble in
	* generic/tclTestObj.c:	ListObjReplace operations. Thanks to kbk for
	* tests/listObj.test:	fix and test.

2010-03-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmdsSZ.c (IssueTryFinallyInstructions):
	[Bug 2971921]: Corrected jump so that it doesn't skip into the middle
	of an instruction! Tightened the instruction issuing. Moved endCatch
	calls closer to their point that they guard, ensuring correct ordering
	of result values.

2010-03-17  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORTrans.c (ReflectInput, ReflectOutput)
	(ReflectSeekWide): [Bug 2921116]: Added missing TclEventuallyFree
	calls for preserved ReflectedTransform* structures. Reworked
	ReflectInput to preserve the structure for its whole life, not only in
	InvokeTclMethod.

	* generic/tclIO.c (Tcl_GetsObj): [Bug 2921116]: Regenerate topChan,
	may have been changed by a self-modifying transformation.

	* tests/ioTrans/test (iortrans-4.8, iortrans-4.9, iortrans-5.11)
	(iortrans-7.4, iortrans-8.3): New test cases.

2010-03-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* compat/zlib/*:	Upgrade zlib to version 1.2.4.
	* win/makefile.vc:
	* unix/Makefile.in:
	* win/tclWinChan.c:	Don't cast away "const" without reason.

2010-03-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/makefile.vc: [Bug 2967340]: Static build was failing.
	* win/.cvsignore:

2010-03-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTest.c:	Remove unnecessary '&' decoration for
	* generic/tclIOUtil.c:	function pointers
	* win/tclWin32Dll.c:	Double declaration of TclNativeDupInternalRep
	* unix/tclIOUtil.c:
	* unix/dltest/.cvsignore: Ignore *.so here

2010-03-09  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORChan.c: [Bug 2936225]: Thanks to Alexandre Ferrieux
	* doc/refchan.n:    <ferrieux@users.sourceforge.net> for debugging and
	* tests/ioCmd.test: fixing the problem. It is the write-side
	equivalent to the bug fixed 2009-08-06.

5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764



5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054

6055
6056

6057
6058
6059
6060
6061

6062
6063
6064


6065
6066
6067

6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108


6109
6110

6111
6112
6113
6114



6115
6116
6117
6118
6119
6120
6121

6122
6123
6124
6125
6126

6127
6128
6129
6130
6131


6132
6133
6134
6135
6136
6137
6138

6139
6140
6141
6142
6143
6144
6145
6146
6147
















6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171

6172
6173
6174
6175

6176
6177

6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188

6189
6190

6191
6192
6193
6194

6195
6196

6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-



-
-
-
-
-












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





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

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



-
+
+

-
+

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

-
+





+
+






-
+

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



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







	* library/tzdata/Antarctica/Casey:
	* library/tzdata/Antarctica/Davis:
	* library/tzdata/Antarctica/Mawson:
	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Pacific/Fiji:
	Olson tzdata2010c.

2010-03-07  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTest.c:	  Test that tclOO stubs are present in stub
				  library
	* generic/tclOOMethod.c:  Applied missing part of [Patch 2961556]
	* win/tclWinInt.h:	  Change all tclWinProcs signatures to use
	* win/tclWin32Dll.c:	  TCHAR* in stead of WCHAR*. This is meant
	* win/tclWinDde.c:	  as preparation to make [Enh 2965056]
	* win/tclWinFCmd.c:	  possible at all.
	* win/tclWinFile.c:
	* win/tclWinPipe.c:
	* win/tclWinSock.c:

2010-03-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclStubLib.c:	Remove presence of tclTomMathStubsPtr here.
	* generic/tclTest.c:	Test that tommath stubs are present in stub
				library.

2010-03-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclIORTrans.c (ForwardProc): [Bug 2964425]: When cleaning
	the stables, it is sometimes necessary to do more than the minimum. In
	this case, rationalizing the variables for a forwarded limit? method
	required removing an extra Tcl_DecrRefCount too.

	* generic/tclOO.h, generic/tclOOInt.h: [Patch 2961556]: Change TclOO
	to use the same style of function typedefs as Tcl, as this is about
	the last chance to get this right.

	***POTENTIAL INCOMPATIBILITY***
	Source code that uses function typedefs from TclOO will need to update
	variables and argument definitions so that pointers to the function
	values are used instead. Binary compatibility is not affected.

	* generic/*.c, generic/tclInt.h, unix/*.c, macosx/*.c: Applied results
	of doing a Code Audit. Principal changes:
	  * Use do { ... } while (0) in macros
	  * Avoid shadowing one local variable with another
	  * Use clearer 'foo.bar++;' instead of '++foo.bar;' where result not
	    required (i.e., semantically equivalent); clarity is increased
	    because it is bar that is incremented, not foo.
	  * Follow Engineering Manual rules on spacing and declarations

2010-03-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (ObjectRenamedTrace): [Bug 2962664]: Add special
	handling so that when the class of classes is deleted, so is the class
	of objects. Immediately.

	* generic/tclOOInt.h (ROOT_CLASS): Add new flag for specially marking
	the root class. Simpler and more robust than the previous technique.

2010-03-04  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclGetDate.y:    3 unnecessary MODULE_SCOPE
	* generic/tclDate.c:       symbols
	* generic/tclStubLib.c:    Split tommath stub lib
	* generic/tclTomMathStubLib.c:  in separate file.
	* win/makefile.bc:
	* win/Makefile.in:
	* win/makefile.vc:
	* win/tcl.dsp:
	* unix/Makefile.in:
	* unix/tcl.m4:          Cygwin only gives warning
	* unix/configure:       using -fvisibility=hidden
	* compat/strncasecmp.c: A few more const's
	* compat/strtod.c:
	* compat/strtoul.c:

2010-03-03  Andreas Kupries <andreask@activestate.com>

	* doc/refchan.n: Followup to ChangeLog entry 2009-10-07
	(generic/tclIORChan.c). Fixed the documentation to explain that errno
	numbers are operating system dependent, and reworked the associated
	example.

2010-03-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4:     [FRQ 2959069]: Support for -fvisibility=hidden
	* unix/configure   (regenerated with autoconf-2.59)

2010-03-01  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* unix/tclUnixSock.c: Refrain from a possibly lengthy reverse-DNS
	lookup on 0.0.0.0 when calling [fconfigure -sockname] on an
	universally-bound (default) server socket.
	* unix/tclUnixChan.c: [backported] Refrain from a possibly lengthy
	reverse-DNS lookup on 0.0.0.0 when calling [fconfigure -sockname]
	on an universally-bound (default) server socket.

	* generic/tclIndexObj.c: fix [AT 86258]: special-casing of empty
	tables when generating error messages for [::tcl::prefix match].

2010-02-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdIL.c: More additions of {TCL LOOKUP} error-code
	generation to various subcommands of [info] as part of long-term
	project to classify all Tcl's generated errors.

2010-02-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclStubInit.c: [Bug 2959713]: Link error with gcc 4.1

2010-02-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (StringFirstCmd, StringLastCmd): [Bug 2960021]:
	Only search for the needle in the haystack when the needle isn't
	larger than the haystack. Prevents an odd crash from sometimes
	happening when things get mixed up (a common programming error).

	* generic/tclMain.c (Tcl_Main): [Bug 801429]: Factor out the holding
	of the client-installed main loop function into thread-specific data.

	***POTENTIAL INCOMPATIBILITY***
	Code that previously tried to set the main loop from another thread
	will now fail. On the other hand, there is a fairly high probability
	that such programs would have been failing before due to the lack of
	any kind of inter-thread memory barriers guarding accesses to this
	part of Tcl's state.

2010-02-26  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c:   Split this file into two pieces to make it
	* generic/tclCompCmdsSZ.c: easier to work with. It's still two very
				   long files even after the split.

2010-02-26  Reinhard Max  <max@suse.de>

	* doc/safe.n: Name the installed file after the command it documents.
	Use "Safe Tcl" instead of the "Safe Base", "Safe Tcl" mixture.

2010-02-26  Donal K. Fellows  <dkf@users.sf.net>

	* unix/Makefile.in (NATIVE_TCLSH): Added this variable to allow for
	better control of what tclsh to use for various scripts when doing
	cross compiling. An imperfect solution, but works.

	* unix/installManPage: Remap non-alphanumeric sequences in filenames
	to single underscores (especially colons).

2010-02-26  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/zlib.test: Add tests for [Bug 2818131] which was crashing with
	mismatched zlib algorithms used in combination with gets. This issue
	has been fixed by Andreas's last commit.

2010-02-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclHash.c:	[FRQ 2958832]: Further speed-up of the
	* generic/tclLiteral.c:	ouster-hash function.
	* generic/tclObj.c:
	* generic/tclCkalloc.c:	Eliminate various unnecessary (ClientData)
	* generic/tclTest.c:	type casts.
	* generic/tclTestObj.c:
	* generic/tclTestProcBodyObj.c:
	* unix/tclUnixTest.c:
	* unix/tclUnixTime.c:
	* unix/tclXtTest.c:

2010-02-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclDictObj.c (SetDictFromAny): Prevent the list<->dict
	* generic/tclListObj.c (SetListFromAny): conversion code from taking
	too many liberties. Stops loss of duplicate keys in some scenarios.
	Many thanks to Jean-Claude Wippler for finding this.

	* generic/tclExecute.c (TclExecuteByteCode): Reduce ifdef-fery and
	size of activation record. More variables shared across instructions
	than before.

	* doc/socket.n: [Bug 2957688]: Clarified that [socket -server] works
	with a command prefix. Extended example to show this in action.

2010-02-22  Andreas Kupries  <andreask@activestate.com>

	* generic/tclZlib.c (ZlibTransformInput): [Bug 2762041]: Added a hack
	to work around the general problem, early EOF recognition based on the
	base-channel, instead of the data we have ready for reading in the
	transform. Long-term we need a proper general fix (likely tracking EOF
	on each level of the channel stack), with attendant complexity.
	Furthermore, Z_BUF_ERROR can be ignored, and must be when feeding the
	zlib code with single characters.

2010-02-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixPort.h:   Remove unnecessary EXTERN's, which already are
	                        in the global stub table.
	* unix/configure.in:    Use @EXEEXT@ in stead of @EXT_SUFFIX@
	* unix/tcl.m4:
	* unix/Makefile.in:     Use -DBUILD_tcl for CYGWIN
	* unix/configure:       (regenerated)
	* unix/dltest/pkg*.c:   Use EXTERN to control CYGWIN exported symbols
	* generic/tclCmdMZ.c:   Remove some unnecessary type casts.
	* generic/tclCompCmds.c:
	* generic/tclTest.c:
	* generic/tclUtil.c:

2010-02-21  Mo DeJong  <mdejong@users.sourceforge.net>

	* tests/regexp.test: Add test cases back ported from Jacl regexp work.

2010-02-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclDate.c:    Some more const tables.
	* generic/tclGetDate.y:
	* generic/regc_lex.c:
	* generic/regerror.c:
	* generic/tclStubLib.c:
	* generic/tclBasic.c:   Fix [Bug 2954959] expr abs(0.0) is -0.0
	* tests/expr.test:

2010-02-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileStringLenCmd): Make [string length]
	of a constant string be handled better (i.e., handle backslashes too).

2010-02-19  Stuart Cassoff  <stwo@users.sourceforge.net>

	* tcl.m4: Correct compiler/linker flags for threaded builds on
	OpenBSD.
	* configure: (regenerated).

2010-02-19  Donal K. Fellows  <dkf@users.sf.net>

	* unix/installManPage: [Bug 2954638]: Correct behaviour of manual page
	installer. Also added armouring to check that assumptions about the
	initial state are actually valid (e.g., look for existing input file).

2010-02-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclHash.c (HashStringKey):	Restore these hash functions
	* generic/tclLiteral.c (HashString):	to use the classic algorithm.
	* generic/tclObj.c (TclHashObjKey):	Community felt normal case
	speed to be more important than resistance to malicious cases. For
	now, hashes that need to deal with the malicious case can use a custom
	hash table and install their own hash function, though that is not
	functionality exposed to the script level.

	* generic/tclCompCmds.c (TclCompileDictUpdateCmd): Stack depth must be
	correctly described when compiling a body to prevent crashes in some
	debugging modes.

2010-02-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.h: Change order of various struct members,
	fixing potential binary incompatibility with Tcl 8.5

2010-02-16  Donal K. Fellows  <dkf@users.sf.net>

	* unix/configure.in, generic/tclIOUtil.c (Tcl_Stat): Updated so that
	we do not assume that all unix systems have the POSIX blkcnt_t type,
	since OpenBSD apparently does not.

	* generic/tclLiteral.c (HashString): Missed updating to FNV in one
	place; the literal table (a copy of the hash table code...)

2010-02-15  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl:   Reverted earlier rename from tcl*Stubs to
	* generic/tclBasic.c:   tcl*ConstStubs, it's not necessary at all.
	* generic/tclOO.c:
	* generic/tclTomMathInterface.c:
	* generic/tclStubInit.c: (regenerated)
	* generic/tclOOStubInit.c: (regenerated)
	* generic/tclEnsemble.c:Fix signed-unsigned mismatch
	* win/tclWinInt.h:      make tclWinProcs "const"
	* win/tclWin32Dll.c:
	* win/tclWinFCmd.c:     Eliminate all internal Tcl_WinUtfToTChar
	* win/tclWinFile.c:     and Tcl_WinTCharToUtf calls, needed
	* win/tclWinInit.c:     for mslu support.
	* win/tclWinLoad.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/.cvsignore:
	* compat/unicows/readme.txt:  [FRQ 2819611]: Add first part of MSLU
	* compat/unicows/license.txt: support.
	* compat/unicows/unicows.lib:

2010-02-15  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (AllocObject, SquelchedNsFirst, ObjectRenamedTrace):
	* generic/tclNamesp.c (Tcl_DeleteNamespace): [Bug 2950259]: Revised
	the namespace deletion code to provide an additional internal callback
	that gets triggered early enough in namespace deletion to allow TclOO
	destructors to run sanely. Adjusted TclOO to take advantage of this,
	so making tearing down an object by killing its namespace appear to
	work seamlessly, which is needed for Itcl. (Note that this is not a
	feature that will ever be backported to 8.5, and it remains not a
	recommended way of deleting an object.)

2010-02-13  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileSwitchCmd): Divided the [switch]
	compiler into three pieces (after the model of [try]): a parser, an
	instruction-issuer for chained tests, and an instruction-issuer for
	jump tables.

	* generic/tclEnsemble.c: Split the ensemble engine out into its own
	file rather than keeping it mashed together with the namespace code.

2010-02-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tcl.m4:		Use -pipe for gcc on win32
	* win/configure:	(mingw/cygwin) (regenerated)
	* win/.cvsignore:	Add .lib, .exp and .res here

2010-02-11  Mo DeJong  <mdejong@users.sourceforge.net>

	* tests/list.test: Add tests for explicit \0 in a string argument to
	the list command.

2010-02-11  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclIOCmd.c (Tcl_OpenObjCmd): [Bug 2949740]: Make sure that
	we do not try to put a NULL pipeline channel into binary mode.

2010-02-11  Mo DeJong  <mdejong@users.sourceforge.net>

	[Bug 2826551, Patch 2948425]: Assorted regexp bugs related to -all,
	-line and -start options and newlines.
	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd): If -offset is given, treat it
	as the start of the line if the previous character was a newline. Fix
	nasty edge case where a zero length match would not advance the index.
	* tests/regexp.test: Add regression tests back ported from Jacl.
	Checks for a number of issues related to -line and newline handling. A
	few of tests were broken before the patch and continue to be broken,
	marked as knownBug.

2010-02-11  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (ObjectRenamedTrace): [Bug 2949397]: Prevent
	destructors from running on the two core class objects when the whole
	interpreter is being destroyed.

2010-02-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileTryCmd, IssueTryInstructions)
	(IssueTryFinallyInstructions): Added compiler for the [try] command.
	It is split into three pieces that handle the parsing of the tokens,
	the issuing of instructions for finally-free [try], and the issuing of
	instructions for [try] with finally; there are enough differences
	between the all cases that it was easier to split the code rather than
	have a single function do the whole thing.

2010-02-09  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tools/genStubs.tcl: Remove dependency on 8.5+ idiom "in" in
	expressions.

2010-02-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (Tcl_ZlibDeflate, Tcl_ZlibInflate): [Bug 2947783]:
	Make sure that the result is an unshared object before appending to it
	so that nothing crashes if it is shared (use in Tcl code was not
	affected by this, but use from C was an issue).

2010-02-06  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclHash.c (HashStringKey):	Replace Tcl's crusty old hash
	* generic/tclObj.c (TclHashObjKey):	function with the algorithm
	due to Fowler, Noll and Vo. This is slightly faster (assuming the
	presence of hardware multiply) and has somewhat better distribution
	properties of the resulting hash values. Note that we only ever used
	the 32-bit version of the FNV algorithm; Tcl's core hash engine
	assumes that hash values are simple unsigned ints.

	***POTENTIAL INCOMPATIBILITY***
	Code that depends on hash iteration order (especially tests) may well
	be disrupted by this. Where a definite order is required, the fix is
	usually to just sort the results after extracting them from the hash.
	Where this is insufficient, the code that has ceased working was
	always wrong and was only working by chance.

2010-02-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCompCmds.c (TclCompileErrorCmd): Added compilation of the
	[error] command. No new bytecodes.

2010-02-05  Jan Nijtmans  <nijtmans@users.sf.net>
2010-02-07  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl:	Follow-up to earlier commit today:
	* tools/genStubs.tcl     Backport various formatting (spacing)
	          Eliminate the need for an extra Stubs Pointer for adressing
	          a static stub table: Just change the exported table from
	          static to MODULE_SCOPE.
	* generic/tclBasic.c
	* generic/tclOO.c
	* generic/tcl*.decls     changes from HEAD, so diffing
	* generic/tclTomMathInterface.c
	* generic/tcl*Decls.h (regenerated)
	* generic/tclStubInit.c (regenerated)
	* generic/tcl*Decls.h    between 8.5.x and 8.6 shows the
	* generic/tclStubInit.c  real structural differences again.
	* generic/tclOOStubInit.c (regenerated)
	* generic/tclTest.c (minor formatting)

	                         (any signature change not backported!)
2010-02-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclVar.c: More consistency in errorcode generation.

	* generic/tclOOBasic.c (TclOO_Object_Destroy): Rewrote to be NRE-aware
	when calling destructors. Note that there is no guarantee that
	destructors will always be called in an NRE context; that's a feature
	of the 'destroy' method only.

	* generic/tclEncoding.c: Add 'const' to many function-internal vars
	that are never pointing to things that are written to.

2010-02-05  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl:	Follow-up to [2010-01-29] commit:
		prevent space within stub table function parameters if the
		parameter type is a pointer.
	* win/tclWinInt.h:	Minor Formatting
	* generic/tcl.h:	VOID -> void and other formatting
	* generic/tclInt.h:	Minor formatting
	* generic/tclInt.decls: Change signature of TclNRInterpProcCore,
	* generic/tclOO.decls:	and TclOONewProc(Instance|)MethodEx,
	* generic/tclProc.c:	indicating that errorProc is a function,
	* generic/tclOOMethod.c:pointer, and other formatting
	* generic/tcl*Decls.h:	(regenerated)
	* generic/tclVar.c:	gcc warning(line 3703): 'pattern' may be used
				uninitialized in this function
				gcc warning(line 3788): 'matched' may be used
				uninitialized in this function

2010-02-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclVar.c: Added more use of error-codes and reduced the
	stack overhead of older interfaces.
	(ArrayGetCmd): Stop silly crash when using a trivial pattern due to
	error in conversion to ensemble.
	(ArrayNamesCmd): Use the object RE interface for faster matching.

2010-02-03  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclVar.c (ArrayUnsetCmd): More corrections.
	* generic/tclVar.c (Tcl_ArrayObjCmd): More corrections for the 'unset'
	subcommand.

2010-02-02  Donal K. Fellows  <dkf@users.sf.net>
2010-02-02  Andreas Kupries  <andreask@activestate.com>

	* generic/tclVar.c: Turned the [array] command into a true ensemble.

	* generic/tclOO.c (AllocObject, MyDeleted): A slightly faster way to
	* generic/tclCompile.c: [Bug 2933089]: A literal sharing problem with
	* generic/tclCompile.h: 'info frame' affects not only 8.6 but 8.5 as
	* generic/tclExecute.h: well. Backported the fix done in 8.6, without
	handle the deletion of [my] is with a standard delete callback. This
	is because it doesn't require an additional memory allocation during
	object creation. Also reduced the amount of string manipulation
	performed during object creation to further streamline memory
	handling; this is not backported to the 8.5 package as it breaks a
	number of abstractions.

	* tests/info.test: changes. New testcase info-39.1.
	* generic/tclOOBasic.c (TclOO_Object_Destroy): [Bug 2944404]: Do not
	crash when a destructor deletes the object that is executing that
	destructor.

2010-02-01  Donal K. Fellows  <dkf@users.sf.net>
2010-02-02  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclVar.c (Tcl_ArrayObjCmd): [Bug 2939073]: Stop the [array
	unset] command from having dangling pointer problems when an unset
	trace deletes the element that is going to be processed next. Many
	thanks to Alexandre Ferrieux for the bulk of this fix.

2010-02-01  Donal K. Fellows  <dkf@users.sf.net>

	* generic/regexec.c (ccondissect, crevdissect): [Bug 2942697]: Rework
	these functions so that certain pathological patterns are matched much
	more rapidly. Many thanks to Tom Lane for dianosing this issue and
	providing an initial patch.

2010-01-30  Donal K. Fellows  <dkf@users.sf.net>
2010-02-01  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCompile.c (tclInstructionTable):	Bytecode instructions
	* generic/tclCompCmds.c (TclCompileUnsetCmd):	to allow the [unset]
	* generic/tclExecute.c (TclExecuteByteCode):	command to be compiled
	with the compiler being a complete compilation for all compile-time
	decidable uses.

	* generic/tclVar.c (TclPtrUnsetVar): Var reference version of the code
	to unset a variable. Required for INST_UNSET bytecodes.
	* generic/tclInt.decls:		Various CYGWIN-related fixes
	* generic/tclInt.h:		backported from HEAD. Still
	* generic/tclIntPlatDecls.h:	configure script not modified,
	* generic/tclPort.h:		so CYGWIN build is still
	* generic/tclTest.c:		disabled. Reason: although the
	* win/cat.c:			build succeeds with those changes,
	* win/tclWinDde.c:		many tests still fail.
	* win/tclWinError.c:
	* win/tclWinFile.c:
	* win/tclWinPipe.c:
	* win/tclWinPort.h:
	* win/tclWinReg.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* win/tclWinTest.c:
	* win/tclWinThrd.c:

2010-01-29  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h: [Bug 2942081]: Reverted Tcl_ThreadDataKey type change
				Changed some Tcl_CallFrame fields from "char *"
				to "void *". This saves unnecessary space on
				Cray's (and it's simply more correct).

	* tools/genStubs.tcl:	No longer generate a space after "*" and
				immediately after a function name, so the
				format of function definitions in tcl*Decls.h
				match all other tcl*.h header files.
	* doc/ParseArgs.3:	Change Tcl_ArgvFuncProc, Tcl_ArgvGenFuncProc
	* generic/tcl.h:	and GetFrameInfoValueProc to be function
	* generic/tclInt.h:	definitions, not pointers, for consistency
	* generic/tclOOInt.h:	with all other Tcl function definitions.
	* generic/tclIndexObj.c:
	* generic/regguts.h:	CONST -> const
	* generic/tcl.decls:	Formatting
	* generic/tclTomMath.decls: Formatting
	* generic/tclDecls.h:	(regenerated)
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclOODecls.h:
	* generic/tcl.h:	Use correct TCL_LL_MODIFIER for CYGWIN.
	* generic/tclOOIntDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclTomMathDecls.h:

				Formatting (all backported from HEAD)
2010-01-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/rege_dfa.c:	Fix macro conflict on CYGWIN: don't use
	* generic/tclOOBasic.c (TclOO_Object_Destroy): Move the execution of
	destructors to a point where they can produce an error. This will not
	work for all destructors, but it does mean that more failing calls of
	them will be caught.
	* generic/tclOO.c (AllocObject, MyDeletedTrace, ObjectRenamedTrace):
	(ObjectNamespaceDeleted): Stop various ways of getting at commands
	with dangling pointers to the object. Also increases the reliability
	of calling of destructors (though most destructors won't benefit; when
	an object is deleted namespace-first, its destructors are not run in a
	nice state as the namespace is partially gone).

				"small".
2010-01-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTest.c:	Fix gcc 4.4 warning: ignoring return value of
	* generic/tclOOStubInit.c:   Remove double includes (which causes a
	* generic/tclOOStubLib.c:    warning in CYGWIN compiles)
	* unix/.cvsignore:	     add confdefs.h

	* unix/tclUnixPipe.c:	'write'
2010-01-22  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixNotify.c:
	* doc/proc.n: [Bug 1970629]: Define a bit better what the current
	namespace of a procedure is.

2010-01-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls:	     Don't use DWORD and HANDLE here.
	* generic/tclIntPlatDecls.h:
	* generic/tcl.h:	     Revert [2009-12-21] change, instead
	* generic/tclPort.h:	     resolve the CYGWIN inclusion problems by
	* win/tclWinPort.h:	     re-arranging the inclusions at other
				     places.
	* win/tclWinError.c
	* win/tclWinPipe.c
	* win/tcl.m4:		     Make cygwin configuration error into
	* win/configure.in:	     a warning: CYGWIN compilation works
	* win/configure:	     although there still are test failures.

2010-01-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Improve error code
	generation from some of the tailcall-related bits of TEBC.

2010-01-21  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCompile.h: [Bug 2910748]: NRE-enable direct eval on BC
	* generic/tclExecute.c: spoilage.
	* tests/nre.test:

2010-01-19  Donal K. Fellows  <dkf@users.sf.net>

	* doc/dict.n: [Bug 2929546]: Clarify just what [dict with] and [dict
	update] are doing with variables.

2010-01-18  Andreas Kupries  <andreask@activestate.com>
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253

6254
6255
6256
6257
6258
6259


6260
6261
6262
6263
6264
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
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
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525

6526
6527

6528
6529
6530

6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577

6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618

6619
6620
6621
6622
6623

6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645


6646
6647

6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856


6857
6858
6859

6860

6861
6862





6863


6864
6865
6866
6867
6868


6869
6870
6871

6872
6873
6874



6875
6876

6877
6878
6879
6880
6881
6882
6883







6884
6885
6886
6887
6888
6889




6890
6891

6892
6893
6894

6895
6896
6897
6898
6899

6900
6901
6902
6903
6904
6905


6906
6907
6908
6909

6910
6911
6912
6913

6914
6915
6916


6917
6918
6919
6920
6921

6922
6923
6924

6925
6926
6927
6928
6929

6930
6931

6932
6933
6934
6935

6936
6937

6938
6939
6940
6941
6942


6943
6944
6945
6946



6947
6948
6949
6950
6951
6952
6953
6954




6955
6956
6957
6958
6959
6960
6961
6962
6963
6964


6965
6966
6967

6968
6969
6970



6971
6972
6973
6974

6975
6976
6977

6978
6979
6980
6981
6982
6983
6984
6985
6986

6987
6988
6989
6990
6991

6992
6993
6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014
7015
7016
7017
7018
7019
7020
7021
7022
7023
7024
7025
7026
7027
7028
7029
7030
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
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
2658
2659


































2660
2661

2662





2663




2664
2665
2666
2667
2668
2669








2670
2671


2672
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
2709


2710
2711
2712
2713

2714
2715






2716
2717
2718
2719
2720
2721
2722
2723
2724
2725



2726
2727
2728
2729
2730

2731
2732


2733





2734

2735




2736
2737


2738

2739
2740
2741
2742

2743
2744


2745
2746



2747

2748

2749

2750
2751




2752


2753




2754


2755





2756
2757




2758
2759
2760








2761
2762
2763
2764










2765
2766



2767



2768
2769
2770




2771

2772

2773
2774
2775
2776
2777
2778
2779
2780


2781


2782


2783



















2784
2785
2786
2787
2788
2789







2790
2791
2792
2793
2794
2795
2796







-
-
-
-
-
-
-
-
+

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













-
-
-
-
-
-
-
-






-
-
-
-
-


-
-
-
-
-
-
-
-



-
-
-
-
-


-
-
-


-
-
+
+










-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-


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

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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






-
-
-
-
-
-
-
-


-
-
+
+
-
-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
+
+
-

-
+

+
-
-
+
+
+
+
+

+
+



-
-
+
+
-

-
+

-
-
+
+
+

-
+

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



-
-
-
+
+
+
+

-
+

-
-
+
-
-
-
-
-
+
-

-
-
-
-
+
+
-
-

-
+



-
+

-
-
+
+
-
-
-

-
+
-

-
+

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

-
+







-
-
+
-
-

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






-
-
-
-
-
-
-







2010-01-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclStringObj.c (Tcl_AppendFormatToObj): [Bug 2932421]: Stop
	the [format] command from causing argument objects to change their
	internal representation when not needed. Thanks to Alexandre Ferrieux
	for this fix.

2010-01-13  Donal K. Fellows  <dkf@users.sf.net>

	* tools/tcltk-man2html.tcl:	  More factoring out of special cases
	* tools/tcltk-man2html-utils.tcl: so that they are described outside
	the engine file. Now there is only one real set of special cases in
	there, to handle the .SO/.OP/.SE directives.

2010-01-13  Jan Nijtmans  <nijtmans@users.sf.net>
2010-01-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:      Fix TCL_LL_MODIFIER for Cygwin
	* generic/tclEnv.c:   Fix CYGWIN compilation problems,
	* generic/tclInt.h:   and remove some unnecessary
	* generic/tclPort.h:  double includes.
	* generic/tclPlatDecls.h:
	* generic/tclCompExpr.c: Warning: array subscript has type 'char'
	* generic/tclPkg.c:
	* win/cat.c:
	* win/tclWinConsole.c:
	* win/tclWinFCmd.c:
	* win/tclWinFile.c:
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinThrd.c:
	* win/tclWinPort.h:   Put win32 includes first
	* unix/tclUnixChan.c: Forgot one CONST change

	* libtommath/bn_mp_read_radix.c:
2010-01-12  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tclUnixCompat.c:	Fix gcc warning: signed and unsigned type
	* tools/tcltk-man2html.tcl: Make the generation of the list of things
	to process the docs from simpler and more flexible. Also factored out
	the lists of special cases.

				in conditional expression.
2010-01-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4: Add support for Haiku and CYGWIN dynamical loading
	* win/tclWinDde.c:      VC++ 6.0 doesn't have
	* win/tclWinReg.c:      PDWORD_PTR
	* win/tclWinThrd.c:     Fix various minor gcc warnings.
	* win/tclWinTime.c:
	* win/tclWinConsole.c:  Put channel type definitions
	* win/tclWinChan.c:     in static const memory
	* win/tclWinPipe.c:
	* win/tclWinSerial.c:
	* win/tclWinSock.c:
	* generic/tclIOGT.c:
	* generic/tclIORChan.c:
	* generic/tclIORTrans.c:
	* unix/tclUnixChan.c:
	* unix/tclUnixPipe.c:
	* unix/tclUnixSock.c:
	* unix/configure: (regenerated)
	* unix/Makefile.in:
	* unix/.cvsignore:
	* unix/configure:       (regenerated with autoconf 2.59)
	* tests/info.test:      Make test independant from
	                        tcltest implementation.

	* tests/stack.test: Reduced minimum required C-stack size to 2034:
2010-01-10  Donal K. Fellows  <dkf@users.sf.net>

			    CYGWIN has this stack size and the test runs fine!
	* tests/namespace.test (namespace-51.17): [Bug 2898722]: Demonstrate
	that there are still bugs in the handling of resolution epochs. This
	bug is not yet fixed.

	* generic/tclEnv.c: Fix environment tests under CYGWIN
	* tools/tcltk-man2html.tcl:	  Split the man->html converter into
	* tools/tcltk-man2html-utils.tcl: two pieces for easier maintenance.
	Also made it much less verbose in its printed messages by default.

	* generic/tclPort.h:
2010-01-09  Donal K. Fellows  <dkf@users.sf.net>

	* tests/env.test:
	* tools/tcltk-man2html.tcl: Added basic support for building the docs
	for contributed packages into the HTML versions. Prompted by question
	on Tcler's Chat by Tom Krehbiel. Note that there remain problems in
	the documentation generated due to errors in the contributed docs.

2010-01-05  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c (TclPathPart):   [Bug 2918610]: Correct
	* tests/fileName.test (filename-14.31): inconsistency between the
	string rep and the intrep of a path value created by [file rootname].
	Thanks to Vitaly Magerya for reporting.

2010-01-03  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 1636685]: Use the configuration
	for modern FreeBSD suggested by the FreeBSD porter.

2010-01-03  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	[Bug 2724403]: Fix leak of coroutines on
	* generic/tclCompile.h: namespace deletion. Added a test for this
	* generic/tclNamesp.c:	leak, and also a test for leaks on namespace
	* tests/coroutine.test: deletion.
	* tests/namespace.test:

2009-12-30  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (AliasSource): [Bug 2923613]: Make the safer
	* tests/safe.test (safe-8.9):	  [source] handle a [return] at the
					  end of the file correctly.

2009-12-30  Miguel Sofer  <msofer@users.sf.net>

	* library/init.tcl (unknown): [Bug 2824981]: Fix infinite recursion of
	::unknown when [set] is undefined.

2009-12-29  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclHistory.c (Tcl_RecordAndEvalObj): Reduce the amount of
	allocation and deallocation of memory by caching objects in the
	interpreter assocData table.

	* generic/tclObj.c (Tcl_GetCommandFromObj): Rewrite the logic so that
	it does not require making assignments part way through an 'if'
	condition, which was deeply unclear.

	* generic/tclInterp.c (Tcl_MakeSafe): [Bug 2895741]: Make sure that
	the min() and max() functions are supported in safe interpreters.

2009-12-29  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclBinary.c:	[Bug 2922555]: Handle completely invalid input
	* tests/binary.test:	to the decode methods.

2009-12-28  Donal K. Fellows  <dkf@users.sf.net>

	* unix/Makefile.in (trace-shell, trace-test): [FRQ 1083288]: Added
	targets to allow easier tracing of shell and test invokations.

	* unix/configure.in: [Bug 942170]:	Detect the st_blocks field of
	* generic/tclCmdAH.c (StoreStatData):	'struct stat' correctly.
	* generic/tclFileName.c (Tcl_GetBlocksFromStat):
	* generic/tclIOUtil.c (Tcl_Stat):
	* generic/tclIOUtil.c (Tcl_Stat, Tcl_FSStat):
	* generic/tclTest.c (PretendTclpStat):

	* generic/tclInterp.c (TimeLimitCallback): [Bug 2891362]: Ensure that
	* tests/interp.test (interp-34.13):	   the granularity ticker is
	reset when we check limits because of the time limit event firing.

2009-12-27  Donal K. Fellows  <dkf@users.sf.net>

	* doc/namespace.n (SCOPED SCRIPTS): [Bug 2921538]: Updated example to
	not be quite so ancient.

2009-12-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCmdMZ.c:      CONST -> const
	* generic/tclParse.c

2009-12-23  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (AliasSource, AliasExeName): [Bug 2913625]: Stop
	information about paths from leaking through [info script] and [info
	nameofexecutable].

2009-12-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4:		Install libtcl8.6.dll in bin directory
	* unix/Makefile.in:
	* unix/configure:	(regenerated)

2009-12-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): [Bug 2918962]: Stop crash when
	-index and -stride are used together.

2009-12-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclThreadStorage.c: Fix gcc warning, using gcc-4.3.4 on
				      cygwin: missing initializer
	* generic/tclOOInt.h:	      Prevent conflict with DUPLICATE
				      definition in WINAPI's nb30.h
	* generic/rege_dfa.c:	      Fix macro conflict on CYGWIN: don't use
				      "small".
	* generic/tcl.h:	      Include <winsock2.h> before <stdio.h> on
				      CYGWIN
	* generic/tclPathObj.c
	* generic/tclPort.h
	* tests/env.test:	      Don't unset WINDIR and TERM, it has a
				      special meaning on CYGWIN (both in UNIX
				      and WIN32 mode!)
	* generic/tclPlatDecls.h:     Include <tchar.h> through tclPlatDecls.h
	* win/tclWinPort.h:	      stricmp -> strcasecmp
	* win/tclWinDde.c:	      _wcsicmp -> wcscasecmp
	* win/tclWinFile.c
	* win/tclWinPipe.c
	* win/tclWinSock.c
	* unix/tcl.m4:		      Add dynamic loading support to CYGWIN
	* unix/configure (regenerated)
	* unix/Makefile.in

2009-12-19  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	[Bug 2917627]: Fix for bad cmd resolution by
	* tests/coroutine.test:	coroutines. Thanks to schelte for finding it.

2009-12-16  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (::safe::AliasGlob): Upgrade to correctly support a
	larger fraction of [glob] functionality, while being stricter about
	directory management.

2009-12-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTest.c:	Fix gcc warning: ignoring return value of
	* unix/tclUnixNotify.c:	"write", declared with attribute
	* unix/tclUnixPipe.c:	warn_unused_result.
	* generic/tclInt.decls:	CONSTify functions TclpGetUserHome and
	* generic/tclIntDecls.h:TclSetPreInitScript (TIP #27)
	* generic/tclInterp.c:
	* win/tclWinFile.c:
	* unix/tclUnixFile.c:

2009-12-16  Donal K. Fellows  <dkf@users.sf.net>

	* doc/tm.n: [Bug 1911342]: Formatting rewrite to avoid bogus crosslink
	to the list manpage when generating HTML.

	* library/msgcat/msgcat.tcl (Init): [Bug 2913616]: Do not use platform
	tests that are not needed and which don't work in safe interpreters.

2009-12-14  Donal K. Fellows  <dkf@users.sf.net>

	* doc/file.n (file tempfile): [Bug 2388866]: Note that this only ever
	creates files on the native filesystem. This is a design feature.

2009-12-13  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	Release TclPopCallFrame() from its
	* generic/tclExecute.c:	tailcall-management duties
	* generic/tclNamesp.c:

	* generic/tclBasic.c:	Moving TclBCArgumentRelease call from
	* generic/tclExecute.c:	TclNRTailcallObjCmd to TEBC, so that the
	pairing of the Enter and Release calls is clearer.

2009-12-12  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclTest.c (TestconcatobjCmd): [Bug 2895367]: Stop memory
	leak when testing. We don't need extra noise of this sort when
	tracking down real problems!

2009-12-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclBinary.c:	Fix gcc warning, using gcc-4.3.4 on cygwin
	* generic/tclCompExpr.c:warning: array subscript has type 'char'
	* generic/tclPkg.c:
	* libtommath/bn_mp_read_radix.c:
	* win/makefile.vc:	[Bug 2912773]: Revert to version 1.203
	* unix/tclUnixCompat.c:	Fix gcc warning: signed and unsigned type
				in conditional expression.

2009-12-11  Donal K. Fellows  <dkf@users.sf.net>

	* tools/tcltk-man2html.tcl (long-toc, cross-reference): [FRQ 2897296]:
	Added cross links to sections within manual pages.

2009-12-11  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   [Bug 2806407]: Full nre-enabling of coroutines
	* generic/tclExecute.c:

	* generic/tclBasic.c: Small cleanup

	* generic/tclExecute.c: Fix panic in http11.test caused by buggy
	earlier commits in coroutine management.

2009-12-10  Andreas Kupries  <andreask@activestate.com>

	* generic/tclObj.c (TclContinuationsEnter): [Bug 2895323]: Updated
	comments to describe when the function can be entered for the same
	Tcl_Obj* multiple times. This is a continuation of the 2009-11-10
	entry where a memory leak was plugged, but where not sure if that was
	just a band-aid to paper over some other error. It isn't, this is a
	legal situation.

2009-12-10  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   Reducing the # of moving parts for coroutines
	* generic/tclExecute.c: by delegating more to tebc; eliminate the
	special coroutine CallFrame.

2009-12-09  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c: [Bug 2901998]: Applied Alexandre Ferrieux's patch
	fixing the inconsistent buffered I/O. Tcl's I/O now flushes buffered
	output before reading, discards buffered input before writing, etc.

	* library/safe.tcl: Backport of the streamlined safe base from
2009-12-09  Miguel Sofer  <msofer@users.sf.net>

	* tests/safe.test: head to the 8.5 branch (See head changelog entries
	* generic/tclBasic.c: Ensure right lifetime of varFrame's (objc,objv)
	for coroutines.

	2009-11-05, 2009-11-06, 2009-12-03).
	* generic/tclExecute.c: Code regrouping

2009-12-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c: Added some of the missing setting of errorcode
	values.

2009-12-08  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (TclStackFree): Improved panic msg.

2009-12-08  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   Partial nre-enabling of coroutines. The
	* generic/tclExecute.c: initial call still requires its own
	* generic/tclInt.h:     instance of tebc, but on resume coros can
	execute in the caller's tebc.

	* generic/tclExecute.c (TEBC): Silence warning about pcAdjustment.

2009-12-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TclExecuteByteCode): Make the dict opcodes
	more sparing in their use of C variables, to reduce size of TEBC
	activiation record a little bit.

2009-12-07  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (TEBC): Grouping "slow" variables into structs,
	to reduce register pressure and help the compiler with variable
	allocation.

2009-12-07  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c: Start cleaning the TEBC stables
	* generic/tclInt.h:

	* generic/tclCmdIL.c:   [Bug 2910094]: Fix by aku
	* tests/coroutine.test:

	* generic/tclBasic.c: Arrange for [tailcall] to be created with the
	other builtins: was being created in a separate call, leftover from
	pre-tip days.

2009-12-07  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStrToD.c: [Bug 2902010]: Correct conditional compile
	* generic/tclStrToD.c:	[Bug 2902010]: Correct conditional compile
	directives to better detect the toolchain that needs extra work for
	proper underflow treatment instead of merely detecting the MIPS
	platform.

2009-12-07  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c: [Patch 2910056]: Add ::tcl::unsupported::yieldTo
	* generic/tclInt.h:

2009-12-07  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (TryPostBody): [Bug 2910044]: Close off memory
	leak in [try] when a variable-free handler clause is present.

2009-12-05  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   Small changes for clarity in tailcall
	* generic/tclExecute.c: and coroutine code.
	* tests/coroutine.test:

	* tests/tailcall.test: Remove some old unused crud; improved the
	stack depth tests.

	* generic/tclBasic.c:  Fixed things so that you can tailcall
	* generic/tclNamesp.c: properly out of a coroutine.
	* tests/tailcall.test:

	* generic/tclInterp.c: Fixed tailcalls for same-interp aliases (no
	test)

2009-12-03  Donal K. Fellows  <dkf@users.sf.net>

	* library/safe.tcl (::safe::AliasEncoding): Make the safe encoding
	command behave more closely like the unsafe one (for safe ops).
	(::safe::AliasGlob): [Bug 2906841]: Clamp down on evil use of [glob]
	in safe interpreters.
	* tests/safe.test: Rewrite to use tcltest2 better.

2009-12-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* tools/genStubs.tcl:	Add support for win32 CALLBACK functions and
	* tools/genStubs.tcl: Add support for win32 CALLBACK functions (needed
	remove obsolete "emitStubs" and "genStubs" functions.
	* win/Makefile.in:	Use tcltest86.dll for all tests, and add
	.PHONY rules to preemptively stop trouble that plagued Tk from hitting
	Tcl too.

	for Tk bugfix).
2009-11-30  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.h:	Don't use EXPORT for Tcl_InitStubs
	* win/Makefile.in:	Better dependancies in case of static build.

2009-11-30  Donal K. Fellows  <dkf@users.sf.net>

	* doc/Tcl.n: [Bug 2901433]: Improved description of expansion to
	mention that it is using list syntax.

2009-11-27  Kevin B. Kenny  <kennykb@acm.org>

	* win/tclAppInit.c (Tcl_AppInit): [Bug 2902965]: Reverted Jan's change
	that added a call to Tcl_InitStubs. The 'tclsh' and 'tcltest' programs
	are providers, not consumers of the Stubs table, and should not link
	with the Stubs library, but only with the main Tcl library. (In any
	case, the presence of Tcl_InitStubs broke the build.)

2009-11-27  Donal K. Fellows  <dkf@users.sf.net>

	* doc/BoolObj.3, doc/Class.3, doc/CrtChannel.3, doc/DictObj.3:
	* doc/DoubleObj.3, doc/Ensemble.3, doc/Environment.3:
	* doc/BoolObj.3, doc/CrtChannel.3, doc/DictObj.3, doc/DoubleObj.3:
	* doc/Ensemble.3, doc/Environment.3, doc/FileSystem.3, doc/Hash.3:
	* doc/FileSystem.3, doc/Hash.3, doc/IntObj.3, doc/Limit.3:
	* doc/Method.3, doc/NRE.3, doc/ObjectType.3, doc/PkgRequire.3:
	* doc/IntObj.3, doc/Limit.3, doc/ObjectType.3, doc/PkgRequire.3:
	* doc/SetChanErr.3, doc/SetResult.3: [Patch 2903921]: Many small
	spelling fixes from Larry Virden.

	BUMP VERSION OF TCLOO TO 0.6.2. Too many people need accumulated small
	versions and bugfixes, so the version-bump removes confusion.

	* generic/tclOOBasic.c (TclOO_Object_LinkVar): [Bug 2903811]: Remove
	unneeded restrictions on who can usefully call this method.

2009-11-26  Donal K. Fellows  <dkf@users.sf.net>

	* unix/Makefile.in: Add .PHONY rules and documentation to preemptively
	stop trouble that plagued Tk from hitting Tcl too, and to make the
	overall makefile easier to understand. Some reorganization too to move
	related rules closer together.

2009-11-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in:	[Bug 2902965]: Fix stub related changes that
	* win/makefile.vc:	caused tclkit build to break.
	* win/tclAppInit.c
	* unix/tcl.m4
	* unix/Makefile.in
	* unix/tclAppInit.c
	* unix/configure:	(regenerated)

2009-11-25  Kevin B. Kenny  <kennykb@acm.org>

	* win/Makefile.in:	Added a 'test-tcl' rule that is identical to
	'test' except that it does not go spelunking in 'pkgs/'. (This rule
	has existed in unix/Makefile.in for some time.)

2009-11-25  Stuart Cassoff  <stwo@users.sf.net>

	* unix/configure.in:	[Patch 2892871]: Remove unneeded
	* unix/tcl.m4:		AC_STRUCT_TIMEZONE and use
	* unix/tclConfig.h.in:	AC_CHECK_MEMBERS([struct stat.st_blksize])
	* unix/tclUnixFCmd.c:	instead of AC_STRUCT_ST_BLKSIZE.
	* unix/configure:	Regenerated with autoconf-2.59.

2009-11-24  Andreas Kupries  <andreask@activestate.com>

	* library/tclIndex: Manually redone the part of tclIndex dealing with
	safe.tcl and tm.tcl. This part passes the testsuite. Note that
	automatic regeneration of this part is not possible because it wrongly
	puts 'safe::Setup' on the list, and wrongly leaves out 'safe::Log'
	which is more dynamically created than the generator expects.

	Further note that the file "clock.tcl" is explicitly loaded by
	"init.tcl", the first time the clock command is invoked. The relevant
	code can be found at line 172ff, roughly, the definition of the
	procedure 'clock'. This means none of the procedures of this file
	belong in the tclIndex. Another indicator that automatic regeneration
	of tclIndex is ill-advised.

2009-11-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (FinalizeAlloc, Tcl_NewObjectInstance):
	[Bug 2903011]: Make it an error to destroy an object in a constructor,
	and also make sure that an object is not deleted twice in the error
	case.

2009-11-24  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/fCmd.test: [Bug 2893771]: Teach [file stat] to handle locked
	* win/tclWinFile.c: files so that [file exists] no longer lies.

2009-11-23  Kevin Kenny  <kennykb@acm.org>

	* tests/fCmd.test (fCmd-30.1): Changed registry location of the 'My
	Documents' folder to the one that's correct for Windows 2000, XP,
	Server 2003, Vista, Server 2008, and Windows 7. (See
	http://support.microsoft.com/kb/310746)

2009-11-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinDde.c:	#undef STATIC_BUILD, in order to make sure
	* win/tclWinReg.c:	that Xxxxx_Init is always exported even when
	* generic/tclTest.c:	Tcl is built static (otherwise we cannot
				create a DLL).
	* generic/tclThreadTest.c: Make all functions static, except
				TclThread_Init.
	* tests/fCmd.test:	Enable fCmd-30.1 when registry is available.
	* win/tcl.m4:		Fix ${SHLIB_LD_LIBS} definition, fix conflicts
	* win/Makefile.in:	Simplifications related to tcl.m4 changes.
	* win/configure.in:	Between static libraries and import library on
				windows.
	* win/configure:	(regenerated)
	* win/makefile.vc:	Add stub library to necessary link lines.

2009-11-23  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Further
	machinations to get NewTestThread actually to launch the thread, not
	just compile.

2009-11-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclThreadTest.c (NewTestThread): [Bug 2901803]: Fix small
	error in function naming which blocked a threaded test build.

2009-11-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in:	Create tcltest86.dll as dynamic Tcltest
				package.
	* generic/tclTest.c:	Remove extraneous prototypes, follow-up to
	* generic/tclTestObj.c:	[Bug 2883850]
	* tests/chanio.test:	Test-cases for fixed [Bug 2849797]
	* tests/io.test:
	* tests/safe.test:	Fix safe-10.1 and safe-10.4 test cases, making
				the wrong assumption that Tcltest is a static
				package.
	* generic/tclEncoding.c:[Bug 2857044]: Updated freeIntRepProc routines
	* generic/tclVar.c:	so that they set the typePtr field to NULL so
				that the Tcl_Obj is not left in an
				inconsistent state.
	* unix/tcl.m4:		[Patch 2883533]: tcl.m4 support for Haiku OS
	* unix/configure:	autoconf-2.59

2009-11-19  Don Porter  <dgp@users.sourceforge.net>

	* unix/tclAppInit.c:	[Bug 2883850, 2900542]: Repair broken build of
	* win/tclAppInit.c:	the tcltest executable.

2009-11-19  Donal K. Fellows  <dkf@users.sf.net>

	* library/auto.tcl (tcl_findLibrary):
	* library/clock.tcl (MakeUniquePrefixRegexp, MakeParseCodeFromFields)
	(SetupTimeZone, ProcessPosixTimeZone):	Restored the use of a literal
	* library/history.tcl (HistAdd):	'then' when following a multi-
	* library/safe.tcl (interpConfigure):	line test expresssion. It's an
	* library/tm.tcl (UnknownHandler):	aid to readability then.

2009-11-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.h:      Make all internal initialization
	* generic/tclTest.c:     routines MODULE_SCOPE
	* generic/tclTestObj.c:
	* generic/tclTestProcBodyObj.c:
	* generic/tclThreadTest.c:
	* unix/Makefile.in:      Fix [Bug 2883850]: pkgIndex.tcl doesn't
	* unix/tclAppInit.c:     get created with static Tcl build
	* unix/tclXtTest.c:
	* unix/tclXtNotify.c:
	* unix/tclUnixTest.c:
	* win/Makefile.in:
	* win/tcl.m4:
	* win/configure:         (regenerated)
	* win/tclAppInit.c:
	* win/tclWinDde.c:       Always compile with Stubs.
	* win/tclWinReg.c:
	* win/tclWinTest.c:

2009-11-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/CrtChannel.3:	[Bug 2849797]: Fix channel name inconsistences
	* generic/tclIORChan.c:	as suggested by DKF.
	* generic/tclIO.c:	Minor *** POTENTIAL INCOMPATIBILITY ***
				because Tcl_CreateChannel() and derivatives
				now sometimes ignore their "chanName"
				argument.

	* generic/tclAsync.c:	Eliminate various gcc warnings (with -Wextra)
	* generic/tclBasic.c
	* generic/tclBinary.c
	* generic/tclCmdAH.c
	* generic/tclCmdIL.c
	* generic/tclCmdMZ.c
	* generic/tclCompile.c
	* generic/tclDate.c
	* generic/tclExecute.c
	* generic/tclDictObj.c
	* generic/tclIndexObj.c
	* generic/tclIOCmd.c
	* generic/tclIOUtil.c
	* generic/tclIORTrans.c
	* generic/tclOO.c
	* generic/tclZlib.c
	* generic/tclGetDate.y
	* win/tclWinInit.c
	* win/tclWinChan.c
	* win/tclWinConsole.c
	* win/tclWinNotify.c
	* win/tclWinReg.c
	* library/auto.tcl:		Eliminate "then" keyword
	* library/clock.tcl
	* library/history.tcl
	* library/safe.tcl
	* library/tm.tcl
	* library/http/http.tcl:	Eliminate unnecessary spaces
	* library/http1.0/http.tcl
	* library/msgcat/msgcat.tcl
	* library/opt/optparse.tcl
	* library/platform/platform.tcl
	* tools/tcltk-man2html.tcl
	* tools/tclZIC.tcl
	* tools/tsdPerf.c

2009-11-17  Andreas Kupries  <andreask@activestate.com>

	* unix/tclUnixChan.c (TtyParseMode): Partial undo of Donal's tidy-up
	from a few days ago (2009-11-9, not in ChangeLog). It seems that
	strchr is apparently a macro on AIX and reacts badly to pre-processor
	directives in its arguments.

2009-11-16  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclEncoding.c:  [Bug 2891556]: Fix and improve test to
	* generic/tclTest.c:	  detect similar manifestations in the future.
	* generic/tclEncoding.c: Fix [Bug 2891556] and improve test to detect
	* tests/decoding.test:   similar manifestations in the future.
	* tests/encoding.test:    Add tcltest support for finalization.

2009-11-15  Mo DeJong  <mdejong@users.sourceforge.net>
2009-11-12  Don Porter  <dgp@users.sourceforge.net>

	*** 8.5.8 TAGGED FOR RELEASE ***
	* win/tclWinDde.c: Avoid gcc compiler warning by explicitly casting
	DdeCreateStringHandle argument.

	* changes:	Update for 8.5.8 release.

	* generic/tclClock.c (TclClockInit):    Do not create [clock] support
	commands in safe interps.

	* tests/io.test:	New test io-53.11 to test for [Bug 2895565].

2009-11-12  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (CopyData): [Bug 2895565]: Dropped bogosity which
	* tests/io.test: used the number of _written_ bytes or character to
	update the counters for the read bytes/characters. New test io-53.11.
	used the number of _written_ bytes or character to update the counters
	for the read bytes/characters. See last entry for the test case.
	This is a forward port from the 8.5 branch.

2009-11-11  Don Porter  <dgp@users.sourceforge.net>
2009-11-11  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclClock.c (TclClockInit):    Do not create [clock] support
	commands in safe interps.
	* tests/fCmd.test:     Fixed a number of issues for Vista and Win7
	* tests/registry.test: that are due to restricted permissions.
	* tests/winFCmd.test:

2009-11-11  Jan Nijtmans  <nijtmans@users.sf.net>
2009-11-11  Don Porter  <dgp@users.sourceforge.net>

	* library/http/http.tcl (http::geturl): [Bug 2891171]: URL checking
	too strict when using multiple question marks.
	* tests/http.test
	* library/http/pkgIndex.tcl:  Bump to http 2.8.2
	* unix/Makefile.in:
	* win/Makefile.in:
	* library/http/http.tcl:	[Bug 2891171]: Update the URL syntax
	check to RFC 3986 compliance on the subject of non-encoded question
	mark characters.

	* library/http/pkgIndex.tcl:	Bump to http 2.7.5 to avoid any
	* unix/Makefile.in:		confusion with snapshot "releases"
	* win/Makefile.in:		that might be in ActiveTcl, etc.

2009-11-11  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error) by
	saving the errno from the first of two FlushChannel()s. Uneasy to
	test; might need specific channel drivers. Four-hands with aku.
	* generic/tclIO.c: Fix [Bug 2888099] (close discards ENOSPC error)
	                   by saving the errno from the first of two
	                   FlushChannel()s. Uneasy to test; might need
	                   specific channel drivers. Four-hands with aku.

2009-11-10  Pat Thoyts  <patthoyts@users.sourceforge.net>
2009-11-10  Don Porter  <dgp@users.sourceforge.net>

	* tests/winFCmd.test: Cleanup directories that have been set chmod
	000. On Windows7 and Vista we really have no access and these were
	* generic/tclBasic.c:	Plug another leak in TCL_EVAL_DIRECT
	getting left behind.
	A few tests were changed to reflect the intent of the test where
	setting a directory chmod 000 should prevent any modification. This
	restriction was ignored on XP but is honoured on Vista

	evaluation.
2009-11-10  Andreas Kupries  <andreask@activestate.com>

	* generic/tclBasic.c: Plug another leak in TCL_EVAL_DIRECT evaluation.
	Forward port from Tcl 8.5 branch, change by Don Porter.

	* generic/tclObj.c: [Bug 2895323]: Plug memory leak in
	* generic/tclObj.c:	Plug memory leak in TclContinuationsEnter().
	[Bug 2895323]
	TclContinuationsEnter(). Forward port from Tcl 8.5 branch, change by
	Don Porter.

2009-11-09  Stuart Cassoff  <stwo@users.sf.net>
2009-11-09  Stuart Cassoff <stwo@users.sf.net>

	* win/README: [bug 2459744]: Removed outdated Msys + Mingw info.

2009-11-09  Andreas Kupries  <andreask@activestate.com>
2009-11-09  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c (TclEvalObjEx): Moved the #280 decrement of
	refCount for the file path out of the branch after the whole
	* generic/tclBasic.c (TclEvalObjEx):	Plug memory leak in
	TCL_EVAL_DIRECT evaluation.
	conditional, closing a memory leak. Added clause on structure type to
	prevent seg.faulting. Forward port from valgrinding the Tcl 8.5
	branch.

	* tests/info.test: Resolve ambiguous resolution of variable "res".
	* tests/info.test:	Resolve ambiguous resolution of variable "res".
	Forward port from 8.5

2009-11-08  Donal K. Fellows  <dkf@users.sf.net>
2009-11-03  Don Porter  <dgp@users.sourceforge.net>

	* doc/string.n (bytelength): Noted that this command is not a good
	thing to use, and suggested a better alternatve. Also factored out the
	description of the indices into its own section.

	* generic/tcl.h:	Bump to 8.5.8 for release.
2009-11-07  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/init.tcl:
	* tests/fCmd.test: [Bug 2891026]: Exclude tests using chmod 555
	directories on vista and win7. The current user has access denied and
	so cannot rename the directory without admin privileges.

	* tools/tcl.wse.in:
2009-11-06  Andreas Kupries  <andreask@activestate.com>

	* unix/configure.in:
	* library/safe.tcl (::safe::Setup): Added documentation of the
	contents of the state array. Also killed the 'InterpState' procedure
	with its upleveled variable/upvar combination, and replaced all uses
	with 'namespace upvar'.

	* unix/tcl.spec:
	* win/configure.in:
2009-11-05  Andreas Kupries  <andreask@activestate.com>

	* library/safe.tcl: A series of patches which bring the SafeBase up to
	date with code guidelines, Tcl's features, also eliminating a number
	* README:

	* unix/configure:	autoconf-2.59
	of inefficiencies along the way.
	(1) Changed all procedure names to be fully qualified.
	(2) Moved the procedures out of the namespace eval. Kept their
	locations. IOW, broke the namespace eval apart into small sections not
	covering the procedure definitions.
	(3) Reindented the code. Just lots of whitespace changes.
	Functionality unchanged.
	(4) Moved the multiple namespace eval's around. Command export at the
	* win/configure:

	* changes:	Update for 8.5.8 release.

	top, everything else (var decls, argument parsing setup) at the
	bottom.
	(5) Moved the argument parsing setup into a procedure called when the
	code is loaded. Easier management of temporary data.
	(6) Replaced several uses of 'Set' with calls to the new procedure
	'InterpState' and direct access to the per-slave state array.
	(7) Replaced the remaining uses of 'Set' and others outside of the
	path/token handling, and deleted a number of procedures related to
	state array access which are not used any longer.
	(8) Converted the path token system to cache normalized paths and path
2009-11-03  Andreas Kupries  <andreask@activestate.com>

	<-> token conversions. Removed more procedures not used any longer.
	Removed the test cases 4.3 and 4.4 from safe.test. They were testing
	the now deleted command "InterpStateName".
	* library/safe.tcl (::safe::InterpSetConfig): [Bug 2854929]: Added
	(9) Changed the log command setup so that logging is compiled out
	completely when disabled (default).
	(10) Misc. cleanup. Inlined IsInterp into CheckInterp, its only user.
	code to recursively find deeper paths which may contain modules.
	Required to handle modules with names like 'platform::shell', which
	translate into 'platform/shell-X.tm', i.e arbitrarily deep
	Consistent 'return -code error' for error reporting. Updated to use
	modern features (lassign, in/ni, dicts). The latter are used to keep a
	reverse path -> token map and quicker check of existence.
	(11) Fixed [Bug 2854929]: Recurse into all subdirs under all TM root
	subdirectories.
	dirs and put them on the access path.

2009-11-02  Kevin B. Kenny  <kennykb@acm.org>
2009-11-03  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Asia/Novokuznetsk: New tzdata locale for Kemerovo
	oblast', which now keeps Novosibirsk time and not Kranoyarsk time.
	* library/tzdata/Asia/Damascus: Syrian DST changes.
	* library/tzdata/Asia/Hong_Kong: Hong Kong historic DST corrections.
	Olson tzdata2009q.

2009-11-02  Donal K. Fellows  <dkf@users.sf.net>

2009-11-03  Pat Thoyts  <patthoyts@users.sourceforge.net>
	* doc/object.n (DESCRIPTION): Substantive revision to make it clearer
	what the fundamental semantics of an object actually are.

2009-11-01  Joe Mistachkin  <joe@mistachkin.com>

	* tests/tcltest.test: Backport permissions fix for Win7.
	* doc/Cancel.3: Minor cosmetic fixes.
	* win/makefile.vc: Make htmlhelp target work again.  An extra set of
	double quotes around the definition of the HTML help compiler tool
	appears to be required.  Previously, there was one set of double
	quotes around the definition of the tool and one around the actual
	invocation.  This led to confusion because it was the only such tool
	path to include double quotes around its invocation.  Also, it was
	somewhat inflexible in the event that somebody needed to override the
	tool command to include arguments.  Therefore, even though it may look
	"wrong", there are now two double quotes on either side of the tool
	path definition.  This fixes the problem that currently prevents the
	htmlhelp target from building and maintains flexibility in case
	somebody needs to override it via the command line or an environment
	variable.

2009-11-01  Joe English  <jenglish@users.sourceforge.net>

	* doc/Eval.3, doc/Cancel.3: Move TIP#285 routines out of Eval.3 into
	their own manpage.

2009-10-31  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c (ExprRoundFunc): [Bug 2889593]: Correctly report
	the expected number of arguments when generating an error for round().

2009-10-30  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/tcltest.test: When creating the notwritabledir we deny the
	current user access to delete the file. We must grant this right when
	we cleanup. Required on Windows 7 when the user does not automatically
	have administrator rights.

2009-10-29  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:        Changed the typedef for the mp_digit type
	from:
		typedef unsigned long mp_digit;
	to:
		typedef unsigned int mp_digit;
7042
7043
7044
7045
7046
7047
7048
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
2808
2809
2810
2811
2812
2813
2814








2815
2816
2817
2818
2819
2820
2821
2822
2823

2824








2825
2826
2827
2828
2829
2830
2831







-
-
-
-
-
-
-
-









-
+
-
-
-
-
-
-
-
-







	arguments *will*, and callers of routines with (mp_int *) arguments
	*may* suffer both binary and stubs incompatibilities with Tcl releases
	8.5.0 - 8.5.7.  Such possibilities should be checked, and if such
	incompatibilities are present, suitable [package require] requirements
	on the Tcl release should be put in place to keep such built code
	[load]-ing only in Tcl interps that are compatible.

2009-10-29  Donal K. Fellows  <dkf@users.sf.net>

	* tests/dict.test: Make variable-clean and simplify tests by utilizing
	the fact that dictionaries have defined orders.

	* generic/tclZlib.c (TclZlibCmd): Remove accidental C99-ism which
	reportedly makes the AIX native compiler choke.

2009-10-29  Kevin B. Kenny  <kennykb@acm.org>

	* library/clock.tcl (LocalizeFormat):
	* tests/clock.test (clock-67.1):
	[Bug 2819334]: Corrected a problem where '%%' followed by a letter in
	a format group could expand recursively: %%R would turn into %%H:%M:%S

2009-10-28  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclLiteral.c:	[Bug 2888044]: Fixed 2 bugs.
	* generic/tclLiteral.c:	Backport fix for [Bug 2888044].
	* tests/info.test:	First, as noted in the comments of the
	TclCleanupLiteralTable routine, since the teardown of the intrep of
	one Tcl_Obj can cause the teardown of others in the same table, the
	full table cleanup must be done with care, but the code did not
	contain the same care demanded in the comment.  Second, recent
	additions to the info.test file had poor hygiene, leaving an array
	variable ::a lying around, which breaks later interp.test tests during
	a -singleproc 1 run of the test suite.

2009-10-28  Kevin B. Kenny  <kennykb@acm.org>

	* tests/fileName.test (fileName-20.[78]): Corrected poor test
	hygiene (failure to save and restore the working directory) that
	caused these two tests to fail on Windows (and [Bug 2806250] to be
	reopened).
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
7137
7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167








7168
7169
7170
7171
7172


7173
7174
7175
7176
7177
7178
7179
2844
2845
2846
2847
2848
2849
2850





2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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







-
-
-
-
-



















-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-





+
+
+
+
+
+
+
+



-
-
+
+







	Added a test case for the above bug.
	* library/tzdata/America/Argentina/Buenos_Aires:
	* library/tzdata/America/Argentina/Cordoba:
	* library/tzdata/America/Argentina/San_Luis:
	* library/tzdata/America/Argentina/Tucuman:
	New DST rules for Argentina. (Olson's tzdata2009p.)

2009-10-26  Don Porter  <dgp@users.sourceforge.net>

	* unix/Makefile.in:	Remove $(PACKAGE).* and prototype from the
	`make distclean` target.  Completes 2009-10-20 commit.

2009-10-24  Kevin B. Kenny  <kennykb@acm.org>

	* library/clock.tcl (ProcessPosixTimeZone):
	Corrected a regression in the fix to [Bug 2207436] that caused
	[clock] to apply EU daylight saving time rules in the US.
	Thanks to Karl Lehenbauer for reporting this regression.
	* tests/clock.test (clock-52.4):
	Added a regression test for the above bug.
	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Asia/Karachi:
	New DST rules for Bangladesh and Pakistan. (Olson's tzdata2009o.)

2009-10-23  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (FlushChannel): Skip OutputProc for low-level
	0-length writes. When closing pipes which have already been closed
	not skipping leads to spurious SIG_PIPE signals. Reported by
	Mikhail Teterin <mi+thun@aldan.algebra.com>.

2009-10-22  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOBasic.c (TclOO_Object_VarName): [Bug 2883857]: Allow
	the passing of array element names through this method.

2009-10-21  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclPosixStr.c: [Bug 2882561]: Work around oddity on Haiku OS
	where SIGSEGV and SIGBUS are the same value.

	* generic/tclTrace.c (StringTraceProc): [Bug 2881259]: Added back cast
	to work around silly bug in MSVC's handling of auto-casting.

2009-10-20  Don Porter  <dgp@users.sourceforge.net>

	* unix/Makefile.in:	Removed the long outdated and broken targets
	package-* that were for building Solaris packages.  Appears that the
	pieces needed for these targets to function have never been present in
	the current era of Tcl development and belong completely to Tcl
	pre-history.

2009-10-19  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIO.c:      [Patch 2107634]: Revised ReadChars and
	FilterInputBytes routines to permit reads to continue up to the string
	limits of Tcl values.  Before revisions, large read attempts could
	panic when as little as half the limiting value length was reached.
	Thanks to Sean Morrison and Bob Parker for their roles in the fix.

2009-10-18  Joe Mistachkin  <joe@mistachkin.com>

	* generic/tclObj.c (TclDbDumpActiveObjects, TclDbInitNewObj)
	(Tcl_DbIncrRefCount, Tcl_DbDecrRefCount, Tcl_DbIsShared):
	[Bug 2871908]: Enforce separation of concerns between the lineCLPtr
	and objThreadMap thread specific data members.

2009-10-18  Joe Mistachkin  <joe@mistachkin.com>

	* tests/thread.test (thread-4.[345]): [Bug 1565466]: Correct tests to
	save their error state before the final call to threadReap just in
	case it triggers an "invalid thread id" error.  This error can occur
	if one or more of the target threads has exited prior to the attempt
	to send it an asynchronous exit command.

	* doc/memory.n: [Bug 988703]: Add mechanism for finding what Tcl_Objs
	* generic/tclCkalloc.c (MemoryCmd): are allocated when built for
	* generic/tclInt.decls: memory debugging. This was previously
	* generic/tclInt.h: backported from Tcl 8.6 with the corrections to
	* generic/tclObj.c (ObjData, TclFinalizeThreadObjects): fix [Bug
	2871908]. However, there were key elements missing. These changes make
	things consistent between branches.

2009-10-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclVar.c (UnsetVarStruct, TclDeleteNamespaceVars)
	(TclDeleteCompiledLocalVars, DeleteArray):
	* generic/tclVar.c (TclDeleteCompiledLocalVars, UnsetVarStruct)
	(TclDeleteNamespaceVars):
	* generic/tclTrace.c (Tcl_UntraceVar2): [Bug 2629338]: Stop traces
	that are deleted part way through (a feature used by tdom) from
	causing freed memory to be accessed.

2009-10-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclDictObj.c (DictIncrCmd): [Bug 2874678]: Don't leak any
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207

7208
7209

7210
7211
7212
7213
7214
7215
7216
7217


7218
7219
7220
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249

7250
7251
7252
7253
7254
7255

7256
7257

7258
7259
7260

7261
7262

7263
7264
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288
7289
7290
7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390


7391
7392
7393
7394

7395
7396
7397
7398
7399
7400



7401
7402
7403
7404
7405
7406
7407
7408
7409




7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420
7421
7422
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







-
-
-
-
-
-




-
+

-
+
-
-
-



-
-
+
+
-










-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+

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






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
+
+



-
+



-
-
-
+
+
+





-
-
-
-
+
+
+
+



-
-
-







	* generic/tclIORChan.c (ErrnoReturn): Replace hardwired constant 11
	with proper errno #define, EAGAIN. What was I thinking? The BSD's have
	a different errno assignment and break with the hardwired number.
	Reported by emiliano on the chat.

2009-10-06  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclInterp.c (SlaveEval): Agressive stomping of internal reps
	was added as part of the NRE patch of 2008-07-13.  This doesn't appear
	to actually be needed, and it hurts quite a bit when large lists lose
	their intreps and require reparsing.  Thanks to Ashok Nadkarni for
	reporting the problem.

	* generic/tclTomMathInt.h (new): Public header tclTomMath.h had
	* generic/tclTomMath.h:	dependence on private headers, breaking use
	* generic/tommath.h:	by extensions [Bug 1941434].

2009-10-05  Andreas Kupries  <andreask@activestate.com>
2009-10-05  Don Porter  <dgp@users.sourceforge.net>

	* library/safe.tcl (AliasGlob): Fixed conversion of catch to
	* changes:	Update for 8.5.8 release.
	try/finally, it had an 'on ok msg' branch missing, causing a silent
	error immediately, and bogus glob results, breaking search for Tcl
	modules.

2009-10-04  Daniel Steffen  <das@users.sourceforge.net>

	* macosx/tclMacOSXBundle.c:	[Bug 2569449]: Workaround CF memory
	* unix/tclUnixInit.c:		managment bug in Mac OS X 10.4 &
	* macosx/tclMacOSXBundle.c:	Workaround CF memory managment bug in
	* unix/tclUnixInit.c:		Mac OS X 10.4 & earlier. [Bug 2569449]
					earlier.

2009-10-02  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Karachi:
	* library/tzdata/Pacific/Apia:	Olson's tzdata2009n.

2009-09-29  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclDictObj.c:		[Bug 2857044]: Updated freeIntRepProc
	* generic/tclExecute.c:		routines so that they set the typePtr
	* generic/tclIO.c:		field to NULL so that the Tcl_Obj is
	* generic/tclIndexObj.c:	not left in an inconsistent state.
	* generic/tclInt.h:
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclOOCall.c:
	* generic/tclObj.c:
	* generic/tclPathObj.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclStringObj.c:

	* generic/tclAlloc.c:           Cleaned up various routines in the
	* generic/tclCkalloc.c:         call stacks for memory allocation to
	* generic/tclInt.h:             guarantee that any size values computed
	* generic/tclThreadAlloc.c:     are within the domains of the routines
	they get passed to.  [Bugs 2557696 and 2557796].

2009-09-28  Don Porter  <dgp@users.sourceforge.net>
2009-09-11  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCmdMZ.c:	Replaced TclProcessReturn() calls with
	* tests/error.test:	Tcl_SetReturnOptions() calls as a simple fix
	for [Bug 2855247].  Thanks to Anton Kovalenko for the report and fix.
	Additional fixes for other failures demonstrated by new tests.

	* library/http/http.tcl:	Bump to http 2.7.4 to account for
2009-09-27  Don Porter  <dgp@users.sourceforge.net>

	* library/http/pkgIndex.tcl:	[Bug 2849860] fix.
	* tests/error.test (error-15.8.*):	Coverage tests illustrating
	flaws in the propagation of return options by [try].

	* unix/Makefile.in:
2009-09-26  Donal K. Fellows  <dkf@users.sf.net>

	* win/Makefile.in:
	* unix/tclooConfig.sh, win/tclooConfig.sh: [Bug 2026844]: Added dummy
	versions of tclooConfig.sh that make it easier to build extensions
	against both Tcl8.5+TclOO-standalone and Tcl8.6.

2009-09-24  Don Porter  <dgp@users.sourceforge.net>

	TIP #356 IMPLEMENTATION

	* generic/tcl.decls:	Promote internal routine TclNRSubstObj()
	* generic/tclCmdMZ.c:	to public Tcl_NRSubstObj().  Still needs docs.
	* generic/tclCompile.c:
	* generic/tclInt.h:

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2009-09-23  Miguel Sofer  <msofer@users.sf.net>

	* doc/namespace.n: the description of [namespace unknown] failed
	to mention [namespace path]: fixed. Thx emiliano.

2009-09-21  Mo DeJong  <mdejong@users.sourceforge.net>

	* tests/regexp.test: Added check for error message from
	unbalanced [] in regexp. Added additional simple test cases
	of basic regsub command.

2009-09-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompile.c:	Correct botch in the conversion of
	Tcl_SubstObj().  Thanks to Kevin Kenny for detection and report.

2009-09-17  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompile.c:	Re-implement Tcl_SubstObj() as a simple
	* generic/tclParse.c:	wrapper around TclNRSubstObj().  This has
	* tests/basic.test:	the effect of caching compiled bytecode in
	* tests/parse.test:	the value to be substituted.  Note that
	Tcl_SubstObj() now exists only for extensions.  Tcl itself no longer
	makes any use of it.  Note also that TclSubstTokens() is now reachable
	only by Tcl_EvalEx() and Tcl_ParseVar() so tests aiming to test its
	functioning needed adjustment to still have the intended effect.

2009-09-16  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclObj.c:   Extended ::tcl::unsupported::representation.

2009-09-11  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c:	Completed the NR-enabling of [subst].
	* generic/tclCmdMZ.c:	[Bug 2314561].
	* generic/tclCompCmds.c:
	* generic/tclCompile.c:
	* generic/tclInt.h:
	* tests/coroutine.test:
	* tests/parse.test:

2009-09-11  Donal K. Fellows  <dkf@users.sf.net>

	* tests/http.test: Added in cleaning up of http tokens for each test
	to reduce amount of global-variable pollution.

2009-09-10  Donal K. Fellows  <dkf@users.sf.net>

	* library/http/http.tcl (http::Event): [Bug 2849860]: Handle charset
	names in double quotes; some servers like generating them like that.

2009-09-07  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclParse.c:	[Bug 2850901]: Corrected line counting error
	* tests/into.test:	in multi-command script substitutions.

2009-09-07  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclExecute.c:	Fix potential uninitialized variable use and
	* generic/tclFCmd.c:	null dereference flagged by clang static
	* generic/tclProc.c:	analyzer.
	* generic/tclTimer.c:
	* generic/tclUtf.c:

	* generic/tclExecute.c:	Silence false positives from clang static
	* generic/tclIO.c:	analyzer about potential null dereference.
	* generic/tclScan.c:
	* generic/tclCompExpr.c:

2009-09-04  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompCmds.c (TclCompileSubstCmd): [Bug 2314561]:
	* generic/tclBasic.c:	Added a bytecode compiler routine for the
	* generic/tclCmdMZ.c:	[subst] command. This is a partial solution to
	* generic/tclCompile.c:	the need to NR-enable [subst] since bytecode
	* generic/tclCompile.h:	execution is already NR-enabled. Two new
	* generic/tclExecute.c:	bytecode instructions, INST_NOP and
	* generic/tclInt.h:	INST_RETURN_CODE_BRANCH were added to support
	* generic/tclParse.c:	the new routine.  INST_RETURN_CODE_BRANCH is
	* tests/basic.test:	likely to be useful in any future effort to
	* tests/info.test:	add a bytecode compiler routine for [try].
	* tests/parse.test:

2009-09-03  Donal K. Fellows  <dkf@users.sf.net>

	* doc/LinkVar.3: [Bug 2844962]: Added documentation of issues relating
	to use of this API in a multi-threaded environment.

2009-09-01  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORTrans.c (ReflectInput): Remove error response to
	0-result from method 'limit?' of transformations. Return the number of
	copied bytes instead, which is possibly nothing. The latter then
	triggers EOF handling in the higher layers, making the 0-result of
	limit? the way to inject artificial EOF's into the data stream.

2009-09-01  Don Porter  <dgp@users.sourceforge.net>

	* library/tcltest/tcltest.tcl:  Bump to tcltest 2.3.2 after revision
	* library/tcltest/pkgIndex.tcl: to verbose error message.
	* unix/Makefile.in:
	* win/Makefile.in:

2009-08-27  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:       [Bug 2845535]: A few more string
	overflow cases in [format].

2009-08-25  Andreas Kupries  <andreask@activestate.com>

	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard)
	(Tcl_EvalEx, TclEvalEx, TclAdvanceContinuations, TclNREvalObjEx):
	(EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations)
	(TclEvalObjEx):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
	* generic/tclCompCmds.c (*):
	* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv)
	(TclFreeCompileEnv, TclCompileScript, TclCompileTokens):
	(TclFreeCompileEnv, TclCompileScript):
	* generic/tclCompile.h (CompileEnv):
	* generic/tclInt.h (ContLineLoc, Interp):
	* generic/tclObj.c (ThreadSpecificData, ContLineLocFree)
	(TclThreadFinalizeObjects, TclInitObjSubsystem, TclContinuationsEnter,
	(TclContinuationsEnterDerived, TclContinuationsCopy, TclFreeObj)
	(TclContinuationsGet):
	(TclThreadFinalizeObjects, TclInitObjSubsystem, TclContinuationsEnter)
	(TclContinuationsEnterDerived, TclContinuationsCopy)
	(TclContinuationsGet, TclFreeObj):
	* generic/tclParse.c (TclSubstTokens, Tcl_SubstObj):
	* generic/tclProc.c (TclCreateProc):
	* generic/tclVar.c (TclPtrSetVar):
	* tests/info.test (info-30.0-24):

	Extended the parser, compiler, and execution engine with code and
	attendant data structures tracking the position of continuation lines
	which are not visible in the resulting script Tcl_Obj*'s, to properly
	account for them while counting lines for #280.
	Extended parser, compiler, and execution with code and attendant data
	structures tracking the positions of continuation lines which are not
	visible in script Tcl_Obj*'s, to properly account for them while
	counting lines for #280.

2009-08-24  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclInt.h: Annotate Tcl_Panic as noreturn for clang static
	analyzer in PURIFY builds, replacing preprocessor/assert technique.

	* macosx/tclMacOSXNotify.c: Fix multiple issues with nested event loops
	when CoreFoundation notifier is running in embedded mode. (Fixes
	problems in TkAqua Cocoa reported by Youness Alaoui on tcl-mac)

2009-08-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFileName.c: Correct regression in [Bug 2837800] fix.
7432
7433
7434
7435
7436
7437
7438
7439

7440
7441
7442
7443
7444
7445
7446
7447
7448
7449
7450
7451
7452
7453
7454
7455
7456
7457
7458
7459
7460
7461
7462
7463
7464
7465
7466
7467
7468
7469
7470
7471
7472
7473
7474
7475
7476
7477
7478
7479
7480
7481
7482
7483
7484
7485
7486
7487
7488
7489
7490
7491
7492
7493
7494
7495
7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530
7531
7532
7533
7534
7535
7536
7537
7538
7539
7540
7541
7542
7543
7544
7545
7546
7547
7548
7549

7550
7551
7552
7553
7554
7555


7556
7557
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602
7603
7604
7605

7606
7607
7608
7609
7610
7611

7612
7613
7614
7615

7616
7617

7618
7619
7620
7621
7622

7623
7624
7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
7635


7636
7637
7638

7639
7640
7641


7642
7643

7644
7645

7646
7647
7648
7649
7650
7651

7652
7653
7654
7655
7656
7657



7658
7659
7660
7661
7662
7663

7664
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732
7733
7734
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
7769
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
7803
7804
3022
3023
3024
3025
3026
3027
3028

3029







3030
3031
3032
3033
3034
3035

























3036
3037
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







-
+
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-


-
-
-
-
-





-
-
-
-
-
-
-
-
-






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





-
+
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-
-
-
-
-
-
-


-
-
+

-
-
-

-
+
-
-

-
+

-
+



-
-
+
-
-
-
-

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

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









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
-
-
-
-
-
-
-
-







	intrep when PATHFLAGS != 0.  This establishes the assumptions relied
	on elsewhere that the name stored there is a relative path.  Also
	refactored to make an AppendPath() routine instead of the cut/paste
	stanzas that were littered throughout.

2009-08-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdIL.c (TclNRIfObjCmd): [Bug 2823276]: Make [if]
	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Plug memory leak.
	NRE-safe on all arguments when interpreted.
	(Tcl_LsortObjCmd): Close off memory leak.

2009-08-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c (TclNRForObjCmd, etc.): [Bug 2823276]: Make [for]
	and [while] into NRE-safe commands, even when interpreted.

2009-08-18  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c: [Bug 2837800]: Added NULL check to prevent
	* tests/fileName.test:  crashes during [glob].

2009-08-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/dltest/pkge.c:  const addition
	* unix/tclUnixThrd.c:  Use <pthread.h> in stead of "pthread.h"
	* win/tclWinDde.c:     Eliminate some more gcc warnings
	* win/tclWinReg.c:
	* generic/tclInt.h:    Change ForIterData, make it const-safe.
	* generic/tclCmdAH.c:

2009-08-12  Don Porter  <dgp@users.sourceforge.net>

	TIP #353 IMPLEMENTATION

	* doc/NRE.3:		New public routine Tcl_NRExprObj() permits
	* generic/tcl.decls:	extension commands to evaluate Tcl expressions
	* generic/tclBasic.c:	in NR-enabled command procedures.
	* generic/tclCmdAH.c:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* generic/tclObj.c:
	* tests/expr.test:

	* generic/tclDecls.h:		make genstubs
	* generic/tclStubInit.c:

2009-08-06  Andreas Kupries  <andreask@activestate.com>

	* doc/refchan.n [Bug 2827000]: Extended the implementation of
	* generic/tclIORChan.c: reflective channels (TIP 219, method
	* tests/ioCmd.test: 'read'), enabling handlers to signal EAGAIN to
	indicate 'no data, but not at EOF either', and other system
	errors. Updated documentation, extended testsuite (New test cases
	iocmd*-23.{9,10}).

2009-08-02  Miguel Sofer  <msofer@users.sf.net>

	* tests/coroutine.test: fix testfile cleanup

2009-08-02  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclObj.c (Tcl_RepresentationCmd): Added an unsupported
	command for reporting the representation of an object. Result string
	is deliberately a bit obstructive so that people are not encouraged to
	make code that depends on it; it's a debugging tool only!

	* unix/tclUnixFCmd.c (GetOwnerAttribute, SetOwnerAttribute)
	(GetGroupAttribute, SetGroupAttribute): [Bug 1942222]: Stop calling
	* unix/tclUnixFile.c (TclpGetUserHome): endpwent() and endgrent();
	they've been unnecessary for ages.

2009-08-02  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWin32Dll.c: Eliminate TclWinResetInterfaceEncodings, since it
	* win/tclWinInit.c:  does exactly the same as TclWinEncodingsCleanup,
	* win/tclWinInt.h:   make sure that tclWinProcs and
			     tclWinTCharEncoding are always set and reset
			     concurrently.
	* win/tclWinFCmd.c:  Correct check for win95

2009-07-31  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c: [Bug 2830354]:	Corrected failure to
	* tests/format.test:		grow buffer when format spec request
	large width floating point values.  Thanks to Clemens Misch.

2009-07-26  Donal K. Fellows  <dkf@users.sf.net>

	* library/auto.tcl (tcl_findLibrary, auto_mkindex):
	* library/package.tcl (pkg_mkIndex, tclPkgUnknown, MacOSXPkgUnknown):
	* library/safe.tcl (interpAddToAccessPath, interpDelete, AliasGlob):
	(AliasSource, AliasLoad, AliasEncoding):
	* library/tm.tcl (UnknownHandler): Simplify by swapping some [catch]
	gymnastics for use of [try].

2009-07-26 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tools/genStubs.tcl: Forced LF translation when generating .h's to
	avoid spurious diffs when regenerating on a Windows box.

2009-07-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in: [Bug 2827066]: msys build --enable-symbols broken
	* win/tcl.m4:	   And modified the same for unicows.dll, as a
	* win/configure:   preparation for [Enh 2819611].

2009-07-25  Donal K. Fellows  <dkf@users.sf.net>

	* library/history.tcl (history): Reworked the history mechanism in
	terms of ensembles, rather than the ad hoc ensemble-lite mechanism
	used previously.

2009-07-24  Donal K. Fellows  <dkf@users.sf.net>

	* doc/self.n (self class): [Bug 2704302]: Add some text to make it
	clearer how to get the name of the current object's class.

2009-07-23  Andreas Kupries  <andreask@activestate.com>
2009-07-24  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (Tcl_GetChannelHandle): [Bug 2826248]: Do not crash
	* generic/tclPipe.c (FileForRedirect): for getHandleProc == NULL, this
	is allowed. Provide a nice error message in the bypass area. Updated
	caller to check the bypass for a mesage. Bug reported by Andy
	Sonnenburg <andy22286@users.sourceforge.net>
	Sonnenburg <andy22286@users.sourceforge.net>. Backported from CVS
	head.

2009-07-23  Joe Mistachkin  <joe@mistachkin.com>

	* generic/tclNotify.c: [Bug 2820349]: Ensure that queued events are
	freed once processed.

2009-07-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* macosx/tclMacOSXFCmd.c: CONST -> const
	* generic/tclGetDate.y:
	* generic/tclDate.c:
	* generic/tclLiteral.c: (char *) cast in ckfree call
	* generic/tclPanic.c: [Feature Request 2814786]: remove TclpPanic
	* generic/tclInt.h
	* unix/tclUnixPort.h
	* win/tclWinPort.h

2009-07-22 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclEvent.c: [Bug 2001201 again]: Refined the 20090617 patch
	on [exit] streamlining, so that it now correctly calls thread exit
	handlers for the calling thread, including <Destroy> bindings in Tk.

2009-07-21  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Asia/Dhaka:
	* library/tzdata/Indian/Mauritius: Olson's tzdata2009k.

2009-07-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (StringIsCmd): Reorganize so that [string is] is
	more efficient when parsing things that are correct, at a cost of
	making the empty string test slightly more costly. With this, the cost
	of doing [string is integer -strict $x] matches [catch {expr {$x+0}}]
	in the successful case, and greatly outstrips it in the failing case.

2009-07-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.decls, generic/tclOO.c (Tcl_GetObjectName): Expose a
	function for efficiently returning the current name of an object.

2009-07-18  Daniel Steffen  <das@users.sourceforge.net>

	* unix/Makefile.in: Define NDEBUG in optimized (non-symbols) build to
	disable NRE assert()s and threaded allocator range checks.

2009-07-16  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBinary.c:	Removed unused variables.
	* generic/tclCmdIL.c:
	* generic/tclCmdIL.c:	Removed unused variables.
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclHash.c:
	* generic/tclIOUtil.c:
	* generic/tclVar.c:

	* unix/tclUnixChan.c:
	* generic/tclBasic.c:	Silence compiler warnings about ClientData.
	* generic/tclProc.c:

	* generic/tclScan.c:    Typo in ACCEPT_NAN configuration.
	* generic/tclScan.c:	Typo in ACCEPT_NAN configuration.

	* generic/tclStrToD.c:  [Bug 2819200]: Set floating point control
	* generic/tclStrToD.c:	[Bug 2819200]: Set floating point control
	register on MIPS systems so that the gradual underflow expected by Tcl
	is in effect.

2009-07-15  Donal K. Fellows  <dkf@users.sf.net>

2009-07-14  Andreas Kupries  <andreask@activestate.com>
	* generic/tclInt.h (Namespace):		   Added machinery to allow
	* generic/tclNamesp.c (many functions):	   reduction of memory used
	* generic/tclResolve.c (BumpCmdRefEpochs): by namespaces. Currently
	#ifdef'ed out because of compatibility concerns.

	* generic/tclInt.decls: Added four functions for better integration
	with itcl-ng.

2009-07-14  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclInt.h (TclNRSwitchObjCmd):
	* generic/tclBasic.c (builtInCmds):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd):
	* generic/tclBasic.c (DeleteInterpProc,TclArgumentBCEnter,
	(TclArgumentBCRelease, TclArgumentGet):
	* tests/switch.test (switch-15.1):
	[Bug 2821401]: Make non-bytecoded [switch] command aware of NRE.

	* generic/tclCompile.c (EnterCmdWordIndex, TclCleanupByteCode,
2009-07-13  Andreas Kupries  <andreask@activestate.com>

	* generic/tclCompile.c (TclInitCompileEnv, EnterCmdWordIndex)
	(TclInitCompileEnv, TclCompileScript):
	* generic/tclCompile.h (ExtCmdLoc):
	(TclCleanupByteCode, TclCompileScript):
	* generic/tclExecute.c (TclCompileObj, TclExecuteByteCode):
	* generic/tclExecute.c (TclExecuteByteCode):
	* tclCompile.h (ExtCmdLoc):
	* tclInt.h (ExtIndex, CFWordBC, CmdFrame):
	* generic/tclInt.h (ExtIndex, CFWordBC):
	* tclBasic.c (DeleteInterpProc, TclArgumentBCEnter)
	(TclArgumentBCRelease, TclArgumentGet, SAVE_CONTEXT)
	(RESTORE_CONTEXT, NRCoroutineExitCallback, TclNRCoroutineObjCmd):
	* generic/tclCmdAH.c (TclNRForObjCmd, TclNRForIterCallback,
	(ForNextCallback):
	* generic/tclCmdMZ.c (TclNRWhileObjCmd):
	* tests/info.test (info-39.0):

	Extended the bytecode compiler initialization to recognize the
	compilation of whole files (NRE enabled 'source' command) and switch
	to the counting of absolute lines in that case.

	Further extended the bytecode compiler to track the start line in the
	Backport of some changes made to the Tcl head, to handle literal
	sharing better. The code here is much simpler (trimmed down) compared
	to the head as the 8.5 branch is not bytecode compiling whole files,
	generated information, and modified the bytecode execution to
	recompile an object if the location as per the calling context doesn't
	match the location saved in the bytecode. This part could be optimized
	more by using more memory to keep all possibilities which occur
	around, or by just adjusting the location information instead of a
	total recompile.
	and doesn't compile eval'd code either.

	Reworked the handling of literal command arguments in bytecode to be
	saved (compiler) and used (execution) per command (See the
	TCL_INVOKE_STK* instructions), and not per the whole bytecode. This,
	and the previous change remove the problems with location data caused
	by literal sharing (across whole files, but also proc bodies).
	Simplified the associated datastructures (ExtIndex is gone, as is the
	function EnterCmdWordIndex).

	The last change causes the hashtable 'lineLABCPtr' to be state which
	has to be kept per coroutine, like the CmdFrame stack. Reworked the
	coroutine support code to create, delete and switch the information as
	needed. Further reworked the tailcall command as well, it has to pop
	its own arguments when run in a bytecode context to keep a proper
	stack in 'lineLABCPtr'.

	Fixed the mishandling of line information in the NRE-enabled 'for' and
	'while' commands introduced when both were made to share their
	iteration callbacks without taking into account that the loop body is
	found in different words of the command. Introduced a separate data
	structure to hold all the callback information, as we went over the
	limit of 4 direct client-data values for NRE callbacks.

	The above fixes [Bug 1605269].

2009-07-12  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (StringIndexCmd, StringEqualCmd, StringCmpCmd):
	* generic/tclExecute.c (TclExecuteByteCode): [Bug 2637173]: Factor out
	* generic/tclInt.h (TclIsPureByteArray):     the code to determine if
	* generic/tclUtil.c (TclStringMatchObj):     it is safe to work with
	byte arrays directly, so that we get the check correct _once_.

	* generic/tclOOCall.c (TclOOGetCallContext): [Bug 1895546]: Changed
	* generic/tclOO.c (TclOOObjectCmdCore):	     the way that the cache is
	managed so that when itcl does cunning things, those cunning things
	can be cached properly.

2009-07-11  Donal K. Fellows  <dkf@users.sf.net>

	* doc/vwait.n: Substantially increased the discussion of issues and
	work-arounds relating to nested vwaits, following discussion on the
	tcl-core mailing list on the topic.

2009-07-10  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/zlib.test:   ZlibTransformClose may be called with a NULL
	* generic/tclZlib.c: interpreter during finalization and
	Tcl_SetChannelError requires a list. Added some tests to ensure error
	propagation from the zlib library to the interp.

2009-07-09  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/zlib.test: [Bug 2818131]: Added tests and fixed a typo that
	broke [zlib push] for deflate format.

2009-07-09  Donal K. Fellows  <dkf@users.sf.net>

	* compat/mkstemp.c (mkstemp): [Bug 2819227]: Use rand() for random
	numbers as it is more portable.

2009-07-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ZlibTransformWatch): Correct the handling of
	events so that channel transforms work with things like an asynch
	[chan copy]. Problem reported by Pat Thoyts.

2009-07-01  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* win/tclWinInt.h:   [Bug 2806622]: Handle the GetUserName API call
	* win/tclWin32Dll.c: via the tclWinProcs indirection structure. This
	* win/tclWinInit.c:  fixes a problem obtaining the username when the
	USERNAME environment variable is unset.

2009-06-30  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclInt.h:		Add assert macros for clang static
	* generic/tclPanic.c:		analyzer and redefine Tcl_Panic to
	* generic/tclStubInit.c:	assert after panic in clang PURIFY
					builds.

	* generic/tclCmdIL.c:		Add clang assert for false positive
					from static analyzer.

2009-06-26  Daniel Steffen  <das@users.sourceforge.net>

	* macosx/Tcl-Common.xcconfig:	 Update projects for Xcode 3.1 and
	* macosx/Tcl.xcode/*:		 3.2, standardize on gcc 4.2, remove
	* macosx/Tcl.xcodeproj/*:	 obsolete configurations and pre-Xcode
	* macosx/Tcl.pbproj/* (removed): project.

	* macosx/README:		 Update project docs, cleanup.

	* unix/Makefile.in:		 Update dist target for project
					 changes.

2009-06-24  Donal K. Fellows  <dkf@users.sf.net>

	* tests/oo.test (oo-19.1): [Bug 2811598]: Make more resilient.

2009-06-24  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/http11.test: [Bug 2811492]: Clean up procs after testing.

2009-06-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCkalloc.c (MemoryCmd): [Bug 988703]:
	* generic/tclObj.c (ObjData, TclFinalizeThreadObjects): Add mechanism
	for discovering what Tcl_Objs are allocated when built for memory
	debugging. Developed by Joe Mistachkin.

2009-06-17 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclEvent.c: Applied a patch by George Peter Staplin
	drastically reducing the ambition of [exit] wrt finalization, and
	thus solving many multi-thread teardown issues. [Bugs 2001201,
	486399, and possibly 597575, 990457, 1437595, 2750491]

2009-06-15  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c: sprintf() -> Tcl_ObjPrintf() conversion.

2009-06-15  Reinhard Max  <max@suse.de>

	* unix/tclUnixPort.h: Move all socket-related code from tclUnixChan.c
	* unix/tclUnixChan.c: to tclUnixSock.c.
	* unix/tclUnixSock.c:

2009-06-15  Donal K. Fellows  <dkf@users.sf.net>

	* tools/tcltk-man2html.tcl (make-man-pages): [Patch 557486]: Apply
	last remaining meaningful part of this patch, a clean up of some
	closing tags.

2009-06-13  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompile.c: [Bug 2802881]: The value stashed in
	* generic/tclProc.c:    iPtr->compiledProcPtr when compiling a proc
	* tests/execute.test:   survives too long. We only need it there long
	enough for the right TclInitCompileEnv() call to re-stash it into
	envPtr->procPtr.  Once that is done, the CompileEnv controls.  If we
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822
7823
7824
7825
7826
7827
7828
7829
7830
7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
7841
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858

7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
7892
7893
7894
7895
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916
7917
7918
7919
7920
7921
7922

7923
7924
7925
7926
7927
7928
7929

7930
7931

7932
7933
7934
7935
7936

7937
7938

7939
7940

7941
7942

7943
7944
7945
7946

7947
7948
7949


7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
7963
7964

7965
7966
7967
7968

7969

7970
7971




7972
7973
7974

7975
7976

7977
7978

7979
7980

7981
7982
7983
7984
7985

7986
7987
7988
7989
7990
7991









7992


7993



7994
7995
7996
7997
7998


7999
8000
8001
8002
8003
8004
8005

8006
8007

8008
8009
8010
8011
8012
8013
8014
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







-
-
-
-
















-
-
-
-














-
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-





-
-
+
-

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

-
+

-
+
-
-
+
-
-
+
-
-

-
+

-
-
+
+








-
-
-
-
-
-
-
+



-
+

+
-
-
+
+
+
+
-
-
-
+

-
+

-
+

-
+




-
+

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

+
+
-
+
+
+

-
-
-
-
+
+
-





-
+

-
+








	* generic/tclStringObj.c:       [Bug 2801413]: Revised [format] to not
	overflow the integer calculations computing the length of the %ll
	formats of really big integers.  Also added protections so that
	[format]s that would produce results overflowing the maximum string
	length of Tcl values throw a normal Tcl error instead of a panic.

	* generic/tclStringObj.c:	[Bug 2803109]: Corrected failures to
	deal with the "pure unicode" representation of an empty string.
	Thanks to Julian Noble for reporting the problem.

2006-06-09  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclGetDate.y: Fixed a thread safety bug in the generated
	* library/clock.tcl:    Bison parser (needed a %pure-parser
	* tests/clock.test:     declaration to avoid static variables).
				Discovered that the %pure-parser declaration
	                        allowed for returning the Bison error message
	                        to the Tcl caller in the event of a syntax
	                        error, so did so.
	* generic/tclDate.c: bison 2.3

2006-06-08  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Asia/Dhaka: New DST rule for Bangladesh. (Olson's
	tzdata2009i.)

2009-06-08  Donal K. Fellows  <dkf@users.sf.net>

	* doc/copy.n: Fix error in example spotted by Venkat Iyer.

2009-06-02  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclExecute.c: Replace dynamically-initialized table with a
	table of static constants in the lookup table for exponent operator
	computations that fit in a 64 bit integer result.

	* generic/tclExecute.c: [Bug 2798543]: Corrected implementations and
	selection logic of the INST_EXPON instruction.

2009-06-01  Don Porter  <dgp@users.sourceforge.net>

	* tests/expr.test:      [Bug 2798543]: Added many tests demonstrating
	the broken cases.

009-05-30  Kevin B. Kenny  <kennykb@acm.org>
2009-05-30  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Africa/Cairo:
	* library/tzdata/Asia/Amman: Olson's tzdata2009h.

2009-05-29  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl: Fixed handling of cpu ia64,
	* library/platform/pkgIndex.tcl: taking ia64_32 into account
	* unix/Makefile.in: now. Bumped version to 1.0.5. Updated the
	* win/Makefile.in: installation commands.

2009-05-26 Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* doc/expr.n: Fixed documentation of the right-associativity of
	the ** operator. (spotted by kbk)

2009-05-14  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOInfo.c (InfoObjectNsCmd): Added introspection mechanism
	for finding out what an object's namespace is. Experience suggests
	that it is just too useful to be able to do without it.

2009-05-12  Donal K. Fellows  <dkf@users.sf.net>

	* doc/vwait.n: Added more words to make it clear just how bad it is to
	nest [vwait]s.

	* compat/mkstemp.c: Add more headers to make this file build on IRIX
	6.5. Thanks to Larry McVoy for this.

2009-05-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (TclNRNewObjectInstance):  [Bug 2414858]: Add a
	* generic/tclBasic.c (TclPushTailcallPoint): marker to the stack of
	NRE callbacks at the right point so that tailcall works correctly in a
	constructor.

	* tests/exec.test (cat): [Bug 2788468]: Adjust the scripted version of
	cat so that it does not perform transformations on the data it is
	working with, making it more like the standard Unix 'cat' program.

2009-05-07  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclObj.c (Tcl_GetCommandFromObj): [Bug 2785893]: Ensure that
	a command in a deleted namespace can't be found through a cached name.

	* generic/tclBasic.c:    Let coroutines start with a much smaller
	* generic/tclCompile.h:  stack: 200 words (previously was 2000, the
	* generic/tclExecute.c:  same as interps).

2009-05-07  Donal K. Fellows  <dkf@users.sf.net>

	* tests/env.test (printenvScript, env-4.3, env-4.5): [Bug 1513659]:
	* tests/exec.test (exec-2.6): These tests had subtle dependencies on
	being on platforms that were either ISO 8859-1 or UTF-8. Stabilized
	the results by forcing the encoding.

2009-05-06  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCmdMZ.c:	[Bug 2582327]: Improve overflow error message
	from [string repeat].

	* tests/interp.test: interp-20.50 test for Bug 2486550.

2009-04-28  Jeff Hobbs  <jeffh@ActiveState.com>
2009-05-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (InitFoundation, AllocObject, AllocClass):
	* generic/tclOODefineCmds.c (InitDefineContext): Make sure that when
	support namespaces are deleted, nothing bad can subsequently happen.
	Issue spotted by Don Porter.

	* unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): harden the check
2009-05-03  Donal K. Fellows  <dkf@users.sf.net>

	to add _r to CC on AIX with threads.
	* doc/Tcl.n: [Bug 2538432]: Clarified exact treatment of ${arr(idx)}
	form of variable substitution. This is not a change of behavior, just
	an improved description of the current situation.

2009-04-30  Miguel Sofer  <msofer@users.sf.net>
2009-04-27  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclBasic.c (TclObjInvoke): [Bug 2486550]: Make sure that a
	* generic/tclInt.h:   Backport fix for [Bug 1028264]: WSACleanup() too early.
	null objProc is not used, use Tcl_NRCallObjProc instead.

	* generic/tclEvent.c: The fix introduces "late exit handlers"
2009-05-01  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tclWinSock.c:   for similar late process-wide cleanups.
	* win/configure.in   Fix 64-bit detection for zlib on Win64
	* win/configure      (regenerated)

2009-04-28  Jeff Hobbs  <jeffh@ActiveState.com>
2009-04-27  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* unix/tcl.m4, unix/configure (SC_CONFIG_CFLAGS): harden the check to
	add _r to CC on AIX with threads.
	* win/tclWinSock.c: Backport fix for [Bug 2446662]: resync Win
	behavior on RST with that of unix (EOF).

2009-04-27  Donal K. Fellows  <dkf@users.sf.net>

	* doc/concat.n (EXAMPLES): [Bug 2780680]: Rewrote so that the spacing
	of result messages is correct. (The exact way they were wrong was
	different when rendered through groff or as HTML, but it was still
	wrong both ways.)

2009-04-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIndexObj.c:  Reset internal INTERP_ALTERNATE_WRONG_ARGS
	* generic/tclIOCmd.c:     flag inside the Tcl_WrongNumArgs function,
	                          so the caller no longer has to do the reset.

2009-04-24  Stuart Cassoff  <stwo@users.sf.net>
2009-04-24  Stuart Cassoff <stwo@users.sf.net>

	* unix/Makefile.in: [Patch 2769530]: Don't chmod/exec installManPage.

2009-04-19  Pat Thoyts  <patthoyts@users.sourceforge.net>
2009-04-15  Don Porter  <dgp@users.sourceforge.net>

	*** 8.5.7 TAGGED FOR RELEASE ***
	* library/http/http.tcl: [Bug 2715421]: Removed spurious newline added
	* tests/http11.test:     after POST and added tests to detect excess

	* generic/tclStringObj.c:	AppendUnicodeToUnicodeRep failed
	to set stringPtr->allocated to 0, leading to crashes.

	* tests/httpd11.tcl:     bytes being POSTed.
	* library/http/pkgIndex.tcl:
	* makefiles:             package version now 2.8.1
	* changes:	Update for 8.5.7 release.

2009-04-15  Donal K. Fellows  <dkf@users.sf.net>
2009-04-14  Stuart Cassoff  <stwo@users.sourceforge.net>

	* doc/chan.n, doc/close.n: Tidy up documentation of TIP #332.
	* unix/tcl.m4:	Removed -Wno-implicit-int from CFLAGS_WARNING.

2009-04-14  Kevin B. Kenny  <kennykb@acm.org>
2008-04-14  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/Asia/Karachi: Updated rules for Pakistan Summer
				       Time (Olson's tzdata2009f)

2009-04-11  Donal K. Fellows  <dkf@users.sf.net>
2009-04-10  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclOOMethod.c (InvokeForwardMethod): Clarify the resolution
	behaviour of the name of the command that is forwarded to: it's now
	resolved using the object's namespace as context, which is much more
	useful than the previous (somewhat random) behaviour of using the
	caller's current namespace.
	* changes:	Update for 8.5.7 release.

	* generic/tcl.h:	Bump to 8.5.7 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:
2009-04-10  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclStringObj.c (UpdateStringOfString):  Fix bug detected
	by compiler warning about undefined "dst".

	* library/http/http.tcl:     Improved HTTP/1.1 support and added
	* library/http/pkgIndex.tcl: specific HTTP/1.1 testing to ensure
	* tests/http11.test:         we handle chunked+gzip for the various
	* tests/httpd11.test:        modes (normal, -channel and -handler)
	* tests/httpd:		Backport new tests for http 2.7.3.
	* tests/http.tcl:
	* makefiles:                 package version set to 2.8.0

2009-04-10  Daniel Steffen  <das@users.sourceforge.net>

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

	* unix/tclLoadDyld.c:		Use RTLD_GLOBAL instead of RTLD_LOCAL.
	* 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
					want to run the tcl event loop via
					Tcl_ServiceModeHook(TCL_SERVICE_ALL).
8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047

8048
8049
8050
8051
8052
8053
8054
8055




8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076

8077
8078
8079

8080
8081
8082
8083
8084
8085
8086
8087
8088






8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
8109
8110
8111
8112
8113
8114
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
8141
8142
8143
8144
8145
8146
8147
8148
8149
8150
8151
8152
8153
8154
8155
8156
8157
8158
8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
8174
8175
8176
8177
8178
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
8193
8194
8195
8196
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8210
8211
8212
8213
8214
8215
8216
8217
8218
8219
8220
8221
8222
8223
8224
8225
8226
8227
8228
8229
8230
8231
8232
8233
8234
8235
8236
8237
8238
8239
8240
8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302
8303
8304
8305
8306
8307
8308
8309
8310
8311
8312
8313
8314
8315
8316
8317
8318
8319
8320
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
8334
8335
8336
8337
8338
8339
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
8367
8368
8369
8370
8371
8372
8373
8374
8375
8376
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
8412
8413
8414
8415
8416
8417
8418
8419
8420
8421
8422
8423
8424
8425
8426
8427
8428
8429
8430
8431
8432
8433
8434
8435
8436
8437
8438
8439
8440
8441
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451
8452
8453
8454
8455
8456
8457
8458
8459
8460
8461
8462
8463
8464
8465
8466
8467
8468
8469
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483
8484
8485
8486
8487
8488
8489
8490
8491
8492
8493
8494
8495
8496
8497
8498
8499
8500
8501
8502
8503
8504
8505
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
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
8571

8572
8573
8574
8575
8576
8577
8578

8579
8580

8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
8606
8607
8608
8609
8610
8611
8612
8613
8614
8615
8616
8617
8618
8619
8620
8621
8622
8623
8624
8625
8626
8627
8628
8629
8630
8631
8632
8633
8634
8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
8660
8661
8662
8663
8664
8665
8666
8667
8668
8669
8670
8671
8672
8673
8674
8675
8676
8677
8678
8679
8680
8681
8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
8692




8693
8694
8695
8696
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
8853
8854
8855
8856
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







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






-
-
+
+
+
+




















-
+
-
-
-
+
-
-
-
-





+
+
+
+
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






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





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





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

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








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











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
+
+
-
-

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






-
-
-
-
-
-
-
-
-











					(NFS mounted locations and thus slow).
	* unix/configure:		autoconf-2.59
	* unix/tclConfig.h.in:		autoheader-2.59

	* macosx/tclMacOSXBundle.c:	on Mac OS X 10.4 and later, replace
					deprecated NSModule API by dlfcn API.

2009-04-10  Donal K. Fellows  <dkf@users.sf.net>

	* doc/StringObj.3: [Bug 2089279]: Corrected example so that it works
	on 64-bit machines as well.

2009-04-10  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/http.test: [Bug 26245326]: Added specific check for problem
	* tests/httpd: (return incomplete HTTP response header).

2009-04-08  Kevin B. Kenny  <kennykb@acm.org>
2009-04-09  Kevin B. Kenny  <kennykb@acm.org>

	* tools/tclZIC.tcl: Always emit files with Unix line termination.
	* library/tzdata: Olson's tzdata2009e

2009-04-09  Don Porter  <dgp@users.sourceforge.net>

	* library/http/http.tcl:	[Bug 26245326]: Handle incomplete
	lines in the "connecting" state. Thanks to Sergei Golovan.
	* library/http/http.tcl:	Backport http 2.7.3 from HEAD for
	* library/http/pkgIndex.tcl:	bundling with the Tcl 8.5.7 release.
	* unix/Makefile.in:
	* win/Makefile.in:

2009-04-08  Andreas Kupries  <andreask@activestate.com>

	* library/platform/platform.tcl: Extended the darwin sections to add
	* library/platform/pkgIndex.tcl: a kernel version number to the
	* unix/Makefile.in: identifier for anything from Leopard (10.5) on up.
	* win/Makefile.in: Extended patterns for same. Extended cpu
	* doc/platform.n: recognition for 64bit Tcl running on a 32bit kernel
	on a 64bit processor (By Daniel Steffen). Bumped version to 1.0.4.
	Updated Makefiles.

2009-04-08  Don Porter  <dgp@users.sourceforge.net>

	* library/tcltest/tcltest.tcl:  [Bug 2570363]: Converted [eval]s (some
	* library/tcltest/pkgIndex.tcl: unsafe!) to {*} in tcltest package.
	* unix/Makefile.in:     => tcltest 2.3.1
	* win/Makefile.in:

2009-04-07  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	Correction so that value of
	* generic/tclStringObj.c:	Completed backports of fixes for
	TCL_GROWTH_MIN_ALLOC is everywhere expressed in bytes as comment
	claims.

	[Bug 2494093] and [Bug 2553906].
2009-04-04  Donal K. Fellows  <dkf@users.sf.net>

	* doc/vwait.n: [Bug 1910136]: Extend description and examples to make
	it clearer just how this command interprets variable names.

2009-03-30  Don Porter  <dgp@users.sourceforge.net>

	* doc/Alloc.3: [Bug 2556263]:	Size argument is "unsigned int".

	* generic/tclStringObj.c:       Added protections from invalid memory
	* generic/tclTestObj.c:         accesses when we append (some part of)
	* tests/stringObj.test:         a Tcl_Obj to itself.  Added the
	appendself and appendself2 subcommands to the [teststringobj] testing
	command and added tests to the test suite.  [Bug 2603158]

2009-03-27  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c (TclPathPart): [Bug 2710920]: TclPathPart()
	* tests/fileName.test:	was computing the wrong results for both [file
	dirname] and [file tail] on "path" arguments with the PATHFLAGS != 0
	intrep and with an empty string for the "joined-on" part.

2009-03-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/tclsh.1:		 Bring doc and tools in line with
	* tools/installData.tcl: http://wiki.tcl.tk/812
	* tools/str2c
	* tools/tcltk-man2html.tcl

2009-03-25  Donal K. Fellows  <dkf@users.sf.net>

	* doc/coroutine.n: [Bug 2152285]: Added basic documentation for the
	coroutine and yield commands.

2009-03-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOBasic.c (TclOOSelfObjCmd): [Bug 2704302]: Make 'self
	class' better defined in the context of objects that change class.

	* generic/tclVar.c (Tcl_UpvarObjCmd): [Bug 2673163] (ferrieux)
	* generic/tclProc.c (TclObjGetFrame): Make the upvar command more able
	to handle its officially documented syntax.

2009-03-22  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c: [Bug 2502037]: NR-enable the handling of unknown
	commands.

2009-03-21  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:   Fixed "leaks" in aliases, imports and
	* generic/tclInt.h:     ensembles. Only remaining known leak is in
	* generic/tclInterp.c:  ensemble unknown dispatch (as it not
	* generic/tclNamesp.c:  NR-enabled)
	* tests/tailcall.test:

	* tclInt.h: comments

	* tests/tailcall.test: Added tests to show that [tailcall] does not
	currently always execute in constant space: interp-alias, ns-imports
	and ensembles "leak" as of this commit.

	* tests/nre.test: [foreach] has been NR-enabled for a while, the test
	was marked 'knownBug': unmark it.

	* generic/tclBasic.c:   Fix for (among others) [Bug 2699087]
	* generic/tclCmdAH.c:   Tailcalls now perform properly even from
	* generic/tclExecute.c: within [eval]ed scripts.
	* generic/tclInt.h:     More tests missing, as well as proper
	exploration and testing of the interaction with "redirectors" like
	interp-alias (suspect that it does not happen in constant space)
	and pure-eval commands.

	* generic/tclExecute.c: Proper fix for [Bug 2415422]. Reenabled
	* tests/nre.test:       the failing assertion that was disabled on
	2008-12-18: the assertion is correct, the fault was in the
	management of expansions.

	* generic/tclExecute.c:  Fix both test and code for tailcall
	* tests/tailcall.test:   from within a compiled [eval] body.

	* tests/tailcall.test: Slightly improved tests

2009-03-20  Don Porter  <dgp@users.sourceforge.net>

	* tests/stringObj.test:         [Bug 2597185]: Test stringObj-6.9
	checks that Tcl_AppendStringsToObj() no longer crashes when operating
	on a pure unicode value.

	* generic/tclExecute.c (INST_CONCAT1):  [Bug 2669109]: Panic when
	appends overflow the max length of a Tcl value.

2009-03-19  Miguel Sofer  <msofer@users.sf.net>

	* generic/tcl.h:
	* generic/tclInt.h:
	* generic/tclBasic.c:
	* generic/tclExecute.c:
	* generic/tclNamesp.c (Tcl_PopCallFrame): Rewritten tailcall
	implementation, ::unsupported::atProcExit is (temporarily?) gone. The
	new approach is much simpler, and also closer to being correct. This
	commit fixes [Bug 2649975] and [Bug 2695587].

	* tests/coroutine.test:    Moved the tests to their own files,
	* tests/tailcall.test:     removed the unsupported.test. Added
	* tests/unsupported.test:  tests for the fixed bugs.

2009-03-19  Donal K. Fellows  <dkf@users.sf.net>

	* doc/tailcall.n: Added documentation for tailcall command.

2009-03-18  Don Porter  <dgp@users.sourceforge.net>

	* win/tclWinFile.c (TclpObjNormalizePath):	[Bug 2688184]:
	Corrected Tcl_Obj leak. Thanks to Joe Mistachkin for detection and
	patch.

	* generic/tclVar.c (TclLookupSimpleVar):	[Bug 2689307]: Shift
	all calls to Tcl_SetErrorCode() out of TclLookupSimpleVar and onto its
	callers, where control with TCL_LEAVE_ERR_MSG flag is more easily
	handled.

2009-03-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (TryPostBody): [Bug 2688063]: Extract information
	from list before getting rid of last reference to it.

2009-03-15  Joe Mistachkin  <joe@mistachkin.com>

	* generic/tclThread.c: [Bug 2687952]: Modify fix for TSD leak to match
	* generic/tclThreadStorage.c: Tcl 8.5 (and prior) allocation semantics

2009-03-15  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclThreadStorage.c (TSDTableDelete):	[Bug 2687952]: Ensure
	* generic/tclThread.c (Tcl_GetThreadData):	that structures in
	Tcl's TSD system are all freed. Use the correct matching allocator.

	* generic/tclPosixStr.c (Tcl_SignalId,Tcl_SignalMsg): [Patch 1513655]:
	Added support for SIGINFO, which is present on BSD platforms.

2009-03-14  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tcl.pc.in (new file):		[Patch 2243948] (hat0)
	* unix/configure.in, unix/Makefile.in: Added support for reporting
	Tcl's public build configuration via the pkg-config system. TEA is
	still the official mechanism though, in part because pkg-config is not
	universally supported across all Tcl's supported platforms.

2009-03-11  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c (TclNRCoroutineObjCmd): fix Tcl_Obj leak.
	Diagnosis and fix thanks to GPS.

2009-03-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (Tcl_TryObjCmd, TclNRTryObjCmd): Moved the
	implementation of [try] from Tcl code into C. Still lacks a bytecode
	version, but should be better than what was before.

2009-03-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (TclZlibCmd): Checksums are defined to be unsigned
	32-bit integers, use Tcl_WideInt to pass to scripts. [Bug 2662434]
	(ZlibStreamCmd, ChanGetOption): A few other related corrections.

2009-02-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.decls:    [Bug 218977]: Tcl_DbCkfree needs return value
	* generic/tclCkalloc.c
	* generic/tclDecls.h:   (regenerated)
	* generic/tclInt.decls: don't use CONST84/CONST86 here
	* generic/tclCompile.h: don't use CONST86 here, comment fixing.
	* generic/tclIO.h:      don't use CONST86 here, comment fixing.
	* generic/tclIntDecls.h (regenerated)

2009-02-25  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclUtil.c (TclStringMatchObj):	[Bug 2637173]: Revised
	the branching on the strObj->typePtr so that untyped values get
	converted to the "string" type and pass through the Unicode matcher.
	[Bug 2613766]: Also added checks to only perform "bytearray"
	optimization on pure bytearray values.

	* generic/tclCmdMZ.c:	Since Tcl_GetCharLength() has its own
	* generic/tclExecute.c:	optimizations for the tclByteArrayType, stop
	having the callers do them.

2009-02-24  Donal K. Fellows  <dkf@users.sf.net>

	* doc/clock.n, doc/fblocked.n, doc/format.n, doc/lsort.n,
	* doc/pkgMkIndex.n, doc/regsub.n, doc/scan.n, doc/tclvars.n:
	General minor documentation improvements.

	* library/http/http.tcl (geturl, Eof): Added support for 8.6's built
	in zlib routines.

2009-02-22  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tests/lrange.test:	Revert commits of 2008-07-23. Those were speed
	* tests/binary.test:	tests, that are inherently brittle.

2009-02-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	Several revisions to the shimmering
	patterns between Unicode and UTF string reps.  Most notably the
	call: objPtr = Tcl_NewUnicodeObj(...,0); followed by a loop of calls:
	Tcl_AppendUnicodeToObj(objPtr, u, n); will now grow and append to
	the Unicode representation.  Before this commit, the sequence would
	convert each append to UTF and perform the append to the UTF rep.
	This is puzzling and likely a bug.  The performance of [string map]
	is significantly improved by this change (according to the MAP
	collection of benchmarks in tclbench).  Just in case there was some
	wisdom in the old ways that I missed, I left in the ability to restore
	the old patterns with a #define COMPAT 1 at the top of the file.

2009-02-20  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c:	[Bug 2571597]: Fixed mistaken logic in
	* tests/fileName.test:	TclFSGetPathType() that assumed (not
	"absolute") => "relative". This is a false assumption on Windows,
	where "volumerelative" is another possibility.

2009-02-18  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	Simplify the logic of the
	Tcl_*SetObjLength() routines.

	* generic/tclStringObj.c:	Rewrite GrowStringBuffer() so that it
	has parallel structure with GrowUnicodeBuffer().  The revision permits
	allocation attempts to continue all the way up to failure, with no
	gap. It also directly manipulates the String and Tcl_Obj internals
	instead of inefficiently operating via Tcl_*SetObjLength() with all of
	its extra protections and underdocumented special cases.

	* generic/tclStringObj.c:	Another round of simplification on
	the allocation macros.

2009-02-17  Jeff Hobbs  <jeffh@ActiveState.com>

	* win/tcl.m4, win/configure: Check if cl groks _WIN64 already to
	avoid CC manipulation that can screw up later configure checks.
	Use 'd'ebug runtime in 64-bit builds.

2009-02-17  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	Pare back the length of the unicode
	array in a non-extended String struct to one Tcl_UniChar, meant to
	hold the terminating NUL character.  Non-empty unicode strings are
	then stored by extending the String struct by stringPtr->maxChars
	additional slots in that array with sizeof(Tcl_UniChar) bytes per
	slot. This revision makes the allocation macros much simpler.

	* generic/tclStringObj.c:	Factor out common GrowUnicodeBuffer()
	and solve overflow and growth algorithm fallbacks in it.

	* generic/tclStringObj.c:	Factor out common GrowStringBuffer().

	* generic/tclStringObj.c:	Convert Tcl_AppendStringsToObj into
	* tests/stringObj.test:		a radically simpler implementation
	where we just loop over calls to Tcl_AppendToObj.  This fixes [Bug
	2597185].  It also creates a *** POTENTIAL INCOMPATIBILITY *** in
	that T_ASTO can now allocate more space than is strictly required,
	like all the other Tcl_Append* routines.  The incompatibility was
	detected by test stringObj-6.5, which I've updated to reflect the
	new behavior.

	* generic/tclStringObj.c:	Revise buffer growth implementation
	in ExtendStringRepWithUnicode.  Use cheap checks to determine that
	no reallocation is necessary without cost of computing the precise
	number of bytes needed.  Also make use of the string growth algortihm
	in the case of repeated appends.

2009-02-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclZlib.c:	Hack needed for official zlib1.dll build.
	* win/configure.in:	fix [Feature Request 2605263] use official
	* win/Makefile.in:	zlib build.
	* win/configure:	(regenerated)
	* compat/zlib/zdll.lib:	new files
	* compat/zlib/zlib1.dll:

	* win/Makefile.in:  [Bug 2605232]: tdbc doesn't build when Tcl is
	compiled with --disable-shared.

2009-02-15  Don Porter  <dgp@users.sourceforge.net>
2009-02-05  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	[Bug 2603158]: Added protections from
	* generic/tclTestObj.c:		invalid memory accesses when we append
	* tests/stringObj.test:		(some part of) a Tcl_Obj to itself.
	Added the appendself and appendself2 subcommands to the
	[teststringobj] testing command and added tests to the test suite.

	* generic/tclStringObj.c:	Factor out duplicate code from
	Tcl_AppendObjToObj.

	* generic/tclStringObj.c:	Replace the 'size_t uallocated' field
	of the String struct, storing the number of bytes allocated to store
	the Tcl_UniChar array, with an 'int maxChars' field, storing the
	number of Tcl_UniChars that may be stored in the allocated space.
	This reduces memory requirement a small bit, and makes some range
	checks simpler to code.
	* generic/tclTestObj.c:	Replace the [teststringobj ualloc] testing
	* tests/stringObj.test:	command with [teststringobj maxchars] and
	update the tests.

	* generic/tclStringObj.c:	Removed limitation in
	Tcl_AppendObjToObj where the char length of the result was only
	computed if the appended string was all single byte characters.
	This limitation was in place to dodge a bug in Tcl_GetUniChar.
	With that bug gone, we can take advantage of always recording the
	length of append results when we know it.

2009-02-14  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	Revisions so that we avoid creating
	the strange representation of an empty string with
	objPtr->bytes == NULL and stringPtr->hasUnicode == 0.  Instead in
	the situations where that was being created, create a traditional
	two-legged stork representation (objPtr->bytes = tclEmptyStringRep
	and stringPtr->hasUnicode = 1).  In the situations where the strange
	rep was treated differently, continue to do so by testing
	stringPtr->numChars == 0 to detect it.  These changes make the code
	more conventional so easier for new maintainers to pick up.  Also
	sets up further simplifications.

	* generic/tclTestObj.c:	Revise updates to [teststringobj] so we don't
	get blocked by MODULE_SCOPE limits.

2009-02-12  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	Rewrites of the routines
	Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetUnicodeFromObj,
	Tcl_GetRange, and TclStringObjReverse to use the new macro, and
	to more simply and clearly split the cases depending on whether
	a valid unicode rep is present or needs to be created.
	New utility routine UnicodeLength(), to compute the length of unicode
	buffer arguments when no length is passed in, with built-in
	overflow protection included.  Update three callers to use it.

	* generic/tclInt.h:	New macro TclNumUtfChars meant to be a faster
	replacement for a full Tcl_NumUtfChars() call when the string has all
	single-byte characters.

	* generic/tclStringObj.c:	Simplified Tcl_GetCharLength by
	* generic/tclTestObj.c:		removing code that did nothing.
	Added early returns from Tcl_*SetObjLength when the desired length
	is already present; adapted test command to the change.

	* generic/tclStringObj.c:	Re-implemented AppendUtfToUnicodeRep
	so that we no longer pass through Tcl_DStrings which have their own
	sets of problems when lengths overflow the int range.  Now AUTUR and
	FillUnicodeRep share a common core routine.

2009-02-12  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOODefineCmds.c (TclOOGetDefineCmdContext): Use the
	correct field in the Interp structure for retrieving the frame to get
	the context object so that people can extend [oo::define] without deep
	shenanigans. Bug found by Federico Ferri.

2009-02-11  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c:	Re-implemented AppendUnicodeToUtfRep
	so that we no longer pass through Tcl_DStrings which have their own
	sets of problems when lengths overflow the int range.  Now AUTUR and
	UpdateStringOfString share a common core routine.

	* generic/tclStringObj.c:	Changed type of the 'allocated' field
	* generic/tclTestObj.c:		of the String struct (and the
	TestString counterpart) from size_t to int since only int values are
	ever stored in it.

2009-02-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclEncoding.c: Eliminate some unnessary type casts
	* generic/tclEvent.c:    some internal const decorations
	* generic/tclExecute.c:  spacing
	* generic/tclIndexObj.c:
	* generic/tclInterp.c:
	* generic/tclIO.c:
	* generic/tclIOCmd.c:
	* generic/tclIORChan.c:
	* generic/tclIOUtil.c:
	* generic/tclListObj.c:
	* generic/tclLiteral.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclOOBasic.c:
	* generic/tclPathObj.c:
	* generic/tclPkg.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclScan.c:
	* generic/tclStringObj.c:
	* generic/tclTest.c:
	* generic/tclTestProcBodyObj.c:
	* generic/tclThread.c:
	* generic/tclThreadTest.c:
	* generic/tclTimer.c:
	* generic/tclTrace.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:
	* generic/tclStubInit.c: (regenerated)

2009-02-10  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
	using the native CC.
	* unix/configure: (autoconf-2.59)

2009-02-10  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclObj.c (Tcl_GetString):	Added comments and validity
	checks following the call to an UpdateStringProc.

	* generic/tclStringObj.c: Reduce code duplication in Tcl_GetUnicode*.
	Restrict AppendUtfToUtfRep to non-negative length appends.
	Convert all Tcl_InvalidateStringRep() calls into macros.
	Simplify Tcl_AttemptSetObjLength by removing unreachable code.
	Simplify SetStringFromAny() by removing unreachable and duplicate code.
	Simplify Tcl_SetObjLength by removing unreachable code.
	Removed handling of (objPtr->bytes != NULL) from UpdateStringOfString,
	which is only called when objPtr->bytes is NULL.

2009-02-09  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCompile.c: [Bug 2555129]: const compiler warning (as
	error) in tclCompile.c

2009-02-07  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (TclZlibCmd): [Bug 2573172]: Ensure that when
	invalid subcommand name is given, the list of valid subcommands is
	produced. This gives a better experience when using the command
	interactively.

2009-02-05  Joe Mistachkin  <joe@mistachkin.com>

	* generic/tclInterp.c: [Bug 2544618]: Fix argument checking for
	[interp cancel].
	* unix/Makefile.in: Fix build issue with zlib on FreeBSD (and possibly
	other platforms).

2009-02-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (StringIndexCmd, StringRangeCmd, StringLenCmd):
	Simplify the implementation of some commands now that the underlying
	string API knows more about bytearrays.

	* generic/tclExecute.c (TclExecuteByteCode): [Bug 2568434]: Make sure
	that INST_CONCAT1 will not lose string reps wrongly.

	* generic/tclStringObj.c (Tcl_AppendObjToObj): Special-case the
	appending of one bytearray to another, which can be extremely rapid.
	Part of scheme to address [Bug 1665628] by making the basic string
	operations more efficient on byte arrays.
	(Tcl_GetCharLength, Tcl_GetUniChar, Tcl_GetRange): More special casing
	work for bytearrays.

2009-02-04  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c: [Bug 2561794]: Added overflow protections to
	the AppendUtfToUtfRep routine to either avoid invalid arguments and
	crashes, or to replace them with controlled panics.

	* generic/tclCmdMZ.c:	[Bug 2561746]: Prevent crashes due to int
	overflow of the length of the result of [string repeat].

2009-02-03  Jan Nijtmans  <nijtmans@users.sf.net>

	* macosx/tclMacOSXFCmd.c: Eliminate some unnessary type casts
	* unix/tclLoadDyld.c:	  some internal const decorations
	* unix/tclUnixCompat.c:	  spacing
	* unix/tclUnixFCmd.c
	* unix/tclUnixFile.c
	* win/tclWinDde.c
	* win/tclWinFCmd.c
	* win/tclWinInit.c
	* win/tclWinLoad.c
	* win/tclWinPipe.c
	* win/tclWinReg.c
	* win/tclWinTest.c
	* generic/tclBasic.c
	* generic/tclBinary.c
	* generic/tclCmdAH.c
	* generic/tclCmdIL.c
	* generic/tclCmdMZ.c
	* generic/tclCompCmds.c
	* generic/tclDictObj.c

2009-02-03  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclObj.c (tclCmdNameType): [Bug 2558422]: Corrected the type
	of this structure so that extensions that write it (yuk!) will still
	be able to function correctly.

2009-02-03  Don Porter  <dgp@users.sourceforge.net>
2009-02-04  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c (SetUnicodeObj):	[Bug 2561488]:
	Corrected failure of Tcl_SetUnicodeObj() to panic on a shared object.
	Also factored out common code to reduce duplication.

	* generic/tclObj.c (Tcl_GetStringFromObj): Reduce code duplication.

	* generic/tclCmdMZ.c:   Prevent crashes due to int overflow of the
2009-02-02  Don Porter  <dgp@users.sourceforge.net>

	length of the result of [string repeat].  [Bug 2561746]
	* generic/tclInterp.c:	Reverted the conversion of [interp] into an
	* tests/interp.test:	ensemble.  Such conversion is not necessary
	* tests/nre.test:	(or even all that helpful) in the NRE-enabling
	of [interp invokehidden], and it has other implications -- including
	significant forkage of the 8.5 and 8.6 implementations -- that are
	better off avoided if there's no gain.

	* generic/tclStringObj.c (STRING_NOMEM):  [Bug 2494093]: Add missing
	cast of NULL to (char *) that upsets some compilers.

	* generic/tclStringObj.c (Tcl_(Attempt)SetObjLength):	[Bug 2553906]:
	Added protections against callers asking for negative lengths.  It is
	likely when this happens that an integer overflow is to blame.

2009-02-01  David Gravereaux  <davygrvy@pobox.com>

	* win/makefile.vc: Allow nmake flags such as -a (rebuild all) to pass
	down to the pkgs targets, too.

2009-01-30  Donal K. Fellows  <dkf@users.sf.net>

	* doc/chan.n: [Bug 1216074]: Added another extended example.

	* doc/refchan.n: Added an example of how to build a scripted channel.

2009-01-29  Donal K. Fellows  <dkf@users.sf.net>

	* tests/stringObj.test: [Bug 2006888]: Remove non-ASCII chars from
	non-comment locations in the file, making it work more reliably in
	locales with a non-Latin-1 default encoding.

	* generic/tclNamesp.c (Tcl_FindCommand): [Bug 2519474]: Ensure that
	the path is not searched when the TCL_NAMESPACE_ONLY flag is given.

	* generic/tclOODecls.h (Tcl_OOInitStubs): [Bug 2537839]: Make the
	declaration of this macro work correctly in the non-stub case.

2009-01-29  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclInterp.c:	Convert the [interp] command into a
	* tests/interp.test:	[namespace ensemble].  Work in progress
	* tests/nre.test:	to NRE-enable the [interp invokehidden]
	subcommand.

2009-01-29  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529117]: Make this
	function behave more sensibly when presented with a fully-qualified
	name, rather than doing strange stuff.

2009-01-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c (TclInvokeObjectCommand): Made this understand
	what to do if it ends up being used on a command with no objProc; that
	shouldn't happen, but...

	* generic/tclNamesp.c (TclMakeEnsemble): [Bug 2529157]: Made this
	understand NRE command implementations better.
	* generic/tclDictObj.c (DictForCmd): Eliminate unnecessary command
	implementation.

2009-01-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOODefineCmds.c (Tcl_ClassSetConstructor):
	[Bug 2531577]: Ensure that caches of constructor chains are cleared
	when the constructor is changed.

2009-01-26  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclInt.h:   [Bug 1028264]: WSACleanup() too early.
	* generic/tclEvent.c: The fix introduces "late exit handlers" for
	* win/tclWinSock.c:   similar late process-wide cleanups.

2009-01-26  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* win/tclWinSock.c: [Bug 2446662]: Resync Win behavior on RST with
	that of unix (EOF).

2009-01-26  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ChanClose): [Bug 2536400]: Only generate error
	messages in the interpreter when the thread is not being closed down.

2009-01-23  Donal K. Fellows  <dkf@users.sf.net>

	* doc/zlib.n: Added a note that 'zlib push' is reversed by 'chan pop'.

2009-01-22  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCompile.h:	CONSTify TclPrintInstruction (TIP #27)
	* generic/tclCompile.c
	* generic/tclInt.h:	CONSTify TclpNativeJoinPath (TIP #27)
	* generic/tclFileName.c
	* generic/tcl.decls:	{unix win} is equivalent to {generic}
	* generic/tclInt.decls
	* generic/tclDecls.h:	(regenerated)
	* generic/tclIntDecls.h
	* generic/tclGetDate.y:	Single internal const decoration.
	* generic/tclDate.c:

2009-01-22  Kevin B. Kenny  <kennykb@acm.org>

	* unix/tcl.m4: Corrected a typo ($(SHLIB_VERSION) should be
	${SHLIB_VERSION}).
	* unix/configure: Autoconf 2.59

2009-01-21  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORChan.c (ReflectClose): [Bug 2458202]:
	* generic/tclIORTrans.c (ReflectClose): Closing a channel may supply
	NULL for the 'interp'. Test for finalization needs to be different,
	and one place has to pull the interp out of the channel instead.
	* generic/tclIORChan.c (ReflectClose): Fix for [Bug 2458202].
	Closing a channel may supply NULL for the 'interp'. Test for
	finalization needs to be different, and one place has to pull the
	interp out of the channel instead.

2009-01-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c: New fix for [Bug 2494093] replaces the
	flawed attempt committed 2009-01-09.

2009-01-19  Kevin B. Kenny  <kennykb@acm.org>

	* unix/Makefile.in: [Patch 907924]:Added a CONFIG_INSTALL_DIR
	* unix/tcl.m4:      parameter so that distributors can control where
	tclConfig.sh goes. Made the installation of 'ldAix' conditional upon
	actually being on an AIX system. Allowed for downstream packagers to
	customize SHLIB_VERSION on BSD-derived systems. Thanks to Stuart
	Cassoff for his help.
	* unix/configure: Autoconf 2.59

2009-01-19  David Gravereaux  <davygrvy@pobox.com>

	* win/build.vc.bat: Improved tools detection and error message
	* win/makefile.vc: Reorganized the $(TCLOBJ) file list into seperate
	parts for easier maintenance. Matched all sources built using -GL to
	both $(lib) and $(link) to use -LTCG and avoid a warning message.
	Addressed the over-building nature of the htmlhelp target by moving
	from a pseudo target to a real target dependent on the entire docs/
	directory contents.
	* win/nmakehlp.c: Removed -g option and GrepForDefine() func as it
	isn't being used anymore. The -V option method is much better.

2009-01-16  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump patchlevel to 8.6b1.1 to distinguish
	* library/init.tcl:	CVS snapshots from the 8.6b1 and 8.6b2 releases
	* unix/configure.in:	and to deal with the fact that the 8.6b1
	* win/configure.in:	version of init.tcl will not [source] in the
	HEAD version of Tcl.

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

2009-01-14  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken):	Reverted most
	of the substance of my 2009-01-12 commit. NULLing the objProc field of
	a Command when deleting it is important so that tests for certain
	classes of commands don't return false positives when applied to
	deleted command tokens. Overall change is now just replacement of a
	false comment with a true one.

2009-01-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
	using the native CC.
	* unix/configure (autoconf-2.59)

2009-01-13  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (Tcl_ThrowObjCmd):	Move implementation of [throw]
	* library/init.tcl (throw):		to C from Tcl.

2009-01-12  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c (Tcl_DeleteCommandFromToken): One consequence of
	the NRE rewrite is that there are now situations where a NULL objProc
	field in a Command struct is perfectly normal. Removed an outdated
	comment in Tcl_DeleteCommandFromToken that claimed we use
	cmdPtr->objPtr==NULL as a test of command validity. In fact we use
	cmdPtr->flags&CMD_IS_DELETED to perform that test. Also removed the
	setting to NULL, since any extension following the advice of the old
	comment is going to be broken by NRE anyway, and needs to shift to
	flag-based testing (or stop intruding into such internal matters).
	Part of [Bug 2486550].

2009-01-09  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c (STRING_SIZE): [Bug 2494093]: Corrected
	failure to limit memory allocation requests to the sizes that can be
	supported by Tcl's memory allocation routines.

2009-01-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclNamesp.c (NamespaceEnsembleCmd): [Bug 1558654]: Error out
	when someone gives wrong # of args to [namespace ensemble create].

2009-01-08  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStringObj.c (STRING_UALLOC): [Bug 2494093]: Added missing
	parens required to get correct results out of things like
	STRING_UALLOC(num + append).

2009-01-08  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclDictObj.c, generic/tclIndexObj.c, generic/tclListObj.c,
	* generic/tclObj.c, generic/tclStrToD.c, generic/tclUtil.c,
	* generic/tclVar.c: Generate errorcodes for the error cases which
	approximate to "I can't interpret that string as one of those" and
	"You gave me the wrong number of arguments".

2009-01-07  Donal K. Fellows  <dkf@users.sf.net>

	* doc/dict.n: [Tk Bug 2491235]: Added more examples.

	* tests/oo.test (oo-22.1): Adjusted test to be less dependent on the
	specifics of how [info frame] reports general frame information, and
	instead to focus on what methods add to it; that's really what the
	test is about anyway.

2009-01-06  Don Porter  <dgp@users.sourceforge.net>

	* tests/stringObj.test:	Revise tests that demand a NULL Tcl_ObjType
	in certain values to construct those values with [testdstring] so
	there's no lack of robustness depending on the shimmer history of
	shared literals.

2009-01-06  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclDictObj.c (DictIncrCmd): Corrected twiddling in internals
	of dictionaries so that literals can't get destroyed.

	* tests/expr.test: [Bug 2006879]: Eliminate non-ASCII char.

	* tests/expr.test, tests/string.test: Eliminate non-ASCII characters.
	[Bugs 2006884, 2006879]
	* generic/tclOOInfo.c (InfoObjectMethodsCmd,InfoClassMethodsCmd):
	[Bug 2489836]: Only delete pointers that were actually allocated!

	* generic/tclOO.c (TclNRNewObjectInstance, Tcl_NewObjectInstance):
	[Bug 2481109]: Perform search for existing commands in right context.

2009-01-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdMZ.c (TclNRSourceObjCmd): [Bug 2412068]: Make
	* generic/tclIOUtil.c (TclNREvalFile):    implementation of the
	[source] command be NRE enabled so that [yield] inside a script
	sourced in a coroutine can work.

2009-01-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c: Tidy up spacing and code style.

2009-01-03  Kevin B. Kenny  <kennykb@acm.org>
2009-01-03  Kevin B. Kenny  <kennykb@acm.org>:

	* library/clock.tcl (tcl::clock::add): Fixed error message formatting
	in the case where [clock add] is presented with a bad switch.
	* tests/clock.test (clock-65.1) Added a test case for the above
	problem [Bug 2481670].

2009-01-02  Donal K. Fellows  <dkf@users.sf.net>

	* unix/tcl.m4 (SC_CONFIG_CFLAGS): [Bug 878333]: Force the use of the
	compatibility version of mkstemp() on IRIX.
	* unix/configure.in, unix/Makefile.in (mkstemp.o):
	* compat/mkstemp.c (new file): [Bug 741967]: Added a compatibility
	implementation of the mkstemp() function, which is apparently needed
	on some platforms.

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2008 IN "ChangeLog.2008"             ***
	*** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007"        ***
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"             ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"             ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"             ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"             ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"             ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************

Changes to ChangeLog.2000.

1775
1776
1777
1778
1779
1780
1781
1782

1783
1784
1785
1786
1787
1788
1789
1775
1776
1777
1778
1779
1780
1781

1782
1783
1784
1785
1786
1787
1788
1789







-
+








	* tests/regexp.test: Added tests for infinite looping in [regexp
	-all].

	* generic/tclCmdMZ.c: Fixed infinite loop bug with [regexp -all]
	[Bug: 4981].

	* tests/*.test: Changed all occurrences of "namespace import
	* tests/*.test: Changed all occurances of "namespace import
	::tcltest" to "namespace import -force ::tcltest" [Bug: 3948].

2000-04-09  Brent Welch <welch@scriptics.com>

	* lib/httpd2.1/http.tcl: Worked on the "server closes before reading
	post data" case, which unfortunately causes different error cases on
	Solaris, which can read the reply, and Linux and Windows, which cannot

Changes to ChangeLog.2001.

347
348
349
350
351
352
353
354

355
356
357
358
359
360
361
347
348
349
350
351
352
353

354
355
356
357
358
359
360
361







-
+







	the .exp files and can remove use of #pragma export that never worked
	well)
	removed line continuation in #if clause as this breaks the mac
	resource compiler (note that *.r files include tcl.h)

	* mac/tclMacFile.c: fixed bug in permission checking code

	* mac/tclMacLoad.c: corrected utf-8 handling, comparison of package
	* mac/tclMacLoad.c: corrected utf8 handling, comparison of package
	names to code fragment names changed to only match on the length of
	package name, this allows for fragment names with version numbers
	appended.

	* mac/tclMacInt.h:
	* generic/tclInt.h:
	* mac/tclMacTime.c:
3521
3522
3523
3524
3525
3526
3527
3528

3529
3530
3531
3532
3533
3534
3535
3521
3522
3523
3524
3525
3526
3527

3528
3529
3530
3531
3532
3533
3534
3535







-
+







	[Patch 403229]

2001-03-06  Donal K. Fellows  <fellowsd@cs.man.ac.uk>

	* generic/tclVar.c (Tcl_UnsetObjCmd): Rewrote argument parser to avoid
	a read off the end of the argument array that could occur when
	executing something like [unset -nocomplain] was executed. Improved
	the error message given when not enough arguments are given (-nocomplain
	the error message given when too few arguments are given (-nocomplain
	should obviously be *before* --, not after it) and also modified the
	test suite to take account of that and the documentation to use the
	same improvement. [Bug 405769]

2001-03-02  Donal K. Fellows  <fellowsd@cs.man.ac.uk>

	* generic/tclExecute.c (TclExecuteByteCode): Fixed bug that could pass

Changes to ChangeLog.2002.

1749
1750
1751
1752
1753
1754
1755
1756

1757
1758
1759
1760
1761
1762
1763
1749
1750
1751
1752
1753
1754
1755

1756
1757
1758
1759
1760
1761
1762
1763







-
+








2002-07-05  Don Porter  <dgp@users.sourceforge.net>

	* changes: added recent changes

2002-07-05  Reinhard Max  <max@suse.de>

	* generic/tclClock.c (FormatClock): Convert the format string to utf-8
	* generic/tclClock.c (FormatClock): Convert the format string to UTF8
	before calling TclpStrftime, so that non-ASCII characters don't get
	mangled when the result string is being converted back.
	* tests/clock.test: Added a test for that.

2002-07-05  Donal K. Fellows  <fellowsd@cs.man.ac.uk>

	* unix/Makefile.in (ro-test,ddd,GDB,DDD): Created new targets to

Changes to ChangeLog.2004.

2298
2299
2300
2301
2302
2303
2304
2305

2306
2307
2308
2309
2310
2311
2312
2298
2299
2300
2301
2302
2303
2304

2305
2306
2307
2308
2309
2310
2311
2312







-
+







	variable instead of retrieving the string again. Fixes [Bug 835289].

	* doc/OpenFileChnl.3: Added description of the behaviour of
	Tcl_ReadChars when its 'charsToRead' argument is set to -1. Fixes [Bug
	934511].

	* doc/CrtCommand.3: Added note that the arguments given to the command
	proc of a Tcl_CreateCommand are in utf-8 since Tcl 8.1. Closing [Patch
	proc of a Tcl_CreateCommand are in utf8 since Tcl 8.1. Closing [Patch
	414778].

	* doc/ChnlStack.3: Removed the declaration that the interp argument to
	Tcl_(un)StackChannel can be NULL. This fixes [Bug 881220], reported by
	Marco Maggi <marcomaggi@users.sourceforge.net>.

	* tests/socket.test: Accepted two new testcases by Stuart Casoff
2869
2870
2871
2872
2873
2874
2875
2876

2877
2878
2879
2880
2881
2882
2883
2869
2870
2871
2872
2873
2874
2875

2876
2877
2878
2879
2880
2881
2882
2883







-
+







	rejecting the "fix" for "Bug" 945570. Tcl_FSSeek() needs the values of
	SEEK_SET, etc. and too many extensions rely on tcl.h providing stdio.h
	for them.

2004-06-02  Jeff Hobbs	<jeffh@ActiveState.com>

	* win/tclWinFile.c (TclpFindExecutable): when using GetModuleFileNameA
	(Win9x), convert from CP_ACP to WCHAR then convert back to utf-8.
	(Win9x), convert from CP_ACP to WCHAR then convert back to utf8.
	Adjunct to 2004-04-07 fix.

2004-06-02  David Gravereaux <davygrvy@pobox.com>

	* tests/winPipe.test (winpipe-6.1): blocking set to 1 before closing
	to ensure we get an exitcode. The windows pipe channel driver doesn't
	differentiate between a blocking and non-blocking close just yet, but

Changes to ChangeLog.2007.

1422
1423
1424
1425
1426
1427
1428
1429

1430
1431
1432
1433
1434
1435
1436
1422
1423
1424
1425
1426
1427
1428

1429
1430
1431
1432
1433
1434
1435
1436







-
+







	an expr syntax error (masked by a [catch]).

	* generic/tclCompCmds.c (TclCompileReturnCmd):	Added crash protection
	to handle callers other than TclCompileScript() failing to meet the
	initialization assumptions of the TIP 280 code in CompileWord().

	* generic/tclCompExpr.c:	Suppress the attempt to convert to
	numeric when pre-compiling a constant expression indicates an error.
	numeric when pre-compiling a constant expresion indicates an error.

2007-08-22  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (TEBC): disable the new shortcut to frequent
	INSTs for debug builds. REVERTED (collision with alternative fix)

2007-08-21  Don Porter	<dgp@users.sourceforge.net>
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919






5920
5921
5907
5908
5909
5910
5911
5912
5913






5914
5915
5916
5917
5918
5919
5920
5921







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


	* win/tclAppInit.c: WIN32 native console signal handler removed. This
	was found to be interfering with TWAPI extension one. IMO, special
	services such as signal handlers should best be done with extensions
	to the core after discussions on c.l.t. about Roy Terry's tclsh
	children of a real windows service shell.

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"	       ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"	       ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"	       ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"	       ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"	       ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"	       ***
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"             ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"             ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"             ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"             ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"             ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************

Changes to ChangeLog.2008.

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
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
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
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
611

612
613
614
615

616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461


1462
1463

1464
1465


1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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

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
-

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

-
-
+
-

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





+




-
-
+
-
-
-

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

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






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+

-
+
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
+
-
-
-

-
-
+
-
-

-
+
-
-
-
-
-




-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+
-
-
-
+
-
-
+
-
-

-
+

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






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







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

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

-
-
-
-
-
-
-
-
+









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











-
+

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






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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



-
-
-
-




-
+

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













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-


-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
+
+
-
-
+


+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-





-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-









-
+

-
-
+
-






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





+
+
+




-
-
-
-
-







-
+
-
-
-
-
-







-
-
-
-
-
-
+

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







2008-12-31  Don Porter  <dgp@users.sourceforge.net>

	* unix/Makefile.in:	Set TCLLIBPATH in SHELL_ENV so that targets
	like `make shell` have access to builds of bundled packages.

2008-12-28  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (Tcl_ZlibStreamPut): Plug a memory leak.

2008-12-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ZlibStreamCmd): Fix compilation consistency. [Bug
	* generic/tcl.decls:		     2470237]

	* generic/tclZlib.c (Tcl_ZlibStreamGet): Corrected the semantics of
	this function to be useful to the PNG implementation. If the argument
	object is empty, this gives the previous semantics.
	(Tcl_ZlibStreamChecksum): Corrected name to be less misleading; it
	only produced Adler-32 checksums when the stream was processing the
	right type of compressed data format.
	(Tcl_ZlibAdler32, Tcl_ZlibCRC32): Corrected types so that they work
	naturally with the results of Tcl_GetByteArrayFromObj().
	*** POTENTIAL INCOMPATIBILITY *** for all above changes, but very
	unlikely to be difficult for anyone to deal with.

2008-12-26  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tcl.decls: Tidy up the commenting style, adding markers for
	each of the big release points under TCT stewardship and noting the
	general purpose of each TIP that added C API. Overall effect is to
	make this file much more informative to read without having to spend
	effort correlating with TIPs and ChangeLogs.

2008-12-23  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in:	Fix build of zlib objects with msvc
	* win/tcl.m4:
	* win/configure:	autoconf-2.59

2008-12-23  Donal K. Fellows  <dkf@users.sf.net>

	* win/Makefile.in: Handle file extensions correctly. [Bug 2459725]

2008-12-22  Pat Thoyts  <patthoyts@users.sourceforge.net>

	*** 8.6b1 TAGGED FOR RELEASE ***

	* win/makefile.vc: Ensure pkgs directories are suitable and quote the
			   paths. [Bug 2458395]

2008-12-22  Joe Mistachkin  <joe@mistachkin.com>

	* tools/man2help2.tcl: Added support for "\(mi" nroff macro. [Bug
	2330040]

2008-12-22  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* win/makefile.vc: Support the pkgs tree in the NMAKE builds.

2008-12-21  Daniel Steffen  <das@users.sourceforge.net>

	* unix/Makefile.in:	Fix broken build of bundled packages when path
				to build dir contains spaces by switching to
				relative paths to toplevel build dir.

	* unix/configure.in:	Preserve configure environment variables for
				sub-configures of bundled packages; reuse
				configure cache file for sub-configures.

	* unix/configure:	autoconf-2.59

2008-12-21  Donal K. Fellows  <dkf@users.sf.net>

	* doc/TclZlib.3: Fix minor typo. [Bug 2455165]

2008-12-20  Kevin B. Kenny  <kennykb@acm.org>

	* win/Makefile.in:	Renamed the static library libtcl86s.a to
	* win/configure.in:	have a name distinct from the import library
				libtcl86.a. This renaming dodges an ancient
				bug in the Makefile revealed by the last
				commit where the $(TCL_LIB_FILE) rule can
				fire to try to build the static library in a
				--enable-shared build (and create a static
				library that subsequently fails to link).
				Revised the zlib objects so that they are
				built directly into the build dir, without
				building an intermediate static library.
				*** POTENTIAL INCOMPATIBILITY *** for
				embedders who link to the static library, but
				I couldn't figure out how to sort this out
				any other way.
	* win/configure:	Autoconf 2.59

2008-12-20  Donal K. Fellows  <dkf@users.sf.net>

	* win/Makefile.in: Minor updates to make building work better with
	msys on Windows. (Apparently the gcc used doesn't like a / at the end
	of a -I argument...)

2008-12-20  Don Porter  <dgp@users.sourceforge.net>
2008-12-21  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6b1 release.

	*** 8.5.6 TAGGED FOR RELEASE ***
2008-12-20  Daniel Steffen  <das@users.sourceforge.net>

	* unix/Makefile.in:	Make package install directory of bundled
	* unix/configure.in:	packages configurable via PACKAGE_DIR makefile
				variable (set to platform-specific default).

	* unix/Makefile.in (*-packages): Ensure toplevel targets fail if
				sub-make/configure fails; fix quoting when
				builddir path contains spaces.

	* macosx/GNUmakefile:	Add install-packages to install targets.

	* unix/configure:	autoconf-2.59

2008-12-19  Don Porter  <dgp@users.sourceforge.net>

	* doc/NRE.3:		Formatting errors found by `make html`
	* doc/Tcl_Main.3:
	* doc/zlib.n:

	* tests/chanio.test:	Add missing [removeFile] cleanups.
	* tests/io.test:	Add missing [close $f] to io-73.2.

	* unix/Makefile.in:	Update `make dist' target to include the files
	from the compat/zlib directory as well as all the bundled packages
	found under the pkgs directory, according to their individual `make
	dist' targets. Change includes breaking a `configure-packages' target
	out of the `packages` target.

	* README:		Bump version number to 8.6b1
	* generic/tcl.h:
	* generic/tcl.h:	Bump to 8.5.6 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:
	* README:

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

2008-12-19  Jan Nijtmans  <nijtmans@users.sf.net>

	* changes:	Update for 8.5.6 release.
	* generic/tclInt.decls: CONSTify TclGetLoadedPackages second param
	* generic/tclLoad.c
	* generic/tclIntDecls.h (regenerated)

2008-12-19  Kevin Kenny  <kennykb@acm.org>

	* library/tclIndex: Removed reference to no-longer-extant procedure
	* generic/tclExecute.c:	Fix compile warnings when --enable-symbols=all

	'tclLdAout'.
	* win/configure.in:
	* win/Makefile.in: Added build of packages in the 'pkgs/' directory.
	* win/configure: Autoconf 2.59

	* doc/library.n: Corrected mention of 'auto_exec' to 'auto_execok'.
2008-12-19  Pat Thoyts  <patthoyts@users.sourceforge.net>

	[Patch 2114900] thanks to Stu Cassoff <stwo@users.sf.net>
	* win/makefile.vc: Added build of compat/zlib

	Backport of 2008-11-26 commit from Kevin Kenny.
2008-12-18  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (Tcl_CloseEx, CloseWrite, CloseChannelPart)
	(ChanCloseHalf): Rewrite the half-close to properly flush the channel,
	like is done for a full close, going through FlushChannel, and using
	the flag BG_FLUSH_SCHEDULED (async flush during close). New functions
	CloseWrite, CloseChannelPart, new flag CHANNEL_CLOSEDWRITE.

	* tests/chanio.test (chanio-28.[67]): Reactivated these tests.
	Replaced tclsh -> [interpreter] to get correct executable for the pipe
	process, and added after cancel to kill the fail timers when we are
	done. Removed the explicits calls to [flush], now that [close] handles
	this correctly.

2008-12-18  Don Porter  <dgp@users.sourceforge.net>

	* tests/chanio.test:	Replaced [chan event] handlers that returned
	TCL_RETURN return code, with more conventional ones that return TCL_OK
	to suppress otherwise strange writes of outdated $::errorInfo values
	to stderr. [Bug 2444274]

	* generic/tclExecute.c:	Disabled apparently faulty assertion. [Bug
	2415422]

2008-12-18  Donal K. Fellows  <dkf@users.sf.net>

	* unix/configure.in, unix/Makefile.in: Autoconf wizardry.
	* compat/zlib/*: Import of zlib 1.2.3. The license is directly
	compatible with Tcl's. This import omits the obsolete and contributed
	parts (i.e. selected directories) and the supplied examples.

	* generic/tclZlib.c:	First implementation of the compressing and
	* doc/zlib.n:		decompressing channel transformations.
	* tests/zlib.test (zlib-8.*):

2008-12-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.decls:	VOID -> void
	* generic/tclInt.decls:
	* compat/dlfcn.h:
	* generic/tclDecls.h:	(regenerated)
	* generic/tclIntDecls.h:

2008-12-18  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	TIP #332 IMPLEMENTATION - Half-Close for Bidirectional Channels

	* doc/close.n, generic/tclIO.c, generic/tclIOCmd.c:
	* unix/tclUnixChan.c, unix/tclUnixPipe.c, win/tclWinSock.c:
	* generic/tcl.decls, generic/tclDecls.h, generic/tclStubInit.c:
	* tests/chan.test, tests/chanio.test, tests/ioCmd.test:

	* win/tclWinThrd.c (TclpThreadCreate): We need to initialize the
2008-12-17  Donal K. Fellows  <dkf@users.sf.net>

	thread id variable to 0 as on 64 bit windows this is a pointer sized
	* doc/SetChanErr.3: General improvements in nroff rendering and some
	corrections to language issues.

	field while windows only fills it with a 32 bit value. The result is
2008-12-17  Jan Nijtmans  <nijtmans@users.sf.net>

	an inability to join the threads as the ids cannot be matched.
	* generic/tclResult.c:	   Move variable "length" inside if()
	* generic/tclStringObj.c:  Don't use ckfree((void *)...) but
	* generic/tclVar.c:	   ckfree((char *)...)
	* generic/tclZlib.c
	* generic/tclBasic.c

	Backport of 2008-10-13 commit from Pat Thoyts.
2008-12-17  Donal K. Fellows  <dkf@users.sf.net>

	* tests/namespace.test (namespace-28.1):	Make tests not
	* tests/namespace-old.test (namespace-old-9.5): dependent on the
	global namespace's particular imports. [Bug 2433936]

2008-12-17  Don Porter  <dgp@users.sourceforge.net>

	* unix/Makefile.in:	Modify the distclean-packages target so that
	empty build directories are deleted.

	* unix/Makefile.in:	Add build support for collections of TEA
	* unix/configure.in:	packages found under the pkgs directory.
	[Patch 1163406]. Still needs porting to Windows.

	* unix/configure:	autoconf-2.59

2008-12-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tcl.h, generic/tclZlib.c: Removed undocumented flag.

2008-12-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclThreadTest.c: Eliminate -Wwrite-strings warnings in
				   --enable-threads build.
	* generic/tclExecute.c:	   Use TclNewLiteralStringObj()
	* unix/tclUnixFCmd.c:	   Use TclNewLiteralStringObj()
	* win/tclWinFCmd.c:	   Use TclNewLiteralStringObj()

2008-12-16  Donal K. Fellows  <dkf@users.sf.net>

	TIP #329 IMPLEMENTATION

	* tests/error.test: Tests for the new commands.
	* doc/throw.n, doc/try.n: Documentation of the new commands.
	* library/init.tcl (throw, try): Implementation of commands documented
	in TIP. This implementation is in Tcl and is a stop-gap until
	higher-performance ones can be written.

2008-12-16  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:	Add TIP 338 routines to stub table.
	* generic/tcl.decls:	[Bug 2431338]

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-12-15  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclExecute.c (TEBC:INST_DICT_GET): Make sure that the result
	is empty when generating an error message. [Bug 2431847]

2008-12-15  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tclBinary.c:	Redefine non-strict decoding to ignore only
	* doc/binary.n:		whitespace. [Bug 2380293]
	* tests/binary.test:

2008-12-15  Don Porter  <dgp@users.sourceforge.net>

	* doc/AddErrInfo.3:	Documented Tcl_(Set|Get)ErrorLine (TIP 336).
	* doc/CrtCommand.3:	Various other documentation updates to
	* doc/CrtInterp.3:	reflect the lack of access to Tcl_Interp
	* doc/Interp.3:		fields by default.
	* doc/SetResult.3:
	* doc/tcl.decls:

	TIP #338 IMPLEMENTATION

	* doc/AppInit.c:	Made routines Tcl_SetStartupScript and
	* doc/Tcl_Main.3:	Tcl_GetStartupScript public. Removed all
	* generic/tcl.h:	internal stub access to Tcl*Startup* routines,
	* generic/tclInt.decls:	and removed their implementations. Their
	* generic/tclMain.c:	function can now be completely performed with
				the new public interface.
	*** POTENTIAL INCOMPATIBILITY for callers of the internal
	    Tcl*Startup* routines. ***

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:
	* generic/tclDecls.h:

2008-12-14  Donal K. Fellows  <dkf@users.sf.net>

	* tests/zlib.test: Added constraint so that tests don't fail where
	they cannot work due to zlib support being missing.

	* unix/configure.in, win/configure.in: Improve the autodetection code.
	* win/tcl.m4 (SC_CONFIG_CFLAGS): Remove the assumption of the presence
	of zlib library on Windows.
	* win/makefile.vc, win/makefile.bc: Add support for building tclZlib.o
	but only in stubbed-out mode for now.

2008-12-13  Donal K. Fellows  <dkf@users.sf.net>

	* doc/TclZlib.3: Basic documentation of the C-level API.
	* doc/zlib.n: Substantially improve documentation of Tcl-level API.
	* generic/tclZlib.c (ZlibCmd): Flesh out the argument parsing for the
	command to integrate with channels.

2008-12-12  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclZlib.c (Tcl_ZlibInflate): Change PATH_MAX to MAXPATHLEN,
	since MSVC doesn't have PATH_MAX.

	* doc/clock.n:	Document new DST fallback rules.
	* library/clock.tcl (ProcessPosixTimeZone): Fix time change in Eastern
	Europe (not 3:00 but 4:00 local time). [Bug 2207436]

2008-12-12  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c, unix/configure.in: Added stubs to use when the
	version of zlib is not capable enough, and automagic to detect when
	that is the case. [Bug 2421265]

2008-12-12  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* unix/tclUnixNotfy.c: Fix missing CLOEXEC on internal pipes [2417695]
	* unix/tclUnixPipe.c:  Fix missing CLOEXEC on [chan pipe] fds.

2008-12-12  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (Tcl_ZlibDeflate): Add a bit of extra space for
	the gzip header. [Bug 2419061]
	(Tcl_ZlibInflate): Ensure that gzip header extraction is done
	correctly.

2008-12-12  Kevin Kenny  <kennykb@acm.org>

	TIP #322 IMPLEMENTATION

	* doc/NRE.3 (new file): Added documentation of the published API for
	Non-Recursive Evaluation (NRE).

2008-12-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclZlib.c: Eliminate warning: different 'const' qualifiers
	with msvc compiler. A few more 'const' optimizations.
	* win/tcl.m4: Fix Windows build (msvc) for TIP #234 implementation
	* win/Makefile.in:
	* win/configure:

2008-12-11  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (SetChannelFromAny and related): Modified the
	* tests/io.test: internal representation of the tclChannelType to
	contain not only the ChannelState pointer, but also a reference to
	the interpreter it was made in. Invalidate and recompute the
	internal representation when it is used in a different interpreter,
	like cmdName intrep's. Added testcase. [Bug 2407783]

2008-12-11  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclZlib.c (ConvertError): Factor out code to turn zlib
	errors into Tcl errors.

	* doc/zlib.n: Added a start at the documentation. Still very rough.

2008-12-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/Makefile.in: Fix Windows build (mingw) for TIP #234
	implementation (additionally, first make sure that zlib is available,
	and rename the standard zdll.lib to libz.a, but at least this works so
	far).

2008-12-11  Donal K. Fellows  <dkf@users.sf.net>

	* tests/zlib.test: Start of test suite for zlib command.

2008-12-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* library/clock.tcl (ProcessPosixTimeZone): Fallback to European time
	zone DST rules, when the timezone is between 0 and -12. [Bug 2207436]
	* tests/clock.test (clock-52.[23]): Test cases for [Bug 2207436]

2008-12-11  Donal K. Fellows  <dkf@users.sf.net>

	TIP #234 IMPLEMENTATION

	* generic/tclZlib.c: A very preliminary hack at an interface to the
	zlib library, based on code from Pascal Scheffers.
	WARNING! The C API may be subect to change without much warning! USE
	AT YOUR OWN RISK!

2008-12-10  Kevin B. Kenny  <kennykb@acm.org>

	* library/tzdata/*: Update from Olson's tzdata2008i.

2008-12-10  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	TIP #343 IMPLEMENTATION - A Binary Specifier for [format/scan]

	* doc/format.n
	* doc/scan.n
	* generic/tclInt.h
	* generic/tclScan.c
	* generic/tclStrToD.c
	* generic/tclStringObj.c
	* tests/format.test
	* tests/scan.test

2008-12-10  Donal K. Fellows  <dkf@users.sf.net>

	TIP #341 IMPLEMENTATION

	* generic/tclDictObj.c (DictFilterCmd): Made key and value filtering
	* tests/dict.test, doc/dict.n:		accept arbitrary numbers of
						glob arguments.

2008-12-09  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls: Restore source and binary compatibility for
				TIP #337 implementation. (When it is _that_
				simple, there is no excuse not to do it! :-))
	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-12-09  Don Porter  <dgp@users.sourceforge.net>

	TIP #337 IMPLEMENTATION

	* doc/BackgdErr.3:	Converted internal routine
	* doc/interp.n:		TclBackgroundException() into public routine
	* generic/tcl.decls:	Tcl_BackgroundException().
	* generic/tclEvent.c:
	* generic/tclInt.decls:

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

	* generic/tclIO.c:	Update callers.
	* generic/tclIOCmd.c:
	* generic/tclInterp.c:
	* generic/tclTimer.c:
	*** POTENTIAL INCOMPATIBILITY only for extensions using the converted
	    internal routine ***

2008-12-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclIO.c (ChanClose,ChanRead,...): Factored out some of the
	code to connect to channel drivers that was common in multiple
	locations so as to make code more readable.

2008-12-06  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c (FileTempfileCmd): Force temporary files to be
	created in the native filesystem. Attempting to provide a template
	that puts it elsewhere will result in the directory part of the
	template being ignored. Partial address of [Bug 2388866] concerns.

2008-12-05  Donal K. Fellows  <dkf@users.sf.net>

	TIP #335 IMPLEMENTATION

	* generic/tclBasic.c (Tcl_InterpActive): Added function for working
	* doc/CrtInterp.3:			 out if an interp is in use.

	TIP #307 IMPLEMENTATION

	* generic/tclResult.c (Tcl_TransferResult): Renamed function from
	* generic/tcl.decls:			    TclTransferResult. Added
	* doc/SetResult.3:			    to public stubs table.

2008-12-04  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c (Tcl_FSGetNormalizedPath):	Added another
	flag value TCLPATH_NEEDNORM to mark those intreps which need more
	complete normalization attention for correct results. [Bug 2385549]

2008-12-03  Donal K. Fellows  <dkf@users.sf.net>

	* win/tclWinPipe.c (TclpOpenTemporaryFile): Avoid an infinite loop due
	to GetTempFileName/CreateFile interaction. [Bug 2380318]

2008-12-03  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFileName.c (DoGlob):    One of the Tcl_FSMatchInDirectory
	calls did not have its return code checked. This caused error messages
	returned by some Tcl_Filesystem drivers to be swallowed.

2008-12-02  Don Porter  <dgp@users.sourceforge.net>

	TIP #336 IMPLEMENTATION

	* generic/tcl.decls:	New routines Tcl_(Get|Set)ErrorLine.
	* generic/tcl.h:	Dropped default access to interp->errorLine.
	* generic/tclCmdAH.c:	Restore it with -DUSE_INTERP_ERRORLINE.
	* generic/tclCmdMZ.c:	Updated callers.
	* generic/tclDictObj.c:
	* generic/tclIOUtil.c:
	* generic/tclNamesp.c:
	* generic/tclOOBasic.c:
	* generic/tclOODefinedCmds.c:
	* generic/tclOOMethod.c:
	* generic/tclProc.c:
	* generic/tclResult.c:
	*** POTENTIAL INCOMPATIBILITY for C code directly using the
	    interp->errorLine field ***

	* generic/tclDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-12-02  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (TclFinalizeIOSubsystem): Replaced Alexandre
	Ferrieux's first patch for [Bug 2270477] with a gentler version, also
	supplied by him.

2008-12-01  Don Porter  <dgp@users.sourceforge.net>
2008-12-01  Don Porter	<dgp@users.sourceforge.net>

	* generic/tclParse.c:  Coding standards fixups.
	* generic/tclParse.c:	Backport fix for [Bug 2251175].

2008-12-01  Donal K. Fellows  <dkf@users.sf.net>

	* tests/cmdAH.test (cmdAH-32.6): Test was not portable; depended on a
	C API function not universally available. [Bug 2371623]

2008-11-30  Kevin B. Kenny  <kennykb@acm.org>

	* library/clock.tcl (format, ParseClockScanFormat): Added a [string
	map] to get rid of namespace delimiters before caching a scan or
	format procedure. [Bug 2362156]
	* tests/clock.test (clock-64.[12]): Added test cases for the bug that
	was tickled by a namespace delimiter inside a format string.

2008-11-29  Donal K. Fellows  <dkf@users.sf.net>

	TIP #210 IMPLEMENTATION

	* generic/tclCmdAH.c (FileTempfileCmd):
	* unix/tclUnixFCmd.c (TclpOpenTemporaryFile, DefaultTempDir):
	* win/tclWinPipe.c (TclpOpenTemporaryFile):
	* doc/file.n, tests/cmdAH.test: Implementation of [file tempfile]. I
	do not claim that this is a brilliant implementation, especially on
	Windows, but it covers the main points.

	* generic/tclThreadStorage.c: General revisions to make code clearer
	and more like the style used in the rest of the core. Includes adding
	more comments and explanation of what is going on. Reduce the amount
	of locking required.

2008-11-27  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* generic/tcl.h:	Alternate fix for [Bug 2251175]: missing
	* generic/tclCompile.c:	backslash substitution on expanded literals.
	* generic/tclParse.c:
	* generic/tclTest.c:
	* tests/parse.test:

2008-11-26  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIndexObj.c:   Eliminate warning: unused variable
	* generic/tclTest.c:	   A few more (harmless) Tcl_SetResult
				   eliminations.

2008-11-26  Kevin B. Kenny  <kennykb@acm.org>

	* library/tclIndex: Removed reference to no-longer-extant procedure
			    'tclLdAout'.
	* doc/library.n: Corrected mention of 'auto_exec' to 'auto_execok'.
	[Patch 2114900] thanks to Stuart Cassoff <stwo@users.sf.net>

2008-11-25  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclIndexObj.c: Eliminate 3 calls to Tcl_SetResult, as
	* generic/tclIO.c:	 examples how it should have been done.
	* generic/tclTestObj.c:	 purpose: contribute in the TIP #340
				 discussion.

2008-11-25  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (TclFinalizeIOSubsystem): Applied Alexandre
	Ferrieux's patch for [Bug 2270477] to prevent infinite looping during
	finalization of channels not bound to interpreters.

2008-11-25  Jan Nijtmans  <nijtmans@users.sf.net>

2008-08-23  Andreas Kupries  <andreask@activestate.com>
	* generic/tclTest.c: Don't assume that Tcl_SetResult sets
	interp->result, especially not in a DString test, in preparation for
	TIP #340

2008-11-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclIO.c: Backport of fix for [Bug 2333466].
	* tools/tcltk-man2html.tcl: Improvements to tackle tricky aspects of
	cross references and new entities to map. [Bug 2330040]

2008-11-19  Jan Nijtmans  <nijtmans@users.sf.net>
2008-11-18  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclThreadTest.c: Convert Tcl_SetResult(......, TCL_DYNAMIC)
	to Tcl_SetResult(......, TCL_VOLATILE), in preparation for TIP #340

2008-11-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tcl.decls:	Fix signature and implementation of
	* generic/tclDecls.h:	Tcl_HashStats, such that it conforms to the
	* generic/tclHash.c:	documentation. [Bug 2308236]
	* generic/tclVar.c:
	* doc/Hash.3:
	* generic/tclDictObj.c: Convert Tcl_SetResult call to
	Tcl_SetObjResult.

2008-11-17  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* tests/for.test: Check for uncompiled-for-continue [Bug 2186888]
	fixed earlier.

	* generic/tcl.h:	 Fix [Bug 2251175]: missing backslash
	* generic/tclCompCmds.c: substitution on expanded literals.
	* generic/tclCompile.c
	* generic/tclParse.c
	* generic/tclTest.c
	* tests/compile.test
	* tests/parse.test

2008-11-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclTest.c: Replace two times Tcl_SetResult with
	Tcl_SetObjResult, a little simplification in preparation for the TIP
	#340 patch.

2008-11-13  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.h:	Rename static function FSUnloadTempFile to
	* generic/tclIOUtil.c:	TclFSUnloadTempFile, needed in tclLoad.c

	* generic/tclLoad.c:	Fixed [Bug 2269431]: Load of shared
				objects leaves temporary files on windows.

2008-11-12  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* tests/registry.test: Use HKCU to avoid requiring admin access for
	registry testing on Vista/Server2008

2008-11-11  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclNamesp.c:	Eliminate warning: passing arg 4 of
				Tcl_SplitList from incompatible pointer type.
	* win/tcl.m4:	Reverted change from 2008-11-06 (was under the
			impression that "-Wno-implicit-int" added an extra
			warning)
	* win/configure: (regenerated)
	* unix/tcl.m4:	Use -O2 as gcc optimization compiler flag, and get rid
			of -Wno-implicit-int for UNIX.
	* unix/configure: (regenerated)

2008-11-10  Andreas Kupries  <andreask@activestate.com>

	* doc/platform_shell.n: Fixed [Bug 2255235], reported by Ulrich
	* library/platform/pkgIndex.tcl: Ring <uring@users.sourceforge.net>.
	* library/platform/shell.tcl: Updated the LOCATE command in the
	* library/tm.tcl:   package 'platform::shell' to handle the new form
	* unix/Makefile.in: of 'provide' commands generated by tm.tcl. Bumped
	* win/Makefile.in:  package to version 1.1.4. Added cross-references
	to the relevant parts of the code to avoid future desynchronization.

2008-11-07  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclInt.h:    Applied [Patch 2215022] from Duoas to clean up
	* generic/tclBinary.c: the binary ensemble initiailization code.
	* generic/tclNamesp.c: Extends the TclMakeEnsemble to do
	* doc/ByteArrObj.3:    sub-ensembles from tables.

2008-11-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* win/tcl.m4:	    Add "-Wno-implicit-int" flag for gcc, as on UNIX
	* win/configure:    (regenerated)
	* generic/tclIO.c:  Eliminate an 'array index out of bounds' warning
			    on HP-UX.

2008-11-04  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclPort.h: Remove the ../win/ header dir as the build system
	already has it, and it confuses builds when used with private headers
	installed.

2008-11-01  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.h (TCLOO_VERSION): Bump version of TclOO.

2008-10-31  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOBasic.c (TclOONRUpcatch): Reworked the code that does
	* generic/tclOO.c (InitFoundation):	 class constructor handling so
	that it is more robust and runs the constructor call in the context of
	the caller of the class's constructor method. Needed because the
	previously used code did not work at all after applying the fix below;
	no Tcl existing command could reliably do what was needed any more.

	* generic/tclOODefineCmds.c (GetClassInOuterContext): Rework and
	factor out the code to resolve class names in definitions so that
	classes are resolved from the perspective of the caller of the
	[oo::define] command, rather than from the oo::define namespace! This
	makes much code simpler by reducing how often fully-qualified names
	are required (previously always in practice, so no back-compat issues
	exist). [Bug 2200824]

2008-10-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclCompile.h: CONSTify TclDTraceInfo
	* generic/tclBasic.c:
	* generic/tclProc.c:
	* generic/tclEnv.c:	Eliminate some -Wwrite-strings warnings
	* generic/tclLink.c:

2008-10-27  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclEncoding.c:	Use "iso8859-1" and not "identity" as
	the default and original [encoding system] value. Since "iso8859-1" is
	built in to the C source code for Tcl now, there's no availability
	issue, and it has the good feature of "identity" that we must have
	("bytes in" == "bytes out") without the bad feature of "identity"
	("broken as designed") that makes us want to abandon it. [RFE 2008609]
	*** POTENTIAL INCOMPATIBILITY for older releases of Tclkit and any
	other code expecting a particular value for Tcl's default system
	encoding ***

2008-10-24  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/http/http.tcl: Fixed a failure to read SHOUTcast streams
	* library/http/http.tcl: Backported a fix for reading HTTP-like
	with the new 2.7 package. Introduced a new intial state as the first
	response may not be HTTP*.

	protocols that used to work and were broken with http 2.7. Now http
2008-10-23  Miguel Sofer  <msofer@users.sf.net>

	2.7.2
	* generic/tclCmdAH.c (ForNextCallback): handle TCL_CONTINUE in the for
	body. [Bug 2186888]

2008-10-22  Jan Nijtmans  <nijtmans@users.sf.net>
2008-10-23  Don Porter	<dgp@users.sourceforge.net>

	* generic/tcl.h:	      CONST -> const and white-spacing
	* generic/tclCompile.h:
	* generic/tclEncoding.c:
	* generic/tclStubInit.c:
	* generic/tclStubLib.c:
	* generic/tcl.decls
	* generic/tclInt.decls
	* generic/tclTomMath.decls
	* generic/tcl.h:	Bump version number to 8.5.6b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.5 and
	* unix/configure.in:	8.5.6 releases.
	* unix/tcl.spec:
	* win/configure.in:
	* tools/tcl.wse.in:
	* README

	* unix/configure:	autoconf (2.59)
	* win/configure:
	* generic/tclDecls.h:	      (regenerated)
	* generic/tclIntDecls.h:      (regenerated)
	* generic/tclIntPlatDecls.h:  (regenerated)
	* generic/tclOODecls.h:	      (regenerated)
	* generic/tclOOIntDecls.h:    (regenerated)
	* generic/tclPlatDecls.h:     (regenerated)
	* generic/tclTomMathDecls.h:  (regenerated)
	* generic/tclIntDecls.h:      (regenerated)
	* tools/genStubs.tcl:	      CONST -> const and white-spacing

2008-10-19  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclProc.c:	Reset -level and -code values to defaults
	after they are used. [Bug 2152286]

2008-10-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c (TclInfoCoroutineCmd): Added code to make this
	check for being invoked in a syntactically correct way.

	* doc/info.n: Added documentation of [info coroutine].

	* doc/prefix.n: Improved the documentation by fixing formatting,
	adding good-practice recommendations and cross-references, etc.

2008-10-17  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclOO.decls:		CONST -> const.
	* generic/tclOODecls.h:		(regenerated)
	* generic/tclOOIntDecls.h:	(regenerated)

2008-10-17  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORTrans.c (DeleteReflectedTransformMap): Removed debug
	output in C++ comment.

2008-10-17  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclCompile.h:	Declare the internal tclInstructionTable to
	* generic/tclExecute.c:	simply be "const", not CONST86.

	* generic/tclCmdAH.c:	whitespace.
	* generic/tclCmdIL.c:	Uninitialized variable warning.
	* generic/tclTest.c:	const correctness warning.

2008-10-17  Donal K. Fellows  <dkf@users.sf.net>

	* doc/*: Many very small formatting fixes.
	* doc/{glob,http,if}.n: More substantial reformatting for clarity.
	* doc/split.n: Remove mention of defunct c.l.t.announce

2008-10-16  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/regc_locale.c: Add "const" to many internal const tables.
	* generic/tclClock.c:	 No functional or API change.
	* generic/tclCmdIL.c
	* generic/tclConfig.c
	* generic/tclDate.c
	* generic/tclEncoding.c
	* generic/tclEvent.c
	* generic/tclExecute.c
	* generic/tclFileName.c
	* generic/tclGetDate.y
	* generic/tclInterp.c
	* generic/tclIO.c
	* generic/tclIOCmd.c
	* generic/tclIORChan.c
	* generic/tclIORTrans.c
	* generic/tclLoad.c
	* generic/tclObj.c
	* generic/tclOOBasic.c
	* generic/tclOOCall.c
	* generic/tclOOInfo.c
	* generic/tclPathObj.c
	* generic/tclPkg.c
	* generic/tclResult.c
	* generic/tclStringObj.c
	* generic/tclTest.c
	* generic/tclTestObj.c
	* generic/tclThreadTest.c
	* generic/tclTimer.c
	* generic/tclTrace.c
	* macosx/tclMacOSXFCmd.c
	* win/cat.c
	* win/tclWinInit.c
	* win/tclWinTest.c

2008-10-16  Don Porter  <dgp@users.sourceforge.net>

	* library/init.tcl:	Revised [unknown] so that it carefully
	preserves the state of the ::errorInfo and ::errorCode variables at
	the start of auto-loading and restores that state before the
	autoloaded command is evaluated. [Bug 2140628]

2008-10-15  Jan Nijtmans  <nijtmans@users.sf.net>

2008-10-10  Don Porter	<dgp@users.sourceforge.net>
	* generic/tclInt.h:	Add "const" to many internal const tables, so
	* generic/tclBinary.c:	those will be put by the C-compiler in the
	* generic/tclCompile.c:	TEXT segment in stead of the DATA segment.
	* generic/tclDictObj.c: This makes those tables sharable in shared
	* generic/tclHash.c:	libraries.
	* generic/tclListObj.c:
	* generic/tclNamesp.c:
	* generic/tclObj.c:
	* generic/tclProc.c:
	* generic/tclRegexp.c:
	* generic/tclStringObj.c:
	* generic/tclUtil.c:
	* generic/tclVar.c:

2008-10-14  Jan Nijtmans  <nijtmans@users.sf.net>

	*** 8.5.5 TAGGED FOR RELEASE ***
	* generic/tclCmdAH.c:	Fix minor compiler warnings when compiling
	* generic/tclCmdMZ.c:	with -Wwrite-strings.
	* generic/tclIndexObj.c:
	* generic/tclProc.c:
	* generic/tclStubLib.c:
	* generic/tclUtil.c:
	* win/tclWinChan.c:
	* win/tclWinDde.c:
	* win/tclWinInit.c:
	* win/tclWinReg.c:
	* win/tclWinSerial.c:

2008-10-14  Donal K. Fellows  <dkf@users.sf.net>

	* doc/binary.n: Formatting fix.

2008-10-14  Don Porter  <dgp@users.sourceforge.net>

	* README:		Bump version number to 8.6a4
	* generic/tcl.h:
	* generic/tcl.h:	Bump to 8.5.5 for release.
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

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

	* generic/tclExecute.c:	Fix compile warnings when --enable-symbols=all

	* generic/tclCmdIL.c:	Fix write to unallocated memory whenever
	[lrepeat] returns an empty list.

2008-10-14  Donal K. Fellows  <dkf@users.sf.net>

	* doc/chan.n, doc/fconfigure.n: Added even more emphatic text to
	direct people to the correct manual pages for specific channel types,
	suitable for the hard-of-reading. Following discussion on tcl-core.

2008-10-13  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* win/tclWinThrd.c (TclpThreadCreate): We need to initialize the
	thread id variable to 0 as on 64 bit windows this is a pointer sized
	field while windows only fills it with a 32 bit value. The result is
	an inability to join the threads as the ids cannot be matched.

	* generic/tclTest.c (TestNRELevels): Set array to the right size.

2008-10-13  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOInfo.c (InfoClassDestrCmd): Handle error case.

	* generic/tclOOInt.h: Added macro magic to make things work with
	Objective C. [Bug 2163447]

2008-10-12  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCompile.c: Fix bug in srcDelta encoding within ByteCodes.
	The bug can only be triggered under conditions that cannot happen in
	Tcl, but were met during development of L. Thanks go to Robert Netzer
	for diagnosis and fix.

2008-10-10  Don Porter  <dgp@users.sourceforge.net>

	*** 8.6a3 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6a3 release.
	* changes:	Update for 8.5.5 release.

2008-10-10  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOODefineCmds.c (TclOODefineUnexportObjCmd)
	(TclOODefineExportObjCmd): Corrected export/unexport record synthesis.
	[Bug 2155658]

2008-10-08  Jan Nijtmans  <nijtmans@users.sf.net>

	* unix/tclUnixChan.c:	Fix minor compiler warning.
	* unix/tcl.m4:		Fix for [Bug 2073255]
	* unix/configure:	Regenerated

2008-10-08  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic (TclInfoCoroutineCmd):
	* tests/unsupported.test: Arrange for [info coroutine] to return {}
	when a coroutine is running but the resume command has been deleted.
	[Bug 2153080]

2008-10-08  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclTrace.c:	Corrected handling of errors returned by
	variable traces so that the errorInfo value contains the original
	error message. [Bug 2151707]

	* generic/tclVar.c:	Revised implementation of TclObjVarErrMsg so
	that error message construction does not disturb an existing
	iPtr->errorInfo that may be in progress.

2008-10-07  Donal K. Fellows  <dkf@users.sf.net>
2008-10-06  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/binary.n: Added better documentation of the [binary encode] and
	[binary decode] subcommands.

	* tclWinTest.c: Fix compiler warning when compiling this file with
2008-10-07  Miguel Sofer  <msofer@users.sf.net>

	mingw gcc:
	TIP #327,#328 IMPLEMENTATIONS

	    tclWinTest.c:706: warning: dereferencing type-punned pointer will
	* generic/tclBasic.c:	   Move [tailcall], [coroutine] and
	* generic/tclCmdIL.c:	   [yield] out of ::tcl::unsupported
	* tclInt.h:
	* tests/info.test:	   and into global scope: TIPs #327
	* tests/unsupported.test:  and #328

	    break strict-aliasing rules
2008-10-07  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclLoad.c: Make sure that any library which doesn't have an
	* doc/chan.n, doc/transchan.n: Documented the channel transformation
	API of TIP #230.

	unloadproc is only really unloaded when no library code is executed
2008-10-06  Pat Thoyts  <patthoyts@users.sourceforge.net>

	yet. [Bug 2059262]
	* tests/winFCmd.test: Fixed some erroneous tests on Vista+.
	* generic/tclFCmd.c: Fix constness for msvc of last commit

2008-10-06  Joe Mistachkin  <joe@mistachkin.com>

	* tools/man2tcl.c: Added missing line from patch by Harald Oehlmann.
	[Bug 1934200]

2008-10-05  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/FileSystem.3:	CONSTified Tcl_FSFileAttrStringsProc
	* generic/tclFCmd.c:	and tclpFileAttrStrings. This allows
	* generic/tclIOUtil.c:	FileSystems to report their attributes
	* generic/tclTest.c:	as const strings, without worrying that
	* unix/tclUnixFCmd.c:	Tcl modifies them (which Tcl should not
	* win/tclWinFCmd.c:	do anyway, but the API didn't indicate that)
	* generic/tcl.decls
	* generic/tclDecls.h:	regenerated
	* generic/tcl.h:	Make sure that if CONST84 is defined as empty,
				CONST86 should be defined as empty as well
				(unless overridden). This change complies with
				TIP #27
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-05  Kevin B, Kenny  <kennykb@acm.org>

	* libtommath/bn_mp_sqrt.c (bn_mp_sqrt): Handle the case where a
	* tests/expr.test (expr-47.13):		number's square root is
	between n<<DIGIT_BIT and n<<DIGIT_BIT+1. [Bug 2143288]
	Thanks to Malcolm Boffey (malcolm.boffey@virgin.net) for the patch.

	TIP #331 IMPLEMENTATION

	* doc/lset.n:
	* generic/tclListObj.c (TclLsetFlat):
	* tests/lset.test: Modified the [lset] command so that it allows for
	an index of 'end+1', which has the effect of appending an element to
	the list.

2008-10-05  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclInt.decls:	 CONSTified the AuxDataType argument
	* generic/tclCompCmds.c: of TclCreateAuxData and
	* generic/tclCompile.c:	 TclRegisterAuxDataType and the return
	* generic/tclCompile.h:	 values of TclGetAuxDataType and
	* generic/tclExecute.c:	 TclGetInstructionTable
	* generic/tclIntDecls.h:		regenerated
	This change complies with TIP #27 (even though it only involves
	internal function, so this is not even necessary).

2008-10-05  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclIndexObj.c (TclInitPrefixCmd): Make the [tcl::prefix]
	into an exported command. [Bug 2144595]

2008-10-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdIL.c (InfoFrameCmd):	Improved hygiene of result
	* generic/tclRegexp.c (TclRegAbout):	handling.

2008-10-04  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/tclLoad.c: Make sure that any library which doesn't have an
	unloadproc is only really unloaded when no library code is executed
	yet. [Bug 2059262]

2008-10-04  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOInfo.c (GetClassFromObj): Factor out the code to parse
	a Tcl_Obj and get a class. Also make result handling hygienic.
	* generic/tclOOBasic.c (TclOOSelfObjCmd): Better hygiene of results,
	and stop allocating quite so much memory by sharing special "method"
	names.

2008-10-04  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/ChnlStack.3:	CONSTified the typePtr argument
	* doc/CrtChannel.3:	of Tcl_CreateChannel and Tcl_StackChannel
	* generic/tcl.decls:	and the return value of Tcl_GetChannelType
	* generic/tcl.h
	* generic/tclIO.h
	* generic/tclIO.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

	* doc/Hash.3:		CONSTified the typePtr argument
	* generic/tcl.decls:	of Tcl_InitCustomHashTable.
	* generic/tcl.h
	* generic/tclHash.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

	* doc/RegConfig.3:	CONSTified the configuration argument
	* generic/tcl.decls:	of Tcl_RegisterConfig.
	* generic/tcl.h
	* generic/tclConfig.c
	* generic/tclPkgConfig.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

	* doc/GetIndex.3:	CONSTified the tablePtr argument
	* generic/tcl.decls:	of Tcl_GetIndexFromObj.
	* generic/tclIndexObj.c
	* generic/tclDecls.h:	regenerated
	This change complies with TIP #27.

2008-10-03  Miguel Sofer  <msofer@users.sf.net>

	* tests/stack.test:
	* unix/tclUnixTest.c: Removed test command teststacklimit and the
	corresponding constraint: it is not needed with NRE

2008-10-03  Donal K. Fellows  <dkf@users.sf.net>

	TIP #195 IMPLEMENTATION

	* generic/tclIndexObj.c (TclGetIndexFromObjList, PrefixMatchObjCmd)
	* doc/prefix.n, tests/string.test: Added [tcl::prefix] command for
	working with prefixes of strings at the Tcl level. [Patch 1040206]

	TIP #265 IMPLEMENTATION

	* generic/tclIndexObj.c (Tcl_ParseArgsObjv, PrintUsage):
	* generic/tcl.h (Tcl_ArgvInfo):	Added function for simple parsing of
	* doc/ParseArgs.3 (new file):	optional arguments to commands. Still
	needs tests and the like. [FRQ 1446696] Note that some of the type
	signatures are changed a bit from the proposed implementation so that
	they better reflect codified good practice for argument order.

2008-10-02  Andreas Kupries  <andreask@activestate.com>

	* tests/info.test (info-23.3): Updated output of the test to handle
	the NRE-enabled eval and the proper propagation of location
	information through it. [Bug 2017632]

	* doc/info.n: Rephrased the documentation of 'info frame' for positive
	numbers as level argument. [Bug 2134049]

	* tests/info.test (info-22.8): Made pattern for file containing
	tcltest less specific to accept both .tcl and .tm variants of the file
	during matching. [Bug 2129828]

2008-10-02  Don Porter  <dgp@users.sourceforge.net>

	TIP #330 IMPLEMENTATION

	* generic/tcl.h:	Remove the "result" and "freeProc" fields
	* generic/tclBasic.c:	from the default public declaration of the
	* generic/tclResult.c:	Tcl_Interp struct. Code should no longer
	* generic/tclStubLib.c:	be accessing these fields. Access can be
	* generic/tclTest.c:	restored by defining USE_INTERP_RESULT, but
	* generic/tclUtil.c:	that should only be a temporary migration aid.
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-02  Joe Mistachkin  <joe@mistachkin.com>

	* doc/info.n: Fix unmatched font change.
	* doc/tclvars.n: Fix unmatched font change.
	* doc/variable.n: Fix unmatched font change.
	* tools/man2help2.tcl: Integrated patch from Harald Oehlmann.
	[Bug 1934272]
	* tools/man2help2.tcl: Integrated patches from Harald Oehlmann.
	* tools/man2tcl.c: [Bug 1934200, 1934272]
	* tools/man2tcl.c: Increase MAX_LINE_SIZE to fix "Too long line" error.
	* win/buildall.vc.bat: Prefer the HtmlHelp target over the WinHelp
	target. [Bug 2072891]
	* win/makefile.vc: Fix the HtmlHelp and WinHelp targets to not be
	mutually exclusive.

2008-09-29  Don Porter  <dgp@users.sourceforge.net>

	TIP #323 IMPLEMENTATION (partial)

	* doc/glob.n:		Revise [glob] to accept zero patterns.
	* generic/tclFileName.c:
	* tests fileName.test:

	* doc/linsert.n:	Revise [linsert] to accept zero elements.
	* generic/tclCmdIL.c:
	* tests/linsert.test:

2008-09-29  Donal K. Fellows  <dkf@users.sf.net>

	TIP #326 IMPLEMENTATION

	* generic/tclCmdIL.c (Tcl_LsortObjCmd): Added -stride option to carry
	* doc/lsort.n, tests/cmdIL.test:	out sorting of lists where the
	elements are grouped. Adapted from [Patch 2082681]

	TIP #313 IMPLEMENTATION

	* generic/tclCmdIL.c (Tcl_LsearchObjCmd): Added -bisect option to
	* doc/lsearch.n, tests/lsearch.test:	  allow the finding of the
	place to insert an element in a sorted list when that element is
	not already there. [Patch 1894241]

	TIP #318 IMPLEMENTATION

	* generic/tclCmdMZ.c (StringTrimCmd,StringTrimLCmd,StringTrimRCmd):
	Update the default set of trimmed characters to include some from the
	larger UNICODE space. Factor out the default trim set into a macro so
	that it is easier to keep them in synch.

2008-09-28  Donal K. Fellows  <dkf@users.sf.net>

	TIP #314 IMPLEMENTATION

	* generic/tclCompCmds.c (TclCompileEnsemble)
	* generic/tclNamesp.c (NamespaceEnsembleCmd)
	(Tcl_SetEnsembleParameterList, Tcl_GetEnsembleParameterList)
	(NsEnsembleImplementationCmdNR):
	* generic/tcl.decls, doc/Ensemble.3, doc/namespace.n
	* tests/namespace.test: Allow the handling of a (fixed) number of
	formal parameters between an ensemble's command and subcommand at
	invokation time. [Patch 1901783]

2008-09-28  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	   Fix the numLevels computations on
	* generic/tclInt.h:	   coroutine yield/resume
	* tests/unsupported.test:

2008-09-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclFileName.c (Tcl_GetBlock*FromStat): Made this work
	acceptably when working with OSes that don't support reporting the
	block size from the stat() call. [Bug 2130726]

	* generic/tclCmdIL.c (Tcl_LrepeatObjCmd): Improve the handling of the
	case where the combination of number of elements and repeat count
	causes the resulting list to be too large. [Bug 2130992]

2008-09-26  Don Porter  <dgp@users.sourceforge.net>
2008-09-25  Don Porter	<dgp@users.sourceforge.net>

	TIP #323 IMPLEMENTATION (partial)

	* doc/lrepeat.n:	Revise [lrepeat] to accept both zero
	* generic/tclCmdIL.c:	repetitions and zero elements to be repeated.
	* tests/lrepeat.test:

	* doc/object.n:		Revise standard oo method [my variable] to
	* generic/tclOOBasic.c:	accept zero variable names.
	* tests/oo.test:

	* doc/tm.n:		Revise [tcl::tm::path add] and
	* library/tm.tcl:	[tcl::tm::path remove] to accept zero paths.
	* tests/tm.test:

	* doc/namespace.n:	Revise [namespace upvar] to accept zero
	* generic/tclNamesp.c:	variable names.
	* tests/upvar.test:

	* doc/lassign.n:	Revise [lassign] to accept zero variable names.
	* generic/tclCmdIL.c:
	* tests/cmdIL.test:

2008-09-26  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.h (TCLOO_VERSION): Bump the version.

2008-09-25  Don Porter  <dgp@users.sourceforge.net>

	TIP #323 IMPLEMENTATION (partial)

	* doc/global.n:		Revise [global] to accept zero variable names.
	* doc/variable.n:	Revise [variable] likewise.
	* generic/tclVar.c:
	* tests/proc-old.test:
	* tests/var.test:

	* doc/global.n: Correct false claim about [info locals].
	* doc/global.n:	Correct false claim about [info locals].

2008-09-25  Donal K. Fellows  <dkf@users.sf.net>

	TIP #315 IMPLEMENTATION

	* tests/platform.test:	Update tests to expect revised results
	* tests/safe.test:	corresponding to the TIP 315 change.

	* unix/tclUnixInit.c, win/tclWinInit.c (TclpSetVariables):
	* doc/tclvars.n (tcl_platform): Define what character is used for
	separating PATH-like lists. Forms part of the tcl_platform array.

	* generic/tclOOCall.c (InitCallChain, IsStillValid):
	* tests/oo.test (oo-25.2): Revise call chain cache management so that
	it takes into account class-wide caching correctly. [Bug 2120903]

2008-09-24  Don Porter  <dgp@users.sourceforge.net>

	TIP #323 IMPLEMENTATION (partial)

	* doc/file.n:		Revise [file delete] and [file mkdir] to
	* generic/tclCmdAH.c:	accept zero "pathname" arguments (the
	* generic/tclFCmd.c:	no-op case).
	* tests/cmdAH.test:
	* tests/fCmd.test:

2008-09-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOMethod.c (DBPRINT): Remove obsolete debugging macro.
	[Bug 2124814]

	TIP #316 IMPLEMENTATION

	* generic/tcl.decls, generic/tclFileName.c (Tcl_GetSizeFromStat, etc):
	* doc/FileSystem.3: Added reader functions for Tcl_StatBuf.

2008-09-23  Donal K. Fellows  <dkf@users.sf.net>

	* doc/Method.3: Corrected documentation. [Patch 2082450]

	* doc/lreverse.n, mathop.n, regexp.n, regsub.n: Make sure that the
	initial line of the manpage includes nothing that chokes old versions
	of man. [Bug 2118123]

2008-09-22  Donal K. Fellows  <dkf@users.sf.net>

	TIP #320 IMPLEMENTATION

	* generic/tclOODefineCmds.c (TclOODefineVariablesObjCmd):
	* generic/tclOOInfo.c (InfoObjectVariablesCmd, InfoClassVariablesCmd):
	* generic/tclOOMethod.c (TclOOSetupVariableResolver, etc):
	* doc/define.n, doc/ooInfo.n, benchmarks/cps.tcl:
	* tests/oo.test (oo-26.*): Allow the declaration of the common
	variables used in methods of a class or object. These are then mapped
	in using a variable resolver. This makes many class declarations much
	simpler overall, encourages good usage of variable names, and also
	boosts speed a bit.

	* generic/tclOOMethod.c (TclOOGetMethodBody): Factor out the code to
	get the body of a procedure-like method. Reduces the amount of "poking
	inside the abstraction" that is done by the introspection code.

2008-09-22  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* doc/chan.n: Clean up paragraph order.

2008-09-18  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c (NEXT_INST_F):
	* generic/tclInt.h (TCL_CT_ASSERT): New compile-time assertions,
	adapted from www.pixelbeat.org/programming/gcc/static_assert.html

2008-09-17  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclInt.h: Correct the TclGetLongFromObj, TclGetIntFromObj,
	and TclGetIntForIndexM macros so that they retrieve the longValue
	field from the internalRep instead of casting the otherValuePtr field
	to type long.

2008-09-17  Miguel Sofer  <msofer@users.sf.net>

	* library/init.tcl: Export min and max commands from the mathfunc
	namespace. [Bug 2116053]

2008-09-16  Joe Mistachkin  <joe@mistachkin.com>

	* generic/tclParse.c: Move TclResetCancellation to be called on
	returning to level 0, as opposed to it being called on starting a
	substitution at level 0.

2008-09-16  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c: Move TclResetCancellation to be called on
	returning to level 0, as opposed to it being called on starting a
	command at level 0. Add a call on returning via Tcl_EvalObjEx to fix
	[Bug 2114165].

2008-09-10  Donal K. Fellows  <dkf@users.sf.net>

	* doc/binary.n: Added partial documentation of [binary encode] and
	[binary decode].

	* tests/binary.test,cmdAH.test,cmdIL.test,cmdMZ.test,fileSystem.test:
	More use of tcltest2 to simplify the tests as exposed to people.
	* tests/compile.test (compile-18.*): Added *some* tests of the
	disassmbler, though not of its output format.

2008-09-10  Miguel Sofer  <msofer@users.sf.net>

	* tests/nre.test: Add missing constraints; enable test of foreach
	recursion.

	* generic/tclBasic.c:
	* generic/tclCompile.h:
	* generic/tclExecute.c (INST_EVAL_STK): Wrong numLevels when evaling a
	canonical list. [Bug 2102930]

2008-09-10  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclListObj.c (Tcl_ListObjGetElements): Make this list->dict
	transformation - encountered when using [foreach] with dicts - not as
	expensive as it was before. Spotted by Kieran Elby and reported on
	tcl-core.

2008-09-08  Donal K. Fellows  <dkf@users.sf.net>

	* tests/append.test, appendComp.test, cmdAH.test: Use the powers of
	tcltest2 to make these files simpler.

2008-09-07  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCompile.c (TclCompileTokens):
	* generic/tclExecute.c (CompileExprObj): Fix a perf bug (found by Alex
	Ferrieux) where some variables in the LVT where not being accessed by
	index. Fix missing localCache management in compiled expressions found
	while analyzing the bug.

2008-09-07  Miguel Sofer  <msofer@users.sf.net>

	* doc/namespace.n: Fix [Bug 2098441]

2008-09-04  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclTrace.test (TraceVarProc):
	* generic/unsupported.test: Insure that unset traces are run even when
	the coroutine is unwinding. [Bug 2093947]

	* generic/tclExecute.c (CACHE_STACK_INFO):
	* tests/unsupported.test: Restore execEnv's bottomPtr. [Bug 2093188]

2008-09-02  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:	Stripped "callers" of the _ANSI_ARGS_ macro
	* compat/dirent2.h:	to support a TCL_NO_DEPRECATED build.
	* compat/dlfcn.h:
	* unix/tclUnixPort.h:

	* generic/tcl.h:	Removed the conditional #define of
	_ANSI_ARGS_ that would support pre-prototype C compilers. Since
	_ANSI_ARGS_ is no longer used in tclDecls.h, it's clear no one
	compiling against Tcl 8.5 headers is making use of a -DNO_PROTOTYPES
	configuration.

2008-09-02  Donal K. Fellows  <dkf@users.sf.net>

	* tests/socket.test: Rewrote so as to use tcltest2 better.

2008-09-01  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCmdAH.c:	   NRE-enabling [eval]; eval scripts are now
	* generic/tclOOBasic.c:	   bytecompiled. Adapted recursion limit tests
	* tests/interp.test:	   that were relying on eval not being
	* tests/nre.test:	   compiled. Part of the [Bug 2017632] project.
	* tests/unsupported.test:

2008-09-01  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOMethod.c (InvokeProcedureMethod):
	* generic/tclOO.c (ObjectRenamedTrace): Arrange for only methods that
	involve callbacks into the Tcl interpreter to be skipped when the
	interpreter is being torn down. Allows the semantics of destructors in
	a dying interpreter to be more useful when they're implemented in C.

2008-08-29  Donal K. Fellows  <dkf@users.sf.net>

	* unix/Makefile.in: Ensure that all TclOO headers get installed.
	* win/Makefile.in:  [Bug 2082299]
	* win/makefile.bc:
	* win/makefile.vc:

2008-08-28  Don Porter  <dgp@users.sourceforge.net>

	* README:		Bump version number to 8.6a3
	* generic/tcl.h:
	* library/init.tcl:
	* generic/tcl.h:	Bump version number to 8.5.5b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.4 and
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/configure.in:	8.5.5 releases.
	* unix/tcl.spec:
	* win/configure.in:
	* tools/tcl.wse.in:
	* README

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

2008-08-27  Donal K. Fellows  <dkf@users.sf.net>

	* doc/tclvars.n, doc/library.n: Ensured that these two manual pages
	properly cross-reference each other. Issue reported on Tcler's Chat.

2008-08-26  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c (InfoCoroutine):
	* tests/unsupported.test: New command that returns the FQN of the
	currently executing coroutine. Lives as infoCoroutine under
	unsupported, but is designed to become a subcommand of [info]

2008-08-23  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c (NRInterpCoroutine): Store the caller's eePtr,
	stop assuming the coroutine is invoked from the same execEnv where it
	was created.

2008-08-24  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclCmdAH.c (TclNRForeachCmd): Converted the [foreach]
	command to have an NRE-aware non-compiled implementation. Part of the
	[Bug 2017632] project. Also restructured the code so as to manage its
	temporary memory more efficiently.

2008-08-23  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	  Removed unused var; fixed function pointer
	* generic/tclOOInt.h:	  declarations (why did gcc start complaining
	* generic/tclOOMethod.c:  all of a sudden?)
	* generic/tclProc.c:

2008-08-23  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclInt.h (EnsembleImplMap): Added extra field to make it
	* generic/tclNamesp.c (TclMakeEnsemble): easier to build non-recursive
	ensembles in the core.

	* generic/tclDictObj.c (DictForNRCmd): Converted the [dict for]
	command to have an NRE-aware non-compiled implementation. Part of the
	[Bug 2017632] project.

2008-08-22  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:
	* generic/tclExecute.c: Set special errocodes: COROUTINE_BUSY,
	COROUTINE_CANT_YIELD, COROUTINE_ILLEGAL_YIELD.

2008-08-22  Don Porter  <dgp@users.sourceforge.net>

	*** 8.6a2 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6a2 release.

	* generic/tcl.h:	Drop use of USE_COMPAT85_CONST. That added
	indirection without value. Use -DCONST86="" to engage source compat
	support for code written for 8.5 headers.

	* generic/tclUtil.c (TclReToGlob):	Added missing set of the
	*exactPtr value to really fix [Bug 2065115]. Also avoid possible
	DString overflow.
	* tests/regexpComp.test:	Correct duplicate test names.

2008-08-21  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	  Previous fix, now done right.
	* generic/tclCmdIL.c:
	* generic/tclInt.h:
	* tests/unsupported.test:

2008-08-21  Jeff Hobbs  <jeffh@ActiveState.com>

	* tests/regexp.test, tests/regexpComp.test: Correct re2glob ***=
	* generic/tclUtil.c (TclReToGlob):	    translation from exact
	to anywhere-in-string match. [Bug 2065115]

2008-08-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tcl.h:	Reduced the use of CONST86 and eliminated
	* generic/tcl.decls:	the use of CONST86_RETURN to support source
	code compatibility with Tcl 8.5 on those public routines passing
	(Tcl_Filesystem *), (Tcl_Timer *), and (Tcl_Objtype *) values which
	have been const-ified. What remains is the minimum configurability
	needed to support code written for pre-8.6 headers via the new
	-DUSE_COMPAT85_CONST compiler directive.
	*** POTENTIAL INCOMPATIBILITY ***

	* generic/tclDecls.h:	make genstubs

2008-08-21  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	Fix the cmdFrame level count in
	* generic/tclCmdIL.c:	coroutines. Fix small bug on coroutine
	* generic/tclInt.h:	rewind.

2008-08-21  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclProc.c (Tcl_DisassembleObjCmd): Added ability to
	disassemble TclOO methods. The code to do this is very ugly.

2008-08-21  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclOOMethod.c: Added casts to make MSVC happy
	* generic/tclBasic.c:

2008-08-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (AllocObject): Suppress compilation of commands in
	the namespace allocated for each object.
	* generic/tclOOMethod.c (PushMethodCallFrame): Restore some of the
	hackery that makes calling methods of classes fast. Fixes performance
	problem introduced by the fix of [Bug 2037727].

	* generic/tclCompile.c (TclCompileScript):    Allow the suppression of
	* generic/tclInt.h (NS_SUPPRESS_COMPILATION): compilation of commands
	* generic/tclNamesp.c (Tcl_CreateNamespace):  from a namespace or its
	children.

2008-08-20  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclTest.c (TestconcatobjCmd):	Fix use of internal-only
	TclInvalidateStringRep macro. [Bug 2057479]

2008-08-17  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	   Implementation of [coroutine] and [yield]
	* generic/tclCmdAH.c:	   commands (in tcl::unsupported).
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclInt.h:
	* tests/unsupported.test:

	* generic/tclTest.c (TestconcatobjCmd):
	* generic/tclUtil.c (Tcl_ConcatObj):
	* tests/util.test (util-4.7):
	Fix [Bug 1447328]; the original "fix" turned Tcl_ConcatObj() into a
	hairy monster. This was exposed by [Bug 2055782]. Additionally,
	Tcl_ConcatObj could corrupt its input under certain conditions!

	*** NASTY BUG FIXED ***

2008-08-16  Miguel Sofer  <msofer@users.sf.net>
2008-08-14  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclExecute.c: Better cmdFrame management

	*** 8.5.4 TAGGED FOR RELEASE ***
2008-08-14  Don Porter  <dgp@users.sourceforge.net>

	* tests/fileName.test:	Revise new tests for portability to case
	insensitive filesystems.

2008-08-14  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclBasic.c (TclNREvalObjv, Tcl_NRCallObjProc):
	* generic/tclProc.c (TclNRInterpProcCore, InterpProcNR2):
	DTrace probes for NRE. [Bug 2017160]

	* generic/tclBasic.c (TclDTraceInfo):	Add two extra arguments to
	* generic/tclCompile.h:			DTrace 'info' probes for tclOO
	* generic/tclDTrace.d:			method & class/object info.

	* generic/tclCompile.h:	Add support for debug logging of DTrace
	* generic/tclBasic.c:	'proc', 'cmd' and 'inst' probes (does _not_
				require a platform with DTrace).
	* generic/tclCompile.h:		Add support for debug logging of DTrace
	* generic/tclBasic.c:		'proc', 'cmd' and 'inst' probes (does
					_not_ require a platform with DTrace).

	* generic/tclCmdIL.c (TclInfoFrame):	Check fPtr->line before
						dereferencing as line info may
						not exists when TclInfoFrame()
						is called from a DTrace probe.

	* tests/msgcat.test:		Fix for ::tcl::mac::locale with
					@modifier (HEAD backport 2008-06-01).

	* tests/fCmd.test (fCmd-6.23):	Made result matching robust when test
					workdir and /tmp are not on same FS.

	* unix/tclUnixThrd.c:		Remove unused TclpThreadGetStackSize()
	* generic/tclInt.h:		and related ifdefs and autoconf tests.
	* unix/tclUnixPort.h:		[Bug 2017264] (jenglish)
	* unix/tcl.m4:

	* unix/Makefile.in:		Ensure Makefile shell is /bin/bash for
	* unix/configure.in (SunOS):	DTrace-enabled build on Solaris.
					(followup to 2008-06-12) [Bug 2016584]

	* unix/tcl.m4 (SC_PATH_X):	Check for libX11.dylib in addition to
					libX11.so et al.

	* unix/configure:		autoconf-2.59
	* unix/configure: 		autoconf-2.59
	* unix/tclConfig.h.in:		autoheader-2.59

2008-08-13  Miguel Sofer  <msofer@users.sf.net>

	* tests/nre.test: Added test for large {*}-expansion effects

2008-08-13  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclFileName.c:	Fix for errors handling -types {}
	* tests/fileName.test:		option to [glob]. [Bug 1750300]
	Thanks to Matthias Kraft and George Peter Staplin.

2008-08-12  Jeff Hobbs  <jeffh@ActiveState.com>

	* generic/tclOOInfo.c (InfoObjectDefnCmd, InfoObjectMixinsCmd):
	Fix # args displayed. [Bug 2048676]

2008-08-08  Don Porter  <dgp@users.sourceforge.net>
2008-08-12  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclOOMethod.c (PushMethodCallFrame):	Added missing check
	for bytecode validity. [Bug 2037727]

	* generic/tclProc.c (TclProcCompileProc):	On recompile of a
	proc, clear away any entries on the CompiledLocal list from the
	previous compile. This will prevent compile of temporary variables in
	the proc body from growing the localCache arbitrarily large.

	* README:		Bump version number to 8.6a2
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

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

	* changes:	Updates for 8.6a2 release.
	* changes:	Update for 8.5.4 release.

2008-08-11  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/http/http.tcl: Remove 8.5 requirement.
	* library/http/pkgIndex.tcl:
	* unix/Makefile.in:
	* win/Makefile.in:
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
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
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
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
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
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
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
611

612
613
614
615
616
617
618


619

620


621












622
623

624











625
626
627
628
629
630
631







-
+

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

-
-
-
+
-
-
+
-

-
+

















-
-
-
-
-
-


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








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

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

-
-
-
-


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









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+

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

-
+
+
+

-
-
+
-
-
+
+
+















-
+

-
+
-

-
-
-
-
+
+
-
-
-









-
+

-
+
-
-

-
+


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

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



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










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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










-
+

+
+
-
+















-
+

-
+
-
-
-

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

-
-
-
+
-
+

-
-
-
-
+
+
-

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















-
-
-
+
-
-










-
-
+
+







-
-
-
-








-
+

-
+






-
-
+
-

-
-

-
-
-
-
-
-
-
-
-
-
-
-


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







	* win/makefile.vc:		[binary scan] command.

2008-08-11  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* library/http/http.tcl: CRC field from zlib data should be treated as
	unsigned for 64bit support. [Bug 2046846]

2008-08-10  Miguel Sofer  <msofer@users.sf.net>
2008-08-08  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclProc.c: Completely removed ProcCompileProc, which was a
	* generic/tcl.h:	Bump to 8.5.4 for release.
	fix for [Bug 1482718]. This is not needed at least since varReform,
	where the local variable data at runtime is read from the CallFrame
	and/or the LocalCache.

	* library/init.tcl:
2008-08-09  Miguel Sofer  <msofer@users.sf.net>

	* tools/tcl.wse.in:
	* generic/tclBasic.c:	Slight cleanup
	* generic/tclCompile.h:
	* unix/configure.in:
	* generic/tclExecute.c:

	* unix/tcl.spec:
2008-08-09  Daniel Steffen  <das@users.sourceforge.net>

	* win/configure.in:
	* generic/tclExecute.c:	Fix warnings.

	* generic/tclOOMethod.c (PushMethodCallFrame):	Fix uninitialized efi
							name field.

	* unix/configure:	autoconf-2.59
	* tests/lrange.test (lrange-1.17):	Add test cleanup; whitespace.

	* win/configure:
2008-08-08  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6a2 release.
	* changes:	Update for 8.5.4 release.

2008-08-08  Kevin Kenny  <kennykb@acm.org>

	* library/tzdata/CET:
	* library/tzdata/MET:
	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Eirunepe:
	* library/tzdata/America/Rio_Branco:
	* library/tzdata/America/Santarem:
	* library/tzdata/America/Argentina/San_Luis:
	* library/tzdata/Asia/Karachi:
	* library/tzdata/Europe/Belgrade:
	* library/tzdata/Europe/Berlin:
	* library/tzdata/Europe/Budapest:
	* library/tzdata/Europe/Sofia:
	* library/tzdata/Indian/Mauritius:  Olson's tzdata2008e.

2008-08-07  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	Fix tailcalls falling out of tebc into
	* generic/tclExecute.c: Tcl_EvalEx. [Bug 2017946]
	* generic/tclInt.h:

2008-08-06  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclOO.c:	Revised TclOO's check for an interp being
	deleted during handling of object command deletion. The old code was
	relying on documented features of command delete traces that do not in
	fact work. [Bug 2039178]

	* tests/oo.test (oo-26.*):	Added tests that demonstrate failure
	of TclOO to check for various kinds of invalid bytecode during method
	dispatch. [Bug 2037727]

2008-08-06  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclVar.c (TclLookupSimpleVar): Fix bug that the core could
	* generic/tclVar.c (TclLookupSimpleVar):  Retrieve the number of
	not trigger before TclOO: the number of locals was being read from the
	Proc, which can under some circumstance be out of sync with the
	localCache's. Found by dgp while investigating [Bug 2037727].

	locals in the localCache from the CallFrame and not from the Proc
	* library/init.tcl (::unknown): Removed the [namespace inscope]
	hack that was maintained for Itcl

	which may have been mangled by a (broken?) recompile. Backport from
	*** POTENTIAL INCOMPATIBILITY *** for Itcl
	Itcl users will need a new release with Itcl's [Patch 2040295], or
	else load the tiny script in that patch by themselves (rewrite
	::unknown). Note that it is a script-only patch.

	the HEAD.
2008-08-05  Joe English  <jenglish@users.sourceforge.net>

	* unix/tclUnixChan.c: Streamline async connect logic [Patch 1994512]

2008-08-05  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c: Fix for [Bug 2038069] by dgp.
	* tests/execute.test:

2008-08-04  Miguel Sofer  <msofer@users.sf.net>

	* tests/nre.test: Added tests for [if], [while] and [for]. A test
	for [foreach] has been added and marked as knownbug, awaiting for it
	to be NR-enabled.

	* generic/tclBasic.c:	   Made atProcExit commands run
	* generic/tclCompile.h:	   unconditionally, streamlined
	* generic/tclExecute.c:	   atProcExit/tailcall processing in TEBC.
	* generic/tclProc.c:
	* tests/unsupported.test:

2008-08-04  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclExecute.c: Stopped faulty double-logging of errors to
	* tests/execute.test:	stack trace when a compile epoch bump triggers
	fallback to direct evaluation of commands in a compiled script.
	[Bug 2037338]

2008-08-03  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	   New unsupported command atProcExit that
	* generic/tclCompile.h:	   shares the implementation with tailcall.
	* generic/tclExecute.c:	   Fixed a segfault in tailcalls. Tests added.
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclNamesp.c:
	* tests/unsupported.test:

2008-08-02  Miguel Sofer  <msofer@users.sf.net>

	* tests/NRE.test (removed):	Migrated tests to standard locations,
	* tests/nre.test (new):		separating core functionality from the
	* tests/unsupported.test (new):	experimental commands.

2008-08-01  Jeff Hobbs  <jeffh@ActiveState.com>

	* doc/Exit.3:			Do not call Tcl_Finalize implicitly
	* generic/tclEvent.c:		on DLL_PROCESS_DETACH as it may lead
	* win/tclWin32Dll.c (DllMain):	to issues and the user should be
	explicitly calling Tcl_Finalize before unloading regardless. Clarify
	the docs to note the explicit need in embedded use.

2008-08-01  Don Porter  <dgp@users.sourceforge.net>
2008-07-30  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c:	Revised timing of the CmdFrame stack
	* tests/info.test:	management in TclEvalEx so that the CmdFrame
	will still be on the stack at the time Tcl_LogCommandInfo is called to
	append another level of -errorinfo information. Sets the stage to add
	file and line data to the stack trace. Added test to check that [info
	frame] functioning remains unchanged by the revision.

2008-07-31  Miguel Sofer  <msofer@users.sf.net>

	* tests/NRE.test:  Replaced all deep-recursing tests by shallower
	tests that actually measure the C-stack depth. This makes them
	bearable again (even under memdebug) and avoid crashing on failure.

	* generic/tclBasic.c:	NR-enabling [catch], [if] and [for] and
	* generic/tclCmdAH.c:	[while] (the script, not the tests)
	* generic/tclCmdIL.c:
	* generic/tclCmdMZ.c:
	* generic/tclInt.h:
	* tests/NRE.test:

	* generic/tclBasic.c:	Moved the few remaining defs from tclNRE.h to
	* generic/tclDictObj.c: tclInt.h, eliminated inclusion of tclNRE.h
	* generic/tclExecute.c: everywhere.
	* generic/tclInt.h:
	* generic/tclInterp.c:
	* generic/tclNRE.h (removed):
	* generic/tclNamesp.c:
	* generic/tclOOBasic.c:
	* generic/tclOOInt.h:
	* generic/tclProc.c:
	* generic/tclTest.c:
	* unix/Makefile.in:

2008-07-30  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	 Improved tailcalls.
	* generic/tclBasic.c:	Corrected the timing of when the flag
	* generic/tclCompile.h:
	* generic/tclExecute.c:
	* generic/tclTest.c:
	* tests/NRE.test:

	TCL_ALLOW_EXCEPTIONS is tested.
	* generic/tclBasic.c (TclNREvalObjEx): New comments and code reorg
	to clarify what is happening.

	* generic/tclBasic.c: Guard against the value of iPtr->evalFlags
	changing between the times where TEOV and TEOV_exception run. Thanks
	dgp for catching this.

2008-07-29  Miguel Sofer  <msofer@users.sf.net>

	* tests/NRE.test: New tests that went MIA in the NRE revamping

	* generic/tclBasic.c:	Clean up
	* generic/tclNRE.h:
	* generic/tclExecute.c:
	* generic/tclExecute.c:  fix [Bug 2030670] that cause

	* generic/tclBasic.c:	Made use of the thread's alloc cache stored in
	* generic/tclInt.h:	the ekeko at interp creation to avoid hitting
	* generic/tclNRE.h:	the TSD each time an NRE callback is pushed or
	* generic/tclThreadAlloc.c: pulled; the approach is suitably general
	to extend to every other obj allocation where an interp is know; this
	is left for some other time, requires a lot of grunt work.

	* generic/tclExecute.c:	 Fix [Bug 2030670] that cause TclStackRealloc
	to panic on rare corner cases. Thx ajpasadyn for diagnose and patch.

	TclStackRealloc to panic on rare corner cases. Thx ajpasadyn for
	diagnose and patch.
	* generic/tcl.decls:	 Completely revamped NRE implementation, with
	* generic/tclBasic.c:	 (almost) unchanged API.
	* generic/tclCompile.h:
	* generic/tclExecute.c:	 TEBC will require a bit of a facelift, but
	* generic/tclInt.decls:	 TEOV at least looks great now. There are new
	* generic/tclInt.h:	 tests (incomplete!) to verify that execution
	* generic/tclInterp.c:	 is indeed in the same TEBC instance, at the
	* generic/tclNRE.h:	 same level in all stacks involved. Tailcalls
	* generic/tclNamesp.c:	 are still a bit leaky, still deserving to be
	* generic/tclOOBasic.c:	 in tcl::unsupported.
	* generic/tclOOMethod.c:
	* generic/tclProc.c:	 Uninit'd var warnings in TEBC with -O2, no
	* generic/tclTest.c:	 warnings otherwise.

2008-07-28  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/FileSystem.3:		CONSTified many functions using
	* generic/tcl.decls:		Tcl_FileSystem which all are supposed
	* generic/tclDecls.h:		to be a constant, but this was not
	* generic/tclFileSystem.h:	reflected in the API: Tcl_FSData,
	* generic/tclIOUtil.c:		Tcl_FSGetInternalRep, Tcl_FSRegister,
	* generic/tclPathObj.c:		Tcl_FSNewNativePath, Tcl_FSUnregister,
	* generic/tclTest.c:		Tcl_FSGetFileSystemForPath ...
	This change complies with TIP #27.
	***POTENTIAL INCOMPATIBILITY***

2008-07-28  Andreas Kupries  <andreask@activestate.com>

	* generic/tclBasic.c: Added missing ref count when creating an empty
	string as path (TclEvalEx). In 8.4 the missing code caused panics in
	the testsuite. It doesn't in 8.5. I am guessing that the code path
	with the missing the incr-refcount is not invoked any longer. Because
	the bug in itself is certainly the same.

2008-07-27  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOMethod.c (PushMethodCallFrame): Remove hack that should
	have gone when this code was merged into Tcl.

2008-07-27  Jan Nijtmans  <nijtmans@users.sf.net>

	* doc/Object.3:		CONSTified 3 functions using Tcl_ObjType
	* doc/ObjectType.3:	which all are supposed to be a constant, but
	* generic/tcl.decls:	this was not reflected in the API:
	* generic/tcl.h:	Tcl_RegisterObjType, Tcl_ConvertToType,
	* generic/tclDecls.h:	Tcl_GetObjType
	* generic/tclObj.c:	Introduced a CONST86_RETURN, so extensions
	* generic/tclCompCmds.c: which use Tcl_ObjType directly can be
	* generic/tclOOMethod.c: modified to compile against both Tcl 8.5 and
	* generic/tclTestobj.c:	Tcl 8.6. tclDecls.h regenerated
	This change complies with TIP #27.
	***POTENTIAL INCOMPATIBILITY***

2008-07-25  Andreas Kupries  <andreask@activestate.com>

	* test/info.test: More work on singleTestInterp usability. [1605269]

	* tests/info.test: Tests 38.* added, exactly testing the tracking of
	location for uplevel scripts. Resolved merge conflict on info-37.0,
	switched !singleTestInterp constraint to glob matching instead. Ditto
	info-22.8, removed constraint, more glob matching, and reduced the
	depth of the stack we check. More is coming, right now I want to
	commit the bug fixes.

	* tests/oo.test: Updated oo-22.1 for expanded location tracking.

	* generic/tclCompile.c (TclInitCompileEnv): Reorganized the
	initialization of the #280 location information to match the flow in
	TclEvalObjEx to get more absolute contexts.

	* generic/tclBasic.c (TclEvalObjEx): Added missing cleanup of extended
	location information.

2008-07-25  Daniel Steffen  <das@users.sourceforge.net>

	* tests/info.test (info-37.0): Add !singleTestInterp constraint;
	(info-22.8, info-23.0): switch to glob matching to avoid sensitivity
	to tcltest.tcl line number changes, remove knownBug constraint, fix
	expected result. [Bug 1605269]

2008-07-24  Jan Nijtmans  <nijtmans@users.sf.net>
2008-07-25  Andreas Kupries  <andreask@activestate.com>

	* doc/Notifier.3:      CONSTified 4 functions in the Notifier which
	* doc/Thread.3:	       all have a Tcl_Time* in it which is supposed
	* tests/info.test: Tests 38.* added, exactly testing the tracking of
	location for uplevel scripts.
	* generic/tcl.decls:   to be a constant, but this was not reflected
	* generic/tcl.h:       reflected in the API:
	* generic/tclDecls.h:	    Tcl_SetTimer, Tcl_WaitForEvent,
	* generic/tclNotify.c:	    Tcl_ConditionWait, Tcl_SetMaxBlockTime
	* macosx/tclMacOSXNotify.c:
	* generic/tclThread.c: Introduced a CONST86, so extensions which have
	* unix/tclUnixNotfy.c: have their own Notifier (are there any?) can
	* unix/tclUnixThrd.c:  can be modified to compile against both Tcl
	* win/tclWinNotify.c:  Tcl 8.5 and Tcl 8.6
	* win/tclWinThrd.c:    Regenerated tclDecls.h with "make stubs".
	This change complies with TIP #27
	***POTENTIAL INCOMPATIBILITY***

2008-07-23  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>
	* generic/tclCompile.c (TclInitCompileEnv): Reorganized the
	initialization of the #280 location information to match the flow in
	TclEvalObjEx to get more absolute contexts.

	* tests/lrange.test: Added relative speed test to check for lrange
	in-place optimization committed 2008-06-30.
	* generic/tclBasic.c (TclEvalObjEx): Moved the pure-list optimization
	* tests/binary.test: Added relative speed test to check for pure byte
	array CONCAT1 optimization committed 2008-06-30.
	out of the eval-direct code path to be done always, i.e. even when a
	compile is requested. This way we do not loose the association between
	#280 location information and the list elements, if any.

2008-07-23  Andreas Kupries  <andreask@activestate.com>

	* tests/info.test: Reordered the tests to have monotonously increasing
	numbers.

	* generic/tclBasic.c: Modified TclArgumentGet to reject pure lists
	* generic/tclCmdIL.c: immediately, without search. Reworked setup of
	* generic/tclCompile.c: eoFramePtr, doesn't need the line information,
	* tests/info.test: more sensible to have everything on line 1 when
	eval'ing a pure list. Updated the users of the line information to
	special case this based on the frame type (i.e.
	TCL_LOCATION_EVAL_LIST). Added a testcase demonstrating the new
	behaviour.

2008-07-23  Miguel Sofer  <msofer@users.sf.net>
2008-07-22  Andreas Kupries  <andreask@activestate.com>

	* generic/tclBasic.c (GetCommandSource): Added comment with
	* generic/tclBasic.c: Added missing function comments.
	explanation and warning for waintainers.

2008-07-22  Andreas Kupries  <andreask@activestate.com>

	* generic/tclCompile.c: Made the new TclEnterCmdWordIndex static, and
	* generic/tclCompile.h: ansified.
	* generic/tclCompile.c: Made the new TclEnterCmdWordIndex
	* generic/tclCompile.h: static, and ansified.

	* generic/tclBasic.c: Ansified the new functions. Added missing
	function comments.

	* generic/tclBasic.c: Reworked the handling of bytecode literals for
	* generic/tclCompile.c: #280 to fix the abysmal performance for deep
	* generic/tclCompile.h: recursion, replaced the linear search through
	* generic/tclExecute.c: the whole stack with another hashtable and
	* generic/tclInt.h: simplified the data structure used by the compiler
	by using an array instead of a hashtable. Incidentially this also
	fixes the memory leak reported via [Bug 2024937].

2008-07-22  Miguel Sofer  <msofer@users.sf.net>
2008-07-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclBasic.c:	 Added numLevels field to CommandFrame, let
	* tests/encoding.test:  Make failing tests pass again. [Bug 1972867]
	* generic/tclExecute.c:	 GetCommandSource use it. This solves [Bug
	* generic/tclInt.h:	 2017146]. Thx dgp for the analysis.

2008-07-21  Andreas Kupries  <andreask@activestate.com>
2008-07-21  Andreas Kupries <andreask@activestate.com>

	* generic/tclBasic.c: Extended the existing TIP #280 system (info
	* generic/tclCmdAH.c: frame), added the ability to track the absolute
	* generic/tclCompCmds.c: location of literal procedure arguments, and
	* generic/tclCompile.c: making this information available to uplevel
	* generic/tclCompile.h: eval, and siblings. This allows proper
	* generic/tclInterp.c: tracking of absolute location through custom
	* generic/tclInt.h: (Tcl-coded) control structures based on uplevel,
	* generic/tclNamesp.c: etc.
	* generic/tclCmdAH.c: frame), added the ability to track the
	* generic/tclCompCmds.c: absolute location of literal procedure
	* generic/tclCompile.c: arguments, and making this information
	* generic/tclCompile.h: available to uplevel, eval, and
	* generic/tclInterp.c: siblings. This allows proper tracking of
	* generic/tclInt.h: absolute location through custom (Tcl-coded)
	* generic/tclNamesp.c: control structures based on uplevel, etc.
	* generic/tclProc.c:
	* tests/info.test:

2008-07-21  Jan Nijtmans  <nijtmans@users.sf.net>

	* generic/*.c: Fix [2021443] inconsistant "wrong # args" messages
	* win/tclWinReg.c
	* win/tclWinTest.c
	* tests/*.test

2008-07-21  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	TIP #304 IMPLEMENTATION

	* generic/tcl.decls:	Public API
	* generic/tclIOCmds.c:	Generic part
	* unix/tclUnixPipe.c:	OS part
	* win/tclWinPipe.c:	OS part
	* tests/chan.test:	[chan pipe] tests
	* tests/ioCmd.test:	Modernized checks
	* tests/ioTrans.test:

2008-07-21  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclFCmd.c:  Inodes on windows are unreliable. [Bug 2015723]
	* generic/tclFCmd.c: Inodes on windows are unreliable [Bug 2015723]
	* tests/winFCmd.test: test rename with inode collision

2008-07-21  Miguel Sofer  <msofer@users.sf.net>

	* generic/tcl.decls:	  Changed the implementation of
	* generic/tclBasic.c:	  [namespace import]; removed
	* generic/tclDecls.h:	  Tcl_NRObjProc, replaced with
	* generic/tclExecute.c:	  Tcl_NRCmdSwap (proposed public
	* generic/tclInt.h:	  NRE API). This should fix
	* generic/tclNRE.h:	  [Bug 582506].
	* generic/tclNamesp.c:
	* generic/tclStubInit.c:

	* generic/tclBasic.c:	 NRE: enabled calling NR commands
	* generic/tclExecute.c:	 from the callbacks. Completely
	* generic/tclInt.h:	 redone tailcall implementation
	* generic/tclNRE.h:	 using the new feature. [Bug 2021489]
	* generic/tclProc.c:
	* tests/NRE.test:

2008-07-20  Kevin B. Kenny  <kenykb@acm.org>

	* tests/fileName.test: Repaired the failing test fileName-15.7 from
	dkf's commit earlier today.

2008-07-20  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclDictObj.c (SetDictFromAny): Make the list->dict
	transformation a bit more efficient; modern dicts are ordered and so
	we can round-trip through lists without needing the string rep at all.
	* generic/tclListObj.c (SetListFromAny): Make the dict->list
	transformation not lossy of internal representations and hence more
	efficient. [Bug 2008248] (ajpasadyn) but using a more efficient patch.

	* tests/fileName.test: Revise to reduce the obscurity of tests. In
	particular, all tests should now produce informative messages on
	failure and the quantity of [catch]-based obscurity is now greatly
	reduced; non-erroring is now checked for directly.

2008-07-19  Donal K. Fellows  <dkf@users.sf.net>

	* tests/env.test: Add LANG to the list of variables that are not
	touched by the environment variable tests, so that subprocesses can
	get their system encoding correct.

	* tests/exec.test, tests/env.test: Rewrite so that non-ASCII
	characters are not used in the final comparison. Part of fixing [Bug
	1513659].

2008-07-18  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	 Optimization: replace calls to
	* generic/tclDictObj.c:	 Tcl_NRAddCallback with the macro
	* generic/tclExecute.c:	 TclNRAddCallback.
	* generic/tclInterp.c:
	* generic/tclNRE.h:
	* generic/tclNamesp.c:
	* generic/tclOO.c:
	* generic/tclOOBasic.c:
	* generic/tclOOCall.c:
	* generic/tclOOInt.h:
	* generic/tclOOMethod.c:
	* generic/tclProc.c:

2008-07-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (TclNRNewObjectInstance, FinalizeAlloc):
	* generic/tclOOBasic.c (TclOO_Class_Create, TclOO_Class_CreateNs)
	(TclOO_Class_New, FinalizeConstruction, AddConstructionFinalizer):
	NRE-enablement of the class construction methods.

2008-07-18  Miguel Sofer  <msofer@users.sf.net>

	* tests/NRE.test:  Added basic tests for deep TclOO calls

	* generic/tcl.decls:	   Change the public api prefix from
	* generic/tcl.h:	   TclNR_foo to Tcl_NRfoo
	* generic/tclBasic.c:
	* generic/tclDecls.h:
	* generic/tclDictObj.c:
	* generic/tclExecute.c:
	* generic/tclInterp.c:
	* generic/tclNRE.h:
	* generic/tclNamesp.c:
	* generic/tclOO.c:
	* generic/tclOOBasic.c:
	* generic/tclOOCall.c:
	* generic/tclOOMethod.c:
	* generic/tclProc.c:
	* generic/tclStubInit.c:

2008-07-18  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOBasic.c (TclOO_Object_Eval, FinalizeEval): NRE-enable
	the oo::object.eval method.

2008-07-18  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclDictObj.c (DictWithCmd, DictUpdateCmd): Fix refcounting
	bugs that caused crashes [Bug 2017857].

	* generic/tclBasic.c (TclNREvalObjEx): Streamline the management of
	the command frame (opt).

2008-07-17  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclDictObj.c (DictWithCmd, FinalizeDictWith): Split the
	implementation of [dict with] so that it works with NRE.
	(DictUpdateCmd, FinalizeDictUpdate): Similarly for the non-compiled
	version of [dict update].

2008-07-16  George Peter Staplin  <georgeps@users.sf.net>

	* win/tclWinThrd.c: Test for TLS_OUT_OF_INDEXES to make certain that
	thread key creation is successful.

2008-07-16  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c, generic/tclOOInt.h, generic/tclOOBasic.c:
	* generic/tclOOCall.c, generic/tclOOMethod.c: NRE-enable the TclOO
	implementation in Tcl. No change to public APIs, except that method
	implementations can now be NRE-aware if they choose (which normal
	methods and forwards are). On the other hand, callers of
	TclOOInvokeObject (which is only in the internal stub table) will need
	to deal with the fact that it's only safe to call inside an NRE-aware
	context.
	***POTENTIAL INCOMPATIBILITY***

2008-07-15  Miguel Sofer  <msofer@users.sf.net>

	* tests/NRE.test:	Better constraint for testing the existence of
	* tests/stack.test:	teststacklimit, to insure that the test suite
				runs under tclsh.

	* generic/tclParse.c: Fixing incomplete reversion of "fix" for [Bug
	2017583], missing TclResetCancellation call.

2008-07-15  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclBasic.c (Tcl_CancelEval): Fix blunder. [Bug 2018603]

	* doc/DictObj.3: Fix error in example. [Bug 2016740]

	* generic/tclNamesp.c (EnsembleUnknownCallback): Factor out some of
	the more complex parts of the ensemble code to make it easier to
	understand and hence to permit tighter compilation of code on the
	critical path.

2008-07-14  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclParse.c: Reverting the "fix" for [Bug 2017583], numLevel
	* tests/parse.test:   management and TclInterpReady check seems to be
			      necessary after all.

2008-07-14  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclProc.c (TclNRApplyObjCmd, TclObjInterpProcCore):
	* generic/tclBasic.c (TclNR_AddCallback, TclEvalObjv_NR2):
	* generic/tclNRE.h (TEOV_callback): Change the callback storage type
	to use an array, so guaranteeing correct inter-member spacing and
	memory layout.

2008-07-14  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c:	 Remove unneeded TclInterpReady calls
	* generic/tclParse.c:

	* generic/tclBasic.c.:	 Embedded Tcl_Canceled() calls into
	* generic/tclExecute.c:	 TclInterpReady().
	* generic/tclParse.c:

	* generic/tclVar.c: Fix error message

	* generic/tclParse.c: Remove unnecessary numLevel management
	* tests/parse.test:   [Bug 2017583]

	* generic/tclBasic.c.:	 NRE left too many calls to
	* generic/tclExecute.c:	 TclResetCancellation lying around: it
	* generic/tclProc.c:	 only needs to be called prior to any
				 iPtr->numLevels++. Thanks mistachkin.

	* generic/tclBasic.c: TclResetCancellation() calls were misplaced
	(merge mishap); stray //. Thanks patthoyts.

	* generic/tclInt.h: The new macros TclSmallAlloc and TclSmallFree
	were badly defined under mem debugging [Bug 2017240] (thx das)

2008-07-13  Miguel Sofer  <msofer@users.sf.net>

	NRE implementation [Patch 2017110]

	* generic/tcl.decls:	 The NRE infrastructure
	* generic/tcl.h:
	* generic/tclBasic.c:
	* generic/tclCmdAH.c:
	* generic/tclCompile.h:
	* generic/tclDecls.h:
	* generic/tclExecute.c:
	* generic/tclHistory.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclNRE.h:
	* generic/tclStubInit.c:
	* unix/Makefile.in:

	* generic/tclInterp.c:	 NRE-enabling: procs, lambdas, uplevel,
	* generic/tclNamesp.c:	 same-interp aliases, ensembles, imports
	* generic/tclProc.c:	 and namespace_eval.

	* generic/tclTestProcBodyObj.c: New NRE specific tests (few, but
	* tests/NRE.test:		note that the thing is actually
					tested by the whole testsuite.

	* tests/interp.test:	 Fixed numLevel counting.
	* tests/parse.test:
	* tests/stack.test:

	* unix/configure:	 Removing support for the hacky nonportable
	* unix/configure.in:	 stack check: it is not needed anymore, Tcl
	* unix/tclConfig.h.in:	 is very thrifty on the C stack.
	* unix/tclUnixInit.c:
	* unix/tclUnixTest.c:
	* win/tclWin32Dll.c:

2008-07-08  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclGet.c:	Corrected out of date comments and removed
	* generic/tclGet.c:	Corrected out of date comments.
	* generic/tclInt.decls:	internal routine TclGetLong() that's no
	longer used. If an extension is using this from the internal stubs
	table, it can shift to the public routine Tcl_GetLongFromObj() or
	can request addition of a public Tcl_GetLong().
	***POTENTIAL INCOMPATIBILITY***

	* generic/tclIntDecls.h:	make genstubs
	* generic/tclStubInit.c:

2008-07-08  Donal K. Fellows  <dkf@users.sf.net>

	* doc/CrtInterp.3: Tighten up the descriptions of behaviour to make
	this page easier to read for a "Tcl 8.6" audience.

2008-07-07  Andreas Kupries  <andreask@activestate.com>

	* generic/tclCmdIL.c (InfoFrameCmd): Fixed unsafe idiom of setting
	the interp result found by Don Porter.

2008-07-07  Donal K. Fellows  <dkf@users.sf.net>

	* doc/regexp.n, doc/regsub.n: Correct examples. [Bug 1982642]

2008-07-06  Donal K. Fellows  <dkf@users.sf.net>
2008-07-04  Joe English  <jenglish@users.sourceforge.net>

	* generic/tclEncoding.c(UtfToUtfProc): Avoid unwanted sign extension
	when converting incomplete UTF-8 sequences. See [Bug 1908443] for
	* doc/lindex.n: Improve examples.
	details.

2008-07-03  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIORChan.c (InvokeTclMethod): Fixed the memory leak
	reported in [Bug 1987821]. Thanks to Miguel for the report and Don
	Porter for tracking the cause down.

2008-07-03  Don Porter  <dgp@users.sourceforge.net>

	* library/package.tcl:	Removed [file readable] testing from
	[tclPkgUnknown] and friends. We find out soon enough whether a file is
	readable when we try to [source] it, and not testing before allows us
	to workaround the bugs on some common filesystems where [file
	readable] lies to us. [Patch 1969717]

2008-07-01  Donal K. Fellows  <dkf@users.sf.net>
2008-06-29  Don Porter  <dgp@users.sourceforge.net>

	* generic/regc_nfa.c (duptraverse): Impose a maximum stack depth on
	*** 8.5.3 TAGGED FOR RELEASE ***
	the single most recursive part of the RE engine. The actual maximum
	may need tuning, but that needs a system with a small stack to carry
	out. [Bug 1905562]

	* tests/string.test: Eliminate non-ASCII characters from the actual
	test script. [Bug 2006884]

	* generic/tcl.h:	Bump to 8.5.3 for release.
2008-06-30  Donal K. Fellows  <dkf@users.sf.net>

	* library/init.tcl:
	* doc/ObjectType.3: Clean up typedef formatting.

	* tools/tcl.wse.in:
2008-06-30  Don Porter  <dgp@users.sourceforge.net>

	* unix/configure.in:
	* doc/ObjectType.3:	Updated documentation of the Tcl_ObjType
	struct to match expectations of Tcl 8.5. [Bug 1917650]

	* unix/tcl.spec:
2008-06-30  Alexandre Ferrieux  <ferrieux@users.sourceforge.net>

	* win/configure.in:
	* generic/tclCmdIL.c: Lrange cleanup and in-place optimization. [Patch
	1890831]

	* generic/tclExecute.c: Avoid useless String conversion for CONCAT1 of
	pure byte arrays. [Patch 1953758]

	* unix/configure:	autoconf-2.59
2008-06-29  Donal K. Fellows  <dkf@users.sf.net>
	* win/configure:

	* doc/*.1, doc/*.3, doc/*.n: Many small updates, purging out of date
	change bars and cleaning up the formatting of typedefs. Added a few
	missing bits of documentation in the process.

	* doc/ObjectType.3:	Updated documentation of the Tcl_ObjType
	struct to match expectations of Tcl 8.5 [Bug 1917650].
2008-06-29  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c:	 Plug memory leak in [Bug 1999176] fix. Thanks
	to Rolf Ade for detecting.
	* generic/tclPathObj.c:  Plug memory leak in [Bug 1999176] fix. Thanks
	Rolf Ade for detecting.

2008-06-29  Donal K. Fellows  <dkf@users.sf.net>

	* doc/interp.n: Corrected order of subcommands. [Bug 2004256]
	Removed obsolete (i.e. 8.5) .VS/.VE pairs.

	* doc/object.n (EXAMPLES): Fix incorrect usage of oo::define to be
	done with oo::objdefine instead. [Bug 2004480]

2008-06-28  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c:	 Plug memory leak in [Bug 1972879] fix. Thanks
	to Rolf Ade for detecting and Dan Steffen for the fix. [Bug 2004654]

2008-06-26  Andreas Kupries  <andreask@activestate.com>

	* unix/Makefile.in: Followup to my change of 2008-06-25, make code
	generated by the Makefile and put into the installed tm.tcl
	conditional on interpreter safeness as well. Thanks to Daniel Steffen
	for reminding me of that code.

2008-06-25  Don Porter  <dgp@users.sourceforge.net>

	*** 8.6a1 TAGGED FOR RELEASE ***

	* changes:	Updates for 8.6a1 release.
	* changes:	Update for 8.5.3 release.

	* generic/tclOO.h:	Bump to TclOO 0.5.

2008-06-25  Andreas Kupries  <andreask@activestate.com>

	* library/tm.tcl:   Modified the handling of Tcl Modules and of the
	* library/safe.tcl: Safe Base to interact nicely with each other,
	* library/init.tcl: enabling requiring Tcl Modules in safe
	* tests/safe.test:  interpreters. [Bug 1999119]

2008-06-25  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* win/rules.vc: Fix versions of dde and registry dlls
	* win/makefile.vc: Fix problem building with staticpkg option
	* win/rules.vc:    Backported fix for dde/registry versions and
	* win/makefile.vc: the staticpkg build option

2008-06-24  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c: Fixed some internals management in the "path"
	Tcl_ObjType for the empty string value. Problem led to a crash in the
	command [glob -dir {} a]. [Bug 1999176]

2008-06-24  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* doc/fileevent.n: Fix examples and comment on eof use. [Bug 1995063]

2008-06-23  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclPathObj.c: Fixed bug in Tcl_GetTranslatedPath() when
	operating on the "Special path" variant of the "path" Tcl_ObjType
	intrep. A full normalization was getting done, in particular, coercing
	relative paths to absolute, contrary to what the function of producing
	the "translated path" is supposed to do. [Bug 1972879]

2008-06-20  Don Porter  <dgp@users.sourceforge.net>
2008-06-19  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6a1 release.
	* changes:	Update for 8.5.3 release.

	* generic/tclInterp.c:	Fixed completely boneheaded mistake that
	* tests/interp.test:	[interp bgerror $slave] and [$slave bgerror]
	would always act like [interp bgerror {}]. [Bug 1999035]

	* tests/chanio.test:	Corrected flawed tests revealed by a -debug 1
	* tests/cmdAH.test:	-singleproc 1 test suite run.
	* tests/event.test:
	* tests/event.test:	-singleproc 1 test suite run.
	* tests/interp.test:
	* tests/io.test:
	* tests/ioTrans.test:
	* tests/namespace.test:

	* tests/encoding.test:	Make failing tests pass again. [Bug 1972867]

2008-06-19  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (Tcl_ObjectContextInvokeNext): Corrected 'next' (at
	* tests/oo.test (oo-7.8):	end of a call chain) to make it
	* doc/next.n:			consistent with the TIP. [Bug 1998244]

	* generic/tclOOCall.c (AddSimpleClassChainToCallContext): Make sure
	* tests/oo.test (oo-14.8): that class mixins are processed in the
	documented order. [Bug 1998221]

2008-06-19  Don Porter  <dgp@users.sourceforge.net>

	* changes:	Updates for 8.6a1 release.
	* changes:	Updates for 8.5.3 release.

	* README:		Bump version number to 8.6a1
	* generic/tcl.h:
	* library/init.tcl:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/configure.in:

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

2008-06-17  Andreas Kupries  <andreask@activestate.com>

	* generic/tclClock.c (ClockConvertlocaltoutcObjCmd): Removed left
	over debug output.

2008-06-17  Andreas Kupries  <andreask@activestate.com>
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
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







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

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
-
-
-
-






-
-
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
-







	* tests/clock.test (clock-63.1): Fixed a bug where the internal
	ConvertLocalToUTC command segfaulted if passed a dictionary without
	the 'localSeconds' key. To the best of my knowledge, the bug was not
	observable in the [clock] command itself.

2008-06-16  Andreas Kupries  <andreask@activestate.com>

	* generic/tclCmdIL.c (TclInfoFrame): Moved the code looking up the
	* tests/info.test: information for key 'proc' out of the
	TCL_LOCATION_BC branch to after the switch, this is common to all
	frame types. Updated the testsuite to match. This was exposed by the
	2008-06-08 commit (Miguel), switching uplevel from direct eval to
	compilation. [Bug 1987851]
	* generic/tclCmdIL.c (TclInfoFrame): Backport of fix made on the
	* tests/info.test: head branch :: Moved the code looking up the
	information for key 'proc' out of the TCL_LOCATION_BC branch to
	after the switch, this is common to all frame types. Updated the
	testsuite to match. This was exposed by the 2008-06-08 commit
	(Miguel), switching uplevel from direct eval to compilation. Fixes
	[Bug 1987851].

2008-06-16  Andreas Kupries  <andreask@activestate.com>

	* tests/ioTrans.test (iortrans-11.*): Fixed same issue as for
	iortrans.tf-11.*, cleanup of temp file, making this a followup to the
	entry on 2008-06-10 by myself.

2008-06-13  David Gravereaux  <davygrvy@pobox.com>

	* win/rules.vc: SYMBOLS macro is now being set to zero when $(OPTS) is
	not available.
	* win/makefile.vc: The Stubs source files (tclStubLib.c and
	tclOOStubLib.c) should not be compiled with the -GL flag.

2008-06-13  Joe Mistachkin  <joe@mistachkin.com>

	TIP #285 IMPLEMENTATION

	* doc/Eval.3: Added documentation for the Tcl_CancelEval and
	Tcl_Canceled functions and the TCL_CANCEL_UNWIND flag bit.
	* doc/after.n: Corrected the spelling of 'canceled' in the
	documentation.
	* doc/interp.n: Added documentation for [interp cancel].
	* generic/tcl.decls: Added the Tcl_CancelEval and Tcl_Canceled
	functions to the stubs table.
	* generic/tcl.h: Added the TCL_CANCEL_UNWIND flag bit.
	* generic/tclBasic.c: The bulk of the script cancellation
	functionality is defined here. Added code to initialize and manage the
	script cancellation hash table in a thread-safe manner. Reset script
	cancellation flags prior to increasing the nesting level (if the
	nesting level is currently zero) and always cooperatively check for
	script cancellation near the start of TclEvalObjvInternal and after
	invoking async handlers.
	* generic/tclDecls.h: Regenerated.
	* generic/tclEvent.c: Call TclFinalizeEvaluation during finalization
	to cleanup the script cancellation hash table. During [vwait], always
	cooperatively check for script cancellation. Corrected the spelling of
	'canceled' in comments to be consistent with the documentation.
	* generic/tclExecute.c: Reset script cancellation flags prior to
	increasing the nesting level (if the nesting level is currently zero)
	and always cooperatively check for script cancellation after invoking
	async handlers. Prevent [catch] from catching script cancellation when
	the TCL_CANCEL_UNWIND flag is set (similar to the manner used by TIP
	143 when a limit has been exceeded).
	* generic/tclInt.decls: Added TclResetCancellation to the internal
	stubs table.
	* generic/tclInt.h: Added asyncCancel and asyncCancelMsg fields to the
	private Interp structure. Added private interp flag value CANCELED to
	help control script cancellation.
	* generic/tclIntDecls.h: Regenerated.
	* generic/tclInterp.c (Tcl_InterpObjCmd): Added [interp cancel]
	subcommand.
	* generic/tclNotify.c (Tcl_DeleteEventSource): Corrected the spelling
	of 'canceled' in comments to be consistent with the documentation.
	* generic/tclParse.c: Reset script cancellation flags prior to
	* generic/tclProc.c: increasing the nesting level (if the nesting
	level is currently zero) and cooperatively check for script
	cancellation prior to evaluating commands.
	* generic/tclStubInit.c: Regenerated.
	* generic/tclThreadTest.c (Tcl_ThreadObjCmd): Added script
	cancellation support ([testthread cancel]).
	Modified [testthread id] to allow querying of the 'main' thread ID.
	Corrected comments to reflect the actual command syntax. Made
	[testthread wait] cooperatively check for script cancellation. Added
	[testthread event] to allow for processing one pending event without
	blocking.
	* generic/tclTimer.c: Delay for a maximum of 500 milliseconds prior to
	checking for async handlers and script cancellation.
	* tests/cmdAH.test: Changed [interp c] to [interp create].
	* tests/interp.test: Added and fixed tests for [interp cancel].
	* tests/thread.test: Added tests for script cancellation via
	[testthread cancel].
	* tools/man2help2.tcl: Fixed problems with WinHelp target (see
	* tools/man2tcl.c: [Bug 1934200], [Bug 1934265], and [Bug 1934272]).
	* win/makefile.vc: Added 'pdbs' option for Windows build rules to
	* win/rules.vc:	   allow for non-debug builds with full symbols.
	* win/tcl.hpj.in: Corrected version for WinHelp target.
	* win/tclWinNotify.c: Used SleepEx and WaitForSingleObjectEx on
	* win/tclWinThrd.c: Windows because they are alertable.

2008-06-12  Daniel Steffen  <das@users.sourceforge.net>

	* unix/Makefile.in:		Add complete deps on tclDTrace.h.

	* generic/tclOO.c:		Use TclOOStubs hooks field to retrieve
	* generic/tclOODecls.h:		TclOOIntStubs pointer. [Bug 1980953]
	* generic/tclOOIntDecls.h:
	* generic/tclOOStubInit.c:
	* generic/tclOOStubLib.c:

	* generic/tclIORTrans.c:	Fix signed <-> unsigned cast warnings.

	* unix/Makefile.in:		Clean generated tclDTrace.h file.
	* unix/configure.in (SunOS):	Fix static DTrace-enabled build.

	* unix/tcl.m4 (SunOS-5.11): Fix 64bit amd64 support with gcc & Sun cc.
	* unix/configure: autoconf-2.59

	* macosx/Tcl.xcodeproj/project.pbxproj:	Add tclIORTrans.c; updates and
						cleanup for Xcode 3.1/Leopard.
	* macosx/Tcl.xcodeproj/project.pbxproj:	Add debug configs with gcov,
	and with corefoundation disabled; updates and cleanup for Xcode 3.1 and
	for Leopard.
	* macosx/Tcl.xcode/project.pbxproj:	Sync Tcl.xcodeproj changes.
	* macosx/README:			Document new build configs.

2008-06-10  Joe English  <jenglish@users.sourceforge.net>

	* generic/tclEncoding.c(UtfToUtfProc): Avoid unwanted sign extension
	when converting incomplete UTF-8 sequences. See [Bug 1908443] for
	details.

2008-06-10  Andreas Kupries  <andreask@activestate.com>

	* tests/ioTrans.test (iortrans.tf-6.1): Fixed the [Bug 1988552],
	reported by Kevin. Have to close the channel before removal of the
	file. Fixed same bug in test 'iortrans.tf-11.0', after fixing missing
	cleanup of the file in 'iortrans.tf-11.*'. Lastly fixed the names of
	the threaded tests 'iortrans-8.*' to the correct 'iortrans.tf-8.*'.

2008-06-09  Andreas Kupries  <andreas_kupries@users.sourceforge.net>

	* generic/tclIORTrans.c (ReflectInput): Fixed a bug triggered by Pat
	Thoyts <patthoyts@users.sourceforge.net>. Reset the EOF flag after
	draining the Tcl level into the result buffer, to make sure that the
	result buffer will be drained as well by repeated calls to
	ReflectInput should it contain more than one buffer-full of data.
	Without that reset the higher I/O system will not call on ReflectInput
	anymore due to the assumed EOF, thus losing the data which did not fit
	in the buffer of the call which caused the eof and drain.

2008-06-09  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOCall.c (TclOOGetSortedMethodList): Plug memory leak
	that occurred when all methods were hidden. [Bug 1987817]

2008-06-08  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclBasic.c:	   Compilation of uplevel scripts, allow
	* generic/tclCompCmds.c:   non-body compiled scripts to access the
	* generic/tclCompile.c:	   LVT (but not to extend it) and enable the
	* generic/tclCompile.h:	   canonical list opt to sidestep the
	* generic/tclExecute.c:	   compiler. [Patch 1973096]
	* generic/tclProc.c:
	* tests/uplevel.test:

2008-06-06  Andreas Kupries  <andreask@activestate.com>

	TIP #230 IMPLEMENTATION

	* generic/tclIOCmd.c: Integration of transform commands into 'chan'
			      ensemble.
	* generic/tclInt.h: Definitions of the transform commands.
	* generic/tclIORTrans.c: Implementation of the reflection transforms.
	* tests/chan.test:  Tests updated for new sub-commands of 'chan'.
	* tests/ioCmd.test: Tests updated for new sub-commands of 'chan'.
	* tests/ioTrans.test: Whole new set of tests for the reflection
			      transform.
	* unix/Makefile.in: Integration of new files into build rules.
	* win/Makefile.in:  Integration of new files into build rules.
	* win/makefile.vc:  Integration of new files into build rules.

	NOTE: The file 'tclIORTrans.c' has a lot of code in common with the
	      file 'tclIORChan.c', as that made it much easier to develop the
	      reference implementation as a separate module. Now that the
	      transforms have been committed the one thing left to do is to go
	      over both modules and see which of the common parts we can
	      factor out and share.

2008-06-04  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclBinary.c: TIP #317 implementation
	* tests/binary.test:

2008-06-02  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclOO.c (ReleaseClassContents): Fix the one remaining
	valgrind complaint about oo.test, caused by failing to protect the
	Object as well as the Class corresponding to a subclass being deleted
	and hence getting a freed-memory read when attempting to delete the
	class command. [Bug 1981001]

2008-06-01  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOOMethod.c (Tcl_NewMethod): Complete the fix of [Bug
	1981001], previous fix was incomplete though helpful in telling me
	where to look.

2008-06-01  Joe Mistachkin  <joe@mistachkin.com>

	* win/Makefile.in: Add tclOO genstubs to Windows makefiles and remove
	* win/makefile.vc: -DBUILD_tcloo because it is no longer required.

2008-06-01  Kevin B. Kenny  <kennykb@acm.org>

	* generic/tclOODecls.h:	   Added the swizzling of DLLEXPORT and
	* generic/tclOOIntDecls.h: DLLIMPORT needed to make EXTERN work.

	* generic/tclDictObj.c:	 Added missing initializers to the ensemble
				 map to silence a compiler warning. Thanks to
				 George Peter Staplin for the report.

	* generic/tclOOMethod.c: Fix a bug where the refcount of a method was
				 reset if the method was redefined while there
				 was an active invocation. [Bug 1981001]

2008-06-01  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.decls, unix/Makefile.in (genstubs): Make generation of
	stub tables correct.
	* generic/tclOO{Decls.h,IntDecls.h,StubInit.c,StubLib.c}: Fixes to
	make the generation work correctly, removing subtle differences
	between output of different versions of stub generator.

2008-06-01  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclOOStubLib.c:	Ensure use of tcl stubs; include in
	* unix/Makefile.in:		stub lib; disable broken tclOO
					genstubs

	* generic/tclOO.c:		Make tclOO stubs tables 'static const'
	* generic/tclOODecls.h:		and stub table pointers MODULE_SCOPE
	* generic/tclOOIntDecls.h:	(change generated files manually
	* generic/tclOOStubInit.c:	pending genstubs support for tclOO).
	* generic/tclOOStubLib.c:

	* generic/tclOO.c:		Fix warnings for 'int<->ptr
	* generic/tclOOCall.c:		conversion' and 'signed vs unsigned
	* generic/tclOOMethod.c:	comparison'.

	* tests/msgcat.test:	Fix for ::tcl::mac::locale with @modifier.

	* tools/tsdPerf.tcl:	Use [info sharedlibextension]

	* unix/tclConfig.h.in:	autoheader-2.59

	* macosx/Tcl.xcodeproj/project.pbxproj:	Add new tclOO files; add debug
	* macosx/README:			configs with corefoundation
						disabled and with gcov; update
						to Xcode 3.1.

2008-05-31  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclOO.c (InitFoundation): Correct reference counting for
	strings used when creating the constructor for classes.
	* generic/tclOOMethod.c (TclOODelMethodRef): Correct fencepost error
	in reference counting of method implementation structures.
	* tests/oo.test (oo-0.5): Added a test to detect a memory leak problem
	relating to disposal of the core object system.

	TIP#257 IMPLEMENTATION

	* generic/tclBasic.c, generic/tclOOInt.h: Correct declarations.
	* win/Makefile.in, win/makefile.bc, win/makefile.vc: Build support for
	Win32, from Joe Mistachkin. [Patch 1980861]

	* generic/tclOO*, doc/*, tests/oo.test: Port of implementation of
	TclOO to sit directly inside Tcl. Note that this is incomplete (e.g.
	no build support yet for Windows).

2008-05-26  Jeff Hobbs  <jeffh@ActiveState.com>

	* tests/io.test (io-53.9): Need to close chan before removing file.

2008-05-26  Donal K. Fellows  <dkf@users.sf.net>

	* win/makefile.bc:		    Remove deprecated winhelp target.
	* win/Makefile.in, win/makefile.vc: It didn't work correctly anyway.

2008-05-23  Andreas Kupries  <andreask@activestate.com>

	* win/tclWinChan.c (FileWideSeekProc): Accepted a patch by Alexandre
	Ferrieux <ferrieux@users.sourceforge.net> to fix the [Bug 1965787].
	'tell' now works for locations > 2 GB as well instead of going
	negative.

2827
2828
2829
2830
2831
2832
2833
2834

2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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







-
+










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





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	* generic/tclParse.c (ParseComment):	The new TclParseAllWhiteSpace
	* tests/parse.test (parse-15.60):	routine has no mechanism to
	return the "incomplete" status of "\\\n" so calling this routine
	anywhere that can be reached within a Tcl_ParseCommand() call is a
	mistake. In particular, ParseComment() must not use it. [Bug 1968882]

2008-05-20  Donal K. Fellows  <dkf@users.sf.net>
2008-05-21  Donal K. Fellows  <dkf@users.sf.net>

	* generic/tclNamesp.c (Tcl_SetNamespaceUnknownHandler): Corrected odd
	logic for handling installation of namespace unknown handlers which
	could lead too very strange things happening in the error case.

2008-05-16  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclCompile.c: Fix crash with tcl_traceExec. Found and fixed
	by Alexander Pasadyn. [Bug 1964803]

2008-05-15  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* win/makefile.vc: We should use the thread allocator for threaded
	* win/rules.vc:	   builds. Added 'tclalloc' option to disable.

2008-05-09  George Peter Staplin  <georgeps@xmission.com>

	* tools/tsdPerf.c:	A loadable Tcl extension for testing TSD
	performance.
	* tools/tsdPerf.tcl:	A simplistic tool that uses the thread
	extension and tsdPerf.so to get some performance metrics by,
	simulating, simple TSD contention.

2008-05-09  George Peter Staplin  <georgeps@xmission.com>

	* generic/tcl.h:	Make Tcl_ThreadDataKey a void *.
	* generic/tclInt.h:	Change around some function names and add some
	new per-platform declarations for thread-specific data functions.
	* generic/tclThread.c:	Make use of of the new function names that no
	longer have a Tclp prefix.
	* generic/tclThreadStorage.c: Replace the core thread-specific data
	(TSD) mechanism with an array offset solution that eliminates the hash
	tables, and only uses one slot of native TSD. Many thanks to Kevin B.
	Kenny for his help with this.

	* unix/tclUnixThrd.c:	Add platform-specific TSD functions for use by
	* win/tclWinThrd.c:	tclThreadStorage.c.

2008-05-09  Kevin B. Kenny  <kennykb@acm.org>

	* tests/dict.test (dict-19.2): Corrected a bug where the test was
	changed to use [apply] instead of a temporary proc, but the cleanup
	script still attempted to delete the temporary proc.

2008-05-07  Donal K. Fellows  <dkf@cspool38.cs.man.ac.uk>
2008-05-07  Donal K. Fellows  <donal.k.fellows@man.ac.uk>

	* generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix silly off-by
	one error that caused a crash every time a compiled 'dict append' with
	more than one argument was used. Found by Colin McCormack.

2008-05-02  Pat Thoyts  <patthoyts@users.sourceforge.net>

	* generic/tclBasic.c:	 Converted the [binary] command into an
	* generic/tclBinary.c:	 ensemble.
	* generic/tclInt.h:
	* test/binary.test:	 Updated the error tests for ensemble errors.

	* generic/tclFileName.c: Reverted accidental commit of TIP 316 APIs.

2008-04-27  Donal K. Fellows  <dkf@users.sf.net>

	* */*.c: A large tranche of getting rid of pre-C89-isms; if your
	compiler doesn't support things like proper function declarations,
	'void' and 'const', borrow a proper one when building Tcl. (The header
	files allow building things that link against Tcl with really ancient
	compilers still; the requirement is just when building Tcl itself.)

2008-04-26  Zoran Vasiljevic  <vasiljevic@users.sourceforge.net>

	* generic/tclAsync.c: Tcl_AsyncDelete(): panic if attempt to locate
	handler token fails. Happens when some other thread attempts to delete
	somebody else's token.

	Also, panic early if we find out the wrong thread attempting to delete
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







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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-
-








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














-
-
-
-
-
-
-
-
-




-
+
-








-
+

-
-
-
+
+
-

-
-
-
-
+

-
-
-
+
-
-
-
-
-
+



-
+

-
-
-
-
+
+
+
+

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









-
-
-
-
-
-
-
-










+
+
+
+
+
+
+
+
+







	pulled out from under a channel (= killing threads, interpreters
	containing the tcl command for a channel, and channel sitting in a
	different interpreter/thread.)

	* generic/tclIORChan.c: Fixed the bugs exposed by the new testcases,
	redone most of the cleanup and exit handling.

2008-04-21  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclIOUtil.c:		Removed all code delimited by
	* generic/tclTest.c:		USE_OBSOLETE_FS_HOOKS, completing
	* tests/ioCmd.test:		the deprecation path for these
	* tests/ioUtil.test (removed):	obsolete interfaces. (Code was active
	in Tcl 8.4, present but enabled only by customized compile switch in
	Tcl 8.5, and now completely gone for Tcl 8.6). Also removed all tests
	relevant only to the removed interfaces.

2008-04-19  George Peter Staplin  <georgeps@xmission.com>

	* doc/Ensemble.3: Fix a typo: s/defiend/defined/
	Thanks to hat0 for spotting this.

2008-04-16  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tclInt.h:		Make stubs tables 'static const' and
	* generic/tclStubInit.c:	export only module-scope pointers to
	* generic/tclStubLib.c:		the main stubs tables (for package
	* tools/genStubs.tcl:		initialization). [Patch 1938497]
	* generic/tclBasic.c (Tcl_CreateInterp):
	* generic/tclTomMathInterface.c (TclTommath_Init):

	* generic/tclInt.h:		Revise Tcl_SetNotifier() to use a
	* generic/tclNotify.c:		module-scope hooks table instead of
	* generic/tclStubInit.c:	runtime stubs-table modification;
	* macosx/tclMacOSXNotify.c:	ensure all hookable notifier functions
	* win/tclWinNotify.c:		check for hooks; remove hook checks in
	* unix/tclUnixNotfy.c:		notifier API callers. [Patch 1938497]

2008-04-15  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (CopyData):	Applied another patch by Alexandre
	* io.test (io-53.8a):		Ferrieux <ferrieux@users.sf.net>,
	* chanio.test (chan-io-53.8a):	to shift EOF handling to the async
	part of the command if a callback is specified, should the channel be
	at EOF already when fcopy is called. Testcase by myself.

2008-04-15  Daniel Steffen  <das@users.sourceforge.net>

	* unix/Makefile.in:	Adjust tclDTrace.h dependencies for removal
				of tclStubLib.o from TCL_OBJS. [Bug 1942795]

2008-04-14  Kevin B. Kenny  <kennykb@acm.org>

	* unix/tclUnixTime.c (NativeGetTime): Removed obsolete use of
	'struct timezone' in the call to 'gettimeofday'. [Bug 1942197]

	* tests/clock.test (clock-33.5, clock-33.5a, clock-33.8, clock-33.8a):
	Added comments to the test that it can fail on a heavily loaded
	system.

2008-04-11  Don Porter	<dgp@users.sourceforge.net>

	* generic/tcl.h:	Bump version number to 8.5.3b1 to distinguish
	* library/init.tcl:	CVS development snapshots from the 8.5.2 and
	* unix/configure.in:	8.5.3 releases.
	* unix/tcl.spec:
	* win/configure.in:
	* README

	* unix/configure:	autoconf (2.59)
	* win/configure:

2008-04-10  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIOCmd.c (Tcl_FcopyObjCmd): Keeping check for negative
	values, changed to not be an error, but behave like the special value
	-1 (copy all, default).

	* tests/iocmd.test (iocmd-15.{12,13}): Removed.

	* tests/io.test (io-52.5{,a,b}): Reverted last change, added
	* tests/chanio.test (chan-io-52.5{,a,b}): comment regarding the
	meaning of -1, added two more testcases for other negative values,
	and input wrapped to negative.

2008-04-09  Donal K. Fellows  <dkf@users.sf.net>

	* tests/{fCmd,unixFCmd,winFCmd,winFile}.test: Tidying up of the test
	suite to make better use of tcltest2 and be clearer about what is
	being tested.

	* win/Makefile.in (html): Added target for doing convenient
	documentation builds, mirroring the one from unix/Makefile.

2008-04-09  Andreas Kupries  <andreask@activestate.com>

	* tests/chanio.test (chan-io-52.5): Removed '-size -1' from test,
	* tests/io.test (io-52.5): does not seem to have any bearing, and was
	an illegal value. Test case is not affected by the value of -size,
	an illegal value.
	test flag restoration and that evrything was properly copied.

	* generic/tclIOCmd.c (Tcl_FcopyObjCmd): Added checking of -size value
	* tests/ioCmd.test (iocmd-15.{13,14}): to reject negative values, and
	values overflowing 32-bit signed. Basic patch by Alexandre Ferrieux
	<ferrieux@users.sourceforge.net>, with modifications from me to
	separate overflow from true negative value. Extended testsuite. [Bug
	1557855]

2008-04-09  Daniel Steffen  <das@users.sourceforge.net>
2008-04-08  Andreas Kupries  <andreask@activestate.com>

	* tests/chanio.test (chan-io-53.8,53.9,53.10): Fix typo & quoting for
	* tests/io.test (io-53.8,53.9,53.10):	       spaces in builddir path

	* tests/io.test (io-53.8): Fixed ordering of vwait and after
	cancel. cancel has to be done after the vwait completes.
2008-04-08  Miguel Sofer  <msofer@users.sf.net>

	* generic/tclExecute.c: Added comments to the alignment macros used in
	GrowEvaluationStack() and friends.

2008-04-08  Daniel Steffen  <das@users.sourceforge.net>
2008-04-09  Daniel Steffen  <das@users.sourceforge.net>

	* tools/genStubs.tcl:	Revert erroneous 2008-04-02 change marking
				*StubsPtr as EXTERN instead of extern.

	* tests/chanio.test (chan-io-53.8,53.9,53.10):	fix typo & quoting for
	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclTomMathDecls.h:
	* tests/io.test (io-53.8,53.9,53.10):		spaces in builddir path

2008-04-07  Andreas Kupries  <andreask@activestate.com>

	* tests/io.test (io-53.10): Testcase for bi-directional fcopy.
	* tests/io.test (io-53.10): Testcase for bi-directionaly fcopy.
	* tests/chanio.test:
	* generic/tclIO.c: Additional changes to data structures for fcopy and
	* generic/tclIO.h: channels to perform proper cleanup in case of a
	channel having two background copy operations running as is now
	possible.
	* generic/tclIO.c: Additional changes to data structures for fcopy
	* generic/tclIO.h: and channels to perform proper cleanup in case
	of a channel having two background copy operations running as is
	now possible.

	* tests/io.test (io-53.10): Testcase for bi-directionaly fcopy.
	* generic/tclIO.c: Additional changes to data structures for fcopy
	and channels to perform proper cleanup in case of a channel having
	two background copy operations running as is now possible.

2008-04-07  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (BUSY_STATE, CheckChannelErrors, TclCopyChannel):
	New macro, and the places using it. This change allows for
	bi-directional fcopy on channels. Thanks to Alexandre Ferrieux
	<ferrieux@users.sourceforge.net> for the patch. [Bug 1350564]
	* generic/tclIO.c (BUSY_STATE, CheckChannelErrors,
	TclCopyChannel): New macro, and the places using it. This change
	allows for bi-directional fcopy on channels. [Bug 1350564]. Thanks
	to Alexandre Ferrieux <ferrieux@users.sourceforge.net> for the
	patch.

2008-04-07  Reinhard Max  <max@suse.de>

	* generic/tclStringObj.c (Tcl_AppendFormatToObj): Fix [format {% d}]
	so that it behaves the same way as in 8.4 and as C's printf().
	* tests/format.test: Add a test for '% d' and '%+d'.

2008-04-05  Kevin B. Kenny  <kennykb@acm.org>

	* win/tclWinFile.c: (WinSymLinkDirectory): Fixed a problem that Tcl
	was creating an NTFS junction point (IO_REPARSE_TAG_MOUNT_POINT) but
	filling in the union member for a Vista symbolic link. We had gotten
	away with this error because the union member
	(SymbolicLinkReparseBuffer) was misdefined in this file and in the
	'winnt.h' in early versions of MinGW. MinGW 3.4.2 has the correct
	definition of SymbolicLinkReparseBuffer, exposing the mismatch, and
	making tests cmdAH-19.4.1, fCmd-28.*, and filename-11.* fail.
	* tests/chanio.test (chan-io-53.9):
	* tests/io.test (io-53.9): Made test cleanup robust against the
	possibility of slow process shutdown on Windows.

	* win/tcl.m4: Added -D_CRT_SECURE_NO_DEPRECATE and
	-DCRT_NONSTDC_NO_DEPRECATE to the MSVC compilation flags so that the
	compilation doesn't barf on perfectly reasonable Posix system calls.
	* win/configure: Manually patched (don't have the right autoconf to
	hand).

	* win/tclWinFile.c: (WinSymLinkDirectory): Fixed a problem that
	Tcl was creating an NTFS junction point (IO_REPARSE_TAG_MOUNT_POINT)
	but filling in the union member for a Vista symbolic link. We had
	gotten away with this error because the union member
	(SymbolicLinkReparseBuffer) was misdefined in this file and in the
	'winnt.h' in early versions of MinGW. MinGW 3.4.2 has the correct
	definition of SymbolicLinkReparseBuffer, exposing the mismatch,
	and making tests cmdAH-19.4.1, fCmd-28.*, and filename-11.* fail.

2008-04-04  Andreas Kupries  <andreask@activestate.com>

	* tests/io.test (io-53.9): Added testcase for [Bug 780533], based
	* tests/chanio.test: on Alexandre's test script. Also fixed problem
	with timer in preceding test, was not canceled properly in the ok case

2008-04-04  Andreas Kupries  <andreask@activestate.com>
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
+



-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







2008-04-03  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (CopyData): Applied patch [Bug 1932639] to
	* tests/io.test: prevent fcopy from calling -command synchronously
	* tests/chanio.test: the first time. Thanks to Alexandre Ferrieux
	<ferrieux@users.sourceforge.net> for report and patch.

2008-04-02  Daniel Steffen  <das@users.sourceforge.net>

	* generic/tcl.decls:	Remove 'export' declarations of symbols now
				only in libtclstub and no longer in libtcl.

	* generic/tclStubLib.c:	Make symbols in libtclstub.a MODULE_SCOPE to
	* tools/genStubs.tcl:	avoid exporting them from libraries that link
				with -ltclstub; constify tcl*StubsPtr and stub
				table hook pointers. [Bug 1819422]

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclStubInit.c:
	* generic/tclTomMathDecls.h:

2008-04-02  Andreas Kupries  <andreask@activestate.com>

	* generic/tclIO.c (CopyData): Applied patch for fcopy problem [Bug
	780533], with many thanks to Alexandre Ferrieux
	<ferrieux@users.sourceforge.net> for tracking it down and providing a
	solution. Still have to convert his test script into a proper test
	case.

2008-04-01  Andreas Kupries  <andreask@activestate.com>

	* generic/tclStrToD.c: Applied patch for [Bug 1839067] (fp rounding
	* unix/tcl.m4:	       setup on solaris x86, native cc), provided by
			       Michael Schlenker.
	* unix/configure:      Michael Schlenker. configure regen'd.

2008-04-01  Don Porter  <dgp@users.sourceforge.net>

	* generic/tclStubLib.c:	Removed needless #ifdef complexity.

	* generic/tclStubLib.c (Tcl_InitStubs):	Added missing error message.
	* generic/tclPkg.c (Tcl_PkgInitStubsCheck):

	* README:		Bump version number to 8.6a0
	* generic/tcl.h:
	* library/init.tcl:
	* macosx/Tcl-Common.xcconfig:
	* macosx/Tcl.pbproj/default.pbxuser:
	* macosx/Tcl.pbproj/project.pbxproj:
	* tools/tcl.wse.in:
	* unix/configure.in:
	* unix/tcl.spec:
	* win/README:
	* win/configure.in:
	* win/makefile.bc:
	* win/tcl.m4:

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

	* generic/tclBasic.c:	Revised stubs-generation tool and interp
	* tools/genStubs.tcl:	creation so that "tclStubsPtr" is not present
	* unix/Makefile.in:	in libtcl.so, but is present only in
	* win/Makefile.in:	libtclstub.a. This tightens up the rules for
	* win/makefile.bc:	users of the stubs interfaces. [Bug 1819422]
	* win/makefile.vc:

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclIntPlatDecls.h:
	* generic/tclPlatDecls.h:
	* generic/tclTomMathDecls.h:

2008-03-30  Kevin Kenny  <kennykb@acm.org>

	* generic/tclInt.h (TclIsNaN):
	* unix/configure.in: Added code to the configurator to check for a
			     standard isnan() macro and use it if one is
			     found. This change avoids bugs where the test of
			     ((d) != (d)) is optimized away by an
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794







3795
3796
1514
1515
1516
1517
1518
1519
1520







1521
1522
1523
1524
1525
1526
1527
1528
1529







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


	* win/configure.in:
	* README

	* unix/configure:	autoconf (2.59)
	* win/configure:

	******************************************************************
	*** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007"	       ***
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"	       ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"	       ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"	       ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"	       ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"	       ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"	       ***
	*** CHANGELOG ENTRIES FOR 2006-2007 IN "ChangeLog.2007"        ***
	*** CHANGELOG ENTRIES FOR 2005 IN "ChangeLog.2005"             ***
	*** CHANGELOG ENTRIES FOR 2004 IN "ChangeLog.2004"             ***
	*** CHANGELOG ENTRIES FOR 2003 IN "ChangeLog.2003"             ***
	*** CHANGELOG ENTRIES FOR 2002 IN "ChangeLog.2002"             ***
	*** CHANGELOG ENTRIES FOR 2001 IN "ChangeLog.2001"             ***
	*** CHANGELOG ENTRIES FOR 2000 IN "ChangeLog.2000"             ***
	*** CHANGELOG ENTRIES FOR 1999 AND EARLIER IN "ChangeLog.1999" ***
	******************************************************************

Changes to README.md.

1
2
3

4
5
6
7
8



9
10
11
12
13
14
15
1
2

3
4
5
6
7

8
9
10
11
12
13
14
15
16
17


-
+




-
+
+
+







# README:  Tcl

This is the **Tcl 9.0a2** source distribution.
This is the **Tcl 8.5.19** source distribution.

You can get any source release of Tcl from [our distribution
site](https://sourceforge.net/projects/tcl/files/Tcl/).

[![Build Status](https://travis-ci.org/tcltk/tcl.svg?branch=master)](https://travis-ci.org/tcltk/tcl)
[![Build Status](https://github.com/tcltk/tcl/workflows/Linux/badge.svg?branch=core-8-5-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Linux%22+branch%3Acore-8-5-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/Windows/badge.svg?branch=core-8-5-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22Windows%22+branch%3Acore-8-5-branch)
[![Build Status](https://github.com/tcltk/tcl/workflows/macOS/badge.svg?branch=core-8-5-branch)](https://github.com/tcltk/tcl/actions?query=workflow%3A%22macOS%22+branch%3Acore-8-5-branch)

## Contents
 1. [Introduction](#intro)
 2. [Documentation](#doc)
 3. [Compiling and installing Tcl](#build)
 4. [Development tools](#devtools)
 5. [Tcl newsgroup](#complangtcl)
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
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







-
+









-
-
+
+







anything you like with it, such as modifying it, redistributing it,
and selling it either in whole or in part.  See the file
`license.terms` for complete information.

## <a id="doc">2.</a> Documentation
Extensive documentation is available at our website.
The home page for this release, including new features, is
[here](https://www.tcl.tk/software/tcltk/9.0.html).
[here](https://www.tcl.tk/software/tcltk/8.5.html).
Detailed release notes can be found at the
[file distributions page](https://sourceforge.net/projects/tcl/files/Tcl/)
by clicking on the relevant version.

Information about Tcl itself can be found at the [Developer
Xchange](https://www.tcl-lang.org/about/).
There have been many Tcl books on the market.  Many are mentioned in
[the Wiki](https://wiki.tcl-lang.org/_/ref?N=25206).

The complete set of reference manual entries for Tcl 9.0 is [online,
here](https://www.tcl-lang.org/man/tcl9.0/).
The complete set of reference manual entries for Tcl 8.5 is [online,
here](https://www.tcl-lang.org/man/tcl8.5/).

### <a id="doc.unix">2a.</a> Unix Documentation
The `doc` subdirectory in this release contains a complete set of
reference manual entries for Tcl.  Files with extension "`.1`" are for
programs (for example, `tclsh.1`); files with extension "`.3`" are for C
library procedures; and files with extension "`.n`" describe Tcl
commands.  The file "`doc/Tcl.n`" gives a quick summary of the Tcl

Changes to changes.

7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245

7246
7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
7258
7259
7260
7261
7262
7263
7264
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288
7289
7290
7291
7292
7293
7294
7295
7296
7297
7298

7299
7300
7301

7302
7303
7304
7305
7306

7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379

7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400
7401

7402
7403

7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420
7421
7422
7423
7424
7425
7426
7427
7428
7429
7430
7431
7432
7433
7434
7435
7436
7437

7438
7439
7440
7441
7442

7443
7444
7445
7446
7447
7448
7449

7450
7451
7452
7453
7454
7455
7456
7457
7458
7459
7460
7461
7462
7463
7464
7465
7466
7467
7468
7469
7470
7471
7472
7473
7474
7475
7476
7477
7478
7479
7480
7481
7482
7483
7484
7485
7486
7487
7488
7489
7490
7491
7492
7493
7494
7495
7496
7497
7498
7499
7500
7501
7502

7503
7504

7505
7506

7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519
7520
7521

7522
7523
7524

7525
7526

7527
7528
7529

7530
7531
7532
7533
7534
7535
7536
7537
7538
7539
7540
7541
7542
7543
7544
7545
7546
7547
7548
7549
7550
7551
7552
7553
7554
7555
7556
7557
7558
7559
7560
7561
7562
7563
7564
7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577
7578
7579
7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629

7630
7631

7632
7633

7634
7635
7636
7637
7638

7639
7640
7641


7642
7643
7644
7645
7646
7647

7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671

7672
7673

7674
7675

7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688

7689
7690

7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706

7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732
7733
7734
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
7769
7770
7771
7772
7773

7774
7775
7776

7777
7778
7779
7780

7781
7782
7783
7784
7785

7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799


7800
7801
7802
7803
7804
7805
7806
7807
7808
7809
7810
7811
7812
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822

7823
7824
7825
7826

7827
7828
7829
7830

7831
7832
7833
7834

7835
7836
7837
7838
7839

7840
7841
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883

7884
7885
7886
7887
7888
7889
7890
7891
7892

7893
7894
7895

7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916
7917
7918
7919
7920
7921

7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936


7937
7938

7939
7940


7941
7942
7943
7944



7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957

7958
7959
7960
7961
7962
7963
7964
7187
7188
7189
7190
7191
7192
7193



7194
7195
7196
7197


7198
7199
7200
7201
7202
7203






7204
7205
7206
7207
7208
7209
7210
7211








7212
7213
7214
7215


7216
7217
7218
7219
7220
7221
7222
7223

7224




7225
7226
7227
7228
7229



7230
7231


7232
7233




7234
7235
7236
7237











7238
7239
7240
7241
7242
7243
7244









7245
7246


7247


7248


7249

7250
7251
7252




7253
7254
















7255
7256






























7257
7258








7259
7260



7261





7262
7263
7264
7265







7266
7267
7268
7269
7270

7271
7272

7273




7274
7275
7276





7277
7278










7279
7280


7281
7282
7283



7284


7285


7286

7287





7288
7289





7290
7291








7292
7293
7294
7295
7296
7297




7298
7299


7300
7301






7302
7303
7304
7305


7306
7307


7308
7309
7310
7311

7312
7313

7314
7315

7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330

7331

7332

7333
7334

7335

7336

7337
7338
7339
7340




7341
7342
7343
7344
7345
7346
7347
7348
7349








7350
7351








7352
7353






7354
7355
7356
7357
7358
7359
7360
7361




7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377




7378
7379



7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392




7393
7394
7395

7396
7397

7398
7399

7400
7401
7402
7403
7404

7405
7406
7407
7408
7409
7410
7411
7412
7413



7414











7415
7416
7417
7418


7419
7420
7421
7422



7423
7424

7425
7426

7427
7428
7429
7430
7431
7432




7433
7434
7435

7436
7437

7438
7439










7440
7441



7442












7443
7444
7445
7446




7447
7448


7449
7450
7451
7452



7453
7454












7455
7456
7457
7458
7459
7460
7461


7462

7463
7464
7465
7466
7467
7468
7469
7470



7471
7472


7473

7474


7475


7476


7477

7478












7479
7480




















7481


7482

7483


7484

7485


7486

7487


7488

7489



7490





























7491
7492
7493








7494
7495


7496

7497
7498
7499
7500
7501



7502
7503


7504





7505
7506
7507
7508
7509
7510
7511







7512
7513
7514
7515
7516


7517

7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529


7530
7531
7532

7533
7534

7535
7536
7537
7538
7539
7540
7541
7542
7543
7544
7545
7546
7547









7548
7549
7550
7551
7552
7553
7554
7555







-
-
-




-
-






-
-
-
-
-
-








-
-
-
-
-
-
-
-




-
-








-
+
-
-
-
-





-
-
-


-
-


-
-
-
-




-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
+

-
-
+
-
-

-
-
+
-



-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-


-
-
-
+
-
-
-
-
-




-
-
-
-
-
-
-





-
+

-
+
-
-
-
-



-
-
-
-
-


-
-
-
-
-
-
-
-
-
-


-
-



-
-
-
+
-
-

-
-
+
-

-
-
-
-
-
+

-
-
-
-
-


-
-
-
-
-
-
-
-






-
-
-
-


-
-


-
-
-
-
-
-




-
-


-
-




-
+

-
+

-
+














-
+
-

-
+

-
+
-

-
+



-
-
-
-









-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-


-
-
-
-
-
-








-
-
-
-
















-
-
-
-


-
-
-













-
-
-
-



-
+

-
+

-
+




-
+



+
+



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




-
-




-
-
-
+

-
+

-
+





-
-
-
-



-
+

-
+

-
-
-
-
-
-
-
-
-
-


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




-
-
-
-


-
-




-
-
-


-
-
-
-
-
-
-
-
-
-
-
-







-
-

-








-
-
-
+

-
-
+
-

-
-
+
-
-

-
-
+
-

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

-
-
+
-

-
-
+
-

-
-
+
-

-
-
+
-

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



-
-
-
-
-
-
-
-


-
-
+
-





-
-
-
+

-
-
+
-
-
-
-
-







-
-
-
-
-
-
-





-
-
+
-












-
-
+
+

-
+

-
+
+




+
+
+




-
-
-
-
-
-
-
-
-
+








2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny)

--- Released 8.5.2, March 28, 2008 --- See ChangeLog for details ---

2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin)

2008-04-01 (interface)[1819422] tclStubsPtr no longer in libtcl (porter)
	*** POTENTIAL INCOMPATIBILITY ***

2008-04-01 (bug fix)[1839067] FP round fix for Solaris/x86 (kupries,schlenker)

2008-04-02 (bug fix)[780533,1932639] [fcopy] callbacks unreliable (ferrieux)

2008-04-02 (interface)[1819422] libtclstub symbols MODULE_SCOPE (steffen)

2008-04-04 (bug fix) [chan postevent] crash (kupries)

2008-04-07 (bug fix) Fix broken [format {% d}] (max)

2008-04-07 (bug fix)[1350564] Bi-directional [fcopy] now supported (ferrieux)

2008-04-16 (bug fix)[1938497] Tcl_SetNotifier() fixes (steffen)

2008-04-16 (interface)[1938497] make stubs tables 'static const' (steffen)

2008-05-02 (new feature) [binary] is now a [namespace ensemble] (thoyts)

2008-05-07 (bug fix) [dict append] crash (mccormack,fellows)

2008-05-21 (bug fix)[1968882] [info complete "\\\n"] => 0 (porter)

2008-05-22 (bug fix)[1968245] Tcl_LogCommandInfo() accept length=-1 (darroch)

2008-05-23 (bug fix)[1965787] 32-bit overflow in [tell] result (ferrieux)

2008-05-31 (new feature)[TIP 257]  [oo::*] commands from TclOO (fellows)

2008-06-04 (new feature)[TIP 317] [binary encode]; [binary decode] (thoyts)

2008-06-06 (new feature)[TIP 230] [chan push]; [chan pop] (kupries)

2008-06-08 (enhancement)[1973096] bytecompiled [uplevel] scripts (sofer)

2008-06-12 (platform support) Solaris static build with DTrace (steffen)

2008-06-12 (platform support) Solaris/amd64 gcc 64bit support (steffen)

2008-06-13 (new feature)[TIP 285] [interp cancel]; Tcl_CancelEval() (mistachkin)

2008-06-20 (bug fix)[1999035] make [interp bgerror $i] act in $i (porter)

2008-06-23 (bug fix)[1972879] bad path intrep caching (porter)

2008-06-24 (bug fix)[1999176] crash in [glob -dir {} a] (porter)

2008-06-25 (bug fix)[1999119] Support TM packages in Safe Base (kupries)

--- Released 8.6a1, June 25, 2008 --- See ChangeLog for details ---
--- Released 8.5.3, June 30, 2008 --- See ChangeLog for details ---

2008-06-29 (bug fix)[2004480] plug memory leaks (ade,porter,steffen)

2008-07-01 (enhancement)[1905562] embed recursion limit in RE engine (fellows)

2008-07-03 (bug fix)[1969717] fix package finding on Samba shares (jos)

2008-07-03 (bug fix)[1987821] mem leak in [seek] on reflected chan (kupries)

2008-07-13 (enhancement)[2017110] new Non-Recursive Evaluation implementation
enables deep Tcl evaluation stacks without deep C stacks. (sofer)

2008-07-20 (enhancement)[2008248] dict->list preserve item intreps (pasadyn)

2008-07-21 (bug fix)[582506] imported cmds now fire execution traces (sofer)

2008-07-21 (bug fix)[2015723] [file] bad use of inodes on Windows (thoyts)

2008-07-21 (new feature)[TIP 304] [chan pipe] (ferrieux)

2008-07-21 (bug fix)[2021443] more consistent "wrong # args" msgs (nijtmans)

2008-07-21 (enhancement) [info frame] returns file data in more cases (kupries)

2008-07-29 (bug fix)[2030670] fix rare panic in TclStackFree (pasadyn,sofer)

2008-08-01 Tcl_Finalize() no longer called implicitly on DLL_PROCESS_DETACH.

2008-08-05 (enhancement)[1994512] async connect logic simplified (jenglish)

2008-08-06 (bug fix)[2040295] stopped supplying a workaround for bugs
in Itcl's use of [namespace code].  Itcl now supplies its own workaround.
	*** POTENTIAL INCOMPATIBILITY for older Itcl releases ***

2008-08-06 (bug fix)[2039178] repaired guard against dispatching oo methods
in a deleted interp. (porter)

2008-08-08 tzdata updated to Olson's tzdata2008e (kenny)

2008-08-11 (bug fix)[2046846] 64bit support for http zlib crc (thoyts)
=> http 2.7.1

2008-08-11 (enhancement) automatic [package provide] for TMs (kupries)

2008-08-17 (bug fix)[2055782] crash involving Tcl_ConcatObj (sofer)

2008-08-21 (new feature) CONST-ified Tcl routines passing (Tcl_ObjType *),
(Tcl_Filesystem *), or (Tcl_Timer *) arguments (nijtmans,porter)
	*** POTENTIAL INCOMPATIBILITY ***

2008-08-21 (bug fix)[2065115] Restored ***= regexp functioning (hobbs,porter)

--- Released 8.6a2, August 25, 2008 --- See ChangeLog for details ---
--- Released 8.5.4, August 15, 2008 --- See ChangeLog for details ---

2008-08-29 (bug fix)[2082299] Install TclOO header files (fellows)

2008-08-14 (bug fix)[2055782] fix crash in [namespace inscope] (sofer)
2008-09-01 oo methods called during interp deletion no longer skipped if
they do not need the dying interp (fellows)

2008-09-02 (support) Dropped support for pre-ANSI compilers.  (porter)

2008-08-21 (bug fix)[2065115] correct handling of ***= RE's (hobbs,porter)
2008-09-04 (bug fix)[2093947] var unset trace in coroutine (fellows,sofer)

2008-09-10 (enhancement) efficient list->dict conversion (elby,fellows)

2008-09-10 (bug fix)[2102930] faulty numLevels count (madden,sofer)

2008-09-16 (bug fix)[2114165] eval failure following cancel (sofer)

2008-09-17 (bug fix)[2116053] export [min] and [max] from tcl::mathfunc (sofer)

2008-09-22 (new feature)[TIP 320] oo common variable declaration (fellows)

2008-09-24 (new feature)[TIP 316] portable access to Tcl_StatBuf (fellows)

2008-09-24 (new feature)[TIP 323] [file delete], [file mkdir] zero pathNames (porter)

2008-09-25 (new feature)[TIP 315] new var: tcl_platform(pathSeparator) (vu,fellows)

2008-09-25 (new feature)[TIP 323] [global], [variable] zero varNames (porter)

2008-09-26 (new feature)[TIP 323] [lassign], [namespace upvar], [my variable] zero varNames (porter)

2008-09-26 (new feature)[TIP 323] [tcl::tm::path add|remove] zero pathNames (porter)

2008-09-26 (new feature)[TIP 323] [lrepeat] zero elements; zero repeats (porter)

2008-09-27 (bug fix)[2130992] prevent overflow crash in [lrepeat] (fellows)

2008-09-28 (new feature)[TIP 314] ensemble parameters before subcommand (hellström,fellows)

2008-09-29 (new feature)[TIP 318] revised defaults for [string trim] (poser)
	*** POTENTIAL INCOMPATIBILITY ***

2008-09-29 (new feature)[TIP 313] [lsearch -bisect] (spjuth)

2008-09-29 (new feature)[TIP 326] [lsort -stride] (elby)

2008-09-29 (new feature)[TIP 323] [linsert] zero elements (porter)

2008-09-29 (new feature)[TIP 323] [glob] zero patterns (porter)

2008-10-02 (new feature)[TIP 330] interp->result access disabled (kenny)
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-03 (new feature)[TIP 265] Tcl_ParseArgv() (bromley)

2008-10-03 (new feature)[TIP 195] [tcl::prefix] (spjuth)

2008-10-04 (new feature) CONST-ified Tcl routines Tcl_GetIndexFromObj,
Tcl_RegisterConfig, Tcl_InitCustomHashTable, and routines passing
(Tcl_ChannelType *). (nijtmans)
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-04 (bug fix)[2059262] unload only libraries marked unloadable (nijtmans)
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-05 (new feature)[TIP 331] [lset listVar end+1 $value] (kenny)

2008-10-05 (bug fix)[2143288] correct bad isqrt() results (boffey,kenny)

2008-10-05 (new feature) CONST-ified return value of the
Tcl_FSFileAttrStringsProc prototype. (nijtmans)
	*** POTENTIAL INCOMPATIBILITY for Tcl_Filesystems ***

2008-10-07 (new feature)[TIP 327] [tailcall] (sofer)

2008-10-07 (new feature)[TIP 328] [coroutine],[yield],[info coroutine] (sofer)

2008-10-08 (bug fix)[2151707] fix stack trace from variable trace (porter)

2008-10-10 (bug fix)[2155658] crash in oo method export (fellows)

--- Released 8.6a3, October 10, 2008 --- See ChangeLog for details ---
--- Released 8.5.5, October 15, 2008 --- See ChangeLog for details ---

2008-10-13 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts)

2008-10-23 (bug fix)[2186888] Direct-eval [for] handling of [continue] was
broken by NRE reform (sofer,porter)

2008-10-24 (bug fix) fix failure to read SHOUTcast streams (thoyts)
=> http 2.7.2

2008-10-27 (enhancement) system encoding at startup is now "iso8859-1", and
no longer "identity".  Use of identity encoding minimized (porter)
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-31 (bug fix)[2200824] revised [oo::define] to include caller
context when resolving names. (nassau,fellows)

2008-11-10 (bug fix)[2255235] [platform::shell::LOCATE] update (ring,kupries)
=> platform::shell 1.1.4

2008-11-13 (bug fix)[2269431] VFS [load] -> tempfile litter (ficicchia,nijtmans)

2008-11-26 (bug fix)[2114900] updated tclIndex file (cassoff,kenny)
2008-11-30 (bug fix)[2362156] [clock]: colon in format string (mizuno,kenny)

2008-11-27 (bug fix)[2251175] [{*}{\{}] errors (hellström,ferrieux,porter)
2008-12-01 (bug fix)[2251175] [{*}{\{}] errors (hellström,ferrieux,porter)

2008-11-29 (new feature)[TIP 210] [file tempfile] (techentin,fellows)

2008-11-30 (bug fix)[2362156] [clock]: colon in format string (mizuno,kenny)

2008-12-02 (bug fix)[2270477] hang in channel finalization (ferrieux,kupries)

2008-12-02 (new feature)[TIP 336] Tcl_*ErrorLine() routines.  Direct access
to the errorLine field of the interp struct denied by default. (porter)
	*** POTENTIAL INCOMPATIBILITY ***
	*** Define USE_INTERP_ERRORLINE to restore access for legacy code ***

2008-12-04 (bug fix)[2385549] [file normalize] failed on some paths (porter)

2008-12-05 (new feature)[TIP 307] Tcl_TransferResult() (leunissen,fellows)

2008-12-05 (new feature)[TIP 335] Tcl_InterpActive() (mistachkin,fellows)

2008-12-09 (new feature)[TIP 337] Tcl_BackgroundException() (porter)

2008-12-10 (new feature)[TIP 341] >1 [dict filter] patterns (hellström,fellows)

2008-12-10 (new feature)[TIP 343] [format %b $n] [scan $s %b] (ferrieux)

2008-12-10 tzdata updated to Olson's tzdata2008i (kenny)

2008-12-11 (new feature)[TIP 234] [zlib] and Tcl_Zlib*() (sheffers,fellows)

2008-12-11 (bug fix)[2407783] spoil ChannelState when channel name passes
among multiple interps (kupries)

2008-12-12 (new feature)[TIP 322] Tcl_NR*() routines to enabled non-recursive
evaluation in extensions (sofer,kenny)

2008-12-21 (bug fix) Fix ability to join threads on 64-bit Windows (thoyts)
2008-12-09 (new feature)[TIP 338] Tcl_*StartupScript() (porter)
	*** POTENTIAL INCOMPATIBILITY for callers of Tcl*Startup* routines ***

2008-12-16 (new feature)[TIP 329] [try] [throw] (davel,fellows)

2008-12-21 (bug fix)[2114900] updated tclIndex file (cassoff,kenny)
2008-12-17 (new feature)[TIP 308] package tdbc 1.0b1 (kenny)

2008-12-18 (new feature)[TIP 332] [close $chan read|write] (ferrieux)

2008-12-18 (bug fix)[2444274] panic in long commands from {*} (goth,porter)

--- Released 8.6b1, December 19, 2008 --- See ChangeLog for details ---
--- Released 8.5.6, December 21, 2008 --- See ChangeLog for details ---

2008-12-27 [TIP 234] Tcl_Zlib* interface revisions (fellows)
	*** INCOMPATIBILITY with interface of 8.6b1 ***

2009-01-02 (platform support)[878333] IRIX compat for mkstemp() (fellows)

2009-01-03 (bug fix)[2481670] [clock add] error message (talvo)

2009-01-05 (bug fix)[2412068] NR-enable [source] (fellows)

2009-01-06 (bug fix)[2489836] crash unknown method dispatch (nadkarni,fellows)

2009-01-06 (bug fix)[2481109] fix context of instance name check (fellows)

2009-01-08 (enhancement) more -errorcode values (fellows)

2009-01-19 (new feature) CONFIG_INSTALL_DIR - where tclConfig.sh goes (cassoff)

2009-01-19 (platform support) better tools for BSD ports (cassoff)

2009-01-21 (bug fix)[2458202] exit crash with [chan create]d channel (kupries)

2009-01-26 (bug fix)[2446662] uniformly declare EOF on RST on sockets (ferrieux)

2009-01-26 (bug fix)[1028264] delay WSACleanup() from under our feet (ferrieux)

2009-01-29 (bug fix)[2519474] Tcl_FindCommand() bug exposed by oo (fellows)

2009-01-29 (bug fix)[2537939] Fix Tcl_OOInitStubs() for no-stubs build (fellows)

2009-02-04 (bug fix)[2561746] [string repeat] overflow crash (porter)

2009-02-05 (enhancement) optimize string operations on bytearrays (fellows)

2009-02-12 (bug fix) enable simpler [oo::define] extension (ferri,fellows)

2009-02-15 (bug fix)[2603158] Tcl_AppendObjToObj: append to self crash (porter)

2009-02-17 (platform support) MSVC and _WIN64 (hobbs)

2009-02-20 (bug fix)[2571597] [file pathtype /a] wrong result (nadkarni,porter)

2009-03-03 (bug fix)[2662434] [zlib crc32] result now unsigned (gavilan,fellows)

2009-03-15 (platform support) translate SIGINFO where defined (BSD) (teterin)

2009-03-15 (bug fix)[2687952] TSD struct memleak (mistachkin)

2009-03-18 (bug fix)[2688184] memleak in [file normalize] (mistachkin)

2009-03-20 (bug fix)[2597185] crash in Tcl_AppendStringToObj (porter)

2009-03-20 (bug fix)[2561794,2669109,2494093,2553906] string overflow (porter)
2009-03-27 (bug fix)[2710920] [file dirname|tail /foo/] errors (epler,porter)

2009-03-22 (bug fix)[2502037] NR-enable [namespace unknown] (sofer)
2009-03-30 (bug fix)[2603158] Tcl_AppendObjToObj: append to self crash (porter)

2009-03-27 (bug fix)[2710920] [file dirname|tail /foo/] errors (epler,porter)
2009-04-07 (bug fix)[2561794,2669109,2494093,2553906] string overflow (porter)

2009-04-08 (bug fix)[2570363] unsafe [eval]s in tcltest (bron,porter)
=> tcltest 2.3.1

2009-04-08 (platform support) more Darwin kernel patterns (steffen)
=> platform 1.0.4

2009-04-09 (bug fix)[26245326] [http::geturl] connection failures (golovan)
=> http 2.7.3

2009-04-10 (new feature) Darwin: embeddable CoreFoundation notifier (steffen)

2009-04-10 (bug fix)[1961211]  Darwin [load] back-compatibility (steffen)

2009-04-09 (new feature) http chunked+gzip modes (thoyts)
2009-04-14 tzdata updated to Olson's tzdata2009f (kenny)
=> http 2.8.0

2009-04-11 (enhancement) clarified cmd name resolution in oo forwards (fellows)
--- Released 8.5.7, April 15, 2009 --- See ChangeLog for details ---

20009-04-19 (bug fix)[2715421] http: excess bytes after POST (thoyts)
2009-04-27 (bug fix)[2446662] uniformly declare EOF on RST on sockets (ferrieux)
=> http 2.8.1

2009-04-30 (bug fix)[2486550] coroutine in [interp invokehidden] (sofer)
2009-04-27 (bug fix)[1028264] delay WSACleanup() from under our feet (ferrieux)

2009-05-07 (bug fix)[2785893] find command in deleted namespace (sofer)

2009-05-08 (bug fix)[2414858] tailcall in oo constructor (fellows)

2009-05-14 (new subcommand)[TIP 354] [info object namespace] (fellows)

2009-05-29 (platform support) account for ia64_32 (kupries)
=> platform 1.0.5

2009-06-02 (bug fix)[2798543] incorrect [expr] integer ** results (porter)

2009-06-10 (bug fix)[2801413] overflow in [format] (porter)

2009-06-13 (bug fix)[2802881] corrected compile env context (tasada,porter)

2009-06-17 (redesign) reduced ambition of [exit] finalization with aim to
avoid otherwise very tricky multi-thread finalization bugs. (staplin,ferrieux)
	*** POTENTIAL INCOMPATIBILITY for exit handlers ***

2009-06-26 (platform support) updates for Xcode 3.1 & 3.2 (steffen)

2009-06-30 (platform support) clang static analyzer macros (steffen)

2009-07-01 (bug fix)[2806622] Win: bad tcl_platform(user) value (thoyts)

2009-07-05 (bug fix) zlib support asynch [chan copy] on chan transform (fellows)

2009-07-12 (bug fix)[1895546] TclOO support for Itcl 4 method caching (fellows)

2009-07-13 (bug fix)[1605269] NR-related [info frame] fixes (kupries)

2009-07-14 (bug fix)[2821401] NR-enable direct eval [switch] (kenny)

2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter)

2009-07-19 (interface)[TIP 354] new routine Tcl_GetObjectName() (fellows)

2009-07-20 (performance) favor [string is] success cases over empty (fellows)

2009-07-22 (interface) removed TclpPanic() routine (nijtmans)

2009-07-23 (bug fix)[2820349] plug event leak in notifier (mistachkin)

2009-07-24 (bug fix)[2826248] crash in Tcl_GetChannelHandle (sonnenburg,kupries)

2009-07-31 (bug fix)[2830354] overflow in [format] (misch,porter)

2009-08-06 (bug fix)[2827000] reflected channels can signal EGAIN (kupries)

2009-08-12 (new feature)[TIP 353] Tcl_NRExprObj() (porter)

2009-08-20 (bug fix)[2823276] NR-enable [if], [for], [while] (fellows)

2009-08-20 (bug fix)[2806250] EIAS violation in ~foo pathnames (porter)

2009-08-21 (bug fix)[2837800] [glob */foo] return ./~x/foo (porter)

2009-08-24 (bug fix) nested event loop notifier w/TkAqua Cocoa (alaoui,steffen)

2009-08-25 (bug fix) [info frame] account for continuation lines (kupries)

2009-08-27 (bug fix)[2845535] overflows in [format] (porter)

2009-09-01 (bug fix) improved error message in tcltest (porter)
=> tcltest 2.3.2

2009-09-11 (bug fix)[2849860] http handle "quoted" charset value (fellows)
=> http 2.7.4

2009-09-11 (enhancement)[2314561] [subst] now bytecompiled, NR-enabled (porter)

2009-09-24 (new feature)[TIP 356] Tcl_NRSubstObj() (porter)

2009-10-04 (bug fix)[2569449] Core Foundation memory bug in Tiger (steffen)

2009-10-06 (bug fix) repair intrep loss in slave interp evaluations
introduced by first versions of the NRE conversion (nadkarni,porter)

2009-10-06 (bug fix)[1941434] broken tclTomMath.h includes (porter)

2009-10-07 (bug fix)[2871908] leaked hash table (mistachkin,kupries)

2009-10-08 (bug fix)[2874678] bignum leak in [dict incr] (fellows)

2009-10-17 (bug fix)[2629338] crash in var unset traces (raney,fellows)

2009-10-19 (bug fix)[2107634] extend [read] and [gets] to Tcl string limits
(morrison,parker,porter)

2009-10-21 (bug fix)[2882561] Haiku OS signal support (morrison,fellows)

2009-10-22 (bug fix)[2883857] [my varname arr(index)] (boudaillier,fellows)

2009-10-23 (bug fix) 0-length writes: spurious SIG_PIPE (teterin,kupries)

2009-10-24 Broken DST applied EU rules to US zones (lehenbauer,kenny)

2009-10-29 (bug fix)[2800740] halved bignum memory on 64-bit systems (porter)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2009-11-05 (bug fix)[2854929] TM search path support in Safe Base (kupries)
2009-11-03 tzdata updated to Olson's tzdata2009q (kenny)

2009-11-05 (enhancement) rewrite of the Safe Base commands (kupries)
2009-11-03 (bug fix)[2854929] TM search path support in Safe Base (kupries)

2009-11-11 (bug fix)[2888099] [close] loses ENOSPC error (khomoutov,ferrieux)

2009-11-11 (bug fix)[2891171] RFC 3986 compliance for ? in URL (nijtmans)
=> http 2.8.2
=> http 2.7.5

2009-11-12 (bug fix)[2895565] [fcopy -size] miscounts when converting encodings
(kupries)

--- Released 8.5.8, November 16, 2009 --- See ChangeLog for details ---

2009-11-16 (bug fix)[2891556] encoding finalization crash (mistachkin,ferrieux)

2009-11-18 (bug fix)[2849797] consistent names for std chans (nijtmans,fellows)
        *** POTENTIAL INCOMPATIBILITY ***

2009-12-09 (enhancement) rewrite of the Safe Base commands (kupries)
2009-11-19 (enhancement) [load]able Tcltest extension (nijtmans)

2009-11-24 (bug fix)[2893771] [file stat] on Win locked files (thoyts)

2009-11-24 (bug fix)[2903011] crash call destructor from constructor (fellows)

2009-12-03 (bug fix)[2906841] Safe Base [glob ../*] fixes (fellows)

2009-12-09 (bug fix)[2901998] consistent I/O buffering (ferrieux,kupries)

2009-12-11 (bug fix)[2806407] NR-enabled coroutines (sofer)

2009-12-16 (bug fix)[2913616] msgcat: improved safe interp support (fellows)
=> msgcat 1.4.3

2009-12-22 (bug fix)[2918962] [lsort -index -stride] crash (moore,fellows)

2009-12-23 (bug fix)[2913625] [info script/nameof] in safe interps (fellows)

2009-12-28 (bug fix)[2891362] enable time limit in child interps (fellows)

2009-12-29 (bug fix)[2922555] [binary decode hex { }] crash (thoyts)

2009-12-29 (bug fix)[2895741] enable min(), max() in safe interps (fellows)
2009-12-28 (bug fix)[2895741] enable min(), max() in safe interps (fellows)

2009-12-30 (bug fix)[2824981] guard [unknown] against [set] undef (sofer)
2010-01-05 (bug fix)[2918610] [file rootname] corruption (magerya,porter)

2010-01-05 (bug fix)[2918610] [file rootname] corruption (magerya,porter)
2010-01-06 (enhancement) Haiku, CYGWIN support improvements (nijtmans)

2010-01-18 (bug fix)[2932421] less [format %s] shimmer (ferrieux)

2010-01-18 (bug fix)[2918110] [chan postevent] crash (bron,kupries)

2010-01-21 (bug fix)[2910748] NR-enable epoch fallback direct eval (sofer)

2010-01-30 (enhancement) [unset] now bytecompiled (fellows)

2010-02-01 (bug fix)[2942697] faster match: some pathological regexp patterns
(lane,fellows)

2010-02-01 (bug fix)[2939073] [array unset] unset trace crash (ferrieux)
2010-02-02 (bug fix)[2939073] [array unset] unset trace crash (ferrieux)

2010-02-02 (bug fix)[2944404] crash in oo destructor (fellows)
2010-02-02 (bug fix)[2933089] [info frame] shared lit trouble (kupries)

2010-02-02 (new feature) [array] is now a [namespace ensemble] (fellows)

2010-02-05 (enhancement) [error] now bytecompiled (fellows)

2010-02-08 (bug fix)[2947783] Tcl_Zlib*flate fail on shared values (fellows)

2010-02-09 (enhancement) [try] now bytecompiled (fellows)

2010-02-11 (bug fix)[2826551] line-sensitive matching in regexp (dejong)

2010-02-11 (bug fix)[2949740] [open |noSuch rb] crash (kovalenko,fellows)

2010-02-15 (bug fix)[2950259] harden (delete obj ns -> delete obj) (fellows)

2010-02-21 (bug fix)[2954959] get sign of abs($zero) right (nijtmans)
2010-02-11 (bug fix)[2954959] get sign of abs($zero) right (nijtmans)

2010-02-22 (bug fix)[2762041] zlib chan transforms read EOF too early (kupries)

2010-02-27 (bug fix)[801429] Tcl_SetMainLoop() thread safety (fellows)
        *** POTENTIAL INCOMPATIBILITY ***

2010-03-02 (enhancement) -fvisibility-hidden build support (nijtmans)

2010-03-04 (bug fix)[2962664] [oo::class destroy] crash (fellows)

2010-03-05 (interface) TclOO typedefs for function pointers (fellows)
        *** POTENTIAL INCOMPATIBILITY ***

2010-03-09 (bug fix)[2936225] stop [chan copy] to slow channel consuming all
memory with buffer backup (ferrieux)

2010-03-17 (bug fix)[2921116] crash in chan transfrom teardown (kupries)

2010-03-19 (enhancement) [throw] now bytecompiled (fellows)

2010-03-20 (enhancement) permit [fcopy] of > 2**31 bytes (fellows)

2010-03-24 (new feature) [info object methodtype] (fellows)

2010-03-24 (bug fix)[2383005] [return -errorcode] reject non-list (porter)

2010-03-25 (bug fix)[2976504] broken fstatfs() call (reeuwijk,fellows)

2010-03-30 (new feature)[TIP 362] [registry -32bit|-64bit] (courtney,fellows)
=> registry 1.3

2010-03-30 (bug fix)[2978773] refchan mem preservation (kupries)

2010-04-02 (new feature)[TIP 357] Tcl_LoadFile, Tcl_FindSymbol, etc. (kenny)

2010-04-05 (configure change)[TIP 364] default build: --enable-threads (fellows)
        *** POTENTIAL INCOMPATIBILITY ***

2010-04-02 (new feature)[TIP 348] [info errorstack], [return -errorstack]
(ferrieux)

2010-04-20 (enhancement) update bundled zlib to 1.2.5 (nijtmans)

2010-04-29 (enhancement)[2992970] optimize bytearray appends (fellows)

2010-05-19 (bug fix)[3004007] dict/list shimmer w/o string rep loss (fellows)

2010-06-09 (bug fixes) platform: several fixes for 64 bit systems (kupries)
=> platform 1.0.9

2010-06-16 (bug fix)[3016135] [clock format] in he_IL locale (nijtmans)

2010-06-18 (bug fix)[3017997] Add .cmd to file extensions for [exec] (fellows)

2010-06-28 (bug fix)[3019634] support errno.h changes in MSVC++ 2010 (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2010-07-02 (enhancement) -errorcode for [expr] domain errors (fellows)

2010-07-28 (bug fix)[3037525] crash deleting vars @ callframe pop (sofer)

2010-08-04 (bug fix)[3034840] mem corrupt when refchan loses interp (kupries)

2010-08-04 (enhancement) Win [load] use LOAD_WITH_ALTERED_SEARCH_PATH (hobbs)

2010-08-04 (platform support) panic on detection of win9x system (hobbs)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2010-08-10 (fix) Handle non-null-terminated bytearrys in glob matching (hobbs)

2010-08-12 (bug fix)[2826551] line-sensitive matching in regexp (dejong)
2010-08-11 (fix) copy-paste bug in [yield] implementation (sofer, goth)

2010-08-11 (platform) Drop pre-aix 4.2 support, ldAix (hobbs)

2010-08-19 (bug fix)[3048354] buffer overflow detect in Fortify build (fellows)
2010-08-14 (frq)[2819611] changed signatures of hash fnctions, delete-file, and get-native-path (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2010-08-15 (bug fix)[3045010] tweaked error message for wrong#args of lambda's (fellows)

2010-08-23 tzdata updated to Olson's tzdata2010l (kenny)
2010-08-18 (bug fix)[3004191] fixed safe [glob] (fellows)

2010-08-21 (patch)[3034251] genStubs steal features of ttkGenStubs (nijtmans)

2010-08-26 (bug fix)[1230554] configure, OSF-1 problems, windows manifest issues (hobbs)

2010-08-30 (bug fix) [3046594,3047235,3048771] reimplemented tailcall (sofer)

2010-08-31 fixed manifest handling on windows (hobbs, kupries)

2010-08-31 windows makefile and stub changes (nijtmans)

2010-09-01 (bug fix)[3057639] compiled lappend trace consistency (hobbs,kupries)
        *** POTENTIAL INCOMPATIBILITY ***
2010-09-01 (bug fix)[3057639] no read traces [lappend arr(elem) ...] (hobbs)
	*** POTENTIAL INCOMPATIBILITY ***

2010-09-01 fixed safe glob handling of -directory (kupries)

2010-09-02 fixed safe glob handling of -join (kupries)

2010-09-08 (bug fix)[3059922] build with mingw on amd64 (porter, mescalinum)

2010-09-15 (bug fix)[3067036] stop hang in bytearray append (fellows)

2010-09-22 unified set of link libraries between mingw and vc (nijtmans)

2010-09-22 (bug fix)[3072640] protect writes to ::error* variables (sofer)

2010-09-23 fix leak of return options [catch $err m constant] (porter, hobbs)

2010-09-24 (bugfix)[3056775] fixed race condition in windows sockets (kupries)

2010-09-24 (performance) string eq/cmp (hobbs)

2010-09-26 (patch)[3072080] rewritten NRE core (sofer)

2010-09-28 (new feature)[TIP 162] implementation of ipv6 sockets (max)

--- Released 8.5.9, September 8, 2010 --- See ChangeLog for details ---
2010-10-02 (bug fix)[3079830] properly invalidate string rep of dicts (fellows)

2010-10-06 (bug fix)[3081065] fix writing to freed Tcl_Obj (porter)

2010-09-24 (bug fix)[3056775] race condition in Win sockets (twylite,kupries)
2010-10-08 fix in ipv6 code on windows (nijtmans)

2010-10-09 fixed overallocation of execution stack (sofer)

2010-10-23 (update)[3085863] Update Unicode data to 6.0 (nijtmans)
2010-10-11 windows unicode changes (nijtmans)

2010-10-12 (bug fix)[3084338] fixed meamleak in ipv6 code (max)

2010-11-02 Safe Tcl handling of empty path lists (cassoff)
2010-10-13 (bug fix)[467523,983660] alt fix allows empty literal share (porter)

2010-10-15 (bugfix)[3085863] updated unicode tables (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2010-11-03 (bug fix)[3098302] crash in compiled [catch] (kenny)
2010-10-16 refactored implementation of dict iteration (fellows)

2010-10-17 (patch)[2995655] report inner contexts on error stack (ferrieux)

2010-10-19 (bug fix)[3081008] fixed bytearray zlib interaction (fellows)

2010-10-19 improved crc, appending to bytearray (fellows)

2010-10-20 improved compilation of [dict for] (fellows)

2010-10-26 Added private support to disable reverse dns (max)

2010-10-26 Prevent crashes when querying socket options (fellows, max)

2010-10-28 (bug fix)[3093120] prevent freeaddrinfo(NULL) (porter, virden)

2010-10-29 (bug fix)[2905784] stop cycle waste in short [after] (ferrieux)

2010-11-01 tzdata updated to Olson's tzdata2010o (kenny)

2010-11-04 (bug fix)[3099086] Clarified docs of var substitution (fellows)

2010-11-04 improved install targets (cassof)

2010-11-04 improved testing of sockets (max)

2010-11-05 (frq)[491789] setargv/unicode cmdline for MSVC (nijtmans)

2010-11-09 (bug fix)[3105999] fixed memleak in OO var resolver (fellows)

2010-11-15 (TIP 378)[3081184] improved TIP 280 performance (kupries)

2010-11-16 (platform) VS 2005 SP1 MSVC compiler (nijtmans)

2010-11-18 (bug fix)[3111059] leak in [namespace delete] w coroutines (sofer)

2010-11-28 [3120139,3105247] Tcl_PrintDouble improvements (kenny)

2010-11-29 (new cmd) [tcl::unsupported::inject] (ferrieux,sofer)

2010-11-30 (enhancement) Restore TclFormatInt for performance (hobbs)

2010-12-09 (new feature) [file] is now a [namespace ensemble] (fellows)

2010-11-30 (enhancement) Tcl_PrintDouble performance improvements (kenny)
2010-12-19 (bug fix) [fcopy -size 1 -command] asynchronous (ferrieux)

2010-12-12 (platform) OpenBSD build improvements (cassoff)

2010-12-17 (platform) Revisions to support rpm 4.4.2 (cassoff)

2010-12-27 (bug fix) crash in [lsort] w multiple -index options (fellows)

2010-12-30 (bug fix)[3142026] GrowEvaluationStack OBOE (harder,sofer)
2011-01-13 (bug fix)[3142026] GrowEvaluationStack OBOE (harder,sofer)

2011-01-18 (bug fix)[3001438] [info frame -1] crash (mccormack,fellows)

2011-01-19 (bug fix)[3072640] protect writes to ::error* variables (sofer)
2011-03-01 (performance)[3168398] optimize [interp cancel] (mistachkin)

2011-03-05 (bug fix)[3185009] crash in OO variables (danckaert,fellows)

2011-03-05 (new cmd) [tcl::unsupported::assemble] (ugurlu,kenny)

2011-03-06 (bug fix)[3200987,3192636] parser buffer overruns (porter)

2011-03-08 (bug fix)[3202905] failed intrep release of interp result (mccormack)

2011-03-09 (bug fix)[3202171] repair [namespace inscope] optimizer (porter)

2011-03-10 (new version) better tcltest reporting from child interps (fellows)
=> tcltest 2.3.3

2011-03-10 (new feature) [namespace] is now a [namespace ensemble] (fellows)

2011-03-12 (interface) reduce casting by ckalloc(), ckfree() callers (fellows)

2011-03-14 (bug fix) Fixes from libtommath 0.42.0 release (fellows)

2011-03-21 (bug fix)[3216070] [load] extension from embed Tcl apps (nijtmans)
	***POTENTIAL INCOMPATIBILITY***

2011-03-27 (performance) NRE: LIST lset foreach benchmark (twylite)

2011-04-12 (bug fix)[3285472] intrep corruption in [string reverse] (porter)
2011-04-11 (bug fix)[3282869] coroutine + eval + locals crash (ferrieux,sofer)

2011-04-13 (bug fix)[2662380] crash when variable append trace unsets (sofer)

2011-04-13 (bug fix)[3285375] Buffer overflow in [concat] (porter)

2011-05-02 (internals change) revised TclFindElement() interface (porter)
	*** POTENTIAL INCOMPATIBILITY ***

2011-05-05 (enhancement) dict->list w/o string rep generation (porter)

2011-05-10 (bug fix)[3173086] Crash parsing long lists (rogers,porter)

2011-05-24 (enhancement) msgcat internal improvements (fellows)
=> msgcat 1.4.4
2011-05-12 (bug fix)[2715421] surplus \n in POST (passadyn,thoyts)
=> http 2.7.6

2011-05-25 (TIP 381) [info object|class call] [self call] [nextto] (fellows)
2011-05-24 tzdata updated to Olson's tzdata2011g (iyer)

2011-05-31 (bug fix)[3293874] let lists grow all the way to the limit (porter)
2011-05-25 (enhancement) msgcat internal improvements (fellows)
=> msgcat 1.4.4

2011-06-02 (bug fix)[3185407] cmd resolution epoch flaw (nadkarni,fellows)

2011-06-13 (bug fix)[3315098] mem leak generating double string rep (neumann)

2011-06-21 (new cmd) [tcltest::loadIntoSlaveInterpreter] (fellows)
=> tcltest 2.3.3

2011-06-22 (new feature) DEB_HOST_MULTIARCH support (kupries)
=> platform 1.0.10

2011-07-15 (bug fix)[3357771] Prevent circular refs in bytecode (porter)

2011-07-28 tzdata updated to Olson's tzdata2011h (porter)

2011-08-01 (bug fix)[3383616] memleak exposed by XOTcl (neumann,sofer)

Many more Tcl built-in command errors now set an -errorcode.

--- Released 8.6b2, August 8, 2011 --- See ChangeLog for details ---
--- Released 8.5.10, June 23, 2011 --- See ChangeLog for details ---

2011-07-02 (bug fix)[3349507] correct double(1[string repeat 0 23]) (kenny)

2011-07-19 (bug fix)[3371644] Tcl_ConvertElement() segfault (sader, ferrieux)

2011-07-21 (bug fix)[3372130] hypot(.) segfault (nijtmans)

7972
7973
7974
7975
7976
7977
7978
7979
7980
7981
7982
7983
7984
7985
7986

7987
7988
7989

7990
7991
7992
7993
7994

7995
7996

7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011

8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024


8025
8026
8027
8028

8029
8030

8031
8032
8033
8034
8035
8036
8037

8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070

8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
8094

8095
8096
8097
8098
8099




8100
8101
8102
8103
8104




8105




8106
8107
8108
8109
8110
8111
8112
8113

8114
8115
8116
8117

8118
8119

8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130

8131
8132

8133
8134
8135
8136
8137

8138
8139
8140
8141
8142
8143
8144
8145
8146
8147
8148
8149
8150

8151
8152

8153
8154

8155
8156

8157
8158

8159
8160
8161
8162

8163
8164
8165
8166

8167
8168
8169
8170
8171
8172
8173
8174
8175
8176
8177

8178
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
8193
8194
8195
8196
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8210
8211
8212
8213
8214
8215
8216
8217
8218

8219


8220


8221
8222

8223
8224
8225
8226

8227
8228
8229
8230
8231

8232
8233

8234
8235
8236
8237
8238
8239
8240
8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252

8253
8254

8255
8256
8257
8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288

8289
8290
8291
8292
8293
8294
8295

8296
8297
8298

8299
8300
8301
8302
8303

8304
8305
8306
8307

8308
8309
8310
8311
8312
8313
8314
8315
8316

8317
8318
8319
8320
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332

8333
8334
8335
8336

8337
8338
8339
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
8367
8368
8369
8370
8371
8372
8373
8374
8375
8376
8377

8378


8379

8380








8381
8382
8383
8384

8385
8386

8387
8388
8389
8390

8391
8392
8393
8394

8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
8412
8413

8414
8415
8416
8417
8418

8419
8420
8421
8422
8423
8424
8425
8426
8427
8428
8429
8430
8431
8432
8433
8434
8435
8436

8437
8438

8439
8440
8441
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451
8452
8453
8454

8455
8456
8457
8458
8459
8460
8461
8462
8463
8464
8465
8466
8467
8468
8469
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483
8484
8485


8486
8487
8488
8489
8490
8491
8492
8493
8494
8495
8496
8497
8498
8499
8500
8501
8502
8503

8504
8505
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
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563

8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575
8576
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587

8588
8589
8590
8591
8592
8593
8594

8595
8596
8597
8598

8599
8600
8601
8602
8603
8604
8605
8606
8607


8608
8609
8610
8611
8612

8613
8614

8615
8616
8617
8618
8619
8620
8621
8622
8623
8624
8625
8626
8627
8628
8629
8630
8631
8632
8633
8634
8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
8660
8661
8662
8663
8664
8665
8666
8667
8668
8669
8670
8671
8672
8673
8674
8675
8676
8677
8678
8679
8680
8681
8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694
8695
8696
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
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868
8869
8870
8871
8872
8873
8874
8875
8876
8877
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
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
8934
8935
8936
8937
8938
8939
8940
8941
8942
8943
8944
8945
8946
8947
8948
8949
8950
8951
8952
8953
8954
8955
8956
8957
8958
8959
8960
8961
8962
8963
8964
8965
8966
8967
8968
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
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
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
9054
9055
9056
9057
9058
9059
9060
9061
9062
9063
9064
9065
9066
9067
9068
9069
9070
9071
9072
9073
9074
9075
9076
9077
9078
9079
9080
9081
9082
9083
9084
9085
9086
9087
9088
9089
9090
9091
9092
9093
9094
9095
9096
9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110
9111
9112
9113
9114
9115
9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
9128
9129
9130
9131
9132
9133
9134
9135
9136
9137
9138
9139
9140
9141
9142
7563
7564
7565
7566
7567
7568
7569


7570
7571
7572
7573
7574

7575
7576


7577

7578
7579
7580

7581
7582

7583
7584
7585
7586
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602
7603
7604


7605
7606


7607
7608
7609
7610
7611
7612
7613

7614
7615

7616
7617
7618
7619
7620
7621
7622

7623















7624
7625
7626


7627
7628



7629
7630




7631

7632

7633
7634
7635
7636
7637
7638











7639
7640
7641
7642
7643
7644
7645
7646
7647
7648


7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671



7672

7673


7674


7675


7676


7677
7678
7679
7680


7681


7682

7683



7684









7685
7686
7687

7688
7689

7690
7691

7692
7693

7694
7695

7696
7697
7698


7699

7700


7701

7702
7703
7704


7705
7706
7707
7708

7709







7710
7711
7712
7713


7714
7715




7716
7717
7718
7719
7720
7721
7722


7723
7724


7725
7726
7727
7728
7729
7730
7731
7732
7733
7734

7735
7736
7737
7738
7739
7740

7741
7742
7743
7744

7745
7746
7747
7748
7749

7750
7751

7752
7753
7754
7755
7756
7757




7758
7759
7760
7761
7762


7763
7764

7765
7766

7767
7768
7769
7770
7771
7772
7773
7774
7775
7776




7777
7778
7779
7780
7781
7782







7783
7784


7785
7786


7787



7788
7789
7790

7791

7792

7793
7794
7795
7796


7797

7798


7799




7800
7801
7802
7803

7804
7805
7806
7807
7808
7809
7810
7811


7812
7813
7814
7815
7816


7817

7818


7819













7820
7821
7822



7823
7824

7825
7826
7827
7828
7829
7830


7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
7841
7842
7843

7844
7845
7846
7847

7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858

7859
7860

7861

7862
7863

7864
7865



7866
7867
7868
7869
7870
7871
7872
7873
7874



7875
7876
7877
7878
7879
7880
7881

7882
7883


7884

7885
7886

















7887
7888

7889




7890
7891
7892
7893
7894
7895






7896
7897


















7898
7899


7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910
7911
7912
7913


7914
7915






7916
7917
7918

7919


7920
7921
7922








7923
7924
7925
7926

7927
7928
7929
7930






7931
7932


7933

7934
7935
7936
7937
7938
7939
7940












7941
7942




7943
7944
7945

7946













7947
7948
7949




7950
7951


7952

7953
7954
7955
7956
7957

7958

7959


7960

7961
7962
7963
7964
7965
7966


7967
7968

7969
7970
7971

7972
7973

7974
7975
7976
7977
7978
7979

















































































7980

































































































































































































































































































































































































































































-
-





-
+

-
-
+
-



-
+

-
+















+





-
-


-
-


+
+



-
+

-
+






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



-
-


-
-
-


-
-
-
-

-
+
-






-
-
-
-
-
-
-
-
-
-
-






+



-
-
+
+
+
+





+
+
+
+

+
+
+
+





-
-
-
+
-

-
-
+
-
-
+
-
-

-
-




-
-
+
-
-
+
-

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



-
+

-
+

-
+

-
+

-
+


-
-
+
-

-
-
+
-



-
-




-
+
-
-
-
-
-
-
-




-
-


-
-
-
-







-
-


-
-









+
-
+
+

+
+

-
+



-
+




-
+

-
+





-
-
-
-





-
-


-
+

-
+









-
-
-
-






-
-
-
-
-
-
-


-
-


-
-
+
-
-
-



-
+
-

-
+



-
-
+
-

-
-
+
-
-
-
-




-
+







-
-





-
-
+
-

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



-
-
-


-
+





-
-












+
-
+
+

+
-
+
+
+
+
+
+
+
+



-
+

-
+
-


-
+

-
-
-
+








-
-
-







-
+

-
-

-
+

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

-
+
-
-
-
-






-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-








+
+




-
-


-
-
-
-
-
-



-
+
-
-



-
-
-
-
-
-
-
-




-
+



-
-
-
-
-
-
+

-
-
+
-







-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-



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



-
-
-
-


-
-
+
-





-
+
-

-
-
+
-






-
-
+
+
-



-
+

-
+





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

2011-08-30 (bug fix)[3398794] panic in interp limit setting (gavlian,fellows)

2011-09-08 (bug fix)[3401704] revised expr parser to permit function names
like "nano()" instead of parsing as "nan o()" with missing op (duquette,porter)
	*** POTENTIAL INCOMPATIBILITY ***

2011-09-10 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows)

2011-09-13 (bug fix)[3390638] solaris studio cc workaround (kechel,porter)

2011-09-13 (bug fix)[3405652] DTrace workaround (michelson,porter)

2011-09-16 (bug fix)[3391977] -headers overrides -type (ziegenhagen,fellows)
=> http 2.8.3
=> http 2.7.7

2011-09-16 (TIP 388) New \Uhhhhhhhh syntax (nijtmans)

2011-09-16 (bug fix)[3400658] wrong num args msg with TclOO (rsooltan,fellows)
2011-10-06 (enhancement) bytecode compile [dict with] (fellows)

2011-10-11 (bug fix)[2935503] [file stat] returns bad mode (nadkarni,nijtmans)

2011-10-20 (bug fix)[3418547] cmd lits and custom resolvers (soberning,fellows)
2011-10-15 tzdata updated to Olson's tzdata2011l (iyer)

2011-10-31 (bug fix)[3414754] EIAS violation in fs paths (porter)
--- Released 8.5.11, November 4, 2011 --- See ChangeLog for details ---

2011-11-22 (bug fix)[3354324] Win: [file mtime] sets wrong time (nijtmans)

2011-11-30 (bug fix)[967195] Simply args passed to child processes (nijtmans)
=> tcltest 2.3.4

2011-12-07 (bug fix)[3444754] fix [string tolower \u01C5] (nijtmans)

2011-12-11 (update)[3457031] Update [[:print:]] to Unicode 6.0 (nijtmans)

2011-12-24 (bug fix)[3464428] fix [string is graph \u0120] (nijtmans)

2012-01-08 (bug fix)[3470928] zoneinfo trouble with Windhoek data file (kenny)

2012-01-13 (bug fix)[3472316] fix retrieval of socket error (fellows)
=> http 2.7.8

2012-01-21 (bug fix)[3475667] [regexp] buffer read overflow (sebres)

2012-01-22 (bug fix)[3475264] [dict exists] return 0, not error (fellows)

2012-01-25 (bug fix)[3474460] [oo::copy] var resolution list (fellows)

2012-01-26 (bug fix)[3475569,3479689] mem corrupt in fs path (sebres,porter)

2012-01-30 (enhancement) improve bytecode compile of [catch] (fellows)

2012-02-02 (bug fix)[2974459,2879351,1951574,1852572,1661378,1613456] Fix
problems where [file *able] would return false results on Win/Samba (porter)

2012-02-02 (update)[3464401] Support Unicode 6.1 (nijtmans)

2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer)

2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows)
2012-02-09 (bug fix)[3484402] mem corrupt OBOE in unicode append (porter)

2012-02-15 (enhancement) bytecode compile [lrange],[lreplace] (fellows)
2012-02-15 (bug fix)[3487626] crash compiling [dict for] (fellows)

2012-02-17 (bug fix)[2233954] compile problem on AIX & Android (nijtmans)

2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans)

2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries)

=> http 2.7.9
2012-03-26 (TIP 380) New builtin class [oo::Slot] (fellows)
	*** POTENTIAL INCOMPATIBILITY ***

2012-03-27 (TIP 397) <cloned> method to extend [oo::copy] (fellows)
	*** POTENTIAL INCOMPATIBILITY ***

2012-03-27 (TIP 395) New subcommand [string is entier] (fellows)

2012-04-02 (TIP 396) New command [yieldto] (fellows)

2012-04-04 (bug fix)[3514761] crash combining objects and ensembles (fellows)

2012-04-09 (bug fix)[2712377] [info vars] and oo variables (fellows)

2012-04-09 (bug fix)[3396896] no dups in oo var lists (fellows)

2012-04-11 (bug fix)[3448512] [clock scan 1958-01-01] fail on Win (nijtmans)

2012-04-15 (bug fix)[3517696] fix flush of zlib chan xform (fellows)

2012-04-18 tzdata updated to Olson's tzdata2012c (kenny)

2012-04-28 (TIP 398) exit non-blocking chan without flush (ferrieux)
	*** POTENTIAL INCOMPATIBILITY ***

2012-05-02 (enhancement) Better use of Intel cpuid instruction (nijtmans)

2012-05-03 (bug fix)[3428753] Unbreak synchronous [socket -async] (porter)

2012-05-10 (bug fix)[2812981] force consistent config of Tcl+pkgs (ferrieux)

2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans)

=> dde 1.3.3
2012-05-17 (bug fix)[3445787] fix [file] ensemble in Safe Base (fellows)

2012-05-17 (bug fix)[2964715] fix [glob] in Safe Base (fellows)

2012-05-17 (bug fix)[3106532] proper [switch -indexvar] values (fellows)
	*** POTENTIAL INCOMPATIBILITY ***

2012-05-21 (TIP 106) New -binary option to [dde execute|poke] (oehlmann)
=> dde 1.4.0

2012-05-23 (bug fix)[3525907] [zlib push decompress] & [chan event]
(fellows,ferrieux,kupries)

2012-05-28 (bug fix)[3529949] Protect ~ paths in Safe Base (fellows)

2012-06-21 (bug fix)[3362446] [registry keys] failure (nijtmans)
=> registry 1.3.0

2012-06-25 (bug fix)[3537605] [encoding dirs a b] error message (fellows)

2012-06-25 (bug fix)[3024359] crash when multi-thread concurrent [file system]
and Tcl_FSMountsChanged(). (porter)

2012-06-29 (bug fix)[3536888] fix locale guessing (oehlmann,nijtmans)
=> msgcat 1.4.5

2012-07-05 (bug fix)[1189293] make "<<" redirect binary safe (porter)

2012-07-08 (bug fix)[3531209] accept IPv6 URLs (max)
=> http 2.8.4
2012-07-11 (bug fix)[3362446] [registry keys] failure (nijtmans)
=> registry 1.2.2

2012-07-16 (bug fix)[3544683] reentrant syscalls on BSD (cassoff,fellows)

2012-07-24 (bug fix) stop mem corruption in stacked channel events (max,porter)

2012-07-25 (bug fix)[3546275] [auto_execok] search match [exec] (danckaert)

Many revisions to better support a Cygwin environment (nijtmans)

--- Released 8.5.12, July 27, 2012 --- See ChangeLog for details ---

2012-07-27 (update)[3464401] Support Unicode 6.2 (nijtmans)

2012-08-07 (bug fix)[3554250] fs segfault in thread exit handler (porter)

2012-08-08 (update)[1536227] Cygwin network pathname support (nijtmans)

2012-08-20 (bug fix)[3559678] [file normalize] EIAS failure (phao,dgp)

2012-08-25 (bug fix)[3561330] Ukranian translation of "March" (teterin)

2012-09-07 (TIP 404) New msgcat commands [mcflset], [mcflmset] (oehlmann)
=> msgcat 1.5.0

2012-09-11 (bug fix)[3564735] mem corruption w/ Itcl's [variable] (porter)
Many revisions to better support a Cygwin environment (nijtmans)

Dropped support for OS X versions less than 10.4 (Tiger) (fellows)

2012-09-25 (TIP 404) New msgcat commands [mcflset], [mcflmset] (oehlmann)
--- Released 8.6b3, September 18, 2012 --- See ChangeLog for details ---

=> msgcat 1.5.0
2012-09-20 (enhancement) full Unicode support (nijtmans)
=> dde 1.4.0

2012-09-20 (enhancement) update bundled zlib to 1.2.7 (nijtmans)

2012-10-03 (bug fix) exit panic on stacked std channel (griffin,porter)

2012-10-14 (bug fix) [tcl::Bgerror] crash on non-dict options (nijtmans)

2012-10-16 (TIP 400) New [zlib] options to set compression dict (fellows)

2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows)
2012-10-16 (TIP 405) New commands [lmap] and [dict map] (fellows)

=> http 2.7.10
2012-10-24 (enhancement) [dict unset] now bytecompiled (fellows)

2012-11-05 (TIP 413) Revisions to default [string trim*] trimset (nijtmans)
	*** POTENTIAL INCOMPATIBILITY ***

2012-11-07 (bug fix)[3574493] hang in Windows socket finalization (fassel)
2012-11-05 (enhancement) Now bytecompiled: [array exists], [array set],
[array unset], [dict create], [dict exists], [dict merge], [format],
[info commands], [info coroutine], [info level], [info object],
[namespace current], [namespace code], [namespace qualifiers], [namespace tail],
[namespace which], [regsub], [self], [string first], [string last],
[string map], [string range], [tailcall], [yield]. (fellows)

2012-11-06 (bug fix)[3581754] avoid multiple callback on keep-alive (fellows)
=> http 2.8.5

2012-11-07 tzdata updated to Olson's tzdata2012i (kenny)

2012-11-13 (bug fix)[3567063] thread fp settings from master (mistachkin)
--- Released 8.5.13, November 12, 2012 --- See ChangeLog for details ---

2012-11-14 (bug fix)[2933003] tempfile creation in $TMPDIR (fellows)
2012-11-13 (enhancement)[360894] Threads inherit floating point from creator.

2012-11-15 (TIP 416) New [load] options -global and -lazy (nijtmans)
2012-11-14 (enhancement)[2933003] compile setting: TCL_TEMPORARY_FILE_DIRECTORY

2012-11-20 (bug fix)[3033307] base64 trail whitespace (kovalenko,goth)
2012-11-16 (bug fix)[3587651] [info functions] returns complete set. (porter)

2012-12-03 (bug fix) [configure] query broke init from argv (porter)
2012-12-03 (bug fix) tcltest: Correct legacy auto-init fom $::argv (porter)
=> tcltest 2.3.5

2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter)

2012-12-06 (bug fix) Tcl_InitStubs("8.5",1) must reject 8.50. (porter)
2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter)

--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---

2012-12-13 (bug fix)[3595576] mem flaw in [catch {} -> no-such-ns::v] (porter)
2012-12-22 (bug fix)[3598150] DString to Tcl_Obj memleak (afredd)

2012-12-27 (bug fix)[3598580] Tcl_ListObjReplace() refcount fix (nijtmans)

2013-01-04 (bug fix) memleak in [format] compiler (fellows)

2013-01-08 (bug fix)[3092089,3587096] [file normalize] on junction points

2013-01-09 (bug fix)[3599395] status line processing (nijtmans)
2013-01-23 (bug fix)[2911139] repair async connection management (fellows)
=> http 2.8.6
=> http 2.7.11

2013-01-26 (bug fix)[3601804] Darwin segfault platformCPUID (nijtmans)

2013-01-28 (enhancement) improve ensemble bytecode (fellows)

2013-01-30 (enhancement) selected script code improvements (fradin)
=> tcltest 2.3.6

2013-01-30 (bug fix)[3599098] update to handle glibc banner changes (kupries)
=> platform 1.0.11

2013-01-31 (bug fix)[3598282] make install DESTDIR support (cassoff)

2013-02-05 (bug fix)[3603434] [file normalize a:/] flaw in VFS (porter,griffin)

2013-02-09 (bug fix)[3603695] $obj varname resolution rules (venable,fellows)

2013-02-11 (bug fix)[3603553] zlib flushing errors (vampiera,fellows)

2013-02-14 (bug fix)[3604576] msgcat use of Windows registry (oehlmann,nijtmans)
=> msgcat 1.5.1

2013-02-19 (bug fix)[2438181] report errors in trace handlers (yorick)

2013-02-21 (bug fix)[3605447] unbreak [namespace export -clear] (porter)

2013-02-23 (bug fix)[3599194] fallback IPv6 routines (afredd,max)

2013-02-27 (bug fix)[3606139] stop crash in [regexp] (lane)

2013-03-03 (bug fix)[3606258] major serial port update (english)

2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs
(grathwohl,lane,porter)

2013-03-12 (enhancement) better build support for Debian arch (shadura)

2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans)

2013-03-21 (bug fix)[2102614] [auto_mkindex] ensemble support (griffin)

2013-03-22 tzdata updated to Olson's tzdata2013b (venkat)
2013-03-27 Tcl_Zlib*() routines tolerate NULL interps (porter

--- Released 8.5.14, April 3, 2013 --- See ChangeLog for details ---

2013-04-03 (bug fix)[3205320] outsmart gcc on powerpc detect stack direction

2013-04-04 (bug fix) Support URLs with query but no path (max)
=> http 2.8.7
=> http 2.7.12

2013-04-08 (bug fix)[3610026] regexp crash on color overflow (linnakangas)

2013-04-29 (enhancement) [array set] compile improvement (fellows)
2013-04-16 (bug fix)[3610404] crash in enter traces (found with TclOO) (porter)

2013-04-30 (enhancement) broaden glibc version detection (kupries)
=> platform 1.0.12

2013-05-06 (platform support) Cygwin64 (nijtmans)
2013-05-01 (bug fix)[2901998] inconsistent I/O buffering (ferrieux)

2013-05-15 (enhancement) Improved [list {*}...] compile (fellows)
2013-05-06 (platform support) Cygwin64 (nijtmans)

2013-05-16 (platform support) mingw-4.0 (nijtmans)

2013-05-19 (platform support) FreeBSD updates (cerutti)

2013-05-20 (bug fix)[3613567] access error temp file creation (keene)

2013-05-20 (bug fix)[3613569] temp file open fail can crash [load] (keene)

2013-05-22 (bug fix)[3613609] [lsort -nocase] failed on non-ASCII (fellows)

2013-05-28 (bug fix)[3036566] Use language packs (Vista+) locale (oehlmann)
=> msgcat 1.5.2

2013-05-29 (bug fix)[3614102] [apply {{} {list [if 1]}}] stack woes (porter)

2013-06-03 Restored lost performance appending to long strings (elby,porter)

2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)

2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
2013-06-17 [string is space \u180e] => 1 (nijtmans)

2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)

2013-06-27 (bug fix)[34538b] apply DST in 2099 (lang)

2013-07-02 (bug fix)[32afa6] corrected dirent64 check (griffin)

2013-07-06 tzdata updated to Olson's tzdata2013d (kenny)

2013-07-10 (bug fix)[86fb5e] [info frame] in compiled ensembles (porter)

2013-07-18 (bug fix)[1c17fb] revisd syntax errorinfo that shows error (porter)

2013-07-26 (bug fix)[6585b2] regexp {(\w).*?\1} abb (lane)

2013-07-29 [string is space \u202f] => 1 (nijtmans)

2013-08-01 [a0bc85] Limited support for fork with threads (for Rivet) (nijtmans)

2013-08-01 (bug fix)[1905562] RE recursion limit increased to support
reported usage of large expressions (porter)

2013-08-02 (bug fix)[9d6162] superclass slot empty crash (vdgoot,fellows)

2013-08-03 (enhancement)[3611643] [auto_mkindex] support TclOO (fellows)

2013-08-14 (bug fix)[a16752] Missing command delete callbacks (porter)

2013-08-15 (bug fix)[3610404] reresolve traced forwards (porter)

2013-08-15 Errors from execution traces become errors of the command (porter)

2013-08-23 (bug fix)[8ff0cb9] Tcl_NR*Eval*() schedule only, as doc'd (porter)

2013-09-07 (bug fix) stop crashes in tclcompiler (kupries,porter)
2013-08-29 (bug fix)[2486550] enable [interp invokehidden {} yield] (porter)

2013-09-01 (bug fix)[b98fa55] [binary decode] fail on whitespace (reche,fellows)

2013-09-07 (bug fix)[86ceb4] have tm path favor first provider (neumann,porter)

2013-09-09 (bug fix)[3609693] copied object member variable confusion (fellows)
2013-09-13 (bug fix)[bdd91c] crash in exec stack mem management (azazel)
=> TclOO 1.0.1

2013-09-17 (bug fix)[2152292] [binary encode uuencode] corrected (fellows)
--- Released 8.5.15, September 16, 2013 --- https://core.tcl-lang.org/tcl/ for details

2013-09-19 (bug fix)[3487626] segfaults in [dict] compilers (porter)

2013-09-19 (bug fix)[31661d2] mem leak in [lreplace] (ade,porter)

2013-09-19 (bug fix) [info frame] line OBOEs in bytecode (porter)
Many optmizations, improvements, and tightened stack management in bytecode.

--- Released 8.6.1, September 20, 2013 --- https://core.tcl-lang.org/tcl/ for details

2013-09-25 (bug fix)[d614d63] namespace matching *:: deletion fail (fellows)
2013-09-27 (enhancement) improved ::env synchronization (fellows)

2013-10-20 (bug fix)[2835313] segfault from
[apply {{} {while 1 {a {*}[return -level 0 -code continue]}}}] (fellows)

2013-10-22 (bug fix)[3556215] [scan %E%G%X] support (fellows)

2013-10-25 (bug fix)[3eb2ec1] upper case scheme names in url. (nijtmans)
=> http 2.8.8
=> http 2.7.13

2013-10-29 (bug fix)[414d103] HP-UX: restore [exec] in threaded Tcl (nijtmans)

2013-11-04 (bug fix) C++ friendly stubs struct declarations (nijtmans)

2013-11-05 (bug fix)[426679e] OpenBSD man page rendering (nijtmans)

2013-11-12 (bug fix)[5425f2c] [fconfigure -error] breaks [socket -async]

2013-11-20 (bug fix) Improved environment variable management (nijtmans)
=> tcltest 2.3.7

2013-11-21 (platforms) Support for Windows 8.1 (nijtmans)

2013-12-06 (RFE) improved [foreach] bytecode (fellows)

2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter)
2013-12-10 (RFE) improved [lmap] bytecode (sofer)

2013-12-11 (RFE) improved [catch] bytecode (sofer)

2014-02-24 (bug fix)[2413550] Win: avoid serial double open (schroeter)
2013-12-18 (bug fix)[0b874c3] SEGV [coroutine X coroutine Y info frame] (porter)

2013-12-20 (RFE) reduced numeric conversion in bytecode (sofer)

2014-01-07 (RFE) compilers for  [concat], [linsert], [namespace origin],
[next], [string replace], [string tolower], [string totitle], [string toupper],
[string trim], [string trimleft], [string trimright] (fellows)

2014-01-22 (RFE) compilers for [nextto], [yieldto] (fellows)

2014-02-02 (RFE) compiler for [string is] (fellows)

2014-02-06 (bug fix)[a4494e2] panic in test namespace-13.2 (porter)

2014-03-20 (bug fix)[2f7cbd0] FreeBSD 10.0 build failure (nijtmans)

2014-03-26 (RFE)[b42b208] Cygwin: [file attr -readonly -archive -hidden -system]
(nijtmans)

2014-03-27 (bug fix) segfault iocmd-23.11 (porter)

2014-04-02 (bug fix)[581937a] Win: readable event on async connect failure
2014-04-02 (bug fix)[336441e] Win: async socket connect stall (oehlmann)

2014-04-04 (bug fix)[581937a,97069ea] async socket connect fail (oehlmann)

2014-04-10 (bug fix)[792641f] Win: no \ in normalized path (nijtmans)

2014-04-11 (bug fix)[3118489] protect NUL in filenames (nijtmans)

2014-04-15 (bug fix)[88aef05] segfault iocmd-21.20 (porter)

2014-04-16 (update) Win: use Winsock 2.2 (nijtmans)

2014-04-16 (bug fix)[d19a30d] segfault clock-67.[23] (sebres)

2014-04-21 (bug fix) segfault iocmd-21.2[12] (porter)

2014-04-22 (bug fix) segfault iogt-2.4 (porter)

2014-04-23 (bug fix)[3493120] memleak in thread exit

2014-04-30 (bug fix) segfault iocmd-21.2[34] (porter)
2014-05-08 refactoring of core I/O functions (porter)

2014-05-01 (bug fix)[0e92c40] bytearray optimization validity (nijtmans)

2014-05-06 (bug fix) segfault iogt-2.5 (porter)
2014-05-09 (bug fix)[3389978] Win: extended paths support (nijtmans)

2014-05-06 (memleaks) io-29.27 io-29.34 io-33.7 (porter)

2014-05-07 (memleaks) io-53.5, cloned Tcl_ChannelTypes (porter)

2014-05-08 (memleak) iocmd-21.22 (porter)

2014-05-08 refactoring of core I/O functions (porter)

2014-05-09 (bug fix) segfault iocmd-32.1 (porter)

2014-05-11 (bug fix)[6d2f249] nested ensemble compile failure (fellows)
2014-05-15 (bug fix)[3118489] protect NUL in filenames (nijtmans)

2014-05-17 (RFE)[47d6625] wideint support in [lsearch -integer] [lsort -integer] (nijtmans)
2014-05-16 (bug fix) Fix for failing tests *io-32.11* (porter)
	*** POTENTIAL INCOMPATIBILITY ***

2014-05-20 (bug fix) Stop eof and blocked state leaking thru stacks (porter)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2014-05-20 (bug fix)[13d3af3] Win: socket -async tried only first IP address

2014-05-28 (platforms) work around systems that fail when a shared library
2014-05-22 (platforms) work around systems that fail when a shared library
is deleted after it is [load]ed (kupries)

2014-05-31 (bug fix) chan events on pipes must be on proper ends (porter)

2014-06-04 (bug fix) socket-2.12 (porter)

2014-06-05 (bug fix) io-12.6 (kupries,porter)

2014-06-15 (RFE)[1b0266d] [dict replace|remove] return canonical dict (fellows)
        *** POTENTIAL INCOMPATIBILITY ***

2014-06-16 (bug fix) socket-2.13 workaround broken select() (porter)

2014-06-20 (bug fix)[b47b176] iortrans.tf-11.0 (porter)

2014-06-22 (RFE)[2f9df4c] -cleanup scripts before -out compare (nijtmans)

2014-07-04 (update) Update Unicode data to 7.0 (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2014-07-08 (bug) [chan push] converts blocked writes to error (aspect,porter)

2014-07-10 (bug fix)[7368d2] memleak Tcl_SetVar2(..,TCL_APPEND_VALUE) (porter)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2014-07-11 (bug) leaks in SetFsPathFromAny, [info frame] (porter)

2014-07-15 (bug) compress dict leak in zlib xform channel close (porter)

2014-07-17 (bug fix)[9969cf8] leak trace data in coroutine deletion (porter)

2014-07-18 (RFE)[b43f2b4] fix [lappend] multi performance collapse (fellows)

2014-07-19 (bug fix)[75b8433] memleak managing oo instance lists (porter)

2014-07-21 (bug fix)[e6477e1] memleak in AtForkChild() (porter)

2014-07-22 (bug fix)[12b0997] memleak in iocmd.tf-32.0 (porter)

2014-07-28 (RFE) Optimized binary [chan copy] by moving buffers (porter)

2014-07-30 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime
2014-08-01 (enhancement) use refcounts, not Tcl_Preserve to manage lifetime
of Tcl_Channel  (porter)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2014-07-31 (bug fix)[a84a720] double free in oo chain deletion (porter)

2014-08-01 (bug fix)[e75faba] SEGV [apply {{} {namespace upvar a b [x]}}] (porter)

2014-08-01 (update) "macosx*-i386-x86_64" "macosx-universal" no longer compatible (kupries)
=> platform 1.0.13

2014-08-12 tzdata updated to Olson's tzdata2014f (kenny)

2014-08-17 (bug fix)[7d52e11] [info class subclasses oo::object] should
include ::oo::class (fellows)

2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux)

--- Released 8.6.2, August 27, 2014 --- https://core.tcl-lang.org/tcl/ for details
--- Released 8.5.16, August 25, 2014 --- https://core.tcl-lang.org/tcl/ for details

2014-08-28 (bug)[b9e1a3] Correct Method Search Order (nadkarni,fellows)
=> TclOO 1.0.3
        *** POTENTIAL INCOMPATIBILITY ***

2014-09-05 (bug)[ccc2c2] Regression [lreplace {} 1 1] (bron,fellows)

2014-09-08 (bug)<oo-1.18.2> Crash regression in [oo::class destroy] (porter)

2014-09-09 (bug)[84af11] Regress [regsub -all {\(.*} a(b) {}] (fellows)

2014-09-10 (bug)[cee90e] [try {} on ok {} - on return {} {}] panic (porter)

2014-09-20 (feature) [tcl::unsupported::getbytecode] disassember (fellows)

2014-09-27 (enhancement) [string cat] bytecode optimization (leitgeb,ferrieux)

2014-09-27 (bug)[82521b] segfault in mangled bytecode (ogilvie,sofer)

2014-10-02 (bug)[bc5b79] Hang in some [read]s of limited size (rogers,porter)

2014-10-03 (bug)[bc1a96] segfault in [array set] of traced array (tab,porter)

2014-10-08 (bug)[59a2e7] MSVC14 compile support (dower,nijtmans)

2014-10-10 (bug)[ed29c4] [fcopy] treats [blocked] as error (rowen,porter)

2014-10-10 (bug)[bf7135] regression in Tcl_Write() interface (porter)

2014-10-18 (bug)[10dc6d] fix [gets] on non-blocking channels (fassel,porter)

--- Released 8.5.17, October 25, 2014 --- https://core.tcl-lang.org/tcl/ for details

2014-10-26 Support for Windows 10 (nijtmans)

2014-10-31 (bug)[dcc034] restore [open comX: r+] (lll,nijtmans)

2014-11-05 (bug)[214cc0] Restore [lappend v] return value (sayers,porter)

2014-11-06 (bug)[5adc35] Stop forcing EOF to be permanent (porter)

--- Released 8.6.3, November 12, 2014 --- https://core.tcl-lang.org/tcl/ for details

2014-11-21 (bug)[743338] Win: socket error encoding (ladayaroslav,nijtmans)

2014-12-01 (bug) restore tbcload/tclcompiler support (kupries)

2014-12-03 (bug)[0c043a] Fix compiled [set var($) val] (porter)

2014-12-04 (bug)[d2ffcc] Limit $... and bareword parsing to ASCII (ladayaroslav,porter)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2014-12-06 (bug)[c6cd4a] Win: hang in async socket connection (shults,nadkarni)

2014-12-10 tzdata updated to Olson's tzdata2014j (venkat)

2014-12-13 fix header files installation on OS X (houben)

2014-12-17 (TIP 427) [fconfigure $h -connecting, -peername, -sockname] (oehlmann,rmax)

2014-12-18 (bug)[af08c8] Crash in full finalize encoding teardown (porter)

2014-12-18 (bug)[7c187a] [chan copy] crash (io-53.17) (benno,porter)

2015-01-26 (bug)[df0848] Trouble with INFINITY macro (dower,nijtmans)

2015-01-29 (bug) Stop crashes when extension var resolvers misbehave (porter)

2015-01-29 (bug)[088727] [read] past EOF (io-73.4) (fenugrec,porter)
2015-02-05 (bug) Plug stacked channel memleak (porter)

2015-02-11 tzdata updated to Olson's tzdata2015a (venkat)

2015-02-20 (bug)[32b615] Fix compiled [lreplace] (lreplace-4.[345]) (aspect)

2015-03-10 (enhancement) Revise OS X notifier for better Cocoa (walzer)
        *** POTENTIAL INCOMPATIBILITY ***

--- Released 8.6.4, March 12, 2015 --- https://core.tcl-lang.org/tcl/ for details
--- Released 8.5.18, March 6, 2015 --- https://core.tcl-lang.org/tcl/ for details

2015-03-19 (bug)[e66e44] Win: Ctrl-C/Ctrl-Break in console not EOF (nadkarni)

2015-03-10 (bug)[3028676] Refinement in OS X notifier (steffen,walzer,lars_h)
2015-03-21 (bug)[d87cb1] Proper tailcall from compiled ensembles (sofer)

2015-04-23 (bug)[19ea02] Win: shared read from linked dirs (bogdan,oehhar)

2015-04-24 (bug)[879a07] Incomplete chars @ buffer ends (leunissen,porter)

2015-04-29 (bug)[894da1] Hang flushing blocking channels (yorick)

2015-05-14 (enhance)[b9d043] Default use of gzip transfer encoding (fellows)
=> http 2.8.9
        *** POTENTIAL INCOMPATIBILITY ***

2015-05-15 (bug)[9dd1bd] destructor [self] after failed constructor (calvo,fellows)

2015-05-15 (bug)[0f42ff] [tailcall] combined with [next] (aspect,fellows)

2015-05-18 (bug)[c11a51] http: race condition in -accept option (fellows)

2015-05-19 (enhance) More pure lists from compiled [list] (porter,fellows)

2015-05-27 (enhancement) Relax memdebug constraint on extensions (kupries)

2015-06-03 (bug)[268b23] crash in traced [expr] (execute-11.2)(tomkinson,porter)

2015-06-11 (bug)[478c44] Memleak in zlib compresion errors (mistachkin)

2015-06-16 (bug)[e770d9] Higher baud on serial channels (woods,nijtmans)

2015-06-18 (update) Update Unicode data to 8.0 (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***
	*** POTENTIAL INCOMPATIBILITY ***

2015-06-18 (bug)[a4cb3f] compiled [lreplace] handling of end (bron,aspect)

2015-06-23 (enhance) Use Unicode SendMessageTimeout() (nijtmans)
=> registry 1.3.1

2015-06-25 (TIP 412) msgcat dynamic locale change and package private locale (oehlmann)
=> msgcat 1.6.0

2015-07-05 (bug)[a0ece9] crash in traced [expr] (execute-11.3) (hans,porter)

2015-07-10 (TIP 436) [info object isa] favors 'false' over error (fellows)
=> TclOO 1.0.4

2015-07-15 (bug)[b1534b][9bad63] writes beyond buffer bounds (hanno,porter)

2015-07-18 (bug)[a3309d] Memleak in compiled [unset a($i)] (jeff,porter)

2015-07-23 (bug)[57945b] lock in forking/multi-threading (neumann,mistachkin)

2015-07-29 (bug)[3e7eca] Allocation overflow in expr parsing (rickyb,porter)

2015-07-30 (bug)[f00009] Win: Memleak in [file] (rp,sebres)

2015-08-12 tzdata updated to Olson's tzdata2015f (venkat)
2015-07-31 (bug) Correct problems found in Coverity audit (sofer)

2015-08-19 (bug)[00189c] MSVC 14: semi-static UCRT support (dower,nijtmans)

2015-08-26 (bug)[0df7a1] Tolerate getcwd() failures (cato,nijtmans)

2015-09-21 (bug)[1115587][a3c350][d7ea9f][0e0e15][187d7f] Many fixes and
2015-09-23 (bug)[e0a7b3] Input buffer draining & file events (griffin,porter)
improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)

2015-09-23 (enhance) hash lookup microoptimization (hipp)

2015-09-24 (bug)[57945b] lock in forking/multi-threading (neumann,mistachkin)
2015-09-23 (bug)[e0a7b3] Input buffer draining & file events (griffin,porter)

2015-09-29 (bug)[219866] Cygwin support error (yorick,nijtmans)
=> platform 1.0.14

2015-10-06 (bug)[b42a85] Win: [file normalize ~user] wrong dir (nadkarni)

2015-10-21 (bug)[1080042][8f2450] More regexp from Postgres (lane,porter)

2015-10-21 (bug)[818a1a][a3c350][d7ea9f][8f2450][1080042] Many fixes and
improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2015-10-23 (bug)[4a0c16] [clock] react to msgcat locale change (oehlmann)

2015-11-10 (bug)[261a8a] Overflow segfault in I/O translation (brooks,porter)

2015-11-20 (bug)[40f628] ListObjReplace callers fail to detect max (porter)
2015-11-20 (bug)[3293874] let lists grow all the way to the limit (porter)

2015-11-30 (enhance)[32c574] Improve list growth performance (brooks,porter)
2015-11-20 (bug)[40f628] ListObjReplace callers fail to detect max (porter)

2015-12-11 (bug)[c9eb6b] tolerate unset ::env(TZ) (gahr, nijtmans)

2016-01-29 (TIP 440) tcl_platform(engine) -- Tcl implementation (mistachkin)

2016-02-03 (bug)[25842c] stream [zlib deflate] fails with 0 input (ade,fellows)

2016-02-04 (bug)[3d96b7][593baa][cf74de] crashes in OO teardown (porter,fellows)

2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans)

--- Released 8.6.5, February 29, 2016 --- https://core.tcl-lang.org/tcl/ for details

2016-03-01 (bug)[803042] mem leak due to reference cycle (porter)

2016-03-08 (bug)[bbc304] reflected watch race condition (porter)

2016-03-17 (bug)[fadc99] compile-5.3 (rodriguez,porter)

2016-03-17 (enhancement)[1a25fd] compile [variable ${ns}::v] (porter)

2016-03-20 (bug)[1af8de] crash in compiled [string replace] (harder,fellows)

2016-03-21 (bug)[d30718] segv in notifier finalize (hirofumi,nijtmans)

2016-03-23 (enhancement)[7d0db7] parallel make (yarda,nijtmans)

2016-03-23 [f12535] enable test bindings customization (vogel,nijtmans)

2016-04-04 (bug)[47ac84] compiled [lreplace] fixes (aspect,ferrieux,fellows)
        *** POTENTIAL INCOMPATIBILITY ***

2016-04-08 (bug)[866368] RE \w includes 'Punctuation Connector' (nijtmans)

2016-04-08 (bug)[2538f3] Win crash Tcl_OpenTcpServer() (griffin)

2016-04-10 [07d13d] Restore TclBlend support lost in 8.6.1 (buratti)

2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny)

2016-05-13 (bug) registry package support any Unicode env (nijtmans)
=> registry 1.3.2

2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)

2016-06-02 (TIP 447) execution time verbosity option (cerutti)
=> tcltest 2.4.0

2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter)

2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric)

2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter)

2016-06-21 (update) Update Unicode data to 9.0 (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2016-06-22 (bug)[16896d] Tcl_DString tolerate append to self. (dah,porter)

2016-06-23 (bug)[d55322] crash in [dict update] (yorick,fellows)

2016-06-27 (bug)[dd260a] crash in [chan configure -dictionary] (madden,aspect)

2016-07-02 (bug)[f961d7] usage message with parameters with spaces (porter)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)

2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)

2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)

2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-10 (bug)[da340d] integer division in clock math (nadkarni)

2016-07-20 tzdata updated to Olson's tzdata2016f (venkat)

--- Released 8.6.6, July 27, 2016 --- https://core.tcl-lang.org/tcl/ for details
--- Released 8.5.19, February 12, 2016 --- https://core.tcl-lang.org/tcl/ for details

2016-09-07 (bug)[c09edf] Bad caching with  custom resolver (neumann,nijtmans)

2016-09-07 (bug)[4dbdd9] Memleak in test var-8.3 (mr_calvin,porter)

2016-10-03 (bug)[2bf561] Allow empty command as alias target (yorick,nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2016-10-04 (bug)[4d5ae7] Crash in async connects host no address (gahr,fellows)

2016-10-08 (bug)[838e99] treat application/xml as text (gahr,fellows)
=> http 2.8.10

2016-10-11 (bug)[3cc1d9] Thread finalization crash in zippy (neumann)

2016-10-12 (bug)[be003d] Fix [scan 0x1 %b], [scan 0x1 %o] (porter)

2016-10-14 (bug)[eb6b68] Fix stringComp-14.5 (porter)

2016-10-30 (bug)[b26e38] Fix zlib-7.8 (fellows)

2016-10-30 (bug)[1ae129] Fix memleak in [history] destruction (fellows)

2016-11-04 (feature) Provisional Tcl 9 support in msgcat and tcltest (nijtmans)
=> msgcat 1.6.1
=> tcltest 2.4.1

2016-11-04 (bug)[824752] Crash in Tcl_ListObjReplace() (gahr,porter)

2016-11-11 (bug)[79614f] invalidate VFS mounts on sytem encoding change (yorick)

2016-11-14 OSX: End panic() as legacy support macro; system conflicts (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2016-11-15 (bug) TclOO fix stops crash mixing Itcl and snit (fellows)

2016-11-17 (update) Reconcile libtommath updates; purge unused files (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2017-01-09 (bug)[b87ad7] Repair drifts in timer clock (sebres)

2017-01-17 (update) => zlib 1.2.11 (nijtmans)

2017-01-31 (bug)[39f630] Revise Tcl_LinkVar to tolerate some prefixes (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2017-02-01 (bug)[d0f7ba] Improper NAN optimization. expr-22.1[01] (aspect)

2017-02-26 (bug)[25842c] zlib stream finalization (aspect)

2017-03-07 (deprecate) Remove unmaintained makefile.bc file (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2017-03-14 (enhancement) [clock] and [encoding] are now ensembles (kenny)

2017-03-15 (enhancement) several [clock] subcommands bytecoded (kenny)

2017-03-23 tzdata updated to Olson's tzdata2017b (jima)

2017-03-29 (bug)[900cb0] Fix OO unexport introspection (napier)

2017-04-12 (bug)[42202b] Nesting imbalance in coro injection (nadkarni,sebres)

2017-04-18 (bug)[bc4322] http package support for safe interps (nash,nijtmans)

2017-04-28 (bug)[f34cf8] [file join a //b] => /b (neumann,porter)

2017-05-01 (bug)[8bd13f] Windows threads and pipes (sebres,nijtmans)

2017-05-01 (bug)[f9fe90] [file join //a b] EIAS violation (aspect,porter)

2017-05-04 (bug) Make test filesystem-1.52 pass on Windows (nijtmans)

2017-05-05 (bug)[601522] [binary] field spec overflow -> segfault (porter)

2017-05-08 (bug)[6ca52a] http memleak handling keep-alive (aspect,nijtmans)
=> http 2.8.11

2017-05-29 (bug)[a3fb33] crash in [lsort] on long lists (sebres)

2017-06-05 (bug)[67aa9a] Tcl_UtfToUniChar() revised handling invalid UTF-8 (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2017-06-08 (bug)[2738427] Tcl_NumUtfChars() corner case utf-4.9 (nijtmans)

2017-06-22 (update) Update Unicode data to 10.0 (nijtmans)
        *** POTENTIAL INCOMPATIBILITY ***

2017-06-22 (TIP 473) Let [oo::copy] specify target namespace (fellows)

2017-06-26 (bug)[46f801] Repair autoloader fragility (porter)

2017-07-06 (bug)[adb198] Plug memleak in TclJoinPath (sebres,porter)

2017-07-17 (bug)[fb2208] Repeatable tclIndex generation (wiedemann,nijtmans)

--- Released 8.6.7, August 9, 2017 --- https://core.tcl-lang.org/tcl/ for details

Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter)
        *** POTENTIAL INCOMPATIBILITY ***

2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter)

2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans)

2016-07-19 (bug)[0363f0] Partial array search ID reform (porter)

2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter)
	*** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") ***

2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max)

2016-11-25 [array names -regexp] supports backrefs (goth)

2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy)

2017-01-04 (TIP 459) New subcommand [package files] (nijtmans)

2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans)

2017-01-30 Add to Win shell builtins: assoc ftype move (ashok)

2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans)

2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans)

2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz)

2017-05-31 Purge build support for SunOS-4.* (stu)

2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows)

2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows)
=> TclOO 1.2.0

2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin)

2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)

2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)

--- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details

2017-08-10 [array names -regexp] supports backrefs (goth)

2017-08-10 Fix gcc build failures due to #pragma placement (cassoff,fellows)

2017-08-29 (bug)[b50fb2] exec redir append stdout and stderr to file (coulter)

2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
=> http 2.8.12

2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)

2017-10-19 (bug)[1a5655] [info * methods] includes mixins (fellows)

2017-10-23 tzdata updated to Olson's tzdata2017c (jima)

2017-10-24 (bug)[fc1409] segfault in method cloning, oo-15.15 (coulter,fellows)

2017-11-03 (bug)[6f2f83] More robust [load] for ReactOS (werner)

2017-11-08 (bug)[3298012] Stop crash when hash tables overflow 32 bits (porter)

2017-11-14 (bug)[5d6de6] Close failing case of [package prefer stable] (kupries)

2017-11-17 (bug)[fab924] Fix misleading [load] message on Windows (oehlmann)

2017-12-05 (bug)[4f6a1e] Crash when ensemble map and list are same (sebres)

2017-12-06 (bug)[ce3a21] file normalize failure when tail is empty (porter)

2017-12-08 (new)[TIP 477] nmake build system reform (nadkarni)

2017-12-19 (bug)[586e71] EvalObjv exception handling at level #0 (sebres,porter)

--- Released 8.6.8, December 22, 2017 --- https://core.tcl-lang.org/tcl/ for details

2018-02-11 (enhance) stop blocking conversion of object to/from class (coulter)

2018-02-12 (enhance) NR-enable [package require] (coulter)

2018-02-14 (bug)[9fd5c6] crash in object deletion, test oo-11.5 (coulter)

2018-02-14 (bug)[3c32a3] crash deleting object with class mixed in (coulter)

2018-02-15 (platform) stop using -lieee, removed from glibc-2.27 (porter)
***POTENTIAL INCOMPATIBILITY for math programs that embed Tcl***

2018-02-23 (bug)[8e6a9a] bad binary [string match], test string-11.55 (porter)

2018-03-05 (bug)[1873ea] repair multi-thread std channel init (sebres)

2018-03-09 (bug)[db36fa] broken bytecode for index values (porter)

2018-03-13 (bug) broken compiled [string replace], test string-14.19 (porter)

2018-03-14 (bug) [string trim*] engine crashed on invalid UTF (sebres)

2018-04-17 (bug) missing trace in compiled [array set], test var-20.11 (porter)

2018-04-22 (bug)[46a241] crash in unset array with search, var-13.[23] (goth)

2018-04-30 (bug)[27b682] race made [file delete] raise "no such file" (sebres)

2018-06-04 (bug)[925643] 32/64 cleanup of filesystem DIR operations (sebres)

2018-06-18 (bug) leaks in TclSetEnv and env cache (coulter)

2018-06-24 (bug)[3592747] [yieldto] dying namespace, tailcall-14.1 (coulter)

2018-07-09 (bug)[270f78] race in [file mkdir] (sebres)

2018-07-12 (bug)[3f7af0] [file delete] raised "permission denied" (sebres)

2018-07-26 (bug)[d051b7] overflow crash in [format] (sebres)

2018-08-29 revised quoting of [exec] args in generated command line (sebres)
***POTENTIAL INCOMPATIBILITY***

2018-09-20 HTTP Keep-Alive with pipelined requests (nash)
=> http 2.9.0

2018-09-27 (new)[TIP 505] [lreplace] accepts all out of range indices (porter)

2018-10-04 (bug) Prevent crash from NULL keyName (nijtmans)
=> registry 1.3.3

2018-10-26 (enhance) advance dde version (nijtmans)
=> dde 1.4.1

2018-10-27 tzdata updated to Olson's tzdata2018g (jima)

2018-10-29 Update tcltest package for Travis support (fellows)
=> tcltest 2.5.0

2018-11-09 (bug)[35a8f1] overlong string length of some lists (owens)

2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres)

- Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ -

2018-11-22 (bug)[7a9dc5] [file normalize ~/~foo] segfault (sebres)

2018-12-30 (bug)[3cf3a9] variable 'timezone' deprecated in vc2017 (nijtmans)

2019-01-09 (bug)[cc1e91] [list [list {*}[set a " "]]] regression (sebres)

2019-02-01 (bug)[e3f481] tests var-1.2[01] (sebres)

2019-03-01 (new) Update to Unicode 12.0 (nijtmans)

2019-03-05 (new)[TIP 527] New command [timerate] (sebres)

2019-03-08 (bug)[39fed4] [package require] memory validity (hume,porter)

2019-04-23 (new) New command tcl::unsupported::corotype (fellows)

2019-05-04 (bug) memlink when namespace deletion kills linked var (porter)

2019-05-28 (new) README file converted to README.md in Markdown (nijtmans)

2019-06-17 (bug)[8b9854] [info level 0] regression with ensembles (porter)

2019-06-20 (bug)[6bdadf] crash multi-arg write-traced [lappend] (fellows,porter)

2019-06-21 (bug)[f8a33c] crash Tcl_Exit before init (brooks,sebres)

2019-08-27 (bug)[fa6bf3] Bytecode fails epoch recovery at numLevel=0 (sebres)

2019-08-29 (bug)[fec0c1] C stack overflow compiling bytecode (ade,sebres)

2019-09-12 tzdata updated to Olson's tzdata2019c (jima)

2019-09-20 (new) registry/dde no longer need -DUNICODE (nijtmans)
=> registry 1.3.4
=> dde 1.4.2

2019-10-02 (bug)[16768d] Fix [info hostname] on NetBSD (rytaro)

2019-10-23 (new) libtommath updated to release 1.2.0 (nijtmans)

2019-10-25 OSX: system Tcl deprecated. End default use of its packages. (walzer)

2019-10-28 (bug)[bcd100] bad fs cache when system encoding changes (coulter)

2019-11-15 (bug)[135804] segfault in [next] after destroy (coulter,sebres)

- Released 8.6.10, Nov 21, 2019 - details at http://core.tcl-lang.org/tcl/ -

Changes to 8.7a3 include all changes to the 8.6 line through 8.6.10,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

2017-11-01 (bug)[3c32a3] crash deleting class mixed into instance (coulter)

2017-11-03 [TIP 345] eliminate the encoding 'identity' (porter)

2017-11-04 (bug)[0d902e] [string first] on ASCII stored as Unicode (fellows)

2017-11-17 [TIP 422] Mark all Tcl_*VA() routines deprecated. (nijtmans)

2017-11-20 (support) Ended use of the obsolete values.h header (culler)

2017-11-30 (bug)[8e1e31] [lsort] ordering of U+0000 (nijtmans)

2017-12-07 [TIP 487] Terminate support for pre-XP Windows (nijtmans)

2017-12-08 [TIP 477] Reform of nmake build (nadkarni)

2017-12-20 (bug)[ba1419] Crash: complex ensemble delete, namespace-7.8 (coulter)

2018-01-17 [TIP 485] Removal of many deprecated features (nijtmans)

2018-01-27 (bug) Crash in [join $l $l], join-4.1 (porter)

2018-02-06 [TIP 493] Cease Distribution of http 1.0 (porter)

2018-02-06 [TIP 484] internal rep for native ints are all 64-bit (nijtmans)

2018-02-14 [TIP 476] Scan/Printf consistency (nijtmans)

2018-03-05 [TIP 351] [lsearch] striding

2018-03-05 [TIPs 330,336] tighten access to Interp fields (porter)

2018-03-12 [TIP 462] [::tcl::process]

2018-03-12 [TIP 490] add oo support for msgcat => msgcat 1.7.0 (oehlmann)

2018-03-12 [TIP 499] custom locale preference list (oehlmann)
=> msgcat 1.7.0

2018-03-20 [TIP 503] End CONST84 support for Tcl 8.3 (porter)

2018-03-30 Refactored [lrange] (spjuth)

2018-04-20 [TIP 389] Unicode beyond BMP (nijtmans)

2018-04-20 [TIP 421] [array for]

2018-05-11 [TIP 425] Windows panic callback use of UTF-8

2018-05-17 [TIP 491] Phase out --disable-threads support

2018-06-03 [TIP 500] TclOO Private Methods and Variables

2018-07-26 (bug)[ba921a] [string cat] of bytearrays (coulter,porter)

2018-09-02 [TIP 478] Many new features in TclOO (lester,fellows)

2018-09-04 (bug)[540bed] [binary format w] from bignum (nijtmans)

2018-09-12 [TIP 430] zipfs and embedded script library (woods)

2018-09-26 [TIP 508] [array default] (bonnet,fellows)

2018-09-27 [TIP 515] level value reform (nijtmans)

2018-09-27 [TIP 516] More OO slot operations (fellows)

2018-09-27 [TIP 426] [info cmdtype] (fellows)

2018-09-28 [TIP 509] Cross platform reentrant mutex

2018-10-08 [TIP 514] native integers are 64-bit

2018-10-12 [TIP 502] index value reform (porter)

2018-11-06 [TIP 406] http cookies (fellows)

2018-11-06 [TIP 445] Tcl_ObjType utilities (migrate to Tcl 9) (porter)

2018-11-06 [TIP 501] [string is dict]

2018-11-06 [TIP 519] inline export/unexport option for [oo::define]

2018-11-06 [TIP 523] [lpop]

2018-11-06 [TIP 524] TclOO custom dialects

2018-11-06 [TIP 506] Tcl_(Incr|Decr)RefCount macros -> functions (porter)

2018-11-15 [TIP 512] No stub for Tcl_SetExitProc()

2019-04-08 (bug)[45b9fa] crash in [try] (coulter)

2019-04-14 [TIP 160] terminal and serial channel controls

2019-04-14 [TIP 312] more types for Tcl_LinkVar

2019-04-14 [TIP 367] [lremove]

2019-04-14 [TIP 504] [string insert]

2019-04-16 [TIP 342] [dict getwithdefault]

2019-05-25 [TIP 431] [file tempdir]

2019-05-25 [TIP 383] [coroinject], [coroprobe]

2019-05-31 [TIP 544] Tcl_GetIntForIndex()

2019-06-12 Replace TclOffset() with offsetof()

2019-06-15 [TIP 461] string compare operators for [expr]

2019-06-16 [TIP 521] floating point classification functions for [expr]

2019-06-20 (bug)[6bdadf] crash multi-arg traced [lappend] (fellows)

2019-06-28 [TIP 547] New encodings utf-16, ucs-2

2019-09-14 [TIP 414] Tcl_InitSubsystems()

2019-09-14 [TIP 548] wchar_t conversion functions

- Released 8.7a3, Nov 21, 2019 --- http://core.tcl-lang.org/tcl/ for details -

Changes to 9.0a1 include all changes to the 8.7 line through 8.7a3,
plus the following, which focuses on the high-level feature changes
in this changeset (new minor version) rather than bug fixes:

2017-11-03 [TIP 114] Leading zero integer no longer means octal

2017-11-03 [TIP 278] Revise variable name resolution, solve "Creative Writing"

2017-11-03 [TIPs 330,336] Encapsulate struct Tcl_Interp

2017-11-17 [TIP 422] Remove all Tcl_*VA() routines

2017-12-15 [TIP 488] Disable magic $::tcl_precision

2018-10-08 [TIP 494] Increased support for size_t value ranges

2019-05-31 [TIP 537] 64-bit indices in regexp matching

- Released 9.0a1, Nov 25, 2019 --- http://core.tcl-lang.org/tcl/ for details -

Deleted compat/fake-rfc2553.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267











































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 2000-2003 Damien Miller.  All rights reserved.
 * Copyright (C) 1999 WIDE Project.  All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. Neither the name of the project nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

/*
 * Pseudo-implementation of RFC2553 name / address resolution functions
 *
 * But these functions are not implemented correctly. The minimum subset
 * is implemented for ssh use only. For example, this routine assumes
 * that ai_family is AF_INET. Don't use it for another purpose.
 */
#include "tclInt.h"

TCL_DECLARE_MUTEX(netdbMutex)

#ifndef HAVE_GETNAMEINFO
#ifndef HAVE_STRLCPY
static size_t
strlcpy(char *dst, const char *src, size_t siz)
{
        char *d = dst;
        const char *s = src;
        size_t n = siz;

        /* Copy as many bytes as will fit */
        if (n != 0 && --n != 0) {
                do {
                        if ((*d++ = *s++) == 0)
                                break;
                } while (--n != 0);
        }

        /* Not enough room in dst, add NUL and traverse rest of src */
        if (n == 0) {
                if (siz != 0)
                        *d = '\0';              /* NUL-terminate dst */
                while (*s++)
                        ;
        }

        return(s - src - 1);    /* count does not include NUL */
}
#endif

int fake_getnameinfo(const struct sockaddr *sa, size_t salen, char *host,
                size_t hostlen, char *serv, size_t servlen, int flags)
{
	struct sockaddr_in *sin = (struct sockaddr_in *)sa;
	struct hostent *hp;
	char tmpserv[16];
	(void)salen;

	if (sa->sa_family != AF_UNSPEC && sa->sa_family != AF_INET)
		return (EAI_FAMILY);
	if (serv != NULL) {
		snprintf(tmpserv, sizeof(tmpserv), "%d", ntohs(sin->sin_port));
		if (strlcpy(serv, tmpserv, servlen) >= servlen)
			return (EAI_MEMORY);
	}

	if (host != NULL) {
		if (flags & NI_NUMERICHOST) {
			size_t len;
			Tcl_MutexLock(&netdbMutex);
			len = strlcpy(host, inet_ntoa(sin->sin_addr), hostlen);
			Tcl_MutexUnlock(&netdbMutex);
			if (len >= hostlen) {
				return (EAI_MEMORY);
			} else {
				return (0);
			}
		} else {
			int ret;
			Tcl_MutexLock(&netdbMutex);
			hp = gethostbyaddr((char *)&sin->sin_addr,
			    sizeof(struct in_addr), AF_INET);
			if (hp == NULL) {
				ret = EAI_NODATA;
			} else if (strlcpy(host, hp->h_name, hostlen)
				   >= hostlen) {
				ret = EAI_MEMORY;
			} else {
				ret = 0;
			}
			Tcl_MutexUnlock(&netdbMutex);
			return ret;
		}
	}
	return (0);
}
#endif /* !HAVE_GETNAMEINFO */

#ifndef HAVE_GAI_STRERROR
const char *
fake_gai_strerror(int err)
{
	switch (err) {
	case EAI_NODATA:
		return ("no address associated with name");
	case EAI_MEMORY:
		return ("memory allocation failure.");
	case EAI_NONAME:
		return ("nodename nor servname provided, or not known");
	case EAI_FAMILY:
		return ("ai_family not supported");
	default:
		return ("unknown/invalid error.");
	}
}
#endif /* !HAVE_GAI_STRERROR */

#ifndef HAVE_FREEADDRINFO
void
fake_freeaddrinfo(struct addrinfo *ai)
{
	struct addrinfo *next;

	for(; ai != NULL;) {
		next = ai->ai_next;
		free(ai);
		ai = next;
	}
}
#endif /* !HAVE_FREEADDRINFO */

#ifndef HAVE_GETADDRINFO
static struct
addrinfo *malloc_ai(int port, u_long addr, const struct addrinfo *hints)
{
	struct addrinfo *ai;

	ai = (struct addrinfo *)malloc(sizeof(*ai) + sizeof(struct sockaddr_in));
	if (ai == NULL)
		return (NULL);

	memset(ai, '\0', sizeof(*ai) + sizeof(struct sockaddr_in));

	ai->ai_addr = (struct sockaddr *)(ai + 1);
	/* XXX -- ssh doesn't use sa_len */
	ai->ai_addrlen = sizeof(struct sockaddr_in);
	ai->ai_addr->sa_family = ai->ai_family = AF_INET;

	((struct sockaddr_in *)(ai)->ai_addr)->sin_port = port;
	((struct sockaddr_in *)(ai)->ai_addr)->sin_addr.s_addr = addr;

	/* XXX: the following is not generally correct, but does what we want */
	if (hints->ai_socktype)
		ai->ai_socktype = hints->ai_socktype;
	else
		ai->ai_socktype = SOCK_STREAM;

	if (hints->ai_protocol)
		ai->ai_protocol = hints->ai_protocol;

	return (ai);
}

int
fake_getaddrinfo(const char *hostname, const char *servname,
    const struct addrinfo *hints, struct addrinfo **res)
{
	struct hostent *hp;
	struct servent *sp;
	struct in_addr in;
	int i;
	long int port;
	u_long addr;

	port = 0;
	if (hints && hints->ai_family != AF_UNSPEC &&
	    hints->ai_family != AF_INET)
		return (EAI_FAMILY);
	if (servname != NULL) {
		char *cp;

		port = strtol(servname, &cp, 10);
		if (port > 0 && port <= 65535 && *cp == '\0')
			port = htons((unsigned short)port);
		else if ((sp = getservbyname(servname, NULL)) != NULL)
			port = sp->s_port;
		else
			port = 0;
	}

	if (hints && hints->ai_flags & AI_PASSIVE) {
		addr = htonl(0x00000000);
		if (hostname && inet_aton(hostname, &in) != 0)
			addr = in.s_addr;
		*res = malloc_ai(port, addr, hints);
		if (*res == NULL)
			return (EAI_MEMORY);
		return (0);
	}

	if (!hostname) {
		*res = malloc_ai(port, htonl(0x7F000001), hints);
		if (*res == NULL)
			return (EAI_MEMORY);
		return (0);
	}

	if (inet_aton(hostname, &in)) {
		*res = malloc_ai(port, in.s_addr, hints);
		if (*res == NULL)
			return (EAI_MEMORY);
		return (0);
	}

	/* Don't try DNS if AI_NUMERICHOST is set */
	if (hints && hints->ai_flags & AI_NUMERICHOST)
		return (EAI_NONAME);

	Tcl_MutexLock(&netdbMutex);
	hp = gethostbyname(hostname);
	if (hp && hp->h_name && hp->h_name[0] && hp->h_addr_list[0]) {
		struct addrinfo *cur, *prev;

		cur = prev = *res = NULL;
		for (i = 0; hp->h_addr_list[i]; i++) {
			struct in_addr *in = (struct in_addr *)hp->h_addr_list[i];

			cur = malloc_ai(port, in->s_addr, hints);
			if (cur == NULL) {
				if (*res != NULL)
					freeaddrinfo(*res);
				Tcl_MutexUnlock(&netdbMutex);
				return (EAI_MEMORY);
			}
			if (prev)
				prev->ai_next = cur;
			else
				*res = cur;

			prev = cur;
		}
		Tcl_MutexUnlock(&netdbMutex);
		return (0);
	}
	Tcl_MutexUnlock(&netdbMutex);
	return (EAI_NODATA);
}
#endif /* !HAVE_GETADDRINFO */

Deleted compat/fake-rfc2553.h.

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










































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Copyright (C) 2000-2003 Damien Miller.  All rights reserved.
 * Copyright (C) 1999 WIDE Project.  All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. Neither the name of the project nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

/*
 * Pseudo-implementation of RFC2553 name / address resolution functions
 *
 * But these functions are not implemented correctly. The minimum subset
 * is implemented for ssh use only. For example, this routine assumes
 * that ai_family is AF_INET. Don't use it for another purpose.
 */

#ifndef _FAKE_RFC2553_H
#define _FAKE_RFC2553_H

/*
 * First, socket and INET6 related definitions
 */
#ifndef HAVE_STRUCT_SOCKADDR_STORAGE
# define	_SS_MAXSIZE	128	/* Implementation specific max size */
# define       _SS_PADSIZE     (_SS_MAXSIZE - sizeof (struct sockaddr))
struct sockaddr_storage {
	struct sockaddr	ss_sa;
	char		__ss_pad2[_SS_PADSIZE];
};
# define ss_family ss_sa.sa_family
#endif /* !HAVE_STRUCT_SOCKADDR_STORAGE */

#ifndef IN6_IS_ADDR_LOOPBACK
# define IN6_IS_ADDR_LOOPBACK(a) \
	(((uint32_t *)(a))[0] == 0 && ((uint32_t *)(a))[1] == 0 && \
	 ((uint32_t *)(a))[2] == 0 && ((uint32_t *)(a))[3] == htonl(1))
#endif /* !IN6_IS_ADDR_LOOPBACK */

#ifndef HAVE_STRUCT_IN6_ADDR
struct in6_addr {
	uint8_t	s6_addr[16];
};
#endif /* !HAVE_STRUCT_IN6_ADDR */

#ifndef HAVE_STRUCT_SOCKADDR_IN6
struct sockaddr_in6 {
	unsigned short	sin6_family;
	uint16_t	sin6_port;
	uint32_t	sin6_flowinfo;
	struct in6_addr	sin6_addr;
	uint32_t	sin6_scope_id;
};
#endif /* !HAVE_STRUCT_SOCKADDR_IN6 */

#ifndef AF_INET6
/* Define it to something that should never appear */
#define AF_INET6 AF_MAX
#endif

/*
 * Next, RFC2553 name / address resolution API
 */

#ifndef NI_NUMERICHOST
# define NI_NUMERICHOST    (1)
#endif
#ifndef NI_NAMEREQD
# define NI_NAMEREQD       (1<<1)
#endif
#ifndef NI_NUMERICSERV
# define NI_NUMERICSERV    (1<<2)
#endif

#ifndef AI_PASSIVE
# define AI_PASSIVE		(1)
#endif
#ifndef AI_CANONNAME
# define AI_CANONNAME		(1<<1)
#endif
#ifndef AI_NUMERICHOST
# define AI_NUMERICHOST		(1<<2)
#endif

#ifndef NI_MAXSERV
# define NI_MAXSERV 32
#endif /* !NI_MAXSERV */
#ifndef NI_MAXHOST
# define NI_MAXHOST 1025
#endif /* !NI_MAXHOST */

#ifndef EAI_NODATA
# define EAI_NODATA	(INT_MAX - 1)
#endif
#ifndef EAI_MEMORY
# define EAI_MEMORY	(INT_MAX - 2)
#endif
#ifndef EAI_NONAME
# define EAI_NONAME	(INT_MAX - 3)
#endif
#ifndef EAI_SYSTEM
# define EAI_SYSTEM	(INT_MAX - 4)
#endif
#ifndef EAI_FAMILY
# define EAI_FAMILY	(INT_MAX - 5)
#endif
#ifndef EAI_SERVICE
# define EAI_SERVICE      -8    /* SERVICE not supported for `ai_socktype'.  */
#endif

#ifndef HAVE_STRUCT_ADDRINFO
struct addrinfo {
	int	ai_flags;	/* AI_PASSIVE, AI_CANONNAME */
	int	ai_family;	/* PF_xxx */
	int	ai_socktype;	/* SOCK_xxx */
	int	ai_protocol;	/* 0 or IPPROTO_xxx for IPv4 and IPv6 */
	size_t	ai_addrlen;	/* length of ai_addr */
	char	*ai_canonname;	/* canonical name for hostname */
	struct sockaddr *ai_addr;	/* binary address */
	struct addrinfo *ai_next;	/* next structure in linked list */
};
#endif /* !HAVE_STRUCT_ADDRINFO */

#ifndef HAVE_GETADDRINFO
#ifdef getaddrinfo
# undef getaddrinfo
#endif
#define getaddrinfo(a,b,c,d)    (fake_getaddrinfo(a,b,c,d))
int getaddrinfo(const char *, const char *,
    const struct addrinfo *, struct addrinfo **);
#endif /* !HAVE_GETADDRINFO */

#ifndef HAVE_GAI_STRERROR
#define gai_strerror(a)         (fake_gai_strerror(a))
const char *gai_strerror(int);
#endif /* !HAVE_GAI_STRERROR */

#ifndef HAVE_FREEADDRINFO
#define freeaddrinfo(a)         (fake_freeaddrinfo(a))
void freeaddrinfo(struct addrinfo *);
#endif /* !HAVE_FREEADDRINFO */

#ifndef HAVE_GETNAMEINFO
#define getnameinfo(a,b,c,d,e,f,g) (fake_getnameinfo(a,b,c,d,e,f,g))
int getnameinfo(const struct sockaddr *, size_t, char *, size_t,
    char *, size_t, int);
#endif /* !HAVE_GETNAMEINFO */


#endif /* !_FAKE_RFC2553_H */

Added compat/fixstrtod.c.





































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * fixstrtod.c --
 *
 *	Source code for the "fixstrtod" procedure.  This procedure is
 *	used in place of strtod under Solaris 2.4, in order to fix
 *	a bug where the "end" pointer gets set incorrectly.
 *
 * Copyright (c) 1995 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 <stdio.h>

#undef strtod

/*
 * Declare strtod explicitly rather than including stdlib.h, since in
 * somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
 */

extern double strtod(char *, char **);

double
fixstrtod(
    char *string,
    char **endPtr)
{
    double d;
    d = strtod(string, endPtr);
    if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
	*endPtr -= 1;
    }
    return d;
}

Added compat/float.h.















1
2
3
4
5
6
7
8
9
10
11
12
13
14
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * float.h --
 *
 *	This is a dummy header file to #include in Tcl when there
 *	is no float.h in /usr/include.  Right now this file is empty:
 *	Tcl contains #ifdefs to deal with the lack of definitions;
 *	all it needs is for the #include statement to work.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

Added compat/limits.h.























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * limits.h --
 *
 *	This is a dummy header file to #include in Tcl when there
 *	is no limits.h in /usr/include.  There are only a few
 *	definitions here;  also see tclPort.h, which already
 *	#defines some of the things here if they're not arleady
 *	defined.
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#define LONG_MIN		0x80000000
#define LONG_MAX		0x7fffffff
#define INT_MIN			0x80000000
#define INT_MAX			0x7fffffff
#define SHRT_MIN		0x8000
#define SHRT_MAX		0x7fff

Deleted compat/mkstemp.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * mkstemp.c --
 *
 *	Source code for the "mkstemp" library routine.
 *
 * 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.
 */

#include <errno.h>
#include <fcntl.h>
#include <stdlib.h>
#include <unistd.h>
#include <string.h>

/*
 *----------------------------------------------------------------------
 *
 * mkstemp --
 *
 *	Create an open temporary file from a template.
 *
 * Results:
 *	A file descriptor, or -1 (with errno set) in the case of an error.
 *
 * Side effects:
 *	The template is updated to contain the real filename.
 *
 *----------------------------------------------------------------------
 */

int
mkstemp(
    char *tmpl)		/* Template for filename. */
{
    static const char alphanumerics[] =
	"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
    char *a, *b;
    int fd, count, alphanumericsLen = strlen(alphanumerics); /* == 62 */

    a = tmpl + strlen(tmpl);
    while (a > tmpl && *(a-1) == 'X') {
	a--;
    }

    if (a == tmpl) {
	errno = ENOENT;
	return -1;
    }

    /*
     * We'll only try up to 10 times; after that, we're suffering from enemy
     * action and should let the caller know.
     */

    count = 10;
    do {
	/*
	 * Replace the X's in the original template with random alphanumeric
	 * digits.
	 */

	for (b=a ; *b ; b++) {
	    float r = rand() / ((float) RAND_MAX);

	    *b = alphanumerics[(int)(r * alphanumericsLen)];
	}

	/*
	 * Template is now realized; try to open (with correct options).
	 */

	fd = open(tmpl, O_RDWR|O_CREAT|O_EXCL, 0600);
    } while (fd == -1 && errno == EEXIST && --count > 0);

    return fd;
}

Changes to compat/opendir.c.

24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38







-
+







    int fd;
    const char *myname;

    myname = ((*name == '\0') ? "." : name);
    if ((fd = open(myname, 0, 0)) == -1) {
	return NULL;
    }
    dirp = (DIR *) Tcl_Alloc(sizeof(DIR));
    dirp = (DIR *) ckalloc(sizeof(DIR));
    if (dirp == NULL) {
	/* unreachable? */
	close(fd);
	return NULL;
    }
    dirp->dd_fd = fd;
    dirp->dd_loc = 0;
102
103
104
105
106
107
108
109

110
102
103
104
105
106
107
108

109
110







-
+

void
closedir(
    DIR *dirp)
{
    close(dirp->dd_fd);
    dirp->dd_fd = -1;
    dirp->dd_loc = 0;
    Tcl_Free(dirp);
    ckfree(dirp);
}

Deleted compat/stdint.h.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919























































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*  A portable stdint.h
 ****************************************************************************
 *  BSD License:
 ****************************************************************************
 *
 *  Copyright (c) 2005-2016 Paul Hsieh
 *  All rights reserved.
 *
 *  Redistribution and use in source and binary forms, with or without
 *  modification, are permitted provided that the following conditions
 *  are met:
 *
 *  1. Redistributions of source code must retain the above copyright
 *     notice, this list of conditions and the following disclaimer.
 *  2. Redistributions in binary form must reproduce the above copyright
 *     notice, this list of conditions and the following disclaimer in the
 *     documentation and/or other materials provided with the distribution.
 *  3. The name of the author may not be used to endorse or promote products
 *     derived from this software without specific prior written permission.
 *
 *  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
 *  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 *  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 *  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
 *  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
 *  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 *  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 *  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 *  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 *  THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 ****************************************************************************
 *
 *  Version 0.1.16.0
 *
 *  The ANSI C standard committee, for the C99 standard, specified the
 *  inclusion of a new standard include file called stdint.h.  This is
 *  a very useful and long desired include file which contains several
 *  very precise definitions for integer scalar types that is critically
 *  important for making several classes of applications portable
 *  including cryptography, hashing, variable length integer libraries
 *  and so on.  But for most developers its likely useful just for
 *  programming sanity.
 *
 *  The problem is that some compiler vendors chose to ignore the C99
 *  standard and some older compilers have no opportunity to be updated.
 *  Because of this situation, simply including stdint.h in your code
 *  makes it unportable.
 *
 *  So that's what this file is all about.  It's an attempt to build a
 *  single universal include file that works on as many platforms as
 *  possible to deliver what stdint.h is supposed to.  Even compilers
 *  that already come with stdint.h can use this file instead without
 *  any loss of functionality.  A few things that should be noted about
 *  this file:
 *
 *    1) It is not guaranteed to be portable and/or present an identical
 *       interface on all platforms.  The extreme variability of the
 *       ANSI C standard makes this an impossibility right from the
 *       very get go. Its really only meant to be useful for the vast
 *       majority of platforms that possess the capability of
 *       implementing usefully and precisely defined, standard sized
 *       integer scalars.  Systems which are not intrinsically 2s
 *       complement may produce invalid constants.
 *
 *    2) There is an unavoidable use of non-reserved symbols.
 *
 *    3) Other standard include files are invoked.
 *
 *    4) This file may come in conflict with future platforms that do
 *       include stdint.h.  The hope is that one or the other can be
 *       used with no real difference.
 *
 *    5) In the current version, if your platform can't represent
 *       int32_t, int16_t and int8_t, it just dumps out with a compiler
 *       error.
 *
 *    6) 64 bit integers may or may not be defined.  Test for their
 *       presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX.
 *       Note that this is different from the C99 specification which
 *       requires the existence of 64 bit support in the compiler.  If
 *       this is not defined for your platform, yet it is capable of
 *       dealing with 64 bits then it is because this file has not yet
 *       been extended to cover all of your system's capabilities.
 *
 *    7) (u)intptr_t may or may not be defined.  Test for its presence
 *       with the test: #ifdef PTRDIFF_MAX.  If this is not defined
 *       for your platform, then it is because this file has not yet
 *       been extended to cover all of your system's capabilities, not
 *       because its optional.
 *
 *    8) The following might not been defined even if your platform is
 *       capable of defining it:
 *
 *       WCHAR_MIN
 *       WCHAR_MAX
 *       (u)int64_t
 *       PTRDIFF_MIN
 *       PTRDIFF_MAX
 *       (u)intptr_t
 *
 *    9) The following have not been defined:
 *
 *       WINT_MIN
 *       WINT_MAX
 *
 *   10) The criteria for defining (u)int_least(*)_t isn't clear,
 *       except for systems which don't have a type that precisely
 *       defined 8, 16, or 32 bit types (which this include file does
 *       not support anyways). Default definitions have been given.
 *
 *   11) The criteria for defining (u)int_fast(*)_t isn't something I
 *       would trust to any particular compiler vendor or the ANSI C
 *       committee.  It is well known that "compatible systems" are
 *       commonly created that have very different performance
 *       characteristics from the systems they are compatible with,
 *       especially those whose vendors make both the compiler and the
 *       system.  Default definitions have been given, but its strongly
 *       recommended that users never use these definitions for any
 *       reason (they do *NOT* deliver any serious guarantee of
 *       improved performance -- not in this file, nor any vendor's
 *       stdint.h).
 *
 *   12) The following macros:
 *
 *       PRINTF_INTMAX_MODIFIER
 *       PRINTF_INT64_MODIFIER
 *       PRINTF_INT32_MODIFIER
 *       PRINTF_INT16_MODIFIER
 *       PRINTF_LEAST64_MODIFIER
 *       PRINTF_LEAST32_MODIFIER
 *       PRINTF_LEAST16_MODIFIER
 *       PRINTF_INTPTR_MODIFIER
 *
 *       are strings which have been defined as the modifiers required
 *       for the "d", "u" and "x" printf formats to correctly output
 *       (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t,
 *       (u)least32_t, (u)least16_t and (u)intptr_t types respectively.
 *       PRINTF_INTPTR_MODIFIER is not defined for some systems which
 *       provide their own stdint.h.  PRINTF_INT64_MODIFIER is not
 *       defined if INT64_MAX is not defined.  These are an extension
 *       beyond what C99 specifies must be in stdint.h.
 *
 *       In addition, the following macros are defined:
 *
 *       PRINTF_INTMAX_HEX_WIDTH
 *       PRINTF_INT64_HEX_WIDTH
 *       PRINTF_INT32_HEX_WIDTH
 *       PRINTF_INT16_HEX_WIDTH
 *       PRINTF_INT8_HEX_WIDTH
 *       PRINTF_INTMAX_DEC_WIDTH
 *       PRINTF_INT64_DEC_WIDTH
 *       PRINTF_INT32_DEC_WIDTH
 *       PRINTF_INT16_DEC_WIDTH
 *       PRINTF_UINT8_DEC_WIDTH
 *       PRINTF_UINTMAX_DEC_WIDTH
 *       PRINTF_UINT64_DEC_WIDTH
 *       PRINTF_UINT32_DEC_WIDTH
 *       PRINTF_UINT16_DEC_WIDTH
 *       PRINTF_UINT8_DEC_WIDTH
 *
 *       Which specifies the maximum number of characters required to
 *       print the number of that type in either hexadecimal or decimal.
 *       These are an extension beyond what C99 specifies must be in
 *       stdint.h.
 *
 *  Compilers tested (all with 0 warnings at their highest respective
 *  settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32
 *  bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio
 *  .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3
 *
 *  This file should be considered a work in progress.  Suggestions for
 *  improvements, especially those which increase coverage are strongly
 *  encouraged.
 *
 *  Acknowledgements
 *
 *  The following people have made significant contributions to the
 *  development and testing of this file:
 *
 *  Chris Howie
 *  John Steele Scott
 *  Dave Thorup
 *  John Dill
 *  Florian Wobbe
 *  Christopher Sean Morrison
 *  Mikkel Fahnoe Jorgensen
 *
 */

#include <stddef.h>
#include <limits.h>
#include <signal.h>

/*
 *  For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and
 *  do nothing else.  On the Mac OS X version of gcc this is _STDINT_H_.
 */

#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED)
#include <stdint.h>
#define _PSTDINT_H_INCLUDED
# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__))
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "l"
#  endif
#  ifndef PRINTF_INT32_MODIFIER
#   define PRINTF_INT32_MODIFIER ""
#  endif
# else
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
#  ifndef PRINTF_INT32_MODIFIER
#   if (UINT_MAX == UINT32_MAX)
#    define PRINTF_INT32_MODIFIER ""
#   else
#    define PRINTF_INT32_MODIFIER "l"
#   endif
#  endif
# endif
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
# ifndef PRINTF_INTMAX_MODIFIER
#  define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INT64_HEX_WIDTH
#  define PRINTF_INT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_UINT64_HEX_WIDTH
#  define PRINTF_UINT64_HEX_WIDTH "16"
# endif
# ifndef PRINTF_INT32_HEX_WIDTH
#  define PRINTF_INT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_UINT32_HEX_WIDTH
#  define PRINTF_UINT32_HEX_WIDTH "8"
# endif
# ifndef PRINTF_INT16_HEX_WIDTH
#  define PRINTF_INT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_UINT16_HEX_WIDTH
#  define PRINTF_UINT16_HEX_WIDTH "4"
# endif
# ifndef PRINTF_INT8_HEX_WIDTH
#  define PRINTF_INT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_UINT8_HEX_WIDTH
#  define PRINTF_UINT8_HEX_WIDTH "2"
# endif
# ifndef PRINTF_INT64_DEC_WIDTH
#  define PRINTF_INT64_DEC_WIDTH "19"
# endif
# ifndef PRINTF_UINT64_DEC_WIDTH
#  define PRINTF_UINT64_DEC_WIDTH "20"
# endif
# ifndef PRINTF_INT32_DEC_WIDTH
#  define PRINTF_INT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_UINT32_DEC_WIDTH
#  define PRINTF_UINT32_DEC_WIDTH "10"
# endif
# ifndef PRINTF_INT16_DEC_WIDTH
#  define PRINTF_INT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_UINT16_DEC_WIDTH
#  define PRINTF_UINT16_DEC_WIDTH "5"
# endif
# ifndef PRINTF_INT8_DEC_WIDTH
#  define PRINTF_INT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_UINT8_DEC_WIDTH
#  define PRINTF_UINT8_DEC_WIDTH "3"
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_UINTMAX_HEX_WIDTH
#  define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif
# ifndef PRINTF_UINTMAX_DEC_WIDTH
#  define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
# endif

/*
 *  Something really weird is going on with Open Watcom.  Just pull some of
 *  these duplicated definitions from Open Watcom's stdint.h file for now.
 */

# if defined (__WATCOMC__) && __WATCOMC__ >= 1250
#  if !defined (INT64_C)
#   define INT64_C(x)   (x + (INT64_MAX - INT64_MAX))
#  endif
#  if !defined (UINT64_C)
#   define UINT64_C(x)  (x + (UINT64_MAX - UINT64_MAX))
#  endif
#  if !defined (INT32_C)
#   define INT32_C(x)   (x + (INT32_MAX - INT32_MAX))
#  endif
#  if !defined (UINT32_C)
#   define UINT32_C(x)  (x + (UINT32_MAX - UINT32_MAX))
#  endif
#  if !defined (INT16_C)
#   define INT16_C(x)   (x)
#  endif
#  if !defined (UINT16_C)
#   define UINT16_C(x)  (x)
#  endif
#  if !defined (INT8_C)
#   define INT8_C(x)   (x)
#  endif
#  if !defined (UINT8_C)
#   define UINT8_C(x)  (x)
#  endif
#  if !defined (UINT64_MAX)
#   define UINT64_MAX  18446744073709551615ULL
#  endif
#  if !defined (INT64_MAX)
#   define INT64_MAX  9223372036854775807LL
#  endif
#  if !defined (UINT32_MAX)
#   define UINT32_MAX  4294967295UL
#  endif
#  if !defined (INT32_MAX)
#   define INT32_MAX  2147483647L
#  endif
#  if !defined (INTMAX_MAX)
#   define INTMAX_MAX INT64_MAX
#  endif
#  if !defined (INTMAX_MIN)
#   define INTMAX_MIN INT64_MIN
#  endif
# endif
#endif

/*
 *  I have no idea what is the truly correct thing to do on older Solaris.
 *  From some online discussions, this seems to be what is being
 *  recommended.  For people who actually are developing on older Solaris,
 *  what I would like to know is, does this define all of the relevant
 *  macros of a complete stdint.h?  Remember, in pstdint.h 64 bit is
 *  considered optional.
 */

#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED)
#include <sys/inttypes.h>
#define _PSTDINT_H_INCLUDED
#endif

#ifndef _PSTDINT_H_INCLUDED
#define _PSTDINT_H_INCLUDED

#ifndef SIZE_MAX
# define SIZE_MAX ((size_t)-1)
#endif

/*
 *  Deduce the type assignments from limits.h under the assumption that
 *  integer sizes in bits are powers of 2, and follow the ANSI
 *  definitions.
 */

#ifndef UINT8_MAX
# define UINT8_MAX 0xff
#endif
#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks)
# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S)
    typedef unsigned char uint8_t;
#   define UINT8_C(v) ((uint8_t) v)
# else
#   error "Platform not supported"
# endif
#endif

#ifndef INT8_MAX
# define INT8_MAX 0x7f
#endif
#ifndef INT8_MIN
# define INT8_MIN INT8_C(0x80)
#endif
#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks)
# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S)
    typedef signed char int8_t;
#   define INT8_C(v) ((int8_t) v)
# else
#   error "Platform not supported"
# endif
#endif

#ifndef UINT16_MAX
# define UINT16_MAX 0xffff
#endif
#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks)
#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S)
  typedef unsigned int uint16_t;
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER ""
# endif
# define UINT16_C(v) ((uint16_t) (v))
#elif (USHRT_MAX == UINT16_MAX)
  typedef unsigned short uint16_t;
# define UINT16_C(v) ((uint16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef INT16_MAX
# define INT16_MAX 0x7fff
#endif
#ifndef INT16_MIN
# define INT16_MIN INT16_C(0x8000)
#endif
#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks)
#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S)
  typedef signed int int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER ""
# endif
#elif (SHRT_MAX == INT16_MAX)
  typedef signed short int16_t;
# define INT16_C(v) ((int16_t) (v))
# ifndef PRINTF_INT16_MODIFIER
#  define PRINTF_INT16_MODIFIER "h"
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef UINT32_MAX
# define UINT32_MAX (0xffffffffUL)
#endif
#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks)
#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S)
  typedef unsigned long uint32_t;
# define UINT32_C(v) v ## UL
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER "l"
# endif
#elif (UINT_MAX == UINT32_MAX)
  typedef unsigned int uint32_t;
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
# define UINT32_C(v) v ## U
#elif (USHRT_MAX == UINT32_MAX)
  typedef unsigned short uint32_t;
# define UINT32_C(v) ((unsigned short) (v))
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif

#ifndef INT32_MAX
# define INT32_MAX (0x7fffffffL)
#endif
#ifndef INT32_MIN
# define INT32_MIN INT32_C(0x80000000)
#endif
#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks)
#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S)
  typedef signed long int32_t;
# define INT32_C(v) v ## L
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER "l"
# endif
#elif (INT_MAX == INT32_MAX)
  typedef signed int int32_t;
# define INT32_C(v) v
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#elif (SHRT_MAX == INT32_MAX)
  typedef signed short int32_t;
# define INT32_C(v) ((short) (v))
# ifndef PRINTF_INT32_MODIFIER
#  define PRINTF_INT32_MODIFIER ""
# endif
#else
#error "Platform not supported"
#endif
#endif

/*
 *  The macro stdint_int64_defined is temporarily used to record
 *  whether or not 64 integer support is available.  It must be
 *  defined for any 64 integer extensions for new platforms that are
 *  added.
 */

#undef stdint_int64_defined
#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S)
# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S)
#  define stdint_int64_defined
   typedef long long int64_t;
   typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# endif
#endif

#if !defined (stdint_int64_defined)
# if defined(__GNUC__) && !defined(vxWorks)
#  define stdint_int64_defined
   __extension__ typedef long long int64_t;
   __extension__ typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S)
#  define stdint_int64_defined
   typedef long long int64_t;
   typedef unsigned long long uint64_t;
#  define UINT64_C(v) v ## ULL
#  define  INT64_C(v) v ## LL
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "ll"
#  endif
# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC)
#  define stdint_int64_defined
   typedef __int64 int64_t;
   typedef unsigned __int64 uint64_t;
#  define UINT64_C(v) v ## UI64
#  define  INT64_C(v) v ## I64
#  ifndef PRINTF_INT64_MODIFIER
#   define PRINTF_INT64_MODIFIER "I64"
#  endif
# endif
#endif

#if !defined (LONG_LONG_MAX) && defined (INT64_C)
# define LONG_LONG_MAX INT64_C (9223372036854775807)
#endif
#ifndef ULONG_LONG_MAX
# define ULONG_LONG_MAX UINT64_C (18446744073709551615)
#endif

#if !defined (INT64_MAX) && defined (INT64_C)
# define INT64_MAX INT64_C (9223372036854775807)
#endif
#if !defined (INT64_MIN) && defined (INT64_C)
# define INT64_MIN INT64_C (-9223372036854775808)
#endif
#if !defined (UINT64_MAX) && defined (INT64_C)
# define UINT64_MAX UINT64_C (18446744073709551615)
#endif

/*
 *  Width of hexadecimal for number field.
 */

#ifndef PRINTF_INT64_HEX_WIDTH
# define PRINTF_INT64_HEX_WIDTH "16"
#endif
#ifndef PRINTF_INT32_HEX_WIDTH
# define PRINTF_INT32_HEX_WIDTH "8"
#endif
#ifndef PRINTF_INT16_HEX_WIDTH
# define PRINTF_INT16_HEX_WIDTH "4"
#endif
#ifndef PRINTF_INT8_HEX_WIDTH
# define PRINTF_INT8_HEX_WIDTH "2"
#endif
#ifndef PRINTF_INT64_DEC_WIDTH
# define PRINTF_INT64_DEC_WIDTH "19"
#endif
#ifndef PRINTF_INT32_DEC_WIDTH
# define PRINTF_INT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_INT16_DEC_WIDTH
# define PRINTF_INT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_INT8_DEC_WIDTH
# define PRINTF_INT8_DEC_WIDTH "3"
#endif
#ifndef PRINTF_UINT64_DEC_WIDTH
# define PRINTF_UINT64_DEC_WIDTH "20"
#endif
#ifndef PRINTF_UINT32_DEC_WIDTH
# define PRINTF_UINT32_DEC_WIDTH "10"
#endif
#ifndef PRINTF_UINT16_DEC_WIDTH
# define PRINTF_UINT16_DEC_WIDTH "5"
#endif
#ifndef PRINTF_UINT8_DEC_WIDTH
# define PRINTF_UINT8_DEC_WIDTH "3"
#endif

/*
 *  Ok, lets not worry about 128 bit integers for now.  Moore's law says
 *  we don't need to worry about that until about 2040 at which point
 *  we'll have bigger things to worry about.
 */

#ifdef stdint_int64_defined
  typedef int64_t intmax_t;
  typedef uint64_t uintmax_t;
# define  INTMAX_MAX   INT64_MAX
# define  INTMAX_MIN   INT64_MIN
# define UINTMAX_MAX  UINT64_MAX
# define UINTMAX_C(v) UINT64_C(v)
# define  INTMAX_C(v)  INT64_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
#   define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH
# endif
#else
  typedef int32_t intmax_t;
  typedef uint32_t uintmax_t;
# define  INTMAX_MAX   INT32_MAX
# define UINTMAX_MAX  UINT32_MAX
# define UINTMAX_C(v) UINT32_C(v)
# define  INTMAX_C(v)  INT32_C(v)
# ifndef PRINTF_INTMAX_MODIFIER
#   define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER
# endif
# ifndef PRINTF_INTMAX_HEX_WIDTH
#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH
# endif
# ifndef PRINTF_INTMAX_DEC_WIDTH
#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH
# endif
#endif

/*
 *  Because this file currently only supports platforms which have
 *  precise powers of 2 as bit sizes for the default integers, the
 *  least definitions are all trivial.  Its possible that a future
 *  version of this file could have different definitions.
 */

#ifndef stdint_least_defined
  typedef   int8_t   int_least8_t;
  typedef  uint8_t  uint_least8_t;
  typedef  int16_t  int_least16_t;
  typedef uint16_t uint_least16_t;
  typedef  int32_t  int_least32_t;
  typedef uint32_t uint_least32_t;
# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER
# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER
# define  UINT_LEAST8_MAX  UINT8_MAX
# define   INT_LEAST8_MAX   INT8_MAX
# define UINT_LEAST16_MAX UINT16_MAX
# define  INT_LEAST16_MAX  INT16_MAX
# define UINT_LEAST32_MAX UINT32_MAX
# define  INT_LEAST32_MAX  INT32_MAX
# define   INT_LEAST8_MIN   INT8_MIN
# define  INT_LEAST16_MIN  INT16_MIN
# define  INT_LEAST32_MIN  INT32_MIN
# ifdef stdint_int64_defined
    typedef  int64_t  int_least64_t;
    typedef uint64_t uint_least64_t;
#   define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER
#   define UINT_LEAST64_MAX UINT64_MAX
#   define  INT_LEAST64_MAX  INT64_MAX
#   define  INT_LEAST64_MIN  INT64_MIN
# endif
#endif
#undef stdint_least_defined

/*
 *  The ANSI C committee has defined *int*_fast*_t types as well.  This,
 *  of course, defies rationality -- you can't know what will be fast
 *  just from the type itself.  Even for a given architecture, compatible
 *  implementations might have different performance characteristics.
 *  Developers are warned to stay away from these types when using this
 *  or any other stdint.h.
 */

typedef   int_least8_t   int_fast8_t;
typedef  uint_least8_t  uint_fast8_t;
typedef  int_least16_t  int_fast16_t;
typedef uint_least16_t uint_fast16_t;
typedef  int_least32_t  int_fast32_t;
typedef uint_least32_t uint_fast32_t;
#define  UINT_FAST8_MAX  UINT_LEAST8_MAX
#define   INT_FAST8_MAX   INT_LEAST8_MAX
#define UINT_FAST16_MAX UINT_LEAST16_MAX
#define  INT_FAST16_MAX  INT_LEAST16_MAX
#define UINT_FAST32_MAX UINT_LEAST32_MAX
#define  INT_FAST32_MAX  INT_LEAST32_MAX
#define   INT_FAST8_MIN   INT_LEAST8_MIN
#define  INT_FAST16_MIN  INT_LEAST16_MIN
#define  INT_FAST32_MIN  INT_LEAST32_MIN
#ifdef stdint_int64_defined
  typedef  int_least64_t  int_fast64_t;
  typedef uint_least64_t uint_fast64_t;
# define UINT_FAST64_MAX UINT_LEAST64_MAX
# define  INT_FAST64_MAX  INT_LEAST64_MAX
# define  INT_FAST64_MIN  INT_LEAST64_MIN
#endif

#undef stdint_int64_defined

/*
 *  Whatever piecemeal, per compiler thing we can do about the wchar_t
 *  type limits.
 */

#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks)
# include <wchar.h>
# ifndef WCHAR_MIN
#  define WCHAR_MIN 0
# endif
# ifndef WCHAR_MAX
#  define WCHAR_MAX ((wchar_t)-1)
# endif
#endif

/*
 *  Whatever piecemeal, per compiler/platform thing we can do about the
 *  (u)intptr_t types and limits.
 */

#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T)
# define STDINT_H_UINTPTR_T_DEFINED
#endif

#ifndef STDINT_H_UINTPTR_T_DEFINED
# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__)
#  define stdint_intptr_bits 64
# elif defined (__WATCOMC__) || defined (__TURBOC__)
#  if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__)
#    define stdint_intptr_bits 16
#  else
#    define stdint_intptr_bits 32
#  endif
# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__)
#  define stdint_intptr_bits 32
# elif defined (__INTEL_COMPILER)
/* TODO -- what did Intel do about x86-64? */
# else
/* #error "This platform might not be supported yet" */
# endif

# ifdef stdint_intptr_bits
#  define stdint_intptr_glue3_i(a,b,c)  a##b##c
#  define stdint_intptr_glue3(a,b,c)    stdint_intptr_glue3_i(a,b,c)
#  ifndef PRINTF_INTPTR_MODIFIER
#    define PRINTF_INTPTR_MODIFIER      stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER)
#  endif
#  ifndef PTRDIFF_MAX
#    define PTRDIFF_MAX                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef PTRDIFF_MIN
#    define PTRDIFF_MIN                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
#  endif
#  ifndef UINTPTR_MAX
#    define UINTPTR_MAX                 stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef INTPTR_MAX
#    define INTPTR_MAX                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
#  endif
#  ifndef INTPTR_MIN
#    define INTPTR_MIN                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
#  endif
#  ifndef INTPTR_C
#    define INTPTR_C(x)                 stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x)
#  endif
#  ifndef UINTPTR_C
#    define UINTPTR_C(x)                stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x)
#  endif
  typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t;
  typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t)  intptr_t;
# else
/* TODO -- This following is likely wrong for some platforms, and does
   nothing for the definition of uintptr_t. */
  typedef ptrdiff_t intptr_t;
# endif
# define STDINT_H_UINTPTR_T_DEFINED
#endif

/*
 *  Assumes sig_atomic_t is signed and we have a 2s complement machine.
 */

#ifndef SIG_ATOMIC_MAX
# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1)
#endif

#endif

#if defined (__TEST_PSTDINT_FOR_CORRECTNESS)

/*
 *  Please compile with the maximum warning settings to make sure macros are
 *  not defined more than once.
 */

#include <stdlib.h>
#include <stdio.h>
#include <string.h>

#define glue3_aux(x,y,z) x ## y ## z
#define glue3(x,y,z) glue3_aux(x,y,z)

#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0);
#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0);

#define DECL(us,bits) glue3(DECL,us,) (bits)

#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits)

#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; }

#define X_SIZE_MAX ((size_t)-1)

int main () {
	int err_n = 0;
	int err_first = 0;
	DECL(I,8)
	DECL(U,8)
	DECL(I,16)
	DECL(U,16)
	DECL(I,32)
	DECL(U,32)
#ifdef INT64_MAX
	DECL(I,64)
	DECL(U,64)
#endif
	intmax_t imax = INTMAX_C(0);
	uintmax_t umax = UINTMAX_C(0);
	char str0[256], str1[256];

	sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647));
	if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
	if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH));
	sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295));
	if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
	if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH));
#ifdef INT64_MAX
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807));
	if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
	if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1)));
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591));
	if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
	if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1)));
#endif

	sprintf (str0, "%d %x\n", 0, ~0);

	sprintf (str1, "%d %x\n",  i8, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1));
	sprintf (str1, "%u %x\n",  u8, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1));
	sprintf (str1, "%d %x\n",  i16, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1));
	sprintf (str1, "%u %x\n",  u16, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1));
	sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n",  i32, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1));
	sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n",  u32, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1));
#ifdef INT64_MAX
	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n",  i64, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1));
#endif
	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n",  imax, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1));
	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n",  umax, ~0);
	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1));

	TESTUMAX(8);
	TESTUMAX(16);
	TESTUMAX(32);
#ifdef INT64_MAX
	TESTUMAX(64);
#endif

#define STR(v) #v
#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v));
	if (err_n) {
		printf ("pstdint.h is not correct.  Please use sizes below to correct it:\n");
	}

	Q(int)
	Q(unsigned)
	Q(long int)
	Q(short int)
	Q(int8_t)
	Q(int16_t)
	Q(int32_t)
#ifdef INT64_MAX
	Q(int64_t)
#endif

#if UINT_MAX < X_SIZE_MAX
	printf ("UINT_MAX < X_SIZE_MAX\n");
#else
	printf ("UINT_MAX >= X_SIZE_MAX\n");
#endif
	printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX);

	return EXIT_SUCCESS;
}

#endif

Changes to compat/stdlib.h.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







/*
 * stdlib.h --
 *
 *	Declares facilities exported by the "stdlib" portion of the C library.
 *	This file isn't complete in the ANSI-C sense; it only declares things
 *	that are needed by Tcl. This file is needed even on many systems with
 *	their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
 *	all the procedures needed here (such as strtol/strtoul).
 *	all the procedures needed here (such as strtod).
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
25
26
27
28
29
30
31

32
33
34
35
25
26
27
28
29
30
31
32
33
34
35
36







+




extern void		exit(int status);
extern int		free(char *blockPtr);
extern char *		getenv(const char *name);
extern char *		malloc(unsigned int numBytes);
extern void		qsort(void *base, int n, int size, int (*compar)(
			    const void *element1, const void *element2));
extern char *		realloc(char *ptr, unsigned int numBytes);
extern double		strtod(const char *string, char **endPtr);
extern long		strtol(const char *string, char **endPtr, int base);
extern unsigned long	strtoul(const char *string, char **endPtr, int base);

#endif /* _STDLIB */

Changes to compat/string.h.

17
18
19
20
21
22
23

24



25
26

27
28
29
30
31
32

33
34
35
36
37
38
39
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







+

+
+
+

-
+





-
+







 * The following #include is needed to define size_t. (This used to include
 * sys/stdtypes.h but that doesn't exist on older versions of SunOS, e.g.
 * 4.0.2, so I'm trying sys/types.h now.... hopefully it exists everywhere)
 */

#include <sys/types.h>

#ifdef __APPLE__
extern void *		memchr(const void *s, int c, size_t n);
#else
extern char *		memchr(const void *s, int c, size_t n);
#endif
extern int		memcmp(const void *s1, const void *s2, size_t n);
extern void *		memcpy(void *t, const void *f, size_t n);
extern char *		memcpy(void *t, const void *f, size_t n);
#ifdef NO_MEMMOVE
#define memmove(d,s,n)	(bcopy((s), (d), (n)))
#else
extern char *		memmove(void *t, const void *f, size_t n);
#endif
extern void *		memset(void *s, int c, size_t n);
extern char *		memset(void *s, int c, size_t n);

extern int		strcasecmp(const char *s1, const char *s2);
extern char *		strcat(char *dst, const char *src);
extern char *		strchr(const char *string, int c);
extern int		strcmp(const char *s1, const char *s2);
extern char *		strcpy(char *dst, const char *src);
extern size_t		strcspn(const char *string, const char *chars);

Added compat/strtod.c.





























































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * strtod.c --
 *
 *	Source code for the "strtod" library procedure.
 *
 * Copyright (c) 1988-1993 The Regents of the University of California.
 * Copyright (c) 1994 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"
#include <ctype.h>

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif
#ifndef NULL
#define NULL 0
#endif

static int maxExponent = 511;	/* Largest possible base 10 exponent.  Any
				 * exponent larger than this will already
				 * produce underflow or overflow, so there's
				 * no need to worry about additional digits.
				 */
static double powersOf10[] = {	/* Table giving binary powers of 10.  Entry */
    10.,			/* is 10^2^i.  Used to convert decimal */
    100.,			/* exponents into floating-point numbers. */
    1.0e4,
    1.0e8,
    1.0e16,
    1.0e32,
    1.0e64,
    1.0e128,
    1.0e256
};

/*
 *----------------------------------------------------------------------
 *
 * strtod --
 *
 *	This procedure converts a floating-point number from an ASCII
 *	decimal representation to internal double-precision format.
 *
 * Results:
 *	The return value is the double-precision floating-point
 *	representation of the characters in string.  If endPtr isn't
 *	NULL, then *endPtr is filled in with the address of the
 *	next character after the last one that was part of the
 *	floating-point number.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

double
strtod(
    const char *string,		/* A decimal ASCII floating-point number,
				 * optionally preceded by white space. Must
				 * have form "-I.FE-X", where I is the integer
				 * part of the mantissa, F is the fractional
				 * part of the mantissa, and X is the
				 * exponent. Either of the signs may be "+",
				 * "-", or omitted. Either I or F may be
				 * omitted, or both. The decimal point isn't
				 * necessary unless F is present. The "E" may
				 * actually be an "e". E and X may both be
				 * omitted (but not just one). */
    char **endPtr)		/* If non-NULL, store terminating character's
				 * address here. */
{
    int sign, expSign = FALSE;
    double fraction, dblExp, *d;
    const char *p;
    int c;
    int exp = 0;		/* Exponent read from "EX" field. */
    int fracExp = 0;		/* Exponent that derives from the fractional
				 * part. Under normal circumstatnces, it is
				 * the negative of the number of digits in F.
				 * However, if I is very long, the last digits
				 * of I get dropped (otherwise a long I with a
				 * large negative exponent could cause an
				 * unnecessary overflow on I alone). In this
				 * case, fracExp is incremented one for each
				 * dropped digit. */
    int mantSize;		/* Number of digits in mantissa. */
    int decPt;			/* Number of mantissa digits BEFORE decimal
				 * point. */
    const char *pExp;		/* Temporarily holds location of exponent in
				 * string. */

    /*
     * Strip off leading blanks and check for a sign.
     */

    p = string;
    while (isspace(UCHAR(*p))) {
	p += 1;
    }
    if (*p == '-') {
	sign = TRUE;
	p += 1;
    } else {
	if (*p == '+') {
	    p += 1;
	}
	sign = FALSE;
    }

    /*
     * Count the number of digits in the mantissa (including the decimal
     * point), and also locate the decimal point.
     */

    decPt = -1;
    for (mantSize = 0; ; mantSize += 1)
    {
	c = *p;
	if (!isdigit(c)) {
	    if ((c != '.') || (decPt >= 0)) {
		break;
	    }
	    decPt = mantSize;
	}
	p += 1;
    }

    /*
     * Now suck up the digits in the mantissa. Use two integers to collect 9
     * digits each (this is faster than using floating-point). If the mantissa
     * has more than 18 digits, ignore the extras, since they can't affect the
     * value anyway.
     */

    pExp  = p;
    p -= mantSize;
    if (decPt < 0) {
	decPt = mantSize;
    } else {
	mantSize -= 1;		/* One of the digits was the point. */
    }
    if (mantSize > 18) {
	fracExp = decPt - 18;
	mantSize = 18;
    } else {
	fracExp = decPt - mantSize;
    }
    if (mantSize == 0) {
	fraction = 0.0;
	p = string;
	goto done;
    } else {
	int frac1, frac2;

	frac1 = 0;
	for ( ; mantSize > 9; mantSize -= 1) {
	    c = *p;
	    p += 1;
	    if (c == '.') {
		c = *p;
		p += 1;
	    }
	    frac1 = 10*frac1 + (c - '0');
	}
	frac2 = 0;
	for (; mantSize > 0; mantSize -= 1) {
	    c = *p;
	    p += 1;
	    if (c == '.') {
		c = *p;
		p += 1;
	    }
	    frac2 = 10*frac2 + (c - '0');
	}
	fraction = (1.0e9 * frac1) + frac2;
    }

    /*
     * Skim off the exponent.
     */

    p = pExp;
    if ((*p == 'E') || (*p == 'e')) {
	p += 1;
	if (*p == '-') {
	    expSign = TRUE;
	    p += 1;
	} else {
	    if (*p == '+') {
		p += 1;
	    }
	    expSign = FALSE;
	}
	if (!isdigit(UCHAR(*p))) {
	    p = pExp;
	    goto done;
	}
	while (isdigit(UCHAR(*p))) {
	    exp = exp * 10 + (*p - '0');
	    p += 1;
	}
    }
    if (expSign) {
	exp = fracExp - exp;
    } else {
	exp = fracExp + exp;
    }

    /*
     * Generate a floating-point number that represents the exponent. Do this
     * by processing the exponent one bit at a time to combine many powers of
     * 2 of 10. Then combine the exponent with the fraction.
     */

    if (exp < 0) {
	expSign = TRUE;
	exp = -exp;
    } else {
	expSign = FALSE;
    }
    if (exp > maxExponent) {
	exp = maxExponent;
	errno = ERANGE;
    }
    dblExp = 1.0;
    for (d = powersOf10; exp != 0; exp >>= 1, d += 1) {
	if (exp & 01) {
	    dblExp *= *d;
	}
    }
    if (expSign) {
	fraction /= dblExp;
    } else {
	fraction *= dblExp;
    }

  done:
    if (endPtr != NULL) {
	*endPtr = (char *) p;
    }

    if (sign) {
	return -fraction;
    }
    return fraction;
}

Added compat/unistd.h.













































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * unistd.h --
 *
 *      Macros, constants and prototypes for Posix conformance.
 *
 * Copyright 1989 Regents of the University of California Permission to use,
 * copy, modify, and distribute this software and its documentation for any
 * purpose and without fee is hereby granted, provided that the above
 * copyright notice appear in all copies. The University of California makes
 * no representations about the suitability of this software for any purpose.
 * It is provided "as is" without express or implied warranty.
 */

#ifndef _UNISTD
#define _UNISTD

#include <sys/types.h>

#ifndef NULL
#define NULL    0
#endif

/*
 * Strict POSIX stuff goes here. Extensions go down below, in the ifndef
 * _POSIX_SOURCE section.
 */

extern void		_exit(int status);
extern int		access(const char *path, int mode);
extern int		chdir(const char *path);
extern int		chown(const char *path, uid_t owner, gid_t group);
extern int		close(int fd);
extern int		dup(int oldfd);
extern int		dup2(int oldfd, int newfd);
extern int		execl(const char *path, ...);
extern int		execle(const char *path, ...);
extern int		execlp(const char *file, ...);
extern int		execv(const char *path, char **argv);
extern int		execve(const char *path, char **argv, char **envp);
extern int		execvpw(const char *file, char **argv);
extern pid_t		fork(void);
extern char *		getcwd(char *buf, size_t size);
extern gid_t		getegid(void);
extern uid_t		geteuid(void);
extern gid_t		getgid(void);
extern int		getgroups(int bufSize, int *buffer);
extern pid_t		getpid(void);
extern uid_t		getuid(void);
extern int		isatty(int fd);
extern long		lseek(int fd, long offset, int whence);
extern int		pipe(int *fildes);
extern int		read(int fd, char *buf, size_t size);
extern int		setgid(gid_t group);
extern int		setuid(uid_t user);
extern unsigned		sleep(unsigned seconds);
extern char *		ttyname(int fd);
extern int		unlink(const char *path);
extern int		write(int fd, const char *buf, size_t size);

#ifndef	_POSIX_SOURCE
extern char *		crypt(const char *, const char *);
extern int		fchown(int fd, uid_t owner, gid_t group);
extern int		flock(int fd, int operation);
extern int		ftruncate(int fd, unsigned long length);
extern int		ioctl(int fd, int request, ...);
extern int		readlink(const char *path, char *buf, int bufsize);
extern int		setegid(gid_t group);
extern int		seteuidw(uid_t user);
extern int		setreuid(int ruid, int euid);
extern int		symlink(const char *, const char *);
extern int		ttyslot(void);
extern int		truncate(const char *path, unsigned long length);
extern int		vfork(void);
#endif /* _POSIX_SOURCE */

#endif /* _UNISTD */

Changes to compat/waitpid.c.

96
97
98
99
100
101
102
103

104
105
106
107
108
109
110
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110







-
+







	result = waitPtr->pid;
	*statusPtr = *((int *) &waitPtr->status);
	if (prevPtr == NULL) {
	    deadList = waitPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = waitPtr->nextPtr;
	}
	Tcl_Free(waitPtr);
	ckfree((char *) waitPtr);
	return result;
    }

    /*
     * Wait for any process to stop or exit. If it's an acceptable one then
     * return it to the caller; otherwise store information about it in the
     * list of exited processes and try again. On systems that have only wait
152
153
154
155
156
157
158
159

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

159
160
161
162
163
164
165
166
167
168







-
+









    saveInfo:
	for (waitPtr = deadList; waitPtr != NULL; waitPtr = waitPtr->nextPtr) {
	    if (waitPtr->pid == result) {
		waitPtr->status = status;
		goto waitAgain;
	    }
	}
	waitPtr = (WaitInfo *) Tcl_Alloc(sizeof(WaitInfo));
	waitPtr = (WaitInfo *) ckalloc(sizeof(WaitInfo));
	waitPtr->pid = result;
	waitPtr->status = status;
	waitPtr->nextPtr = deadList;
	deadList = waitPtr;

    waitAgain:
	continue;
    }
}

Deleted compat/zlib/CMakeLists.txt.

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

























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
cmake_minimum_required(VERSION 2.4.4)
set(CMAKE_ALLOW_LOOSE_LOOP_CONSTRUCTS ON)

project(zlib C)

set(VERSION "1.2.11")

option(ASM686 "Enable building i686 assembly implementation")
option(AMD64 "Enable building amd64 assembly implementation")

set(INSTALL_BIN_DIR "${CMAKE_INSTALL_PREFIX}/bin" CACHE PATH "Installation directory for executables")
set(INSTALL_LIB_DIR "${CMAKE_INSTALL_PREFIX}/lib" CACHE PATH "Installation directory for libraries")
set(INSTALL_INC_DIR "${CMAKE_INSTALL_PREFIX}/include" CACHE PATH "Installation directory for headers")
set(INSTALL_MAN_DIR "${CMAKE_INSTALL_PREFIX}/share/man" CACHE PATH "Installation directory for manual pages")
set(INSTALL_PKGCONFIG_DIR "${CMAKE_INSTALL_PREFIX}/share/pkgconfig" CACHE PATH "Installation directory for pkgconfig (.pc) files")

include(CheckTypeSize)
include(CheckFunctionExists)
include(CheckIncludeFile)
include(CheckCSourceCompiles)
enable_testing()

check_include_file(sys/types.h HAVE_SYS_TYPES_H)
check_include_file(stdint.h    HAVE_STDINT_H)
check_include_file(stddef.h    HAVE_STDDEF_H)

#
# Check to see if we have large file support
#
set(CMAKE_REQUIRED_DEFINITIONS -D_LARGEFILE64_SOURCE=1)
# We add these other definitions here because CheckTypeSize.cmake
# in CMake 2.4.x does not automatically do so and we want
# compatibility with CMake 2.4.x.
if(HAVE_SYS_TYPES_H)
    list(APPEND CMAKE_REQUIRED_DEFINITIONS -DHAVE_SYS_TYPES_H)
endif()
if(HAVE_STDINT_H)
    list(APPEND CMAKE_REQUIRED_DEFINITIONS -DHAVE_STDINT_H)
endif()
if(HAVE_STDDEF_H)
    list(APPEND CMAKE_REQUIRED_DEFINITIONS -DHAVE_STDDEF_H)
endif()
check_type_size(off64_t OFF64_T)
if(HAVE_OFF64_T)
   add_definitions(-D_LARGEFILE64_SOURCE=1)
endif()
set(CMAKE_REQUIRED_DEFINITIONS) # clear variable

#
# Check for fseeko
#
check_function_exists(fseeko HAVE_FSEEKO)
if(NOT HAVE_FSEEKO)
    add_definitions(-DNO_FSEEKO)
endif()

#
# Check for unistd.h
#
check_include_file(unistd.h Z_HAVE_UNISTD_H)

if(MSVC)
    set(CMAKE_DEBUG_POSTFIX "d")
    add_definitions(-D_CRT_SECURE_NO_DEPRECATE)
    add_definitions(-D_CRT_NONSTDC_NO_DEPRECATE)
    include_directories(${CMAKE_CURRENT_SOURCE_DIR})
endif()

if(NOT CMAKE_CURRENT_SOURCE_DIR STREQUAL CMAKE_CURRENT_BINARY_DIR)
    # If we're doing an out of source build and the user has a zconf.h
    # in their source tree...
    if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h)
        message(STATUS "Renaming")
        message(STATUS "    ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h")
        message(STATUS "to 'zconf.h.included' because this file is included with zlib")
        message(STATUS "but CMake generates it automatically in the build directory.")
        file(RENAME ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h ${CMAKE_CURRENT_SOURCE_DIR}/zconf.h.included)
  endif()
endif()

set(ZLIB_PC ${CMAKE_CURRENT_BINARY_DIR}/zlib.pc)
configure_file( ${CMAKE_CURRENT_SOURCE_DIR}/zlib.pc.cmakein
		${ZLIB_PC} @ONLY)
configure_file(	${CMAKE_CURRENT_SOURCE_DIR}/zconf.h.cmakein
		${CMAKE_CURRENT_BINARY_DIR}/zconf.h @ONLY)
include_directories(${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_SOURCE_DIR})


#============================================================================
# zlib
#============================================================================

set(ZLIB_PUBLIC_HDRS
    ${CMAKE_CURRENT_BINARY_DIR}/zconf.h
    zlib.h
)
set(ZLIB_PRIVATE_HDRS
    crc32.h
    deflate.h
    gzguts.h
    inffast.h
    inffixed.h
    inflate.h
    inftrees.h
    trees.h
    zutil.h
)
set(ZLIB_SRCS
    adler32.c
    compress.c
    crc32.c
    deflate.c
    gzclose.c
    gzlib.c
    gzread.c
    gzwrite.c
    inflate.c
    infback.c
    inftrees.c
    inffast.c
    trees.c
    uncompr.c
    zutil.c
)

if(NOT MINGW)
    set(ZLIB_DLL_SRCS
        win32/zlib1.rc # If present will override custom build rule below.
    )
endif()

if(CMAKE_COMPILER_IS_GNUCC)
    if(ASM686)
        set(ZLIB_ASMS contrib/asm686/match.S)
    elseif (AMD64)
        set(ZLIB_ASMS contrib/amd64/amd64-match.S)
    endif ()

	if(ZLIB_ASMS)
		add_definitions(-DASMV)
		set_source_files_properties(${ZLIB_ASMS} PROPERTIES LANGUAGE C COMPILE_FLAGS -DNO_UNDERLINE)
	endif()
endif()

if(MSVC)
    if(ASM686)
		ENABLE_LANGUAGE(ASM_MASM)
        set(ZLIB_ASMS
			contrib/masmx86/inffas32.asm
			contrib/masmx86/match686.asm
		)
    elseif (AMD64)
		ENABLE_LANGUAGE(ASM_MASM)
        set(ZLIB_ASMS
			contrib/masmx64/gvmat64.asm
			contrib/masmx64/inffasx64.asm
		)
    endif()

	if(ZLIB_ASMS)
		add_definitions(-DASMV -DASMINF)
	endif()
endif()

# parse the full version number from zlib.h and include in ZLIB_FULL_VERSION
file(READ ${CMAKE_CURRENT_SOURCE_DIR}/zlib.h _zlib_h_contents)
string(REGEX REPLACE ".*#define[ \t]+ZLIB_VERSION[ \t]+\"([-0-9A-Za-z.]+)\".*"
    "\\1" ZLIB_FULL_VERSION ${_zlib_h_contents})

if(MINGW)
    # This gets us DLL resource information when compiling on MinGW.
    if(NOT CMAKE_RC_COMPILER)
        set(CMAKE_RC_COMPILER windres.exe)
    endif()

    add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj
                       COMMAND ${CMAKE_RC_COMPILER}
                            -D GCC_WINDRES
                            -I ${CMAKE_CURRENT_SOURCE_DIR}
                            -I ${CMAKE_CURRENT_BINARY_DIR}
                            -o ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj
                            -i ${CMAKE_CURRENT_SOURCE_DIR}/win32/zlib1.rc)
    set(ZLIB_DLL_SRCS ${CMAKE_CURRENT_BINARY_DIR}/zlib1rc.obj)
endif(MINGW)

add_library(zlib SHARED ${ZLIB_SRCS} ${ZLIB_ASMS} ${ZLIB_DLL_SRCS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS})
add_library(zlibstatic STATIC ${ZLIB_SRCS} ${ZLIB_ASMS} ${ZLIB_PUBLIC_HDRS} ${ZLIB_PRIVATE_HDRS})
set_target_properties(zlib PROPERTIES DEFINE_SYMBOL ZLIB_DLL)
set_target_properties(zlib PROPERTIES SOVERSION 1)

if(NOT CYGWIN)
    # This property causes shared libraries on Linux to have the full version
    # encoded into their final filename.  We disable this on Cygwin because
    # it causes cygz-${ZLIB_FULL_VERSION}.dll to be created when cygz.dll
    # seems to be the default.
    #
    # This has no effect with MSVC, on that platform the version info for
    # the DLL comes from the resource file win32/zlib1.rc
    set_target_properties(zlib PROPERTIES VERSION ${ZLIB_FULL_VERSION})
endif()

if(UNIX)
    # On unix-like platforms the library is almost always called libz
   set_target_properties(zlib zlibstatic PROPERTIES OUTPUT_NAME z)
   if(NOT APPLE)
     set_target_properties(zlib PROPERTIES LINK_FLAGS "-Wl,--version-script,\"${CMAKE_CURRENT_SOURCE_DIR}/zlib.map\"")
   endif()
elseif(BUILD_SHARED_LIBS AND WIN32)
    # Creates zlib1.dll when building shared library version
    set_target_properties(zlib PROPERTIES SUFFIX "1.dll")
endif()

if(NOT SKIP_INSTALL_LIBRARIES AND NOT SKIP_INSTALL_ALL )
    install(TARGETS zlib zlibstatic
        RUNTIME DESTINATION "${INSTALL_BIN_DIR}"
        ARCHIVE DESTINATION "${INSTALL_LIB_DIR}"
        LIBRARY DESTINATION "${INSTALL_LIB_DIR}" )
endif()
if(NOT SKIP_INSTALL_HEADERS AND NOT SKIP_INSTALL_ALL )
    install(FILES ${ZLIB_PUBLIC_HDRS} DESTINATION "${INSTALL_INC_DIR}")
endif()
if(NOT SKIP_INSTALL_FILES AND NOT SKIP_INSTALL_ALL )
    install(FILES zlib.3 DESTINATION "${INSTALL_MAN_DIR}/man3")
endif()
if(NOT SKIP_INSTALL_FILES AND NOT SKIP_INSTALL_ALL )
    install(FILES ${ZLIB_PC} DESTINATION "${INSTALL_PKGCONFIG_DIR}")
endif()

#============================================================================
# Example binaries
#============================================================================

add_executable(example test/example.c)
target_link_libraries(example zlib)
add_test(example example)

add_executable(minigzip test/minigzip.c)
target_link_libraries(minigzip zlib)

if(HAVE_OFF64_T)
    add_executable(example64 test/example.c)
    target_link_libraries(example64 zlib)
    set_target_properties(example64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64")
    add_test(example64 example64)

    add_executable(minigzip64 test/minigzip.c)
    target_link_libraries(minigzip64 zlib)
    set_target_properties(minigzip64 PROPERTIES COMPILE_FLAGS "-D_FILE_OFFSET_BITS=64")
endif()

Deleted compat/zlib/ChangeLog.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515











































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

                ChangeLog file for zlib

Changes in 1.2.11 (15 Jan 2017)
- Fix deflate stored bug when pulling last block from window
- Permit immediate deflateParams changes before any deflate input

Changes in 1.2.10 (2 Jan 2017)
- Avoid warnings on snprintf() return value
- Fix bug in deflate_stored() for zero-length input
- Fix bug in gzwrite.c that produced corrupt gzip files
- Remove files to be installed before copying them in Makefile.in
- Add warnings when compiling with assembler code

Changes in 1.2.9 (31 Dec 2016)
- Fix contrib/minizip to permit unzipping with desktop API [Zouzou]
- Improve contrib/blast to return unused bytes
- Assure that gzoffset() is correct when appending
- Improve compress() and uncompress() to support large lengths
- Fix bug in test/example.c where error code not saved
- Remedy Coverity warning [Randers-Pehrson]
- Improve speed of gzprintf() in transparent mode
- Fix inflateInit2() bug when windowBits is 16 or 32
- Change DEBUG macro to ZLIB_DEBUG
- Avoid uninitialized access by gzclose_w()
- Allow building zlib outside of the source directory
- Fix bug that accepted invalid zlib header when windowBits is zero
- Fix gzseek() problem on MinGW due to buggy _lseeki64 there
- Loop on write() calls in gzwrite.c in case of non-blocking I/O
- Add --warn (-w) option to ./configure for more compiler warnings
- Reject a window size of 256 bytes if not using the zlib wrapper
- Fix bug when level 0 used with Z_HUFFMAN or Z_RLE
- Add --debug (-d) option to ./configure to define ZLIB_DEBUG
- Fix bugs in creating a very large gzip header
- Add uncompress2() function, which returns the input size used
- Assure that deflateParams() will not switch functions mid-block
- Dramatically speed up deflation for level 0 (storing)
- Add gzfread(), duplicating the interface of fread()
- Add gzfwrite(), duplicating the interface of fwrite()
- Add deflateGetDictionary() function
- Use snprintf() for later versions of Microsoft C
- Fix *Init macros to use z_ prefix when requested
- Replace as400 with os400 for OS/400 support [Monnerat]
- Add crc32_z() and adler32_z() functions with size_t lengths
- Update Visual Studio project files [AraHaan]

Changes in 1.2.8 (28 Apr 2013)
- Update contrib/minizip/iowin32.c for Windows RT [Vollant]
- Do not force Z_CONST for C++
- Clean up contrib/vstudio [Roß]
- Correct spelling error in zlib.h
- Fix mixed line endings in contrib/vstudio

Changes in 1.2.7.3 (13 Apr 2013)
- Fix version numbers and DLL names in contrib/vstudio/*/zlib.rc

Changes in 1.2.7.2 (13 Apr 2013)
- Change check for a four-byte type back to hexadecimal
- Fix typo in win32/Makefile.msc
- Add casts in gzwrite.c for pointer differences

Changes in 1.2.7.1 (24 Mar 2013)
- Replace use of unsafe string functions with snprintf if available
- Avoid including stddef.h on Windows for Z_SOLO compile [Niessink]
- Fix gzgetc undefine when Z_PREFIX set [Turk]
- Eliminate use of mktemp in Makefile (not always available)
- Fix bug in 'F' mode for gzopen()
- Add inflateGetDictionary() function
- Correct comment in deflate.h
- Use _snprintf for snprintf in Microsoft C
- On Darwin, only use /usr/bin/libtool if libtool is not Apple
- Delete "--version" file if created by "ar --version" [Richard G.]
- Fix configure check for veracity of compiler error return codes
- Fix CMake compilation of static lib for MSVC2010 x64
- Remove unused variable in infback9.c
- Fix argument checks in gzlog_compress() and gzlog_write()
- Clean up the usage of z_const and respect const usage within zlib
- Clean up examples/gzlog.[ch] comparisons of different types
- Avoid shift equal to bits in type (caused endless loop)
- Fix uninitialized value bug in gzputc() introduced by const patches
- Fix memory allocation error in examples/zran.c [Nor]
- Fix bug where gzopen(), gzclose() would write an empty file
- Fix bug in gzclose() when gzwrite() runs out of memory
- Check for input buffer malloc failure in examples/gzappend.c
- Add note to contrib/blast to use binary mode in stdio
- Fix comparisons of differently signed integers in contrib/blast
- Check for invalid code length codes in contrib/puff
- Fix serious but very rare decompression bug in inftrees.c
- Update inflateBack() comments, since inflate() can be faster
- Use underscored I/O function names for WINAPI_FAMILY
- Add _tr_flush_bits to the external symbols prefixed by --zprefix
- Add contrib/vstudio/vc10 pre-build step for static only
- Quote --version-script argument in CMakeLists.txt
- Don't specify --version-script on Apple platforms in CMakeLists.txt
- Fix casting error in contrib/testzlib/testzlib.c
- Fix types in contrib/minizip to match result of get_crc_table()
- Simplify contrib/vstudio/vc10 with 'd' suffix
- Add TOP support to win32/Makefile.msc
- Suport i686 and amd64 assembler builds in CMakeLists.txt
- Fix typos in the use of _LARGEFILE64_SOURCE in zconf.h
- Add vc11 and vc12 build files to contrib/vstudio
- Add gzvprintf() as an undocumented function in zlib
- Fix configure for Sun shell
- Remove runtime check in configure for four-byte integer type
- Add casts and consts to ease user conversion to C++
- Add man pages for minizip and miniunzip
- In Makefile uninstall, don't rm if preceding cd fails
- Do not return Z_BUF_ERROR if deflateParam() has nothing to write

Changes in 1.2.7 (2 May 2012)
- Replace use of memmove() with a simple copy for portability
- Test for existence of strerror
- Restore gzgetc_ for backward compatibility with 1.2.6
- Fix build with non-GNU make on Solaris
- Require gcc 4.0 or later on Mac OS X to use the hidden attribute
- Include unistd.h for Watcom C
- Use __WATCOMC__ instead of __WATCOM__
- Do not use the visibility attribute if NO_VIZ defined
- Improve the detection of no hidden visibility attribute
- Avoid using __int64 for gcc or solo compilation
- Cast to char * in gzprintf to avoid warnings [Zinser]
- Fix make_vms.com for VAX [Zinser]
- Don't use library or built-in byte swaps
- Simplify test and use of gcc hidden attribute
- Fix bug in gzclose_w() when gzwrite() fails to allocate memory
- Add "x" (O_EXCL) and "e" (O_CLOEXEC) modes support to gzopen()
- Fix bug in test/minigzip.c for configure --solo
- Fix contrib/vstudio project link errors [Mohanathas]
- Add ability to choose the builder in make_vms.com [Schweda]
- Add DESTDIR support to mingw32 win32/Makefile.gcc
- Fix comments in win32/Makefile.gcc for proper usage
- Allow overriding the default install locations for cmake
- Generate and install the pkg-config file with cmake
- Build both a static and a shared version of zlib with cmake
- Include version symbols for cmake builds
- If using cmake with MSVC, add the source directory to the includes
- Remove unneeded EXTRA_CFLAGS from win32/Makefile.gcc [Truta]
- Move obsolete emx makefile to old [Truta]
- Allow the use of -Wundef when compiling or using zlib
- Avoid the use of the -u option with mktemp
- Improve inflate() documentation on the use of Z_FINISH
- Recognize clang as gcc
- Add gzopen_w() in Windows for wide character path names
- Rename zconf.h in CMakeLists.txt to move it out of the way
- Add source directory in CMakeLists.txt for building examples
- Look in build directory for zlib.pc in CMakeLists.txt
- Remove gzflags from zlibvc.def in vc9 and vc10
- Fix contrib/minizip compilation in the MinGW environment
- Update ./configure for Solaris, support --64 [Mooney]
- Remove -R. from Solaris shared build (possible security issue)
- Avoid race condition for parallel make (-j) running example
- Fix type mismatch between get_crc_table() and crc_table
- Fix parsing of version with "-" in CMakeLists.txt [Snider, Ziegler]
- Fix the path to zlib.map in CMakeLists.txt
- Force the native libtool in Mac OS X to avoid GNU libtool [Beebe]
- Add instructions to win32/Makefile.gcc for shared install [Torri]

Changes in 1.2.6.1 (12 Feb 2012)
- Avoid the use of the Objective-C reserved name "id"
- Include io.h in gzguts.h for Microsoft compilers
- Fix problem with ./configure --prefix and gzgetc macro
- Include gz_header definition when compiling zlib solo
- Put gzflags() functionality back in zutil.c
- Avoid library header include in crc32.c for Z_SOLO
- Use name in GCC_CLASSIC as C compiler for coverage testing, if set
- Minor cleanup in contrib/minizip/zip.c [Vollant]
- Update make_vms.com [Zinser]
- Remove unnecessary gzgetc_ function
- Use optimized byte swap operations for Microsoft and GNU [Snyder]
- Fix minor typo in zlib.h comments [Rzesniowiecki]

Changes in 1.2.6 (29 Jan 2012)
- Update the Pascal interface in contrib/pascal
- Fix function numbers for gzgetc_ in zlibvc.def files
- Fix configure.ac for contrib/minizip [Schiffer]
- Fix large-entry detection in minizip on 64-bit systems [Schiffer]
- Have ./configure use the compiler return code for error indication
- Fix CMakeLists.txt for cross compilation [McClure]
- Fix contrib/minizip/zip.c for 64-bit architectures [Dalsnes]
- Fix compilation of contrib/minizip on FreeBSD [Marquez]
- Correct suggested usages in win32/Makefile.msc [Shachar, Horvath]
- Include io.h for Turbo C / Borland C on all platforms [Truta]
- Make version explicit in contrib/minizip/configure.ac [Bosmans]
- Avoid warning for no encryption in contrib/minizip/zip.c [Vollant]
- Minor cleanup up contrib/minizip/unzip.c [Vollant]
- Fix bug when compiling minizip with C++ [Vollant]
- Protect for long name and extra fields in contrib/minizip [Vollant]
- Avoid some warnings in contrib/minizip [Vollant]
- Add -I../.. -L../.. to CFLAGS for minizip and miniunzip
- Add missing libs to minizip linker command
- Add support for VPATH builds in contrib/minizip
- Add an --enable-demos option to contrib/minizip/configure
- Add the generation of configure.log by ./configure
- Exit when required parameters not provided to win32/Makefile.gcc
- Have gzputc return the character written instead of the argument
- Use the -m option on ldconfig for BSD systems [Tobias]
- Correct in zlib.map when deflateResetKeep was added

Changes in 1.2.5.3 (15 Jan 2012)
- Restore gzgetc function for binary compatibility
- Do not use _lseeki64 under Borland C++ [Truta]
- Update win32/Makefile.msc to build test/*.c [Truta]
- Remove old/visualc6 given CMakefile and other alternatives
- Update AS400 build files and documentation [Monnerat]
- Update win32/Makefile.gcc to build test/*.c [Truta]
- Permit stronger flushes after Z_BLOCK flushes
- Avoid extraneous empty blocks when doing empty flushes
- Permit Z_NULL arguments to deflatePending
- Allow deflatePrime() to insert bits in the middle of a stream
- Remove second empty static block for Z_PARTIAL_FLUSH
- Write out all of the available bits when using Z_BLOCK
- Insert the first two strings in the hash table after a flush

Changes in 1.2.5.2 (17 Dec 2011)
- fix ld error: unable to find version dependency 'ZLIB_1.2.5'
- use relative symlinks for shared libs
- Avoid searching past window for Z_RLE strategy
- Assure that high-water mark initialization is always applied in deflate
- Add assertions to fill_window() in deflate.c to match comments
- Update python link in README
- Correct spelling error in gzread.c
- Fix bug in gzgets() for a concatenated empty gzip stream
- Correct error in comment for gz_make()
- Change gzread() and related to ignore junk after gzip streams
- Allow gzread() and related to continue after gzclearerr()
- Allow gzrewind() and gzseek() after a premature end-of-file
- Simplify gzseek() now that raw after gzip is ignored
- Change gzgetc() to a macro for speed (~40% speedup in testing)
- Fix gzclose() to return the actual error last encountered
- Always add large file support for windows
- Include zconf.h for windows large file support
- Include zconf.h.cmakein for windows large file support
- Update zconf.h.cmakein on make distclean
- Merge vestigial vsnprintf determination from zutil.h to gzguts.h
- Clarify how gzopen() appends in zlib.h comments
- Correct documentation of gzdirect() since junk at end now ignored
- Add a transparent write mode to gzopen() when 'T' is in the mode
- Update python link in zlib man page
- Get inffixed.h and MAKEFIXED result to match
- Add a ./config --solo option to make zlib subset with no library use
- Add undocumented inflateResetKeep() function for CAB file decoding
- Add --cover option to ./configure for gcc coverage testing
- Add #define ZLIB_CONST option to use const in the z_stream interface
- Add comment to gzdopen() in zlib.h to use dup() when using fileno()
- Note behavior of uncompress() to provide as much data as it can
- Add files in contrib/minizip to aid in building libminizip
- Split off AR options in Makefile.in and configure
- Change ON macro to Z_ARG to avoid application conflicts
- Facilitate compilation with Borland C++ for pragmas and vsnprintf
- Include io.h for Turbo C / Borland C++
- Move example.c and minigzip.c to test/
- Simplify incomplete code table filling in inflate_table()
- Remove code from inflate.c and infback.c that is impossible to execute
- Test the inflate code with full coverage
- Allow deflateSetDictionary, inflateSetDictionary at any time (in raw)
- Add deflateResetKeep and fix inflateResetKeep to retain dictionary
- Fix gzwrite.c to accommodate reduced memory zlib compilation
- Have inflate() with Z_FINISH avoid the allocation of a window
- Do not set strm->adler when doing raw inflate
- Fix gzeof() to behave just like feof() when read is not past end of file
- Fix bug in gzread.c when end-of-file is reached
- Avoid use of Z_BUF_ERROR in gz* functions except for premature EOF
- Document gzread() capability to read concurrently written files
- Remove hard-coding of resource compiler in CMakeLists.txt [Blammo]

Changes in 1.2.5.1 (10 Sep 2011)
- Update FAQ entry on shared builds (#13)
- Avoid symbolic argument to chmod in Makefile.in
- Fix bug and add consts in contrib/puff [Oberhumer]
- Update contrib/puff/zeros.raw test file to have all block types
- Add full coverage test for puff in contrib/puff/Makefile
- Fix static-only-build install in Makefile.in
- Fix bug in unzGetCurrentFileInfo() in contrib/minizip [Kuno]
- Add libz.a dependency to shared in Makefile.in for parallel builds
- Spell out "number" (instead of "nb") in zlib.h for total_in, total_out
- Replace $(...) with `...` in configure for non-bash sh [Bowler]
- Add darwin* to Darwin* and solaris* to SunOS\ 5* in configure [Groffen]
- Add solaris* to Linux* in configure to allow gcc use [Groffen]
- Add *bsd* to Linux* case in configure [Bar-Lev]
- Add inffast.obj to dependencies in win32/Makefile.msc
- Correct spelling error in deflate.h [Kohler]
- Change libzdll.a again to libz.dll.a (!) in win32/Makefile.gcc
- Add test to configure for GNU C looking for gcc in output of $cc -v
- Add zlib.pc generation to win32/Makefile.gcc [Weigelt]
- Fix bug in zlib.h for _FILE_OFFSET_BITS set and _LARGEFILE64_SOURCE not
- Add comment in zlib.h that adler32_combine with len2 < 0 makes no sense
- Make NO_DIVIDE option in adler32.c much faster (thanks to John Reiser)
- Make stronger test in zconf.h to include unistd.h for LFS
- Apply Darwin patches for 64-bit file offsets to contrib/minizip [Slack]
- Fix zlib.h LFS support when Z_PREFIX used
- Add updated as400 support (removed from old) [Monnerat]
- Avoid deflate sensitivity to volatile input data
- Avoid division in adler32_combine for NO_DIVIDE
- Clarify the use of Z_FINISH with deflateBound() amount of space
- Set binary for output file in puff.c
- Use u4 type for crc_table to avoid conversion warnings
- Apply casts in zlib.h to avoid conversion warnings
- Add OF to prototypes for adler32_combine_ and crc32_combine_ [Miller]
- Improve inflateSync() documentation to note indeterminancy
- Add deflatePending() function to return the amount of pending output
- Correct the spelling of "specification" in FAQ [Randers-Pehrson]
- Add a check in configure for stdarg.h, use for gzprintf()
- Check that pointers fit in ints when gzprint() compiled old style
- Add dummy name before $(SHAREDLIBV) in Makefile [Bar-Lev, Bowler]
- Delete line in configure that adds -L. libz.a to LDFLAGS [Weigelt]
- Add debug records in assmebler code [Londer]
- Update RFC references to use http://tools.ietf.org/html/... [Li]
- Add --archs option, use of libtool to configure for Mac OS X [Borstel]

Changes in 1.2.5 (19 Apr 2010)
- Disable visibility attribute in win32/Makefile.gcc [Bar-Lev]
- Default to libdir as sharedlibdir in configure [Nieder]
- Update copyright dates on modified source files
- Update trees.c to be able to generate modified trees.h
- Exit configure for MinGW, suggesting win32/Makefile.gcc
- Check for NULL path in gz_open [Homurlu]

Changes in 1.2.4.5 (18 Apr 2010)
- Set sharedlibdir in configure [Torok]
- Set LDFLAGS in Makefile.in [Bar-Lev]
- Avoid mkdir objs race condition in Makefile.in [Bowler]
- Add ZLIB_INTERNAL in front of internal inter-module functions and arrays
- Define ZLIB_INTERNAL to hide internal functions and arrays for GNU C
- Don't use hidden attribute when it is a warning generator (e.g. Solaris)

Changes in 1.2.4.4 (18 Apr 2010)
- Fix CROSS_PREFIX executable testing, CHOST extract, mingw* [Torok]
- Undefine _LARGEFILE64_SOURCE in zconf.h if it is zero, but not if empty
- Try to use bash or ksh regardless of functionality of /bin/sh
- Fix configure incompatibility with NetBSD sh
- Remove attempt to run under bash or ksh since have better NetBSD fix
- Fix win32/Makefile.gcc for MinGW [Bar-Lev]
- Add diagnostic messages when using CROSS_PREFIX in configure
- Added --sharedlibdir option to configure [Weigelt]
- Use hidden visibility attribute when available [Frysinger]

Changes in 1.2.4.3 (10 Apr 2010)
- Only use CROSS_PREFIX in configure for ar and ranlib if they exist
- Use CROSS_PREFIX for nm [Bar-Lev]
- Assume _LARGEFILE64_SOURCE defined is equivalent to true
- Avoid use of undefined symbols in #if with && and ||
- Make *64 prototypes in gzguts.h consistent with functions
- Add -shared load option for MinGW in configure [Bowler]
- Move z_off64_t to public interface, use instead of off64_t
- Remove ! from shell test in configure (not portable to Solaris)
- Change +0 macro tests to -0 for possibly increased portability

Changes in 1.2.4.2 (9 Apr 2010)
- Add consistent carriage returns to readme.txt's in masmx86 and masmx64
- Really provide prototypes for *64 functions when building without LFS
- Only define unlink() in minigzip.c if unistd.h not included
- Update README to point to contrib/vstudio project files
- Move projects/vc6 to old/ and remove projects/
- Include stdlib.h in minigzip.c for setmode() definition under WinCE
- Clean up assembler builds in win32/Makefile.msc [Rowe]
- Include sys/types.h for Microsoft for off_t definition
- Fix memory leak on error in gz_open()
- Symbolize nm as $NM in configure [Weigelt]
- Use TEST_LDSHARED instead of LDSHARED to link test programs [Weigelt]
- Add +0 to _FILE_OFFSET_BITS and _LFS64_LARGEFILE in case not defined
- Fix bug in gzeof() to take into account unused input data
- Avoid initialization of structures with variables in puff.c
- Updated win32/README-WIN32.txt [Rowe]

Changes in 1.2.4.1 (28 Mar 2010)
- Remove the use of [a-z] constructs for sed in configure [gentoo 310225]
- Remove $(SHAREDLIB) from LIBS in Makefile.in [Creech]
- Restore "for debugging" comment on sprintf() in gzlib.c
- Remove fdopen for MVS from gzguts.h
- Put new README-WIN32.txt in win32 [Rowe]
- Add check for shell to configure and invoke another shell if needed
- Fix big fat stinking bug in gzseek() on uncompressed files
- Remove vestigial F_OPEN64 define in zutil.h
- Set and check the value of _LARGEFILE_SOURCE and _LARGEFILE64_SOURCE
- Avoid errors on non-LFS systems when applications define LFS macros
- Set EXE to ".exe" in configure for MINGW [Kahle]
- Match crc32() in crc32.c exactly to the prototype in zlib.h [Sherrill]
- Add prefix for cross-compilation in win32/makefile.gcc [Bar-Lev]
- Add DLL install in win32/makefile.gcc [Bar-Lev]
- Allow Linux* or linux* from uname in configure [Bar-Lev]
- Allow ldconfig to be redefined in configure and Makefile.in [Bar-Lev]
- Add cross-compilation prefixes to configure [Bar-Lev]
- Match type exactly in gz_load() invocation in gzread.c
- Match type exactly of zcalloc() in zutil.c to zlib.h alloc_func
- Provide prototypes for *64 functions when building zlib without LFS
- Don't use -lc when linking shared library on MinGW
- Remove errno.h check in configure and vestigial errno code in zutil.h

Changes in 1.2.4 (14 Mar 2010)
- Fix VER3 extraction in configure for no fourth subversion
- Update zlib.3, add docs to Makefile.in to make .pdf out of it
- Add zlib.3.pdf to distribution
- Don't set error code in gzerror() if passed pointer is NULL
- Apply destination directory fixes to CMakeLists.txt [Lowman]
- Move #cmakedefine's to a new zconf.in.cmakein
- Restore zconf.h for builds that don't use configure or cmake
- Add distclean to dummy Makefile for convenience
- Update and improve INDEX, README, and FAQ
- Update CMakeLists.txt for the return of zconf.h [Lowman]
- Update contrib/vstudio/vc9 and vc10 [Vollant]
- Change libz.dll.a back to libzdll.a in win32/Makefile.gcc
- Apply license and readme changes to contrib/asm686 [Raiter]
- Check file name lengths and add -c option in minigzip.c [Li]
- Update contrib/amd64 and contrib/masmx86/ [Vollant]
- Avoid use of "eof" parameter in trees.c to not shadow library variable
- Update make_vms.com for removal of zlibdefs.h [Zinser]
- Update assembler code and vstudio projects in contrib [Vollant]
- Remove outdated assembler code contrib/masm686 and contrib/asm586
- Remove old vc7 and vc8 from contrib/vstudio
- Update win32/Makefile.msc, add ZLIB_VER_SUBREVISION [Rowe]
- Fix memory leaks in gzclose_r() and gzclose_w(), file leak in gz_open()
- Add contrib/gcc_gvmat64 for longest_match and inflate_fast [Vollant]
- Remove *64 functions from win32/zlib.def (they're not 64-bit yet)
- Fix bug in void-returning vsprintf() case in gzwrite.c
- Fix name change from inflate.h in contrib/inflate86/inffas86.c
- Check if temporary file exists before removing in make_vms.com [Zinser]
- Fix make install and uninstall for --static option
- Fix usage of _MSC_VER in gzguts.h and zutil.h [Truta]
- Update readme.txt in contrib/masmx64 and masmx86 to assemble

Changes in 1.2.3.9 (21 Feb 2010)
- Expunge gzio.c
- Move as400 build information to old
- Fix updates in contrib/minizip and contrib/vstudio
- Add const to vsnprintf test in configure to avoid warnings [Weigelt]
- Delete zconf.h (made by configure) [Weigelt]
- Change zconf.in.h to zconf.h.in per convention [Weigelt]
- Check for NULL buf in gzgets()
- Return empty string for gzgets() with len == 1 (like fgets())
- Fix description of gzgets() in zlib.h for end-of-file, NULL return
- Update minizip to 1.1 [Vollant]
- Avoid MSVC loss of data warnings in gzread.c, gzwrite.c
- Note in zlib.h that gzerror() should be used to distinguish from EOF
- Remove use of snprintf() from gzlib.c
- Fix bug in gzseek()
- Update contrib/vstudio, adding vc9 and vc10 [Kuno, Vollant]
- Fix zconf.h generation in CMakeLists.txt [Lowman]
- Improve comments in zconf.h where modified by configure

Changes in 1.2.3.8 (13 Feb 2010)
- Clean up text files (tabs, trailing whitespace, etc.) [Oberhumer]
- Use z_off64_t in gz_zero() and gz_skip() to match state->skip
- Avoid comparison problem when sizeof(int) == sizeof(z_off64_t)
- Revert to Makefile.in from 1.2.3.6 (live with the clutter)
- Fix missing error return in gzflush(), add zlib.h note
- Add *64 functions to zlib.map [Levin]
- Fix signed/unsigned comparison in gz_comp()
- Use SFLAGS when testing shared linking in configure
- Add --64 option to ./configure to use -m64 with gcc
- Fix ./configure --help to correctly name options
- Have make fail if a test fails [Levin]
- Avoid buffer overrun in contrib/masmx64/gvmat64.asm [Simpson]
- Remove assembler object files from contrib

Changes in 1.2.3.7 (24 Jan 2010)
- Always gzopen() with O_LARGEFILE if available
- Fix gzdirect() to work immediately after gzopen() or gzdopen()
- Make gzdirect() more precise when the state changes while reading
- Improve zlib.h documentation in many places
- Catch memory allocation failure in gz_open()
- Complete close operation if seek forward in gzclose_w() fails
- Return Z_ERRNO from gzclose_r() if close() fails
- Return Z_STREAM_ERROR instead of EOF for gzclose() being passed NULL
- Return zero for gzwrite() errors to match zlib.h description
- Return -1 on gzputs() error to match zlib.h description
- Add zconf.in.h to allow recovery from configure modification [Weigelt]
- Fix static library permissions in Makefile.in [Weigelt]
- Avoid warnings in configure tests that hide functionality [Weigelt]
- Add *BSD and DragonFly to Linux case in configure [gentoo 123571]
- Change libzdll.a to libz.dll.a in win32/Makefile.gcc [gentoo 288212]
- Avoid access of uninitialized data for first inflateReset2 call [Gomes]
- Keep object files in subdirectories to reduce the clutter somewhat
- Remove default Makefile and zlibdefs.h, add dummy Makefile
- Add new external functions to Z_PREFIX, remove duplicates, z_z_ -> z_
- Remove zlibdefs.h completely -- modify zconf.h instead

Changes in 1.2.3.6 (17 Jan 2010)
- Avoid void * arithmetic in gzread.c and gzwrite.c
- Make compilers happier with const char * for gz_error message
- Avoid unused parameter warning in inflate.c
- Avoid signed-unsigned comparison warning in inflate.c
- Indent #pragma's for traditional C
- Fix usage of strwinerror() in glib.c, change to gz_strwinerror()
- Correct email address in configure for system options
- Update make_vms.com and add make_vms.com to contrib/minizip [Zinser]
- Update zlib.map [Brown]
- Fix Makefile.in for Solaris 10 make of example64 and minizip64 [Torok]
- Apply various fixes to CMakeLists.txt [Lowman]
- Add checks on len in gzread() and gzwrite()
- Add error message for no more room for gzungetc()
- Remove zlib version check in gzwrite()
- Defer compression of gzprintf() result until need to
- Use snprintf() in gzdopen() if available
- Remove USE_MMAP configuration determination (only used by minigzip)
- Remove examples/pigz.c (available separately)
- Update examples/gun.c to 1.6

Changes in 1.2.3.5 (8 Jan 2010)
- Add space after #if in zutil.h for some compilers
- Fix relatively harmless bug in deflate_fast() [Exarevsky]
- Fix same problem in deflate_slow()
- Add $(SHAREDLIBV) to LIBS in Makefile.in [Brown]
- Add deflate_rle() for faster Z_RLE strategy run-length encoding
- Add deflate_huff() for faster Z_HUFFMAN_ONLY encoding
- Change name of "write" variable in inffast.c to avoid library collisions
- Fix premature EOF from gzread() in gzio.c [Brown]
- Use zlib header window size if windowBits is 0 in inflateInit2()
- Remove compressBound() call in deflate.c to avoid linking compress.o
- Replace use of errno in gz* with functions, support WinCE [Alves]
- Provide alternative to perror() in minigzip.c for WinCE [Alves]
- Don't use _vsnprintf on later versions of MSVC [Lowman]
- Add CMake build script and input file [Lowman]
- Update contrib/minizip to 1.1 [Svensson, Vollant]
- Moved nintendods directory from contrib to .
- Replace gzio.c with a new set of routines with the same functionality
- Add gzbuffer(), gzoffset(), gzclose_r(), gzclose_w() as part of above
- Update contrib/minizip to 1.1b
- Change gzeof() to return 0 on error instead of -1 to agree with zlib.h

Changes in 1.2.3.4 (21 Dec 2009)
- Use old school .SUFFIXES in Makefile.in for FreeBSD compatibility
- Update comments in configure and Makefile.in for default --shared
- Fix test -z's in configure [Marquess]
- Build examplesh and minigzipsh when not testing
- Change NULL's to Z_NULL's in deflate.c and in comments in zlib.h
- Import LDFLAGS from the environment in configure
- Fix configure to populate SFLAGS with discovered CFLAGS options
- Adapt make_vms.com to the new Makefile.in [Zinser]
- Add zlib2ansi script for C++ compilation [Marquess]
- Add _FILE_OFFSET_BITS=64 test to make test (when applicable)
- Add AMD64 assembler code for longest match to contrib [Teterin]
- Include options from $SFLAGS when doing $LDSHARED
- Simplify 64-bit file support by introducing z_off64_t type
- Make shared object files in objs directory to work around old Sun cc
- Use only three-part version number for Darwin shared compiles
- Add rc option to ar in Makefile.in for when ./configure not run
- Add -WI,-rpath,. to LDFLAGS for OSF 1 V4*
- Set LD_LIBRARYN32_PATH for SGI IRIX shared compile
- Protect against _FILE_OFFSET_BITS being defined when compiling zlib
- Rename Makefile.in targets allstatic to static and allshared to shared
- Fix static and shared Makefile.in targets to be independent
- Correct error return bug in gz_open() by setting state [Brown]
- Put spaces before ;;'s in configure for better sh compatibility
- Add pigz.c (parallel implementation of gzip) to examples/
- Correct constant in crc32.c to UL [Leventhal]
- Reject negative lengths in crc32_combine()
- Add inflateReset2() function to work like inflateEnd()/inflateInit2()
- Include sys/types.h for _LARGEFILE64_SOURCE [Brown]
- Correct typo in doc/algorithm.txt [Janik]
- Fix bug in adler32_combine() [Zhu]
- Catch missing-end-of-block-code error in all inflates and in puff
    Assures that random input to inflate eventually results in an error
- Added enough.c (calculation of ENOUGH for inftrees.h) to examples/
- Update ENOUGH and its usage to reflect discovered bounds
- Fix gzerror() error report on empty input file [Brown]
- Add ush casts in trees.c to avoid pedantic runtime errors
- Fix typo in zlib.h uncompress() description [Reiss]
- Correct inflate() comments with regard to automatic header detection
- Remove deprecation comment on Z_PARTIAL_FLUSH (it stays)
- Put new version of gzlog (2.0) in examples with interruption recovery
- Add puff compile option to permit invalid distance-too-far streams
- Add puff TEST command options, ability to read piped input
- Prototype the *64 functions in zlib.h when _FILE_OFFSET_BITS == 64, but
  _LARGEFILE64_SOURCE not defined
- Fix Z_FULL_FLUSH to truly erase the past by resetting s->strstart
- Fix deflateSetDictionary() to use all 32K for output consistency
- Remove extraneous #define MIN_LOOKAHEAD in deflate.c (in deflate.h)
- Clear bytes after deflate lookahead to avoid use of uninitialized data
- Change a limit in inftrees.c to be more transparent to Coverity Prevent
- Update win32/zlib.def with exported symbols from zlib.h
- Correct spelling errors in zlib.h [Willem, Sobrado]
- Allow Z_BLOCK for deflate() to force a new block
- Allow negative bits in inflatePrime() to delete existing bit buffer
- Add Z_TREES flush option to inflate() to return at end of trees
- Add inflateMark() to return current state information for random access
- Add Makefile for NintendoDS to contrib [Costa]
- Add -w in configure compile tests to avoid spurious warnings [Beucler]
- Fix typos in zlib.h comments for deflateSetDictionary()
- Fix EOF detection in transparent gzread() [Maier]

Changes in 1.2.3.3 (2 October 2006)
- Make --shared the default for configure, add a --static option
- Add compile option to permit invalid distance-too-far streams
- Add inflateUndermine() function which is required to enable above
- Remove use of "this" variable name for C++ compatibility [Marquess]
- Add testing of shared library in make test, if shared library built
- Use ftello() and fseeko() if available instead of ftell() and fseek()
- Provide two versions of all functions that use the z_off_t type for
  binary compatibility -- a normal version and a 64-bit offset version,
  per the Large File Support Extension when _LARGEFILE64_SOURCE is
  defined; use the 64-bit versions by default when _FILE_OFFSET_BITS
  is defined to be 64
- Add a --uname= option to configure to perhaps help with cross-compiling

Changes in 1.2.3.2 (3 September 2006)
- Turn off silly Borland warnings [Hay]
- Use off64_t and define _LARGEFILE64_SOURCE when present
- Fix missing dependency on inffixed.h in Makefile.in
- Rig configure --shared to build both shared and static [Teredesai, Truta]
- Remove zconf.in.h and instead create a new zlibdefs.h file
- Fix contrib/minizip/unzip.c non-encrypted after encrypted [Vollant]
- Add treebuild.xml (see http://treebuild.metux.de/) [Weigelt]

Changes in 1.2.3.1 (16 August 2006)
- Add watcom directory with OpenWatcom make files [Daniel]
- Remove #undef of FAR in zconf.in.h for MVS [Fedtke]
- Update make_vms.com [Zinser]
- Use -fPIC for shared build in configure [Teredesai, Nicholson]
- Use only major version number for libz.so on IRIX and OSF1 [Reinholdtsen]
- Use fdopen() (not _fdopen()) for Interix in zutil.h [Bäck]
- Add some FAQ entries about the contrib directory
- Update the MVS question in the FAQ
- Avoid extraneous reads after EOF in gzio.c [Brown]
- Correct spelling of "successfully" in gzio.c [Randers-Pehrson]
- Add comments to zlib.h about gzerror() usage [Brown]
- Set extra flags in gzip header in gzopen() like deflate() does
- Make configure options more compatible with double-dash conventions
  [Weigelt]
- Clean up compilation under Solaris SunStudio cc [Rowe, Reinholdtsen]
- Fix uninstall target in Makefile.in [Truta]
- Add pkgconfig support [Weigelt]
- Use $(DESTDIR) macro in Makefile.in [Reinholdtsen, Weigelt]
- Replace set_data_type() with a more accurate detect_data_type() in
  trees.c, according to the txtvsbin.txt document [Truta]
- Swap the order of #include <stdio.h> and #include "zlib.h" in
  gzio.c, example.c and minigzip.c [Truta]
- Shut up annoying VS2005 warnings about standard C deprecation [Rowe,
  Truta] (where?)
- Fix target "clean" from win32/Makefile.bor [Truta]
- Create .pdb and .manifest files in win32/makefile.msc [Ziegler, Rowe]
- Update zlib www home address in win32/DLL_FAQ.txt [Truta]
- Update contrib/masmx86/inffas32.asm for VS2005 [Vollant, Van Wassenhove]
- Enable browse info in the "Debug" and "ASM Debug" configurations in
  the Visual C++ 6 project, and set (non-ASM) "Debug" as default [Truta]
- Add pkgconfig support [Weigelt]
- Add ZLIB_VER_MAJOR, ZLIB_VER_MINOR and ZLIB_VER_REVISION in zlib.h,
  for use in win32/zlib1.rc [Polushin, Rowe, Truta]
- Add a document that explains the new text detection scheme to
  doc/txtvsbin.txt [Truta]
- Add rfc1950.txt, rfc1951.txt and rfc1952.txt to doc/ [Truta]
- Move algorithm.txt into doc/ [Truta]
- Synchronize FAQ with website
- Fix compressBound(), was low for some pathological cases [Fearnley]
- Take into account wrapper variations in deflateBound()
- Set examples/zpipe.c input and output to binary mode for Windows
- Update examples/zlib_how.html with new zpipe.c (also web site)
- Fix some warnings in examples/gzlog.c and examples/zran.c (it seems
  that gcc became pickier in 4.0)
- Add zlib.map for Linux: "All symbols from zlib-1.1.4 remain
  un-versioned, the patch adds versioning only for symbols introduced in
  zlib-1.2.0 or later.  It also declares as local those symbols which are
  not designed to be exported." [Levin]
- Update Z_PREFIX list in zconf.in.h, add --zprefix option to configure
- Do not initialize global static by default in trees.c, add a response
  NO_INIT_GLOBAL_POINTERS to initialize them if needed [Marquess]
- Don't use strerror() in gzio.c under WinCE [Yakimov]
- Don't use errno.h in zutil.h under WinCE [Yakimov]
- Move arguments for AR to its usage to allow replacing ar [Marot]
- Add HAVE_VISIBILITY_PRAGMA in zconf.in.h for Mozilla [Randers-Pehrson]
- Improve inflateInit() and inflateInit2() documentation
- Fix structure size comment in inflate.h
- Change configure help option from --h* to --help [Santos]

Changes in 1.2.3 (18 July 2005)
- Apply security vulnerability fixes to contrib/infback9 as well
- Clean up some text files (carriage returns, trailing space)
- Update testzlib, vstudio, masmx64, and masmx86 in contrib [Vollant]

Changes in 1.2.2.4 (11 July 2005)
- Add inflatePrime() function for starting inflation at bit boundary
- Avoid some Visual C warnings in deflate.c
- Avoid more silly Visual C warnings in inflate.c and inftrees.c for 64-bit
  compile
- Fix some spelling errors in comments [Betts]
- Correct inflateInit2() error return documentation in zlib.h
- Add zran.c example of compressed data random access to examples
  directory, shows use of inflatePrime()
- Fix cast for assignments to strm->state in inflate.c and infback.c
- Fix zlibCompileFlags() in zutil.c to use 1L for long shifts [Oberhumer]
- Move declarations of gf2 functions to right place in crc32.c [Oberhumer]
- Add cast in trees.c t avoid a warning [Oberhumer]
- Avoid some warnings in fitblk.c, gun.c, gzjoin.c in examples [Oberhumer]
- Update make_vms.com [Zinser]
- Initialize state->write in inflateReset() since copied in inflate_fast()
- Be more strict on incomplete code sets in inflate_table() and increase
  ENOUGH and MAXD -- this repairs a possible security vulnerability for
  invalid inflate input.  Thanks to Tavis Ormandy and Markus Oberhumer for
  discovering the vulnerability and providing test cases.
- Add ia64 support to configure for HP-UX [Smith]
- Add error return to gzread() for format or i/o error [Levin]
- Use malloc.h for OS/2 [Necasek]

Changes in 1.2.2.3 (27 May 2005)
- Replace 1U constants in inflate.c and inftrees.c for 64-bit compile
- Typecast fread() return values in gzio.c [Vollant]
- Remove trailing space in minigzip.c outmode (VC++ can't deal with it)
- Fix crc check bug in gzread() after gzungetc() [Heiner]
- Add the deflateTune() function to adjust internal compression parameters
- Add a fast gzip decompressor, gun.c, to examples (use of inflateBack)
- Remove an incorrect assertion in examples/zpipe.c
- Add C++ wrapper in infback9.h [Donais]
- Fix bug in inflateCopy() when decoding fixed codes
- Note in zlib.h how much deflateSetDictionary() actually uses
- Remove USE_DICT_HEAD in deflate.c (would mess up inflate if used)
- Add _WIN32_WCE to define WIN32 in zconf.in.h [Spencer]
- Don't include stderr.h or errno.h for _WIN32_WCE in zutil.h [Spencer]
- Add gzdirect() function to indicate transparent reads
- Update contrib/minizip [Vollant]
- Fix compilation of deflate.c when both ASMV and FASTEST [Oberhumer]
- Add casts in crc32.c to avoid warnings [Oberhumer]
- Add contrib/masmx64 [Vollant]
- Update contrib/asm586, asm686, masmx86, testzlib, vstudio [Vollant]

Changes in 1.2.2.2 (30 December 2004)
- Replace structure assignments in deflate.c and inflate.c with zmemcpy to
  avoid implicit memcpy calls (portability for no-library compilation)
- Increase sprintf() buffer size in gzdopen() to allow for large numbers
- Add INFLATE_STRICT to check distances against zlib header
- Improve WinCE errno handling and comments [Chang]
- Remove comment about no gzip header processing in FAQ
- Add Z_FIXED strategy option to deflateInit2() to force fixed trees
- Add updated make_vms.com [Coghlan], update README
- Create a new "examples" directory, move gzappend.c there, add zpipe.c,
  fitblk.c, gzlog.[ch], gzjoin.c, and zlib_how.html.
- Add FAQ entry and comments in deflate.c on uninitialized memory access
- Add Solaris 9 make options in configure [Gilbert]
- Allow strerror() usage in gzio.c for STDC
- Fix DecompressBuf in contrib/delphi/ZLib.pas [ManChesTer]
- Update contrib/masmx86/inffas32.asm and gvmat32.asm [Vollant]
- Use z_off_t for adler32_combine() and crc32_combine() lengths
- Make adler32() much faster for small len
- Use OS_CODE in deflate() default gzip header

Changes in 1.2.2.1 (31 October 2004)
- Allow inflateSetDictionary() call for raw inflate
- Fix inflate header crc check bug for file names and comments
- Add deflateSetHeader() and gz_header structure for custom gzip headers
- Add inflateGetheader() to retrieve gzip headers
- Add crc32_combine() and adler32_combine() functions
- Add alloc_func, free_func, in_func, out_func to Z_PREFIX list
- Use zstreamp consistently in zlib.h (inflate_back functions)
- Remove GUNZIP condition from definition of inflate_mode in inflate.h
  and in contrib/inflate86/inffast.S [Truta, Anderson]
- Add support for AMD64 in contrib/inflate86/inffas86.c [Anderson]
- Update projects/README.projects and projects/visualc6 [Truta]
- Update win32/DLL_FAQ.txt [Truta]
- Avoid warning under NO_GZCOMPRESS in gzio.c; fix typo [Truta]
- Deprecate Z_ASCII; use Z_TEXT instead [Truta]
- Use a new algorithm for setting strm->data_type in trees.c [Truta]
- Do not define an exit() prototype in zutil.c unless DEBUG defined
- Remove prototype of exit() from zutil.c, example.c, minigzip.c [Truta]
- Add comment in zlib.h for Z_NO_FLUSH parameter to deflate()
- Fix Darwin build version identification [Peterson]

Changes in 1.2.2 (3 October 2004)
- Update zlib.h comments on gzip in-memory processing
- Set adler to 1 in inflateReset() to support Java test suite [Walles]
- Add contrib/dotzlib [Ravn]
- Update win32/DLL_FAQ.txt [Truta]
- Update contrib/minizip [Vollant]
- Move contrib/visual-basic.txt to old/ [Truta]
- Fix assembler builds in projects/visualc6/ [Truta]

Changes in 1.2.1.2 (9 September 2004)
- Update INDEX file
- Fix trees.c to update strm->data_type (no one ever noticed!)
- Fix bug in error case in inflate.c, infback.c, and infback9.c [Brown]
- Add "volatile" to crc table flag declaration (for DYNAMIC_CRC_TABLE)
- Add limited multitasking protection to DYNAMIC_CRC_TABLE
- Add NO_vsnprintf for VMS in zutil.h [Mozilla]
- Don't declare strerror() under VMS [Mozilla]
- Add comment to DYNAMIC_CRC_TABLE to use get_crc_table() to initialize
- Update contrib/ada [Anisimkov]
- Update contrib/minizip [Vollant]
- Fix configure to not hardcode directories for Darwin [Peterson]
- Fix gzio.c to not return error on empty files [Brown]
- Fix indentation; update version in contrib/delphi/ZLib.pas and
  contrib/pascal/zlibpas.pas [Truta]
- Update mkasm.bat in contrib/masmx86 [Truta]
- Update contrib/untgz [Truta]
- Add projects/README.projects [Truta]
- Add project for MS Visual C++ 6.0 in projects/visualc6 [Cadieux, Truta]
- Update win32/DLL_FAQ.txt [Truta]
- Update list of Z_PREFIX symbols in zconf.h [Randers-Pehrson, Truta]
- Remove an unnecessary assignment to curr in inftrees.c [Truta]
- Add OS/2 to exe builds in configure [Poltorak]
- Remove err dummy parameter in zlib.h [Kientzle]

Changes in 1.2.1.1 (9 January 2004)
- Update email address in README
- Several FAQ updates
- Fix a big fat bug in inftrees.c that prevented decoding valid
  dynamic blocks with only literals and no distance codes --
  Thanks to "Hot Emu" for the bug report and sample file
- Add a note to puff.c on no distance codes case.

Changes in 1.2.1 (17 November 2003)
- Remove a tab in contrib/gzappend/gzappend.c
- Update some interfaces in contrib for new zlib functions
- Update zlib version number in some contrib entries
- Add Windows CE definition for ptrdiff_t in zutil.h [Mai, Truta]
- Support shared libraries on Hurd and KFreeBSD [Brown]
- Fix error in NO_DIVIDE option of adler32.c

Changes in 1.2.0.8 (4 November 2003)
- Update version in contrib/delphi/ZLib.pas and contrib/pascal/zlibpas.pas
- Add experimental NO_DIVIDE #define in adler32.c
    - Possibly faster on some processors (let me know if it is)
- Correct Z_BLOCK to not return on first inflate call if no wrap
- Fix strm->data_type on inflate() return to correctly indicate EOB
- Add deflatePrime() function for appending in the middle of a byte
- Add contrib/gzappend for an example of appending to a stream
- Update win32/DLL_FAQ.txt [Truta]
- Delete Turbo C comment in README [Truta]
- Improve some indentation in zconf.h [Truta]
- Fix infinite loop on bad input in configure script [Church]
- Fix gzeof() for concatenated gzip files [Johnson]
- Add example to contrib/visual-basic.txt [Michael B.]
- Add -p to mkdir's in Makefile.in [vda]
- Fix configure to properly detect presence or lack of printf functions
- Add AS400 support [Monnerat]
- Add a little Cygwin support [Wilson]

Changes in 1.2.0.7 (21 September 2003)
- Correct some debug formats in contrib/infback9
- Cast a type in a debug statement in trees.c
- Change search and replace delimiter in configure from % to # [Beebe]
- Update contrib/untgz to 0.2 with various fixes [Truta]
- Add build support for Amiga [Nikl]
- Remove some directories in old that have been updated to 1.2
- Add dylib building for Mac OS X in configure and Makefile.in
- Remove old distribution stuff from Makefile
- Update README to point to DLL_FAQ.txt, and add comment on Mac OS X
- Update links in README

Changes in 1.2.0.6 (13 September 2003)
- Minor FAQ updates
- Update contrib/minizip to 1.00 [Vollant]
- Remove test of gz functions in example.c when GZ_COMPRESS defined [Truta]
- Update POSTINC comment for 68060 [Nikl]
- Add contrib/infback9 with deflate64 decoding (unsupported)
- For MVS define NO_vsnprintf and undefine FAR [van Burik]
- Add pragma for fdopen on MVS [van Burik]

Changes in 1.2.0.5 (8 September 2003)
- Add OF to inflateBackEnd() declaration in zlib.h
- Remember start when using gzdopen in the middle of a file
- Use internal off_t counters in gz* functions to properly handle seeks
- Perform more rigorous check for distance-too-far in inffast.c
- Add Z_BLOCK flush option to return from inflate at block boundary
- Set strm->data_type on return from inflate
    - Indicate bits unused, if at block boundary, and if in last block
- Replace size_t with ptrdiff_t in crc32.c, and check for correct size
- Add condition so old NO_DEFLATE define still works for compatibility
- FAQ update regarding the Windows DLL [Truta]
- INDEX update: add qnx entry, remove aix entry [Truta]
- Install zlib.3 into mandir [Wilson]
- Move contrib/zlib_dll_FAQ.txt to win32/DLL_FAQ.txt; update [Truta]
- Adapt the zlib interface to the new DLL convention guidelines [Truta]
- Introduce ZLIB_WINAPI macro to allow the export of functions using
  the WINAPI calling convention, for Visual Basic [Vollant, Truta]
- Update msdos and win32 scripts and makefiles [Truta]
- Export symbols by name, not by ordinal, in win32/zlib.def [Truta]
- Add contrib/ada [Anisimkov]
- Move asm files from contrib/vstudio/vc70_32 to contrib/asm386 [Truta]
- Rename contrib/asm386 to contrib/masmx86 [Truta, Vollant]
- Add contrib/masm686 [Truta]
- Fix offsets in contrib/inflate86 and contrib/masmx86/inffas32.asm
  [Truta, Vollant]
- Update contrib/delphi; rename to contrib/pascal; add example [Truta]
- Remove contrib/delphi2; add a new contrib/delphi [Truta]
- Avoid inclusion of the nonstandard <memory.h> in contrib/iostream,
  and fix some method prototypes [Truta]
- Fix the ZCR_SEED2 constant to avoid warnings in contrib/minizip
  [Truta]
- Avoid the use of backslash (\) in contrib/minizip [Vollant]
- Fix file time handling in contrib/untgz; update makefiles [Truta]
- Update contrib/vstudio/vc70_32 to comply with the new DLL guidelines
  [Vollant]
- Remove contrib/vstudio/vc15_16 [Vollant]
- Rename contrib/vstudio/vc70_32 to contrib/vstudio/vc7 [Truta]
- Update README.contrib [Truta]
- Invert the assignment order of match_head and s->prev[...] in
  INSERT_STRING [Truta]
- Compare TOO_FAR with 32767 instead of 32768, to avoid 16-bit warnings
  [Truta]
- Compare function pointers with 0, not with NULL or Z_NULL [Truta]
- Fix prototype of syncsearch in inflate.c [Truta]
- Introduce ASMINF macro to be enabled when using an ASM implementation
  of inflate_fast [Truta]
- Change NO_DEFLATE to NO_GZCOMPRESS [Truta]
- Modify test_gzio in example.c to take a single file name as a
  parameter [Truta]
- Exit the example.c program if gzopen fails [Truta]
- Add type casts around strlen in example.c [Truta]
- Remove casting to sizeof in minigzip.c; give a proper type
  to the variable compared with SUFFIX_LEN [Truta]
- Update definitions of STDC and STDC99 in zconf.h [Truta]
- Synchronize zconf.h with the new Windows DLL interface [Truta]
- Use SYS16BIT instead of __32BIT__ to distinguish between
  16- and 32-bit platforms [Truta]
- Use far memory allocators in small 16-bit memory models for
  Turbo C [Truta]
- Add info about the use of ASMV, ASMINF and ZLIB_WINAPI in
  zlibCompileFlags [Truta]
- Cygwin has vsnprintf [Wilson]
- In Windows16, OS_CODE is 0, as in MSDOS [Truta]
- In Cygwin, OS_CODE is 3 (Unix), not 11 (Windows32) [Wilson]

Changes in 1.2.0.4 (10 August 2003)
- Minor FAQ updates
- Be more strict when checking inflateInit2's windowBits parameter
- Change NO_GUNZIP compile option to NO_GZIP to cover deflate as well
- Add gzip wrapper option to deflateInit2 using windowBits
- Add updated QNX rule in configure and qnx directory [Bonnefoy]
- Make inflate distance-too-far checks more rigorous
- Clean up FAR usage in inflate
- Add casting to sizeof() in gzio.c and minigzip.c

Changes in 1.2.0.3 (19 July 2003)
- Fix silly error in gzungetc() implementation [Vollant]
- Update contrib/minizip and contrib/vstudio [Vollant]
- Fix printf format in example.c
- Correct cdecl support in zconf.in.h [Anisimkov]
- Minor FAQ updates

Changes in 1.2.0.2 (13 July 2003)
- Add ZLIB_VERNUM in zlib.h for numerical preprocessor comparisons
- Attempt to avoid warnings in crc32.c for pointer-int conversion
- Add AIX to configure, remove aix directory [Bakker]
- Add some casts to minigzip.c
- Improve checking after insecure sprintf() or vsprintf() calls
- Remove #elif's from crc32.c
- Change leave label to inf_leave in inflate.c and infback.c to avoid
  library conflicts
- Remove inflate gzip decoding by default--only enable gzip decoding by
  special request for stricter backward compatibility
- Add zlibCompileFlags() function to return compilation information
- More typecasting in deflate.c to avoid warnings
- Remove leading underscore from _Capital #defines [Truta]
- Fix configure to link shared library when testing
- Add some Windows CE target adjustments [Mai]
- Remove #define ZLIB_DLL in zconf.h [Vollant]
- Add zlib.3 [Rodgers]
- Update RFC URL in deflate.c and algorithm.txt [Mai]
- Add zlib_dll_FAQ.txt to contrib [Truta]
- Add UL to some constants [Truta]
- Update minizip and vstudio [Vollant]
- Remove vestigial NEED_DUMMY_RETURN from zconf.in.h
- Expand use of NO_DUMMY_DECL to avoid all dummy structures
- Added iostream3 to contrib [Schwardt]
- Replace rewind() with fseek() for WinCE [Truta]
- Improve setting of zlib format compression level flags
    - Report 0 for huffman and rle strategies and for level == 0 or 1
    - Report 2 only for level == 6
- Only deal with 64K limit when necessary at compile time [Truta]
- Allow TOO_FAR check to be turned off at compile time [Truta]
- Add gzclearerr() function [Souza]
- Add gzungetc() function

Changes in 1.2.0.1 (17 March 2003)
- Add Z_RLE strategy for run-length encoding [Truta]
    - When Z_RLE requested, restrict matches to distance one
    - Update zlib.h, minigzip.c, gzopen(), gzdopen() for Z_RLE
- Correct FASTEST compilation to allow level == 0
- Clean up what gets compiled for FASTEST
- Incorporate changes to zconf.in.h [Vollant]
    - Refine detection of Turbo C need for dummy returns
    - Refine ZLIB_DLL compilation
    - Include additional header file on VMS for off_t typedef
- Try to use _vsnprintf where it supplants vsprintf [Vollant]
- Add some casts in inffast.c
- Enchance comments in zlib.h on what happens if gzprintf() tries to
  write more than 4095 bytes before compression
- Remove unused state from inflateBackEnd()
- Remove exit(0) from minigzip.c, example.c
- Get rid of all those darn tabs
- Add "check" target to Makefile.in that does the same thing as "test"
- Add "mostlyclean" and "maintainer-clean" targets to Makefile.in
- Update contrib/inflate86 [Anderson]
- Update contrib/testzlib, contrib/vstudio, contrib/minizip [Vollant]
- Add msdos and win32 directories with makefiles [Truta]
- More additions and improvements to the FAQ

Changes in 1.2.0 (9 March 2003)
- New and improved inflate code
    - About 20% faster
    - Does not allocate 32K window unless and until needed
    - Automatically detects and decompresses gzip streams
    - Raw inflate no longer needs an extra dummy byte at end
    - Added inflateBack functions using a callback interface--even faster
      than inflate, useful for file utilities (gzip, zip)
    - Added inflateCopy() function to record state for random access on
      externally generated deflate streams (e.g. in gzip files)
    - More readable code (I hope)
- New and improved crc32()
    - About 50% faster, thanks to suggestions from Rodney Brown
- Add deflateBound() and compressBound() functions
- Fix memory leak in deflateInit2()
- Permit setting dictionary for raw deflate (for parallel deflate)
- Fix const declaration for gzwrite()
- Check for some malloc() failures in gzio.c
- Fix bug in gzopen() on single-byte file 0x1f
- Fix bug in gzread() on concatenated file with 0x1f at end of buffer
  and next buffer doesn't start with 0x8b
- Fix uncompress() to return Z_DATA_ERROR on truncated input
- Free memory at end of example.c
- Remove MAX #define in trees.c (conflicted with some libraries)
- Fix static const's in deflate.c, gzio.c, and zutil.[ch]
- Declare malloc() and free() in gzio.c if STDC not defined
- Use malloc() instead of calloc() in zutil.c if int big enough
- Define STDC for AIX
- Add aix/ with approach for compiling shared library on AIX
- Add HP-UX support for shared libraries in configure
- Add OpenUNIX support for shared libraries in configure
- Use $cc instead of gcc to build shared library
- Make prefix directory if needed when installing
- Correct Macintosh avoidance of typedef Byte in zconf.h
- Correct Turbo C memory allocation when under Linux
- Use libz.a instead of -lz in Makefile (assure use of compiled library)
- Update configure to check for snprintf or vsnprintf functions and their
  return value, warn during make if using an insecure function
- Fix configure problem with compile-time knowledge of HAVE_UNISTD_H that
  is lost when library is used--resolution is to build new zconf.h
- Documentation improvements (in zlib.h):
    - Document raw deflate and inflate
    - Update RFCs URL
    - Point out that zlib and gzip formats are different
    - Note that Z_BUF_ERROR is not fatal
    - Document string limit for gzprintf() and possible buffer overflow
    - Note requirement on avail_out when flushing
    - Note permitted values of flush parameter of inflate()
- Add some FAQs (and even answers) to the FAQ
- Add contrib/inflate86/ for x86 faster inflate
- Add contrib/blast/ for PKWare Data Compression Library decompression
- Add contrib/puff/ simple inflate for deflate format description

Changes in 1.1.4 (11 March 2002)
- ZFREE was repeated on same allocation on some error conditions.
  This creates a security problem described in
  http://www.zlib.org/advisory-2002-03-11.txt
- Returned incorrect error (Z_MEM_ERROR) on some invalid data
- Avoid accesses before window for invalid distances with inflate window
  less than 32K.
- force windowBits > 8 to avoid a bug in the encoder for a window size
  of 256 bytes. (A complete fix will be available in 1.1.5).

Changes in 1.1.3 (9 July 1998)
- fix "an inflate input buffer bug that shows up on rare but persistent
  occasions" (Mark)
- fix gzread and gztell for concatenated .gz files (Didier Le Botlan)
- fix gzseek(..., SEEK_SET) in write mode
- fix crc check after a gzeek (Frank Faubert)
- fix miniunzip when the last entry in a zip file is itself a zip file
  (J Lillge)
- add contrib/asm586 and contrib/asm686 (Brian Raiter)
  See http://www.muppetlabs.com/~breadbox/software/assembly.html
- add support for Delphi 3 in contrib/delphi (Bob Dellaca)
- add support for C++Builder 3 and Delphi 3 in contrib/delphi2 (Davide Moretti)
- do not exit prematurely in untgz if 0 at start of block (Magnus Holmgren)
- use macro EXTERN instead of extern to support DLL for BeOS (Sander Stoks)
- added a FAQ file

- Support gzdopen on Mac with Metrowerks (Jason Linhart)
- Do not redefine Byte on Mac (Brad Pettit & Jason Linhart)
- define SEEK_END too if SEEK_SET is not defined (Albert Chin-A-Young)
- avoid some warnings with Borland C (Tom Tanner)
- fix a problem in contrib/minizip/zip.c for 16-bit MSDOS (Gilles Vollant)
- emulate utime() for WIN32 in contrib/untgz  (Gilles Vollant)
- allow several arguments to configure (Tim Mooney, Frodo Looijaard)
- use libdir and includedir in Makefile.in (Tim Mooney)
- support shared libraries on OSF1 V4 (Tim Mooney)
- remove so_locations in "make clean"  (Tim Mooney)
- fix maketree.c compilation error (Glenn, Mark)
- Python interface to zlib now in Python 1.5 (Jeremy Hylton)
- new Makefile.riscos (Rich Walker)
- initialize static descriptors in trees.c for embedded targets (Nick Smith)
- use "foo-gz" in example.c for RISCOS and VMS (Nick Smith)
- add the OS/2 files in Makefile.in too (Andrew Zabolotny)
- fix fdopen and halloc macros for Microsoft C 6.0 (Tom Lane)
- fix maketree.c to allow clean compilation of inffixed.h (Mark)
- fix parameter check in deflateCopy (Gunther Nikl)
- cleanup trees.c, use compressed_len only in debug mode (Christian Spieler)
- Many portability patches by Christian Spieler:
  . zutil.c, zutil.h: added "const" for zmem*
  . Make_vms.com: fixed some typos
  . Make_vms.com: msdos/Makefile.*: removed zutil.h from some dependency lists
  . msdos/Makefile.msc: remove "default rtl link library" info from obj files
  . msdos/Makefile.*: use model-dependent name for the built zlib library
  . msdos/Makefile.emx, nt/Makefile.emx, nt/Makefile.gcc:
     new makefiles, for emx (DOS/OS2), emx&rsxnt and mingw32 (Windows 9x / NT)
- use define instead of typedef for Bytef also for MSC small/medium (Tom Lane)
- replace __far with _far for better portability (Christian Spieler, Tom Lane)
- fix test for errno.h in configure (Tim Newsham)

Changes in 1.1.2 (19 March 98)
- added contrib/minzip, mini zip and unzip based on zlib (Gilles Vollant)
  See http://www.winimage.com/zLibDll/unzip.html
- preinitialize the inflate tables for fixed codes, to make the code
  completely thread safe (Mark)
- some simplifications and slight speed-up to the inflate code (Mark)
- fix gzeof on non-compressed files (Allan Schrum)
- add -std1 option in configure for OSF1 to fix gzprintf (Martin Mokrejs)
- use default value of 4K for Z_BUFSIZE for 16-bit MSDOS (Tim Wegner + Glenn)
- added os2/Makefile.def and os2/zlib.def (Andrew Zabolotny)
- add shared lib support for UNIX_SV4.2MP (MATSUURA Takanori)
- do not wrap extern "C" around system includes (Tom Lane)
- mention zlib binding for TCL in README (Andreas Kupries)
- added amiga/Makefile.pup for Amiga powerUP SAS/C PPC (Andreas Kleinert)
- allow "make install prefix=..." even after configure (Glenn Randers-Pehrson)
- allow "configure --prefix $HOME" (Tim Mooney)
- remove warnings in example.c and gzio.c (Glenn Randers-Pehrson)
- move Makefile.sas to amiga/Makefile.sas

Changes in 1.1.1 (27 Feb 98)
- fix macros _tr_tally_* in deflate.h for debug mode  (Glenn Randers-Pehrson)
- remove block truncation heuristic which had very marginal effect for zlib
  (smaller lit_bufsize than in gzip 1.2.4) and degraded a little the
  compression ratio on some files. This also allows inlining _tr_tally for
  matches in deflate_slow.
- added msdos/Makefile.w32 for WIN32 Microsoft Visual C++ (Bob Frazier)

Changes in 1.1.0 (24 Feb 98)
- do not return STREAM_END prematurely in inflate (John Bowler)
- revert to the zlib 1.0.8 inflate to avoid the gcc 2.8.0 bug (Jeremy Buhler)
- compile with -DFASTEST to get compression code optimized for speed only
- in minigzip, try mmap'ing the input file first (Miguel Albrecht)
- increase size of I/O buffers in minigzip.c and gzio.c (not a big gain
  on Sun but significant on HP)

- add a pointer to experimental unzip library in README (Gilles Vollant)
- initialize variable gcc in configure (Chris Herborth)

Changes in 1.0.9 (17 Feb 1998)
- added gzputs and gzgets functions
- do not clear eof flag in gzseek (Mark Diekhans)
- fix gzseek for files in transparent mode (Mark Diekhans)
- do not assume that vsprintf returns the number of bytes written (Jens Krinke)
- replace EXPORT with ZEXPORT to avoid conflict with other programs
- added compress2 in zconf.h, zlib.def, zlib.dnt
- new asm code from Gilles Vollant in contrib/asm386
- simplify the inflate code (Mark):
 . Replace ZALLOC's in huft_build() with single ZALLOC in inflate_blocks_new()
 . ZALLOC the length list in inflate_trees_fixed() instead of using stack
 . ZALLOC the value area for huft_build() instead of using stack
 . Simplify Z_FINISH check in inflate()

- Avoid gcc 2.8.0 comparison bug a little differently than zlib 1.0.8
- in inftrees.c, avoid cc -O bug on HP (Farshid Elahi)
- in zconf.h move the ZLIB_DLL stuff earlier to avoid problems with
  the declaration of FAR (Gilles VOllant)
- install libz.so* with mode 755 (executable) instead of 644 (Marc Lehmann)
- read_buf buf parameter of type Bytef* instead of charf*
- zmemcpy parameters are of type Bytef*, not charf* (Joseph Strout)
- do not redeclare unlink in minigzip.c for WIN32 (John Bowler)
- fix check for presence of directories in "make install" (Ian Willis)

Changes in 1.0.8 (27 Jan 1998)
- fixed offsets in contrib/asm386/gvmat32.asm (Gilles Vollant)
- fix gzgetc and gzputc for big endian systems (Markus Oberhumer)
- added compress2() to allow setting the compression level
- include sys/types.h to get off_t on some systems (Marc Lehmann & QingLong)
- use constant arrays for the static trees in trees.c instead of computing
  them at run time (thanks to Ken Raeburn for this suggestion). To create
  trees.h, compile with GEN_TREES_H and run "make test".
- check return code of example in "make test" and display result
- pass minigzip command line options to file_compress
- simplifying code of inflateSync to avoid gcc 2.8 bug

- support CC="gcc -Wall" in configure -s (QingLong)
- avoid a flush caused by ftell in gzopen for write mode (Ken Raeburn)
- fix test for shared library support to avoid compiler warnings
- zlib.lib -> zlib.dll in msdos/zlib.rc (Gilles Vollant)
- check for TARGET_OS_MAC in addition to MACOS (Brad Pettit)
- do not use fdopen for Metrowerks on Mac (Brad Pettit))
- add checks for gzputc and gzputc in example.c
- avoid warnings in gzio.c and deflate.c (Andreas Kleinert)
- use const for the CRC table (Ken Raeburn)
- fixed "make uninstall" for shared libraries
- use Tracev instead of Trace in infblock.c
- in example.c use correct compressed length for test_sync
- suppress +vnocompatwarnings in configure for HPUX (not always supported)

Changes in 1.0.7 (20 Jan 1998)
- fix gzseek which was broken in write mode
- return error for gzseek to negative absolute position
- fix configure for Linux (Chun-Chung Chen)
- increase stack space for MSC (Tim Wegner)
- get_crc_table and inflateSyncPoint are EXPORTed (Gilles Vollant)
- define EXPORTVA for gzprintf (Gilles Vollant)
- added man page zlib.3 (Rick Rodgers)
- for contrib/untgz, fix makedir() and improve Makefile

- check gzseek in write mode in example.c
- allocate extra buffer for seeks only if gzseek is actually called
- avoid signed/unsigned comparisons (Tim Wegner, Gilles Vollant)
- add inflateSyncPoint in zconf.h
- fix list of exported functions in nt/zlib.dnt and mdsos/zlib.def

Changes in 1.0.6 (19 Jan 1998)
- add functions gzprintf, gzputc, gzgetc, gztell, gzeof, gzseek, gzrewind and
  gzsetparams (thanks to Roland Giersig and Kevin Ruland for some of this code)
- Fix a deflate bug occurring only with compression level 0 (thanks to
  Andy Buckler for finding this one).
- In minigzip, pass transparently also the first byte for .Z files.
- return Z_BUF_ERROR instead of Z_OK if output buffer full in uncompress()
- check Z_FINISH in inflate (thanks to Marc Schluper)
- Implement deflateCopy (thanks to Adam Costello)
- make static libraries by default in configure, add --shared option.
- move MSDOS or Windows specific files to directory msdos
- suppress the notion of partial flush to simplify the interface
  (but the symbol Z_PARTIAL_FLUSH is kept for compatibility with 1.0.4)
- suppress history buffer provided by application to simplify the interface
  (this feature was not implemented anyway in 1.0.4)
- next_in and avail_in must be initialized before calling inflateInit or
  inflateInit2
- add EXPORT in all exported functions (for Windows DLL)
- added Makefile.nt (thanks to Stephen Williams)
- added the unsupported "contrib" directory:
   contrib/asm386/ by Gilles Vollant <info@winimage.com>
        386 asm code replacing longest_match().
   contrib/iostream/ by Kevin Ruland <kevin@rodin.wustl.edu>
        A C++ I/O streams interface to the zlib gz* functions
   contrib/iostream2/  by Tyge Løvset <Tyge.Lovset@cmr.no>
        Another C++ I/O streams interface
   contrib/untgz/  by "Pedro A. Aranda Guti\irrez" <paag@tid.es>
        A very simple tar.gz file extractor using zlib
   contrib/visual-basic.txt by Carlos Rios <c_rios@sonda.cl>
        How to use compress(), uncompress() and the gz* functions from VB.
- pass params -f (filtered data), -h (huffman only), -1 to -9 (compression
  level) in minigzip (thanks to Tom Lane)

- use const for rommable constants in deflate
- added test for gzseek and gztell in example.c
- add undocumented function inflateSyncPoint() (hack for Paul Mackerras)
- add undocumented function zError to convert error code to string
  (for Tim Smithers)
- Allow compilation of gzio with -DNO_DEFLATE to avoid the compression code.
- Use default memcpy for Symantec MSDOS compiler.
- Add EXPORT keyword for check_func (needed for Windows DLL)
- add current directory to LD_LIBRARY_PATH for "make test"
- create also a link for libz.so.1
- added support for FUJITSU UXP/DS (thanks to Toshiaki Nomura)
- use $(SHAREDLIB) instead of libz.so in Makefile.in (for HPUX)
- added -soname for Linux in configure (Chun-Chung Chen,
- assign numbers to the exported functions in zlib.def (for Windows DLL)
- add advice in zlib.h for best usage of deflateSetDictionary
- work around compiler bug on Atari (cast Z_NULL in call of s->checkfn)
- allow compilation with ANSI keywords only enabled for TurboC in large model
- avoid "versionString"[0] (Borland bug)
- add NEED_DUMMY_RETURN for Borland
- use variable z_verbose for tracing in debug mode (L. Peter Deutsch).
- allow compilation with CC
- defined STDC for OS/2 (David Charlap)
- limit external names to 8 chars for MVS (Thomas Lund)
- in minigzip.c, use static buffers only for 16-bit systems
- fix suffix check for "minigzip -d foo.gz"
- do not return an error for the 2nd of two consecutive gzflush() (Felix Lee)
- use _fdopen instead of fdopen for MSC >= 6.0 (Thomas Fanslau)
- added makelcc.bat for lcc-win32 (Tom St Denis)
- in Makefile.dj2, use copy and del instead of install and rm (Frank Donahoe)
- Avoid expanded $Id$. Use "rcs -kb" or "cvs admin -kb" to avoid Id expansion.
- check for unistd.h in configure (for off_t)
- remove useless check parameter in inflate_blocks_free
- avoid useless assignment of s->check to itself in inflate_blocks_new
- do not flush twice in gzclose (thanks to Ken Raeburn)
- rename FOPEN as F_OPEN to avoid clash with /usr/include/sys/file.h
- use NO_ERRNO_H instead of enumeration of operating systems with errno.h
- work around buggy fclose on pipes for HP/UX
- support zlib DLL with BORLAND C++ 5.0 (thanks to Glenn Randers-Pehrson)
- fix configure if CC is already equal to gcc

Changes in 1.0.5 (3 Jan 98)
- Fix inflate to terminate gracefully when fed corrupted or invalid data
- Use const for rommable constants in inflate
- Eliminate memory leaks on error conditions in inflate
- Removed some vestigial code in inflate
- Update web address in README

Changes in 1.0.4 (24 Jul 96)
- In very rare conditions, deflate(s, Z_FINISH) could fail to produce an EOF
  bit, so the decompressor could decompress all the correct data but went
  on to attempt decompressing extra garbage data. This affected minigzip too.
- zlibVersion and gzerror return const char* (needed for DLL)
- port to RISCOS (no fdopen, no multiple dots, no unlink, no fileno)
- use z_error only for DEBUG (avoid problem with DLLs)

Changes in 1.0.3 (2 Jul 96)
- use z_streamp instead of z_stream *, which is now a far pointer in MSDOS
  small and medium models; this makes the library incompatible with previous
  versions for these models. (No effect in large model or on other systems.)
- return OK instead of BUF_ERROR if previous deflate call returned with
  avail_out as zero but there is nothing to do
- added memcmp for non STDC compilers
- define NO_DUMMY_DECL for more Mac compilers (.h files merged incorrectly)
- define __32BIT__ if __386__ or i386 is defined (pb. with Watcom and SCO)
- better check for 16-bit mode MSC (avoids problem with Symantec)

Changes in 1.0.2 (23 May 96)
- added Windows DLL support
- added a function zlibVersion (for the DLL support)
- fixed declarations using Bytef in infutil.c (pb with MSDOS medium model)
- Bytef is define's instead of typedef'd only for Borland C
- avoid reading uninitialized memory in example.c
- mention in README that the zlib format is now RFC1950
- updated Makefile.dj2
- added algorithm.doc

Changes in 1.0.1 (20 May 96) [1.0 skipped to avoid confusion]
- fix array overlay in deflate.c which sometimes caused bad compressed data
- fix inflate bug with empty stored block
- fix MSDOS medium model which was broken in 0.99
- fix deflateParams() which could generate bad compressed data.
- Bytef is define'd instead of typedef'ed (work around Borland bug)
- added an INDEX file
- new makefiles for DJGPP (Makefile.dj2), 32-bit Borland (Makefile.b32),
  Watcom (Makefile.wat), Amiga SAS/C (Makefile.sas)
- speed up adler32 for modern machines without auto-increment
- added -ansi for IRIX in configure
- static_init_done in trees.c is an int
- define unlink as delete for VMS
- fix configure for QNX
- add configure branch for SCO and HPUX
- avoid many warnings (unused variables, dead assignments, etc...)
- no fdopen for BeOS
- fix the Watcom fix for 32 bit mode (define FAR as empty)
- removed redefinition of Byte for MKWERKS
- work around an MWKERKS bug (incorrect merge of all .h files)

Changes in 0.99 (27 Jan 96)
- allow preset dictionary shared between compressor and decompressor
- allow compression level 0 (no compression)
- add deflateParams in zlib.h: allow dynamic change of compression level
  and compression strategy.
- test large buffers and deflateParams in example.c
- add optional "configure" to build zlib as a shared library
- suppress Makefile.qnx, use configure instead
- fixed deflate for 64-bit systems (detected on Cray)
- fixed inflate_blocks for 64-bit systems (detected on Alpha)
- declare Z_DEFLATED in zlib.h (possible parameter for deflateInit2)
- always return Z_BUF_ERROR when deflate() has nothing to do
- deflateInit and inflateInit are now macros to allow version checking
- prefix all global functions and types with z_ with -DZ_PREFIX
- make falloc completely reentrant (inftrees.c)
- fixed very unlikely race condition in ct_static_init
- free in reverse order of allocation to help memory manager
- use zlib-1.0/* instead of zlib/* inside the tar.gz
- make zlib warning-free with "gcc -O3 -Wall -Wwrite-strings -Wpointer-arith
  -Wconversion -Wstrict-prototypes -Wmissing-prototypes"
- allow gzread on concatenated .gz files
- deflateEnd now returns Z_DATA_ERROR if it was premature
- deflate is finally (?) fully deterministic (no matches beyond end of input)
- Document Z_SYNC_FLUSH
- add uninstall in Makefile
- Check for __cpluplus in zlib.h
- Better test in ct_align for partial flush
- avoid harmless warnings for Borland C++
- initialize hash_head in deflate.c
- avoid warning on fdopen (gzio.c) for HP cc -Aa
- include stdlib.h for STDC compilers
- include errno.h for Cray
- ignore error if ranlib doesn't exist
- call ranlib twice for NeXTSTEP
- use exec_prefix instead of prefix for libz.a
- renamed ct_* as _tr_* to avoid conflict with applications
- clear z->msg in inflateInit2 before any error return
- initialize opaque in example.c, gzio.c, deflate.c and inflate.c
- fixed typo in zconf.h (_GNUC__ => __GNUC__)
- check for WIN32 in zconf.h and zutil.c (avoid farmalloc in 32-bit mode)
- fix typo in Make_vms.com (f$trnlnm -> f$getsyi)
- in fcalloc, normalize pointer if size > 65520 bytes
- don't use special fcalloc for 32 bit Borland C++
- use STDC instead of __GO32__ to avoid redeclaring exit, calloc, etc...
- use Z_BINARY instead of BINARY
- document that gzclose after gzdopen will close the file
- allow "a" as mode in gzopen.
- fix error checking in gzread
- allow skipping .gz extra-field on pipes
- added reference to Perl interface in README
- put the crc table in FAR data (I dislike more and more the medium model :)
- added get_crc_table
- added a dimension to all arrays (Borland C can't count).
- workaround Borland C bug in declaration of inflate_codes_new & inflate_fast
- guard against multiple inclusion of *.h (for precompiled header on Mac)
- Watcom C pretends to be Microsoft C small model even in 32 bit mode.
- don't use unsized arrays to avoid silly warnings by Visual C++:
     warning C4746: 'inflate_mask' : unsized array treated as  '__far'
     (what's wrong with far data in far model?).
- define enum out of inflate_blocks_state to allow compilation with C++

Changes in 0.95 (16 Aug 95)
- fix MSDOS small and medium model (now easier to adapt to any compiler)
- inlined send_bits
- fix the final (:-) bug for deflate with flush (output was correct but
  not completely flushed in rare occasions).
- default window size is same for compression and decompression
  (it's now sufficient to set MAX_WBITS in zconf.h).
- voidp -> voidpf and voidnp -> voidp (for consistency with other
  typedefs and because voidnp was not near in large model).

Changes in 0.94 (13 Aug 95)
- support MSDOS medium model
- fix deflate with flush (could sometimes generate bad output)
- fix deflateReset (zlib header was incorrectly suppressed)
- added support for VMS
- allow a compression level in gzopen()
- gzflush now calls fflush
- For deflate with flush, flush even if no more input is provided.
- rename libgz.a as libz.a
- avoid complex expression in infcodes.c triggering Turbo C bug
- work around a problem with gcc on Alpha (in INSERT_STRING)
- don't use inline functions (problem with some gcc versions)
- allow renaming of Byte, uInt, etc... with #define.
- avoid warning about (unused) pointer before start of array in deflate.c
- avoid various warnings in gzio.c, example.c, infblock.c, adler32.c, zutil.c
- avoid reserved word 'new' in trees.c

Changes in 0.93 (25 June 95)
- temporarily disable inline functions
- make deflate deterministic
- give enough lookahead for PARTIAL_FLUSH
- Set binary mode for stdin/stdout in minigzip.c for OS/2
- don't even use signed char in inflate (not portable enough)
- fix inflate memory leak for segmented architectures

Changes in 0.92 (3 May 95)
- don't assume that char is signed (problem on SGI)
- Clear bit buffer when starting a stored block
- no memcpy on Pyramid
- suppressed inftest.c
- optimized fill_window, put longest_match inline for gcc
- optimized inflate on stored blocks.
- untabify all sources to simplify patches

Changes in 0.91 (2 May 95)
- Default MEM_LEVEL is 8 (not 9 for Unix) as documented in zlib.h
- Document the memory requirements in zconf.h
- added "make install"
- fix sync search logic in inflateSync
- deflate(Z_FULL_FLUSH) now works even if output buffer too short
- after inflateSync, don't scare people with just "lo world"
- added support for DJGPP

Changes in 0.9 (1 May 95)
- don't assume that zalloc clears the allocated memory (the TurboC bug
  was Mark's bug after all :)
- let again gzread copy uncompressed data unchanged (was working in 0.71)
- deflate(Z_FULL_FLUSH), inflateReset and inflateSync are now fully implemented
- added a test of inflateSync in example.c
- moved MAX_WBITS to zconf.h because users might want to change that.
- document explicitly that zalloc(64K) on MSDOS must return a normalized
  pointer (zero offset)
- added Makefiles for Microsoft C, Turbo C, Borland C++
- faster crc32()

Changes in 0.8 (29 April 95)
- added fast inflate (inffast.c)
- deflate(Z_FINISH) now returns Z_STREAM_END when done. Warning: this
  is incompatible with previous versions of zlib which returned Z_OK.
- work around a TurboC compiler bug (bad code for b << 0, see infutil.h)
  (actually that was not a compiler bug, see 0.81 above)
- gzread no longer reads one extra byte in certain cases
- In gzio destroy(), don't reference a freed structure
- avoid many warnings for MSDOS
- avoid the ERROR symbol which is used by MS Windows

Changes in 0.71 (14 April 95)
- Fixed more MSDOS compilation problems :( There is still a bug with
  TurboC large model.

Changes in 0.7 (14 April 95)
- Added full inflate support.
- Simplified the crc32() interface. The pre- and post-conditioning
  (one's complement) is now done inside crc32(). WARNING: this is
  incompatible with previous versions; see zlib.h for the new usage.

Changes in 0.61 (12 April 95)
- workaround for a bug in TurboC. example and minigzip now work on MSDOS.

Changes in 0.6 (11 April 95)
- added minigzip.c
- added gzdopen to reopen a file descriptor as gzFile
- added transparent reading of non-gziped files in gzread.
- fixed bug in gzread (don't read crc as data)
- fixed bug in destroy (gzio.c) (don't return Z_STREAM_END for gzclose).
- don't allocate big arrays in the stack (for MSDOS)
- fix some MSDOS compilation problems

Changes in 0.5:
- do real compression in deflate.c. Z_PARTIAL_FLUSH is supported but
  not yet Z_FULL_FLUSH.
- support decompression but only in a single step (forced Z_FINISH)
- added opaque object for zalloc and zfree.
- added deflateReset and inflateReset
- added a variable zlib_version for consistency checking.
- renamed the 'filter' parameter of deflateInit2 as 'strategy'.
  Added Z_FILTERED and Z_HUFFMAN_ONLY constants.

Changes in 0.4:
- avoid "zip" everywhere, use zlib instead of ziplib.
- suppress Z_BLOCK_FLUSH, interpret Z_PARTIAL_FLUSH as block flush
  if compression method == 8.
- added adler32 and crc32
- renamed deflateOptions as deflateInit2, call one or the other but not both
- added the method parameter for deflateInit2.
- added inflateInit2
- simplied considerably deflateInit and inflateInit by not supporting
  user-provided history buffer. This is supported only in deflateInit2
  and inflateInit2.

Changes in 0.3:
- prefix all macro names with Z_
- use Z_FINISH instead of deflateEnd to finish compression.
- added Z_HUFFMAN_ONLY
- added gzerror()

Deleted compat/zlib/FAQ.

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
363
364
365
366
367
368
















































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

                Frequently Asked Questions about zlib


If your question is not there, please check the zlib home page
http://zlib.net/ which may have more recent information.
The lastest zlib FAQ is at http://zlib.net/zlib_faq.html


 1. Is zlib Y2K-compliant?

    Yes. zlib doesn't handle dates.

 2. Where can I get a Windows DLL version?

    The zlib sources can be compiled without change to produce a DLL.  See the
    file win32/DLL_FAQ.txt in the zlib distribution.  Pointers to the
    precompiled DLL are found in the zlib web site at http://zlib.net/ .

 3. Where can I get a Visual Basic interface to zlib?

    See
        * http://marknelson.us/1997/01/01/zlib-engine/
        * win32/DLL_FAQ.txt in the zlib distribution

 4. compress() returns Z_BUF_ERROR.

    Make sure that before the call of compress(), the length of the compressed
    buffer is equal to the available size of the compressed buffer and not
    zero.  For Visual Basic, check that this parameter is passed by reference
    ("as any"), not by value ("as long").

 5. deflate() or inflate() returns Z_BUF_ERROR.

    Before making the call, make sure that avail_in and avail_out are not zero.
    When setting the parameter flush equal to Z_FINISH, also make sure that
    avail_out is big enough to allow processing all pending input.  Note that a
    Z_BUF_ERROR is not fatal--another call to deflate() or inflate() can be
    made with more input or output space.  A Z_BUF_ERROR may in fact be
    unavoidable depending on how the functions are used, since it is not
    possible to tell whether or not there is more output pending when
    strm.avail_out returns with zero.  See http://zlib.net/zlib_how.html for a
    heavily annotated example.

 6. Where's the zlib documentation (man pages, etc.)?

    It's in zlib.h .  Examples of zlib usage are in the files test/example.c
    and test/minigzip.c, with more in examples/ .

 7. Why don't you use GNU autoconf or libtool or ...?

    Because we would like to keep zlib as a very small and simple package.
    zlib is rather portable and doesn't need much configuration.

 8. I found a bug in zlib.

    Most of the time, such problems are due to an incorrect usage of zlib.
    Please try to reproduce the problem with a small program and send the
    corresponding source to us at zlib@gzip.org .  Do not send multi-megabyte
    data files without prior agreement.

 9. Why do I get "undefined reference to gzputc"?

    If "make test" produces something like

       example.o(.text+0x154): undefined reference to `gzputc'

    check that you don't have old files libz.* in /usr/lib, /usr/local/lib or
    /usr/X11R6/lib. Remove any old versions, then do "make install".

10. I need a Delphi interface to zlib.

    See the contrib/delphi directory in the zlib distribution.

11. Can zlib handle .zip archives?

    Not by itself, no.  See the directory contrib/minizip in the zlib
    distribution.

12. Can zlib handle .Z files?

    No, sorry.  You have to spawn an uncompress or gunzip subprocess, or adapt
    the code of uncompress on your own.

13. How can I make a Unix shared library?

    By default a shared (and a static) library is built for Unix.  So:

    make distclean
    ./configure
    make

14. How do I install a shared zlib library on Unix?

    After the above, then:

    make install

    However, many flavors of Unix come with a shared zlib already installed.
    Before going to the trouble of compiling a shared version of zlib and
    trying to install it, you may want to check if it's already there!  If you
    can #include <zlib.h>, it's there.  The -lz option will probably link to
    it.  You can check the version at the top of zlib.h or with the
    ZLIB_VERSION symbol defined in zlib.h .

15. I have a question about OttoPDF.

    We are not the authors of OttoPDF. The real author is on the OttoPDF web
    site: Joel Hainley, jhainley@myndkryme.com.

16. Can zlib decode Flate data in an Adobe PDF file?

    Yes. See http://www.pdflib.com/ . To modify PDF forms, see
    http://sourceforge.net/projects/acroformtool/ .

17. Why am I getting this "register_frame_info not found" error on Solaris?

    After installing zlib 1.1.4 on Solaris 2.6, running applications using zlib
    generates an error such as:

        ld.so.1: rpm: fatal: relocation error: file /usr/local/lib/libz.so:
        symbol __register_frame_info: referenced symbol not found

    The symbol __register_frame_info is not part of zlib, it is generated by
    the C compiler (cc or gcc).  You must recompile applications using zlib
    which have this problem.  This problem is specific to Solaris.  See
    http://www.sunfreeware.com for Solaris versions of zlib and applications
    using zlib.

18. Why does gzip give an error on a file I make with compress/deflate?

    The compress and deflate functions produce data in the zlib format, which
    is different and incompatible with the gzip format.  The gz* functions in
    zlib on the other hand use the gzip format.  Both the zlib and gzip formats
    use the same compressed data format internally, but have different headers
    and trailers around the compressed data.

19. Ok, so why are there two different formats?

    The gzip format was designed to retain the directory information about a
    single file, such as the name and last modification date.  The zlib format
    on the other hand was designed for in-memory and communication channel
    applications, and has a much more compact header and trailer and uses a
    faster integrity check than gzip.

20. Well that's nice, but how do I make a gzip file in memory?

    You can request that deflate write the gzip format instead of the zlib
    format using deflateInit2().  You can also request that inflate decode the
    gzip format using inflateInit2().  Read zlib.h for more details.

21. Is zlib thread-safe?

    Yes.  However any library routines that zlib uses and any application-
    provided memory allocation routines must also be thread-safe.  zlib's gz*
    functions use stdio library routines, and most of zlib's functions use the
    library memory allocation routines by default.  zlib's *Init* functions
    allow for the application to provide custom memory allocation routines.

    Of course, you should only operate on any given zlib or gzip stream from a
    single thread at a time.

22. Can I use zlib in my commercial application?

    Yes.  Please read the license in zlib.h.

23. Is zlib under the GNU license?

    No.  Please read the license in zlib.h.

24. The license says that altered source versions must be "plainly marked". So
    what exactly do I need to do to meet that requirement?

    You need to change the ZLIB_VERSION and ZLIB_VERNUM #defines in zlib.h.  In
    particular, the final version number needs to be changed to "f", and an
    identification string should be appended to ZLIB_VERSION.  Version numbers
    x.x.x.f are reserved for modifications to zlib by others than the zlib
    maintainers.  For example, if the version of the base zlib you are altering
    is "1.2.3.4", then in zlib.h you should change ZLIB_VERNUM to 0x123f, and
    ZLIB_VERSION to something like "1.2.3.f-zachary-mods-v3".  You can also
    update the version strings in deflate.c and inftrees.c.

    For altered source distributions, you should also note the origin and
    nature of the changes in zlib.h, as well as in ChangeLog and README, along
    with the dates of the alterations.  The origin should include at least your
    name (or your company's name), and an email address to contact for help or
    issues with the library.

    Note that distributing a compiled zlib library along with zlib.h and
    zconf.h is also a source distribution, and so you should change
    ZLIB_VERSION and ZLIB_VERNUM and note the origin and nature of the changes
    in zlib.h as you would for a full source distribution.

25. Will zlib work on a big-endian or little-endian architecture, and can I
    exchange compressed data between them?

    Yes and yes.

26. Will zlib work on a 64-bit machine?

    Yes.  It has been tested on 64-bit machines, and has no dependence on any
    data types being limited to 32-bits in length.  If you have any
    difficulties, please provide a complete problem report to zlib@gzip.org

27. Will zlib decompress data from the PKWare Data Compression Library?

    No.  The PKWare DCL uses a completely different compressed data format than
    does PKZIP and zlib.  However, you can look in zlib's contrib/blast
    directory for a possible solution to your problem.

28. Can I access data randomly in a compressed stream?

    No, not without some preparation.  If when compressing you periodically use
    Z_FULL_FLUSH, carefully write all the pending data at those points, and
    keep an index of those locations, then you can start decompression at those
    points.  You have to be careful to not use Z_FULL_FLUSH too often, since it
    can significantly degrade compression.  Alternatively, you can scan a
    deflate stream once to generate an index, and then use that index for
    random access.  See examples/zran.c .

29. Does zlib work on MVS, OS/390, CICS, etc.?

    It has in the past, but we have not heard of any recent evidence.  There
    were working ports of zlib 1.1.4 to MVS, but those links no longer work.
    If you know of recent, successful applications of zlib on these operating
    systems, please let us know.  Thanks.

30. Is there some simpler, easier to read version of inflate I can look at to
    understand the deflate format?

    First off, you should read RFC 1951.  Second, yes.  Look in zlib's
    contrib/puff directory.

31. Does zlib infringe on any patents?

    As far as we know, no.  In fact, that was originally the whole point behind
    zlib.  Look here for some more information:

    http://www.gzip.org/#faq11

32. Can zlib work with greater than 4 GB of data?

    Yes.  inflate() and deflate() will process any amount of data correctly.
    Each call of inflate() or deflate() is limited to input and output chunks
    of the maximum value that can be stored in the compiler's "unsigned int"
    type, but there is no limit to the number of chunks.  Note however that the
    strm.total_in and strm_total_out counters may be limited to 4 GB.  These
    counters are provided as a convenience and are not used internally by
    inflate() or deflate().  The application can easily set up its own counters
    updated after each call of inflate() or deflate() to count beyond 4 GB.
    compress() and uncompress() may be limited to 4 GB, since they operate in a
    single call.  gzseek() and gztell() may be limited to 4 GB depending on how
    zlib is compiled.  See the zlibCompileFlags() function in zlib.h.

    The word "may" appears several times above since there is a 4 GB limit only
    if the compiler's "long" type is 32 bits.  If the compiler's "long" type is
    64 bits, then the limit is 16 exabytes.

33. Does zlib have any security vulnerabilities?

    The only one that we are aware of is potentially in gzprintf().  If zlib is
    compiled to use sprintf() or vsprintf(), then there is no protection
    against a buffer overflow of an 8K string space (or other value as set by
    gzbuffer()), other than the caller of gzprintf() assuring that the output
    will not exceed 8K.  On the other hand, if zlib is compiled to use
    snprintf() or vsnprintf(), which should normally be the case, then there is
    no vulnerability.  The ./configure script will display warnings if an
    insecure variation of sprintf() will be used by gzprintf().  Also the
    zlibCompileFlags() function will return information on what variant of
    sprintf() is used by gzprintf().

    If you don't have snprintf() or vsnprintf() and would like one, you can
    find a portable implementation here:

        http://www.ijs.si/software/snprintf/

    Note that you should be using the most recent version of zlib.  Versions
    1.1.3 and before were subject to a double-free vulnerability, and versions
    1.2.1 and 1.2.2 were subject to an access exception when decompressing
    invalid compressed data.

34. Is there a Java version of zlib?

    Probably what you want is to use zlib in Java. zlib is already included
    as part of the Java SDK in the java.util.zip package. If you really want
    a version of zlib written in the Java language, look on the zlib home
    page for links: http://zlib.net/ .

35. I get this or that compiler or source-code scanner warning when I crank it
    up to maximally-pedantic. Can't you guys write proper code?

    Many years ago, we gave up attempting to avoid warnings on every compiler
    in the universe.  It just got to be a waste of time, and some compilers
    were downright silly as well as contradicted each other.  So now, we simply
    make sure that the code always works.

36. Valgrind (or some similar memory access checker) says that deflate is
    performing a conditional jump that depends on an uninitialized value.
    Isn't that a bug?

    No.  That is intentional for performance reasons, and the output of deflate
    is not affected.  This only started showing up recently since zlib 1.2.x
    uses malloc() by default for allocations, whereas earlier versions used
    calloc(), which zeros out the allocated memory.  Even though the code was
    correct, versions 1.2.4 and later was changed to not stimulate these
    checkers.

37. Will zlib read the (insert any ancient or arcane format here) compressed
    data format?

    Probably not. Look in the comp.compression FAQ for pointers to various
    formats and associated software.

38. How can I encrypt/decrypt zip files with zlib?

    zlib doesn't support encryption.  The original PKZIP encryption is very
    weak and can be broken with freely available programs.  To get strong
    encryption, use GnuPG, http://www.gnupg.org/ , which already includes zlib
    compression.  For PKZIP compatible "encryption", look at
    http://www.info-zip.org/

39. What's the difference between the "gzip" and "deflate" HTTP 1.1 encodings?

    "gzip" is the gzip format, and "deflate" is the zlib format.  They should
    probably have called the second one "zlib" instead to avoid confusion with
    the raw deflate compressed data format.  While the HTTP 1.1 RFC 2616
    correctly points to the zlib specification in RFC 1950 for the "deflate"
    transfer encoding, there have been reports of servers and browsers that
    incorrectly produce or expect raw deflate data per the deflate
    specification in RFC 1951, most notably Microsoft.  So even though the
    "deflate" transfer encoding using the zlib format would be the more
    efficient approach (and in fact exactly what the zlib format was designed
    for), using the "gzip" transfer encoding is probably more reliable due to
    an unfortunate choice of name on the part of the HTTP 1.1 authors.

    Bottom line: use the gzip format for HTTP 1.1 encoding.

40. Does zlib support the new "Deflate64" format introduced by PKWare?

    No.  PKWare has apparently decided to keep that format proprietary, since
    they have not documented it as they have previous compression formats.  In
    any case, the compression improvements are so modest compared to other more
    modern approaches, that it's not worth the effort to implement.

41. I'm having a problem with the zip functions in zlib, can you help?

    There are no zip functions in zlib.  You are probably using minizip by
    Giles Vollant, which is found in the contrib directory of zlib.  It is not
    part of zlib.  In fact none of the stuff in contrib is part of zlib.  The
    files in there are not supported by the zlib authors.  You need to contact
    the authors of the respective contribution for help.

42. The match.asm code in contrib is under the GNU General Public License.
    Since it's part of zlib, doesn't that mean that all of zlib falls under the
    GNU GPL?

    No.  The files in contrib are not part of zlib.  They were contributed by
    other authors and are provided as a convenience to the user within the zlib
    distribution.  Each item in contrib has its own license.

43. Is zlib subject to export controls?  What is its ECCN?

    zlib is not subject to export controls, and so is classified as EAR99.

44. Can you please sign these lengthy legal documents and fax them back to us
    so that we can use your software in our product?

    No. Go away. Shoo.

Deleted compat/zlib/INDEX.

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




































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
CMakeLists.txt  cmake build file
ChangeLog       history of changes
FAQ             Frequently Asked Questions about zlib
INDEX           this file
Makefile        dummy Makefile that tells you to ./configure
Makefile.in     template for Unix Makefile
README          guess what
configure       configure script for Unix
make_vms.com    makefile for VMS
test/example.c  zlib usages examples for build testing
test/minigzip.c minimal gzip-like functionality for build testing
test/infcover.c inf*.c code coverage for build coverage testing
treebuild.xml   XML description of source file dependencies
zconf.h.cmakein zconf.h template for cmake
zconf.h.in      zconf.h template for configure
zlib.3          Man page for zlib
zlib.3.pdf      Man page in PDF format
zlib.map        Linux symbol information
zlib.pc.in      Template for pkg-config descriptor
zlib.pc.cmakein zlib.pc template for cmake
zlib2ansi       perl script to convert source files for C++ compilation

amiga/          makefiles for Amiga SAS C
as400/          makefiles for AS/400
doc/            documentation for formats and algorithms
msdos/          makefiles for MSDOS
nintendods/     makefile for Nintendo DS
old/            makefiles for various architectures and zlib documentation
                files that have not yet been updated for zlib 1.2.x
qnx/            makefiles for QNX
watcom/         makefiles for OpenWatcom
win32/          makefiles for Windows

                zlib public header files (required for library use):
zconf.h
zlib.h

                private source files used to build the zlib library:
adler32.c
compress.c
crc32.c
crc32.h
deflate.c
deflate.h
gzclose.c
gzguts.h
gzlib.c
gzread.c
gzwrite.c
infback.c
inffast.c
inffast.h
inffixed.h
inflate.c
inflate.h
inftrees.c
inftrees.h
trees.c
trees.h
uncompr.c
zutil.c
zutil.h

                source files for sample programs
See examples/README.examples

                unsupported contributions by third parties
See contrib/README.contrib

Deleted compat/zlib/Makefile.

1
2
3
4
5





-
-
-
-
-
all:
	-@echo "Please use ./configure first.  Thank you."

distclean:
	make -f Makefile.in distclean

Deleted compat/zlib/Makefile.in.

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
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


























































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# Copyright (C) 1995-2017 Jean-loup Gailly, Mark Adler
# For conditions of distribution and use, see copyright notice in zlib.h

# To compile and test, type:
#    ./configure; make test
# Normally configure builds both a static and a shared library.
# If you want to build just a static library, use: ./configure --static

# To use the asm code, type:
#    cp contrib/asm?86/match.S ./match.S
#    make LOC=-DASMV OBJA=match.o

# To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type:
#    make install
# To install in $HOME instead of /usr/local, use:
#    make install prefix=$HOME

CC=cc

CFLAGS=-O
#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
#CFLAGS=-g -DZLIB_DEBUG
#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
#           -Wstrict-prototypes -Wmissing-prototypes

SFLAGS=-O
LDFLAGS=
TEST_LDFLAGS=-L. libz.a
LDSHARED=$(CC)
CPP=$(CC) -E

STATICLIB=libz.a
SHAREDLIB=libz.so
SHAREDLIBV=libz.so.1.2.11
SHAREDLIBM=libz.so.1
LIBS=$(STATICLIB) $(SHAREDLIBV)

AR=ar
ARFLAGS=rc
RANLIB=ranlib
LDCONFIG=ldconfig
LDSHAREDLIBC=-lc
TAR=tar
SHELL=/bin/sh
EXE=

prefix = /usr/local
exec_prefix = ${prefix}
libdir = ${exec_prefix}/lib
sharedlibdir = ${libdir}
includedir = ${prefix}/include
mandir = ${prefix}/share/man
man3dir = ${mandir}/man3
pkgconfigdir = ${libdir}/pkgconfig
SRCDIR=
ZINC=
ZINCOUT=-I.

OBJZ = adler32.o crc32.o deflate.o infback.o inffast.o inflate.o inftrees.o trees.o zutil.o
OBJG = compress.o uncompr.o gzclose.o gzlib.o gzread.o gzwrite.o
OBJC = $(OBJZ) $(OBJG)

PIC_OBJZ = adler32.lo crc32.lo deflate.lo infback.lo inffast.lo inflate.lo inftrees.lo trees.lo zutil.lo
PIC_OBJG = compress.lo uncompr.lo gzclose.lo gzlib.lo gzread.lo gzwrite.lo
PIC_OBJC = $(PIC_OBJZ) $(PIC_OBJG)

# to use the asm code: make OBJA=match.o, PIC_OBJA=match.lo
OBJA =
PIC_OBJA =

OBJS = $(OBJC) $(OBJA)

PIC_OBJS = $(PIC_OBJC) $(PIC_OBJA)

all: static shared

static: example$(EXE) minigzip$(EXE)

shared: examplesh$(EXE) minigzipsh$(EXE)

all64: example64$(EXE) minigzip64$(EXE)

check: test

test: all teststatic testshared

teststatic: static
	@TMPST=tmpst_$$; \
	if echo hello world | ./minigzip | ./minigzip -d && ./example $$TMPST ; then \
	  echo '		*** zlib test OK ***'; \
	else \
	  echo '		*** zlib test FAILED ***'; false; \
	fi; \
	rm -f $$TMPST

testshared: shared
	@LD_LIBRARY_PATH=`pwd`:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \
	LD_LIBRARYN32_PATH=`pwd`:$(LD_LIBRARYN32_PATH) ; export LD_LIBRARYN32_PATH; \
	DYLD_LIBRARY_PATH=`pwd`:$(DYLD_LIBRARY_PATH) ; export DYLD_LIBRARY_PATH; \
	SHLIB_PATH=`pwd`:$(SHLIB_PATH) ; export SHLIB_PATH; \
	TMPSH=tmpsh_$$; \
	if echo hello world | ./minigzipsh | ./minigzipsh -d && ./examplesh $$TMPSH; then \
	  echo '		*** zlib shared test OK ***'; \
	else \
	  echo '		*** zlib shared test FAILED ***'; false; \
	fi; \
	rm -f $$TMPSH

test64: all64
	@TMP64=tmp64_$$; \
	if echo hello world | ./minigzip64 | ./minigzip64 -d && ./example64 $$TMP64; then \
	  echo '		*** zlib 64-bit test OK ***'; \
	else \
	  echo '		*** zlib 64-bit test FAILED ***'; false; \
	fi; \
	rm -f $$TMP64

infcover.o: $(SRCDIR)test/infcover.c $(SRCDIR)zlib.h zconf.h
	$(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/infcover.c

infcover: infcover.o libz.a
	$(CC) $(CFLAGS) -o $@ infcover.o libz.a

cover: infcover
	rm -f *.gcda
	./infcover
	gcov inf*.c

libz.a: $(OBJS)
	$(AR) $(ARFLAGS) $@ $(OBJS)
	-@ ($(RANLIB) $@ || true) >/dev/null 2>&1

match.o: match.S
	$(CPP) match.S > _match.s
	$(CC) -c _match.s
	mv _match.o match.o
	rm -f _match.s

match.lo: match.S
	$(CPP) match.S > _match.s
	$(CC) -c -fPIC _match.s
	mv _match.o match.lo
	rm -f _match.s

example.o: $(SRCDIR)test/example.c $(SRCDIR)zlib.h zconf.h
	$(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/example.c

minigzip.o: $(SRCDIR)test/minigzip.c $(SRCDIR)zlib.h zconf.h
	$(CC) $(CFLAGS) $(ZINCOUT) -c -o $@ $(SRCDIR)test/minigzip.c

example64.o: $(SRCDIR)test/example.c $(SRCDIR)zlib.h zconf.h
	$(CC) $(CFLAGS) $(ZINCOUT) -D_FILE_OFFSET_BITS=64 -c -o $@ $(SRCDIR)test/example.c

minigzip64.o: $(SRCDIR)test/minigzip.c $(SRCDIR)zlib.h zconf.h
	$(CC) $(CFLAGS) $(ZINCOUT) -D_FILE_OFFSET_BITS=64 -c -o $@ $(SRCDIR)test/minigzip.c


adler32.o: $(SRCDIR)adler32.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)adler32.c

crc32.o: $(SRCDIR)crc32.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)crc32.c

deflate.o: $(SRCDIR)deflate.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)deflate.c

infback.o: $(SRCDIR)infback.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)infback.c

inffast.o: $(SRCDIR)inffast.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inffast.c

inflate.o: $(SRCDIR)inflate.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inflate.c

inftrees.o: $(SRCDIR)inftrees.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)inftrees.c

trees.o: $(SRCDIR)trees.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)trees.c

zutil.o: $(SRCDIR)zutil.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)zutil.c

compress.o: $(SRCDIR)compress.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)compress.c

uncompr.o: $(SRCDIR)uncompr.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)uncompr.c

gzclose.o: $(SRCDIR)gzclose.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzclose.c

gzlib.o: $(SRCDIR)gzlib.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzlib.c

gzread.o: $(SRCDIR)gzread.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzread.c

gzwrite.o: $(SRCDIR)gzwrite.c
	$(CC) $(CFLAGS) $(ZINC) -c -o $@ $(SRCDIR)gzwrite.c


adler32.lo: $(SRCDIR)adler32.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/adler32.o $(SRCDIR)adler32.c
	-@mv objs/adler32.o $@

crc32.lo: $(SRCDIR)crc32.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/crc32.o $(SRCDIR)crc32.c
	-@mv objs/crc32.o $@

deflate.lo: $(SRCDIR)deflate.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/deflate.o $(SRCDIR)deflate.c
	-@mv objs/deflate.o $@

infback.lo: $(SRCDIR)infback.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/infback.o $(SRCDIR)infback.c
	-@mv objs/infback.o $@

inffast.lo: $(SRCDIR)inffast.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inffast.o $(SRCDIR)inffast.c
	-@mv objs/inffast.o $@

inflate.lo: $(SRCDIR)inflate.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inflate.o $(SRCDIR)inflate.c
	-@mv objs/inflate.o $@

inftrees.lo: $(SRCDIR)inftrees.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/inftrees.o $(SRCDIR)inftrees.c
	-@mv objs/inftrees.o $@

trees.lo: $(SRCDIR)trees.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/trees.o $(SRCDIR)trees.c
	-@mv objs/trees.o $@

zutil.lo: $(SRCDIR)zutil.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/zutil.o $(SRCDIR)zutil.c
	-@mv objs/zutil.o $@

compress.lo: $(SRCDIR)compress.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/compress.o $(SRCDIR)compress.c
	-@mv objs/compress.o $@

uncompr.lo: $(SRCDIR)uncompr.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/uncompr.o $(SRCDIR)uncompr.c
	-@mv objs/uncompr.o $@

gzclose.lo: $(SRCDIR)gzclose.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzclose.o $(SRCDIR)gzclose.c
	-@mv objs/gzclose.o $@

gzlib.lo: $(SRCDIR)gzlib.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzlib.o $(SRCDIR)gzlib.c
	-@mv objs/gzlib.o $@

gzread.lo: $(SRCDIR)gzread.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzread.o $(SRCDIR)gzread.c
	-@mv objs/gzread.o $@

gzwrite.lo: $(SRCDIR)gzwrite.c
	-@mkdir objs 2>/dev/null || test -d objs
	$(CC) $(SFLAGS) $(ZINC) -DPIC -c -o objs/gzwrite.o $(SRCDIR)gzwrite.c
	-@mv objs/gzwrite.o $@


placebo $(SHAREDLIBV): $(PIC_OBJS) libz.a
	$(LDSHARED) $(SFLAGS) -o $@ $(PIC_OBJS) $(LDSHAREDLIBC) $(LDFLAGS)
	rm -f $(SHAREDLIB) $(SHAREDLIBM)
	ln -s $@ $(SHAREDLIB)
	ln -s $@ $(SHAREDLIBM)
	-@rmdir objs

example$(EXE): example.o $(STATICLIB)
	$(CC) $(CFLAGS) -o $@ example.o $(TEST_LDFLAGS)

minigzip$(EXE): minigzip.o $(STATICLIB)
	$(CC) $(CFLAGS) -o $@ minigzip.o $(TEST_LDFLAGS)

examplesh$(EXE): example.o $(SHAREDLIBV)
	$(CC) $(CFLAGS) -o $@ example.o -L. $(SHAREDLIBV)

minigzipsh$(EXE): minigzip.o $(SHAREDLIBV)
	$(CC) $(CFLAGS) -o $@ minigzip.o -L. $(SHAREDLIBV)

example64$(EXE): example64.o $(STATICLIB)
	$(CC) $(CFLAGS) -o $@ example64.o $(TEST_LDFLAGS)

minigzip64$(EXE): minigzip64.o $(STATICLIB)
	$(CC) $(CFLAGS) -o $@ minigzip64.o $(TEST_LDFLAGS)

install-libs: $(LIBS)
	-@if [ ! -d $(DESTDIR)$(exec_prefix)  ]; then mkdir -p $(DESTDIR)$(exec_prefix); fi
	-@if [ ! -d $(DESTDIR)$(libdir)       ]; then mkdir -p $(DESTDIR)$(libdir); fi
	-@if [ ! -d $(DESTDIR)$(sharedlibdir) ]; then mkdir -p $(DESTDIR)$(sharedlibdir); fi
	-@if [ ! -d $(DESTDIR)$(man3dir)      ]; then mkdir -p $(DESTDIR)$(man3dir); fi
	-@if [ ! -d $(DESTDIR)$(pkgconfigdir) ]; then mkdir -p $(DESTDIR)$(pkgconfigdir); fi
	rm -f $(DESTDIR)$(libdir)/$(STATICLIB)
	cp $(STATICLIB) $(DESTDIR)$(libdir)
	chmod 644 $(DESTDIR)$(libdir)/$(STATICLIB)
	-@($(RANLIB) $(DESTDIR)$(libdir)/libz.a || true) >/dev/null 2>&1
	-@if test -n "$(SHAREDLIBV)"; then \
	  rm -f $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV); \
	  cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir); \
	  echo "cp $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)"; \
	  chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV); \
	  echo "chmod 755 $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBV)"; \
	  rm -f $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \
	  ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIB); \
	  ln -s $(SHAREDLIBV) $(DESTDIR)$(sharedlibdir)/$(SHAREDLIBM); \
	  ($(LDCONFIG) || true)  >/dev/null 2>&1; \
	fi
	rm -f $(DESTDIR)$(man3dir)/zlib.3
	cp $(SRCDIR)zlib.3 $(DESTDIR)$(man3dir)
	chmod 644 $(DESTDIR)$(man3dir)/zlib.3
	rm -f $(DESTDIR)$(pkgconfigdir)/zlib.pc
	cp zlib.pc $(DESTDIR)$(pkgconfigdir)
	chmod 644 $(DESTDIR)$(pkgconfigdir)/zlib.pc
# The ranlib in install is needed on NeXTSTEP which checks file times
# ldconfig is for Linux

install: install-libs
	-@if [ ! -d $(DESTDIR)$(includedir)   ]; then mkdir -p $(DESTDIR)$(includedir); fi
	rm -f $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h
	cp $(SRCDIR)zlib.h zconf.h $(DESTDIR)$(includedir)
	chmod 644 $(DESTDIR)$(includedir)/zlib.h $(DESTDIR)$(includedir)/zconf.h

uninstall:
	cd $(DESTDIR)$(includedir) && rm -f zlib.h zconf.h
	cd $(DESTDIR)$(libdir) && rm -f libz.a; \
	if test -n "$(SHAREDLIBV)" -a -f $(SHAREDLIBV); then \
	  rm -f $(SHAREDLIBV) $(SHAREDLIB) $(SHAREDLIBM); \
	fi
	cd $(DESTDIR)$(man3dir) && rm -f zlib.3
	cd $(DESTDIR)$(pkgconfigdir) && rm -f zlib.pc

docs: zlib.3.pdf

zlib.3.pdf: $(SRCDIR)zlib.3
	groff -mandoc -f H -T ps $(SRCDIR)zlib.3 | ps2pdf - $@

zconf.h.cmakein: $(SRCDIR)zconf.h.in
	-@ TEMPFILE=zconfh_$$; \
	echo "/#define ZCONF_H/ a\\\\\n#cmakedefine Z_PREFIX\\\\\n#cmakedefine Z_HAVE_UNISTD_H\n" >> $$TEMPFILE &&\
	sed -f $$TEMPFILE $(SRCDIR)zconf.h.in > $@ &&\
	touch -r $(SRCDIR)zconf.h.in $@ &&\
	rm $$TEMPFILE

zconf: $(SRCDIR)zconf.h.in
	cp -p $(SRCDIR)zconf.h.in zconf.h

mostlyclean: clean
clean:
	rm -f *.o *.lo *~ \
	   example$(EXE) minigzip$(EXE) examplesh$(EXE) minigzipsh$(EXE) \
	   example64$(EXE) minigzip64$(EXE) \
	   infcover \
	   libz.* foo.gz so_locations \
	   _match.s maketree contrib/infback9/*.o
	rm -rf objs
	rm -f *.gcda *.gcno *.gcov
	rm -f contrib/infback9/*.gcda contrib/infback9/*.gcno contrib/infback9/*.gcov

maintainer-clean: distclean
distclean: clean zconf zconf.h.cmakein docs
	rm -f Makefile zlib.pc configure.log
	-@rm -f .DS_Store
	@if [ -f Makefile.in ]; then \
	printf 'all:\n\t-@echo "Please use ./configure first.  Thank you."\n' > Makefile ; \
	printf '\ndistclean:\n\tmake -f Makefile.in distclean\n' >> Makefile ; \
	touch -r $(SRCDIR)Makefile.in Makefile ; fi
	@if [ ! -f zconf.h.in ]; then rm -f zconf.h zconf.h.cmakein ; fi
	@if [ ! -f zlib.3 ]; then rm -f zlib.3.pdf ; fi

tags:
	etags $(SRCDIR)*.[ch]

adler32.o zutil.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
gzclose.o gzlib.o gzread.o gzwrite.o: $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h
compress.o example.o minigzip.o uncompr.o: $(SRCDIR)zlib.h zconf.h
crc32.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)crc32.h
deflate.o: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
infback.o inflate.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h $(SRCDIR)inffixed.h
inffast.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h
inftrees.o: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h
trees.o: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)trees.h

adler32.lo zutil.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
gzclose.lo gzlib.lo gzread.lo gzwrite.lo: $(SRCDIR)zlib.h zconf.h $(SRCDIR)gzguts.h
compress.lo example.lo minigzip.lo uncompr.lo: $(SRCDIR)zlib.h zconf.h
crc32.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)crc32.h
deflate.lo: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h
infback.lo inflate.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h $(SRCDIR)inffixed.h
inffast.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h $(SRCDIR)inflate.h $(SRCDIR)inffast.h
inftrees.lo: $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)inftrees.h
trees.lo: $(SRCDIR)deflate.h $(SRCDIR)zutil.h $(SRCDIR)zlib.h zconf.h $(SRCDIR)trees.h

Deleted compat/zlib/README.

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



















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
ZLIB DATA COMPRESSION LIBRARY

zlib 1.2.11 is a general purpose data compression library.  All the code is
thread safe.  The data format used by the zlib library is described by RFCs
(Request for Comments) 1950 to 1952 in the files
http://tools.ietf.org/html/rfc1950 (zlib format), rfc1951 (deflate format) and
rfc1952 (gzip format).

All functions of the compression library are documented in the file zlib.h
(volunteer to write man pages welcome, contact zlib@gzip.org).  A usage example
of the library is given in the file test/example.c which also tests that
the library is working correctly.  Another example is given in the file
test/minigzip.c.  The compression library itself is composed of all source
files in the root directory.

To compile all files and run the test program, follow the instructions given at
the top of Makefile.in.  In short "./configure; make test", and if that goes
well, "make install" should work for most flavors of Unix.  For Windows, use
one of the special makefiles in win32/ or contrib/vstudio/ .  For VMS, use
make_vms.com.

Questions about zlib should be sent to <zlib@gzip.org>, or to Gilles Vollant
<info@winimage.com> for the Windows DLL version.  The zlib home page is
http://zlib.net/ .  Before reporting a problem, please check this site to
verify that you have the latest version of zlib; otherwise get the latest
version and check whether the problem still exists or not.

PLEASE read the zlib FAQ http://zlib.net/zlib_faq.html before asking for help.

Mark Nelson <markn@ieee.org> wrote an article about zlib for the Jan.  1997
issue of Dr.  Dobb's Journal; a copy of the article is available at
http://marknelson.us/1997/01/01/zlib-engine/ .

The changes made in version 1.2.11 are documented in the file ChangeLog.

Unsupported third party contributions are provided in directory contrib/ .

zlib is available in Java using the java.util.zip package, documented at
http://java.sun.com/developer/technicalArticles/Programming/compression/ .

A Perl interface to zlib written by Paul Marquess <pmqs@cpan.org> is available
at CPAN (Comprehensive Perl Archive Network) sites, including
http://search.cpan.org/~pmqs/IO-Compress-Zlib/ .

A Python interface to zlib written by A.M. Kuchling <amk@amk.ca> is
available in Python 1.5 and later versions, see
http://docs.python.org/library/zlib.html .

zlib is built into tcl: http://wiki.tcl.tk/4610 .

An experimental package to read and write files in .zip format, written on top
of zlib by Gilles Vollant <info@winimage.com>, is available in the
contrib/minizip directory of zlib.


Notes for some targets:

- For Windows DLL versions, please see win32/DLL_FAQ.txt

- For 64-bit Irix, deflate.c must be compiled without any optimization. With
  -O, one libpng test fails. The test works in 32 bit mode (with the -n32
  compiler flag). The compiler bug has been reported to SGI.

- zlib doesn't work with gcc 2.6.3 on a DEC 3000/300LX under OSF/1 2.1 it works
  when compiled with cc.

- On Digital Unix 4.0D (formely OSF/1) on AlphaServer, the cc option -std1 is
  necessary to get gzprintf working correctly. This is done by configure.

- zlib doesn't work on HP-UX 9.05 with some versions of /bin/cc. It works with
  other compilers. Use "make test" to check your compiler.

- gzdopen is not supported on RISCOS or BEOS.

- For PalmOs, see http://palmzlib.sourceforge.net/


Acknowledgments:

  The deflate format used by zlib was defined by Phil Katz.  The deflate and
  zlib specifications were written by L.  Peter Deutsch.  Thanks to all the
  people who reported problems and suggested various improvements in zlib; they
  are too numerous to cite here.

Copyright notice:

 (C) 1995-2017 Jean-loup Gailly and Mark Adler

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Jean-loup Gailly        Mark Adler
  jloup@gzip.org          madler@alumni.caltech.edu

If you use the zlib library in a product, we would appreciate *not* receiving
lengthy legal documents to sign.  The sources are provided for free but without
warranty of any kind.  The library has been entirely written by Jean-loup
Gailly and Mark Adler; it does not include third-party code.

If you redistribute modified sources, we would appreciate that you include in
the file ChangeLog history information documenting your changes.  Please read
the FAQ for more information on the distribution of modified source versions.

Deleted compat/zlib/adler32.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186


























































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* adler32.c -- compute the Adler-32 checksum of a data stream
 * Copyright (C) 1995-2011, 2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#include "zutil.h"

local uLong adler32_combine_ OF((uLong adler1, uLong adler2, z_off64_t len2));

#define BASE 65521U     /* largest prime smaller than 65536 */
#define NMAX 5552
/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */

#define DO1(buf,i)  {adler += (buf)[i]; sum2 += adler;}
#define DO2(buf,i)  DO1(buf,i); DO1(buf,i+1);
#define DO4(buf,i)  DO2(buf,i); DO2(buf,i+2);
#define DO8(buf,i)  DO4(buf,i); DO4(buf,i+4);
#define DO16(buf)   DO8(buf,0); DO8(buf,8);

/* use NO_DIVIDE if your processor does not do division in hardware --
   try it both ways to see which is faster */
#ifdef NO_DIVIDE
/* note that this assumes BASE is 65521, where 65536 % 65521 == 15
   (thank you to John Reiser for pointing this out) */
#  define CHOP(a) \
    do { \
        unsigned long tmp = a >> 16; \
        a &= 0xffffUL; \
        a += (tmp << 4) - tmp; \
    } while (0)
#  define MOD28(a) \
    do { \
        CHOP(a); \
        if (a >= BASE) a -= BASE; \
    } while (0)
#  define MOD(a) \
    do { \
        CHOP(a); \
        MOD28(a); \
    } while (0)
#  define MOD63(a) \
    do { /* this assumes a is not negative */ \
        z_off64_t tmp = a >> 32; \
        a &= 0xffffffffL; \
        a += (tmp << 8) - (tmp << 5) + tmp; \
        tmp = a >> 16; \
        a &= 0xffffL; \
        a += (tmp << 4) - tmp; \
        tmp = a >> 16; \
        a &= 0xffffL; \
        a += (tmp << 4) - tmp; \
        if (a >= BASE) a -= BASE; \
    } while (0)
#else
#  define MOD(a) a %= BASE
#  define MOD28(a) a %= BASE
#  define MOD63(a) a %= BASE
#endif

/* ========================================================================= */
uLong ZEXPORT adler32_z(adler, buf, len)
    uLong adler;
    const Bytef *buf;
    z_size_t len;
{
    unsigned long sum2;
    unsigned n;

    /* split Adler-32 into component sums */
    sum2 = (adler >> 16) & 0xffff;
    adler &= 0xffff;

    /* in case user likes doing a byte at a time, keep it fast */
    if (len == 1) {
        adler += buf[0];
        if (adler >= BASE)
            adler -= BASE;
        sum2 += adler;
        if (sum2 >= BASE)
            sum2 -= BASE;
        return adler | (sum2 << 16);
    }

    /* initial Adler-32 value (deferred check for len == 1 speed) */
    if (buf == Z_NULL)
        return 1L;

    /* in case short lengths are provided, keep it somewhat fast */
    if (len < 16) {
        while (len--) {
            adler += *buf++;
            sum2 += adler;
        }
        if (adler >= BASE)
            adler -= BASE;
        MOD28(sum2);            /* only added so many BASE's */
        return adler | (sum2 << 16);
    }

    /* do length NMAX blocks -- requires just one modulo operation */
    while (len >= NMAX) {
        len -= NMAX;
        n = NMAX / 16;          /* NMAX is divisible by 16 */
        do {
            DO16(buf);          /* 16 sums unrolled */
            buf += 16;
        } while (--n);
        MOD(adler);
        MOD(sum2);
    }

    /* do remaining bytes (less than NMAX, still just one modulo) */
    if (len) {                  /* avoid modulos if none remaining */
        while (len >= 16) {
            len -= 16;
            DO16(buf);
            buf += 16;
        }
        while (len--) {
            adler += *buf++;
            sum2 += adler;
        }
        MOD(adler);
        MOD(sum2);
    }

    /* return recombined sums */
    return adler | (sum2 << 16);
}

/* ========================================================================= */
uLong ZEXPORT adler32(adler, buf, len)
    uLong adler;
    const Bytef *buf;
    uInt len;
{
    return adler32_z(adler, buf, len);
}

/* ========================================================================= */
local uLong adler32_combine_(adler1, adler2, len2)
    uLong adler1;
    uLong adler2;
    z_off64_t len2;
{
    unsigned long sum1;
    unsigned long sum2;
    unsigned rem;

    /* for negative len, return invalid adler32 as a clue for debugging */
    if (len2 < 0)
        return 0xffffffffUL;

    /* the derivation of this formula is left as an exercise for the reader */
    MOD63(len2);                /* assumes len2 >= 0 */
    rem = (unsigned)len2;
    sum1 = adler1 & 0xffff;
    sum2 = rem * sum1;
    MOD(sum2);
    sum1 += (adler2 & 0xffff) + BASE - 1;
    sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem;
    if (sum1 >= BASE) sum1 -= BASE;
    if (sum1 >= BASE) sum1 -= BASE;
    if (sum2 >= ((unsigned long)BASE << 1)) sum2 -= ((unsigned long)BASE << 1);
    if (sum2 >= BASE) sum2 -= BASE;
    return sum1 | (sum2 << 16);
}

/* ========================================================================= */
uLong ZEXPORT adler32_combine(adler1, adler2, len2)
    uLong adler1;
    uLong adler2;
    z_off_t len2;
{
    return adler32_combine_(adler1, adler2, len2);
}

uLong ZEXPORT adler32_combine64(adler1, adler2, len2)
    uLong adler1;
    uLong adler2;
    z_off64_t len2;
{
    return adler32_combine_(adler1, adler2, len2);
}

Deleted compat/zlib/amiga/Makefile.pup.

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





































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Amiga powerUP (TM) Makefile
# makefile for libpng and SAS C V6.58/7.00 PPC compiler
# Copyright (C) 1998 by Andreas R. Kleinert

LIBNAME	= libzip.a

CC	= scppc
CFLAGS	= NOSTKCHK NOSINT OPTIMIZE OPTGO OPTPEEP OPTINLOCAL OPTINL \
	  OPTLOOP OPTRDEP=8 OPTDEP=8 OPTCOMP=8 NOVER
AR	= ppc-amigaos-ar cr
RANLIB	= ppc-amigaos-ranlib
LD	= ppc-amigaos-ld -r
LDFLAGS	= -o
LDLIBS	= LIB:scppc.a LIB:end.o
RM	= delete quiet

OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
       uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o

TEST_OBJS = example.o minigzip.o

all: example minigzip

check: test
test: all
	example
	echo hello world | minigzip | minigzip -d

$(LIBNAME): $(OBJS)
	$(AR) $@ $(OBJS)
	-$(RANLIB) $@

example: example.o $(LIBNAME)
	$(LD) $(LDFLAGS) $@ LIB:c_ppc.o $@.o $(LIBNAME) $(LDLIBS)

minigzip: minigzip.o $(LIBNAME)
	$(LD) $(LDFLAGS) $@ LIB:c_ppc.o $@.o $(LIBNAME) $(LDLIBS)

mostlyclean: clean
clean:
	$(RM) *.o example minigzip $(LIBNAME) foo.gz

zip:
	zip -ul9 zlib README ChangeLog Makefile Make????.??? Makefile.?? \
	  descrip.mms *.[ch]

tgz:
	cd ..; tar cfz zlib/zlib.tgz zlib/README zlib/ChangeLog zlib/Makefile \
	  zlib/Make????.??? zlib/Makefile.?? zlib/descrip.mms zlib/*.[ch]

# DO NOT DELETE THIS LINE -- make depend depends on it.

adler32.o: zlib.h zconf.h
compress.o: zlib.h zconf.h
crc32.o: crc32.h zlib.h zconf.h
deflate.o: deflate.h zutil.h zlib.h zconf.h
example.o: zlib.h zconf.h
gzclose.o: zlib.h zconf.h gzguts.h
gzlib.o: zlib.h zconf.h gzguts.h
gzread.o: zlib.h zconf.h gzguts.h
gzwrite.o: zlib.h zconf.h gzguts.h
inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
infback.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inftrees.o: zutil.h zlib.h zconf.h inftrees.h
minigzip.o: zlib.h zconf.h
trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
uncompr.o: zlib.h zconf.h
zutil.o: zutil.h zlib.h zconf.h

Deleted compat/zlib/amiga/Makefile.sas.

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




































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# SMakefile for zlib
# Modified from the standard UNIX Makefile Copyright Jean-loup Gailly
# Osma Ahvenlampi <Osma.Ahvenlampi@hut.fi>
# Amiga, SAS/C 6.56 & Smake

CC=sc
CFLAGS=OPT
#CFLAGS=OPT CPU=68030
#CFLAGS=DEBUG=LINE
LDFLAGS=LIB z.lib

SCOPTIONS=OPTSCHED OPTINLINE OPTALIAS OPTTIME OPTINLOCAL STRMERGE \
       NOICONS PARMS=BOTH NOSTACKCHECK UTILLIB NOVERSION ERRORREXX \
       DEF=POSTINC

OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
       uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o

TEST_OBJS = example.o minigzip.o

all: SCOPTIONS example minigzip

check: test
test: all
	example
	echo hello world | minigzip | minigzip -d

install: z.lib
	copy clone zlib.h zconf.h INCLUDE:
	copy clone z.lib LIB:

z.lib: $(OBJS)
	oml z.lib r $(OBJS)

example: example.o z.lib
	$(CC) $(CFLAGS) LINK TO $@ example.o $(LDFLAGS)

minigzip: minigzip.o z.lib
	$(CC) $(CFLAGS) LINK TO $@ minigzip.o $(LDFLAGS)

mostlyclean: clean
clean:
	-delete force quiet example minigzip *.o z.lib foo.gz *.lnk SCOPTIONS

SCOPTIONS: Makefile.sas
	copy to $@ <from <
$(SCOPTIONS)
<

# DO NOT DELETE THIS LINE -- make depend depends on it.

adler32.o: zlib.h zconf.h
compress.o: zlib.h zconf.h
crc32.o: crc32.h zlib.h zconf.h
deflate.o: deflate.h zutil.h zlib.h zconf.h
example.o: zlib.h zconf.h
gzclose.o: zlib.h zconf.h gzguts.h
gzlib.o: zlib.h zconf.h gzguts.h
gzread.o: zlib.h zconf.h gzguts.h
gzwrite.o: zlib.h zconf.h gzguts.h
inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
infback.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inftrees.o: zutil.h zlib.h zconf.h inftrees.h
minigzip.o: zlib.h zconf.h
trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
uncompr.o: zlib.h zconf.h
zutil.o: zutil.h zlib.h zconf.h

Deleted compat/zlib/compress.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86






















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* compress.c -- compress a memory buffer
 * Copyright (C) 1995-2005, 2014, 2016 Jean-loup Gailly, Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#define ZLIB_INTERNAL
#include "zlib.h"

/* ===========================================================================
     Compresses the source buffer into the destination buffer. The level
   parameter has the same meaning as in deflateInit.  sourceLen is the byte
   length of the source buffer. Upon entry, destLen is the total size of the
   destination buffer, which must be at least 0.1% larger than sourceLen plus
   12 bytes. Upon exit, destLen is the actual size of the compressed buffer.

     compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
   memory, Z_BUF_ERROR if there was not enough room in the output buffer,
   Z_STREAM_ERROR if the level parameter is invalid.
*/
int ZEXPORT compress2 (dest, destLen, source, sourceLen, level)
    Bytef *dest;
    uLongf *destLen;
    const Bytef *source;
    uLong sourceLen;
    int level;
{
    z_stream stream;
    int err;
    const uInt max = (uInt)-1;
    uLong left;

    left = *destLen;
    *destLen = 0;

    stream.zalloc = (alloc_func)0;
    stream.zfree = (free_func)0;
    stream.opaque = (voidpf)0;

    err = deflateInit(&stream, level);
    if (err != Z_OK) return err;

    stream.next_out = dest;
    stream.avail_out = 0;
    stream.next_in = (z_const Bytef *)source;
    stream.avail_in = 0;

    do {
        if (stream.avail_out == 0) {
            stream.avail_out = left > (uLong)max ? max : (uInt)left;
            left -= stream.avail_out;
        }
        if (stream.avail_in == 0) {
            stream.avail_in = sourceLen > (uLong)max ? max : (uInt)sourceLen;
            sourceLen -= stream.avail_in;
        }
        err = deflate(&stream, sourceLen ? Z_NO_FLUSH : Z_FINISH);
    } while (err == Z_OK);

    *destLen = stream.total_out;
    deflateEnd(&stream);
    return err == Z_STREAM_END ? Z_OK : err;
}

/* ===========================================================================
 */
int ZEXPORT compress (dest, destLen, source, sourceLen)
    Bytef *dest;
    uLongf *destLen;
    const Bytef *source;
    uLong sourceLen;
{
    return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION);
}

/* ===========================================================================
     If the default memLevel or windowBits for deflateInit() is changed, then
   this function needs to be updated.
 */
uLong ZEXPORT compressBound (sourceLen)
    uLong sourceLen;
{
    return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) +
           (sourceLen >> 25) + 13;
}

Deleted compat/zlib/configure.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#!/bin/sh
# configure script for zlib.
#
# Normally configure builds both a static and a shared library.
# If you want to build just a static library, use: ./configure --static
#
# To impose specific compiler or flags or install directory, use for example:
#    prefix=$HOME CC=cc CFLAGS="-O4" ./configure
# or for csh/tcsh users:
#    (setenv prefix $HOME; setenv CC cc; setenv CFLAGS "-O4"; ./configure)

# Incorrect settings of CC or CFLAGS may prevent creating a shared library.
# If you have problems, try without defining CC and CFLAGS before reporting
# an error.

# start off configure.log
echo -------------------- >> configure.log
echo $0 $* >> configure.log
date >> configure.log

# get source directory
SRCDIR=`dirname $0`
if test $SRCDIR = "."; then
    ZINC=""
    ZINCOUT="-I."
    SRCDIR=""
else
    ZINC='-include zconf.h'
    ZINCOUT='-I. -I$(SRCDIR)'
    SRCDIR="$SRCDIR/"
fi

# set command prefix for cross-compilation
if [ -n "${CHOST}" ]; then
    uname="`echo "${CHOST}" | sed -e 's/^[^-]*-\([^-]*\)$/\1/' -e 's/^[^-]*-[^-]*-\([^-]*\)$/\1/' -e 's/^[^-]*-[^-]*-\([^-]*\)-.*$/\1/'`"
    CROSS_PREFIX="${CHOST}-"
fi

# destination name for static library
STATICLIB=libz.a

# extract zlib version numbers from zlib.h
VER=`sed -n -e '/VERSION "/s/.*"\(.*\)".*/\1/p' < ${SRCDIR}zlib.h`
VER3=`sed -n -e '/VERSION "/s/.*"\([0-9]*\\.[0-9]*\\.[0-9]*\).*/\1/p' < ${SRCDIR}zlib.h`
VER2=`sed -n -e '/VERSION "/s/.*"\([0-9]*\\.[0-9]*\)\\..*/\1/p' < ${SRCDIR}zlib.h`
VER1=`sed -n -e '/VERSION "/s/.*"\([0-9]*\)\\..*/\1/p' < ${SRCDIR}zlib.h`

# establish commands for library building
if "${CROSS_PREFIX}ar" --version >/dev/null 2>/dev/null || test $? -lt 126; then
    AR=${AR-"${CROSS_PREFIX}ar"}
    test -n "${CROSS_PREFIX}" && echo Using ${AR} | tee -a configure.log
else
    AR=${AR-"ar"}
    test -n "${CROSS_PREFIX}" && echo Using ${AR} | tee -a configure.log
fi
ARFLAGS=${ARFLAGS-"rc"}
if "${CROSS_PREFIX}ranlib" --version >/dev/null 2>/dev/null || test $? -lt 126; then
    RANLIB=${RANLIB-"${CROSS_PREFIX}ranlib"}
    test -n "${CROSS_PREFIX}" && echo Using ${RANLIB} | tee -a configure.log
else
    RANLIB=${RANLIB-"ranlib"}
fi
if "${CROSS_PREFIX}nm" --version >/dev/null 2>/dev/null || test $? -lt 126; then
    NM=${NM-"${CROSS_PREFIX}nm"}
    test -n "${CROSS_PREFIX}" && echo Using ${NM} | tee -a configure.log
else
    NM=${NM-"nm"}
fi

# set defaults before processing command line options
LDCONFIG=${LDCONFIG-"ldconfig"}
LDSHAREDLIBC="${LDSHAREDLIBC--lc}"
ARCHS=
prefix=${prefix-/usr/local}
exec_prefix=${exec_prefix-'${prefix}'}
libdir=${libdir-'${exec_prefix}/lib'}
sharedlibdir=${sharedlibdir-'${libdir}'}
includedir=${includedir-'${prefix}/include'}
mandir=${mandir-'${prefix}/share/man'}
shared_ext='.so'
shared=1
solo=0
cover=0
zprefix=0
zconst=0
build64=0
gcc=0
warn=0
debug=0
old_cc="$CC"
old_cflags="$CFLAGS"
OBJC='$(OBJZ) $(OBJG)'
PIC_OBJC='$(PIC_OBJZ) $(PIC_OBJG)'

# leave this script, optionally in a bad way
leave()
{
  if test "$*" != "0"; then
    echo "** $0 aborting." | tee -a configure.log
  fi
  rm -f $test.[co] $test $test$shared_ext $test.gcno ./--version
  echo -------------------- >> configure.log
  echo >> configure.log
  echo >> configure.log
  exit $1
}

# process command line options
while test $# -ge 1
do
case "$1" in
    -h* | --help)
      echo 'usage:' | tee -a configure.log
      echo '  configure [--const] [--zprefix] [--prefix=PREFIX]  [--eprefix=EXPREFIX]' | tee -a configure.log
      echo '    [--static] [--64] [--libdir=LIBDIR] [--sharedlibdir=LIBDIR]' | tee -a configure.log
      echo '    [--includedir=INCLUDEDIR] [--archs="-arch i386 -arch x86_64"]' | tee -a configure.log
        exit 0 ;;
    -p*=* | --prefix=*) prefix=`echo $1 | sed 's/.*=//'`; shift ;;
    -e*=* | --eprefix=*) exec_prefix=`echo $1 | sed 's/.*=//'`; shift ;;
    -l*=* | --libdir=*) libdir=`echo $1 | sed 's/.*=//'`; shift ;;
    --sharedlibdir=*) sharedlibdir=`echo $1 | sed 's/.*=//'`; shift ;;
    -i*=* | --includedir=*) includedir=`echo $1 | sed 's/.*=//'`;shift ;;
    -u*=* | --uname=*) uname=`echo $1 | sed 's/.*=//'`;shift ;;
    -p* | --prefix) prefix="$2"; shift; shift ;;
    -e* | --eprefix) exec_prefix="$2"; shift; shift ;;
    -l* | --libdir) libdir="$2"; shift; shift ;;
    -i* | --includedir) includedir="$2"; shift; shift ;;
    -s* | --shared | --enable-shared) shared=1; shift ;;
    -t | --static) shared=0; shift ;;
    --solo) solo=1; shift ;;
    --cover) cover=1; shift ;;
    -z* | --zprefix) zprefix=1; shift ;;
    -6* | --64) build64=1; shift ;;
    -a*=* | --archs=*) ARCHS=`echo $1 | sed 's/.*=//'`; shift ;;
    --sysconfdir=*) echo "ignored option: --sysconfdir" | tee -a configure.log; shift ;;
    --localstatedir=*) echo "ignored option: --localstatedir" | tee -a configure.log; shift ;;
    -c* | --const) zconst=1; shift ;;
    -w* | --warn) warn=1; shift ;;
    -d* | --debug) debug=1; shift ;;
    *)
      echo "unknown option: $1" | tee -a configure.log
      echo "$0 --help for help" | tee -a configure.log
      leave 1;;
    esac
done

# temporary file name
test=ztest$$

# put arguments in log, also put test file in log if used in arguments
show()
{
  case "$*" in
    *$test.c*)
      echo === $test.c === >> configure.log
      cat $test.c >> configure.log
      echo === >> configure.log;;
  esac
  echo $* >> configure.log
}

# check for gcc vs. cc and set compile and link flags based on the system identified by uname
cat > $test.c <<EOF
extern int getchar();
int hello() {return getchar();}
EOF

test -z "$CC" && echo Checking for ${CROSS_PREFIX}gcc... | tee -a configure.log
cc=${CC-${CROSS_PREFIX}gcc}
cflags=${CFLAGS-"-O3"}
# to force the asm version use: CFLAGS="-O3 -DASMV" ./configure
case "$cc" in
  *gcc*) gcc=1 ;;
  *clang*) gcc=1 ;;
esac
case `$cc -v 2>&1` in
  *gcc*) gcc=1 ;;
  *clang*) gcc=1 ;;
esac

show $cc -c $test.c
if test "$gcc" -eq 1 && ($cc -c $test.c) >> configure.log 2>&1; then
  echo ... using gcc >> configure.log
  CC="$cc"
  CFLAGS="${CFLAGS--O3}"
  SFLAGS="${CFLAGS--O3} -fPIC"
  if test "$ARCHS"; then
    CFLAGS="${CFLAGS} ${ARCHS}"
    LDFLAGS="${LDFLAGS} ${ARCHS}"
  fi
  if test $build64 -eq 1; then
    CFLAGS="${CFLAGS} -m64"
    SFLAGS="${SFLAGS} -m64"
  fi
  if test "$warn" -eq 1; then
    if test "$zconst" -eq 1; then
      CFLAGS="${CFLAGS} -Wall -Wextra -Wcast-qual -pedantic -DZLIB_CONST"
    else
      CFLAGS="${CFLAGS} -Wall -Wextra -pedantic"
    fi
  fi
  if test $debug -eq 1; then
    CFLAGS="${CFLAGS} -DZLIB_DEBUG"
    SFLAGS="${SFLAGS} -DZLIB_DEBUG"
  fi
  if test -z "$uname"; then
    uname=`(uname -s || echo unknown) 2>/dev/null`
  fi
  case "$uname" in
  Linux* | linux* | GNU | GNU/* | solaris*)
        LDSHARED=${LDSHARED-"$cc -shared -Wl,-soname,libz.so.1,--version-script,${SRCDIR}zlib.map"} ;;
  *BSD | *bsd* | DragonFly)
        LDSHARED=${LDSHARED-"$cc -shared -Wl,-soname,libz.so.1,--version-script,${SRCDIR}zlib.map"}
        LDCONFIG="ldconfig -m" ;;
  CYGWIN* | Cygwin* | cygwin* | OS/2*)
        EXE='.exe' ;;
  MINGW* | mingw*)
# temporary bypass
        rm -f $test.[co] $test $test$shared_ext
        echo "Please use win32/Makefile.gcc instead." | tee -a configure.log
        leave 1
        LDSHARED=${LDSHARED-"$cc -shared"}
        LDSHAREDLIBC=""
        EXE='.exe' ;;
  QNX*)  # This is for QNX6. I suppose that the QNX rule below is for QNX2,QNX4
         # (alain.bonnefoy@icbt.com)
                 LDSHARED=${LDSHARED-"$cc -shared -Wl,-hlibz.so.1"} ;;
  HP-UX*)
         LDSHARED=${LDSHARED-"$cc -shared $SFLAGS"}
         case `(uname -m || echo unknown) 2>/dev/null` in
         ia64)
                 shared_ext='.so'
                 SHAREDLIB='libz.so' ;;
         *)
                 shared_ext='.sl'
                 SHAREDLIB='libz.sl' ;;
         esac ;;
  Darwin* | darwin*)
             shared_ext='.dylib'
             SHAREDLIB=libz$shared_ext
             SHAREDLIBV=libz.$VER$shared_ext
             SHAREDLIBM=libz.$VER1$shared_ext
             LDSHARED=${LDSHARED-"$cc -dynamiclib -install_name $libdir/$SHAREDLIBM -compatibility_version $VER1 -current_version $VER3"}
             if libtool -V 2>&1 | grep Apple > /dev/null; then
                 AR="libtool"
             else
                 AR="/usr/bin/libtool"
             fi
             ARFLAGS="-o" ;;
  *)             LDSHARED=${LDSHARED-"$cc -shared"} ;;
  esac
else
  # find system name and corresponding cc options
  CC=${CC-cc}
  gcc=0
  echo ... using $CC >> configure.log
  if test -z "$uname"; then
    uname=`(uname -sr || echo unknown) 2>/dev/null`
  fi
  case "$uname" in
  HP-UX*)    SFLAGS=${CFLAGS-"-O +z"}
             CFLAGS=${CFLAGS-"-O"}
#            LDSHARED=${LDSHARED-"ld -b +vnocompatwarnings"}
             LDSHARED=${LDSHARED-"ld -b"}
         case `(uname -m || echo unknown) 2>/dev/null` in
         ia64)
             shared_ext='.so'
             SHAREDLIB='libz.so' ;;
         *)
             shared_ext='.sl'
             SHAREDLIB='libz.sl' ;;
         esac ;;
  IRIX*)     SFLAGS=${CFLAGS-"-ansi -O2 -rpath ."}
             CFLAGS=${CFLAGS-"-ansi -O2"}
             LDSHARED=${LDSHARED-"cc -shared -Wl,-soname,libz.so.1"} ;;
  OSF1\ V4*) SFLAGS=${CFLAGS-"-O -std1"}
             CFLAGS=${CFLAGS-"-O -std1"}
             LDFLAGS="${LDFLAGS} -Wl,-rpath,."
             LDSHARED=${LDSHARED-"cc -shared  -Wl,-soname,libz.so -Wl,-msym -Wl,-rpath,$(libdir) -Wl,-set_version,${VER}:1.0"} ;;
  OSF1*)     SFLAGS=${CFLAGS-"-O -std1"}
             CFLAGS=${CFLAGS-"-O -std1"}
             LDSHARED=${LDSHARED-"cc -shared -Wl,-soname,libz.so.1"} ;;
  QNX*)      SFLAGS=${CFLAGS-"-4 -O"}
             CFLAGS=${CFLAGS-"-4 -O"}
             LDSHARED=${LDSHARED-"cc"}
             RANLIB=${RANLIB-"true"}
             AR="cc"
             ARFLAGS="-A" ;;
  SCO_SV\ 3.2*) SFLAGS=${CFLAGS-"-O3 -dy -KPIC "}
             CFLAGS=${CFLAGS-"-O3"}
             LDSHARED=${LDSHARED-"cc -dy -KPIC -G"} ;;
  SunOS\ 5* | solaris*)
         LDSHARED=${LDSHARED-"cc -G -h libz$shared_ext.$VER1"}
         SFLAGS=${CFLAGS-"-fast -KPIC"}
         CFLAGS=${CFLAGS-"-fast"}
         if test $build64 -eq 1; then
             # old versions of SunPRO/Workshop/Studio don't support -m64,
             # but newer ones do.  Check for it.
             flag64=`$CC -flags | egrep -- '^-m64'`
             if test x"$flag64" != x"" ; then
                 CFLAGS="${CFLAGS} -m64"
                 SFLAGS="${SFLAGS} -m64"
             else
                 case `(uname -m || echo unknown) 2>/dev/null` in
                   i86*)
                     SFLAGS="$SFLAGS -xarch=amd64"
                     CFLAGS="$CFLAGS -xarch=amd64" ;;
                   *)
                     SFLAGS="$SFLAGS -xarch=v9"
                     CFLAGS="$CFLAGS -xarch=v9" ;;
                 esac
             fi
         fi
         if test -n "$ZINC"; then
             ZINC='-I- -I. -I$(SRCDIR)'
         fi
         ;;
  SunOS\ 4*) SFLAGS=${CFLAGS-"-O2 -PIC"}
             CFLAGS=${CFLAGS-"-O2"}
             LDSHARED=${LDSHARED-"ld"} ;;
  SunStudio\ 9*) SFLAGS=${CFLAGS-"-fast -xcode=pic32 -xtarget=ultra3 -xarch=v9b"}
             CFLAGS=${CFLAGS-"-fast -xtarget=ultra3 -xarch=v9b"}
             LDSHARED=${LDSHARED-"cc -xarch=v9b"} ;;
  UNIX_System_V\ 4.2.0)
             SFLAGS=${CFLAGS-"-KPIC -O"}
             CFLAGS=${CFLAGS-"-O"}
             LDSHARED=${LDSHARED-"cc -G"} ;;
  UNIX_SV\ 4.2MP)
             SFLAGS=${CFLAGS-"-Kconform_pic -O"}
             CFLAGS=${CFLAGS-"-O"}
             LDSHARED=${LDSHARED-"cc -G"} ;;
  OpenUNIX\ 5)
             SFLAGS=${CFLAGS-"-KPIC -O"}
             CFLAGS=${CFLAGS-"-O"}
             LDSHARED=${LDSHARED-"cc -G"} ;;
  AIX*)  # Courtesy of dbakker@arrayasolutions.com
             SFLAGS=${CFLAGS-"-O -qmaxmem=8192"}
             CFLAGS=${CFLAGS-"-O -qmaxmem=8192"}
             LDSHARED=${LDSHARED-"xlc -G"} ;;
  # send working options for other systems to zlib@gzip.org
  *)         SFLAGS=${CFLAGS-"-O"}
             CFLAGS=${CFLAGS-"-O"}
             LDSHARED=${LDSHARED-"cc -shared"} ;;
  esac
fi

# destination names for shared library if not defined above
SHAREDLIB=${SHAREDLIB-"libz$shared_ext"}
SHAREDLIBV=${SHAREDLIBV-"libz$shared_ext.$VER"}
SHAREDLIBM=${SHAREDLIBM-"libz$shared_ext.$VER1"}

echo >> configure.log

# define functions for testing compiler and library characteristics and logging the results

cat > $test.c <<EOF
#error error
EOF
if ($CC -c $CFLAGS $test.c) 2>/dev/null; then
  try()
  {
    show $*
    test "`( $* ) 2>&1 | tee -a configure.log`" = ""
  }
  echo - using any output from compiler to indicate an error >> configure.log
else
  try()
  {
    show $*
    ( $* ) >> configure.log 2>&1
    ret=$?
    if test $ret -ne 0; then
      echo "(exit code "$ret")" >> configure.log
    fi
    return $ret
  }
fi

tryboth()
{
  show $*
  got=`( $* ) 2>&1`
  ret=$?
  printf %s "$got" >> configure.log
  if test $ret -ne 0; then
    return $ret
  fi
  test "$got" = ""
}

cat > $test.c << EOF
int foo() { return 0; }
EOF
echo "Checking for obsessive-compulsive compiler options..." >> configure.log
if try $CC -c $CFLAGS $test.c; then
  :
else
  echo "Compiler error reporting is too harsh for $0 (perhaps remove -Werror)." | tee -a configure.log
  leave 1
fi

echo >> configure.log

# see if shared library build supported
cat > $test.c <<EOF
extern int getchar();
int hello() {return getchar();}
EOF
if test $shared -eq 1; then
  echo Checking for shared library support... | tee -a configure.log
  # we must test in two steps (cc then ld), required at least on SunOS 4.x
  if try $CC -w -c $SFLAGS $test.c &&
     try $LDSHARED $SFLAGS -o $test$shared_ext $test.o; then
    echo Building shared library $SHAREDLIBV with $CC. | tee -a configure.log
  elif test -z "$old_cc" -a -z "$old_cflags"; then
    echo No shared library support. | tee -a configure.log
    shared=0;
  else
    echo 'No shared library support; try without defining CC and CFLAGS' | tee -a configure.log
    shared=0;
  fi
fi
if test $shared -eq 0; then
  LDSHARED="$CC"
  ALL="static"
  TEST="all teststatic"
  SHAREDLIB=""
  SHAREDLIBV=""
  SHAREDLIBM=""
  echo Building static library $STATICLIB version $VER with $CC. | tee -a configure.log
else
  ALL="static shared"
  TEST="all teststatic testshared"
fi

# check for underscores in external names for use by assembler code
CPP=${CPP-"$CC -E"}
case $CFLAGS in
  *ASMV*)
    echo >> configure.log
    show "$NM $test.o | grep _hello"
    if test "`$NM $test.o | grep _hello | tee -a configure.log`" = ""; then
      CPP="$CPP -DNO_UNDERLINE"
      echo Checking for underline in external names... No. | tee -a configure.log
    else
      echo Checking for underline in external names... Yes. | tee -a configure.log
    fi ;;
esac

echo >> configure.log

# check for size_t
cat > $test.c <<EOF
#include <stdio.h>
#include <stdlib.h>
size_t dummy = 0;
EOF
if try $CC -c $CFLAGS $test.c; then
  echo "Checking for size_t... Yes." | tee -a configure.log
  need_sizet=0
else
  echo "Checking for size_t... No." | tee -a configure.log
  need_sizet=1
fi

echo >> configure.log

# find the size_t integer type, if needed
if test $need_sizet -eq 1; then
  cat > $test.c <<EOF
long long dummy = 0;
EOF
  if try $CC -c $CFLAGS $test.c; then
    echo "Checking for long long... Yes." | tee -a configure.log
    cat > $test.c <<EOF
#include <stdio.h>
int main(void) {
    if (sizeof(void *) <= sizeof(int)) puts("int");
    else if (sizeof(void *) <= sizeof(long)) puts("long");
    else puts("z_longlong");
    return 0;
}
EOF
  else
    echo "Checking for long long... No." | tee -a configure.log
    cat > $test.c <<EOF
#include <stdio.h>
int main(void) {
    if (sizeof(void *) <= sizeof(int)) puts("int");
    else puts("long");
    return 0;
}
EOF
  fi
  if try $CC $CFLAGS -o $test $test.c; then
    sizet=`./$test`
    echo "Checking for a pointer-size integer type..." $sizet"." | tee -a configure.log
  else
    echo "Failed to find a pointer-size integer type." | tee -a configure.log
    leave 1
  fi
fi

if test $need_sizet -eq 1; then
  CFLAGS="${CFLAGS} -DNO_SIZE_T=${sizet}"
  SFLAGS="${SFLAGS} -DNO_SIZE_T=${sizet}"
fi

echo >> configure.log

# check for large file support, and if none, check for fseeko()
cat > $test.c <<EOF
#include <sys/types.h>
off64_t dummy = 0;
EOF
if try $CC -c $CFLAGS -D_LARGEFILE64_SOURCE=1 $test.c; then
  CFLAGS="${CFLAGS} -D_LARGEFILE64_SOURCE=1"
  SFLAGS="${SFLAGS} -D_LARGEFILE64_SOURCE=1"
  ALL="${ALL} all64"
  TEST="${TEST} test64"
  echo "Checking for off64_t... Yes." | tee -a configure.log
  echo "Checking for fseeko... Yes." | tee -a configure.log
else
  echo "Checking for off64_t... No." | tee -a configure.log
  echo >> configure.log
  cat > $test.c <<EOF
#include <stdio.h>
int main(void) {
  fseeko(NULL, 0, 0);
  return 0;
}
EOF
  if try $CC $CFLAGS -o $test $test.c; then
    echo "Checking for fseeko... Yes." | tee -a configure.log
  else
    CFLAGS="${CFLAGS} -DNO_FSEEKO"
    SFLAGS="${SFLAGS} -DNO_FSEEKO"
    echo "Checking for fseeko... No." | tee -a configure.log
  fi
fi

echo >> configure.log

# check for strerror() for use by gz* functions
cat > $test.c <<EOF
#include <string.h>
#include <errno.h>
int main() { return strlen(strerror(errno)); }
EOF
if try $CC $CFLAGS -o $test $test.c; then
  echo "Checking for strerror... Yes." | tee -a configure.log
else
  CFLAGS="${CFLAGS} -DNO_STRERROR"
  SFLAGS="${SFLAGS} -DNO_STRERROR"
  echo "Checking for strerror... No." | tee -a configure.log
fi

# copy clean zconf.h for subsequent edits
cp -p ${SRCDIR}zconf.h.in zconf.h

echo >> configure.log

# check for unistd.h and save result in zconf.h
cat > $test.c <<EOF
#include <unistd.h>
int main() { return 0; }
EOF
if try $CC -c $CFLAGS $test.c; then
  sed < zconf.h "/^#ifdef HAVE_UNISTD_H.* may be/s/def HAVE_UNISTD_H\(.*\) may be/ 1\1 was/" > zconf.temp.h
  mv zconf.temp.h zconf.h
  echo "Checking for unistd.h... Yes." | tee -a configure.log
else
  echo "Checking for unistd.h... No." | tee -a configure.log
fi

echo >> configure.log

# check for stdarg.h and save result in zconf.h
cat > $test.c <<EOF
#include <stdarg.h>
int main() { return 0; }
EOF
if try $CC -c $CFLAGS $test.c; then
  sed < zconf.h "/^#ifdef HAVE_STDARG_H.* may be/s/def HAVE_STDARG_H\(.*\) may be/ 1\1 was/" > zconf.temp.h
  mv zconf.temp.h zconf.h
  echo "Checking for stdarg.h... Yes." | tee -a configure.log
else
  echo "Checking for stdarg.h... No." | tee -a configure.log
fi

# if the z_ prefix was requested, save that in zconf.h
if test $zprefix -eq 1; then
  sed < zconf.h "/#ifdef Z_PREFIX.* may be/s/def Z_PREFIX\(.*\) may be/ 1\1 was/" > zconf.temp.h
  mv zconf.temp.h zconf.h
  echo >> configure.log
  echo "Using z_ prefix on all symbols." | tee -a configure.log
fi

# if --solo compilation was requested, save that in zconf.h and remove gz stuff from object lists
if test $solo -eq 1; then
  sed '/#define ZCONF_H/a\
#define Z_SOLO

' < zconf.h > zconf.temp.h
  mv zconf.temp.h zconf.h
OBJC='$(OBJZ)'
PIC_OBJC='$(PIC_OBJZ)'
fi

# if code coverage testing was requested, use older gcc if defined, e.g. "gcc-4.2" on Mac OS X
if test $cover -eq 1; then
  CFLAGS="${CFLAGS} -fprofile-arcs -ftest-coverage"
  if test -n "$GCC_CLASSIC"; then
    CC=$GCC_CLASSIC
  fi
fi

echo >> configure.log

# conduct a series of tests to resolve eight possible cases of using "vs" or "s" printf functions
# (using stdarg or not), with or without "n" (proving size of buffer), and with or without a
# return value.  The most secure result is vsnprintf() with a return value.  snprintf() with a
# return value is secure as well, but then gzprintf() will be limited to 20 arguments.
cat > $test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
#include "zconf.h"
int main()
{
#ifndef STDC
  choke me
#endif
  return 0;
}
EOF
if try $CC -c $CFLAGS $test.c; then
  echo "Checking whether to use vs[n]printf() or s[n]printf()... using vs[n]printf()." | tee -a configure.log

  echo >> configure.log
  cat > $test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
int mytest(const char *fmt, ...)
{
  char buf[20];
  va_list ap;
  va_start(ap, fmt);
  vsnprintf(buf, sizeof(buf), fmt, ap);
  va_end(ap);
  return 0;
}
int main()
{
  return (mytest("Hello%d\n", 1));
}
EOF
  if try $CC $CFLAGS -o $test $test.c; then
    echo "Checking for vsnprintf() in stdio.h... Yes." | tee -a configure.log

    echo >> configure.log
    cat >$test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
int mytest(const char *fmt, ...)
{
  int n;
  char buf[20];
  va_list ap;
  va_start(ap, fmt);
  n = vsnprintf(buf, sizeof(buf), fmt, ap);
  va_end(ap);
  return n;
}
int main()
{
  return (mytest("Hello%d\n", 1));
}
EOF

    if try $CC -c $CFLAGS $test.c; then
      echo "Checking for return value of vsnprintf()... Yes." | tee -a configure.log
    else
      CFLAGS="$CFLAGS -DHAS_vsnprintf_void"
      SFLAGS="$SFLAGS -DHAS_vsnprintf_void"
      echo "Checking for return value of vsnprintf()... No." | tee -a configure.log
      echo "  WARNING: apparently vsnprintf() does not return a value. zlib" | tee -a configure.log
      echo "  can build but will be open to possible string-format security" | tee -a configure.log
      echo "  vulnerabilities." | tee -a configure.log
    fi
  else
    CFLAGS="$CFLAGS -DNO_vsnprintf"
    SFLAGS="$SFLAGS -DNO_vsnprintf"
    echo "Checking for vsnprintf() in stdio.h... No." | tee -a configure.log
    echo "  WARNING: vsnprintf() not found, falling back to vsprintf(). zlib" | tee -a configure.log
    echo "  can build but will be open to possible buffer-overflow security" | tee -a configure.log
    echo "  vulnerabilities." | tee -a configure.log

    echo >> configure.log
    cat >$test.c <<EOF
#include <stdio.h>
#include <stdarg.h>
int mytest(const char *fmt, ...)
{
  int n;
  char buf[20];
  va_list ap;
  va_start(ap, fmt);
  n = vsprintf(buf, fmt, ap);
  va_end(ap);
  return n;
}
int main()
{
  return (mytest("Hello%d\n", 1));
}
EOF

    if try $CC -c $CFLAGS $test.c; then
      echo "Checking for return value of vsprintf()... Yes." | tee -a configure.log
    else
      CFLAGS="$CFLAGS -DHAS_vsprintf_void"
      SFLAGS="$SFLAGS -DHAS_vsprintf_void"
      echo "Checking for return value of vsprintf()... No." | tee -a configure.log
      echo "  WARNING: apparently vsprintf() does not return a value. zlib" | tee -a configure.log
      echo "  can build but will be open to possible string-format security" | tee -a configure.log
      echo "  vulnerabilities." | tee -a configure.log
    fi
  fi
else
  echo "Checking whether to use vs[n]printf() or s[n]printf()... using s[n]printf()." | tee -a configure.log

  echo >> configure.log
  cat >$test.c <<EOF
#include <stdio.h>
int mytest()
{
  char buf[20];
  snprintf(buf, sizeof(buf), "%s", "foo");
  return 0;
}
int main()
{
  return (mytest());
}
EOF

  if try $CC $CFLAGS -o $test $test.c; then
    echo "Checking for snprintf() in stdio.h... Yes." | tee -a configure.log

    echo >> configure.log
    cat >$test.c <<EOF
#include <stdio.h>
int mytest()
{
  char buf[20];
  return snprintf(buf, sizeof(buf), "%s", "foo");
}
int main()
{
  return (mytest());
}
EOF

    if try $CC -c $CFLAGS $test.c; then
      echo "Checking for return value of snprintf()... Yes." | tee -a configure.log
    else
      CFLAGS="$CFLAGS -DHAS_snprintf_void"
      SFLAGS="$SFLAGS -DHAS_snprintf_void"
      echo "Checking for return value of snprintf()... No." | tee -a configure.log
      echo "  WARNING: apparently snprintf() does not return a value. zlib" | tee -a configure.log
      echo "  can build but will be open to possible string-format security" | tee -a configure.log
      echo "  vulnerabilities." | tee -a configure.log
    fi
  else
    CFLAGS="$CFLAGS -DNO_snprintf"
    SFLAGS="$SFLAGS -DNO_snprintf"
    echo "Checking for snprintf() in stdio.h... No." | tee -a configure.log
    echo "  WARNING: snprintf() not found, falling back to sprintf(). zlib" | tee -a configure.log
    echo "  can build but will be open to possible buffer-overflow security" | tee -a configure.log
    echo "  vulnerabilities." | tee -a configure.log

    echo >> configure.log
    cat >$test.c <<EOF
#include <stdio.h>
int mytest()
{
  char buf[20];
  return sprintf(buf, "%s", "foo");
}
int main()
{
  return (mytest());
}
EOF

    if try $CC -c $CFLAGS $test.c; then
      echo "Checking for return value of sprintf()... Yes." | tee -a configure.log
    else
      CFLAGS="$CFLAGS -DHAS_sprintf_void"
      SFLAGS="$SFLAGS -DHAS_sprintf_void"
      echo "Checking for return value of sprintf()... No." | tee -a configure.log
      echo "  WARNING: apparently sprintf() does not return a value. zlib" | tee -a configure.log
      echo "  can build but will be open to possible string-format security" | tee -a configure.log
      echo "  vulnerabilities." | tee -a configure.log
    fi
  fi
fi

# see if we can hide zlib internal symbols that are linked between separate source files
if test "$gcc" -eq 1; then
  echo >> configure.log
  cat > $test.c <<EOF
#define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
int ZLIB_INTERNAL foo;
int main()
{
  return 0;
}
EOF
  if tryboth $CC -c $CFLAGS $test.c; then
    CFLAGS="$CFLAGS -DHAVE_HIDDEN"
    SFLAGS="$SFLAGS -DHAVE_HIDDEN"
    echo "Checking for attribute(visibility) support... Yes." | tee -a configure.log
  else
    echo "Checking for attribute(visibility) support... No." | tee -a configure.log
  fi
fi

# show the results in the log
echo >> configure.log
echo ALL = $ALL >> configure.log
echo AR = $AR >> configure.log
echo ARFLAGS = $ARFLAGS >> configure.log
echo CC = $CC >> configure.log
echo CFLAGS = $CFLAGS >> configure.log
echo CPP = $CPP >> configure.log
echo EXE = $EXE >> configure.log
echo LDCONFIG = $LDCONFIG >> configure.log
echo LDFLAGS = $LDFLAGS >> configure.log
echo LDSHARED = $LDSHARED >> configure.log
echo LDSHAREDLIBC = $LDSHAREDLIBC >> configure.log
echo OBJC = $OBJC >> configure.log
echo PIC_OBJC = $PIC_OBJC >> configure.log
echo RANLIB = $RANLIB >> configure.log
echo SFLAGS = $SFLAGS >> configure.log
echo SHAREDLIB = $SHAREDLIB >> configure.log
echo SHAREDLIBM = $SHAREDLIBM >> configure.log
echo SHAREDLIBV = $SHAREDLIBV >> configure.log
echo STATICLIB = $STATICLIB >> configure.log
echo TEST = $TEST >> configure.log
echo VER = $VER >> configure.log
echo Z_U4 = $Z_U4 >> configure.log
echo SRCDIR = $SRCDIR >> configure.log
echo exec_prefix = $exec_prefix >> configure.log
echo includedir = $includedir >> configure.log
echo libdir = $libdir >> configure.log
echo mandir = $mandir >> configure.log
echo prefix = $prefix >> configure.log
echo sharedlibdir = $sharedlibdir >> configure.log
echo uname = $uname >> configure.log

# udpate Makefile with the configure results
sed < ${SRCDIR}Makefile.in "
/^CC *=/s#=.*#=$CC#
/^CFLAGS *=/s#=.*#=$CFLAGS#
/^SFLAGS *=/s#=.*#=$SFLAGS#
/^LDFLAGS *=/s#=.*#=$LDFLAGS#
/^LDSHARED *=/s#=.*#=$LDSHARED#
/^CPP *=/s#=.*#=$CPP#
/^STATICLIB *=/s#=.*#=$STATICLIB#
/^SHAREDLIB *=/s#=.*#=$SHAREDLIB#
/^SHAREDLIBV *=/s#=.*#=$SHAREDLIBV#
/^SHAREDLIBM *=/s#=.*#=$SHAREDLIBM#
/^AR *=/s#=.*#=$AR#
/^ARFLAGS *=/s#=.*#=$ARFLAGS#
/^RANLIB *=/s#=.*#=$RANLIB#
/^LDCONFIG *=/s#=.*#=$LDCONFIG#
/^LDSHAREDLIBC *=/s#=.*#=$LDSHAREDLIBC#
/^EXE *=/s#=.*#=$EXE#
/^SRCDIR *=/s#=.*#=$SRCDIR#
/^ZINC *=/s#=.*#=$ZINC#
/^ZINCOUT *=/s#=.*#=$ZINCOUT#
/^prefix *=/s#=.*#=$prefix#
/^exec_prefix *=/s#=.*#=$exec_prefix#
/^libdir *=/s#=.*#=$libdir#
/^sharedlibdir *=/s#=.*#=$sharedlibdir#
/^includedir *=/s#=.*#=$includedir#
/^mandir *=/s#=.*#=$mandir#
/^OBJC *=/s#=.*#= $OBJC#
/^PIC_OBJC *=/s#=.*#= $PIC_OBJC#
/^all: */s#:.*#: $ALL#
/^test: */s#:.*#: $TEST#
" > Makefile

# create zlib.pc with the configure results
sed < ${SRCDIR}zlib.pc.in "
/^CC *=/s#=.*#=$CC#
/^CFLAGS *=/s#=.*#=$CFLAGS#
/^CPP *=/s#=.*#=$CPP#
/^LDSHARED *=/s#=.*#=$LDSHARED#
/^STATICLIB *=/s#=.*#=$STATICLIB#
/^SHAREDLIB *=/s#=.*#=$SHAREDLIB#
/^SHAREDLIBV *=/s#=.*#=$SHAREDLIBV#
/^SHAREDLIBM *=/s#=.*#=$SHAREDLIBM#
/^AR *=/s#=.*#=$AR#
/^ARFLAGS *=/s#=.*#=$ARFLAGS#
/^RANLIB *=/s#=.*#=$RANLIB#
/^EXE *=/s#=.*#=$EXE#
/^prefix *=/s#=.*#=$prefix#
/^exec_prefix *=/s#=.*#=$exec_prefix#
/^libdir *=/s#=.*#=$libdir#
/^sharedlibdir *=/s#=.*#=$sharedlibdir#
/^includedir *=/s#=.*#=$includedir#
/^mandir *=/s#=.*#=$mandir#
/^LDFLAGS *=/s#=.*#=$LDFLAGS#
" | sed -e "
s/\@VERSION\@/$VER/g;
" > zlib.pc

# done
leave 0

Deleted compat/zlib/contrib/README.contrib.

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














































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
All files under this contrib directory are UNSUPPORTED. There were
provided by users of zlib and were not tested by the authors of zlib.
Use at your own risk. Please contact the authors of the contributions
for help about these, not the zlib authors. Thanks.


ada/        by Dmitriy Anisimkov <anisimkov@yahoo.com>
        Support for Ada
        See http://zlib-ada.sourceforge.net/

amd64/      by Mikhail Teterin <mi@ALDAN.algebra.com>
        asm code for AMD64
        See patch at http://www.freebsd.org/cgi/query-pr.cgi?pr=bin/96393

asm686/     by Brian Raiter <breadbox@muppetlabs.com>
        asm code for Pentium and PPro/PII, using the AT&T (GNU as) syntax
        See http://www.muppetlabs.com/~breadbox/software/assembly.html

blast/      by Mark Adler <madler@alumni.caltech.edu>
        Decompressor for output of PKWare Data Compression Library (DCL)

delphi/     by Cosmin Truta <cosmint@cs.ubbcluj.ro>
        Support for Delphi and C++ Builder

dotzlib/    by Henrik Ravn <henrik@ravn.com>
        Support for Microsoft .Net and Visual C++ .Net

gcc_gvmat64/by Gilles Vollant <info@winimage.com>
        GCC Version of x86 64-bit (AMD64 and Intel EM64t) code for x64
        assembler to replace longest_match() and inflate_fast()

infback9/   by Mark Adler <madler@alumni.caltech.edu>
        Unsupported diffs to infback to decode the deflate64 format

inflate86/  by Chris Anderson <christop@charm.net>
        Tuned x86 gcc asm code to replace inflate_fast()

iostream/   by Kevin Ruland <kevin@rodin.wustl.edu>
        A C++ I/O streams interface to the zlib gz* functions

iostream2/  by Tyge Løvset <Tyge.Lovset@cmr.no>
        Another C++ I/O streams interface

iostream3/  by Ludwig Schwardt <schwardt@sun.ac.za>
            and Kevin Ruland <kevin@rodin.wustl.edu>
        Yet another C++ I/O streams interface

masmx64/    by Gilles Vollant <info@winimage.com>
        x86 64-bit (AMD64 and Intel EM64t) code for x64 assembler to
        replace longest_match() and inflate_fast(),  also masm x86
        64-bits translation of Chris Anderson inflate_fast()

masmx86/    by Gilles Vollant <info@winimage.com>
        x86 asm code to replace longest_match() and inflate_fast(),
        for Visual C++ and MASM (32 bits).
        Based on Brian Raiter (asm686) and Chris Anderson (inflate86)

minizip/    by Gilles Vollant <info@winimage.com>
        Mini zip and unzip based on zlib
        Includes Zip64 support by Mathias Svensson <mathias@result42.com>
        See http://www.winimage.com/zLibDll/minizip.html

pascal/     by Bob Dellaca <bobdl@xtra.co.nz> et al.
        Support for Pascal

puff/       by Mark Adler <madler@alumni.caltech.edu>
        Small, low memory usage inflate.  Also serves to provide an
        unambiguous description of the deflate format.

testzlib/   by Gilles Vollant <info@winimage.com>
        Example of the use of zlib

untgz/      by Pedro A. Aranda Gutierrez <paag@tid.es>
        A very simple tar.gz file extractor using zlib

vstudio/    by Gilles Vollant <info@winimage.com>
        Building a minizip-enhanced zlib with Microsoft Visual Studio
        Includes vc11 from kreuzerkrieg and vc12 from davispuh

Deleted compat/zlib/contrib/ada/buffer_demo.adb.

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










































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2004 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------
--
--  $Id: buffer_demo.adb,v 1.3 2004/09/06 06:55:35 vagul Exp $

--  This demo program provided by Dr Steve Sangwine <sjs@essex.ac.uk>
--
--  Demonstration of a problem with Zlib-Ada (already fixed) when a buffer
--  of exactly the correct size is used for decompressed data, and the last
--  few bytes passed in to Zlib are checksum bytes.

--  This program compresses a string of text, and then decompresses the
--  compressed text into a buffer of the same size as the original text.

with Ada.Streams; use Ada.Streams;
with Ada.Text_IO;

with ZLib; use ZLib;

procedure Buffer_Demo is
   EOL  : Character renames ASCII.LF;
   Text : constant String
     := "Four score and seven years ago our fathers brought forth," & EOL &
        "upon this continent, a new nation, conceived in liberty," & EOL &
        "and dedicated to the proposition that `all men are created equal'.";

   Source : Stream_Element_Array (1 .. Text'Length);
   for Source'Address use Text'Address;

begin
   Ada.Text_IO.Put (Text);
   Ada.Text_IO.New_Line;
   Ada.Text_IO.Put_Line
     ("Uncompressed size : " & Positive'Image (Text'Length) & " bytes");

   declare
      Compressed_Data : Stream_Element_Array (1 .. Text'Length);
      L               : Stream_Element_Offset;
   begin
      Compress : declare
         Compressor : Filter_Type;
         I : Stream_Element_Offset;
      begin
         Deflate_Init (Compressor);

         --  Compress the whole of T at once.

         Translate (Compressor, Source, I, Compressed_Data, L, Finish);
         pragma Assert (I = Source'Last);

         Close (Compressor);

         Ada.Text_IO.Put_Line
           ("Compressed size :   "
            & Stream_Element_Offset'Image (L) & " bytes");
      end Compress;

      --  Now we decompress the data, passing short blocks of data to Zlib
      --  (because this demonstrates the problem - the last block passed will
      --  contain checksum information and there will be no output, only a
      --  check inside Zlib that the checksum is correct).

      Decompress : declare
         Decompressor : Filter_Type;

         Uncompressed_Data : Stream_Element_Array (1 .. Text'Length);

         Block_Size : constant := 4;
         --  This makes sure that the last block contains
         --  only Adler checksum data.

         P : Stream_Element_Offset := Compressed_Data'First - 1;
         O : Stream_Element_Offset;
      begin
         Inflate_Init (Decompressor);

         loop
            Translate
              (Decompressor,
               Compressed_Data
                 (P + 1 .. Stream_Element_Offset'Min (P + Block_Size, L)),
               P,
               Uncompressed_Data
                 (Total_Out (Decompressor) + 1 .. Uncompressed_Data'Last),
               O,
               No_Flush);

               Ada.Text_IO.Put_Line
                 ("Total in : " & Count'Image (Total_In (Decompressor)) &
                  ", out : " & Count'Image (Total_Out (Decompressor)));

               exit when P = L;
         end loop;

         Ada.Text_IO.New_Line;
         Ada.Text_IO.Put_Line
           ("Decompressed text matches original text : "
             & Boolean'Image (Uncompressed_Data = Source));
      end Decompress;
   end;
end Buffer_Demo;

Deleted compat/zlib/contrib/ada/mtest.adb.

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




























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------
--  Continuous test for ZLib multithreading. If the test would fail
--  we should provide thread safe allocation routines for the Z_Stream.
--
--  $Id: mtest.adb,v 1.4 2004/07/23 07:49:54 vagul Exp $

with ZLib;
with Ada.Streams;
with Ada.Numerics.Discrete_Random;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Task_Identification;

procedure MTest is
   use Ada.Streams;
   use ZLib;

   Stop : Boolean := False;

   pragma Atomic (Stop);

   subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;

   package Random_Elements is
      new Ada.Numerics.Discrete_Random (Visible_Symbols);

   task type Test_Task;

   task body Test_Task is
      Buffer : Stream_Element_Array (1 .. 100_000);
      Gen : Random_Elements.Generator;

      Buffer_First  : Stream_Element_Offset;
      Compare_First : Stream_Element_Offset;

      Deflate : Filter_Type;
      Inflate : Filter_Type;

      procedure Further (Item : in Stream_Element_Array);

      procedure Read_Buffer
        (Item : out Ada.Streams.Stream_Element_Array;
         Last : out Ada.Streams.Stream_Element_Offset);

      -------------
      -- Further --
      -------------

      procedure Further (Item : in Stream_Element_Array) is

         procedure Compare (Item : in Stream_Element_Array);

         -------------
         -- Compare --
         -------------

         procedure Compare (Item : in Stream_Element_Array) is
            Next_First : Stream_Element_Offset := Compare_First + Item'Length;
         begin
            if Buffer (Compare_First .. Next_First - 1) /= Item then
               raise Program_Error;
            end if;

            Compare_First := Next_First;
         end Compare;

         procedure Compare_Write is new ZLib.Write (Write => Compare);
      begin
         Compare_Write (Inflate, Item, No_Flush);
      end Further;

      -----------------
      -- Read_Buffer --
      -----------------

      procedure Read_Buffer
        (Item : out Ada.Streams.Stream_Element_Array;
         Last : out Ada.Streams.Stream_Element_Offset)
      is
         Buff_Diff   : Stream_Element_Offset := Buffer'Last - Buffer_First;
         Next_First : Stream_Element_Offset;
      begin
         if Item'Length <= Buff_Diff then
            Last := Item'Last;

            Next_First := Buffer_First + Item'Length;

            Item := Buffer (Buffer_First .. Next_First - 1);

            Buffer_First := Next_First;
         else
            Last := Item'First + Buff_Diff;
            Item (Item'First .. Last) := Buffer (Buffer_First .. Buffer'Last);
            Buffer_First := Buffer'Last + 1;
         end if;
      end Read_Buffer;

      procedure Translate is new Generic_Translate
                                   (Data_In  => Read_Buffer,
                                    Data_Out => Further);

   begin
      Random_Elements.Reset (Gen);

      Buffer := (others => 20);

      Main : loop
         for J in Buffer'Range loop
            Buffer (J) := Random_Elements.Random (Gen);

            Deflate_Init (Deflate);
            Inflate_Init (Inflate);

            Buffer_First  := Buffer'First;
            Compare_First := Buffer'First;

            Translate (Deflate);

            if Compare_First /= Buffer'Last + 1 then
               raise Program_Error;
            end if;

            Ada.Text_IO.Put_Line
              (Ada.Task_Identification.Image
                 (Ada.Task_Identification.Current_Task)
               & Stream_Element_Offset'Image (J)
               & ZLib.Count'Image (Total_Out (Deflate)));

            Close (Deflate);
            Close (Inflate);

            exit Main when Stop;
         end loop;
      end loop Main;
   exception
      when E : others =>
         Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
         Stop := True;
   end Test_Task;

   Test : array (1 .. 4) of Test_Task;

   pragma Unreferenced (Test);

   Dummy : Character;

begin
   Ada.Text_IO.Get_Immediate (Dummy);
   Stop := True;
end MTest;

Deleted compat/zlib/contrib/ada/read.adb.

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




























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: read.adb,v 1.8 2004/05/31 10:53:40 vagul Exp $

--  Test/demo program for the generic read interface.

with Ada.Numerics.Discrete_Random;
with Ada.Streams;
with Ada.Text_IO;

with ZLib;

procedure Read is

   use Ada.Streams;

   ------------------------------------
   --  Test configuration parameters --
   ------------------------------------

   File_Size   : Stream_Element_Offset := 100_000;

   Continuous  : constant Boolean          := False;
   --  If this constant is True, the test would be repeated again and again,
   --  with increment File_Size for every iteration.

   Header      : constant ZLib.Header_Type := ZLib.Default;
   --  Do not use Header other than Default in ZLib versions 1.1.4 and older.

   Init_Random : constant := 8;
   --  We are using the same random sequence, in case of we catch bug,
   --  so we would be able to reproduce it.

   -- End --

   Pack_Size : Stream_Element_Offset;
   Offset    : Stream_Element_Offset;

   Filter     : ZLib.Filter_Type;

   subtype Visible_Symbols
      is Stream_Element range 16#20# .. 16#7E#;

   package Random_Elements is new
      Ada.Numerics.Discrete_Random (Visible_Symbols);

   Gen : Random_Elements.Generator;
   Period  : constant Stream_Element_Offset := 200;
   --  Period constant variable for random generator not to be very random.
   --  Bigger period, harder random.

   Read_Buffer : Stream_Element_Array (1 .. 2048);
   Read_First  : Stream_Element_Offset;
   Read_Last   : Stream_Element_Offset;

   procedure Reset;

   procedure Read
     (Item : out Stream_Element_Array;
      Last : out Stream_Element_Offset);
   --  this procedure is for generic instantiation of
   --  ZLib.Read
   --  reading data from the File_In.

   procedure Read is new ZLib.Read
                           (Read,
                            Read_Buffer,
                            Rest_First => Read_First,
                            Rest_Last  => Read_Last);

   ----------
   -- Read --
   ----------

   procedure Read
     (Item : out Stream_Element_Array;
      Last : out Stream_Element_Offset) is
   begin
      Last := Stream_Element_Offset'Min
               (Item'Last,
                Item'First + File_Size - Offset);

      for J in Item'First .. Last loop
         if J < Item'First + Period then
            Item (J) := Random_Elements.Random (Gen);
         else
            Item (J) := Item (J - Period);
         end if;

         Offset   := Offset + 1;
      end loop;
   end Read;

   -----------
   -- Reset --
   -----------

   procedure Reset is
   begin
      Random_Elements.Reset (Gen, Init_Random);
      Pack_Size := 0;
      Offset := 1;
      Read_First := Read_Buffer'Last + 1;
      Read_Last  := Read_Buffer'Last;
   end Reset;

begin
   Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);

   loop
      for Level in ZLib.Compression_Level'Range loop

         Ada.Text_IO.Put ("Level ="
            & ZLib.Compression_Level'Image (Level));

         --  Deflate using generic instantiation.

         ZLib.Deflate_Init
               (Filter,
                Level,
                Header => Header);

         Reset;

         Ada.Text_IO.Put
           (Stream_Element_Offset'Image (File_Size) & " ->");

         loop
            declare
               Buffer : Stream_Element_Array (1 .. 1024);
               Last   : Stream_Element_Offset;
            begin
               Read (Filter, Buffer, Last);

               Pack_Size := Pack_Size + Last - Buffer'First + 1;

               exit when Last < Buffer'Last;
            end;
         end loop;

         Ada.Text_IO.Put_Line (Stream_Element_Offset'Image (Pack_Size));

         ZLib.Close (Filter);
      end loop;

      exit when not Continuous;

      File_Size := File_Size + 1;
   end loop;
end Read;

Deleted compat/zlib/contrib/ada/readme.txt.

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

































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
                        ZLib for Ada thick binding (ZLib.Ada)
                        Release 1.3

ZLib.Ada is a thick binding interface to the popular ZLib data
compression library, available at http://www.gzip.org/zlib/.
It provides Ada-style access to the ZLib C library.


        Here are the main changes since ZLib.Ada 1.2:

- Attension: ZLib.Read generic routine have a initialization requirement
  for Read_Last parameter now. It is a bit incompartible with previous version,
  but extends functionality, we could use new parameters Allow_Read_Some and
  Flush now.

- Added Is_Open routines to ZLib and ZLib.Streams packages.

- Add pragma Assert to check Stream_Element is 8 bit.

- Fix extraction to buffer with exact known decompressed size. Error reported by
  Steve Sangwine.

- Fix definition of ULong (changed to unsigned_long), fix regression on 64 bits
  computers. Patch provided by Pascal Obry.

- Add Status_Error exception definition.

- Add pragma Assertion that Ada.Streams.Stream_Element size is 8 bit.


        How to build ZLib.Ada under GNAT

You should have the ZLib library already build on your computer, before
building ZLib.Ada. Make the directory of ZLib.Ada sources current and
issue the command:

  gnatmake test -largs -L<directory where libz.a is> -lz

Or use the GNAT project file build for GNAT 3.15 or later:

  gnatmake -Pzlib.gpr -L<directory where libz.a is>


        How to build ZLib.Ada under Aonix ObjectAda for Win32 7.2.2

1. Make a project with all *.ads and *.adb files from the distribution.
2. Build the libz.a library from the ZLib C sources.
3. Rename libz.a to z.lib.
4. Add the library z.lib to the project.
5. Add the libc.lib library from the ObjectAda distribution to the project.
6. Build the executable using test.adb as a main procedure.


        How to use ZLib.Ada

The source files test.adb and read.adb are small demo programs that show
the main functionality of ZLib.Ada.

The routines from the package specifications are commented.


Homepage: http://zlib-ada.sourceforge.net/
Author: Dmitriy Anisimkov <anisimkov@yahoo.com>

Contributors: Pascal Obry <pascal@obry.org>, Steve Sangwine <sjs@essex.ac.uk>

Deleted compat/zlib/contrib/ada/test.adb.

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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: test.adb,v 1.17 2003/08/12 12:13:30 vagul Exp $

--  The program has a few aims.
--  1. Test ZLib.Ada95 thick binding functionality.
--  2. Show the example of use main functionality of the ZLib.Ada95 binding.
--  3. Build this program automatically compile all ZLib.Ada95 packages under
--     GNAT Ada95 compiler.

with ZLib.Streams;
with Ada.Streams.Stream_IO;
with Ada.Numerics.Discrete_Random;

with Ada.Text_IO;

with Ada.Calendar;

procedure Test is

   use Ada.Streams;
   use Stream_IO;

   ------------------------------------
   --  Test configuration parameters --
   ------------------------------------

   File_Size   : Count   := 100_000;
   Continuous  : constant Boolean := False;

   Header      : constant ZLib.Header_Type := ZLib.Default;
                                              --  ZLib.None;
                                              --  ZLib.Auto;
                                              --  ZLib.GZip;
   --  Do not use Header other then Default in ZLib versions 1.1.4
   --  and older.

   Strategy    : constant ZLib.Strategy_Type := ZLib.Default_Strategy;
   Init_Random : constant := 10;

   -- End --

   In_File_Name  : constant String := "testzlib.in";
   --  Name of the input file

   Z_File_Name   : constant String := "testzlib.zlb";
   --  Name of the compressed file.

   Out_File_Name : constant String := "testzlib.out";
   --  Name of the decompressed file.

   File_In   : File_Type;
   File_Out  : File_Type;
   File_Back : File_Type;
   File_Z    : ZLib.Streams.Stream_Type;

   Filter : ZLib.Filter_Type;

   Time_Stamp : Ada.Calendar.Time;

   procedure Generate_File;
   --  Generate file of spetsified size with some random data.
   --  The random data is repeatable, for the good compression.

   procedure Compare_Streams
     (Left, Right : in out Root_Stream_Type'Class);
   --  The procedure compearing data in 2 streams.
   --  It is for compare data before and after compression/decompression.

   procedure Compare_Files (Left, Right : String);
   --  Compare files. Based on the Compare_Streams.

   procedure Copy_Streams
     (Source, Target : in out Root_Stream_Type'Class;
      Buffer_Size    : in     Stream_Element_Offset := 1024);
   --  Copying data from one stream to another. It is for test stream
   --  interface of the library.

   procedure Data_In
     (Item : out Stream_Element_Array;
      Last : out Stream_Element_Offset);
   --  this procedure is for generic instantiation of
   --  ZLib.Generic_Translate.
   --  reading data from the File_In.

   procedure Data_Out (Item : in Stream_Element_Array);
   --  this procedure is for generic instantiation of
   --  ZLib.Generic_Translate.
   --  writing data to the File_Out.

   procedure Stamp;
   --  Store the timestamp to the local variable.

   procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count);
   --  Print the time statistic with the message.

   procedure Translate is new ZLib.Generic_Translate
                                (Data_In  => Data_In,
                                 Data_Out => Data_Out);
   --  This procedure is moving data from File_In to File_Out
   --  with compression or decompression, depend on initialization of
   --  Filter parameter.

   -------------------
   -- Compare_Files --
   -------------------

   procedure Compare_Files (Left, Right : String) is
      Left_File, Right_File : File_Type;
   begin
      Open (Left_File, In_File, Left);
      Open (Right_File, In_File, Right);
      Compare_Streams (Stream (Left_File).all, Stream (Right_File).all);
      Close (Left_File);
      Close (Right_File);
   end Compare_Files;

   ---------------------
   -- Compare_Streams --
   ---------------------

   procedure Compare_Streams
     (Left, Right : in out Ada.Streams.Root_Stream_Type'Class)
   is
      Left_Buffer, Right_Buffer : Stream_Element_Array (0 .. 16#FFF#);
      Left_Last, Right_Last : Stream_Element_Offset;
   begin
      loop
         Read (Left, Left_Buffer, Left_Last);
         Read (Right, Right_Buffer, Right_Last);

         if Left_Last /= Right_Last then
            Ada.Text_IO.Put_Line ("Compare error :"
              & Stream_Element_Offset'Image (Left_Last)
              & " /= "
              & Stream_Element_Offset'Image (Right_Last));

            raise Constraint_Error;

         elsif Left_Buffer (0 .. Left_Last)
               /= Right_Buffer (0 .. Right_Last)
         then
            Ada.Text_IO.Put_Line ("ERROR: IN and OUT files is not equal.");
            raise Constraint_Error;

         end if;

         exit when Left_Last < Left_Buffer'Last;
      end loop;
   end Compare_Streams;

   ------------------
   -- Copy_Streams --
   ------------------

   procedure Copy_Streams
     (Source, Target : in out Ada.Streams.Root_Stream_Type'Class;
      Buffer_Size    : in     Stream_Element_Offset := 1024)
   is
      Buffer : Stream_Element_Array (1 .. Buffer_Size);
      Last   : Stream_Element_Offset;
   begin
      loop
         Read  (Source, Buffer, Last);
         Write (Target, Buffer (1 .. Last));

         exit when Last < Buffer'Last;
      end loop;
   end Copy_Streams;

   -------------
   -- Data_In --
   -------------

   procedure Data_In
     (Item : out Stream_Element_Array;
      Last : out Stream_Element_Offset) is
   begin
      Read (File_In, Item, Last);
   end Data_In;

   --------------
   -- Data_Out --
   --------------

   procedure Data_Out (Item : in Stream_Element_Array) is
   begin
      Write (File_Out, Item);
   end Data_Out;

   -------------------
   -- Generate_File --
   -------------------

   procedure Generate_File is
      subtype Visible_Symbols is Stream_Element range 16#20# .. 16#7E#;

      package Random_Elements is
         new Ada.Numerics.Discrete_Random (Visible_Symbols);

      Gen    : Random_Elements.Generator;
      Buffer : Stream_Element_Array := (1 .. 77 => 16#20#) & 10;

      Buffer_Count : constant Count := File_Size / Buffer'Length;
      --  Number of same buffers in the packet.

      Density : constant Count := 30; --  from 0 to Buffer'Length - 2;

      procedure Fill_Buffer (J, D : in Count);
      --  Change the part of the buffer.

      -----------------
      -- Fill_Buffer --
      -----------------

      procedure Fill_Buffer (J, D : in Count) is
      begin
         for K in 0 .. D loop
            Buffer
              (Stream_Element_Offset ((J + K) mod (Buffer'Length - 1) + 1))
             := Random_Elements.Random (Gen);

         end loop;
      end Fill_Buffer;

   begin
      Random_Elements.Reset (Gen, Init_Random);

      Create (File_In, Out_File, In_File_Name);

      Fill_Buffer (1, Buffer'Length - 2);

      for J in 1 .. Buffer_Count loop
         Write (File_In, Buffer);

         Fill_Buffer (J, Density);
      end loop;

      --  fill remain size.

      Write
        (File_In,
         Buffer
           (1 .. Stream_Element_Offset
                   (File_Size - Buffer'Length * Buffer_Count)));

      Flush (File_In);
      Close (File_In);
   end Generate_File;

   ---------------------
   -- Print_Statistic --
   ---------------------

   procedure Print_Statistic (Msg : String; Data_Size : ZLib.Count) is
      use Ada.Calendar;
      use Ada.Text_IO;

      package Count_IO is new Integer_IO (ZLib.Count);

      Curr_Dur : Duration := Clock - Time_Stamp;
   begin
      Put (Msg);

      Set_Col (20);
      Ada.Text_IO.Put ("size =");

      Count_IO.Put
        (Data_Size,
         Width => Stream_IO.Count'Image (File_Size)'Length);

      Put_Line (" duration =" & Duration'Image (Curr_Dur));
   end Print_Statistic;

   -----------
   -- Stamp --
   -----------

   procedure Stamp is
   begin
      Time_Stamp := Ada.Calendar.Clock;
   end Stamp;

begin
   Ada.Text_IO.Put_Line ("ZLib " & ZLib.Version);

   loop
      Generate_File;

      for Level in ZLib.Compression_Level'Range loop

         Ada.Text_IO.Put_Line ("Level ="
            & ZLib.Compression_Level'Image (Level));

         --  Test generic interface.
         Open   (File_In, In_File, In_File_Name);
         Create (File_Out, Out_File, Z_File_Name);

         Stamp;

         --  Deflate using generic instantiation.

         ZLib.Deflate_Init
               (Filter   => Filter,
                Level    => Level,
                Strategy => Strategy,
                Header   => Header);

         Translate (Filter);
         Print_Statistic ("Generic compress", ZLib.Total_Out (Filter));
         ZLib.Close (Filter);

         Close (File_In);
         Close (File_Out);

         Open   (File_In, In_File, Z_File_Name);
         Create (File_Out, Out_File, Out_File_Name);

         Stamp;

         --  Inflate using generic instantiation.

         ZLib.Inflate_Init (Filter, Header => Header);

         Translate (Filter);
         Print_Statistic ("Generic decompress", ZLib.Total_Out (Filter));

         ZLib.Close (Filter);

         Close (File_In);
         Close (File_Out);

         Compare_Files (In_File_Name, Out_File_Name);

         --  Test stream interface.

         --  Compress to the back stream.

         Open   (File_In, In_File, In_File_Name);
         Create (File_Back, Out_File, Z_File_Name);

         Stamp;

         ZLib.Streams.Create
           (Stream          => File_Z,
            Mode            => ZLib.Streams.Out_Stream,
            Back            => ZLib.Streams.Stream_Access
                                 (Stream (File_Back)),
            Back_Compressed => True,
            Level           => Level,
            Strategy        => Strategy,
            Header          => Header);

         Copy_Streams
           (Source => Stream (File_In).all,
            Target => File_Z);

         --  Flushing internal buffers to the back stream.

         ZLib.Streams.Flush (File_Z, ZLib.Finish);

         Print_Statistic ("Write compress",
                          ZLib.Streams.Write_Total_Out (File_Z));

         ZLib.Streams.Close (File_Z);

         Close (File_In);
         Close (File_Back);

         --  Compare reading from original file and from
         --  decompression stream.

         Open (File_In,   In_File, In_File_Name);
         Open (File_Back, In_File, Z_File_Name);

         ZLib.Streams.Create
           (Stream          => File_Z,
            Mode            => ZLib.Streams.In_Stream,
            Back            => ZLib.Streams.Stream_Access
                                 (Stream (File_Back)),
            Back_Compressed => True,
            Header          => Header);

         Stamp;
         Compare_Streams (Stream (File_In).all, File_Z);

         Print_Statistic ("Read decompress",
                          ZLib.Streams.Read_Total_Out (File_Z));

         ZLib.Streams.Close (File_Z);
         Close (File_In);
         Close (File_Back);

         --  Compress by reading from compression stream.

         Open (File_Back, In_File, In_File_Name);
         Create (File_Out, Out_File, Z_File_Name);

         ZLib.Streams.Create
           (Stream          => File_Z,
            Mode            => ZLib.Streams.In_Stream,
            Back            => ZLib.Streams.Stream_Access
                                 (Stream (File_Back)),
            Back_Compressed => False,
            Level           => Level,
            Strategy        => Strategy,
            Header          => Header);

         Stamp;
         Copy_Streams
           (Source => File_Z,
            Target => Stream (File_Out).all);

         Print_Statistic ("Read compress",
                          ZLib.Streams.Read_Total_Out (File_Z));

         ZLib.Streams.Close (File_Z);

         Close (File_Out);
         Close (File_Back);

         --  Decompress to decompression stream.

         Open   (File_In,   In_File, Z_File_Name);
         Create (File_Back, Out_File, Out_File_Name);

         ZLib.Streams.Create
           (Stream          => File_Z,
            Mode            => ZLib.Streams.Out_Stream,
            Back            => ZLib.Streams.Stream_Access
                                 (Stream (File_Back)),
            Back_Compressed => False,
            Header          => Header);

         Stamp;

         Copy_Streams
           (Source => Stream (File_In).all,
            Target => File_Z);

         Print_Statistic ("Write decompress",
                          ZLib.Streams.Write_Total_Out (File_Z));

         ZLib.Streams.Close (File_Z);
         Close (File_In);
         Close (File_Back);

         Compare_Files (In_File_Name, Out_File_Name);
      end loop;

      Ada.Text_IO.Put_Line (Count'Image (File_Size) & " Ok.");

      exit when not Continuous;

      File_Size := File_Size + 1;
   end loop;
end Test;

Deleted compat/zlib/contrib/ada/zlib-streams.adb.

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

































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: zlib-streams.adb,v 1.10 2004/05/31 10:53:40 vagul Exp $

with Ada.Unchecked_Deallocation;

package body ZLib.Streams is

   -----------
   -- Close --
   -----------

   procedure Close (Stream : in out Stream_Type) is
      procedure Free is new Ada.Unchecked_Deallocation
         (Stream_Element_Array, Buffer_Access);
   begin
      if Stream.Mode = Out_Stream or Stream.Mode = Duplex then
         --  We should flush the data written by the writer.

         Flush (Stream, Finish);

         Close (Stream.Writer);
      end if;

      if Stream.Mode = In_Stream or Stream.Mode = Duplex then
         Close (Stream.Reader);
         Free (Stream.Buffer);
      end if;
   end Close;

   ------------
   -- Create --
   ------------

   procedure Create
     (Stream            :    out Stream_Type;
      Mode              : in     Stream_Mode;
      Back              : in     Stream_Access;
      Back_Compressed   : in     Boolean;
      Level             : in     Compression_Level := Default_Compression;
      Strategy          : in     Strategy_Type     := Default_Strategy;
      Header            : in     Header_Type       := Default;
      Read_Buffer_Size  : in     Ada.Streams.Stream_Element_Offset
                                    := Default_Buffer_Size;
      Write_Buffer_Size : in     Ada.Streams.Stream_Element_Offset
                                    := Default_Buffer_Size)
   is

      subtype Buffer_Subtype is Stream_Element_Array (1 .. Read_Buffer_Size);

      procedure Init_Filter
         (Filter   : in out Filter_Type;
          Compress : in     Boolean);

      -----------------
      -- Init_Filter --
      -----------------

      procedure Init_Filter
         (Filter   : in out Filter_Type;
          Compress : in     Boolean) is
      begin
         if Compress then
            Deflate_Init
              (Filter, Level, Strategy, Header => Header);
         else
            Inflate_Init (Filter, Header => Header);
         end if;
      end Init_Filter;

   begin
      Stream.Back := Back;
      Stream.Mode := Mode;

      if Mode = Out_Stream or Mode = Duplex then
         Init_Filter (Stream.Writer, Back_Compressed);
         Stream.Buffer_Size := Write_Buffer_Size;
      else
         Stream.Buffer_Size := 0;
      end if;

      if Mode = In_Stream or Mode = Duplex then
         Init_Filter (Stream.Reader, not Back_Compressed);

         Stream.Buffer     := new Buffer_Subtype;
         Stream.Rest_First := Stream.Buffer'Last + 1;
         Stream.Rest_Last  := Stream.Buffer'Last;
      end if;
   end Create;

   -----------
   -- Flush --
   -----------

   procedure Flush
     (Stream : in out Stream_Type;
      Mode   : in     Flush_Mode := Sync_Flush)
   is
      Buffer : Stream_Element_Array (1 .. Stream.Buffer_Size);
      Last   : Stream_Element_Offset;
   begin
      loop
         Flush (Stream.Writer, Buffer, Last, Mode);

         Ada.Streams.Write (Stream.Back.all, Buffer (1 .. Last));

         exit when Last < Buffer'Last;
      end loop;
   end Flush;

   -------------
   -- Is_Open --
   -------------

   function Is_Open (Stream : Stream_Type) return Boolean is
   begin
      return Is_Open (Stream.Reader) or else Is_Open (Stream.Writer);
   end Is_Open;

   ----------
   -- Read --
   ----------

   procedure Read
     (Stream : in out Stream_Type;
      Item   :    out Stream_Element_Array;
      Last   :    out Stream_Element_Offset)
   is

      procedure Read
        (Item : out Stream_Element_Array;
         Last : out Stream_Element_Offset);

      ----------
      -- Read --
      ----------

      procedure Read
        (Item : out Stream_Element_Array;
         Last : out Stream_Element_Offset) is
      begin
         Ada.Streams.Read (Stream.Back.all, Item, Last);
      end Read;

      procedure Read is new ZLib.Read
         (Read       => Read,
          Buffer     => Stream.Buffer.all,
          Rest_First => Stream.Rest_First,
          Rest_Last  => Stream.Rest_Last);

   begin
      Read (Stream.Reader, Item, Last);
   end Read;

   -------------------
   -- Read_Total_In --
   -------------------

   function Read_Total_In (Stream : in Stream_Type) return Count is
   begin
      return Total_In (Stream.Reader);
   end Read_Total_In;

   --------------------
   -- Read_Total_Out --
   --------------------

   function Read_Total_Out (Stream : in Stream_Type) return Count is
   begin
      return Total_Out (Stream.Reader);
   end Read_Total_Out;

   -----------
   -- Write --
   -----------

   procedure Write
     (Stream : in out Stream_Type;
      Item   : in     Stream_Element_Array)
   is

      procedure Write (Item : in Stream_Element_Array);

      -----------
      -- Write --
      -----------

      procedure Write (Item : in Stream_Element_Array) is
      begin
         Ada.Streams.Write (Stream.Back.all, Item);
      end Write;

      procedure Write is new ZLib.Write
         (Write       => Write,
          Buffer_Size => Stream.Buffer_Size);

   begin
      Write (Stream.Writer, Item, No_Flush);
   end Write;

   --------------------
   -- Write_Total_In --
   --------------------

   function Write_Total_In (Stream : in Stream_Type) return Count is
   begin
      return Total_In (Stream.Writer);
   end Write_Total_In;

   ---------------------
   -- Write_Total_Out --
   ---------------------

   function Write_Total_Out (Stream : in Stream_Type) return Count is
   begin
      return Total_Out (Stream.Writer);
   end Write_Total_Out;

end ZLib.Streams;

Deleted compat/zlib/contrib/ada/zlib-streams.ads.

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


















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: zlib-streams.ads,v 1.12 2004/05/31 10:53:40 vagul Exp $

package ZLib.Streams is

   type Stream_Mode is (In_Stream, Out_Stream, Duplex);

   type Stream_Access is access all Ada.Streams.Root_Stream_Type'Class;

   type Stream_Type is
      new Ada.Streams.Root_Stream_Type with private;

   procedure Read
     (Stream : in out Stream_Type;
      Item   :    out Ada.Streams.Stream_Element_Array;
      Last   :    out Ada.Streams.Stream_Element_Offset);

   procedure Write
     (Stream : in out Stream_Type;
      Item   : in     Ada.Streams.Stream_Element_Array);

   procedure Flush
     (Stream : in out Stream_Type;
      Mode   : in     Flush_Mode := Sync_Flush);
   --  Flush the written data to the back stream,
   --  all data placed to the compressor is flushing to the Back stream.
   --  Should not be used until necessary, because it is decreasing
   --  compression.

   function Read_Total_In (Stream : in Stream_Type) return Count;
   pragma Inline (Read_Total_In);
   --  Return total number of bytes read from back stream so far.

   function Read_Total_Out (Stream : in Stream_Type) return Count;
   pragma Inline (Read_Total_Out);
   --  Return total number of bytes read so far.

   function Write_Total_In (Stream : in Stream_Type) return Count;
   pragma Inline (Write_Total_In);
   --  Return total number of bytes written so far.

   function Write_Total_Out (Stream : in Stream_Type) return Count;
   pragma Inline (Write_Total_Out);
   --  Return total number of bytes written to the back stream.

   procedure Create
     (Stream            :    out Stream_Type;
      Mode              : in     Stream_Mode;
      Back              : in     Stream_Access;
      Back_Compressed   : in     Boolean;
      Level             : in     Compression_Level := Default_Compression;
      Strategy          : in     Strategy_Type     := Default_Strategy;
      Header            : in     Header_Type       := Default;
      Read_Buffer_Size  : in     Ada.Streams.Stream_Element_Offset
                                    := Default_Buffer_Size;
      Write_Buffer_Size : in     Ada.Streams.Stream_Element_Offset
                                    := Default_Buffer_Size);
   --  Create the Comression/Decompression stream.
   --  If mode is In_Stream then Write operation is disabled.
   --  If mode is Out_Stream then Read operation is disabled.

   --  If Back_Compressed is true then
   --  Data written to the Stream is compressing to the Back stream
   --  and data read from the Stream is decompressed data from the Back stream.

   --  If Back_Compressed is false then
   --  Data written to the Stream is decompressing to the Back stream
   --  and data read from the Stream is compressed data from the Back stream.

   --  !!! When the Need_Header is False ZLib-Ada is using undocumented
   --  ZLib 1.1.4 functionality to do not create/wait for ZLib headers.

   function Is_Open (Stream : Stream_Type) return Boolean;

   procedure Close (Stream : in out Stream_Type);

private

   use Ada.Streams;

   type Buffer_Access is access all Stream_Element_Array;

   type Stream_Type
     is new Root_Stream_Type with
   record
      Mode       : Stream_Mode;

      Buffer     : Buffer_Access;
      Rest_First : Stream_Element_Offset;
      Rest_Last  : Stream_Element_Offset;
      --  Buffer for Read operation.
      --  We need to have this buffer in the record
      --  because not all read data from back stream
      --  could be processed during the read operation.

      Buffer_Size : Stream_Element_Offset;
      --  Buffer size for write operation.
      --  We do not need to have this buffer
      --  in the record because all data could be
      --  processed in the write operation.

      Back       : Stream_Access;
      Reader     : Filter_Type;
      Writer     : Filter_Type;
   end record;

end ZLib.Streams;

Deleted compat/zlib/contrib/ada/zlib-thin.adb.

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













































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: zlib-thin.adb,v 1.8 2003/12/14 18:27:31 vagul Exp $

package body ZLib.Thin is

   ZLIB_VERSION  : constant Chars_Ptr := zlibVersion;

   Z_Stream_Size : constant Int := Z_Stream'Size / System.Storage_Unit;

   --------------
   -- Avail_In --
   --------------

   function Avail_In (Strm : in Z_Stream) return UInt is
   begin
      return Strm.Avail_In;
   end Avail_In;

   ---------------
   -- Avail_Out --
   ---------------

   function Avail_Out (Strm : in Z_Stream) return UInt is
   begin
      return Strm.Avail_Out;
   end Avail_Out;

   ------------------
   -- Deflate_Init --
   ------------------

   function Deflate_Init
     (strm       : Z_Streamp;
      level      : Int;
      method     : Int;
      windowBits : Int;
      memLevel   : Int;
      strategy   : Int)
      return       Int is
   begin
      return deflateInit2
               (strm,
                level,
                method,
                windowBits,
                memLevel,
                strategy,
                ZLIB_VERSION,
                Z_Stream_Size);
   end Deflate_Init;

   ------------------
   -- Inflate_Init --
   ------------------

   function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int is
   begin
      return inflateInit2 (strm, windowBits, ZLIB_VERSION, Z_Stream_Size);
   end Inflate_Init;

   ------------------------
   -- Last_Error_Message --
   ------------------------

   function Last_Error_Message (Strm : in Z_Stream) return String is
      use Interfaces.C.Strings;
   begin
      if Strm.msg = Null_Ptr then
         return "";
      else
         return Value (Strm.msg);
      end if;
   end Last_Error_Message;

   ------------
   -- Set_In --
   ------------

   procedure Set_In
     (Strm   : in out Z_Stream;
      Buffer : in     Voidp;
      Size   : in     UInt) is
   begin
      Strm.Next_In  := Buffer;
      Strm.Avail_In := Size;
   end Set_In;

   ------------------
   -- Set_Mem_Func --
   ------------------

   procedure Set_Mem_Func
     (Strm   : in out Z_Stream;
      Opaque : in     Voidp;
      Alloc  : in     alloc_func;
      Free   : in     free_func) is
   begin
      Strm.opaque := Opaque;
      Strm.zalloc := Alloc;
      Strm.zfree  := Free;
   end Set_Mem_Func;

   -------------
   -- Set_Out --
   -------------

   procedure Set_Out
     (Strm   : in out Z_Stream;
      Buffer : in     Voidp;
      Size   : in     UInt) is
   begin
      Strm.Next_Out  := Buffer;
      Strm.Avail_Out := Size;
   end Set_Out;

   --------------
   -- Total_In --
   --------------

   function Total_In (Strm : in Z_Stream) return ULong is
   begin
      return Strm.Total_In;
   end Total_In;

   ---------------
   -- Total_Out --
   ---------------

   function Total_Out (Strm : in Z_Stream) return ULong is
   begin
      return Strm.Total_Out;
   end Total_Out;

end ZLib.Thin;

Deleted compat/zlib/contrib/ada/zlib-thin.ads.

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
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
450


































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2003 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: zlib-thin.ads,v 1.11 2004/07/23 06:33:11 vagul Exp $

with Interfaces.C.Strings;

with System;

private package ZLib.Thin is

   --  From zconf.h

   MAX_MEM_LEVEL : constant := 9;         --  zconf.h:105
                                          --  zconf.h:105
   MAX_WBITS : constant := 15;      --  zconf.h:115
                                    --  32K LZ77 window
                                    --  zconf.h:115
   SEEK_SET : constant := 8#0000#;  --  zconf.h:244
                                    --  Seek from beginning of file.
                                    --  zconf.h:244
   SEEK_CUR : constant := 1;        --  zconf.h:245
                                    --  Seek from current position.
                                    --  zconf.h:245
   SEEK_END : constant := 2;        --  zconf.h:246
                                    --  Set file pointer to EOF plus "offset"
                                    --  zconf.h:246

   type Byte is new Interfaces.C.unsigned_char; --  8 bits
                                                --  zconf.h:214
   type UInt is new Interfaces.C.unsigned;      --  16 bits or more
                                                --  zconf.h:216
   type Int is new Interfaces.C.int;

   type ULong is new Interfaces.C.unsigned_long;     --  32 bits or more
                                                     --  zconf.h:217
   subtype Chars_Ptr is Interfaces.C.Strings.chars_ptr;

   type ULong_Access is access ULong;
   type Int_Access is access Int;

   subtype Voidp is System.Address;            --  zconf.h:232

   subtype Byte_Access is Voidp;

   Nul : constant Voidp := System.Null_Address;
   --  end from zconf

   Z_NO_FLUSH : constant := 8#0000#;   --  zlib.h:125
                                       --  zlib.h:125
   Z_PARTIAL_FLUSH : constant := 1;       --  zlib.h:126
                                          --  will be removed, use
                                          --  Z_SYNC_FLUSH instead
                                          --  zlib.h:126
   Z_SYNC_FLUSH : constant := 2;       --  zlib.h:127
                                       --  zlib.h:127
   Z_FULL_FLUSH : constant := 3;       --  zlib.h:128
                                       --  zlib.h:128
   Z_FINISH : constant := 4;        --  zlib.h:129
                                    --  zlib.h:129
   Z_OK : constant := 8#0000#;   --  zlib.h:132
                                 --  zlib.h:132
   Z_STREAM_END : constant := 1;       --  zlib.h:133
                                       --  zlib.h:133
   Z_NEED_DICT : constant := 2;        --  zlib.h:134
                                       --  zlib.h:134
   Z_ERRNO : constant := -1;        --  zlib.h:135
                                    --  zlib.h:135
   Z_STREAM_ERROR : constant := -2;       --  zlib.h:136
                                          --  zlib.h:136
   Z_DATA_ERROR : constant := -3;      --  zlib.h:137
                                       --  zlib.h:137
   Z_MEM_ERROR : constant := -4;       --  zlib.h:138
                                       --  zlib.h:138
   Z_BUF_ERROR : constant := -5;       --  zlib.h:139
                                       --  zlib.h:139
   Z_VERSION_ERROR : constant := -6;      --  zlib.h:140
                                          --  zlib.h:140
   Z_NO_COMPRESSION : constant := 8#0000#;   --  zlib.h:145
                                             --  zlib.h:145
   Z_BEST_SPEED : constant := 1;       --  zlib.h:146
                                       --  zlib.h:146
   Z_BEST_COMPRESSION : constant := 9;       --  zlib.h:147
                                             --  zlib.h:147
   Z_DEFAULT_COMPRESSION : constant := -1;      --  zlib.h:148
                                                --  zlib.h:148
   Z_FILTERED : constant := 1;      --  zlib.h:151
                                    --  zlib.h:151
   Z_HUFFMAN_ONLY : constant := 2;        --  zlib.h:152
                                          --  zlib.h:152
   Z_DEFAULT_STRATEGY : constant := 8#0000#; --  zlib.h:153
                                             --  zlib.h:153
   Z_BINARY : constant := 8#0000#;  --  zlib.h:156
                                    --  zlib.h:156
   Z_ASCII : constant := 1;      --  zlib.h:157
                                 --  zlib.h:157
   Z_UNKNOWN : constant := 2;       --  zlib.h:158
                                    --  zlib.h:158
   Z_DEFLATED : constant := 8;      --  zlib.h:161
                                    --  zlib.h:161
   Z_NULL : constant := 8#0000#; --  zlib.h:164
                                 --  for initializing zalloc, zfree, opaque
                                 --  zlib.h:164
   type gzFile is new Voidp;                  --  zlib.h:646

   type Z_Stream is private;

   type Z_Streamp is access all Z_Stream;     --  zlib.h:89

   type alloc_func is access function
     (Opaque : Voidp;
      Items  : UInt;
      Size   : UInt)
      return Voidp; --  zlib.h:63

   type free_func is access procedure (opaque : Voidp; address : Voidp);

   function zlibVersion return Chars_Ptr;

   function Deflate (strm : Z_Streamp; flush : Int) return Int;

   function DeflateEnd (strm : Z_Streamp) return Int;

   function Inflate (strm : Z_Streamp; flush : Int) return Int;

   function InflateEnd (strm : Z_Streamp) return Int;

   function deflateSetDictionary
     (strm       : Z_Streamp;
      dictionary : Byte_Access;
      dictLength : UInt)
      return       Int;

   function deflateCopy (dest : Z_Streamp; source : Z_Streamp) return Int;
   --  zlib.h:478

   function deflateReset (strm : Z_Streamp) return Int; -- zlib.h:495

   function deflateParams
     (strm     : Z_Streamp;
      level    : Int;
      strategy : Int)
      return     Int;       -- zlib.h:506

   function inflateSetDictionary
     (strm       : Z_Streamp;
      dictionary : Byte_Access;
      dictLength : UInt)
      return       Int; --  zlib.h:548

   function inflateSync (strm : Z_Streamp) return Int;  --  zlib.h:565

   function inflateReset (strm : Z_Streamp) return Int; --  zlib.h:580

   function compress
     (dest      : Byte_Access;
      destLen   : ULong_Access;
      source    : Byte_Access;
      sourceLen : ULong)
      return      Int;           -- zlib.h:601

   function compress2
     (dest      : Byte_Access;
      destLen   : ULong_Access;
      source    : Byte_Access;
      sourceLen : ULong;
      level     : Int)
      return      Int;          -- zlib.h:615

   function uncompress
     (dest      : Byte_Access;
      destLen   : ULong_Access;
      source    : Byte_Access;
      sourceLen : ULong)
      return      Int;

   function gzopen (path : Chars_Ptr; mode : Chars_Ptr) return gzFile;

   function gzdopen (fd : Int; mode : Chars_Ptr) return gzFile;

   function gzsetparams
     (file     : gzFile;
      level    : Int;
      strategy : Int)
      return     Int;

   function gzread
     (file : gzFile;
      buf  : Voidp;
      len  : UInt)
      return Int;

   function gzwrite
     (file : in gzFile;
      buf  : in Voidp;
      len  : in UInt)
      return Int;

   function gzprintf (file : in gzFile; format : in Chars_Ptr) return Int;

   function gzputs (file : in gzFile; s : in Chars_Ptr) return Int;

   function gzgets
     (file : gzFile;
      buf  : Chars_Ptr;
      len  : Int)
      return Chars_Ptr;

   function gzputc (file : gzFile; char : Int) return Int;

   function gzgetc (file : gzFile) return Int;

   function gzflush (file : gzFile; flush : Int) return Int;

   function gzseek
     (file   : gzFile;
      offset : Int;
      whence : Int)
      return   Int;

   function gzrewind (file : gzFile) return Int;

   function gztell (file : gzFile) return Int;

   function gzeof (file : gzFile) return Int;

   function gzclose (file : gzFile) return Int;

   function gzerror (file : gzFile; errnum : Int_Access) return Chars_Ptr;

   function adler32
     (adler : ULong;
      buf   : Byte_Access;
      len   : UInt)
      return  ULong;

   function crc32
     (crc  : ULong;
      buf  : Byte_Access;
      len  : UInt)
      return ULong;

   function deflateInit
     (strm        : Z_Streamp;
      level       : Int;
      version     : Chars_Ptr;
      stream_size : Int)
      return        Int;

   function deflateInit2
     (strm        : Z_Streamp;
      level       : Int;
      method      : Int;
      windowBits  : Int;
      memLevel    : Int;
      strategy    : Int;
      version     : Chars_Ptr;
      stream_size : Int)
      return        Int;

   function Deflate_Init
     (strm       : Z_Streamp;
      level      : Int;
      method     : Int;
      windowBits : Int;
      memLevel   : Int;
      strategy   : Int)
      return       Int;
   pragma Inline (Deflate_Init);

   function inflateInit
     (strm        : Z_Streamp;
      version     : Chars_Ptr;
      stream_size : Int)
      return        Int;

   function inflateInit2
     (strm        : in Z_Streamp;
      windowBits  : in Int;
      version     : in Chars_Ptr;
      stream_size : in Int)
      return      Int;

   function inflateBackInit
     (strm        : in Z_Streamp;
      windowBits  : in Int;
      window      : in Byte_Access;
      version     : in Chars_Ptr;
      stream_size : in Int)
      return      Int;
   --  Size of window have to be 2**windowBits.

   function Inflate_Init (strm : Z_Streamp; windowBits : Int) return Int;
   pragma Inline (Inflate_Init);

   function zError (err : Int) return Chars_Ptr;

   function inflateSyncPoint (z : Z_Streamp) return Int;

   function get_crc_table return ULong_Access;

   --  Interface to the available fields of the z_stream structure.
   --  The application must update next_in and avail_in when avail_in has
   --  dropped to zero. It must update next_out and avail_out when avail_out
   --  has dropped to zero. The application must initialize zalloc, zfree and
   --  opaque before calling the init function.

   procedure Set_In
     (Strm   : in out Z_Stream;
      Buffer : in Voidp;
      Size   : in UInt);
   pragma Inline (Set_In);

   procedure Set_Out
     (Strm   : in out Z_Stream;
      Buffer : in Voidp;
      Size   : in UInt);
   pragma Inline (Set_Out);

   procedure Set_Mem_Func
     (Strm   : in out Z_Stream;
      Opaque : in Voidp;
      Alloc  : in alloc_func;
      Free   : in free_func);
   pragma Inline (Set_Mem_Func);

   function Last_Error_Message (Strm : in Z_Stream) return String;
   pragma Inline (Last_Error_Message);

   function Avail_Out (Strm : in Z_Stream) return UInt;
   pragma Inline (Avail_Out);

   function Avail_In (Strm : in Z_Stream) return UInt;
   pragma Inline (Avail_In);

   function Total_In (Strm : in Z_Stream) return ULong;
   pragma Inline (Total_In);

   function Total_Out (Strm : in Z_Stream) return ULong;
   pragma Inline (Total_Out);

   function inflateCopy
     (dest   : in Z_Streamp;
      Source : in Z_Streamp)
      return Int;

   function compressBound (Source_Len : in ULong) return ULong;

   function deflateBound
     (Strm       : in Z_Streamp;
      Source_Len : in ULong)
      return     ULong;

   function gzungetc (C : in Int; File : in  gzFile) return Int;

   function zlibCompileFlags return ULong;

private

   type Z_Stream is record            -- zlib.h:68
      Next_In   : Voidp      := Nul;  -- next input byte
      Avail_In  : UInt       := 0;    -- number of bytes available at next_in
      Total_In  : ULong      := 0;    -- total nb of input bytes read so far
      Next_Out  : Voidp      := Nul;  -- next output byte should be put there
      Avail_Out : UInt       := 0;    -- remaining free space at next_out
      Total_Out : ULong      := 0;    -- total nb of bytes output so far
      msg       : Chars_Ptr;          -- last error message, NULL if no error
      state     : Voidp;              -- not visible by applications
      zalloc    : alloc_func := null; -- used to allocate the internal state
      zfree     : free_func  := null; -- used to free the internal state
      opaque    : Voidp;              -- private data object passed to
                                      --  zalloc and zfree
      data_type : Int;                -- best guess about the data type:
                                      --  ascii or binary
      adler     : ULong;              -- adler32 value of the uncompressed
                                      --  data
      reserved  : ULong;              -- reserved for future use
   end record;

   pragma Convention (C, Z_Stream);

   pragma Import (C, zlibVersion, "zlibVersion");
   pragma Import (C, Deflate, "deflate");
   pragma Import (C, DeflateEnd, "deflateEnd");
   pragma Import (C, Inflate, "inflate");
   pragma Import (C, InflateEnd, "inflateEnd");
   pragma Import (C, deflateSetDictionary, "deflateSetDictionary");
   pragma Import (C, deflateCopy, "deflateCopy");
   pragma Import (C, deflateReset, "deflateReset");
   pragma Import (C, deflateParams, "deflateParams");
   pragma Import (C, inflateSetDictionary, "inflateSetDictionary");
   pragma Import (C, inflateSync, "inflateSync");
   pragma Import (C, inflateReset, "inflateReset");
   pragma Import (C, compress, "compress");
   pragma Import (C, compress2, "compress2");
   pragma Import (C, uncompress, "uncompress");
   pragma Import (C, gzopen, "gzopen");
   pragma Import (C, gzdopen, "gzdopen");
   pragma Import (C, gzsetparams, "gzsetparams");
   pragma Import (C, gzread, "gzread");
   pragma Import (C, gzwrite, "gzwrite");
   pragma Import (C, gzprintf, "gzprintf");
   pragma Import (C, gzputs, "gzputs");
   pragma Import (C, gzgets, "gzgets");
   pragma Import (C, gzputc, "gzputc");
   pragma Import (C, gzgetc, "gzgetc");
   pragma Import (C, gzflush, "gzflush");
   pragma Import (C, gzseek, "gzseek");
   pragma Import (C, gzrewind, "gzrewind");
   pragma Import (C, gztell, "gztell");
   pragma Import (C, gzeof, "gzeof");
   pragma Import (C, gzclose, "gzclose");
   pragma Import (C, gzerror, "gzerror");
   pragma Import (C, adler32, "adler32");
   pragma Import (C, crc32, "crc32");
   pragma Import (C, deflateInit, "deflateInit_");
   pragma Import (C, inflateInit, "inflateInit_");
   pragma Import (C, deflateInit2, "deflateInit2_");
   pragma Import (C, inflateInit2, "inflateInit2_");
   pragma Import (C, zError, "zError");
   pragma Import (C, inflateSyncPoint, "inflateSyncPoint");
   pragma Import (C, get_crc_table, "get_crc_table");

   --  since zlib 1.2.0:

   pragma Import (C, inflateCopy, "inflateCopy");
   pragma Import (C, compressBound, "compressBound");
   pragma Import (C, deflateBound, "deflateBound");
   pragma Import (C, gzungetc, "gzungetc");
   pragma Import (C, zlibCompileFlags, "zlibCompileFlags");

   pragma Import (C, inflateBackInit, "inflateBackInit_");

   --  I stopped binding the inflateBack routines, because realize that
   --  it does not support zlib and gzip headers for now, and have no
   --  symmetric deflateBack routines.
   --  ZLib-Ada is symmetric regarding deflate/inflate data transformation
   --  and has a similar generic callback interface for the
   --  deflate/inflate transformation based on the regular Deflate/Inflate
   --  routines.

   --  pragma Import (C, inflateBack, "inflateBack");
   --  pragma Import (C, inflateBackEnd, "inflateBackEnd");

end ZLib.Thin;

Deleted compat/zlib/contrib/ada/zlib.adb.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701





























































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
----------------------------------------------------------------
--  ZLib for Ada thick binding.                               --
--                                                            --
--  Copyright (C) 2002-2004 Dmitriy Anisimkov                 --
--                                                            --
--  Open source license information is in the zlib.ads file.  --
----------------------------------------------------------------

--  $Id: zlib.adb,v 1.31 2004/09/06 06:53:19 vagul Exp $

with Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;

with Interfaces.C.Strings;

with ZLib.Thin;

package body ZLib is

   use type Thin.Int;

   type Z_Stream is new Thin.Z_Stream;

   type Return_Code_Enum is
      (OK,
       STREAM_END,
       NEED_DICT,
       ERRNO,
       STREAM_ERROR,
       DATA_ERROR,
       MEM_ERROR,
       BUF_ERROR,
       VERSION_ERROR);

   type Flate_Step_Function is access
     function (Strm : in Thin.Z_Streamp; Flush : in Thin.Int) return Thin.Int;
   pragma Convention (C, Flate_Step_Function);

   type Flate_End_Function is access
      function (Ctrm : in Thin.Z_Streamp) return Thin.Int;
   pragma Convention (C, Flate_End_Function);

   type Flate_Type is record
      Step : Flate_Step_Function;
      Done : Flate_End_Function;
   end record;

   subtype Footer_Array is Stream_Element_Array (1 .. 8);

   Simple_GZip_Header : constant Stream_Element_Array (1 .. 10)
     := (16#1f#, 16#8b#,                 --  Magic header
         16#08#,                         --  Z_DEFLATED
         16#00#,                         --  Flags
         16#00#, 16#00#, 16#00#, 16#00#, --  Time
         16#00#,                         --  XFlags
         16#03#                          --  OS code
        );
   --  The simplest gzip header is not for informational, but just for
   --  gzip format compatibility.
   --  Note that some code below is using assumption
   --  Simple_GZip_Header'Last > Footer_Array'Last, so do not make
   --  Simple_GZip_Header'Last <= Footer_Array'Last.

   Return_Code : constant array (Thin.Int range <>) of Return_Code_Enum
     := (0 => OK,
         1 => STREAM_END,
         2 => NEED_DICT,
        -1 => ERRNO,
        -2 => STREAM_ERROR,
        -3 => DATA_ERROR,
        -4 => MEM_ERROR,
        -5 => BUF_ERROR,
        -6 => VERSION_ERROR);

   Flate : constant array (Boolean) of Flate_Type
     := (True  => (Step => Thin.Deflate'Access,
                   Done => Thin.DeflateEnd'Access),
         False => (Step => Thin.Inflate'Access,
                   Done => Thin.InflateEnd'Access));

   Flush_Finish : constant array (Boolean) of Flush_Mode
     := (True => Finish, False => No_Flush);

   procedure Raise_Error (Stream : in Z_Stream);
   pragma Inline (Raise_Error);

   procedure Raise_Error (Message : in String);
   pragma Inline (Raise_Error);

   procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int);

   procedure Free is new Ada.Unchecked_Deallocation
      (Z_Stream, Z_Stream_Access);

   function To_Thin_Access is new Ada.Unchecked_Conversion
     (Z_Stream_Access, Thin.Z_Streamp);

   procedure Translate_GZip
     (Filter    : in out Filter_Type;
      In_Data   : in     Ada.Streams.Stream_Element_Array;
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode);
   --  Separate translate routine for make gzip header.

   procedure Translate_Auto
     (Filter    : in out Filter_Type;
      In_Data   : in     Ada.Streams.Stream_Element_Array;
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode);
   --  translate routine without additional headers.

   -----------------
   -- Check_Error --
   -----------------

   procedure Check_Error (Stream : in Z_Stream; Code : in Thin.Int) is
      use type Thin.Int;
   begin
      if Code /= Thin.Z_OK then
         Raise_Error
            (Return_Code_Enum'Image (Return_Code (Code))
              & ": " & Last_Error_Message (Stream));
      end if;
   end Check_Error;

   -----------
   -- Close --
   -----------

   procedure Close
     (Filter       : in out Filter_Type;
      Ignore_Error : in     Boolean := False)
   is
      Code : Thin.Int;
   begin
      if not Ignore_Error and then not Is_Open (Filter) then
         raise Status_Error;
      end if;

      Code := Flate (Filter.Compression).Done (To_Thin_Access (Filter.Strm));

      if Ignore_Error or else Code = Thin.Z_OK then
         Free (Filter.Strm);
      else
         declare
            Error_Message : constant String
              := Last_Error_Message (Filter.Strm.all);
         begin
            Free (Filter.Strm);
            Ada.Exceptions.Raise_Exception
               (ZLib_Error'Identity,
                Return_Code_Enum'Image (Return_Code (Code))
                  & ": " & Error_Message);
         end;
      end if;
   end Close;

   -----------
   -- CRC32 --
   -----------

   function CRC32
     (CRC  : in Unsigned_32;
      Data : in Ada.Streams.Stream_Element_Array)
      return Unsigned_32
   is
      use Thin;
   begin
      return Unsigned_32 (crc32 (ULong (CRC),
                                 Data'Address,
                                 Data'Length));
   end CRC32;

   procedure CRC32
     (CRC  : in out Unsigned_32;
      Data : in     Ada.Streams.Stream_Element_Array) is
   begin
      CRC := CRC32 (CRC, Data);
   end CRC32;

   ------------------
   -- Deflate_Init --
   ------------------

   procedure Deflate_Init
     (Filter       : in out Filter_Type;
      Level        : in     Compression_Level  := Default_Compression;
      Strategy     : in     Strategy_Type      := Default_Strategy;
      Method       : in     Compression_Method := Deflated;
      Window_Bits  : in     Window_Bits_Type   := Default_Window_Bits;
      Memory_Level : in     Memory_Level_Type  := Default_Memory_Level;
      Header       : in     Header_Type        := Default)
   is
      use type Thin.Int;
      Win_Bits : Thin.Int := Thin.Int (Window_Bits);
   begin
      if Is_Open (Filter) then
         raise Status_Error;
      end if;

      --  We allow ZLib to make header only in case of default header type.
      --  Otherwise we would either do header by ourselfs, or do not do
      --  header at all.

      if Header = None or else Header = GZip then
         Win_Bits := -Win_Bits;
      end if;

      --  For the GZip CRC calculation and make headers.

      if Header = GZip then
         Filter.CRC    := 0;
         Filter.Offset := Simple_GZip_Header'First;
      else
         Filter.Offset := Simple_GZip_Header'Last + 1;
      end if;

      Filter.Strm        := new Z_Stream;
      Filter.Compression := True;
      Filter.Stream_End  := False;
      Filter.Header      := Header;

      if Thin.Deflate_Init
           (To_Thin_Access (Filter.Strm),
            Level      => Thin.Int (Level),
            method     => Thin.Int (Method),
            windowBits => Win_Bits,
            memLevel   => Thin.Int (Memory_Level),
            strategy   => Thin.Int (Strategy)) /= Thin.Z_OK
      then
         Raise_Error (Filter.Strm.all);
      end if;
   end Deflate_Init;

   -----------
   -- Flush --
   -----------

   procedure Flush
     (Filter    : in out Filter_Type;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode)
   is
      No_Data : Stream_Element_Array := (1 .. 0 => 0);
      Last    : Stream_Element_Offset;
   begin
      Translate (Filter, No_Data, Last, Out_Data, Out_Last, Flush);
   end Flush;

   -----------------------
   -- Generic_Translate --
   -----------------------

   procedure Generic_Translate
     (Filter          : in out ZLib.Filter_Type;
      In_Buffer_Size  : in     Integer := Default_Buffer_Size;
      Out_Buffer_Size : in     Integer := Default_Buffer_Size)
   is
      In_Buffer  : Stream_Element_Array
                     (1 .. Stream_Element_Offset (In_Buffer_Size));
      Out_Buffer : Stream_Element_Array
                     (1 .. Stream_Element_Offset (Out_Buffer_Size));
      Last       : Stream_Element_Offset;
      In_Last    : Stream_Element_Offset;
      In_First   : Stream_Element_Offset;
      Out_Last   : Stream_Element_Offset;
   begin
      Main : loop
         Data_In (In_Buffer, Last);

         In_First := In_Buffer'First;

         loop
            Translate
              (Filter   => Filter,
               In_Data  => In_Buffer (In_First .. Last),
               In_Last  => In_Last,
               Out_Data => Out_Buffer,
               Out_Last => Out_Last,
               Flush    => Flush_Finish (Last < In_Buffer'First));

            if Out_Buffer'First <= Out_Last then
               Data_Out (Out_Buffer (Out_Buffer'First .. Out_Last));
            end if;

            exit Main when Stream_End (Filter);

            --  The end of in buffer.

            exit when In_Last = Last;

            In_First := In_Last + 1;
         end loop;
      end loop Main;

   end Generic_Translate;

   ------------------
   -- Inflate_Init --
   ------------------

   procedure Inflate_Init
     (Filter      : in out Filter_Type;
      Window_Bits : in     Window_Bits_Type := Default_Window_Bits;
      Header      : in     Header_Type      := Default)
   is
      use type Thin.Int;
      Win_Bits : Thin.Int := Thin.Int (Window_Bits);

      procedure Check_Version;
      --  Check the latest header types compatibility.

      procedure Check_Version is
      begin
         if Version <= "1.1.4" then
            Raise_Error
              ("Inflate header type " & Header_Type'Image (Header)
               & " incompatible with ZLib version " & Version);
         end if;
      end Check_Version;

   begin
      if Is_Open (Filter) then
         raise Status_Error;
      end if;

      case Header is
         when None =>
            Check_Version;

            --  Inflate data without headers determined
            --  by negative Win_Bits.

            Win_Bits := -Win_Bits;
         when GZip =>
            Check_Version;

            --  Inflate gzip data defined by flag 16.

            Win_Bits := Win_Bits + 16;
         when Auto =>
            Check_Version;

            --  Inflate with automatic detection
            --  of gzip or native header defined by flag 32.

            Win_Bits := Win_Bits + 32;
         when Default => null;
      end case;

      Filter.Strm        := new Z_Stream;
      Filter.Compression := False;
      Filter.Stream_End  := False;
      Filter.Header      := Header;

      if Thin.Inflate_Init
         (To_Thin_Access (Filter.Strm), Win_Bits) /= Thin.Z_OK
      then
         Raise_Error (Filter.Strm.all);
      end if;
   end Inflate_Init;

   -------------
   -- Is_Open --
   -------------

   function Is_Open (Filter : in Filter_Type) return Boolean is
   begin
      return Filter.Strm /= null;
   end Is_Open;

   -----------------
   -- Raise_Error --
   -----------------

   procedure Raise_Error (Message : in String) is
   begin
      Ada.Exceptions.Raise_Exception (ZLib_Error'Identity, Message);
   end Raise_Error;

   procedure Raise_Error (Stream : in Z_Stream) is
   begin
      Raise_Error (Last_Error_Message (Stream));
   end Raise_Error;

   ----------
   -- Read --
   ----------

   procedure Read
     (Filter : in out Filter_Type;
      Item   :    out Ada.Streams.Stream_Element_Array;
      Last   :    out Ada.Streams.Stream_Element_Offset;
      Flush  : in     Flush_Mode := No_Flush)
   is
      In_Last    : Stream_Element_Offset;
      Item_First : Ada.Streams.Stream_Element_Offset := Item'First;
      V_Flush    : Flush_Mode := Flush;

   begin
      pragma Assert (Rest_First in Buffer'First .. Buffer'Last + 1);
      pragma Assert (Rest_Last in Buffer'First - 1 .. Buffer'Last);

      loop
         if Rest_Last = Buffer'First - 1 then
            V_Flush := Finish;

         elsif Rest_First > Rest_Last then
            Read (Buffer, Rest_Last);
            Rest_First := Buffer'First;

            if Rest_Last < Buffer'First then
               V_Flush := Finish;
            end if;
         end if;

         Translate
           (Filter   => Filter,
            In_Data  => Buffer (Rest_First .. Rest_Last),
            In_Last  => In_Last,
            Out_Data => Item (Item_First .. Item'Last),
            Out_Last => Last,
            Flush    => V_Flush);

         Rest_First := In_Last + 1;

         exit when Stream_End (Filter)
           or else Last = Item'Last
           or else (Last >= Item'First and then Allow_Read_Some);

         Item_First := Last + 1;
      end loop;
   end Read;

   ----------------
   -- Stream_End --
   ----------------

   function Stream_End (Filter : in Filter_Type) return Boolean is
   begin
      if Filter.Header = GZip and Filter.Compression then
         return Filter.Stream_End
            and then Filter.Offset = Footer_Array'Last + 1;
      else
         return Filter.Stream_End;
      end if;
   end Stream_End;

   --------------
   -- Total_In --
   --------------

   function Total_In (Filter : in Filter_Type) return Count is
   begin
      return Count (Thin.Total_In (To_Thin_Access (Filter.Strm).all));
   end Total_In;

   ---------------
   -- Total_Out --
   ---------------

   function Total_Out (Filter : in Filter_Type) return Count is
   begin
      return Count (Thin.Total_Out (To_Thin_Access (Filter.Strm).all));
   end Total_Out;

   ---------------
   -- Translate --
   ---------------

   procedure Translate
     (Filter    : in out Filter_Type;
      In_Data   : in     Ada.Streams.Stream_Element_Array;
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode) is
   begin
      if Filter.Header = GZip and then Filter.Compression then
         Translate_GZip
           (Filter   => Filter,
            In_Data  => In_Data,
            In_Last  => In_Last,
            Out_Data => Out_Data,
            Out_Last => Out_Last,
            Flush    => Flush);
      else
         Translate_Auto
           (Filter   => Filter,
            In_Data  => In_Data,
            In_Last  => In_Last,
            Out_Data => Out_Data,
            Out_Last => Out_Last,
            Flush    => Flush);
      end if;
   end Translate;

   --------------------
   -- Translate_Auto --
   --------------------

   procedure Translate_Auto
     (Filter    : in out Filter_Type;
      In_Data   : in     Ada.Streams.Stream_Element_Array;
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode)
   is
      use type Thin.Int;
      Code : Thin.Int;

   begin
      if not Is_Open (Filter) then
         raise Status_Error;
      end if;

      if Out_Data'Length = 0 and then In_Data'Length = 0 then
         raise Constraint_Error;
      end if;

      Set_Out (Filter.Strm.all, Out_Data'Address, Out_Data'Length);
      Set_In  (Filter.Strm.all, In_Data'Address, In_Data'Length);

      Code := Flate (Filter.Compression).Step
        (To_Thin_Access (Filter.Strm),
         Thin.Int (Flush));

      if Code = Thin.Z_STREAM_END then
         Filter.Stream_End := True;
      else
         Check_Error (Filter.Strm.all, Code);
      end if;

      In_Last  := In_Data'Last
         - Stream_Element_Offset (Avail_In (Filter.Strm.all));
      Out_Last := Out_Data'Last
         - Stream_Element_Offset (Avail_Out (Filter.Strm.all));
   end Translate_Auto;

   --------------------
   -- Translate_GZip --
   --------------------

   procedure Translate_GZip
     (Filter    : in out Filter_Type;
      In_Data   : in     Ada.Streams.Stream_Element_Array;
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode)
   is
      Out_First : Stream_Element_Offset;

      procedure Add_Data (Data : in Stream_Element_Array);
      --  Add data to stream from the Filter.Offset till necessary,
      --  used for add gzip headr/footer.

      procedure Put_32
        (Item : in out Stream_Element_Array;
         Data : in     Unsigned_32);
      pragma Inline (Put_32);

      --------------
      -- Add_Data --
      --------------

      procedure Add_Data (Data : in Stream_Element_Array) is
         Data_First : Stream_Element_Offset renames Filter.Offset;
         Data_Last  : Stream_Element_Offset;
         Data_Len   : Stream_Element_Offset; --  -1
         Out_Len    : Stream_Element_Offset; --  -1
      begin
         Out_First := Out_Last + 1;

         if Data_First > Data'Last then
            return;
         end if;

         Data_Len  := Data'Last     - Data_First;
         Out_Len   := Out_Data'Last - Out_First;

         if Data_Len <= Out_Len then
            Out_Last  := Out_First  + Data_Len;
            Data_Last := Data'Last;
         else
            Out_Last  := Out_Data'Last;
            Data_Last := Data_First + Out_Len;
         end if;

         Out_Data (Out_First .. Out_Last) := Data (Data_First .. Data_Last);

         Data_First := Data_Last + 1;
         Out_First  := Out_Last + 1;
      end Add_Data;

      ------------
      -- Put_32 --
      ------------

      procedure Put_32
        (Item : in out Stream_Element_Array;
         Data : in     Unsigned_32)
      is
         D : Unsigned_32 := Data;
      begin
         for J in Item'First .. Item'First + 3 loop
            Item (J) := Stream_Element (D and 16#FF#);
            D := Shift_Right (D, 8);
         end loop;
      end Put_32;

   begin
      Out_Last := Out_Data'First - 1;

      if not Filter.Stream_End then
         Add_Data (Simple_GZip_Header);

         Translate_Auto
           (Filter   => Filter,
            In_Data  => In_Data,
            In_Last  => In_Last,
            Out_Data => Out_Data (Out_First .. Out_Data'Last),
            Out_Last => Out_Last,
            Flush    => Flush);

         CRC32 (Filter.CRC, In_Data (In_Data'First .. In_Last));
      end if;

      if Filter.Stream_End and then Out_Last <= Out_Data'Last then
         --  This detection method would work only when
         --  Simple_GZip_Header'Last > Footer_Array'Last

         if Filter.Offset = Simple_GZip_Header'Last + 1 then
            Filter.Offset := Footer_Array'First;
         end if;

         declare
            Footer : Footer_Array;
         begin
            Put_32 (Footer, Filter.CRC);
            Put_32 (Footer (Footer'First + 4 .. Footer'Last),
                    Unsigned_32 (Total_In (Filter)));
            Add_Data (Footer);
         end;
      end if;
   end Translate_GZip;

   -------------
   -- Version --
   -------------

   function Version return String is
   begin
      return Interfaces.C.Strings.Value (Thin.zlibVersion);
   end Version;

   -----------
   -- Write --
   -----------

   procedure Write
     (Filter : in out Filter_Type;
      Item   : in     Ada.Streams.Stream_Element_Array;
      Flush  : in     Flush_Mode := No_Flush)
   is
      Buffer   : Stream_Element_Array (1 .. Buffer_Size);
      In_Last  : Stream_Element_Offset;
      Out_Last : Stream_Element_Offset;
      In_First : Stream_Element_Offset := Item'First;
   begin
      if Item'Length = 0 and Flush = No_Flush then
         return;
      end if;

      loop
         Translate
           (Filter   => Filter,
            In_Data  => Item (In_First .. Item'Last),
            In_Last  => In_Last,
            Out_Data => Buffer,
            Out_Last => Out_Last,
            Flush    => Flush);

         if Out_Last >= Buffer'First then
            Write (Buffer (1 .. Out_Last));
         end if;

         exit when In_Last = Item'Last or Stream_End (Filter);

         In_First := In_Last + 1;
      end loop;
   end Write;

end ZLib;

Deleted compat/zlib/contrib/ada/zlib.ads.

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








































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
------------------------------------------------------------------------------
--                      ZLib for Ada thick binding.                         --
--                                                                          --
--              Copyright (C) 2002-2004 Dmitriy Anisimkov                   --
--                                                                          --
--  This library is free software; you can redistribute it and/or modify    --
--  it under the terms of the GNU General Public License as published by    --
--  the Free Software Foundation; either version 2 of the License, or (at   --
--  your option) any later version.                                         --
--                                                                          --
--  This library is distributed in the hope that it will be useful, but     --
--  WITHOUT ANY WARRANTY; without even the implied warranty of              --
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --
--  General Public License for more details.                                --
--                                                                          --
--  You should have received a copy of the GNU General Public License       --
--  along with this library; if not, write to the Free Software Foundation, --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
--                                                                          --
--  As a special exception, if other files instantiate generics from this   --
--  unit, or you link this unit with other files to produce an executable,  --
--  this  unit  does not  by itself cause  the resulting executable to be   --
--  covered by the GNU General Public License. This exception does not      --
--  however invalidate any other reasons why the executable file  might be  --
--  covered by the  GNU Public License.                                     --
------------------------------------------------------------------------------

--  $Id: zlib.ads,v 1.26 2004/09/06 06:53:19 vagul Exp $

with Ada.Streams;

with Interfaces;

package ZLib is

   ZLib_Error   : exception;
   Status_Error : exception;

   type Compression_Level is new Integer range -1 .. 9;

   type Flush_Mode is private;

   type Compression_Method is private;

   type Window_Bits_Type is new Integer range 8 .. 15;

   type Memory_Level_Type is new Integer range 1 .. 9;

   type Unsigned_32 is new Interfaces.Unsigned_32;

   type Strategy_Type is private;

   type Header_Type is (None, Auto, Default, GZip);
   --  Header type usage have a some limitation for inflate.
   --  See comment for Inflate_Init.

   subtype Count is Ada.Streams.Stream_Element_Count;

   Default_Memory_Level : constant Memory_Level_Type := 8;
   Default_Window_Bits  : constant Window_Bits_Type  := 15;

   ----------------------------------
   -- Compression method constants --
   ----------------------------------

   Deflated : constant Compression_Method;
   --  Only one method allowed in this ZLib version

   ---------------------------------
   -- Compression level constants --
   ---------------------------------

   No_Compression      : constant Compression_Level := 0;
   Best_Speed          : constant Compression_Level := 1;
   Best_Compression    : constant Compression_Level := 9;
   Default_Compression : constant Compression_Level := -1;

   --------------------------
   -- Flush mode constants --
   --------------------------

   No_Flush      : constant Flush_Mode;
   --  Regular way for compression, no flush

   Partial_Flush : constant Flush_Mode;
   --  Will be removed, use Z_SYNC_FLUSH instead

   Sync_Flush    : constant Flush_Mode;
   --  All pending output is flushed to the output buffer and the output
   --  is aligned on a byte boundary, so that the decompressor can get all
   --  input data available so far. (In particular avail_in is zero after the
   --  call if enough output space has been provided  before the call.)
   --  Flushing may degrade compression for some compression algorithms and so
   --  it should be used only when necessary.

   Block_Flush   : constant Flush_Mode;
   --  Z_BLOCK requests that inflate() stop
   --  if and when it get to the next deflate block boundary. When decoding the
   --  zlib or gzip format, this will cause inflate() to return immediately
   --  after the header and before the first block. When doing a raw inflate,
   --  inflate() will go ahead and process the first block, and will return
   --  when it gets to the end of that block, or when it runs out of data.

   Full_Flush    : constant Flush_Mode;
   --  All output is flushed as with SYNC_FLUSH, and the compression state
   --  is reset so that decompression can restart from this point if previous
   --  compressed data has been damaged or if random access is desired. Using
   --  Full_Flush too often can seriously degrade the compression.

   Finish        : constant Flush_Mode;
   --  Just for tell the compressor that input data is complete.

   ------------------------------------
   -- Compression strategy constants --
   ------------------------------------

   --  RLE stategy could be used only in version 1.2.0 and later.

   Filtered         : constant Strategy_Type;
   Huffman_Only     : constant Strategy_Type;
   RLE              : constant Strategy_Type;
   Default_Strategy : constant Strategy_Type;

   Default_Buffer_Size : constant := 4096;

   type Filter_Type is tagged limited private;
   --  The filter is for compression and for decompression.
   --  The usage of the type is depend of its initialization.

   function Version return String;
   pragma Inline (Version);
   --  Return string representation of the ZLib version.

   procedure Deflate_Init
     (Filter       : in out Filter_Type;
      Level        : in     Compression_Level  := Default_Compression;
      Strategy     : in     Strategy_Type      := Default_Strategy;
      Method       : in     Compression_Method := Deflated;
      Window_Bits  : in     Window_Bits_Type   := Default_Window_Bits;
      Memory_Level : in     Memory_Level_Type  := Default_Memory_Level;
      Header       : in     Header_Type        := Default);
   --  Compressor initialization.
   --  When Header parameter is Auto or Default, then default zlib header
   --  would be provided for compressed data.
   --  When Header is GZip, then gzip header would be set instead of
   --  default header.
   --  When Header is None, no header would be set for compressed data.

   procedure Inflate_Init
     (Filter      : in out Filter_Type;
      Window_Bits : in     Window_Bits_Type := Default_Window_Bits;
      Header      : in     Header_Type      := Default);
   --  Decompressor initialization.
   --  Default header type mean that ZLib default header is expecting in the
   --  input compressed stream.
   --  Header type None mean that no header is expecting in the input stream.
   --  GZip header type mean that GZip header is expecting in the
   --  input compressed stream.
   --  Auto header type mean that header type (GZip or Native) would be
   --  detected automatically in the input stream.
   --  Note that header types parameter values None, GZip and Auto are
   --  supported for inflate routine only in ZLib versions 1.2.0.2 and later.
   --  Deflate_Init is supporting all header types.

   function Is_Open (Filter : in Filter_Type) return Boolean;
   pragma Inline (Is_Open);
   --  Is the filter opened for compression or decompression.

   procedure Close
     (Filter       : in out Filter_Type;
      Ignore_Error : in     Boolean := False);
   --  Closing the compression or decompressor.
   --  If stream is closing before the complete and Ignore_Error is False,
   --  The exception would be raised.

   generic
      with procedure Data_In
        (Item : out Ada.Streams.Stream_Element_Array;
         Last : out Ada.Streams.Stream_Element_Offset);
      with procedure Data_Out
        (Item : in Ada.Streams.Stream_Element_Array);
   procedure Generic_Translate
     (Filter          : in out Filter_Type;
      In_Buffer_Size  : in     Integer := Default_Buffer_Size;
      Out_Buffer_Size : in     Integer := Default_Buffer_Size);
   --  Compress/decompress data fetch from Data_In routine and pass the result
   --  to the Data_Out routine. User should provide Data_In and Data_Out
   --  for compression/decompression data flow.
   --  Compression or decompression depend on Filter initialization.

   function Total_In (Filter : in Filter_Type) return Count;
   pragma Inline (Total_In);
   --  Returns total number of input bytes read so far

   function Total_Out (Filter : in Filter_Type) return Count;
   pragma Inline (Total_Out);
   --  Returns total number of bytes output so far

   function CRC32
     (CRC    : in Unsigned_32;
      Data   : in Ada.Streams.Stream_Element_Array)
      return Unsigned_32;
   pragma Inline (CRC32);
   --  Compute CRC32, it could be necessary for make gzip format

   procedure CRC32
     (CRC  : in out Unsigned_32;
      Data : in     Ada.Streams.Stream_Element_Array);
   pragma Inline (CRC32);
   --  Compute CRC32, it could be necessary for make gzip format

   -------------------------------------------------
   --  Below is more complex low level routines.  --
   -------------------------------------------------

   procedure Translate
     (Filter    : in out Filter_Type;
      In_Data   : in     Ada.Streams.Stream_Element_Array;
      In_Last   :    out Ada.Streams.Stream_Element_Offset;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode);
   --  Compress/decompress the In_Data buffer and place the result into
   --  Out_Data. In_Last is the index of last element from In_Data accepted by
   --  the Filter. Out_Last is the last element of the received data from
   --  Filter. To tell the filter that incoming data are complete put the
   --  Flush parameter to Finish.

   function Stream_End (Filter : in Filter_Type) return Boolean;
   pragma Inline (Stream_End);
   --  Return the true when the stream is complete.

   procedure Flush
     (Filter    : in out Filter_Type;
      Out_Data  :    out Ada.Streams.Stream_Element_Array;
      Out_Last  :    out Ada.Streams.Stream_Element_Offset;
      Flush     : in     Flush_Mode);
   pragma Inline (Flush);
   --  Flushing the data from the compressor.

   generic
      with procedure Write
        (Item : in Ada.Streams.Stream_Element_Array);
      --  User should provide this routine for accept
      --  compressed/decompressed data.

      Buffer_Size : in Ada.Streams.Stream_Element_Offset
         := Default_Buffer_Size;
      --  Buffer size for Write user routine.

   procedure Write
     (Filter  : in out Filter_Type;
      Item    : in     Ada.Streams.Stream_Element_Array;
      Flush   : in     Flush_Mode := No_Flush);
   --  Compress/Decompress data from Item to the generic parameter procedure
   --  Write. Output buffer size could be set in Buffer_Size generic parameter.

   generic
      with procedure Read
        (Item : out Ada.Streams.Stream_Element_Array;
         Last : out Ada.Streams.Stream_Element_Offset);
      --  User should provide data for compression/decompression
      --  thru this routine.

      Buffer : in out Ada.Streams.Stream_Element_Array;
      --  Buffer for keep remaining data from the previous
      --  back read.

      Rest_First, Rest_Last : in out Ada.Streams.Stream_Element_Offset;
      --  Rest_First have to be initialized to Buffer'Last + 1
      --  Rest_Last have to be initialized to Buffer'Last
      --  before usage.

      Allow_Read_Some : in Boolean := False;
      --  Is it allowed to return Last < Item'Last before end of data.

   procedure Read
     (Filter : in out Filter_Type;
      Item   :    out Ada.Streams.Stream_Element_Array;
      Last   :    out Ada.Streams.Stream_Element_Offset;
      Flush  : in     Flush_Mode := No_Flush);
   --  Compress/Decompress data from generic parameter procedure Read to the
   --  Item. User should provide Buffer and initialized Rest_First, Rest_Last
   --  indicators. If Allow_Read_Some is True, Read routines could return
   --  Last < Item'Last only at end of stream.

private

   use Ada.Streams;

   pragma Assert (Ada.Streams.Stream_Element'Size    =    8);
   pragma Assert (Ada.Streams.Stream_Element'Modulus = 2**8);

   type Flush_Mode is new Integer range 0 .. 5;

   type Compression_Method is new Integer range 8 .. 8;

   type Strategy_Type is new Integer range 0 .. 3;

   No_Flush      : constant Flush_Mode := 0;
   Partial_Flush : constant Flush_Mode := 1;
   Sync_Flush    : constant Flush_Mode := 2;
   Full_Flush    : constant Flush_Mode := 3;
   Finish        : constant Flush_Mode := 4;
   Block_Flush   : constant Flush_Mode := 5;

   Filtered         : constant Strategy_Type := 1;
   Huffman_Only     : constant Strategy_Type := 2;
   RLE              : constant Strategy_Type := 3;
   Default_Strategy : constant Strategy_Type := 0;

   Deflated : constant Compression_Method := 8;

   type Z_Stream;

   type Z_Stream_Access is access all Z_Stream;

   type Filter_Type is tagged limited record
      Strm        : Z_Stream_Access;
      Compression : Boolean;
      Stream_End  : Boolean;
      Header      : Header_Type;
      CRC         : Unsigned_32;
      Offset      : Stream_Element_Offset;
      --  Offset for gzip header/footer output.
   end record;

end ZLib;

Deleted compat/zlib/contrib/ada/zlib.gpr.

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




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
project Zlib is

   for Languages use ("Ada");
   for Source_Dirs use (".");
   for Object_Dir use ".";
   for Main use ("test.adb", "mtest.adb", "read.adb", "buffer_demo");

   package Compiler is
      for Default_Switches ("ada") use ("-gnatwcfilopru", "-gnatVcdfimorst", "-gnatyabcefhiklmnoprst");
   end Compiler;

   package Linker is
      for Default_Switches ("ada") use ("-lz");
   end Linker;

   package Builder is
      for Default_Switches ("ada") use ("-s", "-gnatQ");
   end Builder;

end Zlib;

Deleted compat/zlib/contrib/amd64/amd64-match.S.

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
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
450
451
452




































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * match.S -- optimized version of longest_match()
 * based on the similar work by Gilles Vollant, and Brian Raiter, written 1998
 *
 * This is free software; you can redistribute it and/or modify it
 * under the terms of the BSD License. Use by owners of Che Guevarra
 * parafernalia is prohibited, where possible, and highly discouraged
 * elsewhere.
 */

#ifndef NO_UNDERLINE
#	define	match_init	_match_init
#	define	longest_match	_longest_match
#endif

#define	scanend		ebx
#define	scanendw	bx
#define	chainlenwmask	edx /* high word: current chain len low word: s->wmask */
#define	curmatch	rsi
#define	curmatchd	esi
#define	windowbestlen	r8
#define	scanalign	r9
#define	scanalignd	r9d
#define	window		r10
#define	bestlen		r11
#define	bestlend	r11d
#define	scanstart	r12d
#define	scanstartw	r12w
#define scan		r13
#define nicematch	r14d
#define	limit		r15
#define	limitd		r15d
#define prev		rcx

/*
 * The 258 is a "magic number, not a parameter -- changing it
 * breaks the hell loose
 */
#define	MAX_MATCH	(258)
#define	MIN_MATCH	(3)
#define	MIN_LOOKAHEAD	(MAX_MATCH + MIN_MATCH + 1)
#define	MAX_MATCH_8	((MAX_MATCH + 7) & ~7)

/* stack frame offsets */
#define	LocalVarsSize	(112)
#define _chainlenwmask	( 8-LocalVarsSize)(%rsp)
#define _windowbestlen	(16-LocalVarsSize)(%rsp)
#define save_r14        (24-LocalVarsSize)(%rsp)
#define save_rsi        (32-LocalVarsSize)(%rsp)
#define save_rbx        (40-LocalVarsSize)(%rsp)
#define save_r12        (56-LocalVarsSize)(%rsp)
#define save_r13        (64-LocalVarsSize)(%rsp)
#define save_r15        (80-LocalVarsSize)(%rsp)


.globl	match_init, longest_match

/*
 * On AMD64 the first argument of a function (in our case -- the pointer to
 * deflate_state structure) is passed in %rdi, hence our offsets below are
 * all off of that.
 */

/* you can check the structure offset by running

#include <stdlib.h>
#include <stdio.h>
#include "deflate.h"

void print_depl()
{
deflate_state ds;
deflate_state *s=&ds;
printf("size pointer=%u\n",(int)sizeof(void*));

printf("#define dsWSize         (%3u)(%%rdi)\n",(int)(((char*)&(s->w_size))-((char*)s)));
printf("#define dsWMask         (%3u)(%%rdi)\n",(int)(((char*)&(s->w_mask))-((char*)s)));
printf("#define dsWindow        (%3u)(%%rdi)\n",(int)(((char*)&(s->window))-((char*)s)));
printf("#define dsPrev          (%3u)(%%rdi)\n",(int)(((char*)&(s->prev))-((char*)s)));
printf("#define dsMatchLen      (%3u)(%%rdi)\n",(int)(((char*)&(s->match_length))-((char*)s)));
printf("#define dsPrevMatch     (%3u)(%%rdi)\n",(int)(((char*)&(s->prev_match))-((char*)s)));
printf("#define dsStrStart      (%3u)(%%rdi)\n",(int)(((char*)&(s->strstart))-((char*)s)));
printf("#define dsMatchStart    (%3u)(%%rdi)\n",(int)(((char*)&(s->match_start))-((char*)s)));
printf("#define dsLookahead     (%3u)(%%rdi)\n",(int)(((char*)&(s->lookahead))-((char*)s)));
printf("#define dsPrevLen       (%3u)(%%rdi)\n",(int)(((char*)&(s->prev_length))-((char*)s)));
printf("#define dsMaxChainLen   (%3u)(%%rdi)\n",(int)(((char*)&(s->max_chain_length))-((char*)s)));
printf("#define dsGoodMatch     (%3u)(%%rdi)\n",(int)(((char*)&(s->good_match))-((char*)s)));
printf("#define dsNiceMatch     (%3u)(%%rdi)\n",(int)(((char*)&(s->nice_match))-((char*)s)));
}

*/


/*
  to compile for XCode 3.2 on MacOSX x86_64
  - run "gcc -g -c -DXCODE_MAC_X64_STRUCTURE amd64-match.S"
 */


#ifndef CURRENT_LINX_XCODE_MAC_X64_STRUCTURE
#define dsWSize		( 68)(%rdi)
#define dsWMask		( 76)(%rdi)
#define dsWindow	( 80)(%rdi)
#define dsPrev		( 96)(%rdi)
#define dsMatchLen	(144)(%rdi)
#define dsPrevMatch	(148)(%rdi)
#define dsStrStart	(156)(%rdi)
#define dsMatchStart	(160)(%rdi)
#define dsLookahead	(164)(%rdi)
#define dsPrevLen	(168)(%rdi)
#define dsMaxChainLen	(172)(%rdi)
#define dsGoodMatch	(188)(%rdi)
#define dsNiceMatch	(192)(%rdi)

#else 

#ifndef STRUCT_OFFSET
#	define STRUCT_OFFSET	(0)
#endif


#define dsWSize		( 56 + STRUCT_OFFSET)(%rdi)
#define dsWMask		( 64 + STRUCT_OFFSET)(%rdi)
#define dsWindow	( 72 + STRUCT_OFFSET)(%rdi)
#define dsPrev		( 88 + STRUCT_OFFSET)(%rdi)
#define dsMatchLen	(136 + STRUCT_OFFSET)(%rdi)
#define dsPrevMatch	(140 + STRUCT_OFFSET)(%rdi)
#define dsStrStart	(148 + STRUCT_OFFSET)(%rdi)
#define dsMatchStart	(152 + STRUCT_OFFSET)(%rdi)
#define dsLookahead	(156 + STRUCT_OFFSET)(%rdi)
#define dsPrevLen	(160 + STRUCT_OFFSET)(%rdi)
#define dsMaxChainLen	(164 + STRUCT_OFFSET)(%rdi)
#define dsGoodMatch	(180 + STRUCT_OFFSET)(%rdi)
#define dsNiceMatch	(184 + STRUCT_OFFSET)(%rdi)

#endif




.text

/* uInt longest_match(deflate_state *deflatestate, IPos curmatch) */

longest_match:
/*
 * Retrieve the function arguments. %curmatch will hold cur_match
 * throughout the entire function (passed via rsi on amd64).
 * rdi will hold the pointer to the deflate_state (first arg on amd64)
 */
		mov     %rsi, save_rsi
		mov     %rbx, save_rbx
		mov	%r12, save_r12
		mov     %r13, save_r13
		mov     %r14, save_r14
		mov     %r15, save_r15

/* uInt wmask = s->w_mask;						*/
/* unsigned chain_length = s->max_chain_length;				*/
/* if (s->prev_length >= s->good_match) {				*/
/*     chain_length >>= 2;						*/
/* }									*/

		movl	dsPrevLen, %eax
		movl	dsGoodMatch, %ebx
		cmpl	%ebx, %eax
		movl	dsWMask, %eax
		movl	dsMaxChainLen, %chainlenwmask
		jl	LastMatchGood
		shrl	$2, %chainlenwmask
LastMatchGood:

/* chainlen is decremented once beforehand so that the function can	*/
/* use the sign flag instead of the zero flag for the exit test.	*/
/* It is then shifted into the high word, to make room for the wmask	*/
/* value, which it will always accompany.				*/

		decl	%chainlenwmask
		shll	$16, %chainlenwmask
		orl	%eax, %chainlenwmask

/* if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;	*/

		movl	dsNiceMatch, %eax
		movl	dsLookahead, %ebx
		cmpl	%eax, %ebx
		jl	LookaheadLess
		movl	%eax, %ebx
LookaheadLess:	movl	%ebx, %nicematch

/* register Bytef *scan = s->window + s->strstart;			*/

		mov	dsWindow, %window
		movl	dsStrStart, %limitd
		lea	(%limit, %window), %scan

/* Determine how many bytes the scan ptr is off from being		*/
/* dword-aligned.							*/

		mov	%scan, %scanalign
		negl	%scanalignd
		andl	$3, %scanalignd

/* IPos limit = s->strstart > (IPos)MAX_DIST(s) ?			*/
/*     s->strstart - (IPos)MAX_DIST(s) : NIL;				*/

		movl	dsWSize, %eax
		subl	$MIN_LOOKAHEAD, %eax
		xorl	%ecx, %ecx
		subl	%eax, %limitd
		cmovng	%ecx, %limitd

/* int best_len = s->prev_length;					*/

		movl	dsPrevLen, %bestlend

/* Store the sum of s->window + best_len in %windowbestlen locally, and in memory.	*/

		lea	(%window, %bestlen), %windowbestlen
		mov	%windowbestlen, _windowbestlen

/* register ush scan_start = *(ushf*)scan;				*/
/* register ush scan_end   = *(ushf*)(scan+best_len-1);			*/
/* Posf *prev = s->prev;						*/

		movzwl	(%scan), %scanstart
		movzwl	-1(%scan, %bestlen), %scanend
		mov	dsPrev, %prev

/* Jump into the main loop.						*/

		movl	%chainlenwmask, _chainlenwmask
		jmp	LoopEntry

.balign 16

/* do {
 *     match = s->window + cur_match;
 *     if (*(ushf*)(match+best_len-1) != scan_end ||
 *         *(ushf*)match != scan_start) continue;
 *     [...]
 * } while ((cur_match = prev[cur_match & wmask]) > limit
 *          && --chain_length != 0);
 *
 * Here is the inner loop of the function. The function will spend the
 * majority of its time in this loop, and majority of that time will
 * be spent in the first ten instructions.
 */
LookupLoop:
		andl	%chainlenwmask, %curmatchd
		movzwl	(%prev, %curmatch, 2), %curmatchd
		cmpl	%limitd, %curmatchd
		jbe	LeaveNow
		subl	$0x00010000, %chainlenwmask
		js	LeaveNow
LoopEntry:	cmpw	-1(%windowbestlen, %curmatch), %scanendw
		jne	LookupLoop
		cmpw	%scanstartw, (%window, %curmatch)
		jne	LookupLoop

/* Store the current value of chainlen.					*/
		movl	%chainlenwmask, _chainlenwmask

/* %scan is the string under scrutiny, and %prev to the string we	*/
/* are hoping to match it up with. In actuality, %esi and %edi are	*/
/* both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and %edx is	*/
/* initialized to -(MAX_MATCH_8 - scanalign).				*/

		mov	$(-MAX_MATCH_8), %rdx
		lea	(%curmatch, %window), %windowbestlen
		lea	MAX_MATCH_8(%windowbestlen, %scanalign), %windowbestlen
		lea	MAX_MATCH_8(%scan, %scanalign), %prev

/* the prefetching below makes very little difference... */
		prefetcht1	(%windowbestlen, %rdx)
		prefetcht1	(%prev, %rdx)

/*
 * Test the strings for equality, 8 bytes at a time. At the end,
 * adjust %rdx so that it is offset to the exact byte that mismatched.
 *
 * It should be confessed that this loop usually does not represent
 * much of the total running time. Replacing it with a more
 * straightforward "rep cmpsb" would not drastically degrade
 * performance -- unrolling it, for example, makes no difference.
 */

#undef USE_SSE	/* works, but is 6-7% slower, than non-SSE... */

LoopCmps:
#ifdef USE_SSE
		/* Preload the SSE registers */
		movdqu	  (%windowbestlen, %rdx), %xmm1
		movdqu	  (%prev, %rdx), %xmm2
		pcmpeqb	%xmm2, %xmm1
		movdqu	16(%windowbestlen, %rdx), %xmm3
		movdqu	16(%prev, %rdx), %xmm4
		pcmpeqb	%xmm4, %xmm3
		movdqu	32(%windowbestlen, %rdx), %xmm5
		movdqu	32(%prev, %rdx), %xmm6
		pcmpeqb	%xmm6, %xmm5
		movdqu	48(%windowbestlen, %rdx), %xmm7
		movdqu	48(%prev, %rdx), %xmm8
		pcmpeqb	%xmm8, %xmm7

		/* Check the comparisions' results */
		pmovmskb %xmm1, %rax
		notw	%ax
		bsfw	%ax, %ax
		jnz	LeaveLoopCmps
		
		/* this is the only iteration of the loop with a possibility of having
		   incremented rdx by 0x108 (each loop iteration add 16*4 = 0x40 
		   and (0x40*4)+8=0x108 */
		add	$8, %rdx
		jz LenMaximum
		add	$8, %rdx

		
		pmovmskb %xmm3, %rax
		notw	%ax
		bsfw	%ax, %ax
		jnz	LeaveLoopCmps
		
		
		add	$16, %rdx


		pmovmskb %xmm5, %rax
		notw	%ax
		bsfw	%ax, %ax
		jnz	LeaveLoopCmps
		
		add	$16, %rdx


		pmovmskb %xmm7, %rax
		notw	%ax
		bsfw	%ax, %ax
		jnz	LeaveLoopCmps
		
		add	$16, %rdx
		
		jmp	LoopCmps
LeaveLoopCmps:	add	%rax, %rdx
#else
		mov	(%windowbestlen, %rdx), %rax
		xor	(%prev, %rdx), %rax
		jnz	LeaveLoopCmps
		
		mov	8(%windowbestlen, %rdx), %rax
		xor	8(%prev, %rdx), %rax
		jnz	LeaveLoopCmps8

		mov	16(%windowbestlen, %rdx), %rax
		xor	16(%prev, %rdx), %rax
		jnz	LeaveLoopCmps16
				
		add	$24, %rdx
		jnz	LoopCmps
		jmp	LenMaximum
#	if 0
/*
 * This three-liner is tantalizingly simple, but bsf is a slow instruction,
 * and the complicated alternative down below is quite a bit faster. Sad...
 */

LeaveLoopCmps:	bsf	%rax, %rax /* find the first non-zero bit */
		shrl	$3, %eax /* divide by 8 to get the byte */
		add	%rax, %rdx
#	else
LeaveLoopCmps16:
		add	$8, %rdx
LeaveLoopCmps8:
		add	$8, %rdx
LeaveLoopCmps:	testl   $0xFFFFFFFF, %eax /* Check the first 4 bytes */
		jnz     Check16
		add     $4, %rdx
		shr     $32, %rax
Check16:        testw   $0xFFFF, %ax
		jnz     LenLower
		add	$2, %rdx
		shrl	$16, %eax
LenLower:	subb	$1, %al
		adc	$0, %rdx
#	endif
#endif

/* Calculate the length of the match. If it is longer than MAX_MATCH,	*/
/* then automatically accept it as the best possible match and leave.	*/

		lea	(%prev, %rdx), %rax
		sub	%scan, %rax
		cmpl	$MAX_MATCH, %eax
		jge	LenMaximum

/* If the length of the match is not longer than the best match we	*/
/* have so far, then forget it and return to the lookup loop.		*/

		cmpl	%bestlend, %eax
		jg	LongerMatch
		mov	_windowbestlen, %windowbestlen
		mov	dsPrev, %prev
		movl	_chainlenwmask, %edx
		jmp	LookupLoop

/*         s->match_start = cur_match;					*/
/*         best_len = len;						*/
/*         if (len >= nice_match) break;				*/
/*         scan_end = *(ushf*)(scan+best_len-1);			*/

LongerMatch:
		movl	%eax, %bestlend
		movl	%curmatchd, dsMatchStart
		cmpl	%nicematch, %eax
		jge	LeaveNow

		lea	(%window, %bestlen), %windowbestlen
		mov	%windowbestlen, _windowbestlen

		movzwl	-1(%scan, %rax), %scanend
		mov	dsPrev, %prev
		movl	_chainlenwmask, %chainlenwmask
		jmp	LookupLoop

/* Accept the current string, with the maximum possible length.		*/

LenMaximum:
		movl	$MAX_MATCH, %bestlend
		movl	%curmatchd, dsMatchStart

/* if ((uInt)best_len <= s->lookahead) return (uInt)best_len;		*/
/* return s->lookahead;							*/

LeaveNow:
		movl	dsLookahead, %eax
		cmpl	%eax, %bestlend
		cmovngl	%bestlend, %eax
LookaheadRet:

/* Restore the registers and return from whence we came.			*/

	mov	save_rsi, %rsi
	mov	save_rbx, %rbx
	mov	save_r12, %r12
	mov	save_r13, %r13
	mov	save_r14, %r14
	mov	save_r15, %r15

	ret

match_init:	ret

Deleted compat/zlib/contrib/asm686/README.686.

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



















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
This is a patched version of zlib, modified to use
Pentium-Pro-optimized assembly code in the deflation algorithm. The
files changed/added by this patch are:

README.686
match.S

The speedup that this patch provides varies, depending on whether the
compiler used to build the original version of zlib falls afoul of the
PPro's speed traps. My own tests show a speedup of around 10-20% at
the default compression level, and 20-30% using -9, against a version
compiled using gcc 2.7.2.3. Your mileage may vary.

Note that this code has been tailored for the PPro/PII in particular,
and will not perform particuarly well on a Pentium.

If you are using an assembler other than GNU as, you will have to
translate match.S to use your assembler's syntax. (Have fun.)

Brian Raiter
breadbox@muppetlabs.com
April, 1998


Added for zlib 1.1.3:

The patches come from
http://www.muppetlabs.com/~breadbox/software/assembly.html

To compile zlib with this asm file, copy match.S to the zlib directory
then do:

CFLAGS="-O3 -DASMV" ./configure
make OBJA=match.o


Update:

I've been ignoring these assembly routines for years, believing that
gcc's generated code had caught up with it sometime around gcc 2.95
and the major rearchitecting of the Pentium 4. However, I recently
learned that, despite what I believed, this code still has some life
in it. On the Pentium 4 and AMD64 chips, it continues to run about 8%
faster than the code produced by gcc 4.1.

In acknowledgement of its continuing usefulness, I've altered the
license to match that of the rest of zlib. Share and Enjoy!

Brian Raiter
breadbox@muppetlabs.com
April, 2007

Deleted compat/zlib/contrib/asm686/match.S.

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





































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* match.S -- x86 assembly version of the zlib longest_match() function.
 * Optimized for the Intel 686 chips (PPro and later).
 *
 * Copyright (C) 1998, 2007 Brian Raiter <breadbox@muppetlabs.com>
 *
 * This software is provided 'as-is', without any express or implied
 * warranty.  In no event will the author be held liable for any damages
 * arising from the use of this software.
 *
 * Permission is granted to anyone to use this software for any purpose,
 * including commercial applications, and to alter it and redistribute it
 * freely, subject to the following restrictions:
 *
 * 1. The origin of this software must not be misrepresented; you must not
 *    claim that you wrote the original software. If you use this software
 *    in a product, an acknowledgment in the product documentation would be
 *    appreciated but is not required.
 * 2. Altered source versions must be plainly marked as such, and must not be
 *    misrepresented as being the original software.
 * 3. This notice may not be removed or altered from any source distribution.
 */

#ifndef NO_UNDERLINE
#define	match_init	_match_init
#define	longest_match	_longest_match
#endif

#define	MAX_MATCH	(258)
#define	MIN_MATCH	(3)
#define	MIN_LOOKAHEAD	(MAX_MATCH + MIN_MATCH + 1)
#define	MAX_MATCH_8	((MAX_MATCH + 7) & ~7)

/* stack frame offsets */

#define	chainlenwmask		0	/* high word: current chain len	*/
					/* low word: s->wmask		*/
#define	window			4	/* local copy of s->window	*/
#define	windowbestlen		8	/* s->window + bestlen		*/
#define	scanstart		16	/* first two bytes of string	*/
#define	scanend			12	/* last two bytes of string	*/
#define	scanalign		20	/* dword-misalignment of string	*/
#define	nicematch		24	/* a good enough match size	*/
#define	bestlen			28	/* size of best match so far	*/
#define	scan			32	/* ptr to string wanting match	*/

#define	LocalVarsSize		(36)
/*	saved ebx		36 */
/*	saved edi		40 */
/*	saved esi		44 */
/*	saved ebp		48 */
/*	return address		52 */
#define	deflatestate		56	/* the function arguments	*/
#define	curmatch		60

/* All the +zlib1222add offsets are due to the addition of fields
 *  in zlib in the deflate_state structure since the asm code was first written
 * (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)").
 * (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0").
 * if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8").
 */

#define zlib1222add		(8)

#define	dsWSize			(36+zlib1222add)
#define	dsWMask			(44+zlib1222add)
#define	dsWindow		(48+zlib1222add)
#define	dsPrev			(56+zlib1222add)
#define	dsMatchLen		(88+zlib1222add)
#define	dsPrevMatch		(92+zlib1222add)
#define	dsStrStart		(100+zlib1222add)
#define	dsMatchStart		(104+zlib1222add)
#define	dsLookahead		(108+zlib1222add)
#define	dsPrevLen		(112+zlib1222add)
#define	dsMaxChainLen		(116+zlib1222add)
#define	dsGoodMatch		(132+zlib1222add)
#define	dsNiceMatch		(136+zlib1222add)


.file "match.S"

.globl	match_init, longest_match

.text

/* uInt longest_match(deflate_state *deflatestate, IPos curmatch) */
.cfi_sections	.debug_frame

longest_match:

.cfi_startproc
/* Save registers that the compiler may be using, and adjust %esp to	*/
/* make room for our stack frame.					*/

		pushl	%ebp
		.cfi_def_cfa_offset 8
		.cfi_offset ebp, -8
		pushl	%edi
		.cfi_def_cfa_offset 12
		pushl	%esi
		.cfi_def_cfa_offset 16
		pushl	%ebx
		.cfi_def_cfa_offset 20
		subl	$LocalVarsSize, %esp
		.cfi_def_cfa_offset LocalVarsSize+20

/* Retrieve the function arguments. %ecx will hold cur_match		*/
/* throughout the entire function. %edx will hold the pointer to the	*/
/* deflate_state structure during the function's setup (before		*/
/* entering the main loop).						*/

		movl	deflatestate(%esp), %edx
		movl	curmatch(%esp), %ecx

/* uInt wmask = s->w_mask;						*/
/* unsigned chain_length = s->max_chain_length;				*/
/* if (s->prev_length >= s->good_match) {				*/
/*     chain_length >>= 2;						*/
/* }									*/
 
		movl	dsPrevLen(%edx), %eax
		movl	dsGoodMatch(%edx), %ebx
		cmpl	%ebx, %eax
		movl	dsWMask(%edx), %eax
		movl	dsMaxChainLen(%edx), %ebx
		jl	LastMatchGood
		shrl	$2, %ebx
LastMatchGood:

/* chainlen is decremented once beforehand so that the function can	*/
/* use the sign flag instead of the zero flag for the exit test.	*/
/* It is then shifted into the high word, to make room for the wmask	*/
/* value, which it will always accompany.				*/

		decl	%ebx
		shll	$16, %ebx
		orl	%eax, %ebx
		movl	%ebx, chainlenwmask(%esp)

/* if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;	*/

		movl	dsNiceMatch(%edx), %eax
		movl	dsLookahead(%edx), %ebx
		cmpl	%eax, %ebx
		jl	LookaheadLess
		movl	%eax, %ebx
LookaheadLess:	movl	%ebx, nicematch(%esp)

/* register Bytef *scan = s->window + s->strstart;			*/

		movl	dsWindow(%edx), %esi
		movl	%esi, window(%esp)
		movl	dsStrStart(%edx), %ebp
		lea	(%esi,%ebp), %edi
		movl	%edi, scan(%esp)

/* Determine how many bytes the scan ptr is off from being		*/
/* dword-aligned.							*/

		movl	%edi, %eax
		negl	%eax
		andl	$3, %eax
		movl	%eax, scanalign(%esp)

/* IPos limit = s->strstart > (IPos)MAX_DIST(s) ?			*/
/*     s->strstart - (IPos)MAX_DIST(s) : NIL;				*/

		movl	dsWSize(%edx), %eax
		subl	$MIN_LOOKAHEAD, %eax
		subl	%eax, %ebp
		jg	LimitPositive
		xorl	%ebp, %ebp
LimitPositive:

/* int best_len = s->prev_length;					*/

		movl	dsPrevLen(%edx), %eax
		movl	%eax, bestlen(%esp)

/* Store the sum of s->window + best_len in %esi locally, and in %esi.	*/

		addl	%eax, %esi
		movl	%esi, windowbestlen(%esp)

/* register ush scan_start = *(ushf*)scan;				*/
/* register ush scan_end   = *(ushf*)(scan+best_len-1);			*/
/* Posf *prev = s->prev;						*/

		movzwl	(%edi), %ebx
		movl	%ebx, scanstart(%esp)
		movzwl	-1(%edi,%eax), %ebx
		movl	%ebx, scanend(%esp)
		movl	dsPrev(%edx), %edi

/* Jump into the main loop.						*/

		movl	chainlenwmask(%esp), %edx
		jmp	LoopEntry

.balign 16

/* do {
 *     match = s->window + cur_match;
 *     if (*(ushf*)(match+best_len-1) != scan_end ||
 *         *(ushf*)match != scan_start) continue;
 *     [...]
 * } while ((cur_match = prev[cur_match & wmask]) > limit
 *          && --chain_length != 0);
 *
 * Here is the inner loop of the function. The function will spend the
 * majority of its time in this loop, and majority of that time will
 * be spent in the first ten instructions.
 *
 * Within this loop:
 * %ebx = scanend
 * %ecx = curmatch
 * %edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
 * %esi = windowbestlen - i.e., (window + bestlen)
 * %edi = prev
 * %ebp = limit
 */
LookupLoop:
		andl	%edx, %ecx
		movzwl	(%edi,%ecx,2), %ecx
		cmpl	%ebp, %ecx
		jbe	LeaveNow
		subl	$0x00010000, %edx
		js	LeaveNow
LoopEntry:	movzwl	-1(%esi,%ecx), %eax
		cmpl	%ebx, %eax
		jnz	LookupLoop
		movl	window(%esp), %eax
		movzwl	(%eax,%ecx), %eax
		cmpl	scanstart(%esp), %eax
		jnz	LookupLoop

/* Store the current value of chainlen.					*/

		movl	%edx, chainlenwmask(%esp)

/* Point %edi to the string under scrutiny, and %esi to the string we	*/
/* are hoping to match it up with. In actuality, %esi and %edi are	*/
/* both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and %edx is	*/
/* initialized to -(MAX_MATCH_8 - scanalign).				*/

		movl	window(%esp), %esi
		movl	scan(%esp), %edi
		addl	%ecx, %esi
		movl	scanalign(%esp), %eax
		movl	$(-MAX_MATCH_8), %edx
		lea	MAX_MATCH_8(%edi,%eax), %edi
		lea	MAX_MATCH_8(%esi,%eax), %esi

/* Test the strings for equality, 8 bytes at a time. At the end,
 * adjust %edx so that it is offset to the exact byte that mismatched.
 *
 * We already know at this point that the first three bytes of the
 * strings match each other, and they can be safely passed over before
 * starting the compare loop. So what this code does is skip over 0-3
 * bytes, as much as necessary in order to dword-align the %edi
 * pointer. (%esi will still be misaligned three times out of four.)
 *
 * It should be confessed that this loop usually does not represent
 * much of the total running time. Replacing it with a more
 * straightforward "rep cmpsb" would not drastically degrade
 * performance.
 */
LoopCmps:
		movl	(%esi,%edx), %eax
		xorl	(%edi,%edx), %eax
		jnz	LeaveLoopCmps
		movl	4(%esi,%edx), %eax
		xorl	4(%edi,%edx), %eax
		jnz	LeaveLoopCmps4
		addl	$8, %edx
		jnz	LoopCmps
		jmp	LenMaximum
LeaveLoopCmps4:	addl	$4, %edx
LeaveLoopCmps:	testl	$0x0000FFFF, %eax
		jnz	LenLower
		addl	$2, %edx
		shrl	$16, %eax
LenLower:	subb	$1, %al
		adcl	$0, %edx

/* Calculate the length of the match. If it is longer than MAX_MATCH,	*/
/* then automatically accept it as the best possible match and leave.	*/

		lea	(%edi,%edx), %eax
		movl	scan(%esp), %edi
		subl	%edi, %eax
		cmpl	$MAX_MATCH, %eax
		jge	LenMaximum

/* If the length of the match is not longer than the best match we	*/
/* have so far, then forget it and return to the lookup loop.		*/

		movl	deflatestate(%esp), %edx
		movl	bestlen(%esp), %ebx
		cmpl	%ebx, %eax
		jg	LongerMatch
		movl	windowbestlen(%esp), %esi
		movl	dsPrev(%edx), %edi
		movl	scanend(%esp), %ebx
		movl	chainlenwmask(%esp), %edx
		jmp	LookupLoop

/*         s->match_start = cur_match;					*/
/*         best_len = len;						*/
/*         if (len >= nice_match) break;				*/
/*         scan_end = *(ushf*)(scan+best_len-1);			*/

LongerMatch:	movl	nicematch(%esp), %ebx
		movl	%eax, bestlen(%esp)
		movl	%ecx, dsMatchStart(%edx)
		cmpl	%ebx, %eax
		jge	LeaveNow
		movl	window(%esp), %esi
		addl	%eax, %esi
		movl	%esi, windowbestlen(%esp)
		movzwl	-1(%edi,%eax), %ebx
		movl	dsPrev(%edx), %edi
		movl	%ebx, scanend(%esp)
		movl	chainlenwmask(%esp), %edx
		jmp	LookupLoop

/* Accept the current string, with the maximum possible length.		*/

LenMaximum:	movl	deflatestate(%esp), %edx
		movl	$MAX_MATCH, bestlen(%esp)
		movl	%ecx, dsMatchStart(%edx)

/* if ((uInt)best_len <= s->lookahead) return (uInt)best_len;		*/
/* return s->lookahead;							*/

LeaveNow:
		movl	deflatestate(%esp), %edx
		movl	bestlen(%esp), %ebx
		movl	dsLookahead(%edx), %eax
		cmpl	%eax, %ebx
		jg	LookaheadRet
		movl	%ebx, %eax
LookaheadRet:

/* Restore the stack and return from whence we came.			*/

		addl	$LocalVarsSize, %esp
		.cfi_def_cfa_offset 20
		popl	%ebx
		.cfi_def_cfa_offset 16
		popl	%esi
		.cfi_def_cfa_offset 12
		popl	%edi
		.cfi_def_cfa_offset 8
		popl	%ebp
		.cfi_def_cfa_offset 4
.cfi_endproc
match_init:	ret

Deleted compat/zlib/contrib/blast/Makefile.

1
2
3
4
5
6
7
8








-
-
-
-
-
-
-
-
blast: blast.c blast.h
	cc -DTEST -o blast blast.c

test: blast
	blast < test.pk | cmp - test.txt

clean:
	rm -f blast blast.o

Deleted compat/zlib/contrib/blast/README.

1
2
3
4




-
-
-
-
Read blast.h for purpose and usage.

Mark Adler
madler@alumni.caltech.edu

Deleted compat/zlib/contrib/blast/blast.c.

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


















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* blast.c
 * Copyright (C) 2003, 2012, 2013 Mark Adler
 * For conditions of distribution and use, see copyright notice in blast.h
 * version 1.3, 24 Aug 2013
 *
 * blast.c decompresses data compressed by the PKWare Compression Library.
 * This function provides functionality similar to the explode() function of
 * the PKWare library, hence the name "blast".
 *
 * This decompressor is based on the excellent format description provided by
 * Ben Rudiak-Gould in comp.compression on August 13, 2001.  Interestingly, the
 * example Ben provided in the post is incorrect.  The distance 110001 should
 * instead be 111000.  When corrected, the example byte stream becomes:
 *
 *    00 04 82 24 25 8f 80 7f
 *
 * which decompresses to "AIAIAIAIAIAIA" (without the quotes).
 */

/*
 * Change history:
 *
 * 1.0  12 Feb 2003     - First version
 * 1.1  16 Feb 2003     - Fixed distance check for > 4 GB uncompressed data
 * 1.2  24 Oct 2012     - Add note about using binary mode in stdio
 *                      - Fix comparisons of differently signed integers
 * 1.3  24 Aug 2013     - Return unused input from blast()
 *                      - Fix test code to correctly report unused input
 *                      - Enable the provision of initial input to blast()
 */

#include <stddef.h>             /* for NULL */
#include <setjmp.h>             /* for setjmp(), longjmp(), and jmp_buf */
#include "blast.h"              /* prototype for blast() */

#define local static            /* for local function definitions */
#define MAXBITS 13              /* maximum code length */
#define MAXWIN 4096             /* maximum window size */

/* input and output state */
struct state {
    /* input state */
    blast_in infun;             /* input function provided by user */
    void *inhow;                /* opaque information passed to infun() */
    unsigned char *in;          /* next input location */
    unsigned left;              /* available input at in */
    int bitbuf;                 /* bit buffer */
    int bitcnt;                 /* number of bits in bit buffer */

    /* input limit error return state for bits() and decode() */
    jmp_buf env;

    /* output state */
    blast_out outfun;           /* output function provided by user */
    void *outhow;               /* opaque information passed to outfun() */
    unsigned next;              /* index of next write location in out[] */
    int first;                  /* true to check distances (for first 4K) */
    unsigned char out[MAXWIN];  /* output buffer and sliding window */
};

/*
 * Return need bits from the input stream.  This always leaves less than
 * eight bits in the buffer.  bits() works properly for need == 0.
 *
 * Format notes:
 *
 * - Bits are stored in bytes from the least significant bit to the most
 *   significant bit.  Therefore bits are dropped from the bottom of the bit
 *   buffer, using shift right, and new bytes are appended to the top of the
 *   bit buffer, using shift left.
 */
local int bits(struct state *s, int need)
{
    int val;            /* bit accumulator */

    /* load at least need bits into val */
    val = s->bitbuf;
    while (s->bitcnt < need) {
        if (s->left == 0) {
            s->left = s->infun(s->inhow, &(s->in));
            if (s->left == 0) longjmp(s->env, 1);       /* out of input */
        }
        val |= (int)(*(s->in)++) << s->bitcnt;          /* load eight bits */
        s->left--;
        s->bitcnt += 8;
    }

    /* drop need bits and update buffer, always zero to seven bits left */
    s->bitbuf = val >> need;
    s->bitcnt -= need;

    /* return need bits, zeroing the bits above that */
    return val & ((1 << need) - 1);
}

/*
 * Huffman code decoding tables.  count[1..MAXBITS] is the number of symbols of
 * each length, which for a canonical code are stepped through in order.
 * symbol[] are the symbol values in canonical order, where the number of
 * entries is the sum of the counts in count[].  The decoding process can be
 * seen in the function decode() below.
 */
struct huffman {
    short *count;       /* number of symbols of each length */
    short *symbol;      /* canonically ordered symbols */
};

/*
 * Decode a code from the stream s using huffman table h.  Return the symbol or
 * a negative value if there is an error.  If all of the lengths are zero, i.e.
 * an empty code, or if the code is incomplete and an invalid code is received,
 * then -9 is returned after reading MAXBITS bits.
 *
 * Format notes:
 *
 * - The codes as stored in the compressed data are bit-reversed relative to
 *   a simple integer ordering of codes of the same lengths.  Hence below the
 *   bits are pulled from the compressed data one at a time and used to
 *   build the code value reversed from what is in the stream in order to
 *   permit simple integer comparisons for decoding.
 *
 * - The first code for the shortest length is all ones.  Subsequent codes of
 *   the same length are simply integer decrements of the previous code.  When
 *   moving up a length, a one bit is appended to the code.  For a complete
 *   code, the last code of the longest length will be all zeros.  To support
 *   this ordering, the bits pulled during decoding are inverted to apply the
 *   more "natural" ordering starting with all zeros and incrementing.
 */
local int decode(struct state *s, struct huffman *h)
{
    int len;            /* current number of bits in code */
    int code;           /* len bits being decoded */
    int first;          /* first code of length len */
    int count;          /* number of codes of length len */
    int index;          /* index of first code of length len in symbol table */
    int bitbuf;         /* bits from stream */
    int left;           /* bits left in next or left to process */
    short *next;        /* next number of codes */

    bitbuf = s->bitbuf;
    left = s->bitcnt;
    code = first = index = 0;
    len = 1;
    next = h->count + 1;
    while (1) {
        while (left--) {
            code |= (bitbuf & 1) ^ 1;   /* invert code */
            bitbuf >>= 1;
            count = *next++;
            if (code < first + count) { /* if length len, return symbol */
                s->bitbuf = bitbuf;
                s->bitcnt = (s->bitcnt - len) & 7;
                return h->symbol[index + (code - first)];
            }
            index += count;             /* else update for next length */
            first += count;
            first <<= 1;
            code <<= 1;
            len++;
        }
        left = (MAXBITS+1) - len;
        if (left == 0) break;
        if (s->left == 0) {
            s->left = s->infun(s->inhow, &(s->in));
            if (s->left == 0) longjmp(s->env, 1);       /* out of input */
        }
        bitbuf = *(s->in)++;
        s->left--;
        if (left > 8) left = 8;
    }
    return -9;                          /* ran out of codes */
}

/*
 * Given a list of repeated code lengths rep[0..n-1], where each byte is a
 * count (high four bits + 1) and a code length (low four bits), generate the
 * list of code lengths.  This compaction reduces the size of the object code.
 * Then given the list of code lengths length[0..n-1] representing a canonical
 * Huffman code for n symbols, construct the tables required to decode those
 * codes.  Those tables are the number of codes of each length, and the symbols
 * sorted by length, retaining their original order within each length.  The
 * return value is zero for a complete code set, negative for an over-
 * subscribed code set, and positive for an incomplete code set.  The tables
 * can be used if the return value is zero or positive, but they cannot be used
 * if the return value is negative.  If the return value is zero, it is not
 * possible for decode() using that table to return an error--any stream of
 * enough bits will resolve to a symbol.  If the return value is positive, then
 * it is possible for decode() using that table to return an error for received
 * codes past the end of the incomplete lengths.
 */
local int construct(struct huffman *h, const unsigned char *rep, int n)
{
    int symbol;         /* current symbol when stepping through length[] */
    int len;            /* current length when stepping through h->count[] */
    int left;           /* number of possible codes left of current length */
    short offs[MAXBITS+1];      /* offsets in symbol table for each length */
    short length[256];  /* code lengths */

    /* convert compact repeat counts into symbol bit length list */
    symbol = 0;
    do {
        len = *rep++;
        left = (len >> 4) + 1;
        len &= 15;
        do {
            length[symbol++] = len;
        } while (--left);
    } while (--n);
    n = symbol;

    /* count number of codes of each length */
    for (len = 0; len <= MAXBITS; len++)
        h->count[len] = 0;
    for (symbol = 0; symbol < n; symbol++)
        (h->count[length[symbol]])++;   /* assumes lengths are within bounds */
    if (h->count[0] == n)               /* no codes! */
        return 0;                       /* complete, but decode() will fail */

    /* check for an over-subscribed or incomplete set of lengths */
    left = 1;                           /* one possible code of zero length */
    for (len = 1; len <= MAXBITS; len++) {
        left <<= 1;                     /* one more bit, double codes left */
        left -= h->count[len];          /* deduct count from possible codes */
        if (left < 0) return left;      /* over-subscribed--return negative */
    }                                   /* left > 0 means incomplete */

    /* generate offsets into symbol table for each length for sorting */
    offs[1] = 0;
    for (len = 1; len < MAXBITS; len++)
        offs[len + 1] = offs[len] + h->count[len];

    /*
     * put symbols in table sorted by length, by symbol order within each
     * length
     */
    for (symbol = 0; symbol < n; symbol++)
        if (length[symbol] != 0)
            h->symbol[offs[length[symbol]]++] = symbol;

    /* return zero for complete set, positive for incomplete set */
    return left;
}

/*
 * Decode PKWare Compression Library stream.
 *
 * Format notes:
 *
 * - First byte is 0 if literals are uncoded or 1 if they are coded.  Second
 *   byte is 4, 5, or 6 for the number of extra bits in the distance code.
 *   This is the base-2 logarithm of the dictionary size minus six.
 *
 * - Compressed data is a combination of literals and length/distance pairs
 *   terminated by an end code.  Literals are either Huffman coded or
 *   uncoded bytes.  A length/distance pair is a coded length followed by a
 *   coded distance to represent a string that occurs earlier in the
 *   uncompressed data that occurs again at the current location.
 *
 * - A bit preceding a literal or length/distance pair indicates which comes
 *   next, 0 for literals, 1 for length/distance.
 *
 * - If literals are uncoded, then the next eight bits are the literal, in the
 *   normal bit order in the stream, i.e. no bit-reversal is needed. Similarly,
 *   no bit reversal is needed for either the length extra bits or the distance
 *   extra bits.
 *
 * - Literal bytes are simply written to the output.  A length/distance pair is
 *   an instruction to copy previously uncompressed bytes to the output.  The
 *   copy is from distance bytes back in the output stream, copying for length
 *   bytes.
 *
 * - Distances pointing before the beginning of the output data are not
 *   permitted.
 *
 * - Overlapped copies, where the length is greater than the distance, are
 *   allowed and common.  For example, a distance of one and a length of 518
 *   simply copies the last byte 518 times.  A distance of four and a length of
 *   twelve copies the last four bytes three times.  A simple forward copy
 *   ignoring whether the length is greater than the distance or not implements
 *   this correctly.
 */
local int decomp(struct state *s)
{
    int lit;            /* true if literals are coded */
    int dict;           /* log2(dictionary size) - 6 */
    int symbol;         /* decoded symbol, extra bits for distance */
    int len;            /* length for copy */
    unsigned dist;      /* distance for copy */
    int copy;           /* copy counter */
    unsigned char *from, *to;   /* copy pointers */
    static int virgin = 1;                              /* build tables once */
    static short litcnt[MAXBITS+1], litsym[256];        /* litcode memory */
    static short lencnt[MAXBITS+1], lensym[16];         /* lencode memory */
    static short distcnt[MAXBITS+1], distsym[64];       /* distcode memory */
    static struct huffman litcode = {litcnt, litsym};   /* length code */
    static struct huffman lencode = {lencnt, lensym};   /* length code */
    static struct huffman distcode = {distcnt, distsym};/* distance code */
        /* bit lengths of literal codes */
    static const unsigned char litlen[] = {
        11, 124, 8, 7, 28, 7, 188, 13, 76, 4, 10, 8, 12, 10, 12, 10, 8, 23, 8,
        9, 7, 6, 7, 8, 7, 6, 55, 8, 23, 24, 12, 11, 7, 9, 11, 12, 6, 7, 22, 5,
        7, 24, 6, 11, 9, 6, 7, 22, 7, 11, 38, 7, 9, 8, 25, 11, 8, 11, 9, 12,
        8, 12, 5, 38, 5, 38, 5, 11, 7, 5, 6, 21, 6, 10, 53, 8, 7, 24, 10, 27,
        44, 253, 253, 253, 252, 252, 252, 13, 12, 45, 12, 45, 12, 61, 12, 45,
        44, 173};
        /* bit lengths of length codes 0..15 */
    static const unsigned char lenlen[] = {2, 35, 36, 53, 38, 23};
        /* bit lengths of distance codes 0..63 */
    static const unsigned char distlen[] = {2, 20, 53, 230, 247, 151, 248};
    static const short base[16] = {     /* base for length codes */
        3, 2, 4, 5, 6, 7, 8, 9, 10, 12, 16, 24, 40, 72, 136, 264};
    static const char extra[16] = {     /* extra bits for length codes */
        0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8};

    /* set up decoding tables (once--might not be thread-safe) */
    if (virgin) {
        construct(&litcode, litlen, sizeof(litlen));
        construct(&lencode, lenlen, sizeof(lenlen));
        construct(&distcode, distlen, sizeof(distlen));
        virgin = 0;
    }

    /* read header */
    lit = bits(s, 8);
    if (lit > 1) return -1;
    dict = bits(s, 8);
    if (dict < 4 || dict > 6) return -2;

    /* decode literals and length/distance pairs */
    do {
        if (bits(s, 1)) {
            /* get length */
            symbol = decode(s, &lencode);
            len = base[symbol] + bits(s, extra[symbol]);
            if (len == 519) break;              /* end code */

            /* get distance */
            symbol = len == 2 ? 2 : dict;
            dist = decode(s, &distcode) << symbol;
            dist += bits(s, symbol);
            dist++;
            if (s->first && dist > s->next)
                return -3;              /* distance too far back */

            /* copy length bytes from distance bytes back */
            do {
                to = s->out + s->next;
                from = to - dist;
                copy = MAXWIN;
                if (s->next < dist) {
                    from += copy;
                    copy = dist;
                }
                copy -= s->next;
                if (copy > len) copy = len;
                len -= copy;
                s->next += copy;
                do {
                    *to++ = *from++;
                } while (--copy);
                if (s->next == MAXWIN) {
                    if (s->outfun(s->outhow, s->out, s->next)) return 1;
                    s->next = 0;
                    s->first = 0;
                }
            } while (len != 0);
        }
        else {
            /* get literal and write it */
            symbol = lit ? decode(s, &litcode) : bits(s, 8);
            s->out[s->next++] = symbol;
            if (s->next == MAXWIN) {
                if (s->outfun(s->outhow, s->out, s->next)) return 1;
                s->next = 0;
                s->first = 0;
            }
        }
    } while (1);
    return 0;
}

/* See comments in blast.h */
int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow,
          unsigned *left, unsigned char **in)
{
    struct state s;             /* input/output state */
    int err;                    /* return value */

    /* initialize input state */
    s.infun = infun;
    s.inhow = inhow;
    if (left != NULL && *left) {
        s.left = *left;
        s.in = *in;
    }
    else
        s.left = 0;
    s.bitbuf = 0;
    s.bitcnt = 0;

    /* initialize output state */
    s.outfun = outfun;
    s.outhow = outhow;
    s.next = 0;
    s.first = 1;

    /* return if bits() or decode() tries to read past available input */
    if (setjmp(s.env) != 0)             /* if came back here via longjmp(), */
        err = 2;                        /*  then skip decomp(), return error */
    else
        err = decomp(&s);               /* decompress */

    /* return unused input */
    if (left != NULL)
        *left = s.left;
    if (in != NULL)
        *in = s.left ? s.in : NULL;

    /* write any leftover output and update the error code if needed */
    if (err != 1 && s.next && s.outfun(s.outhow, s.out, s.next) && err == 0)
        err = 1;
    return err;
}

#ifdef TEST
/* Example of how to use blast() */
#include <stdio.h>
#include <stdlib.h>

#define CHUNK 16384

local unsigned inf(void *how, unsigned char **buf)
{
    static unsigned char hold[CHUNK];

    *buf = hold;
    return fread(hold, 1, CHUNK, (FILE *)how);
}

local int outf(void *how, unsigned char *buf, unsigned len)
{
    return fwrite(buf, 1, len, (FILE *)how) != len;
}

/* Decompress a PKWare Compression Library stream from stdin to stdout */
int main(void)
{
    int ret;
    unsigned left;

    /* decompress to stdout */
    left = 0;
    ret = blast(inf, stdin, outf, stdout, &left, NULL);
    if (ret != 0)
        fprintf(stderr, "blast error: %d\n", ret);

    /* count any leftover bytes */
    while (getchar() != EOF)
        left++;
    if (left)
        fprintf(stderr, "blast warning: %u unused bytes of input\n", left);

    /* return blast() error code */
    return ret;
}
#endif

Deleted compat/zlib/contrib/blast/blast.h.

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



















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* blast.h -- interface for blast.c
  Copyright (C) 2003, 2012, 2013 Mark Adler
  version 1.3, 24 Aug 2013

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the author be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Mark Adler    madler@alumni.caltech.edu
 */


/*
 * blast() decompresses the PKWare Data Compression Library (DCL) compressed
 * format.  It provides the same functionality as the explode() function in
 * that library.  (Note: PKWare overused the "implode" verb, and the format
 * used by their library implode() function is completely different and
 * incompatible with the implode compression method supported by PKZIP.)
 *
 * The binary mode for stdio functions should be used to assure that the
 * compressed data is not corrupted when read or written.  For example:
 * fopen(..., "rb") and fopen(..., "wb").
 */


typedef unsigned (*blast_in)(void *how, unsigned char **buf);
typedef int (*blast_out)(void *how, unsigned char *buf, unsigned len);
/* Definitions for input/output functions passed to blast().  See below for
 * what the provided functions need to do.
 */


int blast(blast_in infun, void *inhow, blast_out outfun, void *outhow,
          unsigned *left, unsigned char **in);
/* Decompress input to output using the provided infun() and outfun() calls.
 * On success, the return value of blast() is zero.  If there is an error in
 * the source data, i.e. it is not in the proper format, then a negative value
 * is returned.  If there is not enough input available or there is not enough
 * output space, then a positive error is returned.
 *
 * The input function is invoked: len = infun(how, &buf), where buf is set by
 * infun() to point to the input buffer, and infun() returns the number of
 * available bytes there.  If infun() returns zero, then blast() returns with
 * an input error.  (blast() only asks for input if it needs it.)  inhow is for
 * use by the application to pass an input descriptor to infun(), if desired.
 *
 * If left and in are not NULL and *left is not zero when blast() is called,
 * then the *left bytes are *in are consumed for input before infun() is used.
 *
 * The output function is invoked: err = outfun(how, buf, len), where the bytes
 * to be written are buf[0..len-1].  If err is not zero, then blast() returns
 * with an output error.  outfun() is always called with len <= 4096.  outhow
 * is for use by the application to pass an output descriptor to outfun(), if
 * desired.
 *
 * If there is any unused input, *left is set to the number of bytes that were
 * read and *in points to them.  Otherwise *left is set to zero and *in is set
 * to NULL.  If left or in are NULL, then they are not set.
 *
 * The return codes are:
 *
 *   2:  ran out of input before completing decompression
 *   1:  output error before completing decompression
 *   0:  successful decompression
 *  -1:  literal flag not zero or one
 *  -2:  dictionary size not in 4..6
 *  -3:  distance is too far back
 *
 * At the bottom of blast.c is an example program that uses blast() that can be
 * compiled to produce a command-line decompression filter by defining TEST.
 */

Deleted compat/zlib/contrib/blast/test.pk.

cannot compute difference between binary files

Deleted compat/zlib/contrib/blast/test.txt.

1

-
AIAIAIAIAIAIA

Deleted compat/zlib/contrib/delphi/ZLib.pas.

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
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
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
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













































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
{*******************************************************}
{                                                       }
{       Borland Delphi Supplemental Components          }
{       ZLIB Data Compression Interface Unit            }
{                                                       }
{       Copyright (c) 1997,99 Borland Corporation       }
{                                                       }
{*******************************************************}

{ Updated for zlib 1.2.x by Cosmin Truta <cosmint@cs.ubbcluj.ro> }

unit ZLib;

interface

uses SysUtils, Classes;

type
  TAlloc = function (AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
  TFree = procedure (AppData, Block: Pointer); cdecl;

  // Internal structure.  Ignore.
  TZStreamRec = packed record
    next_in: PChar;       // next input byte
    avail_in: Integer;    // number of bytes available at next_in
    total_in: Longint;    // total nb of input bytes read so far

    next_out: PChar;      // next output byte should be put here
    avail_out: Integer;   // remaining free space at next_out
    total_out: Longint;   // total nb of bytes output so far

    msg: PChar;           // last error message, NULL if no error
    internal: Pointer;    // not visible by applications

    zalloc: TAlloc;       // used to allocate the internal state
    zfree: TFree;         // used to free the internal state
    AppData: Pointer;     // private data object passed to zalloc and zfree

    data_type: Integer;   // best guess about the data type: ascii or binary
    adler: Longint;       // adler32 value of the uncompressed data
    reserved: Longint;    // reserved for future use
  end;

  // Abstract ancestor class
  TCustomZlibStream = class(TStream)
  private
    FStrm: TStream;
    FStrmPos: Integer;
    FOnProgress: TNotifyEvent;
    FZRec: TZStreamRec;
    FBuffer: array [Word] of Char;
  protected
    procedure Progress(Sender: TObject); dynamic;
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
    constructor Create(Strm: TStream);
  end;

{ TCompressionStream compresses data on the fly as data is written to it, and
  stores the compressed data to another stream.

  TCompressionStream is write-only and strictly sequential. Reading from the
  stream will raise an exception. Using Seek to move the stream pointer
  will raise an exception.

  Output data is cached internally, written to the output stream only when
  the internal output buffer is full.  All pending output data is flushed
  when the stream is destroyed.

  The Position property returns the number of uncompressed bytes of
  data that have been written to the stream so far.

  CompressionRate returns the on-the-fly percentage by which the original
  data has been compressed:  (1 - (CompressedBytes / UncompressedBytes)) * 100
  If raw data size = 100 and compressed data size = 25, the CompressionRate
  is 75%

  The OnProgress event is called each time the output buffer is filled and
  written to the output stream.  This is useful for updating a progress
  indicator when you are writing a large chunk of data to the compression
  stream in a single call.}


  TCompressionLevel = (clNone, clFastest, clDefault, clMax);

  TCompressionStream = class(TCustomZlibStream)
  private
    function GetCompressionRate: Single;
  public
    constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property CompressionRate: Single read GetCompressionRate;
    property OnProgress;
  end;

{ TDecompressionStream decompresses data on the fly as data is read from it.

  Compressed data comes from a separate source stream.  TDecompressionStream
  is read-only and unidirectional; you can seek forward in the stream, but not
  backwards.  The special case of setting the stream position to zero is
  allowed.  Seeking forward decompresses data until the requested position in
  the uncompressed data has been reached.  Seeking backwards, seeking relative
  to the end of the stream, requesting the size of the stream, and writing to
  the stream will raise an exception.

  The Position property returns the number of bytes of uncompressed data that
  have been read from the stream so far.

  The OnProgress event is called each time the internal input buffer of
  compressed data is exhausted and the next block is read from the input stream.
  This is useful for updating a progress indicator when you are reading a
  large chunk of data from the decompression stream in a single call.}

  TDecompressionStream = class(TCustomZlibStream)
  public
    constructor Create(Source: TStream);
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property OnProgress;
  end;



{ CompressBuf compresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
                      out OutBuf: Pointer; out OutBytes: Integer);


{ DecompressBuf decompresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
       OutEstimate = zero, or est. size of the decompressed data
  Out: OutBuf = ptr to newly allocated buffer containing decompressed data
       OutBytes = number of bytes in OutBuf   }
procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
 OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);

{ DecompressToUserBuf decompresses data, buffer to buffer, in one call.
   In: InBuf = ptr to compressed data
       InBytes = number of bytes in InBuf
  Out: OutBuf = ptr to user-allocated buffer to contain decompressed data
       BufSize = number of bytes in OutBuf   }
procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
  const OutBuf: Pointer; BufSize: Integer);

const
  zlib_version = '1.2.11';

type
  EZlibError = class(Exception);
  ECompressionError = class(EZlibError);
  EDecompressionError = class(EZlibError);

implementation

uses ZLibConst;

const
  Z_NO_FLUSH      = 0;
  Z_PARTIAL_FLUSH = 1;
  Z_SYNC_FLUSH    = 2;
  Z_FULL_FLUSH    = 3;
  Z_FINISH        = 4;

  Z_OK            = 0;
  Z_STREAM_END    = 1;
  Z_NEED_DICT     = 2;
  Z_ERRNO         = (-1);
  Z_STREAM_ERROR  = (-2);
  Z_DATA_ERROR    = (-3);
  Z_MEM_ERROR     = (-4);
  Z_BUF_ERROR     = (-5);
  Z_VERSION_ERROR = (-6);

  Z_NO_COMPRESSION       =   0;
  Z_BEST_SPEED           =   1;
  Z_BEST_COMPRESSION     =   9;
  Z_DEFAULT_COMPRESSION  = (-1);

  Z_FILTERED            = 1;
  Z_HUFFMAN_ONLY        = 2;
  Z_RLE                 = 3;
  Z_DEFAULT_STRATEGY    = 0;

  Z_BINARY   = 0;
  Z_ASCII    = 1;
  Z_UNKNOWN  = 2;

  Z_DEFLATED = 8;


{$L adler32.obj}
{$L compress.obj}
{$L crc32.obj}
{$L deflate.obj}
{$L infback.obj}
{$L inffast.obj}
{$L inflate.obj}
{$L inftrees.obj}
{$L trees.obj}
{$L uncompr.obj}
{$L zutil.obj}

procedure adler32; external;
procedure compressBound; external;
procedure crc32; external;
procedure deflateInit2_; external;
procedure deflateParams; external;

function _malloc(Size: Integer): Pointer; cdecl;
begin
  Result := AllocMem(Size);
end;

procedure _free(Block: Pointer); cdecl;
begin
  FreeMem(Block);
end;

procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
  FillChar(P^, count, B);
end;

procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
  Move(source^, dest^, count);
end;



// deflate compresses data
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  recsize: Integer): Integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function deflateEnd(var strm: TZStreamRec): Integer; external;

// inflate decompresses data
function inflateInit_(var strm: TZStreamRec; version: PChar;
  recsize: Integer): Integer; external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer; external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;


function zlibAllocMem(AppData: Pointer; Items, Size: Integer): Pointer; cdecl;
begin
//  GetMem(Result, Items*Size);
  Result := AllocMem(Items * Size);
end;

procedure zlibFreeMem(AppData, Block: Pointer); cdecl;
begin
  FreeMem(Block);
end;

{function zlibCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EZlibError.Create('error');    //!!
end;}

function CCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise ECompressionError.Create('error'); //!!
end;

function DCheck(code: Integer): Integer;
begin
  Result := code;
  if code < 0 then
    raise EDecompressionError.Create('error');  //!!
end;

procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
                      out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TZStreamRec;
  P: Pointer;
begin
  FillChar(strm, sizeof(strm), 0);
  strm.zalloc := zlibAllocMem;
  strm.zfree := zlibFreeMem;
  OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    CCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlib_version, sizeof(strm)));
    try
      while CCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, 256);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
        strm.avail_out := 256;
      end;
    finally
      CCheck(deflateEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out);
    OutBytes := strm.total_out;
  except
    FreeMem(OutBuf);
    raise
  end;
end;


procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
  OutEstimate: Integer; out OutBuf: Pointer; out OutBytes: Integer);
var
  strm: TZStreamRec;
  P: Pointer;
  BufInc: Integer;
begin
  FillChar(strm, sizeof(strm), 0);
  strm.zalloc := zlibAllocMem;
  strm.zfree := zlibFreeMem;
  BufInc := (InBytes + 255) and not 255;
  if OutEstimate = 0 then
    OutBytes := BufInc
  else
    OutBytes := OutEstimate;
  GetMem(OutBuf, OutBytes);
  try
    strm.next_in := InBuf;
    strm.avail_in := InBytes;
    strm.next_out := OutBuf;
    strm.avail_out := OutBytes;
    DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
    try
      while DCheck(inflate(strm, Z_NO_FLUSH)) <> Z_STREAM_END do
      begin
        P := OutBuf;
        Inc(OutBytes, BufInc);
        ReallocMem(OutBuf, OutBytes);
        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
        strm.avail_out := BufInc;
      end;
    finally
      DCheck(inflateEnd(strm));
    end;
    ReallocMem(OutBuf, strm.total_out);
    OutBytes := strm.total_out;
  except
    FreeMem(OutBuf);
    raise
  end;
end;

procedure DecompressToUserBuf(const InBuf: Pointer; InBytes: Integer;
  const OutBuf: Pointer; BufSize: Integer);
var
  strm: TZStreamRec;
begin
  FillChar(strm, sizeof(strm), 0);
  strm.zalloc := zlibAllocMem;
  strm.zfree := zlibFreeMem;
  strm.next_in := InBuf;
  strm.avail_in := InBytes;
  strm.next_out := OutBuf;
  strm.avail_out := BufSize;
  DCheck(inflateInit_(strm, zlib_version, sizeof(strm)));
  try
    if DCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END then
      raise EZlibError.CreateRes(@sTargetBufferTooSmall);
  finally
    DCheck(inflateEnd(strm));
  end;
end;

// TCustomZlibStream

constructor TCustomZLibStream.Create(Strm: TStream);
begin
  inherited Create;
  FStrm := Strm;
  FStrmPos := Strm.Position;
  FZRec.zalloc := zlibAllocMem;
  FZRec.zfree := zlibFreeMem;
end;

procedure TCustomZLibStream.Progress(Sender: TObject);
begin
  if Assigned(FOnProgress) then FOnProgress(Sender);
end;


// TCompressionStream

constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
  Dest: TStream);
const
  Levels: array [TCompressionLevel] of ShortInt =
    (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
begin
  inherited Create(Dest);
  FZRec.next_out := FBuffer;
  FZRec.avail_out := sizeof(FBuffer);
  CCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlib_version, sizeof(FZRec)));
end;

destructor TCompressionStream.Destroy;
begin
  FZRec.next_in := nil;
  FZRec.avail_in := 0;
  try
    if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
    while (CCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
      and (FZRec.avail_out = 0) do
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);
    end;
    if FZRec.avail_out < sizeof(FBuffer) then
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
  finally
    deflateEnd(FZRec);
  end;
  inherited Destroy;
end;

function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  raise ECompressionError.CreateRes(@sInvalidStreamOp);
end;

function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  FZRec.next_in := @Buffer;
  FZRec.avail_in := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FZRec.avail_in > 0) do
  begin
    CCheck(deflate(FZRec, 0));
    if FZRec.avail_out = 0 then
    begin
      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
      FZRec.next_out := FBuffer;
      FZRec.avail_out := sizeof(FBuffer);
      FStrmPos := FStrm.Position;
      Progress(Self);
    end;
  end;
  Result := Count;
end;

function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  if (Offset = 0) and (Origin = soFromCurrent) then
    Result := FZRec.total_in
  else
    raise ECompressionError.CreateRes(@sInvalidStreamOp);
end;

function TCompressionStream.GetCompressionRate: Single;
begin
  if FZRec.total_in = 0 then
    Result := 0
  else
    Result := (1.0 - (FZRec.total_out / FZRec.total_in)) * 100.0;
end;


// TDecompressionStream

constructor TDecompressionStream.Create(Source: TStream);
begin
  inherited Create(Source);
  FZRec.next_in := FBuffer;
  FZRec.avail_in := 0;
  DCheck(inflateInit_(FZRec, zlib_version, sizeof(FZRec)));
end;

destructor TDecompressionStream.Destroy;
begin
  FStrm.Seek(-FZRec.avail_in, 1);
  inflateEnd(FZRec);
  inherited Destroy;
end;

function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
begin
  FZRec.next_out := @Buffer;
  FZRec.avail_out := Count;
  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
  while (FZRec.avail_out > 0) do
  begin
    if FZRec.avail_in = 0 then
    begin
      FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
      if FZRec.avail_in = 0 then
      begin
        Result := Count - FZRec.avail_out;
        Exit;
      end;
      FZRec.next_in := FBuffer;
      FStrmPos := FStrm.Position;
      Progress(Self);
    end;
    CCheck(inflate(FZRec, 0));
  end;
  Result := Count;
end;

function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  raise EDecompressionError.CreateRes(@sInvalidStreamOp);
end;

function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
var
  I: Integer;
  Buf: array [0..4095] of Char;
begin
  if (Offset = 0) and (Origin = soFromBeginning) then
  begin
    DCheck(inflateReset(FZRec));
    FZRec.next_in := FBuffer;
    FZRec.avail_in := 0;
    FStrm.Position := 0;
    FStrmPos := 0;
  end
  else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
          ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
  begin
    if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
    if Offset > 0 then
    begin
      for I := 1 to Offset div sizeof(Buf) do
        ReadBuffer(Buf, sizeof(Buf));
      ReadBuffer(Buf, Offset mod sizeof(Buf));
    end;
  end
  else
    raise EDecompressionError.CreateRes(@sInvalidStreamOp);
  Result := FZRec.total_out;
end;


end.

Deleted compat/zlib/contrib/delphi/ZLibConst.pas.

1
2
3
4
5
6
7
8
9
10
11











-
-
-
-
-
-
-
-
-
-
-
unit ZLibConst;

interface

resourcestring
  sTargetBufferTooSmall = 'ZLib error: target buffer may be too small';
  sInvalidStreamOp = 'Invalid stream operation';

implementation

end.

Deleted compat/zlib/contrib/delphi/readme.txt.

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












































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Overview
========

This directory contains an update to the ZLib interface unit,
distributed by Borland as a Delphi supplemental component.

The original ZLib unit is Copyright (c) 1997,99 Borland Corp.,
and is based on zlib version 1.0.4.  There are a series of bugs
and security problems associated with that old zlib version, and
we recommend the users to update their ZLib unit.


Summary of modifications
========================

- Improved makefile, adapted to zlib version 1.2.1.

- Some field types from TZStreamRec are changed from Integer to
  Longint, for consistency with the zlib.h header, and for 64-bit
  readiness.

- The zlib_version constant is updated.

- The new Z_RLE strategy has its corresponding symbolic constant.

- The allocation and deallocation functions and function types
  (TAlloc, TFree, zlibAllocMem and zlibFreeMem) are now cdecl,
  and _malloc and _free are added as C RTL stubs.  As a result,
  the original C sources of zlib can be compiled out of the box,
  and linked to the ZLib unit.


Suggestions for improvements
============================

Currently, the ZLib unit provides only a limited wrapper around
the zlib library, and much of the original zlib functionality is
missing.  Handling compressed file formats like ZIP/GZIP or PNG
cannot be implemented without having this functionality.
Applications that handle these formats are either using their own,
duplicated code, or not using the ZLib unit at all.

Here are a few suggestions:

- Checksum class wrappers around adler32() and crc32(), similar
  to the Java classes that implement the java.util.zip.Checksum
  interface.

- The ability to read and write raw deflate streams, without the
  zlib stream header and trailer.  Raw deflate streams are used
  in the ZIP file format.

- The ability to read and write gzip streams, used in the GZIP
  file format, and normally produced by the gzip program.

- The ability to select a different compression strategy, useful
  to PNG and MNG image compression, and to multimedia compression
  in general.  Besides the compression level

    TCompressionLevel = (clNone, clFastest, clDefault, clMax);

  which, in fact, could have used the 'z' prefix and avoided
  TColor-like symbols

    TCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);

  there could be a compression strategy

    TCompressionStrategy = (zsDefault, zsFiltered, zsHuffmanOnly, zsRle);

- ZIP and GZIP stream handling via TStreams.


--
Cosmin Truta <cosmint@cs.ubbcluj.ro>

Deleted compat/zlib/contrib/delphi/zlibd32.mak.

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



































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# For use with Delphi and C++ Builder under Win32
# Updated for zlib 1.2.x by Cosmin Truta

# ------------ Borland C++ ------------

# This project uses the Delphi (fastcall/register) calling convention:
LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl

CC = bcc32
LD = bcc32
AR = tlib
# do not use "-pr" in CFLAGS
CFLAGS = -a -d -k- -O2 $(LOC)
LDFLAGS =


# variables
ZLIB_LIB = zlib.lib

OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj


# targets
all: $(ZLIB_LIB) example.exe minigzip.exe

.c.obj:
	$(CC) -c $(CFLAGS) $*.c

adler32.obj: adler32.c zlib.h zconf.h

compress.obj: compress.c zlib.h zconf.h

crc32.obj: crc32.c zlib.h zconf.h crc32.h

deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h

gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h

gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h

gzread.obj: gzread.c zlib.h zconf.h gzguts.h

gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h

infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h

inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h

trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h

uncompr.obj: uncompr.c zlib.h zconf.h

zutil.obj: zutil.c zutil.h zlib.h zconf.h

example.obj: test/example.c zlib.h zconf.h

minigzip.obj: test/minigzip.c zlib.h zconf.h


# For the sake of the old Borland make,
# the command line is cut to fit in the MS-DOS 128 byte limit:
$(ZLIB_LIB): $(OBJ1) $(OBJ2)
	-del $(ZLIB_LIB)
	$(AR) $(ZLIB_LIB) $(OBJP1)
	$(AR) $(ZLIB_LIB) $(OBJP2)


# testing
test: example.exe minigzip.exe
	example
	echo hello world | minigzip | minigzip -d

example.exe: example.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)

minigzip.exe: minigzip.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)


# cleanup
clean:
	-del *.obj
	-del *.exe
	-del *.lib
	-del *.tds
	-del zlib.bak
	-del foo.gz

Deleted compat/zlib/contrib/dotzlib/DotZLib.build.

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

































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8" ?>
<project name="DotZLib" default="build" basedir="./DotZLib">
	<description>A .Net wrapper library around ZLib1.dll</description>

	<property name="nunit.location" value="c:/program files/NUnit V2.1/bin" />
	<property name="build.root" value="bin" />

	<property name="debug" value="true" />
	<property name="nunit" value="true" />

	<property name="build.folder" value="${build.root}/debug/" if="${debug}" />
	<property name="build.folder" value="${build.root}/release/" unless="${debug}" />

	<target name="clean" description="Remove all generated files">
		<delete dir="${build.root}" failonerror="false" />
	</target>

	<target name="build" description="compiles the source code">

		<mkdir dir="${build.folder}" />
		<csc target="library" output="${build.folder}DotZLib.dll" debug="${debug}">
			<references basedir="${nunit.location}">
				<includes if="${nunit}" name="nunit.framework.dll" />
			</references>
			<sources>
				<includes name="*.cs" />
				<excludes name="UnitTests.cs" unless="${nunit}" />
			</sources>
			<arg value="/d:nunit" if="${nunit}" />
		</csc>
	</target>

</project>

Deleted compat/zlib/contrib/dotzlib/DotZLib.chm.

cannot compute difference between binary files

Deleted compat/zlib/contrib/dotzlib/DotZLib.sln.

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





















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Microsoft Visual Studio Solution File, Format Version 8.00
Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "DotZLib", "DotZLib\DotZLib.csproj", "{BB1EE0B1-1808-46CB-B786-949D91117FC5}"
	ProjectSection(ProjectDependencies) = postProject
	EndProjectSection
EndProject
Global
	GlobalSection(SolutionConfiguration) = preSolution
		Debug = Debug
		Release = Release
	EndGlobalSection
	GlobalSection(ProjectConfiguration) = postSolution
		{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.ActiveCfg = Debug|.NET
		{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Debug.Build.0 = Debug|.NET
		{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.ActiveCfg = Release|.NET
		{BB1EE0B1-1808-46CB-B786-949D91117FC5}.Release.Build.0 = Release|.NET
	EndGlobalSection
	GlobalSection(ExtensibilityGlobals) = postSolution
	EndGlobalSection
	GlobalSection(ExtensibilityAddIns) = postSolution
	EndGlobalSection
EndGlobal

Deleted compat/zlib/contrib/dotzlib/DotZLib/AssemblyInfo.cs.

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


























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
using System.Reflection;
using System.Runtime.CompilerServices;

//
// General Information about an assembly is controlled through the following
// set of attributes. Change these attribute values to modify the information
// associated with an assembly.
//
[assembly: AssemblyTitle("DotZLib")]
[assembly: AssemblyDescription(".Net bindings for ZLib compression dll 1.2.x")]
[assembly: AssemblyConfiguration("")]
[assembly: AssemblyCompany("Henrik Ravn")]
[assembly: AssemblyProduct("")]
[assembly: AssemblyCopyright("(c) 2004 by Henrik Ravn")]
[assembly: AssemblyTrademark("")]
[assembly: AssemblyCulture("")]

//
// Version information for an assembly consists of the following four values:
//
//      Major Version
//      Minor Version
//      Build Number
//      Revision
//
// You can specify all the values or you can default the Revision and Build Numbers
// by using the '*' as shown below:

[assembly: AssemblyVersion("1.0.*")]

//
// In order to sign your assembly you must specify a key to use. Refer to the
// Microsoft .NET Framework documentation for more information on assembly signing.
//
// Use the attributes below to control which key is used for signing.
//
// Notes:
//   (*) If no key is specified, the assembly is not signed.
//   (*) KeyName refers to a key that has been installed in the Crypto Service
//       Provider (CSP) on your machine. KeyFile refers to a file which contains
//       a key.
//   (*) If the KeyFile and the KeyName values are both specified, the
//       following processing occurs:
//       (1) If the KeyName can be found in the CSP, that key is used.
//       (2) If the KeyName does not exist and the KeyFile does exist, the key
//           in the KeyFile is installed into the CSP and used.
//   (*) In order to create a KeyFile, you can use the sn.exe (Strong Name) utility.
//       When specifying the KeyFile, the location of the KeyFile should be
//       relative to the project output directory which is
//       %Project Directory%\obj\<configuration>. For example, if your KeyFile is
//       located in the project directory, you would specify the AssemblyKeyFile
//       attribute as [assembly: AssemblyKeyFile("..\\..\\mykey.snk")]
//   (*) Delay Signing is an advanced option - see the Microsoft .NET Framework
//       documentation for more information on this.
//
[assembly: AssemblyDelaySign(false)]
[assembly: AssemblyKeyFile("")]
[assembly: AssemblyKeyName("")]

Deleted compat/zlib/contrib/dotzlib/DotZLib/ChecksumImpl.cs.

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










































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.Runtime.InteropServices;
using System.Text;


namespace DotZLib
{
    #region ChecksumGeneratorBase
    /// <summary>
    /// Implements the common functionality needed for all <see cref="ChecksumGenerator"/>s
    /// </summary>
    /// <example></example>
    public abstract class ChecksumGeneratorBase : ChecksumGenerator
    {
        /// <summary>
        /// The value of the current checksum
        /// </summary>
        protected uint _current;

        /// <summary>
        /// Initializes a new instance of the checksum generator base - the current checksum is
        /// set to zero
        /// </summary>
        public ChecksumGeneratorBase()
        {
            _current = 0;
        }

        /// <summary>
        /// Initializes a new instance of the checksum generator basewith a specified value
        /// </summary>
        /// <param name="initialValue">The value to set the current checksum to</param>
        public ChecksumGeneratorBase(uint initialValue)
        {
            _current = initialValue;
        }

        /// <summary>
        /// Resets the current checksum to zero
        /// </summary>
        public void Reset() { _current = 0; }

        /// <summary>
        /// Gets the current checksum value
        /// </summary>
        public uint Value { get { return _current; } }

        /// <summary>
        /// Updates the current checksum with part of an array of bytes
        /// </summary>
        /// <param name="data">The data to update the checksum with</param>
        /// <param name="offset">Where in <c>data</c> to start updating</param>
        /// <param name="count">The number of bytes from <c>data</c> to use</param>
        /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
        /// <exception cref="NullReferenceException"><c>data</c> is a null reference</exception>
        /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
        /// <remarks>All the other <c>Update</c> methods are implmeneted in terms of this one.
        /// This is therefore the only method a derived class has to implement</remarks>
        public abstract void Update(byte[] data, int offset, int count);

        /// <summary>
        /// Updates the current checksum with an array of bytes.
        /// </summary>
        /// <param name="data">The data to update the checksum with</param>
        public void Update(byte[] data)
        {
            Update(data, 0, data.Length);
        }

        /// <summary>
        /// Updates the current checksum with the data from a string
        /// </summary>
        /// <param name="data">The string to update the checksum with</param>
        /// <remarks>The characters in the string are converted by the UTF-8 encoding</remarks>
        public void Update(string data)
        {
			Update(Encoding.UTF8.GetBytes(data));
        }

        /// <summary>
        /// Updates the current checksum with the data from a string, using a specific encoding
        /// </summary>
        /// <param name="data">The string to update the checksum with</param>
        /// <param name="encoding">The encoding to use</param>
        public void Update(string data, Encoding encoding)
        {
            Update(encoding.GetBytes(data));
        }

    }
    #endregion

    #region CRC32
    /// <summary>
    /// Implements a CRC32 checksum generator
    /// </summary>
    public sealed class CRC32Checksum : ChecksumGeneratorBase
    {
        #region DLL imports

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern uint crc32(uint crc, int data, uint length);

        #endregion

        /// <summary>
        /// Initializes a new instance of the CRC32 checksum generator
        /// </summary>
        public CRC32Checksum() : base() {}

        /// <summary>
        /// Initializes a new instance of the CRC32 checksum generator with a specified value
        /// </summary>
        /// <param name="initialValue">The value to set the current checksum to</param>
        public CRC32Checksum(uint initialValue) : base(initialValue) {}

        /// <summary>
        /// Updates the current checksum with part of an array of bytes
        /// </summary>
        /// <param name="data">The data to update the checksum with</param>
        /// <param name="offset">Where in <c>data</c> to start updating</param>
        /// <param name="count">The number of bytes from <c>data</c> to use</param>
        /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
        /// <exception cref="NullReferenceException"><c>data</c> is a null reference</exception>
        /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
        public override void Update(byte[] data, int offset, int count)
        {
            if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
            if ((offset+count) > data.Length) throw new ArgumentException();
            GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned);
            try
            {
                _current = crc32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count);
            }
            finally
            {
                hData.Free();
            }
        }

    }
    #endregion

    #region Adler
    /// <summary>
    /// Implements a checksum generator that computes the Adler checksum on data
    /// </summary>
    public sealed class AdlerChecksum : ChecksumGeneratorBase
    {
        #region DLL imports

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern uint adler32(uint adler, int data, uint length);

        #endregion

        /// <summary>
        /// Initializes a new instance of the Adler checksum generator
        /// </summary>
        public AdlerChecksum() : base() {}

        /// <summary>
        /// Initializes a new instance of the Adler checksum generator with a specified value
        /// </summary>
        /// <param name="initialValue">The value to set the current checksum to</param>
        public AdlerChecksum(uint initialValue) : base(initialValue) {}

        /// <summary>
        /// Updates the current checksum with part of an array of bytes
        /// </summary>
        /// <param name="data">The data to update the checksum with</param>
        /// <param name="offset">Where in <c>data</c> to start updating</param>
        /// <param name="count">The number of bytes from <c>data</c> to use</param>
        /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
        /// <exception cref="NullReferenceException"><c>data</c> is a null reference</exception>
        /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
        public override void Update(byte[] data, int offset, int count)
        {
            if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
            if ((offset+count) > data.Length) throw new ArgumentException();
            GCHandle hData = GCHandle.Alloc(data, GCHandleType.Pinned);
            try
            {
                _current = adler32(_current, hData.AddrOfPinnedObject().ToInt32()+offset, (uint)count);
            }
            finally
            {
                hData.Free();
            }
        }

    }
    #endregion

}

Deleted compat/zlib/contrib/dotzlib/DotZLib/CircularBuffer.cs.

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



















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.Diagnostics;

namespace DotZLib
{

	/// <summary>
	/// This class implements a circular buffer
	/// </summary>
	internal class CircularBuffer
	{
        #region Private data
        private int _capacity;
        private int _head;
        private int _tail;
        private int _size;
        private byte[] _buffer;
        #endregion

        public CircularBuffer(int capacity)
        {
            Debug.Assert( capacity > 0 );
            _buffer = new byte[capacity];
            _capacity = capacity;
            _head = 0;
            _tail = 0;
            _size = 0;
        }

        public int Size { get { return _size; } }

        public int Put(byte[] source, int offset, int count)
        {
            Debug.Assert( count > 0 );
            int trueCount = Math.Min(count, _capacity - Size);
            for (int i = 0; i < trueCount; ++i)
                _buffer[(_tail+i) % _capacity] = source[offset+i];
            _tail += trueCount;
            _tail %= _capacity;
            _size += trueCount;
            return trueCount;
        }

        public bool Put(byte b)
        {
            if (Size == _capacity) // no room
                return false;
            _buffer[_tail++] = b;
            _tail %= _capacity;
            ++_size;
            return true;
        }

        public int Get(byte[] destination, int offset, int count)
        {
            int trueCount = Math.Min(count,Size);
            for (int i = 0; i < trueCount; ++i)
                destination[offset + i] = _buffer[(_head+i) % _capacity];
            _head += trueCount;
            _head %= _capacity;
            _size -= trueCount;
            return trueCount;
        }

        public int Get()
        {
            if (Size == 0)
                return -1;

            int result = (int)_buffer[_head++ % _capacity];
            --_size;
            return result;
        }

    }
}

Deleted compat/zlib/contrib/dotzlib/DotZLib/CodecBase.cs.

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






































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.Runtime.InteropServices;

namespace DotZLib
{
	/// <summary>
	/// Implements the common functionality needed for all <see cref="Codec"/>s
	/// </summary>
	public abstract class CodecBase : Codec, IDisposable
	{

        #region Data members

        /// <summary>
        /// Instance of the internal zlib buffer structure that is
        /// passed to all functions in the zlib dll
        /// </summary>
        internal ZStream _ztream = new ZStream();

        /// <summary>
        /// True if the object instance has been disposed, false otherwise
        /// </summary>
        protected bool _isDisposed = false;

        /// <summary>
        /// The size of the internal buffers
        /// </summary>
        protected const int kBufferSize = 16384;

        private byte[] _outBuffer = new byte[kBufferSize];
        private byte[] _inBuffer = new byte[kBufferSize];

        private GCHandle _hInput;
        private GCHandle _hOutput;

        private uint _checksum = 0;

        #endregion

        /// <summary>
        /// Initializes a new instance of the <c>CodeBase</c> class.
        /// </summary>
		public CodecBase()
		{
            try
            {
                _hInput = GCHandle.Alloc(_inBuffer, GCHandleType.Pinned);
                _hOutput = GCHandle.Alloc(_outBuffer, GCHandleType.Pinned);
            }
            catch (Exception)
            {
                CleanUp(false);
                throw;
            }
        }


        #region Codec Members

        /// <summary>
        /// Occurs when more processed data are available.
        /// </summary>
        public event DataAvailableHandler DataAvailable;

        /// <summary>
        /// Fires the <see cref="DataAvailable"/> event
        /// </summary>
        protected void OnDataAvailable()
        {
            if (_ztream.total_out > 0)
            {
                if (DataAvailable != null)
                    DataAvailable( _outBuffer, 0, (int)_ztream.total_out);
                resetOutput();
            }
        }

        /// <summary>
        /// Adds more data to the codec to be processed.
        /// </summary>
        /// <param name="data">Byte array containing the data to be added to the codec</param>
        /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
        public void Add(byte[] data)
        {
            Add(data,0,data.Length);
        }

        /// <summary>
        /// Adds more data to the codec to be processed.
        /// </summary>
        /// <param name="data">Byte array containing the data to be added to the codec</param>
        /// <param name="offset">The index of the first byte to add from <c>data</c></param>
        /// <param name="count">The number of bytes to add</param>
        /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
        /// <remarks>This must be implemented by a derived class</remarks>
        public abstract void Add(byte[] data, int offset, int count);

        /// <summary>
        /// Finishes up any pending data that needs to be processed and handled.
        /// </summary>
        /// <remarks>This must be implemented by a derived class</remarks>
        public abstract void Finish();

        /// <summary>
        /// Gets the checksum of the data that has been added so far
        /// </summary>
        public uint Checksum { get { return _checksum; } }

        #endregion

        #region Destructor & IDisposable stuff

        /// <summary>
        /// Destroys this instance
        /// </summary>
        ~CodecBase()
        {
            CleanUp(false);
        }

        /// <summary>
        /// Releases any unmanaged resources and calls the <see cref="CleanUp()"/> method of the derived class
        /// </summary>
        public void Dispose()
        {
            CleanUp(true);
        }

        /// <summary>
        /// Performs any codec specific cleanup
        /// </summary>
        /// <remarks>This must be implemented by a derived class</remarks>
        protected abstract void CleanUp();

        // performs the release of the handles and calls the dereived CleanUp()
        private void CleanUp(bool isDisposing)
        {
            if (!_isDisposed)
            {
                CleanUp();
                if (_hInput.IsAllocated)
                    _hInput.Free();
                if (_hOutput.IsAllocated)
                    _hOutput.Free();

                _isDisposed = true;
            }
        }


        #endregion

        #region Helper methods

        /// <summary>
        /// Copies a number of bytes to the internal codec buffer - ready for proccesing
        /// </summary>
        /// <param name="data">The byte array that contains the data to copy</param>
        /// <param name="startIndex">The index of the first byte to copy</param>
        /// <param name="count">The number of bytes to copy from <c>data</c></param>
        protected void copyInput(byte[] data, int startIndex, int count)
        {
            Array.Copy(data, startIndex, _inBuffer,0, count);
            _ztream.next_in = _hInput.AddrOfPinnedObject();
            _ztream.total_in = 0;
            _ztream.avail_in = (uint)count;

        }

        /// <summary>
        /// Resets the internal output buffers to a known state - ready for processing
        /// </summary>
        protected void resetOutput()
        {
            _ztream.total_out = 0;
            _ztream.avail_out = kBufferSize;
            _ztream.next_out = _hOutput.AddrOfPinnedObject();
        }

        /// <summary>
        /// Updates the running checksum property
        /// </summary>
        /// <param name="newSum">The new checksum value</param>
        protected void setChecksum(uint newSum)
        {
            _checksum = newSum;
        }
        #endregion

    }
}

Deleted compat/zlib/contrib/dotzlib/DotZLib/Deflater.cs.

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










































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.Diagnostics;
using System.Runtime.InteropServices;

namespace DotZLib
{

    /// <summary>
    /// Implements a data compressor, using the deflate algorithm in the ZLib dll
    /// </summary>
	public sealed class Deflater : CodecBase
	{
        #region Dll imports
        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)]
        private static extern int deflateInit_(ref ZStream sz, int level, string vs, int size);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int deflate(ref ZStream sz, int flush);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int deflateReset(ref ZStream sz);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int deflateEnd(ref ZStream sz);
        #endregion

        /// <summary>
        /// Constructs an new instance of the <c>Deflater</c>
        /// </summary>
        /// <param name="level">The compression level to use for this <c>Deflater</c></param>
		public Deflater(CompressLevel level) : base()
		{
            int retval = deflateInit_(ref _ztream, (int)level, Info.Version, Marshal.SizeOf(_ztream));
            if (retval != 0)
                throw new ZLibException(retval, "Could not initialize deflater");

            resetOutput();
		}

        /// <summary>
        /// Adds more data to the codec to be processed.
        /// </summary>
        /// <param name="data">Byte array containing the data to be added to the codec</param>
        /// <param name="offset">The index of the first byte to add from <c>data</c></param>
        /// <param name="count">The number of bytes to add</param>
        /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
        public override void Add(byte[] data, int offset, int count)
        {
            if (data == null) throw new ArgumentNullException();
            if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
            if ((offset+count) > data.Length) throw new ArgumentException();

            int total = count;
            int inputIndex = offset;
            int err = 0;

            while (err >= 0 && inputIndex < total)
            {
                copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize));
                while (err >= 0 && _ztream.avail_in > 0)
                {
                    err = deflate(ref _ztream, (int)FlushTypes.None);
                    if (err == 0)
                        while (_ztream.avail_out == 0)
                        {
                            OnDataAvailable();
                            err = deflate(ref _ztream, (int)FlushTypes.None);
                        }
                    inputIndex += (int)_ztream.total_in;
                }
            }
            setChecksum( _ztream.adler );
        }


        /// <summary>
        /// Finishes up any pending data that needs to be processed and handled.
        /// </summary>
        public override void Finish()
        {
            int err;
            do
            {
                err = deflate(ref _ztream, (int)FlushTypes.Finish);
                OnDataAvailable();
            }
            while (err == 0);
            setChecksum( _ztream.adler );
            deflateReset(ref _ztream);
            resetOutput();
        }

        /// <summary>
        /// Closes the internal zlib deflate stream
        /// </summary>
        protected override void CleanUp() { deflateEnd(ref _ztream); }

    }
}

Deleted compat/zlib/contrib/dotzlib/DotZLib/DotZLib.cs.

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
































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.IO;
using System.Runtime.InteropServices;
using System.Text;


namespace DotZLib
{

    #region Internal types

    /// <summary>
    /// Defines constants for the various flush types used with zlib
    /// </summary>
    internal enum FlushTypes
    {
        None,  Partial,  Sync,  Full,  Finish,  Block
    }

    #region ZStream structure
    // internal mapping of the zlib zstream structure for marshalling
    [StructLayoutAttribute(LayoutKind.Sequential, Pack=4, Size=0, CharSet=CharSet.Ansi)]
    internal struct ZStream
    {
        public IntPtr next_in;
        public uint avail_in;
        public uint total_in;

        public IntPtr next_out;
        public uint avail_out;
        public uint total_out;

        [MarshalAs(UnmanagedType.LPStr)]
        string msg;
        uint state;

        uint zalloc;
        uint zfree;
        uint opaque;

        int data_type;
        public uint adler;
        uint reserved;
    }

    #endregion

    #endregion

    #region Public enums
    /// <summary>
    /// Defines constants for the available compression levels in zlib
    /// </summary>
    public enum CompressLevel : int
    {
        /// <summary>
        /// The default compression level with a reasonable compromise between compression and speed
        /// </summary>
        Default = -1,
        /// <summary>
        /// No compression at all. The data are passed straight through.
        /// </summary>
        None = 0,
        /// <summary>
        /// The maximum compression rate available.
        /// </summary>
        Best = 9,
        /// <summary>
        /// The fastest available compression level.
        /// </summary>
        Fastest = 1
    }
    #endregion

    #region Exception classes
    /// <summary>
    /// The exception that is thrown when an error occurs on the zlib dll
    /// </summary>
    public class ZLibException : ApplicationException
    {
        /// <summary>
        /// Initializes a new instance of the <see cref="ZLibException"/> class with a specified
        /// error message and error code
        /// </summary>
        /// <param name="errorCode">The zlib error code that caused the exception</param>
        /// <param name="msg">A message that (hopefully) describes the error</param>
        public ZLibException(int errorCode, string msg) : base(String.Format("ZLib error {0} {1}", errorCode, msg))
        {
        }

        /// <summary>
        /// Initializes a new instance of the <see cref="ZLibException"/> class with a specified
        /// error code
        /// </summary>
        /// <param name="errorCode">The zlib error code that caused the exception</param>
        public ZLibException(int errorCode) : base(String.Format("ZLib error {0}", errorCode))
        {
        }
    }
    #endregion

    #region Interfaces

    /// <summary>
    /// Declares methods and properties that enables a running checksum to be calculated
    /// </summary>
    public interface ChecksumGenerator
    {
        /// <summary>
        /// Gets the current value of the checksum
        /// </summary>
        uint Value { get; }

        /// <summary>
        /// Clears the current checksum to 0
        /// </summary>
        void Reset();

        /// <summary>
        /// Updates the current checksum with an array of bytes
        /// </summary>
        /// <param name="data">The data to update the checksum with</param>
        void Update(byte[] data);

        /// <summary>
        /// Updates the current checksum with part of an array of bytes
        /// </summary>
        /// <param name="data">The data to update the checksum with</param>
        /// <param name="offset">Where in <c>data</c> to start updating</param>
        /// <param name="count">The number of bytes from <c>data</c> to use</param>
        /// <exception cref="ArgumentException">The sum of offset and count is larger than the length of <c>data</c></exception>
        /// <exception cref="ArgumentNullException"><c>data</c> is a null reference</exception>
        /// <exception cref="ArgumentOutOfRangeException">Offset or count is negative.</exception>
        void Update(byte[] data, int offset, int count);

        /// <summary>
        /// Updates the current checksum with the data from a string
        /// </summary>
        /// <param name="data">The string to update the checksum with</param>
        /// <remarks>The characters in the string are converted by the UTF-8 encoding</remarks>
        void Update(string data);

        /// <summary>
        /// Updates the current checksum with the data from a string, using a specific encoding
        /// </summary>
        /// <param name="data">The string to update the checksum with</param>
        /// <param name="encoding">The encoding to use</param>
        void Update(string data, Encoding encoding);
    }


    /// <summary>
    /// Represents the method that will be called from a codec when new data
    /// are available.
    /// </summary>
    /// <paramref name="data">The byte array containing the processed data</paramref>
    /// <paramref name="startIndex">The index of the first processed byte in <c>data</c></paramref>
    /// <paramref name="count">The number of processed bytes available</paramref>
    /// <remarks>On return from this method, the data may be overwritten, so grab it while you can.
    /// You cannot assume that startIndex will be zero.
    /// </remarks>
    public delegate void DataAvailableHandler(byte[] data, int startIndex, int count);

    /// <summary>
    /// Declares methods and events for implementing compressors/decompressors
    /// </summary>
    public interface Codec
    {
        /// <summary>
        /// Occurs when more processed data are available.
        /// </summary>
        event DataAvailableHandler DataAvailable;

        /// <summary>
        /// Adds more data to the codec to be processed.
        /// </summary>
        /// <param name="data">Byte array containing the data to be added to the codec</param>
        /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
        void Add(byte[] data);

        /// <summary>
        /// Adds more data to the codec to be processed.
        /// </summary>
        /// <param name="data">Byte array containing the data to be added to the codec</param>
        /// <param name="offset">The index of the first byte to add from <c>data</c></param>
        /// <param name="count">The number of bytes to add</param>
        /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
        void Add(byte[] data, int offset, int count);

        /// <summary>
        /// Finishes up any pending data that needs to be processed and handled.
        /// </summary>
        void Finish();

        /// <summary>
        /// Gets the checksum of the data that has been added so far
        /// </summary>
        uint Checksum { get; }


    }

    #endregion

    #region Classes
    /// <summary>
    /// Encapsulates general information about the ZLib library
    /// </summary>
    public class Info
    {
        #region DLL imports
        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern uint zlibCompileFlags();

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern string zlibVersion();
        #endregion

        #region Private stuff
        private uint _flags;

        // helper function that unpacks a bitsize mask
        private static int bitSize(uint bits)
        {
            switch (bits)
            {
                case 0: return 16;
                case 1: return 32;
                case 2: return 64;
            }
            return -1;
        }
        #endregion

        /// <summary>
        /// Constructs an instance of the <c>Info</c> class.
        /// </summary>
        public Info()
        {
            _flags = zlibCompileFlags();
        }

        /// <summary>
        /// True if the library is compiled with debug info
        /// </summary>
        public bool HasDebugInfo { get { return 0 != (_flags & 0x100); } }

        /// <summary>
        /// True if the library is compiled with assembly optimizations
        /// </summary>
        public bool UsesAssemblyCode { get { return 0 != (_flags & 0x200); } }

        /// <summary>
        /// Gets the size of the unsigned int that was compiled into Zlib
        /// </summary>
        public int SizeOfUInt { get { return bitSize(_flags & 3); } }

        /// <summary>
        /// Gets the size of the unsigned long that was compiled into Zlib
        /// </summary>
        public int SizeOfULong { get { return bitSize((_flags >> 2) & 3); } }

        /// <summary>
        /// Gets the size of the pointers that were compiled into Zlib
        /// </summary>
        public int SizeOfPointer { get { return bitSize((_flags >> 4) & 3); } }

        /// <summary>
        /// Gets the size of the z_off_t type that was compiled into Zlib
        /// </summary>
        public int SizeOfOffset { get { return bitSize((_flags >> 6) & 3); } }

        /// <summary>
        /// Gets the version of ZLib as a string, e.g. "1.2.1"
        /// </summary>
        public static string Version { get { return zlibVersion(); } }
    }

    #endregion

}

Deleted compat/zlib/contrib/dotzlib/DotZLib/DotZLib.csproj.

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













































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<VisualStudioProject>
    <CSHARP
        ProjectType = "Local"
        ProductVersion = "7.10.3077"
        SchemaVersion = "2.0"
        ProjectGuid = "{BB1EE0B1-1808-46CB-B786-949D91117FC5}"
    >
        <Build>
            <Settings
                ApplicationIcon = ""
                AssemblyKeyContainerName = ""
                AssemblyName = "DotZLib"
                AssemblyOriginatorKeyFile = ""
                DefaultClientScript = "JScript"
                DefaultHTMLPageLayout = "Grid"
                DefaultTargetSchema = "IE50"
                DelaySign = "false"
                OutputType = "Library"
                PreBuildEvent = ""
                PostBuildEvent = ""
                RootNamespace = "DotZLib"
                RunPostBuildEvent = "OnBuildSuccess"
                StartupObject = ""
            >
                <Config
                    Name = "Debug"
                    AllowUnsafeBlocks = "false"
                    BaseAddress = "285212672"
                    CheckForOverflowUnderflow = "false"
                    ConfigurationOverrideFile = ""
                    DefineConstants = "DEBUG;TRACE"
                    DocumentationFile = "docs\DotZLib.xml"
                    DebugSymbols = "true"
                    FileAlignment = "4096"
                    IncrementalBuild = "false"
                    NoStdLib = "false"
                    NoWarn = "1591"
                    Optimize = "false"
                    OutputPath = "bin\Debug\"
                    RegisterForComInterop = "false"
                    RemoveIntegerChecks = "false"
                    TreatWarningsAsErrors = "false"
                    WarningLevel = "4"
                />
                <Config
                    Name = "Release"
                    AllowUnsafeBlocks = "false"
                    BaseAddress = "285212672"
                    CheckForOverflowUnderflow = "false"
                    ConfigurationOverrideFile = ""
                    DefineConstants = "TRACE"
                    DocumentationFile = "docs\DotZLib.xml"
                    DebugSymbols = "false"
                    FileAlignment = "4096"
                    IncrementalBuild = "false"
                    NoStdLib = "false"
                    NoWarn = ""
                    Optimize = "true"
                    OutputPath = "bin\Release\"
                    RegisterForComInterop = "false"
                    RemoveIntegerChecks = "false"
                    TreatWarningsAsErrors = "false"
                    WarningLevel = "4"
                />
            </Settings>
            <References>
                <Reference
                    Name = "System"
                    AssemblyName = "System"
                    HintPath = "C:\WINNT\Microsoft.NET\Framework\v1.1.4322\System.dll"
                />
                <Reference
                    Name = "System.Data"
                    AssemblyName = "System.Data"
                    HintPath = "C:\WINNT\Microsoft.NET\Framework\v1.1.4322\System.Data.dll"
                />
                <Reference
                    Name = "System.XML"
                    AssemblyName = "System.Xml"
                    HintPath = "C:\WINNT\Microsoft.NET\Framework\v1.1.4322\System.XML.dll"
                />
                <Reference
                    Name = "nunit.framework"
                    AssemblyName = "nunit.framework"
                    HintPath = "E:\apps\NUnit V2.1\\bin\nunit.framework.dll"
                    AssemblyFolderKey = "hklm\dn\nunit.framework"
                />
            </References>
        </Build>
        <Files>
            <Include>
                <File
                    RelPath = "AssemblyInfo.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "ChecksumImpl.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "CircularBuffer.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "CodecBase.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "Deflater.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "DotZLib.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "GZipStream.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "Inflater.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
                <File
                    RelPath = "UnitTests.cs"
                    SubType = "Code"
                    BuildAction = "Compile"
                />
            </Include>
        </Files>
    </CSHARP>
</VisualStudioProject>

Deleted compat/zlib/contrib/dotzlib/DotZLib/GZipStream.cs.

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













































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.IO;
using System.Runtime.InteropServices;

namespace DotZLib
{
	/// <summary>
	/// Implements a compressed <see cref="Stream"/>, in GZip (.gz) format.
	/// </summary>
	public class GZipStream : Stream, IDisposable
	{
        #region Dll Imports
        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)]
        private static extern IntPtr gzopen(string name, string mode);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int gzclose(IntPtr gzFile);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int gzwrite(IntPtr gzFile, int data, int length);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int gzread(IntPtr gzFile, int data, int length);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int gzgetc(IntPtr gzFile);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int gzputc(IntPtr gzFile, int c);

        #endregion

        #region Private data
        private IntPtr _gzFile;
        private bool _isDisposed = false;
        private bool _isWriting;
        #endregion

        #region Constructors
        /// <summary>
        /// Creates a new file as a writeable GZipStream
        /// </summary>
        /// <param name="fileName">The name of the compressed file to create</param>
        /// <param name="level">The compression level to use when adding data</param>
        /// <exception cref="ZLibException">If an error occurred in the internal zlib function</exception>
		public GZipStream(string fileName, CompressLevel level)
		{
            _isWriting = true;
            _gzFile = gzopen(fileName, String.Format("wb{0}", (int)level));
            if (_gzFile == IntPtr.Zero)
                throw new ZLibException(-1, "Could not open " + fileName);
		}

        /// <summary>
        /// Opens an existing file as a readable GZipStream
        /// </summary>
        /// <param name="fileName">The name of the file to open</param>
        /// <exception cref="ZLibException">If an error occurred in the internal zlib function</exception>
        public GZipStream(string fileName)
        {
            _isWriting = false;
            _gzFile = gzopen(fileName, "rb");
            if (_gzFile == IntPtr.Zero)
                throw new ZLibException(-1, "Could not open " + fileName);

        }
        #endregion

        #region Access properties
        /// <summary>
        /// Returns true of this stream can be read from, false otherwise
        /// </summary>
        public override bool CanRead
        {
            get
            {
                return !_isWriting;
            }
        }


        /// <summary>
        /// Returns false.
        /// </summary>
        public override bool CanSeek
        {
            get
            {
                return false;
            }
        }

        /// <summary>
        /// Returns true if this tsream is writeable, false otherwise
        /// </summary>
        public override bool CanWrite
        {
            get
            {
                return _isWriting;
            }
        }
        #endregion

        #region Destructor & IDispose stuff

        /// <summary>
        /// Destroys this instance
        /// </summary>
        ~GZipStream()
        {
            cleanUp(false);
        }

        /// <summary>
        /// Closes the external file handle
        /// </summary>
        public void Dispose()
        {
            cleanUp(true);
        }

        // Does the actual closing of the file handle.
        private void cleanUp(bool isDisposing)
        {
            if (!_isDisposed)
            {
                gzclose(_gzFile);
                _isDisposed = true;
            }
        }
        #endregion

        #region Basic reading and writing
        /// <summary>
        /// Attempts to read a number of bytes from the stream.
        /// </summary>
        /// <param name="buffer">The destination data buffer</param>
        /// <param name="offset">The index of the first destination byte in <c>buffer</c></param>
        /// <param name="count">The number of bytes requested</param>
        /// <returns>The number of bytes read</returns>
        /// <exception cref="ArgumentNullException">If <c>buffer</c> is null</exception>
        /// <exception cref="ArgumentOutOfRangeException">If <c>count</c> or <c>offset</c> are negative</exception>
        /// <exception cref="ArgumentException">If <c>offset</c>  + <c>count</c> is &gt; buffer.Length</exception>
        /// <exception cref="NotSupportedException">If this stream is not readable.</exception>
        /// <exception cref="ObjectDisposedException">If this stream has been disposed.</exception>
        public override int Read(byte[] buffer, int offset, int count)
        {
            if (!CanRead) throw new NotSupportedException();
            if (buffer == null) throw new ArgumentNullException();
            if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
            if ((offset+count) > buffer.Length) throw new ArgumentException();
            if (_isDisposed) throw new ObjectDisposedException("GZipStream");

            GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned);
            int result;
            try
            {
                result = gzread(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count);
                if (result < 0)
                    throw new IOException();
            }
            finally
            {
                h.Free();
            }
            return result;
        }

        /// <summary>
        /// Attempts to read a single byte from the stream.
        /// </summary>
        /// <returns>The byte that was read, or -1 in case of error or End-Of-File</returns>
        public override int ReadByte()
        {
            if (!CanRead) throw new NotSupportedException();
            if (_isDisposed) throw new ObjectDisposedException("GZipStream");
            return gzgetc(_gzFile);
        }

        /// <summary>
        /// Writes a number of bytes to the stream
        /// </summary>
        /// <param name="buffer"></param>
        /// <param name="offset"></param>
        /// <param name="count"></param>
        /// <exception cref="ArgumentNullException">If <c>buffer</c> is null</exception>
        /// <exception cref="ArgumentOutOfRangeException">If <c>count</c> or <c>offset</c> are negative</exception>
        /// <exception cref="ArgumentException">If <c>offset</c>  + <c>count</c> is &gt; buffer.Length</exception>
        /// <exception cref="NotSupportedException">If this stream is not writeable.</exception>
        /// <exception cref="ObjectDisposedException">If this stream has been disposed.</exception>
        public override void Write(byte[] buffer, int offset, int count)
        {
            if (!CanWrite) throw new NotSupportedException();
            if (buffer == null) throw new ArgumentNullException();
            if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
            if ((offset+count) > buffer.Length) throw new ArgumentException();
            if (_isDisposed) throw new ObjectDisposedException("GZipStream");

            GCHandle h = GCHandle.Alloc(buffer, GCHandleType.Pinned);
            try
            {
                int result = gzwrite(_gzFile, h.AddrOfPinnedObject().ToInt32() + offset, count);
                if (result < 0)
                    throw new IOException();
            }
            finally
            {
                h.Free();
            }
        }

        /// <summary>
        /// Writes a single byte to the stream
        /// </summary>
        /// <param name="value">The byte to add to the stream.</param>
        /// <exception cref="NotSupportedException">If this stream is not writeable.</exception>
        /// <exception cref="ObjectDisposedException">If this stream has been disposed.</exception>
        public override void WriteByte(byte value)
        {
            if (!CanWrite) throw new NotSupportedException();
            if (_isDisposed) throw new ObjectDisposedException("GZipStream");

            int result = gzputc(_gzFile, (int)value);
            if (result < 0)
                throw new IOException();
        }
        #endregion

        #region Position & length stuff
        /// <summary>
        /// Not supported.
        /// </summary>
        /// <param name="value"></param>
        /// <exception cref="NotSupportedException">Always thrown</exception>
        public override void SetLength(long value)
        {
            throw new NotSupportedException();
        }

        /// <summary>
        ///  Not suppported.
        /// </summary>
        /// <param name="offset"></param>
        /// <param name="origin"></param>
        /// <returns></returns>
        /// <exception cref="NotSupportedException">Always thrown</exception>
        public override long Seek(long offset, SeekOrigin origin)
        {
            throw new NotSupportedException();
        }

        /// <summary>
        /// Flushes the <c>GZipStream</c>.
        /// </summary>
        /// <remarks>In this implementation, this method does nothing. This is because excessive
        /// flushing may degrade the achievable compression rates.</remarks>
        public override void Flush()
        {
            // left empty on purpose
        }

        /// <summary>
        /// Gets/sets the current position in the <c>GZipStream</c>. Not suppported.
        /// </summary>
        /// <remarks>In this implementation this property is not supported</remarks>
        /// <exception cref="NotSupportedException">Always thrown</exception>
        public override long Position
        {
            get
            {
                throw new NotSupportedException();
            }
            set
            {
                throw new NotSupportedException();
            }
        }

        /// <summary>
        /// Gets the size of the stream. Not suppported.
        /// </summary>
        /// <remarks>In this implementation this property is not supported</remarks>
        /// <exception cref="NotSupportedException">Always thrown</exception>
        public override long Length
        {
            get
            {
                throw new NotSupportedException();
            }
        }
        #endregion
    }
}

Deleted compat/zlib/contrib/dotzlib/DotZLib/Inflater.cs.

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









































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.Diagnostics;
using System.Runtime.InteropServices;

namespace DotZLib
{

    /// <summary>
    /// Implements a data decompressor, using the inflate algorithm in the ZLib dll
    /// </summary>
    public class Inflater : CodecBase
	{
        #region Dll imports
        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl, CharSet=CharSet.Ansi)]
        private static extern int inflateInit_(ref ZStream sz, string vs, int size);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int inflate(ref ZStream sz, int flush);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int inflateReset(ref ZStream sz);

        [DllImport("ZLIB1.dll", CallingConvention=CallingConvention.Cdecl)]
        private static extern int inflateEnd(ref ZStream sz);
        #endregion

        /// <summary>
        /// Constructs an new instance of the <c>Inflater</c>
        /// </summary>
        public Inflater() : base()
		{
            int retval = inflateInit_(ref _ztream, Info.Version, Marshal.SizeOf(_ztream));
            if (retval != 0)
                throw new ZLibException(retval, "Could not initialize inflater");

            resetOutput();
        }


        /// <summary>
        /// Adds more data to the codec to be processed.
        /// </summary>
        /// <param name="data">Byte array containing the data to be added to the codec</param>
        /// <param name="offset">The index of the first byte to add from <c>data</c></param>
        /// <param name="count">The number of bytes to add</param>
        /// <remarks>Adding data may, or may not, raise the <c>DataAvailable</c> event</remarks>
        public override void Add(byte[] data, int offset, int count)
        {
            if (data == null) throw new ArgumentNullException();
            if (offset < 0 || count < 0) throw new ArgumentOutOfRangeException();
            if ((offset+count) > data.Length) throw new ArgumentException();

            int total = count;
            int inputIndex = offset;
            int err = 0;

            while (err >= 0 && inputIndex < total)
            {
                copyInput(data, inputIndex, Math.Min(total - inputIndex, kBufferSize));
                err = inflate(ref _ztream, (int)FlushTypes.None);
                if (err == 0)
                    while (_ztream.avail_out == 0)
                    {
                        OnDataAvailable();
                        err = inflate(ref _ztream, (int)FlushTypes.None);
                    }

                inputIndex += (int)_ztream.total_in;
            }
            setChecksum( _ztream.adler );
        }


        /// <summary>
        /// Finishes up any pending data that needs to be processed and handled.
        /// </summary>
        public override void Finish()
        {
            int err;
            do
            {
                err = inflate(ref _ztream, (int)FlushTypes.Finish);
                OnDataAvailable();
            }
            while (err == 0);
            setChecksum( _ztream.adler );
            inflateReset(ref _ztream);
            resetOutput();
        }

        /// <summary>
        /// Closes the internal zlib inflate stream
        /// </summary>
        protected override void CleanUp() { inflateEnd(ref _ztream); }


	}
}

Deleted compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs.

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


















































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
//
// © Copyright Henrik Ravn 2004
//
// Use, modification and distribution are subject to the Boost Software License, Version 1.0.
// (See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
//

using System;
using System.Collections;
using System.IO;

// uncomment the define below to include unit tests
//#define nunit
#if nunit
using NUnit.Framework;

// Unit tests for the DotZLib class library
// ----------------------------------------
//
// Use this with NUnit 2 from http://www.nunit.org
//

namespace DotZLibTests
{
    using DotZLib;

    // helper methods
    internal class Utils
    {
        public static bool byteArrEqual( byte[] lhs, byte[] rhs )
        {
            if (lhs.Length != rhs.Length)
                return false;
            for (int i = lhs.Length-1; i >= 0; --i)
                if (lhs[i] != rhs[i])
                    return false;
            return true;
        }

    }


    [TestFixture]
    public class CircBufferTests
    {
        #region Circular buffer tests
        [Test]
        public void SinglePutGet()
        {
            CircularBuffer buf = new CircularBuffer(10);
            Assert.AreEqual( 0, buf.Size );
            Assert.AreEqual( -1, buf.Get() );

            Assert.IsTrue(buf.Put( 1 ));
            Assert.AreEqual( 1, buf.Size );
            Assert.AreEqual( 1, buf.Get() );
            Assert.AreEqual( 0, buf.Size );
            Assert.AreEqual( -1, buf.Get() );
        }

        [Test]
        public void BlockPutGet()
        {
            CircularBuffer buf = new CircularBuffer(10);
            byte[] arr = {1,2,3,4,5,6,7,8,9,10};
            Assert.AreEqual( 10, buf.Put(arr,0,10) );
            Assert.AreEqual( 10, buf.Size );
            Assert.IsFalse( buf.Put(11) );
            Assert.AreEqual( 1, buf.Get() );
            Assert.IsTrue( buf.Put(11) );

            byte[] arr2 = (byte[])arr.Clone();
            Assert.AreEqual( 9, buf.Get(arr2,1,9) );
            Assert.IsTrue( Utils.byteArrEqual(arr,arr2) );
        }

        #endregion
    }

    [TestFixture]
    public class ChecksumTests
    {
        #region CRC32 Tests
        [Test]
        public void CRC32_Null()
        {
            CRC32Checksum crc32 = new CRC32Checksum();
            Assert.AreEqual( 0, crc32.Value );

            crc32 = new CRC32Checksum(1);
            Assert.AreEqual( 1, crc32.Value );

            crc32 = new CRC32Checksum(556);
            Assert.AreEqual( 556, crc32.Value );
        }

        [Test]
        public void CRC32_Data()
        {
            CRC32Checksum crc32 = new CRC32Checksum();
            byte[] data = { 1,2,3,4,5,6,7 };
            crc32.Update(data);
            Assert.AreEqual( 0x70e46888, crc32.Value  );

            crc32 = new CRC32Checksum();
            crc32.Update("penguin");
            Assert.AreEqual( 0x0e5c1a120, crc32.Value );

            crc32 = new CRC32Checksum(1);
            crc32.Update("penguin");
            Assert.AreEqual(0x43b6aa94, crc32.Value);

        }
        #endregion

        #region Adler tests

        [Test]
        public void Adler_Null()
        {
            AdlerChecksum adler = new AdlerChecksum();
            Assert.AreEqual(0, adler.Value);

            adler = new AdlerChecksum(1);
            Assert.AreEqual( 1, adler.Value );

            adler = new AdlerChecksum(556);
            Assert.AreEqual( 556, adler.Value );
        }

        [Test]
        public void Adler_Data()
        {
            AdlerChecksum adler = new AdlerChecksum(1);
            byte[] data = { 1,2,3,4,5,6,7 };
            adler.Update(data);
            Assert.AreEqual( 0x5b001d, adler.Value  );

            adler = new AdlerChecksum();
            adler.Update("penguin");
            Assert.AreEqual(0x0bcf02f6, adler.Value );

            adler = new AdlerChecksum(1);
            adler.Update("penguin");
            Assert.AreEqual(0x0bd602f7, adler.Value);

        }
        #endregion
    }

    [TestFixture]
    public class InfoTests
    {
        #region Info tests
        [Test]
        public void Info_Version()
        {
            Info info = new Info();
            Assert.AreEqual("1.2.11", Info.Version);
            Assert.AreEqual(32, info.SizeOfUInt);
            Assert.AreEqual(32, info.SizeOfULong);
            Assert.AreEqual(32, info.SizeOfPointer);
            Assert.AreEqual(32, info.SizeOfOffset);
        }
        #endregion
    }

    [TestFixture]
    public class DeflateInflateTests
    {
        #region Deflate tests
        [Test]
        public void Deflate_Init()
        {
            using (Deflater def = new Deflater(CompressLevel.Default))
            {
            }
        }

        private ArrayList compressedData = new ArrayList();
        private uint adler1;

        private ArrayList uncompressedData = new ArrayList();
        private uint adler2;

        public void CDataAvail(byte[] data, int startIndex, int count)
        {
            for (int i = 0; i < count; ++i)
                compressedData.Add(data[i+startIndex]);
        }

        [Test]
        public void Deflate_Compress()
        {
            compressedData.Clear();

            byte[] testData = new byte[35000];
            for (int i = 0; i < testData.Length; ++i)
                testData[i] = 5;

            using (Deflater def = new Deflater((CompressLevel)5))
            {
                def.DataAvailable += new DataAvailableHandler(CDataAvail);
                def.Add(testData);
                def.Finish();
                adler1 = def.Checksum;
            }
        }
        #endregion

        #region Inflate tests
        [Test]
        public void Inflate_Init()
        {
            using (Inflater inf = new Inflater())
            {
            }
        }

        private void DDataAvail(byte[] data, int startIndex, int count)
        {
            for (int i = 0; i < count; ++i)
                uncompressedData.Add(data[i+startIndex]);
        }

        [Test]
        public void Inflate_Expand()
        {
            uncompressedData.Clear();

            using (Inflater inf = new Inflater())
            {
                inf.DataAvailable += new DataAvailableHandler(DDataAvail);
                inf.Add((byte[])compressedData.ToArray(typeof(byte)));
                inf.Finish();
                adler2 = inf.Checksum;
            }
            Assert.AreEqual( adler1, adler2 );
        }
        #endregion
    }

    [TestFixture]
    public class GZipStreamTests
    {
        #region GZipStream test
        [Test]
        public void GZipStream_WriteRead()
        {
            using (GZipStream gzOut = new GZipStream("gzstream.gz", CompressLevel.Best))
            {
                BinaryWriter writer = new BinaryWriter(gzOut);
                writer.Write("hi there");
                writer.Write(Math.PI);
                writer.Write(42);
            }

            using (GZipStream gzIn = new GZipStream("gzstream.gz"))
            {
                BinaryReader reader = new BinaryReader(gzIn);
                string s = reader.ReadString();
                Assert.AreEqual("hi there",s);
                double d = reader.ReadDouble();
                Assert.AreEqual(Math.PI, d);
                int i = reader.ReadInt32();
                Assert.AreEqual(42,i);
            }

        }
        #endregion
	}
}

#endif

Deleted compat/zlib/contrib/dotzlib/LICENSE_1_0.txt.

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























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Boost Software License - Version 1.0 - August 17th, 2003

Permission is hereby granted, free of charge, to any person or organization
obtaining a copy of the software and accompanying documentation covered by
this license (the "Software") to use, reproduce, display, distribute,
execute, and transmit the Software, and to prepare derivative works of the
Software, and to permit third-parties to whom the Software is furnished to
do so, all subject to the following:

The copyright notices in the Software and this entire statement, including
the above license grant, this restriction and the following disclaimer,
must be included in all copies of the Software, in whole or in part, and
all derivative works of the Software, unless such copies or derivative
works are solely in the form of machine-executable object code generated by
a source language processor.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT
SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE
FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.

Deleted compat/zlib/contrib/dotzlib/readme.txt.

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


























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
This directory contains a .Net wrapper class library for the ZLib1.dll

The wrapper includes support for inflating/deflating memory buffers,
.Net streaming wrappers for the gz streams part of zlib, and wrappers
for the checksum parts of zlib. See DotZLib/UnitTests.cs for examples.

Directory structure:
--------------------

LICENSE_1_0.txt       - License file.
readme.txt            - This file.
DotZLib.chm           - Class library documentation
DotZLib.build         - NAnt build file
DotZLib.sln           - Microsoft Visual Studio 2003 solution file

DotZLib\*.cs          - Source files for the class library

Unit tests:
-----------
The file DotZLib/UnitTests.cs contains unit tests for use with NUnit 2.1 or higher.
To include unit tests in the build, define nunit before building.


Build instructions:
-------------------

1. Using Visual Studio.Net 2003:
   Open DotZLib.sln in VS.Net and build from there. Output file (DotZLib.dll)
   will be found ./DotZLib/bin/release or ./DotZLib/bin/debug, depending on
   you are building the release or debug version of the library. Check
   DotZLib/UnitTests.cs for instructions on how to include unit tests in the
   build.

2. Using NAnt:
   Open a command prompt with access to the build environment and run nant
   in the same directory as the DotZLib.build file.
   You can define 2 properties on the nant command-line to control the build:
   debug={true|false} to toggle between release/debug builds (default=true).
   nunit={true|false} to include or esclude unit tests (default=true).
   Also the target clean will remove binaries.
   Output file (DotZLib.dll) will be found in either ./DotZLib/bin/release
   or ./DotZLib/bin/debug, depending on whether you are building the release
   or debug version of the library.

   Examples:
     nant -D:debug=false -D:nunit=false
       will build a release mode version of the library without unit tests.
     nant
       will build a debug version of the library with unit tests
     nant clean
       will remove all previously built files.


---------------------------------
Copyright (c) Henrik Ravn 2004

Use, modification and distribution are subject to the Boost Software License, Version 1.0.
(See accompanying file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)

Deleted compat/zlib/contrib/gcc_gvmat64/gvmat64.S.

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
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
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
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






























































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
;uInt longest_match_x64(
;    deflate_state *s,
;    IPos cur_match);                             // current match 

; gvmat64.S -- Asm portion of the optimized longest_match for 32 bits x86_64
;  (AMD64 on Athlon 64, Opteron, Phenom
;     and Intel EM64T on Pentium 4 with EM64T, Pentium D, Core 2 Duo, Core I5/I7)
; this file is translation from gvmat64.asm to GCC 4.x (for Linux, Mac XCode)
; Copyright (C) 1995-2010 Jean-loup Gailly, Brian Raiter and Gilles Vollant.
;
; File written by Gilles Vollant, by converting to assembly the longest_match
;  from Jean-loup Gailly in deflate.c of zLib and infoZip zip.
;  and by taking inspiration on asm686 with masm, optimised assembly code
;        from Brian Raiter, written 1998
;
;  This software is provided 'as-is', without any express or implied
;  warranty.  In no event will the authors be held liable for any damages
;  arising from the use of this software.
;
;  Permission is granted to anyone to use this software for any purpose,
;  including commercial applications, and to alter it and redistribute it
;  freely, subject to the following restrictions:
;
;  1. The origin of this software must not be misrepresented; you must not
;     claim that you wrote the original software. If you use this software
;     in a product, an acknowledgment in the product documentation would be
;     appreciated but is not required.
;  2. Altered source versions must be plainly marked as such, and must not be
;     misrepresented as being the original software
;  3. This notice may not be removed or altered from any source distribution.
;
;         http://www.zlib.net
;         http://www.winimage.com/zLibDll
;         http://www.muppetlabs.com/~breadbox/software/assembly.html
;
; to compile this file for zLib, I use option:
;   gcc -c -arch x86_64 gvmat64.S


;uInt longest_match(s, cur_match)
;    deflate_state *s;
;    IPos cur_match;                             // current match /
;
; with XCode for Mac, I had strange error with some jump on intel syntax
; this is why BEFORE_JMP and AFTER_JMP are used
 */


#define BEFORE_JMP .att_syntax
#define AFTER_JMP .intel_syntax noprefix

#ifndef NO_UNDERLINE
#	define	match_init	_match_init
#	define	longest_match	_longest_match
#endif

.intel_syntax noprefix

.globl	match_init, longest_match
.text
longest_match:



#define LocalVarsSize 96
/*
; register used : rax,rbx,rcx,rdx,rsi,rdi,r8,r9,r10,r11,r12
; free register :  r14,r15
; register can be saved : rsp
*/

#define chainlenwmask     (rsp + 8 - LocalVarsSize)
#define nicematch         (rsp + 16 - LocalVarsSize)

#define save_rdi        (rsp + 24 - LocalVarsSize)
#define save_rsi        (rsp + 32 - LocalVarsSize)
#define save_rbx        (rsp + 40 - LocalVarsSize)
#define save_rbp        (rsp + 48 - LocalVarsSize)
#define save_r12        (rsp + 56 - LocalVarsSize)
#define save_r13        (rsp + 64 - LocalVarsSize)
#define save_r14        (rsp + 72 - LocalVarsSize)
#define save_r15        (rsp + 80 - LocalVarsSize)


/*
;  all the +4 offsets are due to the addition of pending_buf_size (in zlib
;  in the deflate_state structure since the asm code was first written
;  (if you compile with zlib 1.0.4 or older, remove the +4).
;  Note : these value are good with a 8 bytes boundary pack structure
*/

#define    MAX_MATCH              258
#define    MIN_MATCH              3
#define    MIN_LOOKAHEAD          (MAX_MATCH+MIN_MATCH+1)

/*
;;; Offsets for fields in the deflate_state structure. These numbers
;;; are calculated from the definition of deflate_state, with the
;;; assumption that the compiler will dword-align the fields. (Thus,
;;; changing the definition of deflate_state could easily cause this
;;; program to crash horribly, without so much as a warning at
;;; compile time. Sigh.)

;  all the +zlib1222add offsets are due to the addition of fields
;  in zlib in the deflate_state structure since the asm code was first written
;  (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)").
;  (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0").
;  if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8").
*/



/* you can check the structure offset by running

#include <stdlib.h>
#include <stdio.h>
#include "deflate.h"

void print_depl()
{
deflate_state ds;
deflate_state *s=&ds;
printf("size pointer=%u\n",(int)sizeof(void*));

printf("#define dsWSize         %u\n",(int)(((char*)&(s->w_size))-((char*)s)));
printf("#define dsWMask         %u\n",(int)(((char*)&(s->w_mask))-((char*)s)));
printf("#define dsWindow        %u\n",(int)(((char*)&(s->window))-((char*)s)));
printf("#define dsPrev          %u\n",(int)(((char*)&(s->prev))-((char*)s)));
printf("#define dsMatchLen      %u\n",(int)(((char*)&(s->match_length))-((char*)s)));
printf("#define dsPrevMatch     %u\n",(int)(((char*)&(s->prev_match))-((char*)s)));
printf("#define dsStrStart      %u\n",(int)(((char*)&(s->strstart))-((char*)s)));
printf("#define dsMatchStart    %u\n",(int)(((char*)&(s->match_start))-((char*)s)));
printf("#define dsLookahead     %u\n",(int)(((char*)&(s->lookahead))-((char*)s)));
printf("#define dsPrevLen       %u\n",(int)(((char*)&(s->prev_length))-((char*)s)));
printf("#define dsMaxChainLen   %u\n",(int)(((char*)&(s->max_chain_length))-((char*)s)));
printf("#define dsGoodMatch     %u\n",(int)(((char*)&(s->good_match))-((char*)s)));
printf("#define dsNiceMatch     %u\n",(int)(((char*)&(s->nice_match))-((char*)s)));
}
*/

#define dsWSize          68
#define dsWMask          76
#define dsWindow         80
#define dsPrev           96
#define dsMatchLen       144
#define dsPrevMatch      148
#define dsStrStart       156
#define dsMatchStart     160
#define dsLookahead      164
#define dsPrevLen        168
#define dsMaxChainLen    172
#define dsGoodMatch      188
#define dsNiceMatch      192

#define window_size      [ rcx + dsWSize]
#define WMask            [ rcx + dsWMask]
#define window_ad        [ rcx + dsWindow]
#define prev_ad          [ rcx + dsPrev]
#define strstart         [ rcx + dsStrStart]
#define match_start      [ rcx + dsMatchStart]
#define Lookahead        [ rcx + dsLookahead] //; 0ffffffffh on infozip
#define prev_length      [ rcx + dsPrevLen]
#define max_chain_length [ rcx + dsMaxChainLen]
#define good_match       [ rcx + dsGoodMatch]
#define nice_match       [ rcx + dsNiceMatch]

/*
; windows:
; parameter 1 in rcx(deflate state s), param 2 in rdx (cur match)

; see http://weblogs.asp.net/oldnewthing/archive/2004/01/14/58579.aspx and
; http://msdn.microsoft.com/library/en-us/kmarch/hh/kmarch/64bitAMD_8e951dd2-ee77-4728-8702-55ce4b5dd24a.xml.asp
;
; All registers must be preserved across the call, except for
;   rax, rcx, rdx, r8, r9, r10, and r11, which are scratch.

;
; gcc on macosx-linux:
; see http://www.x86-64.org/documentation/abi-0.99.pdf
; param 1 in rdi, param 2 in rsi
; rbx, rsp, rbp, r12 to r15 must be preserved

;;; Save registers that the compiler may be using, and adjust esp to
;;; make room for our stack frame.


;;; Retrieve the function arguments. r8d will hold cur_match
;;; throughout the entire function. edx will hold the pointer to the
;;; deflate_state structure during the function's setup (before
;;; entering the main loop.

; ms: parameter 1 in rcx (deflate_state* s), param 2 in edx -> r8 (cur match)
; mac: param 1 in rdi, param 2 rsi
; this clear high 32 bits of r8, which can be garbage in both r8 and rdx
*/
        mov [save_rbx],rbx
        mov [save_rbp],rbp


        mov rcx,rdi

        mov r8d,esi


        mov [save_r12],r12
        mov [save_r13],r13
        mov [save_r14],r14
        mov [save_r15],r15


//;;; uInt wmask = s->w_mask;
//;;; unsigned chain_length = s->max_chain_length;
//;;; if (s->prev_length >= s->good_match) {
//;;;     chain_length >>= 2;
//;;; }


        mov edi, prev_length
        mov esi, good_match
        mov eax, WMask
        mov ebx, max_chain_length
        cmp edi, esi
        jl  LastMatchGood
        shr ebx, 2
LastMatchGood:

//;;; chainlen is decremented once beforehand so that the function can
//;;; use the sign flag instead of the zero flag for the exit test.
//;;; It is then shifted into the high word, to make room for the wmask
//;;; value, which it will always accompany.

        dec ebx
        shl ebx, 16
        or  ebx, eax

//;;; on zlib only
//;;; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;



        mov eax, nice_match
        mov [chainlenwmask], ebx
        mov r10d, Lookahead
        cmp r10d, eax
        cmovnl r10d, eax
        mov [nicematch],r10d



//;;; register Bytef *scan = s->window + s->strstart;
        mov r10, window_ad
        mov ebp, strstart
        lea r13, [r10 + rbp]

//;;; Determine how many bytes the scan ptr is off from being
//;;; dword-aligned.

         mov r9,r13
         neg r13
         and r13,3

//;;; IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
//;;;     s->strstart - (IPos)MAX_DIST(s) : NIL;


        mov eax, window_size
        sub eax, MIN_LOOKAHEAD


        xor edi,edi
        sub ebp, eax

        mov r11d, prev_length

        cmovng ebp,edi

//;;; int best_len = s->prev_length;


//;;; Store the sum of s->window + best_len in esi locally, and in esi.

       lea  rsi,[r10+r11]

//;;; register ush scan_start = *(ushf*)scan;
//;;; register ush scan_end   = *(ushf*)(scan+best_len-1);
//;;; Posf *prev = s->prev;

        movzx r12d,word ptr [r9]
        movzx ebx, word ptr [r9 + r11 - 1]

        mov rdi, prev_ad

//;;; Jump into the main loop.

        mov edx, [chainlenwmask]

        cmp bx,word ptr [rsi + r8 - 1]
        jz  LookupLoopIsZero
				
						
						
LookupLoop1:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
        jbe LeaveNow
		
		
		
        sub edx, 0x00010000
		BEFORE_JMP
        js  LeaveNow
		AFTER_JMP

LoopEntry1:
        cmp bx,word ptr [rsi + r8 - 1]
		BEFORE_JMP
        jz  LookupLoopIsZero
		AFTER_JMP

LookupLoop2:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
		BEFORE_JMP
        jbe LeaveNow
		AFTER_JMP
        sub edx, 0x00010000
		BEFORE_JMP
        js  LeaveNow
		AFTER_JMP

LoopEntry2:
        cmp bx,word ptr [rsi + r8 - 1]
		BEFORE_JMP
        jz  LookupLoopIsZero
		AFTER_JMP

LookupLoop4:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
		BEFORE_JMP
        jbe LeaveNow
		AFTER_JMP
        sub edx, 0x00010000
		BEFORE_JMP
        js  LeaveNow
		AFTER_JMP

LoopEntry4:

        cmp bx,word ptr [rsi + r8 - 1]
		BEFORE_JMP
        jnz LookupLoop1
        jmp LookupLoopIsZero
		AFTER_JMP
/*
;;; do {
;;;     match = s->window + cur_match;
;;;     if (*(ushf*)(match+best_len-1) != scan_end ||
;;;         *(ushf*)match != scan_start) continue;
;;;     [...]
;;; } while ((cur_match = prev[cur_match & wmask]) > limit
;;;          && --chain_length != 0);
;;;
;;; Here is the inner loop of the function. The function will spend the
;;; majority of its time in this loop, and majority of that time will
;;; be spent in the first ten instructions.
;;;
;;; Within this loop:
;;; ebx = scanend
;;; r8d = curmatch
;;; edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
;;; esi = windowbestlen - i.e., (window + bestlen)
;;; edi = prev
;;; ebp = limit
*/
.balign 16
LookupLoop:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
		BEFORE_JMP
        jbe LeaveNow
		AFTER_JMP
        sub edx, 0x00010000
		BEFORE_JMP
        js  LeaveNow
		AFTER_JMP

LoopEntry:

        cmp bx,word ptr [rsi + r8 - 1]
		BEFORE_JMP
        jnz LookupLoop1
		AFTER_JMP
LookupLoopIsZero:
        cmp     r12w, word ptr [r10 + r8]
		BEFORE_JMP
        jnz LookupLoop1
		AFTER_JMP


//;;; Store the current value of chainlen.
        mov [chainlenwmask], edx
/*
;;; Point edi to the string under scrutiny, and esi to the string we
;;; are hoping to match it up with. In actuality, esi and edi are
;;; both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and edx is
;;; initialized to -(MAX_MATCH_8 - scanalign).
*/
        lea rsi,[r8+r10]
        mov rdx, 0xfffffffffffffef8 //; -(MAX_MATCH_8)
        lea rsi, [rsi + r13 + 0x0108] //;MAX_MATCH_8]
        lea rdi, [r9 + r13 + 0x0108] //;MAX_MATCH_8]

        prefetcht1 [rsi+rdx]
        prefetcht1 [rdi+rdx]

/*
;;; Test the strings for equality, 8 bytes at a time. At the end,
;;; adjust rdx so that it is offset to the exact byte that mismatched.
;;;
;;; We already know at this point that the first three bytes of the
;;; strings match each other, and they can be safely passed over before
;;; starting the compare loop. So what this code does is skip over 0-3
;;; bytes, as much as necessary in order to dword-align the edi
;;; pointer. (rsi will still be misaligned three times out of four.)
;;;
;;; It should be confessed that this loop usually does not represent
;;; much of the total running time. Replacing it with a more
;;; straightforward "rep cmpsb" would not drastically degrade
;;; performance.
*/

LoopCmps:
        mov rax, [rsi + rdx]
        xor rax, [rdi + rdx]
        jnz LeaveLoopCmps

        mov rax, [rsi + rdx + 8]
        xor rax, [rdi + rdx + 8]
        jnz LeaveLoopCmps8


        mov rax, [rsi + rdx + 8+8]
        xor rax, [rdi + rdx + 8+8]
        jnz LeaveLoopCmps16

        add rdx,8+8+8

		BEFORE_JMP
        jnz  LoopCmps
        jmp  LenMaximum
		AFTER_JMP
		
LeaveLoopCmps16: add rdx,8
LeaveLoopCmps8: add rdx,8
LeaveLoopCmps:

        test    eax, 0x0000FFFF
        jnz LenLower

        test eax,0xffffffff

        jnz LenLower32

        add rdx,4
        shr rax,32
        or ax,ax
		BEFORE_JMP
        jnz LenLower
		AFTER_JMP

LenLower32:
        shr eax,16
        add rdx,2
		
LenLower:		
        sub al, 1
        adc rdx, 0
//;;; Calculate the length of the match. If it is longer than MAX_MATCH,
//;;; then automatically accept it as the best possible match and leave.

        lea rax, [rdi + rdx]
        sub rax, r9
        cmp eax, MAX_MATCH
		BEFORE_JMP
        jge LenMaximum
		AFTER_JMP
/*
;;; If the length of the match is not longer than the best match we
;;; have so far, then forget it and return to the lookup loop.
;///////////////////////////////////
*/
        cmp eax, r11d
        jg  LongerMatch

        lea rsi,[r10+r11]

        mov rdi, prev_ad
        mov edx, [chainlenwmask]
		BEFORE_JMP
        jmp LookupLoop
		AFTER_JMP
/*
;;;         s->match_start = cur_match;
;;;         best_len = len;
;;;         if (len >= nice_match) break;
;;;         scan_end = *(ushf*)(scan+best_len-1);
*/
LongerMatch:
        mov r11d, eax
        mov match_start, r8d
        cmp eax, [nicematch]
		BEFORE_JMP
        jge LeaveNow
		AFTER_JMP

        lea rsi,[r10+rax]

        movzx   ebx, word ptr [r9 + rax - 1]
        mov rdi, prev_ad
        mov edx, [chainlenwmask]
		BEFORE_JMP
        jmp LookupLoop
		AFTER_JMP

//;;; Accept the current string, with the maximum possible length.

LenMaximum:
        mov r11d,MAX_MATCH
        mov match_start, r8d

//;;; if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
//;;; return s->lookahead;

LeaveNow:
        mov eax, Lookahead
        cmp r11d, eax
        cmovng eax, r11d



//;;; Restore the stack and return from whence we came.


//        mov rsi,[save_rsi]
//        mov rdi,[save_rdi]
        mov rbx,[save_rbx]
        mov rbp,[save_rbp]
        mov r12,[save_r12]
        mov r13,[save_r13]
        mov r14,[save_r14]
        mov r15,[save_r15]


        ret 0
//; please don't remove this string !
//; Your can freely use gvmat64 in any free or commercial app
//; but it is far better don't remove the string in the binary!
 //   db     0dh,0ah,"asm686 with masm, optimised assembly code from Brian Raiter, written 1998, converted to amd 64 by Gilles Vollant 2005",0dh,0ah,0


match_init:
  ret 0


Deleted compat/zlib/contrib/infback9/README.

1

-
See infback9.h for what this is and how to use it.

Deleted compat/zlib/contrib/infback9/infback9.c.

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







































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* infback9.c -- inflate deflate64 data using a call-back interface
 * Copyright (C) 1995-2008 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "zutil.h"
#include "infback9.h"
#include "inftree9.h"
#include "inflate9.h"

#define WSIZE 65536UL

/*
   strm provides memory allocation functions in zalloc and zfree, or
   Z_NULL to use the library memory allocation functions.

   window is a user-supplied window and output buffer that is 64K bytes.
 */
int ZEXPORT inflateBack9Init_(strm, window, version, stream_size)
z_stream FAR *strm;
unsigned char FAR *window;
const char *version;
int stream_size;
{
    struct inflate_state FAR *state;

    if (version == Z_NULL || version[0] != ZLIB_VERSION[0] ||
        stream_size != (int)(sizeof(z_stream)))
        return Z_VERSION_ERROR;
    if (strm == Z_NULL || window == Z_NULL)
        return Z_STREAM_ERROR;
    strm->msg = Z_NULL;                 /* in case we return an error */
    if (strm->zalloc == (alloc_func)0) {
        strm->zalloc = zcalloc;
        strm->opaque = (voidpf)0;
    }
    if (strm->zfree == (free_func)0) strm->zfree = zcfree;
    state = (struct inflate_state FAR *)ZALLOC(strm, 1,
                                               sizeof(struct inflate_state));
    if (state == Z_NULL) return Z_MEM_ERROR;
    Tracev((stderr, "inflate: allocated\n"));
    strm->state = (voidpf)state;
    state->window = window;
    return Z_OK;
}

/*
   Build and output length and distance decoding tables for fixed code
   decoding.
 */
#ifdef MAKEFIXED
#include <stdio.h>

void makefixed9(void)
{
    unsigned sym, bits, low, size;
    code *next, *lenfix, *distfix;
    struct inflate_state state;
    code fixed[544];

    /* literal/length table */
    sym = 0;
    while (sym < 144) state.lens[sym++] = 8;
    while (sym < 256) state.lens[sym++] = 9;
    while (sym < 280) state.lens[sym++] = 7;
    while (sym < 288) state.lens[sym++] = 8;
    next = fixed;
    lenfix = next;
    bits = 9;
    inflate_table9(LENS, state.lens, 288, &(next), &(bits), state.work);

    /* distance table */
    sym = 0;
    while (sym < 32) state.lens[sym++] = 5;
    distfix = next;
    bits = 5;
    inflate_table9(DISTS, state.lens, 32, &(next), &(bits), state.work);

    /* write tables */
    puts("    /* inffix9.h -- table for decoding deflate64 fixed codes");
    puts("     * Generated automatically by makefixed9().");
    puts("     */");
    puts("");
    puts("    /* WARNING: this file should *not* be used by applications.");
    puts("       It is part of the implementation of this library and is");
    puts("       subject to change. Applications should only use zlib.h.");
    puts("     */");
    puts("");
    size = 1U << 9;
    printf("    static const code lenfix[%u] = {", size);
    low = 0;
    for (;;) {
        if ((low % 6) == 0) printf("\n        ");
        printf("{%u,%u,%d}", lenfix[low].op, lenfix[low].bits,
               lenfix[low].val);
        if (++low == size) break;
        putchar(',');
    }
    puts("\n    };");
    size = 1U << 5;
    printf("\n    static const code distfix[%u] = {", size);
    low = 0;
    for (;;) {
        if ((low % 5) == 0) printf("\n        ");
        printf("{%u,%u,%d}", distfix[low].op, distfix[low].bits,
               distfix[low].val);
        if (++low == size) break;
        putchar(',');
    }
    puts("\n    };");
}
#endif /* MAKEFIXED */

/* Macros for inflateBack(): */

/* Clear the input bit accumulator */
#define INITBITS() \
    do { \
        hold = 0; \
        bits = 0; \
    } while (0)

/* Assure that some input is available.  If input is requested, but denied,
   then return a Z_BUF_ERROR from inflateBack(). */
#define PULL() \
    do { \
        if (have == 0) { \
            have = in(in_desc, &next); \
            if (have == 0) { \
                next = Z_NULL; \
                ret = Z_BUF_ERROR; \
                goto inf_leave; \
            } \
        } \
    } while (0)

/* Get a byte of input into the bit accumulator, or return from inflateBack()
   with an error if there is no input available. */
#define PULLBYTE() \
    do { \
        PULL(); \
        have--; \
        hold += (unsigned long)(*next++) << bits; \
        bits += 8; \
    } while (0)

/* Assure that there are at least n bits in the bit accumulator.  If there is
   not enough available input to do that, then return from inflateBack() with
   an error. */
#define NEEDBITS(n) \
    do { \
        while (bits < (unsigned)(n)) \
            PULLBYTE(); \
    } while (0)

/* Return the low n bits of the bit accumulator (n <= 16) */
#define BITS(n) \
    ((unsigned)hold & ((1U << (n)) - 1))

/* Remove n bits from the bit accumulator */
#define DROPBITS(n) \
    do { \
        hold >>= (n); \
        bits -= (unsigned)(n); \
    } while (0)

/* Remove zero to seven bits as needed to go to a byte boundary */
#define BYTEBITS() \
    do { \
        hold >>= bits & 7; \
        bits -= bits & 7; \
    } while (0)

/* Assure that some output space is available, by writing out the window
   if it's full.  If the write fails, return from inflateBack() with a
   Z_BUF_ERROR. */
#define ROOM() \
    do { \
        if (left == 0) { \
            put = window; \
            left = WSIZE; \
            wrap = 1; \
            if (out(out_desc, put, (unsigned)left)) { \
                ret = Z_BUF_ERROR; \
                goto inf_leave; \
            } \
        } \
    } while (0)

/*
   strm provides the memory allocation functions and window buffer on input,
   and provides information on the unused input on return.  For Z_DATA_ERROR
   returns, strm will also provide an error message.

   in() and out() are the call-back input and output functions.  When
   inflateBack() needs more input, it calls in().  When inflateBack() has
   filled the window with output, or when it completes with data in the
   window, it calls out() to write out the data.  The application must not
   change the provided input until in() is called again or inflateBack()
   returns.  The application must not change the window/output buffer until
   inflateBack() returns.

   in() and out() are called with a descriptor parameter provided in the
   inflateBack() call.  This parameter can be a structure that provides the
   information required to do the read or write, as well as accumulated
   information on the input and output such as totals and check values.

   in() should return zero on failure.  out() should return non-zero on
   failure.  If either in() or out() fails, than inflateBack() returns a
   Z_BUF_ERROR.  strm->next_in can be checked for Z_NULL to see whether it
   was in() or out() that caused in the error.  Otherwise,  inflateBack()
   returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format
   error, or Z_MEM_ERROR if it could not allocate memory for the state.
   inflateBack() can also return Z_STREAM_ERROR if the input parameters
   are not correct, i.e. strm is Z_NULL or the state was not initialized.
 */
int ZEXPORT inflateBack9(strm, in, in_desc, out, out_desc)
z_stream FAR *strm;
in_func in;
void FAR *in_desc;
out_func out;
void FAR *out_desc;
{
    struct inflate_state FAR *state;
    z_const unsigned char FAR *next;    /* next input */
    unsigned char FAR *put;     /* next output */
    unsigned have;              /* available input */
    unsigned long left;         /* available output */
    inflate_mode mode;          /* current inflate mode */
    int lastblock;              /* true if processing last block */
    int wrap;                   /* true if the window has wrapped */
    unsigned char FAR *window;  /* allocated sliding window, if needed */
    unsigned long hold;         /* bit buffer */
    unsigned bits;              /* bits in bit buffer */
    unsigned extra;             /* extra bits needed */
    unsigned long length;       /* literal or length of data to copy */
    unsigned long offset;       /* distance back to copy string from */
    unsigned long copy;         /* number of stored or match bytes to copy */
    unsigned char FAR *from;    /* where to copy match bytes from */
    code const FAR *lencode;    /* starting table for length/literal codes */
    code const FAR *distcode;   /* starting table for distance codes */
    unsigned lenbits;           /* index bits for lencode */
    unsigned distbits;          /* index bits for distcode */
    code here;                  /* current decoding table entry */
    code last;                  /* parent table entry */
    unsigned len;               /* length to copy for repeats, bits to drop */
    int ret;                    /* return code */
    static const unsigned short order[19] = /* permutation of code lengths */
        {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};
#include "inffix9.h"

    /* Check that the strm exists and that the state was initialized */
    if (strm == Z_NULL || strm->state == Z_NULL)
        return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;

    /* Reset the state */
    strm->msg = Z_NULL;
    mode = TYPE;
    lastblock = 0;
    wrap = 0;
    window = state->window;
    next = strm->next_in;
    have = next != Z_NULL ? strm->avail_in : 0;
    hold = 0;
    bits = 0;
    put = window;
    left = WSIZE;
    lencode = Z_NULL;
    distcode = Z_NULL;

    /* Inflate until end of block marked as last */
    for (;;)
        switch (mode) {
        case TYPE:
            /* determine and dispatch block type */
            if (lastblock) {
                BYTEBITS();
                mode = DONE;
                break;
            }
            NEEDBITS(3);
            lastblock = BITS(1);
            DROPBITS(1);
            switch (BITS(2)) {
            case 0:                             /* stored block */
                Tracev((stderr, "inflate:     stored block%s\n",
                        lastblock ? " (last)" : ""));
                mode = STORED;
                break;
            case 1:                             /* fixed block */
                lencode = lenfix;
                lenbits = 9;
                distcode = distfix;
                distbits = 5;
                Tracev((stderr, "inflate:     fixed codes block%s\n",
                        lastblock ? " (last)" : ""));
                mode = LEN;                     /* decode codes */
                break;
            case 2:                             /* dynamic block */
                Tracev((stderr, "inflate:     dynamic codes block%s\n",
                        lastblock ? " (last)" : ""));
                mode = TABLE;
                break;
            case 3:
                strm->msg = (char *)"invalid block type";
                mode = BAD;
            }
            DROPBITS(2);
            break;

        case STORED:
            /* get and verify stored block length */
            BYTEBITS();                         /* go to byte boundary */
            NEEDBITS(32);
            if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) {
                strm->msg = (char *)"invalid stored block lengths";
                mode = BAD;
                break;
            }
            length = (unsigned)hold & 0xffff;
            Tracev((stderr, "inflate:       stored length %lu\n",
                    length));
            INITBITS();

            /* copy stored block from input to output */
            while (length != 0) {
                copy = length;
                PULL();
                ROOM();
                if (copy > have) copy = have;
                if (copy > left) copy = left;
                zmemcpy(put, next, copy);
                have -= copy;
                next += copy;
                left -= copy;
                put += copy;
                length -= copy;
            }
            Tracev((stderr, "inflate:       stored end\n"));
            mode = TYPE;
            break;

        case TABLE:
            /* get dynamic table entries descriptor */
            NEEDBITS(14);
            state->nlen = BITS(5) + 257;
            DROPBITS(5);
            state->ndist = BITS(5) + 1;
            DROPBITS(5);
            state->ncode = BITS(4) + 4;
            DROPBITS(4);
            if (state->nlen > 286) {
                strm->msg = (char *)"too many length symbols";
                mode = BAD;
                break;
            }
            Tracev((stderr, "inflate:       table sizes ok\n"));

            /* get code length code lengths (not a typo) */
            state->have = 0;
            while (state->have < state->ncode) {
                NEEDBITS(3);
                state->lens[order[state->have++]] = (unsigned short)BITS(3);
                DROPBITS(3);
            }
            while (state->have < 19)
                state->lens[order[state->have++]] = 0;
            state->next = state->codes;
            lencode = (code const FAR *)(state->next);
            lenbits = 7;
            ret = inflate_table9(CODES, state->lens, 19, &(state->next),
                                &(lenbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid code lengths set";
                mode = BAD;
                break;
            }
            Tracev((stderr, "inflate:       code lengths ok\n"));

            /* get length and distance code code lengths */
            state->have = 0;
            while (state->have < state->nlen + state->ndist) {
                for (;;) {
                    here = lencode[BITS(lenbits)];
                    if ((unsigned)(here.bits) <= bits) break;
                    PULLBYTE();
                }
                if (here.val < 16) {
                    NEEDBITS(here.bits);
                    DROPBITS(here.bits);
                    state->lens[state->have++] = here.val;
                }
                else {
                    if (here.val == 16) {
                        NEEDBITS(here.bits + 2);
                        DROPBITS(here.bits);
                        if (state->have == 0) {
                            strm->msg = (char *)"invalid bit length repeat";
                            mode = BAD;
                            break;
                        }
                        len = (unsigned)(state->lens[state->have - 1]);
                        copy = 3 + BITS(2);
                        DROPBITS(2);
                    }
                    else if (here.val == 17) {
                        NEEDBITS(here.bits + 3);
                        DROPBITS(here.bits);
                        len = 0;
                        copy = 3 + BITS(3);
                        DROPBITS(3);
                    }
                    else {
                        NEEDBITS(here.bits + 7);
                        DROPBITS(here.bits);
                        len = 0;
                        copy = 11 + BITS(7);
                        DROPBITS(7);
                    }
                    if (state->have + copy > state->nlen + state->ndist) {
                        strm->msg = (char *)"invalid bit length repeat";
                        mode = BAD;
                        break;
                    }
                    while (copy--)
                        state->lens[state->have++] = (unsigned short)len;
                }
            }

            /* handle error breaks in while */
            if (mode == BAD) break;

            /* check for end-of-block code (better have one) */
            if (state->lens[256] == 0) {
                strm->msg = (char *)"invalid code -- missing end-of-block";
                mode = BAD;
                break;
            }

            /* build code tables -- note: do not change the lenbits or distbits
               values here (9 and 6) without reading the comments in inftree9.h
               concerning the ENOUGH constants, which depend on those values */
            state->next = state->codes;
            lencode = (code const FAR *)(state->next);
            lenbits = 9;
            ret = inflate_table9(LENS, state->lens, state->nlen,
                            &(state->next), &(lenbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid literal/lengths set";
                mode = BAD;
                break;
            }
            distcode = (code const FAR *)(state->next);
            distbits = 6;
            ret = inflate_table9(DISTS, state->lens + state->nlen,
                            state->ndist, &(state->next), &(distbits),
                            state->work);
            if (ret) {
                strm->msg = (char *)"invalid distances set";
                mode = BAD;
                break;
            }
            Tracev((stderr, "inflate:       codes ok\n"));
            mode = LEN;

        case LEN:
            /* get a literal, length, or end-of-block code */
            for (;;) {
                here = lencode[BITS(lenbits)];
                if ((unsigned)(here.bits) <= bits) break;
                PULLBYTE();
            }
            if (here.op && (here.op & 0xf0) == 0) {
                last = here;
                for (;;) {
                    here = lencode[last.val +
                            (BITS(last.bits + last.op) >> last.bits)];
                    if ((unsigned)(last.bits + here.bits) <= bits) break;
                    PULLBYTE();
                }
                DROPBITS(last.bits);
            }
            DROPBITS(here.bits);
            length = (unsigned)here.val;

            /* process literal */
            if (here.op == 0) {
                Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
                        "inflate:         literal '%c'\n" :
                        "inflate:         literal 0x%02x\n", here.val));
                ROOM();
                *put++ = (unsigned char)(length);
                left--;
                mode = LEN;
                break;
            }

            /* process end of block */
            if (here.op & 32) {
                Tracevv((stderr, "inflate:         end of block\n"));
                mode = TYPE;
                break;
            }

            /* invalid code */
            if (here.op & 64) {
                strm->msg = (char *)"invalid literal/length code";
                mode = BAD;
                break;
            }

            /* length code -- get extra bits, if any */
            extra = (unsigned)(here.op) & 31;
            if (extra != 0) {
                NEEDBITS(extra);
                length += BITS(extra);
                DROPBITS(extra);
            }
            Tracevv((stderr, "inflate:         length %lu\n", length));

            /* get distance code */
            for (;;) {
                here = distcode[BITS(distbits)];
                if ((unsigned)(here.bits) <= bits) break;
                PULLBYTE();
            }
            if ((here.op & 0xf0) == 0) {
                last = here;
                for (;;) {
                    here = distcode[last.val +
                            (BITS(last.bits + last.op) >> last.bits)];
                    if ((unsigned)(last.bits + here.bits) <= bits) break;
                    PULLBYTE();
                }
                DROPBITS(last.bits);
            }
            DROPBITS(here.bits);
            if (here.op & 64) {
                strm->msg = (char *)"invalid distance code";
                mode = BAD;
                break;
            }
            offset = (unsigned)here.val;

            /* get distance extra bits, if any */
            extra = (unsigned)(here.op) & 15;
            if (extra != 0) {
                NEEDBITS(extra);
                offset += BITS(extra);
                DROPBITS(extra);
            }
            if (offset > WSIZE - (wrap ? 0: left)) {
                strm->msg = (char *)"invalid distance too far back";
                mode = BAD;
                break;
            }
            Tracevv((stderr, "inflate:         distance %lu\n", offset));

            /* copy match from window to output */
            do {
                ROOM();
                copy = WSIZE - offset;
                if (copy < left) {
                    from = put + copy;
                    copy = left - copy;
                }
                else {
                    from = put - offset;
                    copy = left;
                }
                if (copy > length) copy = length;
                length -= copy;
                left -= copy;
                do {
                    *put++ = *from++;
                } while (--copy);
            } while (length != 0);
            break;

        case DONE:
            /* inflate stream terminated properly -- write leftover output */
            ret = Z_STREAM_END;
            if (left < WSIZE) {
                if (out(out_desc, window, (unsigned)(WSIZE - left)))
                    ret = Z_BUF_ERROR;
            }
            goto inf_leave;

        case BAD:
            ret = Z_DATA_ERROR;
            goto inf_leave;

        default:                /* can't happen, but makes compilers happy */
            ret = Z_STREAM_ERROR;
            goto inf_leave;
        }

    /* Return unused input */
  inf_leave:
    strm->next_in = next;
    strm->avail_in = have;
    return ret;
}

int ZEXPORT inflateBack9End(strm)
z_stream FAR *strm;
{
    if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0)
        return Z_STREAM_ERROR;
    ZFREE(strm, strm->state);
    strm->state = Z_NULL;
    Tracev((stderr, "inflate: end\n"));
    return Z_OK;
}

Deleted compat/zlib/contrib/infback9/infback9.h.

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





































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* infback9.h -- header for using inflateBack9 functions
 * Copyright (C) 2003 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/*
 * This header file and associated patches provide a decoder for PKWare's
 * undocumented deflate64 compression method (method 9).  Use with infback9.c,
 * inftree9.h, inftree9.c, and inffix9.h.  These patches are not supported.
 * This should be compiled with zlib, since it uses zutil.h and zutil.o.
 * This code has not yet been tested on 16-bit architectures.  See the
 * comments in zlib.h for inflateBack() usage.  These functions are used
 * identically, except that there is no windowBits parameter, and a 64K
 * window must be provided.  Also if int's are 16 bits, then a zero for
 * the third parameter of the "out" function actually means 65536UL.
 * zlib.h must be included before this header file.
 */

#ifdef __cplusplus
extern "C" {
#endif

ZEXTERN int ZEXPORT inflateBack9 OF((z_stream FAR *strm,
                                    in_func in, void FAR *in_desc,
                                    out_func out, void FAR *out_desc));
ZEXTERN int ZEXPORT inflateBack9End OF((z_stream FAR *strm));
ZEXTERN int ZEXPORT inflateBack9Init_ OF((z_stream FAR *strm,
                                         unsigned char FAR *window,
                                         const char *version,
                                         int stream_size));
#define inflateBack9Init(strm, window) \
        inflateBack9Init_((strm), (window), \
        ZLIB_VERSION, sizeof(z_stream))

#ifdef __cplusplus
}
#endif

Deleted compat/zlib/contrib/infback9/inffix9.h.

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











































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
    /* inffix9.h -- table for decoding deflate64 fixed codes
     * Generated automatically by makefixed9().
     */

    /* WARNING: this file should *not* be used by applications.
       It is part of the implementation of this library and is
       subject to change. Applications should only use zlib.h.
     */

    static const code lenfix[512] = {
        {96,7,0},{0,8,80},{0,8,16},{132,8,115},{130,7,31},{0,8,112},
        {0,8,48},{0,9,192},{128,7,10},{0,8,96},{0,8,32},{0,9,160},
        {0,8,0},{0,8,128},{0,8,64},{0,9,224},{128,7,6},{0,8,88},
        {0,8,24},{0,9,144},{131,7,59},{0,8,120},{0,8,56},{0,9,208},
        {129,7,17},{0,8,104},{0,8,40},{0,9,176},{0,8,8},{0,8,136},
        {0,8,72},{0,9,240},{128,7,4},{0,8,84},{0,8,20},{133,8,227},
        {131,7,43},{0,8,116},{0,8,52},{0,9,200},{129,7,13},{0,8,100},
        {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},
        {128,7,8},{0,8,92},{0,8,28},{0,9,152},{132,7,83},{0,8,124},
        {0,8,60},{0,9,216},{130,7,23},{0,8,108},{0,8,44},{0,9,184},
        {0,8,12},{0,8,140},{0,8,76},{0,9,248},{128,7,3},{0,8,82},
        {0,8,18},{133,8,163},{131,7,35},{0,8,114},{0,8,50},{0,9,196},
        {129,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2},{0,8,130},
        {0,8,66},{0,9,228},{128,7,7},{0,8,90},{0,8,26},{0,9,148},
        {132,7,67},{0,8,122},{0,8,58},{0,9,212},{130,7,19},{0,8,106},
        {0,8,42},{0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},
        {128,7,5},{0,8,86},{0,8,22},{65,8,0},{131,7,51},{0,8,118},
        {0,8,54},{0,9,204},{129,7,15},{0,8,102},{0,8,38},{0,9,172},
        {0,8,6},{0,8,134},{0,8,70},{0,9,236},{128,7,9},{0,8,94},
        {0,8,30},{0,9,156},{132,7,99},{0,8,126},{0,8,62},{0,9,220},
        {130,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142},
        {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{133,8,131},
        {130,7,31},{0,8,113},{0,8,49},{0,9,194},{128,7,10},{0,8,97},
        {0,8,33},{0,9,162},{0,8,1},{0,8,129},{0,8,65},{0,9,226},
        {128,7,6},{0,8,89},{0,8,25},{0,9,146},{131,7,59},{0,8,121},
        {0,8,57},{0,9,210},{129,7,17},{0,8,105},{0,8,41},{0,9,178},
        {0,8,9},{0,8,137},{0,8,73},{0,9,242},{128,7,4},{0,8,85},
        {0,8,21},{144,8,3},{131,7,43},{0,8,117},{0,8,53},{0,9,202},
        {129,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},
        {0,8,69},{0,9,234},{128,7,8},{0,8,93},{0,8,29},{0,9,154},
        {132,7,83},{0,8,125},{0,8,61},{0,9,218},{130,7,23},{0,8,109},
        {0,8,45},{0,9,186},{0,8,13},{0,8,141},{0,8,77},{0,9,250},
        {128,7,3},{0,8,83},{0,8,19},{133,8,195},{131,7,35},{0,8,115},
        {0,8,51},{0,9,198},{129,7,11},{0,8,99},{0,8,35},{0,9,166},
        {0,8,3},{0,8,131},{0,8,67},{0,9,230},{128,7,7},{0,8,91},
        {0,8,27},{0,9,150},{132,7,67},{0,8,123},{0,8,59},{0,9,214},
        {130,7,19},{0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},
        {0,8,75},{0,9,246},{128,7,5},{0,8,87},{0,8,23},{77,8,0},
        {131,7,51},{0,8,119},{0,8,55},{0,9,206},{129,7,15},{0,8,103},
        {0,8,39},{0,9,174},{0,8,7},{0,8,135},{0,8,71},{0,9,238},
        {128,7,9},{0,8,95},{0,8,31},{0,9,158},{132,7,99},{0,8,127},
        {0,8,63},{0,9,222},{130,7,27},{0,8,111},{0,8,47},{0,9,190},
        {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},
        {0,8,16},{132,8,115},{130,7,31},{0,8,112},{0,8,48},{0,9,193},
        {128,7,10},{0,8,96},{0,8,32},{0,9,161},{0,8,0},{0,8,128},
        {0,8,64},{0,9,225},{128,7,6},{0,8,88},{0,8,24},{0,9,145},
        {131,7,59},{0,8,120},{0,8,56},{0,9,209},{129,7,17},{0,8,104},
        {0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72},{0,9,241},
        {128,7,4},{0,8,84},{0,8,20},{133,8,227},{131,7,43},{0,8,116},
        {0,8,52},{0,9,201},{129,7,13},{0,8,100},{0,8,36},{0,9,169},
        {0,8,4},{0,8,132},{0,8,68},{0,9,233},{128,7,8},{0,8,92},
        {0,8,28},{0,9,153},{132,7,83},{0,8,124},{0,8,60},{0,9,217},
        {130,7,23},{0,8,108},{0,8,44},{0,9,185},{0,8,12},{0,8,140},
        {0,8,76},{0,9,249},{128,7,3},{0,8,82},{0,8,18},{133,8,163},
        {131,7,35},{0,8,114},{0,8,50},{0,9,197},{129,7,11},{0,8,98},
        {0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229},
        {128,7,7},{0,8,90},{0,8,26},{0,9,149},{132,7,67},{0,8,122},
        {0,8,58},{0,9,213},{130,7,19},{0,8,106},{0,8,42},{0,9,181},
        {0,8,10},{0,8,138},{0,8,74},{0,9,245},{128,7,5},{0,8,86},
        {0,8,22},{65,8,0},{131,7,51},{0,8,118},{0,8,54},{0,9,205},
        {129,7,15},{0,8,102},{0,8,38},{0,9,173},{0,8,6},{0,8,134},
        {0,8,70},{0,9,237},{128,7,9},{0,8,94},{0,8,30},{0,9,157},
        {132,7,99},{0,8,126},{0,8,62},{0,9,221},{130,7,27},{0,8,110},
        {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},
        {96,7,0},{0,8,81},{0,8,17},{133,8,131},{130,7,31},{0,8,113},
        {0,8,49},{0,9,195},{128,7,10},{0,8,97},{0,8,33},{0,9,163},
        {0,8,1},{0,8,129},{0,8,65},{0,9,227},{128,7,6},{0,8,89},
        {0,8,25},{0,9,147},{131,7,59},{0,8,121},{0,8,57},{0,9,211},
        {129,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9},{0,8,137},
        {0,8,73},{0,9,243},{128,7,4},{0,8,85},{0,8,21},{144,8,3},
        {131,7,43},{0,8,117},{0,8,53},{0,9,203},{129,7,13},{0,8,101},
        {0,8,37},{0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},
        {128,7,8},{0,8,93},{0,8,29},{0,9,155},{132,7,83},{0,8,125},
        {0,8,61},{0,9,219},{130,7,23},{0,8,109},{0,8,45},{0,9,187},
        {0,8,13},{0,8,141},{0,8,77},{0,9,251},{128,7,3},{0,8,83},
        {0,8,19},{133,8,195},{131,7,35},{0,8,115},{0,8,51},{0,9,199},
        {129,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131},
        {0,8,67},{0,9,231},{128,7,7},{0,8,91},{0,8,27},{0,9,151},
        {132,7,67},{0,8,123},{0,8,59},{0,9,215},{130,7,19},{0,8,107},
        {0,8,43},{0,9,183},{0,8,11},{0,8,139},{0,8,75},{0,9,247},
        {128,7,5},{0,8,87},{0,8,23},{77,8,0},{131,7,51},{0,8,119},
        {0,8,55},{0,9,207},{129,7,15},{0,8,103},{0,8,39},{0,9,175},
        {0,8,7},{0,8,135},{0,8,71},{0,9,239},{128,7,9},{0,8,95},
        {0,8,31},{0,9,159},{132,7,99},{0,8,127},{0,8,63},{0,9,223},
        {130,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},
        {0,8,79},{0,9,255}
    };

    static const code distfix[32] = {
        {128,5,1},{135,5,257},{131,5,17},{139,5,4097},{129,5,5},
        {137,5,1025},{133,5,65},{141,5,16385},{128,5,3},{136,5,513},
        {132,5,33},{140,5,8193},{130,5,9},{138,5,2049},{134,5,129},
        {142,5,32769},{128,5,2},{135,5,385},{131,5,25},{139,5,6145},
        {129,5,7},{137,5,1537},{133,5,97},{141,5,24577},{128,5,4},
        {136,5,769},{132,5,49},{140,5,12289},{130,5,13},{138,5,3073},
        {134,5,193},{142,5,49153}
    };

Deleted compat/zlib/contrib/infback9/inflate9.h.

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















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inflate9.h -- internal inflate state definition
 * Copyright (C) 1995-2003 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* WARNING: this file should *not* be used by applications. It is
   part of the implementation of the compression library and is
   subject to change. Applications should only use zlib.h.
 */

/* Possible inflate modes between inflate() calls */
typedef enum {
        TYPE,       /* i: waiting for type bits, including last-flag bit */
        STORED,     /* i: waiting for stored size (length and complement) */
        TABLE,      /* i: waiting for dynamic block table lengths */
            LEN,        /* i: waiting for length/lit code */
    DONE,       /* finished check, done -- remain here until reset */
    BAD         /* got a data error -- remain here until reset */
} inflate_mode;

/*
    State transitions between above modes -

    (most modes can go to the BAD mode -- not shown for clarity)

    Read deflate blocks:
            TYPE -> STORED or TABLE or LEN or DONE
            STORED -> TYPE
            TABLE -> LENLENS -> CODELENS -> LEN
    Read deflate codes:
                LEN -> LEN or TYPE
 */

/* state maintained between inflate() calls.  Approximately 7K bytes. */
struct inflate_state {
        /* sliding window */
    unsigned char FAR *window;  /* allocated sliding window, if needed */
        /* dynamic table building */
    unsigned ncode;             /* number of code length code lengths */
    unsigned nlen;              /* number of length code lengths */
    unsigned ndist;             /* number of distance code lengths */
    unsigned have;              /* number of code lengths in lens[] */
    code FAR *next;             /* next available space in codes[] */
    unsigned short lens[320];   /* temporary storage for code lengths */
    unsigned short work[288];   /* work area for code table building */
    code codes[ENOUGH];         /* space for code tables */
};

Deleted compat/zlib/contrib/infback9/inftree9.c.

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




































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inftree9.c -- generate Huffman trees for efficient decoding
 * Copyright (C) 1995-2017 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "zutil.h"
#include "inftree9.h"

#define MAXBITS 15

const char inflate9_copyright[] =
   " inflate9 1.2.11 Copyright 1995-2017 Mark Adler ";
/*
  If you use the zlib library in a product, an acknowledgment is welcome
  in the documentation of your product. If for some reason you cannot
  include such an acknowledgment, I would appreciate that you keep this
  copyright string in the executable of your product.
 */

/*
   Build a set of tables to decode the provided canonical Huffman code.
   The code lengths are lens[0..codes-1].  The result starts at *table,
   whose indices are 0..2^bits-1.  work is a writable array of at least
   lens shorts, which is used as a work area.  type is the type of code
   to be generated, CODES, LENS, or DISTS.  On return, zero is success,
   -1 is an invalid code, and +1 means that ENOUGH isn't enough.  table
   on return points to the next available entry's address.  bits is the
   requested root table index bits, and on return it is the actual root
   table index bits.  It will differ if the request is greater than the
   longest code or if it is less than the shortest code.
 */
int inflate_table9(type, lens, codes, table, bits, work)
codetype type;
unsigned short FAR *lens;
unsigned codes;
code FAR * FAR *table;
unsigned FAR *bits;
unsigned short FAR *work;
{
    unsigned len;               /* a code's length in bits */
    unsigned sym;               /* index of code symbols */
    unsigned min, max;          /* minimum and maximum code lengths */
    unsigned root;              /* number of index bits for root table */
    unsigned curr;              /* number of index bits for current table */
    unsigned drop;              /* code bits to drop for sub-table */
    int left;                   /* number of prefix codes available */
    unsigned used;              /* code entries in table used */
    unsigned huff;              /* Huffman code */
    unsigned incr;              /* for incrementing code, index */
    unsigned fill;              /* index for replicating entries */
    unsigned low;               /* low bits for current root entry */
    unsigned mask;              /* mask for low root bits */
    code this;                  /* table entry for duplication */
    code FAR *next;             /* next available space in table */
    const unsigned short FAR *base;     /* base value table to use */
    const unsigned short FAR *extra;    /* extra bits table to use */
    int end;                    /* use base and extra for symbol > end */
    unsigned short count[MAXBITS+1];    /* number of codes of each length */
    unsigned short offs[MAXBITS+1];     /* offsets in table for each length */
    static const unsigned short lbase[31] = { /* Length codes 257..285 base */
        3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17,
        19, 23, 27, 31, 35, 43, 51, 59, 67, 83, 99, 115,
        131, 163, 195, 227, 3, 0, 0};
    static const unsigned short lext[31] = { /* Length codes 257..285 extra */
        128, 128, 128, 128, 128, 128, 128, 128, 129, 129, 129, 129,
        130, 130, 130, 130, 131, 131, 131, 131, 132, 132, 132, 132,
        133, 133, 133, 133, 144, 77, 202};
    static const unsigned short dbase[32] = { /* Distance codes 0..31 base */
        1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49,
        65, 97, 129, 193, 257, 385, 513, 769, 1025, 1537, 2049, 3073,
        4097, 6145, 8193, 12289, 16385, 24577, 32769, 49153};
    static const unsigned short dext[32] = { /* Distance codes 0..31 extra */
        128, 128, 128, 128, 129, 129, 130, 130, 131, 131, 132, 132,
        133, 133, 134, 134, 135, 135, 136, 136, 137, 137, 138, 138,
        139, 139, 140, 140, 141, 141, 142, 142};

    /*
       Process a set of code lengths to create a canonical Huffman code.  The
       code lengths are lens[0..codes-1].  Each length corresponds to the
       symbols 0..codes-1.  The Huffman code is generated by first sorting the
       symbols by length from short to long, and retaining the symbol order
       for codes with equal lengths.  Then the code starts with all zero bits
       for the first code of the shortest length, and the codes are integer
       increments for the same length, and zeros are appended as the length
       increases.  For the deflate format, these bits are stored backwards
       from their more natural integer increment ordering, and so when the
       decoding tables are built in the large loop below, the integer codes
       are incremented backwards.

       This routine assumes, but does not check, that all of the entries in
       lens[] are in the range 0..MAXBITS.  The caller must assure this.
       1..MAXBITS is interpreted as that code length.  zero means that that
       symbol does not occur in this code.

       The codes are sorted by computing a count of codes for each length,
       creating from that a table of starting indices for each length in the
       sorted table, and then entering the symbols in order in the sorted
       table.  The sorted table is work[], with that space being provided by
       the caller.

       The length counts are used for other purposes as well, i.e. finding
       the minimum and maximum length codes, determining if there are any
       codes at all, checking for a valid set of lengths, and looking ahead
       at length counts to determine sub-table sizes when building the
       decoding tables.
     */

    /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */
    for (len = 0; len <= MAXBITS; len++)
        count[len] = 0;
    for (sym = 0; sym < codes; sym++)
        count[lens[sym]]++;

    /* bound code lengths, force root to be within code lengths */
    root = *bits;
    for (max = MAXBITS; max >= 1; max--)
        if (count[max] != 0) break;
    if (root > max) root = max;
    if (max == 0) return -1;            /* no codes! */
    for (min = 1; min <= MAXBITS; min++)
        if (count[min] != 0) break;
    if (root < min) root = min;

    /* check for an over-subscribed or incomplete set of lengths */
    left = 1;
    for (len = 1; len <= MAXBITS; len++) {
        left <<= 1;
        left -= count[len];
        if (left < 0) return -1;        /* over-subscribed */
    }
    if (left > 0 && (type == CODES || max != 1))
        return -1;                      /* incomplete set */

    /* generate offsets into symbol table for each length for sorting */
    offs[1] = 0;
    for (len = 1; len < MAXBITS; len++)
        offs[len + 1] = offs[len] + count[len];

    /* sort symbols by length, by symbol order within each length */
    for (sym = 0; sym < codes; sym++)
        if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym;

    /*
       Create and fill in decoding tables.  In this loop, the table being
       filled is at next and has curr index bits.  The code being used is huff
       with length len.  That code is converted to an index by dropping drop
       bits off of the bottom.  For codes where len is less than drop + curr,
       those top drop + curr - len bits are incremented through all values to
       fill the table with replicated entries.

       root is the number of index bits for the root table.  When len exceeds
       root, sub-tables are created pointed to by the root entry with an index
       of the low root bits of huff.  This is saved in low to check for when a
       new sub-table should be started.  drop is zero when the root table is
       being filled, and drop is root when sub-tables are being filled.

       When a new sub-table is needed, it is necessary to look ahead in the
       code lengths to determine what size sub-table is needed.  The length
       counts are used for this, and so count[] is decremented as codes are
       entered in the tables.

       used keeps track of how many table entries have been allocated from the
       provided *table space.  It is checked for LENS and DIST tables against
       the constants ENOUGH_LENS and ENOUGH_DISTS to guard against changes in
       the initial root table size constants.  See the comments in inftree9.h
       for more information.

       sym increments through all symbols, and the loop terminates when
       all codes of length max, i.e. all codes, have been processed.  This
       routine permits incomplete codes, so another loop after this one fills
       in the rest of the decoding tables with invalid code markers.
     */

    /* set up for code type */
    switch (type) {
    case CODES:
        base = extra = work;    /* dummy value--not used */
        end = 19;
        break;
    case LENS:
        base = lbase;
        base -= 257;
        extra = lext;
        extra -= 257;
        end = 256;
        break;
    default:            /* DISTS */
        base = dbase;
        extra = dext;
        end = -1;
    }

    /* initialize state for loop */
    huff = 0;                   /* starting code */
    sym = 0;                    /* starting code symbol */
    len = min;                  /* starting code length */
    next = *table;              /* current table to fill in */
    curr = root;                /* current table index bits */
    drop = 0;                   /* current bits to drop from code for index */
    low = (unsigned)(-1);       /* trigger new sub-table when len > root */
    used = 1U << root;          /* use root table entries */
    mask = used - 1;            /* mask for comparing low */

    /* check available table space */
    if ((type == LENS && used >= ENOUGH_LENS) ||
        (type == DISTS && used >= ENOUGH_DISTS))
        return 1;

    /* process all codes and make table entries */
    for (;;) {
        /* create table entry */
        this.bits = (unsigned char)(len - drop);
        if ((int)(work[sym]) < end) {
            this.op = (unsigned char)0;
            this.val = work[sym];
        }
        else if ((int)(work[sym]) > end) {
            this.op = (unsigned char)(extra[work[sym]]);
            this.val = base[work[sym]];
        }
        else {
            this.op = (unsigned char)(32 + 64);         /* end of block */
            this.val = 0;
        }

        /* replicate for those indices with low len bits equal to huff */
        incr = 1U << (len - drop);
        fill = 1U << curr;
        do {
            fill -= incr;
            next[(huff >> drop) + fill] = this;
        } while (fill != 0);

        /* backwards increment the len-bit code huff */
        incr = 1U << (len - 1);
        while (huff & incr)
            incr >>= 1;
        if (incr != 0) {
            huff &= incr - 1;
            huff += incr;
        }
        else
            huff = 0;

        /* go to next symbol, update count, len */
        sym++;
        if (--(count[len]) == 0) {
            if (len == max) break;
            len = lens[work[sym]];
        }

        /* create new sub-table if needed */
        if (len > root && (huff & mask) != low) {
            /* if first time, transition to sub-tables */
            if (drop == 0)
                drop = root;

            /* increment past last table */
            next += 1U << curr;

            /* determine length of next table */
            curr = len - drop;
            left = (int)(1 << curr);
            while (curr + drop < max) {
                left -= count[curr + drop];
                if (left <= 0) break;
                curr++;
                left <<= 1;
            }

            /* check for enough space */
            used += 1U << curr;
            if ((type == LENS && used >= ENOUGH_LENS) ||
                (type == DISTS && used >= ENOUGH_DISTS))
                return 1;

            /* point entry in root table to sub-table */
            low = huff & mask;
            (*table)[low].op = (unsigned char)curr;
            (*table)[low].bits = (unsigned char)root;
            (*table)[low].val = (unsigned short)(next - *table);
        }
    }

    /*
       Fill in rest of table for incomplete codes.  This loop is similar to the
       loop above in incrementing huff for table indices.  It is assumed that
       len is equal to curr + drop, so there is no loop needed to increment
       through high index bits.  When the current sub-table is filled, the loop
       drops back to the root table to fill in any remaining entries there.
     */
    this.op = (unsigned char)64;                /* invalid code marker */
    this.bits = (unsigned char)(len - drop);
    this.val = (unsigned short)0;
    while (huff != 0) {
        /* when done with sub-table, drop back to root table */
        if (drop != 0 && (huff & mask) != low) {
            drop = 0;
            len = root;
            next = *table;
            curr = root;
            this.bits = (unsigned char)len;
        }

        /* put invalid code marker in table */
        next[huff >> drop] = this;

        /* backwards increment the len-bit code huff */
        incr = 1U << (len - 1);
        while (huff & incr)
            incr >>= 1;
        if (incr != 0) {
            huff &= incr - 1;
            huff += incr;
        }
        else
            huff = 0;
    }

    /* set return parameters */
    *table += used;
    *bits = root;
    return 0;
}

Deleted compat/zlib/contrib/infback9/inftree9.h.

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





























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inftree9.h -- header to use inftree9.c
 * Copyright (C) 1995-2008 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* WARNING: this file should *not* be used by applications. It is
   part of the implementation of the compression library and is
   subject to change. Applications should only use zlib.h.
 */

/* Structure for decoding tables.  Each entry provides either the
   information needed to do the operation requested by the code that
   indexed that table entry, or it provides a pointer to another
   table that indexes more bits of the code.  op indicates whether
   the entry is a pointer to another table, a literal, a length or
   distance, an end-of-block, or an invalid code.  For a table
   pointer, the low four bits of op is the number of index bits of
   that table.  For a length or distance, the low four bits of op
   is the number of extra bits to get after the code.  bits is
   the number of bits in this code or part of the code to drop off
   of the bit buffer.  val is the actual byte to output in the case
   of a literal, the base length or distance, or the offset from
   the current table to the next table.  Each entry is four bytes. */
typedef struct {
    unsigned char op;           /* operation, extra bits, table bits */
    unsigned char bits;         /* bits in this part of the code */
    unsigned short val;         /* offset in table or code value */
} code;

/* op values as set by inflate_table():
    00000000 - literal
    0000tttt - table link, tttt != 0 is the number of table index bits
    100eeeee - length or distance, eeee is the number of extra bits
    01100000 - end of block
    01000000 - invalid code
 */

/* Maximum size of the dynamic table.  The maximum number of code structures is
   1446, which is the sum of 852 for literal/length codes and 594 for distance
   codes.  These values were found by exhaustive searches using the program
   examples/enough.c found in the zlib distribtution.  The arguments to that
   program are the number of symbols, the initial root table size, and the
   maximum bit length of a code.  "enough 286 9 15" for literal/length codes
   returns returns 852, and "enough 32 6 15" for distance codes returns 594.
   The initial root table size (9 or 6) is found in the fifth argument of the
   inflate_table() calls in infback9.c.  If the root table size is changed,
   then these maximum sizes would be need to be recalculated and updated. */
#define ENOUGH_LENS 852
#define ENOUGH_DISTS 594
#define ENOUGH (ENOUGH_LENS+ENOUGH_DISTS)

/* Type of code to build for inflate_table9() */
typedef enum {
    CODES,
    LENS,
    DISTS
} codetype;

extern int inflate_table9 OF((codetype type, unsigned short FAR *lens,
                             unsigned codes, code FAR * FAR *table,
                             unsigned FAR *bits, unsigned short FAR *work));

Deleted compat/zlib/contrib/inflate86/inffas86.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157





































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inffas86.c is a hand tuned assembler version of
 *
 * inffast.c -- fast decoding
 * Copyright (C) 1995-2003 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 *
 * Copyright (C) 2003 Chris Anderson <christop@charm.net>
 * Please use the copyright conditions above.
 *
 * Dec-29-2003 -- I added AMD64 inflate asm support.  This version is also
 * slightly quicker on x86 systems because, instead of using rep movsb to copy
 * data, it uses rep movsw, which moves data in 2-byte chunks instead of single
 * bytes.  I've tested the AMD64 code on a Fedora Core 1 + the x86_64 updates
 * from http://fedora.linux.duke.edu/fc1_x86_64
 * which is running on an Athlon 64 3000+ / Gigabyte GA-K8VT800M system with
 * 1GB ram.  The 64-bit version is about 4% faster than the 32-bit version,
 * when decompressing mozilla-source-1.3.tar.gz.
 *
 * Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
 * the gcc -S output of zlib-1.2.0/inffast.c.  Zlib-1.2.0 is in beta release at
 * the moment.  I have successfully compiled and tested this code with gcc2.96,
 * gcc3.2, icc5.0, msvc6.0.  It is very close to the speed of inffast.S
 * compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
 * enabled.  I will attempt to merge the MMX code into this version.  Newer
 * versions of this and inffast.S can be found at
 * http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
 */

#include "zutil.h"
#include "inftrees.h"
#include "inflate.h"
#include "inffast.h"

/* Mark Adler's comments from inffast.c: */

/*
   Decode literal, length, and distance codes and write out the resulting
   literal and match bytes until either not enough input or output is
   available, an end-of-block is encountered, or a data error is encountered.
   When large enough input and output buffers are supplied to inflate(), for
   example, a 16K input buffer and a 64K output buffer, more than 95% of the
   inflate execution time is spent in this routine.

   Entry assumptions:

        state->mode == LEN
        strm->avail_in >= 6
        strm->avail_out >= 258
        start >= strm->avail_out
        state->bits < 8

   On return, state->mode is one of:

        LEN -- ran out of enough output space or enough available input
        TYPE -- reached end of block code, inflate() to interpret next block
        BAD -- error in block data

   Notes:

    - The maximum input bits used by a length/distance pair is 15 bits for the
      length code, 5 bits for the length extra, 15 bits for the distance code,
      and 13 bits for the distance extra.  This totals 48 bits, or six bytes.
      Therefore if strm->avail_in >= 6, then there is enough input to avoid
      checking for available input while decoding.

    - The maximum bytes that a single length/distance pair can output is 258
      bytes, which is the maximum length that can be coded.  inflate_fast()
      requires strm->avail_out >= 258 for each loop to avoid checking for
      output space.
 */
void inflate_fast(strm, start)
z_streamp strm;
unsigned start;         /* inflate()'s starting value for strm->avail_out */
{
    struct inflate_state FAR *state;
    struct inffast_ar {
/* 64   32                               x86  x86_64 */
/* ar offset                              register */
/*  0    0 */ void *esp;                /* esp save */
/*  8    4 */ void *ebp;                /* ebp save */
/* 16    8 */ unsigned char FAR *in;    /* esi rsi  local strm->next_in */
/* 24   12 */ unsigned char FAR *last;  /*     r9   while in < last */
/* 32   16 */ unsigned char FAR *out;   /* edi rdi  local strm->next_out */
/* 40   20 */ unsigned char FAR *beg;   /*          inflate()'s init next_out */
/* 48   24 */ unsigned char FAR *end;   /*     r10  while out < end */
/* 56   28 */ unsigned char FAR *window;/*          size of window, wsize!=0 */
/* 64   32 */ code const FAR *lcode;    /* ebp rbp  local strm->lencode */
/* 72   36 */ code const FAR *dcode;    /*     r11  local strm->distcode */
/* 80   40 */ unsigned long hold;       /* edx rdx  local strm->hold */
/* 88   44 */ unsigned bits;            /* ebx rbx  local strm->bits */
/* 92   48 */ unsigned wsize;           /*          window size */
/* 96   52 */ unsigned write;           /*          window write index */
/*100   56 */ unsigned lmask;           /*     r12  mask for lcode */
/*104   60 */ unsigned dmask;           /*     r13  mask for dcode */
/*108   64 */ unsigned len;             /*     r14  match length */
/*112   68 */ unsigned dist;            /*     r15  match distance */
/*116   72 */ unsigned status;          /*          set when state chng*/
    } ar;

#if defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )
#define PAD_AVAIL_IN 6
#define PAD_AVAIL_OUT 258
#else
#define PAD_AVAIL_IN 5
#define PAD_AVAIL_OUT 257
#endif

    /* copy state to local variables */
    state = (struct inflate_state FAR *)strm->state;
    ar.in = strm->next_in;
    ar.last = ar.in + (strm->avail_in - PAD_AVAIL_IN);
    ar.out = strm->next_out;
    ar.beg = ar.out - (start - strm->avail_out);
    ar.end = ar.out + (strm->avail_out - PAD_AVAIL_OUT);
    ar.wsize = state->wsize;
    ar.write = state->wnext;
    ar.window = state->window;
    ar.hold = state->hold;
    ar.bits = state->bits;
    ar.lcode = state->lencode;
    ar.dcode = state->distcode;
    ar.lmask = (1U << state->lenbits) - 1;
    ar.dmask = (1U << state->distbits) - 1;

    /* decode literals and length/distances until end-of-block or not enough
       input data or output space */

    /* align in on 1/2 hold size boundary */
    while (((unsigned long)(void *)ar.in & (sizeof(ar.hold) / 2 - 1)) != 0) {
        ar.hold += (unsigned long)*ar.in++ << ar.bits;
        ar.bits += 8;
    }

#if defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )
    __asm__ __volatile__ (
"        leaq    %0, %%rax\n"
"        movq    %%rbp, 8(%%rax)\n"       /* save regs rbp and rsp */
"        movq    %%rsp, (%%rax)\n"
"        movq    %%rax, %%rsp\n"          /* make rsp point to &ar */
"        movq    16(%%rsp), %%rsi\n"      /* rsi  = in */
"        movq    32(%%rsp), %%rdi\n"      /* rdi  = out */
"        movq    24(%%rsp), %%r9\n"       /* r9   = last */
"        movq    48(%%rsp), %%r10\n"      /* r10  = end */
"        movq    64(%%rsp), %%rbp\n"      /* rbp  = lcode */
"        movq    72(%%rsp), %%r11\n"      /* r11  = dcode */
"        movq    80(%%rsp), %%rdx\n"      /* rdx  = hold */
"        movl    88(%%rsp), %%ebx\n"      /* ebx  = bits */
"        movl    100(%%rsp), %%r12d\n"    /* r12d = lmask */
"        movl    104(%%rsp), %%r13d\n"    /* r13d = dmask */
                                          /* r14d = len */
                                          /* r15d = dist */
"        cld\n"
"        cmpq    %%rdi, %%r10\n"
"        je      .L_one_time\n"           /* if only one decode left */
"        cmpq    %%rsi, %%r9\n"
"        je      .L_one_time\n"
"        jmp     .L_do_loop\n"

".L_one_time:\n"
"        movq    %%r12, %%r8\n"           /* r8 = lmask */
"        cmpb    $32, %%bl\n"
"        ja      .L_get_length_code_one_time\n"

"        lodsl\n"                         /* eax = *(uint *)in++ */
"        movb    %%bl, %%cl\n"            /* cl = bits, needs it for shifting */
"        addb    $32, %%bl\n"             /* bits += 32 */
"        shlq    %%cl, %%rax\n"
"        orq     %%rax, %%rdx\n"          /* hold |= *((uint *)in)++ << bits */
"        jmp     .L_get_length_code_one_time\n"

".align 32,0x90\n"
".L_while_test:\n"
"        cmpq    %%rdi, %%r10\n"
"        jbe     .L_break_loop\n"
"        cmpq    %%rsi, %%r9\n"
"        jbe     .L_break_loop\n"

".L_do_loop:\n"
"        movq    %%r12, %%r8\n"           /* r8 = lmask */
"        cmpb    $32, %%bl\n"
"        ja      .L_get_length_code\n"    /* if (32 < bits) */

"        lodsl\n"                         /* eax = *(uint *)in++ */
"        movb    %%bl, %%cl\n"            /* cl = bits, needs it for shifting */
"        addb    $32, %%bl\n"             /* bits += 32 */
"        shlq    %%cl, %%rax\n"
"        orq     %%rax, %%rdx\n"          /* hold |= *((uint *)in)++ << bits */

".L_get_length_code:\n"
"        andq    %%rdx, %%r8\n"            /* r8 &= hold */
"        movl    (%%rbp,%%r8,4), %%eax\n"  /* eax = lcode[hold & lmask] */

"        movb    %%ah, %%cl\n"            /* cl = this.bits */
"        subb    %%ah, %%bl\n"            /* bits -= this.bits */
"        shrq    %%cl, %%rdx\n"           /* hold >>= this.bits */

"        testb   %%al, %%al\n"
"        jnz     .L_test_for_length_base\n" /* if (op != 0) 45.7% */

"        movq    %%r12, %%r8\n"            /* r8 = lmask */
"        shrl    $16, %%eax\n"            /* output this.val char */
"        stosb\n"

".L_get_length_code_one_time:\n"
"        andq    %%rdx, %%r8\n"            /* r8 &= hold */
"        movl    (%%rbp,%%r8,4), %%eax\n" /* eax = lcode[hold & lmask] */

".L_dolen:\n"
"        movb    %%ah, %%cl\n"            /* cl = this.bits */
"        subb    %%ah, %%bl\n"            /* bits -= this.bits */
"        shrq    %%cl, %%rdx\n"           /* hold >>= this.bits */

"        testb   %%al, %%al\n"
"        jnz     .L_test_for_length_base\n" /* if (op != 0) 45.7% */

"        shrl    $16, %%eax\n"            /* output this.val char */
"        stosb\n"
"        jmp     .L_while_test\n"

".align 32,0x90\n"
".L_test_for_length_base:\n"
"        movl    %%eax, %%r14d\n"         /* len = this */
"        shrl    $16, %%r14d\n"           /* len = this.val */
"        movb    %%al, %%cl\n"

"        testb   $16, %%al\n"
"        jz      .L_test_for_second_level_length\n" /* if ((op & 16) == 0) 8% */
"        andb    $15, %%cl\n"             /* op &= 15 */
"        jz      .L_decode_distance\n"    /* if (!op) */

".L_add_bits_to_len:\n"
"        subb    %%cl, %%bl\n"
"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"
"        andl    %%edx, %%eax\n"          /* eax &= hold */
"        shrq    %%cl, %%rdx\n"
"        addl    %%eax, %%r14d\n"         /* len += hold & mask[op] */

".L_decode_distance:\n"
"        movq    %%r13, %%r8\n"           /* r8 = dmask */
"        cmpb    $32, %%bl\n"
"        ja      .L_get_distance_code\n"  /* if (32 < bits) */

"        lodsl\n"                         /* eax = *(uint *)in++ */
"        movb    %%bl, %%cl\n"            /* cl = bits, needs it for shifting */
"        addb    $32, %%bl\n"             /* bits += 32 */
"        shlq    %%cl, %%rax\n"
"        orq     %%rax, %%rdx\n"          /* hold |= *((uint *)in)++ << bits */

".L_get_distance_code:\n"
"        andq    %%rdx, %%r8\n"           /* r8 &= hold */
"        movl    (%%r11,%%r8,4), %%eax\n" /* eax = dcode[hold & dmask] */

".L_dodist:\n"
"        movl    %%eax, %%r15d\n"         /* dist = this */
"        shrl    $16, %%r15d\n"           /* dist = this.val */
"        movb    %%ah, %%cl\n"
"        subb    %%ah, %%bl\n"            /* bits -= this.bits */
"        shrq    %%cl, %%rdx\n"           /* hold >>= this.bits */
"        movb    %%al, %%cl\n"            /* cl = this.op */

"        testb   $16, %%al\n"             /* if ((op & 16) == 0) */
"        jz      .L_test_for_second_level_dist\n"
"        andb    $15, %%cl\n"             /* op &= 15 */
"        jz      .L_check_dist_one\n"

".L_add_bits_to_dist:\n"
"        subb    %%cl, %%bl\n"
"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"                 /* (1 << op) - 1 */
"        andl    %%edx, %%eax\n"          /* eax &= hold */
"        shrq    %%cl, %%rdx\n"
"        addl    %%eax, %%r15d\n"         /* dist += hold & ((1 << op) - 1) */

".L_check_window:\n"
"        movq    %%rsi, %%r8\n"           /* save in so from can use it's reg */
"        movq    %%rdi, %%rax\n"
"        subq    40(%%rsp), %%rax\n"      /* nbytes = out - beg */

"        cmpl    %%r15d, %%eax\n"
"        jb      .L_clip_window\n"        /* if (dist > nbytes) 4.2% */

"        movl    %%r14d, %%ecx\n"         /* ecx = len */
"        movq    %%rdi, %%rsi\n"
"        subq    %%r15, %%rsi\n"          /* from = out - dist */

"        sarl    %%ecx\n"
"        jnc     .L_copy_two\n"           /* if len % 2 == 0 */

"        rep     movsw\n"
"        movb    (%%rsi), %%al\n"
"        movb    %%al, (%%rdi)\n"
"        incq    %%rdi\n"

"        movq    %%r8, %%rsi\n"           /* move in back to %rsi, toss from */
"        jmp     .L_while_test\n"

".L_copy_two:\n"
"        rep     movsw\n"
"        movq    %%r8, %%rsi\n"           /* move in back to %rsi, toss from */
"        jmp     .L_while_test\n"

".align 32,0x90\n"
".L_check_dist_one:\n"
"        cmpl    $1, %%r15d\n"            /* if dist 1, is a memset */
"        jne     .L_check_window\n"
"        cmpq    %%rdi, 40(%%rsp)\n"      /* if out == beg, outside window */
"        je      .L_check_window\n"

"        movl    %%r14d, %%ecx\n"         /* ecx = len */
"        movb    -1(%%rdi), %%al\n"
"        movb    %%al, %%ah\n"

"        sarl    %%ecx\n"
"        jnc     .L_set_two\n"
"        movb    %%al, (%%rdi)\n"
"        incq    %%rdi\n"

".L_set_two:\n"
"        rep     stosw\n"
"        jmp     .L_while_test\n"

".align 32,0x90\n"
".L_test_for_second_level_length:\n"
"        testb   $64, %%al\n"
"        jnz     .L_test_for_end_of_block\n" /* if ((op & 64) != 0) */

"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"
"        andl    %%edx, %%eax\n"         /* eax &= hold */
"        addl    %%r14d, %%eax\n"        /* eax += len */
"        movl    (%%rbp,%%rax,4), %%eax\n" /* eax = lcode[val+(hold&mask[op])]*/
"        jmp     .L_dolen\n"

".align 32,0x90\n"
".L_test_for_second_level_dist:\n"
"        testb   $64, %%al\n"
"        jnz     .L_invalid_distance_code\n" /* if ((op & 64) != 0) */

"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"
"        andl    %%edx, %%eax\n"         /* eax &= hold */
"        addl    %%r15d, %%eax\n"        /* eax += dist */
"        movl    (%%r11,%%rax,4), %%eax\n" /* eax = dcode[val+(hold&mask[op])]*/
"        jmp     .L_dodist\n"

".align 32,0x90\n"
".L_clip_window:\n"
"        movl    %%eax, %%ecx\n"         /* ecx = nbytes */
"        movl    92(%%rsp), %%eax\n"     /* eax = wsize, prepare for dist cmp */
"        negl    %%ecx\n"                /* nbytes = -nbytes */

"        cmpl    %%r15d, %%eax\n"
"        jb      .L_invalid_distance_too_far\n" /* if (dist > wsize) */

"        addl    %%r15d, %%ecx\n"         /* nbytes = dist - nbytes */
"        cmpl    $0, 96(%%rsp)\n"
"        jne     .L_wrap_around_window\n" /* if (write != 0) */

"        movq    56(%%rsp), %%rsi\n"     /* from  = window */
"        subl    %%ecx, %%eax\n"         /* eax  -= nbytes */
"        addq    %%rax, %%rsi\n"         /* from += wsize - nbytes */

"        movl    %%r14d, %%eax\n"        /* eax = len */
"        cmpl    %%ecx, %%r14d\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* eax -= nbytes */
"        rep     movsb\n"
"        movq    %%rdi, %%rsi\n"
"        subq    %%r15, %%rsi\n"         /* from = &out[ -dist ] */
"        jmp     .L_do_copy\n"

".align 32,0x90\n"
".L_wrap_around_window:\n"
"        movl    96(%%rsp), %%eax\n"     /* eax = write */
"        cmpl    %%eax, %%ecx\n"
"        jbe     .L_contiguous_in_window\n" /* if (write >= nbytes) */

"        movl    92(%%rsp), %%esi\n"     /* from  = wsize */
"        addq    56(%%rsp), %%rsi\n"     /* from += window */
"        addq    %%rax, %%rsi\n"         /* from += write */
"        subq    %%rcx, %%rsi\n"         /* from -= nbytes */
"        subl    %%eax, %%ecx\n"         /* nbytes -= write */

"        movl    %%r14d, %%eax\n"        /* eax = len */
"        cmpl    %%ecx, %%eax\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* len -= nbytes */
"        rep     movsb\n"
"        movq    56(%%rsp), %%rsi\n"     /* from = window */
"        movl    96(%%rsp), %%ecx\n"     /* nbytes = write */
"        cmpl    %%ecx, %%eax\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* len -= nbytes */
"        rep     movsb\n"
"        movq    %%rdi, %%rsi\n"
"        subq    %%r15, %%rsi\n"         /* from = out - dist */
"        jmp     .L_do_copy\n"

".align 32,0x90\n"
".L_contiguous_in_window:\n"
"        movq    56(%%rsp), %%rsi\n"     /* rsi = window */
"        addq    %%rax, %%rsi\n"
"        subq    %%rcx, %%rsi\n"         /* from += write - nbytes */

"        movl    %%r14d, %%eax\n"        /* eax = len */
"        cmpl    %%ecx, %%eax\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* len -= nbytes */
"        rep     movsb\n"
"        movq    %%rdi, %%rsi\n"
"        subq    %%r15, %%rsi\n"         /* from = out - dist */
"        jmp     .L_do_copy\n"           /* if (nbytes >= len) */

".align 32,0x90\n"
".L_do_copy:\n"
"        movl    %%eax, %%ecx\n"         /* ecx = len */
"        rep     movsb\n"

"        movq    %%r8, %%rsi\n"          /* move in back to %esi, toss from */
"        jmp     .L_while_test\n"

".L_test_for_end_of_block:\n"
"        testb   $32, %%al\n"
"        jz      .L_invalid_literal_length_code\n"
"        movl    $1, 116(%%rsp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_invalid_literal_length_code:\n"
"        movl    $2, 116(%%rsp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_invalid_distance_code:\n"
"        movl    $3, 116(%%rsp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_invalid_distance_too_far:\n"
"        movl    $4, 116(%%rsp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_break_loop:\n"
"        movl    $0, 116(%%rsp)\n"

".L_break_loop_with_status:\n"
/* put in, out, bits, and hold back into ar and pop esp */
"        movq    %%rsi, 16(%%rsp)\n"     /* in */
"        movq    %%rdi, 32(%%rsp)\n"     /* out */
"        movl    %%ebx, 88(%%rsp)\n"     /* bits */
"        movq    %%rdx, 80(%%rsp)\n"     /* hold */
"        movq    (%%rsp), %%rax\n"       /* restore rbp and rsp */
"        movq    8(%%rsp), %%rbp\n"
"        movq    %%rax, %%rsp\n"
          :
          : "m" (ar)
          : "memory", "%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi",
            "%r8", "%r9", "%r10", "%r11", "%r12", "%r13", "%r14", "%r15"
    );
#elif ( defined( __GNUC__ ) || defined( __ICC ) ) && defined( __i386 )
    __asm__ __volatile__ (
"        leal    %0, %%eax\n"
"        movl    %%esp, (%%eax)\n"        /* save esp, ebp */
"        movl    %%ebp, 4(%%eax)\n"
"        movl    %%eax, %%esp\n"
"        movl    8(%%esp), %%esi\n"       /* esi = in */
"        movl    16(%%esp), %%edi\n"      /* edi = out */
"        movl    40(%%esp), %%edx\n"      /* edx = hold */
"        movl    44(%%esp), %%ebx\n"      /* ebx = bits */
"        movl    32(%%esp), %%ebp\n"      /* ebp = lcode */

"        cld\n"
"        jmp     .L_do_loop\n"

".align 32,0x90\n"
".L_while_test:\n"
"        cmpl    %%edi, 24(%%esp)\n"      /* out < end */
"        jbe     .L_break_loop\n"
"        cmpl    %%esi, 12(%%esp)\n"      /* in < last */
"        jbe     .L_break_loop\n"

".L_do_loop:\n"
"        cmpb    $15, %%bl\n"
"        ja      .L_get_length_code\n"    /* if (15 < bits) */

"        xorl    %%eax, %%eax\n"
"        lodsw\n"                         /* al = *(ushort *)in++ */
"        movb    %%bl, %%cl\n"            /* cl = bits, needs it for shifting */
"        addb    $16, %%bl\n"             /* bits += 16 */
"        shll    %%cl, %%eax\n"
"        orl     %%eax, %%edx\n"        /* hold |= *((ushort *)in)++ << bits */

".L_get_length_code:\n"
"        movl    56(%%esp), %%eax\n"      /* eax = lmask */
"        andl    %%edx, %%eax\n"          /* eax &= hold */
"        movl    (%%ebp,%%eax,4), %%eax\n" /* eax = lcode[hold & lmask] */

".L_dolen:\n"
"        movb    %%ah, %%cl\n"            /* cl = this.bits */
"        subb    %%ah, %%bl\n"            /* bits -= this.bits */
"        shrl    %%cl, %%edx\n"           /* hold >>= this.bits */

"        testb   %%al, %%al\n"
"        jnz     .L_test_for_length_base\n" /* if (op != 0) 45.7% */

"        shrl    $16, %%eax\n"            /* output this.val char */
"        stosb\n"
"        jmp     .L_while_test\n"

".align 32,0x90\n"
".L_test_for_length_base:\n"
"        movl    %%eax, %%ecx\n"          /* len = this */
"        shrl    $16, %%ecx\n"            /* len = this.val */
"        movl    %%ecx, 64(%%esp)\n"      /* save len */
"        movb    %%al, %%cl\n"

"        testb   $16, %%al\n"
"        jz      .L_test_for_second_level_length\n" /* if ((op & 16) == 0) 8% */
"        andb    $15, %%cl\n"             /* op &= 15 */
"        jz      .L_decode_distance\n"    /* if (!op) */
"        cmpb    %%cl, %%bl\n"
"        jae     .L_add_bits_to_len\n"    /* if (op <= bits) */

"        movb    %%cl, %%ch\n"            /* stash op in ch, freeing cl */
"        xorl    %%eax, %%eax\n"
"        lodsw\n"                         /* al = *(ushort *)in++ */
"        movb    %%bl, %%cl\n"            /* cl = bits, needs it for shifting */
"        addb    $16, %%bl\n"             /* bits += 16 */
"        shll    %%cl, %%eax\n"
"        orl     %%eax, %%edx\n"         /* hold |= *((ushort *)in)++ << bits */
"        movb    %%ch, %%cl\n"            /* move op back to ecx */

".L_add_bits_to_len:\n"
"        subb    %%cl, %%bl\n"
"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"
"        andl    %%edx, %%eax\n"          /* eax &= hold */
"        shrl    %%cl, %%edx\n"
"        addl    %%eax, 64(%%esp)\n"      /* len += hold & mask[op] */

".L_decode_distance:\n"
"        cmpb    $15, %%bl\n"
"        ja      .L_get_distance_code\n"  /* if (15 < bits) */

"        xorl    %%eax, %%eax\n"
"        lodsw\n"                         /* al = *(ushort *)in++ */
"        movb    %%bl, %%cl\n"            /* cl = bits, needs it for shifting */
"        addb    $16, %%bl\n"             /* bits += 16 */
"        shll    %%cl, %%eax\n"
"        orl     %%eax, %%edx\n"         /* hold |= *((ushort *)in)++ << bits */

".L_get_distance_code:\n"
"        movl    60(%%esp), %%eax\n"      /* eax = dmask */
"        movl    36(%%esp), %%ecx\n"      /* ecx = dcode */
"        andl    %%edx, %%eax\n"          /* eax &= hold */
"        movl    (%%ecx,%%eax,4), %%eax\n"/* eax = dcode[hold & dmask] */

".L_dodist:\n"
"        movl    %%eax, %%ebp\n"          /* dist = this */
"        shrl    $16, %%ebp\n"            /* dist = this.val */
"        movb    %%ah, %%cl\n"
"        subb    %%ah, %%bl\n"            /* bits -= this.bits */
"        shrl    %%cl, %%edx\n"           /* hold >>= this.bits */
"        movb    %%al, %%cl\n"            /* cl = this.op */

"        testb   $16, %%al\n"             /* if ((op & 16) == 0) */
"        jz      .L_test_for_second_level_dist\n"
"        andb    $15, %%cl\n"             /* op &= 15 */
"        jz      .L_check_dist_one\n"
"        cmpb    %%cl, %%bl\n"
"        jae     .L_add_bits_to_dist\n"   /* if (op <= bits) 97.6% */

"        movb    %%cl, %%ch\n"            /* stash op in ch, freeing cl */
"        xorl    %%eax, %%eax\n"
"        lodsw\n"                         /* al = *(ushort *)in++ */
"        movb    %%bl, %%cl\n"            /* cl = bits, needs it for shifting */
"        addb    $16, %%bl\n"             /* bits += 16 */
"        shll    %%cl, %%eax\n"
"        orl     %%eax, %%edx\n"        /* hold |= *((ushort *)in)++ << bits */
"        movb    %%ch, %%cl\n"            /* move op back to ecx */

".L_add_bits_to_dist:\n"
"        subb    %%cl, %%bl\n"
"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"                 /* (1 << op) - 1 */
"        andl    %%edx, %%eax\n"          /* eax &= hold */
"        shrl    %%cl, %%edx\n"
"        addl    %%eax, %%ebp\n"          /* dist += hold & ((1 << op) - 1) */

".L_check_window:\n"
"        movl    %%esi, 8(%%esp)\n"       /* save in so from can use it's reg */
"        movl    %%edi, %%eax\n"
"        subl    20(%%esp), %%eax\n"      /* nbytes = out - beg */

"        cmpl    %%ebp, %%eax\n"
"        jb      .L_clip_window\n"        /* if (dist > nbytes) 4.2% */

"        movl    64(%%esp), %%ecx\n"      /* ecx = len */
"        movl    %%edi, %%esi\n"
"        subl    %%ebp, %%esi\n"          /* from = out - dist */

"        sarl    %%ecx\n"
"        jnc     .L_copy_two\n"           /* if len % 2 == 0 */

"        rep     movsw\n"
"        movb    (%%esi), %%al\n"
"        movb    %%al, (%%edi)\n"
"        incl    %%edi\n"

"        movl    8(%%esp), %%esi\n"       /* move in back to %esi, toss from */
"        movl    32(%%esp), %%ebp\n"      /* ebp = lcode */
"        jmp     .L_while_test\n"

".L_copy_two:\n"
"        rep     movsw\n"
"        movl    8(%%esp), %%esi\n"       /* move in back to %esi, toss from */
"        movl    32(%%esp), %%ebp\n"      /* ebp = lcode */
"        jmp     .L_while_test\n"

".align 32,0x90\n"
".L_check_dist_one:\n"
"        cmpl    $1, %%ebp\n"            /* if dist 1, is a memset */
"        jne     .L_check_window\n"
"        cmpl    %%edi, 20(%%esp)\n"
"        je      .L_check_window\n"      /* out == beg, if outside window */

"        movl    64(%%esp), %%ecx\n"      /* ecx = len */
"        movb    -1(%%edi), %%al\n"
"        movb    %%al, %%ah\n"

"        sarl    %%ecx\n"
"        jnc     .L_set_two\n"
"        movb    %%al, (%%edi)\n"
"        incl    %%edi\n"

".L_set_two:\n"
"        rep     stosw\n"
"        movl    32(%%esp), %%ebp\n"      /* ebp = lcode */
"        jmp     .L_while_test\n"

".align 32,0x90\n"
".L_test_for_second_level_length:\n"
"        testb   $64, %%al\n"
"        jnz     .L_test_for_end_of_block\n" /* if ((op & 64) != 0) */

"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"
"        andl    %%edx, %%eax\n"         /* eax &= hold */
"        addl    64(%%esp), %%eax\n"     /* eax += len */
"        movl    (%%ebp,%%eax,4), %%eax\n" /* eax = lcode[val+(hold&mask[op])]*/
"        jmp     .L_dolen\n"

".align 32,0x90\n"
".L_test_for_second_level_dist:\n"
"        testb   $64, %%al\n"
"        jnz     .L_invalid_distance_code\n" /* if ((op & 64) != 0) */

"        xorl    %%eax, %%eax\n"
"        incl    %%eax\n"
"        shll    %%cl, %%eax\n"
"        decl    %%eax\n"
"        andl    %%edx, %%eax\n"         /* eax &= hold */
"        addl    %%ebp, %%eax\n"         /* eax += dist */
"        movl    36(%%esp), %%ecx\n"     /* ecx = dcode */
"        movl    (%%ecx,%%eax,4), %%eax\n" /* eax = dcode[val+(hold&mask[op])]*/
"        jmp     .L_dodist\n"

".align 32,0x90\n"
".L_clip_window:\n"
"        movl    %%eax, %%ecx\n"
"        movl    48(%%esp), %%eax\n"     /* eax = wsize */
"        negl    %%ecx\n"                /* nbytes = -nbytes */
"        movl    28(%%esp), %%esi\n"     /* from = window */

"        cmpl    %%ebp, %%eax\n"
"        jb      .L_invalid_distance_too_far\n" /* if (dist > wsize) */

"        addl    %%ebp, %%ecx\n"         /* nbytes = dist - nbytes */
"        cmpl    $0, 52(%%esp)\n"
"        jne     .L_wrap_around_window\n" /* if (write != 0) */

"        subl    %%ecx, %%eax\n"
"        addl    %%eax, %%esi\n"         /* from += wsize - nbytes */

"        movl    64(%%esp), %%eax\n"     /* eax = len */
"        cmpl    %%ecx, %%eax\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* len -= nbytes */
"        rep     movsb\n"
"        movl    %%edi, %%esi\n"
"        subl    %%ebp, %%esi\n"         /* from = out - dist */
"        jmp     .L_do_copy\n"

".align 32,0x90\n"
".L_wrap_around_window:\n"
"        movl    52(%%esp), %%eax\n"     /* eax = write */
"        cmpl    %%eax, %%ecx\n"
"        jbe     .L_contiguous_in_window\n" /* if (write >= nbytes) */

"        addl    48(%%esp), %%esi\n"     /* from += wsize */
"        addl    %%eax, %%esi\n"         /* from += write */
"        subl    %%ecx, %%esi\n"         /* from -= nbytes */
"        subl    %%eax, %%ecx\n"         /* nbytes -= write */

"        movl    64(%%esp), %%eax\n"     /* eax = len */
"        cmpl    %%ecx, %%eax\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* len -= nbytes */
"        rep     movsb\n"
"        movl    28(%%esp), %%esi\n"     /* from = window */
"        movl    52(%%esp), %%ecx\n"     /* nbytes = write */
"        cmpl    %%ecx, %%eax\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* len -= nbytes */
"        rep     movsb\n"
"        movl    %%edi, %%esi\n"
"        subl    %%ebp, %%esi\n"         /* from = out - dist */
"        jmp     .L_do_copy\n"

".align 32,0x90\n"
".L_contiguous_in_window:\n"
"        addl    %%eax, %%esi\n"
"        subl    %%ecx, %%esi\n"         /* from += write - nbytes */

"        movl    64(%%esp), %%eax\n"     /* eax = len */
"        cmpl    %%ecx, %%eax\n"
"        jbe     .L_do_copy\n"           /* if (nbytes >= len) */

"        subl    %%ecx, %%eax\n"         /* len -= nbytes */
"        rep     movsb\n"
"        movl    %%edi, %%esi\n"
"        subl    %%ebp, %%esi\n"         /* from = out - dist */
"        jmp     .L_do_copy\n"           /* if (nbytes >= len) */

".align 32,0x90\n"
".L_do_copy:\n"
"        movl    %%eax, %%ecx\n"
"        rep     movsb\n"

"        movl    8(%%esp), %%esi\n"      /* move in back to %esi, toss from */
"        movl    32(%%esp), %%ebp\n"     /* ebp = lcode */
"        jmp     .L_while_test\n"

".L_test_for_end_of_block:\n"
"        testb   $32, %%al\n"
"        jz      .L_invalid_literal_length_code\n"
"        movl    $1, 72(%%esp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_invalid_literal_length_code:\n"
"        movl    $2, 72(%%esp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_invalid_distance_code:\n"
"        movl    $3, 72(%%esp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_invalid_distance_too_far:\n"
"        movl    8(%%esp), %%esi\n"
"        movl    $4, 72(%%esp)\n"
"        jmp     .L_break_loop_with_status\n"

".L_break_loop:\n"
"        movl    $0, 72(%%esp)\n"

".L_break_loop_with_status:\n"
/* put in, out, bits, and hold back into ar and pop esp */
"        movl    %%esi, 8(%%esp)\n"      /* save in */
"        movl    %%edi, 16(%%esp)\n"     /* save out */
"        movl    %%ebx, 44(%%esp)\n"     /* save bits */
"        movl    %%edx, 40(%%esp)\n"     /* save hold */
"        movl    4(%%esp), %%ebp\n"      /* restore esp, ebp */
"        movl    (%%esp), %%esp\n"
          :
          : "m" (ar)
          : "memory", "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi"
    );
#elif defined( _MSC_VER ) && ! defined( _M_AMD64 )
    __asm {
	lea	eax, ar
	mov	[eax], esp         /* save esp, ebp */
	mov	[eax+4], ebp
	mov	esp, eax
	mov	esi, [esp+8]       /* esi = in */
	mov	edi, [esp+16]      /* edi = out */
	mov	edx, [esp+40]      /* edx = hold */
	mov	ebx, [esp+44]      /* ebx = bits */
	mov	ebp, [esp+32]      /* ebp = lcode */

	cld
	jmp	L_do_loop

ALIGN 4
L_while_test:
	cmp	[esp+24], edi
	jbe	L_break_loop
	cmp	[esp+12], esi
	jbe	L_break_loop

L_do_loop:
	cmp	bl, 15
	ja	L_get_length_code    /* if (15 < bits) */

	xor	eax, eax
	lodsw                         /* al = *(ushort *)in++ */
	mov	cl, bl            /* cl = bits, needs it for shifting */
	add	bl, 16             /* bits += 16 */
	shl	eax, cl
	or	edx, eax        /* hold |= *((ushort *)in)++ << bits */

L_get_length_code:
	mov	eax, [esp+56]      /* eax = lmask */
	and	eax, edx          /* eax &= hold */
	mov	eax, [ebp+eax*4] /* eax = lcode[hold & lmask] */

L_dolen:
	mov	cl, ah            /* cl = this.bits */
	sub	bl, ah            /* bits -= this.bits */
	shr	edx, cl           /* hold >>= this.bits */

	test	al, al
	jnz	L_test_for_length_base /* if (op != 0) 45.7% */

	shr	eax, 16            /* output this.val char */
	stosb
	jmp	L_while_test

ALIGN 4
L_test_for_length_base:
	mov	ecx, eax          /* len = this */
	shr	ecx, 16            /* len = this.val */
	mov	[esp+64], ecx      /* save len */
	mov	cl, al

	test	al, 16
	jz	L_test_for_second_level_length /* if ((op & 16) == 0) 8% */
	and	cl, 15             /* op &= 15 */
	jz	L_decode_distance    /* if (!op) */
	cmp	bl, cl
	jae	L_add_bits_to_len    /* if (op <= bits) */

	mov	ch, cl            /* stash op in ch, freeing cl */
	xor	eax, eax
	lodsw                         /* al = *(ushort *)in++ */
	mov	cl, bl            /* cl = bits, needs it for shifting */
	add	bl, 16             /* bits += 16 */
	shl	eax, cl
	or	edx, eax         /* hold |= *((ushort *)in)++ << bits */
	mov	cl, ch            /* move op back to ecx */

L_add_bits_to_len:
	sub	bl, cl
	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax
	and	eax, edx          /* eax &= hold */
	shr	edx, cl
	add	[esp+64], eax      /* len += hold & mask[op] */

L_decode_distance:
	cmp	bl, 15
	ja	L_get_distance_code  /* if (15 < bits) */

	xor	eax, eax
	lodsw                         /* al = *(ushort *)in++ */
	mov	cl, bl            /* cl = bits, needs it for shifting */
	add	bl, 16             /* bits += 16 */
	shl	eax, cl
	or	edx, eax         /* hold |= *((ushort *)in)++ << bits */

L_get_distance_code:
	mov	eax, [esp+60]      /* eax = dmask */
	mov	ecx, [esp+36]      /* ecx = dcode */
	and	eax, edx          /* eax &= hold */
	mov	eax, [ecx+eax*4]/* eax = dcode[hold & dmask] */

L_dodist:
	mov	ebp, eax          /* dist = this */
	shr	ebp, 16            /* dist = this.val */
	mov	cl, ah
	sub	bl, ah            /* bits -= this.bits */
	shr	edx, cl           /* hold >>= this.bits */
	mov	cl, al            /* cl = this.op */

	test	al, 16             /* if ((op & 16) == 0) */
	jz	L_test_for_second_level_dist
	and	cl, 15             /* op &= 15 */
	jz	L_check_dist_one
	cmp	bl, cl
	jae	L_add_bits_to_dist   /* if (op <= bits) 97.6% */

	mov	ch, cl            /* stash op in ch, freeing cl */
	xor	eax, eax
	lodsw                         /* al = *(ushort *)in++ */
	mov	cl, bl            /* cl = bits, needs it for shifting */
	add	bl, 16             /* bits += 16 */
	shl	eax, cl
	or	edx, eax        /* hold |= *((ushort *)in)++ << bits */
	mov	cl, ch            /* move op back to ecx */

L_add_bits_to_dist:
	sub	bl, cl
	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax                 /* (1 << op) - 1 */
	and	eax, edx          /* eax &= hold */
	shr	edx, cl
	add	ebp, eax          /* dist += hold & ((1 << op) - 1) */

L_check_window:
	mov	[esp+8], esi       /* save in so from can use it's reg */
	mov	eax, edi
	sub	eax, [esp+20]      /* nbytes = out - beg */

	cmp	eax, ebp
	jb	L_clip_window        /* if (dist > nbytes) 4.2% */

	mov	ecx, [esp+64]      /* ecx = len */
	mov	esi, edi
	sub	esi, ebp          /* from = out - dist */

	sar	ecx, 1
	jnc	L_copy_two

	rep     movsw
	mov	al, [esi]
	mov	[edi], al
	inc	edi

	mov	esi, [esp+8]      /* move in back to %esi, toss from */
	mov	ebp, [esp+32]     /* ebp = lcode */
	jmp	L_while_test

L_copy_two:
	rep     movsw
	mov	esi, [esp+8]      /* move in back to %esi, toss from */
	mov	ebp, [esp+32]     /* ebp = lcode */
	jmp	L_while_test

ALIGN 4
L_check_dist_one:
	cmp	ebp, 1            /* if dist 1, is a memset */
	jne	L_check_window
	cmp	[esp+20], edi
	je	L_check_window    /* out == beg, if outside window */

	mov	ecx, [esp+64]     /* ecx = len */
	mov	al, [edi-1]
	mov	ah, al

	sar	ecx, 1
	jnc	L_set_two
	mov	[edi], al         /* memset out with from[-1] */
	inc	edi

L_set_two:
	rep     stosw
	mov	ebp, [esp+32]     /* ebp = lcode */
	jmp	L_while_test

ALIGN 4
L_test_for_second_level_length:
	test	al, 64
	jnz	L_test_for_end_of_block /* if ((op & 64) != 0) */

	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax
	and	eax, edx         /* eax &= hold */
	add	eax, [esp+64]     /* eax += len */
	mov	eax, [ebp+eax*4] /* eax = lcode[val+(hold&mask[op])]*/
	jmp	L_dolen

ALIGN 4
L_test_for_second_level_dist:
	test	al, 64
	jnz	L_invalid_distance_code /* if ((op & 64) != 0) */

	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax
	and	eax, edx         /* eax &= hold */
	add	eax, ebp         /* eax += dist */
	mov	ecx, [esp+36]     /* ecx = dcode */
	mov	eax, [ecx+eax*4] /* eax = dcode[val+(hold&mask[op])]*/
	jmp	L_dodist

ALIGN 4
L_clip_window:
	mov	ecx, eax
	mov	eax, [esp+48]     /* eax = wsize */
	neg	ecx                /* nbytes = -nbytes */
	mov	esi, [esp+28]     /* from = window */

	cmp	eax, ebp
	jb	L_invalid_distance_too_far /* if (dist > wsize) */

	add	ecx, ebp         /* nbytes = dist - nbytes */
	cmp	dword ptr [esp+52], 0
	jne	L_wrap_around_window /* if (write != 0) */

	sub	eax, ecx
	add	esi, eax         /* from += wsize - nbytes */

	mov	eax, [esp+64]    /* eax = len */
	cmp	eax, ecx
	jbe	L_do_copy          /* if (nbytes >= len) */

	sub	eax, ecx         /* len -= nbytes */
	rep     movsb
	mov	esi, edi
	sub	esi, ebp         /* from = out - dist */
	jmp	L_do_copy

ALIGN 4
L_wrap_around_window:
	mov	eax, [esp+52]    /* eax = write */
	cmp	ecx, eax
	jbe	L_contiguous_in_window /* if (write >= nbytes) */

	add	esi, [esp+48]    /* from += wsize */
	add	esi, eax         /* from += write */
	sub	esi, ecx         /* from -= nbytes */
	sub	ecx, eax         /* nbytes -= write */

	mov	eax, [esp+64]    /* eax = len */
	cmp	eax, ecx
	jbe	L_do_copy          /* if (nbytes >= len) */

	sub	eax, ecx         /* len -= nbytes */
	rep     movsb
	mov	esi, [esp+28]     /* from = window */
	mov	ecx, [esp+52]     /* nbytes = write */
	cmp	eax, ecx
	jbe	L_do_copy          /* if (nbytes >= len) */

	sub	eax, ecx         /* len -= nbytes */
	rep     movsb
	mov	esi, edi
	sub	esi, ebp         /* from = out - dist */
	jmp	L_do_copy

ALIGN 4
L_contiguous_in_window:
	add	esi, eax
	sub	esi, ecx         /* from += write - nbytes */

	mov	eax, [esp+64]    /* eax = len */
	cmp	eax, ecx
	jbe	L_do_copy          /* if (nbytes >= len) */

	sub	eax, ecx         /* len -= nbytes */
	rep     movsb
	mov	esi, edi
	sub	esi, ebp         /* from = out - dist */
	jmp	L_do_copy

ALIGN 4
L_do_copy:
	mov	ecx, eax
	rep     movsb

	mov	esi, [esp+8]      /* move in back to %esi, toss from */
	mov	ebp, [esp+32]     /* ebp = lcode */
	jmp	L_while_test

L_test_for_end_of_block:
	test	al, 32
	jz	L_invalid_literal_length_code
	mov	dword ptr [esp+72], 1
	jmp	L_break_loop_with_status

L_invalid_literal_length_code:
	mov	dword ptr [esp+72], 2
	jmp	L_break_loop_with_status

L_invalid_distance_code:
	mov	dword ptr [esp+72], 3
	jmp	L_break_loop_with_status

L_invalid_distance_too_far:
	mov	esi, [esp+4]
	mov	dword ptr [esp+72], 4
	jmp	L_break_loop_with_status

L_break_loop:
	mov	dword ptr [esp+72], 0

L_break_loop_with_status:
/* put in, out, bits, and hold back into ar and pop esp */
	mov	[esp+8], esi     /* save in */
	mov	[esp+16], edi    /* save out */
	mov	[esp+44], ebx    /* save bits */
	mov	[esp+40], edx    /* save hold */
	mov	ebp, [esp+4]     /* restore esp, ebp */
	mov	esp, [esp]
    }
#else
#error "x86 architecture not defined"
#endif

    if (ar.status > 1) {
        if (ar.status == 2)
            strm->msg = "invalid literal/length code";
        else if (ar.status == 3)
            strm->msg = "invalid distance code";
        else
            strm->msg = "invalid distance too far back";
        state->mode = BAD;
    }
    else if ( ar.status == 1 ) {
        state->mode = TYPE;
    }

    /* return unused bytes (on entry, bits < 8, so in won't go too far back) */
    ar.len = ar.bits >> 3;
    ar.in -= ar.len;
    ar.bits -= ar.len << 3;
    ar.hold &= (1U << ar.bits) - 1;

    /* update state and return */
    strm->next_in = ar.in;
    strm->next_out = ar.out;
    strm->avail_in = (unsigned)(ar.in < ar.last ?
                                PAD_AVAIL_IN + (ar.last - ar.in) :
                                PAD_AVAIL_IN - (ar.in - ar.last));
    strm->avail_out = (unsigned)(ar.out < ar.end ?
                                 PAD_AVAIL_OUT + (ar.end - ar.out) :
                                 PAD_AVAIL_OUT - (ar.out - ar.end));
    state->hold = ar.hold;
    state->bits = ar.bits;
    return;
}

Deleted compat/zlib/contrib/inflate86/inffast.S.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * inffast.S is a hand tuned assembler version of:
 *
 * inffast.c -- fast decoding
 * Copyright (C) 1995-2003 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 *
 * Copyright (C) 2003 Chris Anderson <christop@charm.net>
 * Please use the copyright conditions above.
 *
 * This version (Jan-23-2003) of inflate_fast was coded and tested under
 * GNU/Linux on a pentium 3, using the gcc-3.2 compiler distribution.  On that
 * machine, I found that gzip style archives decompressed about 20% faster than
 * the gcc-3.2 -O3 -fomit-frame-pointer compiled version.  Your results will
 * depend on how large of a buffer is used for z_stream.next_in & next_out
 * (8K-32K worked best for my 256K cpu cache) and how much overhead there is in
 * stream processing I/O and crc32/addler32.  In my case, this routine used
 * 70% of the cpu time and crc32 used 20%.
 *
 * I am confident that this version will work in the general case, but I have
 * not tested a wide variety of datasets or a wide variety of platforms.
 *
 * Jan-24-2003 -- Added -DUSE_MMX define for slightly faster inflating.
 * It should be a runtime flag instead of compile time flag...
 *
 * Jan-26-2003 -- Added runtime check for MMX support with cpuid instruction.
 * With -DUSE_MMX, only MMX code is compiled.  With -DNO_MMX, only non-MMX code
 * is compiled.  Without either option, runtime detection is enabled.  Runtime
 * detection should work on all modern cpus and the recomended algorithm (flip
 * ID bit on eflags and then use the cpuid instruction) is used in many
 * multimedia applications.  Tested under win2k with gcc-2.95 and gas-2.12
 * distributed with cygwin3.  Compiling with gcc-2.95 -c inffast.S -o
 * inffast.obj generates a COFF object which can then be linked with MSVC++
 * compiled code.  Tested under FreeBSD 4.7 with gcc-2.95.
 *
 * Jan-28-2003 -- Tested Athlon XP... MMX mode is slower than no MMX (and
 * slower than compiler generated code).  Adjusted cpuid check to use the MMX
 * code only for Pentiums < P4 until I have more data on the P4.  Speed
 * improvment is only about 15% on the Athlon when compared with code generated
 * with MSVC++.  Not sure yet, but I think the P4 will also be slower using the
 * MMX mode because many of it's x86 ALU instructions execute in .5 cycles and
 * have less latency than MMX ops.  Added code to buffer the last 11 bytes of
 * the input stream since the MMX code grabs bits in chunks of 32, which
 * differs from the inffast.c algorithm.  I don't think there would have been
 * read overruns where a page boundary was crossed (a segfault), but there
 * could have been overruns when next_in ends on unaligned memory (unintialized
 * memory read).
 *
 * Mar-13-2003 -- P4 MMX is slightly slower than P4 NO_MMX.  I created a C
 * version of the non-MMX code so that it doesn't depend on zstrm and zstate
 * structure offsets which are hard coded in this file.  This was last tested
 * with zlib-1.2.0 which is currently in beta testing, newer versions of this
 * and inffas86.c can be found at http://www.eetbeetee.com/zlib/ and
 * http://www.charm.net/~christop/zlib/
 */


/*
 * if you have underscore linking problems (_inflate_fast undefined), try
 * using -DGAS_COFF
 */
#if ! defined( GAS_COFF ) && ! defined( GAS_ELF )

#if defined( WIN32 ) || defined( __CYGWIN__ )
#define GAS_COFF /* windows object format */
#else
#define GAS_ELF
#endif

#endif /* ! GAS_COFF && ! GAS_ELF */


#if defined( GAS_COFF )

/* coff externals have underscores */
#define inflate_fast _inflate_fast
#define inflate_fast_use_mmx _inflate_fast_use_mmx

#endif /* GAS_COFF */


.file "inffast.S"

.globl inflate_fast

.text
.align 4,0
.L_invalid_literal_length_code_msg:
.string "invalid literal/length code"

.align 4,0
.L_invalid_distance_code_msg:
.string "invalid distance code"

.align 4,0
.L_invalid_distance_too_far_msg:
.string "invalid distance too far back"

#if ! defined( NO_MMX )
.align 4,0
.L_mask: /* mask[N] = ( 1 << N ) - 1 */
.long 0
.long 1
.long 3
.long 7
.long 15
.long 31
.long 63
.long 127
.long 255
.long 511
.long 1023
.long 2047
.long 4095
.long 8191
.long 16383
.long 32767
.long 65535
.long 131071
.long 262143
.long 524287
.long 1048575
.long 2097151
.long 4194303
.long 8388607
.long 16777215
.long 33554431
.long 67108863
.long 134217727
.long 268435455
.long 536870911
.long 1073741823
.long 2147483647
.long 4294967295
#endif /* NO_MMX */

.text

/*
 * struct z_stream offsets, in zlib.h
 */
#define next_in_strm   0   /* strm->next_in */
#define avail_in_strm  4   /* strm->avail_in */
#define next_out_strm  12  /* strm->next_out */
#define avail_out_strm 16  /* strm->avail_out */
#define msg_strm       24  /* strm->msg */
#define state_strm     28  /* strm->state */

/*
 * struct inflate_state offsets, in inflate.h
 */
#define mode_state     0   /* state->mode */
#define wsize_state    32  /* state->wsize */
#define write_state    40  /* state->write */
#define window_state   44  /* state->window */
#define hold_state     48  /* state->hold */
#define bits_state     52  /* state->bits */
#define lencode_state  68  /* state->lencode */
#define distcode_state 72  /* state->distcode */
#define lenbits_state  76  /* state->lenbits */
#define distbits_state 80  /* state->distbits */

/*
 * inflate_fast's activation record
 */
#define local_var_size 64 /* how much local space for vars */
#define strm_sp        88 /* first arg: z_stream * (local_var_size + 24) */
#define start_sp       92 /* second arg: unsigned int (local_var_size + 28) */

/*
 * offsets for local vars on stack
 */
#define out            60  /* unsigned char* */
#define window         56  /* unsigned char* */
#define wsize          52  /* unsigned int */
#define write          48  /* unsigned int */
#define in             44  /* unsigned char* */
#define beg            40  /* unsigned char* */
#define buf            28  /* char[ 12 ] */
#define len            24  /* unsigned int */
#define last           20  /* unsigned char* */
#define end            16  /* unsigned char* */
#define dcode          12  /* code* */
#define lcode           8  /* code* */
#define dmask           4  /* unsigned int */
#define lmask           0  /* unsigned int */

/*
 * typedef enum inflate_mode consts, in inflate.h
 */
#define INFLATE_MODE_TYPE 11  /* state->mode flags enum-ed in inflate.h */
#define INFLATE_MODE_BAD  26


#if ! defined( USE_MMX ) && ! defined( NO_MMX )

#define RUN_TIME_MMX

#define CHECK_MMX    1
#define DO_USE_MMX   2
#define DONT_USE_MMX 3

.globl inflate_fast_use_mmx

.data

.align 4,0
inflate_fast_use_mmx: /* integer flag for run time control 1=check,2=mmx,3=no */
.long CHECK_MMX

#if defined( GAS_ELF )
/* elf info */
.type   inflate_fast_use_mmx,@object
.size   inflate_fast_use_mmx,4
#endif

#endif /* RUN_TIME_MMX */

#if defined( GAS_COFF )
/* coff info: scl 2 = extern, type 32 = function */
.def inflate_fast; .scl 2; .type 32; .endef
#endif

.text

.align 32,0x90
inflate_fast:
        pushl   %edi
        pushl   %esi
        pushl   %ebp
        pushl   %ebx
        pushf   /* save eflags (strm_sp, state_sp assumes this is 32 bits) */
        subl    $local_var_size, %esp
        cld

#define strm_r  %esi
#define state_r %edi

        movl    strm_sp(%esp), strm_r
        movl    state_strm(strm_r), state_r

        /* in = strm->next_in;
         * out = strm->next_out;
         * last = in + strm->avail_in - 11;
         * beg = out - (start - strm->avail_out);
         * end = out + (strm->avail_out - 257);
         */
        movl    avail_in_strm(strm_r), %edx
        movl    next_in_strm(strm_r), %eax

        addl    %eax, %edx      /* avail_in += next_in */
        subl    $11, %edx       /* avail_in -= 11 */

        movl    %eax, in(%esp)
        movl    %edx, last(%esp)

        movl    start_sp(%esp), %ebp
        movl    avail_out_strm(strm_r), %ecx
        movl    next_out_strm(strm_r), %ebx

        subl    %ecx, %ebp      /* start -= avail_out */
        negl    %ebp            /* start = -start */
        addl    %ebx, %ebp      /* start += next_out */

        subl    $257, %ecx      /* avail_out -= 257 */
        addl    %ebx, %ecx      /* avail_out += out */

        movl    %ebx, out(%esp)
        movl    %ebp, beg(%esp)
        movl    %ecx, end(%esp)

        /* wsize = state->wsize;
         * write = state->write;
         * window = state->window;
         * hold = state->hold;
         * bits = state->bits;
         * lcode = state->lencode;
         * dcode = state->distcode;
         * lmask = ( 1 << state->lenbits ) - 1;
         * dmask = ( 1 << state->distbits ) - 1;
         */

        movl    lencode_state(state_r), %eax
        movl    distcode_state(state_r), %ecx

        movl    %eax, lcode(%esp)
        movl    %ecx, dcode(%esp)

        movl    $1, %eax
        movl    lenbits_state(state_r), %ecx
        shll    %cl, %eax
        decl    %eax
        movl    %eax, lmask(%esp)

        movl    $1, %eax
        movl    distbits_state(state_r), %ecx
        shll    %cl, %eax
        decl    %eax
        movl    %eax, dmask(%esp)

        movl    wsize_state(state_r), %eax
        movl    write_state(state_r), %ecx
        movl    window_state(state_r), %edx

        movl    %eax, wsize(%esp)
        movl    %ecx, write(%esp)
        movl    %edx, window(%esp)

        movl    hold_state(state_r), %ebp
        movl    bits_state(state_r), %ebx

#undef strm_r
#undef state_r

#define in_r       %esi
#define from_r     %esi
#define out_r      %edi

        movl    in(%esp), in_r
        movl    last(%esp), %ecx
        cmpl    in_r, %ecx
        ja      .L_align_long           /* if in < last */

        addl    $11, %ecx               /* ecx = &in[ avail_in ] */
        subl    in_r, %ecx              /* ecx = avail_in */
        movl    $12, %eax
        subl    %ecx, %eax              /* eax = 12 - avail_in */
        leal    buf(%esp), %edi
        rep     movsb                   /* memcpy( buf, in, avail_in ) */
        movl    %eax, %ecx
        xorl    %eax, %eax
        rep     stosb         /* memset( &buf[ avail_in ], 0, 12 - avail_in ) */
        leal    buf(%esp), in_r         /* in = buf */
        movl    in_r, last(%esp)        /* last = in, do just one iteration */
        jmp     .L_is_aligned

        /* align in_r on long boundary */
.L_align_long:
        testl   $3, in_r
        jz      .L_is_aligned
        xorl    %eax, %eax
        movb    (in_r), %al
        incl    in_r
        movl    %ebx, %ecx
        addl    $8, %ebx
        shll    %cl, %eax
        orl     %eax, %ebp
        jmp     .L_align_long

.L_is_aligned:
        movl    out(%esp), out_r

#if defined( NO_MMX )
        jmp     .L_do_loop
#endif

#if defined( USE_MMX )
        jmp     .L_init_mmx
#endif

/*** Runtime MMX check ***/

#if defined( RUN_TIME_MMX )
.L_check_mmx:
        cmpl    $DO_USE_MMX, inflate_fast_use_mmx
        je      .L_init_mmx
        ja      .L_do_loop /* > 2 */

        pushl   %eax
        pushl   %ebx
        pushl   %ecx
        pushl   %edx
        pushf
        movl    (%esp), %eax      /* copy eflags to eax */
        xorl    $0x200000, (%esp) /* try toggling ID bit of eflags (bit 21)
                                   * to see if cpu supports cpuid...
                                   * ID bit method not supported by NexGen but
                                   * bios may load a cpuid instruction and
                                   * cpuid may be disabled on Cyrix 5-6x86 */
        popf
        pushf
        popl    %edx              /* copy new eflags to edx */
        xorl    %eax, %edx        /* test if ID bit is flipped */
        jz      .L_dont_use_mmx   /* not flipped if zero */
        xorl    %eax, %eax
        cpuid
        cmpl    $0x756e6547, %ebx /* check for GenuineIntel in ebx,ecx,edx */
        jne     .L_dont_use_mmx
        cmpl    $0x6c65746e, %ecx
        jne     .L_dont_use_mmx
        cmpl    $0x49656e69, %edx
        jne     .L_dont_use_mmx
        movl    $1, %eax
        cpuid                     /* get cpu features */
        shrl    $8, %eax
        andl    $15, %eax
        cmpl    $6, %eax          /* check for Pentium family, is 0xf for P4 */
        jne     .L_dont_use_mmx
        testl   $0x800000, %edx   /* test if MMX feature is set (bit 23) */
        jnz     .L_use_mmx
        jmp     .L_dont_use_mmx
.L_use_mmx:
        movl    $DO_USE_MMX, inflate_fast_use_mmx
        jmp     .L_check_mmx_pop
.L_dont_use_mmx:
        movl    $DONT_USE_MMX, inflate_fast_use_mmx
.L_check_mmx_pop:
        popl    %edx
        popl    %ecx
        popl    %ebx
        popl    %eax
        jmp     .L_check_mmx
#endif


/*** Non-MMX code ***/

#if defined ( NO_MMX ) || defined( RUN_TIME_MMX )

#define hold_r     %ebp
#define bits_r     %bl
#define bitslong_r %ebx

.align 32,0x90
.L_while_test:
        /* while (in < last && out < end)
         */
        cmpl    out_r, end(%esp)
        jbe     .L_break_loop           /* if (out >= end) */

        cmpl    in_r, last(%esp)
        jbe     .L_break_loop

.L_do_loop:
        /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out
         *
         * do {
         *   if (bits < 15) {
         *     hold |= *((unsigned short *)in)++ << bits;
         *     bits += 16
         *   }
         *   this = lcode[hold & lmask]
         */
        cmpb    $15, bits_r
        ja      .L_get_length_code      /* if (15 < bits) */

        xorl    %eax, %eax
        lodsw                           /* al = *(ushort *)in++ */
        movb    bits_r, %cl             /* cl = bits, needs it for shifting */
        addb    $16, bits_r             /* bits += 16 */
        shll    %cl, %eax
        orl     %eax, hold_r            /* hold |= *((ushort *)in)++ << bits */

.L_get_length_code:
        movl    lmask(%esp), %edx       /* edx = lmask */
        movl    lcode(%esp), %ecx       /* ecx = lcode */
        andl    hold_r, %edx            /* edx &= hold */
        movl    (%ecx,%edx,4), %eax     /* eax = lcode[hold & lmask] */

.L_dolen:
        /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out
         *
         * dolen:
         *    bits -= this.bits;
         *    hold >>= this.bits
         */
        movb    %ah, %cl                /* cl = this.bits */
        subb    %ah, bits_r             /* bits -= this.bits */
        shrl    %cl, hold_r             /* hold >>= this.bits */

        /* check if op is a literal
         * if (op == 0) {
         *    PUP(out) = this.val;
         *  }
         */
        testb   %al, %al
        jnz     .L_test_for_length_base /* if (op != 0) 45.7% */

        shrl    $16, %eax               /* output this.val char */
        stosb
        jmp     .L_while_test

.L_test_for_length_base:
        /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out, %edx = len
         *
         * else if (op & 16) {
         *   len = this.val
         *   op &= 15
         *   if (op) {
         *     if (op > bits) {
         *       hold |= *((unsigned short *)in)++ << bits;
         *       bits += 16
         *     }
         *     len += hold & mask[op];
         *     bits -= op;
         *     hold >>= op;
         *   }
         */
#define len_r %edx
        movl    %eax, len_r             /* len = this */
        shrl    $16, len_r              /* len = this.val */
        movb    %al, %cl

        testb   $16, %al
        jz      .L_test_for_second_level_length /* if ((op & 16) == 0) 8% */
        andb    $15, %cl                /* op &= 15 */
        jz      .L_save_len             /* if (!op) */
        cmpb    %cl, bits_r
        jae     .L_add_bits_to_len      /* if (op <= bits) */

        movb    %cl, %ch                /* stash op in ch, freeing cl */
        xorl    %eax, %eax
        lodsw                           /* al = *(ushort *)in++ */
        movb    bits_r, %cl             /* cl = bits, needs it for shifting */
        addb    $16, bits_r             /* bits += 16 */
        shll    %cl, %eax
        orl     %eax, hold_r            /* hold |= *((ushort *)in)++ << bits */
        movb    %ch, %cl                /* move op back to ecx */

.L_add_bits_to_len:
        movl    $1, %eax
        shll    %cl, %eax
        decl    %eax
        subb    %cl, bits_r
        andl    hold_r, %eax            /* eax &= hold */
        shrl    %cl, hold_r
        addl    %eax, len_r             /* len += hold & mask[op] */

.L_save_len:
        movl    len_r, len(%esp)        /* save len */
#undef  len_r

.L_decode_distance:
        /* regs: %esi = in, %ebp = hold, %bl = bits, %edi = out, %edx = dist
         *
         *   if (bits < 15) {
         *     hold |= *((unsigned short *)in)++ << bits;
         *     bits += 16
         *   }
         *   this = dcode[hold & dmask];
         * dodist:
         *   bits -= this.bits;
         *   hold >>= this.bits;
         *   op = this.op;
         */

        cmpb    $15, bits_r
        ja      .L_get_distance_code    /* if (15 < bits) */

        xorl    %eax, %eax
        lodsw                           /* al = *(ushort *)in++ */
        movb    bits_r, %cl             /* cl = bits, needs it for shifting */
        addb    $16, bits_r             /* bits += 16 */
        shll    %cl, %eax
        orl     %eax, hold_r            /* hold |= *((ushort *)in)++ << bits */

.L_get_distance_code:
        movl    dmask(%esp), %edx       /* edx = dmask */
        movl    dcode(%esp), %ecx       /* ecx = dcode */
        andl    hold_r, %edx            /* edx &= hold */
        movl    (%ecx,%edx,4), %eax     /* eax = dcode[hold & dmask] */

#define dist_r %edx
.L_dodist:
        movl    %eax, dist_r            /* dist = this */
        shrl    $16, dist_r             /* dist = this.val */
        movb    %ah, %cl
        subb    %ah, bits_r             /* bits -= this.bits */
        shrl    %cl, hold_r             /* hold >>= this.bits */

        /* if (op & 16) {
         *   dist = this.val
         *   op &= 15
         *   if (op > bits) {
         *     hold |= *((unsigned short *)in)++ << bits;
         *     bits += 16
         *   }
         *   dist += hold & mask[op];
         *   bits -= op;
         *   hold >>= op;
         */
        movb    %al, %cl                /* cl = this.op */

        testb   $16, %al                /* if ((op & 16) == 0) */
        jz      .L_test_for_second_level_dist
        andb    $15, %cl                /* op &= 15 */
        jz      .L_check_dist_one
        cmpb    %cl, bits_r
        jae     .L_add_bits_to_dist     /* if (op <= bits) 97.6% */

        movb    %cl, %ch                /* stash op in ch, freeing cl */
        xorl    %eax, %eax
        lodsw                           /* al = *(ushort *)in++ */
        movb    bits_r, %cl             /* cl = bits, needs it for shifting */
        addb    $16, bits_r             /* bits += 16 */
        shll    %cl, %eax
        orl     %eax, hold_r            /* hold |= *((ushort *)in)++ << bits */
        movb    %ch, %cl                /* move op back to ecx */

.L_add_bits_to_dist:
        movl    $1, %eax
        shll    %cl, %eax
        decl    %eax                    /* (1 << op) - 1 */
        subb    %cl, bits_r
        andl    hold_r, %eax            /* eax &= hold */
        shrl    %cl, hold_r
        addl    %eax, dist_r            /* dist += hold & ((1 << op) - 1) */
        jmp     .L_check_window

.L_check_window:
        /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
         *       %ecx = nbytes
         *
         * nbytes = out - beg;
         * if (dist <= nbytes) {
         *   from = out - dist;
         *   do {
         *     PUP(out) = PUP(from);
         *   } while (--len > 0) {
         * }
         */

        movl    in_r, in(%esp)          /* save in so from can use it's reg */
        movl    out_r, %eax
        subl    beg(%esp), %eax         /* nbytes = out - beg */

        cmpl    dist_r, %eax
        jb      .L_clip_window          /* if (dist > nbytes) 4.2% */

        movl    len(%esp), %ecx
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */

        subl    $3, %ecx
        movb    (from_r), %al
        movb    %al, (out_r)
        movb    1(from_r), %al
        movb    2(from_r), %dl
        addl    $3, from_r
        movb    %al, 1(out_r)
        movb    %dl, 2(out_r)
        addl    $3, out_r
        rep     movsb

        movl    in(%esp), in_r          /* move in back to %esi, toss from */
        jmp     .L_while_test

.align 16,0x90
.L_check_dist_one:
        cmpl    $1, dist_r
        jne     .L_check_window
        cmpl    out_r, beg(%esp)
        je      .L_check_window

        decl    out_r
        movl    len(%esp), %ecx
        movb    (out_r), %al
        subl    $3, %ecx

        movb    %al, 1(out_r)
        movb    %al, 2(out_r)
        movb    %al, 3(out_r)
        addl    $4, out_r
        rep     stosb

        jmp     .L_while_test

.align 16,0x90
.L_test_for_second_level_length:
        /* else if ((op & 64) == 0) {
         *   this = lcode[this.val + (hold & mask[op])];
         * }
         */
        testb   $64, %al
        jnz     .L_test_for_end_of_block  /* if ((op & 64) != 0) */

        movl    $1, %eax
        shll    %cl, %eax
        decl    %eax
        andl    hold_r, %eax            /* eax &= hold */
        addl    %edx, %eax              /* eax += this.val */
        movl    lcode(%esp), %edx       /* edx = lcode */
        movl    (%edx,%eax,4), %eax     /* eax = lcode[val + (hold&mask[op])] */
        jmp     .L_dolen

.align 16,0x90
.L_test_for_second_level_dist:
        /* else if ((op & 64) == 0) {
         *   this = dcode[this.val + (hold & mask[op])];
         * }
         */
        testb   $64, %al
        jnz     .L_invalid_distance_code  /* if ((op & 64) != 0) */

        movl    $1, %eax
        shll    %cl, %eax
        decl    %eax
        andl    hold_r, %eax            /* eax &= hold */
        addl    %edx, %eax              /* eax += this.val */
        movl    dcode(%esp), %edx       /* edx = dcode */
        movl    (%edx,%eax,4), %eax     /* eax = dcode[val + (hold&mask[op])] */
        jmp     .L_dodist

.align 16,0x90
.L_clip_window:
        /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
         *       %ecx = nbytes
         *
         * else {
         *   if (dist > wsize) {
         *     invalid distance
         *   }
         *   from = window;
         *   nbytes = dist - nbytes;
         *   if (write == 0) {
         *     from += wsize - nbytes;
         */
#define nbytes_r %ecx
        movl    %eax, nbytes_r
        movl    wsize(%esp), %eax       /* prepare for dist compare */
        negl    nbytes_r                /* nbytes = -nbytes */
        movl    window(%esp), from_r    /* from = window */

        cmpl    dist_r, %eax
        jb      .L_invalid_distance_too_far /* if (dist > wsize) */

        addl    dist_r, nbytes_r        /* nbytes = dist - nbytes */
        cmpl    $0, write(%esp)
        jne     .L_wrap_around_window   /* if (write != 0) */

        subl    nbytes_r, %eax
        addl    %eax, from_r            /* from += wsize - nbytes */

        /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
         *       %ecx = nbytes, %eax = len
         *
         *     if (nbytes < len) {
         *       len -= nbytes;
         *       do {
         *         PUP(out) = PUP(from);
         *       } while (--nbytes);
         *       from = out - dist;
         *     }
         *   }
         */
#define len_r %eax
        movl    len(%esp), len_r
        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1             /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */
        jmp     .L_do_copy1

        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1             /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */
        jmp     .L_do_copy1

.L_wrap_around_window:
        /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
         *       %ecx = nbytes, %eax = write, %eax = len
         *
         *   else if (write < nbytes) {
         *     from += wsize + write - nbytes;
         *     nbytes -= write;
         *     if (nbytes < len) {
         *       len -= nbytes;
         *       do {
         *         PUP(out) = PUP(from);
         *       } while (--nbytes);
         *       from = window;
         *       nbytes = write;
         *       if (nbytes < len) {
         *         len -= nbytes;
         *         do {
         *           PUP(out) = PUP(from);
         *         } while(--nbytes);
         *         from = out - dist;
         *       }
         *     }
         *   }
         */
#define write_r %eax
        movl    write(%esp), write_r
        cmpl    write_r, nbytes_r
        jbe     .L_contiguous_in_window /* if (write >= nbytes) */

        addl    wsize(%esp), from_r
        addl    write_r, from_r
        subl    nbytes_r, from_r        /* from += wsize + write - nbytes */
        subl    write_r, nbytes_r       /* nbytes -= write */
#undef write_r

        movl    len(%esp), len_r
        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1             /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    window(%esp), from_r    /* from = window */
        movl    write(%esp), nbytes_r   /* nbytes = write */
        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1             /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */
        jmp     .L_do_copy1

.L_contiguous_in_window:
        /* regs: %esi = from, %ebp = hold, %bl = bits, %edi = out, %edx = dist
         *       %ecx = nbytes, %eax = write, %eax = len
         *
         *   else {
         *     from += write - nbytes;
         *     if (nbytes < len) {
         *       len -= nbytes;
         *       do {
         *         PUP(out) = PUP(from);
         *       } while (--nbytes);
         *       from = out - dist;
         *     }
         *   }
         */
#define write_r %eax
        addl    write_r, from_r
        subl    nbytes_r, from_r        /* from += write - nbytes */
#undef write_r

        movl    len(%esp), len_r
        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1             /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */

.L_do_copy1:
        /* regs: %esi = from, %esi = in, %ebp = hold, %bl = bits, %edi = out
         *       %eax = len
         *
         *     while (len > 0) {
         *       PUP(out) = PUP(from);
         *       len--;
         *     }
         *   }
         * } while (in < last && out < end);
         */
#undef nbytes_r
#define in_r %esi
        movl    len_r, %ecx
        rep     movsb

        movl    in(%esp), in_r          /* move in back to %esi, toss from */
        jmp     .L_while_test

#undef len_r
#undef dist_r

#endif /* NO_MMX || RUN_TIME_MMX */


/*** MMX code ***/

#if defined( USE_MMX ) || defined( RUN_TIME_MMX )

.align 32,0x90
.L_init_mmx:
        emms

#undef  bits_r
#undef  bitslong_r
#define bitslong_r %ebp
#define hold_mm    %mm0
        movd    %ebp, hold_mm
        movl    %ebx, bitslong_r

#define used_mm   %mm1
#define dmask2_mm %mm2
#define lmask2_mm %mm3
#define lmask_mm  %mm4
#define dmask_mm  %mm5
#define tmp_mm    %mm6

        movd    lmask(%esp), lmask_mm
        movq    lmask_mm, lmask2_mm
        movd    dmask(%esp), dmask_mm
        movq    dmask_mm, dmask2_mm
        pxor    used_mm, used_mm
        movl    lcode(%esp), %ebx       /* ebx = lcode */
        jmp     .L_do_loop_mmx

.align 32,0x90
.L_while_test_mmx:
        /* while (in < last && out < end)
         */
        cmpl    out_r, end(%esp)
        jbe     .L_break_loop           /* if (out >= end) */

        cmpl    in_r, last(%esp)
        jbe     .L_break_loop

.L_do_loop_mmx:
        psrlq   used_mm, hold_mm        /* hold_mm >>= last bit length */

        cmpl    $32, bitslong_r
        ja      .L_get_length_code_mmx  /* if (32 < bits) */

        movd    bitslong_r, tmp_mm
        movd    (in_r), %mm7
        addl    $4, in_r
        psllq   tmp_mm, %mm7
        addl    $32, bitslong_r
        por     %mm7, hold_mm           /* hold_mm |= *((uint *)in)++ << bits */

.L_get_length_code_mmx:
        pand    hold_mm, lmask_mm
        movd    lmask_mm, %eax
        movq    lmask2_mm, lmask_mm
        movl    (%ebx,%eax,4), %eax     /* eax = lcode[hold & lmask] */

.L_dolen_mmx:
        movzbl  %ah, %ecx               /* ecx = this.bits */
        movd    %ecx, used_mm
        subl    %ecx, bitslong_r        /* bits -= this.bits */

        testb   %al, %al
        jnz     .L_test_for_length_base_mmx /* if (op != 0) 45.7% */

        shrl    $16, %eax               /* output this.val char */
        stosb
        jmp     .L_while_test_mmx

.L_test_for_length_base_mmx:
#define len_r  %edx
        movl    %eax, len_r             /* len = this */
        shrl    $16, len_r              /* len = this.val */

        testb   $16, %al
        jz      .L_test_for_second_level_length_mmx /* if ((op & 16) == 0) 8% */
        andl    $15, %eax               /* op &= 15 */
        jz      .L_decode_distance_mmx  /* if (!op) */

        psrlq   used_mm, hold_mm        /* hold_mm >>= last bit length */
        movd    %eax, used_mm
        movd    hold_mm, %ecx
        subl    %eax, bitslong_r
        andl    .L_mask(,%eax,4), %ecx
        addl    %ecx, len_r             /* len += hold & mask[op] */

.L_decode_distance_mmx:
        psrlq   used_mm, hold_mm        /* hold_mm >>= last bit length */

        cmpl    $32, bitslong_r
        ja      .L_get_dist_code_mmx    /* if (32 < bits) */

        movd    bitslong_r, tmp_mm
        movd    (in_r), %mm7
        addl    $4, in_r
        psllq   tmp_mm, %mm7
        addl    $32, bitslong_r
        por     %mm7, hold_mm           /* hold_mm |= *((uint *)in)++ << bits */

.L_get_dist_code_mmx:
        movl    dcode(%esp), %ebx       /* ebx = dcode */
        pand    hold_mm, dmask_mm
        movd    dmask_mm, %eax
        movq    dmask2_mm, dmask_mm
        movl    (%ebx,%eax,4), %eax     /* eax = dcode[hold & lmask] */

.L_dodist_mmx:
#define dist_r %ebx
        movzbl  %ah, %ecx               /* ecx = this.bits */
        movl    %eax, dist_r
        shrl    $16, dist_r             /* dist  = this.val */
        subl    %ecx, bitslong_r        /* bits -= this.bits */
        movd    %ecx, used_mm

        testb   $16, %al                /* if ((op & 16) == 0) */
        jz      .L_test_for_second_level_dist_mmx
        andl    $15, %eax               /* op &= 15 */
        jz      .L_check_dist_one_mmx

.L_add_bits_to_dist_mmx:
        psrlq   used_mm, hold_mm        /* hold_mm >>= last bit length */
        movd    %eax, used_mm           /* save bit length of current op */
        movd    hold_mm, %ecx           /* get the next bits on input stream */
        subl    %eax, bitslong_r        /* bits -= op bits */
        andl    .L_mask(,%eax,4), %ecx  /* ecx   = hold & mask[op] */
        addl    %ecx, dist_r            /* dist += hold & mask[op] */

.L_check_window_mmx:
        movl    in_r, in(%esp)          /* save in so from can use it's reg */
        movl    out_r, %eax
        subl    beg(%esp), %eax         /* nbytes = out - beg */

        cmpl    dist_r, %eax
        jb      .L_clip_window_mmx      /* if (dist > nbytes) 4.2% */

        movl    len_r, %ecx
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */

        subl    $3, %ecx
        movb    (from_r), %al
        movb    %al, (out_r)
        movb    1(from_r), %al
        movb    2(from_r), %dl
        addl    $3, from_r
        movb    %al, 1(out_r)
        movb    %dl, 2(out_r)
        addl    $3, out_r
        rep     movsb

        movl    in(%esp), in_r          /* move in back to %esi, toss from */
        movl    lcode(%esp), %ebx       /* move lcode back to %ebx, toss dist */
        jmp     .L_while_test_mmx

.align 16,0x90
.L_check_dist_one_mmx:
        cmpl    $1, dist_r
        jne     .L_check_window_mmx
        cmpl    out_r, beg(%esp)
        je      .L_check_window_mmx

        decl    out_r
        movl    len_r, %ecx
        movb    (out_r), %al
        subl    $3, %ecx

        movb    %al, 1(out_r)
        movb    %al, 2(out_r)
        movb    %al, 3(out_r)
        addl    $4, out_r
        rep     stosb

        movl    lcode(%esp), %ebx       /* move lcode back to %ebx, toss dist */
        jmp     .L_while_test_mmx

.align 16,0x90
.L_test_for_second_level_length_mmx:
        testb   $64, %al
        jnz     .L_test_for_end_of_block  /* if ((op & 64) != 0) */

        andl    $15, %eax
        psrlq   used_mm, hold_mm        /* hold_mm >>= last bit length */
        movd    hold_mm, %ecx
        andl    .L_mask(,%eax,4), %ecx
        addl    len_r, %ecx
        movl    (%ebx,%ecx,4), %eax     /* eax = lcode[hold & lmask] */
        jmp     .L_dolen_mmx

.align 16,0x90
.L_test_for_second_level_dist_mmx:
        testb   $64, %al
        jnz     .L_invalid_distance_code  /* if ((op & 64) != 0) */

        andl    $15, %eax
        psrlq   used_mm, hold_mm        /* hold_mm >>= last bit length */
        movd    hold_mm, %ecx
        andl    .L_mask(,%eax,4), %ecx
        movl    dcode(%esp), %eax       /* ecx = dcode */
        addl    dist_r, %ecx
        movl    (%eax,%ecx,4), %eax     /* eax = lcode[hold & lmask] */
        jmp     .L_dodist_mmx

.align 16,0x90
.L_clip_window_mmx:
#define nbytes_r %ecx
        movl    %eax, nbytes_r
        movl    wsize(%esp), %eax       /* prepare for dist compare */
        negl    nbytes_r                /* nbytes = -nbytes */
        movl    window(%esp), from_r    /* from = window */

        cmpl    dist_r, %eax
        jb      .L_invalid_distance_too_far /* if (dist > wsize) */

        addl    dist_r, nbytes_r        /* nbytes = dist - nbytes */
        cmpl    $0, write(%esp)
        jne     .L_wrap_around_window_mmx /* if (write != 0) */

        subl    nbytes_r, %eax
        addl    %eax, from_r            /* from += wsize - nbytes */

        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1_mmx         /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */
        jmp     .L_do_copy1_mmx

        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1_mmx         /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */
        jmp     .L_do_copy1_mmx

.L_wrap_around_window_mmx:
#define write_r %eax
        movl    write(%esp), write_r
        cmpl    write_r, nbytes_r
        jbe     .L_contiguous_in_window_mmx /* if (write >= nbytes) */

        addl    wsize(%esp), from_r
        addl    write_r, from_r
        subl    nbytes_r, from_r        /* from += wsize + write - nbytes */
        subl    write_r, nbytes_r       /* nbytes -= write */
#undef write_r

        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1_mmx         /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    window(%esp), from_r    /* from = window */
        movl    write(%esp), nbytes_r   /* nbytes = write */
        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1_mmx         /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */
        jmp     .L_do_copy1_mmx

.L_contiguous_in_window_mmx:
#define write_r %eax
        addl    write_r, from_r
        subl    nbytes_r, from_r        /* from += write - nbytes */
#undef write_r

        cmpl    nbytes_r, len_r
        jbe     .L_do_copy1_mmx         /* if (nbytes >= len) */

        subl    nbytes_r, len_r         /* len -= nbytes */
        rep     movsb
        movl    out_r, from_r
        subl    dist_r, from_r          /* from = out - dist */

.L_do_copy1_mmx:
#undef nbytes_r
#define in_r %esi
        movl    len_r, %ecx
        rep     movsb

        movl    in(%esp), in_r          /* move in back to %esi, toss from */
        movl    lcode(%esp), %ebx       /* move lcode back to %ebx, toss dist */
        jmp     .L_while_test_mmx

#undef hold_r
#undef bitslong_r

#endif /* USE_MMX || RUN_TIME_MMX */


/*** USE_MMX, NO_MMX, and RUNTIME_MMX from here on ***/

.L_invalid_distance_code:
        /* else {
         *   strm->msg = "invalid distance code";
         *   state->mode = BAD;
         * }
         */
        movl    $.L_invalid_distance_code_msg, %ecx
        movl    $INFLATE_MODE_BAD, %edx
        jmp     .L_update_stream_state

.L_test_for_end_of_block:
        /* else if (op & 32) {
         *   state->mode = TYPE;
         *   break;
         * }
         */
        testb   $32, %al
        jz      .L_invalid_literal_length_code  /* if ((op & 32) == 0) */

        movl    $0, %ecx
        movl    $INFLATE_MODE_TYPE, %edx
        jmp     .L_update_stream_state

.L_invalid_literal_length_code:
        /* else {
         *   strm->msg = "invalid literal/length code";
         *   state->mode = BAD;
         * }
         */
        movl    $.L_invalid_literal_length_code_msg, %ecx
        movl    $INFLATE_MODE_BAD, %edx
        jmp     .L_update_stream_state

.L_invalid_distance_too_far:
        /* strm->msg = "invalid distance too far back";
         * state->mode = BAD;
         */
        movl    in(%esp), in_r          /* from_r has in's reg, put in back */
        movl    $.L_invalid_distance_too_far_msg, %ecx
        movl    $INFLATE_MODE_BAD, %edx
        jmp     .L_update_stream_state

.L_update_stream_state:
        /* set strm->msg = %ecx, strm->state->mode = %edx */
        movl    strm_sp(%esp), %eax
        testl   %ecx, %ecx              /* if (msg != NULL) */
        jz      .L_skip_msg
        movl    %ecx, msg_strm(%eax)    /* strm->msg = msg */
.L_skip_msg:
        movl    state_strm(%eax), %eax  /* state = strm->state */
        movl    %edx, mode_state(%eax)  /* state->mode = edx (BAD | TYPE) */
        jmp     .L_break_loop

.align 32,0x90
.L_break_loop:

/*
 * Regs:
 *
 * bits = %ebp when mmx, and in %ebx when non-mmx
 * hold = %hold_mm when mmx, and in %ebp when non-mmx
 * in   = %esi
 * out  = %edi
 */

#if defined( USE_MMX ) || defined( RUN_TIME_MMX )

#if defined( RUN_TIME_MMX )

        cmpl    $DO_USE_MMX, inflate_fast_use_mmx
        jne     .L_update_next_in

#endif /* RUN_TIME_MMX */

        movl    %ebp, %ebx

.L_update_next_in:

#endif

#define strm_r  %eax
#define state_r %edx

        /* len = bits >> 3;
         * in -= len;
         * bits -= len << 3;
         * hold &= (1U << bits) - 1;
         * state->hold = hold;
         * state->bits = bits;
         * strm->next_in = in;
         * strm->next_out = out;
         */
        movl    strm_sp(%esp), strm_r
        movl    %ebx, %ecx
        movl    state_strm(strm_r), state_r
        shrl    $3, %ecx
        subl    %ecx, in_r
        shll    $3, %ecx
        subl    %ecx, %ebx
        movl    out_r, next_out_strm(strm_r)
        movl    %ebx, bits_state(state_r)
        movl    %ebx, %ecx

        leal    buf(%esp), %ebx
        cmpl    %ebx, last(%esp)
        jne     .L_buf_not_used         /* if buf != last */

        subl    %ebx, in_r              /* in -= buf */
        movl    next_in_strm(strm_r), %ebx
        movl    %ebx, last(%esp)        /* last = strm->next_in */
        addl    %ebx, in_r              /* in += strm->next_in */
        movl    avail_in_strm(strm_r), %ebx
        subl    $11, %ebx
        addl    %ebx, last(%esp)    /* last = &strm->next_in[ avail_in - 11 ] */

.L_buf_not_used:
        movl    in_r, next_in_strm(strm_r)

        movl    $1, %ebx
        shll    %cl, %ebx
        decl    %ebx

#if defined( USE_MMX ) || defined( RUN_TIME_MMX )

#if defined( RUN_TIME_MMX )

        cmpl    $DO_USE_MMX, inflate_fast_use_mmx
        jne     .L_update_hold

#endif /* RUN_TIME_MMX */

        psrlq   used_mm, hold_mm        /* hold_mm >>= last bit length */
        movd    hold_mm, %ebp

        emms

.L_update_hold:

#endif /* USE_MMX || RUN_TIME_MMX */

        andl    %ebx, %ebp
        movl    %ebp, hold_state(state_r)

#define last_r %ebx

        /* strm->avail_in = in < last ? 11 + (last - in) : 11 - (in - last) */
        movl    last(%esp), last_r
        cmpl    in_r, last_r
        jbe     .L_last_is_smaller     /* if (in >= last) */

        subl    in_r, last_r           /* last -= in */
        addl    $11, last_r            /* last += 11 */
        movl    last_r, avail_in_strm(strm_r)
        jmp     .L_fixup_out
.L_last_is_smaller:
        subl    last_r, in_r           /* in -= last */
        negl    in_r                   /* in = -in */
        addl    $11, in_r              /* in += 11 */
        movl    in_r, avail_in_strm(strm_r)

#undef last_r
#define end_r %ebx

.L_fixup_out:
        /* strm->avail_out = out < end ? 257 + (end - out) : 257 - (out - end)*/
        movl    end(%esp), end_r
        cmpl    out_r, end_r
        jbe     .L_end_is_smaller      /* if (out >= end) */

        subl    out_r, end_r           /* end -= out */
        addl    $257, end_r            /* end += 257 */
        movl    end_r, avail_out_strm(strm_r)
        jmp     .L_done
.L_end_is_smaller:
        subl    end_r, out_r           /* out -= end */
        negl    out_r                  /* out = -out */
        addl    $257, out_r            /* out += 257 */
        movl    out_r, avail_out_strm(strm_r)

#undef end_r
#undef strm_r
#undef state_r

.L_done:
        addl    $local_var_size, %esp
        popf
        popl    %ebx
        popl    %ebp
        popl    %esi
        popl    %edi
        ret

#if defined( GAS_ELF )
/* elf info */
.type inflate_fast,@function
.size inflate_fast,.-inflate_fast
#endif

Deleted compat/zlib/contrib/iostream/test.cpp.

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
























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#include "zfstream.h"

int main() {

  // Construct a stream object with this filebuffer.  Anything sent
  // to this stream will go to standard out.
  gzofstream os( 1, ios::out );

  // This text is getting compressed and sent to stdout.
  // To prove this, run 'test | zcat'.
  os << "Hello, Mommy" << endl;

  os << setcompressionlevel( Z_NO_COMPRESSION );
  os << "hello, hello, hi, ho!" << endl;

  setcompressionlevel( os, Z_DEFAULT_COMPRESSION )
    << "I'm compressing again" << endl;

  os.close();

  return 0;

}

Deleted compat/zlib/contrib/iostream/zfstream.cpp.

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









































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#include "zfstream.h"

gzfilebuf::gzfilebuf() :
  file(NULL),
  mode(0),
  own_file_descriptor(0)
{ }

gzfilebuf::~gzfilebuf() {

  sync();
  if ( own_file_descriptor )
    close();

}

gzfilebuf *gzfilebuf::open( const char *name,
                            int io_mode ) {

  if ( is_open() )
    return NULL;

  char char_mode[10];
  char *p = char_mode;

  if ( io_mode & ios::in ) {
    mode = ios::in;
    *p++ = 'r';
  } else if ( io_mode & ios::app ) {
    mode = ios::app;
    *p++ = 'a';
  } else {
    mode = ios::out;
    *p++ = 'w';
  }

  if ( io_mode & ios::binary ) {
    mode |= ios::binary;
    *p++ = 'b';
  }

  // Hard code the compression level
  if ( io_mode & (ios::out|ios::app )) {
    *p++ = '9';
  }

  // Put the end-of-string indicator
  *p = '\0';

  if ( (file = gzopen(name, char_mode)) == NULL )
    return NULL;

  own_file_descriptor = 1;

  return this;

}

gzfilebuf *gzfilebuf::attach( int file_descriptor,
                              int io_mode ) {

  if ( is_open() )
    return NULL;

  char char_mode[10];
  char *p = char_mode;

  if ( io_mode & ios::in ) {
    mode = ios::in;
    *p++ = 'r';
  } else if ( io_mode & ios::app ) {
    mode = ios::app;
    *p++ = 'a';
  } else {
    mode = ios::out;
    *p++ = 'w';
  }

  if ( io_mode & ios::binary ) {
    mode |= ios::binary;
    *p++ = 'b';
  }

  // Hard code the compression level
  if ( io_mode & (ios::out|ios::app )) {
    *p++ = '9';
  }

  // Put the end-of-string indicator
  *p = '\0';

  if ( (file = gzdopen(file_descriptor, char_mode)) == NULL )
    return NULL;

  own_file_descriptor = 0;

  return this;

}

gzfilebuf *gzfilebuf::close() {

  if ( is_open() ) {

    sync();
    gzclose( file );
    file = NULL;

  }

  return this;

}

int gzfilebuf::setcompressionlevel( int comp_level ) {

  return gzsetparams(file, comp_level, -2);

}

int gzfilebuf::setcompressionstrategy( int comp_strategy ) {

  return gzsetparams(file, -2, comp_strategy);

}


streampos gzfilebuf::seekoff( streamoff off, ios::seek_dir dir, int which ) {

  return streampos(EOF);

}

int gzfilebuf::underflow() {

  // If the file hasn't been opened for reading, error.
  if ( !is_open() || !(mode & ios::in) )
    return EOF;

  // if a buffer doesn't exists, allocate one.
  if ( !base() ) {

    if ( (allocate()) == EOF )
      return EOF;
    setp(0,0);

  } else {

    if ( in_avail() )
      return (unsigned char) *gptr();

    if ( out_waiting() ) {
      if ( flushbuf() == EOF )
        return EOF;
    }

  }

  // Attempt to fill the buffer.

  int result = fillbuf();
  if ( result == EOF ) {
    // disable get area
    setg(0,0,0);
    return EOF;
  }

  return (unsigned char) *gptr();

}

int gzfilebuf::overflow( int c ) {

  if ( !is_open() || !(mode & ios::out) )
    return EOF;

  if ( !base() ) {
    if ( allocate() == EOF )
      return EOF;
    setg(0,0,0);
  } else {
    if (in_avail()) {
        return EOF;
    }
    if (out_waiting()) {
      if (flushbuf() == EOF)
        return EOF;
    }
  }

  int bl = blen();
  setp( base(), base() + bl);

  if ( c != EOF ) {

    *pptr() = c;
    pbump(1);

  }

  return 0;

}

int gzfilebuf::sync() {

  if ( !is_open() )
    return EOF;

  if ( out_waiting() )
    return flushbuf();

  return 0;

}

int gzfilebuf::flushbuf() {

  int n;
  char *q;

  q = pbase();
  n = pptr() - q;

  if ( gzwrite( file, q, n) < n )
    return EOF;

  setp(0,0);

  return 0;

}

int gzfilebuf::fillbuf() {

  int required;
  char *p;

  p = base();

  required = blen();

  int t = gzread( file, p, required );

  if ( t <= 0) return EOF;

  setg( base(), base(), base()+t);

  return t;

}

gzfilestream_common::gzfilestream_common() :
  ios( gzfilestream_common::rdbuf() )
{ }

gzfilestream_common::~gzfilestream_common()
{ }

void gzfilestream_common::attach( int fd, int io_mode ) {

  if ( !buffer.attach( fd, io_mode) )
    clear( ios::failbit | ios::badbit );
  else
    clear();

}

void gzfilestream_common::open( const char *name, int io_mode ) {

  if ( !buffer.open( name, io_mode ) )
    clear( ios::failbit | ios::badbit );
  else
    clear();

}

void gzfilestream_common::close() {

  if ( !buffer.close() )
    clear( ios::failbit | ios::badbit );

}

gzfilebuf *gzfilestream_common::rdbuf()
{
  return &buffer;
}

gzifstream::gzifstream() :
  ios( gzfilestream_common::rdbuf() )
{
  clear( ios::badbit );
}

gzifstream::gzifstream( const char *name, int io_mode ) :
  ios( gzfilestream_common::rdbuf() )
{
  gzfilestream_common::open( name, io_mode );
}

gzifstream::gzifstream( int fd, int io_mode ) :
  ios( gzfilestream_common::rdbuf() )
{
  gzfilestream_common::attach( fd, io_mode );
}

gzifstream::~gzifstream() { }

gzofstream::gzofstream() :
  ios( gzfilestream_common::rdbuf() )
{
  clear( ios::badbit );
}

gzofstream::gzofstream( const char *name, int io_mode ) :
  ios( gzfilestream_common::rdbuf() )
{
  gzfilestream_common::open( name, io_mode );
}

gzofstream::gzofstream( int fd, int io_mode ) :
  ios( gzfilestream_common::rdbuf() )
{
  gzfilestream_common::attach( fd, io_mode );
}

gzofstream::~gzofstream() { }

Deleted compat/zlib/contrib/iostream/zfstream.h.

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
































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#ifndef zfstream_h
#define zfstream_h

#include <fstream.h>
#include "zlib.h"

class gzfilebuf : public streambuf {

public:

  gzfilebuf( );
  virtual ~gzfilebuf();

  gzfilebuf *open( const char *name, int io_mode );
  gzfilebuf *attach( int file_descriptor, int io_mode );
  gzfilebuf *close();

  int setcompressionlevel( int comp_level );
  int setcompressionstrategy( int comp_strategy );

  inline int is_open() const { return (file !=NULL); }

  virtual streampos seekoff( streamoff, ios::seek_dir, int );

  virtual int sync();

protected:

  virtual int underflow();
  virtual int overflow( int = EOF );

private:

  gzFile file;
  short mode;
  short own_file_descriptor;

  int flushbuf();
  int fillbuf();

};

class gzfilestream_common : virtual public ios {

  friend class gzifstream;
  friend class gzofstream;
  friend gzofstream &setcompressionlevel( gzofstream &, int );
  friend gzofstream &setcompressionstrategy( gzofstream &, int );

public:
  virtual ~gzfilestream_common();

  void attach( int fd, int io_mode );
  void open( const char *name, int io_mode );
  void close();

protected:
  gzfilestream_common();

private:
  gzfilebuf *rdbuf();

  gzfilebuf buffer;

};

class gzifstream : public gzfilestream_common, public istream {

public:

  gzifstream();
  gzifstream( const char *name, int io_mode = ios::in );
  gzifstream( int fd, int io_mode = ios::in );

  virtual ~gzifstream();

};

class gzofstream : public gzfilestream_common, public ostream {

public:

  gzofstream();
  gzofstream( const char *name, int io_mode = ios::out );
  gzofstream( int fd, int io_mode = ios::out );

  virtual ~gzofstream();

};

template<class T> class gzomanip {
  friend gzofstream &operator<<(gzofstream &, const gzomanip<T> &);
public:
  gzomanip(gzofstream &(*f)(gzofstream &, T), T v) : func(f), val(v) { }
private:
  gzofstream &(*func)(gzofstream &, T);
  T val;
};

template<class T> gzofstream &operator<<(gzofstream &s, const gzomanip<T> &m)
{
  return (*m.func)(s, m.val);
}

inline gzofstream &setcompressionlevel( gzofstream &s, int l )
{
  (s.rdbuf())->setcompressionlevel(l);
  return s;
}

inline gzofstream &setcompressionstrategy( gzofstream &s, int l )
{
  (s.rdbuf())->setcompressionstrategy(l);
  return s;
}

inline gzomanip<int> setcompressionlevel(int l)
{
  return gzomanip<int>(&setcompressionlevel,l);
}

inline gzomanip<int> setcompressionstrategy(int l)
{
  return gzomanip<int>(&setcompressionstrategy,l);
}

#endif

Deleted compat/zlib/contrib/iostream2/zstream.h.

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



















































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 *
 * Copyright (c) 1997
 * Christian Michelsen Research AS
 * Advanced Computing
 * Fantoftvegen 38, 5036 BERGEN, Norway
 * http://www.cmr.no
 *
 * Permission to use, copy, modify, distribute and sell this software
 * and its documentation for any purpose is hereby granted without fee,
 * provided that the above copyright notice appear in all copies and
 * that both that copyright notice and this permission notice appear
 * in supporting documentation.  Christian Michelsen Research AS makes no
 * representations about the suitability of this software for any
 * purpose.  It is provided "as is" without express or implied warranty.
 *
 */

#ifndef ZSTREAM__H
#define ZSTREAM__H

/*
 * zstream.h - C++ interface to the 'zlib' general purpose compression library
 * $Id: zstream.h 1.1 1997-06-25 12:00:56+02 tyge Exp tyge $
 */

#include <strstream.h>
#include <string.h>
#include <stdio.h>
#include "zlib.h"

#if defined(_WIN32)
#   include <fcntl.h>
#   include <io.h>
#   define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
#else
#   define SET_BINARY_MODE(file)
#endif

class zstringlen {
public:
    zstringlen(class izstream&);
    zstringlen(class ozstream&, const char*);
    size_t value() const { return val.word; }
private:
    struct Val { unsigned char byte; size_t word; } val;
};

//  ----------------------------- izstream -----------------------------

class izstream
{
    public:
        izstream() : m_fp(0) {}
        izstream(FILE* fp) : m_fp(0) { open(fp); }
        izstream(const char* name) : m_fp(0) { open(name); }
        ~izstream() { close(); }

        /* Opens a gzip (.gz) file for reading.
         * open() can be used to read a file which is not in gzip format;
         * in this case read() will directly read from the file without
         * decompression. errno can be checked to distinguish two error
         * cases (if errno is zero, the zlib error is Z_MEM_ERROR).
         */
        void open(const char* name) {
            if (m_fp) close();
            m_fp = ::gzopen(name, "rb");
        }

        void open(FILE* fp) {
            SET_BINARY_MODE(fp);
            if (m_fp) close();
            m_fp = ::gzdopen(fileno(fp), "rb");
        }

        /* Flushes all pending input if necessary, closes the compressed file
         * and deallocates all the (de)compression state. The return value is
         * the zlib error number (see function error() below).
         */
        int close() {
            int r = ::gzclose(m_fp);
            m_fp = 0; return r;
        }

        /* Binary read the given number of bytes from the compressed file.
         */
        int read(void* buf, size_t len) {
            return ::gzread(m_fp, buf, len);
        }

        /* Returns the error message for the last error which occurred on the
         * given compressed file. errnum is set to zlib error number. If an
         * error occurred in the file system and not in the compression library,
         * errnum is set to Z_ERRNO and the application may consult errno
         * to get the exact error code.
         */
        const char* error(int* errnum) {
            return ::gzerror(m_fp, errnum);
        }

        gzFile fp() { return m_fp; }

    private:
        gzFile m_fp;
};

/*
 * Binary read the given (array of) object(s) from the compressed file.
 * If the input file was not in gzip format, read() copies the objects number
 * of bytes into the buffer.
 * returns the number of uncompressed bytes actually read
 * (0 for end of file, -1 for error).
 */
template <class T, class Items>
inline int read(izstream& zs, T* x, Items items) {
    return ::gzread(zs.fp(), x, items*sizeof(T));
}

/*
 * Binary input with the '>' operator.
 */
template <class T>
inline izstream& operator>(izstream& zs, T& x) {
    ::gzread(zs.fp(), &x, sizeof(T));
    return zs;
}


inline zstringlen::zstringlen(izstream& zs) {
    zs > val.byte;
    if (val.byte == 255) zs > val.word;
    else val.word = val.byte;
}

/*
 * Read length of string + the string with the '>' operator.
 */
inline izstream& operator>(izstream& zs, char* x) {
    zstringlen len(zs);
    ::gzread(zs.fp(), x, len.value());
    x[len.value()] = '\0';
    return zs;
}

inline char* read_string(izstream& zs) {
    zstringlen len(zs);
    char* x = new char[len.value()+1];
    ::gzread(zs.fp(), x, len.value());
    x[len.value()] = '\0';
    return x;
}

// ----------------------------- ozstream -----------------------------

class ozstream
{
    public:
        ozstream() : m_fp(0), m_os(0) {
        }
        ozstream(FILE* fp, int level = Z_DEFAULT_COMPRESSION)
            : m_fp(0), m_os(0) {
            open(fp, level);
        }
        ozstream(const char* name, int level = Z_DEFAULT_COMPRESSION)
            : m_fp(0), m_os(0) {
            open(name, level);
        }
        ~ozstream() {
            close();
        }

        /* Opens a gzip (.gz) file for writing.
         * The compression level parameter should be in 0..9
         * errno can be checked to distinguish two error cases
         * (if errno is zero, the zlib error is Z_MEM_ERROR).
         */
        void open(const char* name, int level = Z_DEFAULT_COMPRESSION) {
            char mode[4] = "wb\0";
            if (level != Z_DEFAULT_COMPRESSION) mode[2] = '0'+level;
            if (m_fp) close();
            m_fp = ::gzopen(name, mode);
        }

        /* open from a FILE pointer.
         */
        void open(FILE* fp, int level = Z_DEFAULT_COMPRESSION) {
            SET_BINARY_MODE(fp);
            char mode[4] = "wb\0";
            if (level != Z_DEFAULT_COMPRESSION) mode[2] = '0'+level;
            if (m_fp) close();
            m_fp = ::gzdopen(fileno(fp), mode);
        }

        /* Flushes all pending output if necessary, closes the compressed file
         * and deallocates all the (de)compression state. The return value is
         * the zlib error number (see function error() below).
         */
        int close() {
            if (m_os) {
                ::gzwrite(m_fp, m_os->str(), m_os->pcount());
                delete[] m_os->str(); delete m_os; m_os = 0;
            }
            int r = ::gzclose(m_fp); m_fp = 0; return r;
        }

        /* Binary write the given number of bytes into the compressed file.
         */
        int write(const void* buf, size_t len) {
            return ::gzwrite(m_fp, (voidp) buf, len);
        }

        /* Flushes all pending output into the compressed file. The parameter
         * _flush is as in the deflate() function. The return value is the zlib
         * error number (see function gzerror below). flush() returns Z_OK if
         * the flush_ parameter is Z_FINISH and all output could be flushed.
         * flush() should be called only when strictly necessary because it can
         * degrade compression.
         */
        int flush(int _flush) {
            os_flush();
            return ::gzflush(m_fp, _flush);
        }

        /* Returns the error message for the last error which occurred on the
         * given compressed file. errnum is set to zlib error number. If an
         * error occurred in the file system and not in the compression library,
         * errnum is set to Z_ERRNO and the application may consult errno
         * to get the exact error code.
         */
        const char* error(int* errnum) {
            return ::gzerror(m_fp, errnum);
        }

        gzFile fp() { return m_fp; }

        ostream& os() {
            if (m_os == 0) m_os = new ostrstream;
            return *m_os;
        }

        void os_flush() {
            if (m_os && m_os->pcount()>0) {
                ostrstream* oss = new ostrstream;
                oss->fill(m_os->fill());
                oss->flags(m_os->flags());
                oss->precision(m_os->precision());
                oss->width(m_os->width());
                ::gzwrite(m_fp, m_os->str(), m_os->pcount());
                delete[] m_os->str(); delete m_os; m_os = oss;
            }
        }

    private:
        gzFile m_fp;
        ostrstream* m_os;
};

/*
 * Binary write the given (array of) object(s) into the compressed file.
 * returns the number of uncompressed bytes actually written
 * (0 in case of error).
 */
template <class T, class Items>
inline int write(ozstream& zs, const T* x, Items items) {
    return ::gzwrite(zs.fp(), (voidp) x, items*sizeof(T));
}

/*
 * Binary output with the '<' operator.
 */
template <class T>
inline ozstream& operator<(ozstream& zs, const T& x) {
    ::gzwrite(zs.fp(), (voidp) &x, sizeof(T));
    return zs;
}

inline zstringlen::zstringlen(ozstream& zs, const char* x) {
    val.byte = 255;  val.word = ::strlen(x);
    if (val.word < 255) zs < (val.byte = val.word);
    else zs < val;
}

/*
 * Write length of string + the string with the '<' operator.
 */
inline ozstream& operator<(ozstream& zs, const char* x) {
    zstringlen len(zs, x);
    ::gzwrite(zs.fp(), (voidp) x, len.value());
    return zs;
}

#ifdef _MSC_VER
inline ozstream& operator<(ozstream& zs, char* const& x) {
    return zs < (const char*) x;
}
#endif

/*
 * Ascii write with the << operator;
 */
template <class T>
inline ostream& operator<<(ozstream& zs, const T& x) {
    zs.os_flush();
    return zs.os() << x;
}

#endif

Deleted compat/zlib/contrib/iostream2/zstream_test.cpp.

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

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "zstream.h"
#include <math.h>
#include <stdlib.h>
#include <iomanip.h>

void main() {
    char h[256] = "Hello";
    char* g = "Goodbye";
    ozstream out("temp.gz");
    out < "This works well" < h < g;
    out.close();

    izstream in("temp.gz"); // read it back
    char *x = read_string(in), *y = new char[256], z[256];
    in > y > z;
    in.close();
    cout << x << endl << y << endl << z << endl;

    out.open("temp.gz"); // try ascii output; zcat temp.gz to see the results
    out << setw(50) << setfill('#') << setprecision(20) << x << endl << y << endl << z << endl;
    out << z << endl << y << endl << x << endl;
    out << 1.1234567890123456789 << endl;

    delete[] x; delete[] y;
}

Deleted compat/zlib/contrib/iostream3/README.

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



































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
These classes provide a C++ stream interface to the zlib library. It allows you
to do things like:

  gzofstream outf("blah.gz");
  outf << "These go into the gzip file " << 123 << endl;

It does this by deriving a specialized stream buffer for gzipped files, which is
the way Stroustrup would have done it. :->

The gzifstream and gzofstream classes were originally written by Kevin Ruland
and made available in the zlib contrib/iostream directory. The older version still
compiles under gcc 2.xx, but not under gcc 3.xx, which sparked the development of
this version.

The new classes are as standard-compliant as possible, closely following the
approach of the standard library's fstream classes. It compiles under gcc versions
3.2 and 3.3, but not under gcc 2.xx. This is mainly due to changes in the standard
library naming scheme. The new version of gzifstream/gzofstream/gzfilebuf differs
from the previous one in the following respects:
- added showmanyc
- added setbuf, with support for unbuffered output via setbuf(0,0)
- a few bug fixes of stream behavior
- gzipped output file opened with default compression level instead of maximum level
- setcompressionlevel()/strategy() members replaced by single setcompression()

The code is provided "as is", with the permission to use, copy, modify, distribute
and sell it for any purpose without fee.

Ludwig Schwardt
<schwardt@sun.ac.za>

DSP Lab
Electrical & Electronic Engineering Department
University of Stellenbosch
South Africa

Deleted compat/zlib/contrib/iostream3/TODO.

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

















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Possible upgrades to gzfilebuf:

- The ability to do putback (e.g. putbackfail)

- The ability to seek (zlib supports this, but could be slow/tricky)

- Simultaneous read/write access (does it make sense?)

- Support for ios_base::ate open mode

- Locale support?

- Check public interface to see which calls give problems
  (due to dependence on library internals)

- Override operator<<(ostream&, gzfilebuf*) to allow direct copying
  of stream buffer to stream ( i.e. os << is.rdbuf(); )

Deleted compat/zlib/contrib/iostream3/test.cc.

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


















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * Test program for gzifstream and gzofstream
 *
 * by Ludwig Schwardt <schwardt@sun.ac.za>
 * original version by Kevin Ruland <kevin@rodin.wustl.edu>
 */

#include "zfstream.h"
#include <iostream>      // for cout

int main() {

  gzofstream outf;
  gzifstream inf;
  char buf[80];

  outf.open("test1.txt.gz");
  outf << "The quick brown fox sidestepped the lazy canine\n"
       << 1.3 << "\nPlan " << 9 << std::endl;
  outf.close();
  std::cout << "Wrote the following message to 'test1.txt.gz' (check with zcat or zless):\n"
            << "The quick brown fox sidestepped the lazy canine\n"
            << 1.3 << "\nPlan " << 9 << std::endl;

  std::cout << "\nReading 'test1.txt.gz' (buffered) produces:\n";
  inf.open("test1.txt.gz");
  while (inf.getline(buf,80,'\n')) {
    std::cout << buf << "\t(" << inf.rdbuf()->in_avail() << " chars left in buffer)\n";
  }
  inf.close();

  outf.rdbuf()->pubsetbuf(0,0);
  outf.open("test2.txt.gz");
  outf << setcompression(Z_NO_COMPRESSION)
       << "The quick brown fox sidestepped the lazy canine\n"
       << 1.3 << "\nPlan " << 9 << std::endl;
  outf.close();
  std::cout << "\nWrote the same message to 'test2.txt.gz' in uncompressed form";

  std::cout << "\nReading 'test2.txt.gz' (unbuffered) produces:\n";
  inf.rdbuf()->pubsetbuf(0,0);
  inf.open("test2.txt.gz");
  while (inf.getline(buf,80,'\n')) {
    std::cout << buf << "\t(" << inf.rdbuf()->in_avail() << " chars left in buffer)\n";
  }
  inf.close();

  return 0;

}

Deleted compat/zlib/contrib/iostream3/zfstream.cc.

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
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
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































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * A C++ I/O streams interface to the zlib gz* functions
 *
 * by Ludwig Schwardt <schwardt@sun.ac.za>
 * original version by Kevin Ruland <kevin@rodin.wustl.edu>
 *
 * This version is standard-compliant and compatible with gcc 3.x.
 */

#include "zfstream.h"
#include <cstring>          // for strcpy, strcat, strlen (mode strings)
#include <cstdio>           // for BUFSIZ

// Internal buffer sizes (default and "unbuffered" versions)
#define BIGBUFSIZE BUFSIZ
#define SMALLBUFSIZE 1

/*****************************************************************************/

// Default constructor
gzfilebuf::gzfilebuf()
: file(NULL), io_mode(std::ios_base::openmode(0)), own_fd(false),
  buffer(NULL), buffer_size(BIGBUFSIZE), own_buffer(true)
{
  // No buffers to start with
  this->disable_buffer();
}

// Destructor
gzfilebuf::~gzfilebuf()
{
  // Sync output buffer and close only if responsible for file
  // (i.e. attached streams should be left open at this stage)
  this->sync();
  if (own_fd)
    this->close();
  // Make sure internal buffer is deallocated
  this->disable_buffer();
}

// Set compression level and strategy
int
gzfilebuf::setcompression(int comp_level,
                          int comp_strategy)
{
  return gzsetparams(file, comp_level, comp_strategy);
}

// Open gzipped file
gzfilebuf*
gzfilebuf::open(const char *name,
                std::ios_base::openmode mode)
{
  // Fail if file already open
  if (this->is_open())
    return NULL;
  // Don't support simultaneous read/write access (yet)
  if ((mode & std::ios_base::in) && (mode & std::ios_base::out))
    return NULL;

  // Build mode string for gzopen and check it [27.8.1.3.2]
  char char_mode[6] = "\0\0\0\0\0";
  if (!this->open_mode(mode, char_mode))
    return NULL;

  // Attempt to open file
  if ((file = gzopen(name, char_mode)) == NULL)
    return NULL;

  // On success, allocate internal buffer and set flags
  this->enable_buffer();
  io_mode = mode;
  own_fd = true;
  return this;
}

// Attach to gzipped file
gzfilebuf*
gzfilebuf::attach(int fd,
                  std::ios_base::openmode mode)
{
  // Fail if file already open
  if (this->is_open())
    return NULL;
  // Don't support simultaneous read/write access (yet)
  if ((mode & std::ios_base::in) && (mode & std::ios_base::out))
    return NULL;

  // Build mode string for gzdopen and check it [27.8.1.3.2]
  char char_mode[6] = "\0\0\0\0\0";
  if (!this->open_mode(mode, char_mode))
    return NULL;

  // Attempt to attach to file
  if ((file = gzdopen(fd, char_mode)) == NULL)
    return NULL;

  // On success, allocate internal buffer and set flags
  this->enable_buffer();
  io_mode = mode;
  own_fd = false;
  return this;
}

// Close gzipped file
gzfilebuf*
gzfilebuf::close()
{
  // Fail immediately if no file is open
  if (!this->is_open())
    return NULL;
  // Assume success
  gzfilebuf* retval = this;
  // Attempt to sync and close gzipped file
  if (this->sync() == -1)
    retval = NULL;
  if (gzclose(file) < 0)
    retval = NULL;
  // File is now gone anyway (postcondition [27.8.1.3.8])
  file = NULL;
  own_fd = false;
  // Destroy internal buffer if it exists
  this->disable_buffer();
  return retval;
}

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

// Convert int open mode to mode string
bool
gzfilebuf::open_mode(std::ios_base::openmode mode,
                     char* c_mode) const
{
  bool testb = mode & std::ios_base::binary;
  bool testi = mode & std::ios_base::in;
  bool testo = mode & std::ios_base::out;
  bool testt = mode & std::ios_base::trunc;
  bool testa = mode & std::ios_base::app;

  // Check for valid flag combinations - see [27.8.1.3.2] (Table 92)
  // Original zfstream hardcoded the compression level to maximum here...
  // Double the time for less than 1% size improvement seems
  // excessive though - keeping it at the default level
  // To change back, just append "9" to the next three mode strings
  if (!testi && testo && !testt && !testa)
    strcpy(c_mode, "w");
  if (!testi && testo && !testt && testa)
    strcpy(c_mode, "a");
  if (!testi && testo && testt && !testa)
    strcpy(c_mode, "w");
  if (testi && !testo && !testt && !testa)
    strcpy(c_mode, "r");
  // No read/write mode yet
//  if (testi && testo && !testt && !testa)
//    strcpy(c_mode, "r+");
//  if (testi && testo && testt && !testa)
//    strcpy(c_mode, "w+");

  // Mode string should be empty for invalid combination of flags
  if (strlen(c_mode) == 0)
    return false;
  if (testb)
    strcat(c_mode, "b");
  return true;
}

// Determine number of characters in internal get buffer
std::streamsize
gzfilebuf::showmanyc()
{
  // Calls to underflow will fail if file not opened for reading
  if (!this->is_open() || !(io_mode & std::ios_base::in))
    return -1;
  // Make sure get area is in use
  if (this->gptr() && (this->gptr() < this->egptr()))
    return std::streamsize(this->egptr() - this->gptr());
  else
    return 0;
}

// Fill get area from gzipped file
gzfilebuf::int_type
gzfilebuf::underflow()
{
  // If something is left in the get area by chance, return it
  // (this shouldn't normally happen, as underflow is only supposed
  // to be called when gptr >= egptr, but it serves as error check)
  if (this->gptr() && (this->gptr() < this->egptr()))
    return traits_type::to_int_type(*(this->gptr()));

  // If the file hasn't been opened for reading, produce error
  if (!this->is_open() || !(io_mode & std::ios_base::in))
    return traits_type::eof();

  // Attempt to fill internal buffer from gzipped file
  // (buffer must be guaranteed to exist...)
  int bytes_read = gzread(file, buffer, buffer_size);
  // Indicates error or EOF
  if (bytes_read <= 0)
  {
    // Reset get area
    this->setg(buffer, buffer, buffer);
    return traits_type::eof();
  }
  // Make all bytes read from file available as get area
  this->setg(buffer, buffer, buffer + bytes_read);

  // Return next character in get area
  return traits_type::to_int_type(*(this->gptr()));
}

// Write put area to gzipped file
gzfilebuf::int_type
gzfilebuf::overflow(int_type c)
{
  // Determine whether put area is in use
  if (this->pbase())
  {
    // Double-check pointer range
    if (this->pptr() > this->epptr() || this->pptr() < this->pbase())
      return traits_type::eof();
    // Add extra character to buffer if not EOF
    if (!traits_type::eq_int_type(c, traits_type::eof()))
    {
      *(this->pptr()) = traits_type::to_char_type(c);
      this->pbump(1);
    }
    // Number of characters to write to file
    int bytes_to_write = this->pptr() - this->pbase();
    // Overflow doesn't fail if nothing is to be written
    if (bytes_to_write > 0)
    {
      // If the file hasn't been opened for writing, produce error
      if (!this->is_open() || !(io_mode & std::ios_base::out))
        return traits_type::eof();
      // If gzipped file won't accept all bytes written to it, fail
      if (gzwrite(file, this->pbase(), bytes_to_write) != bytes_to_write)
        return traits_type::eof();
      // Reset next pointer to point to pbase on success
      this->pbump(-bytes_to_write);
    }
  }
  // Write extra character to file if not EOF
  else if (!traits_type::eq_int_type(c, traits_type::eof()))
  {
    // If the file hasn't been opened for writing, produce error
    if (!this->is_open() || !(io_mode & std::ios_base::out))
      return traits_type::eof();
    // Impromptu char buffer (allows "unbuffered" output)
    char_type last_char = traits_type::to_char_type(c);
    // If gzipped file won't accept this character, fail
    if (gzwrite(file, &last_char, 1) != 1)
      return traits_type::eof();
  }

  // If you got here, you have succeeded (even if c was EOF)
  // The return value should therefore be non-EOF
  if (traits_type::eq_int_type(c, traits_type::eof()))
    return traits_type::not_eof(c);
  else
    return c;
}

// Assign new buffer
std::streambuf*
gzfilebuf::setbuf(char_type* p,
                  std::streamsize n)
{
  // First make sure stuff is sync'ed, for safety
  if (this->sync() == -1)
    return NULL;
  // If buffering is turned off on purpose via setbuf(0,0), still allocate one...
  // "Unbuffered" only really refers to put [27.8.1.4.10], while get needs at
  // least a buffer of size 1 (very inefficient though, therefore make it bigger?)
  // This follows from [27.5.2.4.3]/12 (gptr needs to point at something, it seems)
  if (!p || !n)
  {
    // Replace existing buffer (if any) with small internal buffer
    this->disable_buffer();
    buffer = NULL;
    buffer_size = 0;
    own_buffer = true;
    this->enable_buffer();
  }
  else
  {
    // Replace existing buffer (if any) with external buffer
    this->disable_buffer();
    buffer = p;
    buffer_size = n;
    own_buffer = false;
    this->enable_buffer();
  }
  return this;
}

// Write put area to gzipped file (i.e. ensures that put area is empty)
int
gzfilebuf::sync()
{
  return traits_type::eq_int_type(this->overflow(), traits_type::eof()) ? -1 : 0;
}

/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */

// Allocate internal buffer
void
gzfilebuf::enable_buffer()
{
  // If internal buffer required, allocate one
  if (own_buffer && !buffer)
  {
    // Check for buffered vs. "unbuffered"
    if (buffer_size > 0)
    {
      // Allocate internal buffer
      buffer = new char_type[buffer_size];
      // Get area starts empty and will be expanded by underflow as need arises
      this->setg(buffer, buffer, buffer);
      // Setup entire internal buffer as put area.
      // The one-past-end pointer actually points to the last element of the buffer,
      // so that overflow(c) can safely add the extra character c to the sequence.
      // These pointers remain in place for the duration of the buffer
      this->setp(buffer, buffer + buffer_size - 1);
    }
    else
    {
      // Even in "unbuffered" case, (small?) get buffer is still required
      buffer_size = SMALLBUFSIZE;
      buffer = new char_type[buffer_size];
      this->setg(buffer, buffer, buffer);
      // "Unbuffered" means no put buffer
      this->setp(0, 0);
    }
  }
  else
  {
    // If buffer already allocated, reset buffer pointers just to make sure no
    // stale chars are lying around
    this->setg(buffer, buffer, buffer);
    this->setp(buffer, buffer + buffer_size - 1);
  }
}

// Destroy internal buffer
void
gzfilebuf::disable_buffer()
{
  // If internal buffer exists, deallocate it
  if (own_buffer && buffer)
  {
    // Preserve unbuffered status by zeroing size
    if (!this->pbase())
      buffer_size = 0;
    delete[] buffer;
    buffer = NULL;
    this->setg(0, 0, 0);
    this->setp(0, 0);
  }
  else
  {
    // Reset buffer pointers to initial state if external buffer exists
    this->setg(buffer, buffer, buffer);
    if (buffer)
      this->setp(buffer, buffer + buffer_size - 1);
    else
      this->setp(0, 0);
  }
}

/*****************************************************************************/

// Default constructor initializes stream buffer
gzifstream::gzifstream()
: std::istream(NULL), sb()
{ this->init(&sb); }

// Initialize stream buffer and open file
gzifstream::gzifstream(const char* name,
                       std::ios_base::openmode mode)
: std::istream(NULL), sb()
{
  this->init(&sb);
  this->open(name, mode);
}

// Initialize stream buffer and attach to file
gzifstream::gzifstream(int fd,
                       std::ios_base::openmode mode)
: std::istream(NULL), sb()
{
  this->init(&sb);
  this->attach(fd, mode);
}

// Open file and go into fail() state if unsuccessful
void
gzifstream::open(const char* name,
                 std::ios_base::openmode mode)
{
  if (!sb.open(name, mode | std::ios_base::in))
    this->setstate(std::ios_base::failbit);
  else
    this->clear();
}

// Attach to file and go into fail() state if unsuccessful
void
gzifstream::attach(int fd,
                   std::ios_base::openmode mode)
{
  if (!sb.attach(fd, mode | std::ios_base::in))
    this->setstate(std::ios_base::failbit);
  else
    this->clear();
}

// Close file
void
gzifstream::close()
{
  if (!sb.close())
    this->setstate(std::ios_base::failbit);
}

/*****************************************************************************/

// Default constructor initializes stream buffer
gzofstream::gzofstream()
: std::ostream(NULL), sb()
{ this->init(&sb); }

// Initialize stream buffer and open file
gzofstream::gzofstream(const char* name,
                       std::ios_base::openmode mode)
: std::ostream(NULL), sb()
{
  this->init(&sb);
  this->open(name, mode);
}

// Initialize stream buffer and attach to file
gzofstream::gzofstream(int fd,
                       std::ios_base::openmode mode)
: std::ostream(NULL), sb()
{
  this->init(&sb);
  this->attach(fd, mode);
}

// Open file and go into fail() state if unsuccessful
void
gzofstream::open(const char* name,
                 std::ios_base::openmode mode)
{
  if (!sb.open(name, mode | std::ios_base::out))
    this->setstate(std::ios_base::failbit);
  else
    this->clear();
}

// Attach to file and go into fail() state if unsuccessful
void
gzofstream::attach(int fd,
                   std::ios_base::openmode mode)
{
  if (!sb.attach(fd, mode | std::ios_base::out))
    this->setstate(std::ios_base::failbit);
  else
    this->clear();
}

// Close file
void
gzofstream::close()
{
  if (!sb.close())
    this->setstate(std::ios_base::failbit);
}

Deleted compat/zlib/contrib/iostream3/zfstream.h.

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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466


















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * A C++ I/O streams interface to the zlib gz* functions
 *
 * by Ludwig Schwardt <schwardt@sun.ac.za>
 * original version by Kevin Ruland <kevin@rodin.wustl.edu>
 *
 * This version is standard-compliant and compatible with gcc 3.x.
 */

#ifndef ZFSTREAM_H
#define ZFSTREAM_H

#include <istream>  // not iostream, since we don't need cin/cout
#include <ostream>
#include "zlib.h"

/*****************************************************************************/

/**
 *  @brief  Gzipped file stream buffer class.
 *
 *  This class implements basic_filebuf for gzipped files. It doesn't yet support
 *  seeking (allowed by zlib but slow/limited), putback and read/write access
 *  (tricky). Otherwise, it attempts to be a drop-in replacement for the standard
 *  file streambuf.
*/
class gzfilebuf : public std::streambuf
{
public:
  //  Default constructor.
  gzfilebuf();

  //  Destructor.
  virtual
  ~gzfilebuf();

  /**
   *  @brief  Set compression level and strategy on the fly.
   *  @param  comp_level  Compression level (see zlib.h for allowed values)
   *  @param  comp_strategy  Compression strategy (see zlib.h for allowed values)
   *  @return  Z_OK on success, Z_STREAM_ERROR otherwise.
   *
   *  Unfortunately, these parameters cannot be modified separately, as the
   *  previous zfstream version assumed. Since the strategy is seldom changed,
   *  it can default and setcompression(level) then becomes like the old
   *  setcompressionlevel(level).
  */
  int
  setcompression(int comp_level,
                 int comp_strategy = Z_DEFAULT_STRATEGY);

  /**
   *  @brief  Check if file is open.
   *  @return  True if file is open.
  */
  bool
  is_open() const { return (file != NULL); }

  /**
   *  @brief  Open gzipped file.
   *  @param  name  File name.
   *  @param  mode  Open mode flags.
   *  @return  @c this on success, NULL on failure.
  */
  gzfilebuf*
  open(const char* name,
       std::ios_base::openmode mode);

  /**
   *  @brief  Attach to already open gzipped file.
   *  @param  fd  File descriptor.
   *  @param  mode  Open mode flags.
   *  @return  @c this on success, NULL on failure.
  */
  gzfilebuf*
  attach(int fd,
         std::ios_base::openmode mode);

  /**
   *  @brief  Close gzipped file.
   *  @return  @c this on success, NULL on failure.
  */
  gzfilebuf*
  close();

protected:
  /**
   *  @brief  Convert ios open mode int to mode string used by zlib.
   *  @return  True if valid mode flag combination.
  */
  bool
  open_mode(std::ios_base::openmode mode,
            char* c_mode) const;

  /**
   *  @brief  Number of characters available in stream buffer.
   *  @return  Number of characters.
   *
   *  This indicates number of characters in get area of stream buffer.
   *  These characters can be read without accessing the gzipped file.
  */
  virtual std::streamsize
  showmanyc();

  /**
   *  @brief  Fill get area from gzipped file.
   *  @return  First character in get area on success, EOF on error.
   *
   *  This actually reads characters from gzipped file to stream
   *  buffer. Always buffered.
  */
  virtual int_type
  underflow();

  /**
   *  @brief  Write put area to gzipped file.
   *  @param  c  Extra character to add to buffer contents.
   *  @return  Non-EOF on success, EOF on error.
   *
   *  This actually writes characters in stream buffer to
   *  gzipped file. With unbuffered output this is done one
   *  character at a time.
  */
  virtual int_type
  overflow(int_type c = traits_type::eof());

  /**
   *  @brief  Installs external stream buffer.
   *  @param  p  Pointer to char buffer.
   *  @param  n  Size of external buffer.
   *  @return  @c this on success, NULL on failure.
   *
   *  Call setbuf(0,0) to enable unbuffered output.
  */
  virtual std::streambuf*
  setbuf(char_type* p,
         std::streamsize n);

  /**
   *  @brief  Flush stream buffer to file.
   *  @return  0 on success, -1 on error.
   *
   *  This calls underflow(EOF) to do the job.
  */
  virtual int
  sync();

//
// Some future enhancements
//
//  virtual int_type uflow();
//  virtual int_type pbackfail(int_type c = traits_type::eof());
//  virtual pos_type
//  seekoff(off_type off,
//          std::ios_base::seekdir way,
//          std::ios_base::openmode mode = std::ios_base::in|std::ios_base::out);
//  virtual pos_type
//  seekpos(pos_type sp,
//          std::ios_base::openmode mode = std::ios_base::in|std::ios_base::out);

private:
  /**
   *  @brief  Allocate internal buffer.
   *
   *  This function is safe to call multiple times. It will ensure
   *  that a proper internal buffer exists if it is required. If the
   *  buffer already exists or is external, the buffer pointers will be
   *  reset to their original state.
  */
  void
  enable_buffer();

  /**
   *  @brief  Destroy internal buffer.
   *
   *  This function is safe to call multiple times. It will ensure
   *  that the internal buffer is deallocated if it exists. In any
   *  case, it will also reset the buffer pointers.
  */
  void
  disable_buffer();

  /**
   *  Underlying file pointer.
  */
  gzFile file;

  /**
   *  Mode in which file was opened.
  */
  std::ios_base::openmode io_mode;

  /**
   *  @brief  True if this object owns file descriptor.
   *
   *  This makes the class responsible for closing the file
   *  upon destruction.
  */
  bool own_fd;

  /**
   *  @brief  Stream buffer.
   *
   *  For simplicity this remains allocated on the free store for the
   *  entire life span of the gzfilebuf object, unless replaced by setbuf.
  */
  char_type* buffer;

  /**
   *  @brief  Stream buffer size.
   *
   *  Defaults to system default buffer size (typically 8192 bytes).
   *  Modified by setbuf.
  */
  std::streamsize buffer_size;

  /**
   *  @brief  True if this object owns stream buffer.
   *
   *  This makes the class responsible for deleting the buffer
   *  upon destruction.
  */
  bool own_buffer;
};

/*****************************************************************************/

/**
 *  @brief  Gzipped file input stream class.
 *
 *  This class implements ifstream for gzipped files. Seeking and putback
 *  is not supported yet.
*/
class gzifstream : public std::istream
{
public:
  //  Default constructor
  gzifstream();

  /**
   *  @brief  Construct stream on gzipped file to be opened.
   *  @param  name  File name.
   *  @param  mode  Open mode flags (forced to contain ios::in).
  */
  explicit
  gzifstream(const char* name,
             std::ios_base::openmode mode = std::ios_base::in);

  /**
   *  @brief  Construct stream on already open gzipped file.
   *  @param  fd    File descriptor.
   *  @param  mode  Open mode flags (forced to contain ios::in).
  */
  explicit
  gzifstream(int fd,
             std::ios_base::openmode mode = std::ios_base::in);

  /**
   *  Obtain underlying stream buffer.
  */
  gzfilebuf*
  rdbuf() const
  { return const_cast<gzfilebuf*>(&sb); }

  /**
   *  @brief  Check if file is open.
   *  @return  True if file is open.
  */
  bool
  is_open() { return sb.is_open(); }

  /**
   *  @brief  Open gzipped file.
   *  @param  name  File name.
   *  @param  mode  Open mode flags (forced to contain ios::in).
   *
   *  Stream will be in state good() if file opens successfully;
   *  otherwise in state fail(). This differs from the behavior of
   *  ifstream, which never sets the state to good() and therefore
   *  won't allow you to reuse the stream for a second file unless
   *  you manually clear() the state. The choice is a matter of
   *  convenience.
  */
  void
  open(const char* name,
       std::ios_base::openmode mode = std::ios_base::in);

  /**
   *  @brief  Attach to already open gzipped file.
   *  @param  fd  File descriptor.
   *  @param  mode  Open mode flags (forced to contain ios::in).
   *
   *  Stream will be in state good() if attach succeeded; otherwise
   *  in state fail().
  */
  void
  attach(int fd,
         std::ios_base::openmode mode = std::ios_base::in);

  /**
   *  @brief  Close gzipped file.
   *
   *  Stream will be in state fail() if close failed.
  */
  void
  close();

private:
  /**
   *  Underlying stream buffer.
  */
  gzfilebuf sb;
};

/*****************************************************************************/

/**
 *  @brief  Gzipped file output stream class.
 *
 *  This class implements ofstream for gzipped files. Seeking and putback
 *  is not supported yet.
*/
class gzofstream : public std::ostream
{
public:
  //  Default constructor
  gzofstream();

  /**
   *  @brief  Construct stream on gzipped file to be opened.
   *  @param  name  File name.
   *  @param  mode  Open mode flags (forced to contain ios::out).
  */
  explicit
  gzofstream(const char* name,
             std::ios_base::openmode mode = std::ios_base::out);

  /**
   *  @brief  Construct stream on already open gzipped file.
   *  @param  fd    File descriptor.
   *  @param  mode  Open mode flags (forced to contain ios::out).
  */
  explicit
  gzofstream(int fd,
             std::ios_base::openmode mode = std::ios_base::out);

  /**
   *  Obtain underlying stream buffer.
  */
  gzfilebuf*
  rdbuf() const
  { return const_cast<gzfilebuf*>(&sb); }

  /**
   *  @brief  Check if file is open.
   *  @return  True if file is open.
  */
  bool
  is_open() { return sb.is_open(); }

  /**
   *  @brief  Open gzipped file.
   *  @param  name  File name.
   *  @param  mode  Open mode flags (forced to contain ios::out).
   *
   *  Stream will be in state good() if file opens successfully;
   *  otherwise in state fail(). This differs from the behavior of
   *  ofstream, which never sets the state to good() and therefore
   *  won't allow you to reuse the stream for a second file unless
   *  you manually clear() the state. The choice is a matter of
   *  convenience.
  */
  void
  open(const char* name,
       std::ios_base::openmode mode = std::ios_base::out);

  /**
   *  @brief  Attach to already open gzipped file.
   *  @param  fd  File descriptor.
   *  @param  mode  Open mode flags (forced to contain ios::out).
   *
   *  Stream will be in state good() if attach succeeded; otherwise
   *  in state fail().
  */
  void
  attach(int fd,
         std::ios_base::openmode mode = std::ios_base::out);

  /**
   *  @brief  Close gzipped file.
   *
   *  Stream will be in state fail() if close failed.
  */
  void
  close();

private:
  /**
   *  Underlying stream buffer.
  */
  gzfilebuf sb;
};

/*****************************************************************************/

/**
 *  @brief  Gzipped file output stream manipulator class.
 *
 *  This class defines a two-argument manipulator for gzofstream. It is used
 *  as base for the setcompression(int,int) manipulator.
*/
template<typename T1, typename T2>
  class gzomanip2
  {
  public:
    // Allows insertor to peek at internals
    template <typename Ta, typename Tb>
      friend gzofstream&
      operator<<(gzofstream&,
                 const gzomanip2<Ta,Tb>&);

    // Constructor
    gzomanip2(gzofstream& (*f)(gzofstream&, T1, T2),
              T1 v1,
              T2 v2);
  private:
    // Underlying manipulator function
    gzofstream&
    (*func)(gzofstream&, T1, T2);

    // Arguments for manipulator function
    T1 val1;
    T2 val2;
  };

/*****************************************************************************/

// Manipulator function thunks through to stream buffer
inline gzofstream&
setcompression(gzofstream &gzs, int l, int s = Z_DEFAULT_STRATEGY)
{
  (gzs.rdbuf())->setcompression(l, s);
  return gzs;
}

// Manipulator constructor stores arguments
template<typename T1, typename T2>
  inline
  gzomanip2<T1,T2>::gzomanip2(gzofstream &(*f)(gzofstream &, T1, T2),
                              T1 v1,
                              T2 v2)
  : func(f), val1(v1), val2(v2)
  { }

// Insertor applies underlying manipulator function to stream
template<typename T1, typename T2>
  inline gzofstream&
  operator<<(gzofstream& s, const gzomanip2<T1,T2>& m)
  { return (*m.func)(s, m.val1, m.val2); }

// Insert this onto stream to simplify setting of compression level
inline gzomanip2<int,int>
setcompression(int l, int s = Z_DEFAULT_STRATEGY)
{ return gzomanip2<int,int>(&setcompression, l, s); }

#endif // ZFSTREAM_H

Deleted compat/zlib/contrib/masmx64/bld_ml64.bat.

1
2


-
-
ml64.exe /Flinffasx64 /c /Zi inffasx64.asm
ml64.exe /Flgvmat64   /c /Zi gvmat64.asm

Deleted compat/zlib/contrib/masmx64/gvmat64.asm.

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
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
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
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









































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
;uInt longest_match_x64(
;    deflate_state *s,
;    IPos cur_match);                             /* current match */

; gvmat64.asm -- Asm portion of the optimized longest_match for 32 bits x86_64
;  (AMD64 on Athlon 64, Opteron, Phenom
;     and Intel EM64T on Pentium 4 with EM64T, Pentium D, Core 2 Duo, Core I5/I7)
; Copyright (C) 1995-2010 Jean-loup Gailly, Brian Raiter and Gilles Vollant.
;
; File written by Gilles Vollant, by converting to assembly the longest_match
;  from Jean-loup Gailly in deflate.c of zLib and infoZip zip.
;
;  and by taking inspiration on asm686 with masm, optimised assembly code
;        from Brian Raiter, written 1998
;
;  This software is provided 'as-is', without any express or implied
;  warranty.  In no event will the authors be held liable for any damages
;  arising from the use of this software.
;
;  Permission is granted to anyone to use this software for any purpose,
;  including commercial applications, and to alter it and redistribute it
;  freely, subject to the following restrictions:
;
;  1. The origin of this software must not be misrepresented; you must not
;     claim that you wrote the original software. If you use this software
;     in a product, an acknowledgment in the product documentation would be
;     appreciated but is not required.
;  2. Altered source versions must be plainly marked as such, and must not be
;     misrepresented as being the original software
;  3. This notice may not be removed or altered from any source distribution.
;
;
;
;         http://www.zlib.net
;         http://www.winimage.com/zLibDll
;         http://www.muppetlabs.com/~breadbox/software/assembly.html
;
; to compile this file for infozip Zip, I use option:
;   ml64.exe /Flgvmat64 /c /Zi /DINFOZIP gvmat64.asm
;
; to compile this file for zLib, I use option:
;   ml64.exe /Flgvmat64 /c /Zi gvmat64.asm
; Be carrefull to adapt zlib1222add below to your version of zLib
;   (if you use a version of zLib before 1.0.4 or after 1.2.2.2, change
;    value of zlib1222add later)
;
; This file compile with Microsoft Macro Assembler (x64) for AMD64
;
;   ml64.exe is given with Visual Studio 2005/2008/2010 and Windows WDK
;
;   (you can get Windows WDK with ml64 for AMD64 from
;      http://www.microsoft.com/whdc/Devtools/wdk/default.mspx for low price)
;


;uInt longest_match(s, cur_match)
;    deflate_state *s;
;    IPos cur_match;                             /* current match */
.code
longest_match PROC


;LocalVarsSize   equ 88
 LocalVarsSize   equ 72

; register used : rax,rbx,rcx,rdx,rsi,rdi,r8,r9,r10,r11,r12
; free register :  r14,r15
; register can be saved : rsp

 chainlenwmask   equ  rsp + 8 - LocalVarsSize    ; high word: current chain len
                                                 ; low word: s->wmask
;window          equ  rsp + xx - LocalVarsSize   ; local copy of s->window ; stored in r10
;windowbestlen   equ  rsp + xx - LocalVarsSize   ; s->window + bestlen , use r10+r11
;scanstart       equ  rsp + xx - LocalVarsSize   ; first two bytes of string ; stored in r12w
;scanend         equ  rsp + xx - LocalVarsSize   ; last two bytes of string use ebx
;scanalign       equ  rsp + xx - LocalVarsSize   ; dword-misalignment of string r13
;bestlen         equ  rsp + xx - LocalVarsSize   ; size of best match so far -> r11d
;scan            equ  rsp + xx - LocalVarsSize   ; ptr to string wanting match -> r9
IFDEF INFOZIP
ELSE
 nicematch       equ  (rsp + 16 - LocalVarsSize) ; a good enough match size
ENDIF

save_rdi        equ  rsp + 24 - LocalVarsSize
save_rsi        equ  rsp + 32 - LocalVarsSize
save_rbx        equ  rsp + 40 - LocalVarsSize
save_rbp        equ  rsp + 48 - LocalVarsSize
save_r12        equ  rsp + 56 - LocalVarsSize
save_r13        equ  rsp + 64 - LocalVarsSize
;save_r14        equ  rsp + 72 - LocalVarsSize
;save_r15        equ  rsp + 80 - LocalVarsSize


; summary of register usage
; scanend     ebx
; scanendw    bx
; chainlenwmask   edx
; curmatch    rsi
; curmatchd   esi
; windowbestlen   r8
; scanalign   r9
; scanalignd  r9d
; window      r10
; bestlen     r11
; bestlend    r11d
; scanstart   r12d
; scanstartw  r12w
; scan        r13
; nicematch   r14d
; limit       r15
; limitd      r15d
; prev        rcx

;  all the +4 offsets are due to the addition of pending_buf_size (in zlib
;  in the deflate_state structure since the asm code was first written
;  (if you compile with zlib 1.0.4 or older, remove the +4).
;  Note : these value are good with a 8 bytes boundary pack structure


    MAX_MATCH           equ     258
    MIN_MATCH           equ     3
    MIN_LOOKAHEAD       equ     (MAX_MATCH+MIN_MATCH+1)


;;; Offsets for fields in the deflate_state structure. These numbers
;;; are calculated from the definition of deflate_state, with the
;;; assumption that the compiler will dword-align the fields. (Thus,
;;; changing the definition of deflate_state could easily cause this
;;; program to crash horribly, without so much as a warning at
;;; compile time. Sigh.)

;  all the +zlib1222add offsets are due to the addition of fields
;  in zlib in the deflate_state structure since the asm code was first written
;  (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)").
;  (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0").
;  if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8").


IFDEF INFOZIP

_DATA   SEGMENT
COMM    window_size:DWORD
; WMask ; 7fff
COMM    window:BYTE:010040H
COMM    prev:WORD:08000H
; MatchLen : unused
; PrevMatch : unused
COMM    strstart:DWORD
COMM    match_start:DWORD
; Lookahead : ignore
COMM    prev_length:DWORD ; PrevLen
COMM    max_chain_length:DWORD
COMM    good_match:DWORD
COMM    nice_match:DWORD
prev_ad equ OFFSET prev
window_ad equ OFFSET window
nicematch equ nice_match
_DATA ENDS
WMask equ 07fffh

ELSE

  IFNDEF zlib1222add
    zlib1222add equ 8
  ENDIF
dsWSize         equ 56+zlib1222add+(zlib1222add/2)
dsWMask         equ 64+zlib1222add+(zlib1222add/2)
dsWindow        equ 72+zlib1222add
dsPrev          equ 88+zlib1222add
dsMatchLen      equ 128+zlib1222add
dsPrevMatch     equ 132+zlib1222add
dsStrStart      equ 140+zlib1222add
dsMatchStart    equ 144+zlib1222add
dsLookahead     equ 148+zlib1222add
dsPrevLen       equ 152+zlib1222add
dsMaxChainLen   equ 156+zlib1222add
dsGoodMatch     equ 172+zlib1222add
dsNiceMatch     equ 176+zlib1222add

window_size     equ [ rcx + dsWSize]
WMask           equ [ rcx + dsWMask]
window_ad       equ [ rcx + dsWindow]
prev_ad         equ [ rcx + dsPrev]
strstart        equ [ rcx + dsStrStart]
match_start     equ [ rcx + dsMatchStart]
Lookahead       equ [ rcx + dsLookahead] ; 0ffffffffh on infozip
prev_length     equ [ rcx + dsPrevLen]
max_chain_length equ [ rcx + dsMaxChainLen]
good_match      equ [ rcx + dsGoodMatch]
nice_match      equ [ rcx + dsNiceMatch]
ENDIF

; parameter 1 in r8(deflate state s), param 2 in rdx (cur match)

; see http://weblogs.asp.net/oldnewthing/archive/2004/01/14/58579.aspx and
; http://msdn.microsoft.com/library/en-us/kmarch/hh/kmarch/64bitAMD_8e951dd2-ee77-4728-8702-55ce4b5dd24a.xml.asp
;
; All registers must be preserved across the call, except for
;   rax, rcx, rdx, r8, r9, r10, and r11, which are scratch.



;;; Save registers that the compiler may be using, and adjust esp to
;;; make room for our stack frame.


;;; Retrieve the function arguments. r8d will hold cur_match
;;; throughout the entire function. edx will hold the pointer to the
;;; deflate_state structure during the function's setup (before
;;; entering the main loop.

; parameter 1 in rcx (deflate_state* s), param 2 in edx -> r8 (cur match)

; this clear high 32 bits of r8, which can be garbage in both r8 and rdx

        mov [save_rdi],rdi
        mov [save_rsi],rsi
        mov [save_rbx],rbx
        mov [save_rbp],rbp
IFDEF INFOZIP
        mov r8d,ecx
ELSE
        mov r8d,edx
ENDIF
        mov [save_r12],r12
        mov [save_r13],r13
;        mov [save_r14],r14
;        mov [save_r15],r15


;;; uInt wmask = s->w_mask;
;;; unsigned chain_length = s->max_chain_length;
;;; if (s->prev_length >= s->good_match) {
;;;     chain_length >>= 2;
;;; }

        mov edi, prev_length
        mov esi, good_match
        mov eax, WMask
        mov ebx, max_chain_length
        cmp edi, esi
        jl  LastMatchGood
        shr ebx, 2
LastMatchGood:

;;; chainlen is decremented once beforehand so that the function can
;;; use the sign flag instead of the zero flag for the exit test.
;;; It is then shifted into the high word, to make room for the wmask
;;; value, which it will always accompany.

        dec ebx
        shl ebx, 16
        or  ebx, eax

;;; on zlib only
;;; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;

IFDEF INFOZIP
        mov [chainlenwmask], ebx
; on infozip nice_match = [nice_match]
ELSE
        mov eax, nice_match
        mov [chainlenwmask], ebx
        mov r10d, Lookahead
        cmp r10d, eax
        cmovnl r10d, eax
        mov [nicematch],r10d
ENDIF

;;; register Bytef *scan = s->window + s->strstart;
        mov r10, window_ad
        mov ebp, strstart
        lea r13, [r10 + rbp]

;;; Determine how many bytes the scan ptr is off from being
;;; dword-aligned.

         mov r9,r13
         neg r13
         and r13,3

;;; IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
;;;     s->strstart - (IPos)MAX_DIST(s) : NIL;
IFDEF INFOZIP
        mov eax,07efah ; MAX_DIST = (WSIZE-MIN_LOOKAHEAD) (0x8000-(3+8+1))
ELSE
        mov eax, window_size
        sub eax, MIN_LOOKAHEAD
ENDIF
        xor edi,edi
        sub ebp, eax

        mov r11d, prev_length

        cmovng ebp,edi

;;; int best_len = s->prev_length;


;;; Store the sum of s->window + best_len in esi locally, and in esi.

       lea  rsi,[r10+r11]

;;; register ush scan_start = *(ushf*)scan;
;;; register ush scan_end   = *(ushf*)(scan+best_len-1);
;;; Posf *prev = s->prev;

        movzx r12d,word ptr [r9]
        movzx ebx, word ptr [r9 + r11 - 1]

        mov rdi, prev_ad

;;; Jump into the main loop.

        mov edx, [chainlenwmask]

        cmp bx,word ptr [rsi + r8 - 1]
        jz  LookupLoopIsZero

LookupLoop1:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
        jbe LeaveNow
        sub edx, 00010000h
        js  LeaveNow

LoopEntry1:
        cmp bx,word ptr [rsi + r8 - 1]
        jz  LookupLoopIsZero

LookupLoop2:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
        jbe LeaveNow
        sub edx, 00010000h
        js  LeaveNow

LoopEntry2:
        cmp bx,word ptr [rsi + r8 - 1]
        jz  LookupLoopIsZero

LookupLoop4:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
        jbe LeaveNow
        sub edx, 00010000h
        js  LeaveNow

LoopEntry4:

        cmp bx,word ptr [rsi + r8 - 1]
        jnz LookupLoop1
        jmp LookupLoopIsZero


;;; do {
;;;     match = s->window + cur_match;
;;;     if (*(ushf*)(match+best_len-1) != scan_end ||
;;;         *(ushf*)match != scan_start) continue;
;;;     [...]
;;; } while ((cur_match = prev[cur_match & wmask]) > limit
;;;          && --chain_length != 0);
;;;
;;; Here is the inner loop of the function. The function will spend the
;;; majority of its time in this loop, and majority of that time will
;;; be spent in the first ten instructions.
;;;
;;; Within this loop:
;;; ebx = scanend
;;; r8d = curmatch
;;; edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
;;; esi = windowbestlen - i.e., (window + bestlen)
;;; edi = prev
;;; ebp = limit

LookupLoop:
        and r8d, edx

        movzx   r8d, word ptr [rdi + r8*2]
        cmp r8d, ebp
        jbe LeaveNow
        sub edx, 00010000h
        js  LeaveNow

LoopEntry:

        cmp bx,word ptr [rsi + r8 - 1]
        jnz LookupLoop1
LookupLoopIsZero:
        cmp     r12w, word ptr [r10 + r8]
        jnz LookupLoop1


;;; Store the current value of chainlen.
        mov [chainlenwmask], edx

;;; Point edi to the string under scrutiny, and esi to the string we
;;; are hoping to match it up with. In actuality, esi and edi are
;;; both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and edx is
;;; initialized to -(MAX_MATCH_8 - scanalign).

        lea rsi,[r8+r10]
        mov rdx, 0fffffffffffffef8h; -(MAX_MATCH_8)
        lea rsi, [rsi + r13 + 0108h] ;MAX_MATCH_8]
        lea rdi, [r9 + r13 + 0108h] ;MAX_MATCH_8]

        prefetcht1 [rsi+rdx]
        prefetcht1 [rdi+rdx]


;;; Test the strings for equality, 8 bytes at a time. At the end,
;;; adjust rdx so that it is offset to the exact byte that mismatched.
;;;
;;; We already know at this point that the first three bytes of the
;;; strings match each other, and they can be safely passed over before
;;; starting the compare loop. So what this code does is skip over 0-3
;;; bytes, as much as necessary in order to dword-align the edi
;;; pointer. (rsi will still be misaligned three times out of four.)
;;;
;;; It should be confessed that this loop usually does not represent
;;; much of the total running time. Replacing it with a more
;;; straightforward "rep cmpsb" would not drastically degrade
;;; performance.


LoopCmps:
        mov rax, [rsi + rdx]
        xor rax, [rdi + rdx]
        jnz LeaveLoopCmps

        mov rax, [rsi + rdx + 8]
        xor rax, [rdi + rdx + 8]
        jnz LeaveLoopCmps8


        mov rax, [rsi + rdx + 8+8]
        xor rax, [rdi + rdx + 8+8]
        jnz LeaveLoopCmps16

        add rdx,8+8+8

        jnz short LoopCmps
        jmp short LenMaximum
LeaveLoopCmps16: add rdx,8
LeaveLoopCmps8: add rdx,8
LeaveLoopCmps:

        test    eax, 0000FFFFh
        jnz LenLower

        test eax,0ffffffffh

        jnz LenLower32

        add rdx,4
        shr rax,32
        or ax,ax
        jnz LenLower

LenLower32:
        shr eax,16
        add rdx,2
LenLower:   sub al, 1
        adc rdx, 0
;;; Calculate the length of the match. If it is longer than MAX_MATCH,
;;; then automatically accept it as the best possible match and leave.

        lea rax, [rdi + rdx]
        sub rax, r9
        cmp eax, MAX_MATCH
        jge LenMaximum

;;; If the length of the match is not longer than the best match we
;;; have so far, then forget it and return to the lookup loop.
;///////////////////////////////////

        cmp eax, r11d
        jg  LongerMatch

        lea rsi,[r10+r11]

        mov rdi, prev_ad
        mov edx, [chainlenwmask]
        jmp LookupLoop

;;;         s->match_start = cur_match;
;;;         best_len = len;
;;;         if (len >= nice_match) break;
;;;         scan_end = *(ushf*)(scan+best_len-1);

LongerMatch:
        mov r11d, eax
        mov match_start, r8d
        cmp eax, [nicematch]
        jge LeaveNow

        lea rsi,[r10+rax]

        movzx   ebx, word ptr [r9 + rax - 1]
        mov rdi, prev_ad
        mov edx, [chainlenwmask]
        jmp LookupLoop

;;; Accept the current string, with the maximum possible length.

LenMaximum:
        mov r11d,MAX_MATCH
        mov match_start, r8d

;;; if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
;;; return s->lookahead;

LeaveNow:
IFDEF INFOZIP
        mov eax,r11d
ELSE
        mov eax, Lookahead
        cmp r11d, eax
        cmovng eax, r11d
ENDIF

;;; Restore the stack and return from whence we came.


        mov rsi,[save_rsi]
        mov rdi,[save_rdi]
        mov rbx,[save_rbx]
        mov rbp,[save_rbp]
        mov r12,[save_r12]
        mov r13,[save_r13]
;        mov r14,[save_r14]
;        mov r15,[save_r15]


        ret 0
; please don't remove this string !
; Your can freely use gvmat64 in any free or commercial app
; but it is far better don't remove the string in the binary!
    db     0dh,0ah,"asm686 with masm, optimised assembly code from Brian Raiter, written 1998, converted to amd 64 by Gilles Vollant 2005",0dh,0ah,0
longest_match   ENDP

match_init PROC
  ret 0
match_init ENDP


END

Deleted compat/zlib/contrib/masmx64/inffas8664.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186


























































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inffas8664.c is a hand tuned assembler version of inffast.c - fast decoding
 * version for AMD64 on Windows using Microsoft C compiler
 *
 * Copyright (C) 1995-2003 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 *
 * Copyright (C) 2003 Chris Anderson <christop@charm.net>
 * Please use the copyright conditions above.
 *
 * 2005 - Adaptation to Microsoft C Compiler for AMD64 by Gilles Vollant
 *
 * inffas8664.c call function inffas8664fnc in inffasx64.asm
 *  inffasx64.asm is automatically convert from AMD64 portion of inffas86.c
 *
 * Dec-29-2003 -- I added AMD64 inflate asm support.  This version is also
 * slightly quicker on x86 systems because, instead of using rep movsb to copy
 * data, it uses rep movsw, which moves data in 2-byte chunks instead of single
 * bytes.  I've tested the AMD64 code on a Fedora Core 1 + the x86_64 updates
 * from http://fedora.linux.duke.edu/fc1_x86_64
 * which is running on an Athlon 64 3000+ / Gigabyte GA-K8VT800M system with
 * 1GB ram.  The 64-bit version is about 4% faster than the 32-bit version,
 * when decompressing mozilla-source-1.3.tar.gz.
 *
 * Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
 * the gcc -S output of zlib-1.2.0/inffast.c.  Zlib-1.2.0 is in beta release at
 * the moment.  I have successfully compiled and tested this code with gcc2.96,
 * gcc3.2, icc5.0, msvc6.0.  It is very close to the speed of inffast.S
 * compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
 * enabled.  I will attempt to merge the MMX code into this version.  Newer
 * versions of this and inffast.S can be found at
 * http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
 *
 */

#include <stdio.h>
#include "zutil.h"
#include "inftrees.h"
#include "inflate.h"
#include "inffast.h"

/* Mark Adler's comments from inffast.c: */

/*
   Decode literal, length, and distance codes and write out the resulting
   literal and match bytes until either not enough input or output is
   available, an end-of-block is encountered, or a data error is encountered.
   When large enough input and output buffers are supplied to inflate(), for
   example, a 16K input buffer and a 64K output buffer, more than 95% of the
   inflate execution time is spent in this routine.

   Entry assumptions:

        state->mode == LEN
        strm->avail_in >= 6
        strm->avail_out >= 258
        start >= strm->avail_out
        state->bits < 8

   On return, state->mode is one of:

        LEN -- ran out of enough output space or enough available input
        TYPE -- reached end of block code, inflate() to interpret next block
        BAD -- error in block data

   Notes:

    - The maximum input bits used by a length/distance pair is 15 bits for the
      length code, 5 bits for the length extra, 15 bits for the distance code,
      and 13 bits for the distance extra.  This totals 48 bits, or six bytes.
      Therefore if strm->avail_in >= 6, then there is enough input to avoid
      checking for available input while decoding.

    - The maximum bytes that a single length/distance pair can output is 258
      bytes, which is the maximum length that can be coded.  inflate_fast()
      requires strm->avail_out >= 258 for each loop to avoid checking for
      output space.
 */



    typedef struct inffast_ar {
/* 64   32                               x86  x86_64 */
/* ar offset                              register */
/*  0    0 */ void *esp;                /* esp save */
/*  8    4 */ void *ebp;                /* ebp save */
/* 16    8 */ unsigned char FAR *in;    /* esi rsi  local strm->next_in */
/* 24   12 */ unsigned char FAR *last;  /*     r9   while in < last */
/* 32   16 */ unsigned char FAR *out;   /* edi rdi  local strm->next_out */
/* 40   20 */ unsigned char FAR *beg;   /*          inflate()'s init next_out */
/* 48   24 */ unsigned char FAR *end;   /*     r10  while out < end */
/* 56   28 */ unsigned char FAR *window;/*          size of window, wsize!=0 */
/* 64   32 */ code const FAR *lcode;    /* ebp rbp  local strm->lencode */
/* 72   36 */ code const FAR *dcode;    /*     r11  local strm->distcode */
/* 80   40 */ size_t /*unsigned long */hold;       /* edx rdx  local strm->hold */
/* 88   44 */ unsigned bits;            /* ebx rbx  local strm->bits */
/* 92   48 */ unsigned wsize;           /*          window size */
/* 96   52 */ unsigned write;           /*          window write index */
/*100   56 */ unsigned lmask;           /*     r12  mask for lcode */
/*104   60 */ unsigned dmask;           /*     r13  mask for dcode */
/*108   64 */ unsigned len;             /*     r14  match length */
/*112   68 */ unsigned dist;            /*     r15  match distance */
/*116   72 */ unsigned status;          /*          set when state chng*/
    } type_ar;
#ifdef ASMINF

void inflate_fast(strm, start)
z_streamp strm;
unsigned start;         /* inflate()'s starting value for strm->avail_out */
{
    struct inflate_state FAR *state;
    type_ar ar;
    void inffas8664fnc(struct inffast_ar * par);



#if (defined( __GNUC__ ) && defined( __amd64__ ) && ! defined( __i386 )) || (defined(_MSC_VER) && defined(_M_AMD64))
#define PAD_AVAIL_IN 6
#define PAD_AVAIL_OUT 258
#else
#define PAD_AVAIL_IN 5
#define PAD_AVAIL_OUT 257
#endif

    /* copy state to local variables */
    state = (struct inflate_state FAR *)strm->state;

    ar.in = strm->next_in;
    ar.last = ar.in + (strm->avail_in - PAD_AVAIL_IN);
    ar.out = strm->next_out;
    ar.beg = ar.out - (start - strm->avail_out);
    ar.end = ar.out + (strm->avail_out - PAD_AVAIL_OUT);
    ar.wsize = state->wsize;
    ar.write = state->wnext;
    ar.window = state->window;
    ar.hold = state->hold;
    ar.bits = state->bits;
    ar.lcode = state->lencode;
    ar.dcode = state->distcode;
    ar.lmask = (1U << state->lenbits) - 1;
    ar.dmask = (1U << state->distbits) - 1;

    /* decode literals and length/distances until end-of-block or not enough
       input data or output space */

    /* align in on 1/2 hold size boundary */
    while (((size_t)(void *)ar.in & (sizeof(ar.hold) / 2 - 1)) != 0) {
        ar.hold += (unsigned long)*ar.in++ << ar.bits;
        ar.bits += 8;
    }

    inffas8664fnc(&ar);

    if (ar.status > 1) {
        if (ar.status == 2)
            strm->msg = "invalid literal/length code";
        else if (ar.status == 3)
            strm->msg = "invalid distance code";
        else
            strm->msg = "invalid distance too far back";
        state->mode = BAD;
    }
    else if ( ar.status == 1 ) {
        state->mode = TYPE;
    }

    /* return unused bytes (on entry, bits < 8, so in won't go too far back) */
    ar.len = ar.bits >> 3;
    ar.in -= ar.len;
    ar.bits -= ar.len << 3;
    ar.hold &= (1U << ar.bits) - 1;

    /* update state and return */
    strm->next_in = ar.in;
    strm->next_out = ar.out;
    strm->avail_in = (unsigned)(ar.in < ar.last ?
                                PAD_AVAIL_IN + (ar.last - ar.in) :
                                PAD_AVAIL_IN - (ar.in - ar.last));
    strm->avail_out = (unsigned)(ar.out < ar.end ?
                                 PAD_AVAIL_OUT + (ar.end - ar.out) :
                                 PAD_AVAIL_OUT - (ar.out - ar.end));
    state->hold = (unsigned long)ar.hold;
    state->bits = ar.bits;
    return;
}

#endif

Deleted compat/zlib/contrib/masmx64/inffasx64.asm.

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
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












































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
; inffasx64.asm is a hand tuned assembler version of inffast.c - fast decoding
; version for AMD64 on Windows using Microsoft C compiler
;
; inffasx64.asm is automatically convert from AMD64 portion of inffas86.c
; inffasx64.asm is called by inffas8664.c, which contain more info.


; to compile this file, I use option
;   ml64.exe /Flinffasx64 /c /Zi inffasx64.asm
;   with Microsoft Macro Assembler (x64) for AMD64
;

; This file compile with Microsoft Macro Assembler (x64) for AMD64
;
;   ml64.exe is given with Visual Studio 2005/2008/2010 and Windows WDK
;
;   (you can get Windows WDK with ml64 for AMD64 from
;      http://www.microsoft.com/whdc/Devtools/wdk/default.mspx for low price)
;


.code
inffas8664fnc PROC

; see http://weblogs.asp.net/oldnewthing/archive/2004/01/14/58579.aspx and
; http://msdn.microsoft.com/library/en-us/kmarch/hh/kmarch/64bitAMD_8e951dd2-ee77-4728-8702-55ce4b5dd24a.xml.asp
;
; All registers must be preserved across the call, except for
;   rax, rcx, rdx, r8, r-9, r10, and r11, which are scratch.


	mov [rsp-8],rsi
	mov [rsp-16],rdi
	mov [rsp-24],r12
	mov [rsp-32],r13
	mov [rsp-40],r14
	mov [rsp-48],r15
	mov [rsp-56],rbx

	mov rax,rcx

	mov	[rax+8], rbp       ; /* save regs rbp and rsp */
	mov	[rax], rsp

	mov	rsp, rax          ; /* make rsp point to &ar */

	mov	rsi, [rsp+16]      ; /* rsi  = in */
	mov	rdi, [rsp+32]      ; /* rdi  = out */
	mov	r9, [rsp+24]       ; /* r9   = last */
	mov	r10, [rsp+48]      ; /* r10  = end */
	mov	rbp, [rsp+64]      ; /* rbp  = lcode */
	mov	r11, [rsp+72]      ; /* r11  = dcode */
	mov	rdx, [rsp+80]      ; /* rdx  = hold */
	mov	ebx, [rsp+88]      ; /* ebx  = bits */
	mov	r12d, [rsp+100]    ; /* r12d = lmask */
	mov	r13d, [rsp+104]    ; /* r13d = dmask */
                                          ; /* r14d = len */
                                          ; /* r15d = dist */


	cld
	cmp	r10, rdi
	je	L_one_time           ; /* if only one decode left */
	cmp	r9, rsi

    jne L_do_loop


L_one_time:
	mov	r8, r12           ; /* r8 = lmask */
	cmp	bl, 32
	ja	L_get_length_code_one_time

	lodsd                         ; /* eax = *(uint *)in++ */
	mov	cl, bl            ; /* cl = bits, needs it for shifting */
	add	bl, 32             ; /* bits += 32 */
	shl	rax, cl
	or	rdx, rax          ; /* hold |= *((uint *)in)++ << bits */
	jmp	L_get_length_code_one_time

ALIGN 4
L_while_test:
	cmp	r10, rdi
	jbe	L_break_loop
	cmp	r9, rsi
	jbe	L_break_loop

L_do_loop:
	mov	r8, r12           ; /* r8 = lmask */
	cmp	bl, 32
	ja	L_get_length_code    ; /* if (32 < bits) */

	lodsd                         ; /* eax = *(uint *)in++ */
	mov	cl, bl            ; /* cl = bits, needs it for shifting */
	add	bl, 32             ; /* bits += 32 */
	shl	rax, cl
	or	rdx, rax          ; /* hold |= *((uint *)in)++ << bits */

L_get_length_code:
	and	r8, rdx            ; /* r8 &= hold */
	mov	eax, [rbp+r8*4]  ; /* eax = lcode[hold & lmask] */

	mov	cl, ah            ; /* cl = this.bits */
	sub	bl, ah            ; /* bits -= this.bits */
	shr	rdx, cl           ; /* hold >>= this.bits */

	test	al, al
	jnz	L_test_for_length_base ; /* if (op != 0) 45.7% */

	mov	r8, r12            ; /* r8 = lmask */
	shr	eax, 16            ; /* output this.val char */
	stosb

L_get_length_code_one_time:
	and	r8, rdx            ; /* r8 &= hold */
	mov	eax, [rbp+r8*4] ; /* eax = lcode[hold & lmask] */

L_dolen:
	mov	cl, ah            ; /* cl = this.bits */
	sub	bl, ah            ; /* bits -= this.bits */
	shr	rdx, cl           ; /* hold >>= this.bits */

	test	al, al
	jnz	L_test_for_length_base ; /* if (op != 0) 45.7% */

	shr	eax, 16            ; /* output this.val char */
	stosb
	jmp	L_while_test

ALIGN 4
L_test_for_length_base:
	mov	r14d, eax         ; /* len = this */
	shr	r14d, 16           ; /* len = this.val */
	mov	cl, al

	test	al, 16
	jz	L_test_for_second_level_length ; /* if ((op & 16) == 0) 8% */
	and	cl, 15             ; /* op &= 15 */
	jz	L_decode_distance    ; /* if (!op) */

L_add_bits_to_len:
	sub	bl, cl
	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax
	and	eax, edx          ; /* eax &= hold */
	shr	rdx, cl
	add	r14d, eax         ; /* len += hold & mask[op] */

L_decode_distance:
	mov	r8, r13           ; /* r8 = dmask */
	cmp	bl, 32
	ja	L_get_distance_code  ; /* if (32 < bits) */

	lodsd                         ; /* eax = *(uint *)in++ */
	mov	cl, bl            ; /* cl = bits, needs it for shifting */
	add	bl, 32             ; /* bits += 32 */
	shl	rax, cl
	or	rdx, rax          ; /* hold |= *((uint *)in)++ << bits */

L_get_distance_code:
	and	r8, rdx           ; /* r8 &= hold */
	mov	eax, [r11+r8*4] ; /* eax = dcode[hold & dmask] */

L_dodist:
	mov	r15d, eax         ; /* dist = this */
	shr	r15d, 16           ; /* dist = this.val */
	mov	cl, ah
	sub	bl, ah            ; /* bits -= this.bits */
	shr	rdx, cl           ; /* hold >>= this.bits */
	mov	cl, al            ; /* cl = this.op */

	test	al, 16             ; /* if ((op & 16) == 0) */
	jz	L_test_for_second_level_dist
	and	cl, 15             ; /* op &= 15 */
	jz	L_check_dist_one

L_add_bits_to_dist:
	sub	bl, cl
	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax                 ; /* (1 << op) - 1 */
	and	eax, edx          ; /* eax &= hold */
	shr	rdx, cl
	add	r15d, eax         ; /* dist += hold & ((1 << op) - 1) */

L_check_window:
	mov	r8, rsi           ; /* save in so from can use it's reg */
	mov	rax, rdi
	sub	rax, [rsp+40]      ; /* nbytes = out - beg */

	cmp	eax, r15d
	jb	L_clip_window        ; /* if (dist > nbytes) 4.2% */

	mov	ecx, r14d         ; /* ecx = len */
	mov	rsi, rdi
	sub	rsi, r15          ; /* from = out - dist */

	sar	ecx, 1
	jnc	L_copy_two           ; /* if len % 2 == 0 */

	rep     movsw
	mov	al, [rsi]
	mov	[rdi], al
	inc	rdi

	mov	rsi, r8           ; /* move in back to %rsi, toss from */
	jmp	L_while_test

L_copy_two:
	rep     movsw
	mov	rsi, r8           ; /* move in back to %rsi, toss from */
	jmp	L_while_test

ALIGN 4
L_check_dist_one:
	cmp	r15d, 1            ; /* if dist 1, is a memset */
	jne	L_check_window
	cmp	[rsp+40], rdi      ; /* if out == beg, outside window */
	je	L_check_window

	mov	ecx, r14d         ; /* ecx = len */
	mov	al, [rdi-1]
	mov	ah, al

	sar	ecx, 1
	jnc	L_set_two
	mov	[rdi], al
	inc	rdi

L_set_two:
	rep     stosw
	jmp	L_while_test

ALIGN 4
L_test_for_second_level_length:
	test	al, 64
	jnz	L_test_for_end_of_block ; /* if ((op & 64) != 0) */

	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax
	and	eax, edx         ; /* eax &= hold */
	add	eax, r14d        ; /* eax += len */
	mov	eax, [rbp+rax*4] ; /* eax = lcode[val+(hold&mask[op])]*/
	jmp	L_dolen

ALIGN 4
L_test_for_second_level_dist:
	test	al, 64
	jnz	L_invalid_distance_code ; /* if ((op & 64) != 0) */

	xor	eax, eax
	inc	eax
	shl	eax, cl
	dec	eax
	and	eax, edx         ; /* eax &= hold */
	add	eax, r15d        ; /* eax += dist */
	mov	eax, [r11+rax*4] ; /* eax = dcode[val+(hold&mask[op])]*/
	jmp	L_dodist

ALIGN 4
L_clip_window:
	mov	ecx, eax         ; /* ecx = nbytes */
	mov	eax, [rsp+92]     ; /* eax = wsize, prepare for dist cmp */
	neg	ecx                ; /* nbytes = -nbytes */

	cmp	eax, r15d
	jb	L_invalid_distance_too_far ; /* if (dist > wsize) */

	add	ecx, r15d         ; /* nbytes = dist - nbytes */
	cmp	dword ptr [rsp+96], 0
	jne	L_wrap_around_window ; /* if (write != 0) */

	mov	rsi, [rsp+56]     ; /* from  = window */
	sub	eax, ecx         ; /* eax  -= nbytes */
	add	rsi, rax         ; /* from += wsize - nbytes */

	mov	eax, r14d        ; /* eax = len */
	cmp	r14d, ecx
	jbe	L_do_copy           ; /* if (nbytes >= len) */

	sub	eax, ecx         ; /* eax -= nbytes */
	rep     movsb
	mov	rsi, rdi
	sub	rsi, r15         ; /* from = &out[ -dist ] */
	jmp	L_do_copy

ALIGN 4
L_wrap_around_window:
	mov	eax, [rsp+96]     ; /* eax = write */
	cmp	ecx, eax
	jbe	L_contiguous_in_window ; /* if (write >= nbytes) */

	mov	esi, [rsp+92]     ; /* from  = wsize */
	add	rsi, [rsp+56]     ; /* from += window */
	add	rsi, rax         ; /* from += write */
	sub	rsi, rcx         ; /* from -= nbytes */
	sub	ecx, eax         ; /* nbytes -= write */

	mov	eax, r14d        ; /* eax = len */
	cmp	eax, ecx
	jbe	L_do_copy           ; /* if (nbytes >= len) */

	sub	eax, ecx         ; /* len -= nbytes */
	rep     movsb
	mov	rsi, [rsp+56]     ; /* from = window */
	mov	ecx, [rsp+96]     ; /* nbytes = write */
	cmp	eax, ecx
	jbe	L_do_copy           ; /* if (nbytes >= len) */

	sub	eax, ecx         ; /* len -= nbytes */
	rep     movsb
	mov	rsi, rdi
	sub	rsi, r15         ; /* from = out - dist */
	jmp	L_do_copy

ALIGN 4
L_contiguous_in_window:
	mov	rsi, [rsp+56]     ; /* rsi = window */
	add	rsi, rax
	sub	rsi, rcx         ; /* from += write - nbytes */

	mov	eax, r14d        ; /* eax = len */
	cmp	eax, ecx
	jbe	L_do_copy           ; /* if (nbytes >= len) */

	sub	eax, ecx         ; /* len -= nbytes */
	rep     movsb
	mov	rsi, rdi
	sub	rsi, r15         ; /* from = out - dist */
	jmp	L_do_copy           ; /* if (nbytes >= len) */

ALIGN 4
L_do_copy:
	mov	ecx, eax         ; /* ecx = len */
	rep     movsb

	mov	rsi, r8          ; /* move in back to %esi, toss from */
	jmp	L_while_test

L_test_for_end_of_block:
	test	al, 32
	jz	L_invalid_literal_length_code
	mov	dword ptr [rsp+116], 1
	jmp	L_break_loop_with_status

L_invalid_literal_length_code:
	mov	dword ptr [rsp+116], 2
	jmp	L_break_loop_with_status

L_invalid_distance_code:
	mov	dword ptr [rsp+116], 3
	jmp	L_break_loop_with_status

L_invalid_distance_too_far:
	mov	dword ptr [rsp+116], 4
	jmp	L_break_loop_with_status

L_break_loop:
	mov	dword ptr [rsp+116], 0

L_break_loop_with_status:
; /* put in, out, bits, and hold back into ar and pop esp */
	mov	[rsp+16], rsi     ; /* in */
	mov	[rsp+32], rdi     ; /* out */
	mov	[rsp+88], ebx     ; /* bits */
	mov	[rsp+80], rdx     ; /* hold */

	mov	rax, [rsp]       ; /* restore rbp and rsp */
	mov	rbp, [rsp+8]
	mov	rsp, rax



	mov rsi,[rsp-8]
	mov rdi,[rsp-16]
	mov r12,[rsp-24]
	mov r13,[rsp-32]
	mov r14,[rsp-40]
	mov r15,[rsp-48]
	mov rbx,[rsp-56]

    ret 0
;          :
;          : "m" (ar)
;          : "memory", "%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi",
;            "%r8", "%r9", "%r10", "%r11", "%r12", "%r13", "%r14", "%r15"
;    );

inffas8664fnc 	ENDP
;_TEXT	ENDS
END

Deleted compat/zlib/contrib/masmx64/readme.txt.

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































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Summary
-------
This directory contains ASM implementations of the functions
longest_match() and inflate_fast(), for 64 bits x86 (both AMD64 and Intel EM64t),
for use with Microsoft Macro Assembler (x64) for AMD64 and Microsoft C++ 64 bits.

gvmat64.asm is written by Gilles Vollant (2005), by using Brian Raiter 686/32 bits
   assembly optimized version from Jean-loup Gailly original longest_match function

inffasx64.asm and inffas8664.c were written by Chris Anderson, by optimizing
   original function from Mark Adler

Use instructions
----------------
Assemble the .asm files using MASM and put the object files into the zlib source
directory.  You can also get object files here:

     http://www.winimage.com/zLibDll/zlib124_masm_obj.zip

define ASMV and ASMINF in your project. Include inffas8664.c in your source tree,
and inffasx64.obj and gvmat64.obj as object to link.


Build instructions
------------------
run bld_64.bat with Microsoft Macro Assembler (x64) for AMD64 (ml64.exe)

ml64.exe is given with Visual Studio 2005, Windows 2003 server DDK

You can get Windows 2003 server DDK with ml64 and cl for AMD64 from
  http://www.microsoft.com/whdc/devtools/ddk/default.mspx for low price)

Deleted compat/zlib/contrib/masmx86/bld_ml32.bat.

1
2


-
-
ml /coff /Zi /c /Flmatch686.lst match686.asm
ml /coff /Zi /c /Flinffas32.lst inffas32.asm

Deleted compat/zlib/contrib/masmx86/inffas32.asm.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
;/* inffas32.asm is a hand tuned assembler version of inffast.c -- fast decoding
; *
; * inffas32.asm is derivated from inffas86.c, with translation of assembly code
; *
; * Copyright (C) 1995-2003 Mark Adler
; * For conditions of distribution and use, see copyright notice in zlib.h
; *
; * Copyright (C) 2003 Chris Anderson <christop@charm.net>
; * Please use the copyright conditions above.
; *
; * Mar-13-2003 -- Most of this is derived from inffast.S which is derived from
; * the gcc -S output of zlib-1.2.0/inffast.c.  Zlib-1.2.0 is in beta release at
; * the moment.  I have successfully compiled and tested this code with gcc2.96,
; * gcc3.2, icc5.0, msvc6.0.  It is very close to the speed of inffast.S
; * compiled with gcc -DNO_MMX, but inffast.S is still faster on the P3 with MMX
; * enabled.  I will attempt to merge the MMX code into this version.  Newer
; * versions of this and inffast.S can be found at
; * http://www.eetbeetee.com/zlib/ and http://www.charm.net/~christop/zlib/
; *
; * 2005 : modification by Gilles Vollant
; */
; For Visual C++ 4.x and higher and ML 6.x and higher
;   ml.exe is in directory \MASM611C of Win95 DDK
;   ml.exe is also distributed in http://www.masm32.com/masmdl.htm
;    and in VC++2003 toolkit at http://msdn.microsoft.com/visualc/vctoolkit2003/
;
;
;   compile with command line option
;   ml  /coff /Zi /c /Flinffas32.lst inffas32.asm

;   if you define NO_GZIP (see inflate.h), compile with
;   ml  /coff /Zi /c /Flinffas32.lst /DNO_GUNZIP inffas32.asm


; zlib122sup is 0 fort zlib 1.2.2.1 and lower
; zlib122sup is 8 fort zlib 1.2.2.2 and more (with addition of dmax and head
;        in inflate_state in inflate.h)
zlib1222sup      equ    8


IFDEF GUNZIP
  INFLATE_MODE_TYPE    equ 11
  INFLATE_MODE_BAD     equ 26
ELSE
  IFNDEF NO_GUNZIP
    INFLATE_MODE_TYPE    equ 11
    INFLATE_MODE_BAD     equ 26
  ELSE
    INFLATE_MODE_TYPE    equ 3
    INFLATE_MODE_BAD     equ 17
  ENDIF
ENDIF


; 75 "inffast.S"
;FILE "inffast.S"

;;;GLOBAL _inflate_fast

;;;SECTION .text



	.586p
	.mmx

	name	inflate_fast_x86
	.MODEL	FLAT

_DATA			segment
inflate_fast_use_mmx:
	dd	1


_TEXT			segment



ALIGN 4
	db	'Fast decoding Code from Chris Anderson'
	db	0

ALIGN 4
invalid_literal_length_code_msg:
	db	'invalid literal/length code'
	db	0

ALIGN 4
invalid_distance_code_msg:
	db	'invalid distance code'
	db	0

ALIGN 4
invalid_distance_too_far_msg:
	db	'invalid distance too far back'
	db	0


ALIGN 4
inflate_fast_mask:
dd	0
dd	1
dd	3
dd	7
dd	15
dd	31
dd	63
dd	127
dd	255
dd	511
dd	1023
dd	2047
dd	4095
dd	8191
dd	16383
dd	32767
dd	65535
dd	131071
dd	262143
dd	524287
dd	1048575
dd	2097151
dd	4194303
dd	8388607
dd	16777215
dd	33554431
dd	67108863
dd	134217727
dd	268435455
dd	536870911
dd	1073741823
dd	2147483647
dd	4294967295


mode_state	 equ	0	;/* state->mode	*/
wsize_state	 equ	(32+zlib1222sup)	;/* state->wsize */
write_state	 equ	(36+4+zlib1222sup)	;/* state->write */
window_state	 equ	(40+4+zlib1222sup)	;/* state->window */
hold_state	 equ	(44+4+zlib1222sup)	;/* state->hold	*/
bits_state	 equ	(48+4+zlib1222sup)	;/* state->bits	*/
lencode_state	 equ	(64+4+zlib1222sup)	;/* state->lencode */
distcode_state	 equ	(68+4+zlib1222sup)	;/* state->distcode */
lenbits_state	 equ	(72+4+zlib1222sup)	;/* state->lenbits */
distbits_state	 equ	(76+4+zlib1222sup)	;/* state->distbits */


;;SECTION .text
; 205 "inffast.S"
;GLOBAL	inflate_fast_use_mmx

;SECTION .data


; GLOBAL inflate_fast_use_mmx:object
;.size inflate_fast_use_mmx, 4
; 226 "inffast.S"
;SECTION .text

ALIGN 4
_inflate_fast proc near
.FPO (16, 4, 0, 0, 1, 0)
	push  edi
	push  esi
	push  ebp
	push  ebx
	pushfd
	sub  esp,64
	cld




	mov  esi, [esp+88]
	mov  edi, [esi+28]







	mov  edx, [esi+4]
	mov  eax, [esi+0]

	add  edx,eax
	sub  edx,11

	mov  [esp+44],eax
	mov  [esp+20],edx

	mov  ebp, [esp+92]
	mov  ecx, [esi+16]
	mov  ebx, [esi+12]

	sub  ebp,ecx
	neg  ebp
	add  ebp,ebx

	sub  ecx,257
	add  ecx,ebx

	mov  [esp+60],ebx
	mov  [esp+40],ebp
	mov  [esp+16],ecx
; 285 "inffast.S"
	mov  eax, [edi+lencode_state]
	mov  ecx, [edi+distcode_state]

	mov  [esp+8],eax
	mov  [esp+12],ecx

	mov  eax,1
	mov  ecx, [edi+lenbits_state]
	shl  eax,cl
	dec  eax
	mov  [esp+0],eax

	mov  eax,1
	mov  ecx, [edi+distbits_state]
	shl  eax,cl
	dec  eax
	mov  [esp+4],eax

	mov  eax, [edi+wsize_state]
	mov  ecx, [edi+write_state]
	mov  edx, [edi+window_state]

	mov  [esp+52],eax
	mov  [esp+48],ecx
	mov  [esp+56],edx

	mov  ebp, [edi+hold_state]
	mov  ebx, [edi+bits_state]
; 321 "inffast.S"
	mov  esi, [esp+44]
	mov  ecx, [esp+20]
	cmp  ecx,esi
	ja   L_align_long

	add  ecx,11
	sub  ecx,esi
	mov  eax,12
	sub  eax,ecx
	lea  edi, [esp+28]
	rep movsb
	mov  ecx,eax
	xor  eax,eax
	rep stosb
	lea  esi, [esp+28]
	mov  [esp+20],esi
	jmp  L_is_aligned


L_align_long:
	test  esi,3
	jz   L_is_aligned
	xor  eax,eax
	mov  al, [esi]
	inc  esi
	mov  ecx,ebx
	add  ebx,8
	shl  eax,cl
	or  ebp,eax
	jmp L_align_long

L_is_aligned:
	mov  edi, [esp+60]
; 366 "inffast.S"
L_check_mmx:
	cmp  dword ptr [inflate_fast_use_mmx],2
	je   L_init_mmx
	ja   L_do_loop

	push  eax
	push  ebx
	push  ecx
	push  edx
	pushfd
	mov  eax, [esp]
	xor  dword ptr [esp],0200000h




	popfd
	pushfd
	pop  edx
	xor  edx,eax
	jz   L_dont_use_mmx
	xor  eax,eax
	cpuid
	cmp  ebx,0756e6547h
	jne  L_dont_use_mmx
	cmp  ecx,06c65746eh
	jne  L_dont_use_mmx
	cmp  edx,049656e69h
	jne  L_dont_use_mmx
	mov  eax,1
	cpuid
	shr  eax,8
	and  eax,15
	cmp  eax,6
	jne  L_dont_use_mmx
	test  edx,0800000h
	jnz  L_use_mmx
	jmp  L_dont_use_mmx
L_use_mmx:
	mov  dword ptr [inflate_fast_use_mmx],2
	jmp  L_check_mmx_pop
L_dont_use_mmx:
	mov  dword ptr [inflate_fast_use_mmx],3
L_check_mmx_pop:
	pop  edx
	pop  ecx
	pop  ebx
	pop  eax
	jmp  L_check_mmx
; 426 "inffast.S"
ALIGN 4
L_do_loop:
; 437 "inffast.S"
	cmp  bl,15
	ja   L_get_length_code

	xor  eax,eax
	lodsw
	mov  cl,bl
	add  bl,16
	shl  eax,cl
	or  ebp,eax

L_get_length_code:
	mov  edx, [esp+0]
	mov  ecx, [esp+8]
	and  edx,ebp
	mov  eax, [ecx+edx*4]

L_dolen:






	mov  cl,ah
	sub  bl,ah
	shr  ebp,cl






	test  al,al
	jnz   L_test_for_length_base

	shr  eax,16
	stosb

L_while_test:


	cmp  [esp+16],edi
	jbe  L_break_loop

	cmp  [esp+20],esi
	ja   L_do_loop
	jmp  L_break_loop

L_test_for_length_base:
; 502 "inffast.S"
	mov  edx,eax
	shr  edx,16
	mov  cl,al

	test  al,16
	jz   L_test_for_second_level_length
	and  cl,15
	jz   L_save_len
	cmp  bl,cl
	jae  L_add_bits_to_len

	mov  ch,cl
	xor  eax,eax
	lodsw
	mov  cl,bl
	add  bl,16
	shl  eax,cl
	or  ebp,eax
	mov  cl,ch

L_add_bits_to_len:
	mov  eax,1
	shl  eax,cl
	dec  eax
	sub  bl,cl
	and  eax,ebp
	shr  ebp,cl
	add  edx,eax

L_save_len:
	mov  [esp+24],edx


L_decode_distance:
; 549 "inffast.S"
	cmp  bl,15
	ja   L_get_distance_code

	xor  eax,eax
	lodsw
	mov  cl,bl
	add  bl,16
	shl  eax,cl
	or  ebp,eax

L_get_distance_code:
	mov  edx, [esp+4]
	mov  ecx, [esp+12]
	and  edx,ebp
	mov  eax, [ecx+edx*4]


L_dodist:
	mov  edx,eax
	shr  edx,16
	mov  cl,ah
	sub  bl,ah
	shr  ebp,cl
; 584 "inffast.S"
	mov  cl,al

	test  al,16
	jz  L_test_for_second_level_dist
	and  cl,15
	jz  L_check_dist_one
	cmp  bl,cl
	jae  L_add_bits_to_dist

	mov  ch,cl
	xor  eax,eax
	lodsw
	mov  cl,bl
	add  bl,16
	shl  eax,cl
	or  ebp,eax
	mov  cl,ch

L_add_bits_to_dist:
	mov  eax,1
	shl  eax,cl
	dec  eax
	sub  bl,cl
	and  eax,ebp
	shr  ebp,cl
	add  edx,eax
	jmp  L_check_window

L_check_window:
; 625 "inffast.S"
	mov  [esp+44],esi
	mov  eax,edi
	sub  eax, [esp+40]

	cmp  eax,edx
	jb   L_clip_window

	mov  ecx, [esp+24]
	mov  esi,edi
	sub  esi,edx

	sub  ecx,3
	mov  al, [esi]
	mov  [edi],al
	mov  al, [esi+1]
	mov  dl, [esi+2]
	add  esi,3
	mov  [edi+1],al
	mov  [edi+2],dl
	add  edi,3
	rep movsb

	mov  esi, [esp+44]
	jmp  L_while_test

ALIGN 4
L_check_dist_one:
	cmp  edx,1
	jne  L_check_window
	cmp  [esp+40],edi
	je  L_check_window

	dec  edi
	mov  ecx, [esp+24]
	mov  al, [edi]
	sub  ecx,3

	mov  [edi+1],al
	mov  [edi+2],al
	mov  [edi+3],al
	add  edi,4
	rep stosb

	jmp  L_while_test

ALIGN 4
L_test_for_second_level_length:




	test  al,64
	jnz   L_test_for_end_of_block

	mov  eax,1
	shl  eax,cl
	dec  eax
	and  eax,ebp
	add  eax,edx
	mov  edx, [esp+8]
	mov  eax, [edx+eax*4]
	jmp  L_dolen

ALIGN 4
L_test_for_second_level_dist:




	test  al,64
	jnz   L_invalid_distance_code

	mov  eax,1
	shl  eax,cl
	dec  eax
	and  eax,ebp
	add  eax,edx
	mov  edx, [esp+12]
	mov  eax, [edx+eax*4]
	jmp  L_dodist

ALIGN 4
L_clip_window:
; 721 "inffast.S"
	mov  ecx,eax
	mov  eax, [esp+52]
	neg  ecx
	mov  esi, [esp+56]

	cmp  eax,edx
	jb   L_invalid_distance_too_far

	add  ecx,edx
	cmp  dword ptr [esp+48],0
	jne  L_wrap_around_window

	sub  eax,ecx
	add  esi,eax
; 749 "inffast.S"
	mov  eax, [esp+24]
	cmp  eax,ecx
	jbe  L_do_copy1

	sub  eax,ecx
	rep movsb
	mov  esi,edi
	sub  esi,edx
	jmp  L_do_copy1

	cmp  eax,ecx
	jbe  L_do_copy1

	sub  eax,ecx
	rep movsb
	mov  esi,edi
	sub  esi,edx
	jmp  L_do_copy1

L_wrap_around_window:
; 793 "inffast.S"
	mov  eax, [esp+48]
	cmp  ecx,eax
	jbe  L_contiguous_in_window

	add  esi, [esp+52]
	add  esi,eax
	sub  esi,ecx
	sub  ecx,eax


	mov  eax, [esp+24]
	cmp  eax,ecx
	jbe  L_do_copy1

	sub  eax,ecx
	rep movsb
	mov  esi, [esp+56]
	mov  ecx, [esp+48]
	cmp  eax,ecx
	jbe  L_do_copy1

	sub  eax,ecx
	rep movsb
	mov  esi,edi
	sub  esi,edx
	jmp  L_do_copy1

L_contiguous_in_window:
; 836 "inffast.S"
	add  esi,eax
	sub  esi,ecx


	mov  eax, [esp+24]
	cmp  eax,ecx
	jbe  L_do_copy1

	sub  eax,ecx
	rep movsb
	mov  esi,edi
	sub  esi,edx

L_do_copy1:
; 862 "inffast.S"
	mov  ecx,eax
	rep movsb

	mov  esi, [esp+44]
	jmp  L_while_test
; 878 "inffast.S"
ALIGN 4
L_init_mmx:
	emms





	movd mm0,ebp
	mov  ebp,ebx
; 896 "inffast.S"
	movd mm4,dword ptr [esp+0]
	movq mm3,mm4
	movd mm5,dword ptr [esp+4]
	movq mm2,mm5
	pxor mm1,mm1
	mov  ebx, [esp+8]
	jmp  L_do_loop_mmx

ALIGN 4
L_do_loop_mmx:
	psrlq mm0,mm1

	cmp  ebp,32
	ja  L_get_length_code_mmx

	movd mm6,ebp
	movd mm7,dword ptr [esi]
	add  esi,4
	psllq mm7,mm6
	add  ebp,32
	por mm0,mm7

L_get_length_code_mmx:
	pand mm4,mm0
	movd eax,mm4
	movq mm4,mm3
	mov  eax, [ebx+eax*4]

L_dolen_mmx:
	movzx  ecx,ah
	movd mm1,ecx
	sub  ebp,ecx

	test  al,al
	jnz L_test_for_length_base_mmx

	shr  eax,16
	stosb

L_while_test_mmx:


	cmp  [esp+16],edi
	jbe L_break_loop

	cmp  [esp+20],esi
	ja L_do_loop_mmx
	jmp L_break_loop

L_test_for_length_base_mmx:

	mov  edx,eax
	shr  edx,16

	test  al,16
	jz  L_test_for_second_level_length_mmx
	and  eax,15
	jz L_decode_distance_mmx

	psrlq mm0,mm1
	movd mm1,eax
	movd ecx,mm0
	sub  ebp,eax
	and  ecx, [inflate_fast_mask+eax*4]
	add  edx,ecx

L_decode_distance_mmx:
	psrlq mm0,mm1

	cmp  ebp,32
	ja L_get_dist_code_mmx

	movd mm6,ebp
	movd mm7,dword ptr [esi]
	add  esi,4
	psllq mm7,mm6
	add  ebp,32
	por mm0,mm7

L_get_dist_code_mmx:
	mov  ebx, [esp+12]
	pand mm5,mm0
	movd eax,mm5
	movq mm5,mm2
	mov  eax, [ebx+eax*4]

L_dodist_mmx:

	movzx  ecx,ah
	mov  ebx,eax
	shr  ebx,16
	sub  ebp,ecx
	movd mm1,ecx

	test  al,16
	jz L_test_for_second_level_dist_mmx
	and  eax,15
	jz L_check_dist_one_mmx

L_add_bits_to_dist_mmx:
	psrlq mm0,mm1
	movd mm1,eax
	movd ecx,mm0
	sub  ebp,eax
	and  ecx, [inflate_fast_mask+eax*4]
	add  ebx,ecx

L_check_window_mmx:
	mov  [esp+44],esi
	mov  eax,edi
	sub  eax, [esp+40]

	cmp  eax,ebx
	jb L_clip_window_mmx

	mov  ecx,edx
	mov  esi,edi
	sub  esi,ebx

	sub  ecx,3
	mov  al, [esi]
	mov  [edi],al
	mov  al, [esi+1]
	mov  dl, [esi+2]
	add  esi,3
	mov  [edi+1],al
	mov  [edi+2],dl
	add  edi,3
	rep movsb

	mov  esi, [esp+44]
	mov  ebx, [esp+8]
	jmp  L_while_test_mmx

ALIGN 4
L_check_dist_one_mmx:
	cmp  ebx,1
	jne  L_check_window_mmx
	cmp  [esp+40],edi
	je   L_check_window_mmx

	dec  edi
	mov  ecx,edx
	mov  al, [edi]
	sub  ecx,3

	mov  [edi+1],al
	mov  [edi+2],al
	mov  [edi+3],al
	add  edi,4
	rep stosb

	mov  ebx, [esp+8]
	jmp  L_while_test_mmx

ALIGN 4
L_test_for_second_level_length_mmx:
	test  al,64
	jnz L_test_for_end_of_block

	and  eax,15
	psrlq mm0,mm1
	movd ecx,mm0
	and  ecx, [inflate_fast_mask+eax*4]
	add  ecx,edx
	mov  eax, [ebx+ecx*4]
	jmp L_dolen_mmx

ALIGN 4
L_test_for_second_level_dist_mmx:
	test  al,64
	jnz L_invalid_distance_code

	and  eax,15
	psrlq mm0,mm1
	movd ecx,mm0
	and  ecx, [inflate_fast_mask+eax*4]
	mov  eax, [esp+12]
	add  ecx,ebx
	mov  eax, [eax+ecx*4]
	jmp  L_dodist_mmx

ALIGN 4
L_clip_window_mmx:

	mov  ecx,eax
	mov  eax, [esp+52]
	neg  ecx
	mov  esi, [esp+56]

	cmp  eax,ebx
	jb  L_invalid_distance_too_far

	add  ecx,ebx
	cmp  dword ptr [esp+48],0
	jne  L_wrap_around_window_mmx

	sub  eax,ecx
	add  esi,eax

	cmp  edx,ecx
	jbe  L_do_copy1_mmx

	sub  edx,ecx
	rep movsb
	mov  esi,edi
	sub  esi,ebx
	jmp  L_do_copy1_mmx

	cmp  edx,ecx
	jbe  L_do_copy1_mmx

	sub  edx,ecx
	rep movsb
	mov  esi,edi
	sub  esi,ebx
	jmp  L_do_copy1_mmx

L_wrap_around_window_mmx:

	mov  eax, [esp+48]
	cmp  ecx,eax
	jbe  L_contiguous_in_window_mmx

	add  esi, [esp+52]
	add  esi,eax
	sub  esi,ecx
	sub  ecx,eax


	cmp  edx,ecx
	jbe  L_do_copy1_mmx

	sub  edx,ecx
	rep movsb
	mov  esi, [esp+56]
	mov  ecx, [esp+48]
	cmp  edx,ecx
	jbe  L_do_copy1_mmx

	sub  edx,ecx
	rep movsb
	mov  esi,edi
	sub  esi,ebx
	jmp  L_do_copy1_mmx

L_contiguous_in_window_mmx:

	add  esi,eax
	sub  esi,ecx


	cmp  edx,ecx
	jbe  L_do_copy1_mmx

	sub  edx,ecx
	rep movsb
	mov  esi,edi
	sub  esi,ebx

L_do_copy1_mmx:


	mov  ecx,edx
	rep movsb

	mov  esi, [esp+44]
	mov  ebx, [esp+8]
	jmp  L_while_test_mmx
; 1174 "inffast.S"
L_invalid_distance_code:





	mov  ecx, invalid_distance_code_msg
	mov  edx,INFLATE_MODE_BAD
	jmp  L_update_stream_state

L_test_for_end_of_block:





	test  al,32
	jz  L_invalid_literal_length_code

	mov  ecx,0
	mov  edx,INFLATE_MODE_TYPE
	jmp  L_update_stream_state

L_invalid_literal_length_code:





	mov  ecx, invalid_literal_length_code_msg
	mov  edx,INFLATE_MODE_BAD
	jmp  L_update_stream_state

L_invalid_distance_too_far:



	mov  esi, [esp+44]
	mov  ecx, invalid_distance_too_far_msg
	mov  edx,INFLATE_MODE_BAD
	jmp  L_update_stream_state

L_update_stream_state:

	mov  eax, [esp+88]
	test  ecx,ecx
	jz  L_skip_msg
	mov  [eax+24],ecx
L_skip_msg:
	mov  eax, [eax+28]
	mov  [eax+mode_state],edx
	jmp  L_break_loop

ALIGN 4
L_break_loop:
; 1243 "inffast.S"
	cmp  dword ptr [inflate_fast_use_mmx],2
	jne  L_update_next_in



	mov  ebx,ebp

L_update_next_in:
; 1266 "inffast.S"
	mov  eax, [esp+88]
	mov  ecx,ebx
	mov  edx, [eax+28]
	shr  ecx,3
	sub  esi,ecx
	shl  ecx,3
	sub  ebx,ecx
	mov  [eax+12],edi
	mov  [edx+bits_state],ebx
	mov  ecx,ebx

	lea  ebx, [esp+28]
	cmp  [esp+20],ebx
	jne  L_buf_not_used

	sub  esi,ebx
	mov  ebx, [eax+0]
	mov  [esp+20],ebx
	add  esi,ebx
	mov  ebx, [eax+4]
	sub  ebx,11
	add  [esp+20],ebx

L_buf_not_used:
	mov  [eax+0],esi

	mov  ebx,1
	shl  ebx,cl
	dec  ebx





	cmp  dword ptr [inflate_fast_use_mmx],2
	jne  L_update_hold



	psrlq mm0,mm1
	movd ebp,mm0

	emms

L_update_hold:



	and  ebp,ebx
	mov  [edx+hold_state],ebp




	mov  ebx, [esp+20]
	cmp  ebx,esi
	jbe  L_last_is_smaller

	sub  ebx,esi
	add  ebx,11
	mov  [eax+4],ebx
	jmp  L_fixup_out
L_last_is_smaller:
	sub  esi,ebx
	neg  esi
	add  esi,11
	mov  [eax+4],esi




L_fixup_out:

	mov  ebx, [esp+16]
	cmp  ebx,edi
	jbe  L_end_is_smaller

	sub  ebx,edi
	add  ebx,257
	mov  [eax+16],ebx
	jmp  L_done
L_end_is_smaller:
	sub  edi,ebx
	neg  edi
	add  edi,257
	mov  [eax+16],edi





L_done:
	add  esp,64
	popfd
	pop  ebx
	pop  ebp
	pop  esi
	pop  edi
	ret
_inflate_fast endp

_TEXT	ends
end

Deleted compat/zlib/contrib/masmx86/match686.asm.

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
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
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































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
; match686.asm -- Asm portion of the optimized longest_match for 32 bits x86
; Copyright (C) 1995-1996 Jean-loup Gailly, Brian Raiter and Gilles Vollant.
; File written by Gilles Vollant, by converting match686.S from Brian Raiter
; for MASM. This is as assembly version of longest_match
;  from Jean-loup Gailly in deflate.c
;
;         http://www.zlib.net
;         http://www.winimage.com/zLibDll
;         http://www.muppetlabs.com/~breadbox/software/assembly.html
;
; For Visual C++ 4.x and higher and ML 6.x and higher
;   ml.exe is distributed in
;  http://www.microsoft.com/downloads/details.aspx?FamilyID=7a1c9da0-0510-44a2-b042-7ef370530c64
;
; this file contain two implementation of longest_match
;
;  this longest_match was written by Brian raiter (1998), optimized for Pentium Pro
;   (and the faster known version of match_init on modern Core 2 Duo and AMD Phenom)
;
;  for using an assembly version of longest_match, you need define ASMV in project
;
;    compile the asm file running
;           ml /coff /Zi /c /Flmatch686.lst match686.asm
;    and do not include match686.obj in your project
;
; note: contrib of zLib 1.2.3 and earlier contained both a deprecated version for
;  Pentium (prior Pentium Pro) and this version for Pentium Pro and modern processor
;  with autoselect (with cpu detection code)
;  if you want support the old pentium optimization, you can still use these version
;
; this file is not optimized for old pentium, but it compatible with all x86 32 bits
; processor (starting 80386)
;
;
; see below : zlib1222add must be adjuster if you use a zlib version < 1.2.2.2

;uInt longest_match(s, cur_match)
;    deflate_state *s;
;    IPos cur_match;                             /* current match */

    NbStack         equ     76
    cur_match       equ     dword ptr[esp+NbStack-0]
    str_s           equ     dword ptr[esp+NbStack-4]
; 5 dword on top (ret,ebp,esi,edi,ebx)
    adrret          equ     dword ptr[esp+NbStack-8]
    pushebp         equ     dword ptr[esp+NbStack-12]
    pushedi         equ     dword ptr[esp+NbStack-16]
    pushesi         equ     dword ptr[esp+NbStack-20]
    pushebx         equ     dword ptr[esp+NbStack-24]

    chain_length    equ     dword ptr [esp+NbStack-28]
    limit           equ     dword ptr [esp+NbStack-32]
    best_len        equ     dword ptr [esp+NbStack-36]
    window          equ     dword ptr [esp+NbStack-40]
    prev            equ     dword ptr [esp+NbStack-44]
    scan_start      equ      word ptr [esp+NbStack-48]
    wmask           equ     dword ptr [esp+NbStack-52]
    match_start_ptr equ     dword ptr [esp+NbStack-56]
    nice_match      equ     dword ptr [esp+NbStack-60]
    scan            equ     dword ptr [esp+NbStack-64]

    windowlen       equ     dword ptr [esp+NbStack-68]
    match_start     equ     dword ptr [esp+NbStack-72]
    strend          equ     dword ptr [esp+NbStack-76]
    NbStackAdd      equ     (NbStack-24)

    .386p

    name    gvmatch
    .MODEL  FLAT



;  all the +zlib1222add offsets are due to the addition of fields
;  in zlib in the deflate_state structure since the asm code was first written
;  (if you compile with zlib 1.0.4 or older, use "zlib1222add equ (-4)").
;  (if you compile with zlib between 1.0.5 and 1.2.2.1, use "zlib1222add equ 0").
;  if you compile with zlib 1.2.2.2 or later , use "zlib1222add equ 8").

    zlib1222add         equ     8

;  Note : these value are good with a 8 bytes boundary pack structure
    dep_chain_length    equ     74h+zlib1222add
    dep_window          equ     30h+zlib1222add
    dep_strstart        equ     64h+zlib1222add
    dep_prev_length     equ     70h+zlib1222add
    dep_nice_match      equ     88h+zlib1222add
    dep_w_size          equ     24h+zlib1222add
    dep_prev            equ     38h+zlib1222add
    dep_w_mask          equ     2ch+zlib1222add
    dep_good_match      equ     84h+zlib1222add
    dep_match_start     equ     68h+zlib1222add
    dep_lookahead       equ     6ch+zlib1222add


_TEXT                   segment

IFDEF NOUNDERLINE
            public  longest_match
            public  match_init
ELSE
            public  _longest_match
            public  _match_init
ENDIF

    MAX_MATCH           equ     258
    MIN_MATCH           equ     3
    MIN_LOOKAHEAD       equ     (MAX_MATCH+MIN_MATCH+1)



MAX_MATCH       equ     258
MIN_MATCH       equ     3
MIN_LOOKAHEAD   equ     (MAX_MATCH + MIN_MATCH + 1)
MAX_MATCH_8_     equ     ((MAX_MATCH + 7) AND 0FFF0h)


;;; stack frame offsets

chainlenwmask   equ  esp + 0    ; high word: current chain len
                    ; low word: s->wmask
window      equ  esp + 4    ; local copy of s->window
windowbestlen   equ  esp + 8    ; s->window + bestlen
scanstart   equ  esp + 16   ; first two bytes of string
scanend     equ  esp + 12   ; last two bytes of string
scanalign   equ  esp + 20   ; dword-misalignment of string
nicematch   equ  esp + 24   ; a good enough match size
bestlen     equ  esp + 28   ; size of best match so far
scan        equ  esp + 32   ; ptr to string wanting match

LocalVarsSize   equ 36
;   saved ebx   byte esp + 36
;   saved edi   byte esp + 40
;   saved esi   byte esp + 44
;   saved ebp   byte esp + 48
;   return address  byte esp + 52
deflatestate    equ  esp + 56   ; the function arguments
curmatch    equ  esp + 60

;;; Offsets for fields in the deflate_state structure. These numbers
;;; are calculated from the definition of deflate_state, with the
;;; assumption that the compiler will dword-align the fields. (Thus,
;;; changing the definition of deflate_state could easily cause this
;;; program to crash horribly, without so much as a warning at
;;; compile time. Sigh.)

dsWSize     equ 36+zlib1222add
dsWMask     equ 44+zlib1222add
dsWindow    equ 48+zlib1222add
dsPrev      equ 56+zlib1222add
dsMatchLen  equ 88+zlib1222add
dsPrevMatch equ 92+zlib1222add
dsStrStart  equ 100+zlib1222add
dsMatchStart    equ 104+zlib1222add
dsLookahead equ 108+zlib1222add
dsPrevLen   equ 112+zlib1222add
dsMaxChainLen   equ 116+zlib1222add
dsGoodMatch equ 132+zlib1222add
dsNiceMatch equ 136+zlib1222add


;;; match686.asm -- Pentium-Pro-optimized version of longest_match()
;;; Written for zlib 1.1.2
;;; Copyright (C) 1998 Brian Raiter <breadbox@muppetlabs.com>
;;; You can look at http://www.muppetlabs.com/~breadbox/software/assembly.html
;;;
;;
;;  This software is provided 'as-is', without any express or implied
;;  warranty.  In no event will the authors be held liable for any damages
;;  arising from the use of this software.
;;
;;  Permission is granted to anyone to use this software for any purpose,
;;  including commercial applications, and to alter it and redistribute it
;;  freely, subject to the following restrictions:
;;
;;  1. The origin of this software must not be misrepresented; you must not
;;     claim that you wrote the original software. If you use this software
;;     in a product, an acknowledgment in the product documentation would be
;;     appreciated but is not required.
;;  2. Altered source versions must be plainly marked as such, and must not be
;;     misrepresented as being the original software
;;  3. This notice may not be removed or altered from any source distribution.
;;

;GLOBAL _longest_match, _match_init


;SECTION    .text

;;; uInt longest_match(deflate_state *deflatestate, IPos curmatch)

;_longest_match:
    IFDEF NOUNDERLINE
    longest_match       proc near
    ELSE
    _longest_match      proc near
    ENDIF
.FPO (9, 4, 0, 0, 1, 0)

;;; Save registers that the compiler may be using, and adjust esp to
;;; make room for our stack frame.

        push    ebp
        push    edi
        push    esi
        push    ebx
        sub esp, LocalVarsSize

;;; Retrieve the function arguments. ecx will hold cur_match
;;; throughout the entire function. edx will hold the pointer to the
;;; deflate_state structure during the function's setup (before
;;; entering the main loop.

        mov edx, [deflatestate]
        mov ecx, [curmatch]

;;; uInt wmask = s->w_mask;
;;; unsigned chain_length = s->max_chain_length;
;;; if (s->prev_length >= s->good_match) {
;;;     chain_length >>= 2;
;;; }

        mov eax, [edx + dsPrevLen]
        mov ebx, [edx + dsGoodMatch]
        cmp eax, ebx
        mov eax, [edx + dsWMask]
        mov ebx, [edx + dsMaxChainLen]
        jl  LastMatchGood
        shr ebx, 2
LastMatchGood:

;;; chainlen is decremented once beforehand so that the function can
;;; use the sign flag instead of the zero flag for the exit test.
;;; It is then shifted into the high word, to make room for the wmask
;;; value, which it will always accompany.

        dec ebx
        shl ebx, 16
        or  ebx, eax
        mov [chainlenwmask], ebx

;;; if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead;

        mov eax, [edx + dsNiceMatch]
        mov ebx, [edx + dsLookahead]
        cmp ebx, eax
        jl  LookaheadLess
        mov ebx, eax
LookaheadLess:  mov [nicematch], ebx

;;; register Bytef *scan = s->window + s->strstart;

        mov esi, [edx + dsWindow]
        mov [window], esi
        mov ebp, [edx + dsStrStart]
        lea edi, [esi + ebp]
        mov [scan], edi

;;; Determine how many bytes the scan ptr is off from being
;;; dword-aligned.

        mov eax, edi
        neg eax
        and eax, 3
        mov [scanalign], eax

;;; IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
;;;     s->strstart - (IPos)MAX_DIST(s) : NIL;

        mov eax, [edx + dsWSize]
        sub eax, MIN_LOOKAHEAD
        sub ebp, eax
        jg  LimitPositive
        xor ebp, ebp
LimitPositive:

;;; int best_len = s->prev_length;

        mov eax, [edx + dsPrevLen]
        mov [bestlen], eax

;;; Store the sum of s->window + best_len in esi locally, and in esi.

        add esi, eax
        mov [windowbestlen], esi

;;; register ush scan_start = *(ushf*)scan;
;;; register ush scan_end   = *(ushf*)(scan+best_len-1);
;;; Posf *prev = s->prev;

        movzx   ebx, word ptr [edi]
        mov [scanstart], ebx
        movzx   ebx, word ptr [edi + eax - 1]
        mov [scanend], ebx
        mov edi, [edx + dsPrev]

;;; Jump into the main loop.

        mov edx, [chainlenwmask]
        jmp short LoopEntry

align 4

;;; do {
;;;     match = s->window + cur_match;
;;;     if (*(ushf*)(match+best_len-1) != scan_end ||
;;;         *(ushf*)match != scan_start) continue;
;;;     [...]
;;; } while ((cur_match = prev[cur_match & wmask]) > limit
;;;          && --chain_length != 0);
;;;
;;; Here is the inner loop of the function. The function will spend the
;;; majority of its time in this loop, and majority of that time will
;;; be spent in the first ten instructions.
;;;
;;; Within this loop:
;;; ebx = scanend
;;; ecx = curmatch
;;; edx = chainlenwmask - i.e., ((chainlen << 16) | wmask)
;;; esi = windowbestlen - i.e., (window + bestlen)
;;; edi = prev
;;; ebp = limit

LookupLoop:
        and ecx, edx
        movzx   ecx, word ptr [edi + ecx*2]
        cmp ecx, ebp
        jbe LeaveNow
        sub edx, 00010000h
        js  LeaveNow
LoopEntry:  movzx   eax, word ptr [esi + ecx - 1]
        cmp eax, ebx
        jnz LookupLoop
        mov eax, [window]
        movzx   eax, word ptr [eax + ecx]
        cmp eax, [scanstart]
        jnz LookupLoop

;;; Store the current value of chainlen.

        mov [chainlenwmask], edx

;;; Point edi to the string under scrutiny, and esi to the string we
;;; are hoping to match it up with. In actuality, esi and edi are
;;; both pointed (MAX_MATCH_8 - scanalign) bytes ahead, and edx is
;;; initialized to -(MAX_MATCH_8 - scanalign).

        mov esi, [window]
        mov edi, [scan]
        add esi, ecx
        mov eax, [scanalign]
        mov edx, 0fffffef8h; -(MAX_MATCH_8)
        lea edi, [edi + eax + 0108h] ;MAX_MATCH_8]
        lea esi, [esi + eax + 0108h] ;MAX_MATCH_8]

;;; Test the strings for equality, 8 bytes at a time. At the end,
;;; adjust edx so that it is offset to the exact byte that mismatched.
;;;
;;; We already know at this point that the first three bytes of the
;;; strings match each other, and they can be safely passed over before
;;; starting the compare loop. So what this code does is skip over 0-3
;;; bytes, as much as necessary in order to dword-align the edi
;;; pointer. (esi will still be misaligned three times out of four.)
;;;
;;; It should be confessed that this loop usually does not represent
;;; much of the total running time. Replacing it with a more
;;; straightforward "rep cmpsb" would not drastically degrade
;;; performance.

LoopCmps:
        mov eax, [esi + edx]
        xor eax, [edi + edx]
        jnz LeaveLoopCmps
        mov eax, [esi + edx + 4]
        xor eax, [edi + edx + 4]
        jnz LeaveLoopCmps4
        add edx, 8
        jnz LoopCmps
        jmp short LenMaximum
LeaveLoopCmps4: add edx, 4
LeaveLoopCmps:  test    eax, 0000FFFFh
        jnz LenLower
        add edx,  2
        shr eax, 16
LenLower:   sub al, 1
        adc edx, 0

;;; Calculate the length of the match. If it is longer than MAX_MATCH,
;;; then automatically accept it as the best possible match and leave.

        lea eax, [edi + edx]
        mov edi, [scan]
        sub eax, edi
        cmp eax, MAX_MATCH
        jge LenMaximum

;;; If the length of the match is not longer than the best match we
;;; have so far, then forget it and return to the lookup loop.

        mov edx, [deflatestate]
        mov ebx, [bestlen]
        cmp eax, ebx
        jg  LongerMatch
        mov esi, [windowbestlen]
        mov edi, [edx + dsPrev]
        mov ebx, [scanend]
        mov edx, [chainlenwmask]
        jmp LookupLoop

;;;         s->match_start = cur_match;
;;;         best_len = len;
;;;         if (len >= nice_match) break;
;;;         scan_end = *(ushf*)(scan+best_len-1);

LongerMatch:    mov ebx, [nicematch]
        mov [bestlen], eax
        mov [edx + dsMatchStart], ecx
        cmp eax, ebx
        jge LeaveNow
        mov esi, [window]
        add esi, eax
        mov [windowbestlen], esi
        movzx   ebx, word ptr [edi + eax - 1]
        mov edi, [edx + dsPrev]
        mov [scanend], ebx
        mov edx, [chainlenwmask]
        jmp LookupLoop

;;; Accept the current string, with the maximum possible length.

LenMaximum: mov edx, [deflatestate]
        mov dword ptr [bestlen], MAX_MATCH
        mov [edx + dsMatchStart], ecx

;;; if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
;;; return s->lookahead;

LeaveNow:
        mov edx, [deflatestate]
        mov ebx, [bestlen]
        mov eax, [edx + dsLookahead]
        cmp ebx, eax
        jg  LookaheadRet
        mov eax, ebx
LookaheadRet:

;;; Restore the stack and return from whence we came.

        add esp, LocalVarsSize
        pop ebx
        pop esi
        pop edi
        pop ebp

        ret
; please don't remove this string !
; Your can freely use match686 in any free or commercial app if you don't remove the string in the binary!
    db     0dh,0ah,"asm686 with masm, optimised assembly code from Brian Raiter, written 1998",0dh,0ah


    IFDEF NOUNDERLINE
    longest_match       endp
    ELSE
    _longest_match      endp
    ENDIF

    IFDEF NOUNDERLINE
    match_init      proc near
                    ret
    match_init      endp
    ELSE
    _match_init     proc near
                    ret
    _match_init     endp
    ENDIF


_TEXT   ends
end

Deleted compat/zlib/contrib/masmx86/readme.txt.

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



























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Summary
-------
This directory contains ASM implementations of the functions
longest_match() and inflate_fast().


Use instructions
----------------
Assemble using MASM, and copy the object files into the zlib source
directory, then run the appropriate makefile, as suggested below.  You can
donwload MASM from here:

    http://www.microsoft.com/downloads/details.aspx?displaylang=en&FamilyID=7a1c9da0-0510-44a2-b042-7ef370530c64

You can also get objects files here:

    http://www.winimage.com/zLibDll/zlib124_masm_obj.zip

Build instructions
------------------
* With Microsoft C and MASM:
nmake -f win32/Makefile.msc LOC="-DASMV -DASMINF" OBJA="match686.obj inffas32.obj"

* With Borland C and TASM:
make -f win32/Makefile.bor LOCAL_ZLIB="-DASMV -DASMINF" OBJA="match686.obj inffas32.obj" OBJPA="+match686c.obj+match686.obj+inffas32.obj"

Deleted compat/zlib/contrib/minizip/Makefile.

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

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
CC=cc
CFLAGS=-O -I../..

UNZ_OBJS = miniunz.o unzip.o ioapi.o ../../libz.a
ZIP_OBJS = minizip.o zip.o   ioapi.o ../../libz.a

.c.o:
	$(CC) -c $(CFLAGS) $*.c

all: miniunz minizip

miniunz:  $(UNZ_OBJS)
	$(CC) $(CFLAGS) -o $@ $(UNZ_OBJS)

minizip:  $(ZIP_OBJS)
	$(CC) $(CFLAGS) -o $@ $(ZIP_OBJS)

test:	miniunz minizip
	./minizip test readme.txt
	./miniunz -l test.zip
	mv readme.txt readme.old
	./miniunz test.zip

clean:
	/bin/rm -f *.o *~ minizip miniunz

Deleted compat/zlib/contrib/minizip/Makefile.am.

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













































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
lib_LTLIBRARIES = libminizip.la

if COND_DEMOS
bin_PROGRAMS = miniunzip minizip
endif

zlib_top_srcdir = $(top_srcdir)/../..
zlib_top_builddir = $(top_builddir)/../..

AM_CPPFLAGS = -I$(zlib_top_srcdir)
AM_LDFLAGS = -L$(zlib_top_builddir)

if WIN32
iowin32_src = iowin32.c
iowin32_h = iowin32.h
endif

libminizip_la_SOURCES = \
	ioapi.c \
	mztools.c \
	unzip.c \
	zip.c \
	${iowin32_src}

libminizip_la_LDFLAGS = $(AM_LDFLAGS) -version-info 1:0:0 -lz

minizip_includedir = $(includedir)/minizip
minizip_include_HEADERS = \
	crypt.h \
	ioapi.h \
	mztools.h \
	unzip.h \
	zip.h \
	${iowin32_h}

pkgconfigdir = $(libdir)/pkgconfig
pkgconfig_DATA = minizip.pc

EXTRA_PROGRAMS = miniunzip minizip

miniunzip_SOURCES = miniunz.c
miniunzip_LDADD = libminizip.la

minizip_SOURCES = minizip.c
minizip_LDADD = libminizip.la -lz

Deleted compat/zlib/contrib/minizip/MiniZip64_Changes.txt.

1
2
3
4
5
6






-
-
-
-
-
-

MiniZip 1.1 was derrived from MiniZip at version 1.01f

Change in 1.0 (Okt 2009)
 - **TODO - Add history**

Deleted compat/zlib/contrib/minizip/MiniZip64_info.txt.

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










































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
MiniZip - Copyright (c) 1998-2010 - by Gilles Vollant - version 1.1 64 bits from Mathias Svensson

Introduction
---------------------
MiniZip 1.1 is built from MiniZip 1.0 by Gilles Vollant ( http://www.winimage.com/zLibDll/minizip.html )

When adding ZIP64 support into minizip it would result into risk of breaking compatibility with minizip 1.0.
All possible work was done for compatibility.


Background
---------------------
When adding ZIP64 support Mathias Svensson found that Even Rouault have added ZIP64 
support for unzip.c into minizip for a open source project called gdal ( http://www.gdal.org/ )

That was used as a starting point. And after that ZIP64 support was added to zip.c
some refactoring and code cleanup was also done.


Changed from MiniZip 1.0 to MiniZip 1.1
---------------------------------------
* Added ZIP64 support for unzip ( by Even Rouault )
* Added ZIP64 support for zip ( by Mathias Svensson )
* Reverted some changed that Even Rouault did.
* Bunch of patches received from Gulles Vollant that he received for MiniZip from various users.
* Added unzip patch for BZIP Compression method (patch create by Daniel Borca)
* Added BZIP Compress method for zip
* Did some refactoring and code cleanup


Credits

 Gilles Vollant    - Original MiniZip author
 Even Rouault      - ZIP64 unzip Support
 Daniel Borca      - BZip Compression method support in unzip
 Mathias Svensson  - ZIP64 zip support
 Mathias Svensson  - BZip Compression method support in zip

 Resources

 ZipLayout   http://result42.com/projects/ZipFileLayout
             Command line tool for Windows that shows the layout and information of the headers in a zip archive.
             Used when debugging and validating the creation of zip files using MiniZip64


 ZIP App Note  http://www.pkware.com/documents/casestudies/APPNOTE.TXT
               Zip File specification


Notes.
 * To be able to use BZip compression method in zip64.c or unzip64.c the BZIP2 lib is needed and HAVE_BZIP2 need to be defined.

License
----------------------------------------------------------
   Condition of use and distribution are the same than zlib :

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

----------------------------------------------------------

Deleted compat/zlib/contrib/minizip/configure.ac.

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
































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#                                               -*- Autoconf -*-
# Process this file with autoconf to produce a configure script.

AC_INIT([minizip], [1.2.11], [bugzilla.redhat.com])
AC_CONFIG_SRCDIR([minizip.c])
AM_INIT_AUTOMAKE([foreign])
LT_INIT

AC_MSG_CHECKING([whether to build example programs])
AC_ARG_ENABLE([demos], AC_HELP_STRING([--enable-demos], [build example programs]))
AM_CONDITIONAL([COND_DEMOS], [test "$enable_demos" = yes])
if test "$enable_demos" = yes
then
	AC_MSG_RESULT([yes])
else
	AC_MSG_RESULT([no])
fi

case "${host}" in
	*-mingw* | mingw*)
		WIN32="yes"
		;;
	*)
		;;
esac
AM_CONDITIONAL([WIN32], [test "${WIN32}" = "yes"])


AC_SUBST([HAVE_UNISTD_H], [0])
AC_CHECK_HEADER([unistd.h], [HAVE_UNISTD_H=1], [])
AC_CONFIG_FILES([Makefile minizip.pc])
AC_OUTPUT

Deleted compat/zlib/contrib/minizip/crypt.h.

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




































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* crypt.h -- base code for crypt/uncrypt ZIPfile


   Version 1.01e, February 12th, 2005

   Copyright (C) 1998-2005 Gilles Vollant

   This code is a modified version of crypting code in Infozip distribution

   The encryption/decryption parts of this source code (as opposed to the
   non-echoing password parts) were originally written in Europe.  The
   whole source package can be freely distributed, including from the USA.
   (Prior to January 2000, re-export from the US was a violation of US law.)

   This encryption code is a direct transcription of the algorithm from
   Roger Schlafly, described by Phil Katz in the file appnote.txt.  This
   file (appnote.txt) is distributed with the PKZIP program (even in the
   version without encryption capabilities).

   If you don't need crypting in your application, just define symbols
   NOCRYPT and NOUNCRYPT.

   This code support the "Traditional PKWARE Encryption".

   The new AES encryption added on Zip format by Winzip (see the page
   http://www.winzip.com/aes_info.htm ) and PKWare PKZip 5.x Strong
   Encryption is not supported.
*/

#define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8))

/***********************************************************************
 * Return the next byte in the pseudo-random sequence
 */
static int decrypt_byte(unsigned long* pkeys, const z_crc_t* pcrc_32_tab)
{
    unsigned temp;  /* POTENTIAL BUG:  temp*(temp^1) may overflow in an
                     * unpredictable manner on 16-bit systems; not a problem
                     * with any known compiler so far, though */
    (void)pcrc_32_tab;

    temp = ((unsigned)(*(pkeys+2)) & 0xffff) | 2;
    return (int)(((temp * (temp ^ 1)) >> 8) & 0xff);
}

/***********************************************************************
 * Update the encryption keys with the next byte of plain text
 */
static int update_keys(unsigned long* pkeys,const z_crc_t* pcrc_32_tab,int c)
{
    (*(pkeys+0)) = CRC32((*(pkeys+0)), c);
    (*(pkeys+1)) += (*(pkeys+0)) & 0xff;
    (*(pkeys+1)) = (*(pkeys+1)) * 134775813L + 1;
    {
      int keyshift = (int)((*(pkeys+1)) >> 24);
      (*(pkeys+2)) = CRC32((*(pkeys+2)), keyshift);
    }
    return c;
}


/***********************************************************************
 * Initialize the encryption keys and the random header according to
 * the given password.
 */
static void init_keys(const char* passwd,unsigned long* pkeys,const z_crc_t* pcrc_32_tab)
{
    *(pkeys+0) = 305419896L;
    *(pkeys+1) = 591751049L;
    *(pkeys+2) = 878082192L;
    while (*passwd != '\0') {
        update_keys(pkeys,pcrc_32_tab,(int)*passwd);
        passwd++;
    }
}

#define zdecode(pkeys,pcrc_32_tab,c) \
    (update_keys(pkeys,pcrc_32_tab,c ^= decrypt_byte(pkeys,pcrc_32_tab)))

#define zencode(pkeys,pcrc_32_tab,c,t) \
    (t=decrypt_byte(pkeys,pcrc_32_tab), update_keys(pkeys,pcrc_32_tab,c), t^(c))

#ifdef INCLUDECRYPTINGCODE_IFCRYPTALLOWED

#define RAND_HEAD_LEN  12
   /* "last resort" source for second part of crypt seed pattern */
#  ifndef ZCR_SEED2
#    define ZCR_SEED2 3141592654UL     /* use PI as default pattern */
#  endif

static int crypthead(const char* passwd,      /* password string */
                     unsigned char* buf,      /* where to write header */
                     int bufSize,
                     unsigned long* pkeys,
                     const z_crc_t* pcrc_32_tab,
                     unsigned long crcForCrypting)
{
    int n;                       /* index in random header */
    int t;                       /* temporary */
    int c;                       /* random byte */
    unsigned char header[RAND_HEAD_LEN-2]; /* random header */
    static unsigned calls = 0;   /* ensure different random header each time */

    if (bufSize<RAND_HEAD_LEN)
      return 0;

    /* First generate RAND_HEAD_LEN-2 random bytes. We encrypt the
     * output of rand() to get less predictability, since rand() is
     * often poorly implemented.
     */
    if (++calls == 1)
    {
        srand((unsigned)(time(NULL) ^ ZCR_SEED2));
    }
    init_keys(passwd, pkeys, pcrc_32_tab);
    for (n = 0; n < RAND_HEAD_LEN-2; n++)
    {
        c = (rand() >> 7) & 0xff;
        header[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, c, t);
    }
    /* Encrypt random header (last two bytes is high word of crc) */
    init_keys(passwd, pkeys, pcrc_32_tab);
    for (n = 0; n < RAND_HEAD_LEN-2; n++)
    {
        buf[n] = (unsigned char)zencode(pkeys, pcrc_32_tab, header[n], t);
    }
    buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 16) & 0xff, t);
    buf[n++] = (unsigned char)zencode(pkeys, pcrc_32_tab, (int)(crcForCrypting >> 24) & 0xff, t);
    return n;
}

#endif

Deleted compat/zlib/contrib/minizip/ioapi.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251



























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* ioapi.h -- IO base function header for compress/uncompress .zip
   part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications for Zip64 support
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

         For more info read MiniZip_info.txt

*/

#if defined(_WIN32) && (!(defined(_CRT_SECURE_NO_WARNINGS)))
        #define _CRT_SECURE_NO_WARNINGS
#endif

#if defined(_WIN32)
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) _ftelli64(stream)
#define FSEEKO_FUNC(stream, offset, origin) _fseeki64(stream, offset, origin)
#elif defined(__APPLE__) || defined(IOAPI_NO_64)
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
#else
#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
#define FTELLO_FUNC(stream) ftello64(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
#endif


#include "ioapi.h"

voidpf call_zopen64 (const zlib_filefunc64_32_def* pfilefunc,const void*filename,int mode)
{
    if (pfilefunc->zfile_func64.zopen64_file != NULL)
        return (*(pfilefunc->zfile_func64.zopen64_file)) (pfilefunc->zfile_func64.opaque,filename,mode);
    else
    {
        return (*(pfilefunc->zopen32_file))(pfilefunc->zfile_func64.opaque,(const char*)filename,mode);
    }
}

long call_zseek64 (const zlib_filefunc64_32_def* pfilefunc,voidpf filestream, ZPOS64_T offset, int origin)
{
    if (pfilefunc->zfile_func64.zseek64_file != NULL)
        return (*(pfilefunc->zfile_func64.zseek64_file)) (pfilefunc->zfile_func64.opaque,filestream,offset,origin);
    else
    {
        uLong offsetTruncated = (uLong)offset;
        if (offsetTruncated != offset)
            return -1;
        else
            return (*(pfilefunc->zseek32_file))(pfilefunc->zfile_func64.opaque,filestream,offsetTruncated,origin);
    }
}

ZPOS64_T call_ztell64 (const zlib_filefunc64_32_def* pfilefunc,voidpf filestream)
{
    if (pfilefunc->zfile_func64.zseek64_file != NULL)
        return (*(pfilefunc->zfile_func64.ztell64_file)) (pfilefunc->zfile_func64.opaque,filestream);
    else
    {
        uLong tell_uLong = (*(pfilefunc->ztell32_file))(pfilefunc->zfile_func64.opaque,filestream);
        if ((tell_uLong) == MAXU32)
            return (ZPOS64_T)-1;
        else
            return tell_uLong;
    }
}

void fill_zlib_filefunc64_32_def_from_filefunc32(zlib_filefunc64_32_def* p_filefunc64_32,const zlib_filefunc_def* p_filefunc32)
{
    p_filefunc64_32->zfile_func64.zopen64_file = NULL;
    p_filefunc64_32->zopen32_file = p_filefunc32->zopen_file;
    p_filefunc64_32->zfile_func64.zerror_file = p_filefunc32->zerror_file;
    p_filefunc64_32->zfile_func64.zread_file = p_filefunc32->zread_file;
    p_filefunc64_32->zfile_func64.zwrite_file = p_filefunc32->zwrite_file;
    p_filefunc64_32->zfile_func64.ztell64_file = NULL;
    p_filefunc64_32->zfile_func64.zseek64_file = NULL;
    p_filefunc64_32->zfile_func64.zclose_file = p_filefunc32->zclose_file;
    p_filefunc64_32->zfile_func64.zerror_file = p_filefunc32->zerror_file;
    p_filefunc64_32->zfile_func64.opaque = p_filefunc32->opaque;
    p_filefunc64_32->zseek32_file = p_filefunc32->zseek_file;
    p_filefunc64_32->ztell32_file = p_filefunc32->ztell_file;
}



static voidpf  ZCALLBACK fopen_file_func OF((voidpf opaque, const char* filename, int mode));
static uLong   ZCALLBACK fread_file_func OF((voidpf opaque, voidpf stream, void* buf, uLong size));
static uLong   ZCALLBACK fwrite_file_func OF((voidpf opaque, voidpf stream, const void* buf,uLong size));
static ZPOS64_T ZCALLBACK ftell64_file_func OF((voidpf opaque, voidpf stream));
static long    ZCALLBACK fseek64_file_func OF((voidpf opaque, voidpf stream, ZPOS64_T offset, int origin));
static int     ZCALLBACK fclose_file_func OF((voidpf opaque, voidpf stream));
static int     ZCALLBACK ferror_file_func OF((voidpf opaque, voidpf stream));

static voidpf ZCALLBACK fopen_file_func (voidpf opaque, const char* filename, int mode)
{
    FILE* file = NULL;
    const char* mode_fopen = NULL;
    if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ)
        mode_fopen = "rb";
    else
    if (mode & ZLIB_FILEFUNC_MODE_EXISTING)
        mode_fopen = "r+b";
    else
    if (mode & ZLIB_FILEFUNC_MODE_CREATE)
        mode_fopen = "wb";

    if ((filename!=NULL) && (mode_fopen != NULL))
        file = fopen(filename, mode_fopen);
    return file;
}

static voidpf ZCALLBACK fopen64_file_func (voidpf opaque, const void* filename, int mode)
{
    FILE* file = NULL;
    const char* mode_fopen = NULL;
    if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ)
        mode_fopen = "rb";
    else
    if (mode & ZLIB_FILEFUNC_MODE_EXISTING)
        mode_fopen = "r+b";
    else
    if (mode & ZLIB_FILEFUNC_MODE_CREATE)
        mode_fopen = "wb";

    if ((filename!=NULL) && (mode_fopen != NULL))
        file = FOPEN_FUNC((const char*)filename, mode_fopen);
    return file;
}


static uLong ZCALLBACK fread_file_func (voidpf opaque, voidpf stream, void* buf, uLong size)
{
    uLong ret;
    ret = (uLong)fread(buf, 1, (size_t)size, (FILE *)stream);
    return ret;
}

static uLong ZCALLBACK fwrite_file_func (voidpf opaque, voidpf stream, const void* buf, uLong size)
{
    uLong ret;
    ret = (uLong)fwrite(buf, 1, (size_t)size, (FILE *)stream);
    return ret;
}

static long ZCALLBACK ftell_file_func (voidpf opaque, voidpf stream)
{
    long ret;
    ret = ftell((FILE *)stream);
    return ret;
}


static ZPOS64_T ZCALLBACK ftell64_file_func (voidpf opaque, voidpf stream)
{
    ZPOS64_T ret;
    ret = FTELLO_FUNC((FILE *)stream);
    return ret;
}

static long ZCALLBACK fseek_file_func (voidpf  opaque, voidpf stream, uLong offset, int origin)
{
    int fseek_origin=0;
    long ret;
    switch (origin)
    {
    case ZLIB_FILEFUNC_SEEK_CUR :
        fseek_origin = SEEK_CUR;
        break;
    case ZLIB_FILEFUNC_SEEK_END :
        fseek_origin = SEEK_END;
        break;
    case ZLIB_FILEFUNC_SEEK_SET :
        fseek_origin = SEEK_SET;
        break;
    default: return -1;
    }
    ret = 0;
    if (fseek((FILE *)stream, offset, fseek_origin) != 0)
        ret = -1;
    return ret;
}

static long ZCALLBACK fseek64_file_func (voidpf  opaque, voidpf stream, ZPOS64_T offset, int origin)
{
    int fseek_origin=0;
    long ret;
    switch (origin)
    {
    case ZLIB_FILEFUNC_SEEK_CUR :
        fseek_origin = SEEK_CUR;
        break;
    case ZLIB_FILEFUNC_SEEK_END :
        fseek_origin = SEEK_END;
        break;
    case ZLIB_FILEFUNC_SEEK_SET :
        fseek_origin = SEEK_SET;
        break;
    default: return -1;
    }
    ret = 0;

    if(FSEEKO_FUNC((FILE *)stream, offset, fseek_origin) != 0)
                        ret = -1;

    return ret;
}


static int ZCALLBACK fclose_file_func (voidpf opaque, voidpf stream)
{
    int ret;
    ret = fclose((FILE *)stream);
    return ret;
}

static int ZCALLBACK ferror_file_func (voidpf opaque, voidpf stream)
{
    int ret;
    ret = ferror((FILE *)stream);
    return ret;
}

void fill_fopen_filefunc (pzlib_filefunc_def)
  zlib_filefunc_def* pzlib_filefunc_def;
{
    pzlib_filefunc_def->zopen_file = fopen_file_func;
    pzlib_filefunc_def->zread_file = fread_file_func;
    pzlib_filefunc_def->zwrite_file = fwrite_file_func;
    pzlib_filefunc_def->ztell_file = ftell_file_func;
    pzlib_filefunc_def->zseek_file = fseek_file_func;
    pzlib_filefunc_def->zclose_file = fclose_file_func;
    pzlib_filefunc_def->zerror_file = ferror_file_func;
    pzlib_filefunc_def->opaque = NULL;
}

void fill_fopen64_filefunc (zlib_filefunc64_def*  pzlib_filefunc_def)
{
    pzlib_filefunc_def->zopen64_file = fopen64_file_func;
    pzlib_filefunc_def->zread_file = fread_file_func;
    pzlib_filefunc_def->zwrite_file = fwrite_file_func;
    pzlib_filefunc_def->ztell64_file = ftell64_file_func;
    pzlib_filefunc_def->zseek64_file = fseek64_file_func;
    pzlib_filefunc_def->zclose_file = fclose_file_func;
    pzlib_filefunc_def->zerror_file = ferror_file_func;
    pzlib_filefunc_def->opaque = NULL;
}

Deleted compat/zlib/contrib/minizip/ioapi.h.

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
















































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* ioapi.h -- IO base function header for compress/uncompress .zip
   part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications for Zip64 support
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

         For more info read MiniZip_info.txt

         Changes

    Oct-2009 - Defined ZPOS64_T to fpos_t on windows and u_int64_t on linux. (might need to find a better why for this)
    Oct-2009 - Change to fseeko64, ftello64 and fopen64 so large files would work on linux.
               More if/def section may be needed to support other platforms
    Oct-2009 - Defined fxxxx64 calls to normal fopen/ftell/fseek so they would compile on windows.
                          (but you should use iowin32.c for windows instead)

*/

#ifndef _ZLIBIOAPI64_H
#define _ZLIBIOAPI64_H

#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))

  // Linux needs this to support file operation on files larger then 4+GB
  // But might need better if/def to select just the platforms that needs them.

        #ifndef __USE_FILE_OFFSET64
                #define __USE_FILE_OFFSET64
        #endif
        #ifndef __USE_LARGEFILE64
                #define __USE_LARGEFILE64
        #endif
        #ifndef _LARGEFILE64_SOURCE
                #define _LARGEFILE64_SOURCE
        #endif
        #ifndef _FILE_OFFSET_BIT
                #define _FILE_OFFSET_BIT 64
        #endif

#endif

#include <stdio.h>
#include <stdlib.h>
#include "zlib.h"

#if defined(USE_FILE32API)
#define fopen64 fopen
#define ftello64 ftell
#define fseeko64 fseek
#else
#ifdef __FreeBSD__
#define fopen64 fopen
#define ftello64 ftello
#define fseeko64 fseeko
#endif
#ifdef _MSC_VER
 #define fopen64 fopen
 #if (_MSC_VER >= 1400) && (!(defined(NO_MSCVER_FILE64_FUNC)))
  #define ftello64 _ftelli64
  #define fseeko64 _fseeki64
 #else // old MSC
  #define ftello64 ftell
  #define fseeko64 fseek
 #endif
#endif
#endif

/*
#ifndef ZPOS64_T
  #ifdef _WIN32
                #define ZPOS64_T fpos_t
  #else
    #include <stdint.h>
    #define ZPOS64_T uint64_t
  #endif
#endif
*/

#ifdef HAVE_MINIZIP64_CONF_H
#include "mz64conf.h"
#endif

/* a type choosen by DEFINE */
#ifdef HAVE_64BIT_INT_CUSTOM
typedef  64BIT_INT_CUSTOM_TYPE ZPOS64_T;
#else
#ifdef HAS_STDINT_H
#include "stdint.h"
typedef uint64_t ZPOS64_T;
#else

/* Maximum unsigned 32-bit value used as placeholder for zip64 */
#define MAXU32 0xffffffff

#if defined(_MSC_VER) || defined(__BORLANDC__)
typedef unsigned __int64 ZPOS64_T;
#else
typedef unsigned long long int ZPOS64_T;
#endif
#endif
#endif



#ifdef __cplusplus
extern "C" {
#endif


#define ZLIB_FILEFUNC_SEEK_CUR (1)
#define ZLIB_FILEFUNC_SEEK_END (2)
#define ZLIB_FILEFUNC_SEEK_SET (0)

#define ZLIB_FILEFUNC_MODE_READ      (1)
#define ZLIB_FILEFUNC_MODE_WRITE     (2)
#define ZLIB_FILEFUNC_MODE_READWRITEFILTER (3)

#define ZLIB_FILEFUNC_MODE_EXISTING (4)
#define ZLIB_FILEFUNC_MODE_CREATE   (8)


#ifndef ZCALLBACK
 #if (defined(WIN32) || defined(_WIN32) || defined (WINDOWS) || defined (_WINDOWS)) && defined(CALLBACK) && defined (USEWINDOWS_CALLBACK)
   #define ZCALLBACK CALLBACK
 #else
   #define ZCALLBACK
 #endif
#endif




typedef voidpf   (ZCALLBACK *open_file_func)      OF((voidpf opaque, const char* filename, int mode));
typedef uLong    (ZCALLBACK *read_file_func)      OF((voidpf opaque, voidpf stream, void* buf, uLong size));
typedef uLong    (ZCALLBACK *write_file_func)     OF((voidpf opaque, voidpf stream, const void* buf, uLong size));
typedef int      (ZCALLBACK *close_file_func)     OF((voidpf opaque, voidpf stream));
typedef int      (ZCALLBACK *testerror_file_func) OF((voidpf opaque, voidpf stream));

typedef long     (ZCALLBACK *tell_file_func)      OF((voidpf opaque, voidpf stream));
typedef long     (ZCALLBACK *seek_file_func)      OF((voidpf opaque, voidpf stream, uLong offset, int origin));


/* here is the "old" 32 bits structure structure */
typedef struct zlib_filefunc_def_s
{
    open_file_func      zopen_file;
    read_file_func      zread_file;
    write_file_func     zwrite_file;
    tell_file_func      ztell_file;
    seek_file_func      zseek_file;
    close_file_func     zclose_file;
    testerror_file_func zerror_file;
    voidpf              opaque;
} zlib_filefunc_def;

typedef ZPOS64_T (ZCALLBACK *tell64_file_func)    OF((voidpf opaque, voidpf stream));
typedef long     (ZCALLBACK *seek64_file_func)    OF((voidpf opaque, voidpf stream, ZPOS64_T offset, int origin));
typedef voidpf   (ZCALLBACK *open64_file_func)    OF((voidpf opaque, const void* filename, int mode));

typedef struct zlib_filefunc64_def_s
{
    open64_file_func    zopen64_file;
    read_file_func      zread_file;
    write_file_func     zwrite_file;
    tell64_file_func    ztell64_file;
    seek64_file_func    zseek64_file;
    close_file_func     zclose_file;
    testerror_file_func zerror_file;
    voidpf              opaque;
} zlib_filefunc64_def;

void fill_fopen64_filefunc OF((zlib_filefunc64_def* pzlib_filefunc_def));
void fill_fopen_filefunc OF((zlib_filefunc_def* pzlib_filefunc_def));

/* now internal definition, only for zip.c and unzip.h */
typedef struct zlib_filefunc64_32_def_s
{
    zlib_filefunc64_def zfile_func64;
    open_file_func      zopen32_file;
    tell_file_func      ztell32_file;
    seek_file_func      zseek32_file;
} zlib_filefunc64_32_def;


#define ZREAD64(filefunc,filestream,buf,size)     ((*((filefunc).zfile_func64.zread_file))   ((filefunc).zfile_func64.opaque,filestream,buf,size))
#define ZWRITE64(filefunc,filestream,buf,size)    ((*((filefunc).zfile_func64.zwrite_file))  ((filefunc).zfile_func64.opaque,filestream,buf,size))
//#define ZTELL64(filefunc,filestream)            ((*((filefunc).ztell64_file)) ((filefunc).opaque,filestream))
//#define ZSEEK64(filefunc,filestream,pos,mode)   ((*((filefunc).zseek64_file)) ((filefunc).opaque,filestream,pos,mode))
#define ZCLOSE64(filefunc,filestream)             ((*((filefunc).zfile_func64.zclose_file))  ((filefunc).zfile_func64.opaque,filestream))
#define ZERROR64(filefunc,filestream)             ((*((filefunc).zfile_func64.zerror_file))  ((filefunc).zfile_func64.opaque,filestream))

voidpf call_zopen64 OF((const zlib_filefunc64_32_def* pfilefunc,const void*filename,int mode));
long    call_zseek64 OF((const zlib_filefunc64_32_def* pfilefunc,voidpf filestream, ZPOS64_T offset, int origin));
ZPOS64_T call_ztell64 OF((const zlib_filefunc64_32_def* pfilefunc,voidpf filestream));

void    fill_zlib_filefunc64_32_def_from_filefunc32(zlib_filefunc64_32_def* p_filefunc64_32,const zlib_filefunc_def* p_filefunc32);

#define ZOPEN64(filefunc,filename,mode)         (call_zopen64((&(filefunc)),(filename),(mode)))
#define ZTELL64(filefunc,filestream)            (call_ztell64((&(filefunc)),(filestream)))
#define ZSEEK64(filefunc,filestream,pos,mode)   (call_zseek64((&(filefunc)),(filestream),(pos),(mode)))

#ifdef __cplusplus
}
#endif

#endif

Deleted compat/zlib/contrib/minizip/iowin32.c.

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














































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* iowin32.c -- IO base function header for compress/uncompress .zip
     Version 1.1, February 14h, 2010
     part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications for Zip64 support
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

     For more info read MiniZip_info.txt

*/

#include <stdlib.h>

#include "zlib.h"
#include "ioapi.h"
#include "iowin32.h"

#ifndef INVALID_HANDLE_VALUE
#define INVALID_HANDLE_VALUE (0xFFFFFFFF)
#endif

#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER ((DWORD)-1)
#endif


// see Include/shared/winapifamily.h in the Windows Kit
#if defined(WINAPI_FAMILY_PARTITION) && (!(defined(IOWIN32_USING_WINRT_API)))
#if WINAPI_FAMILY_ONE_PARTITION(WINAPI_FAMILY, WINAPI_PARTITION_APP)
#define IOWIN32_USING_WINRT_API 1
#endif
#endif

voidpf  ZCALLBACK win32_open_file_func  OF((voidpf opaque, const char* filename, int mode));
uLong   ZCALLBACK win32_read_file_func  OF((voidpf opaque, voidpf stream, void* buf, uLong size));
uLong   ZCALLBACK win32_write_file_func OF((voidpf opaque, voidpf stream, const void* buf, uLong size));
ZPOS64_T ZCALLBACK win32_tell64_file_func  OF((voidpf opaque, voidpf stream));
long    ZCALLBACK win32_seek64_file_func  OF((voidpf opaque, voidpf stream, ZPOS64_T offset, int origin));
int     ZCALLBACK win32_close_file_func OF((voidpf opaque, voidpf stream));
int     ZCALLBACK win32_error_file_func OF((voidpf opaque, voidpf stream));

typedef struct
{
    HANDLE hf;
    int error;
} WIN32FILE_IOWIN;


static void win32_translate_open_mode(int mode,
                                      DWORD* lpdwDesiredAccess,
                                      DWORD* lpdwCreationDisposition,
                                      DWORD* lpdwShareMode,
                                      DWORD* lpdwFlagsAndAttributes)
{
    *lpdwDesiredAccess = *lpdwShareMode = *lpdwFlagsAndAttributes = *lpdwCreationDisposition = 0;

    if ((mode & ZLIB_FILEFUNC_MODE_READWRITEFILTER)==ZLIB_FILEFUNC_MODE_READ)
    {
        *lpdwDesiredAccess = GENERIC_READ;
        *lpdwCreationDisposition = OPEN_EXISTING;
        *lpdwShareMode = FILE_SHARE_READ;
    }
    else if (mode & ZLIB_FILEFUNC_MODE_EXISTING)
    {
        *lpdwDesiredAccess = GENERIC_WRITE | GENERIC_READ;
        *lpdwCreationDisposition = OPEN_EXISTING;
    }
    else if (mode & ZLIB_FILEFUNC_MODE_CREATE)
    {
        *lpdwDesiredAccess = GENERIC_WRITE | GENERIC_READ;
        *lpdwCreationDisposition = CREATE_ALWAYS;
    }
}

static voidpf win32_build_iowin(HANDLE hFile)
{
    voidpf ret=NULL;

    if ((hFile != NULL) && (hFile != INVALID_HANDLE_VALUE))
    {
        WIN32FILE_IOWIN w32fiow;
        w32fiow.hf = hFile;
        w32fiow.error = 0;
        ret = malloc(sizeof(WIN32FILE_IOWIN));

        if (ret==NULL)
            CloseHandle(hFile);
        else
            *((WIN32FILE_IOWIN*)ret) = w32fiow;
    }
    return ret;
}

voidpf ZCALLBACK win32_open64_file_func (voidpf opaque,const void* filename,int mode)
{
    const char* mode_fopen = NULL;
    DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
    HANDLE hFile = NULL;

    win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);

#ifdef IOWIN32_USING_WINRT_API
#ifdef UNICODE
    if ((filename!=NULL) && (dwDesiredAccess != 0))
        hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
#else
    if ((filename!=NULL) && (dwDesiredAccess != 0))
    {
        WCHAR filenameW[FILENAME_MAX + 0x200 + 1];
        MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200);
        hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
    }
#endif
#else
    if ((filename!=NULL) && (dwDesiredAccess != 0))
        hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
#endif

    return win32_build_iowin(hFile);
}


voidpf ZCALLBACK win32_open64_file_funcA (voidpf opaque,const void* filename,int mode)
{
    const char* mode_fopen = NULL;
    DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
    HANDLE hFile = NULL;

    win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);

#ifdef IOWIN32_USING_WINRT_API
    if ((filename!=NULL) && (dwDesiredAccess != 0))
    {
        WCHAR filenameW[FILENAME_MAX + 0x200 + 1];
        MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200);
        hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
    }
#else
    if ((filename!=NULL) && (dwDesiredAccess != 0))
        hFile = CreateFileA((LPCSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
#endif

    return win32_build_iowin(hFile);
}


voidpf ZCALLBACK win32_open64_file_funcW (voidpf opaque,const void* filename,int mode)
{
    const char* mode_fopen = NULL;
    DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
    HANDLE hFile = NULL;

    win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);

#ifdef IOWIN32_USING_WINRT_API
    if ((filename!=NULL) && (dwDesiredAccess != 0))
        hFile = CreateFile2((LPCWSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition,NULL);
#else
    if ((filename!=NULL) && (dwDesiredAccess != 0))
        hFile = CreateFileW((LPCWSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
#endif

    return win32_build_iowin(hFile);
}


voidpf ZCALLBACK win32_open_file_func (voidpf opaque,const char* filename,int mode)
{
    const char* mode_fopen = NULL;
    DWORD dwDesiredAccess,dwCreationDisposition,dwShareMode,dwFlagsAndAttributes ;
    HANDLE hFile = NULL;

    win32_translate_open_mode(mode,&dwDesiredAccess,&dwCreationDisposition,&dwShareMode,&dwFlagsAndAttributes);

#ifdef IOWIN32_USING_WINRT_API
#ifdef UNICODE
    if ((filename!=NULL) && (dwDesiredAccess != 0))
        hFile = CreateFile2((LPCTSTR)filename, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
#else
    if ((filename!=NULL) && (dwDesiredAccess != 0))
    {
        WCHAR filenameW[FILENAME_MAX + 0x200 + 1];
        MultiByteToWideChar(CP_ACP,0,(const char*)filename,-1,filenameW,FILENAME_MAX + 0x200);
        hFile = CreateFile2(filenameW, dwDesiredAccess, dwShareMode, dwCreationDisposition, NULL);
    }
#endif
#else
    if ((filename!=NULL) && (dwDesiredAccess != 0))
        hFile = CreateFile((LPCTSTR)filename, dwDesiredAccess, dwShareMode, NULL, dwCreationDisposition, dwFlagsAndAttributes, NULL);
#endif

    return win32_build_iowin(hFile);
}


uLong ZCALLBACK win32_read_file_func (voidpf opaque, voidpf stream, void* buf,uLong size)
{
    uLong ret=0;
    HANDLE hFile = NULL;
    if (stream!=NULL)
        hFile = ((WIN32FILE_IOWIN*)stream) -> hf;

    if (hFile != NULL)
    {
        if (!ReadFile(hFile, buf, size, &ret, NULL))
        {
            DWORD dwErr = GetLastError();
            if (dwErr == ERROR_HANDLE_EOF)
                dwErr = 0;
            ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
        }
    }

    return ret;
}


uLong ZCALLBACK win32_write_file_func (voidpf opaque,voidpf stream,const void* buf,uLong size)
{
    uLong ret=0;
    HANDLE hFile = NULL;
    if (stream!=NULL)
        hFile = ((WIN32FILE_IOWIN*)stream) -> hf;

    if (hFile != NULL)
    {
        if (!WriteFile(hFile, buf, size, &ret, NULL))
        {
            DWORD dwErr = GetLastError();
            if (dwErr == ERROR_HANDLE_EOF)
                dwErr = 0;
            ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
        }
    }

    return ret;
}

static BOOL MySetFilePointerEx(HANDLE hFile, LARGE_INTEGER pos, LARGE_INTEGER *newPos,  DWORD dwMoveMethod)
{
#ifdef IOWIN32_USING_WINRT_API
    return SetFilePointerEx(hFile, pos, newPos, dwMoveMethod);
#else
    LONG lHigh = pos.HighPart;
    DWORD dwNewPos = SetFilePointer(hFile, pos.LowPart, &lHigh, dwMoveMethod);
    BOOL fOk = TRUE;
    if (dwNewPos == 0xFFFFFFFF)
        if (GetLastError() != NO_ERROR)
            fOk = FALSE;
    if ((newPos != NULL) && (fOk))
    {
        newPos->LowPart = dwNewPos;
        newPos->HighPart = lHigh;
    }
    return fOk;
#endif
}

long ZCALLBACK win32_tell_file_func (voidpf opaque,voidpf stream)
{
    long ret=-1;
    HANDLE hFile = NULL;
    if (stream!=NULL)
        hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
    if (hFile != NULL)
    {
        LARGE_INTEGER pos;
        pos.QuadPart = 0;

        if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT))
        {
            DWORD dwErr = GetLastError();
            ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
            ret = -1;
        }
        else
            ret=(long)pos.LowPart;
    }
    return ret;
}

ZPOS64_T ZCALLBACK win32_tell64_file_func (voidpf opaque, voidpf stream)
{
    ZPOS64_T ret= (ZPOS64_T)-1;
    HANDLE hFile = NULL;
    if (stream!=NULL)
        hFile = ((WIN32FILE_IOWIN*)stream)->hf;

    if (hFile)
    {
        LARGE_INTEGER pos;
        pos.QuadPart = 0;

        if (!MySetFilePointerEx(hFile, pos, &pos, FILE_CURRENT))
        {
            DWORD dwErr = GetLastError();
            ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
            ret = (ZPOS64_T)-1;
        }
        else
            ret=pos.QuadPart;
    }
    return ret;
}


long ZCALLBACK win32_seek_file_func (voidpf opaque,voidpf stream,uLong offset,int origin)
{
    DWORD dwMoveMethod=0xFFFFFFFF;
    HANDLE hFile = NULL;

    long ret=-1;
    if (stream!=NULL)
        hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
    switch (origin)
    {
    case ZLIB_FILEFUNC_SEEK_CUR :
        dwMoveMethod = FILE_CURRENT;
        break;
    case ZLIB_FILEFUNC_SEEK_END :
        dwMoveMethod = FILE_END;
        break;
    case ZLIB_FILEFUNC_SEEK_SET :
        dwMoveMethod = FILE_BEGIN;
        break;
    default: return -1;
    }

    if (hFile != NULL)
    {
        LARGE_INTEGER pos;
        pos.QuadPart = offset;
        if (!MySetFilePointerEx(hFile, pos, NULL, dwMoveMethod))
        {
            DWORD dwErr = GetLastError();
            ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
            ret = -1;
        }
        else
            ret=0;
    }
    return ret;
}

long ZCALLBACK win32_seek64_file_func (voidpf opaque, voidpf stream,ZPOS64_T offset,int origin)
{
    DWORD dwMoveMethod=0xFFFFFFFF;
    HANDLE hFile = NULL;
    long ret=-1;

    if (stream!=NULL)
        hFile = ((WIN32FILE_IOWIN*)stream)->hf;

    switch (origin)
    {
        case ZLIB_FILEFUNC_SEEK_CUR :
            dwMoveMethod = FILE_CURRENT;
            break;
        case ZLIB_FILEFUNC_SEEK_END :
            dwMoveMethod = FILE_END;
            break;
        case ZLIB_FILEFUNC_SEEK_SET :
            dwMoveMethod = FILE_BEGIN;
            break;
        default: return -1;
    }

    if (hFile)
    {
        LARGE_INTEGER pos;
        pos.QuadPart = offset;
        if (!MySetFilePointerEx(hFile, pos, NULL, dwMoveMethod))
        {
            DWORD dwErr = GetLastError();
            ((WIN32FILE_IOWIN*)stream) -> error=(int)dwErr;
            ret = -1;
        }
        else
            ret=0;
    }
    return ret;
}

int ZCALLBACK win32_close_file_func (voidpf opaque, voidpf stream)
{
    int ret=-1;

    if (stream!=NULL)
    {
        HANDLE hFile;
        hFile = ((WIN32FILE_IOWIN*)stream) -> hf;
        if (hFile != NULL)
        {
            CloseHandle(hFile);
            ret=0;
        }
        free(stream);
    }
    return ret;
}

int ZCALLBACK win32_error_file_func (voidpf opaque,voidpf stream)
{
    int ret=-1;
    if (stream!=NULL)
    {
        ret = ((WIN32FILE_IOWIN*)stream) -> error;
    }
    return ret;
}

void fill_win32_filefunc (zlib_filefunc_def* pzlib_filefunc_def)
{
    pzlib_filefunc_def->zopen_file = win32_open_file_func;
    pzlib_filefunc_def->zread_file = win32_read_file_func;
    pzlib_filefunc_def->zwrite_file = win32_write_file_func;
    pzlib_filefunc_def->ztell_file = win32_tell_file_func;
    pzlib_filefunc_def->zseek_file = win32_seek_file_func;
    pzlib_filefunc_def->zclose_file = win32_close_file_func;
    pzlib_filefunc_def->zerror_file = win32_error_file_func;
    pzlib_filefunc_def->opaque = NULL;
}

void fill_win32_filefunc64(zlib_filefunc64_def* pzlib_filefunc_def)
{
    pzlib_filefunc_def->zopen64_file = win32_open64_file_func;
    pzlib_filefunc_def->zread_file = win32_read_file_func;
    pzlib_filefunc_def->zwrite_file = win32_write_file_func;
    pzlib_filefunc_def->ztell64_file = win32_tell64_file_func;
    pzlib_filefunc_def->zseek64_file = win32_seek64_file_func;
    pzlib_filefunc_def->zclose_file = win32_close_file_func;
    pzlib_filefunc_def->zerror_file = win32_error_file_func;
    pzlib_filefunc_def->opaque = NULL;
}


void fill_win32_filefunc64A(zlib_filefunc64_def* pzlib_filefunc_def)
{
    pzlib_filefunc_def->zopen64_file = win32_open64_file_funcA;
    pzlib_filefunc_def->zread_file = win32_read_file_func;
    pzlib_filefunc_def->zwrite_file = win32_write_file_func;
    pzlib_filefunc_def->ztell64_file = win32_tell64_file_func;
    pzlib_filefunc_def->zseek64_file = win32_seek64_file_func;
    pzlib_filefunc_def->zclose_file = win32_close_file_func;
    pzlib_filefunc_def->zerror_file = win32_error_file_func;
    pzlib_filefunc_def->opaque = NULL;
}


void fill_win32_filefunc64W(zlib_filefunc64_def* pzlib_filefunc_def)
{
    pzlib_filefunc_def->zopen64_file = win32_open64_file_funcW;
    pzlib_filefunc_def->zread_file = win32_read_file_func;
    pzlib_filefunc_def->zwrite_file = win32_write_file_func;
    pzlib_filefunc_def->ztell64_file = win32_tell64_file_func;
    pzlib_filefunc_def->zseek64_file = win32_seek64_file_func;
    pzlib_filefunc_def->zclose_file = win32_close_file_func;
    pzlib_filefunc_def->zerror_file = win32_error_file_func;
    pzlib_filefunc_def->opaque = NULL;
}

Deleted compat/zlib/contrib/minizip/iowin32.h.

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




























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* iowin32.h -- IO base function header for compress/uncompress .zip
     Version 1.1, February 14h, 2010
     part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications for Zip64 support
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

         For more info read MiniZip_info.txt

*/

#include <windows.h>


#ifdef __cplusplus
extern "C" {
#endif

void fill_win32_filefunc OF((zlib_filefunc_def* pzlib_filefunc_def));
void fill_win32_filefunc64 OF((zlib_filefunc64_def* pzlib_filefunc_def));
void fill_win32_filefunc64A OF((zlib_filefunc64_def* pzlib_filefunc_def));
void fill_win32_filefunc64W OF((zlib_filefunc64_def* pzlib_filefunc_def));

#ifdef __cplusplus
}
#endif

Deleted compat/zlib/contrib/minizip/make_vms.com.

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

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
$ if f$search("ioapi.h_orig") .eqs. "" then copy ioapi.h ioapi.h_orig
$ open/write zdef vmsdefs.h
$ copy sys$input: zdef
$ deck
#define unix
#define fill_zlib_filefunc64_32_def_from_filefunc32 fillzffunc64from
#define Write_Zip64EndOfCentralDirectoryLocator Write_Zip64EoDLocator
#define Write_Zip64EndOfCentralDirectoryRecord Write_Zip64EoDRecord
#define Write_EndOfCentralDirectoryRecord Write_EoDRecord
$ eod
$ close zdef
$ copy vmsdefs.h,ioapi.h_orig ioapi.h
$ cc/include=[--]/prefix=all ioapi.c
$ cc/include=[--]/prefix=all miniunz.c
$ cc/include=[--]/prefix=all unzip.c
$ cc/include=[--]/prefix=all minizip.c
$ cc/include=[--]/prefix=all zip.c
$ link miniunz,unzip,ioapi,[--]libz.olb/lib
$ link minizip,zip,ioapi,[--]libz.olb/lib
$ mcr []minizip test minizip_info.txt
$ mcr []miniunz -l test.zip
$ rename minizip_info.txt; minizip_info.txt_old
$ mcr []miniunz test.zip
$ delete test.zip;*
$exit

Deleted compat/zlib/contrib/minizip/miniunz.c.

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




















































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
   miniunz.c
   Version 1.1, February 14h, 2010
   sample part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications of Unzip for Zip64
         Copyright (C) 2007-2008 Even Rouault

         Modifications for Zip64 support on both zip and unzip
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
*/

#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
        #ifndef __USE_FILE_OFFSET64
                #define __USE_FILE_OFFSET64
        #endif
        #ifndef __USE_LARGEFILE64
                #define __USE_LARGEFILE64
        #endif
        #ifndef _LARGEFILE64_SOURCE
                #define _LARGEFILE64_SOURCE
        #endif
        #ifndef _FILE_OFFSET_BIT
                #define _FILE_OFFSET_BIT 64
        #endif
#endif

#ifdef __APPLE__
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
#else
#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
#define FTELLO_FUNC(stream) ftello64(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
#endif


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <errno.h>
#include <fcntl.h>

#ifdef _WIN32
# include <direct.h>
# include <io.h>
#else
# include <unistd.h>
# include <utime.h>
#endif


#include "unzip.h"

#define CASESENSITIVITY (0)
#define WRITEBUFFERSIZE (8192)
#define MAXFILENAME (256)

#ifdef _WIN32
#define USEWIN32IOAPI
#include "iowin32.h"
#endif
/*
  mini unzip, demo of unzip package

  usage :
  Usage : miniunz [-exvlo] file.zip [file_to_extract] [-d extractdir]

  list the file in the zipfile, and print the content of FILE_ID.ZIP or README.TXT
    if it exists
*/


/* change_file_date : change the date/time of a file
    filename : the filename of the file where date/time must be modified
    dosdate : the new date at the MSDos format (4 bytes)
    tmu_date : the SAME new date at the tm_unz format */
void change_file_date(filename,dosdate,tmu_date)
    const char *filename;
    uLong dosdate;
    tm_unz tmu_date;
{
#ifdef _WIN32
  HANDLE hFile;
  FILETIME ftm,ftLocal,ftCreate,ftLastAcc,ftLastWrite;

  hFile = CreateFileA(filename,GENERIC_READ | GENERIC_WRITE,
                      0,NULL,OPEN_EXISTING,0,NULL);
  GetFileTime(hFile,&ftCreate,&ftLastAcc,&ftLastWrite);
  DosDateTimeToFileTime((WORD)(dosdate>>16),(WORD)dosdate,&ftLocal);
  LocalFileTimeToFileTime(&ftLocal,&ftm);
  SetFileTime(hFile,&ftm,&ftLastAcc,&ftm);
  CloseHandle(hFile);
#else
#if defined(unix) || defined(__APPLE__)
  struct utimbuf ut;
  struct tm newdate;
  newdate.tm_sec = tmu_date.tm_sec;
  newdate.tm_min=tmu_date.tm_min;
  newdate.tm_hour=tmu_date.tm_hour;
  newdate.tm_mday=tmu_date.tm_mday;
  newdate.tm_mon=tmu_date.tm_mon;
  if (tmu_date.tm_year > 1900)
      newdate.tm_year=tmu_date.tm_year - 1900;
  else
      newdate.tm_year=tmu_date.tm_year ;
  newdate.tm_isdst=-1;

  ut.actime=ut.modtime=mktime(&newdate);
  utime(filename,&ut);
#endif
#endif
}


/* mymkdir and change_file_date are not 100 % portable
   As I don't know well Unix, I wait feedback for the unix portion */

int mymkdir(dirname)
    const char* dirname;
{
    int ret=0;
#ifdef _WIN32
    ret = _mkdir(dirname);
#elif unix
    ret = mkdir (dirname,0775);
#elif __APPLE__
    ret = mkdir (dirname,0775);
#endif
    return ret;
}

int makedir (newdir)
    char *newdir;
{
  char *buffer ;
  char *p;
  int  len = (int)strlen(newdir);

  if (len <= 0)
    return 0;

  buffer = (char*)malloc(len+1);
        if (buffer==NULL)
        {
                printf("Error allocating memory\n");
                return UNZ_INTERNALERROR;
        }
  strcpy(buffer,newdir);

  if (buffer[len-1] == '/') {
    buffer[len-1] = '\0';
  }
  if (mymkdir(buffer) == 0)
    {
      free(buffer);
      return 1;
    }

  p = buffer+1;
  while (1)
    {
      char hold;

      while(*p && *p != '\\' && *p != '/')
        p++;
      hold = *p;
      *p = 0;
      if ((mymkdir(buffer) == -1) && (errno == ENOENT))
        {
          printf("couldn't create directory %s\n",buffer);
          free(buffer);
          return 0;
        }
      if (hold == 0)
        break;
      *p++ = hold;
    }
  free(buffer);
  return 1;
}

void do_banner()
{
    printf("MiniUnz 1.01b, demo of zLib + Unz package written by Gilles Vollant\n");
    printf("more info at http://www.winimage.com/zLibDll/unzip.html\n\n");
}

void do_help()
{
    printf("Usage : miniunz [-e] [-x] [-v] [-l] [-o] [-p password] file.zip [file_to_extr.] [-d extractdir]\n\n" \
           "  -e  Extract without pathname (junk paths)\n" \
           "  -x  Extract with pathname\n" \
           "  -v  list files\n" \
           "  -l  list files\n" \
           "  -d  directory to extract into\n" \
           "  -o  overwrite files without prompting\n" \
           "  -p  extract crypted file using password\n\n");
}

void Display64BitsSize(ZPOS64_T n, int size_char)
{
  /* to avoid compatibility problem , we do here the conversion */
  char number[21];
  int offset=19;
  int pos_string = 19;
  number[20]=0;
  for (;;) {
      number[offset]=(char)((n%10)+'0');
      if (number[offset] != '0')
          pos_string=offset;
      n/=10;
      if (offset==0)
          break;
      offset--;
  }
  {
      int size_display_string = 19-pos_string;
      while (size_char > size_display_string)
      {
          size_char--;
          printf(" ");
      }
  }

  printf("%s",&number[pos_string]);
}

int do_list(uf)
    unzFile uf;
{
    uLong i;
    unz_global_info64 gi;
    int err;

    err = unzGetGlobalInfo64(uf,&gi);
    if (err!=UNZ_OK)
        printf("error %d with zipfile in unzGetGlobalInfo \n",err);
    printf("  Length  Method     Size Ratio   Date    Time   CRC-32     Name\n");
    printf("  ------  ------     ---- -----   ----    ----   ------     ----\n");
    for (i=0;i<gi.number_entry;i++)
    {
        char filename_inzip[256];
        unz_file_info64 file_info;
        uLong ratio=0;
        const char *string_method;
        char charCrypt=' ';
        err = unzGetCurrentFileInfo64(uf,&file_info,filename_inzip,sizeof(filename_inzip),NULL,0,NULL,0);
        if (err!=UNZ_OK)
        {
            printf("error %d with zipfile in unzGetCurrentFileInfo\n",err);
            break;
        }
        if (file_info.uncompressed_size>0)
            ratio = (uLong)((file_info.compressed_size*100)/file_info.uncompressed_size);

        /* display a '*' if the file is crypted */
        if ((file_info.flag & 1) != 0)
            charCrypt='*';

        if (file_info.compression_method==0)
            string_method="Stored";
        else
        if (file_info.compression_method==Z_DEFLATED)
        {
            uInt iLevel=(uInt)((file_info.flag & 0x6)/2);
            if (iLevel==0)
              string_method="Defl:N";
            else if (iLevel==1)
              string_method="Defl:X";
            else if ((iLevel==2) || (iLevel==3))
              string_method="Defl:F"; /* 2:fast , 3 : extra fast*/
        }
        else
        if (file_info.compression_method==Z_BZIP2ED)
        {
              string_method="BZip2 ";
        }
        else
            string_method="Unkn. ";

        Display64BitsSize(file_info.uncompressed_size,7);
        printf("  %6s%c",string_method,charCrypt);
        Display64BitsSize(file_info.compressed_size,7);
        printf(" %3lu%%  %2.2lu-%2.2lu-%2.2lu  %2.2lu:%2.2lu  %8.8lx   %s\n",
                ratio,
                (uLong)file_info.tmu_date.tm_mon + 1,
                (uLong)file_info.tmu_date.tm_mday,
                (uLong)file_info.tmu_date.tm_year % 100,
                (uLong)file_info.tmu_date.tm_hour,(uLong)file_info.tmu_date.tm_min,
                (uLong)file_info.crc,filename_inzip);
        if ((i+1)<gi.number_entry)
        {
            err = unzGoToNextFile(uf);
            if (err!=UNZ_OK)
            {
                printf("error %d with zipfile in unzGoToNextFile\n",err);
                break;
            }
        }
    }

    return 0;
}


int do_extract_currentfile(uf,popt_extract_without_path,popt_overwrite,password)
    unzFile uf;
    const int* popt_extract_without_path;
    int* popt_overwrite;
    const char* password;
{
    char filename_inzip[256];
    char* filename_withoutpath;
    char* p;
    int err=UNZ_OK;
    FILE *fout=NULL;
    void* buf;
    uInt size_buf;

    unz_file_info64 file_info;
    uLong ratio=0;
    err = unzGetCurrentFileInfo64(uf,&file_info,filename_inzip,sizeof(filename_inzip),NULL,0,NULL,0);

    if (err!=UNZ_OK)
    {
        printf("error %d with zipfile in unzGetCurrentFileInfo\n",err);
        return err;
    }

    size_buf = WRITEBUFFERSIZE;
    buf = (void*)malloc(size_buf);
    if (buf==NULL)
    {
        printf("Error allocating memory\n");
        return UNZ_INTERNALERROR;
    }

    p = filename_withoutpath = filename_inzip;
    while ((*p) != '\0')
    {
        if (((*p)=='/') || ((*p)=='\\'))
            filename_withoutpath = p+1;
        p++;
    }

    if ((*filename_withoutpath)=='\0')
    {
        if ((*popt_extract_without_path)==0)
        {
            printf("creating directory: %s\n",filename_inzip);
            mymkdir(filename_inzip);
        }
    }
    else
    {
        const char* write_filename;
        int skip=0;

        if ((*popt_extract_without_path)==0)
            write_filename = filename_inzip;
        else
            write_filename = filename_withoutpath;

        err = unzOpenCurrentFilePassword(uf,password);
        if (err!=UNZ_OK)
        {
            printf("error %d with zipfile in unzOpenCurrentFilePassword\n",err);
        }

        if (((*popt_overwrite)==0) && (err==UNZ_OK))
        {
            char rep=0;
            FILE* ftestexist;
            ftestexist = FOPEN_FUNC(write_filename,"rb");
            if (ftestexist!=NULL)
            {
                fclose(ftestexist);
                do
                {
                    char answer[128];
                    int ret;

                    printf("The file %s exists. Overwrite ? [y]es, [n]o, [A]ll: ",write_filename);
                    ret = scanf("%1s",answer);
                    if (ret != 1)
                    {
                       exit(EXIT_FAILURE);
                    }
                    rep = answer[0] ;
                    if ((rep>='a') && (rep<='z'))
                        rep -= 0x20;
                }
                while ((rep!='Y') && (rep!='N') && (rep!='A'));
            }

            if (rep == 'N')
                skip = 1;

            if (rep == 'A')
                *popt_overwrite=1;
        }

        if ((skip==0) && (err==UNZ_OK))
        {
            fout=FOPEN_FUNC(write_filename,"wb");
            /* some zipfile don't contain directory alone before file */
            if ((fout==NULL) && ((*popt_extract_without_path)==0) &&
                                (filename_withoutpath!=(char*)filename_inzip))
            {
                char c=*(filename_withoutpath-1);
                *(filename_withoutpath-1)='\0';
                makedir(write_filename);
                *(filename_withoutpath-1)=c;
                fout=FOPEN_FUNC(write_filename,"wb");
            }

            if (fout==NULL)
            {
                printf("error opening %s\n",write_filename);
            }
        }

        if (fout!=NULL)
        {
            printf(" extracting: %s\n",write_filename);

            do
            {
                err = unzReadCurrentFile(uf,buf,size_buf);
                if (err<0)
                {
                    printf("error %d with zipfile in unzReadCurrentFile\n",err);
                    break;
                }
                if (err>0)
                    if (fwrite(buf,err,1,fout)!=1)
                    {
                        printf("error in writing extracted file\n");
                        err=UNZ_ERRNO;
                        break;
                    }
            }
            while (err>0);
            if (fout)
                    fclose(fout);

            if (err==0)
                change_file_date(write_filename,file_info.dosDate,
                                 file_info.tmu_date);
        }

        if (err==UNZ_OK)
        {
            err = unzCloseCurrentFile (uf);
            if (err!=UNZ_OK)
            {
                printf("error %d with zipfile in unzCloseCurrentFile\n",err);
            }
        }
        else
            unzCloseCurrentFile(uf); /* don't lose the error */
    }

    free(buf);
    return err;
}


int do_extract(uf,opt_extract_without_path,opt_overwrite,password)
    unzFile uf;
    int opt_extract_without_path;
    int opt_overwrite;
    const char* password;
{
    uLong i;
    unz_global_info64 gi;
    int err;
    FILE* fout=NULL;

    err = unzGetGlobalInfo64(uf,&gi);
    if (err!=UNZ_OK)
        printf("error %d with zipfile in unzGetGlobalInfo \n",err);

    for (i=0;i<gi.number_entry;i++)
    {
        if (do_extract_currentfile(uf,&opt_extract_without_path,
                                      &opt_overwrite,
                                      password) != UNZ_OK)
            break;

        if ((i+1)<gi.number_entry)
        {
            err = unzGoToNextFile(uf);
            if (err!=UNZ_OK)
            {
                printf("error %d with zipfile in unzGoToNextFile\n",err);
                break;
            }
        }
    }

    return 0;
}

int do_extract_onefile(uf,filename,opt_extract_without_path,opt_overwrite,password)
    unzFile uf;
    const char* filename;
    int opt_extract_without_path;
    int opt_overwrite;
    const char* password;
{
    int err = UNZ_OK;
    if (unzLocateFile(uf,filename,CASESENSITIVITY)!=UNZ_OK)
    {
        printf("file %s not found in the zipfile\n",filename);
        return 2;
    }

    if (do_extract_currentfile(uf,&opt_extract_without_path,
                                      &opt_overwrite,
                                      password) == UNZ_OK)
        return 0;
    else
        return 1;
}


int main(argc,argv)
    int argc;
    char *argv[];
{
    const char *zipfilename=NULL;
    const char *filename_to_extract=NULL;
    const char *password=NULL;
    char filename_try[MAXFILENAME+16] = "";
    int i;
    int ret_value=0;
    int opt_do_list=0;
    int opt_do_extract=1;
    int opt_do_extract_withoutpath=0;
    int opt_overwrite=0;
    int opt_extractdir=0;
    const char *dirname=NULL;
    unzFile uf=NULL;

    do_banner();
    if (argc==1)
    {
        do_help();
        return 0;
    }
    else
    {
        for (i=1;i<argc;i++)
        {
            if ((*argv[i])=='-')
            {
                const char *p=argv[i]+1;

                while ((*p)!='\0')
                {
                    char c=*(p++);;
                    if ((c=='l') || (c=='L'))
                        opt_do_list = 1;
                    if ((c=='v') || (c=='V'))
                        opt_do_list = 1;
                    if ((c=='x') || (c=='X'))
                        opt_do_extract = 1;
                    if ((c=='e') || (c=='E'))
                        opt_do_extract = opt_do_extract_withoutpath = 1;
                    if ((c=='o') || (c=='O'))
                        opt_overwrite=1;
                    if ((c=='d') || (c=='D'))
                    {
                        opt_extractdir=1;
                        dirname=argv[i+1];
                    }

                    if (((c=='p') || (c=='P')) && (i+1<argc))
                    {
                        password=argv[i+1];
                        i++;
                    }
                }
            }
            else
            {
                if (zipfilename == NULL)
                    zipfilename = argv[i];
                else if ((filename_to_extract==NULL) && (!opt_extractdir))
                        filename_to_extract = argv[i] ;
            }
        }
    }

    if (zipfilename!=NULL)
    {

#        ifdef USEWIN32IOAPI
        zlib_filefunc64_def ffunc;
#        endif

        strncpy(filename_try, zipfilename,MAXFILENAME-1);
        /* strncpy doesnt append the trailing NULL, of the string is too long. */
        filename_try[ MAXFILENAME ] = '\0';

#        ifdef USEWIN32IOAPI
        fill_win32_filefunc64A(&ffunc);
        uf = unzOpen2_64(zipfilename,&ffunc);
#        else
        uf = unzOpen64(zipfilename);
#        endif
        if (uf==NULL)
        {
            strcat(filename_try,".zip");
#            ifdef USEWIN32IOAPI
            uf = unzOpen2_64(filename_try,&ffunc);
#            else
            uf = unzOpen64(filename_try);
#            endif
        }
    }

    if (uf==NULL)
    {
        printf("Cannot open %s or %s.zip\n",zipfilename,zipfilename);
        return 1;
    }
    printf("%s opened\n",filename_try);

    if (opt_do_list==1)
        ret_value = do_list(uf);
    else if (opt_do_extract==1)
    {
#ifdef _WIN32
        if (opt_extractdir && _chdir(dirname))
#else
        if (opt_extractdir && chdir(dirname))
#endif
        {
          printf("Error changing into %s, aborting\n", dirname);
          exit(-1);
        }

        if (filename_to_extract == NULL)
            ret_value = do_extract(uf, opt_do_extract_withoutpath, opt_overwrite, password);
        else
            ret_value = do_extract_onefile(uf, filename_to_extract, opt_do_extract_withoutpath, opt_overwrite, password);
    }

    unzClose(uf);

    return ret_value;
}

Deleted compat/zlib/contrib/minizip/miniunzip.1.

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































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
.\"                                      Hey, EMACS: -*- nroff -*-
.TH miniunzip 1 "Nov 7, 2001"
.\" Please adjust this date whenever revising the manpage.
.\"
.\" Some roff macros, for reference:
.\" .nh        disable hyphenation
.\" .hy        enable hyphenation
.\" .ad l      left justify
.\" .ad b      justify to both left and right margins
.\" .nf        disable filling
.\" .fi        enable filling
.\" .br        insert line break
.\" .sp <n>    insert n+1 empty lines
.\" for manpage-specific macros, see man(7)
.SH NAME
miniunzip - uncompress and examine ZIP archives
.SH SYNOPSIS
.B miniunzip
.RI [ -exvlo ]
zipfile [ files_to_extract ] [-d tempdir]
.SH DESCRIPTION
.B minizip
is a simple tool which allows the extraction of compressed file
archives in the ZIP format used by the MS-DOS utility PKZIP.  It was
written as a demonstration of the
.IR zlib (3)
library and therefore lack many of the features of the
.IR unzip (1)
program.
.SH OPTIONS
A number of options are supported.  With the exception of
.BI \-d\  tempdir
these must be supplied before any
other arguments and are:
.TP
.BI \-l\ ,\ \-\-v
List the files in the archive without extracting them.
.TP
.B \-o
Overwrite files without prompting for confirmation.
.TP
.B \-x
Extract files (default).
.PP
The
.I zipfile
argument is the name of the archive to process. The next argument can be used
to specify a single file to extract from the archive.

Lastly, the following option can be specified at the end of the command-line:
.TP
.BI \-d\  tempdir
Extract the archive in the directory
.I tempdir
rather than the current directory.
.SH SEE ALSO
.BR minizip (1),
.BR zlib (3),
.BR unzip (1).
.SH AUTHOR
This program was written by Gilles Vollant.  This manual page was
written by Mark Brown <broonie@sirena.org.uk>. The -d tempdir option
was added by Dirk Eddelbuettel <edd@debian.org>.

Deleted compat/zlib/contrib/minizip/minizip.1.

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














































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
.\"                                      Hey, EMACS: -*- nroff -*-
.TH minizip 1 "May 2, 2001"
.\" Please adjust this date whenever revising the manpage.
.\"
.\" Some roff macros, for reference:
.\" .nh        disable hyphenation
.\" .hy        enable hyphenation
.\" .ad l      left justify
.\" .ad b      justify to both left and right margins
.\" .nf        disable filling
.\" .fi        enable filling
.\" .br        insert line break
.\" .sp <n>    insert n+1 empty lines
.\" for manpage-specific macros, see man(7)
.SH NAME
minizip - create ZIP archives
.SH SYNOPSIS
.B minizip
.RI [ -o ]
zipfile [ " files" ... ]
.SH DESCRIPTION
.B minizip
is a simple tool which allows the creation of compressed file archives
in the ZIP format used by the MS-DOS utility PKZIP.  It was written as
a demonstration of the
.IR zlib (3)
library and therefore lack many of the features of the
.IR zip (1)
program.
.SH OPTIONS
The first argument supplied is the name of the ZIP archive to create or
.RI -o
in which case it is ignored and the second argument treated as the
name of the ZIP file.  If the ZIP file already exists it will be
overwritten.
.PP
Subsequent arguments specify a list of files to place in the ZIP
archive.  If none are specified then an empty archive will be created.
.SH SEE ALSO
.BR miniunzip (1),
.BR zlib (3),
.BR zip (1).
.SH AUTHOR
This program was written by Gilles Vollant.  This manual page was
written by Mark Brown <broonie@sirena.org.uk>.

Deleted compat/zlib/contrib/minizip/minizip.c.

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


















































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
   minizip.c
   Version 1.1, February 14h, 2010
   sample part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications of Unzip for Zip64
         Copyright (C) 2007-2008 Even Rouault

         Modifications for Zip64 support on both zip and unzip
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
*/

#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
        #ifndef __USE_FILE_OFFSET64
                #define __USE_FILE_OFFSET64
        #endif
        #ifndef __USE_LARGEFILE64
                #define __USE_LARGEFILE64
        #endif
        #ifndef _LARGEFILE64_SOURCE
                #define _LARGEFILE64_SOURCE
        #endif
        #ifndef _FILE_OFFSET_BIT
                #define _FILE_OFFSET_BIT 64
        #endif
#endif

#if defined(_WIN32)
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) _ftelli64(stream)
#define FSEEKO_FUNC(stream, offset, origin) _fseeki64(stream, offset, origin)
#elif defined(__APPLE__) || defined(IOAPI_NO_64)
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko(stream, offset, origin)
#else
#define FOPEN_FUNC(filename, mode) fopen64(filename, mode)
#define FTELLO_FUNC(stream) ftello64(stream)
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
#endif

#include "tinydir.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <errno.h>
#include <fcntl.h>

#ifdef _WIN32
# include <direct.h>
# include <io.h>
#else
# include <unistd.h>
# include <utime.h>
# include <sys/types.h>
# include <sys/stat.h>
#endif

#include "zip.h"

#ifdef _WIN32
        #define USEWIN32IOAPI
        #include "iowin32.h"
#endif



#define WRITEBUFFERSIZE (16384)
#define MAXFILENAME (256)

#ifdef _WIN32
uLong filetime(f, tmzip, dt)
    const char *f;         /* name of file to get info on */
    tm_zip *tmzip;         /* return value: access, modific. and creation times */
    uLong *dt;             /* dostime */
{
  int ret = 0;
  {
      FILETIME ftLocal;
      HANDLE hFind;
      WIN32_FIND_DATAA ff32;

      hFind = FindFirstFileA(f,&ff32);
      if (hFind != INVALID_HANDLE_VALUE)
      {
        FileTimeToLocalFileTime(&(ff32.ftLastWriteTime),&ftLocal);
        FileTimeToDosDateTime(&ftLocal,((LPWORD)dt)+1,((LPWORD)dt)+0);
        FindClose(hFind);
        ret = 1;
      }
  }
  return ret;
}
#else
#if defined(unix) || defined(__APPLE__)
uLong filetime(f, tmzip, dt)
    const char *f;         /* name of file to get info on */
    tm_zip *tmzip;         /* return value: access, modific. and creation times */
    uLong *dt;             /* dostime */
{
  int ret=0;
  struct stat s;        /* results of stat() */
  struct tm* filedate;
  time_t tm_t=0;

  if (strcmp(f,"-")!=0)
  {
    char name[MAXFILENAME+1];
    int len = strlen(f);
    if (len > MAXFILENAME)
      len = MAXFILENAME;

    strncpy(name, f,MAXFILENAME-1);
    /* strncpy doesnt append the trailing NULL, of the string is too long. */
    name[ MAXFILENAME ] = '\0';

    if (name[len - 1] == '/')
      name[len - 1] = '\0';
    /* not all systems allow stat'ing a file with / appended */
    if (stat(name,&s)==0)
    {
      tm_t = s.st_mtime;
      ret = 1;
    }
  }
  filedate = localtime(&tm_t);

  tmzip->tm_sec  = filedate->tm_sec;
  tmzip->tm_min  = filedate->tm_min;
  tmzip->tm_hour = filedate->tm_hour;
  tmzip->tm_mday = filedate->tm_mday;
  tmzip->tm_mon  = filedate->tm_mon ;
  tmzip->tm_year = filedate->tm_year;

  return ret;
}
#else
uLong filetime(f, tmzip, dt)
    const char *f;         /* name of file to get info on */
    tm_zip *tmzip;         /* return value: access, modific. and creation times */
    uLong *dt;             /* dostime */
{
    return 0;
}
#endif
#endif




int check_exist_file(filename)
    const char* filename;
{
    FILE* ftestexist;
    int ret = 1;
    ftestexist = FOPEN_FUNC(filename,"rb");
    if (ftestexist==NULL)
        ret = 0;
    else
        fclose(ftestexist);
    return ret;
}

void do_banner()
{
    printf("MiniZip 1.1, demo of zLib + MiniZip64 package, written by Gilles Vollant\n");
    printf("more info on MiniZip at http://www.winimage.com/zLibDll/minizip.html\n\n");
}

void do_help()
{
    printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \
           "  -r  Scan directories recursively\n" \
           "  -o  Overwrite existing file.zip\n" \
           "  -a  Append to existing file.zip\n" \
           "  -0  Store only\n" \
           "  -1  Compress faster\n" \
           "  -9  Compress better\n\n" \
           "  -j  exclude path. store only the file name.\n\n");
}

/* calculate the CRC32 of a file,
   because to encrypt a file, we need known the CRC32 of the file before */
int getFileCrc(const char* filenameinzip,void*buf,unsigned long size_buf,unsigned long* result_crc)
{
   unsigned long calculate_crc=0;
   int err=ZIP_OK;
   FILE * fin = FOPEN_FUNC(filenameinzip,"rb");

   unsigned long size_read = 0;
   unsigned long total_read = 0;
   if (fin==NULL)
   {
       err = ZIP_ERRNO;
   }

    if (err == ZIP_OK)
        do
        {
            err = ZIP_OK;
            size_read = (int)fread(buf,1,size_buf,fin);
            if (size_read < size_buf)
                if (feof(fin)==0)
            {
                printf("error in reading %s\n",filenameinzip);
                err = ZIP_ERRNO;
            }

            if (size_read>0)
                calculate_crc = crc32(calculate_crc,buf,size_read);
            total_read += size_read;

        } while ((err == ZIP_OK) && (size_read>0));

    if (fin)
        fclose(fin);

    *result_crc=calculate_crc;
    printf("file %s crc %lx\n", filenameinzip, calculate_crc);
    return err;
}

int isLargeFile(const char* filename)
{
  int largeFile = 0;
  ZPOS64_T pos = 0;
  FILE* pFile = FOPEN_FUNC(filename, "rb");

  if(pFile != NULL)
  {
    int n = FSEEKO_FUNC(pFile, 0, SEEK_END);
    pos = FTELLO_FUNC(pFile);

                printf("File : %s is %lld bytes\n", filename, pos);

    if(pos >= 0xffffffff)
     largeFile = 1;

                fclose(pFile);
  }

 return largeFile;
}

void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    FILE * fin;
    int size_read;
    const char *savefilenameinzip;
    zip_fileinfo zi;
    unsigned long crcFile=0;
    int zip64 = 0;
    int err=0;
    int size_buf=WRITEBUFFERSIZE;
    unsigned char buf[WRITEBUFFERSIZE];
    zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
    zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
    zi.dosDate = 0;
    zi.internal_fa = 0;
    zi.external_fa = 0;
    filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);

/*
    err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
                     NULL,0,NULL,0,NULL / * comment * /,
                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
                     opt_compress_level);
*/
    if ((password != NULL) && (err==ZIP_OK))
        err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);

    zip64 = isLargeFile(filenameinzip);

   /* The path name saved, should not include a leading slash. */
   /*if it did, windows/xp and dynazip couldn't read the zip file. */
     savefilenameinzip = filenameinzip;
     while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
     {
         savefilenameinzip++;
     }

     /*should the zip file contain any path at all?*/
     if( opt_exclude_path )
     {
         const char *tmpptr;
         const char *lastslash = 0;
         for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
         {
             if( *tmpptr == '\\' || *tmpptr == '/')
             {
                 lastslash = tmpptr;
             }
         }
         if( lastslash != NULL )
         {
             savefilenameinzip = lastslash+1; // base filename follows last slash.
         }
     }

     /**/
    err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
                     NULL,0,NULL,0,NULL /* comment*/,
                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
                     opt_compress_level,0,
                     /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
                     -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                     password,crcFile, zip64);

    if (err != ZIP_OK)
        printf("error in opening %s in zipfile\n",filenameinzip);
    else
    {
        fin = FOPEN_FUNC(filenameinzip,"rb");
        if (fin==NULL)
        {
            err=ZIP_ERRNO;
            printf("error in opening %s for reading\n",filenameinzip);
        }
    }

    if (err == ZIP_OK)
        do
        {
            err = ZIP_OK;
            size_read = (int)fread(buf,1,size_buf,fin);
            if (size_read < size_buf)
                if (feof(fin)==0)
            {
                printf("error in reading %s\n",filenameinzip);
                err = ZIP_ERRNO;
            }

            if (size_read>0)
            {
                err = zipWriteInFileInZip (zf,buf,size_read);
                if (err<0)
                {
                    printf("error in writing %s in the zipfile\n",
                                     filenameinzip);
                }

            }
        } while ((err == ZIP_OK) && (size_read>0));

    if (fin)
        fclose(fin);

    if (err<0)
        err=ZIP_ERRNO;
    else
    {
        err = zipCloseFileInZip(zf);
        if (err!=ZIP_OK)
            printf("error in closing %s in the zipfile\n",
                        filenameinzip);
    }
}


void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
    tinydir_dir dir;
    int i;
    char newname[512];

    tinydir_open_sorted(&dir, filenameinzip);

    for (i = 0; i < dir.n_files; i++)
    {
        tinydir_file file;
        tinydir_readfile_n(&dir, &file, i);
        if(strcmp(file.name,".")==0) continue;
        if(strcmp(file.name,"..")==0) continue;
        sprintf(newname,"%s/%s",dir.path,file.name);
        if (file.is_dir)
        {
            addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        } else {
            addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
        }
    }

    tinydir_close(&dir);
}


int main(argc,argv)
    int argc;
    char *argv[];
{
    int i;
    int opt_recursive=0;
    int opt_overwrite=1;
    int opt_compress_level=Z_DEFAULT_COMPRESSION;
    int opt_exclude_path=0;
    int zipfilenamearg = 0;
    char filename_try[MAXFILENAME+16];
    int zipok;
    int err=0;
    int size_buf=0;
    void* buf=NULL;
    const char* password=NULL;


    do_banner();
    if (argc==1)
    {
        do_help();
        return 0;
    }
    else
    {
        for (i=1;i<argc;i++)
        {
            if ((*argv[i])=='-')
            {
                const char *p=argv[i]+1;

                while ((*p)!='\0')
                {
                    char c=*(p++);;
                    if ((c=='o') || (c=='O'))
                        opt_overwrite = 1;
                    if ((c=='a') || (c=='A'))
                        opt_overwrite = 2;
                    if ((c>='0') && (c<='9'))
                        opt_compress_level = c-'0';
                    if ((c=='j') || (c=='J'))
                        opt_exclude_path = 1;
                    if ((c=='r') || (c=='R'))
                        opt_recursive = 1;
                    if (((c=='p') || (c=='P')) && (i+1<argc))
                    {
                        password=argv[i+1];
                        i++;
                    }
                }
            }
            else
            {
                if (zipfilenamearg == 0)
                {
                    zipfilenamearg = i ;
                }
            }
        }
    }

    size_buf = WRITEBUFFERSIZE;
    buf = (void*)malloc(size_buf);
    if (buf==NULL)
    {
        printf("Error allocating memory\n");
        return ZIP_INTERNALERROR;
    }

    if (zipfilenamearg==0)
    {
        zipok=0;
    }
    else
    {
        int i,len;
        int dot_found=0;

        zipok = 1 ;
        strncpy(filename_try, argv[zipfilenamearg],MAXFILENAME-1);
        /* strncpy doesnt append the trailing NULL, of the string is too long. */
        filename_try[ MAXFILENAME ] = '\0';

        len=(int)strlen(filename_try);
        for (i=0;i<len;i++)
            if (filename_try[i]=='.')
                dot_found=1;

        if (dot_found==0)
            strcat(filename_try,".zip");

        if (opt_overwrite==2)
        {
            /* if the file don't exist, we not append file */
            if (check_exist_file(filename_try)==0)
                opt_overwrite=1;
        }
        else
        if (opt_overwrite==0)
            if (check_exist_file(filename_try)!=0)
            {
                char rep=0;
                do
                {
                    char answer[128];
                    int ret;
                    printf("The file %s exists. Overwrite ? [y]es, [n]o, [a]ppend : ",filename_try);
                    ret = scanf("%1s",answer);
                    if (ret != 1)
                    {
                       exit(EXIT_FAILURE);
                    }
                    rep = answer[0] ;
                    if ((rep>='a') && (rep<='z'))
                        rep -= 0x20;
                }
                while ((rep!='Y') && (rep!='N') && (rep!='A'));
                if (rep=='N')
                    zipok = 0;
                if (rep=='A')
                    opt_overwrite = 2;
            }
    }

    if (zipok==1)
    {
        zipFile zf;
        int errclose;
#        ifdef USEWIN32IOAPI
        zlib_filefunc64_def ffunc;
        fill_win32_filefunc64A(&ffunc);
        zf = zipOpen2_64(filename_try,(opt_overwrite==2) ? 2 : 0,NULL,&ffunc);
#        else
        zf = zipOpen64(filename_try,(opt_overwrite==2) ? 2 : 0);
#        endif

        if (zf == NULL)
        {
            printf("error opening %s\n",filename_try);
            err= ZIP_ERRNO;
        }
        else
            printf("creating %s\n",filename_try);

        for (i=zipfilenamearg+1;(i<argc) && (err==ZIP_OK);i++)
        {
            if (!((((*(argv[i]))=='-') || ((*(argv[i]))=='/')) &&
                  ((argv[i][1]=='o') || (argv[i][1]=='O') ||
                   (argv[i][1]=='a') || (argv[i][1]=='A') ||
                   (argv[i][1]=='p') || (argv[i][1]=='P') ||
                   (argv[i][1]=='r') || (argv[i][1]=='R') ||
                   ((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
                  (strlen(argv[i]) == 2)))
            {
                if(opt_recursive) {
                    addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
                } else {
                    addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
                }
            }
        }
        errclose = zipClose(zf,NULL);
        if (errclose != ZIP_OK)
            printf("error in closing %s\n",filename_try);
    }
    else
    {
       do_help();
    }

    free(buf);
    return 0;
}

Deleted compat/zlib/contrib/minizip/minizip.pc.in.

1
2
3
4
5
6
7
8
9
10
11
12












-
-
-
-
-
-
-
-
-
-
-
-
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@/minizip

Name: minizip
Description: Minizip zip file manipulation library
Requires:
Version: @PACKAGE_VERSION@
Libs: -L${libdir} -lminizip
Libs.private: -lz
Cflags: -I${includedir}

Deleted compat/zlib/contrib/minizip/mztools.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291



































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
  Additional tools for Minizip
  Code: Xavier Roche '2004
  License: Same as ZLIB (www.gzip.org)
*/

/* Code */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "zlib.h"
#include "unzip.h"

#define READ_8(adr)  ((unsigned char)*(adr))
#define READ_16(adr) ( READ_8(adr) | (READ_8(adr+1) << 8) )
#define READ_32(adr) ( READ_16(adr) | (READ_16((adr)+2) << 16) )

#define WRITE_8(buff, n) do { \
  *((unsigned char*)(buff)) = (unsigned char) ((n) & 0xff); \
} while(0)
#define WRITE_16(buff, n) do { \
  WRITE_8((unsigned char*)(buff), n); \
  WRITE_8(((unsigned char*)(buff)) + 1, (n) >> 8); \
} while(0)
#define WRITE_32(buff, n) do { \
  WRITE_16((unsigned char*)(buff), (n) & 0xffff); \
  WRITE_16((unsigned char*)(buff) + 2, (n) >> 16); \
} while(0)

extern int ZEXPORT unzRepair(file, fileOut, fileOutTmp, nRecovered, bytesRecovered)
const char* file;
const char* fileOut;
const char* fileOutTmp;
uLong* nRecovered;
uLong* bytesRecovered;
{
  int err = Z_OK;
  FILE* fpZip = fopen(file, "rb");
  FILE* fpOut = fopen(fileOut, "wb");
  FILE* fpOutCD = fopen(fileOutTmp, "wb");
  if (fpZip != NULL &&  fpOut != NULL) {
    int entries = 0;
    uLong totalBytes = 0;
    char header[30];
    char filename[1024];
    char extra[1024];
    int offset = 0;
    int offsetCD = 0;
    while ( fread(header, 1, 30, fpZip) == 30 ) {
      int currentOffset = offset;

      /* File entry */
      if (READ_32(header) == 0x04034b50) {
        unsigned int version = READ_16(header + 4);
        unsigned int gpflag = READ_16(header + 6);
        unsigned int method = READ_16(header + 8);
        unsigned int filetime = READ_16(header + 10);
        unsigned int filedate = READ_16(header + 12);
        unsigned int crc = READ_32(header + 14); /* crc */
        unsigned int cpsize = READ_32(header + 18); /* compressed size */
        unsigned int uncpsize = READ_32(header + 22); /* uncompressed sz */
        unsigned int fnsize = READ_16(header + 26); /* file name length */
        unsigned int extsize = READ_16(header + 28); /* extra field length */
        filename[0] = extra[0] = '\0';

        /* Header */
        if (fwrite(header, 1, 30, fpOut) == 30) {
          offset += 30;
        } else {
          err = Z_ERRNO;
          break;
        }

        /* Filename */
        if (fnsize > 0) {
          if (fnsize < sizeof(filename)) {
            if (fread(filename, 1, fnsize, fpZip) == fnsize) {
                if (fwrite(filename, 1, fnsize, fpOut) == fnsize) {
                offset += fnsize;
              } else {
                err = Z_ERRNO;
                break;
              }
            } else {
              err = Z_ERRNO;
              break;
            }
          } else {
            err = Z_ERRNO;
            break;
          }
        } else {
          err = Z_STREAM_ERROR;
          break;
        }

        /* Extra field */
        if (extsize > 0) {
          if (extsize < sizeof(extra)) {
            if (fread(extra, 1, extsize, fpZip) == extsize) {
              if (fwrite(extra, 1, extsize, fpOut) == extsize) {
                offset += extsize;
                } else {
                err = Z_ERRNO;
                break;
              }
            } else {
              err = Z_ERRNO;
              break;
            }
          } else {
            err = Z_ERRNO;
            break;
          }
        }

        /* Data */
        {
          int dataSize = cpsize;
          if (dataSize == 0) {
            dataSize = uncpsize;
          }
          if (dataSize > 0) {
            char* data = malloc(dataSize);
            if (data != NULL) {
              if ((int)fread(data, 1, dataSize, fpZip) == dataSize) {
                if ((int)fwrite(data, 1, dataSize, fpOut) == dataSize) {
                  offset += dataSize;
                  totalBytes += dataSize;
                } else {
                  err = Z_ERRNO;
                }
              } else {
                err = Z_ERRNO;
              }
              free(data);
              if (err != Z_OK) {
                break;
              }
            } else {
              err = Z_MEM_ERROR;
              break;
            }
          }
        }

        /* Central directory entry */
        {
          char header[46];
          char* comment = "";
          int comsize = (int) strlen(comment);
          WRITE_32(header, 0x02014b50);
          WRITE_16(header + 4, version);
          WRITE_16(header + 6, version);
          WRITE_16(header + 8, gpflag);
          WRITE_16(header + 10, method);
          WRITE_16(header + 12, filetime);
          WRITE_16(header + 14, filedate);
          WRITE_32(header + 16, crc);
          WRITE_32(header + 20, cpsize);
          WRITE_32(header + 24, uncpsize);
          WRITE_16(header + 28, fnsize);
          WRITE_16(header + 30, extsize);
          WRITE_16(header + 32, comsize);
          WRITE_16(header + 34, 0);     /* disk # */
          WRITE_16(header + 36, 0);     /* int attrb */
          WRITE_32(header + 38, 0);     /* ext attrb */
          WRITE_32(header + 42, currentOffset);
          /* Header */
          if (fwrite(header, 1, 46, fpOutCD) == 46) {
            offsetCD += 46;

            /* Filename */
            if (fnsize > 0) {
              if (fwrite(filename, 1, fnsize, fpOutCD) == fnsize) {
                offsetCD += fnsize;
              } else {
                err = Z_ERRNO;
                break;
              }
            } else {
              err = Z_STREAM_ERROR;
              break;
            }

            /* Extra field */
            if (extsize > 0) {
              if (fwrite(extra, 1, extsize, fpOutCD) == extsize) {
                offsetCD += extsize;
              } else {
                err = Z_ERRNO;
                break;
              }
            }

            /* Comment field */
            if (comsize > 0) {
              if ((int)fwrite(comment, 1, comsize, fpOutCD) == comsize) {
                offsetCD += comsize;
              } else {
                err = Z_ERRNO;
                break;
              }
            }


          } else {
            err = Z_ERRNO;
            break;
          }
        }

        /* Success */
        entries++;

      } else {
        break;
      }
    }

    /* Final central directory  */
    {
      int entriesZip = entries;
      char header[22];
      char* comment = ""; // "ZIP File recovered by zlib/minizip/mztools";
      int comsize = (int) strlen(comment);
      if (entriesZip > 0xffff) {
        entriesZip = 0xffff;
      }
      WRITE_32(header, 0x06054b50);
      WRITE_16(header + 4, 0);    /* disk # */
      WRITE_16(header + 6, 0);    /* disk # */
      WRITE_16(header + 8, entriesZip);   /* hack */
      WRITE_16(header + 10, entriesZip);  /* hack */
      WRITE_32(header + 12, offsetCD);    /* size of CD */
      WRITE_32(header + 16, offset);      /* offset to CD */
      WRITE_16(header + 20, comsize);     /* comment */

      /* Header */
      if (fwrite(header, 1, 22, fpOutCD) == 22) {

        /* Comment field */
        if (comsize > 0) {
          if ((int)fwrite(comment, 1, comsize, fpOutCD) != comsize) {
            err = Z_ERRNO;
          }
        }

      } else {
        err = Z_ERRNO;
      }
    }

    /* Final merge (file + central directory) */
    fclose(fpOutCD);
    if (err == Z_OK) {
      fpOutCD = fopen(fileOutTmp, "rb");
      if (fpOutCD != NULL) {
        int nRead;
        char buffer[8192];
        while ( (nRead = (int)fread(buffer, 1, sizeof(buffer), fpOutCD)) > 0) {
          if ((int)fwrite(buffer, 1, nRead, fpOut) != nRead) {
            err = Z_ERRNO;
            break;
          }
        }
        fclose(fpOutCD);
      }
    }

    /* Close */
    fclose(fpZip);
    fclose(fpOut);

    /* Wipe temporary file */
    (void)remove(fileOutTmp);

    /* Number of recovered entries */
    if (err == Z_OK) {
      if (nRecovered != NULL) {
        *nRecovered = entries;
      }
      if (bytesRecovered != NULL) {
        *bytesRecovered = totalBytes;
      }
    }
  } else {
    err = Z_STREAM_ERROR;
  }
  return err;
}

Deleted compat/zlib/contrib/minizip/mztools.h.

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





































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
  Additional tools for Minizip
  Code: Xavier Roche '2004
  License: Same as ZLIB (www.gzip.org)
*/

#ifndef _zip_tools_H
#define _zip_tools_H

#ifdef __cplusplus
extern "C" {
#endif

#ifndef _ZLIB_H
#include "zlib.h"
#endif

#include "unzip.h"

/* Repair a ZIP file (missing central directory)
   file: file to recover
   fileOut: output file after recovery
   fileOutTmp: temporary file name used for recovery
*/
extern int ZEXPORT unzRepair(const char* file,
                             const char* fileOut,
                             const char* fileOutTmp,
                             uLong* nRecovered,
                             uLong* bytesRecovered);


#ifdef __cplusplus
}
#endif


#endif

Deleted compat/zlib/contrib/minizip/tinydir.h.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
















































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
Copyright (c) 2013-2017, tinydir authors:
- Cong Xu
- Lautis Sun
- Baudouin Feildel
- Andargor <andargor@yahoo.com>
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice, this
   list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#ifndef TINYDIR_H
#define TINYDIR_H

#ifdef __cplusplus
extern "C" {
#endif

#if ((defined _UNICODE) && !(defined UNICODE))
#define UNICODE
#endif

#if ((defined UNICODE) && !(defined _UNICODE))
#define _UNICODE
#endif

#include <errno.h>
#include <stdlib.h>
#include <string.h>
#ifdef _MSC_VER
# define WIN32_LEAN_AND_MEAN
# include <windows.h>
# include <tchar.h>
# pragma warning(push)
# pragma warning (disable : 4996)
#else
# include <dirent.h>
# include <libgen.h>
# include <sys/stat.h>
# include <stddef.h>
#endif
#ifdef __MINGW32__
# include <tchar.h>
#endif


/* types */

/* Windows UNICODE wide character support */
#if defined _MSC_VER || defined __MINGW32__
# define _tinydir_char_t TCHAR
# define TINYDIR_STRING(s) _TEXT(s)
# define _tinydir_strlen _tcslen
# define _tinydir_strcpy _tcscpy
# define _tinydir_strcat _tcscat
# define _tinydir_strcmp _tcscmp
# define _tinydir_strrchr _tcsrchr
# define _tinydir_strncmp _tcsncmp
#else
# define _tinydir_char_t char
# define TINYDIR_STRING(s) s
# define _tinydir_strlen strlen
# define _tinydir_strcpy strcpy
# define _tinydir_strcat strcat
# define _tinydir_strcmp strcmp
# define _tinydir_strrchr strrchr
# define _tinydir_strncmp strncmp
#endif

#if (defined _MSC_VER || defined __MINGW32__)
# include <windows.h>
# define _TINYDIR_PATH_MAX MAX_PATH
#elif defined  __linux__
# include <limits.h>
# define _TINYDIR_PATH_MAX PATH_MAX
#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__))
# include <sys/param.h>
# if defined(BSD)
#  include <limits.h>
#  define _TINYDIR_PATH_MAX PATH_MAX
# endif
#endif

#ifndef _TINYDIR_PATH_MAX
#define _TINYDIR_PATH_MAX 4096
#endif

#ifdef _MSC_VER
/* extra chars for the "\\*" mask */
# define _TINYDIR_PATH_EXTRA 2
#else
# define _TINYDIR_PATH_EXTRA 0
#endif

#define _TINYDIR_FILENAME_MAX 256

#if (defined _MSC_VER || defined __MINGW32__)
#define _TINYDIR_DRIVE_MAX 3
#endif

#ifdef _MSC_VER
# define _TINYDIR_FUNC static __inline
#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L
# define _TINYDIR_FUNC static __inline__
#else
# define _TINYDIR_FUNC static inline
#endif

/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */
#ifdef TINYDIR_USE_READDIR_R

/* readdir_r is a POSIX-only function, and may not be available under various
 * environments/settings, e.g. MinGW. Use readdir fallback */
#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\
	_POSIX_SOURCE
# define _TINYDIR_HAS_READDIR_R
#endif
#if _POSIX_C_SOURCE >= 200112L
# define _TINYDIR_HAS_FPATHCONF
# include <unistd.h>
#endif
#if _BSD_SOURCE || _SVID_SOURCE || \
	(_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700)
# define _TINYDIR_HAS_DIRFD
# include <sys/types.h>
#endif
#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\
	defined _PC_NAME_MAX
# define _TINYDIR_USE_FPATHCONF
#endif
#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\
	!(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX)
# define _TINYDIR_USE_READDIR
#endif

/* Use readdir by default */
#else
# define _TINYDIR_USE_READDIR
#endif

/* MINGW32 has two versions of dirent, ASCII and UNICODE*/
#ifndef _MSC_VER
#if (defined __MINGW32__) && (defined _UNICODE)
#define _TINYDIR_DIR _WDIR
#define _tinydir_dirent _wdirent
#define _tinydir_opendir _wopendir
#define _tinydir_readdir _wreaddir
#define _tinydir_closedir _wclosedir
#else
#define _TINYDIR_DIR DIR
#define _tinydir_dirent dirent
#define _tinydir_opendir opendir
#define _tinydir_readdir readdir
#define _tinydir_closedir closedir
#endif
#endif

/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */
#if    defined(_TINYDIR_MALLOC) &&  defined(_TINYDIR_FREE)
#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE)
#else
#error "Either define both alloc and free or none of them!"
#endif

#if !defined(_TINYDIR_MALLOC)
	#define _TINYDIR_MALLOC(_size) malloc(_size)
	#define _TINYDIR_FREE(_ptr)    free(_ptr)
#endif /* !defined(_TINYDIR_MALLOC) */

typedef struct tinydir_file
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	_tinydir_char_t name[_TINYDIR_FILENAME_MAX];
	_tinydir_char_t *extension;
	int is_dir;
	int is_reg;

#ifndef _MSC_VER
#ifdef __MINGW32__
	struct _stat _s;
#else
	struct stat _s;
#endif
#endif
} tinydir_file;

typedef struct tinydir_dir
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	int has_next;
	size_t n_files;

	tinydir_file *_files;
#ifdef _MSC_VER
	HANDLE _h;
	WIN32_FIND_DATA _f;
#else
	_TINYDIR_DIR *_d;
	struct _tinydir_dirent *_e;
#ifndef _TINYDIR_USE_READDIR
	struct _tinydir_dirent *_ep;
#endif
#endif
} tinydir_dir;


/* declarations */

_TINYDIR_FUNC
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path);
_TINYDIR_FUNC
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path);
_TINYDIR_FUNC
void tinydir_close(tinydir_dir *dir);

_TINYDIR_FUNC
int tinydir_next(tinydir_dir *dir);
_TINYDIR_FUNC
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file);
_TINYDIR_FUNC
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i);
_TINYDIR_FUNC
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i);

_TINYDIR_FUNC
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path);
_TINYDIR_FUNC
void _tinydir_get_ext(tinydir_file *file);
_TINYDIR_FUNC
int _tinydir_file_cmp(const void *a, const void *b);
#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
_TINYDIR_FUNC
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp);
#endif
#endif


/* definitions*/

_TINYDIR_FUNC
int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path)
{
#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
	int error;
	int size;	/* using int size */
#endif
#else
	_tinydir_char_t path_buf[_TINYDIR_PATH_MAX];
#endif
	_tinydir_char_t *pathp;

	if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0)
	{
		errno = EINVAL;
		return -1;
	}
	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	/* initialise dir */
	dir->_files = NULL;
#ifdef _MSC_VER
	dir->_h = INVALID_HANDLE_VALUE;
#else
	dir->_d = NULL;
#ifndef _TINYDIR_USE_READDIR
	dir->_ep = NULL;
#endif
#endif
	tinydir_close(dir);

	_tinydir_strcpy(dir->path, path);
	/* Remove trailing slashes */
	pathp = &dir->path[_tinydir_strlen(dir->path) - 1];
	while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/')))
	{
		*pathp = TINYDIR_STRING('\0');
		pathp++;
	}
#ifdef _MSC_VER
	_tinydir_strcpy(path_buf, dir->path);
	_tinydir_strcat(path_buf, TINYDIR_STRING("\\*"));
#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP)
	dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0);
#else
	dir->_h = FindFirstFile(path_buf, &dir->_f);
#endif
	if (dir->_h == INVALID_HANDLE_VALUE)
	{
		errno = ENOENT;
#else
	dir->_d = _tinydir_opendir(path);
	if (dir->_d == NULL)
	{
#endif
		goto bail;
	}

	/* read first file */
	dir->has_next = 1;
#ifndef _MSC_VER
#ifdef _TINYDIR_USE_READDIR
	dir->_e = _tinydir_readdir(dir->_d);
#else
	/* allocate dirent buffer for readdir_r */
	size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */
	if (size == -1) return -1;
	dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size);
	if (dir->_ep == NULL) return -1;

	error = readdir_r(dir->_d, dir->_ep, &dir->_e);
	if (error != 0) return -1;
#endif
	if (dir->_e == NULL)
	{
		dir->has_next = 0;
	}
#endif

	return 0;

bail:
	tinydir_close(dir);
	return -1;
}

_TINYDIR_FUNC
int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path)
{
	/* Count the number of files first, to pre-allocate the files array */
	size_t n_files = 0;
	if (tinydir_open(dir, path) == -1)
	{
		return -1;
	}
	while (dir->has_next)
	{
		n_files++;
		if (tinydir_next(dir) == -1)
		{
			goto bail;
		}
	}
	tinydir_close(dir);

	if (tinydir_open(dir, path) == -1)
	{
		return -1;
	}

	dir->n_files = 0;
	dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files);
	if (dir->_files == NULL)
	{
		goto bail;
	}
	while (dir->has_next)
	{
		tinydir_file *p_file;
		dir->n_files++;

		p_file = &dir->_files[dir->n_files - 1];
		if (tinydir_readfile(dir, p_file) == -1)
		{
			goto bail;
		}

		if (tinydir_next(dir) == -1)
		{
			goto bail;
		}

		/* Just in case the number of files has changed between the first and
		second reads, terminate without writing into unallocated memory */
		if (dir->n_files == n_files)
		{
			break;
		}
	}

	qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp);

	return 0;

bail:
	tinydir_close(dir);
	return -1;
}

_TINYDIR_FUNC
void tinydir_close(tinydir_dir *dir)
{
	if (dir == NULL)
	{
		return;
	}

	memset(dir->path, 0, sizeof(dir->path));
	dir->has_next = 0;
	dir->n_files = 0;
	_TINYDIR_FREE(dir->_files);
	dir->_files = NULL;
#ifdef _MSC_VER
	if (dir->_h != INVALID_HANDLE_VALUE)
	{
		FindClose(dir->_h);
	}
	dir->_h = INVALID_HANDLE_VALUE;
#else
	if (dir->_d)
	{
		_tinydir_closedir(dir->_d);
	}
	dir->_d = NULL;
	dir->_e = NULL;
#ifndef _TINYDIR_USE_READDIR
	_TINYDIR_FREE(dir->_ep);
	dir->_ep = NULL;
#endif
#endif
}

_TINYDIR_FUNC
int tinydir_next(tinydir_dir *dir)
{
	if (dir == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (!dir->has_next)
	{
		errno = ENOENT;
		return -1;
	}

#ifdef _MSC_VER
	if (FindNextFile(dir->_h, &dir->_f) == 0)
#else
#ifdef _TINYDIR_USE_READDIR
	dir->_e = _tinydir_readdir(dir->_d);
#else
	if (dir->_ep == NULL)
	{
		return -1;
	}
	if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0)
	{
		return -1;
	}
#endif
	if (dir->_e == NULL)
#endif
	{
		dir->has_next = 0;
#ifdef _MSC_VER
		if (GetLastError() != ERROR_SUCCESS &&
			GetLastError() != ERROR_NO_MORE_FILES)
		{
			tinydir_close(dir);
			errno = EIO;
			return -1;
		}
#endif
	}

	return 0;
}

_TINYDIR_FUNC
int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file)
{
	if (dir == NULL || file == NULL)
	{
		errno = EINVAL;
		return -1;
	}
#ifdef _MSC_VER
	if (dir->_h == INVALID_HANDLE_VALUE)
#else
	if (dir->_e == NULL)
#endif
	{
		errno = ENOENT;
		return -1;
	}
	if (_tinydir_strlen(dir->path) +
		_tinydir_strlen(
#ifdef _MSC_VER
			dir->_f.cFileName
#else
			dir->_e->d_name
#endif
		) + 1 + _TINYDIR_PATH_EXTRA >=
		_TINYDIR_PATH_MAX)
	{
		/* the path for the file will be too long */
		errno = ENAMETOOLONG;
		return -1;
	}
	if (_tinydir_strlen(
#ifdef _MSC_VER
			dir->_f.cFileName
#else
			dir->_e->d_name
#endif
		) >= _TINYDIR_FILENAME_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	_tinydir_strcpy(file->path, dir->path);
	_tinydir_strcat(file->path, TINYDIR_STRING("/"));
	_tinydir_strcpy(file->name,
#ifdef _MSC_VER
		dir->_f.cFileName
#else
		dir->_e->d_name
#endif
	);
	_tinydir_strcat(file->path, file->name);
#ifndef _MSC_VER
#ifdef __MINGW32__
	if (_tstat(
#else
	if (stat(
#endif
		file->path, &file->_s) == -1)
	{
		return -1;
	}
#endif
	_tinydir_get_ext(file);

	file->is_dir =
#ifdef _MSC_VER
		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
#else
		S_ISDIR(file->_s.st_mode);
#endif
	file->is_reg =
#ifdef _MSC_VER
		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) ||
		(
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) &&
#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) &&
#endif
#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) &&
#endif
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) &&
			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY));
#else
		S_ISREG(file->_s.st_mode);
#endif

	return 0;
}

_TINYDIR_FUNC
int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i)
{
	if (dir == NULL || file == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (i >= dir->n_files)
	{
		errno = ENOENT;
		return -1;
	}

	memcpy(file, &dir->_files[i], sizeof(tinydir_file));
	_tinydir_get_ext(file);

	return 0;
}

_TINYDIR_FUNC
int tinydir_open_subdir_n(tinydir_dir *dir, size_t i)
{
	_tinydir_char_t path[_TINYDIR_PATH_MAX];
	if (dir == NULL)
	{
		errno = EINVAL;
		return -1;
	}
	if (i >= dir->n_files || !dir->_files[i].is_dir)
	{
		errno = ENOENT;
		return -1;
	}

	_tinydir_strcpy(path, dir->_files[i].path);
	tinydir_close(dir);
	if (tinydir_open_sorted(dir, path) == -1)
	{
		return -1;
	}

	return 0;
}

/* Open a single file given its path */
_TINYDIR_FUNC
int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path)
{
	tinydir_dir dir;
	int result = 0;
	int found = 0;
	_tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX];
	_tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX];
	_tinydir_char_t *dir_name;
	_tinydir_char_t *base_name;
#if (defined _MSC_VER || defined __MINGW32__)
	_tinydir_char_t drive_buf[_TINYDIR_PATH_MAX];
	_tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX];
#endif

	if (file == NULL || path == NULL || _tinydir_strlen(path) == 0)
	{
		errno = EINVAL;
		return -1;
	}
	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
	{
		errno = ENAMETOOLONG;
		return -1;
	}

	/* Get the parent path */
#if (defined _MSC_VER || defined __MINGW32__)
#if ((defined _MSC_VER) && (_MSC_VER >= 1400))
		_tsplitpath_s(
			path,
			drive_buf, _TINYDIR_DRIVE_MAX,
			dir_name_buf, _TINYDIR_FILENAME_MAX,
			file_name_buf, _TINYDIR_FILENAME_MAX,
			ext_buf, _TINYDIR_FILENAME_MAX);
#else
		_tsplitpath(
			path,
			drive_buf,
			dir_name_buf,
			file_name_buf,
			ext_buf);
#endif

/* _splitpath_s not work fine with only filename and widechar support */
#ifdef _UNICODE
		if (drive_buf[0] == L'\xFEFE')
			drive_buf[0] = '\0';
		if (dir_name_buf[0] == L'\xFEFE')
			dir_name_buf[0] = '\0';
#endif

	if (errno)
	{
		errno = EINVAL;
		return -1;
	}
	/* Emulate the behavior of dirname by returning "." for dir name if it's
	empty */
	if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0')
	{
		_tinydir_strcpy(dir_name_buf, TINYDIR_STRING("."));
	}
	/* Concatenate the drive letter and dir name to form full dir name */
	_tinydir_strcat(drive_buf, dir_name_buf);
	dir_name = drive_buf;
	/* Concatenate the file name and extension to form base name */
	_tinydir_strcat(file_name_buf, ext_buf);
	base_name = file_name_buf;
#else
	_tinydir_strcpy(dir_name_buf, path);
	dir_name = dirname(dir_name_buf);
	_tinydir_strcpy(file_name_buf, path);
	base_name =basename(file_name_buf);
#endif

	/* Open the parent directory */
	if (tinydir_open(&dir, dir_name) == -1)
	{
		return -1;
	}

	/* Read through the parent directory and look for the file */
	while (dir.has_next)
	{
		if (tinydir_readfile(&dir, file) == -1)
		{
			result = -1;
			goto bail;
		}
		if (_tinydir_strcmp(file->name, base_name) == 0)
		{
			/* File found */
			found = 1;
			break;
		}
		tinydir_next(&dir);
	}
	if (!found)
	{
		result = -1;
		errno = ENOENT;
	}

bail:
	tinydir_close(&dir);
	return result;
}

_TINYDIR_FUNC
void _tinydir_get_ext(tinydir_file *file)
{
	_tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.'));
	if (period == NULL)
	{
		file->extension = &(file->name[_tinydir_strlen(file->name)]);
	}
	else
	{
		file->extension = period + 1;
	}
}

_TINYDIR_FUNC
int _tinydir_file_cmp(const void *a, const void *b)
{
	const tinydir_file *fa = (const tinydir_file *)a;
	const tinydir_file *fb = (const tinydir_file *)b;
	if (fa->is_dir != fb->is_dir)
	{
		return -(fa->is_dir - fb->is_dir);
	}
	return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX);
}

#ifndef _MSC_VER
#ifndef _TINYDIR_USE_READDIR
/*
The following authored by Ben Hutchings <ben@decadent.org.uk>
from https://womble.decadent.org.uk/readdir_r-advisory.html
*/
/* Calculate the required buffer size (in bytes) for directory      *
* entries read from the given directory handle.  Return -1 if this  *
* this cannot be done.                                              *
*                                                                   *
* This code does not trust values of NAME_MAX that are less than    *
* 255, since some systems (including at least HP-UX) incorrectly    *
* define it to be a smaller value.                                  */
_TINYDIR_FUNC
size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp)
{
	long name_max;
	size_t name_end;
	/* parameter may be unused */
	(void)dirp;

#if defined _TINYDIR_USE_FPATHCONF
	name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX);
	if (name_max == -1)
#if defined(NAME_MAX)
		name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
#else
		return (size_t)(-1);
#endif
#elif defined(NAME_MAX)
 	name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
#else
#error "buffer size for readdir_r cannot be determined"
#endif
	name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1;
	return (name_end > sizeof(struct _tinydir_dirent) ?
		name_end : sizeof(struct _tinydir_dirent));
}
#endif
#endif

#ifdef __cplusplus
}
#endif

# if defined (_MSC_VER)
# pragma warning(pop)
# endif

#endif

Deleted compat/zlib/contrib/minizip/unzip.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* unzip.c -- IO for uncompress .zip files using zlib
   Version 1.1, February 14h, 2010
   part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications of Unzip for Zip64
         Copyright (C) 2007-2008 Even Rouault

         Modifications for Zip64 support on both zip and unzip
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

         For more info read MiniZip_info.txt


  ------------------------------------------------------------------------------------
  Decryption code comes from crypt.c by Info-ZIP but has been greatly reduced in terms of
  compatibility with older software. The following is from the original crypt.c.
  Code woven in by Terry Thorsen 1/2003.

  Copyright (c) 1990-2000 Info-ZIP.  All rights reserved.

  See the accompanying file LICENSE, version 2000-Apr-09 or later
  (the contents of which are also included in zip.h) for terms of use.
  If, for some reason, all these files are missing, the Info-ZIP license
  also may be found at:  ftp://ftp.info-zip.org/pub/infozip/license.html

        crypt.c (full version) by Info-ZIP.      Last revised:  [see crypt.h]

  The encryption/decryption parts of this source code (as opposed to the
  non-echoing password parts) were originally written in Europe.  The
  whole source package can be freely distributed, including from the USA.
  (Prior to January 2000, re-export from the US was a violation of US law.)

        This encryption code is a direct transcription of the algorithm from
  Roger Schlafly, described by Phil Katz in the file appnote.txt.  This
  file (appnote.txt) is distributed with the PKZIP program (even in the
  version without encryption capabilities).

        ------------------------------------------------------------------------------------

        Changes in unzip.c

        2007-2008 - Even Rouault - Addition of cpl_unzGetCurrentFileZStreamPos
  2007-2008 - Even Rouault - Decoration of symbol names unz* -> cpl_unz*
  2007-2008 - Even Rouault - Remove old C style function prototypes
  2007-2008 - Even Rouault - Add unzip support for ZIP64

        Copyright (C) 2007-2008 Even Rouault


        Oct-2009 - Mathias Svensson - Removed cpl_* from symbol names (Even Rouault added them but since this is now moved to a new project (minizip64) I renamed them again).
  Oct-2009 - Mathias Svensson - Fixed problem if uncompressed size was > 4G and compressed size was <4G
                                should only read the compressed/uncompressed size from the Zip64 format if
                                the size from normal header was 0xFFFFFFFF
  Oct-2009 - Mathias Svensson - Applied some bug fixes from paches recived from Gilles Vollant
        Oct-2009 - Mathias Svensson - Applied support to unzip files with compression mathod BZIP2 (bzip2 lib is required)
                                Patch created by Daniel Borca

  Jan-2010 - back to unzip and minizip 1.0 name scheme, with compatibility layer

  Copyright (C) 1998 - 2010 Gilles Vollant, Even Rouault, Mathias Svensson

*/


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#ifndef NOUNCRYPT
        #define NOUNCRYPT
#endif

#include "zlib.h"
#include "unzip.h"

#ifdef STDC
#  include <stddef.h>
#  include <string.h>
#  include <stdlib.h>
#endif
#ifdef NO_ERRNO_H
    extern int errno;
#else
#   include <errno.h>
#endif


#ifndef local
#  define local static
#endif
/* compile with -Dlocal if your debugger can't find static symbols */


#ifndef CASESENSITIVITYDEFAULT_NO
#  if !defined(unix) && !defined(CASESENSITIVITYDEFAULT_YES)
#    define CASESENSITIVITYDEFAULT_NO
#  endif
#endif


#ifndef UNZ_BUFSIZE
#define UNZ_BUFSIZE (16384)
#endif

#ifndef UNZ_MAXFILENAMEINZIP
#define UNZ_MAXFILENAMEINZIP (256)
#endif

#ifndef ALLOC
# define ALLOC(size) (malloc(size))
#endif
#ifndef TRYFREE
# define TRYFREE(p) {if (p) free(p);}
#endif

#define SIZECENTRALDIRITEM (0x2e)
#define SIZEZIPLOCALHEADER (0x1e)


const char unz_copyright[] =
   " unzip 1.01 Copyright 1998-2004 Gilles Vollant - http://www.winimage.com/zLibDll";

/* unz_file_info_interntal contain internal info about a file in zipfile*/
typedef struct unz_file_info64_internal_s
{
    ZPOS64_T offset_curfile;/* relative offset of local header 8 bytes */
} unz_file_info64_internal;


/* file_in_zip_read_info_s contain internal information about a file in zipfile,
    when reading and decompress it */
typedef struct
{
    char  *read_buffer;         /* internal buffer for compressed data */
    z_stream stream;            /* zLib stream structure for inflate */

#ifdef HAVE_BZIP2
    bz_stream bstream;          /* bzLib stream structure for bziped */
#endif

    ZPOS64_T pos_in_zipfile;       /* position in byte on the zipfile, for fseek*/
    uLong stream_initialised;   /* flag set if stream structure is initialised*/

    ZPOS64_T offset_local_extrafield;/* offset of the local extra field */
    uInt  size_local_extrafield;/* size of the local extra field */
    ZPOS64_T pos_local_extrafield;   /* position in the local extra field in read*/
    ZPOS64_T total_out_64;

    uLong crc32;                /* crc32 of all data uncompressed */
    uLong crc32_wait;           /* crc32 we must obtain after decompress all */
    ZPOS64_T rest_read_compressed; /* number of byte to be decompressed */
    ZPOS64_T rest_read_uncompressed;/*number of byte to be obtained after decomp*/
    zlib_filefunc64_32_def z_filefunc;
    voidpf filestream;        /* io structore of the zipfile */
    uLong compression_method;   /* compression method (0==store) */
    ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/
    int   raw;
} file_in_zip64_read_info_s;


/* unz64_s contain internal information about the zipfile
*/
typedef struct
{
    zlib_filefunc64_32_def z_filefunc;
    int is64bitOpenFunction;
    voidpf filestream;        /* io structore of the zipfile */
    unz_global_info64 gi;       /* public global information */
    ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/
    ZPOS64_T num_file;             /* number of the current file in the zipfile*/
    ZPOS64_T pos_in_central_dir;   /* pos of the current file in the central dir*/
    ZPOS64_T current_file_ok;      /* flag about the usability of the current file*/
    ZPOS64_T central_pos;          /* position of the beginning of the central dir*/

    ZPOS64_T size_central_dir;     /* size of the central directory  */
    ZPOS64_T offset_central_dir;   /* offset of start of central directory with
                                   respect to the starting disk number */

    unz_file_info64 cur_file_info; /* public info about the current file in zip*/
    unz_file_info64_internal cur_file_info_internal; /* private info about it*/
    file_in_zip64_read_info_s* pfile_in_zip_read; /* structure about the current
                                        file if we are decompressing it */
    int encrypted;

    int isZip64;

#    ifndef NOUNCRYPT
    unsigned long keys[3];     /* keys defining the pseudo-random sequence */
    const z_crc_t* pcrc_32_tab;
#    endif
} unz64_s;


#ifndef NOUNCRYPT
#include "crypt.h"
#endif

/* ===========================================================================
     Read a byte from a gz_stream; update next_in and avail_in. Return EOF
   for end of file.
   IN assertion: the stream s has been successfully opened for reading.
*/


local int unz64local_getByte OF((
    const zlib_filefunc64_32_def* pzlib_filefunc_def,
    voidpf filestream,
    int *pi));

local int unz64local_getByte(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, int *pi)
{
    unsigned char c;
    int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,&c,1);
    if (err==1)
    {
        *pi = (int)c;
        return UNZ_OK;
    }
    else
    {
        if (ZERROR64(*pzlib_filefunc_def,filestream))
            return UNZ_ERRNO;
        else
            return UNZ_EOF;
    }
}


/* ===========================================================================
   Reads a long in LSB order from the given gz_stream. Sets
*/
local int unz64local_getShort OF((
    const zlib_filefunc64_32_def* pzlib_filefunc_def,
    voidpf filestream,
    uLong *pX));

local int unz64local_getShort (const zlib_filefunc64_32_def* pzlib_filefunc_def,
                             voidpf filestream,
                             uLong *pX)
{
    uLong x ;
    int i = 0;
    int err;

    err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x = (uLong)i;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((uLong)i)<<8;

    if (err==UNZ_OK)
        *pX = x;
    else
        *pX = 0;
    return err;
}

local int unz64local_getLong OF((
    const zlib_filefunc64_32_def* pzlib_filefunc_def,
    voidpf filestream,
    uLong *pX));

local int unz64local_getLong (const zlib_filefunc64_32_def* pzlib_filefunc_def,
                            voidpf filestream,
                            uLong *pX)
{
    uLong x ;
    int i = 0;
    int err;

    err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x = (uLong)i;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((uLong)i)<<8;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((uLong)i)<<16;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x += ((uLong)i)<<24;

    if (err==UNZ_OK)
        *pX = x;
    else
        *pX = 0;
    return err;
}

local int unz64local_getLong64 OF((
    const zlib_filefunc64_32_def* pzlib_filefunc_def,
    voidpf filestream,
    ZPOS64_T *pX));


local int unz64local_getLong64 (const zlib_filefunc64_32_def* pzlib_filefunc_def,
                            voidpf filestream,
                            ZPOS64_T *pX)
{
    ZPOS64_T x ;
    int i = 0;
    int err;

    err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x = (ZPOS64_T)i;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((ZPOS64_T)i)<<8;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((ZPOS64_T)i)<<16;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((ZPOS64_T)i)<<24;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((ZPOS64_T)i)<<32;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((ZPOS64_T)i)<<40;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((ZPOS64_T)i)<<48;

    if (err==UNZ_OK)
        err = unz64local_getByte(pzlib_filefunc_def,filestream,&i);
    x |= ((ZPOS64_T)i)<<56;

    if (err==UNZ_OK)
        *pX = x;
    else
        *pX = 0;
    return err;
}

/* My own strcmpi / strcasecmp */
local int strcmpcasenosensitive_internal (const char* fileName1, const char* fileName2)
{
    for (;;)
    {
        char c1=*(fileName1++);
        char c2=*(fileName2++);
        if ((c1>='a') && (c1<='z'))
            c1 -= 0x20;
        if ((c2>='a') && (c2<='z'))
            c2 -= 0x20;
        if (c1=='\0')
            return ((c2=='\0') ? 0 : -1);
        if (c2=='\0')
            return 1;
        if (c1<c2)
            return -1;
        if (c1>c2)
            return 1;
    }
}


#ifdef  CASESENSITIVITYDEFAULT_NO
#define CASESENSITIVITYDEFAULTVALUE 2
#else
#define CASESENSITIVITYDEFAULTVALUE 1
#endif

#ifndef STRCMPCASENOSENTIVEFUNCTION
#define STRCMPCASENOSENTIVEFUNCTION strcmpcasenosensitive_internal
#endif

/*
   Compare two filename (fileName1,fileName2).
   If iCaseSenisivity = 1, comparision is case sensitivity (like strcmp)
   If iCaseSenisivity = 2, comparision is not case sensitivity (like strcmpi
                                                                or strcasecmp)
   If iCaseSenisivity = 0, case sensitivity is defaut of your operating system
        (like 1 on Unix, 2 on Windows)

*/
extern int ZEXPORT unzStringFileNameCompare (const char*  fileName1,
                                                 const char*  fileName2,
                                                 int iCaseSensitivity)

{
    if (iCaseSensitivity==0)
        iCaseSensitivity=CASESENSITIVITYDEFAULTVALUE;

    if (iCaseSensitivity==1)
        return strcmp(fileName1,fileName2);

    return STRCMPCASENOSENTIVEFUNCTION(fileName1,fileName2);
}

#ifndef BUFREADCOMMENT
#define BUFREADCOMMENT (0x400)
#endif

/*
  Locate the Central directory of a zipfile (at the end, just before
    the global comment)
*/
local ZPOS64_T unz64local_SearchCentralDir OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream));
local ZPOS64_T unz64local_SearchCentralDir(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream)
{
    unsigned char* buf;
    ZPOS64_T uSizeFile;
    ZPOS64_T uBackRead;
    ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
    ZPOS64_T uPosFound=0;

    if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
        return 0;


    uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);

    if (uMaxBack>uSizeFile)
        uMaxBack = uSizeFile;

    buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
    if (buf==NULL)
        return 0;

    uBackRead = 4;
    while (uBackRead<uMaxBack)
    {
        uLong uReadSize;
        ZPOS64_T uReadPos ;
        int i;
        if (uBackRead+BUFREADCOMMENT>uMaxBack)
            uBackRead = uMaxBack;
        else
            uBackRead+=BUFREADCOMMENT;
        uReadPos = uSizeFile-uBackRead ;

        uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
                     (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
        if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
            break;

        if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
            break;

        for (i=(int)uReadSize-3; (i--)>0;)
            if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) &&
                ((*(buf+i+2))==0x05) && ((*(buf+i+3))==0x06))
            {
                uPosFound = uReadPos+i;
                break;
            }

        if (uPosFound!=0)
            break;
    }
    TRYFREE(buf);
    return uPosFound;
}


/*
  Locate the Central directory 64 of a zipfile (at the end, just before
    the global comment)
*/
local ZPOS64_T unz64local_SearchCentralDir64 OF((
    const zlib_filefunc64_32_def* pzlib_filefunc_def,
    voidpf filestream));

local ZPOS64_T unz64local_SearchCentralDir64(const zlib_filefunc64_32_def* pzlib_filefunc_def,
                                      voidpf filestream)
{
    unsigned char* buf;
    ZPOS64_T uSizeFile;
    ZPOS64_T uBackRead;
    ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
    ZPOS64_T uPosFound=0;
    uLong uL;
                ZPOS64_T relativeOffset;

    if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
        return 0;


    uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);

    if (uMaxBack>uSizeFile)
        uMaxBack = uSizeFile;

    buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
    if (buf==NULL)
        return 0;

    uBackRead = 4;
    while (uBackRead<uMaxBack)
    {
        uLong uReadSize;
        ZPOS64_T uReadPos;
        int i;
        if (uBackRead+BUFREADCOMMENT>uMaxBack)
            uBackRead = uMaxBack;
        else
            uBackRead+=BUFREADCOMMENT;
        uReadPos = uSizeFile-uBackRead ;

        uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
                     (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
        if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
            break;

        if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
            break;

        for (i=(int)uReadSize-3; (i--)>0;)
            if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) &&
                ((*(buf+i+2))==0x06) && ((*(buf+i+3))==0x07))
            {
                uPosFound = uReadPos+i;
                break;
            }

        if (uPosFound!=0)
            break;
    }
    TRYFREE(buf);
    if (uPosFound == 0)
        return 0;

    /* Zip64 end of central directory locator */
    if (ZSEEK64(*pzlib_filefunc_def,filestream, uPosFound,ZLIB_FILEFUNC_SEEK_SET)!=0)
        return 0;

    /* the signature, already checked */
    if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
        return 0;

    /* number of the disk with the start of the zip64 end of  central directory */
    if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
        return 0;
    if (uL != 0)
        return 0;

    /* relative offset of the zip64 end of central directory record */
    if (unz64local_getLong64(pzlib_filefunc_def,filestream,&relativeOffset)!=UNZ_OK)
        return 0;

    /* total number of disks */
    if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
        return 0;
    if (uL != 1)
        return 0;

    /* Goto end of central directory record */
    if (ZSEEK64(*pzlib_filefunc_def,filestream, relativeOffset,ZLIB_FILEFUNC_SEEK_SET)!=0)
        return 0;

     /* the signature */
    if (unz64local_getLong(pzlib_filefunc_def,filestream,&uL)!=UNZ_OK)
        return 0;

    if (uL != 0x06064b50)
        return 0;

    return relativeOffset;
}

/*
  Open a Zip file. path contain the full pathname (by example,
     on a Windows NT computer "c:\\test\\zlib114.zip" or on an Unix computer
     "zlib/zlib114.zip".
     If the zipfile cannot be opened (file doesn't exist or in not valid), the
       return value is NULL.
     Else, the return value is a unzFile Handle, usable with other function
       of this unzip package.
*/
local unzFile unzOpenInternal (const void *path,
                               zlib_filefunc64_32_def* pzlib_filefunc64_32_def,
                               int is64bitOpenFunction)
{
    unz64_s us;
    unz64_s *s;
    ZPOS64_T central_pos;
    uLong   uL;

    uLong number_disk;          /* number of the current dist, used for
                                   spaning ZIP, unsupported, always 0*/
    uLong number_disk_with_CD;  /* number the the disk with central dir, used
                                   for spaning ZIP, unsupported, always 0*/
    ZPOS64_T number_entry_CD;      /* total number of entries in
                                   the central dir
                                   (same than number_entry on nospan) */

    int err=UNZ_OK;

    if (unz_copyright[0]!=' ')
        return NULL;

    us.z_filefunc.zseek32_file = NULL;
    us.z_filefunc.ztell32_file = NULL;
    if (pzlib_filefunc64_32_def==NULL)
        fill_fopen64_filefunc(&us.z_filefunc.zfile_func64);
    else
        us.z_filefunc = *pzlib_filefunc64_32_def;
    us.is64bitOpenFunction = is64bitOpenFunction;



    us.filestream = ZOPEN64(us.z_filefunc,
                                                 path,
                                                 ZLIB_FILEFUNC_MODE_READ |
                                                 ZLIB_FILEFUNC_MODE_EXISTING);
    if (us.filestream==NULL)
        return NULL;

    central_pos = unz64local_SearchCentralDir64(&us.z_filefunc,us.filestream);
    if (central_pos)
    {
        uLong uS;
        ZPOS64_T uL64;

        us.isZip64 = 1;

        if (ZSEEK64(us.z_filefunc, us.filestream,
                                      central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0)
        err=UNZ_ERRNO;

        /* the signature, already checked */
        if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* size of zip64 end of central directory record */
        if (unz64local_getLong64(&us.z_filefunc, us.filestream,&uL64)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* version made by */
        if (unz64local_getShort(&us.z_filefunc, us.filestream,&uS)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* version needed to extract */
        if (unz64local_getShort(&us.z_filefunc, us.filestream,&uS)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* number of this disk */
        if (unz64local_getLong(&us.z_filefunc, us.filestream,&number_disk)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* number of the disk with the start of the central directory */
        if (unz64local_getLong(&us.z_filefunc, us.filestream,&number_disk_with_CD)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* total number of entries in the central directory on this disk */
        if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.gi.number_entry)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* total number of entries in the central directory */
        if (unz64local_getLong64(&us.z_filefunc, us.filestream,&number_entry_CD)!=UNZ_OK)
            err=UNZ_ERRNO;

        if ((number_entry_CD!=us.gi.number_entry) ||
            (number_disk_with_CD!=0) ||
            (number_disk!=0))
            err=UNZ_BADZIPFILE;

        /* size of the central directory */
        if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.size_central_dir)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* offset of start of central directory with respect to the
          starting disk number */
        if (unz64local_getLong64(&us.z_filefunc, us.filestream,&us.offset_central_dir)!=UNZ_OK)
            err=UNZ_ERRNO;

        us.gi.size_comment = 0;
    }
    else
    {
        central_pos = unz64local_SearchCentralDir(&us.z_filefunc,us.filestream);
        if (central_pos==0)
            err=UNZ_ERRNO;

        us.isZip64 = 0;

        if (ZSEEK64(us.z_filefunc, us.filestream,
                                        central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0)
            err=UNZ_ERRNO;

        /* the signature, already checked */
        if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* number of this disk */
        if (unz64local_getShort(&us.z_filefunc, us.filestream,&number_disk)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* number of the disk with the start of the central directory */
        if (unz64local_getShort(&us.z_filefunc, us.filestream,&number_disk_with_CD)!=UNZ_OK)
            err=UNZ_ERRNO;

        /* total number of entries in the central dir on this disk */
        if (unz64local_getShort(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
            err=UNZ_ERRNO;
        us.gi.number_entry = uL;

        /* total number of entries in the central dir */
        if (unz64local_getShort(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
            err=UNZ_ERRNO;
        number_entry_CD = uL;

        if ((number_entry_CD!=us.gi.number_entry) ||
            (number_disk_with_CD!=0) ||
            (number_disk!=0))
            err=UNZ_BADZIPFILE;

        /* size of the central directory */
        if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
            err=UNZ_ERRNO;
        us.size_central_dir = uL;

        /* offset of start of central directory with respect to the
            starting disk number */
        if (unz64local_getLong(&us.z_filefunc, us.filestream,&uL)!=UNZ_OK)
            err=UNZ_ERRNO;
        us.offset_central_dir = uL;

        /* zipfile comment length */
        if (unz64local_getShort(&us.z_filefunc, us.filestream,&us.gi.size_comment)!=UNZ_OK)
            err=UNZ_ERRNO;
    }

    if ((central_pos<us.offset_central_dir+us.size_central_dir) &&
        (err==UNZ_OK))
        err=UNZ_BADZIPFILE;

    if (err!=UNZ_OK)
    {
        ZCLOSE64(us.z_filefunc, us.filestream);
        return NULL;
    }

    us.byte_before_the_zipfile = central_pos -
                            (us.offset_central_dir+us.size_central_dir);
    us.central_pos = central_pos;
    us.pfile_in_zip_read = NULL;
    us.encrypted = 0;


    s=(unz64_s*)ALLOC(sizeof(unz64_s));
    if( s != NULL)
    {
        *s=us;
        unzGoToFirstFile((unzFile)s);
    }
    return (unzFile)s;
}


extern unzFile ZEXPORT unzOpen2 (const char *path,
                                        zlib_filefunc_def* pzlib_filefunc32_def)
{
    if (pzlib_filefunc32_def != NULL)
    {
        zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
        fill_zlib_filefunc64_32_def_from_filefunc32(&zlib_filefunc64_32_def_fill,pzlib_filefunc32_def);
        return unzOpenInternal(path, &zlib_filefunc64_32_def_fill, 0);
    }
    else
        return unzOpenInternal(path, NULL, 0);
}

extern unzFile ZEXPORT unzOpen2_64 (const void *path,
                                     zlib_filefunc64_def* pzlib_filefunc_def)
{
    if (pzlib_filefunc_def != NULL)
    {
        zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
        zlib_filefunc64_32_def_fill.zfile_func64 = *pzlib_filefunc_def;
        zlib_filefunc64_32_def_fill.ztell32_file = NULL;
        zlib_filefunc64_32_def_fill.zseek32_file = NULL;
        return unzOpenInternal(path, &zlib_filefunc64_32_def_fill, 1);
    }
    else
        return unzOpenInternal(path, NULL, 1);
}

extern unzFile ZEXPORT unzOpen (const char *path)
{
    return unzOpenInternal(path, NULL, 0);
}

extern unzFile ZEXPORT unzOpen64 (const void *path)
{
    return unzOpenInternal(path, NULL, 1);
}

/*
  Close a ZipFile opened with unzOpen.
  If there is files inside the .Zip opened with unzOpenCurrentFile (see later),
    these files MUST be closed with unzCloseCurrentFile before call unzClose.
  return UNZ_OK if there is no problem. */
extern int ZEXPORT unzClose (unzFile file)
{
    unz64_s* s;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;

    if (s->pfile_in_zip_read!=NULL)
        unzCloseCurrentFile(file);

    ZCLOSE64(s->z_filefunc, s->filestream);
    TRYFREE(s);
    return UNZ_OK;
}


/*
  Write info about the ZipFile in the *pglobal_info structure.
  No preparation of the structure is needed
  return UNZ_OK if there is no problem. */
extern int ZEXPORT unzGetGlobalInfo64 (unzFile file, unz_global_info64* pglobal_info)
{
    unz64_s* s;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    *pglobal_info=s->gi;
    return UNZ_OK;
}

extern int ZEXPORT unzGetGlobalInfo (unzFile file, unz_global_info* pglobal_info32)
{
    unz64_s* s;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    /* to do : check if number_entry is not truncated */
    pglobal_info32->number_entry = (uLong)s->gi.number_entry;
    pglobal_info32->size_comment = s->gi.size_comment;
    return UNZ_OK;
}
/*
   Translate date/time from Dos format to tm_unz (readable more easilty)
*/
local void unz64local_DosDateToTmuDate (ZPOS64_T ulDosDate, tm_unz* ptm)
{
    ZPOS64_T uDate;
    uDate = (ZPOS64_T)(ulDosDate>>16);
    ptm->tm_mday = (uInt)(uDate&0x1f) ;
    ptm->tm_mon =  (uInt)((((uDate)&0x1E0)/0x20)-1) ;
    ptm->tm_year = (uInt)(((uDate&0x0FE00)/0x0200)+1980) ;

    ptm->tm_hour = (uInt) ((ulDosDate &0xF800)/0x800);
    ptm->tm_min =  (uInt) ((ulDosDate&0x7E0)/0x20) ;
    ptm->tm_sec =  (uInt) (2*(ulDosDate&0x1f)) ;
}

/*
  Get Info about the current file in the zipfile, with internal only info
*/
local int unz64local_GetCurrentFileInfoInternal OF((unzFile file,
                                                  unz_file_info64 *pfile_info,
                                                  unz_file_info64_internal
                                                  *pfile_info_internal,
                                                  char *szFileName,
                                                  uLong fileNameBufferSize,
                                                  void *extraField,
                                                  uLong extraFieldBufferSize,
                                                  char *szComment,
                                                  uLong commentBufferSize));

local int unz64local_GetCurrentFileInfoInternal (unzFile file,
                                                  unz_file_info64 *pfile_info,
                                                  unz_file_info64_internal
                                                  *pfile_info_internal,
                                                  char *szFileName,
                                                  uLong fileNameBufferSize,
                                                  void *extraField,
                                                  uLong extraFieldBufferSize,
                                                  char *szComment,
                                                  uLong commentBufferSize)
{
    unz64_s* s;
    unz_file_info64 file_info;
    unz_file_info64_internal file_info_internal;
    int err=UNZ_OK;
    uLong uMagic;
    long lSeek=0;
    uLong uL;

    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    if (ZSEEK64(s->z_filefunc, s->filestream,
              s->pos_in_central_dir+s->byte_before_the_zipfile,
              ZLIB_FILEFUNC_SEEK_SET)!=0)
        err=UNZ_ERRNO;


    /* we check the magic */
    if (err==UNZ_OK)
    {
        if (unz64local_getLong(&s->z_filefunc, s->filestream,&uMagic) != UNZ_OK)
            err=UNZ_ERRNO;
        else if (uMagic!=0x02014b50)
            err=UNZ_BADZIPFILE;
    }

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.version) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.version_needed) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.flag) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.compression_method) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.dosDate) != UNZ_OK)
        err=UNZ_ERRNO;

    unz64local_DosDateToTmuDate(file_info.dosDate,&file_info.tmu_date);

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.crc) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
        err=UNZ_ERRNO;
    file_info.compressed_size = uL;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
        err=UNZ_ERRNO;
    file_info.uncompressed_size = uL;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_filename) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_file_extra) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.size_file_comment) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.disk_num_start) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&file_info.internal_fa) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&file_info.external_fa) != UNZ_OK)
        err=UNZ_ERRNO;

                // relative offset of local header
    if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
        err=UNZ_ERRNO;
    file_info_internal.offset_curfile = uL;

    lSeek+=file_info.size_filename;
    if ((err==UNZ_OK) && (szFileName!=NULL))
    {
        uLong uSizeRead ;
        if (file_info.size_filename<fileNameBufferSize)
        {
            *(szFileName+file_info.size_filename)='\0';
            uSizeRead = file_info.size_filename;
        }
        else
            uSizeRead = fileNameBufferSize;

        if ((file_info.size_filename>0) && (fileNameBufferSize>0))
            if (ZREAD64(s->z_filefunc, s->filestream,szFileName,uSizeRead)!=uSizeRead)
                err=UNZ_ERRNO;
        lSeek -= uSizeRead;
    }

    // Read extrafield
    if ((err==UNZ_OK) && (extraField!=NULL))
    {
        ZPOS64_T uSizeRead ;
        if (file_info.size_file_extra<extraFieldBufferSize)
            uSizeRead = file_info.size_file_extra;
        else
            uSizeRead = extraFieldBufferSize;

        if (lSeek!=0)
        {
            if (ZSEEK64(s->z_filefunc, s->filestream,lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0)
                lSeek=0;
            else
                err=UNZ_ERRNO;
        }

        if ((file_info.size_file_extra>0) && (extraFieldBufferSize>0))
            if (ZREAD64(s->z_filefunc, s->filestream,extraField,(uLong)uSizeRead)!=uSizeRead)
                err=UNZ_ERRNO;

        lSeek += file_info.size_file_extra - (uLong)uSizeRead;
    }
    else
        lSeek += file_info.size_file_extra;


    if ((err==UNZ_OK) && (file_info.size_file_extra != 0))
    {
                                uLong acc = 0;

        // since lSeek now points to after the extra field we need to move back
        lSeek -= file_info.size_file_extra;

        if (lSeek!=0)
        {
            if (ZSEEK64(s->z_filefunc, s->filestream,lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0)
                lSeek=0;
            else
                err=UNZ_ERRNO;
        }

        while(acc < file_info.size_file_extra)
        {
            uLong headerId;
                                                uLong dataSize;

            if (unz64local_getShort(&s->z_filefunc, s->filestream,&headerId) != UNZ_OK)
                err=UNZ_ERRNO;

            if (unz64local_getShort(&s->z_filefunc, s->filestream,&dataSize) != UNZ_OK)
                err=UNZ_ERRNO;

            /* ZIP64 extra fields */
            if (headerId == 0x0001)
            {
                                                        uLong uL;

                                                                if(file_info.uncompressed_size == MAXU32)
                                                                {
                                                                        if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info.uncompressed_size) != UNZ_OK)
                                                                                        err=UNZ_ERRNO;
                                                                }

                                                                if(file_info.compressed_size == MAXU32)
                                                                {
                                                                        if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info.compressed_size) != UNZ_OK)
                                                                                  err=UNZ_ERRNO;
                                                                }

                                                                if(file_info_internal.offset_curfile == MAXU32)
                                                                {
                                                                        /* Relative Header offset */
                                                                        if (unz64local_getLong64(&s->z_filefunc, s->filestream,&file_info_internal.offset_curfile) != UNZ_OK)
                                                                                err=UNZ_ERRNO;
                                                                }

                                                                if(file_info.disk_num_start == MAXU32)
                                                                {
                                                                        /* Disk Start Number */
                                                                        if (unz64local_getLong(&s->z_filefunc, s->filestream,&uL) != UNZ_OK)
                                                                                err=UNZ_ERRNO;
                                                                }

            }
            else
            {
                if (ZSEEK64(s->z_filefunc, s->filestream,dataSize,ZLIB_FILEFUNC_SEEK_CUR)!=0)
                    err=UNZ_ERRNO;
            }

            acc += 2 + 2 + dataSize;
        }
    }

    if ((err==UNZ_OK) && (szComment!=NULL))
    {
        uLong uSizeRead ;
        if (file_info.size_file_comment<commentBufferSize)
        {
            *(szComment+file_info.size_file_comment)='\0';
            uSizeRead = file_info.size_file_comment;
        }
        else
            uSizeRead = commentBufferSize;

        if (lSeek!=0)
        {
            if (ZSEEK64(s->z_filefunc, s->filestream,lSeek,ZLIB_FILEFUNC_SEEK_CUR)==0)
                lSeek=0;
            else
                err=UNZ_ERRNO;
        }

        if ((file_info.size_file_comment>0) && (commentBufferSize>0))
            if (ZREAD64(s->z_filefunc, s->filestream,szComment,uSizeRead)!=uSizeRead)
                err=UNZ_ERRNO;
        lSeek+=file_info.size_file_comment - uSizeRead;
    }
    else
        lSeek+=file_info.size_file_comment;


    if ((err==UNZ_OK) && (pfile_info!=NULL))
        *pfile_info=file_info;

    if ((err==UNZ_OK) && (pfile_info_internal!=NULL))
        *pfile_info_internal=file_info_internal;

    return err;
}



/*
  Write info about the ZipFile in the *pglobal_info structure.
  No preparation of the structure is needed
  return UNZ_OK if there is no problem.
*/
extern int ZEXPORT unzGetCurrentFileInfo64 (unzFile file,
                                          unz_file_info64 * pfile_info,
                                          char * szFileName, uLong fileNameBufferSize,
                                          void *extraField, uLong extraFieldBufferSize,
                                          char* szComment,  uLong commentBufferSize)
{
    return unz64local_GetCurrentFileInfoInternal(file,pfile_info,NULL,
                                                szFileName,fileNameBufferSize,
                                                extraField,extraFieldBufferSize,
                                                szComment,commentBufferSize);
}

extern int ZEXPORT unzGetCurrentFileInfo (unzFile file,
                                          unz_file_info * pfile_info,
                                          char * szFileName, uLong fileNameBufferSize,
                                          void *extraField, uLong extraFieldBufferSize,
                                          char* szComment,  uLong commentBufferSize)
{
    int err;
    unz_file_info64 file_info64;
    err = unz64local_GetCurrentFileInfoInternal(file,&file_info64,NULL,
                                                szFileName,fileNameBufferSize,
                                                extraField,extraFieldBufferSize,
                                                szComment,commentBufferSize);
    if ((err==UNZ_OK) && (pfile_info != NULL))
    {
        pfile_info->version = file_info64.version;
        pfile_info->version_needed = file_info64.version_needed;
        pfile_info->flag = file_info64.flag;
        pfile_info->compression_method = file_info64.compression_method;
        pfile_info->dosDate = file_info64.dosDate;
        pfile_info->crc = file_info64.crc;

        pfile_info->size_filename = file_info64.size_filename;
        pfile_info->size_file_extra = file_info64.size_file_extra;
        pfile_info->size_file_comment = file_info64.size_file_comment;

        pfile_info->disk_num_start = file_info64.disk_num_start;
        pfile_info->internal_fa = file_info64.internal_fa;
        pfile_info->external_fa = file_info64.external_fa;

        pfile_info->tmu_date = file_info64.tmu_date,


        pfile_info->compressed_size = (uLong)file_info64.compressed_size;
        pfile_info->uncompressed_size = (uLong)file_info64.uncompressed_size;

    }
    return err;
}
/*
  Set the current file of the zipfile to the first file.
  return UNZ_OK if there is no problem
*/
extern int ZEXPORT unzGoToFirstFile (unzFile file)
{
    int err=UNZ_OK;
    unz64_s* s;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    s->pos_in_central_dir=s->offset_central_dir;
    s->num_file=0;
    err=unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
                                             &s->cur_file_info_internal,
                                             NULL,0,NULL,0,NULL,0);
    s->current_file_ok = (err == UNZ_OK);
    return err;
}

/*
  Set the current file of the zipfile to the next file.
  return UNZ_OK if there is no problem
  return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest.
*/
extern int ZEXPORT unzGoToNextFile (unzFile  file)
{
    unz64_s* s;
    int err;

    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    if (!s->current_file_ok)
        return UNZ_END_OF_LIST_OF_FILE;
    if (s->gi.number_entry != 0xffff)    /* 2^16 files overflow hack */
      if (s->num_file+1==s->gi.number_entry)
        return UNZ_END_OF_LIST_OF_FILE;

    s->pos_in_central_dir += SIZECENTRALDIRITEM + s->cur_file_info.size_filename +
            s->cur_file_info.size_file_extra + s->cur_file_info.size_file_comment ;
    s->num_file++;
    err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
                                               &s->cur_file_info_internal,
                                               NULL,0,NULL,0,NULL,0);
    s->current_file_ok = (err == UNZ_OK);
    return err;
}


/*
  Try locate the file szFileName in the zipfile.
  For the iCaseSensitivity signification, see unzStringFileNameCompare

  return value :
  UNZ_OK if the file is found. It becomes the current file.
  UNZ_END_OF_LIST_OF_FILE if the file is not found
*/
extern int ZEXPORT unzLocateFile (unzFile file, const char *szFileName, int iCaseSensitivity)
{
    unz64_s* s;
    int err;

    /* We remember the 'current' position in the file so that we can jump
     * back there if we fail.
     */
    unz_file_info64 cur_file_infoSaved;
    unz_file_info64_internal cur_file_info_internalSaved;
    ZPOS64_T num_fileSaved;
    ZPOS64_T pos_in_central_dirSaved;


    if (file==NULL)
        return UNZ_PARAMERROR;

    if (strlen(szFileName)>=UNZ_MAXFILENAMEINZIP)
        return UNZ_PARAMERROR;

    s=(unz64_s*)file;
    if (!s->current_file_ok)
        return UNZ_END_OF_LIST_OF_FILE;

    /* Save the current state */
    num_fileSaved = s->num_file;
    pos_in_central_dirSaved = s->pos_in_central_dir;
    cur_file_infoSaved = s->cur_file_info;
    cur_file_info_internalSaved = s->cur_file_info_internal;

    err = unzGoToFirstFile(file);

    while (err == UNZ_OK)
    {
        char szCurrentFileName[UNZ_MAXFILENAMEINZIP+1];
        err = unzGetCurrentFileInfo64(file,NULL,
                                    szCurrentFileName,sizeof(szCurrentFileName)-1,
                                    NULL,0,NULL,0);
        if (err == UNZ_OK)
        {
            if (unzStringFileNameCompare(szCurrentFileName,
                                            szFileName,iCaseSensitivity)==0)
                return UNZ_OK;
            err = unzGoToNextFile(file);
        }
    }

    /* We failed, so restore the state of the 'current file' to where we
     * were.
     */
    s->num_file = num_fileSaved ;
    s->pos_in_central_dir = pos_in_central_dirSaved ;
    s->cur_file_info = cur_file_infoSaved;
    s->cur_file_info_internal = cur_file_info_internalSaved;
    return err;
}


/*
///////////////////////////////////////////
// Contributed by Ryan Haksi (mailto://cryogen@infoserve.net)
// I need random access
//
// Further optimization could be realized by adding an ability
// to cache the directory in memory. The goal being a single
// comprehensive file read to put the file I need in a memory.
*/

/*
typedef struct unz_file_pos_s
{
    ZPOS64_T pos_in_zip_directory;   // offset in file
    ZPOS64_T num_of_file;            // # of file
} unz_file_pos;
*/

extern int ZEXPORT unzGetFilePos64(unzFile file, unz64_file_pos*  file_pos)
{
    unz64_s* s;

    if (file==NULL || file_pos==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    if (!s->current_file_ok)
        return UNZ_END_OF_LIST_OF_FILE;

    file_pos->pos_in_zip_directory  = s->pos_in_central_dir;
    file_pos->num_of_file           = s->num_file;

    return UNZ_OK;
}

extern int ZEXPORT unzGetFilePos(
    unzFile file,
    unz_file_pos* file_pos)
{
    unz64_file_pos file_pos64;
    int err = unzGetFilePos64(file,&file_pos64);
    if (err==UNZ_OK)
    {
        file_pos->pos_in_zip_directory = (uLong)file_pos64.pos_in_zip_directory;
        file_pos->num_of_file = (uLong)file_pos64.num_of_file;
    }
    return err;
}

extern int ZEXPORT unzGoToFilePos64(unzFile file, const unz64_file_pos* file_pos)
{
    unz64_s* s;
    int err;

    if (file==NULL || file_pos==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;

    /* jump to the right spot */
    s->pos_in_central_dir = file_pos->pos_in_zip_directory;
    s->num_file           = file_pos->num_of_file;

    /* set the current file */
    err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
                                               &s->cur_file_info_internal,
                                               NULL,0,NULL,0,NULL,0);
    /* return results */
    s->current_file_ok = (err == UNZ_OK);
    return err;
}

extern int ZEXPORT unzGoToFilePos(
    unzFile file,
    unz_file_pos* file_pos)
{
    unz64_file_pos file_pos64;
    if (file_pos == NULL)
        return UNZ_PARAMERROR;

    file_pos64.pos_in_zip_directory = file_pos->pos_in_zip_directory;
    file_pos64.num_of_file = file_pos->num_of_file;
    return unzGoToFilePos64(file,&file_pos64);
}

/*
// Unzip Helper Functions - should be here?
///////////////////////////////////////////
*/

/*
  Read the local header of the current zipfile
  Check the coherency of the local header and info in the end of central
        directory about this file
  store in *piSizeVar the size of extra info in local header
        (filename and size of extra field data)
*/
local int unz64local_CheckCurrentFileCoherencyHeader (unz64_s* s, uInt* piSizeVar,
                                                    ZPOS64_T * poffset_local_extrafield,
                                                    uInt  * psize_local_extrafield)
{
    uLong uMagic,uData,uFlags;
    uLong size_filename;
    uLong size_extra_field;
    int err=UNZ_OK;

    *piSizeVar = 0;
    *poffset_local_extrafield = 0;
    *psize_local_extrafield = 0;

    if (ZSEEK64(s->z_filefunc, s->filestream,s->cur_file_info_internal.offset_curfile +
                                s->byte_before_the_zipfile,ZLIB_FILEFUNC_SEEK_SET)!=0)
        return UNZ_ERRNO;


    if (err==UNZ_OK)
    {
        if (unz64local_getLong(&s->z_filefunc, s->filestream,&uMagic) != UNZ_OK)
            err=UNZ_ERRNO;
        else if (uMagic!=0x04034b50)
            err=UNZ_BADZIPFILE;
    }

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&uData) != UNZ_OK)
        err=UNZ_ERRNO;
/*
    else if ((err==UNZ_OK) && (uData!=s->cur_file_info.wVersion))
        err=UNZ_BADZIPFILE;
*/
    if (unz64local_getShort(&s->z_filefunc, s->filestream,&uFlags) != UNZ_OK)
        err=UNZ_ERRNO;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&uData) != UNZ_OK)
        err=UNZ_ERRNO;
    else if ((err==UNZ_OK) && (uData!=s->cur_file_info.compression_method))
        err=UNZ_BADZIPFILE;

    if ((err==UNZ_OK) && (s->cur_file_info.compression_method!=0) &&
/* #ifdef HAVE_BZIP2 */
                         (s->cur_file_info.compression_method!=Z_BZIP2ED) &&
/* #endif */
                         (s->cur_file_info.compression_method!=Z_DEFLATED))
        err=UNZ_BADZIPFILE;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* date/time */
        err=UNZ_ERRNO;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* crc */
        err=UNZ_ERRNO;
    else if ((err==UNZ_OK) && (uData!=s->cur_file_info.crc) && ((uFlags & 8)==0))
        err=UNZ_BADZIPFILE;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* size compr */
        err=UNZ_ERRNO;
    else if (uData != 0xFFFFFFFF && (err==UNZ_OK) && (uData!=s->cur_file_info.compressed_size) && ((uFlags & 8)==0))
        err=UNZ_BADZIPFILE;

    if (unz64local_getLong(&s->z_filefunc, s->filestream,&uData) != UNZ_OK) /* size uncompr */
        err=UNZ_ERRNO;
    else if (uData != 0xFFFFFFFF && (err==UNZ_OK) && (uData!=s->cur_file_info.uncompressed_size) && ((uFlags & 8)==0))
        err=UNZ_BADZIPFILE;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&size_filename) != UNZ_OK)
        err=UNZ_ERRNO;
    else if ((err==UNZ_OK) && (size_filename!=s->cur_file_info.size_filename))
        err=UNZ_BADZIPFILE;

    *piSizeVar += (uInt)size_filename;

    if (unz64local_getShort(&s->z_filefunc, s->filestream,&size_extra_field) != UNZ_OK)
        err=UNZ_ERRNO;
    *poffset_local_extrafield= s->cur_file_info_internal.offset_curfile +
                                    SIZEZIPLOCALHEADER + size_filename;
    *psize_local_extrafield = (uInt)size_extra_field;

    *piSizeVar += (uInt)size_extra_field;

    return err;
}

/*
  Open for reading data the current file in the zipfile.
  If there is no error and the file is opened, the return value is UNZ_OK.
*/
extern int ZEXPORT unzOpenCurrentFile3 (unzFile file, int* method,
                                            int* level, int raw, const char* password)
{
    int err=UNZ_OK;
    uInt iSizeVar;
    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    ZPOS64_T offset_local_extrafield;  /* offset of the local extra field */
    uInt  size_local_extrafield;    /* size of the local extra field */
#    ifndef NOUNCRYPT
    char source[12];
#    else
    if (password != NULL)
        return UNZ_PARAMERROR;
#    endif

    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    if (!s->current_file_ok)
        return UNZ_PARAMERROR;

    if (s->pfile_in_zip_read != NULL)
        unzCloseCurrentFile(file);

    if (unz64local_CheckCurrentFileCoherencyHeader(s,&iSizeVar, &offset_local_extrafield,&size_local_extrafield)!=UNZ_OK)
        return UNZ_BADZIPFILE;

    pfile_in_zip_read_info = (file_in_zip64_read_info_s*)ALLOC(sizeof(file_in_zip64_read_info_s));
    if (pfile_in_zip_read_info==NULL)
        return UNZ_INTERNALERROR;

    pfile_in_zip_read_info->read_buffer=(char*)ALLOC(UNZ_BUFSIZE);
    pfile_in_zip_read_info->offset_local_extrafield = offset_local_extrafield;
    pfile_in_zip_read_info->size_local_extrafield = size_local_extrafield;
    pfile_in_zip_read_info->pos_local_extrafield=0;
    pfile_in_zip_read_info->raw=raw;

    if (pfile_in_zip_read_info->read_buffer==NULL)
    {
        TRYFREE(pfile_in_zip_read_info);
        return UNZ_INTERNALERROR;
    }

    pfile_in_zip_read_info->stream_initialised=0;

    if (method!=NULL)
        *method = (int)s->cur_file_info.compression_method;

    if (level!=NULL)
    {
        *level = 6;
        switch (s->cur_file_info.flag & 0x06)
        {
          case 6 : *level = 1; break;
          case 4 : *level = 2; break;
          case 2 : *level = 9; break;
        }
    }

    if ((s->cur_file_info.compression_method!=0) &&
/* #ifdef HAVE_BZIP2 */
        (s->cur_file_info.compression_method!=Z_BZIP2ED) &&
/* #endif */
        (s->cur_file_info.compression_method!=Z_DEFLATED))

        err=UNZ_BADZIPFILE;

    pfile_in_zip_read_info->crc32_wait=s->cur_file_info.crc;
    pfile_in_zip_read_info->crc32=0;
    pfile_in_zip_read_info->total_out_64=0;
    pfile_in_zip_read_info->compression_method = s->cur_file_info.compression_method;
    pfile_in_zip_read_info->filestream=s->filestream;
    pfile_in_zip_read_info->z_filefunc=s->z_filefunc;
    pfile_in_zip_read_info->byte_before_the_zipfile=s->byte_before_the_zipfile;

    pfile_in_zip_read_info->stream.total_out = 0;

    if ((s->cur_file_info.compression_method==Z_BZIP2ED) && (!raw))
    {
#ifdef HAVE_BZIP2
      pfile_in_zip_read_info->bstream.bzalloc = (void *(*) (void *, int, int))0;
      pfile_in_zip_read_info->bstream.bzfree = (free_func)0;
      pfile_in_zip_read_info->bstream.opaque = (voidpf)0;
      pfile_in_zip_read_info->bstream.state = (voidpf)0;

      pfile_in_zip_read_info->stream.zalloc = (alloc_func)0;
      pfile_in_zip_read_info->stream.zfree = (free_func)0;
      pfile_in_zip_read_info->stream.opaque = (voidpf)0;
      pfile_in_zip_read_info->stream.next_in = (voidpf)0;
      pfile_in_zip_read_info->stream.avail_in = 0;

      err=BZ2_bzDecompressInit(&pfile_in_zip_read_info->bstream, 0, 0);
      if (err == Z_OK)
        pfile_in_zip_read_info->stream_initialised=Z_BZIP2ED;
      else
      {
        TRYFREE(pfile_in_zip_read_info);
        return err;
      }
#else
      pfile_in_zip_read_info->raw=1;
#endif
    }
    else if ((s->cur_file_info.compression_method==Z_DEFLATED) && (!raw))
    {
      pfile_in_zip_read_info->stream.zalloc = (alloc_func)0;
      pfile_in_zip_read_info->stream.zfree = (free_func)0;
      pfile_in_zip_read_info->stream.opaque = (voidpf)0;
      pfile_in_zip_read_info->stream.next_in = 0;
      pfile_in_zip_read_info->stream.avail_in = 0;

      err=inflateInit2(&pfile_in_zip_read_info->stream, -MAX_WBITS);
      if (err == Z_OK)
        pfile_in_zip_read_info->stream_initialised=Z_DEFLATED;
      else
      {
        TRYFREE(pfile_in_zip_read_info);
        return err;
      }
        /* windowBits is passed < 0 to tell that there is no zlib header.
         * Note that in this case inflate *requires* an extra "dummy" byte
         * after the compressed stream in order to complete decompression and
         * return Z_STREAM_END.
         * In unzip, i don't wait absolutely Z_STREAM_END because I known the
         * size of both compressed and uncompressed data
         */
    }
    pfile_in_zip_read_info->rest_read_compressed =
            s->cur_file_info.compressed_size ;
    pfile_in_zip_read_info->rest_read_uncompressed =
            s->cur_file_info.uncompressed_size ;


    pfile_in_zip_read_info->pos_in_zipfile =
            s->cur_file_info_internal.offset_curfile + SIZEZIPLOCALHEADER +
              iSizeVar;

    pfile_in_zip_read_info->stream.avail_in = (uInt)0;

    s->pfile_in_zip_read = pfile_in_zip_read_info;
                s->encrypted = 0;

#    ifndef NOUNCRYPT
    if (password != NULL)
    {
        int i;
        s->pcrc_32_tab = get_crc_table();
        init_keys(password,s->keys,s->pcrc_32_tab);
        if (ZSEEK64(s->z_filefunc, s->filestream,
                  s->pfile_in_zip_read->pos_in_zipfile +
                     s->pfile_in_zip_read->byte_before_the_zipfile,
                  SEEK_SET)!=0)
            return UNZ_INTERNALERROR;
        if(ZREAD64(s->z_filefunc, s->filestream,source, 12)<12)
            return UNZ_INTERNALERROR;

        for (i = 0; i<12; i++)
            zdecode(s->keys,s->pcrc_32_tab,source[i]);

        s->pfile_in_zip_read->pos_in_zipfile+=12;
        s->encrypted=1;
    }
#    endif


    return UNZ_OK;
}

extern int ZEXPORT unzOpenCurrentFile (unzFile file)
{
    return unzOpenCurrentFile3(file, NULL, NULL, 0, NULL);
}

extern int ZEXPORT unzOpenCurrentFilePassword (unzFile file, const char*  password)
{
    return unzOpenCurrentFile3(file, NULL, NULL, 0, password);
}

extern int ZEXPORT unzOpenCurrentFile2 (unzFile file, int* method, int* level, int raw)
{
    return unzOpenCurrentFile3(file, method, level, raw, NULL);
}

/** Addition for GDAL : START */

extern ZPOS64_T ZEXPORT unzGetCurrentFileZStreamPos64( unzFile file)
{
    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    s=(unz64_s*)file;
    if (file==NULL)
        return 0; //UNZ_PARAMERROR;
    pfile_in_zip_read_info=s->pfile_in_zip_read;
    if (pfile_in_zip_read_info==NULL)
        return 0; //UNZ_PARAMERROR;
    return pfile_in_zip_read_info->pos_in_zipfile +
                         pfile_in_zip_read_info->byte_before_the_zipfile;
}

/** Addition for GDAL : END */

/*
  Read bytes from the current file.
  buf contain buffer where data must be copied
  len the size of buf.

  return the number of byte copied if somes bytes are copied
  return 0 if the end of file was reached
  return <0 with error code if there is an error
    (UNZ_ERRNO for IO error, or zLib error for uncompress error)
*/
extern int ZEXPORT unzReadCurrentFile  (unzFile file, voidp buf, unsigned len)
{
    int err=UNZ_OK;
    uInt iRead = 0;
    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    pfile_in_zip_read_info=s->pfile_in_zip_read;

    if (pfile_in_zip_read_info==NULL)
        return UNZ_PARAMERROR;


    if (pfile_in_zip_read_info->read_buffer == NULL)
        return UNZ_END_OF_LIST_OF_FILE;
    if (len==0)
        return 0;

    pfile_in_zip_read_info->stream.next_out = (Bytef*)buf;

    pfile_in_zip_read_info->stream.avail_out = (uInt)len;

    if ((len>pfile_in_zip_read_info->rest_read_uncompressed) &&
        (!(pfile_in_zip_read_info->raw)))
        pfile_in_zip_read_info->stream.avail_out =
            (uInt)pfile_in_zip_read_info->rest_read_uncompressed;

    if ((len>pfile_in_zip_read_info->rest_read_compressed+
           pfile_in_zip_read_info->stream.avail_in) &&
         (pfile_in_zip_read_info->raw))
        pfile_in_zip_read_info->stream.avail_out =
            (uInt)pfile_in_zip_read_info->rest_read_compressed+
            pfile_in_zip_read_info->stream.avail_in;

    while (pfile_in_zip_read_info->stream.avail_out>0)
    {
        if ((pfile_in_zip_read_info->stream.avail_in==0) &&
            (pfile_in_zip_read_info->rest_read_compressed>0))
        {
            uInt uReadThis = UNZ_BUFSIZE;
            if (pfile_in_zip_read_info->rest_read_compressed<uReadThis)
                uReadThis = (uInt)pfile_in_zip_read_info->rest_read_compressed;
            if (uReadThis == 0)
                return UNZ_EOF;
            if (ZSEEK64(pfile_in_zip_read_info->z_filefunc,
                      pfile_in_zip_read_info->filestream,
                      pfile_in_zip_read_info->pos_in_zipfile +
                         pfile_in_zip_read_info->byte_before_the_zipfile,
                         ZLIB_FILEFUNC_SEEK_SET)!=0)
                return UNZ_ERRNO;
            if (ZREAD64(pfile_in_zip_read_info->z_filefunc,
                      pfile_in_zip_read_info->filestream,
                      pfile_in_zip_read_info->read_buffer,
                      uReadThis)!=uReadThis)
                return UNZ_ERRNO;


#            ifndef NOUNCRYPT
            if(s->encrypted)
            {
                uInt i;
                for(i=0;i<uReadThis;i++)
                  pfile_in_zip_read_info->read_buffer[i] =
                      zdecode(s->keys,s->pcrc_32_tab,
                              pfile_in_zip_read_info->read_buffer[i]);
            }
#            endif


            pfile_in_zip_read_info->pos_in_zipfile += uReadThis;

            pfile_in_zip_read_info->rest_read_compressed-=uReadThis;

            pfile_in_zip_read_info->stream.next_in =
                (Bytef*)pfile_in_zip_read_info->read_buffer;
            pfile_in_zip_read_info->stream.avail_in = (uInt)uReadThis;
        }

        if ((pfile_in_zip_read_info->compression_method==0) || (pfile_in_zip_read_info->raw))
        {
            uInt uDoCopy,i ;

            if ((pfile_in_zip_read_info->stream.avail_in == 0) &&
                (pfile_in_zip_read_info->rest_read_compressed == 0))
                return (iRead==0) ? UNZ_EOF : iRead;

            if (pfile_in_zip_read_info->stream.avail_out <
                            pfile_in_zip_read_info->stream.avail_in)
                uDoCopy = pfile_in_zip_read_info->stream.avail_out ;
            else
                uDoCopy = pfile_in_zip_read_info->stream.avail_in ;

            for (i=0;i<uDoCopy;i++)
                *(pfile_in_zip_read_info->stream.next_out+i) =
                        *(pfile_in_zip_read_info->stream.next_in+i);

            pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uDoCopy;

            pfile_in_zip_read_info->crc32 = crc32(pfile_in_zip_read_info->crc32,
                                pfile_in_zip_read_info->stream.next_out,
                                uDoCopy);
            pfile_in_zip_read_info->rest_read_uncompressed-=uDoCopy;
            pfile_in_zip_read_info->stream.avail_in -= uDoCopy;
            pfile_in_zip_read_info->stream.avail_out -= uDoCopy;
            pfile_in_zip_read_info->stream.next_out += uDoCopy;
            pfile_in_zip_read_info->stream.next_in += uDoCopy;
            pfile_in_zip_read_info->stream.total_out += uDoCopy;
            iRead += uDoCopy;
        }
        else if (pfile_in_zip_read_info->compression_method==Z_BZIP2ED)
        {
#ifdef HAVE_BZIP2
            uLong uTotalOutBefore,uTotalOutAfter;
            const Bytef *bufBefore;
            uLong uOutThis;

            pfile_in_zip_read_info->bstream.next_in        = (char*)pfile_in_zip_read_info->stream.next_in;
            pfile_in_zip_read_info->bstream.avail_in       = pfile_in_zip_read_info->stream.avail_in;
            pfile_in_zip_read_info->bstream.total_in_lo32  = pfile_in_zip_read_info->stream.total_in;
            pfile_in_zip_read_info->bstream.total_in_hi32  = 0;
            pfile_in_zip_read_info->bstream.next_out       = (char*)pfile_in_zip_read_info->stream.next_out;
            pfile_in_zip_read_info->bstream.avail_out      = pfile_in_zip_read_info->stream.avail_out;
            pfile_in_zip_read_info->bstream.total_out_lo32 = pfile_in_zip_read_info->stream.total_out;
            pfile_in_zip_read_info->bstream.total_out_hi32 = 0;

            uTotalOutBefore = pfile_in_zip_read_info->bstream.total_out_lo32;
            bufBefore = (const Bytef *)pfile_in_zip_read_info->bstream.next_out;

            err=BZ2_bzDecompress(&pfile_in_zip_read_info->bstream);

            uTotalOutAfter = pfile_in_zip_read_info->bstream.total_out_lo32;
            uOutThis = uTotalOutAfter-uTotalOutBefore;

            pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uOutThis;

            pfile_in_zip_read_info->crc32 = crc32(pfile_in_zip_read_info->crc32,bufBefore, (uInt)(uOutThis));
            pfile_in_zip_read_info->rest_read_uncompressed -= uOutThis;
            iRead += (uInt)(uTotalOutAfter - uTotalOutBefore);

            pfile_in_zip_read_info->stream.next_in   = (Bytef*)pfile_in_zip_read_info->bstream.next_in;
            pfile_in_zip_read_info->stream.avail_in  = pfile_in_zip_read_info->bstream.avail_in;
            pfile_in_zip_read_info->stream.total_in  = pfile_in_zip_read_info->bstream.total_in_lo32;
            pfile_in_zip_read_info->stream.next_out  = (Bytef*)pfile_in_zip_read_info->bstream.next_out;
            pfile_in_zip_read_info->stream.avail_out = pfile_in_zip_read_info->bstream.avail_out;
            pfile_in_zip_read_info->stream.total_out = pfile_in_zip_read_info->bstream.total_out_lo32;

            if (err==BZ_STREAM_END)
              return (iRead==0) ? UNZ_EOF : iRead;
            if (err!=BZ_OK)
              break;
#endif
        } // end Z_BZIP2ED
        else
        {
            ZPOS64_T uTotalOutBefore,uTotalOutAfter;
            const Bytef *bufBefore;
            ZPOS64_T uOutThis;
            int flush=Z_SYNC_FLUSH;

            uTotalOutBefore = pfile_in_zip_read_info->stream.total_out;
            bufBefore = pfile_in_zip_read_info->stream.next_out;

            /*
            if ((pfile_in_zip_read_info->rest_read_uncompressed ==
                     pfile_in_zip_read_info->stream.avail_out) &&
                (pfile_in_zip_read_info->rest_read_compressed == 0))
                flush = Z_FINISH;
            */
            err=inflate(&pfile_in_zip_read_info->stream,flush);

            if ((err>=0) && (pfile_in_zip_read_info->stream.msg!=NULL))
              err = Z_DATA_ERROR;

            uTotalOutAfter = pfile_in_zip_read_info->stream.total_out;
            uOutThis = uTotalOutAfter-uTotalOutBefore;

            pfile_in_zip_read_info->total_out_64 = pfile_in_zip_read_info->total_out_64 + uOutThis;

            pfile_in_zip_read_info->crc32 =
                crc32(pfile_in_zip_read_info->crc32,bufBefore,
                        (uInt)(uOutThis));

            pfile_in_zip_read_info->rest_read_uncompressed -=
                uOutThis;

            iRead += (uInt)(uTotalOutAfter - uTotalOutBefore);

            if (err==Z_STREAM_END)
                return (iRead==0) ? UNZ_EOF : iRead;
            if (err!=Z_OK)
                break;
        }
    }

    if (err==Z_OK)
        return iRead;
    return err;
}


/*
  Give the current position in uncompressed data
*/
extern z_off_t ZEXPORT unztell (unzFile file)
{
    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    pfile_in_zip_read_info=s->pfile_in_zip_read;

    if (pfile_in_zip_read_info==NULL)
        return UNZ_PARAMERROR;

    return (z_off_t)pfile_in_zip_read_info->stream.total_out;
}

extern ZPOS64_T ZEXPORT unztell64 (unzFile file)
{

    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    if (file==NULL)
        return (ZPOS64_T)-1;
    s=(unz64_s*)file;
    pfile_in_zip_read_info=s->pfile_in_zip_read;

    if (pfile_in_zip_read_info==NULL)
        return (ZPOS64_T)-1;

    return pfile_in_zip_read_info->total_out_64;
}


/*
  return 1 if the end of file was reached, 0 elsewhere
*/
extern int ZEXPORT unzeof (unzFile file)
{
    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    pfile_in_zip_read_info=s->pfile_in_zip_read;

    if (pfile_in_zip_read_info==NULL)
        return UNZ_PARAMERROR;

    if (pfile_in_zip_read_info->rest_read_uncompressed == 0)
        return 1;
    else
        return 0;
}



/*
Read extra field from the current file (opened by unzOpenCurrentFile)
This is the local-header version of the extra field (sometimes, there is
more info in the local-header version than in the central-header)

  if buf==NULL, it return the size of the local extra field that can be read

  if buf!=NULL, len is the size of the buffer, the extra header is copied in
    buf.
  the return value is the number of bytes copied in buf, or (if <0)
    the error code
*/
extern int ZEXPORT unzGetLocalExtrafield (unzFile file, voidp buf, unsigned len)
{
    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    uInt read_now;
    ZPOS64_T size_to_read;

    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    pfile_in_zip_read_info=s->pfile_in_zip_read;

    if (pfile_in_zip_read_info==NULL)
        return UNZ_PARAMERROR;

    size_to_read = (pfile_in_zip_read_info->size_local_extrafield -
                pfile_in_zip_read_info->pos_local_extrafield);

    if (buf==NULL)
        return (int)size_to_read;

    if (len>size_to_read)
        read_now = (uInt)size_to_read;
    else
        read_now = (uInt)len ;

    if (read_now==0)
        return 0;

    if (ZSEEK64(pfile_in_zip_read_info->z_filefunc,
              pfile_in_zip_read_info->filestream,
              pfile_in_zip_read_info->offset_local_extrafield +
              pfile_in_zip_read_info->pos_local_extrafield,
              ZLIB_FILEFUNC_SEEK_SET)!=0)
        return UNZ_ERRNO;

    if (ZREAD64(pfile_in_zip_read_info->z_filefunc,
              pfile_in_zip_read_info->filestream,
              buf,read_now)!=read_now)
        return UNZ_ERRNO;

    return (int)read_now;
}

/*
  Close the file in zip opened with unzOpenCurrentFile
  Return UNZ_CRCERROR if all the file was read but the CRC is not good
*/
extern int ZEXPORT unzCloseCurrentFile (unzFile file)
{
    int err=UNZ_OK;

    unz64_s* s;
    file_in_zip64_read_info_s* pfile_in_zip_read_info;
    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;
    pfile_in_zip_read_info=s->pfile_in_zip_read;

    if (pfile_in_zip_read_info==NULL)
        return UNZ_PARAMERROR;


    if ((pfile_in_zip_read_info->rest_read_uncompressed == 0) &&
        (!pfile_in_zip_read_info->raw))
    {
        if (pfile_in_zip_read_info->crc32 != pfile_in_zip_read_info->crc32_wait)
            err=UNZ_CRCERROR;
    }


    TRYFREE(pfile_in_zip_read_info->read_buffer);
    pfile_in_zip_read_info->read_buffer = NULL;
    if (pfile_in_zip_read_info->stream_initialised == Z_DEFLATED)
        inflateEnd(&pfile_in_zip_read_info->stream);
#ifdef HAVE_BZIP2
    else if (pfile_in_zip_read_info->stream_initialised == Z_BZIP2ED)
        BZ2_bzDecompressEnd(&pfile_in_zip_read_info->bstream);
#endif


    pfile_in_zip_read_info->stream_initialised = 0;
    TRYFREE(pfile_in_zip_read_info);

    s->pfile_in_zip_read=NULL;

    return err;
}


/*
  Get the global comment string of the ZipFile, in the szComment buffer.
  uSizeBuf is the size of the szComment buffer.
  return the number of byte copied or an error code <0
*/
extern int ZEXPORT unzGetGlobalComment (unzFile file, char * szComment, uLong uSizeBuf)
{
    unz64_s* s;
    uLong uReadThis ;
    if (file==NULL)
        return (int)UNZ_PARAMERROR;
    s=(unz64_s*)file;

    uReadThis = uSizeBuf;
    if (uReadThis>s->gi.size_comment)
        uReadThis = s->gi.size_comment;

    if (ZSEEK64(s->z_filefunc,s->filestream,s->central_pos+22,ZLIB_FILEFUNC_SEEK_SET)!=0)
        return UNZ_ERRNO;

    if (uReadThis>0)
    {
      *szComment='\0';
      if (ZREAD64(s->z_filefunc,s->filestream,szComment,uReadThis)!=uReadThis)
        return UNZ_ERRNO;
    }

    if ((szComment != NULL) && (uSizeBuf > s->gi.size_comment))
        *(szComment+s->gi.size_comment)='\0';
    return (int)uReadThis;
}

/* Additions by RX '2004 */
extern ZPOS64_T ZEXPORT unzGetOffset64(unzFile file)
{
    unz64_s* s;

    if (file==NULL)
          return 0; //UNZ_PARAMERROR;
    s=(unz64_s*)file;
    if (!s->current_file_ok)
      return 0;
    if (s->gi.number_entry != 0 && s->gi.number_entry != 0xffff)
      if (s->num_file==s->gi.number_entry)
         return 0;
    return s->pos_in_central_dir;
}

extern uLong ZEXPORT unzGetOffset (unzFile file)
{
    ZPOS64_T offset64;

    if (file==NULL)
          return 0; //UNZ_PARAMERROR;
    offset64 = unzGetOffset64(file);
    return (uLong)offset64;
}

extern int ZEXPORT unzSetOffset64(unzFile file, ZPOS64_T pos)
{
    unz64_s* s;
    int err;

    if (file==NULL)
        return UNZ_PARAMERROR;
    s=(unz64_s*)file;

    s->pos_in_central_dir = pos;
    s->num_file = s->gi.number_entry;      /* hack */
    err = unz64local_GetCurrentFileInfoInternal(file,&s->cur_file_info,
                                              &s->cur_file_info_internal,
                                              NULL,0,NULL,0,NULL,0);
    s->current_file_ok = (err == UNZ_OK);
    return err;
}

extern int ZEXPORT unzSetOffset (unzFile file, uLong pos)
{
    return unzSetOffset64(file,pos);
}

Deleted compat/zlib/contrib/minizip/unzip.h.

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
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





















































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* unzip.h -- IO for uncompress .zip files using zlib
   Version 1.1, February 14h, 2010
   part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications of Unzip for Zip64
         Copyright (C) 2007-2008 Even Rouault

         Modifications for Zip64 support on both zip and unzip
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

         For more info read MiniZip_info.txt

         ---------------------------------------------------------------------------------

        Condition of use and distribution are the same than zlib :

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  ---------------------------------------------------------------------------------

        Changes

        See header of unzip64.c

*/

#ifndef _unz64_H
#define _unz64_H

#ifdef __cplusplus
extern "C" {
#endif

#ifndef _ZLIB_H
#include "zlib.h"
#endif

#ifndef  _ZLIBIOAPI_H
#include "ioapi.h"
#endif

#ifdef HAVE_BZIP2
#include "bzlib.h"
#endif

#define Z_BZIP2ED 12

#if defined(STRICTUNZIP) || defined(STRICTZIPUNZIP)
/* like the STRICT of WIN32, we define a pointer that cannot be converted
    from (void*) without cast */
typedef struct TagunzFile__ { int unused; } unzFile__;
typedef unzFile__ *unzFile;
#else
typedef voidp unzFile;
#endif


#define UNZ_OK                          (0)
#define UNZ_END_OF_LIST_OF_FILE         (-100)
#define UNZ_ERRNO                       (Z_ERRNO)
#define UNZ_EOF                         (0)
#define UNZ_PARAMERROR                  (-102)
#define UNZ_BADZIPFILE                  (-103)
#define UNZ_INTERNALERROR               (-104)
#define UNZ_CRCERROR                    (-105)

/* tm_unz contain date/time info */
typedef struct tm_unz_s
{
    uInt tm_sec;            /* seconds after the minute - [0,59] */
    uInt tm_min;            /* minutes after the hour - [0,59] */
    uInt tm_hour;           /* hours since midnight - [0,23] */
    uInt tm_mday;           /* day of the month - [1,31] */
    uInt tm_mon;            /* months since January - [0,11] */
    uInt tm_year;           /* years - [1980..2044] */
} tm_unz;

/* unz_global_info structure contain global data about the ZIPfile
   These data comes from the end of central dir */
typedef struct unz_global_info64_s
{
    ZPOS64_T number_entry;         /* total number of entries in
                                     the central dir on this disk */
    uLong size_comment;         /* size of the global comment of the zipfile */
} unz_global_info64;

typedef struct unz_global_info_s
{
    uLong number_entry;         /* total number of entries in
                                     the central dir on this disk */
    uLong size_comment;         /* size of the global comment of the zipfile */
} unz_global_info;

/* unz_file_info contain information about a file in the zipfile */
typedef struct unz_file_info64_s
{
    uLong version;              /* version made by                 2 bytes */
    uLong version_needed;       /* version needed to extract       2 bytes */
    uLong flag;                 /* general purpose bit flag        2 bytes */
    uLong compression_method;   /* compression method              2 bytes */
    uLong dosDate;              /* last mod file date in Dos fmt   4 bytes */
    uLong crc;                  /* crc-32                          4 bytes */
    ZPOS64_T compressed_size;   /* compressed size                 8 bytes */
    ZPOS64_T uncompressed_size; /* uncompressed size               8 bytes */
    uLong size_filename;        /* filename length                 2 bytes */
    uLong size_file_extra;      /* extra field length              2 bytes */
    uLong size_file_comment;    /* file comment length             2 bytes */

    uLong disk_num_start;       /* disk number start               2 bytes */
    uLong internal_fa;          /* internal file attributes        2 bytes */
    uLong external_fa;          /* external file attributes        4 bytes */

    tm_unz tmu_date;
} unz_file_info64;

typedef struct unz_file_info_s
{
    uLong version;              /* version made by                 2 bytes */
    uLong version_needed;       /* version needed to extract       2 bytes */
    uLong flag;                 /* general purpose bit flag        2 bytes */
    uLong compression_method;   /* compression method              2 bytes */
    uLong dosDate;              /* last mod file date in Dos fmt   4 bytes */
    uLong crc;                  /* crc-32                          4 bytes */
    uLong compressed_size;      /* compressed size                 4 bytes */
    uLong uncompressed_size;    /* uncompressed size               4 bytes */
    uLong size_filename;        /* filename length                 2 bytes */
    uLong size_file_extra;      /* extra field length              2 bytes */
    uLong size_file_comment;    /* file comment length             2 bytes */

    uLong disk_num_start;       /* disk number start               2 bytes */
    uLong internal_fa;          /* internal file attributes        2 bytes */
    uLong external_fa;          /* external file attributes        4 bytes */

    tm_unz tmu_date;
} unz_file_info;

extern int ZEXPORT unzStringFileNameCompare OF ((const char* fileName1,
                                                 const char* fileName2,
                                                 int iCaseSensitivity));
/*
   Compare two filename (fileName1,fileName2).
   If iCaseSenisivity = 1, comparision is case sensitivity (like strcmp)
   If iCaseSenisivity = 2, comparision is not case sensitivity (like strcmpi
                                or strcasecmp)
   If iCaseSenisivity = 0, case sensitivity is defaut of your operating system
    (like 1 on Unix, 2 on Windows)
*/


extern unzFile ZEXPORT unzOpen OF((const char *path));
extern unzFile ZEXPORT unzOpen64 OF((const void *path));
/*
  Open a Zip file. path contain the full pathname (by example,
     on a Windows XP computer "c:\\zlib\\zlib113.zip" or on an Unix computer
     "zlib/zlib113.zip".
     If the zipfile cannot be opened (file don't exist or in not valid), the
       return value is NULL.
     Else, the return value is a unzFile Handle, usable with other function
       of this unzip package.
     the "64" function take a const void* pointer, because the path is just the
       value passed to the open64_file_func callback.
     Under Windows, if UNICODE is defined, using fill_fopen64_filefunc, the path
       is a pointer to a wide unicode string (LPCTSTR is LPCWSTR), so const char*
       does not describe the reality
*/


extern unzFile ZEXPORT unzOpen2 OF((const char *path,
                                    zlib_filefunc_def* pzlib_filefunc_def));
/*
   Open a Zip file, like unzOpen, but provide a set of file low level API
      for read/write the zip file (see ioapi.h)
*/

extern unzFile ZEXPORT unzOpen2_64 OF((const void *path,
                                    zlib_filefunc64_def* pzlib_filefunc_def));
/*
   Open a Zip file, like unz64Open, but provide a set of file low level API
      for read/write the zip file (see ioapi.h)
*/

extern int ZEXPORT unzClose OF((unzFile file));
/*
  Close a ZipFile opened with unzOpen.
  If there is files inside the .Zip opened with unzOpenCurrentFile (see later),
    these files MUST be closed with unzCloseCurrentFile before call unzClose.
  return UNZ_OK if there is no problem. */

extern int ZEXPORT unzGetGlobalInfo OF((unzFile file,
                                        unz_global_info *pglobal_info));

extern int ZEXPORT unzGetGlobalInfo64 OF((unzFile file,
                                        unz_global_info64 *pglobal_info));
/*
  Write info about the ZipFile in the *pglobal_info structure.
  No preparation of the structure is needed
  return UNZ_OK if there is no problem. */


extern int ZEXPORT unzGetGlobalComment OF((unzFile file,
                                           char *szComment,
                                           uLong uSizeBuf));
/*
  Get the global comment string of the ZipFile, in the szComment buffer.
  uSizeBuf is the size of the szComment buffer.
  return the number of byte copied or an error code <0
*/


/***************************************************************************/
/* Unzip package allow you browse the directory of the zipfile */

extern int ZEXPORT unzGoToFirstFile OF((unzFile file));
/*
  Set the current file of the zipfile to the first file.
  return UNZ_OK if there is no problem
*/

extern int ZEXPORT unzGoToNextFile OF((unzFile file));
/*
  Set the current file of the zipfile to the next file.
  return UNZ_OK if there is no problem
  return UNZ_END_OF_LIST_OF_FILE if the actual file was the latest.
*/

extern int ZEXPORT unzLocateFile OF((unzFile file,
                     const char *szFileName,
                     int iCaseSensitivity));
/*
  Try locate the file szFileName in the zipfile.
  For the iCaseSensitivity signification, see unzStringFileNameCompare

  return value :
  UNZ_OK if the file is found. It becomes the current file.
  UNZ_END_OF_LIST_OF_FILE if the file is not found
*/


/* ****************************************** */
/* Ryan supplied functions */
/* unz_file_info contain information about a file in the zipfile */
typedef struct unz_file_pos_s
{
    uLong pos_in_zip_directory;   /* offset in zip file directory */
    uLong num_of_file;            /* # of file */
} unz_file_pos;

extern int ZEXPORT unzGetFilePos(
    unzFile file,
    unz_file_pos* file_pos);

extern int ZEXPORT unzGoToFilePos(
    unzFile file,
    unz_file_pos* file_pos);

typedef struct unz64_file_pos_s
{
    ZPOS64_T pos_in_zip_directory;   /* offset in zip file directory */
    ZPOS64_T num_of_file;            /* # of file */
} unz64_file_pos;

extern int ZEXPORT unzGetFilePos64(
    unzFile file,
    unz64_file_pos* file_pos);

extern int ZEXPORT unzGoToFilePos64(
    unzFile file,
    const unz64_file_pos* file_pos);

/* ****************************************** */

extern int ZEXPORT unzGetCurrentFileInfo64 OF((unzFile file,
                         unz_file_info64 *pfile_info,
                         char *szFileName,
                         uLong fileNameBufferSize,
                         void *extraField,
                         uLong extraFieldBufferSize,
                         char *szComment,
                         uLong commentBufferSize));

extern int ZEXPORT unzGetCurrentFileInfo OF((unzFile file,
                         unz_file_info *pfile_info,
                         char *szFileName,
                         uLong fileNameBufferSize,
                         void *extraField,
                         uLong extraFieldBufferSize,
                         char *szComment,
                         uLong commentBufferSize));
/*
  Get Info about the current file
  if pfile_info!=NULL, the *pfile_info structure will contain somes info about
        the current file
  if szFileName!=NULL, the filemane string will be copied in szFileName
            (fileNameBufferSize is the size of the buffer)
  if extraField!=NULL, the extra field information will be copied in extraField
            (extraFieldBufferSize is the size of the buffer).
            This is the Central-header version of the extra field
  if szComment!=NULL, the comment string of the file will be copied in szComment
            (commentBufferSize is the size of the buffer)
*/


/** Addition for GDAL : START */

extern ZPOS64_T ZEXPORT unzGetCurrentFileZStreamPos64 OF((unzFile file));

/** Addition for GDAL : END */


/***************************************************************************/
/* for reading the content of the current zipfile, you can open it, read data
   from it, and close it (you can close it before reading all the file)
   */

extern int ZEXPORT unzOpenCurrentFile OF((unzFile file));
/*
  Open for reading data the current file in the zipfile.
  If there is no error, the return value is UNZ_OK.
*/

extern int ZEXPORT unzOpenCurrentFilePassword OF((unzFile file,
                                                  const char* password));
/*
  Open for reading data the current file in the zipfile.
  password is a crypting password
  If there is no error, the return value is UNZ_OK.
*/

extern int ZEXPORT unzOpenCurrentFile2 OF((unzFile file,
                                           int* method,
                                           int* level,
                                           int raw));
/*
  Same than unzOpenCurrentFile, but open for read raw the file (not uncompress)
    if raw==1
  *method will receive method of compression, *level will receive level of
     compression
  note : you can set level parameter as NULL (if you did not want known level,
         but you CANNOT set method parameter as NULL
*/

extern int ZEXPORT unzOpenCurrentFile3 OF((unzFile file,
                                           int* method,
                                           int* level,
                                           int raw,
                                           const char* password));
/*
  Same than unzOpenCurrentFile, but open for read raw the file (not uncompress)
    if raw==1
  *method will receive method of compression, *level will receive level of
     compression
  note : you can set level parameter as NULL (if you did not want known level,
         but you CANNOT set method parameter as NULL
*/


extern int ZEXPORT unzCloseCurrentFile OF((unzFile file));
/*
  Close the file in zip opened with unzOpenCurrentFile
  Return UNZ_CRCERROR if all the file was read but the CRC is not good
*/

extern int ZEXPORT unzReadCurrentFile OF((unzFile file,
                      voidp buf,
                      unsigned len));
/*
  Read bytes from the current file (opened by unzOpenCurrentFile)
  buf contain buffer where data must be copied
  len the size of buf.

  return the number of byte copied if somes bytes are copied
  return 0 if the end of file was reached
  return <0 with error code if there is an error
    (UNZ_ERRNO for IO error, or zLib error for uncompress error)
*/

extern z_off_t ZEXPORT unztell OF((unzFile file));

extern ZPOS64_T ZEXPORT unztell64 OF((unzFile file));
/*
  Give the current position in uncompressed data
*/

extern int ZEXPORT unzeof OF((unzFile file));
/*
  return 1 if the end of file was reached, 0 elsewhere
*/

extern int ZEXPORT unzGetLocalExtrafield OF((unzFile file,
                                             voidp buf,
                                             unsigned len));
/*
  Read extra field from the current file (opened by unzOpenCurrentFile)
  This is the local-header version of the extra field (sometimes, there is
    more info in the local-header version than in the central-header)

  if buf==NULL, it return the size of the local extra field

  if buf!=NULL, len is the size of the buffer, the extra header is copied in
    buf.
  the return value is the number of bytes copied in buf, or (if <0)
    the error code
*/

/***************************************************************************/

/* Get the current file offset */
extern ZPOS64_T ZEXPORT unzGetOffset64 (unzFile file);
extern uLong ZEXPORT unzGetOffset (unzFile file);

/* Set the current file offset */
extern int ZEXPORT unzSetOffset64 (unzFile file, ZPOS64_T pos);
extern int ZEXPORT unzSetOffset (unzFile file, uLong pos);



#ifdef __cplusplus
}
#endif

#endif /* _unz64_H */

Deleted compat/zlib/contrib/minizip/zip.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zip.c -- IO on .zip files using zlib
   Version 1.1, February 14h, 2010
   part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications for Zip64 support
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

         For more info read MiniZip_info.txt

         Changes
   Oct-2009 - Mathias Svensson - Remove old C style function prototypes
   Oct-2009 - Mathias Svensson - Added Zip64 Support when creating new file archives
   Oct-2009 - Mathias Svensson - Did some code cleanup and refactoring to get better overview of some functions.
   Oct-2009 - Mathias Svensson - Added zipRemoveExtraInfoBlock to strip extra field data from its ZIP64 data
                                 It is used when recreting zip archive with RAW when deleting items from a zip.
                                 ZIP64 data is automatically added to items that needs it, and existing ZIP64 data need to be removed.
   Oct-2009 - Mathias Svensson - Added support for BZIP2 as compression mode (bzip2 lib is required)
   Jan-2010 - back to unzip and minizip 1.0 name scheme, with compatibility layer

*/


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include "zlib.h"
#include "zip.h"

#ifdef STDC
#  include <stddef.h>
#  include <string.h>
#  include <stdlib.h>
#endif
#ifdef NO_ERRNO_H
    extern int errno;
#else
#   include <errno.h>
#endif


#ifndef local
#  define local static
#endif
/* compile with -Dlocal if your debugger can't find static symbols */

#ifndef VERSIONMADEBY
# define VERSIONMADEBY   (0x0) /* platform depedent */
#endif

#ifndef Z_BUFSIZE
#define Z_BUFSIZE (64*1024) //(16384)
#endif

#ifndef Z_MAXFILENAMEINZIP
#define Z_MAXFILENAMEINZIP (256)
#endif

#ifndef ALLOC
# define ALLOC(size) (malloc(size))
#endif
#ifndef TRYFREE
# define TRYFREE(p) {if (p) free(p);}
#endif

/*
#define SIZECENTRALDIRITEM (0x2e)
#define SIZEZIPLOCALHEADER (0x1e)
*/

/* I've found an old Unix (a SunOS 4.1.3_U1) without all SEEK_* defined.... */


// NOT sure that this work on ALL platform
#define MAKEULONG64(a, b) ((ZPOS64_T)(((unsigned long)(a)) | ((ZPOS64_T)((unsigned long)(b))) << 32))

#ifndef SEEK_CUR
#define SEEK_CUR    1
#endif

#ifndef SEEK_END
#define SEEK_END    2
#endif

#ifndef SEEK_SET
#define SEEK_SET    0
#endif

#ifndef DEF_MEM_LEVEL
#if MAX_MEM_LEVEL >= 8
#  define DEF_MEM_LEVEL 8
#else
#  define DEF_MEM_LEVEL  MAX_MEM_LEVEL
#endif
#endif
const char zip_copyright[] =" zip 1.01 Copyright 1998-2004 Gilles Vollant - http://www.winimage.com/zLibDll";


#define SIZEDATA_INDATABLOCK (4096-(4*4))

#define LOCALHEADERMAGIC    (0x04034b50)
#define CENTRALHEADERMAGIC  (0x02014b50)
#define ENDHEADERMAGIC      (0x06054b50)
#define ZIP64ENDHEADERMAGIC      (0x6064b50)
#define ZIP64ENDLOCHEADERMAGIC   (0x7064b50)

#define FLAG_LOCALHEADER_OFFSET (0x06)
#define CRC_LOCALHEADER_OFFSET  (0x0e)

#define SIZECENTRALHEADER (0x2e) /* 46 */

typedef struct linkedlist_datablock_internal_s
{
  struct linkedlist_datablock_internal_s* next_datablock;
  uLong  avail_in_this_block;
  uLong  filled_in_this_block;
  uLong  unused; /* for future use and alignment */
  unsigned char data[SIZEDATA_INDATABLOCK];
} linkedlist_datablock_internal;

typedef struct linkedlist_data_s
{
    linkedlist_datablock_internal* first_block;
    linkedlist_datablock_internal* last_block;
} linkedlist_data;


typedef struct
{
    z_stream stream;            /* zLib stream structure for inflate */
#ifdef HAVE_BZIP2
    bz_stream bstream;          /* bzLib stream structure for bziped */
#endif

    int  stream_initialised;    /* 1 is stream is initialised */
    uInt pos_in_buffered_data;  /* last written byte in buffered_data */

    ZPOS64_T pos_local_header;     /* offset of the local header of the file
                                     currenty writing */
    char* central_header;       /* central header data for the current file */
    uLong size_centralExtra;
    uLong size_centralheader;   /* size of the central header for cur file */
    uLong size_centralExtraFree; /* Extra bytes allocated to the centralheader but that are not used */
    uLong flag;                 /* flag of the file currently writing */

    int  method;                /* compression method of file currenty wr.*/
    int  raw;                   /* 1 for directly writing raw data */
    Byte buffered_data[Z_BUFSIZE];/* buffer contain compressed data to be writ*/
    uLong dosDate;
    uLong crc32;
    int  encrypt;
    int  zip64;               /* Add ZIP64 extened information in the extra field */
    ZPOS64_T pos_zip64extrainfo;
    ZPOS64_T totalCompressedData;
    ZPOS64_T totalUncompressedData;
#ifndef NOCRYPT
    unsigned long keys[3];     /* keys defining the pseudo-random sequence */
    const z_crc_t* pcrc_32_tab;
    int crypt_header_size;
#endif
} curfile64_info;

typedef struct
{
    zlib_filefunc64_32_def z_filefunc;
    voidpf filestream;        /* io structore of the zipfile */
    linkedlist_data central_dir;/* datablock with central dir in construction*/
    int  in_opened_file_inzip;  /* 1 if a file in the zip is currently writ.*/
    curfile64_info ci;            /* info on the file curretly writing */

    ZPOS64_T begin_pos;            /* position of the beginning of the zipfile */
    ZPOS64_T add_position_when_writing_offset;
    ZPOS64_T number_entry;

#ifndef NO_ADDFILEINEXISTINGZIP
    char *globalcomment;
#endif

} zip64_internal;


#ifndef NOCRYPT
#define INCLUDECRYPTINGCODE_IFCRYPTALLOWED
#include "crypt.h"
#endif

local linkedlist_datablock_internal* allocate_new_datablock()
{
    linkedlist_datablock_internal* ldi;
    ldi = (linkedlist_datablock_internal*)
                 ALLOC(sizeof(linkedlist_datablock_internal));
    if (ldi!=NULL)
    {
        ldi->next_datablock = NULL ;
        ldi->filled_in_this_block = 0 ;
        ldi->avail_in_this_block = SIZEDATA_INDATABLOCK ;
    }
    return ldi;
}

local void free_datablock(linkedlist_datablock_internal* ldi)
{
    while (ldi!=NULL)
    {
        linkedlist_datablock_internal* ldinext = ldi->next_datablock;
        TRYFREE(ldi);
        ldi = ldinext;
    }
}

local void init_linkedlist(linkedlist_data* ll)
{
    ll->first_block = ll->last_block = NULL;
}

local void free_linkedlist(linkedlist_data* ll)
{
    free_datablock(ll->first_block);
    ll->first_block = ll->last_block = NULL;
}


local int add_data_in_datablock(linkedlist_data* ll, const void* buf, uLong len)
{
    linkedlist_datablock_internal* ldi;
    const unsigned char* from_copy;

    if (ll==NULL)
        return ZIP_INTERNALERROR;

    if (ll->last_block == NULL)
    {
        ll->first_block = ll->last_block = allocate_new_datablock();
        if (ll->first_block == NULL)
            return ZIP_INTERNALERROR;
    }

    ldi = ll->last_block;
    from_copy = (unsigned char*)buf;

    while (len>0)
    {
        uInt copy_this;
        uInt i;
        unsigned char* to_copy;

        if (ldi->avail_in_this_block==0)
        {
            ldi->next_datablock = allocate_new_datablock();
            if (ldi->next_datablock == NULL)
                return ZIP_INTERNALERROR;
            ldi = ldi->next_datablock ;
            ll->last_block = ldi;
        }

        if (ldi->avail_in_this_block < len)
            copy_this = (uInt)ldi->avail_in_this_block;
        else
            copy_this = (uInt)len;

        to_copy = &(ldi->data[ldi->filled_in_this_block]);

        for (i=0;i<copy_this;i++)
            *(to_copy+i)=*(from_copy+i);

        ldi->filled_in_this_block += copy_this;
        ldi->avail_in_this_block -= copy_this;
        from_copy += copy_this ;
        len -= copy_this;
    }
    return ZIP_OK;
}



/****************************************************************************/

#ifndef NO_ADDFILEINEXISTINGZIP
/* ===========================================================================
   Inputs a long in LSB order to the given file
   nbByte == 1, 2 ,4 or 8 (byte, short or long, ZPOS64_T)
*/

local int zip64local_putValue OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T x, int nbByte));
local int zip64local_putValue (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T x, int nbByte)
{
    unsigned char buf[8];
    int n;
    for (n = 0; n < nbByte; n++)
    {
        buf[n] = (unsigned char)(x & 0xff);
        x >>= 8;
    }
    if (x != 0)
      {     /* data overflow - hack for ZIP64 (X Roche) */
      for (n = 0; n < nbByte; n++)
        {
          buf[n] = 0xff;
        }
      }

    if (ZWRITE64(*pzlib_filefunc_def,filestream,buf,nbByte)!=(uLong)nbByte)
        return ZIP_ERRNO;
    else
        return ZIP_OK;
}

local void zip64local_putValue_inmemory OF((void* dest, ZPOS64_T x, int nbByte));
local void zip64local_putValue_inmemory (void* dest, ZPOS64_T x, int nbByte)
{
    unsigned char* buf=(unsigned char*)dest;
    int n;
    for (n = 0; n < nbByte; n++) {
        buf[n] = (unsigned char)(x & 0xff);
        x >>= 8;
    }

    if (x != 0)
    {     /* data overflow - hack for ZIP64 */
       for (n = 0; n < nbByte; n++)
       {
          buf[n] = 0xff;
       }
    }
}

/****************************************************************************/


local uLong zip64local_TmzDateToDosDate(const tm_zip* ptm)
{
    uLong year = (uLong)ptm->tm_year;
    if (year>=1980)
        year-=1980;
    else if (year>=80)
        year-=80;
    return
      (uLong) (((ptm->tm_mday) + (32 * (ptm->tm_mon+1)) + (512 * year)) << 16) |
        ((ptm->tm_sec/2) + (32* ptm->tm_min) + (2048 * (uLong)ptm->tm_hour));
}


/****************************************************************************/

local int zip64local_getByte OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, int *pi));

local int zip64local_getByte(const zlib_filefunc64_32_def* pzlib_filefunc_def,voidpf filestream,int* pi)
{
    unsigned char c;
    int err = (int)ZREAD64(*pzlib_filefunc_def,filestream,&c,1);
    if (err==1)
    {
        *pi = (int)c;
        return ZIP_OK;
    }
    else
    {
        if (ZERROR64(*pzlib_filefunc_def,filestream))
            return ZIP_ERRNO;
        else
            return ZIP_EOF;
    }
}


/* ===========================================================================
   Reads a long in LSB order from the given gz_stream. Sets
*/
local int zip64local_getShort OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong *pX));

local int zip64local_getShort (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong* pX)
{
    uLong x ;
    int i = 0;
    int err;

    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
    x = (uLong)i;

    if (err==ZIP_OK)
        err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
    x += ((uLong)i)<<8;

    if (err==ZIP_OK)
        *pX = x;
    else
        *pX = 0;
    return err;
}

local int zip64local_getLong OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong *pX));

local int zip64local_getLong (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, uLong* pX)
{
    uLong x ;
    int i = 0;
    int err;

    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
    x = (uLong)i;

    if (err==ZIP_OK)
        err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
    x += ((uLong)i)<<8;

    if (err==ZIP_OK)
        err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
    x += ((uLong)i)<<16;

    if (err==ZIP_OK)
        err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
    x += ((uLong)i)<<24;

    if (err==ZIP_OK)
        *pX = x;
    else
        *pX = 0;
    return err;
}

local int zip64local_getLong64 OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T *pX));


local int zip64local_getLong64 (const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream, ZPOS64_T *pX)
{
  ZPOS64_T x;
  int i = 0;
  int err;

  err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x = (ZPOS64_T)i;

  if (err==ZIP_OK)
    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x += ((ZPOS64_T)i)<<8;

  if (err==ZIP_OK)
    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x += ((ZPOS64_T)i)<<16;

  if (err==ZIP_OK)
    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x += ((ZPOS64_T)i)<<24;

  if (err==ZIP_OK)
    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x += ((ZPOS64_T)i)<<32;

  if (err==ZIP_OK)
    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x += ((ZPOS64_T)i)<<40;

  if (err==ZIP_OK)
    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x += ((ZPOS64_T)i)<<48;

  if (err==ZIP_OK)
    err = zip64local_getByte(pzlib_filefunc_def,filestream,&i);
  x += ((ZPOS64_T)i)<<56;

  if (err==ZIP_OK)
    *pX = x;
  else
    *pX = 0;

  return err;
}

#ifndef BUFREADCOMMENT
#define BUFREADCOMMENT (0x400)
#endif
/*
  Locate the Central directory of a zipfile (at the end, just before
    the global comment)
*/
local ZPOS64_T zip64local_SearchCentralDir OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream));

local ZPOS64_T zip64local_SearchCentralDir(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream)
{
  unsigned char* buf;
  ZPOS64_T uSizeFile;
  ZPOS64_T uBackRead;
  ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
  ZPOS64_T uPosFound=0;

  if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
    return 0;


  uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);

  if (uMaxBack>uSizeFile)
    uMaxBack = uSizeFile;

  buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
  if (buf==NULL)
    return 0;

  uBackRead = 4;
  while (uBackRead<uMaxBack)
  {
    uLong uReadSize;
    ZPOS64_T uReadPos ;
    int i;
    if (uBackRead+BUFREADCOMMENT>uMaxBack)
      uBackRead = uMaxBack;
    else
      uBackRead+=BUFREADCOMMENT;
    uReadPos = uSizeFile-uBackRead ;

    uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
      (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
    if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
      break;

    if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
      break;

    for (i=(int)uReadSize-3; (i--)>0;)
      if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) &&
        ((*(buf+i+2))==0x05) && ((*(buf+i+3))==0x06))
      {
        uPosFound = uReadPos+i;
        break;
      }

      if (uPosFound!=0)
        break;
  }
  TRYFREE(buf);
  return uPosFound;
}

/*
Locate the End of Zip64 Central directory locator and from there find the CD of a zipfile (at the end, just before
the global comment)
*/
local ZPOS64_T zip64local_SearchCentralDir64 OF((const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream));

local ZPOS64_T zip64local_SearchCentralDir64(const zlib_filefunc64_32_def* pzlib_filefunc_def, voidpf filestream)
{
  unsigned char* buf;
  ZPOS64_T uSizeFile;
  ZPOS64_T uBackRead;
  ZPOS64_T uMaxBack=0xffff; /* maximum size of global comment */
  ZPOS64_T uPosFound=0;
  uLong uL;
  ZPOS64_T relativeOffset;

  if (ZSEEK64(*pzlib_filefunc_def,filestream,0,ZLIB_FILEFUNC_SEEK_END) != 0)
    return 0;

  uSizeFile = ZTELL64(*pzlib_filefunc_def,filestream);

  if (uMaxBack>uSizeFile)
    uMaxBack = uSizeFile;

  buf = (unsigned char*)ALLOC(BUFREADCOMMENT+4);
  if (buf==NULL)
    return 0;

  uBackRead = 4;
  while (uBackRead<uMaxBack)
  {
    uLong uReadSize;
    ZPOS64_T uReadPos;
    int i;
    if (uBackRead+BUFREADCOMMENT>uMaxBack)
      uBackRead = uMaxBack;
    else
      uBackRead+=BUFREADCOMMENT;
    uReadPos = uSizeFile-uBackRead ;

    uReadSize = ((BUFREADCOMMENT+4) < (uSizeFile-uReadPos)) ?
      (BUFREADCOMMENT+4) : (uLong)(uSizeFile-uReadPos);
    if (ZSEEK64(*pzlib_filefunc_def,filestream,uReadPos,ZLIB_FILEFUNC_SEEK_SET)!=0)
      break;

    if (ZREAD64(*pzlib_filefunc_def,filestream,buf,uReadSize)!=uReadSize)
      break;

    for (i=(int)uReadSize-3; (i--)>0;)
    {
      // Signature "0x07064b50" Zip64 end of central directory locater
      if (((*(buf+i))==0x50) && ((*(buf+i+1))==0x4b) && ((*(buf+i+2))==0x06) && ((*(buf+i+3))==0x07))
      {
        uPosFound = uReadPos+i;
        break;
      }
    }

      if (uPosFound!=0)
        break;
  }

  TRYFREE(buf);
  if (uPosFound == 0)
    return 0;

  /* Zip64 end of central directory locator */
  if (ZSEEK64(*pzlib_filefunc_def,filestream, uPosFound,ZLIB_FILEFUNC_SEEK_SET)!=0)
    return 0;

  /* the signature, already checked */
  if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
    return 0;

  /* number of the disk with the start of the zip64 end of  central directory */
  if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
    return 0;
  if (uL != 0)
    return 0;

  /* relative offset of the zip64 end of central directory record */
  if (zip64local_getLong64(pzlib_filefunc_def,filestream,&relativeOffset)!=ZIP_OK)
    return 0;

  /* total number of disks */
  if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
    return 0;
  if (uL != 1)
    return 0;

  /* Goto Zip64 end of central directory record */
  if (ZSEEK64(*pzlib_filefunc_def,filestream, relativeOffset,ZLIB_FILEFUNC_SEEK_SET)!=0)
    return 0;

  /* the signature */
  if (zip64local_getLong(pzlib_filefunc_def,filestream,&uL)!=ZIP_OK)
    return 0;

  if (uL != 0x06064b50) // signature of 'Zip64 end of central directory'
    return 0;

  return relativeOffset;
}

int LoadCentralDirectoryRecord(zip64_internal* pziinit)
{
  int err=ZIP_OK;
  ZPOS64_T byte_before_the_zipfile;/* byte before the zipfile, (>0 for sfx)*/

  ZPOS64_T size_central_dir;     /* size of the central directory  */
  ZPOS64_T offset_central_dir;   /* offset of start of central directory */
  ZPOS64_T central_pos;
  uLong uL;

  uLong number_disk;          /* number of the current dist, used for
                              spaning ZIP, unsupported, always 0*/
  uLong number_disk_with_CD;  /* number the the disk with central dir, used
                              for spaning ZIP, unsupported, always 0*/
  ZPOS64_T number_entry;
  ZPOS64_T number_entry_CD;      /* total number of entries in
                                the central dir
                                (same than number_entry on nospan) */
  uLong VersionMadeBy;
  uLong VersionNeeded;
  uLong size_comment;

  int hasZIP64Record = 0;

  // check first if we find a ZIP64 record
  central_pos = zip64local_SearchCentralDir64(&pziinit->z_filefunc,pziinit->filestream);
  if(central_pos > 0)
  {
    hasZIP64Record = 1;
  }
  else if(central_pos == 0)
  {
    central_pos = zip64local_SearchCentralDir(&pziinit->z_filefunc,pziinit->filestream);
  }

/* disable to allow appending to empty ZIP archive
        if (central_pos==0)
            err=ZIP_ERRNO;
*/

  if(hasZIP64Record)
  {
    ZPOS64_T sizeEndOfCentralDirectory;
    if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, central_pos, ZLIB_FILEFUNC_SEEK_SET) != 0)
      err=ZIP_ERRNO;

    /* the signature, already checked */
    if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&uL)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* size of zip64 end of central directory record */
    if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream, &sizeEndOfCentralDirectory)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* version made by */
    if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &VersionMadeBy)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* version needed to extract */
    if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &VersionNeeded)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* number of this disk */
    if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&number_disk)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* number of the disk with the start of the central directory */
    if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&number_disk_with_CD)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* total number of entries in the central directory on this disk */
    if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream, &number_entry)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* total number of entries in the central directory */
    if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&number_entry_CD)!=ZIP_OK)
      err=ZIP_ERRNO;

    if ((number_entry_CD!=number_entry) || (number_disk_with_CD!=0) || (number_disk!=0))
      err=ZIP_BADZIPFILE;

    /* size of the central directory */
    if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&size_central_dir)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* offset of start of central directory with respect to the
    starting disk number */
    if (zip64local_getLong64(&pziinit->z_filefunc, pziinit->filestream,&offset_central_dir)!=ZIP_OK)
      err=ZIP_ERRNO;

    // TODO..
    // read the comment from the standard central header.
    size_comment = 0;
  }
  else
  {
    // Read End of central Directory info
    if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, central_pos,ZLIB_FILEFUNC_SEEK_SET)!=0)
      err=ZIP_ERRNO;

    /* the signature, already checked */
    if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream,&uL)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* number of this disk */
    if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream,&number_disk)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* number of the disk with the start of the central directory */
    if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream,&number_disk_with_CD)!=ZIP_OK)
      err=ZIP_ERRNO;

    /* total number of entries in the central dir on this disk */
    number_entry = 0;
    if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
      err=ZIP_ERRNO;
    else
      number_entry = uL;

    /* total number of entries in the central dir */
    number_entry_CD = 0;
    if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
      err=ZIP_ERRNO;
    else
      number_entry_CD = uL;

    if ((number_entry_CD!=number_entry) || (number_disk_with_CD!=0) || (number_disk!=0))
      err=ZIP_BADZIPFILE;

    /* size of the central directory */
    size_central_dir = 0;
    if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
      err=ZIP_ERRNO;
    else
      size_central_dir = uL;

    /* offset of start of central directory with respect to the starting disk number */
    offset_central_dir = 0;
    if (zip64local_getLong(&pziinit->z_filefunc, pziinit->filestream, &uL)!=ZIP_OK)
      err=ZIP_ERRNO;
    else
      offset_central_dir = uL;


    /* zipfile global comment length */
    if (zip64local_getShort(&pziinit->z_filefunc, pziinit->filestream, &size_comment)!=ZIP_OK)
      err=ZIP_ERRNO;
  }

  if ((central_pos<offset_central_dir+size_central_dir) &&
    (err==ZIP_OK))
    err=ZIP_BADZIPFILE;

  if (err!=ZIP_OK)
  {
    ZCLOSE64(pziinit->z_filefunc, pziinit->filestream);
    return ZIP_ERRNO;
  }

  if (size_comment>0)
  {
    pziinit->globalcomment = (char*)ALLOC(size_comment+1);
    if (pziinit->globalcomment)
    {
      size_comment = ZREAD64(pziinit->z_filefunc, pziinit->filestream, pziinit->globalcomment,size_comment);
      pziinit->globalcomment[size_comment]=0;
    }
  }

  byte_before_the_zipfile = central_pos - (offset_central_dir+size_central_dir);
  pziinit->add_position_when_writing_offset = byte_before_the_zipfile;

  {
    ZPOS64_T size_central_dir_to_read = size_central_dir;
    size_t buf_size = SIZEDATA_INDATABLOCK;
    void* buf_read = (void*)ALLOC(buf_size);
    if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, offset_central_dir + byte_before_the_zipfile, ZLIB_FILEFUNC_SEEK_SET) != 0)
      err=ZIP_ERRNO;

    while ((size_central_dir_to_read>0) && (err==ZIP_OK))
    {
      ZPOS64_T read_this = SIZEDATA_INDATABLOCK;
      if (read_this > size_central_dir_to_read)
        read_this = size_central_dir_to_read;

      if (ZREAD64(pziinit->z_filefunc, pziinit->filestream,buf_read,(uLong)read_this) != read_this)
        err=ZIP_ERRNO;

      if (err==ZIP_OK)
        err = add_data_in_datablock(&pziinit->central_dir,buf_read, (uLong)read_this);

      size_central_dir_to_read-=read_this;
    }
    TRYFREE(buf_read);
  }
  pziinit->begin_pos = byte_before_the_zipfile;
  pziinit->number_entry = number_entry_CD;

  if (ZSEEK64(pziinit->z_filefunc, pziinit->filestream, offset_central_dir+byte_before_the_zipfile,ZLIB_FILEFUNC_SEEK_SET) != 0)
    err=ZIP_ERRNO;

  return err;
}


#endif /* !NO_ADDFILEINEXISTINGZIP*/


/************************************************************/
extern zipFile ZEXPORT zipOpen3 (const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_32_def* pzlib_filefunc64_32_def)
{
    zip64_internal ziinit;
    zip64_internal* zi;
    int err=ZIP_OK;

    ziinit.z_filefunc.zseek32_file = NULL;
    ziinit.z_filefunc.ztell32_file = NULL;
    if (pzlib_filefunc64_32_def==NULL)
        fill_fopen64_filefunc(&ziinit.z_filefunc.zfile_func64);
    else
        ziinit.z_filefunc = *pzlib_filefunc64_32_def;

    ziinit.filestream = ZOPEN64(ziinit.z_filefunc,
                  pathname,
                  (append == APPEND_STATUS_CREATE) ?
                  (ZLIB_FILEFUNC_MODE_READ | ZLIB_FILEFUNC_MODE_WRITE | ZLIB_FILEFUNC_MODE_CREATE) :
                    (ZLIB_FILEFUNC_MODE_READ | ZLIB_FILEFUNC_MODE_WRITE | ZLIB_FILEFUNC_MODE_EXISTING));

    if (ziinit.filestream == NULL)
        return NULL;

    if (append == APPEND_STATUS_CREATEAFTER)
        ZSEEK64(ziinit.z_filefunc,ziinit.filestream,0,SEEK_END);

    ziinit.begin_pos = ZTELL64(ziinit.z_filefunc,ziinit.filestream);
    ziinit.in_opened_file_inzip = 0;
    ziinit.ci.stream_initialised = 0;
    ziinit.number_entry = 0;
    ziinit.add_position_when_writing_offset = 0;
    init_linkedlist(&(ziinit.central_dir));



    zi = (zip64_internal*)ALLOC(sizeof(zip64_internal));
    if (zi==NULL)
    {
        ZCLOSE64(ziinit.z_filefunc,ziinit.filestream);
        return NULL;
    }

    /* now we add file in a zipfile */
#    ifndef NO_ADDFILEINEXISTINGZIP
    ziinit.globalcomment = NULL;
    if (append == APPEND_STATUS_ADDINZIP)
    {
      // Read and Cache Central Directory Records
      err = LoadCentralDirectoryRecord(&ziinit);
    }

    if (globalcomment)
    {
      *globalcomment = ziinit.globalcomment;
    }
#    endif /* !NO_ADDFILEINEXISTINGZIP*/

    if (err != ZIP_OK)
    {
#    ifndef NO_ADDFILEINEXISTINGZIP
        TRYFREE(ziinit.globalcomment);
#    endif /* !NO_ADDFILEINEXISTINGZIP*/
        TRYFREE(zi);
        return NULL;
    }
    else
    {
        *zi = ziinit;
        return (zipFile)zi;
    }
}

extern zipFile ZEXPORT zipOpen2 (const char *pathname, int append, zipcharpc* globalcomment, zlib_filefunc_def* pzlib_filefunc32_def)
{
    if (pzlib_filefunc32_def != NULL)
    {
        zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
        fill_zlib_filefunc64_32_def_from_filefunc32(&zlib_filefunc64_32_def_fill,pzlib_filefunc32_def);
        return zipOpen3(pathname, append, globalcomment, &zlib_filefunc64_32_def_fill);
    }
    else
        return zipOpen3(pathname, append, globalcomment, NULL);
}

extern zipFile ZEXPORT zipOpen2_64 (const void *pathname, int append, zipcharpc* globalcomment, zlib_filefunc64_def* pzlib_filefunc_def)
{
    if (pzlib_filefunc_def != NULL)
    {
        zlib_filefunc64_32_def zlib_filefunc64_32_def_fill;
        zlib_filefunc64_32_def_fill.zfile_func64 = *pzlib_filefunc_def;
        zlib_filefunc64_32_def_fill.ztell32_file = NULL;
        zlib_filefunc64_32_def_fill.zseek32_file = NULL;
        return zipOpen3(pathname, append, globalcomment, &zlib_filefunc64_32_def_fill);
    }
    else
        return zipOpen3(pathname, append, globalcomment, NULL);
}



extern zipFile ZEXPORT zipOpen (const char* pathname, int append)
{
    return zipOpen3((const void*)pathname,append,NULL,NULL);
}

extern zipFile ZEXPORT zipOpen64 (const void* pathname, int append)
{
    return zipOpen3(pathname,append,NULL,NULL);
}

int Write_LocalFileHeader(zip64_internal* zi, const char* filename, uInt size_extrafield_local, const void* extrafield_local)
{
  /* write the local header */
  int err;
  uInt size_filename = (uInt)strlen(filename);
  uInt size_extrafield = size_extrafield_local;

  err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)LOCALHEADERMAGIC, 4);

  if (err==ZIP_OK)
  {
    if(zi->ci.zip64)
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2);/* version needed to extract */
    else
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)20,2);/* version needed to extract */
  }

  if (err==ZIP_OK)
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.flag,2);

  if (err==ZIP_OK)
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.method,2);

  if (err==ZIP_OK)
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->ci.dosDate,4);

  // CRC / Compressed size / Uncompressed size will be filled in later and rewritten later
  if (err==ZIP_OK)
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* crc 32, unknown */
  if (err==ZIP_OK)
  {
    if(zi->ci.zip64)
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xFFFFFFFF,4); /* compressed size, unknown */
    else
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* compressed size, unknown */
  }
  if (err==ZIP_OK)
  {
    if(zi->ci.zip64)
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xFFFFFFFF,4); /* uncompressed size, unknown */
    else
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4); /* uncompressed size, unknown */
  }

  if (err==ZIP_OK)
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_filename,2);

  if(zi->ci.zip64)
  {
    size_extrafield += 20;
  }

  if (err==ZIP_OK)
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_extrafield,2);

  if ((err==ZIP_OK) && (size_filename > 0))
  {
    if (ZWRITE64(zi->z_filefunc,zi->filestream,filename,size_filename)!=size_filename)
      err = ZIP_ERRNO;
  }

  if ((err==ZIP_OK) && (size_extrafield_local > 0))
  {
    if (ZWRITE64(zi->z_filefunc, zi->filestream, extrafield_local, size_extrafield_local) != size_extrafield_local)
      err = ZIP_ERRNO;
  }


  if ((err==ZIP_OK) && (zi->ci.zip64))
  {
      // write the Zip64 extended info
      short HeaderID = 1;
      short DataSize = 16;
      ZPOS64_T CompressedSize = 0;
      ZPOS64_T UncompressedSize = 0;

      // Remember position of Zip64 extended info for the local file header. (needed when we update size after done with file)
      zi->ci.pos_zip64extrainfo = ZTELL64(zi->z_filefunc,zi->filestream);

      err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (short)HeaderID,2);
      err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (short)DataSize,2);

      err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)UncompressedSize,8);
      err = zip64local_putValue(&zi->z_filefunc, zi->filestream, (ZPOS64_T)CompressedSize,8);
  }

  return err;
}

/*
 NOTE.
 When writing RAW the ZIP64 extended information in extrafield_local and extrafield_global needs to be stripped
 before calling this function it can be done with zipRemoveExtraInfoBlock

 It is not done here because then we need to realloc a new buffer since parameters are 'const' and I want to minimize
 unnecessary allocations.
 */
extern int ZEXPORT zipOpenNewFileInZip4_64 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                         const void* extrafield_local, uInt size_extrafield_local,
                                         const void* extrafield_global, uInt size_extrafield_global,
                                         const char* comment, int method, int level, int raw,
                                         int windowBits,int memLevel, int strategy,
                                         const char* password, uLong crcForCrypting,
                                         uLong versionMadeBy, uLong flagBase, int zip64)
{
    zip64_internal* zi;
    uInt size_filename;
    uInt size_comment;
    uInt i;
    int err = ZIP_OK;

#    ifdef NOCRYPT
    (crcForCrypting);
    if (password != NULL)
        return ZIP_PARAMERROR;
#    endif

    if (file == NULL)
        return ZIP_PARAMERROR;

#ifdef HAVE_BZIP2
    if ((method!=0) && (method!=Z_DEFLATED) && (method!=Z_BZIP2ED))
      return ZIP_PARAMERROR;
#else
    if ((method!=0) && (method!=Z_DEFLATED))
      return ZIP_PARAMERROR;
#endif

    zi = (zip64_internal*)file;

    if (zi->in_opened_file_inzip == 1)
    {
        err = zipCloseFileInZip (file);
        if (err != ZIP_OK)
            return err;
    }

    if (filename==NULL)
        filename="-";

    if (comment==NULL)
        size_comment = 0;
    else
        size_comment = (uInt)strlen(comment);

    size_filename = (uInt)strlen(filename);

    if (zipfi == NULL)
        zi->ci.dosDate = 0;
    else
    {
        if (zipfi->dosDate != 0)
            zi->ci.dosDate = zipfi->dosDate;
        else
          zi->ci.dosDate = zip64local_TmzDateToDosDate(&zipfi->tmz_date);
    }

    zi->ci.flag = flagBase;
    if ((level==8) || (level==9))
      zi->ci.flag |= 2;
    if (level==2)
      zi->ci.flag |= 4;
    if (level==1)
      zi->ci.flag |= 6;
    if (password != NULL)
      zi->ci.flag |= 1;

    zi->ci.crc32 = 0;
    zi->ci.method = method;
    zi->ci.encrypt = 0;
    zi->ci.stream_initialised = 0;
    zi->ci.pos_in_buffered_data = 0;
    zi->ci.raw = raw;
    zi->ci.pos_local_header = ZTELL64(zi->z_filefunc,zi->filestream);

    zi->ci.size_centralheader = SIZECENTRALHEADER + size_filename + size_extrafield_global + size_comment;
    zi->ci.size_centralExtraFree = 32; // Extra space we have reserved in case we need to add ZIP64 extra info data

    zi->ci.central_header = (char*)ALLOC((uInt)zi->ci.size_centralheader + zi->ci.size_centralExtraFree);

    zi->ci.size_centralExtra = size_extrafield_global;
    zip64local_putValue_inmemory(zi->ci.central_header,(uLong)CENTRALHEADERMAGIC,4);
    /* version info */
    zip64local_putValue_inmemory(zi->ci.central_header+4,(uLong)versionMadeBy,2);
    zip64local_putValue_inmemory(zi->ci.central_header+6,(uLong)20,2);
    zip64local_putValue_inmemory(zi->ci.central_header+8,(uLong)zi->ci.flag,2);
    zip64local_putValue_inmemory(zi->ci.central_header+10,(uLong)zi->ci.method,2);
    zip64local_putValue_inmemory(zi->ci.central_header+12,(uLong)zi->ci.dosDate,4);
    zip64local_putValue_inmemory(zi->ci.central_header+16,(uLong)0,4); /*crc*/
    zip64local_putValue_inmemory(zi->ci.central_header+20,(uLong)0,4); /*compr size*/
    zip64local_putValue_inmemory(zi->ci.central_header+24,(uLong)0,4); /*uncompr size*/
    zip64local_putValue_inmemory(zi->ci.central_header+28,(uLong)size_filename,2);
    zip64local_putValue_inmemory(zi->ci.central_header+30,(uLong)size_extrafield_global,2);
    zip64local_putValue_inmemory(zi->ci.central_header+32,(uLong)size_comment,2);
    zip64local_putValue_inmemory(zi->ci.central_header+34,(uLong)0,2); /*disk nm start*/

    if (zipfi==NULL)
        zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)0,2);
    else
        zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)zipfi->internal_fa,2);

    if (zipfi==NULL)
        zip64local_putValue_inmemory(zi->ci.central_header+38,(uLong)0,4);
    else
        zip64local_putValue_inmemory(zi->ci.central_header+38,(uLong)zipfi->external_fa,4);

    if(zi->ci.pos_local_header >= 0xffffffff)
      zip64local_putValue_inmemory(zi->ci.central_header+42,(uLong)0xffffffff,4);
    else
      zip64local_putValue_inmemory(zi->ci.central_header+42,(uLong)zi->ci.pos_local_header - zi->add_position_when_writing_offset,4);

    for (i=0;i<size_filename;i++)
        *(zi->ci.central_header+SIZECENTRALHEADER+i) = *(filename+i);

    for (i=0;i<size_extrafield_global;i++)
        *(zi->ci.central_header+SIZECENTRALHEADER+size_filename+i) =
              *(((const char*)extrafield_global)+i);

    for (i=0;i<size_comment;i++)
        *(zi->ci.central_header+SIZECENTRALHEADER+size_filename+
              size_extrafield_global+i) = *(comment+i);
    if (zi->ci.central_header == NULL)
        return ZIP_INTERNALERROR;

    zi->ci.zip64 = zip64;
    zi->ci.totalCompressedData = 0;
    zi->ci.totalUncompressedData = 0;
    zi->ci.pos_zip64extrainfo = 0;

    err = Write_LocalFileHeader(zi, filename, size_extrafield_local, extrafield_local);

#ifdef HAVE_BZIP2
    zi->ci.bstream.avail_in = (uInt)0;
    zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE;
    zi->ci.bstream.next_out = (char*)zi->ci.buffered_data;
    zi->ci.bstream.total_in_hi32 = 0;
    zi->ci.bstream.total_in_lo32 = 0;
    zi->ci.bstream.total_out_hi32 = 0;
    zi->ci.bstream.total_out_lo32 = 0;
#endif

    zi->ci.stream.avail_in = (uInt)0;
    zi->ci.stream.avail_out = (uInt)Z_BUFSIZE;
    zi->ci.stream.next_out = zi->ci.buffered_data;
    zi->ci.stream.total_in = 0;
    zi->ci.stream.total_out = 0;
    zi->ci.stream.data_type = Z_BINARY;

#ifdef HAVE_BZIP2
    if ((err==ZIP_OK) && (zi->ci.method == Z_DEFLATED || zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
#else
    if ((err==ZIP_OK) && (zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
#endif
    {
        if(zi->ci.method == Z_DEFLATED)
        {
          zi->ci.stream.zalloc = (alloc_func)0;
          zi->ci.stream.zfree = (free_func)0;
          zi->ci.stream.opaque = (voidpf)0;

          if (windowBits>0)
              windowBits = -windowBits;

          err = deflateInit2(&zi->ci.stream, level, Z_DEFLATED, windowBits, memLevel, strategy);

          if (err==Z_OK)
              zi->ci.stream_initialised = Z_DEFLATED;
        }
        else if(zi->ci.method == Z_BZIP2ED)
        {
#ifdef HAVE_BZIP2
            // Init BZip stuff here
          zi->ci.bstream.bzalloc = 0;
          zi->ci.bstream.bzfree = 0;
          zi->ci.bstream.opaque = (voidpf)0;

          err = BZ2_bzCompressInit(&zi->ci.bstream, level, 0,35);
          if(err == BZ_OK)
            zi->ci.stream_initialised = Z_BZIP2ED;
#endif
        }

    }

#    ifndef NOCRYPT
    zi->ci.crypt_header_size = 0;
    if ((err==Z_OK) && (password != NULL))
    {
        unsigned char bufHead[RAND_HEAD_LEN];
        unsigned int sizeHead;
        zi->ci.encrypt = 1;
        zi->ci.pcrc_32_tab = get_crc_table();
        /*init_keys(password,zi->ci.keys,zi->ci.pcrc_32_tab);*/

        sizeHead=crypthead(password,bufHead,RAND_HEAD_LEN,zi->ci.keys,zi->ci.pcrc_32_tab,crcForCrypting);
        zi->ci.crypt_header_size = sizeHead;

        if (ZWRITE64(zi->z_filefunc,zi->filestream,bufHead,sizeHead) != sizeHead)
                err = ZIP_ERRNO;
    }
#    endif

    if (err==Z_OK)
        zi->in_opened_file_inzip = 1;
    return err;
}

extern int ZEXPORT zipOpenNewFileInZip4 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                         const void* extrafield_local, uInt size_extrafield_local,
                                         const void* extrafield_global, uInt size_extrafield_global,
                                         const char* comment, int method, int level, int raw,
                                         int windowBits,int memLevel, int strategy,
                                         const char* password, uLong crcForCrypting,
                                         uLong versionMadeBy, uLong flagBase)
{
    return zipOpenNewFileInZip4_64 (file, filename, zipfi,
                                 extrafield_local, size_extrafield_local,
                                 extrafield_global, size_extrafield_global,
                                 comment, method, level, raw,
                                 windowBits, memLevel, strategy,
                                 password, crcForCrypting, versionMadeBy, flagBase, 0);
}

extern int ZEXPORT zipOpenNewFileInZip3 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                         const void* extrafield_local, uInt size_extrafield_local,
                                         const void* extrafield_global, uInt size_extrafield_global,
                                         const char* comment, int method, int level, int raw,
                                         int windowBits,int memLevel, int strategy,
                                         const char* password, uLong crcForCrypting)
{
    return zipOpenNewFileInZip4_64 (file, filename, zipfi,
                                 extrafield_local, size_extrafield_local,
                                 extrafield_global, size_extrafield_global,
                                 comment, method, level, raw,
                                 windowBits, memLevel, strategy,
                                 password, crcForCrypting, VERSIONMADEBY, 0, 0);
}

extern int ZEXPORT zipOpenNewFileInZip3_64(zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                         const void* extrafield_local, uInt size_extrafield_local,
                                         const void* extrafield_global, uInt size_extrafield_global,
                                         const char* comment, int method, int level, int raw,
                                         int windowBits,int memLevel, int strategy,
                                         const char* password, uLong crcForCrypting, int zip64)
{
    return zipOpenNewFileInZip4_64 (file, filename, zipfi,
                                 extrafield_local, size_extrafield_local,
                                 extrafield_global, size_extrafield_global,
                                 comment, method, level, raw,
                                 windowBits, memLevel, strategy,
                                 password, crcForCrypting, VERSIONMADEBY, 0, zip64);
}

extern int ZEXPORT zipOpenNewFileInZip2(zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                        const void* extrafield_local, uInt size_extrafield_local,
                                        const void* extrafield_global, uInt size_extrafield_global,
                                        const char* comment, int method, int level, int raw)
{
    return zipOpenNewFileInZip4_64 (file, filename, zipfi,
                                 extrafield_local, size_extrafield_local,
                                 extrafield_global, size_extrafield_global,
                                 comment, method, level, raw,
                                 -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                                 NULL, 0, VERSIONMADEBY, 0, 0);
}

extern int ZEXPORT zipOpenNewFileInZip2_64(zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                        const void* extrafield_local, uInt size_extrafield_local,
                                        const void* extrafield_global, uInt size_extrafield_global,
                                        const char* comment, int method, int level, int raw, int zip64)
{
    return zipOpenNewFileInZip4_64 (file, filename, zipfi,
                                 extrafield_local, size_extrafield_local,
                                 extrafield_global, size_extrafield_global,
                                 comment, method, level, raw,
                                 -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                                 NULL, 0, VERSIONMADEBY, 0, zip64);
}

extern int ZEXPORT zipOpenNewFileInZip64 (zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                        const void* extrafield_local, uInt size_extrafield_local,
                                        const void*extrafield_global, uInt size_extrafield_global,
                                        const char* comment, int method, int level, int zip64)
{
    return zipOpenNewFileInZip4_64 (file, filename, zipfi,
                                 extrafield_local, size_extrafield_local,
                                 extrafield_global, size_extrafield_global,
                                 comment, method, level, 0,
                                 -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                                 NULL, 0, VERSIONMADEBY, 0, zip64);
}

extern int ZEXPORT zipOpenNewFileInZip (zipFile file, const char* filename, const zip_fileinfo* zipfi,
                                        const void* extrafield_local, uInt size_extrafield_local,
                                        const void*extrafield_global, uInt size_extrafield_global,
                                        const char* comment, int method, int level)
{
    return zipOpenNewFileInZip4_64 (file, filename, zipfi,
                                 extrafield_local, size_extrafield_local,
                                 extrafield_global, size_extrafield_global,
                                 comment, method, level, 0,
                                 -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
                                 NULL, 0, VERSIONMADEBY, 0, 0);
}

local int zip64FlushWriteBuffer(zip64_internal* zi)
{
    int err=ZIP_OK;

    if (zi->ci.encrypt != 0)
    {
#ifndef NOCRYPT
        uInt i;
        int t;
        for (i=0;i<zi->ci.pos_in_buffered_data;i++)
            zi->ci.buffered_data[i] = zencode(zi->ci.keys, zi->ci.pcrc_32_tab, zi->ci.buffered_data[i],t);
#endif
    }

    if (ZWRITE64(zi->z_filefunc,zi->filestream,zi->ci.buffered_data,zi->ci.pos_in_buffered_data) != zi->ci.pos_in_buffered_data)
      err = ZIP_ERRNO;

    zi->ci.totalCompressedData += zi->ci.pos_in_buffered_data;

#ifdef HAVE_BZIP2
    if(zi->ci.method == Z_BZIP2ED)
    {
      zi->ci.totalUncompressedData += zi->ci.bstream.total_in_lo32;
      zi->ci.bstream.total_in_lo32 = 0;
      zi->ci.bstream.total_in_hi32 = 0;
    }
    else
#endif
    {
      zi->ci.totalUncompressedData += zi->ci.stream.total_in;
      zi->ci.stream.total_in = 0;
    }


    zi->ci.pos_in_buffered_data = 0;

    return err;
}

extern int ZEXPORT zipWriteInFileInZip (zipFile file,const void* buf,unsigned int len)
{
    zip64_internal* zi;
    int err=ZIP_OK;

    if (file == NULL)
        return ZIP_PARAMERROR;
    zi = (zip64_internal*)file;

    if (zi->in_opened_file_inzip == 0)
        return ZIP_PARAMERROR;

    zi->ci.crc32 = crc32(zi->ci.crc32,buf,(uInt)len);

#ifdef HAVE_BZIP2
    if(zi->ci.method == Z_BZIP2ED && (!zi->ci.raw))
    {
      zi->ci.bstream.next_in = (void*)buf;
      zi->ci.bstream.avail_in = len;
      err = BZ_RUN_OK;

      while ((err==BZ_RUN_OK) && (zi->ci.bstream.avail_in>0))
      {
        if (zi->ci.bstream.avail_out == 0)
        {
          if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
            err = ZIP_ERRNO;
          zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE;
          zi->ci.bstream.next_out = (char*)zi->ci.buffered_data;
        }


        if(err != BZ_RUN_OK)
          break;

        if ((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
        {
          uLong uTotalOutBefore_lo = zi->ci.bstream.total_out_lo32;
//          uLong uTotalOutBefore_hi = zi->ci.bstream.total_out_hi32;
          err=BZ2_bzCompress(&zi->ci.bstream,  BZ_RUN);

          zi->ci.pos_in_buffered_data += (uInt)(zi->ci.bstream.total_out_lo32 - uTotalOutBefore_lo) ;
        }
      }

      if(err == BZ_RUN_OK)
        err = ZIP_OK;
    }
    else
#endif
    {
      zi->ci.stream.next_in = (Bytef*)buf;
      zi->ci.stream.avail_in = len;

      while ((err==ZIP_OK) && (zi->ci.stream.avail_in>0))
      {
          if (zi->ci.stream.avail_out == 0)
          {
              if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
                  err = ZIP_ERRNO;
              zi->ci.stream.avail_out = (uInt)Z_BUFSIZE;
              zi->ci.stream.next_out = zi->ci.buffered_data;
          }


          if(err != ZIP_OK)
              break;

          if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
          {
              uLong uTotalOutBefore = zi->ci.stream.total_out;
              err=deflate(&zi->ci.stream,  Z_NO_FLUSH);
              if(uTotalOutBefore > zi->ci.stream.total_out)
              {
                int bBreak = 0;
                bBreak++;
              }

              zi->ci.pos_in_buffered_data += (uInt)(zi->ci.stream.total_out - uTotalOutBefore) ;
          }
          else
          {
              uInt copy_this,i;
              if (zi->ci.stream.avail_in < zi->ci.stream.avail_out)
                  copy_this = zi->ci.stream.avail_in;
              else
                  copy_this = zi->ci.stream.avail_out;

              for (i = 0; i < copy_this; i++)
                  *(((char*)zi->ci.stream.next_out)+i) =
                      *(((const char*)zi->ci.stream.next_in)+i);
              {
                  zi->ci.stream.avail_in -= copy_this;
                  zi->ci.stream.avail_out-= copy_this;
                  zi->ci.stream.next_in+= copy_this;
                  zi->ci.stream.next_out+= copy_this;
                  zi->ci.stream.total_in+= copy_this;
                  zi->ci.stream.total_out+= copy_this;
                  zi->ci.pos_in_buffered_data += copy_this;
              }
          }
      }// while(...)
    }

    return err;
}

extern int ZEXPORT zipCloseFileInZipRaw (zipFile file, uLong uncompressed_size, uLong crc32)
{
    return zipCloseFileInZipRaw64 (file, uncompressed_size, crc32);
}

extern int ZEXPORT zipCloseFileInZipRaw64 (zipFile file, ZPOS64_T uncompressed_size, uLong crc32)
{
    zip64_internal* zi;
    ZPOS64_T compressed_size;
    uLong invalidValue = 0xffffffff;
    short datasize = 0;
    int err=ZIP_OK;

    if (file == NULL)
        return ZIP_PARAMERROR;
    zi = (zip64_internal*)file;

    if (zi->in_opened_file_inzip == 0)
        return ZIP_PARAMERROR;
    zi->ci.stream.avail_in = 0;

    if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
                {
                        while (err==ZIP_OK)
                        {
                                uLong uTotalOutBefore;
                                if (zi->ci.stream.avail_out == 0)
                                {
                                        if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
                                                err = ZIP_ERRNO;
                                        zi->ci.stream.avail_out = (uInt)Z_BUFSIZE;
                                        zi->ci.stream.next_out = zi->ci.buffered_data;
                                }
                                uTotalOutBefore = zi->ci.stream.total_out;
                                err=deflate(&zi->ci.stream,  Z_FINISH);
                                zi->ci.pos_in_buffered_data += (uInt)(zi->ci.stream.total_out - uTotalOutBefore) ;
                        }
                }
    else if ((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
    {
#ifdef HAVE_BZIP2
      err = BZ_FINISH_OK;
      while (err==BZ_FINISH_OK)
      {
        uLong uTotalOutBefore;
        if (zi->ci.bstream.avail_out == 0)
        {
          if (zip64FlushWriteBuffer(zi) == ZIP_ERRNO)
            err = ZIP_ERRNO;
          zi->ci.bstream.avail_out = (uInt)Z_BUFSIZE;
          zi->ci.bstream.next_out = (char*)zi->ci.buffered_data;
        }
        uTotalOutBefore = zi->ci.bstream.total_out_lo32;
        err=BZ2_bzCompress(&zi->ci.bstream,  BZ_FINISH);
        if(err == BZ_STREAM_END)
          err = Z_STREAM_END;

        zi->ci.pos_in_buffered_data += (uInt)(zi->ci.bstream.total_out_lo32 - uTotalOutBefore);
      }

      if(err == BZ_FINISH_OK)
        err = ZIP_OK;
#endif
    }

    if (err==Z_STREAM_END)
        err=ZIP_OK; /* this is normal */

    if ((zi->ci.pos_in_buffered_data>0) && (err==ZIP_OK))
                {
        if (zip64FlushWriteBuffer(zi)==ZIP_ERRNO)
            err = ZIP_ERRNO;
                }

    if ((zi->ci.method == Z_DEFLATED) && (!zi->ci.raw))
    {
        int tmp_err = deflateEnd(&zi->ci.stream);
        if (err == ZIP_OK)
            err = tmp_err;
        zi->ci.stream_initialised = 0;
    }
#ifdef HAVE_BZIP2
    else if((zi->ci.method == Z_BZIP2ED) && (!zi->ci.raw))
    {
      int tmperr = BZ2_bzCompressEnd(&zi->ci.bstream);
                        if (err==ZIP_OK)
                                err = tmperr;
                        zi->ci.stream_initialised = 0;
    }
#endif

    if (!zi->ci.raw)
    {
        crc32 = (uLong)zi->ci.crc32;
        uncompressed_size = zi->ci.totalUncompressedData;
    }
    compressed_size = zi->ci.totalCompressedData;

#    ifndef NOCRYPT
    compressed_size += zi->ci.crypt_header_size;
#    endif

    // update Current Item crc and sizes,
    if(compressed_size >= 0xffffffff || uncompressed_size >= 0xffffffff || zi->ci.pos_local_header >= 0xffffffff)
    {
      /*version Made by*/
      zip64local_putValue_inmemory(zi->ci.central_header+4,(uLong)45,2);
      /*version needed*/
      zip64local_putValue_inmemory(zi->ci.central_header+6,(uLong)45,2);

    }

    zip64local_putValue_inmemory(zi->ci.central_header+16,crc32,4); /*crc*/


    if(compressed_size >= 0xffffffff)
      zip64local_putValue_inmemory(zi->ci.central_header+20, invalidValue,4); /*compr size*/
    else
      zip64local_putValue_inmemory(zi->ci.central_header+20, compressed_size,4); /*compr size*/

    /// set internal file attributes field
    if (zi->ci.stream.data_type == Z_ASCII)
        zip64local_putValue_inmemory(zi->ci.central_header+36,(uLong)Z_ASCII,2);

    if(uncompressed_size >= 0xffffffff)
      zip64local_putValue_inmemory(zi->ci.central_header+24, invalidValue,4); /*uncompr size*/
    else
      zip64local_putValue_inmemory(zi->ci.central_header+24, uncompressed_size,4); /*uncompr size*/

    // Add ZIP64 extra info field for uncompressed size
    if(uncompressed_size >= 0xffffffff)
      datasize += 8;

    // Add ZIP64 extra info field for compressed size
    if(compressed_size >= 0xffffffff)
      datasize += 8;

    // Add ZIP64 extra info field for relative offset to local file header of current file
    if(zi->ci.pos_local_header >= 0xffffffff)
      datasize += 8;

    if(datasize > 0)
    {
      char* p = NULL;

      if((uLong)(datasize + 4) > zi->ci.size_centralExtraFree)
      {
        // we can not write more data to the buffer that we have room for.
        return ZIP_BADZIPFILE;
      }

      p = zi->ci.central_header + zi->ci.size_centralheader;

      // Add Extra Information Header for 'ZIP64 information'
      zip64local_putValue_inmemory(p, 0x0001, 2); // HeaderID
      p += 2;
      zip64local_putValue_inmemory(p, datasize, 2); // DataSize
      p += 2;

      if(uncompressed_size >= 0xffffffff)
      {
        zip64local_putValue_inmemory(p, uncompressed_size, 8);
        p += 8;
      }

      if(compressed_size >= 0xffffffff)
      {
        zip64local_putValue_inmemory(p, compressed_size, 8);
        p += 8;
      }

      if(zi->ci.pos_local_header >= 0xffffffff)
      {
        zip64local_putValue_inmemory(p, zi->ci.pos_local_header, 8);
        p += 8;
      }

      // Update how much extra free space we got in the memory buffer
      // and increase the centralheader size so the new ZIP64 fields are included
      // ( 4 below is the size of HeaderID and DataSize field )
      zi->ci.size_centralExtraFree -= datasize + 4;
      zi->ci.size_centralheader += datasize + 4;

      // Update the extra info size field
      zi->ci.size_centralExtra += datasize + 4;
      zip64local_putValue_inmemory(zi->ci.central_header+30,(uLong)zi->ci.size_centralExtra,2);
    }

    if (err==ZIP_OK)
        err = add_data_in_datablock(&zi->central_dir, zi->ci.central_header, (uLong)zi->ci.size_centralheader);

    free(zi->ci.central_header);

    if (err==ZIP_OK)
    {
        // Update the LocalFileHeader with the new values.

        ZPOS64_T cur_pos_inzip = ZTELL64(zi->z_filefunc,zi->filestream);

        if (ZSEEK64(zi->z_filefunc,zi->filestream, zi->ci.pos_local_header + 14,ZLIB_FILEFUNC_SEEK_SET)!=0)
            err = ZIP_ERRNO;

        if (err==ZIP_OK)
            err = zip64local_putValue(&zi->z_filefunc,zi->filestream,crc32,4); /* crc 32, unknown */

        if(uncompressed_size >= 0xffffffff || compressed_size >= 0xffffffff )
        {
          if(zi->ci.pos_zip64extrainfo > 0)
          {
            // Update the size in the ZIP64 extended field.
            if (ZSEEK64(zi->z_filefunc,zi->filestream, zi->ci.pos_zip64extrainfo + 4,ZLIB_FILEFUNC_SEEK_SET)!=0)
              err = ZIP_ERRNO;

            if (err==ZIP_OK) /* compressed size, unknown */
              err = zip64local_putValue(&zi->z_filefunc, zi->filestream, uncompressed_size, 8);

            if (err==ZIP_OK) /* uncompressed size, unknown */
              err = zip64local_putValue(&zi->z_filefunc, zi->filestream, compressed_size, 8);
          }
          else
              err = ZIP_BADZIPFILE; // Caller passed zip64 = 0, so no room for zip64 info -> fatal
        }
        else
        {
          if (err==ZIP_OK) /* compressed size, unknown */
              err = zip64local_putValue(&zi->z_filefunc,zi->filestream,compressed_size,4);

          if (err==ZIP_OK) /* uncompressed size, unknown */
              err = zip64local_putValue(&zi->z_filefunc,zi->filestream,uncompressed_size,4);
        }

        if (ZSEEK64(zi->z_filefunc,zi->filestream, cur_pos_inzip,ZLIB_FILEFUNC_SEEK_SET)!=0)
            err = ZIP_ERRNO;
    }

    zi->number_entry ++;
    zi->in_opened_file_inzip = 0;

    return err;
}

extern int ZEXPORT zipCloseFileInZip (zipFile file)
{
    return zipCloseFileInZipRaw (file,0,0);
}

int Write_Zip64EndOfCentralDirectoryLocator(zip64_internal* zi, ZPOS64_T zip64eocd_pos_inzip)
{
  int err = ZIP_OK;
  ZPOS64_T pos = zip64eocd_pos_inzip - zi->add_position_when_writing_offset;

  err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ZIP64ENDLOCHEADERMAGIC,4);

  /*num disks*/
    if (err==ZIP_OK) /* number of the disk with the start of the central directory */
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4);

  /*relative offset*/
    if (err==ZIP_OK) /* Relative offset to the Zip64EndOfCentralDirectory */
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream, pos,8);

  /*total disks*/ /* Do not support spawning of disk so always say 1 here*/
    if (err==ZIP_OK) /* number of the disk with the start of the central directory */
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)1,4);

    return err;
}

int Write_Zip64EndOfCentralDirectoryRecord(zip64_internal* zi, uLong size_centraldir, ZPOS64_T centraldir_pos_inzip)
{
  int err = ZIP_OK;

  uLong Zip64DataSize = 44;

  err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ZIP64ENDHEADERMAGIC,4);

  if (err==ZIP_OK) /* size of this 'zip64 end of central directory' */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(ZPOS64_T)Zip64DataSize,8); // why ZPOS64_T of this ?

  if (err==ZIP_OK) /* version made by */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2);

  if (err==ZIP_OK) /* version needed */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)45,2);

  if (err==ZIP_OK) /* number of this disk */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4);

  if (err==ZIP_OK) /* number of the disk with the start of the central directory */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,4);

  if (err==ZIP_OK) /* total number of entries in the central dir on this disk */
    err = zip64local_putValue(&zi->z_filefunc, zi->filestream, zi->number_entry, 8);

  if (err==ZIP_OK) /* total number of entries in the central dir */
    err = zip64local_putValue(&zi->z_filefunc, zi->filestream, zi->number_entry, 8);

  if (err==ZIP_OK) /* size of the central directory */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(ZPOS64_T)size_centraldir,8);

  if (err==ZIP_OK) /* offset of start of central directory with respect to the starting disk number */
  {
    ZPOS64_T pos = centraldir_pos_inzip - zi->add_position_when_writing_offset;
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (ZPOS64_T)pos,8);
  }
  return err;
}
int Write_EndOfCentralDirectoryRecord(zip64_internal* zi, uLong size_centraldir, ZPOS64_T centraldir_pos_inzip)
{
  int err = ZIP_OK;

  /*signature*/
  err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)ENDHEADERMAGIC,4);

  if (err==ZIP_OK) /* number of this disk */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,2);

  if (err==ZIP_OK) /* number of the disk with the start of the central directory */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0,2);

  if (err==ZIP_OK) /* total number of entries in the central dir on this disk */
  {
    {
      if(zi->number_entry >= 0xFFFF)
        err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xffff,2); // use value in ZIP64 record
      else
        err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->number_entry,2);
    }
  }

  if (err==ZIP_OK) /* total number of entries in the central dir */
  {
    if(zi->number_entry >= 0xFFFF)
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)0xffff,2); // use value in ZIP64 record
    else
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)zi->number_entry,2);
  }

  if (err==ZIP_OK) /* size of the central directory */
    err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_centraldir,4);

  if (err==ZIP_OK) /* offset of start of central directory with respect to the starting disk number */
  {
    ZPOS64_T pos = centraldir_pos_inzip - zi->add_position_when_writing_offset;
    if(pos >= 0xffffffff)
    {
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (uLong)0xffffffff,4);
    }
    else
      err = zip64local_putValue(&zi->z_filefunc,zi->filestream, (uLong)(centraldir_pos_inzip - zi->add_position_when_writing_offset),4);
  }

   return err;
}

int Write_GlobalComment(zip64_internal* zi, const char* global_comment)
{
  int err = ZIP_OK;
  uInt size_global_comment = 0;

  if(global_comment != NULL)
    size_global_comment = (uInt)strlen(global_comment);

  err = zip64local_putValue(&zi->z_filefunc,zi->filestream,(uLong)size_global_comment,2);

  if (err == ZIP_OK && size_global_comment > 0)
  {
    if (ZWRITE64(zi->z_filefunc,zi->filestream, global_comment, size_global_comment) != size_global_comment)
      err = ZIP_ERRNO;
  }
  return err;
}

extern int ZEXPORT zipClose (zipFile file, const char* global_comment)
{
    zip64_internal* zi;
    int err = 0;
    uLong size_centraldir = 0;
    ZPOS64_T centraldir_pos_inzip;
    ZPOS64_T pos;

    if (file == NULL)
        return ZIP_PARAMERROR;

    zi = (zip64_internal*)file;

    if (zi->in_opened_file_inzip == 1)
    {
        err = zipCloseFileInZip (file);
    }

#ifndef NO_ADDFILEINEXISTINGZIP
    if (global_comment==NULL)
        global_comment = zi->globalcomment;
#endif

    centraldir_pos_inzip = ZTELL64(zi->z_filefunc,zi->filestream);

    if (err==ZIP_OK)
    {
        linkedlist_datablock_internal* ldi = zi->central_dir.first_block;
        while (ldi!=NULL)
        {
            if ((err==ZIP_OK) && (ldi->filled_in_this_block>0))
            {
                if (ZWRITE64(zi->z_filefunc,zi->filestream, ldi->data, ldi->filled_in_this_block) != ldi->filled_in_this_block)
                    err = ZIP_ERRNO;
            }

            size_centraldir += ldi->filled_in_this_block;
            ldi = ldi->next_datablock;
        }
    }
    free_linkedlist(&(zi->central_dir));

    pos = centraldir_pos_inzip - zi->add_position_when_writing_offset;
    if(pos >= 0xffffffff || zi->number_entry > 0xFFFF)
    {
      ZPOS64_T Zip64EOCDpos = ZTELL64(zi->z_filefunc,zi->filestream);
      Write_Zip64EndOfCentralDirectoryRecord(zi, size_centraldir, centraldir_pos_inzip);

      Write_Zip64EndOfCentralDirectoryLocator(zi, Zip64EOCDpos);
    }

    if (err==ZIP_OK)
      err = Write_EndOfCentralDirectoryRecord(zi, size_centraldir, centraldir_pos_inzip);

    if(err == ZIP_OK)
      err = Write_GlobalComment(zi, global_comment);

    if (ZCLOSE64(zi->z_filefunc,zi->filestream) != 0)
        if (err == ZIP_OK)
            err = ZIP_ERRNO;

#ifndef NO_ADDFILEINEXISTINGZIP
    TRYFREE(zi->globalcomment);
#endif
    TRYFREE(zi);

    return err;
}

extern int ZEXPORT zipRemoveExtraInfoBlock (char* pData, int* dataLen, short sHeader)
{
  char* p = pData;
  int size = 0;
  char* pNewHeader;
  char* pTmp;
  short header;
  short dataSize;

  int retVal = ZIP_OK;

  if(pData == NULL || *dataLen < 4)
    return ZIP_PARAMERROR;

  pNewHeader = (char*)ALLOC(*dataLen);
  pTmp = pNewHeader;

  while(p < (pData + *dataLen))
  {
    header = *(short*)p;
    dataSize = *(((short*)p)+1);

    if( header == sHeader ) // Header found.
    {
      p += dataSize + 4; // skip it. do not copy to temp buffer
    }
    else
    {
      // Extra Info block should not be removed, So copy it to the temp buffer.
      memcpy(pTmp, p, dataSize + 4);
      p += dataSize + 4;
      size += dataSize + 4;
    }

  }

  if(size < *dataLen)
  {
    // clean old extra info block.
    memset(pData,0, *dataLen);

    // copy the new extra info block over the old
    if(size > 0)
      memcpy(pData, pNewHeader, size);

    // set the new extra info size
    *dataLen = size;

    retVal = ZIP_OK;
  }
  else
    retVal = ZIP_ERRNO;

  TRYFREE(pNewHeader);

  return retVal;
}

Deleted compat/zlib/contrib/minizip/zip.h.

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










































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zip.h -- IO on .zip files using zlib
   Version 1.1, February 14h, 2010
   part of the MiniZip project - ( http://www.winimage.com/zLibDll/minizip.html )

         Copyright (C) 1998-2010 Gilles Vollant (minizip) ( http://www.winimage.com/zLibDll/minizip.html )

         Modifications for Zip64 support
         Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )

         For more info read MiniZip_info.txt

         ---------------------------------------------------------------------------

   Condition of use and distribution are the same than zlib :

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

        ---------------------------------------------------------------------------

        Changes

        See header of zip.h

*/

#ifndef _zip12_H
#define _zip12_H

#ifdef __cplusplus
extern "C" {
#endif

//#define HAVE_BZIP2

#ifndef _ZLIB_H
#include "zlib.h"
#endif

#ifndef _ZLIBIOAPI_H
#include "ioapi.h"
#endif

#ifdef HAVE_BZIP2
#include "bzlib.h"
#endif

#define Z_BZIP2ED 12

#if defined(STRICTZIP) || defined(STRICTZIPUNZIP)
/* like the STRICT of WIN32, we define a pointer that cannot be converted
    from (void*) without cast */
typedef struct TagzipFile__ { int unused; } zipFile__;
typedef zipFile__ *zipFile;
#else
typedef voidp zipFile;
#endif

#define ZIP_OK                          (0)
#define ZIP_EOF                         (0)
#define ZIP_ERRNO                       (Z_ERRNO)
#define ZIP_PARAMERROR                  (-102)
#define ZIP_BADZIPFILE                  (-103)
#define ZIP_INTERNALERROR               (-104)

#ifndef DEF_MEM_LEVEL
#  if MAX_MEM_LEVEL >= 8
#    define DEF_MEM_LEVEL 8
#  else
#    define DEF_MEM_LEVEL  MAX_MEM_LEVEL
#  endif
#endif
/* default memLevel */

/* tm_zip contain date/time info */
typedef struct tm_zip_s
{
    uInt tm_sec;            /* seconds after the minute - [0,59] */
    uInt tm_min;            /* minutes after the hour - [0,59] */
    uInt tm_hour;           /* hours since midnight - [0,23] */
    uInt tm_mday;           /* day of the month - [1,31] */
    uInt tm_mon;            /* months since January - [0,11] */
    uInt tm_year;           /* years - [1980..2044] */
} tm_zip;

typedef struct
{
    tm_zip      tmz_date;       /* date in understandable format           */
    uLong       dosDate;       /* if dos_date == 0, tmu_date is used      */
/*    uLong       flag;        */   /* general purpose bit flag        2 bytes */

    uLong       internal_fa;    /* internal file attributes        2 bytes */
    uLong       external_fa;    /* external file attributes        4 bytes */
} zip_fileinfo;

typedef const char* zipcharpc;


#define APPEND_STATUS_CREATE        (0)
#define APPEND_STATUS_CREATEAFTER   (1)
#define APPEND_STATUS_ADDINZIP      (2)

extern zipFile ZEXPORT zipOpen OF((const char *pathname, int append));
extern zipFile ZEXPORT zipOpen64 OF((const void *pathname, int append));
/*
  Create a zipfile.
     pathname contain on Windows XP a filename like "c:\\zlib\\zlib113.zip" or on
       an Unix computer "zlib/zlib113.zip".
     if the file pathname exist and append==APPEND_STATUS_CREATEAFTER, the zip
       will be created at the end of the file.
         (useful if the file contain a self extractor code)
     if the file pathname exist and append==APPEND_STATUS_ADDINZIP, we will
       add files in existing zip (be sure you don't add file that doesn't exist)
     If the zipfile cannot be opened, the return value is NULL.
     Else, the return value is a zipFile Handle, usable with other function
       of this zip package.
*/

/* Note : there is no delete function into a zipfile.
   If you want delete file into a zipfile, you must open a zipfile, and create another
   Of couse, you can use RAW reading and writing to copy the file you did not want delte
*/

extern zipFile ZEXPORT zipOpen2 OF((const char *pathname,
                                   int append,
                                   zipcharpc* globalcomment,
                                   zlib_filefunc_def* pzlib_filefunc_def));

extern zipFile ZEXPORT zipOpen2_64 OF((const void *pathname,
                                   int append,
                                   zipcharpc* globalcomment,
                                   zlib_filefunc64_def* pzlib_filefunc_def));

extern int ZEXPORT zipOpenNewFileInZip OF((zipFile file,
                       const char* filename,
                       const zip_fileinfo* zipfi,
                       const void* extrafield_local,
                       uInt size_extrafield_local,
                       const void* extrafield_global,
                       uInt size_extrafield_global,
                       const char* comment,
                       int method,
                       int level));

extern int ZEXPORT zipOpenNewFileInZip64 OF((zipFile file,
                       const char* filename,
                       const zip_fileinfo* zipfi,
                       const void* extrafield_local,
                       uInt size_extrafield_local,
                       const void* extrafield_global,
                       uInt size_extrafield_global,
                       const char* comment,
                       int method,
                       int level,
                       int zip64));

/*
  Open a file in the ZIP for writing.
  filename : the filename in zip (if NULL, '-' without quote will be used
  *zipfi contain supplemental information
  if extrafield_local!=NULL and size_extrafield_local>0, extrafield_local
    contains the extrafield data the the local header
  if extrafield_global!=NULL and size_extrafield_global>0, extrafield_global
    contains the extrafield data the the local header
  if comment != NULL, comment contain the comment string
  method contain the compression method (0 for store, Z_DEFLATED for deflate)
  level contain the level of compression (can be Z_DEFAULT_COMPRESSION)
  zip64 is set to 1 if a zip64 extended information block should be added to the local file header.
                    this MUST be '1' if the uncompressed size is >= 0xffffffff.

*/


extern int ZEXPORT zipOpenNewFileInZip2 OF((zipFile file,
                                            const char* filename,
                                            const zip_fileinfo* zipfi,
                                            const void* extrafield_local,
                                            uInt size_extrafield_local,
                                            const void* extrafield_global,
                                            uInt size_extrafield_global,
                                            const char* comment,
                                            int method,
                                            int level,
                                            int raw));


extern int ZEXPORT zipOpenNewFileInZip2_64 OF((zipFile file,
                                            const char* filename,
                                            const zip_fileinfo* zipfi,
                                            const void* extrafield_local,
                                            uInt size_extrafield_local,
                                            const void* extrafield_global,
                                            uInt size_extrafield_global,
                                            const char* comment,
                                            int method,
                                            int level,
                                            int raw,
                                            int zip64));
/*
  Same than zipOpenNewFileInZip, except if raw=1, we write raw file
 */

extern int ZEXPORT zipOpenNewFileInZip3 OF((zipFile file,
                                            const char* filename,
                                            const zip_fileinfo* zipfi,
                                            const void* extrafield_local,
                                            uInt size_extrafield_local,
                                            const void* extrafield_global,
                                            uInt size_extrafield_global,
                                            const char* comment,
                                            int method,
                                            int level,
                                            int raw,
                                            int windowBits,
                                            int memLevel,
                                            int strategy,
                                            const char* password,
                                            uLong crcForCrypting));

extern int ZEXPORT zipOpenNewFileInZip3_64 OF((zipFile file,
                                            const char* filename,
                                            const zip_fileinfo* zipfi,
                                            const void* extrafield_local,
                                            uInt size_extrafield_local,
                                            const void* extrafield_global,
                                            uInt size_extrafield_global,
                                            const char* comment,
                                            int method,
                                            int level,
                                            int raw,
                                            int windowBits,
                                            int memLevel,
                                            int strategy,
                                            const char* password,
                                            uLong crcForCrypting,
                                            int zip64
                                            ));

/*
  Same than zipOpenNewFileInZip2, except
    windowBits,memLevel,,strategy : see parameter strategy in deflateInit2
    password : crypting password (NULL for no crypting)
    crcForCrypting : crc of file to compress (needed for crypting)
 */

extern int ZEXPORT zipOpenNewFileInZip4 OF((zipFile file,
                                            const char* filename,
                                            const zip_fileinfo* zipfi,
                                            const void* extrafield_local,
                                            uInt size_extrafield_local,
                                            const void* extrafield_global,
                                            uInt size_extrafield_global,
                                            const char* comment,
                                            int method,
                                            int level,
                                            int raw,
                                            int windowBits,
                                            int memLevel,
                                            int strategy,
                                            const char* password,
                                            uLong crcForCrypting,
                                            uLong versionMadeBy,
                                            uLong flagBase
                                            ));


extern int ZEXPORT zipOpenNewFileInZip4_64 OF((zipFile file,
                                            const char* filename,
                                            const zip_fileinfo* zipfi,
                                            const void* extrafield_local,
                                            uInt size_extrafield_local,
                                            const void* extrafield_global,
                                            uInt size_extrafield_global,
                                            const char* comment,
                                            int method,
                                            int level,
                                            int raw,
                                            int windowBits,
                                            int memLevel,
                                            int strategy,
                                            const char* password,
                                            uLong crcForCrypting,
                                            uLong versionMadeBy,
                                            uLong flagBase,
                                            int zip64
                                            ));
/*
  Same than zipOpenNewFileInZip4, except
    versionMadeBy : value for Version made by field
    flag : value for flag field (compression level info will be added)
 */


extern int ZEXPORT zipWriteInFileInZip OF((zipFile file,
                       const void* buf,
                       unsigned len));
/*
  Write data in the zipfile
*/

extern int ZEXPORT zipCloseFileInZip OF((zipFile file));
/*
  Close the current file in the zipfile
*/

extern int ZEXPORT zipCloseFileInZipRaw OF((zipFile file,
                                            uLong uncompressed_size,
                                            uLong crc32));

extern int ZEXPORT zipCloseFileInZipRaw64 OF((zipFile file,
                                            ZPOS64_T uncompressed_size,
                                            uLong crc32));

/*
  Close the current file in the zipfile, for file opened with
    parameter raw=1 in zipOpenNewFileInZip2
  uncompressed_size and crc32 are value for the uncompressed size
*/

extern int ZEXPORT zipClose OF((zipFile file,
                const char* global_comment));
/*
  Close the zipfile
*/


extern int ZEXPORT zipRemoveExtraInfoBlock OF((char* pData, int* dataLen, short sHeader));
/*
  zipRemoveExtraInfoBlock -  Added by Mathias Svensson

  Remove extra information block from a extra information data for the local file header or central directory header

  It is needed to remove ZIP64 extra information blocks when before data is written if using RAW mode.

  0x0001 is the signature header for the ZIP64 extra information blocks

  usage.
                        Remove ZIP64 Extra information from a central director extra field data
              zipRemoveExtraInfoBlock(pCenDirExtraFieldData, &nCenDirExtraFieldDataLen, 0x0001);

                        Remove ZIP64 Extra information from a Local File Header extra field data
        zipRemoveExtraInfoBlock(pLocalHeaderExtraFieldData, &nLocalHeaderExtraFieldDataLen, 0x0001);
*/

#ifdef __cplusplus
}
#endif

#endif /* _zip64_H */

Deleted compat/zlib/contrib/pascal/example.pas.

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
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
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
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























































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
(* example.c -- usage example of the zlib compression library
 * Copyright (C) 1995-2003 Jean-loup Gailly.
 * For conditions of distribution and use, see copyright notice in zlib.h
 *
 * Pascal translation
 * Copyright (C) 1998 by Jacques Nomssi Nzali.
 * For conditions of distribution and use, see copyright notice in readme.txt
 *
 * Adaptation to the zlibpas interface
 * Copyright (C) 2003 by Cosmin Truta.
 * For conditions of distribution and use, see copyright notice in readme.txt
 *)

program example;

{$DEFINE TEST_COMPRESS}
{DO NOT $DEFINE TEST_GZIO}
{$DEFINE TEST_DEFLATE}
{$DEFINE TEST_INFLATE}
{$DEFINE TEST_FLUSH}
{$DEFINE TEST_SYNC}
{$DEFINE TEST_DICT}

uses SysUtils, zlibpas;

const TESTFILE = 'foo.gz';

(* "hello world" would be more standard, but the repeated "hello"
 * stresses the compression code better, sorry...
 *)
const hello: PChar = 'hello, hello!';

const dictionary: PChar = 'hello';

var dictId: LongInt; (* Adler32 value of the dictionary *)

procedure CHECK_ERR(err: Integer; msg: String);
begin
  if err <> Z_OK then
  begin
    WriteLn(msg, ' error: ', err);
    Halt(1);
  end;
end;

procedure EXIT_ERR(const msg: String);
begin
  WriteLn('Error: ', msg);
  Halt(1);
end;

(* ===========================================================================
 * Test compress and uncompress
 *)
{$IFDEF TEST_COMPRESS}
procedure test_compress(compr: Pointer; comprLen: LongInt;
                        uncompr: Pointer; uncomprLen: LongInt);
var err: Integer;
    len: LongInt;
begin
  len := StrLen(hello)+1;

  err := compress(compr, comprLen, hello, len);
  CHECK_ERR(err, 'compress');

  StrCopy(PChar(uncompr), 'garbage');

  err := uncompress(uncompr, uncomprLen, compr, comprLen);
  CHECK_ERR(err, 'uncompress');

  if StrComp(PChar(uncompr), hello) <> 0 then
    EXIT_ERR('bad uncompress')
  else
    WriteLn('uncompress(): ', PChar(uncompr));
end;
{$ENDIF}

(* ===========================================================================
 * Test read/write of .gz files
 *)
{$IFDEF TEST_GZIO}
procedure test_gzio(const fname: PChar; (* compressed file name *)
                    uncompr: Pointer;
                    uncomprLen: LongInt);
var err: Integer;
    len: Integer;
    zfile: gzFile;
    pos: LongInt;
begin
  len := StrLen(hello)+1;

  zfile := gzopen(fname, 'wb');
  if zfile = NIL then
  begin
    WriteLn('gzopen error');
    Halt(1);
  end;
  gzputc(zfile, 'h');
  if gzputs(zfile, 'ello') <> 4 then
  begin
    WriteLn('gzputs err: ', gzerror(zfile, err));
    Halt(1);
  end;
  {$IFDEF GZ_FORMAT_STRING}
  if gzprintf(zfile, ', %s!', 'hello') <> 8 then
  begin
    WriteLn('gzprintf err: ', gzerror(zfile, err));
    Halt(1);
  end;
  {$ELSE}
  if gzputs(zfile, ', hello!') <> 8 then
  begin
    WriteLn('gzputs err: ', gzerror(zfile, err));
    Halt(1);
  end;
  {$ENDIF}
  gzseek(zfile, 1, SEEK_CUR); (* add one zero byte *)
  gzclose(zfile);

  zfile := gzopen(fname, 'rb');
  if zfile = NIL then
  begin
    WriteLn('gzopen error');
    Halt(1);
  end;

  StrCopy(PChar(uncompr), 'garbage');

  if gzread(zfile, uncompr, uncomprLen) <> len then
  begin
    WriteLn('gzread err: ', gzerror(zfile, err));
    Halt(1);
  end;
  if StrComp(PChar(uncompr), hello) <> 0 then
  begin
    WriteLn('bad gzread: ', PChar(uncompr));
    Halt(1);
  end
  else
    WriteLn('gzread(): ', PChar(uncompr));

  pos := gzseek(zfile, -8, SEEK_CUR);
  if (pos <> 6) or (gztell(zfile) <> pos) then
  begin
    WriteLn('gzseek error, pos=', pos, ', gztell=', gztell(zfile));
    Halt(1);
  end;

  if gzgetc(zfile) <> ' ' then
  begin
    WriteLn('gzgetc error');
    Halt(1);
  end;

  if gzungetc(' ', zfile) <> ' ' then
  begin
    WriteLn('gzungetc error');
    Halt(1);
  end;

  gzgets(zfile, PChar(uncompr), uncomprLen);
  uncomprLen := StrLen(PChar(uncompr));
  if uncomprLen <> 7 then (* " hello!" *)
  begin
    WriteLn('gzgets err after gzseek: ', gzerror(zfile, err));
    Halt(1);
  end;
  if StrComp(PChar(uncompr), hello + 6) <> 0 then
  begin
    WriteLn('bad gzgets after gzseek');
    Halt(1);
  end
  else
    WriteLn('gzgets() after gzseek: ', PChar(uncompr));

  gzclose(zfile);
end;
{$ENDIF}

(* ===========================================================================
 * Test deflate with small buffers
 *)
{$IFDEF TEST_DEFLATE}
procedure test_deflate(compr: Pointer; comprLen: LongInt);
var c_stream: z_stream; (* compression stream *)
    err: Integer;
    len: LongInt;
begin
  len := StrLen(hello)+1;

  c_stream.zalloc := NIL;
  c_stream.zfree := NIL;
  c_stream.opaque := NIL;

  err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
  CHECK_ERR(err, 'deflateInit');

  c_stream.next_in := hello;
  c_stream.next_out := compr;

  while (c_stream.total_in <> len) and
        (c_stream.total_out < comprLen) do
  begin
    c_stream.avail_out := 1; { force small buffers }
    c_stream.avail_in := 1;
    err := deflate(c_stream, Z_NO_FLUSH);
    CHECK_ERR(err, 'deflate');
  end;

  (* Finish the stream, still forcing small buffers: *)
  while TRUE do
  begin
    c_stream.avail_out := 1;
    err := deflate(c_stream, Z_FINISH);
    if err = Z_STREAM_END then
      break;
    CHECK_ERR(err, 'deflate');
  end;

  err := deflateEnd(c_stream);
  CHECK_ERR(err, 'deflateEnd');
end;
{$ENDIF}

(* ===========================================================================
 * Test inflate with small buffers
 *)
{$IFDEF TEST_INFLATE}
procedure test_inflate(compr: Pointer; comprLen : LongInt;
                       uncompr: Pointer; uncomprLen : LongInt);
var err: Integer;
    d_stream: z_stream; (* decompression stream *)
begin
  StrCopy(PChar(uncompr), 'garbage');

  d_stream.zalloc := NIL;
  d_stream.zfree := NIL;
  d_stream.opaque := NIL;

  d_stream.next_in := compr;
  d_stream.avail_in := 0;
  d_stream.next_out := uncompr;

  err := inflateInit(d_stream);
  CHECK_ERR(err, 'inflateInit');

  while (d_stream.total_out < uncomprLen) and
        (d_stream.total_in < comprLen) do
  begin
    d_stream.avail_out := 1; (* force small buffers *)
    d_stream.avail_in := 1;
    err := inflate(d_stream, Z_NO_FLUSH);
    if err = Z_STREAM_END then
      break;
    CHECK_ERR(err, 'inflate');
  end;

  err := inflateEnd(d_stream);
  CHECK_ERR(err, 'inflateEnd');

  if StrComp(PChar(uncompr), hello) <> 0 then
    EXIT_ERR('bad inflate')
  else
    WriteLn('inflate(): ', PChar(uncompr));
end;
{$ENDIF}

(* ===========================================================================
 * Test deflate with large buffers and dynamic change of compression level
 *)
{$IFDEF TEST_DEFLATE}
procedure test_large_deflate(compr: Pointer; comprLen: LongInt;
                             uncompr: Pointer; uncomprLen: LongInt);
var c_stream: z_stream; (* compression stream *)
    err: Integer;
begin
  c_stream.zalloc := NIL;
  c_stream.zfree := NIL;
  c_stream.opaque := NIL;

  err := deflateInit(c_stream, Z_BEST_SPEED);
  CHECK_ERR(err, 'deflateInit');

  c_stream.next_out := compr;
  c_stream.avail_out := Integer(comprLen);

  (* At this point, uncompr is still mostly zeroes, so it should compress
   * very well:
   *)
  c_stream.next_in := uncompr;
  c_stream.avail_in := Integer(uncomprLen);
  err := deflate(c_stream, Z_NO_FLUSH);
  CHECK_ERR(err, 'deflate');
  if c_stream.avail_in <> 0 then
    EXIT_ERR('deflate not greedy');

  (* Feed in already compressed data and switch to no compression: *)
  deflateParams(c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY);
  c_stream.next_in := compr;
  c_stream.avail_in := Integer(comprLen div 2);
  err := deflate(c_stream, Z_NO_FLUSH);
  CHECK_ERR(err, 'deflate');

  (* Switch back to compressing mode: *)
  deflateParams(c_stream, Z_BEST_COMPRESSION, Z_FILTERED);
  c_stream.next_in := uncompr;
  c_stream.avail_in := Integer(uncomprLen);
  err := deflate(c_stream, Z_NO_FLUSH);
  CHECK_ERR(err, 'deflate');

  err := deflate(c_stream, Z_FINISH);
  if err <> Z_STREAM_END then
    EXIT_ERR('deflate should report Z_STREAM_END');

  err := deflateEnd(c_stream);
  CHECK_ERR(err, 'deflateEnd');
end;
{$ENDIF}

(* ===========================================================================
 * Test inflate with large buffers
 *)
{$IFDEF TEST_INFLATE}
procedure test_large_inflate(compr: Pointer; comprLen: LongInt;
                             uncompr: Pointer; uncomprLen: LongInt);
var err: Integer;
    d_stream: z_stream; (* decompression stream *)
begin
  StrCopy(PChar(uncompr), 'garbage');

  d_stream.zalloc := NIL;
  d_stream.zfree := NIL;
  d_stream.opaque := NIL;

  d_stream.next_in := compr;
  d_stream.avail_in := Integer(comprLen);

  err := inflateInit(d_stream);
  CHECK_ERR(err, 'inflateInit');

  while TRUE do
  begin
    d_stream.next_out := uncompr;            (* discard the output *)
    d_stream.avail_out := Integer(uncomprLen);
    err := inflate(d_stream, Z_NO_FLUSH);
    if err = Z_STREAM_END then
      break;
    CHECK_ERR(err, 'large inflate');
  end;

  err := inflateEnd(d_stream);
  CHECK_ERR(err, 'inflateEnd');

  if d_stream.total_out <> 2 * uncomprLen + comprLen div 2 then
  begin
    WriteLn('bad large inflate: ', d_stream.total_out);
    Halt(1);
  end
  else
    WriteLn('large_inflate(): OK');
end;
{$ENDIF}

(* ===========================================================================
 * Test deflate with full flush
 *)
{$IFDEF TEST_FLUSH}
procedure test_flush(compr: Pointer; var comprLen : LongInt);
var c_stream: z_stream; (* compression stream *)
    err: Integer;
    len: Integer;
begin
  len := StrLen(hello)+1;

  c_stream.zalloc := NIL;
  c_stream.zfree := NIL;
  c_stream.opaque := NIL;

  err := deflateInit(c_stream, Z_DEFAULT_COMPRESSION);
  CHECK_ERR(err, 'deflateInit');

  c_stream.next_in := hello;
  c_stream.next_out := compr;
  c_stream.avail_in := 3;
  c_stream.avail_out := Integer(comprLen);
  err := deflate(c_stream, Z_FULL_FLUSH);
  CHECK_ERR(err, 'deflate');

  Inc(PByteArray(compr)^[3]); (* force an error in first compressed block *)
  c_stream.avail_in := len - 3;

  err := deflate(c_stream, Z_FINISH);
  if err <> Z_STREAM_END then
    CHECK_ERR(err, 'deflate');

  err := deflateEnd(c_stream);
  CHECK_ERR(err, 'deflateEnd');

  comprLen := c_stream.total_out;
end;
{$ENDIF}

(* ===========================================================================
 * Test inflateSync()
 *)
{$IFDEF TEST_SYNC}
procedure test_sync(compr: Pointer; comprLen: LongInt;
                    uncompr: Pointer; uncomprLen : LongInt);
var err: Integer;
    d_stream: z_stream; (* decompression stream *)
begin
  StrCopy(PChar(uncompr), 'garbage');

  d_stream.zalloc := NIL;
  d_stream.zfree := NIL;
  d_stream.opaque := NIL;

  d_stream.next_in := compr;
  d_stream.avail_in := 2; (* just read the zlib header *)

  err := inflateInit(d_stream);
  CHECK_ERR(err, 'inflateInit');

  d_stream.next_out := uncompr;
  d_stream.avail_out := Integer(uncomprLen);

  inflate(d_stream, Z_NO_FLUSH);
  CHECK_ERR(err, 'inflate');

  d_stream.avail_in := Integer(comprLen-2);   (* read all compressed data *)
  err := inflateSync(d_stream);               (* but skip the damaged part *)
  CHECK_ERR(err, 'inflateSync');

  err := inflate(d_stream, Z_FINISH);
  if err <> Z_DATA_ERROR then
    EXIT_ERR('inflate should report DATA_ERROR');
    (* Because of incorrect adler32 *)

  err := inflateEnd(d_stream);
  CHECK_ERR(err, 'inflateEnd');

  WriteLn('after inflateSync(): hel', PChar(uncompr));
end;
{$ENDIF}

(* ===========================================================================
 * Test deflate with preset dictionary
 *)
{$IFDEF TEST_DICT}
procedure test_dict_deflate(compr: Pointer; comprLen: LongInt);
var c_stream: z_stream; (* compression stream *)
    err: Integer;
begin
  c_stream.zalloc := NIL;
  c_stream.zfree := NIL;
  c_stream.opaque := NIL;

  err := deflateInit(c_stream, Z_BEST_COMPRESSION);
  CHECK_ERR(err, 'deflateInit');

  err := deflateSetDictionary(c_stream, dictionary, StrLen(dictionary));
  CHECK_ERR(err, 'deflateSetDictionary');

  dictId := c_stream.adler;
  c_stream.next_out := compr;
  c_stream.avail_out := Integer(comprLen);

  c_stream.next_in := hello;
  c_stream.avail_in := StrLen(hello)+1;

  err := deflate(c_stream, Z_FINISH);
  if err <> Z_STREAM_END then
    EXIT_ERR('deflate should report Z_STREAM_END');

  err := deflateEnd(c_stream);
  CHECK_ERR(err, 'deflateEnd');
end;
{$ENDIF}

(* ===========================================================================
 * Test inflate with a preset dictionary
 *)
{$IFDEF TEST_DICT}
procedure test_dict_inflate(compr: Pointer; comprLen: LongInt;
                            uncompr: Pointer; uncomprLen: LongInt);
var err: Integer;
    d_stream: z_stream; (* decompression stream *)
begin
  StrCopy(PChar(uncompr), 'garbage');

  d_stream.zalloc := NIL;
  d_stream.zfree := NIL;
  d_stream.opaque := NIL;

  d_stream.next_in := compr;
  d_stream.avail_in := Integer(comprLen);

  err := inflateInit(d_stream);
  CHECK_ERR(err, 'inflateInit');

  d_stream.next_out := uncompr;
  d_stream.avail_out := Integer(uncomprLen);

  while TRUE do
  begin
    err := inflate(d_stream, Z_NO_FLUSH);
    if err = Z_STREAM_END then
      break;
    if err = Z_NEED_DICT then
    begin
      if d_stream.adler <> dictId then
        EXIT_ERR('unexpected dictionary');
      err := inflateSetDictionary(d_stream, dictionary, StrLen(dictionary));
    end;
    CHECK_ERR(err, 'inflate with dict');
  end;

  err := inflateEnd(d_stream);
  CHECK_ERR(err, 'inflateEnd');

  if StrComp(PChar(uncompr), hello) <> 0 then
    EXIT_ERR('bad inflate with dict')
  else
    WriteLn('inflate with dictionary: ', PChar(uncompr));
end;
{$ENDIF}

var compr, uncompr: Pointer;
    comprLen, uncomprLen: LongInt;

begin
  if zlibVersion^ <> ZLIB_VERSION[1] then
    EXIT_ERR('Incompatible zlib version');

  WriteLn('zlib version: ', zlibVersion);
  WriteLn('zlib compile flags: ', Format('0x%x', [zlibCompileFlags]));

  comprLen := 10000 * SizeOf(Integer); (* don't overflow on MSDOS *)
  uncomprLen := comprLen;
  GetMem(compr, comprLen);
  GetMem(uncompr, uncomprLen);
  if (compr = NIL) or (uncompr = NIL) then
    EXIT_ERR('Out of memory');
  (* compr and uncompr are cleared to avoid reading uninitialized
   * data and to ensure that uncompr compresses well.
   *)
  FillChar(compr^, comprLen, 0);
  FillChar(uncompr^, uncomprLen, 0);

  {$IFDEF TEST_COMPRESS}
  WriteLn('** Testing compress');
  test_compress(compr, comprLen, uncompr, uncomprLen);
  {$ENDIF}

  {$IFDEF TEST_GZIO}
  WriteLn('** Testing gzio');
  if ParamCount >= 1 then
    test_gzio(ParamStr(1), uncompr, uncomprLen)
  else
    test_gzio(TESTFILE, uncompr, uncomprLen);
  {$ENDIF}

  {$IFDEF TEST_DEFLATE}
  WriteLn('** Testing deflate with small buffers');
  test_deflate(compr, comprLen);
  {$ENDIF}
  {$IFDEF TEST_INFLATE}
  WriteLn('** Testing inflate with small buffers');
  test_inflate(compr, comprLen, uncompr, uncomprLen);
  {$ENDIF}

  {$IFDEF TEST_DEFLATE}
  WriteLn('** Testing deflate with large buffers');
  test_large_deflate(compr, comprLen, uncompr, uncomprLen);
  {$ENDIF}
  {$IFDEF TEST_INFLATE}
  WriteLn('** Testing inflate with large buffers');
  test_large_inflate(compr, comprLen, uncompr, uncomprLen);
  {$ENDIF}

  {$IFDEF TEST_FLUSH}
  WriteLn('** Testing deflate with full flush');
  test_flush(compr, comprLen);
  {$ENDIF}
  {$IFDEF TEST_SYNC}
  WriteLn('** Testing inflateSync');
  test_sync(compr, comprLen, uncompr, uncomprLen);
  {$ENDIF}
  comprLen := uncomprLen;

  {$IFDEF TEST_DICT}
  WriteLn('** Testing deflate and inflate with preset dictionary');
  test_dict_deflate(compr, comprLen);
  test_dict_inflate(compr, comprLen, uncompr, uncomprLen);
  {$ENDIF}

  FreeMem(compr, comprLen);
  FreeMem(uncompr, uncomprLen);
end.

Deleted compat/zlib/contrib/pascal/readme.txt.

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












































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

This directory contains a Pascal (Delphi, Kylix) interface to the
zlib data compression library.


Directory listing
=================

zlibd32.mak     makefile for Borland C++
example.pas     usage example of zlib
zlibpas.pas     the Pascal interface to zlib
readme.txt      this file


Compatibility notes
===================

- Although the name "zlib" would have been more normal for the
  zlibpas unit, this name is already taken by Borland's ZLib unit.
  This is somehow unfortunate, because that unit is not a genuine
  interface to the full-fledged zlib functionality, but a suite of
  class wrappers around zlib streams.  Other essential features,
  such as checksums, are missing.
  It would have been more appropriate for that unit to have a name
  like "ZStreams", or something similar.

- The C and zlib-supplied types int, uInt, long, uLong, etc. are
  translated directly into Pascal types of similar sizes (Integer,
  LongInt, etc.), to avoid namespace pollution.  In particular,
  there is no conversion of unsigned int into a Pascal unsigned
  integer.  The Word type is non-portable and has the same size
  (16 bits) both in a 16-bit and in a 32-bit environment, unlike
  Integer.  Even if there is a 32-bit Cardinal type, there is no
  real need for unsigned int in zlib under a 32-bit environment.

- Except for the callbacks, the zlib function interfaces are
  assuming the calling convention normally used in Pascal
  (__pascal for DOS and Windows16, __fastcall for Windows32).
  Since the cdecl keyword is used, the old Turbo Pascal does
  not work with this interface.

- The gz* function interfaces are not translated, to avoid
  interfacing problems with the C runtime library.  Besides,
    gzprintf(gzFile file, const char *format, ...)
  cannot be translated into Pascal.


Legal issues
============

The zlibpas interface is:
  Copyright (C) 1995-2003 Jean-loup Gailly and Mark Adler.
  Copyright (C) 1998 by Bob Dellaca.
  Copyright (C) 2003 by Cosmin Truta.

The example program is:
  Copyright (C) 1995-2003 by Jean-loup Gailly.
  Copyright (C) 1998,1999,2000 by Jacques Nomssi Nzali.
  Copyright (C) 2003 by Cosmin Truta.

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the author be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

Deleted compat/zlib/contrib/pascal/zlibd32.mak.

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



































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# For use with Delphi and C++ Builder under Win32
# Updated for zlib 1.2.x by Cosmin Truta

# ------------ Borland C++ ------------

# This project uses the Delphi (fastcall/register) calling convention:
LOC = -DZEXPORT=__fastcall -DZEXPORTVA=__cdecl

CC = bcc32
LD = bcc32
AR = tlib
# do not use "-pr" in CFLAGS
CFLAGS = -a -d -k- -O2 $(LOC)
LDFLAGS =


# variables
ZLIB_LIB = zlib.lib

OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj


# targets
all: $(ZLIB_LIB) example.exe minigzip.exe

.c.obj:
	$(CC) -c $(CFLAGS) $*.c

adler32.obj: adler32.c zlib.h zconf.h

compress.obj: compress.c zlib.h zconf.h

crc32.obj: crc32.c zlib.h zconf.h crc32.h

deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h

gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h

gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h

gzread.obj: gzread.c zlib.h zconf.h gzguts.h

gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h

infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h

inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h

trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h

uncompr.obj: uncompr.c zlib.h zconf.h

zutil.obj: zutil.c zutil.h zlib.h zconf.h

example.obj: test/example.c zlib.h zconf.h

minigzip.obj: test/minigzip.c zlib.h zconf.h


# For the sake of the old Borland make,
# the command line is cut to fit in the MS-DOS 128 byte limit:
$(ZLIB_LIB): $(OBJ1) $(OBJ2)
	-del $(ZLIB_LIB)
	$(AR) $(ZLIB_LIB) $(OBJP1)
	$(AR) $(ZLIB_LIB) $(OBJP2)


# testing
test: example.exe minigzip.exe
	example
	echo hello world | minigzip | minigzip -d

example.exe: example.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)

minigzip.exe: minigzip.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)


# cleanup
clean:
	-del *.obj
	-del *.exe
	-del *.lib
	-del *.tds
	-del zlib.bak
	-del foo.gz

Deleted compat/zlib/contrib/pascal/zlibpas.pas.

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




















































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
(* zlibpas -- Pascal interface to the zlib data compression library
 *
 * Copyright (C) 2003 Cosmin Truta.
 * Derived from original sources by Bob Dellaca.
 * For conditions of distribution and use, see copyright notice in readme.txt
 *)

unit zlibpas;

interface

const
  ZLIB_VERSION = '1.2.11';
  ZLIB_VERNUM  = $12a0;

type
  alloc_func = function(opaque: Pointer; items, size: Integer): Pointer;
                 cdecl;
  free_func  = procedure(opaque, address: Pointer);
                 cdecl;

  in_func    = function(opaque: Pointer; var buf: PByte): Integer;
                 cdecl;
  out_func   = function(opaque: Pointer; buf: PByte; size: Integer): Integer;
                 cdecl;

  z_streamp = ^z_stream;
  z_stream = packed record
    next_in: PChar;       (* next input byte *)
    avail_in: Integer;    (* number of bytes available at next_in *)
    total_in: LongInt;    (* total nb of input bytes read so far *)

    next_out: PChar;      (* next output byte should be put there *)
    avail_out: Integer;   (* remaining free space at next_out *)
    total_out: LongInt;   (* total nb of bytes output so far *)

    msg: PChar;           (* last error message, NULL if no error *)
    state: Pointer;       (* not visible by applications *)

    zalloc: alloc_func;   (* used to allocate the internal state *)
    zfree: free_func;     (* used to free the internal state *)
    opaque: Pointer;      (* private data object passed to zalloc and zfree *)

    data_type: Integer;   (* best guess about the data type: ascii or binary *)
    adler: LongInt;       (* adler32 value of the uncompressed data *)
    reserved: LongInt;    (* reserved for future use *)
  end;

  gz_headerp = ^gz_header;
  gz_header = packed record
    text: Integer;        (* true if compressed data believed to be text *)
    time: LongInt;        (* modification time *)
    xflags: Integer;      (* extra flags (not used when writing a gzip file) *)
    os: Integer;          (* operating system *)
    extra: PChar;         (* pointer to extra field or Z_NULL if none *)
    extra_len: Integer;   (* extra field length (valid if extra != Z_NULL) *)
    extra_max: Integer;   (* space at extra (only when reading header) *)
    name: PChar;          (* pointer to zero-terminated file name or Z_NULL *)
    name_max: Integer;    (* space at name (only when reading header) *)
    comment: PChar;       (* pointer to zero-terminated comment or Z_NULL *)
    comm_max: Integer;    (* space at comment (only when reading header) *)
    hcrc: Integer;        (* true if there was or will be a header crc *)
    done: Integer;        (* true when done reading gzip header *)
  end;

(* constants *)
const
  Z_NO_FLUSH      = 0;
  Z_PARTIAL_FLUSH = 1;
  Z_SYNC_FLUSH    = 2;
  Z_FULL_FLUSH    = 3;
  Z_FINISH        = 4;
  Z_BLOCK         = 5;
  Z_TREES         = 6;

  Z_OK            =  0;
  Z_STREAM_END    =  1;
  Z_NEED_DICT     =  2;
  Z_ERRNO         = -1;
  Z_STREAM_ERROR  = -2;
  Z_DATA_ERROR    = -3;
  Z_MEM_ERROR     = -4;
  Z_BUF_ERROR     = -5;
  Z_VERSION_ERROR = -6;

  Z_NO_COMPRESSION       =  0;
  Z_BEST_SPEED           =  1;
  Z_BEST_COMPRESSION     =  9;
  Z_DEFAULT_COMPRESSION  = -1;

  Z_FILTERED            = 1;
  Z_HUFFMAN_ONLY        = 2;
  Z_RLE                 = 3;
  Z_FIXED               = 4;
  Z_DEFAULT_STRATEGY    = 0;

  Z_BINARY   = 0;
  Z_TEXT     = 1;
  Z_ASCII    = 1;
  Z_UNKNOWN  = 2;

  Z_DEFLATED = 8;

(* basic functions *)
function zlibVersion: PChar;
function deflateInit(var strm: z_stream; level: Integer): Integer;
function deflate(var strm: z_stream; flush: Integer): Integer;
function deflateEnd(var strm: z_stream): Integer;
function inflateInit(var strm: z_stream): Integer;
function inflate(var strm: z_stream; flush: Integer): Integer;
function inflateEnd(var strm: z_stream): Integer;

(* advanced functions *)
function deflateInit2(var strm: z_stream; level, method, windowBits,
                      memLevel, strategy: Integer): Integer;
function deflateSetDictionary(var strm: z_stream; const dictionary: PChar;
                              dictLength: Integer): Integer;
function deflateCopy(var dest, source: z_stream): Integer;
function deflateReset(var strm: z_stream): Integer;
function deflateParams(var strm: z_stream; level, strategy: Integer): Integer;
function deflateTune(var strm: z_stream; good_length, max_lazy, nice_length, max_chain: Integer): Integer;
function deflateBound(var strm: z_stream; sourceLen: LongInt): LongInt;
function deflatePending(var strm: z_stream; var pending: Integer; var bits: Integer): Integer;
function deflatePrime(var strm: z_stream; bits, value: Integer): Integer;
function deflateSetHeader(var strm: z_stream; head: gz_header): Integer;
function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
function inflateSetDictionary(var strm: z_stream; const dictionary: PChar;
                              dictLength: Integer): Integer;
function inflateSync(var strm: z_stream): Integer;
function inflateCopy(var dest, source: z_stream): Integer;
function inflateReset(var strm: z_stream): Integer;
function inflateReset2(var strm: z_stream; windowBits: Integer): Integer;
function inflatePrime(var strm: z_stream; bits, value: Integer): Integer;
function inflateMark(var strm: z_stream): LongInt;
function inflateGetHeader(var strm: z_stream; var head: gz_header): Integer;
function inflateBackInit(var strm: z_stream;
                         windowBits: Integer; window: PChar): Integer;
function inflateBack(var strm: z_stream; in_fn: in_func; in_desc: Pointer;
                     out_fn: out_func; out_desc: Pointer): Integer;
function inflateBackEnd(var strm: z_stream): Integer;
function zlibCompileFlags: LongInt;

(* utility functions *)
function compress(dest: PChar; var destLen: LongInt;
                  const source: PChar; sourceLen: LongInt): Integer;
function compress2(dest: PChar; var destLen: LongInt;
                  const source: PChar; sourceLen: LongInt;
                  level: Integer): Integer;
function compressBound(sourceLen: LongInt): LongInt;
function uncompress(dest: PChar; var destLen: LongInt;
                    const source: PChar; sourceLen: LongInt): Integer;

(* checksum functions *)
function adler32(adler: LongInt; const buf: PChar; len: Integer): LongInt;
function adler32_combine(adler1, adler2, len2: LongInt): LongInt;
function crc32(crc: LongInt; const buf: PChar; len: Integer): LongInt;
function crc32_combine(crc1, crc2, len2: LongInt): LongInt;

(* various hacks, don't look :) *)
function deflateInit_(var strm: z_stream; level: Integer;
                      const version: PChar; stream_size: Integer): Integer;
function inflateInit_(var strm: z_stream; const version: PChar;
                      stream_size: Integer): Integer;
function deflateInit2_(var strm: z_stream;
                       level, method, windowBits, memLevel, strategy: Integer;
                       const version: PChar; stream_size: Integer): Integer;
function inflateInit2_(var strm: z_stream; windowBits: Integer;
                       const version: PChar; stream_size: Integer): Integer;
function inflateBackInit_(var strm: z_stream;
                          windowBits: Integer; window: PChar;
                          const version: PChar; stream_size: Integer): Integer;


implementation

{$L adler32.obj}
{$L compress.obj}
{$L crc32.obj}
{$L deflate.obj}
{$L infback.obj}
{$L inffast.obj}
{$L inflate.obj}
{$L inftrees.obj}
{$L trees.obj}
{$L uncompr.obj}
{$L zutil.obj}

function adler32; external;
function adler32_combine; external;
function compress; external;
function compress2; external;
function compressBound; external;
function crc32; external;
function crc32_combine; external;
function deflate; external;
function deflateBound; external;
function deflateCopy; external;
function deflateEnd; external;
function deflateInit_; external;
function deflateInit2_; external;
function deflateParams; external;
function deflatePending; external;
function deflatePrime; external;
function deflateReset; external;
function deflateSetDictionary; external;
function deflateSetHeader; external;
function deflateTune; external;
function inflate; external;
function inflateBack; external;
function inflateBackEnd; external;
function inflateBackInit_; external;
function inflateCopy; external;
function inflateEnd; external;
function inflateGetHeader; external;
function inflateInit_; external;
function inflateInit2_; external;
function inflateMark; external;
function inflatePrime; external;
function inflateReset; external;
function inflateReset2; external;
function inflateSetDictionary; external;
function inflateSync; external;
function uncompress; external;
function zlibCompileFlags; external;
function zlibVersion; external;

function deflateInit(var strm: z_stream; level: Integer): Integer;
begin
  Result := deflateInit_(strm, level, ZLIB_VERSION, sizeof(z_stream));
end;

function deflateInit2(var strm: z_stream; level, method, windowBits, memLevel,
                      strategy: Integer): Integer;
begin
  Result := deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
                          ZLIB_VERSION, sizeof(z_stream));
end;

function inflateInit(var strm: z_stream): Integer;
begin
  Result := inflateInit_(strm, ZLIB_VERSION, sizeof(z_stream));
end;

function inflateInit2(var strm: z_stream; windowBits: Integer): Integer;
begin
  Result := inflateInit2_(strm, windowBits, ZLIB_VERSION, sizeof(z_stream));
end;

function inflateBackInit(var strm: z_stream;
                         windowBits: Integer; window: PChar): Integer;
begin
  Result := inflateBackInit_(strm, windowBits, window,
                             ZLIB_VERSION, sizeof(z_stream));
end;

function _malloc(Size: Integer): Pointer; cdecl;
begin
  GetMem(Result, Size);
end;

procedure _free(Block: Pointer); cdecl;
begin
  FreeMem(Block);
end;

procedure _memset(P: Pointer; B: Byte; count: Integer); cdecl;
begin
  FillChar(P^, count, B);
end;

procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
  Move(source^, dest^, count);
end;

end.

Deleted compat/zlib/contrib/puff/Makefile.

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










































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
CFLAGS=-O

puff: puff.o pufftest.o

puff.o: puff.h

pufftest.o: puff.h

test: puff
	puff zeros.raw

puft: puff.c puff.h pufftest.o
	cc -fprofile-arcs -ftest-coverage -o puft puff.c pufftest.o

# puff full coverage test (should say 100%)
cov: puft
	@rm -f *.gcov *.gcda
	@puft -w zeros.raw 2>&1 | cat > /dev/null
	@echo '04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
	@echo '00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
	@echo '00 00 00 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 254
	@echo '00 01 00 fe ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
	@echo '01 01 00 fe ff 0a' | xxd -r -p | puft -f 2>&1 | cat > /dev/null
	@echo '02 7e ff ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246
	@echo '02' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
	@echo '04 80 49 92 24 49 92 24 0f b4 ff ff c3 04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 2
	@echo '04 80 49 92 24 49 92 24 71 ff ff 93 11 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 249
	@echo '04 c0 81 08 00 00 00 00 20 7f eb 0b 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246
	@echo '0b 00 00' | xxd -r -p | puft -f 2>&1 | cat > /dev/null
	@echo '1a 07' | xxd -r -p | puft 2> /dev/null || test $$? -eq 246
	@echo '0c c0 81 00 00 00 00 00 90 ff 6b 04' | xxd -r -p | puft 2> /dev/null || test $$? -eq 245
	@puft -f zeros.raw 2>&1 | cat > /dev/null
	@echo 'fc 00 00' | xxd -r -p | puft 2> /dev/null || test $$? -eq 253
	@echo '04 00 fe ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 252
	@echo '04 00 24 49' | xxd -r -p | puft 2> /dev/null || test $$? -eq 251
	@echo '04 80 49 92 24 49 92 24 0f b4 ff ff c3 84' | xxd -r -p | puft 2> /dev/null || test $$? -eq 248
	@echo '04 00 24 e9 ff ff' | xxd -r -p | puft 2> /dev/null || test $$? -eq 250
	@echo '04 00 24 e9 ff 6d' | xxd -r -p | puft 2> /dev/null || test $$? -eq 247
	@gcov -n puff.c

clean:
	rm -f puff puft *.o *.gc*

Deleted compat/zlib/contrib/puff/README.

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































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Puff -- A Simple Inflate
3 Mar 2003
Mark Adler
madler@alumni.caltech.edu

What this is --

puff.c provides the routine puff() to decompress the deflate data format.  It
does so more slowly than zlib, but the code is about one-fifth the size of the
inflate code in zlib, and written to be very easy to read.

Why I wrote this --

puff.c was written to document the deflate format unambiguously, by virtue of
being working C code.  It is meant to supplement RFC 1951, which formally
describes the deflate format.  I have received many questions on details of the
deflate format, and I hope that reading this code will answer those questions.
puff.c is heavily commented with details of the deflate format, especially
those little nooks and cranies of the format that might not be obvious from a
specification.

puff.c may also be useful in applications where code size or memory usage is a
very limited resource, and speed is not as important.

How to use it --

Well, most likely you should just be reading puff.c and using zlib for actual
applications, but if you must ...

Include puff.h in your code, which provides this prototype:

int puff(unsigned char *dest,           /* pointer to destination pointer */
         unsigned long *destlen,        /* amount of output space */
         unsigned char *source,         /* pointer to source data pointer */
         unsigned long *sourcelen);     /* amount of input available */

Then you can call puff() to decompress a deflate stream that is in memory in
its entirety at source, to a sufficiently sized block of memory for the
decompressed data at dest.  puff() is the only external symbol in puff.c  The
only C library functions that puff.c needs are setjmp() and longjmp(), which
are used to simplify error checking in the code to improve readabilty.  puff.c
does no memory allocation, and uses less than 2K bytes off of the stack.

If destlen is not enough space for the uncompressed data, then inflate will
return an error without writing more than destlen bytes.  Note that this means
that in order to decompress the deflate data successfully, you need to know
the size of the uncompressed data ahead of time.

If needed, puff() can determine the size of the uncompressed data with no
output space.  This is done by passing dest equal to (unsigned char *)0.  Then
the initial value of *destlen is ignored and *destlen is set to the length of
the uncompressed data.  So if the size of the uncompressed data is not known,
then two passes of puff() can be used--first to determine the size, and second
to do the actual inflation after allocating the appropriate memory.  Not
pretty, but it works.  (This is one of the reasons you should be using zlib.)

The deflate format is self-terminating.  If the deflate stream does not end
in *sourcelen bytes, puff() will return an error without reading at or past
endsource.

On return, *sourcelen is updated to the amount of input data consumed, and
*destlen is updated to the size of the uncompressed data.  See the comments
in puff.c for the possible return codes for puff().

Deleted compat/zlib/contrib/puff/puff.c.

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








































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * puff.c
 * Copyright (C) 2002-2013 Mark Adler
 * For conditions of distribution and use, see copyright notice in puff.h
 * version 2.3, 21 Jan 2013
 *
 * puff.c is a simple inflate written to be an unambiguous way to specify the
 * deflate format.  It is not written for speed but rather simplicity.  As a
 * side benefit, this code might actually be useful when small code is more
 * important than speed, such as bootstrap applications.  For typical deflate
 * data, zlib's inflate() is about four times as fast as puff().  zlib's
 * inflate compiles to around 20K on my machine, whereas puff.c compiles to
 * around 4K on my machine (a PowerPC using GNU cc).  If the faster decode()
 * function here is used, then puff() is only twice as slow as zlib's
 * inflate().
 *
 * All dynamically allocated memory comes from the stack.  The stack required
 * is less than 2K bytes.  This code is compatible with 16-bit int's and
 * assumes that long's are at least 32 bits.  puff.c uses the short data type,
 * assumed to be 16 bits, for arrays in order to conserve memory.  The code
 * works whether integers are stored big endian or little endian.
 *
 * In the comments below are "Format notes" that describe the inflate process
 * and document some of the less obvious aspects of the format.  This source
 * code is meant to supplement RFC 1951, which formally describes the deflate
 * format:
 *
 *    http://www.zlib.org/rfc-deflate.html
 */

/*
 * Change history:
 *
 * 1.0  10 Feb 2002     - First version
 * 1.1  17 Feb 2002     - Clarifications of some comments and notes
 *                      - Update puff() dest and source pointers on negative
 *                        errors to facilitate debugging deflators
 *                      - Remove longest from struct huffman -- not needed
 *                      - Simplify offs[] index in construct()
 *                      - Add input size and checking, using longjmp() to
 *                        maintain easy readability
 *                      - Use short data type for large arrays
 *                      - Use pointers instead of long to specify source and
 *                        destination sizes to avoid arbitrary 4 GB limits
 * 1.2  17 Mar 2002     - Add faster version of decode(), doubles speed (!),
 *                        but leave simple version for readabilty
 *                      - Make sure invalid distances detected if pointers
 *                        are 16 bits
 *                      - Fix fixed codes table error
 *                      - Provide a scanning mode for determining size of
 *                        uncompressed data
 * 1.3  20 Mar 2002     - Go back to lengths for puff() parameters [Gailly]
 *                      - Add a puff.h file for the interface
 *                      - Add braces in puff() for else do [Gailly]
 *                      - Use indexes instead of pointers for readability
 * 1.4  31 Mar 2002     - Simplify construct() code set check
 *                      - Fix some comments
 *                      - Add FIXLCODES #define
 * 1.5   6 Apr 2002     - Minor comment fixes
 * 1.6   7 Aug 2002     - Minor format changes
 * 1.7   3 Mar 2003     - Added test code for distribution
 *                      - Added zlib-like license
 * 1.8   9 Jan 2004     - Added some comments on no distance codes case
 * 1.9  21 Feb 2008     - Fix bug on 16-bit integer architectures [Pohland]
 *                      - Catch missing end-of-block symbol error
 * 2.0  25 Jul 2008     - Add #define to permit distance too far back
 *                      - Add option in TEST code for puff to write the data
 *                      - Add option in TEST code to skip input bytes
 *                      - Allow TEST code to read from piped stdin
 * 2.1   4 Apr 2010     - Avoid variable initialization for happier compilers
 *                      - Avoid unsigned comparisons for even happier compilers
 * 2.2  25 Apr 2010     - Fix bug in variable initializations [Oberhumer]
 *                      - Add const where appropriate [Oberhumer]
 *                      - Split if's and ?'s for coverage testing
 *                      - Break out test code to separate file
 *                      - Move NIL to puff.h
 *                      - Allow incomplete code only if single code length is 1
 *                      - Add full code coverage test to Makefile
 * 2.3  21 Jan 2013     - Check for invalid code length codes in dynamic blocks
 */

#include <setjmp.h>             /* for setjmp(), longjmp(), and jmp_buf */
#include "puff.h"               /* prototype for puff() */

#define local static            /* for local function definitions */

/*
 * Maximums for allocations and loops.  It is not useful to change these --
 * they are fixed by the deflate format.
 */
#define MAXBITS 15              /* maximum bits in a code */
#define MAXLCODES 286           /* maximum number of literal/length codes */
#define MAXDCODES 30            /* maximum number of distance codes */
#define MAXCODES (MAXLCODES+MAXDCODES)  /* maximum codes lengths to read */
#define FIXLCODES 288           /* number of fixed literal/length codes */

/* input and output state */
struct state {
    /* output state */
    unsigned char *out;         /* output buffer */
    unsigned long outlen;       /* available space at out */
    unsigned long outcnt;       /* bytes written to out so far */

    /* input state */
    const unsigned char *in;    /* input buffer */
    unsigned long inlen;        /* available input at in */
    unsigned long incnt;        /* bytes read so far */
    int bitbuf;                 /* bit buffer */
    int bitcnt;                 /* number of bits in bit buffer */

    /* input limit error return state for bits() and decode() */
    jmp_buf env;
};

/*
 * Return need bits from the input stream.  This always leaves less than
 * eight bits in the buffer.  bits() works properly for need == 0.
 *
 * Format notes:
 *
 * - Bits are stored in bytes from the least significant bit to the most
 *   significant bit.  Therefore bits are dropped from the bottom of the bit
 *   buffer, using shift right, and new bytes are appended to the top of the
 *   bit buffer, using shift left.
 */
local int bits(struct state *s, int need)
{
    long val;           /* bit accumulator (can use up to 20 bits) */

    /* load at least need bits into val */
    val = s->bitbuf;
    while (s->bitcnt < need) {
        if (s->incnt == s->inlen)
            longjmp(s->env, 1);         /* out of input */
        val |= (long)(s->in[s->incnt++]) << s->bitcnt;  /* load eight bits */
        s->bitcnt += 8;
    }

    /* drop need bits and update buffer, always zero to seven bits left */
    s->bitbuf = (int)(val >> need);
    s->bitcnt -= need;

    /* return need bits, zeroing the bits above that */
    return (int)(val & ((1L << need) - 1));
}

/*
 * Process a stored block.
 *
 * Format notes:
 *
 * - After the two-bit stored block type (00), the stored block length and
 *   stored bytes are byte-aligned for fast copying.  Therefore any leftover
 *   bits in the byte that has the last bit of the type, as many as seven, are
 *   discarded.  The value of the discarded bits are not defined and should not
 *   be checked against any expectation.
 *
 * - The second inverted copy of the stored block length does not have to be
 *   checked, but it's probably a good idea to do so anyway.
 *
 * - A stored block can have zero length.  This is sometimes used to byte-align
 *   subsets of the compressed data for random access or partial recovery.
 */
local int stored(struct state *s)
{
    unsigned len;       /* length of stored block */

    /* discard leftover bits from current byte (assumes s->bitcnt < 8) */
    s->bitbuf = 0;
    s->bitcnt = 0;

    /* get length and check against its one's complement */
    if (s->incnt + 4 > s->inlen)
        return 2;                               /* not enough input */
    len = s->in[s->incnt++];
    len |= s->in[s->incnt++] << 8;
    if (s->in[s->incnt++] != (~len & 0xff) ||
        s->in[s->incnt++] != ((~len >> 8) & 0xff))
        return -2;                              /* didn't match complement! */

    /* copy len bytes from in to out */
    if (s->incnt + len > s->inlen)
        return 2;                               /* not enough input */
    if (s->out != NIL) {
        if (s->outcnt + len > s->outlen)
            return 1;                           /* not enough output space */
        while (len--)
            s->out[s->outcnt++] = s->in[s->incnt++];
    }
    else {                                      /* just scanning */
        s->outcnt += len;
        s->incnt += len;
    }

    /* done with a valid stored block */
    return 0;
}

/*
 * Huffman code decoding tables.  count[1..MAXBITS] is the number of symbols of
 * each length, which for a canonical code are stepped through in order.
 * symbol[] are the symbol values in canonical order, where the number of
 * entries is the sum of the counts in count[].  The decoding process can be
 * seen in the function decode() below.
 */
struct huffman {
    short *count;       /* number of symbols of each length */
    short *symbol;      /* canonically ordered symbols */
};

/*
 * Decode a code from the stream s using huffman table h.  Return the symbol or
 * a negative value if there is an error.  If all of the lengths are zero, i.e.
 * an empty code, or if the code is incomplete and an invalid code is received,
 * then -10 is returned after reading MAXBITS bits.
 *
 * Format notes:
 *
 * - The codes as stored in the compressed data are bit-reversed relative to
 *   a simple integer ordering of codes of the same lengths.  Hence below the
 *   bits are pulled from the compressed data one at a time and used to
 *   build the code value reversed from what is in the stream in order to
 *   permit simple integer comparisons for decoding.  A table-based decoding
 *   scheme (as used in zlib) does not need to do this reversal.
 *
 * - The first code for the shortest length is all zeros.  Subsequent codes of
 *   the same length are simply integer increments of the previous code.  When
 *   moving up a length, a zero bit is appended to the code.  For a complete
 *   code, the last code of the longest length will be all ones.
 *
 * - Incomplete codes are handled by this decoder, since they are permitted
 *   in the deflate format.  See the format notes for fixed() and dynamic().
 */
#ifdef SLOW
local int decode(struct state *s, const struct huffman *h)
{
    int len;            /* current number of bits in code */
    int code;           /* len bits being decoded */
    int first;          /* first code of length len */
    int count;          /* number of codes of length len */
    int index;          /* index of first code of length len in symbol table */

    code = first = index = 0;
    for (len = 1; len <= MAXBITS; len++) {
        code |= bits(s, 1);             /* get next bit */
        count = h->count[len];
        if (code - count < first)       /* if length len, return symbol */
            return h->symbol[index + (code - first)];
        index += count;                 /* else update for next length */
        first += count;
        first <<= 1;
        code <<= 1;
    }
    return -10;                         /* ran out of codes */
}

/*
 * A faster version of decode() for real applications of this code.   It's not
 * as readable, but it makes puff() twice as fast.  And it only makes the code
 * a few percent larger.
 */
#else /* !SLOW */
local int decode(struct state *s, const struct huffman *h)
{
    int len;            /* current number of bits in code */
    int code;           /* len bits being decoded */
    int first;          /* first code of length len */
    int count;          /* number of codes of length len */
    int index;          /* index of first code of length len in symbol table */
    int bitbuf;         /* bits from stream */
    int left;           /* bits left in next or left to process */
    short *next;        /* next number of codes */

    bitbuf = s->bitbuf;
    left = s->bitcnt;
    code = first = index = 0;
    len = 1;
    next = h->count + 1;
    while (1) {
        while (left--) {
            code |= bitbuf & 1;
            bitbuf >>= 1;
            count = *next++;
            if (code - count < first) { /* if length len, return symbol */
                s->bitbuf = bitbuf;
                s->bitcnt = (s->bitcnt - len) & 7;
                return h->symbol[index + (code - first)];
            }
            index += count;             /* else update for next length */
            first += count;
            first <<= 1;
            code <<= 1;
            len++;
        }
        left = (MAXBITS+1) - len;
        if (left == 0)
            break;
        if (s->incnt == s->inlen)
            longjmp(s->env, 1);         /* out of input */
        bitbuf = s->in[s->incnt++];
        if (left > 8)
            left = 8;
    }
    return -10;                         /* ran out of codes */
}
#endif /* SLOW */

/*
 * Given the list of code lengths length[0..n-1] representing a canonical
 * Huffman code for n symbols, construct the tables required to decode those
 * codes.  Those tables are the number of codes of each length, and the symbols
 * sorted by length, retaining their original order within each length.  The
 * return value is zero for a complete code set, negative for an over-
 * subscribed code set, and positive for an incomplete code set.  The tables
 * can be used if the return value is zero or positive, but they cannot be used
 * if the return value is negative.  If the return value is zero, it is not
 * possible for decode() using that table to return an error--any stream of
 * enough bits will resolve to a symbol.  If the return value is positive, then
 * it is possible for decode() using that table to return an error for received
 * codes past the end of the incomplete lengths.
 *
 * Not used by decode(), but used for error checking, h->count[0] is the number
 * of the n symbols not in the code.  So n - h->count[0] is the number of
 * codes.  This is useful for checking for incomplete codes that have more than
 * one symbol, which is an error in a dynamic block.
 *
 * Assumption: for all i in 0..n-1, 0 <= length[i] <= MAXBITS
 * This is assured by the construction of the length arrays in dynamic() and
 * fixed() and is not verified by construct().
 *
 * Format notes:
 *
 * - Permitted and expected examples of incomplete codes are one of the fixed
 *   codes and any code with a single symbol which in deflate is coded as one
 *   bit instead of zero bits.  See the format notes for fixed() and dynamic().
 *
 * - Within a given code length, the symbols are kept in ascending order for
 *   the code bits definition.
 */
local int construct(struct huffman *h, const short *length, int n)
{
    int symbol;         /* current symbol when stepping through length[] */
    int len;            /* current length when stepping through h->count[] */
    int left;           /* number of possible codes left of current length */
    short offs[MAXBITS+1];      /* offsets in symbol table for each length */

    /* count number of codes of each length */
    for (len = 0; len <= MAXBITS; len++)
        h->count[len] = 0;
    for (symbol = 0; symbol < n; symbol++)
        (h->count[length[symbol]])++;   /* assumes lengths are within bounds */
    if (h->count[0] == n)               /* no codes! */
        return 0;                       /* complete, but decode() will fail */

    /* check for an over-subscribed or incomplete set of lengths */
    left = 1;                           /* one possible code of zero length */
    for (len = 1; len <= MAXBITS; len++) {
        left <<= 1;                     /* one more bit, double codes left */
        left -= h->count[len];          /* deduct count from possible codes */
        if (left < 0)
            return left;                /* over-subscribed--return negative */
    }                                   /* left > 0 means incomplete */

    /* generate offsets into symbol table for each length for sorting */
    offs[1] = 0;
    for (len = 1; len < MAXBITS; len++)
        offs[len + 1] = offs[len] + h->count[len];

    /*
     * put symbols in table sorted by length, by symbol order within each
     * length
     */
    for (symbol = 0; symbol < n; symbol++)
        if (length[symbol] != 0)
            h->symbol[offs[length[symbol]]++] = symbol;

    /* return zero for complete set, positive for incomplete set */
    return left;
}

/*
 * Decode literal/length and distance codes until an end-of-block code.
 *
 * Format notes:
 *
 * - Compressed data that is after the block type if fixed or after the code
 *   description if dynamic is a combination of literals and length/distance
 *   pairs terminated by and end-of-block code.  Literals are simply Huffman
 *   coded bytes.  A length/distance pair is a coded length followed by a
 *   coded distance to represent a string that occurs earlier in the
 *   uncompressed data that occurs again at the current location.
 *
 * - Literals, lengths, and the end-of-block code are combined into a single
 *   code of up to 286 symbols.  They are 256 literals (0..255), 29 length
 *   symbols (257..285), and the end-of-block symbol (256).
 *
 * - There are 256 possible lengths (3..258), and so 29 symbols are not enough
 *   to represent all of those.  Lengths 3..10 and 258 are in fact represented
 *   by just a length symbol.  Lengths 11..257 are represented as a symbol and
 *   some number of extra bits that are added as an integer to the base length
 *   of the length symbol.  The number of extra bits is determined by the base
 *   length symbol.  These are in the static arrays below, lens[] for the base
 *   lengths and lext[] for the corresponding number of extra bits.
 *
 * - The reason that 258 gets its own symbol is that the longest length is used
 *   often in highly redundant files.  Note that 258 can also be coded as the
 *   base value 227 plus the maximum extra value of 31.  While a good deflate
 *   should never do this, it is not an error, and should be decoded properly.
 *
 * - If a length is decoded, including its extra bits if any, then it is
 *   followed a distance code.  There are up to 30 distance symbols.  Again
 *   there are many more possible distances (1..32768), so extra bits are added
 *   to a base value represented by the symbol.  The distances 1..4 get their
 *   own symbol, but the rest require extra bits.  The base distances and
 *   corresponding number of extra bits are below in the static arrays dist[]
 *   and dext[].
 *
 * - Literal bytes are simply written to the output.  A length/distance pair is
 *   an instruction to copy previously uncompressed bytes to the output.  The
 *   copy is from distance bytes back in the output stream, copying for length
 *   bytes.
 *
 * - Distances pointing before the beginning of the output data are not
 *   permitted.
 *
 * - Overlapped copies, where the length is greater than the distance, are
 *   allowed and common.  For example, a distance of one and a length of 258
 *   simply copies the last byte 258 times.  A distance of four and a length of
 *   twelve copies the last four bytes three times.  A simple forward copy
 *   ignoring whether the length is greater than the distance or not implements
 *   this correctly.  You should not use memcpy() since its behavior is not
 *   defined for overlapped arrays.  You should not use memmove() or bcopy()
 *   since though their behavior -is- defined for overlapping arrays, it is
 *   defined to do the wrong thing in this case.
 */
local int codes(struct state *s,
                const struct huffman *lencode,
                const struct huffman *distcode)
{
    int symbol;         /* decoded symbol */
    int len;            /* length for copy */
    unsigned dist;      /* distance for copy */
    static const short lens[29] = { /* Size base for length codes 257..285 */
        3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
        35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258};
    static const short lext[29] = { /* Extra bits for length codes 257..285 */
        0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2,
        3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0};
    static const short dists[30] = { /* Offset base for distance codes 0..29 */
        1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
        257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
        8193, 12289, 16385, 24577};
    static const short dext[30] = { /* Extra bits for distance codes 0..29 */
        0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6,
        7, 7, 8, 8, 9, 9, 10, 10, 11, 11,
        12, 12, 13, 13};

    /* decode literals and length/distance pairs */
    do {
        symbol = decode(s, lencode);
        if (symbol < 0)
            return symbol;              /* invalid symbol */
        if (symbol < 256) {             /* literal: symbol is the byte */
            /* write out the literal */
            if (s->out != NIL) {
                if (s->outcnt == s->outlen)
                    return 1;
                s->out[s->outcnt] = symbol;
            }
            s->outcnt++;
        }
        else if (symbol > 256) {        /* length */
            /* get and compute length */
            symbol -= 257;
            if (symbol >= 29)
                return -10;             /* invalid fixed code */
            len = lens[symbol] + bits(s, lext[symbol]);

            /* get and check distance */
            symbol = decode(s, distcode);
            if (symbol < 0)
                return symbol;          /* invalid symbol */
            dist = dists[symbol] + bits(s, dext[symbol]);
#ifndef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
            if (dist > s->outcnt)
                return -11;     /* distance too far back */
#endif

            /* copy length bytes from distance bytes back */
            if (s->out != NIL) {
                if (s->outcnt + len > s->outlen)
                    return 1;
                while (len--) {
                    s->out[s->outcnt] =
#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
                        dist > s->outcnt ?
                            0 :
#endif
                            s->out[s->outcnt - dist];
                    s->outcnt++;
                }
            }
            else
                s->outcnt += len;
        }
    } while (symbol != 256);            /* end of block symbol */

    /* done with a valid fixed or dynamic block */
    return 0;
}

/*
 * Process a fixed codes block.
 *
 * Format notes:
 *
 * - This block type can be useful for compressing small amounts of data for
 *   which the size of the code descriptions in a dynamic block exceeds the
 *   benefit of custom codes for that block.  For fixed codes, no bits are
 *   spent on code descriptions.  Instead the code lengths for literal/length
 *   codes and distance codes are fixed.  The specific lengths for each symbol
 *   can be seen in the "for" loops below.
 *
 * - The literal/length code is complete, but has two symbols that are invalid
 *   and should result in an error if received.  This cannot be implemented
 *   simply as an incomplete code since those two symbols are in the "middle"
 *   of the code.  They are eight bits long and the longest literal/length\
 *   code is nine bits.  Therefore the code must be constructed with those
 *   symbols, and the invalid symbols must be detected after decoding.
 *
 * - The fixed distance codes also have two invalid symbols that should result
 *   in an error if received.  Since all of the distance codes are the same
 *   length, this can be implemented as an incomplete code.  Then the invalid
 *   codes are detected while decoding.
 */
local int fixed(struct state *s)
{
    static int virgin = 1;
    static short lencnt[MAXBITS+1], lensym[FIXLCODES];
    static short distcnt[MAXBITS+1], distsym[MAXDCODES];
    static struct huffman lencode, distcode;

    /* build fixed huffman tables if first call (may not be thread safe) */
    if (virgin) {
        int symbol;
        short lengths[FIXLCODES];

        /* construct lencode and distcode */
        lencode.count = lencnt;
        lencode.symbol = lensym;
        distcode.count = distcnt;
        distcode.symbol = distsym;

        /* literal/length table */
        for (symbol = 0; symbol < 144; symbol++)
            lengths[symbol] = 8;
        for (; symbol < 256; symbol++)
            lengths[symbol] = 9;
        for (; symbol < 280; symbol++)
            lengths[symbol] = 7;
        for (; symbol < FIXLCODES; symbol++)
            lengths[symbol] = 8;
        construct(&lencode, lengths, FIXLCODES);

        /* distance table */
        for (symbol = 0; symbol < MAXDCODES; symbol++)
            lengths[symbol] = 5;
        construct(&distcode, lengths, MAXDCODES);

        /* do this just once */
        virgin = 0;
    }

    /* decode data until end-of-block code */
    return codes(s, &lencode, &distcode);
}

/*
 * Process a dynamic codes block.
 *
 * Format notes:
 *
 * - A dynamic block starts with a description of the literal/length and
 *   distance codes for that block.  New dynamic blocks allow the compressor to
 *   rapidly adapt to changing data with new codes optimized for that data.
 *
 * - The codes used by the deflate format are "canonical", which means that
 *   the actual bits of the codes are generated in an unambiguous way simply
 *   from the number of bits in each code.  Therefore the code descriptions
 *   are simply a list of code lengths for each symbol.
 *
 * - The code lengths are stored in order for the symbols, so lengths are
 *   provided for each of the literal/length symbols, and for each of the
 *   distance symbols.
 *
 * - If a symbol is not used in the block, this is represented by a zero as
 *   as the code length.  This does not mean a zero-length code, but rather
 *   that no code should be created for this symbol.  There is no way in the
 *   deflate format to represent a zero-length code.
 *
 * - The maximum number of bits in a code is 15, so the possible lengths for
 *   any code are 1..15.
 *
 * - The fact that a length of zero is not permitted for a code has an
 *   interesting consequence.  Normally if only one symbol is used for a given
 *   code, then in fact that code could be represented with zero bits.  However
 *   in deflate, that code has to be at least one bit.  So for example, if
 *   only a single distance base symbol appears in a block, then it will be
 *   represented by a single code of length one, in particular one 0 bit.  This
 *   is an incomplete code, since if a 1 bit is received, it has no meaning,
 *   and should result in an error.  So incomplete distance codes of one symbol
 *   should be permitted, and the receipt of invalid codes should be handled.
 *
 * - It is also possible to have a single literal/length code, but that code
 *   must be the end-of-block code, since every dynamic block has one.  This
 *   is not the most efficient way to create an empty block (an empty fixed
 *   block is fewer bits), but it is allowed by the format.  So incomplete
 *   literal/length codes of one symbol should also be permitted.
 *
 * - If there are only literal codes and no lengths, then there are no distance
 *   codes.  This is represented by one distance code with zero bits.
 *
 * - The list of up to 286 length/literal lengths and up to 30 distance lengths
 *   are themselves compressed using Huffman codes and run-length encoding.  In
 *   the list of code lengths, a 0 symbol means no code, a 1..15 symbol means
 *   that length, and the symbols 16, 17, and 18 are run-length instructions.
 *   Each of 16, 17, and 18 are follwed by extra bits to define the length of
 *   the run.  16 copies the last length 3 to 6 times.  17 represents 3 to 10
 *   zero lengths, and 18 represents 11 to 138 zero lengths.  Unused symbols
 *   are common, hence the special coding for zero lengths.
 *
 * - The symbols for 0..18 are Huffman coded, and so that code must be
 *   described first.  This is simply a sequence of up to 19 three-bit values
 *   representing no code (0) or the code length for that symbol (1..7).
 *
 * - A dynamic block starts with three fixed-size counts from which is computed
 *   the number of literal/length code lengths, the number of distance code
 *   lengths, and the number of code length code lengths (ok, you come up with
 *   a better name!) in the code descriptions.  For the literal/length and
 *   distance codes, lengths after those provided are considered zero, i.e. no
 *   code.  The code length code lengths are received in a permuted order (see
 *   the order[] array below) to make a short code length code length list more
 *   likely.  As it turns out, very short and very long codes are less likely
 *   to be seen in a dynamic code description, hence what may appear initially
 *   to be a peculiar ordering.
 *
 * - Given the number of literal/length code lengths (nlen) and distance code
 *   lengths (ndist), then they are treated as one long list of nlen + ndist
 *   code lengths.  Therefore run-length coding can and often does cross the
 *   boundary between the two sets of lengths.
 *
 * - So to summarize, the code description at the start of a dynamic block is
 *   three counts for the number of code lengths for the literal/length codes,
 *   the distance codes, and the code length codes.  This is followed by the
 *   code length code lengths, three bits each.  This is used to construct the
 *   code length code which is used to read the remainder of the lengths.  Then
 *   the literal/length code lengths and distance lengths are read as a single
 *   set of lengths using the code length codes.  Codes are constructed from
 *   the resulting two sets of lengths, and then finally you can start
 *   decoding actual compressed data in the block.
 *
 * - For reference, a "typical" size for the code description in a dynamic
 *   block is around 80 bytes.
 */
local int dynamic(struct state *s)
{
    int nlen, ndist, ncode;             /* number of lengths in descriptor */
    int index;                          /* index of lengths[] */
    int err;                            /* construct() return value */
    short lengths[MAXCODES];            /* descriptor code lengths */
    short lencnt[MAXBITS+1], lensym[MAXLCODES];         /* lencode memory */
    short distcnt[MAXBITS+1], distsym[MAXDCODES];       /* distcode memory */
    struct huffman lencode, distcode;   /* length and distance codes */
    static const short order[19] =      /* permutation of code length codes */
        {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};

    /* construct lencode and distcode */
    lencode.count = lencnt;
    lencode.symbol = lensym;
    distcode.count = distcnt;
    distcode.symbol = distsym;

    /* get number of lengths in each table, check lengths */
    nlen = bits(s, 5) + 257;
    ndist = bits(s, 5) + 1;
    ncode = bits(s, 4) + 4;
    if (nlen > MAXLCODES || ndist > MAXDCODES)
        return -3;                      /* bad counts */

    /* read code length code lengths (really), missing lengths are zero */
    for (index = 0; index < ncode; index++)
        lengths[order[index]] = bits(s, 3);
    for (; index < 19; index++)
        lengths[order[index]] = 0;

    /* build huffman table for code lengths codes (use lencode temporarily) */
    err = construct(&lencode, lengths, 19);
    if (err != 0)               /* require complete code set here */
        return -4;

    /* read length/literal and distance code length tables */
    index = 0;
    while (index < nlen + ndist) {
        int symbol;             /* decoded value */
        int len;                /* last length to repeat */

        symbol = decode(s, &lencode);
        if (symbol < 0)
            return symbol;          /* invalid symbol */
        if (symbol < 16)                /* length in 0..15 */
            lengths[index++] = symbol;
        else {                          /* repeat instruction */
            len = 0;                    /* assume repeating zeros */
            if (symbol == 16) {         /* repeat last length 3..6 times */
                if (index == 0)
                    return -5;          /* no last length! */
                len = lengths[index - 1];       /* last length */
                symbol = 3 + bits(s, 2);
            }
            else if (symbol == 17)      /* repeat zero 3..10 times */
                symbol = 3 + bits(s, 3);
            else                        /* == 18, repeat zero 11..138 times */
                symbol = 11 + bits(s, 7);
            if (index + symbol > nlen + ndist)
                return -6;              /* too many lengths! */
            while (symbol--)            /* repeat last or zero symbol times */
                lengths[index++] = len;
        }
    }

    /* check for end-of-block code -- there better be one! */
    if (lengths[256] == 0)
        return -9;

    /* build huffman table for literal/length codes */
    err = construct(&lencode, lengths, nlen);
    if (err && (err < 0 || nlen != lencode.count[0] + lencode.count[1]))
        return -7;      /* incomplete code ok only for single length 1 code */

    /* build huffman table for distance codes */
    err = construct(&distcode, lengths + nlen, ndist);
    if (err && (err < 0 || ndist != distcode.count[0] + distcode.count[1]))
        return -8;      /* incomplete code ok only for single length 1 code */

    /* decode data until end-of-block code */
    return codes(s, &lencode, &distcode);
}

/*
 * Inflate source to dest.  On return, destlen and sourcelen are updated to the
 * size of the uncompressed data and the size of the deflate data respectively.
 * On success, the return value of puff() is zero.  If there is an error in the
 * source data, i.e. it is not in the deflate format, then a negative value is
 * returned.  If there is not enough input available or there is not enough
 * output space, then a positive error is returned.  In that case, destlen and
 * sourcelen are not updated to facilitate retrying from the beginning with the
 * provision of more input data or more output space.  In the case of invalid
 * inflate data (a negative error), the dest and source pointers are updated to
 * facilitate the debugging of deflators.
 *
 * puff() also has a mode to determine the size of the uncompressed output with
 * no output written.  For this dest must be (unsigned char *)0.  In this case,
 * the input value of *destlen is ignored, and on return *destlen is set to the
 * size of the uncompressed output.
 *
 * The return codes are:
 *
 *   2:  available inflate data did not terminate
 *   1:  output space exhausted before completing inflate
 *   0:  successful inflate
 *  -1:  invalid block type (type == 3)
 *  -2:  stored block length did not match one's complement
 *  -3:  dynamic block code description: too many length or distance codes
 *  -4:  dynamic block code description: code lengths codes incomplete
 *  -5:  dynamic block code description: repeat lengths with no first length
 *  -6:  dynamic block code description: repeat more than specified lengths
 *  -7:  dynamic block code description: invalid literal/length code lengths
 *  -8:  dynamic block code description: invalid distance code lengths
 *  -9:  dynamic block code description: missing end-of-block code
 * -10:  invalid literal/length or distance code in fixed or dynamic block
 * -11:  distance is too far back in fixed or dynamic block
 *
 * Format notes:
 *
 * - Three bits are read for each block to determine the kind of block and
 *   whether or not it is the last block.  Then the block is decoded and the
 *   process repeated if it was not the last block.
 *
 * - The leftover bits in the last byte of the deflate data after the last
 *   block (if it was a fixed or dynamic block) are undefined and have no
 *   expected values to check.
 */
int puff(unsigned char *dest,           /* pointer to destination pointer */
         unsigned long *destlen,        /* amount of output space */
         const unsigned char *source,   /* pointer to source data pointer */
         unsigned long *sourcelen)      /* amount of input available */
{
    struct state s;             /* input/output state */
    int last, type;             /* block information */
    int err;                    /* return value */

    /* initialize output state */
    s.out = dest;
    s.outlen = *destlen;                /* ignored if dest is NIL */
    s.outcnt = 0;

    /* initialize input state */
    s.in = source;
    s.inlen = *sourcelen;
    s.incnt = 0;
    s.bitbuf = 0;
    s.bitcnt = 0;

    /* return if bits() or decode() tries to read past available input */
    if (setjmp(s.env) != 0)             /* if came back here via longjmp() */
        err = 2;                        /* then skip do-loop, return error */
    else {
        /* process blocks until last block or error */
        do {
            last = bits(&s, 1);         /* one if last block */
            type = bits(&s, 2);         /* block type 0..3 */
            err = type == 0 ?
                    stored(&s) :
                    (type == 1 ?
                        fixed(&s) :
                        (type == 2 ?
                            dynamic(&s) :
                            -1));       /* type == 3, invalid */
            if (err != 0)
                break;                  /* return with error */
        } while (!last);
    }

    /* update the lengths and return */
    if (err <= 0) {
        *destlen = s.outcnt;
        *sourcelen = s.incnt;
    }
    return err;
}

Deleted compat/zlib/contrib/puff/puff.h.

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



































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* puff.h
  Copyright (C) 2002-2013 Mark Adler, all rights reserved
  version 2.3, 21 Jan 2013

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the author be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Mark Adler    madler@alumni.caltech.edu
 */


/*
 * See puff.c for purpose and usage.
 */
#ifndef NIL
#  define NIL ((unsigned char *)0)      /* for no output option */
#endif

int puff(unsigned char *dest,           /* pointer to destination pointer */
         unsigned long *destlen,        /* amount of output space */
         const unsigned char *source,   /* pointer to source data pointer */
         unsigned long *sourcelen);     /* amount of input available */

Deleted compat/zlib/contrib/puff/pufftest.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165





































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * pufftest.c
 * Copyright (C) 2002-2013 Mark Adler
 * For conditions of distribution and use, see copyright notice in puff.h
 * version 2.3, 21 Jan 2013
 */

/* Example of how to use puff().

   Usage: puff [-w] [-f] [-nnn] file
          ... | puff [-w] [-f] [-nnn]

   where file is the input file with deflate data, nnn is the number of bytes
   of input to skip before inflating (e.g. to skip a zlib or gzip header), and
   -w is used to write the decompressed data to stdout.  -f is for coverage
   testing, and causes pufftest to fail with not enough output space (-f does
   a write like -w, so -w is not required). */

#include <stdio.h>
#include <stdlib.h>
#include "puff.h"

#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
#  include <fcntl.h>
#  include <io.h>
#  define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
#else
#  define SET_BINARY_MODE(file)
#endif

#define local static

/* Return size times approximately the cube root of 2, keeping the result as 1,
   3, or 5 times a power of 2 -- the result is always > size, until the result
   is the maximum value of an unsigned long, where it remains.  This is useful
   to keep reallocations less than ~33% over the actual data. */
local size_t bythirds(size_t size)
{
    int n;
    size_t m;

    m = size;
    for (n = 0; m; n++)
        m >>= 1;
    if (n < 3)
        return size + 1;
    n -= 3;
    m = size >> n;
    m += m == 6 ? 2 : 1;
    m <<= n;
    return m > size ? m : (size_t)(-1);
}

/* Read the input file *name, or stdin if name is NULL, into allocated memory.
   Reallocate to larger buffers until the entire file is read in.  Return a
   pointer to the allocated data, or NULL if there was a memory allocation
   failure.  *len is the number of bytes of data read from the input file (even
   if load() returns NULL).  If the input file was empty or could not be opened
   or read, *len is zero. */
local void *load(const char *name, size_t *len)
{
    size_t size;
    void *buf, *swap;
    FILE *in;

    *len = 0;
    buf = malloc(size = 4096);
    if (buf == NULL)
        return NULL;
    in = name == NULL ? stdin : fopen(name, "rb");
    if (in != NULL) {
        for (;;) {
            *len += fread((char *)buf + *len, 1, size - *len, in);
            if (*len < size) break;
            size = bythirds(size);
            if (size == *len || (swap = realloc(buf, size)) == NULL) {
                free(buf);
                buf = NULL;
                break;
            }
            buf = swap;
        }
        fclose(in);
    }
    return buf;
}

int main(int argc, char **argv)
{
    int ret, put = 0, fail = 0;
    unsigned skip = 0;
    char *arg, *name = NULL;
    unsigned char *source = NULL, *dest;
    size_t len = 0;
    unsigned long sourcelen, destlen;

    /* process arguments */
    while (arg = *++argv, --argc)
        if (arg[0] == '-') {
            if (arg[1] == 'w' && arg[2] == 0)
                put = 1;
            else if (arg[1] == 'f' && arg[2] == 0)
                fail = 1, put = 1;
            else if (arg[1] >= '0' && arg[1] <= '9')
                skip = (unsigned)atoi(arg + 1);
            else {
                fprintf(stderr, "invalid option %s\n", arg);
                return 3;
            }
        }
        else if (name != NULL) {
            fprintf(stderr, "only one file name allowed\n");
            return 3;
        }
        else
            name = arg;
    source = load(name, &len);
    if (source == NULL) {
        fprintf(stderr, "memory allocation failure\n");
        return 4;
    }
    if (len == 0) {
        fprintf(stderr, "could not read %s, or it was empty\n",
                name == NULL ? "<stdin>" : name);
        free(source);
        return 3;
    }
    if (skip >= len) {
        fprintf(stderr, "skip request of %d leaves no input\n", skip);
        free(source);
        return 3;
    }

    /* test inflate data with offset skip */
    len -= skip;
    sourcelen = (unsigned long)len;
    ret = puff(NIL, &destlen, source + skip, &sourcelen);
    if (ret)
        fprintf(stderr, "puff() failed with return code %d\n", ret);
    else {
        fprintf(stderr, "puff() succeeded uncompressing %lu bytes\n", destlen);
        if (sourcelen < len) fprintf(stderr, "%lu compressed bytes unused\n",
                                     len - sourcelen);
    }

    /* if requested, inflate again and write decompressd data to stdout */
    if (put && ret == 0) {
        if (fail)
            destlen >>= 1;
        dest = malloc(destlen);
        if (dest == NULL) {
            fprintf(stderr, "memory allocation failure\n");
            free(source);
            return 4;
        }
        puff(dest, &destlen, source + skip, &sourcelen);
        SET_BINARY_MODE(stdout);
        fwrite(dest, 1, destlen, stdout);
        free(dest);
    }

    /* clean up */
    free(source);
    return ret;
}

Deleted compat/zlib/contrib/puff/zeros.raw.

cannot compute difference between binary files

Deleted compat/zlib/contrib/testzlib/testzlib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275



















































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <stdio.h>
#include <stdlib.h>
#include <windows.h>

#include "zlib.h"


void MyDoMinus64(LARGE_INTEGER *R,LARGE_INTEGER A,LARGE_INTEGER B)
{
    R->HighPart = A.HighPart - B.HighPart;
    if (A.LowPart >= B.LowPart)
        R->LowPart = A.LowPart - B.LowPart;
    else
    {
        R->LowPart = A.LowPart - B.LowPart;
        R->HighPart --;
    }
}

#ifdef _M_X64
// see http://msdn2.microsoft.com/library/twchhe95(en-us,vs.80).aspx for __rdtsc
unsigned __int64 __rdtsc(void);
void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
{
 //   printf("rdtsc = %I64x\n",__rdtsc());
   pbeginTime64->QuadPart=__rdtsc();
}

LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
{
    LARGE_INTEGER LIres;
    unsigned _int64 res=__rdtsc()-((unsigned _int64)(beginTime64.QuadPart));
    LIres.QuadPart=res;
   // printf("rdtsc = %I64x\n",__rdtsc());
    return LIres;
}
#else
#ifdef _M_IX86
void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
{
    DWORD dwEdx,dwEax;
    _asm
    {
        rdtsc
        mov dwEax,eax
        mov dwEdx,edx
    }
    pbeginTime64->LowPart=dwEax;
    pbeginTime64->HighPart=dwEdx;
}

void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
{
    myGetRDTSC32(pbeginTime64);
}

LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
{
    LARGE_INTEGER LIres,endTime64;
    myGetRDTSC32(&endTime64);

    LIres.LowPart=LIres.HighPart=0;
    MyDoMinus64(&LIres,endTime64,beginTime64);
    return LIres;
}
#else
void myGetRDTSC32(LARGE_INTEGER * pbeginTime64)
{
}

void BeginCountRdtsc(LARGE_INTEGER * pbeginTime64)
{
}

LARGE_INTEGER GetResRdtsc(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
{
    LARGE_INTEGER lr;
    lr.QuadPart=0;
    return lr;
}
#endif
#endif

void BeginCountPerfCounter(LARGE_INTEGER * pbeginTime64,BOOL fComputeTimeQueryPerf)
{
    if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(pbeginTime64)))
    {
        pbeginTime64->LowPart = GetTickCount();
        pbeginTime64->HighPart = 0;
    }
}

DWORD GetMsecSincePerfCounter(LARGE_INTEGER beginTime64,BOOL fComputeTimeQueryPerf)
{
    LARGE_INTEGER endTime64,ticksPerSecond,ticks;
    DWORDLONG ticksShifted,tickSecShifted;
    DWORD dwLog=16+0;
    DWORD dwRet;
    if ((!fComputeTimeQueryPerf) || (!QueryPerformanceCounter(&endTime64)))
        dwRet = (GetTickCount() - beginTime64.LowPart)*1;
    else
    {
        MyDoMinus64(&ticks,endTime64,beginTime64);
        QueryPerformanceFrequency(&ticksPerSecond);


        {
            ticksShifted = Int64ShrlMod32(*(DWORDLONG*)&ticks,dwLog);
            tickSecShifted = Int64ShrlMod32(*(DWORDLONG*)&ticksPerSecond,dwLog);

        }

        dwRet = (DWORD)((((DWORD)ticksShifted)*1000)/(DWORD)(tickSecShifted));
        dwRet *=1;
    }
    return dwRet;
}

int ReadFileMemory(const char* filename,long* plFileSize,unsigned char** pFilePtr)
{
    FILE* stream;
    unsigned char* ptr;
    int retVal=1;
    stream=fopen(filename, "rb");
    if (stream==NULL)
        return 0;

    fseek(stream,0,SEEK_END);

    *plFileSize=ftell(stream);
    fseek(stream,0,SEEK_SET);
    ptr=malloc((*plFileSize)+1);
    if (ptr==NULL)
        retVal=0;
    else
    {
        if (fread(ptr, 1, *plFileSize,stream) != (*plFileSize))
            retVal=0;
    }
    fclose(stream);
    *pFilePtr=ptr;
    return retVal;
}

int main(int argc, char *argv[])
{
    int BlockSizeCompress=0x8000;
    int BlockSizeUncompress=0x8000;
    int cprLevel=Z_DEFAULT_COMPRESSION ;
    long lFileSize;
    unsigned char* FilePtr;
    long lBufferSizeCpr;
    long lBufferSizeUncpr;
    long lCompressedSize=0;
    unsigned char* CprPtr;
    unsigned char* UncprPtr;
    long lSizeCpr,lSizeUncpr;
    DWORD dwGetTick,dwMsecQP;
    LARGE_INTEGER li_qp,li_rdtsc,dwResRdtsc;

    if (argc<=1)
    {
        printf("run TestZlib <File> [BlockSizeCompress] [BlockSizeUncompress] [compres. level]\n");
        return 0;
    }

    if (ReadFileMemory(argv[1],&lFileSize,&FilePtr)==0)
    {
        printf("error reading %s\n",argv[1]);
        return 1;
    }
    else printf("file %s read, %u bytes\n",argv[1],lFileSize);

    if (argc>=3)
        BlockSizeCompress=atol(argv[2]);

    if (argc>=4)
        BlockSizeUncompress=atol(argv[3]);

    if (argc>=5)
        cprLevel=(int)atol(argv[4]);

    lBufferSizeCpr = lFileSize + (lFileSize/0x10) + 0x200;
    lBufferSizeUncpr = lBufferSizeCpr;

    CprPtr=(unsigned char*)malloc(lBufferSizeCpr + BlockSizeCompress);

    BeginCountPerfCounter(&li_qp,TRUE);
    dwGetTick=GetTickCount();
    BeginCountRdtsc(&li_rdtsc);
    {
        z_stream zcpr;
        int ret=Z_OK;
        long lOrigToDo = lFileSize;
        long lOrigDone = 0;
        int step=0;
        memset(&zcpr,0,sizeof(z_stream));
        deflateInit(&zcpr,cprLevel);

        zcpr.next_in = FilePtr;
        zcpr.next_out = CprPtr;


        do
        {
            long all_read_before = zcpr.total_in;
            zcpr.avail_in = min(lOrigToDo,BlockSizeCompress);
            zcpr.avail_out = BlockSizeCompress;
            ret=deflate(&zcpr,(zcpr.avail_in==lOrigToDo) ? Z_FINISH : Z_SYNC_FLUSH);
            lOrigDone += (zcpr.total_in-all_read_before);
            lOrigToDo -= (zcpr.total_in-all_read_before);
            step++;
        } while (ret==Z_OK);

        lSizeCpr=zcpr.total_out;
        deflateEnd(&zcpr);
        dwGetTick=GetTickCount()-dwGetTick;
        dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
        dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
        printf("total compress size = %u, in %u step\n",lSizeCpr,step);
        printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
        printf("defcpr time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
        printf("defcpr result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
    }

    CprPtr=(unsigned char*)realloc(CprPtr,lSizeCpr);
    UncprPtr=(unsigned char*)malloc(lBufferSizeUncpr + BlockSizeUncompress);

    BeginCountPerfCounter(&li_qp,TRUE);
    dwGetTick=GetTickCount();
    BeginCountRdtsc(&li_rdtsc);
    {
        z_stream zcpr;
        int ret=Z_OK;
        long lOrigToDo = lSizeCpr;
        long lOrigDone = 0;
        int step=0;
        memset(&zcpr,0,sizeof(z_stream));
        inflateInit(&zcpr);

        zcpr.next_in = CprPtr;
        zcpr.next_out = UncprPtr;


        do
        {
            long all_read_before = zcpr.total_in;
            zcpr.avail_in = min(lOrigToDo,BlockSizeUncompress);
            zcpr.avail_out = BlockSizeUncompress;
            ret=inflate(&zcpr,Z_SYNC_FLUSH);
            lOrigDone += (zcpr.total_in-all_read_before);
            lOrigToDo -= (zcpr.total_in-all_read_before);
            step++;
        } while (ret==Z_OK);

        lSizeUncpr=zcpr.total_out;
        inflateEnd(&zcpr);
        dwGetTick=GetTickCount()-dwGetTick;
        dwMsecQP=GetMsecSincePerfCounter(li_qp,TRUE);
        dwResRdtsc=GetResRdtsc(li_rdtsc,TRUE);
        printf("total uncompress size = %u, in %u step\n",lSizeUncpr,step);
        printf("time = %u msec = %f sec\n",dwGetTick,dwGetTick/(double)1000.);
        printf("uncpr  time QP = %u msec = %f sec\n",dwMsecQP,dwMsecQP/(double)1000.);
        printf("uncpr  result rdtsc = %I64x\n\n",dwResRdtsc.QuadPart);
    }

    if (lSizeUncpr==lFileSize)
    {
        if (memcmp(FilePtr,UncprPtr,lFileSize)==0)
            printf("compare ok\n");

    }

    return 0;
}

Deleted compat/zlib/contrib/testzlib/testzlib.txt.

1
2
3
4
5
6
7
8
9
10










-
-
-
-
-
-
-
-
-
-
To build testzLib with Visual Studio 2005:

copy to a directory file from :
- root of zLib tree
- contrib/testzlib
- contrib/masmx86
- contrib/masmx64
- contrib/vstudio/vc7

and open testzlib8.sln

Deleted compat/zlib/contrib/untgz/Makefile.

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














-
-
-
-
-
-
-
-
-
-
-
-
-
-
CC=cc
CFLAGS=-g

untgz: untgz.o ../../libz.a
	$(CC) $(CFLAGS) -o untgz untgz.o -L../.. -lz

untgz.o: untgz.c ../../zlib.h
	$(CC) $(CFLAGS) -c -I../.. untgz.c

../../libz.a:
	cd ../..; ./configure; make

clean:
	rm -f untgz untgz.o *~

Deleted compat/zlib/contrib/untgz/Makefile.msc.

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

















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
CC=cl
CFLAGS=-MD

untgz.exe: untgz.obj ..\..\zlib.lib
	$(CC) $(CFLAGS) untgz.obj ..\..\zlib.lib

untgz.obj: untgz.c ..\..\zlib.h
	$(CC) $(CFLAGS) -c -I..\.. untgz.c

..\..\zlib.lib:
	cd ..\..
	$(MAKE) -f win32\makefile.msc
	cd contrib\untgz

clean:
	-del untgz.obj
	-del untgz.exe

Deleted compat/zlib/contrib/untgz/untgz.c.

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


































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * untgz.c -- Display contents and extract files from a gzip'd TAR file
 *
 * written by Pedro A. Aranda Gutierrez <paag@tid.es>
 * adaptation to Unix by Jean-loup Gailly <jloup@gzip.org>
 * various fixes by Cosmin Truta <cosmint@cs.ubbcluj.ro>
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <errno.h>

#include "zlib.h"

#ifdef unix
#  include <unistd.h>
#else
#  include <direct.h>
#  include <io.h>
#endif

#ifdef WIN32
#include <windows.h>
#  ifndef F_OK
#    define F_OK  0
#  endif
#  define mkdir(dirname,mode)   _mkdir(dirname)
#  ifdef _MSC_VER
#    define access(path,mode)   _access(path,mode)
#    define chmod(path,mode)    _chmod(path,mode)
#    define strdup(str)         _strdup(str)
#  endif
#else
#  include <utime.h>
#endif


/* values used in typeflag field */

#define REGTYPE  '0'            /* regular file */
#define AREGTYPE '\0'           /* regular file */
#define LNKTYPE  '1'            /* link */
#define SYMTYPE  '2'            /* reserved */
#define CHRTYPE  '3'            /* character special */
#define BLKTYPE  '4'            /* block special */
#define DIRTYPE  '5'            /* directory */
#define FIFOTYPE '6'            /* FIFO special */
#define CONTTYPE '7'            /* reserved */

/* GNU tar extensions */

#define GNUTYPE_DUMPDIR  'D'    /* file names from dumped directory */
#define GNUTYPE_LONGLINK 'K'    /* long link name */
#define GNUTYPE_LONGNAME 'L'    /* long file name */
#define GNUTYPE_MULTIVOL 'M'    /* continuation of file from another volume */
#define GNUTYPE_NAMES    'N'    /* file name that does not fit into main hdr */
#define GNUTYPE_SPARSE   'S'    /* sparse file */
#define GNUTYPE_VOLHDR   'V'    /* tape/volume header */


/* tar header */

#define BLOCKSIZE     512
#define SHORTNAMESIZE 100

struct tar_header
{                               /* byte offset */
  char name[100];               /*   0 */
  char mode[8];                 /* 100 */
  char uid[8];                  /* 108 */
  char gid[8];                  /* 116 */
  char size[12];                /* 124 */
  char mtime[12];               /* 136 */
  char chksum[8];               /* 148 */
  char typeflag;                /* 156 */
  char linkname[100];           /* 157 */
  char magic[6];                /* 257 */
  char version[2];              /* 263 */
  char uname[32];               /* 265 */
  char gname[32];               /* 297 */
  char devmajor[8];             /* 329 */
  char devminor[8];             /* 337 */
  char prefix[155];             /* 345 */
                                /* 500 */
};

union tar_buffer
{
  char               buffer[BLOCKSIZE];
  struct tar_header  header;
};

struct attr_item
{
  struct attr_item  *next;
  char              *fname;
  int                mode;
  time_t             time;
};

enum { TGZ_EXTRACT, TGZ_LIST, TGZ_INVALID };

char *TGZfname          OF((const char *));
void TGZnotfound        OF((const char *));

int getoct              OF((char *, int));
char *strtime           OF((time_t *));
int setfiletime         OF((char *, time_t));
void push_attr          OF((struct attr_item **, char *, int, time_t));
void restore_attr       OF((struct attr_item **));

int ExprMatch           OF((char *, char *));

int makedir             OF((char *));
int matchname           OF((int, int, char **, char *));

void error              OF((const char *));
int tar                 OF((gzFile, int, int, int, char **));

void help               OF((int));
int main                OF((int, char **));

char *prog;

const char *TGZsuffix[] = { "\0", ".tar", ".tar.gz", ".taz", ".tgz", NULL };

/* return the file name of the TGZ archive */
/* or NULL if it does not exist */

char *TGZfname (const char *arcname)
{
  static char buffer[1024];
  int origlen,i;

  strcpy(buffer,arcname);
  origlen = strlen(buffer);

  for (i=0; TGZsuffix[i]; i++)
    {
       strcpy(buffer+origlen,TGZsuffix[i]);
       if (access(buffer,F_OK) == 0)
         return buffer;
    }
  return NULL;
}


/* error message for the filename */

void TGZnotfound (const char *arcname)
{
  int i;

  fprintf(stderr,"%s: Couldn't find ",prog);
  for (i=0;TGZsuffix[i];i++)
    fprintf(stderr,(TGZsuffix[i+1]) ? "%s%s, " : "or %s%s\n",
            arcname,
            TGZsuffix[i]);
  exit(1);
}


/* convert octal digits to int */
/* on error return -1 */

int getoct (char *p,int width)
{
  int result = 0;
  char c;

  while (width--)
    {
      c = *p++;
      if (c == 0)
        break;
      if (c == ' ')
        continue;
      if (c < '0' || c > '7')
        return -1;
      result = result * 8 + (c - '0');
    }
  return result;
}


/* convert time_t to string */
/* use the "YYYY/MM/DD hh:mm:ss" format */

char *strtime (time_t *t)
{
  struct tm   *local;
  static char result[32];

  local = localtime(t);
  sprintf(result,"%4d/%02d/%02d %02d:%02d:%02d",
          local->tm_year+1900, local->tm_mon+1, local->tm_mday,
          local->tm_hour, local->tm_min, local->tm_sec);
  return result;
}


/* set file time */

int setfiletime (char *fname,time_t ftime)
{
#ifdef WIN32
  static int isWinNT = -1;
  SYSTEMTIME st;
  FILETIME locft, modft;
  struct tm *loctm;
  HANDLE hFile;
  int result;

  loctm = localtime(&ftime);
  if (loctm == NULL)
    return -1;

  st.wYear         = (WORD)loctm->tm_year + 1900;
  st.wMonth        = (WORD)loctm->tm_mon + 1;
  st.wDayOfWeek    = (WORD)loctm->tm_wday;
  st.wDay          = (WORD)loctm->tm_mday;
  st.wHour         = (WORD)loctm->tm_hour;
  st.wMinute       = (WORD)loctm->tm_min;
  st.wSecond       = (WORD)loctm->tm_sec;
  st.wMilliseconds = 0;
  if (!SystemTimeToFileTime(&st, &locft) ||
      !LocalFileTimeToFileTime(&locft, &modft))
    return -1;

  if (isWinNT < 0)
    isWinNT = (GetVersion() < 0x80000000) ? 1 : 0;
  hFile = CreateFile(fname, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
                     (isWinNT ? FILE_FLAG_BACKUP_SEMANTICS : 0),
                     NULL);
  if (hFile == INVALID_HANDLE_VALUE)
    return -1;
  result = SetFileTime(hFile, NULL, NULL, &modft) ? 0 : -1;
  CloseHandle(hFile);
  return result;
#else
  struct utimbuf settime;

  settime.actime = settime.modtime = ftime;
  return utime(fname,&settime);
#endif
}


/* push file attributes */

void push_attr(struct attr_item **list,char *fname,int mode,time_t time)
{
  struct attr_item *item;

  item = (struct attr_item *)malloc(sizeof(struct attr_item));
  if (item == NULL)
    error("Out of memory");
  item->fname = strdup(fname);
  item->mode  = mode;
  item->time  = time;
  item->next  = *list;
  *list       = item;
}


/* restore file attributes */

void restore_attr(struct attr_item **list)
{
  struct attr_item *item, *prev;

  for (item = *list; item != NULL; )
    {
      setfiletime(item->fname,item->time);
      chmod(item->fname,item->mode);
      prev = item;
      item = item->next;
      free(prev);
    }
  *list = NULL;
}


/* match regular expression */

#define ISSPECIAL(c) (((c) == '*') || ((c) == '/'))

int ExprMatch (char *string,char *expr)
{
  while (1)
    {
      if (ISSPECIAL(*expr))
        {
          if (*expr == '/')
            {
              if (*string != '\\' && *string != '/')
                return 0;
              string ++; expr++;
            }
          else if (*expr == '*')
            {
              if (*expr ++ == 0)
                return 1;
              while (*++string != *expr)
                if (*string == 0)
                  return 0;
            }
        }
      else
        {
          if (*string != *expr)
            return 0;
          if (*expr++ == 0)
            return 1;
          string++;
        }
    }
}


/* recursive mkdir */
/* abort on ENOENT; ignore other errors like "directory already exists" */
/* return 1 if OK */
/*        0 on error */

int makedir (char *newdir)
{
  char *buffer = strdup(newdir);
  char *p;
  int  len = strlen(buffer);

  if (len <= 0) {
    free(buffer);
    return 0;
  }
  if (buffer[len-1] == '/') {
    buffer[len-1] = '\0';
  }
  if (mkdir(buffer, 0755) == 0)
    {
      free(buffer);
      return 1;
    }

  p = buffer+1;
  while (1)
    {
      char hold;

      while(*p && *p != '\\' && *p != '/')
        p++;
      hold = *p;
      *p = 0;
      if ((mkdir(buffer, 0755) == -1) && (errno == ENOENT))
        {
          fprintf(stderr,"%s: Couldn't create directory %s\n",prog,buffer);
          free(buffer);
          return 0;
        }
      if (hold == 0)
        break;
      *p++ = hold;
    }
  free(buffer);
  return 1;
}


int matchname (int arg,int argc,char **argv,char *fname)
{
  if (arg == argc)      /* no arguments given (untgz tgzarchive) */
    return 1;

  while (arg < argc)
    if (ExprMatch(fname,argv[arg++]))
      return 1;

  return 0; /* ignore this for the moment being */
}


/* tar file list or extract */

int tar (gzFile in,int action,int arg,int argc,char **argv)
{
  union  tar_buffer buffer;
  int    len;
  int    err;
  int    getheader = 1;
  int    remaining = 0;
  FILE   *outfile = NULL;
  char   fname[BLOCKSIZE];
  int    tarmode;
  time_t tartime;
  struct attr_item *attributes = NULL;

  if (action == TGZ_LIST)
    printf("    date      time     size                       file\n"
           " ---------- -------- --------- -------------------------------------\n");
  while (1)
    {
      len = gzread(in, &buffer, BLOCKSIZE);
      if (len < 0)
        error(gzerror(in, &err));
      /*
       * Always expect complete blocks to process
       * the tar information.
       */
      if (len != BLOCKSIZE)
        {
          action = TGZ_INVALID; /* force error exit */
          remaining = 0;        /* force I/O cleanup */
        }

      /*
       * If we have to get a tar header
       */
      if (getheader >= 1)
        {
          /*
           * if we met the end of the tar
           * or the end-of-tar block,
           * we are done
           */
          if (len == 0 || buffer.header.name[0] == 0)
            break;

          tarmode = getoct(buffer.header.mode,8);
          tartime = (time_t)getoct(buffer.header.mtime,12);
          if (tarmode == -1 || tartime == (time_t)-1)
            {
              buffer.header.name[0] = 0;
              action = TGZ_INVALID;
            }

          if (getheader == 1)
            {
              strncpy(fname,buffer.header.name,SHORTNAMESIZE);
              if (fname[SHORTNAMESIZE-1] != 0)
                  fname[SHORTNAMESIZE] = 0;
            }
          else
            {
              /*
               * The file name is longer than SHORTNAMESIZE
               */
              if (strncmp(fname,buffer.header.name,SHORTNAMESIZE-1) != 0)
                  error("bad long name");
              getheader = 1;
            }

          /*
           * Act according to the type flag
           */
          switch (buffer.header.typeflag)
            {
            case DIRTYPE:
              if (action == TGZ_LIST)
                printf(" %s     <dir> %s\n",strtime(&tartime),fname);
              if (action == TGZ_EXTRACT)
                {
                  makedir(fname);
                  push_attr(&attributes,fname,tarmode,tartime);
                }
              break;
            case REGTYPE:
            case AREGTYPE:
              remaining = getoct(buffer.header.size,12);
              if (remaining == -1)
                {
                  action = TGZ_INVALID;
                  break;
                }
              if (action == TGZ_LIST)
                printf(" %s %9d %s\n",strtime(&tartime),remaining,fname);
              else if (action == TGZ_EXTRACT)
                {
                  if (matchname(arg,argc,argv,fname))
                    {
                      outfile = fopen(fname,"wb");
                      if (outfile == NULL) {
                        /* try creating directory */
                        char *p = strrchr(fname, '/');
                        if (p != NULL) {
                          *p = '\0';
                          makedir(fname);
                          *p = '/';
                          outfile = fopen(fname,"wb");
                        }
                      }
                      if (outfile != NULL)
                        printf("Extracting %s\n",fname);
                      else
                        fprintf(stderr, "%s: Couldn't create %s",prog,fname);
                    }
                  else
                    outfile = NULL;
                }
              getheader = 0;
              break;
            case GNUTYPE_LONGLINK:
            case GNUTYPE_LONGNAME:
              remaining = getoct(buffer.header.size,12);
              if (remaining < 0 || remaining >= BLOCKSIZE)
                {
                  action = TGZ_INVALID;
                  break;
                }
              len = gzread(in, fname, BLOCKSIZE);
              if (len < 0)
                error(gzerror(in, &err));
              if (fname[BLOCKSIZE-1] != 0 || (int)strlen(fname) > remaining)
                {
                  action = TGZ_INVALID;
                  break;
                }
              getheader = 2;
              break;
            default:
              if (action == TGZ_LIST)
                printf(" %s     <---> %s\n",strtime(&tartime),fname);
              break;
            }
        }
      else
        {
          unsigned int bytes = (remaining > BLOCKSIZE) ? BLOCKSIZE : remaining;

          if (outfile != NULL)
            {
              if (fwrite(&buffer,sizeof(char),bytes,outfile) != bytes)
                {
                  fprintf(stderr,
                    "%s: Error writing %s -- skipping\n",prog,fname);
                  fclose(outfile);
                  outfile = NULL;
                  remove(fname);
                }
            }
          remaining -= bytes;
        }

      if (remaining == 0)
        {
          getheader = 1;
          if (outfile != NULL)
            {
              fclose(outfile);
              outfile = NULL;
              if (action != TGZ_INVALID)
                push_attr(&attributes,fname,tarmode,tartime);
            }
        }

      /*
       * Abandon if errors are found
       */
      if (action == TGZ_INVALID)
        {
          error("broken archive");
          break;
        }
    }

  /*
   * Restore file modes and time stamps
   */
  restore_attr(&attributes);

  if (gzclose(in) != Z_OK)
    error("failed gzclose");

  return 0;
}


/* ============================================================ */

void help(int exitval)
{
  printf("untgz version 0.2.1\n"
         "  using zlib version %s\n\n",
         zlibVersion());
  printf("Usage: untgz file.tgz            extract all files\n"
         "       untgz file.tgz fname ...  extract selected files\n"
         "       untgz -l file.tgz         list archive contents\n"
         "       untgz -h                  display this help\n");
  exit(exitval);
}

void error(const char *msg)
{
  fprintf(stderr, "%s: %s\n", prog, msg);
  exit(1);
}


/* ============================================================ */

#if defined(WIN32) && defined(__GNUC__)
int _CRT_glob = 0;      /* disable argument globbing in MinGW */
#endif

int main(int argc,char **argv)
{
    int         action = TGZ_EXTRACT;
    int         arg = 1;
    char        *TGZfile;
    gzFile      *f;

    prog = strrchr(argv[0],'\\');
    if (prog == NULL)
      {
        prog = strrchr(argv[0],'/');
        if (prog == NULL)
          {
            prog = strrchr(argv[0],':');
            if (prog == NULL)
              prog = argv[0];
            else
              prog++;
          }
        else
          prog++;
      }
    else
      prog++;

    if (argc == 1)
      help(0);

    if (strcmp(argv[arg],"-l") == 0)
      {
        action = TGZ_LIST;
        if (argc == ++arg)
          help(0);
      }
    else if (strcmp(argv[arg],"-h") == 0)
      {
        help(0);
      }

    if ((TGZfile = TGZfname(argv[arg])) == NULL)
      TGZnotfound(argv[arg]);

    ++arg;
    if ((action == TGZ_LIST) && (arg != argc))
      help(1);

/*
 *  Process the TGZ file
 */
    switch(action)
      {
      case TGZ_LIST:
      case TGZ_EXTRACT:
        f = gzopen(TGZfile,"rb");
        if (f == NULL)
          {
            fprintf(stderr,"%s: Couldn't gzopen %s\n",prog,TGZfile);
            return 1;
          }
        exit(tar(f, action, arg, argc, argv));
      break;

      default:
        error("Unknown option");
        exit(1);
      }

    return 0;
}

Deleted compat/zlib/contrib/vstudio/readme.txt.

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














































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
Building instructions for the DLL versions of Zlib 1.2.11
========================================================

This directory contains projects that build zlib and minizip using
Microsoft Visual C++ 9.0/10.0.

You don't need to build these projects yourself. You can download the
binaries from:
  http://www.winimage.com/zLibDll

More information can be found at this site.





Build instructions for Visual Studio 2008 (32 bits or 64 bits)
--------------------------------------------------------------
- Decompress current zlib, including all contrib/* files
- Compile assembly code (with Visual Studio Command Prompt) by running:
   bld_ml64.bat (in contrib\masmx64)
   bld_ml32.bat (in contrib\masmx86)
- Open contrib\vstudio\vc9\zlibvc.sln with Microsoft Visual C++ 2008
- Or run: vcbuild /rebuild contrib\vstudio\vc9\zlibvc.sln "Release|Win32"

Build instructions for Visual Studio 2010 (32 bits or 64 bits)
--------------------------------------------------------------
- Decompress current zlib, including all contrib/* files
- Open contrib\vstudio\vc10\zlibvc.sln with Microsoft Visual C++ 2010

Build instructions for Visual Studio 2012 (32 bits or 64 bits)
--------------------------------------------------------------
- Decompress current zlib, including all contrib/* files
- Open contrib\vstudio\vc11\zlibvc.sln with Microsoft Visual C++ 2012

Build instructions for Visual Studio 2013 (32 bits or 64 bits)
--------------------------------------------------------------
- Decompress current zlib, including all contrib/* files
- Open contrib\vstudio\vc12\zlibvc.sln with Microsoft Visual C++ 2013

Build instructions for Visual Studio 2015 (32 bits or 64 bits)
--------------------------------------------------------------
- Decompress current zlib, including all contrib/* files
- Open contrib\vstudio\vc14\zlibvc.sln with Microsoft Visual C++ 2015


Important
---------
- To use zlibwapi.dll in your application, you must define the
  macro ZLIB_WINAPI when compiling your application's source files.


Additional notes
----------------
- This DLL, named zlibwapi.dll, is compatible to the old zlib.dll built
  by Gilles Vollant from the zlib 1.1.x sources, and distributed at
    http://www.winimage.com/zLibDll
  It uses the WINAPI calling convention for the exported functions, and
  includes the minizip functionality. If your application needs that
  particular build of zlib.dll, you can rename zlibwapi.dll to zlib.dll.

- The new DLL was renamed because there exist several incompatible
  versions of zlib.dll on the Internet.

- There is also an official DLL build of zlib, named zlib1.dll. This one
  is exporting the functions using the CDECL convention. See the file
  win32\DLL_FAQ.txt found in this zlib distribution.

- There used to be a ZLIB_DLL macro in zlib 1.1.x, but now this symbol
  has a slightly different effect. To avoid compatibility problems, do
  not define it here.


Gilles Vollant
info@winimage.com

Visual Studio 2013 and 2015 Projects from Sean Hunt
seandhunt_7@yahoo.com

Deleted compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.

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






















































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694382A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\miniunz.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/miniunz.vcxproj.filters.

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






















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup>
    <Filter Include="Source Files">
      <UniqueIdentifier>{048af943-022b-4db6-beeb-a54c34774ee2}</UniqueIdentifier>
      <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
    </Filter>
    <Filter Include="Header Files">
      <UniqueIdentifier>{c1d600d2-888f-4aea-b73e-8b0dd9befa0c}</UniqueIdentifier>
      <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
    </Filter>
    <Filter Include="Resource Files">
      <UniqueIdentifier>{0844199a-966b-4f19-81db-1e0125e141b9}</UniqueIdentifier>
      <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
    </Filter>
  </ItemGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\miniunz.c">
      <Filter>Source Files</Filter>
    </ClCompile>
  </ItemGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.

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



















































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\minizip.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/minizip.vcxproj.filters.

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






















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup>
    <Filter Include="Source Files">
      <UniqueIdentifier>{c0419b40-bf50-40da-b153-ff74215b79de}</UniqueIdentifier>
      <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
    </Filter>
    <Filter Include="Header Files">
      <UniqueIdentifier>{bb87b070-735b-478e-92ce-7383abb2f36c}</UniqueIdentifier>
      <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
    </Filter>
    <Filter Include="Resource Files">
      <UniqueIdentifier>{f46ab6a6-548f-43cb-ae96-681abb5bd5db}</UniqueIdentifier>
      <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
    </Filter>
  </ItemGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\minizip.c">
      <Filter>Source Files</Filter>
    </ClCompile>
  </ItemGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.

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
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




































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <RootNamespace>testzlib</RootNamespace>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\testzlib\testzlib.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/testzlib.vcxproj.filters.

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


























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup>
    <Filter Include="Source Files">
      <UniqueIdentifier>{c1f6a2e3-5da5-4955-8653-310d3efe05a9}</UniqueIdentifier>
      <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
    </Filter>
    <Filter Include="Header Files">
      <UniqueIdentifier>{c2aaffdc-2c95-4d6f-8466-4bec5890af2c}</UniqueIdentifier>
      <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
    </Filter>
    <Filter Include="Resource Files">
      <UniqueIdentifier>{c274fe07-05f2-461c-964b-f6341e4e7eb5}</UniqueIdentifier>
      <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
    </Filter>
  </ItemGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\compress.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\crc32.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\deflate.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\infback.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inflate.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inftrees.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\testzlib\testzlib.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\trees.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\uncompr.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\zutil.c">
      <Filter>Source Files</Filter>
    </ClCompile>
  </ItemGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.

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






















































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694366A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\testzlib\testzlib.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/testzlibdll.vcxproj.filters.

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






















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup>
    <Filter Include="Source Files">
      <UniqueIdentifier>{fa61a89f-93fc-4c89-b29e-36224b7592f4}</UniqueIdentifier>
      <Extensions>cpp;c;cxx;def;odl;idl;hpj;bat;asm</Extensions>
    </Filter>
    <Filter Include="Header Files">
      <UniqueIdentifier>{d4b85da0-2ba2-4934-b57f-e2584e3848ee}</UniqueIdentifier>
      <Extensions>h;hpp;hxx;hm;inl;inc</Extensions>
    </Filter>
    <Filter Include="Resource Files">
      <UniqueIdentifier>{e573e075-00bd-4a7d-bd67-a8cc9bfc5aca}</UniqueIdentifier>
      <Extensions>rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe</Extensions>
    </Filter>
  </ItemGroup>
  <ItemGroup>
    <ClCompile Include="..\..\testzlib\testzlib.c">
      <Filter>Source Files</Filter>
    </ClCompile>
  </ItemGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/zlib.rc.

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
































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <windows.h>

#define IDR_VERSION1  1
IDR_VERSION1	VERSIONINFO	MOVEABLE IMPURE LOADONCALL DISCARDABLE
  FILEVERSION	 1, 2, 11, 0
  PRODUCTVERSION 1, 2, 11, 0
  FILEFLAGSMASK	VS_FFI_FILEFLAGSMASK
  FILEFLAGS	0
  FILEOS	VOS_DOS_WINDOWS32
  FILETYPE	VFT_DLL
  FILESUBTYPE	0	// not used
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904E4"
    //language ID = U.S. English, char set = Windows, Multilingual

    BEGIN
      VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
      VALUE "FileVersion",	"1.2.11\0"
      VALUE "InternalName",	"zlib\0"
      VALUE "OriginalFilename",	"zlibwapi.dll\0"
      VALUE "ProductName",	"ZLib.DLL\0"
      VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
      VALUE "LegalCopyright", "(C) 1995-2017 Jean-loup Gailly & Mark Adler\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x0409, 1252
  END
END

Deleted compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.

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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473

























































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
    <PreBuildEvent>
      <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
    <PreBuildEvent>
      <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c" />
    <ClCompile Include="..\..\minizip\zip.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/zlibstat.vcxproj.filters.

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













































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup>
    <Filter Include="Source Files">
      <UniqueIdentifier>{174213f6-7f66-4ae8-a3a8-a1e0a1e6ffdd}</UniqueIdentifier>
    </Filter>
  </ItemGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\compress.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\crc32.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\deflate.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzclose.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzlib.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzread.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzwrite.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\infback.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inflate.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inftrees.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\minizip\ioapi.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\trees.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\uncompr.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\minizip\unzip.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\minizip\zip.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\zutil.c">
      <Filter>Source Files</Filter>
    </ClCompile>
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc">
      <Filter>Source Files</Filter>
    </ResourceCompile>
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def">
      <Filter>Source Files</Filter>
    </None>
  </ItemGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/zlibvc.def.

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

























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
LIBRARY
; zlib data compression and ZIP file I/O library

VERSION		1.2

EXPORTS
        adler32                                  @1
        compress                                 @2
        crc32                                    @3
        deflate                                  @4
        deflateCopy                              @5
        deflateEnd                               @6
        deflateInit2_                            @7
        deflateInit_                             @8
        deflateParams                            @9
        deflateReset                             @10
        deflateSetDictionary                     @11
        gzclose                                  @12
        gzdopen                                  @13
        gzerror                                  @14
        gzflush                                  @15
        gzopen                                   @16
        gzread                                   @17
        gzwrite                                  @18
        inflate                                  @19
        inflateEnd                               @20
        inflateInit2_                            @21
        inflateInit_                             @22
        inflateReset                             @23
        inflateSetDictionary                     @24
        inflateSync                              @25
        uncompress                               @26
        zlibVersion                              @27
        gzprintf                                 @28
        gzputc                                   @29
        gzgetc                                   @30
        gzseek                                   @31
        gzrewind                                 @32
        gztell                                   @33
        gzeof                                    @34
        gzsetparams                              @35
        zError                                   @36
        inflateSyncPoint                         @37
        get_crc_table                            @38
        compress2                                @39
        gzputs                                   @40
        gzgets                                   @41
        inflateCopy                              @42
        inflateBackInit_                         @43
        inflateBack                              @44
        inflateBackEnd                           @45
        compressBound                            @46
        deflateBound                             @47
        gzclearerr                               @48
        gzungetc                                 @49
        zlibCompileFlags                         @50
        deflatePrime                             @51
        deflatePending                           @52

        unzOpen                                  @61
        unzClose                                 @62
        unzGetGlobalInfo                         @63
        unzGetCurrentFileInfo                    @64
        unzGoToFirstFile                         @65
        unzGoToNextFile                          @66
        unzOpenCurrentFile                       @67
        unzReadCurrentFile                       @68
        unzOpenCurrentFile3                      @69
        unztell                                  @70
        unzeof                                   @71
        unzCloseCurrentFile                      @72
        unzGetGlobalComment                      @73
        unzStringFileNameCompare                 @74
        unzLocateFile                            @75
        unzGetLocalExtrafield                    @76
        unzOpen2                                 @77
        unzOpenCurrentFile2                      @78
        unzOpenCurrentFilePassword               @79

        zipOpen                                  @80
        zipOpenNewFileInZip                      @81
        zipWriteInFileInZip                      @82
        zipCloseFileInZip                        @83
        zipClose                                 @84
        zipOpenNewFileInZip2                     @86
        zipCloseFileInZipRaw                     @87
        zipOpen2                                 @88
        zipOpenNewFileInZip3                     @89

        unzGetFilePos                            @100
        unzGoToFilePos                           @101

        fill_win32_filefunc                      @110

; zlibwapi v1.2.4 added:
        fill_win32_filefunc64                   @111
        fill_win32_filefunc64A                  @112
        fill_win32_filefunc64W                  @113

        unzOpen64                               @120
        unzOpen2_64                             @121
        unzGetGlobalInfo64                      @122
        unzGetCurrentFileInfo64                 @124
        unzGetCurrentFileZStreamPos64           @125
        unztell64                               @126
        unzGetFilePos64                         @127
        unzGoToFilePos64                        @128

        zipOpen64                               @130
        zipOpen2_64                             @131
        zipOpenNewFileInZip64                   @132
        zipOpenNewFileInZip2_64                 @133
        zipOpenNewFileInZip3_64                 @134
        zipOpenNewFileInZip4_64                 @135
        zipCloseFileInZipRaw64                  @136

; zlib1 v1.2.4 added:
        adler32_combine                         @140
        crc32_combine                           @142
        deflateSetHeader                        @144
        deflateTune                             @145
        gzbuffer                                @146
        gzclose_r                               @147
        gzclose_w                               @148
        gzdirect                                @149
        gzoffset                                @150
        inflateGetHeader                        @156
        inflateMark                             @157
        inflatePrime                            @158
        inflateReset2                           @159
        inflateUndermine                        @160

; zlib1 v1.2.6 added:
        gzgetc_                                 @161
        inflateResetKeep                        @163
        deflateResetKeep                        @164

; zlib1 v1.2.7 added:
        gzopen_w                                @165

; zlib1 v1.2.8 added:
        inflateGetDictionary                    @166
        gzvprintf                               @167

; zlib1 v1.2.9 added:
        inflateCodesUsed                        @168
        inflateValidate                         @169
        uncompress2                             @170
        gzfread                                 @171
        gzfwrite                                @172
        deflateGetDictionary                    @173
        adler32_z                               @174
        crc32_z                                 @175

Deleted compat/zlib/contrib/vstudio/vc10/zlibvc.sln.

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







































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Microsoft Visual Studio Solution File, Format Version 11.00
# Visual Studio 2010
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
EndProject
Global
	GlobalSection(SolutionConfigurationPlatforms) = preSolution
		Debug|Itanium = Debug|Itanium
		Debug|Win32 = Debug|Win32
		Debug|x64 = Debug|x64
		Release|Itanium = Release|Itanium
		Release|Win32 = Release|Win32
		Release|x64 = Release|x64
		ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
		ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
		ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
	EndGlobalSection
	GlobalSection(ProjectConfigurationPlatforms) = postSolution
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.Build.0 = Debug|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.Build.0 = Release|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.Build.0 = Debug|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.Build.0 = Release|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.Build.0 = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.Build.0 = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
	EndGlobalSection
	GlobalSection(SolutionProperties) = preSolution
		HideSolutionNode = FALSE
	EndGlobalSection
EndGlobal

Deleted compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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

















































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{8FD826F8-3739-44E6-8CC8-997122E53B8D}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapid</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapid</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">zlibwapi</TargetName>
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebug</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>EditAndContinue</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <GenerateMapFile>true</GenerateMapFile>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateMapFile>true</GenerateMapFile>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateMapFile>true</GenerateMapFile>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <GenerateMapFile>true</GenerateMapFile>
      <SubSystem>Windows</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateMapFile>true</GenerateMapFile>
      <SubSystem>Windows</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateMapFile>true</GenerateMapFile>
      <SubSystem>Windows</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\minizip\iowin32.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\minizip\zip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <ItemGroup>
    <ClInclude Include="..\..\..\deflate.h" />
    <ClInclude Include="..\..\..\infblock.h" />
    <ClInclude Include="..\..\..\infcodes.h" />
    <ClInclude Include="..\..\..\inffast.h" />
    <ClInclude Include="..\..\..\inftrees.h" />
    <ClInclude Include="..\..\..\infutil.h" />
    <ClInclude Include="..\..\..\zconf.h" />
    <ClInclude Include="..\..\..\zlib.h" />
    <ClInclude Include="..\..\..\zutil.h" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc10/zlibvc.vcxproj.filters.

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






















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup>
    <Filter Include="Source Files">
      <UniqueIdentifier>{07934a85-8b61-443d-a0ee-b2eedb74f3cd}</UniqueIdentifier>
      <Extensions>cpp;c;cxx;rc;def;r;odl;hpj;bat;for;f90</Extensions>
    </Filter>
    <Filter Include="Header Files">
      <UniqueIdentifier>{1d99675b-433d-4a21-9e50-ed4ab8b19762}</UniqueIdentifier>
      <Extensions>h;hpp;hxx;hm;inl;fi;fd</Extensions>
    </Filter>
    <Filter Include="Resource Files">
      <UniqueIdentifier>{431c0958-fa71-44d0-9084-2d19d100c0cc}</UniqueIdentifier>
      <Extensions>ico;cur;bmp;dlg;rc2;rct;bin;cnt;rtf;gif;jpg;jpeg;jpe</Extensions>
    </Filter>
  </ItemGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\compress.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\crc32.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\deflate.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzclose.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzlib.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzread.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\gzwrite.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\infback.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inflate.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\inftrees.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\minizip\ioapi.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\minizip\iowin32.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\trees.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\uncompr.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\minizip\unzip.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\minizip\zip.c">
      <Filter>Source Files</Filter>
    </ClCompile>
    <ClCompile Include="..\..\..\zutil.c">
      <Filter>Source Files</Filter>
    </ClCompile>
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc">
      <Filter>Source Files</Filter>
    </ResourceCompile>
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def">
      <Filter>Source Files</Filter>
    </None>
  </ItemGroup>
  <ItemGroup>
    <ClInclude Include="..\..\..\deflate.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\infblock.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\infcodes.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\inffast.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\inftrees.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\infutil.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\zconf.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\zlib.h">
      <Filter>Header Files</Filter>
    </ClInclude>
    <ClInclude Include="..\..\..\zutil.h">
      <Filter>Header Files</Filter>
    </ClInclude>
  </ItemGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc11/miniunz.vcxproj.

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


























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694382A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\miniunz.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc11/minizip.vcxproj.

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























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\minizip.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc11/testzlib.vcxproj.

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
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










































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <RootNamespace>testzlib</RootNamespace>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\testzlib\testzlib.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc11/testzlibdll.vcxproj.

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


























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694366A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\testzlib\testzlib.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc11/zlib.rc.

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
































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <windows.h>

#define IDR_VERSION1  1
IDR_VERSION1	VERSIONINFO	MOVEABLE IMPURE LOADONCALL DISCARDABLE
  FILEVERSION	 1, 2, 11, 0
  PRODUCTVERSION 1, 2, 11, 0
  FILEFLAGSMASK	VS_FFI_FILEFLAGSMASK
  FILEFLAGS	0
  FILEOS	VOS_DOS_WINDOWS32
  FILETYPE	VFT_DLL
  FILESUBTYPE	0	// not used
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904E4"
    //language ID = U.S. English, char set = Windows, Multilingual

    BEGIN
      VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
      VALUE "FileVersion",	"1.2.11\0"
      VALUE "InternalName",	"zlib\0"
      VALUE "OriginalFilename",	"zlibwapi.dll\0"
      VALUE "ProductName",	"ZLib.DLL\0"
      VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
      VALUE "LegalCopyright", "(C) 1995-2017 Jean-loup Gailly & Mark Adler\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x0409, 1252
  END
END

Deleted compat/zlib/contrib/vstudio/vc11/zlibstat.vcxproj.

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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
    <CharacterSet>Unicode</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c" />
    <ClCompile Include="..\..\minizip\zip.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc11/zlibvc.def.

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

























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
LIBRARY
; zlib data compression and ZIP file I/O library

VERSION		1.2

EXPORTS
        adler32                                  @1
        compress                                 @2
        crc32                                    @3
        deflate                                  @4
        deflateCopy                              @5
        deflateEnd                               @6
        deflateInit2_                            @7
        deflateInit_                             @8
        deflateParams                            @9
        deflateReset                             @10
        deflateSetDictionary                     @11
        gzclose                                  @12
        gzdopen                                  @13
        gzerror                                  @14
        gzflush                                  @15
        gzopen                                   @16
        gzread                                   @17
        gzwrite                                  @18
        inflate                                  @19
        inflateEnd                               @20
        inflateInit2_                            @21
        inflateInit_                             @22
        inflateReset                             @23
        inflateSetDictionary                     @24
        inflateSync                              @25
        uncompress                               @26
        zlibVersion                              @27
        gzprintf                                 @28
        gzputc                                   @29
        gzgetc                                   @30
        gzseek                                   @31
        gzrewind                                 @32
        gztell                                   @33
        gzeof                                    @34
        gzsetparams                              @35
        zError                                   @36
        inflateSyncPoint                         @37
        get_crc_table                            @38
        compress2                                @39
        gzputs                                   @40
        gzgets                                   @41
        inflateCopy                              @42
        inflateBackInit_                         @43
        inflateBack                              @44
        inflateBackEnd                           @45
        compressBound                            @46
        deflateBound                             @47
        gzclearerr                               @48
        gzungetc                                 @49
        zlibCompileFlags                         @50
        deflatePrime                             @51
        deflatePending                           @52

        unzOpen                                  @61
        unzClose                                 @62
        unzGetGlobalInfo                         @63
        unzGetCurrentFileInfo                    @64
        unzGoToFirstFile                         @65
        unzGoToNextFile                          @66
        unzOpenCurrentFile                       @67
        unzReadCurrentFile                       @68
        unzOpenCurrentFile3                      @69
        unztell                                  @70
        unzeof                                   @71
        unzCloseCurrentFile                      @72
        unzGetGlobalComment                      @73
        unzStringFileNameCompare                 @74
        unzLocateFile                            @75
        unzGetLocalExtrafield                    @76
        unzOpen2                                 @77
        unzOpenCurrentFile2                      @78
        unzOpenCurrentFilePassword               @79

        zipOpen                                  @80
        zipOpenNewFileInZip                      @81
        zipWriteInFileInZip                      @82
        zipCloseFileInZip                        @83
        zipClose                                 @84
        zipOpenNewFileInZip2                     @86
        zipCloseFileInZipRaw                     @87
        zipOpen2                                 @88
        zipOpenNewFileInZip3                     @89

        unzGetFilePos                            @100
        unzGoToFilePos                           @101

        fill_win32_filefunc                      @110

; zlibwapi v1.2.4 added:
        fill_win32_filefunc64                   @111
        fill_win32_filefunc64A                  @112
        fill_win32_filefunc64W                  @113

        unzOpen64                               @120
        unzOpen2_64                             @121
        unzGetGlobalInfo64                      @122
        unzGetCurrentFileInfo64                 @124
        unzGetCurrentFileZStreamPos64           @125
        unztell64                               @126
        unzGetFilePos64                         @127
        unzGoToFilePos64                        @128

        zipOpen64                               @130
        zipOpen2_64                             @131
        zipOpenNewFileInZip64                   @132
        zipOpenNewFileInZip2_64                 @133
        zipOpenNewFileInZip3_64                 @134
        zipOpenNewFileInZip4_64                 @135
        zipCloseFileInZipRaw64                  @136

; zlib1 v1.2.4 added:
        adler32_combine                         @140
        crc32_combine                           @142
        deflateSetHeader                        @144
        deflateTune                             @145
        gzbuffer                                @146
        gzclose_r                               @147
        gzclose_w                               @148
        gzdirect                                @149
        gzoffset                                @150
        inflateGetHeader                        @156
        inflateMark                             @157
        inflatePrime                            @158
        inflateReset2                           @159
        inflateUndermine                        @160

; zlib1 v1.2.6 added:
        gzgetc_                                 @161
        inflateResetKeep                        @163
        deflateResetKeep                        @164

; zlib1 v1.2.7 added:
        gzopen_w                                @165

; zlib1 v1.2.8 added:
        inflateGetDictionary                    @166
        gzvprintf                               @167

; zlib1 v1.2.9 added:
        inflateCodesUsed                        @168
        inflateValidate                         @169
        uncompress2                             @170
        gzfread                                 @171
        gzfwrite                                @172
        deflateGetDictionary                    @173
        adler32_z                               @174
        crc32_z                                 @175

Deleted compat/zlib/contrib/vstudio/vc11/zlibvc.sln.

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





















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 2012
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
EndProject
Global
	GlobalSection(SolutionConfigurationPlatforms) = preSolution
		Debug|Itanium = Debug|Itanium
		Debug|Win32 = Debug|Win32
		Debug|x64 = Debug|x64
		Release|Itanium = Release|Itanium
		Release|Win32 = Release|Win32
		Release|x64 = Release|x64
		ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
		ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
		ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
	EndGlobalSection
	GlobalSection(ProjectConfigurationPlatforms) = postSolution
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
	EndGlobalSection
	GlobalSection(SolutionProperties) = preSolution
		HideSolutionNode = FALSE
	EndGlobalSection
EndGlobal

Deleted compat/zlib/contrib/vstudio/vc11/zlibvc.vcxproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
686
687
688
















































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="4.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{8FD826F8-3739-44E6-8CC8-997122E53B8D}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
    <CharacterSet>Unicode</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v110</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">zlibwapi</TargetName>
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\contrib\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\minizip\iowin32.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\minizip\zip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <ItemGroup>
    <ClInclude Include="..\..\..\deflate.h" />
    <ClInclude Include="..\..\..\infblock.h" />
    <ClInclude Include="..\..\..\infcodes.h" />
    <ClInclude Include="..\..\..\inffast.h" />
    <ClInclude Include="..\..\..\inftrees.h" />
    <ClInclude Include="..\..\..\infutil.h" />
    <ClInclude Include="..\..\..\zconf.h" />
    <ClInclude Include="..\..\..\zlib.h" />
    <ClInclude Include="..\..\..\zutil.h" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc12/miniunz.vcxproj.

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




























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="12.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694382A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\miniunz.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc12/minizip.vcxproj.

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

























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="12.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\minizip.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc12/testzlib.vcxproj.

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
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














































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="12.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <RootNamespace>testzlib</RootNamespace>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
      <ImageHasSafeExceptionHandlers>false</ImageHasSafeExceptionHandlers>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\testzlib\testzlib.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc12/testzlibdll.vcxproj.

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




























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="12.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694366A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\testzlib\testzlib.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc12/zlib.rc.

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
































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <windows.h>

#define IDR_VERSION1  1
IDR_VERSION1	VERSIONINFO	MOVEABLE IMPURE LOADONCALL DISCARDABLE
  FILEVERSION	 1, 2, 11, 0
  PRODUCTVERSION 1, 2, 11, 0
  FILEFLAGSMASK	VS_FFI_FILEFLAGSMASK
  FILEFLAGS	0
  FILEOS	VOS_DOS_WINDOWS32
  FILETYPE	VFT_DLL
  FILESUBTYPE	0	// not used
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904E4"
    //language ID = U.S. English, char set = Windows, Multilingual

    BEGIN
      VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
      VALUE "FileVersion",	"1.2.11\0"
      VALUE "InternalName",	"zlib\0"
      VALUE "OriginalFilename",	"zlibwapi.dll\0"
      VALUE "ProductName",	"ZLib.DLL\0"
      VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
      VALUE "LegalCopyright", "(C) 1995-2017 Jean-loup Gailly & Mark Adler\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x0409, 1252
  END
END

Deleted compat/zlib/contrib/vstudio/vc12/zlibstat.vcxproj.

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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467



















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="12.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
    <CharacterSet>Unicode</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c" />
    <ClCompile Include="..\..\minizip\zip.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc12/zlibvc.def.

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

























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
LIBRARY
; zlib data compression and ZIP file I/O library

VERSION		1.2

EXPORTS
        adler32                                  @1
        compress                                 @2
        crc32                                    @3
        deflate                                  @4
        deflateCopy                              @5
        deflateEnd                               @6
        deflateInit2_                            @7
        deflateInit_                             @8
        deflateParams                            @9
        deflateReset                             @10
        deflateSetDictionary                     @11
        gzclose                                  @12
        gzdopen                                  @13
        gzerror                                  @14
        gzflush                                  @15
        gzopen                                   @16
        gzread                                   @17
        gzwrite                                  @18
        inflate                                  @19
        inflateEnd                               @20
        inflateInit2_                            @21
        inflateInit_                             @22
        inflateReset                             @23
        inflateSetDictionary                     @24
        inflateSync                              @25
        uncompress                               @26
        zlibVersion                              @27
        gzprintf                                 @28
        gzputc                                   @29
        gzgetc                                   @30
        gzseek                                   @31
        gzrewind                                 @32
        gztell                                   @33
        gzeof                                    @34
        gzsetparams                              @35
        zError                                   @36
        inflateSyncPoint                         @37
        get_crc_table                            @38
        compress2                                @39
        gzputs                                   @40
        gzgets                                   @41
        inflateCopy                              @42
        inflateBackInit_                         @43
        inflateBack                              @44
        inflateBackEnd                           @45
        compressBound                            @46
        deflateBound                             @47
        gzclearerr                               @48
        gzungetc                                 @49
        zlibCompileFlags                         @50
        deflatePrime                             @51
        deflatePending                           @52

        unzOpen                                  @61
        unzClose                                 @62
        unzGetGlobalInfo                         @63
        unzGetCurrentFileInfo                    @64
        unzGoToFirstFile                         @65
        unzGoToNextFile                          @66
        unzOpenCurrentFile                       @67
        unzReadCurrentFile                       @68
        unzOpenCurrentFile3                      @69
        unztell                                  @70
        unzeof                                   @71
        unzCloseCurrentFile                      @72
        unzGetGlobalComment                      @73
        unzStringFileNameCompare                 @74
        unzLocateFile                            @75
        unzGetLocalExtrafield                    @76
        unzOpen2                                 @77
        unzOpenCurrentFile2                      @78
        unzOpenCurrentFilePassword               @79

        zipOpen                                  @80
        zipOpenNewFileInZip                      @81
        zipWriteInFileInZip                      @82
        zipCloseFileInZip                        @83
        zipClose                                 @84
        zipOpenNewFileInZip2                     @86
        zipCloseFileInZipRaw                     @87
        zipOpen2                                 @88
        zipOpenNewFileInZip3                     @89

        unzGetFilePos                            @100
        unzGoToFilePos                           @101

        fill_win32_filefunc                      @110

; zlibwapi v1.2.4 added:
        fill_win32_filefunc64                   @111
        fill_win32_filefunc64A                  @112
        fill_win32_filefunc64W                  @113

        unzOpen64                               @120
        unzOpen2_64                             @121
        unzGetGlobalInfo64                      @122
        unzGetCurrentFileInfo64                 @124
        unzGetCurrentFileZStreamPos64           @125
        unztell64                               @126
        unzGetFilePos64                         @127
        unzGoToFilePos64                        @128

        zipOpen64                               @130
        zipOpen2_64                             @131
        zipOpenNewFileInZip64                   @132
        zipOpenNewFileInZip2_64                 @133
        zipOpenNewFileInZip3_64                 @134
        zipOpenNewFileInZip4_64                 @135
        zipCloseFileInZipRaw64                  @136

; zlib1 v1.2.4 added:
        adler32_combine                         @140
        crc32_combine                           @142
        deflateSetHeader                        @144
        deflateTune                             @145
        gzbuffer                                @146
        gzclose_r                               @147
        gzclose_w                               @148
        gzdirect                                @149
        gzoffset                                @150
        inflateGetHeader                        @156
        inflateMark                             @157
        inflatePrime                            @158
        inflateReset2                           @159
        inflateUndermine                        @160

; zlib1 v1.2.6 added:
        gzgetc_                                 @161
        inflateResetKeep                        @163
        deflateResetKeep                        @164

; zlib1 v1.2.7 added:
        gzopen_w                                @165

; zlib1 v1.2.8 added:
        inflateGetDictionary                    @166
        gzvprintf                               @167

; zlib1 v1.2.9 added:
        inflateCodesUsed                        @168
        inflateValidate                         @169
        uncompress2                             @170
        gzfread                                 @171
        gzfwrite                                @172
        deflateGetDictionary                    @173
        adler32_z                               @174
        crc32_z                                 @175

Deleted compat/zlib/contrib/vstudio/vc12/zlibvc.sln.

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























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 2013
VisualStudioVersion = 12.0.40629.0
MinimumVisualStudioVersion = 10.0.40219.1
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
EndProject
Global
	GlobalSection(SolutionConfigurationPlatforms) = preSolution
		Debug|Itanium = Debug|Itanium
		Debug|Win32 = Debug|Win32
		Debug|x64 = Debug|x64
		Release|Itanium = Release|Itanium
		Release|Win32 = Release|Win32
		Release|x64 = Release|x64
		ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
		ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
		ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
	EndGlobalSection
	GlobalSection(ProjectConfigurationPlatforms) = postSolution
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
	EndGlobalSection
	GlobalSection(SolutionProperties) = preSolution
		HideSolutionNode = FALSE
	EndGlobalSection
EndGlobal

Deleted compat/zlib/contrib/vstudio/vc12/zlibvc.vcxproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
686
687
688
689
690
691
692




















































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="12.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{8FD826F8-3739-44E6-8CC8-997122E53B8D}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
    <CharacterSet>Unicode</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v120</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">zlibwapi</TargetName>
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <ImageHasSafeExceptionHandlers>false</ImageHasSafeExceptionHandlers>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\contrib\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\minizip\iowin32.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\minizip\zip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <ItemGroup>
    <ClInclude Include="..\..\..\deflate.h" />
    <ClInclude Include="..\..\..\infblock.h" />
    <ClInclude Include="..\..\..\infcodes.h" />
    <ClInclude Include="..\..\..\inffast.h" />
    <ClInclude Include="..\..\..\inftrees.h" />
    <ClInclude Include="..\..\..\infutil.h" />
    <ClInclude Include="..\..\..\zconf.h" />
    <ClInclude Include="..\..\..\zlib.h" />
    <ClInclude Include="..\..\..\zutil.h" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc14/miniunz.vcxproj.

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




























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="14.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694382A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\MiniUnzip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)miniunz.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)miniunz.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\miniunz.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc14/minizip.vcxproj.

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

























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="14.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\MiniZip$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\$(Configuration)\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)minizip.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)minizip.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\minizip\minizip.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc14/testzlib.vcxproj.

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
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














































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="14.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}</ProjectGuid>
    <RootNamespace>testzlib</RootNamespace>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlib$(Configuration)\Tmp\</IntDir>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlib$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
      <ImageHasSafeExceptionHandlers>false</ImageHasSafeExceptionHandlers>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerOutput>AssemblyAndSourceCode</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <ClCompile>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
    </ClCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <OutputFile>$(OutDir)testzlib.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\testzlib\testzlib.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc14/testzlibdll.vcxproj.

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




























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="14.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{C52F9E7B-498A-42BE-8DB4-85A15694366A}</ProjectGuid>
    <Keyword>Win32Proj</Keyword>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>Unicode</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>Application</ConfigurationType>
    <CharacterSet>MultiByte</CharacterSet>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\TestZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x86\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <TargetMachine>MachineX86</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MinimalRebuild>true</MinimalRebuild>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllDebug\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)testzlib.pdb</ProgramDatabaseFile>
      <SubSystem>Console</SubSystem>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>x64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>MaxSpeed</Optimization>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <OmitFramePointers>true</OmitFramePointers>
      <AdditionalIncludeDirectories>..\..\..;..\..\minizip;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <BasicRuntimeChecks>Default</BasicRuntimeChecks>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeader>
      </PrecompiledHeader>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <WarningLevel>Level3</WarningLevel>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <Link>
      <AdditionalDependencies>ia64\ZlibDllRelease\zlibwapi.lib;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)testzlibdll.exe</OutputFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <SubSystem>Console</SubSystem>
      <OptimizeReferences>true</OptimizeReferences>
      <EnableCOMDATFolding>true</EnableCOMDATFolding>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\testzlib\testzlib.c" />
  </ItemGroup>
  <ItemGroup>
    <ProjectReference Include="zlibvc.vcxproj">
      <Project>{8fd826f8-3739-44e6-8cc8-997122e53b8d}</Project>
    </ProjectReference>
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc14/zlib.rc.

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
































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <windows.h>

#define IDR_VERSION1  1
IDR_VERSION1	VERSIONINFO	MOVEABLE IMPURE LOADONCALL DISCARDABLE
  FILEVERSION	 1, 2, 11, 0
  PRODUCTVERSION 1, 2, 11, 0
  FILEFLAGSMASK	VS_FFI_FILEFLAGSMASK
  FILEFLAGS	0
  FILEOS	VOS_DOS_WINDOWS32
  FILETYPE	VFT_DLL
  FILESUBTYPE	0	// not used
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904E4"
    //language ID = U.S. English, char set = Windows, Multilingual

    BEGIN
      VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
      VALUE "FileVersion",	"1.2.11\0"
      VALUE "InternalName",	"zlib\0"
      VALUE "OriginalFilename",	"zlibwapi.dll\0"
      VALUE "ProductName",	"ZLib.DLL\0"
      VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
      VALUE "LegalCopyright", "(C) 1995-2017 Jean-loup Gailly & Mark Adler\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x0409, 1252
  END
END

Deleted compat/zlib/contrib/vstudio/vc14/zlibstat.vcxproj.

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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467



















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="14.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
    <CharacterSet>Unicode</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>StaticLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibStat$(Configuration)\Tmp\</IntDir>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:X86 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>OldStyle</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <TargetEnvironment>X64</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:AMD64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <TargetEnvironment>Itanium</TargetEnvironment>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibstat.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Lib>
      <AdditionalOptions>/MACHINE:IA64 /NODEFAULTLIB %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibstat.lib</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </Lib>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c" />
    <ClCompile Include="..\..\minizip\zip.c" />
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc14/zlibvc.def.

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

























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
LIBRARY
; zlib data compression and ZIP file I/O library

VERSION		1.2

EXPORTS
        adler32                                  @1
        compress                                 @2
        crc32                                    @3
        deflate                                  @4
        deflateCopy                              @5
        deflateEnd                               @6
        deflateInit2_                            @7
        deflateInit_                             @8
        deflateParams                            @9
        deflateReset                             @10
        deflateSetDictionary                     @11
        gzclose                                  @12
        gzdopen                                  @13
        gzerror                                  @14
        gzflush                                  @15
        gzopen                                   @16
        gzread                                   @17
        gzwrite                                  @18
        inflate                                  @19
        inflateEnd                               @20
        inflateInit2_                            @21
        inflateInit_                             @22
        inflateReset                             @23
        inflateSetDictionary                     @24
        inflateSync                              @25
        uncompress                               @26
        zlibVersion                              @27
        gzprintf                                 @28
        gzputc                                   @29
        gzgetc                                   @30
        gzseek                                   @31
        gzrewind                                 @32
        gztell                                   @33
        gzeof                                    @34
        gzsetparams                              @35
        zError                                   @36
        inflateSyncPoint                         @37
        get_crc_table                            @38
        compress2                                @39
        gzputs                                   @40
        gzgets                                   @41
        inflateCopy                              @42
        inflateBackInit_                         @43
        inflateBack                              @44
        inflateBackEnd                           @45
        compressBound                            @46
        deflateBound                             @47
        gzclearerr                               @48
        gzungetc                                 @49
        zlibCompileFlags                         @50
        deflatePrime                             @51
        deflatePending                           @52

        unzOpen                                  @61
        unzClose                                 @62
        unzGetGlobalInfo                         @63
        unzGetCurrentFileInfo                    @64
        unzGoToFirstFile                         @65
        unzGoToNextFile                          @66
        unzOpenCurrentFile                       @67
        unzReadCurrentFile                       @68
        unzOpenCurrentFile3                      @69
        unztell                                  @70
        unzeof                                   @71
        unzCloseCurrentFile                      @72
        unzGetGlobalComment                      @73
        unzStringFileNameCompare                 @74
        unzLocateFile                            @75
        unzGetLocalExtrafield                    @76
        unzOpen2                                 @77
        unzOpenCurrentFile2                      @78
        unzOpenCurrentFilePassword               @79

        zipOpen                                  @80
        zipOpenNewFileInZip                      @81
        zipWriteInFileInZip                      @82
        zipCloseFileInZip                        @83
        zipClose                                 @84
        zipOpenNewFileInZip2                     @86
        zipCloseFileInZipRaw                     @87
        zipOpen2                                 @88
        zipOpenNewFileInZip3                     @89

        unzGetFilePos                            @100
        unzGoToFilePos                           @101

        fill_win32_filefunc                      @110

; zlibwapi v1.2.4 added:
        fill_win32_filefunc64                   @111
        fill_win32_filefunc64A                  @112
        fill_win32_filefunc64W                  @113

        unzOpen64                               @120
        unzOpen2_64                             @121
        unzGetGlobalInfo64                      @122
        unzGetCurrentFileInfo64                 @124
        unzGetCurrentFileZStreamPos64           @125
        unztell64                               @126
        unzGetFilePos64                         @127
        unzGoToFilePos64                        @128

        zipOpen64                               @130
        zipOpen2_64                             @131
        zipOpenNewFileInZip64                   @132
        zipOpenNewFileInZip2_64                 @133
        zipOpenNewFileInZip3_64                 @134
        zipOpenNewFileInZip4_64                 @135
        zipCloseFileInZipRaw64                  @136

; zlib1 v1.2.4 added:
        adler32_combine                         @140
        crc32_combine                           @142
        deflateSetHeader                        @144
        deflateTune                             @145
        gzbuffer                                @146
        gzclose_r                               @147
        gzclose_w                               @148
        gzdirect                                @149
        gzoffset                                @150
        inflateGetHeader                        @156
        inflateMark                             @157
        inflatePrime                            @158
        inflateReset2                           @159
        inflateUndermine                        @160

; zlib1 v1.2.6 added:
        gzgetc_                                 @161
        inflateResetKeep                        @163
        deflateResetKeep                        @164

; zlib1 v1.2.7 added:
        gzopen_w                                @165

; zlib1 v1.2.8 added:
        inflateGetDictionary                    @166
        gzvprintf                               @167

; zlib1 v1.2.9 added:
        inflateCodesUsed                        @168
        inflateValidate                         @169
        uncompress2                             @170
        gzfread                                 @171
        gzfwrite                                @172
        deflateGetDictionary                    @173
        adler32_z                               @174
        crc32_z                                 @175

Deleted compat/zlib/contrib/vstudio/vc14/zlibvc.sln.

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























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio 14
VisualStudioVersion = 14.0.25420.1
MinimumVisualStudioVersion = 10.0.40219.1
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcxproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcxproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcxproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlibdll", "testzlibdll.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcxproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcxproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
EndProject
Global
	GlobalSection(SolutionConfigurationPlatforms) = preSolution
		Debug|Itanium = Debug|Itanium
		Debug|Win32 = Debug|Win32
		Debug|x64 = Debug|x64
		Release|Itanium = Release|Itanium
		Release|Win32 = Release|Win32
		Release|x64 = Release|x64
		ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
		ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
		ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
	EndGlobalSection
	GlobalSection(ProjectConfigurationPlatforms) = postSolution
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
	EndGlobalSection
	GlobalSection(SolutionProperties) = preSolution
		HideSolutionNode = FALSE
	EndGlobalSection
EndGlobal

Deleted compat/zlib/contrib/vstudio/vc14/zlibvc.vcxproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
686
687
688
689
690
691
692




















































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="utf-8"?>
<Project DefaultTargets="Build" ToolsVersion="14.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  <ItemGroup Label="ProjectConfigurations">
    <ProjectConfiguration Include="Debug|Itanium">
      <Configuration>Debug</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|Win32">
      <Configuration>Debug</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Debug|x64">
      <Configuration>Debug</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Itanium">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|Win32">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="ReleaseWithoutAsm|x64">
      <Configuration>ReleaseWithoutAsm</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Itanium">
      <Configuration>Release</Configuration>
      <Platform>Itanium</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|Win32">
      <Configuration>Release</Configuration>
      <Platform>Win32</Platform>
    </ProjectConfiguration>
    <ProjectConfiguration Include="Release|x64">
      <Configuration>Release</Configuration>
      <Platform>x64</Platform>
    </ProjectConfiguration>
  </ItemGroup>
  <PropertyGroup Label="Globals">
    <ProjectGuid>{8FD826F8-3739-44E6-8CC8-997122E53B8D}</ProjectGuid>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.Default.props" />
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
    <CharacterSet>Unicode</CharacterSet>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <WholeProgramOptimization>true</WholeProgramOptimization>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <PropertyGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="Configuration">
    <ConfigurationType>DynamicLibrary</ConfigurationType>
    <UseOfMfc>false</UseOfMfc>
    <PlatformToolset>v140</PlatformToolset>
  </PropertyGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.props" />
  <ImportGroup Label="ExtensionSettings">
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <ImportGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" Label="PropertySheets">
    <Import Project="$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props" Condition="exists('$(UserRootDir)\Microsoft.Cpp.$(Platform).user.props')" Label="LocalAppDataPlatform" />
  </ImportGroup>
  <PropertyGroup Label="UserMacros" />
  <PropertyGroup>
    <_ProjectFileVersion>10.0.30128.1</_ProjectFileVersion>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">x86\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|x64'">x64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|x64'">false</GenerateManifest>
    <OutDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\</OutDir>
    <IntDir Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ia64\ZlibDll$(Configuration)\Tmp\</IntDir>
    <LinkIncremental Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</LinkIncremental>
    <GenerateManifest Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">false</GenerateManifest>
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Debug|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|Win32'" />
    <CodeAnalysisRuleSet Condition="'$(Configuration)|$(Platform)'=='Release|x64'">AllRules.ruleset</CodeAnalysisRuleSet>
    <CodeAnalysisRules Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <CodeAnalysisRuleAssemblies Condition="'$(Configuration)|$(Platform)'=='Release|x64'" />
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">zlibwapi</TargetName>
    <TargetName Condition="'$(Configuration)|$(Platform)'=='Release|x64'">zlibwapi</TargetName>
  </PropertyGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Win32</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreaded</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalOptions>/MACHINE:I386 %(AdditionalOptions)</AdditionalOptions>
      <AdditionalDependencies>..\..\masmx86\match686.obj;..\..\masmx86\inffas32.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <RandomizedBaseAddress>false</RandomizedBaseAddress>
      <DataExecutionPrevention>
      </DataExecutionPrevention>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <ImageHasSafeExceptionHandlers>false</ImageHasSafeExceptionHandlers>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx86
bld_ml32.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|x64'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\contrib\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">
    <Midl>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <Optimization>Disabled</Optimization>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDebugDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <DebugInformationFormat>ProgramDatabase</DebugInformationFormat>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>_DEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <GenerateDebugInformation>true</GenerateDebugInformation>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|x64'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>X64</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <AdditionalDependencies>..\..\masmx64\gvmat64.obj;..\..\masmx64\inffasx64.obj;%(AdditionalDependencies)</AdditionalDependencies>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineX64</TargetMachine>
    </Link>
    <PreBuildEvent>
      <Command>cd ..\..\masmx64
bld_ml64.bat</Command>
    </PreBuildEvent>
  </ItemDefinitionGroup>
  <ItemDefinitionGroup Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">
    <Midl>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <MkTypLibCompatible>true</MkTypLibCompatible>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <TargetEnvironment>Itanium</TargetEnvironment>
      <TypeLibraryName>$(OutDir)zlibvc.tlb</TypeLibraryName>
    </Midl>
    <ClCompile>
      <InlineFunctionExpansion>OnlyExplicitInline</InlineFunctionExpansion>
      <AdditionalIncludeDirectories>..\..\..;..\..\masmx86;%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions>_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <StringPooling>true</StringPooling>
      <ExceptionHandling>
      </ExceptionHandling>
      <RuntimeLibrary>MultiThreadedDLL</RuntimeLibrary>
      <BufferSecurityCheck>false</BufferSecurityCheck>
      <FunctionLevelLinking>true</FunctionLevelLinking>
      <PrecompiledHeaderOutputFile>$(IntDir)zlibvc.pch</PrecompiledHeaderOutputFile>
      <AssemblerOutput>All</AssemblerOutput>
      <AssemblerListingLocation>$(IntDir)</AssemblerListingLocation>
      <ObjectFileName>$(IntDir)</ObjectFileName>
      <ProgramDataBaseFileName>$(OutDir)</ProgramDataBaseFileName>
      <BrowseInformation>
      </BrowseInformation>
      <WarningLevel>Level3</WarningLevel>
      <SuppressStartupBanner>true</SuppressStartupBanner>
    </ClCompile>
    <ResourceCompile>
      <PreprocessorDefinitions>NDEBUG;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <Culture>0x040c</Culture>
    </ResourceCompile>
    <Link>
      <OutputFile>$(OutDir)zlibwapi.dll</OutputFile>
      <SuppressStartupBanner>true</SuppressStartupBanner>
      <IgnoreAllDefaultLibraries>false</IgnoreAllDefaultLibraries>
      <ModuleDefinitionFile>.\zlibvc.def</ModuleDefinitionFile>
      <ProgramDatabaseFile>$(OutDir)zlibwapi.pdb</ProgramDatabaseFile>
      <GenerateMapFile>true</GenerateMapFile>
      <MapFileName>$(OutDir)zlibwapi.map</MapFileName>
      <SubSystem>Windows</SubSystem>
      <ImportLibrary>$(OutDir)zlibwapi.lib</ImportLibrary>
      <TargetMachine>MachineIA64</TargetMachine>
    </Link>
  </ItemDefinitionGroup>
  <ItemGroup>
    <ClCompile Include="..\..\..\adler32.c" />
    <ClCompile Include="..\..\..\compress.c" />
    <ClCompile Include="..\..\..\crc32.c" />
    <ClCompile Include="..\..\..\deflate.c" />
    <ClCompile Include="..\..\..\gzclose.c" />
    <ClCompile Include="..\..\..\gzlib.c" />
    <ClCompile Include="..\..\..\gzread.c" />
    <ClCompile Include="..\..\..\gzwrite.c" />
    <ClCompile Include="..\..\..\infback.c" />
    <ClCompile Include="..\..\masmx64\inffas8664.c">
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Debug|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='ReleaseWithoutAsm|Win32'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">true</ExcludedFromBuild>
      <ExcludedFromBuild Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">true</ExcludedFromBuild>
    </ClCompile>
    <ClCompile Include="..\..\..\inffast.c" />
    <ClCompile Include="..\..\..\inflate.c" />
    <ClCompile Include="..\..\..\inftrees.c" />
    <ClCompile Include="..\..\minizip\ioapi.c" />
    <ClCompile Include="..\..\minizip\iowin32.c" />
    <ClCompile Include="..\..\..\trees.c" />
    <ClCompile Include="..\..\..\uncompr.c" />
    <ClCompile Include="..\..\minizip\unzip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\minizip\zip.c">
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Itanium'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|Win32'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
      <AdditionalIncludeDirectories Condition="'$(Configuration)|$(Platform)'=='Release|x64'">%(AdditionalIncludeDirectories)</AdditionalIncludeDirectories>
      <PreprocessorDefinitions Condition="'$(Configuration)|$(Platform)'=='Release|x64'">ZLIB_INTERNAL;%(PreprocessorDefinitions)</PreprocessorDefinitions>
    </ClCompile>
    <ClCompile Include="..\..\..\zutil.c" />
  </ItemGroup>
  <ItemGroup>
    <ResourceCompile Include="zlib.rc" />
  </ItemGroup>
  <ItemGroup>
    <None Include="zlibvc.def" />
  </ItemGroup>
  <ItemGroup>
    <ClInclude Include="..\..\..\deflate.h" />
    <ClInclude Include="..\..\..\infblock.h" />
    <ClInclude Include="..\..\..\infcodes.h" />
    <ClInclude Include="..\..\..\inffast.h" />
    <ClInclude Include="..\..\..\inftrees.h" />
    <ClInclude Include="..\..\..\infutil.h" />
    <ClInclude Include="..\..\..\zconf.h" />
    <ClInclude Include="..\..\..\zlib.h" />
    <ClInclude Include="..\..\..\zutil.h" />
  </ItemGroup>
  <Import Project="$(VCTargetsPath)\Microsoft.Cpp.targets" />
  <ImportGroup Label="ExtensionTargets">
  </ImportGroup>
</Project>

Deleted compat/zlib/contrib/vstudio/vc9/miniunz.vcproj.

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
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
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
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





















































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9.00"
	Name="miniunz"
	ProjectGUID="{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
	Keyword="Win32Proj"
	TargetFrameworkVersion="131072"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
		<Platform
			Name="Itanium"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="x86\MiniUnzip$(ConfigurationName)"
			IntermediateDirectory="x86\MiniUnzip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="1"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="4"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x86\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/miniunz.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/miniunz.pdb"
				SubSystem="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="x86\MiniUnzip$(ConfigurationName)"
			IntermediateDirectory="x86\MiniUnzip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x86\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/miniunz.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="x64\MiniUnzip$(ConfigurationName)"
			IntermediateDirectory="x64\MiniUnzip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x64\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/miniunz.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/miniunz.pdb"
				SubSystem="1"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|Itanium"
			OutputDirectory="ia64\MiniUnzip$(ConfigurationName)"
			IntermediateDirectory="ia64\MiniUnzip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="ia64\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/miniunz.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/miniunz.pdb"
				SubSystem="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="x64\MiniUnzip$(ConfigurationName)"
			IntermediateDirectory="x64\MiniUnzip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x64\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/miniunz.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Itanium"
			OutputDirectory="ia64\MiniUnzip$(ConfigurationName)"
			IntermediateDirectory="ia64\MiniUnzip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="ia64\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/miniunz.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<Filter
			Name="Source Files"
			Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
			>
			<File
				RelativePath="..\..\minizip\miniunz.c"
				>
			</File>
		</Filter>
		<Filter
			Name="Header Files"
			Filter="h;hpp;hxx;hm;inl;inc"
			>
		</Filter>
		<Filter
			Name="Resource Files"
			Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
			>
		</Filter>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>

Deleted compat/zlib/contrib/vstudio/vc9/minizip.vcproj.

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
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
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
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


















































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9.00"
	Name="minizip"
	ProjectGUID="{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
	Keyword="Win32Proj"
	TargetFrameworkVersion="131072"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
		<Platform
			Name="Itanium"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="x86\MiniZip$(ConfigurationName)"
			IntermediateDirectory="x86\MiniZip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="1"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="4"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x86\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/minizip.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/minizip.pdb"
				SubSystem="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="x86\MiniZip$(ConfigurationName)"
			IntermediateDirectory="x86\MiniZip$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x86\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/minizip.exe"
				LinkIncremental="1"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="x64\$(ConfigurationName)"
			IntermediateDirectory="x64\$(ConfigurationName)"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x64\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/minizip.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/minizip.pdb"
				SubSystem="1"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|Itanium"
			OutputDirectory="ia64\$(ConfigurationName)"
			IntermediateDirectory="ia64\$(ConfigurationName)"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="ia64\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/minizip.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/minizip.pdb"
				SubSystem="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="x64\$(ConfigurationName)"
			IntermediateDirectory="x64\$(ConfigurationName)"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x64\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/minizip.exe"
				LinkIncremental="1"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Itanium"
			OutputDirectory="ia64\$(ConfigurationName)"
			IntermediateDirectory="ia64\$(ConfigurationName)"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="ia64\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/minizip.exe"
				LinkIncremental="1"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<Filter
			Name="Source Files"
			Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
			>
			<File
				RelativePath="..\..\minizip\minizip.c"
				>
			</File>
		</Filter>
		<Filter
			Name="Header Files"
			Filter="h;hpp;hxx;hm;inl;inc"
			>
		</Filter>
		<Filter
			Name="Resource Files"
			Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
			>
		</Filter>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>

Deleted compat/zlib/contrib/vstudio/vc9/testzlib.vcproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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




















































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9,00"
	Name="testzlib"
	ProjectGUID="{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
	RootNamespace="testzlib"
	Keyword="Win32Proj"
	TargetFrameworkVersion="131072"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
		<Platform
			Name="Itanium"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="x86\TestZlib$(ConfigurationName)"
			IntermediateDirectory="x86\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="1"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerOutput="4"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="4"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="..\..\masmx86\match686.obj ..\..\masmx86\inffas32.obj"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
				SubSystem="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="x64\TestZlib$(ConfigurationName)"
			IntermediateDirectory="x64\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				AssemblerListingLocation="$(IntDir)\"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj"
				GenerateManifest="false"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|Itanium"
			OutputDirectory="ia64\TestZlib$(ConfigurationName)"
			IntermediateDirectory="ia64\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="ZLIB_WINAPI;_DEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerOutput="4"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
				SubSystem="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|Win32"
			OutputDirectory="x86\TestZlib$(ConfigurationName)"
			IntermediateDirectory="x86\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			CharacterSet="2"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|x64"
			OutputDirectory="x64\TestZlib$(ConfigurationName)"
			IntermediateDirectory="x64\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				AssemblerListingLocation="$(IntDir)\"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies=""
				GenerateManifest="false"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|Itanium"
			OutputDirectory="ia64\TestZlib$(ConfigurationName)"
			IntermediateDirectory="ia64\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			CharacterSet="2"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="x86\TestZlib$(ConfigurationName)"
			IntermediateDirectory="x86\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			CharacterSet="2"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="..\..\masmx86\match686.obj ..\..\masmx86\inffas32.obj"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="x64\TestZlib$(ConfigurationName)"
			IntermediateDirectory="x64\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="ASMV;ASMINF;WIN32;ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				BasicRuntimeChecks="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				AssemblerListingLocation="$(IntDir)\"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj"
				GenerateManifest="false"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Itanium"
			OutputDirectory="ia64\TestZlib$(ConfigurationName)"
			IntermediateDirectory="ia64\TestZlib$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			CharacterSet="2"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\.."
				PreprocessorDefinitions="ZLIB_WINAPI;NDEBUG;_CONSOLE;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<Filter
			Name="Source Files"
			Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
			>
			<File
				RelativePath="..\..\..\adler32.c"
				>
			</File>
			<File
				RelativePath="..\..\..\compress.c"
				>
			</File>
			<File
				RelativePath="..\..\..\crc32.c"
				>
			</File>
			<File
				RelativePath="..\..\..\deflate.c"
				>
			</File>
			<File
				RelativePath="..\..\..\infback.c"
				>
			</File>
			<File
				RelativePath="..\..\masmx64\inffas8664.c"
				>
				<FileConfiguration
					Name="Debug|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Debug|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="ReleaseWithoutAsm|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="ReleaseWithoutAsm|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
			</File>
			<File
				RelativePath="..\..\..\inffast.c"
				>
			</File>
			<File
				RelativePath="..\..\..\inflate.c"
				>
			</File>
			<File
				RelativePath="..\..\..\inftrees.c"
				>
			</File>
			<File
				RelativePath="..\..\testzlib\testzlib.c"
				>
			</File>
			<File
				RelativePath="..\..\..\trees.c"
				>
			</File>
			<File
				RelativePath="..\..\..\uncompr.c"
				>
			</File>
			<File
				RelativePath="..\..\..\zutil.c"
				>
			</File>
		</Filter>
		<Filter
			Name="Header Files"
			Filter="h;hpp;hxx;hm;inl;inc"
			>
		</Filter>
		<Filter
			Name="Resource Files"
			Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
			>
		</Filter>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>

Deleted compat/zlib/contrib/vstudio/vc9/testzlibdll.vcproj.

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
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
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
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





















































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9.00"
	Name="TestZlibDll"
	ProjectGUID="{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
	Keyword="Win32Proj"
	TargetFrameworkVersion="131072"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
		<Platform
			Name="Itanium"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="x86\TestZlibDll$(ConfigurationName)"
			IntermediateDirectory="x86\TestZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="1"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="4"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x86\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
				SubSystem="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="x86\TestZlibDll$(ConfigurationName)"
			IntermediateDirectory="x86\TestZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x86\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				TargetMachine="1"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="x64\TestZlibDll$(ConfigurationName)"
			IntermediateDirectory="x64\TestZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x64\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
				SubSystem="1"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|Itanium"
			OutputDirectory="ia64\TestZlibDll$(ConfigurationName)"
			IntermediateDirectory="ia64\TestZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;_DEBUG;_CONSOLE;WIN64"
				MinimalRebuild="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="ia64\ZlibDllDebug\zlibwapi.lib"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="2"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/testzlib.pdb"
				SubSystem="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="x64\TestZlibDll$(ConfigurationName)"
			IntermediateDirectory="x64\TestZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="x64\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Itanium"
			OutputDirectory="ia64\TestZlibDll$(ConfigurationName)"
			IntermediateDirectory="ia64\TestZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="1"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			CharacterSet="2"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				OmitFramePointers="true"
				AdditionalIncludeDirectories="..\..\..;..\..\minizip"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;ZLIB_WINAPI;NDEBUG;_CONSOLE;WIN64"
				StringPooling="true"
				BasicRuntimeChecks="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				UsePrecompiledHeader="0"
				AssemblerListingLocation="$(IntDir)\"
				WarningLevel="3"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="ia64\ZlibDllRelease\zlibwapi.lib"
				OutputFile="$(OutDir)/testzlib.exe"
				LinkIncremental="1"
				GenerateManifest="false"
				GenerateDebugInformation="true"
				SubSystem="1"
				OptimizeReferences="2"
				EnableCOMDATFolding="2"
				OptimizeForWindows98="1"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCWebDeploymentTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<Filter
			Name="Source Files"
			Filter="cpp;c;cxx;def;odl;idl;hpj;bat;asm"
			>
			<File
				RelativePath="..\..\testzlib\testzlib.c"
				>
			</File>
		</Filter>
		<Filter
			Name="Header Files"
			Filter="h;hpp;hxx;hm;inl;inc"
			>
		</Filter>
		<Filter
			Name="Resource Files"
			Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe"
			>
		</Filter>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>

Deleted compat/zlib/contrib/vstudio/vc9/zlib.rc.

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
































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <windows.h>

#define IDR_VERSION1  1
IDR_VERSION1	VERSIONINFO	MOVEABLE IMPURE LOADONCALL DISCARDABLE
  FILEVERSION	 1, 2, 11, 0
  PRODUCTVERSION 1, 2, 11, 0
  FILEFLAGSMASK	VS_FFI_FILEFLAGSMASK
  FILEFLAGS	0
  FILEOS	VOS_DOS_WINDOWS32
  FILETYPE	VFT_DLL
  FILESUBTYPE	0	// not used
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904E4"
    //language ID = U.S. English, char set = Windows, Multilingual

    BEGIN
      VALUE "FileDescription", "zlib data compression and ZIP file I/O library\0"
      VALUE "FileVersion",	"1.2.11\0"
      VALUE "InternalName",	"zlib\0"
      VALUE "OriginalFilename",	"zlibwapi.dll\0"
      VALUE "ProductName",	"ZLib.DLL\0"
      VALUE "Comments","DLL support by Alessandro Iacopetti & Gilles Vollant\0"
      VALUE "LegalCopyright", "(C) 1995-2017 Jean-loup Gailly & Mark Adler\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x0409, 1252
  END
END

Deleted compat/zlib/contrib/vstudio/vc9/zlibstat.vcproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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



































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9,00"
	Name="zlibstat"
	ProjectGUID="{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
	TargetFrameworkVersion="131072"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
		<Platform
			Name="Itanium"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="x86\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="x86\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				ExceptionHandling="0"
				RuntimeLibrary="1"
				BufferSecurityCheck="false"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="1"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:X86 /NODEFAULTLIB"
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="x64\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="x64\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				ExceptionHandling="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="1"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:AMD64 /NODEFAULTLIB"
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|Itanium"
			OutputDirectory="ia64\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="ia64\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				ExceptionHandling="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
				Detect64BitPortabilityProblems="true"
				DebugInformationFormat="1"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:IA64 /NODEFAULTLIB"
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="x86\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="x86\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:X86 /NODEFAULTLIB"
				AdditionalDependencies="..\..\masmx86\match686.obj ..\..\masmx86\inffas32.obj "
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="x64\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="x64\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ASMV;ASMINF;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:AMD64 /NODEFAULTLIB"
				AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj "
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Itanium"
			OutputDirectory="ia64\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="ia64\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:IA64 /NODEFAULTLIB"
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|Win32"
			OutputDirectory="x86\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="x86\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:X86 /NODEFAULTLIB"
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|x64"
			OutputDirectory="x64\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="x64\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:AMD64 /NODEFAULTLIB"
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|Itanium"
			OutputDirectory="ia64\ZlibStat$(ConfigurationName)"
			IntermediateDirectory="ia64\ZlibStat$(ConfigurationName)\Tmp"
			ConfigurationType="4"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="2"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="ZLIB_WINAPI;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibstat.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				AdditionalOptions="/MACHINE:IA64 /NODEFAULTLIB"
				OutputFile="$(OutDir)\zlibstat.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<Filter
			Name="Source Files"
			>
			<File
				RelativePath="..\..\..\adler32.c"
				>
			</File>
			<File
				RelativePath="..\..\..\compress.c"
				>
			</File>
			<File
				RelativePath="..\..\..\crc32.c"
				>
			</File>
			<File
				RelativePath="..\..\..\deflate.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzclose.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzguts.h"
				>
			</File>
			<File
				RelativePath="..\..\..\gzlib.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzread.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzwrite.c"
				>
			</File>
			<File
				RelativePath="..\..\..\infback.c"
				>
			</File>
			<File
				RelativePath="..\..\masmx64\inffas8664.c"
				>
				<FileConfiguration
					Name="Debug|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Debug|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="ReleaseWithoutAsm|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="ReleaseWithoutAsm|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
			</File>
			<File
				RelativePath="..\..\..\inffast.c"
				>
			</File>
			<File
				RelativePath="..\..\..\inflate.c"
				>
			</File>
			<File
				RelativePath="..\..\..\inftrees.c"
				>
			</File>
			<File
				RelativePath="..\..\minizip\ioapi.c"
				>
			</File>
			<File
				RelativePath="..\..\..\trees.c"
				>
			</File>
			<File
				RelativePath="..\..\..\uncompr.c"
				>
			</File>
			<File
				RelativePath="..\..\minizip\unzip.c"
				>
			</File>
			<File
				RelativePath="..\..\minizip\zip.c"
				>
			</File>
			<File
				RelativePath=".\zlib.rc"
				>
			</File>
			<File
				RelativePath=".\zlibvc.def"
				>
			</File>
			<File
				RelativePath="..\..\..\zutil.c"
				>
			</File>
		</Filter>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>

Deleted compat/zlib/contrib/vstudio/vc9/zlibvc.def.

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

























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
LIBRARY
; zlib data compression and ZIP file I/O library

VERSION		1.2

EXPORTS
        adler32                                  @1
        compress                                 @2
        crc32                                    @3
        deflate                                  @4
        deflateCopy                              @5
        deflateEnd                               @6
        deflateInit2_                            @7
        deflateInit_                             @8
        deflateParams                            @9
        deflateReset                             @10
        deflateSetDictionary                     @11
        gzclose                                  @12
        gzdopen                                  @13
        gzerror                                  @14
        gzflush                                  @15
        gzopen                                   @16
        gzread                                   @17
        gzwrite                                  @18
        inflate                                  @19
        inflateEnd                               @20
        inflateInit2_                            @21
        inflateInit_                             @22
        inflateReset                             @23
        inflateSetDictionary                     @24
        inflateSync                              @25
        uncompress                               @26
        zlibVersion                              @27
        gzprintf                                 @28
        gzputc                                   @29
        gzgetc                                   @30
        gzseek                                   @31
        gzrewind                                 @32
        gztell                                   @33
        gzeof                                    @34
        gzsetparams                              @35
        zError                                   @36
        inflateSyncPoint                         @37
        get_crc_table                            @38
        compress2                                @39
        gzputs                                   @40
        gzgets                                   @41
        inflateCopy                              @42
        inflateBackInit_                         @43
        inflateBack                              @44
        inflateBackEnd                           @45
        compressBound                            @46
        deflateBound                             @47
        gzclearerr                               @48
        gzungetc                                 @49
        zlibCompileFlags                         @50
        deflatePrime                             @51
        deflatePending                           @52

        unzOpen                                  @61
        unzClose                                 @62
        unzGetGlobalInfo                         @63
        unzGetCurrentFileInfo                    @64
        unzGoToFirstFile                         @65
        unzGoToNextFile                          @66
        unzOpenCurrentFile                       @67
        unzReadCurrentFile                       @68
        unzOpenCurrentFile3                      @69
        unztell                                  @70
        unzeof                                   @71
        unzCloseCurrentFile                      @72
        unzGetGlobalComment                      @73
        unzStringFileNameCompare                 @74
        unzLocateFile                            @75
        unzGetLocalExtrafield                    @76
        unzOpen2                                 @77
        unzOpenCurrentFile2                      @78
        unzOpenCurrentFilePassword               @79

        zipOpen                                  @80
        zipOpenNewFileInZip                      @81
        zipWriteInFileInZip                      @82
        zipCloseFileInZip                        @83
        zipClose                                 @84
        zipOpenNewFileInZip2                     @86
        zipCloseFileInZipRaw                     @87
        zipOpen2                                 @88
        zipOpenNewFileInZip3                     @89

        unzGetFilePos                            @100
        unzGoToFilePos                           @101

        fill_win32_filefunc                      @110

; zlibwapi v1.2.4 added:
        fill_win32_filefunc64                   @111
        fill_win32_filefunc64A                  @112
        fill_win32_filefunc64W                  @113

        unzOpen64                               @120
        unzOpen2_64                             @121
        unzGetGlobalInfo64                      @122
        unzGetCurrentFileInfo64                 @124
        unzGetCurrentFileZStreamPos64           @125
        unztell64                               @126
        unzGetFilePos64                         @127
        unzGoToFilePos64                        @128

        zipOpen64                               @130
        zipOpen2_64                             @131
        zipOpenNewFileInZip64                   @132
        zipOpenNewFileInZip2_64                 @133
        zipOpenNewFileInZip3_64                 @134
        zipOpenNewFileInZip4_64                 @135
        zipCloseFileInZipRaw64                  @136

; zlib1 v1.2.4 added:
        adler32_combine                         @140
        crc32_combine                           @142
        deflateSetHeader                        @144
        deflateTune                             @145
        gzbuffer                                @146
        gzclose_r                               @147
        gzclose_w                               @148
        gzdirect                                @149
        gzoffset                                @150
        inflateGetHeader                        @156
        inflateMark                             @157
        inflatePrime                            @158
        inflateReset2                           @159
        inflateUndermine                        @160

; zlib1 v1.2.6 added:
        gzgetc_                                 @161
        inflateResetKeep                        @163
        deflateResetKeep                        @164

; zlib1 v1.2.7 added:
        gzopen_w                                @165

; zlib1 v1.2.8 added:
        inflateGetDictionary                    @166
        gzvprintf                               @167

; zlib1 v1.2.9 added:
        inflateCodesUsed                        @168
        inflateValidate                         @169
        uncompress2                             @170
        gzfread                                 @171
        gzfwrite                                @172
        deflateGetDictionary                    @173
        adler32_z                               @174
        crc32_z                                 @175

Deleted compat/zlib/contrib/vstudio/vc9/zlibvc.sln.

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
















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Microsoft Visual Studio Solution File, Format Version 10.00
# Visual Studio 2008
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibvc", "zlibvc.vcproj", "{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "zlibstat", "zlibstat.vcproj", "{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "testzlib", "testzlib.vcproj", "{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}"
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "TestZlibDll", "testzlibdll.vcproj", "{C52F9E7B-498A-42BE-8DB4-85A15694366A}"
	ProjectSection(ProjectDependencies) = postProject
		{8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D}
	EndProjectSection
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "minizip", "minizip.vcproj", "{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}"
	ProjectSection(ProjectDependencies) = postProject
		{8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D}
	EndProjectSection
EndProject
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "miniunz", "miniunz.vcproj", "{C52F9E7B-498A-42BE-8DB4-85A15694382A}"
	ProjectSection(ProjectDependencies) = postProject
		{8FD826F8-3739-44E6-8CC8-997122E53B8D} = {8FD826F8-3739-44E6-8CC8-997122E53B8D}
	EndProjectSection
EndProject
Global
	GlobalSection(SolutionConfigurationPlatforms) = preSolution
		Debug|Itanium = Debug|Itanium
		Debug|Win32 = Debug|Win32
		Debug|x64 = Debug|x64
		Release|Itanium = Release|Itanium
		Release|Win32 = Release|Win32
		Release|x64 = Release|x64
		ReleaseWithoutAsm|Itanium = ReleaseWithoutAsm|Itanium
		ReleaseWithoutAsm|Win32 = ReleaseWithoutAsm|Win32
		ReleaseWithoutAsm|x64 = ReleaseWithoutAsm|x64
	EndGlobalSection
	GlobalSection(ProjectConfigurationPlatforms) = postSolution
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Itanium.Build.0 = Debug|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.ActiveCfg = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|Win32.Build.0 = Debug|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.ActiveCfg = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Debug|x64.Build.0 = Debug|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.ActiveCfg = Release|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Itanium.Build.0 = Release|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.ActiveCfg = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|Win32.Build.0 = Release|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.ActiveCfg = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.Release|x64.Build.0 = Release|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{8FD826F8-3739-44E6-8CC8-997122E53B8D}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Itanium.Build.0 = Debug|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.ActiveCfg = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|Win32.Build.0 = Debug|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.ActiveCfg = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Debug|x64.Build.0 = Debug|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.ActiveCfg = Release|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Itanium.Build.0 = Release|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.ActiveCfg = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|Win32.Build.0 = Release|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.ActiveCfg = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.Release|x64.Build.0 = Release|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{745DEC58-EBB3-47A9-A9B8-4C6627C01BF8}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = ReleaseWithoutAsm|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = ReleaseWithoutAsm|Itanium
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.Build.0 = ReleaseWithoutAsm|Win32
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = ReleaseWithoutAsm|x64
		{AA6666AA-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.Build.0 = ReleaseWithoutAsm|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Itanium.Build.0 = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694366A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Itanium.Build.0 = Debug|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.ActiveCfg = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|Win32.Build.0 = Debug|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.ActiveCfg = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Debug|x64.Build.0 = Debug|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.ActiveCfg = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Itanium.Build.0 = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|Win32.Build.0 = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.ActiveCfg = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.Release|x64.Build.0 = Release|x64
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{48CDD9DC-E09F-4135-9C0C-4FE50C3C654B}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.ActiveCfg = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Itanium.Build.0 = Debug|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.ActiveCfg = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|Win32.Build.0 = Debug|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.ActiveCfg = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Debug|x64.Build.0 = Debug|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|Win32.Build.0 = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.ActiveCfg = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.Release|x64.Build.0 = Release|x64
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.ActiveCfg = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Itanium.Build.0 = Release|Itanium
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|Win32.ActiveCfg = Release|Win32
		{C52F9E7B-498A-42BE-8DB4-85A15694382A}.ReleaseWithoutAsm|x64.ActiveCfg = Release|x64
	EndGlobalSection
	GlobalSection(SolutionProperties) = preSolution
		HideSolutionNode = FALSE
	EndGlobalSection
EndGlobal

Deleted compat/zlib/contrib/vstudio/vc9/zlibvc.vcproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9,00"
	Name="zlibvc"
	ProjectGUID="{8FD826F8-3739-44E6-8CC8-997122E53B8D}"
	RootNamespace="zlibvc"
	TargetFrameworkVersion="131072"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
		<Platform
			Name="Itanium"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="x86\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="x86\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="_DEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="1"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF"
				ExceptionHandling="0"
				RuntimeLibrary="1"
				BufferSecurityCheck="false"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
				DebugInformationFormat="4"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="_DEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalOptions="/MACHINE:I386"
				AdditionalDependencies="..\..\masmx86\match686.obj ..\..\masmx86\inffas32.obj"
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="2"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				ModuleDefinitionFile=".\zlibvc.def"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="x64\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="x64\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="_DEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="3"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64"
				ExceptionHandling="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="_DEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj "
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="2"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				ModuleDefinitionFile=".\zlibvc.def"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|Itanium"
			OutputDirectory="ia64\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="ia64\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="_DEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="2"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64"
				ExceptionHandling="0"
				RuntimeLibrary="3"
				BufferSecurityCheck="false"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
				DebugInformationFormat="3"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="_DEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="2"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				ModuleDefinitionFile=".\zlibvc.def"
				GenerateDebugInformation="true"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|Win32"
			OutputDirectory="x86\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="x86\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="NDEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="1"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerOutput="2"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalOptions="/MACHINE:I386"
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="1"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				IgnoreAllDefaultLibraries="false"
				ModuleDefinitionFile=".\zlibvc.def"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				OptimizeForWindows98="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|x64"
			OutputDirectory="x64\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="x64\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="NDEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="3"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerOutput="2"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="1"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				IgnoreAllDefaultLibraries="false"
				ModuleDefinitionFile=".\zlibvc.def"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				OptimizeForWindows98="1"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="ReleaseWithoutAsm|Itanium"
			OutputDirectory="ia64\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="ia64\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="NDEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="2"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerOutput="2"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="1"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				IgnoreAllDefaultLibraries="false"
				ModuleDefinitionFile=".\zlibvc.def"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				OptimizeForWindows98="1"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="x86\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="x86\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="NDEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="1"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="WIN32;_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="0"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerOutput="2"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalOptions="/MACHINE:I386"
				AdditionalDependencies="..\..\masmx86\match686.obj ..\..\masmx86\inffas32.obj "
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="1"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				IgnoreAllDefaultLibraries="false"
				ModuleDefinitionFile=".\zlibvc.def"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				OptimizeForWindows98="1"
				RandomizedBaseAddress="1"
				DataExecutionPrevention="0"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="x64\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="x64\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="NDEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="3"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;ASMV;ASMINF;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerOutput="2"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				AdditionalDependencies="..\..\masmx64\gvmat64.obj ..\..\masmx64\inffasx64.obj "
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="1"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				IgnoreAllDefaultLibraries="false"
				ModuleDefinitionFile=".\zlibvc.def"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				OptimizeForWindows98="1"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
				TargetMachine="17"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Itanium"
			OutputDirectory="ia64\ZlibDll$(ConfigurationName)"
			IntermediateDirectory="ia64\ZlibDll$(ConfigurationName)\Tmp"
			ConfigurationType="2"
			InheritedPropertySheets="UpgradeFromVC70.vsprops"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			WholeProgramOptimization="1"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCWebServiceProxyGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				PreprocessorDefinitions="NDEBUG"
				MkTypLibCompatible="true"
				SuppressStartupBanner="true"
				TargetEnvironment="2"
				TypeLibraryName="$(OutDir)/zlibvc.tlb"
			/>
			<Tool
				Name="VCCLCompilerTool"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="..\..\..;..\..\masmx86"
				PreprocessorDefinitions="_CRT_NONSTDC_NO_DEPRECATE;_CRT_SECURE_NO_DEPRECATE;_CRT_NONSTDC_NO_WARNINGS;ZLIB_WINAPI;WIN64"
				StringPooling="true"
				ExceptionHandling="0"
				RuntimeLibrary="2"
				BufferSecurityCheck="false"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)/zlibvc.pch"
				AssemblerOutput="2"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(OutDir)\"
				BrowseInformation="0"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1036"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLinkerTool"
				OutputFile="$(OutDir)\zlibwapi.dll"
				LinkIncremental="1"
				SuppressStartupBanner="true"
				GenerateManifest="false"
				IgnoreAllDefaultLibraries="false"
				ModuleDefinitionFile=".\zlibvc.def"
				ProgramDatabaseFile="$(OutDir)/zlibwapi.pdb"
				GenerateMapFile="true"
				MapFileName="$(OutDir)/zlibwapi.map"
				SubSystem="2"
				OptimizeForWindows98="1"
				ImportLibrary="$(OutDir)/zlibwapi.lib"
				TargetMachine="5"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCManifestTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCAppVerifierTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<Filter
			Name="Source Files"
			Filter="cpp;c;cxx;rc;def;r;odl;hpj;bat;for;f90"
			>
			<File
				RelativePath="..\..\..\adler32.c"
				>
			</File>
			<File
				RelativePath="..\..\..\compress.c"
				>
			</File>
			<File
				RelativePath="..\..\..\crc32.c"
				>
			</File>
			<File
				RelativePath="..\..\..\deflate.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzclose.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzguts.h"
				>
			</File>
			<File
				RelativePath="..\..\..\gzlib.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzread.c"
				>
			</File>
			<File
				RelativePath="..\..\..\gzwrite.c"
				>
			</File>
			<File
				RelativePath="..\..\..\infback.c"
				>
			</File>
			<File
				RelativePath="..\..\masmx64\inffas8664.c"
				>
				<FileConfiguration
					Name="Debug|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Debug|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="ReleaseWithoutAsm|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="ReleaseWithoutAsm|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Win32"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Itanium"
					ExcludedFromBuild="true"
					>
					<Tool
						Name="VCCLCompilerTool"
					/>
				</FileConfiguration>
			</File>
			<File
				RelativePath="..\..\..\inffast.c"
				>
			</File>
			<File
				RelativePath="..\..\..\inflate.c"
				>
			</File>
			<File
				RelativePath="..\..\..\inftrees.c"
				>
			</File>
			<File
				RelativePath="..\..\minizip\ioapi.c"
				>
			</File>
			<File
				RelativePath="..\..\minizip\iowin32.c"
				>
			</File>
			<File
				RelativePath="..\..\..\trees.c"
				>
			</File>
			<File
				RelativePath="..\..\..\uncompr.c"
				>
			</File>
			<File
				RelativePath="..\..\minizip\unzip.c"
				>
				<FileConfiguration
					Name="Release|Win32"
					>
					<Tool
						Name="VCCLCompilerTool"
						AdditionalIncludeDirectories=""
						PreprocessorDefinitions="ZLIB_INTERNAL"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|x64"
					>
					<Tool
						Name="VCCLCompilerTool"
						AdditionalIncludeDirectories=""
						PreprocessorDefinitions="ZLIB_INTERNAL"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Itanium"
					>
					<Tool
						Name="VCCLCompilerTool"
						AdditionalIncludeDirectories=""
						PreprocessorDefinitions="ZLIB_INTERNAL"
					/>
				</FileConfiguration>
			</File>
			<File
				RelativePath="..\..\minizip\zip.c"
				>
				<FileConfiguration
					Name="Release|Win32"
					>
					<Tool
						Name="VCCLCompilerTool"
						AdditionalIncludeDirectories=""
						PreprocessorDefinitions="ZLIB_INTERNAL"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|x64"
					>
					<Tool
						Name="VCCLCompilerTool"
						AdditionalIncludeDirectories=""
						PreprocessorDefinitions="ZLIB_INTERNAL"
					/>
				</FileConfiguration>
				<FileConfiguration
					Name="Release|Itanium"
					>
					<Tool
						Name="VCCLCompilerTool"
						AdditionalIncludeDirectories=""
						PreprocessorDefinitions="ZLIB_INTERNAL"
					/>
				</FileConfiguration>
			</File>
			<File
				RelativePath=".\zlib.rc"
				>
			</File>
			<File
				RelativePath=".\zlibvc.def"
				>
			</File>
			<File
				RelativePath="..\..\..\zutil.c"
				>
			</File>
		</Filter>
		<Filter
			Name="Header Files"
			Filter="h;hpp;hxx;hm;inl;fi;fd"
			>
			<File
				RelativePath="..\..\..\deflate.h"
				>
			</File>
			<File
				RelativePath="..\..\..\infblock.h"
				>
			</File>
			<File
				RelativePath="..\..\..\infcodes.h"
				>
			</File>
			<File
				RelativePath="..\..\..\inffast.h"
				>
			</File>
			<File
				RelativePath="..\..\..\inftrees.h"
				>
			</File>
			<File
				RelativePath="..\..\..\infutil.h"
				>
			</File>
			<File
				RelativePath="..\..\..\zconf.h"
				>
			</File>
			<File
				RelativePath="..\..\..\zlib.h"
				>
			</File>
			<File
				RelativePath="..\..\..\zutil.h"
				>
			</File>
		</Filter>
		<Filter
			Name="Resource Files"
			Filter="ico;cur;bmp;dlg;rc2;rct;bin;cnt;rtf;gif;jpg;jpeg;jpe"
			>
		</Filter>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>

Deleted compat/zlib/crc32.c.

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


























































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* crc32.c -- compute the CRC-32 of a data stream
 * Copyright (C) 1995-2006, 2010, 2011, 2012, 2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 *
 * Thanks to Rodney Brown <rbrown64@csc.com.au> for his contribution of faster
 * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing
 * tables for updating the shift register in one step with three exclusive-ors
 * instead of four steps with four exclusive-ors.  This results in about a
 * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3.
 */

/* @(#) $Id$ */

/*
  Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore
  protection on the static variables used to control the first-use generation
  of the crc tables.  Therefore, if you #define DYNAMIC_CRC_TABLE, you should
  first call get_crc_table() to initialize the tables before allowing more than
  one thread to use crc32().

  DYNAMIC_CRC_TABLE and MAKECRCH can be #defined to write out crc32.h.
 */

#ifdef MAKECRCH
#  include <stdio.h>
#  ifndef DYNAMIC_CRC_TABLE
#    define DYNAMIC_CRC_TABLE
#  endif /* !DYNAMIC_CRC_TABLE */
#endif /* MAKECRCH */

#include "zutil.h"      /* for STDC and FAR definitions */

/* Definitions for doing the crc four data bytes at a time. */
#if !defined(NOBYFOUR) && defined(Z_U4)
#  define BYFOUR
#endif
#ifdef BYFOUR
   local unsigned long crc32_little OF((unsigned long,
                        const unsigned char FAR *, z_size_t));
   local unsigned long crc32_big OF((unsigned long,
                        const unsigned char FAR *, z_size_t));
#  define TBLS 8
#else
#  define TBLS 1
#endif /* BYFOUR */

/* Local functions for crc concatenation */
local unsigned long gf2_matrix_times OF((unsigned long *mat,
                                         unsigned long vec));
local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat));
local uLong crc32_combine_ OF((uLong crc1, uLong crc2, z_off64_t len2));


#ifdef DYNAMIC_CRC_TABLE

local volatile int crc_table_empty = 1;
local z_crc_t FAR crc_table[TBLS][256];
local void make_crc_table OF((void));
#ifdef MAKECRCH
   local void write_table OF((FILE *, const z_crc_t FAR *));
#endif /* MAKECRCH */
/*
  Generate tables for a byte-wise 32-bit CRC calculation on the polynomial:
  x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1.

  Polynomials over GF(2) are represented in binary, one bit per coefficient,
  with the lowest powers in the most significant bit.  Then adding polynomials
  is just exclusive-or, and multiplying a polynomial by x is a right shift by
  one.  If we call the above polynomial p, and represent a byte as the
  polynomial q, also with the lowest power in the most significant bit (so the
  byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p,
  where a mod b means the remainder after dividing a by b.

  This calculation is done using the shift-register method of multiplying and
  taking the remainder.  The register is initialized to zero, and for each
  incoming bit, x^32 is added mod p to the register if the bit is a one (where
  x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by
  x (which is shifting right by one and adding x^32 mod p if the bit shifted
  out is a one).  We start with the highest power (least significant bit) of
  q and repeat for all eight bits of q.

  The first table is simply the CRC of all possible eight bit values.  This is
  all the information needed to generate CRCs on data a byte at a time for all
  combinations of CRC register values and incoming bytes.  The remaining tables
  allow for word-at-a-time CRC calculation for both big-endian and little-
  endian machines, where a word is four bytes.
*/
local void make_crc_table()
{
    z_crc_t c;
    int n, k;
    z_crc_t poly;                       /* polynomial exclusive-or pattern */
    /* terms of polynomial defining this crc (except x^32): */
    static volatile int first = 1;      /* flag to limit concurrent making */
    static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26};

    /* See if another task is already doing this (not thread-safe, but better
       than nothing -- significantly reduces duration of vulnerability in
       case the advice about DYNAMIC_CRC_TABLE is ignored) */
    if (first) {
        first = 0;

        /* make exclusive-or pattern from polynomial (0xedb88320UL) */
        poly = 0;
        for (n = 0; n < (int)(sizeof(p)/sizeof(unsigned char)); n++)
            poly |= (z_crc_t)1 << (31 - p[n]);

        /* generate a crc for every 8-bit value */
        for (n = 0; n < 256; n++) {
            c = (z_crc_t)n;
            for (k = 0; k < 8; k++)
                c = c & 1 ? poly ^ (c >> 1) : c >> 1;
            crc_table[0][n] = c;
        }

#ifdef BYFOUR
        /* generate crc for each value followed by one, two, and three zeros,
           and then the byte reversal of those as well as the first table */
        for (n = 0; n < 256; n++) {
            c = crc_table[0][n];
            crc_table[4][n] = ZSWAP32(c);
            for (k = 1; k < 4; k++) {
                c = crc_table[0][c & 0xff] ^ (c >> 8);
                crc_table[k][n] = c;
                crc_table[k + 4][n] = ZSWAP32(c);
            }
        }
#endif /* BYFOUR */

        crc_table_empty = 0;
    }
    else {      /* not first */
        /* wait for the other guy to finish (not efficient, but rare) */
        while (crc_table_empty)
            ;
    }

#ifdef MAKECRCH
    /* write out CRC tables to crc32.h */
    {
        FILE *out;

        out = fopen("crc32.h", "w");
        if (out == NULL) return;
        fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n");
        fprintf(out, " * Generated automatically by crc32.c\n */\n\n");
        fprintf(out, "local const z_crc_t FAR ");
        fprintf(out, "crc_table[TBLS][256] =\n{\n  {\n");
        write_table(out, crc_table[0]);
#  ifdef BYFOUR
        fprintf(out, "#ifdef BYFOUR\n");
        for (k = 1; k < 8; k++) {
            fprintf(out, "  },\n  {\n");
            write_table(out, crc_table[k]);
        }
        fprintf(out, "#endif\n");
#  endif /* BYFOUR */
        fprintf(out, "  }\n};\n");
        fclose(out);
    }
#endif /* MAKECRCH */
}

#ifdef MAKECRCH
local void write_table(out, table)
    FILE *out;
    const z_crc_t FAR *table;
{
    int n;

    for (n = 0; n < 256; n++)
        fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : "    ",
                (unsigned long)(table[n]),
                n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", "));
}
#endif /* MAKECRCH */

#else /* !DYNAMIC_CRC_TABLE */
/* ========================================================================
 * Tables of CRC-32s of all single-byte values, made by make_crc_table().
 */
#include "crc32.h"
#endif /* DYNAMIC_CRC_TABLE */

/* =========================================================================
 * This function can be used by asm versions of crc32()
 */
const z_crc_t FAR * ZEXPORT get_crc_table()
{
#ifdef DYNAMIC_CRC_TABLE
    if (crc_table_empty)
        make_crc_table();
#endif /* DYNAMIC_CRC_TABLE */
    return (const z_crc_t FAR *)crc_table;
}

/* ========================================================================= */
#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8)
#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1

/* ========================================================================= */
unsigned long ZEXPORT crc32_z(crc, buf, len)
    unsigned long crc;
    const unsigned char FAR *buf;
    z_size_t len;
{
    if (buf == Z_NULL) return 0UL;

#ifdef DYNAMIC_CRC_TABLE
    if (crc_table_empty)
        make_crc_table();
#endif /* DYNAMIC_CRC_TABLE */

#ifdef BYFOUR
    if (sizeof(void *) == sizeof(ptrdiff_t)) {
        z_crc_t endian;

        endian = 1;
        if (*((unsigned char *)(&endian)))
            return crc32_little(crc, buf, len);
        else
            return crc32_big(crc, buf, len);
    }
#endif /* BYFOUR */
    crc = crc ^ 0xffffffffUL;
    while (len >= 8) {
        DO8;
        len -= 8;
    }
    if (len) do {
        DO1;
    } while (--len);
    return crc ^ 0xffffffffUL;
}

/* ========================================================================= */
unsigned long ZEXPORT crc32(crc, buf, len)
    unsigned long crc;
    const unsigned char FAR *buf;
    uInt len;
{
    return crc32_z(crc, buf, len);
}

#ifdef BYFOUR

/*
   This BYFOUR code accesses the passed unsigned char * buffer with a 32-bit
   integer pointer type. This violates the strict aliasing rule, where a
   compiler can assume, for optimization purposes, that two pointers to
   fundamentally different types won't ever point to the same memory. This can
   manifest as a problem only if one of the pointers is written to. This code
   only reads from those pointers. So long as this code remains isolated in
   this compilation unit, there won't be a problem. For this reason, this code
   should not be copied and pasted into a compilation unit in which other code
   writes to the buffer that is passed to these routines.
 */

/* ========================================================================= */
#define DOLIT4 c ^= *buf4++; \
        c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \
            crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24]
#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4

/* ========================================================================= */
local unsigned long crc32_little(crc, buf, len)
    unsigned long crc;
    const unsigned char FAR *buf;
    z_size_t len;
{
    register z_crc_t c;
    register const z_crc_t FAR *buf4;

    c = (z_crc_t)crc;
    c = ~c;
    while (len && ((ptrdiff_t)buf & 3)) {
        c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8);
        len--;
    }

    buf4 = (const z_crc_t FAR *)(const void FAR *)buf;
    while (len >= 32) {
        DOLIT32;
        len -= 32;
    }
    while (len >= 4) {
        DOLIT4;
        len -= 4;
    }
    buf = (const unsigned char FAR *)buf4;

    if (len) do {
        c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8);
    } while (--len);
    c = ~c;
    return (unsigned long)c;
}

/* ========================================================================= */
#define DOBIG4 c ^= *buf4++; \
        c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \
            crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24]
#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4

/* ========================================================================= */
local unsigned long crc32_big(crc, buf, len)
    unsigned long crc;
    const unsigned char FAR *buf;
    z_size_t len;
{
    register z_crc_t c;
    register const z_crc_t FAR *buf4;

    c = ZSWAP32((z_crc_t)crc);
    c = ~c;
    while (len && ((ptrdiff_t)buf & 3)) {
        c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8);
        len--;
    }

    buf4 = (const z_crc_t FAR *)(const void FAR *)buf;
    while (len >= 32) {
        DOBIG32;
        len -= 32;
    }
    while (len >= 4) {
        DOBIG4;
        len -= 4;
    }
    buf = (const unsigned char FAR *)buf4;

    if (len) do {
        c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8);
    } while (--len);
    c = ~c;
    return (unsigned long)(ZSWAP32(c));
}

#endif /* BYFOUR */

#define GF2_DIM 32      /* dimension of GF(2) vectors (length of CRC) */

/* ========================================================================= */
local unsigned long gf2_matrix_times(mat, vec)
    unsigned long *mat;
    unsigned long vec;
{
    unsigned long sum;

    sum = 0;
    while (vec) {
        if (vec & 1)
            sum ^= *mat;
        vec >>= 1;
        mat++;
    }
    return sum;
}

/* ========================================================================= */
local void gf2_matrix_square(square, mat)
    unsigned long *square;
    unsigned long *mat;
{
    int n;

    for (n = 0; n < GF2_DIM; n++)
        square[n] = gf2_matrix_times(mat, mat[n]);
}

/* ========================================================================= */
local uLong crc32_combine_(crc1, crc2, len2)
    uLong crc1;
    uLong crc2;
    z_off64_t len2;
{
    int n;
    unsigned long row;
    unsigned long even[GF2_DIM];    /* even-power-of-two zeros operator */
    unsigned long odd[GF2_DIM];     /* odd-power-of-two zeros operator */

    /* degenerate case (also disallow negative lengths) */
    if (len2 <= 0)
        return crc1;

    /* put operator for one zero bit in odd */
    odd[0] = 0xedb88320UL;          /* CRC-32 polynomial */
    row = 1;
    for (n = 1; n < GF2_DIM; n++) {
        odd[n] = row;
        row <<= 1;
    }

    /* put operator for two zero bits in even */
    gf2_matrix_square(even, odd);

    /* put operator for four zero bits in odd */
    gf2_matrix_square(odd, even);

    /* apply len2 zeros to crc1 (first square will put the operator for one
       zero byte, eight zero bits, in even) */
    do {
        /* apply zeros operator for this bit of len2 */
        gf2_matrix_square(even, odd);
        if (len2 & 1)
            crc1 = gf2_matrix_times(even, crc1);
        len2 >>= 1;

        /* if no more bits set, then done */
        if (len2 == 0)
            break;

        /* another iteration of the loop with odd and even swapped */
        gf2_matrix_square(odd, even);
        if (len2 & 1)
            crc1 = gf2_matrix_times(odd, crc1);
        len2 >>= 1;

        /* if no more bits set, then done */
    } while (len2 != 0);

    /* return combined crc */
    crc1 ^= crc2;
    return crc1;
}

/* ========================================================================= */
uLong ZEXPORT crc32_combine(crc1, crc2, len2)
    uLong crc1;
    uLong crc2;
    z_off_t len2;
{
    return crc32_combine_(crc1, crc2, len2);
}

uLong ZEXPORT crc32_combine64(crc1, crc2, len2)
    uLong crc1;
    uLong crc2;
    z_off64_t len2;
{
    return crc32_combine_(crc1, crc2, len2);
}

Deleted compat/zlib/crc32.h.

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
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

























































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* crc32.h -- tables for rapid CRC calculation
 * Generated automatically by crc32.c
 */

local const z_crc_t FAR crc_table[TBLS][256] =
{
  {
    0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL,
    0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL,
    0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL,
    0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL,
    0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL,
    0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL,
    0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL,
    0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL,
    0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL,
    0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL,
    0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL,
    0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL,
    0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL,
    0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL,
    0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL,
    0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL,
    0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL,
    0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL,
    0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL,
    0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL,
    0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL,
    0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL,
    0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL,
    0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL,
    0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL,
    0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL,
    0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL,
    0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL,
    0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL,
    0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL,
    0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL,
    0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL,
    0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL,
    0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL,
    0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL,
    0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL,
    0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL,
    0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL,
    0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL,
    0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL,
    0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL,
    0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL,
    0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL,
    0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL,
    0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL,
    0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL,
    0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL,
    0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL,
    0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL,
    0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL,
    0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL,
    0x2d02ef8dUL
#ifdef BYFOUR
  },
  {
    0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL,
    0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL,
    0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL,
    0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL,
    0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL,
    0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL,
    0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL,
    0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL,
    0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL,
    0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL,
    0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL,
    0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL,
    0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL,
    0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL,
    0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL,
    0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL,
    0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL,
    0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL,
    0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL,
    0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL,
    0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL,
    0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL,
    0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL,
    0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL,
    0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL,
    0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL,
    0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL,
    0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL,
    0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL,
    0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL,
    0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL,
    0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL,
    0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL,
    0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL,
    0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL,
    0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL,
    0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL,
    0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL,
    0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL,
    0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL,
    0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL,
    0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL,
    0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL,
    0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL,
    0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL,
    0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL,
    0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL,
    0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL,
    0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL,
    0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL,
    0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL,
    0x9324fd72UL
  },
  {
    0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL,
    0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL,
    0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL,
    0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL,
    0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL,
    0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL,
    0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL,
    0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL,
    0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL,
    0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL,
    0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL,
    0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL,
    0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL,
    0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL,
    0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL,
    0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL,
    0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL,
    0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL,
    0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL,
    0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL,
    0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL,
    0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL,
    0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL,
    0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL,
    0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL,
    0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL,
    0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL,
    0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL,
    0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL,
    0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL,
    0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL,
    0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL,
    0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL,
    0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL,
    0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL,
    0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL,
    0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL,
    0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL,
    0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL,
    0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL,
    0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL,
    0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL,
    0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL,
    0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL,
    0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL,
    0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL,
    0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL,
    0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL,
    0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL,
    0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL,
    0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL,
    0xbe9834edUL
  },
  {
    0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL,
    0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL,
    0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL,
    0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL,
    0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL,
    0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL,
    0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL,
    0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL,
    0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL,
    0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL,
    0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL,
    0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL,
    0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL,
    0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL,
    0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL,
    0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL,
    0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL,
    0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL,
    0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL,
    0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL,
    0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL,
    0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL,
    0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL,
    0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL,
    0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL,
    0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL,
    0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL,
    0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL,
    0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL,
    0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL,
    0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL,
    0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL,
    0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL,
    0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL,
    0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL,
    0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL,
    0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL,
    0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL,
    0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL,
    0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL,
    0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL,
    0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL,
    0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL,
    0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL,
    0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL,
    0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL,
    0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL,
    0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL,
    0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL,
    0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL,
    0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL,
    0xde0506f1UL
  },
  {
    0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL,
    0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL,
    0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL,
    0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL,
    0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL,
    0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL,
    0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL,
    0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL,
    0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL,
    0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL,
    0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL,
    0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL,
    0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL,
    0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL,
    0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL,
    0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL,
    0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL,
    0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL,
    0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL,
    0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL,
    0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL,
    0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL,
    0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL,
    0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL,
    0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL,
    0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL,
    0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL,
    0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL,
    0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL,
    0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL,
    0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL,
    0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL,
    0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL,
    0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL,
    0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL,
    0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL,
    0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL,
    0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL,
    0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL,
    0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL,
    0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL,
    0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL,
    0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL,
    0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL,
    0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL,
    0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL,
    0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL,
    0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL,
    0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL,
    0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL,
    0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL,
    0x8def022dUL
  },
  {
    0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL,
    0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL,
    0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL,
    0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL,
    0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL,
    0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL,
    0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL,
    0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL,
    0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL,
    0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL,
    0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL,
    0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL,
    0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL,
    0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL,
    0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL,
    0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL,
    0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL,
    0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL,
    0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL,
    0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL,
    0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL,
    0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL,
    0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL,
    0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL,
    0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL,
    0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL,
    0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL,
    0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL,
    0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL,
    0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL,
    0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL,
    0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL,
    0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL,
    0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL,
    0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL,
    0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL,
    0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL,
    0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL,
    0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL,
    0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL,
    0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL,
    0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL,
    0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL,
    0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL,
    0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL,
    0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL,
    0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL,
    0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL,
    0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL,
    0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL,
    0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL,
    0x72fd2493UL
  },
  {
    0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL,
    0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL,
    0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL,
    0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL,
    0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL,
    0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL,
    0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL,
    0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL,
    0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL,
    0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL,
    0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL,
    0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL,
    0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL,
    0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL,
    0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL,
    0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL,
    0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL,
    0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL,
    0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL,
    0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL,
    0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL,
    0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL,
    0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL,
    0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL,
    0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL,
    0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL,
    0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL,
    0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL,
    0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL,
    0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL,
    0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL,
    0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL,
    0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL,
    0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL,
    0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL,
    0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL,
    0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL,
    0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL,
    0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL,
    0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL,
    0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL,
    0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL,
    0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL,
    0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL,
    0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL,
    0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL,
    0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL,
    0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL,
    0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL,
    0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL,
    0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL,
    0xed3498beUL
  },
  {
    0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL,
    0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL,
    0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL,
    0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL,
    0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL,
    0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL,
    0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL,
    0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL,
    0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL,
    0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL,
    0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL,
    0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL,
    0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL,
    0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL,
    0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL,
    0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL,
    0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL,
    0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL,
    0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL,
    0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL,
    0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL,
    0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL,
    0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL,
    0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL,
    0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL,
    0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL,
    0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL,
    0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL,
    0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL,
    0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL,
    0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL,
    0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL,
    0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL,
    0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL,
    0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL,
    0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL,
    0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL,
    0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL,
    0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL,
    0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL,
    0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL,
    0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL,
    0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL,
    0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL,
    0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL,
    0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL,
    0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL,
    0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL,
    0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL,
    0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL,
    0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL,
    0xf10605deUL
#endif
  }
};

Deleted compat/zlib/deflate.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* deflate.c -- compress data using the deflation algorithm
 * Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/*
 *  ALGORITHM
 *
 *      The "deflation" process depends on being able to identify portions
 *      of the input text which are identical to earlier input (within a
 *      sliding window trailing behind the input currently being processed).
 *
 *      The most straightforward technique turns out to be the fastest for
 *      most input files: try all possible matches and select the longest.
 *      The key feature of this algorithm is that insertions into the string
 *      dictionary are very simple and thus fast, and deletions are avoided
 *      completely. Insertions are performed at each input character, whereas
 *      string matches are performed only when the previous match ends. So it
 *      is preferable to spend more time in matches to allow very fast string
 *      insertions and avoid deletions. The matching algorithm for small
 *      strings is inspired from that of Rabin & Karp. A brute force approach
 *      is used to find longer strings when a small match has been found.
 *      A similar algorithm is used in comic (by Jan-Mark Wams) and freeze
 *      (by Leonid Broukhis).
 *         A previous version of this file used a more sophisticated algorithm
 *      (by Fiala and Greene) which is guaranteed to run in linear amortized
 *      time, but has a larger average cost, uses more memory and is patented.
 *      However the F&G algorithm may be faster for some highly redundant
 *      files if the parameter max_chain_length (described below) is too large.
 *
 *  ACKNOWLEDGEMENTS
 *
 *      The idea of lazy evaluation of matches is due to Jan-Mark Wams, and
 *      I found it in 'freeze' written by Leonid Broukhis.
 *      Thanks to many people for bug reports and testing.
 *
 *  REFERENCES
 *
 *      Deutsch, L.P.,"DEFLATE Compressed Data Format Specification".
 *      Available in http://tools.ietf.org/html/rfc1951
 *
 *      A description of the Rabin and Karp algorithm is given in the book
 *         "Algorithms" by R. Sedgewick, Addison-Wesley, p252.
 *
 *      Fiala,E.R., and Greene,D.H.
 *         Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595
 *
 */

/* @(#) $Id$ */

#include "deflate.h"

const char deflate_copyright[] =
   " deflate 1.2.11 Copyright 1995-2017 Jean-loup Gailly and Mark Adler ";
/*
  If you use the zlib library in a product, an acknowledgment is welcome
  in the documentation of your product. If for some reason you cannot
  include such an acknowledgment, I would appreciate that you keep this
  copyright string in the executable of your product.
 */

/* ===========================================================================
 *  Function prototypes.
 */
typedef enum {
    need_more,      /* block not completed, need more input or more output */
    block_done,     /* block flush performed */
    finish_started, /* finish started, need only more output at next deflate */
    finish_done     /* finish done, accept no more input or output */
} block_state;

typedef block_state (*compress_func) OF((deflate_state *s, int flush));
/* Compression function. Returns the block state after the call. */

local int deflateStateCheck      OF((z_streamp strm));
local void slide_hash     OF((deflate_state *s));
local void fill_window    OF((deflate_state *s));
local block_state deflate_stored OF((deflate_state *s, int flush));
local block_state deflate_fast   OF((deflate_state *s, int flush));
#ifndef FASTEST
local block_state deflate_slow   OF((deflate_state *s, int flush));
#endif
local block_state deflate_rle    OF((deflate_state *s, int flush));
local block_state deflate_huff   OF((deflate_state *s, int flush));
local void lm_init        OF((deflate_state *s));
local void putShortMSB    OF((deflate_state *s, uInt b));
local void flush_pending  OF((z_streamp strm));
local unsigned read_buf   OF((z_streamp strm, Bytef *buf, unsigned size));
#ifdef ASMV
#  pragma message("Assembler code may have bugs -- use at your own risk")
      void match_init OF((void)); /* asm code initialization */
      uInt longest_match  OF((deflate_state *s, IPos cur_match));
#else
local uInt longest_match  OF((deflate_state *s, IPos cur_match));
#endif

#ifdef ZLIB_DEBUG
local  void check_match OF((deflate_state *s, IPos start, IPos match,
                            int length));
#endif

/* ===========================================================================
 * Local data
 */

#define NIL 0
/* Tail of hash chains */

#ifndef TOO_FAR
#  define TOO_FAR 4096
#endif
/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */

/* Values for max_lazy_match, good_match and max_chain_length, depending on
 * the desired pack level (0..9). The values given below have been tuned to
 * exclude worst case performance for pathological files. Better values may be
 * found for specific files.
 */
typedef struct config_s {
   ush good_length; /* reduce lazy search above this match length */
   ush max_lazy;    /* do not perform lazy search above this match length */
   ush nice_length; /* quit search above this match length */
   ush max_chain;
   compress_func func;
} config;

#ifdef FASTEST
local const config configuration_table[2] = {
/*      good lazy nice chain */
/* 0 */ {0,    0,  0,    0, deflate_stored},  /* store only */
/* 1 */ {4,    4,  8,    4, deflate_fast}}; /* max speed, no lazy matches */
#else
local const config configuration_table[10] = {
/*      good lazy nice chain */
/* 0 */ {0,    0,  0,    0, deflate_stored},  /* store only */
/* 1 */ {4,    4,  8,    4, deflate_fast}, /* max speed, no lazy matches */
/* 2 */ {4,    5, 16,    8, deflate_fast},
/* 3 */ {4,    6, 32,   32, deflate_fast},

/* 4 */ {4,    4, 16,   16, deflate_slow},  /* lazy matches */
/* 5 */ {8,   16, 32,   32, deflate_slow},
/* 6 */ {8,   16, 128, 128, deflate_slow},
/* 7 */ {8,   32, 128, 256, deflate_slow},
/* 8 */ {32, 128, 258, 1024, deflate_slow},
/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */
#endif

/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4
 * For deflate_fast() (levels <= 3) good is ignored and lazy has a different
 * meaning.
 */

/* rank Z_BLOCK between Z_NO_FLUSH and Z_PARTIAL_FLUSH */
#define RANK(f) (((f) * 2) - ((f) > 4 ? 9 : 0))

/* ===========================================================================
 * Update a hash value with the given input byte
 * IN  assertion: all calls to UPDATE_HASH are made with consecutive input
 *    characters, so that a running hash key can be computed from the previous
 *    key instead of complete recalculation each time.
 */
#define UPDATE_HASH(s,h,c) (h = (((h)<<s->hash_shift) ^ (c)) & s->hash_mask)


/* ===========================================================================
 * Insert string str in the dictionary and set match_head to the previous head
 * of the hash chain (the most recent string with same hash key). Return
 * the previous length of the hash chain.
 * If this file is compiled with -DFASTEST, the compression level is forced
 * to 1, and no hash chains are maintained.
 * IN  assertion: all calls to INSERT_STRING are made with consecutive input
 *    characters and the first MIN_MATCH bytes of str are valid (except for
 *    the last MIN_MATCH-1 bytes of the input file).
 */
#ifdef FASTEST
#define INSERT_STRING(s, str, match_head) \
   (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \
    match_head = s->head[s->ins_h], \
    s->head[s->ins_h] = (Pos)(str))
#else
#define INSERT_STRING(s, str, match_head) \
   (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \
    match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \
    s->head[s->ins_h] = (Pos)(str))
#endif

/* ===========================================================================
 * Initialize the hash table (avoiding 64K overflow for 16 bit systems).
 * prev[] will be initialized on the fly.
 */
#define CLEAR_HASH(s) \
    s->head[s->hash_size-1] = NIL; \
    zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head));

/* ===========================================================================
 * Slide the hash table when sliding the window down (could be avoided with 32
 * bit values at the expense of memory usage). We slide even when level == 0 to
 * keep the hash table consistent if we switch back to level > 0 later.
 */
local void slide_hash(s)
    deflate_state *s;
{
    unsigned n, m;
    Posf *p;
    uInt wsize = s->w_size;

    n = s->hash_size;
    p = &s->head[n];
    do {
        m = *--p;
        *p = (Pos)(m >= wsize ? m - wsize : NIL);
    } while (--n);
    n = wsize;
#ifndef FASTEST
    p = &s->prev[n];
    do {
        m = *--p;
        *p = (Pos)(m >= wsize ? m - wsize : NIL);
        /* If n is not on any hash chain, prev[n] is garbage but
         * its value will never be used.
         */
    } while (--n);
#endif
}

/* ========================================================================= */
int ZEXPORT deflateInit_(strm, level, version, stream_size)
    z_streamp strm;
    int level;
    const char *version;
    int stream_size;
{
    return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL,
                         Z_DEFAULT_STRATEGY, version, stream_size);
    /* To do: ignore strm->next_in if we use it as window */
}

/* ========================================================================= */
int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy,
                  version, stream_size)
    z_streamp strm;
    int  level;
    int  method;
    int  windowBits;
    int  memLevel;
    int  strategy;
    const char *version;
    int stream_size;
{
    deflate_state *s;
    int wrap = 1;
    static const char my_version[] = ZLIB_VERSION;

    ushf *overlay;
    /* We overlay pending_buf and d_buf+l_buf. This works since the average
     * output size for (length,distance) codes is <= 24 bits.
     */

    if (version == Z_NULL || version[0] != my_version[0] ||
        stream_size != sizeof(z_stream)) {
        return Z_VERSION_ERROR;
    }
    if (strm == Z_NULL) return Z_STREAM_ERROR;

    strm->msg = Z_NULL;
    if (strm->zalloc == (alloc_func)0) {
#ifdef Z_SOLO
        return Z_STREAM_ERROR;
#else
        strm->zalloc = zcalloc;
        strm->opaque = (voidpf)0;
#endif
    }
    if (strm->zfree == (free_func)0)
#ifdef Z_SOLO
        return Z_STREAM_ERROR;
#else
        strm->zfree = zcfree;
#endif

#ifdef FASTEST
    if (level != 0) level = 1;
#else
    if (level == Z_DEFAULT_COMPRESSION) level = 6;
#endif

    if (windowBits < 0) { /* suppress zlib wrapper */
        wrap = 0;
        windowBits = -windowBits;
    }
#ifdef GZIP
    else if (windowBits > 15) {
        wrap = 2;       /* write gzip wrapper instead */
        windowBits -= 16;
    }
#endif
    if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED ||
        windowBits < 8 || windowBits > 15 || level < 0 || level > 9 ||
        strategy < 0 || strategy > Z_FIXED || (windowBits == 8 && wrap != 1)) {
        return Z_STREAM_ERROR;
    }
    if (windowBits == 8) windowBits = 9;  /* until 256-byte window bug fixed */
    s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state));
    if (s == Z_NULL) return Z_MEM_ERROR;
    strm->state = (struct internal_state FAR *)s;
    s->strm = strm;
    s->status = INIT_STATE;     /* to pass state test in deflateReset() */

    s->wrap = wrap;
    s->gzhead = Z_NULL;
    s->w_bits = (uInt)windowBits;
    s->w_size = 1 << s->w_bits;
    s->w_mask = s->w_size - 1;

    s->hash_bits = (uInt)memLevel + 7;
    s->hash_size = 1 << s->hash_bits;
    s->hash_mask = s->hash_size - 1;
    s->hash_shift =  ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH);

    s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte));
    s->prev   = (Posf *)  ZALLOC(strm, s->w_size, sizeof(Pos));
    s->head   = (Posf *)  ZALLOC(strm, s->hash_size, sizeof(Pos));

    s->high_water = 0;      /* nothing written to s->window yet */

    s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */

    overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2);
    s->pending_buf = (uchf *) overlay;
    s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L);

    if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL ||
        s->pending_buf == Z_NULL) {
        s->status = FINISH_STATE;
        strm->msg = ERR_MSG(Z_MEM_ERROR);
        deflateEnd (strm);
        return Z_MEM_ERROR;
    }
    s->d_buf = overlay + s->lit_bufsize/sizeof(ush);
    s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize;

    s->level = level;
    s->strategy = strategy;
    s->method = (Byte)method;

    return deflateReset(strm);
}

/* =========================================================================
 * Check for a valid deflate stream state. Return 0 if ok, 1 if not.
 */
local int deflateStateCheck (strm)
    z_streamp strm;
{
    deflate_state *s;
    if (strm == Z_NULL ||
        strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0)
        return 1;
    s = strm->state;
    if (s == Z_NULL || s->strm != strm || (s->status != INIT_STATE &&
#ifdef GZIP
                                           s->status != GZIP_STATE &&
#endif
                                           s->status != EXTRA_STATE &&
                                           s->status != NAME_STATE &&
                                           s->status != COMMENT_STATE &&
                                           s->status != HCRC_STATE &&
                                           s->status != BUSY_STATE &&
                                           s->status != FINISH_STATE))
        return 1;
    return 0;
}

/* ========================================================================= */
int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength)
    z_streamp strm;
    const Bytef *dictionary;
    uInt  dictLength;
{
    deflate_state *s;
    uInt str, n;
    int wrap;
    unsigned avail;
    z_const unsigned char *next;

    if (deflateStateCheck(strm) || dictionary == Z_NULL)
        return Z_STREAM_ERROR;
    s = strm->state;
    wrap = s->wrap;
    if (wrap == 2 || (wrap == 1 && s->status != INIT_STATE) || s->lookahead)
        return Z_STREAM_ERROR;

    /* when using zlib wrappers, compute Adler-32 for provided dictionary */
    if (wrap == 1)
        strm->adler = adler32(strm->adler, dictionary, dictLength);
    s->wrap = 0;                    /* avoid computing Adler-32 in read_buf */

    /* if dictionary would fill window, just replace the history */
    if (dictLength >= s->w_size) {
        if (wrap == 0) {            /* already empty otherwise */
            CLEAR_HASH(s);
            s->strstart = 0;
            s->block_start = 0L;
            s->insert = 0;
        }
        dictionary += dictLength - s->w_size;  /* use the tail */
        dictLength = s->w_size;
    }

    /* insert dictionary into window and hash */
    avail = strm->avail_in;
    next = strm->next_in;
    strm->avail_in = dictLength;
    strm->next_in = (z_const Bytef *)dictionary;
    fill_window(s);
    while (s->lookahead >= MIN_MATCH) {
        str = s->strstart;
        n = s->lookahead - (MIN_MATCH-1);
        do {
            UPDATE_HASH(s, s->ins_h, s->window[str + MIN_MATCH-1]);
#ifndef FASTEST
            s->prev[str & s->w_mask] = s->head[s->ins_h];
#endif
            s->head[s->ins_h] = (Pos)str;
            str++;
        } while (--n);
        s->strstart = str;
        s->lookahead = MIN_MATCH-1;
        fill_window(s);
    }
    s->strstart += s->lookahead;
    s->block_start = (long)s->strstart;
    s->insert = s->lookahead;
    s->lookahead = 0;
    s->match_length = s->prev_length = MIN_MATCH-1;
    s->match_available = 0;
    strm->next_in = next;
    strm->avail_in = avail;
    s->wrap = wrap;
    return Z_OK;
}

/* ========================================================================= */
int ZEXPORT deflateGetDictionary (strm, dictionary, dictLength)
    z_streamp strm;
    Bytef *dictionary;
    uInt  *dictLength;
{
    deflate_state *s;
    uInt len;

    if (deflateStateCheck(strm))
        return Z_STREAM_ERROR;
    s = strm->state;
    len = s->strstart + s->lookahead;
    if (len > s->w_size)
        len = s->w_size;
    if (dictionary != Z_NULL && len)
        zmemcpy(dictionary, s->window + s->strstart + s->lookahead - len, len);
    if (dictLength != Z_NULL)
        *dictLength = len;
    return Z_OK;
}

/* ========================================================================= */
int ZEXPORT deflateResetKeep (strm)
    z_streamp strm;
{
    deflate_state *s;

    if (deflateStateCheck(strm)) {
        return Z_STREAM_ERROR;
    }

    strm->total_in = strm->total_out = 0;
    strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */
    strm->data_type = Z_UNKNOWN;

    s = (deflate_state *)strm->state;
    s->pending = 0;
    s->pending_out = s->pending_buf;

    if (s->wrap < 0) {
        s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */
    }
    s->status =
#ifdef GZIP
        s->wrap == 2 ? GZIP_STATE :
#endif
        s->wrap ? INIT_STATE : BUSY_STATE;
    strm->adler =
#ifdef GZIP
        s->wrap == 2 ? crc32(0L, Z_NULL, 0) :
#endif
        adler32(0L, Z_NULL, 0);
    s->last_flush = Z_NO_FLUSH;

    _tr_init(s);

    return Z_OK;
}

/* ========================================================================= */
int ZEXPORT deflateReset (strm)
    z_streamp strm;
{
    int ret;

    ret = deflateResetKeep(strm);
    if (ret == Z_OK)
        lm_init(strm->state);
    return ret;
}

/* ========================================================================= */
int ZEXPORT deflateSetHeader (strm, head)
    z_streamp strm;
    gz_headerp head;
{
    if (deflateStateCheck(strm) || strm->state->wrap != 2)
        return Z_STREAM_ERROR;
    strm->state->gzhead = head;
    return Z_OK;
}

/* ========================================================================= */
int ZEXPORT deflatePending (strm, pending, bits)
    unsigned *pending;
    int *bits;
    z_streamp strm;
{
    if (deflateStateCheck(strm)) return Z_STREAM_ERROR;
    if (pending != Z_NULL)
        *pending = strm->state->pending;
    if (bits != Z_NULL)
        *bits = strm->state->bi_valid;
    return Z_OK;
}

/* ========================================================================= */
int ZEXPORT deflatePrime (strm, bits, value)
    z_streamp strm;
    int bits;
    int value;
{
    deflate_state *s;
    int put;

    if (deflateStateCheck(strm)) return Z_STREAM_ERROR;
    s = strm->state;
    if ((Bytef *)(s->d_buf) < s->pending_out + ((Buf_size + 7) >> 3))
        return Z_BUF_ERROR;
    do {
        put = Buf_size - s->bi_valid;
        if (put > bits)
            put = bits;
        s->bi_buf |= (ush)((value & ((1 << put) - 1)) << s->bi_valid);
        s->bi_valid += put;
        _tr_flush_bits(s);
        value >>= put;
        bits -= put;
    } while (bits);
    return Z_OK;
}

/* ========================================================================= */
int ZEXPORT deflateParams(strm, level, strategy)
    z_streamp strm;
    int level;
    int strategy;
{
    deflate_state *s;
    compress_func func;

    if (deflateStateCheck(strm)) return Z_STREAM_ERROR;
    s = strm->state;

#ifdef FASTEST
    if (level != 0) level = 1;
#else
    if (level == Z_DEFAULT_COMPRESSION) level = 6;
#endif
    if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) {
        return Z_STREAM_ERROR;
    }
    func = configuration_table[s->level].func;

    if ((strategy != s->strategy || func != configuration_table[level].func) &&
        s->high_water) {
        /* Flush the last buffer: */
        int err = deflate(strm, Z_BLOCK);
        if (err == Z_STREAM_ERROR)
            return err;
        if (strm->avail_out == 0)
            return Z_BUF_ERROR;
    }
    if (s->level != level) {
        if (s->level == 0 && s->matches != 0) {
            if (s->matches == 1)
                slide_hash(s);
            else
                CLEAR_HASH(s);
            s->matches = 0;
        }
        s->level = level;
        s->max_lazy_match   = configuration_table[level].max_lazy;
        s->good_match       = configuration_table[level].good_length;
        s->nice_match       = configuration_table[level].nice_length;
        s->max_chain_length = configuration_table[level].max_chain;
    }
    s->strategy = strategy;
    return Z_OK;
}

/* ========================================================================= */
int ZEXPORT deflateTune(strm, good_length, max_lazy, nice_length, max_chain)
    z_streamp strm;
    int good_length;
    int max_lazy;
    int nice_length;
    int max_chain;
{
    deflate_state *s;

    if (deflateStateCheck(strm)) return Z_STREAM_ERROR;
    s = strm->state;
    s->good_match = (uInt)good_length;
    s->max_lazy_match = (uInt)max_lazy;
    s->nice_match = nice_length;
    s->max_chain_length = (uInt)max_chain;
    return Z_OK;
}

/* =========================================================================
 * For the default windowBits of 15 and memLevel of 8, this function returns
 * a close to exact, as well as small, upper bound on the compressed size.
 * They are coded as constants here for a reason--if the #define's are
 * changed, then this function needs to be changed as well.  The return
 * value for 15 and 8 only works for those exact settings.
 *
 * For any setting other than those defaults for windowBits and memLevel,
 * the value returned is a conservative worst case for the maximum expansion
 * resulting from using fixed blocks instead of stored blocks, which deflate
 * can emit on compressed data for some combinations of the parameters.
 *
 * This function could be more sophisticated to provide closer upper bounds for
 * every combination of windowBits and memLevel.  But even the conservative
 * upper bound of about 14% expansion does not seem onerous for output buffer
 * allocation.
 */
uLong ZEXPORT deflateBound(strm, sourceLen)
    z_streamp strm;
    uLong sourceLen;
{
    deflate_state *s;
    uLong complen, wraplen;

    /* conservative upper bound for compressed data */
    complen = sourceLen +
              ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 5;

    /* if can't get parameters, return conservative bound plus zlib wrapper */
    if (deflateStateCheck(strm))
        return complen + 6;

    /* compute wrapper length */
    s = strm->state;
    switch (s->wrap) {
    case 0:                                 /* raw deflate */
        wraplen = 0;
        break;
    case 1:                                 /* zlib wrapper */
        wraplen = 6 + (s->strstart ? 4 : 0);
        break;
#ifdef GZIP
    case 2:                                 /* gzip wrapper */
        wraplen = 18;
        if (s->gzhead != Z_NULL) {          /* user-supplied gzip header */
            Bytef *str;
            if (s->gzhead->extra != Z_NULL)
                wraplen += 2 + s->gzhead->extra_len;
            str = s->gzhead->name;
            if (str != Z_NULL)
                do {
                    wraplen++;
                } while (*str++);
            str = s->gzhead->comment;
            if (str != Z_NULL)
                do {
                    wraplen++;
                } while (*str++);
            if (s->gzhead->hcrc)
                wraplen += 2;
        }
        break;
#endif
    default:                                /* for compiler happiness */
        wraplen = 6;
    }

    /* if not default parameters, return conservative bound */
    if (s->w_bits != 15 || s->hash_bits != 8 + 7)
        return complen + wraplen;

    /* default settings: return tight bound for that case */
    return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) +
           (sourceLen >> 25) + 13 - 6 + wraplen;
}

/* =========================================================================
 * Put a short in the pending buffer. The 16-bit value is put in MSB order.
 * IN assertion: the stream state is correct and there is enough room in
 * pending_buf.
 */
local void putShortMSB (s, b)
    deflate_state *s;
    uInt b;
{
    put_byte(s, (Byte)(b >> 8));
    put_byte(s, (Byte)(b & 0xff));
}

/* =========================================================================
 * Flush as much pending output as possible. All deflate() output, except for
 * some deflate_stored() output, goes through this function so some
 * applications may wish to modify it to avoid allocating a large
 * strm->next_out buffer and copying into it. (See also read_buf()).
 */
local void flush_pending(strm)
    z_streamp strm;
{
    unsigned len;
    deflate_state *s = strm->state;

    _tr_flush_bits(s);
    len = s->pending;
    if (len > strm->avail_out) len = strm->avail_out;
    if (len == 0) return;

    zmemcpy(strm->next_out, s->pending_out, len);
    strm->next_out  += len;
    s->pending_out  += len;
    strm->total_out += len;
    strm->avail_out -= len;
    s->pending      -= len;
    if (s->pending == 0) {
        s->pending_out = s->pending_buf;
    }
}

/* ===========================================================================
 * Update the header CRC with the bytes s->pending_buf[beg..s->pending - 1].
 */
#define HCRC_UPDATE(beg) \
    do { \
        if (s->gzhead->hcrc && s->pending > (beg)) \
            strm->adler = crc32(strm->adler, s->pending_buf + (beg), \
                                s->pending - (beg)); \
    } while (0)

/* ========================================================================= */
int ZEXPORT deflate (strm, flush)
    z_streamp strm;
    int flush;
{
    int old_flush; /* value of flush param for previous deflate call */
    deflate_state *s;

    if (deflateStateCheck(strm) || flush > Z_BLOCK || flush < 0) {
        return Z_STREAM_ERROR;
    }
    s = strm->state;

    if (strm->next_out == Z_NULL ||
        (strm->avail_in != 0 && strm->next_in == Z_NULL) ||
        (s->status == FINISH_STATE && flush != Z_FINISH)) {
        ERR_RETURN(strm, Z_STREAM_ERROR);
    }
    if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR);

    old_flush = s->last_flush;
    s->last_flush = flush;

    /* Flush as much pending output as possible */
    if (s->pending != 0) {
        flush_pending(strm);
        if (strm->avail_out == 0) {
            /* Since avail_out is 0, deflate will be called again with
             * more output space, but possibly with both pending and
             * avail_in equal to zero. There won't be anything to do,
             * but this is not an error situation so make sure we
             * return OK instead of BUF_ERROR at next call of deflate:
             */
            s->last_flush = -1;
            return Z_OK;
        }

    /* Make sure there is something to do and avoid duplicate consecutive
     * flushes. For repeated and useless calls with Z_FINISH, we keep
     * returning Z_STREAM_END instead of Z_BUF_ERROR.
     */
    } else if (strm->avail_in == 0 && RANK(flush) <= RANK(old_flush) &&
               flush != Z_FINISH) {
        ERR_RETURN(strm, Z_BUF_ERROR);
    }

    /* User must not provide more input after the first FINISH: */
    if (s->status == FINISH_STATE && strm->avail_in != 0) {
        ERR_RETURN(strm, Z_BUF_ERROR);
    }

    /* Write the header */
    if (s->status == INIT_STATE) {
        /* zlib header */
        uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8;
        uInt level_flags;

        if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2)
            level_flags = 0;
        else if (s->level < 6)
            level_flags = 1;
        else if (s->level == 6)
            level_flags = 2;
        else
            level_flags = 3;
        header |= (level_flags << 6);
        if (s->strstart != 0) header |= PRESET_DICT;
        header += 31 - (header % 31);

        putShortMSB(s, header);

        /* Save the adler32 of the preset dictionary: */
        if (s->strstart != 0) {
            putShortMSB(s, (uInt)(strm->adler >> 16));
            putShortMSB(s, (uInt)(strm->adler & 0xffff));
        }
        strm->adler = adler32(0L, Z_NULL, 0);
        s->status = BUSY_STATE;

        /* Compression must start with an empty pending buffer */
        flush_pending(strm);
        if (s->pending != 0) {
            s->last_flush = -1;
            return Z_OK;
        }
    }
#ifdef GZIP
    if (s->status == GZIP_STATE) {
        /* gzip header */
        strm->adler = crc32(0L, Z_NULL, 0);
        put_byte(s, 31);
        put_byte(s, 139);
        put_byte(s, 8);
        if (s->gzhead == Z_NULL) {
            put_byte(s, 0);
            put_byte(s, 0);
            put_byte(s, 0);
            put_byte(s, 0);
            put_byte(s, 0);
            put_byte(s, s->level == 9 ? 2 :
                     (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ?
                      4 : 0));
            put_byte(s, OS_CODE);
            s->status = BUSY_STATE;

            /* Compression must start with an empty pending buffer */
            flush_pending(strm);
            if (s->pending != 0) {
                s->last_flush = -1;
                return Z_OK;
            }
        }
        else {
            put_byte(s, (s->gzhead->text ? 1 : 0) +
                     (s->gzhead->hcrc ? 2 : 0) +
                     (s->gzhead->extra == Z_NULL ? 0 : 4) +
                     (s->gzhead->name == Z_NULL ? 0 : 8) +
                     (s->gzhead->comment == Z_NULL ? 0 : 16)
                     );
            put_byte(s, (Byte)(s->gzhead->time & 0xff));
            put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff));
            put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff));
            put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff));
            put_byte(s, s->level == 9 ? 2 :
                     (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ?
                      4 : 0));
            put_byte(s, s->gzhead->os & 0xff);
            if (s->gzhead->extra != Z_NULL) {
                put_byte(s, s->gzhead->extra_len & 0xff);
                put_byte(s, (s->gzhead->extra_len >> 8) & 0xff);
            }
            if (s->gzhead->hcrc)
                strm->adler = crc32(strm->adler, s->pending_buf,
                                    s->pending);
            s->gzindex = 0;
            s->status = EXTRA_STATE;
        }
    }
    if (s->status == EXTRA_STATE) {
        if (s->gzhead->extra != Z_NULL) {
            ulg beg = s->pending;   /* start of bytes to update crc */
            uInt left = (s->gzhead->extra_len & 0xffff) - s->gzindex;
            while (s->pending + left > s->pending_buf_size) {
                uInt copy = s->pending_buf_size - s->pending;
                zmemcpy(s->pending_buf + s->pending,
                        s->gzhead->extra + s->gzindex, copy);
                s->pending = s->pending_buf_size;
                HCRC_UPDATE(beg);
                s->gzindex += copy;
                flush_pending(strm);
                if (s->pending != 0) {
                    s->last_flush = -1;
                    return Z_OK;
                }
                beg = 0;
                left -= copy;
            }
            zmemcpy(s->pending_buf + s->pending,
                    s->gzhead->extra + s->gzindex, left);
            s->pending += left;
            HCRC_UPDATE(beg);
            s->gzindex = 0;
        }
        s->status = NAME_STATE;
    }
    if (s->status == NAME_STATE) {
        if (s->gzhead->name != Z_NULL) {
            ulg beg = s->pending;   /* start of bytes to update crc */
            int val;
            do {
                if (s->pending == s->pending_buf_size) {
                    HCRC_UPDATE(beg);
                    flush_pending(strm);
                    if (s->pending != 0) {
                        s->last_flush = -1;
                        return Z_OK;
                    }
                    beg = 0;
                }
                val = s->gzhead->name[s->gzindex++];
                put_byte(s, val);
            } while (val != 0);
            HCRC_UPDATE(beg);
            s->gzindex = 0;
        }
        s->status = COMMENT_STATE;
    }
    if (s->status == COMMENT_STATE) {
        if (s->gzhead->comment != Z_NULL) {
            ulg beg = s->pending;   /* start of bytes to update crc */
            int val;
            do {
                if (s->pending == s->pending_buf_size) {
                    HCRC_UPDATE(beg);
                    flush_pending(strm);
                    if (s->pending != 0) {
                        s->last_flush = -1;
                        return Z_OK;
                    }
                    beg = 0;
                }
                val = s->gzhead->comment[s->gzindex++];
                put_byte(s, val);
            } while (val != 0);
            HCRC_UPDATE(beg);
        }
        s->status = HCRC_STATE;
    }
    if (s->status == HCRC_STATE) {
        if (s->gzhead->hcrc) {
            if (s->pending + 2 > s->pending_buf_size) {
                flush_pending(strm);
                if (s->pending != 0) {
                    s->last_flush = -1;
                    return Z_OK;
                }
            }
            put_byte(s, (Byte)(strm->adler & 0xff));
            put_byte(s, (Byte)((strm->adler >> 8) & 0xff));
            strm->adler = crc32(0L, Z_NULL, 0);
        }
        s->status = BUSY_STATE;

        /* Compression must start with an empty pending buffer */
        flush_pending(strm);
        if (s->pending != 0) {
            s->last_flush = -1;
            return Z_OK;
        }
    }
#endif

    /* Start a new block or continue the current one.
     */
    if (strm->avail_in != 0 || s->lookahead != 0 ||
        (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) {
        block_state bstate;

        bstate = s->level == 0 ? deflate_stored(s, flush) :
                 s->strategy == Z_HUFFMAN_ONLY ? deflate_huff(s, flush) :
                 s->strategy == Z_RLE ? deflate_rle(s, flush) :
                 (*(configuration_table[s->level].func))(s, flush);

        if (bstate == finish_started || bstate == finish_done) {
            s->status = FINISH_STATE;
        }
        if (bstate == need_more || bstate == finish_started) {
            if (strm->avail_out == 0) {
                s->last_flush = -1; /* avoid BUF_ERROR next call, see above */
            }
            return Z_OK;
            /* If flush != Z_NO_FLUSH && avail_out == 0, the next call
             * of deflate should use the same flush parameter to make sure
             * that the flush is complete. So we don't have to output an
             * empty block here, this will be done at next call. This also
             * ensures that for a very small output buffer, we emit at most
             * one empty block.
             */
        }
        if (bstate == block_done) {
            if (flush == Z_PARTIAL_FLUSH) {
                _tr_align(s);
            } else if (flush != Z_BLOCK) { /* FULL_FLUSH or SYNC_FLUSH */
                _tr_stored_block(s, (char*)0, 0L, 0);
                /* For a full flush, this empty block will be recognized
                 * as a special marker by inflate_sync().
                 */
                if (flush == Z_FULL_FLUSH) {
                    CLEAR_HASH(s);             /* forget history */
                    if (s->lookahead == 0) {
                        s->strstart = 0;
                        s->block_start = 0L;
                        s->insert = 0;
                    }
                }
            }
            flush_pending(strm);
            if (strm->avail_out == 0) {
              s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */
              return Z_OK;
            }
        }
    }

    if (flush != Z_FINISH) return Z_OK;
    if (s->wrap <= 0) return Z_STREAM_END;

    /* Write the trailer */
#ifdef GZIP
    if (s->wrap == 2) {
        put_byte(s, (Byte)(strm->adler & 0xff));
        put_byte(s, (Byte)((strm->adler >> 8) & 0xff));
        put_byte(s, (Byte)((strm->adler >> 16) & 0xff));
        put_byte(s, (Byte)((strm->adler >> 24) & 0xff));
        put_byte(s, (Byte)(strm->total_in & 0xff));
        put_byte(s, (Byte)((strm->total_in >> 8) & 0xff));
        put_byte(s, (Byte)((strm->total_in >> 16) & 0xff));
        put_byte(s, (Byte)((strm->total_in >> 24) & 0xff));
    }
    else
#endif
    {
        putShortMSB(s, (uInt)(strm->adler >> 16));
        putShortMSB(s, (uInt)(strm->adler & 0xffff));
    }
    flush_pending(strm);
    /* If avail_out is zero, the application will call deflate again
     * to flush the rest.
     */
    if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */
    return s->pending != 0 ? Z_OK : Z_STREAM_END;
}

/* ========================================================================= */
int ZEXPORT deflateEnd (strm)
    z_streamp strm;
{
    int status;

    if (deflateStateCheck(strm)) return Z_STREAM_ERROR;

    status = strm->state->status;

    /* Deallocate in reverse order of allocations: */
    TRY_FREE(strm, strm->state->pending_buf);
    TRY_FREE(strm, strm->state->head);
    TRY_FREE(strm, strm->state->prev);
    TRY_FREE(strm, strm->state->window);

    ZFREE(strm, strm->state);
    strm->state = Z_NULL;

    return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK;
}

/* =========================================================================
 * Copy the source state to the destination state.
 * To simplify the source, this is not supported for 16-bit MSDOS (which
 * doesn't have enough memory anyway to duplicate compression states).
 */
int ZEXPORT deflateCopy (dest, source)
    z_streamp dest;
    z_streamp source;
{
#ifdef MAXSEG_64K
    return Z_STREAM_ERROR;
#else
    deflate_state *ds;
    deflate_state *ss;
    ushf *overlay;


    if (deflateStateCheck(source) || dest == Z_NULL) {
        return Z_STREAM_ERROR;
    }

    ss = source->state;

    zmemcpy((voidpf)dest, (voidpf)source, sizeof(z_stream));

    ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state));
    if (ds == Z_NULL) return Z_MEM_ERROR;
    dest->state = (struct internal_state FAR *) ds;
    zmemcpy((voidpf)ds, (voidpf)ss, sizeof(deflate_state));
    ds->strm = dest;

    ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte));
    ds->prev   = (Posf *)  ZALLOC(dest, ds->w_size, sizeof(Pos));
    ds->head   = (Posf *)  ZALLOC(dest, ds->hash_size, sizeof(Pos));
    overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2);
    ds->pending_buf = (uchf *) overlay;

    if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL ||
        ds->pending_buf == Z_NULL) {
        deflateEnd (dest);
        return Z_MEM_ERROR;
    }
    /* following zmemcpy do not work for 16-bit MSDOS */
    zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte));
    zmemcpy((voidpf)ds->prev, (voidpf)ss->prev, ds->w_size * sizeof(Pos));
    zmemcpy((voidpf)ds->head, (voidpf)ss->head, ds->hash_size * sizeof(Pos));
    zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size);

    ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf);
    ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush);
    ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize;

    ds->l_desc.dyn_tree = ds->dyn_ltree;
    ds->d_desc.dyn_tree = ds->dyn_dtree;
    ds->bl_desc.dyn_tree = ds->bl_tree;

    return Z_OK;
#endif /* MAXSEG_64K */
}

/* ===========================================================================
 * Read a new buffer from the current input stream, update the adler32
 * and total number of bytes read.  All deflate() input goes through
 * this function so some applications may wish to modify it to avoid
 * allocating a large strm->next_in buffer and copying from it.
 * (See also flush_pending()).
 */
local unsigned read_buf(strm, buf, size)
    z_streamp strm;
    Bytef *buf;
    unsigned size;
{
    unsigned len = strm->avail_in;

    if (len > size) len = size;
    if (len == 0) return 0;

    strm->avail_in  -= len;

    zmemcpy(buf, strm->next_in, len);
    if (strm->state->wrap == 1) {
        strm->adler = adler32(strm->adler, buf, len);
    }
#ifdef GZIP
    else if (strm->state->wrap == 2) {
        strm->adler = crc32(strm->adler, buf, len);
    }
#endif
    strm->next_in  += len;
    strm->total_in += len;

    return len;
}

/* ===========================================================================
 * Initialize the "longest match" routines for a new zlib stream
 */
local void lm_init (s)
    deflate_state *s;
{
    s->window_size = (ulg)2L*s->w_size;

    CLEAR_HASH(s);

    /* Set the default configuration parameters:
     */
    s->max_lazy_match   = configuration_table[s->level].max_lazy;
    s->good_match       = configuration_table[s->level].good_length;
    s->nice_match       = configuration_table[s->level].nice_length;
    s->max_chain_length = configuration_table[s->level].max_chain;

    s->strstart = 0;
    s->block_start = 0L;
    s->lookahead = 0;
    s->insert = 0;
    s->match_length = s->prev_length = MIN_MATCH-1;
    s->match_available = 0;
    s->ins_h = 0;
#ifndef FASTEST
#ifdef ASMV
    match_init(); /* initialize the asm code */
#endif
#endif
}

#ifndef FASTEST
/* ===========================================================================
 * Set match_start to the longest match starting at the given string and
 * return its length. Matches shorter or equal to prev_length are discarded,
 * in which case the result is equal to prev_length and match_start is
 * garbage.
 * IN assertions: cur_match is the head of the hash chain for the current
 *   string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1
 * OUT assertion: the match length is not greater than s->lookahead.
 */
#ifndef ASMV
/* For 80x86 and 680x0, an optimized version will be provided in match.asm or
 * match.S. The code will be functionally equivalent.
 */
local uInt longest_match(s, cur_match)
    deflate_state *s;
    IPos cur_match;                             /* current match */
{
    unsigned chain_length = s->max_chain_length;/* max hash chain length */
    register Bytef *scan = s->window + s->strstart; /* current string */
    register Bytef *match;                      /* matched string */
    register int len;                           /* length of current match */
    int best_len = (int)s->prev_length;         /* best match length so far */
    int nice_match = s->nice_match;             /* stop if match long enough */
    IPos limit = s->strstart > (IPos)MAX_DIST(s) ?
        s->strstart - (IPos)MAX_DIST(s) : NIL;
    /* Stop when cur_match becomes <= limit. To simplify the code,
     * we prevent matches with the string of window index 0.
     */
    Posf *prev = s->prev;
    uInt wmask = s->w_mask;

#ifdef UNALIGNED_OK
    /* Compare two bytes at a time. Note: this is not always beneficial.
     * Try with and without -DUNALIGNED_OK to check.
     */
    register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1;
    register ush scan_start = *(ushf*)scan;
    register ush scan_end   = *(ushf*)(scan+best_len-1);
#else
    register Bytef *strend = s->window + s->strstart + MAX_MATCH;
    register Byte scan_end1  = scan[best_len-1];
    register Byte scan_end   = scan[best_len];
#endif

    /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
     * It is easy to get rid of this optimization if necessary.
     */
    Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever");

    /* Do not waste too much time if we already have a good match: */
    if (s->prev_length >= s->good_match) {
        chain_length >>= 2;
    }
    /* Do not look for matches beyond the end of the input. This is necessary
     * to make deflate deterministic.
     */
    if ((uInt)nice_match > s->lookahead) nice_match = (int)s->lookahead;

    Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead");

    do {
        Assert(cur_match < s->strstart, "no future");
        match = s->window + cur_match;

        /* Skip to next match if the match length cannot increase
         * or if the match length is less than 2.  Note that the checks below
         * for insufficient lookahead only occur occasionally for performance
         * reasons.  Therefore uninitialized memory will be accessed, and
         * conditional jumps will be made that depend on those values.
         * However the length of the match is limited to the lookahead, so
         * the output of deflate is not affected by the uninitialized values.
         */
#if (defined(UNALIGNED_OK) && MAX_MATCH == 258)
        /* This code assumes sizeof(unsigned short) == 2. Do not use
         * UNALIGNED_OK if your compiler uses a different size.
         */
        if (*(ushf*)(match+best_len-1) != scan_end ||
            *(ushf*)match != scan_start) continue;

        /* It is not necessary to compare scan[2] and match[2] since they are
         * always equal when the other bytes match, given that the hash keys
         * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at
         * strstart+3, +5, ... up to strstart+257. We check for insufficient
         * lookahead only every 4th comparison; the 128th check will be made
         * at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is
         * necessary to put more guard bytes at the end of the window, or
         * to check more often for insufficient lookahead.
         */
        Assert(scan[2] == match[2], "scan[2]?");
        scan++, match++;
        do {
        } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
                 *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
                 *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
                 *(ushf*)(scan+=2) == *(ushf*)(match+=2) &&
                 scan < strend);
        /* The funny "do {}" generates better code on most compilers */

        /* Here, scan <= window+strstart+257 */
        Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");
        if (*scan == *match) scan++;

        len = (MAX_MATCH - 1) - (int)(strend-scan);
        scan = strend - (MAX_MATCH-1);

#else /* UNALIGNED_OK */

        if (match[best_len]   != scan_end  ||
            match[best_len-1] != scan_end1 ||
            *match            != *scan     ||
            *++match          != scan[1])      continue;

        /* The check at best_len-1 can be removed because it will be made
         * again later. (This heuristic is not always a win.)
         * It is not necessary to compare scan[2] and match[2] since they
         * are always equal when the other bytes match, given that
         * the hash keys are equal and that HASH_BITS >= 8.
         */
        scan += 2, match++;
        Assert(*scan == *match, "match[2]?");

        /* We check for insufficient lookahead only every 8th comparison;
         * the 256th check will be made at strstart+258.
         */
        do {
        } while (*++scan == *++match && *++scan == *++match &&
                 *++scan == *++match && *++scan == *++match &&
                 *++scan == *++match && *++scan == *++match &&
                 *++scan == *++match && *++scan == *++match &&
                 scan < strend);

        Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");

        len = MAX_MATCH - (int)(strend - scan);
        scan = strend - MAX_MATCH;

#endif /* UNALIGNED_OK */

        if (len > best_len) {
            s->match_start = cur_match;
            best_len = len;
            if (len >= nice_match) break;
#ifdef UNALIGNED_OK
            scan_end = *(ushf*)(scan+best_len-1);
#else
            scan_end1  = scan[best_len-1];
            scan_end   = scan[best_len];
#endif
        }
    } while ((cur_match = prev[cur_match & wmask]) > limit
             && --chain_length != 0);

    if ((uInt)best_len <= s->lookahead) return (uInt)best_len;
    return s->lookahead;
}
#endif /* ASMV */

#else /* FASTEST */

/* ---------------------------------------------------------------------------
 * Optimized version for FASTEST only
 */
local uInt longest_match(s, cur_match)
    deflate_state *s;
    IPos cur_match;                             /* current match */
{
    register Bytef *scan = s->window + s->strstart; /* current string */
    register Bytef *match;                       /* matched string */
    register int len;                           /* length of current match */
    register Bytef *strend = s->window + s->strstart + MAX_MATCH;

    /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16.
     * It is easy to get rid of this optimization if necessary.
     */
    Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever");

    Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead");

    Assert(cur_match < s->strstart, "no future");

    match = s->window + cur_match;

    /* Return failure if the match length is less than 2:
     */
    if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1;

    /* The check at best_len-1 can be removed because it will be made
     * again later. (This heuristic is not always a win.)
     * It is not necessary to compare scan[2] and match[2] since they
     * are always equal when the other bytes match, given that
     * the hash keys are equal and that HASH_BITS >= 8.
     */
    scan += 2, match += 2;
    Assert(*scan == *match, "match[2]?");

    /* We check for insufficient lookahead only every 8th comparison;
     * the 256th check will be made at strstart+258.
     */
    do {
    } while (*++scan == *++match && *++scan == *++match &&
             *++scan == *++match && *++scan == *++match &&
             *++scan == *++match && *++scan == *++match &&
             *++scan == *++match && *++scan == *++match &&
             scan < strend);

    Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan");

    len = MAX_MATCH - (int)(strend - scan);

    if (len < MIN_MATCH) return MIN_MATCH - 1;

    s->match_start = cur_match;
    return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead;
}

#endif /* FASTEST */

#ifdef ZLIB_DEBUG

#define EQUAL 0
/* result of memcmp for equal strings */

/* ===========================================================================
 * Check that the match at match_start is indeed a match.
 */
local void check_match(s, start, match, length)
    deflate_state *s;
    IPos start, match;
    int length;
{
    /* check that the match is indeed a match */
    if (zmemcmp(s->window + match,
                s->window + start, length) != EQUAL) {
        fprintf(stderr, " start %u, match %u, length %d\n",
                start, match, length);
        do {
            fprintf(stderr, "%c%c", s->window[match++], s->window[start++]);
        } while (--length != 0);
        z_error("invalid match");
    }
    if (z_verbose > 1) {
        fprintf(stderr,"\\[%d,%d]", start-match, length);
        do { putc(s->window[start++], stderr); } while (--length != 0);
    }
}
#else
#  define check_match(s, start, match, length)
#endif /* ZLIB_DEBUG */

/* ===========================================================================
 * Fill the window when the lookahead becomes insufficient.
 * Updates strstart and lookahead.
 *
 * IN assertion: lookahead < MIN_LOOKAHEAD
 * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD
 *    At least one byte has been read, or avail_in == 0; reads are
 *    performed for at least two bytes (required for the zip translate_eol
 *    option -- not supported here).
 */
local void fill_window(s)
    deflate_state *s;
{
    unsigned n;
    unsigned more;    /* Amount of free space at the end of the window. */
    uInt wsize = s->w_size;

    Assert(s->lookahead < MIN_LOOKAHEAD, "already enough lookahead");

    do {
        more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart);

        /* Deal with !@#$% 64K limit: */
        if (sizeof(int) <= 2) {
            if (more == 0 && s->strstart == 0 && s->lookahead == 0) {
                more = wsize;

            } else if (more == (unsigned)(-1)) {
                /* Very unlikely, but possible on 16 bit machine if
                 * strstart == 0 && lookahead == 1 (input done a byte at time)
                 */
                more--;
            }
        }

        /* If the window is almost full and there is insufficient lookahead,
         * move the upper half to the lower one to make room in the upper half.
         */
        if (s->strstart >= wsize+MAX_DIST(s)) {

            zmemcpy(s->window, s->window+wsize, (unsigned)wsize - more);
            s->match_start -= wsize;
            s->strstart    -= wsize; /* we now have strstart >= MAX_DIST */
            s->block_start -= (long) wsize;
            slide_hash(s);
            more += wsize;
        }
        if (s->strm->avail_in == 0) break;

        /* If there was no sliding:
         *    strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 &&
         *    more == window_size - lookahead - strstart
         * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1)
         * => more >= window_size - 2*WSIZE + 2
         * In the BIG_MEM or MMAP case (not yet supported),
         *   window_size == input_size + MIN_LOOKAHEAD  &&
         *   strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD.
         * Otherwise, window_size == 2*WSIZE so more >= 2.
         * If there was sliding, more >= WSIZE. So in all cases, more >= 2.
         */
        Assert(more >= 2, "more < 2");

        n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more);
        s->lookahead += n;

        /* Initialize the hash value now that we have some input: */
        if (s->lookahead + s->insert >= MIN_MATCH) {
            uInt str = s->strstart - s->insert;
            s->ins_h = s->window[str];
            UPDATE_HASH(s, s->ins_h, s->window[str + 1]);
#if MIN_MATCH != 3
            Call UPDATE_HASH() MIN_MATCH-3 more times
#endif
            while (s->insert) {
                UPDATE_HASH(s, s->ins_h, s->window[str + MIN_MATCH-1]);
#ifndef FASTEST
                s->prev[str & s->w_mask] = s->head[s->ins_h];
#endif
                s->head[s->ins_h] = (Pos)str;
                str++;
                s->insert--;
                if (s->lookahead + s->insert < MIN_MATCH)
                    break;
            }
        }
        /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage,
         * but this is not important since only literal bytes will be emitted.
         */

    } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0);

    /* If the WIN_INIT bytes after the end of the current data have never been
     * written, then zero those bytes in order to avoid memory check reports of
     * the use of uninitialized (or uninitialised as Julian writes) bytes by
     * the longest match routines.  Update the high water mark for the next
     * time through here.  WIN_INIT is set to MAX_MATCH since the longest match
     * routines allow scanning to strstart + MAX_MATCH, ignoring lookahead.
     */
    if (s->high_water < s->window_size) {
        ulg curr = s->strstart + (ulg)(s->lookahead);
        ulg init;

        if (s->high_water < curr) {
            /* Previous high water mark below current data -- zero WIN_INIT
             * bytes or up to end of window, whichever is less.
             */
            init = s->window_size - curr;
            if (init > WIN_INIT)
                init = WIN_INIT;
            zmemzero(s->window + curr, (unsigned)init);
            s->high_water = curr + init;
        }
        else if (s->high_water < (ulg)curr + WIN_INIT) {
            /* High water mark at or above current data, but below current data
             * plus WIN_INIT -- zero out to current data plus WIN_INIT, or up
             * to end of window, whichever is less.
             */
            init = (ulg)curr + WIN_INIT - s->high_water;
            if (init > s->window_size - s->high_water)
                init = s->window_size - s->high_water;
            zmemzero(s->window + s->high_water, (unsigned)init);
            s->high_water += init;
        }
    }

    Assert((ulg)s->strstart <= s->window_size - MIN_LOOKAHEAD,
           "not enough room for search");
}

/* ===========================================================================
 * Flush the current block, with given end-of-file flag.
 * IN assertion: strstart is set to the end of the current match.
 */
#define FLUSH_BLOCK_ONLY(s, last) { \
   _tr_flush_block(s, (s->block_start >= 0L ? \
                   (charf *)&s->window[(unsigned)s->block_start] : \
                   (charf *)Z_NULL), \
                (ulg)((long)s->strstart - s->block_start), \
                (last)); \
   s->block_start = s->strstart; \
   flush_pending(s->strm); \
   Tracev((stderr,"[FLUSH]")); \
}

/* Same but force premature exit if necessary. */
#define FLUSH_BLOCK(s, last) { \
   FLUSH_BLOCK_ONLY(s, last); \
   if (s->strm->avail_out == 0) return (last) ? finish_started : need_more; \
}

/* Maximum stored block length in deflate format (not including header). */
#define MAX_STORED 65535

/* Minimum of a and b. */
#define MIN(a, b) ((a) > (b) ? (b) : (a))

/* ===========================================================================
 * Copy without compression as much as possible from the input stream, return
 * the current block state.
 *
 * In case deflateParams() is used to later switch to a non-zero compression
 * level, s->matches (otherwise unused when storing) keeps track of the number
 * of hash table slides to perform. If s->matches is 1, then one hash table
 * slide will be done when switching. If s->matches is 2, the maximum value
 * allowed here, then the hash table will be cleared, since two or more slides
 * is the same as a clear.
 *
 * deflate_stored() is written to minimize the number of times an input byte is
 * copied. It is most efficient with large input and output buffers, which
 * maximizes the opportunites to have a single copy from next_in to next_out.
 */
local block_state deflate_stored(s, flush)
    deflate_state *s;
    int flush;
{
    /* Smallest worthy block size when not flushing or finishing. By default
     * this is 32K. This can be as small as 507 bytes for memLevel == 1. For
     * large input and output buffers, the stored block size will be larger.
     */
    unsigned min_block = MIN(s->pending_buf_size - 5, s->w_size);

    /* Copy as many min_block or larger stored blocks directly to next_out as
     * possible. If flushing, copy the remaining available input to next_out as
     * stored blocks, if there is enough space.
     */
    unsigned len, left, have, last = 0;
    unsigned used = s->strm->avail_in;
    do {
        /* Set len to the maximum size block that we can copy directly with the
         * available input data and output space. Set left to how much of that
         * would be copied from what's left in the window.
         */
        len = MAX_STORED;       /* maximum deflate stored block length */
        have = (s->bi_valid + 42) >> 3;         /* number of header bytes */
        if (s->strm->avail_out < have)          /* need room for header */
            break;
            /* maximum stored block length that will fit in avail_out: */
        have = s->strm->avail_out - have;
        left = s->strstart - s->block_start;    /* bytes left in window */
        if (len > (ulg)left + s->strm->avail_in)
            len = left + s->strm->avail_in;     /* limit len to the input */
        if (len > have)
            len = have;                         /* limit len to the output */

        /* If the stored block would be less than min_block in length, or if
         * unable to copy all of the available input when flushing, then try
         * copying to the window and the pending buffer instead. Also don't
         * write an empty block when flushing -- deflate() does that.
         */
        if (len < min_block && ((len == 0 && flush != Z_FINISH) ||
                                flush == Z_NO_FLUSH ||
                                len != left + s->strm->avail_in))
            break;

        /* Make a dummy stored block in pending to get the header bytes,
         * including any pending bits. This also updates the debugging counts.
         */
        last = flush == Z_FINISH && len == left + s->strm->avail_in ? 1 : 0;
        _tr_stored_block(s, (char *)0, 0L, last);

        /* Replace the lengths in the dummy stored block with len. */
        s->pending_buf[s->pending - 4] = len;
        s->pending_buf[s->pending - 3] = len >> 8;
        s->pending_buf[s->pending - 2] = ~len;
        s->pending_buf[s->pending - 1] = ~len >> 8;

        /* Write the stored block header bytes. */
        flush_pending(s->strm);

#ifdef ZLIB_DEBUG
        /* Update debugging counts for the data about to be copied. */
        s->compressed_len += len << 3;
        s->bits_sent += len << 3;
#endif

        /* Copy uncompressed bytes from the window to next_out. */
        if (left) {
            if (left > len)
                left = len;
            zmemcpy(s->strm->next_out, s->window + s->block_start, left);
            s->strm->next_out += left;
            s->strm->avail_out -= left;
            s->strm->total_out += left;
            s->block_start += left;
            len -= left;
        }

        /* Copy uncompressed bytes directly from next_in to next_out, updating
         * the check value.
         */
        if (len) {
            read_buf(s->strm, s->strm->next_out, len);
            s->strm->next_out += len;
            s->strm->avail_out -= len;
            s->strm->total_out += len;
        }
    } while (last == 0);

    /* Update the sliding window with the last s->w_size bytes of the copied
     * data, or append all of the copied data to the existing window if less
     * than s->w_size bytes were copied. Also update the number of bytes to
     * insert in the hash tables, in the event that deflateParams() switches to
     * a non-zero compression level.
     */
    used -= s->strm->avail_in;      /* number of input bytes directly copied */
    if (used) {
        /* If any input was used, then no unused input remains in the window,
         * therefore s->block_start == s->strstart.
         */
        if (used >= s->w_size) {    /* supplant the previous history */
            s->matches = 2;         /* clear hash */
            zmemcpy(s->window, s->strm->next_in - s->w_size, s->w_size);
            s->strstart = s->w_size;
        }
        else {
            if (s->window_size - s->strstart <= used) {
                /* Slide the window down. */
                s->strstart -= s->w_size;
                zmemcpy(s->window, s->window + s->w_size, s->strstart);
                if (s->matches < 2)
                    s->matches++;   /* add a pending slide_hash() */
            }
            zmemcpy(s->window + s->strstart, s->strm->next_in - used, used);
            s->strstart += used;
        }
        s->block_start = s->strstart;
        s->insert += MIN(used, s->w_size - s->insert);
    }
    if (s->high_water < s->strstart)
        s->high_water = s->strstart;

    /* If the last block was written to next_out, then done. */
    if (last)
        return finish_done;

    /* If flushing and all input has been consumed, then done. */
    if (flush != Z_NO_FLUSH && flush != Z_FINISH &&
        s->strm->avail_in == 0 && (long)s->strstart == s->block_start)
        return block_done;

    /* Fill the window with any remaining input. */
    have = s->window_size - s->strstart - 1;
    if (s->strm->avail_in > have && s->block_start >= (long)s->w_size) {
        /* Slide the window down. */
        s->block_start -= s->w_size;
        s->strstart -= s->w_size;
        zmemcpy(s->window, s->window + s->w_size, s->strstart);
        if (s->matches < 2)
            s->matches++;           /* add a pending slide_hash() */
        have += s->w_size;          /* more space now */
    }
    if (have > s->strm->avail_in)
        have = s->strm->avail_in;
    if (have) {
        read_buf(s->strm, s->window + s->strstart, have);
        s->strstart += have;
    }
    if (s->high_water < s->strstart)
        s->high_water = s->strstart;

    /* There was not enough avail_out to write a complete worthy or flushed
     * stored block to next_out. Write a stored block to pending instead, if we
     * have enough input for a worthy block, or if flushing and there is enough
     * room for the remaining input as a stored block in the pending buffer.
     */
    have = (s->bi_valid + 42) >> 3;         /* number of header bytes */
        /* maximum stored block length that will fit in pending: */
    have = MIN(s->pending_buf_size - have, MAX_STORED);
    min_block = MIN(have, s->w_size);
    left = s->strstart - s->block_start;
    if (left >= min_block ||
        ((left || flush == Z_FINISH) && flush != Z_NO_FLUSH &&
         s->strm->avail_in == 0 && left <= have)) {
        len = MIN(left, have);
        last = flush == Z_FINISH && s->strm->avail_in == 0 &&
               len == left ? 1 : 0;
        _tr_stored_block(s, (charf *)s->window + s->block_start, len, last);
        s->block_start += len;
        flush_pending(s->strm);
    }

    /* We've done all we can with the available input and output. */
    return last ? finish_started : need_more;
}

/* ===========================================================================
 * Compress as much as possible from the input stream, return the current
 * block state.
 * This function does not perform lazy evaluation of matches and inserts
 * new strings in the dictionary only for unmatched strings or for short
 * matches. It is used only for the fast compression options.
 */
local block_state deflate_fast(s, flush)
    deflate_state *s;
    int flush;
{
    IPos hash_head;       /* head of the hash chain */
    int bflush;           /* set if current block must be flushed */

    for (;;) {
        /* Make sure that we always have enough lookahead, except
         * at the end of the input file. We need MAX_MATCH bytes
         * for the next match, plus MIN_MATCH bytes to insert the
         * string following the next match.
         */
        if (s->lookahead < MIN_LOOKAHEAD) {
            fill_window(s);
            if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) {
                return need_more;
            }
            if (s->lookahead == 0) break; /* flush the current block */
        }

        /* Insert the string window[strstart .. strstart+2] in the
         * dictionary, and set hash_head to the head of the hash chain:
         */
        hash_head = NIL;
        if (s->lookahead >= MIN_MATCH) {
            INSERT_STRING(s, s->strstart, hash_head);
        }

        /* Find the longest match, discarding those <= prev_length.
         * At this point we have always match_length < MIN_MATCH
         */
        if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) {
            /* To simplify the code, we prevent matches with the string
             * of window index 0 (in particular we have to avoid a match
             * of the string with itself at the start of the input file).
             */
            s->match_length = longest_match (s, hash_head);
            /* longest_match() sets match_start */
        }
        if (s->match_length >= MIN_MATCH) {
            check_match(s, s->strstart, s->match_start, s->match_length);

            _tr_tally_dist(s, s->strstart - s->match_start,
                           s->match_length - MIN_MATCH, bflush);

            s->lookahead -= s->match_length;

            /* Insert new strings in the hash table only if the match length
             * is not too large. This saves time but degrades compression.
             */
#ifndef FASTEST
            if (s->match_length <= s->max_insert_length &&
                s->lookahead >= MIN_MATCH) {
                s->match_length--; /* string at strstart already in table */
                do {
                    s->strstart++;
                    INSERT_STRING(s, s->strstart, hash_head);
                    /* strstart never exceeds WSIZE-MAX_MATCH, so there are
                     * always MIN_MATCH bytes ahead.
                     */
                } while (--s->match_length != 0);
                s->strstart++;
            } else
#endif
            {
                s->strstart += s->match_length;
                s->match_length = 0;
                s->ins_h = s->window[s->strstart];
                UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]);
#if MIN_MATCH != 3
                Call UPDATE_HASH() MIN_MATCH-3 more times
#endif
                /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not
                 * matter since it will be recomputed at next deflate call.
                 */
            }
        } else {
            /* No match, output a literal byte */
            Tracevv((stderr,"%c", s->window[s->strstart]));
            _tr_tally_lit (s, s->window[s->strstart], bflush);
            s->lookahead--;
            s->strstart++;
        }
        if (bflush) FLUSH_BLOCK(s, 0);
    }
    s->insert = s->strstart < MIN_MATCH-1 ? s->strstart : MIN_MATCH-1;
    if (flush == Z_FINISH) {
        FLUSH_BLOCK(s, 1);
        return finish_done;
    }
    if (s->last_lit)
        FLUSH_BLOCK(s, 0);
    return block_done;
}

#ifndef FASTEST
/* ===========================================================================
 * Same as above, but achieves better compression. We use a lazy
 * evaluation for matches: a match is finally adopted only if there is
 * no better match at the next window position.
 */
local block_state deflate_slow(s, flush)
    deflate_state *s;
    int flush;
{
    IPos hash_head;          /* head of hash chain */
    int bflush;              /* set if current block must be flushed */

    /* Process the input block. */
    for (;;) {
        /* Make sure that we always have enough lookahead, except
         * at the end of the input file. We need MAX_MATCH bytes
         * for the next match, plus MIN_MATCH bytes to insert the
         * string following the next match.
         */
        if (s->lookahead < MIN_LOOKAHEAD) {
            fill_window(s);
            if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) {
                return need_more;
            }
            if (s->lookahead == 0) break; /* flush the current block */
        }

        /* Insert the string window[strstart .. strstart+2] in the
         * dictionary, and set hash_head to the head of the hash chain:
         */
        hash_head = NIL;
        if (s->lookahead >= MIN_MATCH) {
            INSERT_STRING(s, s->strstart, hash_head);
        }

        /* Find the longest match, discarding those <= prev_length.
         */
        s->prev_length = s->match_length, s->prev_match = s->match_start;
        s->match_length = MIN_MATCH-1;

        if (hash_head != NIL && s->prev_length < s->max_lazy_match &&
            s->strstart - hash_head <= MAX_DIST(s)) {
            /* To simplify the code, we prevent matches with the string
             * of window index 0 (in particular we have to avoid a match
             * of the string with itself at the start of the input file).
             */
            s->match_length = longest_match (s, hash_head);
            /* longest_match() sets match_start */

            if (s->match_length <= 5 && (s->strategy == Z_FILTERED
#if TOO_FAR <= 32767
                || (s->match_length == MIN_MATCH &&
                    s->strstart - s->match_start > TOO_FAR)
#endif
                )) {

                /* If prev_match is also MIN_MATCH, match_start is garbage
                 * but we will ignore the current match anyway.
                 */
                s->match_length = MIN_MATCH-1;
            }
        }
        /* If there was a match at the previous step and the current
         * match is not better, output the previous match:
         */
        if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) {
            uInt max_insert = s->strstart + s->lookahead - MIN_MATCH;
            /* Do not insert strings in hash table beyond this. */

            check_match(s, s->strstart-1, s->prev_match, s->prev_length);

            _tr_tally_dist(s, s->strstart -1 - s->prev_match,
                           s->prev_length - MIN_MATCH, bflush);

            /* Insert in hash table all strings up to the end of the match.
             * strstart-1 and strstart are already inserted. If there is not
             * enough lookahead, the last two strings are not inserted in
             * the hash table.
             */
            s->lookahead -= s->prev_length-1;
            s->prev_length -= 2;
            do {
                if (++s->strstart <= max_insert) {
                    INSERT_STRING(s, s->strstart, hash_head);
                }
            } while (--s->prev_length != 0);
            s->match_available = 0;
            s->match_length = MIN_MATCH-1;
            s->strstart++;

            if (bflush) FLUSH_BLOCK(s, 0);

        } else if (s->match_available) {
            /* If there was no match at the previous position, output a
             * single literal. If there was a match but the current match
             * is longer, truncate the previous match to a single literal.
             */
            Tracevv((stderr,"%c", s->window[s->strstart-1]));
            _tr_tally_lit(s, s->window[s->strstart-1], bflush);
            if (bflush) {
                FLUSH_BLOCK_ONLY(s, 0);
            }
            s->strstart++;
            s->lookahead--;
            if (s->strm->avail_out == 0) return need_more;
        } else {
            /* There is no previous match to compare with, wait for
             * the next step to decide.
             */
            s->match_available = 1;
            s->strstart++;
            s->lookahead--;
        }
    }
    Assert (flush != Z_NO_FLUSH, "no flush?");
    if (s->match_available) {
        Tracevv((stderr,"%c", s->window[s->strstart-1]));
        _tr_tally_lit(s, s->window[s->strstart-1], bflush);
        s->match_available = 0;
    }
    s->insert = s->strstart < MIN_MATCH-1 ? s->strstart : MIN_MATCH-1;
    if (flush == Z_FINISH) {
        FLUSH_BLOCK(s, 1);
        return finish_done;
    }
    if (s->last_lit)
        FLUSH_BLOCK(s, 0);
    return block_done;
}
#endif /* FASTEST */

/* ===========================================================================
 * For Z_RLE, simply look for runs of bytes, generate matches only of distance
 * one.  Do not maintain a hash table.  (It will be regenerated if this run of
 * deflate switches away from Z_RLE.)
 */
local block_state deflate_rle(s, flush)
    deflate_state *s;
    int flush;
{
    int bflush;             /* set if current block must be flushed */
    uInt prev;              /* byte at distance one to match */
    Bytef *scan, *strend;   /* scan goes up to strend for length of run */

    for (;;) {
        /* Make sure that we always have enough lookahead, except
         * at the end of the input file. We need MAX_MATCH bytes
         * for the longest run, plus one for the unrolled loop.
         */
        if (s->lookahead <= MAX_MATCH) {
            fill_window(s);
            if (s->lookahead <= MAX_MATCH && flush == Z_NO_FLUSH) {
                return need_more;
            }
            if (s->lookahead == 0) break; /* flush the current block */
        }

        /* See how many times the previous byte repeats */
        s->match_length = 0;
        if (s->lookahead >= MIN_MATCH && s->strstart > 0) {
            scan = s->window + s->strstart - 1;
            prev = *scan;
            if (prev == *++scan && prev == *++scan && prev == *++scan) {
                strend = s->window + s->strstart + MAX_MATCH;
                do {
                } while (prev == *++scan && prev == *++scan &&
                         prev == *++scan && prev == *++scan &&
                         prev == *++scan && prev == *++scan &&
                         prev == *++scan && prev == *++scan &&
                         scan < strend);
                s->match_length = MAX_MATCH - (uInt)(strend - scan);
                if (s->match_length > s->lookahead)
                    s->match_length = s->lookahead;
            }
            Assert(scan <= s->window+(uInt)(s->window_size-1), "wild scan");
        }

        /* Emit match if have run of MIN_MATCH or longer, else emit literal */
        if (s->match_length >= MIN_MATCH) {
            check_match(s, s->strstart, s->strstart - 1, s->match_length);

            _tr_tally_dist(s, 1, s->match_length - MIN_MATCH, bflush);

            s->lookahead -= s->match_length;
            s->strstart += s->match_length;
            s->match_length = 0;
        } else {
            /* No match, output a literal byte */
            Tracevv((stderr,"%c", s->window[s->strstart]));
            _tr_tally_lit (s, s->window[s->strstart], bflush);
            s->lookahead--;
            s->strstart++;
        }
        if (bflush) FLUSH_BLOCK(s, 0);
    }
    s->insert = 0;
    if (flush == Z_FINISH) {
        FLUSH_BLOCK(s, 1);
        return finish_done;
    }
    if (s->last_lit)
        FLUSH_BLOCK(s, 0);
    return block_done;
}

/* ===========================================================================
 * For Z_HUFFMAN_ONLY, do not look for matches.  Do not maintain a hash table.
 * (It will be regenerated if this run of deflate switches away from Huffman.)
 */
local block_state deflate_huff(s, flush)
    deflate_state *s;
    int flush;
{
    int bflush;             /* set if current block must be flushed */

    for (;;) {
        /* Make sure that we have a literal to write. */
        if (s->lookahead == 0) {
            fill_window(s);
            if (s->lookahead == 0) {
                if (flush == Z_NO_FLUSH)
                    return need_more;
                break;      /* flush the current block */
            }
        }

        /* Output a literal byte */
        s->match_length = 0;
        Tracevv((stderr,"%c", s->window[s->strstart]));
        _tr_tally_lit (s, s->window[s->strstart], bflush);
        s->lookahead--;
        s->strstart++;
        if (bflush) FLUSH_BLOCK(s, 0);
    }
    s->insert = 0;
    if (flush == Z_FINISH) {
        FLUSH_BLOCK(s, 1);
        return finish_done;
    }
    if (s->last_lit)
        FLUSH_BLOCK(s, 0);
    return block_done;
}

Deleted compat/zlib/deflate.h.

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





























































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* deflate.h -- internal compression state
 * Copyright (C) 1995-2016 Jean-loup Gailly
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* WARNING: this file should *not* be used by applications. It is
   part of the implementation of the compression library and is
   subject to change. Applications should only use zlib.h.
 */

/* @(#) $Id$ */

#ifndef DEFLATE_H
#define DEFLATE_H

#include "zutil.h"

/* define NO_GZIP when compiling if you want to disable gzip header and
   trailer creation by deflate().  NO_GZIP would be used to avoid linking in
   the crc code when it is not needed.  For shared libraries, gzip encoding
   should be left enabled. */
#ifndef NO_GZIP
#  define GZIP
#endif

/* ===========================================================================
 * Internal compression state.
 */

#define LENGTH_CODES 29
/* number of length codes, not counting the special END_BLOCK code */

#define LITERALS  256
/* number of literal bytes 0..255 */

#define L_CODES (LITERALS+1+LENGTH_CODES)
/* number of Literal or Length codes, including the END_BLOCK code */

#define D_CODES   30
/* number of distance codes */

#define BL_CODES  19
/* number of codes used to transfer the bit lengths */

#define HEAP_SIZE (2*L_CODES+1)
/* maximum heap size */

#define MAX_BITS 15
/* All codes must not exceed MAX_BITS bits */

#define Buf_size 16
/* size of bit buffer in bi_buf */

#define INIT_STATE    42    /* zlib header -> BUSY_STATE */
#ifdef GZIP
#  define GZIP_STATE  57    /* gzip header -> BUSY_STATE | EXTRA_STATE */
#endif
#define EXTRA_STATE   69    /* gzip extra block -> NAME_STATE */
#define NAME_STATE    73    /* gzip file name -> COMMENT_STATE */
#define COMMENT_STATE 91    /* gzip comment -> HCRC_STATE */
#define HCRC_STATE   103    /* gzip header CRC -> BUSY_STATE */
#define BUSY_STATE   113    /* deflate -> FINISH_STATE */
#define FINISH_STATE 666    /* stream complete */
/* Stream status */


/* Data structure describing a single value and its code string. */
typedef struct ct_data_s {
    union {
        ush  freq;       /* frequency count */
        ush  code;       /* bit string */
    } fc;
    union {
        ush  dad;        /* father node in Huffman tree */
        ush  len;        /* length of bit string */
    } dl;
} FAR ct_data;

#define Freq fc.freq
#define Code fc.code
#define Dad  dl.dad
#define Len  dl.len

typedef struct static_tree_desc_s  static_tree_desc;

typedef struct tree_desc_s {
    ct_data *dyn_tree;           /* the dynamic tree */
    int     max_code;            /* largest code with non zero frequency */
    const static_tree_desc *stat_desc;  /* the corresponding static tree */
} FAR tree_desc;

typedef ush Pos;
typedef Pos FAR Posf;
typedef unsigned IPos;

/* A Pos is an index in the character window. We use short instead of int to
 * save space in the various tables. IPos is used only for parameter passing.
 */

typedef struct internal_state {
    z_streamp strm;      /* pointer back to this zlib stream */
    int   status;        /* as the name implies */
    Bytef *pending_buf;  /* output still pending */
    ulg   pending_buf_size; /* size of pending_buf */
    Bytef *pending_out;  /* next pending byte to output to the stream */
    ulg   pending;       /* nb of bytes in the pending buffer */
    int   wrap;          /* bit 0 true for zlib, bit 1 true for gzip */
    gz_headerp  gzhead;  /* gzip header information to write */
    ulg   gzindex;       /* where in extra, name, or comment */
    Byte  method;        /* can only be DEFLATED */
    int   last_flush;    /* value of flush param for previous deflate call */

                /* used by deflate.c: */

    uInt  w_size;        /* LZ77 window size (32K by default) */
    uInt  w_bits;        /* log2(w_size)  (8..16) */
    uInt  w_mask;        /* w_size - 1 */

    Bytef *window;
    /* Sliding window. Input bytes are read into the second half of the window,
     * and move to the first half later to keep a dictionary of at least wSize
     * bytes. With this organization, matches are limited to a distance of
     * wSize-MAX_MATCH bytes, but this ensures that IO is always
     * performed with a length multiple of the block size. Also, it limits
     * the window size to 64K, which is quite useful on MSDOS.
     * To do: use the user input buffer as sliding window.
     */

    ulg window_size;
    /* Actual size of window: 2*wSize, except when the user input buffer
     * is directly used as sliding window.
     */

    Posf *prev;
    /* Link to older string with same hash index. To limit the size of this
     * array to 64K, this link is maintained only for the last 32K strings.
     * An index in this array is thus a window index modulo 32K.
     */

    Posf *head; /* Heads of the hash chains or NIL. */

    uInt  ins_h;          /* hash index of string to be inserted */
    uInt  hash_size;      /* number of elements in hash table */
    uInt  hash_bits;      /* log2(hash_size) */
    uInt  hash_mask;      /* hash_size-1 */

    uInt  hash_shift;
    /* Number of bits by which ins_h must be shifted at each input
     * step. It must be such that after MIN_MATCH steps, the oldest
     * byte no longer takes part in the hash key, that is:
     *   hash_shift * MIN_MATCH >= hash_bits
     */

    long block_start;
    /* Window position at the beginning of the current output block. Gets
     * negative when the window is moved backwards.
     */

    uInt match_length;           /* length of best match */
    IPos prev_match;             /* previous match */
    int match_available;         /* set if previous match exists */
    uInt strstart;               /* start of string to insert */
    uInt match_start;            /* start of matching string */
    uInt lookahead;              /* number of valid bytes ahead in window */

    uInt prev_length;
    /* Length of the best match at previous step. Matches not greater than this
     * are discarded. This is used in the lazy match evaluation.
     */

    uInt max_chain_length;
    /* To speed up deflation, hash chains are never searched beyond this
     * length.  A higher limit improves compression ratio but degrades the
     * speed.
     */

    uInt max_lazy_match;
    /* Attempt to find a better match only when the current match is strictly
     * smaller than this value. This mechanism is used only for compression
     * levels >= 4.
     */
#   define max_insert_length  max_lazy_match
    /* Insert new strings in the hash table only if the match length is not
     * greater than this length. This saves time but degrades compression.
     * max_insert_length is used only for compression levels <= 3.
     */

    int level;    /* compression level (1..9) */
    int strategy; /* favor or force Huffman coding*/

    uInt good_match;
    /* Use a faster search when the previous match is longer than this */

    int nice_match; /* Stop searching when current match exceeds this */

                /* used by trees.c: */
    /* Didn't use ct_data typedef below to suppress compiler warning */
    struct ct_data_s dyn_ltree[HEAP_SIZE];   /* literal and length tree */
    struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */
    struct ct_data_s bl_tree[2*BL_CODES+1];  /* Huffman tree for bit lengths */

    struct tree_desc_s l_desc;               /* desc. for literal tree */
    struct tree_desc_s d_desc;               /* desc. for distance tree */
    struct tree_desc_s bl_desc;              /* desc. for bit length tree */

    ush bl_count[MAX_BITS+1];
    /* number of codes at each bit length for an optimal tree */

    int heap[2*L_CODES+1];      /* heap used to build the Huffman trees */
    int heap_len;               /* number of elements in the heap */
    int heap_max;               /* element of largest frequency */
    /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used.
     * The same heap array is used to build all trees.
     */

    uch depth[2*L_CODES+1];
    /* Depth of each subtree used as tie breaker for trees of equal frequency
     */

    uchf *l_buf;          /* buffer for literals or lengths */

    uInt  lit_bufsize;
    /* Size of match buffer for literals/lengths.  There are 4 reasons for
     * limiting lit_bufsize to 64K:
     *   - frequencies can be kept in 16 bit counters
     *   - if compression is not successful for the first block, all input
     *     data is still in the window so we can still emit a stored block even
     *     when input comes from standard input.  (This can also be done for
     *     all blocks if lit_bufsize is not greater than 32K.)
     *   - if compression is not successful for a file smaller than 64K, we can
     *     even emit a stored file instead of a stored block (saving 5 bytes).
     *     This is applicable only for zip (not gzip or zlib).
     *   - creating new Huffman trees less frequently may not provide fast
     *     adaptation to changes in the input data statistics. (Take for
     *     example a binary file with poorly compressible code followed by
     *     a highly compressible string table.) Smaller buffer sizes give
     *     fast adaptation but have of course the overhead of transmitting
     *     trees more frequently.
     *   - I can't count above 4
     */

    uInt last_lit;      /* running index in l_buf */

    ushf *d_buf;
    /* Buffer for distances. To simplify the code, d_buf and l_buf have
     * the same number of elements. To use different lengths, an extra flag
     * array would be necessary.
     */

    ulg opt_len;        /* bit length of current block with optimal trees */
    ulg static_len;     /* bit length of current block with static trees */
    uInt matches;       /* number of string matches in current block */
    uInt insert;        /* bytes at end of window left to insert */

#ifdef ZLIB_DEBUG
    ulg compressed_len; /* total bit length of compressed file mod 2^32 */
    ulg bits_sent;      /* bit length of compressed data sent mod 2^32 */
#endif

    ush bi_buf;
    /* Output buffer. bits are inserted starting at the bottom (least
     * significant bits).
     */
    int bi_valid;
    /* Number of valid bits in bi_buf.  All bits above the last valid bit
     * are always zero.
     */

    ulg high_water;
    /* High water mark offset in window for initialized bytes -- bytes above
     * this are set to zero in order to avoid memory check warnings when
     * longest match routines access bytes past the input.  This is then
     * updated to the new high water mark.
     */

} FAR deflate_state;

/* Output a byte on the stream.
 * IN assertion: there is enough room in pending_buf.
 */
#define put_byte(s, c) {s->pending_buf[s->pending++] = (Bytef)(c);}


#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1)
/* Minimum amount of lookahead, except at the end of the input file.
 * See deflate.c for comments about the MIN_MATCH+1.
 */

#define MAX_DIST(s)  ((s)->w_size-MIN_LOOKAHEAD)
/* In order to simplify the code, particularly on 16 bit machines, match
 * distances are limited to MAX_DIST instead of WSIZE.
 */

#define WIN_INIT MAX_MATCH
/* Number of bytes after end of data in window to initialize in order to avoid
   memory checker errors from longest match routines */

        /* in trees.c */
void ZLIB_INTERNAL _tr_init OF((deflate_state *s));
int ZLIB_INTERNAL _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc));
void ZLIB_INTERNAL _tr_flush_block OF((deflate_state *s, charf *buf,
                        ulg stored_len, int last));
void ZLIB_INTERNAL _tr_flush_bits OF((deflate_state *s));
void ZLIB_INTERNAL _tr_align OF((deflate_state *s));
void ZLIB_INTERNAL _tr_stored_block OF((deflate_state *s, charf *buf,
                        ulg stored_len, int last));

#define d_code(dist) \
   ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)])
/* Mapping from a distance to a distance code. dist is the distance - 1 and
 * must not have side effects. _dist_code[256] and _dist_code[257] are never
 * used.
 */

#ifndef ZLIB_DEBUG
/* Inline versions of _tr_tally for speed: */

#if defined(GEN_TREES_H) || !defined(STDC)
  extern uch ZLIB_INTERNAL _length_code[];
  extern uch ZLIB_INTERNAL _dist_code[];
#else
  extern const uch ZLIB_INTERNAL _length_code[];
  extern const uch ZLIB_INTERNAL _dist_code[];
#endif

# define _tr_tally_lit(s, c, flush) \
  { uch cc = (c); \
    s->d_buf[s->last_lit] = 0; \
    s->l_buf[s->last_lit++] = cc; \
    s->dyn_ltree[cc].Freq++; \
    flush = (s->last_lit == s->lit_bufsize-1); \
   }
# define _tr_tally_dist(s, distance, length, flush) \
  { uch len = (uch)(length); \
    ush dist = (ush)(distance); \
    s->d_buf[s->last_lit] = dist; \
    s->l_buf[s->last_lit++] = len; \
    dist--; \
    s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \
    s->dyn_dtree[d_code(dist)].Freq++; \
    flush = (s->last_lit == s->lit_bufsize-1); \
  }
#else
# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c)
# define _tr_tally_dist(s, distance, length, flush) \
              flush = _tr_tally(s, distance, length)
#endif

#endif /* DEFLATE_H */

Deleted compat/zlib/examples/README.examples.

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

















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
This directory contains examples of the use of zlib and other relevant
programs and documentation.

enough.c
    calculation and justification of ENOUGH parameter in inftrees.h
    - calculates the maximum table space used in inflate tree
      construction over all possible Huffman codes

fitblk.c
    compress just enough input to nearly fill a requested output size
    - zlib isn't designed to do this, but fitblk does it anyway

gun.c
    uncompress a gzip file
    - illustrates the use of inflateBack() for high speed file-to-file
      decompression using call-back functions
    - is approximately twice as fast as gzip -d
    - also provides Unix uncompress functionality, again twice as fast

gzappend.c
    append to a gzip file
    - illustrates the use of the Z_BLOCK flush parameter for inflate()
    - illustrates the use of deflatePrime() to start at any bit

gzjoin.c
    join gzip files without recalculating the crc or recompressing
    - illustrates the use of the Z_BLOCK flush parameter for inflate()
    - illustrates the use of crc32_combine()

gzlog.c
gzlog.h
    efficiently and robustly maintain a message log file in gzip format
    - illustrates use of raw deflate, Z_PARTIAL_FLUSH, deflatePrime(),
      and deflateSetDictionary()
    - illustrates use of a gzip header extra field

zlib_how.html
    painfully comprehensive description of zpipe.c (see below)
    - describes in excruciating detail the use of deflate() and inflate()

zpipe.c
    reads and writes zlib streams from stdin to stdout
    - illustrates the proper use of deflate() and inflate()
    - deeply commented in zlib_how.html (see above)

zran.c
    index a zlib or gzip stream and randomly access it
    - illustrates the use of Z_BLOCK, inflatePrime(), and
      inflateSetDictionary() to provide random access

Deleted compat/zlib/examples/enough.c.

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




























































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* enough.c -- determine the maximum size of inflate's Huffman code tables over
 * all possible valid and complete Huffman codes, subject to a length limit.
 * Copyright (C) 2007, 2008, 2012 Mark Adler
 * Version 1.4  18 August 2012  Mark Adler
 */

/* Version history:
   1.0   3 Jan 2007  First version (derived from codecount.c version 1.4)
   1.1   4 Jan 2007  Use faster incremental table usage computation
                     Prune examine() search on previously visited states
   1.2   5 Jan 2007  Comments clean up
                     As inflate does, decrease root for short codes
                     Refuse cases where inflate would increase root
   1.3  17 Feb 2008  Add argument for initial root table size
                     Fix bug for initial root table size == max - 1
                     Use a macro to compute the history index
   1.4  18 Aug 2012  Avoid shifts more than bits in type (caused endless loop!)
                     Clean up comparisons of different types
                     Clean up code indentation
 */

/*
   Examine all possible Huffman codes for a given number of symbols and a
   maximum code length in bits to determine the maximum table size for zilb's
   inflate.  Only complete Huffman codes are counted.

   Two codes are considered distinct if the vectors of the number of codes per
   length are not identical.  So permutations of the symbol assignments result
   in the same code for the counting, as do permutations of the assignments of
   the bit values to the codes (i.e. only canonical codes are counted).

   We build a code from shorter to longer lengths, determining how many symbols
   are coded at each length.  At each step, we have how many symbols remain to
   be coded, what the last code length used was, and how many bit patterns of
   that length remain unused. Then we add one to the code length and double the
   number of unused patterns to graduate to the next code length.  We then
   assign all portions of the remaining symbols to that code length that
   preserve the properties of a correct and eventually complete code.  Those
   properties are: we cannot use more bit patterns than are available; and when
   all the symbols are used, there are exactly zero possible bit patterns
   remaining.

   The inflate Huffman decoding algorithm uses two-level lookup tables for
   speed.  There is a single first-level table to decode codes up to root bits
   in length (root == 9 in the current inflate implementation).  The table
   has 1 << root entries and is indexed by the next root bits of input.  Codes
   shorter than root bits have replicated table entries, so that the correct
   entry is pointed to regardless of the bits that follow the short code.  If
   the code is longer than root bits, then the table entry points to a second-
   level table.  The size of that table is determined by the longest code with
   that root-bit prefix.  If that longest code has length len, then the table
   has size 1 << (len - root), to index the remaining bits in that set of
   codes.  Each subsequent root-bit prefix then has its own sub-table.  The
   total number of table entries required by the code is calculated
   incrementally as the number of codes at each bit length is populated.  When
   all of the codes are shorter than root bits, then root is reduced to the
   longest code length, resulting in a single, smaller, one-level table.

   The inflate algorithm also provides for small values of root (relative to
   the log2 of the number of symbols), where the shortest code has more bits
   than root.  In that case, root is increased to the length of the shortest
   code.  This program, by design, does not handle that case, so it is verified
   that the number of symbols is less than 2^(root + 1).

   In order to speed up the examination (by about ten orders of magnitude for
   the default arguments), the intermediate states in the build-up of a code
   are remembered and previously visited branches are pruned.  The memory
   required for this will increase rapidly with the total number of symbols and
   the maximum code length in bits.  However this is a very small price to pay
   for the vast speedup.

   First, all of the possible Huffman codes are counted, and reachable
   intermediate states are noted by a non-zero count in a saved-results array.
   Second, the intermediate states that lead to (root + 1) bit or longer codes
   are used to look at all sub-codes from those junctures for their inflate
   memory usage.  (The amount of memory used is not affected by the number of
   codes of root bits or less in length.)  Third, the visited states in the
   construction of those sub-codes and the associated calculation of the table
   size is recalled in order to avoid recalculating from the same juncture.
   Beginning the code examination at (root + 1) bit codes, which is enabled by
   identifying the reachable nodes, accounts for about six of the orders of
   magnitude of improvement for the default arguments.  About another four
   orders of magnitude come from not revisiting previous states.  Out of
   approximately 2x10^16 possible Huffman codes, only about 2x10^6 sub-codes
   need to be examined to cover all of the possible table memory usage cases
   for the default arguments of 286 symbols limited to 15-bit codes.

   Note that an unsigned long long type is used for counting.  It is quite easy
   to exceed the capacity of an eight-byte integer with a large number of
   symbols and a large maximum code length, so multiple-precision arithmetic
   would need to replace the unsigned long long arithmetic in that case.  This
   program will abort if an overflow occurs.  The big_t type identifies where
   the counting takes place.

   An unsigned long long type is also used for calculating the number of
   possible codes remaining at the maximum length.  This limits the maximum
   code length to the number of bits in a long long minus the number of bits
   needed to represent the symbols in a flat code.  The code_t type identifies
   where the bit pattern counting takes place.
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>

#define local static

/* special data types */
typedef unsigned long long big_t;   /* type for code counting */
typedef unsigned long long code_t;  /* type for bit pattern counting */
struct tab {                        /* type for been here check */
    size_t len;         /* length of bit vector in char's */
    char *vec;          /* allocated bit vector */
};

/* The array for saving results, num[], is indexed with this triplet:

      syms: number of symbols remaining to code
      left: number of available bit patterns at length len
      len: number of bits in the codes currently being assigned

   Those indices are constrained thusly when saving results:

      syms: 3..totsym (totsym == total symbols to code)
      left: 2..syms - 1, but only the evens (so syms == 8 -> 2, 4, 6)
      len: 1..max - 1 (max == maximum code length in bits)

   syms == 2 is not saved since that immediately leads to a single code.  left
   must be even, since it represents the number of available bit patterns at
   the current length, which is double the number at the previous length.
   left ends at syms-1 since left == syms immediately results in a single code.
   (left > sym is not allowed since that would result in an incomplete code.)
   len is less than max, since the code completes immediately when len == max.

   The offset into the array is calculated for the three indices with the
   first one (syms) being outermost, and the last one (len) being innermost.
   We build the array with length max-1 lists for the len index, with syms-3
   of those for each symbol.  There are totsym-2 of those, with each one
   varying in length as a function of sym.  See the calculation of index in
   count() for the index, and the calculation of size in main() for the size
   of the array.

   For the deflate example of 286 symbols limited to 15-bit codes, the array
   has 284,284 entries, taking up 2.17 MB for an 8-byte big_t.  More than
   half of the space allocated for saved results is actually used -- not all
   possible triplets are reached in the generation of valid Huffman codes.
 */

/* The array for tracking visited states, done[], is itself indexed identically
   to the num[] array as described above for the (syms, left, len) triplet.
   Each element in the array is further indexed by the (mem, rem) doublet,
   where mem is the amount of inflate table space used so far, and rem is the
   remaining unused entries in the current inflate sub-table.  Each indexed
   element is simply one bit indicating whether the state has been visited or
   not.  Since the ranges for mem and rem are not known a priori, each bit
   vector is of a variable size, and grows as needed to accommodate the visited
   states.  mem and rem are used to calculate a single index in a triangular
   array.  Since the range of mem is expected in the default case to be about
   ten times larger than the range of rem, the array is skewed to reduce the
   memory usage, with eight times the range for mem than for rem.  See the
   calculations for offset and bit in beenhere() for the details.

   For the deflate example of 286 symbols limited to 15-bit codes, the bit
   vectors grow to total approximately 21 MB, in addition to the 4.3 MB done[]
   array itself.
 */

/* Globals to avoid propagating constants or constant pointers recursively */
local int max;          /* maximum allowed bit length for the codes */
local int root;         /* size of base code table in bits */
local int large;        /* largest code table so far */
local size_t size;      /* number of elements in num and done */
local int *code;        /* number of symbols assigned to each bit length */
local big_t *num;       /* saved results array for code counting */
local struct tab *done; /* states already evaluated array */

/* Index function for num[] and done[] */
#define INDEX(i,j,k) (((size_t)((i-1)>>1)*((i-2)>>1)+(j>>1)-1)*(max-1)+k-1)

/* Free allocated space.  Uses globals code, num, and done. */
local void cleanup(void)
{
    size_t n;

    if (done != NULL) {
        for (n = 0; n < size; n++)
            if (done[n].len)
                free(done[n].vec);
        free(done);
    }
    if (num != NULL)
        free(num);
    if (code != NULL)
        free(code);
}

/* Return the number of possible Huffman codes using bit patterns of lengths
   len through max inclusive, coding syms symbols, with left bit patterns of
   length len unused -- return -1 if there is an overflow in the counting.
   Keep a record of previous results in num to prevent repeating the same
   calculation.  Uses the globals max and num. */
local big_t count(int syms, int len, int left)
{
    big_t sum;          /* number of possible codes from this juncture */
    big_t got;          /* value returned from count() */
    int least;          /* least number of syms to use at this juncture */
    int most;           /* most number of syms to use at this juncture */
    int use;            /* number of bit patterns to use in next call */
    size_t index;       /* index of this case in *num */

    /* see if only one possible code */
    if (syms == left)
        return 1;

    /* note and verify the expected state */
    assert(syms > left && left > 0 && len < max);

    /* see if we've done this one already */
    index = INDEX(syms, left, len);
    got = num[index];
    if (got)
        return got;         /* we have -- return the saved result */

    /* we need to use at least this many bit patterns so that the code won't be
       incomplete at the next length (more bit patterns than symbols) */
    least = (left << 1) - syms;
    if (least < 0)
        least = 0;

    /* we can use at most this many bit patterns, lest there not be enough
       available for the remaining symbols at the maximum length (if there were
       no limit to the code length, this would become: most = left - 1) */
    most = (((code_t)left << (max - len)) - syms) /
            (((code_t)1 << (max - len)) - 1);

    /* count all possible codes from this juncture and add them up */
    sum = 0;
    for (use = least; use <= most; use++) {
        got = count(syms - use, len + 1, (left - use) << 1);
        sum += got;
        if (got == (big_t)0 - 1 || sum < got)   /* overflow */
            return (big_t)0 - 1;
    }

    /* verify that all recursive calls are productive */
    assert(sum != 0);

    /* save the result and return it */
    num[index] = sum;
    return sum;
}

/* Return true if we've been here before, set to true if not.  Set a bit in a
   bit vector to indicate visiting this state.  Each (syms,len,left) state
   has a variable size bit vector indexed by (mem,rem).  The bit vector is
   lengthened if needed to allow setting the (mem,rem) bit. */
local int beenhere(int syms, int len, int left, int mem, int rem)
{
    size_t index;       /* index for this state's bit vector */
    size_t offset;      /* offset in this state's bit vector */
    int bit;            /* mask for this state's bit */
    size_t length;      /* length of the bit vector in bytes */
    char *vector;       /* new or enlarged bit vector */

    /* point to vector for (syms,left,len), bit in vector for (mem,rem) */
    index = INDEX(syms, left, len);
    mem -= 1 << root;
    offset = (mem >> 3) + rem;
    offset = ((offset * (offset + 1)) >> 1) + rem;
    bit = 1 << (mem & 7);

    /* see if we've been here */
    length = done[index].len;
    if (offset < length && (done[index].vec[offset] & bit) != 0)
        return 1;       /* done this! */

    /* we haven't been here before -- set the bit to show we have now */

    /* see if we need to lengthen the vector in order to set the bit */
    if (length <= offset) {
        /* if we have one already, enlarge it, zero out the appended space */
        if (length) {
            do {
                length <<= 1;
            } while (length <= offset);
            vector = realloc(done[index].vec, length);
            if (vector != NULL)
                memset(vector + done[index].len, 0, length - done[index].len);
        }

        /* otherwise we need to make a new vector and zero it out */
        else {
            length = 1 << (len - root);
            while (length <= offset)
                length <<= 1;
            vector = calloc(length, sizeof(char));
        }

        /* in either case, bail if we can't get the memory */
        if (vector == NULL) {
            fputs("abort: unable to allocate enough memory\n", stderr);
            cleanup();
            exit(1);
        }

        /* install the new vector */
        done[index].len = length;
        done[index].vec = vector;
    }

    /* set the bit */
    done[index].vec[offset] |= bit;
    return 0;
}

/* Examine all possible codes from the given node (syms, len, left).  Compute
   the amount of memory required to build inflate's decoding tables, where the
   number of code structures used so far is mem, and the number remaining in
   the current sub-table is rem.  Uses the globals max, code, root, large, and
   done. */
local void examine(int syms, int len, int left, int mem, int rem)
{
    int least;          /* least number of syms to use at this juncture */
    int most;           /* most number of syms to use at this juncture */
    int use;            /* number of bit patterns to use in next call */

    /* see if we have a complete code */
    if (syms == left) {
        /* set the last code entry */
        code[len] = left;

        /* complete computation of memory used by this code */
        while (rem < left) {
            left -= rem;
            rem = 1 << (len - root);
            mem += rem;
        }
        assert(rem == left);

        /* if this is a new maximum, show the entries used and the sub-code */
        if (mem > large) {
            large = mem;
            printf("max %d: ", mem);
            for (use = root + 1; use <= max; use++)
                if (code[use])
                    printf("%d[%d] ", code[use], use);
            putchar('\n');
            fflush(stdout);
        }

        /* remove entries as we drop back down in the recursion */
        code[len] = 0;
        return;
    }

    /* prune the tree if we can */
    if (beenhere(syms, len, left, mem, rem))
        return;

    /* we need to use at least this many bit patterns so that the code won't be
       incomplete at the next length (more bit patterns than symbols) */
    least = (left << 1) - syms;
    if (least < 0)
        least = 0;

    /* we can use at most this many bit patterns, lest there not be enough
       available for the remaining symbols at the maximum length (if there were
       no limit to the code length, this would become: most = left - 1) */
    most = (((code_t)left << (max - len)) - syms) /
            (((code_t)1 << (max - len)) - 1);

    /* occupy least table spaces, creating new sub-tables as needed */
    use = least;
    while (rem < use) {
        use -= rem;
        rem = 1 << (len - root);
        mem += rem;
    }
    rem -= use;

    /* examine codes from here, updating table space as we go */
    for (use = least; use <= most; use++) {
        code[len] = use;
        examine(syms - use, len + 1, (left - use) << 1,
                mem + (rem ? 1 << (len - root) : 0), rem << 1);
        if (rem == 0) {
            rem = 1 << (len - root);
            mem += rem;
        }
        rem--;
    }

    /* remove entries as we drop back down in the recursion */
    code[len] = 0;
}

/* Look at all sub-codes starting with root + 1 bits.  Look at only the valid
   intermediate code states (syms, left, len).  For each completed code,
   calculate the amount of memory required by inflate to build the decoding
   tables. Find the maximum amount of memory required and show the code that
   requires that maximum.  Uses the globals max, root, and num. */
local void enough(int syms)
{
    int n;              /* number of remaing symbols for this node */
    int left;           /* number of unused bit patterns at this length */
    size_t index;       /* index of this case in *num */

    /* clear code */
    for (n = 0; n <= max; n++)
        code[n] = 0;

    /* look at all (root + 1) bit and longer codes */
    large = 1 << root;              /* base table */
    if (root < max)                 /* otherwise, there's only a base table */
        for (n = 3; n <= syms; n++)
            for (left = 2; left < n; left += 2)
            {
                /* look at all reachable (root + 1) bit nodes, and the
                   resulting codes (complete at root + 2 or more) */
                index = INDEX(n, left, root + 1);
                if (root + 1 < max && num[index])       /* reachable node */
                    examine(n, root + 1, left, 1 << root, 0);

                /* also look at root bit codes with completions at root + 1
                   bits (not saved in num, since complete), just in case */
                if (num[index - 1] && n <= left << 1)
                    examine((n - left) << 1, root + 1, (n - left) << 1,
                            1 << root, 0);
            }

    /* done */
    printf("done: maximum of %d table entries\n", large);
}

/*
   Examine and show the total number of possible Huffman codes for a given
   maximum number of symbols, initial root table size, and maximum code length
   in bits -- those are the command arguments in that order.  The default
   values are 286, 9, and 15 respectively, for the deflate literal/length code.
   The possible codes are counted for each number of coded symbols from two to
   the maximum.  The counts for each of those and the total number of codes are
   shown.  The maximum number of inflate table entires is then calculated
   across all possible codes.  Each new maximum number of table entries and the
   associated sub-code (starting at root + 1 == 10 bits) is shown.

   To count and examine Huffman codes that are not length-limited, provide a
   maximum length equal to the number of symbols minus one.

   For the deflate literal/length code, use "enough".  For the deflate distance
   code, use "enough 30 6".

   This uses the %llu printf format to print big_t numbers, which assumes that
   big_t is an unsigned long long.  If the big_t type is changed (for example
   to a multiple precision type), the method of printing will also need to be
   updated.
 */
int main(int argc, char **argv)
{
    int syms;           /* total number of symbols to code */
    int n;              /* number of symbols to code for this run */
    big_t got;          /* return value of count() */
    big_t sum;          /* accumulated number of codes over n */
    code_t word;        /* for counting bits in code_t */

    /* set up globals for cleanup() */
    code = NULL;
    num = NULL;
    done = NULL;

    /* get arguments -- default to the deflate literal/length code */
    syms = 286;
    root = 9;
    max = 15;
    if (argc > 1) {
        syms = atoi(argv[1]);
        if (argc > 2) {
            root = atoi(argv[2]);
            if (argc > 3)
                max = atoi(argv[3]);
        }
    }
    if (argc > 4 || syms < 2 || root < 1 || max < 1) {
        fputs("invalid arguments, need: [sym >= 2 [root >= 1 [max >= 1]]]\n",
              stderr);
        return 1;
    }

    /* if not restricting the code length, the longest is syms - 1 */
    if (max > syms - 1)
        max = syms - 1;

    /* determine the number of bits in a code_t */
    for (n = 0, word = 1; word; n++, word <<= 1)
        ;

    /* make sure that the calculation of most will not overflow */
    if (max > n || (code_t)(syms - 2) >= (((code_t)0 - 1) >> (max - 1))) {
        fputs("abort: code length too long for internal types\n", stderr);
        return 1;
    }

    /* reject impossible code requests */
    if ((code_t)(syms - 1) > ((code_t)1 << max) - 1) {
        fprintf(stderr, "%d symbols cannot be coded in %d bits\n",
                syms, max);
        return 1;
    }

    /* allocate code vector */
    code = calloc(max + 1, sizeof(int));
    if (code == NULL) {
        fputs("abort: unable to allocate enough memory\n", stderr);
        return 1;
    }

    /* determine size of saved results array, checking for overflows,
       allocate and clear the array (set all to zero with calloc()) */
    if (syms == 2)              /* iff max == 1 */
        num = NULL;             /* won't be saving any results */
    else {
        size = syms >> 1;
        if (size > ((size_t)0 - 1) / (n = (syms - 1) >> 1) ||
                (size *= n, size > ((size_t)0 - 1) / (n = max - 1)) ||
                (size *= n, size > ((size_t)0 - 1) / sizeof(big_t)) ||
                (num = calloc(size, sizeof(big_t))) == NULL) {
            fputs("abort: unable to allocate enough memory\n", stderr);
            cleanup();
            return 1;
        }
    }

    /* count possible codes for all numbers of symbols, add up counts */
    sum = 0;
    for (n = 2; n <= syms; n++) {
        got = count(n, 1, 2);
        sum += got;
        if (got == (big_t)0 - 1 || sum < got) {     /* overflow */
            fputs("abort: can't count that high!\n", stderr);
            cleanup();
            return 1;
        }
        printf("%llu %d-codes\n", got, n);
    }
    printf("%llu total codes for 2 to %d symbols", sum, syms);
    if (max < syms - 1)
        printf(" (%d-bit length limit)\n", max);
    else
        puts(" (no length limit)");

    /* allocate and clear done array for beenhere() */
    if (syms == 2)
        done = NULL;
    else if (size > ((size_t)0 - 1) / sizeof(struct tab) ||
             (done = calloc(size, sizeof(struct tab))) == NULL) {
        fputs("abort: unable to allocate enough memory\n", stderr);
        cleanup();
        return 1;
    }

    /* find and show maximum inflate table usage */
    if (root > max)                 /* reduce root to max length */
        root = max;
    if ((code_t)syms < ((code_t)1 << (root + 1)))
        enough(syms);
    else
        puts("cannot handle minimum code lengths > root");

    /* done */
    cleanup();
    return 0;
}

Deleted compat/zlib/examples/fitblk.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233









































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* fitblk.c: example of fitting compressed output to a specified size
   Not copyrighted -- provided to the public domain
   Version 1.1  25 November 2004  Mark Adler */

/* Version history:
   1.0  24 Nov 2004  First version
   1.1  25 Nov 2004  Change deflateInit2() to deflateInit()
                     Use fixed-size, stack-allocated raw buffers
                     Simplify code moving compression to subroutines
                     Use assert() for internal errors
                     Add detailed description of approach
 */

/* Approach to just fitting a requested compressed size:

   fitblk performs three compression passes on a portion of the input
   data in order to determine how much of that input will compress to
   nearly the requested output block size.  The first pass generates
   enough deflate blocks to produce output to fill the requested
   output size plus a specfied excess amount (see the EXCESS define
   below).  The last deflate block may go quite a bit past that, but
   is discarded.  The second pass decompresses and recompresses just
   the compressed data that fit in the requested plus excess sized
   buffer.  The deflate process is terminated after that amount of
   input, which is less than the amount consumed on the first pass.
   The last deflate block of the result will be of a comparable size
   to the final product, so that the header for that deflate block and
   the compression ratio for that block will be about the same as in
   the final product.  The third compression pass decompresses the
   result of the second step, but only the compressed data up to the
   requested size minus an amount to allow the compressed stream to
   complete (see the MARGIN define below).  That will result in a
   final compressed stream whose length is less than or equal to the
   requested size.  Assuming sufficient input and a requested size
   greater than a few hundred bytes, the shortfall will typically be
   less than ten bytes.

   If the input is short enough that the first compression completes
   before filling the requested output size, then that compressed
   stream is return with no recompression.

   EXCESS is chosen to be just greater than the shortfall seen in a
   two pass approach similar to the above.  That shortfall is due to
   the last deflate block compressing more efficiently with a smaller
   header on the second pass.  EXCESS is set to be large enough so
   that there is enough uncompressed data for the second pass to fill
   out the requested size, and small enough so that the final deflate
   block of the second pass will be close in size to the final deflate
   block of the third and final pass.  MARGIN is chosen to be just
   large enough to assure that the final compression has enough room
   to complete in all cases.
 */

#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#include "zlib.h"

#define local static

/* print nastygram and leave */
local void quit(char *why)
{
    fprintf(stderr, "fitblk abort: %s\n", why);
    exit(1);
}

#define RAWLEN 4096    /* intermediate uncompressed buffer size */

/* compress from file to def until provided buffer is full or end of
   input reached; return last deflate() return value, or Z_ERRNO if
   there was read error on the file */
local int partcompress(FILE *in, z_streamp def)
{
    int ret, flush;
    unsigned char raw[RAWLEN];

    flush = Z_NO_FLUSH;
    do {
        def->avail_in = fread(raw, 1, RAWLEN, in);
        if (ferror(in))
            return Z_ERRNO;
        def->next_in = raw;
        if (feof(in))
            flush = Z_FINISH;
        ret = deflate(def, flush);
        assert(ret != Z_STREAM_ERROR);
    } while (def->avail_out != 0 && flush == Z_NO_FLUSH);
    return ret;
}

/* recompress from inf's input to def's output; the input for inf and
   the output for def are set in those structures before calling;
   return last deflate() return value, or Z_MEM_ERROR if inflate()
   was not able to allocate enough memory when it needed to */
local int recompress(z_streamp inf, z_streamp def)
{
    int ret, flush;
    unsigned char raw[RAWLEN];

    flush = Z_NO_FLUSH;
    do {
        /* decompress */
        inf->avail_out = RAWLEN;
        inf->next_out = raw;
        ret = inflate(inf, Z_NO_FLUSH);
        assert(ret != Z_STREAM_ERROR && ret != Z_DATA_ERROR &&
               ret != Z_NEED_DICT);
        if (ret == Z_MEM_ERROR)
            return ret;

        /* compress what was decompresed until done or no room */
        def->avail_in = RAWLEN - inf->avail_out;
        def->next_in = raw;
        if (inf->avail_out != 0)
            flush = Z_FINISH;
        ret = deflate(def, flush);
        assert(ret != Z_STREAM_ERROR);
    } while (ret != Z_STREAM_END && def->avail_out != 0);
    return ret;
}

#define EXCESS 256      /* empirically determined stream overage */
#define MARGIN 8        /* amount to back off for completion */

/* compress from stdin to fixed-size block on stdout */
int main(int argc, char **argv)
{
    int ret;                /* return code */
    unsigned size;          /* requested fixed output block size */
    unsigned have;          /* bytes written by deflate() call */
    unsigned char *blk;     /* intermediate and final stream */
    unsigned char *tmp;     /* close to desired size stream */
    z_stream def, inf;      /* zlib deflate and inflate states */

    /* get requested output size */
    if (argc != 2)
        quit("need one argument: size of output block");
    ret = strtol(argv[1], argv + 1, 10);
    if (argv[1][0] != 0)
        quit("argument must be a number");
    if (ret < 8)            /* 8 is minimum zlib stream size */
        quit("need positive size of 8 or greater");
    size = (unsigned)ret;

    /* allocate memory for buffers and compression engine */
    blk = malloc(size + EXCESS);
    def.zalloc = Z_NULL;
    def.zfree = Z_NULL;
    def.opaque = Z_NULL;
    ret = deflateInit(&def, Z_DEFAULT_COMPRESSION);
    if (ret != Z_OK || blk == NULL)
        quit("out of memory");

    /* compress from stdin until output full, or no more input */
    def.avail_out = size + EXCESS;
    def.next_out = blk;
    ret = partcompress(stdin, &def);
    if (ret == Z_ERRNO)
        quit("error reading input");

    /* if it all fit, then size was undersubscribed -- done! */
    if (ret == Z_STREAM_END && def.avail_out >= EXCESS) {
        /* write block to stdout */
        have = size + EXCESS - def.avail_out;
        if (fwrite(blk, 1, have, stdout) != have || ferror(stdout))
            quit("error writing output");

        /* clean up and print results to stderr */
        ret = deflateEnd(&def);
        assert(ret != Z_STREAM_ERROR);
        free(blk);
        fprintf(stderr,
                "%u bytes unused out of %u requested (all input)\n",
                size - have, size);
        return 0;
    }

    /* it didn't all fit -- set up for recompression */
    inf.zalloc = Z_NULL;
    inf.zfree = Z_NULL;
    inf.opaque = Z_NULL;
    inf.avail_in = 0;
    inf.next_in = Z_NULL;
    ret = inflateInit(&inf);
    tmp = malloc(size + EXCESS);
    if (ret != Z_OK || tmp == NULL)
        quit("out of memory");
    ret = deflateReset(&def);
    assert(ret != Z_STREAM_ERROR);

    /* do first recompression close to the right amount */
    inf.avail_in = size + EXCESS;
    inf.next_in = blk;
    def.avail_out = size + EXCESS;
    def.next_out = tmp;
    ret = recompress(&inf, &def);
    if (ret == Z_MEM_ERROR)
        quit("out of memory");

    /* set up for next reocmpression */
    ret = inflateReset(&inf);
    assert(ret != Z_STREAM_ERROR);
    ret = deflateReset(&def);
    assert(ret != Z_STREAM_ERROR);

    /* do second and final recompression (third compression) */
    inf.avail_in = size - MARGIN;   /* assure stream will complete */
    inf.next_in = tmp;
    def.avail_out = size;
    def.next_out = blk;
    ret = recompress(&inf, &def);
    if (ret == Z_MEM_ERROR)
        quit("out of memory");
    assert(ret == Z_STREAM_END);    /* otherwise MARGIN too small */

    /* done -- write block to stdout */
    have = size - def.avail_out;
    if (fwrite(blk, 1, have, stdout) != have || ferror(stdout))
        quit("error writing output");

    /* clean up and print results to stderr */
    free(tmp);
    ret = inflateEnd(&inf);
    assert(ret != Z_STREAM_ERROR);
    ret = deflateEnd(&def);
    assert(ret != Z_STREAM_ERROR);
    free(blk);
    fprintf(stderr,
            "%u bytes unused out of %u requested (%lu input)\n",
            size - have, size, def.total_in);
    return 0;
}

Deleted compat/zlib/examples/gun.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702






























































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gun.c -- simple gunzip to give an example of the use of inflateBack()
 * Copyright (C) 2003, 2005, 2008, 2010, 2012 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
   Version 1.7  12 August 2012  Mark Adler */

/* Version history:
   1.0  16 Feb 2003  First version for testing of inflateBack()
   1.1  21 Feb 2005  Decompress concatenated gzip streams
                     Remove use of "this" variable (C++ keyword)
                     Fix return value for in()
                     Improve allocation failure checking
                     Add typecasting for void * structures
                     Add -h option for command version and usage
                     Add a bunch of comments
   1.2  20 Mar 2005  Add Unix compress (LZW) decompression
                     Copy file attributes from input file to output file
   1.3  12 Jun 2005  Add casts for error messages [Oberhumer]
   1.4   8 Dec 2006  LZW decompression speed improvements
   1.5   9 Feb 2008  Avoid warning in latest version of gcc
   1.6  17 Jan 2010  Avoid signed/unsigned comparison warnings
   1.7  12 Aug 2012  Update for z_const usage in zlib 1.2.8
 */

/*
   gun [ -t ] [ name ... ]

   decompresses the data in the named gzip files.  If no arguments are given,
   gun will decompress from stdin to stdout.  The names must end in .gz, -gz,
   .z, -z, _z, or .Z.  The uncompressed data will be written to a file name
   with the suffix stripped.  On success, the original file is deleted.  On
   failure, the output file is deleted.  For most failures, the command will
   continue to process the remaining names on the command line.  A memory
   allocation failure will abort the command.  If -t is specified, then the
   listed files or stdin will be tested as gzip files for integrity (without
   checking for a proper suffix), no output will be written, and no files
   will be deleted.

   Like gzip, gun allows concatenated gzip streams and will decompress them,
   writing all of the uncompressed data to the output.  Unlike gzip, gun allows
   an empty file on input, and will produce no error writing an empty output
   file.

   gun will also decompress files made by Unix compress, which uses LZW
   compression.  These files are automatically detected by virtue of their
   magic header bytes.  Since the end of Unix compress stream is marked by the
   end-of-file, they cannot be concantenated.  If a Unix compress stream is
   encountered in an input file, it is the last stream in that file.

   Like gunzip and uncompress, the file attributes of the original compressed
   file are maintained in the final uncompressed file, to the extent that the
   user permissions allow it.

   On my Mac OS X PowerPC G4, gun is almost twice as fast as gunzip (version
   1.2.4) is on the same file, when gun is linked with zlib 1.2.2.  Also the
   LZW decompression provided by gun is about twice as fast as the standard
   Unix uncompress command.
 */

/* external functions and related types and constants */
#include <stdio.h>          /* fprintf() */
#include <stdlib.h>         /* malloc(), free() */
#include <string.h>         /* strerror(), strcmp(), strlen(), memcpy() */
#include <errno.h>          /* errno */
#include <fcntl.h>          /* open() */
#include <unistd.h>         /* read(), write(), close(), chown(), unlink() */
#include <sys/types.h>
#include <sys/stat.h>       /* stat(), chmod() */
#include <utime.h>          /* utime() */
#include "zlib.h"           /* inflateBackInit(), inflateBack(), */
                            /* inflateBackEnd(), crc32() */

/* function declaration */
#define local static

/* buffer constants */
#define SIZE 32768U         /* input and output buffer sizes */
#define PIECE 16384         /* limits i/o chunks for 16-bit int case */

/* structure for infback() to pass to input function in() -- it maintains the
   input file and a buffer of size SIZE */
struct ind {
    int infile;
    unsigned char *inbuf;
};

/* Load input buffer, assumed to be empty, and return bytes loaded and a
   pointer to them.  read() is called until the buffer is full, or until it
   returns end-of-file or error.  Return 0 on error. */
local unsigned in(void *in_desc, z_const unsigned char **buf)
{
    int ret;
    unsigned len;
    unsigned char *next;
    struct ind *me = (struct ind *)in_desc;

    next = me->inbuf;
    *buf = next;
    len = 0;
    do {
        ret = PIECE;
        if ((unsigned)ret > SIZE - len)
            ret = (int)(SIZE - len);
        ret = (int)read(me->infile, next, ret);
        if (ret == -1) {
            len = 0;
            break;
        }
        next += ret;
        len += ret;
    } while (ret != 0 && len < SIZE);
    return len;
}

/* structure for infback() to pass to output function out() -- it maintains the
   output file, a running CRC-32 check on the output and the total number of
   bytes output, both for checking against the gzip trailer.  (The length in
   the gzip trailer is stored modulo 2^32, so it's ok if a long is 32 bits and
   the output is greater than 4 GB.) */
struct outd {
    int outfile;
    int check;                  /* true if checking crc and total */
    unsigned long crc;
    unsigned long total;
};

/* Write output buffer and update the CRC-32 and total bytes written.  write()
   is called until all of the output is written or an error is encountered.
   On success out() returns 0.  For a write failure, out() returns 1.  If the
   output file descriptor is -1, then nothing is written.
 */
local int out(void *out_desc, unsigned char *buf, unsigned len)
{
    int ret;
    struct outd *me = (struct outd *)out_desc;

    if (me->check) {
        me->crc = crc32(me->crc, buf, len);
        me->total += len;
    }
    if (me->outfile != -1)
        do {
            ret = PIECE;
            if ((unsigned)ret > len)
                ret = (int)len;
            ret = (int)write(me->outfile, buf, ret);
            if (ret == -1)
                return 1;
            buf += ret;
            len -= ret;
        } while (len != 0);
    return 0;
}

/* next input byte macro for use inside lunpipe() and gunpipe() */
#define NEXT() (have ? 0 : (have = in(indp, &next)), \
                last = have ? (have--, (int)(*next++)) : -1)

/* memory for gunpipe() and lunpipe() --
   the first 256 entries of prefix[] and suffix[] are never used, could
   have offset the index, but it's faster to waste the memory */
unsigned char inbuf[SIZE];              /* input buffer */
unsigned char outbuf[SIZE];             /* output buffer */
unsigned short prefix[65536];           /* index to LZW prefix string */
unsigned char suffix[65536];            /* one-character LZW suffix */
unsigned char match[65280 + 2];         /* buffer for reversed match or gzip
                                           32K sliding window */

/* throw out what's left in the current bits byte buffer (this is a vestigial
   aspect of the compressed data format derived from an implementation that
   made use of a special VAX machine instruction!) */
#define FLUSHCODE() \
    do { \
        left = 0; \
        rem = 0; \
        if (chunk > have) { \
            chunk -= have; \
            have = 0; \
            if (NEXT() == -1) \
                break; \
            chunk--; \
            if (chunk > have) { \
                chunk = have = 0; \
                break; \
            } \
        } \
        have -= chunk; \
        next += chunk; \
        chunk = 0; \
    } while (0)

/* Decompress a compress (LZW) file from indp to outfile.  The compress magic
   header (two bytes) has already been read and verified.  There are have bytes
   of buffered input at next.  strm is used for passing error information back
   to gunpipe().

   lunpipe() will return Z_OK on success, Z_BUF_ERROR for an unexpected end of
   file, read error, or write error (a write error indicated by strm->next_in
   not equal to Z_NULL), or Z_DATA_ERROR for invalid input.
 */
local int lunpipe(unsigned have, z_const unsigned char *next, struct ind *indp,
                  int outfile, z_stream *strm)
{
    int last;                   /* last byte read by NEXT(), or -1 if EOF */
    unsigned chunk;             /* bytes left in current chunk */
    int left;                   /* bits left in rem */
    unsigned rem;               /* unused bits from input */
    int bits;                   /* current bits per code */
    unsigned code;              /* code, table traversal index */
    unsigned mask;              /* mask for current bits codes */
    int max;                    /* maximum bits per code for this stream */
    unsigned flags;             /* compress flags, then block compress flag */
    unsigned end;               /* last valid entry in prefix/suffix tables */
    unsigned temp;              /* current code */
    unsigned prev;              /* previous code */
    unsigned final;             /* last character written for previous code */
    unsigned stack;             /* next position for reversed string */
    unsigned outcnt;            /* bytes in output buffer */
    struct outd outd;           /* output structure */
    unsigned char *p;

    /* set up output */
    outd.outfile = outfile;
    outd.check = 0;

    /* process remainder of compress header -- a flags byte */
    flags = NEXT();
    if (last == -1)
        return Z_BUF_ERROR;
    if (flags & 0x60) {
        strm->msg = (char *)"unknown lzw flags set";
        return Z_DATA_ERROR;
    }
    max = flags & 0x1f;
    if (max < 9 || max > 16) {
        strm->msg = (char *)"lzw bits out of range";
        return Z_DATA_ERROR;
    }
    if (max == 9)                           /* 9 doesn't really mean 9 */
        max = 10;
    flags &= 0x80;                          /* true if block compress */

    /* clear table */
    bits = 9;
    mask = 0x1ff;
    end = flags ? 256 : 255;

    /* set up: get first 9-bit code, which is the first decompressed byte, but
       don't create a table entry until the next code */
    if (NEXT() == -1)                       /* no compressed data is ok */
        return Z_OK;
    final = prev = (unsigned)last;          /* low 8 bits of code */
    if (NEXT() == -1)                       /* missing a bit */
        return Z_BUF_ERROR;
    if (last & 1) {                         /* code must be < 256 */
        strm->msg = (char *)"invalid lzw code";
        return Z_DATA_ERROR;
    }
    rem = (unsigned)last >> 1;              /* remaining 7 bits */
    left = 7;
    chunk = bits - 2;                       /* 7 bytes left in this chunk */
    outbuf[0] = (unsigned char)final;       /* write first decompressed byte */
    outcnt = 1;

    /* decode codes */
    stack = 0;
    for (;;) {
        /* if the table will be full after this, increment the code size */
        if (end >= mask && bits < max) {
            FLUSHCODE();
            bits++;
            mask <<= 1;
            mask++;
        }

        /* get a code of length bits */
        if (chunk == 0)                     /* decrement chunk modulo bits */
            chunk = bits;
        code = rem;                         /* low bits of code */
        if (NEXT() == -1) {                 /* EOF is end of compressed data */
            /* write remaining buffered output */
            if (outcnt && out(&outd, outbuf, outcnt)) {
                strm->next_in = outbuf;     /* signal write error */
                return Z_BUF_ERROR;
            }
            return Z_OK;
        }
        code += (unsigned)last << left;     /* middle (or high) bits of code */
        left += 8;
        chunk--;
        if (bits > left) {                  /* need more bits */
            if (NEXT() == -1)               /* can't end in middle of code */
                return Z_BUF_ERROR;
            code += (unsigned)last << left; /* high bits of code */
            left += 8;
            chunk--;
        }
        code &= mask;                       /* mask to current code length */
        left -= bits;                       /* number of unused bits */
        rem = (unsigned)last >> (8 - left); /* unused bits from last byte */

        /* process clear code (256) */
        if (code == 256 && flags) {
            FLUSHCODE();
            bits = 9;                       /* initialize bits and mask */
            mask = 0x1ff;
            end = 255;                      /* empty table */
            continue;                       /* get next code */
        }

        /* special code to reuse last match */
        temp = code;                        /* save the current code */
        if (code > end) {
            /* Be picky on the allowed code here, and make sure that the code
               we drop through (prev) will be a valid index so that random
               input does not cause an exception.  The code != end + 1 check is
               empirically derived, and not checked in the original uncompress
               code.  If this ever causes a problem, that check could be safely
               removed.  Leaving this check in greatly improves gun's ability
               to detect random or corrupted input after a compress header.
               In any case, the prev > end check must be retained. */
            if (code != end + 1 || prev > end) {
                strm->msg = (char *)"invalid lzw code";
                return Z_DATA_ERROR;
            }
            match[stack++] = (unsigned char)final;
            code = prev;
        }

        /* walk through linked list to generate output in reverse order */
        p = match + stack;
        while (code >= 256) {
            *p++ = suffix[code];
            code = prefix[code];
        }
        stack = p - match;
        match[stack++] = (unsigned char)code;
        final = code;

        /* link new table entry */
        if (end < mask) {
            end++;
            prefix[end] = (unsigned short)prev;
            suffix[end] = (unsigned char)final;
        }

        /* set previous code for next iteration */
        prev = temp;

        /* write output in forward order */
        while (stack > SIZE - outcnt) {
            while (outcnt < SIZE)
                outbuf[outcnt++] = match[--stack];
            if (out(&outd, outbuf, outcnt)) {
                strm->next_in = outbuf; /* signal write error */
                return Z_BUF_ERROR;
            }
            outcnt = 0;
        }
        p = match + stack;
        do {
            outbuf[outcnt++] = *--p;
        } while (p > match);
        stack = 0;

        /* loop for next code with final and prev as the last match, rem and
           left provide the first 0..7 bits of the next code, end is the last
           valid table entry */
    }
}

/* Decompress a gzip file from infile to outfile.  strm is assumed to have been
   successfully initialized with inflateBackInit().  The input file may consist
   of a series of gzip streams, in which case all of them will be decompressed
   to the output file.  If outfile is -1, then the gzip stream(s) integrity is
   checked and nothing is written.

   The return value is a zlib error code: Z_MEM_ERROR if out of memory,
   Z_DATA_ERROR if the header or the compressed data is invalid, or if the
   trailer CRC-32 check or length doesn't match, Z_BUF_ERROR if the input ends
   prematurely or a write error occurs, or Z_ERRNO if junk (not a another gzip
   stream) follows a valid gzip stream.
 */
local int gunpipe(z_stream *strm, int infile, int outfile)
{
    int ret, first, last;
    unsigned have, flags, len;
    z_const unsigned char *next = NULL;
    struct ind ind, *indp;
    struct outd outd;

    /* setup input buffer */
    ind.infile = infile;
    ind.inbuf = inbuf;
    indp = &ind;

    /* decompress concatenated gzip streams */
    have = 0;                               /* no input data read in yet */
    first = 1;                              /* looking for first gzip header */
    strm->next_in = Z_NULL;                 /* so Z_BUF_ERROR means EOF */
    for (;;) {
        /* look for the two magic header bytes for a gzip stream */
        if (NEXT() == -1) {
            ret = Z_OK;
            break;                          /* empty gzip stream is ok */
        }
        if (last != 31 || (NEXT() != 139 && last != 157)) {
            strm->msg = (char *)"incorrect header check";
            ret = first ? Z_DATA_ERROR : Z_ERRNO;
            break;                          /* not a gzip or compress header */
        }
        first = 0;                          /* next non-header is junk */

        /* process a compress (LZW) file -- can't be concatenated after this */
        if (last == 157) {
            ret = lunpipe(have, next, indp, outfile, strm);
            break;
        }

        /* process remainder of gzip header */
        ret = Z_BUF_ERROR;
        if (NEXT() != 8) {                  /* only deflate method allowed */
            if (last == -1) break;
            strm->msg = (char *)"unknown compression method";
            ret = Z_DATA_ERROR;
            break;
        }
        flags = NEXT();                     /* header flags */
        NEXT();                             /* discard mod time, xflgs, os */
        NEXT();
        NEXT();
        NEXT();
        NEXT();
        NEXT();
        if (last == -1) break;
        if (flags & 0xe0) {
            strm->msg = (char *)"unknown header flags set";
            ret = Z_DATA_ERROR;
            break;
        }
        if (flags & 4) {                    /* extra field */
            len = NEXT();
            len += (unsigned)(NEXT()) << 8;
            if (last == -1) break;
            while (len > have) {
                len -= have;
                have = 0;
                if (NEXT() == -1) break;
                len--;
            }
            if (last == -1) break;
            have -= len;
            next += len;
        }
        if (flags & 8)                      /* file name */
            while (NEXT() != 0 && last != -1)
                ;
        if (flags & 16)                     /* comment */
            while (NEXT() != 0 && last != -1)
                ;
        if (flags & 2) {                    /* header crc */
            NEXT();
            NEXT();
        }
        if (last == -1) break;

        /* set up output */
        outd.outfile = outfile;
        outd.check = 1;
        outd.crc = crc32(0L, Z_NULL, 0);
        outd.total = 0;

        /* decompress data to output */
        strm->next_in = next;
        strm->avail_in = have;
        ret = inflateBack(strm, in, indp, out, &outd);
        if (ret != Z_STREAM_END) break;
        next = strm->next_in;
        have = strm->avail_in;
        strm->next_in = Z_NULL;             /* so Z_BUF_ERROR means EOF */

        /* check trailer */
        ret = Z_BUF_ERROR;
        if (NEXT() != (int)(outd.crc & 0xff) ||
            NEXT() != (int)((outd.crc >> 8) & 0xff) ||
            NEXT() != (int)((outd.crc >> 16) & 0xff) ||
            NEXT() != (int)((outd.crc >> 24) & 0xff)) {
            /* crc error */
            if (last != -1) {
                strm->msg = (char *)"incorrect data check";
                ret = Z_DATA_ERROR;
            }
            break;
        }
        if (NEXT() != (int)(outd.total & 0xff) ||
            NEXT() != (int)((outd.total >> 8) & 0xff) ||
            NEXT() != (int)((outd.total >> 16) & 0xff) ||
            NEXT() != (int)((outd.total >> 24) & 0xff)) {
            /* length error */
            if (last != -1) {
                strm->msg = (char *)"incorrect length check";
                ret = Z_DATA_ERROR;
            }
            break;
        }

        /* go back and look for another gzip stream */
    }

    /* clean up and return */
    return ret;
}

/* Copy file attributes, from -> to, as best we can.  This is best effort, so
   no errors are reported.  The mode bits, including suid, sgid, and the sticky
   bit are copied (if allowed), the owner's user id and group id are copied
   (again if allowed), and the access and modify times are copied. */
local void copymeta(char *from, char *to)
{
    struct stat was;
    struct utimbuf when;

    /* get all of from's Unix meta data, return if not a regular file */
    if (stat(from, &was) != 0 || (was.st_mode & S_IFMT) != S_IFREG)
        return;

    /* set to's mode bits, ignore errors */
    (void)chmod(to, was.st_mode & 07777);

    /* copy owner's user and group, ignore errors */
    (void)chown(to, was.st_uid, was.st_gid);

    /* copy access and modify times, ignore errors */
    when.actime = was.st_atime;
    when.modtime = was.st_mtime;
    (void)utime(to, &when);
}

/* Decompress the file inname to the file outnname, of if test is true, just
   decompress without writing and check the gzip trailer for integrity.  If
   inname is NULL or an empty string, read from stdin.  If outname is NULL or
   an empty string, write to stdout.  strm is a pre-initialized inflateBack
   structure.  When appropriate, copy the file attributes from inname to
   outname.

   gunzip() returns 1 if there is an out-of-memory error or an unexpected
   return code from gunpipe().  Otherwise it returns 0.
 */
local int gunzip(z_stream *strm, char *inname, char *outname, int test)
{
    int ret;
    int infile, outfile;

    /* open files */
    if (inname == NULL || *inname == 0) {
        inname = "-";
        infile = 0;     /* stdin */
    }
    else {
        infile = open(inname, O_RDONLY, 0);
        if (infile == -1) {
            fprintf(stderr, "gun cannot open %s\n", inname);
            return 0;
        }
    }
    if (test)
        outfile = -1;
    else if (outname == NULL || *outname == 0) {
        outname = "-";
        outfile = 1;    /* stdout */
    }
    else {
        outfile = open(outname, O_CREAT | O_TRUNC | O_WRONLY, 0666);
        if (outfile == -1) {
            close(infile);
            fprintf(stderr, "gun cannot create %s\n", outname);
            return 0;
        }
    }
    errno = 0;

    /* decompress */
    ret = gunpipe(strm, infile, outfile);
    if (outfile > 2) close(outfile);
    if (infile > 2) close(infile);

    /* interpret result */
    switch (ret) {
    case Z_OK:
    case Z_ERRNO:
        if (infile > 2 && outfile > 2) {
            copymeta(inname, outname);          /* copy attributes */
            unlink(inname);
        }
        if (ret == Z_ERRNO)
            fprintf(stderr, "gun warning: trailing garbage ignored in %s\n",
                    inname);
        break;
    case Z_DATA_ERROR:
        if (outfile > 2) unlink(outname);
        fprintf(stderr, "gun data error on %s: %s\n", inname, strm->msg);
        break;
    case Z_MEM_ERROR:
        if (outfile > 2) unlink(outname);
        fprintf(stderr, "gun out of memory error--aborting\n");
        return 1;
    case Z_BUF_ERROR:
        if (outfile > 2) unlink(outname);
        if (strm->next_in != Z_NULL) {
            fprintf(stderr, "gun write error on %s: %s\n",
                    outname, strerror(errno));
        }
        else if (errno) {
            fprintf(stderr, "gun read error on %s: %s\n",
                    inname, strerror(errno));
        }
        else {
            fprintf(stderr, "gun unexpected end of file on %s\n",
                    inname);
        }
        break;
    default:
        if (outfile > 2) unlink(outname);
        fprintf(stderr, "gun internal error--aborting\n");
        return 1;
    }
    return 0;
}

/* Process the gun command line arguments.  See the command syntax near the
   beginning of this source file. */
int main(int argc, char **argv)
{
    int ret, len, test;
    char *outname;
    unsigned char *window;
    z_stream strm;

    /* initialize inflateBack state for repeated use */
    window = match;                         /* reuse LZW match buffer */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    ret = inflateBackInit(&strm, 15, window);
    if (ret != Z_OK) {
        fprintf(stderr, "gun out of memory error--aborting\n");
        return 1;
    }

    /* decompress each file to the same name with the suffix removed */
    argc--;
    argv++;
    test = 0;
    if (argc && strcmp(*argv, "-h") == 0) {
        fprintf(stderr, "gun 1.6 (17 Jan 2010)\n");
        fprintf(stderr, "Copyright (C) 2003-2010 Mark Adler\n");
        fprintf(stderr, "usage: gun [-t] [file1.gz [file2.Z ...]]\n");
        return 0;
    }
    if (argc && strcmp(*argv, "-t") == 0) {
        test = 1;
        argc--;
        argv++;
    }
    if (argc)
        do {
            if (test)
                outname = NULL;
            else {
                len = (int)strlen(*argv);
                if (strcmp(*argv + len - 3, ".gz") == 0 ||
                    strcmp(*argv + len - 3, "-gz") == 0)
                    len -= 3;
                else if (strcmp(*argv + len - 2, ".z") == 0 ||
                    strcmp(*argv + len - 2, "-z") == 0 ||
                    strcmp(*argv + len - 2, "_z") == 0 ||
                    strcmp(*argv + len - 2, ".Z") == 0)
                    len -= 2;
                else {
                    fprintf(stderr, "gun error: no gz type on %s--skipping\n",
                            *argv);
                    continue;
                }
                outname = malloc(len + 1);
                if (outname == NULL) {
                    fprintf(stderr, "gun out of memory error--aborting\n");
                    ret = 1;
                    break;
                }
                memcpy(outname, *argv, len);
                outname[len] = 0;
            }
            ret = gunzip(&strm, *argv, outname, test);
            if (outname != NULL) free(outname);
            if (ret) break;
        } while (argv++, --argc);
    else
        ret = gunzip(&strm, NULL, NULL, test);

    /* clean up */
    inflateBackEnd(&strm);
    return ret;
}

Deleted compat/zlib/examples/gzappend.c.

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
























































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzappend -- command to append to a gzip file

  Copyright (C) 2003, 2012 Mark Adler, all rights reserved
  version 1.2, 11 Oct 2012

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the author be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Mark Adler    madler@alumni.caltech.edu
 */

/*
 * Change history:
 *
 * 1.0  19 Oct 2003     - First version
 * 1.1   4 Nov 2003     - Expand and clarify some comments and notes
 *                      - Add version and copyright to help
 *                      - Send help to stdout instead of stderr
 *                      - Add some preemptive typecasts
 *                      - Add L to constants in lseek() calls
 *                      - Remove some debugging information in error messages
 *                      - Use new data_type definition for zlib 1.2.1
 *                      - Simplfy and unify file operations
 *                      - Finish off gzip file in gztack()
 *                      - Use deflatePrime() instead of adding empty blocks
 *                      - Keep gzip file clean on appended file read errors
 *                      - Use in-place rotate instead of auxiliary buffer
 *                        (Why you ask?  Because it was fun to write!)
 * 1.2  11 Oct 2012     - Fix for proper z_const usage
 *                      - Check for input buffer malloc failure
 */

/*
   gzappend takes a gzip file and appends to it, compressing files from the
   command line or data from stdin.  The gzip file is written to directly, to
   avoid copying that file, in case it's large.  Note that this results in the
   unfriendly behavior that if gzappend fails, the gzip file is corrupted.

   This program was written to illustrate the use of the new Z_BLOCK option of
   zlib 1.2.x's inflate() function.  This option returns from inflate() at each
   block boundary to facilitate locating and modifying the last block bit at
   the start of the final deflate block.  Also whether using Z_BLOCK or not,
   another required feature of zlib 1.2.x is that inflate() now provides the
   number of unusued bits in the last input byte used.  gzappend will not work
   with versions of zlib earlier than 1.2.1.

   gzappend first decompresses the gzip file internally, discarding all but
   the last 32K of uncompressed data, and noting the location of the last block
   bit and the number of unused bits in the last byte of the compressed data.
   The gzip trailer containing the CRC-32 and length of the uncompressed data
   is verified.  This trailer will be later overwritten.

   Then the last block bit is cleared by seeking back in the file and rewriting
   the byte that contains it.  Seeking forward, the last byte of the compressed
   data is saved along with the number of unused bits to initialize deflate.

   A deflate process is initialized, using the last 32K of the uncompressed
   data from the gzip file to initialize the dictionary.  If the total
   uncompressed data was less than 32K, then all of it is used to initialize
   the dictionary.  The deflate output bit buffer is also initialized with the
   last bits from the original deflate stream.  From here on, the data to
   append is simply compressed using deflate, and written to the gzip file.
   When that is complete, the new CRC-32 and uncompressed length are written
   as the trailer of the gzip file.
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <fcntl.h>
#include <unistd.h>
#include "zlib.h"

#define local static
#define LGCHUNK 14
#define CHUNK (1U << LGCHUNK)
#define DSIZE 32768U

/* print an error message and terminate with extreme prejudice */
local void bye(char *msg1, char *msg2)
{
    fprintf(stderr, "gzappend error: %s%s\n", msg1, msg2);
    exit(1);
}

/* return the greatest common divisor of a and b using Euclid's algorithm,
   modified to be fast when one argument much greater than the other, and
   coded to avoid unnecessary swapping */
local unsigned gcd(unsigned a, unsigned b)
{
    unsigned c;

    while (a && b)
        if (a > b) {
            c = b;
            while (a - c >= c)
                c <<= 1;
            a -= c;
        }
        else {
            c = a;
            while (b - c >= c)
                c <<= 1;
            b -= c;
        }
    return a + b;
}

/* rotate list[0..len-1] left by rot positions, in place */
local void rotate(unsigned char *list, unsigned len, unsigned rot)
{
    unsigned char tmp;
    unsigned cycles;
    unsigned char *start, *last, *to, *from;

    /* normalize rot and handle degenerate cases */
    if (len < 2) return;
    if (rot >= len) rot %= len;
    if (rot == 0) return;

    /* pointer to last entry in list */
    last = list + (len - 1);

    /* do simple left shift by one */
    if (rot == 1) {
        tmp = *list;
        memcpy(list, list + 1, len - 1);
        *last = tmp;
        return;
    }

    /* do simple right shift by one */
    if (rot == len - 1) {
        tmp = *last;
        memmove(list + 1, list, len - 1);
        *list = tmp;
        return;
    }

    /* otherwise do rotate as a set of cycles in place */
    cycles = gcd(len, rot);             /* number of cycles */
    do {
        start = from = list + cycles;   /* start index is arbitrary */
        tmp = *from;                    /* save entry to be overwritten */
        for (;;) {
            to = from;                  /* next step in cycle */
            from += rot;                /* go right rot positions */
            if (from > last) from -= len;   /* (pointer better not wrap) */
            if (from == start) break;   /* all but one shifted */
            *to = *from;                /* shift left */
        }
        *to = tmp;                      /* complete the circle */
    } while (--cycles);
}

/* structure for gzip file read operations */
typedef struct {
    int fd;                     /* file descriptor */
    int size;                   /* 1 << size is bytes in buf */
    unsigned left;              /* bytes available at next */
    unsigned char *buf;         /* buffer */
    z_const unsigned char *next;    /* next byte in buffer */
    char *name;                 /* file name for error messages */
} file;

/* reload buffer */
local int readin(file *in)
{
    int len;

    len = read(in->fd, in->buf, 1 << in->size);
    if (len == -1) bye("error reading ", in->name);
    in->left = (unsigned)len;
    in->next = in->buf;
    return len;
}

/* read from file in, exit if end-of-file */
local int readmore(file *in)
{
    if (readin(in) == 0) bye("unexpected end of ", in->name);
    return 0;
}

#define read1(in) (in->left == 0 ? readmore(in) : 0, \
                   in->left--, *(in->next)++)

/* skip over n bytes of in */
local void skip(file *in, unsigned n)
{
    unsigned bypass;

    if (n > in->left) {
        n -= in->left;
        bypass = n & ~((1U << in->size) - 1);
        if (bypass) {
            if (lseek(in->fd, (off_t)bypass, SEEK_CUR) == -1)
                bye("seeking ", in->name);
            n -= bypass;
        }
        readmore(in);
        if (n > in->left)
            bye("unexpected end of ", in->name);
    }
    in->left -= n;
    in->next += n;
}

/* read a four-byte unsigned integer, little-endian, from in */
unsigned long read4(file *in)
{
    unsigned long val;

    val = read1(in);
    val += (unsigned)read1(in) << 8;
    val += (unsigned long)read1(in) << 16;
    val += (unsigned long)read1(in) << 24;
    return val;
}

/* skip over gzip header */
local void gzheader(file *in)
{
    int flags;
    unsigned n;

    if (read1(in) != 31 || read1(in) != 139) bye(in->name, " not a gzip file");
    if (read1(in) != 8) bye("unknown compression method in", in->name);
    flags = read1(in);
    if (flags & 0xe0) bye("unknown header flags set in", in->name);
    skip(in, 6);
    if (flags & 4) {
        n = read1(in);
        n += (unsigned)(read1(in)) << 8;
        skip(in, n);
    }
    if (flags & 8) while (read1(in) != 0) ;
    if (flags & 16) while (read1(in) != 0) ;
    if (flags & 2) skip(in, 2);
}

/* decompress gzip file "name", return strm with a deflate stream ready to
   continue compression of the data in the gzip file, and return a file
   descriptor pointing to where to write the compressed data -- the deflate
   stream is initialized to compress using level "level" */
local int gzscan(char *name, z_stream *strm, int level)
{
    int ret, lastbit, left, full;
    unsigned have;
    unsigned long crc, tot;
    unsigned char *window;
    off_t lastoff, end;
    file gz;

    /* open gzip file */
    gz.name = name;
    gz.fd = open(name, O_RDWR, 0);
    if (gz.fd == -1) bye("cannot open ", name);
    gz.buf = malloc(CHUNK);
    if (gz.buf == NULL) bye("out of memory", "");
    gz.size = LGCHUNK;
    gz.left = 0;

    /* skip gzip header */
    gzheader(&gz);

    /* prepare to decompress */
    window = malloc(DSIZE);
    if (window == NULL) bye("out of memory", "");
    strm->zalloc = Z_NULL;
    strm->zfree = Z_NULL;
    strm->opaque = Z_NULL;
    ret = inflateInit2(strm, -15);
    if (ret != Z_OK) bye("out of memory", " or library mismatch");

    /* decompress the deflate stream, saving append information */
    lastbit = 0;
    lastoff = lseek(gz.fd, 0L, SEEK_CUR) - gz.left;
    left = 0;
    strm->avail_in = gz.left;
    strm->next_in = gz.next;
    crc = crc32(0L, Z_NULL, 0);
    have = full = 0;
    do {
        /* if needed, get more input */
        if (strm->avail_in == 0) {
            readmore(&gz);
            strm->avail_in = gz.left;
            strm->next_in = gz.next;
        }

        /* set up output to next available section of sliding window */
        strm->avail_out = DSIZE - have;
        strm->next_out = window + have;

        /* inflate and check for errors */
        ret = inflate(strm, Z_BLOCK);
        if (ret == Z_STREAM_ERROR) bye("internal stream error!", "");
        if (ret == Z_MEM_ERROR) bye("out of memory", "");
        if (ret == Z_DATA_ERROR)
            bye("invalid compressed data--format violated in", name);

        /* update crc and sliding window pointer */
        crc = crc32(crc, window + have, DSIZE - have - strm->avail_out);
        if (strm->avail_out)
            have = DSIZE - strm->avail_out;
        else {
            have = 0;
            full = 1;
        }

        /* process end of block */
        if (strm->data_type & 128) {
            if (strm->data_type & 64)
                left = strm->data_type & 0x1f;
            else {
                lastbit = strm->data_type & 0x1f;
                lastoff = lseek(gz.fd, 0L, SEEK_CUR) - strm->avail_in;
            }
        }
    } while (ret != Z_STREAM_END);
    inflateEnd(strm);
    gz.left = strm->avail_in;
    gz.next = strm->next_in;

    /* save the location of the end of the compressed data */
    end = lseek(gz.fd, 0L, SEEK_CUR) - gz.left;

    /* check gzip trailer and save total for deflate */
    if (crc != read4(&gz))
        bye("invalid compressed data--crc mismatch in ", name);
    tot = strm->total_out;
    if ((tot & 0xffffffffUL) != read4(&gz))
        bye("invalid compressed data--length mismatch in", name);

    /* if not at end of file, warn */
    if (gz.left || readin(&gz))
        fprintf(stderr,
            "gzappend warning: junk at end of gzip file overwritten\n");

    /* clear last block bit */
    lseek(gz.fd, lastoff - (lastbit != 0), SEEK_SET);
    if (read(gz.fd, gz.buf, 1) != 1) bye("reading after seek on ", name);
    *gz.buf = (unsigned char)(*gz.buf ^ (1 << ((8 - lastbit) & 7)));
    lseek(gz.fd, -1L, SEEK_CUR);
    if (write(gz.fd, gz.buf, 1) != 1) bye("writing after seek to ", name);

    /* if window wrapped, build dictionary from window by rotating */
    if (full) {
        rotate(window, DSIZE, have);
        have = DSIZE;
    }

    /* set up deflate stream with window, crc, total_in, and leftover bits */
    ret = deflateInit2(strm, level, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY);
    if (ret != Z_OK) bye("out of memory", "");
    deflateSetDictionary(strm, window, have);
    strm->adler = crc;
    strm->total_in = tot;
    if (left) {
        lseek(gz.fd, --end, SEEK_SET);
        if (read(gz.fd, gz.buf, 1) != 1) bye("reading after seek on ", name);
        deflatePrime(strm, 8 - left, *gz.buf);
    }
    lseek(gz.fd, end, SEEK_SET);

    /* clean up and return */
    free(window);
    free(gz.buf);
    return gz.fd;
}

/* append file "name" to gzip file gd using deflate stream strm -- if last
   is true, then finish off the deflate stream at the end */
local void gztack(char *name, int gd, z_stream *strm, int last)
{
    int fd, len, ret;
    unsigned left;
    unsigned char *in, *out;

    /* open file to compress and append */
    fd = 0;
    if (name != NULL) {
        fd = open(name, O_RDONLY, 0);
        if (fd == -1)
            fprintf(stderr, "gzappend warning: %s not found, skipping ...\n",
                    name);
    }

    /* allocate buffers */
    in = malloc(CHUNK);
    out = malloc(CHUNK);
    if (in == NULL || out == NULL) bye("out of memory", "");

    /* compress input file and append to gzip file */
    do {
        /* get more input */
        len = read(fd, in, CHUNK);
        if (len == -1) {
            fprintf(stderr,
                    "gzappend warning: error reading %s, skipping rest ...\n",
                    name);
            len = 0;
        }
        strm->avail_in = (unsigned)len;
        strm->next_in = in;
        if (len) strm->adler = crc32(strm->adler, in, (unsigned)len);

        /* compress and write all available output */
        do {
            strm->avail_out = CHUNK;
            strm->next_out = out;
            ret = deflate(strm, last && len == 0 ? Z_FINISH : Z_NO_FLUSH);
            left = CHUNK - strm->avail_out;
            while (left) {
                len = write(gd, out + CHUNK - strm->avail_out - left, left);
                if (len == -1) bye("writing gzip file", "");
                left -= (unsigned)len;
            }
        } while (strm->avail_out == 0 && ret != Z_STREAM_END);
    } while (len != 0);

    /* write trailer after last entry */
    if (last) {
        deflateEnd(strm);
        out[0] = (unsigned char)(strm->adler);
        out[1] = (unsigned char)(strm->adler >> 8);
        out[2] = (unsigned char)(strm->adler >> 16);
        out[3] = (unsigned char)(strm->adler >> 24);
        out[4] = (unsigned char)(strm->total_in);
        out[5] = (unsigned char)(strm->total_in >> 8);
        out[6] = (unsigned char)(strm->total_in >> 16);
        out[7] = (unsigned char)(strm->total_in >> 24);
        len = 8;
        do {
            ret = write(gd, out + 8 - len, len);
            if (ret == -1) bye("writing gzip file", "");
            len -= ret;
        } while (len);
        close(gd);
    }

    /* clean up and return */
    free(out);
    free(in);
    if (fd > 0) close(fd);
}

/* process the compression level option if present, scan the gzip file, and
   append the specified files, or append the data from stdin if no other file
   names are provided on the command line -- the gzip file must be writable
   and seekable */
int main(int argc, char **argv)
{
    int gd, level;
    z_stream strm;

    /* ignore command name */
    argc--; argv++;

    /* provide usage if no arguments */
    if (*argv == NULL) {
        printf(
            "gzappend 1.2 (11 Oct 2012) Copyright (C) 2003, 2012 Mark Adler\n"
               );
        printf(
            "usage: gzappend [-level] file.gz [ addthis [ andthis ... ]]\n");
        return 0;
    }

    /* set compression level */
    level = Z_DEFAULT_COMPRESSION;
    if (argv[0][0] == '-') {
        if (argv[0][1] < '0' || argv[0][1] > '9' || argv[0][2] != 0)
            bye("invalid compression level", "");
        level = argv[0][1] - '0';
        if (*++argv == NULL) bye("no gzip file name after options", "");
    }

    /* prepare to append to gzip file */
    gd = gzscan(*argv++, &strm, level);

    /* append files on command line, or from stdin if none */
    if (*argv == NULL)
        gztack(NULL, gd, &strm, 1);
    else
        do {
            gztack(*argv, gd, &strm, argv[1] == NULL);
        } while (*++argv != NULL);
    return 0;
}

Deleted compat/zlib/examples/gzjoin.c.

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

































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzjoin -- command to join gzip files into one gzip file

  Copyright (C) 2004, 2005, 2012 Mark Adler, all rights reserved
  version 1.2, 14 Aug 2012

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the author be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Mark Adler    madler@alumni.caltech.edu
 */

/*
 * Change history:
 *
 * 1.0  11 Dec 2004     - First version
 * 1.1  12 Jun 2005     - Changed ssize_t to long for portability
 * 1.2  14 Aug 2012     - Clean up for z_const usage
 */

/*
   gzjoin takes one or more gzip files on the command line and writes out a
   single gzip file that will uncompress to the concatenation of the
   uncompressed data from the individual gzip files.  gzjoin does this without
   having to recompress any of the data and without having to calculate a new
   crc32 for the concatenated uncompressed data.  gzjoin does however have to
   decompress all of the input data in order to find the bits in the compressed
   data that need to be modified to concatenate the streams.

   gzjoin does not do an integrity check on the input gzip files other than
   checking the gzip header and decompressing the compressed data.  They are
   otherwise assumed to be complete and correct.

   Each joint between gzip files removes at least 18 bytes of previous trailer
   and subsequent header, and inserts an average of about three bytes to the
   compressed data in order to connect the streams.  The output gzip file
   has a minimal ten-byte gzip header with no file name or modification time.

   This program was written to illustrate the use of the Z_BLOCK option of
   inflate() and the crc32_combine() function.  gzjoin will not compile with
   versions of zlib earlier than 1.2.3.
 */

#include <stdio.h>      /* fputs(), fprintf(), fwrite(), putc() */
#include <stdlib.h>     /* exit(), malloc(), free() */
#include <fcntl.h>      /* open() */
#include <unistd.h>     /* close(), read(), lseek() */
#include "zlib.h"
    /* crc32(), crc32_combine(), inflateInit2(), inflate(), inflateEnd() */

#define local static

/* exit with an error (return a value to allow use in an expression) */
local int bail(char *why1, char *why2)
{
    fprintf(stderr, "gzjoin error: %s%s, output incomplete\n", why1, why2);
    exit(1);
    return 0;
}

/* -- simple buffered file input with access to the buffer -- */

#define CHUNK 32768         /* must be a power of two and fit in unsigned */

/* bin buffered input file type */
typedef struct {
    char *name;             /* name of file for error messages */
    int fd;                 /* file descriptor */
    unsigned left;          /* bytes remaining at next */
    unsigned char *next;    /* next byte to read */
    unsigned char *buf;     /* allocated buffer of length CHUNK */
} bin;

/* close a buffered file and free allocated memory */
local void bclose(bin *in)
{
    if (in != NULL) {
        if (in->fd != -1)
            close(in->fd);
        if (in->buf != NULL)
            free(in->buf);
        free(in);
    }
}

/* open a buffered file for input, return a pointer to type bin, or NULL on
   failure */
local bin *bopen(char *name)
{
    bin *in;

    in = malloc(sizeof(bin));
    if (in == NULL)
        return NULL;
    in->buf = malloc(CHUNK);
    in->fd = open(name, O_RDONLY, 0);
    if (in->buf == NULL || in->fd == -1) {
        bclose(in);
        return NULL;
    }
    in->left = 0;
    in->next = in->buf;
    in->name = name;
    return in;
}

/* load buffer from file, return -1 on read error, 0 or 1 on success, with
   1 indicating that end-of-file was reached */
local int bload(bin *in)
{
    long len;

    if (in == NULL)
        return -1;
    if (in->left != 0)
        return 0;
    in->next = in->buf;
    do {
        len = (long)read(in->fd, in->buf + in->left, CHUNK - in->left);
        if (len < 0)
            return -1;
        in->left += (unsigned)len;
    } while (len != 0 && in->left < CHUNK);
    return len == 0 ? 1 : 0;
}

/* get a byte from the file, bail if end of file */
#define bget(in) (in->left ? 0 : bload(in), \
                  in->left ? (in->left--, *(in->next)++) : \
                    bail("unexpected end of file on ", in->name))

/* get a four-byte little-endian unsigned integer from file */
local unsigned long bget4(bin *in)
{
    unsigned long val;

    val = bget(in);
    val += (unsigned long)(bget(in)) << 8;
    val += (unsigned long)(bget(in)) << 16;
    val += (unsigned long)(bget(in)) << 24;
    return val;
}

/* skip bytes in file */
local void bskip(bin *in, unsigned skip)
{
    /* check pointer */
    if (in == NULL)
        return;

    /* easy case -- skip bytes in buffer */
    if (skip <= in->left) {
        in->left -= skip;
        in->next += skip;
        return;
    }

    /* skip what's in buffer, discard buffer contents */
    skip -= in->left;
    in->left = 0;

    /* seek past multiples of CHUNK bytes */
    if (skip > CHUNK) {
        unsigned left;

        left = skip & (CHUNK - 1);
        if (left == 0) {
            /* exact number of chunks: seek all the way minus one byte to check
               for end-of-file with a read */
            lseek(in->fd, skip - 1, SEEK_CUR);
            if (read(in->fd, in->buf, 1) != 1)
                bail("unexpected end of file on ", in->name);
            return;
        }

        /* skip the integral chunks, update skip with remainder */
        lseek(in->fd, skip - left, SEEK_CUR);
        skip = left;
    }

    /* read more input and skip remainder */
    bload(in);
    if (skip > in->left)
        bail("unexpected end of file on ", in->name);
    in->left -= skip;
    in->next += skip;
}

/* -- end of buffered input functions -- */

/* skip the gzip header from file in */
local void gzhead(bin *in)
{
    int flags;

    /* verify gzip magic header and compression method */
    if (bget(in) != 0x1f || bget(in) != 0x8b || bget(in) != 8)
        bail(in->name, " is not a valid gzip file");

    /* get and verify flags */
    flags = bget(in);
    if ((flags & 0xe0) != 0)
        bail("unknown reserved bits set in ", in->name);

    /* skip modification time, extra flags, and os */
    bskip(in, 6);

    /* skip extra field if present */
    if (flags & 4) {
        unsigned len;

        len = bget(in);
        len += (unsigned)(bget(in)) << 8;
        bskip(in, len);
    }

    /* skip file name if present */
    if (flags & 8)
        while (bget(in) != 0)
            ;

    /* skip comment if present */
    if (flags & 16)
        while (bget(in) != 0)
            ;

    /* skip header crc if present */
    if (flags & 2)
        bskip(in, 2);
}

/* write a four-byte little-endian unsigned integer to out */
local void put4(unsigned long val, FILE *out)
{
    putc(val & 0xff, out);
    putc((val >> 8) & 0xff, out);
    putc((val >> 16) & 0xff, out);
    putc((val >> 24) & 0xff, out);
}

/* Load up zlib stream from buffered input, bail if end of file */
local void zpull(z_streamp strm, bin *in)
{
    if (in->left == 0)
        bload(in);
    if (in->left == 0)
        bail("unexpected end of file on ", in->name);
    strm->avail_in = in->left;
    strm->next_in = in->next;
}

/* Write header for gzip file to out and initialize trailer. */
local void gzinit(unsigned long *crc, unsigned long *tot, FILE *out)
{
    fwrite("\x1f\x8b\x08\0\0\0\0\0\0\xff", 1, 10, out);
    *crc = crc32(0L, Z_NULL, 0);
    *tot = 0;
}

/* Copy the compressed data from name, zeroing the last block bit of the last
   block if clr is true, and adding empty blocks as needed to get to a byte
   boundary.  If clr is false, then the last block becomes the last block of
   the output, and the gzip trailer is written.  crc and tot maintains the
   crc and length (modulo 2^32) of the output for the trailer.  The resulting
   gzip file is written to out.  gzinit() must be called before the first call
   of gzcopy() to write the gzip header and to initialize crc and tot. */
local void gzcopy(char *name, int clr, unsigned long *crc, unsigned long *tot,
                  FILE *out)
{
    int ret;                /* return value from zlib functions */
    int pos;                /* where the "last block" bit is in byte */
    int last;               /* true if processing the last block */
    bin *in;                /* buffered input file */
    unsigned char *start;   /* start of compressed data in buffer */
    unsigned char *junk;    /* buffer for uncompressed data -- discarded */
    z_off_t len;            /* length of uncompressed data (support > 4 GB) */
    z_stream strm;          /* zlib inflate stream */

    /* open gzip file and skip header */
    in = bopen(name);
    if (in == NULL)
        bail("could not open ", name);
    gzhead(in);

    /* allocate buffer for uncompressed data and initialize raw inflate
       stream */
    junk = malloc(CHUNK);
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit2(&strm, -15);
    if (junk == NULL || ret != Z_OK)
        bail("out of memory", "");

    /* inflate and copy compressed data, clear last-block bit if requested */
    len = 0;
    zpull(&strm, in);
    start = in->next;
    last = start[0] & 1;
    if (last && clr)
        start[0] &= ~1;
    strm.avail_out = 0;
    for (;;) {
        /* if input used and output done, write used input and get more */
        if (strm.avail_in == 0 && strm.avail_out != 0) {
            fwrite(start, 1, strm.next_in - start, out);
            start = in->buf;
            in->left = 0;
            zpull(&strm, in);
        }

        /* decompress -- return early when end-of-block reached */
        strm.avail_out = CHUNK;
        strm.next_out = junk;
        ret = inflate(&strm, Z_BLOCK);
        switch (ret) {
        case Z_MEM_ERROR:
            bail("out of memory", "");
        case Z_DATA_ERROR:
            bail("invalid compressed data in ", in->name);
        }

        /* update length of uncompressed data */
        len += CHUNK - strm.avail_out;

        /* check for block boundary (only get this when block copied out) */
        if (strm.data_type & 128) {
            /* if that was the last block, then done */
            if (last)
                break;

            /* number of unused bits in last byte */
            pos = strm.data_type & 7;

            /* find the next last-block bit */
            if (pos != 0) {
                /* next last-block bit is in last used byte */
                pos = 0x100 >> pos;
                last = strm.next_in[-1] & pos;
                if (last && clr)
                    in->buf[strm.next_in - in->buf - 1] &= ~pos;
            }
            else {
                /* next last-block bit is in next unused byte */
                if (strm.avail_in == 0) {
                    /* don't have that byte yet -- get it */
                    fwrite(start, 1, strm.next_in - start, out);
                    start = in->buf;
                    in->left = 0;
                    zpull(&strm, in);
                }
                last = strm.next_in[0] & 1;
                if (last && clr)
                    in->buf[strm.next_in - in->buf] &= ~1;
            }
        }
    }

    /* update buffer with unused input */
    in->left = strm.avail_in;
    in->next = in->buf + (strm.next_in - in->buf);

    /* copy used input, write empty blocks to get to byte boundary */
    pos = strm.data_type & 7;
    fwrite(start, 1, in->next - start - 1, out);
    last = in->next[-1];
    if (pos == 0 || !clr)
        /* already at byte boundary, or last file: write last byte */
        putc(last, out);
    else {
        /* append empty blocks to last byte */
        last &= ((0x100 >> pos) - 1);       /* assure unused bits are zero */
        if (pos & 1) {
            /* odd -- append an empty stored block */
            putc(last, out);
            if (pos == 1)
                putc(0, out);               /* two more bits in block header */
            fwrite("\0\0\xff\xff", 1, 4, out);
        }
        else {
            /* even -- append 1, 2, or 3 empty fixed blocks */
            switch (pos) {
            case 6:
                putc(last | 8, out);
                last = 0;
            case 4:
                putc(last | 0x20, out);
                last = 0;
            case 2:
                putc(last | 0x80, out);
                putc(0, out);
            }
        }
    }

    /* update crc and tot */
    *crc = crc32_combine(*crc, bget4(in), len);
    *tot += (unsigned long)len;

    /* clean up */
    inflateEnd(&strm);
    free(junk);
    bclose(in);

    /* write trailer if this is the last gzip file */
    if (!clr) {
        put4(*crc, out);
        put4(*tot, out);
    }
}

/* join the gzip files on the command line, write result to stdout */
int main(int argc, char **argv)
{
    unsigned long crc, tot;     /* running crc and total uncompressed length */

    /* skip command name */
    argc--;
    argv++;

    /* show usage if no arguments */
    if (argc == 0) {
        fputs("gzjoin usage: gzjoin f1.gz [f2.gz [f3.gz ...]] > fjoin.gz\n",
              stderr);
        return 0;
    }

    /* join gzip files on command line and write to stdout */
    gzinit(&crc, &tot, stdout);
    while (argc--)
        gzcopy(*argv++, argc, &crc, &tot, stdout);

    /* done */
    return 0;
}

Deleted compat/zlib/examples/gzlog.c.

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



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * gzlog.c
 * Copyright (C) 2004, 2008, 2012, 2016 Mark Adler, all rights reserved
 * For conditions of distribution and use, see copyright notice in gzlog.h
 * version 2.2, 14 Aug 2012
 */

/*
   gzlog provides a mechanism for frequently appending short strings to a gzip
   file that is efficient both in execution time and compression ratio.  The
   strategy is to write the short strings in an uncompressed form to the end of
   the gzip file, only compressing when the amount of uncompressed data has
   reached a given threshold.

   gzlog also provides protection against interruptions in the process due to
   system crashes.  The status of the operation is recorded in an extra field
   in the gzip file, and is only updated once the gzip file is brought to a
   valid state.  The last data to be appended or compressed is saved in an
   auxiliary file, so that if the operation is interrupted, it can be completed
   the next time an append operation is attempted.

   gzlog maintains another auxiliary file with the last 32K of data from the
   compressed portion, which is preloaded for the compression of the subsequent
   data.  This minimizes the impact to the compression ratio of appending.
 */

/*
   Operations Concept:

   Files (log name "foo"):
   foo.gz -- gzip file with the complete log
   foo.add -- last message to append or last data to compress
   foo.dict -- dictionary of the last 32K of data for next compression
   foo.temp -- temporary dictionary file for compression after this one
   foo.lock -- lock file for reading and writing the other files
   foo.repairs -- log file for log file recovery operations (not compressed)

   gzip file structure:
   - fixed-length (no file name) header with extra field (see below)
   - compressed data ending initially with empty stored block
   - uncompressed data filling out originally empty stored block and
     subsequent stored blocks as needed (16K max each)
   - gzip trailer
   - no junk at end (no other gzip streams)

   When appending data, the information in the first three items above plus the
   foo.add file are sufficient to recover an interrupted append operation.  The
   extra field has the necessary information to restore the start of the last
   stored block and determine where to append the data in the foo.add file, as
   well as the crc and length of the gzip data before the append operation.

   The foo.add file is created before the gzip file is marked for append, and
   deleted after the gzip file is marked as complete.  So if the append
   operation is interrupted, the data to add will still be there.  If due to
   some external force, the foo.add file gets deleted between when the append
   operation was interrupted and when recovery is attempted, the gzip file will
   still be restored, but without the appended data.

   When compressing data, the information in the first two items above plus the
   foo.add file are sufficient to recover an interrupted compress operation.
   The extra field has the necessary information to find the end of the
   compressed data, and contains both the crc and length of just the compressed
   data and of the complete set of data including the contents of the foo.add
   file.

   Again, the foo.add file is maintained during the compress operation in case
   of an interruption.  If in the unlikely event the foo.add file with the data
   to be compressed is missing due to some external force, a gzip file with
   just the previous compressed data will be reconstructed.  In this case, all
   of the data that was to be compressed is lost (approximately one megabyte).
   This will not occur if all that happened was an interruption of the compress
   operation.

   The third state that is marked is the replacement of the old dictionary with
   the new dictionary after a compress operation.  Once compression is
   complete, the gzip file is marked as being in the replace state.  This
   completes the gzip file, so an interrupt after being so marked does not
   result in recompression.  Then the dictionary file is replaced, and the gzip
   file is marked as completed.  This state prevents the possibility of
   restarting compression with the wrong dictionary file.

   All three operations are wrapped by a lock/unlock procedure.  In order to
   gain exclusive access to the log files, first a foo.lock file must be
   exclusively created.  When all operations are complete, the lock is
   released by deleting the foo.lock file.  If when attempting to create the
   lock file, it already exists and the modify time of the lock file is more
   than five minutes old (set by the PATIENCE define below), then the old
   lock file is considered stale and deleted, and the exclusive creation of
   the lock file is retried.  To assure that there are no false assessments
   of the staleness of the lock file, the operations periodically touch the
   lock file to update the modified date.

   Following is the definition of the extra field with all of the information
   required to enable the above append and compress operations and their
   recovery if interrupted.  Multi-byte values are stored little endian
   (consistent with the gzip format).  File pointers are eight bytes long.
   The crc's and lengths for the gzip trailer are four bytes long.  (Note that
   the length at the end of a gzip file is used for error checking only, and
   for large files is actually the length modulo 2^32.)  The stored block
   length is two bytes long.  The gzip extra field two-byte identification is
   "ap" for append.  It is assumed that writing the extra field to the file is
   an "atomic" operation.  That is, either all of the extra field is written
   to the file, or none of it is, if the operation is interrupted right at the
   point of updating the extra field.  This is a reasonable assumption, since
   the extra field is within the first 52 bytes of the file, which is smaller
   than any expected block size for a mass storage device (usually 512 bytes or
   larger).

   Extra field (35 bytes):
   - Pointer to first stored block length -- this points to the two-byte length
     of the first stored block, which is followed by the two-byte, one's
     complement of that length.  The stored block length is preceded by the
     three-bit header of the stored block, which is the actual start of the
     stored block in the deflate format.  See the bit offset field below.
   - Pointer to the last stored block length.  This is the same as above, but
     for the last stored block of the uncompressed data in the gzip file.
     Initially this is the same as the first stored block length pointer.
     When the stored block gets to 16K (see the MAX_STORE define), then a new
     stored block as added, at which point the last stored block length pointer
     is different from the first stored block length pointer.  When they are
     different, the first bit of the last stored block header is eight bits, or
     one byte back from the block length.
   - Compressed data crc and length.  This is the crc and length of the data
     that is in the compressed portion of the deflate stream.  These are used
     only in the event that the foo.add file containing the data to compress is
     lost after a compress operation is interrupted.
   - Total data crc and length.  This is the crc and length of all of the data
     stored in the gzip file, compressed and uncompressed.  It is used to
     reconstruct the gzip trailer when compressing, as well as when recovering
     interrupted operations.
   - Final stored block length.  This is used to quickly find where to append,
     and allows the restoration of the original final stored block state when
     an append operation is interrupted.
   - First stored block start as the number of bits back from the final stored
     block first length byte.  This value is in the range of 3..10, and is
     stored as the low three bits of the final byte of the extra field after
     subtracting three (0..7).  This allows the last-block bit of the stored
     block header to be updated when a new stored block is added, for the case
     when the first stored block and the last stored block are the same.  (When
     they are different, the numbers of bits back is known to be eight.)  This
     also allows for new compressed data to be appended to the old compressed
     data in the compress operation, overwriting the previous first stored
     block, or for the compressed data to be terminated and a valid gzip file
     reconstructed on the off chance that a compression operation was
     interrupted and the data to compress in the foo.add file was deleted.
   - The operation in process.  This is the next two bits in the last byte (the
     bits under the mask 0x18).  The are interpreted as 0: nothing in process,
     1: append in process, 2: compress in process, 3: replace in process.
   - The top three bits of the last byte in the extra field are reserved and
     are currently set to zero.

   Main procedure:
   - Exclusively create the foo.lock file using the O_CREAT and O_EXCL modes of
     the system open() call.  If the modify time of an existing lock file is
     more than PATIENCE seconds old, then the lock file is deleted and the
     exclusive create is retried.
   - Load the extra field from the foo.gz file, and see if an operation was in
     progress but not completed.  If so, apply the recovery procedure below.
   - Perform the append procedure with the provided data.
   - If the uncompressed data in the foo.gz file is 1MB or more, apply the
     compress procedure.
   - Delete the foo.lock file.

   Append procedure:
   - Put what to append in the foo.add file so that the operation can be
     restarted if this procedure is interrupted.
   - Mark the foo.gz extra field with the append operation in progress.
   + Restore the original last-block bit and stored block length of the last
     stored block from the information in the extra field, in case a previous
     append operation was interrupted.
   - Append the provided data to the last stored block, creating new stored
     blocks as needed and updating the stored blocks last-block bits and
     lengths.
   - Update the crc and length with the new data, and write the gzip trailer.
   - Write over the extra field (with a single write operation) with the new
     pointers, lengths, and crc's, and mark the gzip file as not in process.
     Though there is still a foo.add file, it will be ignored since nothing
     is in process.  If a foo.add file is leftover from a previously
     completed operation, it is truncated when writing new data to it.
   - Delete the foo.add file.

   Compress and replace procedures:
   - Read all of the uncompressed data in the stored blocks in foo.gz and write
     it to foo.add.  Also write foo.temp with the last 32K of that data to
     provide a dictionary for the next invocation of this procedure.
   - Rewrite the extra field marking foo.gz with a compression in process.
   * If there is no data provided to compress (due to a missing foo.add file
     when recovering), reconstruct and truncate the foo.gz file to contain
     only the previous compressed data and proceed to the step after the next
     one.  Otherwise ...
   - Compress the data with the dictionary in foo.dict, and write to the
     foo.gz file starting at the bit immediately following the last previously
     compressed block.  If there is no foo.dict, proceed anyway with the
     compression at slightly reduced efficiency.  (For the foo.dict file to be
     missing requires some external failure beyond simply the interruption of
     a compress operation.)  During this process, the foo.lock file is
     periodically touched to assure that that file is not considered stale by
     another process before we're done.  The deflation is terminated with a
     non-last empty static block (10 bits long), that is then located and
     written over by a last-bit-set empty stored block.
   - Append the crc and length of the data in the gzip file (previously
     calculated during the append operations).
   - Write over the extra field with the updated stored block offsets, bits
     back, crc's, and lengths, and mark foo.gz as in process for a replacement
     of the dictionary.
   @ Delete the foo.add file.
   - Replace foo.dict with foo.temp.
   - Write over the extra field, marking foo.gz as complete.

   Recovery procedure:
   - If not a replace recovery, read in the foo.add file, and provide that data
     to the appropriate recovery below.  If there is no foo.add file, provide
     a zero data length to the recovery.  In that case, the append recovery
     restores the foo.gz to the previous compressed + uncompressed data state.
     For the the compress recovery, a missing foo.add file results in foo.gz
     being restored to the previous compressed-only data state.
   - Append recovery:
     - Pick up append at + step above
   - Compress recovery:
     - Pick up compress at * step above
   - Replace recovery:
     - Pick up compress at @ step above
   - Log the repair with a date stamp in foo.repairs
 */

#include <sys/types.h>
#include <stdio.h>      /* rename, fopen, fprintf, fclose */
#include <stdlib.h>     /* malloc, free */
#include <string.h>     /* strlen, strrchr, strcpy, strncpy, strcmp */
#include <fcntl.h>      /* open */
#include <unistd.h>     /* lseek, read, write, close, unlink, sleep, */
                        /* ftruncate, fsync */
#include <errno.h>      /* errno */
#include <time.h>       /* time, ctime */
#include <sys/stat.h>   /* stat */
#include <sys/time.h>   /* utimes */
#include "zlib.h"       /* crc32 */

#include "gzlog.h"      /* header for external access */

#define local static
typedef unsigned int uint;
typedef unsigned long ulong;

/* Macro for debugging to deterministically force recovery operations */
#ifdef GZLOG_DEBUG
    #include <setjmp.h>         /* longjmp */
    jmp_buf gzlog_jump;         /* where to go back to */
    int gzlog_bail = 0;         /* which point to bail at (1..8) */
    int gzlog_count = -1;       /* number of times through to wait */
#   define BAIL(n) do { if (n == gzlog_bail && gzlog_count-- == 0) \
                            longjmp(gzlog_jump, gzlog_bail); } while (0)
#else
#   define BAIL(n)
#endif

/* how old the lock file can be in seconds before considering it stale */
#define PATIENCE 300

/* maximum stored block size in Kbytes -- must be in 1..63 */
#define MAX_STORE 16

/* number of stored Kbytes to trigger compression (must be >= 32 to allow
   dictionary construction, and <= 204 * MAX_STORE, in order for >> 10 to
   discard the stored block headers contribution of five bytes each) */
#define TRIGGER 1024

/* size of a deflate dictionary (this cannot be changed) */
#define DICT 32768U

/* values for the operation (2 bits) */
#define NO_OP 0
#define APPEND_OP 1
#define COMPRESS_OP 2
#define REPLACE_OP 3

/* macros to extract little-endian integers from an unsigned byte buffer */
#define PULL2(p) ((p)[0]+((uint)((p)[1])<<8))
#define PULL4(p) (PULL2(p)+((ulong)PULL2(p+2)<<16))
#define PULL8(p) (PULL4(p)+((off_t)PULL4(p+4)<<32))

/* macros to store integers into a byte buffer in little-endian order */
#define PUT2(p,a) do {(p)[0]=a;(p)[1]=(a)>>8;} while(0)
#define PUT4(p,a) do {PUT2(p,a);PUT2(p+2,a>>16);} while(0)
#define PUT8(p,a) do {PUT4(p,a);PUT4(p+4,a>>32);} while(0)

/* internal structure for log information */
#define LOGID "\106\035\172"    /* should be three non-zero characters */
struct log {
    char id[4];     /* contains LOGID to detect inadvertent overwrites */
    int fd;         /* file descriptor for .gz file, opened read/write */
    char *path;     /* allocated path, e.g. "/var/log/foo" or "foo" */
    char *end;      /* end of path, for appending suffices such as ".gz" */
    off_t first;    /* offset of first stored block first length byte */
    int back;       /* location of first block id in bits back from first */
    uint stored;    /* bytes currently in last stored block */
    off_t last;     /* offset of last stored block first length byte */
    ulong ccrc;     /* crc of compressed data */
    ulong clen;     /* length (modulo 2^32) of compressed data */
    ulong tcrc;     /* crc of total data */
    ulong tlen;     /* length (modulo 2^32) of total data */
    time_t lock;    /* last modify time of our lock file */
};

/* gzip header for gzlog */
local unsigned char log_gzhead[] = {
    0x1f, 0x8b,                 /* magic gzip id */
    8,                          /* compression method is deflate */
    4,                          /* there is an extra field (no file name) */
    0, 0, 0, 0,                 /* no modification time provided */
    0, 0xff,                    /* no extra flags, no OS specified */
    39, 0, 'a', 'p', 35, 0      /* extra field with "ap" subfield */
                                /* 35 is EXTRA, 39 is EXTRA + 4 */
};

#define HEAD sizeof(log_gzhead)     /* should be 16 */

/* initial gzip extra field content (52 == HEAD + EXTRA + 1) */
local unsigned char log_gzext[] = {
    52, 0, 0, 0, 0, 0, 0, 0,    /* offset of first stored block length */
    52, 0, 0, 0, 0, 0, 0, 0,    /* offset of last stored block length */
    0, 0, 0, 0, 0, 0, 0, 0,     /* compressed data crc and length */
    0, 0, 0, 0, 0, 0, 0, 0,     /* total data crc and length */
    0, 0,                       /* final stored block data length */
    5                           /* op is NO_OP, last bit 8 bits back */
};

#define EXTRA sizeof(log_gzext)     /* should be 35 */

/* initial gzip data and trailer */
local unsigned char log_gzbody[] = {
    1, 0, 0, 0xff, 0xff,        /* empty stored block (last) */
    0, 0, 0, 0,                 /* crc */
    0, 0, 0, 0                  /* uncompressed length */
};

#define BODY sizeof(log_gzbody)

/* Exclusively create foo.lock in order to negotiate exclusive access to the
   foo.* files.  If the modify time of an existing lock file is greater than
   PATIENCE seconds in the past, then consider the lock file to have been
   abandoned, delete it, and try the exclusive create again.  Save the lock
   file modify time for verification of ownership.  Return 0 on success, or -1
   on failure, usually due to an access restriction or invalid path.  Note that
   if stat() or unlink() fails, it may be due to another process noticing the
   abandoned lock file a smidge sooner and deleting it, so those are not
   flagged as an error. */
local int log_lock(struct log *log)
{
    int fd;
    struct stat st;

    strcpy(log->end, ".lock");
    while ((fd = open(log->path, O_CREAT | O_EXCL, 0644)) < 0) {
        if (errno != EEXIST)
            return -1;
        if (stat(log->path, &st) == 0 && time(NULL) - st.st_mtime > PATIENCE) {
            unlink(log->path);
            continue;
        }
        sleep(2);       /* relinquish the CPU for two seconds while waiting */
    }
    close(fd);
    if (stat(log->path, &st) == 0)
        log->lock = st.st_mtime;
    return 0;
}

/* Update the modify time of the lock file to now, in order to prevent another
   task from thinking that the lock is stale.  Save the lock file modify time
   for verification of ownership. */
local void log_touch(struct log *log)
{
    struct stat st;

    strcpy(log->end, ".lock");
    utimes(log->path, NULL);
    if (stat(log->path, &st) == 0)
        log->lock = st.st_mtime;
}

/* Check the log file modify time against what is expected.  Return true if
   this is not our lock.  If it is our lock, touch it to keep it. */
local int log_check(struct log *log)
{
    struct stat st;

    strcpy(log->end, ".lock");
    if (stat(log->path, &st) || st.st_mtime != log->lock)
        return 1;
    log_touch(log);
    return 0;
}

/* Unlock a previously acquired lock, but only if it's ours. */
local void log_unlock(struct log *log)
{
    if (log_check(log))
        return;
    strcpy(log->end, ".lock");
    unlink(log->path);
    log->lock = 0;
}

/* Check the gzip header and read in the extra field, filling in the values in
   the log structure.  Return op on success or -1 if the gzip header was not as
   expected.  op is the current operation in progress last written to the extra
   field.  This assumes that the gzip file has already been opened, with the
   file descriptor log->fd. */
local int log_head(struct log *log)
{
    int op;
    unsigned char buf[HEAD + EXTRA];

    if (lseek(log->fd, 0, SEEK_SET) < 0 ||
        read(log->fd, buf, HEAD + EXTRA) != HEAD + EXTRA ||
        memcmp(buf, log_gzhead, HEAD)) {
        return -1;
    }
    log->first = PULL8(buf + HEAD);
    log->last = PULL8(buf + HEAD + 8);
    log->ccrc = PULL4(buf + HEAD + 16);
    log->clen = PULL4(buf + HEAD + 20);
    log->tcrc = PULL4(buf + HEAD + 24);
    log->tlen = PULL4(buf + HEAD + 28);
    log->stored = PULL2(buf + HEAD + 32);
    log->back = 3 + (buf[HEAD + 34] & 7);
    op = (buf[HEAD + 34] >> 3) & 3;
    return op;
}

/* Write over the extra field contents, marking the operation as op.  Use fsync
   to assure that the device is written to, and in the requested order.  This
   operation, and only this operation, is assumed to be atomic in order to
   assure that the log is recoverable in the event of an interruption at any
   point in the process.  Return -1 if the write to foo.gz failed. */
local int log_mark(struct log *log, int op)
{
    int ret;
    unsigned char ext[EXTRA];

    PUT8(ext, log->first);
    PUT8(ext + 8, log->last);
    PUT4(ext + 16, log->ccrc);
    PUT4(ext + 20, log->clen);
    PUT4(ext + 24, log->tcrc);
    PUT4(ext + 28, log->tlen);
    PUT2(ext + 32, log->stored);
    ext[34] = log->back - 3 + (op << 3);
    fsync(log->fd);
    ret = lseek(log->fd, HEAD, SEEK_SET) < 0 ||
          write(log->fd, ext, EXTRA) != EXTRA ? -1 : 0;
    fsync(log->fd);
    return ret;
}

/* Rewrite the last block header bits and subsequent zero bits to get to a byte
   boundary, setting the last block bit if last is true, and then write the
   remainder of the stored block header (length and one's complement).  Leave
   the file pointer after the end of the last stored block data.  Return -1 if
   there is a read or write failure on the foo.gz file */
local int log_last(struct log *log, int last)
{
    int back, len, mask;
    unsigned char buf[6];

    /* determine the locations of the bytes and bits to modify */
    back = log->last == log->first ? log->back : 8;
    len = back > 8 ? 2 : 1;                 /* bytes back from log->last */
    mask = 0x80 >> ((back - 1) & 7);        /* mask for block last-bit */

    /* get the byte to modify (one or two back) into buf[0] -- don't need to
       read the byte if the last-bit is eight bits back, since in that case
       the entire byte will be modified */
    buf[0] = 0;
    if (back != 8 && (lseek(log->fd, log->last - len, SEEK_SET) < 0 ||
                      read(log->fd, buf, 1) != 1))
        return -1;

    /* change the last-bit of the last stored block as requested -- note
       that all bits above the last-bit are set to zero, per the type bits
       of a stored block being 00 and per the convention that the bits to
       bring the stream to a byte boundary are also zeros */
    buf[1] = 0;
    buf[2 - len] = (*buf & (mask - 1)) + (last ? mask : 0);

    /* write the modified stored block header and lengths, move the file
       pointer to after the last stored block data */
    PUT2(buf + 2, log->stored);
    PUT2(buf + 4, log->stored ^ 0xffff);
    return lseek(log->fd, log->last - len, SEEK_SET) < 0 ||
           write(log->fd, buf + 2 - len, len + 4) != len + 4 ||
           lseek(log->fd, log->stored, SEEK_CUR) < 0 ? -1 : 0;
}

/* Append len bytes from data to the locked and open log file.  len may be zero
   if recovering and no .add file was found.  In that case, the previous state
   of the foo.gz file is restored.  The data is appended uncompressed in
   deflate stored blocks.  Return -1 if there was an error reading or writing
   the foo.gz file. */
local int log_append(struct log *log, unsigned char *data, size_t len)
{
    uint put;
    off_t end;
    unsigned char buf[8];

    /* set the last block last-bit and length, in case recovering an
       interrupted append, then position the file pointer to append to the
       block */
    if (log_last(log, 1))
        return -1;

    /* append, adding stored blocks and updating the offset of the last stored
       block as needed, and update the total crc and length */
    while (len) {
        /* append as much as we can to the last block */
        put = (MAX_STORE << 10) - log->stored;
        if (put > len)
            put = (uint)len;
        if (put) {
            if (write(log->fd, data, put) != put)
                return -1;
            BAIL(1);
            log->tcrc = crc32(log->tcrc, data, put);
            log->tlen += put;
            log->stored += put;
            data += put;
            len -= put;
        }

        /* if we need to, add a new empty stored block */
        if (len) {
            /* mark current block as not last */
            if (log_last(log, 0))
                return -1;

            /* point to new, empty stored block */
            log->last += 4 + log->stored + 1;
            log->stored = 0;
        }

        /* mark last block as last, update its length */
        if (log_last(log, 1))
            return -1;
        BAIL(2);
    }

    /* write the new crc and length trailer, and truncate just in case (could
       be recovering from partial append with a missing foo.add file) */
    PUT4(buf, log->tcrc);
    PUT4(buf + 4, log->tlen);
    if (write(log->fd, buf, 8) != 8 ||
        (end = lseek(log->fd, 0, SEEK_CUR)) < 0 || ftruncate(log->fd, end))
        return -1;

    /* write the extra field, marking the log file as done, delete .add file */
    if (log_mark(log, NO_OP))
        return -1;
    strcpy(log->end, ".add");
    unlink(log->path);          /* ignore error, since may not exist */
    return 0;
}

/* Replace the foo.dict file with the foo.temp file.  Also delete the foo.add
   file, since the compress operation may have been interrupted before that was
   done.  Returns 1 if memory could not be allocated, or -1 if reading or
   writing foo.gz fails, or if the rename fails for some reason other than
   foo.temp not existing.  foo.temp not existing is a permitted error, since
   the replace operation may have been interrupted after the rename is done,
   but before foo.gz is marked as complete. */
local int log_replace(struct log *log)
{
    int ret;
    char *dest;

    /* delete foo.add file */
    strcpy(log->end, ".add");
    unlink(log->path);         /* ignore error, since may not exist */
    BAIL(3);

    /* rename foo.name to foo.dict, replacing foo.dict if it exists */
    strcpy(log->end, ".dict");
    dest = malloc(strlen(log->path) + 1);
    if (dest == NULL)
        return -2;
    strcpy(dest, log->path);
    strcpy(log->end, ".temp");
    ret = rename(log->path, dest);
    free(dest);
    if (ret && errno != ENOENT)
        return -1;
    BAIL(4);

    /* mark the foo.gz file as done */
    return log_mark(log, NO_OP);
}

/* Compress the len bytes at data and append the compressed data to the
   foo.gz deflate data immediately after the previous compressed data.  This
   overwrites the previous uncompressed data, which was stored in foo.add
   and is the data provided in data[0..len-1].  If this operation is
   interrupted, it picks up at the start of this routine, with the foo.add
   file read in again.  If there is no data to compress (len == 0), then we
   simply terminate the foo.gz file after the previously compressed data,
   appending a final empty stored block and the gzip trailer.  Return -1 if
   reading or writing the log.gz file failed, or -2 if there was a memory
   allocation failure. */
local int log_compress(struct log *log, unsigned char *data, size_t len)
{
    int fd;
    uint got, max;
    ssize_t dict;
    off_t end;
    z_stream strm;
    unsigned char buf[DICT];

    /* compress and append compressed data */
    if (len) {
        /* set up for deflate, allocating memory */
        strm.zalloc = Z_NULL;
        strm.zfree = Z_NULL;
        strm.opaque = Z_NULL;
        if (deflateInit2(&strm, Z_DEFAULT_COMPRESSION, Z_DEFLATED, -15, 8,
                         Z_DEFAULT_STRATEGY) != Z_OK)
            return -2;

        /* read in dictionary (last 32K of data that was compressed) */
        strcpy(log->end, ".dict");
        fd = open(log->path, O_RDONLY, 0);
        if (fd >= 0) {
            dict = read(fd, buf, DICT);
            close(fd);
            if (dict < 0) {
                deflateEnd(&strm);
                return -1;
            }
            if (dict)
                deflateSetDictionary(&strm, buf, (uint)dict);
        }
        log_touch(log);

        /* prime deflate with last bits of previous block, position write
           pointer to write those bits and overwrite what follows */
        if (lseek(log->fd, log->first - (log->back > 8 ? 2 : 1),
                SEEK_SET) < 0 ||
            read(log->fd, buf, 1) != 1 || lseek(log->fd, -1, SEEK_CUR) < 0) {
            deflateEnd(&strm);
            return -1;
        }
        deflatePrime(&strm, (8 - log->back) & 7, *buf);

        /* compress, finishing with a partial non-last empty static block */
        strm.next_in = data;
        max = (((uint)0 - 1) >> 1) + 1; /* in case int smaller than size_t */
        do {
            strm.avail_in = len > max ? max : (uint)len;
            len -= strm.avail_in;
            do {
                strm.avail_out = DICT;
                strm.next_out = buf;
                deflate(&strm, len ? Z_NO_FLUSH : Z_PARTIAL_FLUSH);
                got = DICT - strm.avail_out;
                if (got && write(log->fd, buf, got) != got) {
                    deflateEnd(&strm);
                    return -1;
                }
                log_touch(log);
            } while (strm.avail_out == 0);
        } while (len);
        deflateEnd(&strm);
        BAIL(5);

        /* find start of empty static block -- scanning backwards the first one
           bit is the second bit of the block, if the last byte is zero, then
           we know the byte before that has a one in the top bit, since an
           empty static block is ten bits long */
        if ((log->first = lseek(log->fd, -1, SEEK_CUR)) < 0 ||
            read(log->fd, buf, 1) != 1)
            return -1;
        log->first++;
        if (*buf) {
            log->back = 1;
            while ((*buf & ((uint)1 << (8 - log->back++))) == 0)
                ;       /* guaranteed to terminate, since *buf != 0 */
        }
        else
            log->back = 10;

        /* update compressed crc and length */
        log->ccrc = log->tcrc;
        log->clen = log->tlen;
    }
    else {
        /* no data to compress -- fix up existing gzip stream */
        log->tcrc = log->ccrc;
        log->tlen = log->clen;
    }

    /* complete and truncate gzip stream */
    log->last = log->first;
    log->stored = 0;
    PUT4(buf, log->tcrc);
    PUT4(buf + 4, log->tlen);
    if (log_last(log, 1) || write(log->fd, buf, 8) != 8 ||
        (end = lseek(log->fd, 0, SEEK_CUR)) < 0 || ftruncate(log->fd, end))
        return -1;
    BAIL(6);

    /* mark as being in the replace operation */
    if (log_mark(log, REPLACE_OP))
        return -1;

    /* execute the replace operation and mark the file as done */
    return log_replace(log);
}

/* log a repair record to the .repairs file */
local void log_log(struct log *log, int op, char *record)
{
    time_t now;
    FILE *rec;

    now = time(NULL);
    strcpy(log->end, ".repairs");
    rec = fopen(log->path, "a");
    if (rec == NULL)
        return;
    fprintf(rec, "%.24s %s recovery: %s\n", ctime(&now), op == APPEND_OP ?
            "append" : (op == COMPRESS_OP ? "compress" : "replace"), record);
    fclose(rec);
    return;
}

/* Recover the interrupted operation op.  First read foo.add for recovering an
   append or compress operation.  Return -1 if there was an error reading or
   writing foo.gz or reading an existing foo.add, or -2 if there was a memory
   allocation failure. */
local int log_recover(struct log *log, int op)
{
    int fd, ret = 0;
    unsigned char *data = NULL;
    size_t len = 0;
    struct stat st;

    /* log recovery */
    log_log(log, op, "start");

    /* load foo.add file if expected and present */
    if (op == APPEND_OP || op == COMPRESS_OP) {
        strcpy(log->end, ".add");
        if (stat(log->path, &st) == 0 && st.st_size) {
            len = (size_t)(st.st_size);
            if ((off_t)len != st.st_size ||
                    (data = malloc(st.st_size)) == NULL) {
                log_log(log, op, "allocation failure");
                return -2;
            }
            if ((fd = open(log->path, O_RDONLY, 0)) < 0) {
                log_log(log, op, ".add file read failure");
                return -1;
            }
            ret = (size_t)read(fd, data, len) != len;
            close(fd);
            if (ret) {
                log_log(log, op, ".add file read failure");
                return -1;
            }
            log_log(log, op, "loaded .add file");
        }
        else
            log_log(log, op, "missing .add file!");
    }

    /* recover the interrupted operation */
    switch (op) {
    case APPEND_OP:
        ret = log_append(log, data, len);
        break;
    case COMPRESS_OP:
        ret = log_compress(log, data, len);
        break;
    case REPLACE_OP:
        ret = log_replace(log);
    }

    /* log status */
    log_log(log, op, ret ? "failure" : "complete");

    /* clean up */
    if (data != NULL)
        free(data);
    return ret;
}

/* Close the foo.gz file (if open) and release the lock. */
local void log_close(struct log *log)
{
    if (log->fd >= 0)
        close(log->fd);
    log->fd = -1;
    log_unlock(log);
}

/* Open foo.gz, verify the header, and load the extra field contents, after
   first creating the foo.lock file to gain exclusive access to the foo.*
   files.  If foo.gz does not exist or is empty, then write the initial header,
   extra, and body content of an empty foo.gz log file.  If there is an error
   creating the lock file due to access restrictions, or an error reading or
   writing the foo.gz file, or if the foo.gz file is not a proper log file for
   this object (e.g. not a gzip file or does not contain the expected extra
   field), then return true.  If there is an error, the lock is released.
   Otherwise, the lock is left in place. */
local int log_open(struct log *log)
{
    int op;

    /* release open file resource if left over -- can occur if lock lost
       between gzlog_open() and gzlog_write() */
    if (log->fd >= 0)
        close(log->fd);
    log->fd = -1;

    /* negotiate exclusive access */
    if (log_lock(log) < 0)
        return -1;

    /* open the log file, foo.gz */
    strcpy(log->end, ".gz");
    log->fd = open(log->path, O_RDWR | O_CREAT, 0644);
    if (log->fd < 0) {
        log_close(log);
        return -1;
    }

    /* if new, initialize foo.gz with an empty log, delete old dictionary */
    if (lseek(log->fd, 0, SEEK_END) == 0) {
        if (write(log->fd, log_gzhead, HEAD) != HEAD ||
            write(log->fd, log_gzext, EXTRA) != EXTRA ||
            write(log->fd, log_gzbody, BODY) != BODY) {
            log_close(log);
            return -1;
        }
        strcpy(log->end, ".dict");
        unlink(log->path);
    }

    /* verify log file and load extra field information */
    if ((op = log_head(log)) < 0) {
        log_close(log);
        return -1;
    }

    /* check for interrupted process and if so, recover */
    if (op != NO_OP && log_recover(log, op)) {
        log_close(log);
        return -1;
    }

    /* touch the lock file to prevent another process from grabbing it */
    log_touch(log);
    return 0;
}

/* See gzlog.h for the description of the external methods below */
gzlog *gzlog_open(char *path)
{
    size_t n;
    struct log *log;

    /* check arguments */
    if (path == NULL || *path == 0)
        return NULL;

    /* allocate and initialize log structure */
    log = malloc(sizeof(struct log));
    if (log == NULL)
        return NULL;
    strcpy(log->id, LOGID);
    log->fd = -1;

    /* save path and end of path for name construction */
    n = strlen(path);
    log->path = malloc(n + 9);              /* allow for ".repairs" */
    if (log->path == NULL) {
        free(log);
        return NULL;
    }
    strcpy(log->path, path);
    log->end = log->path + n;

    /* gain exclusive access and verify log file -- may perform a
       recovery operation if needed */
    if (log_open(log)) {
        free(log->path);
        free(log);
        return NULL;
    }

    /* return pointer to log structure */
    return log;
}

/* gzlog_compress() return values:
    0: all good
   -1: file i/o error (usually access issue)
   -2: memory allocation failure
   -3: invalid log pointer argument */
int gzlog_compress(gzlog *logd)
{
    int fd, ret;
    uint block;
    size_t len, next;
    unsigned char *data, buf[5];
    struct log *log = logd;

    /* check arguments */
    if (log == NULL || strcmp(log->id, LOGID))
        return -3;

    /* see if we lost the lock -- if so get it again and reload the extra
       field information (it probably changed), recover last operation if
       necessary */
    if (log_check(log) && log_open(log))
        return -1;

    /* create space for uncompressed data */
    len = ((size_t)(log->last - log->first) & ~(((size_t)1 << 10) - 1)) +
          log->stored;
    if ((data = malloc(len)) == NULL)
        return -2;

    /* do statement here is just a cheap trick for error handling */
    do {
        /* read in the uncompressed data */
        if (lseek(log->fd, log->first - 1, SEEK_SET) < 0)
            break;
        next = 0;
        while (next < len) {
            if (read(log->fd, buf, 5) != 5)
                break;
            block = PULL2(buf + 1);
            if (next + block > len ||
                read(log->fd, (char *)data + next, block) != block)
                break;
            next += block;
        }
        if (lseek(log->fd, 0, SEEK_CUR) != log->last + 4 + log->stored)
            break;
        log_touch(log);

        /* write the uncompressed data to the .add file */
        strcpy(log->end, ".add");
        fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644);
        if (fd < 0)
            break;
        ret = (size_t)write(fd, data, len) != len;
        if (ret | close(fd))
            break;
        log_touch(log);

        /* write the dictionary for the next compress to the .temp file */
        strcpy(log->end, ".temp");
        fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644);
        if (fd < 0)
            break;
        next = DICT > len ? len : DICT;
        ret = (size_t)write(fd, (char *)data + len - next, next) != next;
        if (ret | close(fd))
            break;
        log_touch(log);

        /* roll back to compressed data, mark the compress in progress */
        log->last = log->first;
        log->stored = 0;
        if (log_mark(log, COMPRESS_OP))
            break;
        BAIL(7);

        /* compress and append the data (clears mark) */
        ret = log_compress(log, data, len);
        free(data);
        return ret;
    } while (0);

    /* broke out of do above on i/o error */
    free(data);
    return -1;
}

/* gzlog_write() return values:
    0: all good
   -1: file i/o error (usually access issue)
   -2: memory allocation failure
   -3: invalid log pointer argument */
int gzlog_write(gzlog *logd, void *data, size_t len)
{
    int fd, ret;
    struct log *log = logd;

    /* check arguments */
    if (log == NULL || strcmp(log->id, LOGID))
        return -3;
    if (data == NULL || len <= 0)
        return 0;

    /* see if we lost the lock -- if so get it again and reload the extra
       field information (it probably changed), recover last operation if
       necessary */
    if (log_check(log) && log_open(log))
        return -1;

    /* create and write .add file */
    strcpy(log->end, ".add");
    fd = open(log->path, O_WRONLY | O_CREAT | O_TRUNC, 0644);
    if (fd < 0)
        return -1;
    ret = (size_t)write(fd, data, len) != len;
    if (ret | close(fd))
        return -1;
    log_touch(log);

    /* mark log file with append in progress */
    if (log_mark(log, APPEND_OP))
        return -1;
    BAIL(8);

    /* append data (clears mark) */
    if (log_append(log, data, len))
        return -1;

    /* check to see if it's time to compress -- if not, then done */
    if (((log->last - log->first) >> 10) + (log->stored >> 10) < TRIGGER)
        return 0;

    /* time to compress */
    return gzlog_compress(log);
}

/* gzlog_close() return values:
    0: ok
   -3: invalid log pointer argument */
int gzlog_close(gzlog *logd)
{
    struct log *log = logd;

    /* check arguments */
    if (log == NULL || strcmp(log->id, LOGID))
        return -3;

    /* close the log file and release the lock */
    log_close(log);

    /* free structure and return */
    if (log->path != NULL)
        free(log->path);
    strcpy(log->id, "bad");
    free(log);
    return 0;
}

Deleted compat/zlib/examples/gzlog.h.

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



























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzlog.h
  Copyright (C) 2004, 2008, 2012 Mark Adler, all rights reserved
  version 2.2, 14 Aug 2012

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the author be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Mark Adler    madler@alumni.caltech.edu
 */

/* Version History:
   1.0  26 Nov 2004  First version
   2.0  25 Apr 2008  Complete redesign for recovery of interrupted operations
                     Interface changed slightly in that now path is a prefix
                     Compression now occurs as needed during gzlog_write()
                     gzlog_write() now always leaves the log file as valid gzip
   2.1   8 Jul 2012  Fix argument checks in gzlog_compress() and gzlog_write()
   2.2  14 Aug 2012  Clean up signed comparisons
 */

/*
   The gzlog object allows writing short messages to a gzipped log file,
   opening the log file locked for small bursts, and then closing it.  The log
   object works by appending stored (uncompressed) data to the gzip file until
   1 MB has been accumulated.  At that time, the stored data is compressed, and
   replaces the uncompressed data in the file.  The log file is truncated to
   its new size at that time.  After each write operation, the log file is a
   valid gzip file that can decompressed to recover what was written.

   The gzlog operations can be interupted at any point due to an application or
   system crash, and the log file will be recovered the next time the log is
   opened with gzlog_open().
 */

#ifndef GZLOG_H
#define GZLOG_H

/* gzlog object type */
typedef void gzlog;

/* Open a gzlog object, creating the log file if it does not exist.  Return
   NULL on error.  Note that gzlog_open() could take a while to complete if it
   has to wait to verify that a lock is stale (possibly for five minutes), or
   if there is significant contention with other instantiations of this object
   when locking the resource.  path is the prefix of the file names created by
   this object.  If path is "foo", then the log file will be "foo.gz", and
   other auxiliary files will be created and destroyed during the process:
   "foo.dict" for a compression dictionary, "foo.temp" for a temporary (next)
   dictionary, "foo.add" for data being added or compressed, "foo.lock" for the
   lock file, and "foo.repairs" to log recovery operations performed due to
   interrupted gzlog operations.  A gzlog_open() followed by a gzlog_close()
   will recover a previously interrupted operation, if any. */
gzlog *gzlog_open(char *path);

/* Write to a gzlog object.  Return zero on success, -1 if there is a file i/o
   error on any of the gzlog files (this should not happen if gzlog_open()
   succeeded, unless the device has run out of space or leftover auxiliary
   files have permissions or ownership that prevent their use), -2 if there is
   a memory allocation failure, or -3 if the log argument is invalid (e.g. if
   it was not created by gzlog_open()).  This function will write data to the
   file uncompressed, until 1 MB has been accumulated, at which time that data
   will be compressed.  The log file will be a valid gzip file upon successful
   return. */
int gzlog_write(gzlog *log, void *data, size_t len);

/* Force compression of any uncompressed data in the log.  This should be used
   sparingly, if at all.  The main application would be when a log file will
   not be appended to again.  If this is used to compress frequently while
   appending, it will both significantly increase the execution time and
   reduce the compression ratio.  The return codes are the same as for
   gzlog_write(). */
int gzlog_compress(gzlog *log);

/* Close a gzlog object.  Return zero on success, -3 if the log argument is
   invalid.  The log object is freed, and so cannot be referenced again. */
int gzlog_close(gzlog *log);

#endif

Deleted compat/zlib/examples/zlib_how.html.

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
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
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
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545

































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"
  "http://www.w3.org/TR/REC-html40/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1">
<title>zlib Usage Example</title>
<!--  Copyright (c) 2004, 2005 Mark Adler.  -->
</head>
<body bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#00A000">
<h2 align="center"> zlib Usage Example </h2>
We often get questions about how the <tt>deflate()</tt> and <tt>inflate()</tt> functions should be used.
Users wonder when they should provide more input, when they should use more output,
what to do with a <tt>Z_BUF_ERROR</tt>, how to make sure the process terminates properly, and
so on.  So for those who have read <tt>zlib.h</tt> (a few times), and
would like further edification, below is an annotated example in C of simple routines to compress and decompress
from an input file to an output file using <tt>deflate()</tt> and <tt>inflate()</tt> respectively.  The
annotations are interspersed between lines of the code.  So please read between the lines.
We hope this helps explain some of the intricacies of <em>zlib</em>.
<p>
Without further adieu, here is the program <a href="zpipe.c"><tt>zpipe.c</tt></a>:
<pre><b>
/* zpipe.c: example of proper use of zlib's inflate() and deflate()
   Not copyrighted -- provided to the public domain
   Version 1.4  11 December 2005  Mark Adler */

/* Version history:
   1.0  30 Oct 2004  First version
   1.1   8 Nov 2004  Add void casting for unused return values
                     Use switch statement for inflate() return values
   1.2   9 Nov 2004  Add assertions to document zlib guarantees
   1.3   6 Apr 2005  Remove incorrect assertion in inf()
   1.4  11 Dec 2005  Add hack to avoid MSDOS end-of-line conversions
                     Avoid some compiler warnings for input and output buffers
 */
</b></pre><!-- -->
We now include the header files for the required definitions.  From
<tt>stdio.h</tt> we use <tt>fopen()</tt>, <tt>fread()</tt>, <tt>fwrite()</tt>,
<tt>feof()</tt>, <tt>ferror()</tt>, and <tt>fclose()</tt> for file i/o, and
<tt>fputs()</tt> for error messages.  From <tt>string.h</tt> we use
<tt>strcmp()</tt> for command line argument processing.
From <tt>assert.h</tt> we use the <tt>assert()</tt> macro.
From <tt>zlib.h</tt>
we use the basic compression functions <tt>deflateInit()</tt>,
<tt>deflate()</tt>, and <tt>deflateEnd()</tt>, and the basic decompression
functions <tt>inflateInit()</tt>, <tt>inflate()</tt>, and
<tt>inflateEnd()</tt>.
<pre><b>
#include &lt;stdio.h&gt;
#include &lt;string.h&gt;
#include &lt;assert.h&gt;
#include "zlib.h"
</b></pre><!-- -->
This is an ugly hack required to avoid corruption of the input and output data on
Windows/MS-DOS systems.  Without this, those systems would assume that the input and output
files are text, and try to convert the end-of-line characters from one standard to
another.  That would corrupt binary data, and in particular would render the compressed data unusable.
This sets the input and output to binary which suppresses the end-of-line conversions.
<tt>SET_BINARY_MODE()</tt> will be used later on <tt>stdin</tt> and <tt>stdout</tt>, at the beginning of <tt>main()</tt>.
<pre><b>
#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
#  include &lt;fcntl.h&gt;
#  include &lt;io.h&gt;
#  define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
#else
#  define SET_BINARY_MODE(file)
#endif
</b></pre><!-- -->
<tt>CHUNK</tt> is simply the buffer size for feeding data to and pulling data
from the <em>zlib</em> routines.  Larger buffer sizes would be more efficient,
especially for <tt>inflate()</tt>.  If the memory is available, buffers sizes
on the order of 128K or 256K bytes should be used.
<pre><b>
#define CHUNK 16384
</b></pre><!-- -->
The <tt>def()</tt> routine compresses data from an input file to an output file.  The output data
will be in the <em>zlib</em> format, which is different from the <em>gzip</em> or <em>zip</em>
formats.  The <em>zlib</em> format has a very small header of only two bytes to identify it as
a <em>zlib</em> stream and to provide decoding information, and a four-byte trailer with a fast
check value to verify the integrity of the uncompressed data after decoding.
<pre><b>
/* Compress from file source to file dest until EOF on source.
   def() returns Z_OK on success, Z_MEM_ERROR if memory could not be
   allocated for processing, Z_STREAM_ERROR if an invalid compression
   level is supplied, Z_VERSION_ERROR if the version of zlib.h and the
   version of the library linked do not match, or Z_ERRNO if there is
   an error reading or writing the files. */
int def(FILE *source, FILE *dest, int level)
{
</b></pre>
Here are the local variables for <tt>def()</tt>.  <tt>ret</tt> will be used for <em>zlib</em>
return codes.  <tt>flush</tt> will keep track of the current flushing state for <tt>deflate()</tt>,
which is either no flushing, or flush to completion after the end of the input file is reached.
<tt>have</tt> is the amount of data returned from <tt>deflate()</tt>.  The <tt>strm</tt> structure
is used to pass information to and from the <em>zlib</em> routines, and to maintain the
<tt>deflate()</tt> state.  <tt>in</tt> and <tt>out</tt> are the input and output buffers for
<tt>deflate()</tt>.
<pre><b>
    int ret, flush;
    unsigned have;
    z_stream strm;
    unsigned char in[CHUNK];
    unsigned char out[CHUNK];
</b></pre><!-- -->
The first thing we do is to initialize the <em>zlib</em> state for compression using
<tt>deflateInit()</tt>.  This must be done before the first use of <tt>deflate()</tt>.
The <tt>zalloc</tt>, <tt>zfree</tt>, and <tt>opaque</tt> fields in the <tt>strm</tt>
structure must be initialized before calling <tt>deflateInit()</tt>.  Here they are
set to the <em>zlib</em> constant <tt>Z_NULL</tt> to request that <em>zlib</em> use
the default memory allocation routines.  An application may also choose to provide
custom memory allocation routines here.  <tt>deflateInit()</tt> will allocate on the
order of 256K bytes for the internal state.
(See <a href="zlib_tech.html"><em>zlib Technical Details</em></a>.)
<p>
<tt>deflateInit()</tt> is called with a pointer to the structure to be initialized and
the compression level, which is an integer in the range of -1 to 9.  Lower compression
levels result in faster execution, but less compression.  Higher levels result in
greater compression, but slower execution.  The <em>zlib</em> constant Z_DEFAULT_COMPRESSION,
equal to -1,
provides a good compromise between compression and speed and is equivalent to level 6.
Level 0 actually does no compression at all, and in fact expands the data slightly to produce
the <em>zlib</em> format (it is not a byte-for-byte copy of the input).
More advanced applications of <em>zlib</em>
may use <tt>deflateInit2()</tt> here instead.  Such an application may want to reduce how
much memory will be used, at some price in compression.  Or it may need to request a
<em>gzip</em> header and trailer instead of a <em>zlib</em> header and trailer, or raw
encoding with no header or trailer at all.
<p>
We must check the return value of <tt>deflateInit()</tt> against the <em>zlib</em> constant
<tt>Z_OK</tt> to make sure that it was able to
allocate memory for the internal state, and that the provided arguments were valid.
<tt>deflateInit()</tt> will also check that the version of <em>zlib</em> that the <tt>zlib.h</tt>
file came from matches the version of <em>zlib</em> actually linked with the program.  This
is especially important for environments in which <em>zlib</em> is a shared library.
<p>
Note that an application can initialize multiple, independent <em>zlib</em> streams, which can
operate in parallel.  The state information maintained in the structure allows the <em>zlib</em>
routines to be reentrant.
<pre><b>
    /* allocate deflate state */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    ret = deflateInit(&amp;strm, level);
    if (ret != Z_OK)
        return ret;
</b></pre><!-- -->
With the pleasantries out of the way, now we can get down to business.  The outer <tt>do</tt>-loop
reads all of the input file and exits at the bottom of the loop once end-of-file is reached.
This loop contains the only call of <tt>deflate()</tt>.  So we must make sure that all of the
input data has been processed and that all of the output data has been generated and consumed
before we fall out of the loop at the bottom.
<pre><b>
    /* compress until end of file */
    do {
</b></pre>
We start off by reading data from the input file.  The number of bytes read is put directly
into <tt>avail_in</tt>, and a pointer to those bytes is put into <tt>next_in</tt>.  We also
check to see if end-of-file on the input has been reached.  If we are at the end of file, then <tt>flush</tt> is set to the
<em>zlib</em> constant <tt>Z_FINISH</tt>, which is later passed to <tt>deflate()</tt> to
indicate that this is the last chunk of input data to compress.  We need to use <tt>feof()</tt>
to check for end-of-file as opposed to seeing if fewer than <tt>CHUNK</tt> bytes have been read.  The
reason is that if the input file length is an exact multiple of <tt>CHUNK</tt>, we will miss
the fact that we got to the end-of-file, and not know to tell <tt>deflate()</tt> to finish
up the compressed stream.  If we are not yet at the end of the input, then the <em>zlib</em>
constant <tt>Z_NO_FLUSH</tt> will be passed to <tt>deflate</tt> to indicate that we are still
in the middle of the uncompressed data.
<p>
If there is an error in reading from the input file, the process is aborted with
<tt>deflateEnd()</tt> being called to free the allocated <em>zlib</em> state before returning
the error.  We wouldn't want a memory leak, now would we?  <tt>deflateEnd()</tt> can be called
at any time after the state has been initialized.  Once that's done, <tt>deflateInit()</tt> (or
<tt>deflateInit2()</tt>) would have to be called to start a new compression process.  There is
no point here in checking the <tt>deflateEnd()</tt> return code.  The deallocation can't fail.
<pre><b>
        strm.avail_in = fread(in, 1, CHUNK, source);
        if (ferror(source)) {
            (void)deflateEnd(&amp;strm);
            return Z_ERRNO;
        }
        flush = feof(source) ? Z_FINISH : Z_NO_FLUSH;
        strm.next_in = in;
</b></pre><!-- -->
The inner <tt>do</tt>-loop passes our chunk of input data to <tt>deflate()</tt>, and then
keeps calling <tt>deflate()</tt> until it is done producing output.  Once there is no more
new output, <tt>deflate()</tt> is guaranteed to have consumed all of the input, i.e.,
<tt>avail_in</tt> will be zero.
<pre><b>
        /* run deflate() on input until output buffer not full, finish
           compression if all of source has been read in */
        do {
</b></pre>
Output space is provided to <tt>deflate()</tt> by setting <tt>avail_out</tt> to the number
of available output bytes and <tt>next_out</tt> to a pointer to that space.
<pre><b>
            strm.avail_out = CHUNK;
            strm.next_out = out;
</b></pre>
Now we call the compression engine itself, <tt>deflate()</tt>.  It takes as many of the
<tt>avail_in</tt> bytes at <tt>next_in</tt> as it can process, and writes as many as
<tt>avail_out</tt> bytes to <tt>next_out</tt>.  Those counters and pointers are then
updated past the input data consumed and the output data written.  It is the amount of
output space available that may limit how much input is consumed.
Hence the inner loop to make sure that
all of the input is consumed by providing more output space each time.  Since <tt>avail_in</tt>
and <tt>next_in</tt> are updated by <tt>deflate()</tt>, we don't have to mess with those
between <tt>deflate()</tt> calls until it's all used up.
<p>
The parameters to <tt>deflate()</tt> are a pointer to the <tt>strm</tt> structure containing
the input and output information and the internal compression engine state, and a parameter
indicating whether and how to flush data to the output.  Normally <tt>deflate</tt> will consume
several K bytes of input data before producing any output (except for the header), in order
to accumulate statistics on the data for optimum compression.  It will then put out a burst of
compressed data, and proceed to consume more input before the next burst.  Eventually,
<tt>deflate()</tt>
must be told to terminate the stream, complete the compression with provided input data, and
write out the trailer check value.  <tt>deflate()</tt> will continue to compress normally as long
as the flush parameter is <tt>Z_NO_FLUSH</tt>.  Once the <tt>Z_FINISH</tt> parameter is provided,
<tt>deflate()</tt> will begin to complete the compressed output stream.  However depending on how
much output space is provided, <tt>deflate()</tt> may have to be called several times until it
has provided the complete compressed stream, even after it has consumed all of the input.  The flush
parameter must continue to be <tt>Z_FINISH</tt> for those subsequent calls.
<p>
There are other values of the flush parameter that are used in more advanced applications.  You can
force <tt>deflate()</tt> to produce a burst of output that encodes all of the input data provided
so far, even if it wouldn't have otherwise, for example to control data latency on a link with
compressed data.  You can also ask that <tt>deflate()</tt> do that as well as erase any history up to
that point so that what follows can be decompressed independently, for example for random access
applications.  Both requests will degrade compression by an amount depending on how often such
requests are made.
<p>
<tt>deflate()</tt> has a return value that can indicate errors, yet we do not check it here.  Why
not?  Well, it turns out that <tt>deflate()</tt> can do no wrong here.  Let's go through
<tt>deflate()</tt>'s return values and dispense with them one by one.  The possible values are
<tt>Z_OK</tt>, <tt>Z_STREAM_END</tt>, <tt>Z_STREAM_ERROR</tt>, or <tt>Z_BUF_ERROR</tt>.  <tt>Z_OK</tt>
is, well, ok.  <tt>Z_STREAM_END</tt> is also ok and will be returned for the last call of
<tt>deflate()</tt>.  This is already guaranteed by calling <tt>deflate()</tt> with <tt>Z_FINISH</tt>
until it has no more output.  <tt>Z_STREAM_ERROR</tt> is only possible if the stream is not
initialized properly, but we did initialize it properly.  There is no harm in checking for
<tt>Z_STREAM_ERROR</tt> here, for example to check for the possibility that some
other part of the application inadvertently clobbered the memory containing the <em>zlib</em> state.
<tt>Z_BUF_ERROR</tt> will be explained further below, but
suffice it to say that this is simply an indication that <tt>deflate()</tt> could not consume
more input or produce more output.  <tt>deflate()</tt> can be called again with more output space
or more available input, which it will be in this code.
<pre><b>
            ret = deflate(&amp;strm, flush);    /* no bad return value */
            assert(ret != Z_STREAM_ERROR);  /* state not clobbered */
</b></pre>
Now we compute how much output <tt>deflate()</tt> provided on the last call, which is the
difference between how much space was provided before the call, and how much output space
is still available after the call.  Then that data, if any, is written to the output file.
We can then reuse the output buffer for the next call of <tt>deflate()</tt>.  Again if there
is a file i/o error, we call <tt>deflateEnd()</tt> before returning to avoid a memory leak.
<pre><b>
            have = CHUNK - strm.avail_out;
            if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
                (void)deflateEnd(&amp;strm);
                return Z_ERRNO;
            }
</b></pre>
The inner <tt>do</tt>-loop is repeated until the last <tt>deflate()</tt> call fails to fill the
provided output buffer.  Then we know that <tt>deflate()</tt> has done as much as it can with
the provided input, and that all of that input has been consumed.  We can then fall out of this
loop and reuse the input buffer.
<p>
The way we tell that <tt>deflate()</tt> has no more output is by seeing that it did not fill
the output buffer, leaving <tt>avail_out</tt> greater than zero.  However suppose that
<tt>deflate()</tt> has no more output, but just so happened to exactly fill the output buffer!
<tt>avail_out</tt> is zero, and we can't tell that <tt>deflate()</tt> has done all it can.
As far as we know, <tt>deflate()</tt>
has more output for us.  So we call it again.  But now <tt>deflate()</tt> produces no output
at all, and <tt>avail_out</tt> remains unchanged as <tt>CHUNK</tt>.  That <tt>deflate()</tt> call
wasn't able to do anything, either consume input or produce output, and so it returns
<tt>Z_BUF_ERROR</tt>.  (See, I told you I'd cover this later.)  However this is not a problem at
all.  Now we finally have the desired indication that <tt>deflate()</tt> is really done,
and so we drop out of the inner loop to provide more input to <tt>deflate()</tt>.
<p>
With <tt>flush</tt> set to <tt>Z_FINISH</tt>, this final set of <tt>deflate()</tt> calls will
complete the output stream.  Once that is done, subsequent calls of <tt>deflate()</tt> would return
<tt>Z_STREAM_ERROR</tt> if the flush parameter is not <tt>Z_FINISH</tt>, and do no more processing
until the state is reinitialized.
<p>
Some applications of <em>zlib</em> have two loops that call <tt>deflate()</tt>
instead of the single inner loop we have here.  The first loop would call
without flushing and feed all of the data to <tt>deflate()</tt>.  The second loop would call
<tt>deflate()</tt> with no more
data and the <tt>Z_FINISH</tt> parameter to complete the process.  As you can see from this
example, that can be avoided by simply keeping track of the current flush state.
<pre><b>
        } while (strm.avail_out == 0);
        assert(strm.avail_in == 0);     /* all input will be used */
</b></pre><!-- -->
Now we check to see if we have already processed all of the input file.  That information was
saved in the <tt>flush</tt> variable, so we see if that was set to <tt>Z_FINISH</tt>.  If so,
then we're done and we fall out of the outer loop.  We're guaranteed to get <tt>Z_STREAM_END</tt>
from the last <tt>deflate()</tt> call, since we ran it until the last chunk of input was
consumed and all of the output was generated.
<pre><b>
        /* done when last data in file processed */
    } while (flush != Z_FINISH);
    assert(ret == Z_STREAM_END);        /* stream will be complete */
</b></pre><!-- -->
The process is complete, but we still need to deallocate the state to avoid a memory leak
(or rather more like a memory hemorrhage if you didn't do this).  Then
finally we can return with a happy return value.
<pre><b>
    /* clean up and return */
    (void)deflateEnd(&amp;strm);
    return Z_OK;
}
</b></pre><!-- -->
Now we do the same thing for decompression in the <tt>inf()</tt> routine. <tt>inf()</tt>
decompresses what is hopefully a valid <em>zlib</em> stream from the input file and writes the
uncompressed data to the output file.  Much of the discussion above for <tt>def()</tt>
applies to <tt>inf()</tt> as well, so the discussion here will focus on the differences between
the two.
<pre><b>
/* Decompress from file source to file dest until stream ends or EOF.
   inf() returns Z_OK on success, Z_MEM_ERROR if memory could not be
   allocated for processing, Z_DATA_ERROR if the deflate data is
   invalid or incomplete, Z_VERSION_ERROR if the version of zlib.h and
   the version of the library linked do not match, or Z_ERRNO if there
   is an error reading or writing the files. */
int inf(FILE *source, FILE *dest)
{
</b></pre>
The local variables have the same functionality as they do for <tt>def()</tt>.  The
only difference is that there is no <tt>flush</tt> variable, since <tt>inflate()</tt>
can tell from the <em>zlib</em> stream itself when the stream is complete.
<pre><b>
    int ret;
    unsigned have;
    z_stream strm;
    unsigned char in[CHUNK];
    unsigned char out[CHUNK];
</b></pre><!-- -->
The initialization of the state is the same, except that there is no compression level,
of course, and two more elements of the structure are initialized.  <tt>avail_in</tt>
and <tt>next_in</tt> must be initialized before calling <tt>inflateInit()</tt>.  This
is because the application has the option to provide the start of the zlib stream in
order for <tt>inflateInit()</tt> to have access to information about the compression
method to aid in memory allocation.  In the current implementation of <em>zlib</em>
(up through versions 1.2.x), the method-dependent memory allocations are deferred to the first call of
<tt>inflate()</tt> anyway.  However those fields must be initialized since later versions
of <em>zlib</em> that provide more compression methods may take advantage of this interface.
In any case, no decompression is performed by <tt>inflateInit()</tt>, so the
<tt>avail_out</tt> and <tt>next_out</tt> fields do not need to be initialized before calling.
<p>
Here <tt>avail_in</tt> is set to zero and <tt>next_in</tt> is set to <tt>Z_NULL</tt> to
indicate that no input data is being provided.
<pre><b>
    /* allocate inflate state */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit(&amp;strm);
    if (ret != Z_OK)
        return ret;
</b></pre><!-- -->
The outer <tt>do</tt>-loop decompresses input until <tt>inflate()</tt> indicates
that it has reached the end of the compressed data and has produced all of the uncompressed
output.  This is in contrast to <tt>def()</tt> which processes all of the input file.
If end-of-file is reached before the compressed data self-terminates, then the compressed
data is incomplete and an error is returned.
<pre><b>
    /* decompress until deflate stream ends or end of file */
    do {
</b></pre>
We read input data and set the <tt>strm</tt> structure accordingly.  If we've reached the
end of the input file, then we leave the outer loop and report an error, since the
compressed data is incomplete.  Note that we may read more data than is eventually consumed
by <tt>inflate()</tt>, if the input file continues past the <em>zlib</em> stream.
For applications where <em>zlib</em> streams are embedded in other data, this routine would
need to be modified to return the unused data, or at least indicate how much of the input
data was not used, so the application would know where to pick up after the <em>zlib</em> stream.
<pre><b>
        strm.avail_in = fread(in, 1, CHUNK, source);
        if (ferror(source)) {
            (void)inflateEnd(&amp;strm);
            return Z_ERRNO;
        }
        if (strm.avail_in == 0)
            break;
        strm.next_in = in;
</b></pre><!-- -->
The inner <tt>do</tt>-loop has the same function it did in <tt>def()</tt>, which is to
keep calling <tt>inflate()</tt> until has generated all of the output it can with the
provided input.
<pre><b>
        /* run inflate() on input until output buffer not full */
        do {
</b></pre>
Just like in <tt>def()</tt>, the same output space is provided for each call of <tt>inflate()</tt>.
<pre><b>
            strm.avail_out = CHUNK;
            strm.next_out = out;
</b></pre>
Now we run the decompression engine itself.  There is no need to adjust the flush parameter, since
the <em>zlib</em> format is self-terminating. The main difference here is that there are
return values that we need to pay attention to.  <tt>Z_DATA_ERROR</tt>
indicates that <tt>inflate()</tt> detected an error in the <em>zlib</em> compressed data format,
which means that either the data is not a <em>zlib</em> stream to begin with, or that the data was
corrupted somewhere along the way since it was compressed.  The other error to be processed is
<tt>Z_MEM_ERROR</tt>, which can occur since memory allocation is deferred until <tt>inflate()</tt>
needs it, unlike <tt>deflate()</tt>, whose memory is allocated at the start by <tt>deflateInit()</tt>.
<p>
Advanced applications may use
<tt>deflateSetDictionary()</tt> to prime <tt>deflate()</tt> with a set of likely data to improve the
first 32K or so of compression.  This is noted in the <em>zlib</em> header, so <tt>inflate()</tt>
requests that that dictionary be provided before it can start to decompress.  Without the dictionary,
correct decompression is not possible.  For this routine, we have no idea what the dictionary is,
so the <tt>Z_NEED_DICT</tt> indication is converted to a <tt>Z_DATA_ERROR</tt>.
<p>
<tt>inflate()</tt> can also return <tt>Z_STREAM_ERROR</tt>, which should not be possible here,
but could be checked for as noted above for <tt>def()</tt>.  <tt>Z_BUF_ERROR</tt> does not need to be
checked for here, for the same reasons noted for <tt>def()</tt>.  <tt>Z_STREAM_END</tt> will be
checked for later.
<pre><b>
            ret = inflate(&amp;strm, Z_NO_FLUSH);
            assert(ret != Z_STREAM_ERROR);  /* state not clobbered */
            switch (ret) {
            case Z_NEED_DICT:
                ret = Z_DATA_ERROR;     /* and fall through */
            case Z_DATA_ERROR:
            case Z_MEM_ERROR:
                (void)inflateEnd(&amp;strm);
                return ret;
            }
</b></pre>
The output of <tt>inflate()</tt> is handled identically to that of <tt>deflate()</tt>.
<pre><b>
            have = CHUNK - strm.avail_out;
            if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
                (void)inflateEnd(&amp;strm);
                return Z_ERRNO;
            }
</b></pre>
The inner <tt>do</tt>-loop ends when <tt>inflate()</tt> has no more output as indicated
by not filling the output buffer, just as for <tt>deflate()</tt>.  In this case, we cannot
assert that <tt>strm.avail_in</tt> will be zero, since the deflate stream may end before the file
does.
<pre><b>
        } while (strm.avail_out == 0);
</b></pre><!-- -->
The outer <tt>do</tt>-loop ends when <tt>inflate()</tt> reports that it has reached the
end of the input <em>zlib</em> stream, has completed the decompression and integrity
check, and has provided all of the output.  This is indicated by the <tt>inflate()</tt>
return value <tt>Z_STREAM_END</tt>.  The inner loop is guaranteed to leave <tt>ret</tt>
equal to <tt>Z_STREAM_END</tt> if the last chunk of the input file read contained the end
of the <em>zlib</em> stream.  So if the return value is not <tt>Z_STREAM_END</tt>, the
loop continues to read more input.
<pre><b>
        /* done when inflate() says it's done */
    } while (ret != Z_STREAM_END);
</b></pre><!-- -->
At this point, decompression successfully completed, or we broke out of the loop due to no
more data being available from the input file.  If the last <tt>inflate()</tt> return value
is not <tt>Z_STREAM_END</tt>, then the <em>zlib</em> stream was incomplete and a data error
is returned.  Otherwise, we return with a happy return value.  Of course, <tt>inflateEnd()</tt>
is called first to avoid a memory leak.
<pre><b>
    /* clean up and return */
    (void)inflateEnd(&amp;strm);
    return ret == Z_STREAM_END ? Z_OK : Z_DATA_ERROR;
}
</b></pre><!-- -->
That ends the routines that directly use <em>zlib</em>.  The following routines make this
a command-line program by running data through the above routines from <tt>stdin</tt> to
<tt>stdout</tt>, and handling any errors reported by <tt>def()</tt> or <tt>inf()</tt>.
<p>
<tt>zerr()</tt> is used to interpret the possible error codes from <tt>def()</tt>
and <tt>inf()</tt>, as detailed in their comments above, and print out an error message.
Note that these are only a subset of the possible return values from <tt>deflate()</tt>
and <tt>inflate()</tt>.
<pre><b>
/* report a zlib or i/o error */
void zerr(int ret)
{
    fputs("zpipe: ", stderr);
    switch (ret) {
    case Z_ERRNO:
        if (ferror(stdin))
            fputs("error reading stdin\n", stderr);
        if (ferror(stdout))
            fputs("error writing stdout\n", stderr);
        break;
    case Z_STREAM_ERROR:
        fputs("invalid compression level\n", stderr);
        break;
    case Z_DATA_ERROR:
        fputs("invalid or incomplete deflate data\n", stderr);
        break;
    case Z_MEM_ERROR:
        fputs("out of memory\n", stderr);
        break;
    case Z_VERSION_ERROR:
        fputs("zlib version mismatch!\n", stderr);
    }
}
</b></pre><!-- -->
Here is the <tt>main()</tt> routine used to test <tt>def()</tt> and <tt>inf()</tt>.  The
<tt>zpipe</tt> command is simply a compression pipe from <tt>stdin</tt> to <tt>stdout</tt>, if
no arguments are given, or it is a decompression pipe if <tt>zpipe -d</tt> is used.  If any other
arguments are provided, no compression or decompression is performed.  Instead a usage
message is displayed.  Examples are <tt>zpipe < foo.txt > foo.txt.z</tt> to compress, and
<tt>zpipe -d < foo.txt.z > foo.txt</tt> to decompress.
<pre><b>
/* compress or decompress from stdin to stdout */
int main(int argc, char **argv)
{
    int ret;

    /* avoid end-of-line conversions */
    SET_BINARY_MODE(stdin);
    SET_BINARY_MODE(stdout);

    /* do compression if no arguments */
    if (argc == 1) {
        ret = def(stdin, stdout, Z_DEFAULT_COMPRESSION);
        if (ret != Z_OK)
            zerr(ret);
        return ret;
    }

    /* do decompression if -d specified */
    else if (argc == 2 &amp;&amp; strcmp(argv[1], "-d") == 0) {
        ret = inf(stdin, stdout);
        if (ret != Z_OK)
            zerr(ret);
        return ret;
    }

    /* otherwise, report usage */
    else {
        fputs("zpipe usage: zpipe [-d] &lt; source &gt; dest\n", stderr);
        return 1;
    }
}
</b></pre>
<hr>
<i>Copyright (c) 2004, 2005 by Mark Adler<br>Last modified 11 December 2005</i>
</body>
</html>

Deleted compat/zlib/examples/zpipe.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205













































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zpipe.c: example of proper use of zlib's inflate() and deflate()
   Not copyrighted -- provided to the public domain
   Version 1.4  11 December 2005  Mark Adler */

/* Version history:
   1.0  30 Oct 2004  First version
   1.1   8 Nov 2004  Add void casting for unused return values
                     Use switch statement for inflate() return values
   1.2   9 Nov 2004  Add assertions to document zlib guarantees
   1.3   6 Apr 2005  Remove incorrect assertion in inf()
   1.4  11 Dec 2005  Add hack to avoid MSDOS end-of-line conversions
                     Avoid some compiler warnings for input and output buffers
 */

#include <stdio.h>
#include <string.h>
#include <assert.h>
#include "zlib.h"

#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
#  include <fcntl.h>
#  include <io.h>
#  define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
#else
#  define SET_BINARY_MODE(file)
#endif

#define CHUNK 16384

/* Compress from file source to file dest until EOF on source.
   def() returns Z_OK on success, Z_MEM_ERROR if memory could not be
   allocated for processing, Z_STREAM_ERROR if an invalid compression
   level is supplied, Z_VERSION_ERROR if the version of zlib.h and the
   version of the library linked do not match, or Z_ERRNO if there is
   an error reading or writing the files. */
int def(FILE *source, FILE *dest, int level)
{
    int ret, flush;
    unsigned have;
    z_stream strm;
    unsigned char in[CHUNK];
    unsigned char out[CHUNK];

    /* allocate deflate state */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    ret = deflateInit(&strm, level);
    if (ret != Z_OK)
        return ret;

    /* compress until end of file */
    do {
        strm.avail_in = fread(in, 1, CHUNK, source);
        if (ferror(source)) {
            (void)deflateEnd(&strm);
            return Z_ERRNO;
        }
        flush = feof(source) ? Z_FINISH : Z_NO_FLUSH;
        strm.next_in = in;

        /* run deflate() on input until output buffer not full, finish
           compression if all of source has been read in */
        do {
            strm.avail_out = CHUNK;
            strm.next_out = out;
            ret = deflate(&strm, flush);    /* no bad return value */
            assert(ret != Z_STREAM_ERROR);  /* state not clobbered */
            have = CHUNK - strm.avail_out;
            if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
                (void)deflateEnd(&strm);
                return Z_ERRNO;
            }
        } while (strm.avail_out == 0);
        assert(strm.avail_in == 0);     /* all input will be used */

        /* done when last data in file processed */
    } while (flush != Z_FINISH);
    assert(ret == Z_STREAM_END);        /* stream will be complete */

    /* clean up and return */
    (void)deflateEnd(&strm);
    return Z_OK;
}

/* Decompress from file source to file dest until stream ends or EOF.
   inf() returns Z_OK on success, Z_MEM_ERROR if memory could not be
   allocated for processing, Z_DATA_ERROR if the deflate data is
   invalid or incomplete, Z_VERSION_ERROR if the version of zlib.h and
   the version of the library linked do not match, or Z_ERRNO if there
   is an error reading or writing the files. */
int inf(FILE *source, FILE *dest)
{
    int ret;
    unsigned have;
    z_stream strm;
    unsigned char in[CHUNK];
    unsigned char out[CHUNK];

    /* allocate inflate state */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit(&strm);
    if (ret != Z_OK)
        return ret;

    /* decompress until deflate stream ends or end of file */
    do {
        strm.avail_in = fread(in, 1, CHUNK, source);
        if (ferror(source)) {
            (void)inflateEnd(&strm);
            return Z_ERRNO;
        }
        if (strm.avail_in == 0)
            break;
        strm.next_in = in;

        /* run inflate() on input until output buffer not full */
        do {
            strm.avail_out = CHUNK;
            strm.next_out = out;
            ret = inflate(&strm, Z_NO_FLUSH);
            assert(ret != Z_STREAM_ERROR);  /* state not clobbered */
            switch (ret) {
            case Z_NEED_DICT:
                ret = Z_DATA_ERROR;     /* and fall through */
            case Z_DATA_ERROR:
            case Z_MEM_ERROR:
                (void)inflateEnd(&strm);
                return ret;
            }
            have = CHUNK - strm.avail_out;
            if (fwrite(out, 1, have, dest) != have || ferror(dest)) {
                (void)inflateEnd(&strm);
                return Z_ERRNO;
            }
        } while (strm.avail_out == 0);

        /* done when inflate() says it's done */
    } while (ret != Z_STREAM_END);

    /* clean up and return */
    (void)inflateEnd(&strm);
    return ret == Z_STREAM_END ? Z_OK : Z_DATA_ERROR;
}

/* report a zlib or i/o error */
void zerr(int ret)
{
    fputs("zpipe: ", stderr);
    switch (ret) {
    case Z_ERRNO:
        if (ferror(stdin))
            fputs("error reading stdin\n", stderr);
        if (ferror(stdout))
            fputs("error writing stdout\n", stderr);
        break;
    case Z_STREAM_ERROR:
        fputs("invalid compression level\n", stderr);
        break;
    case Z_DATA_ERROR:
        fputs("invalid or incomplete deflate data\n", stderr);
        break;
    case Z_MEM_ERROR:
        fputs("out of memory\n", stderr);
        break;
    case Z_VERSION_ERROR:
        fputs("zlib version mismatch!\n", stderr);
    }
}

/* compress or decompress from stdin to stdout */
int main(int argc, char **argv)
{
    int ret;

    /* avoid end-of-line conversions */
    SET_BINARY_MODE(stdin);
    SET_BINARY_MODE(stdout);

    /* do compression if no arguments */
    if (argc == 1) {
        ret = def(stdin, stdout, Z_DEFAULT_COMPRESSION);
        if (ret != Z_OK)
            zerr(ret);
        return ret;
    }

    /* do decompression if -d specified */
    else if (argc == 2 && strcmp(argv[1], "-d") == 0) {
        ret = inf(stdin, stdout);
        if (ret != Z_OK)
            zerr(ret);
        return ret;
    }

    /* otherwise, report usage */
    else {
        fputs("zpipe usage: zpipe [-d] < source > dest\n", stderr);
        return 1;
    }
}

Deleted compat/zlib/examples/zran.c.

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

























































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zran.c -- example of zlib/gzip stream indexing and random access
 * Copyright (C) 2005, 2012 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
   Version 1.1  29 Sep 2012  Mark Adler */

/* Version History:
 1.0  29 May 2005  First version
 1.1  29 Sep 2012  Fix memory reallocation error
 */

/* Illustrate the use of Z_BLOCK, inflatePrime(), and inflateSetDictionary()
   for random access of a compressed file.  A file containing a zlib or gzip
   stream is provided on the command line.  The compressed stream is decoded in
   its entirety, and an index built with access points about every SPAN bytes
   in the uncompressed output.  The compressed file is left open, and can then
   be read randomly, having to decompress on the average SPAN/2 uncompressed
   bytes before getting to the desired block of data.

   An access point can be created at the start of any deflate block, by saving
   the starting file offset and bit of that block, and the 32K bytes of
   uncompressed data that precede that block.  Also the uncompressed offset of
   that block is saved to provide a referece for locating a desired starting
   point in the uncompressed stream.  build_index() works by decompressing the
   input zlib or gzip stream a block at a time, and at the end of each block
   deciding if enough uncompressed data has gone by to justify the creation of
   a new access point.  If so, that point is saved in a data structure that
   grows as needed to accommodate the points.

   To use the index, an offset in the uncompressed data is provided, for which
   the latest access point at or preceding that offset is located in the index.
   The input file is positioned to the specified location in the index, and if
   necessary the first few bits of the compressed data is read from the file.
   inflate is initialized with those bits and the 32K of uncompressed data, and
   the decompression then proceeds until the desired offset in the file is
   reached.  Then the decompression continues to read the desired uncompressed
   data from the file.

   Another approach would be to generate the index on demand.  In that case,
   requests for random access reads from the compressed data would try to use
   the index, but if a read far enough past the end of the index is required,
   then further index entries would be generated and added.

   There is some fair bit of overhead to starting inflation for the random
   access, mainly copying the 32K byte dictionary.  So if small pieces of the
   file are being accessed, it would make sense to implement a cache to hold
   some lookahead and avoid many calls to extract() for small lengths.

   Another way to build an index would be to use inflateCopy().  That would
   not be constrained to have access points at block boundaries, but requires
   more memory per access point, and also cannot be saved to file due to the
   use of pointers in the state.  The approach here allows for storage of the
   index in a file.
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "zlib.h"

#define local static

#define SPAN 1048576L       /* desired distance between access points */
#define WINSIZE 32768U      /* sliding window size */
#define CHUNK 16384         /* file input buffer size */

/* access point entry */
struct point {
    off_t out;          /* corresponding offset in uncompressed data */
    off_t in;           /* offset in input file of first full byte */
    int bits;           /* number of bits (1-7) from byte at in - 1, or 0 */
    unsigned char window[WINSIZE];  /* preceding 32K of uncompressed data */
};

/* access point list */
struct access {
    int have;           /* number of list entries filled in */
    int size;           /* number of list entries allocated */
    struct point *list; /* allocated list */
};

/* Deallocate an index built by build_index() */
local void free_index(struct access *index)
{
    if (index != NULL) {
        free(index->list);
        free(index);
    }
}

/* Add an entry to the access point list.  If out of memory, deallocate the
   existing list and return NULL. */
local struct access *addpoint(struct access *index, int bits,
    off_t in, off_t out, unsigned left, unsigned char *window)
{
    struct point *next;

    /* if list is empty, create it (start with eight points) */
    if (index == NULL) {
        index = malloc(sizeof(struct access));
        if (index == NULL) return NULL;
        index->list = malloc(sizeof(struct point) << 3);
        if (index->list == NULL) {
            free(index);
            return NULL;
        }
        index->size = 8;
        index->have = 0;
    }

    /* if list is full, make it bigger */
    else if (index->have == index->size) {
        index->size <<= 1;
        next = realloc(index->list, sizeof(struct point) * index->size);
        if (next == NULL) {
            free_index(index);
            return NULL;
        }
        index->list = next;
    }

    /* fill in entry and increment how many we have */
    next = index->list + index->have;
    next->bits = bits;
    next->in = in;
    next->out = out;
    if (left)
        memcpy(next->window, window + WINSIZE - left, left);
    if (left < WINSIZE)
        memcpy(next->window + left, window, WINSIZE - left);
    index->have++;

    /* return list, possibly reallocated */
    return index;
}

/* Make one entire pass through the compressed stream and build an index, with
   access points about every span bytes of uncompressed output -- span is
   chosen to balance the speed of random access against the memory requirements
   of the list, about 32K bytes per access point.  Note that data after the end
   of the first zlib or gzip stream in the file is ignored.  build_index()
   returns the number of access points on success (>= 1), Z_MEM_ERROR for out
   of memory, Z_DATA_ERROR for an error in the input file, or Z_ERRNO for a
   file read error.  On success, *built points to the resulting index. */
local int build_index(FILE *in, off_t span, struct access **built)
{
    int ret;
    off_t totin, totout;        /* our own total counters to avoid 4GB limit */
    off_t last;                 /* totout value of last access point */
    struct access *index;       /* access points being generated */
    z_stream strm;
    unsigned char input[CHUNK];
    unsigned char window[WINSIZE];

    /* initialize inflate */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit2(&strm, 47);      /* automatic zlib or gzip decoding */
    if (ret != Z_OK)
        return ret;

    /* inflate the input, maintain a sliding window, and build an index -- this
       also validates the integrity of the compressed data using the check
       information at the end of the gzip or zlib stream */
    totin = totout = last = 0;
    index = NULL;               /* will be allocated by first addpoint() */
    strm.avail_out = 0;
    do {
        /* get some compressed data from input file */
        strm.avail_in = fread(input, 1, CHUNK, in);
        if (ferror(in)) {
            ret = Z_ERRNO;
            goto build_index_error;
        }
        if (strm.avail_in == 0) {
            ret = Z_DATA_ERROR;
            goto build_index_error;
        }
        strm.next_in = input;

        /* process all of that, or until end of stream */
        do {
            /* reset sliding window if necessary */
            if (strm.avail_out == 0) {
                strm.avail_out = WINSIZE;
                strm.next_out = window;
            }

            /* inflate until out of input, output, or at end of block --
               update the total input and output counters */
            totin += strm.avail_in;
            totout += strm.avail_out;
            ret = inflate(&strm, Z_BLOCK);      /* return at end of block */
            totin -= strm.avail_in;
            totout -= strm.avail_out;
            if (ret == Z_NEED_DICT)
                ret = Z_DATA_ERROR;
            if (ret == Z_MEM_ERROR || ret == Z_DATA_ERROR)
                goto build_index_error;
            if (ret == Z_STREAM_END)
                break;

            /* if at end of block, consider adding an index entry (note that if
               data_type indicates an end-of-block, then all of the
               uncompressed data from that block has been delivered, and none
               of the compressed data after that block has been consumed,
               except for up to seven bits) -- the totout == 0 provides an
               entry point after the zlib or gzip header, and assures that the
               index always has at least one access point; we avoid creating an
               access point after the last block by checking bit 6 of data_type
             */
            if ((strm.data_type & 128) && !(strm.data_type & 64) &&
                (totout == 0 || totout - last > span)) {
                index = addpoint(index, strm.data_type & 7, totin,
                                 totout, strm.avail_out, window);
                if (index == NULL) {
                    ret = Z_MEM_ERROR;
                    goto build_index_error;
                }
                last = totout;
            }
        } while (strm.avail_in != 0);
    } while (ret != Z_STREAM_END);

    /* clean up and return index (release unused entries in list) */
    (void)inflateEnd(&strm);
    index->list = realloc(index->list, sizeof(struct point) * index->have);
    index->size = index->have;
    *built = index;
    return index->size;

    /* return error */
  build_index_error:
    (void)inflateEnd(&strm);
    if (index != NULL)
        free_index(index);
    return ret;
}

/* Use the index to read len bytes from offset into buf, return bytes read or
   negative for error (Z_DATA_ERROR or Z_MEM_ERROR).  If data is requested past
   the end of the uncompressed data, then extract() will return a value less
   than len, indicating how much as actually read into buf.  This function
   should not return a data error unless the file was modified since the index
   was generated.  extract() may also return Z_ERRNO if there is an error on
   reading or seeking the input file. */
local int extract(FILE *in, struct access *index, off_t offset,
                  unsigned char *buf, int len)
{
    int ret, skip;
    z_stream strm;
    struct point *here;
    unsigned char input[CHUNK];
    unsigned char discard[WINSIZE];

    /* proceed only if something reasonable to do */
    if (len < 0)
        return 0;

    /* find where in stream to start */
    here = index->list;
    ret = index->have;
    while (--ret && here[1].out <= offset)
        here++;

    /* initialize file and inflate state to start there */
    strm.zalloc = Z_NULL;
    strm.zfree = Z_NULL;
    strm.opaque = Z_NULL;
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit2(&strm, -15);         /* raw inflate */
    if (ret != Z_OK)
        return ret;
    ret = fseeko(in, here->in - (here->bits ? 1 : 0), SEEK_SET);
    if (ret == -1)
        goto extract_ret;
    if (here->bits) {
        ret = getc(in);
        if (ret == -1) {
            ret = ferror(in) ? Z_ERRNO : Z_DATA_ERROR;
            goto extract_ret;
        }
        (void)inflatePrime(&strm, here->bits, ret >> (8 - here->bits));
    }
    (void)inflateSetDictionary(&strm, here->window, WINSIZE);

    /* skip uncompressed bytes until offset reached, then satisfy request */
    offset -= here->out;
    strm.avail_in = 0;
    skip = 1;                               /* while skipping to offset */
    do {
        /* define where to put uncompressed data, and how much */
        if (offset == 0 && skip) {          /* at offset now */
            strm.avail_out = len;
            strm.next_out = buf;
            skip = 0;                       /* only do this once */
        }
        if (offset > WINSIZE) {             /* skip WINSIZE bytes */
            strm.avail_out = WINSIZE;
            strm.next_out = discard;
            offset -= WINSIZE;
        }
        else if (offset != 0) {             /* last skip */
            strm.avail_out = (unsigned)offset;
            strm.next_out = discard;
            offset = 0;
        }

        /* uncompress until avail_out filled, or end of stream */
        do {
            if (strm.avail_in == 0) {
                strm.avail_in = fread(input, 1, CHUNK, in);
                if (ferror(in)) {
                    ret = Z_ERRNO;
                    goto extract_ret;
                }
                if (strm.avail_in == 0) {
                    ret = Z_DATA_ERROR;
                    goto extract_ret;
                }
                strm.next_in = input;
            }
            ret = inflate(&strm, Z_NO_FLUSH);       /* normal inflate */
            if (ret == Z_NEED_DICT)
                ret = Z_DATA_ERROR;
            if (ret == Z_MEM_ERROR || ret == Z_DATA_ERROR)
                goto extract_ret;
            if (ret == Z_STREAM_END)
                break;
        } while (strm.avail_out != 0);

        /* if reach end of stream, then don't keep trying to get more */
        if (ret == Z_STREAM_END)
            break;

        /* do until offset reached and requested data read, or stream ends */
    } while (skip);

    /* compute number of uncompressed bytes read after offset */
    ret = skip ? 0 : len - strm.avail_out;

    /* clean up and return bytes read or error */
  extract_ret:
    (void)inflateEnd(&strm);
    return ret;
}

/* Demonstrate the use of build_index() and extract() by processing the file
   provided on the command line, and the extracting 16K from about 2/3rds of
   the way through the uncompressed output, and writing that to stdout. */
int main(int argc, char **argv)
{
    int len;
    off_t offset;
    FILE *in;
    struct access *index = NULL;
    unsigned char buf[CHUNK];

    /* open input file */
    if (argc != 2) {
        fprintf(stderr, "usage: zran file.gz\n");
        return 1;
    }
    in = fopen(argv[1], "rb");
    if (in == NULL) {
        fprintf(stderr, "zran: could not open %s for reading\n", argv[1]);
        return 1;
    }

    /* build index */
    len = build_index(in, SPAN, &index);
    if (len < 0) {
        fclose(in);
        switch (len) {
        case Z_MEM_ERROR:
            fprintf(stderr, "zran: out of memory\n");
            break;
        case Z_DATA_ERROR:
            fprintf(stderr, "zran: compressed data error in %s\n", argv[1]);
            break;
        case Z_ERRNO:
            fprintf(stderr, "zran: read error on %s\n", argv[1]);
            break;
        default:
            fprintf(stderr, "zran: error %d while building index\n", len);
        }
        return 1;
    }
    fprintf(stderr, "zran: built index with %d access points\n", len);

    /* use index by reading some bytes from an arbitrary offset */
    offset = (index->list[index->have - 1].out << 1) / 3;
    len = extract(in, index, offset, buf, CHUNK);
    if (len < 0)
        fprintf(stderr, "zran: extraction failed: %s error\n",
                len == Z_MEM_ERROR ? "out of memory" : "input corrupted");
    else {
        fwrite(buf, 1, len, stdout);
        fprintf(stderr, "zran: extracted %d bytes at %llu\n", len, offset);
    }

    /* clean up and exit */
    free_index(index);
    fclose(in);
    return 0;
}

Deleted compat/zlib/gzclose.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

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzclose.c -- zlib gzclose() function
 * Copyright (C) 2004, 2010 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "gzguts.h"

/* gzclose() is in a separate file so that it is linked in only if it is used.
   That way the other gzclose functions can be used instead to avoid linking in
   unneeded compression or decompression routines. */
int ZEXPORT gzclose(file)
    gzFile file;
{
#ifndef NO_GZCOMPRESS
    gz_statep state;

    if (file == NULL)
        return Z_STREAM_ERROR;
    state = (gz_statep)file;

    return state->mode == GZ_READ ? gzclose_r(file) : gzclose_w(file);
#else
    return gzclose_r(file);
#endif
}

Deleted compat/zlib/gzguts.h.

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


























































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzguts.h -- zlib internal header definitions for gz* operations
 * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013, 2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#ifdef _LARGEFILE64_SOURCE
#  ifndef _LARGEFILE_SOURCE
#    define _LARGEFILE_SOURCE 1
#  endif
#  ifdef _FILE_OFFSET_BITS
#    undef _FILE_OFFSET_BITS
#  endif
#endif

#ifdef HAVE_HIDDEN
#  define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
#else
#  define ZLIB_INTERNAL
#endif

#include <stdio.h>
#include "zlib.h"
#ifdef STDC
#  include <string.h>
#  include <stdlib.h>
#  include <limits.h>
#endif

#ifndef _POSIX_SOURCE
#  define _POSIX_SOURCE
#endif
#include <fcntl.h>

#ifdef _WIN32
#  include <stddef.h>
#endif

#if defined(__TURBOC__) || defined(_MSC_VER) || defined(_WIN32)
#  include <io.h>
#endif

#if defined(_WIN32) || defined(__CYGWIN__)
#  define WIDECHAR
#endif

#ifdef WINAPI_FAMILY
#  define open _open
#  define read _read
#  define write _write
#  define close _close
#endif

#ifdef NO_DEFLATE       /* for compatibility with old definition */
#  define NO_GZCOMPRESS
#endif

#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550)
#  ifndef HAVE_VSNPRINTF
#    define HAVE_VSNPRINTF
#  endif
#endif

#if defined(__CYGWIN__)
#  ifndef HAVE_VSNPRINTF
#    define HAVE_VSNPRINTF
#  endif
#endif

#if defined(MSDOS) && defined(__BORLANDC__) && (BORLANDC > 0x410)
#  ifndef HAVE_VSNPRINTF
#    define HAVE_VSNPRINTF
#  endif
#endif

#ifndef HAVE_VSNPRINTF
#  ifdef MSDOS
/* vsnprintf may exist on some MS-DOS compilers (DJGPP?),
   but for now we just assume it doesn't. */
#    define NO_vsnprintf
#  endif
#  ifdef __TURBOC__
#    define NO_vsnprintf
#  endif
#  ifdef WIN32
/* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */
#    if !defined(vsnprintf) && !defined(NO_vsnprintf)
#      if !defined(_MSC_VER) || ( defined(_MSC_VER) && _MSC_VER < 1500 )
#         define vsnprintf _vsnprintf
#      endif
#    endif
#  endif
#  ifdef __SASC
#    define NO_vsnprintf
#  endif
#  ifdef VMS
#    define NO_vsnprintf
#  endif
#  ifdef __OS400__
#    define NO_vsnprintf
#  endif
#  ifdef __MVS__
#    define NO_vsnprintf
#  endif
#endif

/* unlike snprintf (which is required in C99), _snprintf does not guarantee
   null termination of the result -- however this is only used in gzlib.c where
   the result is assured to fit in the space provided */
#if defined(_MSC_VER) && _MSC_VER < 1900
#  define snprintf _snprintf
#endif

#ifndef local
#  define local static
#endif
/* since "static" is used to mean two completely different things in C, we
   define "local" for the non-static meaning of "static", for readability
   (compile with -Dlocal if your debugger can't find static symbols) */

/* gz* functions always use library allocation functions */
#ifndef STDC
  extern voidp  malloc OF((uInt size));
  extern void   free   OF((voidpf ptr));
#endif

/* get errno and strerror definition */
#if defined UNDER_CE
#  include <windows.h>
#  define zstrerror() gz_strwinerror((DWORD)GetLastError())
#else
#  ifndef NO_STRERROR
#    include <errno.h>
#    define zstrerror() strerror(errno)
#  else
#    define zstrerror() "stdio error (consult errno)"
#  endif
#endif

/* provide prototypes for these when building zlib without LFS */
#if !defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0
    ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *));
    ZEXTERN z_off64_t ZEXPORT gzseek64 OF((gzFile, z_off64_t, int));
    ZEXTERN z_off64_t ZEXPORT gztell64 OF((gzFile));
    ZEXTERN z_off64_t ZEXPORT gzoffset64 OF((gzFile));
#endif

/* default memLevel */
#if MAX_MEM_LEVEL >= 8
#  define DEF_MEM_LEVEL 8
#else
#  define DEF_MEM_LEVEL  MAX_MEM_LEVEL
#endif

/* default i/o buffer size -- double this for output when reading (this and
   twice this must be able to fit in an unsigned type) */
#define GZBUFSIZE 8192

/* gzip modes, also provide a little integrity check on the passed structure */
#define GZ_NONE 0
#define GZ_READ 7247
#define GZ_WRITE 31153
#define GZ_APPEND 1     /* mode set to GZ_WRITE after the file is opened */

/* values for gz_state how */
#define LOOK 0      /* look for a gzip header */
#define COPY 1      /* copy input directly */
#define GZIP 2      /* decompress a gzip stream */

/* internal gzip file state data structure */
typedef struct {
        /* exposed contents for gzgetc() macro */
    struct gzFile_s x;      /* "x" for exposed */
                            /* x.have: number of bytes available at x.next */
                            /* x.next: next output data to deliver or write */
                            /* x.pos: current position in uncompressed data */
        /* used for both reading and writing */
    int mode;               /* see gzip modes above */
    int fd;                 /* file descriptor */
    char *path;             /* path or fd for error messages */
    unsigned size;          /* buffer size, zero if not allocated yet */
    unsigned want;          /* requested buffer size, default is GZBUFSIZE */
    unsigned char *in;      /* input buffer (double-sized when writing) */
    unsigned char *out;     /* output buffer (double-sized when reading) */
    int direct;             /* 0 if processing gzip, 1 if transparent */
        /* just for reading */
    int how;                /* 0: get header, 1: copy, 2: decompress */
    z_off64_t start;        /* where the gzip data started, for rewinding */
    int eof;                /* true if end of input file reached */
    int past;               /* true if read requested past end */
        /* just for writing */
    int level;              /* compression level */
    int strategy;           /* compression strategy */
        /* seek request */
    z_off64_t skip;         /* amount to skip (already rewound if backwards) */
    int seek;               /* true if seek request pending */
        /* error information */
    int err;                /* error code */
    char *msg;              /* error message */
        /* zlib inflate or deflate stream */
    z_stream strm;          /* stream structure in-place (not a pointer) */
} gz_state;
typedef gz_state FAR *gz_statep;

/* shared functions */
void ZLIB_INTERNAL gz_error OF((gz_statep, int, const char *));
#if defined UNDER_CE
char ZLIB_INTERNAL *gz_strwinerror OF((DWORD error));
#endif

/* GT_OFF(x), where x is an unsigned value, is true if x > maximum z_off64_t
   value -- needed when comparing unsigned to z_off64_t, which is signed
   (possible z_off64_t types off_t, off64_t, and long are all signed) */
#ifdef INT_MAX
#  define GT_OFF(x) (sizeof(int) == sizeof(z_off64_t) && (x) > INT_MAX)
#else
unsigned ZLIB_INTERNAL gz_intmax OF((void));
#  define GT_OFF(x) (sizeof(int) == sizeof(z_off64_t) && (x) > gz_intmax())
#endif

Deleted compat/zlib/gzlib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637





























































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzlib.c -- zlib functions common to reading and writing gzip files
 * Copyright (C) 2004-2017 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "gzguts.h"

#if defined(_WIN32) && !defined(__BORLANDC__) && !defined(__MINGW32__)
#  define LSEEK _lseeki64
#else
#if defined(_LARGEFILE64_SOURCE) && _LFS64_LARGEFILE-0
#  define LSEEK lseek64
#else
#  define LSEEK lseek
#endif
#endif

/* Local functions */
local void gz_reset OF((gz_statep));
local gzFile gz_open OF((const void *, int, const char *));

#if defined UNDER_CE

/* Map the Windows error number in ERROR to a locale-dependent error message
   string and return a pointer to it.  Typically, the values for ERROR come
   from GetLastError.

   The string pointed to shall not be modified by the application, but may be
   overwritten by a subsequent call to gz_strwinerror

   The gz_strwinerror function does not change the current setting of
   GetLastError. */
char ZLIB_INTERNAL *gz_strwinerror (error)
     DWORD error;
{
    static char buf[1024];

    wchar_t *msgbuf;
    DWORD lasterr = GetLastError();
    DWORD chars = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
        | FORMAT_MESSAGE_ALLOCATE_BUFFER,
        NULL,
        error,
        0, /* Default language */
        (LPVOID)&msgbuf,
        0,
        NULL);
    if (chars != 0) {
        /* If there is an \r\n appended, zap it.  */
        if (chars >= 2
            && msgbuf[chars - 2] == '\r' && msgbuf[chars - 1] == '\n') {
            chars -= 2;
            msgbuf[chars] = 0;
        }

        if (chars > sizeof (buf) - 1) {
            chars = sizeof (buf) - 1;
            msgbuf[chars] = 0;
        }

        wcstombs(buf, msgbuf, chars + 1);
        LocalFree(msgbuf);
    }
    else {
        sprintf(buf, "unknown win32 error (%ld)", error);
    }

    SetLastError(lasterr);
    return buf;
}

#endif /* UNDER_CE */

/* Reset gzip file state */
local void gz_reset(state)
    gz_statep state;
{
    state->x.have = 0;              /* no output data available */
    if (state->mode == GZ_READ) {   /* for reading ... */
        state->eof = 0;             /* not at end of file */
        state->past = 0;            /* have not read past end yet */
        state->how = LOOK;          /* look for gzip header */
    }
    state->seek = 0;                /* no seek request pending */
    gz_error(state, Z_OK, NULL);    /* clear error */
    state->x.pos = 0;               /* no uncompressed data yet */
    state->strm.avail_in = 0;       /* no input data yet */
}

/* Open a gzip file either by name or file descriptor. */
local gzFile gz_open(path, fd, mode)
    const void *path;
    int fd;
    const char *mode;
{
    gz_statep state;
    z_size_t len;
    int oflag;
#ifdef O_CLOEXEC
    int cloexec = 0;
#endif
#ifdef O_EXCL
    int exclusive = 0;
#endif

    /* check input */
    if (path == NULL)
        return NULL;

    /* allocate gzFile structure to return */
    state = (gz_statep)malloc(sizeof(gz_state));
    if (state == NULL)
        return NULL;
    state->size = 0;            /* no buffers allocated yet */
    state->want = GZBUFSIZE;    /* requested buffer size */
    state->msg = NULL;          /* no error message yet */

    /* interpret mode */
    state->mode = GZ_NONE;
    state->level = Z_DEFAULT_COMPRESSION;
    state->strategy = Z_DEFAULT_STRATEGY;
    state->direct = 0;
    while (*mode) {
        if (*mode >= '0' && *mode <= '9')
            state->level = *mode - '0';
        else
            switch (*mode) {
            case 'r':
                state->mode = GZ_READ;
                break;
#ifndef NO_GZCOMPRESS
            case 'w':
                state->mode = GZ_WRITE;
                break;
            case 'a':
                state->mode = GZ_APPEND;
                break;
#endif
            case '+':       /* can't read and write at the same time */
                free(state);
                return NULL;
            case 'b':       /* ignore -- will request binary anyway */
                break;
#ifdef O_CLOEXEC
            case 'e':
                cloexec = 1;
                break;
#endif
#ifdef O_EXCL
            case 'x':
                exclusive = 1;
                break;
#endif
            case 'f':
                state->strategy = Z_FILTERED;
                break;
            case 'h':
                state->strategy = Z_HUFFMAN_ONLY;
                break;
            case 'R':
                state->strategy = Z_RLE;
                break;
            case 'F':
                state->strategy = Z_FIXED;
                break;
            case 'T':
                state->direct = 1;
                break;
            default:        /* could consider as an error, but just ignore */
                ;
            }
        mode++;
    }

    /* must provide an "r", "w", or "a" */
    if (state->mode == GZ_NONE) {
        free(state);
        return NULL;
    }

    /* can't force transparent read */
    if (state->mode == GZ_READ) {
        if (state->direct) {
            free(state);
            return NULL;
        }
        state->direct = 1;      /* for empty file */
    }

    /* save the path name for error messages */
#ifdef WIDECHAR
    if (fd == -2) {
        len = wcstombs(NULL, path, 0);
        if (len == (z_size_t)-1)
            len = 0;
    }
    else
#endif
        len = strlen((const char *)path);
    state->path = (char *)malloc(len + 1);
    if (state->path == NULL) {
        free(state);
        return NULL;
    }
#ifdef WIDECHAR
    if (fd == -2)
        if (len)
            wcstombs(state->path, path, len + 1);
        else
            *(state->path) = 0;
    else
#endif
#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
        (void)snprintf(state->path, len + 1, "%s", (const char *)path);
#else
        strcpy(state->path, path);
#endif

    /* compute the flags for open() */
    oflag =
#ifdef O_LARGEFILE
        O_LARGEFILE |
#endif
#ifdef O_BINARY
        O_BINARY |
#endif
#ifdef O_CLOEXEC
        (cloexec ? O_CLOEXEC : 0) |
#endif
        (state->mode == GZ_READ ?
         O_RDONLY :
         (O_WRONLY | O_CREAT |
#ifdef O_EXCL
          (exclusive ? O_EXCL : 0) |
#endif
          (state->mode == GZ_WRITE ?
           O_TRUNC :
           O_APPEND)));

    /* open the file with the appropriate flags (or just use fd) */
    state->fd = fd > -1 ? fd : (
#ifdef WIDECHAR
        fd == -2 ? _wopen(path, oflag, 0666) :
#endif
        open((const char *)path, oflag, 0666));
    if (state->fd == -1) {
        free(state->path);
        free(state);
        return NULL;
    }
    if (state->mode == GZ_APPEND) {
        LSEEK(state->fd, 0, SEEK_END);  /* so gzoffset() is correct */
        state->mode = GZ_WRITE;         /* simplify later checks */
    }

    /* save the current position for rewinding (only if reading) */
    if (state->mode == GZ_READ) {
        state->start = LSEEK(state->fd, 0, SEEK_CUR);
        if (state->start == -1) state->start = 0;
    }

    /* initialize stream */
    gz_reset(state);

    /* return stream */
    return (gzFile)state;
}

/* -- see zlib.h -- */
gzFile ZEXPORT gzopen(path, mode)
    const char *path;
    const char *mode;
{
    return gz_open(path, -1, mode);
}

/* -- see zlib.h -- */
gzFile ZEXPORT gzopen64(path, mode)
    const char *path;
    const char *mode;
{
    return gz_open(path, -1, mode);
}

/* -- see zlib.h -- */
gzFile ZEXPORT gzdopen(fd, mode)
    int fd;
    const char *mode;
{
    char *path;         /* identifier for error messages */
    gzFile gz;

    if (fd == -1 || (path = (char *)malloc(7 + 3 * sizeof(int))) == NULL)
        return NULL;
#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
    (void)snprintf(path, 7 + 3 * sizeof(int), "<fd:%d>", fd);
#else
    sprintf(path, "<fd:%d>", fd);   /* for debugging */
#endif
    gz = gz_open(path, fd, mode);
    free(path);
    return gz;
}

/* -- see zlib.h -- */
#ifdef WIDECHAR
gzFile ZEXPORT gzopen_w(path, mode)
    const wchar_t *path;
    const char *mode;
{
    return gz_open(path, -2, mode);
}
#endif

/* -- see zlib.h -- */
int ZEXPORT gzbuffer(file, size)
    gzFile file;
    unsigned size;
{
    gz_statep state;

    /* get internal structure and check integrity */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;
    if (state->mode != GZ_READ && state->mode != GZ_WRITE)
        return -1;

    /* make sure we haven't already allocated memory */
    if (state->size != 0)
        return -1;

    /* check and set requested size */
    if ((size << 1) < size)
        return -1;              /* need to be able to double it */
    if (size < 2)
        size = 2;               /* need two bytes to check magic header */
    state->want = size;
    return 0;
}

/* -- see zlib.h -- */
int ZEXPORT gzrewind(file)
    gzFile file;
{
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;

    /* check that we're reading and that there's no error */
    if (state->mode != GZ_READ ||
            (state->err != Z_OK && state->err != Z_BUF_ERROR))
        return -1;

    /* back up and start over */
    if (LSEEK(state->fd, state->start, SEEK_SET) == -1)
        return -1;
    gz_reset(state);
    return 0;
}

/* -- see zlib.h -- */
z_off64_t ZEXPORT gzseek64(file, offset, whence)
    gzFile file;
    z_off64_t offset;
    int whence;
{
    unsigned n;
    z_off64_t ret;
    gz_statep state;

    /* get internal structure and check integrity */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;
    if (state->mode != GZ_READ && state->mode != GZ_WRITE)
        return -1;

    /* check that there's no error */
    if (state->err != Z_OK && state->err != Z_BUF_ERROR)
        return -1;

    /* can only seek from start or relative to current position */
    if (whence != SEEK_SET && whence != SEEK_CUR)
        return -1;

    /* normalize offset to a SEEK_CUR specification */
    if (whence == SEEK_SET)
        offset -= state->x.pos;
    else if (state->seek)
        offset += state->skip;
    state->seek = 0;

    /* if within raw area while reading, just go there */
    if (state->mode == GZ_READ && state->how == COPY &&
            state->x.pos + offset >= 0) {
        ret = LSEEK(state->fd, offset - state->x.have, SEEK_CUR);
        if (ret == -1)
            return -1;
        state->x.have = 0;
        state->eof = 0;
        state->past = 0;
        state->seek = 0;
        gz_error(state, Z_OK, NULL);
        state->strm.avail_in = 0;
        state->x.pos += offset;
        return state->x.pos;
    }

    /* calculate skip amount, rewinding if needed for back seek when reading */
    if (offset < 0) {
        if (state->mode != GZ_READ)         /* writing -- can't go backwards */
            return -1;
        offset += state->x.pos;
        if (offset < 0)                     /* before start of file! */
            return -1;
        if (gzrewind(file) == -1)           /* rewind, then skip to offset */
            return -1;
    }

    /* if reading, skip what's in output buffer (one less gzgetc() check) */
    if (state->mode == GZ_READ) {
        n = GT_OFF(state->x.have) || (z_off64_t)state->x.have > offset ?
            (unsigned)offset : state->x.have;
        state->x.have -= n;
        state->x.next += n;
        state->x.pos += n;
        offset -= n;
    }

    /* request skip (if not zero) */
    if (offset) {
        state->seek = 1;
        state->skip = offset;
    }
    return state->x.pos + offset;
}

/* -- see zlib.h -- */
z_off_t ZEXPORT gzseek(file, offset, whence)
    gzFile file;
    z_off_t offset;
    int whence;
{
    z_off64_t ret;

    ret = gzseek64(file, (z_off64_t)offset, whence);
    return ret == (z_off_t)ret ? (z_off_t)ret : -1;
}

/* -- see zlib.h -- */
z_off64_t ZEXPORT gztell64(file)
    gzFile file;
{
    gz_statep state;

    /* get internal structure and check integrity */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;
    if (state->mode != GZ_READ && state->mode != GZ_WRITE)
        return -1;

    /* return position */
    return state->x.pos + (state->seek ? state->skip : 0);
}

/* -- see zlib.h -- */
z_off_t ZEXPORT gztell(file)
    gzFile file;
{
    z_off64_t ret;

    ret = gztell64(file);
    return ret == (z_off_t)ret ? (z_off_t)ret : -1;
}

/* -- see zlib.h -- */
z_off64_t ZEXPORT gzoffset64(file)
    gzFile file;
{
    z_off64_t offset;
    gz_statep state;

    /* get internal structure and check integrity */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;
    if (state->mode != GZ_READ && state->mode != GZ_WRITE)
        return -1;

    /* compute and return effective offset in file */
    offset = LSEEK(state->fd, 0, SEEK_CUR);
    if (offset == -1)
        return -1;
    if (state->mode == GZ_READ)             /* reading */
        offset -= state->strm.avail_in;     /* don't count buffered input */
    return offset;
}

/* -- see zlib.h -- */
z_off_t ZEXPORT gzoffset(file)
    gzFile file;
{
    z_off64_t ret;

    ret = gzoffset64(file);
    return ret == (z_off_t)ret ? (z_off_t)ret : -1;
}

/* -- see zlib.h -- */
int ZEXPORT gzeof(file)
    gzFile file;
{
    gz_statep state;

    /* get internal structure and check integrity */
    if (file == NULL)
        return 0;
    state = (gz_statep)file;
    if (state->mode != GZ_READ && state->mode != GZ_WRITE)
        return 0;

    /* return end-of-file state */
    return state->mode == GZ_READ ? state->past : 0;
}

/* -- see zlib.h -- */
const char * ZEXPORT gzerror(file, errnum)
    gzFile file;
    int *errnum;
{
    gz_statep state;

    /* get internal structure and check integrity */
    if (file == NULL)
        return NULL;
    state = (gz_statep)file;
    if (state->mode != GZ_READ && state->mode != GZ_WRITE)
        return NULL;

    /* return error information */
    if (errnum != NULL)
        *errnum = state->err;
    return state->err == Z_MEM_ERROR ? "out of memory" :
                                       (state->msg == NULL ? "" : state->msg);
}

/* -- see zlib.h -- */
void ZEXPORT gzclearerr(file)
    gzFile file;
{
    gz_statep state;

    /* get internal structure and check integrity */
    if (file == NULL)
        return;
    state = (gz_statep)file;
    if (state->mode != GZ_READ && state->mode != GZ_WRITE)
        return;

    /* clear error and end-of-file */
    if (state->mode == GZ_READ) {
        state->eof = 0;
        state->past = 0;
    }
    gz_error(state, Z_OK, NULL);
}

/* Create an error message in allocated memory and set state->err and
   state->msg accordingly.  Free any previous error message already there.  Do
   not try to free or allocate space if the error is Z_MEM_ERROR (out of
   memory).  Simply save the error message as a static string.  If there is an
   allocation failure constructing the error message, then convert the error to
   out of memory. */
void ZLIB_INTERNAL gz_error(state, err, msg)
    gz_statep state;
    int err;
    const char *msg;
{
    /* free previously allocated message and clear */
    if (state->msg != NULL) {
        if (state->err != Z_MEM_ERROR)
            free(state->msg);
        state->msg = NULL;
    }

    /* if fatal, set state->x.have to 0 so that the gzgetc() macro fails */
    if (err != Z_OK && err != Z_BUF_ERROR)
        state->x.have = 0;

    /* set error code, and if no message, then done */
    state->err = err;
    if (msg == NULL)
        return;

    /* for an out of memory error, return literal string when requested */
    if (err == Z_MEM_ERROR)
        return;

    /* construct error message with path */
    if ((state->msg = (char *)malloc(strlen(state->path) + strlen(msg) + 3)) ==
            NULL) {
        state->err = Z_MEM_ERROR;
        return;
    }
#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
    (void)snprintf(state->msg, strlen(state->path) + strlen(msg) + 3,
                   "%s%s%s", state->path, ": ", msg);
#else
    strcpy(state->msg, state->path);
    strcat(state->msg, ": ");
    strcat(state->msg, msg);
#endif
}

#ifndef INT_MAX
/* portably return maximum value for an int (when limits.h presumed not
   available) -- we need to do this to cover cases where 2's complement not
   used, since C standard permits 1's complement and sign-bit representations,
   otherwise we could just use ((unsigned)-1) >> 1 */
unsigned ZLIB_INTERNAL gz_intmax()
{
    unsigned p, q;

    p = 1;
    do {
        q = p;
        p <<= 1;
        p++;
    } while (p > q);
    return q >> 1;
}
#endif

Deleted compat/zlib/gzread.c.

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














































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzread.c -- zlib functions for reading gzip files
 * Copyright (C) 2004, 2005, 2010, 2011, 2012, 2013, 2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "gzguts.h"

/* Local functions */
local int gz_load OF((gz_statep, unsigned char *, unsigned, unsigned *));
local int gz_avail OF((gz_statep));
local int gz_look OF((gz_statep));
local int gz_decomp OF((gz_statep));
local int gz_fetch OF((gz_statep));
local int gz_skip OF((gz_statep, z_off64_t));
local z_size_t gz_read OF((gz_statep, voidp, z_size_t));

/* Use read() to load a buffer -- return -1 on error, otherwise 0.  Read from
   state->fd, and update state->eof, state->err, and state->msg as appropriate.
   This function needs to loop on read(), since read() is not guaranteed to
   read the number of bytes requested, depending on the type of descriptor. */
local int gz_load(state, buf, len, have)
    gz_statep state;
    unsigned char *buf;
    unsigned len;
    unsigned *have;
{
    int ret;
    unsigned get, max = ((unsigned)-1 >> 2) + 1;

    *have = 0;
    do {
        get = len - *have;
        if (get > max)
            get = max;
        ret = read(state->fd, buf + *have, get);
        if (ret <= 0)
            break;
        *have += (unsigned)ret;
    } while (*have < len);
    if (ret < 0) {
        gz_error(state, Z_ERRNO, zstrerror());
        return -1;
    }
    if (ret == 0)
        state->eof = 1;
    return 0;
}

/* Load up input buffer and set eof flag if last data loaded -- return -1 on
   error, 0 otherwise.  Note that the eof flag is set when the end of the input
   file is reached, even though there may be unused data in the buffer.  Once
   that data has been used, no more attempts will be made to read the file.
   If strm->avail_in != 0, then the current data is moved to the beginning of
   the input buffer, and then the remainder of the buffer is loaded with the
   available data from the input file. */
local int gz_avail(state)
    gz_statep state;
{
    unsigned got;
    z_streamp strm = &(state->strm);

    if (state->err != Z_OK && state->err != Z_BUF_ERROR)
        return -1;
    if (state->eof == 0) {
        if (strm->avail_in) {       /* copy what's there to the start */
            unsigned char *p = state->in;
            unsigned const char *q = strm->next_in;
            unsigned n = strm->avail_in;
            do {
                *p++ = *q++;
            } while (--n);
        }
        if (gz_load(state, state->in + strm->avail_in,
                    state->size - strm->avail_in, &got) == -1)
            return -1;
        strm->avail_in += got;
        strm->next_in = state->in;
    }
    return 0;
}

/* Look for gzip header, set up for inflate or copy.  state->x.have must be 0.
   If this is the first time in, allocate required memory.  state->how will be
   left unchanged if there is no more input data available, will be set to COPY
   if there is no gzip header and direct copying will be performed, or it will
   be set to GZIP for decompression.  If direct copying, then leftover input
   data from the input buffer will be copied to the output buffer.  In that
   case, all further file reads will be directly to either the output buffer or
   a user buffer.  If decompressing, the inflate state will be initialized.
   gz_look() will return 0 on success or -1 on failure. */
local int gz_look(state)
    gz_statep state;
{
    z_streamp strm = &(state->strm);

    /* allocate read buffers and inflate memory */
    if (state->size == 0) {
        /* allocate buffers */
        state->in = (unsigned char *)malloc(state->want);
        state->out = (unsigned char *)malloc(state->want << 1);
        if (state->in == NULL || state->out == NULL) {
            free(state->out);
            free(state->in);
            gz_error(state, Z_MEM_ERROR, "out of memory");
            return -1;
        }
        state->size = state->want;

        /* allocate inflate memory */
        state->strm.zalloc = Z_NULL;
        state->strm.zfree = Z_NULL;
        state->strm.opaque = Z_NULL;
        state->strm.avail_in = 0;
        state->strm.next_in = Z_NULL;
        if (inflateInit2(&(state->strm), 15 + 16) != Z_OK) {    /* gunzip */
            free(state->out);
            free(state->in);
            state->size = 0;
            gz_error(state, Z_MEM_ERROR, "out of memory");
            return -1;
        }
    }

    /* get at least the magic bytes in the input buffer */
    if (strm->avail_in < 2) {
        if (gz_avail(state) == -1)
            return -1;
        if (strm->avail_in == 0)
            return 0;
    }

    /* look for gzip magic bytes -- if there, do gzip decoding (note: there is
       a logical dilemma here when considering the case of a partially written
       gzip file, to wit, if a single 31 byte is written, then we cannot tell
       whether this is a single-byte file, or just a partially written gzip
       file -- for here we assume that if a gzip file is being written, then
       the header will be written in a single operation, so that reading a
       single byte is sufficient indication that it is not a gzip file) */
    if (strm->avail_in > 1 &&
            strm->next_in[0] == 31 && strm->next_in[1] == 139) {
        inflateReset(strm);
        state->how = GZIP;
        state->direct = 0;
        return 0;
    }

    /* no gzip header -- if we were decoding gzip before, then this is trailing
       garbage.  Ignore the trailing garbage and finish. */
    if (state->direct == 0) {
        strm->avail_in = 0;
        state->eof = 1;
        state->x.have = 0;
        return 0;
    }

    /* doing raw i/o, copy any leftover input to output -- this assumes that
       the output buffer is larger than the input buffer, which also assures
       space for gzungetc() */
    state->x.next = state->out;
    if (strm->avail_in) {
        memcpy(state->x.next, strm->next_in, strm->avail_in);
        state->x.have = strm->avail_in;
        strm->avail_in = 0;
    }
    state->how = COPY;
    state->direct = 1;
    return 0;
}

/* Decompress from input to the provided next_out and avail_out in the state.
   On return, state->x.have and state->x.next point to the just decompressed
   data.  If the gzip stream completes, state->how is reset to LOOK to look for
   the next gzip stream or raw data, once state->x.have is depleted.  Returns 0
   on success, -1 on failure. */
local int gz_decomp(state)
    gz_statep state;
{
    int ret = Z_OK;
    unsigned had;
    z_streamp strm = &(state->strm);

    /* fill output buffer up to end of deflate stream */
    had = strm->avail_out;
    do {
        /* get more input for inflate() */
        if (strm->avail_in == 0 && gz_avail(state) == -1)
            return -1;
        if (strm->avail_in == 0) {
            gz_error(state, Z_BUF_ERROR, "unexpected end of file");
            break;
        }

        /* decompress and handle errors */
        ret = inflate(strm, Z_NO_FLUSH);
        if (ret == Z_STREAM_ERROR || ret == Z_NEED_DICT) {
            gz_error(state, Z_STREAM_ERROR,
                     "internal error: inflate stream corrupt");
            return -1;
        }
        if (ret == Z_MEM_ERROR) {
            gz_error(state, Z_MEM_ERROR, "out of memory");
            return -1;
        }
        if (ret == Z_DATA_ERROR) {              /* deflate stream invalid */
            gz_error(state, Z_DATA_ERROR,
                     strm->msg == NULL ? "compressed data error" : strm->msg);
            return -1;
        }
    } while (strm->avail_out && ret != Z_STREAM_END);

    /* update available output */
    state->x.have = had - strm->avail_out;
    state->x.next = strm->next_out - state->x.have;

    /* if the gzip stream completed successfully, look for another */
    if (ret == Z_STREAM_END)
        state->how = LOOK;

    /* good decompression */
    return 0;
}

/* Fetch data and put it in the output buffer.  Assumes state->x.have is 0.
   Data is either copied from the input file or decompressed from the input
   file depending on state->how.  If state->how is LOOK, then a gzip header is
   looked for to determine whether to copy or decompress.  Returns -1 on error,
   otherwise 0.  gz_fetch() will leave state->how as COPY or GZIP unless the
   end of the input file has been reached and all data has been processed.  */
local int gz_fetch(state)
    gz_statep state;
{
    z_streamp strm = &(state->strm);

    do {
        switch(state->how) {
        case LOOK:      /* -> LOOK, COPY (only if never GZIP), or GZIP */
            if (gz_look(state) == -1)
                return -1;
            if (state->how == LOOK)
                return 0;
            break;
        case COPY:      /* -> COPY */
            if (gz_load(state, state->out, state->size << 1, &(state->x.have))
                    == -1)
                return -1;
            state->x.next = state->out;
            return 0;
        case GZIP:      /* -> GZIP or LOOK (if end of gzip stream) */
            strm->avail_out = state->size << 1;
            strm->next_out = state->out;
            if (gz_decomp(state) == -1)
                return -1;
        }
    } while (state->x.have == 0 && (!state->eof || strm->avail_in));
    return 0;
}

/* Skip len uncompressed bytes of output.  Return -1 on error, 0 on success. */
local int gz_skip(state, len)
    gz_statep state;
    z_off64_t len;
{
    unsigned n;

    /* skip over len bytes or reach end-of-file, whichever comes first */
    while (len)
        /* skip over whatever is in output buffer */
        if (state->x.have) {
            n = GT_OFF(state->x.have) || (z_off64_t)state->x.have > len ?
                (unsigned)len : state->x.have;
            state->x.have -= n;
            state->x.next += n;
            state->x.pos += n;
            len -= n;
        }

        /* output buffer empty -- return if we're at the end of the input */
        else if (state->eof && state->strm.avail_in == 0)
            break;

        /* need more data to skip -- load up output buffer */
        else {
            /* get more output, looking for header if required */
            if (gz_fetch(state) == -1)
                return -1;
        }
    return 0;
}

/* Read len bytes into buf from file, or less than len up to the end of the
   input.  Return the number of bytes read.  If zero is returned, either the
   end of file was reached, or there was an error.  state->err must be
   consulted in that case to determine which. */
local z_size_t gz_read(state, buf, len)
    gz_statep state;
    voidp buf;
    z_size_t len;
{
    z_size_t got;
    unsigned n;

    /* if len is zero, avoid unnecessary operations */
    if (len == 0)
        return 0;

    /* process a skip request */
    if (state->seek) {
        state->seek = 0;
        if (gz_skip(state, state->skip) == -1)
            return 0;
    }

    /* get len bytes to buf, or less than len if at the end */
    got = 0;
    do {
        /* set n to the maximum amount of len that fits in an unsigned int */
        n = -1;
        if (n > len)
            n = len;

        /* first just try copying data from the output buffer */
        if (state->x.have) {
            if (state->x.have < n)
                n = state->x.have;
            memcpy(buf, state->x.next, n);
            state->x.next += n;
            state->x.have -= n;
        }

        /* output buffer empty -- return if we're at the end of the input */
        else if (state->eof && state->strm.avail_in == 0) {
            state->past = 1;        /* tried to read past end */
            break;
        }

        /* need output data -- for small len or new stream load up our output
           buffer */
        else if (state->how == LOOK || n < (state->size << 1)) {
            /* get more output, looking for header if required */
            if (gz_fetch(state) == -1)
                return 0;
            continue;       /* no progress yet -- go back to copy above */
            /* the copy above assures that we will leave with space in the
               output buffer, allowing at least one gzungetc() to succeed */
        }

        /* large len -- read directly into user buffer */
        else if (state->how == COPY) {      /* read directly */
            if (gz_load(state, (unsigned char *)buf, n, &n) == -1)
                return 0;
        }

        /* large len -- decompress directly into user buffer */
        else {  /* state->how == GZIP */
            state->strm.avail_out = n;
            state->strm.next_out = (unsigned char *)buf;
            if (gz_decomp(state) == -1)
                return 0;
            n = state->x.have;
            state->x.have = 0;
        }

        /* update progress */
        len -= n;
        buf = (char *)buf + n;
        got += n;
        state->x.pos += n;
    } while (len);

    /* return number of bytes read into user buffer */
    return got;
}

/* -- see zlib.h -- */
int ZEXPORT gzread(file, buf, len)
    gzFile file;
    voidp buf;
    unsigned len;
{
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;

    /* check that we're reading and that there's no (serious) error */
    if (state->mode != GZ_READ ||
            (state->err != Z_OK && state->err != Z_BUF_ERROR))
        return -1;

    /* since an int is returned, make sure len fits in one, otherwise return
       with an error (this avoids a flaw in the interface) */
    if ((int)len < 0) {
        gz_error(state, Z_STREAM_ERROR, "request does not fit in an int");
        return -1;
    }

    /* read len or fewer bytes to buf */
    len = gz_read(state, buf, len);

    /* check for an error */
    if (len == 0 && state->err != Z_OK && state->err != Z_BUF_ERROR)
        return -1;

    /* return the number of bytes read (this is assured to fit in an int) */
    return (int)len;
}

/* -- see zlib.h -- */
z_size_t ZEXPORT gzfread(buf, size, nitems, file)
    voidp buf;
    z_size_t size;
    z_size_t nitems;
    gzFile file;
{
    z_size_t len;
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return 0;
    state = (gz_statep)file;

    /* check that we're reading and that there's no (serious) error */
    if (state->mode != GZ_READ ||
            (state->err != Z_OK && state->err != Z_BUF_ERROR))
        return 0;

    /* compute bytes to read -- error on overflow */
    len = nitems * size;
    if (size && len / size != nitems) {
        gz_error(state, Z_STREAM_ERROR, "request does not fit in a size_t");
        return 0;
    }

    /* read len or fewer bytes to buf, return the number of full items read */
    return len ? gz_read(state, buf, len) / size : 0;
}

/* -- see zlib.h -- */
#ifdef Z_PREFIX_SET
#  undef z_gzgetc
#else
#  undef gzgetc
#endif
int ZEXPORT gzgetc(file)
    gzFile file;
{
    int ret;
    unsigned char buf[1];
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;

    /* check that we're reading and that there's no (serious) error */
    if (state->mode != GZ_READ ||
        (state->err != Z_OK && state->err != Z_BUF_ERROR))
        return -1;

    /* try output buffer (no need to check for skip request) */
    if (state->x.have) {
        state->x.have--;
        state->x.pos++;
        return *(state->x.next)++;
    }

    /* nothing there -- try gz_read() */
    ret = gz_read(state, buf, 1);
    return ret < 1 ? -1 : buf[0];
}

int ZEXPORT gzgetc_(file)
gzFile file;
{
    return gzgetc(file);
}

/* -- see zlib.h -- */
int ZEXPORT gzungetc(c, file)
    int c;
    gzFile file;
{
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;

    /* check that we're reading and that there's no (serious) error */
    if (state->mode != GZ_READ ||
        (state->err != Z_OK && state->err != Z_BUF_ERROR))
        return -1;

    /* process a skip request */
    if (state->seek) {
        state->seek = 0;
        if (gz_skip(state, state->skip) == -1)
            return -1;
    }

    /* can't push EOF */
    if (c < 0)
        return -1;

    /* if output buffer empty, put byte at end (allows more pushing) */
    if (state->x.have == 0) {
        state->x.have = 1;
        state->x.next = state->out + (state->size << 1) - 1;
        state->x.next[0] = (unsigned char)c;
        state->x.pos--;
        state->past = 0;
        return c;
    }

    /* if no room, give up (must have already done a gzungetc()) */
    if (state->x.have == (state->size << 1)) {
        gz_error(state, Z_DATA_ERROR, "out of room to push characters");
        return -1;
    }

    /* slide output data if needed and insert byte before existing data */
    if (state->x.next == state->out) {
        unsigned char *src = state->out + state->x.have;
        unsigned char *dest = state->out + (state->size << 1);
        while (src > state->out)
            *--dest = *--src;
        state->x.next = dest;
    }
    state->x.have++;
    state->x.next--;
    state->x.next[0] = (unsigned char)c;
    state->x.pos--;
    state->past = 0;
    return c;
}

/* -- see zlib.h -- */
char * ZEXPORT gzgets(file, buf, len)
    gzFile file;
    char *buf;
    int len;
{
    unsigned left, n;
    char *str;
    unsigned char *eol;
    gz_statep state;

    /* check parameters and get internal structure */
    if (file == NULL || buf == NULL || len < 1)
        return NULL;
    state = (gz_statep)file;

    /* check that we're reading and that there's no (serious) error */
    if (state->mode != GZ_READ ||
        (state->err != Z_OK && state->err != Z_BUF_ERROR))
        return NULL;

    /* process a skip request */
    if (state->seek) {
        state->seek = 0;
        if (gz_skip(state, state->skip) == -1)
            return NULL;
    }

    /* copy output bytes up to new line or len - 1, whichever comes first --
       append a terminating zero to the string (we don't check for a zero in
       the contents, let the user worry about that) */
    str = buf;
    left = (unsigned)len - 1;
    if (left) do {
        /* assure that something is in the output buffer */
        if (state->x.have == 0 && gz_fetch(state) == -1)
            return NULL;                /* error */
        if (state->x.have == 0) {       /* end of file */
            state->past = 1;            /* read past end */
            break;                      /* return what we have */
        }

        /* look for end-of-line in current output buffer */
        n = state->x.have > left ? left : state->x.have;
        eol = (unsigned char *)memchr(state->x.next, '\n', n);
        if (eol != NULL)
            n = (unsigned)(eol - state->x.next) + 1;

        /* copy through end-of-line, or remainder if not found */
        memcpy(buf, state->x.next, n);
        state->x.have -= n;
        state->x.next += n;
        state->x.pos += n;
        left -= n;
        buf += n;
    } while (left && eol == NULL);

    /* return terminated string, or if nothing, end of file */
    if (buf == str)
        return NULL;
    buf[0] = 0;
    return str;
}

/* -- see zlib.h -- */
int ZEXPORT gzdirect(file)
    gzFile file;
{
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return 0;
    state = (gz_statep)file;

    /* if the state is not known, but we can find out, then do so (this is
       mainly for right after a gzopen() or gzdopen()) */
    if (state->mode == GZ_READ && state->how == LOOK && state->x.have == 0)
        (void)gz_look(state);

    /* return 1 if transparent, 0 if processing a gzip stream */
    return state->direct;
}

/* -- see zlib.h -- */
int ZEXPORT gzclose_r(file)
    gzFile file;
{
    int ret, err;
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return Z_STREAM_ERROR;
    state = (gz_statep)file;

    /* check that we're reading */
    if (state->mode != GZ_READ)
        return Z_STREAM_ERROR;

    /* free memory and close file */
    if (state->size) {
        inflateEnd(&(state->strm));
        free(state->out);
        free(state->in);
    }
    err = state->err == Z_BUF_ERROR ? Z_BUF_ERROR : Z_OK;
    gz_error(state, Z_OK, NULL);
    free(state->path);
    ret = close(state->fd);
    free(state);
    return ret ? Z_ERRNO : err;
}

Deleted compat/zlib/gzwrite.c.

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

























































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* gzwrite.c -- zlib functions for writing gzip files
 * Copyright (C) 2004-2017 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "gzguts.h"

/* Local functions */
local int gz_init OF((gz_statep));
local int gz_comp OF((gz_statep, int));
local int gz_zero OF((gz_statep, z_off64_t));
local z_size_t gz_write OF((gz_statep, voidpc, z_size_t));

/* Initialize state for writing a gzip file.  Mark initialization by setting
   state->size to non-zero.  Return -1 on a memory allocation failure, or 0 on
   success. */
local int gz_init(state)
    gz_statep state;
{
    int ret;
    z_streamp strm = &(state->strm);

    /* allocate input buffer (double size for gzprintf) */
    state->in = (unsigned char *)malloc(state->want << 1);
    if (state->in == NULL) {
        gz_error(state, Z_MEM_ERROR, "out of memory");
        return -1;
    }

    /* only need output buffer and deflate state if compressing */
    if (!state->direct) {
        /* allocate output buffer */
        state->out = (unsigned char *)malloc(state->want);
        if (state->out == NULL) {
            free(state->in);
            gz_error(state, Z_MEM_ERROR, "out of memory");
            return -1;
        }

        /* allocate deflate memory, set up for gzip compression */
        strm->zalloc = Z_NULL;
        strm->zfree = Z_NULL;
        strm->opaque = Z_NULL;
        ret = deflateInit2(strm, state->level, Z_DEFLATED,
                           MAX_WBITS + 16, DEF_MEM_LEVEL, state->strategy);
        if (ret != Z_OK) {
            free(state->out);
            free(state->in);
            gz_error(state, Z_MEM_ERROR, "out of memory");
            return -1;
        }
        strm->next_in = NULL;
    }

    /* mark state as initialized */
    state->size = state->want;

    /* initialize write buffer if compressing */
    if (!state->direct) {
        strm->avail_out = state->size;
        strm->next_out = state->out;
        state->x.next = strm->next_out;
    }
    return 0;
}

/* Compress whatever is at avail_in and next_in and write to the output file.
   Return -1 if there is an error writing to the output file or if gz_init()
   fails to allocate memory, otherwise 0.  flush is assumed to be a valid
   deflate() flush value.  If flush is Z_FINISH, then the deflate() state is
   reset to start a new gzip stream.  If gz->direct is true, then simply write
   to the output file without compressing, and ignore flush. */
local int gz_comp(state, flush)
    gz_statep state;
    int flush;
{
    int ret, writ;
    unsigned have, put, max = ((unsigned)-1 >> 2) + 1;
    z_streamp strm = &(state->strm);

    /* allocate memory if this is the first time through */
    if (state->size == 0 && gz_init(state) == -1)
        return -1;

    /* write directly if requested */
    if (state->direct) {
        while (strm->avail_in) {
            put = strm->avail_in > max ? max : strm->avail_in;
            writ = write(state->fd, strm->next_in, put);
            if (writ < 0) {
                gz_error(state, Z_ERRNO, zstrerror());
                return -1;
            }
            strm->avail_in -= (unsigned)writ;
            strm->next_in += writ;
        }
        return 0;
    }

    /* run deflate() on provided input until it produces no more output */
    ret = Z_OK;
    do {
        /* write out current buffer contents if full, or if flushing, but if
           doing Z_FINISH then don't write until we get to Z_STREAM_END */
        if (strm->avail_out == 0 || (flush != Z_NO_FLUSH &&
            (flush != Z_FINISH || ret == Z_STREAM_END))) {
            while (strm->next_out > state->x.next) {
                put = strm->next_out - state->x.next > (int)max ? max :
                      (unsigned)(strm->next_out - state->x.next);
                writ = write(state->fd, state->x.next, put);
                if (writ < 0) {
                    gz_error(state, Z_ERRNO, zstrerror());
                    return -1;
                }
                state->x.next += writ;
            }
            if (strm->avail_out == 0) {
                strm->avail_out = state->size;
                strm->next_out = state->out;
                state->x.next = state->out;
            }
        }

        /* compress */
        have = strm->avail_out;
        ret = deflate(strm, flush);
        if (ret == Z_STREAM_ERROR) {
            gz_error(state, Z_STREAM_ERROR,
                      "internal error: deflate stream corrupt");
            return -1;
        }
        have -= strm->avail_out;
    } while (have);

    /* if that completed a deflate stream, allow another to start */
    if (flush == Z_FINISH)
        deflateReset(strm);

    /* all done, no errors */
    return 0;
}

/* Compress len zeros to output.  Return -1 on a write error or memory
   allocation failure by gz_comp(), or 0 on success. */
local int gz_zero(state, len)
    gz_statep state;
    z_off64_t len;
{
    int first;
    unsigned n;
    z_streamp strm = &(state->strm);

    /* consume whatever's left in the input buffer */
    if (strm->avail_in && gz_comp(state, Z_NO_FLUSH) == -1)
        return -1;

    /* compress len zeros (len guaranteed > 0) */
    first = 1;
    while (len) {
        n = GT_OFF(state->size) || (z_off64_t)state->size > len ?
            (unsigned)len : state->size;
        if (first) {
            memset(state->in, 0, n);
            first = 0;
        }
        strm->avail_in = n;
        strm->next_in = state->in;
        state->x.pos += n;
        if (gz_comp(state, Z_NO_FLUSH) == -1)
            return -1;
        len -= n;
    }
    return 0;
}

/* Write len bytes from buf to file.  Return the number of bytes written.  If
   the returned value is less than len, then there was an error. */
local z_size_t gz_write(state, buf, len)
    gz_statep state;
    voidpc buf;
    z_size_t len;
{
    z_size_t put = len;

    /* if len is zero, avoid unnecessary operations */
    if (len == 0)
        return 0;

    /* allocate memory if this is the first time through */
    if (state->size == 0 && gz_init(state) == -1)
        return 0;

    /* check for seek request */
    if (state->seek) {
        state->seek = 0;
        if (gz_zero(state, state->skip) == -1)
            return 0;
    }

    /* for small len, copy to input buffer, otherwise compress directly */
    if (len < state->size) {
        /* copy to input buffer, compress when full */
        do {
            unsigned have, copy;

            if (state->strm.avail_in == 0)
                state->strm.next_in = state->in;
            have = (unsigned)((state->strm.next_in + state->strm.avail_in) -
                              state->in);
            copy = state->size - have;
            if (copy > len)
                copy = len;
            memcpy(state->in + have, buf, copy);
            state->strm.avail_in += copy;
            state->x.pos += copy;
            buf = (const char *)buf + copy;
            len -= copy;
            if (len && gz_comp(state, Z_NO_FLUSH) == -1)
                return 0;
        } while (len);
    }
    else {
        /* consume whatever's left in the input buffer */
        if (state->strm.avail_in && gz_comp(state, Z_NO_FLUSH) == -1)
            return 0;

        /* directly compress user buffer to file */
        state->strm.next_in = (z_const Bytef *)buf;
        do {
            unsigned n = (unsigned)-1;
            if (n > len)
                n = len;
            state->strm.avail_in = n;
            state->x.pos += n;
            if (gz_comp(state, Z_NO_FLUSH) == -1)
                return 0;
            len -= n;
        } while (len);
    }

    /* input was all buffered or compressed */
    return put;
}

/* -- see zlib.h -- */
int ZEXPORT gzwrite(file, buf, len)
    gzFile file;
    voidpc buf;
    unsigned len;
{
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return 0;
    state = (gz_statep)file;

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return 0;

    /* since an int is returned, make sure len fits in one, otherwise return
       with an error (this avoids a flaw in the interface) */
    if ((int)len < 0) {
        gz_error(state, Z_DATA_ERROR, "requested length does not fit in int");
        return 0;
    }

    /* write len bytes from buf (the return value will fit in an int) */
    return (int)gz_write(state, buf, len);
}

/* -- see zlib.h -- */
z_size_t ZEXPORT gzfwrite(buf, size, nitems, file)
    voidpc buf;
    z_size_t size;
    z_size_t nitems;
    gzFile file;
{
    z_size_t len;
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return 0;
    state = (gz_statep)file;

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return 0;

    /* compute bytes to read -- error on overflow */
    len = nitems * size;
    if (size && len / size != nitems) {
        gz_error(state, Z_STREAM_ERROR, "request does not fit in a size_t");
        return 0;
    }

    /* write len bytes to buf, return the number of full items written */
    return len ? gz_write(state, buf, len) / size : 0;
}

/* -- see zlib.h -- */
int ZEXPORT gzputc(file, c)
    gzFile file;
    int c;
{
    unsigned have;
    unsigned char buf[1];
    gz_statep state;
    z_streamp strm;

    /* get internal structure */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;
    strm = &(state->strm);

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return -1;

    /* check for seek request */
    if (state->seek) {
        state->seek = 0;
        if (gz_zero(state, state->skip) == -1)
            return -1;
    }

    /* try writing to input buffer for speed (state->size == 0 if buffer not
       initialized) */
    if (state->size) {
        if (strm->avail_in == 0)
            strm->next_in = state->in;
        have = (unsigned)((strm->next_in + strm->avail_in) - state->in);
        if (have < state->size) {
            state->in[have] = (unsigned char)c;
            strm->avail_in++;
            state->x.pos++;
            return c & 0xff;
        }
    }

    /* no room in buffer or not initialized, use gz_write() */
    buf[0] = (unsigned char)c;
    if (gz_write(state, buf, 1) != 1)
        return -1;
    return c & 0xff;
}

/* -- see zlib.h -- */
int ZEXPORT gzputs(file, str)
    gzFile file;
    const char *str;
{
    int ret;
    z_size_t len;
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return -1;
    state = (gz_statep)file;

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return -1;

    /* write string */
    len = strlen(str);
    ret = gz_write(state, str, len);
    return ret == 0 && len != 0 ? -1 : ret;
}

#if defined(STDC) || defined(Z_HAVE_STDARG_H)
#include <stdarg.h>

/* -- see zlib.h -- */
int ZEXPORTVA gzvprintf(gzFile file, const char *format, va_list va)
{
    int len;
    unsigned left;
    char *next;
    gz_statep state;
    z_streamp strm;

    /* get internal structure */
    if (file == NULL)
        return Z_STREAM_ERROR;
    state = (gz_statep)file;
    strm = &(state->strm);

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return Z_STREAM_ERROR;

    /* make sure we have some buffer space */
    if (state->size == 0 && gz_init(state) == -1)
        return state->err;

    /* check for seek request */
    if (state->seek) {
        state->seek = 0;
        if (gz_zero(state, state->skip) == -1)
            return state->err;
    }

    /* do the printf() into the input buffer, put length in len -- the input
       buffer is double-sized just for this function, so there is guaranteed to
       be state->size bytes available after the current contents */
    if (strm->avail_in == 0)
        strm->next_in = state->in;
    next = (char *)(state->in + (strm->next_in - state->in) + strm->avail_in);
    next[state->size - 1] = 0;
#ifdef NO_vsnprintf
#  ifdef HAS_vsprintf_void
    (void)vsprintf(next, format, va);
    for (len = 0; len < state->size; len++)
        if (next[len] == 0) break;
#  else
    len = vsprintf(next, format, va);
#  endif
#else
#  ifdef HAS_vsnprintf_void
    (void)vsnprintf(next, state->size, format, va);
    len = strlen(next);
#  else
    len = vsnprintf(next, state->size, format, va);
#  endif
#endif

    /* check that printf() results fit in buffer */
    if (len == 0 || (unsigned)len >= state->size || next[state->size - 1] != 0)
        return 0;

    /* update buffer and position, compress first half if past that */
    strm->avail_in += (unsigned)len;
    state->x.pos += len;
    if (strm->avail_in >= state->size) {
        left = strm->avail_in - state->size;
        strm->avail_in = state->size;
        if (gz_comp(state, Z_NO_FLUSH) == -1)
            return state->err;
        memcpy(state->in, state->in + state->size, left);
        strm->next_in = state->in;
        strm->avail_in = left;
    }
    return len;
}

int ZEXPORTVA gzprintf(gzFile file, const char *format, ...)
{
    va_list va;
    int ret;

    va_start(va, format);
    ret = gzvprintf(file, format, va);
    va_end(va);
    return ret;
}

#else /* !STDC && !Z_HAVE_STDARG_H */

/* -- see zlib.h -- */
int ZEXPORTVA gzprintf (file, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
                       a11, a12, a13, a14, a15, a16, a17, a18, a19, a20)
    gzFile file;
    const char *format;
    int a1, a2, a3, a4, a5, a6, a7, a8, a9, a10,
        a11, a12, a13, a14, a15, a16, a17, a18, a19, a20;
{
    unsigned len, left;
    char *next;
    gz_statep state;
    z_streamp strm;

    /* get internal structure */
    if (file == NULL)
        return Z_STREAM_ERROR;
    state = (gz_statep)file;
    strm = &(state->strm);

    /* check that can really pass pointer in ints */
    if (sizeof(int) != sizeof(void *))
        return Z_STREAM_ERROR;

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return Z_STREAM_ERROR;

    /* make sure we have some buffer space */
    if (state->size == 0 && gz_init(state) == -1)
        return state->error;

    /* check for seek request */
    if (state->seek) {
        state->seek = 0;
        if (gz_zero(state, state->skip) == -1)
            return state->error;
    }

    /* do the printf() into the input buffer, put length in len -- the input
       buffer is double-sized just for this function, so there is guaranteed to
       be state->size bytes available after the current contents */
    if (strm->avail_in == 0)
        strm->next_in = state->in;
    next = (char *)(strm->next_in + strm->avail_in);
    next[state->size - 1] = 0;
#ifdef NO_snprintf
#  ifdef HAS_sprintf_void
    sprintf(next, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12,
            a13, a14, a15, a16, a17, a18, a19, a20);
    for (len = 0; len < size; len++)
        if (next[len] == 0)
            break;
#  else
    len = sprintf(next, format, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11,
                  a12, a13, a14, a15, a16, a17, a18, a19, a20);
#  endif
#else
#  ifdef HAS_snprintf_void
    snprintf(next, state->size, format, a1, a2, a3, a4, a5, a6, a7, a8, a9,
             a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
    len = strlen(next);
#  else
    len = snprintf(next, state->size, format, a1, a2, a3, a4, a5, a6, a7, a8,
                   a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20);
#  endif
#endif

    /* check that printf() results fit in buffer */
    if (len == 0 || len >= state->size || next[state->size - 1] != 0)
        return 0;

    /* update buffer and position, compress first half if past that */
    strm->avail_in += len;
    state->x.pos += len;
    if (strm->avail_in >= state->size) {
        left = strm->avail_in - state->size;
        strm->avail_in = state->size;
        if (gz_comp(state, Z_NO_FLUSH) == -1)
            return state->err;
        memcpy(state->in, state->in + state->size, left);
        strm->next_in = state->in;
        strm->avail_in = left;
    }
    return (int)len;
}

#endif

/* -- see zlib.h -- */
int ZEXPORT gzflush(file, flush)
    gzFile file;
    int flush;
{
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return Z_STREAM_ERROR;
    state = (gz_statep)file;

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return Z_STREAM_ERROR;

    /* check flush parameter */
    if (flush < 0 || flush > Z_FINISH)
        return Z_STREAM_ERROR;

    /* check for seek request */
    if (state->seek) {
        state->seek = 0;
        if (gz_zero(state, state->skip) == -1)
            return state->err;
    }

    /* compress remaining data with requested flush */
    (void)gz_comp(state, flush);
    return state->err;
}

/* -- see zlib.h -- */
int ZEXPORT gzsetparams(file, level, strategy)
    gzFile file;
    int level;
    int strategy;
{
    gz_statep state;
    z_streamp strm;

    /* get internal structure */
    if (file == NULL)
        return Z_STREAM_ERROR;
    state = (gz_statep)file;
    strm = &(state->strm);

    /* check that we're writing and that there's no error */
    if (state->mode != GZ_WRITE || state->err != Z_OK)
        return Z_STREAM_ERROR;

    /* if no change is requested, then do nothing */
    if (level == state->level && strategy == state->strategy)
        return Z_OK;

    /* check for seek request */
    if (state->seek) {
        state->seek = 0;
        if (gz_zero(state, state->skip) == -1)
            return state->err;
    }

    /* change compression parameters for subsequent input */
    if (state->size) {
        /* flush previous input with previous parameters before changing */
        if (strm->avail_in && gz_comp(state, Z_BLOCK) == -1)
            return state->err;
        deflateParams(strm, level, strategy);
    }
    state->level = level;
    state->strategy = strategy;
    return Z_OK;
}

/* -- see zlib.h -- */
int ZEXPORT gzclose_w(file)
    gzFile file;
{
    int ret = Z_OK;
    gz_statep state;

    /* get internal structure */
    if (file == NULL)
        return Z_STREAM_ERROR;
    state = (gz_statep)file;

    /* check that we're writing */
    if (state->mode != GZ_WRITE)
        return Z_STREAM_ERROR;

    /* check for seek request */
    if (state->seek) {
        state->seek = 0;
        if (gz_zero(state, state->skip) == -1)
            ret = state->err;
    }

    /* flush, free memory, and close file */
    if (gz_comp(state, Z_FINISH) == -1)
        ret = state->err;
    if (state->size) {
        if (!state->direct) {
            (void)deflateEnd(&(state->strm));
            free(state->out);
        }
        free(state->in);
    }
    gz_error(state, Z_OK, NULL);
    free(state->path);
    if (close(state->fd) == -1)
        ret = Z_ERRNO;
    free(state);
    return ret;
}

Deleted compat/zlib/infback.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* infback.c -- inflate using a call-back interface
 * Copyright (C) 1995-2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/*
   This code is largely copied from inflate.c.  Normally either infback.o or
   inflate.o would be linked into an application--not both.  The interface
   with inffast.c is retained so that optimized assembler-coded versions of
   inflate_fast() can be used with either inflate.c or infback.c.
 */

#include "zutil.h"
#include "inftrees.h"
#include "inflate.h"
#include "inffast.h"

/* function prototypes */
local void fixedtables OF((struct inflate_state FAR *state));

/*
   strm provides memory allocation functions in zalloc and zfree, or
   Z_NULL to use the library memory allocation functions.

   windowBits is in the range 8..15, and window is a user-supplied
   window and output buffer that is 2**windowBits bytes.
 */
int ZEXPORT inflateBackInit_(strm, windowBits, window, version, stream_size)
z_streamp strm;
int windowBits;
unsigned char FAR *window;
const char *version;
int stream_size;
{
    struct inflate_state FAR *state;

    if (version == Z_NULL || version[0] != ZLIB_VERSION[0] ||
        stream_size != (int)(sizeof(z_stream)))
        return Z_VERSION_ERROR;
    if (strm == Z_NULL || window == Z_NULL ||
        windowBits < 8 || windowBits > 15)
        return Z_STREAM_ERROR;
    strm->msg = Z_NULL;                 /* in case we return an error */
    if (strm->zalloc == (alloc_func)0) {
#ifdef Z_SOLO
        return Z_STREAM_ERROR;
#else
        strm->zalloc = zcalloc;
        strm->opaque = (voidpf)0;
#endif
    }
    if (strm->zfree == (free_func)0)
#ifdef Z_SOLO
        return Z_STREAM_ERROR;
#else
    strm->zfree = zcfree;
#endif
    state = (struct inflate_state FAR *)ZALLOC(strm, 1,
                                               sizeof(struct inflate_state));
    if (state == Z_NULL) return Z_MEM_ERROR;
    Tracev((stderr, "inflate: allocated\n"));
    strm->state = (struct internal_state FAR *)state;
    state->dmax = 32768U;
    state->wbits = (uInt)windowBits;
    state->wsize = 1U << windowBits;
    state->window = window;
    state->wnext = 0;
    state->whave = 0;
    return Z_OK;
}

/*
   Return state with length and distance decoding tables and index sizes set to
   fixed code decoding.  Normally this returns fixed tables from inffixed.h.
   If BUILDFIXED is defined, then instead this routine builds the tables the
   first time it's called, and returns those tables the first time and
   thereafter.  This reduces the size of the code by about 2K bytes, in
   exchange for a little execution time.  However, BUILDFIXED should not be
   used for threaded applications, since the rewriting of the tables and virgin
   may not be thread-safe.
 */
local void fixedtables(state)
struct inflate_state FAR *state;
{
#ifdef BUILDFIXED
    static int virgin = 1;
    static code *lenfix, *distfix;
    static code fixed[544];

    /* build fixed huffman tables if first call (may not be thread safe) */
    if (virgin) {
        unsigned sym, bits;
        static code *next;

        /* literal/length table */
        sym = 0;
        while (sym < 144) state->lens[sym++] = 8;
        while (sym < 256) state->lens[sym++] = 9;
        while (sym < 280) state->lens[sym++] = 7;
        while (sym < 288) state->lens[sym++] = 8;
        next = fixed;
        lenfix = next;
        bits = 9;
        inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work);

        /* distance table */
        sym = 0;
        while (sym < 32) state->lens[sym++] = 5;
        distfix = next;
        bits = 5;
        inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work);

        /* do this just once */
        virgin = 0;
    }
#else /* !BUILDFIXED */
#   include "inffixed.h"
#endif /* BUILDFIXED */
    state->lencode = lenfix;
    state->lenbits = 9;
    state->distcode = distfix;
    state->distbits = 5;
}

/* Macros for inflateBack(): */

/* Load returned state from inflate_fast() */
#define LOAD() \
    do { \
        put = strm->next_out; \
        left = strm->avail_out; \
        next = strm->next_in; \
        have = strm->avail_in; \
        hold = state->hold; \
        bits = state->bits; \
    } while (0)

/* Set state from registers for inflate_fast() */
#define RESTORE() \
    do { \
        strm->next_out = put; \
        strm->avail_out = left; \
        strm->next_in = next; \
        strm->avail_in = have; \
        state->hold = hold; \
        state->bits = bits; \
    } while (0)

/* Clear the input bit accumulator */
#define INITBITS() \
    do { \
        hold = 0; \
        bits = 0; \
    } while (0)

/* Assure that some input is available.  If input is requested, but denied,
   then return a Z_BUF_ERROR from inflateBack(). */
#define PULL() \
    do { \
        if (have == 0) { \
            have = in(in_desc, &next); \
            if (have == 0) { \
                next = Z_NULL; \
                ret = Z_BUF_ERROR; \
                goto inf_leave; \
            } \
        } \
    } while (0)

/* Get a byte of input into the bit accumulator, or return from inflateBack()
   with an error if there is no input available. */
#define PULLBYTE() \
    do { \
        PULL(); \
        have--; \
        hold += (unsigned long)(*next++) << bits; \
        bits += 8; \
    } while (0)

/* Assure that there are at least n bits in the bit accumulator.  If there is
   not enough available input to do that, then return from inflateBack() with
   an error. */
#define NEEDBITS(n) \
    do { \
        while (bits < (unsigned)(n)) \
            PULLBYTE(); \
    } while (0)

/* Return the low n bits of the bit accumulator (n < 16) */
#define BITS(n) \
    ((unsigned)hold & ((1U << (n)) - 1))

/* Remove n bits from the bit accumulator */
#define DROPBITS(n) \
    do { \
        hold >>= (n); \
        bits -= (unsigned)(n); \
    } while (0)

/* Remove zero to seven bits as needed to go to a byte boundary */
#define BYTEBITS() \
    do { \
        hold >>= bits & 7; \
        bits -= bits & 7; \
    } while (0)

/* Assure that some output space is available, by writing out the window
   if it's full.  If the write fails, return from inflateBack() with a
   Z_BUF_ERROR. */
#define ROOM() \
    do { \
        if (left == 0) { \
            put = state->window; \
            left = state->wsize; \
            state->whave = left; \
            if (out(out_desc, put, left)) { \
                ret = Z_BUF_ERROR; \
                goto inf_leave; \
            } \
        } \
    } while (0)

/*
   strm provides the memory allocation functions and window buffer on input,
   and provides information on the unused input on return.  For Z_DATA_ERROR
   returns, strm will also provide an error message.

   in() and out() are the call-back input and output functions.  When
   inflateBack() needs more input, it calls in().  When inflateBack() has
   filled the window with output, or when it completes with data in the
   window, it calls out() to write out the data.  The application must not
   change the provided input until in() is called again or inflateBack()
   returns.  The application must not change the window/output buffer until
   inflateBack() returns.

   in() and out() are called with a descriptor parameter provided in the
   inflateBack() call.  This parameter can be a structure that provides the
   information required to do the read or write, as well as accumulated
   information on the input and output such as totals and check values.

   in() should return zero on failure.  out() should return non-zero on
   failure.  If either in() or out() fails, than inflateBack() returns a
   Z_BUF_ERROR.  strm->next_in can be checked for Z_NULL to see whether it
   was in() or out() that caused in the error.  Otherwise,  inflateBack()
   returns Z_STREAM_END on success, Z_DATA_ERROR for an deflate format
   error, or Z_MEM_ERROR if it could not allocate memory for the state.
   inflateBack() can also return Z_STREAM_ERROR if the input parameters
   are not correct, i.e. strm is Z_NULL or the state was not initialized.
 */
int ZEXPORT inflateBack(strm, in, in_desc, out, out_desc)
z_streamp strm;
in_func in;
void FAR *in_desc;
out_func out;
void FAR *out_desc;
{
    struct inflate_state FAR *state;
    z_const unsigned char FAR *next;    /* next input */
    unsigned char FAR *put;     /* next output */
    unsigned have, left;        /* available input and output */
    unsigned long hold;         /* bit buffer */
    unsigned bits;              /* bits in bit buffer */
    unsigned copy;              /* number of stored or match bytes to copy */
    unsigned char FAR *from;    /* where to copy match bytes from */
    code here;                  /* current decoding table entry */
    code last;                  /* parent table entry */
    unsigned len;               /* length to copy for repeats, bits to drop */
    int ret;                    /* return code */
    static const unsigned short order[19] = /* permutation of code lengths */
        {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};

    /* Check that the strm exists and that the state was initialized */
    if (strm == Z_NULL || strm->state == Z_NULL)
        return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;

    /* Reset the state */
    strm->msg = Z_NULL;
    state->mode = TYPE;
    state->last = 0;
    state->whave = 0;
    next = strm->next_in;
    have = next != Z_NULL ? strm->avail_in : 0;
    hold = 0;
    bits = 0;
    put = state->window;
    left = state->wsize;

    /* Inflate until end of block marked as last */
    for (;;)
        switch (state->mode) {
        case TYPE:
            /* determine and dispatch block type */
            if (state->last) {
                BYTEBITS();
                state->mode = DONE;
                break;
            }
            NEEDBITS(3);
            state->last = BITS(1);
            DROPBITS(1);
            switch (BITS(2)) {
            case 0:                             /* stored block */
                Tracev((stderr, "inflate:     stored block%s\n",
                        state->last ? " (last)" : ""));
                state->mode = STORED;
                break;
            case 1:                             /* fixed block */
                fixedtables(state);
                Tracev((stderr, "inflate:     fixed codes block%s\n",
                        state->last ? " (last)" : ""));
                state->mode = LEN;              /* decode codes */
                break;
            case 2:                             /* dynamic block */
                Tracev((stderr, "inflate:     dynamic codes block%s\n",
                        state->last ? " (last)" : ""));
                state->mode = TABLE;
                break;
            case 3:
                strm->msg = (char *)"invalid block type";
                state->mode = BAD;
            }
            DROPBITS(2);
            break;

        case STORED:
            /* get and verify stored block length */
            BYTEBITS();                         /* go to byte boundary */
            NEEDBITS(32);
            if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) {
                strm->msg = (char *)"invalid stored block lengths";
                state->mode = BAD;
                break;
            }
            state->length = (unsigned)hold & 0xffff;
            Tracev((stderr, "inflate:       stored length %u\n",
                    state->length));
            INITBITS();

            /* copy stored block from input to output */
            while (state->length != 0) {
                copy = state->length;
                PULL();
                ROOM();
                if (copy > have) copy = have;
                if (copy > left) copy = left;
                zmemcpy(put, next, copy);
                have -= copy;
                next += copy;
                left -= copy;
                put += copy;
                state->length -= copy;
            }
            Tracev((stderr, "inflate:       stored end\n"));
            state->mode = TYPE;
            break;

        case TABLE:
            /* get dynamic table entries descriptor */
            NEEDBITS(14);
            state->nlen = BITS(5) + 257;
            DROPBITS(5);
            state->ndist = BITS(5) + 1;
            DROPBITS(5);
            state->ncode = BITS(4) + 4;
            DROPBITS(4);
#ifndef PKZIP_BUG_WORKAROUND
            if (state->nlen > 286 || state->ndist > 30) {
                strm->msg = (char *)"too many length or distance symbols";
                state->mode = BAD;
                break;
            }
#endif
            Tracev((stderr, "inflate:       table sizes ok\n"));

            /* get code length code lengths (not a typo) */
            state->have = 0;
            while (state->have < state->ncode) {
                NEEDBITS(3);
                state->lens[order[state->have++]] = (unsigned short)BITS(3);
                DROPBITS(3);
            }
            while (state->have < 19)
                state->lens[order[state->have++]] = 0;
            state->next = state->codes;
            state->lencode = (code const FAR *)(state->next);
            state->lenbits = 7;
            ret = inflate_table(CODES, state->lens, 19, &(state->next),
                                &(state->lenbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid code lengths set";
                state->mode = BAD;
                break;
            }
            Tracev((stderr, "inflate:       code lengths ok\n"));

            /* get length and distance code code lengths */
            state->have = 0;
            while (state->have < state->nlen + state->ndist) {
                for (;;) {
                    here = state->lencode[BITS(state->lenbits)];
                    if ((unsigned)(here.bits) <= bits) break;
                    PULLBYTE();
                }
                if (here.val < 16) {
                    DROPBITS(here.bits);
                    state->lens[state->have++] = here.val;
                }
                else {
                    if (here.val == 16) {
                        NEEDBITS(here.bits + 2);
                        DROPBITS(here.bits);
                        if (state->have == 0) {
                            strm->msg = (char *)"invalid bit length repeat";
                            state->mode = BAD;
                            break;
                        }
                        len = (unsigned)(state->lens[state->have - 1]);
                        copy = 3 + BITS(2);
                        DROPBITS(2);
                    }
                    else if (here.val == 17) {
                        NEEDBITS(here.bits + 3);
                        DROPBITS(here.bits);
                        len = 0;
                        copy = 3 + BITS(3);
                        DROPBITS(3);
                    }
                    else {
                        NEEDBITS(here.bits + 7);
                        DROPBITS(here.bits);
                        len = 0;
                        copy = 11 + BITS(7);
                        DROPBITS(7);
                    }
                    if (state->have + copy > state->nlen + state->ndist) {
                        strm->msg = (char *)"invalid bit length repeat";
                        state->mode = BAD;
                        break;
                    }
                    while (copy--)
                        state->lens[state->have++] = (unsigned short)len;
                }
            }

            /* handle error breaks in while */
            if (state->mode == BAD) break;

            /* check for end-of-block code (better have one) */
            if (state->lens[256] == 0) {
                strm->msg = (char *)"invalid code -- missing end-of-block";
                state->mode = BAD;
                break;
            }

            /* build code tables -- note: do not change the lenbits or distbits
               values here (9 and 6) without reading the comments in inftrees.h
               concerning the ENOUGH constants, which depend on those values */
            state->next = state->codes;
            state->lencode = (code const FAR *)(state->next);
            state->lenbits = 9;
            ret = inflate_table(LENS, state->lens, state->nlen, &(state->next),
                                &(state->lenbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid literal/lengths set";
                state->mode = BAD;
                break;
            }
            state->distcode = (code const FAR *)(state->next);
            state->distbits = 6;
            ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist,
                            &(state->next), &(state->distbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid distances set";
                state->mode = BAD;
                break;
            }
            Tracev((stderr, "inflate:       codes ok\n"));
            state->mode = LEN;

        case LEN:
            /* use inflate_fast() if we have enough input and output */
            if (have >= 6 && left >= 258) {
                RESTORE();
                if (state->whave < state->wsize)
                    state->whave = state->wsize - left;
                inflate_fast(strm, state->wsize);
                LOAD();
                break;
            }

            /* get a literal, length, or end-of-block code */
            for (;;) {
                here = state->lencode[BITS(state->lenbits)];
                if ((unsigned)(here.bits) <= bits) break;
                PULLBYTE();
            }
            if (here.op && (here.op & 0xf0) == 0) {
                last = here;
                for (;;) {
                    here = state->lencode[last.val +
                            (BITS(last.bits + last.op) >> last.bits)];
                    if ((unsigned)(last.bits + here.bits) <= bits) break;
                    PULLBYTE();
                }
                DROPBITS(last.bits);
            }
            DROPBITS(here.bits);
            state->length = (unsigned)here.val;

            /* process literal */
            if (here.op == 0) {
                Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
                        "inflate:         literal '%c'\n" :
                        "inflate:         literal 0x%02x\n", here.val));
                ROOM();
                *put++ = (unsigned char)(state->length);
                left--;
                state->mode = LEN;
                break;
            }

            /* process end of block */
            if (here.op & 32) {
                Tracevv((stderr, "inflate:         end of block\n"));
                state->mode = TYPE;
                break;
            }

            /* invalid code */
            if (here.op & 64) {
                strm->msg = (char *)"invalid literal/length code";
                state->mode = BAD;
                break;
            }

            /* length code -- get extra bits, if any */
            state->extra = (unsigned)(here.op) & 15;
            if (state->extra != 0) {
                NEEDBITS(state->extra);
                state->length += BITS(state->extra);
                DROPBITS(state->extra);
            }
            Tracevv((stderr, "inflate:         length %u\n", state->length));

            /* get distance code */
            for (;;) {
                here = state->distcode[BITS(state->distbits)];
                if ((unsigned)(here.bits) <= bits) break;
                PULLBYTE();
            }
            if ((here.op & 0xf0) == 0) {
                last = here;
                for (;;) {
                    here = state->distcode[last.val +
                            (BITS(last.bits + last.op) >> last.bits)];
                    if ((unsigned)(last.bits + here.bits) <= bits) break;
                    PULLBYTE();
                }
                DROPBITS(last.bits);
            }
            DROPBITS(here.bits);
            if (here.op & 64) {
                strm->msg = (char *)"invalid distance code";
                state->mode = BAD;
                break;
            }
            state->offset = (unsigned)here.val;

            /* get distance extra bits, if any */
            state->extra = (unsigned)(here.op) & 15;
            if (state->extra != 0) {
                NEEDBITS(state->extra);
                state->offset += BITS(state->extra);
                DROPBITS(state->extra);
            }
            if (state->offset > state->wsize - (state->whave < state->wsize ?
                                                left : 0)) {
                strm->msg = (char *)"invalid distance too far back";
                state->mode = BAD;
                break;
            }
            Tracevv((stderr, "inflate:         distance %u\n", state->offset));

            /* copy match from window to output */
            do {
                ROOM();
                copy = state->wsize - state->offset;
                if (copy < left) {
                    from = put + copy;
                    copy = left - copy;
                }
                else {
                    from = put - state->offset;
                    copy = left;
                }
                if (copy > state->length) copy = state->length;
                state->length -= copy;
                left -= copy;
                do {
                    *put++ = *from++;
                } while (--copy);
            } while (state->length != 0);
            break;

        case DONE:
            /* inflate stream terminated properly -- write leftover output */
            ret = Z_STREAM_END;
            if (left < state->wsize) {
                if (out(out_desc, state->window, state->wsize - left))
                    ret = Z_BUF_ERROR;
            }
            goto inf_leave;

        case BAD:
            ret = Z_DATA_ERROR;
            goto inf_leave;

        default:                /* can't happen, but makes compilers happy */
            ret = Z_STREAM_ERROR;
            goto inf_leave;
        }

    /* Return unused input */
  inf_leave:
    strm->next_in = next;
    strm->avail_in = have;
    return ret;
}

int ZEXPORT inflateBackEnd(strm)
z_streamp strm;
{
    if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0)
        return Z_STREAM_ERROR;
    ZFREE(strm, strm->state);
    strm->state = Z_NULL;
    Tracev((stderr, "inflate: end\n"));
    return Z_OK;
}

Deleted compat/zlib/inffast.c.

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



































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inffast.c -- fast decoding
 * Copyright (C) 1995-2017 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "zutil.h"
#include "inftrees.h"
#include "inflate.h"
#include "inffast.h"

#ifdef ASMINF
#  pragma message("Assembler code may have bugs -- use at your own risk")
#else

/*
   Decode literal, length, and distance codes and write out the resulting
   literal and match bytes until either not enough input or output is
   available, an end-of-block is encountered, or a data error is encountered.
   When large enough input and output buffers are supplied to inflate(), for
   example, a 16K input buffer and a 64K output buffer, more than 95% of the
   inflate execution time is spent in this routine.

   Entry assumptions:

        state->mode == LEN
        strm->avail_in >= 6
        strm->avail_out >= 258
        start >= strm->avail_out
        state->bits < 8

   On return, state->mode is one of:

        LEN -- ran out of enough output space or enough available input
        TYPE -- reached end of block code, inflate() to interpret next block
        BAD -- error in block data

   Notes:

    - The maximum input bits used by a length/distance pair is 15 bits for the
      length code, 5 bits for the length extra, 15 bits for the distance code,
      and 13 bits for the distance extra.  This totals 48 bits, or six bytes.
      Therefore if strm->avail_in >= 6, then there is enough input to avoid
      checking for available input while decoding.

    - The maximum bytes that a single length/distance pair can output is 258
      bytes, which is the maximum length that can be coded.  inflate_fast()
      requires strm->avail_out >= 258 for each loop to avoid checking for
      output space.
 */
void ZLIB_INTERNAL inflate_fast(strm, start)
z_streamp strm;
unsigned start;         /* inflate()'s starting value for strm->avail_out */
{
    struct inflate_state FAR *state;
    z_const unsigned char FAR *in;      /* local strm->next_in */
    z_const unsigned char FAR *last;    /* have enough input while in < last */
    unsigned char FAR *out;     /* local strm->next_out */
    unsigned char FAR *beg;     /* inflate()'s initial strm->next_out */
    unsigned char FAR *end;     /* while out < end, enough space available */
#ifdef INFLATE_STRICT
    unsigned dmax;              /* maximum distance from zlib header */
#endif
    unsigned wsize;             /* window size or zero if not using window */
    unsigned whave;             /* valid bytes in the window */
    unsigned wnext;             /* window write index */
    unsigned char FAR *window;  /* allocated sliding window, if wsize != 0 */
    unsigned long hold;         /* local strm->hold */
    unsigned bits;              /* local strm->bits */
    code const FAR *lcode;      /* local strm->lencode */
    code const FAR *dcode;      /* local strm->distcode */
    unsigned lmask;             /* mask for first level of length codes */
    unsigned dmask;             /* mask for first level of distance codes */
    code here;                  /* retrieved table entry */
    unsigned op;                /* code bits, operation, extra bits, or */
                                /*  window position, window bytes to copy */
    unsigned len;               /* match length, unused bytes */
    unsigned dist;              /* match distance */
    unsigned char FAR *from;    /* where to copy match from */

    /* copy state to local variables */
    state = (struct inflate_state FAR *)strm->state;
    in = strm->next_in;
    last = in + (strm->avail_in - 5);
    out = strm->next_out;
    beg = out - (start - strm->avail_out);
    end = out + (strm->avail_out - 257);
#ifdef INFLATE_STRICT
    dmax = state->dmax;
#endif
    wsize = state->wsize;
    whave = state->whave;
    wnext = state->wnext;
    window = state->window;
    hold = state->hold;
    bits = state->bits;
    lcode = state->lencode;
    dcode = state->distcode;
    lmask = (1U << state->lenbits) - 1;
    dmask = (1U << state->distbits) - 1;

    /* decode literals and length/distances until end-of-block or not enough
       input data or output space */
    do {
        if (bits < 15) {
            hold += (unsigned long)(*in++) << bits;
            bits += 8;
            hold += (unsigned long)(*in++) << bits;
            bits += 8;
        }
        here = lcode[hold & lmask];
      dolen:
        op = (unsigned)(here.bits);
        hold >>= op;
        bits -= op;
        op = (unsigned)(here.op);
        if (op == 0) {                          /* literal */
            Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
                    "inflate:         literal '%c'\n" :
                    "inflate:         literal 0x%02x\n", here.val));
            *out++ = (unsigned char)(here.val);
        }
        else if (op & 16) {                     /* length base */
            len = (unsigned)(here.val);
            op &= 15;                           /* number of extra bits */
            if (op) {
                if (bits < op) {
                    hold += (unsigned long)(*in++) << bits;
                    bits += 8;
                }
                len += (unsigned)hold & ((1U << op) - 1);
                hold >>= op;
                bits -= op;
            }
            Tracevv((stderr, "inflate:         length %u\n", len));
            if (bits < 15) {
                hold += (unsigned long)(*in++) << bits;
                bits += 8;
                hold += (unsigned long)(*in++) << bits;
                bits += 8;
            }
            here = dcode[hold & dmask];
          dodist:
            op = (unsigned)(here.bits);
            hold >>= op;
            bits -= op;
            op = (unsigned)(here.op);
            if (op & 16) {                      /* distance base */
                dist = (unsigned)(here.val);
                op &= 15;                       /* number of extra bits */
                if (bits < op) {
                    hold += (unsigned long)(*in++) << bits;
                    bits += 8;
                    if (bits < op) {
                        hold += (unsigned long)(*in++) << bits;
                        bits += 8;
                    }
                }
                dist += (unsigned)hold & ((1U << op) - 1);
#ifdef INFLATE_STRICT
                if (dist > dmax) {
                    strm->msg = (char *)"invalid distance too far back";
                    state->mode = BAD;
                    break;
                }
#endif
                hold >>= op;
                bits -= op;
                Tracevv((stderr, "inflate:         distance %u\n", dist));
                op = (unsigned)(out - beg);     /* max distance in output */
                if (dist > op) {                /* see if copy from window */
                    op = dist - op;             /* distance back in window */
                    if (op > whave) {
                        if (state->sane) {
                            strm->msg =
                                (char *)"invalid distance too far back";
                            state->mode = BAD;
                            break;
                        }
#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
                        if (len <= op - whave) {
                            do {
                                *out++ = 0;
                            } while (--len);
                            continue;
                        }
                        len -= op - whave;
                        do {
                            *out++ = 0;
                        } while (--op > whave);
                        if (op == 0) {
                            from = out - dist;
                            do {
                                *out++ = *from++;
                            } while (--len);
                            continue;
                        }
#endif
                    }
                    from = window;
                    if (wnext == 0) {           /* very common case */
                        from += wsize - op;
                        if (op < len) {         /* some from window */
                            len -= op;
                            do {
                                *out++ = *from++;
                            } while (--op);
                            from = out - dist;  /* rest from output */
                        }
                    }
                    else if (wnext < op) {      /* wrap around window */
                        from += wsize + wnext - op;
                        op -= wnext;
                        if (op < len) {         /* some from end of window */
                            len -= op;
                            do {
                                *out++ = *from++;
                            } while (--op);
                            from = window;
                            if (wnext < len) {  /* some from start of window */
                                op = wnext;
                                len -= op;
                                do {
                                    *out++ = *from++;
                                } while (--op);
                                from = out - dist;      /* rest from output */
                            }
                        }
                    }
                    else {                      /* contiguous in window */
                        from += wnext - op;
                        if (op < len) {         /* some from window */
                            len -= op;
                            do {
                                *out++ = *from++;
                            } while (--op);
                            from = out - dist;  /* rest from output */
                        }
                    }
                    while (len > 2) {
                        *out++ = *from++;
                        *out++ = *from++;
                        *out++ = *from++;
                        len -= 3;
                    }
                    if (len) {
                        *out++ = *from++;
                        if (len > 1)
                            *out++ = *from++;
                    }
                }
                else {
                    from = out - dist;          /* copy direct from output */
                    do {                        /* minimum length is three */
                        *out++ = *from++;
                        *out++ = *from++;
                        *out++ = *from++;
                        len -= 3;
                    } while (len > 2);
                    if (len) {
                        *out++ = *from++;
                        if (len > 1)
                            *out++ = *from++;
                    }
                }
            }
            else if ((op & 64) == 0) {          /* 2nd level distance code */
                here = dcode[here.val + (hold & ((1U << op) - 1))];
                goto dodist;
            }
            else {
                strm->msg = (char *)"invalid distance code";
                state->mode = BAD;
                break;
            }
        }
        else if ((op & 64) == 0) {              /* 2nd level length code */
            here = lcode[here.val + (hold & ((1U << op) - 1))];
            goto dolen;
        }
        else if (op & 32) {                     /* end-of-block */
            Tracevv((stderr, "inflate:         end of block\n"));
            state->mode = TYPE;
            break;
        }
        else {
            strm->msg = (char *)"invalid literal/length code";
            state->mode = BAD;
            break;
        }
    } while (in < last && out < end);

    /* return unused bytes (on entry, bits < 8, so in won't go too far back) */
    len = bits >> 3;
    in -= len;
    bits -= len << 3;
    hold &= (1U << bits) - 1;

    /* update state and return */
    strm->next_in = in;
    strm->next_out = out;
    strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last));
    strm->avail_out = (unsigned)(out < end ?
                                 257 + (end - out) : 257 - (out - end));
    state->hold = hold;
    state->bits = bits;
    return;
}

/*
   inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe):
   - Using bit fields for code structure
   - Different op definition to avoid & for extra bits (do & for table bits)
   - Three separate decoding do-loops for direct, window, and wnext == 0
   - Special case for distance > 1 copies to do overlapped load and store copy
   - Explicit branch predictions (based on measured branch probabilities)
   - Deferring match copy and interspersed it with decoding subsequent codes
   - Swapping literal/length else
   - Swapping window/direct else
   - Larger unrolled copy loops (three is about right)
   - Moving len -= 3 statement into middle of loop
 */

#endif /* !ASMINF */

Deleted compat/zlib/inffast.h.

1
2
3
4
5
6
7
8
9
10
11











-
-
-
-
-
-
-
-
-
-
-
/* inffast.h -- header to use inffast.c
 * Copyright (C) 1995-2003, 2010 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* WARNING: this file should *not* be used by applications. It is
   part of the implementation of the compression library and is
   subject to change. Applications should only use zlib.h.
 */

void ZLIB_INTERNAL inflate_fast OF((z_streamp strm, unsigned start));

Deleted compat/zlib/inffixed.h.

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






























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
    /* inffixed.h -- table for decoding fixed codes
     * Generated automatically by makefixed().
     */

    /* WARNING: this file should *not* be used by applications.
       It is part of the implementation of this library and is
       subject to change. Applications should only use zlib.h.
     */

    static const code lenfix[512] = {
        {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48},
        {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128},
        {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59},
        {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176},
        {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20},
        {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100},
        {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8},
        {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216},
        {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76},
        {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114},
        {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2},
        {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148},
        {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42},
        {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86},
        {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15},
        {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236},
        {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62},
        {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142},
        {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31},
        {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162},
        {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25},
        {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105},
        {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4},
        {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202},
        {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69},
        {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125},
        {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13},
        {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195},
        {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35},
        {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91},
        {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19},
        {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246},
        {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55},
        {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135},
        {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99},
        {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190},
        {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16},
        {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96},
        {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6},
        {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209},
        {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72},
        {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116},
        {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4},
        {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153},
        {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44},
        {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82},
        {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11},
        {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229},
        {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58},
        {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138},
        {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51},
        {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173},
        {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30},
        {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110},
        {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0},
        {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195},
        {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65},
        {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121},
        {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9},
        {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258},
        {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37},
        {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93},
        {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23},
        {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251},
        {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51},
        {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131},
        {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67},
        {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183},
        {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23},
        {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103},
        {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9},
        {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223},
        {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79},
        {0,9,255}
    };

    static const code distfix[32] = {
        {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025},
        {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193},
        {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385},
        {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577},
        {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073},
        {22,5,193},{64,5,0}
    };

Deleted compat/zlib/inflate.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inflate.c -- zlib decompression
 * Copyright (C) 1995-2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/*
 * Change history:
 *
 * 1.2.beta0    24 Nov 2002
 * - First version -- complete rewrite of inflate to simplify code, avoid
 *   creation of window when not needed, minimize use of window when it is
 *   needed, make inffast.c even faster, implement gzip decoding, and to
 *   improve code readability and style over the previous zlib inflate code
 *
 * 1.2.beta1    25 Nov 2002
 * - Use pointers for available input and output checking in inffast.c
 * - Remove input and output counters in inffast.c
 * - Change inffast.c entry and loop from avail_in >= 7 to >= 6
 * - Remove unnecessary second byte pull from length extra in inffast.c
 * - Unroll direct copy to three copies per loop in inffast.c
 *
 * 1.2.beta2    4 Dec 2002
 * - Change external routine names to reduce potential conflicts
 * - Correct filename to inffixed.h for fixed tables in inflate.c
 * - Make hbuf[] unsigned char to match parameter type in inflate.c
 * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset)
 *   to avoid negation problem on Alphas (64 bit) in inflate.c
 *
 * 1.2.beta3    22 Dec 2002
 * - Add comments on state->bits assertion in inffast.c
 * - Add comments on op field in inftrees.h
 * - Fix bug in reuse of allocated window after inflateReset()
 * - Remove bit fields--back to byte structure for speed
 * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths
 * - Change post-increments to pre-increments in inflate_fast(), PPC biased?
 * - Add compile time option, POSTINC, to use post-increments instead (Intel?)
 * - Make MATCH copy in inflate() much faster for when inflate_fast() not used
 * - Use local copies of stream next and avail values, as well as local bit
 *   buffer and bit count in inflate()--for speed when inflate_fast() not used
 *
 * 1.2.beta4    1 Jan 2003
 * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings
 * - Move a comment on output buffer sizes from inffast.c to inflate.c
 * - Add comments in inffast.c to introduce the inflate_fast() routine
 * - Rearrange window copies in inflate_fast() for speed and simplification
 * - Unroll last copy for window match in inflate_fast()
 * - Use local copies of window variables in inflate_fast() for speed
 * - Pull out common wnext == 0 case for speed in inflate_fast()
 * - Make op and len in inflate_fast() unsigned for consistency
 * - Add FAR to lcode and dcode declarations in inflate_fast()
 * - Simplified bad distance check in inflate_fast()
 * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new
 *   source file infback.c to provide a call-back interface to inflate for
 *   programs like gzip and unzip -- uses window as output buffer to avoid
 *   window copying
 *
 * 1.2.beta5    1 Jan 2003
 * - Improved inflateBack() interface to allow the caller to provide initial
 *   input in strm.
 * - Fixed stored blocks bug in inflateBack()
 *
 * 1.2.beta6    4 Jan 2003
 * - Added comments in inffast.c on effectiveness of POSTINC
 * - Typecasting all around to reduce compiler warnings
 * - Changed loops from while (1) or do {} while (1) to for (;;), again to
 *   make compilers happy
 * - Changed type of window in inflateBackInit() to unsigned char *
 *
 * 1.2.beta7    27 Jan 2003
 * - Changed many types to unsigned or unsigned short to avoid warnings
 * - Added inflateCopy() function
 *
 * 1.2.0        9 Mar 2003
 * - Changed inflateBack() interface to provide separate opaque descriptors
 *   for the in() and out() functions
 * - Changed inflateBack() argument and in_func typedef to swap the length
 *   and buffer address return values for the input function
 * - Check next_in and next_out for Z_NULL on entry to inflate()
 *
 * The history for versions after 1.2.0 are in ChangeLog in zlib distribution.
 */

#include "zutil.h"
#include "inftrees.h"
#include "inflate.h"
#include "inffast.h"

#ifdef MAKEFIXED
#  ifndef BUILDFIXED
#    define BUILDFIXED
#  endif
#endif

/* function prototypes */
local int inflateStateCheck OF((z_streamp strm));
local void fixedtables OF((struct inflate_state FAR *state));
local int updatewindow OF((z_streamp strm, const unsigned char FAR *end,
                           unsigned copy));
#ifdef BUILDFIXED
   void makefixed OF((void));
#endif
local unsigned syncsearch OF((unsigned FAR *have, const unsigned char FAR *buf,
                              unsigned len));

local int inflateStateCheck(strm)
z_streamp strm;
{
    struct inflate_state FAR *state;
    if (strm == Z_NULL ||
        strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0)
        return 1;
    state = (struct inflate_state FAR *)strm->state;
    if (state == Z_NULL || state->strm != strm ||
        state->mode < HEAD || state->mode > SYNC)
        return 1;
    return 0;
}

int ZEXPORT inflateResetKeep(strm)
z_streamp strm;
{
    struct inflate_state FAR *state;

    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    strm->total_in = strm->total_out = state->total = 0;
    strm->msg = Z_NULL;
    if (state->wrap)        /* to support ill-conceived Java test suite */
        strm->adler = state->wrap & 1;
    state->mode = HEAD;
    state->last = 0;
    state->havedict = 0;
    state->dmax = 32768U;
    state->head = Z_NULL;
    state->hold = 0;
    state->bits = 0;
    state->lencode = state->distcode = state->next = state->codes;
    state->sane = 1;
    state->back = -1;
    Tracev((stderr, "inflate: reset\n"));
    return Z_OK;
}

int ZEXPORT inflateReset(strm)
z_streamp strm;
{
    struct inflate_state FAR *state;

    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    state->wsize = 0;
    state->whave = 0;
    state->wnext = 0;
    return inflateResetKeep(strm);
}

int ZEXPORT inflateReset2(strm, windowBits)
z_streamp strm;
int windowBits;
{
    int wrap;
    struct inflate_state FAR *state;

    /* get the state */
    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;

    /* extract wrap request from windowBits parameter */
    if (windowBits < 0) {
        wrap = 0;
        windowBits = -windowBits;
    }
    else {
        wrap = (windowBits >> 4) + 5;
#ifdef GUNZIP
        if (windowBits < 48)
            windowBits &= 15;
#endif
    }

    /* set number of window bits, free window if different */
    if (windowBits && (windowBits < 8 || windowBits > 15))
        return Z_STREAM_ERROR;
    if (state->window != Z_NULL && state->wbits != (unsigned)windowBits) {
        ZFREE(strm, state->window);
        state->window = Z_NULL;
    }

    /* update state and reset the rest of it */
    state->wrap = wrap;
    state->wbits = (unsigned)windowBits;
    return inflateReset(strm);
}

int ZEXPORT inflateInit2_(strm, windowBits, version, stream_size)
z_streamp strm;
int windowBits;
const char *version;
int stream_size;
{
    int ret;
    struct inflate_state FAR *state;

    if (version == Z_NULL || version[0] != ZLIB_VERSION[0] ||
        stream_size != (int)(sizeof(z_stream)))
        return Z_VERSION_ERROR;
    if (strm == Z_NULL) return Z_STREAM_ERROR;
    strm->msg = Z_NULL;                 /* in case we return an error */
    if (strm->zalloc == (alloc_func)0) {
#ifdef Z_SOLO
        return Z_STREAM_ERROR;
#else
        strm->zalloc = zcalloc;
        strm->opaque = (voidpf)0;
#endif
    }
    if (strm->zfree == (free_func)0)
#ifdef Z_SOLO
        return Z_STREAM_ERROR;
#else
        strm->zfree = zcfree;
#endif
    state = (struct inflate_state FAR *)
            ZALLOC(strm, 1, sizeof(struct inflate_state));
    if (state == Z_NULL) return Z_MEM_ERROR;
    Tracev((stderr, "inflate: allocated\n"));
    strm->state = (struct internal_state FAR *)state;
    state->strm = strm;
    state->window = Z_NULL;
    state->mode = HEAD;     /* to pass state test in inflateReset2() */
    ret = inflateReset2(strm, windowBits);
    if (ret != Z_OK) {
        ZFREE(strm, state);
        strm->state = Z_NULL;
    }
    return ret;
}

int ZEXPORT inflateInit_(strm, version, stream_size)
z_streamp strm;
const char *version;
int stream_size;
{
    return inflateInit2_(strm, DEF_WBITS, version, stream_size);
}

int ZEXPORT inflatePrime(strm, bits, value)
z_streamp strm;
int bits;
int value;
{
    struct inflate_state FAR *state;

    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    if (bits < 0) {
        state->hold = 0;
        state->bits = 0;
        return Z_OK;
    }
    if (bits > 16 || state->bits + (uInt)bits > 32) return Z_STREAM_ERROR;
    value &= (1L << bits) - 1;
    state->hold += (unsigned)value << state->bits;
    state->bits += (uInt)bits;
    return Z_OK;
}

/*
   Return state with length and distance decoding tables and index sizes set to
   fixed code decoding.  Normally this returns fixed tables from inffixed.h.
   If BUILDFIXED is defined, then instead this routine builds the tables the
   first time it's called, and returns those tables the first time and
   thereafter.  This reduces the size of the code by about 2K bytes, in
   exchange for a little execution time.  However, BUILDFIXED should not be
   used for threaded applications, since the rewriting of the tables and virgin
   may not be thread-safe.
 */
local void fixedtables(state)
struct inflate_state FAR *state;
{
#ifdef BUILDFIXED
    static int virgin = 1;
    static code *lenfix, *distfix;
    static code fixed[544];

    /* build fixed huffman tables if first call (may not be thread safe) */
    if (virgin) {
        unsigned sym, bits;
        static code *next;

        /* literal/length table */
        sym = 0;
        while (sym < 144) state->lens[sym++] = 8;
        while (sym < 256) state->lens[sym++] = 9;
        while (sym < 280) state->lens[sym++] = 7;
        while (sym < 288) state->lens[sym++] = 8;
        next = fixed;
        lenfix = next;
        bits = 9;
        inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work);

        /* distance table */
        sym = 0;
        while (sym < 32) state->lens[sym++] = 5;
        distfix = next;
        bits = 5;
        inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work);

        /* do this just once */
        virgin = 0;
    }
#else /* !BUILDFIXED */
#   include "inffixed.h"
#endif /* BUILDFIXED */
    state->lencode = lenfix;
    state->lenbits = 9;
    state->distcode = distfix;
    state->distbits = 5;
}

#ifdef MAKEFIXED
#include <stdio.h>

/*
   Write out the inffixed.h that is #include'd above.  Defining MAKEFIXED also
   defines BUILDFIXED, so the tables are built on the fly.  makefixed() writes
   those tables to stdout, which would be piped to inffixed.h.  A small program
   can simply call makefixed to do this:

    void makefixed(void);

    int main(void)
    {
        makefixed();
        return 0;
    }

   Then that can be linked with zlib built with MAKEFIXED defined and run:

    a.out > inffixed.h
 */
void makefixed()
{
    unsigned low, size;
    struct inflate_state state;

    fixedtables(&state);
    puts("    /* inffixed.h -- table for decoding fixed codes");
    puts("     * Generated automatically by makefixed().");
    puts("     */");
    puts("");
    puts("    /* WARNING: this file should *not* be used by applications.");
    puts("       It is part of the implementation of this library and is");
    puts("       subject to change. Applications should only use zlib.h.");
    puts("     */");
    puts("");
    size = 1U << 9;
    printf("    static const code lenfix[%u] = {", size);
    low = 0;
    for (;;) {
        if ((low % 7) == 0) printf("\n        ");
        printf("{%u,%u,%d}", (low & 127) == 99 ? 64 : state.lencode[low].op,
               state.lencode[low].bits, state.lencode[low].val);
        if (++low == size) break;
        putchar(',');
    }
    puts("\n    };");
    size = 1U << 5;
    printf("\n    static const code distfix[%u] = {", size);
    low = 0;
    for (;;) {
        if ((low % 6) == 0) printf("\n        ");
        printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits,
               state.distcode[low].val);
        if (++low == size) break;
        putchar(',');
    }
    puts("\n    };");
}
#endif /* MAKEFIXED */

/*
   Update the window with the last wsize (normally 32K) bytes written before
   returning.  If window does not exist yet, create it.  This is only called
   when a window is already in use, or when output has been written during this
   inflate call, but the end of the deflate stream has not been reached yet.
   It is also called to create a window for dictionary data when a dictionary
   is loaded.

   Providing output buffers larger than 32K to inflate() should provide a speed
   advantage, since only the last 32K of output is copied to the sliding window
   upon return from inflate(), and since all distances after the first 32K of
   output will fall in the output data, making match copies simpler and faster.
   The advantage may be dependent on the size of the processor's data caches.
 */
local int updatewindow(strm, end, copy)
z_streamp strm;
const Bytef *end;
unsigned copy;
{
    struct inflate_state FAR *state;
    unsigned dist;

    state = (struct inflate_state FAR *)strm->state;

    /* if it hasn't been done already, allocate space for the window */
    if (state->window == Z_NULL) {
        state->window = (unsigned char FAR *)
                        ZALLOC(strm, 1U << state->wbits,
                               sizeof(unsigned char));
        if (state->window == Z_NULL) return 1;
    }

    /* if window not in use yet, initialize */
    if (state->wsize == 0) {
        state->wsize = 1U << state->wbits;
        state->wnext = 0;
        state->whave = 0;
    }

    /* copy state->wsize or less output bytes into the circular window */
    if (copy >= state->wsize) {
        zmemcpy(state->window, end - state->wsize, state->wsize);
        state->wnext = 0;
        state->whave = state->wsize;
    }
    else {
        dist = state->wsize - state->wnext;
        if (dist > copy) dist = copy;
        zmemcpy(state->window + state->wnext, end - copy, dist);
        copy -= dist;
        if (copy) {
            zmemcpy(state->window, end - copy, copy);
            state->wnext = copy;
            state->whave = state->wsize;
        }
        else {
            state->wnext += dist;
            if (state->wnext == state->wsize) state->wnext = 0;
            if (state->whave < state->wsize) state->whave += dist;
        }
    }
    return 0;
}

/* Macros for inflate(): */

/* check function to use adler32() for zlib or crc32() for gzip */
#ifdef GUNZIP
#  define UPDATE(check, buf, len) \
    (state->flags ? crc32(check, buf, len) : adler32(check, buf, len))
#else
#  define UPDATE(check, buf, len) adler32(check, buf, len)
#endif

/* check macros for header crc */
#ifdef GUNZIP
#  define CRC2(check, word) \
    do { \
        hbuf[0] = (unsigned char)(word); \
        hbuf[1] = (unsigned char)((word) >> 8); \
        check = crc32(check, hbuf, 2); \
    } while (0)

#  define CRC4(check, word) \
    do { \
        hbuf[0] = (unsigned char)(word); \
        hbuf[1] = (unsigned char)((word) >> 8); \
        hbuf[2] = (unsigned char)((word) >> 16); \
        hbuf[3] = (unsigned char)((word) >> 24); \
        check = crc32(check, hbuf, 4); \
    } while (0)
#endif

/* Load registers with state in inflate() for speed */
#define LOAD() \
    do { \
        put = strm->next_out; \
        left = strm->avail_out; \
        next = strm->next_in; \
        have = strm->avail_in; \
        hold = state->hold; \
        bits = state->bits; \
    } while (0)

/* Restore state from registers in inflate() */
#define RESTORE() \
    do { \
        strm->next_out = put; \
        strm->avail_out = left; \
        strm->next_in = next; \
        strm->avail_in = have; \
        state->hold = hold; \
        state->bits = bits; \
    } while (0)

/* Clear the input bit accumulator */
#define INITBITS() \
    do { \
        hold = 0; \
        bits = 0; \
    } while (0)

/* Get a byte of input into the bit accumulator, or return from inflate()
   if there is no input available. */
#define PULLBYTE() \
    do { \
        if (have == 0) goto inf_leave; \
        have--; \
        hold += (unsigned long)(*next++) << bits; \
        bits += 8; \
    } while (0)

/* Assure that there are at least n bits in the bit accumulator.  If there is
   not enough available input to do that, then return from inflate(). */
#define NEEDBITS(n) \
    do { \
        while (bits < (unsigned)(n)) \
            PULLBYTE(); \
    } while (0)

/* Return the low n bits of the bit accumulator (n < 16) */
#define BITS(n) \
    ((unsigned)hold & ((1U << (n)) - 1))

/* Remove n bits from the bit accumulator */
#define DROPBITS(n) \
    do { \
        hold >>= (n); \
        bits -= (unsigned)(n); \
    } while (0)

/* Remove zero to seven bits as needed to go to a byte boundary */
#define BYTEBITS() \
    do { \
        hold >>= bits & 7; \
        bits -= bits & 7; \
    } while (0)

/*
   inflate() uses a state machine to process as much input data and generate as
   much output data as possible before returning.  The state machine is
   structured roughly as follows:

    for (;;) switch (state) {
    ...
    case STATEn:
        if (not enough input data or output space to make progress)
            return;
        ... make progress ...
        state = STATEm;
        break;
    ...
    }

   so when inflate() is called again, the same case is attempted again, and
   if the appropriate resources are provided, the machine proceeds to the
   next state.  The NEEDBITS() macro is usually the way the state evaluates
   whether it can proceed or should return.  NEEDBITS() does the return if
   the requested bits are not available.  The typical use of the BITS macros
   is:

        NEEDBITS(n);
        ... do something with BITS(n) ...
        DROPBITS(n);

   where NEEDBITS(n) either returns from inflate() if there isn't enough
   input left to load n bits into the accumulator, or it continues.  BITS(n)
   gives the low n bits in the accumulator.  When done, DROPBITS(n) drops
   the low n bits off the accumulator.  INITBITS() clears the accumulator
   and sets the number of available bits to zero.  BYTEBITS() discards just
   enough bits to put the accumulator on a byte boundary.  After BYTEBITS()
   and a NEEDBITS(8), then BITS(8) would return the next byte in the stream.

   NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return
   if there is no input available.  The decoding of variable length codes uses
   PULLBYTE() directly in order to pull just enough bytes to decode the next
   code, and no more.

   Some states loop until they get enough input, making sure that enough
   state information is maintained to continue the loop where it left off
   if NEEDBITS() returns in the loop.  For example, want, need, and keep
   would all have to actually be part of the saved state in case NEEDBITS()
   returns:

    case STATEw:
        while (want < need) {
            NEEDBITS(n);
            keep[want++] = BITS(n);
            DROPBITS(n);
        }
        state = STATEx;
    case STATEx:

   As shown above, if the next state is also the next case, then the break
   is omitted.

   A state may also return if there is not enough output space available to
   complete that state.  Those states are copying stored data, writing a
   literal byte, and copying a matching string.

   When returning, a "goto inf_leave" is used to update the total counters,
   update the check value, and determine whether any progress has been made
   during that inflate() call in order to return the proper return code.
   Progress is defined as a change in either strm->avail_in or strm->avail_out.
   When there is a window, goto inf_leave will update the window with the last
   output written.  If a goto inf_leave occurs in the middle of decompression
   and there is no window currently, goto inf_leave will create one and copy
   output to the window for the next call of inflate().

   In this implementation, the flush parameter of inflate() only affects the
   return code (per zlib.h).  inflate() always writes as much as possible to
   strm->next_out, given the space available and the provided input--the effect
   documented in zlib.h of Z_SYNC_FLUSH.  Furthermore, inflate() always defers
   the allocation of and copying into a sliding window until necessary, which
   provides the effect documented in zlib.h for Z_FINISH when the entire input
   stream available.  So the only thing the flush parameter actually does is:
   when flush is set to Z_FINISH, inflate() cannot return Z_OK.  Instead it
   will return Z_BUF_ERROR if it has not reached the end of the stream.
 */

int ZEXPORT inflate(strm, flush)
z_streamp strm;
int flush;
{
    struct inflate_state FAR *state;
    z_const unsigned char FAR *next;    /* next input */
    unsigned char FAR *put;     /* next output */
    unsigned have, left;        /* available input and output */
    unsigned long hold;         /* bit buffer */
    unsigned bits;              /* bits in bit buffer */
    unsigned in, out;           /* save starting available input and output */
    unsigned copy;              /* number of stored or match bytes to copy */
    unsigned char FAR *from;    /* where to copy match bytes from */
    code here;                  /* current decoding table entry */
    code last;                  /* parent table entry */
    unsigned len;               /* length to copy for repeats, bits to drop */
    int ret;                    /* return code */
#ifdef GUNZIP
    unsigned char hbuf[4];      /* buffer for gzip header crc calculation */
#endif
    static const unsigned short order[19] = /* permutation of code lengths */
        {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15};

    if (inflateStateCheck(strm) || strm->next_out == Z_NULL ||
        (strm->next_in == Z_NULL && strm->avail_in != 0))
        return Z_STREAM_ERROR;

    state = (struct inflate_state FAR *)strm->state;
    if (state->mode == TYPE) state->mode = TYPEDO;      /* skip check */
    LOAD();
    in = have;
    out = left;
    ret = Z_OK;
    for (;;)
        switch (state->mode) {
        case HEAD:
            if (state->wrap == 0) {
                state->mode = TYPEDO;
                break;
            }
            NEEDBITS(16);
#ifdef GUNZIP
            if ((state->wrap & 2) && hold == 0x8b1f) {  /* gzip header */
                if (state->wbits == 0)
                    state->wbits = 15;
                state->check = crc32(0L, Z_NULL, 0);
                CRC2(state->check, hold);
                INITBITS();
                state->mode = FLAGS;
                break;
            }
            state->flags = 0;           /* expect zlib header */
            if (state->head != Z_NULL)
                state->head->done = -1;
            if (!(state->wrap & 1) ||   /* check if zlib header allowed */
#else
            if (
#endif
                ((BITS(8) << 8) + (hold >> 8)) % 31) {
                strm->msg = (char *)"incorrect header check";
                state->mode = BAD;
                break;
            }
            if (BITS(4) != Z_DEFLATED) {
                strm->msg = (char *)"unknown compression method";
                state->mode = BAD;
                break;
            }
            DROPBITS(4);
            len = BITS(4) + 8;
            if (state->wbits == 0)
                state->wbits = len;
            if (len > 15 || len > state->wbits) {
                strm->msg = (char *)"invalid window size";
                state->mode = BAD;
                break;
            }
            state->dmax = 1U << len;
            Tracev((stderr, "inflate:   zlib header ok\n"));
            strm->adler = state->check = adler32(0L, Z_NULL, 0);
            state->mode = hold & 0x200 ? DICTID : TYPE;
            INITBITS();
            break;
#ifdef GUNZIP
        case FLAGS:
            NEEDBITS(16);
            state->flags = (int)(hold);
            if ((state->flags & 0xff) != Z_DEFLATED) {
                strm->msg = (char *)"unknown compression method";
                state->mode = BAD;
                break;
            }
            if (state->flags & 0xe000) {
                strm->msg = (char *)"unknown header flags set";
                state->mode = BAD;
                break;
            }
            if (state->head != Z_NULL)
                state->head->text = (int)((hold >> 8) & 1);
            if ((state->flags & 0x0200) && (state->wrap & 4))
                CRC2(state->check, hold);
            INITBITS();
            state->mode = TIME;
        case TIME:
            NEEDBITS(32);
            if (state->head != Z_NULL)
                state->head->time = hold;
            if ((state->flags & 0x0200) && (state->wrap & 4))
                CRC4(state->check, hold);
            INITBITS();
            state->mode = OS;
        case OS:
            NEEDBITS(16);
            if (state->head != Z_NULL) {
                state->head->xflags = (int)(hold & 0xff);
                state->head->os = (int)(hold >> 8);
            }
            if ((state->flags & 0x0200) && (state->wrap & 4))
                CRC2(state->check, hold);
            INITBITS();
            state->mode = EXLEN;
        case EXLEN:
            if (state->flags & 0x0400) {
                NEEDBITS(16);
                state->length = (unsigned)(hold);
                if (state->head != Z_NULL)
                    state->head->extra_len = (unsigned)hold;
                if ((state->flags & 0x0200) && (state->wrap & 4))
                    CRC2(state->check, hold);
                INITBITS();
            }
            else if (state->head != Z_NULL)
                state->head->extra = Z_NULL;
            state->mode = EXTRA;
        case EXTRA:
            if (state->flags & 0x0400) {
                copy = state->length;
                if (copy > have) copy = have;
                if (copy) {
                    if (state->head != Z_NULL &&
                        state->head->extra != Z_NULL) {
                        len = state->head->extra_len - state->length;
                        zmemcpy(state->head->extra + len, next,
                                len + copy > state->head->extra_max ?
                                state->head->extra_max - len : copy);
                    }
                    if ((state->flags & 0x0200) && (state->wrap & 4))
                        state->check = crc32(state->check, next, copy);
                    have -= copy;
                    next += copy;
                    state->length -= copy;
                }
                if (state->length) goto inf_leave;
            }
            state->length = 0;
            state->mode = NAME;
        case NAME:
            if (state->flags & 0x0800) {
                if (have == 0) goto inf_leave;
                copy = 0;
                do {
                    len = (unsigned)(next[copy++]);
                    if (state->head != Z_NULL &&
                            state->head->name != Z_NULL &&
                            state->length < state->head->name_max)
                        state->head->name[state->length++] = (Bytef)len;
                } while (len && copy < have);
                if ((state->flags & 0x0200) && (state->wrap & 4))
                    state->check = crc32(state->check, next, copy);
                have -= copy;
                next += copy;
                if (len) goto inf_leave;
            }
            else if (state->head != Z_NULL)
                state->head->name = Z_NULL;
            state->length = 0;
            state->mode = COMMENT;
        case COMMENT:
            if (state->flags & 0x1000) {
                if (have == 0) goto inf_leave;
                copy = 0;
                do {
                    len = (unsigned)(next[copy++]);
                    if (state->head != Z_NULL &&
                            state->head->comment != Z_NULL &&
                            state->length < state->head->comm_max)
                        state->head->comment[state->length++] = (Bytef)len;
                } while (len && copy < have);
                if ((state->flags & 0x0200) && (state->wrap & 4))
                    state->check = crc32(state->check, next, copy);
                have -= copy;
                next += copy;
                if (len) goto inf_leave;
            }
            else if (state->head != Z_NULL)
                state->head->comment = Z_NULL;
            state->mode = HCRC;
        case HCRC:
            if (state->flags & 0x0200) {
                NEEDBITS(16);
                if ((state->wrap & 4) && hold != (state->check & 0xffff)) {
                    strm->msg = (char *)"header crc mismatch";
                    state->mode = BAD;
                    break;
                }
                INITBITS();
            }
            if (state->head != Z_NULL) {
                state->head->hcrc = (int)((state->flags >> 9) & 1);
                state->head->done = 1;
            }
            strm->adler = state->check = crc32(0L, Z_NULL, 0);
            state->mode = TYPE;
            break;
#endif
        case DICTID:
            NEEDBITS(32);
            strm->adler = state->check = ZSWAP32(hold);
            INITBITS();
            state->mode = DICT;
        case DICT:
            if (state->havedict == 0) {
                RESTORE();
                return Z_NEED_DICT;
            }
            strm->adler = state->check = adler32(0L, Z_NULL, 0);
            state->mode = TYPE;
        case TYPE:
            if (flush == Z_BLOCK || flush == Z_TREES) goto inf_leave;
        case TYPEDO:
            if (state->last) {
                BYTEBITS();
                state->mode = CHECK;
                break;
            }
            NEEDBITS(3);
            state->last = BITS(1);
            DROPBITS(1);
            switch (BITS(2)) {
            case 0:                             /* stored block */
                Tracev((stderr, "inflate:     stored block%s\n",
                        state->last ? " (last)" : ""));
                state->mode = STORED;
                break;
            case 1:                             /* fixed block */
                fixedtables(state);
                Tracev((stderr, "inflate:     fixed codes block%s\n",
                        state->last ? " (last)" : ""));
                state->mode = LEN_;             /* decode codes */
                if (flush == Z_TREES) {
                    DROPBITS(2);
                    goto inf_leave;
                }
                break;
            case 2:                             /* dynamic block */
                Tracev((stderr, "inflate:     dynamic codes block%s\n",
                        state->last ? " (last)" : ""));
                state->mode = TABLE;
                break;
            case 3:
                strm->msg = (char *)"invalid block type";
                state->mode = BAD;
            }
            DROPBITS(2);
            break;
        case STORED:
            BYTEBITS();                         /* go to byte boundary */
            NEEDBITS(32);
            if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) {
                strm->msg = (char *)"invalid stored block lengths";
                state->mode = BAD;
                break;
            }
            state->length = (unsigned)hold & 0xffff;
            Tracev((stderr, "inflate:       stored length %u\n",
                    state->length));
            INITBITS();
            state->mode = COPY_;
            if (flush == Z_TREES) goto inf_leave;
        case COPY_:
            state->mode = COPY;
        case COPY:
            copy = state->length;
            if (copy) {
                if (copy > have) copy = have;
                if (copy > left) copy = left;
                if (copy == 0) goto inf_leave;
                zmemcpy(put, next, copy);
                have -= copy;
                next += copy;
                left -= copy;
                put += copy;
                state->length -= copy;
                break;
            }
            Tracev((stderr, "inflate:       stored end\n"));
            state->mode = TYPE;
            break;
        case TABLE:
            NEEDBITS(14);
            state->nlen = BITS(5) + 257;
            DROPBITS(5);
            state->ndist = BITS(5) + 1;
            DROPBITS(5);
            state->ncode = BITS(4) + 4;
            DROPBITS(4);
#ifndef PKZIP_BUG_WORKAROUND
            if (state->nlen > 286 || state->ndist > 30) {
                strm->msg = (char *)"too many length or distance symbols";
                state->mode = BAD;
                break;
            }
#endif
            Tracev((stderr, "inflate:       table sizes ok\n"));
            state->have = 0;
            state->mode = LENLENS;
        case LENLENS:
            while (state->have < state->ncode) {
                NEEDBITS(3);
                state->lens[order[state->have++]] = (unsigned short)BITS(3);
                DROPBITS(3);
            }
            while (state->have < 19)
                state->lens[order[state->have++]] = 0;
            state->next = state->codes;
            state->lencode = (const code FAR *)(state->next);
            state->lenbits = 7;
            ret = inflate_table(CODES, state->lens, 19, &(state->next),
                                &(state->lenbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid code lengths set";
                state->mode = BAD;
                break;
            }
            Tracev((stderr, "inflate:       code lengths ok\n"));
            state->have = 0;
            state->mode = CODELENS;
        case CODELENS:
            while (state->have < state->nlen + state->ndist) {
                for (;;) {
                    here = state->lencode[BITS(state->lenbits)];
                    if ((unsigned)(here.bits) <= bits) break;
                    PULLBYTE();
                }
                if (here.val < 16) {
                    DROPBITS(here.bits);
                    state->lens[state->have++] = here.val;
                }
                else {
                    if (here.val == 16) {
                        NEEDBITS(here.bits + 2);
                        DROPBITS(here.bits);
                        if (state->have == 0) {
                            strm->msg = (char *)"invalid bit length repeat";
                            state->mode = BAD;
                            break;
                        }
                        len = state->lens[state->have - 1];
                        copy = 3 + BITS(2);
                        DROPBITS(2);
                    }
                    else if (here.val == 17) {
                        NEEDBITS(here.bits + 3);
                        DROPBITS(here.bits);
                        len = 0;
                        copy = 3 + BITS(3);
                        DROPBITS(3);
                    }
                    else {
                        NEEDBITS(here.bits + 7);
                        DROPBITS(here.bits);
                        len = 0;
                        copy = 11 + BITS(7);
                        DROPBITS(7);
                    }
                    if (state->have + copy > state->nlen + state->ndist) {
                        strm->msg = (char *)"invalid bit length repeat";
                        state->mode = BAD;
                        break;
                    }
                    while (copy--)
                        state->lens[state->have++] = (unsigned short)len;
                }
            }

            /* handle error breaks in while */
            if (state->mode == BAD) break;

            /* check for end-of-block code (better have one) */
            if (state->lens[256] == 0) {
                strm->msg = (char *)"invalid code -- missing end-of-block";
                state->mode = BAD;
                break;
            }

            /* build code tables -- note: do not change the lenbits or distbits
               values here (9 and 6) without reading the comments in inftrees.h
               concerning the ENOUGH constants, which depend on those values */
            state->next = state->codes;
            state->lencode = (const code FAR *)(state->next);
            state->lenbits = 9;
            ret = inflate_table(LENS, state->lens, state->nlen, &(state->next),
                                &(state->lenbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid literal/lengths set";
                state->mode = BAD;
                break;
            }
            state->distcode = (const code FAR *)(state->next);
            state->distbits = 6;
            ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist,
                            &(state->next), &(state->distbits), state->work);
            if (ret) {
                strm->msg = (char *)"invalid distances set";
                state->mode = BAD;
                break;
            }
            Tracev((stderr, "inflate:       codes ok\n"));
            state->mode = LEN_;
            if (flush == Z_TREES) goto inf_leave;
        case LEN_:
            state->mode = LEN;
        case LEN:
            if (have >= 6 && left >= 258) {
                RESTORE();
                inflate_fast(strm, out);
                LOAD();
                if (state->mode == TYPE)
                    state->back = -1;
                break;
            }
            state->back = 0;
            for (;;) {
                here = state->lencode[BITS(state->lenbits)];
                if ((unsigned)(here.bits) <= bits) break;
                PULLBYTE();
            }
            if (here.op && (here.op & 0xf0) == 0) {
                last = here;
                for (;;) {
                    here = state->lencode[last.val +
                            (BITS(last.bits + last.op) >> last.bits)];
                    if ((unsigned)(last.bits + here.bits) <= bits) break;
                    PULLBYTE();
                }
                DROPBITS(last.bits);
                state->back += last.bits;
            }
            DROPBITS(here.bits);
            state->back += here.bits;
            state->length = (unsigned)here.val;
            if ((int)(here.op) == 0) {
                Tracevv((stderr, here.val >= 0x20 && here.val < 0x7f ?
                        "inflate:         literal '%c'\n" :
                        "inflate:         literal 0x%02x\n", here.val));
                state->mode = LIT;
                break;
            }
            if (here.op & 32) {
                Tracevv((stderr, "inflate:         end of block\n"));
                state->back = -1;
                state->mode = TYPE;
                break;
            }
            if (here.op & 64) {
                strm->msg = (char *)"invalid literal/length code";
                state->mode = BAD;
                break;
            }
            state->extra = (unsigned)(here.op) & 15;
            state->mode = LENEXT;
        case LENEXT:
            if (state->extra) {
                NEEDBITS(state->extra);
                state->length += BITS(state->extra);
                DROPBITS(state->extra);
                state->back += state->extra;
            }
            Tracevv((stderr, "inflate:         length %u\n", state->length));
            state->was = state->length;
            state->mode = DIST;
        case DIST:
            for (;;) {
                here = state->distcode[BITS(state->distbits)];
                if ((unsigned)(here.bits) <= bits) break;
                PULLBYTE();
            }
            if ((here.op & 0xf0) == 0) {
                last = here;
                for (;;) {
                    here = state->distcode[last.val +
                            (BITS(last.bits + last.op) >> last.bits)];
                    if ((unsigned)(last.bits + here.bits) <= bits) break;
                    PULLBYTE();
                }
                DROPBITS(last.bits);
                state->back += last.bits;
            }
            DROPBITS(here.bits);
            state->back += here.bits;
            if (here.op & 64) {
                strm->msg = (char *)"invalid distance code";
                state->mode = BAD;
                break;
            }
            state->offset = (unsigned)here.val;
            state->extra = (unsigned)(here.op) & 15;
            state->mode = DISTEXT;
        case DISTEXT:
            if (state->extra) {
                NEEDBITS(state->extra);
                state->offset += BITS(state->extra);
                DROPBITS(state->extra);
                state->back += state->extra;
            }
#ifdef INFLATE_STRICT
            if (state->offset > state->dmax) {
                strm->msg = (char *)"invalid distance too far back";
                state->mode = BAD;
                break;
            }
#endif
            Tracevv((stderr, "inflate:         distance %u\n", state->offset));
            state->mode = MATCH;
        case MATCH:
            if (left == 0) goto inf_leave;
            copy = out - left;
            if (state->offset > copy) {         /* copy from window */
                copy = state->offset - copy;
                if (copy > state->whave) {
                    if (state->sane) {
                        strm->msg = (char *)"invalid distance too far back";
                        state->mode = BAD;
                        break;
                    }
#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
                    Trace((stderr, "inflate.c too far\n"));
                    copy -= state->whave;
                    if (copy > state->length) copy = state->length;
                    if (copy > left) copy = left;
                    left -= copy;
                    state->length -= copy;
                    do {
                        *put++ = 0;
                    } while (--copy);
                    if (state->length == 0) state->mode = LEN;
                    break;
#endif
                }
                if (copy > state->wnext) {
                    copy -= state->wnext;
                    from = state->window + (state->wsize - copy);
                }
                else
                    from = state->window + (state->wnext - copy);
                if (copy > state->length) copy = state->length;
            }
            else {                              /* copy from output */
                from = put - state->offset;
                copy = state->length;
            }
            if (copy > left) copy = left;
            left -= copy;
            state->length -= copy;
            do {
                *put++ = *from++;
            } while (--copy);
            if (state->length == 0) state->mode = LEN;
            break;
        case LIT:
            if (left == 0) goto inf_leave;
            *put++ = (unsigned char)(state->length);
            left--;
            state->mode = LEN;
            break;
        case CHECK:
            if (state->wrap) {
                NEEDBITS(32);
                out -= left;
                strm->total_out += out;
                state->total += out;
                if ((state->wrap & 4) && out)
                    strm->adler = state->check =
                        UPDATE(state->check, put - out, out);
                out = left;
                if ((state->wrap & 4) && (
#ifdef GUNZIP
                     state->flags ? hold :
#endif
                     ZSWAP32(hold)) != state->check) {
                    strm->msg = (char *)"incorrect data check";
                    state->mode = BAD;
                    break;
                }
                INITBITS();
                Tracev((stderr, "inflate:   check matches trailer\n"));
            }
#ifdef GUNZIP
            state->mode = LENGTH;
        case LENGTH:
            if (state->wrap && state->flags) {
                NEEDBITS(32);
                if (hold != (state->total & 0xffffffffUL)) {
                    strm->msg = (char *)"incorrect length check";
                    state->mode = BAD;
                    break;
                }
                INITBITS();
                Tracev((stderr, "inflate:   length matches trailer\n"));
            }
#endif
            state->mode = DONE;
        case DONE:
            ret = Z_STREAM_END;
            goto inf_leave;
        case BAD:
            ret = Z_DATA_ERROR;
            goto inf_leave;
        case MEM:
            return Z_MEM_ERROR;
        case SYNC:
        default:
            return Z_STREAM_ERROR;
        }

    /*
       Return from inflate(), updating the total counts and the check value.
       If there was no progress during the inflate() call, return a buffer
       error.  Call updatewindow() to create and/or update the window state.
       Note: a memory error from inflate() is non-recoverable.
     */
  inf_leave:
    RESTORE();
    if (state->wsize || (out != strm->avail_out && state->mode < BAD &&
            (state->mode < CHECK || flush != Z_FINISH)))
        if (updatewindow(strm, strm->next_out, out - strm->avail_out)) {
            state->mode = MEM;
            return Z_MEM_ERROR;
        }
    in -= strm->avail_in;
    out -= strm->avail_out;
    strm->total_in += in;
    strm->total_out += out;
    state->total += out;
    if ((state->wrap & 4) && out)
        strm->adler = state->check =
            UPDATE(state->check, strm->next_out - out, out);
    strm->data_type = (int)state->bits + (state->last ? 64 : 0) +
                      (state->mode == TYPE ? 128 : 0) +
                      (state->mode == LEN_ || state->mode == COPY_ ? 256 : 0);
    if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK)
        ret = Z_BUF_ERROR;
    return ret;
}

int ZEXPORT inflateEnd(strm)
z_streamp strm;
{
    struct inflate_state FAR *state;
    if (inflateStateCheck(strm))
        return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    if (state->window != Z_NULL) ZFREE(strm, state->window);
    ZFREE(strm, strm->state);
    strm->state = Z_NULL;
    Tracev((stderr, "inflate: end\n"));
    return Z_OK;
}

int ZEXPORT inflateGetDictionary(strm, dictionary, dictLength)
z_streamp strm;
Bytef *dictionary;
uInt *dictLength;
{
    struct inflate_state FAR *state;

    /* check state */
    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;

    /* copy dictionary */
    if (state->whave && dictionary != Z_NULL) {
        zmemcpy(dictionary, state->window + state->wnext,
                state->whave - state->wnext);
        zmemcpy(dictionary + state->whave - state->wnext,
                state->window, state->wnext);
    }
    if (dictLength != Z_NULL)
        *dictLength = state->whave;
    return Z_OK;
}

int ZEXPORT inflateSetDictionary(strm, dictionary, dictLength)
z_streamp strm;
const Bytef *dictionary;
uInt dictLength;
{
    struct inflate_state FAR *state;
    unsigned long dictid;
    int ret;

    /* check state */
    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    if (state->wrap != 0 && state->mode != DICT)
        return Z_STREAM_ERROR;

    /* check for correct dictionary identifier */
    if (state->mode == DICT) {
        dictid = adler32(0L, Z_NULL, 0);
        dictid = adler32(dictid, dictionary, dictLength);
        if (dictid != state->check)
            return Z_DATA_ERROR;
    }

    /* copy dictionary to window using updatewindow(), which will amend the
       existing dictionary if appropriate */
    ret = updatewindow(strm, dictionary + dictLength, dictLength);
    if (ret) {
        state->mode = MEM;
        return Z_MEM_ERROR;
    }
    state->havedict = 1;
    Tracev((stderr, "inflate:   dictionary set\n"));
    return Z_OK;
}

int ZEXPORT inflateGetHeader(strm, head)
z_streamp strm;
gz_headerp head;
{
    struct inflate_state FAR *state;

    /* check state */
    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    if ((state->wrap & 2) == 0) return Z_STREAM_ERROR;

    /* save header structure */
    state->head = head;
    head->done = 0;
    return Z_OK;
}

/*
   Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff.  Return when found
   or when out of input.  When called, *have is the number of pattern bytes
   found in order so far, in 0..3.  On return *have is updated to the new
   state.  If on return *have equals four, then the pattern was found and the
   return value is how many bytes were read including the last byte of the
   pattern.  If *have is less than four, then the pattern has not been found
   yet and the return value is len.  In the latter case, syncsearch() can be
   called again with more data and the *have state.  *have is initialized to
   zero for the first call.
 */
local unsigned syncsearch(have, buf, len)
unsigned FAR *have;
const unsigned char FAR *buf;
unsigned len;
{
    unsigned got;
    unsigned next;

    got = *have;
    next = 0;
    while (next < len && got < 4) {
        if ((int)(buf[next]) == (got < 2 ? 0 : 0xff))
            got++;
        else if (buf[next])
            got = 0;
        else
            got = 4 - got;
        next++;
    }
    *have = got;
    return next;
}

int ZEXPORT inflateSync(strm)
z_streamp strm;
{
    unsigned len;               /* number of bytes to look at or looked at */
    unsigned long in, out;      /* temporary to save total_in and total_out */
    unsigned char buf[4];       /* to restore bit buffer to byte string */
    struct inflate_state FAR *state;

    /* check parameters */
    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR;

    /* if first time, start search in bit buffer */
    if (state->mode != SYNC) {
        state->mode = SYNC;
        state->hold <<= state->bits & 7;
        state->bits -= state->bits & 7;
        len = 0;
        while (state->bits >= 8) {
            buf[len++] = (unsigned char)(state->hold);
            state->hold >>= 8;
            state->bits -= 8;
        }
        state->have = 0;
        syncsearch(&(state->have), buf, len);
    }

    /* search available input */
    len = syncsearch(&(state->have), strm->next_in, strm->avail_in);
    strm->avail_in -= len;
    strm->next_in += len;
    strm->total_in += len;

    /* return no joy or set up to restart inflate() on a new block */
    if (state->have != 4) return Z_DATA_ERROR;
    in = strm->total_in;  out = strm->total_out;
    inflateReset(strm);
    strm->total_in = in;  strm->total_out = out;
    state->mode = TYPE;
    return Z_OK;
}

/*
   Returns true if inflate is currently at the end of a block generated by
   Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP
   implementation to provide an additional safety check. PPP uses
   Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored
   block. When decompressing, PPP checks that at the end of input packet,
   inflate is waiting for these length bytes.
 */
int ZEXPORT inflateSyncPoint(strm)
z_streamp strm;
{
    struct inflate_state FAR *state;

    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    return state->mode == STORED && state->bits == 0;
}

int ZEXPORT inflateCopy(dest, source)
z_streamp dest;
z_streamp source;
{
    struct inflate_state FAR *state;
    struct inflate_state FAR *copy;
    unsigned char FAR *window;
    unsigned wsize;

    /* check input */
    if (inflateStateCheck(source) || dest == Z_NULL)
        return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)source->state;

    /* allocate space */
    copy = (struct inflate_state FAR *)
           ZALLOC(source, 1, sizeof(struct inflate_state));
    if (copy == Z_NULL) return Z_MEM_ERROR;
    window = Z_NULL;
    if (state->window != Z_NULL) {
        window = (unsigned char FAR *)
                 ZALLOC(source, 1U << state->wbits, sizeof(unsigned char));
        if (window == Z_NULL) {
            ZFREE(source, copy);
            return Z_MEM_ERROR;
        }
    }

    /* copy state */
    zmemcpy((voidpf)dest, (voidpf)source, sizeof(z_stream));
    zmemcpy((voidpf)copy, (voidpf)state, sizeof(struct inflate_state));
    copy->strm = dest;
    if (state->lencode >= state->codes &&
        state->lencode <= state->codes + ENOUGH - 1) {
        copy->lencode = copy->codes + (state->lencode - state->codes);
        copy->distcode = copy->codes + (state->distcode - state->codes);
    }
    copy->next = copy->codes + (state->next - state->codes);
    if (window != Z_NULL) {
        wsize = 1U << state->wbits;
        zmemcpy(window, state->window, wsize);
    }
    copy->window = window;
    dest->state = (struct internal_state FAR *)copy;
    return Z_OK;
}

int ZEXPORT inflateUndermine(strm, subvert)
z_streamp strm;
int subvert;
{
    struct inflate_state FAR *state;

    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR
    state->sane = !subvert;
    return Z_OK;
#else
    (void)subvert;
    state->sane = 1;
    return Z_DATA_ERROR;
#endif
}

int ZEXPORT inflateValidate(strm, check)
z_streamp strm;
int check;
{
    struct inflate_state FAR *state;

    if (inflateStateCheck(strm)) return Z_STREAM_ERROR;
    state = (struct inflate_state FAR *)strm->state;
    if (check)
        state->wrap |= 4;
    else
        state->wrap &= ~4;
    return Z_OK;
}

long ZEXPORT inflateMark(strm)
z_streamp strm;
{
    struct inflate_state FAR *state;

    if (inflateStateCheck(strm))
        return -(1L << 16);
    state = (struct inflate_state FAR *)strm->state;
    return (long)(((unsigned long)((long)state->back)) << 16) +
        (state->mode == COPY ? state->length :
            (state->mode == MATCH ? state->was - state->length : 0));
}

unsigned long ZEXPORT inflateCodesUsed(strm)
z_streamp strm;
{
    struct inflate_state FAR *state;
    if (inflateStateCheck(strm)) return (unsigned long)-1;
    state = (struct inflate_state FAR *)strm->state;
    return (unsigned long)(state->next - state->codes);
}

Deleted compat/zlib/inflate.h.

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





























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inflate.h -- internal inflate state definition
 * Copyright (C) 1995-2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* WARNING: this file should *not* be used by applications. It is
   part of the implementation of the compression library and is
   subject to change. Applications should only use zlib.h.
 */

/* define NO_GZIP when compiling if you want to disable gzip header and
   trailer decoding by inflate().  NO_GZIP would be used to avoid linking in
   the crc code when it is not needed.  For shared libraries, gzip decoding
   should be left enabled. */
#ifndef NO_GZIP
#  define GUNZIP
#endif

/* Possible inflate modes between inflate() calls */
typedef enum {
    HEAD = 16180,   /* i: waiting for magic header */
    FLAGS,      /* i: waiting for method and flags (gzip) */
    TIME,       /* i: waiting for modification time (gzip) */
    OS,         /* i: waiting for extra flags and operating system (gzip) */
    EXLEN,      /* i: waiting for extra length (gzip) */
    EXTRA,      /* i: waiting for extra bytes (gzip) */
    NAME,       /* i: waiting for end of file name (gzip) */
    COMMENT,    /* i: waiting for end of comment (gzip) */
    HCRC,       /* i: waiting for header crc (gzip) */
    DICTID,     /* i: waiting for dictionary check value */
    DICT,       /* waiting for inflateSetDictionary() call */
        TYPE,       /* i: waiting for type bits, including last-flag bit */
        TYPEDO,     /* i: same, but skip check to exit inflate on new block */
        STORED,     /* i: waiting for stored size (length and complement) */
        COPY_,      /* i/o: same as COPY below, but only first time in */
        COPY,       /* i/o: waiting for input or output to copy stored block */
        TABLE,      /* i: waiting for dynamic block table lengths */
        LENLENS,    /* i: waiting for code length code lengths */
        CODELENS,   /* i: waiting for length/lit and distance code lengths */
            LEN_,       /* i: same as LEN below, but only first time in */
            LEN,        /* i: waiting for length/lit/eob code */
            LENEXT,     /* i: waiting for length extra bits */
            DIST,       /* i: waiting for distance code */
            DISTEXT,    /* i: waiting for distance extra bits */
            MATCH,      /* o: waiting for output space to copy string */
            LIT,        /* o: waiting for output space to write literal */
    CHECK,      /* i: waiting for 32-bit check value */
    LENGTH,     /* i: waiting for 32-bit length (gzip) */
    DONE,       /* finished check, done -- remain here until reset */
    BAD,        /* got a data error -- remain here until reset */
    MEM,        /* got an inflate() memory error -- remain here until reset */
    SYNC        /* looking for synchronization bytes to restart inflate() */
} inflate_mode;

/*
    State transitions between above modes -

    (most modes can go to BAD or MEM on error -- not shown for clarity)

    Process header:
        HEAD -> (gzip) or (zlib) or (raw)
        (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME -> COMMENT ->
                  HCRC -> TYPE
        (zlib) -> DICTID or TYPE
        DICTID -> DICT -> TYPE
        (raw) -> TYPEDO
    Read deflate blocks:
            TYPE -> TYPEDO -> STORED or TABLE or LEN_ or CHECK
            STORED -> COPY_ -> COPY -> TYPE
            TABLE -> LENLENS -> CODELENS -> LEN_
            LEN_ -> LEN
    Read deflate codes in fixed or dynamic block:
                LEN -> LENEXT or LIT or TYPE
                LENEXT -> DIST -> DISTEXT -> MATCH -> LEN
                LIT -> LEN
    Process trailer:
        CHECK -> LENGTH -> DONE
 */

/* State maintained between inflate() calls -- approximately 7K bytes, not
   including the allocated sliding window, which is up to 32K bytes. */
struct inflate_state {
    z_streamp strm;             /* pointer back to this zlib stream */
    inflate_mode mode;          /* current inflate mode */
    int last;                   /* true if processing last block */
    int wrap;                   /* bit 0 true for zlib, bit 1 true for gzip,
                                   bit 2 true to validate check value */
    int havedict;               /* true if dictionary provided */
    int flags;                  /* gzip header method and flags (0 if zlib) */
    unsigned dmax;              /* zlib header max distance (INFLATE_STRICT) */
    unsigned long check;        /* protected copy of check value */
    unsigned long total;        /* protected copy of output count */
    gz_headerp head;            /* where to save gzip header information */
        /* sliding window */
    unsigned wbits;             /* log base 2 of requested window size */
    unsigned wsize;             /* window size or zero if not using window */
    unsigned whave;             /* valid bytes in the window */
    unsigned wnext;             /* window write index */
    unsigned char FAR *window;  /* allocated sliding window, if needed */
        /* bit accumulator */
    unsigned long hold;         /* input bit accumulator */
    unsigned bits;              /* number of bits in "in" */
        /* for string and stored block copying */
    unsigned length;            /* literal or length of data to copy */
    unsigned offset;            /* distance back to copy string from */
        /* for table and code decoding */
    unsigned extra;             /* extra bits needed */
        /* fixed and dynamic code tables */
    code const FAR *lencode;    /* starting table for length/literal codes */
    code const FAR *distcode;   /* starting table for distance codes */
    unsigned lenbits;           /* index bits for lencode */
    unsigned distbits;          /* index bits for distcode */
        /* dynamic table building */
    unsigned ncode;             /* number of code length code lengths */
    unsigned nlen;              /* number of length code lengths */
    unsigned ndist;             /* number of distance code lengths */
    unsigned have;              /* number of code lengths in lens[] */
    code FAR *next;             /* next available space in codes[] */
    unsigned short lens[320];   /* temporary storage for code lengths */
    unsigned short work[288];   /* work area for code table building */
    code codes[ENOUGH];         /* space for code tables */
    int sane;                   /* if false, allow invalid distance too far */
    int back;                   /* bits back of last unprocessed length/lit */
    unsigned was;               /* initial length of match */
};

Deleted compat/zlib/inftrees.c.

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
















































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inftrees.c -- generate Huffman trees for efficient decoding
 * Copyright (C) 1995-2017 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

#include "zutil.h"
#include "inftrees.h"

#define MAXBITS 15

const char inflate_copyright[] =
   " inflate 1.2.11 Copyright 1995-2017 Mark Adler ";
/*
  If you use the zlib library in a product, an acknowledgment is welcome
  in the documentation of your product. If for some reason you cannot
  include such an acknowledgment, I would appreciate that you keep this
  copyright string in the executable of your product.
 */

/*
   Build a set of tables to decode the provided canonical Huffman code.
   The code lengths are lens[0..codes-1].  The result starts at *table,
   whose indices are 0..2^bits-1.  work is a writable array of at least
   lens shorts, which is used as a work area.  type is the type of code
   to be generated, CODES, LENS, or DISTS.  On return, zero is success,
   -1 is an invalid code, and +1 means that ENOUGH isn't enough.  table
   on return points to the next available entry's address.  bits is the
   requested root table index bits, and on return it is the actual root
   table index bits.  It will differ if the request is greater than the
   longest code or if it is less than the shortest code.
 */
int ZLIB_INTERNAL inflate_table(type, lens, codes, table, bits, work)
codetype type;
unsigned short FAR *lens;
unsigned codes;
code FAR * FAR *table;
unsigned FAR *bits;
unsigned short FAR *work;
{
    unsigned len;               /* a code's length in bits */
    unsigned sym;               /* index of code symbols */
    unsigned min, max;          /* minimum and maximum code lengths */
    unsigned root;              /* number of index bits for root table */
    unsigned curr;              /* number of index bits for current table */
    unsigned drop;              /* code bits to drop for sub-table */
    int left;                   /* number of prefix codes available */
    unsigned used;              /* code entries in table used */
    unsigned huff;              /* Huffman code */
    unsigned incr;              /* for incrementing code, index */
    unsigned fill;              /* index for replicating entries */
    unsigned low;               /* low bits for current root entry */
    unsigned mask;              /* mask for low root bits */
    code here;                  /* table entry for duplication */
    code FAR *next;             /* next available space in table */
    const unsigned short FAR *base;     /* base value table to use */
    const unsigned short FAR *extra;    /* extra bits table to use */
    unsigned match;             /* use base and extra for symbol >= match */
    unsigned short count[MAXBITS+1];    /* number of codes of each length */
    unsigned short offs[MAXBITS+1];     /* offsets in table for each length */
    static const unsigned short lbase[31] = { /* Length codes 257..285 base */
        3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31,
        35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0};
    static const unsigned short lext[31] = { /* Length codes 257..285 extra */
        16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18,
        19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 77, 202};
    static const unsigned short dbase[32] = { /* Distance codes 0..29 base */
        1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193,
        257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145,
        8193, 12289, 16385, 24577, 0, 0};
    static const unsigned short dext[32] = { /* Distance codes 0..29 extra */
        16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22,
        23, 23, 24, 24, 25, 25, 26, 26, 27, 27,
        28, 28, 29, 29, 64, 64};

    /*
       Process a set of code lengths to create a canonical Huffman code.  The
       code lengths are lens[0..codes-1].  Each length corresponds to the
       symbols 0..codes-1.  The Huffman code is generated by first sorting the
       symbols by length from short to long, and retaining the symbol order
       for codes with equal lengths.  Then the code starts with all zero bits
       for the first code of the shortest length, and the codes are integer
       increments for the same length, and zeros are appended as the length
       increases.  For the deflate format, these bits are stored backwards
       from their more natural integer increment ordering, and so when the
       decoding tables are built in the large loop below, the integer codes
       are incremented backwards.

       This routine assumes, but does not check, that all of the entries in
       lens[] are in the range 0..MAXBITS.  The caller must assure this.
       1..MAXBITS is interpreted as that code length.  zero means that that
       symbol does not occur in this code.

       The codes are sorted by computing a count of codes for each length,
       creating from that a table of starting indices for each length in the
       sorted table, and then entering the symbols in order in the sorted
       table.  The sorted table is work[], with that space being provided by
       the caller.

       The length counts are used for other purposes as well, i.e. finding
       the minimum and maximum length codes, determining if there are any
       codes at all, checking for a valid set of lengths, and looking ahead
       at length counts to determine sub-table sizes when building the
       decoding tables.
     */

    /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */
    for (len = 0; len <= MAXBITS; len++)
        count[len] = 0;
    for (sym = 0; sym < codes; sym++)
        count[lens[sym]]++;

    /* bound code lengths, force root to be within code lengths */
    root = *bits;
    for (max = MAXBITS; max >= 1; max--)
        if (count[max] != 0) break;
    if (root > max) root = max;
    if (max == 0) {                     /* no symbols to code at all */
        here.op = (unsigned char)64;    /* invalid code marker */
        here.bits = (unsigned char)1;
        here.val = (unsigned short)0;
        *(*table)++ = here;             /* make a table to force an error */
        *(*table)++ = here;
        *bits = 1;
        return 0;     /* no symbols, but wait for decoding to report error */
    }
    for (min = 1; min < max; min++)
        if (count[min] != 0) break;
    if (root < min) root = min;

    /* check for an over-subscribed or incomplete set of lengths */
    left = 1;
    for (len = 1; len <= MAXBITS; len++) {
        left <<= 1;
        left -= count[len];
        if (left < 0) return -1;        /* over-subscribed */
    }
    if (left > 0 && (type == CODES || max != 1))
        return -1;                      /* incomplete set */

    /* generate offsets into symbol table for each length for sorting */
    offs[1] = 0;
    for (len = 1; len < MAXBITS; len++)
        offs[len + 1] = offs[len] + count[len];

    /* sort symbols by length, by symbol order within each length */
    for (sym = 0; sym < codes; sym++)
        if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym;

    /*
       Create and fill in decoding tables.  In this loop, the table being
       filled is at next and has curr index bits.  The code being used is huff
       with length len.  That code is converted to an index by dropping drop
       bits off of the bottom.  For codes where len is less than drop + curr,
       those top drop + curr - len bits are incremented through all values to
       fill the table with replicated entries.

       root is the number of index bits for the root table.  When len exceeds
       root, sub-tables are created pointed to by the root entry with an index
       of the low root bits of huff.  This is saved in low to check for when a
       new sub-table should be started.  drop is zero when the root table is
       being filled, and drop is root when sub-tables are being filled.

       When a new sub-table is needed, it is necessary to look ahead in the
       code lengths to determine what size sub-table is needed.  The length
       counts are used for this, and so count[] is decremented as codes are
       entered in the tables.

       used keeps track of how many table entries have been allocated from the
       provided *table space.  It is checked for LENS and DIST tables against
       the constants ENOUGH_LENS and ENOUGH_DISTS to guard against changes in
       the initial root table size constants.  See the comments in inftrees.h
       for more information.

       sym increments through all symbols, and the loop terminates when
       all codes of length max, i.e. all codes, have been processed.  This
       routine permits incomplete codes, so another loop after this one fills
       in the rest of the decoding tables with invalid code markers.
     */

    /* set up for code type */
    switch (type) {
    case CODES:
        base = extra = work;    /* dummy value--not used */
        match = 20;
        break;
    case LENS:
        base = lbase;
        extra = lext;
        match = 257;
        break;
    default:    /* DISTS */
        base = dbase;
        extra = dext;
        match = 0;
    }

    /* initialize state for loop */
    huff = 0;                   /* starting code */
    sym = 0;                    /* starting code symbol */
    len = min;                  /* starting code length */
    next = *table;              /* current table to fill in */
    curr = root;                /* current table index bits */
    drop = 0;                   /* current bits to drop from code for index */
    low = (unsigned)(-1);       /* trigger new sub-table when len > root */
    used = 1U << root;          /* use root table entries */
    mask = used - 1;            /* mask for comparing low */

    /* check available table space */
    if ((type == LENS && used > ENOUGH_LENS) ||
        (type == DISTS && used > ENOUGH_DISTS))
        return 1;

    /* process all codes and make table entries */
    for (;;) {
        /* create table entry */
        here.bits = (unsigned char)(len - drop);
        if (work[sym] + 1U < match) {
            here.op = (unsigned char)0;
            here.val = work[sym];
        }
        else if (work[sym] >= match) {
            here.op = (unsigned char)(extra[work[sym] - match]);
            here.val = base[work[sym] - match];
        }
        else {
            here.op = (unsigned char)(32 + 64);         /* end of block */
            here.val = 0;
        }

        /* replicate for those indices with low len bits equal to huff */
        incr = 1U << (len - drop);
        fill = 1U << curr;
        min = fill;                 /* save offset to next table */
        do {
            fill -= incr;
            next[(huff >> drop) + fill] = here;
        } while (fill != 0);

        /* backwards increment the len-bit code huff */
        incr = 1U << (len - 1);
        while (huff & incr)
            incr >>= 1;
        if (incr != 0) {
            huff &= incr - 1;
            huff += incr;
        }
        else
            huff = 0;

        /* go to next symbol, update count, len */
        sym++;
        if (--(count[len]) == 0) {
            if (len == max) break;
            len = lens[work[sym]];
        }

        /* create new sub-table if needed */
        if (len > root && (huff & mask) != low) {
            /* if first time, transition to sub-tables */
            if (drop == 0)
                drop = root;

            /* increment past last table */
            next += min;            /* here min is 1 << curr */

            /* determine length of next table */
            curr = len - drop;
            left = (int)(1 << curr);
            while (curr + drop < max) {
                left -= count[curr + drop];
                if (left <= 0) break;
                curr++;
                left <<= 1;
            }

            /* check for enough space */
            used += 1U << curr;
            if ((type == LENS && used > ENOUGH_LENS) ||
                (type == DISTS && used > ENOUGH_DISTS))
                return 1;

            /* point entry in root table to sub-table */
            low = huff & mask;
            (*table)[low].op = (unsigned char)curr;
            (*table)[low].bits = (unsigned char)root;
            (*table)[low].val = (unsigned short)(next - *table);
        }
    }

    /* fill in remaining table entry if code is incomplete (guaranteed to have
       at most one remaining entry, since if the code is incomplete, the
       maximum code length that was allowed to get this far is one bit) */
    if (huff != 0) {
        here.op = (unsigned char)64;            /* invalid code marker */
        here.bits = (unsigned char)(len - drop);
        here.val = (unsigned short)0;
        next[huff] = here;
    }

    /* set return parameters */
    *table += used;
    *bits = root;
    return 0;
}

Deleted compat/zlib/inftrees.h.

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






























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* inftrees.h -- header to use inftrees.c
 * Copyright (C) 1995-2005, 2010 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* WARNING: this file should *not* be used by applications. It is
   part of the implementation of the compression library and is
   subject to change. Applications should only use zlib.h.
 */

/* Structure for decoding tables.  Each entry provides either the
   information needed to do the operation requested by the code that
   indexed that table entry, or it provides a pointer to another
   table that indexes more bits of the code.  op indicates whether
   the entry is a pointer to another table, a literal, a length or
   distance, an end-of-block, or an invalid code.  For a table
   pointer, the low four bits of op is the number of index bits of
   that table.  For a length or distance, the low four bits of op
   is the number of extra bits to get after the code.  bits is
   the number of bits in this code or part of the code to drop off
   of the bit buffer.  val is the actual byte to output in the case
   of a literal, the base length or distance, or the offset from
   the current table to the next table.  Each entry is four bytes. */
typedef struct {
    unsigned char op;           /* operation, extra bits, table bits */
    unsigned char bits;         /* bits in this part of the code */
    unsigned short val;         /* offset in table or code value */
} code;

/* op values as set by inflate_table():
    00000000 - literal
    0000tttt - table link, tttt != 0 is the number of table index bits
    0001eeee - length or distance, eeee is the number of extra bits
    01100000 - end of block
    01000000 - invalid code
 */

/* Maximum size of the dynamic table.  The maximum number of code structures is
   1444, which is the sum of 852 for literal/length codes and 592 for distance
   codes.  These values were found by exhaustive searches using the program
   examples/enough.c found in the zlib distribtution.  The arguments to that
   program are the number of symbols, the initial root table size, and the
   maximum bit length of a code.  "enough 286 9 15" for literal/length codes
   returns returns 852, and "enough 30 6 15" for distance codes returns 592.
   The initial root table size (9 or 6) is found in the fifth argument of the
   inflate_table() calls in inflate.c and infback.c.  If the root table size is
   changed, then these maximum sizes would be need to be recalculated and
   updated. */
#define ENOUGH_LENS 852
#define ENOUGH_DISTS 592
#define ENOUGH (ENOUGH_LENS+ENOUGH_DISTS)

/* Type of code to build for inflate_table() */
typedef enum {
    CODES,
    LENS,
    DISTS
} codetype;

int ZLIB_INTERNAL inflate_table OF((codetype type, unsigned short FAR *lens,
                             unsigned codes, code FAR * FAR *table,
                             unsigned FAR *bits, unsigned short FAR *work));

Deleted compat/zlib/make_vms.com.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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



































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
$! make libz under VMS written by
$! Martin P.J. Zinser
$!
$! In case of problems with the install you might contact me at
$! zinser@zinser.no-ip.info(preferred) or
$! martin.zinser@eurexchange.com (work)
$!
$! Make procedure history for Zlib
$!
$!------------------------------------------------------------------------------
$! Version history
$! 0.01 20060120 First version to receive a number
$! 0.02 20061008 Adapt to new Makefile.in
$! 0.03 20091224 Add support for large file check
$! 0.04 20100110 Add new gzclose, gzlib, gzread, gzwrite
$! 0.05 20100221 Exchange zlibdefs.h by zconf.h.in
$! 0.06 20120111 Fix missing amiss_err, update zconf_h.in, fix new exmples
$!               subdir path, update module search in makefile.in
$! 0.07 20120115 Triggered by work done by Alexey Chupahin completly redesigned
$!               shared image creation
$! 0.08 20120219 Make it work on VAX again, pre-load missing symbols to shared
$!               image
$! 0.09 20120305 SMS.  P1 sets builder ("MMK", "MMS", " " (built-in)).
$!               "" -> automatic, preference: MMK, MMS, built-in.
$!
$ on error then goto err_exit
$!
$ true  = 1
$ false = 0
$ tmpnam = "temp_" + f$getjpi("","pid")
$ tt = tmpnam + ".txt"
$ tc = tmpnam + ".c"
$ th = tmpnam + ".h"
$ define/nolog tconfig 'th'
$ its_decc = false
$ its_vaxc = false
$ its_gnuc = false
$ s_case   = False
$!
$! Setup variables holding "config" information
$!
$ Make    = "''p1'"
$ name     = "Zlib"
$ version  = "?.?.?"
$ v_string = "ZLIB_VERSION"
$ v_file   = "zlib.h"
$ ccopt   = "/include = []"
$ lopts   = ""
$ dnsrl   = ""
$ aconf_in_file = "zconf.h.in#zconf.h_in#zconf_h.in"
$ conf_check_string = ""
$ linkonly = false
$ optfile  = name + ".opt"
$ mapfile  = name + ".map"
$ libdefs  = ""
$ vax      = f$getsyi("HW_MODEL").lt.1024
$ axp      = f$getsyi("HW_MODEL").ge.1024 .and. f$getsyi("HW_MODEL").lt.4096
$ ia64     = f$getsyi("HW_MODEL").ge.4096
$!
$! 2012-03-05 SMS.
$! Why is this needed?  And if it is needed, why not simply ".not. vax"?
$!
$!!! if axp .or. ia64 then  set proc/parse=extended
$!
$ whoami = f$parse(f$environment("Procedure"),,,,"NO_CONCEAL")
$ mydef  = F$parse(whoami,,,"DEVICE")
$ mydir  = f$parse(whoami,,,"DIRECTORY") - "]["
$ myproc = f$parse(whoami,,,"Name") + f$parse(whoami,,,"type")
$!
$! Check for MMK/MMS
$!
$ if (Make .eqs. "")
$ then
$   If F$Search ("Sys$System:MMS.EXE") .nes. "" Then Make = "MMS"
$   If F$Type (MMK) .eqs. "STRING" Then Make = "MMK"
$ else
$   Make = f$edit( Make, "trim")
$ endif
$!
$ gosub find_version
$!
$  open/write topt tmp.opt
$  open/write optf 'optfile'
$!
$ gosub check_opts
$!
$! Look for the compiler used
$!
$ gosub check_compiler
$ close topt
$ close optf
$!
$ if its_decc
$ then
$   ccopt = "/prefix=all" + ccopt
$   if f$trnlnm("SYS") .eqs. ""
$   then
$     if axp
$     then
$       define sys sys$library:
$     else
$       ccopt = "/decc" + ccopt
$       define sys decc$library_include:
$     endif
$   endif
$!
$! 2012-03-05 SMS.
$! Why /NAMES = AS_IS?  Why not simply ".not. vax"?  And why not on VAX?
$!
$   if axp .or. ia64
$   then
$       ccopt = ccopt + "/name=as_is/opt=(inline=speed)"
$       s_case = true
$   endif
$ endif
$ if its_vaxc .or. its_gnuc
$ then
$    if f$trnlnm("SYS").eqs."" then define sys sys$library:
$ endif
$!
$! Build a fake configure input header
$!
$ open/write conf_hin config.hin
$ write conf_hin "#undef _LARGEFILE64_SOURCE"
$ close conf_hin
$!
$!
$ i = 0
$FIND_ACONF:
$ fname = f$element(i,"#",aconf_in_file)
$ if fname .eqs. "#" then goto AMISS_ERR
$ if f$search(fname) .eqs. ""
$ then
$   i = i + 1
$   goto find_aconf
$ endif
$ open/read/err=aconf_err aconf_in 'fname'
$ open/write aconf zconf.h
$ACONF_LOOP:
$ read/end_of_file=aconf_exit aconf_in line
$ work = f$edit(line, "compress,trim")
$ if f$extract(0,6,work) .nes. "#undef"
$ then
$   if f$extract(0,12,work) .nes. "#cmakedefine"
$   then
$       write aconf line
$   endif
$ else
$   cdef = f$element(1," ",work)
$   gosub check_config
$ endif
$ goto aconf_loop
$ACONF_EXIT:
$ write aconf ""
$ write aconf "/* VMS specifics added by make_vms.com: */"
$ write aconf "#define VMS 1"
$ write aconf "#include <unistd.h>"
$ write aconf "#include <unixio.h>"
$ write aconf "#ifdef _LARGEFILE"
$ write aconf "# define off64_t __off64_t"
$ write aconf "# define fopen64 fopen"
$ write aconf "# define fseeko64 fseeko"
$ write aconf "# define lseek64 lseek"
$ write aconf "# define ftello64 ftell"
$ write aconf "#endif"
$ write aconf "#if !defined( __VAX) && (__CRTL_VER >= 70312000)"
$ write aconf "# define HAVE_VSNPRINTF"
$ write aconf "#endif"
$ close aconf_in
$ close aconf
$ if f$search("''th'") .nes. "" then delete 'th';*
$! Build the thing plain or with mms
$!
$ write sys$output "Compiling Zlib sources ..."
$ if make.eqs.""
$ then
$   if (f$search( "example.obj;*") .nes. "") then delete example.obj;*
$   if (f$search( "minigzip.obj;*") .nes. "") then delete minigzip.obj;*
$   CALL MAKE adler32.OBJ "CC ''CCOPT' adler32" -
                adler32.c zlib.h zconf.h
$   CALL MAKE compress.OBJ "CC ''CCOPT' compress" -
                compress.c zlib.h zconf.h
$   CALL MAKE crc32.OBJ "CC ''CCOPT' crc32" -
                crc32.c zlib.h zconf.h
$   CALL MAKE deflate.OBJ "CC ''CCOPT' deflate" -
                deflate.c deflate.h zutil.h zlib.h zconf.h
$   CALL MAKE gzclose.OBJ "CC ''CCOPT' gzclose" -
                gzclose.c zutil.h zlib.h zconf.h
$   CALL MAKE gzlib.OBJ "CC ''CCOPT' gzlib" -
                gzlib.c zutil.h zlib.h zconf.h
$   CALL MAKE gzread.OBJ "CC ''CCOPT' gzread" -
                gzread.c zutil.h zlib.h zconf.h
$   CALL MAKE gzwrite.OBJ "CC ''CCOPT' gzwrite" -
                gzwrite.c zutil.h zlib.h zconf.h
$   CALL MAKE infback.OBJ "CC ''CCOPT' infback" -
                infback.c zutil.h inftrees.h inflate.h inffast.h inffixed.h
$   CALL MAKE inffast.OBJ "CC ''CCOPT' inffast" -
                inffast.c zutil.h zlib.h zconf.h inffast.h
$   CALL MAKE inflate.OBJ "CC ''CCOPT' inflate" -
                inflate.c zutil.h zlib.h zconf.h infblock.h
$   CALL MAKE inftrees.OBJ "CC ''CCOPT' inftrees" -
                inftrees.c zutil.h zlib.h zconf.h inftrees.h
$   CALL MAKE trees.OBJ "CC ''CCOPT' trees" -
                trees.c deflate.h zutil.h zlib.h zconf.h
$   CALL MAKE uncompr.OBJ "CC ''CCOPT' uncompr" -
                uncompr.c zlib.h zconf.h
$   CALL MAKE zutil.OBJ "CC ''CCOPT' zutil" -
                zutil.c zutil.h zlib.h zconf.h
$   write sys$output "Building Zlib ..."
$   CALL MAKE libz.OLB "lib/crea libz.olb *.obj" *.OBJ
$   write sys$output "Building example..."
$   CALL MAKE example.OBJ "CC ''CCOPT' [.test]example" -
                [.test]example.c zlib.h zconf.h
$   call make example.exe "LINK example,libz.olb/lib" example.obj libz.olb
$   write sys$output "Building minigzip..."
$   CALL MAKE minigzip.OBJ "CC ''CCOPT' [.test]minigzip" -
              [.test]minigzip.c zlib.h zconf.h
$   call make minigzip.exe -
              "LINK minigzip,libz.olb/lib" -
              minigzip.obj libz.olb
$ else
$   gosub crea_mms
$   write sys$output "Make ''name' ''version' with ''Make' "
$   'make'
$ endif
$!
$! Create shareable image
$!
$ gosub crea_olist
$ write sys$output "Creating libzshr.exe"
$ call map_2_shopt 'mapfile' 'optfile'
$ LINK_'lopts'/SHARE=libzshr.exe modules.opt/opt,'optfile'/opt
$ write sys$output "Zlib build completed"
$ delete/nolog tmp.opt;*
$ exit
$AMISS_ERR:
$ write sys$output "No source for config.hin found."
$ write sys$output "Tried any of ''aconf_in_file'"
$ goto err_exit
$CC_ERR:
$ write sys$output "C compiler required to build ''name'"
$ goto err_exit
$ERR_EXIT:
$ set message/facil/ident/sever/text
$ close/nolog optf
$ close/nolog topt
$ close/nolog aconf_in
$ close/nolog aconf
$ close/nolog out
$ close/nolog min
$ close/nolog mod
$ close/nolog h_in
$ write sys$output "Exiting..."
$ exit 2
$!
$!
$MAKE: SUBROUTINE   !SUBROUTINE TO CHECK DEPENDENCIES
$ V = 'F$Verify(0)
$! P1 = What we are trying to make
$! P2 = Command to make it
$! P3 - P8  What it depends on
$
$ If F$Search(P1) .Eqs. "" Then Goto Makeit
$ Time = F$CvTime(F$File(P1,"RDT"))
$arg=3
$Loop:
$       Argument = P'arg
$       If Argument .Eqs. "" Then Goto Exit
$       El=0
$Loop2:
$       File = F$Element(El," ",Argument)
$       If File .Eqs. " " Then Goto Endl
$       AFile = ""
$Loop3:
$       OFile = AFile
$       AFile = F$Search(File)
$       If AFile .Eqs. "" .Or. AFile .Eqs. OFile Then Goto NextEl
$       If F$CvTime(F$File(AFile,"RDT")) .Ges. Time Then Goto Makeit
$       Goto Loop3
$NextEL:
$       El = El + 1
$       Goto Loop2
$EndL:
$ arg=arg+1
$ If arg .Le. 8 Then Goto Loop
$ Goto Exit
$
$Makeit:
$ VV=F$VERIFY(0)
$ write sys$output P2
$ 'P2
$ VV='F$Verify(VV)
$Exit:
$ If V Then Set Verify
$ENDSUBROUTINE
$!------------------------------------------------------------------------------
$!
$! Check command line options and set symbols accordingly
$!
$!------------------------------------------------------------------------------
$! Version history
$! 0.01 20041206 First version to receive a number
$! 0.02 20060126 Add new "HELP" target
$ CHECK_OPTS:
$ i = 1
$ OPT_LOOP:
$ if i .lt. 9
$ then
$   cparm = f$edit(p'i',"upcase")
$!
$! Check if parameter actually contains something
$!
$   if f$edit(cparm,"trim") .nes. ""
$   then
$     if cparm .eqs. "DEBUG"
$     then
$       ccopt = ccopt + "/noopt/deb"
$       lopts = lopts + "/deb"
$     endif
$     if f$locate("CCOPT=",cparm) .lt. f$length(cparm)
$     then
$       start = f$locate("=",cparm) + 1
$       len   = f$length(cparm) - start
$       ccopt = ccopt + f$extract(start,len,cparm)
$       if f$locate("AS_IS",f$edit(ccopt,"UPCASE")) .lt. f$length(ccopt) -
          then s_case = true
$     endif
$     if cparm .eqs. "LINK" then linkonly = true
$     if f$locate("LOPTS=",cparm) .lt. f$length(cparm)
$     then
$       start = f$locate("=",cparm) + 1
$       len   = f$length(cparm) - start
$       lopts = lopts + f$extract(start,len,cparm)
$     endif
$     if f$locate("CC=",cparm) .lt. f$length(cparm)
$     then
$       start  = f$locate("=",cparm) + 1
$       len    = f$length(cparm) - start
$       cc_com = f$extract(start,len,cparm)
        if (cc_com .nes. "DECC") .and. -
           (cc_com .nes. "VAXC") .and. -
           (cc_com .nes. "GNUC")
$       then
$         write sys$output "Unsupported compiler choice ''cc_com' ignored"
$         write sys$output "Use DECC, VAXC, or GNUC instead"
$       else
$         if cc_com .eqs. "DECC" then its_decc = true
$         if cc_com .eqs. "VAXC" then its_vaxc = true
$         if cc_com .eqs. "GNUC" then its_gnuc = true
$       endif
$     endif
$     if f$locate("MAKE=",cparm) .lt. f$length(cparm)
$     then
$       start  = f$locate("=",cparm) + 1
$       len    = f$length(cparm) - start
$       mmks = f$extract(start,len,cparm)
$       if (mmks .eqs. "MMK") .or. (mmks .eqs. "MMS")
$       then
$         make = mmks
$       else
$         write sys$output "Unsupported make choice ''mmks' ignored"
$         write sys$output "Use MMK or MMS instead"
$       endif
$     endif
$     if cparm .eqs. "HELP" then gosub bhelp
$   endif
$   i = i + 1
$   goto opt_loop
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! Look for the compiler used
$!
$! Version history
$! 0.01 20040223 First version to receive a number
$! 0.02 20040229 Save/set value of decc$no_rooted_search_lists
$! 0.03 20060202 Extend handling of GNU C
$! 0.04 20090402 Compaq -> hp
$CHECK_COMPILER:
$ if (.not. (its_decc .or. its_vaxc .or. its_gnuc))
$ then
$   its_decc = (f$search("SYS$SYSTEM:DECC$COMPILER.EXE") .nes. "")
$   its_vaxc = .not. its_decc .and. (F$Search("SYS$System:VAXC.Exe") .nes. "")
$   its_gnuc = .not. (its_decc .or. its_vaxc) .and. (f$trnlnm("gnu_cc") .nes. "")
$ endif
$!
$! Exit if no compiler available
$!
$ if (.not. (its_decc .or. its_vaxc .or. its_gnuc))
$ then goto CC_ERR
$ else
$   if its_decc
$   then
$     write sys$output "CC compiler check ... hp C"
$     if f$trnlnm("decc$no_rooted_search_lists") .nes. ""
$     then
$       dnrsl = f$trnlnm("decc$no_rooted_search_lists")
$     endif
$     define/nolog decc$no_rooted_search_lists 1
$   else
$     if its_vaxc then write sys$output "CC compiler check ... VAX C"
$     if its_gnuc
$     then
$         write sys$output "CC compiler check ... GNU C"
$         if f$trnlnm(topt) then write topt "gnu_cc:[000000]gcclib.olb/lib"
$         if f$trnlnm(optf) then write optf "gnu_cc:[000000]gcclib.olb/lib"
$         cc = "gcc"
$     endif
$     if f$trnlnm(topt) then write topt "sys$share:vaxcrtl.exe/share"
$     if f$trnlnm(optf) then write optf "sys$share:vaxcrtl.exe/share"
$   endif
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! If MMS/MMK are available dump out the descrip.mms if required
$!
$CREA_MMS:
$ write sys$output "Creating descrip.mms..."
$ create descrip.mms
$ open/append out descrip.mms
$ copy sys$input: out
$ deck
# descrip.mms: MMS description file for building zlib on VMS
# written by Martin P.J. Zinser
# <zinser@zinser.no-ip.info or martin.zinser@eurexchange.com>

OBJS = adler32.obj, compress.obj, crc32.obj, gzclose.obj, gzlib.obj\
       gzread.obj, gzwrite.obj, uncompr.obj, infback.obj\
       deflate.obj, trees.obj, zutil.obj, inflate.obj, \
       inftrees.obj, inffast.obj

$ eod
$ write out "CFLAGS=", ccopt
$ write out "LOPTS=", lopts
$ write out "all : example.exe minigzip.exe libz.olb"
$ copy sys$input: out
$ deck
        @ write sys$output " Example applications available"

libz.olb : libz.olb($(OBJS))
	@ write sys$output " libz available"

example.exe : example.obj libz.olb
              link $(LOPTS) example,libz.olb/lib

minigzip.exe : minigzip.obj libz.olb
              link $(LOPTS) minigzip,libz.olb/lib

clean :
	delete *.obj;*,libz.olb;*,*.opt;*,*.exe;*


# Other dependencies.
adler32.obj  : adler32.c zutil.h zlib.h zconf.h
compress.obj : compress.c zlib.h zconf.h
crc32.obj    : crc32.c zutil.h zlib.h zconf.h
deflate.obj  : deflate.c deflate.h zutil.h zlib.h zconf.h
example.obj  : [.test]example.c zlib.h zconf.h
gzclose.obj  : gzclose.c zutil.h zlib.h zconf.h
gzlib.obj    : gzlib.c zutil.h zlib.h zconf.h
gzread.obj   : gzread.c zutil.h zlib.h zconf.h
gzwrite.obj  : gzwrite.c zutil.h zlib.h zconf.h
inffast.obj  : inffast.c zutil.h zlib.h zconf.h inftrees.h inffast.h
inflate.obj  : inflate.c zutil.h zlib.h zconf.h
inftrees.obj : inftrees.c zutil.h zlib.h zconf.h inftrees.h
minigzip.obj : [.test]minigzip.c zlib.h zconf.h
trees.obj    : trees.c deflate.h zutil.h zlib.h zconf.h
uncompr.obj  : uncompr.c zlib.h zconf.h
zutil.obj    : zutil.c zutil.h zlib.h zconf.h
infback.obj  : infback.c zutil.h inftrees.h inflate.h inffast.h inffixed.h
$ eod
$ close out
$ return
$!------------------------------------------------------------------------------
$!
$! Read list of core library sources from makefile.in and create options
$! needed to build shareable image
$!
$CREA_OLIST:
$ open/read min makefile.in
$ open/write mod modules.opt
$ src_check_list = "OBJZ =#OBJG ="
$MRLOOP:
$ read/end=mrdone min rec
$ i = 0
$SRC_CHECK_LOOP:
$ src_check = f$element(i, "#", src_check_list)
$ i = i+1
$ if src_check .eqs. "#" then goto mrloop
$ if (f$extract(0,6,rec) .nes. src_check) then goto src_check_loop
$ rec = rec - src_check
$ gosub extra_filnam
$ if (f$element(1,"\",rec) .eqs. "\") then goto mrloop
$MRSLOOP:
$ read/end=mrdone min rec
$ gosub extra_filnam
$ if (f$element(1,"\",rec) .nes. "\") then goto mrsloop
$MRDONE:
$ close min
$ close mod
$ return
$!------------------------------------------------------------------------------
$!
$! Take record extracted in crea_olist and split it into single filenames
$!
$EXTRA_FILNAM:
$ myrec = f$edit(rec - "\", "trim,compress")
$ i = 0
$FELOOP:
$ srcfil = f$element(i," ", myrec)
$ if (srcfil .nes. " ")
$ then
$   write mod f$parse(srcfil,,,"NAME"), ".obj"
$   i = i + 1
$   goto feloop
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! Find current Zlib version number
$!
$FIND_VERSION:
$ open/read h_in 'v_file'
$hloop:
$ read/end=hdone h_in rec
$ rec = f$edit(rec,"TRIM")
$ if (f$extract(0,1,rec) .nes. "#") then goto hloop
$ rec = f$edit(rec - "#", "TRIM")
$ if f$element(0," ",rec) .nes. "define" then goto hloop
$ if f$element(1," ",rec) .eqs. v_string
$ then
$   version = 'f$element(2," ",rec)'
$   goto hdone
$ endif
$ goto hloop
$hdone:
$ close h_in
$ return
$!------------------------------------------------------------------------------
$!
$CHECK_CONFIG:
$!
$ in_ldef = f$locate(cdef,libdefs)
$ if (in_ldef .lt. f$length(libdefs))
$ then
$   write aconf "#define ''cdef' 1"
$   libdefs = f$extract(0,in_ldef,libdefs) + -
              f$extract(in_ldef + f$length(cdef) + 1, -
                        f$length(libdefs) - in_ldef - f$length(cdef) - 1, -
                        libdefs)
$ else
$   if (f$type('cdef') .eqs. "INTEGER")
$   then
$     write aconf "#define ''cdef' ", 'cdef'
$   else
$     if (f$type('cdef') .eqs. "STRING")
$     then
$       write aconf "#define ''cdef' ", """", '''cdef'', """"
$     else
$       gosub check_cc_def
$     endif
$   endif
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! Check if this is a define relating to the properties of the C/C++
$! compiler
$!
$ CHECK_CC_DEF:
$ if (cdef .eqs. "_LARGEFILE64_SOURCE")
$ then
$   copy sys$input: 'tc'
$   deck
#include "tconfig"
#define _LARGEFILE
#include <stdio.h>

int main(){
FILE *fp;
  fp = fopen("temp.txt","r");
  fseeko(fp,1,SEEK_SET);
  fclose(fp);
}

$   eod
$   test_inv = false
$   comm_h = false
$   gosub cc_prop_check
$   return
$ endif
$ write aconf "/* ", line, " */"
$ return
$!------------------------------------------------------------------------------
$!
$! Check for properties of C/C++ compiler
$!
$! Version history
$! 0.01 20031020 First version to receive a number
$! 0.02 20031022 Added logic for defines with value
$! 0.03 20040309 Make sure local config file gets not deleted
$! 0.04 20041230 Also write include for configure run
$! 0.05 20050103 Add processing of "comment defines"
$CC_PROP_CHECK:
$ cc_prop = true
$ is_need = false
$ is_need = (f$extract(0,4,cdef) .eqs. "NEED") .or. (test_inv .eq. true)
$ if f$search(th) .eqs. "" then create 'th'
$ set message/nofac/noident/nosever/notext
$ on error then continue
$ cc 'tmpnam'
$ if .not. ($status)  then cc_prop = false
$ on error then continue
$! The headers might lie about the capabilities of the RTL
$ link 'tmpnam',tmp.opt/opt
$ if .not. ($status)  then cc_prop = false
$ set message/fac/ident/sever/text
$ on error then goto err_exit
$ delete/nolog 'tmpnam'.*;*/exclude='th'
$ if (cc_prop .and. .not. is_need) .or. -
     (.not. cc_prop .and. is_need)
$ then
$   write sys$output "Checking for ''cdef'... yes"
$   if f$type('cdef_val'_yes) .nes. ""
$   then
$     if f$type('cdef_val'_yes) .eqs. "INTEGER" -
         then call write_config f$fao("#define !AS !UL",cdef,'cdef_val'_yes)
$     if f$type('cdef_val'_yes) .eqs. "STRING" -
         then call write_config f$fao("#define !AS !AS",cdef,'cdef_val'_yes)
$   else
$     call write_config f$fao("#define !AS 1",cdef)
$   endif
$   if (cdef .eqs. "HAVE_FSEEKO") .or. (cdef .eqs. "_LARGE_FILES") .or. -
       (cdef .eqs. "_LARGEFILE64_SOURCE") then -
      call write_config f$string("#define _LARGEFILE 1")
$ else
$   write sys$output "Checking for ''cdef'... no"
$   if (comm_h)
$   then
      call write_config f$fao("/* !AS */",line)
$   else
$     if f$type('cdef_val'_no) .nes. ""
$     then
$       if f$type('cdef_val'_no) .eqs. "INTEGER" -
           then call write_config f$fao("#define !AS !UL",cdef,'cdef_val'_no)
$       if f$type('cdef_val'_no) .eqs. "STRING" -
           then call write_config f$fao("#define !AS !AS",cdef,'cdef_val'_no)
$     else
$       call write_config f$fao("#undef !AS",cdef)
$     endif
$   endif
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! Check for properties of C/C++ compiler with multiple result values
$!
$! Version history
$! 0.01 20040127 First version
$! 0.02 20050103 Reconcile changes from cc_prop up to version 0.05
$CC_MPROP_CHECK:
$ cc_prop = true
$ i    = 1
$ idel = 1
$ MT_LOOP:
$ if f$type(result_'i') .eqs. "STRING"
$ then
$   set message/nofac/noident/nosever/notext
$   on error then continue
$   cc 'tmpnam'_'i'
$   if .not. ($status)  then cc_prop = false
$   on error then continue
$! The headers might lie about the capabilities of the RTL
$   link 'tmpnam'_'i',tmp.opt/opt
$   if .not. ($status)  then cc_prop = false
$   set message/fac/ident/sever/text
$   on error then goto err_exit
$   delete/nolog 'tmpnam'_'i'.*;*
$   if (cc_prop)
$   then
$     write sys$output "Checking for ''cdef'... ", mdef_'i'
$     if f$type(mdef_'i') .eqs. "INTEGER" -
         then call write_config f$fao("#define !AS !UL",cdef,mdef_'i')
$     if f$type('cdef_val'_yes) .eqs. "STRING" -
         then call write_config f$fao("#define !AS !AS",cdef,mdef_'i')
$     goto msym_clean
$   else
$     i = i + 1
$     goto mt_loop
$   endif
$ endif
$ write sys$output "Checking for ''cdef'... no"
$ call write_config f$fao("#undef !AS",cdef)
$ MSYM_CLEAN:
$ if (idel .le. msym_max)
$ then
$   delete/sym mdef_'idel'
$   idel = idel + 1
$   goto msym_clean
$ endif
$ return
$!------------------------------------------------------------------------------
$!
$! Write configuration to both permanent and temporary config file
$!
$! Version history
$! 0.01 20031029 First version to receive a number
$!
$WRITE_CONFIG: SUBROUTINE
$  write aconf 'p1'
$  open/append confh 'th'
$  write confh 'p1'
$  close confh
$ENDSUBROUTINE
$!------------------------------------------------------------------------------
$!
$! Analyze the project map file and create the symbol vector for a shareable
$! image from it
$!
$! Version history
$! 0.01 20120128 First version
$! 0.02 20120226 Add pre-load logic
$!
$ MAP_2_SHOPT: Subroutine
$!
$ SAY := "WRITE_ SYS$OUTPUT"
$!
$ IF F$SEARCH("''P1'") .EQS. ""
$ THEN
$    SAY "MAP_2_SHOPT-E-NOSUCHFILE:  Error, inputfile ''p1' not available"
$    goto exit_m2s
$ ENDIF
$ IF "''P2'" .EQS. ""
$ THEN
$    SAY "MAP_2_SHOPT:  Error, no output file provided"
$    goto exit_m2s
$ ENDIF
$!
$ module1 = "deflate#deflateEnd#deflateInit_#deflateParams#deflateSetDictionary"
$ module2 = "gzclose#gzerror#gzgetc#gzgets#gzopen#gzprintf#gzputc#gzputs#gzread"
$ module3 = "gzseek#gztell#inflate#inflateEnd#inflateInit_#inflateSetDictionary"
$ module4 = "inflateSync#uncompress#zlibVersion#compress"
$ open/read map 'p1
$ if axp .or. ia64
$ then
$     open/write aopt a.opt
$     open/write bopt b.opt
$     write aopt " CASE_SENSITIVE=YES"
$     write bopt "SYMBOL_VECTOR= (-"
$     mod_sym_num = 1
$ MOD_SYM_LOOP:
$     if f$type(module'mod_sym_num') .nes. ""
$     then
$         mod_in = 0
$ MOD_SYM_IN:
$         shared_proc = f$element(mod_in, "#", module'mod_sym_num')
$         if shared_proc .nes. "#"
$         then
$             write aopt f$fao(" symbol_vector=(!AS/!AS=PROCEDURE)",-
        		       f$edit(shared_proc,"upcase"),shared_proc)
$             write bopt f$fao("!AS=PROCEDURE,-",shared_proc)
$             mod_in = mod_in + 1
$             goto mod_sym_in
$         endif
$         mod_sym_num = mod_sym_num + 1
$         goto mod_sym_loop
$     endif
$MAP_LOOP:
$     read/end=map_end map line
$     if (f$locate("{",line).lt. f$length(line)) .or. -
         (f$locate("global:", line) .lt. f$length(line))
$     then
$         proc = true
$         goto map_loop
$     endif
$     if f$locate("}",line).lt. f$length(line) then proc = false
$     if f$locate("local:", line) .lt. f$length(line) then proc = false
$     if proc
$     then
$         shared_proc = f$edit(line,"collapse")
$         chop_semi = f$locate(";", shared_proc)
$         if chop_semi .lt. f$length(shared_proc) then -
              shared_proc = f$extract(0, chop_semi, shared_proc)
$         write aopt f$fao(" symbol_vector=(!AS/!AS=PROCEDURE)",-
        			 f$edit(shared_proc,"upcase"),shared_proc)
$         write bopt f$fao("!AS=PROCEDURE,-",shared_proc)
$     endif
$     goto map_loop
$MAP_END:
$     close/nolog aopt
$     close/nolog bopt
$     open/append libopt 'p2'
$     open/read aopt a.opt
$     open/read bopt b.opt
$ALOOP:
$     read/end=aloop_end aopt line
$     write libopt line
$     goto aloop
$ALOOP_END:
$     close/nolog aopt
$     sv = ""
$BLOOP:
$     read/end=bloop_end bopt svn
$     if (svn.nes."")
$     then
$        if (sv.nes."") then write libopt sv
$        sv = svn
$     endif
$     goto bloop
$BLOOP_END:
$     write libopt f$extract(0,f$length(sv)-2,sv), "-"
$     write libopt ")"
$     close/nolog bopt
$     delete/nolog/noconf a.opt;*,b.opt;*
$ else
$     if vax
$     then
$     open/append libopt 'p2'
$     mod_sym_num = 1
$ VMOD_SYM_LOOP:
$     if f$type(module'mod_sym_num') .nes. ""
$     then
$         mod_in = 0
$ VMOD_SYM_IN:
$         shared_proc = f$element(mod_in, "#", module'mod_sym_num')
$         if shared_proc .nes. "#"
$         then
$     	      write libopt f$fao("UNIVERSAL=!AS",-
      	  			     f$edit(shared_proc,"upcase"))
$             mod_in = mod_in + 1
$             goto vmod_sym_in
$         endif
$         mod_sym_num = mod_sym_num + 1
$         goto vmod_sym_loop
$     endif
$VMAP_LOOP:
$     	  read/end=vmap_end map line
$     	  if (f$locate("{",line).lt. f$length(line)) .or. -
   	      (f$locate("global:", line) .lt. f$length(line))
$     	  then
$     	      proc = true
$     	      goto vmap_loop
$     	  endif
$     	  if f$locate("}",line).lt. f$length(line) then proc = false
$     	  if f$locate("local:", line) .lt. f$length(line) then proc = false
$     	  if proc
$     	  then
$     	      shared_proc = f$edit(line,"collapse")
$     	      chop_semi = f$locate(";", shared_proc)
$     	      if chop_semi .lt. f$length(shared_proc) then -
      	  	  shared_proc = f$extract(0, chop_semi, shared_proc)
$     	      write libopt f$fao("UNIVERSAL=!AS",-
      	  			     f$edit(shared_proc,"upcase"))
$     	  endif
$     	  goto vmap_loop
$VMAP_END:
$     else
$         write sys$output "Unknown Architecture (Not VAX, AXP, or IA64)"
$         write sys$output "No options file created"
$     endif
$ endif
$ EXIT_M2S:
$ close/nolog map
$ close/nolog libopt
$ endsubroutine

Deleted compat/zlib/msdos/Makefile.bor.

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



















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# Borland C++
# Last updated: 15-Mar-2003

# To use, do "make -fmakefile.bor"
# To compile in small model, set below: MODEL=s

# WARNING: the small model is supported but only for small values of
# MAX_WBITS and MAX_MEM_LEVEL. For example:
#    -DMAX_WBITS=11 -DDEF_WBITS=11 -DMAX_MEM_LEVEL=3
# If you wish to reduce the memory requirements (default 256K for big
# objects plus a few K), you can add to the LOC macro below:
#   -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14
# See zconf.h for details about the memory requirements.

# ------------ Turbo C++, Borland C++ ------------

#    Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7)
#    should be added to the environment via "set LOCAL_ZLIB=-DFOO" or added
#    to the declaration of LOC here:
LOC = $(LOCAL_ZLIB)

# type for CPU required: 0: 8086, 1: 80186, 2: 80286, 3: 80386, etc.
CPU_TYP = 0

# memory model: one of s, m, c, l (small, medium, compact, large)
MODEL=l

# replace bcc with tcc for Turbo C++ 1.0, with bcc32 for the 32 bit version
CC=bcc
LD=bcc
AR=tlib

# compiler flags
# replace "-O2" by "-O -G -a -d" for Turbo C++ 1.0
CFLAGS=-O2 -Z -m$(MODEL) $(LOC)

LDFLAGS=-m$(MODEL) -f-


# variables
ZLIB_LIB = zlib_$(MODEL).lib

OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj


# targets
all: $(ZLIB_LIB) example.exe minigzip.exe

.c.obj:
	$(CC) -c $(CFLAGS) $*.c

adler32.obj: adler32.c zlib.h zconf.h

compress.obj: compress.c zlib.h zconf.h

crc32.obj: crc32.c zlib.h zconf.h crc32.h

deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h

gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h

gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h

gzread.obj: gzread.c zlib.h zconf.h gzguts.h

gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h

infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h

inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h

trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h

uncompr.obj: uncompr.c zlib.h zconf.h

zutil.obj: zutil.c zutil.h zlib.h zconf.h

example.obj: test/example.c zlib.h zconf.h

minigzip.obj: test/minigzip.c zlib.h zconf.h


# the command line is cut to fit in the MS-DOS 128 byte limit:
$(ZLIB_LIB): $(OBJ1) $(OBJ2)
	-del $(ZLIB_LIB)
	$(AR) $(ZLIB_LIB) $(OBJP1)
	$(AR) $(ZLIB_LIB) $(OBJP2)

example.exe: example.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)

minigzip.exe: minigzip.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)

test: example.exe minigzip.exe
	example
	echo hello world | minigzip | minigzip -d

clean:
	-del *.obj
	-del *.lib
	-del *.exe
	-del zlib_*.bak
	-del foo.gz

Deleted compat/zlib/msdos/Makefile.dj2.

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








































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib.  Modified for djgpp v2.0 by F. J. Donahoe, 3/15/96.
# Copyright (C) 1995-1998 Jean-loup Gailly.
# For conditions of distribution and use, see copyright notice in zlib.h

# To compile, or to compile and test, type:
#
#   make -fmakefile.dj2;  make test -fmakefile.dj2
#
# To install libz.a, zconf.h and zlib.h in the djgpp directories, type:
#
#    make install -fmakefile.dj2
#
# after first defining LIBRARY_PATH and INCLUDE_PATH in djgpp.env as
# in the sample below if the pattern of the DJGPP distribution is to
# be followed.  Remember that, while <sp>'es around <=> are ignored in
# makefiles, they are *not* in batch files or in djgpp.env.
# - - - - -
# [make]
# INCLUDE_PATH=%\>;INCLUDE_PATH%%\DJDIR%\include
# LIBRARY_PATH=%\>;LIBRARY_PATH%%\DJDIR%\lib
# BUTT=-m486
# - - - - -
# Alternately, these variables may be defined below, overriding the values
# in djgpp.env, as
# INCLUDE_PATH=c:\usr\include
# LIBRARY_PATH=c:\usr\lib

CC=gcc

#CFLAGS=-MMD -O
#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
#CFLAGS=-MMD -g -DZLIB_DEBUG
CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
             -Wstrict-prototypes -Wmissing-prototypes

# If cp.exe is available, replace "copy /Y" with "cp -fp" .
CP=copy /Y
# If gnu install.exe is available, replace $(CP) with ginstall.
INSTALL=$(CP)
# The default value of RM is "rm -f."  If "rm.exe" is found, comment out:
RM=del
LDLIBS=-L. -lz
LD=$(CC) -s -o
LDSHARED=$(CC)

INCL=zlib.h zconf.h
LIBS=libz.a

AR=ar rcs

prefix=/usr/local
exec_prefix = $(prefix)

OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
       uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o

OBJA =
# to use the asm code: make OBJA=match.o

TEST_OBJS = example.o minigzip.o

all: example.exe minigzip.exe

check: test
test: all
	./example
	echo hello world | .\minigzip | .\minigzip -d

%.o : %.c
	$(CC) $(CFLAGS) -c $< -o $@

libz.a: $(OBJS) $(OBJA)
	$(AR) $@ $(OBJS) $(OBJA)

%.exe : %.o $(LIBS)
	$(LD) $@ $< $(LDLIBS)

# INCLUDE_PATH and LIBRARY_PATH were set for [make] in djgpp.env .

.PHONY : uninstall clean

install: $(INCL) $(LIBS)
	-@if not exist $(INCLUDE_PATH)\nul mkdir $(INCLUDE_PATH)
	-@if not exist $(LIBRARY_PATH)\nul mkdir $(LIBRARY_PATH)
	$(INSTALL) zlib.h $(INCLUDE_PATH)
	$(INSTALL) zconf.h $(INCLUDE_PATH)
	$(INSTALL) libz.a $(LIBRARY_PATH)

uninstall:
	$(RM) $(INCLUDE_PATH)\zlib.h
	$(RM) $(INCLUDE_PATH)\zconf.h
	$(RM) $(LIBRARY_PATH)\libz.a

clean:
	$(RM) *.d
	$(RM) *.o
	$(RM) *.exe
	$(RM) libz.a
	$(RM) foo.gz

DEPS := $(wildcard *.d)
ifneq ($(DEPS),)
include $(DEPS)
endif

Deleted compat/zlib/msdos/Makefile.emx.

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





































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib.  Modified for emx 0.9c by Chr. Spieler, 6/17/98.
# Copyright (C) 1995-1998 Jean-loup Gailly.
# For conditions of distribution and use, see copyright notice in zlib.h

# To compile, or to compile and test, type:
#
#   make -fmakefile.emx;  make test -fmakefile.emx
#

CC=gcc

#CFLAGS=-MMD -O
#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
#CFLAGS=-MMD -g -DZLIB_DEBUG
CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
             -Wstrict-prototypes -Wmissing-prototypes

# If cp.exe is available, replace "copy /Y" with "cp -fp" .
CP=copy /Y
# If gnu install.exe is available, replace $(CP) with ginstall.
INSTALL=$(CP)
# The default value of RM is "rm -f."  If "rm.exe" is found, comment out:
RM=del
LDLIBS=-L. -lzlib
LD=$(CC) -s -o
LDSHARED=$(CC)

INCL=zlib.h zconf.h
LIBS=zlib.a

AR=ar rcs

prefix=/usr/local
exec_prefix = $(prefix)

OBJS = adler32.o compress.o crc32.o gzclose.o gzlib.o gzread.o gzwrite.o \
       uncompr.o deflate.o trees.o zutil.o inflate.o infback.o inftrees.o inffast.o

TEST_OBJS = example.o minigzip.o

all: example.exe minigzip.exe

test: all
	./example
	echo hello world | .\minigzip | .\minigzip -d

%.o : %.c
	$(CC) $(CFLAGS) -c $< -o $@

zlib.a: $(OBJS)
	$(AR) $@ $(OBJS)

%.exe : %.o $(LIBS)
	$(LD) $@ $< $(LDLIBS)


.PHONY : clean

clean:
	$(RM) *.d
	$(RM) *.o
	$(RM) *.exe
	$(RM) zlib.a
	$(RM) foo.gz

DEPS := $(wildcard *.d)
ifneq ($(DEPS),)
include $(DEPS)
endif

Deleted compat/zlib/msdos/Makefile.msc.

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
















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# Microsoft C 5.1 or later
# Last updated: 19-Mar-2003

# To use, do "make makefile.msc"
# To compile in small model, set below: MODEL=S

# If you wish to reduce the memory requirements (default 256K for big
# objects plus a few K), you can add to the LOC macro below:
#   -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14
# See zconf.h for details about the memory requirements.

# ------------- Microsoft C 5.1 and later -------------

#    Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7)
#    should be added to the environment via "set LOCAL_ZLIB=-DFOO" or added
#    to the declaration of LOC here:
LOC = $(LOCAL_ZLIB)

# Type for CPU required: 0: 8086, 1: 80186, 2: 80286, 3: 80386, etc.
CPU_TYP = 0

# Memory model: one of S, M, C, L (small, medium, compact, large)
MODEL=L

CC=cl
CFLAGS=-nologo -A$(MODEL) -G$(CPU_TYP) -W3 -Oait -Gs $(LOC)
#-Ox generates bad code with MSC 5.1
LIB_CFLAGS=-Zl $(CFLAGS)

LD=link
LDFLAGS=/noi/e/st:0x1500/noe/farcall/packcode
# "/farcall/packcode" are only useful for `large code' memory models
# but should be a "no-op" for small code models.


# variables
ZLIB_LIB = zlib_$(MODEL).lib

OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj


# targets
all:  $(ZLIB_LIB) example.exe minigzip.exe

.c.obj:
	$(CC) -c $(LIB_CFLAGS) $*.c

adler32.obj: adler32.c zlib.h zconf.h

compress.obj: compress.c zlib.h zconf.h

crc32.obj: crc32.c zlib.h zconf.h crc32.h

deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h

gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h

gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h

gzread.obj: gzread.c zlib.h zconf.h gzguts.h

gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h

infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h

inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h

trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h

uncompr.obj: uncompr.c zlib.h zconf.h

zutil.obj: zutil.c zutil.h zlib.h zconf.h

example.obj: test/example.c zlib.h zconf.h
	$(CC) -c $(CFLAGS) $*.c

minigzip.obj: test/minigzip.c zlib.h zconf.h
	$(CC) -c $(CFLAGS) $*.c


# the command line is cut to fit in the MS-DOS 128 byte limit:
$(ZLIB_LIB): $(OBJ1) $(OBJ2)
	if exist $(ZLIB_LIB) del $(ZLIB_LIB)
	lib $(ZLIB_LIB) $(OBJ1);
	lib $(ZLIB_LIB) $(OBJ2);

example.exe: example.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) example.obj,,,$(ZLIB_LIB);

minigzip.exe: minigzip.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) minigzip.obj,,,$(ZLIB_LIB);

test: example.exe minigzip.exe
	example
	echo hello world | minigzip | minigzip -d

clean:
	-del *.obj
	-del *.lib
	-del *.exe
	-del *.map
	-del zlib_*.bak
	-del foo.gz

Deleted compat/zlib/msdos/Makefile.tc.

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




































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# Turbo C 2.01, Turbo C++ 1.01
# Last updated: 15-Mar-2003

# To use, do "make -fmakefile.tc"
# To compile in small model, set below: MODEL=s

# WARNING: the small model is supported but only for small values of
# MAX_WBITS and MAX_MEM_LEVEL. For example:
#    -DMAX_WBITS=11 -DMAX_MEM_LEVEL=3
# If you wish to reduce the memory requirements (default 256K for big
# objects plus a few K), you can add to CFLAGS below:
#   -DMAX_MEM_LEVEL=7 -DMAX_WBITS=14
# See zconf.h for details about the memory requirements.

# ------------ Turbo C 2.01, Turbo C++ 1.01 ------------
MODEL=l
CC=tcc
LD=tcc
AR=tlib
# CFLAGS=-O2 -G -Z -m$(MODEL) -DMAX_WBITS=11 -DMAX_MEM_LEVEL=3
CFLAGS=-O2 -G -Z -m$(MODEL)
LDFLAGS=-m$(MODEL) -f-


# variables
ZLIB_LIB = zlib_$(MODEL).lib

OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj


# targets
all: $(ZLIB_LIB) example.exe minigzip.exe

.c.obj:
	$(CC) -c $(CFLAGS) $*.c

adler32.obj: adler32.c zlib.h zconf.h

compress.obj: compress.c zlib.h zconf.h

crc32.obj: crc32.c zlib.h zconf.h crc32.h

deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h

gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h

gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h

gzread.obj: gzread.c zlib.h zconf.h gzguts.h

gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h

infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h

inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h

trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h

uncompr.obj: uncompr.c zlib.h zconf.h

zutil.obj: zutil.c zutil.h zlib.h zconf.h

example.obj: test/example.c zlib.h zconf.h

minigzip.obj: test/minigzip.c zlib.h zconf.h


# the command line is cut to fit in the MS-DOS 128 byte limit:
$(ZLIB_LIB): $(OBJ1) $(OBJ2)
	-del $(ZLIB_LIB)
	$(AR) $(ZLIB_LIB) $(OBJP1)
	$(AR) $(ZLIB_LIB) $(OBJP2)

example.exe: example.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)

minigzip.exe: minigzip.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)

test: example.exe minigzip.exe
	example
	echo hello world | minigzip | minigzip -d

clean:
	-del *.obj
	-del *.lib
	-del *.exe
	-del zlib_*.bak
	-del foo.gz

Deleted compat/zlib/nintendods/Makefile.

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






























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#---------------------------------------------------------------------------------
.SUFFIXES:
#---------------------------------------------------------------------------------

ifeq ($(strip $(DEVKITARM)),)
$(error "Please set DEVKITARM in your environment. export DEVKITARM=<path to>devkitARM")
endif

include $(DEVKITARM)/ds_rules

#---------------------------------------------------------------------------------
# TARGET is the name of the output
# BUILD is the directory where object files & intermediate files will be placed
# SOURCES is a list of directories containing source code
# DATA is a list of directories containing data files
# INCLUDES is a list of directories containing header files
#---------------------------------------------------------------------------------
TARGET		:=	$(shell basename $(CURDIR))
BUILD		:=	build
SOURCES		:=	../../
DATA		:=	data
INCLUDES	:=	include

#---------------------------------------------------------------------------------
# options for code generation
#---------------------------------------------------------------------------------
ARCH	:=	-mthumb -mthumb-interwork

CFLAGS	:=	-Wall -O2\
		-march=armv5te -mtune=arm946e-s \
		-fomit-frame-pointer -ffast-math \
		$(ARCH)

CFLAGS	+=	$(INCLUDE) -DARM9
CXXFLAGS	:= $(CFLAGS) -fno-rtti -fno-exceptions

ASFLAGS	:=	$(ARCH) -march=armv5te -mtune=arm946e-s
LDFLAGS	=	-specs=ds_arm9.specs -g $(ARCH) -Wl,-Map,$(notdir $*.map)

#---------------------------------------------------------------------------------
# list of directories containing libraries, this must be the top level containing
# include and lib
#---------------------------------------------------------------------------------
LIBDIRS	:=	$(LIBNDS)

#---------------------------------------------------------------------------------
# no real need to edit anything past this point unless you need to add additional
# rules for different file extensions
#---------------------------------------------------------------------------------
ifneq ($(BUILD),$(notdir $(CURDIR)))
#---------------------------------------------------------------------------------

export OUTPUT	:=	$(CURDIR)/lib/libz.a

export VPATH	:=	$(foreach dir,$(SOURCES),$(CURDIR)/$(dir)) \
			$(foreach dir,$(DATA),$(CURDIR)/$(dir))

export DEPSDIR	:=	$(CURDIR)/$(BUILD)

CFILES		:=	$(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.c)))
CPPFILES	:=	$(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.cpp)))
SFILES		:=	$(foreach dir,$(SOURCES),$(notdir $(wildcard $(dir)/*.s)))
BINFILES	:=	$(foreach dir,$(DATA),$(notdir $(wildcard $(dir)/*.*)))

#---------------------------------------------------------------------------------
# use CXX for linking C++ projects, CC for standard C
#---------------------------------------------------------------------------------
ifeq ($(strip $(CPPFILES)),)
#---------------------------------------------------------------------------------
	export LD	:=	$(CC)
#---------------------------------------------------------------------------------
else
#---------------------------------------------------------------------------------
	export LD	:=	$(CXX)
#---------------------------------------------------------------------------------
endif
#---------------------------------------------------------------------------------

export OFILES	:=	$(addsuffix .o,$(BINFILES)) \
			$(CPPFILES:.cpp=.o) $(CFILES:.c=.o) $(SFILES:.s=.o)

export INCLUDE	:=	$(foreach dir,$(INCLUDES),-I$(CURDIR)/$(dir)) \
			$(foreach dir,$(LIBDIRS),-I$(dir)/include) \
			-I$(CURDIR)/$(BUILD)

.PHONY: $(BUILD) clean all

#---------------------------------------------------------------------------------
all: $(BUILD)
	@[ -d $@ ] || mkdir -p include
	@cp ../../*.h include

lib:
	@[ -d $@ ] || mkdir -p $@
	
$(BUILD): lib
	@[ -d $@ ] || mkdir -p $@
	@$(MAKE) --no-print-directory -C $(BUILD) -f $(CURDIR)/Makefile

#---------------------------------------------------------------------------------
clean:
	@echo clean ...
	@rm -fr $(BUILD) lib

#---------------------------------------------------------------------------------
else

DEPENDS	:=	$(OFILES:.o=.d)

#---------------------------------------------------------------------------------
# main targets
#---------------------------------------------------------------------------------
$(OUTPUT)	:	$(OFILES)

#---------------------------------------------------------------------------------
%.bin.o	:	%.bin
#---------------------------------------------------------------------------------
	@echo $(notdir $<)
	@$(bin2o)


-include $(DEPENDS)

#---------------------------------------------------------------------------------------
endif
#---------------------------------------------------------------------------------------

Deleted compat/zlib/nintendods/README.

1
2
3
4
5





-
-
-
-
-
This Makefile requires devkitARM (http://www.devkitpro.org/category/devkitarm/) and works inside "contrib/nds". It is based on a devkitARM template.

Eduardo Costa <eduardo.m.costa@gmail.com>
January 3, 2009

Deleted compat/zlib/old/Makefile.emx.

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





































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib.  Modified for emx/rsxnt by Chr. Spieler, 6/16/98.
# Copyright (C) 1995-1998 Jean-loup Gailly.
# For conditions of distribution and use, see copyright notice in zlib.h

# To compile, or to compile and test, type:
#
#   make -fmakefile.emx;  make test -fmakefile.emx
#

CC=gcc -Zwin32

#CFLAGS=-MMD -O
#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
#CFLAGS=-MMD -g -DZLIB_DEBUG
CFLAGS=-MMD -O3 $(BUTT) -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
             -Wstrict-prototypes -Wmissing-prototypes

# If cp.exe is available, replace "copy /Y" with "cp -fp" .
CP=copy /Y
# If gnu install.exe is available, replace $(CP) with ginstall.
INSTALL=$(CP)
# The default value of RM is "rm -f."  If "rm.exe" is found, comment out:
RM=del
LDLIBS=-L. -lzlib
LD=$(CC) -s -o
LDSHARED=$(CC)

INCL=zlib.h zconf.h
LIBS=zlib.a

AR=ar rcs

prefix=/usr/local
exec_prefix = $(prefix)

OBJS = adler32.o compress.o crc32.o deflate.o gzclose.o gzlib.o gzread.o \
       gzwrite.o infback.o inffast.o inflate.o inftrees.o trees.o uncompr.o zutil.o

TEST_OBJS = example.o minigzip.o

all: example.exe minigzip.exe

test: all
	./example
	echo hello world | .\minigzip | .\minigzip -d

%.o : %.c
	$(CC) $(CFLAGS) -c $< -o $@

zlib.a: $(OBJS)
	$(AR) $@ $(OBJS)

%.exe : %.o $(LIBS)
	$(LD) $@ $< $(LDLIBS)


.PHONY : clean

clean:
	$(RM) *.d
	$(RM) *.o
	$(RM) *.exe
	$(RM) zlib.a
	$(RM) foo.gz

DEPS := $(wildcard *.d)
ifneq ($(DEPS),)
include $(DEPS)
endif

Deleted compat/zlib/old/Makefile.riscos.

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























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Project:   zlib_1_03
# Patched for zlib 1.1.2 rw@shadow.org.uk 19980430
# test works out-of-the-box, installs `somewhere' on demand

# Toolflags:
CCflags = -c -depend !Depend -IC: -g -throwback  -DRISCOS  -fah
C++flags = -c -depend !Depend -IC: -throwback
Linkflags = -aif -c++ -o $@
ObjAsmflags = -throwback -NoCache -depend !Depend
CMHGflags =
LibFileflags = -c -l -o $@
Squeezeflags = -o $@

# change the line below to where _you_ want the library installed.
libdest = lib:zlib

# Final targets:
@.lib:   @.o.adler32 @.o.compress @.o.crc32 @.o.deflate @.o.gzio \
        @.o.infblock @.o.infcodes @.o.inffast @.o.inflate @.o.inftrees @.o.infutil @.o.trees \
        @.o.uncompr @.o.zutil
        LibFile $(LibFileflags) @.o.adler32 @.o.compress @.o.crc32 @.o.deflate \
        @.o.gzio @.o.infblock @.o.infcodes @.o.inffast @.o.inflate @.o.inftrees @.o.infutil \
        @.o.trees @.o.uncompr @.o.zutil
test:   @.minigzip @.example @.lib
	@copy @.lib @.libc  A~C~DF~L~N~P~Q~RS~TV
	@echo running tests: hang on.
	@/@.minigzip -f -9 libc
	@/@.minigzip -d libc-gz
	@/@.minigzip -f -1 libc
	@/@.minigzip -d libc-gz
	@/@.minigzip -h -9 libc
	@/@.minigzip -d libc-gz
	@/@.minigzip -h -1 libc
	@/@.minigzip -d libc-gz
	@/@.minigzip -9 libc
	@/@.minigzip -d libc-gz
	@/@.minigzip -1 libc
	@/@.minigzip -d libc-gz
	@diff @.lib @.libc
	@echo that should have reported '@.lib and @.libc identical' if you have diff.
	@/@.example @.fred @.fred
	@echo that will have given lots of hello!'s.

@.minigzip:   @.o.minigzip @.lib C:o.Stubs
        Link $(Linkflags) @.o.minigzip @.lib C:o.Stubs
@.example:   @.o.example @.lib C:o.Stubs
        Link $(Linkflags) @.o.example @.lib C:o.Stubs

install: @.lib
	cdir $(libdest)
	cdir $(libdest).h
	@copy @.h.zlib $(libdest).h.zlib A~C~DF~L~N~P~Q~RS~TV
	@copy @.h.zconf $(libdest).h.zconf A~C~DF~L~N~P~Q~RS~TV
	@copy @.lib $(libdest).lib  A~C~DF~L~N~P~Q~RS~TV
	@echo okay, installed zlib in $(libdest)

clean:; remove @.minigzip
	remove @.example
	remove @.libc
	-wipe @.o.* F~r~cV
	remove @.fred

# User-editable dependencies:
.c.o:
        cc $(ccflags) -o $@ $<

# Static dependencies:

# Dynamic dependencies:
o.example:	c.example
o.example:	h.zlib
o.example:	h.zconf
o.minigzip:	c.minigzip
o.minigzip:	h.zlib
o.minigzip:	h.zconf
o.adler32:	c.adler32
o.adler32:	h.zlib
o.adler32:	h.zconf
o.compress:	c.compress
o.compress:	h.zlib
o.compress:	h.zconf
o.crc32:	c.crc32
o.crc32:	h.zlib
o.crc32:	h.zconf
o.deflate:	c.deflate
o.deflate:	h.deflate
o.deflate:	h.zutil
o.deflate:	h.zlib
o.deflate:	h.zconf
o.gzio:	c.gzio
o.gzio:	h.zutil
o.gzio:	h.zlib
o.gzio:	h.zconf
o.infblock:	c.infblock
o.infblock:	h.zutil
o.infblock:	h.zlib
o.infblock:	h.zconf
o.infblock:	h.infblock
o.infblock:	h.inftrees
o.infblock:	h.infcodes
o.infblock:	h.infutil
o.infcodes:	c.infcodes
o.infcodes:	h.zutil
o.infcodes:	h.zlib
o.infcodes:	h.zconf
o.infcodes:	h.inftrees
o.infcodes:	h.infblock
o.infcodes:	h.infcodes
o.infcodes:	h.infutil
o.infcodes:	h.inffast
o.inffast:	c.inffast
o.inffast:	h.zutil
o.inffast:	h.zlib
o.inffast:	h.zconf
o.inffast:	h.inftrees
o.inffast:	h.infblock
o.inffast:	h.infcodes
o.inffast:	h.infutil
o.inffast:	h.inffast
o.inflate:	c.inflate
o.inflate:	h.zutil
o.inflate:	h.zlib
o.inflate:	h.zconf
o.inflate:	h.infblock
o.inftrees:	c.inftrees
o.inftrees:	h.zutil
o.inftrees:	h.zlib
o.inftrees:	h.zconf
o.inftrees:	h.inftrees
o.inftrees:	h.inffixed
o.infutil:	c.infutil
o.infutil:	h.zutil
o.infutil:	h.zlib
o.infutil:	h.zconf
o.infutil:	h.infblock
o.infutil:	h.inftrees
o.infutil:	h.infcodes
o.infutil:	h.infutil
o.trees:	c.trees
o.trees:	h.deflate
o.trees:	h.zutil
o.trees:	h.zlib
o.trees:	h.zconf
o.trees:	h.trees
o.uncompr:	c.uncompr
o.uncompr:	h.zlib
o.uncompr:	h.zconf
o.zutil:	c.zutil
o.zutil:	h.zutil
o.zutil:	h.zlib
o.zutil:	h.zconf

Deleted compat/zlib/old/README.

1
2
3



-
-
-
This directory contains files that have not been updated for zlib 1.2.x

(Volunteers are encouraged to help clean this up.  Thanks.)

Deleted compat/zlib/old/descrip.mms.

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
















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# descrip.mms: MMS description file for building zlib on VMS
# written by Martin P.J. Zinser <m.zinser@gsi.de>

cc_defs =
c_deb =

.ifdef __DECC__
pref = /prefix=all
.endif

OBJS = adler32.obj, compress.obj, crc32.obj, gzio.obj, uncompr.obj,\
       deflate.obj, trees.obj, zutil.obj, inflate.obj, infblock.obj,\
       inftrees.obj, infcodes.obj, infutil.obj, inffast.obj

CFLAGS= $(C_DEB) $(CC_DEFS) $(PREF)

all : example.exe minigzip.exe
        @ write sys$output " Example applications available"
libz.olb : libz.olb($(OBJS))
	@ write sys$output " libz available"

example.exe : example.obj libz.olb
              link example,libz.olb/lib

minigzip.exe : minigzip.obj libz.olb
              link minigzip,libz.olb/lib,x11vms:xvmsutils.olb/lib

clean :
	delete *.obj;*,libz.olb;*


# Other dependencies.
adler32.obj : zutil.h zlib.h zconf.h
compress.obj : zlib.h zconf.h
crc32.obj : zutil.h zlib.h zconf.h
deflate.obj : deflate.h zutil.h zlib.h zconf.h
example.obj : zlib.h zconf.h
gzio.obj : zutil.h zlib.h zconf.h
infblock.obj : zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.h
infcodes.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h infcodes.h inffast.h
inffast.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h inffast.h
inflate.obj : zutil.h zlib.h zconf.h infblock.h
inftrees.obj : zutil.h zlib.h zconf.h inftrees.h
infutil.obj : zutil.h zlib.h zconf.h inftrees.h infutil.h
minigzip.obj : zlib.h zconf.h
trees.obj : deflate.h zutil.h zlib.h zconf.h
uncompr.obj : zlib.h zconf.h
zutil.obj : zutil.h zlib.h zconf.h

Deleted compat/zlib/old/os2/Makefile.os2.

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








































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib under OS/2 using GCC (PGCC)
# For conditions of distribution and use, see copyright notice in zlib.h

# To compile and test, type:
#   cp Makefile.os2 ..
#   cd ..
#   make -f Makefile.os2 test

# This makefile will build a static library z.lib, a shared library
# z.dll and a import library zdll.lib. You can use either z.lib or
# zdll.lib by specifying either -lz or -lzdll on gcc's command line

CC=gcc -Zomf -s

CFLAGS=-O6 -Wall
#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
#CFLAGS=-g -DZLIB_DEBUG
#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
#           -Wstrict-prototypes -Wmissing-prototypes

#################### BUG WARNING: #####################
## infcodes.c hits a bug in pgcc-1.0, so you have to use either
## -O# where # <= 4 or one of (-fno-ommit-frame-pointer or -fno-force-mem)
## This bug is reportedly fixed in pgcc >1.0, but this was not tested
CFLAGS+=-fno-force-mem

LDFLAGS=-s -L. -lzdll -Zcrtdll
LDSHARED=$(CC) -s -Zomf -Zdll -Zcrtdll

VER=1.1.0
ZLIB=z.lib
SHAREDLIB=z.dll
SHAREDLIBIMP=zdll.lib
LIBS=$(ZLIB) $(SHAREDLIB) $(SHAREDLIBIMP)

AR=emxomfar cr
IMPLIB=emximp
RANLIB=echo
TAR=tar
SHELL=bash

prefix=/usr/local
exec_prefix = $(prefix)

OBJS = adler32.o compress.o crc32.o gzio.o uncompr.o deflate.o trees.o \
       zutil.o inflate.o infblock.o inftrees.o infcodes.o infutil.o inffast.o

TEST_OBJS = example.o minigzip.o

DISTFILES = README INDEX ChangeLog configure Make*[a-z0-9] *.[ch] descrip.mms \
  algorithm.txt zlib.3 msdos/Make*[a-z0-9] msdos/zlib.def msdos/zlib.rc \
  nt/Makefile.nt nt/zlib.dnt  contrib/README.contrib contrib/*.txt \
  contrib/asm386/*.asm contrib/asm386/*.c \
  contrib/asm386/*.bat contrib/asm386/zlibvc.d?? contrib/iostream/*.cpp \
  contrib/iostream/*.h  contrib/iostream2/*.h contrib/iostream2/*.cpp \
  contrib/untgz/Makefile contrib/untgz/*.c contrib/untgz/*.w32

all: example.exe minigzip.exe

test: all
	@LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ; export LD_LIBRARY_PATH; \
	echo hello world | ./minigzip | ./minigzip -d || \
	  echo '		*** minigzip test FAILED ***' ; \
	if ./example; then \
	  echo '		*** zlib test OK ***'; \
	else \
	  echo '		*** zlib test FAILED ***'; \
	fi

$(ZLIB): $(OBJS)
	$(AR) $@ $(OBJS)
	-@ ($(RANLIB) $@ || true) >/dev/null 2>&1

$(SHAREDLIB): $(OBJS) os2/z.def
	$(LDSHARED) -o $@ $^

$(SHAREDLIBIMP): os2/z.def
	$(IMPLIB) -o $@ $^

example.exe: example.o $(LIBS)
	$(CC) $(CFLAGS) -o $@ example.o $(LDFLAGS)

minigzip.exe: minigzip.o $(LIBS)
	$(CC) $(CFLAGS) -o $@ minigzip.o $(LDFLAGS)

clean:
	rm -f *.o *~ example minigzip libz.a libz.so* foo.gz

distclean:	clean

zip:
	mv Makefile Makefile~; cp -p Makefile.in Makefile
	rm -f test.c ztest*.c
	v=`sed -n -e 's/\.//g' -e '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\
	zip -ul9 zlib$$v $(DISTFILES)
	mv Makefile~ Makefile

dist:
	mv Makefile Makefile~; cp -p Makefile.in Makefile
	rm -f test.c ztest*.c
	d=zlib-`sed -n '/VERSION "/s/.*"\(.*\)".*/\1/p' < zlib.h`;\
	rm -f $$d.tar.gz; \
	if test ! -d ../$$d; then rm -f ../$$d; ln -s `pwd` ../$$d; fi; \
	files=""; \
	for f in $(DISTFILES); do files="$$files $$d/$$f"; done; \
	cd ..; \
	GZIP=-9 $(TAR) chofz $$d/$$d.tar.gz $$files; \
	if test ! -d $$d; then rm -f $$d; fi
	mv Makefile~ Makefile

tags:
	etags *.[ch]

depend:
	makedepend -- $(CFLAGS) -- *.[ch]

# DO NOT DELETE THIS LINE -- make depend depends on it.

adler32.o: zlib.h zconf.h
compress.o: zlib.h zconf.h
crc32.o: zlib.h zconf.h
deflate.o: deflate.h zutil.h zlib.h zconf.h
example.o: zlib.h zconf.h
gzio.o: zutil.h zlib.h zconf.h
infblock.o: infblock.h inftrees.h infcodes.h infutil.h zutil.h zlib.h zconf.h
infcodes.o: zutil.h zlib.h zconf.h
infcodes.o: inftrees.h infblock.h infcodes.h infutil.h inffast.h
inffast.o: zutil.h zlib.h zconf.h inftrees.h
inffast.o: infblock.h infcodes.h infutil.h inffast.h
inflate.o: zutil.h zlib.h zconf.h infblock.h
inftrees.o: zutil.h zlib.h zconf.h inftrees.h
infutil.o: zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.h
minigzip.o: zlib.h zconf.h
trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
uncompr.o: zlib.h zconf.h
zutil.o: zutil.h zlib.h zconf.h

Deleted compat/zlib/old/os2/zlib.def.

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



















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
;
; Slightly modified version of ../nt/zlib.dnt :-)
;

LIBRARY		Z
DESCRIPTION	"Zlib compression library for OS/2"
CODE		PRELOAD MOVEABLE DISCARDABLE
DATA		PRELOAD MOVEABLE MULTIPLE

EXPORTS
    adler32
    compress
    crc32
    deflate
    deflateCopy
    deflateEnd
    deflateInit2_
    deflateInit_
    deflateParams
    deflateReset
    deflateSetDictionary
    gzclose
    gzdopen
    gzerror
    gzflush
    gzopen
    gzread
    gzwrite
    inflate
    inflateEnd
    inflateInit2_
    inflateInit_
    inflateReset
    inflateSetDictionary
    inflateSync
    uncompress
    zlibVersion
    gzprintf
    gzputc
    gzgetc
    gzseek
    gzrewind
    gztell
    gzeof
    gzsetparams
    zError
    inflateSyncPoint
    get_crc_table
    compress2
    gzputs
    gzgets

Deleted compat/zlib/old/visual-basic.txt.

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
































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
See below some functions declarations for Visual Basic.

Frequently Asked Question:

Q: Each time I use the compress function I get the -5 error (not enough
   room in the output buffer).

A: Make sure that the length of the compressed buffer is passed by
   reference ("as any"), not by value ("as long"). Also check that
   before the call of compress this length is equal to the total size of
   the compressed buffer and not zero.


From: "Jon Caruana" <jon-net@usa.net>
Subject: Re: How to port zlib declares to vb?
Date: Mon, 28 Oct 1996 18:33:03 -0600

Got the answer! (I haven't had time to check this but it's what I got, and
looks correct):

He has the following routines working:
        compress
        uncompress
        gzopen
        gzwrite
        gzread
        gzclose

Declares follow: (Quoted from Carlos Rios <c_rios@sonda.cl>, in Vb4 form)

#If Win16 Then   'Use Win16 calls.
Declare Function compress Lib "ZLIB.DLL" (ByVal compr As
        String, comprLen As Any, ByVal buf As String, ByVal buflen
        As Long) As Integer
Declare Function uncompress Lib "ZLIB.DLL" (ByVal uncompr
        As String, uncomprLen As Any, ByVal compr As String, ByVal
        lcompr As Long) As Integer
Declare Function gzopen Lib "ZLIB.DLL" (ByVal filePath As
        String, ByVal mode As String) As Long
Declare Function gzread Lib "ZLIB.DLL" (ByVal file As
        Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
        As Integer
Declare Function gzwrite Lib "ZLIB.DLL" (ByVal file As
        Long, ByVal uncompr As String, ByVal uncomprLen As Integer)
        As Integer
Declare Function gzclose Lib "ZLIB.DLL" (ByVal file As
        Long) As Integer
#Else
Declare Function compress Lib "ZLIB32.DLL"
        (ByVal compr As String, comprLen As Any, ByVal buf As
        String, ByVal buflen As Long) As Integer
Declare Function uncompress Lib "ZLIB32.DLL"
        (ByVal uncompr As String, uncomprLen As Any, ByVal compr As
        String, ByVal lcompr As Long) As Long
Declare Function gzopen Lib "ZLIB32.DLL"
        (ByVal file As String, ByVal mode As String) As Long
Declare Function gzread Lib "ZLIB32.DLL"
        (ByVal file As Long, ByVal uncompr As String, ByVal
        uncomprLen As Long) As Long
Declare Function gzwrite Lib "ZLIB32.DLL"
        (ByVal file As Long, ByVal uncompr As String, ByVal
        uncomprLen As Long) As Long
Declare Function gzclose Lib "ZLIB32.DLL"
        (ByVal file As Long) As Long
#End If

-Jon Caruana
jon-net@usa.net
Microsoft Sitebuilder Network Level 1 Member - HTML Writer's Guild Member


Here is another example from Michael <michael_borgsys@hotmail.com> that he
says conforms to the VB guidelines, and that solves the problem of not
knowing the uncompressed size by storing it at the end of the file:

'Calling the functions:
'bracket meaning: <parameter> [optional] {Range of possible values}
'Call subCompressFile(<path with filename to compress> [, <path with
filename to write to>, [level of compression {1..9}]])
'Call subUncompressFile(<path with filename to compress>)

Option Explicit
Private lngpvtPcnSml As Long 'Stores value for 'lngPercentSmaller'
Private Const SUCCESS As Long = 0
Private Const strFilExt As String = ".cpr"
Private Declare Function lngfncCpr Lib "zlib.dll" Alias "compress2" (ByRef
dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long,
ByVal level As Integer) As Long
Private Declare Function lngfncUcp Lib "zlib.dll" Alias "uncompress" (ByRef
dest As Any, ByRef destLen As Any, ByRef src As Any, ByVal srcLen As Long)
As Long

Public Sub subCompressFile(ByVal strargOriFilPth As String, Optional ByVal
strargCprFilPth As String, Optional ByVal intLvl As Integer = 9)
    Dim strCprPth As String
    Dim lngOriSiz As Long
    Dim lngCprSiz As Long
    Dim bytaryOri() As Byte
    Dim bytaryCpr() As Byte
    lngOriSiz = FileLen(strargOriFilPth)
    ReDim bytaryOri(lngOriSiz - 1)
    Open strargOriFilPth For Binary Access Read As #1
        Get #1, , bytaryOri()
    Close #1
    strCprPth = IIf(strargCprFilPth = "", strargOriFilPth, strargCprFilPth)
'Select file path and name
    strCprPth = strCprPth & IIf(Right(strCprPth, Len(strFilExt)) =
strFilExt, "", strFilExt) 'Add file extension if not exists
    lngCprSiz = (lngOriSiz * 1.01) + 12 'Compression needs temporary a bit
more space then original file size
    ReDim bytaryCpr(lngCprSiz - 1)
    If lngfncCpr(bytaryCpr(0), lngCprSiz, bytaryOri(0), lngOriSiz, intLvl) =
SUCCESS Then
        lngpvtPcnSml = (1# - (lngCprSiz / lngOriSiz)) * 100
        ReDim Preserve bytaryCpr(lngCprSiz - 1)
        Open strCprPth For Binary Access Write As #1
            Put #1, , bytaryCpr()
            Put #1, , lngOriSiz 'Add the the original size value to the end
(last 4 bytes)
        Close #1
    Else
        MsgBox "Compression error"
    End If
    Erase bytaryCpr
    Erase bytaryOri
End Sub

Public Sub subUncompressFile(ByVal strargFilPth As String)
    Dim bytaryCpr() As Byte
    Dim bytaryOri() As Byte
    Dim lngOriSiz As Long
    Dim lngCprSiz As Long
    Dim strOriPth As String
    lngCprSiz = FileLen(strargFilPth)
    ReDim bytaryCpr(lngCprSiz - 1)
    Open strargFilPth For Binary Access Read As #1
        Get #1, , bytaryCpr()
    Close #1
    'Read the original file size value:
    lngOriSiz = bytaryCpr(lngCprSiz - 1) * (2 ^ 24) _
              + bytaryCpr(lngCprSiz - 2) * (2 ^ 16) _
              + bytaryCpr(lngCprSiz - 3) * (2 ^ 8) _
              + bytaryCpr(lngCprSiz - 4)
    ReDim Preserve bytaryCpr(lngCprSiz - 5) 'Cut of the original size value
    ReDim bytaryOri(lngOriSiz - 1)
    If lngfncUcp(bytaryOri(0), lngOriSiz, bytaryCpr(0), lngCprSiz) = SUCCESS
Then
        strOriPth = Left(strargFilPth, Len(strargFilPth) - Len(strFilExt))
        Open strOriPth For Binary Access Write As #1
            Put #1, , bytaryOri()
        Close #1
    Else
        MsgBox "Uncompression error"
    End If
    Erase bytaryCpr
    Erase bytaryOri
End Sub
Public Property Get lngPercentSmaller() As Long
    lngPercentSmaller = lngpvtPcnSml
End Property

Deleted compat/zlib/os400/README400.

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
















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
        ZLIB version 1.2.11 for OS/400 installation instructions

1) Download and unpack the zlib tarball to some IFS directory.
   (i.e.: /path/to/the/zlib/ifs/source/directory)

   If the installed IFS command suppors gzip format, this is straightforward,
else you have to unpack first to some directory on a system supporting it,
then move the whole directory to the IFS via the network (via SMB or FTP).

2) Edit the configuration parameters in the compilation script.

        EDTF STMF('/path/to/the/zlib/ifs/source/directory/os400/make.sh')

Tune the parameters according to your needs if not matching the defaults.
Save the file and exit after edition.

3) Enter qshell, then work in the zlib OS/400 specific directory.

        QSH
        cd /path/to/the/zlib/ifs/source/directory/os400

4) Compile and install

        sh make.sh

The script will:
- create the libraries, objects and IFS directories for the zlib environment,
- compile all modules,
- create a service program,
- create a static and a dynamic binding directory,
- install header files for C/C++ and for ILE/RPG, both for compilation in
  DB2 and IFS environments.

That's all. 


Notes:  For OS/400 ILE RPG programmers, a /copy member defining the ZLIB
                API prototypes for ILE RPG can be found in ZLIB/H(ZLIB.INC).
                In the ILE environment, the same definitions are available from
                file zlib.inc located in the same IFS include directory as the
                C/C++ header files.
                Please read comments in this member for more information.

        Remember that most foreign textual data are ASCII coded: this
                implementation does not handle conversion from/to ASCII, so
                text data code conversions must be done explicitely.

        Mainly for the reason above, always open zipped files in binary mode.

Deleted compat/zlib/os400/bndsrc.

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























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
STRPGMEXP PGMLVL(*CURRENT) SIGNATURE('ZLIB')

/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*   Version 1.1.3 entry points.                                    */
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/

  EXPORT SYMBOL("adler32")
  EXPORT SYMBOL("compress")
  EXPORT SYMBOL("compress2")
  EXPORT SYMBOL("crc32")
  EXPORT SYMBOL("get_crc_table")
  EXPORT SYMBOL("deflate")
  EXPORT SYMBOL("deflateEnd")
  EXPORT SYMBOL("deflateSetDictionary")
  EXPORT SYMBOL("deflateCopy")
  EXPORT SYMBOL("deflateReset")
  EXPORT SYMBOL("deflateParams")
  EXPORT SYMBOL("deflatePrime")
  EXPORT SYMBOL("deflateInit_")
  EXPORT SYMBOL("deflateInit2_")
  EXPORT SYMBOL("gzopen")
  EXPORT SYMBOL("gzdopen")
  EXPORT SYMBOL("gzsetparams")
  EXPORT SYMBOL("gzread")
  EXPORT SYMBOL("gzwrite")
  EXPORT SYMBOL("gzprintf")
  EXPORT SYMBOL("gzputs")
  EXPORT SYMBOL("gzgets")
  EXPORT SYMBOL("gzputc")
  EXPORT SYMBOL("gzgetc")
  EXPORT SYMBOL("gzflush")
  EXPORT SYMBOL("gzseek")
  EXPORT SYMBOL("gzrewind")
  EXPORT SYMBOL("gztell")
  EXPORT SYMBOL("gzeof")
  EXPORT SYMBOL("gzclose")
  EXPORT SYMBOL("gzerror")
  EXPORT SYMBOL("inflate")
  EXPORT SYMBOL("inflateEnd")
  EXPORT SYMBOL("inflateSetDictionary")
  EXPORT SYMBOL("inflateSync")
  EXPORT SYMBOL("inflateReset")
  EXPORT SYMBOL("inflateInit_")
  EXPORT SYMBOL("inflateInit2_")
  EXPORT SYMBOL("inflateSyncPoint")
  EXPORT SYMBOL("uncompress")
  EXPORT SYMBOL("zlibVersion")
  EXPORT SYMBOL("zError")
  EXPORT SYMBOL("z_errmsg")

/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*   Version 1.2.1 additional entry points.                         */
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/

  EXPORT SYMBOL("compressBound")
  EXPORT SYMBOL("deflateBound")
  EXPORT SYMBOL("deflatePending")
  EXPORT SYMBOL("gzungetc")
  EXPORT SYMBOL("gzclearerr")
  EXPORT SYMBOL("inflateBack")
  EXPORT SYMBOL("inflateBackEnd")
  EXPORT SYMBOL("inflateBackInit_")
  EXPORT SYMBOL("inflateCopy")
  EXPORT SYMBOL("zlibCompileFlags")

/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*   Version 1.2.4 additional entry points.                         */
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/

  EXPORT SYMBOL("adler32_combine")
  EXPORT SYMBOL("adler32_combine64")
  EXPORT SYMBOL("crc32_combine")
  EXPORT SYMBOL("crc32_combine64")
  EXPORT SYMBOL("deflateSetHeader")
  EXPORT SYMBOL("deflateTune")
  EXPORT SYMBOL("gzbuffer")
  EXPORT SYMBOL("gzclose_r")
  EXPORT SYMBOL("gzclose_w")
  EXPORT SYMBOL("gzdirect")
  EXPORT SYMBOL("gzoffset")
  EXPORT SYMBOL("gzoffset64")
  EXPORT SYMBOL("gzopen64")
  EXPORT SYMBOL("gzseek64")
  EXPORT SYMBOL("gztell64")
  EXPORT SYMBOL("inflateGetHeader")
  EXPORT SYMBOL("inflateMark")
  EXPORT SYMBOL("inflatePrime")
  EXPORT SYMBOL("inflateReset2")
  EXPORT SYMBOL("inflateUndermine")

/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*   Version 1.2.6 additional entry points.                         */
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/

  EXPORT SYMBOL("deflateResetKeep")
  EXPORT SYMBOL("gzgetc_")
  EXPORT SYMBOL("inflateResetKeep")

/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*   Version 1.2.8 additional entry points.                         */
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/

  EXPORT SYMBOL("gzvprintf")
  EXPORT SYMBOL("inflateGetDictionary")

/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/
/*   Version 1.2.9 additional entry points.                         */
/*@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*/

  EXPORT SYMBOL("adler32_z")
  EXPORT SYMBOL("crc32_z")
  EXPORT SYMBOL("deflateGetDictionary")
  EXPORT SYMBOL("gzfread")
  EXPORT SYMBOL("gzfwrite")
  EXPORT SYMBOL("inflateCodesUsed")
  EXPORT SYMBOL("inflateValidate")
  EXPORT SYMBOL("uncompress2")

ENDPGMEXP

Deleted compat/zlib/os400/make.sh.

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
363
364
365
366














































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#!/bin/sh
#
#       ZLIB compilation script for the OS/400.
#
#
#       This is a shell script since make is not a standard component of OS/400.


################################################################################
#
#                       Tunable configuration parameters.
#
################################################################################

TARGETLIB='ZLIB'                # Target OS/400 program library
STATBNDDIR='ZLIB_A'             # Static binding directory.
DYNBNDDIR='ZLIB'                # Dynamic binding directory.
SRVPGM="ZLIB"                   # Service program.
IFSDIR='/zlib'                  # IFS support base directory.
TGTCCSID='500'                  # Target CCSID of objects
DEBUG='*NONE'                   # Debug level
OPTIMIZE='40'                   # Optimisation level
OUTPUT='*NONE'                  # Compilation output option.
TGTRLS='V6R1M0'                 # Target OS release

export TARGETLIB STATBNDDIR DYNBNDDIR SRVPGM IFSDIR
export TGTCCSID DEBUG OPTIMIZE OUTPUT TGTRLS


################################################################################
#
#                       OS/400 specific definitions.
#
################################################################################

LIBIFSNAME="/QSYS.LIB/${TARGETLIB}.LIB"


################################################################################
#
#                               Procedures.
#
################################################################################

#       action_needed dest [src]
#
#       dest is an object to build
#       if specified, src is an object on which dest depends.
#
#       exit 0 (succeeds) if some action has to be taken, else 1.

action_needed()

{
        [ ! -e "${1}" ] && return 0
        [ "${2}" ] || return 1
        [ "${1}" -ot "${2}" ] && return 0
        return 1
}


#       make_module module_name source_name [additional_definitions]
#
#       Compile source name into module if needed.
#       As side effect, append the module name to variable MODULES.
#       Set LINK to "YES" if the module has been compiled.

make_module()

{
    MODULES="${MODULES} ${1}"
    MODIFSNAME="${LIBIFSNAME}/${1}.MODULE"
    CSRC="`basename \"${2}\"`"

    if action_needed "${MODIFSNAME}" "${2}"
    then    :
    elif [ ! "`sed -e \"/<source name=\\\"${CSRC}\\\">/,/<\\\\/source>/!d\" \
      -e '/<depend /!d'                                                 \
      -e 's/.* name=\"\\([^\"]*\\)\".*/\\1/' < \"${TOPDIR}/treebuild.xml\" |
        while read HDR
        do      if action_needed \"${MODIFSNAME}\" \"${IFSDIR}/include/${HDR}\"
                then    echo recompile
                        break
                fi
        done`" ]
    then    return 0
    fi

    CMD="CRTCMOD MODULE(${TARGETLIB}/${1}) SRCSTMF('${2}')"
    CMD="${CMD} SYSIFCOPT(*IFS64IO) OPTION(*INCDIRFIRST)"
    CMD="${CMD} LOCALETYPE(*LOCALE) FLAG(10)"
    CMD="${CMD} INCDIR('${IFSDIR}/include' ${INCLUDES})"
    CMD="${CMD} TGTCCSID(${TGTCCSID}) TGTRLS(${TGTRLS})"
    CMD="${CMD} OUTPUT(${OUTPUT})"
    CMD="${CMD} OPTIMIZE(${OPTIMIZE})"
    CMD="${CMD} DBGVIEW(${DEBUG})"
    system "${CMD}"
    LINK=YES
}


#       Determine DB2 object name from IFS name.

db2_name()

{
        basename "${1}"                                                 |
        tr 'a-z-' 'A-Z_'                                                |
        sed -e 's/\..*//'                                               \
            -e 's/^\(.\).*\(.........\)$/\1\2/'
}


#       Force enumeration types to be the same size as integers.

copy_hfile()

{
        sed -e '1i\
#pragma enum(int)\
' "${@}" -e '$a\
#pragma enum(pop)\
'
}


################################################################################
#
#                             Script initialization.
#
################################################################################

SCRIPTDIR=`dirname "${0}"`

case "${SCRIPTDIR}" in
/*)     ;;
*)      SCRIPTDIR="`pwd`/${SCRIPTDIR}"
esac

while true
do      case "${SCRIPTDIR}" in
        */.)    SCRIPTDIR="${SCRIPTDIR%/.}";;
        *)      break;;
        esac
done

#  The script directory is supposed to be in ${TOPDIR}/os400.

TOPDIR=`dirname "${SCRIPTDIR}"`
export SCRIPTDIR TOPDIR
cd "${TOPDIR}"


#  Extract the version from the master compilation XML file.

VERSION=`sed -e '/^<package /!d'                                        \
            -e 's/^.* version="\([0-9.]*\)".*$/\1/' -e 'q'              \
            < treebuild.xml`
export VERSION

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


#       Create the OS/400 library if it does not exist.

if action_needed "${LIBIFSNAME}"
then    CMD="CRTLIB LIB(${TARGETLIB}) TEXT('ZLIB: Data compression API')"
        system "${CMD}"
fi


#       Create the DOCS source file if it does not exist.

if action_needed "${LIBIFSNAME}/DOCS.FILE"
then    CMD="CRTSRCPF FILE(${TARGETLIB}/DOCS) RCDLEN(112)"
        CMD="${CMD} CCSID(${TGTCCSID}) TEXT('Documentation texts')"
        system "${CMD}"
fi

#       Copy some documentation files if needed.

for TEXT in "${TOPDIR}/ChangeLog" "${TOPDIR}/FAQ"                       \
    "${TOPDIR}/README" "${SCRIPTDIR}/README400"
do      MEMBER="${LIBIFSNAME}/DOCS.FILE/`db2_name \"${TEXT}\"`.MBR"

        if action_needed "${MEMBER}" "${TEXT}"
        then    CMD="CPY OBJ('${TEXT}') TOOBJ('${MEMBER}') TOCCSID(${TGTCCSID})"
                CMD="${CMD} DTAFMT(*TEXT) REPLACE(*YES)"
                system "${CMD}"
        fi
done


#       Create the OS/400 source program file for the C header files.

SRCPF="${LIBIFSNAME}/H.FILE"

if action_needed "${SRCPF}"
then    CMD="CRTSRCPF FILE(${TARGETLIB}/H) RCDLEN(112)"
        CMD="${CMD} CCSID(${TGTCCSID}) TEXT('ZLIB: C/C++ header files')"
        system "${CMD}"
fi


#       Create the IFS directory for the C header files.

if action_needed "${IFSDIR}/include"
then    mkdir -p "${IFSDIR}/include"
fi

#       Copy the header files to DB2 library. Link from IFS include directory.

for HFILE in "${TOPDIR}/"*.h
do      DEST="${SRCPF}/`db2_name \"${HFILE}\"`.MBR"

        if action_needed "${DEST}" "${HFILE}"
        then    copy_hfile < "${HFILE}" > tmphdrfile

                #       Need to translate to target CCSID.

                CMD="CPY OBJ('`pwd`/tmphdrfile') TOOBJ('${DEST}')"
                CMD="${CMD} TOCCSID(${TGTCCSID}) DTAFMT(*TEXT) REPLACE(*YES)"
                system "${CMD}"
                # touch -r "${HFILE}" "${DEST}"
                rm -f tmphdrfile
        fi

        IFSFILE="${IFSDIR}/include/`basename \"${HFILE}\"`"

        if action_needed "${IFSFILE}" "${DEST}"
        then    rm -f "${IFSFILE}"
                ln -s "${DEST}" "${IFSFILE}"
        fi
done


#       Install the ILE/RPG header file.


HFILE="${SCRIPTDIR}/zlib.inc"
DEST="${SRCPF}/ZLIB.INC.MBR"

if action_needed "${DEST}" "${HFILE}"
then    CMD="CPY OBJ('${HFILE}') TOOBJ('${DEST}')"
        CMD="${CMD} TOCCSID(${TGTCCSID}) DTAFMT(*TEXT) REPLACE(*YES)"
        system "${CMD}"
        # touch -r "${HFILE}" "${DEST}"
fi

IFSFILE="${IFSDIR}/include/`basename \"${HFILE}\"`"

if action_needed "${IFSFILE}" "${DEST}"
then    rm -f "${IFSFILE}"
        ln -s "${DEST}" "${IFSFILE}"
fi


#      Create and compile the identification source file.

echo '#pragma comment(user, "ZLIB version '"${VERSION}"'")' > os400.c
echo '#pragma comment(user, __DATE__)' >> os400.c
echo '#pragma comment(user, __TIME__)' >> os400.c
echo '#pragma comment(copyright, "Copyright (C) 1995-2017 Jean-Loup Gailly, Mark Adler. OS/400 version by P. Monnerat.")' >> os400.c
make_module     OS400           os400.c
LINK=                           # No need to rebuild service program yet.
MODULES=


#       Get source list.

CSOURCES=`sed -e '/<source name="/!d'                                   \
    -e 's/.* name="\([^"]*\)".*/\1/' < treebuild.xml`

#       Compile the sources into modules.

for SRC in ${CSOURCES}
do      MODULE=`db2_name "${SRC}"`
        make_module "${MODULE}" "${SRC}"
done


#       If needed, (re)create the static binding directory.

if action_needed "${LIBIFSNAME}/${STATBNDDIR}.BNDDIR"
then    LINK=YES
fi

if [ "${LINK}" ]
then    rm -rf "${LIBIFSNAME}/${STATBNDDIR}.BNDDIR"
        CMD="CRTBNDDIR BNDDIR(${TARGETLIB}/${STATBNDDIR})"
        CMD="${CMD} TEXT('ZLIB static binding directory')"
        system "${CMD}"

        for MODULE in ${MODULES}
        do      CMD="ADDBNDDIRE BNDDIR(${TARGETLIB}/${STATBNDDIR})"
                CMD="${CMD} OBJ((${TARGETLIB}/${MODULE} *MODULE))"
                system "${CMD}"
        done
fi


#       The exportation file for service program creation must be in a DB2
#               source file, so make sure it exists.

if action_needed "${LIBIFSNAME}/TOOLS.FILE"
then    CMD="CRTSRCPF FILE(${TARGETLIB}/TOOLS) RCDLEN(112)"
        CMD="${CMD} CCSID(${TGTCCSID}) TEXT('ZLIB: build tools')"
        system "${CMD}"
fi


DEST="${LIBIFSNAME}/TOOLS.FILE/BNDSRC.MBR"

if action_needed "${SCRIPTDIR}/bndsrc" "${DEST}"
then    CMD="CPY OBJ('${SCRIPTDIR}/bndsrc') TOOBJ('${DEST}')"
        CMD="${CMD} TOCCSID(${TGTCCSID}) DTAFMT(*TEXT) REPLACE(*YES)"
        system "${CMD}"
        # touch -r "${SCRIPTDIR}/bndsrc" "${DEST}"
        LINK=YES
fi


#       Build the service program if needed.

if action_needed "${LIBIFSNAME}/${SRVPGM}.SRVPGM"
then    LINK=YES
fi

if [ "${LINK}" ]
then    CMD="CRTSRVPGM SRVPGM(${TARGETLIB}/${SRVPGM})"
        CMD="${CMD} SRCFILE(${TARGETLIB}/TOOLS) SRCMBR(BNDSRC)"
        CMD="${CMD} MODULE(${TARGETLIB}/OS400)"
        CMD="${CMD} BNDDIR(${TARGETLIB}/${STATBNDDIR})"
        CMD="${CMD} TEXT('ZLIB ${VERSION} dynamic library')"
        CMD="${CMD} TGTRLS(${TGTRLS})"
        system "${CMD}"
        LINK=YES

        #       Duplicate the service program for a versioned backup.

        BACKUP=`echo "${SRVPGM}${VERSION}"                              |
                sed -e 's/.*\(..........\)$/\1/' -e 's/\./_/g'`
        BACKUP="`db2_name \"${BACKUP}\"`"
        BKUPIFSNAME="${LIBIFSNAME}/${BACKUP}.SRVPGM"
        rm -f "${BKUPIFSNAME}"
        CMD="CRTDUPOBJ OBJ(${SRVPGM}) FROMLIB(${TARGETLIB})"
        CMD="${CMD} OBJTYPE(*SRVPGM) NEWOBJ(${BACKUP})"
        system "${CMD}"
fi


#       If needed, (re)create the dynamic binding directory.

if action_needed "${LIBIFSNAME}/${DYNBNDDIR}.BNDDIR"
then    LINK=YES
fi

if [ "${LINK}" ]
then    rm -rf "${LIBIFSNAME}/${DYNBNDDIR}.BNDDIR"
        CMD="CRTBNDDIR BNDDIR(${TARGETLIB}/${DYNBNDDIR})"
        CMD="${CMD} TEXT('ZLIB dynamic binding directory')"
        system "${CMD}"
        CMD="ADDBNDDIRE BNDDIR(${TARGETLIB}/${DYNBNDDIR})"
        CMD="${CMD} OBJ((*LIBL/${SRVPGM} *SRVPGM))"
        system "${CMD}"
fi

Deleted compat/zlib/os400/zlib.inc.

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
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
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
524
525
526
527















































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
      *  ZLIB.INC - Interface to the general purpose compression library
      *
      *  ILE RPG400 version by Patrick Monnerat, DATASPHERE.
      *  Version 1.2.11
      *
      *
      *  WARNING:
      *     Procedures inflateInit(), inflateInit2(), deflateInit(),
      *         deflateInit2() and inflateBackInit() need to be called with
      *         two additional arguments:
      *         the package version string and the stream control structure.
      *         size. This is needed because RPG lacks some macro feature.
      *         Call these procedures as:
      *             inflateInit(...: ZLIB_VERSION: %size(z_stream))
      *
      /if not defined(ZLIB_H_)
      /define ZLIB_H_
      *
      **************************************************************************
      *                               Constants
      **************************************************************************
      *
      *  Versioning information.
      *
     D ZLIB_VERSION    C                   '1.2.11'
     D ZLIB_VERNUM     C                   X'12a0'
     D ZLIB_VER_MAJOR  C                   1
     D ZLIB_VER_MINOR  C                   2
     D ZLIB_VER_REVISION...
     D                 C                   11
     D ZLIB_VER_SUBREVISION...
     D                 C                   0
      *
      *  Other equates.
      *
     D Z_NO_FLUSH      C                   0
     D Z_PARTIAL_FLUSH...
     D                 C                   1
     D Z_SYNC_FLUSH    C                   2
     D Z_FULL_FLUSH    C                   3
     D Z_FINISH        C                   4
     D Z_BLOCK         C                   5
     D Z_TREES         C                   6
      *
     D Z_OK            C                   0
     D Z_STREAM_END    C                   1
     D Z_NEED_DICT     C                   2
     D Z_ERRNO         C                   -1
     D Z_STREAM_ERROR  C                   -2
     D Z_DATA_ERROR    C                   -3
     D Z_MEM_ERROR     C                   -4
     D Z_BUF_ERROR     C                   -5
     D Z_VERSION_ERROR C                   -6
      *
     D Z_NO_COMPRESSION...
     D                 C                   0
     D Z_BEST_SPEED    C                   1
     D Z_BEST_COMPRESSION...
     D                 C                   9
     D Z_DEFAULT_COMPRESSION...
     D                 C                   -1
      *
     D Z_FILTERED      C                   1
     D Z_HUFFMAN_ONLY  C                   2
     D Z_RLE           C                   3
     D Z_DEFAULT_STRATEGY...
     D                 C                   0
      *
     D Z_BINARY        C                   0
     D Z_ASCII         C                   1
     D Z_UNKNOWN       C                   2
      *
     D Z_DEFLATED      C                   8
      *
     D Z_NULL          C                   0
      *
      **************************************************************************
      *                                 Types
      **************************************************************************
      *
     D z_streamp       S               *                                        Stream struct ptr
     D gzFile          S               *                                        File pointer
     D gz_headerp      S               *
     D z_off_t         S             10i 0                                      Stream offsets
     D z_off64_t       S             20i 0                                      Stream offsets
      *
      **************************************************************************
      *                               Structures
      **************************************************************************
      *
      *  The GZIP encode/decode stream support structure.
      *
     D z_stream        DS                  align based(z_streamp)
     D  zs_next_in                     *                                        Next input byte
     D  zs_avail_in                  10U 0                                      Byte cnt at next_in
     D  zs_total_in                  10U 0                                      Total bytes read
     D  zs_next_out                    *                                        Output buffer ptr
     D  zs_avail_out                 10U 0                                      Room left @ next_out
     D  zs_total_out                 10U 0                                      Total bytes written
     D  zs_msg                         *                                        Last errmsg or null
     D  zs_state                       *                                        Internal state
     D  zs_zalloc                      *   procptr                              Int. state allocator
     D  zs_free                        *   procptr                              Int. state dealloc.
     D  zs_opaque                      *                                        Private alloc. data
     D  zs_data_type                 10i 0                                      ASC/BIN best guess
     D  zs_adler                     10u 0                                      Uncompr. adler32 val
     D                               10U 0                                      Reserved
     D                               10U 0                                      Ptr. alignment
      *
      **************************************************************************
      *                     Utility function prototypes
      **************************************************************************
      *
     D compress        PR            10I 0 extproc('compress')
     D  dest                      65535    options(*varsize)                    Destination buffer
     D  destLen                      10U 0                                      Destination length
     D  source                    65535    const options(*varsize)              Source buffer
     D  sourceLen                    10u 0 value                                Source length
      *
     D compress2       PR            10I 0 extproc('compress2')
     D  dest                      65535    options(*varsize)                    Destination buffer
     D  destLen                      10U 0                                      Destination length
     D  source                    65535    const options(*varsize)              Source buffer
     D  sourceLen                    10U 0 value                                Source length
     D  level                        10I 0 value                                Compression level
      *
     D compressBound   PR            10U 0 extproc('compressBound')
     D  sourceLen                    10U 0 value
      *
     D uncompress      PR            10I 0 extproc('uncompress')
     D  dest                      65535    options(*varsize)                    Destination buffer
     D  destLen                      10U 0                                      Destination length
     D  source                    65535    const options(*varsize)              Source buffer
     D  sourceLen                    10U 0 value                                Source length
      *
     D uncompress2     PR            10I 0 extproc('uncompress2')
     D  dest                      65535    options(*varsize)                    Destination buffer
     D  destLen                      10U 0                                      Destination length
     D  source                    65535    const options(*varsize)              Source buffer
     D  sourceLen                    10U 0                                      Source length
      *
      /if not defined(LARGE_FILES)
     D gzopen          PR                  extproc('gzopen')
     D                                     like(gzFile)
     D  path                           *   value options(*string)               File pathname
     D  mode                           *   value options(*string)               Open mode
      /else
     D gzopen          PR                  extproc('gzopen64')
     D                                     like(gzFile)
     D  path                           *   value options(*string)               File pathname
     D  mode                           *   value options(*string)               Open mode
      *
     D gzopen64        PR                  extproc('gzopen64')
     D                                     like(gzFile)
     D  path                           *   value options(*string)               File pathname
     D  mode                           *   value options(*string)               Open mode
      /endif
      *
     D gzdopen         PR                  extproc('gzdopen')
     D                                     like(gzFile)
     D  fd                           10I 0 value                                File descriptor
     D  mode                           *   value options(*string)               Open mode
      *
     D gzbuffer        PR            10I 0 extproc('gzbuffer')
     D  file                               value like(gzFile)                   File pointer
     D  size                         10U 0 value
      *
     D gzsetparams     PR            10I 0 extproc('gzsetparams')
     D  file                               value like(gzFile)                   File pointer
     D  level                        10I 0 value
     D  strategy                     10I 0 value
      *
     D gzread          PR            10I 0 extproc('gzread')
     D  file                               value like(gzFile)                   File pointer
     D  buf                       65535    options(*varsize)                    Buffer
     D  len                          10u 0 value                                Buffer length
      *
     D gzfread          PR           20I 0 extproc('gzfread')
     D  buf                       65535    options(*varsize)                    Buffer
     D  size                         20u 0 value                                Buffer length
     D  nitems                       20u 0 value                                Buffer length
     D  file                               value like(gzFile)                   File pointer
      *
     D gzwrite         PR            10I 0 extproc('gzwrite')
     D  file                               value like(gzFile)                   File pointer
     D  buf                       65535    const options(*varsize)              Buffer
     D  len                          10u 0 value                                Buffer length
      *
     D gzfwrite         PR           20I 0 extproc('gzfwrite')
     D  buf                       65535    options(*varsize)                    Buffer
     D  size                         20u 0 value                                Buffer length
     D  nitems                       20u 0 value                                Buffer length
     D  file                               value like(gzFile)                   File pointer
      *
     D gzputs          PR            10I 0 extproc('gzputs')
     D  file                               value like(gzFile)                   File pointer
     D  s                              *   value options(*string)               String to output
      *
     D gzgets          PR              *   extproc('gzgets')
     D  file                               value like(gzFile)                   File pointer
     D  buf                       65535    options(*varsize)                    Read buffer
     D  len                          10i 0 value                                Buffer length
      *
     D gzputc          PR            10i 0 extproc('gzputc')
     D  file                               value like(gzFile)                   File pointer
     D  c                            10I 0 value                                Character to write
      *
     D gzgetc          PR            10i 0 extproc('gzgetc')
     D  file                               value like(gzFile)                   File pointer
      *
     D gzgetc_         PR            10i 0 extproc('gzgetc_')
     D  file                               value like(gzFile)                   File pointer
      *
     D gzungetc        PR            10i 0 extproc('gzungetc')
     D  c                            10I 0 value                                Character to push
     D  file                               value like(gzFile)                   File pointer
      *
     D gzflush         PR            10i 0 extproc('gzflush')
     D  file                               value like(gzFile)                   File pointer
     D  flush                        10I 0 value                                Type of flush
      *
      /if not defined(LARGE_FILES)
     D gzseek          PR                  extproc('gzseek')
     D                                     like(z_off_t)
     D  file                               value like(gzFile)                   File pointer
     D  offset                             value like(z_off_t)                  Offset
     D  whence                       10i 0 value                                Origin
      /else
     D gzseek          PR                  extproc('gzseek64')
     D                                     like(z_off_t)
     D  file                               value like(gzFile)                   File pointer
     D  offset                             value like(z_off_t)                  Offset
     D  whence                       10i 0 value                                Origin
      *
     D gzseek64        PR                  extproc('gzseek64')
     D                                     like(z_off64_t)
     D  file                               value like(gzFile)                   File pointer
     D  offset                             value like(z_off64_t)                Offset
     D  whence                       10i 0 value                                Origin
      /endif
      *
     D gzrewind        PR            10i 0 extproc('gzrewind')
     D  file                               value like(gzFile)                   File pointer
      *
      /if not defined(LARGE_FILES)
     D gztell          PR                  extproc('gztell')
     D                                     like(z_off_t)
     D  file                               value like(gzFile)                   File pointer
      /else
     D gztell          PR                  extproc('gztell64')
     D                                     like(z_off_t)
     D  file                               value like(gzFile)                   File pointer
      *
     D gztell64        PR                  extproc('gztell64')
     D                                     like(z_off64_t)
     D  file                               value like(gzFile)                   File pointer
      /endif
      *
      /if not defined(LARGE_FILES)
     D gzoffset        PR                  extproc('gzoffset')
     D                                     like(z_off_t)
     D  file                               value like(gzFile)                   File pointer
      /else
     D gzoffset        PR                  extproc('gzoffset64')
     D                                     like(z_off_t)
     D  file                               value like(gzFile)                   File pointer
      *
     D gzoffset64      PR                  extproc('gzoffset64')
     D                                     like(z_off64_t)
     D  file                               value like(gzFile)                   File pointer
      /endif
      *
     D gzeof           PR            10i 0 extproc('gzeof')
     D  file                               value like(gzFile)                   File pointer
      *
     D gzdirect        PR            10i 0 extproc('gzdirect')
     D  file                               value like(gzFile)                   File pointer
      *
     D gzclose_r       PR            10i 0 extproc('gzclose_r')
     D  file                               value like(gzFile)                   File pointer
      *
     D gzclose_w       PR            10i 0 extproc('gzclose_w')
     D  file                               value like(gzFile)                   File pointer
      *
     D gzclose         PR            10i 0 extproc('gzclose')
     D  file                               value like(gzFile)                   File pointer
      *
     D gzerror         PR              *   extproc('gzerror')                   Error string
     D  file                               value like(gzFile)                   File pointer
     D  errnum                       10I 0                                      Error code
      *
     D gzclearerr      PR                  extproc('gzclearerr')
     D  file                               value like(gzFile)                   File pointer
      *
      **************************************************************************
      *                        Basic function prototypes
      **************************************************************************
      *
     D zlibVersion     PR              *   extproc('zlibVersion')               Version string
      *
     D deflateInit     PR            10I 0 extproc('deflateInit_')              Init. compression
     D  strm                               like(z_stream)                       Compression stream
     D  level                        10I 0 value                                Compression level
     D  version                        *   value options(*string)               Version string
     D  stream_size                  10i 0 value                                Stream struct. size
      *
     D deflate         PR            10I 0 extproc('deflate')                   Compress data
     D  strm                               like(z_stream)                       Compression stream
     D  flush                        10I 0 value                                Flush type required
      *
     D deflateEnd      PR            10I 0 extproc('deflateEnd')                Termin. compression
     D  strm                               like(z_stream)                       Compression stream
      *
     D inflateInit     PR            10I 0 extproc('inflateInit_')              Init. expansion
     D  strm                               like(z_stream)                       Expansion stream
     D  version                        *   value options(*string)               Version string
     D  stream_size                  10i 0 value                                Stream struct. size
      *
     D inflate         PR            10I 0 extproc('inflate')                   Expand data
     D  strm                               like(z_stream)                       Expansion stream
     D  flush                        10I 0 value                                Flush type required
      *
     D inflateEnd      PR            10I 0 extproc('inflateEnd')                Termin. expansion
     D  strm                               like(z_stream)                       Expansion stream
      *
      **************************************************************************
      *                        Advanced function prototypes
      **************************************************************************
      *
     D deflateInit2    PR            10I 0 extproc('deflateInit2_')             Init. compression
     D  strm                               like(z_stream)                       Compression stream
     D  level                        10I 0 value                                Compression level
     D  method                       10I 0 value                                Compression method
     D  windowBits                   10I 0 value                                log2(window size)
     D  memLevel                     10I 0 value                                Mem/cmpress tradeoff
     D  strategy                     10I 0 value                                Compression strategy
     D  version                        *   value options(*string)               Version string
     D  stream_size                  10i 0 value                                Stream struct. size
      *
     D deflateSetDictionary...
     D                 PR            10I 0 extproc('deflateSetDictionary')      Init. dictionary
     D  strm                               like(z_stream)                       Compression stream
     D  dictionary                65535    const options(*varsize)              Dictionary bytes
     D  dictLength                   10U 0 value                                Dictionary length
      *
     D deflateCopy     PR            10I 0 extproc('deflateCopy')               Compress strm 2 strm
     D  dest                               like(z_stream)                       Destination stream
     D  source                             like(z_stream)                       Source stream
      *
     D deflateReset    PR            10I 0 extproc('deflateReset')              End and init. stream
     D  strm                               like(z_stream)                       Compression stream
      *
     D deflateParams   PR            10I 0 extproc('deflateParams')             Change level & strat
     D  strm                               like(z_stream)                       Compression stream
     D  level                        10I 0 value                                Compression level
     D  strategy                     10I 0 value                                Compression strategy
      *
     D deflateTune     PR            10I 0 extproc('deflateTune')
     D  strm                               like(z_stream)                       Compression stream
     D  good                         10I 0 value
     D  lazy                         10I 0 value
     D  nice                         10I 0 value
     D  chain                        10I 0 value
      *
     D deflateBound    PR            10U 0 extproc('deflateBound')              Change level & strat
     D  strm                               like(z_stream)                       Compression stream
     D  sourcelen                    10U 0 value                                Compression level
      *
     D deflatePending  PR            10I 0 extproc('deflatePending')            Change level & strat
     D  strm                               like(z_stream)                       Compression stream
     D  pending                      10U 0                                      Pending bytes
     D  bits                         10I 0                                      Pending bits
      *
     D deflatePrime    PR            10I 0 extproc('deflatePrime')              Change level & strat
     D  strm                               like(z_stream)                       Compression stream
     D  bits                         10I 0 value                                # of bits to insert
     D  value                        10I 0 value                                Bits to insert
      *
     D inflateInit2    PR            10I 0 extproc('inflateInit2_')             Init. expansion
     D  strm                               like(z_stream)                       Expansion stream
     D  windowBits                   10I 0 value                                log2(window size)
     D  version                        *   value options(*string)               Version string
     D  stream_size                  10i 0 value                                Stream struct. size
      *
     D inflateSetDictionary...
     D                 PR            10I 0 extproc('inflateSetDictionary')      Init. dictionary
     D  strm                               like(z_stream)                       Expansion stream
     D  dictionary                65535    const options(*varsize)              Dictionary bytes
     D  dictLength                   10U 0 value                                Dictionary length
      *
     D inflateGetDictionary...
     D                 PR            10I 0 extproc('inflateGetDictionary')      Get dictionary
     D  strm                               like(z_stream)                       Expansion stream
     D  dictionary                65535    options(*varsize)                    Dictionary bytes
     D  dictLength                   10U 0                                      Dictionary length
      *
     D deflateGetDictionary...
     D                 PR            10I 0 extproc('deflateGetDictionary')      Get dictionary
     D  strm                               like(z_stream)                       Expansion stream
     D  dictionary                65535    options(*varsize)                    Dictionary bytes
     D  dictLength                   10U 0                                      Dictionary length
      *
     D inflateSync     PR            10I 0 extproc('inflateSync')               Sync. expansion
     D  strm                               like(z_stream)                       Expansion stream
      *
     D inflateCopy     PR            10I 0 extproc('inflateCopy')
     D  dest                               like(z_stream)                       Destination stream
     D  source                             like(z_stream)                       Source stream
      *
     D inflateReset    PR            10I 0 extproc('inflateReset')              End and init. stream
     D  strm                               like(z_stream)                       Expansion stream
      *
     D inflateReset2   PR            10I 0 extproc('inflateReset2')             End and init. stream
     D  strm                               like(z_stream)                       Expansion stream
     D  windowBits                   10I 0 value                                Log2(buffer size)
      *
     D inflatePrime    PR            10I 0 extproc('inflatePrime')              Insert bits
     D  strm                               like(z_stream)                       Expansion stream
     D  bits                         10I 0 value                                Bit count
     D  value                        10I 0 value                                Bits to insert
      *
     D inflateMark     PR            10I 0 extproc('inflateMark')               Get inflate info
     D  strm                               like(z_stream)                       Expansion stream
      *
     D inflateCodesUsed...
                       PR            20U 0 extproc('inflateCodesUsed')
     D  strm                               like(z_stream)                       Expansion stream
      *
     D inflateValidate...
                       PR            20U 0 extproc('inflateValidate')
     D  strm                               like(z_stream)                       Expansion stream
     D  check                        10I 0 value
      *
     D inflateGetHeader...
                       PR            10U 0 extproc('inflateGetHeader')
     D  strm                               like(z_stream)                       Expansion stream
     D  head                               like(gz_headerp)
      *
     D deflateSetHeader...
                       PR            10U 0 extproc('deflateSetHeader')
     D  strm                               like(z_stream)                       Expansion stream
     D  head                               like(gz_headerp)
      *
     D inflateBackInit...
     D                 PR            10I 0 extproc('inflateBackInit_')
     D  strm                               like(z_stream)                       Expansion stream
     D  windowBits                   10I 0 value                                Log2(buffer size)
     D  window                    65535    options(*varsize)                    Buffer
     D  version                        *   value options(*string)               Version string
     D  stream_size                  10i 0 value                                Stream struct. size
      *
     D inflateBack     PR            10I 0 extproc('inflateBack')
     D  strm                               like(z_stream)                       Expansion stream
     D  in                             *   value procptr                        Input function
     D  in_desc                        *   value                                Input descriptor
     D  out                            *   value procptr                        Output function
     D  out_desc                       *   value                                Output descriptor
      *
     D inflateBackEnd  PR            10I 0 extproc('inflateBackEnd')
     D  strm                               like(z_stream)                       Expansion stream
      *
     D zlibCompileFlags...
     D                 PR            10U 0 extproc('zlibCompileFlags')
      *
      **************************************************************************
      *                        Checksum function prototypes
      **************************************************************************
      *
     D adler32         PR            10U 0 extproc('adler32')                   New checksum
     D  adler                        10U 0 value                                Old checksum
     D  buf                       65535    const options(*varsize)              Bytes to accumulate
     D  len                          10U 0 value                                Buffer length
      *
     D adler32_combine...
                       PR            10U 0 extproc('adler32_combine')           New checksum
     D  adler1                       10U 0 value                                Old checksum
     D  adler2                       10U 0 value                                Old checksum
     D  len2                         20U 0 value                                Buffer length
      *
     D adler32_z       PR            10U 0 extproc('adler32_z')                 New checksum
     D  adler                        10U 0 value                                Old checksum
     D  buf                       65535    const options(*varsize)              Bytes to accumulate
     D  len                          20U 0 value                                Buffer length
      *
     D crc32           PR            10U 0 extproc('crc32')                     New checksum
     D  crc                          10U 0 value                                Old checksum
     D  buf                       65535    const options(*varsize)              Bytes to accumulate
     D  len                          10U 0 value                                Buffer length
      *
     D crc32_combine...
                       PR            10U 0 extproc('crc32_combine')             New checksum
     D  crc1                         10U 0 value                                Old checksum
     D  crc2                         10U 0 value                                Old checksum
     D  len2                         20U 0 value                                Buffer length
      *
     D crc32_z         PR            10U 0 extproc('crc32_z')                   New checksum
     D  crc                          10U 0 value                                Old checksum
     D  buf                       65535    const options(*varsize)              Bytes to accumulate
     D  len                          20U 0 value                                Buffer length
      *
      **************************************************************************
      *                     Miscellaneous function prototypes
      **************************************************************************
      *
     D zError          PR              *   extproc('zError')                    Error string
     D  err                          10I 0 value                                Error code
      *
     D inflateSyncPoint...
     D                 PR            10I 0 extproc('inflateSyncPoint')
     D  strm                               like(z_stream)                       Expansion stream
      *
     D get_crc_table   PR              *   extproc('get_crc_table')             Ptr to ulongs
      *
     D inflateUndermine...
     D                 PR            10I 0 extproc('inflateUndermine')
     D  strm                               like(z_stream)                       Expansion stream
     D  arg                          10I 0 value                                Error code
      *
     D inflateResetKeep...
     D                 PR            10I 0 extproc('inflateResetKeep')          End and init. stream
     D  strm                               like(z_stream)                       Expansion stream
      *
     D deflateResetKeep...
     D                 PR            10I 0 extproc('deflateResetKeep')          End and init. stream
     D  strm                               like(z_stream)                       Expansion stream
      *
      /endif

Deleted compat/zlib/qnx/package.qpg.

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













































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<QPG:Generation>
   <QPG:Options>
      <QPG:User unattended="no" verbosity="2" listfiles="yes"/>
      <QPG:Defaults type="qnx_package"/>
      <QPG:Source></QPG:Source>
      <QPG:Release number="+"/>
      <QPG:Build></QPG:Build>
      <QPG:FileSorting strip="yes"/>
      <QPG:Package targets="combine"/>
      <QPG:Repository generate="yes"/>
      <QPG:FinalDir></QPG:FinalDir>
      <QPG:Cleanup></QPG:Cleanup>
   </QPG:Options>

   <QPG:Responsible>
      <QPG:Company></QPG:Company>
      <QPG:Department></QPG:Department>
      <QPG:Group></QPG:Group>
      <QPG:Team></QPG:Team>
      <QPG:Employee></QPG:Employee>
      <QPG:EmailAddress></QPG:EmailAddress>
   </QPG:Responsible>

   <QPG:Values>
      <QPG:Files>
         <QPG:Add file="../zconf.h" install="/opt/include/" user="root:sys" permission="644"/>
         <QPG:Add file="../zlib.h" install="/opt/include/" user="root:sys" permission="644"/>
         <QPG:Add file="../libz.so.1.2.11" install="/opt/lib/" user="root:bin" permission="644"/>
         <QPG:Add file="libz.so" install="/opt/lib/" component="dev" filetype="symlink" linkto="libz.so.1.2.11"/>
         <QPG:Add file="libz.so.1" install="/opt/lib/" filetype="symlink" linkto="libz.so.1.2.11"/>
         <QPG:Add file="../libz.so.1.2.11" install="/opt/lib/" component="slib"/>
      </QPG:Files>

      <QPG:PackageFilter>
         <QPM:PackageManifest>
            <QPM:PackageDescription>
               <QPM:PackageType>Library</QPM:PackageType>
               <QPM:PackageReleaseNotes></QPM:PackageReleaseNotes>
               <QPM:PackageReleaseUrgency>Medium</QPM:PackageReleaseUrgency>
               <QPM:PackageRepository></QPM:PackageRepository>
               <QPM:FileVersion>2.0</QPM:FileVersion>
            </QPM:PackageDescription>

            <QPM:ProductDescription>
               <QPM:ProductName>zlib</QPM:ProductName>
               <QPM:ProductIdentifier>zlib</QPM:ProductIdentifier>
               <QPM:ProductEmail>alain.bonnefoy@icbt.com</QPM:ProductEmail>
               <QPM:VendorName>Public</QPM:VendorName>
               <QPM:VendorInstallName>public</QPM:VendorInstallName>
               <QPM:VendorURL>www.gzip.org/zlib</QPM:VendorURL>
               <QPM:VendorEmbedURL></QPM:VendorEmbedURL>
               <QPM:VendorEmail></QPM:VendorEmail>
               <QPM:AuthorName>Jean-Loup Gailly,Mark Adler</QPM:AuthorName>
               <QPM:AuthorURL>www.gzip.org/zlib</QPM:AuthorURL>
               <QPM:AuthorEmbedURL></QPM:AuthorEmbedURL>
               <QPM:AuthorEmail>zlib@gzip.org</QPM:AuthorEmail>
               <QPM:ProductIconSmall></QPM:ProductIconSmall>
               <QPM:ProductIconLarge></QPM:ProductIconLarge>
               <QPM:ProductDescriptionShort>A massively spiffy yet delicately unobtrusive compression library.</QPM:ProductDescriptionShort>
               <QPM:ProductDescriptionLong>zlib is designed to be a free, general-purpose, legally unencumbered, lossless data compression library for use on virtually any computer hardware and operating system.</QPM:ProductDescriptionLong>
               <QPM:ProductDescriptionURL>http://www.gzip.org/zlib</QPM:ProductDescriptionURL>
               <QPM:ProductDescriptionEmbedURL></QPM:ProductDescriptionEmbedURL>
            </QPM:ProductDescription>

            <QPM:ReleaseDescription>
               <QPM:ReleaseVersion>1.2.11</QPM:ReleaseVersion>
               <QPM:ReleaseUrgency>Medium</QPM:ReleaseUrgency>
               <QPM:ReleaseStability>Stable</QPM:ReleaseStability>
               <QPM:ReleaseNoteMinor></QPM:ReleaseNoteMinor>
               <QPM:ReleaseNoteMajor></QPM:ReleaseNoteMajor>
               <QPM:ExcludeCountries>
                  <QPM:Country></QPM:Country>
               </QPM:ExcludeCountries>

               <QPM:ReleaseCopyright>No License</QPM:ReleaseCopyright>
            </QPM:ReleaseDescription>

            <QPM:ContentDescription>
               <QPM:ContentTopic xmlmultiple="true">Software Development/Libraries and Extensions/C Libraries</QPM:ContentTopic>
               <QPM:ContentKeyword>zlib,compression</QPM:ContentKeyword>
               <QPM:TargetOS>qnx6</QPM:TargetOS>
               <QPM:HostOS>qnx6</QPM:HostOS>
               <QPM:DisplayEnvironment xmlmultiple="true">None</QPM:DisplayEnvironment>
               <QPM:TargetAudience xmlmultiple="true">Developer</QPM:TargetAudience>
            </QPM:ContentDescription>
         </QPM:PackageManifest>
      </QPG:PackageFilter>

      <QPG:PackageFilter proc="none" target="none">
         <QPM:PackageManifest>
            <QPM:ProductInstallationDependencies>
               <QPM:ProductRequirements></QPM:ProductRequirements>
            </QPM:ProductInstallationDependencies>

            <QPM:ProductInstallationProcedure>
               <QPM:Script xmlmultiple="true">
                  <QPM:ScriptName></QPM:ScriptName>
                  <QPM:ScriptType>Install</QPM:ScriptType>
                  <QPM:ScriptTiming>Post</QPM:ScriptTiming>
                  <QPM:ScriptBlocking>No</QPM:ScriptBlocking>
                  <QPM:ScriptResult>Ignore</QPM:ScriptResult>
                  <QPM:ShortDescription></QPM:ShortDescription>
                  <QPM:UseBinaries>No</QPM:UseBinaries>
                  <QPM:Priority>Optional</QPM:Priority>
               </QPM:Script>
            </QPM:ProductInstallationProcedure>
         </QPM:PackageManifest>

         <QPM:Launch>
         </QPM:Launch>
      </QPG:PackageFilter>

      <QPG:PackageFilter type="core" component="none">
         <QPM:PackageManifest>
            <QPM:ProductInstallationProcedure>
	       <QPM:OrderDependency xmlmultiple="true">
	          <QPM:Order>InstallOver</QPM:Order>
	          <QPM:Product>zlib</QPM:Product>
	       </QPM:OrderDependency>
            </QPM:ProductInstallationProcedure>
         </QPM:PackageManifest>

         <QPM:Launch>
         </QPM:Launch>
      </QPG:PackageFilter>

      <QPG:PackageFilter type="core" component="dev">
         <QPM:PackageManifest>
            <QPM:ProductInstallationProcedure>
	       <QPM:OrderDependency xmlmultiple="true">
	          <QPM:Order>InstallOver</QPM:Order>
	          <QPM:Product>zlib-dev</QPM:Product>
	       </QPM:OrderDependency>
            </QPM:ProductInstallationProcedure>
         </QPM:PackageManifest>

         <QPM:Launch>
         </QPM:Launch>
      </QPG:PackageFilter>
   </QPG:Values>
</QPG:Generation>

Deleted compat/zlib/test/example.c.

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


























































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* example.c -- usage example of the zlib compression library
 * Copyright (C) 1995-2006, 2011, 2016 Jean-loup Gailly
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#include "zlib.h"
#include <stdio.h>

#ifdef STDC
#  include <string.h>
#  include <stdlib.h>
#endif

#if defined(VMS) || defined(RISCOS)
#  define TESTFILE "foo-gz"
#else
#  define TESTFILE "foo.gz"
#endif

#define CHECK_ERR(err, msg) { \
    if (err != Z_OK) { \
        fprintf(stderr, "%s error: %d\n", msg, err); \
        exit(1); \
    } \
}

static z_const char hello[] = "hello, hello!";
/* "hello world" would be more standard, but the repeated "hello"
 * stresses the compression code better, sorry...
 */

static const char dictionary[] = "hello";
static uLong dictId;    /* Adler32 value of the dictionary */

void test_deflate       OF((Byte *compr, uLong comprLen));
void test_inflate       OF((Byte *compr, uLong comprLen,
                            Byte *uncompr, uLong uncomprLen));
void test_large_deflate OF((Byte *compr, uLong comprLen,
                            Byte *uncompr, uLong uncomprLen));
void test_large_inflate OF((Byte *compr, uLong comprLen,
                            Byte *uncompr, uLong uncomprLen));
void test_flush         OF((Byte *compr, uLong *comprLen));
void test_sync          OF((Byte *compr, uLong comprLen,
                            Byte *uncompr, uLong uncomprLen));
void test_dict_deflate  OF((Byte *compr, uLong comprLen));
void test_dict_inflate  OF((Byte *compr, uLong comprLen,
                            Byte *uncompr, uLong uncomprLen));
int  main               OF((int argc, char *argv[]));


#ifdef Z_SOLO

void *myalloc OF((void *, unsigned, unsigned));
void myfree OF((void *, void *));

void *myalloc(q, n, m)
    void *q;
    unsigned n, m;
{
    (void)q;
    return calloc(n, m);
}

void myfree(void *q, void *p)
{
    (void)q;
    free(p);
}

static alloc_func zalloc = myalloc;
static free_func zfree = myfree;

#else /* !Z_SOLO */

static alloc_func zalloc = (alloc_func)0;
static free_func zfree = (free_func)0;

void test_compress      OF((Byte *compr, uLong comprLen,
                            Byte *uncompr, uLong uncomprLen));
void test_gzio          OF((const char *fname,
                            Byte *uncompr, uLong uncomprLen));

/* ===========================================================================
 * Test compress() and uncompress()
 */
void test_compress(compr, comprLen, uncompr, uncomprLen)
    Byte *compr, *uncompr;
    uLong comprLen, uncomprLen;
{
    int err;
    uLong len = (uLong)strlen(hello)+1;

    err = compress(compr, &comprLen, (const Bytef*)hello, len);
    CHECK_ERR(err, "compress");

    strcpy((char*)uncompr, "garbage");

    err = uncompress(uncompr, &uncomprLen, compr, comprLen);
    CHECK_ERR(err, "uncompress");

    if (strcmp((char*)uncompr, hello)) {
        fprintf(stderr, "bad uncompress\n");
        exit(1);
    } else {
        printf("uncompress(): %s\n", (char *)uncompr);
    }
}

/* ===========================================================================
 * Test read/write of .gz files
 */
void test_gzio(fname, uncompr, uncomprLen)
    const char *fname; /* compressed file name */
    Byte *uncompr;
    uLong uncomprLen;
{
#ifdef NO_GZCOMPRESS
    fprintf(stderr, "NO_GZCOMPRESS -- gz* functions cannot compress\n");
#else
    int err;
    int len = (int)strlen(hello)+1;
    gzFile file;
    z_off_t pos;

    file = gzopen(fname, "wb");
    if (file == NULL) {
        fprintf(stderr, "gzopen error\n");
        exit(1);
    }
    gzputc(file, 'h');
    if (gzputs(file, "ello") != 4) {
        fprintf(stderr, "gzputs err: %s\n", gzerror(file, &err));
        exit(1);
    }
    if (gzprintf(file, ", %s!", "hello") != 8) {
        fprintf(stderr, "gzprintf err: %s\n", gzerror(file, &err));
        exit(1);
    }
    gzseek(file, 1L, SEEK_CUR); /* add one zero byte */
    gzclose(file);

    file = gzopen(fname, "rb");
    if (file == NULL) {
        fprintf(stderr, "gzopen error\n");
        exit(1);
    }
    strcpy((char*)uncompr, "garbage");

    if (gzread(file, uncompr, (unsigned)uncomprLen) != len) {
        fprintf(stderr, "gzread err: %s\n", gzerror(file, &err));
        exit(1);
    }
    if (strcmp((char*)uncompr, hello)) {
        fprintf(stderr, "bad gzread: %s\n", (char*)uncompr);
        exit(1);
    } else {
        printf("gzread(): %s\n", (char*)uncompr);
    }

    pos = gzseek(file, -8L, SEEK_CUR);
    if (pos != 6 || gztell(file) != pos) {
        fprintf(stderr, "gzseek error, pos=%ld, gztell=%ld\n",
                (long)pos, (long)gztell(file));
        exit(1);
    }

    if (gzgetc(file) != ' ') {
        fprintf(stderr, "gzgetc error\n");
        exit(1);
    }

    if (gzungetc(' ', file) != ' ') {
        fprintf(stderr, "gzungetc error\n");
        exit(1);
    }

    gzgets(file, (char*)uncompr, (int)uncomprLen);
    if (strlen((char*)uncompr) != 7) { /* " hello!" */
        fprintf(stderr, "gzgets err after gzseek: %s\n", gzerror(file, &err));
        exit(1);
    }
    if (strcmp((char*)uncompr, hello + 6)) {
        fprintf(stderr, "bad gzgets after gzseek\n");
        exit(1);
    } else {
        printf("gzgets() after gzseek: %s\n", (char*)uncompr);
    }

    gzclose(file);
#endif
}

#endif /* Z_SOLO */

/* ===========================================================================
 * Test deflate() with small buffers
 */
void test_deflate(compr, comprLen)
    Byte *compr;
    uLong comprLen;
{
    z_stream c_stream; /* compression stream */
    int err;
    uLong len = (uLong)strlen(hello)+1;

    c_stream.zalloc = zalloc;
    c_stream.zfree = zfree;
    c_stream.opaque = (voidpf)0;

    err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION);
    CHECK_ERR(err, "deflateInit");

    c_stream.next_in  = (z_const unsigned char *)hello;
    c_stream.next_out = compr;

    while (c_stream.total_in != len && c_stream.total_out < comprLen) {
        c_stream.avail_in = c_stream.avail_out = 1; /* force small buffers */
        err = deflate(&c_stream, Z_NO_FLUSH);
        CHECK_ERR(err, "deflate");
    }
    /* Finish the stream, still forcing small buffers: */
    for (;;) {
        c_stream.avail_out = 1;
        err = deflate(&c_stream, Z_FINISH);
        if (err == Z_STREAM_END) break;
        CHECK_ERR(err, "deflate");
    }

    err = deflateEnd(&c_stream);
    CHECK_ERR(err, "deflateEnd");
}

/* ===========================================================================
 * Test inflate() with small buffers
 */
void test_inflate(compr, comprLen, uncompr, uncomprLen)
    Byte *compr, *uncompr;
    uLong comprLen, uncomprLen;
{
    int err;
    z_stream d_stream; /* decompression stream */

    strcpy((char*)uncompr, "garbage");

    d_stream.zalloc = zalloc;
    d_stream.zfree = zfree;
    d_stream.opaque = (voidpf)0;

    d_stream.next_in  = compr;
    d_stream.avail_in = 0;
    d_stream.next_out = uncompr;

    err = inflateInit(&d_stream);
    CHECK_ERR(err, "inflateInit");

    while (d_stream.total_out < uncomprLen && d_stream.total_in < comprLen) {
        d_stream.avail_in = d_stream.avail_out = 1; /* force small buffers */
        err = inflate(&d_stream, Z_NO_FLUSH);
        if (err == Z_STREAM_END) break;
        CHECK_ERR(err, "inflate");
    }

    err = inflateEnd(&d_stream);
    CHECK_ERR(err, "inflateEnd");

    if (strcmp((char*)uncompr, hello)) {
        fprintf(stderr, "bad inflate\n");
        exit(1);
    } else {
        printf("inflate(): %s\n", (char *)uncompr);
    }
}

/* ===========================================================================
 * Test deflate() with large buffers and dynamic change of compression level
 */
void test_large_deflate(compr, comprLen, uncompr, uncomprLen)
    Byte *compr, *uncompr;
    uLong comprLen, uncomprLen;
{
    z_stream c_stream; /* compression stream */
    int err;

    c_stream.zalloc = zalloc;
    c_stream.zfree = zfree;
    c_stream.opaque = (voidpf)0;

    err = deflateInit(&c_stream, Z_BEST_SPEED);
    CHECK_ERR(err, "deflateInit");

    c_stream.next_out = compr;
    c_stream.avail_out = (uInt)comprLen;

    /* At this point, uncompr is still mostly zeroes, so it should compress
     * very well:
     */
    c_stream.next_in = uncompr;
    c_stream.avail_in = (uInt)uncomprLen;
    err = deflate(&c_stream, Z_NO_FLUSH);
    CHECK_ERR(err, "deflate");
    if (c_stream.avail_in != 0) {
        fprintf(stderr, "deflate not greedy\n");
        exit(1);
    }

    /* Feed in already compressed data and switch to no compression: */
    deflateParams(&c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY);
    c_stream.next_in = compr;
    c_stream.avail_in = (uInt)comprLen/2;
    err = deflate(&c_stream, Z_NO_FLUSH);
    CHECK_ERR(err, "deflate");

    /* Switch back to compressing mode: */
    deflateParams(&c_stream, Z_BEST_COMPRESSION, Z_FILTERED);
    c_stream.next_in = uncompr;
    c_stream.avail_in = (uInt)uncomprLen;
    err = deflate(&c_stream, Z_NO_FLUSH);
    CHECK_ERR(err, "deflate");

    err = deflate(&c_stream, Z_FINISH);
    if (err != Z_STREAM_END) {
        fprintf(stderr, "deflate should report Z_STREAM_END\n");
        exit(1);
    }
    err = deflateEnd(&c_stream);
    CHECK_ERR(err, "deflateEnd");
}

/* ===========================================================================
 * Test inflate() with large buffers
 */
void test_large_inflate(compr, comprLen, uncompr, uncomprLen)
    Byte *compr, *uncompr;
    uLong comprLen, uncomprLen;
{
    int err;
    z_stream d_stream; /* decompression stream */

    strcpy((char*)uncompr, "garbage");

    d_stream.zalloc = zalloc;
    d_stream.zfree = zfree;
    d_stream.opaque = (voidpf)0;

    d_stream.next_in  = compr;
    d_stream.avail_in = (uInt)comprLen;

    err = inflateInit(&d_stream);
    CHECK_ERR(err, "inflateInit");

    for (;;) {
        d_stream.next_out = uncompr;            /* discard the output */
        d_stream.avail_out = (uInt)uncomprLen;
        err = inflate(&d_stream, Z_NO_FLUSH);
        if (err == Z_STREAM_END) break;
        CHECK_ERR(err, "large inflate");
    }

    err = inflateEnd(&d_stream);
    CHECK_ERR(err, "inflateEnd");

    if (d_stream.total_out != 2*uncomprLen + comprLen/2) {
        fprintf(stderr, "bad large inflate: %ld\n", d_stream.total_out);
        exit(1);
    } else {
        printf("large_inflate(): OK\n");
    }
}

/* ===========================================================================
 * Test deflate() with full flush
 */
void test_flush(compr, comprLen)
    Byte *compr;
    uLong *comprLen;
{
    z_stream c_stream; /* compression stream */
    int err;
    uInt len = (uInt)strlen(hello)+1;

    c_stream.zalloc = zalloc;
    c_stream.zfree = zfree;
    c_stream.opaque = (voidpf)0;

    err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION);
    CHECK_ERR(err, "deflateInit");

    c_stream.next_in  = (z_const unsigned char *)hello;
    c_stream.next_out = compr;
    c_stream.avail_in = 3;
    c_stream.avail_out = (uInt)*comprLen;
    err = deflate(&c_stream, Z_FULL_FLUSH);
    CHECK_ERR(err, "deflate");

    compr[3]++; /* force an error in first compressed block */
    c_stream.avail_in = len - 3;

    err = deflate(&c_stream, Z_FINISH);
    if (err != Z_STREAM_END) {
        CHECK_ERR(err, "deflate");
    }
    err = deflateEnd(&c_stream);
    CHECK_ERR(err, "deflateEnd");

    *comprLen = c_stream.total_out;
}

/* ===========================================================================
 * Test inflateSync()
 */
void test_sync(compr, comprLen, uncompr, uncomprLen)
    Byte *compr, *uncompr;
    uLong comprLen, uncomprLen;
{
    int err;
    z_stream d_stream; /* decompression stream */

    strcpy((char*)uncompr, "garbage");

    d_stream.zalloc = zalloc;
    d_stream.zfree = zfree;
    d_stream.opaque = (voidpf)0;

    d_stream.next_in  = compr;
    d_stream.avail_in = 2; /* just read the zlib header */

    err = inflateInit(&d_stream);
    CHECK_ERR(err, "inflateInit");

    d_stream.next_out = uncompr;
    d_stream.avail_out = (uInt)uncomprLen;

    err = inflate(&d_stream, Z_NO_FLUSH);
    CHECK_ERR(err, "inflate");

    d_stream.avail_in = (uInt)comprLen-2;   /* read all compressed data */
    err = inflateSync(&d_stream);           /* but skip the damaged part */
    CHECK_ERR(err, "inflateSync");

    err = inflate(&d_stream, Z_FINISH);
    if (err != Z_DATA_ERROR) {
        fprintf(stderr, "inflate should report DATA_ERROR\n");
        /* Because of incorrect adler32 */
        exit(1);
    }
    err = inflateEnd(&d_stream);
    CHECK_ERR(err, "inflateEnd");

    printf("after inflateSync(): hel%s\n", (char *)uncompr);
}

/* ===========================================================================
 * Test deflate() with preset dictionary
 */
void test_dict_deflate(compr, comprLen)
    Byte *compr;
    uLong comprLen;
{
    z_stream c_stream; /* compression stream */
    int err;

    c_stream.zalloc = zalloc;
    c_stream.zfree = zfree;
    c_stream.opaque = (voidpf)0;

    err = deflateInit(&c_stream, Z_BEST_COMPRESSION);
    CHECK_ERR(err, "deflateInit");

    err = deflateSetDictionary(&c_stream,
                (const Bytef*)dictionary, (int)sizeof(dictionary));
    CHECK_ERR(err, "deflateSetDictionary");

    dictId = c_stream.adler;
    c_stream.next_out = compr;
    c_stream.avail_out = (uInt)comprLen;

    c_stream.next_in = (z_const unsigned char *)hello;
    c_stream.avail_in = (uInt)strlen(hello)+1;

    err = deflate(&c_stream, Z_FINISH);
    if (err != Z_STREAM_END) {
        fprintf(stderr, "deflate should report Z_STREAM_END\n");
        exit(1);
    }
    err = deflateEnd(&c_stream);
    CHECK_ERR(err, "deflateEnd");
}

/* ===========================================================================
 * Test inflate() with a preset dictionary
 */
void test_dict_inflate(compr, comprLen, uncompr, uncomprLen)
    Byte *compr, *uncompr;
    uLong comprLen, uncomprLen;
{
    int err;
    z_stream d_stream; /* decompression stream */

    strcpy((char*)uncompr, "garbage");

    d_stream.zalloc = zalloc;
    d_stream.zfree = zfree;
    d_stream.opaque = (voidpf)0;

    d_stream.next_in  = compr;
    d_stream.avail_in = (uInt)comprLen;

    err = inflateInit(&d_stream);
    CHECK_ERR(err, "inflateInit");

    d_stream.next_out = uncompr;
    d_stream.avail_out = (uInt)uncomprLen;

    for (;;) {
        err = inflate(&d_stream, Z_NO_FLUSH);
        if (err == Z_STREAM_END) break;
        if (err == Z_NEED_DICT) {
            if (d_stream.adler != dictId) {
                fprintf(stderr, "unexpected dictionary");
                exit(1);
            }
            err = inflateSetDictionary(&d_stream, (const Bytef*)dictionary,
                                       (int)sizeof(dictionary));
        }
        CHECK_ERR(err, "inflate with dict");
    }

    err = inflateEnd(&d_stream);
    CHECK_ERR(err, "inflateEnd");

    if (strcmp((char*)uncompr, hello)) {
        fprintf(stderr, "bad inflate with dict\n");
        exit(1);
    } else {
        printf("inflate with dictionary: %s\n", (char *)uncompr);
    }
}

/* ===========================================================================
 * Usage:  example [output.gz  [input.gz]]
 */

int main(argc, argv)
    int argc;
    char *argv[];
{
    Byte *compr, *uncompr;
    uLong comprLen = 10000*sizeof(int); /* don't overflow on MSDOS */
    uLong uncomprLen = comprLen;
    static const char* myVersion = ZLIB_VERSION;

    if (zlibVersion()[0] != myVersion[0]) {
        fprintf(stderr, "incompatible zlib version\n");
        exit(1);

    } else if (strcmp(zlibVersion(), ZLIB_VERSION) != 0) {
        fprintf(stderr, "warning: different zlib version\n");
    }

    printf("zlib version %s = 0x%04x, compile flags = 0x%lx\n",
            ZLIB_VERSION, ZLIB_VERNUM, zlibCompileFlags());

    compr    = (Byte*)calloc((uInt)comprLen, 1);
    uncompr  = (Byte*)calloc((uInt)uncomprLen, 1);
    /* compr and uncompr are cleared to avoid reading uninitialized
     * data and to ensure that uncompr compresses well.
     */
    if (compr == Z_NULL || uncompr == Z_NULL) {
        printf("out of memory\n");
        exit(1);
    }

#ifdef Z_SOLO
    (void)argc;
    (void)argv;
#else
    test_compress(compr, comprLen, uncompr, uncomprLen);

    test_gzio((argc > 1 ? argv[1] : TESTFILE),
              uncompr, uncomprLen);
#endif

    test_deflate(compr, comprLen);
    test_inflate(compr, comprLen, uncompr, uncomprLen);

    test_large_deflate(compr, comprLen, uncompr, uncomprLen);
    test_large_inflate(compr, comprLen, uncompr, uncomprLen);

    test_flush(compr, &comprLen);
    test_sync(compr, comprLen, uncompr, uncomprLen);
    comprLen = uncomprLen;

    test_dict_deflate(compr, comprLen);
    test_dict_inflate(compr, comprLen, uncompr, uncomprLen);

    free(compr);
    free(uncompr);

    return 0;
}

Deleted compat/zlib/test/infcover.c.

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































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* infcover.c -- test zlib's inflate routines with full code coverage
 * Copyright (C) 2011, 2016 Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* to use, do: ./configure --cover && make cover */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include "zlib.h"

/* get definition of internal structure so we can mess with it (see pull()),
   and so we can call inflate_trees() (see cover5()) */
#define ZLIB_INTERNAL
#include "inftrees.h"
#include "inflate.h"

#define local static

/* -- memory tracking routines -- */

/*
   These memory tracking routines are provided to zlib and track all of zlib's
   allocations and deallocations, check for LIFO operations, keep a current
   and high water mark of total bytes requested, optionally set a limit on the
   total memory that can be allocated, and when done check for memory leaks.

   They are used as follows:

   z_stream strm;
   mem_setup(&strm)         initializes the memory tracking and sets the
                            zalloc, zfree, and opaque members of strm to use
                            memory tracking for all zlib operations on strm
   mem_limit(&strm, limit)  sets a limit on the total bytes requested -- a
                            request that exceeds this limit will result in an
                            allocation failure (returns NULL) -- setting the
                            limit to zero means no limit, which is the default
                            after mem_setup()
   mem_used(&strm, "msg")   prints to stderr "msg" and the total bytes used
   mem_high(&strm, "msg")   prints to stderr "msg" and the high water mark
   mem_done(&strm, "msg")   ends memory tracking, releases all allocations
                            for the tracking as well as leaked zlib blocks, if
                            any.  If there was anything unusual, such as leaked
                            blocks, non-FIFO frees, or frees of addresses not
                            allocated, then "msg" and information about the
                            problem is printed to stderr.  If everything is
                            normal, nothing is printed. mem_done resets the
                            strm members to Z_NULL to use the default memory
                            allocation routines on the next zlib initialization
                            using strm.
 */

/* these items are strung together in a linked list, one for each allocation */
struct mem_item {
    void *ptr;                  /* pointer to allocated memory */
    size_t size;                /* requested size of allocation */
    struct mem_item *next;      /* pointer to next item in list, or NULL */
};

/* this structure is at the root of the linked list, and tracks statistics */
struct mem_zone {
    struct mem_item *first;     /* pointer to first item in list, or NULL */
    size_t total, highwater;    /* total allocations, and largest total */
    size_t limit;               /* memory allocation limit, or 0 if no limit */
    int notlifo, rogue;         /* counts of non-LIFO frees and rogue frees */
};

/* memory allocation routine to pass to zlib */
local void *mem_alloc(void *mem, unsigned count, unsigned size)
{
    void *ptr;
    struct mem_item *item;
    struct mem_zone *zone = mem;
    size_t len = count * (size_t)size;

    /* induced allocation failure */
    if (zone == NULL || (zone->limit && zone->total + len > zone->limit))
        return NULL;

    /* perform allocation using the standard library, fill memory with a
       non-zero value to make sure that the code isn't depending on zeros */
    ptr = malloc(len);
    if (ptr == NULL)
        return NULL;
    memset(ptr, 0xa5, len);

    /* create a new item for the list */
    item = malloc(sizeof(struct mem_item));
    if (item == NULL) {
        free(ptr);
        return NULL;
    }
    item->ptr = ptr;
    item->size = len;

    /* insert item at the beginning of the list */
    item->next = zone->first;
    zone->first = item;

    /* update the statistics */
    zone->total += item->size;
    if (zone->total > zone->highwater)
        zone->highwater = zone->total;

    /* return the allocated memory */
    return ptr;
}

/* memory free routine to pass to zlib */
local void mem_free(void *mem, void *ptr)
{
    struct mem_item *item, *next;
    struct mem_zone *zone = mem;

    /* if no zone, just do a free */
    if (zone == NULL) {
        free(ptr);
        return;
    }

    /* point next to the item that matches ptr, or NULL if not found -- remove
       the item from the linked list if found */
    next = zone->first;
    if (next) {
        if (next->ptr == ptr)
            zone->first = next->next;   /* first one is it, remove from list */
        else {
            do {                        /* search the linked list */
                item = next;
                next = item->next;
            } while (next != NULL && next->ptr != ptr);
            if (next) {                 /* if found, remove from linked list */
                item->next = next->next;
                zone->notlifo++;        /* not a LIFO free */
            }

        }
    }

    /* if found, update the statistics and free the item */
    if (next) {
        zone->total -= next->size;
        free(next);
    }

    /* if not found, update the rogue count */
    else
        zone->rogue++;

    /* in any case, do the requested free with the standard library function */
    free(ptr);
}

/* set up a controlled memory allocation space for monitoring, set the stream
   parameters to the controlled routines, with opaque pointing to the space */
local void mem_setup(z_stream *strm)
{
    struct mem_zone *zone;

    zone = malloc(sizeof(struct mem_zone));
    assert(zone != NULL);
    zone->first = NULL;
    zone->total = 0;
    zone->highwater = 0;
    zone->limit = 0;
    zone->notlifo = 0;
    zone->rogue = 0;
    strm->opaque = zone;
    strm->zalloc = mem_alloc;
    strm->zfree = mem_free;
}

/* set a limit on the total memory allocation, or 0 to remove the limit */
local void mem_limit(z_stream *strm, size_t limit)
{
    struct mem_zone *zone = strm->opaque;

    zone->limit = limit;
}

/* show the current total requested allocations in bytes */
local void mem_used(z_stream *strm, char *prefix)
{
    struct mem_zone *zone = strm->opaque;

    fprintf(stderr, "%s: %lu allocated\n", prefix, zone->total);
}

/* show the high water allocation in bytes */
local void mem_high(z_stream *strm, char *prefix)
{
    struct mem_zone *zone = strm->opaque;

    fprintf(stderr, "%s: %lu high water mark\n", prefix, zone->highwater);
}

/* release the memory allocation zone -- if there are any surprises, notify */
local void mem_done(z_stream *strm, char *prefix)
{
    int count = 0;
    struct mem_item *item, *next;
    struct mem_zone *zone = strm->opaque;

    /* show high water mark */
    mem_high(strm, prefix);

    /* free leftover allocations and item structures, if any */
    item = zone->first;
    while (item != NULL) {
        free(item->ptr);
        next = item->next;
        free(item);
        item = next;
        count++;
    }

    /* issue alerts about anything unexpected */
    if (count || zone->total)
        fprintf(stderr, "** %s: %lu bytes in %d blocks not freed\n",
                prefix, zone->total, count);
    if (zone->notlifo)
        fprintf(stderr, "** %s: %d frees not LIFO\n", prefix, zone->notlifo);
    if (zone->rogue)
        fprintf(stderr, "** %s: %d frees not recognized\n",
                prefix, zone->rogue);

    /* free the zone and delete from the stream */
    free(zone);
    strm->opaque = Z_NULL;
    strm->zalloc = Z_NULL;
    strm->zfree = Z_NULL;
}

/* -- inflate test routines -- */

/* Decode a hexadecimal string, set *len to length, in[] to the bytes.  This
   decodes liberally, in that hex digits can be adjacent, in which case two in
   a row writes a byte.  Or they can be delimited by any non-hex character,
   where the delimiters are ignored except when a single hex digit is followed
   by a delimiter, where that single digit writes a byte.  The returned data is
   allocated and must eventually be freed.  NULL is returned if out of memory.
   If the length is not needed, then len can be NULL. */
local unsigned char *h2b(const char *hex, unsigned *len)
{
    unsigned char *in, *re;
    unsigned next, val;

    in = malloc((strlen(hex) + 1) >> 1);
    if (in == NULL)
        return NULL;
    next = 0;
    val = 1;
    do {
        if (*hex >= '0' && *hex <= '9')
            val = (val << 4) + *hex - '0';
        else if (*hex >= 'A' && *hex <= 'F')
            val = (val << 4) + *hex - 'A' + 10;
        else if (*hex >= 'a' && *hex <= 'f')
            val = (val << 4) + *hex - 'a' + 10;
        else if (val != 1 && val < 32)  /* one digit followed by delimiter */
            val += 240;                 /* make it look like two digits */
        if (val > 255) {                /* have two digits */
            in[next++] = val & 0xff;    /* save the decoded byte */
            val = 1;                    /* start over */
        }
    } while (*hex++);       /* go through the loop with the terminating null */
    if (len != NULL)
        *len = next;
    re = realloc(in, next);
    return re == NULL ? in : re;
}

/* generic inflate() run, where hex is the hexadecimal input data, what is the
   text to include in an error message, step is how much input data to feed
   inflate() on each call, or zero to feed it all, win is the window bits
   parameter to inflateInit2(), len is the size of the output buffer, and err
   is the error code expected from the first inflate() call (the second
   inflate() call is expected to return Z_STREAM_END).  If win is 47, then
   header information is collected with inflateGetHeader().  If a zlib stream
   is looking for a dictionary, then an empty dictionary is provided.
   inflate() is run until all of the input data is consumed. */
local void inf(char *hex, char *what, unsigned step, int win, unsigned len,
               int err)
{
    int ret;
    unsigned have;
    unsigned char *in, *out;
    z_stream strm, copy;
    gz_header head;

    mem_setup(&strm);
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit2(&strm, win);
    if (ret != Z_OK) {
        mem_done(&strm, what);
        return;
    }
    out = malloc(len);                          assert(out != NULL);
    if (win == 47) {
        head.extra = out;
        head.extra_max = len;
        head.name = out;
        head.name_max = len;
        head.comment = out;
        head.comm_max = len;
        ret = inflateGetHeader(&strm, &head);   assert(ret == Z_OK);
    }
    in = h2b(hex, &have);                       assert(in != NULL);
    if (step == 0 || step > have)
        step = have;
    strm.avail_in = step;
    have -= step;
    strm.next_in = in;
    do {
        strm.avail_out = len;
        strm.next_out = out;
        ret = inflate(&strm, Z_NO_FLUSH);       assert(err == 9 || ret == err);
        if (ret != Z_OK && ret != Z_BUF_ERROR && ret != Z_NEED_DICT)
            break;
        if (ret == Z_NEED_DICT) {
            ret = inflateSetDictionary(&strm, in, 1);
                                                assert(ret == Z_DATA_ERROR);
            mem_limit(&strm, 1);
            ret = inflateSetDictionary(&strm, out, 0);
                                                assert(ret == Z_MEM_ERROR);
            mem_limit(&strm, 0);
            ((struct inflate_state *)strm.state)->mode = DICT;
            ret = inflateSetDictionary(&strm, out, 0);
                                                assert(ret == Z_OK);
            ret = inflate(&strm, Z_NO_FLUSH);   assert(ret == Z_BUF_ERROR);
        }
        ret = inflateCopy(&copy, &strm);        assert(ret == Z_OK);
        ret = inflateEnd(&copy);                assert(ret == Z_OK);
        err = 9;                        /* don't care next time around */
        have += strm.avail_in;
        strm.avail_in = step > have ? have : step;
        have -= strm.avail_in;
    } while (strm.avail_in);
    free(in);
    free(out);
    ret = inflateReset2(&strm, -8);             assert(ret == Z_OK);
    ret = inflateEnd(&strm);                    assert(ret == Z_OK);
    mem_done(&strm, what);
}

/* cover all of the lines in inflate.c up to inflate() */
local void cover_support(void)
{
    int ret;
    z_stream strm;

    mem_setup(&strm);
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit(&strm);                   assert(ret == Z_OK);
    mem_used(&strm, "inflate init");
    ret = inflatePrime(&strm, 5, 31);           assert(ret == Z_OK);
    ret = inflatePrime(&strm, -1, 0);           assert(ret == Z_OK);
    ret = inflateSetDictionary(&strm, Z_NULL, 0);
                                                assert(ret == Z_STREAM_ERROR);
    ret = inflateEnd(&strm);                    assert(ret == Z_OK);
    mem_done(&strm, "prime");

    inf("63 0", "force window allocation", 0, -15, 1, Z_OK);
    inf("63 18 5", "force window replacement", 0, -8, 259, Z_OK);
    inf("63 18 68 30 d0 0 0", "force split window update", 4, -8, 259, Z_OK);
    inf("3 0", "use fixed blocks", 0, -15, 1, Z_STREAM_END);
    inf("", "bad window size", 0, 1, 0, Z_STREAM_ERROR);

    mem_setup(&strm);
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit_(&strm, ZLIB_VERSION - 1, (int)sizeof(z_stream));
                                                assert(ret == Z_VERSION_ERROR);
    mem_done(&strm, "wrong version");

    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit(&strm);                   assert(ret == Z_OK);
    ret = inflateEnd(&strm);                    assert(ret == Z_OK);
    fputs("inflate built-in memory routines\n", stderr);
}

/* cover all inflate() header and trailer cases and code after inflate() */
local void cover_wrap(void)
{
    int ret;
    z_stream strm, copy;
    unsigned char dict[257];

    ret = inflate(Z_NULL, 0);                   assert(ret == Z_STREAM_ERROR);
    ret = inflateEnd(Z_NULL);                   assert(ret == Z_STREAM_ERROR);
    ret = inflateCopy(Z_NULL, Z_NULL);          assert(ret == Z_STREAM_ERROR);
    fputs("inflate bad parameters\n", stderr);

    inf("1f 8b 0 0", "bad gzip method", 0, 31, 0, Z_DATA_ERROR);
    inf("1f 8b 8 80", "bad gzip flags", 0, 31, 0, Z_DATA_ERROR);
    inf("77 85", "bad zlib method", 0, 15, 0, Z_DATA_ERROR);
    inf("8 99", "set window size from header", 0, 0, 0, Z_OK);
    inf("78 9c", "bad zlib window size", 0, 8, 0, Z_DATA_ERROR);
    inf("78 9c 63 0 0 0 1 0 1", "check adler32", 0, 15, 1, Z_STREAM_END);
    inf("1f 8b 8 1e 0 0 0 0 0 0 1 0 0 0 0 0 0", "bad header crc", 0, 47, 1,
        Z_DATA_ERROR);
    inf("1f 8b 8 2 0 0 0 0 0 0 1d 26 3 0 0 0 0 0 0 0 0 0", "check gzip length",
        0, 47, 0, Z_STREAM_END);
    inf("78 90", "bad zlib header check", 0, 47, 0, Z_DATA_ERROR);
    inf("8 b8 0 0 0 1", "need dictionary", 0, 8, 0, Z_NEED_DICT);
    inf("78 9c 63 0", "compute adler32", 0, 15, 1, Z_OK);

    mem_setup(&strm);
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit2(&strm, -8);
    strm.avail_in = 2;
    strm.next_in = (void *)"\x63";
    strm.avail_out = 1;
    strm.next_out = (void *)&ret;
    mem_limit(&strm, 1);
    ret = inflate(&strm, Z_NO_FLUSH);           assert(ret == Z_MEM_ERROR);
    ret = inflate(&strm, Z_NO_FLUSH);           assert(ret == Z_MEM_ERROR);
    mem_limit(&strm, 0);
    memset(dict, 0, 257);
    ret = inflateSetDictionary(&strm, dict, 257);
                                                assert(ret == Z_OK);
    mem_limit(&strm, (sizeof(struct inflate_state) << 1) + 256);
    ret = inflatePrime(&strm, 16, 0);           assert(ret == Z_OK);
    strm.avail_in = 2;
    strm.next_in = (void *)"\x80";
    ret = inflateSync(&strm);                   assert(ret == Z_DATA_ERROR);
    ret = inflate(&strm, Z_NO_FLUSH);           assert(ret == Z_STREAM_ERROR);
    strm.avail_in = 4;
    strm.next_in = (void *)"\0\0\xff\xff";
    ret = inflateSync(&strm);                   assert(ret == Z_OK);
    (void)inflateSyncPoint(&strm);
    ret = inflateCopy(&copy, &strm);            assert(ret == Z_MEM_ERROR);
    mem_limit(&strm, 0);
    ret = inflateUndermine(&strm, 1);           assert(ret == Z_DATA_ERROR);
    (void)inflateMark(&strm);
    ret = inflateEnd(&strm);                    assert(ret == Z_OK);
    mem_done(&strm, "miscellaneous, force memory errors");
}

/* input and output functions for inflateBack() */
local unsigned pull(void *desc, unsigned char **buf)
{
    static unsigned int next = 0;
    static unsigned char dat[] = {0x63, 0, 2, 0};
    struct inflate_state *state;

    if (desc == Z_NULL) {
        next = 0;
        return 0;   /* no input (already provided at next_in) */
    }
    state = (void *)((z_stream *)desc)->state;
    if (state != Z_NULL)
        state->mode = SYNC;     /* force an otherwise impossible situation */
    return next < sizeof(dat) ? (*buf = dat + next++, 1) : 0;
}

local int push(void *desc, unsigned char *buf, unsigned len)
{
    buf += len;
    return desc != Z_NULL;      /* force error if desc not null */
}

/* cover inflateBack() up to common deflate data cases and after those */
local void cover_back(void)
{
    int ret;
    z_stream strm;
    unsigned char win[32768];

    ret = inflateBackInit_(Z_NULL, 0, win, 0, 0);
                                                assert(ret == Z_VERSION_ERROR);
    ret = inflateBackInit(Z_NULL, 0, win);      assert(ret == Z_STREAM_ERROR);
    ret = inflateBack(Z_NULL, Z_NULL, Z_NULL, Z_NULL, Z_NULL);
                                                assert(ret == Z_STREAM_ERROR);
    ret = inflateBackEnd(Z_NULL);               assert(ret == Z_STREAM_ERROR);
    fputs("inflateBack bad parameters\n", stderr);

    mem_setup(&strm);
    ret = inflateBackInit(&strm, 15, win);      assert(ret == Z_OK);
    strm.avail_in = 2;
    strm.next_in = (void *)"\x03";
    ret = inflateBack(&strm, pull, Z_NULL, push, Z_NULL);
                                                assert(ret == Z_STREAM_END);
        /* force output error */
    strm.avail_in = 3;
    strm.next_in = (void *)"\x63\x00";
    ret = inflateBack(&strm, pull, Z_NULL, push, &strm);
                                                assert(ret == Z_BUF_ERROR);
        /* force mode error by mucking with state */
    ret = inflateBack(&strm, pull, &strm, push, Z_NULL);
                                                assert(ret == Z_STREAM_ERROR);
    ret = inflateBackEnd(&strm);                assert(ret == Z_OK);
    mem_done(&strm, "inflateBack bad state");

    ret = inflateBackInit(&strm, 15, win);      assert(ret == Z_OK);
    ret = inflateBackEnd(&strm);                assert(ret == Z_OK);
    fputs("inflateBack built-in memory routines\n", stderr);
}

/* do a raw inflate of data in hexadecimal with both inflate and inflateBack */
local int try(char *hex, char *id, int err)
{
    int ret;
    unsigned len, size;
    unsigned char *in, *out, *win;
    char *prefix;
    z_stream strm;

    /* convert to hex */
    in = h2b(hex, &len);
    assert(in != NULL);

    /* allocate work areas */
    size = len << 3;
    out = malloc(size);
    assert(out != NULL);
    win = malloc(32768);
    assert(win != NULL);
    prefix = malloc(strlen(id) + 6);
    assert(prefix != NULL);

    /* first with inflate */
    strcpy(prefix, id);
    strcat(prefix, "-late");
    mem_setup(&strm);
    strm.avail_in = 0;
    strm.next_in = Z_NULL;
    ret = inflateInit2(&strm, err < 0 ? 47 : -15);
    assert(ret == Z_OK);
    strm.avail_in = len;
    strm.next_in = in;
    do {
        strm.avail_out = size;
        strm.next_out = out;
        ret = inflate(&strm, Z_TREES);
        assert(ret != Z_STREAM_ERROR && ret != Z_MEM_ERROR);
        if (ret == Z_DATA_ERROR || ret == Z_NEED_DICT)
            break;
    } while (strm.avail_in || strm.avail_out == 0);
    if (err) {
        assert(ret == Z_DATA_ERROR);
        assert(strcmp(id, strm.msg) == 0);
    }
    inflateEnd(&strm);
    mem_done(&strm, prefix);

    /* then with inflateBack */
    if (err >= 0) {
        strcpy(prefix, id);
        strcat(prefix, "-back");
        mem_setup(&strm);
        ret = inflateBackInit(&strm, 15, win);
        assert(ret == Z_OK);
        strm.avail_in = len;
        strm.next_in = in;
        ret = inflateBack(&strm, pull, Z_NULL, push, Z_NULL);
        assert(ret != Z_STREAM_ERROR);
        if (err) {
            assert(ret == Z_DATA_ERROR);
            assert(strcmp(id, strm.msg) == 0);
        }
        inflateBackEnd(&strm);
        mem_done(&strm, prefix);
    }

    /* clean up */
    free(prefix);
    free(win);
    free(out);
    free(in);
    return ret;
}

/* cover deflate data cases in both inflate() and inflateBack() */
local void cover_inflate(void)
{
    try("0 0 0 0 0", "invalid stored block lengths", 1);
    try("3 0", "fixed", 0);
    try("6", "invalid block type", 1);
    try("1 1 0 fe ff 0", "stored", 0);
    try("fc 0 0", "too many length or distance symbols", 1);
    try("4 0 fe ff", "invalid code lengths set", 1);
    try("4 0 24 49 0", "invalid bit length repeat", 1);
    try("4 0 24 e9 ff ff", "invalid bit length repeat", 1);
    try("4 0 24 e9 ff 6d", "invalid code -- missing end-of-block", 1);
    try("4 80 49 92 24 49 92 24 71 ff ff 93 11 0",
        "invalid literal/lengths set", 1);
    try("4 80 49 92 24 49 92 24 f b4 ff ff c3 84", "invalid distances set", 1);
    try("4 c0 81 8 0 0 0 0 20 7f eb b 0 0", "invalid literal/length code", 1);
    try("2 7e ff ff", "invalid distance code", 1);
    try("c c0 81 0 0 0 0 0 90 ff 6b 4 0", "invalid distance too far back", 1);

    /* also trailer mismatch just in inflate() */
    try("1f 8b 8 0 0 0 0 0 0 0 3 0 0 0 0 1", "incorrect data check", -1);
    try("1f 8b 8 0 0 0 0 0 0 0 3 0 0 0 0 0 0 0 0 1",
        "incorrect length check", -1);
    try("5 c0 21 d 0 0 0 80 b0 fe 6d 2f 91 6c", "pull 17", 0);
    try("5 e0 81 91 24 cb b2 2c 49 e2 f 2e 8b 9a 47 56 9f fb fe ec d2 ff 1f",
        "long code", 0);
    try("ed c0 1 1 0 0 0 40 20 ff 57 1b 42 2c 4f", "length extra", 0);
    try("ed cf c1 b1 2c 47 10 c4 30 fa 6f 35 1d 1 82 59 3d fb be 2e 2a fc f c",
        "long distance and extra", 0);
    try("ed c0 81 0 0 0 0 80 a0 fd a9 17 a9 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 "
        "0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 6", "window end", 0);
    inf("2 8 20 80 0 3 0", "inflate_fast TYPE return", 0, -15, 258,
        Z_STREAM_END);
    inf("63 18 5 40 c 0", "window wrap", 3, -8, 300, Z_OK);
}

/* cover remaining lines in inftrees.c */
local void cover_trees(void)
{
    int ret;
    unsigned bits;
    unsigned short lens[16], work[16];
    code *next, table[ENOUGH_DISTS];

    /* we need to call inflate_table() directly in order to manifest not-
       enough errors, since zlib insures that enough is always enough */
    for (bits = 0; bits < 15; bits++)
        lens[bits] = (unsigned short)(bits + 1);
    lens[15] = 15;
    next = table;
    bits = 15;
    ret = inflate_table(DISTS, lens, 16, &next, &bits, work);
                                                assert(ret == 1);
    next = table;
    bits = 1;
    ret = inflate_table(DISTS, lens, 16, &next, &bits, work);
                                                assert(ret == 1);
    fputs("inflate_table not enough errors\n", stderr);
}

/* cover remaining inffast.c decoding and window copying */
local void cover_fast(void)
{
    inf("e5 e0 81 ad 6d cb b2 2c c9 01 1e 59 63 ae 7d ee fb 4d fd b5 35 41 68"
        " ff 7f 0f 0 0 0", "fast length extra bits", 0, -8, 258, Z_DATA_ERROR);
    inf("25 fd 81 b5 6d 59 b6 6a 49 ea af 35 6 34 eb 8c b9 f6 b9 1e ef 67 49"
        " 50 fe ff ff 3f 0 0", "fast distance extra bits", 0, -8, 258,
        Z_DATA_ERROR);
    inf("3 7e 0 0 0 0 0", "fast invalid distance code", 0, -8, 258,
        Z_DATA_ERROR);
    inf("1b 7 0 0 0 0 0", "fast invalid literal/length code", 0, -8, 258,
        Z_DATA_ERROR);
    inf("d c7 1 ae eb 38 c 4 41 a0 87 72 de df fb 1f b8 36 b1 38 5d ff ff 0",
        "fast 2nd level codes and too far back", 0, -8, 258, Z_DATA_ERROR);
    inf("63 18 5 8c 10 8 0 0 0 0", "very common case", 0, -8, 259, Z_OK);
    inf("63 60 60 18 c9 0 8 18 18 18 26 c0 28 0 29 0 0 0",
        "contiguous and wrap around window", 6, -8, 259, Z_OK);
    inf("63 0 3 0 0 0 0 0", "copy direct from output", 0, -8, 259,
        Z_STREAM_END);
}

int main(void)
{
    fprintf(stderr, "%s\n", zlibVersion());
    cover_support();
    cover_wrap();
    cover_back();
    cover_inflate();
    cover_trees();
    cover_fast();
    return 0;
}

Deleted compat/zlib/test/minigzip.c.

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











































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* minigzip.c -- simulate gzip using the zlib compression library
 * Copyright (C) 1995-2006, 2010, 2011, 2016 Jean-loup Gailly
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/*
 * minigzip is a minimal implementation of the gzip utility. This is
 * only an example of using zlib and isn't meant to replace the
 * full-featured gzip. No attempt is made to deal with file systems
 * limiting names to 14 or 8+3 characters, etc... Error checking is
 * very limited. So use minigzip only for testing; use gzip for the
 * real thing. On MSDOS, use only on file names without extension
 * or in pipe mode.
 */

/* @(#) $Id$ */

#include "zlib.h"
#include <stdio.h>

#ifdef STDC
#  include <string.h>
#  include <stdlib.h>
#endif

#ifdef USE_MMAP
#  include <sys/types.h>
#  include <sys/mman.h>
#  include <sys/stat.h>
#endif

#if defined(MSDOS) || defined(OS2) || defined(WIN32) || defined(__CYGWIN__)
#  include <fcntl.h>
#  include <io.h>
#  ifdef UNDER_CE
#    include <stdlib.h>
#  endif
#  define SET_BINARY_MODE(file) setmode(fileno(file), O_BINARY)
#else
#  define SET_BINARY_MODE(file)
#endif

#if defined(_MSC_VER) && _MSC_VER < 1900
#  define snprintf _snprintf
#endif

#ifdef VMS
#  define unlink delete
#  define GZ_SUFFIX "-gz"
#endif
#ifdef RISCOS
#  define unlink remove
#  define GZ_SUFFIX "-gz"
#  define fileno(file) file->__file
#endif
#if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os
#  include <unix.h> /* for fileno */
#endif

#if !defined(Z_HAVE_UNISTD_H) && !defined(_LARGEFILE64_SOURCE)
#ifndef WIN32 /* unlink already in stdio.h for WIN32 */
  extern int unlink OF((const char *));
#endif
#endif

#if defined(UNDER_CE)
#  include <windows.h>
#  define perror(s) pwinerror(s)

/* Map the Windows error number in ERROR to a locale-dependent error
   message string and return a pointer to it.  Typically, the values
   for ERROR come from GetLastError.

   The string pointed to shall not be modified by the application,
   but may be overwritten by a subsequent call to strwinerror

   The strwinerror function does not change the current setting
   of GetLastError.  */

static char *strwinerror (error)
     DWORD error;
{
    static char buf[1024];

    wchar_t *msgbuf;
    DWORD lasterr = GetLastError();
    DWORD chars = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM
        | FORMAT_MESSAGE_ALLOCATE_BUFFER,
        NULL,
        error,
        0, /* Default language */
        (LPVOID)&msgbuf,
        0,
        NULL);
    if (chars != 0) {
        /* If there is an \r\n appended, zap it.  */
        if (chars >= 2
            && msgbuf[chars - 2] == '\r' && msgbuf[chars - 1] == '\n') {
            chars -= 2;
            msgbuf[chars] = 0;
        }

        if (chars > sizeof (buf) - 1) {
            chars = sizeof (buf) - 1;
            msgbuf[chars] = 0;
        }

        wcstombs(buf, msgbuf, chars + 1);
        LocalFree(msgbuf);
    }
    else {
        sprintf(buf, "unknown win32 error (%ld)", error);
    }

    SetLastError(lasterr);
    return buf;
}

static void pwinerror (s)
    const char *s;
{
    if (s && *s)
        fprintf(stderr, "%s: %s\n", s, strwinerror(GetLastError ()));
    else
        fprintf(stderr, "%s\n", strwinerror(GetLastError ()));
}

#endif /* UNDER_CE */

#ifndef GZ_SUFFIX
#  define GZ_SUFFIX ".gz"
#endif
#define SUFFIX_LEN (sizeof(GZ_SUFFIX)-1)

#define BUFLEN      16384
#define MAX_NAME_LEN 1024

#ifdef MAXSEG_64K
#  define local static
   /* Needed for systems with limitation on stack size. */
#else
#  define local
#endif

#ifdef Z_SOLO
/* for Z_SOLO, create simplified gz* functions using deflate and inflate */

#if defined(Z_HAVE_UNISTD_H) || defined(Z_LARGE)
#  include <unistd.h>       /* for unlink() */
#endif

void *myalloc OF((void *, unsigned, unsigned));
void myfree OF((void *, void *));

void *myalloc(q, n, m)
    void *q;
    unsigned n, m;
{
    (void)q;
    return calloc(n, m);
}

void myfree(q, p)
    void *q, *p;
{
    (void)q;
    free(p);
}

typedef struct gzFile_s {
    FILE *file;
    int write;
    int err;
    char *msg;
    z_stream strm;
} *gzFile;

gzFile gzopen OF((const char *, const char *));
gzFile gzdopen OF((int, const char *));
gzFile gz_open OF((const char *, int, const char *));

gzFile gzopen(path, mode)
const char *path;
const char *mode;
{
    return gz_open(path, -1, mode);
}

gzFile gzdopen(fd, mode)
int fd;
const char *mode;
{
    return gz_open(NULL, fd, mode);
}

gzFile gz_open(path, fd, mode)
    const char *path;
    int fd;
    const char *mode;
{
    gzFile gz;
    int ret;

    gz = malloc(sizeof(struct gzFile_s));
    if (gz == NULL)
        return NULL;
    gz->write = strchr(mode, 'w') != NULL;
    gz->strm.zalloc = myalloc;
    gz->strm.zfree = myfree;
    gz->strm.opaque = Z_NULL;
    if (gz->write)
        ret = deflateInit2(&(gz->strm), -1, 8, 15 + 16, 8, 0);
    else {
        gz->strm.next_in = 0;
        gz->strm.avail_in = Z_NULL;
        ret = inflateInit2(&(gz->strm), 15 + 16);
    }
    if (ret != Z_OK) {
        free(gz);
        return NULL;
    }
    gz->file = path == NULL ? fdopen(fd, gz->write ? "wb" : "rb") :
                              fopen(path, gz->write ? "wb" : "rb");
    if (gz->file == NULL) {
        gz->write ? deflateEnd(&(gz->strm)) : inflateEnd(&(gz->strm));
        free(gz);
        return NULL;
    }
    gz->err = 0;
    gz->msg = "";
    return gz;
}

int gzwrite OF((gzFile, const void *, unsigned));

int gzwrite(gz, buf, len)
    gzFile gz;
    const void *buf;
    unsigned len;
{
    z_stream *strm;
    unsigned char out[BUFLEN];

    if (gz == NULL || !gz->write)
        return 0;
    strm = &(gz->strm);
    strm->next_in = (void *)buf;
    strm->avail_in = len;
    do {
        strm->next_out = out;
        strm->avail_out = BUFLEN;
        (void)deflate(strm, Z_NO_FLUSH);
        fwrite(out, 1, BUFLEN - strm->avail_out, gz->file);
    } while (strm->avail_out == 0);
    return len;
}

int gzread OF((gzFile, void *, unsigned));

int gzread(gz, buf, len)
    gzFile gz;
    void *buf;
    unsigned len;
{
    int ret;
    unsigned got;
    unsigned char in[1];
    z_stream *strm;

    if (gz == NULL || gz->write)
        return 0;
    if (gz->err)
        return 0;
    strm = &(gz->strm);
    strm->next_out = (void *)buf;
    strm->avail_out = len;
    do {
        got = fread(in, 1, 1, gz->file);
        if (got == 0)
            break;
        strm->next_in = in;
        strm->avail_in = 1;
        ret = inflate(strm, Z_NO_FLUSH);
        if (ret == Z_DATA_ERROR) {
            gz->err = Z_DATA_ERROR;
            gz->msg = strm->msg;
            return 0;
        }
        if (ret == Z_STREAM_END)
            inflateReset(strm);
    } while (strm->avail_out);
    return len - strm->avail_out;
}

int gzclose OF((gzFile));

int gzclose(gz)
    gzFile gz;
{
    z_stream *strm;
    unsigned char out[BUFLEN];

    if (gz == NULL)
        return Z_STREAM_ERROR;
    strm = &(gz->strm);
    if (gz->write) {
        strm->next_in = Z_NULL;
        strm->avail_in = 0;
        do {
            strm->next_out = out;
            strm->avail_out = BUFLEN;
            (void)deflate(strm, Z_FINISH);
            fwrite(out, 1, BUFLEN - strm->avail_out, gz->file);
        } while (strm->avail_out == 0);
        deflateEnd(strm);
    }
    else
        inflateEnd(strm);
    fclose(gz->file);
    free(gz);
    return Z_OK;
}

const char *gzerror OF((gzFile, int *));

const char *gzerror(gz, err)
    gzFile gz;
    int *err;
{
    *err = gz->err;
    return gz->msg;
}

#endif

static char *prog;

void error            OF((const char *msg));
void gz_compress      OF((FILE   *in, gzFile out));
#ifdef USE_MMAP
int  gz_compress_mmap OF((FILE   *in, gzFile out));
#endif
void gz_uncompress    OF((gzFile in, FILE   *out));
void file_compress    OF((char  *file, char *mode));
void file_uncompress  OF((char  *file));
int  main             OF((int argc, char *argv[]));

/* ===========================================================================
 * Display error message and exit
 */
void error(msg)
    const char *msg;
{
    fprintf(stderr, "%s: %s\n", prog, msg);
    exit(1);
}

/* ===========================================================================
 * Compress input to output then close both files.
 */

void gz_compress(in, out)
    FILE   *in;
    gzFile out;
{
    local char buf[BUFLEN];
    int len;
    int err;

#ifdef USE_MMAP
    /* Try first compressing with mmap. If mmap fails (minigzip used in a
     * pipe), use the normal fread loop.
     */
    if (gz_compress_mmap(in, out) == Z_OK) return;
#endif
    for (;;) {
        len = (int)fread(buf, 1, sizeof(buf), in);
        if (ferror(in)) {
            perror("fread");
            exit(1);
        }
        if (len == 0) break;

        if (gzwrite(out, buf, (unsigned)len) != len) error(gzerror(out, &err));
    }
    fclose(in);
    if (gzclose(out) != Z_OK) error("failed gzclose");
}

#ifdef USE_MMAP /* MMAP version, Miguel Albrecht <malbrech@eso.org> */

/* Try compressing the input file at once using mmap. Return Z_OK if
 * if success, Z_ERRNO otherwise.
 */
int gz_compress_mmap(in, out)
    FILE   *in;
    gzFile out;
{
    int len;
    int err;
    int ifd = fileno(in);
    caddr_t buf;    /* mmap'ed buffer for the entire input file */
    off_t buf_len;  /* length of the input file */
    struct stat sb;

    /* Determine the size of the file, needed for mmap: */
    if (fstat(ifd, &sb) < 0) return Z_ERRNO;
    buf_len = sb.st_size;
    if (buf_len <= 0) return Z_ERRNO;

    /* Now do the actual mmap: */
    buf = mmap((caddr_t) 0, buf_len, PROT_READ, MAP_SHARED, ifd, (off_t)0);
    if (buf == (caddr_t)(-1)) return Z_ERRNO;

    /* Compress the whole file at once: */
    len = gzwrite(out, (char *)buf, (unsigned)buf_len);

    if (len != (int)buf_len) error(gzerror(out, &err));

    munmap(buf, buf_len);
    fclose(in);
    if (gzclose(out) != Z_OK) error("failed gzclose");
    return Z_OK;
}
#endif /* USE_MMAP */

/* ===========================================================================
 * Uncompress input to output then close both files.
 */
void gz_uncompress(in, out)
    gzFile in;
    FILE   *out;
{
    local char buf[BUFLEN];
    int len;
    int err;

    for (;;) {
        len = gzread(in, buf, sizeof(buf));
        if (len < 0) error (gzerror(in, &err));
        if (len == 0) break;

        if ((int)fwrite(buf, 1, (unsigned)len, out) != len) {
            error("failed fwrite");
        }
    }
    if (fclose(out)) error("failed fclose");

    if (gzclose(in) != Z_OK) error("failed gzclose");
}


/* ===========================================================================
 * Compress the given file: create a corresponding .gz file and remove the
 * original.
 */
void file_compress(file, mode)
    char  *file;
    char  *mode;
{
    local char outfile[MAX_NAME_LEN];
    FILE  *in;
    gzFile out;

    if (strlen(file) + strlen(GZ_SUFFIX) >= sizeof(outfile)) {
        fprintf(stderr, "%s: filename too long\n", prog);
        exit(1);
    }

#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
    snprintf(outfile, sizeof(outfile), "%s%s", file, GZ_SUFFIX);
#else
    strcpy(outfile, file);
    strcat(outfile, GZ_SUFFIX);
#endif

    in = fopen(file, "rb");
    if (in == NULL) {
        perror(file);
        exit(1);
    }
    out = gzopen(outfile, mode);
    if (out == NULL) {
        fprintf(stderr, "%s: can't gzopen %s\n", prog, outfile);
        exit(1);
    }
    gz_compress(in, out);

    unlink(file);
}


/* ===========================================================================
 * Uncompress the given file and remove the original.
 */
void file_uncompress(file)
    char  *file;
{
    local char buf[MAX_NAME_LEN];
    char *infile, *outfile;
    FILE  *out;
    gzFile in;
    unsigned len = strlen(file);

    if (len + strlen(GZ_SUFFIX) >= sizeof(buf)) {
        fprintf(stderr, "%s: filename too long\n", prog);
        exit(1);
    }

#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
    snprintf(buf, sizeof(buf), "%s", file);
#else
    strcpy(buf, file);
#endif

    if (len > SUFFIX_LEN && strcmp(file+len-SUFFIX_LEN, GZ_SUFFIX) == 0) {
        infile = file;
        outfile = buf;
        outfile[len-3] = '\0';
    } else {
        outfile = file;
        infile = buf;
#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
        snprintf(buf + len, sizeof(buf) - len, "%s", GZ_SUFFIX);
#else
        strcat(infile, GZ_SUFFIX);
#endif
    }
    in = gzopen(infile, "rb");
    if (in == NULL) {
        fprintf(stderr, "%s: can't gzopen %s\n", prog, infile);
        exit(1);
    }
    out = fopen(outfile, "wb");
    if (out == NULL) {
        perror(file);
        exit(1);
    }

    gz_uncompress(in, out);

    unlink(infile);
}


/* ===========================================================================
 * Usage:  minigzip [-c] [-d] [-f] [-h] [-r] [-1 to -9] [files...]
 *   -c : write to standard output
 *   -d : decompress
 *   -f : compress with Z_FILTERED
 *   -h : compress with Z_HUFFMAN_ONLY
 *   -r : compress with Z_RLE
 *   -1 to -9 : compression level
 */

int main(argc, argv)
    int argc;
    char *argv[];
{
    int copyout = 0;
    int uncompr = 0;
    gzFile file;
    char *bname, outmode[20];

#if !defined(NO_snprintf) && !defined(NO_vsnprintf)
    snprintf(outmode, sizeof(outmode), "%s", "wb6 ");
#else
    strcpy(outmode, "wb6 ");
#endif

    prog = argv[0];
    bname = strrchr(argv[0], '/');
    if (bname)
      bname++;
    else
      bname = argv[0];
    argc--, argv++;

    if (!strcmp(bname, "gunzip"))
      uncompr = 1;
    else if (!strcmp(bname, "zcat"))
      copyout = uncompr = 1;

    while (argc > 0) {
      if (strcmp(*argv, "-c") == 0)
        copyout = 1;
      else if (strcmp(*argv, "-d") == 0)
        uncompr = 1;
      else if (strcmp(*argv, "-f") == 0)
        outmode[3] = 'f';
      else if (strcmp(*argv, "-h") == 0)
        outmode[3] = 'h';
      else if (strcmp(*argv, "-r") == 0)
        outmode[3] = 'R';
      else if ((*argv)[0] == '-' && (*argv)[1] >= '1' && (*argv)[1] <= '9' &&
               (*argv)[2] == 0)
        outmode[2] = (*argv)[1];
      else
        break;
      argc--, argv++;
    }
    if (outmode[3] == ' ')
        outmode[3] = 0;
    if (argc == 0) {
        SET_BINARY_MODE(stdin);
        SET_BINARY_MODE(stdout);
        if (uncompr) {
            file = gzdopen(fileno(stdin), "rb");
            if (file == NULL) error("can't gzdopen stdin");
            gz_uncompress(file, stdout);
        } else {
            file = gzdopen(fileno(stdout), outmode);
            if (file == NULL) error("can't gzdopen stdout");
            gz_compress(stdin, file);
        }
    } else {
        if (copyout) {
            SET_BINARY_MODE(stdout);
        }
        do {
            if (uncompr) {
                if (copyout) {
                    file = gzopen(*argv, "rb");
                    if (file == NULL)
                        fprintf(stderr, "%s: can't gzopen %s\n", prog, *argv);
                    else
                        gz_uncompress(file, stdout);
                } else {
                    file_uncompress(*argv);
                }
            } else {
                if (copyout) {
                    FILE * in = fopen(*argv, "rb");

                    if (in == NULL) {
                        perror(*argv);
                    } else {
                        file = gzdopen(fileno(stdout), outmode);
                        if (file == NULL) error("can't gzdopen stdout");

                        gz_compress(in, file);
                    }

                } else {
                    file_compress(*argv, outmode);
                }
            }
        } while (argv++, --argc);
    }
    return 0;
}

Deleted compat/zlib/treebuild.xml.

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




















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" ?>
<package name="zlib" version="1.2.11">
    <library name="zlib" dlversion="1.2.11" dlname="z">
	<property name="description"> zip compression library </property>
	<property name="include-target-dir" value="$(@PACKAGE/install-includedir)" />

	<!-- fixme: not implemented yet -->
	<property name="compiler/c/inline" value="yes" />

	<include-file name="zlib.h" scope="public" mode="644" />
	<include-file name="zconf.h" scope="public" mode="644" />

	<source name="adler32.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	</source>
	<source name="compress.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	</source>
	<source name="crc32.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="crc32.h" />
	</source>
	<source name="gzclose.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="gzguts.h" />
	</source>
	<source name="gzlib.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="gzguts.h" />
	</source>
	<source name="gzread.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="gzguts.h" />
	</source>
	<source name="gzwrite.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="gzguts.h" />
	</source>
	<source name="uncompr.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	</source>
	<source name="deflate.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="zutil.h" />
	    <depend name="deflate.h" />
	</source>
	<source name="trees.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="zutil.h" />
	    <depend name="deflate.h" />
	    <depend name="trees.h" />
	</source>
	<source name="zutil.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="zutil.h" />
	</source>
	<source name="inflate.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="zutil.h" />
	    <depend name="inftrees.h" />
	    <depend name="inflate.h" />
	    <depend name="inffast.h" />
	</source>
	<source name="infback.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="zutil.h" />
	    <depend name="inftrees.h" />
	    <depend name="inflate.h" />
	    <depend name="inffast.h" />
	</source>
	<source name="inftrees.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="zutil.h" />
	    <depend name="inftrees.h" />
	</source>
	<source name="inffast.c">
	    <depend name="zlib.h" />
	    <depend name="zconf.h" />
	    <depend name="zutil.h" />
	    <depend name="inftrees.h" />
	    <depend name="inflate.h" />
	    <depend name="inffast.h" />
	</source>
    </library>
</package>

<!--
CFLAGS=-O
#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7
#CFLAGS=-g -DZLIB_DEBUG
#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \
#           -Wstrict-prototypes -Wmissing-prototypes

# OBJA =
# to use the asm code: make OBJA=match.o
#
match.o: match.S
	$(CPP) match.S > _match.s
	$(CC) -c _match.s
	mv _match.o match.o
	rm -f _match.s
-->

Deleted compat/zlib/trees.c.

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



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* trees.c -- output deflated data using Huffman coding
 * Copyright (C) 1995-2017 Jean-loup Gailly
 * detect_data_type() function provided freely by Cosmin Truta, 2006
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/*
 *  ALGORITHM
 *
 *      The "deflation" process uses several Huffman trees. The more
 *      common source values are represented by shorter bit sequences.
 *
 *      Each code tree is stored in a compressed form which is itself
 * a Huffman encoding of the lengths of all the code strings (in
 * ascending order by source values).  The actual code strings are
 * reconstructed from the lengths in the inflate process, as described
 * in the deflate specification.
 *
 *  REFERENCES
 *
 *      Deutsch, L.P.,"'Deflate' Compressed Data Format Specification".
 *      Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc
 *
 *      Storer, James A.
 *          Data Compression:  Methods and Theory, pp. 49-50.
 *          Computer Science Press, 1988.  ISBN 0-7167-8156-5.
 *
 *      Sedgewick, R.
 *          Algorithms, p290.
 *          Addison-Wesley, 1983. ISBN 0-201-06672-6.
 */

/* @(#) $Id$ */

/* #define GEN_TREES_H */

#include "deflate.h"

#ifdef ZLIB_DEBUG
#  include <ctype.h>
#endif

/* ===========================================================================
 * Constants
 */

#define MAX_BL_BITS 7
/* Bit length codes must not exceed MAX_BL_BITS bits */

#define END_BLOCK 256
/* end of block literal code */

#define REP_3_6      16
/* repeat previous bit length 3-6 times (2 bits of repeat count) */

#define REPZ_3_10    17
/* repeat a zero length 3-10 times  (3 bits of repeat count) */

#define REPZ_11_138  18
/* repeat a zero length 11-138 times  (7 bits of repeat count) */

local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */
   = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0};

local const int extra_dbits[D_CODES] /* extra bits for each distance code */
   = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13};

local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */
   = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7};

local const uch bl_order[BL_CODES]
   = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15};
/* The lengths of the bit length codes are sent in order of decreasing
 * probability, to avoid transmitting the lengths for unused bit length codes.
 */

/* ===========================================================================
 * Local data. These are initialized only once.
 */

#define DIST_CODE_LEN  512 /* see definition of array dist_code below */

#if defined(GEN_TREES_H) || !defined(STDC)
/* non ANSI compilers may not accept trees.h */

local ct_data static_ltree[L_CODES+2];
/* The static literal tree. Since the bit lengths are imposed, there is no
 * need for the L_CODES extra codes used during heap construction. However
 * The codes 286 and 287 are needed to build a canonical tree (see _tr_init
 * below).
 */

local ct_data static_dtree[D_CODES];
/* The static distance tree. (Actually a trivial tree since all codes use
 * 5 bits.)
 */

uch _dist_code[DIST_CODE_LEN];
/* Distance codes. The first 256 values correspond to the distances
 * 3 .. 258, the last 256 values correspond to the top 8 bits of
 * the 15 bit distances.
 */

uch _length_code[MAX_MATCH-MIN_MATCH+1];
/* length code for each normalized match length (0 == MIN_MATCH) */

local int base_length[LENGTH_CODES];
/* First normalized length for each code (0 = MIN_MATCH) */

local int base_dist[D_CODES];
/* First normalized distance for each code (0 = distance of 1) */

#else
#  include "trees.h"
#endif /* GEN_TREES_H */

struct static_tree_desc_s {
    const ct_data *static_tree;  /* static tree or NULL */
    const intf *extra_bits;      /* extra bits for each code or NULL */
    int     extra_base;          /* base index for extra_bits */
    int     elems;               /* max number of elements in the tree */
    int     max_length;          /* max bit length for the codes */
};

local const static_tree_desc  static_l_desc =
{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS};

local const static_tree_desc  static_d_desc =
{static_dtree, extra_dbits, 0,          D_CODES, MAX_BITS};

local const static_tree_desc  static_bl_desc =
{(const ct_data *)0, extra_blbits, 0,   BL_CODES, MAX_BL_BITS};

/* ===========================================================================
 * Local (static) routines in this file.
 */

local void tr_static_init OF((void));
local void init_block     OF((deflate_state *s));
local void pqdownheap     OF((deflate_state *s, ct_data *tree, int k));
local void gen_bitlen     OF((deflate_state *s, tree_desc *desc));
local void gen_codes      OF((ct_data *tree, int max_code, ushf *bl_count));
local void build_tree     OF((deflate_state *s, tree_desc *desc));
local void scan_tree      OF((deflate_state *s, ct_data *tree, int max_code));
local void send_tree      OF((deflate_state *s, ct_data *tree, int max_code));
local int  build_bl_tree  OF((deflate_state *s));
local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes,
                              int blcodes));
local void compress_block OF((deflate_state *s, const ct_data *ltree,
                              const ct_data *dtree));
local int  detect_data_type OF((deflate_state *s));
local unsigned bi_reverse OF((unsigned value, int length));
local void bi_windup      OF((deflate_state *s));
local void bi_flush       OF((deflate_state *s));

#ifdef GEN_TREES_H
local void gen_trees_header OF((void));
#endif

#ifndef ZLIB_DEBUG
#  define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len)
   /* Send a code of the given tree. c and tree must not have side effects */

#else /* !ZLIB_DEBUG */
#  define send_code(s, c, tree) \
     { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \
       send_bits(s, tree[c].Code, tree[c].Len); }
#endif

/* ===========================================================================
 * Output a short LSB first on the stream.
 * IN assertion: there is enough room in pendingBuf.
 */
#define put_short(s, w) { \
    put_byte(s, (uch)((w) & 0xff)); \
    put_byte(s, (uch)((ush)(w) >> 8)); \
}

/* ===========================================================================
 * Send a value on a given number of bits.
 * IN assertion: length <= 16 and value fits in length bits.
 */
#ifdef ZLIB_DEBUG
local void send_bits      OF((deflate_state *s, int value, int length));

local void send_bits(s, value, length)
    deflate_state *s;
    int value;  /* value to send */
    int length; /* number of bits */
{
    Tracevv((stderr," l %2d v %4x ", length, value));
    Assert(length > 0 && length <= 15, "invalid length");
    s->bits_sent += (ulg)length;

    /* If not enough room in bi_buf, use (valid) bits from bi_buf and
     * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid))
     * unused bits in value.
     */
    if (s->bi_valid > (int)Buf_size - length) {
        s->bi_buf |= (ush)value << s->bi_valid;
        put_short(s, s->bi_buf);
        s->bi_buf = (ush)value >> (Buf_size - s->bi_valid);
        s->bi_valid += length - Buf_size;
    } else {
        s->bi_buf |= (ush)value << s->bi_valid;
        s->bi_valid += length;
    }
}
#else /* !ZLIB_DEBUG */

#define send_bits(s, value, length) \
{ int len = length;\
  if (s->bi_valid > (int)Buf_size - len) {\
    int val = (int)value;\
    s->bi_buf |= (ush)val << s->bi_valid;\
    put_short(s, s->bi_buf);\
    s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\
    s->bi_valid += len - Buf_size;\
  } else {\
    s->bi_buf |= (ush)(value) << s->bi_valid;\
    s->bi_valid += len;\
  }\
}
#endif /* ZLIB_DEBUG */


/* the arguments must not have side effects */

/* ===========================================================================
 * Initialize the various 'constant' tables.
 */
local void tr_static_init()
{
#if defined(GEN_TREES_H) || !defined(STDC)
    static int static_init_done = 0;
    int n;        /* iterates over tree elements */
    int bits;     /* bit counter */
    int length;   /* length value */
    int code;     /* code value */
    int dist;     /* distance index */
    ush bl_count[MAX_BITS+1];
    /* number of codes at each bit length for an optimal tree */

    if (static_init_done) return;

    /* For some embedded targets, global variables are not initialized: */
#ifdef NO_INIT_GLOBAL_POINTERS
    static_l_desc.static_tree = static_ltree;
    static_l_desc.extra_bits = extra_lbits;
    static_d_desc.static_tree = static_dtree;
    static_d_desc.extra_bits = extra_dbits;
    static_bl_desc.extra_bits = extra_blbits;
#endif

    /* Initialize the mapping length (0..255) -> length code (0..28) */
    length = 0;
    for (code = 0; code < LENGTH_CODES-1; code++) {
        base_length[code] = length;
        for (n = 0; n < (1<<extra_lbits[code]); n++) {
            _length_code[length++] = (uch)code;
        }
    }
    Assert (length == 256, "tr_static_init: length != 256");
    /* Note that the length 255 (match length 258) can be represented
     * in two different ways: code 284 + 5 bits or code 285, so we
     * overwrite length_code[255] to use the best encoding:
     */
    _length_code[length-1] = (uch)code;

    /* Initialize the mapping dist (0..32K) -> dist code (0..29) */
    dist = 0;
    for (code = 0 ; code < 16; code++) {
        base_dist[code] = dist;
        for (n = 0; n < (1<<extra_dbits[code]); n++) {
            _dist_code[dist++] = (uch)code;
        }
    }
    Assert (dist == 256, "tr_static_init: dist != 256");
    dist >>= 7; /* from now on, all distances are divided by 128 */
    for ( ; code < D_CODES; code++) {
        base_dist[code] = dist << 7;
        for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) {
            _dist_code[256 + dist++] = (uch)code;
        }
    }
    Assert (dist == 256, "tr_static_init: 256+dist != 512");

    /* Construct the codes of the static literal tree */
    for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0;
    n = 0;
    while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++;
    while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++;
    while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++;
    while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++;
    /* Codes 286 and 287 do not exist, but we must include them in the
     * tree construction to get a canonical Huffman tree (longest code
     * all ones)
     */
    gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count);

    /* The static distance tree is trivial: */
    for (n = 0; n < D_CODES; n++) {
        static_dtree[n].Len = 5;
        static_dtree[n].Code = bi_reverse((unsigned)n, 5);
    }
    static_init_done = 1;

#  ifdef GEN_TREES_H
    gen_trees_header();
#  endif
#endif /* defined(GEN_TREES_H) || !defined(STDC) */
}

/* ===========================================================================
 * Genererate the file trees.h describing the static trees.
 */
#ifdef GEN_TREES_H
#  ifndef ZLIB_DEBUG
#    include <stdio.h>
#  endif

#  define SEPARATOR(i, last, width) \
      ((i) == (last)? "\n};\n\n" :    \
       ((i) % (width) == (width)-1 ? ",\n" : ", "))

void gen_trees_header()
{
    FILE *header = fopen("trees.h", "w");
    int i;

    Assert (header != NULL, "Can't open trees.h");
    fprintf(header,
            "/* header created automatically with -DGEN_TREES_H */\n\n");

    fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n");
    for (i = 0; i < L_CODES+2; i++) {
        fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code,
                static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5));
    }

    fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n");
    for (i = 0; i < D_CODES; i++) {
        fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code,
                static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5));
    }

    fprintf(header, "const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = {\n");
    for (i = 0; i < DIST_CODE_LEN; i++) {
        fprintf(header, "%2u%s", _dist_code[i],
                SEPARATOR(i, DIST_CODE_LEN-1, 20));
    }

    fprintf(header,
        "const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= {\n");
    for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) {
        fprintf(header, "%2u%s", _length_code[i],
                SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20));
    }

    fprintf(header, "local const int base_length[LENGTH_CODES] = {\n");
    for (i = 0; i < LENGTH_CODES; i++) {
        fprintf(header, "%1u%s", base_length[i],
                SEPARATOR(i, LENGTH_CODES-1, 20));
    }

    fprintf(header, "local const int base_dist[D_CODES] = {\n");
    for (i = 0; i < D_CODES; i++) {
        fprintf(header, "%5u%s", base_dist[i],
                SEPARATOR(i, D_CODES-1, 10));
    }

    fclose(header);
}
#endif /* GEN_TREES_H */

/* ===========================================================================
 * Initialize the tree data structures for a new zlib stream.
 */
void ZLIB_INTERNAL _tr_init(s)
    deflate_state *s;
{
    tr_static_init();

    s->l_desc.dyn_tree = s->dyn_ltree;
    s->l_desc.stat_desc = &static_l_desc;

    s->d_desc.dyn_tree = s->dyn_dtree;
    s->d_desc.stat_desc = &static_d_desc;

    s->bl_desc.dyn_tree = s->bl_tree;
    s->bl_desc.stat_desc = &static_bl_desc;

    s->bi_buf = 0;
    s->bi_valid = 0;
#ifdef ZLIB_DEBUG
    s->compressed_len = 0L;
    s->bits_sent = 0L;
#endif

    /* Initialize the first block of the first file: */
    init_block(s);
}

/* ===========================================================================
 * Initialize a new block.
 */
local void init_block(s)
    deflate_state *s;
{
    int n; /* iterates over tree elements */

    /* Initialize the trees. */
    for (n = 0; n < L_CODES;  n++) s->dyn_ltree[n].Freq = 0;
    for (n = 0; n < D_CODES;  n++) s->dyn_dtree[n].Freq = 0;
    for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0;

    s->dyn_ltree[END_BLOCK].Freq = 1;
    s->opt_len = s->static_len = 0L;
    s->last_lit = s->matches = 0;
}

#define SMALLEST 1
/* Index within the heap array of least frequent node in the Huffman tree */


/* ===========================================================================
 * Remove the smallest element from the heap and recreate the heap with
 * one less element. Updates heap and heap_len.
 */
#define pqremove(s, tree, top) \
{\
    top = s->heap[SMALLEST]; \
    s->heap[SMALLEST] = s->heap[s->heap_len--]; \
    pqdownheap(s, tree, SMALLEST); \
}

/* ===========================================================================
 * Compares to subtrees, using the tree depth as tie breaker when
 * the subtrees have equal frequency. This minimizes the worst case length.
 */
#define smaller(tree, n, m, depth) \
   (tree[n].Freq < tree[m].Freq || \
   (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m]))

/* ===========================================================================
 * Restore the heap property by moving down the tree starting at node k,
 * exchanging a node with the smallest of its two sons if necessary, stopping
 * when the heap property is re-established (each father smaller than its
 * two sons).
 */
local void pqdownheap(s, tree, k)
    deflate_state *s;
    ct_data *tree;  /* the tree to restore */
    int k;               /* node to move down */
{
    int v = s->heap[k];
    int j = k << 1;  /* left son of k */
    while (j <= s->heap_len) {
        /* Set j to the smallest of the two sons: */
        if (j < s->heap_len &&
            smaller(tree, s->heap[j+1], s->heap[j], s->depth)) {
            j++;
        }
        /* Exit if v is smaller than both sons */
        if (smaller(tree, v, s->heap[j], s->depth)) break;

        /* Exchange v with the smallest son */
        s->heap[k] = s->heap[j];  k = j;

        /* And continue down the tree, setting j to the left son of k */
        j <<= 1;
    }
    s->heap[k] = v;
}

/* ===========================================================================
 * Compute the optimal bit lengths for a tree and update the total bit length
 * for the current block.
 * IN assertion: the fields freq and dad are set, heap[heap_max] and
 *    above are the tree nodes sorted by increasing frequency.
 * OUT assertions: the field len is set to the optimal bit length, the
 *     array bl_count contains the frequencies for each bit length.
 *     The length opt_len is updated; static_len is also updated if stree is
 *     not null.
 */
local void gen_bitlen(s, desc)
    deflate_state *s;
    tree_desc *desc;    /* the tree descriptor */
{
    ct_data *tree        = desc->dyn_tree;
    int max_code         = desc->max_code;
    const ct_data *stree = desc->stat_desc->static_tree;
    const intf *extra    = desc->stat_desc->extra_bits;
    int base             = desc->stat_desc->extra_base;
    int max_length       = desc->stat_desc->max_length;
    int h;              /* heap index */
    int n, m;           /* iterate over the tree elements */
    int bits;           /* bit length */
    int xbits;          /* extra bits */
    ush f;              /* frequency */
    int overflow = 0;   /* number of elements with bit length too large */

    for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0;

    /* In a first pass, compute the optimal bit lengths (which may
     * overflow in the case of the bit length tree).
     */
    tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */

    for (h = s->heap_max+1; h < HEAP_SIZE; h++) {
        n = s->heap[h];
        bits = tree[tree[n].Dad].Len + 1;
        if (bits > max_length) bits = max_length, overflow++;
        tree[n].Len = (ush)bits;
        /* We overwrite tree[n].Dad which is no longer needed */

        if (n > max_code) continue; /* not a leaf node */

        s->bl_count[bits]++;
        xbits = 0;
        if (n >= base) xbits = extra[n-base];
        f = tree[n].Freq;
        s->opt_len += (ulg)f * (unsigned)(bits + xbits);
        if (stree) s->static_len += (ulg)f * (unsigned)(stree[n].Len + xbits);
    }
    if (overflow == 0) return;

    Tracev((stderr,"\nbit length overflow\n"));
    /* This happens for example on obj2 and pic of the Calgary corpus */

    /* Find the first bit length which could increase: */
    do {
        bits = max_length-1;
        while (s->bl_count[bits] == 0) bits--;
        s->bl_count[bits]--;      /* move one leaf down the tree */
        s->bl_count[bits+1] += 2; /* move one overflow item as its brother */
        s->bl_count[max_length]--;
        /* The brother of the overflow item also moves one step up,
         * but this does not affect bl_count[max_length]
         */
        overflow -= 2;
    } while (overflow > 0);

    /* Now recompute all bit lengths, scanning in increasing frequency.
     * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all
     * lengths instead of fixing only the wrong ones. This idea is taken
     * from 'ar' written by Haruhiko Okumura.)
     */
    for (bits = max_length; bits != 0; bits--) {
        n = s->bl_count[bits];
        while (n != 0) {
            m = s->heap[--h];
            if (m > max_code) continue;
            if ((unsigned) tree[m].Len != (unsigned) bits) {
                Tracev((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits));
                s->opt_len += ((ulg)bits - tree[m].Len) * tree[m].Freq;
                tree[m].Len = (ush)bits;
            }
            n--;
        }
    }
}

/* ===========================================================================
 * Generate the codes for a given tree and bit counts (which need not be
 * optimal).
 * IN assertion: the array bl_count contains the bit length statistics for
 * the given tree and the field len is set for all tree elements.
 * OUT assertion: the field code is set for all tree elements of non
 *     zero code length.
 */
local void gen_codes (tree, max_code, bl_count)
    ct_data *tree;             /* the tree to decorate */
    int max_code;              /* largest code with non zero frequency */
    ushf *bl_count;            /* number of codes at each bit length */
{
    ush next_code[MAX_BITS+1]; /* next code value for each bit length */
    unsigned code = 0;         /* running code value */
    int bits;                  /* bit index */
    int n;                     /* code index */

    /* The distribution counts are first used to generate the code values
     * without bit reversal.
     */
    for (bits = 1; bits <= MAX_BITS; bits++) {
        code = (code + bl_count[bits-1]) << 1;
        next_code[bits] = (ush)code;
    }
    /* Check that the bit counts in bl_count are consistent. The last code
     * must be all ones.
     */
    Assert (code + bl_count[MAX_BITS]-1 == (1<<MAX_BITS)-1,
            "inconsistent bit counts");
    Tracev((stderr,"\ngen_codes: max_code %d ", max_code));

    for (n = 0;  n <= max_code; n++) {
        int len = tree[n].Len;
        if (len == 0) continue;
        /* Now reverse the bits */
        tree[n].Code = (ush)bi_reverse(next_code[len]++, len);

        Tracecv(tree != static_ltree, (stderr,"\nn %3d %c l %2d c %4x (%x) ",
             n, (isgraph(n) ? n : ' '), len, tree[n].Code, next_code[len]-1));
    }
}

/* ===========================================================================
 * Construct one Huffman tree and assigns the code bit strings and lengths.
 * Update the total bit length for the current block.
 * IN assertion: the field freq is set for all tree elements.
 * OUT assertions: the fields len and code are set to the optimal bit length
 *     and corresponding code. The length opt_len is updated; static_len is
 *     also updated if stree is not null. The field max_code is set.
 */
local void build_tree(s, desc)
    deflate_state *s;
    tree_desc *desc; /* the tree descriptor */
{
    ct_data *tree         = desc->dyn_tree;
    const ct_data *stree  = desc->stat_desc->static_tree;
    int elems             = desc->stat_desc->elems;
    int n, m;          /* iterate over heap elements */
    int max_code = -1; /* largest code with non zero frequency */
    int node;          /* new node being created */

    /* Construct the initial heap, with least frequent element in
     * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1].
     * heap[0] is not used.
     */
    s->heap_len = 0, s->heap_max = HEAP_SIZE;

    for (n = 0; n < elems; n++) {
        if (tree[n].Freq != 0) {
            s->heap[++(s->heap_len)] = max_code = n;
            s->depth[n] = 0;
        } else {
            tree[n].Len = 0;
        }
    }

    /* The pkzip format requires that at least one distance code exists,
     * and that at least one bit should be sent even if there is only one
     * possible code. So to avoid special checks later on we force at least
     * two codes of non zero frequency.
     */
    while (s->heap_len < 2) {
        node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0);
        tree[node].Freq = 1;
        s->depth[node] = 0;
        s->opt_len--; if (stree) s->static_len -= stree[node].Len;
        /* node is 0 or 1 so it does not have extra bits */
    }
    desc->max_code = max_code;

    /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree,
     * establish sub-heaps of increasing lengths:
     */
    for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n);

    /* Construct the Huffman tree by repeatedly combining the least two
     * frequent nodes.
     */
    node = elems;              /* next internal node of the tree */
    do {
        pqremove(s, tree, n);  /* n = node of least frequency */
        m = s->heap[SMALLEST]; /* m = node of next least frequency */

        s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */
        s->heap[--(s->heap_max)] = m;

        /* Create a new node father of n and m */
        tree[node].Freq = tree[n].Freq + tree[m].Freq;
        s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ?
                                s->depth[n] : s->depth[m]) + 1);
        tree[n].Dad = tree[m].Dad = (ush)node;
#ifdef DUMP_BL_TREE
        if (tree == s->bl_tree) {
            fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)",
                    node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq);
        }
#endif
        /* and insert the new node in the heap */
        s->heap[SMALLEST] = node++;
        pqdownheap(s, tree, SMALLEST);

    } while (s->heap_len >= 2);

    s->heap[--(s->heap_max)] = s->heap[SMALLEST];

    /* At this point, the fields freq and dad are set. We can now
     * generate the bit lengths.
     */
    gen_bitlen(s, (tree_desc *)desc);

    /* The field len is now set, we can generate the bit codes */
    gen_codes ((ct_data *)tree, max_code, s->bl_count);
}

/* ===========================================================================
 * Scan a literal or distance tree to determine the frequencies of the codes
 * in the bit length tree.
 */
local void scan_tree (s, tree, max_code)
    deflate_state *s;
    ct_data *tree;   /* the tree to be scanned */
    int max_code;    /* and its largest code of non zero frequency */
{
    int n;                     /* iterates over all tree elements */
    int prevlen = -1;          /* last emitted length */
    int curlen;                /* length of current code */
    int nextlen = tree[0].Len; /* length of next code */
    int count = 0;             /* repeat count of the current code */
    int max_count = 7;         /* max repeat count */
    int min_count = 4;         /* min repeat count */

    if (nextlen == 0) max_count = 138, min_count = 3;
    tree[max_code+1].Len = (ush)0xffff; /* guard */

    for (n = 0; n <= max_code; n++) {
        curlen = nextlen; nextlen = tree[n+1].Len;
        if (++count < max_count && curlen == nextlen) {
            continue;
        } else if (count < min_count) {
            s->bl_tree[curlen].Freq += count;
        } else if (curlen != 0) {
            if (curlen != prevlen) s->bl_tree[curlen].Freq++;
            s->bl_tree[REP_3_6].Freq++;
        } else if (count <= 10) {
            s->bl_tree[REPZ_3_10].Freq++;
        } else {
            s->bl_tree[REPZ_11_138].Freq++;
        }
        count = 0; prevlen = curlen;
        if (nextlen == 0) {
            max_count = 138, min_count = 3;
        } else if (curlen == nextlen) {
            max_count = 6, min_count = 3;
        } else {
            max_count = 7, min_count = 4;
        }
    }
}

/* ===========================================================================
 * Send a literal or distance tree in compressed form, using the codes in
 * bl_tree.
 */
local void send_tree (s, tree, max_code)
    deflate_state *s;
    ct_data *tree; /* the tree to be scanned */
    int max_code;       /* and its largest code of non zero frequency */
{
    int n;                     /* iterates over all tree elements */
    int prevlen = -1;          /* last emitted length */
    int curlen;                /* length of current code */
    int nextlen = tree[0].Len; /* length of next code */
    int count = 0;             /* repeat count of the current code */
    int max_count = 7;         /* max repeat count */
    int min_count = 4;         /* min repeat count */

    /* tree[max_code+1].Len = -1; */  /* guard already set */
    if (nextlen == 0) max_count = 138, min_count = 3;

    for (n = 0; n <= max_code; n++) {
        curlen = nextlen; nextlen = tree[n+1].Len;
        if (++count < max_count && curlen == nextlen) {
            continue;
        } else if (count < min_count) {
            do { send_code(s, curlen, s->bl_tree); } while (--count != 0);

        } else if (curlen != 0) {
            if (curlen != prevlen) {
                send_code(s, curlen, s->bl_tree); count--;
            }
            Assert(count >= 3 && count <= 6, " 3_6?");
            send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2);

        } else if (count <= 10) {
            send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3);

        } else {
            send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7);
        }
        count = 0; prevlen = curlen;
        if (nextlen == 0) {
            max_count = 138, min_count = 3;
        } else if (curlen == nextlen) {
            max_count = 6, min_count = 3;
        } else {
            max_count = 7, min_count = 4;
        }
    }
}

/* ===========================================================================
 * Construct the Huffman tree for the bit lengths and return the index in
 * bl_order of the last bit length code to send.
 */
local int build_bl_tree(s)
    deflate_state *s;
{
    int max_blindex;  /* index of last bit length code of non zero freq */

    /* Determine the bit length frequencies for literal and distance trees */
    scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code);
    scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code);

    /* Build the bit length tree: */
    build_tree(s, (tree_desc *)(&(s->bl_desc)));
    /* opt_len now includes the length of the tree representations, except
     * the lengths of the bit lengths codes and the 5+5+4 bits for the counts.
     */

    /* Determine the number of bit length codes to send. The pkzip format
     * requires that at least 4 bit length codes be sent. (appnote.txt says
     * 3 but the actual value used is 4.)
     */
    for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) {
        if (s->bl_tree[bl_order[max_blindex]].Len != 0) break;
    }
    /* Update opt_len to include the bit length tree and counts */
    s->opt_len += 3*((ulg)max_blindex+1) + 5+5+4;
    Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld",
            s->opt_len, s->static_len));

    return max_blindex;
}

/* ===========================================================================
 * Send the header for a block using dynamic Huffman trees: the counts, the
 * lengths of the bit length codes, the literal tree and the distance tree.
 * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4.
 */
local void send_all_trees(s, lcodes, dcodes, blcodes)
    deflate_state *s;
    int lcodes, dcodes, blcodes; /* number of codes for each tree */
{
    int rank;                    /* index in bl_order */

    Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes");
    Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES,
            "too many codes");
    Tracev((stderr, "\nbl counts: "));
    send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */
    send_bits(s, dcodes-1,   5);
    send_bits(s, blcodes-4,  4); /* not -3 as stated in appnote.txt */
    for (rank = 0; rank < blcodes; rank++) {
        Tracev((stderr, "\nbl code %2d ", bl_order[rank]));
        send_bits(s, s->bl_tree[bl_order[rank]].Len, 3);
    }
    Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent));

    send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */
    Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent));

    send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */
    Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent));
}

/* ===========================================================================
 * Send a stored block
 */
void ZLIB_INTERNAL _tr_stored_block(s, buf, stored_len, last)
    deflate_state *s;
    charf *buf;       /* input block */
    ulg stored_len;   /* length of input block */
    int last;         /* one if this is the last block for a file */
{
    send_bits(s, (STORED_BLOCK<<1)+last, 3);    /* send block type */
    bi_windup(s);        /* align on byte boundary */
    put_short(s, (ush)stored_len);
    put_short(s, (ush)~stored_len);
    zmemcpy(s->pending_buf + s->pending, (Bytef *)buf, stored_len);
    s->pending += stored_len;
#ifdef ZLIB_DEBUG
    s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L;
    s->compressed_len += (stored_len + 4) << 3;
    s->bits_sent += 2*16;
    s->bits_sent += stored_len<<3;
#endif
}

/* ===========================================================================
 * Flush the bits in the bit buffer to pending output (leaves at most 7 bits)
 */
void ZLIB_INTERNAL _tr_flush_bits(s)
    deflate_state *s;
{
    bi_flush(s);
}

/* ===========================================================================
 * Send one empty static block to give enough lookahead for inflate.
 * This takes 10 bits, of which 7 may remain in the bit buffer.
 */
void ZLIB_INTERNAL _tr_align(s)
    deflate_state *s;
{
    send_bits(s, STATIC_TREES<<1, 3);
    send_code(s, END_BLOCK, static_ltree);
#ifdef ZLIB_DEBUG
    s->compressed_len += 10L; /* 3 for block type, 7 for EOB */
#endif
    bi_flush(s);
}

/* ===========================================================================
 * Determine the best encoding for the current block: dynamic trees, static
 * trees or store, and write out the encoded block.
 */
void ZLIB_INTERNAL _tr_flush_block(s, buf, stored_len, last)
    deflate_state *s;
    charf *buf;       /* input block, or NULL if too old */
    ulg stored_len;   /* length of input block */
    int last;         /* one if this is the last block for a file */
{
    ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */
    int max_blindex = 0;  /* index of last bit length code of non zero freq */

    /* Build the Huffman trees unless a stored block is forced */
    if (s->level > 0) {

        /* Check if the file is binary or text */
        if (s->strm->data_type == Z_UNKNOWN)
            s->strm->data_type = detect_data_type(s);

        /* Construct the literal and distance trees */
        build_tree(s, (tree_desc *)(&(s->l_desc)));
        Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len,
                s->static_len));

        build_tree(s, (tree_desc *)(&(s->d_desc)));
        Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len,
                s->static_len));
        /* At this point, opt_len and static_len are the total bit lengths of
         * the compressed block data, excluding the tree representations.
         */

        /* Build the bit length tree for the above two trees, and get the index
         * in bl_order of the last bit length code to send.
         */
        max_blindex = build_bl_tree(s);

        /* Determine the best encoding. Compute the block lengths in bytes. */
        opt_lenb = (s->opt_len+3+7)>>3;
        static_lenb = (s->static_len+3+7)>>3;

        Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ",
                opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len,
                s->last_lit));

        if (static_lenb <= opt_lenb) opt_lenb = static_lenb;

    } else {
        Assert(buf != (char*)0, "lost buf");
        opt_lenb = static_lenb = stored_len + 5; /* force a stored block */
    }

#ifdef FORCE_STORED
    if (buf != (char*)0) { /* force stored block */
#else
    if (stored_len+4 <= opt_lenb && buf != (char*)0) {
                       /* 4: two words for the lengths */
#endif
        /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE.
         * Otherwise we can't have processed more than WSIZE input bytes since
         * the last block flush, because compression would have been
         * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to
         * transform a block into a stored block.
         */
        _tr_stored_block(s, buf, stored_len, last);

#ifdef FORCE_STATIC
    } else if (static_lenb >= 0) { /* force static trees */
#else
    } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) {
#endif
        send_bits(s, (STATIC_TREES<<1)+last, 3);
        compress_block(s, (const ct_data *)static_ltree,
                       (const ct_data *)static_dtree);
#ifdef ZLIB_DEBUG
        s->compressed_len += 3 + s->static_len;
#endif
    } else {
        send_bits(s, (DYN_TREES<<1)+last, 3);
        send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1,
                       max_blindex+1);
        compress_block(s, (const ct_data *)s->dyn_ltree,
                       (const ct_data *)s->dyn_dtree);
#ifdef ZLIB_DEBUG
        s->compressed_len += 3 + s->opt_len;
#endif
    }
    Assert (s->compressed_len == s->bits_sent, "bad compressed size");
    /* The above check is made mod 2^32, for files larger than 512 MB
     * and uLong implemented on 32 bits.
     */
    init_block(s);

    if (last) {
        bi_windup(s);
#ifdef ZLIB_DEBUG
        s->compressed_len += 7;  /* align on byte boundary */
#endif
    }
    Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3,
           s->compressed_len-7*last));
}

/* ===========================================================================
 * Save the match info and tally the frequency counts. Return true if
 * the current block must be flushed.
 */
int ZLIB_INTERNAL _tr_tally (s, dist, lc)
    deflate_state *s;
    unsigned dist;  /* distance of matched string */
    unsigned lc;    /* match length-MIN_MATCH or unmatched char (if dist==0) */
{
    s->d_buf[s->last_lit] = (ush)dist;
    s->l_buf[s->last_lit++] = (uch)lc;
    if (dist == 0) {
        /* lc is the unmatched char */
        s->dyn_ltree[lc].Freq++;
    } else {
        s->matches++;
        /* Here, lc is the match length - MIN_MATCH */
        dist--;             /* dist = match distance - 1 */
        Assert((ush)dist < (ush)MAX_DIST(s) &&
               (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) &&
               (ush)d_code(dist) < (ush)D_CODES,  "_tr_tally: bad match");

        s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++;
        s->dyn_dtree[d_code(dist)].Freq++;
    }

#ifdef TRUNCATE_BLOCK
    /* Try to guess if it is profitable to stop the current block here */
    if ((s->last_lit & 0x1fff) == 0 && s->level > 2) {
        /* Compute an upper bound for the compressed length */
        ulg out_length = (ulg)s->last_lit*8L;
        ulg in_length = (ulg)((long)s->strstart - s->block_start);
        int dcode;
        for (dcode = 0; dcode < D_CODES; dcode++) {
            out_length += (ulg)s->dyn_dtree[dcode].Freq *
                (5L+extra_dbits[dcode]);
        }
        out_length >>= 3;
        Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ",
               s->last_lit, in_length, out_length,
               100L - out_length*100L/in_length));
        if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1;
    }
#endif
    return (s->last_lit == s->lit_bufsize-1);
    /* We avoid equality with lit_bufsize because of wraparound at 64K
     * on 16 bit machines and because stored blocks are restricted to
     * 64K-1 bytes.
     */
}

/* ===========================================================================
 * Send the block data compressed using the given Huffman trees
 */
local void compress_block(s, ltree, dtree)
    deflate_state *s;
    const ct_data *ltree; /* literal tree */
    const ct_data *dtree; /* distance tree */
{
    unsigned dist;      /* distance of matched string */
    int lc;             /* match length or unmatched char (if dist == 0) */
    unsigned lx = 0;    /* running index in l_buf */
    unsigned code;      /* the code to send */
    int extra;          /* number of extra bits to send */

    if (s->last_lit != 0) do {
        dist = s->d_buf[lx];
        lc = s->l_buf[lx++];
        if (dist == 0) {
            send_code(s, lc, ltree); /* send a literal byte */
            Tracecv(isgraph(lc), (stderr," '%c' ", lc));
        } else {
            /* Here, lc is the match length - MIN_MATCH */
            code = _length_code[lc];
            send_code(s, code+LITERALS+1, ltree); /* send the length code */
            extra = extra_lbits[code];
            if (extra != 0) {
                lc -= base_length[code];
                send_bits(s, lc, extra);       /* send the extra length bits */
            }
            dist--; /* dist is now the match distance - 1 */
            code = d_code(dist);
            Assert (code < D_CODES, "bad d_code");

            send_code(s, code, dtree);       /* send the distance code */
            extra = extra_dbits[code];
            if (extra != 0) {
                dist -= (unsigned)base_dist[code];
                send_bits(s, dist, extra);   /* send the extra distance bits */
            }
        } /* literal or match pair ? */

        /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */
        Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx,
               "pendingBuf overflow");

    } while (lx < s->last_lit);

    send_code(s, END_BLOCK, ltree);
}

/* ===========================================================================
 * Check if the data type is TEXT or BINARY, using the following algorithm:
 * - TEXT if the two conditions below are satisfied:
 *    a) There are no non-portable control characters belonging to the
 *       "black list" (0..6, 14..25, 28..31).
 *    b) There is at least one printable character belonging to the
 *       "white list" (9 {TAB}, 10 {LF}, 13 {CR}, 32..255).
 * - BINARY otherwise.
 * - The following partially-portable control characters form a
 *   "gray list" that is ignored in this detection algorithm:
 *   (7 {BEL}, 8 {BS}, 11 {VT}, 12 {FF}, 26 {SUB}, 27 {ESC}).
 * IN assertion: the fields Freq of dyn_ltree are set.
 */
local int detect_data_type(s)
    deflate_state *s;
{
    /* black_mask is the bit mask of black-listed bytes
     * set bits 0..6, 14..25, and 28..31
     * 0xf3ffc07f = binary 11110011111111111100000001111111
     */
    unsigned long black_mask = 0xf3ffc07fUL;
    int n;

    /* Check for non-textual ("black-listed") bytes. */
    for (n = 0; n <= 31; n++, black_mask >>= 1)
        if ((black_mask & 1) && (s->dyn_ltree[n].Freq != 0))
            return Z_BINARY;

    /* Check for textual ("white-listed") bytes. */
    if (s->dyn_ltree[9].Freq != 0 || s->dyn_ltree[10].Freq != 0
            || s->dyn_ltree[13].Freq != 0)
        return Z_TEXT;
    for (n = 32; n < LITERALS; n++)
        if (s->dyn_ltree[n].Freq != 0)
            return Z_TEXT;

    /* There are no "black-listed" or "white-listed" bytes:
     * this stream either is empty or has tolerated ("gray-listed") bytes only.
     */
    return Z_BINARY;
}

/* ===========================================================================
 * Reverse the first len bits of a code, using straightforward code (a faster
 * method would use a table)
 * IN assertion: 1 <= len <= 15
 */
local unsigned bi_reverse(code, len)
    unsigned code; /* the value to invert */
    int len;       /* its bit length */
{
    register unsigned res = 0;
    do {
        res |= code & 1;
        code >>= 1, res <<= 1;
    } while (--len > 0);
    return res >> 1;
}

/* ===========================================================================
 * Flush the bit buffer, keeping at most 7 bits in it.
 */
local void bi_flush(s)
    deflate_state *s;
{
    if (s->bi_valid == 16) {
        put_short(s, s->bi_buf);
        s->bi_buf = 0;
        s->bi_valid = 0;
    } else if (s->bi_valid >= 8) {
        put_byte(s, (Byte)s->bi_buf);
        s->bi_buf >>= 8;
        s->bi_valid -= 8;
    }
}

/* ===========================================================================
 * Flush the bit buffer and align the output on a byte boundary
 */
local void bi_windup(s)
    deflate_state *s;
{
    if (s->bi_valid > 8) {
        put_short(s, s->bi_buf);
    } else if (s->bi_valid > 0) {
        put_byte(s, (Byte)s->bi_buf);
    }
    s->bi_buf = 0;
    s->bi_valid = 0;
#ifdef ZLIB_DEBUG
    s->bits_sent = (s->bits_sent+7) & ~7;
#endif
}

Deleted compat/zlib/trees.h.

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
































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* header created automatically with -DGEN_TREES_H */

local const ct_data static_ltree[L_CODES+2] = {
{{ 12},{  8}}, {{140},{  8}}, {{ 76},{  8}}, {{204},{  8}}, {{ 44},{  8}},
{{172},{  8}}, {{108},{  8}}, {{236},{  8}}, {{ 28},{  8}}, {{156},{  8}},
{{ 92},{  8}}, {{220},{  8}}, {{ 60},{  8}}, {{188},{  8}}, {{124},{  8}},
{{252},{  8}}, {{  2},{  8}}, {{130},{  8}}, {{ 66},{  8}}, {{194},{  8}},
{{ 34},{  8}}, {{162},{  8}}, {{ 98},{  8}}, {{226},{  8}}, {{ 18},{  8}},
{{146},{  8}}, {{ 82},{  8}}, {{210},{  8}}, {{ 50},{  8}}, {{178},{  8}},
{{114},{  8}}, {{242},{  8}}, {{ 10},{  8}}, {{138},{  8}}, {{ 74},{  8}},
{{202},{  8}}, {{ 42},{  8}}, {{170},{  8}}, {{106},{  8}}, {{234},{  8}},
{{ 26},{  8}}, {{154},{  8}}, {{ 90},{  8}}, {{218},{  8}}, {{ 58},{  8}},
{{186},{  8}}, {{122},{  8}}, {{250},{  8}}, {{  6},{  8}}, {{134},{  8}},
{{ 70},{  8}}, {{198},{  8}}, {{ 38},{  8}}, {{166},{  8}}, {{102},{  8}},
{{230},{  8}}, {{ 22},{  8}}, {{150},{  8}}, {{ 86},{  8}}, {{214},{  8}},
{{ 54},{  8}}, {{182},{  8}}, {{118},{  8}}, {{246},{  8}}, {{ 14},{  8}},
{{142},{  8}}, {{ 78},{  8}}, {{206},{  8}}, {{ 46},{  8}}, {{174},{  8}},
{{110},{  8}}, {{238},{  8}}, {{ 30},{  8}}, {{158},{  8}}, {{ 94},{  8}},
{{222},{  8}}, {{ 62},{  8}}, {{190},{  8}}, {{126},{  8}}, {{254},{  8}},
{{  1},{  8}}, {{129},{  8}}, {{ 65},{  8}}, {{193},{  8}}, {{ 33},{  8}},
{{161},{  8}}, {{ 97},{  8}}, {{225},{  8}}, {{ 17},{  8}}, {{145},{  8}},
{{ 81},{  8}}, {{209},{  8}}, {{ 49},{  8}}, {{177},{  8}}, {{113},{  8}},
{{241},{  8}}, {{  9},{  8}}, {{137},{  8}}, {{ 73},{  8}}, {{201},{  8}},
{{ 41},{  8}}, {{169},{  8}}, {{105},{  8}}, {{233},{  8}}, {{ 25},{  8}},
{{153},{  8}}, {{ 89},{  8}}, {{217},{  8}}, {{ 57},{  8}}, {{185},{  8}},
{{121},{  8}}, {{249},{  8}}, {{  5},{  8}}, {{133},{  8}}, {{ 69},{  8}},
{{197},{  8}}, {{ 37},{  8}}, {{165},{  8}}, {{101},{  8}}, {{229},{  8}},
{{ 21},{  8}}, {{149},{  8}}, {{ 85},{  8}}, {{213},{  8}}, {{ 53},{  8}},
{{181},{  8}}, {{117},{  8}}, {{245},{  8}}, {{ 13},{  8}}, {{141},{  8}},
{{ 77},{  8}}, {{205},{  8}}, {{ 45},{  8}}, {{173},{  8}}, {{109},{  8}},
{{237},{  8}}, {{ 29},{  8}}, {{157},{  8}}, {{ 93},{  8}}, {{221},{  8}},
{{ 61},{  8}}, {{189},{  8}}, {{125},{  8}}, {{253},{  8}}, {{ 19},{  9}},
{{275},{  9}}, {{147},{  9}}, {{403},{  9}}, {{ 83},{  9}}, {{339},{  9}},
{{211},{  9}}, {{467},{  9}}, {{ 51},{  9}}, {{307},{  9}}, {{179},{  9}},
{{435},{  9}}, {{115},{  9}}, {{371},{  9}}, {{243},{  9}}, {{499},{  9}},
{{ 11},{  9}}, {{267},{  9}}, {{139},{  9}}, {{395},{  9}}, {{ 75},{  9}},
{{331},{  9}}, {{203},{  9}}, {{459},{  9}}, {{ 43},{  9}}, {{299},{  9}},
{{171},{  9}}, {{427},{  9}}, {{107},{  9}}, {{363},{  9}}, {{235},{  9}},
{{491},{  9}}, {{ 27},{  9}}, {{283},{  9}}, {{155},{  9}}, {{411},{  9}},
{{ 91},{  9}}, {{347},{  9}}, {{219},{  9}}, {{475},{  9}}, {{ 59},{  9}},
{{315},{  9}}, {{187},{  9}}, {{443},{  9}}, {{123},{  9}}, {{379},{  9}},
{{251},{  9}}, {{507},{  9}}, {{  7},{  9}}, {{263},{  9}}, {{135},{  9}},
{{391},{  9}}, {{ 71},{  9}}, {{327},{  9}}, {{199},{  9}}, {{455},{  9}},
{{ 39},{  9}}, {{295},{  9}}, {{167},{  9}}, {{423},{  9}}, {{103},{  9}},
{{359},{  9}}, {{231},{  9}}, {{487},{  9}}, {{ 23},{  9}}, {{279},{  9}},
{{151},{  9}}, {{407},{  9}}, {{ 87},{  9}}, {{343},{  9}}, {{215},{  9}},
{{471},{  9}}, {{ 55},{  9}}, {{311},{  9}}, {{183},{  9}}, {{439},{  9}},
{{119},{  9}}, {{375},{  9}}, {{247},{  9}}, {{503},{  9}}, {{ 15},{  9}},
{{271},{  9}}, {{143},{  9}}, {{399},{  9}}, {{ 79},{  9}}, {{335},{  9}},
{{207},{  9}}, {{463},{  9}}, {{ 47},{  9}}, {{303},{  9}}, {{175},{  9}},
{{431},{  9}}, {{111},{  9}}, {{367},{  9}}, {{239},{  9}}, {{495},{  9}},
{{ 31},{  9}}, {{287},{  9}}, {{159},{  9}}, {{415},{  9}}, {{ 95},{  9}},
{{351},{  9}}, {{223},{  9}}, {{479},{  9}}, {{ 63},{  9}}, {{319},{  9}},
{{191},{  9}}, {{447},{  9}}, {{127},{  9}}, {{383},{  9}}, {{255},{  9}},
{{511},{  9}}, {{  0},{  7}}, {{ 64},{  7}}, {{ 32},{  7}}, {{ 96},{  7}},
{{ 16},{  7}}, {{ 80},{  7}}, {{ 48},{  7}}, {{112},{  7}}, {{  8},{  7}},
{{ 72},{  7}}, {{ 40},{  7}}, {{104},{  7}}, {{ 24},{  7}}, {{ 88},{  7}},
{{ 56},{  7}}, {{120},{  7}}, {{  4},{  7}}, {{ 68},{  7}}, {{ 36},{  7}},
{{100},{  7}}, {{ 20},{  7}}, {{ 84},{  7}}, {{ 52},{  7}}, {{116},{  7}},
{{  3},{  8}}, {{131},{  8}}, {{ 67},{  8}}, {{195},{  8}}, {{ 35},{  8}},
{{163},{  8}}, {{ 99},{  8}}, {{227},{  8}}
};

local const ct_data static_dtree[D_CODES] = {
{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}},
{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}},
{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}},
{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}},
{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}},
{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}}
};

const uch ZLIB_INTERNAL _dist_code[DIST_CODE_LEN] = {
 0,  1,  2,  3,  4,  4,  5,  5,  6,  6,  6,  6,  7,  7,  7,  7,  8,  8,  8,  8,
 8,  8,  8,  8,  9,  9,  9,  9,  9,  9,  9,  9, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13,
13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,  0,  0, 16, 17,
18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22,
23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27,
27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29
};

const uch ZLIB_INTERNAL _length_code[MAX_MATCH-MIN_MATCH+1]= {
 0,  1,  2,  3,  4,  5,  6,  7,  8,  8,  9,  9, 10, 10, 11, 11, 12, 12, 12, 12,
13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16,
17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19,
19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22,
22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23,
23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26,
26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28
};

local const int base_length[LENGTH_CODES] = {
0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,
64, 80, 96, 112, 128, 160, 192, 224, 0
};

local const int base_dist[D_CODES] = {
    0,     1,     2,     3,     4,     6,     8,    12,    16,    24,
   32,    48,    64,    96,   128,   192,   256,   384,   512,   768,
 1024,  1536,  2048,  3072,  4096,  6144,  8192, 12288, 16384, 24576
};

Deleted compat/zlib/uncompr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93





























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* uncompr.c -- decompress a memory buffer
 * Copyright (C) 1995-2003, 2010, 2014, 2016 Jean-loup Gailly, Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#define ZLIB_INTERNAL
#include "zlib.h"

/* ===========================================================================
     Decompresses the source buffer into the destination buffer.  *sourceLen is
   the byte length of the source buffer. Upon entry, *destLen is the total size
   of the destination buffer, which must be large enough to hold the entire
   uncompressed data. (The size of the uncompressed data must have been saved
   previously by the compressor and transmitted to the decompressor by some
   mechanism outside the scope of this compression library.) Upon exit,
   *destLen is the size of the decompressed data and *sourceLen is the number
   of source bytes consumed. Upon return, source + *sourceLen points to the
   first unused input byte.

     uncompress returns Z_OK if success, Z_MEM_ERROR if there was not enough
   memory, Z_BUF_ERROR if there was not enough room in the output buffer, or
   Z_DATA_ERROR if the input data was corrupted, including if the input data is
   an incomplete zlib stream.
*/
int ZEXPORT uncompress2 (dest, destLen, source, sourceLen)
    Bytef *dest;
    uLongf *destLen;
    const Bytef *source;
    uLong *sourceLen;
{
    z_stream stream;
    int err;
    const uInt max = (uInt)-1;
    uLong len, left;
    Byte buf[1];    /* for detection of incomplete stream when *destLen == 0 */

    len = *sourceLen;
    if (*destLen) {
        left = *destLen;
        *destLen = 0;
    }
    else {
        left = 1;
        dest = buf;
    }

    stream.next_in = (z_const Bytef *)source;
    stream.avail_in = 0;
    stream.zalloc = (alloc_func)0;
    stream.zfree = (free_func)0;
    stream.opaque = (voidpf)0;

    err = inflateInit(&stream);
    if (err != Z_OK) return err;

    stream.next_out = dest;
    stream.avail_out = 0;

    do {
        if (stream.avail_out == 0) {
            stream.avail_out = left > (uLong)max ? max : (uInt)left;
            left -= stream.avail_out;
        }
        if (stream.avail_in == 0) {
            stream.avail_in = len > (uLong)max ? max : (uInt)len;
            len -= stream.avail_in;
        }
        err = inflate(&stream, Z_NO_FLUSH);
    } while (err == Z_OK);

    *sourceLen -= len + stream.avail_in;
    if (dest != buf)
        *destLen = stream.total_out;
    else if (stream.total_out && err == Z_BUF_ERROR)
        left = 1;

    inflateEnd(&stream);
    return err == Z_STREAM_END ? Z_OK :
           err == Z_NEED_DICT ? Z_DATA_ERROR  :
           err == Z_BUF_ERROR && left + stream.avail_out ? Z_DATA_ERROR :
           err;
}

int ZEXPORT uncompress (dest, destLen, source, sourceLen)
    Bytef *dest;
    uLongf *destLen;
    const Bytef *source;
    uLong sourceLen;
{
    return uncompress2(dest, destLen, source, &sourceLen);
}

Deleted compat/zlib/watcom/watcom_f.mak.

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











































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# OpenWatcom flat model
# Last updated: 28-Dec-2005

# To use, do "wmake -f watcom_f.mak"

C_SOURCE =  adler32.c  compress.c crc32.c   deflate.c    &
	    gzclose.c  gzlib.c    gzread.c  gzwrite.c    &
            infback.c  inffast.c  inflate.c inftrees.c   &
            trees.c    uncompr.c  zutil.c

OBJS =      adler32.obj  compress.obj crc32.obj   deflate.obj    &
	    gzclose.obj  gzlib.obj    gzread.obj  gzwrite.obj    &
            infback.obj  inffast.obj  inflate.obj inftrees.obj   &
            trees.obj    uncompr.obj  zutil.obj

CC       = wcc386
LINKER   = wcl386
CFLAGS   = -zq -mf -3r -fp3 -s -bt=dos -oilrtfm -fr=nul -wx
ZLIB_LIB = zlib_f.lib

.C.OBJ:
        $(CC) $(CFLAGS) $[@

all: $(ZLIB_LIB) example.exe minigzip.exe

$(ZLIB_LIB): $(OBJS)
	wlib -b -c $(ZLIB_LIB) -+adler32.obj  -+compress.obj -+crc32.obj
	wlib -b -c $(ZLIB_LIB) -+gzclose.obj  -+gzlib.obj    -+gzread.obj   -+gzwrite.obj
        wlib -b -c $(ZLIB_LIB) -+deflate.obj  -+infback.obj
        wlib -b -c $(ZLIB_LIB) -+inffast.obj  -+inflate.obj  -+inftrees.obj
        wlib -b -c $(ZLIB_LIB) -+trees.obj    -+uncompr.obj  -+zutil.obj

example.exe: $(ZLIB_LIB) example.obj
	$(LINKER) -ldos32a -fe=example.exe example.obj $(ZLIB_LIB)

minigzip.exe: $(ZLIB_LIB) minigzip.obj
	$(LINKER) -ldos32a -fe=minigzip.exe minigzip.obj $(ZLIB_LIB)

clean: .SYMBOLIC
          del *.obj
          del $(ZLIB_LIB)
          @echo Cleaning done

Deleted compat/zlib/watcom/watcom_l.mak.

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











































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# OpenWatcom large model
# Last updated: 28-Dec-2005

# To use, do "wmake -f watcom_l.mak"

C_SOURCE =  adler32.c  compress.c crc32.c   deflate.c    &
	    gzclose.c  gzlib.c    gzread.c  gzwrite.c    &
            infback.c  inffast.c  inflate.c inftrees.c   &
            trees.c    uncompr.c  zutil.c

OBJS =      adler32.obj  compress.obj crc32.obj   deflate.obj    &
	    gzclose.obj  gzlib.obj    gzread.obj  gzwrite.obj    &
            infback.obj  inffast.obj  inflate.obj inftrees.obj   &
            trees.obj    uncompr.obj  zutil.obj

CC       = wcc
LINKER   = wcl
CFLAGS   = -zq -ml -s -bt=dos -oilrtfm -fr=nul -wx
ZLIB_LIB = zlib_l.lib

.C.OBJ:
        $(CC) $(CFLAGS) $[@

all: $(ZLIB_LIB) example.exe minigzip.exe

$(ZLIB_LIB): $(OBJS)
	wlib -b -c $(ZLIB_LIB) -+adler32.obj  -+compress.obj -+crc32.obj
	wlib -b -c $(ZLIB_LIB) -+gzclose.obj  -+gzlib.obj    -+gzread.obj   -+gzwrite.obj
        wlib -b -c $(ZLIB_LIB) -+deflate.obj  -+infback.obj
        wlib -b -c $(ZLIB_LIB) -+inffast.obj  -+inflate.obj  -+inftrees.obj
        wlib -b -c $(ZLIB_LIB) -+trees.obj    -+uncompr.obj  -+zutil.obj

example.exe: $(ZLIB_LIB) example.obj
	$(LINKER) -fe=example.exe example.obj $(ZLIB_LIB)

minigzip.exe: $(ZLIB_LIB) minigzip.obj
	$(LINKER) -fe=minigzip.exe minigzip.obj $(ZLIB_LIB)

clean: .SYMBOLIC
          del *.obj
          del $(ZLIB_LIB)
          @echo Cleaning done

Deleted compat/zlib/win32/DLL_FAQ.txt.

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
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













































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

            Frequently Asked Questions about ZLIB1.DLL


This document describes the design, the rationale, and the usage
of the official DLL build of zlib, named ZLIB1.DLL.  If you have
general questions about zlib, you should see the file "FAQ" found
in the zlib distribution, or at the following location:
  http://www.gzip.org/zlib/zlib_faq.html


 1. What is ZLIB1.DLL, and how can I get it?

  - ZLIB1.DLL is the official build of zlib as a DLL.
    (Please remark the character '1' in the name.)

    Pointers to a precompiled ZLIB1.DLL can be found in the zlib
    web site at:
      http://www.zlib.net/

    Applications that link to ZLIB1.DLL can rely on the following
    specification:

    * The exported symbols are exclusively defined in the source
      files "zlib.h" and "zlib.def", found in an official zlib
      source distribution.
    * The symbols are exported by name, not by ordinal.
    * The exported names are undecorated.
    * The calling convention of functions is "C" (CDECL).
    * The ZLIB1.DLL binary is linked to MSVCRT.DLL.

    The archive in which ZLIB1.DLL is bundled contains compiled
    test programs that must run with a valid build of ZLIB1.DLL.
    It is recommended to download the prebuilt DLL from the zlib
    web site, instead of building it yourself, to avoid potential
    incompatibilities that could be introduced by your compiler
    and build settings.  If you do build the DLL yourself, please
    make sure that it complies with all the above requirements,
    and it runs with the precompiled test programs, bundled with
    the original ZLIB1.DLL distribution.

    If, for any reason, you need to build an incompatible DLL,
    please use a different file name.


 2. Why did you change the name of the DLL to ZLIB1.DLL?
    What happened to the old ZLIB.DLL?

  - The old ZLIB.DLL, built from zlib-1.1.4 or earlier, required
    compilation settings that were incompatible to those used by
    a static build.  The DLL settings were supposed to be enabled
    by defining the macro ZLIB_DLL, before including "zlib.h".
    Incorrect handling of this macro was silently accepted at
    build time, resulting in two major problems:

    * ZLIB_DLL was missing from the old makefile.  When building
      the DLL, not all people added it to the build options.  In
      consequence, incompatible incarnations of ZLIB.DLL started
      to circulate around the net.

    * When switching from using the static library to using the
      DLL, applications had to define the ZLIB_DLL macro and
      to recompile all the sources that contained calls to zlib
      functions.  Failure to do so resulted in creating binaries
      that were unable to run with the official ZLIB.DLL build.

    The only possible solution that we could foresee was to make
    a binary-incompatible change in the DLL interface, in order to
    remove the dependency on the ZLIB_DLL macro, and to release
    the new DLL under a different name.

    We chose the name ZLIB1.DLL, where '1' indicates the major
    zlib version number.  We hope that we will not have to break
    the binary compatibility again, at least not as long as the
    zlib-1.x series will last.

    There is still a ZLIB_DLL macro, that can trigger a more
    efficient build and use of the DLL, but compatibility no
    longer dependents on it.


 3. Can I build ZLIB.DLL from the new zlib sources, and replace
    an old ZLIB.DLL, that was built from zlib-1.1.4 or earlier?

  - In principle, you can do it by assigning calling convention
    keywords to the macros ZEXPORT and ZEXPORTVA.  In practice,
    it depends on what you mean by "an old ZLIB.DLL", because the
    old DLL exists in several mutually-incompatible versions.
    You have to find out first what kind of calling convention is
    being used in your particular ZLIB.DLL build, and to use the
    same one in the new build.  If you don't know what this is all
    about, you might be better off if you would just leave the old
    DLL intact.


 4. Can I compile my application using the new zlib interface, and
    link it to an old ZLIB.DLL, that was built from zlib-1.1.4 or
    earlier?

  - The official answer is "no"; the real answer depends again on
    what kind of ZLIB.DLL you have.  Even if you are lucky, this
    course of action is unreliable.

    If you rebuild your application and you intend to use a newer
    version of zlib (post- 1.1.4), it is strongly recommended to
    link it to the new ZLIB1.DLL.


 5. Why are the zlib symbols exported by name, and not by ordinal?

  - Although exporting symbols by ordinal is a little faster, it
    is risky.  Any single glitch in the maintenance or use of the
    DEF file that contains the ordinals can result in incompatible
    builds and frustrating crashes.  Simply put, the benefits of
    exporting symbols by ordinal do not justify the risks.

    Technically, it should be possible to maintain ordinals in
    the DEF file, and still export the symbols by name.  Ordinals
    exist in every DLL, and even if the dynamic linking performed
    at the DLL startup is searching for names, ordinals serve as
    hints, for a faster name lookup.  However, if the DEF file
    contains ordinals, the Microsoft linker automatically builds
    an implib that will cause the executables linked to it to use
    those ordinals, and not the names.  It is interesting to
    notice that the GNU linker for Win32 does not suffer from this
    problem.

    It is possible to avoid the DEF file if the exported symbols
    are accompanied by a "__declspec(dllexport)" attribute in the
    source files.  You can do this in zlib by predefining the
    ZLIB_DLL macro.


 6. I see that the ZLIB1.DLL functions use the "C" (CDECL) calling
    convention.  Why not use the STDCALL convention?
    STDCALL is the standard convention in Win32, and I need it in
    my Visual Basic project!

    (For readability, we use CDECL to refer to the convention
     triggered by the "__cdecl" keyword, STDCALL to refer to
     the convention triggered by "__stdcall", and FASTCALL to
     refer to the convention triggered by "__fastcall".)

  - Most of the native Windows API functions (without varargs) use
    indeed the WINAPI convention (which translates to STDCALL in
    Win32), but the standard C functions use CDECL.  If a user
    application is intrinsically tied to the Windows API (e.g.
    it calls native Windows API functions such as CreateFile()),
    sometimes it makes sense to decorate its own functions with
    WINAPI.  But if ANSI C or POSIX portability is a goal (e.g.
    it calls standard C functions such as fopen()), it is not a
    sound decision to request the inclusion of <windows.h>, or to
    use non-ANSI constructs, for the sole purpose to make the user
    functions STDCALL-able.

    The functionality offered by zlib is not in the category of
    "Windows functionality", but is more like "C functionality".

    Technically, STDCALL is not bad; in fact, it is slightly
    faster than CDECL, and it works with variable-argument
    functions, just like CDECL.  It is unfortunate that, in spite
    of using STDCALL in the Windows API, it is not the default
    convention used by the C compilers that run under Windows.
    The roots of the problem reside deep inside the unsafety of
    the K&R-style function prototypes, where the argument types
    are not specified; but that is another story for another day.

    The remaining fact is that CDECL is the default convention.
    Even if an explicit convention is hard-coded into the function
    prototypes inside C headers, problems may appear.  The
    necessity to expose the convention in users' callbacks is one
    of these problems.

    The calling convention issues are also important when using
    zlib in other programming languages.  Some of them, like Ada
    (GNAT) and Fortran (GNU G77), have C bindings implemented
    initially on Unix, and relying on the C calling convention.
    On the other hand, the pre- .NET versions of Microsoft Visual
    Basic require STDCALL, while Borland Delphi prefers, although
    it does not require, FASTCALL.

    In fairness to all possible uses of zlib outside the C
    programming language, we choose the default "C" convention.
    Anyone interested in different bindings or conventions is
    encouraged to maintain specialized projects.  The "contrib/"
    directory from the zlib distribution already holds a couple
    of foreign bindings, such as Ada, C++, and Delphi.


 7. I need a DLL for my Visual Basic project.  What can I do?

  - Define the ZLIB_WINAPI macro before including "zlib.h", when
    building both the DLL and the user application (except that
    you don't need to define anything when using the DLL in Visual
    Basic).  The ZLIB_WINAPI macro will switch on the WINAPI
    (STDCALL) convention.  The name of this DLL must be different
    than the official ZLIB1.DLL.

    Gilles Vollant has contributed a build named ZLIBWAPI.DLL,
    with the ZLIB_WINAPI macro turned on, and with the minizip
    functionality built in.  For more information, please read
    the notes inside "contrib/vstudio/readme.txt", found in the
    zlib distribution.


 8. I need to use zlib in my Microsoft .NET project.  What can I
    do?

  - Henrik Ravn has contributed a .NET wrapper around zlib.  Look
    into contrib/dotzlib/, inside the zlib distribution.


 9. If my application uses ZLIB1.DLL, should I link it to
    MSVCRT.DLL?  Why?

  - It is not required, but it is recommended to link your
    application to MSVCRT.DLL, if it uses ZLIB1.DLL.

    The executables (.EXE, .DLL, etc.) that are involved in the
    same process and are using the C run-time library (i.e. they
    are calling standard C functions), must link to the same
    library.  There are several libraries in the Win32 system:
    CRTDLL.DLL, MSVCRT.DLL, the static C libraries, etc.
    Since ZLIB1.DLL is linked to MSVCRT.DLL, the executables that
    depend on it should also be linked to MSVCRT.DLL.


10. Why are you saying that ZLIB1.DLL and my application should
    be linked to the same C run-time (CRT) library?  I linked my
    application and my DLLs to different C libraries (e.g. my
    application to a static library, and my DLLs to MSVCRT.DLL),
    and everything works fine.

  - If a user library invokes only pure Win32 API (accessible via
    <windows.h> and the related headers), its DLL build will work
    in any context.  But if this library invokes standard C API,
    things get more complicated.

    There is a single Win32 library in a Win32 system.  Every
    function in this library resides in a single DLL module, that
    is safe to call from anywhere.  On the other hand, there are
    multiple versions of the C library, and each of them has its
    own separate internal state.  Standalone executables and user
    DLLs that call standard C functions must link to a C run-time
    (CRT) library, be it static or shared (DLL).  Intermixing
    occurs when an executable (not necessarily standalone) and a
    DLL are linked to different CRTs, and both are running in the
    same process.

    Intermixing multiple CRTs is possible, as long as their
    internal states are kept intact.  The Microsoft Knowledge Base
    articles KB94248 "HOWTO: Use the C Run-Time" and KB140584
    "HOWTO: Link with the Correct C Run-Time (CRT) Library"
    mention the potential problems raised by intermixing.

    If intermixing works for you, it's because your application
    and DLLs are avoiding the corruption of each of the CRTs'
    internal states, maybe by careful design, or maybe by fortune.

    Also note that linking ZLIB1.DLL to non-Microsoft CRTs, such
    as those provided by Borland, raises similar problems.


11. Why are you linking ZLIB1.DLL to MSVCRT.DLL?

  - MSVCRT.DLL exists on every Windows 95 with a new service pack
    installed, or with Microsoft Internet Explorer 4 or later, and
    on all other Windows 4.x or later (Windows 98, Windows NT 4,
    or later).  It is freely distributable; if not present in the
    system, it can be downloaded from Microsoft or from other
    software provider for free.

    The fact that MSVCRT.DLL does not exist on a virgin Windows 95
    is not so problematic.  Windows 95 is scarcely found nowadays,
    Microsoft ended its support a long time ago, and many recent
    applications from various vendors, including Microsoft, do not
    even run on it.  Furthermore, no serious user should run
    Windows 95 without a proper update installed.


12. Why are you not linking ZLIB1.DLL to
    <<my favorite C run-time library>> ?

  - We considered and abandoned the following alternatives:

    * Linking ZLIB1.DLL to a static C library (LIBC.LIB, or
      LIBCMT.LIB) is not a good option.  People are using the DLL
      mainly to save disk space.  If you are linking your program
      to a static C library, you may as well consider linking zlib
      in statically, too.

    * Linking ZLIB1.DLL to CRTDLL.DLL looks appealing, because
      CRTDLL.DLL is present on every Win32 installation.
      Unfortunately, it has a series of problems: it does not
      work properly with Microsoft's C++ libraries, it does not
      provide support for 64-bit file offsets, (and so on...),
      and Microsoft discontinued its support a long time ago.

    * Linking ZLIB1.DLL to MSVCR70.DLL or MSVCR71.DLL, supplied
      with the Microsoft .NET platform, and Visual C++ 7.0/7.1,
      raises problems related to the status of ZLIB1.DLL as a
      system component.  According to the Microsoft Knowledge Base
      article KB326922 "INFO: Redistribution of the Shared C
      Runtime Component in Visual C++ .NET", MSVCR70.DLL and
      MSVCR71.DLL are not supposed to function as system DLLs,
      because they may clash with MSVCRT.DLL.  Instead, the
      application's installer is supposed to put these DLLs
      (if needed) in the application's private directory.
      If ZLIB1.DLL depends on a non-system runtime, it cannot
      function as a redistributable system component.

    * Linking ZLIB1.DLL to non-Microsoft runtimes, such as
      Borland's, or Cygwin's, raises problems related to the
      reliable presence of these runtimes on Win32 systems.
      It's easier to let the DLL build of zlib up to the people
      who distribute these runtimes, and who may proceed as
      explained in the answer to Question 14.


13. If ZLIB1.DLL cannot be linked to MSVCR70.DLL or MSVCR71.DLL,
    how can I build/use ZLIB1.DLL in Microsoft Visual C++ 7.0
    (Visual Studio .NET) or newer?

  - Due to the problems explained in the Microsoft Knowledge Base
    article KB326922 (see the previous answer), the C runtime that
    comes with the VC7 environment is no longer considered a
    system component.  That is, it should not be assumed that this
    runtime exists, or may be installed in a system directory.
    Since ZLIB1.DLL is supposed to be a system component, it may
    not depend on a non-system component.

    In order to link ZLIB1.DLL and your application to MSVCRT.DLL
    in VC7, you need the library of Visual C++ 6.0 or older.  If
    you don't have this library at hand, it's probably best not to
    use ZLIB1.DLL.

    We are hoping that, in the future, Microsoft will provide a
    way to build applications linked to a proper system runtime,
    from the Visual C++ environment.  Until then, you have a
    couple of alternatives, such as linking zlib in statically.
    If your application requires dynamic linking, you may proceed
    as explained in the answer to Question 14.


14. I need to link my own DLL build to a CRT different than
    MSVCRT.DLL.  What can I do?

  - Feel free to rebuild the DLL from the zlib sources, and link
    it the way you want.  You should, however, clearly state that
    your build is unofficial.  You should give it a different file
    name, and/or install it in a private directory that can be
    accessed by your application only, and is not visible to the
    others (i.e. it's neither in the PATH, nor in the SYSTEM or
    SYSTEM32 directories).  Otherwise, your build may clash with
    applications that link to the official build.

    For example, in Cygwin, zlib is linked to the Cygwin runtime
    CYGWIN1.DLL, and it is distributed under the name CYGZ.DLL.


15. May I include additional pieces of code that I find useful,
    link them in ZLIB1.DLL, and export them?

  - No.  A legitimate build of ZLIB1.DLL must not include code
    that does not originate from the official zlib source code.
    But you can make your own private DLL build, under a different
    file name, as suggested in the previous answer.

    For example, zlib is a part of the VCL library, distributed
    with Borland Delphi and C++ Builder.  The DLL build of VCL
    is a redistributable file, named VCLxx.DLL.


16. May I remove some functionality out of ZLIB1.DLL, by enabling
    macros like NO_GZCOMPRESS or NO_GZIP at compile time?

  - No.  A legitimate build of ZLIB1.DLL must provide the complete
    zlib functionality, as implemented in the official zlib source
    code.  But you can make your own private DLL build, under a
    different file name, as suggested in the previous answer.


17. I made my own ZLIB1.DLL build.  Can I test it for compliance?

  - We prefer that you download the official DLL from the zlib
    web site.  If you need something peculiar from this DLL, you
    can send your suggestion to the zlib mailing list.

    However, in case you do rebuild the DLL yourself, you can run
    it with the test programs found in the DLL distribution.
    Running these test programs is not a guarantee of compliance,
    but a failure can imply a detected problem.

**

This document is written and maintained by
Cosmin Truta <cosmint@cs.ubbcluj.ro>

Deleted compat/zlib/win32/Makefile.bor.

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














































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib
# Borland C++ for Win32
#
# Usage:
#  make -f win32/Makefile.bor
#  make -f win32/Makefile.bor LOCAL_ZLIB=-DASMV OBJA=match.obj OBJPA=+match.obj

# ------------ Borland C++ ------------

# Optional nonstandard preprocessor flags (e.g. -DMAX_MEM_LEVEL=7)
# should be added to the environment via "set LOCAL_ZLIB=-DFOO" or
# added to the declaration of LOC here:
LOC = $(LOCAL_ZLIB)

CC = bcc32
AS = bcc32
LD = bcc32
AR = tlib
CFLAGS  = -a -d -k- -O2 $(LOC)
ASFLAGS = $(LOC)
LDFLAGS = $(LOC)


# variables
ZLIB_LIB = zlib.lib

OBJ1 = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj
OBJ2 = gzwrite.obj infback.obj inffast.obj inflate.obj inftrees.obj trees.obj uncompr.obj zutil.obj
#OBJA =
OBJP1 = +adler32.obj+compress.obj+crc32.obj+deflate.obj+gzclose.obj+gzlib.obj+gzread.obj
OBJP2 = +gzwrite.obj+infback.obj+inffast.obj+inflate.obj+inftrees.obj+trees.obj+uncompr.obj+zutil.obj
#OBJPA=


# targets
all: $(ZLIB_LIB) example.exe minigzip.exe

.c.obj:
	$(CC) -c $(CFLAGS) $<

.asm.obj:
	$(AS) -c $(ASFLAGS) $<

adler32.obj: adler32.c zlib.h zconf.h

compress.obj: compress.c zlib.h zconf.h

crc32.obj: crc32.c zlib.h zconf.h crc32.h

deflate.obj: deflate.c deflate.h zutil.h zlib.h zconf.h

gzclose.obj: gzclose.c zlib.h zconf.h gzguts.h

gzlib.obj: gzlib.c zlib.h zconf.h gzguts.h

gzread.obj: gzread.c zlib.h zconf.h gzguts.h

gzwrite.obj: gzwrite.c zlib.h zconf.h gzguts.h

infback.obj: infback.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inffast.obj: inffast.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h

inflate.obj: inflate.c zutil.h zlib.h zconf.h inftrees.h inflate.h \
 inffast.h inffixed.h

inftrees.obj: inftrees.c zutil.h zlib.h zconf.h inftrees.h

trees.obj: trees.c zutil.h zlib.h zconf.h deflate.h trees.h

uncompr.obj: uncompr.c zlib.h zconf.h

zutil.obj: zutil.c zutil.h zlib.h zconf.h

example.obj: test/example.c zlib.h zconf.h

minigzip.obj: test/minigzip.c zlib.h zconf.h


# For the sake of the old Borland make,
# the command line is cut to fit in the MS-DOS 128 byte limit:
$(ZLIB_LIB): $(OBJ1) $(OBJ2) $(OBJA)
	-del $(ZLIB_LIB)
	$(AR) $(ZLIB_LIB) $(OBJP1)
	$(AR) $(ZLIB_LIB) $(OBJP2)
	$(AR) $(ZLIB_LIB) $(OBJPA)


# testing
test: example.exe minigzip.exe
	example
	echo hello world | minigzip | minigzip -d

example.exe: example.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) example.obj $(ZLIB_LIB)

minigzip.exe: minigzip.obj $(ZLIB_LIB)
	$(LD) $(LDFLAGS) minigzip.obj $(ZLIB_LIB)


# cleanup
clean:
	-del $(ZLIB_LIB)
	-del *.obj
	-del *.exe
	-del *.tds
	-del zlib.bak
	-del foo.gz

Deleted compat/zlib/win32/Makefile.gcc.

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






















































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib, derived from Makefile.dj2.
# Modified for mingw32 by C. Spieler, 6/16/98.
# Updated for zlib 1.2.x by Christian Spieler and Cosmin Truta, Mar-2003.
# Last updated: Mar 2012.
# Tested under Cygwin and MinGW.

# Copyright (C) 1995-2003 Jean-loup Gailly.
# For conditions of distribution and use, see copyright notice in zlib.h

# To compile, or to compile and test, type from the top level zlib directory:
#
#   make -fwin32/Makefile.gcc;  make test testdll -fwin32/Makefile.gcc
#
# To use the asm code, type:
#   cp contrib/asm?86/match.S ./match.S
#   make LOC=-DASMV OBJA=match.o -fwin32/Makefile.gcc
#
# To install libz.a, zconf.h and zlib.h in the system directories, type:
#
#   make install -fwin32/Makefile.gcc
#
# BINARY_PATH, INCLUDE_PATH and LIBRARY_PATH must be set.
#
# To install the shared lib, append SHARED_MODE=1 to the make command :
#
#   make install -fwin32/Makefile.gcc SHARED_MODE=1

# Note:
# If the platform is *not* MinGW (e.g. it is Cygwin or UWIN),
# the DLL name should be changed from "zlib1.dll".

STATICLIB = libz.a
SHAREDLIB = zlib1.dll
IMPLIB    = libz.dll.a

#
# Set to 1 if shared object needs to be installed
#
SHARED_MODE=0

#LOC = -DASMV
#LOC = -DZLIB_DEBUG -g

PREFIX =
CC = $(PREFIX)gcc
CFLAGS = $(LOC) -O3 -Wall

AS = $(CC)
ASFLAGS = $(LOC) -Wall

LD = $(CC)
LDFLAGS = $(LOC)

AR = $(PREFIX)ar
ARFLAGS = rcs

RC = $(PREFIX)windres
RCFLAGS = --define GCC_WINDRES

STRIP = $(PREFIX)strip

CP = cp -fp
# If GNU install is available, replace $(CP) with install.
INSTALL = $(CP)
RM = rm -f

prefix ?= /usr/local
exec_prefix = $(prefix)

OBJS = adler32.o compress.o crc32.o deflate.o gzclose.o gzlib.o gzread.o \
       gzwrite.o infback.o inffast.o inflate.o inftrees.o trees.o uncompr.o zutil.o
OBJA =

all: $(STATICLIB) $(SHAREDLIB) $(IMPLIB) example.exe minigzip.exe example_d.exe minigzip_d.exe

test: example.exe minigzip.exe
	./example
	echo hello world | ./minigzip | ./minigzip -d

testdll: example_d.exe minigzip_d.exe
	./example_d
	echo hello world | ./minigzip_d | ./minigzip_d -d

.c.o:
	$(CC) $(CFLAGS) -c -o $@ $<

.S.o:
	$(AS) $(ASFLAGS) -c -o $@ $<

$(STATICLIB): $(OBJS) $(OBJA)
	$(AR) $(ARFLAGS) $@ $(OBJS) $(OBJA)

$(IMPLIB): $(SHAREDLIB)

$(SHAREDLIB): win32/zlib.def $(OBJS) $(OBJA) zlibrc.o
	$(CC) -shared -Wl,--out-implib,$(IMPLIB) $(LDFLAGS) \
	-o $@ win32/zlib.def $(OBJS) $(OBJA) zlibrc.o
	$(STRIP) $@

example.exe: example.o $(STATICLIB)
	$(LD) $(LDFLAGS) -o $@ example.o $(STATICLIB)
	$(STRIP) $@

minigzip.exe: minigzip.o $(STATICLIB)
	$(LD) $(LDFLAGS) -o $@ minigzip.o $(STATICLIB)
	$(STRIP) $@

example_d.exe: example.o $(IMPLIB)
	$(LD) $(LDFLAGS) -o $@ example.o $(IMPLIB)
	$(STRIP) $@

minigzip_d.exe: minigzip.o $(IMPLIB)
	$(LD) $(LDFLAGS) -o $@ minigzip.o $(IMPLIB)
	$(STRIP) $@

example.o: test/example.c zlib.h zconf.h
	$(CC) $(CFLAGS) -I. -c -o $@ test/example.c

minigzip.o: test/minigzip.c zlib.h zconf.h
	$(CC) $(CFLAGS) -I. -c -o $@ test/minigzip.c

zlibrc.o: win32/zlib1.rc
	$(RC) $(RCFLAGS) -o $@ win32/zlib1.rc

.PHONY: install uninstall clean

install: zlib.h zconf.h $(STATICLIB) $(IMPLIB)
	@if test -z "$(DESTDIR)$(INCLUDE_PATH)" -o -z "$(DESTDIR)$(LIBRARY_PATH)" -o -z "$(DESTDIR)$(BINARY_PATH)"; then \
		echo INCLUDE_PATH, LIBRARY_PATH, and BINARY_PATH must be specified; \
		exit 1; \
	fi
	-@mkdir -p '$(DESTDIR)$(INCLUDE_PATH)'
	-@mkdir -p '$(DESTDIR)$(LIBRARY_PATH)' '$(DESTDIR)$(LIBRARY_PATH)'/pkgconfig
	-if [ "$(SHARED_MODE)" = "1" ]; then \
		mkdir -p '$(DESTDIR)$(BINARY_PATH)'; \
		$(INSTALL) $(SHAREDLIB) '$(DESTDIR)$(BINARY_PATH)'; \
		$(INSTALL) $(IMPLIB) '$(DESTDIR)$(LIBRARY_PATH)'; \
	fi
	-$(INSTALL) zlib.h '$(DESTDIR)$(INCLUDE_PATH)'
	-$(INSTALL) zconf.h '$(DESTDIR)$(INCLUDE_PATH)'
	-$(INSTALL) $(STATICLIB) '$(DESTDIR)$(LIBRARY_PATH)'
	sed \
		-e 's|@prefix@|${prefix}|g' \
		-e 's|@exec_prefix@|${exec_prefix}|g' \
		-e 's|@libdir@|$(LIBRARY_PATH)|g' \
		-e 's|@sharedlibdir@|$(LIBRARY_PATH)|g' \
		-e 's|@includedir@|$(INCLUDE_PATH)|g' \
		-e 's|@VERSION@|'`sed -n -e '/VERSION "/s/.*"\(.*\)".*/\1/p' zlib.h`'|g' \
		zlib.pc.in > '$(DESTDIR)$(LIBRARY_PATH)'/pkgconfig/zlib.pc

uninstall:
	-if [ "$(SHARED_MODE)" = "1" ]; then \
		$(RM) '$(DESTDIR)$(BINARY_PATH)'/$(SHAREDLIB); \
		$(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(IMPLIB); \
	fi
	-$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zlib.h
	-$(RM) '$(DESTDIR)$(INCLUDE_PATH)'/zconf.h
	-$(RM) '$(DESTDIR)$(LIBRARY_PATH)'/$(STATICLIB)

clean:
	-$(RM) $(STATICLIB)
	-$(RM) $(SHAREDLIB)
	-$(RM) $(IMPLIB)
	-$(RM) *.o
	-$(RM) *.exe
	-$(RM) foo.gz

adler32.o: zlib.h zconf.h
compress.o: zlib.h zconf.h
crc32.o: crc32.h zlib.h zconf.h
deflate.o: deflate.h zutil.h zlib.h zconf.h
gzclose.o: zlib.h zconf.h gzguts.h
gzlib.o: zlib.h zconf.h gzguts.h
gzread.o: zlib.h zconf.h gzguts.h
gzwrite.o: zlib.h zconf.h gzguts.h
inffast.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inflate.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
infback.o: zutil.h zlib.h zconf.h inftrees.h inflate.h inffast.h
inftrees.o: zutil.h zlib.h zconf.h inftrees.h
trees.o: deflate.h zutil.h zlib.h zconf.h trees.h
uncompr.o: zlib.h zconf.h
zutil.o: zutil.h zlib.h zconf.h

Deleted compat/zlib/win32/Makefile.msc.

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



































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Makefile for zlib using Microsoft (Visual) C
# zlib is copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler
#
# Usage:
#   nmake -f win32/Makefile.msc                          (standard build)
#   nmake -f win32/Makefile.msc LOC=-DFOO                (nonstandard build)
#   nmake -f win32/Makefile.msc LOC="-DASMV -DASMINF" \
#         OBJA="inffas32.obj match686.obj"               (use ASM code, x86)
#   nmake -f win32/Makefile.msc AS=ml64 LOC="-DASMV -DASMINF -I." \
#         OBJA="inffasx64.obj gvmat64.obj inffas8664.obj"  (use ASM code, x64)

# The toplevel directory of the source tree.
#
TOP = .

# optional build flags
LOC =

# variables
STATICLIB = zlib.lib
SHAREDLIB = zlib1.dll
IMPLIB    = zdll.lib

CC = cl
AS = ml
LD = link
AR = lib
RC = rc
CFLAGS  = -nologo -MD -W3 -O2 -Oy- -Zi -Fd"zlib" $(LOC)
WFLAGS  = -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE
ASFLAGS = -coff -Zi $(LOC)
LDFLAGS = -nologo -debug -incremental:no -opt:ref
ARFLAGS = -nologo
RCFLAGS = /dWIN32 /r

OBJS = adler32.obj compress.obj crc32.obj deflate.obj gzclose.obj gzlib.obj gzread.obj \
       gzwrite.obj infback.obj inflate.obj inftrees.obj inffast.obj trees.obj uncompr.obj zutil.obj
OBJA =


# targets
all: $(STATICLIB) $(SHAREDLIB) $(IMPLIB) \
     example.exe minigzip.exe example_d.exe minigzip_d.exe

$(STATICLIB): $(OBJS) $(OBJA)
	$(AR) $(ARFLAGS) -out:$@ $(OBJS) $(OBJA)

$(IMPLIB): $(SHAREDLIB)

$(SHAREDLIB): $(TOP)/win32/zlib.def $(OBJS) $(OBJA) zlib1.res
	$(LD) $(LDFLAGS) -def:$(TOP)/win32/zlib.def -dll -implib:$(IMPLIB) \
	  -out:$@ -base:0x5A4C0000 $(OBJS) $(OBJA) zlib1.res
	if exist $@.manifest \
	  mt -nologo -manifest $@.manifest -outputresource:$@;2

example.exe: example.obj $(STATICLIB)
	$(LD) $(LDFLAGS) example.obj $(STATICLIB)
	if exist $@.manifest \
	  mt -nologo -manifest $@.manifest -outputresource:$@;1

minigzip.exe: minigzip.obj $(STATICLIB)
	$(LD) $(LDFLAGS) minigzip.obj $(STATICLIB)
	if exist $@.manifest \
	  mt -nologo -manifest $@.manifest -outputresource:$@;1

example_d.exe: example.obj $(IMPLIB)
	$(LD) $(LDFLAGS) -out:$@ example.obj $(IMPLIB)
	if exist $@.manifest \
	  mt -nologo -manifest $@.manifest -outputresource:$@;1

minigzip_d.exe: minigzip.obj $(IMPLIB)
	$(LD) $(LDFLAGS) -out:$@ minigzip.obj $(IMPLIB)
	if exist $@.manifest \
	  mt -nologo -manifest $@.manifest -outputresource:$@;1

{$(TOP)}.c.obj:
	$(CC) -c $(WFLAGS) $(CFLAGS) $<

{$(TOP)/test}.c.obj:
	$(CC) -c -I$(TOP) $(WFLAGS) $(CFLAGS) $<

{$(TOP)/contrib/masmx64}.c.obj:
	$(CC) -c $(WFLAGS) $(CFLAGS) $<

{$(TOP)/contrib/masmx64}.asm.obj:
	$(AS) -c $(ASFLAGS) $<

{$(TOP)/contrib/masmx86}.asm.obj:
	$(AS) -c $(ASFLAGS) $<

adler32.obj: $(TOP)/adler32.c $(TOP)/zlib.h $(TOP)/zconf.h

compress.obj: $(TOP)/compress.c $(TOP)/zlib.h $(TOP)/zconf.h

crc32.obj: $(TOP)/crc32.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/crc32.h

deflate.obj: $(TOP)/deflate.c $(TOP)/deflate.h $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h

gzclose.obj: $(TOP)/gzclose.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h

gzlib.obj: $(TOP)/gzlib.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h

gzread.obj: $(TOP)/gzread.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h

gzwrite.obj: $(TOP)/gzwrite.c $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/gzguts.h

infback.obj: $(TOP)/infback.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \
             $(TOP)/inffast.h $(TOP)/inffixed.h

inffast.obj: $(TOP)/inffast.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \
             $(TOP)/inffast.h

inflate.obj: $(TOP)/inflate.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h $(TOP)/inflate.h \
             $(TOP)/inffast.h $(TOP)/inffixed.h

inftrees.obj: $(TOP)/inftrees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/inftrees.h

trees.obj: $(TOP)/trees.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h $(TOP)/deflate.h $(TOP)/trees.h

uncompr.obj: $(TOP)/uncompr.c $(TOP)/zlib.h $(TOP)/zconf.h

zutil.obj: $(TOP)/zutil.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h

gvmat64.obj: $(TOP)/contrib\masmx64\gvmat64.asm

inffasx64.obj: $(TOP)/contrib\masmx64\inffasx64.asm

inffas8664.obj: $(TOP)/contrib\masmx64\inffas8664.c $(TOP)/zutil.h $(TOP)/zlib.h $(TOP)/zconf.h \
		$(TOP)/inftrees.h $(TOP)/inflate.h $(TOP)/inffast.h

inffas32.obj: $(TOP)/contrib\masmx86\inffas32.asm

match686.obj: $(TOP)/contrib\masmx86\match686.asm

example.obj: $(TOP)/test/example.c $(TOP)/zlib.h $(TOP)/zconf.h

minigzip.obj: $(TOP)/test/minigzip.c $(TOP)/zlib.h $(TOP)/zconf.h

zlib1.res: $(TOP)/win32/zlib1.rc
	$(RC) $(RCFLAGS) /fo$@ $(TOP)/win32/zlib1.rc

# testing
test: example.exe minigzip.exe
	example
	echo hello world | minigzip | minigzip -d

testdll: example_d.exe minigzip_d.exe
	example_d
	echo hello world | minigzip_d | minigzip_d -d


# cleanup
clean:
	-del $(STATICLIB)
	-del $(SHAREDLIB)
	-del $(IMPLIB)
	-del *.obj
	-del *.res
	-del *.exp
	-del *.exe
	-del *.pdb
	-del *.manifest
	-del foo.gz

Deleted compat/zlib/win32/README-WIN32.txt.

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







































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
ZLIB DATA COMPRESSION LIBRARY

zlib 1.2.11 is a general purpose data compression library.  All the code is
thread safe.  The data format used by the zlib library is described by RFCs
(Request for Comments) 1950 to 1952 in the files
http://www.ietf.org/rfc/rfc1950.txt (zlib format), rfc1951.txt (deflate format)
and rfc1952.txt (gzip format).

All functions of the compression library are documented in the file zlib.h
(volunteer to write man pages welcome, contact zlib@gzip.org).  Two compiled
examples are distributed in this package, example and minigzip.  The example_d
and minigzip_d flavors validate that the zlib1.dll file is working correctly.

Questions about zlib should be sent to <zlib@gzip.org>.  The zlib home page
is http://zlib.net/ .  Before reporting a problem, please check this site to
verify that you have the latest version of zlib; otherwise get the latest
version and check whether the problem still exists or not.

PLEASE read DLL_FAQ.txt, and the the zlib FAQ http://zlib.net/zlib_faq.html
before asking for help.


Manifest:

The package zlib-1.2.11-win32-x86.zip will contain the following files:

  README-WIN32.txt This document
  ChangeLog        Changes since previous zlib packages
  DLL_FAQ.txt      Frequently asked questions about zlib1.dll
  zlib.3.pdf       Documentation of this library in Adobe Acrobat format

  example.exe      A statically-bound example (using zlib.lib, not the dll)
  example.pdb      Symbolic information for debugging example.exe

  example_d.exe    A zlib1.dll bound example (using zdll.lib)
  example_d.pdb    Symbolic information for debugging example_d.exe

  minigzip.exe     A statically-bound test program (using zlib.lib, not the dll)
  minigzip.pdb     Symbolic information for debugging minigzip.exe

  minigzip_d.exe   A zlib1.dll bound test program (using zdll.lib)
  minigzip_d.pdb   Symbolic information for debugging minigzip_d.exe

  zlib.h           Install these files into the compilers' INCLUDE path to
  zconf.h          compile programs which use zlib.lib or zdll.lib

  zdll.lib         Install these files into the compilers' LIB path if linking
  zdll.exp         a compiled program to the zlib1.dll binary

  zlib.lib         Install these files into the compilers' LIB path to link zlib
  zlib.pdb         into compiled programs, without zlib1.dll runtime dependency
                   (zlib.pdb provides debugging info to the compile time linker)

  zlib1.dll        Install this binary shared library into the system PATH, or
                   the program's runtime directory (where the .exe resides)
  zlib1.pdb        Install in the same directory as zlib1.dll, in order to debug
                   an application crash using WinDbg or similar tools.

All .pdb files above are entirely optional, but are very useful to a developer
attempting to diagnose program misbehavior or a crash.  Many additional
important files for developers can be found in the zlib127.zip source package
available from http://zlib.net/ - review that package's README file for details.


Acknowledgments:

The deflate format used by zlib was defined by Phil Katz.  The deflate and
zlib specifications were written by L.  Peter Deutsch.  Thanks to all the
people who reported problems and suggested various improvements in zlib; they
are too numerous to cite here.


Copyright notice:

  (C) 1995-2017 Jean-loup Gailly and Mark Adler

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Jean-loup Gailly        Mark Adler
  jloup@gzip.org          madler@alumni.caltech.edu

If you use the zlib library in a product, we would appreciate *not* receiving
lengthy legal documents to sign.  The sources are provided for free but without
warranty of any kind.  The library has been entirely written by Jean-loup
Gailly and Mark Adler; it does not include third-party code.

If you redistribute modified sources, we would appreciate that you include in
the file ChangeLog history information documenting your changes.  Please read
the FAQ for more information on the distribution of modified source versions.

Deleted compat/zlib/win32/README.txt.

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




























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

What's here
===========
  The official ZLIB1.DLL


Source
======
  zlib version 1.2.11
  available at http://www.gzip.org/zlib/


Specification and rationale
===========================
  See the accompanying DLL_FAQ.txt


Usage
=====
  See the accompanying USAGE.txt


Build info
==========
  Contributed by Jan Nijtmans.

  Compiler:
    i686-w64-mingw32-gcc (GCC) 5.4.0
  Library:
    mingw64-i686-runtime/headers: 5.0.0
  Build commands:
    i686-w64-mingw32-gcc -c -DASMV contrib/asm686/match.S
    i686-w64-mingw32-gcc -c -DASMINF -I. -O3 contrib/inflate86/inffas86.c
    make -f win32/Makefile.gcc PREFIX=i686-w64-mingw32- LOC="-mms-bitfields -DASMV -DASMINF" OBJA="inffas86.o match.o"
   Finally, from VS commandline (VS2005 or higher):
    lib -machine:X86 -name:zlib1.dll -def:zlib.def -out:zdll.lib

Copyright notice
================
  Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Jean-loup Gailly        Mark Adler
  jloup@gzip.org          madler@alumni.caltech.edu

Deleted compat/zlib/win32/USAGE.txt.

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

































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Installing ZLIB1.DLL
====================
  Copy ZLIB1.DLL to the SYSTEM or the SYSTEM32 directory.
  
  If you want to install the 32-bit dll on a 64-bit
  machine, use the SysWOW64 directory instead.


Using ZLIB1.DLL with Microsoft Visual C++
=========================================
   1. Install the supplied header files "zlib.h" and "zconf.h"
      into a directory found in the INCLUDE path list.

   2. Install the supplied library file "zdll.lib" into a
      directory found in the LIB path list.

   3. Add "zdll.lib" to your project.


Using ZLIB1.DLL with gcc/MinGW
==============================
   1. Install the supplied header files "zlib.h" and "zconf.h"
      into the INCLUDE directory.

   2. (32-bit): Copy the supplied library file "zdll.lib" to "libzdll.a":
        cp lib/zdll.lib lib/libzdll.a

      OR

   2'. (64-bit): Copy the supplied library file "libz.dll.a" to "libzdll.a":
        cp lib/libz.dll.a lib/libzdll.a

      OR

   2'' Build the import library from the supplied "zlib.def":
        dlltool -D zlib1.dll -d lib/zlib.def -l lib/libzdll.a

   3. Install "libzdll.a" into the LIB directory.

   4. Add "libzdll.a" to your project, or use the -lzdll option.


Using ZLIB1.DLL with gcc/Cygwin
===============================
  ZLIB1.DLL is not designed to work with Cygwin.  The Cygwin
  system has its own DLL build of zlib, named CYGZ.DLL.


Using ZLIB1.DLL with Borland C++
================================
   1. Install the supplied header files "zlib.h" and "zconf.h"
      into a directory found in the INCLUDE path list.

   2. Build the import library using the IMPLIB tool:
        implib -a -c -f lib\zdllbor.lib zlib1.dll

      OR

   2' Convert the supplied library file "zdll.lib" to OMF format,
      using the COFF2OMF tool:
        coff2omf lib\zdll.lib lib\zdllbor.lib

   3. Install "zdllbor.lib" into a directory found in the LIB path
      list.

   4. Add "zdllbor.lib" to your project.

  Notes:
  - The modules that are linked with "zdllbor.lib" must be compiled
    using a 4-byte alignment (option -a):
        bcc32 -a -c myprog.c
        bcc32 myprog.obj zdllbor.lib
  - If you wish, you may use "zlib1.lib" instead of "zdllbor.lib".


Rebuilding ZLIB1.DLL
====================
  Depending on your build environment, use the appropriate
  makefile from the win32/ directory, found in the zlib source
  distribution.

  Your custom build has to comply with the requirements stated
  in DLL_FAQ.txt, including (but not limited to) the following:
    - It must be built from an unaltered zlib source distribution.
    - It must be linked to MSVCRT.DLL.
    - The macros that compile out certain portions of the zlib
      code (such as NO_GZCOMPRESS, NO_GZIP) must not be enabled.
    - The ZLIB_WINAPI macro must not be enabled.

  Furthermore, it has to run successfully with the test suite
  found in this package.

  It is recommended, however, to use the supplied ZLIB1.DLL,
  instead of rebuilding it yourself.  You should rebuild it
  only if you have a special reason.

Deleted compat/zlib/win32/VisualC.txt.

1
2
3



-
-
-

To build zlib using the Microsoft Visual C++ environment,
use the appropriate project from the contrib/vstudio/ directory.

Deleted compat/zlib/win32/zdll.lib.

cannot compute difference between binary files

Deleted compat/zlib/win32/zlib.def.

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






























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
; zlib data compression library
EXPORTS
; basic functions
    zlibVersion
    deflate
    deflateEnd
    inflate
    inflateEnd
; advanced functions
    deflateSetDictionary
    deflateGetDictionary
    deflateCopy
    deflateReset
    deflateParams
    deflateTune
    deflateBound
    deflatePending
    deflatePrime
    deflateSetHeader
    inflateSetDictionary
    inflateGetDictionary
    inflateSync
    inflateCopy
    inflateReset
    inflateReset2
    inflatePrime
    inflateMark
    inflateGetHeader
    inflateBack
    inflateBackEnd
    zlibCompileFlags
; utility functions
    compress
    compress2
    compressBound
    uncompress
    uncompress2
    gzopen
    gzdopen
    gzbuffer
    gzsetparams
    gzread
    gzfread
    gzwrite
    gzfwrite
    gzprintf
    gzvprintf
    gzputs
    gzgets
    gzputc
    gzgetc
    gzungetc
    gzflush
    gzseek
    gzrewind
    gztell
    gzoffset
    gzeof
    gzdirect
    gzclose
    gzclose_r
    gzclose_w
    gzerror
    gzclearerr
; large file functions
    gzopen64
    gzseek64
    gztell64
    gzoffset64
    adler32_combine64
    crc32_combine64
; checksum functions
    adler32
    adler32_z
    crc32
    crc32_z
    adler32_combine
    crc32_combine
; various hacks, don't look :)
    deflateInit_
    deflateInit2_
    inflateInit_
    inflateInit2_
    inflateBackInit_
    gzgetc_
    zError
    inflateSyncPoint
    get_crc_table
    inflateUndermine
    inflateValidate
    inflateCodesUsed
    inflateResetKeep
    deflateResetKeep
    gzopen_w

Deleted compat/zlib/win32/zlib1.dll.

cannot compute difference between binary files

Deleted compat/zlib/win32/zlib1.rc.

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








































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <winver.h>
#include "../zlib.h"

#ifdef GCC_WINDRES
VS_VERSION_INFO		VERSIONINFO
#else
VS_VERSION_INFO		VERSIONINFO	MOVEABLE IMPURE LOADONCALL DISCARDABLE
#endif
  FILEVERSION		ZLIB_VER_MAJOR,ZLIB_VER_MINOR,ZLIB_VER_REVISION,0
  PRODUCTVERSION	ZLIB_VER_MAJOR,ZLIB_VER_MINOR,ZLIB_VER_REVISION,0
  FILEFLAGSMASK		VS_FFI_FILEFLAGSMASK
#ifdef _DEBUG
  FILEFLAGS		1
#else
  FILEFLAGS		0
#endif
  FILEOS		VOS__WINDOWS32
  FILETYPE		VFT_DLL
  FILESUBTYPE		0	// not used
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904E4"
    //language ID = U.S. English, char set = Windows, Multilingual
    BEGIN
      VALUE "FileDescription",	"zlib data compression library\0"
      VALUE "FileVersion",	ZLIB_VERSION "\0"
      VALUE "InternalName",	"zlib1.dll\0"
      VALUE "LegalCopyright",	"(C) 1995-2017 Jean-loup Gailly & Mark Adler\0"
      VALUE "OriginalFilename",	"zlib1.dll\0"
      VALUE "ProductName",	"zlib\0"
      VALUE "ProductVersion",	ZLIB_VERSION "\0"
      VALUE "Comments",		"For more information visit http://www.zlib.net/\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x0409, 1252
  END
END

Deleted compat/zlib/win64/libz.dll.a.

cannot compute difference between binary files

Deleted compat/zlib/win64/zdll.lib.

cannot compute difference between binary files

Deleted compat/zlib/win64/zlib1.dll.

cannot compute difference between binary files

Deleted compat/zlib/zconf.h.

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
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
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
524
525
526
527
528
529
530
531
532
533
534






















































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zconf.h -- configuration of the zlib compression library
 * Copyright (C) 1995-2016 Jean-loup Gailly, Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#ifndef ZCONF_H
#define ZCONF_H

/*
 * If you *really* need a unique prefix for all types and library functions,
 * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it.
 * Even better than compiling with -DZ_PREFIX would be to use configure to set
 * this permanently in zconf.h using "./configure --zprefix".
 */
#ifdef Z_PREFIX     /* may be set to #if 1 by ./configure */
#  define Z_PREFIX_SET

/* all linked symbols and init macros */
#  define _dist_code            z__dist_code
#  define _length_code          z__length_code
#  define _tr_align             z__tr_align
#  define _tr_flush_bits        z__tr_flush_bits
#  define _tr_flush_block       z__tr_flush_block
#  define _tr_init              z__tr_init
#  define _tr_stored_block      z__tr_stored_block
#  define _tr_tally             z__tr_tally
#  define adler32               z_adler32
#  define adler32_combine       z_adler32_combine
#  define adler32_combine64     z_adler32_combine64
#  define adler32_z             z_adler32_z
#  ifndef Z_SOLO
#    define compress              z_compress
#    define compress2             z_compress2
#    define compressBound         z_compressBound
#  endif
#  define crc32                 z_crc32
#  define crc32_combine         z_crc32_combine
#  define crc32_combine64       z_crc32_combine64
#  define crc32_z               z_crc32_z
#  define deflate               z_deflate
#  define deflateBound          z_deflateBound
#  define deflateCopy           z_deflateCopy
#  define deflateEnd            z_deflateEnd
#  define deflateGetDictionary  z_deflateGetDictionary
#  define deflateInit           z_deflateInit
#  define deflateInit2          z_deflateInit2
#  define deflateInit2_         z_deflateInit2_
#  define deflateInit_          z_deflateInit_
#  define deflateParams         z_deflateParams
#  define deflatePending        z_deflatePending
#  define deflatePrime          z_deflatePrime
#  define deflateReset          z_deflateReset
#  define deflateResetKeep      z_deflateResetKeep
#  define deflateSetDictionary  z_deflateSetDictionary
#  define deflateSetHeader      z_deflateSetHeader
#  define deflateTune           z_deflateTune
#  define deflate_copyright     z_deflate_copyright
#  define get_crc_table         z_get_crc_table
#  ifndef Z_SOLO
#    define gz_error              z_gz_error
#    define gz_intmax             z_gz_intmax
#    define gz_strwinerror        z_gz_strwinerror
#    define gzbuffer              z_gzbuffer
#    define gzclearerr            z_gzclearerr
#    define gzclose               z_gzclose
#    define gzclose_r             z_gzclose_r
#    define gzclose_w             z_gzclose_w
#    define gzdirect              z_gzdirect
#    define gzdopen               z_gzdopen
#    define gzeof                 z_gzeof
#    define gzerror               z_gzerror
#    define gzflush               z_gzflush
#    define gzfread               z_gzfread
#    define gzfwrite              z_gzfwrite
#    define gzgetc                z_gzgetc
#    define gzgetc_               z_gzgetc_
#    define gzgets                z_gzgets
#    define gzoffset              z_gzoffset
#    define gzoffset64            z_gzoffset64
#    define gzopen                z_gzopen
#    define gzopen64              z_gzopen64
#    ifdef _WIN32
#      define gzopen_w              z_gzopen_w
#    endif
#    define gzprintf              z_gzprintf
#    define gzputc                z_gzputc
#    define gzputs                z_gzputs
#    define gzread                z_gzread
#    define gzrewind              z_gzrewind
#    define gzseek                z_gzseek
#    define gzseek64              z_gzseek64
#    define gzsetparams           z_gzsetparams
#    define gztell                z_gztell
#    define gztell64              z_gztell64
#    define gzungetc              z_gzungetc
#    define gzvprintf             z_gzvprintf
#    define gzwrite               z_gzwrite
#  endif
#  define inflate               z_inflate
#  define inflateBack           z_inflateBack
#  define inflateBackEnd        z_inflateBackEnd
#  define inflateBackInit       z_inflateBackInit
#  define inflateBackInit_      z_inflateBackInit_
#  define inflateCodesUsed      z_inflateCodesUsed
#  define inflateCopy           z_inflateCopy
#  define inflateEnd            z_inflateEnd
#  define inflateGetDictionary  z_inflateGetDictionary
#  define inflateGetHeader      z_inflateGetHeader
#  define inflateInit           z_inflateInit
#  define inflateInit2          z_inflateInit2
#  define inflateInit2_         z_inflateInit2_
#  define inflateInit_          z_inflateInit_
#  define inflateMark           z_inflateMark
#  define inflatePrime          z_inflatePrime
#  define inflateReset          z_inflateReset
#  define inflateReset2         z_inflateReset2
#  define inflateResetKeep      z_inflateResetKeep
#  define inflateSetDictionary  z_inflateSetDictionary
#  define inflateSync           z_inflateSync
#  define inflateSyncPoint      z_inflateSyncPoint
#  define inflateUndermine      z_inflateUndermine
#  define inflateValidate       z_inflateValidate
#  define inflate_copyright     z_inflate_copyright
#  define inflate_fast          z_inflate_fast
#  define inflate_table         z_inflate_table
#  ifndef Z_SOLO
#    define uncompress            z_uncompress
#    define uncompress2           z_uncompress2
#  endif
#  define zError                z_zError
#  ifndef Z_SOLO
#    define zcalloc               z_zcalloc
#    define zcfree                z_zcfree
#  endif
#  define zlibCompileFlags      z_zlibCompileFlags
#  define zlibVersion           z_zlibVersion

/* all zlib typedefs in zlib.h and zconf.h */
#  define Byte                  z_Byte
#  define Bytef                 z_Bytef
#  define alloc_func            z_alloc_func
#  define charf                 z_charf
#  define free_func             z_free_func
#  ifndef Z_SOLO
#    define gzFile                z_gzFile
#  endif
#  define gz_header             z_gz_header
#  define gz_headerp            z_gz_headerp
#  define in_func               z_in_func
#  define intf                  z_intf
#  define out_func              z_out_func
#  define uInt                  z_uInt
#  define uIntf                 z_uIntf
#  define uLong                 z_uLong
#  define uLongf                z_uLongf
#  define voidp                 z_voidp
#  define voidpc                z_voidpc
#  define voidpf                z_voidpf

/* all zlib structs in zlib.h and zconf.h */
#  define gz_header_s           z_gz_header_s
#  define internal_state        z_internal_state

#endif

#if defined(__MSDOS__) && !defined(MSDOS)
#  define MSDOS
#endif
#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2)
#  define OS2
#endif
#if defined(_WINDOWS) && !defined(WINDOWS)
#  define WINDOWS
#endif
#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__)
#  ifndef WIN32
#    define WIN32
#  endif
#endif
#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
#  if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
#    ifndef SYS16BIT
#      define SYS16BIT
#    endif
#  endif
#endif

/*
 * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
 * than 64k bytes at a time (needed on systems with 16-bit int).
 */
#ifdef SYS16BIT
#  define MAXSEG_64K
#endif
#ifdef MSDOS
#  define UNALIGNED_OK
#endif

#ifdef __STDC_VERSION__
#  ifndef STDC
#    define STDC
#  endif
#  if __STDC_VERSION__ >= 199901L
#    ifndef STDC99
#      define STDC99
#    endif
#  endif
#endif
#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
#  define STDC
#endif
#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
#  define STDC
#endif
#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
#  define STDC
#endif
#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
#  define STDC
#endif

#if defined(__OS400__) && !defined(STDC)    /* iSeries (formerly AS/400). */
#  define STDC
#endif

#ifndef STDC
#  ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
#    define const       /* note: need a more gentle solution here */
#  endif
#endif

#if defined(ZLIB_CONST) && !defined(z_const)
#  define z_const const
#else
#  define z_const
#endif

#ifdef Z_SOLO
   typedef unsigned long z_size_t;
#else
#  define z_longlong long long
#  if defined(NO_SIZE_T)
     typedef unsigned NO_SIZE_T z_size_t;
#  elif defined(STDC)
#    include <stddef.h>
     typedef size_t z_size_t;
#  else
     typedef unsigned long z_size_t;
#  endif
#  undef z_longlong
#endif

/* Maximum value for memLevel in deflateInit2 */
#ifndef MAX_MEM_LEVEL
#  ifdef MAXSEG_64K
#    define MAX_MEM_LEVEL 8
#  else
#    define MAX_MEM_LEVEL 9
#  endif
#endif

/* Maximum value for windowBits in deflateInit2 and inflateInit2.
 * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
 * created by gzip. (Files created by minigzip can still be extracted by
 * gzip.)
 */
#ifndef MAX_WBITS
#  define MAX_WBITS   15 /* 32K LZ77 window */
#endif

/* The memory requirements for deflate are (in bytes):
            (1 << (windowBits+2)) +  (1 << (memLevel+9))
 that is: 128K for windowBits=15  +  128K for memLevel = 8  (default values)
 plus a few kilobytes for small objects. For example, if you want to reduce
 the default memory requirements from 256K to 128K, compile with
     make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
 Of course this will generally degrade compression (there's no free lunch).

   The memory requirements for inflate are (in bytes) 1 << windowBits
 that is, 32K for windowBits=15 (default value) plus about 7 kilobytes
 for small objects.
*/

                        /* Type declarations */

#ifndef OF /* function prototypes */
#  ifdef STDC
#    define OF(args)  args
#  else
#    define OF(args)  ()
#  endif
#endif

#ifndef Z_ARG /* function prototypes for stdarg */
#  if defined(STDC) || defined(Z_HAVE_STDARG_H)
#    define Z_ARG(args)  args
#  else
#    define Z_ARG(args)  ()
#  endif
#endif

/* The following definitions for FAR are needed only for MSDOS mixed
 * model programming (small or medium model with some far allocations).
 * This was tested only with MSC; for other MSDOS compilers you may have
 * to define NO_MEMCPY in zutil.h.  If you don't need the mixed model,
 * just define FAR to be empty.
 */
#ifdef SYS16BIT
#  if defined(M_I86SM) || defined(M_I86MM)
     /* MSC small or medium model */
#    define SMALL_MEDIUM
#    ifdef _MSC_VER
#      define FAR _far
#    else
#      define FAR far
#    endif
#  endif
#  if (defined(__SMALL__) || defined(__MEDIUM__))
     /* Turbo C small or medium model */
#    define SMALL_MEDIUM
#    ifdef __BORLANDC__
#      define FAR _far
#    else
#      define FAR far
#    endif
#  endif
#endif

#if defined(WINDOWS) || defined(WIN32)
   /* If building or using zlib as a DLL, define ZLIB_DLL.
    * This is not mandatory, but it offers a little performance increase.
    */
#  ifdef ZLIB_DLL
#    if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
#      ifdef ZLIB_INTERNAL
#        define ZEXTERN extern __declspec(dllexport)
#      else
#        define ZEXTERN extern __declspec(dllimport)
#      endif
#    endif
#  endif  /* ZLIB_DLL */
   /* If building or using zlib with the WINAPI/WINAPIV calling convention,
    * define ZLIB_WINAPI.
    * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
    */
#  ifdef ZLIB_WINAPI
#    ifdef FAR
#      undef FAR
#    endif
#    include <windows.h>
     /* No need for _export, use ZLIB.DEF instead. */
     /* For complete Windows compatibility, use WINAPI, not __stdcall. */
#    define ZEXPORT WINAPI
#    ifdef WIN32
#      define ZEXPORTVA WINAPIV
#    else
#      define ZEXPORTVA FAR CDECL
#    endif
#  endif
#endif

#if defined (__BEOS__)
#  ifdef ZLIB_DLL
#    ifdef ZLIB_INTERNAL
#      define ZEXPORT   __declspec(dllexport)
#      define ZEXPORTVA __declspec(dllexport)
#    else
#      define ZEXPORT   __declspec(dllimport)
#      define ZEXPORTVA __declspec(dllimport)
#    endif
#  endif
#endif

#ifndef ZEXTERN
#  define ZEXTERN extern
#endif
#ifndef ZEXPORT
#  define ZEXPORT
#endif
#ifndef ZEXPORTVA
#  define ZEXPORTVA
#endif

#ifndef FAR
#  define FAR
#endif

#if !defined(__MACTYPES__)
typedef unsigned char  Byte;  /* 8 bits */
#endif
typedef unsigned int   uInt;  /* 16 bits or more */
typedef unsigned long  uLong; /* 32 bits or more */

#ifdef SMALL_MEDIUM
   /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
#  define Bytef Byte FAR
#else
   typedef Byte  FAR Bytef;
#endif
typedef char  FAR charf;
typedef int   FAR intf;
typedef uInt  FAR uIntf;
typedef uLong FAR uLongf;

#ifdef STDC
   typedef void const *voidpc;
   typedef void FAR   *voidpf;
   typedef void       *voidp;
#else
   typedef Byte const *voidpc;
   typedef Byte FAR   *voidpf;
   typedef Byte       *voidp;
#endif

#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
#  include <limits.h>
#  if (UINT_MAX == 0xffffffffUL)
#    define Z_U4 unsigned
#  elif (ULONG_MAX == 0xffffffffUL)
#    define Z_U4 unsigned long
#  elif (USHRT_MAX == 0xffffffffUL)
#    define Z_U4 unsigned short
#  endif
#endif

#ifdef Z_U4
   typedef Z_U4 z_crc_t;
#else
   typedef unsigned long z_crc_t;
#endif

#ifdef HAVE_UNISTD_H    /* may be set to #if 1 by ./configure */
#  define Z_HAVE_UNISTD_H
#endif

#ifdef HAVE_STDARG_H    /* may be set to #if 1 by ./configure */
#  define Z_HAVE_STDARG_H
#endif

#ifdef STDC
#  ifndef Z_SOLO
#    include <sys/types.h>      /* for off_t */
#  endif
#endif

#if defined(STDC) || defined(Z_HAVE_STDARG_H)
#  ifndef Z_SOLO
#    include <stdarg.h>         /* for va_list */
#  endif
#endif

#ifdef _WIN32
#  ifndef Z_SOLO
#    include <stddef.h>         /* for wchar_t */
#  endif
#endif

/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
 * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even
 * though the former does not conform to the LFS document), but considering
 * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
 * equivalently requesting no 64-bit operations
 */
#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
#  undef _LARGEFILE64_SOURCE
#endif

#if defined(__WATCOMC__) && !defined(Z_HAVE_UNISTD_H)
#  define Z_HAVE_UNISTD_H
#endif
#ifndef Z_SOLO
#  if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE)
#    include <unistd.h>         /* for SEEK_*, off_t, and _LFS64_LARGEFILE */
#    ifdef VMS
#      include <unixio.h>       /* for off_t */
#    endif
#    ifndef z_off_t
#      define z_off_t off_t
#    endif
#  endif
#endif

#if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0
#  define Z_LFS64
#endif

#if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64)
#  define Z_LARGE64
#endif

#if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64)
#  define Z_WANT64
#endif

#if !defined(SEEK_SET) && !defined(Z_SOLO)
#  define SEEK_SET        0       /* Seek from beginning of file.  */
#  define SEEK_CUR        1       /* Seek from current position.  */
#  define SEEK_END        2       /* Set file pointer to EOF plus "offset" */
#endif

#ifndef z_off_t
#  define z_off_t long
#endif

#if !defined(_WIN32) && defined(Z_LARGE64)
#  define z_off64_t off64_t
#else
#  if defined(_WIN32) && !defined(__GNUC__) && !defined(Z_SOLO)
#    define z_off64_t __int64
#  else
#    define z_off64_t z_off_t
#  endif
#endif

/* MVS linker does not support external names larger than 8 bytes */
#if defined(__MVS__)
  #pragma map(deflateInit_,"DEIN")
  #pragma map(deflateInit2_,"DEIN2")
  #pragma map(deflateEnd,"DEEND")
  #pragma map(deflateBound,"DEBND")
  #pragma map(inflateInit_,"ININ")
  #pragma map(inflateInit2_,"ININ2")
  #pragma map(inflateEnd,"INEND")
  #pragma map(inflateSync,"INSY")
  #pragma map(inflateSetDictionary,"INSEDI")
  #pragma map(compressBound,"CMBND")
  #pragma map(inflate_table,"INTABL")
  #pragma map(inflate_fast,"INFA")
  #pragma map(inflate_copyright,"INCOPY")
#endif

#endif /* ZCONF_H */

Deleted compat/zlib/zconf.h.cmakein.

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
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
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
524
525
526
527
528
529
530
531
532
533
534
535
536
























































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zconf.h -- configuration of the zlib compression library
 * Copyright (C) 1995-2016 Jean-loup Gailly, Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#ifndef ZCONF_H
#define ZCONF_H
#cmakedefine Z_PREFIX
#cmakedefine Z_HAVE_UNISTD_H

/*
 * If you *really* need a unique prefix for all types and library functions,
 * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it.
 * Even better than compiling with -DZ_PREFIX would be to use configure to set
 * this permanently in zconf.h using "./configure --zprefix".
 */
#ifdef Z_PREFIX     /* may be set to #if 1 by ./configure */
#  define Z_PREFIX_SET

/* all linked symbols and init macros */
#  define _dist_code            z__dist_code
#  define _length_code          z__length_code
#  define _tr_align             z__tr_align
#  define _tr_flush_bits        z__tr_flush_bits
#  define _tr_flush_block       z__tr_flush_block
#  define _tr_init              z__tr_init
#  define _tr_stored_block      z__tr_stored_block
#  define _tr_tally             z__tr_tally
#  define adler32               z_adler32
#  define adler32_combine       z_adler32_combine
#  define adler32_combine64     z_adler32_combine64
#  define adler32_z             z_adler32_z
#  ifndef Z_SOLO
#    define compress              z_compress
#    define compress2             z_compress2
#    define compressBound         z_compressBound
#  endif
#  define crc32                 z_crc32
#  define crc32_combine         z_crc32_combine
#  define crc32_combine64       z_crc32_combine64
#  define crc32_z               z_crc32_z
#  define deflate               z_deflate
#  define deflateBound          z_deflateBound
#  define deflateCopy           z_deflateCopy
#  define deflateEnd            z_deflateEnd
#  define deflateGetDictionary  z_deflateGetDictionary
#  define deflateInit           z_deflateInit
#  define deflateInit2          z_deflateInit2
#  define deflateInit2_         z_deflateInit2_
#  define deflateInit_          z_deflateInit_
#  define deflateParams         z_deflateParams
#  define deflatePending        z_deflatePending
#  define deflatePrime          z_deflatePrime
#  define deflateReset          z_deflateReset
#  define deflateResetKeep      z_deflateResetKeep
#  define deflateSetDictionary  z_deflateSetDictionary
#  define deflateSetHeader      z_deflateSetHeader
#  define deflateTune           z_deflateTune
#  define deflate_copyright     z_deflate_copyright
#  define get_crc_table         z_get_crc_table
#  ifndef Z_SOLO
#    define gz_error              z_gz_error
#    define gz_intmax             z_gz_intmax
#    define gz_strwinerror        z_gz_strwinerror
#    define gzbuffer              z_gzbuffer
#    define gzclearerr            z_gzclearerr
#    define gzclose               z_gzclose
#    define gzclose_r             z_gzclose_r
#    define gzclose_w             z_gzclose_w
#    define gzdirect              z_gzdirect
#    define gzdopen               z_gzdopen
#    define gzeof                 z_gzeof
#    define gzerror               z_gzerror
#    define gzflush               z_gzflush
#    define gzfread               z_gzfread
#    define gzfwrite              z_gzfwrite
#    define gzgetc                z_gzgetc
#    define gzgetc_               z_gzgetc_
#    define gzgets                z_gzgets
#    define gzoffset              z_gzoffset
#    define gzoffset64            z_gzoffset64
#    define gzopen                z_gzopen
#    define gzopen64              z_gzopen64
#    ifdef _WIN32
#      define gzopen_w              z_gzopen_w
#    endif
#    define gzprintf              z_gzprintf
#    define gzputc                z_gzputc
#    define gzputs                z_gzputs
#    define gzread                z_gzread
#    define gzrewind              z_gzrewind
#    define gzseek                z_gzseek
#    define gzseek64              z_gzseek64
#    define gzsetparams           z_gzsetparams
#    define gztell                z_gztell
#    define gztell64              z_gztell64
#    define gzungetc              z_gzungetc
#    define gzvprintf             z_gzvprintf
#    define gzwrite               z_gzwrite
#  endif
#  define inflate               z_inflate
#  define inflateBack           z_inflateBack
#  define inflateBackEnd        z_inflateBackEnd
#  define inflateBackInit       z_inflateBackInit
#  define inflateBackInit_      z_inflateBackInit_
#  define inflateCodesUsed      z_inflateCodesUsed
#  define inflateCopy           z_inflateCopy
#  define inflateEnd            z_inflateEnd
#  define inflateGetDictionary  z_inflateGetDictionary
#  define inflateGetHeader      z_inflateGetHeader
#  define inflateInit           z_inflateInit
#  define inflateInit2          z_inflateInit2
#  define inflateInit2_         z_inflateInit2_
#  define inflateInit_          z_inflateInit_
#  define inflateMark           z_inflateMark
#  define inflatePrime          z_inflatePrime
#  define inflateReset          z_inflateReset
#  define inflateReset2         z_inflateReset2
#  define inflateResetKeep      z_inflateResetKeep
#  define inflateSetDictionary  z_inflateSetDictionary
#  define inflateSync           z_inflateSync
#  define inflateSyncPoint      z_inflateSyncPoint
#  define inflateUndermine      z_inflateUndermine
#  define inflateValidate       z_inflateValidate
#  define inflate_copyright     z_inflate_copyright
#  define inflate_fast          z_inflate_fast
#  define inflate_table         z_inflate_table
#  ifndef Z_SOLO
#    define uncompress            z_uncompress
#    define uncompress2           z_uncompress2
#  endif
#  define zError                z_zError
#  ifndef Z_SOLO
#    define zcalloc               z_zcalloc
#    define zcfree                z_zcfree
#  endif
#  define zlibCompileFlags      z_zlibCompileFlags
#  define zlibVersion           z_zlibVersion

/* all zlib typedefs in zlib.h and zconf.h */
#  define Byte                  z_Byte
#  define Bytef                 z_Bytef
#  define alloc_func            z_alloc_func
#  define charf                 z_charf
#  define free_func             z_free_func
#  ifndef Z_SOLO
#    define gzFile                z_gzFile
#  endif
#  define gz_header             z_gz_header
#  define gz_headerp            z_gz_headerp
#  define in_func               z_in_func
#  define intf                  z_intf
#  define out_func              z_out_func
#  define uInt                  z_uInt
#  define uIntf                 z_uIntf
#  define uLong                 z_uLong
#  define uLongf                z_uLongf
#  define voidp                 z_voidp
#  define voidpc                z_voidpc
#  define voidpf                z_voidpf

/* all zlib structs in zlib.h and zconf.h */
#  define gz_header_s           z_gz_header_s
#  define internal_state        z_internal_state

#endif

#if defined(__MSDOS__) && !defined(MSDOS)
#  define MSDOS
#endif
#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2)
#  define OS2
#endif
#if defined(_WINDOWS) && !defined(WINDOWS)
#  define WINDOWS
#endif
#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__)
#  ifndef WIN32
#    define WIN32
#  endif
#endif
#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
#  if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
#    ifndef SYS16BIT
#      define SYS16BIT
#    endif
#  endif
#endif

/*
 * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
 * than 64k bytes at a time (needed on systems with 16-bit int).
 */
#ifdef SYS16BIT
#  define MAXSEG_64K
#endif
#ifdef MSDOS
#  define UNALIGNED_OK
#endif

#ifdef __STDC_VERSION__
#  ifndef STDC
#    define STDC
#  endif
#  if __STDC_VERSION__ >= 199901L
#    ifndef STDC99
#      define STDC99
#    endif
#  endif
#endif
#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
#  define STDC
#endif
#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
#  define STDC
#endif
#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
#  define STDC
#endif
#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
#  define STDC
#endif

#if defined(__OS400__) && !defined(STDC)    /* iSeries (formerly AS/400). */
#  define STDC
#endif

#ifndef STDC
#  ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
#    define const       /* note: need a more gentle solution here */
#  endif
#endif

#if defined(ZLIB_CONST) && !defined(z_const)
#  define z_const const
#else
#  define z_const
#endif

#ifdef Z_SOLO
   typedef unsigned long z_size_t;
#else
#  define z_longlong long long
#  if defined(NO_SIZE_T)
     typedef unsigned NO_SIZE_T z_size_t;
#  elif defined(STDC)
#    include <stddef.h>
     typedef size_t z_size_t;
#  else
     typedef unsigned long z_size_t;
#  endif
#  undef z_longlong
#endif

/* Maximum value for memLevel in deflateInit2 */
#ifndef MAX_MEM_LEVEL
#  ifdef MAXSEG_64K
#    define MAX_MEM_LEVEL 8
#  else
#    define MAX_MEM_LEVEL 9
#  endif
#endif

/* Maximum value for windowBits in deflateInit2 and inflateInit2.
 * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
 * created by gzip. (Files created by minigzip can still be extracted by
 * gzip.)
 */
#ifndef MAX_WBITS
#  define MAX_WBITS   15 /* 32K LZ77 window */
#endif

/* The memory requirements for deflate are (in bytes):
            (1 << (windowBits+2)) +  (1 << (memLevel+9))
 that is: 128K for windowBits=15  +  128K for memLevel = 8  (default values)
 plus a few kilobytes for small objects. For example, if you want to reduce
 the default memory requirements from 256K to 128K, compile with
     make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
 Of course this will generally degrade compression (there's no free lunch).

   The memory requirements for inflate are (in bytes) 1 << windowBits
 that is, 32K for windowBits=15 (default value) plus about 7 kilobytes
 for small objects.
*/

                        /* Type declarations */

#ifndef OF /* function prototypes */
#  ifdef STDC
#    define OF(args)  args
#  else
#    define OF(args)  ()
#  endif
#endif

#ifndef Z_ARG /* function prototypes for stdarg */
#  if defined(STDC) || defined(Z_HAVE_STDARG_H)
#    define Z_ARG(args)  args
#  else
#    define Z_ARG(args)  ()
#  endif
#endif

/* The following definitions for FAR are needed only for MSDOS mixed
 * model programming (small or medium model with some far allocations).
 * This was tested only with MSC; for other MSDOS compilers you may have
 * to define NO_MEMCPY in zutil.h.  If you don't need the mixed model,
 * just define FAR to be empty.
 */
#ifdef SYS16BIT
#  if defined(M_I86SM) || defined(M_I86MM)
     /* MSC small or medium model */
#    define SMALL_MEDIUM
#    ifdef _MSC_VER
#      define FAR _far
#    else
#      define FAR far
#    endif
#  endif
#  if (defined(__SMALL__) || defined(__MEDIUM__))
     /* Turbo C small or medium model */
#    define SMALL_MEDIUM
#    ifdef __BORLANDC__
#      define FAR _far
#    else
#      define FAR far
#    endif
#  endif
#endif

#if defined(WINDOWS) || defined(WIN32)
   /* If building or using zlib as a DLL, define ZLIB_DLL.
    * This is not mandatory, but it offers a little performance increase.
    */
#  ifdef ZLIB_DLL
#    if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
#      ifdef ZLIB_INTERNAL
#        define ZEXTERN extern __declspec(dllexport)
#      else
#        define ZEXTERN extern __declspec(dllimport)
#      endif
#    endif
#  endif  /* ZLIB_DLL */
   /* If building or using zlib with the WINAPI/WINAPIV calling convention,
    * define ZLIB_WINAPI.
    * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
    */
#  ifdef ZLIB_WINAPI
#    ifdef FAR
#      undef FAR
#    endif
#    include <windows.h>
     /* No need for _export, use ZLIB.DEF instead. */
     /* For complete Windows compatibility, use WINAPI, not __stdcall. */
#    define ZEXPORT WINAPI
#    ifdef WIN32
#      define ZEXPORTVA WINAPIV
#    else
#      define ZEXPORTVA FAR CDECL
#    endif
#  endif
#endif

#if defined (__BEOS__)
#  ifdef ZLIB_DLL
#    ifdef ZLIB_INTERNAL
#      define ZEXPORT   __declspec(dllexport)
#      define ZEXPORTVA __declspec(dllexport)
#    else
#      define ZEXPORT   __declspec(dllimport)
#      define ZEXPORTVA __declspec(dllimport)
#    endif
#  endif
#endif

#ifndef ZEXTERN
#  define ZEXTERN extern
#endif
#ifndef ZEXPORT
#  define ZEXPORT
#endif
#ifndef ZEXPORTVA
#  define ZEXPORTVA
#endif

#ifndef FAR
#  define FAR
#endif

#if !defined(__MACTYPES__)
typedef unsigned char  Byte;  /* 8 bits */
#endif
typedef unsigned int   uInt;  /* 16 bits or more */
typedef unsigned long  uLong; /* 32 bits or more */

#ifdef SMALL_MEDIUM
   /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
#  define Bytef Byte FAR
#else
   typedef Byte  FAR Bytef;
#endif
typedef char  FAR charf;
typedef int   FAR intf;
typedef uInt  FAR uIntf;
typedef uLong FAR uLongf;

#ifdef STDC
   typedef void const *voidpc;
   typedef void FAR   *voidpf;
   typedef void       *voidp;
#else
   typedef Byte const *voidpc;
   typedef Byte FAR   *voidpf;
   typedef Byte       *voidp;
#endif

#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
#  include <limits.h>
#  if (UINT_MAX == 0xffffffffUL)
#    define Z_U4 unsigned
#  elif (ULONG_MAX == 0xffffffffUL)
#    define Z_U4 unsigned long
#  elif (USHRT_MAX == 0xffffffffUL)
#    define Z_U4 unsigned short
#  endif
#endif

#ifdef Z_U4
   typedef Z_U4 z_crc_t;
#else
   typedef unsigned long z_crc_t;
#endif

#ifdef HAVE_UNISTD_H    /* may be set to #if 1 by ./configure */
#  define Z_HAVE_UNISTD_H
#endif

#ifdef HAVE_STDARG_H    /* may be set to #if 1 by ./configure */
#  define Z_HAVE_STDARG_H
#endif

#ifdef STDC
#  ifndef Z_SOLO
#    include <sys/types.h>      /* for off_t */
#  endif
#endif

#if defined(STDC) || defined(Z_HAVE_STDARG_H)
#  ifndef Z_SOLO
#    include <stdarg.h>         /* for va_list */
#  endif
#endif

#ifdef _WIN32
#  ifndef Z_SOLO
#    include <stddef.h>         /* for wchar_t */
#  endif
#endif

/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
 * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even
 * though the former does not conform to the LFS document), but considering
 * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
 * equivalently requesting no 64-bit operations
 */
#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
#  undef _LARGEFILE64_SOURCE
#endif

#if defined(__WATCOMC__) && !defined(Z_HAVE_UNISTD_H)
#  define Z_HAVE_UNISTD_H
#endif
#ifndef Z_SOLO
#  if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE)
#    include <unistd.h>         /* for SEEK_*, off_t, and _LFS64_LARGEFILE */
#    ifdef VMS
#      include <unixio.h>       /* for off_t */
#    endif
#    ifndef z_off_t
#      define z_off_t off_t
#    endif
#  endif
#endif

#if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0
#  define Z_LFS64
#endif

#if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64)
#  define Z_LARGE64
#endif

#if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64)
#  define Z_WANT64
#endif

#if !defined(SEEK_SET) && !defined(Z_SOLO)
#  define SEEK_SET        0       /* Seek from beginning of file.  */
#  define SEEK_CUR        1       /* Seek from current position.  */
#  define SEEK_END        2       /* Set file pointer to EOF plus "offset" */
#endif

#ifndef z_off_t
#  define z_off_t long
#endif

#if !defined(_WIN32) && defined(Z_LARGE64)
#  define z_off64_t off64_t
#else
#  if defined(_WIN32) && !defined(__GNUC__) && !defined(Z_SOLO)
#    define z_off64_t __int64
#  else
#    define z_off64_t z_off_t
#  endif
#endif

/* MVS linker does not support external names larger than 8 bytes */
#if defined(__MVS__)
  #pragma map(deflateInit_,"DEIN")
  #pragma map(deflateInit2_,"DEIN2")
  #pragma map(deflateEnd,"DEEND")
  #pragma map(deflateBound,"DEBND")
  #pragma map(inflateInit_,"ININ")
  #pragma map(inflateInit2_,"ININ2")
  #pragma map(inflateEnd,"INEND")
  #pragma map(inflateSync,"INSY")
  #pragma map(inflateSetDictionary,"INSEDI")
  #pragma map(compressBound,"CMBND")
  #pragma map(inflate_table,"INTABL")
  #pragma map(inflate_fast,"INFA")
  #pragma map(inflate_copyright,"INCOPY")
#endif

#endif /* ZCONF_H */

Deleted compat/zlib/zconf.h.in.

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
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
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
524
525
526
527
528
529
530
531
532
533
534






















































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zconf.h -- configuration of the zlib compression library
 * Copyright (C) 1995-2016 Jean-loup Gailly, Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#ifndef ZCONF_H
#define ZCONF_H

/*
 * If you *really* need a unique prefix for all types and library functions,
 * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it.
 * Even better than compiling with -DZ_PREFIX would be to use configure to set
 * this permanently in zconf.h using "./configure --zprefix".
 */
#ifdef Z_PREFIX     /* may be set to #if 1 by ./configure */
#  define Z_PREFIX_SET

/* all linked symbols and init macros */
#  define _dist_code            z__dist_code
#  define _length_code          z__length_code
#  define _tr_align             z__tr_align
#  define _tr_flush_bits        z__tr_flush_bits
#  define _tr_flush_block       z__tr_flush_block
#  define _tr_init              z__tr_init
#  define _tr_stored_block      z__tr_stored_block
#  define _tr_tally             z__tr_tally
#  define adler32               z_adler32
#  define adler32_combine       z_adler32_combine
#  define adler32_combine64     z_adler32_combine64
#  define adler32_z             z_adler32_z
#  ifndef Z_SOLO
#    define compress              z_compress
#    define compress2             z_compress2
#    define compressBound         z_compressBound
#  endif
#  define crc32                 z_crc32
#  define crc32_combine         z_crc32_combine
#  define crc32_combine64       z_crc32_combine64
#  define crc32_z               z_crc32_z
#  define deflate               z_deflate
#  define deflateBound          z_deflateBound
#  define deflateCopy           z_deflateCopy
#  define deflateEnd            z_deflateEnd
#  define deflateGetDictionary  z_deflateGetDictionary
#  define deflateInit           z_deflateInit
#  define deflateInit2          z_deflateInit2
#  define deflateInit2_         z_deflateInit2_
#  define deflateInit_          z_deflateInit_
#  define deflateParams         z_deflateParams
#  define deflatePending        z_deflatePending
#  define deflatePrime          z_deflatePrime
#  define deflateReset          z_deflateReset
#  define deflateResetKeep      z_deflateResetKeep
#  define deflateSetDictionary  z_deflateSetDictionary
#  define deflateSetHeader      z_deflateSetHeader
#  define deflateTune           z_deflateTune
#  define deflate_copyright     z_deflate_copyright
#  define get_crc_table         z_get_crc_table
#  ifndef Z_SOLO
#    define gz_error              z_gz_error
#    define gz_intmax             z_gz_intmax
#    define gz_strwinerror        z_gz_strwinerror
#    define gzbuffer              z_gzbuffer
#    define gzclearerr            z_gzclearerr
#    define gzclose               z_gzclose
#    define gzclose_r             z_gzclose_r
#    define gzclose_w             z_gzclose_w
#    define gzdirect              z_gzdirect
#    define gzdopen               z_gzdopen
#    define gzeof                 z_gzeof
#    define gzerror               z_gzerror
#    define gzflush               z_gzflush
#    define gzfread               z_gzfread
#    define gzfwrite              z_gzfwrite
#    define gzgetc                z_gzgetc
#    define gzgetc_               z_gzgetc_
#    define gzgets                z_gzgets
#    define gzoffset              z_gzoffset
#    define gzoffset64            z_gzoffset64
#    define gzopen                z_gzopen
#    define gzopen64              z_gzopen64
#    ifdef _WIN32
#      define gzopen_w              z_gzopen_w
#    endif
#    define gzprintf              z_gzprintf
#    define gzputc                z_gzputc
#    define gzputs                z_gzputs
#    define gzread                z_gzread
#    define gzrewind              z_gzrewind
#    define gzseek                z_gzseek
#    define gzseek64              z_gzseek64
#    define gzsetparams           z_gzsetparams
#    define gztell                z_gztell
#    define gztell64              z_gztell64
#    define gzungetc              z_gzungetc
#    define gzvprintf             z_gzvprintf
#    define gzwrite               z_gzwrite
#  endif
#  define inflate               z_inflate
#  define inflateBack           z_inflateBack
#  define inflateBackEnd        z_inflateBackEnd
#  define inflateBackInit       z_inflateBackInit
#  define inflateBackInit_      z_inflateBackInit_
#  define inflateCodesUsed      z_inflateCodesUsed
#  define inflateCopy           z_inflateCopy
#  define inflateEnd            z_inflateEnd
#  define inflateGetDictionary  z_inflateGetDictionary
#  define inflateGetHeader      z_inflateGetHeader
#  define inflateInit           z_inflateInit
#  define inflateInit2          z_inflateInit2
#  define inflateInit2_         z_inflateInit2_
#  define inflateInit_          z_inflateInit_
#  define inflateMark           z_inflateMark
#  define inflatePrime          z_inflatePrime
#  define inflateReset          z_inflateReset
#  define inflateReset2         z_inflateReset2
#  define inflateResetKeep      z_inflateResetKeep
#  define inflateSetDictionary  z_inflateSetDictionary
#  define inflateSync           z_inflateSync
#  define inflateSyncPoint      z_inflateSyncPoint
#  define inflateUndermine      z_inflateUndermine
#  define inflateValidate       z_inflateValidate
#  define inflate_copyright     z_inflate_copyright
#  define inflate_fast          z_inflate_fast
#  define inflate_table         z_inflate_table
#  ifndef Z_SOLO
#    define uncompress            z_uncompress
#    define uncompress2           z_uncompress2
#  endif
#  define zError                z_zError
#  ifndef Z_SOLO
#    define zcalloc               z_zcalloc
#    define zcfree                z_zcfree
#  endif
#  define zlibCompileFlags      z_zlibCompileFlags
#  define zlibVersion           z_zlibVersion

/* all zlib typedefs in zlib.h and zconf.h */
#  define Byte                  z_Byte
#  define Bytef                 z_Bytef
#  define alloc_func            z_alloc_func
#  define charf                 z_charf
#  define free_func             z_free_func
#  ifndef Z_SOLO
#    define gzFile                z_gzFile
#  endif
#  define gz_header             z_gz_header
#  define gz_headerp            z_gz_headerp
#  define in_func               z_in_func
#  define intf                  z_intf
#  define out_func              z_out_func
#  define uInt                  z_uInt
#  define uIntf                 z_uIntf
#  define uLong                 z_uLong
#  define uLongf                z_uLongf
#  define voidp                 z_voidp
#  define voidpc                z_voidpc
#  define voidpf                z_voidpf

/* all zlib structs in zlib.h and zconf.h */
#  define gz_header_s           z_gz_header_s
#  define internal_state        z_internal_state

#endif

#if defined(__MSDOS__) && !defined(MSDOS)
#  define MSDOS
#endif
#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2)
#  define OS2
#endif
#if defined(_WINDOWS) && !defined(WINDOWS)
#  define WINDOWS
#endif
#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__)
#  ifndef WIN32
#    define WIN32
#  endif
#endif
#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32)
#  if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__)
#    ifndef SYS16BIT
#      define SYS16BIT
#    endif
#  endif
#endif

/*
 * Compile with -DMAXSEG_64K if the alloc function cannot allocate more
 * than 64k bytes at a time (needed on systems with 16-bit int).
 */
#ifdef SYS16BIT
#  define MAXSEG_64K
#endif
#ifdef MSDOS
#  define UNALIGNED_OK
#endif

#ifdef __STDC_VERSION__
#  ifndef STDC
#    define STDC
#  endif
#  if __STDC_VERSION__ >= 199901L
#    ifndef STDC99
#      define STDC99
#    endif
#  endif
#endif
#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus))
#  define STDC
#endif
#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__))
#  define STDC
#endif
#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32))
#  define STDC
#endif
#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__))
#  define STDC
#endif

#if defined(__OS400__) && !defined(STDC)    /* iSeries (formerly AS/400). */
#  define STDC
#endif

#ifndef STDC
#  ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */
#    define const       /* note: need a more gentle solution here */
#  endif
#endif

#if defined(ZLIB_CONST) && !defined(z_const)
#  define z_const const
#else
#  define z_const
#endif

#ifdef Z_SOLO
   typedef unsigned long z_size_t;
#else
#  define z_longlong long long
#  if defined(NO_SIZE_T)
     typedef unsigned NO_SIZE_T z_size_t;
#  elif defined(STDC)
#    include <stddef.h>
     typedef size_t z_size_t;
#  else
     typedef unsigned long z_size_t;
#  endif
#  undef z_longlong
#endif

/* Maximum value for memLevel in deflateInit2 */
#ifndef MAX_MEM_LEVEL
#  ifdef MAXSEG_64K
#    define MAX_MEM_LEVEL 8
#  else
#    define MAX_MEM_LEVEL 9
#  endif
#endif

/* Maximum value for windowBits in deflateInit2 and inflateInit2.
 * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files
 * created by gzip. (Files created by minigzip can still be extracted by
 * gzip.)
 */
#ifndef MAX_WBITS
#  define MAX_WBITS   15 /* 32K LZ77 window */
#endif

/* The memory requirements for deflate are (in bytes):
            (1 << (windowBits+2)) +  (1 << (memLevel+9))
 that is: 128K for windowBits=15  +  128K for memLevel = 8  (default values)
 plus a few kilobytes for small objects. For example, if you want to reduce
 the default memory requirements from 256K to 128K, compile with
     make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7"
 Of course this will generally degrade compression (there's no free lunch).

   The memory requirements for inflate are (in bytes) 1 << windowBits
 that is, 32K for windowBits=15 (default value) plus about 7 kilobytes
 for small objects.
*/

                        /* Type declarations */

#ifndef OF /* function prototypes */
#  ifdef STDC
#    define OF(args)  args
#  else
#    define OF(args)  ()
#  endif
#endif

#ifndef Z_ARG /* function prototypes for stdarg */
#  if defined(STDC) || defined(Z_HAVE_STDARG_H)
#    define Z_ARG(args)  args
#  else
#    define Z_ARG(args)  ()
#  endif
#endif

/* The following definitions for FAR are needed only for MSDOS mixed
 * model programming (small or medium model with some far allocations).
 * This was tested only with MSC; for other MSDOS compilers you may have
 * to define NO_MEMCPY in zutil.h.  If you don't need the mixed model,
 * just define FAR to be empty.
 */
#ifdef SYS16BIT
#  if defined(M_I86SM) || defined(M_I86MM)
     /* MSC small or medium model */
#    define SMALL_MEDIUM
#    ifdef _MSC_VER
#      define FAR _far
#    else
#      define FAR far
#    endif
#  endif
#  if (defined(__SMALL__) || defined(__MEDIUM__))
     /* Turbo C small or medium model */
#    define SMALL_MEDIUM
#    ifdef __BORLANDC__
#      define FAR _far
#    else
#      define FAR far
#    endif
#  endif
#endif

#if defined(WINDOWS) || defined(WIN32)
   /* If building or using zlib as a DLL, define ZLIB_DLL.
    * This is not mandatory, but it offers a little performance increase.
    */
#  ifdef ZLIB_DLL
#    if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500))
#      ifdef ZLIB_INTERNAL
#        define ZEXTERN extern __declspec(dllexport)
#      else
#        define ZEXTERN extern __declspec(dllimport)
#      endif
#    endif
#  endif  /* ZLIB_DLL */
   /* If building or using zlib with the WINAPI/WINAPIV calling convention,
    * define ZLIB_WINAPI.
    * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI.
    */
#  ifdef ZLIB_WINAPI
#    ifdef FAR
#      undef FAR
#    endif
#    include <windows.h>
     /* No need for _export, use ZLIB.DEF instead. */
     /* For complete Windows compatibility, use WINAPI, not __stdcall. */
#    define ZEXPORT WINAPI
#    ifdef WIN32
#      define ZEXPORTVA WINAPIV
#    else
#      define ZEXPORTVA FAR CDECL
#    endif
#  endif
#endif

#if defined (__BEOS__)
#  ifdef ZLIB_DLL
#    ifdef ZLIB_INTERNAL
#      define ZEXPORT   __declspec(dllexport)
#      define ZEXPORTVA __declspec(dllexport)
#    else
#      define ZEXPORT   __declspec(dllimport)
#      define ZEXPORTVA __declspec(dllimport)
#    endif
#  endif
#endif

#ifndef ZEXTERN
#  define ZEXTERN extern
#endif
#ifndef ZEXPORT
#  define ZEXPORT
#endif
#ifndef ZEXPORTVA
#  define ZEXPORTVA
#endif

#ifndef FAR
#  define FAR
#endif

#if !defined(__MACTYPES__)
typedef unsigned char  Byte;  /* 8 bits */
#endif
typedef unsigned int   uInt;  /* 16 bits or more */
typedef unsigned long  uLong; /* 32 bits or more */

#ifdef SMALL_MEDIUM
   /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */
#  define Bytef Byte FAR
#else
   typedef Byte  FAR Bytef;
#endif
typedef char  FAR charf;
typedef int   FAR intf;
typedef uInt  FAR uIntf;
typedef uLong FAR uLongf;

#ifdef STDC
   typedef void const *voidpc;
   typedef void FAR   *voidpf;
   typedef void       *voidp;
#else
   typedef Byte const *voidpc;
   typedef Byte FAR   *voidpf;
   typedef Byte       *voidp;
#endif

#if !defined(Z_U4) && !defined(Z_SOLO) && defined(STDC)
#  include <limits.h>
#  if (UINT_MAX == 0xffffffffUL)
#    define Z_U4 unsigned
#  elif (ULONG_MAX == 0xffffffffUL)
#    define Z_U4 unsigned long
#  elif (USHRT_MAX == 0xffffffffUL)
#    define Z_U4 unsigned short
#  endif
#endif

#ifdef Z_U4
   typedef Z_U4 z_crc_t;
#else
   typedef unsigned long z_crc_t;
#endif

#ifdef HAVE_UNISTD_H    /* may be set to #if 1 by ./configure */
#  define Z_HAVE_UNISTD_H
#endif

#ifdef HAVE_STDARG_H    /* may be set to #if 1 by ./configure */
#  define Z_HAVE_STDARG_H
#endif

#ifdef STDC
#  ifndef Z_SOLO
#    include <sys/types.h>      /* for off_t */
#  endif
#endif

#if defined(STDC) || defined(Z_HAVE_STDARG_H)
#  ifndef Z_SOLO
#    include <stdarg.h>         /* for va_list */
#  endif
#endif

#ifdef _WIN32
#  ifndef Z_SOLO
#    include <stddef.h>         /* for wchar_t */
#  endif
#endif

/* a little trick to accommodate both "#define _LARGEFILE64_SOURCE" and
 * "#define _LARGEFILE64_SOURCE 1" as requesting 64-bit operations, (even
 * though the former does not conform to the LFS document), but considering
 * both "#undef _LARGEFILE64_SOURCE" and "#define _LARGEFILE64_SOURCE 0" as
 * equivalently requesting no 64-bit operations
 */
#if defined(_LARGEFILE64_SOURCE) && -_LARGEFILE64_SOURCE - -1 == 1
#  undef _LARGEFILE64_SOURCE
#endif

#if defined(__WATCOMC__) && !defined(Z_HAVE_UNISTD_H)
#  define Z_HAVE_UNISTD_H
#endif
#ifndef Z_SOLO
#  if defined(Z_HAVE_UNISTD_H) || defined(_LARGEFILE64_SOURCE)
#    include <unistd.h>         /* for SEEK_*, off_t, and _LFS64_LARGEFILE */
#    ifdef VMS
#      include <unixio.h>       /* for off_t */
#    endif
#    ifndef z_off_t
#      define z_off_t off_t
#    endif
#  endif
#endif

#if defined(_LFS64_LARGEFILE) && _LFS64_LARGEFILE-0
#  define Z_LFS64
#endif

#if defined(_LARGEFILE64_SOURCE) && defined(Z_LFS64)
#  define Z_LARGE64
#endif

#if defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS-0 == 64 && defined(Z_LFS64)
#  define Z_WANT64
#endif

#if !defined(SEEK_SET) && !defined(Z_SOLO)
#  define SEEK_SET        0       /* Seek from beginning of file.  */
#  define SEEK_CUR        1       /* Seek from current position.  */
#  define SEEK_END        2       /* Set file pointer to EOF plus "offset" */
#endif

#ifndef z_off_t
#  define z_off_t long
#endif

#if !defined(_WIN32) && defined(Z_LARGE64)
#  define z_off64_t off64_t
#else
#  if defined(_WIN32) && !defined(__GNUC__) && !defined(Z_SOLO)
#    define z_off64_t __int64
#  else
#    define z_off64_t z_off_t
#  endif
#endif

/* MVS linker does not support external names larger than 8 bytes */
#if defined(__MVS__)
  #pragma map(deflateInit_,"DEIN")
  #pragma map(deflateInit2_,"DEIN2")
  #pragma map(deflateEnd,"DEEND")
  #pragma map(deflateBound,"DEBND")
  #pragma map(inflateInit_,"ININ")
  #pragma map(inflateInit2_,"ININ2")
  #pragma map(inflateEnd,"INEND")
  #pragma map(inflateSync,"INSY")
  #pragma map(inflateSetDictionary,"INSEDI")
  #pragma map(compressBound,"CMBND")
  #pragma map(inflate_table,"INTABL")
  #pragma map(inflate_fast,"INFA")
  #pragma map(inflate_copyright,"INCOPY")
#endif

#endif /* ZCONF_H */

Deleted compat/zlib/zlib.3.

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





















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
.TH ZLIB 3 "15 Jan 2017"
.SH NAME
zlib \- compression/decompression library
.SH SYNOPSIS
[see
.I zlib.h
for full description]
.SH DESCRIPTION
The
.I zlib
library is a general purpose data compression library.
The code is thread safe, assuming that the standard library functions
used are thread safe, such as memory allocation routines.
It provides in-memory compression and decompression functions,
including integrity checks of the uncompressed data.
This version of the library supports only one compression method (deflation)
but other algorithms may be added later
with the same stream interface.
.LP
Compression can be done in a single step if the buffers are large enough
or can be done by repeated calls of the compression function.
In the latter case,
the application must provide more input and/or consume the output
(providing more output space) before each call.
.LP
The library also supports reading and writing files in
.IR gzip (1)
(.gz) format
with an interface similar to that of stdio.
.LP
The library does not install any signal handler.
The decoder checks the consistency of the compressed data,
so the library should never crash even in the case of corrupted input.
.LP
All functions of the compression library are documented in the file
.IR zlib.h .
The distribution source includes examples of use of the library
in the files
.I test/example.c
and
.IR test/minigzip.c,
as well as other examples in the
.IR examples/
directory.
.LP
Changes to this version are documented in the file
.I ChangeLog
that accompanies the source.
.LP
.I zlib
is built in to many languages and operating systems, including but not limited to
Java, Python, .NET, PHP, Perl, Ruby, Swift, and Go.
.LP
An experimental package to read and write files in the .zip format,
written on top of
.I zlib
by Gilles Vollant (info@winimage.com),
is available at:
.IP
http://www.winimage.com/zLibDll/minizip.html
and also in the
.I contrib/minizip
directory of the main
.I zlib
source distribution.
.SH "SEE ALSO"
The
.I zlib
web site can be found at:
.IP
http://zlib.net/
.LP
The data format used by the
.I zlib
library is described by RFC
(Request for Comments) 1950 to 1952 in the files:
.IP
http://tools.ietf.org/html/rfc1950 (for the zlib header and trailer format)
.br
http://tools.ietf.org/html/rfc1951 (for the deflate compressed data format)
.br
http://tools.ietf.org/html/rfc1952 (for the gzip header and trailer format)
.LP
Mark Nelson wrote an article about
.I zlib
for the Jan. 1997 issue of  Dr. Dobb's Journal;
a copy of the article is available at:
.IP
http://marknelson.us/1997/01/01/zlib-engine/
.SH "REPORTING PROBLEMS"
Before reporting a problem,
please check the
.I zlib
web site to verify that you have the latest version of
.IR zlib ;
otherwise,
obtain the latest version and see if the problem still exists.
Please read the
.I zlib
FAQ at:
.IP
http://zlib.net/zlib_faq.html
.LP
before asking for help.
Send questions and/or comments to zlib@gzip.org,
or (for the Windows DLL version) to Gilles Vollant (info@winimage.com).
.SH AUTHORS AND LICENSE
Version 1.2.11
.LP
Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler
.LP
This software is provided 'as-is', without any express or implied
warranty.  In no event will the authors be held liable for any damages
arising from the use of this software.
.LP
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
.LP
.nr step 1 1
.IP \n[step]. 3
The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software
in a product, an acknowledgment in the product documentation would be
appreciated but is not required.
.IP \n+[step].
Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
.IP \n+[step].
This notice may not be removed or altered from any source distribution.
.LP
Jean-loup Gailly        Mark Adler
.br
jloup@gzip.org          madler@alumni.caltech.edu
.LP
The deflate format used by
.I zlib
was defined by Phil Katz.
The deflate and
.I zlib
specifications were written by L. Peter Deutsch.
Thanks to all the people who reported problems and suggested various
improvements in
.IR zlib ;
who are too numerous to cite here.
.LP
UNIX manual page by R. P. C. Rodgers,
U.S. National Library of Medicine (rodgers@nlm.nih.gov).
.\" end of man page

Deleted compat/zlib/zlib.3.pdf.

cannot compute difference between binary files

Deleted compat/zlib/zlib.h.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zlib.h -- interface of the 'zlib' general purpose compression library
  version 1.2.11, January 15th, 2017

  Copyright (C) 1995-2017 Jean-loup Gailly and Mark Adler

  This software is provided 'as-is', without any express or implied
  warranty.  In no event will the authors be held liable for any damages
  arising from the use of this software.

  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:

  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software
     in a product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.

  Jean-loup Gailly        Mark Adler
  jloup@gzip.org          madler@alumni.caltech.edu


  The data format used by the zlib library is described by RFCs (Request for
  Comments) 1950 to 1952 in the files http://tools.ietf.org/html/rfc1950
  (zlib format), rfc1951 (deflate format) and rfc1952 (gzip format).
*/

#ifndef ZLIB_H
#define ZLIB_H

#include "zconf.h"

#ifdef __cplusplus
extern "C" {
#endif

#define ZLIB_VERSION "1.2.11"
#define ZLIB_VERNUM 0x12b0
#define ZLIB_VER_MAJOR 1
#define ZLIB_VER_MINOR 2
#define ZLIB_VER_REVISION 11
#define ZLIB_VER_SUBREVISION 0

/*
    The 'zlib' compression library provides in-memory compression and
  decompression functions, including integrity checks of the uncompressed data.
  This version of the library supports only one compression method (deflation)
  but other algorithms will be added later and will have the same stream
  interface.

    Compression can be done in a single step if the buffers are large enough,
  or can be done by repeated calls of the compression function.  In the latter
  case, the application must provide more input and/or consume the output
  (providing more output space) before each call.

    The compressed data format used by default by the in-memory functions is
  the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped
  around a deflate stream, which is itself documented in RFC 1951.

    The library also supports reading and writing files in gzip (.gz) format
  with an interface similar to that of stdio using the functions that start
  with "gz".  The gzip format is different from the zlib format.  gzip is a
  gzip wrapper, documented in RFC 1952, wrapped around a deflate stream.

    This library can optionally read and write gzip and raw deflate streams in
  memory as well.

    The zlib format was designed to be compact and fast for use in memory
  and on communications channels.  The gzip format was designed for single-
  file compression on file systems, has a larger header than zlib to maintain
  directory information, and uses a different, slower check method than zlib.

    The library does not install any signal handler.  The decoder checks
  the consistency of the compressed data, so the library should never crash
  even in the case of corrupted input.
*/

typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size));
typedef void   (*free_func)  OF((voidpf opaque, voidpf address));

struct internal_state;

typedef struct z_stream_s {
    z_const Bytef *next_in;     /* next input byte */
    uInt     avail_in;  /* number of bytes available at next_in */
    uLong    total_in;  /* total number of input bytes read so far */

    Bytef    *next_out; /* next output byte will go here */
    uInt     avail_out; /* remaining free space at next_out */
    uLong    total_out; /* total number of bytes output so far */

    z_const char *msg;  /* last error message, NULL if no error */
    struct internal_state FAR *state; /* not visible by applications */

    alloc_func zalloc;  /* used to allocate the internal state */
    free_func  zfree;   /* used to free the internal state */
    voidpf     opaque;  /* private data object passed to zalloc and zfree */

    int     data_type;  /* best guess about the data type: binary or text
                           for deflate, or the decoding state for inflate */
    uLong   adler;      /* Adler-32 or CRC-32 value of the uncompressed data */
    uLong   reserved;   /* reserved for future use */
} z_stream;

typedef z_stream FAR *z_streamp;

/*
     gzip header information passed to and from zlib routines.  See RFC 1952
  for more details on the meanings of these fields.
*/
typedef struct gz_header_s {
    int     text;       /* true if compressed data believed to be text */
    uLong   time;       /* modification time */
    int     xflags;     /* extra flags (not used when writing a gzip file) */
    int     os;         /* operating system */
    Bytef   *extra;     /* pointer to extra field or Z_NULL if none */
    uInt    extra_len;  /* extra field length (valid if extra != Z_NULL) */
    uInt    extra_max;  /* space at extra (only when reading header) */
    Bytef   *name;      /* pointer to zero-terminated file name or Z_NULL */
    uInt    name_max;   /* space at name (only when reading header) */
    Bytef   *comment;   /* pointer to zero-terminated comment or Z_NULL */
    uInt    comm_max;   /* space at comment (only when reading header) */
    int     hcrc;       /* true if there was or will be a header crc */
    int     done;       /* true when done reading gzip header (not used
                           when writing a gzip file) */
} gz_header;

typedef gz_header FAR *gz_headerp;

/*
     The application must update next_in and avail_in when avail_in has dropped
   to zero.  It must update next_out and avail_out when avail_out has dropped
   to zero.  The application must initialize zalloc, zfree and opaque before
   calling the init function.  All other fields are set by the compression
   library and must not be updated by the application.

     The opaque value provided by the application will be passed as the first
   parameter for calls of zalloc and zfree.  This can be useful for custom
   memory management.  The compression library attaches no meaning to the
   opaque value.

     zalloc must return Z_NULL if there is not enough memory for the object.
   If zlib is used in a multi-threaded application, zalloc and zfree must be
   thread safe.  In that case, zlib is thread-safe.  When zalloc and zfree are
   Z_NULL on entry to the initialization function, they are set to internal
   routines that use the standard library functions malloc() and free().

     On 16-bit systems, the functions zalloc and zfree must be able to allocate
   exactly 65536 bytes, but will not be required to allocate more than this if
   the symbol MAXSEG_64K is defined (see zconf.h).  WARNING: On MSDOS, pointers
   returned by zalloc for objects of exactly 65536 bytes *must* have their
   offset normalized to zero.  The default allocation function provided by this
   library ensures this (see zutil.c).  To reduce memory requirements and avoid
   any allocation of 64K objects, at the expense of compression ratio, compile
   the library with -DMAX_WBITS=14 (see zconf.h).

     The fields total_in and total_out can be used for statistics or progress
   reports.  After compression, total_in holds the total size of the
   uncompressed data and may be saved for use by the decompressor (particularly
   if the decompressor wants to decompress everything in a single step).
*/

                        /* constants */

#define Z_NO_FLUSH      0
#define Z_PARTIAL_FLUSH 1
#define Z_SYNC_FLUSH    2
#define Z_FULL_FLUSH    3
#define Z_FINISH        4
#define Z_BLOCK         5
#define Z_TREES         6
/* Allowed flush values; see deflate() and inflate() below for details */

#define Z_OK            0
#define Z_STREAM_END    1
#define Z_NEED_DICT     2
#define Z_ERRNO        (-1)
#define Z_STREAM_ERROR (-2)
#define Z_DATA_ERROR   (-3)
#define Z_MEM_ERROR    (-4)
#define Z_BUF_ERROR    (-5)
#define Z_VERSION_ERROR (-6)
/* Return codes for the compression/decompression functions. Negative values
 * are errors, positive values are used for special but normal events.
 */

#define Z_NO_COMPRESSION         0
#define Z_BEST_SPEED             1
#define Z_BEST_COMPRESSION       9
#define Z_DEFAULT_COMPRESSION  (-1)
/* compression levels */

#define Z_FILTERED            1
#define Z_HUFFMAN_ONLY        2
#define Z_RLE                 3
#define Z_FIXED               4
#define Z_DEFAULT_STRATEGY    0
/* compression strategy; see deflateInit2() below for details */

#define Z_BINARY   0
#define Z_TEXT     1
#define Z_ASCII    Z_TEXT   /* for compatibility with 1.2.2 and earlier */
#define Z_UNKNOWN  2
/* Possible values of the data_type field for deflate() */

#define Z_DEFLATED   8
/* The deflate compression method (the only one supported in this version) */

#define Z_NULL  0  /* for initializing zalloc, zfree, opaque */

#define zlib_version zlibVersion()
/* for compatibility with versions < 1.0.2 */


                        /* basic functions */

ZEXTERN const char * ZEXPORT zlibVersion OF((void));
/* The application can compare zlibVersion and ZLIB_VERSION for consistency.
   If the first character differs, the library code actually used is not
   compatible with the zlib.h header file used by the application.  This check
   is automatically made by deflateInit and inflateInit.
 */

/*
ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level));

     Initializes the internal stream state for compression.  The fields
   zalloc, zfree and opaque must be initialized before by the caller.  If
   zalloc and zfree are set to Z_NULL, deflateInit updates them to use default
   allocation functions.

     The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9:
   1 gives best speed, 9 gives best compression, 0 gives no compression at all
   (the input data is simply copied a block at a time).  Z_DEFAULT_COMPRESSION
   requests a default compromise between speed and compression (currently
   equivalent to level 6).

     deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough
   memory, Z_STREAM_ERROR if level is not a valid compression level, or
   Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible
   with the version assumed by the caller (ZLIB_VERSION).  msg is set to null
   if there is no error message.  deflateInit does not perform any compression:
   this will be done by deflate().
*/


ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush));
/*
    deflate compresses as much data as possible, and stops when the input
  buffer becomes empty or the output buffer becomes full.  It may introduce
  some output latency (reading input without producing any output) except when
  forced to flush.

    The detailed semantics are as follows.  deflate performs one or both of the
  following actions:

  - Compress more input starting at next_in and update next_in and avail_in
    accordingly.  If not all input can be processed (because there is not
    enough room in the output buffer), next_in and avail_in are updated and
    processing will resume at this point for the next call of deflate().

  - Generate more output starting at next_out and update next_out and avail_out
    accordingly.  This action is forced if the parameter flush is non zero.
    Forcing flush frequently degrades the compression ratio, so this parameter
    should be set only when necessary.  Some output may be provided even if
    flush is zero.

    Before the call of deflate(), the application should ensure that at least
  one of the actions is possible, by providing more input and/or consuming more
  output, and updating avail_in or avail_out accordingly; avail_out should
  never be zero before the call.  The application can consume the compressed
  output when it wants, for example when the output buffer is full (avail_out
  == 0), or after each call of deflate().  If deflate returns Z_OK and with
  zero avail_out, it must be called again after making room in the output
  buffer because there might be more output pending. See deflatePending(),
  which can be used if desired to determine whether or not there is more ouput
  in that case.

    Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to
  decide how much data to accumulate before producing output, in order to
  maximize compression.

    If the parameter flush is set to Z_SYNC_FLUSH, all pending output is
  flushed to the output buffer and the output is aligned on a byte boundary, so
  that the decompressor can get all input data available so far.  (In
  particular avail_in is zero after the call if enough output space has been
  provided before the call.) Flushing may degrade compression for some
  compression algorithms and so it should be used only when necessary.  This
  completes the current deflate block and follows it with an empty stored block
  that is three bits plus filler bits to the next byte, followed by four bytes
  (00 00 ff ff).

    If flush is set to Z_PARTIAL_FLUSH, all pending output is flushed to the
  output buffer, but the output is not aligned to a byte boundary.  All of the
  input data so far will be available to the decompressor, as for Z_SYNC_FLUSH.
  This completes the current deflate block and follows it with an empty fixed
  codes block that is 10 bits long.  This assures that enough bytes are output
  in order for the decompressor to finish the block before the empty fixed
  codes block.

    If flush is set to Z_BLOCK, a deflate block is completed and emitted, as
  for Z_SYNC_FLUSH, but the output is not aligned on a byte boundary, and up to
  seven bits of the current block are held to be written as the next byte after
  the next deflate block is completed.  In this case, the decompressor may not
  be provided enough bits at this point in order to complete decompression of
  the data provided so far to the compressor.  It may need to wait for the next
  block to be emitted.  This is for advanced applications that need to control
  the emission of deflate blocks.

    If flush is set to Z_FULL_FLUSH, all output is flushed as with
  Z_SYNC_FLUSH, and the compression state is reset so that decompression can
  restart from this point if previous compressed data has been damaged or if
  random access is desired.  Using Z_FULL_FLUSH too often can seriously degrade
  compression.

    If deflate returns with avail_out == 0, this function must be called again
  with the same value of the flush parameter and more output space (updated
  avail_out), until the flush is complete (deflate returns with non-zero
  avail_out).  In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that
  avail_out is greater than six to avoid repeated flush markers due to
  avail_out == 0 on return.

    If the parameter flush is set to Z_FINISH, pending input is processed,
  pending output is flushed and deflate returns with Z_STREAM_END if there was
  enough output space.  If deflate returns with Z_OK or Z_BUF_ERROR, this
  function must be called again with Z_FINISH and more output space (updated
  avail_out) but no more input data, until it returns with Z_STREAM_END or an
  error.  After deflate has returned Z_STREAM_END, the only possible operations
  on the stream are deflateReset or deflateEnd.

    Z_FINISH can be used in the first deflate call after deflateInit if all the
  compression is to be done in a single step.  In order to complete in one
  call, avail_out must be at least the value returned by deflateBound (see
  below).  Then deflate is guaranteed to return Z_STREAM_END.  If not enough
  output space is provided, deflate will not return Z_STREAM_END, and it must
  be called again as described above.

    deflate() sets strm->adler to the Adler-32 checksum of all input read
  so far (that is, total_in bytes).  If a gzip stream is being generated, then
  strm->adler will be the CRC-32 checksum of the input read so far.  (See
  deflateInit2 below.)

    deflate() may update strm->data_type if it can make a good guess about
  the input data type (Z_BINARY or Z_TEXT).  If in doubt, the data is
  considered binary.  This field is only for information purposes and does not
  affect the compression algorithm in any manner.

    deflate() returns Z_OK if some progress has been made (more input
  processed or more output produced), Z_STREAM_END if all input has been
  consumed and all output has been produced (only when flush is set to
  Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example
  if next_in or next_out was Z_NULL or the state was inadvertently written over
  by the application), or Z_BUF_ERROR if no progress is possible (for example
  avail_in or avail_out was zero).  Note that Z_BUF_ERROR is not fatal, and
  deflate() can be called again with more input and more output space to
  continue compressing.
*/


ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm));
/*
     All dynamically allocated data structures for this stream are freed.
   This function discards any unprocessed input and does not flush any pending
   output.

     deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the
   stream state was inconsistent, Z_DATA_ERROR if the stream was freed
   prematurely (some input or output was discarded).  In the error case, msg
   may be set but then points to a static string (which must not be
   deallocated).
*/


/*
ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm));

     Initializes the internal stream state for decompression.  The fields
   next_in, avail_in, zalloc, zfree and opaque must be initialized before by
   the caller.  In the current version of inflate, the provided input is not
   read or consumed.  The allocation of a sliding window will be deferred to
   the first call of inflate (if the decompression does not complete on the
   first call).  If zalloc and zfree are set to Z_NULL, inflateInit updates
   them to use default allocation functions.

     inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough
   memory, Z_VERSION_ERROR if the zlib library version is incompatible with the
   version assumed by the caller, or Z_STREAM_ERROR if the parameters are
   invalid, such as a null pointer to the structure.  msg is set to null if
   there is no error message.  inflateInit does not perform any decompression.
   Actual decompression will be done by inflate().  So next_in, and avail_in,
   next_out, and avail_out are unused and unchanged.  The current
   implementation of inflateInit() does not process any header information --
   that is deferred until inflate() is called.
*/


ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush));
/*
    inflate decompresses as much data as possible, and stops when the input
  buffer becomes empty or the output buffer becomes full.  It may introduce
  some output latency (reading input without producing any output) except when
  forced to flush.

  The detailed semantics are as follows.  inflate performs one or both of the
  following actions:

  - Decompress more input starting at next_in and update next_in and avail_in
    accordingly.  If not all input can be processed (because there is not
    enough room in the output buffer), then next_in and avail_in are updated
    accordingly, and processing will resume at this point for the next call of
    inflate().

  - Generate more output starting at next_out and update next_out and avail_out
    accordingly.  inflate() provides as much output as possible, until there is
    no more input data or no more space in the output buffer (see below about
    the flush parameter).

    Before the call of inflate(), the application should ensure that at least
  one of the actions is possible, by providing more input and/or consuming more
  output, and updating the next_* and avail_* values accordingly.  If the
  caller of inflate() does not provide both available input and available
  output space, it is possible that there will be no progress made.  The
  application can consume the uncompressed output when it wants, for example
  when the output buffer is full (avail_out == 0), or after each call of
  inflate().  If inflate returns Z_OK and with zero avail_out, it must be
  called again after making room in the output buffer because there might be
  more output pending.

    The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, Z_FINISH,
  Z_BLOCK, or Z_TREES.  Z_SYNC_FLUSH requests that inflate() flush as much
  output as possible to the output buffer.  Z_BLOCK requests that inflate()
  stop if and when it gets to the next deflate block boundary.  When decoding
  the zlib or gzip format, this will cause inflate() to return immediately
  after the header and before the first block.  When doing a raw inflate,
  inflate() will go ahead and process the first block, and will return when it
  gets to the end of that block, or when it runs out of data.

    The Z_BLOCK option assists in appending to or combining deflate streams.
  To assist in this, on return inflate() always sets strm->data_type to the
  number of unused bits in the last byte taken from strm->next_in, plus 64 if
  inflate() is currently decoding the last block in the deflate stream, plus
  128 if inflate() returned immediately after decoding an end-of-block code or
  decoding the complete header up to just before the first byte of the deflate
  stream.  The end-of-block will not be indicated until all of the uncompressed
  data from that block has been written to strm->next_out.  The number of
  unused bits may in general be greater than seven, except when bit 7 of
  data_type is set, in which case the number of unused bits will be less than
  eight.  data_type is set as noted here every time inflate() returns for all
  flush options, and so can be used to determine the amount of currently
  consumed input in bits.

    The Z_TREES option behaves as Z_BLOCK does, but it also returns when the
  end of each deflate block header is reached, before any actual data in that
  block is decoded.  This allows the caller to determine the length of the
  deflate block header for later use in random access within a deflate block.
  256 is added to the value of strm->data_type when inflate() returns
  immediately after reaching the end of the deflate block header.

    inflate() should normally be called until it returns Z_STREAM_END or an
  error.  However if all decompression is to be performed in a single step (a
  single call of inflate), the parameter flush should be set to Z_FINISH.  In
  this case all pending input is processed and all pending output is flushed;
  avail_out must be large enough to hold all of the uncompressed data for the
  operation to complete.  (The size of the uncompressed data may have been
  saved by the compressor for this purpose.)  The use of Z_FINISH is not
  required to perform an inflation in one step.  However it may be used to
  inform inflate that a faster approach can be used for the single inflate()
  call.  Z_FINISH also informs inflate to not maintain a sliding window if the
  stream completes, which reduces inflate's memory footprint.  If the stream
  does not complete, either because not all of the stream is provided or not
  enough output space is provided, then a sliding window will be allocated and
  inflate() can be called again to continue the operation as if Z_NO_FLUSH had
  been used.

     In this implementation, inflate() always flushes as much output as
  possible to the output buffer, and always uses the faster approach on the
  first call.  So the effects of the flush parameter in this implementation are
  on the return value of inflate() as noted below, when inflate() returns early
  when Z_BLOCK or Z_TREES is used, and when inflate() avoids the allocation of
  memory for a sliding window when Z_FINISH is used.

     If a preset dictionary is needed after this call (see inflateSetDictionary
  below), inflate sets strm->adler to the Adler-32 checksum of the dictionary
  chosen by the compressor and returns Z_NEED_DICT; otherwise it sets
  strm->adler to the Adler-32 checksum of all output produced so far (that is,
  total_out bytes) and returns Z_OK, Z_STREAM_END or an error code as described
  below.  At the end of the stream, inflate() checks that its computed Adler-32
  checksum is equal to that saved by the compressor and returns Z_STREAM_END
  only if the checksum is correct.

    inflate() can decompress and check either zlib-wrapped or gzip-wrapped
  deflate data.  The header type is detected automatically, if requested when
  initializing with inflateInit2().  Any information contained in the gzip
  header is not retained unless inflateGetHeader() is used.  When processing
  gzip-wrapped deflate data, strm->adler32 is set to the CRC-32 of the output
  produced so far.  The CRC-32 is checked against the gzip trailer, as is the
  uncompressed length, modulo 2^32.

    inflate() returns Z_OK if some progress has been made (more input processed
  or more output produced), Z_STREAM_END if the end of the compressed data has
  been reached and all uncompressed output has been produced, Z_NEED_DICT if a
  preset dictionary is needed at this point, Z_DATA_ERROR if the input data was
  corrupted (input stream not conforming to the zlib format or incorrect check
  value, in which case strm->msg points to a string with a more specific
  error), Z_STREAM_ERROR if the stream structure was inconsistent (for example
  next_in or next_out was Z_NULL, or the state was inadvertently written over
  by the application), Z_MEM_ERROR if there was not enough memory, Z_BUF_ERROR
  if no progress was possible or if there was not enough room in the output
  buffer when Z_FINISH is used.  Note that Z_BUF_ERROR is not fatal, and
  inflate() can be called again with more input and more output space to
  continue decompressing.  If Z_DATA_ERROR is returned, the application may
  then call inflateSync() to look for a good compression block if a partial
  recovery of the data is to be attempted.
*/


ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm));
/*
     All dynamically allocated data structures for this stream are freed.
   This function discards any unprocessed input and does not flush any pending
   output.

     inflateEnd returns Z_OK if success, or Z_STREAM_ERROR if the stream state
   was inconsistent.
*/


                        /* Advanced functions */

/*
    The following functions are needed only in some special applications.
*/

/*
ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm,
                                     int  level,
                                     int  method,
                                     int  windowBits,
                                     int  memLevel,
                                     int  strategy));

     This is another version of deflateInit with more compression options.  The
   fields next_in, zalloc, zfree and opaque must be initialized before by the
   caller.

     The method parameter is the compression method.  It must be Z_DEFLATED in
   this version of the library.

     The windowBits parameter is the base two logarithm of the window size
   (the size of the history buffer).  It should be in the range 8..15 for this
   version of the library.  Larger values of this parameter result in better
   compression at the expense of memory usage.  The default value is 15 if
   deflateInit is used instead.

     For the current implementation of deflate(), a windowBits value of 8 (a
   window size of 256 bytes) is not supported.  As a result, a request for 8
   will result in 9 (a 512-byte window).  In that case, providing 8 to
   inflateInit2() will result in an error when the zlib header with 9 is
   checked against the initialization of inflate().  The remedy is to not use 8
   with deflateInit2() with this initialization, or at least in that case use 9
   with inflateInit2().

     windowBits can also be -8..-15 for raw deflate.  In this case, -windowBits
   determines the window size.  deflate() will then generate raw deflate data
   with no zlib header or trailer, and will not compute a check value.

     windowBits can also be greater than 15 for optional gzip encoding.  Add
   16 to windowBits to write a simple gzip header and trailer around the
   compressed data instead of a zlib wrapper.  The gzip header will have no
   file name, no extra data, no comment, no modification time (set to zero), no
   header crc, and the operating system will be set to the appropriate value,
   if the operating system was determined at compile time.  If a gzip stream is
   being written, strm->adler is a CRC-32 instead of an Adler-32.

     For raw deflate or gzip encoding, a request for a 256-byte window is
   rejected as invalid, since only the zlib header provides a means of
   transmitting the window size to the decompressor.

     The memLevel parameter specifies how much memory should be allocated
   for the internal compression state.  memLevel=1 uses minimum memory but is
   slow and reduces compression ratio; memLevel=9 uses maximum memory for
   optimal speed.  The default value is 8.  See zconf.h for total memory usage
   as a function of windowBits and memLevel.

     The strategy parameter is used to tune the compression algorithm.  Use the
   value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a
   filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no
   string match), or Z_RLE to limit match distances to one (run-length
   encoding).  Filtered data consists mostly of small values with a somewhat
   random distribution.  In this case, the compression algorithm is tuned to
   compress them better.  The effect of Z_FILTERED is to force more Huffman
   coding and less string matching; it is somewhat intermediate between
   Z_DEFAULT_STRATEGY and Z_HUFFMAN_ONLY.  Z_RLE is designed to be almost as
   fast as Z_HUFFMAN_ONLY, but give better compression for PNG image data.  The
   strategy parameter only affects the compression ratio but not the
   correctness of the compressed output even if it is not set appropriately.
   Z_FIXED prevents the use of dynamic Huffman codes, allowing for a simpler
   decoder for special applications.

     deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
   memory, Z_STREAM_ERROR if any parameter is invalid (such as an invalid
   method), or Z_VERSION_ERROR if the zlib library version (zlib_version) is
   incompatible with the version assumed by the caller (ZLIB_VERSION).  msg is
   set to null if there is no error message.  deflateInit2 does not perform any
   compression: this will be done by deflate().
*/

ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm,
                                             const Bytef *dictionary,
                                             uInt  dictLength));
/*
     Initializes the compression dictionary from the given byte sequence
   without producing any compressed output.  When using the zlib format, this
   function must be called immediately after deflateInit, deflateInit2 or
   deflateReset, and before any call of deflate.  When doing raw deflate, this
   function must be called either before any call of deflate, or immediately
   after the completion of a deflate block, i.e. after all input has been
   consumed and all output has been delivered when using any of the flush
   options Z_BLOCK, Z_PARTIAL_FLUSH, Z_SYNC_FLUSH, or Z_FULL_FLUSH.  The
   compressor and decompressor must use exactly the same dictionary (see
   inflateSetDictionary).

     The dictionary should consist of strings (byte sequences) that are likely
   to be encountered later in the data to be compressed, with the most commonly
   used strings preferably put towards the end of the dictionary.  Using a
   dictionary is most useful when the data to be compressed is short and can be
   predicted with good accuracy; the data can then be compressed better than
   with the default empty dictionary.

     Depending on the size of the compression data structures selected by
   deflateInit or deflateInit2, a part of the dictionary may in effect be
   discarded, for example if the dictionary is larger than the window size
   provided in deflateInit or deflateInit2.  Thus the strings most likely to be
   useful should be put at the end of the dictionary, not at the front.  In
   addition, the current implementation of deflate will use at most the window
   size minus 262 bytes of the provided dictionary.

     Upon return of this function, strm->adler is set to the Adler-32 value
   of the dictionary; the decompressor may later use this value to determine
   which dictionary has been used by the compressor.  (The Adler-32 value
   applies to the whole dictionary even if only a subset of the dictionary is
   actually used by the compressor.) If a raw deflate was requested, then the
   Adler-32 value is not computed and strm->adler is not set.

     deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a
   parameter is invalid (e.g.  dictionary being Z_NULL) or the stream state is
   inconsistent (for example if deflate has already been called for this stream
   or if not at a block boundary for raw deflate).  deflateSetDictionary does
   not perform any compression: this will be done by deflate().
*/

ZEXTERN int ZEXPORT deflateGetDictionary OF((z_streamp strm,
                                             Bytef *dictionary,
                                             uInt  *dictLength));
/*
     Returns the sliding dictionary being maintained by deflate.  dictLength is
   set to the number of bytes in the dictionary, and that many bytes are copied
   to dictionary.  dictionary must have enough space, where 32768 bytes is
   always enough.  If deflateGetDictionary() is called with dictionary equal to
   Z_NULL, then only the dictionary length is returned, and nothing is copied.
   Similary, if dictLength is Z_NULL, then it is not set.

     deflateGetDictionary() may return a length less than the window size, even
   when more than the window size in input has been provided. It may return up
   to 258 bytes less in that case, due to how zlib's implementation of deflate
   manages the sliding window and lookahead for matches, where matches can be
   up to 258 bytes long. If the application needs the last window-size bytes of
   input, then that would need to be saved by the application outside of zlib.

     deflateGetDictionary returns Z_OK on success, or Z_STREAM_ERROR if the
   stream state is inconsistent.
*/

ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest,
                                    z_streamp source));
/*
     Sets the destination stream as a complete copy of the source stream.

     This function can be useful when several compression strategies will be
   tried, for example when there are several ways of pre-processing the input
   data with a filter.  The streams that will be discarded should then be freed
   by calling deflateEnd.  Note that deflateCopy duplicates the internal
   compression state which can be quite large, so this strategy is slow and can
   consume lots of memory.

     deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
   enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
   (such as zalloc being Z_NULL).  msg is left unchanged in both source and
   destination.
*/

ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm));
/*
     This function is equivalent to deflateEnd followed by deflateInit, but
   does not free and reallocate the internal compression state.  The stream
   will leave the compression level and any other attributes that may have been
   set unchanged.

     deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
   stream state was inconsistent (such as zalloc or state being Z_NULL).
*/

ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm,
                                      int level,
                                      int strategy));
/*
     Dynamically update the compression level and compression strategy.  The
   interpretation of level and strategy is as in deflateInit2().  This can be
   used to switch between compression and straight copy of the input data, or
   to switch to a different kind of input data requiring a different strategy.
   If the compression approach (which is a function of the level) or the
   strategy is changed, and if any input has been consumed in a previous
   deflate() call, then the input available so far is compressed with the old
   level and strategy using deflate(strm, Z_BLOCK).  There are three approaches
   for the compression levels 0, 1..3, and 4..9 respectively.  The new level
   and strategy will take effect at the next call of deflate().

     If a deflate(strm, Z_BLOCK) is performed by deflateParams(), and it does
   not have enough output space to complete, then the parameter change will not
   take effect.  In this case, deflateParams() can be called again with the
   same parameters and more output space to try again.

     In order to assure a change in the parameters on the first try, the
   deflate stream should be flushed using deflate() with Z_BLOCK or other flush
   request until strm.avail_out is not zero, before calling deflateParams().
   Then no more input data should be provided before the deflateParams() call.
   If this is done, the old level and strategy will be applied to the data
   compressed before deflateParams(), and the new level and strategy will be
   applied to the the data compressed after deflateParams().

     deflateParams returns Z_OK on success, Z_STREAM_ERROR if the source stream
   state was inconsistent or if a parameter was invalid, or Z_BUF_ERROR if
   there was not enough output space to complete the compression of the
   available input data before a change in the strategy or approach.  Note that
   in the case of a Z_BUF_ERROR, the parameters are not changed.  A return
   value of Z_BUF_ERROR is not fatal, in which case deflateParams() can be
   retried with more output space.
*/

ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm,
                                    int good_length,
                                    int max_lazy,
                                    int nice_length,
                                    int max_chain));
/*
     Fine tune deflate's internal compression parameters.  This should only be
   used by someone who understands the algorithm used by zlib's deflate for
   searching for the best matching string, and even then only by the most
   fanatic optimizer trying to squeeze out the last compressed bit for their
   specific input data.  Read the deflate.c source code for the meaning of the
   max_lazy, good_length, nice_length, and max_chain parameters.

     deflateTune() can be called after deflateInit() or deflateInit2(), and
   returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream.
 */

ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm,
                                       uLong sourceLen));
/*
     deflateBound() returns an upper bound on the compressed size after
   deflation of sourceLen bytes.  It must be called after deflateInit() or
   deflateInit2(), and after deflateSetHeader(), if used.  This would be used
   to allocate an output buffer for deflation in a single pass, and so would be
   called before deflate().  If that first deflate() call is provided the
   sourceLen input bytes, an output buffer allocated to the size returned by
   deflateBound(), and the flush value Z_FINISH, then deflate() is guaranteed
   to return Z_STREAM_END.  Note that it is possible for the compressed size to
   be larger than the value returned by deflateBound() if flush options other
   than Z_FINISH or Z_NO_FLUSH are used.
*/

ZEXTERN int ZEXPORT deflatePending OF((z_streamp strm,
                                       unsigned *pending,
                                       int *bits));
/*
     deflatePending() returns the number of bytes and bits of output that have
   been generated, but not yet provided in the available output.  The bytes not
   provided would be due to the available output space having being consumed.
   The number of bits of output not provided are between 0 and 7, where they
   await more bits to join them in order to fill out a full byte.  If pending
   or bits are Z_NULL, then those values are not set.

     deflatePending returns Z_OK if success, or Z_STREAM_ERROR if the source
   stream state was inconsistent.
 */

ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm,
                                     int bits,
                                     int value));
/*
     deflatePrime() inserts bits in the deflate output stream.  The intent
   is that this function is used to start off the deflate output with the bits
   leftover from a previous deflate stream when appending to it.  As such, this
   function can only be used for raw deflate, and must be used before the first
   deflate() call after a deflateInit2() or deflateReset().  bits must be less
   than or equal to 16, and that many of the least significant bits of value
   will be inserted in the output.

     deflatePrime returns Z_OK if success, Z_BUF_ERROR if there was not enough
   room in the internal buffer to insert the bits, or Z_STREAM_ERROR if the
   source stream state was inconsistent.
*/

ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm,
                                         gz_headerp head));
/*
     deflateSetHeader() provides gzip header information for when a gzip
   stream is requested by deflateInit2().  deflateSetHeader() may be called
   after deflateInit2() or deflateReset() and before the first call of
   deflate().  The text, time, os, extra field, name, and comment information
   in the provided gz_header structure are written to the gzip header (xflag is
   ignored -- the extra flags are set according to the compression level).  The
   caller must assure that, if not Z_NULL, name and comment are terminated with
   a zero byte, and that if extra is not Z_NULL, that extra_len bytes are
   available there.  If hcrc is true, a gzip header crc is included.  Note that
   the current versions of the command-line version of gzip (up through version
   1.3.x) do not support header crc's, and will report that it is a "multi-part
   gzip file" and give up.

     If deflateSetHeader is not used, the default gzip header has text false,
   the time set to zero, and os set to 255, with no extra, name, or comment
   fields.  The gzip header is returned to the default state by deflateReset().

     deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
   stream state was inconsistent.
*/

/*
ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm,
                                     int  windowBits));

     This is another version of inflateInit with an extra parameter.  The
   fields next_in, avail_in, zalloc, zfree and opaque must be initialized
   before by the caller.

     The windowBits parameter is the base two logarithm of the maximum window
   size (the size of the history buffer).  It should be in the range 8..15 for
   this version of the library.  The default value is 15 if inflateInit is used
   instead.  windowBits must be greater than or equal to the windowBits value
   provided to deflateInit2() while compressing, or it must be equal to 15 if
   deflateInit2() was not used.  If a compressed stream with a larger window
   size is given as input, inflate() will return with the error code
   Z_DATA_ERROR instead of trying to allocate a larger window.

     windowBits can also be zero to request that inflate use the window size in
   the zlib header of the compressed stream.

     windowBits can also be -8..-15 for raw inflate.  In this case, -windowBits
   determines the window size.  inflate() will then process raw deflate data,
   not looking for a zlib or gzip header, not generating a check value, and not
   looking for any check values for comparison at the end of the stream.  This
   is for use with other formats that use the deflate compressed data format
   such as zip.  Those formats provide their own check values.  If a custom
   format is developed using the raw deflate format for compressed data, it is
   recommended that a check value such as an Adler-32 or a CRC-32 be applied to
   the uncompressed data as is done in the zlib, gzip, and zip formats.  For
   most applications, the zlib format should be used as is.  Note that comments
   above on the use in deflateInit2() applies to the magnitude of windowBits.

     windowBits can also be greater than 15 for optional gzip decoding.  Add
   32 to windowBits to enable zlib and gzip decoding with automatic header
   detection, or add 16 to decode only the gzip format (the zlib format will
   return a Z_DATA_ERROR).  If a gzip stream is being decoded, strm->adler is a
   CRC-32 instead of an Adler-32.  Unlike the gunzip utility and gzread() (see
   below), inflate() will not automatically decode concatenated gzip streams.
   inflate() will return Z_STREAM_END at the end of the gzip stream.  The state
   would need to be reset to continue decoding a subsequent gzip stream.

     inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
   memory, Z_VERSION_ERROR if the zlib library version is incompatible with the
   version assumed by the caller, or Z_STREAM_ERROR if the parameters are
   invalid, such as a null pointer to the structure.  msg is set to null if
   there is no error message.  inflateInit2 does not perform any decompression
   apart from possibly reading the zlib header if present: actual decompression
   will be done by inflate().  (So next_in and avail_in may be modified, but
   next_out and avail_out are unused and unchanged.) The current implementation
   of inflateInit2() does not process any header information -- that is
   deferred until inflate() is called.
*/

ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm,
                                             const Bytef *dictionary,
                                             uInt  dictLength));
/*
     Initializes the decompression dictionary from the given uncompressed byte
   sequence.  This function must be called immediately after a call of inflate,
   if that call returned Z_NEED_DICT.  The dictionary chosen by the compressor
   can be determined from the Adler-32 value returned by that call of inflate.
   The compressor and decompressor must use exactly the same dictionary (see
   deflateSetDictionary).  For raw inflate, this function can be called at any
   time to set the dictionary.  If the provided dictionary is smaller than the
   window and there is already data in the window, then the provided dictionary
   will amend what's there.  The application must insure that the dictionary
   that was used for compression is provided.

     inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a
   parameter is invalid (e.g.  dictionary being Z_NULL) or the stream state is
   inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the
   expected one (incorrect Adler-32 value).  inflateSetDictionary does not
   perform any decompression: this will be done by subsequent calls of
   inflate().
*/

ZEXTERN int ZEXPORT inflateGetDictionary OF((z_streamp strm,
                                             Bytef *dictionary,
                                             uInt  *dictLength));
/*
     Returns the sliding dictionary being maintained by inflate.  dictLength is
   set to the number of bytes in the dictionary, and that many bytes are copied
   to dictionary.  dictionary must have enough space, where 32768 bytes is
   always enough.  If inflateGetDictionary() is called with dictionary equal to
   Z_NULL, then only the dictionary length is returned, and nothing is copied.
   Similary, if dictLength is Z_NULL, then it is not set.

     inflateGetDictionary returns Z_OK on success, or Z_STREAM_ERROR if the
   stream state is inconsistent.
*/

ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm));
/*
     Skips invalid compressed data until a possible full flush point (see above
   for the description of deflate with Z_FULL_FLUSH) can be found, or until all
   available input is skipped.  No output is provided.

     inflateSync searches for a 00 00 FF FF pattern in the compressed data.
   All full flush points have this pattern, but not all occurrences of this
   pattern are full flush points.

     inflateSync returns Z_OK if a possible full flush point has been found,
   Z_BUF_ERROR if no more input was provided, Z_DATA_ERROR if no flush point
   has been found, or Z_STREAM_ERROR if the stream structure was inconsistent.
   In the success case, the application may save the current current value of
   total_in which indicates where valid compressed data was found.  In the
   error case, the application may repeatedly call inflateSync, providing more
   input each time, until success or end of the input data.
*/

ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest,
                                    z_streamp source));
/*
     Sets the destination stream as a complete copy of the source stream.

     This function can be useful when randomly accessing a large stream.  The
   first pass through the stream can periodically record the inflate state,
   allowing restarting inflate at those points when randomly accessing the
   stream.

     inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not
   enough memory, Z_STREAM_ERROR if the source stream state was inconsistent
   (such as zalloc being Z_NULL).  msg is left unchanged in both source and
   destination.
*/

ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm));
/*
     This function is equivalent to inflateEnd followed by inflateInit,
   but does not free and reallocate the internal decompression state.  The
   stream will keep attributes that may have been set by inflateInit2.

     inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source
   stream state was inconsistent (such as zalloc or state being Z_NULL).
*/

ZEXTERN int ZEXPORT inflateReset2 OF((z_streamp strm,
                                      int windowBits));
/*
     This function is the same as inflateReset, but it also permits changing
   the wrap and window size requests.  The windowBits parameter is interpreted
   the same as it is for inflateInit2.  If the window size is changed, then the
   memory allocated for the window is freed, and the window will be reallocated
   by inflate() if needed.

     inflateReset2 returns Z_OK if success, or Z_STREAM_ERROR if the source
   stream state was inconsistent (such as zalloc or state being Z_NULL), or if
   the windowBits parameter is invalid.
*/

ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm,
                                     int bits,
                                     int value));
/*
     This function inserts bits in the inflate input stream.  The intent is
   that this function is used to start inflating at a bit position in the
   middle of a byte.  The provided bits will be used before any bytes are used
   from next_in.  This function should only be used with raw inflate, and
   should be used before the first inflate() call after inflateInit2() or
   inflateReset().  bits must be less than or equal to 16, and that many of the
   least significant bits of value will be inserted in the input.

     If bits is negative, then the input stream bit buffer is emptied.  Then
   inflatePrime() can be called again to put bits in the buffer.  This is used
   to clear out bits leftover after feeding inflate a block description prior
   to feeding inflate codes.

     inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source
   stream state was inconsistent.
*/

ZEXTERN long ZEXPORT inflateMark OF((z_streamp strm));
/*
     This function returns two values, one in the lower 16 bits of the return
   value, and the other in the remaining upper bits, obtained by shifting the
   return value down 16 bits.  If the upper value is -1 and the lower value is
   zero, then inflate() is currently decoding information outside of a block.
   If the upper value is -1 and the lower value is non-zero, then inflate is in
   the middle of a stored block, with the lower value equaling the number of
   bytes from the input remaining to copy.  If the upper value is not -1, then
   it is the number of bits back from the current bit position in the input of
   the code (literal or length/distance pair) currently being processed.  In
   that case the lower value is the number of bytes already emitted for that
   code.

     A code is being processed if inflate is waiting for more input to complete
   decoding of the code, or if it has completed decoding but is waiting for
   more output space to write the literal or match data.

     inflateMark() is used to mark locations in the input data for random
   access, which may be at bit positions, and to note those cases where the
   output of a code may span boundaries of random access blocks.  The current
   location in the input stream can be determined from avail_in and data_type
   as noted in the description for the Z_BLOCK flush parameter for inflate.

     inflateMark returns the value noted above, or -65536 if the provided
   source stream state was inconsistent.
*/

ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm,
                                         gz_headerp head));
/*
     inflateGetHeader() requests that gzip header information be stored in the
   provided gz_header structure.  inflateGetHeader() may be called after
   inflateInit2() or inflateReset(), and before the first call of inflate().
   As inflate() processes the gzip stream, head->done is zero until the header
   is completed, at which time head->done is set to one.  If a zlib stream is
   being decoded, then head->done is set to -1 to indicate that there will be
   no gzip header information forthcoming.  Note that Z_BLOCK or Z_TREES can be
   used to force inflate() to return immediately after header processing is
   complete and before any actual data is decompressed.

     The text, time, xflags, and os fields are filled in with the gzip header
   contents.  hcrc is set to true if there is a header CRC.  (The header CRC
   was valid if done is set to one.) If extra is not Z_NULL, then extra_max
   contains the maximum number of bytes to write to extra.  Once done is true,
   extra_len contains the actual extra field length, and extra contains the
   extra field, or that field truncated if extra_max is less than extra_len.
   If name is not Z_NULL, then up to name_max characters are written there,
   terminated with a zero unless the length is greater than name_max.  If
   comment is not Z_NULL, then up to comm_max characters are written there,
   terminated with a zero unless the length is greater than comm_max.  When any
   of extra, name, or comment are not Z_NULL and the respective field is not
   present in the header, then that field is set to Z_NULL to signal its
   absence.  This allows the use of deflateSetHeader() with the returned
   structure to duplicate the header.  However if those fields are set to
   allocated memory, then the application will need to save those pointers
   elsewhere so that they can be eventually freed.

     If inflateGetHeader is not used, then the header information is simply
   discarded.  The header is always checked for validity, including the header
   CRC if present.  inflateReset() will reset the process to discard the header
   information.  The application would need to call inflateGetHeader() again to
   retrieve the header from the next gzip stream.

     inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source
   stream state was inconsistent.
*/

/*
ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits,
                                        unsigned char FAR *window));

     Initialize the internal stream state for decompression using inflateBack()
   calls.  The fields zalloc, zfree and opaque in strm must be initialized
   before the call.  If zalloc and zfree are Z_NULL, then the default library-
   derived memory allocation routines are used.  windowBits is the base two
   logarithm of the window size, in the range 8..15.  window is a caller
   supplied buffer of that size.  Except for special applications where it is
   assured that deflate was used with small window sizes, windowBits must be 15
   and a 32K byte window must be supplied to be able to decompress general
   deflate streams.

     See inflateBack() for the usage of these routines.

     inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of
   the parameters are invalid, Z_MEM_ERROR if the internal state could not be
   allocated, or Z_VERSION_ERROR if the version of the library does not match
   the version of the header file.
*/

typedef unsigned (*in_func) OF((void FAR *,
                                z_const unsigned char FAR * FAR *));
typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned));

ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm,
                                    in_func in, void FAR *in_desc,
                                    out_func out, void FAR *out_desc));
/*
     inflateBack() does a raw inflate with a single call using a call-back
   interface for input and output.  This is potentially more efficient than
   inflate() for file i/o applications, in that it avoids copying between the
   output and the sliding window by simply making the window itself the output
   buffer.  inflate() can be faster on modern CPUs when used with large
   buffers.  inflateBack() trusts the application to not change the output
   buffer passed by the output function, at least until inflateBack() returns.

     inflateBackInit() must be called first to allocate the internal state
   and to initialize the state with the user-provided window buffer.
   inflateBack() may then be used multiple times to inflate a complete, raw
   deflate stream with each call.  inflateBackEnd() is then called to free the
   allocated state.

     A raw deflate stream is one with no zlib or gzip header or trailer.
   This routine would normally be used in a utility that reads zip or gzip
   files and writes out uncompressed files.  The utility would decode the
   header and process the trailer on its own, hence this routine expects only
   the raw deflate stream to decompress.  This is different from the default
   behavior of inflate(), which expects a zlib header and trailer around the
   deflate stream.

     inflateBack() uses two subroutines supplied by the caller that are then
   called by inflateBack() for input and output.  inflateBack() calls those
   routines until it reads a complete deflate stream and writes out all of the
   uncompressed data, or until it encounters an error.  The function's
   parameters and return types are defined above in the in_func and out_func
   typedefs.  inflateBack() will call in(in_desc, &buf) which should return the
   number of bytes of provided input, and a pointer to that input in buf.  If
   there is no input available, in() must return zero -- buf is ignored in that
   case -- and inflateBack() will return a buffer error.  inflateBack() will
   call out(out_desc, buf, len) to write the uncompressed data buf[0..len-1].
   out() should return zero on success, or non-zero on failure.  If out()
   returns non-zero, inflateBack() will return with an error.  Neither in() nor
   out() are permitted to change the contents of the window provided to
   inflateBackInit(), which is also the buffer that out() uses to write from.
   The length written by out() will be at most the window size.  Any non-zero
   amount of input may be provided by in().

     For convenience, inflateBack() can be provided input on the first call by
   setting strm->next_in and strm->avail_in.  If that input is exhausted, then
   in() will be called.  Therefore strm->next_in must be initialized before
   calling inflateBack().  If strm->next_in is Z_NULL, then in() will be called
   immediately for input.  If strm->next_in is not Z_NULL, then strm->avail_in
   must also be initialized, and then if strm->avail_in is not zero, input will
   initially be taken from strm->next_in[0 ..  strm->avail_in - 1].

     The in_desc and out_desc parameters of inflateBack() is passed as the
   first parameter of in() and out() respectively when they are called.  These
   descriptors can be optionally used to pass any information that the caller-
   supplied in() and out() functions need to do their job.

     On return, inflateBack() will set strm->next_in and strm->avail_in to
   pass back any unused input that was provided by the last in() call.  The
   return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR
   if in() or out() returned an error, Z_DATA_ERROR if there was a format error
   in the deflate stream (in which case strm->msg is set to indicate the nature
   of the error), or Z_STREAM_ERROR if the stream was not properly initialized.
   In the case of Z_BUF_ERROR, an input or output error can be distinguished
   using strm->next_in which will be Z_NULL only if in() returned an error.  If
   strm->next_in is not Z_NULL, then the Z_BUF_ERROR was due to out() returning
   non-zero.  (in() will always be called before out(), so strm->next_in is
   assured to be defined if out() returns non-zero.)  Note that inflateBack()
   cannot return Z_OK.
*/

ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm));
/*
     All memory allocated by inflateBackInit() is freed.

     inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream
   state was inconsistent.
*/

ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void));
/* Return flags indicating compile-time options.

    Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other:
     1.0: size of uInt
     3.2: size of uLong
     5.4: size of voidpf (pointer)
     7.6: size of z_off_t

    Compiler, assembler, and debug options:
     8: ZLIB_DEBUG
     9: ASMV or ASMINF -- use ASM code
     10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention
     11: 0 (reserved)

    One-time table building (smaller code, but not thread-safe if true):
     12: BUILDFIXED -- build static block decoding tables when needed
     13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed
     14,15: 0 (reserved)

    Library content (indicates missing functionality):
     16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking
                          deflate code when not needed)
     17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect
                    and decode gzip streams (to avoid linking crc code)
     18-19: 0 (reserved)

    Operation variations (changes in library functionality):
     20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate
     21: FASTEST -- deflate algorithm with only one, lowest compression level
     22,23: 0 (reserved)

    The sprintf variant used by gzprintf (zero is best):
     24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format
     25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure!
     26: 0 = returns value, 1 = void -- 1 means inferred string length returned

    Remainder:
     27-31: 0 (reserved)
 */

#ifndef Z_SOLO

                        /* utility functions */

/*
     The following utility functions are implemented on top of the basic
   stream-oriented functions.  To simplify the interface, some default options
   are assumed (compression level and memory usage, standard memory allocation
   functions).  The source code of these utility functions can be modified if
   you need special options.
*/

ZEXTERN int ZEXPORT compress OF((Bytef *dest,   uLongf *destLen,
                                 const Bytef *source, uLong sourceLen));
/*
     Compresses the source buffer into the destination buffer.  sourceLen is
   the byte length of the source buffer.  Upon entry, destLen is the total size
   of the destination buffer, which must be at least the value returned by
   compressBound(sourceLen).  Upon exit, destLen is the actual size of the
   compressed data.  compress() is equivalent to compress2() with a level
   parameter of Z_DEFAULT_COMPRESSION.

     compress returns Z_OK if success, Z_MEM_ERROR if there was not
   enough memory, Z_BUF_ERROR if there was not enough room in the output
   buffer.
*/

ZEXTERN int ZEXPORT compress2 OF((Bytef *dest,   uLongf *destLen,
                                  const Bytef *source, uLong sourceLen,
                                  int level));
/*
     Compresses the source buffer into the destination buffer.  The level
   parameter has the same meaning as in deflateInit.  sourceLen is the byte
   length of the source buffer.  Upon entry, destLen is the total size of the
   destination buffer, which must be at least the value returned by
   compressBound(sourceLen).  Upon exit, destLen is the actual size of the
   compressed data.

     compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough
   memory, Z_BUF_ERROR if there was not enough room in the output buffer,
   Z_STREAM_ERROR if the level parameter is invalid.
*/

ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen));
/*
     compressBound() returns an upper bound on the compressed size after
   compress() or compress2() on sourceLen bytes.  It would be used before a
   compress() or compress2() call to allocate the destination buffer.
*/

ZEXTERN int ZEXPORT uncompress OF((Bytef *dest,   uLongf *destLen,
                                   const Bytef *source, uLong sourceLen));
/*
     Decompresses the source buffer into the destination buffer.  sourceLen is
   the byte length of the source buffer.  Upon entry, destLen is the total size
   of the destination buffer, which must be large enough to hold the entire
   uncompressed data.  (The size of the uncompressed data must have been saved
   previously by the compressor and transmitted to the decompressor by some
   mechanism outside the scope of this compression library.) Upon exit, destLen
   is the actual size of the uncompressed data.

     uncompress returns Z_OK if success, Z_MEM_ERROR if there was not
   enough memory, Z_BUF_ERROR if there was not enough room in the output
   buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete.  In
   the case where there is not enough room, uncompress() will fill the output
   buffer with the uncompressed data up to that point.
*/

ZEXTERN int ZEXPORT uncompress2 OF((Bytef *dest,   uLongf *destLen,
                                    const Bytef *source, uLong *sourceLen));
/*
     Same as uncompress, except that sourceLen is a pointer, where the
   length of the source is *sourceLen.  On return, *sourceLen is the number of
   source bytes consumed.
*/

                        /* gzip file access functions */

/*
     This library supports reading and writing files in gzip (.gz) format with
   an interface similar to that of stdio, using the functions that start with
   "gz".  The gzip format is different from the zlib format.  gzip is a gzip
   wrapper, documented in RFC 1952, wrapped around a deflate stream.
*/

typedef struct gzFile_s *gzFile;    /* semi-opaque gzip file descriptor */

/*
ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode));

     Opens a gzip (.gz) file for reading or writing.  The mode parameter is as
   in fopen ("rb" or "wb") but can also include a compression level ("wb9") or
   a strategy: 'f' for filtered data as in "wb6f", 'h' for Huffman-only
   compression as in "wb1h", 'R' for run-length encoding as in "wb1R", or 'F'
   for fixed code compression as in "wb9F".  (See the description of
   deflateInit2 for more information about the strategy parameter.)  'T' will
   request transparent writing or appending with no compression and not using
   the gzip format.

     "a" can be used instead of "w" to request that the gzip stream that will
   be written be appended to the file.  "+" will result in an error, since
   reading and writing to the same gzip file is not supported.  The addition of
   "x" when writing will create the file exclusively, which fails if the file
   already exists.  On systems that support it, the addition of "e" when
   reading or writing will set the flag to close the file on an execve() call.

     These functions, as well as gzip, will read and decode a sequence of gzip
   streams in a file.  The append function of gzopen() can be used to create
   such a file.  (Also see gzflush() for another way to do this.)  When
   appending, gzopen does not test whether the file begins with a gzip stream,
   nor does it look for the end of the gzip streams to begin appending.  gzopen
   will simply append a gzip stream to the existing file.

     gzopen can be used to read a file which is not in gzip format; in this
   case gzread will directly read from the file without decompression.  When
   reading, this will be detected automatically by looking for the magic two-
   byte gzip header.

     gzopen returns NULL if the file could not be opened, if there was
   insufficient memory to allocate the gzFile state, or if an invalid mode was
   specified (an 'r', 'w', or 'a' was not provided, or '+' was provided).
   errno can be checked to determine if the reason gzopen failed was that the
   file could not be opened.
*/

ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode));
/*
     gzdopen associates a gzFile with the file descriptor fd.  File descriptors
   are obtained from calls like open, dup, creat, pipe or fileno (if the file
   has been previously opened with fopen).  The mode parameter is as in gzopen.

     The next call of gzclose on the returned gzFile will also close the file
   descriptor fd, just like fclose(fdopen(fd, mode)) closes the file descriptor
   fd.  If you want to keep fd open, use fd = dup(fd_keep); gz = gzdopen(fd,
   mode);.  The duplicated descriptor should be saved to avoid a leak, since
   gzdopen does not close fd if it fails.  If you are using fileno() to get the
   file descriptor from a FILE *, then you will have to use dup() to avoid
   double-close()ing the file descriptor.  Both gzclose() and fclose() will
   close the associated file descriptor, so they need to have different file
   descriptors.

     gzdopen returns NULL if there was insufficient memory to allocate the
   gzFile state, if an invalid mode was specified (an 'r', 'w', or 'a' was not
   provided, or '+' was provided), or if fd is -1.  The file descriptor is not
   used until the next gz* read, write, seek, or close operation, so gzdopen
   will not detect if fd is invalid (unless fd is -1).
*/

ZEXTERN int ZEXPORT gzbuffer OF((gzFile file, unsigned size));
/*
     Set the internal buffer size used by this library's functions.  The
   default buffer size is 8192 bytes.  This function must be called after
   gzopen() or gzdopen(), and before any other calls that read or write the
   file.  The buffer memory allocation is always deferred to the first read or
   write.  Three times that size in buffer space is allocated.  A larger buffer
   size of, for example, 64K or 128K bytes will noticeably increase the speed
   of decompression (reading).

     The new buffer size also affects the maximum length for gzprintf().

     gzbuffer() returns 0 on success, or -1 on failure, such as being called
   too late.
*/

ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy));
/*
     Dynamically update the compression level or strategy.  See the description
   of deflateInit2 for the meaning of these parameters.  Previously provided
   data is flushed before the parameter change.

     gzsetparams returns Z_OK if success, Z_STREAM_ERROR if the file was not
   opened for writing, Z_ERRNO if there is an error writing the flushed data,
   or Z_MEM_ERROR if there is a memory allocation error.
*/

ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len));
/*
     Reads the given number of uncompressed bytes from the compressed file.  If
   the input file is not in gzip format, gzread copies the given number of
   bytes into the buffer directly from the file.

     After reaching the end of a gzip stream in the input, gzread will continue
   to read, looking for another gzip stream.  Any number of gzip streams may be
   concatenated in the input file, and will all be decompressed by gzread().
   If something other than a gzip stream is encountered after a gzip stream,
   that remaining trailing garbage is ignored (and no error is returned).

     gzread can be used to read a gzip file that is being concurrently written.
   Upon reaching the end of the input, gzread will return with the available
   data.  If the error code returned by gzerror is Z_OK or Z_BUF_ERROR, then
   gzclearerr can be used to clear the end of file indicator in order to permit
   gzread to be tried again.  Z_OK indicates that a gzip stream was completed
   on the last gzread.  Z_BUF_ERROR indicates that the input file ended in the
   middle of a gzip stream.  Note that gzread does not return -1 in the event
   of an incomplete gzip stream.  This error is deferred until gzclose(), which
   will return Z_BUF_ERROR if the last gzread ended in the middle of a gzip
   stream.  Alternatively, gzerror can be used before gzclose to detect this
   case.

     gzread returns the number of uncompressed bytes actually read, less than
   len for end of file, or -1 for error.  If len is too large to fit in an int,
   then nothing is read, -1 is returned, and the error state is set to
   Z_STREAM_ERROR.
*/

ZEXTERN z_size_t ZEXPORT gzfread OF((voidp buf, z_size_t size, z_size_t nitems,
                                     gzFile file));
/*
     Read up to nitems items of size size from file to buf, otherwise operating
   as gzread() does.  This duplicates the interface of stdio's fread(), with
   size_t request and return types.  If the library defines size_t, then
   z_size_t is identical to size_t.  If not, then z_size_t is an unsigned
   integer type that can contain a pointer.

     gzfread() returns the number of full items read of size size, or zero if
   the end of the file was reached and a full item could not be read, or if
   there was an error.  gzerror() must be consulted if zero is returned in
   order to determine if there was an error.  If the multiplication of size and
   nitems overflows, i.e. the product does not fit in a z_size_t, then nothing
   is read, zero is returned, and the error state is set to Z_STREAM_ERROR.

     In the event that the end of file is reached and only a partial item is
   available at the end, i.e. the remaining uncompressed data length is not a
   multiple of size, then the final partial item is nevetheless read into buf
   and the end-of-file flag is set.  The length of the partial item read is not
   provided, but could be inferred from the result of gztell().  This behavior
   is the same as the behavior of fread() implementations in common libraries,
   but it prevents the direct use of gzfread() to read a concurrently written
   file, reseting and retrying on end-of-file, when size is not 1.
*/

ZEXTERN int ZEXPORT gzwrite OF((gzFile file,
                                voidpc buf, unsigned len));
/*
     Writes the given number of uncompressed bytes into the compressed file.
   gzwrite returns the number of uncompressed bytes written or 0 in case of
   error.
*/

ZEXTERN z_size_t ZEXPORT gzfwrite OF((voidpc buf, z_size_t size,
                                      z_size_t nitems, gzFile file));
/*
     gzfwrite() writes nitems items of size size from buf to file, duplicating
   the interface of stdio's fwrite(), with size_t request and return types.  If
   the library defines size_t, then z_size_t is identical to size_t.  If not,
   then z_size_t is an unsigned integer type that can contain a pointer.

     gzfwrite() returns the number of full items written of size size, or zero
   if there was an error.  If the multiplication of size and nitems overflows,
   i.e. the product does not fit in a z_size_t, then nothing is written, zero
   is returned, and the error state is set to Z_STREAM_ERROR.
*/

ZEXTERN int ZEXPORTVA gzprintf Z_ARG((gzFile file, const char *format, ...));
/*
     Converts, formats, and writes the arguments to the compressed file under
   control of the format string, as in fprintf.  gzprintf returns the number of
   uncompressed bytes actually written, or a negative zlib error code in case
   of error.  The number of uncompressed bytes written is limited to 8191, or
   one less than the buffer size given to gzbuffer().  The caller should assure
   that this limit is not exceeded.  If it is exceeded, then gzprintf() will
   return an error (0) with nothing written.  In this case, there may also be a
   buffer overflow with unpredictable consequences, which is possible only if
   zlib was compiled with the insecure functions sprintf() or vsprintf()
   because the secure snprintf() or vsnprintf() functions were not available.
   This can be determined using zlibCompileFlags().
*/

ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s));
/*
     Writes the given null-terminated string to the compressed file, excluding
   the terminating null character.

     gzputs returns the number of characters written, or -1 in case of error.
*/

ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len));
/*
     Reads bytes from the compressed file until len-1 characters are read, or a
   newline character is read and transferred to buf, or an end-of-file
   condition is encountered.  If any characters are read or if len == 1, the
   string is terminated with a null character.  If no characters are read due
   to an end-of-file or len < 1, then the buffer is left untouched.

     gzgets returns buf which is a null-terminated string, or it returns NULL
   for end-of-file or in case of error.  If there was an error, the contents at
   buf are indeterminate.
*/

ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c));
/*
     Writes c, converted to an unsigned char, into the compressed file.  gzputc
   returns the value that was written, or -1 in case of error.
*/

ZEXTERN int ZEXPORT gzgetc OF((gzFile file));
/*
     Reads one byte from the compressed file.  gzgetc returns this byte or -1
   in case of end of file or error.  This is implemented as a macro for speed.
   As such, it does not do all of the checking the other functions do.  I.e.
   it does not check to see if file is NULL, nor whether the structure file
   points to has been clobbered or not.
*/

ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file));
/*
     Push one character back onto the stream to be read as the first character
   on the next read.  At least one character of push-back is allowed.
   gzungetc() returns the character pushed, or -1 on failure.  gzungetc() will
   fail if c is -1, and may fail if a character has been pushed but not read
   yet.  If gzungetc is used immediately after gzopen or gzdopen, at least the
   output buffer size of pushed characters is allowed.  (See gzbuffer above.)
   The pushed character will be discarded if the stream is repositioned with
   gzseek() or gzrewind().
*/

ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush));
/*
     Flushes all pending output into the compressed file.  The parameter flush
   is as in the deflate() function.  The return value is the zlib error number
   (see function gzerror below).  gzflush is only permitted when writing.

     If the flush parameter is Z_FINISH, the remaining data is written and the
   gzip stream is completed in the output.  If gzwrite() is called again, a new
   gzip stream will be started in the output.  gzread() is able to read such
   concatenated gzip streams.

     gzflush should be called only when strictly necessary because it will
   degrade compression if called too often.
*/

/*
ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file,
                                   z_off_t offset, int whence));

     Sets the starting position for the next gzread or gzwrite on the given
   compressed file.  The offset represents a number of bytes in the
   uncompressed data stream.  The whence parameter is defined as in lseek(2);
   the value SEEK_END is not supported.

     If the file is opened for reading, this function is emulated but can be
   extremely slow.  If the file is opened for writing, only forward seeks are
   supported; gzseek then compresses a sequence of zeroes up to the new
   starting position.

     gzseek returns the resulting offset location as measured in bytes from
   the beginning of the uncompressed stream, or -1 in case of error, in
   particular if the file is opened for writing and the new starting position
   would be before the current position.
*/

ZEXTERN int ZEXPORT    gzrewind OF((gzFile file));
/*
     Rewinds the given file. This function is supported only for reading.

     gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET)
*/

/*
ZEXTERN z_off_t ZEXPORT    gztell OF((gzFile file));

     Returns the starting position for the next gzread or gzwrite on the given
   compressed file.  This position represents a number of bytes in the
   uncompressed data stream, and is zero when starting, even if appending or
   reading a gzip stream from the middle of a file using gzdopen().

     gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR)
*/

/*
ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile file));

     Returns the current offset in the file being read or written.  This offset
   includes the count of bytes that precede the gzip stream, for example when
   appending or when using gzdopen() for reading.  When reading, the offset
   does not include as yet unused buffered input.  This information can be used
   for a progress indicator.  On error, gzoffset() returns -1.
*/

ZEXTERN int ZEXPORT gzeof OF((gzFile file));
/*
     Returns true (1) if the end-of-file indicator has been set while reading,
   false (0) otherwise.  Note that the end-of-file indicator is set only if the
   read tried to go past the end of the input, but came up short.  Therefore,
   just like feof(), gzeof() may return false even if there is no more data to
   read, in the event that the last read request was for the exact number of
   bytes remaining in the input file.  This will happen if the input file size
   is an exact multiple of the buffer size.

     If gzeof() returns true, then the read functions will return no more data,
   unless the end-of-file indicator is reset by gzclearerr() and the input file
   has grown since the previous end of file was detected.
*/

ZEXTERN int ZEXPORT gzdirect OF((gzFile file));
/*
     Returns true (1) if file is being copied directly while reading, or false
   (0) if file is a gzip stream being decompressed.

     If the input file is empty, gzdirect() will return true, since the input
   does not contain a gzip stream.

     If gzdirect() is used immediately after gzopen() or gzdopen() it will
   cause buffers to be allocated to allow reading the file to determine if it
   is a gzip file.  Therefore if gzbuffer() is used, it should be called before
   gzdirect().

     When writing, gzdirect() returns true (1) if transparent writing was
   requested ("wT" for the gzopen() mode), or false (0) otherwise.  (Note:
   gzdirect() is not needed when writing.  Transparent writing must be
   explicitly requested, so the application already knows the answer.  When
   linking statically, using gzdirect() will include all of the zlib code for
   gzip file reading and decompression, which may not be desired.)
*/

ZEXTERN int ZEXPORT    gzclose OF((gzFile file));
/*
     Flushes all pending output if necessary, closes the compressed file and
   deallocates the (de)compression state.  Note that once file is closed, you
   cannot call gzerror with file, since its structures have been deallocated.
   gzclose must not be called more than once on the same file, just as free
   must not be called more than once on the same allocation.

     gzclose will return Z_STREAM_ERROR if file is not valid, Z_ERRNO on a
   file operation error, Z_MEM_ERROR if out of memory, Z_BUF_ERROR if the
   last read ended in the middle of a gzip stream, or Z_OK on success.
*/

ZEXTERN int ZEXPORT gzclose_r OF((gzFile file));
ZEXTERN int ZEXPORT gzclose_w OF((gzFile file));
/*
     Same as gzclose(), but gzclose_r() is only for use when reading, and
   gzclose_w() is only for use when writing or appending.  The advantage to
   using these instead of gzclose() is that they avoid linking in zlib
   compression or decompression code that is not used when only reading or only
   writing respectively.  If gzclose() is used, then both compression and
   decompression code will be included the application when linking to a static
   zlib library.
*/

ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum));
/*
     Returns the error message for the last error which occurred on the given
   compressed file.  errnum is set to zlib error number.  If an error occurred
   in the file system and not in the compression library, errnum is set to
   Z_ERRNO and the application may consult errno to get the exact error code.

     The application must not modify the returned string.  Future calls to
   this function may invalidate the previously returned string.  If file is
   closed, then the string previously returned by gzerror will no longer be
   available.

     gzerror() should be used to distinguish errors from end-of-file for those
   functions above that do not distinguish those cases in their return values.
*/

ZEXTERN void ZEXPORT gzclearerr OF((gzFile file));
/*
     Clears the error and end-of-file flags for file.  This is analogous to the
   clearerr() function in stdio.  This is useful for continuing to read a gzip
   file that is being written concurrently.
*/

#endif /* !Z_SOLO */

                        /* checksum functions */

/*
     These functions are not related to compression but are exported
   anyway because they might be useful in applications using the compression
   library.
*/

ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len));
/*
     Update a running Adler-32 checksum with the bytes buf[0..len-1] and
   return the updated checksum.  If buf is Z_NULL, this function returns the
   required initial value for the checksum.

     An Adler-32 checksum is almost as reliable as a CRC-32 but can be computed
   much faster.

   Usage example:

     uLong adler = adler32(0L, Z_NULL, 0);

     while (read_buffer(buffer, length) != EOF) {
       adler = adler32(adler, buffer, length);
     }
     if (adler != original_adler) error();
*/

ZEXTERN uLong ZEXPORT adler32_z OF((uLong adler, const Bytef *buf,
                                    z_size_t len));
/*
     Same as adler32(), but with a size_t length.
*/

/*
ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2,
                                          z_off_t len2));

     Combine two Adler-32 checksums into one.  For two sequences of bytes, seq1
   and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for
   each, adler1 and adler2.  adler32_combine() returns the Adler-32 checksum of
   seq1 and seq2 concatenated, requiring only adler1, adler2, and len2.  Note
   that the z_off_t type (like off_t) is a signed integer.  If len2 is
   negative, the result has no meaning or utility.
*/

ZEXTERN uLong ZEXPORT crc32   OF((uLong crc, const Bytef *buf, uInt len));
/*
     Update a running CRC-32 with the bytes buf[0..len-1] and return the
   updated CRC-32.  If buf is Z_NULL, this function returns the required
   initial value for the crc.  Pre- and post-conditioning (one's complement) is
   performed within this function so it shouldn't be done by the application.

   Usage example:

     uLong crc = crc32(0L, Z_NULL, 0);

     while (read_buffer(buffer, length) != EOF) {
       crc = crc32(crc, buffer, length);
     }
     if (crc != original_crc) error();
*/

ZEXTERN uLong ZEXPORT crc32_z OF((uLong adler, const Bytef *buf,
                                  z_size_t len));
/*
     Same as crc32(), but with a size_t length.
*/

/*
ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2));

     Combine two CRC-32 check values into one.  For two sequences of bytes,
   seq1 and seq2 with lengths len1 and len2, CRC-32 check values were
   calculated for each, crc1 and crc2.  crc32_combine() returns the CRC-32
   check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and
   len2.
*/


                        /* various hacks, don't look :) */

/* deflateInit and inflateInit are macros to allow checking the zlib version
 * and the compiler's view of z_stream:
 */
ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level,
                                     const char *version, int stream_size));
ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm,
                                     const char *version, int stream_size));
ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int  level, int  method,
                                      int windowBits, int memLevel,
                                      int strategy, const char *version,
                                      int stream_size));
ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int  windowBits,
                                      const char *version, int stream_size));
ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits,
                                         unsigned char FAR *window,
                                         const char *version,
                                         int stream_size));
#ifdef Z_PREFIX_SET
#  define z_deflateInit(strm, level) \
          deflateInit_((strm), (level), ZLIB_VERSION, (int)sizeof(z_stream))
#  define z_inflateInit(strm) \
          inflateInit_((strm), ZLIB_VERSION, (int)sizeof(z_stream))
#  define z_deflateInit2(strm, level, method, windowBits, memLevel, strategy) \
          deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\
                        (strategy), ZLIB_VERSION, (int)sizeof(z_stream))
#  define z_inflateInit2(strm, windowBits) \
          inflateInit2_((strm), (windowBits), ZLIB_VERSION, \
                        (int)sizeof(z_stream))
#  define z_inflateBackInit(strm, windowBits, window) \
          inflateBackInit_((strm), (windowBits), (window), \
                           ZLIB_VERSION, (int)sizeof(z_stream))
#else
#  define deflateInit(strm, level) \
          deflateInit_((strm), (level), ZLIB_VERSION, (int)sizeof(z_stream))
#  define inflateInit(strm) \
          inflateInit_((strm), ZLIB_VERSION, (int)sizeof(z_stream))
#  define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \
          deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\
                        (strategy), ZLIB_VERSION, (int)sizeof(z_stream))
#  define inflateInit2(strm, windowBits) \
          inflateInit2_((strm), (windowBits), ZLIB_VERSION, \
                        (int)sizeof(z_stream))
#  define inflateBackInit(strm, windowBits, window) \
          inflateBackInit_((strm), (windowBits), (window), \
                           ZLIB_VERSION, (int)sizeof(z_stream))
#endif

#ifndef Z_SOLO

/* gzgetc() macro and its supporting function and exposed data structure.  Note
 * that the real internal state is much larger than the exposed structure.
 * This abbreviated structure exposes just enough for the gzgetc() macro.  The
 * user should not mess with these exposed elements, since their names or
 * behavior could change in the future, perhaps even capriciously.  They can
 * only be used by the gzgetc() macro.  You have been warned.
 */
struct gzFile_s {
    unsigned have;
    unsigned char *next;
    z_off64_t pos;
};
ZEXTERN int ZEXPORT gzgetc_ OF((gzFile file));  /* backward compatibility */
#ifdef Z_PREFIX_SET
#  undef z_gzgetc
#  define z_gzgetc(g) \
          ((g)->have ? ((g)->have--, (g)->pos++, *((g)->next)++) : (gzgetc)(g))
#else
#  define gzgetc(g) \
          ((g)->have ? ((g)->have--, (g)->pos++, *((g)->next)++) : (gzgetc)(g))
#endif

/* provide 64-bit offset functions if _LARGEFILE64_SOURCE defined, and/or
 * change the regular functions to 64 bits if _FILE_OFFSET_BITS is 64 (if
 * both are true, the application gets the *64 functions, and the regular
 * functions are changed to 64 bits) -- in case these are set on systems
 * without large file support, _LFS64_LARGEFILE must also be true
 */
#ifdef Z_LARGE64
   ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *));
   ZEXTERN z_off64_t ZEXPORT gzseek64 OF((gzFile, z_off64_t, int));
   ZEXTERN z_off64_t ZEXPORT gztell64 OF((gzFile));
   ZEXTERN z_off64_t ZEXPORT gzoffset64 OF((gzFile));
   ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off64_t));
   ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off64_t));
#endif

#if !defined(ZLIB_INTERNAL) && defined(Z_WANT64)
#  ifdef Z_PREFIX_SET
#    define z_gzopen z_gzopen64
#    define z_gzseek z_gzseek64
#    define z_gztell z_gztell64
#    define z_gzoffset z_gzoffset64
#    define z_adler32_combine z_adler32_combine64
#    define z_crc32_combine z_crc32_combine64
#  else
#    define gzopen gzopen64
#    define gzseek gzseek64
#    define gztell gztell64
#    define gzoffset gzoffset64
#    define adler32_combine adler32_combine64
#    define crc32_combine crc32_combine64
#  endif
#  ifndef Z_LARGE64
     ZEXTERN gzFile ZEXPORT gzopen64 OF((const char *, const char *));
     ZEXTERN z_off_t ZEXPORT gzseek64 OF((gzFile, z_off_t, int));
     ZEXTERN z_off_t ZEXPORT gztell64 OF((gzFile));
     ZEXTERN z_off_t ZEXPORT gzoffset64 OF((gzFile));
     ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t));
     ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t));
#  endif
#else
   ZEXTERN gzFile ZEXPORT gzopen OF((const char *, const char *));
   ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile, z_off_t, int));
   ZEXTERN z_off_t ZEXPORT gztell OF((gzFile));
   ZEXTERN z_off_t ZEXPORT gzoffset OF((gzFile));
   ZEXTERN uLong ZEXPORT adler32_combine OF((uLong, uLong, z_off_t));
   ZEXTERN uLong ZEXPORT crc32_combine OF((uLong, uLong, z_off_t));
#endif

#else /* Z_SOLO */

   ZEXTERN uLong ZEXPORT adler32_combine OF((uLong, uLong, z_off_t));
   ZEXTERN uLong ZEXPORT crc32_combine OF((uLong, uLong, z_off_t));

#endif /* !Z_SOLO */

/* undocumented functions */
ZEXTERN const char   * ZEXPORT zError           OF((int));
ZEXTERN int            ZEXPORT inflateSyncPoint OF((z_streamp));
ZEXTERN const z_crc_t FAR * ZEXPORT get_crc_table    OF((void));
ZEXTERN int            ZEXPORT inflateUndermine OF((z_streamp, int));
ZEXTERN int            ZEXPORT inflateValidate OF((z_streamp, int));
ZEXTERN unsigned long  ZEXPORT inflateCodesUsed OF ((z_streamp));
ZEXTERN int            ZEXPORT inflateResetKeep OF((z_streamp));
ZEXTERN int            ZEXPORT deflateResetKeep OF((z_streamp));
#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(Z_SOLO)
ZEXTERN gzFile         ZEXPORT gzopen_w OF((const wchar_t *path,
                                            const char *mode));
#endif
#if defined(STDC) || defined(Z_HAVE_STDARG_H)
#  ifndef Z_SOLO
ZEXTERN int            ZEXPORTVA gzvprintf Z_ARG((gzFile file,
                                                  const char *format,
                                                  va_list va));
#  endif
#endif

#ifdef __cplusplus
}
#endif

#endif /* ZLIB_H */

Deleted compat/zlib/zlib.map.

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






























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
ZLIB_1.2.0 {
  global:
    compressBound;
    deflateBound;
    inflateBack;
    inflateBackEnd;
    inflateBackInit_;
    inflateCopy;
  local:
    deflate_copyright;
    inflate_copyright;
    inflate_fast;
    inflate_table;
    zcalloc;
    zcfree;
    z_errmsg;
    gz_error;
    gz_intmax;
    _*;
};

ZLIB_1.2.0.2 {
    gzclearerr;
    gzungetc;
    zlibCompileFlags;
} ZLIB_1.2.0;

ZLIB_1.2.0.8 {
    deflatePrime;
} ZLIB_1.2.0.2;

ZLIB_1.2.2 {
    adler32_combine;
    crc32_combine;
    deflateSetHeader;
    inflateGetHeader;
} ZLIB_1.2.0.8;

ZLIB_1.2.2.3 {
    deflateTune;
    gzdirect;
} ZLIB_1.2.2;

ZLIB_1.2.2.4 {
    inflatePrime;
} ZLIB_1.2.2.3;

ZLIB_1.2.3.3 {
    adler32_combine64;
    crc32_combine64;
    gzopen64;
    gzseek64;
    gztell64;
    inflateUndermine;
} ZLIB_1.2.2.4;

ZLIB_1.2.3.4 {
    inflateReset2;
    inflateMark;
} ZLIB_1.2.3.3;

ZLIB_1.2.3.5 {
    gzbuffer;
    gzoffset;
    gzoffset64;
    gzclose_r;
    gzclose_w;
} ZLIB_1.2.3.4;

ZLIB_1.2.5.1 {
    deflatePending;
} ZLIB_1.2.3.5;

ZLIB_1.2.5.2 {
    deflateResetKeep;
    gzgetc_;
    inflateResetKeep;
} ZLIB_1.2.5.1;

ZLIB_1.2.7.1 {
    inflateGetDictionary;
    gzvprintf;
} ZLIB_1.2.5.2;

ZLIB_1.2.9 {
    inflateCodesUsed;
    inflateValidate;
    uncompress2;
    gzfread;
    gzfwrite;
    deflateGetDictionary;
    adler32_z;
    crc32_z;
} ZLIB_1.2.7.1;

Deleted compat/zlib/zlib.pc.cmakein.

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













-
-
-
-
-
-
-
-
-
-
-
-
-
prefix=@CMAKE_INSTALL_PREFIX@
exec_prefix=@CMAKE_INSTALL_PREFIX@
libdir=@INSTALL_LIB_DIR@
sharedlibdir=@INSTALL_LIB_DIR@
includedir=@INSTALL_INC_DIR@

Name: zlib
Description: zlib compression library
Version: @VERSION@

Requires:
Libs: -L${libdir} -L${sharedlibdir} -lz
Cflags: -I${includedir}

Deleted compat/zlib/zlib.pc.in.

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













-
-
-
-
-
-
-
-
-
-
-
-
-
prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
sharedlibdir=@sharedlibdir@
includedir=@includedir@

Name: zlib
Description: zlib compression library
Version: @VERSION@

Requires:
Libs: -L${libdir} -L${sharedlibdir} -lz
Cflags: -I${includedir}

Deleted compat/zlib/zlib2ansi.

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
























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#!/usr/bin/perl

# Transform K&R C function definitions into ANSI equivalent.
#
# Author: Paul Marquess
# Version: 1.0
# Date: 3 October 2006

# TODO
#
# Asumes no function pointer parameters. unless they are typedefed.
# Assumes no literal strings that look like function definitions
# Assumes functions start at the beginning of a line

use strict;
use warnings;

local $/;
$_ = <>;

my $sp = qr{ \s* (?: /\* .*? \*/ )? \s* }x; # assume no nested comments

my $d1    = qr{ $sp (?: [\w\*\s]+ $sp)* $sp \w+ $sp [\[\]\s]* $sp }x ;
my $decl  = qr{ $sp (?: \w+ $sp )+ $d1 }xo ;
my $dList = qr{ $sp $decl (?: $sp , $d1 )* $sp ; $sp }xo ;


while (s/^
            (                  # Start $1
                (              #   Start $2
                    .*?        #     Minimal eat content
                    ( ^ \w [\w\s\*]+ )    #     $3 -- function name
                    \s*        #     optional whitespace
                )              # $2 - Matched up to before parameter list

                \( \s*         # Literal "(" + optional whitespace
                ( [^\)]+ )     # $4 - one or more anythings except ")"
                \s* \)         # optional whitespace surrounding a Literal ")"

                ( (?: $dList )+ ) # $5

                $sp ^ {        # literal "{" at start of line
            )                  # Remember to $1
        //xsom
      )
{
    my $all = $1 ;
    my $prefix = $2;
    my $param_list = $4 ;
    my $params = $5;

    StripComments($params);
    StripComments($param_list);
    $param_list =~ s/^\s+//;
    $param_list =~ s/\s+$//;

    my $i = 0 ;
    my %pList = map { $_ => $i++ }
                split /\s*,\s*/, $param_list;
    my $pMatch = '(\b' . join('|', keys %pList) . '\b)\W*$' ;

    my @params = split /\s*;\s*/, $params;
    my @outParams = ();
    foreach my $p (@params)
    {
        if ($p =~ /,/)
        {
            my @bits = split /\s*,\s*/, $p;
            my $first = shift @bits;
            $first =~ s/^\s*//;
            push @outParams, $first;
            $first =~ /^(\w+\s*)/;
            my $type = $1 ;
            push @outParams, map { $type . $_ } @bits;
        }
        else
        {
            $p =~ s/^\s+//;
            push @outParams, $p;
        }
    }


    my %tmp = map { /$pMatch/;  $_ => $pList{$1}  }
              @outParams ;

    @outParams = map  { "    $_" }
                 sort { $tmp{$a} <=> $tmp{$b} }
                 @outParams ;

    print $prefix ;
    print "(\n" . join(",\n", @outParams) . ")\n";
    print "{" ;

}

# Output any trailing code.
print ;
exit 0;


sub StripComments
{

  no warnings;

  # Strip C & C++ coments
  # From the perlfaq
  $_[0] =~

    s{
       /\*         ##  Start of /* ... */ comment
       [^*]*\*+    ##  Non-* followed by 1-or-more *'s
       (
         [^/*][^*]*\*+
       )*          ##  0-or-more things which don't start with /
                   ##    but do end with '*'
       /           ##  End of /* ... */ comment

     |         ##     OR  C++ Comment
       //          ## Start of C++ comment //
       [^\n]*      ## followed by 0-or-more non end of line characters

     |         ##     OR  various things which aren't comments:

       (
         "           ##  Start of " ... " string
         (
           \\.           ##  Escaped char
         |               ##    OR
           [^"\\]        ##  Non "\
         )*
         "           ##  End of " ... " string

       |         ##     OR

         '           ##  Start of ' ... ' string
         (
           \\.           ##  Escaped char
         |               ##    OR
           [^'\\]        ##  Non '\
         )*
         '           ##  End of ' ... ' string

       |         ##     OR

         .           ##  Anything other char
         [^/"'\\]*   ##  Chars which doesn't start a comment, string or escape
       )
     }{$2}gxs;

}

Deleted compat/zlib/zutil.c.

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





































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zutil.c -- target dependent utility functions for the compression library
 * Copyright (C) 1995-2017 Jean-loup Gailly
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* @(#) $Id$ */

#include "zutil.h"
#ifndef Z_SOLO
#  include "gzguts.h"
#endif

z_const char * const z_errmsg[10] = {
    (z_const char *)"need dictionary",     /* Z_NEED_DICT       2  */
    (z_const char *)"stream end",          /* Z_STREAM_END      1  */
    (z_const char *)"",                    /* Z_OK              0  */
    (z_const char *)"file error",          /* Z_ERRNO         (-1) */
    (z_const char *)"stream error",        /* Z_STREAM_ERROR  (-2) */
    (z_const char *)"data error",          /* Z_DATA_ERROR    (-3) */
    (z_const char *)"insufficient memory", /* Z_MEM_ERROR     (-4) */
    (z_const char *)"buffer error",        /* Z_BUF_ERROR     (-5) */
    (z_const char *)"incompatible version",/* Z_VERSION_ERROR (-6) */
    (z_const char *)""
};


const char * ZEXPORT zlibVersion()
{
    return ZLIB_VERSION;
}

uLong ZEXPORT zlibCompileFlags()
{
    uLong flags;

    flags = 0;
    switch ((int)(sizeof(uInt))) {
    case 2:     break;
    case 4:     flags += 1;     break;
    case 8:     flags += 2;     break;
    default:    flags += 3;
    }
    switch ((int)(sizeof(uLong))) {
    case 2:     break;
    case 4:     flags += 1 << 2;        break;
    case 8:     flags += 2 << 2;        break;
    default:    flags += 3 << 2;
    }
    switch ((int)(sizeof(voidpf))) {
    case 2:     break;
    case 4:     flags += 1 << 4;        break;
    case 8:     flags += 2 << 4;        break;
    default:    flags += 3 << 4;
    }
    switch ((int)(sizeof(z_off_t))) {
    case 2:     break;
    case 4:     flags += 1 << 6;        break;
    case 8:     flags += 2 << 6;        break;
    default:    flags += 3 << 6;
    }
#ifdef ZLIB_DEBUG
    flags += 1 << 8;
#endif
#if defined(ASMV) || defined(ASMINF)
    flags += 1 << 9;
#endif
#ifdef ZLIB_WINAPI
    flags += 1 << 10;
#endif
#ifdef BUILDFIXED
    flags += 1 << 12;
#endif
#ifdef DYNAMIC_CRC_TABLE
    flags += 1 << 13;
#endif
#ifdef NO_GZCOMPRESS
    flags += 1L << 16;
#endif
#ifdef NO_GZIP
    flags += 1L << 17;
#endif
#ifdef PKZIP_BUG_WORKAROUND
    flags += 1L << 20;
#endif
#ifdef FASTEST
    flags += 1L << 21;
#endif
#if defined(STDC) || defined(Z_HAVE_STDARG_H)
#  ifdef NO_vsnprintf
    flags += 1L << 25;
#    ifdef HAS_vsprintf_void
    flags += 1L << 26;
#    endif
#  else
#    ifdef HAS_vsnprintf_void
    flags += 1L << 26;
#    endif
#  endif
#else
    flags += 1L << 24;
#  ifdef NO_snprintf
    flags += 1L << 25;
#    ifdef HAS_sprintf_void
    flags += 1L << 26;
#    endif
#  else
#    ifdef HAS_snprintf_void
    flags += 1L << 26;
#    endif
#  endif
#endif
    return flags;
}

#ifdef ZLIB_DEBUG
#include <stdlib.h>
#  ifndef verbose
#    define verbose 0
#  endif
int ZLIB_INTERNAL z_verbose = verbose;

void ZLIB_INTERNAL z_error (m)
    char *m;
{
    fprintf(stderr, "%s\n", m);
    exit(1);
}
#endif

/* exported to allow conversion of error code to string for compress() and
 * uncompress()
 */
const char * ZEXPORT zError(err)
    int err;
{
    return ERR_MSG(err);
}

#if defined(_WIN32_WCE)
    /* The Microsoft C Run-Time Library for Windows CE doesn't have
     * errno.  We define it as a global variable to simplify porting.
     * Its value is always 0 and should not be used.
     */
    int errno = 0;
#endif

#ifndef HAVE_MEMCPY

void ZLIB_INTERNAL zmemcpy(dest, source, len)
    Bytef* dest;
    const Bytef* source;
    uInt  len;
{
    if (len == 0) return;
    do {
        *dest++ = *source++; /* ??? to be unrolled */
    } while (--len != 0);
}

int ZLIB_INTERNAL zmemcmp(s1, s2, len)
    const Bytef* s1;
    const Bytef* s2;
    uInt  len;
{
    uInt j;

    for (j = 0; j < len; j++) {
        if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1;
    }
    return 0;
}

void ZLIB_INTERNAL zmemzero(dest, len)
    Bytef* dest;
    uInt  len;
{
    if (len == 0) return;
    do {
        *dest++ = 0;  /* ??? to be unrolled */
    } while (--len != 0);
}
#endif

#ifndef Z_SOLO

#ifdef SYS16BIT

#ifdef __TURBOC__
/* Turbo C in 16-bit mode */

#  define MY_ZCALLOC

/* Turbo C malloc() does not allow dynamic allocation of 64K bytes
 * and farmalloc(64K) returns a pointer with an offset of 8, so we
 * must fix the pointer. Warning: the pointer must be put back to its
 * original form in order to free it, use zcfree().
 */

#define MAX_PTR 10
/* 10*64K = 640K */

local int next_ptr = 0;

typedef struct ptr_table_s {
    voidpf org_ptr;
    voidpf new_ptr;
} ptr_table;

local ptr_table table[MAX_PTR];
/* This table is used to remember the original form of pointers
 * to large buffers (64K). Such pointers are normalized with a zero offset.
 * Since MSDOS is not a preemptive multitasking OS, this table is not
 * protected from concurrent access. This hack doesn't work anyway on
 * a protected system like OS/2. Use Microsoft C instead.
 */

voidpf ZLIB_INTERNAL zcalloc (voidpf opaque, unsigned items, unsigned size)
{
    voidpf buf;
    ulg bsize = (ulg)items*size;

    (void)opaque;

    /* If we allocate less than 65520 bytes, we assume that farmalloc
     * will return a usable pointer which doesn't have to be normalized.
     */
    if (bsize < 65520L) {
        buf = farmalloc(bsize);
        if (*(ush*)&buf != 0) return buf;
    } else {
        buf = farmalloc(bsize + 16L);
    }
    if (buf == NULL || next_ptr >= MAX_PTR) return NULL;
    table[next_ptr].org_ptr = buf;

    /* Normalize the pointer to seg:0 */
    *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4;
    *(ush*)&buf = 0;
    table[next_ptr++].new_ptr = buf;
    return buf;
}

void ZLIB_INTERNAL zcfree (voidpf opaque, voidpf ptr)
{
    int n;

    (void)opaque;

    if (*(ush*)&ptr != 0) { /* object < 64K */
        farfree(ptr);
        return;
    }
    /* Find the original pointer */
    for (n = 0; n < next_ptr; n++) {
        if (ptr != table[n].new_ptr) continue;

        farfree(table[n].org_ptr);
        while (++n < next_ptr) {
            table[n-1] = table[n];
        }
        next_ptr--;
        return;
    }
    Assert(0, "zcfree: ptr not found");
}

#endif /* __TURBOC__ */


#ifdef M_I86
/* Microsoft C in 16-bit mode */

#  define MY_ZCALLOC

#if (!defined(_MSC_VER) || (_MSC_VER <= 600))
#  define _halloc  halloc
#  define _hfree   hfree
#endif

voidpf ZLIB_INTERNAL zcalloc (voidpf opaque, uInt items, uInt size)
{
    (void)opaque;
    return _halloc((long)items, size);
}

void ZLIB_INTERNAL zcfree (voidpf opaque, voidpf ptr)
{
    (void)opaque;
    _hfree(ptr);
}

#endif /* M_I86 */

#endif /* SYS16BIT */


#ifndef MY_ZCALLOC /* Any system without a special alloc function */

#ifndef STDC
extern voidp  malloc OF((uInt size));
extern voidp  calloc OF((uInt items, uInt size));
extern void   free   OF((voidpf ptr));
#endif

voidpf ZLIB_INTERNAL zcalloc (opaque, items, size)
    voidpf opaque;
    unsigned items;
    unsigned size;
{
    (void)opaque;
    return sizeof(uInt) > 2 ? (voidpf)malloc(items * size) :
                              (voidpf)calloc(items, size);
}

void ZLIB_INTERNAL zcfree (opaque, ptr)
    voidpf opaque;
    voidpf ptr;
{
    (void)opaque;
    free(ptr);
}

#endif /* MY_ZCALLOC */

#endif /* !Z_SOLO */

Deleted compat/zlib/zutil.h.

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















































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* zutil.h -- internal interface and configuration of the compression library
 * Copyright (C) 1995-2016 Jean-loup Gailly, Mark Adler
 * For conditions of distribution and use, see copyright notice in zlib.h
 */

/* WARNING: this file should *not* be used by applications. It is
   part of the implementation of the compression library and is
   subject to change. Applications should only use zlib.h.
 */

/* @(#) $Id$ */

#ifndef ZUTIL_H
#define ZUTIL_H

#ifdef HAVE_HIDDEN
#  define ZLIB_INTERNAL __attribute__((visibility ("hidden")))
#else
#  define ZLIB_INTERNAL
#endif

#include "zlib.h"

#if defined(STDC) && !defined(Z_SOLO)
#  if !(defined(_WIN32_WCE) && defined(_MSC_VER))
#    include <stddef.h>
#  endif
#  include <string.h>
#  include <stdlib.h>
#endif

#ifdef Z_SOLO
   typedef long ptrdiff_t;  /* guess -- will be caught if guess is wrong */
#endif

#ifndef local
#  define local static
#endif
/* since "static" is used to mean two completely different things in C, we
   define "local" for the non-static meaning of "static", for readability
   (compile with -Dlocal if your debugger can't find static symbols) */

typedef unsigned char  uch;
typedef uch FAR uchf;
typedef unsigned short ush;
typedef ush FAR ushf;
typedef unsigned long  ulg;

extern z_const char * const z_errmsg[10]; /* indexed by 2-zlib_error */
/* (size given to avoid silly warnings with Visual C++) */

#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)]

#define ERR_RETURN(strm,err) \
  return (strm->msg = ERR_MSG(err), (err))
/* To be used only when the state is known to be valid */

        /* common constants */

#ifndef DEF_WBITS
#  define DEF_WBITS MAX_WBITS
#endif
/* default windowBits for decompression. MAX_WBITS is for compression only */

#if MAX_MEM_LEVEL >= 8
#  define DEF_MEM_LEVEL 8
#else
#  define DEF_MEM_LEVEL  MAX_MEM_LEVEL
#endif
/* default memLevel */

#define STORED_BLOCK 0
#define STATIC_TREES 1
#define DYN_TREES    2
/* The three kinds of block type */

#define MIN_MATCH  3
#define MAX_MATCH  258
/* The minimum and maximum match lengths */

#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */

        /* target dependencies */

#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32))
#  define OS_CODE  0x00
#  ifndef Z_SOLO
#    if defined(__TURBOC__) || defined(__BORLANDC__)
#      if (__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__))
         /* Allow compilation with ANSI keywords only enabled */
         void _Cdecl farfree( void *block );
         void *_Cdecl farmalloc( unsigned long nbytes );
#      else
#        include <alloc.h>
#      endif
#    else /* MSC or DJGPP */
#      include <malloc.h>
#    endif
#  endif
#endif

#ifdef AMIGA
#  define OS_CODE  1
#endif

#if defined(VAXC) || defined(VMS)
#  define OS_CODE  2
#  define F_OPEN(name, mode) \
     fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512")
#endif

#ifdef __370__
#  if __TARGET_LIB__ < 0x20000000
#    define OS_CODE 4
#  elif __TARGET_LIB__ < 0x40000000
#    define OS_CODE 11
#  else
#    define OS_CODE 8
#  endif
#endif

#if defined(ATARI) || defined(atarist)
#  define OS_CODE  5
#endif

#ifdef OS2
#  define OS_CODE  6
#  if defined(M_I86) && !defined(Z_SOLO)
#    include <malloc.h>
#  endif
#endif

#if defined(MACOS) || defined(TARGET_OS_MAC)
#  define OS_CODE  7
#  ifndef Z_SOLO
#    if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os
#      include <unix.h> /* for fdopen */
#    else
#      ifndef fdopen
#        define fdopen(fd,mode) NULL /* No fdopen() */
#      endif
#    endif
#  endif
#endif

#ifdef __acorn
#  define OS_CODE 13
#endif

#if defined(WIN32) && !defined(__CYGWIN__)
#  define OS_CODE  10
#endif

#ifdef _BEOS_
#  define OS_CODE  16
#endif

#ifdef __TOS_OS400__
#  define OS_CODE 18
#endif

#ifdef __APPLE__
#  define OS_CODE 19
#endif

#if defined(_BEOS_) || defined(RISCOS)
#  define fdopen(fd,mode) NULL /* No fdopen() */
#endif

#if (defined(_MSC_VER) && (_MSC_VER > 600)) && !defined __INTERIX
#  if defined(_WIN32_WCE)
#    define fdopen(fd,mode) NULL /* No fdopen() */
#    ifndef _PTRDIFF_T_DEFINED
       typedef int ptrdiff_t;
#      define _PTRDIFF_T_DEFINED
#    endif
#  else
#    define fdopen(fd,type)  _fdopen(fd,type)
#  endif
#endif

#if defined(__BORLANDC__) && !defined(MSDOS)
  #pragma warn -8004
  #pragma warn -8008
  #pragma warn -8066
#endif

/* provide prototypes for these when building zlib without LFS */
#if !defined(_WIN32) && \
    (!defined(_LARGEFILE64_SOURCE) || _LFS64_LARGEFILE-0 == 0)
    ZEXTERN uLong ZEXPORT adler32_combine64 OF((uLong, uLong, z_off_t));
    ZEXTERN uLong ZEXPORT crc32_combine64 OF((uLong, uLong, z_off_t));
#endif

        /* common defaults */

#ifndef OS_CODE
#  define OS_CODE  3     /* assume Unix */
#endif

#ifndef F_OPEN
#  define F_OPEN(name, mode) fopen((name), (mode))
#endif

         /* functions */

#if defined(pyr) || defined(Z_SOLO)
#  define NO_MEMCPY
#endif
#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__)
 /* Use our own functions for small and medium model with MSC <= 5.0.
  * You may have to use the same strategy for Borland C (untested).
  * The __SC__ check is for Symantec.
  */
#  define NO_MEMCPY
#endif
#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY)
#  define HAVE_MEMCPY
#endif
#ifdef HAVE_MEMCPY
#  ifdef SMALL_MEDIUM /* MSDOS small or medium model */
#    define zmemcpy _fmemcpy
#    define zmemcmp _fmemcmp
#    define zmemzero(dest, len) _fmemset(dest, 0, len)
#  else
#    define zmemcpy memcpy
#    define zmemcmp memcmp
#    define zmemzero(dest, len) memset(dest, 0, len)
#  endif
#else
   void ZLIB_INTERNAL zmemcpy OF((Bytef* dest, const Bytef* source, uInt len));
   int ZLIB_INTERNAL zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len));
   void ZLIB_INTERNAL zmemzero OF((Bytef* dest, uInt len));
#endif

/* Diagnostic functions */
#ifdef ZLIB_DEBUG
#  include <stdio.h>
   extern int ZLIB_INTERNAL z_verbose;
   extern void ZLIB_INTERNAL z_error OF((char *m));
#  define Assert(cond,msg) {if(!(cond)) z_error(msg);}
#  define Trace(x) {if (z_verbose>=0) fprintf x ;}
#  define Tracev(x) {if (z_verbose>0) fprintf x ;}
#  define Tracevv(x) {if (z_verbose>1) fprintf x ;}
#  define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;}
#  define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;}
#else
#  define Assert(cond,msg)
#  define Trace(x)
#  define Tracev(x)
#  define Tracevv(x)
#  define Tracec(c,x)
#  define Tracecv(c,x)
#endif

#ifndef Z_SOLO
   voidpf ZLIB_INTERNAL zcalloc OF((voidpf opaque, unsigned items,
                                    unsigned size));
   void ZLIB_INTERNAL zcfree  OF((voidpf opaque, voidpf ptr));
#endif

#define ZALLOC(strm, items, size) \
           (*((strm)->zalloc))((strm)->opaque, (items), (size))
#define ZFREE(strm, addr)  (*((strm)->zfree))((strm)->opaque, (voidpf)(addr))
#define TRY_FREE(s, p) {if (p) ZFREE(s, p);}

/* Reverse the bytes in a 32-bit value */
#define ZSWAP32(q) ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \
                    (((q) & 0xff00) << 8) + (((q) & 0xff) << 24))

#endif /* ZUTIL_H */

Changes to doc/Access.3.

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
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






-
+



















-
-
-
-
+
+
+
+



+


-
-
-
+
+
+
-
-

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

-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

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

-
-
+
+
+
+


-
+
-
'\"
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Access 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Access, Tcl_Stat \- check file permissions and other attributes
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_Access\fR(\fIpath\fR, \fImode\fR)
.sp
int
\fBTcl_Stat\fR(\fIpath\fR, \fIstatPtr\fR)
.SH ARGUMENTS
.AS "struct stat" *statPtr out
.AP char *path in
Native name of the file to check the attributes of.
.AP int mode in
Mask consisting of one or more of \fBR_OK\fR, \fBW_OK\fR, \fBX_OK\fR and
\fBF_OK\fR. \fBR_OK\fR, \fBW_OK\fR and \fBX_OK\fR request checking whether the
file exists and has read, write and execute permissions, respectively.
\fBF_OK\fR just requests a check for the existence of the file.
Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK.  R_OK,
W_OK and X_OK request checking whether the file exists and  has  read,
write and  execute  permissions, respectively.  F_OK just requests
checking for the existence of the file.
.AP "struct stat" *statPtr out
The structure that contains the result.
.BE

.SH DESCRIPTION
.PP
As of Tcl 8.4, the object-based APIs \fBTcl_FSAccess\fR and \fBTcl_FSStat\fR
should be used in preference to \fBTcl_Access\fR and \fBTcl_Stat\fR, wherever
possible. Those functions also support Tcl's virtual filesystem layer, which
As of Tcl 8.4, the object-based APIs \fBTcl_FSAccess\fR and
\fBTcl_FSStat\fR should be used in preference to \fBTcl_Access\fR and
\fBTcl_Stat\fR, wherever possible.
these do not.
.SS "OBSOLETE FUNCTIONS"
.PP
There are two reasons for calling \fBTcl_Access\fR and \fBTcl_Stat\fR rather
than calling system level functions \fBaccess\fR and \fBstat\fR directly.
First, the Windows implementation of both functions fixes some bugs in the
system level calls. Second, both \fBTcl_Access\fR and \fBTcl_Stat\fR (as well
as \fBTcl_OpenFileChannelProc\fR) hook into a linked list of functions. This
allows the possibility to reroute file access to alternative media or access
methods.
There are two reasons for calling \fBTcl_Access\fR and \fBTcl_Stat\fR
rather than calling system level functions \fBaccess\fR and \fBstat\fR
directly.  First, the Windows implementation of both functions fixes
some bugs in the system level calls.  Second, both \fBTcl_Access\fR
and \fBTcl_Stat\fR (as well as \fBTcl_OpenFileChannelProc\fR) hook
into a linked list of functions.  This allows the possibility to reroute
file access to alternative media or access methods.
.PP
\fBTcl_Access\fR checks whether the process would be allowed to read, write or
test for existence of the file (or other file system object) whose name is
\fIpath\fR. If \fIpath\fR is a symbolic link on Unix, then permissions of the
file referred by this symbolic link are tested.
\fBTcl_Access\fR checks whether the process would be allowed to read,
write or test for existence of the file (or other file system object)
whose name is pathname.   If pathname is a symbolic link on Unix,
then permissions of the file referred by this symbolic link are
tested.
.PP
On success (all requested permissions granted), zero is returned. On error (at
least one bit in mode asked for a permission that is denied, or some other
error occurred), -1 is returned.
On success (all requested permissions granted), zero is returned.  On
error (at least one bit in mode asked for a permission that is denied,
or some other  error occurred), -1 is returned.
.PP
\fBTcl_Stat\fR fills the stat structure \fIstatPtr\fR with information about
the specified file. You do not need any access rights to the file to get this
information but you need search rights to all directories named in the path
leading to the file. The stat structure includes info regarding device, inode
(always 0 on Windows), privilege mode, nlink (always 1 on Windows), user id
(always 0 on Windows), group id (always 0 on Windows), rdev (same as device on
Windows), size, last access time, last modification time, and creation time.
\fBTcl_Stat\fR fills the stat structure \fIstatPtr\fR with information
about the specified file.  You do not need any access rights to the
file to get this information but you need search rights to all
directories named in the path leading to the file.  The stat structure
includes info regarding device, inode (always 0 on Windows),
privilege mode, nlink (always 1 on Windows), user id (always 0 on
Windows), group id (always 0 on Windows), rdev (same as device on
Windows), size, last access time, last modification time, and creation
time.
.PP
If \fIpath\fR exists, \fBTcl_Stat\fR returns 0 and the stat structure is
filled with data. Otherwise, -1 is returned, and no stat info is given.
If \fIpath\fR exists, \fBTcl_Stat\fR returns 0 and the stat structure
is filled with data.  Otherwise, -1 is returned, and no stat info is
given.

.SH KEYWORDS
stat, access
.SH "SEE ALSO"

Tcl_FSAccess(3), Tcl_FSStat(3)

Changes to doc/AddErrInfo.3.

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
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






-
+




-
+



+




-
+

+


+


+







-
-
-
+










-
+











+



+
-
+


-
+








-
-







+


+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_AddErrorInfo 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorLine, Tcl_GetErrorLine, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
Tcl_GetReturnOptions, Tcl_SetReturnOptions, Tcl_AddErrorInfo, Tcl_AppendObjToErrorInfo, Tcl_AddObjErrorInfo, Tcl_SetObjErrorCode, Tcl_SetErrorCode, Tcl_SetErrorCodeVA, Tcl_PosixError, Tcl_LogCommandInfo \- retrieve or record information about errors and other return options
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.VS 8.5
.sp
Tcl_Obj *
\fBTcl_GetReturnOptions\fR(\fIinterp, code\fR)
.sp
int
int 
\fBTcl_SetReturnOptions\fR(\fIinterp, options\fR)
.VE 8.5
.sp
\fBTcl_AddErrorInfo\fR(\fIinterp, message\fR)
.VS 8.5
.sp
\fBTcl_AppendObjToErrorInfo\fR(\fIinterp, objPtr\fR)
.VE 8.5
.sp
\fBTcl_AddObjErrorInfo\fR(\fIinterp, message, length\fR)
.sp
\fBTcl_SetObjErrorCode\fR(\fIinterp, errorObjPtr\fR)
.sp
\fBTcl_SetErrorCode\fR(\fIinterp, element, element, ... \fB(char *) NULL\fR)
.sp
\fBTcl_GetErrorLine\fR(\fIinterp\fR)
.sp
\fBTcl_SetErrorLine\fR(\fIinterp, lineNum\fR)
\fBTcl_SetErrorCodeVA\fR(\fIinterp, argList\fR)
.sp
const char *
\fBTcl_PosixError\fR(\fIinterp\fR)
.sp
void
\fBTcl_LogCommandInfo\fR(\fIinterp, script, command, commandLength\fR)
.SH ARGUMENTS
.AS Tcl_Interp commandLength
.AP Tcl_Interp *interp in
Interpreter in which to record information.
.AP int code
.AP int code 
The code returned from script evaluation.
.AP Tcl_Obj *options
A dictionary of return options.
.AP char *message in
For \fBTcl_AddErrorInfo\fR,
this is a conventional C string to append to the \fB\-errorinfo\fR return option.
For \fBTcl_AddObjErrorInfo\fR,
this points to the first byte of an array of \fIlength\fR bytes
containing a string to append to the \fB\-errorinfo\fR return option.
This byte array may contain embedded null bytes
unless \fIlength\fR is negative.
.VS 8.5
.AP Tcl_Obj *objPtr in
A message to be appended to the \fB\-errorinfo\fR return option
in the form of a Tcl_Obj value.
.VE 8.5
.AP size_t length in
.AP int length in
The number of bytes to copy from \fImessage\fR when
appending to the \fB\-errorinfo\fR return option.
If TCL_INDEX_NONE, all bytes up to the first null byte are used.
If negative, all bytes up to the first null byte are used.
.AP Tcl_Obj *errorObjPtr in
The \fB\-errorcode\fR return option will be set to this value.
.AP char *element in
String to record as one element of the \fB\-errorcode\fR return option.
Last \fIelement\fR argument must be NULL.
.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 lineNum
The line number of a script where an error occurred.
.AP "const char" *script in
Pointer to first character in script containing command (must be <= command)
.AP "const char" *command in
Pointer to first character in command that generated the error
.AP int commandLength in
Number of bytes in command; -1 means use all bytes up to first null byte
.BE

.SH DESCRIPTION
.PP
.VS 8.5
The \fBTcl_SetReturnOptions\fR and \fBTcl_GetReturnOptions\fR
routines expose the same capabilities as the \fBreturn\fR and
\fBcatch\fR commands, respectively, in the form of a C interface.
.PP
\fBTcl_GetReturnOptions\fR retrieves the dictionary of return options
from an interpreter following a script evaluation.
Routines such as \fBTcl_Eval\fR are called to evaluate a
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
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







-
+
-
-
-
-
-




-

-
+

-
+






-














-





-
+

-











-
+


-
+
-
-
-
-
+
-
+




-
+



-
+


-
-
-
+
+
+







\fB\-errorcode\fR, and \fB\-errorline\fR will appear in the
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 value.
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_EvalEx(interp, script, -1, 0);
int code = Tcl_Eval(interp, script);
if (code == TCL_ERROR) {
    Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);
    Tcl_Obj *options = Tcl_GetReturnOptions(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
appropriate error message.  Otherwise, a completion code
in agreement with the \fB\-code\fR and \fB\-level\fR
keys in \fIoptions\fR will be returned.
.PP
As an example, Tcl's \fBreturn\fR command itself could
be implemented in terms of \fBTcl_SetReturnOptions\fR
like so:
.PP
.CS
if ((objc % 2) == 0) { /* explicit result argument */
    objc--;
    Tcl_SetObjResult(interp, objv[objc]);
}
return \fBTcl_SetReturnOptions\fR(interp, Tcl_NewListObj(objc-1, objv+1));
return Tcl_SetReturnOptions(interp, Tcl_NewListObj(objc-1, objv+1));
.CE
.PP
(It is not really implemented that way.  Internal access
privileges allow for a more efficient alternative that meshes
better with the bytecode compiler.)
.PP
Note that a newly created \fBTcl_Obj\fR may be passed
in as the \fIoptions\fR argument without the need to tend
to any reference counting.  This is analogous to
\fBTcl_SetObjResult\fR.
.PP
While \fBTcl_SetReturnOptions\fR provides a general interface
to set any collection of return options, there are a handful
of return options that are very frequently used.  Most
of return options that are very frequently used.  Most 
notably the \fB\-errorinfo\fR and \fB\-errorcode\fR return
options should be set properly when the command procedure
of a command returns \fBTCL_ERROR\fR.  The \fB\-errorline\fR
of a command returns \fBTCL_ERROR\fR.  Tcl provides several
return option is also read by commands that evaluate scripts
and wish to supply detailed error location information in
the stack trace text they append to the \fB\-errorinfo\fR option.
Tcl provides several simpler interfaces to more directly set
simpler interfaces to more directly set these return options.
these return options.
.VE 8.5
.PP
The \fB\-errorinfo\fR option holds a stack trace of the
operations that were in progress when an error occurred,
and is intended to be human-readable.
The \fB\-errorcode\fR option holds a Tcl list of items that
The \fB\-errorcode\fR option holds a list of items that
are intended to be machine-readable.
The first item in the \fB\-errorcode\fR value identifies the class of
error that occurred
(e.g., POSIX means an error occurred in a POSIX system call)
(e.g. POSIX means an error occurred in a POSIX system call)
and additional elements hold additional pieces
of information that depend on the class.
See the manual entry on the \fBerrorCode\fR variable for details on the
various formats for the \fB\-errorcode\fR option used by Tcl's built-in
commands.
See the tclvars manual entry for details on the various
formats for the \fB\-errorcode\fR option used by
Tcl's built-in commands.
.PP
The \fB\-errorinfo\fR option value is gradually built up as an
error unwinds through the nested operations.
Each time an error code is returned to \fBTcl_Eval\fR, or
any of the routines that performs script evaluation,
the procedure \fBTcl_AddErrorInfo\fR is called to add
additional text to the \fB\-errorinfo\fR value describing the
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
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







+




+



-
+







-
-
-
+
+
+







-
+


-
-
-
+
-
+







within the procedure are recorded, and so on.
The best time to call \fBTcl_AddErrorInfo\fR is just after
a script evaluation routine has returned \fBTCL_ERROR\fR.
The value of the \fB\-errorline\fR return option (retrieved
via a call to \fBTcl_GetReturnOptions\fR) often makes up
a useful part of the \fImessage\fR passed to \fBTcl_AddErrorInfo\fR.
.PP
.VS 8.5
\fBTcl_AppendObjToErrorInfo\fR is an alternative interface to the
same functionality as \fBTcl_AddErrorInfo\fR.  \fBTcl_AppendObjToErrorInfo\fR
is called when the string value to be appended to the \fB\-errorinfo\fR option
is available as a \fBTcl_Obj\fR instead of as a \fBchar\fR array.
.VE 8.5
.PP
\fBTcl_AddObjErrorInfo\fR is nearly identical
to \fBTcl_AddErrorInfo\fR, except that it has an additional \fIlength\fR
argument.  This allows the \fImessage\fR string to contain
argument.  This allows the \fImessage\fR string to contain 
embedded null bytes.  This is essentially never a good idea.
If the \fImessage\fR needs to contain the null character \fBU+0000\fR,
Tcl's usual internal encoding rules should be used to avoid
the need for a null byte.  If the \fBTcl_AddObjErrorInfo\fR
interface is used at all, it should be with a negative \fIlength\fR value.
.PP
The procedure \fBTcl_SetObjErrorCode\fR is used to set the
\fB\-errorcode\fR return option to the list value \fIerrorObjPtr\fR
built up by the caller.
\fBTcl_SetObjErrorCode\fR is typically invoked just
\fB\-errorcode\fR return option to the list object \fIerrorObjPtr\fR 
built up by the caller. 
\fBTcl_SetObjErrorCode\fR is typically invoked just 
before returning an error. If an error is
returned without calling \fBTcl_SetObjErrorCode\fR or
\fBTcl_SetErrorCode\fR the Tcl interpreter automatically sets
the \fB\-errorcode\fR return option to \fBNONE\fR.
.PP
The procedure \fBTcl_SetErrorCode\fR is also used to set the
\fB\-errorcode\fR return option. However, it takes one or more strings to
record instead of a value. Otherwise, it is similar to
record instead of an object. Otherwise, it is similar to
\fBTcl_SetObjErrorCode\fR in behavior.
.PP
The procedure \fBTcl_GetErrorLine\fR is used to read the integer value
of the \fB\-errorline\fR return option without the overhead of a full
call to \fBTcl_GetReturnOptions\fR.  Likewise, \fBTcl_SetErrorLine\fR
\fBTcl_SetErrorCodeVA\fR is the same as \fBTcl_SetErrorCode\fR except that
sets the \fB\-errorline\fR return option value.
instead of taking a variable number of arguments it takes an argument list.
.PP
\fBTcl_PosixError\fR
sets the \fB\-errorcode\fR variable after an error in a POSIX kernel call.
It reads the value of the \fBerrno\fR C variable and calls
\fBTcl_SetErrorCode\fR to set the \fB\-errorcode\fR return
option in the \fBPOSIX\fR format.
The caller must previously have called \fBTcl_SetErrno\fR to set
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

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







-
+












-
+








-
+







+

-
-
+
+

-
+
It may be convenient to include this string as part of the
error message returned to the application in
the interpreter's result.
.PP
\fBTcl_LogCommandInfo\fR is invoked after an error occurs in an
interpreter.  It adds information about the command that was being
executed when the error occurred to the \fB\-errorinfo\fR value, and
the line number stored internally in the interpreter is set.
the line number stored internally in the interpreter is set.  
.PP
In older releases of Tcl, there was no \fBTcl_GetReturnOptions\fR
routine.  In its place, the global Tcl variables \fBerrorInfo\fR
and \fBerrorCode\fR were the only place to retrieve the error
information.  Much existing code written for older Tcl releases
still access this information via those global variables.
.PP
It is important to realize that while reading from those
global variables remains a supported way to access these
return option values, it is important not to assume that
writing to those global variables will properly set the
corresponding return options.  It has long been emphasized
in this manual page that it is important to
in this manual page that it is important to 
call the procedures described here rather than
setting \fBerrorInfo\fR or \fBerrorCode\fR directly with
\fBTcl_ObjSetVar2\fR.
.PP
If the procedure \fBTcl_ResetResult\fR is called,
it clears all of the state of the interpreter associated with
script evaluation, including the entire return options dictionary.
In particular, the \fB\-errorinfo\fR and \fB\-errorcode\fR options
are reset.
are reset.  
If an error had occurred, the \fBTcl_ResetResult\fR call will
clear the error state to make it appear as if no error had
occurred after all.
The global variables \fBerrorInfo\fR and
\fBerrorCode\fR are not modified by \fBTcl_ResetResult\fR
so they continue to hold a record of information about the
most recent error seen in an interpreter.

.SH "SEE ALSO"
Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_Interp(3), Tcl_ResetResult(3),
Tcl_SetErrno(3), errorCode(n), errorInfo(n)
Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_Interp, Tcl_ResetResult, Tcl_SetErrno

.SH KEYWORDS
error, value, value result, stack, trace, variable
error, object, object result, stack, trace, variable

Changes to doc/Alloc.3.

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
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










-
+










-
+


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

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






+
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Alloc 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc \- allocate or free heap memory
Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
char *
\fBTcl_Alloc\fR(\fIsize\fR)
.sp
void
\fBTcl_Free\fR(\fIptr\fR)
.sp
void *
char *
\fBTcl_Realloc\fR(\fIptr, size\fR)
.sp
char *
\fBTcl_AttemptAlloc\fR(\fIsize\fR)
.sp
char *
\fBTcl_AttemptRealloc\fR(\fIptr, size\fR)
.sp
void *
\fBTcl_AttemptAlloc\fR(\fIsize\fR)
void
\fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR)
.sp
char *
\fBckalloc\fR(\fIsize\fR)
.sp
void *
\fBTcl_AttemptRealloc\fR(\fIptr, size\fR)
void
\fBckfree\fR(\fIptr\fR)
.sp
char *
\fBckrealloc\fR(\fIptr, size\fR)
.sp
char *
\fBattemptckalloc\fR(\fIsize\fR)
.sp
char *
\fBattemptckrealloc\fR(\fIptr, size\fR)
.SH ARGUMENTS
.AS char *size
.AP "unsigned int" size in
Size in bytes of the memory block to allocate.
.AP char *ptr in
Pointer to memory block to free or realloc.
.AP Tcl_DString *dsPtr in
Initialized DString pointer.
.BE

.SH DESCRIPTION
.PP
These procedures provide a platform and compiler independent interface
for memory allocation.  Programs that need to transfer ownership of
memory blocks between Tcl and other modules should use these routines
60
61
62
63
64
65
66




67
68
69
70








71
72
73
80
81
82
83
84
85
86
87
88
89
90




91
92
93
94
95
96
97
98
99
100
101







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



function to \fBTcl_Alloc\fR and \fBTcl_Realloc\fR, except that
\fBTcl_AttemptAlloc\fR and \fBTcl_AttemptRealloc\fR will not cause the Tcl
interpreter to \fBpanic\fR if the memory allocation fails.  If the
allocation fails, these functions will return NULL.  Note that on some
platforms, but not all, attempting to allocate a zero-sized block of
memory will also cause these functions to return NULL.
.PP
The procedures \fBckalloc\fR, \fBckfree\fR, \fBckrealloc\fR,
\fBattemptckalloc\fR, and \fBattemptckrealloc\fR are implemented
as macros.  Normally, they are synonyms for the corresponding
procedures documented on this page.  When Tcl and all modules
When a module or Tcl itself is compiled with \fBTCL_MEM_DEBUG\fR defined,
the procedures \fBTcl_Alloc\fR, \fBTcl_Free\fR, \fBTcl_Realloc\fR,
\fBTcl_AttemptAlloc\fR, and \fBTcl_AttempRealloc\fR are implemented
as macros, redefined to be special debugging versions of these procedures.
calling Tcl are compiled with \fBTCL_MEM_DEBUG\fR defined, however,
these macros are redefined to be special debugging versions
of these procedures.  To support Tcl's memory debugging within a
module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc.

\fBTcl_GetMemoryInfo\fR appends a list-of-lists of memory stats to the
provided DString. This function cannot be used in stub-enabled extensions,
and it is only available if Tcl is compiled with the threaded memory allocator.

.SH KEYWORDS
alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG

Changes to doc/AllowExc.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_AllowExceptions 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_AllowExceptions \- allow all exceptions in next script evaluation
.SH SYNOPSIS
.nf
26
27
28
29
30
31
32
33


34
35
36
37
38
39
40
41
42
43
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41
42
43
44







-
+
+










If a script is evaluated at top-level (i.e. no other scripts are
pending evaluation when the script is invoked), and if the script
terminates with a completion code other than \fBTCL_OK\fR, \fBTCL_ERROR\fR
or \fBTCL_RETURN\fR, then Tcl normally converts this into a \fBTCL_ERROR\fR
return with an appropriate message.  The particular script
evaluation procedures of Tcl that act in the manner are
\fBTcl_EvalObjEx\fR, \fBTcl_EvalObjv\fR, \fBTcl_Eval\fR, \fBTcl_EvalEx\fR,
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR and \fBTcl_VarEval\fR.
\fBTcl_GlobalEval\fR, \fBTcl_GlobalEvalObj\fR, \fBTcl_VarEval\fR and
\fBTcl_VarEvalVA\fR. 
.PP
However, if \fBTcl_AllowExceptions\fR is invoked immediately before
calling one of those a procedures, then arbitrary completion
codes are permitted from the script, and they are returned without
modification.
This is useful in cases where the caller can deal with exceptions
such as \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR in a meaningful way.

.SH KEYWORDS
continue, break, exception, interpreter

Changes to doc/AppInit.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_AppInit 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_AppInit \- perform application-specific initialization
.SH SYNOPSIS
.nf
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
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







-
-
-
-
-







-



-











-
-
-


Each initialization procedure adds new commands to \fIinterp\fR
for its package and performs other package-specific initialization.
.IP [2]
Process command-line arguments, which can be accessed from the
Tcl variables \fBargv\fR and \fBargv0\fR in \fIinterp\fR.
.IP [3]
Invoke a startup script to initialize the application.
.IP [4]
Use the routines \fBTcl_SetStartupScript\fR and
\fBTcl_GetStartupScript\fR to set or query the file and encoding
that the active \fBTcl_Main\fR or \fBTk_Main\fR routine will
use as a startup script.
.LP
\fBTcl_AppInit\fR returns \fBTCL_OK\fR or \fBTCL_ERROR\fR.
If it returns \fBTCL_ERROR\fR then it must leave an error message in
for the interpreter's result;  otherwise the result is ignored.
.PP
In addition to \fBTcl_AppInit\fR, your application should also contain
a procedure \fBmain\fR that calls \fBTcl_Main\fR as follows:
.PP
.CS
Tcl_Main(argc, argv, Tcl_AppInit);
.CE
.PP
The third argument to \fBTcl_Main\fR gives the address of the
application-specific initialization procedure to invoke.
This means that you do not have to use the name \fBTcl_AppInit\fR
for the procedure, but in practice the name is nearly always
\fBTcl_AppInit\fR (in versions before Tcl 7.4 the name \fBTcl_AppInit\fR
was implicit;  there was no way to specify the procedure explicitly).
The best way to get started is to make a copy of the file
\fBtclAppInit.c\fR from the Tcl library or source directory.
It already contains a \fBmain\fR procedure and a template for
\fBTcl_AppInit\fR that you can modify for your application.

.SH "SEE ALSO"
Tcl_Main(3)

.SH KEYWORDS
application, argument, command, initialization, interpreter

Changes to doc/AssocData.3.

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
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





-
+









-
+

















-
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_SetAssocData 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetAssocData, Tcl_SetAssocData, Tcl_DeleteAssocData \- manage associations of string keys and user specified data with Tcl interpreters
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void *
ClientData
\fBTcl_GetAssocData\fR(\fIinterp, key, delProcPtr\fR)
.sp
\fBTcl_SetAssocData\fR(\fIinterp, key, delProc, clientData\fR)
.sp
\fBTcl_DeleteAssocData\fR(\fIinterp, key\fR)
.SH ARGUMENTS
.AS Tcl_InterpDeleteProc **delProcPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
.AP "const char" *key in
Key for association with which to store data or from which to delete or
retrieve data.  Typically the module prefix for a package.
.AP Tcl_InterpDeleteProc *delProc in
Procedure to call when \fIinterp\fR is deleted.
.AP Tcl_InterpDeleteProc **delProcPtr in
Pointer to location in which to store address of current deletion procedure
for association.  Ignored if NULL.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value associated with the given key in this
interpreter.  This data is owned by the caller.
.BE

.SH DESCRIPTION
.PP
These procedures allow extensions to associate their own data with
57
58
59
60
61
62
63
64
65
66
67


68
69
70
71
72
73
74
75
76
77
57
58
59
60
61
62
63

64


65
66
67
68

69
70
71
72
73
74
75







-

-
-
+
+


-







\fBTcl_SetAssocData\fR overwrites it with the new information.
It is up to callers to organize their use of names to avoid conflicts,
for example, by using package names as the keys.
If the \fIdeleteProc\fR argument is non-NULL it specifies the address of a
procedure to invoke if the interpreter is deleted before the association
is deleted.  \fIDeleteProc\fR should have arguments and result that match
the type \fBTcl_InterpDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_InterpDeleteProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_InterpDeleteProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
When \fIdeleteProc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as the corresponding arguments passed to
\fBTcl_SetAssocData\fR.
The deletion procedure will \fInot\fR be invoked if the association
is deleted before the interpreter is deleted.
.PP
\fBTcl_GetAssocData\fR returns the datum stored in the association with the

Changes to doc/Async.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_AsyncCreate 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_AsyncCreate, Tcl_AsyncMark, Tcl_AsyncInvoke, Tcl_AsyncDelete, Tcl_AsyncReady \- handle asynchronous events
.SH SYNOPSIS
.nf
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40







-
+







.sp
int
\fBTcl_AsyncReady\fR()
.SH ARGUMENTS
.AS Tcl_AsyncHandler clientData
.AP Tcl_AsyncProc *proc in
Procedure to invoke to handle an asynchronous event.
.AP void *clientData in
.AP ClientData clientData in
One-word value to pass to \fIproc\fR.
.AP Tcl_AsyncHandler async in
Token for asynchronous event handler.
.AP Tcl_Interp *interp in
Tcl interpreter in which command was being evaluated when handler was
invoked, or NULL if handler was invoked when there was no interpreter
active.
77
78
79
80
81
82
83
84
85
86
87


88
89
90
91
92
93
94
95
96
97
98
77
78
79
80
81
82
83

84


85
86
87
88
89

90
91
92
93
94
95
96







-

-
-
+
+



-







\fBTcl_AsyncMark\fR will mark the handler as ready to execute, but it
will not invoke the handler immediately.
Tcl will call the \fIproc\fR associated with the handler later, when
the world is in a safe state, and \fIproc\fR can then carry out
the actions associated with the asynchronous event.
\fIProc\fR should have arguments and result that match the
type \fBTcl_AsyncProc\fR:
.PP
.CS
typedef int \fBTcl_AsyncProc\fR(
        void *\fIclientData\fR,
typedef int Tcl_AsyncProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIcode\fR);
.CE
.PP
The \fIclientData\fR will be the same as the \fIclientData\fR
argument passed to \fBTcl_AsyncCreate\fR when the handler was
created.
If \fIproc\fR is invoked just after a command has completed
execution in an interpreter, then \fIinterp\fR will identify
the interpreter in which the command was evaluated and
\fIcode\fR will be the completion code returned by that

Changes to doc/BackgdErr.3.

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
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






-
+




-
+




-
-




-
+
-
-




-
+
-


-
+

-
-
+
+

-
+
-
-
+
-
-
-
+

-
+
-
-
+






-
+


-
+




-
-
-
+
+
+


-
-
-
-
-
-
-
-



'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_BackgroundException, Tcl_BackgroundError \- report Tcl exception that occurred in background processing
Tcl_BackgroundError \- report Tcl error that occurred in background processing
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_BackgroundException\fR(\fIinterp, code\fR)
.sp
\fBTcl_BackgroundError\fR(\fIinterp\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter in which the exception occurred.
Interpreter in which the error occurred.
.AP int code in
The exceptional return code to be reported.
.BE

.SH DESCRIPTION
.PP
This procedure is typically invoked when a Tcl exception (any
This procedure is typically invoked when a Tcl error occurs during
return code other than TCL_OK) occurs during
.QW "background processing"
such as executing an event handler.
When such an exception occurs, the condition is reported to Tcl
When such an error occurs, the error condition is reported to Tcl
or to a widget or some other C code, and there is not usually any
obvious way for that code to report the exception to the user.
In these cases the code calls \fBTcl_BackgroundException\fR with an
obvious way for that code to report the error to the user.
In these cases the code calls \fBTcl_BackgroundError\fR with an
\fIinterp\fR argument identifying the interpreter in which the
exception occurred, and a \fIcode\fR argument holding the return
error occurred.  At the time \fBTcl_BackgroundError\fR is invoked,
code value of the exception.  The state of the interpreter, including
any error message in the interpreter result, and the values of
the interpreter's result is expected to contain an error message.
any entries in the return options dictionary, is captured and
saved.  \fBTcl_BackgroundException\fR then arranges for the event
loop to invoke at some later time the command registered
\fBTcl_BackgroundError\fR will invoke the command registered
in that interpreter to handle background errors by the
\fBinterp bgerror\fR command, passing the captured values as
\fBinterp bgerror\fR command.
arguments.
The registered handler command is meant to report the exception
The registered handler command is meant to report the error
in an application-specific fashion.  The handler command
receives two arguments, the result of the interp, and the
return options of the interp at the time the error occurred.
If the application registers no handler command, the default
handler command will attempt to call \fBbgerror\fR to report
the error.  If an error condition arises while invoking the
handler command, then \fBTcl_BackgroundException\fR reports the
handler command, then \fBTcl_BackgroundError\fR reports the
error itself by printing a message on the standard error file.
.PP
\fBTcl_BackgroundException\fR does not invoke the handler command immediately
\fBTcl_BackgroundError\fR does not invoke the handler command immediately
because this could potentially interfere with scripts that are in process
at the time the error occurred.
Instead, it invokes the handler command later as an idle callback.
.PP
It is possible for many background exceptions to accumulate before
the handler command is invoked.  When this happens, each of the exceptions
is processed in order.  However, if the handler command returns a
It is possible for many background errors to accumulate before
the handler command is invoked.  When this happens, each of the errors
is processed in order.  However, if the handle command returns a
break exception, then all remaining error reports for the
interpreter are skipped.
.PP
The \fBTcl_BackgroundError\fR routine is an older and simpler interface
useful when the exception code reported is \fBTCL_ERROR\fR.  It is
equivalent to:
.PP
.CS
Tcl_BackgroundException(interp, TCL_ERROR);
.CE

.SH KEYWORDS
background, bgerror, error, interp

Added doc/Backslash.3.
















































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Backslash \- parse a backslash sequence
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
char
\fBTcl_Backslash\fR(\fIsrc, countPtr\fR)
.SH ARGUMENTS
.AS char *countPtr out
.AP char *src in
Pointer to a string starting with a backslash.
.AP int *countPtr out
If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled
in with number of characters in the backslash sequence, including
the backslash character.
.BE

.SH DESCRIPTION
.PP
The use of \fBTcl_Backslash\fR is deprecated in favor of
\fBTcl_UtfBackslash\fR.
.PP
This is a utility procedure provided for backwards compatibility with
non-internationalized Tcl extensions.  It parses a backslash sequence and
returns the low byte of the Unicode character corresponding to the sequence. 
\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of
characters in the backslash sequence.
.PP
See the Tcl manual entry for information on the valid backslash sequences.
All of the sequences described in the Tcl manual entry are supported by
\fBTcl_Backslash\fR.
.SH "SEE ALSO"
Tcl(n), Tcl_UtfBackslash(3)

.SH KEYWORDS
backslash, parse

Changes to doc/BoolObj.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2005.  (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.
'\"
'\" 
.TH Tcl_BooleanObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewBooleanObj, Tcl_SetBooleanObj, Tcl_GetBooleanFromObj \- store/retrieve boolean value in a Tcl_Obj
.SH SYNOPSIS
.nf
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

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







-
+



















-
+










-
+







-
+


-
+



















-
+
.AP int boolValue in
Integer value to be stored as a boolean value in a Tcl_Obj.
.AP Tcl_Obj *objPtr in/out
Points to the Tcl_Obj in which to store, or from which to
retrieve a boolean value.
.AP Tcl_Interp *interp in/out
If a boolean value cannot be retrieved,
an error message is left in the interpreter's result value
an error message is left in the interpreter's result object
unless \fIinterp\fR is NULL.
.AP int *boolPtr out
Points to place where \fBTcl_GetBooleanFromObj\fR
stores the boolean value (0 or 1) obtained from \fIobjPtr\fR.
.BE

.SH DESCRIPTION
.PP
These procedures are used to pass boolean values to and from
Tcl as Tcl_Obj's.  When storing a boolean value into a Tcl_Obj,
any non-zero integer value in \fIboolValue\fR is taken to be
the boolean value \fB1\fR, and the integer value \fB0\fR is
taken to be the boolean value \fB0\fR.
.PP
\fBTcl_NewBooleanObj\fR creates a new Tcl_Obj, stores the boolean
value \fIboolValue\fR in it, and returns a pointer to the new Tcl_Obj.
The new Tcl_Obj has reference count of zero.
.PP
\fBTcl_SetBooleanObj\fR accepts \fIobjPtr\fR, a pointer to
an existing Tcl_Obj, and stores in the Tcl_Obj \fI*objPtr\fR
an existing Tcl_Obj, and stores in the Tcl_Obj \fI*objPtr\fR 
the boolean value \fIboolValue\fR.  This is a write operation
on \fI*objPtr\fR, so \fIobjPtr\fR must be unshared.  Attempts to
write to a shared Tcl_Obj will panic.  A successful write
of \fIboolValue\fR into \fI*objPtr\fR implies the freeing of
any former value stored in \fI*objPtr\fR.
.PP
\fBTcl_GetBooleanFromObj\fR attempts to retrieve a boolean value
from the value stored in \fI*objPtr\fR.
If \fIobjPtr\fR holds a string value recognized by \fBTcl_GetBoolean\fR,
then the recognized boolean value is written at the address given
by \fIboolPtr\fR.
by \fIboolPtr\fR.  
If \fIobjPtr\fR holds any value recognized as
a number by Tcl, then if that value is zero a 0 is written at
the address given by \fIboolPtr\fR and if that
value is non-zero a 1 is written at the address given by \fIboolPtr\fR.
In all cases where a value is written at the address given
by \fIboolPtr\fR, \fBTcl_GetBooleanFromObj\fR returns \fBTCL_OK\fR.
If the value of \fIobjPtr\fR does not meet any of the conditions
above, then \fBTCL_ERROR\fR is returned and an error message is
above, then \fBTCL_ERROR\fR is returned and an error message is 
left in the interpreter's result unless \fIinterp\fR is NULL.
\fBTcl_GetBooleanFromObj\fR may also make changes to the internal
fields of \fI*objPtr\fR so that future calls to
fields of \fI*objPtr\fR so that future calls to 
\fBTcl_GetBooleanFromObj\fR on the same \fIobjPtr\fR can be
performed more efficiently.
.PP
Note that the routines \fBTcl_GetBooleanFromObj\fR and
\fBTcl_GetBoolean\fR are not functional equivalents.
The set of values for which \fBTcl_GetBooleanFromObj\fR
will return \fBTCL_OK\fR is strictly larger than
the set of values for which \fBTcl_GetBoolean\fR will do the same.
For example, the value
.QW 5
passed to \fBTcl_GetBooleanFromObj\fR
will lead to a \fBTCL_OK\fR return (and the boolean value 1),
while the same value passed to \fBTcl_GetBoolean\fR will lead to
a \fBTCL_ERROR\fR return.

.SH "SEE ALSO"
Tcl_NewObj, Tcl_IsShared, Tcl_GetBoolean

.SH KEYWORDS
boolean, value
boolean, object

Changes to doc/ByteArrObj.3.

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

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





-
+




-
+







-
+










-
+
-
-
-
+
+

-
+

-
+

-
+

-
+




-
-
+
+





-
-
+
+


-
+


-
-
-
+
+
+

-
+

-
-
+
+
-

-
-
+
+


-
-
-
+
+
+

-
-
+
+





-
+





-
+
'\"
'\" Copyright (c) 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.
'\"
'\" 
.TH Tcl_ByteArrayObj 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl values as a arrays of bytes
Tcl_NewByteArrayObj, Tcl_SetByteArrayObj, Tcl_GetByteArrayFromObj, Tcl_SetByteArrayLength \- manipulate Tcl objects as a arrays of bytes 
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewByteArrayObj\fR(\fIbytes, length\fR)
.sp
void
void 
\fBTcl_SetByteArrayObj\fR(\fIobjPtr, bytes, length\fR)
.sp
unsigned char *
\fBTcl_GetByteArrayFromObj\fR(\fIobjPtr, lengthPtr\fR)
.sp
unsigned char *
\fBTcl_SetByteArrayLength\fR(\fIobjPtr, length\fR)
.SH ARGUMENTS
.AS "const unsigned char" *lengthPtr in/out
.AP "const unsigned char" *bytes in
The array of bytes used to initialize or set a byte-array value. May be NULL
The array of bytes used to initialize or set a byte-array object.
even if \fIlength\fR is non-zero.
.AP size_t length in
The length of the array of bytes.
.AP int length in
The length of the array of bytes.  It must be >= 0.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetByteArrayObj\fR, this points to the value to be converted to
For \fBTcl_SetByteArrayObj\fR, this points to the object to be converted to
byte-array type.  For \fBTcl_GetByteArrayFromObj\fR and
\fBTcl_SetByteArrayLength\fR, this points to the value from which to get
\fBTcl_SetByteArrayLength\fR, this points to the object from which to get
the byte-array value; if \fIobjPtr\fR does not already point to a byte-array
value, it will be converted to one.
object, it will be converted to one.
.AP int *lengthPtr out
If non-NULL, filled with the length of the array of bytes in the value.
If non-NULL, filled with the length of the array of bytes in the object.
.BE

.SH DESCRIPTION
.PP
These procedures are used to create, modify, and read Tcl byte-array values
from C code.  Byte-array values are typically used to hold the
These procedures are used to create, modify, and read Tcl byte-array objects
from C code.  Byte-array objects are typically used to hold the
results of binary IO operations or data structures created with the
\fBbinary\fR command.  In Tcl, an array of bytes is not equivalent to a
string.  Conceptually, a string is an array of Unicode characters, while a
byte-array is an array of 8-bit quantities with no implicit meaning.
Accessor functions are provided to get the string representation of a
byte-array or to convert an arbitrary value to a byte-array.  Obtaining the
string representation of a byte-array value (by calling
byte-array or to convert an arbitrary object to a byte-array.  Obtaining the
string representation of a byte-array object (by calling
\fBTcl_GetStringFromObj\fR) produces a properly formed UTF-8 sequence with a
one-to-one mapping between the bytes in the internal representation and the
UTF-8 characters in the string representation.
UTF-8 characters in the string representation.  
.PP
\fBTcl_NewByteArrayObj\fR and \fBTcl_SetByteArrayObj\fR will
create a new value of byte-array type or modify an existing value to have a
byte-array type.  Both of these procedures set the value's type to be
byte-array and set the value's internal representation to a copy of the
create a new object of byte-array type or modify an existing object to have a
byte-array type.  Both of these procedures set the object's type to be
byte-array and set the object's internal representation to a copy of the
array of bytes given by \fIbytes\fR. \fBTcl_NewByteArrayObj\fR returns a
pointer to a newly allocated value with a reference count of zero.
pointer to a newly allocated object with a reference count of zero.
\fBTcl_SetByteArrayObj\fR invalidates any old string representation and, if
the value is not already a byte-array value, frees any old internal
representation. If \fIbytes\fR is NULL then the new byte array contains
the object is not already a byte-array object, frees any old internal
representation.
arbitrary values.
.PP
\fBTcl_GetByteArrayFromObj\fR converts a Tcl value to byte-array type and
returns a pointer to the value's new internal representation as an array of
\fBTcl_GetByteArrayFromObj\fR converts a Tcl object to byte-array type and
returns a pointer to the object's new internal representation as an array of
bytes.  The length of this array is stored in \fIlengthPtr\fR if
\fIlengthPtr\fR is non-NULL.  The storage for the array of bytes is owned by
the value and should not be freed.  The contents of the array may be
modified by the caller only if the value is not shared and the caller
invalidates the string representation.
the object and should not be freed.  The contents of the array may be
modified by the caller only if the object is not shared and the caller
invalidates the string representation.  
.PP
\fBTcl_SetByteArrayLength\fR converts the Tcl value to byte-array type
and changes the length of the value's internal representation as an
\fBTcl_SetByteArrayLength\fR converts the Tcl object to byte-array type
and changes the length of the object's internal representation as an
array of bytes.  If \fIlength\fR is greater than the space currently
allocated for the array, the array is reallocated to the new length; the
newly allocated bytes at the end of the array have arbitrary values.  If
\fIlength\fR is less than the space currently allocated for the array,
the length of array is reduced to the new length.  The return value is a
pointer to the value's new array of bytes.
pointer to the object's new array of bytes.  

.SH "SEE ALSO"
Tcl_GetStringFromObj, Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount

.SH KEYWORDS
value, binary data, byte array, utf, unicode, internationalization
object, byte array, utf, unicode, internationalization

Changes to doc/CallDel.3.

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

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






-
+


















-
+


+









-

-
-
+
+


-















-
+
-
-
-
-
-

-
+
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_CallWhenDeleted 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CallWhenDeleted, Tcl_DontCallWhenDeleted \- Arrange for callback when interpreter is deleted
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_CallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR)
.sp
\fBTcl_DontCallWhenDeleted\fR(\fIinterp\fR, \fIproc\fR, \fIclientData\fR)
.SH ARGUMENTS
.AS Tcl_InterpDeleteProc clientData
.AP Tcl_Interp *interp in
Interpreter with which to associated callback.
.AP Tcl_InterpDeleteProc *proc in
Procedure to call when \fIinterp\fR is deleted.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_CallWhenDeleted\fR arranges for \fIproc\fR to be called by
\fBTcl_DeleteInterp\fR if/when \fIinterp\fR is deleted at some future
time.  \fIProc\fR will be invoked just before the interpreter
is deleted, but the interpreter will still be valid at the
time of the call.
\fIProc\fR should have arguments and result that match the
type \fBTcl_InterpDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_InterpDeleteProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_InterpDeleteProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters are
copies of the \fIclientData\fR and \fIinterp\fR arguments given
to \fBTcl_CallWhenDeleted\fR.
Typically, \fIclientData\fR points to an application-specific
data structure that \fIproc\fR uses to perform cleanup when an
interpreter is about to go away.
\fIProc\fR does not return a value.
.PP
\fBTcl_DontCallWhenDeleted\fR cancels a previous call to
\fBTcl_CallWhenDeleted\fR with the same arguments, so that
\fIproc\fR will not be called after all when \fIinterp\fR is
deleted.
If there is no deletion callback that matches \fIinterp\fR,
\fIproc\fR, and \fIclientData\fR then the call to
\fBTcl_DontCallWhenDeleted\fR has no effect.
.PP

Note that if the callback is being used to delete a resource that \fImust\fR
be released on exit, \fBTcl_CreateExitHandler\fR should be used to ensure that
a callback is received even if the application terminates without deleting the interpreter.
.SH "SEE ALSO"
Tcl_CreateExitHandler(3), Tcl_CreateThreadExitHandler(3)
.SH KEYWORDS
callback, cleanup, delete, interpreter
callback, delete, interpreter

Deleted doc/Cancel.3.

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










































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2006-2008 Joe Mistachkin.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Cancel 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CancelEval, Tcl_Canceled \- cancel Tcl scripts
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
int
\fBTcl_CancelEval\fR(\fIinterp, resultObjPtr, clientData, flags\fR)
.sp
int
\fBTcl_Canceled\fR(\fIinterp, flags\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter in which to cancel the script.
.AP Tcl_Obj *resultObjPtr in
Error message to use in the cancellation, or NULL to use a default message. If
not NULL, this object will have its reference count decremented before
\fBTcl_CancelEval\fR returns.
.AP int flags in
ORed combination of flag bits that specify additional options.
For \fBTcl_CancelEval\fR, only \fBTCL_CANCEL_UNWIND\fR is currently
supported.  For \fBTcl_Canceled\fR, only \fBTCL_LEAVE_ERR_MSG\fR and
\fBTCL_CANCEL_UNWIND\fR are currently supported.
.AP void *clientData in
Currently reserved for future use.
It should be set to NULL.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CancelEval\fR cancels or unwinds the script in progress soon after
the next invocation of asynchronous handlers, causing \fBTCL_ERROR\fR to be
the return code for that script.  This function is thread-safe and may be
called from any thread in the process.
.PP
\fBTcl_Canceled\fR checks if the script in progress has been canceled and
returns \fBTCL_ERROR\fR if it has.  Otherwise, \fBTCL_OK\fR is returned.
Extensions can use this function to check to see if they should abort a long
running command.  This function is thread sensitive and may only be called
from the thread the interpreter was created in.
.SS "FLAG BITS"
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_CancelEval\fR:
.TP 20
\fBTCL_CANCEL_UNWIND\fR
.
This flag is used by \fBTcl_CancelEval\fR and \fBTcl_Canceled\fR.
For \fBTcl_CancelEval\fR, if this flag is set, the script in progress
is canceled and the evaluation stack for the interpreter is unwound.
For \fBTcl_Canceled\fR, if this flag is set, the script in progress
is considered to be canceled only if the evaluation stack for the
interpreter is being unwound.
.TP 20
\fBTCL_LEAVE_ERR_MSG\fR
.
This flag is only used by \fBTcl_Canceled\fR; it is ignored by
other procedures.  If an error is returned and this bit is set in
\fIflags\fR, then an error message will be left in the interpreter's
result, where it can be retrieved with \fBTcl_GetObjResult\fR or
\fBTcl_GetStringResult\fR.  If this flag bit is not set then no error
message is left and the interpreter's result will not be modified.
.SH "SEE ALSO"
interp(n), Tcl_Eval(3),
TIP 285
.SH KEYWORDS
cancel, unwind

Changes to doc/ChnlStack.3.

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
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







-
+

-
+
















+
+
-
-
+
+
+







Tcl_Channel
\fBTcl_GetTopChannel\fR(\fIchannel\fR)
.sp
.SH ARGUMENTS
.AS Tcl_ChannelType clientData
.AP Tcl_Interp *interp in
Interpreter for error reporting.
.AP "const Tcl_ChannelType" *typePtr in
.AP Tcl_ChannelType *typePtr in
The new channel I/O procedures to use for \fIchannel\fR.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to channel I/O procedures.
.AP int mask in
Conditions under which \fIchannel\fR will be used: OR-ed combination of
\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR.
This can be a subset of the operations currently allowed on \fIchannel\fR.
.AP Tcl_Channel channel in
An existing Tcl channel such as returned by \fBTcl_CreateChannel\fR.
.BE

.SH DESCRIPTION
.PP
These functions are for use by extensions that add processing layers to Tcl
I/O channels.  Examples include compression and encryption modules.  These
functions transparently stack and unstack a new channel on top of an
existing one.  Any number of channels can be stacked together.
.PP
The implementation of the Tcl channel code was rewritten in 8.3.2 to
correct some problems with the previous implementation with regard to
The \fBTcl_ChannelType\fR version currently supported is
\fBTCL_CHANNEL_VERSION_5\fR.  See \fBTcl_CreateChannel\fR for details.
stacked channels.  Anyone using stacked channels or creating stacked
channel drivers should update to the new \fBTCL_CHANNEL_VERSION_2\fR
\fBTcl_ChannelType\fR structure.  See \fBTcl_CreateChannel\fR for details.
.PP
\fBTcl_StackChannel\fR stacks a new \fIchannel\fR on an existing channel
with the same name that was registered for \fIchannel\fR by
\fBTcl_RegisterChannel\fR.
.PP
\fBTcl_StackChannel\fR works by creating a new channel structure and
placing itself on top of the channel stack.  EOL translation, encoding and

Deleted doc/Class.3.

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



























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Class 3 0.1 TclOO "TclOO Library Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_CopyObjectInstance, Tcl_GetClassAsObject, Tcl_GetObjectAsClass, Tcl_GetObjectCommand, Tcl_GetObjectFromObj, Tcl_GetObjectName, Tcl_GetObjectNamespace, Tcl_NewObjectInstance, Tcl_ObjectDeleted, Tcl_ObjectGetMetadata, Tcl_ObjectGetMethodNameMapper, Tcl_ObjectSetMetadata, Tcl_ObjectSetMethodNameMapper \- manipulate objects and classes
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
Tcl_Object
\fBTcl_GetObjectFromObj\fR(\fIinterp, objPtr\fR)
.sp
Tcl_Object
\fBTcl_GetClassAsObject\fR(\fIclass\fR)
.sp
Tcl_Class
\fBTcl_GetObjectAsClass\fR(\fIobject\fR)
.sp
Tcl_Obj *
\fBTcl_GetObjectName\fR(\fIinterp, object\fR)
.sp
Tcl_Command
\fBTcl_GetObjectCommand\fR(\fIobject\fR)
.sp
Tcl_Namespace *
\fBTcl_GetObjectNamespace\fR(\fIobject\fR)
.sp
Tcl_Object
\fBTcl_NewObjectInstance\fR(\fIinterp, class, name, nsName, objc, objv, skip\fR)
.sp
Tcl_Object
\fBTcl_CopyObjectInstance\fR(\fIinterp, object, name, nsName\fR)
.sp
int
\fBTcl_ObjectDeleted\fR(\fIobject\fR)
.sp
void *
\fBTcl_ObjectGetMetadata\fR(\fIobject, metaTypePtr\fR)
.sp
\fBTcl_ObjectSetMetadata\fR(\fIobject, metaTypePtr, metadata\fR)
.sp
void *
\fBTcl_ClassGetMetadata\fR(\fIclass, metaTypePtr\fR)
.sp
\fBTcl_ClassSetMetadata\fR(\fIclass, metaTypePtr, metadata\fR)
.sp
Tcl_ObjectMapMethodNameProc
\fBTcl_ObjectGetMethodNameMapper\fR(\fIobject\fR)
.sp
\fBTcl_ObjectSetMethodNameMapper\fR(\fIobject\fR, \fImethodNameMapper\fR)
.SH ARGUMENTS
.AS void *metadata in/out
.AP Tcl_Interp *interp in/out
Interpreter providing the context for looking up or creating an object, and
into whose result error messages will be written on failure.
.AP Tcl_Obj *objPtr in
The name of the object to look up.
.AP Tcl_Object object in
Reference to the object to operate upon.
.AP Tcl_Class class in
Reference to the class to operate upon.
.AP "const char" *name in
The name of the object to create, or NULL if a new unused name is to be
automatically selected.
.AP "const char" *nsName in
The name of the namespace to create for the object's private use, or NULL if a
new unused name is to be automatically selected. The namespace must not
already exist.
.AP int objc in
The number of elements in the \fIobjv\fR array.
.AP "Tcl_Obj *const" *objv in
The arguments to the command to create the instance of the class.
.AP int skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors. This allows the generation of correct
error messages even when complicated calling patterns are used (e.g., via the
\fBnext\fR command).
.AP Tcl_ObjectMetadataType *metaTypePtr in
The type of \fImetadata\fR being set with \fBTcl_ClassSetMetadata\fR or
retrieved with \fBTcl_ClassGetMetadata\fR.
.AP void *metadata in
An item of metadata to attach to the class, or NULL to remove the metadata
associated with a particular \fImetaTypePtr\fR.
.AP "Tcl_ObjectMapMethodNameProc" "methodNameMapper" in
A pointer to a function to call to adjust the mapping of objects and method
names to implementations, or NULL when no such mapping is required.
.BE
.SH DESCRIPTION
.PP
Objects are typed entities that have a set of operations ("methods")
associated with them. Classes are objects that can manufacture objects. Each
class can be viewed as an object itself; the object view can be retrieved
using \fBTcl_GetClassAsObject\fR which always returns the object when applied
to a non-destroyed class, and an object can be viewed as a class with the aid
of the \fBTcl_GetObjectAsClass\fR (which either returns the class, or NULL if
the object is not a class). An object may be looked up using the
\fBTcl_GetObjectFromObj\fR function, which either returns an object or NULL
(with an error message in the interpreter result) if the object cannot be
found. The correct way to look up a class by name is to look up the object
with that name, and then to use \fBTcl_GetObjectAsClass\fR.
.PP
Every object has its own command and namespace associated with it. The command
may be retrieved using the \fBTcl_GetObjectCommand\fR function, the name of
the object (and hence the name of the command) with \fBTcl_GetObjectName\fR,
and the namespace may be retrieved using the \fBTcl_GetObjectNamespace\fR
function. Note that the Tcl_Obj reference returned by \fBTcl_GetObjectName\fR
is a shared reference. You can also get whether the object has been marked for
deletion with \fBTcl_ObjectDeleted\fR (it returns true if deletion of the
object has begun); this can be useful during the processing of methods.
.PP
Instances of classes are created using \fBTcl_NewObjectInstance\fR, which
creates an object from any class (and which is internally called by both
the \fBcreate\fR and \fBnew\fR methods of the \fBoo::class\fR class). It takes
parameters that optionally give the name of the object and namespace to
create, and which describe the arguments to pass to the class's constructor
(if any). The result of the function will be either a reference to the newly
created object, or NULL if the creation failed (when an error message will be
left in the interpreter result). In addition, objects may be copied by using
\fBTcl_CopyObjectInstance\fR which creates a copy of an object without running
any constructors.
.PP
Note that the lifetime management of objects is handled internally within
TclOO, and does not use \fBTcl_Preserve\fR. \fIIt is not safe to put a
Tcl_Object handle in a C structure with a lifespan different to the object;\fR
you should use the object's command name (as retrieved with
\fBTcl_GetObjectName\fR) instead. It is safe to use a Tcl_Object handle for
the lifespan of a call of a method on that object; handles do not become
invalid while there is an outstanding call on their object (even if the only
operation guaranteed to be safe on them is \fBTcl_ObjectDeleted\fR; the other
operations are only guaranteed to work on non-deleted objects).
.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
\fBTcl_ObjectGetMetadata\fR and \fBTcl_ClassGetMetadata\fR are NULL if the
given type of metadata was not attached. It is not an error to request or
remove a piece of metadata that was not attached.
.SS "TCL_OBJECTMETADATATYPE STRUCTURE"
.PP
The contents of the Tcl_ObjectMetadataType structure are as follows:
.PP
.CS
typedef const struct {
    int \fIversion\fR;
    const char *\fIname\fR;
    Tcl_ObjectMetadataDeleteProc *\fIdeleteProc\fR;
    Tcl_CloneProc *\fIcloneProc\fR;
} \fBTcl_ObjectMetadataType\fR;
.CE
.PP
The \fIversion\fR field allows for future expansion of the structure, and
should always be declared equal to TCL_OO_METADATA_VERSION_CURRENT. The
\fIname\fR field provides a human-readable name for the type, and is reserved
for debugging.
.PP
The \fIdeleteProc\fR field gives a function of type
Tcl_ObjectMetadataDeleteProc that is used to delete a particular piece of
metadata, and is called when the attached metadata is replaced or removed; the
field must not be NULL.
.PP
The \fIcloneProc\fR field gives a function that is used to copy a piece of
metadata (used when a copy of an object is created using
\fBTcl_CopyObjectInstance\fR); if NULL, the metadata will be just directly
copied.
.SS "TCL_OBJECTMETADATADELETEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to delete metadata associated with
a class or object.
.PP
.CS
typedef void \fBTcl_ObjectMetadataDeleteProc\fR(
        void *\fImetadata\fR);
.CE
.PP
The \fImetadata\fR argument gives the address of the metadata to be
deleted.
.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to create copies of metadata
associated with a class or object.
.PP
.CS
typedef int \fBTcl_CloneProc\fR(
        Tcl_Interp *\fIinterp\fR,
        void *\fIsrcMetadata\fR,
        void **\fIdstMetadataPtr\fR);
.CE
.PP
The \fIinterp\fR argument gives a place to write an error message when the
attempt to clone the object is to fail, in which case the clone procedure must
also return TCL_ERROR; it should return TCL_OK otherwise.
The \fIsrcMetadata\fR argument gives the address of the metadata to be cloned,
and the cloned metadata should be written into the variable pointed to by
\fIdstMetadataPtr\fR; a NULL should be written if the metadata is to not be
cloned but the overall object copy operation is still to succeed.
.SH "OBJECT METHOD NAME MAPPING"
It is possible to control, on a per-object basis, what methods are invoked
when a particular method is invoked. Normally this is done by looking up the
method name in the object and then in the class hierarchy, but fine control of
exactly what the value used to perform the look up is afforded through the
ability to set a method name mapper callback via
\fBTcl_ObjectSetMethodNameMapper\fR (and its introspection counterpart,
\fBTcl_ObjectGetMethodNameMapper\fR, which returns the current mapper). The
current mapper (if any) is invoked immediately before looking up what chain of
method implementations is to be used.
.SS "TCL_OBJECTMAPMETHODNAMEPROC FUNCTION SIGNATURE"
The \fITcl_ObjectMapMethodNameProc\fR callback is defined as follows:
.PP
.CS
typedef int \fBTcl_ObjectMapMethodNameProc\fR(
        Tcl_Interp *\fIinterp\fR,
        Tcl_Object \fIobject\fR,
        Tcl_Class *\fIstartClsPtr\fR,
        Tcl_Obj *\fImethodNameObj\fR);
.CE
.PP
If the result is TCL_OK, the remapping is assumed to have been done. If the
result is TCL_ERROR, an error message will have been left in \fIinterp\fR and
the method call will fail. If the result is TCL_BREAK, the standard method
name lookup rules will be used; the behavior of other result codes is
currently undefined. The \fIobject\fR parameter says which object is being
processed. The \fIstartClsPtr\fR parameter points to a variable that contains
the first class to provide a definition in the method chain to process, or
NULL if the whole chain is to be processed (the argument itself is never
NULL); this variable may be updated by the callback. The \fImethodNameObj\fR
parameter gives an unshared object containing the name of the method being
invoked, as provided by the user; this object may be updated by the callback.
.SH "SEE ALSO"
Method(3), oo::class(n), oo::copy(n), oo::define(n), oo::object(n)
.SH KEYWORDS
class, constructor, object
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/CmdCmplt.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CommandComplete \- Check for unmatched braces in a Tcl command
.SH SYNOPSIS
.nf

Changes to doc/Concat.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Concat \- concatenate a collection of strings
.SH SYNOPSIS
.nf

Deleted doc/CrtAlias.3.

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












































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_CreateAlias 3 7.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_IsSafe\fR(\fIinterp\fR)
.sp
int
\fBTcl_MakeSafe\fR(\fIinterp\fR)
.sp
Tcl_Interp *
\fBTcl_CreateChild\fR(\fIinterp, name, isSafe\fR)
.sp
Tcl_Interp *
\fBTcl_GetChild\fR(\fIinterp, name\fR)
.sp
Tcl_Interp *
\fBTcl_GetParent\fR(\fIinterp\fR)
.sp
int
\fBTcl_GetInterpPath\fR(\fIinterp, childInterp\fR)
.sp
int
\fBTcl_CreateAlias\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
                argc, argv\fR)
.sp
int
\fBTcl_CreateAliasObj\fR(\fIchildInterp, childCmd, targetInterp, targetCmd,
                   objc, objv\fR)
.sp
int
\fBTcl_GetAlias\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
             argcPtr, argvPtr\fR)
.sp
int
\fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr,
                objcPtr, objvPtr\fR)
.sp
int
\fBTcl_ExposeCommand\fR(\fIinterp, hiddenCmdName, cmdName\fR)
.sp
int
\fBTcl_HideCommand\fR(\fIinterp, cmdName, hiddenCmdName\fR)
.SH ARGUMENTS
.AS "const char *const" **targetInterpPtr out
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
.AP "const char" *name in
Name of child interpreter to create or manipulate.
.AP int isSafe in
If non-zero, a
.QW safe
child that is suitable for running untrusted code
is created, otherwise a trusted child is created.
.AP Tcl_Interp *childInterp in
Interpreter to use for creating the source command for an alias (see
below).
.AP "const char" *childCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
.AP "const char" *targetCmd in
Name of target command for alias in \fItargetInterp\fR.
.AP int argc in
Count of additional arguments to pass to the alias command.
.AP "const char *const" *argv in
Vector of strings, the additional arguments to pass to the alias command.
This storage is owned by the caller.
.AP int objc in
Count of additional value arguments to pass to the aliased command.
.AP Tcl_Obj **objv in
Vector of Tcl_Obj structures, the additional value arguments to pass to
the aliased command.
This storage is owned by the caller.
.AP Tcl_Interp **targetInterpPtr in
Pointer to location to store the address of the interpreter where a target
command is defined for an alias.
.AP "const char" **targetCmdPtr out
Pointer to location to store the address of the name of the target command
for an alias.
.AP int *argcPtr out
Pointer to location to store count of additional arguments to be passed to
the alias. The location is in storage owned by the caller.
.AP "const char" ***argvPtr out
Pointer to location to store a vector of strings, the additional arguments
to pass to an alias. The location is in storage owned by the caller, the
vector of strings is owned by the called function.
.AP int *objcPtr out
Pointer to location to store count of additional value arguments to be
passed to the alias. The location is in storage owned by the caller.
.AP Tcl_Obj ***objvPtr out
Pointer to location to store a vector of Tcl_Obj structures, the additional
arguments to pass to an alias command. The location is in storage
owned by the caller, the vector of Tcl_Obj structures is owned by the
called function.
.AP "const char" *cmdName in
Name of an exposed command to hide or create.
.AP "const char" *hiddenCmdName in
Name under which a hidden command is stored and with which it can be
exposed or invoked.
.BE

.SH DESCRIPTION
.PP
These procedures are intended for access to the multiple interpreter
facility from inside C programs. They enable managing multiple interpreters
in a hierarchical relationship, and the management of aliases, commands
that when invoked in one interpreter execute a command in another
interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the interpreter's result contains an error message.
.PP
\fBTcl_CreateChild\fR creates a new interpreter as a child of \fIinterp\fR.
It also creates a child command named \fIname\fR in \fIinterp\fR which
allows \fIinterp\fR to manipulate the new child.
If \fIisSafe\fR is zero, the command creates a trusted child in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
.QW safe
child in which Tcl code has access only to set of Tcl commands defined as
.QW "Safe Tcl" ;
see the manual entry for the Tcl \fBinterp\fR command for details.
If the creation of the new child interpreter failed, \fBNULL\fR is returned.
.PP
\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
.QW safe
(was created with the \fBTCL_SAFE_INTERPRETER\fR flag specified),
\fB0\fR otherwise.
.PP
\fBTcl_MakeSafe\fR marks \fIinterp\fR as
.QW safe ,
so that future
calls to \fBTcl_IsSafe\fR will return 1.  It also removes all known
potentially-unsafe core functionality (both commands and variables)
from \fIinterp\fR.  However, it cannot know what parts of an extension
or application are safe and does not make any attempt to remove those
parts, so safety is not guaranteed after calling \fBTcl_MakeSafe\fR.
Callers will want to take care with their use of \fBTcl_MakeSafe\fR
to avoid false claims of safety.  For many situations, \fBTcl_CreateChild\fR
may be a better choice, since it creates interpreters in a known-safe state.
.PP
\fBTcl_GetChild\fR returns a pointer to a child interpreter of
\fIinterp\fR. The child interpreter is identified by \fIname\fR.
If no such child interpreter exists, \fBNULL\fR is returned.
.PP
\fBTcl_GetParent\fR returns a pointer to the parent interpreter of
\fIinterp\fR. If \fIinterp\fR has no parent (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
\fBTcl_GetInterpPath\fR stores in the result of \fIinterp\fR
the relative path between \fIinterp\fR and \fIchildInterp\fR;
\fIchildInterp\fR must be a child of \fIinterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and an error message is stored as the
result of \fIinterp\fR.
.PP
\fBTcl_CreateAlias\fR creates a command named \fIchildCmd\fR in
\fIchildInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
invocation of \fIchildCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
it fails; in that case, an error message is left in the value result
of \fIchildInterp\fR.
Note that there are no restrictions on the ancestry relationship (as
created by \fBTcl_CreateChild\fR) between \fIchildInterp\fR and
\fItargetInterp\fR. Any two interpreters can be used, without any
restrictions on how they are related.
.PP
\fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except
that it takes a vector of values to pass as additional arguments instead
of a vector of strings.
.PP
\fBTcl_GetAlias\fR returns information about an alias \fIaliasName\fR
in \fIinterp\fR. Any of the result fields can be \fBNULL\fR, in
which case the corresponding datum is not returned. If a result field is
non\-\fBNULL\fR, the address indicated is set to the corresponding datum.
For example, if \fItargetNamePtr\fR is non\-\fBNULL\fR it is set to a
pointer to the string containing the name of the target command.
.PP
\fBTcl_GetAliasObj\fR is similar to \fBTcl_GetAlias\fR except that it
returns a pointer to a vector of Tcl_Obj structures instead of a vector of
strings.
.PP
\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
the set of hidden commands to the set of exposed commands, putting
it under the name
\fIcmdName\fR.
\fIHiddenCmdName\fR must be the name of an existing hidden
command, or the operation will return \fBTCL_ERROR\fR and
leave an error message as the result of \fIinterp\fR.
If an exposed command named \fIcmdName\fR already exists,
the operation returns \fBTCL_ERROR\fR and leaves an error message as
the result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in any
script evaluation mechanism will again succeed.
.PP
\fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of
exposed commands to the set of hidden commands, under the name
\fIhiddenCmdName\fR.
\fICmdName\fR must be the name of an existing exposed
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message as the result of \fIinterp\fR.
Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain
namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and
leave an error message as the result of \fIinterp\fR.
The \fICmdName\fR will be looked up in the global namespace, and not
relative to the current namespace, even if the current namespace is not the
global one.
If a hidden command whose name is \fIhiddenCmdName\fR already
exists, the operation also returns \fBTCL_ERROR\fR and an error
message is left as the result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in
any script evaluation mechanism will fail.
.PP
For a description of the Tcl interface to multiple interpreters, see
\fIinterp(n)\fR.
.SH "SEE ALSO"
interp

.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
parent, child

Changes to doc/CrtChannel.3.

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
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











-
+







-
+


-
+







'\"
'\" Copyright (c) 1996-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1997-2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.TH Tcl_CreateChannel 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelWideSeekProc, Tcl_ChannelTruncateProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
Tcl_CreateChannel, Tcl_GetChannelInstanceData, Tcl_GetChannelType, Tcl_GetChannelName, Tcl_GetChannelHandle, Tcl_GetChannelMode, Tcl_GetChannelBufferSize, Tcl_SetChannelBufferSize, Tcl_NotifyChannel, Tcl_BadChannelOption, Tcl_ChannelName, Tcl_ChannelVersion, Tcl_ChannelBlockModeProc, Tcl_ChannelCloseProc, Tcl_ChannelClose2Proc, Tcl_ChannelInputProc, Tcl_ChannelOutputProc, Tcl_ChannelSeekProc, Tcl_ChannelWideSeekProc, Tcl_ChannelTruncateProc, Tcl_ChannelSetOptionProc, Tcl_ChannelGetOptionProc, Tcl_ChannelWatchProc, Tcl_ChannelGetHandleProc, Tcl_ChannelFlushProc, Tcl_ChannelHandlerProc, Tcl_ChannelThreadActionProc, Tcl_IsChannelShared, Tcl_IsChannelRegistered, Tcl_CutChannel, Tcl_SpliceChannel, Tcl_IsChannelExisting, Tcl_ClearChannelHandlers, Tcl_GetChannelThread, Tcl_ChannelBuffered \- procedures for creating and manipulating channels
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Channel
\fBTcl_CreateChannel\fR(\fItypePtr, channelName, instanceData, mask\fR)
.sp
void *
ClientData
\fBTcl_GetChannelInstanceData\fR(\fIchannel\fR)
.sp
const Tcl_ChannelType *
Tcl_ChannelType *
\fBTcl_GetChannelType\fR(\fIchannel\fR)
.sp
const char *
\fBTcl_GetChannelName\fR(\fIchannel\fR)
.sp
int
\fBTcl_GetChannelHandle\fR(\fIchannel, direction, handlePtr\fR)
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
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







+
+
+









+
+
+






+


+







.sp
Tcl_ChannelTypeVersion
\fBTcl_ChannelVersion\fR(\fItypePtr\fR)
.sp
Tcl_DriverBlockModeProc *
\fBTcl_ChannelBlockModeProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverCloseProc *
\fBTcl_ChannelCloseProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverClose2Proc *
\fBTcl_ChannelClose2Proc\fR(\fItypePtr\fR)
.sp
Tcl_DriverInputProc *
\fBTcl_ChannelInputProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverOutputProc *
\fBTcl_ChannelOutputProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverSeekProc *
\fBTcl_ChannelSeekProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverWideSeekProc *
\fBTcl_ChannelWideSeekProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverThreadActionProc *
\fBTcl_ChannelThreadActionProc\fR(\fItypePtr\fR)
.sp
.VS 8.5
Tcl_DriverTruncateProc *
\fBTcl_ChannelTruncateProc\fR(\fItypePtr\fR)
.VE 8.5
.sp
Tcl_DriverSetOptionProc *
\fBTcl_ChannelSetOptionProc\fR(\fItypePtr\fR)
.sp
Tcl_DriverGetOptionProc *
\fBTcl_ChannelGetOptionProc\fR(\fItypePtr\fR)
.sp
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
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







-
+
-
-
-
+










-
+

















+

+







.AS "const Tcl_ChannelType" *channelName
.AP "const Tcl_ChannelType" *typePtr in
Points to a structure containing the addresses of procedures that
can be called to perform I/O and other functions on the channel.
.AP "const char" *channelName in
The name of this channel, such as \fBfile3\fR; must not be in use
by any other channel. Can be NULL, in which case the channel is
created without a name. If the created channel is assigned to one
created without a name.
of the standard channels (\fBstdin\fR, \fBstdout\fR or \fBstderr\fR),
the assigned channel name will be the name of the standard channel.
.AP void *instanceData in
.AP ClientData instanceData in
Arbitrary one-word value to be associated with this channel.  This
value is passed to procedures in \fItypePtr\fR when they are invoked.
.AP int mask in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
whether a channel is readable and writable.
.AP Tcl_Channel channel in
The channel to operate on.
.AP int direction in
\fBTCL_READABLE\fR means the input handle is wanted; \fBTCL_WRITABLE\fR
means the output handle is wanted.
.AP void **handlePtr out
.AP ClientData *handlePtr out
Points to the location where the desired OS-specific handle should be
stored.
.AP int size in
The size, in bytes, of buffers to allocate in this channel.
.AP int mask in
An OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR that indicates events that have occurred on
this channel.
.AP Tcl_Interp *interp in
Current interpreter. (can be NULL)
.AP "const char" *optionName in
Name of the invalid option.
.AP "const char" *optionList in
Specific options list (space separated words, without
.QW \- )
to append to the standard generic options list.
Can be NULL for generic options error message only.

.BE

.SH DESCRIPTION
.PP
Tcl uses a two-layered channel architecture. It provides a generic upper
layer to enable C and Tcl programs to perform input and output using the
same APIs for a variety of files, devices, sockets etc. The generic C APIs
are described in the manual entry for \fBTcl_OpenFileChannel\fR.
.PP
201
202
203
204
205
206
207
208

209
210
211
212
213
214
215
209
210
211
212
213
214
215

216
217
218
219
220
221
222
223







-
+







.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
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
240
241
242
243
244
245
246
247
248


249
250
251
252
253
254
255
248
249
250
251
252
253
254


255
256
257
258
259
260
261
262
263







-
-
+
+







\fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers
allocated to store input or output in \fIchannel\fR. If the value was not set
by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then
the default value of 4096 is returned.
.PP
\fBTcl_SetChannelBufferSize\fR sets the size, in bytes, of buffers that
will be allocated in subsequent operations on the channel to store input or
output. The \fIsize\fR argument should be between one and one million,
allowing buffers of one byte to one million bytes. If \fIsize\fR is
output. The \fIsize\fR argument should be between ten and one million,
allowing buffers of ten bytes to one million bytes. If \fIsize\fR is
outside this range, \fBTcl_SetChannelBufferSize\fR sets the buffer size to
4096.
.PP
\fBTcl_NotifyChannel\fR is called by a channel driver to indicate to
the generic layer that the events specified by \fImask\fR have
occurred on the channel.  Channel drivers are responsible for invoking
this function whenever the channel handlers need to be called for the
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
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







+
-
+
+

+




+
+
+
-
+
+














-


-
+

-
+


-
+










+

+
-
+
















-
-
+
+
+

+

+




















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

-
+
+
+
+
+
+
+
+







-
-
+
+







name is registered in the (thread)-global list of all channels (result
== 1) or not (result == 0).
.PP
\fBTcl_CutChannel\fR removes the specified \fIchannel\fR from the
(thread)global list of all channels (of the current thread).
Application to a channel still registered in some interpreter
is not allowed.
.VS 8.5
Also notifies the driver if
Also notifies the driver if the \fBTcl_ChannelType\fR version is
\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
\fBTcl_DriverThreadActionProc\fR is defined for it.
.VE 8.5
.PP
\fBTcl_SpliceChannel\fR adds the specified \fIchannel\fR to the
(thread)global list of all channels (of the current thread).
Application to a channel registered in some interpreter is not allowed.
.VS 8.5
Also notifies the driver if the \fBTcl_ChannelType\fR version is
\fBTCL_CHANNEL_VERSION_4\fR (or higher), and
Also notifies the driver if \fBTcl_DriverThreadActionProc\fR is defined for it.
\fBTcl_DriverThreadActionProc\fR is defined for it.
.VE 8.5
.PP
\fBTcl_ClearChannelHandlers\fR removes all channel handlers and event
scripts associated with the specified \fIchannel\fR, thus shutting
down all event processing for this channel.
.SH TCL_CHANNELTYPE
.PP
A channel driver provides a \fBTcl_ChannelType\fR structure that contains
pointers to functions that implement the various operations on a channel;
these operations are invoked as needed by the generic layer.  The structure
was versioned starting in Tcl 8.3.2/8.4 to correct a problem with stacked
channel drivers.  See the \fBOLD CHANNEL TYPES\fR section below for
details about the old structure.
.PP
The \fBTcl_ChannelType\fR structure contains the following fields:
.PP
.CS
typedef struct Tcl_ChannelType {
        const char *\fItypeName\fR;
        char *\fItypeName\fR;
        Tcl_ChannelTypeVersion \fIversion\fR;
        void *\fIcloseProc\fR; /* Not used any more*/
        Tcl_DriverCloseProc *\fIcloseProc\fR;
        Tcl_DriverInputProc *\fIinputProc\fR;
        Tcl_DriverOutputProc *\fIoutputProc\fR;
        void *\fIseekProc\fR; /* Not used any more */
        Tcl_DriverSeekProc *\fIseekProc\fR;
        Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
        Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
        Tcl_DriverWatchProc *\fIwatchProc\fR;
        Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
        Tcl_DriverClose2Proc *\fIclose2Proc\fR;
        Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
        Tcl_DriverFlushProc *\fIflushProc\fR;
        Tcl_DriverHandlerProc *\fIhandlerProc\fR;
        Tcl_DriverWideSeekProc *\fIwideSeekProc\fR;
        Tcl_DriverThreadActionProc *\fIthreadActionProc\fR;
.VS 8.5
        Tcl_DriverTruncateProc *\fItruncateProc\fR;
.VE 8.5
} \fBTcl_ChannelType\fR;
} Tcl_ChannelType;
.CE
.PP
It is not necessary to provide implementations for all channel
operations.  Those which are not necessary may be set to NULL in the
struct: \fIblockModeProc\fR, \fIseekProc\fR, \fIsetOptionProc\fR,
\fIgetOptionProc\fR, \fIgetHandleProc\fR, and \fIclose2Proc\fR, in addition to
\fIflushProc\fR, \fIhandlerProc\fR, \fIthreadActionProc\fR, and
\fItruncateProc\fR.  Other functions that cannot be implemented in a
meaningful way should return \fBEINVAL\fR when called, to indicate
that the operations they represent are not available. Also note that
\fIwideSeekProc\fR can be NULL if \fIseekProc\fR is.
.PP
The user should only use the above structure for \fBTcl_ChannelType\fR
instantiation.  When referencing fields in a \fBTcl_ChannelType\fR
structure, the following functions should be used to obtain the values:
\fBTcl_ChannelName\fR, \fBTcl_ChannelVersion\fR,
\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelClose2Proc\fR,
\fBTcl_ChannelInputProc\fR, \fBTcl_ChannelOutputProc\fR,
\fBTcl_ChannelBlockModeProc\fR, \fBTcl_ChannelCloseProc\fR,
\fBTcl_ChannelClose2Proc\fR, \fBTcl_ChannelInputProc\fR,
\fBTcl_ChannelOutputProc\fR, \fBTcl_ChannelSeekProc\fR,
\fBTcl_ChannelWideSeekProc\fR, \fBTcl_ChannelThreadActionProc\fR,
.VS 8.5
\fBTcl_ChannelTruncateProc\fR,
.VE 8.5
\fBTcl_ChannelSetOptionProc\fR, \fBTcl_ChannelGetOptionProc\fR,
\fBTcl_ChannelWatchProc\fR, \fBTcl_ChannelGetHandleProc\fR,
\fBTcl_ChannelFlushProc\fR, or \fBTcl_ChannelHandlerProc\fR.
.PP
The change to the structures was made in such a way that standard channel
types are binary compatible.  However, channel types that use stacked
channels (i.e. TLS, Trf) have new versions to correspond to the above change
since the previous code for stacked channels had problems.
.SS TYPENAME
.PP
The \fItypeName\fR field contains a null-terminated string that
identifies the type of the device implemented by this driver, e.g.
\fBfile\fR or \fBsocket\fR.
.PP
This value can be retrieved with \fBTcl_ChannelName\fR, which returns
a pointer to the string.
.SS VERSION
.PP

The \fIversion\fR field should be set to the version of the structure
that you require. \fBTCL_CHANNEL_VERSION_5\fR is the minimum supported.
that you require. \fBTCL_CHANNEL_VERSION_2\fR is the minimum recommended.
\fBTCL_CHANNEL_VERSION_3\fR must be set to specify the \fIwideSeekProc\fR member.
\fBTCL_CHANNEL_VERSION_4\fR must be set to specify the \fIthreadActionProc\fR member
(includes \fIwideSeekProc\fR).
.VS 8.5
\fBTCL_CHANNEL_VERSION_5\fR must be set to specify the
\fItruncateProc\fR members (includes
\fIwideSeekProc\fR and \fIthreadActionProc\fR).
.VE 8.5
If it is not set to any of these, then this
\fBTcl_ChannelType\fR is assumed to have the original structure.  See
\fBOLD CHANNEL TYPES\fR for more details.  While Tcl will recognize
and function with either structures, stacked channels must be of at
least \fBTCL_CHANNEL_VERSION_2\fR to function correctly.
.PP
This value can be retrieved with \fBTcl_ChannelVersion\fR.
This value can be retrieved with \fBTcl_ChannelVersion\fR, which returns
one of
.VS 8.5
\fBTCL_CHANNEL_VERSION_5\fR,
.VE 8.5
\fBTCL_CHANNEL_VERSION_4\fR,
\fBTCL_CHANNEL_VERSION_3\fR,
\fBTCL_CHANNEL_VERSION_2\fR or \fBTCL_CHANNEL_VERSION_1\fR.
.SS BLOCKMODEPROC
.PP
The \fIblockModeProc\fR field contains the address of a function called by
the generic layer to set blocking and nonblocking mode on the device.
\fIBlockModeProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverBlockModeProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverBlockModeProc(
        ClientData \fIinstanceData\fR,
        int \fImode\fR);
.CE
.PP
The \fIinstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created.  The \fImode\fR
argument is either \fBTCL_MODE_BLOCKING\fR or \fBTCL_MODE_NONBLOCKING\fR to
set the device into blocking or nonblocking mode. The function should
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
450


451
452
453
454
455
456
457
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







-
+

-
+

-
+


-
-
-
+
+
+
-


-
-
-
-
+
+
+
+








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




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

+
-
-
+
+







-
-
+
+







.PP
A channel driver \fBnot\fR supplying a \fIblockModeProc\fR has to be
very, very careful. It has to tell the generic layer exactly which
blocking mode is acceptable to it, and should this also document for
the user so that the blocking mode of the channel is not changed to an
unacceptable value. Any confusion here may lead the interpreter into a
(spurious and difficult to find) deadlock.
.SS "CLOSE2PROC"
.SS "CLOSEPROC AND CLOSE2PROC"
.PP
The \fIclose2Proc\fR field contains the address of a function called by the
The \fIcloseProc\fR field contains the address of a function called by the
generic layer to clean up driver-related information when the channel is
closed. \fIClose2Proc\fR must match the following prototype:
closed. \fICloseProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverClose2Proc\fR(
        void *\fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
typedef int Tcl_DriverCloseProc(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR);
        int \fIflags\fR);
.CE
.PP
If \fIflags\fR is 0, the \fIinstanceData\fR argument is the same as the value
provided to \fBTcl_CreateChannel\fR when the channel was created. The function
should release any storage maintained by the channel driver for this channel,
and close the input and output devices encapsulated by this channel. All queued
The \fIinstanceData\fR argument is the same as the value provided to
\fBTcl_CreateChannel\fR when the channel was created. The function should
release any storage maintained by the channel driver for this channel, and
close the input and output devices encapsulated by this channel. All queued
output will have been flushed to the device before this function is called,
and no further driver operations will be invoked on this instance after
calling the \fIcloseProc\fR. If the close operation is successful, the
procedure should return zero; otherwise it should return a nonzero POSIX
error code. In addition, if an error occurs and \fIinterp\fR is not NULL,
the procedure should store an error message in the interpreter's result.
.PP
Alternatively, channels that support closing the read and write sides
independently may accept other flag values than 0.
Then \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed
independently may set \fIcloseProc\fR to \fBTCL_CLOSE2PROC\fR and set
\fIclose2Proc\fR to the address of a function that matches the
following prototype:
.PP
.CS
typedef int Tcl_DriverClose2Proc(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclose2Proc\fR will be called with \fIflags\fR set to an OR'ed
combination of \fBTCL_CLOSE_READ\fR or \fBTCL_CLOSE_WRITE\fR to
indicate that the driver should close the read and/or write side of
the channel.  The channel driver may be invoked to perform
additional operations on the channel after \fIclose2Proc\fR is
called to close one or both sides of the channel.  In all cases, the
\fIclose2Proc\fR function should return zero if the close operation was
successful; otherwise it should return a nonzero POSIX error code.
In addition, if an error occurs and \fIinterp\fR is not NULL, the procedure
should store an error message in the interpreter's result.
called to close one or both sides of the channel.  If \fIflags\fR is
\fB0\fR (zero), the driver should close the channel in the manner
described above for \fIcloseProc\fR.  No further operations will be
invoked on this instance after \fIclose2Proc\fR is called with all
flags cleared.  In all cases, the \fIclose2Proc\fR function should
return zero if the close operation was successful; otherwise it should
return a nonzero POSIX error code. In addition, if an error occurs and
\fIinterp\fR is not NULL, the procedure should store an error message
in the interpreter's result.
.PP
The \fIcloseProc\fR and \fIclose2Proc\fR values can be retrieved with
The \fIclose2Proc\fR value can be retrieved with \fBTcl_ChannelClose2Proc\fR,
which returns a pointer to the function.
\fBTcl_ChannelCloseProc\fR or \fBTcl_ChannelClose2Proc\fR, which
return a pointer to the respective function.
.SS INPUTPROC
.PP
The \fIinputProc\fR field contains the address of a function called by the
generic layer to read data from the file or device and store it in an
internal buffer. \fIInputProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverInputProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverInputProc(
        ClientData \fIinstanceData\fR,
        char *\fIbuf\fR,
        int \fIbufSize\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when the channel was created.  The \fIbuf\fR
486
487
488
489
490
491
492
493
494


495
496
497
498
499
500
501
539
540
541
542
543
544
545


546
547
548
549
550
551
552
553
554







-
-
+
+







.SS OUTPUTPROC
.PP
The \fIoutputProc\fR field contains the address of a function called by the
generic layer to transfer data from an internal buffer to the output device.
\fIOutputProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverOutputProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverOutputProc(
        ClientData \fIinstanceData\fR,
        const char *\fIbuf\fR,
        int \fItoWrite\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when the channel was created. The \fIbuf\fR
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
611
612
613
614
615

616
617
618
619
620
621
622
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
618
619
620
621
622
623
624
625


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
686
687
688
689

690
691
692
693
694
695
696
697







-
+

-
+

-
+



-
-
-
+
+
+


















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







-
-
+
+
















-
+





-
+


-
-
+
+












-
-
+
+










-
+







.PP
If the channel is nonblocking and the output device is unable to absorb any
data whatsoever, the function should return -1 with an \fBEAGAIN\fR error
without writing any data.
.PP
This value can be retrieved with \fBTcl_ChannelOutputProc\fR, which returns
a pointer to the function.
.SS "WIDESEEKPROC"
.SS "SEEKPROC AND WIDESEEKPROC"
.PP
The \fIwideSeekProc\fR field contains the address of a function called by the
The \fIseekProc\fR field contains the address of a function called by the
generic layer to move the access point at which subsequent input or output
operations will be applied. \fIWideSeekProc\fR must match the following
operations will be applied. \fISeekProc\fR must match the following
prototype:
.PP
.CS
typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR(
        void *\fIinstanceData\fR,
        Tcl_WideInt \fIoffset\fR,
typedef int Tcl_DriverSeekProc(
        ClientData \fIinstanceData\fR,
        long \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The \fIinstanceData\fR argument is the same as the value given to
\fBTcl_CreateChannel\fR when this channel was created.  \fIOffset\fR and
\fIseekMode\fR have the same meaning as for the \fBTcl_Seek\fR
procedure (described in the manual entry for \fBTcl_OpenFileChannel\fR).
.PP
The \fIerrorCodePtr\fR argument points to an integer variable provided by
the generic layer for returning \fBerrno\fR values from the function.  The
function should set this variable to a POSIX error code if an error occurs.
The function should store an \fBEINVAL\fR error code if the channel type
does not implement seeking.
.PP
The return value is the new access point or -1 in case of error. If an
error occurred, the function should not move the access point.
.PP
If there is a non-NULL \fIseekProc\fR field, the \fIwideSeekProc\fR
field may contain the address of an alternative function to use which
handles wide (i.e. larger than 32-bit) offsets, so allowing seeks
within files larger than 2GB.  The \fIwideSeekProc\fR will be called
in preference to the \fIseekProc\fR, but both must be defined if the
\fIwideSeekProc\fR is defined.  \fIWideSeekProc\fR must match the
following prototype:
.PP
.CS
typedef Tcl_WideInt Tcl_DriverWideSeekProc(
        ClientData \fIinstanceData\fR,
        Tcl_WideInt \fIoffset\fR,
        int \fIseekMode\fR,
        int *\fIerrorCodePtr\fR);
.CE
.PP
The arguments and return values mean the same thing as with
\fIseekProc\fR above, except that the type of offsets and the return
type are different.
.PP
The \fIwideSseekProc\fR value can be retrieved with
\fBTcl_ChannelWideSeekProc\fR, which returns a pointer to the function.
The \fIseekProc\fR value can be retrieved with
\fBTcl_ChannelSeekProc\fR, which returns a pointer to the function,
and similarly the \fIwideSeekProc\fR can be retrieved with
\fBTcl_ChannelWideSeekProc\fR.
.SS SETOPTIONPROC
.PP
The \fIsetOptionProc\fR field contains the address of a function called by
the generic layer to set a channel type specific option on a channel.
\fIsetOptionProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverSetOptionProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverSetOptionProc(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoptionName\fR,
        const char *\fInewValue\fR);
.CE
.PP
\fIoptionName\fR is the name of an option to set, and \fInewValue\fR is
the new value for that option, as a string. The \fIinstanceData\fR is the
same as the value given to \fBTcl_CreateChannel\fR when this channel was
created. The function should do whatever channel type specific action is
required to implement the new value of the option.
.PP
Some options are handled by the generic code and this function is never
called to set them, e.g. \fB\-blockmode\fR. Other options are specific to
each channel type and the \fIsetOptionProc\fR procedure of the channel
driver will get called to implement them. The \fIsetOptionProc\fR field can
be NULL, which indicates that this channel type supports no type specific
options.
options. 
.PP
If the option value is successfully modified to the new value, the function
returns \fBTCL_OK\fR.
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized.
unrecognized. 
If \fInewValue\fR specifies a value for the option that
is not supported or if a system call error occurs,
the function should leave an error message in the result
of \fIinterp\fR if \fIinterp\fR is not NULL. The
the function should leave an error message in the
\fIresult\fR field of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
.PP
This value can be retrieved with \fBTcl_ChannelSetOptionProc\fR, which returns
a pointer to the function.
.SS GETOPTIONPROC
.PP
The \fIgetOptionProc\fR field contains the address of a function called by
the generic layer to get the value of a channel type specific option on a
channel. \fIgetOptionProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverGetOptionProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverGetOptionProc(
        ClientData \fIinstanceData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoptionName\fR,
        Tcl_DString *\fIoptionValue\fR);
.CE
.PP
\fIOptionName\fR is the name of an option supported by this type of
channel. If the option name is not NULL, the function stores its current
value, as a string, in the Tcl dynamic string \fIoptionValue\fR.
If \fIoptionName\fR is NULL, the function stores in \fIoptionValue\fR an
alternating list of all supported options and their current values.
On success, the function returns \fBTCL_OK\fR.
On success, the function returns \fBTCL_OK\fR. 
It should call \fBTcl_BadChannelOption\fR which itself returns
\fBTCL_ERROR\fR if the \fIoptionName\fR is
unrecognized. If a system call error occurs,
the function should leave an error message in the
result of \fIinterp\fR if \fIinterp\fR is not NULL. The
function should also call \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.
634
635
636
637
638
639
640
641
642


643
644
645
646
647
648
649
709
710
711
712
713
714
715


716
717
718
719
720
721
722
723
724







-
-
+
+







.PP
The \fIwatchProc\fR field contains the address of a function called
by the generic layer to initialize the event notification mechanism to
notice events of interest on this channel.
\fIWatchProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_DriverWatchProc\fR(
        void *\fIinstanceData\fR,
typedef void Tcl_DriverWatchProc(
        ClientData \fIinstanceData\fR,
        int \fImask\fR);
.CE
.PP
The \fIinstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fImask\fR
argument is an OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR
and \fBTCL_EXCEPTION\fR; it indicates events the caller is interested in
665
666
667
668
669
670
671
672
673


674
675

676
677
678
679
680
681
682
740
741
742
743
744
745
746


747
748
749

750
751
752
753
754
755
756
757







-
-
+
+

-
+







.SS GETHANDLEPROC
.PP
The \fIgetHandleProc\fR field contains the address of a function called by
the generic layer to retrieve a device-specific handle from the channel.
\fIGetHandleProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverGetHandleProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverGetHandleProc(
        ClientData \fIinstanceData\fR,
        int \fIdirection\fR,
        void **\fIhandlePtr\fR);
        ClientData *\fIhandlePtr\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created. The \fIdirection\fR
argument is either \fBTCL_READABLE\fR to retrieve the handle used
for input, or \fBTCL_WRITABLE\fR to retrieve the handle used for
output.
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
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







-
-
+
+













-
-
+
+







.SS FLUSHPROC
.PP
The \fIflushProc\fR field is currently reserved for future use.
It should be set to NULL.
\fIFlushProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverFlushProc\fR(
        void *\fIinstanceData\fR);
typedef int Tcl_DriverFlushProc(
        ClientData \fIinstanceData\fR);
.CE
.PP
This value can be retrieved with \fBTcl_ChannelFlushProc\fR, which returns
a pointer to the function.
.SS HANDLERPROC
.PP
The \fIhandlerProc\fR field contains the address of a function called by
the generic layer to notify the channel that an event occurred.  It should
be defined for stacked channel drivers that wish to be notified of events
that occur on the underlying (stacked) channel.
\fIHandlerProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_DriverHandlerProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverHandlerProc(
        ClientData \fIinstanceData\fR,
        int \fIinterestMask\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to \fBTcl_CreateChannel\fR
when this channel was created.  The \fIinterestMask\fR is an OR-ed
combination of \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR; it indicates what
type of event occurred on this channel.
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
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







-
-
-
+
+
+














-
-
+
+
















-
+






-
+



-
+



















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


+


.PP
The action \fITCL_CHANNEL_THREAD_INSERT\fR is used to notify the
driver that it should update or initialize any thread-specific data it
might be maintaining using the calling thread as the associate. See
\fBTcl_CutChannel\fR and \fBTcl_SpliceChannel\fR for more detail.
.PP
.CS
typedef void \fBTcl_DriverThreadActionProc\fR(
        void *\fIinstanceData\fR,
        int \fIaction\fR);
typedef void Tcl_DriverThreadActionProc(
        ClientData \fIinstanceData\fR,
        int        \fIaction\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created.
.PP
These values can be retrieved with \fBTcl_ChannelThreadActionProc\fR,
which returns a pointer to the function.
.SS "TRUNCATEPROC"
.PP
The \fItruncateProc\fR field contains the address of the function
called by the generic layer when a channel is truncated to some
length. It can be NULL.
.PP
.CS
typedef int \fBTcl_DriverTruncateProc\fR(
        void *\fIinstanceData\fR,
typedef int Tcl_DriverTruncateProc(
        ClientData \fIinstanceData\fR,
        Tcl_WideInt \fIlength\fR);
.CE
.PP
\fIInstanceData\fR is the same as the value passed to
\fBTcl_CreateChannel\fR when this channel was created, and
\fIlength\fR is the new length of the underlying file, which should
not be negative. The result should be 0 on success or an errno code
(suitable for use with \fBTcl_SetErrno\fR) on failure.
.PP
These values can be retrieved with \fBTcl_ChannelTruncateProc\fR,
which returns a pointer to the function.
.SH TCL_BADCHANNELOPTION
.PP
This procedure generates a
.QW "bad option"
error message in an
(optional) interpreter.  It is used by channel drivers when
(optional) interpreter.  It is used by channel drivers when 
an invalid Set/Get option is requested. Its purpose is to concatenate
the generic options list to the specific ones and factorize
the generic options error message string.
.PP
It always returns \fBTCL_ERROR\fR
.PP
An error message is generated in \fIinterp\fR's result value to
An error message is generated in \fIinterp\fR's result object to
indicate that a command was invoked with a bad option.
The message has the form
.CS
    bad option "blah": should be one of
    bad option "blah": should be one of 
    <...generic options...>+<...specific options...>
.CE
so you get for instance:
.CS
    bad option "-blah": should be one of -blocking,
    -buffering, -buffersize, -eofchar, -translation,
    -peername, or -sockname
.CE
when called with \fIoptionList\fR equal to
.QW "peername sockname"
.PP
.QW blah
is the \fIoptionName\fR argument and
.QW "<specific options>"
is a space separated list of specific option words.
The function takes good care of inserting minus signs before
each option, commas after, and an
.QW or
before the last option.
.SH "OLD CHANNEL TYPES"
The original (8.3.1 and below) \fBTcl_ChannelType\fR structure contains
the following fields:
.PP
.CS
typedef struct Tcl_ChannelType {
        char *\fItypeName\fR;
        Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
        Tcl_DriverCloseProc *\fIcloseProc\fR;
        Tcl_DriverInputProc *\fIinputProc\fR;
        Tcl_DriverOutputProc *\fIoutputProc\fR;
        Tcl_DriverSeekProc *\fIseekProc\fR;
        Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
        Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
        Tcl_DriverWatchProc *\fIwatchProc\fR;
        Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
        Tcl_DriverClose2Proc *\fIclose2Proc\fR;
} Tcl_ChannelType;
.CE
.PP
It is still possible to create channel with the above structure.  The
internal channel code will determine the version.  It is imperative to use
the new \fBTcl_ChannelType\fR structure if you are creating a stacked
channel driver, due to problems with the earlier stacked channel
implementation (in 8.2.0 to 8.3.1).
.PP
Prior to 8.4.0 (i.e. during the later releases of 8.3 and early part
of the 8.4 development cycle) the \fBTcl_ChannelType\fR structure
contained the following fields:
.PP
.CS
typedef struct Tcl_ChannelType {
        char *\fItypeName\fR;
        Tcl_ChannelTypeVersion \fIversion\fR;
        Tcl_DriverCloseProc *\fIcloseProc\fR;
        Tcl_DriverInputProc *\fIinputProc\fR;
        Tcl_DriverOutputProc *\fIoutputProc\fR;
        Tcl_DriverSeekProc *\fIseekProc\fR;
        Tcl_DriverSetOptionProc *\fIsetOptionProc\fR;
        Tcl_DriverGetOptionProc *\fIgetOptionProc\fR;
        Tcl_DriverWatchProc *\fIwatchProc\fR;
        Tcl_DriverGetHandleProc *\fIgetHandleProc\fR;
        Tcl_DriverClose2Proc *\fIclose2Proc\fR;
        Tcl_DriverBlockModeProc *\fIblockModeProc\fR;
        Tcl_DriverFlushProc *\fIflushProc\fR;
        Tcl_DriverHandlerProc *\fIhandlerProc\fR;
        Tcl_DriverTruncateProc *\fItruncateProc\fR;
} Tcl_ChannelType;
.CE
.PP
When the above structure is registered as a channel type, the
\fIversion\fR field should always be \fBTCL_CHANNEL_VERSION_2\fR.

.SH "SEE ALSO"
Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3), Tcl_QueueEvent(3), Tcl_StackChannel(3), Tcl_GetStdChannel(3)

.SH KEYWORDS
blocking, channel driver, channel registration, channel type, nonblocking

Changes to doc/CrtChnlHdlr.3.

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
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







-
+


+










-

-
-
+
+







.AP int mask in
Conditions under which \fIproc\fR should be called: OR-ed combination of
\fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR and \fBTCL_EXCEPTION\fR. Specify
a zero value to temporarily disable an existing handler.
.AP Tcl_FileProc *proc in
Procedure to invoke whenever the channel indicated by \fIchannel\fR meets
the conditions specified by \fImask\fR.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_CreateChannelHandler\fR arranges for \fIproc\fR to be called in the
future whenever input or output becomes possible on the channel identified
by \fIchannel\fR, or whenever an exceptional condition exists for
\fIchannel\fR. The conditions of interest under which \fIproc\fR will be
invoked are specified by the \fImask\fR argument.
See the manual entry for \fBfileevent\fR for a precise description of
what it means for a channel to be readable or writable.
\fIProc\fR must conform to the following prototype:
.PP
.CS
typedef void \fBTcl_ChannelProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_ChannelProc(
        ClientData \fIclientData\fR,
        int \fImask\fR);
.CE
.PP
The \fIclientData\fR argument is the same as the value passed to
\fBTcl_CreateChannelHandler\fR when the handler was created. Typically,
\fIclientData\fR points to a data structure containing application-specific
information about the channel. \fIMask\fR is an integer mask indicating
79
80
81
82
83
84
85

86
87

88
89
79
80
81
82
83
84
85
86
87
88
89
90
91







+


+


to \fIproc\fR may no longer exist when \fIproc\fR is invoked:  for
example, if there are two handlers for \fBTCL_READABLE\fR on the same
channel, the first handler could consume all of the available input
so that the channel is no longer readable when the second handler
is invoked.
For this reason it may be useful to use nonblocking I/O on channels
for which there are event handlers.

.SH "SEE ALSO"
Notifier(3), Tcl_CreateChannel(3), Tcl_OpenFileChannel(3), vwait(n).

.SH KEYWORDS
blocking, callback, channel, events, handler, nonblocking.

Changes to doc/CrtCloseHdlr.3.

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
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







-
+


+








-
-
+
+










+


+


.sp
.SH ARGUMENTS
.AS Tcl_CloseProc clientData
.AP Tcl_Channel channel in
The channel for which to create or delete a close callback.
.AP Tcl_CloseProc *proc in
The procedure to call as the callback.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_CreateCloseHandler\fR arranges for \fIproc\fR to be called when
\fIchannel\fR is closed with \fBTcl_Close\fR or
\fBTcl_UnregisterChannel\fR, or using the Tcl \fBclose\fR command.
\fIProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_CloseProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_CloseProc(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR is the same as the value provided in the call to
\fBTcl_CreateCloseHandler\fR.
.PP
\fBTcl_DeleteCloseHandler\fR removes a close callback for \fIchannel\fR.
The \fIproc\fR and \fIclientData\fR identify which close callback to
remove; \fBTcl_DeleteCloseHandler\fR does nothing if its \fIproc\fR and
\fIclientData\fR arguments do not match the \fIproc\fR and \fIclientData\fR
for a  close handler for \fIchannel\fR.

.SH "SEE ALSO"
close(n), Tcl_Close(3), Tcl_UnregisterChannel(3)

.SH KEYWORDS
callback, channel closing

Changes to doc/CrtCommand.3.

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
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






-
+




















-
+






+









-
-
+
+


-
-
+
+

-
+



-
+
+
+



















-

-
-
+
+




-










-
+












-
+
















-
-
+
+





-

-
-
+
+

-


+

-
-
+
+


'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateCommand \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *deleteProc
.AP Tcl_Interp *interp in
Interpreter in which to create new command.
.AP "const char" *cmdName in
Name of command.
.AP Tcl_CmdProc *proc in
Implementation of new command:  \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP voie *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup.  If NULL, then no procedure is
called before the command is deleted.
.BE

.SH DESCRIPTION
.PP
\fBTcl_CreateCommand\fR defines a new command in \fIinterp\fR and associates
it with procedure \fIproc\fR such that whenever \fIcmdName\fR is
invoked as a Tcl command (via a call to \fBTcl_Eval\fR) the Tcl interpreter
will call \fIproc\fR to process the command.
It differs from \fBTcl_CreateObjCommand\fR in that a new string-based
command is defined;
that is, a command procedure is defined that takes an array of
argument strings instead of values.
The value-based command procedures registered by \fBTcl_CreateObjCommand\fR
argument strings instead of objects.
The object-based command procedures registered by \fBTcl_CreateObjCommand\fR
can execute significantly faster than the string-based command procedures
defined by \fBTcl_CreateCommand\fR.
This is because they take Tcl values as arguments
and those values can retain an internal representation that
This is because they take Tcl objects as arguments
and those objects can retain an internal representation that
can be manipulated more efficiently.
Also, Tcl's interpreter now uses values internally.
Also, Tcl's interpreter now uses objects internally.
In order to invoke a string-based command procedure
registered by \fBTcl_CreateCommand\fR,
it must generate and fetch a string representation
from each argument value before the call.
from each argument object before the call
and create a new Tcl object to hold the string result returned by the
string-based command procedure.
New commands should be defined using \fBTcl_CreateObjCommand\fR.
We support \fBTcl_CreateCommand\fR for backwards compatibility.
.PP
The procedures \fBTcl_DeleteCommand\fR, \fBTcl_GetCommandInfo\fR,
and \fBTcl_SetCommandInfo\fR are used in conjunction with
\fBTcl_CreateCommand\fR.
.PP
\fBTcl_CreateCommand\fR will delete an existing command \fIcmdName\fR,
if one is already associated with the interpreter.
It returns a token that may be used to refer
to the command in subsequent calls to \fBTcl_GetCommandName\fR.
If \fIcmdName\fR contains any \fB::\fR namespace qualifiers,
then the command is added to the specified namespace;
otherwise the command is added to the global namespace.
If \fBTcl_CreateCommand\fR is called for an interpreter that is in
the process of being deleted, then it does not create a new command
and it returns NULL.
\fIProc\fR should have arguments and result that match the type
\fBTcl_CmdProc\fR:
.PP
.CS
typedef int \fBTcl_CmdProc\fR(
        void *\fIclientData\fR,
typedef int Tcl_CmdProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIargc\fR,
        const char *\fIargv\fR[]);
.CE
.PP
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
parameters will be copies of the \fIclientData\fR and \fIinterp\fR
arguments given to \fBTcl_CreateCommand\fR.
Typically, \fIclientData\fR points to an application-specific
data structure that describes what to do when the command procedure
is invoked.  \fIArgc\fR and \fIargv\fR describe the arguments to
the command, \fIargc\fR giving the number of arguments (including
the command name) and \fIargv\fR giving the values of the arguments
as strings.  The \fIargv\fR array will contain \fIargc\fR+1 values;
the first \fIargc\fR values point to the argument strings, and the
last value is NULL.
last value is NULL.  
Note that the argument strings should not be modified as they may
point to constant strings or may be shared with other parts of the
interpreter.
.PP
Note that the argument strings are encoded in normalized UTF-8 since
version 8.1 of Tcl.
.PP
\fIProc\fR must return an integer code that is expected to be one of
\fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or
\fBTCL_CONTINUE\fR.  See the Tcl overview man page
for details on what these codes mean.  Most normal commands will only
return \fBTCL_OK\fR or \fBTCL_ERROR\fR.  In addition, \fIproc\fR must set
the interpreter result;
the interpreter result to point to a string value;
in the case of a \fBTCL_OK\fR return code this gives the result
of the command, and in the case of \fBTCL_ERROR\fR it gives an error message.
The \fBTcl_SetResult\fR procedure provides an easy interface for setting
the return value;  for complete details on how the interpreter result
field is managed, see the \fBTcl_Interp\fR man page.
Before invoking a command procedure,
\fBTcl_Eval\fR sets the interpreter result to point to an empty string,
so simple commands can return an empty result by doing nothing at all.
.PP
The contents of the \fIargv\fR array belong to Tcl and are not
guaranteed to persist once \fIproc\fR returns:  \fIproc\fR should
not modify them, nor should it set the interpreter result to point
anywhere within the \fIargv\fR values.
Call \fBTcl_SetResult\fR with status \fBTCL_VOLATILE\fR if you want
to return something from the \fIargv\fR array.
.PP
\fIDeleteProc\fR will be invoked when (if) \fIcmdName\fR is deleted. This can
occur through a call to \fBTcl_DeleteCommand\fR or \fBTcl_DeleteInterp\fR,
\fIDeleteProc\fR will be invoked when (if) \fIcmdName\fR is deleted.
This can occur through a call to \fBTcl_DeleteCommand\fR or \fBTcl_DeleteInterp\fR,
or by replacing \fIcmdName\fR in another call to \fBTcl_CreateCommand\fR.
\fIDeleteProc\fR is invoked before the command is deleted, and gives the
application an opportunity to release any structures associated
with the command.  \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_CmdDeleteProc(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateCommand\fR.

.SH "SEE ALSO"
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo,
Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_GetCommandInfo, Tcl_SetCommandInfo, Tcl_GetCommandName, Tcl_SetObjResult

.SH KEYWORDS
bind, command, create, delete, interpreter, namespace

Changes to doc/CrtFileHdlr.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateFileHandler, Tcl_DeleteFileHandler \- associate procedure callbacks with files or devices (Unix only)
.SH SYNOPSIS
.nf
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
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







-
+


+
















-

-
-
+
+


-









+




















-
-
+
+
-


Conditions under which \fIproc\fR should be called:
OR-ed combination of \fBTCL_READABLE\fR, \fBTCL_WRITABLE\fR,
and \fBTCL_EXCEPTION\fR.  May be set to 0 to temporarily disable
a handler.
.AP Tcl_FileProc *proc in
Procedure to invoke whenever the file or device indicated
by \fIfile\fR meets the conditions specified by \fImask\fR.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_CreateFileHandler\fR arranges for \fIproc\fR to be
invoked in the future whenever I/O becomes possible on a file
or an exceptional condition exists for the file.  The file
is indicated by \fIfd\fR, and the conditions of interest
are indicated by \fImask\fR.  For example, if \fImask\fR
is \fBTCL_READABLE\fR, \fIproc\fR will be called when
the file is readable.
The callback to \fIproc\fR is made by \fBTcl_DoOneEvent\fR, so
\fBTcl_CreateFileHandler\fR is only useful in programs that dispatch
events through \fBTcl_DoOneEvent\fR or through Tcl commands such
as \fBvwait\fR.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_FileProc\fR:
.PP
.CS
typedef void \fBTcl_FileProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_FileProc(
        ClientData \fIclientData\fR,
        int \fImask\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy
of the \fIclientData\fR
argument given to \fBTcl_CreateFileHandler\fR when the callback
was created.  Typically, \fIclientData\fR points to a data
structure containing application-specific information about
the file.  \fIMask\fR is an integer mask indicating which
of the requested conditions actually exists for the file;  it
will contain a subset of the bits in the \fImask\fR argument
to \fBTcl_CreateFileHandler\fR.
.PP
.PP
There may exist only one handler for a given file at a given time.
If \fBTcl_CreateFileHandler\fR is called when a handler already
exists for \fIfd\fR, then the new callback replaces the information
that was previously recorded.
.PP
\fBTcl_DeleteFileHandler\fR may be called to delete the
file handler for \fIfd\fR;  if no handler exists for the
file given by \fIfd\fR then the procedure has no effect.
.PP
The purpose of file handlers is to enable an application to respond to
events while waiting for files to become ready for I/O.  For this to work
correctly, the application may need to use non-blocking I/O operations on
the files for which handlers are declared.  Otherwise the application may
block if it reads or writes too much data; while waiting for the I/O to
complete the application will not be able to service other events. Use
\fBTcl_SetChannelOption\fR with \fB\-blocking\fR to set the channel into
blocking or nonblocking mode as required.
.PP
Note that these interfaces are only supported by the Unix
implementation of the Tcl notifier.
.SH "SEE ALSO"
implementation of the Tcl notifier.   

fileevent(n), Tcl_CreateTimerHandler(3), Tcl_DoWhenIdle(3)
.SH KEYWORDS
callback, file, handler

Changes to doc/CrtInterp.3.

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
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






-
+




-
+











-
-
-



-
+

+



-
+

-
-
-
+
+
+
+
-

-
-
+
+
-





-
+



















-
+
-
-
-
-
-
-



















-
+
-






-
+
-










-
+
-

-
-
+
+
-
-


-
+










-
+
-
-
-
-


+


'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_CreateInterp 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateInterp, Tcl_DeleteInterp, Tcl_InterpActive, Tcl_InterpDeleted \- create and delete Tcl command interpreters
Tcl_CreateInterp, Tcl_DeleteInterp, Tcl_InterpDeleted \- create and delete Tcl command interpreters
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Interp *
\fBTcl_CreateInterp\fR()
.sp
\fBTcl_DeleteInterp\fR(\fIinterp\fR)
.sp
int
\fBTcl_InterpDeleted\fR(\fIinterp\fR)
.sp
int
\fBTcl_InterpActive\fR(\fIinterp\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Token for interpreter to be destroyed or queried.
Token for interpreter to be destroyed.
.BE

.SH DESCRIPTION
.PP
\fBTcl_CreateInterp\fR creates a new interpreter structure and returns
a token for it. The token is required in calls to most other Tcl
a token for it.  The token is required in calls to most other Tcl
procedures, such as \fBTcl_CreateCommand\fR, \fBTcl_Eval\fR, and
\fBTcl_DeleteInterp\fR.  The token returned by \fBTcl_CreateInterp\fR
may only be passed to Tcl routines called from the same thread as
the original \fBTcl_CreateInterp\fR call.  It is not safe for multiple
\fBTcl_DeleteInterp\fR.
Clients are only allowed to access a few of the fields of
Tcl_Interp structures;  see the \fBTcl_Interp\fR
and \fBTcl_CreateCommand\fR man pages for details.
threads to pass the same token to Tcl's routines.
The new interpreter is initialized with the built-in Tcl commands
and with standard variables like \fBtcl_platform\fR and \fBenv\fR. To
bind in additional commands, call \fBTcl_CreateCommand\fR, and to
and with the variables documented in tclvars(n).  To bind in
additional commands, call \fBTcl_CreateCommand\fR.
create additional variables, call \fBTcl_SetVar\fR.
.PP
\fBTcl_DeleteInterp\fR marks an interpreter as deleted; the interpreter
will eventually be deleted when all calls to \fBTcl_Preserve\fR for it have
been matched by calls to \fBTcl_Release\fR. At that time, all of the
resources associated with it, including variables, procedures, and
application-specific command bindings, will be deleted. After
application-specific command bindings, will be deleted.  After
\fBTcl_DeleteInterp\fR returns any attempt to use \fBTcl_Eval\fR on the
interpreter will fail and return \fBTCL_ERROR\fR. After the call to
\fBTcl_DeleteInterp\fR it is safe to examine the interpreter's result,
query or set the values of variables, define, undefine or retrieve
procedures, and examine the runtime evaluation stack. See below, in the
section \fBINTERPRETERS AND MEMORY MANAGEMENT\fR for details.
.PP
\fBTcl_InterpDeleted\fR returns nonzero if \fBTcl_DeleteInterp\fR was
called with \fIinterp\fR as its argument; this indicates that the
interpreter will eventually be deleted, when the last call to
\fBTcl_Preserve\fR for it is matched by a call to \fBTcl_Release\fR. If
nonzero is returned, further calls to \fBTcl_Eval\fR in this interpreter
will return \fBTCL_ERROR\fR.
.PP
\fBTcl_InterpDeleted\fR is useful in deletion callbacks to distinguish
between when only the memory the callback is responsible for is being
deleted and when the whole interpreter is being deleted. In the former case
the callback may recreate the data being deleted, but this would lead to an
infinite loop if the interpreter were being deleted.
.PP

\fBTcl_InterpActive\fR is useful for determining whether there is any
execution of scripts ongoing in an interpreter, which is a useful piece of
information when Tcl is embedded in a garbage-collected environment and it
becomes necessary to determine whether the interpreter is a candidate for
deletion. The function returns a true value if the interpreter has at least
one active execution running inside it, and a false value otherwise.
.SH "INTERPRETERS AND MEMORY MANAGEMENT"
.PP
\fBTcl_DeleteInterp\fR can be called at any time on an interpreter that may
be used by nested evaluations and C code in various extensions. Tcl
implements a simple mechanism that allows callers to use interpreters
without worrying about the interpreter being deleted in a nested call, and
without requiring special code to protect the interpreter, in most cases.
This mechanism ensures that nested uses of an interpreter can safely
continue using it even after \fBTcl_DeleteInterp\fR is called.
.PP
The mechanism relies on matching up calls to \fBTcl_Preserve\fR with calls
to \fBTcl_Release\fR. If \fBTcl_DeleteInterp\fR has been called, only when
the last call to \fBTcl_Preserve\fR is matched by a call to
\fBTcl_Release\fR, will the interpreter be freed. See the manual entry for
\fBTcl_Preserve\fR for a description of these functions.
.PP
The rules for when the user of an interpreter must call \fBTcl_Preserve\fR
and \fBTcl_Release\fR are simple:
.TP
\fBInterpreters Passed As Arguments\fR
Interpreters Passed As Arguments
.
Functions that are passed an interpreter as an argument can safely use the
interpreter without any special protection. Thus, when you write an
extension consisting of new Tcl commands, no special code is needed to
protect interpreters received as arguments. This covers the majority of all
uses.
.TP
\fBInterpreter Creation And Deletion\fR
Interpreter Creation And Deletion
.
When a new interpreter is created and used in a call to \fBTcl_Eval\fR,
\fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or
\fBTcl_GetVar\fR, a pair of calls to \fBTcl_Preserve\fR and
\fBTcl_Release\fR should be wrapped around all uses of the interpreter.
Remember that it is unsafe to use the interpreter once \fBTcl_Release\fR
has been called. To ensure that the interpreter is properly deleted when
it is no longer needed, call \fBTcl_InterpDeleted\fR to test if some other
code already called \fBTcl_DeleteInterp\fR; if not, call
\fBTcl_DeleteInterp\fR before calling \fBTcl_Release\fR in your own code.
.TP
\fBRetrieving An Interpreter From A Data Structure\fR
Retrieving An Interpreter From A Data Structure
.
When an interpreter is retrieved from a data structure (e.g. the client
data of a callback) for use in one of the evaluation functions
(\fBTcl_Eval\fR, \fBTcl_VarEval\fR, \fBTcl_GlobalEval\fR, \fBTcl_EvalObjv\fR,
data of a callback) for use in \fBTcl_Eval\fR, \fBTcl_VarEval\fR,
\fBTcl_GlobalEval\fR, \fBTcl_SetVar\fR, or \fBTcl_GetVar\fR, a pair of
etc.) or variable access functions (\fBTcl_SetVar\fR, \fBTcl_GetVar\fR,
\fBTcl_SetVar2Ex\fR, etc.), a pair of
calls to \fBTcl_Preserve\fR and \fBTcl_Release\fR should be wrapped around
all uses of the interpreter; it is unsafe to reuse the interpreter once
\fBTcl_Release\fR has been called. If an interpreter is stored inside a
\fBTcl_Release\fR has been called.  If an interpreter is stored inside a
callback data structure, an appropriate deletion cleanup mechanism should
be set up by the code that creates the data structure so that the
interpreter is removed from the data structure (e.g. by setting the field
to NULL) when the interpreter is deleted. Otherwise, you may be using an
interpreter that has been freed and whose memory may already have been
reused.
.PP
All uses of interpreters in Tcl and Tk have already been protected.
Extension writers should ensure that their code also properly protects any
additional interpreters used, as described above.
.PP

Note that the protection mechanisms do not work well with conventional garbage
collection systems. When in such a managed environment, \fBTcl_InterpActive\fR
should be used to determine when an interpreter is a candidate for deletion
due to inactivity.
.SH "SEE ALSO"
Tcl_Preserve(3), Tcl_Release(3)

.SH KEYWORDS
command, create, delete, interpreter

Added doc/CrtMathFnc.3.





























































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR)
.sp
int
\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr,
                    clientDataPtr\fR)
.sp
Tcl_Obj *
\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR)
.SH ARGUMENTS
.AS Tcl_ValueType *clientDataPtr out
.AP Tcl_Interp *interp in
Interpreter in which new function will be defined.
.AP "const char" *name in
Name for new function.
.AP int numArgs in
Number of arguments to new function;  also gives size of \fIargTypes\fR array.
.AP Tcl_ValueType *argTypes in
Points to an array giving the permissible types for each argument to
function.
.AP Tcl_MathProc *proc in
Procedure that implements the function.
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR when it is invoked.
.AP int *numArgsPtr out
Points to a variable that will be set to contain the number of
arguments to the function.
.AP Tcl_ValueType **argTypesPtr out
Points to a variable that will be set to contain a pointer to an array
giving the permissible types for each argument to the function which
will need to be freed up using \fITcl_Free\fR.
.AP Tcl_MathProc **procPtr out
Points to a variable that will be set to contain a pointer to the
implementation code for the function (or NULL if the function is
implemented directly in bytecode).
.AP ClientData *clientDataPtr out
Points to a variable that will be set to contain the clientData
argument passed to \fITcl_CreateMathFunc\fR when the function was
created if the function is not implemented directly in bytecode.
.AP "const char" *pattern in
Pattern to match against function names so as to filter them (by
passing to \fITcl_StringMatch\fR), or NULL to not apply any filter.
.BE

.SH DESCRIPTION
.PP
Tcl allows a number of mathematical functions to be used in
expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR.
These functions are represented by commands in the namespace,
\fBtcl::mathfunc\fR.  The \fBTcl_CreateMathFunc\fR function is
an obsolete way for applications to add additional functions
to those already provided by Tcl or to replace existing functions.
It should not be used by new applications, which should create
math functions using \fBTcl_CreateObjCommand\fR to create a command
in the \fBtcl::mathfunc\fR namespace.
.PP
In the \fBTcl_CreateMathFunc\fR interface,
\fIName\fR is the name of the function as it will appear in expressions.
If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR
namespace, then a new command is created in that namespace.
If \fIname\fR does exist, then the existing function is replaced.
\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function.
Each entry in the \fIargTypes\fR array must be
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR,
or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an
integer, a double-precision floating value, a wide (64-bit) integer,
or any, respectively.
.PP
Whenever the function is invoked in an expression Tcl will invoke
\fIproc\fR.  \fIProc\fR should have arguments and result that match
the type \fBTcl_MathProc\fR:
.CS
typedef int Tcl_MathProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        Tcl_Value *\fIargs\fR,
        Tcl_Value *\fIresultPtr\fR);
.CE
.PP
When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR
arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR.
\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures,
which describe the actual arguments to the function:
.CS
typedef struct Tcl_Value {
        Tcl_ValueType \fItype\fR;
        long \fIintValue\fR;
        double \fIdoubleValue\fR;
        Tcl_WideInt \fIwideValue\fR;
} Tcl_Value;
.CE
.PP
The \fItype\fR field indicates the type of the argument and is
one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR.
It will match the \fIargTypes\fR value specified for the function unless
the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts
the argument supplied in the expression to the type requested in
\fIargTypes\fR, if that is necessary.
Depending on the value of the \fItype\fR field, the \fIintValue\fR,
\fIdoubleValue\fR or \fIwideValue\fR
field will contain the actual value of the argument.
.PP
\fIProc\fR should compute its result and store it either as an integer
in \fIresultPtr->intValue\fR or as a floating value in
\fIresultPtr->doubleValue\fR.
It should set also \fIresultPtr->type\fR to one of
\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR
to indicate which value was set.
Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR.
If an error occurs while executing the function, \fIproc\fR should
return \fBTCL_ERROR\fR and leave an error message in the interpreter's result.
.PP
\fBTcl_GetMathFuncInfo\fR retrieves the values associated with
function \fIname\fR that were passed to a preceding
\fBTcl_CreateMathFunc\fR call.  Normally, the return code is
\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR
is returned and an error message is placed in the interpreter's
result.
.PP
If an error did not occur, the array reference placed in the variable
pointed to by \fIargTypesPtr\fR is newly allocated, and should be
released by passing it to \fBTcl_Free\fR.  Some functions (the
standard set implemented in the core, and those defined by placing
commands in the \fBtcl::mathfunc\fR namespace) do not have
argument type information; attempting to retrieve values for
them causes a NULL to be stored in the variable pointed to by 
\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR
will not be modified.  The variable pointed to by \fInumArgsPointer\fR
will contain -1, and no argument types will be stored in the variable
pointed to by \fIargTypesPointer\fR.
.PP
\fBTcl_ListMathFuncs\fR returns a Tcl object containing a list of all
the math functions defined in the interpreter whose name matches
\fIpattern\fR.  The returned object has a reference count of zero.

.SH "SEE ALSO"
expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3)

.SH KEYWORDS
expression, mathematical function

Changes to doc/CrtObjCmd.3.

1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5

6
7
8
9
10

11
12
13
14
15
16
17
18





-
+




-
+







'\"
'\" Copyright (c) 1996-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.
'\"
'\" 
.TH Tcl_CreateObjCommand 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj, Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateObjCommand\fR(\fIinterp, cmdName, proc, clientData, deleteProc\fR)
.sp
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
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







-
-
-
-
-
-
-
-









-
+












-
+
-
-
-







\fBTcl_GetCommandName\fR(\fIinterp, token\fR)
.sp
void
\fBTcl_GetCommandFullName\fR(\fIinterp, token, objPtr\fR)
.sp
Tcl_Command
\fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)
.sp
.VS "info cmdtype feature"
void
\fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR)
.sp
const char *
\fBTcl_GetCommandTypeName\fR(\fItoken\fR)
.VE "info cmdtype feature"
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *deleteProc in/out
.AP Tcl_Interp *interp in
Interpreter in which to create a new command or that contains a command.
.AP char *cmdName in
Name of command.
.AP Tcl_ObjCmdProc *proc in
Implementation of the new command: \fIproc\fR will be called whenever
\fIcmdName\fR is invoked as a command.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR and \fIdeleteProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in
Procedure to call before \fIcmdName\fR is deleted from the interpreter;
allows for command-specific cleanup. If NULL, then no procedure is
called before the command is deleted.
.AP Tcl_Command token in
Token for command, returned by previous call to \fBTcl_CreateObjCommand\fR.
The command must not have been deleted.
.AP Tcl_CmdInfo *infoPtr in/out
Pointer to structure containing various information about a
Tcl command.
.AP Tcl_Obj *objPtr in
Value containing the name of a Tcl command.
Object containing the name of a Tcl command.
.AP "const char" *typeName in
Indicates the name of the type of command implementation associated
with a particular \fIproc\fR, or NULL to break the association.
.BE
.SH DESCRIPTION
.PP
\fBTcl_CreateObjCommand\fR defines a new command in \fIinterp\fR
and associates it with procedure \fIproc\fR
such that whenever \fIname\fR is
invoked as a Tcl command (e.g., via a call to \fBTcl_EvalObjEx\fR)
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
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







-

-
-
+
+




-





-
+


-
+









-
+

-
+















-
+
















-
+










-

-
-
+
+

-







then the command is added to the specified namespace;
otherwise the command is added to the global namespace.
If \fBTcl_CreateObjCommand\fR is called for an interpreter that is in
the process of being deleted, then it does not create a new command
and it returns NULL.
\fIproc\fR should have arguments and result that match the type
\fBTcl_ObjCmdProc\fR:
.PP
.CS
typedef int \fBTcl_ObjCmdProc\fR(
        void *\fIclientData\fR,
typedef int Tcl_ObjCmdProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIobjc\fR,
        Tcl_Obj *const \fIobjv\fR[]);
.CE
.PP
When \fIproc\fR is invoked, the \fIclientData\fR and \fIinterp\fR parameters
will be copies of the \fIclientData\fR and \fIinterp\fR arguments given to
\fBTcl_CreateObjCommand\fR.  Typically, \fIclientData\fR points to an
application-specific data structure that describes what to do when the
command procedure is invoked. \fIObjc\fR and \fIobjv\fR describe the
arguments to the command, \fIobjc\fR giving the number of argument values
arguments to the command, \fIobjc\fR giving the number of argument objects
(including the command name) and \fIobjv\fR giving the values of the
arguments.  The \fIobjv\fR array will contain \fIobjc\fR values, pointing to
the argument values.  Unlike \fIargv\fR[\fIargv\fR] used in a
the argument objects.  Unlike \fIargv\fR[\fIargv\fR] used in a
string-based command procedure, \fIobjv\fR[\fIobjc\fR] will not contain NULL.
.PP
Additionally, when \fIproc\fR is invoked, it must not modify the contents
of the \fIobjv\fR array by assigning new pointer values to any element of the
array (for example, \fIobjv\fR[\fB2\fR] = \fBNULL\fR) because this will
cause memory to be lost and the runtime stack to be corrupted.  The
\fBconst\fR in the declaration of \fIobjv\fR will cause ANSI-compliant
compilers to report any such attempted assignment as an error.  However,
it is acceptable to modify the internal representation of any individual
value argument.  For instance, the user may call
object argument.  For instance, the user may call
\fBTcl_GetIntFromObj\fR on \fIobjv\fR[\fB2\fR] to obtain the integer
representation of that value; that call may change the type of the value
representation of that object; that call may change the type of the object
that \fIobjv\fR[\fB2\fR] points at, but will not change where
\fIobjv\fR[\fB2\fR] points.
.PP
\fIproc\fR must return an integer code that is either \fBTCL_OK\fR,
\fBTCL_ERROR\fR, \fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR.
See the Tcl overview man page
for details on what these codes mean.  Most normal commands will only
return \fBTCL_OK\fR or \fBTCL_ERROR\fR.
In addition, if \fIproc\fR needs to return a non-empty result,
it can call \fBTcl_SetObjResult\fR to set the interpreter's result.
In the case of a \fBTCL_OK\fR return code this gives the result
of the command,
and in the case of \fBTCL_ERROR\fR this gives an error message.
Before invoking a command procedure,
\fBTcl_EvalObjEx\fR sets interpreter's result to
point to a value representing an empty string, so simple
point to an object representing an empty string, so simple
commands can return an empty result by doing nothing at all.
.PP
The contents of the \fIobjv\fR array belong to Tcl and are not
guaranteed to persist once \fIproc\fR returns: \fIproc\fR should
not modify them.
Call \fBTcl_SetObjResult\fR if you want
to return something from the \fIobjv\fR array.
.PP
Ordinarily, \fBTcl_CreateObjCommand\fR deletes any existing command
\fIname\fR already associated with the interpreter.
However, if the existing command was created by a previous call to
\fBTcl_CreateCommand\fR,
\fBTcl_CreateObjCommand\fR does not delete the command
but instead arranges for the Tcl interpreter to call the
\fBTcl_ObjCmdProc\fR \fIproc\fR in the future.
The old string-based \fBTcl_CmdProc\fR associated with the command
is retained and its address can be obtained by subsequent
is retained and its address can be obtained by subsequent 
\fBTcl_GetCommandInfo\fR calls. This is done for backwards compatibility.
.PP
\fIDeleteProc\fR will be invoked when (if) \fIname\fR is deleted.
This can occur through a call to \fBTcl_DeleteCommand\fR,
\fBTcl_DeleteCommandFromToken\fR, or \fBTcl_DeleteInterp\fR,
or by replacing \fIname\fR in another call to \fBTcl_CreateObjCommand\fR.
\fIDeleteProc\fR is invoked before the command is deleted, and gives the
application an opportunity to release any structures associated
with the command.  \fIDeleteProc\fR should have arguments and
result that match the type \fBTcl_CmdDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdDeleteProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_CmdDeleteProc(
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument passed to \fBTcl_CreateObjCommand\fR.
.PP
\fBTcl_DeleteCommand\fR deletes a command from a command interpreter.
Once the call completes, attempts to invoke \fIcmdName\fR in
\fIinterp\fR will result in errors.
If \fIcmdName\fR is not bound as a command in \fIinterp\fR then
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

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







-




-
+

-
+

-
+

-
+

-










-
+









-
-
+
+













-
+















-
+

-
+



















-
+

-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

+
-
+

-
+
\fIcmdName\fR may include \fB::\fR namespace qualifiers
to identify a command in a particular namespace.
If the command is not found, then it returns 0.
Otherwise it places information about the command
in the \fBTcl_CmdInfo\fR structure
pointed to by \fIinfoPtr\fR and returns 1.
A \fBTcl_CmdInfo\fR structure has the following fields:
.PP
.CS
typedef struct Tcl_CmdInfo {
    int \fIisNativeObjectProc\fR;
    Tcl_ObjCmdProc *\fIobjProc\fR;
    void *\fIobjClientData\fR;
    ClientData \fIobjClientData\fR;
    Tcl_CmdProc *\fIproc\fR;
    void *\fIclientData\fR;
    ClientData \fIclientData\fR;
    Tcl_CmdDeleteProc *\fIdeleteProc\fR;
    void *\fIdeleteData\fR;
    ClientData \fIdeleteData\fR;
    Tcl_Namespace *\fInamespacePtr\fR;
} \fBTcl_CmdInfo\fR;
} Tcl_CmdInfo;
.CE
.PP
The \fIisNativeObjectProc\fR field has the value 1
if \fBTcl_CreateObjCommand\fR was called to register the command;
it is 0 if only \fBTcl_CreateCommand\fR was called.
It allows a program to determine whether it is faster to
call \fIobjProc\fR or \fIproc\fR:
\fIobjProc\fR is normally faster
if \fIisNativeObjectProc\fR has the value 1.
The fields \fIobjProc\fR and \fIobjClientData\fR
have the same meaning as the \fIproc\fR and \fIclientData\fR
arguments to \fBTcl_CreateObjCommand\fR;
they hold information about the value-based command procedure
they hold information about the object-based command procedure
that the Tcl interpreter calls to implement the command.
The fields \fIproc\fR and \fIclientData\fR
hold information about the string-based command procedure
that implements the command.
If \fBTcl_CreateCommand\fR was called for this command,
this is the procedure passed to it;
otherwise, this is a compatibility procedure
registered by \fBTcl_CreateObjCommand\fR
that simply calls the command's
value-based procedure after converting its string arguments to Tcl values.
The field \fIdeleteData\fR is the clientData value
object-based procedure after converting its string arguments to Tcl objects.
The field \fIdeleteData\fR is the ClientData value
to pass to \fIdeleteProc\fR;  it is normally the same as
\fIclientData\fR but may be set independently using the
\fBTcl_SetCommandInfo\fR procedure.
The field \fInamespacePtr\fR holds a pointer to the
Tcl_Namespace that contains the command.
.PP
\fBTcl_GetCommandInfoFromToken\fR is identical to
\fBTcl_GetCommandInfo\fR except that it uses a command token returned
from \fBTcl_CreateObjCommand\fR in place of the command name.  If the
\fItoken\fR parameter is NULL, it returns 0; otherwise, it returns 1
and fills in the structure designated by \fIinfoPtr\fR.
.PP
\fBTcl_SetCommandInfo\fR is used to modify the procedures and
clientData values associated with a command.
ClientData values associated with a command.
Its \fIcmdName\fR argument is the name of a command in \fIinterp\fR.
\fIcmdName\fR may include \fB::\fR namespace qualifiers
to identify a command in a particular namespace.
If this command does not exist then \fBTcl_SetCommandInfo\fR returns 0.
Otherwise, it copies the information from \fI*infoPtr\fR to
Tcl's internal structure for the command and returns 1.
.PP
\fBTcl_SetCommandInfoFromToken\fR is identical to
\fBTcl_SetCommandInfo\fR except that it takes a command token as
returned by \fBTcl_CreateObjCommand\fR instead of the command name.
If the \fItoken\fR parameter is NULL, it returns 0.  Otherwise, it
copies the information from \fI*infoPtr\fR to Tcl's internal structure
for the command and returns 1.
.PP
Note that \fBTcl_SetCommandInfo\fR and
\fBTcl_SetCommandInfoFromToken\fR both allow the clientData for a
\fBTcl_SetCommandInfoFromToken\fR both allow the ClientData for a
command's deletion procedure to be given a different value than the
clientData for its command procedure.
ClientData for its command procedure.
.PP
Note that neither \fBTcl_SetCommandInfo\fR nor
\fBTcl_SetCommandInfoFromToken\fR will change a command's namespace.
Use \fBTcl_Eval\fR to call the \fBrename\fR command to do that.
.PP
\fBTcl_GetCommandName\fR provides a mechanism for tracking commands
that have been renamed.
Given a token returned by \fBTcl_CreateObjCommand\fR
when the command was created, \fBTcl_GetCommandName\fR returns the
string name of the command.  If the command has been renamed since it
was created, then \fBTcl_GetCommandName\fR returns the current name.
This name does not include any \fB::\fR namespace qualifiers.
The command corresponding to \fItoken\fR must not have been deleted.
The string returned by \fBTcl_GetCommandName\fR is in dynamic memory
owned by Tcl and is only guaranteed to retain its value as long as the
command is not deleted or renamed;  callers should copy the string if
they need to keep it for a long time.
.PP
\fBTcl_GetCommandFullName\fR produces the fully qualified name
of a command from a command token.
of a command from a command token.  
The name, including all namespace prefixes,
is appended to the value specified by \fIobjPtr\fR.
is appended to the object specified by \fIobjPtr\fR.
.PP
\fBTcl_GetCommandFromObj\fR returns a token for the command
specified by the name in a \fBTcl_Obj\fR.
The command name is resolved relative to the current namespace.
Returns NULL if the command is not found.
.PP
.VS "info cmdtype feature"
\fBTcl_RegisterCommandTypeName\fR is used to associate a name (the
\fItypeName\fR argument) with a particular implementation function so that it
can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is
called with a command token that information is wanted for and which returns
the name of the type that was registered for the implementation function used
for that command. (The lookup functionality is surfaced virtually directly in Tcl via
\fBinfo cmdtype\fR.) If there is no function registered for a particular
function, the result will be the string literal
.QW \fBnative\fR .
The registration of a name can be undone by registering a mapping to NULL
instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that
string which was registered, and not a copy; use of a compile-time constant
string is \fIstrongly recommended\fR.
.VE "info cmdtype feature"
.SH "SEE ALSO"
Tcl_CreateCommand, Tcl_ResetResult, Tcl_SetObjResult
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)

.SH KEYWORDS
bind, command, create, delete, namespace, value
bind, command, create, delete, namespace, object

Added doc/CrtSlave.3.













































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateSlave, Tcl_GetSlave, Tcl_GetMaster, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_IsSafe\fR(\fIinterp\fR)
.sp
int
\fBTcl_MakeSafe\fR(\fIinterp\fR)
.sp
Tcl_Interp *
\fBTcl_CreateSlave\fR(\fIinterp, slaveName, isSafe\fR)
.sp
Tcl_Interp *
\fBTcl_GetSlave\fR(\fIinterp, slaveName\fR)
.sp
Tcl_Interp *
\fBTcl_GetMaster\fR(\fIinterp\fR)
.sp
int
\fBTcl_GetInterpPath\fR(\fIaskingInterp, slaveInterp\fR)
.sp
int
\fBTcl_CreateAlias\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
                argc, argv\fR)
.sp
int
\fBTcl_CreateAliasObj\fR(\fIslaveInterp, slaveCmd, targetInterp, targetCmd,
                   objc, objv\fR)
.sp
int
\fBTcl_GetAlias\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
             argcPtr, argvPtr\fR)
.sp
int
\fBTcl_GetAliasObj\fR(\fIinterp, slaveCmd, targetInterpPtr, targetCmdPtr,
                objcPtr, objvPtr\fR)
.sp
int
\fBTcl_ExposeCommand\fR(\fIinterp, hiddenCmdName, cmdName\fR)
.sp
int
\fBTcl_HideCommand\fR(\fIinterp, cmdName, hiddenCmdName\fR)
.SH ARGUMENTS
.AS "const char *const" **targetInterpPtr out
.AP Tcl_Interp *interp in
Interpreter in which to execute the specified command.
.AP "const char" *slaveName in
Name of slave interpreter to create or manipulate.
.AP int isSafe in
If non-zero, a
.QW safe
slave that is suitable for running untrusted code
is created, otherwise a trusted slave is created.
.AP Tcl_Interp *slaveInterp in
Interpreter to use for creating the source command for an alias (see
below).
.AP "const char" *slaveCmd in
Name of source command for alias.
.AP Tcl_Interp *targetInterp in
Interpreter that contains the target command for an alias.
.AP "const char" *targetCmd in
Name of target command for alias in \fItargetInterp\fR.
.AP int argc in
Count of additional arguments to pass to the alias command.
.AP "const char *const" *argv in
Vector of strings, the additional arguments to pass to the alias command.
This storage is owned by the caller.
.AP int objc in
Count of additional object arguments to pass to the alias object command.
.AP Tcl_Obj **objv in
Vector of Tcl_Obj structures, the additional object arguments to pass to
the alias object command.
This storage is owned by the caller.
.AP Tcl_Interp **targetInterpPtr in
Pointer to location to store the address of the interpreter where a target
command is defined for an alias.
.AP "const char" **targetCmdPtr out
Pointer to location to store the address of the name of the target command
for an alias.
.AP int *argcPtr out
Pointer to location to store count of additional arguments to be passed to
the alias. The location is in storage owned by the caller.
.AP "const char" ***argvPtr out
Pointer to location to store a vector of strings, the additional arguments
to pass to an alias. The location is in storage owned by the caller, the
vector of strings is owned by the called function.
.AP int *objcPtr out
Pointer to location to store count of additional object arguments to be
passed to the alias. The location is in storage owned by the caller.
.AP Tcl_Obj ***objvPtr out
Pointer to location to store a vector of Tcl_Obj structures, the additional
arguments to pass to an object alias command. The location is in storage
owned by the caller, the vector of Tcl_Obj structures is owned by the
called function.
.AP "const char" *cmdName in
Name of an exposed command to hide or create.
.AP "const char" *hiddenCmdName in
Name under which a hidden command is stored and with which it can be
exposed or invoked.
.BE

.SH DESCRIPTION
.PP
These procedures are intended for access to the multiple interpreter
facility from inside C programs. They enable managing multiple interpreters
in a hierarchical relationship, and the management of aliases, commands
that when invoked in one interpreter execute a command in another
interpreter. The return value for those procedures that return an \fBint\fR
is either \fBTCL_OK\fR or \fBTCL_ERROR\fR. If \fBTCL_ERROR\fR is returned
then the \fBresult\fR field of the interpreter contains an error message.
.PP
\fBTcl_CreateSlave\fR creates a new interpreter as a slave of \fIinterp\fR.
It also creates a slave command named \fIslaveName\fR in \fIinterp\fR which 
allows \fIinterp\fR to manipulate the new slave. 
If \fIisSafe\fR is zero, the command creates a trusted slave in which Tcl
code has access to all the Tcl commands.
If it is \fB1\fR, the command creates a
.QW safe
slave in which Tcl code has access only to set of Tcl commands defined as
.QW "Safe Tcl" ;
see the manual entry for the Tcl \fBinterp\fR command for details.
If the creation of the new slave interpreter failed, \fBNULL\fR is returned.
.PP
\fBTcl_IsSafe\fR returns \fB1\fR if \fIinterp\fR is
.QW safe
(was created with the \fBTCL_SAFE_INTERPRETER\fR flag specified),
\fB0\fR otherwise.
.PP
\fBTcl_MakeSafe\fR marks \fIinterp\fR as
.QW safe ,
so that future
calls to \fBTcl_IsSafe\fR will return 1.  It also removes all known
potentially-unsafe core functionality (both commands and variables)
from \fIinterp\fR.  However, it cannot know what parts of an extension
or application are safe and does not make any attempt to remove those
parts, so safety is not guaranteed after calling \fBTcl_MakeSafe\fR.
Callers will want to take care with their use of \fBTcl_MakeSafe\fR
to avoid false claims of safety.  For many situations, \fBTcl_CreateSlave\fR
may be a better choice, since it creates interpreters in a known-safe state.
.PP
\fBTcl_GetSlave\fR returns a pointer to a slave interpreter of
\fIinterp\fR. The slave interpreter is identified by \fIslaveName\fR.
If no such slave interpreter exists, \fBNULL\fR is returned.
.PP
\fBTcl_GetMaster\fR returns a pointer to the master interpreter of
\fIinterp\fR. If \fIinterp\fR has no master (it is a
top-level interpreter) then \fBNULL\fR is returned.
.PP
\fBTcl_GetInterpPath\fR sets the \fIresult\fR field in \fIaskingInterp\fR
to the relative path between \fIaskingInterp\fR and \fIslaveInterp\fR;
\fIslaveInterp\fR must be a slave of \fIaskingInterp\fR. If the computation
of the relative path succeeds, \fBTCL_OK\fR is returned, else
\fBTCL_ERROR\fR is returned and the \fIresult\fR field in
\fIaskingInterp\fR contains the error message.
.PP
\fBTcl_CreateAlias\fR creates an object command named \fIslaveCmd\fR in
\fIslaveInterp\fR that when invoked, will cause the command \fItargetCmd\fR
to be invoked in \fItargetInterp\fR. The arguments specified by the strings
contained in \fIargv\fR are always prepended to any arguments supplied in the
invocation of \fIslaveCmd\fR and passed to \fItargetCmd\fR.
This operation returns \fBTCL_OK\fR if it succeeds, or \fBTCL_ERROR\fR if
it fails; in that case, an error message is left in the object result
of \fIslaveInterp\fR.
Note that there are no restrictions on the ancestry relationship (as
created by \fBTcl_CreateSlave\fR) between \fIslaveInterp\fR and
\fItargetInterp\fR. Any two interpreters can be used, without any
restrictions on how they are related.
.PP
\fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except 
that it takes a vector of objects to pass as additional arguments instead
of a vector of strings.
.PP
\fBTcl_GetAlias\fR returns information about an alias \fIaliasName\fR
in \fIinterp\fR. Any of the result fields can be \fBNULL\fR, in
which case the corresponding datum is not returned. If a result field is
non\-\fBNULL\fR, the address indicated is set to the corresponding datum.
For example, if \fItargetNamePtr\fR is non\-\fBNULL\fR it is set to a
pointer to the string containing the name of the target command.
.PP
\fBTcl_GetAliasObj\fR is similar to \fBTcl_GetAlias\fR except that it
returns a pointer to a vector of Tcl_Obj structures instead of a vector of
strings.
.PP
\fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from
the set of hidden commands to the set of exposed commands, putting
it under the name
\fIcmdName\fR. 
\fIHiddenCmdName\fR must be the name of an existing hidden
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message in the \fIresult\fR field in \fIinterp\fR.
If an exposed command named \fIcmdName\fR already exists,
the operation returns \fBTCL_ERROR\fR and leaves an error message in the
object result of \fIinterp\fR.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in a call to
\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will again succeed.
.PP
\fBTcl_HideCommand\fR moves the command named \fIcmdName\fR from the set of
exposed commands to the set of hidden commands, under the name
\fIhiddenCmdName\fR.
\fICmdName\fR must be the name of an existing exposed
command, or the operation will return \fBTCL_ERROR\fR and leave an error
message in the object result of \fIinterp\fR.
Currently both \fIcmdName\fR and \fIhiddenCmdName\fR must not contain
namespace qualifiers, or the operation will return \fBTCL_ERROR\fR and
leave an error message in the object result of \fIinterp\fR.
The \fICmdName\fR will be looked up in the global namespace, and not
relative to the current namespace, even if the current namespace is not the
global one.
If a hidden command whose name is \fIhiddenCmdName\fR already
exists, the operation also returns \fBTCL_ERROR\fR and the \fIresult\fR
field in \fIinterp\fR contains an error message.
If the operation succeeds, it returns \fBTCL_OK\fR.
After executing this command, attempts to use \fIcmdName\fR in a call to
\fBTcl_Eval\fR or with the Tcl \fBeval\fR command will fail.
.PP
For a description of the Tcl interface to multiple interpreters, see
\fIinterp(n)\fR.
.SH "SEE ALSO"
interp

.SH KEYWORDS
alias, command, exposed commands, hidden commands, interpreter, invoke,
master, slave

Changes to doc/CrtTimerHdlr.3.

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
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






-
+



















-
+





+


















-

-
-
+

-
















-
+
-


'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateTimerHandler, Tcl_DeleteTimerHandler \- call a procedure at a given time
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_TimerToken
\fBTcl_CreateTimerHandler\fR(\fImilliseconds, proc, clientData\fR)
.sp
\fBTcl_DeleteTimerHandler\fR(\fItoken\fR)
.SH ARGUMENTS
.AS Tcl_TimerToken milliseconds
.AP int milliseconds  in
How many milliseconds to wait before invoking \fIproc\fR.
.AP Tcl_TimerProc *proc in
Procedure to invoke after \fImilliseconds\fR have elapsed.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.AP Tcl_TimerToken token in
Token for previously created timer handler (the return value
from some previous call to \fBTcl_CreateTimerHandler\fR).
.BE

.SH DESCRIPTION
.PP
\fBTcl_CreateTimerHandler\fR arranges for \fIproc\fR to be
invoked at a time \fImilliseconds\fR milliseconds in the
future.
The callback to \fIproc\fR will be made by \fBTcl_DoOneEvent\fR,
so \fBTcl_CreateTimerHandler\fR is only useful in programs that
dispatch events through \fBTcl_DoOneEvent\fR or through Tcl commands
such as \fBvwait\fR.
The call to \fIproc\fR may not be made at the exact time given by
\fImilliseconds\fR:  it will be made at the next opportunity
after that time.  For example, if \fBTcl_DoOneEvent\fR is not
called until long after the time has elapsed, or if there
are other pending events to process before the call to
\fIproc\fR, then the call to \fIproc\fR will be delayed.
.PP
\fIProc\fR should have arguments and return value that match
the type \fBTcl_TimerProc\fR:
.PP
.CS
typedef void \fBTcl_TimerProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_TimerProc(ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateTimerHandler\fR when the callback
was created.  Typically, \fIclientData\fR points to a data
structure containing application-specific information about
what to do in \fIproc\fR.
.PP
\fBTcl_DeleteTimerHandler\fR may be called to delete a
previously created timer handler.  It deletes the handler
indicated by \fItoken\fR so that no call to \fIproc\fR
will be made;  if that handler no longer exists
(e.g. because the time period has already elapsed and \fIproc\fR
has been invoked then \fBTcl_DeleteTimerHandler\fR does nothing.
The tokens returned by \fBTcl_CreateTimerHandler\fR never have
a value of NULL, so if NULL is passed to \fBTcl_DeleteTimerHandler\fR
then the procedure does nothing.
.SH "SEE ALSO"

after(n), Tcl_CreateFileHandler(3), Tcl_DoWhenIdle(3)
.SH KEYWORDS
callback, clock, handler, timer

Changes to doc/CrtTrace.3.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2002 by Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateTrace, Tcl_CreateObjTrace, Tcl_DeleteTrace \- arrange for command execution to be traced
.SH SYNOPSIS
.nf
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51







-
+







Flags governing the trace execution.  See below for details.
.AP Tcl_CmdObjTraceProc *objProc in
Procedure to call for each command that is executed.  See below for
details of the calling sequence.
.AP Tcl_CmdTraceProc *proc in
Procedure to call for each command that is executed.  See below for
details on the calling sequence.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIobjProc\fR or \fIproc\fR.
.AP Tcl_CmdObjTraceDeleteProc *deleteProc in
Procedure to call when the trace is deleted.  See below for details of
the calling sequence.  A NULL pointer is permissible and results in no
callback when the trace is deleted.
.AP Tcl_Trace trace in
Token for trace to be removed (return value from previous call
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
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







-

-
-
+
+





-
+

-


-
+







The return value from \fBTcl_CreateObjTrace\fR is a token for the trace,
which may be passed to \fBTcl_DeleteTrace\fR to remove the trace.
There may be many traces in effect simultaneously for the same
interpreter.
.PP
\fIobjProc\fR should have arguments and result that match the type,
\fBTcl_CmdObjTraceProc\fR:
.PP
.CS
typedef int \fBTcl_CmdObjTraceProc\fR(
        \fBvoid *\fR \fIclientData\fR,
typedef int \fBTcl_CmdObjTraceProc\fR( 
        \fBClientData\fR \fIclientData\fR,
        \fBTcl_Interp\fR* \fIinterp\fR,
        int \fIlevel\fR,
        const char *\fIcommand\fR,
        \fBTcl_Command\fR \fIcommandToken\fR,
        int \fIobjc\fR,
        \fBTcl_Obj\fR *const \fIobjv\fR[]);
        \fBTcl_Obj\fR *const \fIobjv\fR[] );
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters are copies of the
corresponding arguments given to \fBTcl_CreateTrace\fR.
\fIclientData\fR typically points to an application-specific data
\fIClientData\fR typically points to an application-specific data
structure that describes what to do when \fIobjProc\fR is invoked.  The
\fIlevel\fR parameter gives the nesting level of the command (1 for
top-level commands passed to \fBTcl_Eval\fR by the application, 2 for
the next-level commands passed to \fBTcl_Eval\fR as part of parsing or
interpreting level-1 commands, and so on). The \fIcommand\fR parameter
points to a string containing the text of the command, before any
argument substitution.  The \fIcommandToken\fR parameter is a Tcl
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
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







-

-
-
+
+

-










-

-
-
+
+




-
+



-







made to the procedure associated with the trace.  After \fBTcl_DeleteTrace\fR
returns, the caller should never again use the \fItrace\fR token.
.PP
When \fBTcl_DeleteTrace\fR is called, the interpreter invokes the
\fIdeleteProc\fR that was passed as a parameter to
\fBTcl_CreateObjTrace\fR.  The \fIdeleteProc\fR must match the type,
\fBTcl_CmdObjTraceDeleteProc\fR:
.PP
.CS
typedef void \fBTcl_CmdObjTraceDeleteProc\fR(
        \fBvoid *\fR \fIclientData\fR);
typedef void \fBTcl_CmdObjTraceDeleteProc\fR( 
        \fBClientData\fR \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter will be the same as the
\fIclientData\fR parameter that was originally passed to
\fBTcl_CreateObjTrace\fR.
.PP
\fBTcl_CreateTrace\fR is an alternative interface for command tracing,
\fInot recommended for new applications\fR.  It is provided for backward
compatibility with code that was developed for older versions of the
Tcl interpreter.  It is similar to \fBTcl_CreateObjTrace\fR, except
that its \fIproc\fR parameter should have arguments and result that
match the type \fBTcl_CmdTraceProc\fR:
.PP
.CS
typedef void \fBTcl_CmdTraceProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_CmdTraceProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIlevel\fR,
        char *\fIcommand\fR,
        Tcl_CmdProc *\fIcmdProc\fR,
        void *\fIcmdClientData\fR,
        ClientData \fIcmdClientData\fR,
        int \fIargc\fR,
        const char *\fIargv\fR[]);
.CE
.PP
The parameters to the \fIproc\fR callback are similar to those of the
\fIobjProc\fR callback above. The \fIcommandToken\fR is
replaced with \fIcmdProc\fR, a pointer to the (string-based) command
procedure that will be invoked; and \fIcmdClientData\fR, the client
data that will be passed to the procedure.  The \fIobjc\fR parameter
is replaced with an \fIargv\fR parameter, that gives the arguments to
the command as character strings.

Changes to doc/DString.3.

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
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






-
+




-
+
















-
+






+
+














-
-
+
+

-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_DString 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringTrunc, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_DStringInit\fR(\fIdsPtr\fR)
.sp
char *
\fBTcl_DStringAppend\fR(\fIdsPtr, bytes, length\fR)
.sp
char *
\fBTcl_DStringAppendElement\fR(\fIdsPtr, element\fR)
.sp
\fBTcl_DStringStartSublist\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringEndSublist\fR(\fIdsPtr\fR)
.sp
size_t
int
\fBTcl_DStringLength\fR(\fIdsPtr\fR)
.sp
char *
\fBTcl_DStringValue\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
.sp
\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
.SH ARGUMENTS
.AS Tcl_DString newLength in/out
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
.AP "const char" *bytes in
Pointer to characters to append to dynamic string.
.AP "const char" *element in
Pointer to characters to append as list element to dynamic string.
.AP size_t length in
Number of bytes from \fIbytes\fR to add to dynamic string.  If TCL_INDEX_NONE,
.AP int length in
Number of bytes from \fIbytes\fR to add to dynamic string.  If -1,
add all characters up to null terminating character.
.AP size_t newLength in
.AP int newLength in
New length for dynamic string, not including null terminating
character.
.AP Tcl_Interp *interp in/out
Interpreter whose result is to be set from or moved to the
dynamic string.
.BE

121
122
123
124
125
126
127




128
129
130
131
132
133
134
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140







+
+
+
+







for the string if needed.
However, \fBTcl_DStringSetLength\fR will not initialize the new
space except to provide a terminating null character;  it is up to the
caller to fill in the new space.
\fBTcl_DStringSetLength\fR does not free up the string's storage space
even if the string is truncated to zero length, so \fBTcl_DStringFree\fR
will still need to be called.
.PP
\fBTcl_DStringTrunc\fR changes the length of a dynamic string.
This procedure is now deprecated.  \fBTcl_DStringSetLength\fR  should
be used instead.
.PP
\fBTcl_DStringFree\fR should be called when you are finished using
the string.  It frees up any memory that was allocated for the string
and reinitializes the string's value to an empty string.
.PP
\fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of
the dynamic string given by \fIdsPtr\fR.  It does this by moving

Changes to doc/DetachPids.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DetachPids, Tcl_ReapDetachedProcs, Tcl_WaitPid \- manage child processes in background
.SH SYNOPSIS
.nf

Changes to doc/DictObj.3.

1
2
3
4
5
6

7
8
9
10
11
12

13
14
15
16
17
18
19
1
2
3
4
5

6
7
8
9
10
11

12
13
14
15
16
17
18
19





-
+





-
+







'\"
'\" Copyright (c) 2003 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_NewDictObj, Tcl_DictObjPut, Tcl_DictObjGet, Tcl_DictObjRemove, Tcl_DictObjSize, Tcl_DictObjFirst, Tcl_DictObjNext, Tcl_DictObjDone, Tcl_DictObjPutKeyList, Tcl_DictObjRemoveKeyList \- manipulate Tcl values as dictionaries
Tcl_NewDictObj, Tcl_DictObjPut, Tcl_DictObjGet, Tcl_DictObjRemove, Tcl_DictObjSize, Tcl_DictObjFirst, Tcl_DictObjNext, Tcl_DictObjDone, Tcl_DictObjPutKeyList, Tcl_DictObjRemoveKeyList \- manipulate Tcl objects as dictionaries
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewDictObj\fR()
.sp
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
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







-
-
+
+


-
-
+
+



-
+





-
-
+
+







\fBTcl_DictObjPutKeyList\fR(\fIinterp, dictPtr, keyc, keyv, valuePtr\fR)
.sp
int
\fBTcl_DictObjRemoveKeyList\fR(\fIinterp, dictPtr, keyc, keyv\fR)
.SH ARGUMENTS
.AS Tcl_DictSearch "**valuePtrPtr" in/out
.AP Tcl_Interp *interp in
If an error occurs while converting a value to be a dictionary value,
an error message is left in the interpreter's result value
If an error occurs while converting an object to be a dictionary object,
an error message is left in the interpreter's result object
unless \fIinterp\fR is NULL.
.AP Tcl_Obj *dictPtr in/out
Points to the dictionary value to be manipulated.
If \fIdictPtr\fR does not already point to a dictionary value,
Points to the dictionary object to be manipulated.
If \fIdictPtr\fR does not already point to a dictionary object,
an attempt will be made to convert it to one.
.AP Tcl_Obj *keyPtr in
Points to the key for the key/value pair being manipulated within the
dictionary value.
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 value (or sub-value, in the case of
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.
.AP int *sizePtr out
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
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







-
+


-
+




-
+









-
+

-
-
-
+
+
+







Points to a variable that will have a non-zero value written into it
when the enumeration of the key/value pairs in a dictionary has
completed, and a zero otherwise.
.AP int keyc in
Indicates the number of keys that will be supplied in the \fIkeyv\fR
array.
.AP "Tcl_Obj *const" *keyv in
Array of \fIkeyc\fR pointers to values that
Array of \fIkeyc\fR pointers to objects that
\fBTcl_DictObjPutKeyList\fR and \fBTcl_DictObjRemoveKeyList\fR will
use to locate the key/value pair to manipulate within the
sub-dictionaries of the main dictionary value passed to them.
sub-dictionaries of the main dictionary object passed to them.
.BE

.SH DESCRIPTION
.PP
Tcl dictionary values have an internal representation that supports
Tcl dictionary objects have an internal representation that supports
efficient mapping from keys to values and which guarantees that the
particular ordering of keys within the dictionary remains the same
modulo any keys being deleted (which removes them from the order) or
added (which adds them to the end of the order). If reinterpreted as a
list, the values at the even-valued indices in the list will be the
keys of the dictionary, and each will be followed (in the odd-valued
index) by the value associated with that key.
.PP
The procedures described in this man page are used to
create, modify, index, and iterate over dictionary values from C code.
create, modify, index, and iterate over dictionary objects from C code.
.PP
\fBTcl_NewDictObj\fR creates a new, empty dictionary value.  The
string representation of the value will be invalid, and the reference
count of the value will be zero.
\fBTcl_NewDictObj\fR creates a new, empty dictionary object.  The
string representation of the object will be invalid, and the reference
count of the object will be zero.
.PP
\fBTcl_DictObjGet\fR looks up the given key within the given
dictionary and writes a pointer to the value associated with that key
into the variable pointed to by \fIvaluePtrPtr\fR, or a NULL if the
key has no mapping within the dictionary.  The result of this
procedure is \fBTCL_OK\fR, or \fBTCL_ERROR\fR if the \fIdictPtr\fR cannot be
converted to a dictionary.
213
214
215
216
217
218
219
220

221
222
223
224
225
226
227
228
229
230
231
232
233
234

213
214
215
216
217
218
219

220
221
222
223
224
225
226
227
228
229
230
231
232
233

234







-
+













-
+
if (\fBTcl_DictObjFirst\fR(interp, objPtr, &search,
        &key, &value, &done) != TCL_OK) {
    return TCL_ERROR;
}
for (; !done ; \fBTcl_DictObjNext\fR(&search, &key, &value, &done)) {
    /*
     * Note that strcmp() is not a good way of comparing
     * values and is just used here for demonstration
     * objects and is just used here for demonstration
     * purposes.
     */
    if (!strcmp(Tcl_GetString(key), Tcl_GetString(value))) {
        break;
    }
}
\fBTcl_DictObjDone\fR(&search);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!done));
return TCL_OK;
.CE
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_InitObjHashTable
.SH KEYWORDS
dict, dict value, dictionary, dictionary value, hash table, iteration, value
dict, dict object, dictionary, dictionary object, hash table, iteration, object

Changes to doc/DoOneEvent.3.

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
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






-
+















-
+







'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_DoOneEvent 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DoOneEvent \- wait for events and invoke event handlers
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_DoOneEvent\fR(\fIflags\fR)
.SH ARGUMENTS
.AS int flags
.AP int flags in
This parameter is normally zero.  It may be an OR-ed combination
of any of the following flag bits:
of any of the following flag bits:  
\fBTCL_WINDOW_EVENTS\fR, \fBTCL_FILE_EVENTS\fR,
\fBTCL_TIMER_EVENTS\fR, \fBTCL_IDLE_EVENTS\fR, \fBTCL_ALL_EVENTS\fR,
or \fBTCL_DONT_WAIT\fR.
.BE

.SH DESCRIPTION
.PP
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53







-
+







If there are no events ready to be handled, then \fBTcl_DoOneEvent\fR
checks for new events from all possible sources.
If any are found, it puts all of them on Tcl's event queue, calls
handlers for the first event on the queue, and returns.
If no events are found, \fBTcl_DoOneEvent\fR checks for \fBTcl_DoWhenIdle\fR
callbacks; if any are found, it invokes all of them and returns.
Finally, if no events or idle callbacks have been found, then
\fBTcl_DoOneEvent\fR sleeps until an event occurs; then it adds any
\fBTcl_DoOneEvent\fR sleeps until an event occurs; then it adds any 
new events to the Tcl event queue, calls handlers for the first event,
and returns.
The normal return value is 1 to signify that some event
was processed (see below for other alternatives).
.PP
If the \fIflags\fR argument to \fBTcl_DoOneEvent\fR is non-zero,
it restricts the kinds of events that will be processed by

Changes to doc/DoWhenIdle.3.

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
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






-
+
















-
+


+
















-

-
-
+

-







'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DoWhenIdle, Tcl_CancelIdleCall \- invoke a procedure when there are no pending events
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_DoWhenIdle\fR(\fIproc, clientData\fR)
.sp
\fBTcl_CancelIdleCall\fR(\fIproc, clientData\fR)
.SH ARGUMENTS
.AS Tcl_IdleProc clientData
.AP Tcl_IdleProc *proc in
Procedure to invoke.
.AP coid *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_DoWhenIdle\fR arranges for \fIproc\fR to be invoked
when the application becomes idle.  The application is
considered to be idle when \fBTcl_DoOneEvent\fR has been
called, could not find any events to handle, and is about
to go to sleep waiting for an event to occur.  At this
point all pending \fBTcl_DoWhenIdle\fR handlers are
invoked.  For each call to \fBTcl_DoWhenIdle\fR there will
be a single call to \fIproc\fR;  after \fIproc\fR is
invoked the handler is automatically removed.
\fBTcl_DoWhenIdle\fR is only usable in programs that
use \fBTcl_DoOneEvent\fR to dispatch events.
.PP
\fIProc\fR should have arguments and result that match the
type \fBTcl_IdleProc\fR:
.PP
.CS
typedef void \fBTcl_IdleProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_IdleProc(ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
argument given to \fBTcl_DoWhenIdle\fR.  Typically, \fIclientData\fR
points to a data structure containing application-specific information about
what \fIproc\fR should do.
.PP
\fBTcl_CancelIdleCall\fR
may be used to cancel one or more previous
77
78
79
80
81
82
83
84

85
86
87
75
76
77
78
79
80
81

82

83
84







-
+
-


.SH BUGS
.PP
At present it is not safe for an idle callback to reschedule itself
continuously.  This will interact badly with certain features of Tk
that attempt to wait for all idle callbacks to complete.  If you would
like for an idle callback to reschedule itself continuously, it is
better to use a timer handler with a zero timeout period.
.SH "SEE ALSO"

after(n), Tcl_CreateFileHandler(3), Tcl_CreateTimerHandler(3)
.SH KEYWORDS
callback, defer, idle callback

Changes to doc/DoubleObj.3.

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

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





-
+




-
+














-
+

-
+

-
-
+
+








-
+


-
-
+
+

-
+

-
-
-
+
+
+



-
+




-
+




-
+
'\"
'\" Copyright (c) 1996-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.
'\"
'\" 
.TH Tcl_DoubleObj 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewDoubleObj, Tcl_SetDoubleObj, Tcl_GetDoubleFromObj \- manipulate Tcl values as floating-point values
Tcl_NewDoubleObj, Tcl_SetDoubleObj, Tcl_GetDoubleFromObj \- manipulate Tcl objects as floating-point values
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewDoubleObj\fR(\fIdoubleValue\fR)
.sp
\fBTcl_SetDoubleObj\fR(\fIobjPtr, doubleValue\fR)
.sp
int
\fBTcl_GetDoubleFromObj\fR(\fIinterp, objPtr, doublePtr\fR)
.SH ARGUMENTS
.AS Tcl_Interp doubleValue in/out
.AP double doubleValue in
A double-precision floating-point value used to initialize or set a Tcl value.
A double-precision floating-point value used to initialize or set a Tcl object.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetDoubleObj\fR, this points to the value in which to store a
For \fBTcl_SetDoubleObj\fR, this points to the object in which to store a
double value.
For \fBTcl_GetDoubleFromObj\fR, this refers to the value
from which to retrieve a double value.
For \fBTcl_GetDoubleFromObj\fR, this refers to the object
from which to retrieve a double value. 
.AP Tcl_Interp *interp in/out
When non-NULL, an error message is left here when double value retrieval fails.
.AP double *doublePtr out
Points to place to store the double value obtained from \fIobjPtr\fR.
.BE

.SH DESCRIPTION
.PP
These procedures are used to create, modify, and read Tcl values that
These procedures are used to create, modify, and read Tcl objects that
hold double-precision floating-point values.
.PP
\fBTcl_NewDoubleObj\fR creates and returns a new Tcl value initialized to
the double value \fIdoubleValue\fR.  The returned Tcl value is unshared.
\fBTcl_NewDoubleObj\fR creates and returns a new Tcl object initialized to
the double value \fIdoubleValue\fR.  The returned Tcl object is unshared.
.PP
\fBTcl_SetDoubleObj\fR sets the value of an existing Tcl value pointed to
\fBTcl_SetDoubleObj\fR sets the value of an existing Tcl object pointed to
by \fIobjPtr\fR to the double value \fIdoubleValue\fR.  The \fIobjPtr\fR
argument must point to an unshared Tcl value.  Any attempt to set the value
of a shared Tcl value violates Tcl's copy-on-write policy.  Any existing
string representation or internal representation in the unshared Tcl value
argument must point to an unshared Tcl object.  Any attempt to set the value
of a shared Tcl object violates Tcl's copy-on-write policy.  Any existing
string representation or internal representation in the unshared Tcl object
will be freed as a consequence of setting the new value.
.PP
\fBTcl_GetDoubleFromObj\fR attempts to retrieve a double value from the
Tcl value \fIobjPtr\fR.  If the attempt succeeds, then \fBTCL_OK\fR is
Tcl object \fIobjPtr\fR.  If the attempt succeeds, then \fBTCL_OK\fR is
returned, and the double value is written to the storage pointed to by
\fIdoublePtr\fR.  If the attempt fails, then \fBTCL_ERROR\fR is returned,
and if \fIinterp\fR is non-NULL, an error message is left in \fIinterp\fR.
The \fBTcl_ObjType\fR of \fIobjPtr\fR may be changed to make subsequent
calls to \fBTcl_GetDoubleFromObj\fR more efficient.
calls to \fBTcl_GetDoubleFromObj\fR more efficient. 
'\" TODO: add discussion of treatment of NaN value
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
.SH KEYWORDS
double, double value, double type, internal representation, value, value type, string representation
double, double object, double type, internal representation, object, object type, string representation

Changes to doc/DumpActiveMemory.3.

1
2
3
4
5

6
7
8
9
10
11
12
1
2
3
4

5
6
7
8
9
10
11
12




-
+







'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
'\" 
.TH "Tcl_DumpActiveMemory" 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_DumpActiveMemory, Tcl_InitMemory, Tcl_ValidateAllMemory \- Validated memory allocation interface
.SH SYNOPSIS
.nf
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
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







-
+



-
+











-
-
+
+









.BE

.SH DESCRIPTION
These functions provide access to Tcl memory debugging information.
They are only functional when Tcl has been compiled with
\fBTCL_MEM_DEBUG\fR defined at compile-time.  When \fBTCL_MEM_DEBUG\fR
is not defined, these functions are all no-ops.
.PP
.PP 
\fBTcl_DumpActiveMemory\fR will output a list of all currently
allocated memory to the specified file.  The information output for
each allocated block of memory is:  starting and ending addresses
(excluding guard zone), size, source file where \fBTcl_Alloc\fR was
(excluding guard zone), size, source file where \fBckalloc\fR was
called to allocate the block and line number in that file.  It is
especially useful to call \fBTcl_DumpActiveMemory\fR after the Tcl
interpreter has been deleted.
.PP
\fBTcl_InitMemory\fR adds the Tcl \fBmemory\fR command to the
interpreter given by \fIinterp\fR.  \fBTcl_InitMemory\fR is called
by \fBTcl_Main\fR.
.PP
\fBTcl_ValidateAllMemory\fR forces a validation of the guard zones of
all currently allocated blocks of memory.  Normally validation of a
block occurs when its freed, unless full validation is enabled, in
which case validation of all blocks occurs when \fBTcl_Alloc\fR and
\fBTcl_Free\fR are called.  This function forces the validation to occur
which case validation of all blocks occurs when \fBckalloc\fR and
\fBckfree\fR are called.  This function forces the validation to occur
at any point.

.SH "SEE ALSO"
TCL_MEM_DEBUG, memory

.SH KEYWORDS
memory, debug


Changes to doc/Encoding.3.

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
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





-
+




-
+










+


+















+
+
+
+
+
+






+


+







+





+
+
+
+
+
+
+








-
+


+

+

+

+



-
-
+
+


-
-
+
+





-
+











-
+







-
+


















+

+

-
+

+

+

-
+







'\"
'\" Copyright (c) 1997-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_GetEncoding 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings
Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Encoding
\fBTcl_GetEncoding\fR(\fIinterp, name\fR)
.sp
void
\fBTcl_FreeEncoding\fR(\fIencoding\fR)
.sp
.VS 8.5
int
\fBTcl_GetEncodingFromObj\fR(\fIinterp, objPtr, encodingPtr\fR)
.VE 8.5
.sp
char *
\fBTcl_ExternalToUtfDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
.sp
char *
\fBTcl_UtfToExternalDString\fR(\fIencoding, src, srcLen, dstPtr\fR)
.sp
int
\fBTcl_ExternalToUtf\fR(\fIinterp, encoding, src, srcLen, flags, statePtr,
                  dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR)
.sp
int
\fBTcl_UtfToExternal\fR(\fIinterp, encoding, src, srcLen, flags, statePtr,
                  dst, dstLen, srcReadPtr, dstWrotePtr, dstCharsPtr\fR)
.sp
char *
\fBTcl_WinTCharToUtf\fR(\fItsrc, srcLen, dstPtr\fR)
.sp
TCHAR *
\fBTcl_WinUtfToTChar\fR(\fIsrc, srcLen, dstPtr\fR)
.sp
const char *
\fBTcl_GetEncodingName\fR(\fIencoding\fR)
.sp
int
\fBTcl_SetSystemEncoding\fR(\fIinterp, name\fR)
.sp
.VS 8.5
const char *
\fBTcl_GetEncodingNameFromEnvironment\fR(\fIbufPtr\fR)
.VE 8.5
.sp
void
\fBTcl_GetEncodingNames\fR(\fIinterp\fR)
.sp
Tcl_Encoding
\fBTcl_CreateEncoding\fR(\fItypePtr\fR)
.sp
.VS 8.5
Tcl_Obj *
\fBTcl_GetEncodingSearchPath\fR()
.sp
int
\fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR)
.VE 8.5
.sp
const char *
\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR)
.sp
void
\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR)
.SH ARGUMENTS
.AS "const Tcl_EncodingType" *dstWrotePtr in/out
.AP Tcl_Interp *interp in
Interpreter to use for error reporting, or NULL if no error reporting is
desired.
.AP "const char" *name in
Name of encoding to load.
.AP Tcl_Encoding encoding in
The encoding to query, free, or use for converting text.  If \fIencoding\fR is
The encoding to query, free, or use for converting text.  If \fIencoding\fR is 
NULL, the current system encoding is used.
.AP Tcl_Obj *objPtr in
.VS 8.5
Name of encoding to get token for.
.VE 8.5
.AP Tcl_Encoding *encodingPtr out
.VS 8.5
Points to storage where encoding token is to be written.
.VE 8.5
.AP "const char" *src in
For the \fBTcl_ExternalToUtf\fR functions, an array of bytes in the
specified encoding that are to be converted to UTF-8.  For the
\fBTcl_UtfToExternal\fR function, an array of
UTF-8 characters to be converted to the specified encoding.
\fBTcl_UtfToExternal\fR and \fBTcl_WinUtfToTChar\fR functions, an array of
UTF-8 characters to be converted to the specified encoding.  
.AP "const TCHAR" *tsrc in
An array of Windows TCHAR characters to convert to UTF-8.
.AP size_t srcLen in
Length of \fIsrc\fR or \fItsrc\fR in bytes.  If the length is negative, the
.AP int srcLen in 
Length of \fIsrc\fR or \fItsrc\fR in bytes.  If the length is negative, the 
encoding-specific length of the string is used.
.AP Tcl_DString *dstPtr out
Pointer to an uninitialized or free \fBTcl_DString\fR in which the converted
result will be stored.
.AP int flags in
Various flag bits OR-ed together.
Various flag bits OR-ed together.  
\fBTCL_ENCODING_START\fR signifies that the
source buffer is the first block in a (potentially multi-block) input
stream, telling the conversion routine to reset to an initial state and
perform any initialization that needs to occur before the first byte is
converted. \fBTCL_ENCODING_END\fR signifies that the source buffer is the last
block in a (potentially multi-block) input stream, telling the conversion
routine to perform any finalization that needs to occur after the last
byte is converted and then to reset to an initial state.
\fBTCL_ENCODING_STOPONERROR\fR signifies that the conversion routine should
return immediately upon reading a source character that does not exist in
the target encoding; otherwise a default fallback character will
automatically be substituted.
automatically be substituted.  
.AP Tcl_EncodingState *statePtr in/out
Used when converting a (generally long or indefinite length) byte stream
in a piece-by-piece fashion.  The conversion routine stores its current
state in \fI*statePtr\fR after \fIsrc\fR (the buffer containing the
current piece) has been converted; that state information must be passed
back when converting the next piece of the stream so the conversion
routine knows what state it was in when it left off at the end of the
last piece.  May be NULL, in which case the value specified for \fIflags\fR
last piece.  May be NULL, in which case the value specified for \fIflags\fR 
is ignored and the source buffer is assumed to contain the complete string to
convert.
.AP char *dst out
Buffer in which the converted result will be stored.  No more than
\fIdstLen\fR bytes will be stored in \fIdst\fR.
.AP int dstLen in
The maximum length of the output buffer \fIdst\fR in bytes.
.AP int *srcReadPtr out
Filled with the number of bytes from \fIsrc\fR that were actually
converted.  This may be less than the original source length if there was
a problem converting some source characters.  May be NULL.
.AP int *dstWrotePtr out
Filled with the number of bytes that were actually stored in the output
buffer as a result of the conversion.  May be NULL.
.AP int *dstCharsPtr out
Filled with the number of characters that correspond to the number of bytes
stored in the output buffer.  May be NULL.
.AP Tcl_DString *bufPtr out
.VS 8.5
Storage for the prescribed system encoding name.
.VE 8.5
.AP "const Tcl_EncodingType" *typePtr in
Structure that defines a new type of encoding.
Structure that defines a new type of encoding.  
.AP Tcl_Obj *searchPath in
.VS 8.5
List of filesystem directories in which to search for encoding data files.
.VE 8.5
.AP "const char" *path in
A path to the location of the encoding file.
A path to the location of the encoding file.  
.BE
.SH INTRODUCTION
.PP
These routines convert between Tcl's internal character representation,
UTF-8, and character representations used by various operating systems or
file systems, such as Unicode, ASCII, or Shift-JIS.  When operating on
strings, such as such as obtaining the names of files or displaying
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
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







-
+





-
+

+











+


-
+







message is returned in \fIinterp\fR.
.PP
The encoding package maintains a database of all encodings currently in use.
The first time \fIname\fR is seen, \fBTcl_GetEncoding\fR returns an
encoding with a reference count of 1.  If the same \fIname\fR is requested
further times, then the reference count for that encoding is incremented
without the overhead of allocating a new encoding and all its associated
data structures.
data structures.  
.PP
When an \fIencoding\fR is no longer needed, \fBTcl_FreeEncoding\fR
should be called to release it.  When an \fIencoding\fR is no longer in use
anywhere (i.e., it has been freed as many times as it has been gotten)
\fBTcl_FreeEncoding\fR will release all storage the encoding was using
and delete it from the database.
and delete it from the database. 
.PP
.VS 8.5
\fBTcl_GetEncodingFromObj\fR treats the string representation of
\fIobjPtr\fR as an encoding name, and finds an encoding with that
name, just as \fBTcl_GetEncoding\fR does. When an encoding is found,
it is cached within the \fBobjPtr\fR value for future reference, the
\fBTcl_Encoding\fR token is written to the storage pointed to by
\fIencodingPtr\fR, and the value \fBTCL_OK\fR is returned. If no such
encoding is found, the value \fBTCL_ERROR\fR is returned, and no
writing to \fB*\fR\fIencodingPtr\fR takes place. Just as with
\fBTcl_GetEncoding\fR, the caller should call \fBTcl_FreeEncoding\fR
on the resulting encoding token when that token will no longer be
used.
.VE 8.5
.PP
\fBTcl_ExternalToUtfDString\fR converts a source buffer \fIsrc\fR from the
specified \fIencoding\fR into UTF-8.  The converted bytes are stored in
specified \fIencoding\fR into UTF-8.  The converted bytes are stored in 
\fIdstPtr\fR, which is then null-terminated.  The caller should eventually
call \fBTcl_DStringFree\fR to free any information stored in \fIdstPtr\fR.
When converting, if any of the characters in the source buffer cannot be
represented in the target encoding, a default fallback character will be
used.  The return value is a pointer to the value stored in the DString.
.PP
\fBTcl_ExternalToUtf\fR converts a source buffer \fIsrc\fR from the specified
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
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







-
+






-
+


-
+

















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


-
+













+






+




-
+














-
+

-
+





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







many characters as could fit were converted though.
.IP \fBTCL_CONVERT_MULTIBYTE\fR 29
The last few bytes in the source buffer were the beginning of a multibyte
sequence, but more bytes were needed to complete this sequence.  A
subsequent call to the conversion routine should pass a buffer containing
the unconverted bytes that remained in \fIsrc\fR plus some further bytes
from the source stream to properly convert the formerly split-up multibyte
sequence.
sequence.  
.IP \fBTCL_CONVERT_SYNTAX\fR 29
The source buffer contained an invalid character sequence.  This may occur
if the input stream has been damaged or if the input encoding method was
misidentified.
.IP \fBTCL_CONVERT_UNKNOWN\fR 29
The source buffer contained a character that could not be represented in
the target encoding and \fBTCL_ENCODING_STOPONERROR\fR was specified.
the target encoding and \fBTCL_ENCODING_STOPONERROR\fR was specified.  
.RE
.LP
\fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8
\fBTcl_UtfToExternalDString\fR converts a source buffer \fIsrc\fR from UTF-8 
into the specified \fIencoding\fR.  The converted bytes are stored in
\fIdstPtr\fR, which is then terminated with the appropriate encoding-specific
null.  The caller should eventually call \fBTcl_DStringFree\fR to free any
information stored in \fIdstPtr\fR.  When converting, if any of the
characters in the source buffer cannot be represented in the target
encoding, a default fallback character will be used.  The return value is
a pointer to the value stored in the DString.
.PP
\fBTcl_UtfToExternal\fR converts a source buffer \fIsrc\fR from UTF-8 into
the specified \fIencoding\fR.  Up to \fIsrcLen\fR bytes are converted from
the source buffer and up to \fIdstLen\fR converted bytes are stored in
\fIdst\fR.  In all cases, \fI*srcReadPtr\fR is filled with the number of
bytes that were successfully converted from \fIsrc\fR and \fI*dstWrotePtr\fR
is filled with the corresponding number of bytes that were stored in
\fIdst\fR.  The return values are the same as the return values for
\fBTcl_ExternalToUtf\fR.
.PP
\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR are
Windows-only convenience
functions for converting between UTF-8 and Windows strings.  On Windows 95
(as with the Unix operating system),
all strings exchanged between Tcl and the operating system are
.QW "char"
based.  On Windows NT, some strings exchanged between Tcl and the
operating system are
.QW "char"
oriented while others are in Unicode.  By
convention, in Windows a TCHAR is a character in the ANSI code page
on Windows 95 and a Unicode character on Windows NT.
.PP
If you planned to use the same
.QW "char"
based interfaces on both Windows
95 and Windows NT, you could use \fBTcl_UtfToExternal\fR and
\fBTcl_ExternalToUtf\fR (or their \fBTcl_DString\fR equivalents) with an
encoding of NULL (the current system encoding).  On the other hand,
if you planned to use the Unicode interface when running on Windows NT
and the
.QW "char"
interfaces when running on Windows 95, you would have
to perform the following type of test over and over in your program
(as represented in pseudo-code):
.CS
if (running NT) {
    encoding <- Tcl_GetEncoding("unicode");
    nativeBuffer <- Tcl_UtfToExternal(encoding, utfBuffer);
    Tcl_FreeEncoding(encoding);
} else {
    nativeBuffer <- Tcl_UtfToExternal(NULL, utfBuffer);
}
.CE
\fBTcl_WinUtfToTChar\fR and \fBTcl_WinTCharToUtf\fR automatically
handle this test and use the proper encoding based on the current
operating system.  \fBTcl_WinUtfToTChar\fR returns a pointer to
a TCHAR string, and \fBTcl_WinTCharToUtf\fR expects a TCHAR string
pointer as the \fIsrc\fR string.  Otherwise, these functions
behave identically to \fBTcl_UtfToExternalDString\fR and
\fBTcl_ExternalToUtfDString\fR.
.PP
\fBTcl_GetEncodingName\fR is roughly the inverse of \fBTcl_GetEncoding\fR.
Given an \fIencoding\fR, the return value is the \fIname\fR argument that
was used to create the encoding.  The string returned by
was used to create the encoding.  The string returned by 
\fBTcl_GetEncodingName\fR is only guaranteed to persist until the
\fIencoding\fR is deleted.  The caller must not modify this string.
.PP
\fBTcl_SetSystemEncoding\fR sets the default encoding that should be used
whenever the user passes a NULL value for the \fIencoding\fR argument to
any of the other encoding functions.  If \fIname\fR is NULL, the system
encoding is reset to the default system encoding, \fBbinary\fR.  If the
name did not refer to any known or loadable encoding, \fBTCL_ERROR\fR is
returned and an error message is left in \fIinterp\fR.  Otherwise, this
procedure increments the reference count of the new system encoding,
decrements the reference count of the old system encoding, and returns
\fBTCL_OK\fR.
.PP
.VS 8.5
\fBTcl_GetEncodingNameFromEnvironment\fR provides a means for the Tcl
library to report the encoding name it believes to be the correct one
to use as the system encoding, based on system calls and examination of
the environment suitable for the platform.  It accepts \fIbufPtr\fR,
a pointer to an uninitialized or freed \fBTcl_DString\fR and writes
the encoding name to it.  The \fBTcl_DStringValue\fR is returned.
.VE 8.5
.PP
\fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list
consisting of the names of all the encodings that are currently defined
or can be dynamically loaded, searching the encoding path specified by
\fBTcl_SetEncodingSearchPath\fR.  This procedure does not ensure that the
\fBTcl_SetDefaultEncodingDir\fR.  This procedure does not ensure that the
dynamically-loadable encoding files contain valid data, but merely that they
exist.
.PP
\fBTcl_CreateEncoding\fR defines a new encoding and registers the C
procedures that are called back to convert between the encoding and
UTF-8.  Encodings created by \fBTcl_CreateEncoding\fR are thereafter
visible in the database used by \fBTcl_GetEncoding\fR.  Just as with the
\fBTcl_GetEncoding\fR procedure, the return value is a token that
represents the encoding and can be used in subsequent calls to other
encoding functions.  \fBTcl_CreateEncoding\fR returns an encoding with a
reference count of 1. If an encoding with the specified \fIname\fR
already exists, then its entry in the database is replaced with the new
encoding; the token for the old encoding will remain valid and continue
to behave as before, but users of the new token will now call the new
encoding procedures.
encoding procedures.  
.PP
The \fItypePtr\fR argument to \fBTcl_CreateEncoding\fR contains information
The \fItypePtr\fR argument to \fBTcl_CreateEncoding\fR contains information 
about the name of the encoding and the procedures that will be called to
convert between this encoding and UTF-8.  It is defined as follows:
.PP
.CS
typedef struct Tcl_EncodingType {
    const char *\fIencodingName\fR;
    Tcl_EncodingConvertProc *\fItoUtfProc\fR;
    Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
    Tcl_EncodingFreeProc *\fIfreeProc\fR;
    void *\fIclientData\fR;
    int \fInullSize\fR;
} \fBTcl_EncodingType\fR;
        const char *\fIencodingName\fR;
        Tcl_EncodingConvertProc *\fItoUtfProc\fR;
        Tcl_EncodingConvertProc *\fIfromUtfProc\fR;
        Tcl_EncodingFreeProc *\fIfreeProc\fR;
        ClientData \fIclientData\fR;
        int \fInullSize\fR;
} Tcl_EncodingType;  
.CE
.PP
The \fIencodingName\fR provides a string name for the encoding, by
which it can be referred in other procedures such as
\fBTcl_GetEncoding\fR.  The \fItoUtfProc\fR refers to a callback
procedure to invoke to convert text from this encoding into UTF-8.
The \fIfromUtfProc\fR refers to a callback procedure to invoke to
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
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
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







-
-
-
-
-
+
+
+
+
+

-
-
+
+















-
+




-
+

-

-
-
+
+




-
+

+


-
+















+
+
+
+
+
+
+
+
+
+








-
+







Constant-sized encodings with 3 or more bytes per character (such as
CNS11643) are not accepted.
.PP
The callback procedures \fItoUtfProc\fR and \fIfromUtfProc\fR should match the
type \fBTcl_EncodingConvertProc\fR:
.PP
.CS
typedef int \fBTcl_EncodingConvertProc\fR(
        void *\fIclientData\fR,
        const char *\fIsrc\fR,
        int \fIsrcLen\fR,
        int \fIflags\fR,
typedef int Tcl_EncodingConvertProc(
        ClientData \fIclientData\fR,
        const char *\fIsrc\fR, 
        int \fIsrcLen\fR, 
        int \fIflags\fR, 
        Tcl_EncodingState *\fIstatePtr\fR,
        char *\fIdst\fR,
        int \fIdstLen\fR,
        char *\fIdst\fR, 
        int \fIdstLen\fR, 
        int *\fIsrcReadPtr\fR,
        int *\fIdstWrotePtr\fR,
        int *\fIdstCharsPtr\fR);
.CE
.PP
The \fItoUtfProc\fR and \fIfromUtfProc\fR procedures are called by the
\fBTcl_ExternalToUtf\fR or \fBTcl_UtfToExternal\fR family of functions to
perform the actual conversion.  The \fIclientData\fR parameter to these
procedures is the same as the \fIclientData\fR field specified to
\fBTcl_CreateEncoding\fR when the encoding was created.  The remaining
arguments to the callback procedures are the same as the arguments,
documented at the top, to \fBTcl_ExternalToUtf\fR or
\fBTcl_UtfToExternal\fR, with the following exceptions.  If the
\fIsrcLen\fR argument to one of those high-level functions is negative,
the value passed to the callback procedure will be the appropriate
encoding-specific string length of \fIsrc\fR.  If any of the \fIsrcReadPtr\fR,
encoding-specific string length of \fIsrc\fR.  If any of the \fIsrcReadPtr\fR, 
\fIdstWrotePtr\fR, or \fIdstCharsPtr\fR arguments to one of the high-level
functions is NULL, the corresponding value passed to the callback
procedure will be a non-NULL location.
.PP
The callback procedure \fIfreeProc\fR, if non-NULL, should match the type
The callback procedure \fIfreeProc\fR, if non-NULL, should match the type 
\fBTcl_EncodingFreeProc\fR:
.PP
.CS
typedef void \fBTcl_EncodingFreeProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_EncodingFreeProc(
        ClientData \fIclientData\fR);
.CE
.PP
This \fIfreeProc\fR function is called when the encoding is deleted.  The
\fIclientData\fR parameter is the same as the \fIclientData\fR field
specified to \fBTcl_CreateEncoding\fR when the encoding was created.
specified to \fBTcl_CreateEncoding\fR when the encoding was created.  
.PP
.VS 8.5
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR
are called to access and set the list of filesystem directories searched
for encoding data files.
for encoding data files.  
.PP
The value returned by \fBTcl_GetEncodingSearchPath\fR
is the value stored by the last successful call to
\fBTcl_SetEncodingSearchPath\fR.  If no calls to
\fBTcl_SetEncodingSearchPath\fR have occurred, Tcl will compute an initial
value based on the environment.  There is one encoding search path for the
entire process, shared by all threads in the process.
.PP
\fBTcl_SetEncodingSearchPath\fR stores \fIsearchPath\fR and returns
\fBTCL_OK\fR, unless \fIsearchPath\fR is not a valid Tcl list, which
causes \fBTCL_ERROR\fR to be returned.  The elements of \fIsearchPath\fR
are not verified as existing readable filesystem directories.  When
searching for encoding data files takes place, and non-existent or
non-readable filesystem directories on the \fIsearchPath\fR are silently
ignored.
.PP
\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR
are obsolete interfaces best replaced with calls to
\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR.
They are called to access and set the first element of the \fIsearchPath\fR
list.  Since Tcl searches \fIsearchPath\fR for encoding data files in
list order, these routines establish the
.QW default
directory in which to find encoding data files.
.VE 8.5
.SH "ENCODING FILES"
Space would prohibit precompiling into Tcl every possible encoding
algorithm, so many encodings are stored on disk as dynamically-loadable
encoding files.  This behavior also allows the user to create additional
encoding files that can be loaded using the same mechanism.  These
encoding files contain information about the tables and/or escape
sequences used to map between an external encoding and Unicode.  The
external encoding may consist of single-byte, multi-byte, or double-byte
characters.
characters.  
.PP
Each dynamically-loadable encoding is represented as a text file.  The
initial line of the file, beginning with a
.QW #
symbol, is a comment
that provides a human-readable description of the file.  The next line
identifies the type of encoding file.  It can be one of the following
412
413
414
415
416
417
418
419

420
421

422
423
424
425
426
427
428
429
430
431
432
433
434
494
495
496
497
498
499
500

501
502

503
504
505
506
507
508

509
510
511
512
513
514
515







-
+

-
+





-







Certain bytes are lead bytes, indicating that another byte must follow
and that together the two bytes represent one character.  Other bytes are not
lead bytes and represent themselves.  An example is \fBshiftjis\fR, used by
many Japanese computers.
.IP "[4] \fBE\fR"
An escape-sequence encoding, specifying that certain sequences of bytes
do not represent characters, but commands that describe how following bytes
should be interpreted.
should be interpreted.  
.PP
The rest of the lines in the file depend on the type.
The rest of the lines in the file depend on the type.  
.PP
Cases [1], [2], and [3] are collectively referred to as table-based encoding
files.  The lines in a table-based encoding file are in the same
format as this example taken from the \fBshiftjis\fR encoding (this is not
the complete file):
.PP
.CS
# Encoding file: shiftjis, multi-byte
M
003F 0 40
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
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
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







-
+




















-







212B2030266F266D266A2020202100B6000000000000000025EF000000000000
.CE
.PP
The third line of the file is three numbers.  The first number is the
fallback character (in base 16) to use when converting from UTF-8 to this
encoding.  The second number is a \fB1\fR if this file represents the
encoding for a symbol font, or \fB0\fR otherwise.  The last number (in base
10) is how many pages of data follow.
10) is how many pages of data follow.  
.PP
Subsequent lines in the example above are pages that describe how to map
from the encoding into 2-byte Unicode.  The first line in a page identifies
the page number.  Following it are 256 double-byte numbers, arranged as 16
rows of 16 numbers.  Given a character in the encoding, the high byte of
that character is used to select which page, and the low byte of that
character is used as an index to select one of the double-byte numbers in
that page \- the value obtained being the corresponding Unicode character.
By examination of the example above, one can see that the characters 0x7E
and 0x8163 in \fBshiftjis\fR map to 203E and 2026 in Unicode, respectively.
.PP
Following the first page will be all the other pages, each in the same
format as the first: one number identifying the page followed by 256
double-byte Unicode characters.  If a character in the encoding maps to the
Unicode character 0000, it means that the character does not actually exist.
If all characters on a page would map to 0000, that page can be omitted.
.PP
Case [4] is the escape-sequence encoding file.  The lines in an this type of
file are in the same format as this example taken from the \fBiso2022-jp\fR
encoding:
.PP
.CS
.ta 1.5i
# Encoding file: iso2022-jp, escape-driven
E
init		{}
final		{}
iso8859-1	\ex1b(B

Changes to doc/Ensemble.3.

1
2
3
4
5
6

7
8

9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5

6
7

8
9
10
11
12

13
14
15
16
17
18
19
20





-
+

-
+




-
+







'\"
'\" Copyright (c) 2005 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
'\" This documents the C API introduced in TIP#235
'\"
'\" 
.TH Tcl_Ensemble 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CreateEnsemble, Tcl_FindEnsemble, Tcl_GetEnsembleFlags, Tcl_GetEnsembleMappingDict, Tcl_GetEnsembleNamespace, Tcl_GetEnsembleParameterList, Tcl_GetEnsembleUnknownHandler, Tcl_GetEnsembleSubcommandList, Tcl_IsEnsemble, Tcl_SetEnsembleFlags, Tcl_SetEnsembleMappingDict, Tcl_SetEnsembleParameterList, Tcl_SetEnsembleSubcommandList, Tcl_SetEnsembleUnknownHandler \- manipulate ensemble commands
Tcl_CreateEnsemble, Tcl_FindEnsemble, Tcl_GetEnsembleFlags, Tcl_GetEnsembleMappingDict, Tcl_GetEnsembleNamespace, Tcl_GetEnsembleUnknownHandler, Tcl_GetEnsembleSubcommandList, Tcl_IsEnsemble, Tcl_SetEnsembleFlags, Tcl_SetEnsembleMappingDict, Tcl_SetEnsembleSubcommandList, Tcl_SetEnsembleUnknownHandler \- manipulate ensemble commands
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_CreateEnsemble\fR(\fIinterp, name, namespacePtr, ensFlags\fR)
.sp
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
32
33
34
35
36
37
38






39
40
41
42
43
44
45







-
-
-
-
-
-







.sp
int
\fBTcl_GetEnsembleMappingDict\fR(\fIinterp, token, dictObjPtr\fR)
.sp
int
\fBTcl_SetEnsembleMappingDict\fR(\fIinterp, token, dictObj\fR)
.sp
int
\fBTcl_GetEnsembleParameterList\fR(\fIinterp, token, listObjPtr\fR)
.sp
int
\fBTcl_SetEnsembleParameterList\fR(\fIinterp, token, listObj\fR)
.sp
int
\fBTcl_GetEnsembleSubcommandList\fR(\fIinterp, token, listObjPtr\fR)
.sp
int
\fBTcl_SetEnsembleSubcommandList\fR(\fIinterp, token, listObj\fR)
.sp
int
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
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









-
+






-
+





-
+








-
-
-
+
+
+
-

-
+
-
-
+




+











-
-
+
+




-
+











-

-
+




-
-
+
+


-








-
+






-
-
-
-
-
-
-
-
-
-
-
-

-






-
+
-





-







-
+
-





-





-
+
+


-
-
.AP "const char" *name in
The name of the ensemble command to be created.
.AP Tcl_Namespace *namespacePtr in
The namespace to which the ensemble command is to be bound, or NULL
for the current namespace.
.AP int ensFlags in
An ORed set of flag bits describing the basic configuration of the
ensemble. Currently only one bit has meaning, \fBTCL_ENSEMBLE_PREFIX\fR,
ensemble. Currently only one bit has meaning, TCL_ENSEMBLE_PREFIX,
which is present when the ensemble command should also match
unambiguous prefixes of subcommands.
.AP Tcl_Obj *cmdNameObj in
A value holding the name of the ensemble command to look up.
.AP int flags in
An ORed set of flag bits controlling the behavior of
\fBTcl_FindEnsemble\fR. Currently only \fBTCL_LEAVE_ERR_MSG\fR is supported.
\fBTcl_FindEnsemble\fR. Currently only TCL_LEAVE_ERR_MSG is supported.
.AP Tcl_Command token in
A normal command token that refers to an ensemble command, or which
you wish to use for testing as an ensemble command in \fBTcl_IsEnsemble\fR.
.AP int *ensFlagsPtr out
Pointer to a variable into which to write the current ensemble flag
bits; currently only the bit \fBTCL_ENSEMBLE_PREFIX\fR is defined.
bits; currently only the bit TCL_ENSEMBLE_PREFIX is defined.
.AP Tcl_Obj *dictObj in
A dictionary value to use for the subcommand to implementation command
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
A list value to use for 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.
are to be removed.
.AP Tcl_Obj **listObjPtr out
Pointer to a variable into which to write the current list of formal
Pointer to a variable into which to write the current defiend list of
pre-subcommand parameters, the defined list of subcommands or the current
unknown handler prefix.
subcommands or the current unknown handler prefix.
.AP Tcl_Namespace **namespacePtrPtr out
Pointer to a variable into which to write the handle of the namespace
to which the ensemble is bound.
.BE

.SH DESCRIPTION
An ensemble is a command, bound to some namespace, which consists of a
collection of subcommands implemented by other Tcl commands. The first
argument to the ensemble command is always interpreted as a selector
that states what subcommand to execute.
.PP
Ensembles are created using \fBTcl_CreateEnsemble\fR, which takes four
arguments: the interpreter to work within, the name of the ensemble to
create, the namespace within the interpreter to bind the ensemble to,
and the default set of ensemble flags. The result of the function is
the command token for the ensemble, which may be used to further
configure the ensemble using the API described below in
\fBENSEMBLE PROPERTIES\fR.
configure the ensemble using the API described below in \fBENSEMBLE
PROPERTIES\fR.
.PP
Given the name of an ensemble command, the token for that command may
be retrieved using \fBTcl_FindEnsemble\fR. If the given command name
(in \fIcmdNameObj\fR) does not refer to an ensemble command, the
result of the function is NULL and (if the \fBTCL_LEAVE_ERR_MSG\fR bit is
result of the function is NULL and (if the TCL_LEAVE_ERR_MSG bit is
set in \fIflags\fR) an error message is left in the interpreter
result.
.PP
A command token may be checked to see if it refers to an ensemble
using \fBTcl_IsEnsemble\fR. This returns 1 if the token refers to an
ensemble, or 0 otherwise.
.SS "ENSEMBLE PROPERTIES"
Every ensemble has four read-write properties and a read-only
property. The properties are:
.TP
\fBflags\fR (read-write)
.
The set of flags for the ensemble, expressed as a
bit-field. Currently, the only public flag is \fBTCL_ENSEMBLE_PREFIX\fR
bit-field. Currently, the only public flag is TCL_ENSEMBLE_PREFIX
which is set when unambiguous prefixes of subcommands are permitted to
be resolved to implementations as well as exact matches. The flags may
be read and written using \fBTcl_GetEnsembleFlags\fR and
\fBTcl_SetEnsembleFlags\fR respectively. The result of both of those
functions is a Tcl result code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if
the token does not refer to an ensemble).
functions is a Tcl result code (TCL_OK, or TCL_ERROR if the token does
not refer to an ensemble).
.TP
\fBmapping dictionary\fR (read-write)
.
A dictionary containing a mapping from subcommand names to lists of
words to use as a command prefix (replacing the first two words of the
command which are the ensemble command itself and the subcommand
name), or NULL if every subcommand is to be mapped to the command with
the same unqualified name in the ensemble's bound namespace. Defaults
to NULL. May be read and written using
\fBTcl_GetEnsembleMappingDict\fR and \fBTcl_SetEnsembleMappingDict\fR
respectively. The result of both of those functions is a Tcl result
code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an
code (TCL_OK, or TCL_ERROR if the token does not refer to an
ensemble) and the dictionary obtained from
\fBTcl_GetEnsembleMappingDict\fR should always be treated as immutable
even if it is unshared.
All command names in prefixes set via \fBTcl_SetEnsembleMappingDict\fR
must be fully qualified.
.TP
\fBformal pre-subcommand parameter list\fR (read-write)
A list of formal parameter names (the names only being used when generating
error messages) that come at invocation of the ensemble between the name of
the ensemble and the subcommand argument. NULL (the default) is equivalent to
the empty list. May be read and written using
\fBTcl_GetEnsembleParameterList\fR and \fBTcl_SetEnsembleParameterList\fR
respectively. The result of both of those functions is a Tcl result code
(\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an
ensemble) and the
dictionary obtained from \fBTcl_GetEnsembleParameterList\fR should always be
treated as immutable even if it is unshared.
.TP
\fBsubcommand list\fR (read-write)
.
A list of all the subcommand names for the ensemble, or NULL if this
is to be derived from either the keys of the mapping dictionary (see
above) or (if that is also NULL) from the set of commands exported by
the bound namespace. May be read and written using
\fBTcl_GetEnsembleSubcommandList\fR and
\fBTcl_SetEnsembleSubcommandList\fR respectively. The result of both
of those functions is a Tcl result code (\fBTCL_OK\fR, or
of those functions is a Tcl result code (TCL_OK, or TCL_ERROR if the
\fBTCL_ERROR\fR if the
token does not refer to an ensemble) and the list obtained from
\fBTcl_GetEnsembleSubcommandList\fR should always be treated as
immutable even if it is unshared.
.TP
\fBunknown subcommand handler command prefix\fR (read-write)
.
A list of words to prepend on the front of any subcommand when the
subcommand is unknown to the ensemble (according to the current prefix
handling rule); see the \fBnamespace ensemble\fR command for more
details. If NULL, the default behavior \- generate a suitable error
message \- will be used when an unknown subcommand is encountered. May
be read and written using \fBTcl_GetEnsembleUnknownHandler\fR and
\fBTcl_SetEnsembleUnknownHandler\fR respectively. The result of both
functions is a Tcl result code (\fBTCL_OK\fR, or \fBTCL_ERROR\fR if
functions is a Tcl result code (TCL_OK, or TCL_ERROR if the token does
the token does
not refer to an ensemble) and the list obtained from
\fBTcl_GetEnsembleUnknownHandler\fR should always be treated as
immutable even if it is unshared.
.TP
\fBbound namespace\fR (read-only)
.
The namespace to which the ensemble is bound; when the namespace is
deleted, so too will the ensemble, and this namespace is also the
namespace whose list of exported commands is used if both the mapping
dictionary and the subcommand list properties are NULL. May be read
using \fBTcl_GetEnsembleNamespace\fR which returns a Tcl result code
(\fBTCL_OK\fR, or \fBTCL_ERROR\fR if the token does not refer to an ensemble).
(TCL_OK, or TCL_ERROR if the token does not refer to an ensemble).

.SH "SEE ALSO"
namespace(n), Tcl_DeleteCommandFromToken(3)
.SH KEYWORDS
command, ensemble

Changes to doc/Environment.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1997-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_PutEnv \- procedures to manipulate the environment
.SH SYNOPSIS
.nf
29
30
31
32
33
34
35
36

37
38
29
30
31
32
33
34
35

36
37
38







-
+


.QW \fINAME\fB=\fIvalue\fR .
This procedure is
intended to be a stand-in for the UNIX \fBputenv\fR system call. All
Tcl-based applications using \fBputenv\fR should redefine it to
\fBTcl_PutEnv\fR so that they will interface properly to the Tcl
runtime.
.SH "SEE ALSO"
env(n)
tclvars(n)
.SH KEYWORDS
environment, variable

Changes to doc/Eval.3.

1
2
3
4
5
6
7
8

9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5
6
7

8
9
10
11
12

13
14
15
16
17
18
19
20







-
+




-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval \- execute Tcl scripts
Tcl_EvalObjEx, Tcl_EvalFile, Tcl_EvalObjv, Tcl_Eval, Tcl_EvalEx, Tcl_GlobalEval, Tcl_GlobalEvalObj, Tcl_VarEval, Tcl_VarEvalVA \- execute Tcl scripts
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_EvalObjEx\fR(\fIinterp, objPtr, flags\fR)
.sp
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
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







+
+
+






-
+






-
+


-
+









+
+
+













-
+







\fBTcl_GlobalEval\fR(\fIinterp, script\fR)
.sp
int
\fBTcl_GlobalEvalObj\fR(\fIinterp, objPtr\fR)
.sp
int
\fBTcl_VarEval\fR(\fIinterp, part, part, ... \fB(char *) NULL\fR)
.sp
int
\fBTcl_VarEvalVA\fR(\fIinterp, argList\fR)
.SH ARGUMENTS
.AS Tcl_Interp **termPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute the script.  The interpreter's result is
modified to hold the result or error message from the script.
.AP Tcl_Obj *objPtr in
A Tcl value containing the script to execute.
A Tcl object containing the script to execute.
.AP int flags in
ORed combination of flag bits that specify additional options.
\fBTCL_EVAL_GLOBAL\fR and \fBTCL_EVAL_DIRECT\fR are currently supported.
.AP "const char" *fileName in
Name of a file containing a Tcl script.
.AP int objc in
The number of values in the array pointed to by \fIobjPtr\fR;
The number of objects in the array pointed to by \fIobjPtr\fR;
this is also the number of words in the command.
.AP Tcl_Obj **objv in
Points to an array of pointers to values; each value holds the
Points to an array of pointers to objects; each object holds the
value of a single word in the command to execute.
.AP int numBytes in
The number of bytes in \fIscript\fR, not including any
null terminating character.  If \-1, then all characters up to the
first null byte are used.
.AP "const char" *script in
Points to first byte of script to execute (null-terminated and UTF-8).
.AP char *part in
String forming part of a Tcl script.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.BE

.SH DESCRIPTION
.PP
The procedures described here are invoked to execute Tcl scripts in
various forms.
\fBTcl_EvalObjEx\fR is the core procedure and is used by many of the others.
It executes the commands in the script stored in \fIobjPtr\fR
until either an error occurs or the end of the script is reached.
If this is the first time \fIobjPtr\fR has been executed,
its commands are compiled into bytecode instructions
which are then executed.  The
bytecodes are saved in \fIobjPtr\fR so that the compilation step
can be skipped if the value is evaluated again in the future.
can be skipped if the object is evaluated again in the future.
.PP
The return value from \fBTcl_EvalObjEx\fR (and all the other procedures
described here) is a Tcl completion code with
one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, \fBTCL_RETURN\fR,
\fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly some other
integer value originating in an extension.
In addition, a result value or error message is left in \fIinterp\fR's
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
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







-
+



-
-
+
+


-
+







-
-
+
+
+
+
+
+


-
+
+
+












-
+


+
+
+
+


-




-





-
+




-
-
-
-
+
+
+
+
-







or
.QW \eu001a ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
\fBTcl_EvalObjv\fR executes a single pre-parsed command instead of a
script.  The \fIobjc\fR and \fIobjv\fR arguments contain the values
of the words for the Tcl command, one word in each value in
of the words for the Tcl command, one word in each object in
\fIobjv\fR.  \fBTcl_EvalObjv\fR evaluates the command and returns
a completion code and result just like \fBTcl_EvalObjEx\fR.
The caller of \fBTcl_EvalObjv\fR has to manage the reference count of the
elements of \fIobjv\fR, insuring that the values are valid until
\fBTcl_EvalObjv\fR returns.
elements of \fIobjv\fR, insuring that the objects are valid until
\fBTcl_EvalObjv\fR returns.  
.PP
\fBTcl_Eval\fR is similar to \fBTcl_EvalObjEx\fR except that the script to
be executed is supplied as a string instead of a value and no compilation
be executed is supplied as a string instead of an object and no compilation
occurs.  The string should be a proper UTF-8 string as converted by
\fBTcl_ExternalToUtfDString\fR or \fBTcl_ExternalToUtf\fR when it is known
to possibly contain upper ASCII characters whose possible combinations
might be a UTF-8 special code.  The string is parsed and executed directly
(using \fBTcl_EvalObjv\fR) instead of compiling it and executing the
bytecodes.  In situations where it is known that the script will never be
executed again, \fBTcl_Eval\fR may be faster than \fBTcl_EvalObjEx\fR.
 \fBTcl_Eval\fR returns a completion code and result just like
\fBTcl_EvalObjEx\fR.
 \fBTcl_Eval\fR returns a completion code and result just like 
\fBTcl_EvalObjEx\fR.  Note: for backward compatibility with versions before
Tcl 8.0, \fBTcl_Eval\fR copies the object result in \fIinterp\fR to
\fIinterp->result\fR (use is deprecated) where it can be accessed directly.
 This makes \fBTcl_Eval\fR somewhat slower than \fBTcl_EvalEx\fR, which
does not do the copy.
.PP
\fBTcl_EvalEx\fR is an extended version of \fBTcl_Eval\fR that takes
additional arguments \fInumBytes\fR and \fIflags\fR.
additional arguments \fInumBytes\fR and \fIflags\fR.  For the
efficiency reason given above, \fBTcl_EvalEx\fR is generally preferred
over \fBTcl_Eval\fR.
.PP
\fBTcl_GlobalEval\fR and \fBTcl_GlobalEvalObj\fR are older procedures
that are now deprecated.  They are similar to \fBTcl_EvalEx\fR and
\fBTcl_EvalObjEx\fR except that the script is evaluated in the global
namespace and its variable context consists of global variables only
(it ignores any Tcl procedures that are active).  These functions are
equivalent to using the \fBTCL_EVAL_GLOBAL\fR flag (see below).
.PP
\fBTcl_VarEval\fR takes any number of string arguments
of any length, concatenates them into a single string,
then calls \fBTcl_Eval\fR to execute that string as a Tcl command.
It returns the result of the command and also modifies
the interpreter result in the same way as \fBTcl_Eval\fR.
\fIinterp->result\fR in the same way as \fBTcl_Eval\fR.
The last argument to \fBTcl_VarEval\fR must be NULL to indicate the end
of arguments.  \fBTcl_VarEval\fR is now deprecated.
.PP
\fBTcl_VarEvalVA\fR is the same as \fBTcl_VarEval\fR except that
instead of taking a variable number of arguments it takes an argument
list. Like \fBTcl_VarEval\fR, \fBTcl_VarEvalVA\fR is deprecated.

.SH "FLAG BITS"
.PP
Any ORed combination of the following values may be used for the
\fIflags\fR argument to procedures such as \fBTcl_EvalObjEx\fR:
.TP 23
\fBTCL_EVAL_DIRECT\fR
.
This flag is only used by \fBTcl_EvalObjEx\fR; it is ignored by
other procedures.  If this flag bit is set, the script is not
compiled to bytecodes; instead it is executed directly
as is done by \fBTcl_EvalEx\fR.  The
\fBTCL_EVAL_DIRECT\fR flag is useful in situations where the
contents of a value are going to change immediately, so the
contents of an object are going to change immediately, so the
bytecodes will not be reused in a future execution.  In this case,
it is faster to execute the script directly.
.TP 23
\fBTCL_EVAL_GLOBAL\fR
.
If this flag is set, the script is evaluated in the global namespace instead of
the current namespace and its variable context consists of global variables
only (it ignores any Tcl procedures that are active).
If this flag is set, the script is processed at global level.  This
means that it is evaluated in the global namespace and its variable
context consists of global variables only (it ignores any Tcl
procedures at are active).
.\" TODO: document TCL_EVAL_INVOKE and TCL_EVAL_NOERR.

.SH "MISCELLANEOUS DETAILS"
.PP
During the processing of a Tcl command it is legal to make nested
calls to evaluate other commands (this is how procedures and
some control structures are implemented).
If a code other than \fBTCL_OK\fR is returned
185
186
187
188
189
190
191
192

193
194
195

198
199
200
201
202
203
204

205
206
207

208







-
+


-
+
about to be returned from the topmost \fBTcl_EvalObjEx\fR
invocation for \fIinterp\fR,
it converts the return code to \fBTCL_ERROR\fR
and sets \fIinterp\fR's result to an error message indicating that
the \fBreturn\fR, \fBbreak\fR, or \fBcontinue\fR command was
invoked in an inappropriate place.
This means that top-level applications should never see a return code
from \fBTcl_EvalObjEx\fR other than \fBTCL_OK\fR or \fBTCL_ERROR\fR.
from \fBTcl_EvalObjEx\fR other then \fBTCL_OK\fR or \fBTCL_ERROR\fR.

.SH KEYWORDS
execute, file, global, result, script, value
execute, file, global, object, result, script

Changes to doc/Exit.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Exit 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Exit, Tcl_Finalize, Tcl_CreateExitHandler, Tcl_DeleteExitHandler, Tcl_ExitThread, Tcl_FinalizeThread, Tcl_CreateThreadExitHandler, Tcl_DeleteThreadExitHandler, Tcl_SetExitProc \- end the application or thread (and invoke exit handlers)
.SH SYNOPSIS
.nf
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

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







+


+











-
+



















+


-
+

+






+
+
+
+
-
-
+
+
















-

-
-
+

-














+










-
+





+







-
-
-
+
+
+
-
-

-
+
.sp
\fBTcl_FinalizeThread\fR()
.sp
\fBTcl_CreateThreadExitHandler\fR(\fIproc, clientData\fR)
.sp
\fBTcl_DeleteThreadExitHandler\fR(\fIproc, clientData\fR)
.sp
.VS 8.5
Tcl_ExitProc *
\fBTcl_SetExitProc\fR(\fIproc\fR)
.VE 8.5
.SH ARGUMENTS
.AS Tcl_ExitProc clientData
.AP int status  in
Provides information about why the application or thread exited.
Exact meaning may
be platform-specific.  0 usually means a normal exit, any nonzero value
usually means that an error occurred.
.AP Tcl_ExitProc *proc in
Procedure to invoke before exiting application, or (for
\fBTcl_SetExitProc\fR) NULL to uninstall the current application exit
procedure.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
The procedures described here provide a graceful mechanism to end the
execution of a \fBTcl\fR application. Exit handlers are invoked to cleanup the
application's state before ending the execution of \fBTcl\fR code.
.PP
Invoke \fBTcl_Exit\fR to end a \fBTcl\fR application and to exit from this
process. This procedure is invoked by the \fBexit\fR command, and can be
invoked anyplace else to terminate the application.
No-one should ever invoke the \fBexit\fR system procedure directly;  always
invoke \fBTcl_Exit\fR instead, so that it can invoke exit handlers.
Note that if other code invokes \fBexit\fR system procedure directly, or
otherwise causes the application to terminate without calling
\fBTcl_Exit\fR, the exit handlers will not be run.
\fBTcl_Exit\fR internally invokes the \fBexit\fR system call, thus it never
returns control to its caller.
.VS 8.5
If an application exit handler has been installed (see
\fBTcl_SetExitProc\fR), that handler is invoked with an argument
consisting of the exit status (cast to void *); the application
consisting of the exit status (cast to ClientData); the application
exit handler should not return control to Tcl.
.VE 8.5
.PP
\fBTcl_Finalize\fR is similar to \fBTcl_Exit\fR except that it does not
exit from the current process.
It is useful for cleaning up when a process is finished using \fBTcl\fR but
wishes to continue executing, and when \fBTcl\fR is used in a dynamically
loaded extension that is about to be unloaded.
On some systems \fBTcl\fR is automatically notified when it is being
unloaded, and it calls \fBTcl_Finalize\fR internally; on these systems it
not necessary for the caller to explicitly call \fBTcl_Finalize\fR.
However, to ensure portability, your code should always invoke
Your code should always invoke \fBTcl_Finalize\fR when \fBTcl\fR is being
unloaded, to ensure proper cleanup. \fBTcl_Finalize\fR can be safely called
\fBTcl_Finalize\fR when \fBTcl\fR is being unloaded, to ensure that the
code will work on all platforms. \fBTcl_Finalize\fR can be safely called
more than once.
.PP
\fBTcl_ExitThread\fR is used to terminate the current thread and invoke
per-thread exit handlers.  This finalization is done by
\fBTcl_FinalizeThread\fR, which you can call if you just want to clean
up per-thread state and invoke the thread exit handlers.
\fBTcl_Finalize\fR calls \fBTcl_FinalizeThread\fR for the current
thread automatically.
.PP
\fBTcl_CreateExitHandler\fR arranges for \fIproc\fR to be invoked
by \fBTcl_Finalize\fR and \fBTcl_Exit\fR.
\fBTcl_CreateThreadExitHandler\fR arranges for \fIproc\fR to be invoked
by \fBTcl_FinalizeThread\fR and \fBTcl_ExitThread\fR.
This provides a hook for cleanup operations such as flushing buffers
and freeing global memory.
\fIProc\fR should match the type \fBTcl_ExitProc\fR:
.PP
.CS
typedef void \fBTcl_ExitProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_ExitProc(ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR parameter to \fIproc\fR is a
copy of the \fIclientData\fR argument given to
\fBTcl_CreateExitHandler\fR or \fBTcl_CreateThreadExitHandler\fR when
the callback
was created.  Typically, \fIclientData\fR points to a data
structure containing application-specific information about
what to do in \fIproc\fR.
.PP
\fBTcl_DeleteExitHandler\fR and \fBTcl_DeleteThreadExitHandler\fR may be
called to delete a
previously-created exit handler.  It removes the handler
indicated by \fIproc\fR and \fIclientData\fR so that no call
to \fIproc\fR will be made.  If no such handler exists then
\fBTcl_DeleteExitHandler\fR or \fBTcl_DeleteThreadExitHandler\fR does nothing.
.PP
.PP
\fBTcl_Finalize\fR and \fBTcl_Exit\fR execute all registered exit handlers,
in reverse order from the order in which they were registered.
This matches the natural order in which extensions are loaded and unloaded;
if extension \fBA\fR loads extension \fBB\fR, it usually
unloads \fBB\fR before it itself is unloaded.
If extension \fBA\fR registers its exit handlers before loading extension
\fBB\fR, this ensures that any exit handlers for \fBB\fR will be executed
before the exit handlers for \fBA\fR.
.PP
\fBTcl_Finalize\fR and \fBTcl_Exit\fR call \fBTcl_FinalizeThread\fR
\fBTcl_Finalize\fR and \fBTcl_Exit\fR call \fBTcl_FinalizeThread\fR 
and the thread exit handlers \fIafter\fR
the process-wide exit handlers.  This is because thread finalization shuts
down the I/O channel system, so any attempt at I/O by the global exit
handlers will vanish into the bitbucket.
.PP
.VS 8.5
\fBTcl_SetExitProc\fR installs an application exit handler, returning
the previously-installed application exit handler or NULL if no
application handler was installed.  If an application exit handler is
installed, that exit handler takes over complete responsibility for
finalization of Tcl's subsystems via \fBTcl_Finalize\fR at an
appropriate time.  The argument passed to \fIproc\fR when it is
invoked will be the exit status code (as passed to \fBTcl_Exit\fR)
cast to a void *value.
.PP
\fBTcl_SetExitProc\fR can not be used in stub-enabled extensions.
cast to a ClientData value.
.VE 8.5

.SH "SEE ALSO"
exit(n)
.SH KEYWORDS
abort, callback, cleanup, dynamic loading, end application, exit, unloading, thread
callback, cleanup, dynamic loading, end application, exit, unloading, thread

Changes to doc/ExprLong.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString \- evaluate an expression
.SH SYNOPSIS
.nf
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
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







-
+


















-
+

-
+

-
+







int
\fBTcl_ExprString\fR(\fIinterp, expr\fR)
.SH ARGUMENTS
.AS Tcl_Interp *booleanPtr out
.AP Tcl_Interp *interp in
Interpreter in whose context to evaluate \fIexpr\fR.
.AP "const char" *expr in
Expression to be evaluated.
Expression to be evaluated.  
.AP long *longPtr out
Pointer to location in which to store the integer value of the
expression.
.AP int *doublePtr out
Pointer to location in which to store the floating-point value of the
expression.
.AP int *booleanPtr out
Pointer to location in which to store the 0/1 boolean value of the
expression.
.BE

.SH DESCRIPTION
.PP
These four procedures all evaluate the expression
given by the \fIexpr\fR argument
and return the result in one of four different forms.
The expression can have any of the forms accepted by the \fBexpr\fR command.
Note that these procedures have been largely replaced by the
value-based procedures \fBTcl_ExprLongObj\fR, \fBTcl_ExprDoubleObj\fR,
object-based procedures \fBTcl_ExprLongObj\fR, \fBTcl_ExprDoubleObj\fR,
\fBTcl_ExprBooleanObj\fR, and \fBTcl_ExprObj\fR.
Those value-based procedures evaluate an expression held in a Tcl value
Those object-based procedures evaluate an expression held in a Tcl object
instead of a string.
The value argument can retain an internal representation
The object argument can retain an internal representation
that is more efficient to execute.
.PP
The \fIinterp\fR argument refers to an interpreter used to
evaluate the expression (e.g. for variables and nested Tcl
commands) and to return error information.
.PP
For all of these procedures the return value is a standard
99
100
101
102
103
104
105
106

99
100
101
102
103
104
105

106







-
+
\fBTcl_ExprString\fR returns the value of the expression as a
string stored in the interpreter's result.

.SH "SEE ALSO"
Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj

.SH KEYWORDS
boolean, double, evaluate, expression, integer, value, string
boolean, double, evaluate, expression, integer, object, string

Changes to doc/ExprLongObj.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1996-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.
'\"
'\" 
.TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_ExprLongObj, Tcl_ExprDoubleObj, Tcl_ExprBooleanObj, Tcl_ExprObj \- evaluate an expression
.SH SYNOPSIS
.nf
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
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







-
+










-
+







int
\fBTcl_ExprObj\fR(\fIinterp, objPtr, resultPtrPtr\fR)
.SH ARGUMENTS
.AS Tcl_Interp **resultPtrPtr out
.AP Tcl_Interp *interp in
Interpreter in whose context to evaluate \fIobjPtr\fR.
.AP Tcl_Obj *objPtr in
Pointer to a value containing the expression to evaluate.
Pointer to an object containing the expression to evaluate.
.AP long *longPtr out
Pointer to location in which to store the integer value of the
expression.
.AP int *doublePtr out
Pointer to location in which to store the floating-point value of the
expression.
.AP int *booleanPtr out
Pointer to location in which to store the 0/1 boolean value of the
expression.
.AP Tcl_Obj **resultPtrPtr out
Pointer to location in which to store a pointer to the value
Pointer to location in which to store a pointer to the object
that is the result of the expression.
.BE

.SH DESCRIPTION
.PP
These four procedures all evaluate an expression, returning
the result in one of four different forms.
89
90
91
92
93
94
95
96

97
98
99
100


101
102
103
104
105
106

89
90
91
92
93
94
95

96
97
98


99
100
101
102
103
104
105

106







-
+


-
-
+
+





-
+
such as
.QW yes
or
.QW no ,
or else an error occurs.
.PP
If \fBTcl_ExprObj\fR successfully evaluates the expression,
it stores a pointer to the Tcl value
it stores a pointer to the Tcl object
containing the expression's value at \fI*resultPtrPtr\fR.
In this case, the caller is responsible for calling
\fBTcl_DecrRefCount\fR to decrement the value's reference count
when it is finished with the value.
\fBTcl_DecrRefCount\fR to decrement the object's reference count
when it is finished with the object.

.SH "SEE ALSO"
Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean, Tcl_ExprString, Tcl_GetObjResult

.SH KEYWORDS
boolean, double, evaluate, expression, integer, value, string
boolean, double, evaluate, expression, integer, object, string

Changes to doc/FileSystem.3.

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
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


-



-
+




-
+










-
+





-
+







'\"
'\" Copyright (c) 2001 Vincent Darley
'\" Copyright (c) 2008-2010 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Filesystem 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSEvalFileEx, Tcl_FSLoadFile, Tcl_FSUnloadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_GetAccessTimeFromStat, Tcl_GetBlockSizeFromStat, Tcl_GetBlocksFromStat, Tcl_GetChangeTimeFromStat, Tcl_GetDeviceTypeFromStat, Tcl_GetFSDeviceFromStat, Tcl_GetFSInodeFromStat, Tcl_GetGroupIdFromStat, Tcl_GetLinkCountFromStat, Tcl_GetModeFromStat, Tcl_GetModificationTimeFromStat, Tcl_GetSizeFromStat, Tcl_GetUserIdFromStat, Tcl_AllocStatBuf \- procedures to interact with any filesystem
Tcl_FSRegister, Tcl_FSUnregister, Tcl_FSData, Tcl_FSMountsChanged, Tcl_FSGetFileSystemForPath, Tcl_FSGetPathType, Tcl_FSCopyFile, Tcl_FSCopyDirectory, Tcl_FSCreateDirectory, Tcl_FSDeleteFile, Tcl_FSRemoveDirectory, Tcl_FSRenameFile, Tcl_FSListVolumes, Tcl_FSEvalFile, Tcl_FSEvalFileEx, Tcl_FSLoadFile, Tcl_FSMatchInDirectory, Tcl_FSLink, Tcl_FSLstat, Tcl_FSUtime, Tcl_FSFileAttrsGet, Tcl_FSFileAttrsSet, Tcl_FSFileAttrStrings, Tcl_FSStat, Tcl_FSAccess, Tcl_FSOpenFileChannel, Tcl_FSGetCwd, Tcl_FSChdir, Tcl_FSPathSeparator, Tcl_FSJoinPath, Tcl_FSSplitPath, Tcl_FSEqualPaths, Tcl_FSGetNormalizedPath, Tcl_FSJoinToPath, Tcl_FSConvertToPathType, Tcl_FSGetInternalRep, Tcl_FSGetTranslatedPath, Tcl_FSGetTranslatedStringPath, Tcl_FSNewNativePath, Tcl_FSGetNativePath, Tcl_FSFileSystemInfo, Tcl_AllocStatBuf \- procedures to interact with any filesystem
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_FSRegister\fR(\fIclientData, fsPtr\fR)
.sp
int
\fBTcl_FSUnregister\fR(\fIfsPtr\fR)
.sp
void *
ClientData
\fBTcl_FSData\fR(\fIfsPtr\fR)
.sp
void
\fBTcl_FSMountsChanged\fR(\fIfsPtr\fR)
.sp
const Tcl_Filesystem *
Tcl_Filesystem*
\fBTcl_FSGetFileSystemForPath\fR(\fIpathPtr\fR)
.sp
Tcl_PathType
\fBTcl_FSGetPathType\fR(\fIpathPtr\fR)
.sp
int
\fBTcl_FSCopyFile\fR(\fIsrcPathPtr, destPathPtr\fR)
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
363
364
365
366
367
368
369
370

371
372
373
374
375
376
377
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







-
+


+


+






-
+
-
-
-




-
+














-
+











-
+





-
+


-
+


-
+





-
+


-
+





-
+








-
+


-
+


-
+


-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+



-
-
+
+














-
+



-
-
+
+

-
+


-
+





-
+

-
+


-
+

-
+



-
+

-
+











-
+


-
+



-
-




-
+


-
+




-
+
















+



-
+

-
+

-
-
+
+




-
+




-
+

-
+


-
+










-
-
+
+

-
+






-
-
-
-
+
+
+
+


-
-
+
+


-
+

-
+

-





-


-
+

-
+


-
+











-
+







.sp
int
\fBTcl_FSRemoveDirectory\fR(\fIpathPtr, int recursive, errorPtr\fR)
.sp
int
\fBTcl_FSRenameFile\fR(\fIsrcPathPtr, destPathPtr\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSListVolumes\fR(\fIvoid\fR)
.sp
.VS 8.5
int
\fBTcl_FSEvalFileEx\fR(\fIinterp, pathPtr, encodingName\fR)
.VE 8.5
.sp
int
\fBTcl_FSEvalFile\fR(\fIinterp, pathPtr\fR)
.sp
int
\fBTcl_FSLoadFile\fR(\fIinterp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
               loadHandlePtr, unloadProcPtr\fR)
               handlePtr, unloadProcPtr\fR)
.sp
int
\fBTcl_FSUnloadFile\fR(\fIinterp, loadHandle\fR)
.sp
int
\fBTcl_FSMatchInDirectory\fR(\fIinterp, resultPtr, pathPtr, pattern, types\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSLink\fR(\fIlinkNamePtr, toPtr, linkAction\fR)
.sp
int
\fBTcl_FSLstat\fR(\fIpathPtr, statPtr\fR)
.sp
int
\fBTcl_FSUtime\fR(\fIpathPtr, tval\fR)
.sp
int
\fBTcl_FSFileAttrsGet\fR(\fIinterp, int index, pathPtr, objPtrRef\fR)
.sp
int
\fBTcl_FSFileAttrsSet\fR(\fIinterp, int index, pathPtr, Tcl_Obj *objPtr\fR)
.sp
const char *const *
const char**
\fBTcl_FSFileAttrStrings\fR(\fIpathPtr, objPtrRef\fR)
.sp
int
\fBTcl_FSStat\fR(\fIpathPtr, statPtr\fR)
.sp
int
\fBTcl_FSAccess\fR(\fIpathPtr, mode\fR)
.sp
Tcl_Channel
\fBTcl_FSOpenFileChannel\fR(\fIinterp, pathPtr, modeString, permissions\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSGetCwd\fR(\fIinterp\fR)
.sp
int
\fBTcl_FSChdir\fR(\fIpathPtr\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSPathSeparator\fR(\fIpathPtr\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSJoinPath\fR(\fIlistObj, elements\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSSplitPath\fR(\fIpathPtr, lenPtr\fR)
.sp
int
\fBTcl_FSEqualPaths\fR(\fIfirstPtr, secondPtr\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSGetNormalizedPath\fR(\fIinterp, pathPtr\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSJoinToPath\fR(\fIbasePtr, objc, objv\fR)
.sp
int
\fBTcl_FSConvertToPathType\fR(\fIinterp, pathPtr\fR)
.sp
void *
ClientData
\fBTcl_FSGetInternalRep\fR(\fIpathPtr, fsPtr\fR)
.sp
Tcl_Obj *
\fBTcl_FSGetTranslatedPath\fR(\fIinterp, pathPtr\fR)
.sp
const char *
\fBTcl_FSGetTranslatedStringPath\fR(\fIinterp, pathPtr\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSNewNativePath\fR(\fIfsPtr, clientData\fR)
.sp
const void *
const char *
\fBTcl_FSGetNativePath\fR(\fIpathPtr\fR)
.sp
Tcl_Obj *
Tcl_Obj*
\fBTcl_FSFileSystemInfo\fR(\fIpathPtr\fR)
.sp
Tcl_StatBuf *
Tcl_StatBuf*
\fBTcl_AllocStatBuf\fR()
.sp
Tcl_WideInt
\fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
\fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideInt
\fBTcl_GetChangeTimeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetDeviceTypeFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetFSDeviceFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetFSInodeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetGroupIdFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetLinkCountFromStat\fR(\fIstatPtr\fR)
.sp
unsigned
\fBTcl_GetModeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideInt
\fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR)
.sp
Tcl_WideUInt
\fBTcl_GetSizeFromStat\fR(\fIstatPtr\fR)
.sp
int
\fBTcl_GetUserIdFromStat\fR(\fIstatPtr\fR)
.SH ARGUMENTS
.AS Tcl_GlobTypeData **srcPathPtr out
.AP "const Tcl_Filesystem" *fsPtr in
.AS Tcl_FSUnloadFileProc **unloadProcPtr out
.AP Tcl_Filesystem *fsPtr in
Points to a structure containing the addresses of procedures that
can be called to perform the various filesystem operations.
.AP Tcl_Obj *pathPtr in
The path represented by this value is used for the operation in
question. If the value does not already have an internal \fBpath\fR
The path represented by this object is used for the operation in
question.  If the object does not already have an internal \fBpath\fR
representation, it will be converted to have one.
.AP Tcl_Obj *srcPathPtr in
As for \fIpathPtr\fR, but used for the source file for a copy or
rename operation.
.AP Tcl_Obj *destPathPtr in
As for \fIpathPtr\fR, but used for the destination filename for a copy or
rename operation.
.AP "const char" *encodingName in
The encoding of the data stored in the
file identified by \fIpathPtr\fR and to be evaluated.
.AP "const char" *pattern in
Only files or directories matching this pattern will be returned.
.AP Tcl_GlobTypeData *types in
Only files or directories matching the type descriptions contained in
this structure will be returned. This parameter may be NULL.
this structure will be returned.  This parameter may be NULL.
.AP Tcl_Interp *interp in
Interpreter to use either for results, evaluation, or reporting error
messages.
.AP void *clientData in
The native description of the path value to create.
.AP ClientData clientData in
The native description of the path object to create.
.AP Tcl_Obj *firstPtr in
The first of two path values to compare. The value may be converted
The first of two path objects to compare.  The object may be converted
to \fBpath\fR type.
.AP Tcl_Obj *secondPtr in
The second of two path values to compare. The value may be converted
The second of two path objects to compare.  The object may be converted
to \fBpath\fR type.
.AP Tcl_Obj *listObj in
The list of path elements to operate on with a \fBjoin\fR operation.
.AP int elements in
If non-negative, the number of elements in the \fIlistObj\fR which should
be joined together. If negative, then all elements are joined.
be joined together.  If negative, then all elements are joined.
.AP Tcl_Obj **errorPtr out
In the case of an error, filled with a value containing the name of
In the case of an error, filled with an object containing the name of
the file which caused an error in the various copy/rename operations.
.AP Tcl_Obj **objPtrRef out
Filled with a value containing the result of the operation.
Filled with an object containing the result of the operation.
.AP Tcl_Obj *resultPtr out
Pre-allocated value in which to store (using
Pre-allocated object in which to store (using
\fBTcl_ListObjAppendElement\fR) the list of
files or directories which are successfully matched.
.AP int mode in
Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK. R_OK,
Mask consisting of one or more of R_OK, W_OK, X_OK and F_OK.  R_OK,
W_OK and X_OK request checking whether the file exists and  has  read,
write and  execute  permissions, respectively. F_OK just requests
write and  execute  permissions, respectively.  F_OK just requests
checking for the existence of the file.
.AP Tcl_StatBuf *statPtr out
The structure that contains the result of a stat or lstat operation.
.AP "const char" *sym1 in
Name of a procedure to look up in the file's symbol table
.AP "const char" *sym2 in
Name of a procedure to look up in the file's symbol table
.AP Tcl_PackageInitProc **proc1Ptr out
Filled with the init function for this code.
.AP Tcl_PackageInitProc **proc2Ptr out
Filled with the safe-init function for this code.
.AP void **clientDataPtr out
.AP ClientData *clientDataPtr out
Filled with the clientData value to pass to this code's unload
function when it is called.
.AP Tcl_LoadHandle *loadHandlePtr out
.AP Tcl_LoadHandle *handlePtr out
Filled with an abstract token representing the loaded file.
.AP Tcl_FSUnloadFileProc **unloadProcPtr out
Filled with the function to use to unload this piece of code.
.AP Tcl_LoadHandle loadHandle in
Handle to the loaded library to be unloaded.
.AP utimbuf *tval in
The access and modification times in this structure are read and
used to set those values for a given file.
.AP "const char" *modeString in
Specifies how the file is to be accessed. May have any of the values
Specifies how the file is to be accessed.  May have any of the values
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
.AP int permissions in
POSIX-style permission flags such as 0644. If a new file is created, these
POSIX-style permission flags such as 0644.  If a new file is created, these
permissions will be set on the created file.
.AP int *lenPtr out
If non-NULL, filled with the number of elements in the split path.
.AP Tcl_Obj *basePtr in
The base path on to which to join the given elements. May be NULL.
The base path on to which to join the given elements.  May be NULL.
.AP int objc in
The number of elements in \fIobjv\fR.
.AP "Tcl_Obj *const" objv[] in
The elements to join to the given base path.
.AP Tcl_Obj *linkNamePtr in
The name of the link to be created or read.
.AP Tcl_Obj *toPtr in
What the link called \fIlinkNamePtr\fR should be linked to, or NULL if
the symbolic link specified by \fIlinkNamePtr\fR is to be read.
.AP int linkAction in
OR-ed combination of flags indicating what kind of link should be
created (will be ignored if \fItoPtr\fR is NULL). Valid bits to set
are \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
When both flags are set and the underlying filesystem can do either,
symbolic links are preferred.
.BE

.SH DESCRIPTION
.PP
There are several reasons for calling the \fBTcl_FS\fR API functions
(e.g.\ \fBTcl_FSAccess\fR and \fBTcl_FSStat\fR)
(e.g. \fBTcl_FSAccess\fR and \fBTcl_FSStat\fR)
rather than calling system level functions like \fBaccess\fR and
\fBstat\fR directly. First, they will work cross-platform, so an
\fBstat\fR directly.  First, they will work cross-platform, so an
extension which calls them should work unmodified on Unix and
Windows. Second, the Windows implementation of some of these functions
fixes some bugs in the system level calls. Third, these function calls
Windows.  Second, the Windows implementation of some of these functions
fixes some bugs in the system level calls.  Third, these function calls
deal with any
.QW "Utf to platform-native"
path conversions which may be
required (and may cache the results of such conversions for greater
efficiency on subsequent calls). Fourth, and perhaps most importantly,
efficiency on subsequent calls).  Fourth, and perhaps most importantly,
all of these functions are
.QW "virtual filesystem aware" .
Any virtual filesystem (VFS for short) which has been registered (through
\fBTcl_FSRegister\fR) may reroute file access to alternative
media or access methods. This means that all of these functions (and
media or access methods.  This means that all of these functions (and
therefore the corresponding \fBfile\fR, \fBglob\fR, \fBpwd\fR, \fBcd\fR,
\fBopen\fR, etc.\ Tcl commands) may be operate on
\fBopen\fR, etc.  Tcl commands) may be operate on
.QW files
which are not
native files in the native filesystem. This also means that any Tcl
native files in the native filesystem.  This also means that any Tcl
extension which accesses the filesystem (FS for short) through this API is
automatically
.QW "virtual filesystem aware" .
Of course, if an extension
accesses the native filesystem directly (through platform-specific
APIs, for example), then Tcl cannot intercept such calls.
.PP
If appropriate VFSes have been registered, the
.QW files
may, to give two
examples, be remote (e.g.\ situated on a remote ftp server) or archived
(e.g.\ lying inside a .zip archive). Such registered filesystems provide
examples, be remote (e.g. situated on a remote ftp server) or archived
(e.g. lying inside a .zip archive).  Such registered filesystems provide
a lookup table of functions to implement all or some of the functionality
listed here. Finally, the \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR calls
listed here.  Finally, the \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR calls
abstract away from what the
.QW "struct stat"
buffer is actually
declared to be, allowing the same code to be used both on systems with
and systems without support for files larger than 2GB in size.
.PP
The \fBTcl_FS\fR API is \fBTcl_Obj\fR-ified and may cache internal
representations and other path-related strings (e.g.\ the current working
directory). One side-effect of this is that one must not pass in values
with a reference count of zero to any of these functions. If such calls were
The \fBTcl_FS\fR API is objectified and may cache internal
representations and other path-related strings (e.g. the current working
directory).  One side-effect of this is that one must not pass in objects
with a reference count of zero to any of these functions.  If such calls were
handled, they might result
in memory leaks (under some circumstances, the filesystem code may wish
to retain a reference to the passed in value, and so one must not assume
that after any of these calls return, the value still has a reference count of
to retain a reference to the passed in object, and so one must not assume
that after any of these calls return, the object still has a reference count of
zero - it may have been incremented) or in a direct segmentation fault
(or other memory access error)
due to the value being freed part way through the complex value
due to the object being freed part way through the complex object
manipulation required to ensure that the path is fully normalized and
absolute for filesystem determination. The practical lesson to learn
absolute for filesystem determination.  The practical lesson to learn
from this is that
.PP
.CS
Tcl_Obj *path = Tcl_NewStringObj(...);
Tcl_FS\fIWhatever\fR(path);
Tcl_DecrRefCount(path);
.CE
.PP
is wrong, and may cause memory errors. The \fIpath\fR must have its
reference count incremented before passing it in, or
decrementing it. For this reason, values with a reference count of zero are
decrementing it.  For this reason, objects with a reference count of zero are
considered not to be valid filesystem paths and calling any Tcl_FS API
function with such a value will result in no action being taken.
function with such an object will result in no action being taken.
.SS "FS API FUNCTIONS"
\fBTcl_FSCopyFile\fR attempts to copy the file given by \fIsrcPathPtr\fR to the
path name given by \fIdestPathPtr\fR. If the two paths given lie in the same
path name given by \fIdestPathPtr\fR.  If the two paths given lie in the same
filesystem (according to \fBTcl_FSGetFileSystemForPath\fR) then that
filesystem's
.QW "copy file"
function is called (if it is non-NULL).
Otherwise the function returns -1 and sets the \fBerrno\fR global C
variable to the
.QW EXDEV
POSIX error code (which signifies a
.QW "cross-domain link" ).
.PP
\fBTcl_FSCopyDirectory\fR attempts to copy the directory given by \fIsrcPathPtr\fR to the
path name given by \fIdestPathPtr\fR. If the two paths given lie in the same
path name given by \fIdestPathPtr\fR.  If the two paths given lie in the same
filesystem (according to \fBTcl_FSGetFileSystemForPath\fR) then that
filesystem's
.QW "copy file"
function is called (if it is non-NULL).
Otherwise the function returns -1 and sets the \fBerrno\fR global C
variable to the
.QW EXDEV
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


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

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
611
612
613

614
615
616
617

618
619

620
621
622
623

624
625
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
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
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
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

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
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

611
612
613
614




615
616
617
618

619
620
621
622

623
624
625
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
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
756
757


758
759
760
761
762
763
764
765
766
767
768

769
770
771
772
773
774
775







-
+



-
+







-
+



+


-
+

-
+















-
+

+



-
-
+
+



-
-
-
-

-
-
+
+

-
-
-

-
+



-
-
+
+




-
+

-
+



-
+




-
+

-
-
-
-
+
+
+
+

-
-
+
+

-
+

-
-
+
+

-
-
+
+




-
-


-
+





-
+







-
+


-
+




-
+



-
+



-
+

-
+


-
+



-
+



-
+



-
-
+
+

-
-
+
+




-
-


-
+
















-
+





-
+




-
+


-
-
+
+




-
-
+
+




-
+




-
+



-
+



-
+

-
+



-
+



-
+

-
-
-
-
-
+
+
+
+
+



-
+

-
+




-
-
+
+
+






-
+




-
+


-
-
+
+

-
+



-
-
-
-
+
+
+
+
-




-
+






-
-
+
+




-
+




-
+






-
-
-
+
+
+






-
-
-
-
+
+
+
+





-
-
+
+



-
-
+
+

-
+

-
+

-
+




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

-
+

-
+

-
+


-
+




-
+







-
+



-
+


-
+










-

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











-
+

-
+

-
+


-
+


-
-
+
+









-







.PP
\fBTcl_FSRemoveDirectory\fR attempts to remove the directory given by
\fIpathPtr\fR by calling the owning filesystem's
.QW "remove directory"
function.
.PP
\fBTcl_FSRenameFile\fR attempts to rename the file or directory given by
\fIsrcPathPtr\fR to the path name given by \fIdestPathPtr\fR. If the two paths
\fIsrcPathPtr\fR to the path name given by \fIdestPathPtr\fR.  If the two paths
given lie in the same filesystem (according to
\fBTcl_FSGetFileSystemForPath\fR) then that filesystem's
.QW "rename file"
function is called (if it is non-NULL). Otherwise the function returns -1
function is called (if it is non-NULL).  Otherwise the function returns -1
and sets the \fBerrno\fR global C variable to the
.QW EXDEV
POSIX error code (which signifies a
.QW "cross-domain link" ).
.PP
\fBTcl_FSListVolumes\fR calls each filesystem which has a non-NULL
.QW "list volumes"
function and asks them to return their list of root volumes. It
function and asks them to return their list of root volumes.  It
accumulates the return values in a list which is returned to the
caller (with a reference count of 0).
.PP
.VS 8.5
\fBTcl_FSEvalFileEx\fR reads the file given by \fIpathPtr\fR using
the encoding identified by \fIencodingName\fR and evaluates
its contents as a Tcl script. It returns the same information as
its contents as a Tcl script.  It returns the same information as
\fBTcl_EvalObjEx\fR.
If \fIencodingName\fR is NULL, the utf-8 encoding is used for
If \fIencodingName\fR is NULL, the system encoding is used for
reading the file contents.
If the file could not be read then a Tcl error is returned to describe
why the file could not be read.
The eofchar for files is
.QW \e32
(^Z) for all platforms.
If you require a
.QW ^Z
in code for string comparison, you can use
.QW \e032
or
.QW \eu001a ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
\fBTcl_FSEvalFile\fR is a simpler version of
\fBTcl_FSEvalFileEx\fR that always uses the utf-8 encoding
\fBTcl_FSEvalFileEx\fR that always uses the system encoding
when reading the file.
.VE 8.5
.PP
\fBTcl_FSLoadFile\fR dynamically loads a binary code file into memory and
returns the addresses of two procedures within that file, if they are
defined. The appropriate function for the filesystem to which \fIpathPtr\fR
belongs will be called. If that filesystem does not implement this
defined.  The appropriate function for the filesystem to which \fIpathPtr\fR
belongs will be called.  If that filesystem does not implement this
function (most virtual filesystems will not, because of OS limitations
in dynamically loading binary code), Tcl will attempt to copy the file
to a temporary directory and load that temporary file.
\fBTcl_FSUnloadFile\fR reverses the operation, asking for the library
indicated by the \fIloadHandle\fR to be removed from the process. Note that,
unlike with the \fBunload\fR command, this does not give the library any
opportunity to clean up.
.PP
Both the above functions return a standard Tcl completion code. If an error
occurs, an error message is left in the \fIinterp\fR's result.
Returns a standard Tcl completion code.  If an error occurs, an error
message is left in the \fIinterp\fR's result.
.PP
The token provided via the variable indicated by \fIloadHandlePtr\fR may be
used with \fBTcl_FindSymbol\fR.
.PP
\fBTcl_FSMatchInDirectory\fR is used by the globbing code to search a
directory for all files which match a given pattern. The appropriate
directory for all files which match a given pattern.  The appropriate
function for the filesystem to which \fIpathPtr\fR belongs will be called.
.PP
The return value is a standard Tcl result indicating whether an error
occurred in globbing. Error messages are placed in interp (unless
interp is NULL, which is allowed), but good results are placed in the
occurred in globbing.  Error messages are placed in interp (unless 
interp is NULL, which is allowed), but good results are placed in the 
resultPtr given.
.PP
Note that the \fBglob\fR code implements recursive patterns internally, so
this function will only ever be passed simple patterns, which can be
matched using the logic of \fBstring match\fR. To handle recursion, Tcl
matched using the logic of \fBstring match\fR.  To handle recursion, Tcl
will call this function frequently asking only for directories to be
returned. A special case of being called with a NULL pattern indicates
returned.  A special case of being called with a NULL pattern indicates
that the path needs to be checked only for the correct type.
.PP
\fBTcl_FSLink\fR replaces the library version of \fBreadlink\fR, and
extends it to support the creation of links. The appropriate function
extends it to support the creation of links.  The appropriate function
for the filesystem to which \fIlinkNamePtr\fR belongs will be called.
.PP
If the \fItoPtr\fR is NULL, a
.QW "read link"
action is performed. The result
action is performed.  The result
is a Tcl_Obj specifying the contents of the symbolic link given by
\fIlinkNamePtr\fR, or NULL if the link could not be read. The result is owned
by the caller, which should call \fBTcl_DecrRefCount\fR when the result is no
longer needed. If the \fItoPtr\fR is not NULL, Tcl should create a link
of one of the types passed in in the \fIlinkAction\fR flag. This flag is
\fIlinkNamePtr\fR, or NULL if the link could not be read.  The result is owned
by the caller, which should call Tcl_DecrRefCount when the result is no
longer needed.  If the \fItoPtr\fR is not NULL, Tcl should create a link
of one of the types passed in in the \fIlinkAction\fR flag.  This flag is
an ORed combination of \fBTCL_CREATE_SYMBOLIC_LINK\fR and \fBTCL_CREATE_HARD_LINK\fR.
Where a choice exists (i.e.\ more than one flag is passed in), the Tcl
convention is to prefer symbolic links. When a link is successfully
Where a choice exists (i.e. more than one flag is passed in), the Tcl
convention is to prefer symbolic links.  When a link is successfully
created, the return value should be \fItoPtr\fR (which is therefore
already owned by the caller). If unsuccessful, NULL is returned.
already owned by the caller).  If unsuccessful, NULL is returned.
.PP
\fBTcl_FSLstat\fR fills the \fITcl_StatBuf\fR structure \fIstatPtr\fR with
information about the specified file. You do not need any access rights to the
\fBTcl_FSLstat\fR fills the stat structure \fIstatPtr\fR with information
about the specified file.  You do not need any access rights to the
file to get this information but you need search rights to all
directories named in the path leading to the file. The \fITcl_StatBuf\fR
structure includes info regarding device, inode (always 0 on Windows),
directories named in the path leading to the file.  The stat structure
includes info regarding device, inode (always 0 on Windows),
privilege mode, nlink (always 1 on Windows), user id (always 0 on
Windows), group id (always 0 on Windows), rdev (same as device on
Windows), size, last access time, last modification time, and
last metadata change time.
See \fBPORTABLE STAT RESULT API\fR for a description of how to write
portable code to allocate and access the \fITcl_StatBuf\fR structure.
.PP
If \fIpath\fR exists, \fBTcl_FSLstat\fR returns 0 and the stat structure
is filled with data. Otherwise, -1 is returned, and no stat info is
is filled with data.  Otherwise, -1 is returned, and no stat info is
given.
.PP
\fBTcl_FSUtime\fR replaces the library version of utime.
.PP
This returns 0 on success and -1 on error (as per the \fButime\fR
documentation). If successful, the function
documentation).  If successful, the function
will update the
.QW atime
and
.QW mtime
values of the file given.
.PP
\fBTcl_FSFileAttrsGet\fR implements read access for the hookable \fBfile
attributes\fR subcommand. The appropriate function for the filesystem to
attributes\fR subcommand.  The appropriate function for the filesystem to
which \fIpathPtr\fR belongs will be called.
.PP
If the result is \fBTCL_OK\fR, then a value was placed in
If the result is \fBTCL_OK\fR, then an object was placed in
\fIobjPtrRef\fR, which
will only be temporarily valid (unless \fBTcl_IncrRefCount\fR is called).
.PP
\fBTcl_FSFileAttrsSet\fR implements write access for the hookable \fBfile
attributes\fR subcommand. The appropriate function for the filesystem to
attributes\fR subcommand.  The appropriate function for the filesystem to
which \fIpathPtr\fR belongs will be called.
.PP
\fBTcl_FSFileAttrStrings\fR implements part of the hookable \fBfile
attributes\fR subcommand. The appropriate function for the filesystem
attributes\fR subcommand.  The appropriate function for the filesystem
to which \fIpathPtr\fR belongs will be called.
.PP
The called procedure may either return an array of strings, or may
instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR. Tcl
instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR.  Tcl
will take that list and first increment its reference count before using it.
On completion of that use, Tcl will decrement its reference count. Hence if
On completion of that use, Tcl will decrement its reference count.  Hence if
the list should be disposed of by Tcl when done, it should have a
reference count of zero, and if the list should not be disposed of, the
filesystem should ensure it retains a reference count to the value.
filesystem should ensure it retains a reference count to the object.
.PP
\fBTcl_FSAccess\fR checks whether the process would be allowed to read,
write or test for existence of the file (or other filesystem object)
whose name is \fIpathname\fR. If \fIpathname\fR is a symbolic link on Unix,
whose name is \fIpathname\fR.   If \fIpathname\fR is a symbolic link on Unix,
then permissions of the file referred by this symbolic link are
tested.
.PP
On success (all requested permissions granted), zero is returned. On
On success (all requested permissions granted), zero is returned.  On
error (at least one bit in mode asked for a permission that is denied,
or some other error occurred), -1 is returned.
.PP
\fBTcl_FSStat\fR fills the \fITcl_StatBuf\fR structure \fIstatPtr\fR with
information about the specified file. You do not need any access rights to the
\fBTcl_FSStat\fR fills the stat structure \fIstatPtr\fR with information
about the specified file.  You do not need any access rights to the
file to get this information but you need search rights to all
directories named in the path leading to the file. The \fITcl_StatBuf\fR
structure includes info regarding device, inode (always 0 on Windows),
directories named in the path leading to the file.  The stat structure
includes info regarding device, inode (always 0 on Windows),
privilege mode, nlink (always 1 on Windows), user id (always 0 on
Windows), group id (always 0 on Windows), rdev (same as device on
Windows), size, last access time, last modification time, and
last metadata change time.
See \fBPORTABLE STAT RESULT API\fR for a description of how to write
portable code to allocate and access the \fITcl_StatBuf\fR structure.
.PP
If \fIpath\fR exists, \fBTcl_FSStat\fR returns 0 and the stat structure
is filled with data. Otherwise, -1 is returned, and no stat info is
is filled with data.  Otherwise, -1 is returned, and no stat info is
given.
.PP
\fBTcl_FSOpenFileChannel\fR opens a file specified by \fIpathPtr\fR and
returns a channel handle that can be used to perform input and output on
the file. This API is modeled after the \fBfopen\fR procedure of
the Unix standard I/O library.
The syntax and meaning of all arguments is similar to those
given in the Tcl \fBopen\fR command when opening a file.
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
If one of the standard channels, \fBstdin, stdout\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
It returns the Tcl library's current working directory.  This may be
different to the native platform's working directory, which happens when
the current working directory is not in the native filesystem.
.PP
The result is a pointer to a Tcl_Obj specifying the current directory,
or NULL if the current directory could not be determined. If NULL is
or NULL if the current directory could not be determined.  If NULL is
returned, an error message is left in the \fIinterp\fR's result.
.PP
The result already has its reference count incremented for the caller. When
it is no longer needed, that reference count should be decremented. This is
The result already has its reference count incremented for the caller.  When
it is no longer needed, that reference count should be decremented.  This is
needed for thread-safety purposes, to allow multiple threads to access
this and related functions, while ensuring the results are always
valid.
.PP
\fBTcl_FSChdir\fR replaces the library version of \fBchdir\fR. The path is
normalized and then passed to the filesystem which claims it. If that
\fBTcl_FSChdir\fR replaces the library version of \fBchdir\fR.  The path is
normalized and then passed to the filesystem which claims it.  If that
filesystem does not implement this function, Tcl will fallback to a
combination of \fBstat\fR and \fBaccess\fR to check whether the directory
exists and has appropriate permissions.
.PP
For results, see \fBchdir\fR documentation. If successful, we keep a
For results, see \fBchdir\fR documentation.  If successful, we keep a
record of the successful path in \fIcwdPathPtr\fR for subsequent calls to
\fBTcl_FSGetCwd\fR.
.PP
\fBTcl_FSPathSeparator\fR returns the separator character to be used for
most specific element of the path specified by \fIpathPtr\fR (i.e.\ the last
most specific element of the path specified by \fIpathPtr\fR (i.e. the last
part of the path).
.PP
The separator is returned as a Tcl_Obj containing a string of length
1. If the path is invalid, NULL is returned.
1.  If the path is invalid, NULL is returned.
.PP
\fBTcl_FSJoinPath\fR takes the given Tcl_Obj, which must be a valid
list (which is allowed to have a reference count of zero), and returns the path
value given by considering the first \fIelements\fR elements as valid path
object given by considering the first \fIelements\fR elements as valid path
segments (each path segment may be a complete path, a partial path or
just a single possible directory or file name). If any path segment is
just a single possible directory or file name).  If any path segment is
actually an absolute path, then all prior path segments are discarded.
If \fIelements\fR is less than 0, we use the entire list.
.PP
It is possible that the returned value is actually an element
It is possible that the returned object is actually an element
of the given list, so the caller should be careful to increment the
reference count of the result before freeing the list.
.PP
The returned value, typically with a reference count of zero (but it
The returned object, typically with a reference count of zero (but it
could be shared
under some conditions), contains the joined path. The caller must
add a reference count to the value before using it. In particular, the
returned value could be an element of the given list, so freeing the
list might free the value prematurely if no reference count has been taken.
If the number of elements is zero, then the returned value will be
under some conditions), contains the joined path.  The caller must
add a reference count to the object before using it.  In particular, the
returned object could be an element of the given list, so freeing the
list might free the object prematurely if no reference count has been taken.
If the number of elements is zero, then the returned object will be
an empty-string Tcl_Obj.
.PP
\fBTcl_FSSplitPath\fR takes the given Tcl_Obj, which should be a valid path,
and returns a Tcl list value containing each segment of that path as
and returns a Tcl list object containing each segment of that path as
an element.
It returns a list value with a reference count of zero. If the
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
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
It returns the normalized path value, owned by Tcl, or NULL if the path
It returns the normalized path object, owned by Tcl, or NULL if the path
was invalid or could otherwise not be successfully converted.
Extraction of absolute, normalized paths is very efficient (because the
filesystem operates on these representations internally), although the
result when the filesystem contains numerous symbolic links may not be
the most user-friendly version of a path. The return value is owned by
the most user-friendly version of a path.  The return value is owned by
Tcl and has a lifetime equivalent to that of the \fIpathPtr\fR passed in
(unless that is a relative path, in which case the normalized path
value may be freed any time the cwd changes) - the caller can of
course increment the reference count if it wishes to maintain a copy for longer.
object may be freed any time the cwd changes) - the caller can of
course increment the refCount if it wishes to maintain a copy for longer.
.PP
\fBTcl_FSJoinToPath\fR takes the given value, which should usually be a
\fBTcl_FSJoinToPath\fR takes the given object, which should usually be a
valid path or NULL, and joins onto it the array of paths segments
given.
.PP
Returns a value, typically with reference count of zero (but it could be shared
under some conditions), containing the joined path. The caller must
add a reference count to the value before using it. If any of the values
passed into this function (\fIpathPtr\fR or \fIpath\fR elements) have
Returns object, typically with refCount of zero (but it could be shared
under some conditions), containing the joined path.  The caller must
add a refCount to the object before using it.  If any of the objects
passed into this function (pathPtr or path elements) have a refCount
a reference count
of zero, they will be freed when this function returns.
.PP
\fBTcl_FSConvertToPathType\fR tries to convert the given Tcl_Obj to a valid
Tcl path type, taking account of the fact that the cwd may have changed
even if this value is already supposedly of the correct type.
even if this object is already supposedly of the correct type.
The filename may begin with
.QW ~
(to indicate current user's home directory) or
.QW ~<user>
(to indicate any user's home directory).
.PP
If the conversion succeeds (i.e.\ the value is a valid path in one of
the current filesystems), then \fBTCL_OK\fR is returned. Otherwise
If the conversion succeeds (i.e. the object is a valid path in one of
the current filesystems), then \fBTCL_OK\fR is returned.  Otherwise
\fBTCL_ERROR\fR is returned, and an error message may
be left in the interpreter.
.PP
\fBTcl_FSGetInternalRep\fR extracts the internal representation of a given
path value, in the given filesystem. If the path value belongs to a
path object, in the given filesystem.  If the path object belongs to a
different filesystem, we return NULL. If the internal representation is
currently NULL, we attempt to generate it, by calling the filesystem's
\fBTcl_FSCreateInternalRepProc\fR.
.PP
Returns NULL or a valid internal path representation. This internal
Returns NULL or a valid internal path representation.  This internal
representation is cached, so that repeated calls to this function will
not require additional conversions.
.PP
\fBTcl_FSGetTranslatedPath\fR attempts to extract the translated path
from the given Tcl_Obj.
.PP
If the translation succeeds (i.e.\ the value is a valid path), then it is
returned. Otherwise NULL will be returned, and an error message may be
left in the interpreter. A
If the translation succeeds (i.e. the object is a valid path), then it is
returned.  Otherwise NULL will be returned, and an error message may be
left in the interpreter.  A
.QW translated
path is one which contains no
.QW ~
or
.QW ~user
sequences (these have been expanded to their current
representation in the filesystem). The value returned is owned by the
caller, which must store it or call \fBTcl_DecrRefCount\fR to ensure memory is
freed. This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
representation in the filesystem).  The object returned is owned by the
caller, which must store it or call Tcl_DecrRefCount to ensure memory is
freed.  This function is of little practical use, and
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSGetTranslatedStringPath\fR does the same as
\fBTcl_FSGetTranslatedPath\fR, but returns a character string or NULL.
The string returned is dynamically allocated and owned by the caller,
which must store it or call \fBTcl_Free\fR to ensure it is freed. Again,
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_FSGetNativePath\fR are usually
which must store it or call \fBckfree\fR to ensure it is freed.  Again,
\fBTcl_FSGetNormalizedPath\fR or \fBTcl_GetNativePath\fR are usually
better functions to use for most purposes.
.PP
\fBTcl_FSNewNativePath\fR performs something like the reverse of the
usual obj->path->nativerep conversions. If some code retrieves a path
in native form (from, e.g.\ \fBreadlink\fR or a native dialog), and that path
usual obj->path->nativerep conversions.  If some code retrieves a path
in native form (from, e.g. \fBreadlink\fR or a native dialog), and that path
is to be used at the Tcl level, then calling this function is an
efficient way of creating the appropriate path value type.
efficient way of creating the appropriate path object type.
.PP
The resulting value is a pure
The resulting object is a pure
.QW path
value, which will only receive
object, which will only receive
a UTF-8 string representation if that is required by some Tcl code.
.PP
\fBTcl_FSGetNativePath\fR is for use by the Win/Unix native
filesystems, so that they can easily retrieve the native (char* or
TCHAR*) representation of a path. This function is a convenience
wrapper around \fBTcl_FSGetInternalRep\fR. It may be desirable in the
future to have non-string-based native representations (for example,
on MacOSX, a representation using a fileSpec of FSRef structure would
probably be more efficient). On Windows a full Unicode representation
would allow for paths of unlimited length. Currently the representation
is simply a character string which may contain either the relative path
or a complete, absolute normalized path in the native encoding (complex
TCHAR*) representation of a path.  This function is a convenience
wrapper around \fBTcl_FSGetInternalRep\fR, and assumes the native
representation is string-based.  It may be desirable in the future to
have non-string-based native representations (for example, on MacOSX, a
representation using a fileSpec of FSRef structure would probably be
more efficient).  On Windows a full Unicode representation would allow
for paths of unlimited length.  Currently the representation is simply a
character string which may contain either the relative path or a
complete, absolute normalized path in the native encoding (complex
conditions dictate which of these will be provided, so neither can be
relied upon, unless the path is known to be absolute). If you need a
relied upon, unless the path is known to be absolute).  If you need a
native path which must be absolute, then you should ask for the native
version of a normalized path. If for some reason a non-absolute,
version of a normalized path.  If for some reason a non-absolute,
non-normalized version of the path is needed, that must be constructed
separately (e.g.\ using \fBTcl_FSGetTranslatedPath\fR).
separately (e.g. using \fBTcl_FSGetTranslatedPath\fR).
.PP
The native representation is cached so that repeated calls to this
function will not require additional conversions. The return value is
function will not require additional conversions.  The return value is
owned by Tcl and has a lifetime equivalent to that of the \fIpathPtr\fR
passed in (unless that is a relative path, in which case the native
representation may be freed any time the cwd changes).
.PP
\fBTcl_FSFileSystemInfo\fR returns a list of two elements. The first
\fBTcl_FSFileSystemInfo\fR returns a list of two elements.  The first
element is the name of the filesystem (e.g.
.QW native ,
.QW vfs ,
.QW zip ,
or
.QW prowrap ,
perhaps), and the second is the particular type of the
given path within that filesystem (which is filesystem dependent). The
given path within that filesystem (which is filesystem dependent).  The
second element may be empty if the filesystem does not provide a
further categorization of files.
.PP
A valid list value is returned, unless the path value is not
A valid list object is returned, unless the path object is not
recognized, when NULL will be returned.
.PP
\fBTcl_FSGetFileSystemForPath\fR returns a pointer to the
\fBTcl_FSGetFileSystemForPath\fR returns the a pointer to the
\fBTcl_Filesystem\fR which accepts this path as valid.
.PP
If no filesystem will accept the path, NULL is returned.
.PP
\fBTcl_FSGetPathType\fR determines whether the given path is relative
to the current directory, relative to the current volume, or
absolute.
.PP
It returns one of \fBTCL_PATH_ABSOLUTE\fR, \fBTCL_PATH_RELATIVE\fR, or
\fBTCL_PATH_VOLUME_RELATIVE\fR
.SS "PORTABLE STAT RESULT API"
.PP
\fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system heap (which
may be deallocated by being passed to \fBTcl_Free\fR). This allows extensions to
invoke \fBTcl_FSStat\fR and \fBTcl_FSLstat\fR without being dependent on the
size of the buffer. That in turn depends on the flags used to build Tcl.
\fBTcl_AllocStatBuf\fR allocates a \fITcl_StatBuf\fR on the system
heap (which may be deallocated by being passed to \fBckfree\fR.)  This
allows extensions to invoke \fBTcl_FSStat\fR and \fBTcl_FSLStat\fR
without being dependent on the size of the buffer.  That in turn
depends on the flags used to build Tcl.
.PP
The portable fields of a \fITcl_StatBuf\fR may be read using the following
functions, each of which returns the value of the corresponding field listed
in the table below. Note that on some platforms there may be other fields in
the \fITcl_StatBuf\fR as it is an alias for a suitable system structure, but
only the portable ones are made available here. See your system documentation
for a full description of these fields.
.DS
.ta \w'\fBTcl_GetModificationTimeFromStat\fR\0\0\0\0'u
\fIAccess Function\fR	\fIField\fR
 \fBTcl_GetFSDeviceFromStat\fR	 st_dev
 \fBTcl_GetFSInodeFromStat\fR	 st_ino
 \fBTcl_GetModeFromStat\fR	 st_mode
 \fBTcl_GetLinkCountFromStat\fR	 st_nlink
 \fBTcl_GetUserIdFromStat\fR	 st_uid
 \fBTcl_GetGroupIdFromStat\fR	 st_gid
 \fBTcl_GetDeviceTypeFromStat\fR	 st_rdev
 \fBTcl_GetAccessTimeFromStat\fR	 st_atime
 \fBTcl_GetModificationTimeFromStat\fR	 st_mtime
 \fBTcl_GetChangeTimeFromStat\fR	 st_ctime
 \fBTcl_GetSizeFromStat\fR	 st_size
 \fBTcl_GetBlocksFromStat\fR	 st_blocks
 \fBTcl_GetBlockSizeFromStat\fR	 st_blksize
.DE
.SH "THE VIRTUAL FILESYSTEM API"
.PP
A filesystem provides a \fBTcl_Filesystem\fR structure that contains
pointers to functions that implement the various operations on a
filesystem; these operations are invoked as needed by the generic
layer, which generally occurs through the functions listed above.
.PP
The \fBTcl_Filesystem\fR structures are manipulated using the following
methods.
.PP
\fBTcl_FSRegister\fR takes a pointer to a filesystem structure and an
optional piece of data to associated with that filesystem. On calling
optional piece of data to associated with that filesystem.  On calling
this function, Tcl will attach the filesystem to the list of known
filesystems, and it will become fully functional immediately. Tcl does
filesystems, and it will become fully functional immediately.  Tcl does
not check if the same filesystem is registered multiple times (and in
general that is not a good thing to do). \fBTCL_OK\fR will be returned.
general that is not a good thing to do).  \fBTCL_OK\fR will be returned.
.PP
\fBTcl_FSUnregister\fR removes the given filesystem structure from
the list of known filesystems, if it is known, and returns \fBTCL_OK\fR. If
the list of known filesystems, if it is known, and returns \fBTCL_OK\fR.  If
the filesystem is not currently registered, \fBTCL_ERROR\fR is returned.
.PP
\fBTcl_FSData\fR will return the clientData associated with the given
filesystem, if that filesystem is registered. Otherwise it will
\fBTcl_FSData\fR will return the ClientData associated with the given
filesystem, if that filesystem is registered.  Otherwise it will
return NULL.
.PP
\fBTcl_FSMountsChanged\fR is used to inform the Tcl's core that
the set of mount points for the given (already registered) filesystem
have changed, and that cached file representations may therefore no
longer be correct.
.SS "THE TCL_FILESYSTEM STRUCTURE"
.PP
The \fBTcl_Filesystem\fR structure contains the following fields:
.PP
.CS
typedef struct Tcl_Filesystem {
    const char *\fItypeName\fR;
    int \fIstructureLength\fR;
    Tcl_FSVersion \fIversion\fR;
    Tcl_FSPathInFilesystemProc *\fIpathInFilesystemProc\fR;
    Tcl_FSDupInternalRepProc *\fIdupInternalRepProc\fR;
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
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







-
+













-
+







-
+

-
+




-
+







-







    Tcl_FSCopyFileProc *\fIcopyFileProc\fR;
    Tcl_FSRenameFileProc *\fIrenameFileProc\fR;
    Tcl_FSCopyDirectoryProc *\fIcopyDirectoryProc\fR;
    Tcl_FSLstatProc *\fIlstatProc\fR;
    Tcl_FSLoadFileProc *\fIloadFileProc\fR;
    Tcl_FSGetCwdProc *\fIgetCwdProc\fR;
    Tcl_FSChdirProc *\fIchdirProc\fR;
} \fBTcl_Filesystem\fR;
} Tcl_Filesystem;
.CE
.PP
Except for the first three fields in this structure which contain
simple data elements, all entries contain addresses of functions called
by the generic filesystem layer to perform the complete range of
filesystem related actions.
.PP
The many functions in this structure are broken down into three
categories: infrastructure functions (almost all of which must be
implemented), operational functions (which must be implemented if a
complete filesystem is provided), and efficiency functions (which need
only be implemented if they can be done so efficiently, or if they have
side-effects which are required by the filesystem; Tcl has less
efficient emulations it can fall back on). It is important to note
efficient emulations it can fall back on).  It is important to note
that, in the current version of Tcl, most of these fallbacks are only
used to handle commands initiated in Tcl, not in C. What this means is,
that if a \fBfile rename\fR command is issued in Tcl, and the relevant
filesystem(s) do not implement their \fITcl_FSRenameFileProc\fR, Tcl's
core will instead fallback on a combination of other filesystem
functions (it will use \fITcl_FSCopyFileProc\fR followed by
\fITcl_FSDeleteFileProc\fR, and if \fITcl_FSCopyFileProc\fR is not
implemented there is a further fallback). However, if a
implemented there is a further fallback).  However, if a
\fITcl_FSRenameFileProc\fR command is issued at the C level, no such
fallbacks occur. This is true except for the last four entries in the
fallbacks occur.  This is true except for the last four entries in the
filesystem table (\fBlstat\fR, \fBload\fR, \fBgetcwd\fR and \fBchdir\fR)
for which fallbacks do in fact occur at the C level.
.PP
Any functions which take path names in Tcl_Obj form take
those names in UTF\-8 form. The filesystem infrastructure API is
those names in UTF\-8 form.  The filesystem infrastructure API is
designed to support efficient, cached conversion of these UTF\-8 paths
to other native representations.
.SS "EXAMPLE FILESYSTEM DEFINITION"
.PP
Here is the filesystem lookup table used by the
.QW vfs
extension which allows filesystem actions to be implemented in Tcl.
.PP
.CS
static Tcl_Filesystem vfsFilesystem = {
    "tclvfs",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_1,
    &VfsPathInFilesystem,
    &VfsDupInternalRep,
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

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

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


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
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


1439
1440

1441
1442
1443

1444
1445
1446
1447
1448

1449
1450
1451
1452

1453
1454
1455
1456
1457
1458


1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470


1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486

1487
1488
1489
1490
1491
1492
1493

1494
1495
1496
1497
1498
1499

1500
1501
1502
1503


1504
1505
1506

1507
1508
1509
1510
1511
1512
1513


1514
1515
1516
1517
1518

1519
1520
1521
1522
1523
1524

1525
1526
1527
1528
1529
1530

1531
1532

1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543

1544
1545
1546
1547
1548
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
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
1631
1632

1633
1634

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
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
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
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
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

1439
1440
1441
1442
1443
1444

1445
1446
1447
1448
1449
1450

1451
1452

1453
1454
1455
1456

1457
1458
1459
1460
1461
1462
1463

1464
1465
1466
1467
1468


1469
1470
1471
1472
1473
1474
1475

1476
1477

1478
1479
1480
1481
1482
1483

1484
1485
1486
1487
1488
1489
1490



1491
1492
1493
1494
1495
1496

1497
1498
1499


1500
1501
1502
1503
1504
1505
1506

1507
1508
1509
1510
1511

1512
1513
1514

1515
1516



1517
1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528


1529
1530
1531
1532
1533

1534
1535

1536
1537

1538
1539
1540

1541
1542
1543
1544

1545
1546
1547
1548
1549
1550
1551
1552

1553
1554

1555







-
-
+
+

-
-
+
+


-
-
-
+
+
+




-
+

-
+




-
+




-
-
+
+


-
-
+
+



-
-
+
+



-
-
-
+
+
+



-
-
+
+



-
+

-
+




-
+




-
+

-
+



-
+

-
+




-
-
-
-
+
+
+
+



-
-
+
+





-
+








-
-
+
+

-
+



-
+


-
+

-
+



-
+





-
+



-
+









-
-
+
+


-
+




-
+

-
+



-
+





-
+

-
+








-
+


-
+

-
+


-
+






-
+



-
+




-
+


-
+


-
+








-
-
+
+


-
+






-
-
+
+

-
+




-
+





-
-
+
+








-
-
+
+

-
+

-
-
+
+




-
+

-
-
-
+
+
+






-
+

-


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





-
-
+
+

-
+



-
+



-
+




-
+











-
+



-
+






-
+

-
-
-
+
+
+


-
-
+
+









-
+



-
+

-
-
+
+

-
+


-
-
+
+







-
-
-
+
+
+




-
+

-
+



-
+

-
+


-
+







-
+






-
+


-
-
+
+




-
+



-
+










-
+



-
+




-
+




-
+



-
+






-
-
+
+

-
+


-
+




-
+



-
+




-
-
+
+










-
-
+
+




-
+










-
+






-
+





-
+


-
-
+
+


-
+





-
-
+
+




-
+





-
+





-
+

-
+



-
+






-
+




-
-
+
+





-
+

-
+





-
+






-
-
-
+
+
+



-
+


-
-
+
+





-
+




-
+


-
+

-
-
-
+
+
+


-
+






-
-
+
+



-
+

-
+

-
+


-
+



-
+







-
+

-
+
changes in a future Tcl release.
.SS VERSION
.PP
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 value belongs to this
filesystem or not. Tcl will only call the rest of the filesystem
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,
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 value, 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
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
Tcl's internal list of known filesystems.
.PP
.CS
typedef int \fBTcl_FSPathInFilesystemProc\fR(
typedef int Tcl_FSPathInFilesystemProc(
        Tcl_Obj *\fIpathPtr\fR,
        void **\fIclientDataPtr\fR);
        ClientData *\fIclientDataPtr\fR);
.CE
.SS DUPINTERNALREPPROC
.PP
This function makes a copy of a path's internal representation, and is
called when Tcl needs to duplicate a path value. If NULL, Tcl will
called when Tcl needs to duplicate a path object.  If NULL, Tcl will
simply not copy the internal representation, which may then need to be
regenerated later.
.PP
.CS
typedef void *\fBTcl_FSDupInternalRepProc\fR(
        void *\fIclientData\fR);
typedef ClientData Tcl_FSDupInternalRepProc(
        ClientData \fIclientData\fR);
.CE
.SS FREEINTERNALREPPROC
Free the internal representation. This must be implemented if internal
representations need freeing (i.e.\ if some memory is allocated when an
Free the internal representation.  This must be implemented if internal
representations need freeing (i.e. if some memory is allocated when an
internal representation is generated), but may otherwise be NULL.
.PP
.CS
typedef void \fBTcl_FSFreeInternalRepProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_FSFreeInternalRepProc(
        ClientData \fIclientData\fR);
.CE
.SS INTERNALTONORMALIZEDPROC
.PP
Function to convert internal representation to a normalized path. Only
required if the filesystem creates pure path values with no string/path
representation. The return value is a Tcl value whose string
Function to convert internal representation to a normalized path.  Only
required if the filesystem creates pure path objects with no string/path
representation.  The return value is a Tcl object whose string
representation is the normalized path.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSInternalToNormalizedProc\fR(
        void *\fIclientData\fR);
typedef Tcl_Obj* Tcl_FSInternalToNormalizedProc(
        ClientData \fIclientData\fR);
.CE
.SS CREATEINTERNALREPPROC
.PP
Function to take a path value, and calculate an internal
Function to take a path object, and calculate an internal
representation for it, and store that native representation in the
value. May be NULL if paths have no internal representation, or if
object.  May be NULL if paths have no internal representation, or if
the \fITcl_FSPathInFilesystemProc\fR for this filesystem always
immediately creates an internal representation for paths it accepts.
.PP
.CS
typedef void *\fBTcl_FSCreateInternalRepProc\fR(
typedef ClientData Tcl_FSCreateInternalRepProc(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.SS NORMALIZEPATHPROC
.PP
Function to normalize a path. Should be implemented for all
Function to normalize a path.  Should be implemented for all
filesystems which can have multiple string representations for the same
path value. In Tcl, every
path object.  In Tcl, every
.QW path
must have a single unique
.QW normalized
string representation. Depending on the filesystem,
string representation.  Depending on the filesystem,
there may be more than one unnormalized string representation which
refers to that path (e.g.\ a relative path, a path with different
refers to that path (e.g. a relative path, a path with different
character case if the filesystem is case insensitive, a path contain a
reference to a home directory such as
.QW ~ ,
a path containing symbolic
links, etc). If the very last component in the path is a symbolic
link, it should not be converted into the value it points to (but
its case or other aspects should be made unique). All other path
components should be converted from symbolic links. This one
links, etc).  If the very last component in the path is a symbolic
link, it should not be converted into the object it points to (but
its case or other aspects should be made unique).  All other path
components should be converted from symbolic links.  This one
exception is required to agree with Tcl's semantics with \fBfile
delete\fR, \fBfile rename\fR, \fBfile copy\fR operating on symbolic links.
This function may be called with \fInextCheckpoint\fR either
at the beginning of the path (i.e.\ zero), at the end of the path, or
at any intermediate file separator in the path. It will never
at the beginning of the path (i.e. zero), at the end of the path, or
at any intermediate file separator in the path.  It will never
point to any other arbitrary position in the path. In the last of
the three valid cases, the implementation can assume that the path
up to and including the file separator is known and normalized.
.PP
.CS
typedef int \fBTcl_FSNormalizePathProc\fR(
typedef int Tcl_FSNormalizePathProc(
        Tcl_Interp *\fIinterp\fR,
        Tcl_Obj *\fIpathPtr\fR,
        int \fInextCheckpoint\fR);
.CE
.SH "FILESYSTEM OPERATIONS"
.PP
The fields in this section of the structure contain addresses of
functions which are called to carry out the basic filesystem
operations. A filesystem which expects to be used with the complete
standard Tcl command set must implement all of these. If some of
operations.  A filesystem which expects to be used with the complete
standard Tcl command set must implement all of these.  If some of
them are not implemented, then certain Tcl commands may fail when
operating on paths within that filesystem. However, in some instances
operating on paths within that filesystem.  However, in some instances
this may be desirable (for example, a read-only filesystem should not
implement the last four functions, and a filesystem which does not
support symbolic links need not implement the \fBreadlink\fR function,
etc. The Tcl core expects filesystems to behave in this way).
etc.  The Tcl core expects filesystems to behave in this way).
.SS FILESYSTEMPATHTYPEPROC
.PP
Function to determine the type of a path in this filesystem. May be
Function to determine the type of a path in this filesystem.  May be
NULL, in which case no type information will be available to users of
the filesystem. The
the filesystem.  The
.QW type
is used only for informational purposes,
and should be returned as the string representation of the Tcl_Obj
which is returned. A typical return value might be
which is returned.  A typical return value might be
.QW networked ,
.QW zip
or
.QW ftp .
The Tcl_Obj result is owned by the filesystem and so Tcl will
increment the reference count of that value if it wishes to retain a reference
increment the refCount of that object if it wishes to retain a reference
to it.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSFilesystemPathTypeProc\fR(
typedef Tcl_Obj* Tcl_FSFilesystemPathTypeProc(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.SS FILESYSTEMSEPARATORPROC
.PP
Function to return the separator character(s) for this filesystem.
This need only be implemented if the filesystem wishes to use a
different separator than the standard string
.QW / .
Amongst other
uses, it is returned by the \fBfile separator\fR command. The
return value should be a value with reference count of zero.
uses, it is returned by the \fBfile separator\fR command.  The
return value should be an object with refCount of zero.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSFilesystemSeparatorProc\fR(
typedef Tcl_Obj* Tcl_FSFilesystemSeparatorProc(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.SS STATPROC
.PP
Function to process a \fBTcl_FSStat\fR call. Must be implemented for any
Function to process a \fBTcl_FSStat\fR call.  Must be implemented for any
reasonable filesystem, since many Tcl level commands depend crucially
upon it (e.g.\ \fBfile atime\fR, \fBfile isdirectory\fR, \fBfile size\fR,
upon it (e.g. \fBfile atime\fR, \fBfile isdirectory\fR, \fBfile size\fR,
\fBglob\fR).
.PP
.CS
typedef int \fBTcl_FSStatProc\fR(
typedef int Tcl_FSStatProc(
        Tcl_Obj *\fIpathPtr\fR,
        Tcl_StatBuf *\fIstatPtr\fR);
.CE
.PP
The \fBTcl_FSStatProc\fR fills the stat structure \fIstatPtr\fR with
information about the specified file. You do not need any access
information about the specified file.  You do not need any access
rights to the file to get this information but you need search rights
to all directories named in the path leading to the file. The stat
to all directories named in the path leading to the file.  The stat
structure includes info regarding device, inode (always 0 on Windows),
privilege mode, nlink (always 1 on Windows), user id (always 0 on
Windows), group id (always 0 on Windows), rdev (same as device on
Windows), size, last access time, last modification time, and
last metadata change time.
.PP
If the file represented by \fIpathPtr\fR exists, the
\fBTcl_FSStatProc\fR returns 0 and the stat structure is filled with
data. Otherwise, -1 is returned, and no stat info is given.
data.  Otherwise, -1 is returned, and no stat info is given.
.SS ACCESSPROC
.PP
Function to process a \fBTcl_FSAccess\fR call. Must be implemented for
Function to process a \fBTcl_FSAccess\fR call.  Must be implemented for
any reasonable filesystem, since many Tcl level commands depend crucially
upon it (e.g.\ \fBfile exists\fR, \fBfile readable\fR).
upon it (e.g. \fBfile exists\fR, \fBfile readable\fR).
.PP
.CS
typedef int \fBTcl_FSAccessProc\fR(
typedef int Tcl_FSAccessProc(
        Tcl_Obj *\fIpathPtr\fR,
        int \fImode\fR);
.CE
.PP
The \fBTcl_FSAccessProc\fR checks whether the process would be allowed
to read, write or test for existence of the file (or other filesystem
object) whose name is in \fIpathPtr\fR. If the pathname refers to a
object) whose name is in \fIpathPtr\fR.  If the pathname refers to a
symbolic link, then the
permissions of the file referred by this symbolic link should be tested.
.PP
On success (all requested permissions granted), zero is returned. On
On success (all requested permissions granted), zero is returned.  On
error (at least one bit in mode asked for a permission that is denied,
or some other  error occurred), -1 is returned.
.SS OPENFILECHANNELPROC
.PP
Function to process a \fBTcl_FSOpenFileChannel\fR call. Must be
Function to process a \fBTcl_FSOpenFileChannel\fR call.  Must be
implemented for any reasonable filesystem, since any operations
which require open or accessing a file's contents will use it
(e.g.\ \fBopen\fR, \fBencoding\fR, and many Tk commands).
(e.g. \fBopen\fR, \fBencoding\fR, and many Tk commands).
.PP
.CS
typedef Tcl_Channel \fBTcl_FSOpenFileChannelProc\fR(
typedef Tcl_Channel Tcl_FSOpenFileChannelProc(
        Tcl_Interp *\fIinterp\fR,
        Tcl_Obj *\fIpathPtr\fR,
        int \fImode\fR,
        int \fIpermissions\fR);
.CE
.PP
The \fBTcl_FSOpenFileChannelProc\fR opens a file specified by
\fIpathPtr\fR and returns a channel handle that can be used to perform
input and output on the file. This API is modeled after the \fBfopen\fR
procedure of the Unix standard I/O library. The syntax and meaning of
input and output on the file.  This API is modeled after the \fBfopen\fR
procedure of the Unix standard I/O library.  The syntax and meaning of
all arguments is similar to those given in the Tcl \fBopen\fR command
when opening a file, where the \fImode\fR argument is a combination of
the POSIX flags O_RDONLY, O_WRONLY, etc. If an error occurs while
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 be registered in the supplied interpreter
by a \fBTcl_FSOpenFileChannelProc\fR; that task is up to the caller of
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
the standard channels, \fBstdin, stdout\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
Function to process a \fBTcl_FSMatchInDirectory\fR call.  If not
implemented, then glob and recursive copy functionality will be lacking
in the filesystem (and this may impact commands like \fBencoding names\fR
which use glob functionality internally).
.PP
.CS
typedef int \fBTcl_FSMatchInDirectoryProc\fR(
        Tcl_Interp *\fIinterp\fR,
typedef int Tcl_FSMatchInDirectoryProc(
        Tcl_Interp* \fIinterp\fR,
        Tcl_Obj *\fIresultPtr\fR,
        Tcl_Obj *\fIpathPtr\fR,
        const char *\fIpattern\fR,
        Tcl_GlobTypeData *\fItypes\fR);
.CE
.PP
The function should return all files or directories (or other filesystem
objects) which match the given pattern and accord with the \fItypes\fR
specification given. There are two ways in which this function may be
called. If \fIpattern\fR is NULL, then \fIpathPtr\fR is a full path
specification given.  There are two ways in which this function may be
called.  If \fIpattern\fR is NULL, then \fIpathPtr\fR is a full path
specification of a single file or directory which should be checked for
existence and correct type. Otherwise, \fIpathPtr\fR is a directory, the
existence and correct type.  Otherwise, \fIpathPtr\fR is a directory, the
contents of which the function should search for files or directories
which have the correct type. In either case, \fIpathPtr\fR can be
assumed to be both non-NULL and non-empty. It is not currently
which have the correct type.  In either case, \fIpathPtr\fR can be
assumed to be both non-NULL and non-empty.  It is not currently
documented whether \fIpathPtr\fR will have a file separator at its end of
not, so code should be flexible to both possibilities.
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the matching process. Error messages are placed in
occurred in the matching process.  Error messages are placed in
\fIinterp\fR, unless \fIinterp\fR in NULL in which case no error
message need be generated; on a \fBTCL_OK\fR result, results should be
added to the \fIresultPtr\fR value given (which can be assumed to be a
valid unshared Tcl list). The matches added
message need be generated; on a \fBTCL_OK\fR result, results should be 
added to the \fIresultPtr\fR object given (which can be assumed to be a 
valid unshared Tcl list).  The matches added
to \fIresultPtr\fR should include any path prefix given in \fIpathPtr\fR
(this usually means they will be absolute path specifications).
Note that if no matches are found, that simply leads to an empty
result; errors are only signaled for actual file or filesystem
problems which may occur during the matching process.
.PP
The \fBTcl_GlobTypeData\fR structure passed in the \fItypes\fR
The \fBTcl_GlobTypeData\fR structure passed in the \fItypes\fR 
parameter contains the following fields:
.PP
.CS
typedef struct Tcl_GlobTypeData {
    /* Corresponds to bcdpfls as in 'find -t' */
    int \fItype\fR;
    /* Corresponds to file permissions */
    int \fIperm\fR;
    /* Acceptable mac type */
    Tcl_Obj *\fImacType\fR;
    /* Acceptable mac creator */
    Tcl_Obj *\fImacCreator\fR;
} \fBTcl_GlobTypeData\fR;
        /* Corresponds to bcdpfls as in 'find -t' */
        int \fItype\fR;
        /* Corresponds to file permissions */
        int \fIperm\fR;
        /* Acceptable mac type */
        Tcl_Obj *\fImacType\fR;
        /* Acceptable mac creator */
        Tcl_Obj *\fImacCreator\fR;
} Tcl_GlobTypeData;
.CE
.PP
There are two specific cases which it is important to handle correctly,
both when \fItypes\fR is non-NULL. The two cases are when \fItypes->types
& TCL_GLOB_TYPE_DIR\fR or \fItypes->types & TCL_GLOB_TYPE_MOUNT\fR are
true (and in particular when the other flags are false). In the first of
these cases, the function must list the contained directories. Tcl uses
true (and in particular when the other flags are false).  In the first of
these cases, the function must list the contained directories.  Tcl uses
this to implement recursive globbing, so it is critical that filesystems
implement directory matching correctly. In the second of these cases,
implement directory matching correctly.  In the second of these cases,
with \fBTCL_GLOB_TYPE_MOUNT\fR, the filesystem must list the mount points
which lie within the given \fIpathPtr\fR (and in this case, \fIpathPtr\fR
need not lie within the same filesystem - different to all other cases in
which this function is called). Support for this is critical if Tcl is
which this function is called).  Support for this is critical if Tcl is
to have seamless transitions between from one filesystem to another.
.SS UTIMEPROC
.PP
Function to process a \fBTcl_FSUtime\fR call. Required to allow setting
Function to process a \fBTcl_FSUtime\fR call.  Required to allow setting
(not reading) of times with \fBfile mtime\fR, \fBfile atime\fR and the
open-r/open-w/fcopy implementation of \fBfile copy\fR.
.PP
.CS
typedef int \fBTcl_FSUtimeProc\fR(
typedef int Tcl_FSUtimeProc(
        Tcl_Obj *\fIpathPtr\fR,
        struct utimbuf *\fItval\fR);
.CE
.PP
The access and modification times of the file specified by \fIpathPtr\fR
should be changed to the values given in the \fItval\fR structure.
.PP
The return value should be 0 on success and -1 on an error, as
with the system \fButime\fR.
.SS LINKPROC
.PP
Function to process a \fBTcl_FSLink\fR call. Should be implemented
Function to process a \fBTcl_FSLink\fR call.  Should be implemented
only if the filesystem supports links, and may otherwise be NULL.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSLinkProc\fR(
typedef Tcl_Obj* Tcl_FSLinkProc(
        Tcl_Obj *\fIlinkNamePtr\fR,
        Tcl_Obj *\fItoPtr\fR,
        int \fIlinkAction\fR);
.CE
.PP
If \fItoPtr\fR is NULL, the function is being asked to read the
contents of a link. The result is a Tcl_Obj specifying the contents of
contents of a link.  The result is a Tcl_Obj specifying the contents of
the link given by \fIlinkNamePtr\fR, or NULL if the link could
not be read. The result is owned by the caller (and should therefore
have its ref count incremented before being returned). Any callers
should call \fBTcl_DecrRefCount\fR on this result when it is no longer needed.
not be read.  The result is owned by the caller (and should therefore
have its ref count incremented before being returned).  Any callers
should call Tcl_DecrRefCount on this result when it is no longer needed.
If \fItoPtr\fR is not NULL, the function should attempt to create a link.
The result in this case should be \fItoPtr\fR if the link was successful
and NULL otherwise. In this case the result is not owned by the caller
(i.e.\ no reference count manipulations on either end are needed). See
and NULL otherwise.  In this case the result is not owned by the caller
(i.e. no ref count manipulation on either end is needed). See
the documentation for \fBTcl_FSLink\fR for the correct interpretation
of the \fIlinkAction\fR flags.
.SS LISTVOLUMESPROC
.PP
Function to list any filesystem volumes added by this filesystem.
Should be implemented only if the filesystem adds volumes at the head
of the filesystem, so that they can be returned by \fBfile volumes\fR.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSListVolumesProc\fR(void);
typedef Tcl_Obj* Tcl_FSListVolumesProc(void);
.CE
.PP
The result should be a list of volumes added by this filesystem, or
NULL (or an empty list) if no volumes are provided. The result value
NULL (or an empty list) if no volumes are provided.  The result object
is considered to be owned by the filesystem (not by Tcl's core), but
should be given a reference count for Tcl. Tcl will use the contents of the
list and then decrement that reference count. This allows filesystems to
should be given a refCount for Tcl.  Tcl will use the contents of the
list and then decrement that refCount.  This allows filesystems to
choose whether they actually want to retain a
.QW "global list"
.QW "master list"
of volumes
or not (if not, they generate the list on the fly and pass it to Tcl
with a reference count of 1 and then forget about the list, if yes, then
they simply increment the reference count of their global list and pass it
with a refCount of 1 and then forget about the list, if yes, then
they simply increment the refCount of their master list and pass it
to Tcl which will copy the contents and then decrement the count back
to where it was).
.PP
Therefore, Tcl considers return values from this proc to be read-only.
.SS FILEATTRSTRINGSPROC
.PP
Function to list all attribute strings which are valid for this
filesystem. If not implemented the filesystem will not support
the \fBfile attributes\fR command. This allows arbitrary additional
information to be attached to files in the filesystem. If it is
filesystem.  If not implemented the filesystem will not support
the \fBfile attributes\fR command.  This allows arbitrary additional
information to be attached to files in the filesystem.  If it is
not implemented, there is no need to implement the \fBget\fR and \fBset\fR
methods.
.PP
.CS
typedef const char *const *\fBTcl_FSFileAttrStringsProc\fR(
typedef const char** Tcl_FSFileAttrStringsProc(
        Tcl_Obj *\fIpathPtr\fR,
        Tcl_Obj **\fIobjPtrRef\fR);
        Tcl_Obj** \fIobjPtrRef\fR);
.CE
.PP
The called function may either return an array of strings, or may
instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR. Tcl
instead return NULL and place a Tcl list into the given \fIobjPtrRef\fR.  Tcl
will take that list and first increment its reference count before using it.
On completion of that use, Tcl will decrement its reference count. Hence if
On completion of that use, Tcl will decrement its reference count.  Hence if
the list should be disposed of by Tcl when done, it should have a
reference count of zero, and if the list should not be disposed of, the
filesystem should ensure it returns a value with a reference count
filesystem should ensure it returns an object with a reference count
of at least one.
.SS FILEATTRSGETPROC
.PP
Function to process a \fBTcl_FSFileAttrsGet\fR call, used by \fBfile
attributes\fR.
.PP
.CS
typedef int \fBTcl_FSFileAttrsGetProc\fR(
typedef int Tcl_FSFileAttrsGetProc(
        Tcl_Interp *\fIinterp\fR,
        int \fIindex\fR,
        Tcl_Obj *\fIpathPtr\fR,
        Tcl_Obj **\fIobjPtrRef\fR);
.CE
.PP
Returns a standard Tcl return code. The attribute value retrieved,
Returns a standard Tcl return code.  The attribute value retrieved,
which corresponds to the \fIindex\fR'th element in the list returned by
the \fBTcl_FSFileAttrStringsProc\fR, is a Tcl_Obj placed in \fIobjPtrRef\fR (if
\fBTCL_OK\fR was returned) and is likely to have a reference count of zero. Either
way we must either store it somewhere (e.g.\ the Tcl result), or
\fBTCL_OK\fR was returned) and is likely to have a reference count of zero.  Either
way we must either store it somewhere (e.g. the Tcl result), or
Incr/Decr its reference count to ensure it is properly freed.
.SS FILEATTRSSETPROC
.PP
Function to process a \fBTcl_FSFileAttrsSet\fR call, used by \fBfile
attributes\fR. If the filesystem is read-only, there is no need
attributes\fR.  If the filesystem is read-only, there is no need
to implement this.
.PP
.CS
typedef int \fBTcl_FSFileAttrsSetProc\fR(
typedef int Tcl_FSFileAttrsSetProc(
        Tcl_Interp *\fIinterp\fR,
        int \fIindex\fR,
        Tcl_Obj *\fIpathPtr\fR,
        Tcl_Obj *\fIobjPtr\fR);
.CE
.PP
The attribute value of the \fIindex\fR'th element in the list returned by
the Tcl_FSFileAttrStringsProc should be set to the \fIobjPtr\fR given.
.SS CREATEDIRECTORYPROC
.PP
Function to process a \fBTcl_FSCreateDirectory\fR call. Should be
Function to process a \fBTcl_FSCreateDirectory\fR call.  Should be
implemented unless the FS is read-only.
.PP
.CS
typedef int \fBTcl_FSCreateDirectoryProc\fR(
typedef int Tcl_FSCreateDirectoryProc(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the process. If successful, a new directory should have
occurred in the process.  If successful, a new directory should have
been added to the filesystem in the location specified by
\fIpathPtr\fR.
.SS REMOVEDIRECTORYPROC
.PP
Function to process a \fBTcl_FSRemoveDirectory\fR call. Should be
Function to process a \fBTcl_FSRemoveDirectory\fR call.  Should be
implemented unless the FS is read-only.
.PP
.CS
typedef int \fBTcl_FSRemoveDirectoryProc\fR(
typedef int Tcl_FSRemoveDirectoryProc(
        Tcl_Obj *\fIpathPtr\fR,
        int \fIrecursive\fR,
        Tcl_Obj **\fIerrorPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the process. If successful, the directory specified by
\fIpathPtr\fR should have been removed from the filesystem. If the
occurred in the process.  If successful, the directory specified by
\fIpathPtr\fR should have been removed from the filesystem.  If the
\fIrecursive\fR flag is given, then a non-empty directory should be
deleted without error. If this flag is not given, then and the
deleted without error.  If this flag is not given, then and the
directory is non-empty a POSIX
.QW EEXIST
error should be signaled. If an
error should be signaled.  If an
error does occur, the name of the file or directory which caused the
error should be placed in \fIerrorPtr\fR.
.SS DELETEFILEPROC
.PP
Function to process a \fBTcl_FSDeleteFile\fR call. Should be implemented
Function to process a \fBTcl_FSDeleteFile\fR call.  Should be implemented
unless the FS is read-only.
.PP
.CS
typedef int \fBTcl_FSDeleteFileProc\fR(
typedef int Tcl_FSDeleteFileProc(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the process. If successful, the file specified by
\fIpathPtr\fR should have been removed from the filesystem. Note that,
occurred in the process.  If successful, the file specified by
\fIpathPtr\fR should have been removed from the filesystem.  Note that,
if the filesystem supports symbolic links, Tcl will always call this
function and not Tcl_FSRemoveDirectoryProc when needed to delete them
(even if they are symbolic links to directories).
.SH "FILESYSTEM EFFICIENCY"
.PP
These functions need not be implemented for a particular filesystem
because the core has a fallback implementation available. See each
individual description for the consequences of leaving the field NULL.
.SS LSTATPROC
.PP
Function to process a \fBTcl_FSLstat\fR call. If not implemented, Tcl
will attempt to use the \fIstatProc\fR defined above instead. Therefore
Function to process a \fBTcl_FSLstat\fR call.  If not implemented, Tcl
will attempt to use the \fIstatProc\fR defined above instead.  Therefore
it need only be implemented if a filesystem can differentiate between
\fBstat\fR and \fBlstat\fR calls.
.PP
.CS
typedef int \fBTcl_FSLstatProc\fR(
typedef int Tcl_FSLstatProc(
        Tcl_Obj *\fIpathPtr\fR,
        Tcl_StatBuf *\fIstatPtr\fR);
.CE
.PP
The behavior of this function is very similar to that of the
\fBTcl_FSStatProc\fR defined above, except that if it is applied
to a symbolic link, it returns information about the link, not
about the target file.
.SS COPYFILEPROC
.PP
Function to process a \fBTcl_FSCopyFile\fR call. If not implemented Tcl
Function to process a \fBTcl_FSCopyFile\fR call.  If not implemented Tcl
will fall back on \fBopen\fR-r, \fBopen\fR-w and \fBfcopy\fR as a
copying mechanism.
Therefore it need only be implemented if the filesystem can perform
that action more efficiently.
.PP
.CS
typedef int \fBTcl_FSCopyFileProc\fR(
typedef int Tcl_FSCopyFileProc(
        Tcl_Obj *\fIsrcPathPtr\fR,
        Tcl_Obj *\fIdestPathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the copying process. Note that, \fIdestPathPtr\fR is the
occurred in the copying process.  Note that, \fIdestPathPtr\fR is the
name of the file which should become the copy of \fIsrcPathPtr\fR. It
is never the name of a directory into which \fIsrcPathPtr\fR could be
copied (i.e.\ the function is much simpler than the Tcl level \fBfile
copy\fR subcommand). Note that,
copied (i.e. the function is much simpler than the Tcl level \fBfile
copy\fR subcommand).  Note that,
if the filesystem supports symbolic links, Tcl will always call this
function and not \fIcopyDirectoryProc\fR when needed to copy them
(even if they are symbolic links to directories). Finally, if the
(even if they are symbolic links to directories).  Finally, if the
filesystem determines it cannot support the \fBfile copy\fR action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS RENAMEFILEPROC
.PP
Function to process a \fBTcl_FSRenameFile\fR call. If not implemented,
Tcl will fall back on a copy and delete mechanism. Therefore it need
Function to process a \fBTcl_FSRenameFile\fR call.  If not implemented,
Tcl will fall back on a copy and delete mechanism.  Therefore it need
only be implemented if the filesystem can perform that action more
efficiently.
.PP
.CS
typedef int \fBTcl_FSRenameFileProc\fR(
typedef int Tcl_FSRenameFileProc(
        Tcl_Obj *\fIsrcPathPtr\fR,
        Tcl_Obj *\fIdestPathPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the renaming process. If the
occurred in the renaming process.  If the
filesystem determines it cannot support the \fBfile rename\fR action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS COPYDIRECTORYPROC
.PP
Function to process a \fBTcl_FSCopyDirectory\fR call. If not
Function to process a \fBTcl_FSCopyDirectory\fR call.  If not
implemented, Tcl will fall back on a recursive \fBfile mkdir\fR, \fBfile copy\fR
mechanism. Therefore it need only be implemented if the filesystem can
mechanism.  Therefore it need only be implemented if the filesystem can
perform that action more efficiently.
.PP
.CS
typedef int \fBTcl_FSCopyDirectoryProc\fR(
typedef int Tcl_FSCopyDirectoryProc(
        Tcl_Obj *\fIsrcPathPtr\fR,
        Tcl_Obj *\fIdestPathPtr\fR,
        Tcl_Obj **\fIerrorPtr\fR);
.CE
.PP
The return value is a standard Tcl result indicating whether an error
occurred in the copying process. If an error does occur, the name of
occurred in the copying process.  If an error does occur, the name of
the file or directory which caused the error should be placed in
\fIerrorPtr\fR. Note that, \fIdestPathPtr\fR is the name of the
directory-name which should become the mirror-image of
\fIsrcPathPtr\fR. It is not the name of a directory into which
\fIsrcPathPtr\fR should be copied (i.e.\ the function is much simpler
than the Tcl level \fBfile copy\fR subcommand). Finally, if the
\fIsrcPathPtr\fR should be copied (i.e. the function is much simpler
than the Tcl level \fBfile copy\fR subcommand).  Finally, if the
filesystem determines it cannot support the directory copy action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS LOADFILEPROC
.PP
Function to process a \fBTcl_FSLoadFile\fR call. If not implemented, Tcl
Function to process a \fBTcl_FSLoadFile\fR call.  If not implemented, Tcl
will fall back on a copy to native-temp followed by a \fBTcl_FSLoadFile\fR on
that temporary copy. Therefore it need only be implemented if the
that temporary copy.  Therefore it need only be implemented if the
filesystem can load code directly, or it can be implemented simply to
return \fBTCL_ERROR\fR to disable load functionality in this filesystem
entirely.
.PP
.CS
typedef int \fBTcl_FSLoadFileProc\fR(
typedef int Tcl_FSLoadFileProc(
        Tcl_Interp *\fIinterp\fR,
        Tcl_Obj *\fIpathPtr\fR,
        Tcl_LoadHandle *\fIhandlePtr\fR,
        Tcl_FSUnloadFileProc *\fIunloadProcPtr\fR);
.CE
.PP
Returns a standard Tcl completion code. If an error occurs, an error
message is left in the \fIinterp\fR's result. The function dynamically loads a
binary code file into memory. On a successful load, the \fIhandlePtr\fR
Returns a standard Tcl completion code.  If an error occurs, an error
message is left in the \fIinterp\fR's result.  The function dynamically loads a
binary code file into memory.  On a successful load, the \fIhandlePtr\fR
should be filled with a token for the dynamically loaded file, and the
\fIunloadProcPtr\fR should be filled in with the address of a procedure.
The unload procedure will be called with the given \fBTcl_LoadHandle\fR as its
only parameter when Tcl needs to unload the file. For example, for the
only parameter when Tcl needs to unload the file.  For example, for the
native filesystem, the \fBTcl_LoadHandle\fR returned is currently a token
which can be used in the private \fBTclpFindSymbol\fR to access functions
in the new code. Each filesystem is free to define the
\fBTcl_LoadHandle\fR as it requires. Finally, if the
in the new code.  Each filesystem is free to define the
\fBTcl_LoadHandle\fR as it requires.  Finally, if the
filesystem determines it cannot support the file load action,
calling \fBTcl_SetErrno(EXDEV)\fR and returning a non-\fBTCL_OK\fR
result will tell Tcl to use its standard fallback mechanisms.
.SS UNLOADFILEPROC
.PP
Function to unload a previously successfully loaded file. If load was
Function to unload a previously successfully loaded file.  If load was
implemented, then this should also be implemented, if there is any
cleanup action required.
.PP
.CS
typedef void \fBTcl_FSUnloadFileProc\fR(
typedef void Tcl_FSUnloadFileProc(
        Tcl_LoadHandle \fIloadHandle\fR);
.CE
.SS GETCWDPROC
.SS GETCWDPROC     
.PP
Function to process a \fBTcl_FSGetCwd\fR call. Most filesystems need not
implement this. It will usually only be called once, if \fBgetcwd\fR is
called before \fBchdir\fR. May be NULL.
Function to process a \fBTcl_FSGetCwd\fR call.  Most filesystems need not
implement this.  It will usually only be called once, if \fBgetcwd\fR is
called before \fBchdir\fR.  May be NULL.
.PP
.CS
typedef Tcl_Obj *\fBTcl_FSGetCwdProc\fR(
typedef Tcl_Obj* Tcl_FSGetCwdProc(
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
If the filesystem supports a native notion of a current working
directory (which might perhaps change independent of Tcl), this
function should return that cwd as the result, or NULL if the current
directory could not be determined (e.g.\ the user does not have
appropriate permissions on the cwd directory). If NULL is returned, an
directory could not be determined (e.g. the user does not have
appropriate permissions on the cwd directory).  If NULL is returned, an
error message is left in the \fIinterp\fR's result.
.SS CHDIRPROC
.PP
Function to process a \fBTcl_FSChdir\fR call. If filesystems do not
Function to process a \fBTcl_FSChdir\fR call.  If filesystems do not
implement this, it will be emulated by a series of directory access
checks. Otherwise, virtual filesystems which do implement it need only
checks.  Otherwise, virtual filesystems which do implement it need only
respond with a positive return result if the \fIpathPtr\fR is a valid,
accessible directory in their filesystem. They need not remember the
accessible directory in their filesystem.  They need not remember the
result, since that will be automatically remembered for use by
\fBTcl_FSGetCwd\fR.
Real filesystems should carry out the correct action (i.e.\ call the
Real filesystems should carry out the correct action (i.e. call the
correct system \fBchdir\fR API).
.PP
.CS
typedef int \fBTcl_FSChdirProc\fR(
typedef int Tcl_FSChdirProc(
        Tcl_Obj *\fIpathPtr\fR);
.CE
.PP
The \fBTcl_FSChdirProc\fR changes the applications current working
directory to the value specified in \fIpathPtr\fR. The function returns
-1 on error or 0 on success.
.SH "SEE ALSO"
cd(n), file(n), filename(n), load(n), open(n), pwd(n), source(n), unload(n)
cd(n), file(n), load(n), open(n), pwd(n), unload(n)
.SH KEYWORDS
stat, access, filesystem, vfs, virtual filesystem
stat, access, filesystem, vfs, virtual

Changes to doc/FindExec.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_FindExecutable, Tcl_GetNameOfExecutable \- identify or return the name of the binary file containing the application
.SH SYNOPSIS
.nf
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

62
63
64
41
42
43
44
45
46
47







48
49
50
51
52
53

54

55
56







-
-
-
-
-
-
-






-
+
-


working directory before the invocation.
\fBTcl_FindExecutable\fR uses \fIargv0\fR
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
equivalent to the \fBinfo nameofexecutable\fR command.  NULL
is returned if the internal full path name has not been
computed or unknown.
.PP

\fBTcl_FindExecutable\fR can not be used in stub-enabled extensions.
.SH KEYWORDS
binary, executable file

Changes to doc/GetCwd.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetCwd, Tcl_Chdir \- manipulate the current working directory
.SH SYNOPSIS
.nf

Changes to doc/GetHostName.3.

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
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



-
+
















-
+






'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
'\" 
.TH Tcl_GetHostName 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetHostName \- get the name of the local host
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
const char *
\fBTcl_GetHostName\fR()
.BE

.SH DESCRIPTION
.PP
\fBTcl_GetHostName\fR is a utility procedure used by some of the
Tcl commands.  It returns a pointer to a string containing the name
Tcl commands.  It returns a pointer to a string containing the name 
for the current machine, or an empty string if the name cannot be
determined.  The string is statically allocated, and the caller must
not modify of free it.
.PP
.SH KEYWORDS
hostname

Changes to doc/GetIndex.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 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.
'\"
'\" 
.TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetIndexFromObj, Tcl_GetIndexFromObjStruct \- lookup string in table of keywords
.SH SYNOPSIS
.nf
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

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







-
+
-
-
+

-
+


-
-
+






-
-
+










-
+
-




+



-
-
+
+
















-
-
+







-
-
-
+













+

-
+
+

-
+
                          msg, flags, indexPtr\fR)
.SH ARGUMENTS
.AS "const char" *structTablePtr in/out
.AP Tcl_Interp *interp in
Interpreter to use for error reporting; if NULL, then no message is
provided on errors.
.AP Tcl_Obj *objPtr in/out
The string value of this value is used to search through \fItablePtr\fR.
The string value of this object is used to search through \fItablePtr\fR.
If the \fBTCL_INDEX_TEMP_TABLE\fR flag is not specified,
the internal representation is modified to hold the index of the matching
The internal representation is modified to hold the index of the matching
table entry.
.AP "const char *const" *tablePtr in
.AP "const char" **tablePtr in
An array of null-terminated strings.  The end of the array is marked
by a NULL string pointer.
Note that, unless the \fBTCL_INDEX_TEMP_TABLE\fR flag is specified,
references to the \fItablePtr\fR may be retained in the
Note that references to the \fItablePtr\fR may be retained in the
internal representation of \fIobjPtr\fR, so this should represent the
address of a statically-allocated array.
.AP "const void" *structTablePtr in
An array of arbitrary type, typically some \fBstruct\fR type.
The first member of the structure must be a null-terminated string.
The size of the structure is given by \fIoffset\fR.
Note that, unless the \fBTCL_INDEX_TEMP_TABLE\fR flag is specified,
references to the \fIstructTablePtr\fR may be retained in the
Note that references to the \fIstructTablePtr\fR may be retained in the
internal representation of \fIobjPtr\fR, so this should represent the
address of a statically-allocated array of structures.
.AP int offset in
The offset to add to structTablePtr to get to the next entry.
The end of the array is marked by a NULL string pointer.
.AP "const char" *msg in
Null-terminated string describing what is being looked up, such as
\fBoption\fR.  This string is included in error messages.
.AP int flags in
OR-ed combination of bits providing additional information for
operation.  The only bits that are currently defined are \fBTCL_EXACT\fR
operation.  The only bit that is currently defined is \fBTCL_EXACT\fR.
and \fBTCL_INDEX_TEMP_TABLE\fR.
.AP int *indexPtr out
The index of the string in \fItablePtr\fR that matches the value of
\fIobjPtr\fR is returned here.
.BE

.SH DESCRIPTION
.PP
These procedures provide an efficient way for looking up keywords,
switch names, option names, and similar things where the literal value of
a Tcl value must be chosen from a predefined set.
switch names, option names, and similar things where the value of
an object must be one of a predefined set of values.
\fBTcl_GetIndexFromObj\fR compares \fIobjPtr\fR against each of
the strings in \fItablePtr\fR to find a match.  A match occurs if
\fIobjPtr\fR's string value is identical to one of the strings in
\fItablePtr\fR, or if it is a non-empty unique abbreviation
for exactly one of the strings in \fItablePtr\fR and the
\fBTCL_EXACT\fR flag was not specified; in either case
the index of the matching entry is stored at \fI*indexPtr\fR
and \fBTCL_OK\fR is returned.
.PP
If there is no matching entry,
\fBTCL_ERROR\fR is returned and an error message is left in \fIinterp\fR's
result if \fIinterp\fR is not NULL.  \fIMsg\fR is included in the
error message to indicate what was being looked up.  For example,
if \fImsg\fR is \fBoption\fR the error message will have a form like
.QW "\fBbad option \N'34'firt\N'34': must be first, second, or third\fR" .
.PP
If the \fBTCL_INDEX_TEMP_TABLE\fR was not specified, when
\fBTcl_GetIndexFromObj\fR completes successfully it modifies the
If \fBTcl_GetIndexFromObj\fR completes successfully it modifies the
internal representation of \fIobjPtr\fR to hold the address of
the table and the index of the matching entry.  If \fBTcl_GetIndexFromObj\fR
is invoked again with the same \fIobjPtr\fR and \fItablePtr\fR
arguments (e.g. during a reinvocation of a Tcl command), it returns
the matching index immediately without having to redo the lookup
operation.  Note: \fBTcl_GetIndexFromObj\fR assumes that the entries
in \fItablePtr\fR are static: they must not change between
invocations.  This caching mechanism can be disallowed by specifying
the \fBTCL_INDEX_TEMP_TABLE\fR flag.
If the value of \fIobjPtr\fR is the empty string,
invocations.  If the value of \fIobjPtr\fR is the empty string,
\fBTcl_GetIndexFromObj\fR will treat it as a non-matching value
and return \fBTCL_ERROR\fR.
.PP
\fBTcl_GetIndexFromObjStruct\fR works just like
\fBTcl_GetIndexFromObj\fR, except that instead of treating
\fItablePtr\fR as an array of string pointers, it treats it as a
pointer to the first string in a series of strings that have
\fIoffset\fR bytes between them (i.e. that there is a pointer to the
first array of characters at \fItablePtr\fR, a pointer to the second
array of characters at \fItablePtr\fR+\fIoffset\fR bytes, etc.)
This is particularly useful when processing things like
\fBTk_ConfigurationSpec\fR, whose string keys are in the same place in
each of several array elements.

.SH "SEE ALSO"
prefix(n), Tcl_WrongNumArgs(3)
Tcl_WrongNumArgs

.SH KEYWORDS
index, option, value, table lookup
index, object, table lookup

Changes to doc/GetInt.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_GetInt 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetInt, Tcl_GetDouble, Tcl_GetBoolean \- convert from string to integer, double, or boolean
.SH SYNOPSIS
.nf
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
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







-
-
+
+

-
+

-
-
+
+
-
-
-
-
-
-

-
+




-
-
-
-
+
+




-
-
+
+
-
-
-
-
-
-
-












third argument.  If all goes well, each of the procedures returns
\fBTCL_OK\fR.  If \fIsrc\fR does not have the proper syntax for the
desired type then \fBTCL_ERROR\fR is returned, an error message is left
in the interpreter's result, and nothing is stored at *\fIintPtr\fR
or *\fIdoublePtr\fR or *\fIboolPtr\fR.
.PP
\fBTcl_GetInt\fR expects \fIsrc\fR to consist of a collection
of integer digits, optionally signed and optionally preceded and
followed by white space.  If the first two characters of \fIsrc\fR
of integer digits, optionally signed and optionally preceded by
white space.  If the first two characters of \fIsrc\fR
after the optional white space and sign are
.QW \fB0x\fR
.QW 0x
then \fIsrc\fR is expected to be in hexadecimal form;  otherwise,
if the first such characters are
.QW \fB0d\fR
if the first such character is
.QW 0
then \fIsrc\fR is expected to be in decimal form; otherwise,
if the first such characters are
.QW \fB0o\fR
then \fIsrc\fR is expected to be in octal form;  otherwise,
if the first such characters are
.QW \fB0b\fR
then \fIsrc\fR
is expected to be in binary form;  otherwise, \fIsrc\fR is
is expected to be in octal form;  otherwise, \fIsrc\fR is
expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is:  white space;  a sign; a sequence of digits;  a
decimal point
.QW \fB.\fR ;
a sequence of digits;  the letter
.QW \fBe\fR ;
decimal point;  a sequence of digits;  the letter
.QW e ;
a signed decimal exponent;  and more white space.
Any of the fields may be omitted, except that
the digits either before or after the decimal point must be present
and if the
.QW \fBe\fR
is present then it must be followed by the exponent number. If there
.QW e
is present then it must be followed by the exponent number.
are no fields apart from the sign and initial sequence of digits
(i.e., no decimal point or exponent indicator), that
initial sequence of digits should take one of the forms that
\fBTcl_GetInt\fR supports, described above. The use of
.QW \fB,\fR
as a decimal point is not supported nor should any other sort of
inter-digit separator be present.
.PP
\fBTcl_GetBoolean\fR expects \fIsrc\fR to specify a boolean
value.  If \fIsrc\fR is any of \fB0\fR, \fBfalse\fR,
\fBno\fR, or \fBoff\fR, then \fBTcl_GetBoolean\fR stores a zero
value at \fI*boolPtr\fR.
If \fIsrc\fR is any of \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR,
then 1 is stored at \fI*boolPtr\fR.
Any of these values may be abbreviated, and upper-case spellings
are also acceptable.

.SH KEYWORDS
boolean, conversion, double, floating-point, integer

Changes to doc/GetOpnFl.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1996-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.
'\"
'\" 
.TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetOpenFile \- Return a FILE* for a channel registered in the given interpreter (Unix only)
.SH SYNOPSIS
.nf
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38







-
+







String identifying channel, such as \fBstdin\fR or \fBfile4\fR.
.AP int write in
Non-zero means the file will be used for writing, zero means it will
be used for reading.
.AP int checkUsage in
If non-zero, then an error will be generated if the file was not opened
for the access indicated by \fIwrite\fR.
.AP void **filePtr out
.AP ClientData *filePtr out
Points to word in which to store pointer to FILE structure for
the file given by \fIchanID\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_GetOpenFile\fR takes as argument a file identifier of the form

Changes to doc/GetStdChan.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 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.
'\"
'\" 
.TH Tcl_GetStdChannel 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_GetStdChannel, Tcl_SetStdChannel \- procedures for retrieving and replacing the standard channels
.SH SYNOPSIS
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
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







-
+






-
+



-
+







-



-






-
+












-
+







.SH DESCRIPTION
.PP
Tcl defines three special channels that are used by various I/O related
commands if no other channels are specified.  The standard input channel
has a channel name of \fBstdin\fR and is used by \fBread\fR and \fBgets\fR.
The standard output channel is named \fBstdout\fR and is used by
\fBputs\fR.  The standard error channel is named \fBstderr\fR and is used for
\fBputs\fR.  The standard error channel is named \fBstderr\fR and is used for 
reporting errors.  In addition, the standard channels are inherited by any
child processes created using \fBexec\fR or \fBopen\fR in the absence of any
other redirections.
.PP
The standard channels are actually aliases for other normal channels.  The
current channel associated with a standard channel can be retrieved by calling
\fBTcl_GetStdChannel\fR with one of
\fBTcl_GetStdChannel\fR with one of 
\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, or \fBTCL_STDERR\fR as the \fItype\fR.  The
return value will be a valid channel, or NULL.
.PP
A new channel can be set for the standard channel specified by \fItype\fR
A new channel can be set for the standard channel specified by \fItype\fR 
by calling \fBTcl_SetStdChannel\fR with a new channel or NULL in the
\fIchannel\fR argument.  If the specified channel is closed by a later call to
\fBTcl_Close\fR, then the corresponding standard channel will automatically be
set to NULL.
.PP
If a non-NULL value for \fIchannel\fR is passed to \fBTcl_SetStdChannel\fR,
then that same value should be passed to \fBTcl_RegisterChannel\fR, like so:
.PP
.CS
Tcl_RegisterChannel(NULL, channel);
.CE
.PP
This is a workaround for a misfeature in \fBTcl_SetStdChannel\fR that it
fails to do some reference counting housekeeping.  This misfeature cannot
be corrected without contradicting the assumptions of some existing
code that calls \fBTcl_SetStdChannel\fR.
.PP
If \fBTcl_GetStdChannel\fR is called before \fBTcl_SetStdChannel\fR, Tcl will
construct a new channel to wrap the appropriate platform-specific standard
construct a new channel to wrap the appropriate platform-specific standard 
file handle.  If \fBTcl_SetStdChannel\fR is called before
\fBTcl_GetStdChannel\fR, then the default channel will not be created.
.PP
If one of the standard channels is set to NULL, either by calling
\fBTcl_SetStdChannel\fR with a NULL \fIchannel\fR argument, or by calling
\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.
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

Changes to doc/GetTime.3.

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
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





-
+















-
-
+
+

-
+
+

-
+
+


-
+
+

-
+
+

-
+
+

-
+
+







-


-
-
-
+
+
+
















-

-
+






-
+





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

-
-
-
-
-
+
+
+
+
+
+

-
+


'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetTime, Tcl_SetTimeProc, Tcl_QueryTimeProc \- get date and time
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_GetTime\fR(\fItimePtr\fR)
.sp
\fBTcl_SetTimeProc\fR(\fIgetProc, scaleProc, clientData\fR)
.sp
\fBTcl_QueryTimeProc\fR(\fIgetProcPtr, scaleProcPtr, clientDataPtr\fR)
.SH ARGUMENTS
.AS Tcl_GetTimeProc *getProc in
.AP Tcl_Time *timePtr out
.AS "Tcl_Time *" timePtr out
.AP "Tcl_Time *" timePtr out
Points to memory in which to store the date and time information.
.AP Tcl_GetTimeProc getProc in
.AS "Tcl_GetTimeProc *" getProc in
.AP "Tcl_GetTimeProc *" getProc in
Pointer to handler function replacing \fBTcl_GetTime\fR's access to the OS.
.AP Tcl_ScaleTimeProc scaleProc in
.AS "Tcl_ScaleTimeProc *" scaleProc in
.AP "Tcl_ScaleTimeProc *" scaleProc in
Pointer to handler function for the conversion of time delays in the
virtual domain to real-time.
.AP void *clientData in
.AS "ClientData *" clientData in
.AP "ClientData *" clientData in
Value passed through to the two handler functions.
.AP Tcl_GetTimeProc *getProcPtr out
.AS "Tcl_GetTimeProc **" getProcPtr inout
.AP "Tcl_GetTimeProc **" getProcPtr inout
Pointer to place the currently registered get handler function into.
.AP Tcl_ScaleTimeProc *scaleProcPtr out
.AS "Tcl_ScaleTimeProc **" scaleProcPtr inout
.AP "Tcl_ScaleTimeProc **" scaleProcPtr inout
Pointer to place the currently registered scale handler function into.
.AP void **clientDataPtr out
.AS "ClientData **" clientDataPtr inout
.AP "ClientData **" clientDataPtr inout
Pointer to place the currently registered pass-through value into.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_GetTime\fR function retrieves the current time as a
\fITcl_Time\fR structure in memory the caller provides.  This
structure has the following definition:
.PP
.CS
typedef struct Tcl_Time {
    long \fIsec\fR;
    long \fIusec\fR;
} \fBTcl_Time\fR;
    long sec;
    long usec;
} Tcl_Time;
.CE
.PP
On return, the \fIsec\fR member of the structure is filled in with the
number of seconds that have elapsed since the \fIepoch:\fR the epoch
is the point in time of 00:00 UTC, 1 January 1970.  This number does
\fInot\fR count leap seconds \- an interval of one day advances it by
86400 seconds regardless of whether a leap second has been inserted.
.PP
The \fIusec\fR member of the structure is filled in with the number of
microseconds that have elapsed since the start of the second
designated by \fIsec\fR.  The Tcl library makes every effort to keep
this number as precise as possible, subject to the limitations of the
computer system.  On multiprocessor variants of Windows, this number
may be limited to the 10- or 20-ms granularity of the system clock.
(On single-processor Windows systems, the \fIusec\fR field is derived
from a performance counter and is highly precise.)
.SS "VIRTUALIZED TIME"
.PP
The \fBTcl_SetTimeProc\fR function registers two related handler functions
The \fBTcl_SetTime\fR function registers two related handler functions
with the core. The first handler function is a replacement for
\fBTcl_GetTime\fR, or rather the OS access made by
\fBTcl_GetTime\fR. The other handler function is used by the Tcl
notifier to convert wait/block times from the virtual domain into real
time.
.PP
The \fBTcl_QueryTimeProc\fR function returns the currently registered
The \fBTcl_QueryTime\fR function returns the currently registered
handler functions. If no external handlers were set then this will
return the standard handlers accessing and processing the native time
of the OS. The arguments to the function are allowed to be NULL; and
any argument which is NULL is ignored and not set.
.PP
The signatures of the handler functions are as follows:
.PP
.CS
typedef void \fBTcl_GetTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        void *\fIclientData\fR);
typedef void \fBTcl_ScaleTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        void *\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.
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.
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)
clock
.SH KEYWORDS
date, time

Changes to doc/GetVersion.3.

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
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





-
+




















-
+






-
+







-
+






'\"
'\" Copyright (c) 1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_GetVersion 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_GetVersion \- get the version of the library at runtime
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_GetVersion\fR(\fImajor, minor, patchLevel, type\fR)
.SH ARGUMENTS
.AS Tcl_ReleaseType *patchLevel out
.AP int *major out
Major version number of the Tcl library.
.AP int *minor out
Minor version number of the Tcl library.
.AP int *patchLevel out
The patch level of the Tcl library (or alpha or beta number).
.AP Tcl_ReleaseType *type out
The type of release, also indicates the type of patch level. Can be
one of \fBTCL_ALPHA_RELEASE\fR, \fBTCL_BETA_RELEASE\fR, or
one of \fBTCL_ALPHA_RELEASE\fR, \fBTCL_BETA_RELEASE\fR, or 
\fBTCL_FINAL_RELEASE\fR.
.BE

.SH DESCRIPTION
.PP
\fBTcl_GetVersion\fR should be used to query the version number
of the Tcl library at runtime.  This is useful when using a
of the Tcl library at runtime.  This is useful when using a 
dynamically loaded Tcl library or when writing a stubs-aware
extension.  For instance, if you write an extension that is
linked against the Tcl stubs library, it could be loaded into
a program linked to an older version of Tcl than you expected.
Use \fBTcl_GetVersion\fR to verify that fact, and possibly to
change the behavior of your extension.
.PP
\fBTcl_GetVersion\fR accepts NULL for any of the arguments. For instance if
\fBTcl_GetVersion\fR accepts NULL for any of the arguments. For instance if 
you do not care about the \fIpatchLevel\fR of the library, pass
a NULL for the \fIpatchLevel\fR argument.

.SH KEYWORDS
version, patchlevel, major, minor, alpha, beta, release

Changes to doc/Hash.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Hash 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_InitHashTable, Tcl_InitCustomHashTable, Tcl_InitObjHashTable, Tcl_DeleteHashTable, Tcl_CreateHashEntry, Tcl_DeleteHashEntry, Tcl_FindHashEntry, Tcl_GetHashValue, Tcl_SetHashValue, Tcl_GetHashKey, Tcl_FirstHashEntry, Tcl_NextHashEntry, Tcl_HashStats \- procedures to manage hash tables
.SH SYNOPSIS
.nf
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
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







-
+




-
+











-
+









-
-
+
+







-
-
+
+
+












-
-
+
+







\fBTcl_CreateHashEntry\fR(\fItablePtr, key, newPtr\fR)
.sp
\fBTcl_DeleteHashEntry\fR(\fIentryPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_FindHashEntry\fR(\fItablePtr, key\fR)
.sp
void *
ClientData
\fBTcl_GetHashValue\fR(\fIentryPtr\fR)
.sp
\fBTcl_SetHashValue\fR(\fIentryPtr, value\fR)
.sp
void *
char *
\fBTcl_GetHashKey\fR(\fItablePtr, entryPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_FirstHashEntry\fR(\fItablePtr, searchPtr\fR)
.sp
Tcl_HashEntry *
\fBTcl_NextHashEntry\fR(\fIsearchPtr\fR)
.sp
char *
\fBTcl_HashStats\fR(\fItablePtr\fR)
.SH ARGUMENTS
.AS "const Tcl_HashKeyType" *searchPtr out
.AS Tcl_HashKeyType *searchPtr out
.AP Tcl_HashTable *tablePtr in
Address of hash table structure (for all procedures but
\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
Address of structure which defines the behaviour of the hash table.
.AP "const char" *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
Pointer to hash table entry.
.AP void *value in
New value to assign to hash table entry.
.AP ClientData value in
New value to assign to hash table entry.  Need not have type
ClientData, but must fit in same space as ClientData.
.AP Tcl_HashSearch *searchPtr in
Pointer to record to use to keep track of progress in enumerating
all the entries in a hash table.
.BE
.SH DESCRIPTION
.PP
A hash table consists of zero or more entries, each consisting of a
key and a value.  Given the key for an entry, the hashing routines can
very quickly locate the entry, and hence its value. There may be at
most one entry in a hash table with a particular key, but many entries
may have the same value.  Keys can take one of four forms: strings,
one-word values, integer arrays, or custom keys defined by a
Tcl_HashKeyType structure (See section \fBTHE TCL_HASHKEYTYPE STRUCTURE\fR
below). All of the keys in a given table have the same
Tcl_HashKeyType structure (See section \fBTHE TCL_HASHKEYTYPE
STRUCTURE\fR below). All of the keys in a given table have the same
form, which is specified when the table is initialized.
.PP
The value of a hash table entry can be anything that fits in the same
space as a
.QW "char *"
pointer.  Values for hash table entries are
managed entirely by clients, not by the hash module itself.  Typically
126
127
128
129
130
131
132
133
134


135
136
137
138
139


140
141
142
143
144
145
146
127
128
129
130
131
132
133


134
135
136
137
138


139
140
141
142
143
144
145
146
147







-
-
+
+



-
-
+
+







and stored in hash table entries as
.QW "char *"
values.
The pointer value is the key;  it need not (and usually does not)
actually point to a string.
.IP \fBTCL_CUSTOM_TYPE_KEYS\fR 25
Keys are of arbitrary type, and are stored in the entry. Hashing
and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
structure is described in the section
and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType 
structure is described in the section 
\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
.IP \fBTCL_CUSTOM_PTR_KEYS\fR 25
Keys are pointers to an arbitrary type, and are stored in the entry. Hashing
and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType
structure is described in the section
and comparison is determined by \fItypePtr\fR. The Tcl_HashKeyType 
structure is described in the section 
\fBTHE TCL_HASHKEYTYPE STRUCTURE\fR below.
.IP \fIother\fR 25
If \fIkeyType\fR is not one of the above,
then it must be an integer value greater than 1.
In this case the keys will be arrays of
.QW int
values, where
181
182
183
184
185
186
187





188
189
190
191
192
193
194
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200







+
+
+
+
+







.PP
\fBTcl_FindHashEntry\fR is similar to \fBTcl_CreateHashEntry\fR
except that it does not create a new entry if the key doesn't exist;
instead, it returns NULL as result.
.PP
\fBTcl_GetHashValue\fR and \fBTcl_SetHashValue\fR are used to
read and write an entry's value, respectively.
Values are stored and retrieved as type
.QW ClientData ,
which is
large enough to hold a pointer value.  On almost all machines this is
large enough to hold an integer value too.
.PP
\fBTcl_GetHashKey\fR returns the key for a given hash table entry,
either as a pointer to a string, a one-word
.PQ "char *"
key, or
as a pointer to the first word of an array of integers, depending
on the \fIkeyType\fR used to create a hash table.
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
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







-
+















-








-
+














+







+



-

-
+



-





-

-
+



-





-

-
+



-
-
+






-
+



-

-
-
+

-
-
+

-
+


\fBTcl_FirstHashEntry\fR or \fBTcl_NextHashEntry\fR.
.PP
\fBTcl_HashStats\fR returns a dynamically-allocated string with
overall information about a hash table, such as the number of
entries it contains, the number of buckets in its hash array,
and the utilization of the buckets.
It is the caller's responsibility to free the result string
by passing it to \fBTcl_Free\fR.
by passing it to \fBckfree\fR.
.PP
The header file \fBtcl.h\fR defines the actual data structures
used to implement hash tables.
This is necessary so that clients can allocate Tcl_HashTable
structures and so that macros can be used to read and write
the values of entries.
However, users of the hashing routines should never refer directly
to any of the fields of any of the hash-related data structures;
use the procedures and macros defined here.
.SH "THE TCL_HASHKEYTYPE STRUCTURE"
.PP
Extension writers can define new hash key types by defining four procedures,
initializing a \fBTcl_HashKeyType\fR structure to describe the type, and
calling \fBTcl_InitCustomHashTable\fR. The \fBTcl_HashKeyType\fR structure is
defined as follows:
.PP
.CS
typedef struct Tcl_HashKeyType {
    int \fIversion\fR;
    int \fIflags\fR;
    Tcl_HashKeyProc *\fIhashKeyProc\fR;
    Tcl_CompareHashKeysProc *\fIcompareKeysProc\fR;
    Tcl_AllocHashEntryProc *\fIallocEntryProc\fR;
    Tcl_FreeHashEntryProc *\fIfreeEntryProc\fR;
} \fBTcl_HashKeyType\fR;
} Tcl_HashKeyType;
.CE
.PP
The \fIversion\fR member is the version of the table. If this structure is
extended in future then the version can be used to distinguish between
different structures. It should be set to \fBTCL_HASH_KEY_TYPE_VERSION\fR.
.PP
The \fIflags\fR member is 0 or one or more of the following values OR'ed
together:
.IP \fBTCL_HASH_KEY_RANDOMIZE_HASH\fR 25
There are some things, pointers for example which do not hash well because
they do not use the lower bits. If this flag is set then the hash table will
attempt to rectify this by randomizing the bits and then using the upper N
bits as the index into the table.
.IP \fBTCL_HASH_KEY_SYSTEM_HASH\fR 25
.VS 8.5
This flag forces Tcl to use the memory allocation procedures provided by the
operating system when allocating and freeing memory used to store the hash
table data structures, and not any of Tcl's own customized memory allocation
routines. This is important if the hash table is to be used in the
implementation of a custom set of allocation routines, or something that a
custom set of allocation routines might depend on, in order to avoid any
circular dependency.
.VE 8.5
.PP
The \fIhashKeyProc\fR member contains the address of a function called to
calculate a hash value for the key.
.PP
.CS
typedef TCL_HASH_TYPE \fBTcl_HashKeyProc\fR(
typedef unsigned int (Tcl_HashKeyProc) (
        Tcl_HashTable *\fItablePtr\fR,
        void *\fIkeyPtr\fR);
.CE
.PP
If this is NULL then \fIkeyPtr\fR is used and
\fBTCL_HASH_KEY_RANDOMIZE_HASH\fR is assumed.
.PP
The \fIcompareKeysProc\fR member contains the address of a function called to
compare two keys.
.PP
.CS
typedef int \fBTcl_CompareHashKeysProc\fR(
typedef int (Tcl_CompareHashKeysProc) (
        void *\fIkeyPtr\fR,
        Tcl_HashEntry *\fIhPtr\fR);
.CE
.PP
If this is NULL then the \fIkeyPtr\fR pointers are compared. If the keys do
not match then the function returns 0, otherwise it returns 1.
.PP
The \fIallocEntryProc\fR member contains the address of a function called to
allocate space for an entry and initialize the key and clientData.
.PP
.CS
typedef Tcl_HashEntry *\fBTcl_AllocHashEntryProc\fR(
typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) (
        Tcl_HashTable *\fItablePtr\fR,
        void *\fIkeyPtr\fR);
.CE
.PP
If this is NULL then \fBTcl_Alloc\fR is used to allocate enough space for a
If this is NULL then Tcl_Alloc is used to allocate enough space for a
Tcl_HashEntry, the key pointer is assigned to key.oneWordValue and the
clientData is set to NULL. String keys and array keys use this function to
allocate enough space for the entry and the key in one block, rather than
doing it in two blocks. This saves space for a pointer to the key from the
entry and another memory allocation. Tcl_Obj* keys use this function to
allocate enough space for an entry and increment the reference count on the
value.
object.
.PP
The \fIfreeEntryProc\fR member contains the address of a function called to
free space for an entry.
.PP
.CS
typedef void \fBTcl_FreeHashEntryProc\fR(
        Tcl_HashEntry *\fIhPtr\fR);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *\fIhPtr\fR);
.CE
.PP
If this is NULL then \fBTcl_Free\fR is used to free the space for the entry.
If this is NULL then Tcl_Free is used to free the space for the entry.
Tcl_Obj* keys use this function to decrement the reference count on the
value.
object.
.SH KEYWORDS
hash table, key, lookup, search, value

Changes to doc/Init.3.

1
2
3
4

5
6
7
8
9
10
11
1
2
3

4
5
6
7
8
9
10
11



-
+







'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
'\" 
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Init \- find and source initialization script
.SH SYNOPSIS
.nf

Changes to doc/InitStubs.3.

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
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





-
+



















-
+

-
+

-
+







'\"
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_InitStubs 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_InitStubs \- initialize the Tcl stubs mechanism
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
const char *
\fBTcl_InitStubs\fR(\fIinterp, version, exact\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Tcl interpreter handle.
.AP "const char" *version in
A version string consisting of one or more decimal numbers
separated by dots.
.AP int exact in
1 means that only the particular version specified by
Non-zero means that only the particular version specified by
\fIversion\fR is acceptable.
0 means that versions newer than \fIversion\fR are also
Zero means that versions newer than \fIversion\fR are also
acceptable as long as they have the same major version number
as \fIversion\fR. Other bits have no effect.
as \fIversion\fR.
.BE
.SH INTRODUCTION
.PP
The Tcl stubs mechanism defines a way to dynamically bind
extensions to a particular Tcl implementation at run time.
This provides two significant benefits to Tcl users:
.IP 1) 5
59
60
61
62
63
64
65
66
67
68



69
70
71
72
73
74
75
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 9.0 ABI on Unix platforms,
the library name is \fIlibtclstub9.0.a\fR; on Windows platforms, the
library name is \fItclstub90.lib\fR.
Tcl library.  On Unix platforms, the library name is
\fIlibtclstub8.5.a\fR; on Windows platforms, the library name is
\fItclstub85.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

Deleted doc/InitSubSyst.3.

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































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2018 Tcl Core Team
'\"
'\" 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 Tcl_InitSubsystems 3 8.7 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_InitSubsystems \- initialize the Tcl library.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_InitSubsystems\fR(\fIvoid\fR)
.SH DESCRIPTION
.PP
The \fBTcl_InitSubsystems\fR procedure initializes the Tcl
library. This procedure is typically invoked as the very
first thing in the application's main program.
.PP
\fBTcl_InitSubsystems\fR is very similar in use to
\fBTcl_FindExecutable\fR. It can be used when Tcl is
used as utility library, no other encodings than utf-8,
iso8859-1 or unicode are used, and no interest exists in the
value of \fBinfo nameofexecutable\fR. The system encoding will not
be extracted from the environment, but falls back to utf-8.
.SH KEYWORDS
binary, executable file

Changes to doc/IntObj.3.

1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5

6
7
8
9
10

11
12
13
14
15
16
17
18





-
+




-
+







'\"
'\" Copyright (c) 1996-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.
'\"
'\" 
.TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers
Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_GetIntFromObj, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl objects as integer values
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewIntObj\fR(\fIintValue\fR)
.sp
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

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







-
-
-







+















+


-
-

-
+

-
+

-
+


-
+


-
+











+


+

+


+

+


+
-
-
+
+









-
+

-
+



-
-
+
+



-
+

-
+

-
+


-
-
-
-
-
-
-
-
-
-



-
+








-
+

















+



-
-
+
\fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR)
.sp
\fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR)
.sp
int
\fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR)
.sp
int
\fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, intPtr\fR)
.sp
int
\fBTcl_GetLongFromObj\fR(\fIinterp, objPtr, longPtr\fR)
.sp
int
\fBTcl_GetWideIntFromObj\fR(\fIinterp, objPtr, widePtr\fR)
.sp
.sp
.VS 8.5
\fB#include <tclTomMath.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewBignumObj\fR(\fIbigValue\fR)
.sp
\fBTcl_SetBignumObj\fR(\fIobjPtr, bigValue\fR)
.sp
int
\fBTcl_GetBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_TakeBignumFromObj\fR(\fIinterp, objPtr, bigValue\fR)
.sp
int
\fBTcl_InitBignumFromDouble\fR(\fIinterp, doubleValue, bigValue\fR)
.VE 8.5
.SH ARGUMENTS
.AS Tcl_WideInt doubleValue in/out
.AP int endValue in
\fBTcl_GetIntForIndex\fR will return this when the input value is "end".
.AP int intValue in
Integer value used to initialize or set a Tcl value.
Integer value used to initialize or set a Tcl object.
.AP long longValue in
Long integer value used to initialize or set a Tcl value.
Long integer value used to initialize or set a Tcl object.
.AP Tcl_WideInt wideValue in
Wide integer value used to initialize or set a Tcl value.
Wide integer value used to initialize or set a Tcl object.
.AP Tcl_Obj *objPtr in/out
For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR,
and \fBTcl_SetBignumObj\fR, this points to the value in which to store an
and \fBTcl_SetBignumObj\fR, this points to the object in which to store an
integral value.  For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and
\fBTcl_TakeBignumFromObj\fR, this refers to the value from which
\fBTcl_TakeBignumFromObj\fR, this refers to the object from which
to retrieve an integral value.
.AP Tcl_Interp *interp in/out
When non-NULL, an error message is left here when integral value
retrieval fails.
.AP int *intPtr out
Points to place to store the integer value retrieved from \fIobjPtr\fR.
.AP long *longPtr out
Points to place to store the long integer value retrieved from \fIobjPtr\fR.
.AP Tcl_WideInt *widePtr out
Points to place to store the wide integer value retrieved from \fIobjPtr\fR.
.AP mp_int *bigValue in/out
.VS 8.5
Points to a multi-precision integer structure declared by the LibTomMath
library.
.VE 8.5
.AP double doubleValue in
.VS 8.5
Double value from which the integer part is determined and
used to initialize a multi-precision integer value.
.VE 8.5
.BE

.SH DESCRIPTION
.PP
.VS 8.5
These procedures are used to create, modify, and read Tcl values
that hold integral values.
These procedures are used to create, modify, and read Tcl objects
that hold integral values.  
.PP
The different routines exist to accommodate different integral types in C
with which values might be exchanged.  The C integral types for which Tcl
provides value exchange routines are \fBint\fR, \fBlong int\fR,
\fBTcl_WideInt\fR, and \fBmp_int\fR.  The \fBint\fR and \fBlong int\fR types
are provided by the C language standard.  The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807).  Depending
on the platform and the C compiler, the actual type might be
\fBlong long int\fR, \fB__int64\fR, or something else.
\fBlong int\fR, \fBlong long int\fR, \fBint64\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
by the LibTomMath multiple-precision integer library.  
.PP
The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR,
and \fBTcl_NewBignumObj\fR routines each create and return a new
Tcl value initialized to the integral value of the argument.  The
returned Tcl value is unshared.
Tcl object initialized to the integral value of the argument.  The
returned Tcl object is unshared.
.PP
The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR,
and \fBTcl_SetBignumObj\fR routines each set the value of an existing
Tcl value pointed to by \fIobjPtr\fR to the integral value provided
Tcl object pointed to by \fIobjPtr\fR to the integral value provided
by the other argument.  The \fIobjPtr\fR argument must point to an
unshared Tcl value.  Any attempt to set the value of a shared Tcl value
unshared Tcl object.  Any attempt to set the value of a shared Tcl object
violates Tcl's copy-on-write policy.  Any existing string representation
or internal representation in the unshared Tcl value will be freed
or internal representation in the unshared Tcl object will be freed
as a consequence of setting the new value.
.PP
The \fBTcl_GetIntForIndex\fR routine attempts to retrieve an index
value from the Tcl value \fIobjPtr\fR.  If the attempt succeeds,
then \fBTCL_OK\fR is returned, and the value is written to the
storage provided by the caller.  The attempt might fail if
\fIobjPtr\fR does not hold an index value.  If the attempt fails,
then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL,
an error message is left in \fIinterp\fR.  The \fBTcl_ObjType\fR
of \fIobjPtr\fR may be changed to make subsequent calls to the
same routine more efficient.
.PP
The \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR,
\fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and
\fBTcl_TakeBignumFromObj\fR routines attempt to retrieve an integral
value of the appropriate type from the Tcl value \fIobjPtr\fR.  If the
value of the appropriate type from the Tcl object \fIobjPtr\fR.  If the
attempt succeeds, then \fBTCL_OK\fR is returned, and the value is
written to the storage provided by the caller.  The attempt might
fail if \fIobjPtr\fR does not hold an integral value, or if the
value exceeds the range of the target type.  If the attempt fails,
then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL,
an error message is left in \fIinterp\fR.  The \fBTcl_ObjType\fR
of \fIobjPtr\fR may be changed to make subsequent calls to the
same routine more efficient. Unlike the other functions,
\fBTcl_TakeBignumFromObj\fR may set the content of the Tcl value
\fBTcl_TakeBignumFromObj\fR may set the content of the Tcl object
\fIobjPtr\fR to an empty string in the process of retrieving the
multiple-precision integer value.
.PP
The choice between \fBTcl_GetBignumFromObj\fR and
\fBTcl_TakeBignumFromObj\fR is governed by how the caller will
continue to use \fIobjPtr\fR.  If after the \fBmp_int\fR value
is retrieved from \fIobjPtr\fR, the caller will make no more
use of \fIobjPtr\fR, then using \fBTcl_TakeBignumFromObj\fR
permits Tcl to detect when an unshared \fIobjPtr\fR permits the
value to be moved instead of copied, which should be more efficient.
If anything later in the caller requires
\fIobjPtr\fR to continue to hold the same value, then
\fBTcl_GetBignumFromObj\fR must be chosen.
.PP
The \fBTcl_InitBignumFromDouble\fR routine is a utility procedure
that extracts the integer part of \fIdoubleValue\fR and stores that
integer value in the \fBmp_int\fR value \fIbigValue\fR.
.VE 8.5
.SH "SEE ALSO"
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
.SH KEYWORDS
integer, integer value, integer type, internal representation, value,
value type, string representation
integer, integer object, integer type, internal representation, object, object type, string representation

Added doc/Interp.3.































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.TH Tcl_Interp 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Interp \- client-visible fields of interpreter structures
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
typedef struct {
        char *\fIresult\fR;
        Tcl_FreeProc *\fIfreeProc\fR;
        int \fIerrorLine\fR;
} Tcl_Interp;

typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
.BE

.SH DESCRIPTION
.PP
The \fBTcl_CreateInterp\fR procedure returns a pointer to a Tcl_Interp
structure.  This pointer is then passed into other Tcl procedures
to process commands in the interpreter and perform other operations
on the interpreter.  Interpreter structures contain many fields
that are used by Tcl, but only three that may be accessed by
clients:  \fIresult\fR, \fIfreeProc\fR, and \fIerrorLine\fR.
.PP
.VS 8.5
\fBNote that access to all three fields, \fIresult\fB, \fIfreeProc\fB and
\fIerrorLine\fB is deprecated.\fR  Use \fBTcl_SetResult\fR,
\fBTcl_GetResult\fR, and \fBTcl_GetReturnOptions\fR instead.
.VE 8.5
.PP
The \fIresult\fR and \fIfreeProc\fR fields are used to return
results or error messages from commands.
This information is returned by command procedures back to \fBTcl_Eval\fR,
and by \fBTcl_Eval\fR back to its callers.
The \fIresult\fR field points to the string that represents the
result or error message, and the \fIfreeProc\fR field tells how
to dispose of the storage for the string when it is not needed anymore.
The easiest way for command procedures to manipulate these
fields is to call procedures like \fBTcl_SetResult\fR
or \fBTcl_AppendResult\fR;  they
will hide all the details of managing the fields.
The description below is for those procedures that manipulate the
fields directly.
.PP
Whenever a command procedure returns, it must ensure
that the \fIresult\fR field of its interpreter points to the string
being returned by the command.
The \fIresult\fR field must always point to a valid string.
If a command wishes to return no result then \fIinterp->result\fR
should point to an empty string.
Normally, results are assumed to be statically allocated,
which means that the contents will not change before the next time
\fBTcl_Eval\fR is called or some other command procedure is invoked.
In this case, the \fIfreeProc\fR field must be zero.
Alternatively, a command procedure may dynamically
allocate its return value (e.g. using \fBTcl_Alloc\fR)
and store a pointer to it in \fIinterp->result\fR.
In this case, the command procedure must also set \fIinterp->freeProc\fR
to the address of a procedure that can free the value, or \fBTCL_DYNAMIC\fR
if the storage was allocated directly by Tcl or by a call to
\fBTcl_Alloc\fR. 
If \fIinterp->freeProc\fR is non-zero, then Tcl will call \fIfreeProc\fR
to free the space pointed to by \fIinterp->result\fR before it
invokes the next command.
If a client procedure overwrites \fIinterp->result\fR when
\fIinterp->freeProc\fR is non-zero, then it is responsible for calling
\fIfreeProc\fR to free the old \fIinterp->result\fR (the \fBTcl_FreeResult\fR
macro should be used for this purpose).
.PP
\fIFreeProc\fR should have arguments and result that match the
\fBTcl_FreeProc\fR declaration above:  it receives a single
argument which is a pointer to the result value to free.
In most applications \fBTCL_DYNAMIC\fR is the only non-zero value ever
used for \fIfreeProc\fR.
However, an application may store a different procedure address
in \fIfreeProc\fR in order to use an alternate memory allocator
or in order to do other cleanup when the result memory is freed.
.PP
As part of processing each command, \fBTcl_Eval\fR initializes
\fIinterp->result\fR
and \fIinterp->freeProc\fR just before calling the command procedure for
the command.  The \fIfreeProc\fR field will be initialized to zero,
and \fIinterp->result\fR will point to an empty string.  Commands that
do not return any value can simply leave the fields alone.
Furthermore, the empty string pointed to by \fIresult\fR is actually
part of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
If a command wishes to return a short string, it can simply copy
it to the area pointed to by \fIinterp->result\fR.  Or, it can use
the sprintf procedure to generate a short result string at the location
pointed to by \fIinterp->result\fR.
.PP
It is a general convention in Tcl-based applications that the result
of an interpreter is normally in the initialized state described
in the previous paragraph.
Procedures that manipulate an interpreter's result (e.g. by
returning an error) will generally assume that the result
has been initialized when the procedure is called.
If such a procedure is to be called after the result has been
changed, then \fBTcl_ResetResult\fR should be called first to
reset the result to its initialized state.  The direct use of
\fIinterp->result\fR is strongly deprecated (see \fBTcl_SetResult\fR).
.PP
The \fIerrorLine\fR
field is valid only after \fBTcl_Eval\fR returns
a \fBTCL_ERROR\fR return code.  In this situation the \fIerrorLine\fR
field identifies the line number of the command being executed when
the error occurred.  The line numbers are relative to the command
being executed:  1 means the first line of the command passed to
\fBTcl_Eval\fR, 2 means the second line, and so on.
The \fIerrorLine\fR field is typically used in conjunction with
\fBTcl_AddErrorInfo\fR to report information about where an error
occurred.
\fIErrorLine\fR should not normally be modified except by \fBTcl_Eval\fR.

.SH KEYWORDS
free, initialized, interpreter, malloc, result

Changes to doc/Limit.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 2004 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_LimitCheck 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_LimitAddHandler, Tcl_LimitCheck, Tcl_LimitExceeded, Tcl_LimitGetCommands, Tcl_LimitGetGranularity, Tcl_LimitGetTime, Tcl_LimitReady, Tcl_LimitRemoveHandler, Tcl_LimitSetCommands, Tcl_LimitSetGranularity, Tcl_LimitSetTime, Tcl_LimitTypeEnabled, Tcl_LimitTypeExceeded, Tcl_LimitTypeReset, Tcl_LimitTypeSet \- manage and check resource limits on interpreters
.SH SYNOPSIS
.nf
79
80
81
82
83
84
85
86

87
88
89
90
91
92

93
94
95
96
97
98
99
79
80
81
82
83
84
85

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







-
+






+







Function to call when a particular limit is exceeded.  If the
\fIhandlerProc\fR removes or raises the limit during its processing,
the limited interpreter will be permitted to continue to process after
the handler returns.  Many handlers may be attached to the same
interpreter limit; their order of execution is not defined, and they
must be identified by \fIhandlerProc\fR and \fIclientData\fR when they
are deleted.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary pointer-sized word used to pass some context to the
\fIhandlerProc\fR function.
.AP Tcl_LimitHandlerDeleteProc *deleteProc in
Function to call whenever a handler is deleted.  May be NULL if the
\fIclientData\fR requires no deletion.
.BE

.SH DESCRIPTION
.PP
Tcl's interpreter resource limit subsystem allows for close control
over how much computation time a script may use, and is useful for
cases where a program is divided into multiple pieces where some parts
are more trusted than others (e.g. web application servers).
.PP
112
113
114
115
116
117
118
119

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

120
121
122
123
124
125
126
127







-
+







the interpreter to permit it to continue processing longer.
.PP
When a limit is exceeded (and the callbacks have run; the order of
execution of the callbacks is unspecified) execution in the limited
interpreter is stopped by raising an error and setting a flag that
prevents the \fBcatch\fR command in that interpreter from trapping
that error.  It is up to the context that started execution in that
interpreter (typically the main interpreter) to handle the error.
interpreter (typically a master interpreter) to handle the error.
.SH "LIMIT CHECKING API"
.PP
To check the resource limits for an interpreter, call
\fBTcl_LimitCheck\fR, which returns \fBTCL_OK\fR if the limit was not
exceeded (after processing callbacks) and \fBTCL_ERROR\fR if the limit was
exceeded (in which case an error message is also placed in the
interpreter result).  That function should only be called when
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
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







-
-
+
+















-
-
+
+








+


.PP
To add a handler callback to be invoked when a limit is exceeded, call
\fBTcl_LimitAddHandler\fR.  The \fIhandlerProc\fR argument describes
the function that will actually be called; it should have the
following prototype:
.PP
.CS
typedef void \fBTcl_LimitHandlerProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_LimitHandlerProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIclientData\fR argument to the handler will be whatever is
passed to the \fIclientData\fR argument to \fBTcl_LimitAddHandler\fR,
and the \fIinterp\fR is the interpreter that had its limit exceeded.
.PP
The \fIdeleteProc\fR argument to \fBTcl_LimitAddHandler\fR is a
function to call to delete the \fIclientData\fR value.  It may be
\fBTCL_STATIC\fR or NULL if no deletion action is necessary, or
\fBTCL_DYNAMIC\fR if all that is necessary is to free the structure with
\fBTcl_Free\fR.  Otherwise, it should refer to a function with the
following prototype:
.PP
.CS
typedef void \fBTcl_LimitHandlerDeleteProc\fR(
        void *\fIclientData\fR);
typedef void Tcl_LimitHandlerDeleteProc(
        ClientData \fIclientData\fR);
.CE
.PP
A limit handler may be deleted using \fBTcl_LimitRemoveHandler\fR; the
handler removed will be the first one found (out of the handlers added
with \fBTcl_LimitAddHandler\fR) with exactly matching \fItype\fR,
\fIhandlerProc\fR and \fIclientData\fR arguments.  This function
always invokes the \fIdeleteProc\fR on the \fIclientData\fR (unless
the \fIdeleteProc\fR was NULL or \fBTCL_STATIC\fR).

.SH KEYWORDS
interpreter, resource, limit, commands, time, callback

Changes to doc/LinkVar.3.

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

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






-
+




-
+







-
-
-
-
-




-
+





-
+

-
-
-
-
-

-
-
+
+


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

+













-
-
-
-
-
-
-

-




-
-
+



-
-
+
+
-


-
-
+




-
+
-
-


-
-
+



-
+
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-

-
-
+




-
+
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-

-
-
+



-
+
-
-


-
-
+




-
+
-
-


-
-
+



-
+
-
-


-
-
+




-
-
+
+
-


-
-
+



-
-
+
+
-


-
-
+




-
-
+
+
-


-
-
-
+




-
-
+
+
-


-
-
-
-
+
+
+





-
-
+
+
-


-
-
+












-


-
+






-



















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

-
+
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_LinkArray, Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
Tcl_LinkVar, Tcl_UnlinkVar, Tcl_UpdateLinkedVar \- link Tcl variable to C variable
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_LinkVar\fR(\fIinterp, varName, addr, type\fR)
.sp
.VS "TIP 312"
int
\fBTcl_LinkArray\fR(\fIinterp, varName, addr, type, size\fR)
.VE "TIP 312"
.sp
\fBTcl_UnlinkVar\fR(\fIinterp, varName\fR)
.sp
\fBTcl_UpdateLinkedVar\fR(\fIinterp, varName\fR)
.SH ARGUMENTS
.AS Tcl_Interp varName in
.AS Tcl_Interp writable
.AP Tcl_Interp *interp in
Interpreter that contains \fIvarName\fR.
Also used by \fBTcl_LinkVar\fR to return error messages.
.AP "const char" *varName in
Name of global variable.
.AP void *addr in
.AP char *addr in
Address of C variable that is to be linked to \fIvarName\fR.
.sp
.VS "TIP 312"
In \fBTcl_LinkArray\fR, may be NULL to tell Tcl to create the storage
for the array in the variable.
.VE "TIP 312"
.AP int type in
Type of C variable for \fBTcl_LinkVar\fR or type of array element for
\fBTcl_LinkArray\fR.  Must be one of \fBTCL_LINK_INT\fR,
Type of C variable.  Must be one of \fBTCL_LINK_INT\fR,
.VS 8.5
\fBTCL_LINK_UINT\fR, \fBTCL_LINK_CHAR\fR, \fBTCL_LINK_UCHAR\fR,
\fBTCL_LINK_SHORT\fR, \fBTCL_LINK_USHORT\fR, \fBTCL_LINK_LONG\fR,
\fBTCL_LINK_ULONG\fR, \fBTCL_LINK_WIDE_INT\fR,
\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR, \fBTCL_LINK_DOUBLE\fR,
\fBTCL_LINK_ULONG\fR,
.VE 8.5
\fBTCL_LINK_WIDE_INT\fR,
\fBTCL_LINK_BOOLEAN\fR, or one of the extra ones listed below.
.sp
In \fBTcl_LinkVar\fR, the additional linked type \fBTCL_LINK_STRING\fR may be
used.
.sp
.VS "TIP 312"
.VS 8.5
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
\fBTCL_LINK_BYTES\fR may be used.
.VE "TIP 312"
\fBTCL_LINK_WIDE_UINT\fR, \fBTCL_LINK_FLOAT\fR,
.VE 8.5
.sp
All the above for both functions may be
optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR to make the Tcl
variable read-only.
\fBTCL_LINK_DOUBLE\fR, \fBTCL_LINK_BOOLEAN\fR, or
\fBTCL_LINK_STRING\fR, optionally OR'ed with \fBTCL_LINK_READ_ONLY\fR
to make Tcl variable read-only.
.AP size_t size in
.VS "TIP 312"
The number of elements in the C array. Must be greater than zero.
.VE "TIP 312"
.BE

.SH DESCRIPTION
.PP
\fBTcl_LinkVar\fR uses variable traces to keep the Tcl variable
named by \fIvarName\fR in sync with the C variable at the address
given by \fIaddr\fR.
Whenever the Tcl variable is read the value of the C variable will
be returned, and whenever the Tcl variable is written the C
variable will be updated to have the same value.
\fBTcl_LinkVar\fR normally returns \fBTCL_OK\fR;  if an error occurs
while setting up the link (e.g. because \fIvarName\fR is the
name of array) then \fBTCL_ERROR\fR is returned and the interpreter's result
contains an error message.
.PP
.VS "TIP 312"
\fBTcl_LinkArray\fR is similar, but for arrays of fixed size (given by
the \fIsize\fR argument). When asked to allocate the backing C array
storage (via the \fIaddr\fR argument being NULL), it writes the
address that it allocated to the Tcl interpreter result.
.VE "TIP 312"
.PP
The \fItype\fR argument specifies the type of the C variable,
or the type of the elements of the C array,
and must have one of the following values, optionally OR'ed with
\fBTCL_LINK_READ_ONLY\fR:
.TP
\fBTCL_LINK_INT\fR
.
The C variable, or each element of the C array, is of type \fBint\fR.
The C variable is of type \fBint\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted
Tcl errors.
.VS 8.5
as if they are valid too.
.TP
\fBTCL_LINK_UINT\fR
.
The C variable, or each element of the C array, is of type \fBunsigned int\fR.
The C variable is of type \fBunsigned int\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned int\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
\fIvarName\fR will be rejected with Tcl errors.
representations (like the empty string, '+', '-' or the hex/octal/decimal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_CHAR\fR
.
The C variable, or each element of the C array, is of type \fBchar\fR.
The C variable is of type \fBchar\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBchar\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
values into \fIvarName\fR will be rejected with Tcl errors.
integer representations (like the empty string, '+', '-' or the
hex/octal/decimal/binary prefix) are accepted as if they are valid too.
.RS
.PP
.VS "TIP 312"
If using an array of these, consider using \fBTCL_LINK_CHARS\fR instead.
.VE "TIP 312"
.RE
.TP
\fBTCL_LINK_CHARS\fR
.VS "TIP 312"
The C array is of type \fBchar *\fR and is mapped into Tcl as a string.
Any value written into the Tcl variable must have the same length as
the underlying storage. Only supported with \fBTcl_LinkArray\fR.
.VE "TIP 312"
.TP
\fBTCL_LINK_UCHAR\fR
.
The C variable, or each element of the C array, is of type \fBunsigned char\fR.
The C variable is of type \fBunsigned char\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned char\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
\fIvarName\fR will be rejected with Tcl errors.
representations (like the empty string, '+', '-' or the hex/octal/decimal/binary
prefix) are accepted as if they are valid too.
.RS
.PP
.VS "TIP 312"
If using an array of these, consider using \fBTCL_LINK_BYTES\fR instead.
.VE "TIP 312"
.RE
.TP
\fBTCL_LINK_BYTES\fR
.VS "TIP 312"
The C array is of type \fBunsigned char *\fR and is mapped into Tcl
as a bytearray.
Any value written into the Tcl variable must have the same length as
the underlying storage. Only supported with \fBTcl_LinkArray\fR.
.VE "TIP 312"
.TP
\fBTCL_LINK_SHORT\fR
.
The C variable, or each element of the C array, is of type \fBshort\fR.
The C variable is of type \fBshort\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetIntFromObj\fR and be in the range of the
\fBshort\fR datatype; attempts to write non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
values into \fIvarName\fR will be rejected with Tcl errors.
integer representations (like the empty string, '+', '-' or the
hex/octal/decimal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_USHORT\fR
.
The C variable, or each element of the C array, is of type \fBunsigned short\fR.
The C variable is of type \fBunsigned short\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetIntFromObj\fR and in the
platform's defined range for the \fBunsigned short\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
\fIvarName\fR will be rejected with Tcl errors.
representations (like the empty string, '+', '-' or the hex/octal/decimal/binary
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_LONG\fR
.
The C variable, or each element of the C array, is of type \fBlong\fR.
The C variable is of type \fBlong\fR.
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetLongFromObj\fR; attempts to write
non-integer or out-of-range
values into \fIvarName\fR will be rejected with Tcl errors. Incomplete
values into \fIvarName\fR will be rejected with Tcl errors.
integer representations (like the empty string, '+', '-' or the
hex/octal/decimal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_ULONG\fR
.
The C variable, or each element of the C array, is of type \fBunsigned long\fR.
The C variable is of type \fBunsigned long\fR.
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR and in the
platform's defined range for the \fBunsigned long\fR type; attempts to
write non-integer values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
representations (like the empty string, '+', '-' or the hex/octal/decimal/binary
\fIvarName\fR will be rejected with Tcl errors.
.VE 8.5
prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_DOUBLE\fR
.
The C variable, or each element of the C array, is of type \fBdouble\fR.
The C variable is of type \fBdouble\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR;  attempts to write
non-real values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer or real representations (like the
empty string, '.', '+', '-' or the hex/octal/decimal/binary prefix) are
Tcl errors.
.VS 8.5
accepted as if they are valid too.
.TP
\fBTCL_LINK_FLOAT\fR
.
The C variable, or each element of the C array, is of type \fBfloat\fR.
The C variable is of type \fBfloat\fR.
Any value written into the Tcl variable must have a proper real
form acceptable to \fBTcl_GetDoubleFromObj\fR and must be within the
range acceptable for a \fBfloat\fR; attempts to
write non-real values (or values outside the range) into
\fIvarName\fR will be rejected with Tcl errors. Incomplete integer
or real representations (like the empty string, '.', '+', '-' or
\fIvarName\fR will be rejected with Tcl errors.
.VE 8.5
the hex/octal/decimal/binary prefix) are accepted as if they are valid too.
.TP
\fBTCL_LINK_WIDE_INT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideInt\fR
(which is an integer type
The C variable is of type \fBTcl_WideInt\fR (which is an integer type
at least 64-bits wide on all platforms that can support it.)
Any value written into the Tcl variable must have a proper integer
form acceptable to \fBTcl_GetWideIntFromObj\fR;  attempts to write
non-integer values into \fIvarName\fR will be rejected with
Tcl errors. Incomplete integer representations (like the empty
string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted
Tcl errors.
.VS 8.5
as if they are valid too.
.TP
\fBTCL_LINK_WIDE_UINT\fR
.
The C variable, or each element of the C array, is of type \fBTcl_WideUInt\fR
(which is an unsigned integer type at least 64-bits wide on all platforms that
can support it.)
The C variable is of type \fBTcl_WideUInt\fR (which is an unsigned
integer type at least 64-bits wide on all platforms that can support
it.)
Any value written into the Tcl variable must have a proper unsigned
integer form acceptable to \fBTcl_GetWideIntFromObj\fR (it will be
cast to unsigned);
.\" FIXME! Use bignums instead.
attempts to write non-integer values into \fIvarName\fR will be
rejected with Tcl errors. Incomplete integer representations (like
the empty string, '+', '-' or the hex/octal/decimal/binary prefix) are accepted
rejected with Tcl errors.
.VE 8.5
as if they are valid too.
.TP
\fBTCL_LINK_BOOLEAN\fR
.
The C variable, or each element of the C array, is of type \fBint\fR.
The C variable is of type \fBint\fR.
If its value is zero then it will read from Tcl as
.QW 0 ;
otherwise it will read from Tcl as
.QW 1 .
Whenever \fIvarName\fR is
modified, the C variable will be set to a 0 or 1 value.
Any value written into the Tcl variable must have a proper boolean
form acceptable to \fBTcl_GetBooleanFromObj\fR;  attempts to write
non-boolean values into \fIvarName\fR will be rejected with
Tcl errors.
.TP
\fBTCL_LINK_STRING\fR
.
The C variable is of type \fBchar *\fR.
If its value is not NULL then it must be a pointer to a string
allocated with \fBTcl_Alloc\fR.
allocated with \fBTcl_Alloc\fR or \fBckalloc\fR.
Whenever the Tcl variable is modified the current C string will be
freed and new memory will be allocated to hold a copy of the variable's
new value.
If the C variable contains a NULL pointer then the Tcl variable
will read as
.QW NULL .
This is only supported by \fBTcl_LinkVar\fR.
.PP
If the \fBTCL_LINK_READ_ONLY\fR flag is present in \fItype\fR then the
variable will be read-only from Tcl, so that its value can only be
changed by modifying the C variable.
Attempts to write the variable from Tcl will be rejected with errors.
.PP
\fBTcl_UnlinkVar\fR removes the link previously set up for the
variable given by \fIvarName\fR.  If there does not exist a link
for \fIvarName\fR then the procedure has no effect.
.PP
\fBTcl_UpdateLinkedVar\fR may be invoked after the C variable has
changed to force the Tcl variable to be updated immediately.
In many cases this procedure is not needed, since any attempt to
read the Tcl variable will return the latest value of the C variable.
However, if a trace has been set on the Tcl variable (such as a
Tk widget that wishes to display the value of the variable), the
trace will not trigger when the C variable has changed.
\fBTcl_UpdateLinkedVar\fR ensures that any traces on the Tcl
variable are invoked.
.PP

Note that, as with any call to a Tcl interpreter, \fBTcl_UpdateLinkedVar\fR
must be called from the same thread that created the interpreter. The safest
mechanism is to ensure that the C variable is only ever updated from the same
thread that created the interpreter (possibly in response to an event posted
with \fBTcl_ThreadQueueEvent\fR), but when it is necessary to update the
variable in a separate thread, it is advised that \fBTcl_AsyncMark\fR be used
to indicate to the thread hosting the interpreter that it is ready to run
\fBTcl_UpdateLinkedVar\fR.
.SH "SEE ALSO"
Tcl_TraceVar(3)
.SH KEYWORDS
boolean, integer, link, read-only, real, string, trace, variable
boolean, integer, link, read-only, real, string, traces, variable

Changes to doc/ListObj.3.

1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5

6
7
8
9
10

11
12
13
14
15
16
17
18





-
+




-
+







'\"
'\" Copyright (c) 1996-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.
'\"
'\" 
.TH Tcl_ListObj 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl values as lists
Tcl_ListObjAppendList, Tcl_ListObjAppendElement, Tcl_NewListObj, Tcl_SetListObj, Tcl_ListObjGetElements, Tcl_ListObjLength, Tcl_ListObjIndex, Tcl_ListObjReplace \- manipulate Tcl objects as lists
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_ListObjAppendList\fR(\fIinterp, listPtr, elemListPtr\fR)
.sp
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
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








-
-
+
+


-
-
+
+


-
+




-
+



-
+

-
+



-
+


-
+

-
-
+
+


-
+

-
-
+
+

-
+









-
+











-
+


-
+


-
-
-
+
+
+

-
+

-
-
+
+


-
-
+
+



-
+


-
+


-
+






-
+


-
+

-
+

-
+


-
+

-
-
+
+



-
+





-
+


-
+


-
+


-
+


-
+



-
+

-
+

-
+


-
+







-
+





-
-
+
+


-
+

-
+














-
+




-
-
+
+



-
+



-
+




-
+

-
+









-
+



-
+

-
+
-
\fBTcl_ListObjIndex\fR(\fIinterp, listPtr, index, objPtrPtr\fR)
.sp
int
\fBTcl_ListObjReplace\fR(\fIinterp, listPtr, first, count, objc, objv\fR)
.SH ARGUMENTS
.AS "Tcl_Obj *const" *elemListPtr in/out
.AP Tcl_Interp *interp in
If an error occurs while converting a value to be a list value,
an error message is left in the interpreter's result value
If an error occurs while converting an object to be a list object,
an error message is left in the interpreter's result object
unless \fIinterp\fR is NULL.
.AP Tcl_Obj *listPtr in/out
Points to the list value to be manipulated.
If \fIlistPtr\fR does not already point to a list value,
Points to the list object to be manipulated.
If \fIlistPtr\fR does not already point to a list object,
an attempt will be made to convert it to one.
.AP Tcl_Obj *elemListPtr in/out
For \fBTcl_ListObjAppendList\fR, this points to a list value
For \fBTcl_ListObjAppendList\fR, this points to a list object
containing elements to be appended onto \fIlistPtr\fR.
Each element of *\fIelemListPtr\fR will
become a new element of \fIlistPtr\fR.
If *\fIelemListPtr\fR is not NULL and
does not already point to a list value,
does not already point to a list object,
an attempt will be made to convert it to one.
.AP Tcl_Obj *objPtr in
For \fBTcl_ListObjAppendElement\fR,
points to the Tcl value that will be appended to \fIlistPtr\fR.
points to the Tcl object that will be appended to \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
this points to the Tcl value that will be converted to a list value
this points to the Tcl object that will be converted to a list object
containing the \fIobjc\fR elements of the array referenced by \fIobjv\fR.
.AP int *objcPtr in
Points to location where \fBTcl_ListObjGetElements\fR
stores the number of element values in \fIlistPtr\fR.
stores the number of element objects in \fIlistPtr\fR.
.AP Tcl_Obj ***objvPtr out
A location where \fBTcl_ListObjGetElements\fR stores a pointer to an array
of pointers to the element values of \fIlistPtr\fR.
of pointers to the element objects of \fIlistPtr\fR.  
.AP int objc in
The number of Tcl values that \fBTcl_NewListObj\fR
will insert into a new list value,
The number of Tcl objects that \fBTcl_NewListObj\fR
will insert into a new list object,
and \fBTcl_ListObjReplace\fR will insert into \fIlistPtr\fR.
For \fBTcl_SetListObj\fR,
the number of Tcl values to insert into \fIobjPtr\fR.
the number of Tcl objects to insert into \fIobjPtr\fR.
.AP "Tcl_Obj *const" objv[] in
An array of pointers to values.
\fBTcl_NewListObj\fR will insert these values into a new list value
An array of pointers to objects.
\fBTcl_NewListObj\fR will insert these objects into a new list object
and \fBTcl_ListObjReplace\fR will insert them into an existing \fIlistPtr\fR.
Each value will become a separate list element.
Each object will become a separate list element.  
.AP int *intPtr out
Points to location where \fBTcl_ListObjLength\fR
stores the length of the list.
.AP int index in
Index of the list element that \fBTcl_ListObjIndex\fR
is to return.
The first element has index 0.
.AP Tcl_Obj **objPtrPtr out
Points to place where \fBTcl_ListObjIndex\fR is to store
a pointer to the resulting list element value.
a pointer to the resulting list element object.
.AP int first in
Index of the starting list element that \fBTcl_ListObjReplace\fR
is to replace.
The list's first element has index 0.
.AP int count in
The number of elements that \fBTcl_ListObjReplace\fR
is to replace.
.BE

.SH DESCRIPTION
.PP
Tcl list values have an internal representation that supports
Tcl list objects have an internal representation that supports
the efficient indexing and appending.
The procedures described in this man page are used to
create, modify, index, and append to Tcl list values from C code.
create, modify, index, and append to Tcl list objects from C code.
.PP
\fBTcl_ListObjAppendList\fR and \fBTcl_ListObjAppendElement\fR
both add one or more values
to the end of the list value referenced by \fIlistPtr\fR.
\fBTcl_ListObjAppendList\fR appends each element of the list value
both add one or more objects
to the end of the list object referenced by \fIlistPtr\fR.
\fBTcl_ListObjAppendList\fR appends each element of the list object
referenced by \fIelemListPtr\fR while
\fBTcl_ListObjAppendElement\fR appends the single value
\fBTcl_ListObjAppendElement\fR appends the single object
referenced by \fIobjPtr\fR.
Both procedures will convert the value referenced by \fIlistPtr\fR
to a list value if necessary.
Both procedures will convert the object referenced by \fIlistPtr\fR
to a list object if necessary.
If an error occurs during conversion,
both procedures return \fBTCL_ERROR\fR and leave an error message
in the interpreter's result value if \fIinterp\fR is not NULL.
Similarly, if \fIelemListPtr\fR does not already refer to a list value,
in the interpreter's result object if \fIinterp\fR is not NULL.
Similarly, if \fIelemListPtr\fR does not already refer to a list object,
\fBTcl_ListObjAppendList\fR will attempt to convert it to one
and if an error occurs during conversion,
will return \fBTCL_ERROR\fR
and leave an error message in the interpreter's result value
and leave an error message in the interpreter's result object
if interp is not NULL.
Both procedures invalidate any old string representation of \fIlistPtr\fR
and, if it was converted to a list value,
and, if it was converted to a list object,
free any old internal representation.
Similarly, \fBTcl_ListObjAppendList\fR frees any old internal representation
of \fIelemListPtr\fR if it converts it to a list value.
of \fIelemListPtr\fR if it converts it to a list object.
After appending each element in \fIelemListPtr\fR,
\fBTcl_ListObjAppendList\fR increments the element's reference count
since \fIlistPtr\fR now also refers to it.
For the same reason, \fBTcl_ListObjAppendElement\fR
increments \fIobjPtr\fR's reference count.
If no error occurs,
the two procedures return \fBTCL_OK\fR after appending the values.
the two procedures return \fBTCL_OK\fR after appending the objects.
.PP
\fBTcl_NewListObj\fR and \fBTcl_SetListObj\fR
create a new value or modify an existing value to hold
create a new object or modify an existing object to hold 
the \fIobjc\fR elements of the array referenced by \fIobjv\fR
where each element is a pointer to a Tcl value.
where each element is a pointer to a Tcl object.
If \fIobjc\fR is less than or equal to zero,
they return an empty value. If \fIobjv\fR is NULL, the resulting list
they return an empty object. If \fIobjv\fR is NULL, the resulting list
contains 0 elements, with reserved space in an internal representation
for \fIobjc\fR more elements (to avoid its reallocation later).
The new value's string representation is left invalid.
The new object's string representation is left invalid.
The two procedures increment the reference counts
of the elements in \fIobjc\fR since the list value now refers to them.
The new list value returned by \fBTcl_NewListObj\fR
of the elements in \fIobjc\fR since the list object now refers to them.
The new list object returned by \fBTcl_NewListObj\fR
has reference count zero.
.PP
\fBTcl_ListObjGetElements\fR returns a count and a pointer to an array of
the elements in a list value.  It returns the count by storing it in the
the elements in a list object.  It returns the count by storing it in the
address \fIobjcPtr\fR.  Similarly, it returns the array pointer by storing
it in the address \fIobjvPtr\fR.
The memory pointed to is managed by Tcl and should not be freed or written
to by the caller. If the list is empty, 0 is stored at \fIobjcPtr\fR
and NULL at \fIobjvPtr\fR.
If \fIlistPtr\fR is not already a list value, \fBTcl_ListObjGetElements\fR
If \fIlistPtr\fR is not already a list object, \fBTcl_ListObjGetElements\fR
will attempt to convert it to one; if the conversion fails, it returns
\fBTCL_ERROR\fR and leaves an error message in the interpreter's result
value if \fIinterp\fR is not NULL.
object if \fIinterp\fR is not NULL.
Otherwise it returns \fBTCL_OK\fR after storing the count and array pointer.
.PP
\fBTcl_ListObjLength\fR returns the number of elements in the list value
\fBTcl_ListObjLength\fR returns the number of elements in the list object
referenced by \fIlistPtr\fR.
It returns this count by storing an integer in the address \fIintPtr\fR.
If the value is not already a list value,
If the object is not already a list object,
\fBTcl_ListObjLength\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result value
and leaves an error message in the interpreter's result object
if \fIinterp\fR is not NULL.
Otherwise it returns \fBTCL_OK\fR after storing the list's length.
.PP
The procedure \fBTcl_ListObjIndex\fR returns a pointer to the value
The procedure \fBTcl_ListObjIndex\fR returns a pointer to the object
at element \fIindex\fR in the list referenced by \fIlistPtr\fR.
It returns this value by storing a pointer to it
It returns this object by storing a pointer to it
in the address \fIobjPtrPtr\fR.
If \fIlistPtr\fR does not already refer to a list value,
If \fIlistPtr\fR does not already refer to a list object,
\fBTcl_ListObjIndex\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result value
and leaves an error message in the interpreter's result object
if \fIinterp\fR is not NULL.
If the index is out of range,
that is, \fIindex\fR is negative or
greater than or equal to the number of elements in the list,
\fBTcl_ListObjIndex\fR stores a NULL in \fIobjPtrPtr\fR
and returns \fBTCL_OK\fR.
Otherwise it returns \fBTCL_OK\fR after storing the element's
value pointer.
object pointer.
The reference count for the list element is not incremented;
the caller must do that if it needs to retain a pointer to the element.
.PP
\fBTcl_ListObjReplace\fR replaces zero or more elements
of the list referenced by \fIlistPtr\fR
with the \fIobjc\fR values in the array referenced by \fIobjv\fR.
If \fIlistPtr\fR does not point to a list value,
with the \fIobjc\fR objects in the array referenced by \fIobjv\fR.
If \fIlistPtr\fR does not point to a list object,
\fBTcl_ListObjReplace\fR will attempt to convert it to one;
if the conversion fails, it returns \fBTCL_ERROR\fR
and leaves an error message in the interpreter's result value
and leaves an error message in the interpreter's result object
if \fIinterp\fR is not NULL.
Otherwise, it returns \fBTCL_OK\fR after replacing the values.
Otherwise, it returns \fBTCL_OK\fR after replacing the objects.
If \fIobjv\fR is NULL, no new elements are added.
If the argument \fIfirst\fR is zero or negative,
it refers to the first element.
If \fIfirst\fR is greater than or equal to the
number of elements in the list, then no elements are deleted;
the new elements are appended to the list.
\fIcount\fR gives the number of elements to replace.
If \fIcount\fR is zero or negative then no elements are deleted;
the new elements are simply inserted before the one
designated by \fIfirst\fR.
\fBTcl_ListObjReplace\fR invalidates \fIlistPtr\fR's
old string representation.
The reference counts of any elements inserted from \fIobjv\fR
are incremented since the resulting list now refers to them.
Similarly, the reference counts for any replaced values are decremented.
Similarly, the reference counts for any replaced objects are decremented.
.PP
Because \fBTcl_ListObjReplace\fR combines
both element insertion and deletion,
it can be used to implement a number of list operations.
For example, the following code inserts the \fIobjc\fR values
referenced by the array of value pointers \fIobjv\fR
For example, the following code inserts the \fIobjc\fR objects
referenced by the array of object pointers \fIobjv\fR
just before the element \fIindex\fR of the list referenced by \fIlistPtr\fR:
.PP
.CS
result = \fBTcl_ListObjReplace\fR(interp, listPtr, index, 0,
result = Tcl_ListObjReplace(interp, listPtr, index, 0,
        objc, objv);
.CE
.PP
Similarly, the following code appends the \fIobjc\fR values
Similarly, the following code appends the \fIobjc\fR objects
referenced by the array \fIobjv\fR
to the end of the list \fIlistPtr\fR:
.PP
.CS
result = \fBTcl_ListObjLength\fR(interp, listPtr, &length);
result = Tcl_ListObjLength(interp, listPtr, &length);
if (result == TCL_OK) {
    result = \fBTcl_ListObjReplace\fR(interp, listPtr, length, 0,
    result = Tcl_ListObjReplace(interp, listPtr, length, 0,
            objc, objv);
}
.CE
.PP
The \fIcount\fR list elements starting at \fIfirst\fR can be deleted
by simply calling \fBTcl_ListObjReplace\fR
with a NULL \fIobjvPtr\fR:
.PP
.CS
result = \fBTcl_ListObjReplace\fR(interp, listPtr, first, count,
result = Tcl_ListObjReplace(interp, listPtr, first, count,
        0, NULL);
.CE
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3)
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount, Tcl_GetObjResult
.SH KEYWORDS
append, index, insert, internal representation, length, list, list value,
append, index, insert, internal representation, length, list, list object, list type, object, object type, replace, string representation
list type, value, value type, replace, string representation

Deleted doc/Load.3.

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






































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2009-2010 Kevin B. Kenny
'\" Copyright (c) 2010 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Load 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_LoadFile, Tcl_FindSymbol \- platform-independent dynamic library loading
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_LoadFile\fR(\fIinterp, pathPtr, symbols, flags, procPtrs, loadHandlePtr\fR)
.sp
void *
\fBTcl_FindSymbol\fR(\fIinterp, loadHandle, symbol\fR)
.SH ARGUMENTS
.AS Tcl_LoadHandle loadHandle in
.AP Tcl_Interp *interp in
Interpreter to use for reporting error messages.
.AP Tcl_Obj *pathPtr in
The name of the file to load. If it is a single name, the library search path
of the current environment will be used to resolve it.
.AP "const char *const" symbols[] in
Array of names of symbols to be resolved during the load of the library, or
NULL if no symbols are to be resolved. If an array is given, the last entry in
the array must be NULL.
.AP int flags in
The value should normally be 0, but \fITCL_LOAD_GLOBAL\fR or \fITCL_LOAD_LAZY\fR
or a combination of those two is allowed as well.
.AP void *procPtrs out
Points to an array that will hold the addresses of the functions described in
the \fIsymbols\fR argument. Should be NULL if no symbols are to be resolved.
.AP Tcl_LoadHandle *loadHandlePtr out
Points to a variable that will hold the handle to the abstract token
describing the library that has been loaded.
.AP Tcl_LoadHandle loadHandle in
Abstract token describing the library to look up a symbol in.
.AP "const char" *symbol in
The name of the symbol to look up.
.BE
.SH DESCRIPTION
.PP
\fBTcl_LoadFile\fR loads a file from the filesystem (including potentially any
virtual filesystem that has been installed) and provides a handle to it that
may be used in further operations. The \fIsymbols\fR array, if non-NULL,
supplies a set of names of symbols (typically functions) that must be resolved
from the library and which will be stored in the array indicated by
\fIprocPtrs\fR. If any of the symbols is not resolved, the loading of the file
will fail with an error message left in the interpreter (if that is non-NULL).
The result of \fBTcl_LoadFile\fR is a standard Tcl error code. The library may
be unloaded with \fBTcl_FSUnloadFile\fR.
.PP
\fBTcl_FindSymbol\fR locates a symbol in a loaded library and returns it. If
the symbol cannot be found, it returns NULL and sets an error message in the
given \fIinterp\fR (if that is non-NULL). Note that it is unsafe to use this
operation on a handle that has been passed to \fBTcl_FSUnloadFile\fR.
.SH "SEE ALSO"
Tcl_FSLoadFile(3), Tcl_FSUnloadFile(3), load(n), unload(n)
.SH KEYWORDS
binary code, loading, shared library
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/Method.3.

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













































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_Method 3 0.1 TclOO "TclOO Library Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
Tcl_Method
\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
              clientData\fR)
.sp
Tcl_Method
\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
                      clientData\fR)
.sp
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
.sp
\fBTcl_ClassSetDestructor\fR(\fIinterp, class, method\fR)
.sp
Tcl_Class
\fBTcl_MethodDeclarerClass\fR(\fImethod\fR)
.sp
Tcl_Object
\fBTcl_MethodDeclarerObject\fR(\fImethod\fR)
.sp
Tcl_Obj *
\fBTcl_MethodName\fR(\fImethod\fR)
.sp
.VS TIP500
int
\fBTcl_MethodIsPublic\fR(\fImethod\fR)
.VE TIP500
.sp
int
\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
.sp
int
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
.sp
int
\fBTcl_ObjectContextInvokeNext\fR(\fIinterp, context, objc, objv, skip\fR)
.sp
int
\fBTcl_ObjectContextIsFiltering\fR(\fIcontext\fR)
.sp
Tcl_Method
\fBTcl_ObjectContextMethod\fR(\fIcontext\fR)
.sp
Tcl_Object
\fBTcl_ObjectContextObject\fR(\fIcontext\fR)
.sp
int
\fBTcl_ObjectContextSkippedArgs\fR(\fIcontext\fR)
.SH ARGUMENTS
.AS void *clientData in
.AP Tcl_Interp *interp in/out
The interpreter holding the object or class to create or update a method in.
.AP Tcl_Object object in
The object to create the method in.
.AP Tcl_Class class in
The class to create the method in.
.AP Tcl_Obj *nameObj in
The name of the method to create. Should not be NULL unless creating
constructors or destructors.
.AP int flags in
A flag saying (currently) what the visibility of the method is. The supported
public values of this flag are \fBTCL_OO_METHOD_PUBLIC\fR (which is fixed at 1
for backward compatibility) for an exported method,
\fBTCL_OO_METHOD_UNEXPORTED\fR (which is fixed at 0 for backward
compatibility) for a non-exported method,
.VS TIP500
and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
.VE TIP500
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
.AP void *clientData in
A piece of data that is passed to the implementation of the method without
interpretation.
.AP void **clientDataPtr out
A pointer to a variable in which to write the \fIclientData\fR value supplied
when the method was created. If NULL, the \fIclientData\fR value will not be
retrieved.
.AP Tcl_Method method in
A reference to a method to query.
.AP Tcl_ObjectContext context in
A reference to a method-call context. Note that client code \fImust not\fR
retain a reference to a context.
.AP int objc in
The number of arguments to pass to the method implementation.
.AP "Tcl_Obj *const" *objv in
An array of arguments to pass to the method implementation.
.AP int skip in
The number of arguments passed to the method implementation that do not
represent "real" arguments.
.BE
.SH DESCRIPTION
.PP
A method is an operation carried out on an object that is associated with the
object. Every method must be attached to either an object or a class; methods
attached to a class are associated with all instances (direct and indirect) of
that class.
.PP
Given a method, the entity that declared it can be found using
\fBTcl_MethodDeclarerClass\fR which returns the class that the method is
attached to (or NULL if the method is not attached to any class) and
\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
attached to (or NULL if the method is not attached to an object). The name of
the method can be retrieved with \fBTcl_MethodName\fR, whether the method
is exported is retrieved with \fBTcl_MethodIsPublic\fR,
.VS TIP500
and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
.VE TIP500
The type of the method
can also be introspected upon to a limited degree; the function
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
assigning the per-method \fIclientData\fR to the variable pointed to by
\fIclientDataPtr\fR if (that is non-NULL) if the type is matched.
.SS "METHOD CREATION"
.PP
Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
which
create a method attached to a class or an object respectively. In both cases,
the \fInameObj\fR argument gives the name of the method to create, the
\fIflags\fR argument states whether the method should be exported
initially
.VS TIP500
or be marked as a private method,
.VE TIP500
the \fImethodTypePtr\fR argument describes the implementation of
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
argument gives some implementation-specific data that is passed on to the
implementation of the method when it is called.
.PP
When the \fInameObj\fR argument to \fBTcl_NewMethod\fR is NULL, an
unnamed method is created, which is used for constructors and destructors.
Constructors should be installed into their class using the
\fBTcl_ClassSetConstructor\fR function, and destructors (which must not
require any arguments) should be installed into their class using the
\fBTcl_ClassSetDestructor\fR function. Unnamed methods should not be used for
any other purpose, and named methods should not be used as either constructors
or destructors. Also note that a NULL \fImethodTypePtr\fR is used to provide
internal signaling, and should not be used in client code.
.SS "METHOD CALL CONTEXTS"
.PP
When a method is called, a method-call context reference is passed in as one
of the arguments to the implementation function. This context can be inspected
to provide information about the caller, but should not be retained beyond the
moment when the method call terminates.
.PP
The method that is being called can be retrieved from the context by using
\fBTcl_ObjectContextMethod\fR, and the object that caused the method to be
invoked can be retrieved with \fBTcl_ObjectContextObject\fR. The number of
arguments that are to be skipped (e.g. the object name and method name in a
normal method call) is read with \fBTcl_ObjectContextSkippedArgs\fR, and the
context can also report whether it is working as a filter for another method
through \fBTcl_ObjectContextIsFiltering\fR.
.PP
During the execution of a method, the method implementation may choose to
invoke the stages of the method call chain that come after the current method
implementation. This (the core of the \fBnext\fR command) is done using
\fBTcl_ObjectContextInvokeNext\fR. Note that this function does not manipulate
the call-frame stack, unlike the \fBnext\fR command; if the method
implementation has pushed one or more extra frames on the stack as part of its
implementation, it is also responsible for temporarily popping those frames
from the stack while the \fBTcl_ObjectContextInvokeNext\fR function is
executing. Note also that the method-call context is \fInever\fR deleted
during the execution of this function.
.SH "METHOD TYPES"
.PP
The types of methods are described by a pointer to a Tcl_MethodType structure,
which is defined as:
.PP
.CS
typedef struct {
    int \fIversion\fR;
    const char *\fIname\fR;
    Tcl_MethodCallProc *\fIcallProc\fR;
    Tcl_MethodDeleteProc *\fIdeleteProc\fR;
    Tcl_CloneProc *\fIcloneProc\fR;
} \fBTcl_MethodType\fR;
.CE
.PP
The \fIversion\fR field allows for future expansion of the structure, and
should always be declared equal to TCL_OO_METHOD_VERSION_CURRENT. The
\fIname\fR field provides a human-readable name for the type, and is the value
that is exposed via the \fBinfo class methodtype\fR and
\fBinfo object methodtype\fR Tcl commands.
.PP
The \fIcallProc\fR field gives a function that is called when the method is
invoked; it must never be NULL.
.PP
The \fIdeleteProc\fR field gives a function that is used to delete a
particular method, and is called when the method is replaced or removed; if
the field is NULL, it is assumed that the method's \fIclientData\fR needs no
special action to delete.
.PP
The \fIcloneProc\fR field is either a function that is used to copy a method's
\fIclientData\fR (as part of \fBTcl_CopyObjectInstance\fR) or NULL to indicate
that the \fIclientData\fR can just be copied directly.
.SS "TCL_METHODCALLPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are called when the method is invoked.
.PP
.CS
typedef int \fBTcl_MethodCallProc\fR(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        Tcl_ObjectContext \fIobjectContext\fR,
        int \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR);
.CE
.PP
The \fIclientData\fR argument to a Tcl_MethodCallProc is the value that was
given when the method was created, the \fIinterp\fR is a place in which to
execute scripts and access variables as well as being where to put the result
of the method, and the \fIobjc\fR and \fIobjv\fR fields give the parameter
objects to the method. The calling context of the method can be discovered
through the \fIobjectContext\fR argument, and the return value from a
Tcl_MethodCallProc is any Tcl return code (e.g. TCL_OK, TCL_ERROR).
.SS "TCL_METHODDELETEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used when a method is deleted, whether
through a new method being created or because the object or class is deleted.
.PP
.CS
typedef void \fBTcl_MethodDeleteProc\fR(
        void *\fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument to a Tcl_MethodDeleteProc will be the same as
the value passed to the \fIclientData\fR argument to \fBTcl_NewMethod\fR or
\fBTcl_NewInstanceMethod\fR when the method was created.
.SS "TCL_CLONEPROC FUNCTION SIGNATURE"
.PP
Functions matching this signature are used to copy a method when the object or
class is copied using \fBTcl_CopyObjectInstance\fR (or \fBoo::copy\fR).
.PP
.CS
typedef int \fBTcl_CloneProc\fR(
        Tcl_Interp *\fIinterp\fR,
        void *\fIoldClientData\fR,
        void **\fInewClientDataPtr\fR);
.CE
.PP
The \fIinterp\fR argument gives a place to write an error message when the
attempt to clone the object is to fail, in which case the clone procedure must
also return TCL_ERROR; it should return TCL_OK otherwise.
The \fIoldClientData\fR field to a Tcl_CloneProc gives the value from the
method being copied from, and the \fInewClientDataPtr\fR field will point to
a variable in which to write the value for the method being copied to.
.SH "SEE ALSO"
Class(3), oo::class(n), oo::define(n), oo::object(n)
.SH KEYWORDS
constructor, method, object

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

Deleted doc/NRE.3.

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












































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
.\" Copyright (c) 2018 by Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH NRE 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NRCreateCommand, Tcl_NRCallObjProc, Tcl_NREvalObj, Tcl_NREvalObjv, Tcl_NRCmdSwap, Tcl_NRExprObj, Tcl_NRAddCallback \- Non-Recursive (stackless) evaluation of Tcl scripts.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Command
\fBTcl_NRCreateCommand\fR(\fIinterp, cmdName, proc, nreProc, clientData,
                    deleteProc\fR)
.sp
int
\fBTcl_NRCallObjProc\fR(\fIinterp, nreProc, clientData, objc, objv\fR)
.sp
int
\fBTcl_NREvalObj\fR(\fIinterp, objPtr, flags\fR)
.sp
int
\fBTcl_NREvalObjv\fR(\fIinterp, objc, objv, flags\fR)
.sp
int
\fBTcl_NRCmdSwap\fR(\fIinterp, cmd, objc, objv, flags\fR)
.sp
int
\fBTcl_NRExprObj\fR(\fIinterp, objPtr, resultPtr\fR)
.sp
void
\fBTcl_NRAddCallback\fR(\fIinterp, postProcPtr, data0, data1, data2, data3\fR)
.fi
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *interp in
.AP Tcl_Interp *interp in
The relevant Interpreter.
.AP char *cmdName in
Name of the command to create.
.AP Tcl_ObjCmdProc *proc in
Called in order to evaluate a command.  Is often just a small wrapper that uses
\fBTcl_NRCallObjProc\fR to call \fInreProc\fR using a new trampoline.  Behaves
in the same way as the \fIproc\fR argument to \fBTcl_CreateObjCommand\fR(3)
(\fIq.v.\fR).
.AP Tcl_ObjCmdProc *nreProc in
Called instead of \fIproc\fR when a trampoline is already in use.
.AP void *clientData in
Arbitrary one-word value passed to \fIproc\fR, \fInreProc\fR, \fIdeleteProc\fR
and \fIobjProc\fR.
.AP Tcl_CmdDeleteProc *deleteProc in/out
Called before \fIcmdName\fR is deleted from the interpreter, allowing for
command-specific cleanup. May be NULL.
.AP int objc in
Number of items in \fIobjv\fR.
.AP Tcl_Obj **objv in
Words in the command.
.AP Tcl_Obj *objPtr in
A script or expression to evaluate.
.AP int flags in
As described for \fITcl_EvalObjv\fR.
.PP
.AP Tcl_Command cmd in
Token to use instead of one derived from the first word of \fIobjv\fR in order
to evaluate a command.
.AP Tcl_Obj *resultPtr out
Pointer to an unshared Tcl_Obj where the result of the evaluation is stored if
the return code is TCL_OK.
.AP Tcl_NRPostProc *postProcPtr in
A function to push.
.AP void *data0 in
.AP void *data1 in
.AP void *data2 in
.AP void *data3 in
\fIdata0\fR through \fIdata3\fR are four one-word values that will be passed
to the function designated by \fIpostProcPtr\fR when it is invoked.
.BE
.SH DESCRIPTION
.PP
These functions provide an interface to the function stack that an interpreter
iterates through to evaluate commands.  The routine behind a command is
implemented by an initial function and any additional functions that the
routine pushes onto the stack as it progresses.  The interpreter itself pushes
functions onto the stack to react to the end of a routine and to exercise other
forms of control such as switching between in-progress stacks and the
evaluation of other scripts at additional levels without adding frames to the C
stack.  To execute a routine, the initial function for the routine is called
and then a small bit of code called a \fItrampoline\fR iteratively takes
functions off the stack and calls them, using the value of the last call as the
value of the routine.
.PP
\fBTcl_NRCallObjProc\fR calls \fInreProc\fR using a new trampoline.
.PP
\fBTcl_NRCreateCommand\fR, an alternative to \fBTcl_CreateObjCommand\fR,
resolves \fIcmdName\fR, which may contain namespace qualifiers, relative to the
current namespace, creates a command by that name, and returns a token for the
command which may be used in subsequent calls to \fBTcl_GetCommandName\fR.
Except for a few cases noted below any existing command by the same name is
first deleted.  If \fIinterp\fR is in the process of being deleted
\fBTcl_NRCreateCommand\fR does not create any command, does not delete any
command, and returns NULL.
.PP
\fBTcl_NREvalObj\fR pushes a function that is like \fBTcl_EvalObjEx\fR but
consumes no space on the C stack.
.PP
\fBTcl_NREvalObjv\fR pushes a function that is like \fBTcl_EvalObjv\fR but
consumes no space on the C stack.
.PP
\fBTcl_NRCmdSwap\fR is like \fBTcl_NREvalObjv\fR, but uses \fIcmd\fR, a token
previously returned by \fBTcl_CreateObjCommand\fR or
\fBTcl_GetCommandFromObj\fR, instead of resolving the first word of \fIobjv\fR.
.  The name of this command must be the same as \fIobjv[0]\fR.
.PP
\fBTcl_NRExprObj\fR pushes a function that evaluates \fIobjPtr\fR as an
expression in the same manner as \fBTcl_ExprObj\fR but without consuming space
on the C stack.
.PP
All of the functions return \fBTCL_OK\fR if the evaluation of the script,
command, or expression has been scheduled successfully.  Otherwise (for example
if the command name cannot be resolved), they return \fBTCL_ERROR\fR and store
a message as the interpreter's result.
.PP
\fBTcl_NRAddCallback\fR pushes \fIpostProcPtr\fR.  The signature for
\fBTcl_NRPostProc\fR is:
.PP
.CS
typedef int
\fBTcl_NRPostProc\fR(
        \fBvoid *\fR \fIdata\fR[],
        \fBTcl_Interp\fR *\fIinterp\fR,
        int \fIresult\fR);
.CE
.PP
\fIdata\fR is a pointer to an array containing \fIdata0\fR through \fIdata3\fR.
\fIresult\fR is the value returned by the previous function implementing part
the routine.
.SH EXAMPLE
.PP
The following command uses \fBTcl_EvalObjEx\fR, which consumes space on the C
stack, to evalute a script:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;

    \fI... preparation ...\fR

    result = \fBTcl_EvalObjEx\fR(interp, objPtr, 0);

    \fI... postprocessing ...\fR

    return result;
}
\fBTcl_CreateObjCommand\fR(interp, "theCommand",
        \fITheCmdOldObjProc\fR, clientData, TheCmdDeleteProc);
.CE
.PP
To avoid consuming space on the C stack, \fITheCmdOldObjProc\fR is renamed to
\fITheCmdNRObjProc\fR and the postprocessing step is split into a separate
function, \fITheCmdPostProc\fR, which is pushed onto the function stack.
\fITcl_EvalObjEx\fR is replaced with \fITcl_NREvalObj\fR, which uses a
trampoline instead of consuming space on the C stack.  A new version of
\fITheCmdOldObjProc\fR is just a a wrapper that uses \fBTcl_NRCallObjProc\fR to
call \fITheCmdNRObjProc\fR:
.PP
.CS
int
\fITheCmdOldObjProc\fR(
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return \fBTcl_NRCallObjProc\fR(interp, \fITheCmdNRObjProc\fR,
            clientData, objc, objv);
}
.CE
.PP
.CS
int
\fITheCmdNRObjProc\fR
    void *clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *objPtr;

    \fI... preparation ...\fR

    \fBTcl_NRAddCallback\fR(interp, \fITheCmdPostProc\fR,
            data0, data1, data2, data3);
    /* \fIdata0 .. data3\fR are up to four one-word items to
     * pass to the postprocessing procedure */

    return \fBTcl_NREvalObj\fR(interp, objPtr, 0);
}
.CE
.PP
.CS
int
\fITheCmdNRPostProc\fR(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    /* \fIdata[0] .. data[3]\fR are the four words of data
     * passed to \fBTcl_NRAddCallback\fR */

    \fI... postprocessing ...\fR

    return result;
}
.CE
.PP
Any function comprising a routine can push other functions, making it possible
implement looping and sequencing constructs using the function stack.
.PP
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_CreateObjCommand(3), Tcl_EvalObjEx(3), Tcl_GetCommandFromObj(3), Tcl_ExprObj(3)
.SH KEYWORDS
stackless, nonrecursive, execute, command, global, value, result, script
.SH COPYRIGHT
Copyright (c) 2008 by Kevin B. Kenny.
Copyright (c) 2018 by Nathan Coulter.

Changes to doc/Namespace.3.

1
2
3
4
5
6

7
8
9

10
11
12
13
14
15
16
1
2
3
4
5

6
7
8

9
10
11
12
13
14
15
16





-
+


-
+







'\"
'\" Copyright (c) 2003 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
'\" Note that some of these functions do not seem to belong, but they
'\" were all introduced with the same TIP (#139)
'\"
'\" 
.TH Tcl_Namespace 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_AppendExportList, Tcl_CreateNamespace, Tcl_DeleteNamespace, Tcl_Export, Tcl_FindCommand, Tcl_FindNamespace, Tcl_ForgetImport, Tcl_GetCurrentNamespace, Tcl_GetGlobalNamespace, Tcl_GetNamespaceUnknownHandler, Tcl_Import, Tcl_SetNamespaceUnknownHandler \- manipulate namespaces
.SH SYNOPSIS
.nf
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
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







-
+









-
+







.SH ARGUMENTS
.AS Tcl_NamespaceDeleteProc allowOverwrite in/out
.AP Tcl_Interp *interp in/out
The interpreter in which the namespace exists and where name lookups
are performed. Also where error result messages are written.
.AP "const char" *name in
The name of the namespace or command to be created or accessed.
.AP void *clientData in
.AP ClientData clientData in
A context pointer by the creator of the namespace.  Not interpreted by
Tcl at all.
.AP Tcl_NamespaceDeleteProc *deleteProc in
A pointer to function to call when the namespace is deleted, or NULL
if no such callback is to be performed.
.AP Tcl_Namespace *nsPtr in
The namespace to be manipulated, or NULL (for other than
\fBTcl_DeleteNamespace\fR) to manipulate the current namespace.
.AP Tcl_Obj *objPtr out
A reference to an unshared value to which the function output will be
A reference to an unshared object to which the function output will be
written.
.AP "const char" *pattern in
The glob-style pattern (see \fBTcl_StringMatch\fR) that describes the
commands to be imported or exported.
.AP int resetListFirst in
Whether the list of export patterns should be reset before adding the
current pattern to it.
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
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







+



















-

-
+
-


-
+
-







indicates that the search is always to be conducted relative to the
context namespace), and \fBTCL_LEAVE_ERR_MSG\fR (indicates that an error
message should be left in the interpreter if the search fails.)
.AP Tcl_Obj *handlerPtr in
A script fragment to be installed as the unknown command handler for the
namespace, or NULL to reset the handler to its default.
.BE

.SH DESCRIPTION
.PP
Namespaces are hierarchic naming contexts that can contain commands
and variables.  They also maintain a list of patterns that describes
what commands are exported, and can import commands that have been
exported by other namespaces.  Namespaces can also be manipulated
through the Tcl command \fBnamespace\fR.
.PP
The \fITcl_Namespace\fR structure encapsulates a namespace, and is
guaranteed to have the following fields in it: \fIname\fR (the local
name of the namespace, with no namespace separator characters in it,
with empty denoting the global namespace), \fIfullName\fR (the fully
specified name of the namespace), \fIclientData\fR, \fIdeleteProc\fR
(the values specified in the call to \fBTcl_CreateNamespace\fR), and
\fIparentPtr\fR (a pointer to the containing namespace, or NULL for
the global namespace.)
.PP
\fBTcl_CreateNamespace\fR creates a new namespace.  The
\fIdeleteProc\fR will have the following type signature:
.PP
.CS
typedef void \fBTcl_NamespaceDeleteProc\fR(
typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
        void *\fIclientData\fR);
.CE
.PP
\fBTcl_DeleteNamespace\fR deletes a namespace, calling the
\fBTcl_DeleteNamespace\fR deletes a namespace.
\fIdeleteProc\fR defined for the namespace (if any).
.PP
\fBTcl_AppendExportList\fR retrieves the export patterns for a
namespace given namespace and appends them (as list items) to
\fIobjPtr\fR.
.PP
\fBTcl_Export\fR sets and appends to the export patterns for a
namespace.  Patterns are appended unless the \fIresetListFirst\fR flag
155
156
157
158
159
160
161

162
163


164
165
153
154
155
156
157
158
159
160
161

162
163
164
165







+

-
+
+


.PP
\fBTcl_GetNamespaceUnknownHandler\fR returns the unknown command handler
for the namespace, or NULL if none is set.
.PP
\fBTcl_SetNamespaceUnknownHandler\fR sets the unknown command handler for
the namespace. If \fIhandlerPtr\fR is NULL, then the handler is reset to
its default.

.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_ListObjAppendList(3), Tcl_SetVar(3)
Tcl_CreateCommand, Tcl_ListObjAppendElements, Tcl_SetVar

.SH KEYWORDS
namespace, command

Changes to doc/Notifier.3.

1
2
3
4
5
6
7

8
9
10
11
12

13
14
15
16
17
18
19
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.
'\"
'\" 
.TH Notifier 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.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
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
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48







-
+







.sp
Tcl_ThreadId
\fBTcl_GetCurrentThread\fR()
.sp
void
\fBTcl_DeleteEvents\fR(\fIdeleteProc, clientData\fR)
.sp
void *
ClientData
\fBTcl_InitNotifier\fR()
.sp
void
\fBTcl_FinalizeNotifier\fR(\fIclientData\fR)
.sp
int
\fBTcl_WaitForEvent\fR(\fItimePtr\fR)
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
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







-
+


-
+







-
+


















+







.AS Tcl_EventDeleteProc *notifierProcPtr
.AP Tcl_EventSetupProc *setupProc in
Procedure to invoke to prepare for event wait in \fBTcl_DoOneEvent\fR.
.AP Tcl_EventCheckProc *checkProc in
Procedure for \fBTcl_DoOneEvent\fR to invoke after waiting for
events.  Checks to see if any events have occurred and, if so,
queues them.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIsetupProc\fR, \fIcheckProc\fR, or
\fIdeleteProc\fR.
.AP "const Tcl_Time" *timePtr in
.AP Tcl_Time *timePtr in
Indicates the maximum amount of time to wait for an event.  This
is specified as an interval (how long to wait), not an absolute
time (when to wakeup).  If the pointer passed to \fBTcl_WaitForEvent\fR
is NULL, it means there is no maximum wait time:  wait forever if
necessary.
.AP Tcl_Event *evPtr in
An event to add to the event queue.  The storage for the event must
have been allocated by the caller using \fBTcl_Alloc\fR.
have been allocated by the caller using \fBTcl_Alloc\fR or \fBckalloc\fR.
.AP Tcl_QueuePosition position in
Where to add the new event in the queue:  \fBTCL_QUEUE_TAIL\fR,
\fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR.
.AP Tcl_ThreadId threadId in
A unique identifier for a thread.
.AP Tcl_EventDeleteProc *deleteProc in
Procedure to invoke for each queued event in \fBTcl_DeleteEvents\fR.
.AP int flags in
What types of events to service.  These flags are the same as those
passed to \fBTcl_DoOneEvent\fR.
.AP int mode in
Indicates whether events should be serviced by \fBTcl_ServiceAll\fR.
Must be one of \fBTCL_SERVICE_NONE\fR or \fBTCL_SERVICE_ALL\fR.
.AP Tcl_NotifierProcs* notifierProcPtr in
Structure of function pointers describing notifier procedures that are
to replace the ones installed in the executable.  See
\fBREPLACING THE NOTIFIER\fR for details.
.BE

.SH INTRODUCTION
.PP
The interfaces described here are used to customize the Tcl event
loop.  The two most common customizations are to add new sources of
events and to merge Tcl's event loop with some other event loop, such
as one provided by an application in which Tcl is embedded.  Each of
these tasks is described in a separate section below.
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
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







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

-
+

-
+
+
+







source must work with the notifier to detect events at the right
times, record them on the event queue, and eventually notify
higher-level software that they have occurred.  The procedures
\fBTcl_CreateEventSource\fR, \fBTcl_DeleteEventSource\fR,
and \fBTcl_SetMaxBlockTime\fR, \fBTcl_QueueEvent\fR, and
\fBTcl_DeleteEvents\fR are used primarily by event sources.
.IP [2]
The event queue: for non-threaded applications,
The event queue: there is a single queue for each thread containing
a Tcl interpreter, containing events that have been detected but not
yet serviced.  Event sources place events onto the queue so that they
may be processed in order at appropriate times during the event loop.
The event queue guarantees a fair discipline of event handling, so that
no event source can starve the others.  It also allows events to be
saved for servicing at a future time.
there is a single queue for the whole application,
containing events that have been detected but not yet serviced.  Event
sources place events onto the queue so that they may be processed in
order at appropriate times during the event loop. The event queue
guarantees a fair discipline of event handling, so that no event
source can starve the others.  It also allows events to be saved for
servicing at a future time.  Threaded applications work in a
similar manner, except that there is a separate event queue for
each thread containing a Tcl interpreter.
\fBTcl_QueueEvent\fR is used (primarily
by event sources) to add events to the current thread's event queue and
by event sources) to add events to the event queue and 
\fBTcl_DeleteEvents\fR is used to remove events from the queue without
processing them.
processing them.  In a threaded application, \fBTcl_QueueEvent\fR adds
an event to the current thread's queue, and \fBTcl_ThreadQueueEvent\fR
adds an event to a queue in a specific thread.
.IP [3]
The event loop: in order to detect and process events, the application
enters a loop that waits for events to occur, places them on the event
queue, and then processes them.  Most applications will do this by
calling the procedure \fBTcl_DoOneEvent\fR, which is described in a
separate manual entry.
.PP
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
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







+













-

-
-
+
+


-







from the queue, and return.
.IP [6]
See if there are idle callbacks pending. If so, invoke all of them and
return.
.IP [7]
Either return 0 to indicate that no events were ready, or go back to
step [2] if blocking was requested by the caller.

.SH "CREATING A NEW EVENT SOURCE"
.PP
An event source consists of three procedures invoked by the notifier,
plus additional C procedures that are invoked by higher-level code
to arrange for event-driven callbacks.  The three procedures called
by the notifier consist of the setup and check procedures described
above, plus an additional procedure that is invoked when an event
is removed from the event queue for servicing.
.PP
The procedure \fBTcl_CreateEventSource\fR creates a new event source.
Its arguments specify the setup procedure and check procedure for
the event source.
\fISetupProc\fR should match the following prototype:
.PP
.CS
typedef void \fBTcl_EventSetupProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_EventSetupProc(
        ClientData \fIclientData\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_CreateEventSource\fR;  it is typically used to
point to private information managed by the event source.
The \fIflags\fR argument will be the same as the \fIflags\fR
argument passed to \fBTcl_DoOneEvent\fR except that it will never
be 0 (\fBTcl_DoOneEvent\fR replaces 0 with \fBTCL_ALL_EVENTS\fR).
\fIFlags\fR indicates what kinds of events should be considered;
259
260
261
262
263
264
265
266
267
268
269
270
271



272
273
274
275
276
277
278
279
280
264
265
266
267
268
269
270

271
272



273
274
275
276

277
278
279
280
281
282
283







-


-
-
-
+
+
+

-







events already queued.  If there are, it calls
\fBTcl_SetMaxBlockTime\fR with a 0 block time so that
\fBTcl_WaitForEvent\fR does not block if there is no new data on the X
connection.
The \fItimePtr\fR argument to \fBTcl_WaitForEvent\fR points to
a structure that describes a time interval in seconds and
microseconds:
.PP
.CS
typedef struct Tcl_Time {
    long \fIsec\fR;
    long \fIusec\fR;
} \fBTcl_Time\fR;
        long \fIsec\fR;
        long \fIusec\fR;
} Tcl_Time;
.CE
.PP
The \fIusec\fR field should be less than 1000000.
.PP
Information provided to \fBTcl_SetMaxBlockTime\fR
is only used for the next call to \fBTcl_WaitForEvent\fR; it is
discarded after \fBTcl_WaitForEvent\fR returns.
The next time an event wait is done each of the event sources'
setup procedures will be called again, and they can specify new
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
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







-

-
-
+
+


-


















-




-
+

-







\fBTcl_WaitForEvent\fR on that platform.  For example, on Unix systems
the \fBTcl_CreateFileHandler\fR interface can be used to wait for file events.
.PP
The second procedure provided by each event source is its check
procedure, indicated by the \fIcheckProc\fR argument to
\fBTcl_CreateEventSource\fR.  \fICheckProc\fR must match the
following prototype:
.PP
.CS
typedef void \fBTcl_EventCheckProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_EventCheckProc(
        ClientData \fIclientData\fR,
        int \fIflags\fR);
.CE
.PP
The arguments to this procedure are the same as those for \fIsetupProc\fR.
\fBCheckProc\fR is invoked by \fBTcl_DoOneEvent\fR after it has waited
for events.  Presumably at least one event source is now prepared to
queue an event.  \fBTcl_DoOneEvent\fR calls each of the event sources
in turn, so they all have a chance to queue any events that are ready.
The check procedure does two things.  First, it must see if any events
have triggered.  Different event sources do this in different ways.
.PP
If an event source's check procedure detects an interesting event, it
must add the event to Tcl's event queue.  To do this, the event source
calls \fBTcl_QueueEvent\fR.  The \fIevPtr\fR argument is a pointer to
a dynamically allocated structure containing the event (see below for
more information on memory management issues).  Each event source can
define its own event structure with whatever information is relevant
to that event source.  However, the first element of the structure
must be a structure of type \fBTcl_Event\fR, and the address of this
structure is used when communicating between the event source and the
rest of the notifier.  A \fBTcl_Event\fR has the following definition:
.PP
.CS
typedef struct {
    Tcl_EventProc *\fIproc\fR;
    struct Tcl_Event *\fInextPtr\fR;
} \fBTcl_Event\fR;
} Tcl_Event;
.CE
.PP
The event source must fill in the \fIproc\fR field of
the event before calling \fBTcl_QueueEvent\fR.
The \fInextPtr\fR is used to link together the events in the queue
and should not be modified by the event source.
.PP
An event may be added to the queue at any of three positions, depending
on the \fIposition\fR argument to \fBTcl_QueueEvent\fR:
356
357
358
359
360
361
362
363
364
365

366
367
368
369
370
371
372
373
374
375
376
355
356
357
358
359
360
361

362

363
364
365
366

367
368
369
370
371
372
373







-

-
+



-







Enter and Leave events synthesized during a grab or ungrab operation
in Tk.
.PP
When it is time to handle an event from the queue (steps 1 and 4
above) \fBTcl_ServiceEvent\fR will invoke the \fIproc\fR specified
in the first queued \fBTcl_Event\fR structure.
\fIProc\fR must match the following prototype:
.PP
.CS
typedef int \fBTcl_EventProc\fR(
typedef int Tcl_EventProc(
        Tcl_Event *\fIevPtr\fR,
        int \fIflags\fR);
.CE
.PP
The first argument to \fIproc\fR is a pointer to the event, which will
be the same as the first argument to the \fBTcl_QueueEvent\fR call that
added the event to the queue.
The second argument to \fIproc\fR is the \fIflags\fR argument for the
current call to \fBTcl_ServiceEvent\fR;  this is used by the event source
to return immediately if its events are not relevant.
.PP
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
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







-
+



+
+
+
+
-
+



-
+












-

-
+

-
+

-









+







Another example of deferring events happens in Tk if
\fBTk_RestrictEvents\fR has been invoked to defer certain kinds
of window events.
.PP
When \fIproc\fR returns 1, \fBTcl_ServiceEvent\fR will remove the
event from the event queue and free its storage.
Note that the storage for an event must be allocated by
the event source (using \fBTcl_Alloc\fR)
the event source (using \fBTcl_Alloc\fR or the Tcl macro \fBckalloc\fR)
before calling \fBTcl_QueueEvent\fR, but it
will be freed by \fBTcl_ServiceEvent\fR, not by the event source.
.PP
Threaded applications work in a
similar manner, except that there is a separate event queue for
each thread containing a Tcl interpreter.
Calling \fBTcl_QueueEvent\fR in a multithreaded application adds
Calling \fBTcl_QueueEvent\fR adds an event to the current thread's queue.
an event to the current thread's queue.
To add an event to another thread's queue, use \fBTcl_ThreadQueueEvent\fR.
\fBTcl_ThreadQueueEvent\fR accepts as an argument a Tcl_ThreadId argument,
which uniquely identifies a thread in a Tcl application.  To obtain the
Tcl_ThreadId for the current thread, use the \fBTcl_GetCurrentThread\fR
Tcl_ThreadID for the current thread, use the \fBTcl_GetCurrentThread\fR
procedure.  (A thread would then need to pass this identifier to other
threads for those threads to be able to add events to its queue.)
After adding an event to another thread's queue, you then typically
need to call \fBTcl_ThreadAlert\fR to
.QW "wake up"
that thread's notifier to alert it to the new event.
.PP
\fBTcl_DeleteEvents\fR can be used to explicitly remove one or more
events from the event queue.  \fBTcl_DeleteEvents\fR calls \fIproc\fR
for each event in the queue, deleting those for with the procedure
returns 1.  Events for which the procedure returns 0 are left in the
queue.  \fIProc\fR should match the following prototype:
.PP
.CS
typedef int \fBTcl_EventDeleteProc\fR(
typedef int Tcl_EventDeleteProc(
        Tcl_Event *\fIevPtr\fR,
        void *\fIclientData\fR);
        ClientData \fIclientData\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_DeleteEvents\fR; it is typically used to point to
private information managed by the event source.  The \fIevPtr\fR will
point to the next event in the queue.
.PP
\fBTcl_DeleteEventSource\fR deletes an event source.  The \fIsetupProc\fR,
\fIcheckProc\fR, and \fIclientData\fR arguments must exactly match those
provided to the \fBTcl_CreateEventSource\fR for the event source to be deleted.
If no such source exists, \fBTcl_DeleteEventSource\fR has no effect.

.SH "CREATING A NEW NOTIFIER"
.PP
The notifier consists of all the procedures described in this manual
entry, plus \fBTcl_DoOneEvent\fR and \fBTcl_Sleep\fR, which are
available on all platforms, and \fBTcl_CreateFileHandler\fR and
\fBTcl_DeleteFileHandler\fR, which are Unix-specific.  Most of these
procedures are generic, in that they are the same for all notifiers.
485
486
487
488
489
490
491
492


493
494
495
496
497
498
499
485
486
487
488
489
490
491

492
493
494
495
496
497
498
499
500







-
+
+







elapsed).  Finally, a return value of \-1 means that the event loop is
no longer operational and the application should probably unwind and
terminate.  Under Windows this happens when a WM_QUIT message is received;
under Unix it happens when \fBTcl_WaitForEvent\fR would have waited
forever because there were no active event sources and the timeout was
infinite.
.PP
\fBTcl_AlertNotifier\fR is used to allow any thread to
\fBTcl_AlertNotifier\fR is used in multithreaded applications to allow
any thread to
.QW "wake up"
the notifier to alert it to new events on its
queue.  \fBTcl_AlertNotifier\fR requires as an argument the notifier
handle returned by \fBTcl_InitNotifier\fR.
.PP
If the notifier will be used with an external event loop, then it must
also support the \fBTcl_SetTimer\fR interface.  \fBTcl_SetTimer\fR is
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
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







+












-


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

-







+







.PP
The \fBTcl_Sleep\fR and \fBTcl_DoOneEvent\fR interfaces are described
in their respective manual pages.
.PP
The easiest way to create a new notifier is to look at the code
for an existing notifier, such as the files \fBunix/tclUnixNotfy.c\fR
or \fBwin/tclWinNotify.c\fR in the Tcl source distribution.

.SH "REPLACING THE NOTIFIER"
.PP
A notifier that has been written according to the conventions above
can also be installed in a running process in place of the standard
notifier.  This mechanism is used so that a single executable can be
used (with the standard notifier) as a stand-alone program and reused
(with a replacement notifier in a loadable extension) as an extension
to another program, such as a Web browser plugin.
.PP
To do this, the extension makes a call to \fBTcl_SetNotifier\fR
passing a pointer to a \fBTcl_NotifierProcs\fR data structure.  The
structure has the following layout:
.PP
.CS
typedef struct Tcl_NotifierProcs {
    Tcl_SetTimerProc *\fIsetTimerProc\fR;
    Tcl_WaitForEventProc *\fIwaitForEventProc\fR;
    Tcl_CreateFileHandlerProc *\fIcreateFileHandlerProc\fR;
    Tcl_DeleteFileHandlerProc *\fIdeleteFileHandlerProc\fR;
    Tcl_InitNotifierProc *\fIinitNotifierProc\fR;
    Tcl_FinalizeNotifierProc *\fIfinalizeNotifierProc\fR;
    Tcl_AlertNotifierProc *\fIalertNotifierProc\fR;
    Tcl_ServiceModeHookProc *\fIserviceModeHookProc\fR;
} \fBTcl_NotifierProcs\fR;
    Tcl_SetTimerProc *setTimerProc;
    Tcl_WaitForEventProc *waitForEventProc;
    Tcl_CreateFileHandlerProc *createFileHandlerProc;
    Tcl_DeleteFileHandlerProc *deleteFileHandlerProc;
    Tcl_InitNotifierProc *initNotifierProc;
    Tcl_FinalizeNotifierProc *finalizeNotifierProc;
    Tcl_AlertNotifierProc *alertNotifierProc;
    Tcl_ServiceModeHookProc *serviceModeHookProc;
} Tcl_NotifierProcs;
.CE
.PP
Following the call to \fBTcl_SetNotifier\fR, the pointers given in
the \fBTcl_NotifierProcs\fR structure replace whatever notifier had
been installed in the process.
.PP
It is extraordinarily unwise to replace a running notifier. Normally,
\fBTcl_SetNotifier\fR should be called at process initialization time
before the first call to \fBTcl_InitNotifier\fR.

.SH "EXTERNAL EVENT LOOPS"
.PP
The notifier interfaces are designed so that Tcl can be embedded into
applications that have their own private event loops.  In this case,
the application does not call \fBTcl_DoOneEvent\fR except in the case
of recursive event loops such as calls to the Tcl commands \fBupdate\fR
or \fBvwait\fR.  Most of the time is spent in the external event loop
614
615
616
617
618
619
620

621
622
623


624
625
615
616
617
618
619
620
621
622
623


624
625
626
627







+

-
-
+
+


to \fBTcl_ServiceAll\fR will return immediately without processing any
events.  If \fBTcl_SetServiceMode\fR is passed \fBTCL_SERVICE_ALL\fR,
then calls to \fBTcl_ServiceAll\fR will behave normally.
\fBTcl_SetServiceMode\fR returns the previous value of the service
mode, which should be restored when the recursive loop exits.
\fBTcl_GetServiceMode\fR returns the current value of the service
mode.

.SH "SEE ALSO"
Tcl_CreateFileHandler(3), Tcl_DeleteFileHandler(3), Tcl_Sleep(3),
Tcl_DoOneEvent(3), Thread(3)
\fBTcl_CreateFileHandler\fR, \fBTcl_DeleteFileHandler\fR, \fBTcl_Sleep\fR,
\fBTcl_DoOneEvent\fR, \fBThread(3)\fR
.SH KEYWORDS
event, notifier, event queue, event sources, file events, timer, idle, service mode, threads

Deleted doc/OOInitStubs.3.

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






















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 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.
'\"
.TH Tcl_OOInitStubs 3 1.0 TclOO "TclOO Library Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_OOInitStubs \- initialize library access to TclOO functionality
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
const char *
\fBTcl_OOInitStubs\fR(\fIinterp\fR)
.fi
.SH ARGUMENTS
.AS Tcl_Interp *interp in
.AP Tcl_Interp *interp in
The Tcl interpreter that the TclOO API is integrated with and whose C
interface is going to be used.
.BE
.SH DESCRIPTION
.PP
When an extension library is going to use the C interface exposed by TclOO, it
should use \fBTcl_OOInitStubs\fR to initialize its access to that interface
from within its \fI*\fB_Init\fR (or \fI*\fB_SafeInit\fR) function, passing in
the \fIinterp\fR that was passed into that routine as context. If the result
of calling \fBTcl_OOInitStubs\fR is NULL, the initialization failed and an
error message will have been left in the interpreter's result. Otherwise, the
initialization succeeded and the TclOO API may thereafter be used; the
version of the TclOO API is returned.
.PP
When using this function, either the C #define symbol \fBUSE_TCLOO_STUBS\fR
should be defined and your library code linked against the Tcl stub library,
or that #define symbol should \fInot\fR be defined and your library code
linked against the Tcl main library directly.
.SH "BACKWARD COMPATIBILITY NOTE"
.PP
If you are linking against the Tcl 8.5 forward compatibility package for
TclOO, \fIonly\fR the stub-enabled configuration is supported and you should
also link against the TclOO independent stub library; that library is an
integrated part of the main Tcl stub library in Tcl 8.6.
.SH KEYWORDS
stubs
.SH "SEE ALSO"
Tcl_InitStubs(3)
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/Object.3.

1
2
3
4
5
6
7
8
9
10
11

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

11
12
13
14
15
16
17
18










-
+







'\"
'\" Copyright (c) 1996-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.
'\"
.TH Tcl_Obj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values
Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl objects
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewObj\fR()
.sp
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

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







-
+


+


-
+
-
-
-
-
+
+
+

-
+




-
+




-
+

-
+

-
-
+
+


-
+














-
+


-
-
+
+






-
+

-
+

-
+






-
+

-
-
+
+






-
+

-


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

-

-
+









-
+



-
+






-
+


-
+




-
-
+
+



-
+









-
-
+
+

-
+

-
+


-
+

-
+

-
+

-
+












-
+



-
+


-
-
-
+
+
+


-
-
+
+


-
+

-
+

-
-
+
+


-
-
+
+

-
+

-



-
-
+

-
+
-



-


-



-
-
+

-
-
-
+
+
+

-
+


-
+




-



-
-
+



-
+

-
+

-
+

-
+


-
+


-
-
+
+

-
+


-
-
-
+
+
+







-
+


-
-
-
+
+
+



-
+

-
-
+
+

-
+

-
+

-
+


-
+


-
+




-
-
+
+






-
+

-
+




-
-
+
int
\fBTcl_IsShared\fR(\fIobjPtr\fR)
.sp
\fBTcl_InvalidateStringRep\fR(\fIobjPtr\fR)
.SH ARGUMENTS
.AS Tcl_Obj *objPtr
.AP Tcl_Obj *objPtr in
Points to a value;
Points to an object;
must have been the result of a previous call to \fBTcl_NewObj\fR.
.BE

.SH INTRODUCTION
.PP
This man page presents an overview of Tcl values (called \fBTcl_Obj\fRs for
This man page presents an overview of Tcl objects and how they are used.
historical reasons) and how they are used.
It also describes generic procedures for managing Tcl values.
These procedures are used to create and copy values,
and increment and decrement the count of references (pointers) to values.
It also describes generic procedures for managing Tcl objects.
These procedures are used to create and copy objects,
and increment and decrement the count of references (pointers) to objects.
The procedures are used in conjunction with ones
that operate on specific types of values such as
that operate on specific types of objects such as
\fBTcl_GetIntFromObj\fR and \fBTcl_ListObjAppendElement\fR.
The individual procedures are described along with the data structures
they manipulate.
.PP
Tcl's \fIdual-ported\fR values provide a general-purpose mechanism
Tcl's \fIdual-ported\fR objects provide a general-purpose mechanism
for storing and exchanging Tcl values.
They largely replace the use of strings in Tcl.
For example, they are used to store variable values,
command arguments, command results, and scripts.
Tcl values behave like strings but also hold an internal representation
Tcl objects behave like strings but also hold an internal representation
that can be manipulated more efficiently.
For example, a Tcl list is now represented as a value
For example, a Tcl list is now represented as an object
that holds the list's string representation
as well as an array of pointers to the values for each list element.
Dual-ported values avoid most runtime type conversions.
as well as an array of pointers to the objects for each list element.
Dual-ported objects avoid most runtime type conversions.
They also improve the speed of many operations
since an appropriate representation is immediately available.
The compiler itself uses Tcl values to
The compiler itself uses Tcl objects to
cache the instruction bytecodes resulting from compiling scripts.
.PP
The two representations are a cache of each other and are computed lazily.
That is, each representation is only computed when necessary,
it is computed from the other representation,
and, once computed, it is saved.
In addition, a change in one representation invalidates the other one.
As an example, a Tcl program doing integer calculations can
operate directly on a variable's internal machine integer
representation without having to constantly convert
between integers and strings.
Only when it needs a string representing the variable's value,
say to print it,
will the program regenerate the string representation from the integer.
Although values contain an internal representation,
Although objects contain an internal representation,
their semantics are defined in terms of strings:
an up-to-date string can always be obtained,
and any change to the value will be reflected in that string
when the value's string representation is fetched.
and any change to the object will be reflected in that string
when the object's string representation is fetched.
Because of this representation invalidation and regeneration,
it is dangerous for extension writers to access
\fBTcl_Obj\fR fields directly.
It is better to access Tcl_Obj information using
procedures like \fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR.
.PP
Values are allocated on the heap
Objects are allocated on the heap
and are referenced using a pointer to their \fBTcl_Obj\fR structure.
Values are shared as much as possible.
Objects are shared as much as possible.
This significantly reduces storage requirements
because some values such as long lists are very large.
because some objects such as long lists are very large.
Also, most Tcl values are only read and never modified.
This is especially true for procedure arguments,
which can be shared between the caller and the called procedure.
Assignment and argument binding is done by
simply assigning a pointer to the value.
Reference counting is used to determine when it is safe to
reclaim a value's storage.
reclaim an object's storage.
.PP
Tcl values are typed.
A value's internal representation is controlled by its type.
Tcl objects are typed.
An object's internal representation is controlled by its type.
Several types are predefined in the Tcl core
including integer, double, list, and bytecode.
Extension writers can extend the set of types
by defining their own \fBTcl_ObjType\fR structs.
.SH "THE TCL_OBJ STRUCTURE"
.PP
Each Tcl value is represented by a \fBTcl_Obj\fR structure
Each Tcl object is represented by a \fBTcl_Obj\fR structure
which is defined as follows.
.PP
.CS
typedef struct Tcl_Obj {
    size_t \fIrefCount\fR;
    char *\fIbytes\fR;
    size_t \fIlength\fR;
    const Tcl_ObjType *\fItypePtr\fR;
    union {
        long \fIlongValue\fR;
        double \fIdoubleValue\fR;
        void *\fIotherValuePtr\fR;
        Tcl_WideInt \fIwideValue\fR;
        struct {
            void *\fIptr1\fR;
            void *\fIptr2\fR;
        } \fItwoPtrValue\fR;
        struct {
            void *\fIptr\fR;
            unsigned long \fIvalue\fR;
        } \fIptrAndLongRep\fR;
    } \fIinternalRep\fR;
} \fBTcl_Obj\fR;
        int \fIrefCount\fR;
        char *\fIbytes\fR;
        int \fIlength\fR;
        Tcl_ObjType *\fItypePtr\fR;
        union {
                long \fIlongValue\fR;
                double \fIdoubleValue\fR;
                void *\fIotherValuePtr\fR;
                Tcl_WideInt \fIwideValue\fR;
                struct {
                        void *\fIptr1\fR;
                        void *\fIptr2\fR;
                } \fItwoPtrValue\fR;
                struct {
                        void *\fIptr\fR;
                        unsigned long \fIvalue\fR;
                } \fIptrAndLongRep\fR;
        } \fIinternalRep\fR;
} Tcl_Obj;
.CE
.PP
The \fIbytes\fR and the \fIlength\fR members together hold
a value's UTF-8 string representation,
an object's UTF-8 string representation,
which is a \fIcounted string\fR not containing null bytes (UTF-8 null
characters should be encoded as a two byte sequence: 192, 128.)
\fIbytes\fR points to the first byte of the string representation.
The \fIlength\fR member gives the number of bytes.
The byte array must always have a null byte after the last data byte,
at offset \fIlength\fR;
this allows string representations
to be treated as conventional null-terminated C strings.
C programs use \fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR to get
a value's string representation.
an object's string representation.
If \fIbytes\fR is NULL,
the string representation is invalid.
.PP
A value's type manages its internal representation.
An object's type manages its internal representation.
The member \fItypePtr\fR points to the Tcl_ObjType structure
that describes the type.
If \fItypePtr\fR is NULL,
the internal representation is invalid.
.PP
The \fIinternalRep\fR union member holds
a value's internal representation.
an object's internal representation.
This is either a (long) integer, a double-precision floating-point number,
a pointer to a value containing additional information
needed by the value's type to represent the value, a Tcl_WideInt
needed by the object's type to represent the object, a Tcl_WideInt
integer, two arbitrary pointers, or a pair made up of an unsigned long
integer and a pointer.
.PP
The \fIrefCount\fR member is used to tell when it is safe to free
a value's storage.
It holds the count of active references to the value.
an object's storage.
It holds the count of active references to the object.
Maintaining the correct reference count is a key responsibility
of extension writers.
Reference counting is discussed below
in the section \fBSTORAGE MANAGEMENT OF VALUES\fR.
in the section \fBSTORAGE MANAGEMENT OF OBJECTS\fR.
.PP
Although extension writers can directly access
the members of a Tcl_Obj structure,
it is much better to use the appropriate procedures and macros.
For example, extension writers should never
read or update \fIrefCount\fR directly;
they should use macros such as
\fBTcl_IncrRefCount\fR and \fBTcl_IsShared\fR instead.
.PP
A key property of Tcl values is that they hold two representations.
A value typically starts out containing only a string representation:
A key property of Tcl objects is that they hold two representations.
An object typically starts out containing only a string representation:
it is untyped and has a NULL \fItypePtr\fR.
A value containing an empty string or a copy of a specified string
An object containing an empty string or a copy of a specified string
is created using \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR respectively.
A value's string value is gotten with
An object's string value is gotten with
\fBTcl_GetStringFromObj\fR or \fBTcl_GetString\fR
and changed with \fBTcl_SetStringObj\fR.
If the value is later passed to a procedure like \fBTcl_GetIntFromObj\fR
If the object is later passed to a procedure like \fBTcl_GetIntFromObj\fR
that requires a specific internal representation,
the procedure will create one and set the value's \fItypePtr\fR.
the procedure will create one and set the object's \fItypePtr\fR.
The internal representation is computed from the string representation.
A value's two representations are duals of each other:
An object's two representations are duals of each other:
changes made to one are reflected in the other.
For example, \fBTcl_ListObjReplace\fR will modify a value's
For example, \fBTcl_ListObjReplace\fR will modify an object's
internal representation and the next call to \fBTcl_GetStringFromObj\fR
or \fBTcl_GetString\fR will reflect that change.
.PP
Representations are recomputed lazily for efficiency.
A change to one representation made by a procedure
such as \fBTcl_ListObjReplace\fR is not reflected immediately
in the other representation.
Instead, the other representation is marked invalid
so that it is only regenerated if it is needed later.
Most C programmers never have to be concerned with how this is done
and simply use procedures such as \fBTcl_GetBooleanFromObj\fR or
\fBTcl_ListObjIndex\fR.
Programmers that implement their own value types
Programmers that implement their own object types
must check for invalid representations
and mark representations invalid when necessary.
The procedure \fBTcl_InvalidateStringRep\fR is used
to mark a value's string representation invalid and to
to mark an object's string representation invalid and to
free any storage associated with the old string representation.
.PP
Values usually remain one type over their life,
but occasionally a value must be converted from one type to another.
For example, a C program might build up a string in a value
Objects usually remain one type over their life,
but occasionally an object must be converted from one type to another.
For example, a C program might build up a string in an object
with repeated calls to \fBTcl_AppendToObj\fR,
and then call \fBTcl_ListObjIndex\fR to extract a list element from
the value.
The same value holding the same string value
the object.
The same object holding the same string value
can have several different internal representations
at different times.
Extension writers can also force a value to be converted from one type
Extension writers can also force an object to be converted from one type
to another using the \fBTcl_ConvertToType\fR procedure.
Only programmers that create new value types need to be concerned
Only programmers that create new object types need to be concerned
about how this is done.
A procedure defined as part of the value type's implementation
creates a new internal representation for a value
A procedure defined as part of the object type's implementation
creates a new internal representation for an object
and changes its \fItypePtr\fR.
See the man page for \fBTcl_RegisterObjType\fR
to see how to create a new value type.
.SH "EXAMPLE OF THE LIFETIME OF A VALUE"
to see how to create a new object type.
.SH "EXAMPLE OF THE LIFETIME OF AN OBJECT"
.PP
As an example of the lifetime of a value,
As an example of the lifetime of an object,
consider the following sequence of commands:
.PP
.CS
\fBset x 123\fR
.CE
.PP
This assigns to \fIx\fR an untyped value whose
This assigns to \fIx\fR an untyped object whose
\fIbytes\fR member points to \fB123\fR and \fIlength\fR member contains 3.
The value's \fItypePtr\fR member is NULL.
The object's \fItypePtr\fR member is NULL.
.PP
.CS
\fBputs "x is $x"\fR
.CE
.PP
\fIx\fR's string representation is valid (since \fIbytes\fR is non-NULL)
and is fetched for the command.
.PP
.CS
\fBincr x\fR
.CE
.PP
The \fBincr\fR command first gets an integer from \fIx\fR's value
The \fBincr\fR command first gets an integer from \fIx\fR's object
by calling \fBTcl_GetIntFromObj\fR.
This procedure checks whether the value is already an integer value.
Since it is not, it converts the value
by setting the value's internal representation
This procedure checks whether the object is already an integer object.
Since it is not, it converts the object
by setting the object's internal representation
to the integer \fB123\fR
and setting the value's \fItypePtr\fR
and setting the object's \fItypePtr\fR
to point to the integer Tcl_ObjType structure.
Both representations are now valid.
\fBincr\fR increments the value's integer internal representation
\fBincr\fR increments the object's integer internal representation
then invalidates its string representation
(by calling \fBTcl_InvalidateStringRep\fR)
since the string representation
no longer corresponds to the internal representation.
.PP
.CS
\fBputs "x is now $x"\fR
.CE
.PP
The string representation of \fIx\fR's value is needed
The string representation of \fIx\fR's object is needed
and is recomputed.
The string representation is now \fB124\fR
and both representations are again valid.
.SH "STORAGE MANAGEMENT OF VALUES"
.SH "STORAGE MANAGEMENT OF OBJECTS"
.PP
Tcl values are allocated on the heap and are shared as much as possible
Tcl objects are allocated on the heap and are shared as much as possible
to reduce storage requirements.
Reference counting is used to determine when a value is
Reference counting is used to determine when an object is
no longer needed and can safely be freed.
A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
An object just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
has \fIrefCount\fR 0.
The macro \fBTcl_IncrRefCount\fR increments the reference count
when a new reference to the value is created.
when a new reference to the object is created.
The macro \fBTcl_DecrRefCount\fR decrements the count
when a reference is no longer needed and,
if the value's reference count drops to zero, frees its storage.
A value shared by different code or data structures has
if the object's reference count drops to zero, frees its storage.
An object shared by different code or data structures has
\fIrefCount\fR greater than 1.
Incrementing a value's reference count ensures that
Incrementing an object's reference count ensures that
it will not be freed too early or have its value change accidentally.
.PP
As an example, the bytecode interpreter shares argument values
between calling and called Tcl procedures to avoid having to copy values.
It assigns the call's argument values to the procedure's
As an example, the bytecode interpreter shares argument objects
between calling and called Tcl procedures to avoid having to copy objects.
It assigns the call's argument objects to the procedure's
formal parameter variables.
In doing so, it calls \fBTcl_IncrRefCount\fR to increment
the reference count of each argument since there is now a new
reference to it from the formal parameter.
When the called procedure returns,
the interpreter calls \fBTcl_DecrRefCount\fR to decrement
each argument's reference count.
When a value's reference count drops less than or equal to zero,
When an object's reference count drops less than or equal to zero,
\fBTcl_DecrRefCount\fR reclaims its storage.
Most command procedures do not have to be concerned about
reference counting since they use a value's value immediately
and do not retain a pointer to the value after they return.
However, if they do retain a pointer to a value in a data structure,
reference counting since they use an object's value immediately
and do not retain a pointer to the object after they return.
However, if they do retain a pointer to an object in a data structure,
they must be careful to increment its reference count
since the retained pointer is a new reference.
.PP
Command procedures that directly modify values
Command procedures that directly modify objects
such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
copy a shared value before changing it.
They must first check whether the value is shared
copy a shared object before changing it.
They must first check whether the object is shared
by calling \fBTcl_IsShared\fR.
If the value is shared they must copy the value
If the object is shared they must copy the object
by using \fBTcl_DuplicateObj\fR;
this returns a new duplicate of the original value
this returns a new duplicate of the original object
that has \fIrefCount\fR 0.
If the value is not shared,
If the object is not shared,
the command procedure
.QW "owns"
the value and can safely modify it directly.
the object and can safely modify it directly.
For example, the following code appears in the command procedure
that implements \fBlinsert\fR.
This procedure modifies the list value passed to it in \fIobjv[1]\fR
This procedure modifies the list object passed to it in \fIobjv[1]\fR
by inserting \fIobjc-3\fR new elements before \fIindex\fR.
.PP
.CS
listPtr = objv[1];
if (\fBTcl_IsShared\fR(listPtr)) {
    listPtr = \fBTcl_DuplicateObj\fR(listPtr);
if (Tcl_IsShared(listPtr)) {
    listPtr = Tcl_DuplicateObj(listPtr);
}
result = Tcl_ListObjReplace(interp, listPtr, index, 0,
        (objc-3), &(objv[3]));
.CE
.PP
As another example, \fBincr\fR's command procedure
must check whether the variable's value is shared before
must check whether the variable's object is shared before
incrementing the integer in its internal representation.
If it is shared, it needs to duplicate the value
If it is shared, it needs to duplicate the object
in order to avoid accidentally changing values in other data structures.
.SH "SEE ALSO"
Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
.SH KEYWORDS
internal representation, value, value creation, value type,
reference counting, string representation, type conversion
internal representation, object, object creation, object type, reference counting, string representation, type conversion

Changes to doc/ObjectType.3.

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
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





-
+




-
+






-
+









-
-
+
+



-
+



-
-
-
+
+
+





-
+
-
-
+


-
-
-
+
+
+

-
+














-
-
+
+

-
+


-
+



-
-
+
+


-
+




+






+


-
+










-
+




-
+








-
+




-
+


-
-
+





-
+







'\"
'\" Copyright (c) 1996-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.
'\"
'\" 
.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType  \- manipulate Tcl value types
Tcl_RegisterObjType, Tcl_GetObjType, Tcl_AppendAllObjTypes, Tcl_ConvertToType  \- manipulate Tcl object types
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_RegisterObjType\fR(\fItypePtr\fR)
.sp
const Tcl_ObjType *
Tcl_ObjType *
\fBTcl_GetObjType\fR(\fItypeName\fR)
.sp
int
\fBTcl_AppendAllObjTypes\fR(\fIinterp, objPtr\fR)
.sp
int
\fBTcl_ConvertToType\fR(\fIinterp, objPtr, typePtr\fR)
.SH ARGUMENTS
.AS "const char" *typeName
.AP "const Tcl_ObjType" *typePtr in
Points to the structure containing information about the Tcl value type.
.AP Tcl_ObjType *typePtr in
Points to the structure containing information about the Tcl object type.
This storage must live forever,
typically by being statically allocated.
.AP "const char" *typeName in
The name of a Tcl value type that \fBTcl_GetObjType\fR should look up.
The name of a Tcl object type that \fBTcl_GetObjType\fR should look up.
.AP Tcl_Interp *interp in
Interpreter to use for error reporting.
.AP Tcl_Obj *objPtr in
For \fBTcl_AppendAllObjTypes\fR, this points to the value onto which
it appends the name of each value type as a list element.
For \fBTcl_ConvertToType\fR, this points to a value that
For \fBTcl_AppendAllObjTypes\fR, this points to the object onto which
it appends the name of each object type as a list element.
For \fBTcl_ConvertToType\fR, this points to an object that
must have been the result of a previous call to \fBTcl_NewObj\fR.
.BE

.SH DESCRIPTION
.PP
The procedures in this man page manage Tcl value types (sometimes
The procedures in this man page manage Tcl object types.
referred to as object types or \fBTcl_ObjType\fRs for historical reasons).
They are used to register new value types, look up types,
They are used to register new object types, look up types,
and force conversions from one type to another.
.PP
\fBTcl_RegisterObjType\fR registers a new Tcl value type
in the table of all value types that \fBTcl_GetObjType\fR
can look up by name.  There are other value types supported by Tcl
\fBTcl_RegisterObjType\fR registers a new Tcl object type
in the table of all object types that \fBTcl_GetObjType\fR
can look up by name.  There are other object types supported by Tcl
as well, which Tcl chooses not to register.  Extensions can likewise
choose to register the value types they create or not.
choose to register the object types they create or not.
The argument \fItypePtr\fR points to a Tcl_ObjType structure that
describes the new type by giving its name
and by supplying pointers to four procedures
that implement the type.
If the type table already contains a type
with the same name as in \fItypePtr\fR,
it is replaced with the new type.
The Tcl_ObjType structure is described
in the section \fBTHE TCL_OBJTYPE STRUCTURE\fR below.
.PP
\fBTcl_GetObjType\fR returns a pointer to the registered Tcl_ObjType
with name \fItypeName\fR.
It returns NULL if no type with that name is registered.
.PP
\fBTcl_AppendAllObjTypes\fR appends the name of each registered value type
as a list element onto the Tcl value referenced by \fIobjPtr\fR.
\fBTcl_AppendAllObjTypes\fR appends the name of each registered object type
as a list element onto the Tcl object referenced by \fIobjPtr\fR.
The return value is \fBTCL_OK\fR unless there was an error
converting \fIobjPtr\fR to a list value;
converting \fIobjPtr\fR to a list object;
in that case \fBTCL_ERROR\fR is returned.
.PP
\fBTcl_ConvertToType\fR converts a value from one type to another
\fBTcl_ConvertToType\fR converts an object from one type to another
if possible.
It creates a new internal representation for \fIobjPtr\fR
appropriate for the target type \fItypePtr\fR
and sets its \fItypePtr\fR member as determined by calling the
\fItypePtr->setFromAnyProc\fR routine.
and sets its \fItypePtr\fR member as determined by calling the 
\fItypePtr->setFromAnyProc\fR routine.  
Any internal representation for \fIobjPtr\fR's old type is freed.
If an error occurs during conversion, it returns \fBTCL_ERROR\fR
and leaves an error message in the result value for \fIinterp\fR
and leaves an error message in the result object for \fIinterp\fR
unless \fIinterp\fR is NULL.
Otherwise, it returns \fBTCL_OK\fR.
Passing a NULL \fIinterp\fR allows this procedure to be used
as a test whether the conversion can be done (and in fact was done).
.VS 8.5
.PP
In many cases, the \fItypePtr->setFromAnyProc\fR routine will
set \fIobjPtr->typePtr\fR to the argument value \fItypePtr\fR,
but that is no longer guaranteed.  The \fIsetFromAnyProc\fR is
free to set the internal representation for \fIobjPtr\fR to make
use of another related Tcl_ObjType, if it sees fit.
.VE 8.5
.SH "THE TCL_OBJTYPE STRUCTURE"
.PP
Extension writers can define new value types by defining four
Extension writers can define new object types by defining four
procedures and
initializing a Tcl_ObjType structure to describe the type.
Extension writers may also pass a pointer to their Tcl_ObjType
structure to \fBTcl_RegisterObjType\fR if they wish to permit
other extensions to look up their Tcl_ObjType by name with
the \fBTcl_GetObjType\fR routine.
The \fBTcl_ObjType\fR structure is defined as follows:
.PP
.CS
typedef struct Tcl_ObjType {
    const char *\fIname\fR;
    char *\fIname\fR;
    Tcl_FreeInternalRepProc *\fIfreeIntRepProc\fR;
    Tcl_DupInternalRepProc *\fIdupIntRepProc\fR;
    Tcl_UpdateStringProc *\fIupdateStringProc\fR;
    Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
} \fBTcl_ObjType\fR;
} Tcl_ObjType;
.CE
.SS "THE NAME FIELD"
.PP
The \fIname\fR member describes the name of the type, e.g. \fBint\fR.
When a type is registered, this is the name used by callers
of \fBTcl_GetObjType\fR to lookup the type.  For unregistered
types, the \fIname\fR field is primarily of value for debugging.
The remaining four members are pointers to procedures
called by the generic Tcl value code:
called by the generic Tcl object code:
.SS "THE SETFROMANYPROC FIELD"
.PP
The \fIsetFromAnyProc\fR member contains the address of a function
called to create a valid internal representation
from a value's string representation.
from an object's string representation.
.PP
.CS
typedef int \fBTcl_SetFromAnyProc\fR(
        Tcl_Interp *\fIinterp\fR,
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *\fIinterp\fR,
        Tcl_Obj *\fIobjPtr\fR);
.CE
.PP
If an internal representation cannot be created from the string,
it returns \fBTCL_ERROR\fR and puts a message
describing the error in the result value for \fIinterp\fR
describing the error in the result object for \fIinterp\fR
unless \fIinterp\fR is NULL.
If \fIsetFromAnyProc\fR is successful,
it stores the new internal representation,
sets \fIobjPtr\fR's \fItypePtr\fR member to point to
the \fBTcl_ObjType\fR struct corresponding to the new
internal representation, and returns \fBTCL_OK\fR.
Before setting the new internal representation,
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

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







-
+






-
+


-
-
+






-
+




-
-
+
+
















-
+


-
-
+







-
+










-
+


-
-
+



-
-
+
+



-
+





-
-
+
+



-
+

-
+
.PP
Do not release \fIobjPtr\fR's old internal representation unless you
replace it with a new one or reset the \fItypePtr\fR member to NULL.
.PP
The \fIsetFromAnyProc\fR member may be set to NULL, if the routines
making use of the internal representation have no need to derive that
internal representation from an arbitrary string value.  However, in
this case, passing a pointer to the type to \fBTcl_ConvertToType\fR will
this case, passing a pointer to the type to Tcl_ConvertToType() will
lead to a panic, so to avoid this possibility, the type
should \fInot\fR be registered.
.SS "THE UPDATESTRINGPROC FIELD"
.PP
The \fIupdateStringProc\fR member contains the address of a function
called to create a valid string representation
from a value's internal representation.
from an object's internal representation.
.PP
.CS
typedef void \fBTcl_UpdateStringProc\fR(
        Tcl_Obj *\fIobjPtr\fR);
typedef void (Tcl_UpdateStringProc) (Tcl_Obj *\fIobjPtr\fR);
.CE
.PP
\fIobjPtr\fR's \fIbytes\fR member is always NULL when it is called.
It must always set \fIbytes\fR non-NULL before returning.
We require the string representation's byte array
to have a null after the last byte, at offset \fIlength\fR,
and to have no null bytes before that; this allows string representations
and to have no null bytes before that; this allows string representations 
to be treated as conventional null character-terminated C strings.
These restrictions are easily met by using Tcl's internal UTF encoding
for the string representation, same as one would do for other
Tcl routines accepting string values as arguments.
Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR.
Note that \fIupdateStringProc\fRs must allocate
Storage for the byte array must be allocated in the heap by \fBTcl_Alloc\fR
or \fBckalloc\fR.  Note that \fIupdateStringProc\fRs must allocate
enough storage for the string's bytes and the terminating null byte.
.PP
The \fIupdateStringProc\fR for Tcl's built-in double type, for example,
calls Tcl_PrintDouble to write to a buffer of size TCL_DOUBLE_SPACE,
then allocates and copies the string representation to just enough
space to hold it.  A pointer to the allocated space is stored in
the \fIbytes\fR member.
.PP
The \fIupdateStringProc\fR member may be set to NULL, if the routines
making use of the internal representation are written so that the
string representation is never invalidated.  Failure to meet this
obligation will lead to panics or crashes when \fBTcl_GetStringFromObj\fR
or other similar routines ask for the string representation.
.SS "THE DUPINTREPPROC FIELD"
.PP
The \fIdupIntRepProc\fR member contains the address of a function
called to copy an internal representation from one value to another.
called to copy an internal representation from one object to another.
.PP
.CS
typedef void \fBTcl_DupInternalRepProc\fR(
        Tcl_Obj *\fIsrcPtr\fR,
typedef void (Tcl_DupInternalRepProc) (Tcl_Obj *\fIsrcPtr\fR,
        Tcl_Obj *\fIdupPtr\fR);
.CE
.PP
\fIdupPtr\fR's internal representation is made a copy of \fIsrcPtr\fR's
internal representation.
Before the call,
\fIsrcPtr\fR's internal representation is valid and \fIdupPtr\fR's is not.
\fIsrcPtr\fR's value type determines what
\fIsrcPtr\fR's object type determines what
copying its internal representation means.
.PP
For example, the \fIdupIntRepProc\fR for the Tcl integer type
simply copies an integer.
The built-in list type's \fIdupIntRepProc\fR uses a far more
sophisticated scheme to continue sharing storage as much as it
reasonably can.
.SS "THE FREEINTREPPROC FIELD"
.PP
The \fIfreeIntRepProc\fR member contains the address of a function
that is called when a value is freed.
that is called when an object is freed.
.PP
.CS
typedef void \fBTcl_FreeInternalRepProc\fR(
        Tcl_Obj *\fIobjPtr\fR);
typedef void (Tcl_FreeInternalRepProc) (Tcl_Obj *\fIobjPtr\fR);
.CE
.PP
The \fIfreeIntRepProc\fR function can deallocate the storage
for the value's internal representation
and do other type-specific processing necessary when a value is freed.
for the object's internal representation
and do other type-specific processing necessary when an object is freed.
.PP
For example, the list type's \fIfreeIntRepProc\fR respects
the storage sharing scheme established by the \fIdupIntRepProc\fR
so that it only frees storage when the last value sharing it
so that it only frees storage when the last object sharing it
is being freed.
.PP
The \fIfreeIntRepProc\fR member can be set to NULL
to indicate that the internal representation does not require freeing.
The \fIfreeIntRepProc\fR implementation must not access the
\fIbytes\fR member of the value, since Tcl makes its own internal
uses of that field during value deletion.  The defined tasks for
\fIbytes\fR member of the object, since Tcl makes its own internal
uses of that field during object deletion.  The defined tasks for
the \fIfreeIntRepProc\fR have no need to consult the \fIbytes\fR
member.
.SH "SEE ALSO"
Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
Tcl_NewObj, Tcl_DecrRefCount, Tcl_IncrRefCount
.SH KEYWORDS
internal representation, value, value type, string representation, type conversion
internal representation, object, object type, string representation, type conversion

Changes to doc/OpenFileChnl.3.

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
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







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







.sp
int
\fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
.sp
int
\fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
int
\fBTcl_GetsObj\fR(\fIchannel, lineObjPtr\fR)
.sp
size_t
int
\fBTcl_Gets\fR(\fIchannel, lineRead\fR)
.sp
size_t
int
\fBTcl_Ungets\fR(\fIchannel, input, inputLen, addAtEnd\fR)
.sp
size_t
int
\fBTcl_WriteObj\fR(\fIchannel, writeObjPtr\fR)
.sp
size_t
int
\fBTcl_WriteChars\fR(\fIchannel, charBuf, bytesToWrite\fR)
.sp
size_t
int
\fBTcl_Write\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
size_t
int
\fBTcl_ReadRaw\fR(\fIchannel, readBuf, bytesToRead\fR)
.sp
size_t
int
\fBTcl_WriteRaw\fR(\fIchannel, byteBuf, bytesToWrite\fR)
.sp
int
\fBTcl_Eof\fR(\fIchannel\fR)
.sp
int
\fBTcl_Flush\fR(\fIchannel\fR)
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
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







+


+















-
+


















-
+






-
+










-
+

-
-
-
+
+
+


-
-
+
+


-
+



-
+

-
+






-
+





-
+




-
+







.sp
Tcl_WideInt
\fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
.sp
Tcl_WideInt
\fBTcl_Tell\fR(\fIchannel\fR)
.sp
.VS 8.5
int
\fBTcl_TruncateChannel\fR(\fIchannel, length\fR)
.VE 8.5
.sp
int
\fBTcl_GetChannelOption\fR(\fIinterp, channel, optionName, optionValue\fR)
.sp
int
\fBTcl_SetChannelOption\fR(\fIinterp, channel, optionName, newValue\fR)
.sp
.SH ARGUMENTS
.AS Tcl_DString *channelName in/out
.AP Tcl_Interp *interp in
Used for error reporting and to look up a channel registered in it.
.AP "const char" *fileName in
The name of a local or network file.
.AP "const char" *mode in
Specifies how the file is to be accessed.  May have any of the values
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.
allowed for the \fImode\fR argument to the Tcl \fBopen\fR command.  
.AP int permissions in
POSIX-style permission flags such as 0644.  If a new file is created, these
permissions will be set on the created file.
.AP int argc in
The number of elements in \fIargv\fR.
.AP "const char" **argv in
Arguments for constructing a command pipeline.  These values have the same
meaning as the non-switch arguments to the Tcl \fBexec\fR command.
.AP int flags in
Specifies the disposition of the stdio handles in pipeline: OR-ed
combination of \fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, \fBTCL_STDERR\fR, and
\fBTCL_ENFORCE_MODE\fR. If \fBTCL_STDIN\fR is set, stdin for the first child
in the pipe is the pipe channel, otherwise it is the same as the standard
input of the invoking process; likewise for \fBTCL_STDOUT\fR and
\fBTCL_STDERR\fR. If \fBTCL_ENFORCE_MODE\fR is not set, then the pipe can
redirect stdio handles to override the stdio handles for which
\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR and \fBTCL_STDERR\fR have been set.  If it
is set, then such redirections cause an error.
.AP void *handle in
.AP ClientData handle in
Operating system specific handle for I/O to a file. For Unix this is a
file descriptor, for Windows it is a HANDLE.
.AP int readOrWrite in
OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR to indicate
what operations are valid on \fIhandle\fR.
.AP "const char" *channelName in
The name of the channel.
The name of the channel. 
.AP int *modePtr out
Points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR denoting whether the channel is
open for reading and writing.
.AP "const char" *pattern in
The pattern to match on, passed to Tcl_StringMatch, or NULL.
.AP Tcl_Channel channel in
A Tcl channel for input or output.  Must have been the return value
from a procedure such as \fBTcl_OpenFileChannel\fR.
.AP Tcl_Obj *readObjPtr in/out
A pointer to a Tcl value in which to store the characters read from the
A pointer to a Tcl Object in which to store the characters read from the
channel.
.AP size_t charsToRead in
The number of characters to read from the channel.  If the channel's encoding
is \fBbinary\fR, this is equivalent to the number of bytes to read from the
.AP int charsToRead in
The number of characters to read from the channel.  If the channel's encoding 
is \fBbinary\fR, this is equivalent to the number of bytes to read from the 
channel.
.AP int appendFlag in
If non-zero, data read from the channel will be appended to the value.
Otherwise, the data will replace the existing contents of the value.
If non-zero, data read from the channel will be appended to the object.
Otherwise, the data will replace the existing contents of the object.
.AP char *readBuf out
A buffer in which to store the bytes read from the channel.
.AP size_t bytesToRead in
.AP int bytesToRead in
The number of bytes to read from the channel.  The buffer \fIreadBuf\fR must
be large enough to hold this many bytes.
.AP Tcl_Obj *lineObjPtr in/out
A pointer to a Tcl value in which to store the line read from the
A pointer to a Tcl object in which to store the line read from the
channel.  The line read will be appended to the current value of the
value.
object. 
.AP Tcl_DString *lineRead in/out
A pointer to a Tcl dynamic string in which to store the line read from the
channel.  Must have been initialized by the caller.  The line read will be
appended to any data already in the dynamic string.
.AP "const char" *input in
The input to add to a channel buffer.
.AP size_t inputLen in
.AP int inputLen in
Length of the input
.AP int addAtEnd in
Flag indicating whether the input should be added to the end or
beginning of the channel buffer.
.AP Tcl_Obj *writeObjPtr in
A pointer to a Tcl value whose contents will be output to the channel.
A pointer to a Tcl Object whose contents will be output to the channel.
.AP "const char" *charBuf in
A buffer containing the characters to output to the channel.
.AP "const char" *byteBuf in
A buffer containing the bytes to output to the channel.
.AP size_t bytesToWrite in
.AP int bytesToWrite in
The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
output to the channel.
.AP Tcl_WideInt offset in
How far to move the access point in the channel at which the next input or
output operation will be applied, measured in bytes from the position
given by \fIseekMode\fR.  May be either positive or negative.
.AP int seekMode in
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
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







+

















+












-
-
+
+




-
+


+







May have any of the values accepted by the \fBfconfigure\fR command.
.AP Tcl_DString *optionValue in
Where to store the value of an option or a list of all options and their
values. Must have been initialized by the caller.
.AP "const char" *newValue in
New value for the option given by \fIoptionName\fR.
.BE

.SH DESCRIPTION
.PP
The Tcl channel mechanism provides a device-independent and
platform-independent mechanism for performing buffered input
and output operations on a variety of file, socket, and device
types.
The channel mechanism is extensible to new channel types, by
providing a low-level channel driver for the new type; the channel driver
interface is described in the manual entry for \fBTcl_CreateChannel\fR. The
channel mechanism provides a buffering scheme modeled after
Unix's standard I/O, and it also allows for nonblocking I/O on
channels.
.PP
The procedures described in this manual entry comprise the C APIs of the
generic layer of the channel architecture. For a description of the channel
driver architecture and how to implement channel drivers for new types of
channels, see the manual entry for \fBTcl_CreateChannel\fR.

.SH TCL_OPENFILECHANNEL
.PP
\fBTcl_OpenFileChannel\fR opens a file specified by \fIfileName\fR and
returns a channel handle that can be used to perform input and output on
the file. This API is modeled after the \fBfopen\fR procedure of
the Unix standard I/O library.
The syntax and meaning of all arguments is similar to those
given in the Tcl \fBopen\fR command when opening a file.
If an error occurs while opening the channel, \fBTcl_OpenFileChannel\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_OpenFileChannel\fR
leaves an error message in \fIinterp\fR's result after any error.
As of Tcl 8.4, the value-based API \fBTcl_FSOpenFileChannel\fR should
leaves an error message in \fIinterp\fR's result after any error.  
As of Tcl 8.4, the object-based API \fBTcl_FSOpenFileChannel\fR should 
be used in preference to \fBTcl_OpenFileChannel\fR wherever possible.
.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
If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.

.SH TCL_OPENCOMMANDCHANNEL
.PP
\fBTcl_OpenCommandChannel\fR provides a C-level interface to the
functions of the \fBexec\fR and \fBopen\fR commands.
It creates a sequence of subprocesses specified
by the \fIargv\fR and \fIargc\fR arguments and returns a channel that can
be used to communicate with these subprocesses.
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
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







-
+



-
+


+






-
+


+












-
+




+







error for argc and argv to override stdio channels for which
\fBTCL_STDIN\fR, \fBTCL_STDOUT\fR, and \fBTCL_STDERR\fR have been set.
.PP
If an error occurs while opening the channel, \fBTcl_OpenCommandChannel\fR
returns NULL and records a POSIX error code that can be retrieved with
\fBTcl_GetErrno\fR.
In addition, \fBTcl_OpenCommandChannel\fR leaves an error message in
the interpreter's result. \fIinterp\fR cannot be NULL.
the interpreter's result if \fIinterp\fR is not NULL.
.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
If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.

.SH TCL_MAKEFILECHANNEL
.PP
\fBTcl_MakeFileChannel\fR makes a \fBTcl_Channel\fR from an existing,
platform-specific, file handle.
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
If one of the standard channels, \fBstdin, stdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.

.SH TCL_GETCHANNEL
.PP
\fBTcl_GetChannel\fR returns a channel given the \fIchannelName\fR used to
create it with \fBTcl_CreateChannel\fR and a pointer to a Tcl interpreter in
\fIinterp\fR. If a channel by that name is not registered in that interpreter,
the procedure returns NULL. If the \fImodePtr\fR argument is not NULL, it
points at an integer variable that will receive an OR-ed combination of
\fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR describing whether the channel is
open for reading and writing.
.PP
\fBTcl_GetChannelNames\fR and \fBTcl_GetChannelNamesEx\fR write the
names of the registered channels to the interpreter's result as a
list value.  \fBTcl_GetChannelNamesEx\fR will filter these names
list object.  \fBTcl_GetChannelNamesEx\fR will filter these names
according to the \fIpattern\fR.  If \fIpattern\fR is NULL, then it
will not do any filtering.  The return value is \fBTCL_OK\fR if no
errors occurred writing to the result, otherwise it is \fBTCL_ERROR\fR,
and the error message is left in the interpreter's result.

.SH TCL_REGISTERCHANNEL
.PP
\fBTcl_RegisterChannel\fR adds a channel to the set of channels accessible
in \fIinterp\fR. After this call, Tcl programs executing in that
interpreter can refer to the channel in input or output operations using
the name given in the call to \fBTcl_CreateChannel\fR.  After this call,
the channel becomes the property of the interpreter, and the caller should
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
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







-
+

+














+






-
+





-
+

+



-
-
+
+

-
+

+







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
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
interpreter, the channel is also closed and destroyed.
.PP
Code not associated with a Tcl interpreter can call
\fBTcl_UnregisterChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
that it no longer holds a reference to that channel. If this is the last
reference to the channel, it will now be closed.  \fBTcl_UnregisterChannel\fR
is very similar to \fBTcl_DetachChannel\fR except that it will also
close the channel if no further references to it exist.

.SH TCL_DETACHCHANNEL
.PP
\fBTcl_DetachChannel\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.
Beyond that, this command has no further effect.  It cannot be used on
the standard channels (\fBstdout\fR, \fBstderr\fR, \fBstdin\fR), and will return
the standard channels (stdout, stderr, stdin), and will return
\fBTCL_ERROR\fR if passed one of those channels.
.PP
Code not associated with a Tcl interpreter can call
\fBTcl_DetachChannel\fR with \fIinterp\fR as NULL, to indicate to Tcl
that it no longer holds a reference to that channel. If this is the last
reference to the channel, unlike \fBTcl_UnregisterChannel\fR,
reference to the channel, unlike \fBTcl_UnregisterChannel\fR, 
it will not be closed.

.SH TCL_ISSTANDARDCHANNEL
.PP
\fBTcl_IsStandardChannel\fR tests whether a channel is one of the
three standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR.
If so, it returns 1, otherwise 0.
three standard channels, stdin, stdout or stderr.  If so, it returns
1, otherwise 0.
.PP
No attempt is made to check whether the given channel or the standard
No attempt is made to check whether the given channel or the standard 
channels are initialized or otherwise valid.

.SH TCL_CLOSE
.PP
\fBTcl_Close\fR destroys the channel \fIchannel\fR, which must denote a
currently open channel. The channel should not be registered in any
interpreter when \fBTcl_Close\fR is called. Buffered output is flushed to
the channel's output device prior to destroying the channel, and any
buffered input is discarded.  If this is a blocking channel, the call does
395
396
397
398
399
400
401

402
403
404
405

406
407
408
409
410
411
412
407
408
409
410
411
412
413
414
415
416
417

418
419
420
421
422
423
424
425







+



-
+







registered using \fBTcl_RegisterChannel\fR; see the documentation for
\fBTcl_RegisterChannel\fR, above, for details. If the channel has ever
been given as the \fBchan\fR argument in a call to
\fBTcl_RegisterChannel\fR, you should instead use
\fBTcl_UnregisterChannel\fR, which will internally call \fBTcl_Close\fR
when all calls to \fBTcl_RegisterChannel\fR have been matched by
corresponding calls to \fBTcl_UnregisterChannel\fR.

.SH "TCL_READCHARS AND TCL_READ"
.PP
\fBTcl_ReadChars\fR consumes bytes from \fIchannel\fR, converting the bytes
to UTF-8 based on the channel's encoding and storing the produced data in
to UTF-8 based on the channel's encoding and storing the produced data in 
\fIreadObjPtr\fR's string representation.  The return value of
\fBTcl_ReadChars\fR is the number of characters, up to \fIcharsToRead\fR,
that were stored in \fIreadObjPtr\fR.  If an error occurs while reading, the
return value is \-1 and \fBTcl_ReadChars\fR records a POSIX error code that
can be retrieved with \fBTcl_GetErrno\fR.
.PP
Setting \fIcharsToRead\fR to \fB\-1\fR will cause the command to read
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
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







-
+














-
+








+







end-of-line recognition mode.  End-of-line recognition and the various
platform-specific modes are described in the manual entry for the Tcl
\fBfconfigure\fR command.
.PP
As a performance optimization, when reading from a channel with the encoding
\fBbinary\fR, the bytes are not converted to UTF-8 as they are read.
Instead, they are stored in \fIreadObjPtr\fR's internal representation as a
byte-array value.  The string representation of this value will only be
byte-array object.  The string representation of this object will only be
constructed if it is needed (e.g., because of a call to
\fBTcl_GetStringFromObj\fR).  In this way, byte-oriented data can be read
from a channel, manipulated by calling \fBTcl_GetByteArrayFromObj\fR and
related functions, and then written to a channel without the expense of ever
converting to or from UTF-8.
.PP
\fBTcl_Read\fR is similar to \fBTcl_ReadChars\fR, except that it does not do
encoding conversions, regardless of the channel's encoding.  It is deprecated
and exists for backwards compatibility with non-internationalized Tcl
extensions.  It consumes bytes from \fIchannel\fR and stores them in
\fIreadBuf\fR, performing end-of-line translations on the way.  The return value
of \fBTcl_Read\fR is the number of bytes, up to \fIbytesToRead\fR, written in
\fIreadBuf\fR.  The buffer produced by \fBTcl_Read\fR is not null-terminated.
Its contents are valid from the zeroth position up to and excluding the
position indicated by the return value.
position indicated by the return value.  
.PP
\fBTcl_ReadRaw\fR is the same as \fBTcl_Read\fR but does not
compensate for stacking. While \fBTcl_Read\fR (and the other functions
in the API) always get their data from the topmost channel in the
stack the supplied channel is part of, \fBTcl_ReadRaw\fR does
not. Thus this function is \fBonly\fR usable for transformational
channel drivers, i.e. drivers used in the middle of a stack of
channels, to move data from the channel below into the transformation.

.SH "TCL_GETSOBJ AND TCL_GETS"
.PP
\fBTcl_GetsObj\fR consumes bytes from \fIchannel\fR, converting the bytes to
UTF-8 based on the channel's encoding, until a full line of input has been
seen.  If the channel's encoding is \fBbinary\fR, each byte read from the
channel is treated as an individual Unicode character.  All of the
characters of the line except for the terminating end-of-line character(s)
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
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615







-
+
+












+










-
+















-
+

-
+



-
-
+
+




















+













+










+




+


+



+
+







no data was available or the data that was available did not contain an
end-of-line character.  When \-1 is returned, the \fBTcl_InputBlocked\fR
procedure may be invoked to determine if the channel is blocked because
of input unavailability.
.PP
\fBTcl_Gets\fR is the same as \fBTcl_GetsObj\fR except the resulting
characters are appended to the dynamic string given by
\fIlineRead\fR rather than a Tcl value.
\fIlineRead\fR rather than a Tcl object.

.SH "TCL_UNGETS"
.PP
\fBTcl_Ungets\fR is used to add data to the input queue of a channel,
at either the head or tail of the queue.  The pointer \fIinput\fR points
to the data that is to be added.  The length of the input to add is given
by \fIinputLen\fR.  A non-zero value of \fIaddAtEnd\fR indicates that the
data is to be added at the end of queue; otherwise it will be added at the
head of the queue.  If \fIchannel\fR has a
.QW sticky
EOF set, no data will be
added to the input queue.  \fBTcl_Ungets\fR returns \fIinputLen\fR or
\-1 if an error occurs.

.SH "TCL_WRITECHARS, TCL_WRITEOBJ, AND TCL_WRITE"
.PP
\fBTcl_WriteChars\fR accepts \fIbytesToWrite\fR bytes of character data at
\fIcharBuf\fR.  The UTF-8 characters in the buffer are converted to the
channel's encoding and queued for output to \fIchannel\fR.  If
\fIbytesToWrite\fR is negative, \fBTcl_WriteChars\fR expects \fIcharBuf\fR
to be null-terminated and it outputs everything up to the null.
.PP
Data queued for output may not appear on the output device immediately, due
to internal buffering.  If the data should appear immediately, call
\fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the
\fBTcl_Flush\fR after the call to \fBTcl_WriteChars\fR, or set the 
\fB\-buffering\fR option on the channel to \fBnone\fR.  If you wish the data
to appear as soon as a complete line is accepted for output, set the
\fB\-buffering\fR option on the channel to \fBline\fR mode.
.PP
The return value of \fBTcl_WriteChars\fR is a count of how many bytes were
accepted for output to the channel.  This is either greater than zero to
indicate success or \-1 to indicate that an error occurred.  If an error
occurs, \fBTcl_WriteChars\fR records a POSIX error code that may be
retrieved with \fBTcl_GetErrno\fR.
.PP
Newline characters in the output data are translated to platform-specific
end-of-line sequences according to the \fB\-translation\fR option for the
channel.  This is done even if the channel has no encoding.
.PP
\fBTcl_WriteObj\fR is similar to \fBTcl_WriteChars\fR except it
accepts a Tcl value whose contents will be output to the channel.  The
accepts a Tcl object whose contents will be output to the channel.  The
UTF-8 characters in \fIwriteObjPtr\fR's string representation are converted
to the channel's encoding and queued for output to \fIchannel\fR.
to the channel's encoding and queued for output to \fIchannel\fR.  
As a performance optimization, when writing to a channel with the encoding
\fBbinary\fR, UTF-8 characters are not converted as they are written.
Instead, the bytes in \fIwriteObjPtr\fR's internal representation as a
byte-array value are written to the channel.  The byte-array representation
of the value will be constructed if it is needed.  In this way,
byte-array object are written to the channel.  The byte-array representation
of the object will be constructed if it is needed.  In this way,
byte-oriented data can be read from a channel, manipulated by calling
\fBTcl_GetByteArrayFromObj\fR and related functions, and then written to a
channel without the expense of ever converting to or from UTF-8.
.PP
\fBTcl_Write\fR is similar to \fBTcl_WriteChars\fR except that it does not do
encoding conversions, regardless of the channel's encoding.  It is
deprecated and exists for backwards compatibility with non-internationalized
Tcl extensions.  It accepts \fIbytesToWrite\fR bytes of data at
\fIbyteBuf\fR and queues them for output to \fIchannel\fR.  If
\fIbytesToWrite\fR is negative, \fBTcl_Write\fR expects \fIbyteBuf\fR to be
null-terminated and it outputs everything up to the null.
.PP
\fBTcl_WriteRaw\fR is the same as \fBTcl_Write\fR but does not
compensate for stacking. While \fBTcl_Write\fR (and the other
functions in the API) always feed their input to the topmost channel
in the stack the supplied channel is part of, \fBTcl_WriteRaw\fR does
not. Thus this function is \fBonly\fR usable for transformational
channel drivers, i.e. drivers used in the middle of a stack of
channels, to move data from the transformation into the channel below
it.

.SH TCL_FLUSH
.PP
\fBTcl_Flush\fR causes all of the buffered output data for \fIchannel\fR
to be written to its underlying file or device as soon as possible.
If the channel is in blocking mode, the call does not return until
all the buffered data has been sent to the channel or some error occurred.
The call returns immediately if the channel is nonblocking; it starts
a background flush that will write the buffered data to the channel
eventually, as fast as the channel is able to absorb it.
.PP
The return value is normally \fBTCL_OK\fR.
If an error occurs, \fBTcl_Flush\fR returns \fBTCL_ERROR\fR and
records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.

.SH TCL_SEEK
.PP
\fBTcl_Seek\fR moves the access point in \fIchannel\fR where subsequent
data will be read or written. Buffered output is flushed to the channel and
buffered input is discarded, prior to the seek operation.
.PP
\fBTcl_Seek\fR normally returns the new access point.
If an error occurs, \fBTcl_Seek\fR returns \-1 and records a POSIX error
code that can be retrieved with \fBTcl_GetErrno\fR.
After an error, the access point may or may not have been moved.

.SH TCL_TELL
.PP
\fBTcl_Tell\fR returns the current access point for a channel. The returned
value is \-1 if the channel does not support seeking.

.SH TCL_TRUNCATECHANNEL
.PP
.VS 8.5
\fBTcl_TruncateChannel\fR truncates the file underlying \fIchannel\fR
to a given \fIlength\fR of bytes. It returns \fBTCL_OK\fR if the
operation succeeded, and \fBTCL_ERROR\fR otherwise.
.VE 8.5

.SH TCL_GETCHANNELOPTION
.PP
\fBTcl_GetChannelOption\fR retrieves, in \fIoptionValue\fR, the value of one of
the options currently in effect for a channel, or a list of all options and
their values.  The \fIchannel\fR argument identifies the channel for which
to query an option or retrieve all options and their values.
If \fIoptionName\fR is not NULL, it is the name of the
600
601
602
603
604
605
606

607
608
609
610
611
612
613

614
615
616
617

618
619
620
621
622
623

624
625
626
627
628

629
630
631
632
633

634
635
636
637
638
639
640
641
642
643

644
645

646
647
648
623
624
625
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







+







+




+






+





+

-



+










+


+



These channel type specific options are described in the manual entry for
the Tcl command that creates a channel of that type; for example, the
additional options for TCP based channels are described in the manual entry
for the Tcl \fBsocket\fR command.
The procedure normally returns \fBTCL_OK\fR. If an error occurs, it returns
\fBTCL_ERROR\fR and calls \fBTcl_SetErrno\fR to store an appropriate POSIX
error code.

.SH TCL_SETCHANNELOPTION
.PP
\fBTcl_SetChannelOption\fR sets a new value \fInewValue\fR
for an option \fIoptionName\fR on \fIchannel\fR.
The procedure normally returns \fBTCL_OK\fR.  If an error occurs,
it returns \fBTCL_ERROR\fR;  in addition, if \fIinterp\fR is non-NULL,
\fBTcl_SetChannelOption\fR leaves an error message in the interpreter's result.

.SH TCL_EOF
.PP
\fBTcl_Eof\fR returns a nonzero value if \fIchannel\fR encountered
an end of file during the last input operation.

.SH TCL_INPUTBLOCKED
.PP
\fBTcl_InputBlocked\fR returns a nonzero value if \fIchannel\fR is in
nonblocking mode and the last input operation returned less data than
requested because there was insufficient data available.
The call always returns zero if the channel is in blocking mode.

.SH TCL_INPUTBUFFERED
.PP
\fBTcl_InputBuffered\fR returns the number of bytes of input currently
buffered in the internal buffers for a channel. If the channel is not open
for reading, this function always returns zero.

.SH TCL_OUTPUTBUFFERED
.PP
\fBTcl_OutputBuffered\fR returns the number of bytes of output
currently buffered in the internal buffers for a channel. If the
channel is not open for writing, this function always returns zero.

.SH "PLATFORM ISSUES"
.PP
The handles returned from \fBTcl_GetChannelHandle\fR depend on the
platform and the channel type.  On Unix platforms, the handle is
always a Unix file descriptor as returned from the \fBopen\fR system
call.  On Windows platforms, the handle is a file \fBHANDLE\fR when
the channel was created with \fBTcl_OpenFileChannel\fR,
\fBTcl_OpenCommandChannel\fR, or \fBTcl_MakeFileChannel\fR.  Other
channel types may return a different type of handle on Windows
platforms.

.SH "SEE ALSO"
DString(3), fconfigure(n), filename(n), fopen(3), Tcl_CreateChannel(3)

.SH KEYWORDS
access point, blocking, buffered I/O, channel, channel driver, end of file,
flush, input, nonblocking, output, read, seek, write

Changes to doc/OpenTcp.3.

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
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






-
+




-
+













-
-
-







-
-
-











-
-
-
-
+




-
+


+






+
-
+







'\"
'\" Copyright (c) 1996-7 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_OpenTcpClient 3 8.7 Tcl "Tcl Library Procedures"
.TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_OpenTcpClient, Tcl_MakeTcpClientChannel, Tcl_OpenTcpServer, Tcl_OpenTcpServerEx \- procedures to open channels using TCP sockets
Tcl_OpenTcpClient, Tcl_MakeTcpClientChannel, Tcl_OpenTcpServer \- procedures to open channels using TCP sockets
.SH SYNOPSIS
.nf
\fB#include <tcl.h> \fR
.sp
Tcl_Channel
\fBTcl_OpenTcpClient\fR(\fIinterp, port, host, myaddr, myport, async\fR)
.sp
Tcl_Channel
\fBTcl_MakeTcpClientChannel\fR(\fIsock\fR)
.sp
Tcl_Channel
\fBTcl_OpenTcpServer\fR(\fIinterp, port, myaddr, proc, clientData\fR)
.sp
Tcl_Channel
\fBTcl_OpenTcpServerEx\fR(\fIinterp, service, myaddr, flags, proc, clientData\fR)
.sp
.SH ARGUMENTS
.AS Tcl_TcpAcceptProc clientData
.AP Tcl_Interp *interp in
Tcl interpreter to use for error reporting.  If non-NULL and an
error occurs, an error message is left in the interpreter's result.
.AP int port in
A port number to connect to as a client or to listen on as a server.
.AP "const char" *service in
A string specifying the port number to connect to as a client or to listen on as
 a server.
.AP "const char" *host in
A string specifying a host name or address for the remote end of the connection.
.AP int myport in
A port number for the client's end of the socket.  If 0, a port number
is allocated at random.
.AP "const char" *myaddr in
A string specifying the host name or address for network interface to use
for the local end of the connection.  If NULL, a default interface is
chosen.
.AP int async in
If nonzero, the client socket is connected asynchronously to the server.
.AP "unsigned int" flags in
ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional
informations about the socket being created.
.AP void *sock in
.AP ClientData sock in
Platform-specific handle for client TCP socket.
.AP Tcl_TcpAcceptProc *proc in
Pointer to a procedure to invoke each time a new connection is
accepted via the socket.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.BE

.SH DESCRIPTION
.PP
These functions are convenience procedures for creating
channels that communicate over TCP sockets.
The operations on a channel
are described in the manual entry for \fBTcl_OpenFileChannel\fR.

.SS TCL_OPENTCPCLIENT
.SH TCL_OPENTCPCLIENT
.PP
\fBTcl_OpenTcpClient\fR opens a client TCP socket connected to a \fIport\fR
on a specific \fIhost\fR, and returns a channel that can be used to
communicate with the server. The host to connect to can be specified either
as a domain name style name (e.g. \fBwww.sunlabs.com\fR), or as a string
containing the alphanumeric representation of its four-byte address (e.g.
\fB127.0.0.1\fR). Use the string \fBlocalhost\fR to connect to a TCP socket on
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
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







-
+


+
-
+






-
+


+
-
+









-

-
-
+
+











-
+







NULL and records a POSIX error code that can be retrieved
with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, an error message
is left in the interpreter's result.
.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
If one of the standard channels, \fBstdin, stdout\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 TCL_MAKETCPCLIENTCHANNEL
.SH TCL_MAKETCPCLIENTCHANNEL
.PP
\fBTcl_MakeTcpClientChannel\fR creates a \fBTcl_Channel\fR around an
existing, platform specific, handle for a client TCP socket.
.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
If one of the standard channels, \fBstdin, stdout\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 TCL_OPENTCPSERVER
.SH TCL_OPENTCPSERVER
.PP
\fBTcl_OpenTcpServer\fR opens a TCP socket on the local host on a specified
\fIport\fR and uses the Tcl event mechanism to accept requests from clients
to connect to it. The \fImyaddr\fR argument specifies the network interface.
If \fImyaddr\fR is NULL the special address INADDR_ANY should be used to
allow connections from any network interface.
Each time a client connects to this socket, Tcl creates a channel
for the new connection and invokes \fIproc\fR with information about
the channel. \fIProc\fR must match the following prototype:
.PP
.CS
typedef void \fBTcl_TcpAcceptProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_TcpAcceptProc(
        ClientData \fIclientData\fR,
        Tcl_Channel \fIchannel\fR,
        char *\fIhostName\fR,
        int \fIport\fR);
.CE
.PP
The \fIclientData\fR argument will be the same as the \fIclientData\fR
argument to \fBTcl_OpenTcpServer\fR, \fIchannel\fR will be the handle
for the new channel, \fIhostName\fR points to a string containing
the name of the client host making the connection, and \fIport\fR
will contain the client's port number.
The new channel
is opened for both input and output.
is opened for both input and output. 
If \fIproc\fR raises an error, the connection is closed automatically.
\fIProc\fR has no return value, but if it wishes to reject the
connection it can close \fIchannel\fR.
.PP
\fBTcl_OpenTcpServer\fR normally returns a pointer to a channel
representing the server socket.
If an error occurs, \fBTcl_OpenTcpServer\fR returns NULL and
160
161
162
163
164
165
166
167

168
169
170

171
172
173
174
175
176
177
178
179

180
181

182
183

154
155
156
157
158
159
160

161
162
163

164




165
166
167
168
169
170
171
172
173
174

175







-
+


-
+
-
-
-
-





+


+

-
+
TCP server channels operate correctly only in applications that dispatch
events through \fBTcl_DoOneEvent\fR or through Tcl commands such as
\fBvwait\fR; otherwise Tcl will never notice that a connection request from
a remote client is pending.
.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
If one of the standard channels, \fBstdin, stdout\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 TCL_OPENTCPSERVEREX

.PP
\fBTcl_OpenTcpServerEx\fR behaviour is identical to \fBTcl_OpenTcpServer\fR but
gives more flexibility to the user by providing a mean to further customize some
aspects of the socket via the \fIflags\fR parameter.
.SH "PLATFORM ISSUES"
.PP
On Unix platforms, the socket handle is a Unix file descriptor as
returned by the \fBsocket\fR system call.  On the Windows platform, the
socket handle is a \fBSOCKET\fR as defined in the WinSock API.

.SH "SEE ALSO"
Tcl_OpenFileChannel(3), Tcl_RegisterChannel(3), vwait(n)

.SH KEYWORDS
channel, client, server, socket, TCP
client, server, TCP

Changes to doc/Panic.3.

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

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



-
+





-
+








-
+


-
+













+

+















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






-
+






-
-
-
-
+
+
+
+
+
+



-
+
-
-
-
+
+
+







+
+
+


+


+
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Panic 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\"  Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_Panic, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_Panic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
.sp
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
\fBTcl_PanicVA\fR(\fIformat\fR, \fIargList\fR)
.sp
void
\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
A printf-style format string.
.AP "" arg in
Arguments matching the format string.
.AP va_list argList in
An argument list of arguments matching the format string.
Must have been initialized using \fBva_start\fR,
and cleared using \fBva_end\fR.
.AP Tcl_PanicProc *panicProc in
Procedure to report fatal error message and abort.

.BE

.SH DESCRIPTION
.PP
When the Tcl library detects that its internal data structures are in an
inconsistent state, or that its C procedures have been called in a
manner inconsistent with their documentation, it calls \fBTcl_Panic\fR
to display a message describing the error and abort the process.  The
\fIformat\fR argument is a format string describing how to format the
remaining arguments \fIarg\fR into an error message, according to the
same formatting rules used by the \fBprintf\fR family of functions.  The
same formatting rules are also used by the built-in Tcl command
\fBformat\fR.
.PP
In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted
error message to the standard error file of the process, and then
calls \fBabort\fR to terminate the process.  \fBTcl_Panic\fR does not
return. On Windows, when a debugger is running, the formatted error
return.
message is sent to the debugger instead. If the windows executable
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
system dialog box is used to display the panic message.
.PP
If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
and you want to implicitly use the stderr channel of your
application's C runtime (instead of the stderr channel of the
C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
with \fBTcl_ConsolePanic\fR as its argument. On platforms which
only have one C runtime (almost all platforms except Windows)
\fBTcl_ConsolePanic\fR is equivalent to NULL.
.PP
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
\fBTcl_Panic\fR.  The \fIpanicProc\fR argument should match the
type \fBTcl_PanicProc\fR:
.PP
.CS
typedef void \fBTcl_PanicProc\fR(
typedef void Tcl_PanicProc(
        const char *\fBformat\fR,
        \fBarg\fR, \fBarg\fR,...);
.CE
.PP
After \fBTcl_SetPanicProc\fR returns, any future calls to
\fBTcl_Panic\fR will call \fIpanicProc\fR, passing along the
\fIformat\fR and \fIarg\fR arguments. \fIpanicProc\fR should avoid
making calls into the Tcl library, or into other libraries that may
call the Tcl library, since the original call to \fBTcl_Panic\fR
indicates the Tcl library is not in a state of reliable operation.
\fIformat\fR and \fIarg\fR arguments.  To maintain consistency with the
callers of \fBTcl_Panic\fR, \fIpanicProc\fR must not return; it must
call \fBabort\fR.  \fIpanicProc\fR should avoid making calls into the
Tcl library, or into other libraries that may call the Tcl library,
since the original call to \fBTcl_Panic\fR indicates the Tcl library is
not in a state of reliable operation.  
.PP
The typical use of \fBTcl_SetPanicProc\fR arranges for the error message
to be displayed or reported in a manner more suitable for the
application or the platform.
application or the platform.  As an example, the Windows implementation
.PP
\fBTcl_SetPanicProc\fR can not be used safely by stub-enabled extensions, so its
symbol is not included in the stub table.
of \fBwish\fR calls \fBTcl_SetPanicProc\fR to force all panic messages
to be displayed in a system dialog box, rather than to be printed to the
standard error file (usually not visible under Windows).
.PP
Although the primary callers of \fBTcl_Panic\fR are the procedures of
the Tcl library, \fBTcl_Panic\fR is a public function and may be called
by any extension or application that wishes to abort the process and
have a panic message displayed the same way that panic messages from Tcl
will be displayed.
.PP
\fBTcl_PanicVA\fR is the same as \fBTcl_Panic\fR except that instead of
taking a variable number of arguments it takes an argument list.

.SH "SEE ALSO"
abort(3), printf(3), exec(n), format(n)

.SH KEYWORDS
abort, fatal, error

Deleted doc/ParseArgs.3.

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






































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 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.
'\"
.TH Tcl_ParseArgsObjv 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_ParseArgsObjv \- parse arguments according to a tabular description
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_ParseArgsObjv\fR(\fIinterp, argTable, objcPtr, objv, remObjv\fR)
.SH ARGUMENTS
.AS "const Tcl_ArgvInfo" ***remObjv in/out
.AP Tcl_Interp *interp out
Where to store error messages.
.AP "const Tcl_ArgvInfo" *argTable in
Pointer to array of option descriptors.
.AP int *objcPtr in/out
A pointer to variable holding number of arguments in \fIobjv\fR. Will be
modified to hold number of arguments left in the unprocessed argument list
stored in \fIremObjv\fR.
.AP "Tcl_Obj *const" *objv in
The array of arguments to be parsed.
.AP Tcl_Obj ***remObjv out
Pointer to a variable that will hold the array of unprocessed arguments.
Should be NULL if no return of unprocessed arguments is required. If
\fIobjcPtr\fR is updated to a non-zero value, the array returned through this
must be deallocated using \fBTcl_Free\fR.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_ParseArgsObjv\fR function provides a system for parsing argument
lists of the form
.QW "\fB\-someName \fIsomeValue\fR ..." .
Such argument lists are commonly found both in the arguments to a program and
in the arguments to an individual Tcl command. This parser assumes that the
order of the arguments does not matter, other than in so far as later copies
of a duplicated option overriding earlier ones.
.PP
The argument array is described by the \fIobjcPtr\fR and \fIobjv\fR
parameters, and an array of unprocessed arguments is returned through the
\fIobjcPtr\fR and \fIremObjv\fR parameters; if no return of unprocessed
arguments is desired, the \fIremObjv\fR parameter should be NULL. If any
problems happen, including if the
.QW "generate help"
option is selected, an error message is left in the interpreter result and
TCL_ERROR is returned. Otherwise, the interpreter result is left unchanged and
TCL_OK is returned.
.PP
The collection of arguments to be parsed is described by the \fIargTable\fR
parameter. This points to a table of descriptor structures that is terminated
by an entry with the \fItype\fR field set to TCL_ARGV_END. As convenience, the
following prototypical entries are provided:
.TP
\fBTCL_ARGV_AUTO_HELP\fR
.
Enables the argument processor to provide help when passed the argument
.QW \fB\-help\fR .
.TP
\fBTCL_ARGV_AUTO_REST\fR
.
Instructs the argument processor that arguments after
.QW \fB\-\-\fR
are to be unprocessed.
.TP
\fBTCL_ARGV_TABLE_END\fR
.
Marks the end of the table of argument descriptors.
.SS "ARGUMENT DESCRIPTOR ENTRIES"
.PP
Each entry of the argument descriptor table must be a structure of type
\fBTcl_ArgvInfo\fR. The structure is defined as this:
.PP
.CS
typedef struct {
    int \fItype\fR;
    const char *\fIkeyStr\fR;
    void *\fIsrcPtr\fR;
    void *\fIdstPtr\fR;
    const char *\fIhelpStr\fR;
    void *\fIclientData\fR;
} \fBTcl_ArgvInfo\fR;
.CE
.PP
The \fIkeyStr\fR field contains the name of the option; by convention, this
will normally begin with a
.QW \fB\-\fR
character. The \fItype\fR, \fIsrcPtr\fR, \fIdstPtr\fR and \fIclientData\fR
fields describe the interpretation of the value of the argument, as described
below. The \fIhelpStr\fR field gives some text that is used to provide help to
users when they request it.
.PP
As noted above, the \fItype\fR field is used to describe the interpretation of
the argument's value. The following values are acceptable values for
\fItype\fR:
.TP
\fBTCL_ARGV_CONSTANT\fR
.
The argument does not take any following value argument. If this argument is
present, the (integer) value of the \fIsrcPtr\fR field is copied to the variable
pointed to by the \fIdstPtr\fR field. The \fIclientData\fR field is ignored.
.TP
\fBTCL_ARGV_END\fR
.
This value marks the end of all option descriptors in the table. All other
fields are ignored.
.TP
\fBTCL_ARGV_FLOAT\fR
.
This argument takes a following floating point value argument. The value (once
parsed by \fBTcl_GetDoubleFromObj\fR) will be stored as a double-precision
value in the variable pointed to by the \fIdstPtr\fR field. The \fIsrcPtr\fR
and \fIclientData\fR fields are ignored.
.TP
\fBTCL_ARGV_FUNC\fR
.
This argument optionally takes a following value argument; it is up to the
handler callback function passed in \fIsrcPtr\fR to decide. That function will
have the following signature:
.RS
.PP
.CS
typedef int (\fBTcl_ArgvFuncProc\fR)(
        void *\fIclientData\fR,
        Tcl_Obj *\fIobjPtr\fR,
        void *\fIdstPtr\fR);
.CE
.PP
The result is a boolean value indicating whether to consume the following
argument. The \fIclientData\fR is the value from the table entry, the
\fIobjPtr\fR is the value that represents the following argument or NULL if
there are no following arguments at all, and the \fIdstPtr\fR argument to the
\fBTcl_ArgvFuncProc\fR is the location to write the parsed value to.
.RE
.TP
\fBTCL_ARGV_GENFUNC\fR
.
This argument takes zero or more following arguments; the handler callback
function passed in \fIsrcPtr\fR returns how many (or a negative number to
signal an error, in which case it should also set the interpreter result). The
function will have the following signature:
.RS
.PP
.CS
typedef int (\fBTcl_ArgvGenFuncProc\fR)(
        void *\fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        int \fIobjc\fR,
        Tcl_Obj *const *\fIobjv\fR,
        void *\fIdstPtr\fR);
.CE
.PP
The \fIclientData\fR is the value from the table entry, the \fIinterp\fR is
where to store any error messages, the \fIkeyStr\fR is the name of the
argument, \fIobjc\fR and \fIobjv\fR describe an array of all the remaining
arguments, and \fIdstPtr\fR argument to the \fBTcl_ArgvGenFuncProc\fR is the
location to write the parsed value (or values) to.
.RE
.TP
\fBTCL_ARGV_HELP\fR
.
This special argument does not take any following value argument, but instead
causes \fBTcl_ParseArgsObjv\fR to generate an error message describing the
arguments supported. All other fields except the \fIhelpStr\fR field are
ignored.
.TP
\fBTCL_ARGV_INT\fR
.
This argument takes a following integer value argument. The value (once parsed
by \fBTcl_GetIntFromObj\fR) will be stored as an int in the variable pointed
to by the \fIdstPtr\fR field. The \fIsrcPtr\fR field is ignored.
.TP
\fBTCL_ARGV_REST\fR
.
This special argument does not take any following value argument, but instead
marks all following arguments to be left unprocessed. The \fIsrcPtr\fR,
\fIdstPtr\fR and \fIclientData\fR fields are ignored.
.TP
\fBTCL_ARGV_STRING\fR
.
This argument takes a following string value argument. A pointer to the string
will be stored at \fIdstPtr\fR; the string inside will have a lifetime linked
to the lifetime of the string representation of the argument value that it
came from, and so should be copied if it needs to be retained. The
\fIsrcPtr\fR and \fIclientData\fR fields are ignored.
.SH "SEE ALSO"
Tcl_GetIndexFromObj(3), Tcl_Main(3), Tcl_CreateObjCommand(3)
.SH KEYWORDS
argument, parse
'\" Local Variables:
'\" fill-column: 78
'\" End:

Changes to doc/ParseCmd.3.

1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5

6
7
8
9
10

11
12
13
14
15
16
17
18





-
+




-
+







'\"
'\" Copyright (c) 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.
'\"
'\" 
.TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_ParseCommand\fR(\fIinterp, start, numBytes, nested, parsePtr\fR)
.sp
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
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







+
+
+





-
-
+
+

+
-
-
+
+









-
+







\fBTcl_ParseVarName\fR(\fIinterp, start, numBytes, parsePtr, append\fR)
.sp
const char *
\fBTcl_ParseVar\fR(\fIinterp, start, termPtr\fR)
.sp
\fBTcl_FreeParse\fR(\fIusedParsePtr\fR)
.sp
Tcl_Obj *
\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR)
.sp
int
\fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR)
.SH ARGUMENTS
.AS Tcl_Interp *usedParsePtr out
.AP Tcl_Interp *interp out
For procedures other than \fBTcl_FreeParse\fR and
\fBTcl_EvalTokensStandard\fR, used only for error reporting;
For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR
and \fBTcl_EvalTokensStandard\fR, used only for error reporting;
if NULL, then no error messages are left after errors.
For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR,
For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating
the script and also is used for error reporting; must not be NULL.
determines the context for evaluating the
script and also is used for error reporting; must not be NULL.
.AP "const char" *start in
Pointer to first character in string to parse.
.AP int numBytes in
Number of bytes in string to parse, not including any terminating null
character.  If less than 0 then the script consists of all characters
following \fIstart\fR up to the first null character.
.AP int nested in
Non-zero means that the script is part of a command substitution so an
unquoted close bracket should be treated as a command terminator.  If zero,
close brackets have no special meaning.
close brackets have no special meaning. 
.AP int append in
Non-zero means that \fI*parsePtr\fR already contains valid tokens; the new
tokens should be appended to those already present.  Zero means that
\fI*parsePtr\fR is uninitialized; any information in it is ignored.
This argument is normally 0.
.AP Tcl_Parse *parsePtr out
Points to structure to fill in with information about the parsed
72
73
74
75
76
77
78

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







+







just after the terminating character (the close-brace, the last
character of the variable name, or the close-quote (respectively))
if the parse was successful.
.AP Tcl_Parse *usedParsePtr in
Points to structure that was filled in by a previous call to
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseVarName\fR, etc.
.BE

.SH DESCRIPTION
.PP
These procedures parse Tcl commands or portions of Tcl commands such as
expressions or references to variables.
Each procedure takes a pointer to a script (or portion thereof)
and fills in the structure pointed to by \fIparsePtr\fR
with a collection of tokens describing the information that was parsed.
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
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







-
+















-
+















-
+







\fBTCL_ERROR\fR is returned, an error message is left in \fIinterp\fR's
result, and no information is left at \fI*parsePtr\fR.
.PP
\fBTcl_ParseBraces\fR parses a string or command argument
enclosed in braces such as
\fB{hello}\fR or \fB{string \et with \et tabs}\fR
from the beginning of its argument \fIstart\fR.
The first character of \fIstart\fR must be \fB{\fR.
The first character of \fIstart\fR must be \fB{\fR. 
If the braced string was parsed successfully,
\fBTcl_ParseBraces\fR returns \fBTCL_OK\fR,
fills in the structure pointed to by \fIparsePtr\fR
with information about the structure of the string
(see below for details),
and stores a pointer to the character just after the terminating \fB}\fR
in the location given by \fI*termPtr\fR.
If an error occurs while parsing the string
then \fBTCL_ERROR\fR is returned,
an error message is left in \fIinterp\fR's result,
and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
.PP
\fBTcl_ParseQuotedString\fR parses a double-quoted string such as
\fB"sum is [expr {$a+$b}]"\fR
from the beginning of the argument \fIstart\fR.
The first character of \fIstart\fR must be \fB\N'34'\fR.
The first character of \fIstart\fR must be \fB\N'34'\fR. 
If the double-quoted string was parsed successfully,
\fBTcl_ParseQuotedString\fR returns \fBTCL_OK\fR,
fills in the structure pointed to by \fIparsePtr\fR
with information about the structure of the string
(see below for details),
and stores a pointer to the character just after the terminating \fB\N'34'\fR
in the location given by \fI*termPtr\fR.
If an error occurs while parsing the string
then \fBTCL_ERROR\fR is returned,
an error message is left in \fIinterp\fR's result,
and no information is left at \fI*parsePtr\fR or \fI*termPtr\fR.
.PP
\fBTcl_ParseVarName\fR parses a Tcl variable reference such as
\fB$abc\fR or \fB$x([expr {$index + 1}])\fR from the beginning of its
\fIstart\fR argument.
The first character of \fIstart\fR must be \fB$\fR.
The first character of \fIstart\fR must be \fB$\fR. 
If a variable name was parsed successfully, \fBTcl_ParseVarName\fR
returns \fBTCL_OK\fR and fills in the structure pointed to by
\fIparsePtr\fR with information about the structure of the variable name
(see below for details).  If an error
occurs while parsing the command then \fBTCL_ERROR\fR is returned, an
error message is left in \fIinterp\fR's result (if \fIinterp\fR is not
NULL), and no information is left at \fI*parsePtr\fR.
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
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







-
+






+
+
+
+
+
+
+
+
+
+
+





-


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


-
-
-
-
-
+
+
+
+
+

















-
+







then \fBTcl_FreeParse\fR must be invoked once after each call.
.PP
\fBTcl_EvalTokensStandard\fR evaluates a sequence of parse tokens from
a Tcl_Parse structure.  The tokens typically consist
of all the tokens in a word or all the tokens that make up the index for
a reference to an array variable.  \fBTcl_EvalTokensStandard\fR performs the
substitutions requested by the tokens and concatenates the
resulting values.
resulting values. 
The return value from \fBTcl_EvalTokensStandard\fR is a Tcl completion
code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR,
\fBTCL_RETURN\fR, \fBTCL_BREAK\fR, or \fBTCL_CONTINUE\fR, or possibly
some other integer value originating in an extension.
In addition, a result value or error message is left in \fIinterp\fR's
result; it can be retrieved using \fBTcl_GetObjResult\fR.
.PP
\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in
the return convention used: it returns the result in a new Tcl_Obj.
The reference count of the object returned as result has been
incremented, so the caller must
invoke \fBTcl_DecrRefCount\fR when it is finished with the object.
If an error or other exception occurs while evaluating the tokens
(such as a reference to a non-existent variable) then the return value
is NULL and an error message is left in \fIinterp\fR's result. The use
of \fBTcl_EvalTokens\fR is deprecated.

.SH "TCL_PARSE STRUCTURE"
.PP
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR
return parse information in two data structures, Tcl_Parse and Tcl_Token:
.PP
.CS
typedef struct Tcl_Parse {
    const char *\fIcommentStart\fR;
    int \fIcommentSize\fR;
    const char *\fIcommandStart\fR;
    int \fIcommandSize\fR;
    int \fInumWords\fR;
    Tcl_Token *\fItokenPtr\fR;
    int \fInumTokens\fR;
    ...
} \fBTcl_Parse\fR;
        const char *\fIcommentStart\fR;
        int \fIcommentSize\fR;
        const char *\fIcommandStart\fR;
        int \fIcommandSize\fR;
        int \fInumWords\fR;
        Tcl_Token *\fItokenPtr\fR;
        int \fInumTokens\fR;
        ...
} Tcl_Parse;

typedef struct Tcl_Token {
    int \fItype\fR;
    const char *\fIstart\fR;
    size_t \fIsize\fR;
    size_t \fInumComponents\fR;
} \fBTcl_Token\fR;
        int \fItype\fR;
        const char *\fIstart\fR;
        int \fIsize\fR;
        int \fInumComponents\fR;
} Tcl_Token;
.CE
.PP
The first five fields of a Tcl_Parse structure
are filled in only by \fBTcl_ParseCommand\fR.
These fields are not used by the other parsing procedures.
.PP
\fBTcl_ParseCommand\fR fills in a Tcl_Parse structure
with information that describes one Tcl command and any comments that
precede the command.
If there are comments,
the \fIcommentStart\fR field points to the \fB#\fR character that begins
the first comment and \fIcommentSize\fR indicates the number of bytes
in all of the comments preceding the command, including the newline
character that terminates the last comment.
If the command is not preceded by any comments, \fIcommentSize\fR is 0.
\fBTcl_ParseCommand\fR also sets the \fIcommandStart\fR field
to point to the first character of the first
word in the command (skipping any comments and leading space) and
word in the command (skipping any comments and leading space) and 
\fIcommandSize\fR gives the total number of bytes in the command,
including the character pointed to by \fIcommandStart\fR up to and
including the newline, close bracket, or semicolon character that
terminates the command.  The \fInumWords\fR field gives the
total number of words in the command.
.PP
All parsing procedures set the remaining fields,
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
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







-














-





-
+






+


-




-




-







-















-



















-
+






-







gives the total number of characters in the token.  Some token types,
such as \fBTCL_TOKEN_WORD\fR and \fBTCL_TOKEN_VARIABLE\fR, consist of
several component tokens, which immediately follow the parent token;
the \fInumComponents\fR field describes how many of these there are.
The \fItype\fR field has one of the following values:
.TP 20
\fBTCL_TOKEN_WORD\fR
.
This token ordinarily describes one word of a command
but it may also describe a quoted or braced string in an expression.
The token describes a component of the script that is
the result of concatenating together a sequence of subcomponents,
each described by a separate subtoken.
The token starts with the first non-blank
character of the component (which may be a double-quote or open brace)
and includes all characters in the component up to but not including the
space, semicolon, close bracket, close quote, or close brace that
terminates the component.  The \fInumComponents\fR field counts the total
number of sub-tokens that make up the word, including sub-tokens
of \fBTCL_TOKEN_VARIABLE\fR and \fBTCL_TOKEN_BS\fR tokens.
.TP
\fBTCL_TOKEN_SIMPLE_WORD\fR
.
This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that
the word is guaranteed to consist of a single \fBTCL_TOKEN_TEXT\fR
sub-token.  The \fInumComponents\fR field is always 1.
.TP
\fBTCL_TOKEN_EXPAND_WORD\fR
.
.VS 8.5
This token has the same meaning as \fBTCL_TOKEN_WORD\fR, except that
the command parser notes this word began with the expansion
prefix \fB{*}\fR, indicating that after substitution,
the list value of this word should be expanded to form multiple
arguments in command evaluation.  This
token type can only be created by Tcl_ParseCommand.
.VE 8.5
.TP
\fBTCL_TOKEN_TEXT\fR
.
The token describes a range of literal text that is part of a word.
The \fInumComponents\fR field is always 0.
.TP
\fBTCL_TOKEN_BS\fR
.
The token describes a backslash sequence such as \fB\en\fR or \fB\e0xA3\fR.
The \fInumComponents\fR field is always 0.
.TP
\fBTCL_TOKEN_COMMAND\fR
.
The token describes a command whose result must be substituted into
the word.  The token includes the square brackets that surround the
command.  The \fInumComponents\fR field is always 0 (the nested command
is not parsed; call \fBTcl_ParseCommand\fR recursively if you want to
see its tokens).
.TP
\fBTCL_TOKEN_VARIABLE\fR
.
The token describes a variable substitution, including the
\fB$\fR, variable name, and array index (if there is one) up through the
close parenthesis that terminates the index.  This token is followed
by one or more additional tokens that describe the variable name and
array index.  If \fInumComponents\fR  is 1 then the variable is a
scalar and the next token is a \fBTCL_TOKEN_TEXT\fR token that gives the
variable name.  If \fInumComponents\fR is greater than 1 then the
variable is an array: the first sub-token is a \fBTCL_TOKEN_TEXT\fR
token giving the array name and the remaining sub-tokens are
\fBTCL_TOKEN_TEXT\fR, \fBTCL_TOKEN_BS\fR, \fBTCL_TOKEN_COMMAND\fR, and
\fBTCL_TOKEN_VARIABLE\fR tokens that must be concatenated to produce the
array index. The \fInumComponents\fR field includes nested sub-tokens
that are part of \fBTCL_TOKEN_VARIABLE\fR tokens in the array index.
.TP
\fBTCL_TOKEN_SUB_EXPR\fR
.
The token describes one subexpression of an expression
(or an entire expression).
A subexpression may consist of a value
such as an integer literal, variable substitution,
or parenthesized subexpression;
it may also consist of an operator and its operands.
The token starts with the first non-blank character of the subexpression
up to but not including the space, brace, close-paren, or bracket
that terminates the subexpression.
This token is followed by one or more additional tokens
that describe the subexpression.
If the first sub-token after the \fBTCL_TOKEN_SUB_EXPR\fR token
is a \fBTCL_TOKEN_OPERATOR\fR token,
the subexpression consists of an operator and its token operands.
If the operator has no operands, the subexpression consists of
just the \fBTCL_TOKEN_OPERATOR\fR token.
Each operand is described by a \fBTCL_TOKEN_SUB_EXPR\fR token.
Otherwise, the subexpression is a value described by
one of the token types \fBTCL_TOKEN_WORD\fR, \fBTCL_TOKEN_TEXT\fR,
\fBTCL_TOKEN_BS\fR, \fBTCL_TOKEN_COMMAND\fR,
\fBTCL_TOKEN_BS\fR, \fBTCL_TOKEN_COMMAND\fR, 
\fBTCL_TOKEN_VARIABLE\fR, and \fBTCL_TOKEN_SUB_EXPR\fR.
The \fInumComponents\fR field
counts the total number of sub-tokens that make up the subexpression;
this includes the sub-tokens for any nested \fBTCL_TOKEN_SUB_EXPR\fR tokens.
.TP
\fBTCL_TOKEN_OPERATOR\fR
.
The token describes one operator of an expression
such as \fB&&\fR or \fBhypot\fR.
A \fBTCL_TOKEN_OPERATOR\fR token is always preceded by a
\fBTCL_TOKEN_SUB_EXPR\fR token
that describes the operator and its operands;
the \fBTCL_TOKEN_SUB_EXPR\fR token's \fInumComponents\fR field
can be used to determine the number of operands.
371
372
373
374
375
376
377

378

379
380
381
382
383
384
385

386
387
388
389
390
391
392
379
380
381
382
383
384
385
386

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402







+
-
+







+







\fIx\fR, \fIy\fR, and \fIz\fR.
The \fInumComponents\fR field for a \fBTCL_TOKEN_OPERATOR\fR token
is always 0.
.PP
After \fBTcl_ParseCommand\fR returns, the first token pointed to by
the \fItokenPtr\fR field of the
Tcl_Parse structure always has type \fBTCL_TOKEN_WORD\fR or
.VS 8.5
\fBTCL_TOKEN_SIMPLE_WORD\fR or \fBTCL_TOKEN_EXPAND_WORD\fR.
\fBTCL_TOKEN_SIMPLE_WORD\fR or \fBTCL_TOKEN_EXPAND_WORD\fR.  
It is followed by the sub-tokens
that must be concatenated to produce the value of that word.
The next token is the \fBTCL_TOKEN_WORD\fR or \fBTCL_TOKEN_SIMPLE_WORD\fR
of \fBTCL_TOKEN_EXPAND_WORD\fR token for the second word,
followed by sub-tokens for that
word, and so on until all \fInumWords\fR have been accounted
for.
.VE 8.5
.PP
After \fBTcl_ParseExpr\fR returns, the first token pointed to by
the \fItokenPtr\fR field of the
Tcl_Parse structure always has type \fBTCL_TOKEN_SUB_EXPR\fR.
It is followed by the sub-tokens that must be evaluated
to produce the value of the expression.
Only the token information in the Tcl_Parse structure
445
446
447
448
449
450
451

452
453
455
456
457
458
459
460
461
462
463
464







+


\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR.
.PP
There are additional fields in the Tcl_Parse structure after the
\fInumTokens\fR field, but these are for the private use of
\fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR,
\fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVarName\fR; they should not be
referenced by code outside of these procedures.

.SH KEYWORDS
backslash substitution, braces, command, expression, parse, token, variable substitution

Changes to doc/PkgRequire.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_PkgRequire 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_PkgRequire, Tcl_PkgRequireEx, Tcl_PkgRequireProc, Tcl_PkgPresent, Tcl_PkgPresentEx, Tcl_PkgProvide, Tcl_PkgProvideEx \- package version control
.SH SYNOPSIS
.nf
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
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









-
+













-
+

-
+


-
+
-





+















-
-
+
+














+


-
-
.sp
int
\fBTcl_PkgProvide\fR(\fIinterp, name, version\fR)
.sp
int
\fBTcl_PkgProvideEx\fR(\fIinterp, name, version, clientData\fR)
.SH ARGUMENTS
.AS void *clientDataPtr out
.AS ClientData clientDataPtr out
.AP Tcl_Interp *interp in
Interpreter where package is needed or available.
.AP "const char" *name in
Name of package.
.AP "const char" *version in
A version string consisting of one or more decimal numbers
separated by dots.
.AP int exact in
Non-zero means that only the particular version specified by
\fIversion\fR is acceptable.
Zero means that newer versions than \fIversion\fR are also
acceptable as long as they have the same major version number
as \fIversion\fR.
.AP "const void" *clientData in
.AP ClientData clientData in
Arbitrary value to be associated with the package.
.AP void *clientDataPtr out
.AP ClientData *clientDataPtr out
Pointer to place to store the value associated with the matching
package. It is only changed if the pointer is not NULL and the
function completed successfully. The storage can be any pointer
function completed successfully.
type with the same size as a void pointer.
.AP int objc in
Number of requirements.
.AP Tcl_Obj* objv[] in
Array of requirements.
.BE

.SH DESCRIPTION
.PP
These procedures provide C-level interfaces to Tcl's package and
version management facilities.
.PP
\fBTcl_PkgRequire\fR is equivalent to the \fBpackage require\fR
command, \fBTcl_PkgPresent\fR is equivalent to the \fBpackage present\fR
command, and \fBTcl_PkgProvide\fR is equivalent to the
\fBpackage provide\fR command.
.PP
See the documentation for the Tcl commands for details on what these
procedures do.
.PP
If \fBTcl_PkgPresent\fR or \fBTcl_PkgRequire\fR complete successfully
they return a pointer to the version string for the version of the package
that is provided in the interpreter (which may be different than
\fIversion\fR); if an error occurs they return NULL and leave an error
that is provided in the interpreter (which may be different than 
\fIversion\fR); if an error occurs they return NULL and leave an error 
message in the interpreter's result.
.PP
\fBTcl_PkgProvide\fR returns \fBTCL_OK\fR if it completes successfully;
if an error occurs it returns \fBTCL_ERROR\fR and leaves an error message
in the interpreter's result.
.PP
\fBTcl_PkgProvideEx\fR, \fBTcl_PkgPresentEx\fR and \fBTcl_PkgRequireEx\fR
allow the setting and retrieving of the client data associated with
the package. In all other respects they are equivalent to the matching
functions.
.PP
\fBTcl_PkgRequireProc\fR is the form of \fBpackage require\fR handling
multiple requirements. The other forms are present for backward
compatibility and translate their invocations to this form.

.SH KEYWORDS
package, present, provide, require, version
.SH "SEE ALSO"
package(n), Tcl_StaticPackage(3)

Changes to doc/Preserve.3.

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
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






-
+
















-
+





+







'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Preserve, Tcl_Release, Tcl_EventuallyFree \- avoid freeing storage while it is being used
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_Preserve\fR(\fIclientData\fR)
.sp
\fBTcl_Release\fR(\fIclientData\fR)
.sp
\fBTcl_EventuallyFree\fR(\fIclientData, freeProc\fR)
.SH ARGUMENTS
.AS Tcl_FreeProc clientData
.AP void *clientData in
.AP ClientData clientData in
Token describing structure to be freed or reallocated.  Usually a pointer
to memory for structure.
.AP Tcl_FreeProc *freeProc in
Procedure to invoke to free \fIclientData\fR.
.BE

.SH DESCRIPTION
.PP
These three procedures help implement a simple reference count mechanism
for managing storage.  They are designed to solve a problem
having to do with widget deletion, but are also useful in many other
situations.  When a widget is deleted, its
widget record (the structure holding information specific to the
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
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







-

-
-
+

-








-
+












+


+


When all calls to \fBTcl_Preserve\fR have been matched with
calls to \fBTcl_Release\fR then \fIfreeProc\fR will be called by
\fBTcl_Release\fR to do the cleanup.
.PP
All the work of freeing the object is carried out by \fIfreeProc\fR.
\fIFreeProc\fR must have arguments and result that match the
type \fBTcl_FreeProc\fR:
.PP
.CS
typedef void \fBTcl_FreeProc\fR(
        char *\fIblockPtr\fR);
typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
.CE
.PP
The \fIblockPtr\fR argument to \fIfreeProc\fR will be the
same as the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR.
The type of \fIblockPtr\fR (\fBchar *\fR) is different than the type of the
\fIclientData\fR argument to \fBTcl_EventuallyFree\fR for historical
reasons, but the value is the same.
.PP
When the \fIclientData\fR argument to \fBTcl_EventuallyFree\fR
refers to storage allocated and returned by a prior call to
\fBTcl_Alloc\fR or another function of the Tcl library,
\fBTcl_Alloc\fR, \fBckalloc\fR, or another function of the Tcl library,
then the \fIfreeProc\fR argument should be given the special value of
\fBTCL_DYNAMIC\fR.
.PP
This mechanism can be used to solve the problem described above
by placing \fBTcl_Preserve\fR and \fBTcl_Release\fR calls around
actions that may cause undesired storage re-allocation.  The
mechanism is intended only for short-term use (i.e. while procedures
are pending on the stack);  it will not work efficiently as a
mechanism for long-term reference counts.
The implementation does not depend in any way on the internal
structure of the objects being freed;  it keeps the reference
counts in a separate structure.

.SH "SEE ALSO"
Tcl_Interp, Tcl_Alloc

.SH KEYWORDS
free, reference count, storage

Changes to doc/PrintDbl.3.

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
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






-
+













+
-
+
+
+






+












+

+
+
-
+



+
+


'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_PrintDouble \- Convert floating value to string
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_PrintDouble\fR(\fIinterp, value, dst\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp out
.AP Tcl_Interp *interp in
Before Tcl 8.0, the \fBtcl_precision\fR variable in this interpreter
This argument is ignored.
controlled the conversion.  As of Tcl 8.0, this argument is ignored and
the conversion is controlled by the \fBtcl_precision\fR variable
that is now shared by all interpreters.
.AP double value in
Floating-point value to be converted.
.AP char *dst out
Where to store the string representing \fIvalue\fR.  Must have at
least \fBTCL_DOUBLE_SPACE\fR characters of storage.
.BE

.SH DESCRIPTION
.PP
\fBTcl_PrintDouble\fR generates a string that represents the value
of \fIvalue\fR and stores it in memory at the location given by
\fIdst\fR.  It uses \fB%g\fR format to generate the string, with one
special twist: the string is guaranteed to contain either a
.QW .
or an
.QW e
so that it does not look like an integer.  Where \fB%g\fR would
generate an integer with no decimal point, \fBTcl_PrintDouble\fR adds
.QW .0 .
.VS 8.5
.PP
If the \fBtcl_precision\fR value is non-zero, the result will have
precisely that many digits of significance.  If the value is zero
The result will have the fewest digits needed to
(the default), the result will have the fewest digits needed to
represent the number in such a way that \fBTcl_NewDoubleObj\fR
will generate the same number when presented with the given string.
IEEE semantics of rounding to even apply to the conversion.
.VE

.SH KEYWORDS
conversion, double-precision, floating-point, string

Changes to doc/RecEvalObj.3.

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

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





-
+
















-
+










-
+
+
+

-
+














-
+
'\"
'\" Copyright (c) 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.
'\"
'\" 
.TH Tcl_RecordAndEvalObj 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RecordAndEvalObj \- save command on history list before evaluating
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_RecordAndEvalObj\fR(\fIinterp, cmdPtr, flags\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Tcl interpreter in which to evaluate command.
.AP Tcl_Obj *cmdPtr in
Points to a Tcl value containing a command (or sequence of commands)
Points to a Tcl object containing a command (or sequence of commands)
to execute.
.AP int flags in
An OR'ed combination of flag bits.  \fBTCL_NO_EVAL\fR means record the
command but do not evaluate it.  \fBTCL_EVAL_GLOBAL\fR means evaluate
the command at global level instead of the current stack level.
.BE

.SH DESCRIPTION
.PP
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
on the history list and then execute it using \fBTcl_EvalObjEx\fR.
on the history list and then execute it using \fBTcl_EvalObjEx\fR
(or \fBTcl_GlobalEvalObj\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set
in \fIflags\fR).
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
as well as a result value containing additional information
as well as a result object containing additional information
(a result value or error message)
that can be retrieved using \fBTcl_GetObjResult\fR.
If you do not want the command recorded on the history list then
you should invoke \fBTcl_EvalObjEx\fR instead of \fBTcl_RecordAndEvalObj\fR.
Normally \fBTcl_RecordAndEvalObj\fR is only called with top-level
commands typed by the user, since the purpose of history is to
allow the user to re-issue recently invoked commands.
If the \fIflags\fR argument contains the \fBTCL_NO_EVAL\fR bit then
the command is recorded without being evaluated.

.SH "SEE ALSO"
Tcl_EvalObjEx, Tcl_GetObjResult

.SH KEYWORDS
command, event, execute, history, interpreter, value, record
command, event, execute, history, interpreter, object, record

Changes to doc/RecordEval.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RecordAndEval \- save command on history list before evaluating
.SH SYNOPSIS
.nf
40
41
42
43
44
45
46
47
48
49



50
51
52
53
54
55
40
41
42
43
44
45
46



47
48
49
50
51
52
53
54
55







-
-
-
+
+
+






Normally \fBTcl_RecordAndEval\fR is only called with top-level
commands typed by the user, since the purpose of history is to
allow the user to re-issue recently-invoked commands.
If the \fIflags\fR argument contains the \fBTCL_NO_EVAL\fR bit then
the command is recorded without being evaluated.
.PP
Note that \fBTcl_RecordAndEval\fR has been largely replaced by the
value-based procedure \fBTcl_RecordAndEvalObj\fR.
That value-based procedure records and optionally executes
a command held in a Tcl value instead of a string.
object-based procedure \fBTcl_RecordAndEvalObj\fR.
That object-based procedure records and optionally executes
a command held in a Tcl object instead of a string.

.SH "SEE ALSO"
Tcl_RecordAndEvalObj

.SH KEYWORDS
command, event, execute, history, interpreter, record

Changes to doc/RegConfig.3.

22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
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







-
+









+







.AP Tcl_Interp *interp in
Refers to the interpreter the embedded configuration information is
registered for. Must not be NULL.
.AP "const char" *pkgName in
Contains the name of the package registering the embedded
configuration as ASCII string. This means that this information is in
UTF-8 too. Must not be NULL.
.AP "const Tcl_Config" *configuration in
.AP Tcl_Config *configuration in
Refers to an array of Tcl_Config entries containing the information
embedded in the binary library. Must not be NULL. The end of the array
is signaled by either a key identical to NULL, or a key referring to
the empty string.
.AP "const char" *valEncoding in
Contains the name of the encoding used to store the configuration
values as ASCII string. This means that this information is in UTF-8
too. Must not be NULL.
.BE

.SH DESCRIPTION
.PP
The function described here has its base in TIP 59 and provides
extensions with support for the embedding of configuration
information into their binary library and the generation of a
Tcl-level interface for querying this information.
.PP
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
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







-
+




















-
-
-
+
+
+





.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
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
::\fIpkgName\fR::\fBpkgconfig\fR list
Returns a list containing the names of all defined keys.
.TP
::\fIpkgName\fR::\fBpkgconfig\fR get \fIkey\fR
Returns the configuration value associated with the specified
\fIkey\fR.
.RE
.SH TCL_CONFIG
.PP
The \fBTcl_Config\fR structure contains the following fields:
.PP
.CS
typedef struct Tcl_Config {
    const char *\fIkey\fR;
    const char *\fIvalue\fR;
} \fBTcl_Config\fR;
    const char* key;
    const char* value;
} Tcl_Config;
.CE
.\" No cross references yet.
.\" .SH "SEE ALSO"
.SH KEYWORDS
embedding, configuration, binary library

Changes to doc/RegExp.3.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_RegExpMatch 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_RegExpMatch, Tcl_RegExpCompile, Tcl_RegExpExec, Tcl_RegExpRange, Tcl_GetRegExpFromObj, Tcl_RegExpMatchObj, Tcl_RegExpExecObj, Tcl_RegExpGetInfo \- Pattern matching with regular expressions
.SH SYNOPSIS
.nf
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
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







-
-
+
+


-
-
+
+













-
+















-
+



-
+


-
+















-
+






-
-
+
+







.fi
.SH ARGUMENTS
.AS Tcl_RegExpInfo *interp in/out
.AP Tcl_Interp *interp in
Tcl interpreter to use for error reporting.  The interpreter may be
NULL if no error reporting is desired.
.AP Tcl_Obj *textObj in/out
Refers to the value from which to get the text to search.  The
internal representation of the value may be converted to a form that
Refers to the object from which to get the text to search.  The
internal representation of the object may be converted to a form that
can be efficiently searched.
.AP Tcl_Obj *patObj in/out
Refers to the value from which to get a regular expression. The
compiled regular expression is cached in the value.
Refers to the object from which to get a regular expression. The
compiled regular expression is cached in the object.
.AP char *text in
Text to search for a match with a regular expression.
.AP "const char" *pattern in
String in the form of a regular expression pattern.
.AP Tcl_RegExp regexp in
Compiled regular expression.  Must have been returned previously
by \fBTcl_GetRegExpFromObj\fR or \fBTcl_RegExpCompile\fR.
.AP char *start in
If \fItext\fR is just a portion of some other string, this argument
identifies the beginning of the larger string.
If it is not the same as \fItext\fR, then no
.QW \fB^\fR
matches will be allowed.
.AP size_t index in
.AP int index in
Specifies which range is desired:  0 means the range of the entire
match, 1 or greater means the range that matched a parenthesized
sub-expression.
.AP "const char" **startPtr out
The address of the first character in the range is stored here, or
NULL if there is no such range.
.AP "const char" **endPtr out
The address of the character just after the last one in the range
is stored here, or NULL if there is no such range.
.AP int cflags in
OR-ed combination of the compilation flags \fBTCL_REG_ADVANCED\fR,
\fBTCL_REG_EXTENDED\fR, \fBTCL_REG_BASIC\fR, \fBTCL_REG_EXPANDED\fR,
\fBTCL_REG_QUOTE\fR, \fBTCL_REG_NOCASE\fR, \fBTCL_REG_NEWLINE\fR,
\fBTCL_REG_NLSTOP\fR, \fBTCL_REG_NLANCH\fR, \fBTCL_REG_NOSUB\fR, and
\fBTCL_REG_CANMATCH\fR. See below for more information.
.AP size_t offset in
.AP int offset in
The character offset into the text where matching should begin.
The value of the offset has no impact on \fB^\fR matches.  This
behavior is controlled by \fIeflags\fR.
.AP size_t nmatches in
.AP int nmatches in
The number of matching subexpressions that should be remembered for
later use.  If this value is 0, then no subexpression match
information will be computed.  If the value is TCL_INDEX_NONE, then
information will be computed.  If the value is \-1, then
all of the matching subexpressions will be remembered.  Any other
value will be taken as the maximum number of subexpressions to
remember.
.AP int eflags in
OR-ed combination of the execution flags \fBTCL_REG_NOTBOL\fR and
\fBTCL_REG_NOTEOL\fR. See below for more information.
.AP Tcl_RegExpInfo *infoPtr out
The address of the location where information about a previous match
should be stored by \fBTcl_RegExpGetInfo\fR.
.BE
.SH DESCRIPTION
.PP
\fBTcl_RegExpMatch\fR determines whether its \fIpattern\fR argument
matches \fIregexp\fR, where \fIregexp\fR is interpreted
as a regular expression using the rules in the \fBre_syntax\fR
reference page.
reference page. 
If there is a match then \fBTcl_RegExpMatch\fR returns 1.
If there is no match then \fBTcl_RegExpMatch\fR returns 0.
If an error occurs in the matching process (e.g. \fIpattern\fR
is not a valid regular expression) then \fBTcl_RegExpMatch\fR
returns \-1 and leaves an error message in the interpreter result.
\fBTcl_RegExpMatchObj\fR is similar to \fBTcl_RegExpMatch\fR except it
operates on the Tcl values \fItextObj\fR and \fIpatObj\fR instead of
UTF strings.
operates on the Tcl objects \fItextObj\fR and \fIpatObj\fR instead of
UTF strings. 
\fBTcl_RegExpMatchObj\fR is generally more efficient than
\fBTcl_RegExpMatch\fR, so it is the preferred interface.
.PP
\fBTcl_RegExpCompile\fR, \fBTcl_RegExpExec\fR, and \fBTcl_RegExpRange\fR
provide lower-level access to the regular expression pattern matcher.
\fBTcl_RegExpCompile\fR compiles a regular expression string into
the internal form used for efficient pattern matching.
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
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







-
+





-
+


-
+

-
+







of characters that matched the entire pattern;  otherwise,
information is returned about the range of characters that matched the
\fIindex\fR'th parenthesized subexpression within the pattern.
If there is no range corresponding to \fIindex\fR then NULL
is stored in \fI*startPtr\fR and \fI*endPtr\fR.
.PP
\fBTcl_GetRegExpFromObj\fR, \fBTcl_RegExpExecObj\fR, and
\fBTcl_RegExpGetInfo\fR are value interfaces that provide the most
\fBTcl_RegExpGetInfo\fR are object interfaces that provide the most
direct control of Henry Spencer's regular expression library.  For
users that need to modify compilation and execution options directly,
it is recommended that you use these interfaces instead of calling the
internal regexp functions.  These interfaces handle the details of UTF
to Unicode translations as well as providing improved performance
through caching in the pattern and string values.
through caching in the pattern and string objects.
.PP
\fBTcl_GetRegExpFromObj\fR attempts to return a compiled regular
expression from the \fIpatObj\fR.  If the value does not already
expression from the \fIpatObj\fR.  If the object does not already
contain a compiled regular expression it will attempt to create one
from the string in the value and assign it to the internal
from the string in the object and assign it to the internal
representation of the \fIpatObj\fR.  The return value of this function
is of type \fBTcl_RegExp\fR.  The return value is a token for this
compiled form, which can be used in subsequent calls to
\fBTcl_RegExpExecObj\fR or \fBTcl_RegExpGetInfo\fR.  If an error
occurs while compiling the regular expression then
\fBTcl_GetRegExpFromObj\fR returns NULL and leaves an error message in
the interpreter result.  The regular expression token can be used as
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
197
198
199
200
201
202
203

204
205
206
207
208
209
210
211







-
+







\fBregsub\fR commands.
.TP
\fBTCL_REG_EXTENDED\fR
Compile extended regular expressions
.PQ ERE s .
This mode corresponds
to the regular expression syntax recognized by Tcl 8.0 and earlier
versions.
versions. 
.TP
\fBTCL_REG_BASIC\fR
Compile basic regular expressions
.PQ BRE s .
This mode corresponds
to the regular expression syntax recognized by common Unix utilities
like \fBsed\fR and \fBgrep\fR.  This is the default if no flags are
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
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







-
-
-
-
+
+
+
+














-
-
-
+
+
+

















-
+





\fBTcl_RegExpGetInfo\fR retrieves information about the last match
performed with a given regular expression \fIregexp\fR.  The
\fIinfoPtr\fR argument contains a pointer to a structure that is
defined as follows:
.PP
.CS
typedef struct Tcl_RegExpInfo {
    size_t \fInsubs\fR;
    Tcl_RegExpIndices *\fImatches\fR;
    size_t \fIextendStart\fR;
} \fBTcl_RegExpInfo\fR;
        int \fInsubs\fR;
        Tcl_RegExpIndices *\fImatches\fR;
        long \fIextendStart\fR;
} Tcl_RegExpInfo;
.CE
.PP
The \fInsubs\fR field contains a count of the number of parenthesized
subexpressions within the regular expression.  If the \fBTCL_REG_NOSUB\fR
was used, then this value will be zero.  The \fImatches\fR field
points to an array of \fInsubs\fR+1 values that indicate the bounds of each
subexpression matched.  The first element in the array refers to the
range matched by the entire regular expression, and subsequent elements
refer to the parenthesized subexpressions in the order that they
appear in the pattern.  Each element is a structure that is defined as
follows:
.PP
.CS
typedef struct Tcl_RegExpIndices {
    size_t \fIstart\fR;
    size_t \fIend\fR;
} \fBTcl_RegExpIndices\fR;
        long \fIstart\fR;
        long \fIend\fR;
} Tcl_RegExpIndices;
.CE
.PP
The \fIstart\fR and \fIend\fR values are Unicode character indices
relative to the offset location within \fIobjPtr\fR where matching began.
The \fIstart\fR index identifies the first character of the matched
subexpression.  The \fIend\fR index identifies the first character
after the matched subexpression.  If the subexpression matched the
empty string, then \fIstart\fR and \fIend\fR will be equal.  If the
subexpression did not participate in the match, then \fIstart\fR and
\fIend\fR will be set to \-1.
.PP
The \fIextendStart\fR field in \fBTcl_RegExpInfo\fR is only set if the
\fBTCL_REG_CANMATCH\fR flag was used.  It indicates the first
character in the string where a match could occur.  If a match was
found, this will be the same as the beginning of the current match.
If no match was found, then it indicates the earliest point at which a
match might occur if additional text is appended to the string.  If it
is no match is possible even with further text, this field will be set
is no match is possible even with further text, this field will be set 
to \-1.
.SH "SEE ALSO"
re_syntax(n)
.SH KEYWORDS
match, pattern, regular expression, string, subexpression, Tcl_RegExpIndices, Tcl_RegExpInfo

Changes to doc/SaveResult.3.

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
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



-








-
+
-
-




















-
+

-
+

-
+

-
+

+


+
+
-
-
+
+
+

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

+
+
-
-
+
+
-
+
+
+
+

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

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

-
-
-
+
+
+
+


-
-
+
+
+


+
+
-
+
-
+


'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_SaveResult 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState,
Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state
Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the
state of an an interpreter.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_InterpState
\fBTcl_SaveInterpState\fR(\fIinterp, status\fR)
.sp
int
\fBTcl_RestoreInterpState\fR(\fIinterp, state\fR)
.sp
\fBTcl_DiscardInterpState\fR(\fIstate\fR)
.sp
\fBTcl_SaveResult\fR(\fIinterp, savedPtr\fR)
.sp
\fBTcl_RestoreResult\fR(\fIinterp, savedPtr\fR)
.sp
\fBTcl_DiscardResult\fR(\fIsavedPtr\fR)
.SH ARGUMENTS
.AS Tcl_InterpState savedPtr
.AP Tcl_Interp *interp in
The interpreter for the operation.
Interpreter for which state should be saved.
.AP int status in
The return code for the state.
Return code value to save as part of interpreter state.
.AP Tcl_InterpState state in
A token for saved state.
Saved state token to be restored or discarded.
.AP Tcl_SavedResult *savedPtr in
A pointer to storage for saved state.
Pointer to location where interpreter result should be saved or restored.
.BE

.SH DESCRIPTION
.PP
.VS 8.5
These routines allows a C procedure to take a snapshot of the current
These routines save the state of an interpreter before a call to a routine such
as \fBTcl_Eval\fR, and restore the state afterwards.
state of an interpreter so that it can be restored after a call
to \fBTcl_Eval\fR or some other routine that modifies the interpreter
state.  There are two triplets of routines meant to work together.
.PP
\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the
result of a script, including the resulting value, the return code passed as
\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR.
It returns a token for the saved state.  The interpreter result is not reset
and no interpreter state is changed.
The first triplet stores the snapshot of interpreter state in
.PP
\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and
an opaque token returned by \fBTcl_SaveInterpState\fR.  That token
value may then be passed back to one of \fBTcl_RestoreInterpState\fR
returns the \fIstatus\fR originally passed in the corresponding call to
\fBTcl_SaveInterpState\fR.
or \fBTcl_DiscardInterpState\fR, depending on whether the interp
state is to be restored.  So long as one of the latter two routines
is called, Tcl will take care of memory management.
.PP
The second triplet stores the snapshot of only the interpreter
result (not its complete state) in memory allocated by the caller.
If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called
to release it.  A token used to discard or restore state must not be used
These routines are passed a pointer to \fBTcl_SavedResult\fR
that is used to store enough information to restore the interpreter result.
again.
\fBTcl_SavedResult\fR can be allocated on the stack of the calling
procedure.  These routines do not save the state of any error
information in the interpreter (e.g. the \fB\-errorcode\fR or
\fB\-errorinfo\fR return options, when an error is in progress).
.PP
\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are
deprecated.  Instead use \fBTcl_SaveInterpState\fR,
\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more
capable.
Because the routines \fBTcl_SaveInterpState\fR,
\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR perform
a superset of the functions provided by the other routines,
any new code should only make use of the more powerful routines.
The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
and \fBTcl_DiscardResult\fR continue to exist only for the sake
of existing programs that may already be using them.
.PP
\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
interpreter state that make up the full result of script evaluation.
This include the interpreter result, the return code (passed in
as the \fIstatus\fR argument, and any return options, including
\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress.
This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR.
The call to \fBTcl_SaveInterpState\fR does not itself change the
state of the interpreter.  Unlike \fBTcl_SaveResult\fR, it does
not reset the interpreter.
.PP
\fBTcl_RestoreInterpState\fR accepts a \fBTcl_InterpState\fR token
previously returned by \fBTcl_SaveInterpState\fR and restores the
state of the interp to the state held in that snapshot.  The return
value of \fBTcl_RestoreInterpState\fR is the status value originally
passed to \fBTcl_SaveInterpState\fR when the snapshot token was
created.
.PP
\fBTcl_DiscardInterpState\fR is called to release a \fBTcl_InterpState\fR
token previously returned by \fBTcl_SaveInterpState\fR when that
snapshot is not to be restored to an interp.
.PP
The \fBTcl_InterpState\fR token returned by \fBTcl_SaveInterpState\fR
must eventually be passed to either \fBTcl_RestoreInterpState\fR
or \fBTcl_DiscardInterpState\fR to avoid a memory leak.  Once
the \fBTcl_InterpState\fR token is passed to one of them, the
token is no longer valid and should not be used anymore.
.VE 8.5
.PP
\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location
\fIstatePtr\fR points to and returns the interpreter result to its initial
\fBTcl_SaveResult\fR moves the string and object results
of \fIinterp\fR into the location specified by \fIstatePtr\fR.
\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and
leaves the result in its normal empty initialized state.
state.  It does not save options such as \fB\-errorcode\fR or
\fB\-errorinfo\fR.
.PP
\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and
moves the result from \fIstatePtr\fR back to \fIinterp\fR.  \fIstatePtr\fR is
then in an undefined state and must not be used until passed again to
\fBTcl_RestoreResult\fR moves the string and object results from
\fIstatePtr\fR back into \fIinterp\fR.  Any result or error that was
already in the interpreter will be cleared.  The \fIstatePtr\fR is left
in an uninitialized state and cannot be used until another call to
\fBTcl_SaveResult\fR.
.PP
\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is
then in an undefined state and must not be used until passed again to
\fBTcl_DiscardResult\fR releases the saved interpreter state
stored at \fBstatePtr\fR.  The state structure is left in an
uninitialized state and cannot be used until another call to
\fBTcl_SaveResult\fR.
.PP
Once \fBTcl_SaveResult\fR is called to save the interpreter
result, either \fBTcl_RestoreResult\fR or
If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to
\fBTcl_DiscardResult\fR must be called to properly clean up the
release it.
memory associated with the saved state.
.SH KEYWORDS
result, state, interp

Changes to doc/SetChanErr.3.

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
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







-
-
-
+
+
+

-
-
+
+



-
-
-
+
+
+
+

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

-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

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

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

-
-
-
+
+
+
+
+
+



+
+




-
-
+
+


-
+

-
-
+
+



-
-
+
+

-
-
+
+

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

-
+

-
+
-
-
-
+
+
+
+


+


.SH ARGUMENTS
.AS Tcl_Channel chan
.AP Tcl_Channel chan in
Refers to the Tcl channel whose bypass area is accessed.
.AP Tcl_Interp* interp in
Refers to the Tcl interpreter whose bypass area is accessed.
.AP Tcl_Obj* msg in
Error message put into a bypass area. A list of return options and values,
followed by a string message. Both message and the option/value information
are optional.
Error message put into a bypass area.  A list of return options and
values, followed by a string message.  Both message and the
option/value information are optional.
.AP Tcl_Obj** msgPtr out
Reference to a place where the message stored in the accessed bypass area can
be stored in.
Reference to a place where the message stored in the accessed bypass
area can be stored in.
.BE
.SH DESCRIPTION
.PP
The current definition of a Tcl channel driver does not permit the direct
return of arbitrary error messages, except for the setting and retrieval of
channel options. All other functions are restricted to POSIX error codes.
The current definition of a Tcl channel driver does not permit the
direct return of arbitrary error messages, except for the setting and
retrieval of 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.
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\fI 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 value 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.
\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
\fBTcl_SetChannelErrorInterp\fR stores error information in the bypass area of
the specified interpreter. The number of references to the \fBmsg\fR value
goes up by one. Previously stored information will be discarded, by releasing
the reference held by the interpreter. The interpreter reference must not be
NULL.
\fBTcl_SetChannelErrorInterp\fR stores error information in the bypass
area of the specified interpreter. 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 interpreter. The
interpreter reference must not be NULL.
.PP
\fBTcl_GetChannelError\fR places either the error message held in the bypass
area of the specified channel into \fImsgPtr\fR, or NULL; and resets the
bypass, that is, after an invocation all following invocations will return
NULL, until an intervening invocation of \fBTcl_SetChannelError\fR with a
non-NULL message. The \fImsgPtr\fR must not be NULL. The reference count of
the message is not touched.  The reference previously held by the channel is
now held by the caller of the function and it is its responsibility to release
that reference when it is done with the value.
\fBTcl_GetChannelError\fR places either the error message held in the
bypass area of the specified channel into \fImsgPtr\fR, or NULL; and
resets the bypass. I.e. after an invocation all following invocations
will return NULL, until an intervening invocation of
\fBTcl_SetChannelError\fR with a non-NULL message. The \fImsgPtr\fR
must not be NULL. The reference count of the message is not touched.
The reference previously held by the channel is now held by the caller
of the function and it is its responsibility to release that reference
when it is done with the object.
.PP
\fBTcl_GetChannelErrorInterp\fR places either the error message held in the
bypass area of the specified interpreter into \fImsgPtr\fR, or NULL; and
resets the bypass, that is, after an invocation all following invocations will
return NULL, until an intervening invocation of
\fBTcl_SetChannelErrorInterp\fR with a non-NULL message. The \fImsgPtr\fR must
not be NULL. The reference count of the message is not touched.  The reference
previously held by the interpreter is now held by the caller of the function
and it is its responsibility to release that reference when it is done with
\fBTcl_GetChannelErrorInterp\fR places either the error message held
in the bypass area of the specified interpreter into \fImsgPtr\fR, or
NULL; and resets the bypass. I.e. after an invocation all following
invocations will return NULL, until an intervening invocation of
\fBTcl_SetChannelErrorInterp\fR with a non-NULL message. The
\fImsgPtr\fR must not be NULL. The reference count of the message is
not touched.  The reference previously held by the interpreter is now
held by the caller of the function and it is its responsibility to
release that reference when it is done with the object.
the value.
.PP
Which functions of a channel driver are allowed to use which bypass function
is listed below, as is which functions of the public channel API may leave a
messages in the bypass areas.
Which functions of a channel driver are allowed to use which bypass
function is listed below, as is which functions of the public channel
API may leave a messages in the bypass areas.
.PP
.IP \fBTcl_DriverCloseProc\fR
May use \fBTcl_SetChannelErrorInterp\fR, and only this function.
.IP \fBTcl_DriverInputProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverOutputProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverSeekProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverWideSeekProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverSetOptionProc\fR
Has already the ability to pass arbitrary error messages. Must \fInot\fR use
any of the new functions.
Has already the ability to pass arbitrary error messages. Must
\fBnot\fR use any of the new functions.
.IP \fBTcl_DriverGetOptionProc\fR
Has already the ability to pass arbitrary error messages. Must
\fInot\fR use any of the new functions.
\fBnot\fR use any of the new functions.
.IP \fBTcl_DriverWatchProc\fR
Must \fInot\fR use any of the new functions. Is internally called and has no
ability to return any type of error whatsoever.
Must \fBnot\fR use any of the new functions. Is internally called and
has no ability to return any type of error whatsoever.
.IP \fBTcl_DriverBlockModeProc\fR
May use \fBTcl_SetChannelError\fR, and only this function.
.IP \fBTcl_DriverGetHandleProc\fR
Must \fInot\fR use any of the new functions. It is only a low-level function,
and not used by Tcl commands.
Must \fBnot\fR use any of the new functions. It is only a low-level
function, and not used by Tcl commands.
.IP \fBTcl_DriverHandlerProc\fR
Must \fInot\fR use any of the new functions. Is internally called and has no
ability to return any type of error whatsoever.
Must \fBnot\fR use any of the new functions. Is internally called and
has no ability to return any type of error whatsoever.
.PP
Given the information above the following public functions of the Tcl C API
are affected by these changes; when these functions are called, the channel
may now contain a stored arbitrary error message requiring processing by the
caller.
.DS
.ta 1.9i 4i
\fBTcl_Flush\fR	\fBTcl_GetsObj\fR	\fBTcl_Gets\fR
\fBTcl_ReadChars\fR	\fBTcl_ReadRaw\fR	\fBTcl_Read\fR
\fBTcl_Seek\fR	\fBTcl_StackChannel\fR	\fBTcl_Tell\fR
\fBTcl_WriteChars\fR	\fBTcl_WriteObj\fR	\fBTcl_WriteRaw\fR
\fBTcl_Write\fR
Given the information above the following public functions of the Tcl
C API are affected by these changes. I.e. when these functions are
called the channel may now contain a stored arbitrary error message
requiring processing by the caller.
.PP
.IP \fBTcl_StackChannel\fR
.IP \fBTcl_Seek\fR
.IP \fBTcl_Tell\fR
.IP \fBTcl_ReadRaw\fR
.IP \fBTcl_Read\fR
.IP \fBTcl_ReadChars\fR
.IP \fBTcl_Gets\fR
.IP \fBTcl_GetsObj\fR
.IP \fBTcl_Flush\fR
.IP \fBTcl_WriteRaw\fR
.IP \fBTcl_WriteObj\fR
.IP \fBTcl_Write\fR
.DE
.IP \fBTcl_WriteChars\fR
.PP
All other API functions are unchanged. In particular, the functions below
All other API functions are unchanged. Especially the functions below
leave all their error information in the interpreter result.
.DS
.PP
.ta 1.9i 4i
\fBTcl_Close\fR	\fBTcl_UnstackChannel\fR	\fBTcl_UnregisterChannel\fR
.DE
.IP \fBTcl_Close\fR
.IP \fBTcl_UnregisterChannel\fR
.IP \fBTcl_UnstackChannel\fR

.SH "SEE ALSO"
Tcl_Close(3), Tcl_OpenFileChannel(3), Tcl_SetErrno(3)

.SH KEYWORDS
channel driver, error messages, channel type

Changes to doc/SetErrno.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_SetErrno 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SetErrno, Tcl_GetErrno, Tcl_ErrnoId, Tcl_ErrnoMsg \- manipulate errno to store and retrieve error codes
.SH SYNOPSIS
.nf

Changes to doc/SetRecLmt.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_SetRecursionLimit 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SetRecursionLimit \- set maximum allowable nesting depth in interpreter
.SH SYNOPSIS
.nf
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39







-
+







New limit for nested calls to \fBTcl_Eval\fR for \fIinterp\fR.
.BE

.SH DESCRIPTION
.PP
At any given time Tcl enforces a limit on the number of recursive
calls that may be active for \fBTcl_Eval\fR and related procedures
such as \fBTcl_EvalEx\fR.
such as \fBTcl_GlobalEval\fR.
Any call to \fBTcl_Eval\fR that exceeds this depth is aborted with
an error.
By default the recursion limit is 1000.
.PP
\fBTcl_SetRecursionLimit\fR may be used to change the maximum
allowable nesting depth for an interpreter.
The \fIdepth\fR argument specifies a new limit for \fIinterp\fR,

Changes to doc/SetResult.3.

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
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






-
-
+
+



-
+
















+
+
-
+

-
+

-
+

-
+



-
+



-
+









-
-
-
-
-
-





-
+

-
+

-
-
+
+


-
+

-
+




-
+



-
-
+
+


-
-
-
+
+
+















-
-
-
+
+
+


-
+




-
+

-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
.TH Tcl_SetResult 3 8.7 Tcl "Tcl Library Procedures"
'\" 
.TH Tcl_SetResult 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendElement, Tcl_ResetResult, Tcl_TransferResult \- manipulate Tcl result
Tcl_SetObjResult, Tcl_GetObjResult, Tcl_SetResult, Tcl_GetStringResult, Tcl_AppendResult, Tcl_AppendResultVA, Tcl_AppendElement, Tcl_ResetResult, Tcl_FreeResult \- manipulate Tcl result
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_SetObjResult\fR(\fIinterp, objPtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetObjResult\fR(\fIinterp\fR)
.sp
\fBTcl_SetResult\fR(\fIinterp, result, freeProc\fR)
.sp
const char *
\fBTcl_GetStringResult\fR(\fIinterp\fR)
.sp
\fBTcl_AppendResult\fR(\fIinterp, result, result, ... , \fB(char *) NULL\fR)
.sp
\fBTcl_AppendResultVA\fR(\fIinterp, argList\fR)
.sp
\fBTcl_ResetResult\fR(\fIinterp\fR)
\fBTcl_AppendElement\fR(\fIinterp, element\fR)
.sp
\fBTcl_TransferResult\fR(\fIsourceInterp, code, targetInterp\fR)
\fBTcl_ResetResult\fR(\fIinterp\fR)
.sp
\fBTcl_AppendElement\fR(\fIinterp, element\fR)
\fBTcl_FreeResult\fR(\fIinterp\fR)
.SH ARGUMENTS
.AS Tcl_FreeProc sourceInterp out
.AS Tcl_FreeProc freeProc out
.AP Tcl_Interp *interp out
Interpreter whose result is to be modified or read.
.AP Tcl_Obj *objPtr in
Tcl value to become result for \fIinterp\fR.
Object value to become result for \fIinterp\fR.
.AP char *result in
String value to become result for \fIinterp\fR or to be
appended to the existing result.
.AP "const char" *element in
.AP char *element in
String value to append as a list element
to the existing result of \fIinterp\fR.
.AP Tcl_FreeProc *freeProc in
Address of procedure to call to release storage at
\fIresult\fR, or \fBTCL_STATIC\fR, \fBTCL_DYNAMIC\fR, or
\fBTCL_VOLATILE\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 Tcl_Interp *sourceInterp in
Interpreter that the result and return options should be transferred from.
.AP Tcl_Interp *targetInterp in
Interpreter that the result and return options should be transferred to.
.AP int code in
Return code value that controls transfer of return options.
.BE
.SH DESCRIPTION
.PP
The procedures described here are utilities for manipulating the
result value in a Tcl interpreter.
The interpreter result may be either a Tcl value or a string.
The interpreter result may be either a Tcl object or a string.
For example, \fBTcl_SetObjResult\fR and \fBTcl_SetResult\fR
set the interpreter result to, respectively, a value and a string.
set the interpreter result to, respectively, an object and a string.
Similarly, \fBTcl_GetObjResult\fR and \fBTcl_GetStringResult\fR
return the interpreter result as a value and as a string.
The procedures always keep the string and value forms
return the interpreter result as an object and as a string.
The procedures always keep the string and object forms
of the interpreter result consistent.
For example, if \fBTcl_SetObjResult\fR is called to set
the result to a value,
the result to an object,
then \fBTcl_GetStringResult\fR is called,
it will return the value's string representation.
it will return the object's string value.
.PP
\fBTcl_SetObjResult\fR
arranges for \fIobjPtr\fR to be the result for \fIinterp\fR,
replacing any existing result.
The result is left pointing to the value
The result is left pointing to the object
referenced by \fIobjPtr\fR.
\fIobjPtr\fR's reference count is incremented
since there is now a new reference to it from \fIinterp\fR.
The reference count for any old result value
is decremented and the old result value is freed if no
The reference count for any old result object
is decremented and the old result object is freed if no
references to it remain.
.PP
\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as a value.
The value's reference count is not incremented;
if the caller needs to retain a long-term pointer to the value
\fBTcl_GetObjResult\fR returns the result for \fIinterp\fR as an object.
The object's reference count is not incremented;
if the caller needs to retain a long-term pointer to the object
they should use \fBTcl_IncrRefCount\fR to increment its reference count
in order to keep it from being freed too early or accidentally changed.
.PP
\fBTcl_SetResult\fR
arranges for \fIresult\fR to be the result for the current Tcl
command in \fIinterp\fR, replacing any existing result.
The \fIfreeProc\fR argument specifies how to manage the storage
for the \fIresult\fR argument;
it is discussed in the section
\fBTHE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT\fR below.
If \fIresult\fR is \fBNULL\fR, then \fIfreeProc\fR is ignored
and \fBTcl_SetResult\fR
re-initializes \fIinterp\fR's result to point to an empty string.
.PP
\fBTcl_GetStringResult\fR returns the result for \fIinterp\fR as a string.
If the result was set to a value by a \fBTcl_SetObjResult\fR call,
the value form will be converted to a string and returned.
If the value's string representation contains null bytes,
If the result was set to an object by a \fBTcl_SetObjResult\fR call,
the object form will be converted to a string and returned.
If the object's string representation contains null bytes,
this conversion will lose information.
For this reason, programmers are encouraged to
write their code to use the new value API procedures
write their code to use the new object API procedures
and to call \fBTcl_GetObjResult\fR instead.
.PP
\fBTcl_ResetResult\fR clears the result for \fIinterp\fR
and leaves the result in its normal empty initialized state.
If the result is a value,
If the result is an object,
its reference count is decremented and the result is left
pointing to an unshared value representing an empty string.
pointing to an unshared object representing an empty string.
If the result is a dynamically allocated string, its memory is free*d
and the result is left as a empty string.
\fBTcl_ResetResult\fR also clears the error state managed by
\fBTcl_AddErrorInfo\fR, \fBTcl_AddObjErrorInfo\fR,
and \fBTcl_SetErrorCode\fR.
.PP
\fBTcl_AppendResult\fR makes it easy to build up Tcl results in pieces.
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
131
132
133
134
135
136
137








138


139
140
141

142
143
144

145
146
147
148
149
150
151
152







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

-
+


-
+







result, such as allocating a larger result area if necessary.
It also manages conversion to and from the \fIresult\fR field of the
\fIinterp\fR so as to handle backward-compatibility with old-style
extensions.
Any number of \fIresult\fR arguments may be passed in a single
call; the last argument in the list must be a NULL pointer.
.PP
\fBTcl_TransferResult\fR transfers interpreter state from \fIsourceInterp\fR
to \fItargetInterp\fR. The two interpreters must have been created in the
same thread.  If \fIsourceInterp\fR and \fItargetInterp\fR are the same,
nothing is done. Otherwise, \fBTcl_TransferResult\fR moves the result
from \fIsourceInterp\fR to \fItargetInterp\fR, and resets the result
in \fIsourceInterp\fR. It also moves the return options dictionary as
controlled by the return code value \fIcode\fR in the same manner
as \fBTcl_GetReturnOptions\fR.
\fBTcl_AppendResultVA\fR is the same as \fBTcl_AppendResult\fR except that
.SH "DEPRECATED INTERFACES"
.SS "OLD STRING PROCEDURES"
instead of taking a variable number of arguments it takes an argument list.
.SH "OLD STRING PROCEDURES"
.PP
Use of the following procedures is deprecated
Use of the following procedures (is deprecated
since they manipulate the Tcl result as a string.
Procedures such as \fBTcl_SetObjResult\fR
that manipulate the result as a value
that manipulate the result as an object
can be significantly more efficient.
.PP
\fBTcl_AppendElement\fR is similar to \fBTcl_AppendResult\fR in
that it allows results to be built up in pieces.
However, \fBTcl_AppendElement\fR takes only a single \fIelement\fR
argument and it appends that argument to the current result
as a proper Tcl list element.
171
172
173
174
175
176
177


















178
179
180

181
182
183
184
185
186
187
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







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


-
+







However if the new list element is the first in a list or sub-list
(i.e. \fIinterp\fR's current result is empty, or consists of the
single character
.QW { ,
or ends in the characters
.QW " {" )
then no space is added.
.PP
\fBTcl_FreeResult\fR performs part of the work
of \fBTcl_ResetResult\fR.
It frees up the memory associated with \fIinterp\fR's result.
It also sets \fIinterp->freeProc\fR to zero, but does not
change \fIinterp->result\fR or clear error state.
\fBTcl_FreeResult\fR is most commonly used when a procedure
is about to replace one result value with another.
.SH "DIRECT ACCESS TO INTERP->RESULT IS DEPRECATED"
.PP
It used to be legal for programs to
directly read and write \fIinterp->result\fR
to manipulate the interpreter result.
Direct access to \fIinterp->result\fR is now strongly deprecated
because it can make the result's string and object forms inconsistent.
Programs should always read the result
using the procedures \fBTcl_GetObjResult\fR or \fBTcl_GetStringResult\fR,
and write the result using \fBTcl_SetObjResult\fR or \fBTcl_SetResult\fR.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how 
the Tcl system is to manage the storage for the \fIresult\fR argument.
If \fBTcl_SetResult\fR or \fBTcl_SetObjResult\fR are called
at a time when \fIinterp\fR holds a string result,
they do whatever is necessary to dispose of the old string result
(see the \fBTcl_Interp\fR manual entry for details on this).
.PP
If \fIfreeProc\fR is \fBTCL_STATIC\fR it means that \fIresult\fR
202
203
204
205
206
207
208
209
210
211
212

213
214
215
216
217
218

219
220
221

209
210
211
212
213
214
215

216


217
218

219
220
221

222

223

224







-

-
-
+

-



-
+
-

-
+
If \fIfreeProc\fR is not one of the values \fBTCL_STATIC\fR,
\fBTCL_DYNAMIC\fR, and \fBTCL_VOLATILE\fR, then it is the address
of a procedure that Tcl should call to free the string.
This allows applications to use non-standard storage allocators.
When Tcl no longer needs the storage for the string, it will
call \fIfreeProc\fR. \fIFreeProc\fR should have arguments and
result that match the type \fBTcl_FreeProc\fR:
.PP
.CS
typedef void \fBTcl_FreeProc\fR(
        char *\fIblockPtr\fR);
typedef void Tcl_FreeProc(char *\fIblockPtr\fR);
.CE
.PP
When \fIfreeProc\fR is called, its \fIblockPtr\fR will be set to
the value of \fIresult\fR passed to \fBTcl_SetResult\fR.
.SH "SEE ALSO"
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp,
Tcl_AddErrorInfo, Tcl_CreateObjCommand, Tcl_SetErrorCode, Tcl_Interp
Tcl_GetReturnOptions
.SH KEYWORDS
append, command, element, list, value, result, return value, interpreter
append, command, element, list, object, result, return value, interpreter

Changes to doc/SetVar.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SetVar2Ex, Tcl_SetVar, Tcl_SetVar2, Tcl_ObjSetVar2, Tcl_GetVar2Ex, Tcl_GetVar, Tcl_GetVar2, Tcl_ObjGetVar2, Tcl_UnsetVar, Tcl_UnsetVar2 \- manipulate Tcl variables
.SH SYNOPSIS
.nf
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
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







-
+













-
+




-
+









-
+







or a complete name including both variable name and index.
May include \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
.AP "const char" *name2 in
If non-NULL, gives name of element within array; in this
case \fIname1\fR must refer to an array variable.
.AP Tcl_Obj *newValuePtr in
Points to a Tcl value containing the new value for the variable.
Points to a Tcl object containing the new value for the variable.
.AP int flags in
OR-ed combination of bits providing additional information. See below
for valid values.
.AP "const char" *varName in
Name of variable.
May include \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
May refer to a scalar variable or an element of
an array.
.AP "const char" *newValue in
New value for variable, specified as a null-terminated string.
A copy of this value is stored in the variable.
.AP Tcl_Obj *part1Ptr in
Points to a Tcl value containing the variable's name.
Points to a Tcl object containing the variable's name.
The name may include a series of \fB::\fR namespace qualifiers
to specify a variable in a particular namespace.
May refer to a scalar variable or an element of an array variable.
.AP Tcl_Obj *part2Ptr in
If non-NULL, points to a value containing the name of an element
If non-NULL, points to an object containing the name of an element
within an array and \fIpart1Ptr\fR must refer to an array variable.
.BE

.SH DESCRIPTION
.PP
These procedures are used to create, modify, read, and delete
Tcl variables from C code.
.PP
\fBTcl_SetVar2Ex\fR, \fBTcl_SetVar\fR, \fBTcl_SetVar2\fR, and
\fBTcl_ObjSetVar2\fR
\fBTcl_ObjSetVar2\fR 
will create a new variable or modify an existing one.
These procedures set the given variable to the value
given by \fInewValuePtr\fR or \fInewValue\fR and return a
pointer to the variable's new value, which is stored in Tcl's
variable structure.
\fBTcl_SetVar2Ex\fR and \fBTcl_ObjSetVar2\fR take the new value as a
Tcl_Obj and return
242
243
244
245
246
247
248
249

242
243
244
245
246
247
248

249







-
+
If an array name is specified without an index, then the entire
array is removed.

.SH "SEE ALSO"
Tcl_GetObjResult, Tcl_GetStringResult, Tcl_TraceVar

.SH KEYWORDS
array, get variable, interpreter, scalar, set, unset, value, variable
array, get variable, interpreter, object, scalar, set, unset, variable

Changes to doc/Signal.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 2001 ActiveState Tool Corp.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_SignalId 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SignalId, Tcl_SignalMsg \- Convert signal codes
.SH SYNOPSIS
.nf

Changes to doc/Sleep.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1990 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Sleep \- delay execution for a given number of milliseconds
.SH SYNOPSIS
.nf

Changes to doc/SplitList.3.

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
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






-
+















-
+


-
+


-
+


-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_SplitList 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SplitList, Tcl_Merge, Tcl_ScanElement, Tcl_ConvertElement, Tcl_ScanCountedElement, Tcl_ConvertCountedElement \- manipulate Tcl lists
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_SplitList\fR(\fIinterp, list, argcPtr, argvPtr\fR)
.sp
char *
\fBTcl_Merge\fR(\fIargc, argv\fR)
.sp
size_t
int
\fBTcl_ScanElement\fR(\fIsrc, flagsPtr\fR)
.sp
size_t
int
\fBTcl_ScanCountedElement\fR(\fIsrc, length, flagsPtr\fR)
.sp
size_t
int
\fBTcl_ConvertElement\fR(\fIsrc, dst, flags\fR)
.sp
size_t
int
\fBTcl_ConvertCountedElement\fR(\fIsrc, length, dst, flags\fR)
.SH ARGUMENTS
.AS "const char *const" ***argvPtr out
.AP Tcl_Interp *interp out
Interpreter to use for error reporting.  If NULL, then no error message
is left.
.AP char *list in
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
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







-
+









+














-





-
+

-


-







Array of strings to merge together into a single list.
Each string will become a separate element of the list.
.AP "const char" *src in
String that is to become an element of a list.
.AP int *flagsPtr in
Pointer to word to fill in with information about \fIsrc\fR.
The value of *\fIflagsPtr\fR must be passed to \fBTcl_ConvertElement\fR.
.AP size_t length in
.AP int length in
Number of bytes in string \fIsrc\fR.
.AP char *dst in
Place to copy converted list element.  Must contain enough characters
to hold converted string.
.AP int flags in
Information about \fIsrc\fR. Must be value returned by previous
call to \fBTcl_ScanElement\fR, possibly OR-ed
with \fBTCL_DONT_USE_BRACES\fR.
.BE

.SH DESCRIPTION
.PP
These procedures may be used to disassemble and reassemble Tcl lists.
\fBTcl_SplitList\fR breaks a list up into its constituent elements,
returning an array of pointers to the elements using
\fIargcPtr\fR and \fIargvPtr\fR.
While extracting the arguments, \fBTcl_SplitList\fR obeys the usual
rules for backslash substitutions and braces.  The area of
memory pointed to by \fI*argvPtr\fR is dynamically allocated;  in
addition to the array of pointers, it
also holds copies of all the list elements.  It is the caller's
responsibility to free up all of this storage.
For example, suppose that you have called \fBTcl_SplitList\fR with
the following code:
.PP
.CS
int argc, code;
char *string;
char **argv;
\&...
code = \fBTcl_SplitList\fR(interp, string, &argc, &argv);
code = Tcl_SplitList(interp, string, &argc, &argv);
.CE
.PP
Then you should eventually free the storage with a call like the
following:
.PP
.CS
Tcl_Free((char *) argv);
.CE
.PP
\fBTcl_SplitList\fR normally returns \fBTCL_OK\fR, which means the list was
successfully parsed.
If there was a syntax error in \fIlist\fR, then \fBTCL_ERROR\fR is returned
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
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







+











+





-
+
-


\fBTCL_DONT_USE_BRACES\fR.
Although this will produce an uglier result, it is useful in some
special situations, such as when \fBTcl_ConvertElement\fR is being
used to generate a portion of an argument for a Tcl command.
In this case, surrounding \fIsrc\fR with curly braces would cause
the command not to be parsed correctly.
.PP
.VS 8.5
By default, \fBTcl_ConvertElement\fR will use quoting in its output
to be sure the first character of an element is not the hash
character
.PQ # .
This is to be sure the first element of any list
passed to \fBeval\fR is not mis-parsed as the beginning of a comment.
When a list element is not the first element of a list, this quoting
is not necessary.  When the caller can be sure that the element is
not the first element of a list, it can disable quoting of the leading
hash character by OR-ing the flag value returned by \fBTcl_ScanElement\fR
with \fBTCL_DONT_QUOTE_HASH\fR.
.VE 8.5
.PP
\fBTcl_ScanCountedElement\fR and \fBTcl_ConvertCountedElement\fR are
the same as \fBTcl_ScanElement\fR and \fBTcl_ConvertElement\fR, except
the length of string \fIsrc\fR is specified by the \fIlength\fR
argument, and the string may contain embedded nulls.
.SH "SEE ALSO"

Tcl_ListObjGetElements(3)
.SH KEYWORDS
backslash, convert, element, list, merge, split, strings

Changes to doc/SplitPath.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SplitPath, Tcl_JoinPath, Tcl_GetPathType \- manipulate platform-dependent file paths
.SH SYNOPSIS
.nf
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
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







-
+















-







-


-







.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 Tcl-value-aware procedures in
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
\fBTcl_SplitPath\fR breaks a path into its constituent elements,
returning an array of pointers to the elements using \fIargcPtr\fR and
\fIargvPtr\fR.  The area of memory pointed to by \fI*argvPtr\fR is
dynamically allocated; in addition to the array of pointers, it also
holds copies of all the path elements.  It is the caller's
responsibility to free all of this storage.
For example, suppose that you have called \fBTcl_SplitPath\fR with the
following code:
.PP
.CS
int argc;
char *path;
char **argv;
\&...
Tcl_SplitPath(string, &argc, &argv);
.CE
.PP
Then you should eventually free the storage with a call like the
following:
.PP
.CS
Tcl_Free((char *) argv);
.CE
.PP
\fBTcl_JoinPath\fR is the inverse of \fBTcl_SplitPath\fR: it takes a
collection of path elements given by \fIargc\fR and \fIargv\fR and
generates a result string that is a properly constructed path. The

Changes to doc/StaticPkg.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_StaticPackage \- make a statically linked package available via the 'load' command
.SH SYNOPSIS
.nf
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
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









-
+


+



















-

-
-
+

-







-
+
-
-


-
-
Name of the package;  should be properly capitalized (first letter
upper-case, all others lower-case).
.AP Tcl_PackageInitProc *initProc in
Procedure to invoke to incorporate this package into a trusted
interpreter.
.AP Tcl_PackageInitProc *safeInitProc in
Procedure to call to incorporate this package into a safe interpreter
(one that will execute untrusted scripts).  NULL means the package
(one that will execute untrusted scripts).   NULL means the package
cannot be used in safe interpreters.
.BE

.SH DESCRIPTION
.PP
This procedure may be invoked to announce that a package has been
linked statically with a Tcl application and, optionally, that it
has already been loaded into an interpreter.
Once \fBTcl_StaticPackage\fR has been invoked for a package, it
may be loaded into interpreters using the \fBload\fR command.
\fBTcl_StaticPackage\fR is normally invoked only by the \fBTcl_AppInit\fR
procedure for the application, not by packages for themselves
(\fBTcl_StaticPackage\fR should only be invoked for statically
loaded packages, and code in the package itself should not need
to know whether the package is dynamically or statically loaded).
.PP
When the \fBload\fR command is used later to load the package into
an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will
be invoked, depending on whether the target interpreter is safe
or not.
\fIinitProc\fR and \fIsafeInitProc\fR must both match the
following prototype:
.PP
.CS
typedef int \fBTcl_PackageInitProc\fR(
        Tcl_Interp *\fIinterp\fR);
typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the package
is to be loaded.  The initialization procedure must return \fBTCL_OK\fR or
\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
the event of an error it should set the interpreter's result to point to an
error message.  The result or error from the initialization procedure will
be returned as the result of the \fBload\fR command that caused the
initialization procedure to be invoked.
.PP

\fBTcl_StaticPackage\fR can not be safely used by stub-enabled extensions,
so its symbol is not included in the stub table.
.SH KEYWORDS
initialization procedure, package, static linking
.SH "SEE ALSO"
load(n), package(n), Tcl_PkgRequire(3)

Changes to doc/StdChannels.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 2001 by ActiveState Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_StandardChannels \- How the Tcl library deals with the standard channels
.BE

Changes to doc/StrMatch.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_StringMatch 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_StringMatch, Tcl_StringCaseMatch \- test whether a string matches a pattern
.SH SYNOPSIS
.nf

Changes to doc/StringObj.3.

1
2
3
4
5
6

7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5

6
7
8
9
10

11
12
13
14
15
16
17
18





-
+




-
+







'\"
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_StringObj 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl values as strings
Tcl_NewStringObj, Tcl_NewUnicodeObj, Tcl_SetStringObj, Tcl_SetUnicodeObj, Tcl_GetStringFromObj, Tcl_GetString, Tcl_GetUnicodeFromObj, Tcl_GetUnicode, Tcl_GetUniChar, Tcl_GetCharLength, Tcl_GetRange, Tcl_AppendToObj, Tcl_AppendUnicodeToObj, Tcl_AppendObjToObj, Tcl_AppendStringsToObj, Tcl_AppendStringsToObjVA, Tcl_AppendLimitedToObj, Tcl_Format, Tcl_AppendFormatToObj, Tcl_ObjPrintf, Tcl_AppendPrintfToObj, Tcl_SetObjLength, Tcl_AttemptSetObjLength, Tcl_ConcatObj \- manipulate Tcl objects as strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_NewStringObj\fR(\fIbytes, length\fR)
.sp
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
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







-
+




















+
+
+
+












-
+

+













-
+

-
-
+
+


-
+

-
-
+
+


-
+


-
+

-
-
-
+
+
+

-
+

-
-
+
+

-
+

-
+

-
+


-
+



-
+

-
+



-
+
-
-





-
-
+
+



+


-
+

-
+






-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+


-
+

-
+


-
+

-
+

-
+















-
+



-
+





-
+
-

-
+

-
+

-
+


-
+


-
-
+
+


-
-
+
+

-
+


-
-
+
+

-
-
+
+

-
+













+
+
+
+
+







.sp
Tcl_UniChar *
\fBTcl_GetUnicodeFromObj\fR(\fIobjPtr, lengthPtr\fR)
.sp
Tcl_UniChar *
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
.sp
int
Tcl_UniChar
\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
.sp
int
\fBTcl_GetCharLength\fR(\fIobjPtr\fR)
.sp
Tcl_Obj *
\fBTcl_GetRange\fR(\fIobjPtr, first, last\fR)
.sp
void
\fBTcl_AppendToObj\fR(\fIobjPtr, bytes, length\fR)
.sp
void
\fBTcl_AppendUnicodeToObj\fR(\fIobjPtr, unicode, numChars\fR)
.sp
void
\fBTcl_AppendObjToObj\fR(\fIobjPtr, appendObjPtr\fR)
.sp
void
\fBTcl_AppendStringsToObj\fR(\fIobjPtr, string, string, ... \fB(char *) NULL\fR)
.sp
void
\fBTcl_AppendStringsToObjVA\fR(\fIobjPtr, argList\fR)
.VS 8.5
.sp
void
\fBTcl_AppendLimitedToObj\fR(\fIobjPtr, bytes, length, limit, ellipsis\fR)
.sp
Tcl_Obj *
\fBTcl_Format\fR(\fIinterp, format, objc, objv\fR)
.sp
int
\fBTcl_AppendFormatToObj\fR(\fIinterp, objPtr, format, objc, objv\fR)
.sp
Tcl_Obj *
\fBTcl_ObjPrintf\fR(\fIformat, ...\fR)
.sp
void
int
\fBTcl_AppendPrintfToObj\fR(\fIobjPtr, format, ...\fR)
.VE 8.5
.sp
void
\fBTcl_SetObjLength\fR(\fIobjPtr, newLength\fR)
.sp
int
\fBTcl_AttemptSetObjLength\fR(\fIobjPtr, newLength\fR)
.sp
Tcl_Obj *
\fBTcl_ConcatObj\fR(\fIobjc, objv\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *appendObjPtr in/out
.AP "const char" *bytes in
Points to the first byte of an array of UTF-8-encoded bytes
used to set or append to a string value.
used to set or append to a string object.
This byte array may contain embedded null characters
unless \fInumChars\fR is TCL_INDEX_NONE.  (Applications needing null bytes
should represent them as the two-byte sequence \fI\e300\e200\fR, use
unless \fInumChars\fR is negative.  (Applications needing null bytes
should represent them as the two-byte sequence \fI\e700\e600\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
.AP size_t length in
.AP int length in
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string value.
If TCL_INDEX_NONE, all bytes up to the first null are used.
initializing, setting, or appending to a string object.
If negative, all bytes up to the first null are used.
.AP "const Tcl_UniChar" *unicode in
Points to the first byte of an array of Unicode characters
used to set or append to a string value.
used to set or append to a string object.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
.AP size_t numChars in
.AP int numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string value.
If TCL_INDEX_NONE, all characters up to the first null character are used.
.AP size_t index in
initializing, setting, or appending to a string object.
If negative, all characters up to the first null character are used.
.AP int index in
The index of the Unicode character to return.
.AP size_t first in
.AP int first in
The index of the first Unicode character in the Unicode range to be
returned as a new value.
.AP size_t last in
returned as a new object.
.AP int last in
The index of the last Unicode character in the Unicode range to be
returned as a new value.
returned as a new object.
.AP Tcl_Obj *objPtr in/out
Points to a value to manipulate.
Points to an object to manipulate.
.AP Tcl_Obj *appendObjPtr in
The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
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 a value's string representation.
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
An argument list which must have been initialised using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP size_t limit in
.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
If NULL is passed then the suffix "..." is used.
.QW "..."
is used.
.AP "const char" *format in
Format control string including % conversion specifiers.
.AP int objc in
The number of elements to format or concatenate.
.AP Tcl_Obj *objv[] in
The array of values to format or concatenate.
.AP size_t newLength in
The array of objects to format or concatenate.
.AP int newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.BE

.SH DESCRIPTION
.PP
The procedures described in this manual entry allow Tcl values to
The procedures described in this manual entry allow Tcl objects to
be manipulated as string values.  They use the internal representation
of the value to store additional information to make the string
of the object to store additional information to make the string
manipulations more efficient.  In particular, they make a series of
append operations efficient by allocating extra storage space for the
string so that it does not have to be copied for each append.
Also, indexing and length computations are optimized because the
Unicode string representation is calculated and cached as needed.
When using the \fBTcl_Append*\fR family of functions where the
interpreter's result is the value being appended to, it is important
interpreter's result is the object being appended to, it is important
to call Tcl_ResetResult first to ensure you are not unintentionally
appending to existing data in the result value.
appending to existing data in the result object.
.PP
\fBTcl_NewStringObj\fR and \fBTcl_SetStringObj\fR create a new value
or modify an existing value to hold a copy of the string given by
\fBTcl_NewStringObj\fR and \fBTcl_SetStringObj\fR create a new object
or modify an existing object to hold a copy of the string given by
\fIbytes\fR and \fIlength\fR.  \fBTcl_NewUnicodeObj\fR and
\fBTcl_SetUnicodeObj\fR create a new value or modify an existing
value to hold a copy of the Unicode string given by \fIunicode\fR and
\fBTcl_SetUnicodeObj\fR create a new object or modify an existing
object to hold a copy of the Unicode string given by \fIunicode\fR and
\fInumChars\fR.  \fBTcl_NewStringObj\fR and \fBTcl_NewUnicodeObj\fR
return a pointer to a newly created value with reference count zero.
All four procedures set the value to hold a copy of the specified
return a pointer to a newly created object with reference count zero.
All four procedures set the object to hold a copy of the specified
string.  \fBTcl_SetStringObj\fR and \fBTcl_SetUnicodeObj\fR free any
old string representation as well as any old internal representation
of the value.
of the object.
.PP
\fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR return a value's
\fBTcl_GetStringFromObj\fR and \fBTcl_GetString\fR return an object's
string representation.  This is given by the returned byte pointer and
(for \fBTcl_GetStringFromObj\fR) length, which is stored in
\fIlengthPtr\fR if it is non-NULL.  If the value's UTF string
\fIlengthPtr\fR if it is non-NULL.  If the object's UTF string
representation is invalid (its byte pointer is NULL), the string
representation is regenerated from the value's internal
representation is regenerated from the object's internal
representation.  The storage referenced by the returned byte pointer
is owned by the value manager.  It is passed back as a writable
is owned by the object manager.  It is passed back as a writable
pointer so that extension author creating their own \fBTcl_ObjType\fR
will be able to modify the string representation within the
\fBTcl_UpdateStringProc\fR of their \fBTcl_ObjType\fR.  Except for that
limited purpose, the pointer returned by \fBTcl_GetStringFromObj\fR
or \fBTcl_GetString\fR should be treated as read-only.  It is
recommended that this pointer be assigned to a (const char *) variable.
Even in the limited situations where writing to this pointer is
acceptable, one should take care to respect the copy-on-write
semantics required by \fBTcl_Obj\fR's, with appropriate calls
to \fBTcl_IsShared\fR and \fBTcl_DuplicateObj\fR prior to any
in-place modification of the string representation.
The procedure \fBTcl_GetString\fR is used in the common case
where the caller does not need the length of the string
representation.
.PP
\fBTcl_GetUnicodeFromObj\fR and \fBTcl_GetUnicode\fR return a value's
\fBTcl_GetUnicodeFromObj\fR and \fBTcl_GetUnicode\fR return an object's
value as a Unicode string.  This is given by the returned pointer and
(for \fBTcl_GetUnicodeFromObj\fR) length, which is stored in
\fIlengthPtr\fR if it is non-NULL.  The storage referenced by the returned
byte pointer is owned by the value manager and should not be modified by
byte pointer is owned by the object manager and should not be modified by
the caller.  The procedure \fBTcl_GetUnicode\fR is used in the common case
where the caller does not need the length of the unicode string
representation.
.PP
\fBTcl_GetUniChar\fR returns the \fIindex\fR'th character in the
value's Unicode representation. If the index is out of range or
object's Unicode representation.
it references a low surrogate preceded by a high surrogate, it returns -1;
.PP
\fBTcl_GetRange\fR returns a newly created value comprised of the
\fBTcl_GetRange\fR returns a newly created object comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
value's Unicode representation.  If the value's Unicode
object's Unicode representation.  If the object's Unicode
representation is invalid, the Unicode representation is regenerated
from the value's string representation.
from the object's string representation.
.PP
\fBTcl_GetCharLength\fR returns the number of characters (as opposed
to bytes) in the string value.
to bytes) in the string object.
.PP
\fBTcl_AppendToObj\fR appends the data given by \fIbytes\fR and
\fIlength\fR to the string representation of the value specified by
\fIobjPtr\fR.  If the value has an invalid string representation,
\fIlength\fR to the string representation of the object specified by
\fIobjPtr\fR.  If the object has an invalid string representation,
then an attempt is made to convert \fIbytes\fR is to the Unicode
format.  If the conversion is successful, then the converted form of
\fIbytes\fR is appended to the value's Unicode representation.
Otherwise, the value's Unicode representation is invalidated and
\fIbytes\fR is appended to the object's Unicode representation.
Otherwise, the object's Unicode representation is invalidated and
converted to the UTF format, and \fIbytes\fR is appended to the
value's new string representation.
object's new string representation.
.PP
\fBTcl_AppendUnicodeToObj\fR appends the Unicode string given by
\fIunicode\fR and \fInumChars\fR to the value specified by
\fIobjPtr\fR.  If the value has an invalid Unicode representation,
\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
value's string representation.  Appends are optimized to handle
repeated appends relatively efficiently (it over-allocates the string
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
value's string value).
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.
.PP
\fBTcl_AppendStringsToObj\fR is similar to \fBTcl_AppendToObj\fR
except that it can be passed more than one value to append and
each value must be a null-terminated string (i.e. none of the
values may contain internal null characters).  Any number of
\fIstring\fR arguments may be provided, but the last argument
must be a NULL pointer to indicate the end of the list.
.PP
\fBTcl_AppendStringsToObjVA\fR is the same as \fBTcl_AppendStringsToObj\fR
except that instead of taking a variable number of arguments it takes an
argument list.
.PP
.VS 8.5
\fBTcl_AppendLimitedToObj\fR is similar to \fBTcl_AppendToObj\fR
except that it imposes a limit on how many bytes are appended.
This can be handy when the string to be appended might be
very large, but the value being constructed should not be allowed to grow
without bound. A common usage is when constructing an error message, where the
end result should be kept short enough to be read.
Bytes from \fIbytes\fR are appended to \fIobjPtr\fR, but no more
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
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







-

-
+

-









-
+
-

-
+

-
+
-


-




-



-
+

-
-
+











-
+
-

-
-
+
+

-



-
-
-



-

-
-
+
-

-


+



-
+




-
+

-
+








-
+





-
+

-
+



-
+


-
+
+

+
-
+

-
+

The number of bytes appended can be less than the lesser
of \fIlength\fR and \fIlimit\fR when appending fewer
bytes is necessary to append only whole multi-byte characters.
.PP
\fBTcl_Format\fR is the C-level interface to the engine of the \fBformat\fR
command.  The actual command procedure for \fBformat\fR is little more
than
.PP
.CS
\fBTcl_Format\fR(interp, \fBTcl_GetString\fR(objv[1]), objc-2, objv+2);
Tcl_Format(interp, Tcl_GetString(objv[1]), objc-2, objv+2);
.CE
.PP
The \fIobjc\fR Tcl_Obj values in \fIobjv\fR are formatted into a string
according to the conversion specification in \fIformat\fR argument, following
the documentation for the \fBformat\fR command.  The resulting formatted
string is converted to a new Tcl_Obj with refcount of zero and returned.
If some error happens during production of the formatted string, NULL is
returned, and an error message is recorded in \fIinterp\fR, if \fIinterp\fR
is non-NULL.
.PP
\fBTcl_AppendFormatToObj\fR is an appending alternative form
of \fBTcl_Format\fR with functionality equivalent to:
of \fBTcl_Format\fR with functionality equivalent to
.PP
.CS
Tcl_Obj *newPtr = \fBTcl_Format\fR(interp, format, objc, objv);
Tcl_Obj *newPtr = Tcl_Format(interp, format, objc, objv);
if (newPtr == NULL) return TCL_ERROR;
\fBTcl_AppendObjToObj\fR(objPtr, newPtr);
Tcl_AppendObjToObj(objPtr, newPtr);
\fBTcl_DecrRefCount\fR(newPtr);
return TCL_OK;
.CE
.PP
but with greater convenience and efficiency when the appending
functionality is needed.
.PP
\fBTcl_ObjPrintf\fR serves as a replacement for the common sequence
.PP
.CS
char buf[SOME_SUITABLE_LENGTH];
sprintf(buf, format, ...);
\fBTcl_NewStringObj\fR(buf, -1);
Tcl_NewStringObj(buf, -1);
.CE
.PP
but with greater convenience and no need to
but with greater convenience and no need to 
determine \fBSOME_SUITABLE_LENGTH\fR. The formatting is done with the same
core formatting engine used by \fBTcl_Format\fR.  This means the set of
supported conversion specifiers is that of the \fBformat\fR command and
not that of the \fBsprintf\fR routine where the two sets differ. When a
conversion specifier passed to \fBTcl_ObjPrintf\fR includes a precision,
the value is taken as a number of bytes, as \fBsprintf\fR does, and not
as a number of characters, as \fBformat\fR does.  This is done on the
assumption that C code is more likely to know how many bytes it is
passing around than the number of encoded characters those bytes happen
to represent.  The variable number of arguments passed in should be of
the types that would be suitable for passing to \fBsprintf\fR.  Note in
this example usage, \fIx\fR is of type \fBint\fR.
this example usage, \fIx\fR is of type \fBlong\fR.
.PP
.CS
int x = 5;
Tcl_Obj *objPtr = \fBTcl_ObjPrintf\fR("Value is %d", x);
long x = 5;
Tcl_Obj *objPtr = Tcl_ObjPrintf("Value is %d", x);
.CE
.PP
If the value of \fIformat\fR contains internal inconsistencies or invalid
specifier formats, the formatted string result produced by
\fBTcl_ObjPrintf\fR will be an error message describing the error.
It is impossible however to provide runtime protection against
mismatches between the format and any subsequent arguments.
Compile-time protection may be provided by some compilers.
.PP
\fBTcl_AppendPrintfToObj\fR is an appending alternative form
of \fBTcl_ObjPrintf\fR with functionality equivalent to
.PP
.CS
Tcl_Obj *newPtr = \fBTcl_ObjPrintf\fR(format, ...);
\fBTcl_AppendObjToObj\fR(objPtr, newPtr);
Tcl_AppendObjToObj(objPtr, Tcl_ObjPrintf(format, ...));
\fBTcl_DecrRefCount\fR(newPtr);
.CE
.PP
but with greater convenience and efficiency when the appending
functionality is needed.
.VE 8.5
.PP
The \fBTcl_SetObjLength\fR procedure changes the length of the
string value of its \fIobjPtr\fR argument.  If the \fInewLength\fR
argument is greater than the space allocated for the value's
argument is greater than the space allocated for the object's
string, then the string space is reallocated and the old value
is copied to the new space; the bytes between the old length of
the string and the new length may have arbitrary values.
If the \fInewLength\fR argument is less than the current length
of the value's string, with \fIobjPtr->length\fR is reduced without
of the object's string, with \fIobjPtr->length\fR is reduced without
reallocating the string space; the original allocated size for the
string is recorded in the value, so that the string length can be
string is recorded in the object, so that the string length can be
enlarged in a subsequent call to \fBTcl_SetObjLength\fR without
reallocating storage.  In all cases \fBTcl_SetObjLength\fR leaves
a null character at \fIobjPtr->bytes[newLength]\fR.
.PP
\fBTcl_AttemptSetObjLength\fR is identical in function to
\fBTcl_SetObjLength\fR except that if sufficient memory to satisfy the
request cannot be allocated, it does not cause the Tcl interpreter to
\fBpanic\fR.  Thus, if \fInewLength\fR is greater than the space
allocated for the value's string, and there is not enough memory
allocated for the object's string, and there is not enough memory
available to satisfy the request, \fBTcl_AttemptSetObjLength\fR will take
no action and return 0 to indicate failure.  If there is enough memory
to satisfy the request, \fBTcl_AttemptSetObjLength\fR behaves just like
\fBTcl_SetObjLength\fR and returns 1 to indicate success.
.PP
The \fBTcl_ConcatObj\fR function returns a new string value whose
The \fBTcl_ConcatObj\fR function returns a new string object whose
value is the space-separated concatenation of the string
representations of all of the values in the \fIobjv\fR
representations of all of the objects in the \fIobjv\fR
array. \fBTcl_ConcatObj\fR eliminates leading and trailing white space
as it copies the string representations of the \fIobjv\fR array to the
result. If an element of the \fIobjv\fR array consists of nothing but
white space, then that value is ignored entirely. This white-space
white space, then that object is ignored entirely. This white-space
removal was added to make the output of the \fBconcat\fR command
cleaner-looking. \fBTcl_ConcatObj\fR returns a pointer to a
newly-created value whose ref count is zero.
newly-created object whose ref count is zero.

.SH "SEE ALSO"
Tcl_NewObj, Tcl_IncrRefCount, Tcl_DecrRefCount, format, sprintf
Tcl_NewObj(3), Tcl_IncrRefCount(3), Tcl_DecrRefCount(3), format(n), sprintf(3)

.SH KEYWORDS
append, internal representation, value, value type, string value,
append, internal representation, object, object type, string object,
string type, string representation, concat, concatenate, unicode

Changes to doc/SubstObj.3.

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
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





-
+




-
+













-
+













-
+







'\"
'\" Copyright (c) 2001 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_SubstObj 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_SubstObj \- perform substitutions on Tcl values
Tcl_SubstObj \- perform substitutions on Tcl objects
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
Tcl_Obj *
\fBTcl_SubstObj\fR(\fIinterp, objPtr, flags\fR)
.SH ARGUMENTS
.AS Tcl_Interp **termPtr
.AP Tcl_Interp *interp in
Interpreter in which to execute Tcl scripts and lookup variables.  If
an error occurs, the interpreter's result is modified to hold an error
message.
.AP Tcl_Obj *objPtr in
A Tcl value containing the string to perform substitutions on.
A Tcl object containing the string to perform substitutions on.
.AP int flags in
ORed combination of flag bits that specify which substitutions to
perform.  The flags \fBTCL_SUBST_COMMANDS\fR,
\fBTCL_SUBST_VARIABLES\fR and \fBTCL_SUBST_BACKSLASHES\fR are
currently supported, and \fBTCL_SUBST_ALL\fR is provided as a
convenience for the common case where all substitutions are desired.
.BE
.SH DESCRIPTION
.PP
The \fBTcl_SubstObj\fR function is used to perform substitutions on
strings in the fashion of the \fBsubst\fR command.  It gets the value
of the string contained in \fIobjPtr\fR and scans it, copying
characters and performing the chosen substitutions as it goes to an
output value which is returned as the result of the function.  In the
output object which is returned as the result of the function.  In the
event of an error occurring during the execution of a command or
variable substitution, the function returns NULL and an error message
is left in \fIinterp\fR's result.
.PP
Three kinds of substitutions are supported.  When the
\fBTCL_SUBST_BACKSLASHES\fR bit is set in \fIflags\fR, sequences that
look like backslash substitutions for Tcl commands are replaced by

Changes to doc/TCL_MEM_DEBUG.3.

1

2
3
4
5

6
7
8
9
10
11
12

1
2
3
4

5
6
7
8
9
10
11
12
-
+



-
+







'\"
'\" 
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
'\" 
.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TCL_MEM_DEBUG \- Compile-time flag to enable Tcl memory debugging
.BE
.SH DESCRIPTION
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
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







-
+









-
+








-
+












-
+


-
+





-
+


.PP
Once memory debugging support has been compiled into Tcl, the C
functions \fBTcl_ValidateAllMemory\fR, and \fBTcl_DumpActiveMemory\fR,
and the Tcl \fBmemory\fR command can be used to validate and examine
memory usage.
.SH "GUARD ZONES"
.PP
When memory debugging is enabled, whenever a call to \fBTcl_Alloc\fR is
When memory debugging is enabled, whenever a call to \fBckalloc\fR is
made, slightly more memory than requested is allocated so the memory
debugging code can keep track of the allocated memory, and eight-byte
.QW "guard zones"
are placed in front of and behind the space that will be
returned to the caller.  (The sizes of the guard zones are defined by the
C #define \fBLOW_GUARD_SIZE\fR and #define \fBHIGH_GUARD_SIZE\fR
in the file \fIgeneric/tclCkalloc.c\fR \(em it can
be extended if you suspect large overwrite problems, at some cost in
performance.)  A known pattern is written into the guard zones and, on
a call to \fBTcl_Free\fR, the guard zones of the space being freed are
a call to \fBckfree\fR, the guard zones of the space being freed are
checked to see if either zone has been modified in any way.  If one
has been, the guard bytes and their new contents are identified, and a
.QW "low guard failed"
or
.QW "high guard failed"
message is issued.  The
.QW "guard failed"
message includes the address of the memory packet and
the file name and line number of the code that called \fBTcl_Free\fR.
the file name and line number of the code that called \fBckfree\fR.
This allows you to detect the common sorts of one-off problems, where
not enough space was allocated to contain the data written, for
example.
.SH "DEBUGGING DIFFICULT MEMORY CORRUPTION PROBLEMS"
.PP
Normally, Tcl compiled with memory debugging enabled will make it easy
to isolate a corruption problem.  Turning on memory validation with
the memory command can help isolate difficult problems.  If you
suspect (or know) that corruption is occurring before the Tcl
interpreter comes up far enough for you to issue commands, you can set
\fBMEM_VALIDATE\fR define, recompile tclCkalloc.c and rebuild Tcl.
This will enable memory validation from the first call to
\fBTcl_Alloc\fR, again, at a large performance impact.
\fBckalloc\fR, again, at a large performance impact.
.PP
If you are desperate and validating memory on every call to
\fBTcl_Alloc\fR and \fBTcl_Free\fR is not enough, you can explicitly call
\fBckalloc\fR and \fBckfree\fR is not enough, you can explicitly call
\fBTcl_ValidateAllMemory\fR directly at any point.  It takes a \fIchar
*\fR and an \fIint\fR which are normally the filename and line number
of the caller, but they can actually be anything you want.  Remember
to remove the calls after you find the problem.
.SH "SEE ALSO"
Tcl_Alloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
ckalloc, memory, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory
.SH KEYWORDS
memory, debug

Changes to doc/Tcl.n.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
.TH Tcl n "8.5" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
Tcl \- Tool Command Language
.SH SYNOPSIS
Summary of Tcl language syntax.
.BE
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
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







-
-
-
-
+
+
+
+
















+











-
+

-
+
+







(see below) unless quoted.
.IP "[2] \fBEvaluation.\fR"
A command is evaluated in two steps.
First, the Tcl interpreter breaks the command into \fIwords\fR
and performs substitutions as described below.
These substitutions are performed in the same way for all
commands.
Secondly, the first word is used to locate a routine to
carry out the command, and the remaining words of the command are
passed to that routine.
The routine is free to interpret each of its words
The first word is used to locate a command procedure to
carry out the command, then all of the words of the command are
passed to the command procedure.
The command procedure is free to interpret each of its words
in any way it likes, such as an integer, variable name, list,
or Tcl script.
Different commands interpret their words differently.
.IP "[3] \fBWords.\fR"
Words of a command are separated by white space (except for
newlines, which are command separators).
.IP "[4] \fBDouble quotes.\fR"
If the first character of a word is double-quote
.PQ \N'34'
then the word is terminated by the next double-quote character.
If semi-colons, close brackets, or white space characters
(including newlines) appear between the quotes then they are treated
as ordinary characters and included in the word.
Command substitution, variable substitution, and backslash substitution
are performed on the characters between the quotes as described below.
The double-quotes are not retained as part of the word.
.VS 8.5 br
.IP "[5] \fBArgument expansion.\fR"
If a word starts with the string
.QW {*}
followed by a non-whitespace character, then the leading
.QW {*}
is removed and the rest of the word is parsed and substituted as any other
word. After substitution, the word is parsed as a list (without command or
variable substitutions; backslash substitutions are performed as is normal for
a list and individual internal words may be surrounded by either braces or
double-quote characters), and its words are added to the command being
substituted. For instance,
.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}"
.QW "cmd a {*}{b [c]} d {*}{$e f \N'34'g h\N'34'}"
is equivalent to
.QW "cmd a b {[c]} d {$e} f {g h}" .
.QW "cmd a b {[c]} d {$e} f \N'34'g h\N'34'" .
.VE 8.5
.IP "[6] \fBBraces.\fR"
If the first character of a word is an open brace
.PQ {
and rule [5] does not apply, then
the word is terminated by the matching close brace
.PQ } "" .
Braces nest within the word: for each additional open
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
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







-



-
-


-




-
-




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


-
-
-
-
















-
+


-
+


-
+


-
+


-
+


-
+


-
+














-
+

-
-
+
+
-
-
-
-
+

-
+

-
-
-
-
+
+
+
+
+

-
+



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







described below, then Tcl performs \fIvariable
substitution\fR:  the dollar-sign and the following characters are
replaced in the word by the value of a variable.
Variable substitution may take any of the following forms:
.RS
.TP 15
\fB$\fIname\fR
.
\fIName\fR is the name of a scalar variable;  the name is a sequence
of one or more characters that are a letter, digit, underscore,
or namespace separators (two or more colons).
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
.TP 15
\fB$\fIname\fB(\fIindex\fB)\fR
.
\fIName\fR gives the name of an array variable and \fIindex\fR gives
the name of an element within that array.
\fIName\fR must contain only letters, digits, underscores, and
namespace separators, and may be an empty string.
Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
Command substitutions, variable substitutions, and backslash
substitutions are performed on the characters of \fIindex\fR.
.TP 15
\fB${\fIname\fB}\fR
.
\fIName\fR is the name of a scalar variable or array element.  It may contain
any characters whatsoever except for close braces.  It indicates an array
\fIName\fR is the name of a scalar variable.  It may contain any
characters whatsoever except for close braces.
element if \fIname\fR is in the form
.QW \fIarrayName\fB(\fIindex\fB)\fR
where \fIarrayName\fR does not contain any open parenthesis characters,
.QW \fB(\fR ,
or close brace characters,
.QW \fB}\fR ,
and \fIindex\fR can be any sequence of characters except for close brace
characters.  No further
substitutions are performed during the parsing of \fIname\fR.
.PP
.LP
There may be any number of variable substitutions in a single word.
Variable substitution is not performed on words enclosed in braces.
.PP
Note that variables may contain character sequences other than those listed
above, but in that case other mechanisms must be used to access them (e.g.,
via the \fBset\fR command's single-argument form).
.RE
.IP "[9] \fBBackslash substitution.\fR"
If a backslash
.PQ \e
appears within a word then \fIbackslash substitution\fR occurs.
In all cases but those described below the backslash is dropped and
the following character is treated as an ordinary
character and included in the word.
This allows characters such as double quotes, close brackets,
and dollar signs to be included in words without triggering
special processing.
The following table lists the backslash sequences that are
handled specially, along with the value that replaces each sequence.
.RS
.TP 7
\e\fBa\fR
Audible alert (bell) (Unicode U+000007).
Audible alert (bell) (0x7).
.TP 7
\e\fBb\fR
Backspace (Unicode U+000008).
Backspace (0x8).
.TP 7
\e\fBf\fR
Form feed (Unicode U+00000C).
Form feed (0xC).
.TP 7
\e\fBn\fR
Newline (Unicode U+00000A).
Newline (0xA).
.TP 7
\e\fBr\fR
Carriage-return (Unicode U+00000D).
Carriage-return (0xD).
.TP 7
\e\fBt\fR
Tab (Unicode U+000009).
Tab (0x9).
.TP 7
\e\fBv\fR
Vertical tab (Unicode U+00000B).
Vertical tab (0xB).
.TP 7
\e\fB<newline>\fIwhiteSpace\fR
.
A single space character replaces the backslash, newline, and all spaces
and tabs after the newline.  This backslash sequence is unique in that it
is replaced in a separate pre-pass before the command is actually parsed.
This means that it will be replaced even when it occurs between braces,
and the resulting space will be treated as a word separator if it is not
in braces or quotes.
.TP 7
\e\e
Backslash
.PQ \e "" .
.TP 7
\e\fIooo\fR
\e\fIooo\fR 
.
The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal
value for the Unicode character that will be inserted, in the range
The digits \fIooo\fR (one, two, or three of them) give an eight-bit octal 
value for the Unicode character that will be inserted.  The upper bits of the
\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
The parser will stop just before this range overflows, or when
the maximum of three digits is reached.  The upper bits of the Unicode
character will be 0.
Unicode character will be 0.
.TP 7
\e\fBx\fIhh\fR
\e\fBx\fIhh\fR 
.
The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
hexadecimal value for the Unicode character that will be inserted.  The upper
bits of the Unicode character will be 0 (i.e., the character will be in the
range U+000000\(enU+0000FF).
The hexadecimal digits \fIhh\fR give an eight-bit hexadecimal value for the
Unicode character that will be inserted.  Any number of hexadecimal digits
may be present; however, all but the last two are ignored (the result is
always a one-byte quantity).  The upper bits of the Unicode character will
be 0.
.TP 7
\e\fBu\fIhhhh\fR
\e\fBu\fIhhhh\fR 
.
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 (i.e., the
inserted.
character will be in the range U+000000\(enU+00FFFF).
.TP 7
\e\fBU\fIhhhhhhhh\fR
.
.LP
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+000000\(enU+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.
.RS
.PP
The range U+00D800\(enU+00DFFF is reserved for surrogates, which
are illegal on its own. Therefore, such sequences will result in
the replacement character U+FFFD. Surrogate pairs should be
encoded as single \e\fBU\fIhhhhhhhh\fR character.
.RE
.PP
Backslash substitution is not performed on words enclosed in braces,
except for backslash-newline as described above.
.RE
.IP "[10] \fBComments.\fR"
If a hash character
.PQ #
appears at a point where Tcl is
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
213
214
215
216
217
218
219

220
221
222
223

224
225
226

227
228
229
230
231
232
233
234













-
+



-



-








-
-
-
-
-
-
value is inserted into the word verbatim.
If command substitution occurs then the nested command is
processed entirely by the recursive call to the Tcl interpreter;
no substitutions are performed before making the recursive
call and no additional substitutions are performed on the result
of the nested script.
.RS
.PP
.LP
Substitutions take place from left to right, and each substitution is
evaluated completely before attempting to evaluate the next.  Thus, a
sequence like
.PP
.CS
set y [set x 0][incr x][incr x]
.CE
.PP
will always set the variable \fIy\fR to the value, \fI012\fR.
.RE
.IP "[12] \fBSubstitution and word boundaries.\fR"
Substitutions do not affect the word boundaries of a command,
except for argument expansion as specified in rule [5].
For example, during variable substitution the entire value of
the variable becomes part of a single word, even if the variable's
value contains spaces.
.SH KEYWORDS
backslash, command, comment, script, substitution, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/TclZlib.3.

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




















































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 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.
'\"
.TH TclZlib 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Tcl_ZlibAdler32, Tcl_ZlibCRC32, Tcl_ZlibDeflate, Tcl_ZlibInflate, Tcl_ZlibStreamChecksum, Tcl_ZlibStreamClose, Tcl_ZlibStreamEof, Tcl_ZlibStreamGet, Tcl_ZlibStreamGetCommandName, Tcl_ZlibStreamInit, Tcl_ZlibStreamPut \- compression and decompression functions
.SH SYNOPSIS
.nf
#include <tcl.h>
.sp
int
\fBTcl_ZlibDeflate\fR(\fIinterp, format, dataObj, level, dictObj\fR)
.sp
int
\fBTcl_ZlibInflate\fR(\fIinterp, format, dataObj, dictObj\fR)
.sp
unsigned int
\fBTcl_ZlibCRC32\fR(\fIinitValue, bytes, length\fR)
.sp
unsigned int
\fBTcl_ZlibAdler32\fR(\fIinitValue, bytes, length\fR)
.sp
int
\fBTcl_ZlibStreamInit\fR(\fIinterp, mode, format, level, dictObj, zshandlePtr\fR)
.sp
Tcl_Obj *
\fBTcl_ZlibStreamGetCommandName\fR(\fIzshandle\fR)
.sp
int
\fBTcl_ZlibStreamEof\fR(\fIzshandle\fR)
.sp
int
\fBTcl_ZlibStreamClose\fR(\fIzshandle\fR)
.sp
int
\fBTcl_ZlibStreamReset\fR(\fIzshandle\fR)
.sp
int
\fBTcl_ZlibStreamChecksum\fR(\fIzshandle\fR)
.sp
int
\fBTcl_ZlibStreamPut\fR(\fIzshandle, dataObj, flush\fR)
.sp
int
\fBTcl_ZlibStreamGet\fR(\fIzshandle, dataObj, count\fR)
.sp
\fBTcl_ZlibStreamSetCompressionDictionary\fR(\fIzshandle, compDict\fR)
.fi
.SH ARGUMENTS
.AS Tcl_ZlibStream zshandle in
.AP Tcl_Interp *interp in
The interpreter to store resulting compressed or uncompressed data in. Also
where any error messages are written. For \fBTcl_ZlibStreamInit\fR, this can
be NULL to create a stream that is not bound to a command.
.AP int format in
What format of compressed data to work with. Must be one of
\fBTCL_ZLIB_FORMAT_ZLIB\fR for zlib-format data, \fBTCL_ZLIB_FORMAT_GZIP\fR
for gzip-format data, or \fBTCL_ZLIB_FORMAT_RAW\fR for raw compressed data. In
addition, for decompression only, \fBTCL_ZLIB_FORMAT_AUTO\fR may also be
chosen which can automatically detect whether the compressed data was in zlib
or gzip format.
.AP Tcl_Obj *dataObj in/out
A byte-array value containing the data to be compressed or decompressed, or
to which the data extracted from the stream is appended when passed to
\fBTcl_ZlibStreamGet\fR.
.AP int level in
What level of compression to use. Should be a number from 0 to 9 or one of the
following: \fBTCL_ZLIB_COMPRESS_NONE\fR for no compression,
\fBTCL_ZLIB_COMPRESS_FAST\fR for fast but inefficient compression,
\fBTCL_ZLIB_COMPRESS_BEST\fR for slow but maximal compression, or
\fBTCL_ZLIB_COMPRESS_DEFAULT\fR for the level recommended by the zlib library.
.AP Tcl_Obj *dictObj in/out
A dictionary that contains, or which will be updated to contain, a description
of the gzip header associated with the compressed data. Only useful when the
\fIformat\fR is \fBTCL_ZLIB_FORMAT_GZIP\fR or \fBTCL_ZLIB_FORMAT_AUTO\fR. If
a NULL is passed, a default header will be used on compression and the header
will be ignored (apart from integrity checks) on decompression. See the
section \fBGZIP OPTIONS DICTIONARY\fR for details about the contents of this
dictionary.
.AP "unsigned int" initValue in
The initial value for the checksum algorithm.
.AP "unsigned char" *bytes in
An array of bytes to run the checksum algorithm over, or NULL to get the
recommended initial value for the checksum algorithm.
.AP size_t length in
The number of bytes in the array.
.AP int mode in
What mode to operate the stream in. Should be either
\fBTCL_ZLIB_STREAM_DEFLATE\fR for a compressing stream or
\fBTCL_ZLIB_STREAM_INFLATE\fR for a decompressing stream.
.AP Tcl_ZlibStream *zshandlePtr out
A pointer to a variable in which to write the abstract token for the stream
upon successful creation.
.AP Tcl_ZlibStream zshandle in
The abstract token for the stream to operate on.
.AP int flush in
Whether and how to flush the stream after writing the data to it. Must be one
of: \fBTCL_ZLIB_NO_FLUSH\fR if no flushing is to be done, \fBTCL_ZLIB_FLUSH\fR
if the currently compressed data must be made available for access using
\fBTcl_ZlibStreamGet\fR, \fBTCL_ZLIB_FULLFLUSH\fR if the stream must be put
into a state where the decompressor can recover from on corruption, or
\fBTCL_ZLIB_FINALIZE\fR to ensure that the stream is finished and that any
trailer demanded by the format is written.
.AP size_t count in
The maximum number of bytes to get from the stream, or TCL_INDEX_NONE to get
all remaining bytes from the stream's buffers.
.AP Tcl_Obj *compDict in
A byte array value that is the compression dictionary to use with the stream.
Note that this is \fInot a Tcl dictionary\fR, and it is recommended that this
only ever be used with streams that were created with their \fIformat\fR set
to \fBTCL_ZLIB_FORMAT_ZLIB\fR because the other formats have no mechanism to
indicate whether a compression dictionary was present other than to fail on
decompression.
.BE
.SH DESCRIPTION
These functions form the interface from the Tcl library to the Zlib
library by Jean-loup Gailly and Mark Adler.
.PP
\fBTcl_ZlibDeflate\fR and \fBTcl_ZlibInflate\fR respectively compress and
decompress the data contained in the \fIdataObj\fR argument, according to the
\fIformat\fR and, for compression, \fIlevel\fR arguments. The dictionary in
the \fIdictObj\fR parameter is used to convey additional header information
about the compressed data when the compression format supports it; currently,
the dictionary is only used when the \fIformat\fR parameter is
\fBTCL_ZLIB_FORMAT_GZIP\fR or \fBTCL_ZLIB_FORMAT_AUTO\fR. For details of the
contents of the dictionary, see the \fBGZIP OPTIONS DICTIONARY\fR section
below. Upon success, both functions leave the resulting compressed or
decompressed data in a byte-array value that is the Tcl interpreter's result;
the returned value is a standard Tcl result code.
.PP
\fBTcl_ZlibAdler32\fR and \fBTcl_ZlibCRC32\fR compute checksums on arrays of
bytes, returning the computed checksum. Checksums are computed incrementally,
allowing data to be processed one block at a time, but this requires the
caller to maintain the current checksum and pass it in as the \fIinitValue\fR
parameter; the initial value to use for this can be obtained by using NULL for
the \fIbytes\fR parameter instead of a pointer to the array of bytes to
compute the checksum over. Thus, typical usage in the single data block case
is like this:
.PP
.CS
checksum = \fBTcl_ZlibCRC32\fR(\fBTcl_ZlibCRC32\fR(0,NULL,0), data, length);
.CE
.PP
Note that the Adler-32 algorithm is not a real checksum, but instead is a
related type of hash that works best on longer data.
.SS "ZLIB STREAMS"
.PP
\fBTcl_ZlibStreamInit\fR creates a compressing or decompressing stream that is
linked to a Tcl command, according to its arguments, and provides an abstract
token for the stream and returns a normal Tcl result code;
\fBTcl_ZlibStreamGetCommandName\fR returns the name of that command given the
stream token, or NULL if the stream has no command. Streams are not designed
to be thread-safe; each stream should only ever be used from the thread that
created it. When working with gzip streams, a dictionary (fields as given in
the \fBGZIP OPTIONS DICTIONARY\fR section below) can be given via the
\fIdictObj\fR parameter that on compression allows control over the generated
headers, and on decompression allows discovery of the existing headers. Note
that the dictionary will be written to on decompression once sufficient data
has been read to have a complete header. This means that the dictionary must
be an unshared value in that case; a blank value created with
\fBTcl_NewObj\fR is suggested.
.PP
Once a stream has been constructed, \fBTcl_ZlibStreamPut\fR is used to add
data to the stream and \fBTcl_ZlibStreamGet\fR is used to retrieve data from
the stream after processing. Both return normal Tcl result codes and leave an
error message in the result of the interpreter that the stream is registered
with in the error case (if such a registration has been performed). With
\fBTcl_ZlibStreamPut\fR, the data buffer value passed to it should not be
modified afterwards. With \fBTcl_ZlibStreamGet\fR, the data buffer value
passed to it will have the data bytes appended to it. Internally to the
stream, data is kept compressed so as to minimize the cost of buffer space.
.PP
\fBTcl_ZlibStreamChecksum\fR returns the checksum computed over the
uncompressed data according to the format, and \fBTcl_ZlibStreamEof\fR returns
a boolean value indicating whether the end of the uncompressed data has been
reached.
.PP
\fBTcl_ZlibStreamSetCompressionDictionary\fR is used to control the
compression dictionary used with the stream, a compression dictionary being an
array of bytes (such as might be created with \fBTcl_NewByteArrayObj\fR) that
is used to initialize the compression engine rather than leaving it to create
it on the fly from the data being compressed. Setting a compression dictionary
allows for more efficient compression in the case where the start of the data
is highly regular, but it does require both the compressor and the
decompressor to agreee on the value to use. Compression dictionaries are only
fully supported for zlib-format data; on compression, they must be set before
any data is sent in with \fBTcl_ZlibStreamPut\fR, and on decompression they
should be set when \fBTcl_ZlibStreamGet\fR produces an \fBerror\fR with its
\fB\-errorcode\fR set to
.QW "\fBZLIB NEED_DICT\fI code\fR" ;
the \fIcode\fR will be the Adler-32 checksum (see \fBTcl_ZlibAdler32\fR) of
the compression dictionary sought. (Note that this is only true for
zlib-format streams; gzip streams ignore compression dictionaries as the
format specification doesn't permit them, and raw streams just produce a data
error if the compression dictionary is missing or incorrect.)
.PP
If you wish to clear a stream and reuse it for a new compression or
decompression action, \fBTcl_ZlibStreamReset\fR will do this and return a
normal Tcl result code to indicate whether it was successful; if the stream is
registered with an interpreter, an error message will be left in the
interpreter result when this function returns TCL_ERROR.
Finally, \fBTcl_ZlibStreamClose\fR will clean up the stream and delete the
associated command: using \fBTcl_DeleteCommand\fR on the stream's command is
equivalent (when such a command exists).
.SH "GZIP OPTIONS DICTIONARY"
.PP
The \fIdictObj\fR parameter to \fBTcl_ZlibDeflate\fR, \fBTcl_ZlibInflate\fR
and \fBTcl_ZlibStreamInit\fR is used to pass a dictionary of options about
that is used to describe the gzip header in the compressed data. When creating
compressed data, the dictionary is read and when unpacking compressed data the
dictionary is written (in which case the \fIdictObj\fR parameter must refer to
an unshared dictionary value).
.PP
The following fields in the dictionary value are understood. All other fields
are ignored. No field is required when creating a gzip-format stream.
.TP
\fBcomment\fR
.
This holds the comment field of the header, if present. If absent, no comment
was supplied (on decompression) or will be created (on compression).
.TP
\fBcrc\fR
.
A boolean value describing whether a CRC of the header is computed. Note that
the \fBgzip\fR program does \fInot\fR use or allow a CRC on the header.
.TP
\fBfilename\fR
.
The name of the file that held the uncompressed data. This should not contain
any directory separators, and should be sanitized before use on decompression
with \fBfile tail\fR.
.TP
\fBos\fR
.
The operating system type code field from the header (if not the
.QW unknown
value). See RFC 1952 for the meaning of these codes. On compression, if this
is absent then the field will be set to the
.QW unknown
value.
.TP
\fBsize\fR
.
The size of the uncompressed data. This is ignored on compression; the size
of the data compressed depends on how much data is supplied to the
compression engine.
.TP
\fBtime\fR
.
The time field from the header if non-zero, expected to be the time that the
file named by the \fBfilename\fR field was modified. Suitable for use with
\fBclock format\fR. On creation, the right value to use is that from
\fBclock seconds\fR or \fBfile mtime\fR.
.TP
\fBtype\fR
.
The type of the uncompressed data (either \fBbinary\fR or \fBtext\fR) if
known.
.SH "PORTABILITY NOTES"
These functions will fail gracefully if Tcl is not linked with the zlib
library.
.SH "SEE ALSO"
Tcl_NewByteArrayObj(3), zlib(n)
'\"Tcl_StackChannel(3)
.SH "KEYWORDS"
compress, decompress, deflate, gzip, inflate
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/Tcl_Main.3.

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
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







-
+




-
+






-
-
-
-
-






-
+
-



-
-
-
-
-
-
-



+









-
+





-
+




















-
+







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



-
-
+
+
+

-
+









-
-
-
-
+
+
-

-
-
+

-
+



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







-
+










-

-
+











-
+
-


-
+
+


'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_Main 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_Main, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications
Tcl_Main, Tcl_SetMainLoop \- main program and event loop definition for Tcl-based applications
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_Main\fR(\fIargc, argv, appInitProc\fR)
.sp
\fBTcl_SetStartupScript\fR(\fIpath, encoding\fR)
.sp
Tcl_Obj *
\fBTcl_GetStartupScript\fR(\fIencodingPtr\fR)
.sp
\fBTcl_SetMainLoop\fR(\fImainLoopProc\fR)
.SH ARGUMENTS
.AS Tcl_MainLoopProc *mainLoopProc
.AP int argc in
Number of elements in \fIargv\fR.
.AP char *argv[] in
Array of strings containing command-line arguments. On Windows, when
Array of strings containing command-line arguments.
using -DUNICODE, the parameter type changes to wchar_t *.
.AP Tcl_AppInitProc *appInitProc in
Address of an application-specific initialization procedure.
The value for this argument is usually \fBTcl_AppInit\fR.
.AP Tcl_Obj *path in
Name of file to use as startup script, or NULL.
.AP "const char" *encoding in
Encoding of file to use as startup script, or NULL.
.AP "const char" **encodingPtr out
If non-NULL, location to write a copy of the (const char *)
pointing to the encoding name.
.AP Tcl_MainLoopProc *mainLoopProc in
Address of an application-specific event loop procedure.
.BE

.SH DESCRIPTION
.PP
\fBTcl_Main\fR can serve as the main program for Tcl-based shell
applications.  A
.QW "shell application"
is a program
like tclsh or wish that supports both interactive interpretation
of Tcl and evaluation of a script contained in a file given as
a command line argument.  \fBTcl_Main\fR is offered as a convenience
to developers of shell applications, so they do not have to
to developers of shell applications, so they do not have to 
reproduce all of the code for proper initialization of the Tcl
library and interactive shell operation.  Other styles of embedding
Tcl in an application are not supported by \fBTcl_Main\fR.  Those
must be achieved by calling lower level functions in the Tcl library
directly.
.PP

The \fBTcl_Main\fR function has been offered by the Tcl library
since release Tcl 7.4.  In older releases of Tcl, the Tcl library
itself defined a function \fBmain\fR, but that lacks flexibility
of embedding style and having a function \fBmain\fR in a library
(particularly a shared library) causes problems on many systems.
Having \fBmain\fR in the Tcl library would also make it hard to use
Tcl in C++ programs, since C++ programs must have special C++
\fBmain\fR functions.
.PP
Normally each shell application contains a small \fBmain\fR function
that does nothing but invoke \fBTcl_Main\fR.
\fBTcl_Main\fR then does all the work of creating and running a
\fBtclsh\fR-like application.
.PP
\fBTcl_Main\fR is not provided by the public interface of Tcl's
stub library.  Programs that call \fBTcl_Main\fR must be linked
against the standard Tcl library.  Extensions (stub-enabled or
not) are not intended to call \fBTcl_Main\fR.
.PP
\fBTcl_Main\fR is not thread-safe.  It should only be called by
a single main thread of a multi-threaded application.  This
a single master thread of a multi-threaded application.  This
restriction is not a problem with normal use described above.
.PP
\fBTcl_Main\fR and therefore all applications based upon it, like
\fBtclsh\fR, use \fBTcl_GetStdChannel\fR to initialize the standard
channels to their default values. See \fBTcl_StandardChannels\fR for
more information.
.PP
\fBTcl_Main\fR supports two modes of operation, depending on
\fBTcl_Main\fR supports two modes of operation, depending on the
whether the filename and encoding of a startup script has been
established.  The routines \fBTcl_SetStartupScript\fR and
\fBTcl_GetStartupScript\fR are the tools for controlling this
configuration of \fBTcl_Main\fR.
.PP
\fBTcl_SetStartupScript\fR registers the value \fIpath\fR
as the name of the file for \fBTcl_Main\fR to evaluate as
its startup script.  The value \fIencoding\fR is Tcl's name
for the encoding used to store the text in that file.  A
value of \fBNULL\fR for \fIencoding\fR is a signal to use
the system encoding.  A value of \fBNULL\fR for \fIpath\fR
erases any existing registration so that \fBTcl_Main\fR
will not evaluate any startup script.
.PP
\fBTcl_GetStartupScript\fR queries the registered file name
and encoding set by the most recent \fBTcl_SetStartupScript\fR
call in the same thread.  The stored file name is returned,
and the stored encoding name is written to space pointed to
by \fIencodingPtr\fR, when that is not NULL.
.PP
The file name and encoding values managed by the routines
\fBTcl_SetStartupScript\fR and \fBTcl_GetStartupScript\fR
are stored per-thread.  Although the storage and retrieval
functions of these routines work in any thread, only those
calls in the same main thread as \fBTcl_Main\fR can have
any influence on it.
.PP
The caller of \fBTcl_Main\fR may call \fBTcl_SetStartupScript\fR
first to establish its desired startup script.  If \fBTcl_Main\fR
finds that no such startup script has been established, it consults
the first few arguments in \fIargv\fR.  If they match
?\fB\-encoding \fIname\fR? \fIfileName\fR,
values of \fIargc\fR and \fIargv\fR.  If the first few arguments
in \fIargv\fR match ?\fB\-encoding \fIname\fR? \fIfileName\fR,
where \fIfileName\fR does not begin with the character \fI\-\fR,
then \fIfileName\fR is taken to be the name of a file containing
a \fIstartup script\fR, and \fIname\fR is taken to be the name
of the encoding of the contents of that file.  \fBTcl_Main\fR
then calls \fBTcl_SetStartupScript\fR with these values.
of the encoding of the contents of that file, which \fBTcl_Main\fR
will attempt to evaluate.  Otherwise, \fBTcl_Main\fR will enter an
interactive mode.
.PP
\fBTcl_Main\fR then defines in its main interpreter
In either mode, \fBTcl_Main\fR will define in its master interpreter
the Tcl variables \fIargc\fR, \fIargv\fR, \fIargv0\fR, and
\fItcl_interactive\fR, as described in the documentation for \fBtclsh\fR.
.PP
When it has finished its own initialization, but before it processes
commands, \fBTcl_Main\fR calls the procedure given by the
\fIappInitProc\fR argument.  This procedure provides a
.QW hook
for the application to perform its own initialization of the interpreter
created by \fBTcl_Main\fR, such as defining application-specific
commands.  The application initialization routine might also
call \fBTcl_SetStartupScript\fR to (re-)set the file and encoding
to be used as a startup script.  The procedure must have an interface
that matches the type \fBTcl_AppInitProc\fR:
commands.  The procedure must have an interface that matches the
type \fBTcl_AppInitProc\fR:
.PP
.CS
typedef int \fBTcl_AppInitProc\fR(
        Tcl_Interp *\fIinterp\fR);
typedef int Tcl_AppInitProc(Tcl_Interp *\fIinterp\fR);
.CE
.PP

\fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR; for more
details on this procedure, see the documentation for \fBTcl_AppInit\fR.
.PP
When the \fIappInitProc\fR is finished, \fBTcl_Main\fR calls
When the \fIappInitProc\fR is finished, \fBTcl_Main\fR enters one
\fBTcl_GetStartupScript\fR to determine what startup script has
been requested, if any.  If a startup script has been provided,
\fBTcl_Main\fR attempts to evaluate it.  Otherwise, interactive
mode begins with examination of the variable \fItcl_rcFileName\fR
in the main interpreter.  If that variable exists and holds the
name of a readable file, the contents of that file are evaluated
in the main interpreter.  Then interactive operations begin,
of its two modes.  If a startup script has been provided, \fBTcl_Main\fR
attempts to evaluate it.  Otherwise, interactive mode begins with
examination of the variable \fItcl_rcFileName\fR in the master
interpreter.  If that variable exists and holds the name of a readable
file, the contents of that file are evaluated in the master interpreter.
Then interactive operations begin,
with prompts and command evaluation results written to the standard
output channel, and commands read from the standard input channel
and then evaluated.  The prompts written to the standard output
channel may be customized by defining the Tcl variables \fItcl_prompt1\fR
and \fItcl_prompt2\fR as described in the documentation for \fBtclsh\fR.
The prompts and command evaluation results are written to the standard
output channel only if the Tcl variable \fItcl_interactive\fR in the
main interpreter holds a non-zero integer value.
master interpreter holds a non-zero integer value.
.PP
\fBTcl_SetMainLoop\fR allows setting an event loop procedure to be run.
This allows, for example, Tk to be dynamically loaded and set its event
loop.  The event loop will run following the startup script.  If you
are in interactive mode, setting the main loop procedure will cause the
prompt to become fileevent based and then the loop procedure is called.
When the loop procedure returns in interactive mode, interactive operation
will continue.
The main loop procedure must have an interface that matches the type
\fBTcl_MainLoopProc\fR:
.PP
.CS
typedef void \fBTcl_MainLoopProc\fR(void);
typedef void Tcl_MainLoopProc(void);
.CE
.PP
\fBTcl_Main\fR does not return.  Normally a program based on
\fBTcl_Main\fR will terminate when the \fBexit\fR command is
evaluated.  In interactive mode, if an EOF or channel error
is encountered on the standard input channel, then \fBTcl_Main\fR
itself will evaluate the \fBexit\fR command after the main loop
procedure (if any) returns.  In non-interactive mode, after
\fBTcl_Main\fR evaluates the startup script, and the main loop
procedure (if any) returns, \fBTcl_Main\fR will also evaluate
the \fBexit\fR command.
.PP

\fBTcl_Main\fR can not be used in stub-enabled extensions.
.SH "SEE ALSO"
tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3),
exit(n), encoding(n)
exit(n)

.SH KEYWORDS
application-specific initialization, command-line arguments, main program

Changes to doc/Thread.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1999 Scriptics Corporation
'\" Copyright (c) 1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Threads 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_ConditionNotify, Tcl_ConditionWait, Tcl_ConditionFinalize, Tcl_GetThreadData, Tcl_MutexLock, Tcl_MutexUnlock, Tcl_MutexFinalize, Tcl_CreateThread, Tcl_JoinThread \- Tcl thread support
.SH SYNOPSIS
.nf
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
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







-
+




-
+



-
-
+
-
-
+















-
+


-
-
+
+



-
+








-
+
-
-
-
+
+









-
+




-
-
-
-
+
+
+
+







void
\fBTcl_MutexUnlock\fR(\fImutexPtr\fR)
.sp
void
\fBTcl_MutexFinalize\fR(\fImutexPtr\fR)
.sp
int
\fBTcl_CreateThread\fR(\fIidPtr, proc, clientData, stackSize, flags\fR)
\fBTcl_CreateThread\fR(\fIidPtr, threadProc, clientData, stackSize, flags\fR)
.sp
int
\fBTcl_JoinThread\fR(\fIid, result\fR)
.SH ARGUMENTS
.AS Tcl_CreateThreadProc proc out
.AS Tcl_CreateThreadProc threadProc out
.AP Tcl_Condition *condPtr in
A condition variable, which must be associated with a mutex lock.
.AP Tcl_Mutex *mutexPtr in
.VS TIP509
A recursive mutex lock.
A mutex lock.
.VE TIP509
.AP "const Tcl_Time" *timePtr in
.AP Tcl_Time *timePtr in
A time limit on the condition wait.  NULL to wait forever.
Note that a polling value of 0 seconds does not make much sense.
.AP Tcl_ThreadDataKey *keyPtr in
This identifies a block of thread local storage.  The key should be
static and process-wide, yet each thread will end up associating
a different block of storage with this key.
.AP int *size in
The size of the thread local storage block.  This amount of data
is allocated and initialized to zero the first time each thread
calls \fBTcl_GetThreadData\fR.
.AP Tcl_ThreadId *idPtr out
The referred storage will contain the id of the newly created thread as
returned by the operating system.
.AP Tcl_ThreadId id in
Id of the thread waited upon.
.AP Tcl_ThreadCreateProc *proc in
.AP Tcl_ThreadCreateProc threadProc in
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP void *clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP ClientData clientData in
Arbitrary information. Passed as sole argument to the \fIthreadProc\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
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.  Starting with the 8.6 release, Tcl
customizing the Tcl core.  To enable Tcl multithreading support,
multithreading support is on by default. To disable Tcl multithreading
support, you must include the \fB\-\|\-disable-threads\fR option to
\fBconfigure\fR when you configure and compile your Tcl core.
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
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 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.
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
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
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







-
+












-
-
-
-
-
+
-
+







thread which already exited is possible, the system will retain the
necessary information until after the call to \fBTcl_JoinThread\fR.
This means that not calling \fBTcl_JoinThread\fR for a joinable thread
will cause a memory leak.
.PP
The \fBTcl_GetThreadData\fR call returns a pointer to a block of
thread-private data.  Its argument is a key that is shared by all threads
and a size for the block of storage.  The storage is automatically
and a size for the block of storage.  The storage is automatically 
allocated and initialized to all zeros the first time each thread asks for it.
The storage is automatically deallocated by \fBTcl_FinalizeThread\fR.
.SS "SYNCHRONIZATION AND COMMUNICATION"
Tcl provides \fBTcl_ThreadQueueEvent\fR and \fBTcl_ThreadAlert\fR
for handling event queuing in multithreaded applications.  See
the \fBNotifier\fR manual page for more information on these procedures.
.PP
A mutex is a lock that is used to serialize all threads through a piece
of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
block until \fBTcl_MutexUnlock\fR is called.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
.VS TIP509
Mutexes are reentrant: they can be locked several times from the same
thread. However there must be exactly one call to
\fBTcl_MutexUnlock\fR for each call to \fBTcl_MutexLock\fR in order
for a thread to release a mutex completely.
The result of locking a mutex twice from the same thread is undefined.
.VE TIP509
On some platforms it will result in a deadlock.
The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
procedures are defined as empty macros if not compiling with threads enabled.
For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.
This macro assures correct mutex handling even when the core is compiled
without threads enabled.
.PP
A condition variable is used as a signaling mechanism:
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
176
177
178
179
180
181
182

183
184
185
186
187
188


































189













190
191
192
193
194
195







-
+





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






upon first use.
The mutexes and condition variables are
either cleaned up by process exit handlers (if living that long) or
explicitly by calls to \fBTcl_MutexFinalize\fR or
\fBTcl_ConditionFinalize\fR.
Thread local storage is reclaimed during \fBTcl_FinalizeThread\fR.
.SH "SCRIPT-LEVEL ACCESS TO THREADS"
.PP
.VS 8.5
Tcl provides no built-in commands for scripts to use to create,
manage, or join threads, nor any script-level access to mutex or
condition variables.  It provides such facilities only via C
interfaces, and leaves it up to packages to expose these matters to
the script level.  One such package is the \fBThread\fR package.
.SH EXAMPLE
.PP
To create a thread with portable code, its implementation function should be
declared as follows:
.PP
.CS
static \fBTcl_ThreadCreateProc\fR MyThreadImplFunc;
.CE
.PP
It should then be defined like this example, which just counts up to a given
value and then finishes.
.PP
.CS
static \fBTcl_ThreadCreateType\fR
MyThreadImplFunc(
    void *clientData)
{
    int i, limit = (int) clientData;
    for (i=0 ; i<limit ; i++) {
        /* doing nothing at all here */
    }
    \fBTCL_THREAD_CREATE_RETURN\fR;
}
.CE
.PP
To create the above thread, make it execute, and wait for it to finish, we
would do this:
.PP
.CS
int limit = 1000000000;
void *limitData = (void*)((intptr_t) limit);
Tcl_ThreadId id;    \fI/* holds identity of thread created */\fR
int result;

.VE 8.5
if (\fBTcl_CreateThread\fR(&id, MyThreadImplFunc, limitData,
        \fBTCL_THREAD_STACK_DEFAULT\fR,
        \fBTCL_THREAD_JOINABLE\fR) != TCL_OK) {
    \fI/* Thread did not create correctly */\fR
    return;
}
\fI/* Do something else for a while here */\fR
if (\fBTcl_JoinThread\fR(id, &result) != TCL_OK) {
    \fI/* Thread did not finish properly */\fR
    return;
}
\fI/* All cleaned up nicely */\fR
.CE
.SH "SEE ALSO"
Tcl_GetCurrentThread(3), Tcl_ThreadQueueEvent(3), Tcl_ThreadAlert(3),
Tcl_ExitThread(3), Tcl_FinalizeThread(3), Tcl_CreateThreadExitHandler(3),
Tcl_DeleteThreadExitHandler(3), Thread
.SH KEYWORDS
thread, mutex, condition variable, thread local storage

Changes to doc/ToUpper.3.

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
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) 1997 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.
'\"
'\" 
.TH Tcl_UtfToUpper 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_UtfToLower, Tcl_UtfToTitle \- routines for manipulating the case of Unicode characters and UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
Tcl_UniChar
\fBTcl_UniCharToUpper\fR(\fIch\fR)
.sp
int
Tcl_UniChar
\fBTcl_UniCharToLower\fR(\fIch\fR)
.sp
int
Tcl_UniChar
\fBTcl_UniCharToTitle\fR(\fIch\fR)
.sp
int
\fBTcl_UtfToUpper\fR(\fIstr\fR)
.sp
int
\fBTcl_UtfToLower\fR(\fIstr\fR)
.sp
int
\fBTcl_UtfToTitle\fR(\fIstr\fR)
.SH ARGUMENTS
.AS char *str in/out
.AP int ch in
The Unicode character to be converted.
The Tcl_UniChar to be converted.
.AP char *str in/out
Pointer to UTF-8 string to be converted in place.
.BE

.SH DESCRIPTION
.PP
The first three routines convert the case of individual Unicode characters:
74
75
76
77
78
79
80






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







+
+
+
+
+
+


\fBTcl_UtfToLower\fR is the same as \fBTcl_UtfToUpper\fR except it
turns each character in the string into its lower-case equivalent.
.PP
\fBTcl_UtfToTitle\fR is the same as \fBTcl_UtfToUpper\fR except it
turns the first character in the string into its title-case equivalent
and all following characters into their lower-case equivalents.

.SH BUGS
.PP
At this time, the case conversions are only defined for the ISO8859-1
characters.  Unicode characters above 0x00FF are not modified by these
routines.

.SH KEYWORDS
utf, unicode, toupper, tolower, totitle, case

Changes to doc/TraceCmd.3.

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
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





-
+









-
+


















-
+

-
+







'\"
'\" Copyright (c) 2002 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_TraceCommand 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_CommandTraceInfo, Tcl_TraceCommand, Tcl_UntraceCommand \- monitor renames and deletes of a command
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void *
ClientData
\fBTcl_CommandTraceInfo(\fIinterp, cmdName, flags, proc, prevClientData\fB)\fR
.sp
int
\fBTcl_TraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
.sp
void
\fBTcl_UntraceCommand(\fIinterp, cmdName, flags, proc, clientData\fB)\fR
.SH ARGUMENTS
.AS Tcl_CommandTraceProc prevClientData
.AP Tcl_Interp *interp in
Interpreter containing the command.
.AP "const char" *cmdName in
Name of command.
.AP int flags in
OR'ed collection of the values \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR.
.AP Tcl_CommandTraceProc *proc in
Procedure to call when specified operations occur to \fIcmdName\fR.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary argument to pass to \fIproc\fR.
.AP void *prevClientData in
.AP ClientData prevClientData in
If non-NULL, gives last value returned by \fBTcl_CommandTraceInfo\fR,
so this call will return information about next trace.  If NULL, this
call will return information about first trace.
.BE
.SH DESCRIPTION
.PP
\fBTcl_TraceCommand\fR allows a C procedure to monitor operations
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
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







-

-
-
+
+





-


-
+







.TP
\fBTCL_TRACE_DELETE\fR
Invoke \fIproc\fR when the command is deleted.
.PP
Whenever one of the specified operations occurs to the command,
\fIproc\fR will be invoked.  It should have arguments and result that
match the type \fBTcl_CommandTraceProc\fR:
.PP
.CS
typedef void \fBTcl_CommandTraceProc\fR(
        void *\fIclientData\fR,
typedef void Tcl_CommandTraceProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        const char *\fIoldName\fR,
        const char *\fInewName\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will have the same
values as those passed to \fBTcl_TraceCommand\fR when the trace was
created.  \fIclientData\fR typically points to an application-specific
created.  \fIClientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR is invoked.
\fIOldName\fR gives the name of the command being renamed, and
\fInewName\fR gives the name that the command is being renamed to (or
NULL when the command is being deleted.)
\fIFlags\fR is an OR'ed combination of bits potentially providing
several pieces of information.  One of the bits \fBTCL_TRACE_RENAME\fR and
\fBTCL_TRACE_DELETE\fR will be set in \fIflags\fR to indicate which

Changes to doc/TraceVar.3.

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
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






-
-
+
+


















-
+


-
+


-
+















-
+







-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tcl_TraceVar 3 9.0 Tcl "Tcl Library Procedures"
'\" 
.TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_TraceVar, Tcl_TraceVar2, Tcl_UntraceVar, Tcl_UntraceVar2, Tcl_VarTraceInfo, Tcl_VarTraceInfo2 \- monitor accesses to a variable
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
int
\fBTcl_TraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR
.sp
int
\fBTcl_TraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
.sp
\fBTcl_UntraceVar(\fIinterp, varName, flags, proc, clientData\fB)\fR
.sp
\fBTcl_UntraceVar2(\fIinterp, name1, name2, flags, proc, clientData\fB)\fR
.sp
void *
ClientData
\fBTcl_VarTraceInfo(\fIinterp, varName, flags, proc, prevClientData\fB)\fR
.sp
void *
ClientData
\fBTcl_VarTraceInfo2(\fIinterp, name1, name2, flags, proc, prevClientData\fB)\fR
.SH ARGUMENTS
.AS void *prevClientData
.AS Tcl_VarTraceProc prevClientData
.AP Tcl_Interp *interp in
Interpreter containing variable.
.AP "const char" *varName in
Name of variable.  May refer to a scalar variable, to
an array variable with no index, or to an array variable
with a parenthesized index.
.AP int flags in
OR-ed combination of the values \fBTCL_TRACE_READS\fR,
\fBTCL_TRACE_WRITES\fR, \fBTCL_TRACE_UNSETS\fR, \fBTCL_TRACE_ARRAY\fR,
\fBTCL_GLOBAL_ONLY\fR, \fBTCL_NAMESPACE_ONLY\fR,
\fBTCL_TRACE_RESULT_DYNAMIC\fR and \fBTCL_TRACE_RESULT_OBJECT\fR.
Not all flags are used by all
procedures.  See below for more information.
.AP Tcl_VarTraceProc *proc in
Procedure to invoke whenever one of the traced operations occurs.
.AP void *clientData in
.AP ClientData clientData in
Arbitrary one-word value to pass to \fIproc\fR.
.AP "const char" *name1 in
Name of scalar or array variable (without array index).
.AP "const char" *name2 in
For a trace on an element of an array, gives the index of the
element.  For traces on scalar variables or on whole arrays,
is NULL.
.AP void *prevClientData in
.AP ClientData prevClientData in
If non-NULL, gives last value returned by \fBTcl_VarTraceInfo\fR or
\fBTcl_VarTraceInfo2\fR, so this call will return information about
next trace.  If NULL, this call will return information about first
trace.
.BE
.SH DESCRIPTION
.PP
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
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







-
+











-
+













-

-
-
+
+





-



-
+







\fBTCL_TRACE_WRITES\fR
Invoke \fIproc\fR whenever an attempt is made to modify the variable.
.TP
\fBTCL_TRACE_UNSETS\fR
Invoke \fIproc\fR whenever the variable is unset.
A variable may be unset either explicitly by an \fBunset\fR command,
or implicitly when a procedure returns (its local variables are
automatically unset) or when the interpreter or namespace is deleted (all
automatically unset) or when the interpreter is deleted (all
variables are automatically unset).
.TP
\fBTCL_TRACE_ARRAY\fR
Invoke \fIproc\fR whenever the array command is invoked.
This gives the trace procedure a chance to update the array before
array names or array get is called.  Note that this is called
before an array set, but that will trigger write traces.
.TP
\fBTCL_TRACE_RESULT_DYNAMIC\fR
The result of invoking the \fIproc\fR is a dynamically allocated
string that will be released by the Tcl library via a call to
\fBTcl_Free\fR.  Must not be specified at the same time as
\fBckfree\fR.  Must not be specified at the same time as
\fBTCL_TRACE_RESULT_OBJECT\fR.
.TP
\fBTCL_TRACE_RESULT_OBJECT\fR
The result of invoking the \fIproc\fR is a Tcl_Obj* (cast to a char*)
with a reference count of at least one.  The ownership of that
reference will be transferred to the Tcl core for release (when the
core has finished with it) via a call to \fBTcl_DecrRefCount\fR.  Must
not be specified at the same time as \fBTCL_TRACE_RESULT_DYNAMIC\fR.
.PP
Whenever one of the specified operations occurs on the variable,
\fIproc\fR will be invoked.
It should have arguments and result that match the type
\fBTcl_VarTraceProc\fR:
.PP
.CS
typedef char *\fBTcl_VarTraceProc\fR(
        void *\fIclientData\fR,
typedef char *Tcl_VarTraceProc(
        ClientData \fIclientData\fR,
        Tcl_Interp *\fIinterp\fR,
        char *\fIname1\fR,
        char *\fIname2\fR,
        int \fIflags\fR);
.CE
.PP
The \fIclientData\fR and \fIinterp\fR parameters will
have the same values as those passed to \fBTcl_TraceVar\fR when the
trace was created.
\fIclientData\fR typically points to an application-specific
\fIClientData\fR typically points to an application-specific
data structure that describes what to do when \fIproc\fR
is invoked.
\fIName1\fR and \fIname2\fR give the name of the traced variable
in the normal two-part form (see the description of \fBTcl_TraceVar2\fR
below for details).
\fIFlags\fR is an OR-ed combination of bits providing several
pieces of information.
156
157
158
159
160
161
162




163
164
165
166
167
168
169
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171







+
+
+
+







procedure call:  the trace procedure will need to pass this flag
back to variable-related procedures like \fBTcl_GetVar\fR if it
attempts to access the variable.
The bit \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is
about to be destroyed;  this information may be useful to \fIproc\fR
so that it can clean up its own internal data structures (see
the section \fBTCL_TRACE_DESTROYED\fR below for more details).
Lastly, the bit \fBTCL_INTERP_DESTROYED\fR will be set if the entire
interpreter is being destroyed.
When this bit is set, \fIproc\fR must be especially careful in
the things it does (see the section \fBTCL_INTERP_DESTROYED\fR below).
The trace procedure's return value should normally be NULL;  see
\fBERROR RETURNS\fR below for information on other possibilities.
.PP
\fBTcl_UntraceVar\fR may be used to remove a trace.
If the variable specified by \fIinterp\fR, \fIvarName\fR, and \fIflags\fR
has a trace set with \fIflags\fR, \fIproc\fR, and
\fIclientData\fR, then the corresponding trace is removed.
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
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







-
+










-
+







.PP
The procedures \fBTcl_TraceVar2\fR, \fBTcl_UntraceVar2\fR, and
\fBTcl_VarTraceInfo2\fR are identical to \fBTcl_TraceVar\fR,
\fBTcl_UntraceVar\fR, and \fBTcl_VarTraceInfo\fR, respectively,
except that the name of the variable consists of two parts.
\fIName1\fR gives the name of a scalar variable or array,
and \fIname2\fR gives the name of an element within an array.
When \fIname2\fR is NULL,
When \fIname2\fR is NULL, 
\fIname1\fR may contain both an array and an element name:
if the name contains an open parenthesis and ends with a
close parenthesis, then the value between the parentheses is
treated as an element name (which can have any string value) and
the characters before the first open
parenthesis are treated as the name of an array variable.
If \fIname2\fR is NULL and \fIname1\fR does not refer
to an array element it means that either the variable is
a scalar or the trace is to be set on the entire array rather
than an individual element (see WHOLE-ARRAY TRACES below for
more information).
more information). 
.SH "ACCESSING VARIABLES DURING TRACES"
.PP
During read, write, and array traces, the
trace procedure can read, write, or unset the traced
variable using \fBTcl_GetVar2\fR, \fBTcl_SetVar2\fR, and
other procedures.
While \fIproc\fR is executing, traces are temporarily disabled
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
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







-
+

















-
-
-
-
-
-
-
-
-
-







successful completion.
If \fIproc\fR returns a non-NULL value it signifies that an
error occurred.
The return value must be a pointer to a static character string
containing an error message,
unless (\fIexactly\fR one of) the \fBTCL_TRACE_RESULT_DYNAMIC\fR and
\fBTCL_TRACE_RESULT_OBJECT\fR flags is set, which specify that the result is
either a dynamic string (to be released with \fBTcl_Free\fR) or a
either a dynamic string (to be released with \fBckfree\fR) or a
Tcl_Obj* (cast to char* and to be released with
\fBTcl_DecrRefCount\fR) containing the error message.
If a trace procedure returns an error, no further traces are
invoked for the access and the traced access aborts with the
given message.
Trace procedures can use this facility to make variables
read-only, for example (but note that the value of the variable
will already have been modified before the trace procedure is
called, so the trace procedure will have to restore the correct
value).
.PP
The return value from \fIproc\fR is only used during read and
write tracing.
During unset traces, the return value is ignored and all relevant
trace procedures will always be invoked.
.SH "RESTRICTIONS"
.PP
Because operations on variables may take place as part of the deletion
of the interp that contains them, \fIproc\fR must be careful about checking
what the \fIinterp\fR parameter can be used to do.
The routine \fBTcl_InterpDeleted\fR is an important tool for this.
When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able
to invoke any scripts in \fIinterp\fR. You may encounter old code using
a deprecated flag value \fBTCL_INTERP_DESTROYED\fR to signal this
condition, but Tcl 9 no longer supports this. Any supported code
must be converted to stop using it.
.PP
A trace procedure can be called at any time, even when there
are partially formed results stored in the interpreter.  If
the trace procedure does anything that could damage this result (such
as calling \fBTcl_Eval\fR) then it must use the \fBTcl_SaveInterpState\fR
and related routines to save and restore the original state of
the interpreter before it returns.
.SH "UNDEFINED VARIABLES"
356
357
358
359
360
361
362












363




364
365
366
367
368
369
370
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







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

+
+
+
+



-
-


In an unset callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
is set in \fIflags\fR if the trace is being removed as part
of the deletion.
Traces on a variable are always removed whenever the variable
is deleted;  the only time \fBTCL_TRACE_DESTROYED\fR is not set is for
a whole-array trace invoked when only a single element of an
array is unset.
.SH "TCL_INTERP_DESTROYED"
.PP
When an interpreter is destroyed, unset traces are called for
all of its variables.
The \fBTCL_INTERP_DESTROYED\fR bit will be set in the \fIflags\fR
argument passed to the trace procedures.
Trace procedures must be extremely careful in what they do if
the \fBTCL_INTERP_DESTROYED\fR bit is set.
It is not safe for the procedures to invoke any Tcl procedures
on the interpreter, since its state is partially deleted.
All that trace procedures should do under these circumstances is
to clean up and free their own internal data structures.
.SH BUGS
.PP
Tcl does not do any error checking to prevent trace procedures
from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
set.
.PP
Array traces are not yet integrated with the Tcl \fBinfo exists\fR command,
nor is there Tcl-level access to array traces.
.SH "SEE ALSO"
trace(n)
.SH KEYWORDS
clientData, trace, variable

Changes to doc/Translate.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1989-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_TranslateFileName 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_TranslateFileName \- convert file name to native form and replace tilde with home directory
.SH SYNOPSIS
.nf
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
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







+





-
+


-
-
+
+


-
+







.QW ~ .
.AP Tcl_DString *bufferPtr in/out
If needed, this dynamic string is used to store the new file name.
At the time of the call it should be uninitialized or free.  The
caller must eventually call \fBTcl_DStringFree\fR to free up
anything stored here.
.BE

.SH DESCRIPTION
.PP
This utility procedure translates a file name to a platform-specific form
which, after being converted to the appropriate encoding, is suitable for
passing to the local operating system.  In particular, it converts
network names into native form and does tilde substitution.
network names into native form and does tilde substitution.  
.PP
However, with the advent of the newer \fBTcl_FSGetNormalizedPath\fR and
\fBTcl_FSGetNativePath\fR, there is no longer any need to use this
procedure.  In particular, \fBTcl_FSGetNativePath\fR performs all the
\fBTcl_GetNativePath\fR, there is no longer any need to use this
procedure.  In particular, \fBTcl_GetNativePath\fR performs all the
necessary translation and encoding conversion, is virtual-filesystem
aware, and caches the native result for faster repeated calls.
Finally \fBTcl_FSGetNativePath\fR does not require you to free anything
Finally \fBTcl_GetNativePath\fR does not require you to free anything
afterwards.
.PP
If
\fBTcl_TranslateFileName\fR has to do tilde substitution or translate
the name then it uses
the dynamic string at \fI*bufferPtr\fR to hold the new string it
generates.
61
62
63
64
65
66
67

68
69


70
71
62
63
64
65
66
67
68
69
70

71
72
73
74







+

-
+
+


in the interpreter's result.
When an error occurs, \fBTcl_TranslateFileName\fR
frees the dynamic string itself so that the caller need not call
\fBTcl_DStringFree\fR.
.PP
The caller is responsible for making sure that the interpreter's result
has its default empty value when \fBTcl_TranslateFileName\fR is invoked.

.SH "SEE ALSO"
filename(n)
filename

.SH KEYWORDS
file name, home directory, tilde, translate, user

Changes to doc/UniCharIsAlpha.3.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 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.
'\"
'\" 
.TH Tcl_UniCharIsAlpha 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_UniCharIsAlnum, Tcl_UniCharIsAlpha, Tcl_UniCharIsControl, Tcl_UniCharIsDigit, Tcl_UniCharIsGraph, Tcl_UniCharIsLower, Tcl_UniCharIsPrint, Tcl_UniCharIsPunct, Tcl_UniCharIsSpace, Tcl_UniCharIsUpper, Tcl_UniCharIsWordChar \- routines for classification of Tcl_UniChar characters
.SH SYNOPSIS
.nf
44
45
46
47
48
49
50
51

52
53
54
55
56

57
58
59
60



61
62
63
64
65
66
67
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







-
+




-
+




+
+
+







\fBTcl_UniCharIsUpper\fR(\fIch\fR)
.sp
int
\fBTcl_UniCharIsWordChar\fR(\fIch\fR)
.SH ARGUMENTS
.AS int ch
.AP int ch in
The Unicode character to be examined.
The Tcl_UniChar to be examined.
.BE

.SH DESCRIPTION
.PP
All of the routines described examine Unicode characters and return a
All of the routines described examine Tcl_UniChars and return a
boolean value. A non-zero return value means that the character does
belong to the character class associated with the called routine. The
rest of this document just describes the character classes associated
with the various routines.
.PP
Note: A Tcl_UniChar is a Unicode character represented as an unsigned,
fixed-size quantity.

.SH "CHARACTER CLASSES"
.PP
\fBTcl_UniCharIsAlnum\fR tests if the character is an alphanumeric Unicode character.
.PP
\fBTcl_UniCharIsAlpha\fR tests if the character is an alphabetic Unicode character.
.PP

Changes to doc/UpVar.3.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH Tcl_UpVar 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_UpVar, Tcl_UpVar2 \- link one variable to another
.SH SYNOPSIS
.nf
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50







-
+







variable so that references to \fIdestName\fR
refer to the other variable.  Must not currently exist except as
an upvar-ed variable.
.AP int flags in
One of \fBTCL_GLOBAL_ONLY\fR, \fBTCL_NAMESPACE_ONLY\fR or 0;  if non-zero,
then \fIdestName\fR is a global or namespace variable;  otherwise it is
local to the current procedure (or current namespace if no procedure is
active).
active). 
.AP "const char" *name1 in
First part of source variable's name (scalar name, or name of array
without array index).
.AP "const char" *name2 in
If source variable is an element of an array, gives the index of the element.
For scalar source variables, is NULL.
.BE

Changes to doc/Utf.3.

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
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










-
+












-
-
-
-
-
-



-
-
-
-
-
-



-
-
-
-
-
-




-
+


-
+





-
+


-
+



















-
+





-
+





-
+

-
+


-
-
-
-














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


-
-
+
+
+


+
+


-
+






-
+







-
-
-
-
+
+
+
+
+

-
+
-
+

-
+

-
+
-
-
-
-







-
-
-

-
-
+
+



+







'\"
'\" Copyright (c) 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.
'\"
.TH Utf 3 "8.1" Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
typedef ... \fBTcl_UniChar\fR;
.sp
int
\fBTcl_UniCharToUtf\fR(\fIch, buf\fR)
.sp
int
\fBTcl_UtfToUniChar\fR(\fIsrc, chPtr\fR)
.sp
int
\fBTcl_UtfToChar16\fR(\fIsrc, uPtr\fR)
.sp
int
\fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR)
.sp
char *
\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR)
.sp
char *
\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR)
.sp
char *
\fBTcl_WCharToUtfDString\fR(\fIwStr, uniLength, dsPtr\fR)
.sp
Tcl_UniChar *
\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR)
.sp
unsigned short *
\fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR)
.sp
wchar_t *
\fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR)
.sp
int
\fBTcl_UniCharLen\fR(\fIuniStr\fR)
.sp
int
\fBTcl_UniCharNcmp\fR(\fIucs, uct, uniLength\fR)
\fBTcl_UniCharNcmp\fR(\fIucs, uct, numChars\fR)
.sp
int
\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, uniLength\fR)
\fBTcl_UniCharNcasecmp\fR(\fIucs, uct, numChars\fR)
.sp
int
\fBTcl_UniCharCaseMatch\fR(\fIuniStr, uniPattern, nocase\fR)
.sp
int
\fBTcl_UtfNcmp\fR(\fIcs, ct, length\fR)
\fBTcl_UtfNcmp\fR(\fIcs, ct, numChars\fR)
.sp
int
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR)
\fBTcl_UtfNcasecmp\fR(\fIcs, ct, numChars\fR)
.sp
int
\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
.sp
int
\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
.sp
const char *
\fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR)
.sp
const char *
\fBTcl_UtfFindLast\fR(\fIsrc, ch\fR)
.sp
const char *
\fBTcl_UtfNext\fR(\fIsrc\fR)
.sp
const char *
\fBTcl_UtfPrev\fR(\fIsrc, start\fR)
.sp
int
Tcl_UniChar
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
\fBTcl_UtfAtIndex\fR(\fIsrc, index\fR)
.sp
size_t
int
\fBTcl_UtfBackslash\fR(\fIsrc, readPtr, dst\fR)
.SH ARGUMENTS
.AS "const Tcl_UniChar" *uniPattern in/out
.AP char *buf out
Buffer in which the UTF-8 representation of the Tcl_UniChar is stored.  At most
4 bytes are stored in the buffer.
\fBTCL_UTF_MAX\fR bytes are stored in the buffer.
.AP int ch in
The Unicode character to be converted or examined.
The Tcl_UniChar to be converted or examined.
.AP Tcl_UniChar *chPtr out
Filled with the Tcl_UniChar represented by the head of the UTF-8 string.
.AP unsigned short *uPtr out
Filled with the utf-16 represented by the head of the UTF-8 string.
.AP wchar_t *wPtr out
Filled with the wchar_t represented by the head of the UTF-8 string.
.AP "const char" *src in
Pointer to a UTF-8 string.
.AP "const char" *cs in
Pointer to a UTF-8 string.
.AP "const char" *ct in
Pointer to a UTF-8 string.
.AP "const Tcl_UniChar" *uniStr in
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *ucs in
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uct in
A null-terminated Unicode string.
.AP "const Tcl_UniChar" *uniPattern in
A null-terminated Unicode string.
.AP "const unsigned short" *uStr in
A null-terminated UTF-16 string.
.AP "const wchar_t" *wStr in
A null-terminated wchar_t string.
.AP "const unsigned short" *utf16s in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16t in
A null-terminated utf-16 string.
.AP "const unsigned short" *utf16Pattern in
A null-terminated utf-16 string.
.AP size_t length in
.AP int length in
The length of the UTF-8 string in bytes (not UTF-8 characters).  If
negative, all bytes up to the first null byte are used.
.AP size_t uniLength in
The length of the Unicode string in characters.
.AP int uniLength in
The length of the Unicode string in characters.  Must be greater than or
equal to 0.
.AP "Tcl_DString" *dsPtr in/out
A pointer to a previously initialized \fBTcl_DString\fR.
.AP "unsigned long" numChars in
The number of characters to compare.
.AP "const char" *start in
Pointer to the beginning of a UTF-8 string.
.AP size_t index in
.AP int index in
The index of a character (not byte) in the UTF-8 string.
.AP int *readPtr out
If non-NULL, filled with the number of bytes in the backslash sequence,
including the backslash character.
.AP char *dst out
Buffer in which the bytes represented by the backslash sequence are stored.
At most 4 bytes are stored in the buffer.
At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
.AP int nocase in
Specifies whether the match should be done case-sensitive (0) or
case-insensitive (1).
.BE

.SH DESCRIPTION
.PP
These routines convert between UTF-8 strings and Unicode/Utf-16 characters.
A UTF-8 character is a Unicode character represented as a varying-length
sequence of up to \fB4\fR bytes.  A multibyte UTF-8 sequence
consists of a lead byte followed by some number of trail bytes.
These routines convert between UTF-8 strings and Tcl_UniChars.  A
Tcl_UniChar is a Unicode character represented as an unsigned, fixed-size
quantity.  A UTF-8 character is a Unicode character represented as
a varying-length sequence of up to \fBTCL_UTF_MAX\fR bytes.  A multibyte UTF-8
sequence consists of a lead byte followed by some number of trail bytes.
.PP
\fBTCL_UTF_MAX\fR is the maximum number of bytes that \fBTcl_UtfToUniChar\fR
\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
can consume in a single call.
represent one Unicode character in the UTF-8 representation.
.PP
\fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
\fBTcl_UniCharToUtf\fR stores the Tcl_UniChar \fIch\fR as a UTF-8 string
in starting at \fIbuf\fR.  The return value is the number of bytes stored
in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then
in \fIbuf\fR.
the return value will be 1 and a single byte in the range 0xF0 - 0xF4
will be stored. If you still want to produce UTF-8 output for it (even
though knowing it's an illegal code-point on its own), just call
\fBTcl_UniCharToUtf\fR again specifying ch = -1.
.PP
\fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
and stores it as a Tcl_UniChar in \fI*chPtr\fR.  The return value is the
number of bytes read from \fIsrc\fR.  The caller must ensure that the
source buffer is long enough such that this routine does not run off the
end and dereference non-existent or random memory; if the source buffer
is known to be null-terminated, this will not happen.  If the input is
a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the
cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR
and returns 1. If the input is otherwise
not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x00A0 and
0x00FF and return 1.
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x80 and
0xFF and return 1.
.PP
\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR.
You must specify \fIuniLength\fR, the length of the given Unicode string.
The return value is a pointer to the UTF-8 representation of the
Unicode string.  Storage for the return value is appended to the
end of the \fBTcl_DString\fR.
.PP
\fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode,
storing the result in the previously initialized \fBTcl_DString\fR.
In the argument \fIlength\fR, you may either specify the length of
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
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







-
+













-
+













-
-
-
-
+
+
+
+







-
+




-
+







-
+
+







\fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
characters.  It accepts a null-terminated Unicode string and returns
the number of Unicode characters (not bytes) in that string.
.PP
\fBTcl_UniCharNcmp\fR and \fBTcl_UniCharNcasecmp\fR correspond to
\fBstrncmp\fR and \fBstrncasecmp\fR, respectively, for Unicode characters.
They accept two null-terminated Unicode strings and the number of characters
to compare.  Both strings are assumed to be at least \fIuniLength\fR characters
to compare.  Both strings are assumed to be at least \fInumChars\fR characters
long. \fBTcl_UniCharNcmp\fR  compares the two strings character-by-character
according to the Unicode character ordering.  It returns an integer greater
than, equal to, or less than 0 if the first string is greater than, equal
to, or less than the second string respectively.  \fBTcl_UniCharNcasecmp\fR
is the Unicode case insensitive version.
.PP
\fBTcl_UniCharCaseMatch\fR is the Unicode equivalent to
\fBTcl_StringCaseMatch\fR.  It accepts a null-terminated Unicode string,
a Unicode pattern, and a boolean value specifying whether the match should
be case sensitive and returns whether the string matches the pattern.
.PP
\fBTcl_UtfNcmp\fR corresponds to \fBstrncmp\fR for UTF-8 strings. It
accepts two null-terminated UTF-8 strings and the number of characters
to compare.  (Both strings are assumed to be at least \fIlength\fR
to compare.  (Both strings are assumed to be at least \fInumChars\fR
characters long.)  \fBTcl_UtfNcmp\fR compares the two strings
character-by-character according to the Unicode character ordering.
It returns an integer greater than, equal to, or less than 0 if the
first string is greater than, equal to, or less than the second string
respectively.
.PP
\fBTcl_UtfNcasecmp\fR corresponds to \fBstrncasecmp\fR for UTF-8
strings.  It is similar to \fBTcl_UtfNcmp\fR except comparisons ignore
differences in case when comparing upper, lower or title case
characters.
.PP
\fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR
of \fIlength\fR bytes is long enough to be decoded by
\fBTcl_UtfToUniChar\fR, or 0 otherwise.  This function does not guarantee
that the UTF-8 string is properly formed.  This routine is used by
procedures that are operating on a byte at a time and need to know if a
full Unicode character has been seen.
\fBTcl_UtfToUniChar\fR/\fBTcl_UtfNext\fR, or 0 otherwise.  This function
does not guarantee that the UTF-8 string is properly formed.  This routine
is used by procedures that are operating on a byte at a time and need to
know if a full Tcl_UniChar has been seen.
.PP
\fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings.  It
returns the number of Tcl_UniChars that are represented by the UTF-8 string
\fIsrc\fR.  The length of the source string is \fIlength\fR bytes.  If the
length is negative, all bytes up to the first null byte are used.
.PP
\fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings.  It
returns a pointer to the first occurrence of the Unicode character \fIch\fR
returns a pointer to the first occurrence of the Tcl_UniChar \fIch\fR
in the null-terminated UTF-8 string \fIsrc\fR.  The null terminator is
considered part of the UTF-8 string.
.PP
\fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings.  It
returns a pointer to the last occurrence of the Unicode character \fIch\fR
returns a pointer to the last occurrence of the Tcl_UniChar \fIch\fR
in the null-terminated UTF-8 string \fIsrc\fR.  The null terminator is
considered part of the UTF-8 string.
.PP
Given \fIsrc\fR, a pointer to some location in a UTF-8 string,
\fBTcl_UtfNext\fR returns a pointer to the next UTF-8 character in the
string.  The caller must not ask for the next character after the last
character in the string if the string is not terminated by a null
character.
character. \fBTcl_UtfCharComplete\fR can be used in that case to
make sure enough bytes are available before calling \fBTcl_UtfNext\fR.
.PP
\fBTcl_UtfPrev\fR is used to step backward through but not beyond the
UTF-8 string that begins at \fIstart\fR.  If the UTF-8 string is made
up entirely of complete and well-formed characters, and \fIsrc\fR points
to the lead byte of one of those characters (or to the location one byte
past the end of the string), then repeated calls of \fBTcl_UtfPrev\fR will
return pointers to the lead bytes of each character in the string, one
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
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







-
+


-
+
-




-
+





-
+










at the returned pointer is the first one that either includes the
byte \fIsrc[-1]\fR, or might include it if the right trail bytes are
present at \fIsrc\fR and greater. \fBTcl_UtfPrev\fR never reads the
byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte
\fIsrc[-\fBTCL_UTF_MAX\fI-1]\fR.
.PP
\fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
Pascal Ord() function.  It returns the Unicode character represented at the
Pascal Ord() function.  It returns the Tcl_UniChar represented at the
specified character (not byte) \fIindex\fR in the UTF-8 string
\fIsrc\fR.  The source string must contain at least \fIindex\fR
characters.  If \fIindex\fR is TCL_INDEX_NONE or \fIindex\fR points
characters.  Behavior is undefined if a negative \fIindex\fR is given.
to the second half of a surrogate pair, it returns -1.
.PP
\fBTcl_UtfAtIndex\fR returns a pointer to the specified character (not
byte) \fIindex\fR in the UTF-8 string \fIsrc\fR.  The source string must
contain at least \fIindex\fR characters.  This is equivalent to calling
\fBTcl_UtfToUniChar\fR \fIindex\fR times.  If \fIindex\fR is TCL_INDEX_NONE,
\fBTcl_UtfToUniChar\fR \fIindex\fR times.  If a negative \fIindex\fR is given,
the return pointer points to the first character in the source string.
.PP
\fBTcl_UtfBackslash\fR is a utility procedure used by several of the Tcl
commands.  It parses a backslash sequence and stores the properly formed
UTF-8 character represented by the backslash sequence in the output
buffer \fIdst\fR.  At most 4 bytes are stored in the buffer.
buffer \fIdst\fR.  At most \fBTCL_UTF_MAX\fR bytes are stored in the buffer.
\fBTcl_UtfBackslash\fR modifies \fI*readPtr\fR to contain the number
of bytes in the backslash sequence, including the backslash character.
The return value is the number of bytes stored in the output buffer.
.PP
See the \fBTcl\fR manual entry for information on the valid backslash
sequences.  All of the sequences described in the Tcl manual entry are
supported by \fBTcl_UtfBackslash\fR.

.SH KEYWORDS
utf, unicode, backslash

Changes to doc/WrongNumArgs.3.

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
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





-
+














-
+










+





-
+





-
+

-



-

-



-


-
+

-
+

-
+






-
-
+
+

-



+

-
+
+


'\"
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH Tcl_WrongNumArgs 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
Tcl_WrongNumArgs \- generate standard error message for wrong number of arguments
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_WrongNumArgs\fR(\fIinterp, objc, objv, message\fR)
.SH ARGUMENTS
.AS "Tcl_Obj *const" *message
.AP Tcl_Interp interp in
Interpreter in which error will be reported: error message gets stored
in its result value.
in its result object.
.AP int objc in
Number of leading arguments from \fIobjv\fR to include in error
message.
.AP "Tcl_Obj *const" objv[] in
Arguments to command that had the wrong number of arguments.
.AP "const char" *message in
Additional error information to print after leading arguments
from \fIobjv\fR.  This typically gives the acceptable syntax
of the command.  This argument may be NULL.
.BE

.SH DESCRIPTION
.PP
\fBTcl_WrongNumArgs\fR is a utility procedure that is invoked by
command procedures when they discover that they have received the
wrong number of arguments.  \fBTcl_WrongNumArgs\fR generates a
standard error message and stores it in the result value of
standard error message and stores it in the result object of
\fIinterp\fR.  The message includes the \fIobjc\fR initial
elements of \fIobjv\fR plus \fImessage\fR.  For example, if
\fIobjv\fR consists of the values \fBfoo\fR and \fBbar\fR,
\fIobjc\fR is 1, and \fImessage\fR is
.QW "\fBfileName count\fR"
then \fIinterp\fR's result value will be set to the following
then \fIinterp\fR's result object will be set to the following
string:
.PP
.CS
wrong # args: should be "foo fileName count"
.CE
.PP
If \fIobjc\fR is 2, the result will be set to the following string:
.PP
.CS
wrong # args: should be "foo bar fileName count"
.CE
.PP
\fIObjc\fR is usually 1, but may be 2 or more for commands like
\fBstring\fR and the Tk widget commands, which use the first argument
as a subcommand.
as a subcommand.  
.PP
Some of the values in the \fIobjv\fR array may be abbreviations for
Some of the objects in the \fIobjv\fR array may be abbreviations for
a subcommand.  The command
\fBTcl_GetIndexFromObj\fR will convert the abbreviated string value
\fBTcl_GetIndexFromObj\fR will convert the abbreviated string object
into an \fIindexObject\fR.  If an error occurs in the parsing of the
subcommand we would like to use the full subcommand name rather than
the abbreviation.  If the \fBTcl_WrongNumArgs\fR command finds any
\fIindexObjects\fR in the \fIobjv\fR array it will use the full subcommand
name in the error message instead of the abbreviated name that was
originally passed in.  Using the above example, let us assume that
\fIbar\fR is actually an abbreviation for \fIbarfly\fR and the value
is now an \fIindexObject\fR because it was passed to
\fIbar\fR is actually an abbreviation for \fIbarfly\fR and the object
is now an indexObject because it was passed to
\fBTcl_GetIndexFromObj\fR.  In this case the error message would be:
.PP
.CS
wrong # args: should be "foo barfly fileName count"
.CE

.SH "SEE ALSO"
Tcl_GetIndexFromObj(3)
Tcl_GetIndexFromObj

.SH KEYWORDS
command, error message, wrong number of arguments

Deleted doc/abstract.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
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













































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH abstract n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::abstract \- a class that does not allow direct instances of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::abstract\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::abstract\fR
.fi
.BE
.SH DESCRIPTION
Abstract classes are classes that can contain definitions, but which cannot be
directly manufactured; they are intended to only ever be inherited from and
instantiated indirectly. The characteristic methods of \fBoo::class\fR
(\fBcreate\fR and \fBnew\fR) are not exported by an instance of
\fBoo::abstract\fR.
.PP
Note that \fBoo::abstract\fR is not itself an instance of \fBoo::abstract\fR.
.SS CONSTRUCTOR
The \fBoo::abstract\fR class does not define an explicit constructor; this
means that it is effectively the same as the constructor of the
\fBoo::class\fR class.
.SS DESTRUCTOR
The \fBoo::abstract\fR class does not define an explicit destructor;
destroying an instance of it is just like destroying an ordinary class (and
will destroy all its subclasses).
.SS "EXPORTED METHODS"
The \fBoo::abstract\fR class defines no new exported methods.
.SS "NON-EXPORTED METHODS"
The \fBoo::abstract\fR class explicitly states that \fBcreate\fR,
\fBcreateWithNamespace\fR, and \fBnew\fR are unexported.
.SH EXAMPLES
.PP
This example defines a simple class hierarchy and creates a new instance of
it. It then invokes a method of the object before destroying the hierarchy and
showing that the destruction is transitive.
.PP
.CS
\fBoo::abstract\fR create fruit {
    method eat {} {
        puts "yummy!"
    }
}
oo::class create banana {
    superclass fruit
    method peel {} {
        puts "skin now off"
    }
}
set b [banana \fBnew\fR]
$b peel              \fI\(-> prints 'skin now off'\fR
$b eat               \fI\(-> prints 'yummy!'\fR
set f [fruit new]    \fI\(-> error 'unknown method "new"...'\fR
.CE
.SH "SEE ALSO"
oo::define(n), oo::object(n)
.SH KEYWORDS
abstract class, class, metaclass, object
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/after.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
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
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









-
+



















+







-






-








-
+

-
+




-








-




-
+



-









-
+


-







-
+















-


-
+





-














-


-
-
-
+
+
+



+


+


-
-
-
'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH after n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
after \- Execute a command after a time delay
.SH SYNOPSIS
\fBafter \fIms\fR
.sp
\fBafter \fIms \fR?\fIscript script script ...\fR?
.sp
\fBafter cancel \fIid\fR
.sp
\fBafter cancel \fIscript script script ...\fR
.sp
\fBafter idle \fR?\fIscript script script ...\fR?
.sp
\fBafter info \fR?\fIid\fR?
.BE

.SH DESCRIPTION
.PP
This command is used to delay execution of the program or to execute
a command in background sometime in the future.  It has several forms,
depending on the first argument to the command:
.TP
\fBafter \fIms\fR
.
\fIMs\fR must be an integer giving a time in milliseconds.
The command sleeps for \fIms\fR milliseconds and then returns.
While the command is sleeping the application does not respond to
events.
.TP
\fBafter \fIms \fR?\fIscript script script ...\fR?
.
In this form the command returns immediately, but it arranges
for a Tcl command to be executed \fIms\fR milliseconds later as an
event handler.
The command will be executed exactly once, at the given time.
The delayed command is formed by concatenating all the \fIscript\fR
arguments in the same fashion as the \fBconcat\fR command.
The command will be executed at global level (outside the context
of any Tcl procedure).
If an error occurs while executing the delayed command then
If an error occurs while executing the delayed command then 
the background error will be reported by the command
registered with \fBinterp bgerror\fR.
registered with \fB interp bgerror\fR.
The \fBafter\fR command returns an identifier that can be used
to cancel the delayed command using \fBafter cancel\fR.
.TP
\fBafter cancel \fIid\fR
.
Cancels the execution of a delayed command that
was previously scheduled.
\fIId\fR indicates which command should be canceled;  it must have
been the return value from a previous \fBafter\fR command.
If the command given by \fIid\fR has already been executed then
the \fBafter cancel\fR command has no effect.
.TP
\fBafter cancel \fIscript script ...\fR
.
This command also cancels the execution of a delayed command.
The \fIscript\fR arguments are concatenated together with space
separators (just as in the \fBconcat\fR command).
If there is a pending command that matches the string, it is
canceled and will never be executed;  if no such command is
cancelled and will never be executed;  if no such command is
currently pending then the \fBafter cancel\fR command has no effect.
.TP
\fBafter idle \fIscript \fR?\fIscript script ...\fR?
.
Concatenates the \fIscript\fR arguments together with space
separators (just as in the \fBconcat\fR command), and arranges
for the resulting script to be evaluated later as an idle callback.
The script will be run exactly once, the next time the event
loop is entered and there are no events to process.
The command returns an identifier that can be used
to cancel the delayed command using \fBafter cancel\fR.
If an error occurs while executing the script then the
background error will be reported by the command
registered with \fBinterp bgerror\fR.
registered with \fB interp bgerror\fR.
.TP
\fBafter info \fR?\fIid\fR?
.
This command returns information about existing event handlers.
If no \fIid\fR argument is supplied, the command returns
a list of the identifiers for all existing
event handlers created by the \fBafter\fR command for this
interpreter.
If \fIid\fR is supplied, it specifies an existing handler;
\fIid\fR must have been the return value from some previous call
to \fBafter\fR and it must not have triggered yet or been canceled.
to \fBafter\fR and it must not have triggered yet or been cancelled.
In this case the command returns a list with two elements.
The first element of the list is the script associated
with \fIid\fR, and the second element is either
\fBidle\fR or \fBtimer\fR to indicate what kind of event
handler it is.
.LP
The \fBafter \fIms\fR and \fBafter idle\fR forms of the command
assume that the application is event driven:  the delayed commands
will not be executed unless the application enters the event loop.
In applications that are not normally event-driven, such as
\fBtclsh\fR, the event loop can be entered with the \fBvwait\fR
and \fBupdate\fR commands.
.SH "EXAMPLES"
This defines a command to make Tcl do nothing at all for \fIN\fR
seconds:
.PP
.CS
proc sleep {N} {
    \fBafter\fR [expr {int($N * 1000)}]
   \fBafter\fR [expr {int($N * 1000)}]
}
.CE
.PP
This arranges for the command \fIwake_up\fR to be run in eight hours
(providing the event loop is active at that time):
.PP
.CS
\fBafter\fR [expr {1000 * 60 * 60 * 8}] wake_up
.CE
.PP
The following command can be used to do long-running calculations (as
represented here by \fI::my_calc::one_step\fR, which is assumed to
return a boolean indicating whether another step should be performed)
in a step-by-step fashion, though the calculation itself needs to be
arranged so it can work step-wise.  This technique is extra careful to
ensure that the event loop is not starved by the rescheduling of
processing steps (arranging for the next step to be done using an
already-triggered timer event only when the event queue has been
drained) and is useful when you want to ensure that a Tk GUI remains
responsive during a slow task.
.PP
.CS
proc doOneStep {} {
    if {[::my_calc::one_step]} {
        \fBafter idle\fR [list \fBafter\fR 0 doOneStep]
    }
   if {[::my_calc::one_step]} {
      \fBafter idle\fR [list \fBafter\fR 0 doOneStep]
   }
}
doOneStep
.CE

.SH "SEE ALSO"
concat(n), interp(n), update(n), vwait(n)

.SH KEYWORDS
cancel, delay, idle callback, sleep, time
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/append.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

44
45
46
47

48
49

50
51
52
53
54
55
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










-
+









+






-
-
-
-
-











-



-
+




+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH append n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
append \- Append to variable
.SH SYNOPSIS
\fBappend \fIvarName \fR?\fIvalue value value ...\fR?
.BE

.SH DESCRIPTION
.PP
Append all of the \fIvalue\fR arguments to the current value
of variable \fIvarName\fR.  If \fIvarName\fR does not exist,
it is given a value equal to the concatenation of all the
\fIvalue\fR arguments.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, the concatenation of the default value and all the
\fIvalue\fR arguments will be stored in the array element.
.VE TIP508
The result of this command is the new value stored in variable
\fIvarName\fR.
This command provides an efficient way to build up long
variables incrementally.
For example,
.QW "\fBappend a $b\fR"
is much more efficient than
.QW "\fBset a $a$b\fR"
if \fB$a\fR is long.
.SH EXAMPLE
Building a string of comma-separated numbers piecemeal using a loop.
.PP
.CS
set var 0
for {set i 1} {$i<=10} {incr i} {
    \fBappend\fR var "," $i
   \fBappend\fR var "," $i
}
puts $var
# Prints 0,1,2,3,4,5,6,7,8,9,10
.CE

.SH "SEE ALSO"
concat(n), lappend(n)

.SH KEYWORDS
append, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/apply.n.

10
11
12
13
14
15
16
17

18
19
20
21

22
23
24
25
26
27
28
10
11
12
13
14
15
16

17
18
19
20

21
22
23
24
25
26
27
28







-
+



-
+







apply \- Apply an anonymous function
.SH SYNOPSIS
\fBapply \fIfunc\fR ?\fIarg1 arg2 ...\fR?
.BE
.SH DESCRIPTION
.PP
The command \fBapply\fR applies the function \fIfunc\fR to the arguments
\fIarg1 arg2 ...\fR and returns the result.
\fIarg1 arg2 ...\fR and returns the result. 
.PP
The function \fIfunc\fR is a two element list \fI{args body}\fR or a three
element list \fI{args body namespace}\fR (as if the
\fBlist\fR command had been used).
\fBlist\fR command had been used). 
The first element \fIargs\fR specifies the formal arguments to
\fIfunc\fR. The specification of the formal arguments \fIargs\fR
is shared with the \fBproc\fR command, and is described in detail in the
corresponding manual page.
.PP
The contents of \fIbody\fR are executed by the Tcl interpreter
after the local variables corresponding to the formal arguments are given
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
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










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



-


-


-
-
-
-
-
+
+
+
+
+









-



-
-
+
+







-
+
-
-
-
with
.QW :: .
.PP
The semantics of \fBapply\fR can also be described by:
.PP
.CS
proc apply {fun args} {
    set len [llength $fun]
    if {($len < 2) || ($len > 3)} {
         error "can't interpret \e"$fun\e" as anonymous function"
    }
    lassign $fun argList body ns
    set name ::$ns::[getGloballyUniqueName]
    set body0 {
         rename [lindex [info level 0] 0] {}
    }
    proc $name $argList ${body0}$body
    set code [catch {uplevel 1 $name $args} res opt]
    return -options $opt $res
   set len [llength $fun]
   if {($len < 2) || ($len > 3)} {
      error "can't interpret \e"$fun\e" as anonymous function"
   }
   lassign $fun argList body ns
   set name ::$ns::[getGloballyUniqueName]
   set body0 {
      rename [lindex [info level 0] 0] {}
   }
   proc $name $argList ${body0}$body
   set code [catch {uplevel 1 $name $args} res opt]
   return -options $opt $res
}
.CE
.SH EXAMPLES
.PP
This shows how to make a simple general command that applies a transformation
to each element of a list.
.PP
.CS
proc map {lambda list} {
    set result {}
    foreach item $list {
        lappend result [\fBapply\fR $lambda $item]
    }
    return $result
   set result {}
   foreach item $list {
      lappend result [\fBapply\fR $lambda $item]
   }
   return $result
}
map {x {return [string length $x]:$x}} {a bb ccc dddd}
      \fI\(-> 1:a 2:bb 3:ccc 4:dddd\fR
map {x {expr {$x**2 + 3*$x - 2}}} {-4 -3 -2 -1 0 1 2 3 4}
      \fI\(-> 2 -2 -4 -4 -2 2 8 16 26\fR
.CE
.PP
The \fBapply\fR command is also useful for defining callbacks for use in the
\fBtrace\fR command:
.PP
.CS
set vbl "123abc"
trace add variable vbl write {\fBapply\fR {{v1 v2 op} {
    upvar 1 $v1 v
    puts "updated variable to \e"$v\e""
   upvar 1 $v1 v
   puts "updated variable to \e"$v\e""
}}}
set vbl 123
set vbl abc
.CE
.SH "SEE ALSO"
proc(n), uplevel(n)
.SH KEYWORDS
anonymous function, argument, lambda, procedure,
argument, procedure, anonymous function
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/array.n.

1
2
3
4
5
6
7
8


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


7
8
9
10
11
12
13
14
15






-
-
+
+







'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH array n 8.7 Tcl "Tcl Built-In Commands"
'\" 
.TH array n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
array \- Manipulate array variables
.SH SYNOPSIS
\fBarray \fIoption arrayName\fR ?\fIarg arg ...\fR?
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
-
-
-
-
-
-
-
-







\fISearchId\fR indicates which search on \fIarrayName\fR to
check, and must have been the return value from a previous
invocation of \fBarray startsearch\fR.
This option is particularly useful if an array has an element
with an empty name, since the return value from
\fBarray nextelement\fR will not indicate whether the search
has been completed.
.TP
\fBarray default \fIsubcommand arrayName args...\fR
.VS TIP508
Manages the default value of the array. Arrays initially have no default
value, but this command allows you to set one; the default value will be
returned when reading from an element of the array \fIarrayName\fR if the read
would otherwise result in an error. Note that this may cause the \fBappend\fR,
\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
relation to non-existing array elements.
.RS
.PP
The \fIsubcommand\fR argument controls what exact operation will be performed
on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
.VE TIP508
.TP
\fBarray default exists \fIarrayName\fR
.VS TIP508
This returns a boolean value indicating whether a default value has been set
for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
not exist. Raises an error if \fIarrayName\fR is an existing variable that is
not an array.
.VE TIP508
.TP
\fBarray default get \fIarrayName\fR
.VS TIP508
This returns the current default value for the array \fIarrayName\fR.  Raises
an error if \fIarrayName\fR is an existing variable that is not an array, or
if \fIarrayName\fR is an array without a default value.
.VE TIP508
.TP
\fBarray default set \fIarrayName value\fR
.VS TIP508
This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
Returns the empty string. Raises an error if \fIarrayName\fR is an existing
variable that is not an array, or if \fIarrayName\fR is an illegal name for an
array. If \fIarrayName\fR does not currently exist, it is created as an empty
array as well as having its default value set.
.VE TIP508
.TP
\fBarray default unset \fIarrayName\fR
.VS TIP508
This removes the default value for the array \fIarrayName\fR and returns the
empty string. Does nothing if \fIarrayName\fR does not have a default
value. Raises an error if \fIarrayName\fR is an existing variable that is not
an array.
.VE TIP508
.RE
.TP
\fBarray donesearch \fIarrayName searchId\fR
This command terminates an array search and destroys all the
state associated with that search.  \fISearchId\fR indicates
which search on \fIarrayName\fR to destroy, and must have
been the return value from a previous invocation of
\fBarray startsearch\fR.  Returns an empty string.
.TP
\fBarray exists \fIarrayName\fR
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
is no variable by that name or if it is a scalar variable.
.TP
\fBarray for {\fIkeyVariable valueVariable\fB} \fIarrayName body\fP
The first argument is a two element list of variable names for the
key and value of each entry in the array.  The second argument is the
array name to iterate over.  The third argument is the body to execute
for each key and value returned.
The ordering of the returned keys is undefined.
If an array element is deleted or a new array element is inserted during
the \fIarray for\fP process, the command will terminate with an error.
.TP
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing pairs of elements.  The first
element in each pair is the name of an element in \fIarrayName\fR
and the second element of each pair is the value of the
array element.  The order of the pairs is undefined.
If \fIpattern\fR is not specified, then all of the elements of the
array are included in the result.
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
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







-
-
-
-
+
+
+
+



-
+







-
+







-
+







of an array variable or there are no matching elements in the array, no
error will be raised.  If \fIpattern\fR is omitted and \fIarrayName\fR is
an array variable, then the command unsets the entire array.
The command always returns an empty string.
.SH EXAMPLES
.CS
\fBarray set\fR colorcount {
    red   1
    green 5
    blue  4
    white 9
   red   1
   green 5
   blue  4
   white 9
}

foreach {color count} [\fBarray get\fR colorcount] {
    puts "Color: $color Count: $count"
   puts "Color: $color Count: $count"
}
  \fB\(->\fR Color: blue Count: 4
    Color: white Count: 9
    Color: green Count: 5
    Color: red Count: 1

foreach color [\fBarray names\fR colorcount] {
    puts "Color: $color Count: $colorcount($color)"
   puts "Color: $color Count: $colorcount($color)"
}
  \fB\(->\fR Color: blue Count: 4
    Color: white Count: 9
    Color: green Count: 5
    Color: red Count: 1

foreach color [lsort [\fBarray names\fR colorcount]] {
    puts "Color: $color Count: $colorcount($color)"
   puts "Color: $color Count: $colorcount($color)"
}
  \fB\(->\fR Color: blue Count: 4
    Color: green Count: 5
    Color: red Count: 1
    Color: white Count: 9

\fBarray statistics\fR colorcount
237
238
239
240
241
242
243
244
245
246
247
181
182
183
184
185
186
187











-
-
-
-
    number of buckets with 10 or more entries: 0
    average search distance for entry: 1.2
.CE
.SH "SEE ALSO"
list(n), string(n), variable(n), trace(n), foreach(n)
.SH KEYWORDS
array, element names, search
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/bgerror.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
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






-
+









+

-
+











+







'\"
'\" Copyright (c) 1990-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH bgerror n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
bgerror \- Command invoked to process background errors
.SH SYNOPSIS
\fBbgerror \fImessage\fR
.BE

.SH DESCRIPTION
.PP
.VS 8.5
Release 8.5 of Tcl supports the \fBinterp bgerror\fR command,
which allows applications to register in an interpreter the command
that will handle background errors in that interpreter.  In older
releases of Tcl, this level of control was not available, and applications
could control the handling of background errors only by creating
a command with the particular command name \fBbgerror\fR in the
global namespace of an interpreter.  The following documentation
describes the interface requirements of the \fBbgerror\fR command
an application might define to retain compatibility with pre-8.5
releases of Tcl.  Applications intending to support only
Tcl releases 8.5 and later should simply make use of \fBinterp bgerror\fR.
.VE 8.5
.PP
The \fBbgerror\fR command does not exist as built-in part of Tcl.  Instead,
individual applications or users can define a \fBbgerror\fR
command (e.g. as a Tcl procedure) if they wish to handle background
errors.
.PP
A background error is one that occurs in an event handler or some
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
71
72
73
74
75
76
77

78

79
80
81
82
83
84
85
86
87
88

89
90
91
92










-

-








+

-
+
+


-
-
-
.PP
If you are writing code that will be used by others as part of a
package or other kind of library, consider avoiding \fBbgerror\fR.
The reason for this is that the application programmer may also want
to define a \fBbgerror\fR, or use other code that does and thus will
have trouble integrating your code.
.SH "EXAMPLE"
.PP
This \fBbgerror\fR procedure appends errors to a file, with a timestamp.
.PP
.CS
proc bgerror {message} {
    set timestamp [clock format [clock seconds]]
    set fl [open mylog.txt {WRONLY CREAT APPEND}]
    puts $fl "$timestamp: bgerror in $::argv '$message'"
    close $fl
}
.CE

.SH "SEE ALSO"
after(n), errorCode(n), errorInfo(n), interp(n)
after(n), interp(n), tclvars(n)

.SH KEYWORDS
background error, reporting
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/binary.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
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
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


-



-
+







-
-
-
-







-
+


-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
+
-
-



-
+



-







'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Copyright (c) 2008 by Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH binary n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
binary \- Insert and extract fields from binary strings
.SH SYNOPSIS
\fBbinary decode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
\fBbinary encode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
\fBbinary format \fIformatString \fR?\fIarg arg ...\fR?
.br
\fBbinary scan \fIstring formatString \fR?\fIvarName varName ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides facilities for manipulating binary data.  The
subcommand \fBbinary format\fR creates a binary string from normal
first form, \fBbinary format\fR, creates a binary string from normal
Tcl values.  For example, given the values 16 and 22, on a 32-bit
architecture, it might produce an 8-byte binary string consisting of
two 4-byte integers, one for each of the numbers.  The subcommand
\fBbinary scan\fR, does the opposite: it extracts data
two 4-byte integers, one for each of the numbers.  The second form of
the command, \fBbinary scan\fR, does the opposite: it extracts data
from a binary string and returns it as ordinary Tcl string values.
The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert
binary data to or from string encodings such as base64 (used in MIME
messages for example).
.PP
Note that other operations on binary data, such as taking a subsequence of it,
getting its length, or reinterpreting it as a string in some encoding, are
done by other Tcl commands (respectively \fBstring range\fR,
\fBstring length\fR and \fBencoding convertfrom\fR in the example cases).  A
binary string in Tcl is merely one where all the characters it contains are in
the range \eu0000\-\eu00FF.
.SH "BINARY ENCODE AND DECODE"
.PP
When encoding binary data as a readable string, the starting binary data is
passed to the \fBbinary encode\fR command, together with the name of the
encoding to use and any encoding-specific options desired. Data which has been
encoded can be converted back to binary form using \fBbinary decode\fR. The
following formats and options are supported.
.TP
\fBbase64\fR
.
The \fBbase64\fR binary encoding is commonly used in mail messages and XML
documents, and uses mostly upper and lower case letters and digits. It has the
distinction of being able to be rewrapped arbitrarily without losing
information.
.RS
.PP
During encoding, the following options are supported:
.TP
\fB\-maxlen \fIlength\fR
.
Indicates that the output should be split into lines of no more than
\fIlength\fR characters. By default, lines are not split.
.TP
\fB\-wrapchar \fIcharacter\fR
.
Indicates that, when lines are split because of the \fB\-maxlen\fR option,
\fIcharacter\fR should be used to separate lines. By default, this is a
newline character,
.QW \en .
.PP
During decoding, the following options are supported:
.TP
\fB\-strict\fR
.
Instructs the decoder to throw an error if it encounters any characters
that are not strictly part of the encoding itself. Otherwise it ignores them.
RFC 2045 calls for base64 decoders to be non-strict.
.RE
.TP
\fBhex\fR
.
The \fBhex\fR binary encoding converts each byte to a pair of hexadecimal
digits in big-endian form.
.RS
.PP
No options are supported during encoding. During decoding, the following
options are supported:
.TP
\fB\-strict\fR
.
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 (though changing them may
produce files that other implementations of decoders cannot process):
.TP
\fB\-maxlen \fIlength\fR
.
Indicates the maximum number of characters to produce for each encoded line.
The valid range is 5 to 85. Line lengths outside that range cannot be
accommodated by the encoding format. The default value is 61.
.TP
\fB\-wrapchar \fIcharacter\fR
.
Indicates the character(s) to use to mark the end of each encoded line.
Acceptable values are a sequence of zero or more characters from the
set { \\x09 (TAB), \\x0B (VT), \\x0C (FF), \\x0D (CR) } followed
by zero or one newline \\x0A (LF).  Any other values are rejected because
they would generate encoded text that could not be decoded. The default value
is a single newline.
.PP
During decoding, the following options are supported:
.TP
\fB\-strict\fR
.
Instructs the decoder to throw an error if it encounters anything
outside of the standard encoding format. Without this option, the
decoder tolerates some deviations, mostly to forgive reflows of lines
between the encoder and decoder.
.PP
Note that neither the encoder nor the decoder handle the header and footer of
the uuencode format.
.RE
.SH "BINARY FORMAT"
.PP
The \fBbinary format\fR command generates a binary string whose layout
is specified by the \fIformatString\fR and whose contents come from
the additional arguments.  The resulting binary value is returned.
.PP
The \fIformatString\fR consists of a sequence of zero or more field
specifiers separated by zero or more spaces.  Each field specifier is
a single type character followed by an optional flag character followed
by an optional numeric \fIcount\fR.
Most field specifiers consume one argument to obtain the value to be
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
is a non-negative decimal integer or \fB*\fR, which normally indicates
.QW \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.
is ignored for for \fBbinary format\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
.PP
.CS
\fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1
.CE
.PP
The first argument is a list of four numbers, but because of the count
of 3 for the associated field specifier, only the first three will be
used. The second argument is associated with the second field
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
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
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
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
611
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
363

364
365
366
367
368
369
370
371



372
373
374
375

376
377
378





379

380
381
382
383
384
385
386







-
-
-
+

-
+

-



-
-
-
-
-
+
-
-
-
-



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



-
-
-
-
-
-
-
-
+


-



-
-
-
-
-
-
-
-
+







-



-
-
+
-
-
-
-



-
+





-
+
-
-





-



-
-
-
-
-
+
-





-



-
-
-
-
-
+
-



-
+







-
-
+




-



-
-
-
-
-
+
-





-



-
-
-
-
-
+
-






-
+
-
-
+



-



-
-
+
-
-
-
+
-
-
-
-



-









-



-
-
+
-
-
-
+
-






-



-
-
+
-
-
-
+
-


+





+







-



-
-
+
-
-

-






-



-
-
+
-
-

-


+






+







-



-
-
+






-



-
-
+


+






+














-



-
-
+
-
-
-
+
-


+





+

+


+






-



-
-
+
-
-
-
+
-


+





+

+


+


-
+
-



-



-
-
-
-
-
+
-



-
-
-
+





-



-








-
-
-
+



-



-
-
-
-
-
+
-







the \fBencoding convertto\fR command should be used first to change
the string into an external representation
if this truncation is not desired (i.e. if the characters are
not part of the ISO 8859\-1 character set.)
If \fIarg\fR has fewer than \fIcount\fR bytes, then additional zero
bytes are used to pad out the field.  If \fIarg\fR is longer than the
specified length, the extra characters will be ignored.  If
\fIcount\fR is
.QW \fB*\fR ,
then all of the bytes in \fIarg\fR will be
\fIcount\fR is \fB*\fR, then all of the bytes in \fIarg\fR will be
formatted.  If \fIcount\fR is omitted, then one character will be
formatted.  For example, the command:
formatted.  For example,
.RS
.PP
.CS
\fBbinary format\fR a7a*a alpha bravo charlie
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fBalpha\e000\e000bravoc\fR
will return a string equivalent to \fBalpha\e000\e000bravoc\fR,
.CE
.PP
the command:
.PP
.CS
\fBbinary format\fR a* [encoding convertto utf-8 \eu20ac]
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\e342\e202\e254\fR
will return a string equivalent to \fB\e342\e202\e254\fR (which is the
.CE
.PP
(which is the
UTF-8 byte sequence for a Euro-currency character), and the command:
UTF-8 byte sequence for a Euro-currency character) and
.PP
.CS
\fBbinary format\fR a* [encoding convertto iso8859-15 \eu20ac]
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\e244\fR
.CE
.PP
(which is the ISO
will return a string equivalent to \fB\e244\fR (which is the ISO
8859\-15 byte sequence for a Euro-currency character). Contrast these
last two with:
.PP
.CS
\fBbinary format\fR a* \eu20ac
.CE
.PP
which returns a binary string equivalent to:
.PP
.CS
\fB\e254\fR
.CE
.PP
(i.e. \fB\exac\fR) by
which returns a string equivalent to \fB\e254\fR (i.e. \fB\exac\fR) by
truncating the high-bits of the character, and which is probably not
what is desired.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR except that spaces are used for
padding instead of nulls.  For example,
.RS
.PP
.CS
\fBbinary format\fR A6A*A alpha bravo charlie
.CE
.PP
will return
will return \fBalpha bravoc\fR.
.PP
.CS
\fBalpha bravoc\fR
.CE
.RE
.IP \fBb\fR 5
Stores a string of \fIcount\fR binary digits in low-to-high order
within each byte in the output binary string.  \fIArg\fR must contain a
within each byte in the output string.  \fIArg\fR must contain a
sequence of \fB1\fR and \fB0\fR characters.  The resulting bytes are
emitted in first to last order with the bits being formatted in
low-to-high order within each byte.  If \fIarg\fR has fewer than
\fIcount\fR digits, then zeros will be used for the remaining bits.
If \fIarg\fR has more than the specified number of digits, the extra
digits will be ignored.  If \fIcount\fR is
digits will be ignored.  If \fIcount\fR is \fB*\fR, then all of the
.QW \fB*\fR ,
then all of the
digits in \fIarg\fR will be formatted.  If \fIcount\fR is omitted,
then one digit will be formatted.  If the number of bits formatted
does not end at a byte boundary, the remaining bits of the last byte
will be zeros.  For example,
.RS
.PP
.CS
\fBbinary format\fR b5b* 11100 111000011010
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\ex07\ex87\ex05\fR
will return a string equivalent to \fB\ex07\ex87\ex05\fR.
.CE
.RE
.IP \fBB\fR 5
This form is the same as \fBb\fR except that the bits are stored in
high-to-low order within each byte.  For example,
.RS
.PP
.CS
\fBbinary format\fR B5B* 11100 111000011010
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exe0\exe1\exa0\fR
will return a string equivalent to \fB\exe0\exe1\exa0\fR.
.CE
.RE
.IP \fBH\fR 5
Stores a string of \fIcount\fR hexadecimal digits in high-to-low
within each byte in the output binary string.  \fIArg\fR must contain a
within each byte in the output string.  \fIArg\fR must contain a
sequence of characters in the set
.QW 0123456789abcdefABCDEF .
The resulting bytes are emitted in first to last order with the hex digits
being formatted in high-to-low order within each byte.  If \fIarg\fR
has fewer than \fIcount\fR digits, then zeros will be used for the
remaining digits.  If \fIarg\fR has more than the specified number of
digits, the extra digits will be ignored.  If \fIcount\fR is
.QW \fB*\fR ,
then all of the digits in \fIarg\fR will be formatted.  If
\fB*\fR, then all of the digits in \fIarg\fR will be formatted.  If
\fIcount\fR is omitted, then one digit will be formatted.  If the
number of digits formatted does not end at a byte boundary, the
remaining bits of the last byte will be zeros.  For example,
.RS
.PP
.CS
\fBbinary format\fR H3H*H2 ab DEF 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exab\ex00\exde\exf0\ex98\fR
will return a string equivalent to \fB\exab\ex00\exde\exf0\ex98\fR.
.CE
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR except that the digits are stored in
low-to-high order within each byte. This is seldom required. For example,
.RS
.PP
.CS
\fBbinary format\fR h3h*h2 AB def 987
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fB\exba\ex00\exed\ex0f\ex89\fR
will return a string equivalent to \fB\exba\ex00\exed\ex0f\ex89\fR.
.CE
.RE
.IP \fBc\fR 5
Stores one or more 8-bit integer values in the output string.  If no
\fIcount\fR is specified, then \fIarg\fR must consist of an integer
value. If \fIcount\fR is specified, \fIarg\fR must consist of a list
containing at least that many integers. The low-order 8 bits of each integer
are stored as a one-byte value at the cursor position.  If \fIcount\fR is
are stored as a one-byte value at the cursor position.  If \fIcount\fR
.QW \fB*\fR ,
then all of the integers in the list are formatted. If the
is \fB*\fR, then all of the integers in the list are formatted. If the
number of elements in the list is greater
than \fIcount\fR, then the extra elements are ignored.  For example,
.RS
.PP
.CS
\fBbinary format\fR c3cc* {3 -3 128 1} 260 {2 5}
.CE
.PP
will return a binary string equivalent to:
will return a string equivalent to
.PP
.CS
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR, whereas
.CE
.PP
whereas:
.PP
.CS
\fBbinary format\fR c {2 5}
.CE
.PP
will generate an error.
.RE
.IP \fBs\fR 5
This form is the same as \fBc\fR except that it stores one or more
16-bit integers in little-endian byte order in the output string.  The
low-order 16-bits of each integer are stored as a two-byte value at
the cursor position with the least significant byte stored first.  For
example,
.RS
.PP
.CS
\fBbinary format\fR s3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
will return a string equivalent to 
.PP
.CS
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR.
.CE
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that it stores one or more
16-bit integers in big-endian byte order in the output string.  For
example,
.RS
.PP
.CS
\fBbinary format\fR S3 {3 -3 258 1}
.CE
.PP
will return a binary string equivalent to:
will return a string equivalent to 
.PP
.CS
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR
\fB\ex00\ex03\exff\exfd\ex01\ex02\fR.
.CE
.RE
.IP \fBt\fR 5
.VS 8.5
This form (mnemonically \fItiny\fR) is the same as \fBs\fR and \fBS\fR
except that it stores the 16-bit integers in the output string in the
native byte order of the machine where the Tcl script is running.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.VE 8.5
.IP \fBi\fR 5
This form is the same as \fBc\fR except that it stores one or more
32-bit integers in little-endian byte order in the output string.  The
low-order 32-bits of each integer are stored as a four-byte value at
the cursor position with the least significant byte stored first.  For
example,
.RS
.PP
.CS
\fBbinary format\fR i3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
will return a string equivalent to 
.PP
.CS
\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
.CE
.RE
.IP \fBI\fR 5
This form is the same as \fBi\fR except that it stores one or more one
or more 32-bit integers in big-endian byte order in the output string.
For example,
.RS
.PP
.CS
\fBbinary format\fR I3 {3 -3 65536 1}
.CE
.PP
will return a binary string equivalent to:
will return a string equivalent to 
.PP
.CS
\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
.CE
.RE
.IP \fBn\fR 5
.VS 8.5
This form (mnemonically \fInumber\fR or \fInormal\fR) is the same as
\fBi\fR and \fBI\fR except that it stores the 32-bit integers in the
output string in the native byte order of the machine where the Tcl
script is running.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.VE 8.5
.IP \fBw\fR 5
This form is the same as \fBc\fR except that it stores one or more
64-bit integers in little-endian byte order in the output string.  The
low-order 64-bits of each integer are stored as an eight-byte value at
the cursor position with the least significant byte stored first.  For
example,
.RS
.PP
.CS
\fBbinary format\fR w 7810179016327718216
.CE
.PP
will return the binary string \fBHelloTcl\fR.
will return the string \fBHelloTcl\fR
.RE
.IP \fBW\fR 5
This form is the same as \fBw\fR except that it stores one or more one
or more 64-bit integers in big-endian byte order in the output string.
For example,
.RS
.PP
.CS
\fBbinary format\fR Wc 4785469626960341345 110
.CE
.PP
will return the binary string \fBBigEndian\fR
will return the string \fBBigEndian\fR
.RE
.IP \fBm\fR 5
.VS 8.5
This form (mnemonically the mirror of \fBw\fR) is the same as \fBw\fR
and \fBW\fR except that it stores the 64-bit integers in the output
string in the native byte order of the machine where the Tcl script is
running.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.VE 8.5
.IP \fBf\fR 5
This form is the same as \fBc\fR except that it stores one or more one
or more single-precision floating point numbers in the machine's native
representation in the output string.  This representation is not
portable across architectures, so it should not be used to communicate
floating point numbers across the network.  The size of a floating
point number may vary across architectures, so the number of bytes
that are generated may vary.  If the value overflows the
machine's native representation, then the value of FLT_MAX
as defined by the system will be used instead.  Because Tcl uses
double-precision floating point numbers internally, there may be some
loss of precision in the conversion to single-precision.  For example,
on a Windows system running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary format\fR f2 {1.6 3.4}
.CE
.PP
will return a binary string equivalent to:
will return a string equivalent to 
.PP
.CS
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR
\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR.
.CE
.RE
.IP \fBr\fR 5
.VS 8.5
This form (mnemonically \fIreal\fR) is the same as \fBf\fR except that
it stores the single-precision floating point numbers in little-endian
order.  This conversion only produces meaningful output when used on
machines which use the IEEE floating point representation (very
common, but not universal.)
.VE 8.5
.IP \fBR\fR 5
.VS 8.5
This form is the same as \fBr\fR except that it stores the
single-precision floating point numbers in big-endian order.
.VE 8.5
.IP \fBd\fR 5
This form is the same as \fBf\fR except that it stores one or more one
or more double-precision floating point numbers in the machine's native
representation in the output string.  For example, on a
Windows system running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary format\fR d1 {1.6}
.CE
.PP
will return a binary string equivalent to:
will return a string equivalent to 
.PP
.CS
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR
\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR.
.CE
.RE
.IP \fBq\fR 5
.VS 8.5
This form (mnemonically the mirror of \fBd\fR) is the same as \fBd\fR
except that it stores the double-precision floating point numbers in
little-endian order.  This conversion only produces meaningful output
when used on machines which use the IEEE floating point representation
(very common, but not universal.)
.VE 8.5
.IP \fBQ\fR 5
.VS 8.5
This form is the same as \fBq\fR except that it stores the
double-precision floating point numbers in big-endian order.
.VE 8.5
.IP \fBx\fR 5
Stores \fIcount\fR null bytes in the output string.  If \fIcount\fR is
not specified, stores one null byte.  If \fIcount\fR is
not specified, stores one null byte.  If \fIcount\fR is \fB*\fR,
.QW \fB*\fR ,
generates an error.  This type does not consume an argument.  For
example,
.RS
.PP
.CS
\fBbinary format\fR a3xa3x2a3 abc def ghi
.CE
.PP
will return a binary string equivalent to:
.PP
.CS
\fBabc\e000def\e000\e000ghi\fR
will return a string equivalent to \fBabc\e000def\e000\e000ghi\fR.
.CE
.RE
.IP \fBX\fR 5
Moves the cursor back \fIcount\fR bytes in the output string.  If
\fIcount\fR is
.QW \fB*\fR
or is larger than the current cursor position,
\fIcount\fR is \fB*\fR or is larger than the current cursor position,
then the cursor is positioned at location 0 so that the next byte
stored will be the first byte in the result string.  If \fIcount\fR is
omitted then the cursor is moved back one byte.  This type does not
consume an argument.  For example,
.RS
.PP
.CS
\fBbinary format\fR a3X*a3X2a3 abc def ghi
.CE
.PP
will return \fBdghi\fR.
.RE
.IP \fB@\fR 5
Moves the cursor to the absolute location in the output string
specified by \fIcount\fR.  Position 0 refers to the first byte in the
output string.  If \fIcount\fR refers to a position beyond the last
byte stored so far, then null bytes will be placed in the uninitialized
locations and the cursor will be placed at the specified location.  If
\fIcount\fR is
.QW \fB*\fR ,
then the cursor is moved to the current end of
\fIcount\fR is \fB*\fR, then the cursor is moved to the current end of
the output string.  If \fIcount\fR is omitted, then an error will be
generated.  This type does not consume an argument. For example,
.RS
.PP
.CS
\fBbinary format\fR a5@2a1@*a3@10a1 abcde f ghi j
.CE
.PP
will return
.PP
.CS
\fBabfdeghi\e000\e000j\fR
will return \fBabfdeghi\e000\e000j\fR.
.CE
.RE
.SH "BINARY SCAN"
.PP
The \fBbinary scan\fR command parses fields from a binary string,
returning the number of conversions performed.  \fIString\fR gives the
input bytes to be parsed (one byte per character, and characters not
representable as a byte have their high bits chopped)
619
620
621
622
623
624
625
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
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
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

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
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
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
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
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
611
612

613
614
615
616

617


618
619
620
621
622
623
624
625
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
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
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











-
+
-
-
+













-











-





-

-











-




-




-










-
+
-
-
+








-



-


-




-






-



-










-
+
-
-
+


-



-







-



-










-
-
+



-



-







-



-


-
+


-


-
+
-
-




-



-

-
-
+
+
+
+
+
+



-
+
-
-
+
-
-
+



-



-

-
-
+
+
+
+
+
+



-
+


-



-

-
+


+


-
-
+


+


-
+
-
-
+
-
-
+



-




-

-
-
+
+
+
+
+
+




-
-
+

-




-




+


-
-
+


+


-
+
-
-
+
-
-
+



-




-

-
+
+




-
-
+

-




-




+


-
-
+


+




-
-
-
+








-



-




+




+

+




+






-



-




+




+

+




+


-
-
-
+





-



-




-
-
-
+





-



-










-



-




-







-


-










-









-
-
-
-
-
-
-
-
-
-

-
+


-
-
-
-
spaces.  Each field specifier is a single type character followed by
an optional flag character followed by an optional numeric \fIcount\fR.
Most field specifiers consume one
argument to obtain the variable into which the scanned values should
be placed.  The type character specifies how the binary data is to be
interpreted.  The \fIcount\fR typically indicates how many items of
the specified type are taken from the data.  If present, the
\fIcount\fR is a non-negative decimal integer or
\fIcount\fR is a non-negative decimal integer or \fB*\fR, which
.QW \fB*\fR ,
which normally indicates that all of the remaining items in the data are to
normally indicates that all of the remaining items in the data are to
be used.  If there are not enough bytes left after the current cursor
position to satisfy the current field specifier, then the
corresponding variable is left untouched and \fBbinary scan\fR returns
immediately with the number of variables that were set.  If there are
not enough arguments for all of the fields in the format string that
consume arguments, then an error is generated. The flag character
.QW u
may be given to cause some types to be read as unsigned values. The flag
is accepted for all field types but is ignored for non-integer fields.
.PP
A similar example as with \fBbinary format\fR should explain the
relation between field specifiers and arguments in case of the binary
scan subcommand:
.PP
.CS
\fBbinary scan\fR $bytes s3s first second
.CE
.PP
This command (provided the binary string in the variable \fIbytes\fR
is long enough) assigns a list of three integers to the variable
\fIfirst\fR and assigns a single value to the variable \fIsecond\fR.
If \fIbytes\fR contains fewer than 8 bytes (i.e. four 2-byte
integers), no assignment to \fIsecond\fR will be made, and if
\fIbytes\fR contains fewer than 6 bytes (i.e. three 2-byte integers),
no assignment to \fIfirst\fR will be made.  Hence:
.PP
.CS
puts [\fBbinary scan\fR abcdefg s3s first second]
puts $first
puts $second
.CE
.PP
will print (assuming neither variable is set previously):
.PP
.CS
1
25185 25699 26213
can't read "second": no such variable
.CE
.PP
It is \fIimportant\fR to note that the \fBc\fR, \fBs\fR, and \fBS\fR
(and \fBi\fR and \fBI\fR on 64bit systems) will be scanned into
long data size values.  In doing this, values that have their high
bit set (0x80 for chars, 0x8000 for shorts, 0x80000000 for ints),
will be sign extended.  Thus the following will occur:
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
.CE
.PP
If you require unsigned values you can include the
.QW u
flag character following
the field type. For example, to read an unsigned short value:
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort su1 val; \fI# val == 0x00008000\fR
.CE
.PP
Each type-count pair moves an imaginary cursor through the binary data,
reading bytes from the current position.  The cursor is initially
at position 0 at the beginning of the data.  The type may be any one of
the following characters:
.IP \fBa\fR 5
The data is a byte string of length \fIcount\fR.  If \fIcount\fR is
The data is a byte string of length \fIcount\fR.  If \fIcount\fR
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be
is \fB*\fR, then all of the remaining bytes in \fIstring\fR will be
scanned into the variable.  If \fIcount\fR is omitted, then one
byte will be scanned.
All bytes scanned will be interpreted as being characters in the
range \eu0000-\eu00ff so the \fBencoding convertfrom\fR command will be
needed if the string is not a binary string or a string encoded in ISO
8859\-1.
For example,
.RS
.PP
.CS
\fBbinary scan\fR abcde\e000fghi a6a10 var1 var2
.CE
.PP
will return \fB1\fR with the string equivalent to \fBabcde\e000\fR
stored in \fIvar1\fR and \fIvar2\fR left unmodified, and
.PP
.CS
\fBbinary scan\fR \e342\e202\e254 a* var1
set var2 [encoding convertfrom utf-8 $var1]
.CE
.PP
will store a Euro-currency character in \fIvar2\fR.
.RE
.IP \fBA\fR 5
This form is the same as \fBa\fR, except trailing blanks and nulls are stripped from
the scanned value before it is stored in the variable.  For example,
.RS
.PP
.CS
\fBbinary scan\fR "abc efghi  \e000" A* var1
.CE
.PP
will return \fB1\fR with \fBabc efghi\fR stored in \fIvar1\fR.
.RE
.IP \fBb\fR 5
The data is turned into a string of \fIcount\fR binary digits in
low-to-high order represented as a sequence of
.QW 1
and
.QW 0
characters.  The data bytes are scanned in first to last order with
the bits being taken in low-to-high order within each byte.  Any extra
bits in the last byte are ignored.  If \fIcount\fR is
bits in the last byte are ignored.  If \fIcount\fR is \fB*\fR, then
.QW \fB*\fR ,
then all of the remaining bits in \fIstring\fR will be scanned.  If
all of the remaining bits in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one bit will be scanned.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\ex87\ex05 b5b* var1 var2
.CE
.PP
will return \fB2\fR with \fB11100\fR stored in \fIvar1\fR and
\fB1110000110100000\fR stored in \fIvar2\fR.
.RE
.IP \fBB\fR 5
This form is the same as \fBb\fR, except the bits are taken in
high-to-low order within each byte.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex70\ex87\ex05 B5B* var1 var2
.CE
.PP
will return \fB2\fR with \fB01110\fR stored in \fIvar1\fR and
\fB1000011100000101\fR stored in \fIvar2\fR.
.RE
.IP \fBH\fR 5
The data is turned into a string of \fIcount\fR hexadecimal digits in
high-to-low order represented as a sequence of characters in the set
.QW 0123456789abcdef .
The data bytes are scanned in first to last
order with the hex digits being taken in high-to-low order within each
byte. Any extra bits in the last byte are ignored. If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining hex digits in \fIstring\fR will be
\fB*\fR, then all of the remaining hex digits in \fIstring\fR will be
scanned. If \fIcount\fR is omitted, then one hex digit will be
scanned. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
.CE
.PP
will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
\fB051f34\fR stored in \fIvar2\fR.
.RE
.IP \fBh\fR 5
This form is the same as \fBH\fR, except the digits are taken in
reverse (low-to-high) order within each byte. For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\ex86\ex05\ex12\ex34 h3h* var1 var2
.CE
.PP
will return \fB2\fR with \fB706\fR stored in \fIvar1\fR and
\fB502143\fR stored in \fIvar2\fR.
.PP
.RE
Note that most code that wishes to parse the hexadecimal digits from
multiple bytes in order should use the \fBH\fR format.
.RE
.IP \fBc\fR 5
The data is turned into \fIcount\fR 8-bit signed integers and stored
in the corresponding variable as a list, or as unsigned if \fBu\fR is placed
in the corresponding variable as a list. If \fIcount\fR is \fB*\fR,
immediately after the \fBc\fR. If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 8-bit integer will be scanned.  For
example,
.RS
.PP
.CS
\fBbinary scan\fR \ex07\ex86\ex05 c2c* var1 var2
.CE
.PP
will return \fB2\fR with \fB7 -122\fR stored in \fIvar1\fR and \fB5\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBcu\fR in place of \fBc\fR.
stored in \fIvar2\fR.  Note that the integers returned are signed, but
they can be converted to unsigned 8-bit quantities using an expression
like:
.CS
set num [expr { $num & 0xFF }]
.CE
.RE
.IP \fBs\fR 5
The data is interpreted as \fIcount\fR 16-bit signed integers
represented in little-endian byte order, or as unsigned if \fBu\fR is placed
represented in little-endian byte order.  The integers are stored in
immediately after the \fBs\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
the corresponding variable as a list.  If \fIcount\fR is \fB*\fR, then
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 16-bit integer will be scanned.  For
example,
.RS
.PP
.CS
\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBsu\fR is used in place of \fBs\fR.
stored in \fIvar2\fR.  Note that the integers returned are signed, but
they can be converted to unsigned 16-bit quantities using an expression
like:
.CS
set num [expr { $num & 0xFFFF }]
.CE
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that the data is interpreted
as \fIcount\fR 16-bit integers represented in big-endian byte
as \fIcount\fR 16-bit signed integers represented in big-endian byte
order.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
stored in \fIvar2\fR. 
.RE
.IP \fBt\fR 5
.VS 8.5
The data is interpreted as \fIcount\fR 16-bit signed integers
represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBt\fR.  It is otherwise identical to \fBs\fR and \fBS\fR.
script.  It is otherwise identical to \fBs\fR and \fBS\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.VE 8.5
.IP \fBi\fR 5
The data is interpreted as \fIcount\fR 32-bit signed integers
represented in little-endian byte order, or as unsigned if \fBu\fR is placed
represented in little-endian byte order.  The integers are stored in
immediately after the \fBi\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
the corresponding variable as a list.  If \fIcount\fR is \fB*\fR, then
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 32-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBiu\fR is used in place of \fBi\fR.
stored in \fIvar2\fR.  Note that the integers returned are signed, but
they can be converted to unsigned 32-bit quantities using an expression
like:
.CS
set num [expr { $num & 0xFFFFFFFF }]
.CE
.RE
.IP \fBI\fR 5
This form is the same as \fBI\fR except that the data is interpreted
as \fIcount\fR 32-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBI\fR.  For example,
order.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
.CE
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBn\fR 5
.VS 8.5
The data is interpreted as \fIcount\fR 32-bit signed integers
represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBn\fR.  It is otherwise identical to \fBi\fR and \fBI\fR.
script.  It is otherwise identical to \fBi\fR and \fBI\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.VE 8.5
.IP \fBw\fR 5
The data is interpreted as \fIcount\fR 64-bit signed integers
represented in little-endian byte order, or as unsigned if \fBu\fR is placed
represented in little-endian byte order.  The integers are stored in
immediately after the \fBw\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
the corresponding variable as a list.  If \fIcount\fR is \fB*\fR, then
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 64-bit integer will be scanned.  For
example,
.RS
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
.CE
.PP
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
\fB\-16\fR stored in \fIvar2\fR.
\fB\-16\fR stored in \fIvar2\fR.  Note that the integers returned are
signed and cannot be represented by Tcl as unsigned values.
.RE
.IP \fBW\fR 5
This form is the same as \fBw\fR except that the data is interpreted
as \fIcount\fR 64-bit signed integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBW\fR.  For example,
order.  For example,
.RS
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
.CE
.PP
will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBm\fR 5
.VS 8.5
The data is interpreted as \fIcount\fR 64-bit signed integers
represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBm\fR.  It is otherwise identical to \fBw\fR and \fBW\fR.
script.  It is otherwise identical to \fBw\fR and \fBW\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.VE 8.5
.IP \fBf\fR 5
The data is interpreted as \fIcount\fR single-precision floating point
numbers in the machine's native representation.  The floating point
numbers are stored in the corresponding variable as a list.  If
\fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in
\fIcount\fR is \fB*\fR, then all of the remaining bytes in
\fIstring\fR will be scanned.  If \fIcount\fR is omitted, then one
single-precision floating point number will be scanned.  The size of a
floating point number may vary across architectures, so the number of
bytes that are scanned may vary.  If the data does not represent a
valid floating point number, the resulting value is undefined and
compiler dependent.  For example, on a Windows system running on an
Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
.CE
.PP
will return \fB1\fR with \fB1.6000000238418579\fR stored in
\fIvar1\fR.
.RE
.IP \fBr\fR 5
.VS 8.5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR single-precision floating point number in little-endian
order.  This conversion is not portable to the minority of systems not
using IEEE floating point representations.
.VE 8.5
.IP \fBR\fR 5
.VS 8.5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR single-precision floating point number in big-endian
order.  This conversion is not portable to the minority of systems not
using IEEE floating point representations.
.VE 8.5
.IP \fBd\fR 5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
machine's native representation. For example, on a Windows system
running on an Intel Pentium processor,
.RS
.PP
.CS
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
.CE
.PP
will return \fB1\fR with \fB1.6000000000000001\fR
stored in \fIvar1\fR.
.RE
.IP \fBq\fR 5
.VS 8.5
This form is the same as \fBd\fR except that the data is interpreted
as \fIcount\fR double-precision floating point number in little-endian
order.  This conversion is not portable to the minority of systems not
using IEEE floating point representations.
.VE 8.5
.IP \fBQ\fR 5
.VS 8.5
This form is the same as \fBd\fR except that the data is interpreted
as \fIcount\fR double-precision floating point number in big-endian
order.  This conversion is not portable to the minority of systems not
using IEEE floating point representations.
.VE 8.5
.IP \fBx\fR 5
Moves the cursor forward \fIcount\fR bytes in \fIstring\fR.  If
\fIcount\fR is
.QW \fB*\fR
or is larger than the number of bytes after the
\fIcount\fR is \fB*\fR or is larger than the number of bytes after the
current cursor position, then the cursor is positioned after
the last byte in \fIstring\fR.  If \fIcount\fR is omitted, then the
cursor is moved forward one byte.  Note that this type does not
consume an argument.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex01\ex02\ex03\ex04 x2H* var1
.CE
.PP
will return \fB1\fR with \fB0304\fR stored in \fIvar1\fR.
.RE
.IP \fBX\fR 5
Moves the cursor back \fIcount\fR bytes in \fIstring\fR.  If
\fIcount\fR is
.QW \fB*\fR
or is larger than the current cursor position,
\fIcount\fR is \fB*\fR or is larger than the current cursor position,
then the cursor is positioned at location 0 so that the next byte
scanned will be the first byte in \fIstring\fR.  If \fIcount\fR
is omitted then the cursor is moved back one byte.  Note that this
type does not consume an argument.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex01\ex02\ex03\ex04 c2XH* var1 var2
.CE
.PP
will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR
stored in \fIvar2\fR.
.RE
.IP \fB@\fR 5
Moves the cursor to the absolute location in the data string specified
by \fIcount\fR.  Note that position 0 refers to the first byte in
\fIstring\fR.  If \fIcount\fR refers to a position beyond the end of
\fIstring\fR, then the cursor is positioned after the last byte.  If
\fIcount\fR is omitted, then an error will be generated.  For example,
.RS
.PP
.CS
\fBbinary scan\fR \ex01\ex02\ex03\ex04 c2@1H* var1 var2
.CE
.PP
will return \fB2\fR with \fB1 2\fR stored in \fIvar1\fR and \fB020304\fR
stored in \fIvar2\fR.
.RE
.SH "PORTABILITY ISSUES"
.PP
The \fBr\fR, \fBR\fR, \fBq\fR and \fBQ\fR conversions will only work
reliably for transferring data between computers which are all using
IEEE floating point representations.  This is very common, but not
universal.  To transfer floating-point numbers portably between all
architectures, use their textual representation (as produced by
\fBformat\fR) instead.
.SH EXAMPLES
.PP
This is a procedure to write a Tcl string to a binary-encoded channel as
UTF-8 data preceded by a length word:
.PP
.CS
proc \fIwriteString\fR {channel string} {
    set data [encoding convertto utf-8 $string]
    puts -nonewline [\fBbinary format\fR Ia* \e
            [string length $data] $data]
}
.CE
.PP
This procedure reads a string from a channel that was written by the
previously presented \fIwriteString\fR procedure:
.PP
.CS
proc \fIreadString\fR {channel} {
    if {![\fBbinary scan\fR [read $channel 4] I length]} {
        error "missing length"
    }
    set data [read $channel $length]
    return [encoding convertfrom utf-8 $data]
}
.CE
.PP
This converts the contents of a file (named in the variable \fIfilename\fR) to
base64 and prints them:
.PP
.CS
set f [open $filename rb]
set data [read $f]
close $f
puts [\fBbinary encode\fR base64 \-maxlen 64 $data]
.CE
.SH "SEE ALSO"
encoding(n), format(n), scan(n), string(n), tcl_platform(n)
format(n), scan(n), tclvars(n)
.SH KEYWORDS
binary, format, scan
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/break.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
44
45
46
47
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









-
+









+




-
+








-

-


-
-
-
-
+
+
+
+


+


+


-
-
-
'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH break n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
break \- Abort looping command
.SH SYNOPSIS
\fBbreak\fR
.BE

.SH DESCRIPTION
.PP
This command is typically invoked inside the body of a looping command
such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR.
It returns a 3 (\fBTCL_BREAK\fR) result code, which causes a break exception
It returns a \fBTCL_BREAK\fR code, which causes a break exception
to occur.
The exception causes the current script to be aborted
out to the innermost containing loop command, which then
aborts its execution and returns normally.
Break exceptions are also handled in a few other situations, such
as the \fBcatch\fR command, Tk event bindings, and the outermost
scripts of procedure bodies.
.SH EXAMPLE
.PP
Print a line for each of the integers from 0 to 5:
.PP
.CS
for {set x 0} {$x<10} {incr x} {
    if {$x > 5} {
        \fBbreak\fR
    }
    puts "x is $x"
   if {$x > 5} {
      \fBbreak\fR
   }
   puts "x is $x"
}
.CE

.SH "SEE ALSO"
catch(n), continue(n), for(n), foreach(n), return(n), while(n)

.SH KEYWORDS
abort, break, loop
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/callback.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
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
























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH callback n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
callback, mymethod \- generate callbacks to methods
.SH SYNOPSIS
.nf
package require TclOO

\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBcallback\fR command,
'\" Based on notes in the tcllib docs, we know the provenance of mymethod
also called \fBmymethod\fR for compatibility with the ooutil and snit packages
of Tcllib,
and which should only be used from within the context of a call to a method
(i.e. inside a method, constructor or destructor body) is used to generate a
script fragment that will invoke the method, \fImethodName\fR, on the current
object (as reported by \fBself\fR) when executed. Any additional arguments
provided will be provided as leading arguments to the callback. The resulting
script fragment shall be a proper list.
.PP
Note that it is up to the caller to ensure that the current object is able to
handle the call of \fImethodName\fR; this command does not check that.
\fImethodName\fR may refer to any exported or unexported method, but may not
refer to a private method as those can only be invoked directly from within
methods. If there is no such method present at the point when the callback is
invoked, the standard \fBunknown\fR method handler will be called.
.SH EXAMPLE
This is a simple echo server class. The \fBcallback\fR command is used in two
places, to arrange for the incoming socket connections to be handled by the
\fIAccept\fR method, and to arrange for the incoming bytes on those
connections to be handled by the \fIReceive\fR method.
.PP
.CS
oo::class create EchoServer {
    variable server clients
    constructor {port} {
        set server [socket -server [\fBcallback\fR Accept] $port]
        set clients {}
    }
    destructor {
        chan close $server
        foreach client [dict keys $clients] {
            chan close $client
        }
    }

    method Accept {channel clientAddress clientPort} {
        dict set clients $channel [dict create \e
                address $clientAddress port $clientPort]
        chan event $channel readable [\fBcallback\fR Receive $channel]
    }
    method Receive {channel} {
        if {[chan gets $channel line] >= 0} {
            my echo $channel $line
        } else {
            chan close $channel
            dict unset clients $channel
        }
    }

    method echo {channel line} {
        dict with clients $channel {
            chan puts $channel \e
                    [format {[%s:%d] %s} $address $port $line]
        }
    }
}
.CE
.SH "SEE ALSO"
chan(n), fileevent(n), my(n), self(n), socket(n), trace(n)
.SH KEYWORDS
callback, object
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Added doc/case.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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.TH case n 7.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
case \- Evaluate one of several scripts, depending on a given value
.SH SYNOPSIS
\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...?
.sp
\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?}
.BE

.SH DESCRIPTION
.PP
\fINote: the \fBcase\fI command is obsolete and is supported only
for backward compatibility.  At some point in the future it may be
removed entirely.  You should use the \fBswitch\fI command instead.\fR
.PP
The \fBcase\fR command matches \fIstring\fR against each of
the \fIpatList\fR arguments in order.
Each \fIpatList\fR argument is a list of one or
more patterns.  If any of these patterns matches \fIstring\fR then
\fBcase\fR evaluates the following \fIbody\fR argument
by passing it recursively to the Tcl interpreter and returns the result
of that evaluation.
Each \fIpatList\fR argument consists of a single
pattern or list of patterns.  Each pattern may contain any of the wild-cards
described under \fBstring match\fR.  If a \fIpatList\fR
argument is \fBdefault\fR, the corresponding body will be evaluated
if no \fIpatList\fR matches \fIstring\fR.  If no \fIpatList\fR argument
matches \fIstring\fR and no default is given, then the \fBcase\fR
command returns an empty string.
.PP
Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
this form is convenient if substitutions are desired on some of the
patterns or commands.
The second form places all of the patterns and commands together into
a single argument; the argument must have proper list structure, with
the elements of the list being the patterns and commands.
The second form makes it easy to construct multi-line case commands,
since the braces around the whole list make it unnecessary to include a
backslash at the end of each line.
Since the \fIpatList\fR arguments are in braces in the second form,
no command or variable substitutions are performed on them;  this makes
the behavior of the second form different than the first form in some
cases.

.SH "SEE ALSO"
switch(n)

.SH KEYWORDS
case, match, regular expression

Changes to doc/catch.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

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
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











-
+









+



-
-
+
+












-
+



-
-
-
-
+
+
+
+

+


-
+








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





+

-


-









+
-
-
-
+
+
+

-
+
-
-
-
-
'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2003.  (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.
'\"
'\" 
.TH catch n "8.5" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
catch \- Evaluate script and trap exceptional returns
.SH SYNOPSIS
\fBcatch\fI script \fR?\fIresultVarName\fR? ?\fIoptionsVarName\fR?
.BE

.SH DESCRIPTION
.PP
The \fBcatch\fR command may be used to prevent errors from aborting command
interpretation.  The \fBcatch\fR command calls the Tcl interpreter recursively
to execute \fIscript\fR, and always returns without raising an error,
interpretation.  The \fBcatch\fR command calls the Tcl interpreter recursively to
execute \fIscript\fR, and always returns without raising an error,
regardless of any errors that might occur while executing \fIscript\fR.
.PP
If \fIscript\fR raises an error, \fBcatch\fR will return a non-zero integer
value corresponding to the exceptional return code returned by evaluation
of \fIscript\fR.  Tcl defines the normal return code from script
evaluation to be zero (0), or \fBTCL_OK\fR.  Tcl also defines four exceptional
return codes: 1 (\fBTCL_ERROR\fR), 2 (\fBTCL_RETURN\fR), 3 (\fBTCL_BREAK\fR),
and 4 (\fBTCL_CONTINUE\fR).  Errors during evaluation of a script are indicated
by a return code of \fBTCL_ERROR\fR.  The other exceptional return codes are
returned by the \fBreturn\fR, \fBbreak\fR, and \fBcontinue\fR commands
and in other special situations as documented.  Tcl packages can define
new commands that return other integer values as return codes as well,
and scripts that make use of the \fBreturn \-code\fR command can also
and scripts that make use of the \fBreturn -code\fR command can also
have return codes other than the five defined by Tcl.
.PP
If the \fIresultVarName\fR argument is given, then the variable it names is
set to the result of the script evaluation.  When the return code from the
script is 1 (\fBTCL_ERROR\fR), the value stored in \fIresultVarName\fR is an
error message.  When the return code from the script is 0 (\fBTCL_OK\fR), the
value stored in \fIresultVarName\fR is the value returned from \fIscript\fR.
set to the result of the script evaluation.  When the return code from
the script is 1 (\fBTCL_ERROR\fR), the value stored in \fIresultVarName\fR is an error
message.  When the return code from the script is 0 (\fBTCL_OK\fR), the value
stored in \fIresultVarName\fR is the value returned from \fIscript\fR.
.PP
.VS 8.5
If the \fIoptionsVarName\fR argument is given, then the variable it
names is set to a dictionary of return options returned by evaluation
of \fIscript\fR.  Tcl specifies two entries that are always
of \fIscript\fR.  Tcl specifies two entries that are always 
defined in the dictionary: \fB\-code\fR and \fB\-level\fR.  When
the return code from evaluation of \fIscript\fR is not \fBTCL_RETURN\fR,
the value of the \fB\-level\fR entry will be 0, and the value
of the \fB\-code\fR entry will be the same as the return code.
Only when the return code is \fBTCL_RETURN\fR will the values of
the \fB\-level\fR and \fB\-code\fR entries be something else, as
further described in the documentation for the \fBreturn\fR command.
.PP
When the return code from evaluation of \fIscript\fR is
\fBTCL_ERROR\fR, four additional entries are defined in the dictionary
of return options stored in \fIoptionsVarName\fR: \fB\-errorinfo\fR,
\fB\-errorcode\fR, \fB\-errorline\fR, and
When the return code from evaluation of \fIscript\fR is \fBTCL_ERROR\fR,
three additional entries are defined in the dictionary of return options
stored in \fIoptionsVarName\fR: \fB\-errorinfo\fR, \fB\-errorcode\fR, 
and \fB\-errorline\fR.  The value of the \fB\-errorinfo\fR entry
\fB\-errorstack\fR.
The value of the \fB\-errorinfo\fR entry is a formatted stack trace containing
more information about the context in which the error happened.  The formatted
stack trace is meant to be read by a person.  The value of the
\fB\-errorcode\fR entry is additional information about the error stored as a
list.  The \fB\-errorcode\fR value is meant to be further processed by
programs, and may not be particularly readable by people.  The value of the
\fB\-errorline\fR entry is an integer indicating which line of \fIscript\fR
was being evaluated when the error occurred.
is a formatted stack trace containing more information about
the context in which the error happened.  The formatted stack
trace is meant to be read by a person.  The value of
the \fB\-errorcode\fR entry is additional information about the
error stored as a list.  The \fB\-errorcode\fR value is meant to
be further processed by programs, and may not be particularly
readable by people.  The value of the \fB\-errorline\fR entry
is an integer indicating which line of \fIscript\fR was being
evaluated when the error occurred.  The values of the \fB\-errorinfo\fR
The value of the \fB\-errorstack\fR entry is an
even-sized list made of token-parameter pairs accumulated while
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]
it is coarser-grained, with only one element per stack frame (like procs; no
separate elements for \fBforeach\fR constructs for example).
.PP
The values of the \fB\-errorinfo\fR and \fB\-errorcode\fR entries of
the most recent error are also available as values of the global
variables \fB::errorInfo\fR and \fB::errorCode\fR respectively.
and \fB\-errorcode\fR entries of the most recent error are also
available as values of the global variables \fB::errorInfo\fR
and \fB::errorCode\fR respectively.
The value of the \fB\-errorstack\fR entry surfaces as \fBinfo errorstack\fR.
.PP
Tcl packages may provide commands that set other entries in the
dictionary of return options, and the \fBreturn\fR command may be
used by scripts to set return options in addition to those defined
above.
.VE 8.5
.SH EXAMPLES
.PP
The \fBcatch\fR command may be used in an \fBif\fR to branch based on
the success of a script.
.PP
.CS
if { [\fBcatch\fR {open $someFile w} fid] } {
    puts stderr "Could not open $someFile for writing\en$fid"
    exit 1
}
.CE
.PP
There are more complex examples of \fBcatch\fR usage in the
documentation for the \fBreturn\fR command.

.SH "SEE ALSO"
break(n), continue(n), dict(n), error(n), errorCode(n), errorInfo(n), info(n),
return(n)
.SH "SEE ALSO" 
break(n), continue(n), dict(n), error(n), return(n), tclvars(n)

.SH KEYWORDS
catch, error, exception
catch, error
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/cd.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
44
45
46
47
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) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH cd n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
cd \- Change working directory
.SH SYNOPSIS
\fBcd \fR?\fIdirName\fR?
.BE

.SH DESCRIPTION
.PP
Change the current working directory to \fIdirName\fR, or to the
home directory (as specified in the HOME environment variable) if
\fIdirName\fR is not given.
Returns an empty string.
Note that the current working directory is a per-process resource; the
\fBcd\fR command changes the working directory for all interpreters
and all threads.
and (in a threaded environment) all threads.
.SH EXAMPLES
.PP
Change to the home directory of the user \fBfred\fR:
.PP
.CS
\fBcd\fR ~fred
.CE
.PP
Change to the directory \fBlib\fR that is a sibling directory of the
current one:
.PP
.CS
\fBcd\fR ../lib
.CE

.SH "SEE ALSO"
filename(n), glob(n), pwd(n)

.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/chan.n.

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







'\"
'\" 
'\" Copyright (c) 2005-2006 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.TH chan n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
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
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







-
+



-
-
-
-
-
-
-
-
-



-
-
-
-
+
+
+
-

-
-
-
-
-
+
+
+
+
+









-
+
-
-
-
+

-
+







-
-
-
-
-


















-
-
-
-
+
+
+
+
-






-
+


-
+







This tests whether the last input operation on the channel called
\fIchannelId\fR failed because it would have otherwise caused the
process to block, and returns 1 if that was the case. It returns 0
otherwise. Note that this only ever returns 1 when the channel has
been configured to be non-blocking; all Tcl channels have blocking
turned on by default.
.TP
\fBchan close \fIchannelId\fR ?\fIdirection\fR?
\fBchan close \fIchannelId\fR
.
Close and destroy the channel called \fIchannelId\fR. Note that this
deletes all existing file-events registered on the channel.
If the \fIdirection\fR argument (which must be \fBread\fR or \fBwrite\fR or
any unique abbreviation of them) is present, the channel will only be
half-closed, so that it can go from being read-write to write-only or
read-only respectively. If a read-only channel is closed for reading, it is
the same as if the channel is fully closed, and respectively similar for
write-only channels. Without the \fIdirection\fR argument, the channel is
closed for both reading and writing (but only if those directions are
currently open). It is an error to close a read-only channel for writing, or a
write-only channel for reading.
.RS
.PP
As part of closing the channel, all buffered output is flushed to the
channel's output device (only if the channel is ceasing to be writable), any
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
channel's output device, any buffered input is discarded, the
underlying operating system resource is closed and \fIchannelId\fR
becomes unavailable for future use.
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.
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 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
makes \fIchannelId\fR unavailable in the invoking interpreter but has
no other effect until all of the sharing interpreters have closed the
channel. When the last interpreter in which the channel is registered
invokes \fBchan close\fR (or \fBclose\fR), the cleanup actions
described above occur. With half-closing, the half-close of the channel only
described above occur. See the \fBinterp\fR command for a description
applies to the current interpreter's view of the channel until all channels
have closed it in that direction (or completely).
See the \fBinterp\fR command for a description of channel sharing.
of channel sharing.
.PP
Channels are automatically fully closed when an interpreter is destroyed and
Channels are automatically closed when an interpreter is destroyed and
when the process exits.  Channels are switched to blocking mode, to
ensure that all output is correctly flushed before the process exits.
.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, \fBchan close\fR
generates an error (similar to the \fBexec\fR command.)
.PP
Note that half-closes of sockets and command pipelines can have important side
effects because they result in a shutdown() or close() of the underlying
system resource, which can change how other processes or systems respond to
the Tcl program.
.RE
.TP
\fBchan configure \fIchannelId\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?...
.
Query or set the configuration options of the channel named
\fIchannelId\fR.
.RS
.PP
If no \fIoptionName\fR or \fIvalue\fR arguments are supplied, the
command returns a list containing alternating option names and values
for the channel.  If \fIoptionName\fR is supplied but no \fIvalue\fR
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
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 its
additional options.
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
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 non-blocking mode to
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
192
193
194
195
196
197
198
199

200
201
202
203
204
205
206
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187







-
+







for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR 
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en).  However, in actual files and devices the end
of a line may be represented differently on different platforms, or
even for different devices on the same platform.  For example, under
UNIX newlines are used in files, whereas carriage-return-linefeed
sequences are normally used in network connections.  On input (i.e.,
232
233
234
235
236
237
238
239

240
241
242
243
244
245
246
213
214
215
216
217
218
219

220
221
222
223
224
225
226
227







-
+







are translated to a newline.  As the output translation mode,
\fBauto\fR chooses a platform specific representation; for sockets on
all platforms Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses
\fBlf\fR, and for the various flavors of Windows it chooses
\fBcrlf\fR.  The default setting for \fB\-translation\fR is \fBauto\fR
for both input and output.
.TP
\fBbinary\fR
\fBbinary\fR 
.
No end-of-line translations are performed.  This is nearly identical
to \fBlf\fR mode, except that in addition \fBbinary\fR mode also sets
the end-of-file character to the empty string (which disables it) and
sets the encoding to \fBbinary\fR (which disables encoding filtering).
See the description of \fB\-eofchar\fR and \fB\-encoding\fR for more
information.
279
280
281
282
283
284
285
286

287
288
289
290
291
292
293





294
295
296
297
298
299
300
260
261
262
263
264
265
266

267







268
269
270
271
272
273
274
275
276
277
278
279







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







been opened for writing. The \fBchan copy\fR command leverages the
buffering in the Tcl I/O system to avoid extra copies and to avoid
buffering too much data in main memory when copying large files to
slow destinations like network sockets.
.RS
.PP
The \fBchan copy\fR command transfers data from \fIinputChan\fR until
end of file or \fIsize\fR bytes or characters have been transferred;
end of file or \fIsize\fR bytes have been transferred. If no
\fIsize\fR is in bytes if the two channels are using the same encoding,
and is in characters otherwise.  If no \fB\-size\fR argument is given,
then the copy goes until end of file. All the data read from
\fIinputChan\fR is copied to \fIoutputChan\fR.  Without the
\fB\-command\fR option, \fBchan copy\fR blocks until the copy is
complete and returns the number of bytes or characters (using the same
rules as for the \fB\-size\fR option) written to \fIoutputChan\fR.
\fB\-size\fR argument is given, then the copy goes until end of file.
All the data read from \fIinputChan\fR is copied to \fIoutputChan\fR.
Without the \fB\-command\fR option, \fBchan copy\fR blocks until the
copy is complete and returns the number of bytes written to
\fIoutputChan\fR.
.PP
The \fB\-command\fR argument makes \fBchan copy\fR work in the
background.  In this case it returns immediately and the
\fIcallback\fR is invoked later when the copy completes.  The
\fIcallback\fR is called with one or two additional arguments that
indicates how many bytes were written to \fIoutputChan\fR.  If an
error occurred during the background copy, the second argument is the
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
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







-
+


















-
+







.TP
\fBchan create \fImode cmdPrefix\fR
.
This subcommand creates a new script level channel using the command
prefix \fIcmdPrefix\fR as its handler. Any such channel is called a
\fBreflected\fR channel. The specified command prefix, \fBcmdPrefix\fR,
must be a non-empty list, and should provide the API described in the
\fBrefchan\fR manual page. The handle of the new channel is
\fBreflectedchan\fR manual page. The handle of the new channel is
returned as the result of the \fBchan create\fR command, and the
channel is open. Use either \fBclose\fR or \fBchan close\fR to remove
the channel.
.RS
.PP
The argument \fImode\fR specifies if the new channel is opened for
reading, writing, or both. It has to be a list containing any of the
strings
.QW \fBread\fR
or
.QW \fBwrite\fR .
The list must have at least one
element, as a channel you can neither write to nor read from makes no
sense. The handler command for the new channel must support the chosen
mode, or an error is thrown.
.PP
The command prefix is executed in the global namespace, at the top of
call stack, following the appending of arguments as described in the
\fBrefchan\fR manual page. Command resolution happens at the
\fBreflectedchan\fR manual page. Command resolution happens at the
time of the call. Renaming the command, or destroying it means that
the next call of a handler method may fail, causing the channel
command invoking the handler to fail as well. Depending on the
subcommand being invoked, the error message may not be able to explain
the reason for that failure.
.PP
Every channel created with this subcommand knows which interpreter it
393
394
395
396
397
398
399
400

401
402
403
404
405
406
407
372
373
374
375
376
377
378

379
380
381
382
383
384
385
386







-
+







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
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
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
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







-
+














-
+




-
+



















-
+







.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
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
non-blocking mode with the \fBchan configure\fR command.  In blocking
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 non-blocking mode \fBchan puts\fR, \fBchan read\fR, and \fBchan
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 non-blocking mode, the command may return before all
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?
.
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
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







-
+













-
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







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
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
\fBstring match\fR) will be returned.
.TP
\fBchan pending \fImode channelId\fR
.
Depending on whether \fImode\fR is \fBinput\fR or \fBoutput\fR,
returns the number of
bytes of input or output (respectively) currently buffered
internally for \fIchannelId\fR (especially useful in a readable event
bytes of input or output (respectively) currently buffered 
internally for \fIchannelId\fR (especially useful in a readable event 
callback to impose application-specific limits on input line lengths to avoid
a potential denial-of-service attack where a hostile user crafts
an extremely long line that exceeds the available memory to buffer it).
Returns -1 if the channel was not opened for the mode in question.
.TP
\fBchan pipe\fR
Creates a standalone pipe whose read- and write-side channels are
returned as a 2-element list, the first element being the read side and
the second the write side. Can be useful e.g. to redirect
separately \fBstderr\fR and \fBstdout\fR from a subprocess. To do
this, spawn with "2>@" or
">@" redirection operators onto the write side of a pipe, and then
immediately close it in the parent. This is necessary to get an EOF on
the read side once the child has exited or otherwise closed its output.
.RS
.PP
Note that the pipe buffering semantics can vary at the operating system level
substantially; it is not safe to assume that a write performed on the output
side of the pipe will appear instantly to the input side. This is a
fundamental difference and Tcl cannot conceal it. The overall stream semantics
\fIare\fR compatible, so blocking reads and writes will not see most of the
differences, but the details of what exactly gets written when are not. This
is most likely to show up when using pipelines for testing; care should be
taken to ensure that deadlocks do not occur and that potential short reads are
allowed for.
.RE
.TP
\fBchan pop \fIchannelId\fR
Removes the topmost transformation from the channel \fIchannelId\fR, if there
is any. If there are no transformations added to \fIchannelId\fR, this is
equivalent to \fBchan close\fR of that channel. The result is normally the
empty string, but can be an error in some situations (i.e. where the
underlying system stream is closed and that results in an error).
.TP
\fBchan postevent \fIchannelId eventSpec\fR
.
This subcommand is used by command handlers specified with \fBchan
create\fR. It notifies the channel represented by the handle
\fIchannelId\fR that the event(s) listed in the \fIeventSpec\fR have
occurred. The argument has to be a list containing any of the strings
\fBread\fR and \fBwrite\fR. The list must contain at least one
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
618
619
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







-
+










-
-
-
-
-
-
-
-
-
-







to a reflected channel from an interpreter that does not contain it's
implementation is not allowed. Attempting to post an event from any
other interpreter will cause this subcommand to report an error.
.PP
Another restriction is that it is not possible to post events that the
I/O core has not registered an interest in. Trying to do so will cause
the method to throw an error. See the command handler method
\fBwatch\fR described in \fBrefchan\fR, the document specifying
\fBwatch\fR described in \fBreflectedchan\fR, the document specifying
the API of command handlers for reflected channels.
.PP
This command is \fBsafe\fR and made accessible to safe interpreters.
It can trigger the execution of \fBchan event\fR handlers, whether in the
current interpreter or in other interpreters or other threads, even
where the event is posted from a safe interpreter and listened for by
a trusted interpreter. \fBChan event\fR handlers are \fIalways\fR
executed in the interpreter that set them up.
.RE
.TP
\fBchan push \fIchannelId cmdPrefix\fR
Adds a new transformation on top of the channel \fIchannelId\fR. The
\fIcmdPrefix\fR argument describes a list of one or more words which represent
a handler that will be used to implement the transformation. The command
prefix must provide the API described in the \fBtranschan\fR manual page.
The result of this subcommand is a handle to the transformation. Note that it
is important to make sure that the transformation is capable of supporting the
channel mode that it is used with or this can make the channel neither
readable nor writable.
.TP
\fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR
.
Writes \fIstring\fR to the channel named \fIchannelId\fR followed by a
newline character. A trailing newline character is written unless the
optional flag \fB\-nonewline\fR is given. If \fIchannelId\fR is
omitted, the string is written to the standard output channel,
\fBstdout\fR.
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
686
687
688
689
690
691
692
693
694
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
618
619
620
621

622

623
624
625

626
627
628
629
630
631
632







-
+




-
+


-
-
+
+



















-
+















-
+
-



-







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
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 non-blocking output to work; otherwise Tcl never
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 non-blocking mode, which could consume a large amount of
memory.  To avoid wasting memory, non-blocking I/O should normally be
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 non-blocking mode, \fBchan read\fR may not
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 non-blocking, like this:
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
get a \fBreadable\fR event for each character read from them. Care
must be taken when using \fBchan read\fR on blocking serial ports:
.TP
\fBchan read \fIchannelId numChars\fR
.
728
729
730
731
732
733
734
735

736
737
738
739
740
741
742
666
667
668
669
670
671
672

673
674
675
676
677
678
679
680







-
+







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
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.
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
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










-
-
+
-











-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+


-
-
-
.TP
\fBchan truncate \fIchannelId\fR ?\fIlength\fR?
.
Sets the byte length of the underlying data stream for the channel
named \fIchannelId\fR to be \fIlength\fR (or to the current byte
offset within the underlying data stream if \fIlength\fR is
omitted). The channel is flushed before truncation.
.
.SH EXAMPLES
.SH EXAMPLE
.PP
This opens a file using a known encoding (CP1252, a very common encoding
on Windows), searches for a string, rewrites that part, and truncates the
file after a further two lines.
.PP
.CS
set f [open somefile.txt r+]
\fBchan configure\fR $f -encoding cp1252
set offset 0

\fI# Search for string "FOOBAR" in the file\fR
while {[\fBchan gets\fR $f line] >= 0} {
    set idx [string first FOOBAR $line]
    if {$idx >= 0} {
        \fI# Found it; rewrite line\fR
   set idx [string first FOOBAR $line]
   if {$idx > -1} {
      \fI# Found it; rewrite line\fR

        \fBchan seek\fR $f [expr {$offset + $idx}]
        \fBchan puts\fR -nonewline $f BARFOO
      \fBchan seek\fR $f [expr {$offset + $idx}]
      \fBchan puts\fR -nonewline $f BARFOO

        \fI# Skip to end of following line, and truncate\fR
        \fBchan gets\fR $f
        \fBchan gets\fR $f
        \fBchan truncate\fR $f
      \fI# Skip to end of following line, and truncate\fR
      \fBchan gets\fR $f
      \fBchan gets\fR $f
      \fBchan truncate\fR $f

        \fI# Stop searching the file now\fR
        break
    }
      \fI# Stop searching the file now\fR
      break
   }

    \fI# Save offset of start of next line for later\fR
    set offset [\fBchan tell\fR $f]
   \fI# Save offset of start of next line for later\fR
   set offset [\fBchan tell\fR $f]
}
\fBchan close\fR $f
.CE
.PP
A network server that does echoing of its input line-by-line without
preventing servicing of other connections at the same time.
.PP
.CS
# This is a very simple logger...
proc log {message} {
    \fBchan puts\fR stdout $message
}

# This is called whenever a new client connects to the server
proc connect {chan host port} {
    set clientName [format <%s:%d> $host $port]
    log "connection from $clientName"
    \fBchan configure\fR $chan -blocking 0 -buffering line
    \fBchan event\fR $chan readable [list echoLine $chan $clientName]
}

# This is called whenever either at least one byte of input
# data is available, or the channel was closed by the client.
proc echoLine {chan clientName} {
    \fBchan gets\fR $chan line
    if {[\fBchan eof\fR $chan]} {
        log "finishing connection from $clientName"
        \fBchan close\fR $chan
    } elseif {![\fBchan blocked\fR $chan]} {
        # Didn't block waiting for end-of-line
        log "$clientName - $line"
        \fBchan puts\fR $chan $line
    }
}

# Create the server socket and enter the event-loop to wait
# for incoming connections...
socket -server connect 12345
vwait forever
.CE
.SH "SEE ALSO"
close(n), eof(n), fblocked(n), fconfigure(n), fcopy(n), file(n),
fileevent(n), flush(n), gets(n), open(n), puts(n), read(n), seek(n),
socket(n), tell(n), refchan(n), transchan(n)
socket(n), tell(n), refchan(n)
.SH KEYWORDS
channel, input, output, events, offset
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/class.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
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








































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH class n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::class \- class of all classes
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::class\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
.fi
.BE
.SH DESCRIPTION
.PP
Classes are objects that can manufacture other objects according to a pattern
stored in the factory object (the class). An instance of the class is created
by calling one of the class's factory methods, typically either \fBcreate\fR
if an explicit name is being given, or \fBnew\fR if an arbitrary unique name
is to be automatically selected.
.PP
The \fBoo::class\fR class is the class of all classes; every class is an
instance of this class, which is consequently an instance of itself. This
class is a subclass of \fBoo::object\fR, so every class is also an object.
Additional metaclasses (i.e., classes of classes) can be defined if necessary
by subclassing \fBoo::class\fR. Note that the \fBoo::class\fR object hides the
\fBnew\fR method on itself, so new classes should always be made using the
\fBcreate\fR method.
.SS CONSTRUCTOR
.PP
The constructor of the \fBoo::class\fR class takes an optional argument which,
if present, is sent to the \fBoo::define\fR command (along with the name of
the newly-created class) to allow the class to be conveniently configured at
creation time.
.SS DESTRUCTOR
The \fBoo::class\fR class does not define an explicit destructor. However,
when a class is destroyed, all its subclasses and instances are also
destroyed, along with all objects that it has been mixed into.
.SS "EXPORTED METHODS"
.TP
\fIcls \fBcreate \fIname \fR?\fIarg ...\fR?
.
This creates a new instance of the class \fIcls\fR called \fIname\fR (which is
resolved within the calling context's namespace if not fully qualified),
passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
a successful result) returning the fully qualified name of the created object
(the result of the constructor is ignored). If the constructor fails (i.e.
returns a non-OK result) then the object is destroyed and the error message is
the result of this method call.
.TP
\fIcls \fBnew \fR?\fIarg ...\fR?
.
This creates a new instance of the class \fIcls\fR with a new unique name,
passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
a successful result) returning the fully qualified name of the created object
(the result of the constructor is ignored). If the constructor fails (i.e.,
returns a non-OK result) then the object is destroyed and the error message is
the result of this method call.
.RS
.PP
Note that this method is not exported by the \fBoo::class\fR object itself, so
classes should not be created using this method.
.RE
.SS "NON-EXPORTED METHODS"
.PP
The \fBoo::class\fR class supports the following non-exported methods:
.TP
\fIcls \fBcreateWithNamespace\fI name nsName\fR ?\fIarg ...\fR?
.
This creates a new instance of the class \fIcls\fR called \fIname\fR (which is
resolved within the calling context's namespace if not fully qualified),
passing the arguments, \fIarg ...\fR, to the constructor, and (if that returns
a successful result) returning the fully qualified name of the created object
(the result of the constructor is ignored). The name of the instance's
internal namespace will be \fInsName\fR unless that namespace already exists
(when an arbitrary name will be chosen instead). If the constructor fails
(i.e., returns a non-OK result) then the object is destroyed and the error
message is the result of this method call.
.SH EXAMPLES
.PP
This example defines a simple class hierarchy and creates a new instance of
it. It then invokes a method of the object before destroying the hierarchy and
showing that the destruction is transitive.
.PP
.CS
\fBoo::class create\fR fruit {
    method eat {} {
        puts "yummy!"
    }
}
\fBoo::class create\fR banana {
    superclass fruit
    constructor {} {
        my variable peeled
        set peeled 0
    }
    method peel {} {
        my variable peeled
        set peeled 1
        puts "skin now off"
    }
    method edible? {} {
        my variable peeled
        return $peeled
    }
    method eat {} {
        if {![my edible?]} {
            my peel
        }
        next
    }
}
set b [banana \fBnew\fR]
$b eat               \fI\(-> prints "skin now off" and "yummy!"\fR
fruit destroy
$b eat               \fI\(-> error "unknown command"\fR
.CE
.SH "SEE ALSO"
oo::define(n), oo::object(n)
.SH KEYWORDS
class, metaclass, object
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Deleted doc/classvariable.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
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














































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH classvariable n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
classvariable \- create link from local variable to variable in class
.SH SYNOPSIS
.nf
package require TclOO

\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBclassvariable\fR command is available within methods. It takes a series
of one or more variable names and makes them available in the method's scope;
those variable names must not be qualified and must not refer to array
elements. The originating scope for the variables is the namespace of the
class that the method was defined by. In other words, the referenced variables
are shared between all instances of that class.
.PP
Note: This command is equivalent to the command \fBtypevariable\fR provided by
the snit package in tcllib for approximately the same purpose. If used in a
method defined directly on a class instance (e.g., through the
\fBoo::objdefine\fR \fBmethod\fR definition) this is very much like just
using:
.PP
.CS
namespace upvar [namespace current] $var $var
.CE
.PP
for each variable listed to \fBclassvariable\fR.
.SH EXAMPLE
This class counts how many instances of it have been made.
.PP
.CS
oo::class create Counted {
    initialise {
        variable count 0
    }

    variable number
    constructor {} {
        \fBclassvariable\fR count
        set number [incr count]
    }

    method report {} {
        \fBclassvariable\fR count
        puts "This is instance $number of $count"
    }
}

set a [Counted new]
set b [Counted new]
$a report
        \fI\(-> This is instance 1 of 2\fR
set c [Counted new]
$b report
        \fI\(-> This is instance 2 of 3\fR
$c report
        \fI\(-> This is instance 3 of 3\fR
.CE
.SH "SEE ALSO"
global(n), namespace(n), oo::class(n), oo::define(n), upvar(n), variable(n)
.SH KEYWORDS
class, class variable, variable
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/clock.n.

38
39
40
41
42
43
44
45

46
47
48
49
50

51
52
53
54
55
56
57
38
39
40
41
42
43
44

45
46
47
48
49

50
51
52
53
54
55
56
57







-
+




-
+







\fBclock clicks\fR ?\fI\-option\fR?
If no \fI\-option\fR argument is supplied, returns a high-resolution
time value as a system-dependent integer value.  The unit of the value
is system-dependent but should be the highest resolution clock available
on the system such as a CPU cycle counter.  See \fBHIGH RESOLUTION TIMERS\fR for a full description.
.RS
.PP
If the \fI\-option\fR argument is \fB\-milliseconds\fR, then the command
If the \fI\-option\fR argument is \fI\-milliseconds\fR, then the command
is synonymous with \fBclock milliseconds\fR (see below).  This
usage is obsolete, and \fBclock milliseconds\fR is to be
considered the preferred way of obtaining a count of milliseconds.
.PP
If the \fI\-option\fR argument is \fB\-microseconds\fR, then the command
If the \fI\-option\fR argument is \fI\-microseconds\fR, then the command
is synonymous with \fBclock microseconds\fR (see below).  This
usage is obsolete, and \fBclock microseconds\fR is to be
considered the preferred way of obtaining a count of microseconds.
.RE
.TP
\fBclock format\fR \fItimeVal\fR ?\fI\-option value\fR...?
Formats a time that is expressed as an integer number of seconds into a format
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
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







-
-
-
+
+
+
+


















-




-
+







exactly 86400 seconds.  Tcl responds to leap seconds by speeding or
slowing its clock by a tiny fraction for some minutes until it is
back in sync with UTC; its data model does not represent minutes that
have 59 or 61 seconds.
.TP
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.
Used in conjunction with \fIcount\fR to identify an interval of time,
for example, \fI3 seconds\fR or \fI1 year\fR.
\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
any unique prefix of such a word. Used in conjunction with \fIcount\fR
to identify an interval of time, for example, \fI3 seconds\fR or
\fI1 year\fR.
.SS "OPTIONS"
.TP
\fB\-base\fR time
Specifies that any relative times present in a \fBclock scan\fR command
are to be given relative to \fItime\fR.  \fItime\fR must be expressed as
a count of nominal seconds from the epoch time of 1 January 1970, 00:00 UTC.
.TP
\fB\-format\fR format
Specifies the desired output format for \fBclock format\fR or the
expected input format for \fBclock scan\fR.  The \fIformat\fR string consists
of any number of characters other than the per-cent sign
.PQ \fB%\fR
interspersed with any number of \fIformat groups\fR, which are two-character
sequences beginning with the per-cent sign.  The permissible format groups,
and their interpretation, are described under \fBFORMAT GROUPS\fR.
.RS
.PP
On \fBclock format\fR, the default format is
.PP
.CS
%a %b %d %H:%M:%S %Z %Y
.CE
.PP
On \fBclock scan\fR, the lack of a \fB\-format\fR option indicates that a
On \fBclock scan\fR, the lack of a \fI\-format\fR option indicates that a
.QW "free format scan"
is requested; see \fBFREE FORM SCAN\fR for a description of what happens.
.RE
.TP
\fB\-gmt\fR boolean
If \fIboolean\fR is true, specifies that a time specified to \fBclock add\fR,
\fBclock format\fR or \fBclock scan\fR should be processed in
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
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







-






-






-
+
+







.IP [1]
the environment variable \fBTCL_TZ\fR.
.IP [2]
the environment variable \fBTZ\fR.
.IP [3]
on Windows systems, the time zone settings from the Control Panel.
.RE
.PP
If none of these is present, the C \fBlocaltime\fR and \fBmktime\fR
functions are used to attempt to convert times between local and
Greenwich.  On 32-bit systems, this approach is likely to have bugs,
particularly for times that lie outside the window (approximately the
years 1902 to 2037) that can be represented in a 32-bit integer.
.SH "CLOCK ARITHMETIC"
.PP
The \fBclock add\fR command performs clock arithmetic on a value
(expressed as nominal seconds from the epoch time of 1 January 1970, 00:00 UTC)
given as its first argument.  The remaining arguments (other than the
possible \fB\-timezone\fR, \fB\-locale\fR and \fB\-gmt\fR options)
are integers and keywords in alternation, where the keywords are chosen
from \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
\fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.
\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
any unique prefix of such a word.
.PP
Addition of seconds, minutes and hours is fairly straightforward;
the given time increment (times sixty for minutes, or 3600 for hours)
is simply added to the \fItimeVal\fR given
to the \fBclock add\fR command.  The result is interpreted as
a nominal number of seconds from the Epoch.
.PP
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
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







-














-
+
-





-















-












-







is back in step with the world.
.PP
The fact that adding and subtracting hours is defined in terms of
absolute time means that it will add fixed amounts of time in time zones
that observe summer time (Daylight Saving Time).  For example,
the following code sets the value of \fBx\fR to \fB04:00:00\fR because
the clock has changed in the interval in question.
.PP
.CS
set s [\fBclock scan\fR {2004-10-30 05:00:00} \e
           -format {%Y-%m-%d %H:%M:%S} \e
           -timezone :America/New_York]
set a [\fBclock add\fR $s 24 hours -timezone :America/New_York]
set x [\fBclock format\fR $a \e
           -format {%H:%M:%S} -timezone :America/New_York]
.CE
.PP
Adding and subtracting days and weeks is accomplished by converting
the given time to a calendar day and time of day in the appropriate
time zone and locale.  The requisite number of days (weeks are converted
to days by multiplying by seven) is added to the calendar day, and
the date and time are then converted back to a count of seconds from
the epoch time.  The \fBweekdays\fR keyword is similar to \fBdays\fR,
the epoch time.
with the only difference that weekends - Saturdays and Sundays - are skipped.
.PP
Adding and subtracting a given number of days across the point that
the time changes at the start or end of summer time (Daylight Saving Time)
results in the \fIsame local time\fR on the day in question.  For
instance, the following code sets the value of \fBx\fR to \fB05:00:00\fR.
.PP
.CS
set s [\fBclock scan\fR {2004-10-30 05:00:00} \e
           -format {%Y-%m-%d %H:%M:%S} \e
           -timezone :America/New_York]
set a [\fBclock add\fR $s 1 day -timezone :America/New_York]
set x [\fBclock format\fR $a \e
           -format {%H:%M:%S} -timezone :America/New_York]
.CE
.PP
In cases of ambiguity, where the same local time happens twice
on the same day, the earlier time is used.  In cases where the conversion
yields an impossible time (for instance, 02:30 during the Spring
Daylight Saving Time change using US rules), the time is converted
as if the clock had not changed.  Thus, the following code
will set the value of \fBx\fR to \fB03:30:00\fR.
.PP
.CS
set s [\fBclock scan\fR {2004-04-03 02:30:00} \e
           -format {%Y-%m-%d %H:%M:%S} \e
           -timezone :America/New_York]
set a [\fBclock add\fR $s 1 day -timezone :America/New_York]
set x [\fBclock format\fR $a \e
           -format {%H:%M:%S} -timezone :America/New_York]
.CE
.PP
Adding a given number of days or weeks works correctly across the conversion
between the Julian and Gregorian calendars; the omitted days are skipped.
The following code sets \fBz\fR to \fB1752-09-14\fR.
.PP
.CS
set x [\fBclock scan\fR 1752-09-02 -format %Y-%m-%d -locale en_US]
set y [\fBclock add\fR $x 1 day -locale en_US]
set z [\fBclock format\fR $y -format %Y-%m-%d -locale en_US]
.CE
.PP
In the bizarre case that adding the given number of days yields a date
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
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







-














-







The rules for handling anomalies relating to summer time and to the
Gregorian calendar are the same when adding/subtracting months and
years as they are when adding/subtracting days and weeks.
.PP
If multiple \fIcount unit\fR pairs are present on the command, they
are evaluated consecutively, from left to right.
.SH "HIGH RESOLUTION TIMERS"
.PP
Most of the subcommands supported by the \fBclock\fR command deal with
times represented as a count of seconds from the epoch time, and this is the
representation that \fBclock seconds\fR returns.  There are three exceptions,
which are all intended for use where higher-resolution times are required.
\fBclock milliseconds\fR returns the count of milliseconds from the
epoch time, and \fBclock microseconds\fR returns the count of microseconds
from the epoch time. In addition, there is a \fBclock clicks\fR command
that returns a platform-dependent high-resolution timer.  Unlike
\fBclock seconds\fR and \fBclock milliseconds\fR, the value
of \fBclock clicks\fR is not guaranteed to be tied to any fixed
epoch; it is simply intended to be the most precise interval timer
available, and is intended only for relative timing studies such as
benchmarks.
.SH "FORMATTING TIMES"
.PP
The \fBclock format\fR command produces times for display to a user
or writing to an external medium.  The command accepts times that are
expressed in seconds from the epoch time of 1 January 1970, 00:00 UTC,
as returned by \fBclock seconds\fR, \fBclock scan\fR, \fBclock add\fR,
\fBfile atime\fR or \fBfile mtime\fR.
.PP
If a \fB\-format\fR option is present, the following argument is
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
318
319
320
321
322
323
324

325
326
327
328
329
330
331







-







reflects the user's current choices.  For instance, on Windows, the
format that the user has selected from dates and times in the Control
Panel can be obtained by using the \fBsystem\fR locale.  On
platforms that do not define a user selection of date and time formats
separate from \fBLC_TIME\fR, \fB\-locale\fR \fBsystem\fR is
synonymous with \fB\-locale\fR \fBcurrent\fR.
.SH "SCANNING TIMES"
.PP
The \fBclock scan\fR command accepts times that are formatted as
strings and converts them to counts of seconds from the epoch time
of 1 January 1970, 00:00 UTC.  It normally takes a \fB\-format\fR
option that is followed by a string describing
the expected format of the input.  (See
\fBFREE FORM SCAN\fR for the effect of \fBclock scan\fR
without such an argument.)  The string consists of any number of
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
439
440
441
442
443
444
445













446

447
448
449
450
451
452
453







-
-
-
-
-
-
-
-
-
-
-
-
-

-







If a format string lacks a \fB%z\fR or \fB%Z\fR format group,
it is possible for the time to be ambiguous because it appears twice
in the same day, once without and once with Daylight Saving Time.
If this situation occurs, the first occurrence of the time is chosen.
(For this reason, it is wise to have the input string contain the
time zone when converting local times.  This caveat does not apply to
UTC times.)
.PP
If the interpretation of the groups yields an impossible time because
a field is out of range, enough of that field's unit will be added to
or subtracted from the time to bring it in range. Thus, if attempting to
scan or format day 0 of the month, one day will be subtracted from day
1 of the month, yielding the last day of the previous month.
.PP
If the interpretation of the groups yields an impossible time because
a Daylight Saving Time change skips over that time, or an ambiguous
time because a Daylight Saving Time change skips back so that the clock
observes the given time twice, and no time zone specifier (\fB%z\fR
or \fB%Z\fR) is present in the format, the time is interpreted as
if the clock had not changed.
.SH "FORMAT GROUPS"
.PP
The following format groups are recognized by the \fBclock scan\fR and
\fBclock format\fR commands.
.TP
\fB%a\fR
On output, produces an abbreviation (\fIe.g.,\fR \fBMon\fR) for the day
of the week in the given locale.  On input, matches the name of the day
of the week in the given locale (in either abbreviated or full form, or
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
730
731
732
733
734
735
736

737
738
739
740
741
742
743







-







.QW \fB%\fR
character.
.TP
\fB%+\fR
Synonymous with
.QW "\fB%a %b %e %H:%M:%S %Z %Y\fR" .
.SH "TIME ZONES"
.PP
When the \fBclock\fR command is processing a local time, it has several
possible sources for the time zone to use.  In order of preference, they
are:
.IP [1]
A time zone specified inside a string being parsed and matched by a \fB%z\fR
or \fB%Z\fR format group.
.IP [2]
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
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







-











-







The local time zone from the Control Panel on Windows systems.
.IP [6]
The C library's idea of the local time zone, as defined by the
\fBmktime\fR and \fBlocaltime\fR functions.
.PP
In case [1] \fIonly,\fR the string is tested to see if it is one
of the strings:
.PP
.CS
 gmt     ut      utc     bst     wet     wat     at
 nft     nst     ndt     ast     adt     est     edt
 cst     cdt     mst     mdt     pst     pdt     yst
 ydt     hst     hdt     cat     ahst    nt      idlw
 cet     cest    met     mewt    mest    swt     sst
 eet     eest    bt      it      zp4     zp5     ist
 zp6     wast    wadt    jt      cct     jst     cast
 cadt    east    eadt    gst     nzt     nzst    nzdt
 idle
.CE
.PP
If it is a string in the above list, it designates a known
time zone, and is interpreted as such.
.PP
For time zones in case [1] that do not match any of the above strings,
and always for cases [2]-[6], the following rules apply.
.PP
If the time zone begins with a colon, it is one of a
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
795
796
797
798
799
800
801

















802
803
804

805
806
807
808

809
810
811
812
813
814
815







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-




-







the minus sign one west of Greenwich.
.PP
A time zone string conforming to the Posix specification of the \fBTZ\fR
environment variable will be recognized.  The specification
may be found at
\fIhttp://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html\fR.
.PP
If the Posix time zone string contains a DST (Daylight Savings Time)
part, but doesn't contain a rule stating when DST starts or ends,
then default rules are used. For Timezones with an offset between 0
and +12, the current European/Russian rules are used, otherwise the
current US rules are used. In Europe (offset +0 to +2) the switch
to summertime is done each last Sunday in March at 1:00 GMT, and
the switch back is each last Sunday in October at 2:00 GMT. In
Russia (offset +3 to +12), the switch dates are the same, only
the switch to summertime is at 2:00 local time, and the switch
back is at 3:00 local time in all time zones. The US switch to
summertime takes place each second Sunday in March at 2:00 local
time, and the switch back is each first Sunday in November at
3:00 local time. These default rules mean that in all European,
Russian and US (or compatible) time zones, DST calculations will
be correct for dates in 2007 and later, unless in the future the
rules change again.
.PP
Any other time zone string is processed by prefixing a colon and attempting
to use it as a location name, as above.
.SH "LOCALIZATION"
.PP
Developers wishing to localize the date and time formatting and parsing
are referred to \fIhttp://tip.tcl.tk/173\fR for a
specification.
.SH "FREE FORM SCAN"
.PP
If the \fBclock scan\fR command is invoked without a \fB\-format\fR
option, then it requests a \fIfree-form scan.\fR  \fI
This form of scan is deprecated.\fR  The reason for the deprecation
is that there are too many ambiguities. (Does the string
.QW 2000
represent a year, a time of day, or a quantity?)  No set of rules
for interpreting free-form dates and times has been found to
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
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







-
-
+
-
-
-
-
+
+



-


-
-
-
-
-
+
+
+
+
+

-
+






-

-
+



-

-
-
+
+


-
+


-







time.  This is useful for determining the time on a specific day or
doing other date-relative conversions.
.PP
The \fIinputString\fR argument consists of zero or more specifications of the
following form:
.TP
\fItime\fR
.
A time of day, which is of the form:
A time of day, which is of the form: \fBhh?:mm?:ss?? ?meridian? ?zone?\fR
.QW "\fIhh\fR?\fB:\fImm\fR?\fB:\fIss\fR?? ?\fImeridian\fR? ?\fIzone\fR?"
or
.QW "\fBhhmm \fR?\fBmeridian\fR? ?\fBzone\fR?" .
If no \fImeridian\fR is specified, \fIhh\fR is interpreted on
or \fBhhmm ?meridian? ?zone?\fR
If no meridian is specified, \fBhh\fR is interpreted on
a 24-hour clock.
.TP
\fIdate\fR
.
A specific month and day with optional year.  The
acceptable formats are
.QW "\fImm\fB/\fIdd\fR?\fB/\fIyy\fR?" ,
.QW "\fImonthname dd\fR?\fB, \fIyy\fR?" ,
.QW "\fIday\fB, \fIdd monthname \fR?\fIyy\fR?" ,
.QW "\fIdd monthname yy\fR" ,
.QW "?\fICC\fR?\fIyymmdd\fR" ,
.QW "\fBmm/dd\fR?\fB/yy\fR?" ,
.QW "\fBmonthname dd\fR?\fB, yy\fR?" ,
.QW "\fBday, dd monthname \fR?\fByy\fR?" ,
.QW "\fBdd monthname yy\fR" ,
.QW "?\fBCC\fR?\fByymmdd\fR" ,
and
.QW "\fIdd\fB-\fImonthname\fB-\fR?\fICC\fR?\fIyy\fR" .
.QW "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR" .
The default year is the current year.  If the year is less
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999.  Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.TP
\fIISO 8601 point-in-time\fR
.
An ISO 8601 point-in-time specification, such as
.QW "\fICCyymmdd\fBT\fIhhmmss\fR",
.QW \fICCyymmdd\fBT\fIhhmmss\fR,
where \fBT\fR is the literal
.QW T ,
.QW "\fICCyymmdd hhmmss\fR" ,
.QW "\fICCyymmdd\fBT\fIhh:mm:ss\fR" ,
or
.QW "\fICCyy-mm-dd\fBT\fIhh\fB:\fImm\fB:\fIss\fR".
Note that only these four formats are accepted.
.QW \fICCyymmdd\fBT\fIhh:mm:ss\fR .
Note that only these three formats are accepted.
The command does \fInot\fR accept the full range of point-in-time
specifications specified in ISO8601.  Other formats can be recognized by
giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
giving an explicit \fI\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
.
A specification relative to the current time.  The format is \fBnumber
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
\fBhour\fR, \fBminute\fR (or \fBmin\fR), and \fBsecond\fR (or \fBsec\fR).  The
unit can be specified as a singular or plural, as in \fB3 weeks\fR.
These modifiers may also be specified:
\fBtomorrow\fR, \fByesterday\fR, \fBtoday\fR, \fBnow\fR,
948
949
950
951
952
953
954
955
956
957
896
897
898
899
900
901
902










-
-
-
of a long month to a short month.
.SH "SEE ALSO"
msgcat(n)
.SH KEYWORDS
clock, date, time
.SH "COPYRIGHT"
Copyright (c) 2004 Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/close.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
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






-
+







-
+

+


-
+






-
-
-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH close n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
close \- Close an open channel
.SH SYNOPSIS
\fBclose \fIchannelId\fR ?r(ead)|w(rite)?
\fBclose \fIchannelId\fR
.BE

.SH DESCRIPTION
.PP
Closes or half-closes the channel given by \fIchannelId\fR.
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,
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
channel remains open and the command
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
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











-
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-



-











+


+

-
+
-
-
-
-
other effect until all of the sharing interpreters have closed the
channel.
When the last interpreter in which the channel is registered invokes
\fBclose\fR, the cleanup actions described above occur. See the
\fBinterp\fR command for a description of channel sharing.
.PP
Channels are automatically closed when an interpreter is destroyed and
when the process exits.
From 8.6 on (TIP#398), nonblocking channels are no longer switched to blocking mode when exiting; this guarantees a timely exit even when the peer or a communication channel is stalled. To ensure proper flushing of stalled nonblocking channels on exit, one must now either (a) actively switch them back to blocking or (b) use the environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT,  which when set and not equal to "0" restores the previous behavior.
when the process exits.  Channels are switched to blocking mode, to ensure
that all output is correctly flushed before the process exits.
.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
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.
.SH EXAMPLE
.PP
This illustrates how you can use Tcl to ensure that files get closed
even when errors happen by combining \fBcatch\fR, \fBclose\fR and
\fBreturn\fR:
.PP
.CS
proc withOpenFile {filename channelVar script} {
    upvar 1 $channelVar chan
    set chan [open $filename]
    catch {
        uplevel 1 $script
    } result options
    \fBclose\fR $chan
    return -options $options $result
}
.CE

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

.SH KEYWORDS
blocking, channel, close, nonblocking, half-close
blocking, channel, close, nonblocking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/concat.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
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






-
+









+



-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH concat n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
concat \- Join lists together
.SH SYNOPSIS
\fBconcat\fI \fR?\fIarg arg ...\fR?
.BE

.SH DESCRIPTION
.PP
This command joins each of its arguments together with spaces after
trimming leading and trailing white-space from each of them.  If all of the
trimming leading and trailing white-space from each of them.  If all the
arguments are lists, this has the same effect as concatenating them
into a single list.
Arguments that are empty (after trimming) are ignored entirely.
It permits any number of arguments;
if no \fIarg\fRs are supplied, the result is an empty string.
.SH EXAMPLES
Although \fBconcat\fR will concatenate lists, flattening them in the process
49
50
51
52
53
54
55
56

57
58
59
50
51
52
53
54
55
56

57










-
+
-
-
-
.CE
.PP
(i.e., there are three spaces between each of the \fBa\fR, the \fBb\fR and the
\fBc\fR).
.SH "SEE ALSO"
append(n), eval(n), join(n)
.SH KEYWORDS
concatenate, join, list
concatenate, join, lists
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/continue.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
44
45
46
47
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









-
+









+




-
-
+
+



-
+



-

-


-
-
-
-
+
+
+
+


+


+


-
-
-
'\"
'\" Copyright (c) 1993-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH continue n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
continue \- Skip to the next iteration of a loop
.SH SYNOPSIS
\fBcontinue\fR
.BE

.SH DESCRIPTION
.PP
This command is typically invoked inside the body of a looping command
such as \fBfor\fR or \fBforeach\fR or \fBwhile\fR.
It returns a 4 (\fBTCL_CONTINUE\fR) result code, which causes a continue
exception to occur.
It returns a \fBTCL_CONTINUE\fR code, which causes a continue exception
to occur.
The exception causes the current script to be aborted
out to the innermost containing loop command, which then
continues with the next iteration of the loop.
Continue exceptions are also handled in a few other situations, such
Catch exceptions are also handled in a few other situations, such
as the \fBcatch\fR command and the outermost scripts of procedure
bodies.
.SH EXAMPLE
.PP
Print a line for each of the integers from 0 to 10 \fIexcept\fR 5:
.PP
.CS
for {set x 0} {$x<10} {incr x} {
    if {$x == 5} {
        \fBcontinue\fR
    }
    puts "x is $x"
   if {$x == 5} {
      \fBcontinue\fR
   }
   puts "x is $x"
}
.CE

.SH "SEE ALSO"
break(n), for(n), foreach(n), return(n), while(n)

.SH KEYWORDS
continue, iteration, loop
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/cookiejar.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
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

























































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2014-2018 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "cookiejar" n 0.1 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
cookiejar \- Implementation of the Tcl http package cookie jar protocol
.SH SYNOPSIS
.nf
\fBpackage require\fR \fBcookiejar\fR ?\fB0.1\fR?

\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
\fB::http::cookiejar create\fR \fIname\fR ?\fIfilename\fR?
\fB::http::cookiejar new\fR ?\fIfilename\fR?

\fIcookiejar\fR \fBdestroy\fR
\fIcookiejar\fR \fBforceLoadDomainData\fR
\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
.fi
.SH DESCRIPTION
.PP
The cookiejar package provides an implementation of the http package's cookie
jar protocol using an SQLite database. It provides one main command,
\fB::http::cookiejar\fR, which is a TclOO class that should be instantiated to
create a cookie jar that manages a particular HTTP session.
.PP
The database management policy can be controlled at the package level by the
\fBconfigure\fR method on the \fB::http::cookiejar\fR class object:
.TP
\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
.
If neither \fIoptionName\fR nor \fIoptionValue\fR are supplied, this returns a
copy of the configuration as a Tcl dictionary. If just \fIoptionName\fR is
supplied, just the value of the named option is returned. If both
\fIoptionName\fR and \fIoptionValue\fR are given, the named option is changed
to be the given value.
.RS
.PP
Supported options are:
.TP
\fB\-domainfile \fIfilename\fR
.
A file (defaulting to within the cookiejar package) with a description of the
list of top-level domains (e.g., \fB.com\fR or \fB.co.jp\fR). Such domains
\fImust not\fR accept cookies set upon them. Note that the list of such
domains is both security-sensitive and \fInot\fR constant and should be
periodically refetched. Cookie jars maintain their own cache of the domain
list.
.TP
\fB\-domainlist \fIurl\fR
.
A URL to fetch the list of top-level domains (e.g., \fB.com\fR or
\fB.co.jp\fR) from.  Such domains \fImust not\fR accept cookies set upon
them. Note that the list of such domains is both security-sensitive and
\fInot\fR constant and should be periodically refetched. Cookie jars maintain
their own cache of the domain list.
.TP
\fB\-domainrefresh \fIintervalMilliseconds\fR
.
The number of milliseconds between checks of the \fI\-domainlist\fR for new
domains.
.TP
\fB\-loglevel \fIlevel\fR
.
The logging level of this package. The logging level must be (in order of
decreasing verbosity) one of \fBdebug\fR, \fBinfo\fR, \fBwarn\fR, or
\fBerror\fR.
.TP
\fB\-offline \fIflag\fR
.
Allows the cookie managment engine to be placed into offline mode. In offline
mode, the list of domains is read immediately from the file configured in the
\fB\-domainfile\fR option, and the \fB\-domainlist\fR option is not used; it
also makes the \fB\-domainrefresh\fR option be effectively ignored.
.TP
\fB\-purgeold \fIintervalMilliseconds\fR
.
The number of milliseconds between checks of the database for expired
cookies; expired cookies are deleted.
.TP
\fB\-retain \fIcookieCount\fR
.
The maximum number of cookies to retain in the database.
.TP
\fB\-vacuumtrigger \fIdeletionCount\fR
.
A count of the number of persistent cookie deletions to go between vacuuming
the database.
.RE
.PP
Cookie jar instances may be made with any of the standard TclOO instance
creation methods (\fBcreate\fR or \fBnew\fR).
.TP
\fB::http::cookiejar new\fR ?\fIfilename\fR?
.
If a \fIfilename\fR argument is provided, it is the name of a file containing
an SQLite database that will contain the persistent cookies maintained by the
cookie jar; the database will be created if the file does not already
exist. If \fIfilename\fR is not supplied, the database will be held entirely within
memory, which effectively forces all cookies within it to be session cookies.
.SS "INSTANCE METHODS"
.PP
The following methods are supported on the instances:
.TP
\fIcookiejar\fR \fBdestroy\fR
.
This is the standard TclOO destruction method. It does \fInot\fR delete the
SQLite database if it is written to disk. Callers are responsible for ensuring
that the cookie jar is not in use by the http package at the time of
destruction.
.TP
\fIcookiejar\fR \fBforceLoadDomainData\fR
.
This method causes the cookie jar to immediately load (and cache) the domain
list data. The domain list will be loaded from the \fB\-domainlist\fR
configured a the package level if that is enabled, and otherwise will be
obtained from the \fB\-domainfile\fR configured at the package level.
.TP
\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
.
This method obtains the cookies for a particular HTTP request. \fIThis
implements the http cookie jar protocol.\fR
.TP
\fIcookiejar\fR \fBpolicyAllow\fR \fIoperation domain path\fR
.
This method is called by the \fBstoreCookie\fR method to get a decision on
whether to allow \fIoperation\fR to be performed for the \fIdomain\fR and
\fIpath\fR. This is checked immediately before the database is updated but
after the built-in security checks are done, and should return a boolean
value; if the value is false, the operation is rejected and the database is
not modified. The supported \fIoperation\fRs are:
.RS
.TP
\fBdelete\fR
.
The \fIdomain\fR is seeking to delete a cookie.
.TP
\fBsession\fR
.
The \fIdomain\fR is seeking to create or update a session cookie.
.TP
\fBset\fR
.
The \fIdomain\fR is seeking to create or update a persistent cookie (with a
defined lifetime).
.PP
The default implementation of this method just returns true, but subclasses of
this class may impose their own rules.
.RE
.TP
\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
.
This method stores a single cookie from a particular HTTP response. Cookies
that fail security checks are ignored. \fIThis implements the http cookie jar
protocol.\fR
.TP
\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
.
This method looks a cookie by exact host (or domain) matching. If neither
\fIhost\fR nor \fIkey\fR are supplied, the list of hosts for which a cookie is
stored is returned. If just \fIhost\fR (which may be a hostname or a domain
name) is supplied, the list of cookie keys stored for that host is returned.
If both \fIhost\fR and \fIkey\fR are supplied, the value for that key is
returned; it is an error if no such host or key match exactly.
.SH "EXAMPLES"
.PP
The simplest way of using a cookie jar is to just permanently configure it at
the start of the application.
.PP
.CS
package require http
\fBpackage require cookiejar\fR

set cookiedb ~/.tclcookies.db
http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl.tk/]
.CE
.PP
To only allow a particular domain to use cookies, perhaps because you only
want to enable a particular host to create and manipulate sessions, create a
subclass that imposes that policy.
.PP
.CS
package require http
\fBpackage require cookiejar\fR

oo::class create MyCookieJar {
    superclass \fBhttp::cookiejar\fR

    method \fBpolicyAllow\fR {operation domain path} {
        return [expr {$domain eq "my.example.com"}]
    }
}

set cookiedb ~/.tclcookies.db
http::configure -cookiejar [MyCookieJar new $cookiedb]

# No further explicit steps are required to use cookies
set tok [http::geturl http://core.tcl.tk/]
.CE
.SH "SEE ALSO"
http(n), oo::class(n), sqlite3(n)
.SH KEYWORDS
cookie, internet, security policy, www
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/copy.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
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












































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH copy n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::copy \- create copies of objects and classes
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::copy\fI sourceObject \fR?\fItargetObject\fR? ?\fItargetNamespace\fR?
.fi
.BE
.SH DESCRIPTION
.PP
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
and
.VS TIP473
\fItargetNamespace\fR which is the name of the namespace that will hold the
internal state of the object (\fBmy\fR command, etc.); it \fImust not\fR
refer to an existing namespace.
If either \fItargetObject\fR or \fItargetNamespace\fR is omitted or is given
as the empty string, a new name is chosen. Names, unless specified, are
chosen with the same algorithm used by the \fBnew\fR method of
\fBoo::class\fR.
.VE TIP473
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
oo::objdefine src method msg {} {puts foo}
\fBoo::copy\fR src dst
oo::objdefine src method msg {} {puts bar}
src msg              \fI\(-> prints "bar"\fR
dst msg              \fI\(-> prints "foo"\fR
.CE
.SH "SEE ALSO"
oo::class(n), oo::define(n), oo::object(n)
.SH KEYWORDS
clone, copy, duplication, object
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Deleted 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
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





































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" 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.
'\"
.TH coroutine n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
coroutine, yield, yieldto, coroinject, coroprobe \- Create and produce values from coroutines
.SH SYNOPSIS
.nf
\fBcoroutine \fIname command\fR ?\fIarg...\fR?
\fByield\fR ?\fIvalue\fR?
\fByieldto\fR \fIcommand\fR ?\fIarg...\fR?
\fIname\fR ?\fIvalue...\fR?
.sp
.VS "8.7, TIP383"
\fBcoroinject \fIcoroName command\fR ?\fIarg...\fR?
\fBcoroprobe \fIcoroName command\fR ?\fIarg...\fR?
.VE "8.7, TIP383"
.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
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 yieldMultiple {value} {
    tailcall \fByieldto\fR string cat $value
}
.CE
.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).
.PP
At the point when \fIcommand\fR is called, the current namespace will be the
global namespace and there will be no stack frames above it (in the sense of
\fBupvar\fR and \fBuplevel\fR). However, which command to call will be
determined in the namespace that the \fBcoroutine\fR command was called from.
.PP
.VS "8.7, TIP383"
A suspended coroutine (i.e., one that has \fByield\fRed or \fByieldto\fR-d)
may have its state inspected (or modified) at that point by using
\fBcoroprobe\fR to run a command at the point where the coroutine is at. The
command takes the name of the coroutine to run the command in, \fIcoroName\fR,
and the name of a command (any any arguments it requires) to immediately run
at that point. The result of that command is the result of the \fBcoroprobe\fR
command, and the gross state of the coroutine remains the same afterwards
(i.e., the coroutine is still expecting the results of a \fByield\fR or
\fByieldto\fR as before) though variables may have been changed.
.PP
Similarly, the \fBcoroinject\fR command may be used to place a command to be
run inside a suspended coroutine (when it is resumed) to process arguments,
with quite a bit of similarity to \fBcoroprobe\fR. However, with
\fBcoroinject\fR there are several key differences:
.VE "8.7, TIP383"
.IP \(bu
.VS "8.7, TIP383"
The coroutine is not immediately resumed after the injection has been done.  A
consequence of this is that multiple injections may be done before the
coroutine is resumed. There injected commands are performed in \fIreverse
order of definition\fR (that is, they are internally stored on a stack).
.VE "8.7, TIP383"
.IP \(bu
.VS "8.7, TIP383"
An additional two arguments are appended to the list of arguments to be run
(that is, the \fIcommand\fR and its \fIargs\fR are extended by two elements).
The first is the name of the command that suspended the coroutine (\fByield\fR
or \fByieldto\fR), and the second is the argument (or list of arguments, in
the case of \fByieldto\fR) that is the current resumption value.
.VE "8.7, TIP383"
.IP \(bu
.VS "8.7, TIP383"
The result of the injected command is used as the result of the \fByield\fR or
\fByieldto\fR that caused the coroutine to become suspended. Where there are
multiple injected commands, the result of one becomes the resumption value
processed by the next.
.PP
The injection is a one-off. It is not retained once it has been executed. It
may \fByield\fR or \fByieldto\fR as part of its execution.
.PP
Note that running coroutines may be neither probed nor injected; the
operations may only be applied to
.VE "8.7, TIP383"
.SH EXAMPLES
.PP
This example shows a coroutine that will produce an infinite sequence of
even values, and a loop that consumes the first ten of them.
.PP
.CS
proc allNumbers {} {
    \fByield\fR
    set i 0
    while 1 {
        \fByield\fR $i
        incr i 2
    }
}
\fBcoroutine\fR nextNumber allNumbers
for {set i 0} {$i < 10} {incr i} {
    puts "received [\fInextNumber\fR]"
}
rename nextNumber {}
.CE
.PP
In this example, the coroutine acts to add up the arguments passed to it.
.PP
.CS
\fBcoroutine\fR accumulator apply {{} {
    set x 0
    while 1 {
        incr x [\fByield\fR $x]
    }
}}
for {set i 0} {$i < 10} {incr i} {
    puts "$i -> [\fIaccumulator\fR $i]"
}
.CE
.PP
This example demonstrates the use of coroutines to implement the classic Sieve
of Eratosthenes algorithm for finding prime numbers. Note the creation of
coroutines inside a coroutine.
.PP
.CS
proc filterByFactor {source n} {
    \fByield\fR [info coroutine]
    while 1 {
        set x [\fI$source\fR]
        if {$x % $n} {
            \fByield\fR $x
        }
    }
}
\fBcoroutine\fR allNumbers apply {{} {while 1 {\fByield\fR [incr x]}}}
\fBcoroutine\fR eratosthenes apply {c {
    \fByield\fR
    while 1 {
        set n [\fI$c\fR]
        \fByield\fR $n
        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
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 \fI$target\fR $value] value
    }
}
\fBcoroutine\fR j1 juggler Larry [
    \fBcoroutine\fR j2 juggler Curly [
        \fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!"
.CE
.PP
.VS "8.7, TIP383"
This example shows a simple coroutine that collects non-empty values and
returns a list of them when not given an argument. It also shows how we can
look inside the coroutine to find out what it is doing, and how we can modify
the input on a one-off basis.
.PP
.CS
proc collectorImpl {} {
    set me [info coroutine]
    set accumulator {}
    for {set val [\fByield\fR $me]} {$val ne ""} {set val [\fByield\fR]} {
        lappend accumulator $val
    }
    return $accumulator
}

\fBcoroutine\fR collect collectorImpl
\fIcollect\fR 123
\fIcollect\fR "abc def"
\fIcollect\fR 456

puts [\fBcoroprobe \fIcollect\fR set accumulator]
# ==> 123 {abc def} 456

\fIcollect\fR "pqr"

\fBcoroinject \fIcollect\fR apply {{type value} {
    puts "Received '$value' at a $type in [info coroutine]"
    return [string toupper $value]
}}

\fIcollect\fR rst
# ==> Received 'rst' at a yield in ::collect
\fIcollect\fR xyz

puts [\fIcollect\fR]
# ==> 123 {abc def} 456 pqr RST xyz
.CE
.PP
This example shows a simple coroutine that collects non-empty values and
returns a list of them when not given an argument. It also shows how we can
look inside the coroutine to find out what it is doing.
.VE "8.7, TIP383"
.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} {
    # Where was the caller called from?
    set ns [uplevel 2 {namespace current}]
    \fByield\fR "made $where $level context=$ns name=[info coroutine]"
}
proc example {} {
    report outer [info level]
}
namespace eval demo {
    proc example {} {
        report inner [info level]
    }
    proc makeExample {} {
        puts "making from [info level]"
        puts [\fBcoroutine\fR coroEg example]
    }
    makeExample
}
.CE
.PP
Which produces the output below. In particular, we can see that stack
manipulation has occurred (comparing the levels from the first and second
line) and that the parent level in the coroutine is the global namespace. We
can also see that coroutine names are local to the current namespace if not
qualified, and that coroutines may yield at depth (e.g., in called
procedures).
.PP
.CS
making from 2
made inner 1 context=:: name=::demo::coroEg
.CE
.SH "SEE ALSO"
apply(n), info(n), proc(n), return(n)
.SH KEYWORDS
coroutine, generator
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/dde.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
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






-
-
+
+







-
+



-
+

-
+







'\"
'\" Copyright (c) 1997 Sun Microsystems, Inc.
'\" Copyright (c) 2001 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH dde n 1.4 dde "Tcl Bundled Packages"
'\" 
.TH dde n 1.3 dde "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
dde \- Execute a Dynamic Data Exchange command
.SH SYNOPSIS
.sp
\fBpackage require dde 1.4\fR
\fBpackage require dde 1.3\fR
.sp
\fBdde servername\fR ?\fB\-force\fR? ?\fB\-handler \fIproc\fR? ?\fB\-\|\-\fR? ?\fItopic\fR?
.sp
\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
.sp
\fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
\fBdde poke\fR \fIservice topic item data\fR
.sp
\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
.sp
\fBdde services \fIservice topic\fR
.sp
\fBdde eval\fR ?\fB\-async\fR? \fItopic cmd \fR?\fIarg arg ...\fR?
.BE
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
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







-
+










-
-
-
-
-

-
+








-
-
-
-
-







The \fB\-handler\fR option specifies a Tcl procedure that will be called to
process calls to the dde server. If the package has been loaded into a
safe interpreter then a \fB\-handler\fR procedure must be defined. The
procedure is called with all the arguments provided by the remote
call.
.RE
.TP
\fBdde execute\fR ?\fB\-async\fR? ?\fB\-binary\fR? \fIservice topic data\fR
\fBdde execute\fR ?\fB\-async\fR? \fIservice topic data\fR
.
\fBdde execute\fR takes the \fIdata\fR and sends it to the server indicated
by \fIservice\fR with the topic indicated by \fItopic\fR. Typically,
\fIservice\fR is the name of an application, and \fItopic\fR is a file to
work on.  The \fIdata\fR field is given to the remote application.
Typically, the application treats the \fIdata\fR field as a script, and the
script is run in the application.  The \fB\-async\fR option requests
asynchronous invocation.  The command returns an error message if the
script did not run, unless the \fB\-async\fR flag was used, in which case
the command returns immediately with no error.
Without the \fB\-binary\fR option all data will be sent in unicode. For
dde clients which don't implement the CF_UNICODE clipboard format, this
will automatically be translated to the system encoding. You can use
the \fB\-binary\fR option in combination with the result of
\fBencoding convertto\fR to send data in any other encoding.
.TP
\fBdde poke\fR ?\fB\-binary\fR? \fIservice topic item data\fR
\fBdde poke \fIservice topic item data\fR
.
\fBdde poke\fR passes the \fIdata\fR to the server indicated by
\fIservice\fR using the \fItopic\fR and \fIitem\fR specified.  Typically,
\fIservice\fR is the name of an application.  \fItopic\fR is application
specific but can be a command to the server or the name of a file to work
on.  The \fIitem\fR is also application specific and is often not used, but
it must always be non-null.  The \fIdata\fR field is given to the remote
application.
Without the \fB\-binary\fR option all data will be sent in unicode. For
dde clients which don't implement the CF_UNICODE clipboard format, this
will automatically be translated to the system encoding. You can use
the \fB\-binary\fR option in combination with the result of
\fBencoding convertto\fR to send data in any other encoding.
.TP
\fBdde request\fR ?\fB\-binary\fR? \fIservice topic item\fR
.
\fBdde request\fR is typically used to get the value of something; the
value of a cell in Microsoft Excel or the text of a selection in
Microsoft Word. \fIservice\fR is typically the name of an application,
\fItopic\fR is typically the name of the file, and \fIitem\fR is
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
119
120
121
122
123
124
125

126
127
128
129
130
131
132







-







\fBdde eval\fR evaluates a command and its arguments using the interpreter
specified by \fItopic\fR. The DDE service must be the \fBTclEval\fR
service.  The \fB\-async\fR option requests asynchronous invocation.  The
command returns an error message if the script did not run, unless the
\fB\-async\fR flag was used, in which case the command returns immediately
with no error.  This command can be used to replace send on Windows.
.SH "DDE AND TCL"
.PP
A Tcl interpreter always has a service name of \fBTclEval\fR.  Each
different interpreter of all running Tcl applications must be
given a unique
name specified by \fBdde servername\fR. Each interp is available as a
DDE topic only if the \fBdde servername\fR command was used to set the
name of the topic for each interp. So a \fBdde services TclEval {}\fR
command will return a list of service-topic pairs, where each of the
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
151
152
153
154
155
156
157

158
159

160
161
162
163
164
165
166
167










-


-








-
-
-
using either \fBupdate\fR or \fBvwait\fR.  This happens by default
when using \fBwish\fR unless a blocking command is called (such as \fBexec\fR
without adding the \fB&\fR to place the process in the background).
If for any reason the event queue is not flushed, DDE commands may
hang until the event queue is flushed.  This can create a deadlock
situation.
.SH EXAMPLE
.PP
This asks Internet Explorer (which must already be running) to go to a
particularly important website:
.PP
.CS
package require dde
\fBdde execute\fR -async iexplore WWW_OpenURL http://www.tcl.tk/
.CE
.SH "SEE ALSO"
tk(n), winfo(n), send(n)
.SH KEYWORDS
application, dde, name, remote execution
'\"Local Variables:
'\"mode: nroff
'\"End:

Deleted doc/define.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
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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















































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007-2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH define n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::define, oo::objdefine \- define and configure classes and objects
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::define\fI class defScript\fR
\fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR?
\fBoo::objdefine\fI object defScript\fR
\fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR?
.fi
.BE

.SH DESCRIPTION
The \fBoo::define\fR command is used to control the configuration of classes,
and the \fBoo::objdefine\fR command is used to control the configuration of
objects (including classes as instance objects), with the configuration being
applied to the entity named in the \fIclass\fR or the \fIobject\fR argument.
Configuring a class also updates the
configuration of all subclasses of the class and all objects that are
instances of that class or which mix it in (as modified by any per-instance
configuration). The way in which the configuration is done is controlled by
either the \fIdefScript\fR argument or by the \fIsubcommand\fR and following
\fIarg\fR arguments; when the second is present, it is exactly as if all the
arguments from \fIsubcommand\fR onwards are made into a list and that list is
used as the \fIdefScript\fR argument.
.PP
Note that the constructor for \fBoo::class\fR will call \fBoo::define\fR on
the script argument that it is provided. This is a convenient way to create
and define a class in one step.
.SH "CONFIGURING CLASSES"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
.TP
\fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR?
.VS TIP478
This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
omitted) promotes an existing method on the class object to be a class
method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
the \fBmethod\fR definition, below.
.RS
.PP
Class methods can be called on either the class itself or on the instances of
that class. When they are called, the current object (see the \fBsel\fR and
\fBmy\fR commands) is the class on which they are called or the class of the
instance on which they are called, depending on whether they are called on the
class or an instance of the class, respectively. If called on a subclass or
instance of the subclass, the current object is the subclass.
.PP
In a private definition context, the methods as invoked on classes are
\fInot\fR private, but the methods as invoked on instances of classes are
private.
.RE
.VE TIP478
.TP
\fBconstructor\fI argList bodyScript\fR
.
This creates or updates the constructor for a class. The formal arguments to
the constructor (defined using the same format as for the Tcl \fBproc\fR
command) will be \fIargList\fR, and the body of the constructor will be
\fIbodyScript\fR. When the body of the constructor is evaluated, the current
namespace of the constructor will be a namespace that is unique to the object
being constructed. Within the constructor, the \fBnext\fR command should be
used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
string, the constructor will be deleted.
.RS
.PP
Classes do not need to have a constructor defined. If none is specified, the
superclass's constructor will be used instead.
.RE
.TP
\fBdestructor\fI bodyScript\fR
.
This creates or updates the destructor for a class. Destructors take no
arguments, and the body of the destructor will be \fIbodyScript\fR. The
destructor is called when objects of the class are deleted, and when called
will have the object's unique namespace as the current namespace. Destructors
should use the \fBnext\fR command to call the superclasses' destructors. Note
that destructors are not called in all situations (e.g. if the interpreter is
destroyed). If \fIbodyScript\fR is the empty string, the destructor will be
deleted.
.RS
Note that errors during the evaluation of a destructor \fIare not returned\fR
to the code that causes the destruction of an object. Instead, they are passed
to the currently-defined \fBbgerror\fR handler.
.RE
.TP
\fBexport\fI name \fR?\fIname ...\fR?
.
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
\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
rules of the invoking objects' namespaces, i.e., when \fIcmdName\fR is not
fully-qualified, the command will be searched for in each object's namespace,
using the instances' namespace's path, or by looking in the global namespace.
The method will be exported if \fIname\fR starts with a lower-case letter, and
non-exported otherwise.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBinitialise\fI script\fR
.TP
\fBinitialize\fI script\fR
.VS TIP478
This evaluates \fIscript\fR in a context which supports local variables and
where the current namespace is the instance namespace of the class object
itself. This is useful for setting up, e.g., class-scoped variables.
.VE TIP478
.TP
\fBmethod\fI name \fR?\fIoption\fR? \fIargList bodyScript\fR
.
This creates or updates a method that is implemented as a procedure-like
script. 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 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
.VS  TIP519
or by specifying \fB\-export\fR, \fB\-private\fR or \fB\-unexport\fR in the
optional parameter \fIoption\fR.
.VE TIP519
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below) or if the \fB\-private\fR flag is given for \fIoption\fR, this command
creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current class will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, \fBself\fR, and \fBvariable\fR. Nesting
\fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
definition context is just a private definition context. All other definition
commands have no difference in behavior when used in a private definition
context.
.RE
.VE TIP500
.TP
\fBself\fI subcommand arg ...\fR
.TP
\fBself\fI script\fR
.TP
\fBself\fR
.
This command is equivalent to calling \fBoo::objdefine\fR on the class being
defined (see \fBCONFIGURING OBJECTS\fR below for a description of the
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" .
.RS
.PP
.VS TIP470
If no arguments at all are used, this gives the name of the class currently
being configured.
.VE TIP470
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), the definitions on the class object will also be made in a private
definition context.
.VE TIP500
.RE
.TP
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
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.
By default, this slot works by replacement.
.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?
.
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 namespace of 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.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
class. In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this class, and the name of the variable in the instance
namespace has a unique prefix that makes accidental use from other classes
extremely unlikely.
.VE TIP500
.RE
.SS "ADVANCED CLASS CONFIGURATION OPTIONS"
.PP
The following definitions are also supported, but are not required in simple
programs:
.TP
\fBdefinitionnamespace\fR ?\fIkind\fR? \fInamespaceName\fR
.VS TIP524
This allows control over what namespace will be used by the \fBoo::define\fR
and \fBoo::objdefine\fR commands to look up the definition commands they
use. When any object has a definition operation applied to it, \fIthe class that
it is an instance of\fR (and its superclasses and mixins) is consulted for
what definition namespace to use. \fBoo::define\fR gets the class definition
namespace, and \fB::oo::objdefine\fR gets the instance definition namespace,
but both otherwise use the identical lookup operation.
.RS
.PP
This sets the definition namespace of kind \fIkind\fR provided by the current
class to \fInamespaceName\fR. The \fInamespaceName\fR must refer to a
currently existing namespace, or must be the empty string (to stop the current
class from having such a namespace connected). The \fIkind\fR, if supplied,
must be either \fB\-class\fR (the default) or \fB\-instance\fR to specify the
whether the namespace for use with \fBoo::define\fR or \fBoo::objdefine\fR
respectively is being set.
.PP
The class \fBoo::object\fR has its instance namespace locked to
\fB::oo::objdefine\fR, and the class \fBoo::class\fR has its class namespace
locked to \fB::oo::define\fR. A consequence of this is that effective use of
this feature for classes requires the definition of a metaclass.
.RE
.VE TIP524
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
This deletes each of the methods called \fIname\fR from a class. The methods
must have previously existed in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
(except when they have a call chain through the class being modified) or the
class object itself.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
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.
By default, this slot works by appending.
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
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.
By default, this slot works by replacement.
.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
(except when they have a call chain through the class being modified), or the
class object itself. Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.SH "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
\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
\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.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this command creates private forwarded methods.
.VE TIP500
.RE
.TP
\fBmethod\fI name \fR?\fIoption\fR? \fIargList 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;
.VS  TIP519
this can be overridden by specifying \fB\-export\fR, \fB\-private\fR or
\fB\-unexport\fR in the optional parameter \fIoption\fR, or via the
\fBexport\fR and \fBunexport\fR definitions.
.VE TIP519
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below) or if the \fB\-private\fR flag is given for \fIoption\fR, this command
creates private procedure-like methods.
.VE TIP500
.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
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.
By default, this slot works by replacement.
.TP
\fBprivate \fIcmd arg...\fR
.TP
\fBprivate \fIscript\fR
.VS TIP500
This evaluates the \fIscript\fR (or the list of command and arguments given by
\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
current object will be private definitions.
.RS
.PP
The following class definition commands are affected by \fBprivate\fR:
\fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
\fBprivate\fR has no cumulative effect; the innermost definition context is
just a private definition context. All other definition commands have no
difference in behavior when used in a private definition context.
.RE
.VE TIP500
.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?
.
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 namespace of 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.
.RS
.PP
.VS TIP500
If in a private definition context (see the \fBprivate\fR definition command,
below), this slot manipulates the list of private variable bindings for this
object.  In a private variable binding, the name of the variable within the
instance object is different to the name given in the definition; the name
used in the definition is the name that you use to access the variable within
the methods of this instance object, and the name of the variable in the
instance namespace has a unique prefix that makes accidental use from
superclass methods extremely unlikely.
.VE TIP500
.RE
.SS "ADVANCED OBJECT CONFIGURATION OPTIONS"
.PP
The following definitions are also supported, but are not required in simple
programs:
.TP
\fBclass\fI className\fR
.
This allows the class of an object to be changed after creation. Note that the
class's constructors are not called when this is done, and so the object may
well be in an inconsistent state unless additional configuration work is done.
.TP
\fBdeletemethod\fI name\fR ?\fIname ...\fR
.
This deletes each of the methods called \fIname\fR from an object. The methods
must have previously existed in that object (e.g., because it was created
through \fBoo::objdefine method\fR). Does not affect the classes that the
object is an instance of, or remove the exposure of those class-provided
methods in the instance of that class.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
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.
By default, this slot works by appending.
.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 and cannot rename in an instance object the
methods provided by those classes (though a \fBoo::objdefine forward\fRed
method may provide an equivalent capability). Does not change the export
status of the method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.SH "PRIVATE METHODS"
.VS TIP500
When a class or instance has a private method, that private method can only be
invoked from within methods of that class or instance. Other callers of the
object's methods \fIcannot\fR invoke private methods, it is as if the private
methods do not exist. However, a private method of a class \fIcan\fR be
invoked from the class's methods when those methods are being used on another
instance object; this means that a class can use them to coordinate behaviour
between several instances of itself without interfering with how other
classes (especially either subclasses or superclasses) interact. Private
methods precede all mixed in classes in the method call order (as reported by
\fBself call\fR).
.VE TIP500
.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 five operations (as methods) that may be done on
the slot:
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.
This appends the given \fImember\fR elements to the slot definition.
.TP
\fIslot\fR \fB\-clear\fR
.
This sets the slot definition to the empty list.
.TP
\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
.VS TIP516
This prepends the given \fImember\fR elements to the slot definition.
.VE TIP516
.TP
\fIslot\fR \fB\-remove\fR ?\fImember ...\fR?
.VS TIP516
This removes the given \fImember\fR elements from the slot definition.
.VE TIP516
.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
.
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:
.TP
\fIslot\fR \fBGet\fR
.
Returns a list that is the current contents of the slot, but does not modify
the slot. This method must always be called from a stack frame created by a
call to \fBoo::define\fR or \fBoo::objdefine\fR. This method \fIshould not\fR
return an error unless it is called from outside a definition context or with
the wrong number of arguments.
.RS
.PP
.VS TIP516
The elements of the list should be fully resolved, if that is a meaningful
concept to the slot.
.VE TIP516
.RE
.TP
\fIslot\fR \fBResolve\fR \fIslotElement\fR
.VS TIP516
Returns \fIslotElement\fR with a resolution operation applied to it, but does
not modify the slot. For slots of simple strings, this is an operation that
does nothing, whereas for slots of classes, this maps a class name to its
fully-qualified class name.  This method must always be called from a stack
frame created by a call to \fBoo::define\fR or \fBoo::objdefine\fR.  This
method \fIshould not\fR return an error unless it is called from outside a
definition context or with the wrong number of arguments; unresolvable
arguments should be returned as is (as not all slot operations strictly
require that values are resolvable to work).
.RS
.PP
Implementations \fIshould not\fR enforce uniqueness and ordering constraints
in this method; that is the responsibility of the \fBSet\fR method.
.RE
.VE TIP516
.TP
\fIslot\fR \fBSet \fIelementList\fR
.
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. This method may return an
error if it rejects the change to the slot contents (e.g., because of invalid
values) as well as if it is called from outside a definition context or with
the wrong number of arguments.
.RS
.PP
This method \fImay\fR reorder and filter the elements if this is necessary in
order to satisfy the underlying constraints of the slot. (For example, slots
of classes enforce a uniqueness constraint that places each element in the
earliest location in the slot that it can.)
.RE
.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.
.PP
.VS TIP516
Most slot operations will initially \fBResolve\fR their argument list, combine
it with the results of the \fBGet\fR method, and then \fBSet\fR the result.
Some operations omit one or both of the first two steps; omitting the third
would result in an idempotent read-only operation (but the standard mechanism
for reading from slots is via \fBinfo class\fR and \fBinfo object\fR).
.VE TIP516
.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 their subcommands.
.PP
.CS
oo::class create c
c create o
\fBoo::define\fR c \fBmethod\fR foo {} {
    puts "world"
}
\fBoo::objdefine\fR o {
    \fBmethod\fR bar {} {
        my Foo "hello "
        my foo
    }
    \fBforward\fR Foo ::puts -nonewline
    \fBunexport\fR foo
}
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
.PP
.VS TIP478
This example shows how to create and use class variables. It is a class that
counts how many instances of itself have been made.
.PP
.CS
oo::class create Counted
\fBoo::define\fR Counted {
    \fBinitialise\fR {
        variable count 0
    }

    \fBvariable\fR number
    \fBconstructor\fR {} {
        classvariable count
        set number [incr count]
    }

    \fBmethod\fR report {} {
        classvariable count
        puts "This is instance $number of $count"
    }
}

set a [Counted new]
set b [Counted new]
$a report
        \fI\(-> This is instance 1 of 2\fR
set c [Counted new]
$b report
        \fI\(-> This is instance 2 of 3\fR
$c report
        \fI\(-> This is instance 3 of 3\fR
.CE
.PP
This example demonstrates how to use class methods. (Note that the constructor
for \fBoo::class\fR calls \fBoo::define\fR on the class.)
.PP
.CS
oo::class create DBTable {
    \fBclassmethod\fR find {description} {
        puts "DB: locate row from [self] matching $description"
        return [my new]
    }
    \fBclassmethod\fR insert {description} {
        puts "DB: create row in [self] matching $description"
        return [my new]
    }
    \fBmethod\fR update {description} {
        puts "DB: update row [self] with $description"
    }
    \fBmethod\fR delete {} {
        puts "DB: delete row [self]"
        my destroy; # Just delete the object, not the DB row
    }
}

oo::class create Users {
    \fBsuperclass\fR DBTable
}
oo::class create Groups {
    \fBsuperclass\fR DBTable
}

set u1 [Users insert "username=abc"]
        \fI\(-> DB: create row from ::Users matching username=abc\fR
set u2 [Users insert "username=def"]
        \fI\(-> DB: create row from ::Users matching username=def\fR
$u2 update "group=NULL"
        \fI\(-> DB: update row ::oo::Obj124 with group=NULL\fR
$u1 delete
        \fI\(-> DB: delete row ::oo::Obj123\fR
set g [Group find "groupname=webadmins"]
        \fI\(-> DB: locate row ::Group with groupname=webadmins\fR
$g update "emailaddress=admins"
        \fI\(-> DB: update row ::oo::Obj125 with emailaddress=admins\fR
.CE
.VE TIP478
.PP
.VS TIP524
This example shows how to make a custom definition for a class. Note that it
explicitly includes delegation to the existing definition commands via
\fBnamespace path\fR.
.PP
.CS
namespace eval myDefinitions {
    # Delegate to existing definitions where not overridden
    namespace path \fB::oo::define\fR

    # A custom type of method
    proc exprmethod {name arguments body} {
        tailcall \fBmethod\fR $name $arguments [list expr $body]
    }

    # A custom way of building a constructor
    proc parameters args {
        uplevel 1 [list \fBvariable\fR {*}$args]
        set body [join [lmap a $args {
            string map [list VAR $a] {
                set [my varname VAR] [expr {double($VAR)}]
            }
        }] ";"]
        tailcall \fBconstructor\fR $args $body
    }
}

# Bind the namespace into a (very simple) metaclass for use
oo::class create exprclass {
    \fBsuperclass\fR oo::class
    \fBdefinitionnamespace\fR myDefinitions
}

# Use the custom definitions
exprclass create quadratic {
    parameters a b c
    exprmethod evaluate {x} {
        ($a * $x**2) + ($b * $x) + $c
    }
}

# Showing the resulting class and object in action
quadratic create quad 1 2 3
for {set x 0} {$x <= 4} {incr x} {
    puts [format "quad(%d) = %.2f" $x [quad evaluate $x]]
}
        \fI\(-> quad(0) = 3.00\fR
        \fI\(-> quad(1) = 6.00\fR
        \fI\(-> quad(2) = 11.00\fR
        \fI\(-> quad(3) = 18.00\fR
        \fI\(-> quad(4) = 27.00\fR
.CE
.VE TIP524
.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/dict.n.

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
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







-



-
+
-
-
-
-
-
-


-
-
+




-






-





-
-
-
+
+
+

-
+
-

-
+










-
-
-
+
+
+


-
+
-














-







.PP
Performs one of several operations on dictionary values or variables
containing dictionary values (see the \fBDICTIONARY VALUES\fR section
below for a description), depending on \fIoption\fR.  The legal
\fIoption\fRs (which may be abbreviated) are:
.TP
\fBdict append \fIdictionaryVariable key \fR?\fIstring ...\fR?
.
This appends the given string (or strings) to the value that the given
key maps to in the dictionary value contained in the given variable,
writing the resulting dictionary value back to that variable.
Non-existent keys are treated as if they map to an empty string. The
Non-existent keys are treated as if they map to an empty string.
updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the appending operation.
.VE TIP508
.TP
\fBdict create \fR?\fIkey value ...\fR?
.
Return a new dictionary that contains each of the key/value mappings
Create a new dictionary that contains each of the key/value mappings
listed as arguments (keys and values alternating, with each key being
followed by its associated value.)
.TP
\fBdict exists \fIdictionaryValue key \fR?\fIkey ...\fR?
.
This returns a boolean value indicating whether the given key (or path
of keys through a set of nested dictionaries) exists in the given
dictionary value. This returns a true value exactly when \fBdict
get\fR on that path will succeed.
.TP
\fBdict filter \fIdictionaryValue filterType arg \fR?\fIarg ...\fR?
.
This takes a dictionary value and returns a new dictionary that
contains just those key/value pairs that match the specified filter
type (which may be abbreviated.)  Supported filter types are:
.RS
.TP
\fBdict filter \fIdictionaryValue \fBkey\fR ?\fIglobPattern ...\fR?
The key rule only matches those key/value pairs whose keys match any
of the given patterns (in the style of \fBstring match\fR.)
\fBdict filter \fIdictionaryValue \fBkey \fIglobPattern\fR
The key rule only matches those key/value pairs whose keys match the
given pattern (in the style of \fBstring match\fR.)
.TP
\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVariable valueVariable\fB} \fIscript\fR
\fBdict filter \fIdictionaryValue \fBscript {\fIkeyVar valueVar\fB} \fIscript\fR
.
The script rule tests for matching by assigning the key to the
\fIkeyVariable\fR and the value to the \fIvalueVariable\fR, and then evaluating
\fIkeyVar\fR and the value to the \fIvalueVar\fR, and then evaluating
the given script which should return a boolean value (with the
key/value pair only being included in the result of the \fBdict
filter\fR when a true value is returned.)  Note that the first
argument after the rule selection word is a two-element list.  If the
\fIscript\fR returns with a condition of \fBTCL_BREAK\fR, no further
key/value pairs are considered for inclusion in the resulting
dictionary, and a condition of \fBTCL_CONTINUE\fR is equivalent to a false
result. The key/value pairs are tested in the order in which the keys
were inserted into the dictionary.
.TP
\fBdict filter \fIdictionaryValue \fBvalue \fR?\fIglobPattern ...\fR?
The value rule only matches those key/value pairs whose values match any
of the given patterns (in the style of \fBstring match\fR.)
\fBdict filter \fIdictionaryValue \fBvalue \fIglobPattern\fR
The value rule only matches those key/value pairs whose values match
the given pattern (in the style of \fBstring match\fR.)
.RE
.TP
\fBdict for {\fIkeyVariable valueVariable\fB} \fIdictionaryValue body\fR
\fBdict for {\fIkeyVar valueVar\fB} \fIdictionaryValue body\fR
.
This command takes three arguments, the first a two-element list of
variable names (for the key and value respectively of each mapping in
the dictionary), the second the dictionary value to iterate across,
and the third a script to be evaluated for each mapping with the key
and value variables set appropriately (in the manner of \fBforeach\fR.)
The result of the command is an empty string. If any evaluation of the
body generates a \fBTCL_BREAK\fR result, no further pairs from the
dictionary will be iterated over and the \fBdict for\fR command will
terminate successfully immediately. If any evaluation of the body
generates a \fBTCL_CONTINUE\fR result, this shall be treated exactly like a
normal \fBTCL_OK\fR result. The order of iteration is the order in
which the keys were inserted into the dictionary.
.TP
\fBdict get \fIdictionaryValue \fR?\fIkey ...\fR?
.
Given a dictionary value (first argument) and a key (second argument),
this will retrieve the value for that key. Where several keys are
supplied, the behaviour of the command shall be as if the result of
\fBdict get $dictVal $key\fR was passed as the first argument to
\fBdict get\fR with the remaining arguments as second (and possibly
subsequent) arguments. This facilitates lookups in nested
dictionaries. For example, the following two commands are equivalent:
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-





-
+
-
-
-
-
-
-


-







-






-





-
+
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-







-







-







-




-
+
-
-
-
-
-


-



-






-
+
-
-
-
-
-
-


-












-
-
-
-
-




-
+








-







-












-
-
-
-
-




-
+







element of each pair would be the key and the second element would be
the value for that key.
.PP
It is an error to attempt to retrieve a value for a key that is not
present in the dictionary.
.RE
.TP
\fBdict getdef \fIdictionaryValue \fR?\fIkey ...\fR? \fIkey default\fR
.TP
\fBdict getwithdefault \fIdictionaryValue \fR?\fIkey ...\fR? \fIkey default\fR
.VS "8.7, TIP342"
This behaves the same as \fBdict get\fR (with at least one \fIkey\fR
argument), returning the value that the key path maps to in the
dictionary \fIdictionaryValue\fR, except that instead of producing an
error because the \fIkey\fR (or one of the \fIkey\fRs on the key path)
is absent, it returns the \fIdefault\fR argument instead.
.RS
.PP
Note that there must always be at least one \fIkey\fR provided, and that
\fBdict getdef\fR and \fBdict getwithdefault\fR are aliases for each other.
.RE
.VE "8.7, TIP342"
.TP
\fBdict incr \fIdictionaryVariable key \fR?\fIincrement\fR?
.
This adds the given increment value (an integer that defaults to 1 if
not specified) to the value that the given key maps to in the
dictionary value contained in the given variable, writing the
resulting dictionary value back to that variable. Non-existent keys
are treated as if they map to 0. It is an error to increment a value
for an existing key if that value is not an integer. The updated
for an existing key if that value is not an integer.
dictionary value is returned.
.VS TIP508
If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the incrementing operation.
.VE TIP508
.TP
\fBdict info \fIdictionaryValue\fR
.
This returns information (intended for display to people) about the
given dictionary though the format of this data is dependent on the
implementation of the dictionary. For dictionaries that are
implemented by hash tables, it is expected that this will return the
string produced by \fBTcl_HashStats\fR, similar to \fBarray statistics\fR.
.TP
\fBdict keys \fIdictionaryValue \fR?\fIglobPattern\fR?
.
Return a list of all keys in the given dictionary value. If a pattern
is supplied, only those keys that match it (according to the rules of
\fBstring match\fR) will be returned. The returned keys will be in the
order that they were inserted into the dictionary.
.TP
\fBdict lappend \fIdictionaryVariable key \fR?\fIvalue ...\fR?
.
This appends the given items to the list value that the given key maps
to in the dictionary value contained in the given variable, writing
the resulting dictionary value back to that variable. Non-existent
keys are treated as if they map to an empty list, and it is legal for
there to be no items to append to the list. It is an error for the
value that the key maps to to not be representable as a list. The
value that the key maps to to not be representable as a list.
updated dictionary value is returned.
.VS TIP508
If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the list-appending operation.
.VE TIP508
.TP
\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
.
This command applies a transformation to each element of a dictionary,
returning a new dictionary. It takes three arguments: the first is a
two-element list of variable names (for the key and value respectively of each
mapping in the dictionary), the second the dictionary value to iterate across,
and the third a script to be evaluated for each mapping with the key and value
variables set appropriately (in the manner of \fBlmap\fR). In an iteration
where the evaluated script completes normally (\fBTCL_OK\fR, as opposed to an
\fBerror\fR, etc.) the result of the script is put into an accumulator
dictionary using the key that is the current contents of the \fIkeyVariable\fR
variable at that point. The result of the \fBdict map\fR command is the
accumulator dictionary after all keys have been iterated over.
.RS
.PP
If the evaluation of the body for any particular step generates a \fBbreak\fR,
no further pairs from the dictionary will be iterated over and the \fBdict
map\fR command will terminate successfully immediately. If the evaluation of
the body for a particular step generates a \fBcontinue\fR result, the current
iteration is aborted and the accumulator dictionary is not modified. The order
of iteration is the natural order of the dictionary (typically the order in
which the keys were added to the dictionary; the order is the same as that
used in \fBdict for\fR).
.RE
.TP
\fBdict merge \fR?\fIdictionaryValue ...\fR?
.
Return a dictionary that contains the contents of each of the
\fIdictionaryValue\fR arguments.  Where two (or more) dictionaries
contain a mapping for the same key, the resulting dictionary maps that
key to the value according to the last dictionary on the command line
containing a mapping for that key.
.TP
\fBdict remove \fIdictionaryValue \fR?\fIkey ...\fR?
.
Return a new dictionary that is a copy of an old one passed in as
first argument except without mappings for each of the keys listed.
It is legal for there to be no keys to remove, and it also legal for
any of the keys to be removed to not be present in the input
dictionary in the first place.
.TP
\fBdict replace \fIdictionaryValue \fR?\fIkey value ...\fR?
.
Return a new dictionary that is a copy of an old one passed in as
first argument except with some values different or some extra
key/value pairs added. It is legal for this command to be called with
no key/value pairs, but illegal for this command to be called with a
key but no value.
.TP
\fBdict set \fIdictionaryVariable key \fR?\fIkey ...\fR? \fIvalue\fR
.
This operation takes the name of a variable containing a dictionary
value and places an updated dictionary value in that variable
containing a mapping from the given key to the given value. When
multiple keys are present, this operation creates or updates a chain
of nested dictionaries. The updated dictionary value is returned.
of nested dictionaries.
.VS TIP508
If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value insert/update operation.
.VE TIP508
.TP
\fBdict size \fIdictionaryValue\fR
.
Return the number of key/value mappings in the given dictionary value.
.TP
\fBdict unset \fIdictionaryVariable key \fR?\fIkey ...\fR?
.
This operation (the companion to \fBdict set\fR) takes the name of a
variable containing a dictionary value and places an updated
dictionary value in that variable that does not contain a mapping for
the given key. Where multiple keys are present, this describes a path
through nested dictionaries to the mapping to remove. At least one key
must be specified, but the last key on the key-path need not exist.
All other components on the path must exist. The updated dictionary
All other components on the path must exist.
value is returned.
.VS TIP508
If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the value remove operation.
.VE TIP508
.TP
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
.
Execute the Tcl script in \fIbody\fR with the value for each \fIkey\fR
(as found by reading the dictionary value in \fIdictionaryVariable\fR)
mapped to the variable \fIvarName\fR. There may be multiple
\fIkey\fR/\fIvarName\fR pairs. If a \fIkey\fR does not have a mapping,
that corresponds to an unset \fIvarName\fR. When \fIbody\fR
terminates, any changes made to the \fIvarName\fRs is reflected back
to the dictionary within \fIdictionaryVariable\fR (unless
\fIdictionaryVariable\fR itself becomes unreadable, when all updates
are silently discarded), even if the result of \fIbody\fR is an error
or some other kind of exceptional exit. The result of \fBdict
update\fR is (unless some kind of error occurs) the result of the
evaluation of \fIbody\fR.
.VS TIP508
If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the update operation.
.VE TIP508
.RS
.PP
Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
(\fBproc\fRedure or lambda term for \fBapply\fR). Because of
this, the variables set by \fBdict update\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).
Note that the mapping of values to variables
does not use traces; changes to the \fIdictionaryVariable\fR's
contents only happen when \fIbody\fR terminates.
.RE
.TP
\fBdict values \fIdictionaryValue \fR?\fIglobPattern\fR?
.
Return a list of all values in the given dictionary value. If a
pattern is supplied, only those values that match it (according to the
rules of \fBstring match\fR) will be returned. The returned values
will be in the order of that the keys associated with those values
were inserted into the dictionary.
.TP
\fBdict with \fIdictionaryVariable \fR?\fIkey ...\fR? \fIbody\fR
.
Execute the Tcl script in \fIbody\fR with the value for each key in
\fIdictionaryVariable\fR mapped (in a manner similarly to \fBdict
update\fR) to a variable with the same name. Where one or more
\fIkey\fRs are available, these indicate a chain of nested
dictionaries, with the innermost dictionary being the one opened out
for the execution of \fIbody\fR. As with \fBdict update\fR, making
\fIdictionaryVariable\fR unreadable will make the updates to the
dictionary be discarded, and this also happens if the contents of
\fIdictionaryVariable\fR are adjusted so that the chain of
dictionaries no longer exists. The result of \fBdict with\fR is
(unless some kind of error occurs) the result of the evaluation of
\fIbody\fR.
.VS TIP508
If \fIdictionaryVariable\fR indicates an element that does not exist of an
array that has a default value set, the default value and will be used as the
value of the dictionary prior to the updating operation.
.VE TIP508
.RS
.PP
The variables are mapped in the scope enclosing the \fBdict with\fR;
it is recommended that this command only be used in a local scope
(\fBproc\fRedure, lambda term for \fBapply\fR, or method). Because of
(\fBproc\fRedure or lambda term for \fBapply\fR). Because of
this, the variables set by \fBdict with\fR will continue to
exist after the command finishes (unless explicitly \fBunset\fR).
Note that the mapping of values to variables does not use
traces; changes to the \fIdictionaryVariable\fR's contents only happen
when \fIbody\fR terminates.
.PP
If the \fIdictionaryVariable\fR contains a value that is not a dictionary at
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
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
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










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



-
+









-
+


















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



-
-
+
+



















-
+

-
+
-
-
-
\fBdict set\fR employeeInfo 98372-J phone  "555-8765"
# The above data probably ought to come from a database...

# Print out some employee info
set i 0
puts "There are [\fBdict size\fR $employeeInfo] employees"
\fBdict for\fR {id info} $employeeInfo {
    puts "Employee #[incr i]: $id"
    \fBdict with\fR info {
        puts "   Name: $forenames $surname"
        puts "   Address: $street, $city"
        puts "   Telephone: $phone"
    }
   puts "Employee #[incr i]: $id"
   \fBdict with\fR info {
      puts "   Name: $forenames $surname"
      puts "   Address: $street, $city"
      puts "   Telephone: $phone"
   }
}
# Another way to iterate and pick out names...
foreach id [\fBdict keys\fR $employeeInfo] {
    puts "Hello, [\fBdict get\fR $employeeInfo $id forenames]!"
   puts "Hello, [\fBdict get\fR $employeeInfo $id forenames]!"
}
.CE
.PP
A localizable version of \fBstring toupper\fR:
.PP
.CS
# Set up the basic C locale
set capital [\fBdict create\fR C [\fBdict create\fR]]
foreach c [split {abcdefghijklmnopqrstuvwxyz} ""] {
    \fBdict set\fR capital C $c [string toupper $c]
   \fBdict set\fR capital C $c [string toupper $c]
}

# English locales can luckily share the "C" locale
\fBdict set\fR capital en [\fBdict get\fR $capital C]
\fBdict set\fR capital en_US [\fBdict get\fR $capital C]
\fBdict set\fR capital en_GB [\fBdict get\fR $capital C]

# ... and so on for other supported languages ...

# Now get the mapping for the current locale and use it.
set upperCaseMap [\fBdict get\fR $capital $env(LANG)]
set upperCase [string map $upperCaseMap $string]
.CE
.PP
Showing the detail of \fBdict with\fR:
.PP
.CS
proc sumDictionary {varName} {
    upvar 1 $varName vbl
    foreach key [\fBdict keys\fR $vbl] {
        # Manufacture an entry in the subdictionary
        \fBdict set\fR vbl $key total 0
        # Add the values and remove the old
        \fBdict with\fR vbl $key {
            set total [expr {$x + $y + $z}]
            unset x y z
        }
    }
    puts "last total was $total, for key $key"
   upvar 1 $varName vbl
   foreach key [\fBdict keys\fR $vbl] {
      # Manufacture an entry in the subdictionary
      \fBdict set\fR vbl $key total 0
      # Add the values and remove the old
      \fBdict with\fR vbl $key {
         set total [expr {$x + $y + $z}]
         unset x y z
      }
   }
   puts "last total was $total, for key $key"
}

set myDict {
    a {x 1 y 2 z 3}
    b {x 6 y 5 z 4}
   a {x 1 y 2 z 3}
   b {x 6 y 5 z 4}
}

sumDictionary myDict
#    prints: \fIlast total was 15, for key b\fR

puts "dictionary is now \\"$myDict\\""
#    prints: \fIdictionary is now "a {total 6} b {total 15}"\fR
.CE
.PP
When \fBdict with\fR is used with a key that clashes with the name of the
dictionary variable:
.PP
.CS
set foo {foo {a b} bar 2 baz 3}
\fBdict with\fR foo {}
puts $foo
#    prints: \fIa b foo {a b} bar 2 baz 3\fR
.CE
.SH "SEE ALSO"
append(n), array(n), foreach(n), incr(n), list(n), lappend(n), lmap(n), set(n)
append(n), array(n), foreach(n), incr(n), list(n), lappend(n), set(n)
.SH KEYWORDS
dictionary, create, update, lookup, iterate, filter, map
dictionary, create, update, lookup, iterate, filter
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/encoding.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
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
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





-
+


-
+








+


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






-








-



-
-
-
+
+


-
+









+


-

-
+
-
-
-
-
-


-














-
+







-



-



+


+

-
+
-
-
-
'\"
'\" Copyright (c) 1998 by Scriptics Corporation.
'\"
'\" 
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH encoding n "8.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
encoding \- Manipulate encodings
.SH SYNOPSIS
\fBencoding \fIoption\fR ?\fIarg arg ...\fR?
.BE

.SH INTRODUCTION
.PP
Strings in Tcl are logically a sequence of 16-bit Unicode characters.
Strings in Tcl are encoded using 16-bit Unicode characters.  Different
These strings are represented in memory as a sequence of bytes that
may be in one of several encodings: modified UTF\-8 (which uses 1 to 3
bytes per character), 16-bit
.QW Unicode
(which uses 2 bytes per character, with an endianness that is
dependent on the host architecture), and binary (which uses a single
byte per character but only handles a restricted range of characters).
Tcl does not guarantee to always use the same encoding for the same
string.
.PP
Different operating system interfaces or applications may generate
strings in other encodings such as Shift\-JIS.  The \fBencoding\fR
command helps to bridge the gap between Unicode and these other
operating system interfaces or applications may generate strings in
other encodings such as Shift-JIS.  The \fBencoding\fR command helps
to bridge the gap between Unicode and these other formats.
formats.
.SH DESCRIPTION
.PP
Performs one of several encoding related operations, depending on
\fIoption\fR.  The legal \fIoption\fRs are:
.TP
\fBencoding convertfrom\fR ?\fIencoding\fR? \fIdata\fR
.
Convert \fIdata\fR to Unicode from the specified \fIencoding\fR.  The
characters in \fIdata\fR are treated as binary data where the lower
8-bits of each character is taken as a single byte.  The resulting
sequence of bytes is treated as a string in the specified
\fIencoding\fR.  If \fIencoding\fR is not specified, the current
system encoding is used.
.TP
\fBencoding convertto\fR ?\fIencoding\fR? \fIstring\fR
.
Convert \fIstring\fR from Unicode to the specified \fIencoding\fR.
The result is a sequence of bytes that represents the converted
string.  Each byte is stored in the lower 8-bits of a Unicode
character (indeed, the resulting string is a binary string as far as
Tcl is concerned, at least initially).  If \fIencoding\fR is not
specified, the current system encoding is used.
character.  If \fIencoding\fR is not specified, the current
system encoding is used.
.TP
\fBencoding dirs\fR ?\fIdirectoryList\fR?
.
.VS 8.5
Tcl can load encoding data files from the file system that describe
additional encodings for it to work with. This command sets the search
path for \fB*.enc\fR encoding data files to the list of directories
\fIdirectoryList\fR. If \fIdirectoryList\fR is omitted then the
command returns the current list of directories that make up the
search path. It is an error for \fIdirectoryList\fR to not be a valid
list. If, when a search for an encoding data file is happening, an
element in \fIdirectoryList\fR does not refer to a readable,
searchable directory, that element is ignored.
.VE 8.5
.TP
\fBencoding names\fR
.
Returns a list containing the names of all of the encodings that are
currently available.
currently available. 
The encodings
.QW utf-8
and
.QW iso8859-1
are guaranteed to be present in the list.
.TP
\fBencoding system\fR ?\fIencoding\fR?
.
Set the system encoding to \fIencoding\fR. If \fIencoding\fR is
omitted then the command returns the current system encoding.  The
system encoding is used whenever Tcl passes strings to system calls.
.SH EXAMPLE
.PP
It is common practice to write script files using a text editor that
produces output in the euc-jp encoding, which represents the ASCII
characters as singe bytes and Japanese characters as two bytes.  This
makes it easy to embed literal strings that correspond to non-ASCII
characters by simply typing the strings in place in the script.
However, because the \fBsource\fR command always reads files using the
current system encoding, Tcl will only source such files correctly
when the encoding used to write the file is the same.  This tends not
to be true in an internationalized setting.  For example, if such a
file was sourced in North America (where the ISO8859\-1 is normally
file was sourced in North America (where the ISO8859-1 is normally
used), each byte in the file would be treated as a separate character
that maps to the 00 page in Unicode.  The resulting Tcl strings will
not contain the expected Japanese characters.  Instead, they will
contain a sequence of Latin-1 characters that correspond to the bytes
of the original string.  The \fBencoding\fR command can be used to
convert this string to the expected Japanese Unicode characters.  For
example,
.PP
.CS
set s [\fBencoding convertfrom\fR euc-jp "\exA4\exCF"]
.CE
.PP
would return the Unicode string
.QW "\eu306F" ,
which is the Hiragana letter HA.

.SH "SEE ALSO"
Tcl_GetEncoding(3)

.SH KEYWORDS
encoding, unicode
encoding
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/eof.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
44
45
46
47
48
49
50
51
52
53
54
55
56
57

58
59

60
61
62
63
64
65
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










-
+









+











-

-













-













+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH eof n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
eof \- Check for end of file condition on channel
.SH SYNOPSIS
\fBeof \fIchannelId\fR
.BE

.SH DESCRIPTION
.PP
Returns 1 if an end of file condition occurred during the most
recent input operation on \fIchannelId\fR (such as \fBgets\fR),
0 otherwise.
.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.
.SH EXAMPLES
.PP
Read and print out the contents of a file line-by-line:
.PP
.CS
set f [open somefile.txt]
while {1} {
    set line [gets $f]
    if {[\fBeof\fR $f]} {
        close $f
        break
    }
    puts "Read line: $line"
}
.CE
.PP
Read and print out the contents of a file by fixed-size records:
.PP
.CS
set f [open somefile.dat]
fconfigure $f -translation binary
set recordSize 40
while {1} {
    set record [read $f $recordSize]
    if {[\fBeof\fR $f]} {
        close $f
        break
    }
    puts "Read record: $record"
}
.CE

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

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

Changes to doc/error.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH error n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
error \- Generate an error
.SH SYNOPSIS
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
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










-
+








-

-
+


-
+

-


-

-
+

-
+









-

-





+


+

-
+
-
-
-
The \fB\-errorinfo\fR return option of an interpreter is used
to accumulate a stack trace of what was in progress when an
error occurred; as nested commands unwind,
the Tcl interpreter adds information to the \fB\-errorinfo\fR
return option.  If the \fIinfo\fR argument is present, it is
used to initialize the \fB\-errorinfo\fR return options and
the first increment of unwind information
will not be added by the Tcl interpreter.
will not be added by the Tcl interpreter.  
In other
words, the command containing the \fBerror\fR command will not appear
in the stack trace; in its place will be \fIinfo\fR.
Historically, this feature had been most useful in conjunction
with the \fBcatch\fR command:
if a caught error cannot be handled successfully, \fIinfo\fR can be used
to return a stack trace reflecting the original point of occurrence
of the error:
.PP
.CS
catch {...} errMsg
\fBcatch {...} errMsg
set savedInfo $::errorInfo
\&...
\fBerror\fR $errMsg $savedInfo
error $errMsg $savedInfo\fR
.CE
.PP
When working with Tcl 8.5 or later, the following code
should be used instead:
.PP
.CS
catch {...} errMsg options
\fBcatch {...} errMsg options
\&...
return -options $options $errMsg
return -options $options $errMsg\fR
.CE
.PP
If the \fIcode\fR argument is present, then its value is stored
in the \fB\-errorcode\fR return option.  The \fB\-errorcode\fR
return option is intended to hold a machine-readable description
of the error in cases where such information is available; see
the \fBreturn\fR manual page for information on the proper format
for this option's value.
.SH EXAMPLE
.PP
Generate an error if a basic mathematical operation fails:
.PP
.CS
if {1+2 != 3} {
    \fBerror\fR "something is very wrong with addition"
}
.CE

.SH "SEE ALSO"
catch(n), return(n)

.SH KEYWORDS
error, exception
error
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/eval.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
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
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









-
+









+











-





-

















+





+



-


-
-
-
-
-
+
+
+
+
+


-
+


-



+
+

-
-
+
+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH eval n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
eval \- Evaluate a Tcl script
.SH SYNOPSIS
\fBeval \fIarg \fR?\fIarg ...\fR?
.BE

.SH DESCRIPTION
.PP
\fBEval\fR takes one or more arguments, which together comprise a Tcl
script containing one or more commands.
\fBEval\fR concatenates all its arguments in the same
fashion as the \fBconcat\fR command, passes the concatenated string to the
Tcl interpreter recursively, and returns the result of that
evaluation (or any error generated by it).
Note that the \fBlist\fR command quotes sequences of words in such a
way that they are not further expanded by the \fBeval\fR command.
.SH EXAMPLES
.PP
Often, it is useful to store a fragment of a script in a variable and
execute it later on with extra values appended. This technique is used
in a number of places throughout the Tcl core (e.g. in \fBfcopy\fR,
\fBlsort\fR and \fBtrace\fR command callbacks). This example shows how
to do this using core Tcl commands:
.PP
.CS
set script {
    puts "logging now"
    lappend $myCurrentLogVar
}
set myCurrentLogVar log1
# Set up a switch of logging variable part way through!
after 20000 set myCurrentLogVar log2

for {set i 0} {$i<10} {incr i} {
    # Introduce a random delay
    after [expr {int(5000 * rand())}]
    update    ;# Check for the asynch log switch
    \fBeval\fR $script $i [clock clicks]
}
.CE
.PP
.VS 8.5
Note that in the most common case (where the script fragment is
actually just a list of words forming a command prefix), it is better
to use \fB{*}$script\fR when doing this sort of invocation
pattern.  It is less general than the \fBeval\fR command, and hence
easier to make robust in practice.
.VE 8.5
The following procedure acts in a way that is analogous to the
\fBlappend\fR command, except it inserts the argument values at the
start of the list in the variable:
.PP
.CS
proc lprepend {varName args} {
    upvar 1 $varName var
    # Ensure that the variable exists and contains a list
    lappend var
    # Now we insert all the arguments in one go
    set var [\fBeval\fR [list linsert $var 0] $args]
   upvar 1 $varName var
   # Ensure that the variable exists and contains a list
   lappend var
   # Now we insert all the arguments in one go
   set var [\fBeval\fR [list linsert $var 0] $args]
}
.CE
.PP
.VS 8.5
However, the last line would now normally be written without
\fBeval\fR, like this:
.PP
.CS
set var [linsert $var 0 {*}$args]
.CE
.VE 8.5

.SH "SEE ALSO"
catch(n), concat(n), error(n), errorCode(n), errorInfo(n), interp(n), list(n),
namespace(n), subst(n), uplevel(n)
catch(n), concat(n), error(n), interp(n), list(n), namespace(n), subst(n), tclvars(n), uplevel(n)

.SH KEYWORDS
concatenate, evaluate, script
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/exec.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
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
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







-
+







-
+

+







+
+
+
+







-
+


+


-




-















-





-






-




-






-



-




-




-





-





-





-





-






-







-





-








-
+
+
+


+








+

+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2006 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH exec n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
exec \- Invoke subprocesses
.SH SYNOPSIS
\fBexec \fR?\fIswitches\fR? \fIarg \fR?\fIarg ...\fR? ?\fB&\fR?
\fBexec \fR?\fIswitches\fR? \fIarg \fR?\fIarg ...\fR?
.BE

.SH DESCRIPTION
.PP
This command treats its arguments as the specification
of one or more subprocesses to execute.
The arguments take the form of a standard shell pipeline
where each \fIarg\fR becomes one word of a command, and
each distinct command becomes a subprocess.
The result of the command is the standard output of the final subprocess in
the pipeline, interpreted using the system \fBencoding\fR; to use any other
encoding (especially including binary data), the pipeline must be
\fBopen\fRed, configured and read explicitly.
.PP
If the initial arguments to \fBexec\fR start with \fB\-\fR then
they are treated as command-line switches and are not part
of the pipeline specification.  The following switches are
currently supported:
.TP 13
\fB\-ignorestderr\fR
.
.VS 8.5
Stops the \fBexec\fR command from treating the output of messages to the
pipeline's standard error channel as an error case.
.VE 8.5
.TP 13
\fB\-keepnewline\fR
.
Retains a trailing newline in the pipeline's output.
Normally a trailing newline will be deleted.
.TP 13
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.PP
If an \fIarg\fR (or pair of \fIarg\fRs) has one of the forms
described below then it is used by \fBexec\fR to control the
flow of input and output among the subprocess(es).
Such arguments will not be passed to the subprocess(es).  In forms
such as
.QW "\fB<\fR \fIfileName\fR" ,
\fIfileName\fR may either be in a separate argument from
.QW \fB<\fR
or in the same argument with no intervening space (i.e.
.QW \fB<\fIfileName\fR ).
.TP 15
\fB|\fR
.
Separates distinct commands in the pipeline.  The standard output
of the preceding command will be piped into the standard input
of the next command.
.TP 15
\fB|&\fR
.
Separates distinct commands in the pipeline.  Both standard output
and standard error of the preceding command will be piped into
the standard input of the next command.
This form of redirection overrides forms such as 2> and >&.
.TP 15
\fB<\0\fIfileName\fR
.
The file named by \fIfileName\fR is opened and used as the standard
input for the first command in the pipeline.
.TP 15
\fB<@\0\fIfileId\fR
.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
It is used as the standard input for the first command in the pipeline.
\fIFileId\fR must have been opened for reading.
.TP 15
\fB<<\0\fIvalue\fR
.
\fIValue\fR is passed to the first command as its standard input.
.TP 15
\fB>\0\fIfileName\fR
.
Standard output from the last command is redirected to the file named
\fIfileName\fR, overwriting its previous contents.
.TP 15
\fB2>\0\fIfileName\fR
.
Standard error from all commands in the pipeline is redirected to the
file named \fIfileName\fR, overwriting its previous contents.
.TP 15
\fB>&\0\fIfileName\fR
.
Both standard output from the last command and standard error from all
commands are redirected to the file named \fIfileName\fR, overwriting
its previous contents.
.TP 15
\fB>>\0\fIfileName\fR
.
Standard output from the last command is
redirected to the file named \fIfileName\fR, appending to it rather
than overwriting it.
.TP 15
\fB2>>\0\fIfileName\fR
.
Standard error from all commands in the pipeline is
redirected to the file named \fIfileName\fR, appending to it rather
than overwriting it.
.TP 15
\fB>>&\0\fIfileName\fR
.
Both standard output from the last command and standard error from
all commands are redirected to the file named \fIfileName\fR,
appending to it rather than overwriting it.
.TP 15
\fB>@\0\fIfileId\fR
.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
Standard output from the last command is redirected to \fIfileId\fR's
file, which must have been opened for writing.
.TP 15
\fB2>@\0\fIfileId\fR
.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
Standard error from all commands in the pipeline is
redirected to \fIfileId\fR's file.
The file must have been opened for writing.
.TP 15
\fB2>@1\0\fR
.
Standard error from all commands in the pipeline is redirected to the
command result.  This operator is only valid at the end of the command
pipeline.
.TP 15
\fB>&@\0\fIfileId\fR
.
\fIFileId\fR must be the identifier for an open file, such as the return
value from a previous call to \fBopen\fR.
Both standard output from the last command and standard error from
all commands are redirected to \fIfileId\fR's file.
The file must have been opened for writing.
.PP
If standard output has not been redirected then the \fBexec\fR
command returns the standard output from the last command
in the pipeline, unless
in the pipeline,
.VS 8.5
unless
.QW 2>@1
was specified, in which case standard error is included as well.
.VE 8.5
If any of the commands in the pipeline exit abnormally or
are killed or suspended, then \fBexec\fR will return an error
and the error message will include the pipeline's output followed by
error messages describing the abnormal terminations; the
\fB\-errorcode\fR return option will contain additional information
about the last abnormal termination encountered.
If any of the commands writes to its standard error file and that
standard error is not redirected
.VS 8.5
and \fB\-ignorestderr\fR is not specified,
.VE 8.5
then \fBexec\fR will return an error;  the error message
will include the pipeline's standard output, followed by messages
about abnormal terminations (if any), followed by the standard error
output.
.PP
If the last character of the result or error message
is a newline then that character is normally deleted
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
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







-
-
+
+

-
+





-
+










-
+







-
+







Note that the current escape resp. quoting of arguments for windows works only
with executables using CommandLineToArgv, CRT-library or similar, as well as
with the windows batch files (excepting the newline, see below).
Although it is the common escape algorithm, but, in fact, the way how the
executable parses the command-line (resp. splits it into single arguments)
is decisive.
.PP
Unfortunately, there is currently no way to supply newline character within
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
Unfortunately, there is currently no way to supply newline character within 
an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command 
processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
(also the argument chain) on the first newline character.
(also the argument chain) on the first newline character. 
But it works properly with an executable (using CommandLineToArgv, etc).
.PP
The Tk console text widget does not provide real standard IO capabilities.
Under Tk, when redirecting from standard input, all applications will see an
immediate end-of-file; information redirected to standard output or standard
error will be discarded.
error will be discarded.  
.PP
Either forward or backward slashes are accepted as path separators for
arguments to Tcl commands.  When executing an application, the path name
specified for the application may also contain forward or backward slashes
as path separators.  Bear in mind, however, that most Windows applications
accept arguments with forward slashes only as option delimiters and
backslashes only in paths.  Any arguments to an application that specify a
path name with forward slashes will not automatically be converted to use
the backslash character.  If an argument contains forward slashes as the
path separator, it may or may not be recognized as a path name, depending on
the program.
the program.  
.PP
Additionally, when calling a 16-bit DOS or Windows 3.X application, all path
names must use the short, cryptic, path format (e.g., using
.QW applba~1.def
instead of
.QW applbakery.default ),
which can be obtained with the
.QW "\fBfile attributes\fI fileName \fB\-shortname\fR"
.QW "\fBfile attributes \fIfileName \fB\-shortname\fR"
command.
.PP
Two or more forward or backward slashes in a row in a path refer to a
network path.  For example, a simple concatenation of the root directory
\fBc:/\fR with a subdirectory \fB/windows/system\fR will yield
\fBc://windows/system\fR (two slashes together), which refers to the mount
point called \fBsystem\fR on the machine called \fBwindows\fR (and the
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
450
451
452
453
454
455
456
457
458
459
460
461
462

463
464
465
466
467
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
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










-
+
+
+
+

-
+
-
-
+



+
-
+

-
+

-
+

-
+

-
+

-
+








-
+

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


-

+





-








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


-
-
-
-
-
-
-
-
-
-
-
-
-
-














-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-

+












-
+
+
+
+
+
+
+
+














+

+



-


















-
-
-
-
-
-
-
-
-
-
-
-
-

-
+


-
-
-
.RE
.PP
\fBexec\fR will not work well with TUI applications when a console is not
present, as is done when launching applications under wish.  It is desirable
to have console applications hidden and detached.  This is a designed-in
limitation as \fBexec\fR wants to communicate over pipes.  The Expect
extension addresses this issue when communicating with a TUI application.
.PP
.RE
.TP
\fBWindows NT\fR
.
When attempting to execute an application, \fBexec\fR first searches for
the name as it was specified.  Then, in order,
the name as it was specified.  Then, in order, \fB.com\fR, \fB.exe\fR, and
\fB.com\fR, \fB.exe\fR, \fB.bat\fR and \fB.cmd\fR
are appended to the end of the specified name and it searches
\fB.bat\fR are appended to the end of the specified name and it searches
for the longer name.  If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
.RS
.IP \(bu 3
.IP \(bu
The directory from which the Tcl executable was loaded.
.IP \(bu 3
.IP \(bu
The current directory.
.IP \(bu 3
.IP \(bu
The Windows NT 32-bit system directory.
.IP \(bu 3
.IP \(bu
The Windows NT 16-bit system directory.
.IP \(bu 3
.IP \(bu
The Windows NT home directory.
.IP \(bu 3
.IP \(bu
The directories listed in the path.
.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
the caller must prepend the desired command with
.QW "\fBcmd.exe /c\0\fR"
because built-in commands are not implemented using executables.
.RE
.TP
\fBUnix\fR (including Mac OS X)
\fBWindows 9x\fR
.
When attempting to execute an application, \fBexec\fR first searches for
the name as it was specified.  Then, in order, \fB.com\fR, \fB.exe\fR, and
\fB.bat\fR are appended to the end of the specified name and it searches
for the longer name.  If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
.RS
.IP \(bu
The directory from which the Tcl executable was loaded.
.IP \(bu
The current directory.
.IP \(bu
The Windows 9x system directory.
.IP \(bu
The Windows 9x home directory.
.IP \(bu
The directories listed in the path.
.RE
.RS
.PP
In order to execute shell built-in commands like \fBdir\fR and \fBcopy\fR,
the caller must prepend the desired command with
.QW "\fBcommand.com /c\0\fR"
because built-in commands are not implemented using executables.
.PP
Once a 16-bit DOS application has read standard input from a console and 
then quit, all subsequently run 16-bit DOS applications will see the 
standard input as already closed.  32-bit applications do not have this
problem and will run correctly, even after a 16-bit DOS application thinks 
that standard input is closed.  There is no known workaround for this bug
at this time.
.PP
Redirection between the \fBNUL:\fR device and a 16-bit application does not
always work.  When redirecting from \fBNUL:\fR, some applications may hang,
others will get an infinite stream of
.QW 0x01
bytes, and some will actually
correctly get an immediate end-of-file; the behavior seems to depend upon 
something compiled into the application itself.  When redirecting greater than
4K or so to \fBNUL:\fR, some applications will hang.  The above problems do not
happen with 32-bit applications.  
.PP
All DOS 16-bit applications are run synchronously.  All standard input from
a pipe to a 16-bit DOS application is collected into a temporary file; the
other end of the pipe must be closed before the 16-bit DOS application
begins executing.  All standard output or error from a 16-bit DOS
application to a pipe is collected into temporary files; the application
must terminate before the temporary files are redirected to the next stage
of the pipeline.  This is due to a workaround for a Windows 95 bug in the
implementation of pipes, and is how the standard Windows 95 DOS shell
handles pipes itself.
.PP
Certain applications, such as \fBcommand.com\fR, should not be executed
interactively.  Applications which directly access the console window,
rather than reading from their standard input and writing to their standard
output may fail, hang Tcl, or even hang the system if their own private
console window is not available to them.
.RE
.TP
\fBUnix\fR\0\0\0\0\0\0\0
The \fBexec\fR command is fully functional and works as described.
.SH "UNIX EXAMPLES"
.PP
Here are some examples of the use of the \fBexec\fR command on Unix.
.PP
To execute a simple program and get its result:
.PP
.CS
\fBexec\fR uname -a
.CE
.SS "WORKING WITH NON-ZERO RESULTS"
.PP
To execute a program that can return a non-zero result, you should
wrap the call to \fBexec\fR in \fBcatch\fR and check the contents
of the \fB\-errorcode\fR return option if you have an error:
.PP
.CS
set status 0
if {[catch {\fBexec\fR grep foo bar.txt} results options]} {
    set details [dict get $options -errorcode]
    if {[lindex $details 0] eq "CHILDSTATUS"} {
        set status [lindex $details 2]
    } else {
        # Some other error; regenerate it to let caller handle
   set details [dict get $options -errorcode]
   if {[lindex $details 0] eq "CHILDSTATUS"} {
      set status [lindex $details 2]
   } else {
      # Some kind of unexpected failure
        return -options $options -level 0 $results
    }
   }
}
.CE
.PP
This is more easily written using the \fBtry\fR command, as that makes
it simpler to trap specific types of errors. This is
done using code like this:
.PP
.CS
try {
    set results [\fBexec\fR grep foo bar.txt]
    set status 0
} trap CHILDSTATUS {results options} {
    set status [lindex [dict get $options -errorcode] 2]
}
.CE
.SS "WORKING WITH QUOTED ARGUMENTS"
.PP
When translating a command from a Unix shell invocation, care should
be taken over the fact that single quote characters have no special
significance to Tcl.  Thus:
.PP
.CS
awk '{sum += $1} END {print sum}' numbers.list
.CE
.PP
would be translated into something like:
.PP
.CS
\fBexec\fR awk {{sum += $1} END {print sum}} numbers.list
.CE
.SS "WORKING WITH GLOBBING"
.PP
If you are converting invocations involving shell globbing, you should
remember that Tcl does not handle globbing or expand things into
multiple arguments by default.  Instead you should write things like
this:
.PP
.CS
\fBexec\fR ls -l {*}[glob *.tcl]
.CE
.SS "WORKING WITH USER-SUPPLIED SHELL SCRIPT FRAGMENTS"
.PP
One useful technique can be to expose to users of a script the ability
to specify a fragment of shell script to execute that will have some
data passed in on standard input that was produced by the Tcl program.
This is a common technique for using the \fIlpr\fR program for
printing. By far the simplest way of doing this is to pass the user's
script to the user's shell for processing, as this avoids a lot of
complexity with parsing other languages.
.PP
.CS
set lprScript [\fIget from user...\fR]
set postscriptData [\fIgenerate somehow...\fR]

\fBexec\fR $env(SHELL) -c $lprScript << $postscriptData
.CE
.SH "WINDOWS EXAMPLES"
.PP
Here are some examples of the use of the \fBexec\fR command on Windows.
.PP
To start an instance of \fInotepad\fR editing a file without waiting
for the user to finish editing the file:
.PP
.CS
\fBexec\fR notepad myfile.txt &
.CE
.PP
To print a text file using \fInotepad\fR:
.PP
.CS
\fBexec\fR notepad /p myfile.txt
.CE
.SS "WORKING WITH CONSOLE PROGRAMS"
.PP
To print a text file in a directory other than the current one using
\fInotepad\fR, you need to use \fBfile nativename\fR to convert the name into
a form that will be understood by the other program:
.PP
.CS
\fBexec\fR notepad /p [file nativename some/dir/myfile.txt]
.CE
.PP
If a program calls other programs, such as is common with compilers,
then you may need to resort to batch files to hide the console windows
that sometimes pop up:
.PP
.CS
\fBexec\fR cmp.bat somefile.c -o somefile
.CE
.PP
With the file \fIcmp.bat\fR looking something like:
.PP
.CS
@gcc %*
.CE
.PP
or like another variant using single parameters:
.PP
.CS
@gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
.CE
.SS "WORKING WITH COMMAND BUILT-INS"
.PP
Sometimes you need to be careful, as different programs may have the
same name and be in the path. It can then happen that typing a command
at the DOS prompt finds \fIa different program\fR than the same
command run via \fBexec\fR. This is because of the (documented)
differences in behaviour between \fBexec\fR and DOS batch files.
.PP
When in doubt, use the command \fBauto_execok\fR: it will return the
complete path to the program as seen by the \fBexec\fR command.  This
applies especially when you want to run
.QW internal
commands like
\fIdir\fR from a Tcl script (if you just want to list filenames, use
the \fBglob\fR command.)  To do that, use this:
.PP
.CS
\fBexec\fR {*}[auto_execok dir] *.tcl
.CE
.SS "WORKING WITH NATIVE FILENAMES"
.PP
Many programs on Windows require filename arguments to be passed in with
backslashes as pathname separators. This is done with the help of the
\fBfile nativename\fR command. For example, to make a directory (on NTFS)
encrypted so that only the current user can access it requires use of
the \fICIPHER\fR command, like this:
.PP
.CS
set secureDir "~/Desktop/Secure Directory"
file mkdir $secureDir
\fBexec\fR CIPHER /e /s:[file nativename $secureDir]
.CE
.SH "SEE ALSO"
error(n), file(n), open(n)
error(n), open(n)
.SH KEYWORDS
execute, pipeline, redirection, subprocess
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/exit.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
44
45
46
47

48
49

50
51

52
53
54
55
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










-
+

















-




-







-
+









+


+

-
+
-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH exit n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
exit \- End the application
.SH SYNOPSIS
\fBexit \fR?\fIreturnCode\fR?
.BE

.SH DESCRIPTION
.PP
Terminate the process, returning \fIreturnCode\fR to the
system as the exit status.
If \fIreturnCode\fR is not specified then it defaults
to 0.
.SH EXAMPLE
.PP
Since non-zero exit codes are usually interpreted as error cases by
the calling process, the \fBexit\fR command is an important part of
signaling that something fatal has gone wrong. This code fragment is
useful in scripts to act as a general problem trap:
.PP
.CS
proc main {} {
    # ... put the real main code in here ...
}

if {[catch {main} msg options]} {
    puts stderr "unexpected script error: $msg"
    if {[info exists env(DEBUG)]} {
    if {[info exist env(DEBUG)]} {
        puts stderr "---- BEGIN TRACE ----"
        puts stderr [dict get $options -errorinfo]
        puts stderr "---- END TRACE ----"
    }

    # Reserve code 1 for "expected" error exits...
    \fBexit\fR 2
}
.CE

.SH "SEE ALSO"
exec(n)

.SH KEYWORDS
abort, exit, process
exit, process
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/expr.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
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
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
450
451
452
453
454
455
456
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
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







-
+











-
-
-
+
+
+



-
-
+
+



-
+



-
-
-
+
+
+

-
-
-
-
-


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

-
+



-
+
-

-
-
+
+


-
-
+
+
+


+
-
+


-
+
+

-
-
+
+

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

-
-
-
+
+
+
+
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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


-
-
-
-
+
+
+


-
-
+
+
-
+


-
-
-
-
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+








-
-
+


-
-
+



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


-
-
+
+


-
-
+
+


-
-
-
-
+
+
+
+
+
+
+


-
-
+


-
-
+


-
-
+


-
-
-
+
+
+
-
-
+



-
-
-
+
+
+


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

-




-
-
-
-
-
-
-
+

-
+

-
-
+
+





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


+
+
-
-
-
+
+
+





-
+





-
+





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

-
+

+


+
-
-
-
+
+
+
+


-
-
+
+
+
+

-
-
-
+
+
+



-
+

-
-
-
-
+
+
+
+
+













-
+
-

-
+

-
-
+






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


-
+
-
-
-
-
+
+
-

-
-
+
+
-
-
-
+
-
-







-
+
-
-
-
-
+
+
+
+
+

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















+
-
+
-
-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH expr n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
expr \- Evaluate an expression
.SH SYNOPSIS
\fBexpr \fIarg \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fIexpr\fR command concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
that expression, returning its value.
The operators permitted in an expression include a subset of
Concatenates \fIarg\fRs (adding separator spaces between them),
evaluates the result as a Tcl expression, and returns the value.
The operators permitted in Tcl expressions include a subset of
the operators permitted in C expressions.  For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
The value of an expression is often a numeric result, either an integer or a
floating-point value, but may also be a non-numeric value.
Expressions almost always yield numeric results
(integer or floating-point values).
For example, the expression
.PP
.CS
\fBexpr\fR 8.2 + 6
\fBexpr 8.2 + 6\fR
.CE
.PP
evaluates to 14.2.
Expressions differ from C expressions in the way that
operands are specified.  Expressions also support
non-numeric operands, string comparisons, and some
Tcl expressions differ from C expressions in the way that
operands are specified.  Also, Tcl expressions support
non-numeric operands and string comparisons, as well as some
additional operators not found in C.
.PP
When an expression evaluates to an integer, the value is the decimal form of
the integer, and when an expression evaluates to a floating-point number, the
value is the form produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.
.SS OPERANDS
.PP
An expression consists of a combination of operands, operators, parentheses and
commas, possibly with whitespace between any of these elements, which is
ignored.
A Tcl expression consists of a combination of operands, operators,
and parentheses.
White space may be used between the operands and operators and
parentheses; it is ignored by the expression's instructions.
Where possible, operands are interpreted as integer values.
.VS 8.5
Integer values may be specified in decimal (the normal case), in binary
(if the first two characters of the operand are \fB0b\fR), in octal
(if the first two characters of the operand are \fB0o\fR), or in hexadecimal
(if the first two characters of the operand are \fB0x\fR).  For
compatibility with older Tcl releases, an octal integer value is also
indicated simply when the first character of the operand is \fB0\fR,
whether or not the second character is also \fBo\fR.
If an operand does not have one of the integer formats given
above, then it is treated as a floating-point number if that is
possible.  Floating-point numbers may be specified in any of several
common formats making use of the decimal digits, the decimal point \fB.\fR,
the characters \fBe\fR or \fBE\fR indicating scientific notation, and
the sign characters \fB+\fR or \fB\-\fR.  For example, all of the
following are valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
Also recognized as floating point values are the strings \fBInf\fR
and \fBNaN\fR making use of any case for each character.
.VE 8.5
If no numeric interpretation is possible (note that all literal
operands that are not numeric or boolean must be quoted with either
braces or with double quotes), then an operand is left as a string
(and only a limited set of operators may be applied to it).
.PP
An operand may be specified in any of the following ways:
Operands may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
As a boolean value, using any form understood by \fBstring is\fR
As a boolean value, using any form understood by \fBstring is boolean\fR.
\fBboolean\fR.
.IP [3]
As a variable, using standard \fB$\fR notation.
The value of the variable is then the value of the operand.
As a Tcl variable, using standard \fB$\fR notation.
The variable's value will be used as the operand.
.IP [4]
As a string enclosed in double-quotes.
Backslash, variable, and command substitution are performed as described in
\fBTcl\fR.
The expression parser will perform backslash, variable, and
command substitutions on the information between the quotes,
and use the resulting value as the operand
.IP [5]
As a string enclosed in braces.
The characters between the open brace and matching close brace
The operand is treated as a braced value as described in \fBTcl\fR.
will be used as the operand without any substitutions.
.IP [6]
As a Tcl command enclosed in brackets.
Command substitution is performed as described in \fBTcl\fR.
The command will be executed and its result will be used as
the operand.
.IP [7]
As a mathematical function such as \fBsin($x)\fR, whose arguments have any of the above
forms for operands.  See \fBMATH FUNCTIONS\fR below for
As a mathematical function whose arguments have any of the above
forms for operands, such as \fBsin($x)\fR.  See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
.PP
Because \fBexpr\fR parses and performs substitutions on values that have
already been parsed and substituted by \fBTcl\fR, it is usually best to enclose
expressions in braces to avoid the first round of substitutions by
.LP
Where the above substitutions occur (e.g. inside quoted strings), they
are performed by the expression's instructions.
However, the command parser may already have performed one round of
substitution before the expression processor was called.
As discussed below, it is usually best to enclose expressions
in braces to prevent the command parser from performing substitutions
\fBTcl\fR.
on the contents.
.PP
Below are some examples of simple expressions where the value of \fBa\fR is 3
and the value of \fBb\fR is 6.  The command on the left side of each line
produces the value on the right side.
For some examples of simple expressions, suppose the variable
\fBa\fR has the value 3 and
the variable \fBb\fR has the value 6.
Then the command on the left side of each of the lines below
will produce the value on the right side of the line:
.PP
.CS
.ta 9c
\fBexpr\fR 3.1 + $a	\fI6.1\fR
\fBexpr\fR 2 + "$a.$b"	\fI5.6\fR
\fBexpr\fR 4*[llength "6 2"]	\fI8\fR
\fBexpr\fR {{word one} < "word $a"}	\fI0\fR
.CE
.PP
\fBInteger value\fR
.PP
An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
(the first two characters are \fB0x\fR) form.  For
.PP
\fBFloating-point value\fR
.PP
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
the sign characters \fB+\fR and \fB\-\fR.  The
following are all valid floating-point numbers:  2.1, 3., 6e4, 7.91e+16.
The strings \fBInf\fR
and \fBNaN\fR, in any combination of case, are also recognized as floating point
values.  An operand that doesn't have a numeric interpretation must be quoted
with either braces or with double quotes.
.PP
\fBBoolean value\fR
.PP
A boolean value may be represented by any of the values \fB0\fR, \fBfalse\fR, \fBno\fR,
or \fBoff\fR and any of the values \fB1\fR, \fBtrue\fR, \fByes\fR, or \fBon\fR.
.PP
\fBDigit Separator\fR
.PP
Digits in any numeric value may be separated with one or more underscore
characters, "\fB_\fR", to improve readability.  These separators may only
appear between digits.  The separator may not appear at the start of a
numeric value, between the leading 0 and radix specifier, or at the
end of a numeric value.  Here are some examples:
.PP
.CS
.ta 9c
\fBexpr\fR 100_000_000		\fI100000000\fR
\fBexpr\fR 0xffff_ffff		\fI4294967295\fR
\fBformat\fR 0x%x 0b1111_1110_1101_1011		\fI0xfedb\fR
.CE
.PP
.SS OPERATORS
.PP
For operators having both a numeric mode and a string mode, the numeric mode is
chosen when all operands have a numeric interpretation.  The integer
interpretation of an operand is preferred over the floating-point
interpretation.  To ensure string operations on arbitrary values it is generally a
good idea to use \fBeq\fR, \fBne\fR, or the \fBstring\fR command instead of
more versatile operators such as \fB==\fR.
.PP
Unless otherwise specified, operators accept non-numeric operands.  The value
of a boolean operation is 1 if true, 0 otherwise.  See also \fBstring is\fR
\fBboolean\fR.  The valid operators, most of which are also available as
commands in the \fBtcl::mathop\fR namespace (see \fBmathop\fR(n)), are listed
below, grouped in decreasing order of precedence:
The valid operators (most of which are also available as commands in
the \fBtcl::mathop\fR namespace; see the \fBmathop\fR(n) manual page
for details) are listed below, grouped in decreasing order of precedence:
.TP 20
\fB\-\0\0+\0\0~\0\0!\fR
.
Unary minus, unary plus, bit-wise NOT, logical NOT.  These operators
may only be applied to numeric operands, and bit-wise NOT may only be
applied to integers.
Unary minus, unary plus, bit-wise NOT, logical NOT.  None of these operators
may be applied to string operands, and bit-wise NOT may be
applied only to integers.
.TP 20
\fB**\fR
.
Exponentiation.  Valid for numeric operands.  The maximum exponent value
.VS 8.5
Exponentiation.  Valid for any numeric operands.
that Tcl can handle if the first number is an integer > 1 is 268435455.
.VE 8.5
.TP 20
\fB*\0\0/\0\0%\fR
.
Multiply and divide, which are valid for numeric operands, and remainder, which
is valid for integers.  The remainder, an absolute value smaller than the
absolute value of the divisor, has the same sign as the divisor.
Multiply, divide, remainder.  None of these operators may be
applied to string operands, and remainder may be applied only
to integers.
The remainder will always have the same sign as the divisor and
an absolute value smaller than the absolute value of the divisor.
.RS
.PP
When applied to integers, division and remainder can be
considered to partition the number line into a sequence of
adjacent non-overlapping pieces, where each piece is the size of the divisor;
the quotient identifies which piece the dividend lies within, and the
remainder identifies where within that piece the dividend lies. A
When applied to integers, the division and remainder operators can be
considered to partition the number line into a sequence of equal-sized
adjacent non-overlapping pieces where each piece is the size of the divisor;
the division result identifies which piece the divisor lay within, and the
remainder result identifies where within that piece the divisor lay. A
consequence of this is that the result of
.QW "-57 \fB/\fR 10"
is always -6, and the result of
.QW "-57 \fB%\fR 10"
is always 3.
.RE
.TP 20
\fB+\0\0\-\fR
.
Add and subtract.  Valid for numeric operands.
Add and subtract.  Valid for any numeric operands.
.TP 20
\fB<<\0\0>>\fR
.
Left and right shift.  Valid for integers.
Left and right shift.  Valid for integer operands only.
A right shift always propagates the sign bit.
.TP 20
\fB<\0\0>\0\0<=\0\0>=\fR
.
Boolean numeric-preferring comparisons: less than, greater than, less than or
equal, and greater than or equal. If either argument is not numeric, the
Boolean less, greater, less than or equal, and greater than or equal.
comparison is done using UNICODE string comparison, as with the string
comparison operators below, which have the same precedence.
Each operator produces 1 if the condition is true, 0 otherwise.
These operators may be applied to strings as well as numeric operands,
.TP 20
\fBlt\0\0gt\0\0le\0\0ge\fR
.VS "8.7, TIP461"
Boolean string comparisons: less than, greater than, less than or equal, and
in which case string comparison is used.
greater than or equal. These always compare values using their UNICODE strings
(also see \fBstring compare\fR), unlike with the numeric-preferring
comparisons abov, which have the same precedence.
.VE "8.7, TIP461"
.TP 20
\fB==\0\0!=\fR
.
Boolean equal and not equal.
Boolean equal and not equal.  Each operator produces a zero/one result.
Valid for all operand types.
.TP 20
\fBeq\0\0ne\fR
.
Boolean string equal and string not equal.
Boolean string equal and string not equal.  Each operator produces a
zero/one result.  The operand types are interpreted only as strings.
.TP 20
\fBin\0\0ni\fR
.
List containment and negated list containment.  The first argument is
interpreted as a string, the second as a list.  \fBin\fR tests for membership
in the list, and \fBni\fR is the inverse.
.VS 8.5
List containment and negated list containment.  Each operator produces
a zero/one result and treats its first argument as a string and its
second argument as a Tcl list.  The \fBin\fR operator indicates
whether the first argument is a member of the second argument list;
the \fBni\fR operator inverts the sense of the result.
.VE 8.5
.TP 20
\fB&\fR
.
Bit-wise AND.  Valid for integer operands.
Bit-wise AND.  Valid for integer operands only.
.TP 20
\fB^\fR
.
Bit-wise exclusive OR.  Valid for integer operands.
Bit-wise exclusive OR.  Valid for integer operands only.
.TP 20
\fB|\fR
.
Bit-wise OR.  Valid for integer operands.
Bit-wise OR.  Valid for integer operands only.
.TP 20
\fB&&\fR
.
Logical AND.  If both operands are true, the result is 1, or 0 otherwise.
This operator evaluates lazily; it only evaluates its second operand if it
Logical AND.  Produces a 1 result if both operands are non-zero,
0 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
must in order to determine its result.
This operator evaluates lazily; it only evaluates its second operand if it
This operator evaluates lazily; it only evaluates its right-hand side if it
must in order to determine its result.
.TP 20
\fB||\fR
.
Logical OR.  If both operands are false, the result is 0, or 1 otherwise.
This operator evaluates lazily; it only evaluates its second operand if it
Logical OR.  Produces a 0 result if both operands are zero, 1 otherwise.
Valid for boolean and numeric (integers or floating-point) operands only.
This operator evaluates lazily; it only evaluates its right-hand side if it
must in order to determine its result.
.TP 20
\fIx \fB?\fI y \fB:\fI z\fR
\fIx \fB? \fIy \fB: \fIz\fR
.
If-then-else, as in C.  If \fIx\fR is false , the result is the value of
\fIy\fR.  Otherwise the result is the value of \fIz\fR.
This operator evaluates lazily; it evaluates only one of \fIy\fR or \fIz\fR.
.PP
The exponentiation operator promotes types in the same way that the multiply
and divide operators do, and the result is is the same as the result of
\fBpow\fR.
Exponentiation groups right-to-left within a precedence level. Other binary
operators group left-to-right.  For example, the value of
If-then-else, as in C.  If \fIx\fR
evaluates to non-zero, then the result is the value of \fIy\fR.
Otherwise the result is the value of \fIz\fR.
The \fIx\fR operand must have a boolean or numeric value.
This operator evaluates lazily; it only evaluates one of \fIy\fR or \fIz\fR.
.LP
See the C manual for more details on the results
produced by each operator.
.VS 8.5
The exponentiation operator promotes types like the multiply and
divide operators, and produces a result that is the same as the output
of the \fBpow\fR function (after any type conversions.)
.VE 8.5
All of the binary operators group left-to-right within the same
precedence level.  For example, the command
.PP
.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
is 0, while the value of
.PP
.CS
\fBexpr\fR {2**3**2}
.CE
.PP
is 512.
returns 0.
.PP
As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have
.QW "lazy evaluation" ,
which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in
just as in C, which means that operands are not evaluated if they are
not needed to determine the outcome.  For example, in the command
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
.CE
.PP
only one of \fB[a]\fR or \fB[b]\fR is evaluated,
depending on the value of \fB$v\fR.  This is not true of the normal Tcl parser,
only one of
.QW \fB[a]\fR
or
.QW \fB[b]\fR
will actually be evaluated,
depending on the value of \fB$v\fR.  Note, however, that this is
so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
Without braces, as in
\fBexpr\fR $v ? [a] : [b]
both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
only true if the entire expression is enclosed in braces;  otherwise
the Tcl parser will evaluate both
.QW \fB[a]\fR
and
.QW \fB[b]\fR
.PP
For more details on the results
before invoking the \fBexpr\fR command.
produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
.VS 8.5
When the expression parser encounters a mathematical function
A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary
Tcl command in the \fBtcl::mathfunc\fR namespace.  The evaluation
of an expression such as
such as \fBsin($x)\fR, it replaces it with a call to an ordinary
Tcl command in the \fBtcl::mathfunc\fR namespace.  The processing
of an expression such as:
.PP
.CS
\fBexpr\fR {sin($x+$y)}
.CE
.PP
is the same in every way as the evaluation of
is the same in every way as the processing of:
.PP
.CS
\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]}
.CE
.PP
which in turn is the same as the evaluation of
which in turn is the same as the processing of:
.PP
.CS
tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
.CE
.PP
\fBtcl::mathfunc::sin\fR is resolved as described in
The executor will search for \fBtcl::mathfunc::sin\fR using the usual
\fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation.   Given the
default value of \fBnamespace path\fR, \fB[namespace
current]::tcl::mathfunc::sin\fR or \fB::tcl::mathfunc::sin\fR are the typical
rules for resolving functions in namespaces. Either
\fB::tcl::mathfunc::sin\fR or \fB[namespace
resolutions.
.PP
As in C, a mathematical function may accept multiple arguments separated by commas. Thus,
.PP
.CS
\fBexpr\fR {hypot($x,$y)}
.CE
.PP
becomes
.PP
.CS
tcl::mathfunc::hypot $x $y
current]::tcl::mathfunc::sin\fR will satisfy the request, and others
.CE
may as well (depending on the current \fBnamespace path\fR setting).
.PP
See the \fBmathfunc\fR(n) documentation for the math functions that are
See the \fBmathfunc\fR(n) manual page for the math functions that are
available by default.
.VE 8.5
.SS "TYPES, OVERFLOW, AND PRECISION"
.PP
.VS 8.5
When needed to guarantee exact performance, internal computations involving
integers use the LibTomMath multiple precision integer library.  In Tcl releases
prior to 8.5, integer calculations were performed using one of the C types
All internal computations involving integers are done calling on the
LibTomMath multiple precision integer library as required so that all
integer calculations are performed exactly.  Note that in Tcl releases
prior to 8.5, integer calculations were performed with one of the C types
\fIlong int\fR or \fITcl_WideInt\fR, causing implicit range truncation
in those calculations where values overflowed the range of those types.
Any code that relied on these implicit truncations should instead call
\fBint()\fR or \fBwide()\fR, which do truncate.
Any code that relied on these implicit truncations will need to explicitly
add \fBint()\fR or \fBwide()\fR function calls to expressions at the points
where such truncation is required to take place.
.VE 8.5
.PP
Internal floating-point computations are
performed using the \fIdouble\fR C type.
When converting a string to floating-point value, exponent overflow is
All internal computations involving floating-point are
done with the C type \fIdouble\fR.
When converting a string to floating-point, exponent overflow is
detected and results in the \fIdouble\fR value of \fBInf\fR or
\fB\-Inf\fR as appropriate.  Floating-point overflow and underflow
are detected to the degree supported by the hardware, which is generally
fairly reliable.
pretty reliable.
.PP
Conversion among internal representations for integer, floating-point, and
string operands is done automatically as needed.  For arithmetic computations,
integers are used until some floating-point number is introduced, after which
floating-point values are used.  For example,
Conversion among internal representations for integer, floating-point,
and string operands is done automatically as needed.
For arithmetic computations, integers are used until some
floating-point number is introduced, after which floating-point is used.
For example,
.PP
.CS
\fBexpr\fR {5 / 4}
.CE
.PP
returns 1, while
.PP
.CS
\fBexpr\fR {5 / 4.0}
\fBexpr\fR {5 / ( [string length "abcd"] + 0.0 )}
.CE
.PP
both return 1.25.
A floating-point result can be distinguished from an integer result by the
Floating-point values are always returned with a
presence of either
.QW \fB.\fR
or
or an
.QW \fBe\fR
.PP
. For example,
so that they will not look like integer values.  For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
.SS "STRING OPERATIONS"
.PP
String values may be used as operands of the comparison operators,
although the expression evaluator tries to do comparisons as integer
or floating-point when it can,
i.e., when all arguments to the operator allow numeric interpretations,
except in the case of the \fBeq\fR and \fBne\fR operators.
If one of the operands of a comparison is a string and the other
has a numeric value, a canonical string representation of the numeric
operand value is generated to compare with the string operand.
Canonical string representation for integer values is a decimal string
format.  Canonical string representation for floating-point values
is that produced by the \fB%g\fR format specifier of Tcl's
\fBformat\fR command.  For example, the commands
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
both return 1.  The first comparison is done using integer
comparison, and the second is done using string comparison.
Because of Tcl's tendency to treat values as numbers whenever
possible, it is not generally a good idea to use operators like \fB==\fR
when you really want string comparison and the values of the
operands could be arbitrary;  it is better in these cases to use
the \fBeq\fR or \fBne\fR operators, or the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
.PP
Where an expression contains syntax that Tcl would otherwise perform
Enclose expressions in braces for the best speed and the smallest
substitutions on, enclosing an expression in braces or otherwise quoting it
so that it's a static value allows the Tcl compiler to generate bytecode for
the expression, resulting in better speed and smaller storage requirements.
This also avoids issues that can arise if Tcl is allowed to perform
storage requirements.
This allows the Tcl bytecode compiler to generate the best code.
substitution on the value before \fBexpr\fR is called.
.PP
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part
As mentioned above, expressions are substituted twice:
once by the Tcl parser and once by the \fBexpr\fR command.
of evaluating the expression
.QW "$a + 2*4" .
Enclosing the
For example, the commands
expression in braces would result in a syntax error as \fB$b\fR does
not evaluate to a numeric value.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP
When an expression is generated at runtime, like the one above is, the bytecode
return 11, not a multiple of 4.
compiler must ensure that new code is generated each time the expression
is evaluated.  This is the most costly kind of expression from a performance
perspective.  In such cases, consider directly using the commands described in
the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR.
This is because the Tcl parser will first substitute
.QW "\fB$a + 2\fR"
for the variable \fBb\fR,
then the \fBexpr\fR command will evaluate the expression
.QW "\fB$a + 2*4\fR" .
.PP
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions.  To allow the bytecode
Most expressions do not require a second round of substitutions.
Either they are enclosed in braces or, if not,
their variable and command substitutions yield numbers or strings
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
that do not themselves require substitutions.
However, because a few unbraced expressions 
need two rounds of substitutions,
the bytecode compiler must emit
additional instructions to handle this situation.
The most expensive code is required for
unbraced expressions that contain command substitutions.
These expressions must be implemented by generating new code
each time the expression is executed.
.PP
If it is necessary to include a non-constant expression string within the
wider context of an otherwise-constant expression, the most efficient
technique is to put the varying part inside a recursive \fBexpr\fR, as this at
least allows for the compilation of the outer part, though it does mean that
the varying part must itself be evaluated as a separate expression. Thus, in
this example the result is 20 and the outer expression benefits from fully
cached bytecode compilation.
.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR {[\fBexpr\fR $b] * 4}
.CE
.PP
.VS 8.5
In general, you should enclose your expression in braces wherever possible,
When the expression is unbraced to allow the substitution of a function or
and where not possible, the argument to \fBexpr\fR should be an expression
defined elsewhere as simply as possible. It is usually more efficient and
safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR
namespace) than it is to do complex expression generation.
operator, consider using the commands documented in the \fBmathfunc\fR(n) or
\fBmathop\fR(n) manual pages directly instead.
.VE 8.5
.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
.PP
A string comparison whose result is 1:
.PP
.CS
\fBexpr\fR {"0y" > "0x12"}
.CE
.PP
.VS "8.7, TIP461"
A forced string comparison whose result is 0:
.PP
.CS
\fBexpr\fR {"0x03" gt "2"}
.CE
.VE "8.7, TIP461"
.PP
Define a procedure that computes an
.QW interesting
mathematical function:
.PP
.CS
proc tcl::mathfunc::calc {x y} {
    \fBexpr\fR { ($x**2 - $y**2) / exp($x**2 + $y**2) }
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
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










-
-
+
+

















-
+


-
-
-
+
+
+

-
-
-
Print a message describing the relationship of two string values to
each other:
.PP
.CS
puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]"
.CE
.PP
Set a variable indicating whether an environment variable is defined and has
value of true:
Set a variable to whether an environment variable is both defined at
all and also set to a true boolean value:
.PP
.CS
set isTrue [\fBexpr\fR {
    [info exists ::env(SOME_ENV_VAR)] &&
    [string is true -strict $::env(SOME_ENV_VAR)]
}]
.CE
.PP
Generate a random integer in the range 0..99 inclusive:
.PP
.CS
set randNum [\fBexpr\fR { int(100 * rand()) }]
.CE
.SH "SEE ALSO"
array(n), for(n), if(n), mathfunc(n), mathop(n), namespace(n), proc(n),
string(n), Tcl(n), while(n)
.SH KEYWORDS
arithmetic, boolean, compare, expression, fuzzy comparison, integer value
arithmetic, boolean, compare, expression, fuzzy comparison
.SH COPYRIGHT
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
Copyright (c) 1993 The Regents of the University of California.
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved.
.fi
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/fblocked.n.

1

2
3
4
5
6
7

8
9
10
11
12
13
14

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






+







'\"
'\" 
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH fblocked n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fblocked \- Test whether the last input operation exhausted all available input
.SH SYNOPSIS
\fBfblocked \fIchannelId\fR
.BE
57
58
59
60
61
62
63

64
65

66
67
68
69
70
71
58
59
60
61
62
63
64
65
66
67
68
69
70











+


+


-
-
-
-
}

# Create the server socket and enter the event-loop to wait
# for incoming connections...
socket -server connect 12345
vwait forever
.CE

.SH "SEE ALSO"
gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)

.SH KEYWORDS
blocking, nonblocking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/fconfigure.n.

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







'\"
'\" 
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH fconfigure n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
35
36
37
38
39
40
41

42

43
44
45
46
47
48
49







-
+
-







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
entry for the \fBsocket\fR command for its additional options.
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 \fBgets\fR,
68
69
70
71
72
73
74
75
76


77
78
79
80
81
82
83
67
68
69
70
71
72
73


74
75
76
77
78
79
80
81
82







-
-
+
+







is \fBline\fR.  Additionally, \fBstdin\fR and \fBstdout\fR are
initially set to \fBline\fR, and \fBstderr\fR is set to \fBnone\fR.
.TP
\fB\-buffersize\fR \fInewSize\fR
.
\fINewvalue\fR must be an integer; its value is used to set the size of
buffers, in bytes, subsequently allocated for this channel to store input
or output. \fINewvalue\fR must be between one and one million, allowing
buffers of one to one million bytes in size.
or output. \fINewvalue\fR must be between ten and one million, allowing
buffers of ten to one million bytes in size.
.TP
\fB\-encoding\fR \fIname\fR
.
This option is used to specify the encoding of the channel, so that the data
can be converted to and from Unicode for use in Tcl.  For instance, in
order for Tcl to read characters from a Japanese file in \fBshiftjis\fR
and properly process and display the contents, the encoding would be set
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
120
121
122
123
124
125
126

127
128
129
130
131
132
133
134







-
+







reading and the empty string for writing.
The acceptable range for \fB\-eofchar\fR values is \ex01 - \ex7f;
attempting to set \fB\-eofchar\fR to a value outside of this range will
generate an error.
.TP
\fB\-translation\fR \fImode\fR
.TP
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR
\fB\-translation\fR \fB{\fIinMode outMode\fB}\fR 
.
In Tcl scripts the end of a line is always represented using a single
newline character (\en).  However, in actual files and devices the end of
a line may be represented differently on different platforms, or even for
different devices on the same platform.  For example, under UNIX newlines
are used in files, whereas carriage-return-linefeed sequences are
normally used in network connections.  On input (i.e., with \fBgets\fR
159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172







-
+







representation can even change from line-to-line, and all cases are
translated to a newline.  As the output translation mode, \fBauto\fR
chooses a platform specific representation; for sockets on all platforms
Tcl chooses \fBcrlf\fR, for all Unix flavors, it chooses \fBlf\fR, and
for the various flavors of Windows it chooses \fBcrlf\fR.  The default
setting for \fB\-translation\fR is \fBauto\fR for both input and output.
.TP
\fBbinary\fR
\fBbinary\fR 
.
No end-of-line translations are performed.  This is nearly identical to
\fBlf\fR mode, except that in addition \fBbinary\fR mode also sets the
end-of-file character to the empty string (which disables it) and sets the
encoding to \fBbinary\fR (which disables encoding filtering).  See the
description of \fB\-eofchar\fR and \fB\-encoding\fR for more information.
.RS
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
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










-


-






-





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




-







-
+






-
-
-
+
+
+














+



+




-
-
-
can be configured through this command like every other channel opened
by the Tcl library. Beyond the standard options described above they
will also support any special option according to their current type.
If, for example, a Tcl application is started by the \fBinet\fR
super-server common on Unix system its Tcl standard channels will be
sockets and thus support the socket options.
.SH EXAMPLES
.PP
Instruct Tcl to always send output to \fBstdout\fR immediately,
whether or not it is to a terminal:
.PP
.CS
\fBfconfigure\fR stdout -buffering none
.CE
.PP
Open a socket and read lines from it without ever blocking the
processing of other events:
.PP
.CS
set s [socket some.where.com 12345]
\fBfconfigure\fR $s -blocking 0
fileevent $s readable "readMe $s"
proc readMe chan {
    if {[gets $chan line] < 0} {
        if {[eof $chan]} {
            close $chan
            return
        }
        # Could not read a complete line this time; Tcl's
        # internal buffering will hold the partial line for us
        # until some more data is available over the socket.
    } else {
        puts stdout $line
    }
   if {[gets $chan line] < 0} {
      if {[eof $chan]} {
         close $chan
         return
      }
      # Could not read a complete line this time; Tcl's
      # internal buffering will hold the partial line for us
      # until some more data is available over the socket.
   } else {
      puts stdout $line
   }
}
.CE
.PP
Read a PPM-format image from a file:
.PP
.CS
# Open the file and put it into Unix ASCII mode
set f [open teapot.ppm]
\fBfconfigure\fR $f \-encoding ascii \-translation lf

# Get the header
if {[gets $f] ne "P6"} {
    error "not a raw\-bits PPM"
   error "not a raw\-bits PPM"
}

# Read lines until we have got non-comment lines
# that supply us with three decimal values.
set words {}
while {[llength $words] < 3} {
    gets $f line
    if {[string match "#*" $line]} continue
    lappend words {*}[join [scan $line %d%d%d]]
   gets $f line
   if {[string match "#*" $line]} continue
   lappend words {*}[join [scan $line %d%d%d]]
}

# Those words supply the size of the image and its
# overall depth per channel. Assign to variables.
lassign $words xSize ySize depth

# Now switch to binary mode to pull in the data,
# one byte per channel (red,green,blue) per pixel.
\fBfconfigure\fR $f \-translation binary
set numDataBytes [expr {3 * $xSize * $ySize}]
set data [read $f $numDataBytes]

close $f
.CE

.SH "SEE ALSO"
close(n), flush(n), gets(n), open(n), puts(n), read(n), socket(n),
Tcl_StandardChannels(3)

.SH KEYWORDS
blocking, buffering, carriage return, end of line, flushing, linemode,
newline, nonblocking, platform, translation, encoding, filter, byte array,
binary
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/fcopy.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
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
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






-
+


















-
+

-
+
-
-
-
+



-
+
-





-
+









-
-
+
+
-
-
-









-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH fcopy n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fcopy \- Copy data from one channel to another
.SH SYNOPSIS
\fBfcopy \fIinchan\fR \fIoutchan\fR ?\fB\-size \fIsize\fR? ?\fB\-command \fIcallback\fR?
.BE

.SH DESCRIPTION
.PP
The \fBfcopy\fR command copies data from one I/O channel, \fIinchan\fR to another I/O channel, \fIoutchan\fR.
The \fBfcopy\fR command leverages the buffering in the Tcl I/O system to
avoid extra copies and to avoid buffering too much data in
main memory when copying large files to slow destinations like
network sockets.
.PP
The \fBfcopy\fR
The \fBfcopy\fR 
command transfers data from \fIinchan\fR until end of file
or \fIsize\fR bytes or characters have been
or \fIsize\fR bytes have been 
transferred; \fIsize\fR is in bytes if the two channels are using the
same encoding, and is in characters otherwise.
If no \fB\-size\fR argument is given,
transferred. If no \fB\-size\fR argument is given,
then the copy goes until end of file.
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
and returns the number of bytes or characters (using the same rules as
and returns the number of bytes written to \fIoutchan\fR.
for the \fB\-size\fR option) written to \fIoutchan\fR.
.PP
The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
In this case it returns immediately and the \fIcallback\fR is invoked
later when the copy completes.
The \fIcallback\fR is called with
one or two additional
one or two additional 
arguments that indicates how many bytes were written to \fIoutchan\fR.
If an error occurred during the background copy, the second argument is the
error string associated with the error.
With a background copy,
it is not necessary to put \fIinchan\fR or \fIoutchan\fR into
non-blocking mode; the \fBfcopy\fR command takes care of that automatically.
However, it is necessary to enter the event loop by using
the \fBvwait\fR command or by using Tk.
.PP
You are not allowed to do other input operations with \fIinchan\fR, or
output operations with \fIoutchan\fR, during a background
You are not allowed to do other I/O operations with
\fIinchan\fR or \fIoutchan\fR during a background \fBfcopy\fR.
\fBfcopy\fR. The converse is entirely legitimate, as exhibited by the
bidirectional fcopy example below.
.PP
If either \fIinchan\fR or \fIoutchan\fR get closed
while the copy is in progress, the current copy is stopped
and the command callback is \fInot\fR made.
If \fIinchan\fR is closed,
then all data already queued for \fIoutchan\fR is written out.
.PP
Note that \fIinchan\fR can become readable during a background copy.
You should turn off any \fBfileevent\fR handlers during a background
copy so those handlers do not interfere with the copy.
Any wrong-sided I/O attempted (by a \fBfileevent\fR handler or otherwise) will get a
Any I/O attempted by a \fBfileevent\fR handler will get a
.QW "channel busy"
error.
.PP
\fBFcopy\fR translates end-of-line sequences in \fIinchan\fR and \fIoutchan\fR
according to the \fB\-translation\fR option
for these channels.
See the manual entry for \fBfconfigure\fR for details on the
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
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










+






-









-
+

-







-
+









-
+
-





-
-
-
+
+
+

-
+











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


+


-
-
-
the system will write the internal UTF-8 representation of the incoming
characters. If only the input channel is set to encoding
.QW binary
the system will assume that the incoming
bytes are valid UTF-8 characters and convert them according to the
output encoding. The behaviour of the system for bytes which are not
valid UTF-8 characters is undefined in this case.

.SH EXAMPLES
.PP
The first example transfers the contents of one channel exactly to
another. Note that when copying one file to another, it is better to
use \fBfile copy\fR which also copies file metadata (e.g. the file
access permissions) where possible.
.PP
.CS
fconfigure $in -translation binary
fconfigure $out -translation binary
\fBfcopy\fR $in $out
.CE
.PP
This second example shows how the callback gets
passed the number of bytes transferred.
It also uses vwait to put the application into the event loop.
Of course, this simplified example could be done without the command
Of course, this simplified example could be done without the command 
callback.
.PP
.CS
proc Cleanup {in out bytes {error {}}} {
    global total
    set total $bytes
    close $in
    close $out
    if {[string length $error] != 0} {
        # error occurred during the copy
	# error occurred during the copy
    }
}
set in [open $file1]
set out [socket $server $port]
\fBfcopy\fR $in $out -command [list Cleanup $in $out]
vwait total
.CE
.PP
The third example copies in chunks and tests for end of file
in the command callback.
in the command callback
.PP
.CS
proc CopyMore {in out chunk bytes {error {}}} {
    global total done
    incr total $bytes
    if {([string length $error] != 0) || [eof $in]} {
        set done $total
        close $in
        close $out
	set done $total
	close $in
	close $out
    } else {
        \fBfcopy\fR $in $out -size $chunk \e
	\fBfcopy\fR $in $out -size $chunk \e
                -command [list CopyMore $in $out $chunk]
    }
}
set in [open $file1]
set out [socket $server $port]
set chunk 1024
set total 0
\fBfcopy\fR $in $out -size $chunk \e
        -command [list CopyMore $in $out $chunk]
vwait done
.CE
.PP
The fourth example starts an asynchronous, bidirectional fcopy between
two sockets. Those could also be pipes from two [open "|hal 9000" r+]
(though their conversation would remain secret to the script, since
all four fileevent slots are busy).
.PP
.CS
set flows 2
proc Done {dir args} {
     global flows done
     puts "$dir is over."
     incr flows -1
     if {$flows<=0} {set done 1}
}

\fBfcopy\fR $sok1 $sok2 -command [list Done UP]
\fBfcopy\fR $sok2 $sok1 -command [list Done DOWN]
vwait done
.CE
.SH "SEE ALSO"
eof(n), fblocked(n), fconfigure(n), file(n)

.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/file.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
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
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






-
+


















-
+










-
+

-
+

-
-
-
-
-
+
+
+
+
+


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




















-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH file n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
file \- Manipulate file names and attributes
.SH SYNOPSIS
\fBfile \fIoption\fR \fIname\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides several operations on a file's name or attributes.
\fIName\fR is the name of a file; if it starts with a tilde, then tilde
substitution is done before executing the command (see the manual entry for
\fBfilename\fR for details).  \fIOption\fR indicates what to do with the
file name.  Any unique abbreviation for \fIoption\fR is acceptable.  The
valid options are:
.TP
\fBfile atime \fIname\fR ?\fItime\fR?
\fBfile atime \fIname\fR ?\fBtime\fR?
.
Returns a decimal string giving the time at which file \fIname\fR was last
accessed.  If \fItime\fR is specified, it is an access time to set
for the file.  The time is measured in the standard POSIX fashion as
seconds from a fixed starting time (often January 1, 1970).  If the file
does not exist or its access time cannot be queried or set then an error is
generated.  On Windows, FAT file systems do not support access time.
.TP
\fBfile attributes \fIname\fR
.TP
\fBfile attributes \fIname\fR ?\fIoption\fR?
\fBfile attributes \fIname\fR ?\fBoption\fR?
.TP
\fBfile attributes \fIname\fR ?\fIoption value option value...\fR?
\fBfile attributes \fIname\fR ?\fBoption value option value...\fR?
.
This subcommand returns or sets platform specific values associated
with a file. The first form returns a list of the platform specific
flags and their values. The second form returns the value for the
specific option. The third form sets one or more of the values. The
values are as follows:
This subcommand returns or sets platform-specific values associated
with a file. The first form returns a list of the platform-specific
options and their values. The second form returns the value for the
given option. The third form sets one or more of the values. The values
are as follows:
.RS
.PP
On Unix, \fB\-group\fR gets or sets the group name for the file. A group id
can be given to the command, but it returns a group name. \fB\-owner\fR gets
or sets the user name of the owner of the file. The command returns the
owner name, but the numerical id can be passed when setting the
owner. \fB\-permissions\fR sets or retrieves the octal code that chmod(1)
uses.  This command does also has limited support for setting using the
On Unix, \fB\-group\fR gets or sets the group name for the file. A
group id can be given to the command, but it returns a group name.
\fB\-owner\fR gets or sets the user name of the owner of the file. The
command returns the owner name, but the numerical id can be passed when
setting the owner. \fB\-permissions\fR retrieves or sets a file's
access permissions, using octal notation by default. This option also
provides limited support for setting permissions using the symbolic
symbolic attributes for chmod(1), of the form [ugo]?[[+\-=][rwxst],[...]],
where multiple symbolic attributes can be separated by commas (example:
\fBu+s,go\-rw\fR add sticky bit for user, remove read and write
permissions for group and other).  A simplified \fBls\fR style string,
of the form rwxrwxrwx (must be 9 characters), is also supported
(example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
On versions of Unix supporting file flags, \fB\-readonly\fR gives the
value or sets or clears the readonly attribute of the file,
i.e. the user immutable flag \fBuchg\fR to chflags(1).
notation accepted by the \fBchmod\fR command, following the form
[\fBugo\fR]?[[\fB+-=\fR][\fBrwxst\fR]\fB,\fR[...]]. Multiple permission
specifications may be given, separated by commas. E.g., \fBu+s,go-rw\fR
would set the setuid bit for a file's owner as well as remove read and
write permission for the file's group and other users. An
\fBls\fR-style string of the form \fBrwxrwxrwx\fR is also accepted but
must always be 9 characters long. E.g., \fBrwxr-xr-t\fR is equivalent
to \fB01755\fR. On versions of Unix supporting file flags,
\fB-readonly\fR returns the value of, or sets, or clears the readonly
attribute of a file, i.e., the user immutable flag (\fBuchg\fR) to the
\fBchflags\fR command.
.PP
On Windows, \fB\-archive\fR gives the value or sets or clears the
archive attribute of the file. \fB\-hidden\fR gives the value or sets
or clears the hidden attribute of the file. \fB\-longname\fR will
expand each path element to its long version. This attribute cannot be
set. \fB\-readonly\fR gives the value or sets or clears the readonly
attribute of the file. \fB\-shortname\fR gives a string where every
path element is replaced with its short (8.3) version of the
name. This attribute cannot be set. \fB\-system\fR gives or sets or
clears the value of the system attribute of the file.
.PP
On Mac OS X and Darwin, \fB\-creator\fR gives or sets the
Finder creator type of the file. \fB\-hidden\fR gives or sets or clears
the hidden attribute of the file. \fB\-readonly\fR gives or sets or
clears the readonly attribute of the file. \fB\-rsrclength\fR gives
the length of the resource fork of the file, this attribute can only be
set to the value 0, which results in the resource fork being stripped
off the file.
.RE
.TP
\fBfile channels\fR ?\fIpattern\fR?
\fBfile channels ?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of names of all
registered open channels in this interpreter.  If \fIpattern\fR is
specified, only those names matching \fIpattern\fR are returned.  Matching
is determined using the same rules as for \fBstring match\fR.
.TP
\fBfile copy \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIsource\fR \fItarget\fR
100
101
102
103
104
105
106
107

108
109
110
111
112

113
114
115
116
117
118
119
103
104
105
106
107
108
109

110
111
112
113
114

115
116
117
118
119
120
121
122







-
+




-
+







overwritten unless the \fB\-force\fR option is specified (when Tcl will
also attempt to adjust permissions on the destination file or directory
if that is necessary to allow the copy to proceed).  When copying
within a single filesystem, \fIfile copy\fR will copy soft links (i.e.
the links themselves are copied, not the things they point to).  Trying
to overwrite a non-empty directory, overwrite a directory with a file,
or overwrite a file with a directory will all result in errors even if
\fB\-force\fR was specified.  Arguments are processed in the order
\fI\-force\fR was specified.  Arguments are processed in the order
specified, halting at the first error, if any.  A \fB\-\|\-\fR marks
the end of switches; the argument following the \fB\-\|\-\fR will be
treated as a \fIsource\fR even if it starts with a \fB\-\fR.
.TP
\fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? ?\fIpathname\fR ... ?
\fBfile delete \fR?\fB\-force\fR? ?\fB\-\|\-\fR? \fIpathname\fR ?\fIpathname\fR ... ?
.
Removes the file or directory specified by each \fIpathname\fR
argument.  Non-empty directories will be removed only if the
\fB\-force\fR option is specified.  When operating on symbolic links,
the links themselves will be deleted, not the objects they point to.
Trying to delete a non-existent file is not considered an error.
Trying to delete a read-only file will cause the file to be deleted,
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
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







-

-
+

-
-
+



-

-
+

-

-

-
+

-








-
+







Returns a name comprised of all of the path components in \fIname\fR
excluding the last element.  If \fIname\fR is a relative file name and
only contains one path element, then returns
.QW \fB.\fR .
If \fIname\fR refers to a root directory, then the root directory is
returned.  For example,
.RS
.PP
.CS
\fBfile dirname\fR c:/
\fBfile dirname c:/\fR
.CE
.PP
returns \fBc:/\fR.
returns \fBc:/\fR. 
.PP
Note that tilde substitution will only be
performed if it is necessary to complete the command. For example,
.PP
.CS
\fBfile dirname\fR ~/src/foo.c
\fBfile dirname ~/src/foo.c\fR
.CE
.PP
returns \fB~/src\fR, whereas
.PP
.CS
\fBfile dirname\fR ~
\fBfile dirname ~\fR
.CE
.PP
returns \fB/home\fR (or something similar).
.RE
.TP
\fBfile executable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is executable by the current user,
\fB0\fR otherwise. On Windows, which does not have an executable attribute,
the command treats all directories and any files with extensions
\fBexe\fR, \fBcom\fR, \fBcmd\fR or \fBbat\fR as executable.
\fBexe\fR, \fBcom\fR, \fBcmd\fR, \fBbat\fR or \fBps1\fR as executable.
.TP
\fBfile exists \fIname\fR
.
Returns \fB1\fR if file \fIname\fR exists and the current user has
search privileges for the directories leading to it, \fB0\fR otherwise.
.TP
\fBfile extension \fIname\fR
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
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







-

-
+

-







-
+







.
Takes one or more file names and combines them, using the correct path
separator for the current platform.  If a particular \fIname\fR is
relative, then it will be joined to the previous file name argument.
Otherwise, any earlier arguments will be discarded, and joining will
proceed from the current argument.  For example,
.RS
.PP
.CS
\fBfile join\fR a b /foo bar
\fBfile join a b /foo bar\fR
.CE
.PP
returns \fB/foo/bar\fR.
.PP
Note that any of the names can contain separators, and that the result
is always canonical for the current platform: \fB/\fR for Unix and
Windows.
.RE
.TP
\fBfile link\fR ?\fI\-linktype\fR? \fIlinkName\fR ?\fItarget\fR?
\fBfile link ?\fI\-linktype\fR? \fIlinkName\fR ?\fItarget\fR?
.
If only one argument is given, that argument is assumed to be
\fIlinkName\fR, and this command returns the value of the link given by
\fIlinkName\fR (i.e. the name of the file it points to).  If
\fIlinkName\fR is not a link or its value cannot be read (as, for example,
seems to be the case with hard links, which look just like ordinary
files), then an error is returned.
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
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







-
+

-
+











-
-
-
+
+
+
+
+











-
+







create a link in a cross-platform way, and does not care what type of
link is created.
.PP
If the user wishes to make a link of a specific type only, (and signal an
error if for some reason that is not possible), then the optional
\fI\-linktype\fR argument should be given.  Accepted values for
\fI\-linktype\fR are
.QW \fB\-symbolic\fR
.QW \-symbolic
and
.QW \fB\-hard\fR .
.QW \-hard .
.PP
On Unix, symbolic links can be made to relative paths, and those paths
must be relative to the actual \fIlinkName\fR's location (not to the
cwd), but on all other platforms where relative links are not supported,
target paths will always be converted to absolute, normalized form
before the link is created (and therefore relative paths are interpreted
as relative to the cwd).  Furthermore,
.QW ~user
paths are always expanded
to absolute form.  When creating links on filesystems that either do not
support any links, or do not support the specific type requested, an
error message will be returned.  Most Unix platforms support both
symbolic and hard links (the latter for files only). Windows
supports symbolic directory links and hard file links on NTFS drives.
error message will be returned.  In particular Windows 95, 98 and ME do
not support any links at present, but most Unix platforms support both
symbolic and hard links (the latter for files only) and Windows
NT/2000/XP (on NTFS drives) support symbolic
directory links and hard file links.
.RE
.TP
\fBfile lstat \fIname varName\fR
.
Same as \fBstat\fR option (see below) except uses the \fIlstat\fR
kernel call instead of \fIstat\fR.  This means that if \fIname\fR
refers to a symbolic link the information returned in \fIvarName\fR
is for the link rather than the file it refers to.  On systems that
do not support symbolic links this option behaves exactly the same
as the \fBstat\fR option.
.TP
\fBfile mkdir\fR ?\fIdir\fR ...?
\fBfile mkdir \fIdir\fR ?\fIdir\fR ...?
.
Creates each directory specified.  For each pathname \fIdir\fR specified,
this command will create all non-existing parent directories as
well as \fIdir\fR itself.  If an existing directory is specified, then
no action is taken and no error is returned.  Trying to overwrite an existing
file with a directory will result in an error.  Arguments are processed in
the order specified, halting at the first error, if any.
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
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







-
+

















-
+







means we want the long form with that form's case-dependence (which
gives us a unique, case-dependent path).  The one exception concerning the
last link in the path is necessary, because Tcl or the user may wish to
operate on the actual symbolic link itself (for example \fBfile delete\fR,
\fBfile rename\fR, \fBfile copy\fR are defined to operate on symbolic
links, not on the things that they point to).
.TP
\fBfile owned \fIname\fR
\fBfile owned \fIname\fR 
.
Returns \fB1\fR if file \fIname\fR is owned by the current user, \fB0\fR
otherwise.
.TP
\fBfile pathtype \fIname\fR
.
Returns one of \fBabsolute\fR, \fBrelative\fR, \fBvolumerelative\fR. If
\fIname\fR refers to a specific file on a specific volume, the path type will
be \fBabsolute\fR. If \fIname\fR refers to a file relative to the current
working directory, then the path type will be \fBrelative\fR. If \fIname\fR
refers to a file relative to the current working directory on a specified
volume, or to a specific file on the current working volume, then the path
type is \fBvolumerelative\fR.
.TP
\fBfile readable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is readable by the current user,
\fB0\fR otherwise.
\fB0\fR otherwise. 
.TP
\fBfile readlink \fIname\fR
.
Returns the value of the symbolic link given by \fIname\fR (i.e. the name
of the file it points to).  If \fIname\fR is not a symbolic link or its
value cannot be read, then an error is returned.  On systems that do not
support symbolic links this option is undefined.
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
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







-
+



















-

-
+

-
-
-
+
-




-
+







last
.QW .
character in the last component of name.  If the last
component of \fIname\fR does not contain a dot, then returns \fIname\fR.
.TP
\fBfile separator\fR ?\fIname\fR?
.
If no argument is given, returns the character which is used to separate
If no argument is given, returns the character which is used to separate 
path segments for native files on this platform.  If a path is given,
the filesystem responsible for that path is asked to return its
separator character.  If no file system accepts \fIname\fR, an error
is generated.
.TP
\fBfile size \fIname\fR
.
Returns a decimal string giving the size of file \fIname\fR in bytes.  If
the file does not exist or its size cannot be queried then an error is
generated.
.TP
\fBfile split \fIname\fR
.
Returns a list whose elements are the path components in \fIname\fR.  The
first element of the list will have the same path type as \fIname\fR.
All other elements will be relative.  Path separators will be discarded
unless they are needed to ensure that an element is unambiguously relative.
For example, under Unix
.RS
.PP
.CS
\fBfile split\fR /foo/~bar/baz
file split /foo/~bar/baz
.CE
.PP
returns
.QW \fB/\0\0foo\0\0./~bar\0\0baz\fR
returns \fB/\0\0foo\0\0./~bar\0\0baz\fR to ensure that later commands
to ensure that later commands
that use the third component do not attempt to perform tilde
substitution.
.RE
.TP
\fBfile stat \fIname varName\fR
\fBfile stat  \fIname varName\fR
.
Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
given by \fIvarName\fR to hold information returned from the kernel call.
\fIVarName\fR is treated as an array variable, and the following elements
of that variable are set: \fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR,
\fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR,
\fBuid\fR.  Each element except \fBtype\fR is a decimal string with the
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
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
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






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












-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+




















-
+
-
-
-
-
-
-

-



-


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





-





-
+










-







-
+
-
-
-
-
-
.QW vfs .
If the file does not belong to any filesystem, an error is generated.
.TP
\fBfile tail \fIname\fR
.
Returns all of the characters in the last filesystem component of
\fIname\fR.  Any trailing directory separator in \fIname\fR is ignored.
If \fIname\fR contains no separators then returns \fIname\fR.  So,
If \fIname\fR contains no separators then returns \fIname\fR.  So, 
\fBfile tail a/b\fR, \fBfile tail a/b/\fR and \fBfile tail b\fR all
return \fBb\fR.
.TP
\fBfile tempdir\fR ?\fItemplate\fR?
.VS "8.7, TIP 431"
Creates a temporary directory (guaranteed to be newly created and writable by
the current script) and returns its name. If \fItemplate\fR is given, it
specifies one of or both of the existing directory (on a filesystem controlled
by the operating system) to contain the temporary directory, and the base part
of the directory name; it is considered to have the location of the directory
if there is a directory separator in the name, and the base part is everything
after the last directory separator (if non-empty).  The default containing
directory is determined by system-specific operations, and the default base
name prefix is
.QW \fBtcl\fR .
.RS
.PP
The following output is typical and illustrative; the actual output will vary
between platforms:
.PP
.CS
% \fBfile tempdir\fR
/var/tmp/tcl_u0kuy5
 % \fBfile tempdir\fR /tmp/myapp
/tmp/myapp_8o7r9L
% \fBfile tempdir\fR /tmp/
/tmp/tcl_1mOJHD
% \fBfile tempdir\fR myapp
/var/tmp/myapp_0ihS0n
.CE
.RE
.VE "8.7, TIP 431"
.TP
\fBfile tempfile\fR ?\fInameVar\fR? ?\fItemplate\fR?
'\" TIP #210
Creates a temporary file and returns a read-write channel opened on that file.
If the \fInameVar\fR is given, it specifies a variable that the name of the
temporary file will be written into; if absent, Tcl will attempt to arrange
for the temporary file to be deleted once it is no longer required. If the
\fItemplate\fR is present, it specifies parts of the template of the filename
to use when creating it (such as the directory, base-name or extension) though
some platforms may ignore some or all of these parts and use a built-in
default instead.
.RS
.PP
Note that temporary files are \fIonly\fR ever created on the native
filesystem. As such, they can be relied upon to be used with operating-system
native APIs and external programs that require a filename.
.RE
.TP
\fBfile type \fIname\fR
.
Returns a string giving the type of file \fIname\fR, which will be one of
\fBfile\fR, \fBdirectory\fR, \fBcharacterSpecial\fR, \fBblockSpecial\fR,
\fBfifo\fR, \fBlink\fR, or \fBsocket\fR.
.TP
\fBfile volumes\fR
.
. 
Returns the absolute paths to the volumes mounted on the system, as a
proper Tcl list.  Without any virtual filesystems mounted as root
volumes, on UNIX, the command will always return
.QW / ,
since all filesystems are locally mounted.
On Windows, it will return a list of the available local drives
(e.g.
.QW "a:/ c:/" ).
If any virtual filesystem has mounted additional
volumes, they will be in the returned list.
.TP
\fBfile writable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is writable by the current user,
\fB0\fR otherwise.
.SH "PORTABILITY ISSUES"
.TP
\fBUnix\fR\0\0\0\0\0\0\0
.
These commands always operate using the real user and group identifiers,
not the effective ones.
not the effective ones. 
.TP
\fBWindows\fR\0\0\0\0
.
The \fBfile owned\fR subcommand uses the user identifier (SID) of
the process token, not the thread token which may be impersonating
some other user.
.SH EXAMPLES
.PP
This procedure shows how to search for C files in a given directory
that have a correspondingly-named object file in the current
directory:
.PP
.CS
proc findMatchingCFiles {dir} {
    set files {}
    switch $::tcl_platform(platform) {
        windows {
            set ext .obj
        }
        unix {
           set ext .o
        }
    }
    foreach file [glob \-nocomplain \-directory $dir *.c] {
        set objectFile [\fBfile tail\fR [\fBfile rootname\fR $file]]$ext
        if {[\fBfile exists\fR $objectFile]} {
            lappend files $file
        }
    }
    return $files
   set files {}
   switch $::tcl_platform(platform) {
      windows {
         set ext .obj
      }
      unix {
         set ext .o
      }
   }
   foreach file [glob \-nocomplain \-directory $dir *.c] {
      set objectFile [\fBfile tail\fR [\fBfile rootname\fR $file]]$ext
      if {[\fBfile exists\fR $objectFile]} {
         lappend files $file
      }
   }
   return $files
}
.CE
.PP
Rename a file and leave a symbolic link pointing from the old location
to the new place:
.PP
.CS
set oldName foobar.txt
set newName foo/bar.txt
# Make sure that where we're going to move to exists...
if {![\fBfile isdirectory\fR [\fBfile dirname\fR $newName]]} {
    \fBfile mkdir\fR [\fBfile dirname\fR $newName]
   \fBfile mkdir\fR [\fBfile dirname\fR $newName]
}
\fBfile rename\fR $oldName $newName
\fBfile link\fR \-symbolic $oldName $newName
.CE
.PP
On Windows, a file can be
.QW started
easily enough (equivalent to double-clicking on it in the Explorer
interface) but the name passed to the operating system must be in
native format:
.PP
.CS
exec {*}[auto_execok start] {} [\fBfile nativename\fR ~/example.txt]
.CE
.SH "SEE ALSO"
filename(n), open(n), close(n), eof(n), gets(n), tell(n), seek(n),
fblocked(n), flush(n)
.SH KEYWORDS
attributes, copy files, delete files, directory, file, move files, name,
attributes, copy files, delete files, directory, file, move files, name, rename files, stat
rename files, stat, user
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/fileevent.n.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3

4
5
6

7
8
9
10
11
12
13
14



-



-
+







'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2008 Pat Thoyts
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH fileevent n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fileevent \- Execute a script when a channel becomes readable or writable
.SH SYNOPSIS
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
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











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




-
-
-
-
-









-

-
+
-
-
-
-
-


-
-
-
-
+
+



-


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




+


+



-
-
-
-
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.
.PP
Event-driven I/O works best for channels that have been placed into
nonblocking mode with the \fBfconfigure\fR command.  In blocking mode,
a \fBputs\fR command may block if you give it more data than the
underlying file or device can accept, and a \fBgets\fR or \fBread\fR
command will block if you attempt to read more data than is ready; a
Event-driven I/O works best for channels that have been
placed into nonblocking mode with the \fBfconfigure\fR command.
In blocking mode, a \fBputs\fR command may block if you give it
more data than the underlying file or device can accept, and a
\fBgets\fR or \fBread\fR command will block if you attempt to read
readable underlying file or device may not even guarantee that a
blocking [read 1] will succeed (counter-examples being multi-byte
encodings, compression or encryption transforms ). In all such cases,
no events will be processed while the commands block.
more data than is ready;  no events will be processed while the
.PP
commands block.
In nonblocking mode \fBputs\fR, \fBread\fR, and \fBgets\fR never block.
See the documentation for the individual commands for information
on how they handle blocking and nonblocking channels.
.PP
Testing for the end of file condition should be done after any attempts
read the channel data. The eof flag is set once an attempt to read the
end of data has occurred and testing before this read will require an
additional event to be fired.
.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
\fBfileevent\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.
.SH EXAMPLE
.PP
In this setup \fBGetData\fR will be called with the channel as an
argument whenever $chan becomes readable. The \fBread\fR call will
argument whenever $chan becomes readable.
read whatever binary data is currently available without blocking.
Here the channel has the fileevent removed when an end of file
occurs to avoid being continually called (see above). Alternatively
the channel may be closed on this condition.
.PP
.CS
proc GetData {chan} {
    set data [read $chan]
    puts "[string length $data] $data"
    if {[eof $chan]} {
        fileevent $chan readable {}
    if {![eof $chan]} {
        puts [gets $chan]
    }
}

fconfigure $chan -blocking 0 -encoding binary
\fBfileevent\fR $chan readable [list GetData $chan]
.CE
.PP
The next example demonstrates use of \fBgets\fR to read line-oriented
data.
.PP
.CS
proc GetData {chan} {
    if {[gets $chan line] >= 0} {
        puts $line
    }

    if {[eof $chan]} {
        close $chan
    }
}

fconfigure $chan -blocking 0 -buffering line -translation crlf
\fBfileevent\fR $chan readable [list GetData $chan]
.CE
.SH CREDITS
.PP
\fBfileevent\fR is based on the \fBaddinput\fR command created
by Mark Diekhans.

.SH "SEE ALSO"
fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)

.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
script, writable.
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/filename.n.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH filename n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
filename \- File name conventions supported by Tcl commands
.BE
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48







-
+








-
+







entry for more details).
.SH "PATH TYPES"
.PP
File names are grouped into three general types based on the starting point
for the path used to specify the file: absolute, relative, and
volume-relative.  Absolute names are completely qualified, giving a path to
the file relative to a particular volume and the root directory on that
volume.  Relative names are unqualified, giving a path to the file relative
volume.  Relative names are unqualified, giving a path to the file relative 
to the current working directory.  Volume-relative names are partially
qualified, either giving the path relative to the root directory on the
current volume, or relative to the current directory of the specified
volume.  The \fBfile pathtype\fR command can be used to determine the
type of a given path.
.SH "PATH SYNTAX"
.PP
The rules for native names depend on the value reported in the Tcl
\fBplatform\fR element of the \fBtcl_platform\fR array:
array element \fBtcl_platform(platform)\fR:
.TP 10
\fBUnix\fR
On Unix and Apple MacOS X platforms, Tcl uses path names where the
components are separated by slashes.  Path names may be relative or
absolute, and file names may contain any character other than slash.
The file names \fB\&.\fR and \fB\&..\fR are special and refer to the
current directory and the parent of the current directory respectively.
71
72
73
74
75
76
77
78

79
80
81
82
83
84
85
86
87

88
89
90
91
92
93
94
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85
86

87
88
89
90
91
92
93
94







-
+








-
+







.TP 15
\fBfoo/bar\fR
Relative path to the file \fBbar\fR in the directory \fBfoo\fR in the
current directory.
.TP 15
\fB\&../foo\fR
Relative path to the file \fBfoo\fR in the directory above the current
directory.
directory. 
.RE
.TP
\fBWindows\fR
On Microsoft Windows platforms, Tcl supports both drive-relative and UNC
style names.  Both \fB/\fR and \fB\e\fR may be used as directory separators
in either type of name.  Drive-relative names consist of an optional drive
specifier followed by an absolute or relative path.  UNC paths follow the
general form \fB\e\eservername\esharename\epath\efile\fR, but must at
the very least contain the server and share components, i.e.
the very least contain the server and share components, i.e. 
\fB\e\eservername\esharename\fR.  In both forms,
the file names \fB.\fR and \fB..\fR are special and refer to the current
directory and the parent of the current directory respectively.  The
following examples illustrate various forms of path names:
.RS
.TP 15
\fB\&\e\eHost\eshare/file\fR
150
151
152
153
154
155
156
157

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

157
158
159
160
161
162
163
164







-
+







alphanumeric characters only.  Care should be taken with filenames
which contain spaces (common on Windows systems) and
filenames where the backslash is the directory separator (Windows
native path names).  Also Windows 3.1 only supports file
names with a root of no more than 8 characters and an extension of no
more than 3 characters.
.PP
On Windows platforms there are file and path length restrictions.
On Windows platforms there are file and path length restrictions. 
Complete paths or filenames longer than about 260 characters will lead
to errors in most file operations.
.PP
Another Windows peculiarity is that any number of trailing dots
.QW .
in filenames are totally ignored, so, for example, attempts to create a
file or directory with a name
172
173
174
175
176
177
178
179
180
181
182
172
173
174
175
176
177
178











-
-
-
-
.QW .....abc
is illegal.
.SH "SEE ALSO"
file(n), glob(n)
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/flush.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

44
45
46
47
48
49
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










-
+









+
















-

-






+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH flush n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
flush \- Flush buffered output for a channel
.SH SYNOPSIS
\fBflush \fIchannelId\fR
.BE

.SH DESCRIPTION
.PP
Flushes any output that has been buffered for \fIchannelId\fR.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a
Tcl standard channel (\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.  The
channel must have been opened for writing.
.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.
.SH EXAMPLE
.PP
Prompt for the user to type some information in on the console:
.PP
.CS
puts -nonewline "Please type your name: "
\fBflush\fR stdout
gets stdin name
puts "Hello there, $name!"
.CE

.SH "SEE ALSO"
file(n), open(n), socket(n), Tcl_StandardChannels(3)

.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/for.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH for n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
for \- 'For' loop
.SH SYNOPSIS
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
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










-

-

-
-
+
+










-

-
-
+
+




-

-
-
+
+


+

+
-
+

-
+
-
-
-
made by the loop body will not be considered in the expression.
This is likely to result in an infinite loop.  If \fItest\fR is
enclosed in braces, variable substitutions are delayed until the
expression is evaluated (before
each loop iteration), so changes in the variables will be visible.
See below for an example:
.SH EXAMPLES
.PP
Print a line for each of the integers from 0 to 9:
.PP
.CS
\fBfor\fR {set x 0} {$x<10} {incr x} {
    puts "x is $x"
for {set x 0} {$x<10} {incr x} {
   puts "x is $x"
}
.CE
.PP
Either loop infinitely or not at all because the expression being
evaluated is actually the constant, or even generate an error!  The
actual behaviour will depend on whether the variable \fIx\fR exists
before the \fBfor\fR command is run and whether its value is a value
that is less than or greater than/equal to ten, and this is because
the expression will be substituted before the \fBfor\fR command is
executed.
.PP
.CS
\fBfor\fR {set x 0} $x<10 {incr x} {
    puts "x is $x"
for {set x 0} $x<10 {incr x} {
   puts "x is $x"
}
.CE
.PP
Print out the powers of two from 1 to 1024:
.PP
.CS
\fBfor\fR {set x 1} {$x<=1024} {set x [expr {$x * 2}]} {
    puts "x is $x"
for {set x 1} {$x<=1024} {set x [expr {$x * 2}]} {
   puts "x is $x"
}
.CE

.SH "SEE ALSO"
break, continue, foreach, while
break(n), continue(n), foreach(n), while(n)

.SH KEYWORDS
boolean, for, iteration, loop
for, iteration, looping
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/foreach.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH foreach n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
foreach \- Iterate over all elements in one or more lists
.SH SYNOPSIS
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
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











-


-












-










-










-













-
+
-
-
-
-
elements for each of its loop variables in each iteration,
empty values are used for the missing elements.
.PP
The \fBbreak\fR and \fBcontinue\fR statements may be
invoked inside \fIbody\fR, with the same effect as in the \fBfor\fR
command.  \fBForeach\fR returns an empty string.
.SH EXAMPLES
.PP
This loop prints every value in a list together with the square and
cube of the value:
.PP
.CS
'\" Maintainers: notice the tab hacking below!
.ta 3i
set values {1 3 5 7 2 4 6 8}	;# Odd numbers first, for fun!
puts "Value\etSquare\etCube"	;# Neat-looking header
\fBforeach\fR x $values {	;# Now loop and print...
    puts " $x\et [expr {$x**2}]\et [expr {$x**3}]"
}
.CE
.PP
The following loop uses i and j as loop variables to iterate over
pairs of elements of a single list.
.PP
.CS
set x {}
\fBforeach\fR {i j} {a b c d e f} {
    lappend x $j $i
}
# The value of x is "b a d c f e"
# There are 3 iterations of the loop.
.CE
.PP
The next loop uses i and j to iterate over two lists in parallel.
.PP
.CS
set x {}
\fBforeach\fR i {a b c} j {d e f g} {
    lappend x $i $j
}
# The value of x is "a d b e c f {} g"
# There are 4 iterations of the loop.
.CE
.PP
The two forms are combined in the following example.
.PP
.CS
set x {}
\fBforeach\fR i {a b c} {j k} {d e f g} {
    lappend x $i $j $k
}
# The value of x is "a d e b f g c {} {}"
# There are 3 iterations of the loop.
.CE

.SH "SEE ALSO"
for(n), while(n), break(n), continue(n)

.SH KEYWORDS
foreach, iteration, list, loop
foreach, iteration, list, looping
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/format.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
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
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






-
+




















-
+






-
+













-













-





-
-
+
+



-
+







-
+



-
-
-
+
+
+

-
-
-
-
-

-
+

-
+

-








-
+





-












-
+




-


-
+




-
+


-
-
-
+


-
+
-
-







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH format n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
format \- Format a string in the style of sprintf
.SH SYNOPSIS
\fBformat \fIformatString \fR?\fIarg arg ...\fR?
.BE

.SH INTRODUCTION
.PP
This command generates a formatted string in a fashion similar to the
ANSI C \fBsprintf\fR procedure.
\fIFormatString\fR indicates how to format the result, using
\fB%\fR conversion specifiers as in \fBsprintf\fR, and the additional
arguments, if any, provide values to be substituted into the result.
The return value from \fBformat\fR is the formatted string.
.SH "DETAILS ON FORMATTING"
.PP
The command operates by scanning \fIformatString\fR from left to right.
The command operates by scanning \fIformatString\fR from left to right. 
Each character from the format string is appended to the result
string unless it is a percent sign.
If the character is a \fB%\fR then it is not copied to the result string.
Instead, the characters following the \fB%\fR character are treated as
a conversion specifier.
The conversion specifier controls the conversion of the next successive
\fIarg\fR to a particular format and the result is appended to
\fIarg\fR to a particular format and the result is appended to 
the result string in place of the conversion specifier.
If there are multiple conversion specifiers in the format string,
then each one controls the conversion of one additional \fIarg\fR.
The \fBformat\fR command must be given enough \fIarg\fRs to meet the needs
of all of the conversion specifiers in \fIformatString\fR.
.PP
Each conversion specifier may contain up to six different parts:
an XPG3 position specifier,
a set of flags, a minimum field width, a precision, a size modifier,
and a conversion character.
Any of these fields may be omitted except for the conversion character.
The fields that are present must appear in the order given above.
The paragraphs below discuss each of these fields in turn.
.SS "OPTIONAL POSITIONAL SPECIFIER"
.PP
If the \fB%\fR is followed by a decimal number and a \fB$\fR, as in
.QW \fB%2$d\fR ,
then the value to convert is not taken from the next sequential argument.
Instead, it is taken from the argument indicated by the number,
where 1 corresponds to the first \fIarg\fR.
If the conversion specifier requires multiple arguments because
of \fB*\fR characters in the specifier then
successive arguments are used, starting with the argument
given by the number.
This follows the XPG3 conventions for positional specifiers.
If there are any positional specifiers in \fIformatString\fR
then all of the specifiers must be positional.
.SS "OPTIONAL FLAGS"
.PP
The second portion of a conversion specifier may contain any of the
following flag characters, in any order:
.TP 10
\fB\-\fR
Specifies that the converted argument should be left-justified
in its field (numbers are normally right-justified with leading
Specifies that the converted argument should be left-justified 
in its field (numbers are normally right-justified with leading 
spaces if needed).
.TP 10
\fB+\fR
Specifies that a number should always be printed with a sign,
Specifies that a number should always be printed with a sign, 
even if positive.
.TP 10
\fIspace\fR
Specifies that a space should be added to the beginning of the
number if the first character is not a sign.
.TP 10
\fB0\fR
Specifies that the number should be padded on the left with
Specifies that the number should be padded on the left with 
zeroes instead of spaces.
.TP 10
\fB#\fR
Requests an alternate output form. For \fBo\fR conversions,
\fB0o\fR will be added to the beginning of the result unless
it is zero. For \fBx\fR or \fBX\fR conversions, \fB0x\fR
Requests an alternate output form. For \fBo\fR and \fBO\fR
conversions it guarantees that the first digit is always \fB0\fR.
For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
will be added to the beginning of the result unless it is zero.
For \fBb\fR conversions, \fB0b\fR
will be added to the beginning of the result unless it is zero.
For \fBd\fR conversions, \fB0d\fR there is no effect unless
the \fB0\fR specifier is used as well: In that case, \fB0d\fR
will be added to the beginning.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
\fBg\fR, and \fBG\fR) it guarantees that the result always
\fBg\fR, and \fBG\fR) it guarantees that the result always 
has a decimal point.
For \fBg\fR and \fBG\fR conversions it specifies that
For \fBg\fR and \fBG\fR conversions it specifies that 
trailing zeroes should not be removed.
.SS "OPTIONAL FIELD WIDTH"
.PP
The third portion of a conversion specifier is a decimal number giving a
minimum field width for this conversion.
It is typically used to make columns line up in tabular printouts.
If the converted argument contains fewer characters than the
minimum field width then it will be padded so that it is as wide
as the minimum field width.
Padding normally occurs by adding extra spaces on the left of the
converted argument, but the \fB0\fR and \fB\-\fR flags
converted argument, but the \fB0\fR and \fB\-\fR flags 
may be used to specify padding with zeroes on the left or with
spaces on the right, respectively.
If the minimum field width is specified as \fB*\fR rather than
a number, then the next argument to the \fBformat\fR command
determines the minimum field width; it must be an integer value.
.SS "OPTIONAL PRECISION/BOUND"
.PP
The fourth portion of a conversion specifier is a precision,
which consists of a period followed by a number.
The number is used in different ways for different conversions.
For \fBe\fR, \fBE\fR, and \fBf\fR conversions it specifies the number
of digits to appear to the right of the decimal point.
For \fBg\fR and \fBG\fR conversions it specifies the total number
of digits to appear, including those on both sides of the decimal
point (however, trailing zeroes after the decimal point will still
be omitted unless the \fB#\fR flag has been specified).
For integer conversions, it specifies a minimum number of digits
to print (leading zeroes will be added if necessary).
For \fBs\fR conversions it specifies the maximum number of characters to be
For \fBs\fR conversions it specifies the maximum number of characters to be 
printed; if the string is longer than this then the trailing characters will be dropped.
If the precision is specified with \fB*\fR rather than a number
then the next argument to the \fBformat\fR command determines the precision;
it must be a numeric string.
.SS "OPTIONAL SIZE MODIFIER"
.PP
The fifth part of a conversion specifier is a size modifier,
which must be \fBll\fR, \fBh\fR, \fBl\fR, or \fBL\fR.
which must be \fBll\fR, \fBh\fR, or \fBl\fR.
If it is \fBll\fR it specifies that an integer value is taken
without truncation for conversion to a formatted substring.
If it is \fBh\fR it specifies that an integer value is
truncated to a 16-bit range before converting.  This option is rarely useful.
If it is \fBl\fR it specifies that the integer value is
If it is \fBl\fR it specifies that the integer value is 
truncated to the same range as that produced by the \fBwide()\fR
function of the \fBexpr\fR command (at least a 64-bit range).
If it is \fBL\fR it specifies that an integer or double value is taken
without truncation for conversion to a formatted substring.
If neither \fBh\fR nor \fBl\fR nor \fBL\fR are present, the integer value is
If neither \fBh\fR nor \fBl\fR are present, the integer value is
truncated to the same range as that produced by the \fBint()\fR
function of the \fBexpr\fR command (at least a 32-bit range, but
determined by the value of the \fBwordSize\fR element of the
determined by the value of \fBtcl_platform(wordSize)\fR).
\fBtcl_platform\fR array).
.SS "MANDATORY CONVERSION TYPE"
.PP
The last thing in a conversion specifier is an alphabetic character
that determines what kind of conversion to perform.
The following conversion characters are currently supported:
.TP 10
\fBd\fR
Convert integer to signed decimal string.
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
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










-
-
-







-
-
+
+




-
-
+
+


-
+



-
-
+
+




-
-
-
-
-
-
-


-
-
-
-






-
+

-
-


-
+

-
+

-


-







-






-








-









-














-
-
+
+









-
-
-
\fBx\fR or \fBX\fR
Convert integer to unsigned hexadecimal string, using digits
.QW 0123456789abcdef
for \fBx\fR and
.QW 0123456789ABCDEF
for \fBX\fR).
.TP 10
\fBb\fR
Convert integer to unsigned binary string, using digits 0 and 1.
.TP 10
\fBc\fR
Convert integer to the Unicode character it represents.
.TP 10
\fBs\fR
No conversion; just insert string.
.TP 10
\fBf\fR
Convert number to signed decimal string of
the form \fIxx.yyy\fR, where the number of \fIy\fR's is determined by
Convert number to signed decimal string of 
the form \fIxx.yyy\fR, where the number of \fIy\fR's is determined by 
the precision (default: 6).
If the precision is 0 then no decimal point is output.
.TP 10
\fBe\fR or \fBE\fR
Convert number to scientific notation in the
form \fIx.yyy\fBe\(+-\fIzz\fR, where the number of \fIy\fR's is determined
Convert number to scientific notation in the 
form \fIx.yyy\fBe\(+-\fIzz\fR, where the number of \fIy\fR's is determined 
by the precision (default: 6).
If the precision is 0 then no decimal point is output.
If the \fBE\fR form is used then \fBE\fR is
If the \fBE\fR form is used then \fBE\fR is 
printed instead of \fBe\fR.
.TP 10
\fBg\fR or \fBG\fR
If the exponent is less than \-4 or greater than or equal to the
precision, then convert number as for \fB%e\fR or
If the exponent is less than \-4 or greater than or equal to the 
precision, then convert number as for \fB%e\fR or 
\fB%E\fR.
Otherwise convert as for \fB%f\fR.
Trailing zeroes and a trailing decimal point are omitted.
.TP 10
\fBa\fR or \fBA\fR
Convert double to hexadecimal notation in the form
\fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is
determined by the precision (default: 13).
If the \fBA\fR form is used then the hex characters
are printed in uppercase.
.TP 10
\fB%\fR
No conversion: just insert \fB%\fR.
.TP 10
\fBp\fR
Shorthand form for \fB0x%zx\fR, so it outputs the integer in
hexadecimal form with \fB0x\fR prefix.
.SH "DIFFERENCES FROM ANSI SPRINTF"
.PP
The behavior of the format command is the same as the
ANSI C \fBsprintf\fR procedure except for the following
differences:
.IP [1]
Tcl guarantees that it will be working with UNICODE characters.
\fB%p\fR and \fB%n\fR specifiers are not supported.
.IP [2]
\fB%n\fR specifier is not supported.
.IP [3]
For \fB%c\fR conversions the argument must be an integer value,
which will then be converted to the corresponding character value.
.IP [4]
.IP [3]
The size modifiers are ignored when formatting floating-point values.
The \fBb\fR specifier has no \fBsprintf\fR counterpart.
The \fBll\fR modifier has no \fBsprintf\fR counterpart.
.SH EXAMPLES
.PP
Convert the numeric value of a UNICODE character to the character
itself:
.PP
.CS
set value 120
set char [\fBformat\fR %c $value]
.CE
.PP
Convert the output of \fBtime\fR into seconds to an accuracy of
hundredths of a second:
.PP
.CS
set us [lindex [time $someTclCode] 0]
puts [\fBformat\fR "%.2f seconds to execute" [expr {$us / 1e6}]]
.CE
.PP
Create a packed X11 literal color specification:
.PP
.CS
# Each color-component should be in range (0..255)
set color [\fBformat\fR "#%02x%02x%02x" $r $g $b]
.CE
.PP
Use XPG3 format codes to allow reordering of fields (a technique that
is often used in localized message catalogs; see \fBmsgcat\fR) without
reordering the data values passed to \fBformat\fR:
.PP
.CS
set fmt1 "Today, %d shares in %s were bought at $%.2f each"
puts [\fBformat\fR $fmt1 123 "Global BigCorp" 19.37]

set fmt2 "Bought %2\e$s equity ($%3$.2f x %1\e$d) today"
puts [\fBformat\fR $fmt2 123 "Global BigCorp" 19.37]
.CE
.PP
Print a small table of powers of three:
.PP
.CS
# Set up the column widths
set w1 5
set w2 10

# Make a nice header (with separator) for the table first
set sep +-[string repeat - $w1]-+-[string repeat - $w2]-+
puts $sep
puts [\fBformat\fR "| %-*s | %-*s |" $w1 "Index" $w2 "Power"]
puts $sep

# Print the contents of the table
set p 1
for {set i 0} {$i<=20} {incr i} {
    puts [\fBformat\fR "| %*d | %*ld |" $w1 $i $w2 $p]
    set p [expr {wide($p) * 3}]
   puts [\fBformat\fR "| %*d | %*ld |" $w1 $i $w2 $p]
   set p [expr {wide($p) * 3}]
}

# Finish off by printing the separator again
puts $sep
.CE
.SH "SEE ALSO"
scan(n), sprintf(3), string(n)
.SH KEYWORDS
conversion specifier, format, sprintf, string, substitution
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/fpclassify.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
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



















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2018 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\" Copyright (c) 2019 by Donal Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH fpclassify n 8.7 Tcl "Tcl Float Classifier"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
fpclassify \- Floating point number classification of Tcl values
.SH SYNOPSIS
package require \fBTcl 8.7\fR
.sp
\fBfpclassify \fIvalue\fR
.BE
.SH DESCRIPTION
The \fBfpclassify\fR command takes a floating point number, \fIvalue\fR, and
returns one of the following strings that describe it:
.TP
\fBzero\fR
.
\fIvalue\fR is a floating point zero.
.TP
\fBsubnormal\fR
.
\fIvalue\fR is the result of a gradual underflow.
.TP
\fBnormal\fR
.
\fIvalue\fR is an ordinary floating-point number (not zero, subnormal,
infinite, nor NaN).
.TP
\fBinfinite\fR
.
\fIvalue\fR is a floating-point infinity.
.TP
\fBnan\fR
.
\fIvalue\fR is Not-a-Number.
.PP
The \fBfpclassify\fR command throws an error if value is not a floating-point
value and cannot be converted to one.
.SH EXAMPLE
.PP
This shows how to check whether the result of a computation is numerically
safe or not. (Note however that it does not guard against numerical errors;
just against representational problems.)
.PP
.CS
set value [command-that-computes-a-value]
switch [\fBfpclassify\fR $value] {
    normal - zero {
        puts "Result is $value"
    }
    infinite {
        puts "Result is infinite"
    }
    subnormal {
        puts "Result is $value - WARNING! precision lost"
    }
    nan {
        puts "Computation completely failed"
    }
}
.CE
.SH "SEE ALSO"
expr(n), mathfunc(n)
.SH KEYWORDS
floating point
.SH STANDARDS
This command depends on the \fBfpclassify\fR() C macro conforming to
.QW "ISO C99"
(i.e., to ISO/IEC 9899:1999).
.SH COPYRIGHT
.nf
Copyright \(co 2018 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved
.fi
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/gets.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH gets n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
gets \- Read a line from a channel
.SH SYNOPSIS
31
32
33
34
35
36
37
38

39
40
41
42
43

44
45
46
47
48
49
50
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
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 non-blocking mode, then the return count is -1.
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"
60
61
62
63
64
65
66
67

68
69
70
71
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, non-blocking, read
blocking, channel, end of file, end of line, line, nonblocking, read
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/glob.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
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
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









+







-
+

+





-
-
-
-
+
+
+

-
-
+

-
+



-

-
+

-
+




-





-
-
+



-

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



-

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



-

-
+









-
-
+
+





-
+


-
+

-
+





-
+




-
+






-
-
+

-


-
+
-


-



-



-
-
+




-



-
-
-
+
+

-
+




-
-
+
+

-
+

-
+

-
+

-
+













-
+




-
+





-
+





-
+

+
+

-
+




-
-
+
+
+
+
+
+
+

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

-

-






-





-










-



+


+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.TH glob n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
glob \- Return names of files that match patterns
.SH SYNOPSIS
\fBglob \fR?\fIswitches\fR? ?\fIpattern ...\fR?
\fBglob \fR?\fIswitches\fR? \fIpattern \fR?\fIpattern ...\fR?
.BE

.SH DESCRIPTION
.PP
This command performs file name
.QW globbing
in a fashion similar to
the csh shell or bash shell.
It returns a list of the files whose names match any
of the \fIpattern\fR arguments. No particular order is guaranteed
in the list, so if a sorted list is required the caller should use
the csh shell.  It returns a list of the files whose names match any
of the \fIpattern\fR arguments.  No particular order is guaranteed
in the list, so if a sorted list is required the caller should use 
\fBlsort\fR.
.SS OPTIONS
.PP
.LP
If the initial arguments to \fBglob\fR start with \fB\-\fR then
they are treated as switches. The following switches are
they are treated as switches.  The following switches are
currently supported:
.TP
\fB\-directory\fR \fIdirectory\fR
.
Search for files which match the given patterns starting in the given
\fIdirectory\fR. This allows searching of directories whose name
\fIdirectory\fR.  This allows searching of directories whose name
contains glob-sensitive characters without the need to quote such
characters explicitly. This option may not be used in conjunction with
characters explicitly.  This option may not be used in conjunction with
\fB\-path\fR, which is used to allow searching for complete file paths
whose names may contain glob-sensitive characters.
.TP
\fB\-join\fR
.
The remaining pattern arguments, after option processing, are treated
as a single pattern obtained by joining the arguments with directory
separators.
.TP
\fB\-nocomplain\fR
.
Allows an empty list to be returned without error; without this
Allows an empty list to be returned without error;  without this
switch an error is returned if the result list would be empty.
.TP
\fB\-path\fR \fIpathPrefix\fR
.
Search for files with the given \fIpathPrefix\fR where the rest of the name
matches the given patterns. This allows searching for files with names
similar to a given file (as opposed to a directory) even when the names
contain glob-sensitive
characters. This option may not be used in conjunction with
\fB\-directory\fR. For example, to find all files with the same root name
as $path, but differing extensions, you should use
.QW "\fBglob \-path [file rootname $path] .*\fR"
matches the given patterns.  This allows searching for files with names
similar to a given file (as opposed to a directory) even when the names 
contain glob-sensitive 
characters.  This option may not be used in conjunction with
\fB\-directory\fR.  For example, to find all files with the same root name
as $path, but differing extensions, you should use \fBglob 
-path [file rootname $path] .*\fR which will work even if $path contains
which will work even if \fB$path\fR contains
numerous glob-sensitive characters.
.TP
\fB\-tails\fR
.
Only return the part of each file found which follows the last directory
named in any \fB\-directory\fR or \fB\-path\fR path specification.
named in any \fB\-directory\fR or \fB\-path\fR path specification.  
Thus
.QW "\fBglob \-tails \-directory $dir *\fR"
is equivalent to
.QW "\fBset pwd [pwd]; cd $dir; glob *; cd $pwd\fR" .
For \fB\-path\fR specifications, the returned names will include the last
path segment, so
Thus \fBglob -tails -directory $dir *\fR is equivalent to 
\fBset pwd [pwd] ; cd $dir ; glob *; cd $pwd\fR.  For 
\fB\-path\fR specifications, the returned names will include the last
path segment, so \fBglob -tails -path [file rootname ~/foo.tex] .*\fR 
.QW "\fBglob \-tails \-path [file rootname ~/foo.tex] .*\fR"
will return paths like \fBfoo.aux foo.bib foo.tex\fR etc.
.TP
\fB\-types\fR \fItypeList\fR
.
Only list files or directories which match \fItypeList\fR, where the items
in the list have two forms. The first form is like the \-type option of
in the list have two forms.  The first form is like the \-type option of
the Unix find command:
\fIb\fR (block special file),
\fIc\fR (character special file),
\fId\fR (directory),
\fIf\fR (plain file),
\fIl\fR (symbolic link),
\fIp\fR (named pipe),
or \fIs\fR (socket), where multiple types may be specified in the list.
\fBGlob\fR will return all files which match at least one of the types given.
Note that symbolic links will be returned both if \fB\-types l\fR is given,
or if the target of a link matches the requested type. So, a link to
Note that symbolic links will be returned both if \fB\-types l\fR is given, 
or if the target of a link matches the requested type.  So, a link to
a directory will be returned if \fB\-types d\fR was specified.
.RS
.PP
The second form specifies types where all the types given must match.
These are \fIr\fR, \fIw\fR, \fIx\fR as file permissions, and
\fIreadonly\fR, \fIhidden\fR as special permission cases. On the
\fIreadonly\fR, \fIhidden\fR as special permission cases.  On the
Macintosh, MacOS types and creators are also supported, where any item
which is four characters long is assumed to be a MacOS type
(e.g. \fBTEXT\fR). Items which are of the form \fI{macintosh type XXXX}\fR
(e.g. \fBTEXT\fR).  Items which are of the form \fI{macintosh type XXXX}\fR
or \fI{macintosh creator XXXX}\fR will match types or creators
respectively. Unrecognized types, or specifications of multiple MacOS
respectively.  Unrecognized types, or specifications of multiple MacOS
types/creators will signal an error.
.PP
The two forms may be mixed, so \fB\-types {d f r w}\fR will find all
regular files OR directories that have both read AND write permissions.
The following are equivalent:
.PP
.RS
.CS
\fBglob \-type d *\fR
\fBglob */\fR
.CE
.PP
.RE
except that the first case doesn't return the trailing
.QW /
and is more platform independent.
.RE
.TP
\fB\-\|\-\fR
.
Marks the end of switches. The argument following this one will
Marks the end of switches.  The argument following this one will
be treated as a \fIpattern\fR even if it starts with a \fB\-\fR.
.SS "GLOBBING PATTERNS"
.PP
The \fIpattern\fR arguments may contain any of the following
special characters, which are a superset of those supported by
special characters:
\fBstring match\fR:
.TP 10
\fB?\fR
.
Matches any single character.
.TP 10
\fB*\fR
.
Matches any sequence of zero or more characters.
.TP 10
\fB[\fIchars\fB]\fR
.
Matches any single character in \fIchars\fR. If \fIchars\fR
Matches any single character in \fIchars\fR.  If \fIchars\fR
contains a sequence of the form \fIa\fB\-\fIb\fR then any
character between \fIa\fR and \fIb\fR (inclusive) will match.
.TP 10
\fB\e\fIx\fR
.
Matches the character \fIx\fR.
.TP 10
\fB{\fIa\fB,\fIb\fB,\fI...\fR}
.
Matches any of the sub-patterns \fIa\fR, \fIb\fR, etc.
.PP
Matches any of the strings \fIa\fR, \fIb\fR, etc.
.LP
On Unix, as with csh, a
.QW . \|
.QW .
at the beginning of a file's name or just after a
.QW /
must be matched explicitly or with a {} construct, unless the
\fB\-types hidden\fR flag is given (since
.QW . \|
at the beginning of a file's name indicates that it is hidden). On
.QW .
at the beginning of a file's name indicates that it is hidden).  On
other platforms, files beginning with a
.QW . \|
.QW .
are handled no differently to any others, except the special directories
.QW . \|
.QW .
and
.QW .. \|
.QW ..
which must be matched explicitly (this is to avoid a recursive pattern like
.QW "glob \-join * * * *"
.QW "glob -join * * * *"
from recursing up the directory hierarchy as well as down). In addition, all
.QW /
characters must be matched explicitly.
.LP
If the first character in a \fIpattern\fR is
.QW ~
then it refers to the home directory for the user whose name follows the
.QW ~ .
If the
.QW ~
is followed immediately by
.QW /
then the value of the HOME environment variable is used.
.PP
.LP
The \fBglob\fR command differs from csh globbing in two ways.
First, it does not sort its result list (use the \fBlsort\fR
command if you want the list sorted).
Second, \fBglob\fR only returns the names of files that actually
exist; in csh no check for existence is made unless a pattern
exist;  in csh no check for existence is made unless a pattern
contains a ?, *, or [] construct.
.LP
When the \fBglob\fR command returns relative paths whose filenames
start with a tilde
.QW ~
(for example through \fBglob *\fR or \fBglob \-tails\fR, the returned
(for example through \fBglob *\fR or \fBglob -tails\fR, the returned
list will not quote the tilde with
.QW ./ .
This means care must be taken if those names are later to
be used with \fBfile join\fR, to avoid them being interpreted as
absolute paths pointing to a given user's home directory.
.SH "WINDOWS PORTABILITY ISSUES"
.SH "PORTABILITY ISSUES"
.PP
\fBWindows\fR
.
For Windows UNC names, the servername and sharename components of the path
may not contain ?, *, or [] constructs. On Windows NT, if \fIpattern\fR is
may not contain ?, *, or [] constructs.  On Windows NT, if \fIpattern\fR is
of the form
.QW \fB~\fIusername\fB@\fIdomain\fR ,
it refers to the home
directory of the user whose account information resides on the specified NT
domain server. Otherwise, user account information is obtained from
the local computer.
domain server.  Otherwise, user account information is obtained from
the local computer.  On Windows 95 and 98, \fBglob\fR accepts patterns
like
.QW .../
and
.QW ..../
for successively higher up parent directories.
.PP
Since the backslash character has a special meaning to the glob
command, glob patterns containing Windows style path separators need
special care. The pattern
Since the backslash character has a special meaning to the glob 
command, glob patterns containing Windows style path separators need 
special care. The pattern \fIC:\e\efoo\e\e*\fR is interpreted as 
.QW \fIC:\e\efoo\e\e*\fR
is interpreted as
.QW \fIC:\efoo\e*\fR
where
.QW \fI\ef\fR
will match the single character
\fIC:\efoo\e*\fR where \fI\ef\fR will match the single character \fIf\fR 
.QW \fIf\fR
and
.QW \fI\e*\fR
will match the single character
and \fI\e*\fR will match the single character \fI*\fR and will not be 
.QW \fI*\fR
and will not be
interpreted as a wildcard character. One solution to this problem is
to use the Unix style forward slash as a path separator. Windows style
paths can be converted to Unix style paths with the command
interpreted as a wildcard character. One solution to this problem is 
to use the Unix style forward slash as a path separator. Windows style 
paths can be converted to Unix style paths with the command \fBfile
.QW "\fBfile join\fR \fB$path\fR"
or
.QW "\fBfile normalize\fR \fB$path\fR" .
join $path\fR (or \fBfile normalize $path\fR in Tcl 8.4). 
.SH EXAMPLES
.PP
Find all the Tcl files in the current directory:
.PP
.CS
\fBglob\fR *.tcl
.CE
.PP
Find all the Tcl files in the user's home directory, irrespective of
what the current directory is:
.PP
.CS
\fBglob\fR \-directory ~ *.tcl
.CE
.PP
Find all subdirectories of the current directory:
.PP
.CS
\fBglob\fR \-type d *
.CE
.PP
Find all files whose name contains an
.QW a ,
a
.QW b
or the sequence
.QW cde :
.PP
.CS
\fBglob\fR \-type f *{a,b,cde}*
.CE

.SH "SEE ALSO"
file(n)

.SH KEYWORDS
exist, file, glob, pattern
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/global.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
44
45
46
47
48
49
50
51
52
53
54

55
56

57
58
59
60
61
62
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










-
+







-
+

+










-
+





-

-












-






+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH global n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
global \- Access global variables
.SH SYNOPSIS
\fBglobal \fR?\fIvarname ...\fR?
\fBglobal \fIvarname \fR?\fIvarname ...\fR?
.BE

.SH DESCRIPTION
.PP
This command has no effect unless executed in the context of a proc body.
If the \fBglobal\fR command is executed in the context of a proc body, it
creates local variables linked to the corresponding global variables (though
these linked variables, like those created by \fBupvar\fR, are not included
in the list returned by \fBinfo locals\fR).
.PP
If \fIvarname\fR contains namespace qualifiers, the local variable's name is
the unqualified name of the global variable, as determined by the
\fBnamespace tail\fR command.
\fBnamespace tail\fR command. 
.PP
\fIvarname\fR is always treated as the name of a variable, not an
array element.  An error is returned if the name looks like an array element,
such as \fBa(b)\fR.
.SH EXAMPLES
.PP
This procedure sets the namespace variable \fI::a::x\fR
.PP
.CS
proc reset {} {
    \fBglobal\fR a::x
    set x 0
}
.CE
.PP
This procedure accumulates the strings passed to it in a global
buffer, separated by newlines.  It is useful for situations when you
want to build a message piece-by-piece (as if with \fBputs\fR) but
send that full message in a single piece (e.g. over a connection
opened with \fBsocket\fR or as part of a counted HTTP response).
.PP
.CS
proc accum {string} {
    \fBglobal\fR accumulator
    append accumulator $string \en
}
.CE

.SH "SEE ALSO"
namespace(n), upvar(n), variable(n)

.SH KEYWORDS
global, namespace, procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/history.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH history n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
history \- Manipulate the history list
.SH SYNOPSIS
96
97
98
99
100
101
102
103
104
105
106
96
97
98
99
100
101
102











-
-
-
-
is modified to eliminate the history command and replace it with
the result of the history command.
If you want to redo an event without modifying history, then use
the \fBevent\fR operation to retrieve some event,
and the \fBadd\fR operation to add it to history and execute it.
.SH KEYWORDS
event, history, record
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/http.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
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







-
-
+
+






-
+


-
+

-
+



-
-







'\"
'\" Copyright (c) 1995-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1998-2000 by Ajuba Solutions.
'\" Copyright (c) 2004 ActiveState Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "http" n 2.9 http "Tcl Bundled Packages"
'\" 
.TH "http" n 2.7 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
\fBpackage require http\fI ?\fB2.9\fR?
\fBpackage require http ?2.7?\fR
.\" See Also -useragent option documentation in body!
.sp
\fB::http::config\fR ?\fI\-option value\fR ...?
\fB::http::config \fI?options?\fR
.sp
\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
\fB::http::geturl \fIurl ?options?\fR
.sp
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.sp
\fB::http::quoteString\fR \fIvalue\fR
.sp
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.sp
\fB::http::wait \fItoken\fR
.sp
\fB::http::status \fItoken\fR
.sp
\fB::http::size \fItoken\fR
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
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
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
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
363
364
365
366
367
368
369











370

371
372
373
374
375
376
377







-
-





-
+










-
+
















-










-

-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-




-



-










-
-
-
-
-
-
-
-
-
-
-
-

-

-
-
+



-
-
+
+


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


-
+
-














-






-





-




-







-









-








-












-
-
-
-



-
-
+
-






-
-



-


-
-
+



-





-




-








-








-





-






-

-
+






-










-





-



-








-





-








-






-
-
-
-
-

-
-
-
+
+
-


-









-




-




-




-




-




-





-





-










-




-










-
-
-
-
-
-
-
-
-
-
-

-







.sp
\fB::http::error \fItoken\fR
.sp
\fB::http::cleanup \fItoken\fR
.sp
\fB::http::register \fIproto port command\fR
.sp
\fB::http::registerError \fIport\fR ?\fImessage\fR?
.sp
\fB::http::unregister \fIproto\fR
.BE
.SH DESCRIPTION
.PP
The \fBhttp\fR package provides the client side of the HTTP/1.1
protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
protocol, as defined in RFC 2616.
The package implements the GET, POST, and HEAD operations
of HTTP/1.1.  It allows configuration of a proxy host to get through
firewalls.  The package is compatible with the \fBSafesock\fR security
policy, so it can be used by untrusted applets to do URL fetching from
a restricted set of hosts. This package can be extended to support
additional HTTP transport protocols, such as HTTPS, by providing
a custom \fBsocket\fR command, via \fB::http::register\fR.
.PP
The \fB::http::geturl\fR procedure does a HTTP transaction.
Its \fIoptions \fR determine whether a GET, POST, or HEAD transaction
is performed.
is performed.  
The return value of \fB::http::geturl\fR is a token for the transaction.
The value is also the name of an array in the ::http namespace
that contains state information about the transaction.  The elements
of this array are described in the \fBSTATE ARRAY\fR section.
.PP
If the \fB\-command\fR option is specified, then
the HTTP operation is done in the background.
\fB::http::geturl\fR returns immediately after generating the
HTTP request and the callback is invoked
when the transaction completes.  For this to work, the Tcl event loop
must be active.  In Tk applications this is always true.  For pure-Tcl
applications, the caller can use \fB::http::wait\fR after calling
\fB::http::geturl\fR to start the event loop.
.SH COMMANDS
.TP
\fB::http::config\fR ?\fIoptions\fR?
.
The \fB::http::config\fR command is used to set and query the name of the
proxy server and port, and the User-Agent name used in the HTTP
requests.  If no options are specified, then the current configuration
is returned.  If a single argument is specified, then it should be one
of the flags described below.  In this case the current value of
that setting is returned.  Otherwise, the options should be a set of
flags and values that define the configuration:
.RS
.TP
\fB\-accept\fR \fImimetypes\fR
.
The Accept header of the request.  The default is */*, which means that
all types of documents are accepted.  Otherwise you can supply a
all types of documents are accepted.  Otherwise you can supply a 
comma-separated list of mime type patterns that you are
willing to receive.  For example,
.QW "image/gif, image/jpeg, text/*" .
.TP
\fB\-cookiejar\fR \fIcommand\fR
.VS TIP406
The cookie store for the package to use to manage HTTP cookies.
\fIcommand\fR is a command prefix list; if the empty list (the
default value) is used, no cookies will be sent by requests or stored
from responses. The command indicated by \fIcommand\fR, if supplied,
must obey the \fBCOOKIE JAR PROTOCOL\fR described below.
.VE TIP406
.TP
\fB\-pipeline\fR \fIboolean\fR
.
Specifies whether HTTP/1.1 transactions on a persistent socket will be
pipelined.  See the \fBPERSISTENT SOCKETS\fR section for details. The default
is 1.
.TP
\fB\-postfresh\fR \fIboolean\fR
.
Specifies whether requests that use the \fBPOST\fR method will always use a
fresh socket, overriding the \fB-keepalive\fR option of
command \fBhttp::geturl\fR.  See the \fBPERSISTENT SOCKETS\fR section for details.
The default is 0.
.TP
\fB\-proxyhost\fR \fIhostname\fR
.
The name of the proxy host, if any.  If this value is the
empty string, the URL host is contacted directly.
.TP
\fB\-proxyport\fR \fInumber\fR
.
The proxy port number.
.TP
\fB\-proxyfilter\fR \fIcommand\fR
.
The command is a callback that is made during
\fB::http::geturl\fR
to determine if a proxy is required for a given host.  One argument, a
host name, is added to \fIcommand\fR when it is invoked.  If a proxy
is required, the callback should return a two-element list containing
the proxy server and proxy port.  Otherwise the filter should return
an empty list.  The default filter returns the values of the
\fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
non-empty.
.TP
\fB\-repost\fR \fIboolean\fR
.
Specifies what to do if a POST request over a persistent connection fails
because the server has half-closed the connection.  If boolean \fBtrue\fR, the
request
will be automatically retried; if boolean \fBfalse\fR it will not, and the
application
that uses \fBhttp::geturl\fR is expected to seek user confirmation before
retrying the POST.  The value \fBtrue\fR should be used only under certain
conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
default is 0.
.TP
\fB\-urlencoding\fR \fIencoding\fR
.
The \fIencoding\fR used for creating the x-url-encoded URLs with
\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
The default is \fButf-8\fR, as specified by RFC
\fB::http::formatQuery\fR.  The default is \fButf-8\fR, as specified by RFC
2718.  Prior to http 2.5 this was unspecified, and that behavior can be
returned by specifying the empty string (\fB{}\fR), although
\fIiso8859-1\fR is recommended to restore similar behavior but without the
\fB::http::formatQuery\fR or \fB::http::quoteString\fR
throwing an error processing non-latin-1 characters.
\fB::http::formatQuery\fR throwing an error processing non-latin-1
characters.
.TP
\fB\-useragent\fR \fIstring\fR
.
The value of the User-Agent header in the HTTP request.  In an unsafe
The value of the User-Agent header in the HTTP request.  The default is
interpreter, the default value depends upon the operating system, and
the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.9.0 Tcl/8.6.9\fR" .
A safe interpreter cannot determine its operating system, and so the default
in a safe interpreter is to use a Windows 10 value with the current version
numbers of \fBhttp\fR and \fBTcl\fR.
.TP
\fB\-zip\fR \fIboolean\fR
.
If the value is boolean \fBtrue\fR, then by default requests will send a header
.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
.QW "\fBTcl http client package 2.7\fR" .
If the value is boolean \fBfalse\fR, then by default this header will not be sent.
In either case the default can be overridden for an individual request by
supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
of \fBhttp::geturl\fR. The default is 1.
.RE
.TP
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
\fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR? 
.
The \fB::http::geturl\fR command is the main procedure in the package.
The \fB\-query\fR option causes a POST operation and
the \fB\-validate\fR option causes a HEAD operation;
otherwise, a GET operation is performed.  The \fB::http::geturl\fR command
returns a \fItoken\fR value that can be used to get
information about the transaction.  See the \fBSTATE ARRAY\fR and
\fBERRORS\fR section for
details.  The \fB::http::geturl\fR command blocks until the operation
completes, unless the \fB\-command\fR option specifies a callback
that is invoked when the HTTP transaction completes.
\fB::http::geturl\fR takes several options:
.RS
.TP
\fB\-binary\fR \fIboolean\fR
.
Specifies whether to force interpreting the URL data as binary.  Normally
this is auto-detected (anything not beginning with a \fBtext\fR content
type or whose content encoding is \fBgzip\fR or \fBcompress\fR is
considered binary data).
.TP
\fB\-blocksize\fR \fIsize\fR
.
The block size used when reading the URL.
At most \fIsize\fR bytes are read at once.  After each block, a call to the
\fB\-progress\fR callback is made (if that option is specified).
.TP
\fB\-channel\fR \fIname\fR
.
Copy the URL contents to channel \fIname\fR instead of saving it in
\fBstate(body)\fR.
.TP
\fB\-command\fR \fIcallback\fR
.
Invoke \fIcallback\fR after the HTTP transaction completes.
This option causes \fB::http::geturl\fR to return immediately.
The \fIcallback\fR gets an additional argument that is the \fItoken\fR returned
from \fB::http::geturl\fR. This token is the name of an array that is
described in the \fBSTATE ARRAY\fR section.  Here is a template for the
callback:
.RS
.PP
.CS
proc httpCallback {token} {
    upvar #0 $token state
    # Access state as a Tcl array
}
.CE
.RE
.TP
\fB\-handler\fR \fIcallback\fR
.
Invoke \fIcallback\fR whenever HTTP data is available; if present, nothing
else will be done with the HTTP data.  This procedure gets two additional
arguments: the socket for the HTTP data and the \fItoken\fR returned from
\fB::http::geturl\fR.  The token is the name of a global array that is
described in the \fBSTATE ARRAY\fR section.  The procedure is expected
to return the number of bytes read from the socket.  Here is a
template for the callback:
.RS
.PP
.CS
proc httpHandlerCallback {socket token} {
    upvar #0 $token state
    # Access socket, and state as a Tcl array
    # For example...
    ...
    set data [read $socket 1000]
    set nbytes [string length $data]
    ...
    return $nbytes
}
.CE
.PP
The \fBhttp::geturl\fR code for the \fB-handler\fR option is not compatible with either compression or chunked transfer-encoding.  If \fB-handler\fR is specified, then to work around these issues \fBhttp::geturl\fR will reduce the HTTP protocol to 1.0, and override the \fB-zip\fR option (i.e. it will not send the header "\fBAccept-Encoding: gzip,deflate,compress\fR").
.PP
If options \fB-handler\fR and \fB-channel\fR are used together, the handler is responsible for copying the data from the HTTP socket to the specified channel.  The name of the channel is available to the handler as element \fB-channel\fR of the token array.
.RE
.TP
\fB\-headers\fR \fIkeyvaluelist\fR
.
This option is used to add headers not already specified
This option is used to add extra headers to the HTTP request.  The
by \fB::http::config\fR to the HTTP request.  The
\fIkeyvaluelist\fR argument must be a list with an even number of
elements that alternate between keys and values.  The keys become
header field names.  Newlines are stripped from the values so the
header cannot be corrupted.  For example, if \fIkeyvaluelist\fR is
\fBPragma no-cache\fR then the following header is included in the
HTTP request:
.RS
.PP
.CS
Pragma: no-cache
.CE
.RE
.TP
\fB\-keepalive\fR \fIboolean\fR
.
If boolean \fBtrue\fR, attempt to keep the connection open for servicing
If true, attempt to keep the connection open for servicing
multiple requests.  Default is 0.
.TP
\fB\-method\fR \fItype\fR
.
Force the HTTP request method to \fItype\fR. \fB::http::geturl\fR will
auto-select GET, POST or HEAD based on other options, but this option
enables choices like PUT and DELETE for webdav support.
.TP
\fB\-myaddr\fR \fIaddress\fR
.
Pass an specific local address to the underlying \fBsocket\fR call in case
multiple interfaces are available.
.TP
\fB\-progress\fR \fIcallback\fR
.
The \fIcallback\fR is made after each transfer of data from the URL.
The callback gets three additional arguments: the \fItoken\fR from
\fB::http::geturl\fR, the expected total size of the contents from the
\fBContent-Length\fR meta-data, and the current number of bytes
transferred so far.  The expected total size may be unknown, in which
case zero is passed to the callback.  Here is a template for the
progress callback:
.RS
.PP
.CS
proc httpProgress {token total current} {
    upvar #0 $token state
}
.CE
.RE
.TP
\fB\-protocol\fR \fIversion\fR
.
Select the HTTP protocol version to use. This should be 1.0 or 1.1 (the
default). Should only be necessary for servers that do not understand or
otherwise complain about HTTP/1.1.
.TP
\fB\-query\fR \fIquery\fR
.
This flag causes \fB::http::geturl\fR to do a POST request that passes the
\fIquery\fR to the server. The \fIquery\fR must be an x-url-encoding
formatted query.  The \fB::http::formatQuery\fR procedure can be used to
do the formatting.
.TP
\fB\-queryblocksize\fR \fIsize\fR
.
The block size used when posting query data to the URL.
At most
At most 
\fIsize\fR
bytes are written at once.  After each block, a call to the
\fB\-queryprogress\fR
callback is made (if that option is specified).
.TP
\fB\-querychannel\fR \fIchannelID\fR
.
This flag causes \fB::http::geturl\fR to do a POST request that passes the
data contained in \fIchannelID\fR to the server. The data contained in
\fIchannelID\fR must be an x-url-encoding
formatted query unless the \fB\-type\fR option below is used.
If a Content-Length header is not specified via the \fB\-headers\fR options,
\fB::http::geturl\fR attempts to determine the size of the post data
in order to create that header.  If it is
unable to determine the size, it returns an error.
.TP
\fB\-queryprogress\fR \fIcallback\fR
.
The \fIcallback\fR is made after each transfer of data to the URL
(i.e. POST) and acts exactly like the \fB\-progress\fR option (the
callback format is the same).
.TP
\fB\-strict\fR \fIboolean\fR
.
Whether to enforce RFC 3986 URL validation on the request.  Default is 1.
.TP
\fB\-timeout\fR \fImilliseconds\fR
.
If \fImilliseconds\fR is non-zero, then \fB::http::geturl\fR sets up a timeout
to occur after the specified number of milliseconds.
A timeout results in a call to \fB::http::reset\fR and to
the \fB\-command\fR callback, if specified.
The return value of \fB::http::status\fR is \fBtimeout\fR
after a timeout has occurred.
.TP
\fB\-type\fR \fImime-type\fR
.
Use \fImime-type\fR as the \fBContent-Type\fR value, instead of the
default value (\fBapplication/x-www-form-urlencoded\fR) during a
POST operation.
.TP
\fB\-validate\fR \fIboolean\fR
.
If \fIboolean\fR is non-zero, then \fB::http::geturl\fR does an HTTP HEAD
request.  This request returns meta information about the URL, but the
contents are not returned.  The meta information is available in the
\fBstate(meta) \fR variable after the transaction.  See the
\fBSTATE ARRAY\fR section for details.
.RE
.TP
\fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
.
This procedure does x-url-encoding of query data.  It takes an even
number of arguments that are the keys and values of the query.  It
encodes the keys and values, and generates one string that has the
proper & and = separators.  The result is suitable for the
\fB\-query\fR value passed to \fB::http::geturl\fR.
.TP
\fB::http::quoteString\fR \fIvalue\fR
.
This procedure does x-url-encoding of string.  It takes a single argument and
encodes it.
.TP
\fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
.
This command resets the HTTP transaction identified by \fItoken\fR, if any.
This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to
This command resets the HTTP transaction identified by \fItoken\fR, if
any.  This sets the \fBstate(status)\fR value to \fIwhy\fR, which defaults to \fBreset\fR, and then calls the registered \fB\-command\fR callback.
\fBreset\fR, and then calls the registered \fB\-command\fR callback.
.TP
\fB::http::wait\fR \fItoken\fR
.
This is a convenience procedure that blocks and waits for the
transaction to complete.  This only works in trusted code because it
uses \fBvwait\fR.  Also, it is not useful for the case where
\fB::http::geturl\fR is called \fIwithout\fR the \fB\-command\fR option
because in this case the \fB::http::geturl\fR call does not return
until the HTTP transaction is complete, and thus there is nothing to
wait for.
.TP
\fB::http::data\fR \fItoken\fR
.
This is a convenience procedure that returns the \fBbody\fR element
(i.e., the URL data) of the state array.
.TP
\fB::http::error\fR \fItoken\fR
.
This is a convenience procedure that returns the \fBerror\fR element
of the state array.
.TP
\fB::http::status\fR \fItoken\fR
.
This is a convenience procedure that returns the \fBstatus\fR element of
the state array.
.TP
\fB::http::code\fR \fItoken\fR
.
This is a convenience procedure that returns the \fBhttp\fR element of the
state array.
.TP
\fB::http::ncode\fR \fItoken\fR
.
This is a convenience procedure that returns just the numeric return
code (200, 404, etc.) from the \fBhttp\fR element of the state array.
.TP
\fB::http::size\fR \fItoken\fR
.
This is a convenience procedure that returns the \fBcurrentsize\fR
element of the state array, which represents the number of bytes
received from the URL in the \fB::http::geturl\fR call.
.TP
\fB::http::meta\fR \fItoken\fR
.
This is a convenience procedure that returns the \fBmeta\fR
element of the state array which contains the HTTP response
headers. See below for an explanation of this element.
.TP
\fB::http::cleanup\fR \fItoken\fR
.
This procedure cleans up the state associated with the connection
identified by \fItoken\fR.  After this call, the procedures
like \fB::http::data\fR cannot be used to get information
about the operation.  It is \fIstrongly\fR recommended that you call
this function after you are done with a given HTTP request.  Not doing
so will result in memory not being freed, and if your app calls
\fB::http::geturl\fR enough times, the memory leak could cause a
performance hit...or worse.
.TP
\fB::http::register\fR \fIproto port command\fR
.
This procedure allows one to provide custom HTTP transport types
such as HTTPS, by registering a prefix, the default port, and the
command to execute to create the Tcl \fBchannel\fR. E.g.:
.RS
.PP
.CS
package require http
package require tls

::http::register https 443 ::tls::socket

set token [::http::geturl https://my.secure.site/]
.CE
.RE
.TP
\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
.
This procedure allows a registered protocol handler to deliver an error
message for use by \fBhttp\fR.  Calling this command does not raise an
error. The command is useful when a registered protocol detects an problem
(for example, an invalid TLS certificate) that will cause an error to
propagate to \fBhttp\fR.  The command allows \fBhttp\fR to provide a
precise error message rather than a general one.  The command returns the
value provided by the last call with argument \fImessage\fR, or the empty
string if no such call has been made.
.TP
\fB::http::unregister\fR \fIproto\fR
.
This procedure unregisters a protocol handler that was previously
registered via \fB::http::register\fR, returning a two-item list of
the default port and handler command that was previously installed
(via \fB::http::register\fR) if there was such a handler, and an error if
there was no such handler.
.SH ERRORS
The \fB::http::geturl\fR procedure will raise errors in the following cases:
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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

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










-
+
-







-
+
-



-
+
-
















-



-







-
-
-
-
-
-
-
-

-




-






-



-




-




-



-



-








-





-



-




-





-

-
+


-




-




-






-



-



-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-

+

-
-
-
-
+
+
+
+

-
-
+
+

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

-
+


-
-
+
+





-
+
-
-
-
In any case, you must still call
\fB::http::cleanup\fR to delete the state array when you are done.
.PP
There are other possible results of the HTTP transaction
determined by examining the status from \fB::http::status\fR.
These are described below.
.TP
\fBok\fR
ok
.
If the HTTP transaction completes entirely, then status will be \fBok\fR.
However, you should still check the \fB::http::code\fR value to get
the HTTP status.  The \fB::http::ncode\fR procedure provides just
the numeric error (e.g., 200, 404 or 500) while the \fB::http::code\fR
procedure returns a value like
.QW "HTTP 404 File not found" .
.TP
\fBeof\fR
eof
.
If the server closes the socket without replying, then no error
is raised, but the status of the transaction will be \fBeof\fR.
.TP
\fBerror\fR
error
.
The error message will also be stored in the \fBerror\fR status
array element, accessible via \fB::http::error\fR.
.PP
Another error possibility is that \fB::http::geturl\fR is unable to
write all the post query data to the server before the server
responds and closes the socket.
The error message is saved in the \fBposterror\fR status array
element and then  \fB::http::geturl\fR attempts to complete the
transaction.
If it can read the server's response
it will end up with an \fBok\fR status, otherwise it will have
an \fBeof\fR status.
.SH "STATE ARRAY"
The \fB::http::geturl\fR procedure returns a \fItoken\fR that can be used to
get to the state of the HTTP transaction in the form of a Tcl array.
Use this construct to create an easy-to-use array variable:
.PP
.CS
upvar #0 $token state
.CE
.PP
Once the data associated with the URL is no longer needed, the state
array should be unset to free up storage.
The \fB::http::cleanup\fR procedure is provided for that purpose.
The following elements of
the array are supported:
.RS
.TP
\fBbinary\fR
.
This is boolean \fBtrue\fR if (after decoding any compression specified
by the
.QW "Content-Encoding"
response header) the HTTP response is binary.  It is boolean \fBfalse\fR
if the HTTP response is text.
.TP
\fBbody\fR
.
The contents of the URL.  This will be empty if the \fB\-channel\fR
option has been specified.  This value is returned by the \fB::http::data\fR command.
.TP
\fBcharset\fR
.
The value of the charset attribute from the \fBContent-Type\fR meta-data
value.  If none was specified, this defaults to the RFC standard
\fBiso8859-1\fR, or the value of \fB$::http::defaultCharset\fR.  Incoming
text data will be automatically converted from this charset to utf-8.
.TP
\fBcoding\fR
.
A copy of the \fBContent-Encoding\fR meta-data value.
.TP
\fBcurrentsize\fR
.
The current number of bytes fetched from the URL.
This value is returned by the \fB::http::size\fR command.
.TP
\fBerror\fR
.
If defined, this is the error string seen when the HTTP transaction
was aborted.
.TP
\fBhttp\fR
.
The HTTP status reply from the server.  This value
is returned by the \fB::http::code\fR command.  The format of this value is:
.RS
.PP
.CS
\fIHTTP/1.1 code string\fR
.CE
.PP
The \fIcode\fR is a three-digit number defined in the HTTP standard.
A code of 200 is OK.  Codes beginning with 4 or 5 indicate errors.
Codes beginning with 3 are redirection errors.  In this case the
\fBLocation\fR meta-data specifies a new URL that contains the
requested information.
.RE
.TP
\fBmeta\fR
.
The HTTP protocol returns meta-data that describes the URL contents.
The \fBmeta\fR element of the state array is a list of the keys and
values of the meta-data.  This is in a format useful for initializing
an array that just contains the meta-data:
.RS
.PP
.CS
array set meta $state(meta)
.CE
.PP
Some of the meta-data keys are listed below, but the HTTP standard defines
more, and servers are free to add their own.
.TP
\fBContent-Type\fR
.
The type of the URL contents.  Examples include \fBtext/html\fR,
\fBimage/gif,\fR \fBapplication/postscript\fR and
\fBapplication/x-tcl\fR.
.TP
\fBContent-Length\fR
.
The advertised size of the contents.  The actual size obtained by
\fB::http::geturl\fR is available as \fBstate(currentsize)\fR.
\fB::http::geturl\fR is available as \fBstate(size)\fR.
.TP
\fBLocation\fR
.
An alternate URL that contains the requested data.
.RE
.TP
\fBposterror\fR
.
The error, if any, that occurred while writing
the post query data to the server.
.TP
\fBstatus\fR
.
Either \fBok\fR, for successful completion, \fBreset\fR for
user-reset, \fBtimeout\fR if a timeout occurred before the transaction
could complete, or \fBerror\fR for an error condition.  During the
transaction this value is the empty string.
.TP
\fBtotalsize\fR
.
A copy of the \fBContent-Length\fR meta-data value.
.TP
\fBtype\fR
.
A copy of the \fBContent-Type\fR meta-data value.
.TP
\fBurl\fR
.
The requested URL.
.RE
.SH "PERSISTENT CONNECTIONS"
.PP
.SS "BASICS"
.PP
See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
.PP
A persistent connection allows multiple HTTP/1.1 transactions to be
carried over the same TCP connection.  Pipelining allows a
client to make multiple requests over a persistent connection without
waiting for each response.  The server sends responses in the same order
that the requests were received.
.PP
If a POST request fails to complete, typically user confirmation is
needed before sending the request again.  The user may wish to verify
whether the server was modified by the failed POST request, before
sending the same request again.
.PP
A HTTP request will use a persistent socket if the call to
\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
pipelining where permitted if the \fBhttp::config\fR option
\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
.PP
The http package maintains no more than one persistent connection to each
server (i.e. each value of
.QW "domain:port" ).
If \fBhttp::geturl\fR is called to make a request over a persistent
connection while the connection is busy with another request, the new
request will be held in a queue until the connection is free.
.PP
The http package does not support HTTP/1.0 persistent connections
controlled by the \fBKeep-Alive\fR header.
.SS "SPECIAL CASES"
.PP
This subsection discusses issues related to closure of the
persistent connection by the server, automatic retry of failed requests,
the special treatment necessary for POST requests, and the options for
dealing with these cases.
.PP
In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
requests that use the POST method.  If a POST uses a persistent
connection and is not the first request on that connection,
\fBhttp::geturl\fR waits until it has received the response for the previous
request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
uses a new connection for each POST.
.PP
If the server is processing a number of pipelined requests, and sends a
response header
.QW "\fBConnection: close\fR"
with one of the responses (other than the last), then subsequent responses
are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
over a new connection.
.PP
A difficulty arises when a HTTP client sends a request over a persistent
connection that has been idle for a while.  The HTTP server may
half-close an apparently idle connection while the client is sending a
request, but before the request arrives at the server: in this case (an
.QW "asynchronous close event" )
the request will fail.  The difficulty arises because the client cannot
be certain whether the POST modified the state of the server.  For HEAD or
GET requests, \fBhttp::geturl\fR opens another connection and retransmits
the failed request. However, if the request was a POST, RFC 7230 forbids
automatic retry by default, suggesting either user confirmation, or
confirmation by user-agent software that has semantic understanding of
the application.  The \fBhttp::config\fR option \fB-repost\fR allows for
either possibility.
.PP
Asynchronous close events can occur only in a short interval of time.  The
\fBhttp\fR package monitors each persistent connection for closure by the
server.  Upon detection, the connection is also closed at the client end,
and subsequent requests will use a fresh connection.
.PP
If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
then it will both try to use an existing persistent connection
(if one is available), and it will send the server a
.QW "\fBConnection: keep-alive\fR"
request header asking to keep the connection open for future requests.
.PP
The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
\fB-repost\fR relate to persistent connections.
.PP
Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
made
over a persistent connection.  POST requests will not be pipelined - if the
POST is not the first transaction on the connection, its request will not
be sent until the previous response has finished.  GET and HEAD requests
made after a POST will not be sent until the POST response has been
delivered, and will not be sent if the POST fails.
.PP
Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
\fB-keepalive\fR, and always open a fresh connection for a POST request.
.PP
Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
that fails because it uses a persistent connection that the server has
half-closed (an
.QW "asynchronous close event" ).
Subsequent GET and HEAD requests in a failed pipeline will also be retried.
\fIThe -repost option should be used only if the application understands
that the retry is appropriate\fR - specifically, the application must know
that if the failed POST successfully modified the state of the server, a repeat POST
would have no adverse effect.
.VS TIP406
.SH "COOKIE JAR PROTOCOL"
.PP
Cookies are short key-value pairs used to implement sessions within the
otherwise-stateless HTTP protocol. (See RFC 6265 for details; Tcl does not
implement the Cookie2 protocol as that is rarely seen in the wild.)
.PP
Cookie storage managment commands \(em
.QW "cookie jars"
\(em must support these subcommands which form the HTTP cookie storage
management protocol. Note that \fIcookieJar\fR below does not have to be a
command name; it is properly a command prefix (a Tcl list of words that will
be expanded in place) and admits many possible implementations.
.PP
Though not formally part of the protocol, it is expected that particular
values of \fIcookieJar\fR will correspond to sessions; it is up to the caller
of \fB::http::config\fR to decide what session applies and to manage the
deletion of said sessions when they are no longer desired (which should be
when they not configured as the current cookie jar).
.TP
\fIcookieJar \fBgetCookies \fIprotocol host requestPath\fR
.
This command asks the cookie jar what cookies should be supplied for a
particular request. It should take the \fIprotocol\fR (typically \fBhttp\fR or
\fBhttps\fR), \fIhost\fR name and \fIrequestPath\fR (parsed from the \fIurl\fR
argument to \fB::http::geturl\fR) and return a list of cookie keys and values
that describe the cookies to supply to the remote host. The list must have an
even number of elements.
.RS
.PP
There should only ever be at most one cookie with a particular key for any
request (typically the one with the most specific \fIhost\fR/domain match and
most specific \fIrequestPath\fR/path match), but there may be many cookies
with different names in any request.
.RE
.TP
\fIcookieJar \fBstoreCookie \fIcookieDictionary\fR
.
This command asks the cookie jar to store a particular cookie that was
returned by a request; the result of this command is ignored. The cookie
(which will have been parsed by the http package) is described by a
dictionary, \fIcookieDictionary\fR, that may have the following keys:
.RS
.TP
\fBdomain\fR
.
This is always present. Its value describes the domain hostname \fIor
prefix\fR that the cookie should be returned for.  The checking of the domain
against the origin (below) should be careful since sites that issue cookies
should only do so for domains related to themselves. Cookies that do not obey
a relevant origin matching rule should be ignored.
.TP
\fBexpires\fR
.
This is optional. If present, the cookie is intended to be a persistent cookie
and the value of the option is the Tcl timestamp (in seconds from the same
base as \fBclock seconds\fR) of when the cookie expires (which may be in the
past, which should result in the cookie being deleted immediately). If absent,
the cookie is intended to be a session cookie that should be not persisted
beyond the lifetime of the cookie jar.
.TP
\fBhostonly\fR
.
This is always present. Its value is a boolean that describes whether the
cookie is a single host cookie (true) or a domain-level cookie (false).
.TP
\fBhttponly\fR
.
This is always present. Its value is a boolean that is true when the site
wishes the cookie to only ever be used with HTTP (or HTTPS) traffic.
.TP
\fBkey\fR
.
This is always present. Its value is the \fIkey\fR of the cookie, which is
part of the information that must be return when sending this cookie back in a
future request.
.TP
\fBorigin\fR
.
This is always present. Its value describes where the http package believes it
received the cookie from, which may be useful for checking whether the
cookie's domain is valid.
.TP
\fBpath\fR
.
This is always present. Its value describes the path prefix of requests to the
cookie domain where the cookie should be returned.
.TP
\fBsecure\fR
.
This is always present. Its value is a boolean that is true when the cookie
should only used on requests sent over secure channels (typically HTTPS).
.TP
\fBvalue\fR
.
This is always present. Its value is the value of the cookie, which is part of
the information that must be return when sending this cookie back in a future
request.
.PP
Other keys may always be ignored; they have no meaning in this protocol.
.RE
.VE TIP406
.SH EXAMPLE
.PP
This example creates a procedure to copy a URL to a file while printing a
progress meter, and prints the meta-data associated with the URL.
.PP
.CS
# Copy a URL to a file and print meta-data
proc httpcopy { url file {chunk 4096} } {
    set out [open $file w]
    set token [\fB::http::geturl\fR $url -channel $out \e
            -progress httpCopyProgress -blocksize $chunk]
    close $out
   set out [open $file w]
   set token [\fB::http::geturl\fR $url -channel $out \e
          -progress httpCopyProgress -blocksize $chunk]
   close $out

    # This ends the line started by httpCopyProgress
    puts stderr ""
   # This ends the line started by httpCopyProgress
   puts stderr ""

    upvar #0 $token state
    set max 0
    foreach {name value} $state(meta) {
        if {[string length $name] > $max} {
            set max [string length $name]
        }
        if {[regexp -nocase ^location$ $name]} {
            # Handle URL redirects
            puts stderr "Location:$value"
            return [httpcopy [string trim $value] $file $chunk]
        }
    }
    incr max
    foreach {name value} $state(meta) {
        puts [format "%-*s %s" $max $name: $value]
    }
   upvar #0 $token state
   set max 0
   foreach {name value} $state(meta) {
      if {[string length $name] > $max} {
         set max [string length $name]
      }
      if {[regexp -nocase ^location$ $name]} {
         # Handle URL redirects
         puts stderr "Location:$value"
         return [httpcopy [string trim $value] $file $chunk]
      }
   }
   incr max
   foreach {name value} $state(meta) {
      puts [format "%-*s %s" $max $name: $value]
   }

    return $token
   return $token
}
proc httpCopyProgress {args} {
    puts -nonewline stderr .
    flush stderr
   puts -nonewline stderr .
   flush stderr
}
.CE
.SH "SEE ALSO"
safe(n), socket(n), safesock(n)
.SH KEYWORDS
internet, security policy, socket, www
security policy, socket
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/idna.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
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
























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2014-2018 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH "idna" n 0.1 http "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::idna \- Support for normalization of Internationalized Domain Names
.SH SYNOPSIS
.nf
package require tcl::idna 1.0

\fBtcl::idna decode\fR \fIhostname\fR
\fBtcl::idna encode\fR \fIhostname\fR
\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
\fBtcl::idna version\fR
.fi
.SH DESCRIPTION
This package provides an implementation of the punycode scheme used in
Internationalised Domain Names, and some access commands. (See RFC 3492 for a
description of punycode.)
.TP
\fBtcl::idna decode\fR \fIhostname\fR
.
This command takes the name of a host that potentially contains
punycode-encoded character sequences, \fIhostname\fR, and returns the hostname
as might be displayed to the user. Note that there are often UNICODE
characters that have extremely similar glyphs, so care should be taken with
displaying hostnames to users.
.TP
\fBtcl::idna encode\fR \fIhostname\fR
.
This command takes the name of a host as might be displayed to the user,
\fIhostname\fR, and returns the version of the hostname with characters not
permitted in basic hostnames encoded with punycode.
.TP
\fBtcl::idna puny\fR \fIsubcommand ...\fR
.
This command provides direct access to the basic punycode encoder and
decoder. It supports two \fIsubcommand\fRs:
.RS
.TP
\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
.
This command decodes the punycode-encoded string, \fIstring\fR, and returns
the result. If \fIcase\fR is provided, it is a boolean to make the case be
folded to upper case (if \fIcase\fR is true) or lower case (if \fIcase\fR is
false) during the decoding process; if omitted, no case transformation is
applied.
.TP
\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
.
This command encodes the string, \fIstring\fR, and returns the
punycode-encoded version of the string. If \fIcase\fR is provided, it is a
boolean to make the case be folded to upper case (if \fIcase\fR is true) or
lower case (if \fIcase\fR is false) during the encoding process; if omitted,
no case transformation is applied.
.RE
.TP
\fBtcl::idna version\fR
.
This returns the version of the \fBtcl::idna\fR package.
.SH "EXAMPLE"
.PP
This is an example of how punycoding of a string works:
.PP
.CS
package require tcl::idna

puts [\fBtcl::idna puny encode\fR "abc\(->def"]
#    prints: \fIabcdef-kn2c\fR
puts [\fBtcl::idna puny decode\fR "abcdef-kn2c"]
#    prints: \fIabc\(->def\fR
.CE
'\" TODO: show how it handles a real domain name
.SH "SEE ALSO"
http(n), cookiejar(n)
.SH KEYWORDS
internet, www
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/if.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH if n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
if \- Execute scripts conditionally
.SH SYNOPSIS
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
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










-

-





-


-
+

-
+




-


-
+

-
+

-
+





-


-
+
-
-

-
+


+


+


-
-
-
to make the command easier to read.
There may be any number of \fBelseif\fR clauses, including zero.
\fIBodyN\fR may also be omitted as long as \fBelse\fR is omitted too.
The return value from the command is the result of the body script
that was executed, or an empty string
if none of the expressions was non-zero and there was no \fIbodyN\fR.
.SH EXAMPLES
.PP
A simple conditional:
.PP
.CS
\fBif\fR {$vbl == 1} { puts "vbl is one" }
.CE
.PP
With an \fBelse\fR-clause:
.PP
.CS
\fBif\fR {$vbl == 1} {
    puts "vbl is one"
   puts "vbl is one"
} \fBelse\fR {
    puts "vbl is not one"
   puts "vbl is not one"
}
.CE
.PP
With an \fBelseif\fR-clause too:
.PP
.CS
\fBif\fR {$vbl == 1} {
    puts "vbl is one"
   puts "vbl is one"
} \fBelseif\fR {$vbl == 2} {
    puts "vbl is two"
   puts "vbl is two"
} \fBelse\fR {
    puts "vbl is not one or two"
   puts "vbl is not one or two"
}
.CE
.PP
Remember, expressions can be multi-line, but in that case it can be a
good idea to use the optional \fBthen\fR keyword for clarity:
.PP
.CS
\fBif\fR {
    $vbl == 1
   $vbl == 1 || $vbl == 2 || $vbl == 3
    || $vbl == 2
    || $vbl == 3
} \fBthen\fR {
    puts "vbl is one, two or three"
   puts "vbl is one, two or three"
}
.CE

.SH "SEE ALSO"
expr(n), for(n), foreach(n)

.SH KEYWORDS
boolean, conditional, else, false, if, true
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/incr.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
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
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










-
+









+










+



-
-
-
-
-
+

-

-





-






-







-



+

-
+
+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH incr n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
incr \- Increment the value of a variable
.SH SYNOPSIS
\fBincr \fIvarName \fR?\fIincrement\fR?
.BE

.SH DESCRIPTION
.PP
Increments the value stored in the variable whose name is \fIvarName\fR.
The value of the variable must be an integer.
If \fIincrement\fR is supplied then its value (which must be an
integer) is added to the value of variable \fIvarName\fR;  otherwise
1 is added to \fIvarName\fR.
The new value is stored as a decimal string in variable \fIvarName\fR
and also returned as result.
.PP
.VS 8.5
Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
to \fBincr\fR may be unset, and in that case, it will be set to
the value \fIincrement\fR or to the default increment value of \fB1\fR.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, the sum of the default value and the \fIincrement\fR (or
1) will be stored in the array element.
.VE TIP508
.VE 8.5
.SH EXAMPLES
.PP
Add one to the contents of the variable \fIx\fR:
.PP
.CS
\fBincr\fR x
.CE
.PP
Add 42 to the contents of the variable \fIx\fR:
.PP
.CS
\fBincr\fR x 42
.CE
.PP
Add the contents of the variable \fIy\fR to the contents of the
variable \fIx\fR:
.PP
.CS
\fBincr\fR x $y
.CE
.PP
Add nothing at all to the variable \fIx\fR (often useful for checking
whether an argument to a procedure is actually integral and generating
an error if it is not):
.PP
.CS
\fBincr\fR x 0
.CE

.SH "SEE ALSO"
expr(n), set(n)
expr(n)

.SH KEYWORDS
add, increment, variable, value
.\" 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
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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

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





-



-
+





-
+



+


-
+
+
+


-
-
+
+
+


-
-
+
-
-
-
-
+
-


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


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


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

-
+
-
-
-
-
+
+
+
+
+

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

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


-
-
+
+
+
+
+

+
+
+
+
-
+



-
+

+

-
+
+


-
-
+
+




-
-
+



-
-
+
-


-
-
+


-
-
-
+
+
+



-
-
-
-
-
+
+
+
+
+


-
-
-
+
+


-
-
+
+
+
+
+


-
-
+
+


-
-
-
+
+
+


-
-
+
+
+

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

-
-
+
+




-
+






-
-
+
+




-
-
+

-
-
+
+
+


-
-
+


-
+




-
-
-
-
-
+
+
+
+

-
+


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


-
-
-
+
+
+
+
+

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


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


-
-
-
+
+
+

-
-
-
-
-

-
-
+
-
+


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


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


-
-
-
-
+
+
+
+


-
-
+
-
+


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

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



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-

-
+
-
-
-
+
+
-
-
+
'\"
'\" 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.
'\"
'\" 
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
info \- Information about the state of the Tcl interpreter
info \- Return information about the state of the Tcl interpreter
.SH SYNOPSIS
\fBinfo \fIoption \fR?\fIarg arg ...\fR?
.BE

.SH DESCRIPTION
.PP
Available commands:
This command provides information about various internals of the Tcl
interpreter.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBinfo args \fIprocname\fR
.
Returns the names of the parameters to the procedure named \fIprocname\fR.
Returns a list containing the names of the arguments to procedure
\fIprocname\fR, in order.  \fIProcname\fR must be the name of a
Tcl command procedure.
.TP
\fBinfo body \fIprocname\fR
.
Returns the body of the procedure named \fIprocname\fR.
Returns the body of procedure \fIprocname\fR.  \fIProcname\fR must be
.TP
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
.
Returns information about the class named \fIclass\fR.
the name of a Tcl command procedure.
See \fBCLASS INTROSPECTION\fR below.
.TP
\fBinfo cmdcount\fR
.
Returns the total number of commands evaluated in this interpreter.
Returns a count of the total number of commands that have been invoked
.TP
\fBinfo cmdtype \fIcommandName\fR
.VS TIP426
Returns a the type of the command named \fIcommandName\fR.
Built-in types are:
in this interpreter.
.RS
.IP \fBalias\fR
\fIcommandName\fR was created by \fBinterp alias\fR.
In a safe interpreter an alias is only visible if both the alias and the
target are visible.
.IP \fBcoroutine\fR
\fIcommandName\fR was created by \fBcoroutine\fR.
.IP \fBensemble\fR
\fIcommandName\fR was created by \fBnamespace ensemble\fR.
.IP \fBimport\fR
\fIcommandName\fR was created by \fBnamespace import\fR.
.IP \fBnative\fR
\fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
interface directly without further registration of the type of command.
.IP \fBobject\fR
\fIcommandName\fR is the public command that represents an
instance of \fBoo::object\fR or one of its subclasses.
.IP \fBprivateObject\fR
\fIcommandName\fR is the private command, \fBmy\fR by default,
that represents an instance of \fBoo::object\fR or one of its subclasses.
.IP \fBproc\fR
\fIcommandName\fR was created by \fBproc\fR.
.IP \fBinterp\fR
\fIcommandName\fR was created by \fBinterp create\fR.
.IP \fBzlibStream\fR
\fIcommandName\fR was created by \fBzlib stream\fR.
.PP
Other types may be also registered as well.  See \fBTcl_RegisterCommandTypeName\fR.
.RE
.VE TIP426
.TP
\fBinfo commands \fR?\fIpattern\fR?
If \fIpattern\fR is not specified,
.\" Do not move this .VS above the .TP
.
Returns the names of all commands visible in the current namespace.  If
\fIpattern\fR is given, returns only those names that match according to
\fBstring match\fR.  Only the last component of \fIpattern\fR is a pattern.
Other components identify a namespace.  See \fBNAMESPACE RESOLUTION\fR in the
\fBnamespace\fR(n) documentation.
.VS 8.5
returns a list of names of all the Tcl commands visible
(i.e. executable without using a qualified name) to the current namespace,
including both the built-in commands written in C and
the command procedures defined using the \fBproc\fR command.
If \fIpattern\fR is specified,
only those names matching \fIpattern\fR are returned.
Matching is determined using the same rules as for \fBstring match\fR.
\fIpattern\fR can be a qualified name like \fBFoo::print*\fR.
That is, it may specify a particular namespace
using a sequence of namespace names separated by double colons (\fB::\fR),
and may have pattern matching special characters
at the end to specify a set of commands in that namespace.
If \fIpattern\fR is a qualified name,
the resulting list of command names has each one qualified with the name
of the specified namespace, and only the commands defined in the named
namespace are returned.
.\" Technically, most of this hasn't changed; that's mostly just the
.\" way it always worked. Hardly anyone knew that though.
.VE 8.5
.TP
\fBinfo complete \fIcommand\fR
.
Returns 1 if \fIcommand\fR is a complete command, and \fB0\fR otherwise.
Typically used in line-oriented input environments
to allow users to type in commands that span multiple lines.
Returns 1 if \fIcommand\fR is a complete Tcl command in the sense of
having no unclosed quotes, braces, brackets or array element names.
If the command does not appear to be complete then 0 is returned.
This command is typically used in line-oriented input environments
to allow users to type in commands that span multiple lines;  if the
.TP
\fBinfo coroutine\fR
command is not complete, the script can delay evaluating it until additional
.
Returns the name of the current \fBcoroutine\fR, or the empty
string if there is no current coroutine or the current coroutine
has been deleted.
lines have been typed to complete the command.
.TP
\fBinfo default \fIprocname parameter varname\fR
\fBinfo default \fIprocname arg varname\fR
.
If the parameter \fIparameter\fR for the procedure named \fIprocname\fR has a
default value, stores that value in \fIvarname\fR and returns \fB1\fR.
Otherwise, returns \fB0\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?
\fBinfo exists \fIvarName\fR
.
Returns a description of the active command at each level for the
last error in the current interpreter, or in the interpreter named
\fIinterp\fR if given.
.RS
.PP
The description is a dictionary of 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 command 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
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
the previous \fBCALL\fR item. Its parameter is the level offset. \fBINNER\fR
identifies the
.QW "inner context" ,
current context (either as a global or local variable) and has been
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
provide a trail of the call path, \fBINNER\fR provides details of the offending
operation in the innermost procedure call, even 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 \fBinterpreter\fR.
.RE
.TP
\fBinfo exists \fIvarName\fR
.
Returns \fB1\fR if a variable named \fIvarName\fR is visible and has been
defined, and \fB0\fR otherwise.
defined by being given a value, returns \fB0\fR otherwise.
.TP
\fBinfo frame\fR ?\fIdepth\fR?
\fBinfo frame\fR ?\fInumber\fR?
.
Returns the depth of the call to \fBinfo frame\fR itself.  Otherwise, returns a
dictionary describing the active command at the \fIdepth\fR, which counts all
commands visible to \fBinfo level\fR, plus commands that don't create a new
level, such as \fBeval\fR, \fBsource\fR, or \fIuplevel\fR. The frame depth is
always greater than the current level.
This command provides access to all frames on the stack, even those
hidden from \fBinfo level\fR. If \fInumber\fR is not specified, this
command returns a number giving the frame level of the command. This
is 1 if the command is invoked at top-level. If \fInumber\fR is
specified, then the result is a dictionary containing the location
information for the command at the \fInumber\fRed level on the stack.
.RS
.PP
If \fIdepth\fR is greater than \fB0\fR it is the frame at that depth.  Otherwise
it is the number of frames up from the current frame.
If \fInumber\fR is positive (> 0) then it selects a particular stack
level (1 refers to the top-most active command, i.e., \fBinfo frame\fR
itself, 2 to the command it was called from, and so on); otherwise it
gives a level relative to the current command (0 refers to the current
command, i.e., \fBinfo frame\fR itself, -1 to its caller, and so on).
.PP
This is similar to how \fBinfo level\fR works, except that this
subcommand reports all frames, like \fBsource\fRd scripts,
\fBeval\fRs, \fBuplevel\fRs, etc.
.PP
As with \fBinfo level\fR and error traces, for nested commands like
Note that for nested commands, like
.QW "foo [bar [x]]" ,
only
.QW x
is seen by \fBinfo frame\fR invoked within
will be seen by an \fBinfo frame\fR invoked within
.QW x .
This is the same as for \fBinfo level\fR and error stack traces.
.PP
The dictionary may contain the following keys:
The result dictionary may contain the keys listed below, with the
specified meanings for their values:
.TP
\fBtype\fR
.
Always present.  Possible values are \fBsource\fR, \fBproc\fR,
This entry is always present and describes the nature of the location
for the command. The recognized values are \fBsource\fR, \fBproc\fR,
\fBeval\fR, and \fBprecompiled\fR.
.RS
.TP
\fBsource\fR\0\0\0\0\0\0\0\0
.
A script loaded via the \fBsource\fR
means that the command is found in a script loaded by the \fBsource\fR
command.
.TP
\fBproc\fR\0\0\0\0\0\0\0\0
.
The body of a procedure that could not be traced back to a
means that the command is found in dynamically created procedure body.
line in a particular script.
.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
The body of a script provided to \fBeval\fR or \fBuplevel\fR.
means that the command is executed by \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
A pre-compiled script (loadable by the package
\fBtbcload\fR), and no further information is available.
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
.
The line number of of the command inside its script.  Not available for
\fBprecompiled\fR commands.  When the type is \fBsource\fR, the line number is
relative to the beginning of the file, whereas for the last two types it is
relative to the start of the script.
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
.
For type \fBsource\fR, provides the normalized path of the file that contains
the command.
This entry is present only for type \fBsource\fR. It provides the
normalized path of the file the command is in.
.TP
\fBcmd\fR
.
The command before substitutions were performed.
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
.
For type \fBprod\fR, the name of the procedure containing the command.
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
\fBlambda\fR
.
For a command in a script evaluated as the body of an unnamed routine via the
\fBapply\fR command, the definition of that routine.
This entry is present only if the command is found in the body of an
anonymous Tcl procedure, i.e. a lambda. It then provides the entire
definition of the lambda in question.
.TP
\fBlevel\fR
.
For a frame that corresponds to a level, (to be determined).
This entry is present only if the queried frame has a corresponding
frame returned by \fBinfo level\fR. It provides the index of this
frame, relative to the current level (0 and negative numbers).
.PP
When a command can be traced to its literal definition in some script, e.g.
procedures nested in statically defined procedures, and literal eval scripts in
files or statically defined procedures, its type is \fBsource\fR and its
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
location is the absolute line number in the script.  Otherwise, its type is
\fBproc\fR and its location is its line number within the body of the
procedure.
defined procedures.
.PP
In contrast, procedure definitions and \fBeval\fR within a dynamically
\fBeval\fRuated environment count line numbers relative to the start of
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
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
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 given, returns a list of all the math
If \fIpattern\fR is not specified, returns a list of all the math
functions currently defined.
If \fIpattern\fR is given, returns only those names that match
\fIpattern\fR according to \fBstring match\fR.
If \fIpattern\fR is specified, only those functions whose name matches
\fIpattern\fR are returned.  Matching is determined using the same
rules as for \fBstring match\fR.
.TP
\fBinfo globals \fR?\fIpattern\fR?
.
If \fIpattern\fR is not given, returns a list of all the names
If \fIpattern\fR is not specified, returns a list of all the names
of currently-defined global variables.
Global variables are variables in the global namespace.
If \fIpattern\fR is given, only those names matching \fIpattern\fR
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
are returned.  Matching is determined using the same rules as for
\fBstring match\fR.
.TP
\fBinfo hostname\fR
.
Returns the name of the current host.

This name is not guaranteed to be the fully-qualified domain
name of the host.  Where machines have several different names, as is
Returns the name of the computer on which this invocation is being
executed.
Note that this name is not guaranteed to be the fully qualified domain
name of the host.  Where machines have several different names (as is
common on systems with both TCP/IP (DNS) and NetBIOS-based networking
installed, it is the name that is suitable for TCP/IP networking that
installed,) it is the name that is suitable for TCP/IP networking that
is returned.
.TP
\fBinfo level\fR ?\fIlevel\fR?
\fBinfo level\fR ?\fInumber\fR?
.
If \fInumber\fR is not given, the level this routine was called from.
Otherwise returns the complete command active at the given level.  If
\fInumber\fR is greater than \fB0\fR, it is the desired level.  Otherwise, it
is \fInumber\fR levels up from the current level.  A complete command is the
If \fInumber\fR is not specified, this command returns a number
giving the stack level of the invoking procedure, or 0 if the
command is invoked at top-level.  If \fInumber\fR is specified,
then the result is a list consisting of the name and arguments for the
procedure call at level \fInumber\fR on the stack.  If \fInumber\fR
is positive then it selects a particular stack level (1 refers
to the top-most active procedure, 2 to the procedure it called, and
so on); otherwise it gives a level relative to the current level
words in the command, with all subsitutions performed, meaning that it is a
list.  See \fBuplevel\fR for more information on levels.
(0 refers to the current procedure, -1 to its caller, and so on).
See the \fBuplevel\fR command for more information on what stack
levels mean.
.TP
\fBinfo library\fR
.
Returns the value of \fBtcl_library\fR, which is the name of the library
directory in which the scripts distributed with Tcl scripts are stored.
Returns the name of the library directory in which standard Tcl
scripts are stored.
This is actually the value of the \fBtcl_library\fR
variable and may be changed by setting \fBtcl_library\fR.
See the \fBtclvars\fR manual entry for more information.
.TP
\fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR?
\fBinfo loaded \fR?\fIinterp\fR?
.
Returns the name of each file loaded in \fIinterp\fR va \fBload\fR as part of
\fIpackage\fR .  If \fIpackage\fR is not given, returns a list where each item
is the name of the loaded file and the name of the package for which the file
was loaded.  For a statically-loaded package the name of the file is the empty
string.  For \fIinterp\fR, the empty string is the current interpreter.
Returns a list describing all of the packages that have been loaded into
\fIinterp\fR with the \fBload\fR command.
Each list element is a sub-list with two elements consisting of the
name of the file from which the package was loaded and the name of
the package.
For statically-loaded packages the file name will be an empty string.
If \fIinterp\fR is omitted then information is returned for all packages
loaded in any interpreter in the process.
To get a list of just the packages in the current interpreter, specify
an empty string for the \fIinterp\fR argument.
.TP
\fBinfo locals \fR?\fIpattern\fR?
.
If \fIpattern\fR is given, returns the name of each local variable matching
\fIpattern\fR according to \fBstring match\fR.  Otherwise, returns the name of
each local variable.  A variables defined with the \fBglobal\fR, \fBupvar\fR or
\fBvariable\fR is not local.

If \fIpattern\fR is not specified, returns a list of all the names
of currently-defined local variables, including arguments to the
current procedure, if any.
Variables defined with the \fBglobal\fR, \fBupvar\fR  and
\fBvariable\fR commands will not be returned.
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
are returned.  Matching is determined using the same rules as for
\fBstring match\fR.
.TP
\fBinfo nameofexecutable\fR
.
Returns the absolute pathname of the program for the current interpreter.  If
such a file can not be identified an empty string is returned.
Returns the full path name of the binary file from which the application
was invoked.  If Tcl was unable to identify the file, then an empty
string is returned.
.TP
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
.
Returns information about the object named \fIobject\fR. \fIsubcommand\fR is
described \fBOBJECT INTROSPECTION\fR below.
.TP
\fBinfo patchlevel\fR
.
Returns the value of the global variable \fBtcl_patchLevel\fR, in which the
Returns the value of the global variable \fBtcl_patchLevel\fR; see
exact version of the Tcl library initially stored.
the \fBtclvars\fR manual entry for more information.
.TP
\fBinfo procs \fR?\fIpattern\fR?
.
Returns the names of all visible procedures. If \fIpattern\fR is given, returns
only those names that match according to \fBstring match\fR.  Only the final
component in \fIpattern\fR is actually considered a pattern.  Any qualifying
components simply select a namespace.  See \fBNAMESPACE RESOLUTION\fR in the
\fBnamespace\fR(n) documentation.
If \fIpattern\fR is not specified, returns a list of all the
names of Tcl command procedures in the current namespace.
If \fIpattern\fR is specified,
only those procedure names in the current namespace
matching \fIpattern\fR are returned.
Matching is determined using the same rules as for
\fBstring match\fR.
If \fIpattern\fR contains any namespace separators, they are used to
select a namespace relative to the current namespace (or relative to
the global namespace if \fIpattern\fR starts with \fB::\fR) to match
within; the matching pattern is taken to be the part after the last
namespace separator.
.TP
\fBinfo script\fR ?\fIfilename\fR?
.
Returns the pathname of the innermost script currently being evaluated, or the
empty string if no pathname can be determined.  If \fIfilename\fR is given,
sets the return value of any future calls to \fBinfo script\fR for the duration
of the innermost active script.  This is useful in virtual file system
applications.
If a Tcl script file is currently being evaluated (i.e. there is a
call to \fBTcl_EvalFile\fR active or there is an active invocation
of the \fBsource\fR command), then this command returns the name
of the innermost file being processed.  If \fIfilename\fR is specified,
then the return value of this command will be modified for the
duration of the active invocation to return that name.  This is
useful in virtual file system applications.
Otherwise the command returns an empty string.
.TP
\fBinfo sharedlibextension\fR
.
Returns the extension used on this platform for names of shared libraries, e.g.
\fB.so\fR under Solaris.  Returns the empty string if shared libraries are not
supported on this platform.
Returns the extension used on this platform for the names of files
containing shared libraries (for example, \fB.so\fR under Solaris).
If shared libraries are not supported on this platform then an empty
string is returned.
.TP
\fBinfo tclversion\fR
.
Returns the value of the global variable \fBtcl_version\fR, in which the
Returns the value of the global variable \fBtcl_version\fR; see
major and minor version of the Tcl library are stored.
the \fBtclvars\fR manual entry for more information.
.TP
\fBinfo vars\fR ?\fIpattern\fR?
.
If \fIpattern\fR is not given, returns the names of all visible variables.  If
If \fIpattern\fR is not specified,
\fIpattern\fR is given, returns only those names that match according to
\fBstring match\fR.  Only the last component of \fIpattern\fR is a pattern.
Other components identify a namespace.  See \fBNAMESPACE RESOLUTION\fR in the
\fBnamespace\fR(n) documentation.  When \fIpattern\fR is a qualified name,
results are fully qualified.

A variable that has declared but not yet defined is included in the results.
returns a list of all the names of currently-visible variables.
This includes locals and currently-visible globals.
.SS "CLASS INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
.TP
\fBinfo class call\fI class method\fR
.
Returns a description of the method implementations that are used to provide a
stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
(stereotypical instances being objects instantiated by a class without having
any object-specific definitions added). This consists of a list of lists of
four elements, where each sublist consists of a word that describes the
general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
.QW \fBunknown\fR
for the \fBunknown\fR type), a word giving the fully qualified name of the
class that defined the method, and a word describing the type of method
implementation (see \fBinfo class methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE
.TP
\fBinfo class constructor\fI class\fR
.
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.
.TP
\fBinfo class definition\fI class method\fR
.
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.
.TP
\fBinfo class definitionnamespace\fI class\fR ?\fIkind\fR?
.VS TIP524
This subcommand returns the definition namespace for \fIkind\fR definitions of
the class \fIclass\fR; the definition namespace only affects the instances of
\fIclass\fR, not \fIclass\fR itself. The \fIkind\fR can be either
\fB\-class\fR to return the definition namespace used for \fBoo::define\fR, or
\fB\-instance\fR to return the definition namespace used for
\fBoo::objdefine\fR; the \fB\-class\fR kind is default (though this is only
actually useful on classes that are subclasses of \fBoo::class\fR).
.RS
.PP
If \fIclass\fR does not provide a definition namespace of the given kind,
this command returns the empty string. In those circumstances, the
\fBoo::define\fR and \fBoo::objdefine\fR commands look up which definition
namespace to use using the class inheritance hierarchy.
.RE
.VE TIP524
.TP
\fBinfo class destructor\fI class\fR
.
This subcommand returns the body of the destructor of class \fIclass\fR. If no
destructor is present, this returns the empty string.
.TP
\fBinfo class filters\fI class\fR
.
This subcommand returns the list of filter methods set on the class.
.TP
\fBinfo class forward\fI class method\fR
.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the class called \fIclass\fR.
.TP
\fBinfo class instances\fI class\fR ?\fIpattern\fR?
If \fIpattern\fR is specified, only those names matching \fIpattern\fR
.
This subcommand returns a list of instances of class \fIclass\fR. If the
optional \fIpattern\fR argument is present, it constrains the list of returned
instances to those that match it according to the rules of \fBstring match\fR.
.TP
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
.
This subcommand returns a list of all public (i.e. exported) methods of the
class called \fIclass\fR. Any of the following \fIoption\fRs may be
given, controlling exactly which method names are returned:
.RS
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
methods defined not just by the class, but also by the class's superclasses
and mixins.
.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the class (and superclasses and
mixins, if \fB\-all\fR is also given).
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIclass\fR that have the given visibility
\fIscope\fR.  When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance
of this class) are to be returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
are returned.  Matching is determined using the same rules as for
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this class's
methods) are to be returned.
.RE
.VE TIP500
.RE
.TP
\fBinfo class methodtype\fI class method\fR
.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of class \fIclass\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo class
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo class forward\fR.
.TP
\fBinfo class mixins\fI class\fR
.
This subcommand returns a list of all classes that have been mixed into the
class named \fIclass\fR.
.TP
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
.
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
returned classes to those that match it according to the rules of
\fBstring match\fR.
.TP
\fBinfo class superclasses\fI class\fR
.
This subcommand returns a list of direct superclasses of class \fIclass\fR in
inheritance precedence order.
.TP
\fBinfo class variables\fI class\fR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the class named \fIclass\fR (i.e. that are automatically present in the
class's methods, constructor and destructor).
.VS TIP500
If the \fB\-private\fR option is given, this lists the private variables
declared instead.
\fIpattern\fR can be a qualified name like \fBFoo::option*\fR.
That is, it may specify a particular namespace
.VE TIP500
.SS "OBJECT INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
using a sequence of namespace names separated by double colons (\fB::\fR),
.TP
\fBinfo object call\fI object method\fR
.
Returns a description of the method implementations that are used to provide
\fIobject\fR's implementation of \fImethod\fR.  This consists of a list of
lists of four elements, where each sublist consists of a word that describes
the general type of method implementation (being one of \fBmethod\fR for an
ordinary method, \fBfilter\fR for an applied filter,
.VS TIP500
\fBprivate\fR for a private method,
.VE TIP500
and \fBunknown\fR for a
and may have pattern matching special characters
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
.QW \fBunknown\fR
for the \fBunknown\fR type), a word giving what defined the method (the fully
qualified name of the class, or the literal string \fBobject\fR if the method
implementation is on an instance), and a word describing the type of method
implementation (see \fBinfo object methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
actually use \fBnext\fR to transfer control along the call chain,
.VS TIP500
and the call chains that this command files do not actually contain private
methods.
.VE TIP500
.RE
.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?
.
If \fIclassName\fR is not given, this subcommand returns class of the
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.TP
\fBinfo object creationid\fI object\fR
.VS TIP500
Returns the unique creation identifier for the \fIobject\fR object. This
creation identifier is unique to the object (within a Tcl interpreter) and
cannot be controlled at object creation time or altered afterwards.
.RS
.PP
\fIImplementation note:\fR the creation identifier is used to generate unique
identifiers associated with the object, especially for private variables.
at the end to specify a set of variables in that namespace.
.RE
.VE TIP500
.TP
\fBinfo object definition\fI object method\fR
.
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.
.TP
\fBinfo object filters\fI object\fR
.
This subcommand returns the list of filter methods set on the object.
.TP
\fBinfo object forward\fI object method\fR
.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the object called \fIobject\fR.
.TP
\fBinfo object isa\fI category object\fR ?\fIarg\fR?
.
This subcommand tests whether an object belongs to a particular category,
returning a boolean value that indicates whether the \fIobject\fR argument
meets the criteria for the category. The supported categories are:
.RS
.TP
\fBinfo object isa class\fI object\fR
.
This returns whether \fIobject\fR is a class (i.e. an instance of
\fBoo::class\fR or one of its subclasses).
.TP
\fBinfo object isa metaclass\fI object\fR
.
This returns whether \fIobject\fR is a class that can manufacture classes
(i.e. is \fBoo::class\fR or a subclass of it).
.TP
\fBinfo object isa mixin\fI object class\fR
.
This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
.TP
\fBinfo object isa object\fI object\fR
.
This returns whether \fIobject\fR really is an object.
.TP
\fBinfo object isa typeof\fI object class\fR
.
This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
direct or indirect).
.RE
.TP
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
.
This subcommand returns a list of all public (i.e. exported) methods of the
object called \fIobject\fR. Any of the following \fIoption\fRs may be
given, controlling exactly which method names are returned:
.RS
.TP
\fB\-all\fR
.
If the \fB\-all\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will include those
methods defined not just by the object, but also by the object's class and
mixins, plus the superclasses of those classes.
.TP
\fB\-private\fR
.
If the \fB\-private\fR flag is given,
.VS TIP500
and the \fB\-scope\fR flag is not given,
.VE TIP500
the list of methods will also include
the non-exported methods of the object (and classes, if
\fB\-all\fR is also given).
If \fIpattern\fR is a qualified name,
.VS TIP500
Note that this naming is an unfortunate clash with true private methods; this
option name is retained for backward compatibility.
.VE TIP500
.TP
\fB\-scope\fI scope\fR
.VS TIP500
Returns a list of all methods on \fIobject\fR that have the given visibility
\fIscope\fR.  When this option is supplied, both the \fB\-all\fR and
\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
.RS
.IP \fBpublic\fR 3
Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be
returned.
.IP \fBunexported\fR 3
Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
be returned.
.IP \fBprivate\fR 3
Only methods with \fIprivate\fR scope (i.e., only callable from within this object's
instance methods) are to be returned.
.RE
.VE TIP500
.RE
.TP
\fBinfo object methodtype\fI object method\fR
.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of object \fIobject\fR. When the result is
the resulting list of variable names
\fBmethod\fR, further information can be discovered with \fBinfo object
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo object forward\fR.
has each matching namespace variable qualified with the name
.TP
\fBinfo object mixins\fI object\fR
.
This subcommand returns a list of all classes that have been mixed into the
object named \fIobject\fR.
.TP
\fBinfo object namespace\fI object\fR
.
of its namespace.
Note that a currently-visible variable may not yet
.QW exist
This subcommand returns the name of the internal namespace of the object named
\fIobject\fR.
.TP
\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
if it has not
.VS TIP500
If the \fB\-private\fR option is given, this lists the private variables
declared instead.
been set (e.g. a variable declared but not set by \fBvariable\fR).
.VE TIP500
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
.
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).
.SH EXAMPLES
.SH EXAMPLE
.PP
This command prints out a procedure suitable for saving in a Tcl
script:
.PP
.CS
proc printProc {procName} {
    set result [list proc $procName]
    set formals {}
    foreach var [\fBinfo args\fR $procName] {
        if {[\fBinfo default\fR $procName $var def]} {
            lappend formals [list $var $def]
        } else {
            # Still need the list-quoting because variable
            # names may properly contain spaces.
            lappend formals [list $var]
        }
    }
    puts [lappend result $formals [\fBinfo body\fR $procName]]
}
.CE
.SS "EXAMPLES WITH OBJECTS"
.PP
Every object necessarily knows what its class is; this information is
trivially extractable through introspection:
.PP
.CS
oo::class create c
c create o
puts [\fBinfo object class\fR o]
                     \fI\(-> prints "::c"\fR
puts [\fBinfo object class\fR c]
                     \fI\(-> prints "::oo::class"\fR
.CE
.PP
The introspection capabilities can be used to discover what class implements a
method and get how it is defined. This procedure illustrates how:
.PP
.CS
proc getDef {obj method} {
    foreach inf [\fBinfo object call\fR $obj $method] {
        lassign $inf calltype name locus methodtype

        # Assume no forwards or filters, and hence no $calltype
        # or $methodtype checks...

        if {$locus eq "object"} {
            return [\fBinfo object definition\fR $obj $name]
        } else {
            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
.SH "SEE ALSO"
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
global(n), proc(n)
tcl_library(n), tcl_patchLevel(n), tcl_version(n)
.SH KEYWORDS
command, information, interpreter, introspection, level, namespace,
command, information, interpreter, level, namespace, procedure, variable
object, procedure, variable
'\" Local Variables:
'\" mode: nroff
.\" Local Variables:
.\" mode: nroff
'\" fill-column: 78
'\" End:
.\" End:

Changes to doc/interp.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
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
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



-



-
-
+
+












-
-
-
-
+
+
+
+




-
+

-
-
+
+



+
-
+
+
+






-
+












-
+



-
+

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




-
-
+
+





-
+




-




-
+


-
-
+






-
-
-
-
+
+
+







-
-
+
-
-
-
-
+
+
+















-







-
-
+
+

-
+

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


-
-
-
-
+
+
+


-
+

-
+


-
-
+
+

-
+



-
-
-
-
+
+
+
+


-
+


-
-
+
+


-
+


-

+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2004 Donal K. Fellows
'\" Copyright (c) 2006-2008 Joe Mistachkin.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH interp n 8.6 Tcl "Tcl Built-In Commands"
'\" 
.TH interp n 7.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
interp \- Create and manipulate Tcl interpreters
.SH SYNOPSIS
\fBinterp \fIsubcommand \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command makes it possible to create one or more new Tcl
interpreters that co-exist with the creating interpreter in the
same application.  The creating interpreter is called the \fIparent\fR
and the new interpreter is called a \fIchild\fR.
A parent can create any number of children, and each child can
itself create additional children for which it is parent, resulting
same application.  The creating interpreter is called the \fImaster\fR
and the new interpreter is called a \fIslave\fR.
A master can create any number of slaves, and each slave can
itself create additional slaves for which it is master, resulting
in a hierarchy of interpreters.
.PP
Each interpreter is independent from the others: it has its own name
space for commands, procedures, and global variables.
A parent interpreter may create connections between its children and
A master interpreter may create connections between its slaves and
itself using a mechanism called an \fIalias\fR.  An \fIalias\fR is
a command in a child interpreter which, when invoked, causes a
command to be invoked in its parent interpreter or in another child
a command in a slave interpreter which, when invoked, causes a
command to be invoked in its master interpreter or in another slave
interpreter.  The only other connections between interpreters are
through environment variables (the \fBenv\fR variable), which are
normally shared among all interpreters in the application,
.VS 8.5
and by resource limit exceeded callbacks. Note that the
and by resource limit exceeded callbacks.
.VE 8.5
Note that the
name space for files (such as the names returned by the \fBopen\fR command)
is no longer shared between interpreters. Explicit commands are provided to
share files and to transfer references to open files from one interpreter
to another.
.PP
The \fBinterp\fR command also provides support for \fIsafe\fR
interpreters.  A safe interpreter is a child whose functions have
interpreters.  A safe interpreter is a slave whose functions have
been greatly restricted, so that it is safe to execute untrusted
scripts without fear of them damaging other interpreters or the
application's environment. For example, all IO channel creation
commands and subprocess creation commands are made inaccessible to safe
interpreters.
See \fBSAFE INTERPRETERS\fR below for more information on
what features are present in a safe interpreter.
The dangerous functionality is not removed from the safe interpreter;
instead, it is \fIhidden\fR, so that only trusted interpreters can obtain
access to it. For a detailed explanation of hidden commands, see
\fBHIDDEN COMMANDS\fR, below.
The alias mechanism can be used for protected communication (analogous to a
kernel call) between a child interpreter and its parent.
kernel call) between a slave interpreter and its master.
See \fBALIAS INVOCATION\fR, below, for more details
on how the alias mechanism works.
.PP
A qualified interpreter name is a proper Tcl list containing a subset of its
A qualified interpreter name is a proper Tcl lists containing a subset of its
ancestors in the interpreter hierarchy, terminated by the string naming the
interpreter in its immediate parent. Interpreter names are relative to the
interpreter in which they are used. For example, if
interpreter in its immediate master. Interpreter names are relative to the
interpreter in which they are used. For example, if \fBa\fR is a slave of
.QW \fBa\fR
is a child of the current interpreter and it has a child
the current interpreter and it has a slave \fBa1\fR, which in turn has a
.QW \fBa1\fR ,
which in turn has a child
.QW \fBa11\fR ,
the qualified name of
slave \fBa11\fR, the qualified name of \fBa11\fR in \fBa\fR is the list
.QW \fBa11\fR
in
.QW \fBa\fR
is the list
.QW "\fBa1 a11\fR" .
\fBa1 a11\fR.
.PP
The \fBinterp\fR command, described below, accepts qualified interpreter
names as arguments; the interpreter in which the command is being evaluated
can always be referred to as \fB{}\fR (the empty list or string). Note that
it is impossible to refer to a parent (ancestor) interpreter by name in a
child interpreter except through aliases. Also, there is no global name by
it is impossible to refer to a master (ancestor) interpreter by name in a
slave interpreter except through aliases. Also, there is no global name by
which one can refer to the first interpreter created in an application.
Both restrictions are motivated by safety concerns.
.SH "THE INTERP COMMAND"
.PP
The \fBinterp\fR command is used to create, delete, and manipulate
child interpreters, and to share or transfer
slave interpreters, and to share or transfer
channels between interpreters.  It can have any of several forms, depending
on the \fIsubcommand\fR argument:
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR
.
Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the name of the source command in the
child is different from \fIsrcToken\fR).
slave is different from \fIsrcToken\fR).
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcToken\fR \fB{}\fR
.
Deletes the alias for \fIsrcToken\fR in the child interpreter identified by
Deletes the alias for \fIsrcToken\fR in the slave interpreter identified by
\fIsrcPath\fR.
\fIsrcToken\fR refers to the value returned when the alias
was created;  if the source command has been renamed, the renamed
command will be deleted.
.TP
\fBinterp\fR \fBalias\fR \fIsrcPath\fR \fIsrcCmd\fR \fItargetPath\fR \fItargetCmd \fR?\fIarg arg ...\fR?
.
This command creates an alias between one child and another (see the
\fBalias\fR child command below for creating aliases between a child
and its parent).  In this command, either of the child interpreters
This command creates an alias between one slave and another (see the
\fBalias\fR slave command below for creating aliases between a slave
and its master).  In this command, either of the slave interpreters
may be anywhere in the hierarchy of interpreters under the interpreter
invoking the command.
\fISrcPath\fR and \fIsrcCmd\fR identify the source of the alias.
\fISrcPath\fR is a Tcl list whose elements select a particular
interpreter.  For example,
.QW "\fBa b\fR"
identifies an interpreter
.QW \fBb\fR ,
which is a child of interpreter
\fBb\fR, which is a slave of interpreter \fBa\fR, which is a slave
.QW \fBa\fR ,
which is a child of the invoking interpreter.  An empty list specifies
the interpreter invoking the command.  \fIsrcCmd\fR gives the name of
a new command, which will be created in the source interpreter.
of the invoking interpreter.  An empty list specifies the interpreter
invoking the command.  \fIsrcCmd\fR gives the name of a new
command, which will be created in the source interpreter.
\fITargetPath\fR and \fItargetCmd\fR specify a target interpreter
and command, and the \fIarg\fR arguments, if any, specify additional
arguments to \fItargetCmd\fR which are prepended to any arguments specified
in the invocation of \fIsrcCmd\fR.
\fITargetCmd\fR may be undefined at the time of this call, or it may
already exist; it is not created by this command.
The alias arranges for the given target command to be invoked
in the target interpreter whenever the given source command is
invoked in the source interpreter.  See \fBALIAS INVOCATION\fR below for
more details.
The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
\fBinterp\fR \fBaliases \fR?\fIpath\fR?
.
This command returns a Tcl list of the tokens of all the source commands for
aliases defined in the interpreter identified by \fIpath\fR. The tokens
correspond to the values returned when
the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fBinterp bgerror \fIpath\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background exception handler
.VS 8.5
This command either gets or sets the current background error handler
for the interpreter identified by \fIpath\fR. If \fIcmdPrefix\fR is
absent, the current background exception handler is returned, and if it is
absent, the current background error handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background exception handler to. See the
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
.TP
what to set the interpreter's background error to. See the
\fBBACKGROUND ERROR HANDLING\fR section for more details.
.VE 8.5
\fBinterp\fR \fBcancel \fR?\fB\-unwind\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? ?\fIresult\fR?
Cancels the script being evaluated in the interpreter identified by
\fIpath\fR. Without the \fB\-unwind\fR switch the evaluation stack for
the interpreter is unwound until an enclosing catch command is found or
there are no further invocations of the interpreter left on the call
stack. With the \fB\-unwind\fR switch the evaluation stack for the
interpreter is unwound without regard to any intervening catch command
until there are no further invocations of the interpreter left on the
call stack. The \fB\-\|\-\fR switch can be used to mark the end of
switches; it may be needed if \fIpath\fR is an unusual value such
as \fB\-safe\fR. If \fIresult\fR is present, it will be used as the
error message string; otherwise, a default error message string will be
used.
.TP
\fBinterp\fR \fBcreate \fR?\fB\-safe\fR? ?\fB\-\|\-\fR? ?\fIpath\fR?
.
Creates a child interpreter identified by \fIpath\fR and a new command,
called a \fIchild command\fR. The name of the child command is the last
component of \fIpath\fR. The new child interpreter and the child command
Creates a slave interpreter identified by \fIpath\fR and a new command,
called a \fIslave command\fR. The name of the slave command is the last
component of \fIpath\fR. The new slave interpreter and the slave command
are created in the interpreter identified by the path obtained by removing
the last component from \fIpath\fR. For example, if \fIpath\fR is \fBa b
c\fR then a new child interpreter and child command named \fBc\fR are
c\fR then a new slave interpreter and slave command named \fBc\fR are
created in the interpreter identified by the path \fBa b\fR.
The child command may be used to manipulate the new interpreter as
The slave command may be used to manipulate the new interpreter as
described below. If \fIpath\fR is omitted, Tcl creates a unique name of the
form \fBinterp\fIx\fR, where \fIx\fR is an integer, and uses it for the
interpreter and the child command. If the \fB\-safe\fR switch is specified
(or if the parent interpreter is a safe interpreter), the new child
interpreter and the slave command. If the \fB\-safe\fR switch is specified
(or if the master interpreter is a safe interpreter), the new slave
interpreter will be created as a safe interpreter with limited
functionality; otherwise the child will include the full set of Tcl
functionality; otherwise the slave will include the full set of Tcl
built-in commands and variables. The \fB\-\|\-\fR switch can be used to
mark the end of switches;  it may be needed if \fIpath\fR is an unusual
value such as \fB\-safe\fR. The result of the command is the name of the
new interpreter. The name of a child interpreter must be unique among all
the children for its parent;  an error occurs if a child interpreter by the
given name already exists in this parent.
The initial recursion limit of the child interpreter is set to the
new interpreter. The name of a slave interpreter must be unique among all
the slaves for its master;  an error occurs if a slave interpreter by the
given name already exists in this master.
The initial recursion limit of the slave interpreter is set to the
current recursion limit of its parent interpreter.
.TP
\fBinterp\fR \fBdebug \fIpath\fR ?\fB\-frame\fR ?\fIbool\fR??
\fBinterp\fR \fBdebug \fIpath\fR ?\fI\-frame\fR ?\fIbool\fR??
.
Controls whether frame-level stack information is captured in the
child interpreter identified by \fIpath\fR.  If no arguments are
given, option and current setting are returned.  If \fB\-frame\fR
slave interpreter identified by \fIpath\fR.  If no arguments are
given, option and current setting are returned.  If \fI\-frame\fR
is given, the debug setting is set to the given boolean if provided
and the current setting is returned.
This only affects the output of \fBinfo frame\fR, in that exact
This only effects the output of \fBinfo frame\fR, in that exact
frame-level information for command invocation at the bytecode level
is only captured with this setting on.
.RS
.PP
.RS
For example, with code like
.PP
.CS
\fBproc\fR mycontrol {... script} {
  ...
  \fBuplevel\fR 1 $script
  ...
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
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
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


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
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
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
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







-
-
-
-


-
+
-

-
-
+
+




-


-
+




-
-
-
+
+
+



-
-
-
+
+



-










-










-
+




-




-




















-
-
-
-
-

-
+







+

+
+
+
+

-







-



-
+















-








-
+
-
-
+




-










-



-
+

-
-
+
+



-

-
+

-
-
+



-
+
-

-
+



-
+
-




-
+

-
+
-
-
+




-
+
-

-
+








-
-
-
-
-
+
+
+
+
+

-
-
+
+
+

-
+
-


-
+




-
-
-
+
+
+


-
+
-



-
+




-
+
-


-
+






-
+



-
+
-
-
+

-
+
-

-
+




-
+

-
+







-
+



-
+
-
-
+

-
-
+
+

-
+





+

-
+
-
-
+

-
+


-
+
-
-
-
+
+

-
+







the standard setting will provide a relative line number for the
command \fBsomecode\fR and the relevant frame will be of type
\fBeval\fR. With frame-debug active on the other hand the tracking
extends so far that the system will be able to determine the file and
absolute line number of this command, and return a frame of type
\fBsource\fR. This more exact information is paid for with slower
execution of all commands.
.PP
Note that once it is on, this flag cannot be switched back off: such
attempts are silently ignored. This is needed to maintain the
consistency of the underlying interpreter's state.
.RE
.TP
\fBinterp\fR \fBdelete \fR?\fIpath ...\fR?
\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its children. The
command also deletes the child command for each interpreter deleted.
arguments, and for each interpreter, it also deletes its slaves. The
command also deletes the slave command for each interpreter deleted.
For each \fIpath\fR argument, if no interpreter by that name
exists, the command raises an error.
.TP
\fBinterp\fR \fBeval\fR \fIpath arg \fR?\fIarg ...\fR?
.
This command concatenates all of the \fIarg\fR arguments in the same
fashion as the \fBconcat\fR command, then evaluates the resulting string as
a Tcl script in the child interpreter identified by \fIpath\fR. The result
a Tcl script in the slave interpreter identified by \fIpath\fR. The result
of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame of the
\fIpath\fR interpreter; this is so that the implementations (in a parent
interpreter) of aliases in a child interpreter can execute scripts in
the child that find out information about the child's current state
\fIpath\fR interpreter; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
the slave that find out information about the slave's current state
and stack frame.
.TP
\fBinterp exists \fIpath\fR
.
Returns \fB1\fR if a child interpreter by the specified \fIpath\fR
exists in this parent, \fB0\fR otherwise. If \fIpath\fR is omitted, the
Returns \fB1\fR if a slave interpreter by the specified \fIpath\fR
exists in this master, \fB0\fR otherwise. If \fIpath\fR is omitted, the
invoking interpreter is used.
.TP
\fBinterp expose \fIpath\fR \fIhiddenName\fR ?\fIexposedCmdName\fR?
.
Makes the hidden command \fIhiddenName\fR exposed, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
in the interpreter
denoted by \fIpath\fR.
If an exposed command with the targeted name already exists, this command
fails.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
\fBinterp\fR \fBhide\fR \fIpath\fR \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
.
Makes the exposed command \fIexposedCmdName\fR hidden, renaming
it to the hidden command \fIhiddenCmdName\fR, or keeping the same name if
\fIhiddenCmdName\fR is not given, in the interpreter denoted
by \fIpath\fR.
If a hidden command with the targeted name already exists, this command
fails.
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
prevents children from fooling a parent interpreter into hiding the wrong
prevents slaves from fooling a master interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
\fBinterp\fR \fBhidden\fR \fIpath\fR
.
Returns a list of the names of all hidden commands in the interpreter
identified by \fIpath\fR.
.TP
\fBinterp\fR \fBinvokehidden\fR \fIpath\fR ?\fI\-option ...\fR? \fIhiddenCmdName\fR ?\fIarg ...\fR?
.
Invokes the hidden command \fIhiddenCmdName\fR with the arguments supplied
in the interpreter denoted by \fIpath\fR. No substitutions or evaluation
are applied to the arguments. Three \fI\-option\fRs are supported, all
of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
If the \fB\-namespace\fR flag is present, the hidden command is invoked in
the namespace called \fInsName\fR in the target interpreter.
If the \fB\-global\fR flag is present, the hidden command is invoked at the
global level in the target interpreter; otherwise it is invoked at the
current call frame and can access local variables in that and outer call
frames.
The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
.QW \-
character, and is otherwise unnecessary.
If both the \fB\-namespace\fR and \fB\-global\fR flags are present, the
\fB\-namespace\fR flag is ignored.
Note that the hidden command will be executed (by default) in the
current context stack frame of the \fIpath\fR interpreter.
Hidden commands are explained in more detail in \fBHIDDEN COMMANDS\fR, below.
.TP
\fBinterp issafe\fR ?\fIpath\fR?
.
Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR
is safe, \fB0\fR otherwise.
.TP
\fBinterp\fR \fBlimit\fR \fIpath\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
.
.VS 8.5
Sets up, manipulates and queries the configuration of the resource
limit \fIlimitType\fR for the interpreter denoted by \fIpath\fR.  If
no \fI\-option\fR is specified, return the current configuration of the
limit.  If \fI\-option\fR is the sole argument, return the value of that
option.  Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs
must supplied. See \fBRESOURCE LIMITS\fR below for a more detailed
explanation of what limits and options are supported.
.VE 8.5
.TP
\fBinterp issafe\fR ?\fIpath\fR?
Returns \fB1\fR if the interpreter identified by the specified \fIpath\fR
is safe, \fB0\fR otherwise.
.TP
\fBinterp marktrusted\fR \fIpath\fR
.
Marks the interpreter identified by \fIpath\fR as trusted. Does
not expose the hidden commands. This command can only be invoked from a
trusted interpreter.
The command has no effect if the interpreter identified by \fIpath\fR is
already trusted.
.TP
\fBinterp\fR \fBrecursionlimit\fR \fIpath\fR ?\fInewlimit\fR?
.
Returns the maximum allowable nesting depth for the interpreter
specified by \fIpath\fR.  If \fInewlimit\fR is specified,
the interpreter recursion limit will be set so that nesting
of more than \fInewlimit\fR calls to \fBTcl_Eval\fR
of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
and related procedures in that interpreter will return an error.
The \fInewlimit\fR value is also returned.
The \fInewlimit\fR value must be a positive integer between 1 and the
maximum value of a non-long integer on the platform.
.RS
.PP
The command sets the maximum size of the Tcl call stack only. It cannot
by itself prevent stack overflows on the C stack being used by the
application. If your machine has a limit on the size of the C stack, you
may get stack overflows before reaching the limit set by the command. If
this happens, see if there is a mechanism in your system for increasing
the maximum size of the C stack.
.RE
.TP
\fBinterp\fR \fBshare\fR \fIsrcPath channelId destPath\fR
.
Causes the IO channel identified by \fIchannelId\fR to become shared
between the interpreter identified by \fIsrcPath\fR and the interpreter
identified by \fIdestPath\fR. Both interpreters have the same permissions
on the IO channel.
Both interpreters must close it to close the underlying IO channel; IO
channels accessible in an interpreter are automatically closed when an
interpreter is destroyed.
.TP
\fBinterp\fR \fBchildren\fR ?\fIpath\fR?
\fBinterp\fR \fBslaves\fR ?\fIpath\fR?
.
Returns a Tcl list of the names of all the child interpreters associated
Returns a Tcl list of the names of all the slave interpreters associated
with the interpreter identified by \fIpath\fR. If \fIpath\fR is omitted,
the invoking interpreter is used.
.TP
\fBinterp\fR \fBtarget\fR \fIpath alias\fR
.
Returns a Tcl list describing the target interpreter for an alias. The
alias is specified with an interpreter path and source command name, just
as in \fBinterp alias\fR above. The name of the target interpreter is
returned as an interpreter path, relative to the invoking interpreter.
If the target interpreter for the alias is the invoking interpreter then an
empty list is returned. If the target interpreter for the alias is not the
invoking interpreter or one of its descendants then an error is generated.
The target command does not have to be defined at the time of this invocation.
.TP
\fBinterp\fR \fBtransfer\fR \fIsrcPath channelId destPath\fR
.
Causes the IO channel identified by \fIchannelId\fR to become available in
the interpreter identified by \fIdestPath\fR and unavailable in the
interpreter identified by \fIsrcPath\fR.
.SH "CHILD COMMAND"
.SH "SLAVE COMMAND"
.PP
For each child interpreter created with the \fBinterp\fR command, a
new Tcl command is created in the parent interpreter with the same
For each slave interpreter created with the \fBinterp\fR command, a
new Tcl command is created in the master interpreter with the same
name as the new interpreter. This command may be used to invoke
various operations on the interpreter.  It has the following
general form:
.PP
.CS
\fIchild command \fR?\fIarg arg ...\fR?
\fIslave command \fR?\fIarg arg ...\fR?
.CE
.PP
\fIChild\fR is the name of the interpreter, and \fIcommand\fR
\fISlave\fR is the name of the interpreter, and \fIcommand\fR
and the \fIarg\fRs determine the exact behavior of the command.
The valid forms of this command are:
.TP
\fIchild \fBaliases\fR
\fIslave \fBaliases\fR
.
Returns a Tcl list whose elements are the tokens of all the
aliases in \fIchild\fR.  The tokens correspond to the values returned when
aliases in \fIslave\fR.  The tokens correspond to the values returned when
the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fIchild \fBalias \fIsrcToken\fR
\fIslave \fBalias \fIsrcToken\fR
.
Returns a Tcl list whose elements are the \fItargetCmd\fR and
\fIarg\fRs associated with the alias represented by \fIsrcToken\fR
(this is the value returned when the alias was
created; it is possible that the actual source command in the
child is different from \fIsrcToken\fR).
slave is different from \fIsrcToken\fR).
.TP
\fIchild \fBalias \fIsrcToken \fB{}\fR
\fIslave \fBalias \fIsrcToken \fB{}\fR
.
Deletes the alias for \fIsrcToken\fR in the child interpreter.
Deletes the alias for \fIsrcToken\fR in the slave interpreter.
\fIsrcToken\fR refers to the value returned when the alias
was created;  if the source command has been renamed, the renamed
command will be deleted.
.TP
\fIchild \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
\fIslave \fBalias \fIsrcCmd targetCmd \fR?\fIarg ..\fR?
.
Creates an alias such that whenever \fIsrcCmd\fR is invoked
in \fIchild\fR, \fItargetCmd\fR is invoked in the parent.
in \fIslave\fR, \fItargetCmd\fR is invoked in the master.
The \fIarg\fR arguments will be passed to \fItargetCmd\fR as additional
arguments, prepended before any arguments passed in the invocation of
\fIsrcCmd\fR.
See \fBALIAS INVOCATION\fR below for details.
The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
\fIchild \fBbgerror\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background exception handler
for the \fIchild\fR interpreter. If \fIcmdPrefix\fR is
absent, the current background exception handler is returned, and if it is
\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
.VS 8.5
This command either gets or sets the current background error handler
for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
absent, the current background error handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background exception handler to. See the
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
what to set the interpreter's background error to. See the
\fBBACKGROUND ERROR HANDLING\fR section for more details.
.VE 8.5
.TP
\fIchild \fBeval \fIarg \fR?\fIarg ..\fR?
\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
.
This command concatenates all of the \fIarg\fR arguments in
the same fashion as the \fBconcat\fR command, then evaluates
the resulting string as a Tcl script in \fIchild\fR.
the resulting string as a Tcl script in \fIslave\fR.
The result of this evaluation (including all \fBreturn\fR options,
such as \fB\-errorinfo\fR and \fB\-errorcode\fR information, if an
error occurs) is returned to the invoking interpreter.
Note that the script will be executed in the current context stack frame
of \fIchild\fR; this is so that the implementations (in a parent
interpreter) of aliases in a child interpreter can execute scripts in
the child that find out information about the child's current state
of \fIslave\fR; this is so that the implementations (in a master
interpreter) of aliases in a slave interpreter can execute scripts in
the slave that find out information about the slave's current state
and stack frame.
.TP
\fIchild \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
\fIslave \fBexpose \fIhiddenName \fR?\fIexposedCmdName\fR?
.
This command exposes the hidden command \fIhiddenName\fR, eventually bringing
it back under a new \fIexposedCmdName\fR name (this name is currently
accepted only if it is a valid global name space name without any ::),
in \fIchild\fR.
in \fIslave\fR.
If an exposed command with the targeted name already exists, this command
fails.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIchild \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
\fIslave \fBhide \fIexposedCmdName\fR ?\fIhiddenCmdName\fR?
.
This command hides the exposed command \fIexposedCmdName\fR, renaming it to
the hidden command \fIhiddenCmdName\fR, or keeping the same name if the
argument is not given, in the \fIchild\fR interpreter.
argument is not given, in the \fIslave\fR interpreter.
If a hidden command with the targeted name already exists, this command
fails.
Currently both \fIexposedCmdName\fR and \fIhiddenCmdName\fR can
not contain namespace qualifiers, or an error is raised.
Commands to be hidden are looked up in the global
namespace even if the current namespace is not the global one. This
prevents children from fooling a parent interpreter into hiding the wrong
prevents slaves from fooling a master interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
For more details on hidden commands, see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIchild \fBhidden\fR
\fIslave \fBhidden\fR
.
Returns a list of the names of all hidden commands in \fIchild\fR.
Returns a list of the names of all hidden commands in \fIslave\fR.
.TP
\fIchild \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
\fIslave \fBinvokehidden\fR ?\fI\-option ...\fR? \fIhiddenName \fR?\fIarg ..\fR?
.
This command invokes the hidden command \fIhiddenName\fR with the
supplied arguments, in \fIchild\fR. No substitutions or evaluations are
supplied arguments, in \fIslave\fR. No substitutions or evaluations are
applied to the arguments. Three \fI\-option\fRs are supported, all
of which start with \fB\-\fR: \fB\-namespace\fR (which takes a single
argument afterwards, \fInsName\fR), \fB\-global\fR, and \fB\-\|\-\fR.
If the \fB\-namespace\fR flag is given, the hidden command is invoked in
the specified namespace in the child.
the specified namespace in the slave.
If the \fB\-global\fR flag is given, the command is invoked at the global
level in the child; otherwise it is invoked at the current call frame and
level in the slave; otherwise it is invoked at the current call frame and
can access local variables in that or outer call frames.
The \fB\-\|\-\fR flag allows the \fIhiddenCmdName\fR argument to start with a
.QW \-
character, and is otherwise unnecessary.
If both the \fB\-namespace\fR and \fB\-global\fR flags are given, the
\fB\-namespace\fR flag is ignored.
Note that the hidden command will be executed (by default) in the
current context stack frame of \fIchild\fR.
current context stack frame of \fIslave\fR.
For more details on hidden commands,
see \fBHIDDEN COMMANDS\fR, below.
.TP
\fIchild \fBissafe\fR
\fIslave \fBissafe\fR
.
Returns  \fB1\fR if the child interpreter is safe, \fB0\fR otherwise.
Returns  \fB1\fR if the slave interpreter is safe, \fB0\fR otherwise.
.TP
\fIchild \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
.
\fIslave \fBlimit\fR \fIlimitType\fR ?\fI\-option\fR? ?\fIvalue\fR \fI...\fR?
.VS 8.5
Sets up, manipulates and queries the configuration of the resource
limit \fIlimitType\fR for the child interpreter.  If no \fI\-option\fR
limit \fIlimitType\fR for the slave interpreter.  If no \fI\-option\fR
is specified, return the current configuration of the limit.  If
\fI\-option\fR is the sole argument, return the value of that option.
Otherwise, a list of \fI\-option\fR/\fIvalue\fR argument pairs must
supplied. See \fBRESOURCE LIMITS\fR below for a more detailed explanation of
what limits and options are supported.
.VE 8.5
.TP
\fIchild \fBmarktrusted\fR
\fIslave \fBmarktrusted\fR
.
Marks the child interpreter as trusted. Can only be invoked by a
Marks the slave interpreter as trusted. Can only be invoked by a
trusted interpreter. This command does not expose any hidden
commands in the child interpreter. The command has no effect if the child
commands in the slave interpreter. The command has no effect if the slave
is already trusted.
.TP
\fIchild\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
\fIslave\fR \fBrecursionlimit\fR ?\fInewlimit\fR?
.
Returns the maximum allowable nesting depth for the \fIchild\fR interpreter.
If \fInewlimit\fR is specified, the recursion limit in \fIchild\fR will be
Returns the maximum allowable nesting depth for the \fIslave\fR interpreter.
If \fInewlimit\fR is specified, the recursion limit in \fIslave\fR will be
set so that nesting of more than \fInewlimit\fR calls to \fBTcl_Eval()\fR
and related procedures in \fIchild\fR will return an error.
and related procedures in \fIslave\fR will return an error.
The \fInewlimit\fR value is also returned.
The \fInewlimit\fR value must be a positive integer between 1 and the
maximum value of a non-long integer on the platform.
.RS
.PP
The command sets the maximum size of the Tcl call stack only. It cannot
by itself prevent stack overflows on the C stack being used by the
561
562
563
564
565
566
567
568

569
570
571
572
573
574
575

576
577
578
579
580
581
582
506
507
508
509
510
511
512

513
514
515
516
517
518
519

520
521
522
523
524
525
526
527







-
+






-
+







fear of that script damaging the enclosing application or the rest
of your computing environment.  In order to make an interpreter
safe, certain commands and variables are removed from the interpreter.
For example, commands to create files on disk are removed, and the
\fBexec\fR command is removed, since it could be used to cause damage
through subprocesses.
Limited access to these facilities can be provided, by creating
aliases to the parent interpreter which check their arguments carefully
aliases to the master interpreter which check their arguments carefully
and provide restricted access to a safe subset of facilities.
For example, file creation might be allowed in a particular subdirectory
and subprocess invocation might be allowed for a carefully selected and
fixed set of programs.
.PP
A safe interpreter is created by specifying the \fB\-safe\fR switch
to the \fBinterp create\fR command.  Furthermore, any child created
to the \fBinterp create\fR command.  Furthermore, any slave created
by a safe interpreter will also be safe.
.PP
A safe interpreter is created with exactly the following set of
built-in commands:
.DS
.ta 1.2i 2.4i 3.6i
\fBafter\fR	\fBappend\fR	\fBapply\fR	\fBarray\fR
655
656
657
658
659
660
661
662
663
664
665
666
667
668







669
670

671
672
673
674
675
676
677
600
601
602
603
604
605
606







607
608
609
610
611
612
613
614

615
616
617
618
619
620
621
622







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

-
+







\fBSafe\-Tcl\fR and the \fBload\fR Tcl command.
.PP
A safe interpreter may not alter the recursion limit of any interpreter,
including itself.
.SH "ALIAS INVOCATION"
.PP
The alias mechanism has been carefully designed so that it can
be used safely in an untrusted script which is being executed in a
safe interpreter even if the target of the alias is not a safe
interpreter.  The most important thing in guaranteeing safety is to
ensure that information passed from the child to the parent is
never evaluated or substituted in the parent;  if this were to
occur, it would enable an evil script in the child to invoke
arbitrary functions in the parent, which would compromise security.
be used safely when an untrusted script is executing
in a safe slave and the target of the alias is a trusted
master.  The most important thing in guaranteeing safety is to
ensure that information passed from the slave to the master is
never evaluated or substituted in the master;  if this were to
occur, it would enable an evil script in the slave to invoke
arbitrary functions in the master, which would compromise security.
.PP
When the source for an alias is invoked in the child interpreter, the
When the source for an alias is invoked in the slave interpreter, the
usual Tcl substitutions are performed when parsing that command.
These substitutions are carried out in the source interpreter just
as they would be for any other command invoked in that interpreter.
The command procedure for the source command takes its arguments
and merges them with the \fItargetCmd\fR and \fIarg\fRs for the
alias to create a new array of arguments.  If the words
of \fIsrcCmd\fR were
690
691
692
693
694
695
696
697
698


699
700
701
702
703
704
705
635
636
637
638
639
640
641


642
643
644
645
646
647
648
649
650







-
-
+
+







\fItargetCmd\fR and \fIargs\fR were substituted when parsing the command
that created the alias, and \fIarg1 - argN\fR are substituted when
the alias's source command is parsed in the source interpreter.
.PP
When writing the \fItargetCmd\fRs for aliases in safe interpreters,
it is very important that the arguments to that command never be
evaluated or substituted, since this would provide an escape
mechanism whereby the child interpreter could execute arbitrary
code in the parent.  This in turn would compromise the security
mechanism whereby the slave interpreter could execute arbitrary
code in the master.  This in turn would compromise the security
of the system.
.SH "HIDDEN COMMANDS"
.PP
Safe interpreters greatly restrict the functionality available to Tcl
programs executing within them.
Allowing the untrusted Tcl program to have direct access to this
functionality is unsafe, because it can be used for a variety of
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
897
898
899




900
901

902
903

904
905

906
907
908
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
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










-
-
-
-
+
+
+
+

-
-
+
+

-
+


-
+


-
+






-
+


















-
+


+


-
+








-
+












+


-
+




-
-
+
+
-
-
+


+


-
+





+


-
+




+


-
+






+


-
+




-
-
-
-
+
+
+
+


-
+

-
+

-
+

-
-
+
+

-
-
+
+

-
+

-
-
+
-
-
-
+
+


+




-

-







-





-
-
+
+




+


-




-
-
-
-
+
+
+
+


+

-
+

-
+
-
-
-
unavailable to Tcl scripts executing in the interpreter. However, such
hidden commands can be invoked by any trusted ancestor of the safe
interpreter, in the context of the safe interpreter, using \fBinterp
invoke\fR. Hidden commands and exposed commands reside in separate name
spaces. It is possible to define a hidden command and an exposed command by
the same name within one interpreter.
.PP
Hidden commands in a child interpreter can be invoked in the body of
procedures called in the parent during alias invocation. For example, an
alias for \fBsource\fR could be created in a child interpreter. When it is
invoked in the child interpreter, a procedure is called in the parent
Hidden commands in a slave interpreter can be invoked in the body of
procedures called in the master during alias invocation. For example, an
alias for \fBsource\fR could be created in a slave interpreter. When it is
invoked in the slave interpreter, a procedure is called in the master
interpreter to check that the operation is allowable (e.g. it asks to
source a file that the child interpreter is allowed to access). The
procedure then it invokes the hidden \fBsource\fR command in the child
source a file that the slave interpreter is allowed to access). The
procedure then it invokes the hidden \fBsource\fR command in the slave
interpreter to actually source in the contents of the file. Note that two
commands named \fBsource\fR exist in the child interpreter: the alias, and
commands named \fBsource\fR exist in the slave interpreter: the alias, and
the hidden command.
.PP
Because a parent interpreter may invoke a hidden command as part of
Because a master interpreter may invoke a hidden command as part of
handling an alias invocation, great care must be taken to avoid evaluating
any arguments passed in through the alias invocation.
Otherwise, malicious child interpreters could cause a trusted parent
Otherwise, malicious slave interpreters could cause a trusted master
interpreter to execute dangerous commands on their behalf. See the section
on \fBALIAS INVOCATION\fR for a more complete discussion of this topic.
To help avoid this problem, no substitutions or evaluations are
applied to arguments of \fBinterp invokehidden\fR.
.PP
Safe interpreters are not allowed to invoke hidden commands in themselves
or in their descendants. This prevents them from gaining access to
or in their descendants. This prevents safe slaves from gaining access to
hidden functionality in themselves or their descendants.
.PP
The set of hidden commands in an interpreter can be manipulated by a trusted
interpreter using \fBinterp expose\fR and \fBinterp hide\fR. The \fBinterp
expose\fR command moves a hidden command to the
set of exposed commands in the interpreter identified by \fIpath\fR,
potentially renaming the command in the process. If an exposed command by
the targeted name already exists, the operation fails. Similarly,
\fBinterp hide\fR moves an exposed command to the set of hidden commands in
that interpreter. Safe interpreters are not allowed to move commands
between the set of hidden and exposed commands, in either themselves or
their descendants.
.PP
Currently, the names of hidden commands cannot contain namespace
qualifiers, and you must first rename a command in a namespace to the
global namespace before you can hide it.
Commands to be hidden by \fBinterp hide\fR are looked up in the global
namespace even if the current namespace is not the global one. This
prevents children from fooling a parent interpreter into hiding the wrong
prevents slaves from fooling a master interpreter into hiding the wrong
command, by making the current namespace be different from the global one.
.SH "RESOURCE LIMITS"
.VS 8.5
.PP
Every interpreter has two kinds of resource limits that may be imposed by any
parent interpreter upon its children. Command limits (of type \fBcommand\fR)
master interpreter upon its slaves. Command limits (of type \fBcommand\fR)
restrict the total number of Tcl commands that may be executed by an
interpreter (as can be inspected via the \fBinfo cmdcount\fR command), and
time limits (of type \fBtime\fR) place a limit by which execution within the
interpreter must complete. Note that time limits are expressed as
\fIabsolute\fR times (as in \fBclock seconds\fR) and not relative times (as in
\fBafter\fR) because they may be modified after creation.
.PP
When a limit is exceeded for an interpreter, first any handler callbacks
defined by parent interpreters are called. If those callbacks increase or
defined by master interpreters are called. If those callbacks increase or
remove the limit, execution within the (previously) limited interpreter
continues. If the limit is still in force, an error is generated at that point
and normal processing of errors within the interpreter (by the \fBcatch\fR
command) is disabled, so the error propagates outwards (building a stack-trace
as it goes) to the point where the limited interpreter was invoked (e.g. by
\fBinterp eval\fR) where it becomes the responsibility of the calling code to
catch and handle.
.SS "LIMIT OPTIONS"
.PP
Every limit has a number of options associated with it, some of which are
common across all kinds of limits, and others of which are particular to the
kind of limit.
.VE 8.5
.TP
\fB\-command\fR
.
.VS 8.5
This option (common for all limit types) specifies (if non-empty) a Tcl script
to be executed in the global namespace of the interpreter reading and writing
the option when the particular limit in the limited interpreter is exceeded.
The callback may modify the limit on the interpreter if it wishes the limited
interpreter to continue executing. If the callback generates an exception, it
is reported through the background exception mechanism (see
interpreter to continue executing. If the callback generates an error, it is
reported through the background error mechanism (see \fBBACKGROUND ERROR
\fBBACKGROUND EXCEPTION HANDLING\fR).
Note that the callbacks defined by one interpreter are
HANDLING\fR). Note that the callbacks defined by one interpreter are
completely isolated from the callbacks defined by another, and that the order
in which those callbacks are called is undefined.
.VE 8.5
.TP
\fB\-granularity\fR
.
.VS 8.5
This option (common for all limit types) specifies how frequently (out of the
points when the Tcl interpreter is in a consistent state where limit checking
is possible) that the limit is actually checked. This allows the tuning of how
frequently a limit is checked, and hence how often the limit-checking overhead
(which may be substantial in the case of time limits) is incurred.
.VE 8.5
.TP
\fB\-milliseconds\fR
.
.VS 8.5
This option specifies the number of milliseconds after the moment defined in
the \fB\-seconds\fR option that the time limit will fire. It should only ever
be specified in conjunction with the \fB\-seconds\fR option (whether it was
set previously or is being set this invocation.)
.VE 8.5
.TP
\fB\-seconds\fR
.
.VS 8.5
This option specifies the number of seconds after the epoch (see \fBclock
seconds\fR) that the time limit for the interpreter will be triggered. The
limit will be triggered at the start of the second unless specified at a
sub-second level using the \fB\-milliseconds\fR option. This option may be the
empty string, which indicates that a time limit is not set for the
interpreter.
.VE 8.5
.TP
\fB\-value\fR
.
.VS 8.5
This option specifies the number of commands that the interpreter may execute
before triggering the command limit. This option may be the empty string,
which indicates that a command limit is not set for the interpreter.
.PP
Where an interpreter with a resource limit set on it creates a child
interpreter, that child interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating parent
interpreter. If the parent interpreter of the limited parent wishes to relax
Where an interpreter with a resource limit set on it creates a slave
interpreter, that slave interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating master
interpreter. If the master interpreter of the limited master wishes to relax
these conditions, it should hide the \fBinterp\fR command in the child and
then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
access as it chooses to the \fBinterp\fR command to the limited parent as
access as it chooses to the \fBinterp\fR command to the limited master as
necessary.
.SH "BACKGROUND EXCEPTION HANDLING"
.SH "BACKGROUND ERROR HANDLING"
.PP
When an exception happens in a situation where it cannot be reported directly up
When an error happens in a situation where it cannot be reported directly up
the stack (e.g. when processing events in an \fBupdate\fR or \fBvwait\fR call)
the exception is instead reported through the background exception handling mechanism.
Every interpreter has a background exception handler registered; the default exception
the error is instead reported through the background error handling mechanism.
Every interpreter has a background error handler registered; the default error
handler arranges for the \fBbgerror\fR command in the interpreter's global
namespace to be called, but other exception handlers may be installed and process
background exceptions in substantially different ways.
namespace to be called, but other error handlers may be installed and process
background errors in substantially different ways.
.PP
A background exception handler consists of a non-empty list of words to which will
A background error handler consists of a non-empty list of words to which will
be appended two further words at invocation time. The first word will be the
interpreter result at time of the exception, typically an error message,
and the second will be the dictionary of return options at the time of
error message string, and the second will a dictionary of return options (this
the exception.  These are the same values that \fBcatch\fR can capture
when it controls script evaluation in a non-background situation.
The resulting list will then be executed
is also the sort of information that can be obtained by trapping a normal
error using \fBcatch\fR of course.) The resulting list will then be executed
in the interpreter's global namespace without further substitutions being
performed.
.VE 8.5
.SH CREDITS
The safe interpreter mechanism is based on the Safe-Tcl prototype implemented
by Nathaniel Borenstein and Marshall Rose.
.SH EXAMPLES
.PP
Creating and using an alias for a command in the current interpreter:
.PP
.CS
\fBinterp alias\fR {} getIndex {} lsearch {alpha beta gamma delta}
set idx [getIndex delta]
.CE
.PP
Executing an arbitrary command in a safe interpreter where every
invocation of \fBlappend\fR is logged:
.PP
.CS
set i [\fBinterp create\fR -safe]
\fBinterp hide\fR $i lappend
\fBinterp alias\fR $i lappend {} loggedLappend $i
proc loggedLappend {i args} {
    puts "logged invocation of lappend $args"
    \fBinterp invokehidden\fR $i lappend {*}$args
   puts "logged invocation of lappend $args"
   \fBinterp invokehidden\fR $i lappend {*}$args
}
\fBinterp eval\fR $i $someUntrustedScript
.CE
.PP
.VS 8.5
Setting a resource limit on an interpreter so that an infinite loop
terminates.
.PP
.CS
set i [\fBinterp create\fR]
\fBinterp limit\fR $i command -value 1000
\fBinterp eval\fR $i {
    set x 0
    while {1} {
        puts "Counting up... [incr x]"
    }
   set x 0
   while {1} {
      puts "Counting up... [incr x]"
   }
}
.CE
.VE 8.5
.SH "SEE ALSO"
bgerror(n), load(n), safe(n), Tcl_CreateChild(3), Tcl_Eval(3), Tcl_BackgroundException(3)
bgerror(n), load(n), safe(n), Tcl_CreateSlave(3)
.SH KEYWORDS
alias, parent interpreter, safe interpreter, child interpreter
alias, master interpreter, safe interpreter, slave interpreter
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/join.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
44
45
46
47
48
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










-
+









+








-

-







-





+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH join n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
join \- Create a string by joining together list elements
.SH SYNOPSIS
\fBjoin \fIlist \fR?\fIjoinString\fR?
.BE

.SH DESCRIPTION
.PP
The \fIlist\fR argument must be a valid Tcl list.
This command returns the string
formed by joining all of the elements of \fIlist\fR together with
\fIjoinString\fR separating each adjacent pair of elements.
The \fIjoinString\fR argument defaults to a space character.
.SH EXAMPLES
.PP
Making a comma-separated list:
.PP
.CS
set data {1 2 3 4 5}
\fBjoin\fR $data ", "
     \fB\(-> 1, 2, 3, 4, 5\fR
.CE
.PP
Using \fBjoin\fR to flatten a list by a single level:
.PP
.CS
set data {1 {2 3} 4 {5 {6 7} 8}}
\fBjoin\fR $data
     \fB\(-> 1 2 3 4 5 {6 7} 8\fR
.CE

.SH "SEE ALSO"
list(n), lappend(n), split(n)

.SH KEYWORDS
element, join, list, separator
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/lappend.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
44
45
46
47
48
49
50

51
52
53
54



55
56
57
58
59
60
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











-
+









+







-
-
-
-
-
-









-

-








+

-
-
-
+
+
+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lappend n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lappend \- Append list elements onto a variable
.SH SYNOPSIS
\fBlappend \fIvarName \fR?\fIvalue value value ...\fR?
.BE

.SH DESCRIPTION
.PP
This command treats the variable given by \fIvarName\fR as a list
and appends each of the \fIvalue\fR arguments to that list as a separate
element, with spaces between elements.
If \fIvarName\fR does not exist, it is created as a list with elements
given by the \fIvalue\fR arguments.
.VS TIP508
If \fIvarName\fR indicate an element that does not exist of an array that has
a default value set, list that is comprised of the default value with all the
\fIvalue\fR arguments appended as elements will be stored in the array
element.
.VE TIP508
\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
are appended as list elements rather than raw text.
This command provides a relatively efficient way to build up
large lists.  For example,
.QW "\fBlappend a $b\fR"
is much more efficient than
.QW "\fBset a [concat $a [list $b]]\fR"
when \fB$a\fR is long.
.SH EXAMPLE
.PP
Using \fBlappend\fR to build up a list of numbers.
.PP
.CS
% set var 1
1
% \fBlappend\fR var 2
1 2
% \fBlappend\fR var 3 4 5
1 2 3 4 5
.CE

.SH "SEE ALSO"
list(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
list(n), lindex(n), linsert(n), llength(n), lset(n),
lsort(n), lrange(n)

.SH KEYWORDS
append, element, list, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/lassign.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
44
45
46
47
48
49
50
51
52

53
54
55
56


57
58
59
60
61
62
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









-
+







-
+

+









-


-

-
+




-
+




-
+



-




-

-
+


-
-
+
+
-


-
-
-
'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer & Mark Diekhans
'\" Copyright (c) 2004 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lassign n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lassign \- Assign list elements to variables
.SH SYNOPSIS
\fBlassign \fIlist \fR?\fIvarName ...\fR?
\fBlassign \fIlist varName \fR?\fIvarName ...\fR?
.BE

.SH DESCRIPTION
.PP
This command treats the value \fIlist\fR as a list and assigns
successive elements from that list to the variables given by the
\fIvarName\fR arguments in order.  If there are more variable names
than list elements, the remaining variables are set to the empty
string.  If there are more list elements than variables, a list of
unassigned elements is returned.
.SH EXAMPLES
.PP
An illustration of how multiple assignment works, and what happens
when there are either too few or too many elements.
.PP
.CS
\fBlassign\fR {a b c} x y z       ;# Empty return
lassign {a b c} x y z       ;# Empty return
puts $x                     ;# Prints "a"
puts $y                     ;# Prints "b"
puts $z                     ;# Prints "c"

\fBlassign\fR {d e} x y z         ;# Empty return
lassign {d e} x y z         ;# Empty return
puts $x                     ;# Prints "d"
puts $y                     ;# Prints "e"
puts $z                     ;# Prints ""

\fBlassign\fR {f g h i} x y       ;# Returns "h i"
lassign {f g h i} x y       ;# Returns "h i"
puts $x                     ;# Prints "f"
puts $y                     ;# Prints "g"
.CE
.PP
The \fBlassign\fR command has other uses.  It can be used to create
the analogue of the
.QW shift
command in many shell languages like this:
.PP
.CS
set ::argv [\fBlassign\fR $::argv argumentToReadOff]
set ::argv [lassign $::argv argumentToReadOff]
.CE
.SH "SEE ALSO"
list(n), lappend(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lindex(n), list(n), lset(n), set(n)

lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
assign, element, list, multiple, set, variable
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/library.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
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











-
+






+







'\"
'\" Copyright (c) 1991-1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures
auto_execok, auto_import, auto_load, auto_mkindex, auto_mkindex_old, auto_qualify, auto_reset, tcl_findLibrary, parray, tcl_endOfWord, tcl_startOfNextWord, tcl_startOfPreviousWord, tcl_wordBreakAfter, tcl_wordBreakBefore \- standard library of Tcl procedures
.SH SYNOPSIS
.nf
\fBauto_execok \fIcmd\fR
\fBauto_import \fIpattern\fR
\fBauto_load \fIcmd\fR
\fBauto_mkindex \fIdir pattern pattern ...\fR
\fBauto_mkindex_old \fIdir pattern pattern ...\fR
\fBauto_qualify \fIcommand namespace\fR
\fBauto_reset\fR
\fBtcl_findLibrary \fIbasename version patch initScript enVarName varName\fR
\fBparray \fIarrayName\fR ?\fIpattern\fR?
\fBtcl_endOfWord \fIstr start\fR
\fBtcl_startOfNextWord \fIstr start\fR
\fBtcl_startOfPreviousWord \fIstr start\fR
34
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
35
36
37
38
39
40
41

42
43
44
45
46

47
48
49

50
51
52
53
54
55
56







-
+




-



-







The location of the Tcl library is returned by the \fBinfo library\fR
command.
In addition to the Tcl library, each application will normally have
its own library of support procedures as well;  the location of this
library is normally given by the value of the \fB$\fIapp\fB_library\fR
global variable, where \fIapp\fR is the name of the application.
For example, the location of the Tk library is kept in the variable
\fBtk_library\fR.
\fB$tk_library\fR.
.PP
To access the procedures in the Tcl library, an application should
source the file \fBinit.tcl\fR in the library, for example with
the Tcl command
.PP
.CS
\fBsource [file join [info library] init.tcl]\fR
.CE
.PP
If the library procedure \fBTcl_Init\fR is invoked from an application's
\fBTcl_AppInit\fR procedure, this happens automatically.
The code in \fBinit.tcl\fR will define the \fBunknown\fR procedure
and arrange for the other procedures to be loaded on-demand using
the auto-load mechanism defined below.
.SH "COMMAND PROCEDURES"
.PP
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
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







-
-
+
+




















-








-



-
+




-
+





-
+
-
-
-
+
-



-
+





-
+



-







does nothing.  The pattern matching is performed according to the
matching rules of \fBnamespace import\fR.
.TP
\fBauto_load \fIcmd\fR
This command attempts to load the definition for a Tcl command named
\fIcmd\fR.  To do this, it searches an \fIauto-load path\fR, which is
a list of one or more directories.  The auto-load path is given by the
global variable \fBauto_path\fR if it exists.  If there is no
\fBauto_path\fR variable, then the TCLLIBPATH environment variable is
global variable \fB$auto_path\fR if it exists.  If there is no
\fB$auto_path\fR variable, then the TCLLIBPATH environment variable is
used, if it exists.  Otherwise the auto-load path consists of just the
Tcl library directory.  Within each directory in the auto-load path
there must be a file \fBtclIndex\fR that describes one or more
commands defined in that directory and a script to evaluate to load
each of the commands.  The \fBtclIndex\fR file should be generated
with the \fBauto_mkindex\fR command.  If \fIcmd\fR is found in an
index file, then the appropriate script is evaluated to create the
command.  The \fBauto_load\fR command returns 1 if \fIcmd\fR was
successfully created.  The command returns 0 if there was no index
entry for \fIcmd\fR or if the script did not actually define \fIcmd\fR
(e.g. because index information is out of date).  If an error occurs
while processing the script, then that error is returned.
\fBAuto_load\fR only reads the index information once and saves it in
the array \fBauto_index\fR;  future calls to \fBauto_load\fR check for
\fIcmd\fR in the array rather than re-reading the index files.  The
cached index information may be deleted with the command
\fBauto_reset\fR.  This will force the next \fBauto_load\fR command to
reload the index database from disk.
.TP
\fBauto_mkindex \fIdir pattern pattern ...\fR
.
Generates an index suitable for use by \fBauto_load\fR.  The command
searches \fIdir\fR for all files whose names match any of the
\fIpattern\fR arguments (matching is done with the \fBglob\fR
command), generates an index of all the Tcl command procedures defined
in all the matching files, and stores the index information in a file
named \fBtclIndex\fR in \fIdir\fR. If no pattern is given a pattern of
\fB*.tcl\fR will be assumed.  For example, the command
.RS
.PP
.CS
\fBauto_mkindex foo *.tcl\fR
.CE
.PP
.LP
will read all the \fB.tcl\fR files in subdirectory \fBfoo\fR and
generate a new index file \fBfoo/tclIndex\fR.
.PP
\fBAuto_mkindex\fR parses the Tcl scripts by sourcing them into a
child interpreter and monitoring the proc and namespace commands that
slave interpreter and monitoring the proc and namespace commands that
are executed.  Extensions can use the (undocumented)
auto_mkindex_parser package to register other commands that can
contribute to the auto_load index. You will have to read through
auto.tcl to see how this works.
.PP
\fBAuto_mkindex_old\fR
\fBAuto_mkindex_old\fR parses the Tcl scripts in a relatively
(which has the same syntax as \fBauto_mkindex\fR)
parses the Tcl scripts in a relatively
unsophisticated way:  if any line contains the word
unsophisticated way:  if any line contains the word \fBproc\fR
.QW \fBproc\fR
as its first characters then it is assumed to be a procedure
definition and the next word of the line is taken as the
procedure's name.
Procedure definitions that do not appear in this way (e.g.\ they
Procedure definitions that do not appear in this way (e.g. they
have spaces before the \fBproc\fR) will not be indexed.  If your
script contains
.QW dangerous
code, such as global initialization
code or procedure names with special characters like \fB$\fR,
\fB*\fR, \fB[\fR or \fB]\fR, you are safer using \fBauto_mkindex_old\fR.
\fB*\fR, \fB[\fR or \fB]\fR, you are safer using auto_mkindex_old.
.RE
.TP
\fBauto_reset\fR
.
Destroys all the information cached by \fBauto_execok\fR and
\fBauto_load\fR.  This information will be re-read from disk the next
time it is needed.  \fBAuto_reset\fR also deletes any procedures
listed in the auto-load index, so that fresh copies of them will be
loaded the next time that they are used.
.TP
\fBauto_qualify \fIcommand namespace\fR
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
190
191
192
193
194
195
196

197
198
199
200
201
202
203
204







-
+







relative to the executable file in a parallel build tree.
.TP
\fBparray \fIarrayName\fR ?\fIpattern\fR?
Prints on standard output the names and values of all the elements in the
array \fIarrayName\fR, or just the names that match \fIpattern\fR (using the
matching rules of \fBstring match\fR) and their values if \fIpattern\fR is
given.
\fIArrayName\fR must be an array accessible to the caller of \fBparray\fR.
\fBArrayName\fR must be an array accessible to the caller of \fBparray\fR.
It may be either local or global.
.TP
\fBtcl_endOfWord \fIstr start\fR
Returns the index of the first end-of-word location that occurs after
a starting index \fIstart\fR in the string \fIstr\fR.  An end-of-word
location is defined to be the first non-word character following the
first word character after the starting point.  Returns -1 if there
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
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










-
+
-
-


















-

-
+
-

-
-
-
-
+
+
+
+
-
-















-
-
-
-





-
+
+
+
+





-
+
+
+

-
+


-
-
-
\fIstart\fR in the string \fIstr\fR.  Returns \-1 if there are no more
boundaries before the starting point in the given string.  The index
returned refers to the second character of the pair that comprises a
boundary.
.SH "VARIABLES"
.PP
The following global variables are defined or used by the procedures in
the Tcl library. They fall into two broad classes, handling unknown
the Tcl library:
commands and packages, and determining what are words.
.SS "AUTOLOADING AND PACKAGE MANAGEMENT VARIABLES"
.TP
\fBauto_execs\fR
Used by \fBauto_execok\fR to record information about whether
particular commands exist as executable files.
.TP
\fBauto_index\fR
Used by \fBauto_load\fR to save the index information read from
disk.
.TP
\fBauto_noexec\fR
If set to any value, then \fBunknown\fR will not attempt to auto-exec
any commands.
.TP
\fBauto_noload\fR
If set to any value, then \fBunknown\fR will not attempt to auto-load
any commands.
.TP
\fBauto_path\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations (including for package index
search during auto-load operations.
files when using the default \fBpackage unknown\fR handler).
This variable is initialized during startup to contain, in order:
the directories listed in the \fBTCLLIBPATH\fR environment variable,
the directory named by the \fBtcl_library\fR global variable,
the parent directory of \fBtcl_library\fR,
the directories listed in the \fBtcl_pkgPath\fR variable.
the directories listed in the TCLLIBPATH environment variable,
the directory named by the $tcl_library variable,
the parent directory of $tcl_library,
the directories listed in the $tcl_pkgPath variable.
Additional locations to look for files and package indices should
normally be added to this variable using \fBlappend\fR.
.TP
\fBenv(TCL_LIBRARY)\fR
If set, then it specifies the location of the directory containing
library scripts (the value of this variable will be
assigned to the \fBtcl_library\fR variable and therefore returned by
the command \fBinfo library\fR).  If this variable is not set then
a default value is used.
.TP
\fBenv(TCLLIBPATH)\fR
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations.  Directories must be specified in
Tcl format, using
.QW /
as the path separator, regardless of platform.
This variable is only used when initializing the \fBauto_path\fR variable.
.SS "WORD BOUNDARY DETERMINATION VARIABLES"
These variables are only used in the \fBtcl_endOfWord\fR,
\fBtcl_startOfNextWord\fR, \fBtcl_startOfPreviousWord\fR,
\fBtcl_wordBreakAfter\fR, and \fBtcl_wordBreakBefore\fR commands.
.TP
\fBtcl_nonwordchars\fR
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a non-word character. The default is "\\W".
considered to be a non-word character.  On Windows platforms, spaces,
tabs, and newlines are considered non-word characters.  Under Unix,
everything but numbers, letters and underscores are considered
non-word characters.
.TP
\fBtcl_wordchars\fR
This variable contains a regular expression that is used by routines
like \fBtcl_endOfWord\fR to identify whether a character is part of a
word or not.  If the pattern matches a character, the character is
considered to be a word character. The default is "\\w".
considered to be a word character.  On Windows platforms, words are
comprised of any character that is not a space, tab, or newline.  Under
Unix, words are comprised of numbers, letters or underscores.
.SH "SEE ALSO"
env(n), info(n), re_syntax(n)
info(n), re_syntax(n)
.SH KEYWORDS
auto-exec, auto-load, library, unknown, word, whitespace
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/lindex.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
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
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










-
+







-
+










-

-
+

-

-

-
+

-













+
-
+


+




-

-
+

-

-

-
+

-

-

-
+


-
-
-

+
+
+
+








-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-
+
+

+
+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lindex n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lindex \- Retrieve an element from a list
.SH SYNOPSIS
\fBlindex \fIlist\fR ?\fIindex ...\fR?
\fBlindex \fIlist ?index...?\fR
.BE
.SH DESCRIPTION
.PP
The \fBlindex\fR command accepts a parameter, \fIlist\fR, which
it treats as a Tcl list. It also accepts zero or more \fIindices\fR into
the list.  The indices may be presented either consecutively on the
command line, or grouped in a
Tcl list and presented as a single argument.
.PP
If no indices are presented, the command takes the form:
.PP
.CS
\fBlindex \fIlist\fR
lindex list
.CE
.PP
or
.PP
.CS
\fBlindex \fIlist\fR {}
lindex list {}
.CE
.PP
In this case, the return value of \fBlindex\fR is simply the value of the
\fIlist\fR parameter.
.PP
When presented with a single index, the \fBlindex\fR command
treats \fIlist\fR as a Tcl list and returns the
\fIindex\fR'th element from it (0 refers to the first element of the list).
In extracting the element, \fBlindex\fR observes the same rules
concerning braces and quotes and backslashes as the Tcl command
interpreter; however, variable
substitution and command substitution do not occur.
If \fIindex\fR is negative or greater than or equal to the number
of elements in \fIvalue\fR, then an empty
string is returned.
.VS 8.5
The interpretation of each simple \fIindex\fR value is the same as
The interpretation of each simple \fIindex\fR value is the same as 
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
.VE 8.5
.PP
If additional \fIindex\fR arguments are supplied, then each argument is
used in turn to select an element from the previous indexing operation,
allowing the script to select elements from sublists.  The command,
.PP
.CS
\fBlindex\fR $a 1 2 3
lindex $a 1 2 3
.CE
.PP
or
.PP
.CS
\fBlindex\fR $a {1 2 3}
lindex $a {1 2 3}
.CE
.PP
is synonymous with
.PP
.CS
\fBlindex\fR [\fBlindex\fR [\fBlindex\fR $a 1] 2] 3
lindex [lindex [lindex $a 1] 2] 3
.CE
.SH EXAMPLES
.PP
Lists can be indexed into from either end:
.PP
.CS
\fBlindex\fR {a b c}
      \fI\(-> a b c\fR
\fBlindex\fR {a b c} {}
      \fI\(-> a b c\fR
\fBlindex\fR {a b c} 0
      \fI\(-> a\fR
\fBlindex\fR {a b c} 2
      \fI\(-> c\fR
\fBlindex\fR {a b c} end
      \fI\(-> c\fR
\fBlindex\fR {a b c} end-1
      \fI\(-> b\fR
.CE
.PP
Lists or sequences of indices allow selection into lists of lists:
.PP
.CS
\fBlindex\fR {a b c}
      \fI\(-> a b c\fR
\fBlindex\fR {a b c} {}
      \fI\(-> a b c\fR
\fBlindex\fR {{a b c} {d e f} {g h i}} 2 1
      \fI\(-> h\fR
\fBlindex\fR {{a b c} {d e f} {g h i}} {2 1}
      \fI\(-> h\fR
\fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} 1 1 0
      \fI\(-> g\fR
\fBlindex\fR {{{a b} {c d}} {{e f} {g h}}} {1 1 0}
      \fI\(-> g\fR
.CE
.PP
List indices may also perform limited computation, adding or subtracting fixed
amounts from other indices:
.PP
.CS
set idx 1
\fBlindex\fR {a b c d e f} $idx+2
      \fI\(-> d\fR
set idx 3
\fBlindex\fR {a b c d e f} $idx+2
      \fI\(-> f\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), linsert(n), llength(n),
list(n), lappend(n), linsert(n), llength(n), lsearch(n), 
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n),
lset(n), lsort(n), lrange(n), lreplace(n),
.VS 8.5
string(n)
.VE

.SH KEYWORDS
element, index, list
'\"Local Variables:
'\"mode: nroff
'\"End:

Deleted doc/link.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
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




























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2011-2015 Andreas Kupries
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH link n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
link \- create link from command to method of object
.SH SYNOPSIS
.nf
package require TclOO

\fBlink\fR \fImethodName\fR ?\fI...\fR?
\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
.fi
.BE
.SH DESCRIPTION
The \fBlink\fR command is available within methods. It takes a series of one
or more method names (\fImethodName ...\fR) and/or pairs of command- and
method-name (\fB{\fIcommandName methodName\fB}\fR) and makes the named methods
available as commands without requiring the explicit use of the name of the
object or the \fBmy\fR command. The method does not need to exist at the time
that the link is made; if the link command is invoked when the method does not
exist, the standard \fBunknown\fR method handling system is used.
.PP
The command name under which the method becomes available defaults to the
method name, except where explicitly specified through an alias/method pair.
Formally, every argument must be a list; if the list has two elements, the
first element is the name of the command to create and the second element is
the name of the method of the current object to which the command links;
otherwise, the name of the command and the name of the method are the same
string (the first element of the list).
.PP
If the name of the command is not a fully-qualified command name, it will be
resolved with respect to the current namespace (i.e., the object namespace).
.SH EXAMPLES
This demonstrates linking a single method in various ways. First it makes a
simple link, then a renamed link, then an external link. Note that the method
itself is unexported, but that it can still be called directly from outside
the class.
.PP
.CS
oo::class create ABC {
    method Foo {} {
        puts "This is Foo in [self]"
    }

    constructor {} {
        \fBlink\fR Foo
        # The method foo is now directly accessible as foo here
        \fBlink\fR {bar Foo}
        # The method foo is now directly accessible as bar
        \fBlink\fR {::ExternalCall Foo}
        # The method foo is now directly accessible in the global
        # namespace as ExternalCall
    }

    method grill {} {
        puts "Step 1:"
        Foo
        puts "Step 2:"
        bar
    }
}

ABC create abc
abc grill
        \fI\(-> Step 1:\fR
        \fI\(-> This is foo in ::abc\fR
        \fI\(-> Step 2:\fR
        \fI\(-> This is foo in ::abc\fR
# Direct access via the linked command
puts "Step 3:"; ExternalCall
        \fI\(-> Step 3:\fR
        \fI\(-> This is foo in ::abc\fR
.CE
.PP
This example shows that multiple linked commands can be made in a call to
\fBlink\fR, and that they can handle arguments.
.PP
.CS
oo::class create Ex {
    constructor {} {
        \fBlink\fR a b c
        # The methods a, b, and c (defined below) are all now
        # directly acessible within methods under their own names.
    }

    method a {} {
        puts "This is a"
    }
    method b {x} {
        puts "This is b($x)"
    }
    method c {y z} {
        puts "This is c($y,$z)"
    }

    method call {p q r} {
        a
        b $p
        c $q $r
    }
}

set o [Ex new]
$o 3 5 7
        \fI\(-> This is a\fR
        \fI\(-> This is b(3)\fR
        \fI\(-> This is c(5,7)\fR
.CE
.SH "SEE ALSO"
interp(n), my(n), oo::class(n), oo::define(n)
.SH KEYWORDS
command, method, object
.\" Local Variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/linsert.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
44
45
46

47
48

49
50


51


52
53
54
55
56
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










-
+







-
+

+






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

-


-







+

-
+
-
-
+
+

+
+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH linsert n 8.2 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
linsert \- Insert elements into a list
.SH SYNOPSIS
\fBlinsert \fIlist index \fR?\fIelement element ...\fR?
\fBlinsert \fIlist index element \fR?\fIelement element ...\fR?
.BE

.SH DESCRIPTION
.PP
This command produces a new list from \fIlist\fR by inserting all of the
\fIelement\fR arguments just before the \fIindex\fR'th element of
\fIlist\fR.  Each \fIelement\fR argument will become a separate element of
the new list.  If \fIindex\fR is less than or equal to zero, then the new
elements are inserted at the beginning of the list, and if \fIindex\fR is
greater or equal to the length of \fIlist\fR, it is as if it was \fBend\fR.
As with \fBstring index\fR, the \fIindex\fR value supports both simple index
arithmetic and end-relative indexing.
.PP
elements are inserted at the beginning of the list.  
.VS 8.5
The interpretation of the \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
.VE
Subject to the restrictions that indices must refer to locations inside the
list and that the \fIelement\fRs will always be inserted in order, insertions
are done so that when \fIindex\fR is start-relative, the first \fIelement\fR
will be at that index in the resulting list, and when \fIindex\fR is
end-relative, the last \fIelement\fR will be at that index in the resulting
list.
.SH EXAMPLE
.PP
Putting some values into a list, first indexing from the start and
then indexing from the end, and then chaining them together:
.PP
.CS
set oldList {the fox jumps over the dog}
set midList [\fBlinsert\fR $oldList 1 quick]
set newList [\fBlinsert\fR $midList end-1 lazy]
# The old lists still exist though...
set newerList [\fBlinsert\fR [\fBlinsert\fR $oldList end-1 quick] 1 lazy]
.CE

.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), llength(n),
list(n), lappend(n), lindex(n), llength(n), lsearch(n), 
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n),
lset(n), lsort(n), lrange(n), lreplace(n),
.VS 8.5
string(n)
.VE

.SH KEYWORDS
element, insert, list
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/list.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
44
45
46
47

48
49
50
51






52
53

54
55
56
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










-
+









+












-

-



-

-



-

-



+

-
-
-
+
+
+
+
+
+

-
+
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH list n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
list \- Create a list
.SH SYNOPSIS
\fBlist \fR?\fIarg arg ...\fR?
.BE

.SH DESCRIPTION
.PP
This command returns a list comprised of all the \fIarg\fRs,
or an empty string if no \fIarg\fRs are specified.
Braces and backslashes get added as necessary, so that the \fBlindex\fR command
may be used on the result to re-extract the original arguments, and also
so that \fBeval\fR may be used to execute the resulting list, with
\fIarg1\fR comprising the command's name and the other \fIarg\fRs comprising
its arguments.  \fBList\fR produces slightly different results than
\fBconcat\fR:  \fBconcat\fR removes one level of grouping before forming
the list, while \fBlist\fR works directly from the original arguments.
.SH EXAMPLE
.PP
The command
.PP
.CS
\fBlist\fR a b "c d e  " "  f {g h}"
.CE
.PP
will return
.PP
.CS
\fBa b {c d e  } {  f {g h}}\fR
.CE
.PP
while \fBconcat\fR with the same arguments will return
.PP
.CS
\fBa b c d e f {g h}\fR
.CE

.SH "SEE ALSO"
lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
lappend(n), lindex(n), linsert(n), llength(n), lrange(n),
.VS 8.5
lrepeat(n),
.VE 8.5
lreplace(n), lsearch(n), lset(n), lsort(n)

.SH KEYWORDS
element, list, quoting
element, list
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/llength.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
44
45
46
47
48
49
50

51
52
53
54



55
56
57
58
59
60
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











-
+









+




+

-

-











-








-




+

-
-
-
+
+
+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH llength n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
llength \- Count the number of elements in a list
.SH SYNOPSIS
\fBllength \fIlist\fR
.BE

.SH DESCRIPTION
.PP
Treats \fIlist\fR as a list and returns a decimal string giving
the number of elements in it.

.SH EXAMPLES
.PP
The result is the number of elements:
.PP
.CS
% \fBllength\fR {a b c d e}
5
% \fBllength\fR {a b c}
3
% \fBllength\fR {}
0
.CE
.PP
Elements are not guaranteed to be exactly words in a dictionary sense
of course, especially when quoting is used:
.PP
.CS
% \fBllength\fR {a b {c d} e}
4
% \fBllength\fR {a b { } c d e}
6
.CE
.PP
An empty list is not necessarily an empty string:
.PP
.CS
% set var { }; puts "[string length $var],[\fBllength\fR $var]"
1,0
.CE

.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
list(n), lappend(n), lindex(n), linsert(n), lsearch(n), 
lset(n), lsort(n), lrange(n), lreplace(n)

.SH KEYWORDS
element, list, length
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/lmap.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
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
























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2012 Trevor Davel
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lmap n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lmap \- Iterate over all elements in one or more lists and collect results
.SH SYNOPSIS
\fBlmap \fIvarname list body\fR
.br
\fBlmap \fIvarlist1 list1\fR ?\fIvarlist2 list2 ...\fR? \fIbody\fR
.BE
.SH DESCRIPTION
.PP
The \fBlmap\fR command implements a loop where the loop variable(s) take on
values from one or more lists, and the loop returns a list of results
collected from each iteration.
.PP
In the simplest case there is one loop variable, \fIvarname\fR, and one list,
\fIlist\fR, that is a list of values to assign to \fIvarname\fR. The
\fIbody\fR argument is a Tcl script. For each element of \fIlist\fR (in order
from first to last), \fBlmap\fR assigns the contents of the element to
\fIvarname\fR as if the \fBlindex\fR command had been used to extract the
element, then calls the Tcl interpreter to execute \fIbody\fR. If execution of
the body completes normally then the result of the body is appended to an
accumulator list. \fBlmap\fR returns the accumulator list.
.PP
In the general case there can be more than one value list (e.g., \fIlist1\fR
and \fIlist2\fR), and each value list can be associated with a list of loop
variables (e.g., \fIvarlist1\fR and \fIvarlist2\fR). During each iteration of
the loop the variables of each \fIvarlist\fR are assigned consecutive values
from the corresponding \fIlist\fR. Values in each \fIlist\fR are used in order
from first to last, and each value is used exactly once. The total number of
loop iterations is large enough to use up all the values from all the value
lists. If a value list does not contain enough elements for each of its loop
variables in each iteration, empty values are used for the missing elements.
.PP
The \fBbreak\fR and \fBcontinue\fR statements may be invoked inside
\fIbody\fR, with the same effect as in the \fBfor\fR and \fBforeach\fR
commands. In these cases the body does not complete normally and the result is
not appended to the accumulator list.
.SH EXAMPLES
.PP
Zip lists together:
.PP
.CS
set list1 {a b c d}
set list2 {1 2 3 4}
set zipped [\fBlmap\fR a $list1 b $list2 {list $a $b}]
# The value of zipped is "{a 1} {b 2} {c 3} {d 4}"
.CE
.PP
Filter a list to remove odd values:
.PP
.CS
set values {1 2 3 4 5 6 7 8}
proc isEven {n} {expr {($n % 2) == 0}}
set goodOnes [\fBlmap\fR x $values {expr {
    [isEven $x] ? $x : [continue]
}}]
# The value of goodOnes is "2 4 6 8"
.CE
.PP
Take a prefix from a list based on the contents of the list:
.PP
.CS
set values {8 7 6 5 4 3 2 1}
proc isGood {counter} {expr {$n > 3}}
set prefix [\fBlmap\fR x $values {expr {
    [isGood $x] ? $x : [break]
}}]
# The value of prefix is "8 7 6 5 4"
.CE
.SH "SEE ALSO"
break(n), continue(n), for(n), foreach(n), while(n),
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
foreach, iteration, list, loop, map
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/load.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
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





-
+







-
+

-
+

-
+

+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH load n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
load \- Load machine code and initialize new commands
.SH SYNOPSIS
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR
\fBload \fIfileName\fR
.br
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName\fR
\fBload \fIfileName packageName\fR
.br
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName interp\fR
\fBload \fIfileName packageName interp\fR
.BE

.SH DESCRIPTION
.PP
This command loads binary code from a file into the
application's address space and calls an initialization procedure
in the package to incorporate it into an interpreter.  \fIfileName\fR
is the name of the file containing the code;  its exact form varies
from system to system but on most systems it is a shared library,
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
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







-

-
-
+

-












+




+







instead of \fIpkg\fB_Init\fR.
The \fIpkg\fB_SafeInit\fR function should be written carefully, so that it
initializes the safe interpreter only with partial functionality provided
by the package that is safe for use by untrusted code. For more information
on Safe\-Tcl, see the \fBsafe\fR manual entry.
.PP
The initialization procedure must match the following prototype:
.PP
.CS
typedef int \fBTcl_PackageInitProc\fR(
        Tcl_Interp *\fIinterp\fR);
typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter in which the
package is to be loaded.  The initialization procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
successfully;  in the event of an error it should set the interpreter's result
to point to an error message.  The result of the \fBload\fR command
will be the result returned by the initialization procedure.
.PP
The actual loading of a file will only be done once for each \fIfileName\fR
in an application.  If a given \fIfileName\fR is loaded into multiple
interpreters, then the first \fBload\fR will load the code and
call the initialization procedure;  subsequent \fBload\fRs will
call the initialization procedure without loading the code again.
.VS 8.5
For Tcl versions lower than 8.5, it is not possible to unload or reload a
package. From version 8.5 however, the \fBunload\fR command allows the unloading
of libraries loaded with \fBload\fR, for libraries that are aware of the
Tcl's unloading mechanism.
.VE 8.5
.PP
The \fBload\fR command also supports packages that are statically
linked with the application, if those packages have been registered
by calling the \fBTcl_StaticPackage\fR procedure.
If \fIfileName\fR is an empty string, then \fIpackageName\fR must
be specified.
.PP
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
-



-







-





-
+







The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR
procedure) by that name; if one is found, it is used.
Otherwise, the \fBload\fR command searches for a dynamically loaded
package by that name, and uses it if it is found.  If several
different files have been \fBload\fRed with different versions of
the package, Tcl picks the file that was loaded first.
.PP
If \fB\-global\fR is specified preceding the filename, all symbols
found in the shared library are exported for global use by other
libraries. The option \fB\-lazy\fR delays the actual loading of
symbols until their first actual use. The options may be abbreviated.
The option \fB\-\-\fR indicates the end of the options, and should
be used if you wish to use a filename which starts with \fB\-\fR
and you provide a packageName to the \fBload\fR command.
.PP
On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR
options, the options still exist but have no effect. Note that use
of the \fB\-global\fR or \fB\-lazy\fR option may lead to crashes
in your application later (in case of symbol conflicts resp. missing
symbols), which cannot be detected during the \fBload\fR. So, only
use this when you know what you are doing, you will not get a nice
error message when something is wrong with the loaded library.
.SH "PORTABILITY ISSUES"
.TP
\fBWindows\fR\0\0\0\0\0
.
When a load fails with
.QW "library not found"
error, it is also possible
that a dependent library was not found.  To see the dependent libraries,
type
.QW "dumpbin -imports <dllname>"
in a DOS console to see what the library must import.
When loading a DLL in the current directory, Windows will ignore
.QW ./
as a path specifier and use a search heuristic to find the DLL instead.
To avoid this, load the DLL with:
.RS
.PP
.CS
\fBload\fR [file join [pwd] mylib.DLL]
.CE
.RE
.SH BUGS
.PP
If the same file is \fBload\fRed by different \fIfileName\fRs, it will
be loaded into the process's address space multiple times.  The
behavior of this varies from system to system (some systems may
detect the redundant loads, others may not).
.SH EXAMPLE
.PP
The following is a minimal extension:
.PP
.CS
#include <tcl.h>
#include <stdio.h>
static int fooCmd(void *clientData,
static int fooCmd(ClientData clientData,
        Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
    printf("called with %d arguments\en", objc);
    return TCL_OK;
}
int Foo_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
	return TCL_ERROR;
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
152
153
154
155
156
157
158






159
160
161
162
163
164
165
166
167
168
169
170
171

172
173
174

175










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





+

-
+
+

-
+
-
-
-
When built into a shared/dynamic library with a suitable name
(e.g. \fBfoo.dll\fR on Windows, \fBlibfoo.so\fR on Solaris and Linux)
it can then be loaded into Tcl with the following:
.PP
.CS
# Load the extension
switch $tcl_platform(platform) {
    windows {
        \fBload\fR [file join [pwd] foo.dll]
    }
    unix {
        \fBload\fR [file join [pwd] libfoo[info sharedlibextension]]
    }
   windows {
      \fBload\fR [file join [pwd] foo.dll]
   }
   unix {
      \fBload\fR [file join [pwd] libfoo[info sharedlibextension]]
   }
}

# Now execute the command defined by the extension
foo
.CE

.SH "SEE ALSO"
info sharedlibextension, package(n), Tcl_StaticPackage(3), safe(n)
info sharedlibextension, Tcl_StaticPackage(3), safe(n)

.SH KEYWORDS
binary code, dynamic library, load, safe interpreter, shared library
binary code, loading, safe interpreter, shared library
'\"Local Variables:
'\"mode: nroff
'\"End:

Deleted doc/lpop.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
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

































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2018 by Peter Spjuth.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lpop \- Get and remove an element in a list
.SH SYNOPSIS
\fBlpop \fIvarName ?index ...?\fR
.BE
.SH DESCRIPTION
.PP
The \fBlpop\fR command accepts a parameter, \fIvarName\fR, which
it interprets as the name of a variable containing a Tcl list.
It also accepts one or more \fIindices\fR into
the list. If no indices are presented, it defaults to "end".
.PP
When presented with a single index, the \fBlpop\fR command
addresses the \fIindex\fR'th element in it, removes if from the list
and returns the element.
.PP
If \fIindex\fR is negative or greater or equal than the number
of elements in \fI$varName\fR, then an error occurs.
.PP
The interpretation of each simple \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
.PP
If additional \fIindex\fR arguments are supplied, then each argument is
used in turn to address an element within a sublist designated
by the previous indexing operation,
allowing the script to remove elements in sublists.
The command,
.PP
.CS
\fBlpop\fR a 1 2
.CE
.PP
gets and removes element 2 of sublist 1.
.PP
.SH EXAMPLES
.PP
In each of these examples, the initial value of \fIx\fR is:
.PP
.CS
set x [list [list a b c] [list d e f] [list g h i]]
      \fI\(-> {a b c} {d e f} {g h i}\fR
.CE
.PP
The indicated value becomes the new value of \fIx\fR
(except in the last case, which is an error which leaves the value of
\fIx\fR unchanged.)
.PP
.CS
\fBlpop\fR x 0
      \fI\(-> {d e f} {g h i}\fR
\fBlpop\fR x 2
      \fI\(-> {a b c} {d e f}\fR
\fBlpop\fR x end
      \fI\(-> {a b c} {d e f}\fR
\fBlpop\fR x end-1
      \fI\(-> {a b c} {g h i}\fR
\fBlpop\fR x 2 1
      \fI\(-> {a b c} {d e f} {g i}\fR
\fBlpop\fR x 2 3 j
      \fI\(-> list index out of range\fR
.CE
.PP
In the following examples, the initial value of \fIx\fR is:
.PP
.CS
set x [list [list [list a b] [list c d]] \e
            [list [list e f] [list g h]]]
      \fI\(-> {{a b} {c d}} {{e f} {g h}}\fR
.CE
.PP
The indicated value becomes the new value of \fIx\fR.
.PP
.CS
\fBlpop\fR x 1 1 0
      \fI\(-> {{a b} {c d}} {{e f} h}\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n),
string(n)
.SH KEYWORDS
element, index, list, remove, pop, stack, queue
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/lrange.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
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
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











-
+









+





+




+













-

-






-






-







-








+

-
-
+
+
-
+

+
+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lrange n 7.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lrange \- Return one or more adjacent elements from a list
.SH SYNOPSIS
\fBlrange \fIlist first last\fR
.BE

.SH DESCRIPTION
.PP
\fIList\fR must be a valid Tcl list.  This command will
return a new list consisting of elements
\fIfirst\fR through \fIlast\fR, inclusive.
.VS 8.5
The index values \fIfirst\fR and \fIlast\fR are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list.
.VE
If \fIfirst\fR is less than zero, it is treated as if it were zero.
If \fIlast\fR is greater than or equal to the number of elements
in the list, then it is treated as if it were \fBend\fR.
If \fIfirst\fR is greater than \fIlast\fR then an empty string
is returned.
Note:
.QW "\fBlrange \fIlist first first\fR"
does not always produce the same result as
.QW "\fBlindex \fIlist first\fR"
(although it often does for simple fields that are not enclosed in
braces); it does, however, produce exactly the same results as
.QW "\fBlist [lindex \fIlist first\fB]\fR"
.SH EXAMPLES
.PP
Selecting the first two elements:
.PP
.CS
% \fBlrange\fR {a b c d e} 0 1
a b
.CE
.PP
Selecting the last three elements:
.PP
.CS
% \fBlrange\fR {a b c d e} end-2 end
c d e
.CE
.PP
Selecting everything except the first and last element:
.PP
.CS
% \fBlrange\fR {a b c d e} 1 end-1
b c d
.CE
.PP
Selecting a single element with \fBlrange\fR is not the same as doing
so with \fBlindex\fR:
.PP
.CS
% set var {some {elements to} select}
some {elements to} select
% lindex $var 1
elements to
% \fBlrange\fR $var 1 1
{elements to}
.CE

.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lremove(n), lrepeat(n), lreplace(n),
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), 
lset(n), lreplace(n), lsort(n),
lreverse(n), lsearch(n), lset(n), lsort(n),
.VS 8.5
string(n)
.VE

.SH KEYWORDS
element, list, range, sublist
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/lremove.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
44
45
46
47
48
49
50
51
52
53
54
55
56
57

























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2019 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lremove n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lremove \- Remove elements from a list by index
.SH SYNOPSIS
\fBlremove \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlremove\fR returns a new list formed by simultaneously removing zero or
more elements of \fIlist\fR at each of the indices given by an arbirary number
of \fIindex\fR arguments. The indices may be in any order and may be repeated;
the element at index will only be removed once.  The index values are
interpreted the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the end of the
list.  0 refers to the first element of the list, and \fBend\fR refers to the
last element of the list.
.SH EXAMPLES
.PP
Removing the third element of a list:
.PP
.CS
% \fBlremove\fR {a b c d e} 2
a b d e
.CE
.PP
Removing two elements from a list:
.PP
.CS
% \fBlremove\fR {a b c d e} end-1 1
a c e
.CE
.PP
Removing the same element indicated in two different ways:
.PP
.CS
% \fBlremove\fR {a b c d e} 2 end-2
a b d e
.CE
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, list, remove
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/lrepeat.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
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









-
+







-
+



-
-
-
-
-
+
+
+
+
+
+












-
-
+
+
-


-
-
-
-
'\"
'\" Copyright (c) 2003 by Simon Geard.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lrepeat \- Build a list by repeating elements
.SH SYNOPSIS
\fBlrepeat \fIcount \fR?\fIelement ...\fR?
\fBlrepeat \fInumber element1 \fR?\fIelement2 element3 ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fBlrepeat\fR command creates a list of size \fIcount * number of
elements\fR by repeating \fIcount\fR times the sequence of elements
\fIelement ...\fR.  \fIcount\fR must be a non-negative integer,
\fIelement\fR can be any Tcl value.  Note that \fBlrepeat 1 element ...\fR
is identical to \fBlist element ...\fR.
The \fBlrepeat\fR command creates a list of size \fInumber * number of
elements\fR by repeating \fInumber\fR times the sequence of elements
\fIelement1 element2 ...\fR.  \fInumber\fR must be a positive integer,
\fIelementn\fR can be any Tcl value.  Note that \fBlrepeat 1 arg ...\fR
is identical to \fBlist arg ...\fR, though the \fIarg\fR is required
with \fBlrepeat\fR.
.SH EXAMPLES
.CS
\fBlrepeat\fR 3 a
      \fI\(-> a a a\fR
\fBlrepeat\fR 3 [\fBlrepeat\fR 3 0]
      \fI\(-> {0 0 0} {0 0 0} {0 0 0}\fR
\fBlrepeat\fR 3 a b c
      \fI\(-> a b c a b c a b c\fR
\fBlrepeat\fR 3 [\fBlrepeat\fR 2 a] b c
      \fI\(-> {a a} b c {a a} b c {a a} b c\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
list(n), lappend(n), linsert(n), llength(n), lset(n)

lreverse(n), lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, index, list
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/lreplace.n.

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
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











-
+

+








+
+

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


-
+


-
+



-
+
+

-

-






-






-








-







-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+
-
+

+


-
-
-
-
.SH NAME
lreplace \- Replace elements in a list with new elements
.SH SYNOPSIS
\fBlreplace \fIlist first last \fR?\fIelement element ...\fR?
.BE
.SH DESCRIPTION
.PP
\fBlreplace\fR returns a new list formed by replacing zero or more elements of
\fBlreplace\fR returns a new list formed by replacing one or more elements of
\fIlist\fR with the \fIelement\fR arguments.
.VS 8.5
\fIfirst\fR and \fIlast\fR are index values specifying the first and
last elements of the range to replace.
The index values \fIfirst\fR and \fIlast\fR are interpreted
the same as index values for the command \fBstring index\fR,
supporting simple index arithmetic and indices relative to the
end of the list.
0 refers to the first element of the
list, and \fBend\fR refers to the last element of the list.
If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
.VE
.PP
If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered
to refer to before the first element of the list. This allows \fBlreplace\fR
If \fIfirst\fR is less than zero, it is considered to refer to before the
first element of the list.  For non-empty lists, the element indicated
to prepend elements to \fIlist\fR.
.VS TIP505
If either \fIfirst\fR or \fIlast\fR indicates a position greater than the
index of the last element of the list, it is treated as if it is an
by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
start of the list.
index one greater than the last element. This allows \fBlreplace\fR to
append elements to \fIlist\fR.
.VE TIP505
.PP
If \fIlast\fR is less than \fIfirst\fR, then any specified elements
will be inserted into the list before the element specified by \fIfirst\fR
will be inserted into the list at the point specified by \fIfirst\fR
with no elements being deleted.
.PP
The \fIelement\fR arguments specify zero or more new elements to
The \fIelement\fR arguments specify zero or more new arguments to
be added to the list in place of those that were deleted.
Each \fIelement\fR argument will become a separate element of
the list.  If no \fIelement\fR arguments are specified, then the elements
between \fIfirst\fR and \fIlast\fR are simply deleted.
between \fIfirst\fR and \fIlast\fR are simply deleted.  If \fIlist\fR
is empty, any \fIelement\fR arguments are added to the end of the list.
.SH EXAMPLES
.PP
Replacing an element of a list with another:
.PP
.CS
% \fBlreplace\fR {a b c d e} 1 1 foo
a foo c d e
.CE
.PP
Replacing two elements of a list with three:
.PP
.CS
% \fBlreplace\fR {a b c d e} 1 2 three more elements
a three more elements d e
.CE
.PP
Deleting the last element from a list in a variable:
.PP
.CS
% set var {a b c d e}
a b c d e
% set var [\fBlreplace\fR $var end end]
a b c d
.CE
.PP
A procedure to delete a given element from a list:
.PP
.CS
proc lremove {listVariable value} {
    upvar 1 $listVariable var
    set idx [lsearch -exact $var $value]
    set var [\fBlreplace\fR $var $idx $idx]
}
.CE
.PP
.VS TIP505
Appending elements to the list; note that \fBend+2\fR will initially
be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
than the index of the final item so they behave identically:
.PP
.CS
% set var {a b c d e}
a b c d e
% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
a b c d e f g h i
.CE
.VE TIP505
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n),
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
lset(n), lrange(n), lsort(n),
lreverse(n), lsearch(n), lset(n), lsort(n),
.VS 8.5
string(n)
.VE
.SH KEYWORDS
element, list, replace
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/lreverse.n.

1

2
3
4
5
6

7
8
9
10
11
12
13

1
2
3
4
5

6
7
8
9
10
11
12
13
-
+




-
+







'\"
'\" -*- nroff -*-
'\" Copyright (c) 2006 by Donal K. Fellows.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lreverse \- Reverse the order of a list
.SH SYNOPSIS
21
22
23
24
25
26
27
28
29


30
31
32
33
34
35
21
22
23
24
25
26
27


28
29

30
31










-
-
+
+
-


-
-
-
.CS
\fBlreverse\fR {a a b c}
      \fI\(-> c b a a\fR
\fBlreverse\fR {a b {c d} e f}
      \fI\(-> f e {c d} b a\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
list(n), lsearch(n), lsort(n)

lsearch(n), lset(n), lsort(n)
.SH KEYWORDS
element, list, reverse
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/lsearch.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
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

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
-
+







-
-
+
+








+






-
+
-



-





-




-




-





-








-






-
-
+
+


-





-




-

+



+

-






-




-







-

+


-

-
+

+


-


-





-




-


-
-
-
-
-
-
-
-
-

-
+



-
-
-
-
-
-
-
-
-
-
-
-
-

-






-




-
+
+

-

-








-














-






-






-




-
-
-
-
-
-
-

-
-
+
-
-
+
+

+

-




'\"
'\" 
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\" Copyright (c) 2003-2004 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH lsearch n 8.6 Tcl "Tcl Built-In Commands"
'\" 
.TH lsearch n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lsearch \- See if a list contains a particular element
.SH SYNOPSIS
\fBlsearch \fR?\fIoptions\fR? \fIlist pattern\fR
.BE

.SH DESCRIPTION
.PP
This command searches the elements of \fIlist\fR to see if one
of them matches \fIpattern\fR.  If so, the command returns the index
of the first matching element
(unless the options \fB\-all\fR or \fB\-inline\fR are specified.)
If not, the command returns \fB\-1\fR or (if options \fB\-all\fR
If not, the command returns \fB\-1\fR.  The \fIoption\fR arguments
or \fB\-inline\fR are specified) the empty string.  The \fIoption\fR arguments
indicates how the elements of the list are to be matched against
\fIpattern\fR and must have one of the values below:
.SS "MATCHING STYLE OPTIONS"
.PP
If all matching style options are omitted, the default matching style
is \fB\-glob\fR.  If more than one matching style is specified, the
last matching style given takes precedence.
.TP
\fB\-exact\fR
.
\fIPattern\fR is a literal string that is compared for exact equality
against each list element.
.TP
\fB\-glob\fR
.
\fIPattern\fR is a glob-style pattern which is matched against each list
element using the same rules as the \fBstring match\fR command.
.TP
\fB\-regexp\fR
.
\fIPattern\fR is treated as a regular expression and matched against
each list element using the rules described in the \fBre_syntax\fR
reference page.
.TP
\fB\-sorted\fR
.
The list elements are in sorted order.  If this option is specified,
\fBlsearch\fR will use a more efficient searching algorithm to search
\fIlist\fR.  If no other options are specified, \fIlist\fR is assumed
to be sorted in increasing order, and to contain ASCII strings.  This
option is mutually exclusive with \fB\-glob\fR and \fB\-regexp\fR, and
is treated exactly like \fB\-exact\fR when either \fB\-all\fR or
\fB\-not\fR are specified.
.SS "GENERAL MODIFIER OPTIONS"
.PP
These options may be given with all matching styles.
.TP
\fB\-all\fR
.
Changes the result to be the list of all matching indices (or all matching
values if \fB\-inline\fR is specified as well.) If indices are returned, the
indices will be in ascending numeric order. If values are returned, the order
of the values will be the order of those values within the input \fIlist\fR.
indices will be in numeric order. If values are returned, the order of the
values will be the order of those values within the input \fIlist\fR.
.TP
\fB\-inline\fR
.
The matching value is returned instead of its index (or an empty
string if no value matches.)  If \fB\-all\fR is also specified, then
the result of the command is the list of all values that matched.
.TP
\fB\-not\fR
.
This negates the sense of the match, returning the index of the first
non-matching value in the list.
.TP
\fB\-start\fR\0\fIindex\fR
.
The list is searched starting at position \fIindex\fR.
.VS 8.5
The interpretation of the \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
.VE 8.5
.SS "CONTENTS DESCRIPTION OPTIONS"
.PP
These options describe how to interpret the items in the list being
searched.  They are only meaningful when used with the \fB\-exact\fR
and \fB\-sorted\fR options.  If more than one is specified, the last
one takes precedence.  The default is \fB\-ascii\fR.
.TP
\fB\-ascii\fR
.
The list elements are to be examined as Unicode strings (the name is
for backward-compatibility reasons.)
.TP
\fB\-dictionary\fR
.
The list elements are to be compared using dictionary-style
comparisons (see \fBlsort\fR for a fuller description). Note that this
only makes a meaningful difference from the \fB\-ascii\fR option when
the \fB\-sorted\fR option is given, because values are only
dictionary-equal when exactly equal.
.TP
\fB\-integer\fR
.
The list elements are to be compared as integers.
.VS 8.5
.TP
\fB\-nocase\fR
.
Causes comparisons to be handled in a case-insensitive manner.  Has no
effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or 
\fB\-real\fR options.
.VE 8.5
.TP
\fB\-real\fR
.
The list elements are to be compared as floating-point values.
.SS "SORTED LIST OPTIONS"
.PP
These options (only meaningful with the \fB\-sorted\fR option) specify
how the list is sorted.  If more than one is given, the last one takes
precedence.  The default option is \fB\-increasing\fR.
.TP
\fB\-decreasing\fR
.
The list elements are sorted in decreasing order.  This option is only
meaningful when used with \fB\-sorted\fR.
.TP
\fB\-increasing\fR
.
The list elements are sorted in increasing order.  This option is only
meaningful when used with \fB\-sorted\fR.
.TP
\fB\-bisect\fR
Inexact search when the list elements are in sorted order. For an increasing
list the last index where the element is less than or equal to the pattern
is returned. For a decreasing list the last index where the element is greater
than or equal to the pattern is returned. If the pattern is before the first
element or the list is empty, -1 is returned.
This option implies \fB\-sorted\fR and cannot be used with either \fB\-all\fR
or \fB\-not\fR.
.SS "NESTED LIST OPTIONS"
.PP
.VS 8.5
These options are used to search lists of lists.  They may be used
with any other options.
.TP
\fB\-stride\0\fIstrideLength\fR
.
If this option is specified, the list is treated as consisting of
groups of \fIstrideLength\fR elements and the groups are searched by
either their first element or, if the \fB\-index\fR option is used,
by the element within each group given by the first index passed to
\fB\-index\fR (which is then ignored by \fB\-index\fR). The resulting
index always points to the first element in a group.
.PP
The list length must be an integer multiple of \fIstrideLength\fR, which
in turn must be at least 1. A \fIstrideLength\fR of 1 is the default and
indicates no grouping.
.TP
\fB\-index\fR\0\fIindexList\fR
.
This option is designed for use when searching within nested lists.
The \fIindexList\fR argument gives a path of indices (much as might be
used with the \fBlindex\fR or \fBlset\fR commands) within each element
to allow the location of the term being matched against.
.TP
\fB\-subindices\fR
.
If this option is given, the index result from this command (or every
index result when \fB\-all\fR is also specified) will be a complete
path (suitable for use with \fBlindex\fR or \fBlset\fR) within the
overall list to the term found.  This option has no effect unless the
\fB\-index\fR is also specified, and is just a convenience short-cut.
\fI\-index\fR is also specified, and is just a convenience short-cut.
.VE 8.5
.SH EXAMPLES
.PP
Basic searching:
.PP
.CS
\fBlsearch\fR {a b c d e} c
      \fI\(-> 2\fR
\fBlsearch\fR -all {a b c a b c} c
      \fI\(-> 2 5\fR
.CE
.PP
Using \fBlsearch\fR to filter lists:
.PP
.CS
\fBlsearch\fR -inline {a20 b35 c47} b*
      \fI\(-> b35\fR
\fBlsearch\fR -inline -not {a20 b35 c47} b*
      \fI\(-> a20\fR
\fBlsearch\fR -all -inline -not {a20 b35 c47} b*
      \fI\(-> a20 c47\fR
\fBlsearch\fR -all -not {a20 b35 c47} b*
      \fI\(-> 0 2\fR
.CE
.PP
This can even do a
.QW set-like
removal operation:
.PP
.CS
\fBlsearch\fR -all -inline -not -exact {a b c a d e a f g a} a
      \fI\(-> b c d e f g\fR
.CE
.PP
Searching may start part-way through the list:
.PP
.CS
\fBlsearch\fR -start 3 {a b c a b c} c
      \fI\(-> 5\fR
.CE
.PP
It is also possible to search inside elements:
.PP
.CS
\fBlsearch\fR -index 1 -all -inline {{a abc} {b bcd} {c cde}} *bc*
      \fI\(-> {a abc} {b bcd}\fR
.CE
.PP
The same thing for a flattened list:
.PP
.CS
\fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc*
      \fI\(-> {a abc b bcd}\fR
.CE
.SH "SEE ALSO"
foreach(n),
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n), 
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lset(n), lsort(n),
lset(n), lsort(n), lrange(n), lreplace(n),
.VS 8.5
string(n)
.VE
.SH KEYWORDS
binary search, linear search,
list, match, pattern, regular expression, search, string
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/lset.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

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
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








-
+







-
+




-
+







-

-
+

-

-

-
+

-





-
+










-
+


-
-
-
+



+




-
+
-
-

-
+

-

-

-
+

-




-
-
+
+
-
-
+

-

-




-



-


















-
-


-

-





-

-







-
-
-
+
+
+

+
+
+


-
-
-
'\"
'\" Copyright (c) 2001 by Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lset n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lset \- Change an element in a list
.SH SYNOPSIS
\fBlset \fIvarName ?index ...? newValue\fR
\fBlset \fIvarName ?index...? newValue\fR
.BE
.SH DESCRIPTION
.PP
The \fBlset\fR command accepts a parameter, \fIvarName\fR, which
it interprets as the name of a variable containing a Tcl list.
it interprets as the name of a variable containing a Tcl list. 
It also accepts zero or more \fIindices\fR into
the list.  The indices may be presented either consecutively on the
command line, or grouped in a
Tcl list and presented as a single argument.
Finally, it accepts a new value for an element of \fIvarName\fR.
.PP
If no indices are presented, the command takes the form:
.PP
.CS
\fBlset\fR varName newValue
lset varName newValue
.CE
.PP
or
.PP
.CS
\fBlset\fR varName {} newValue
lset varName {} newValue
.CE
.PP
In this case, \fInewValue\fR replaces the old value of the variable
\fIvarName\fR.
.PP
When presented with a single index, the \fBlset\fR command
treats the content of the \fIvarName\fR variable as a Tcl list.
It addresses the \fIindex\fR'th element in it
It addresses the \fIindex\fR'th element in it 
(0 refers to the first element of the list).
When interpreting the list, \fBlset\fR observes the same rules
concerning braces and quotes and backslashes as the Tcl command
interpreter; however, variable
substitution and command substitution do not occur.
The command constructs a new list in which the designated element is
replaced with \fInewValue\fR.  This new list is stored in the
variable \fIvarName\fR, and is also the return value from the \fBlset\fR
command.
.PP
If \fIindex\fR is negative or greater than the number
If \fIindex\fR is negative or greater than or equal to the number
of elements in \fI$varName\fR, then an error occurs.
.PP
If \fIindex\fR is equal to the number of elements in \fI$varName\fR,
then the given element is appended to the list.
.PP
.VS 8.5
The interpretation of each simple \fIindex\fR value is the same as
for the command \fBstring index\fR, supporting simple index
arithmetic and indices relative to the end of the list.
.VE 8.5
.PP
If additional \fIindex\fR arguments are supplied, then each argument is
used in turn to address an element within a sublist designated
by the previous indexing operation,
allowing the script to alter elements in sublists (or append elements
allowing the script to alter elements in sublists.  The command,
to sublists).  The command,
.PP
.CS
\fBlset\fR a 1 2 newValue
lset a 1 2 newValue
.CE
.PP
or
.PP
.CS
\fBlset\fR a {1 2} newValue
lset a {1 2} newValue
.CE
.PP
replaces element 2 of sublist 1 with \fInewValue\fR.
.PP
The integer appearing in each \fIindex\fR argument must be greater
than or equal to zero.  The integer appearing in each \fIindex\fR
argument must be less than or equal to the length of the corresponding
list.  In other words, the \fBlset\fR command can change the size
argument must be strictly less than the length of the corresponding
list.  In other words, the \fBlset\fR command cannot change the size
of a list only by appending an element (setting the one after the current
end).  If an index is outside the permitted range, an error is reported.
of a list.  If an index is outside the permitted range, an error is reported.
.SH EXAMPLES
.PP
In each of these examples, the initial value of \fIx\fR is:
.PP
.CS
set x [list [list a b c] [list d e f] [list g h i]]
      \fI\(-> {a b c} {d e f} {g h i}\fR
.CE
.PP
The indicated return value also becomes the new value of \fIx\fR
(except in the last case, which is an error which leaves the value of
\fIx\fR unchanged.)
.PP
.CS
\fBlset\fR x {j k l}
      \fI\(-> j k l\fR
\fBlset\fR x {} {j k l}
      \fI\(-> j k l\fR
\fBlset\fR x 0 j
      \fI\(-> j {d e f} {g h i}\fR
\fBlset\fR x 2 j
      \fI\(-> {a b c} {d e f} j\fR
\fBlset\fR x end j
      \fI\(-> {a b c} {d e f} j\fR
\fBlset\fR x end-1 j
      \fI\(-> {a b c} j {g h i}\fR
\fBlset\fR x 2 1 j
      \fI\(-> {a b c} {d e f} {g j i}\fR
\fBlset\fR x {2 1} j
      \fI\(-> {a b c} {d e f} {g j i}\fR
\fBlset\fR x {2 3} j
      \fI\(-> {a b c} {d e f} {g h i j}\fR
\fBlset\fR x {2 4} j
      \fI\(-> list index out of range\fR
.CE
.PP
In the following examples, the initial value of \fIx\fR is:
.PP
.CS
set x [list [list [list a b] [list c d]] \e
            [list [list e f] [list g h]]]
      \fI\(-> {{a b} {c d}} {{e f} {g h}}\fR
.CE
.PP
The indicated return value also becomes the new value of \fIx\fR.
.PP
.CS
\fBlset\fR x 1 1 0 j
      \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR
\fBlset\fR x {1 1 0} j
      \fI\(-> {{a b} {c d}} {{e f} {j h}}\fR
.CE
.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lsort(n)
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), 
lsort(n), lrange(n), lreplace(n),
.VS 8.5
string(n)
.VE


.SH KEYWORDS
element, index, list, replace, set
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/lsort.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

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
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











-
+









+











-
+

-


-
+

-





-
+
-
-
+

-

-
+

-

-
+

-







-
+

-



-
+

-


-
+

-
+


+
-
+

-

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


-

-
+


-
-
+
-




-
-
+
+

-

+

-

-
-
-
-
+
+
+
+


-


+



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

-

-
+

+
-
+

-


-
-
+
+















-

-
+




-

-
+




-

-
+

-
+




-

-
+

-
+




-

-
-
+
+

-
+

-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-

-
+




-

-
+









-
+



+

-
-
-
+
+
+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 1999 Scriptics Corporation
'\" Copyright (c) 2001 Kevin B. Kenny <kennykb@acm.org>.  All rights reserved.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH lsort n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
lsort \- Sort the elements of a list
.SH SYNOPSIS
\fBlsort \fR?\fIoptions\fR? \fIlist\fR
.BE

.SH DESCRIPTION
.PP
This command sorts the elements of \fIlist\fR, returning a new
list in sorted order.  The implementation of the \fBlsort\fR command
uses the merge\-sort algorithm which is a stable sort that has O(n log
n) performance characteristics.
.PP
By default ASCII sorting is used with the result returned in
increasing order.  However, any of the following options may be
specified before \fIlist\fR to control the sorting process (unique
abbreviations are accepted):
.TP
.TP 20
\fB\-ascii\fR
.
Use string comparison with Unicode code-point collation order (the
name is for backward-compatibility reasons.)  This is the default.
.TP
.TP 20
\fB\-dictionary\fR
.
Use dictionary-style comparison.  This is the same as \fB\-ascii\fR
except (a) case is ignored except as a tie-breaker and (b) if two
strings contain embedded numbers, the numbers compare as integers,
not characters.  For example, in \fB\-dictionary\fR mode, \fBbigBoy\fR
sorts between \fBbigbang\fR and \fBbigboy\fR, and \fBx10y\fR
sorts between \fBx9y\fR and \fBx11y\fR. Overrides the \fB\-nocase\fR
sorts between \fBx9y\fR and \fBx11y\fR.
option.
.TP
.TP 20
\fB\-integer\fR
.
Convert list elements to integers and use integer comparison.
.TP
.TP 20
\fB\-real\fR
.
Convert list elements to floating-point values and use floating comparison.
.TP
.TP 20
\fB\-command\0\fIcommand\fR
.
Use \fIcommand\fR as a comparison command.
To compare two elements, evaluate a Tcl script consisting of
\fIcommand\fR with the two elements appended as additional
arguments.  The script should return an integer less than,
equal to, or greater than zero if the first element is to
be considered less than, equal to, or greater than the second,
respectively.
.TP
.TP 20
\fB\-increasing\fR
.
Sort the list in increasing order
.PQ smallest "items first" .
This is the default.
.TP
.TP 20
\fB\-decreasing\fR
.
Sort the list in decreasing order
.PQ largest "items first" .
.TP
.TP 20
\fB\-indices\fR
.
.VS "8.5 (TIP#217)"
Return a list of indices into \fIlist\fR in sorted order instead of
the values themselves.
.VE "8.5 (TIP#217)"
.TP
.TP 20
\fB\-index\0\fIindexList\fR
.
If this option is specified, each of the elements of \fIlist\fR must
itself be a proper Tcl sublist (unless \fB\-stride\fR is used).
Instead of sorting based on whole sublists, \fBlsort\fR will extract
the \fIindexList\fR'th element from each sublist (as if the overall
element and the \fIindexList\fR were passed to \fBlindex\fR) and sort
based on the given element.
itself be a proper Tcl sublist.  Instead of sorting based on whole
sublists, \fBlsort\fR will extract the \fIindexList\fR'th element from
each sublist
.VS 8.5
(as if the overall element and the \fIindexList\fR were passed to
\fBlindex\fR) and sort based on the given element.  
.VE 8.5
For example,
.RS
.PP
.CS
\fBlsort\fR -integer -index 1 \e
lsort -integer -index 1 \e
      {{First 24} {Second 18} {Third 30}}
.CE
.PP
returns \fB{Second 18} {First 24} {Third 30}\fR,
returns \fB{Second 18} {First 24} {Third 30}\fR, and
.PP
'\"
'\" This example is from the test suite!
'\"
.CS
\fBlsort\fR -index end-1 \e
        {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
lsort -index end-1 \e
      {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
.CE
.PP
returns \fB{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}\fR,
.VS 8.5
and
.PP
.CS
\fBlsort\fR -index {0 1} {
    {{b i g} 12345}
    {{d e m o} 34512}
    {{c o d e} 54321}
lsort -index {0 1} {
   {{b i g} 12345}
   {{d e m o} 34512}
   {{c o d e} 54321}
}
.CE
.PP
returns \fB{{d e m o} 34512} {{b i g} 12345} {{c o d e} 54321}\fR
(because \fBe\fR sorts before \fBi\fR which sorts before \fBo\fR.)
.VE 8.5
This option is much more efficient than using \fB\-command\fR
to achieve the same effect.
.RE
.TP
\fB\-stride\0\fIstrideLength\fR
.
.VS 8.5
If this option is specified, the list is treated as consisting of
groups of \fIstrideLength\fR elements and the groups are sorted by
either their first element or, if the \fB\-index\fR option is used,
by the element within each group given by the first index passed to
\fB\-index\fR (which is then ignored by \fB\-index\fR). Elements
always remain in the same position within their group.
.RS
.PP
The list length must be an integer multiple of \fIstrideLength\fR, which
in turn must be at least 2.
.PP
For example,
.PP
.CS
\fBlsort\fR \-stride 2 {carrot 10 apple 50 banana 25}
.CE
.PP
returns
.QW "apple 50 banana 25 carrot 10" ,
and
.PP
.CS
\fBlsort\fR \-stride 2 \-index 1 \-integer {carrot 10 apple 50 banana 25}
.CE
.PP
returns
.QW "carrot 10 banana 25 apple 50" .
.RE
.TP
.TP 20
\fB\-nocase\fR
.
Causes comparisons to be handled in a case-insensitive manner.  Has no
effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or
effect if combined with the \fB\-dictionary\fR, \fB\-integer\fR, or 
\fB\-real\fR options.
.VE 8.5
.TP
.TP 20
\fB\-unique\fR
.
If this option is specified, then only the last set of duplicate
elements found in the list will be retained.  Note that duplicates are
determined relative to the comparison used in the sort.  Thus if
\fB\-index 0\fR is used, \fB{1 a}\fR and \fB{1 b}\fR would be
determined relative to the comparison used in the sort.  Thus if 
\fI\-index 0\fR is used, \fB{1 a}\fR and \fB{1 b}\fR would be
considered duplicates and only the second element, \fB{1 b}\fR, would
be retained.
.SH "NOTES"
.PP
The options to \fBlsort\fR only control what sort of comparison is
used, and do not necessarily constrain what the values themselves
actually are.  This distinction is only noticeable when the list to be
sorted has fewer than two elements.
.PP
The \fBlsort\fR command is reentrant, meaning it is safe to use as
part of the implementation of a command used in the \fB\-command\fR
option.
.SH "EXAMPLES"
.PP
Sorting a list using ASCII sorting:
.PP
.CS
\fI%\fR \fBlsort\fR {a10 B2 b1 a1 a2}
% \fBlsort\fR {a10 B2 b1 a1 a2}
B2 a1 a10 a2 b1
.CE
.PP
Sorting a list using Dictionary sorting:
.PP
.CS
\fI%\fR \fBlsort\fR -dictionary {a10 B2 b1 a1 a2}
% \fBlsort\fR -dictionary {a10 B2 b1 a1 a2}
a1 a2 a10 b1 B2
.CE
.PP
Sorting lists of integers:
.PP
.CS
\fI%\fR \fBlsort\fR -integer {5 3 1 2 11 4}
% \fBlsort\fR -integer {5 3 1 2 11 4}
1 2 3 4 5 11
\fI%\fR \fBlsort\fR -integer {1 2 0x5 7 0 4 -1}
% \fBlsort\fR -integer {1 2 0x5 7 0 4 -1}
-1 0 1 2 4 0x5 7
.CE
.PP
Sorting lists of floating-point numbers:
.PP
.CS
\fI%\fR \fBlsort\fR -real {5 3 1 2 11 4}
% \fBlsort\fR -real {5 3 1 2 11 4}
1 2 3 4 5 11
\fI%\fR \fBlsort\fR -real {.5 0.07e1 0.4 6e-1}
% \fBlsort\fR -real {.5 0.07e1 0.4 6e-1}
0.4 .5 6e-1 0.07e1
.CE
.PP
Sorting using indices:
.PP
.CS
\fI%\fR # Note the space character before the c
\fI%\fR \fBlsort\fR {{a 5} { c 3} {b 4} {e 1} {d 2}}
% # Note the space character before the c
% \fBlsort\fR {{a 5} { c 3} {b 4} {e 1} {d 2}}
{ c 3} {a 5} {b 4} {d 2} {e 1}
\fI%\fR \fBlsort\fR -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}}
% \fBlsort\fR -index 0 {{a 5} { c 3} {b 4} {e 1} {d 2}}
{a 5} {b 4} { c 3} {d 2} {e 1}
\fI%\fR \fBlsort\fR -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}}
% \fBlsort\fR -index 1 {{a 5} { c 3} {b 4} {e 1} {d 2}}
{e 1} {d 2} { c 3} {b 4} {a 5}
.CE
.PP
Sorting a dictionary:
.PP
.CS
\fI%\fR set d [dict create c d a b h i f g c e]
c e a b h i f g
\fI%\fR \fBlsort\fR -stride 2 $d
a b c e f g h i
.CE
.PP
Sorting using striding and multiple indices:
.PP
.CS
\fI%\fR # Note the first index value is relative to the group
\fI%\fR \fBlsort\fR \-stride 3 \-index {0 1} \e
     {{Bob Smith} 25 Audi {Jane Doe} 40 Ford}
{{Jane Doe} 40 Ford {Bob Smith} 25 Audi}
.CE
.PP
Stripping duplicate values using sorting:
.PP
.CS
\fI%\fR \fBlsort\fR -unique {a b c a b c a b c}
% \fBlsort\fR -unique {a b c a b c a b c}
a b c
.CE
.PP
More complex sorting using a comparison function:
.PP
.CS
\fI%\fR proc compare {a b} {
% proc compare {a b} {
    set a0 [lindex $a 0]
    set b0 [lindex $b 0]
    if {$a0 < $b0} {
        return -1
    } elseif {$a0 > $b0} {
        return 1
    }
    return [string compare [lindex $a 1] [lindex $b 1]]
}
\fI%\fR \fBlsort\fR -command compare \e
% \fBlsort\fR -command compare \e
        {{3 apple} {0x2 carrot} {1 dingo} {2 banana}}
{1 dingo} {2 banana} {0x2 carrot} {3 apple}
.CE

.SH "SEE ALSO"
list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
lmap(n), lpop(n), lrange(n), lremove(n), lrepeat(n), lreplace(n),
lreverse(n), lsearch(n), lset(n)
list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n), 
lset(n), lrange(n), lreplace(n)

.SH KEYWORDS
element, list, order, sort
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/mathfunc.n.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-2000 Sun Microsystems, Inc.
'\" Copyright (c) 2005 by Kevin B. Kenny <kennykb@acm.org>. All rights reserved
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH mathfunc n 8.5 Tcl "Tcl Mathematical Functions"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
mathfunc \- Mathematical functions for Tcl expressions
.SH SYNOPSIS
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
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







+


+










-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-







.br
\fB::tcl::mathfunc::cos\fR \fIarg\fR
.br
\fB::tcl::mathfunc::cosh\fR \fIarg\fR
.br
\fB::tcl::mathfunc::double\fR \fIarg\fR
.br
.VS 8.5
\fB::tcl::mathfunc::entier\fR \fIarg\fR
.br
.VE 8.5
\fB::tcl::mathfunc::exp\fR \fIarg\fR
.br
\fB::tcl::mathfunc::floor\fR \fIarg\fR
.br
\fB::tcl::mathfunc::fmod\fR \fIx\fR \fIy\fR
.br
\fB::tcl::mathfunc::hypot\fR \fIx\fR \fIy\fR
.br
\fB::tcl::mathfunc::int\fR \fIarg\fR
.br
.VS "8.7, TIP 521"
\fB::tcl::mathfunc::isfinite\fR \fIarg\fR
.br
\fB::tcl::mathfunc::isinf\fR \fIarg\fR
.br
\fB::tcl::mathfunc::isnan\fR \fIarg\fR
.br
\fB::tcl::mathfunc::isnormal\fR \fIarg\fR
.VE "8.7, TIP 521"
.br
\fB::tcl::mathfunc::isqrt\fR \fIarg\fR
.br
.VS "8.7, TIP 521"
\fB::tcl::mathfunc::issubnormal\fR \fIarg\fR
.br
\fB::tcl::mathfunc::isunordered\fR \fIx y\fR
.VE "8.7, TIP 521"
.br
\fB::tcl::mathfunc::log\fR \fIarg\fR
.br
\fB::tcl::mathfunc::log10\fR \fIarg\fR
.br
\fB::tcl::mathfunc::max\fR \fIarg\fR ?\fIarg\fR ...?
.br
\fB::tcl::mathfunc::min\fR \fIarg\fR ?\fIarg\fR ...?
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
363
364
365
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











-
+




-
-
-
-
-
+
+
+
+
-





-
+
+
+
+



-




-




-




-




-






-

-
+





-





-



-




-







-
+




+


-




-





-




-
-
+
-
-
+
-
-


-



-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-




-




-




-




-




-
-
+








-




-



-




-






-





-



-



-


-
+

-
+


-
-
-
+
+
+

-
-
-
-
namespace \fB::tcl::mathfunc\fR; these functions are also available
for code apart from \fBexpr\fR, by invoking the given commands
directly.
.PP
Tcl supports the following mathematical functions in expressions, all
of which work solely with floating-point numbers unless otherwise noted:
.DS
.ta 3.2c 6.4c 9.6c
.ta 3c 6c 9c
\fBabs\fR	\fBacos\fR	\fBasin\fR	\fBatan\fR
\fBatan2\fR	\fBbool\fR	\fBceil\fR	\fBcos\fR
\fBcosh\fR	\fBdouble\fR	\fBentier\fR	\fBexp\fR
\fBfloor\fR	\fBfmod\fR	\fBhypot\fR	\fBint\fR
\fBisfinite\fR	\fBisinf\fR	\fBisnan\fR	\fBisnormal\fR
\fBisqrt\fR	\fBissubnormal\fR	\fBisunordered\fR	\fBlog\fR
\fBlog10\fR	\fBmax\fR	\fBmin\fR	\fBpow\fR
\fBrand\fR	\fBround\fR	\fBsin\fR	\fBsinh\fR
\fBsqrt\fR	\fBsrand\fR	\fBtan\fR	\fBtanh\fR
\fBisqrt\fR	\fBlog\fR	\fBlog10\fR	\fBmax\fR
\fBmin\fR	\fBpow\fR	\fBrand\fR	\fBround\fR
\fBsin\fR	\fBsinh\fR	\fBsqrt\fR	\fBsrand\fR
\fBtan\fR	\fBtanh\fR	\fBwide\fR
\fBwide\fR
.DE
.PP
In addition to these predefined functions, applications may
define additional functions by using \fBproc\fR (or any other method,
such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define
new commands in the \fBtcl::mathfunc\fR namespace.
new commands in the \fBtcl::mathfunc\fR namespace.  In addition, an
obsolete interface named \fBTcl_CreateMathFunc\fR() is available to
extensions that are written in C. The latter interface is not recommended
for new implementations.
.SS "DETAILED DEFINITIONS"
.TP
\fBabs \fIarg\fR
.
Returns the absolute value of \fIarg\fR.  \fIArg\fR may be either
integer or floating-point, and the result is returned in the same form.
.TP
\fBacos \fIarg\fR
.
Returns the arc cosine of \fIarg\fR, in the range [\fI0\fR,\fIpi\fR]
radians. \fIArg\fR should be in the range [\fI\-1\fR,\fI1\fR].
.TP
\fBasin \fIarg\fR
.
Returns the arc sine of \fIarg\fR, in the range [\fI\-pi/2\fR,\fIpi/2\fR]
radians.  \fIArg\fR should be in the range [\fI\-1\fR,\fI1\fR].
.TP
\fBatan \fIarg\fR
.
Returns the arc tangent of \fIarg\fR, in the range [\fI\-pi/2\fR,\fIpi/2\fR]
radians.
.TP
\fBatan2 \fIy x\fR
.
Returns the arc tangent of \fIy\fR/\fIx\fR, in the range [\fI\-pi\fR,\fIpi\fR]
radians.  \fIx\fR and \fIy\fR cannot both be 0.  If \fIx\fR is greater
than \fI0\fR, this is equivalent to
.QW "\fBatan \fR[\fBexpr\fR {\fIy\fB/\fIx\fR}]" .
.TP
\fBbool \fIarg\fR
.
Accepts any numeric value, or any string acceptable to
\fBstring is boolean\fR, and returns the corresponding
\fBstring is boolean\fR, and returns the corresponding 
boolean value \fB0\fR or \fB1\fR.  Non-zero numbers are true.
Other numbers are false.  Non-numeric strings produce boolean value in
agreement with \fBstring is true\fR and \fBstring is false\fR.
.TP
\fBceil \fIarg\fR
.
Returns the smallest integral floating-point value (i.e. with a zero
fractional part) not less than \fIarg\fR.  The argument may be any
numeric value.
.TP
\fBcos \fIarg\fR
.
Returns the cosine of \fIarg\fR, measured in radians.
.TP
\fBcosh \fIarg\fR
.
Returns the hyperbolic cosine of \fIarg\fR.  If the result would cause
an overflow, an error is returned.
.TP
\fBdouble \fIarg\fR
.
The argument may be any numeric value,
If \fIarg\fR is a floating-point value, returns \fIarg\fR, otherwise converts
\fIarg\fR to floating-point and returns the converted value.  May return
\fBInf\fR or \fB\-Inf\fR when the argument is a numeric value that exceeds
the floating-point range.
.TP
\fBentier \fIarg\fR
.
.VS 8.5
The argument may be any numeric value.  The integer part of \fIarg\fR
is determined and returned.  The integer range returned by this function
is unlimited, unlike \fBint\fR and \fBwide\fR which
truncate their range to fit in particular storage widths.
.VE 8.5
.TP
\fBexp \fIarg\fR
.
Returns the exponential of \fIarg\fR, defined as \fIe\fR**\fIarg\fR.
If the result would cause an overflow, an error is returned.
.TP
\fBfloor \fIarg\fR
.
Returns the largest integral floating-point value (i.e. with a zero
fractional part) not greater than \fIarg\fR.  The argument may be
any numeric value.
.TP
\fBfmod \fIx y\fR
.
Returns the floating-point remainder of the division of \fIx\fR by
\fIy\fR.  If \fIy\fR is 0, an error is returned.
.TP
\fBhypot \fIx y\fR
.
Computes the length of the hypotenuse of a right-angled triangle,
Computes the length of the hypotenuse of a right-angled triangle
approximately
.QW "\fBsqrt\fR [\fBexpr\fR {\fIx\fB*\fIx\fB+\fIy\fB*\fIy\fR}]"
.QW "\fBsqrt\fR [\fBexpr\fR {\fIx\fB*\fIx\fB+\fIy\fB*\fIy\fR}]".
except for being more numerically stable when the two arguments have
substantially different magnitudes.
.TP
\fBint \fIarg\fR
.
The argument may be any numeric value.  The integer part of \fIarg\fR
is determined, and then the low order bits of that integer value up
to the machine word size are returned as an integer value.  For reference,
the number of bytes in the machine word are stored in the \fBwordSize\fR
element of the \fBtcl_platform\fR array.
the number of bytes in the machine word are stored in
\fBtcl_platform(wordSize)\fR.
.TP
\fBisfinite \fIarg\fR
.VS "8.7, TIP 521"
Returns 1 if the floating-point number \fIarg\fR is finite. That is, if it is
zero, subnormal, or normal. Returns 0 if the number is infinite or NaN. Throws
an error if \fIarg\fR cannot be promoted to a floating-point value.
.VE "8.7, TIP 521"
.TP
\fBisinf \fIarg\fR
.VS "8.7, TIP 521"
Returns 1 if the floating-point number \fIarg\fR is infinite. Returns 0 if the
number is finite or NaN. Throws an error if \fIarg\fR cannot be promoted to a
floating-point value.
.VE "8.7, TIP 521"
.TP
\fBisnan \fIarg\fR
.VS "8.7, TIP 521"
Returns 1 if the floating-point number \fIarg\fR is Not-a-Number. Returns 0 if
the number is finite or infinite. Throws an error if \fIarg\fR cannot be
promoted to a floating-point value.
.VE "8.7, TIP 521"
.TP
\fBisnormal \fIarg\fR
.VS "8.7, TIP 521"
Returns 1 if the floating-point number \fIarg\fR is normal. Returns 0 if the
number is zero, subnormal, infinite or NaN. Throws an error if \fIarg\fR
cannot be promoted to a floating-point value.
.VE "8.7, TIP 521"
.TP
\fBisqrt \fIarg\fR
.
Computes the integer part of the square root of \fIarg\fR.  \fIArg\fR must be
a positive value, either an integer or a floating point number.
Unlike \fBsqrt\fR, which is limited to the precision of a floating point
number, \fIisqrt\fR will return a result of arbitrary precision.
.TP
\fBissubnormal \fIarg\fR
.VS "8.7, TIP 521"
Returns 1 if the floating-point number \fIarg\fR is subnormal, i.e., the
result of gradual underflow. Returns 0 if the number is zero, normal, infinite
or NaN. Throws an error if \fIarg\fR cannot be promoted to a floating-point
value.
.VE "8.7, TIP 521"
.TP
\fBisunordered \fIx y\fR
.VS "8.7, TIP 521"
Returns 1 if \fIx\fR and \fIy\fR cannot be compared for ordering, that is, if
either one is NaN. Returns 0 if both values can be ordered, that is, if they
are both chosen from among the set of zero, subnormal, normal and infinite
values. Throws an error if either \fIx\fR or \fIy\fR cannot be promoted to a
floating-point value.
.VE "8.7, TIP 521"
.TP
\fBlog \fIarg\fR
.
Returns the natural logarithm of \fIarg\fR.  \fIArg\fR must be a
positive value.
.TP
\fBlog10 \fIarg\fR
.
Returns the base 10 logarithm of \fIarg\fR.  \fIArg\fR must be a
positive value.
.TP
\fBmax \fIarg\fB \fI...\fR
.
Accepts one or more numeric arguments.  Returns the one argument
with the greatest value.
.TP
\fBmin \fIarg\fB \fI...\fR
.
Accepts one or more numeric arguments.  Returns the one argument
with the least value.
.TP
\fBpow \fIx y\fR
.
Computes the value of \fIx\fR raised to the power \fIy\fR.  If \fIx\fR
is negative, \fIy\fR must be an integer value.
.TP
\fBrand\fR
.
Returns a pseudo-random floating-point value in the range (\fI0\fR,\fI1\fR).
Returns a pseudo-random floating-point value in the range (\fI0\fR,\fI1\fR).  
The generator algorithm is a simple linear congruential generator that
is not cryptographically secure.  Each result from \fBrand\fR completely
determines all future results from subsequent calls to \fBrand\fR, so
\fBrand\fR should not be used to generate a sequence of secrets, such as
one-time passwords.  The seed of the generator is initialized from the
internal clock of the machine or may be set with the \fBsrand\fR function.
.TP
\fBround \fIarg\fR
.
If \fIarg\fR is an integer value, returns \fIarg\fR, otherwise converts
\fIarg\fR to integer by rounding and returns the converted value.
.TP
\fBsin \fIarg\fR
.
Returns the sine of \fIarg\fR, measured in radians.
.TP
\fBsinh \fIarg\fR
.
Returns the hyperbolic sine of \fIarg\fR.  If the result would cause
an overflow, an error is returned.
.TP
\fBsqrt \fIarg\fR
.
The argument may be any non-negative numeric value.  Returns a floating-point
value that is the square root of \fIarg\fR.  May return \fBInf\fR when the
argument is a numeric value that exceeds the square of the maximum value of
the floating-point range.
.TP
\fBsrand \fIarg\fR
.
The \fIarg\fR, which must be an integer, is used to reset the seed for
the random number generator of \fBrand\fR.  Returns the first random
number (see \fBrand\fR) from that seed.  Each interpreter has its own seed.
.TP
\fBtan \fIarg\fR
.
Returns the tangent of \fIarg\fR, measured in radians.
.TP
\fBtanh \fIarg\fR
.
Returns the hyperbolic tangent of \fIarg\fR.
.TP
\fBwide \fIarg\fR
.
The argument may be any numeric value.  The integer part of \fIarg\fR
is determined, and then the low order 64 bits of that integer value
are returned as an integer value.
are returned as an integer value.  
.SH "SEE ALSO"
expr(n), fpclassify(n), mathop(n), namespace(n)
expr(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
.nf
Copyright \(co 1993 The Regents of the University of California.
Copyright \(co 1994-2000 Sun Microsystems Incorporated.
Copyright \(co 2005, 2006 by Kevin B. Kenny <kennykb@acm.org>.
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 <kennykb@acm.org>.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/mathop.n.

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







.\"
.\" -*- nroff -*-
.\" Copyright (c) 2006-2007 Donal K. Fellows.
.\"
.\" See the file "license.terms" for information on usage and redistribution
.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.\"
.TH mathop n 8.5 Tcl "Tcl Mathematical Operator Commands"
.so man.macros
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
51
52
53
54
55
56
57










58
59
60
61
62
63
64







-
-
-
-
-
-
-
-
-
-







.br
\fB::tcl::mathop::>\fR ?\fIarg\fR ...?
.br
\fB::tcl::mathop::eq\fR ?\fIarg\fR ...?
.br
\fB::tcl::mathop::ne\fR \fIarg arg\fR
.br
.VS "8.7, TIP461"
\fB::tcl::mathop::lt\fR ?\fIarg\fR ...?
.br
\fB::tcl::mathop::le\fR ?\fIarg\fR ...?
.br
\fB::tcl::mathop::gt\fR ?\fIarg\fR ...?
.br
\fB::tcl::mathop::ge\fR ?\fIarg\fR ...?
.VE "8.7, TIP461"
.br
\fB::tcl::mathop::in\fR \fIarg list\fR
.br
\fB::tcl::mathop::ni\fR \fIarg list\fR
.sp
.BE
.SH DESCRIPTION
.PP
82
83
84
85
86
87
88
89

90
91
92
93
94
95
96
97
72
73
74
75
76
77
78

79

80
81
82
83
84
85
86







-
+
-







The following operator commands are supported:
.DS
.ta 2c 4c 6c 8c
\fB~\fR	\fB!\fR	\fB+\fR	\fB\-\fR	\fB*\fR
\fB/\fR	\fB%\fR	\fB**\fR	\fB&\fR	\fB|\fR
\fB^\fR	\fB>>\fR	\fB<<\fR	\fB==\fR	\fBeq\fR
\fB!=\fR	\fBne\fR	\fB<\fR	\fB<=\fR	\fB>\fR
\fB>=\fR	\fBin\fR	\fBni\fR	\fBlt\fR	\fBle\fR
\fB>=\fR	\fBin\fR	\fBni\fR
\fBgt\fR	\fBge\fR
.DE
.SS "MATHEMATICAL OPERATORS"
.PP
The behaviors of the mathematical operator commands are as follows:
.TP
\fB!\fR \fIboolean\fR
.
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
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







-
+












-
-
-
-
-
+
+
+
+







.RS
.PP
Note that Tcl defines this operation exactly even for negative numbers, so
that the following command returns a true value (omitting the namespace for
clarity):
.PP
.CS
\fB==\fR [\fB*\fR [\fB/\fI x y\fR] \fIy\fR] [\fB\-\fI x\fR [\fB%\fI x y\fR]]
\fB==\fR [\fB*\fR [\fB/\fI x y\fR] \fIy\fR] [\fB-\fI x\fR [\fB%\fI x y\fR]]
.CE
.RE
.TP
\fB**\fR ?\fInumber\fR ...?
.
Returns the result of raising each value to the power of the result of
recursively operating on the result of processing the following arguments, so
.QW "\fB** 2 3 4\fR"
is the same as
.QW "\fB** 2 [** 3 4]\fR" .
Each \fInumber\fR may be
any numeric value, though the second number must not be fractional if the
first is negative.  The maximum exponent value that Tcl can handle if the
first number is an integer > 1 is 268435455. If no arguments are given,
the result will be one, and if only one argument is given, the result will
be that argument. The result will have an integral value only when all
arguments are integral values.
first is negative. If no arguments are given, the result will be one, and if
only one argument is given, the result will be that argument. The
result will have an integral value only when all arguments are
integral values.
.SS "COMPARISON OPERATORS"
.PP
The behaviors of the comparison operator commands (most of which operate
preferentially on numeric arguments) are as follows:
.TP
\fB==\fR ?\fIarg\fR ...?
.
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
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







-
-
+
+








-
-
+
+








-
-
+
+








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







\fB<\fR ?\fIarg\fR ...?
.
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be strictly more than the one preceding it.
Comparisons are performed preferentially on the numeric values, and are
otherwise performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value. When the
arguments are numeric but should be compared as strings, the \fBlt\fR
operator or the \fBstring compare\fR command should be used instead.
arguments are numeric but should be compared as strings, the \fBstring
compare\fR command should be used instead.
.TP
\fB<=\fR ?\fIarg\fR ...?
.
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be equal to or more than the one preceding it.
Comparisons are performed preferentially on the numeric values, and are
otherwise performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value. When the
arguments are numeric but should be compared as strings,  the \fBle\fR
operator or the \fBstring compare\fR command should be used instead.
arguments are numeric but should be compared as strings, the \fBstring
compare\fR command should be used instead.
.TP
\fB>\fR ?\fIarg\fR ...?
.
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be strictly less than the one preceding it.
Comparisons are performed preferentially on the numeric values, and are
otherwise performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value. When the
arguments are numeric but should be compared as strings, the \fBgt\fR
operator or the \fBstring compare\fR command should be used instead.
arguments are numeric but should be compared as strings, the \fBstring
compare\fR command should be used instead.
.TP
\fB>=\fR ?\fIarg\fR ...?
.
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be equal to or less than the one preceding it.
Comparisons are performed preferentially on the numeric values, and are
otherwise performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value. When the
arguments are numeric but should be compared as strings, the \fBge\fR
operator or the \fBstring compare\fR command should be used instead.
arguments are numeric but should be compared as strings, the \fBstring
compare\fR command should be used instead.
.TP
\fBlt\fR ?\fIarg\fR ...?
.VS "8.7, TIP461"
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be strictly more than the one preceding it.
Comparisons are performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value.
.VE "8.7, TIP461"
.TP
\fBle\fR ?\fIarg\fR ...?
.VS "8.7, TIP461"
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be equal to or strictly more than the one preceding it.
Comparisons are performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value.
.VE "8.7, TIP461"
.TP
\fBgt\fR ?\fIarg\fR ...?
.VS "8.7, TIP461"
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be strictly less than the one preceding it.
Comparisons are performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value.
.VE "8.7, TIP461"
.TP
\fBge\fR ?\fIarg\fR ...?
.VS "8.7, TIP461"
Returns whether the arbitrarily-many arguments are ordered, with each argument
after the first having to be equal to or strictly less than the one preceding it.
Comparisons are performed using UNICODE string comparison. If fewer than two
arguments are present, this operation always returns a true value.
.VE "8.7, TIP461"
.SS "BIT-WISE OPERATORS"
.PP
The behaviors of the bit-wise operator commands (all of which only operate on
integral arguments) are as follows:
.TP
\fB~\fR \fInumber\fR
.
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
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










-



-
















-
+

-
-
-
-





-
-
-
(according to exact string comparison of elements).
.TP
\fBni\fR \fIarg list\fR
.
Returns whether the value \fIarg\fR is not present in the list \fIlist\fR
(according to exact string comparison of elements).
.SH EXAMPLES
.PP
The simplest way to use the operators is often by using \fBnamespace path\fR
to make the commands available. This has the advantage of not affecting the
set of commands defined by the current namespace.
.PP
.CS
namespace path {\fB::tcl::mathop\fR ::tcl::mathfunc}

\fI# Compute the sum of some numbers\fR
set sum [\fB+\fR 1 2 3]

\fI# Compute the average of a list\fR
set list {1 2 3 4 5 6}
set mean [\fB/\fR [\fB+\fR {*}$list] [double [llength $list]]]

\fI# Test for list membership\fR
set gotIt [\fBin\fR 3 $list]

\fI# Test to see if a value is within some defined range\fR
set inRange [\fB<=\fR 1 $x 5]

\fI# Test to see if a list is numerically sorted\fR
\fI# Test to see if a list is sorted\fR
set sorted [\fB<=\fR {*}$list]

\fI# Test to see if a list is lexically sorted\fR
set alphaList {a b c d e f}
set sorted [\fBle\fR {*}$alphaList]
.CE
.SH "SEE ALSO"
expr(n), mathfunc(n), namespace(n)
.SH KEYWORDS
command, expression, operator
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/memory.n.

1
2
3
4
5

6
7
8
9
10
11
12
1
2
3
4

5
6
7
8
9
10
11
12




-
+







'\"
'\" Copyright (c) 1992-1999 by Karl Lehenbauer and Mark Diekhans
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
'\" 
.TH memory n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
memory \- Control Tcl memory debugging capabilities
.SH SYNOPSIS
\fBmemory \fIoption \fR?\fIarg arg ...\fR?
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
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







-
+







-
+

-
-
+
+







.TP
\fBmemory active\fR \fIfile\fR
.
Write a list of all currently allocated memory to the specified \fIfile\fR.
.TP
\fBmemory break_on_malloc\fR \fIcount\fR
.
After the \fIcount\fR allocations have been performed, \fBTcl_Alloc\fR
After the \fIcount\fR allocations have been performed, \fBckalloc\fR
outputs a message to this effect and that it is now attempting to enter
the C debugger.  Tcl will then issue a \fISIGINT\fR signal against itself.
If you are running Tcl under a C debugger, it should then enter the debugger
command mode.
.TP
\fBmemory info\fR
.
Returns a report containing the total allocations and frees since
Returns a report containing the total allocations and frees since 
Tcl began, the current packets allocated (the current
number of calls to \fBTcl_Alloc\fR not met by a corresponding call
to \fBTcl_Free\fR), the current bytes allocated, and the maximum number
number of calls to \fBckalloc\fR not met by a corresponding call 
to \fBckfree\fR), the current bytes allocated, and the maximum number
of packets and bytes allocated.
.TP
\fBmemory init \fR[\fBon\fR|\fBoff\fR]
.
Turn on or off the pre-initialization of all allocated memory
with bogus bytes.  Useful for detecting the use of uninitialized
values.
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
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










-
+




-
+




-
-
+
+





-
+


-
+




-
+

-
+




-
+





-
+

-
+


-
-
+
+



-
+


-
-
-
.
Causes a list of all allocated memory to be written to the specified \fIfile\fR
during the finalization of Tcl's memory subsystem.  Useful for checking
that memory is properly cleaned up during process exit.
.TP
\fBmemory tag\fR \fIstring\fR
.
Each packet of memory allocated by \fBTcl_Alloc\fR can have associated
Each packet of memory allocated by \fBckalloc\fR can have associated
with it a string-valued tag.  In the lists of allocated memory generated
by \fBmemory active\fR and \fBmemory onexit\fR, the tag for each packet
is printed along with other information about the packet.  The
\fBmemory tag\fR command sets the tag value for subsequent calls
to \fBTcl_Alloc\fR to be \fIstring\fR.
to \fBckalloc\fR to be \fIstring\fR.  
.TP
\fBmemory trace \fR[\fBon\fR|\fBoff\fR]
.
Turns memory tracing on or off.  When memory tracing is on, every call
to \fBTcl_Alloc\fR causes a line of trace information to be written to
\fIstderr\fR, consisting of the word \fITcl_Alloc\fR, followed by the
to \fBckalloc\fR causes a line of trace information to be written to
\fIstderr\fR, consisting of the word \fIckalloc\fR, followed by the
address returned, the amount of memory allocated, and the C filename
and line number of the code performing the allocation.  For example:
.RS
.PP
.CS
Tcl_Alloc 40e478 98 tclProc.c 1406
ckalloc 40e478 98 tclProc.c 1406
.CE
.PP
Calls to \fBTcl_Free\fR are traced in the same manner.
Calls to \fBckfree\fR are traced in the same manner.
.RE
.TP
\fBmemory trace_on_at_malloc\fR \fIcount\fR
.
Enable memory tracing after \fIcount\fR \fBTcl_Alloc\fRs have been performed.
Enable memory tracing after \fIcount\fR \fBckalloc\fRs have been performed.
For example, if you enter \fBmemory trace_on_at_malloc 100\fR,
after the 100th call to \fBTcl_Alloc\fR, memory trace information will begin
after the 100th call to \fBckalloc\fR, memory trace information will begin
being displayed for all allocations and frees.  Since there can be a lot
of memory activity before a problem occurs, judicious use of this option
can reduce the slowdown caused by tracing (and the amount of trace information
produced), if you can identify a number of allocations that occur before
the problem sets in.  The current number of memory allocations that have
the problem sets in.  The current number of memory allocations that have 
occurred since Tcl started is printed on a guard zone failure.
.TP
\fBmemory validate \fR[\fBon\fR|\fBoff\fR]
.
Turns memory validation on or off. When memory validation is enabled,
on every call to \fBTcl_Alloc\fR or \fBTcl_Free\fR, the guard zones are
on every call to \fBckalloc\fR or \fBckfree\fR, the guard zones are
checked for every piece of memory currently in existence that was
allocated by \fBTcl_Alloc\fR.  This has a large performance impact and
allocated by \fBckalloc\fR.  This has a large performance impact and
should only be used when overwrite problems are strongly suspected.
The advantage of enabling memory validation is that a guard zone
overwrite can be detected on the first call to \fBTcl_Alloc\fR or
\fBTcl_Free\fR after the overwrite occurred, rather than when the
overwrite can be detected on the first call to \fBckalloc\fR or
\fBckfree\fR after the overwrite occurred, rather than when the
specific memory with the overwritten guard zone(s) is freed, which may
occur long after the overwrite occurred.
.SH "SEE ALSO"
Tcl_Alloc, Tcl_Free, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG
ckalloc, ckfree, Tcl_ValidateAllMemory, Tcl_DumpActiveMemory, TCL_MEM_DEBUG
.SH KEYWORDS
memory, debug
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/msgcat.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
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
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





-
+







-
+

-
+





-
-
-
-
-
-
-
-


-
-
+
-
-
-
-
-







+



-
-
-
-
-
-
-
-
-
-
+

-
-
+
-










-
+


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





-
+


















-
-
-
-
-
-
-
-
-
-
-







-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


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




-
-
-
-
-
-

-
+

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



-

-
-
+
+








-
-
-
-
-




















+





+


+







+












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







'\"
'\" Copyright (c) 1998 Mark Harrison.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH "msgcat" n 1.5 msgcat "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
\fBpackage require Tcl 8.7\fR
\fBpackage require Tcl 8.5\fR
.sp
\fBpackage require msgcat 1.7\fR
\fBpackage require msgcat 1.5\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.sp
.VS "TIP 412"
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
.VE "TIP 412"
.sp
.VS "TIP 490"
\fB::msgcat::mcpackagenamespaceget\fR
.VE "TIP 490"
.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
.VS "TIP 499"
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
\fB::msgcat::mcpreferences\fR
.VE "TIP 499"
.sp
.VS "TIP 412"
\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
.VE "TIP 412"
.sp
\fB::msgcat::mcload \fIdirname\fR
.sp
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
.sp
.VS "TIP 404"
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
.sp
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
.sp
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.sp
.VS "TIP 412"
\fB::msgcat::mcpackagelocale subcommand\fR ?\fIlocale\fR?
.sp
\fB::msgcat::mcpackageconfig subcommand\fR \fIoption\fR ?\fIvalue\fR?
.sp
\fB::msgcat::mcforgetpackage\fR
.VE "TIP 412"
.VE "TIP 404"
.sp
.VS "TIP 499"
\fB::msgcat::mcutil subcommand\fR ?\fIlocale\fR?
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.VS "TIP 499"
.BE
.SH DESCRIPTION
.PP
The \fBmsgcat\fR package provides a set of functions
that can be used to manage multi-lingual user interfaces.
Text strings are defined in a
.QW "message catalog"
which is independent from the application, and
which can be edited or localized without modifying
the application source code.  New languages
or locales may be provided by adding a new file to
or locales are provided by adding a new file to
the message catalog.
.PP
\fBmsgcat\fR distinguises packages by its namespace.
Each package has its own message catalog and configuration settings in \fBmsgcat\fR.
Use of the message catalog is optional by any application
.PP
A \fIlocale\fR is a specification string describing a user language like \fBde_ch\fR for Swiss German.
In \fBmsgcat\fR, there is a global locale initialized by the system locale of the current system.
Each package may decide to use the global locale or to use a package specific locale.
or package, but is encouraged if the application or package
.PP
The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server.
wishes to be enabled for multi-lingual applications.
.PP
.VS tip490
Object oriented programming is supported by the use of a package namespace.
.VE tip490
.PP
.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Returns a translation of \fIsrc-string\fR according to the
current locale.  If additional arguments past \fIsrc-string\fR
user's current locale.  If additional arguments past \fIsrc-string\fR
are given, the \fBformat\fR command is used to substitute the
additional arguments in the translation of \fIsrc-string\fR.
.RS
.PP
\fB::msgcat::mc\fR will search the messages defined
in the current namespace for a translation of \fIsrc-string\fR; if
none is found, it will search in the parent of the current namespace,
and so on until it reaches the global namespace.  If no translation
string exists, \fB::msgcat::mcunknown\fR is called and the string
returned from \fB::msgcat::mcunknown\fR is returned.
.PP
\fB::msgcat::mc\fR is the main function used to localize an
application.  Instead of using an English string directly, an
application can pass the English string through \fB::msgcat::mc\fR and
use the result.  If an application is written for a single language in
this fashion, then it is easy to add support for additional languages
later simply by defining new message catalog entries.
.RE
.VS "TIP 490"
.TP
\fB::msgcat::mcn \fInamespace\fR \fIsrc-string\fR ?\fIarg arg ...\fR?
.
Like \fB::msgcat::mc\fR, but with the message namespace specified as first argument.
.PP
.RS
\fBmcn\fR may be used for cases where the package namespace is not the namespace of the caller.
An example is shown within the description of the command \fB::msgcat::mcpackagenamespaceget\fR below.
.RE
.PP
.TP
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.
Given several source strings, \fB::msgcat::mcmax\fR returns the length
of the longest translated string.  This is useful when designing
localized GUIs, which may require that all buttons, for example, be a
fixed width (which will be the width of the widest button).
.VS "TIP 412"
.TP
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fR \fInamespace\fR? \fIsrc-string\fR
.
Return true, if there is a translation for the given \fIsrc-string\fR.
.PP
.RS
The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces.
.PP
It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used).
.PP
.VE "TIP 412"
.VS "TIP 490"
An explicit package namespace may be specified by the option \fB-namespace\fR.
The namespace of the caller is used if not explicitly specified.
.RE
.PP
.VE "TIP 490"
.VS "TIP 490"
.TP
\fB::msgcat::mcpackagenamespaceget\fR
.
Return the package namespace of the caller.
This command handles all cases described in section \fBOBJECT ORIENTED PROGRAMMING\fR.
.PP
.RS
Example usage is a tooltip package, which saves the caller package namespace to update the translation each time the tooltip is shown:
.CS
proc ::tooltip::tooltip {widget message} {
    ...
    set messagenamespace [uplevel 1 {::msgcat::mcpackagenamespaceget}]
    ...
    bind $widget  [list ::tooltip::show $widget $messagenamespace $message]
}

proc ::tooltip::show {widget messagenamespace message} {
    ...
    set message [::msgcat::mcn $messagenamespace $message]
    ...
}
.CE
.RE
.PP
.VE "TIP 490"
.TP
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.
This function sets the locale to \fInewLocale\fR.  If \fInewLocale\fR
If \fInewLocale\fR is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR.
is omitted, the current locale is returned, otherwise the current locale
is set to \fInewLocale\fR.  msgcat stores and compares the locale in a
.PP
.RS
If the new locale is set to \fInewLocale\fR, the corresponding preferences are calculated and set.
For example, if the current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR.
.PP
The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fR \fInewLocale\fR].
.PP
The current locale is always the first element of the list returned by \fBmcpreferences\fR.
.PP
msgcat stores and compares the locale in a
case-insensitive manner, and returns locales in lowercase.
The initial locale is determined by the locale specified in
the user's environment.  See \fBLOCALE SPECIFICATION\fR
below for a description of the locale string format.
.PP
.VS "TIP 412"
If the locale is set, the preference list of locales is evaluated.
Locales in this list are loaded now, if not jet loaded.
.VE "TIP 412"
.RE
.TP
\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
\fB::msgcat::mcpreferences\fR
.
Without arguments, returns an ordered list of the locales preferred by
the user.
The list is ordered from most specific to least preference.
Returns an ordered list of the locales preferred by
the user, based on the user's language specification.
The list is ordered from most specific to least
.PP
.VS "TIP 499"
.RS
A set of locale preferences may be given to set the list of locale preferences.
preference.  The list is derived from the current
The current locale is also set, which is the first element of the locale preferences list.
.PP
Locale preferences are loaded now, if not jet loaded.
locale set in msgcat by \fB::msgcat::mclocale\fR, and
.PP
As an example, the user may prefer French or English text. This may be configured by:
cannot be set independently.  For example, if the
.CS
::msgcat::mcpreferences fr en {}
current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
.CE
.RE
.PP
.VS "TIP 499"
.TP
\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
.
This group of commands manage the list of loaded locales for packages not setting a package locale.
.PP
.RS
The subcommand \fBget\fR returns the list of currently loaded locales.
returns \fB{en_US_funky en_US en {}}\fR.
.PP
The subcommand \fBpresent\fR requires the argument \fIlocale\fR and returns true, if this locale is loaded.
.PP
The subcommand \fBclear\fR removes all locales and their data, which are not in the current preference list.
.RE
.TP
\fB::msgcat::mcload \fIdirname\fR
.
.VS "TIP 412"
Searches the specified directory for files that match
the language specifications returned by \fB::msgcat::mcloadedlocales get\fR
(or \fBmsgcat::mcpackagelocale preferences\fR if a package locale is set) (note that these are all lowercase), extended by the file extension
the language specifications returned by \fB::msgcat::mcpreferences\fR
(note that these are all lowercase), extended by the file extension
.QW .msg .
Each matching file is
read in order, assuming a UTF-8 encoding.  The file contents are
then evaluated as a Tcl script.  This means that Unicode characters
may be present in the message file either directly in their UTF-8
encoded form, or by use of the backslash-u quoting recognized by Tcl
evaluation.  The number of message files which matched the specification
and were loaded is returned.
.RS
.PP
In addition, the given folder is stored in the \fBmsgcat\fR package configuration option \fImcfolder\fR to eventually load message catalog files required by a locale change.
.VE "TIP 412"
.RE
.TP
\fB::msgcat::mcset \fIlocale src-string \fR?\fItranslate-string\fR?
.
Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR
in the specified \fIlocale\fR and the current namespace.  If
\fItranslate-string\fR is not specified, \fIsrc-string\fR is used
for both.  The function returns \fItranslate-string\fR.
.TP
\fB::msgcat::mcmset \fIlocale src-trans-list\fR
.
Sets the translation for multiple source strings in
\fIsrc-trans-list\fR in the specified \fIlocale\fR and the current
namespace.
\fIsrc-trans-list\fR must have an even number of elements and is in
the form {\fIsrc-string translate-string\fR ?\fIsrc-string
translate-string ...\fR?} \fB::msgcat::mcmset\fR can be significantly
faster than multiple invocations of \fB::msgcat::mcset\fR. The function
returns the number of translations set.
.TP
\fB::msgcat::mcflset \fIsrc-string \fR?\fItranslate-string\fR?
.VS "TIP 404"
Sets the translation for \fIsrc-string\fR to \fItranslate-string\fR in the
current namespace for the locale implied by the name of the message catalog
being loaded via \fB::msgcat::mcload\fR.  If \fItranslate-string\fR is not
specified, \fIsrc-string\fR is used for both.  The function returns
\fItranslate-string\fR.
.VE "TIP 404"
.TP
\fB::msgcat::mcflmset \fIsrc-trans-list\fR
.VS "TIP 404"
Sets the translation for multiple source strings in \fIsrc-trans-list\fR in
the current namespace for the locale implied by the name of the message
catalog being loaded via \fB::msgcat::mcload\fR. \fIsrc-trans-list\fR must
have an even number of elements and is in the form {\fIsrc-string
translate-string\fR ?\fIsrc-string translate-string ...\fR?}
\fB::msgcat::mcflmset\fR can be significantly faster than multiple invocations
of \fB::msgcat::mcflset\fR. The function returns the number of translations set.
.VE "TIP 404"
.TP
\fB::msgcat::mcunknown \fIlocale src-string\fR ?\fIarg arg ...\fR?
.
This routine is called by \fB::msgcat::mc\fR in the case when
a translation for \fIsrc-string\fR is not defined in the
current locale.  The default action is to return
\fIsrc-string\fR passed by format if there are any arguments.  This
procedure can be redefined by the
application, for example to log error messages for each unknown
string.  The \fB::msgcat::mcunknown\fR procedure is invoked at the
same stack context as the call to \fB::msgcat::mc\fR.  The return value
of \fB::msgcat::mcunknown\fR is used as the return value for the call
to \fB::msgcat::mc\fR.
to \fB::msgcat::mc\fR.  
.VS "TIP 412"
.RS
.PP
Note that this routine is only called if the concerned package did not set a package locale unknown command name.
.RE
.TP
\fB::msgcat::mcforgetpackage\fR
.
The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations.
.VE "TIP 412"
.PP
.VS "TIP 499"
.TP
\fB::msgcat::mcutil getpreferences\fR \fIlocale\fR
.
Return the preferences list of the given locale as described in section \fBLOCALE SPECIFICATION\fR.
An example is the composition of a preference list for the bilingual region "Biel/Bienne" as a concatenation of swiss german and swiss french:
.CS
% concat [lrange [msgcat::mcutil getpreferences fr_CH] 0 end-1] [msgcat::mcutil getpreferences de_CH]
fr_ch fr de_ch de {}
.CE
.TP
\fB::msgcat::mcutil getsystemlocale\fR
.
The system locale is returned as described by the section \fBLOCALE SPECIFICATION\fR.
.VE "TIP 499"
.PP
.SH "LOCALE SPECIFICATION"
.PP
The locale is specified to \fBmsgcat\fR by a locale string
passed to \fB::msgcat::mclocale\fR.
The locale string consists of
a language code, an optional country code, and an optional
system-specific code, each separated by
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
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







-
+




















-
-
+
+






-
+







initial locale.  The value is parsed according to the XPG4 pattern
.PP
.CS
language[_country][.codeset][@modifier]
.CE
.PP
to extract its parts.  The initial locale is then set by calling
\fB::msgcat::mclocale\fR with the argument
\fB::msgcat::mclocale\fR with the argument 
.PP
.CS
language[_country][_modifier]
.CE
.PP
On Windows and Cygwin, if none of those environment variables is set,
msgcat will attempt to extract locale information from the registry.
From Windows Vista on, the RFC4747 locale name "lang-script-country-options"
is transformed to the locale as "lang_country_script" (Example:
sr-Latn-CS -> sr_cs_latin). For Windows XP, the language id is
transformed analoguously (Example: 0c1a -> sr_yu_cyrillic).
If all these attempts to discover an initial locale from the user's
environment fail, msgcat defaults to an initial locale of
.QW C .
.PP
When a locale is specified by the user, a
.QW "best match"
search is performed during string translation.  For example, if a user
specifies
en_GB_Funky, the locales
.QW en_gb_funky ,
.QW en_gb ,
.QW en_GB_Funky ,
.QW en_GB ,
.QW en
and
.MT
(the empty string)
are searched in order until a matching translation
string is found.  If no translation string is available, then
the unknown handler is called.
\fB::msgcat::mcunknown\fR is called.
.SH "NAMESPACES AND MESSAGE CATALOGS"
.PP
Strings stored in the message catalog are stored relative
to the namespace from which they were added.  This allows
multiple packages to use the same strings without fear
of collisions with other packages.  It also allows the
source string to be shorter and less prone to typographical
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
369
370
371
372
373
374
375






































































































































































































































































376
377
378
379

380
381

382
383
384
385







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+

-
+



formatting substitution is done directly.
.PP
.CS
\fBmsgcat::mc\fR {Produced %1$d at %2$s} $num $city
# ... where that key is mapped to one of the
# human-oriented versions by \fBmsgcat::mcset\fR
.CE
.VS "TIP 412"
.SH "PACKAGE PRIVATE LOCALE"
.PP
A package using \fBmsgcat\fR may choose to use its own package private
locale and its own set of loaded locales, independent to the global
locale set by \fB::msgcat::mclocale\fR.
.PP
This allows a package to change its locale without causing any locales load or removal in other packages and not to invoke the global locale change callback (see below).
.PP
This action is controled by the following ensemble:
.TP
\fB::msgcat::mcpackagelocale set\fR ?\fIlocale\fR?
.
Set or change a package private locale.
The package private locale is set to the given \fIlocale\fR if the \fIlocale\fR is given.
If the option \fIlocale\fR is not given, the package is set to package private locale mode, but no locale is changed (e.g. if the global locale was valid for the package before, it is copied to the package private locale).
.PP
.RS
This command may cause the load of locales.
.RE
.TP
\fB::msgcat::mcpackagelocale get\fR
.
Return the package private locale or the global locale, if no package private locale is set.
.TP
\fB::msgcat::mcpackagelocale preferences\fR ?\fIlocale preference\fR? ...
.
With no parameters, return the package private preferences or the global preferences,
if no package private locale is set.
The package locale state (set or not) is not changed (in contrast to the command \fB::msgcat::mcpackagelocale set\fR).
.PP
.RS
.VS "TIP 499"
If a set of locale preferences is given, it is set as package locale preference list.
The package locale is set to the first element of the preference list.
A package locale is activated, if it was not set so far.
.PP
Locale preferences are loaded now for the package, if not jet loaded.
.VE "TIP 499"
.RE
.PP
.TP
\fB::msgcat::mcpackagelocale loaded\fR
.
Return the list of locales loaded for this package.
.TP
\fB::msgcat::mcpackagelocale isset\fR
.
Returns true, if a package private locale is set.
.TP
\fB::msgcat::mcpackagelocale unset\fR
.
Unset the package private locale and use the globale locale.
Load and remove locales to adjust the list of loaded locales for the
package to the global loaded locales list.
.TP
\fB::msgcat::mcpackagelocale present\fR \fIlocale\fR
.
Returns true, if the given locale is loaded for the package.
.TP
\fB::msgcat::mcpackagelocale clear\fR
.
Clear any loaded locales of the package not present in the package preferences.
.PP
.SH "CHANGING PACKAGE OPTIONS"
.PP
Each package using msgcat has a set of options within \fBmsgcat\fR.
The package options are described in the next sectionPackage options.
Each package option may be set or unset individually using the following ensemble:
.TP
\fB::msgcat::mcpackageconfig get\fR \fIoption\fR
.
Return the current value of the given \fIoption\fR.
This call returns an error if the option is not set for the package.
.TP
\fB::msgcat::mcpackageconfig isset\fR \fIoption\fR
.
Returns 1, if the given \fIoption\fR is set for the package, 0 otherwise.
.TP
\fB::msgcat::mcpackageconfig set\fR \fIoption\fR \fIvalue\fR
.
Set the given \fIoption\fR to the given \fIvalue\fR.
This may invoke additional actions in dependency of the \fIoption\fR.
The return value is 0 or the number of loaded packages for the option \fBmcfolder\fR.
.TP
\fB::msgcat::mcpackageconfig unset\fR \fIoption\fR
.
Unsets the given \fIoption\fR for the package.
No action is taken if the \fIoption\fR is not set for the package.
The empty string is returned.
.SS Package options
.PP
The following package options are available for each package:
.TP
\fBmcfolder\fR
.
This is the message folder of the package. This option is set by mcload and by the subcommand set. Both are identical and both return the number of loaded message catalog files.
.RS
.PP
Setting or changing this value will load all locales contained in the preferences valid for the package. This implies also to invoke any set loadcmd (see below).
.PP
Unsetting this value will disable message file load for the package.
.RE
.TP
\fBloadcmd\fR
.
This callback is invoked before a set of message catalog files are loaded for the package which has this property set.
.PP
.RS
This callback may be used to do any preparation work for message file load or to get the message data from another source like a data base. In this case, no message files are used (mcfolder is unset).
.PP
See section \fBcallback invocation\fR below.
The parameter list appended to this callback is the list of locales to load.
.PP
If this callback is changed, it is called with the preferences valid for the package.
.RE
.TP
\fBchangecmd\fR
.
This callback is invoked when a default local change was performed. Its purpose is to allow a package to update any dependency on the default locale like showing the GUI in another language.
.PP
.RS
See the callback invocation section below.
The parameter list appended to this callback is \fBmcpreferences\fR.
The registered callbacks are invoked in no particular order.
.RE
.TP
\fBunknowncmd\fR
.
Use a package locale mcunknown procedure instead of the standard version supplied by the msgcat package (msgcat::mcunknown).
.PP
.RS
The called procedure must return the formatted message which will finally be returned by msgcat::mc.
.PP
A generic unknown handler is used if set to the empty string. This consists in returning the key if no arguments are given. With given arguments, format is used to process the arguments.
.PP
See section \fBcallback invocation\fR below.
The appended arguments are identical to \fB::msgcat::mcunknown\fR.
.RE
.SH "Callback invocation"
A package may decide to register one or multiple callbacks, as described above.
.PP
Callbacks are invoked, if:
.PP
1. the callback command is set,
.PP
2. the command is not the empty string,
.PP
3. the registering namespace exists.
.PP
If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion.
Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error.
.PP
.VS tip490
.SH "OBJECT ORIENTED PROGRAMMING"
\fBmsgcat\fR supports packages implemented by object oriented programming.
Objects and classes should be defined within a package namespace.
.PP
There are 3 supported cases where package namespace sensitive commands of msgcat (\fBmc\fR, \fBmcexists\fR, \fBmcpackagelocale\fR, \fBmcforgetpackage\fR, \fBmcpackagenamespaceget\fR, \fBmcpackageconfig\fR, \fBmcset\fR and \fBmcmset\fR) may be called:
.PP
.TP
\fB1) In class definition script\fR
.
\fBmsgcat\fR command is called within a class definition script.
.CS
namespace eval ::N2 {
    mcload $dir/msgs
    oo::class create C1 {puts [mc Hi!]}
}
.CE
.PP
.TP
\fB2) method defined in a class\fR
.
\fBmsgcat\fR command is called from a method in an object and the method is defined in a class.
.CS
namespace eval ::N3Class {
    mcload $dir/msgs
    oo::class create C1
    oo::define C1 method m1 {
        puts [mc Hi!]
    }
}
.CE
.PP
.TP
\fB3) method defined in a classless object\fR
.
\fBmsgcat\fR command is called from a method of a classless object.
.CS
namespace eval ::N4 {
    mcload $dir/msgs
    oo::object create O1
    oo::objdefine O1 method m1 {} {
        puts [mc Hi!]
    }
}
.CE
.PP
.VE tip490
.SH EXAMPLES
Packages which display a GUI may update their widgets when the global locale changes.
To register to a callback, use:
.CS
namespace eval gui {
    msgcat::mcpackageconfig changecmd updateGUI

    proc updateGui args {
        puts "New locale is '[lindex $args 0]'."
    }
}
% msgcat::mclocale fr
fr
% New locale is 'fr'.
.CE
.PP
If locales (or additional locales) are contained in another source like a data base, a package may use the load callback and not mcload:
.CS
namespace eval db {
    msgcat::mcpackageconfig loadcmd loadMessages

    proc loadMessages args {
        foreach locale $args {
            if {[LocaleInDB $locale]} {
                msgcat::mcmset $locale [GetLocaleList $locale]
            }
        }
    }
}
.CE
.PP
The \fBclock\fR command implementation uses \fBmsgcat\fR with a package locale to implement the command line parameter \fB-locale\fR.
Here are some sketches of the implementation:
.PP
First, a package locale is initialized and the generic unknown function is desactivated:
.CS
msgcat::mcpackagelocale set
msgcat::mcpackageconfig unknowncmd ""
.CE
As an example, the user requires the week day in a certain locale as follows:
.CS
clock format clock seconds -format %A -locale fr
.CE
\fBclock\fR sets the package locale to \fBfr\fR and looks for the day name as follows:
.CS
msgcat::mcpackagelocale set $locale
return [lindex [msgcat::mc DAYS_OF_WEEK_FULL] $day]
### Returns "mercredi"
.CE
Within \fBclock\fR, some message-catalog items are heavy in computation and thus are dynamically cached using:
.CS
proc ::tcl::clock::LocalizeFormat { locale format } {
    set key FORMAT_$format
    if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
        return [mc $key]
    }
    #...expensive computation of format clipped...
    mcset $locale $key $format
    return $format
}
.CE
.VE "TIP 412"
.SH CREDITS
.PP
The message catalog code was developed by Mark Harrison.
.SH "SEE ALSO"
format(n), scan(n), namespace(n), package(n), oo::class(n), oo::object
format(n), scan(n), namespace(n), package(n)
.SH KEYWORDS
internationalization, i18n, localization, l10n, message, text, translation, class, object
internationalization, i18n, localization, l10n, message, text, translation
.\" Local Variables:
.\" mode: nroff
.\" End:

Deleted doc/my.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
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



































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH my n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
my, myclass \- invoke any method of current object or its class
.SH SYNOPSIS
.nf
package require TclOO

\fBmy\fI methodName\fR ?\fIarg ...\fR?
\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP
The \fBmy\fR command is used to allow methods of objects to invoke methods
of the object (or its class),
.VS TIP478
and the \fBmyclass\fR command is used to allow methods of objects to invoke
methods of the current class of the object \fIas an object\fR.
.VE TIP478
In particular, the set of valid values for
\fImethodName\fR is the set of all methods supported by an object and its
superclasses, including those that are not exported
.VS TIP500
and private methods of the object or class when used within another method
defined by that object or class.
.VE TIP500
.PP
The object upon which the method is invoked via \fBmy\fR is the one that owns
the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
remains if the command is renamed), which is the currently invoked object by
default.
.VS TIP478
Similarly, the object on which the method is invoked via \fBmyclass\fR is the
object that is the current class of the object that owns the namespace that
the \fBmyclass\fR command is contained in initially. As with \fBmy\fR, the
link remains even if the command is renamed into another namespace, and
defaults to being the manufacturing class of the current object.
.VE TIP478
.PP
Each object has its own \fBmy\fR and \fBmyclass\fR commands, 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
        puts [incr counter]
    }
}

c create o
o count              \fI\(-> prints "1"\fR
o count              \fI\(-> prints "2"\fR
o count              \fI\(-> prints "3"\fR
.CE
.PP
This example shows how you can use \fBmy\fR to make callbacks to private
methods from outside the object (from a \fBtrace\fR), using
\fBnamespace code\fR to enter the correct context. (See the \fBcallback\fR
command for the recommended way of doing this.)
.PP
.CS
oo::class create HasCallback {
    method makeCallback {} {
        return [namespace code {
            \fBmy\fR Callback
        }]
    }

    method Callback {args} {
        puts "callback: $args"
    }
}

set o [HasCallback new]
trace add variable xyz write [$o makeCallback]
set xyz "called"     \fI\(-> prints "callback: xyz {} write"\fR
.CE
.PP
.VS TIP478
This example shows how to access a private method of a class from an instance
of that class. (See the \fBclassmethod\fR declaration in \fBoo::define\fR for
a higher level interface for doing this.)
.PP
.CS
oo::class create CountedSteps {
    self {
        variable count
        method Count {} {
            return [incr count]
        }
    }
    method advanceTwice {} {
        puts "in [self] step A: [\fBmyclass\fR Count]"
        puts "in [self] step B: [\fBmyclass\fR Count]"
    }
}

CountedSteps create x
CountedSteps create y
x advanceTwice       \fI\(-> prints "in ::x step A: 1"\fR
                     \fI\(-> prints "in ::x step B: 2"\fR
y advanceTwice       \fI\(-> prints "in ::y step A: 3"\fR
                     \fI\(-> prints "in ::y step B: 4"\fR
x advanceTwice       \fI\(-> prints "in ::x step A: 5"\fR
                     \fI\(-> prints "in ::x step B: 6"\fR
y advanceTwice       \fI\(-> prints "in ::y step A: 7"\fR
                     \fI\(-> prints "in ::y step B: 8"\fR
.CE
.VE TIP478
.SH "SEE ALSO"
next(n), oo::object(n), self(n)
.SH KEYWORDS
method, method visibility, object, private method, public method
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/namespace.n.

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
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







-















-







separate contexts for commands and variables.
See the section \fBWHAT IS A NAMESPACE?\fR below
for a brief overview of namespaces.
The legal values of \fIsubcommand\fR are listed below.
Note that you can abbreviate the \fIsubcommand\fRs.
.TP
\fBnamespace children \fR?\fInamespace\fR? ?\fIpattern\fR?
.
Returns a list of all child namespaces that belong to the
namespace \fInamespace\fR.
If \fInamespace\fR is not specified,
then the children are returned for the current namespace.
This command returns fully-qualified names,
which start with a double colon (\fB::\fR).
If the optional \fIpattern\fR is given,
then this command returns only the names that match the glob-style pattern.
The actual pattern used is determined as follows:
a pattern that starts with double colon (\fB::\fR) is used directly,
otherwise the namespace \fInamespace\fR
(or the fully-qualified name of the current namespace)
is prepended onto the pattern.
.TP
\fBnamespace code \fIscript\fR
.
Captures the current namespace context for later execution
of the script \fIscript\fR.
It returns a new script in which \fIscript\fR has been wrapped
in a \fBnamespace inscope\fR command.
The new script has two important properties.
First, it can be evaluated in any namespace and will cause
\fIscript\fR to be evaluated in the current namespace
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
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







-








-











-
+



+


-















-



-
+
-




















-







in the global namespace.
A scoped command captures a command together with its namespace context
in a way that allows it to be executed properly later.
See the section \fBSCOPED SCRIPTS\fR for some examples
of how this is used to create callback scripts.
.TP
\fBnamespace current\fR
.
Returns the fully-qualified name for the current namespace.
The actual name of the global namespace is
.MT
(i.e., an empty string),
but this command returns \fB::\fR for the global namespace
as a convenience to programmers.
.TP
\fBnamespace delete \fR?\fInamespace namespace ...\fR?
.
Each namespace \fInamespace\fR is deleted
and all variables, procedures, and child namespaces
contained in the namespace are deleted.
If a procedure is currently executing inside the namespace,
the namespace will be kept alive until the procedure returns;
however, the namespace is marked to prevent other code from
looking it up by name.
If a namespace does not exist, this command returns an error.
If no namespace names are given, this command does nothing.
.TP
\fBnamespace ensemble\fR \fIsubcommand\fR ?\fIarg ...\fR?
.
.VS 8.5
Creates and manipulates a command that is formed out of an ensemble of
subcommands.  See the section \fBENSEMBLES\fR below for further
details.
.VE 8.5
.TP
\fBnamespace eval\fR \fInamespace arg\fR ?\fIarg ...\fR?
.
Activates a namespace called \fInamespace\fR and evaluates some code
in that context.
If the namespace does not already exist, it is created.
If more than one \fIarg\fR argument is specified,
the arguments are concatenated together with a space between each one
in the same fashion as the \fBeval\fR command,
and the result is evaluated.
.RS
.PP
If \fInamespace\fR has leading namespace qualifiers
and any leading namespaces do not exist,
they are automatically created.
.RE
.TP
\fBnamespace exists\fR \fInamespace\fR
.
Returns \fB1\fR if \fInamespace\fR is a valid namespace in the current
context, returns \fB0\fR otherwise.
.TP
\fBnamespace export \fR?\fB\-clear\fR? ?\fIpattern pattern ...\fR?
\fBnamespace export \fR?\-\fBclear\fR? ?\fIpattern pattern ...\fR?
.
Specifies which commands are exported from a namespace.
The exported commands are those that can be later imported
into another namespace using a \fBnamespace import\fR command.
Both commands defined in a namespace and
commands the namespace has previously imported
can be exported by a namespace.
The commands do not have to be defined
at the time the \fBnamespace export\fR command is executed.
Each \fIpattern\fR may contain glob-style special characters,
but it may not include any namespace qualifiers.
That is, the pattern can only specify commands
in the current (exporting) namespace.
Each \fIpattern\fR is appended onto the namespace's list of export patterns.
If the \fB\-clear\fR flag is given,
the namespace's export pattern list is reset to empty before any
\fIpattern\fR arguments are appended.
If no \fIpattern\fRs are given and the \fB\-clear\fR flag is not given,
this command returns the namespace's current export list.
.TP
\fBnamespace forget \fR?\fIpattern pattern ...\fR?
.
Removes previously imported commands from a namespace.
Each \fIpattern\fR is a simple or qualified name such as
\fBx\fR, \fBfoo::x\fR or \fBa::b::p*\fR.
Qualified names contain double colons (\fB::\fR) and qualify a name
with the name of one or more namespaces.
Each
.QW "qualified pattern"
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
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







-
+








-
+
-







-
-
-
-
-








-
+








-


-














-

-



-





-














-






+
-
+






+


-











-









-
+
-
-
+









-


-
-
+







-
+
-







this command first finds the matching exported commands.
It then checks whether any of those commands
were previously imported by the current namespace.
If so, this command deletes the corresponding imported commands.
In effect, this un-does the action of a \fBnamespace import\fR command.
.TP
\fBnamespace import \fR?\fB\-force\fR? ?\fIpattern\fR \fIpattern ...\fR?
.
.VS 8.5
Imports commands into a namespace, or queries the set of imported
commands in a namespace.  When no arguments are present,
\fBnamespace import\fR returns the list of commands in
the current namespace that have been imported from other
namespaces.  The commands in the returned list are in
the format of simple names, with no namespace qualifiers at all.
This format is suitable for composition with \fBnamespace forget\fR
(see \fBEXAMPLES\fR below).
.RS
.VE 8.5
.PP
When \fIpattern\fR arguments are present,
each \fIpattern\fR is a qualified name like
\fBfoo::x\fR or \fBa::p*\fR.
That is, it includes the name of an exporting namespace
and may have glob-style special characters in the command name
at the end of the qualified name.
Glob characters may not appear in a namespace name.
When the namespace name is not fully qualified (i.e., does not start
with a namespace separator) it is resolved as a namespace name in the
way described in the \fBNAME RESOLUTION\fR section; it is an error if
no namespace with that name can be found.
.PP
All the commands that match a \fIpattern\fR string
and which are currently exported from their namespace
are added to the current namespace.
This is done by creating a new command in the current namespace
that points to the exported command in its original namespace;
when the new imported command is called, it invokes the exported command.
This command normally returns an error
if an imported command conflicts with an existing command.
However, if the \fB\-force\fR option is given,
However, if the \-\fBforce\fR option is given,
imported commands will silently replace existing commands.
The \fBnamespace import\fR command has snapshot semantics:
that is, only requested commands that are currently defined
in the exporting namespace are imported.
In other words, you can import only the commands that are in a namespace
at the time when the \fBnamespace import\fR command is executed.
If another command is defined and exported in this namespace later on,
it will not be imported.
.RE
.TP
\fBnamespace inscope\fR \fInamespace\fR \fIscript\fR ?\fIarg ...\fR?
.
Executes a script in the context of the specified \fInamespace\fR.
This command is not expected to be used directly by programmers;
calls to it are generated implicitly when applications
use \fBnamespace code\fR commands to create callback scripts
that the applications then register with, e.g., Tk widgets.
The \fBnamespace inscope\fR command is much like the \fBnamespace eval\fR
command except that the \fInamespace\fR must already exist,
and \fBnamespace inscope\fR appends additional \fIarg\fRs
as proper list elements.
.RS
.PP
.CS
\fBnamespace inscope ::foo $script $x $y $z\fR
.CE
.PP
is equivalent to
.PP
.CS
\fBnamespace eval ::foo [concat $script [list $x $y $z]]\fR
.CE
.PP
thus additional arguments will not undergo a second round of substitution,
as is the case with \fBnamespace eval\fR.
.RE
.TP
\fBnamespace origin \fIcommand\fR
.
Returns the fully-qualified name of the original command
to which the imported command \fIcommand\fR refers.
When a command is imported into a namespace,
a new command is created in that namespace
that points to the actual command in the exporting namespace.
If a command is imported into a sequence of namespaces
\fIa, b,...,n\fR where each successive namespace
just imports the command from the previous namespace,
this command returns the fully-qualified name of the original command
in the first namespace, \fIa\fR.
If \fIcommand\fR does not refer to an imported command,
the command's own fully-qualified name is returned.
.TP
\fBnamespace parent\fR ?\fInamespace\fR?
.
Returns the fully-qualified name of the parent namespace
for namespace \fInamespace\fR.
If \fInamespace\fR is not specified,
the fully-qualified name of the current namespace's parent is returned.
.TP
\fBnamespace path\fR ?\fInamespaceList\fR?
.\" Should really have the .TP inside the .VS, but that triggers a groff bug
.
.VS 8.5
Returns the command resolution path of the current namespace. If
\fInamespaceList\fR is specified as a list of named namespaces, the
current namespace's command resolution path is set to those namespaces
and returns the empty list. The default command resolution path is
always empty. See the section \fBNAME RESOLUTION\fR below for an
explanation of the rules regarding name resolution.
.VE 8.5
.TP
\fBnamespace qualifiers\fR \fIstring\fR
.
Returns any leading namespace qualifiers for \fIstring\fR.
Qualifiers are namespace names separated by double colons (\fB::\fR).
For the \fIstring\fR \fB::foo::bar::x\fR,
this command returns \fB::foo::bar\fR,
and for \fB::\fR it returns an empty string.
This command is the complement of the \fBnamespace tail\fR command.
Note that it does not check whether the
namespace names are, in fact,
the names of currently defined namespaces.
.TP
\fBnamespace tail\fR \fIstring\fR
.
Returns the simple name at the end of a qualified string.
Qualifiers are namespace names separated by double colons (\fB::\fR).
For the \fIstring\fR \fB::foo::bar::x\fR,
this command returns \fBx\fR,
and for \fB::\fR it returns an empty string.
This command is the complement of the \fBnamespace qualifiers\fR command.
It does not check whether the namespace names are, in fact,
the names of currently defined namespaces.
.TP
\fBnamespace upvar\fR \fInamespace\fR ?\fIotherVar myVar \fR...?
\fBnamespace upvar\fR \fInamespace\fR \fIotherVar myVar \fR?\fIotherVar myVar \fR...
.
This command arranges for zero or more local variables in the current
This command arranges for one or more local variables in the current
procedure to refer to variables in \fInamespace\fR. The namespace name is
resolved as described in section \fBNAME RESOLUTION\fR.
The command
\fBnamespace upvar $ns a b\fR has the same behaviour as
\fBupvar 0 ${ns}::a b\fR, with the sole exception of the resolution rules
used for qualified namespace or variable names.
\fBnamespace upvar\fR returns an empty string.
.TP
\fBnamespace unknown\fR ?\fIscript\fR?
.
Sets or returns the unknown command handler for the current namespace.
The handler is invoked when a command called from within the namespace
cannot be found in the current namespace, the namespace's path nor in
the global namespace.
cannot be found (in either the current namespace or the global namespace).
The \fIscript\fR argument, if given, should be a well
formed list representing a command name and optional arguments. When
the handler is invoked, the full invocation line will be appended to the
script and the result evaluated in the context of the namespace. The
default handler for all namespaces is \fB::unknown\fR. If no argument
is given, it returns the handler for the current namespace.
.TP
\fBnamespace which\fR ?\fB\-command\fR? ?\fB\-variable\fR? \fIname\fR
\fBnamespace which\fR ?\-\fBcommand\fR? ?\-\fBvariable\fR? \fIname\fR
.
Looks up \fIname\fR as either a command or variable
and returns its fully-qualified name.
For example, if \fIname\fR does not exist in the current namespace
but does exist in the global namespace,
this command returns a fully-qualified name in the global namespace.
If the command or variable does not exist,
this command returns an empty string.  If the variable has been
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
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







-


-
-
+
+

-
-
-
-
+
+
+
+


-



















-


-
-
-
-
-
+
+
+
+
+


-
-
-
+
+
+


-
+


-







It encapsulates the commands and variables to ensure that they
will not interfere with the commands and variables of other namespaces.
Tcl has always had one such collection,
which we refer to as the \fIglobal namespace\fR.
The global namespace holds all global variables and commands.
The \fBnamespace eval\fR command lets you create new namespaces.
For example,
.PP
.CS
\fBnamespace eval\fR Counter {
    \fBnamespace export\fR bump
    variable num 0
   \fBnamespace export\fR bump
   variable num 0

    proc bump {} {
        variable num
        incr num
    }
   proc bump {} {
      variable num
      incr num
   }
}
.CE
.PP
creates a new namespace containing the variable \fBnum\fR and
the procedure \fBbump\fR.
The commands and variables in this namespace are separate from
other commands and variables in the same program.
If there is a command named \fBbump\fR in the global namespace,
for example, it will be different from the command \fBbump\fR
in the \fBCounter\fR namespace.
.PP
Namespace variables resemble global variables in Tcl.
They exist outside of the procedures in a namespace
but can be accessed in a procedure via the \fBvariable\fR command,
as shown in the example above.
.PP
Namespaces are dynamic.
You can add and delete commands and variables at any time,
so you can build up the contents of a
namespace over time using a series of \fBnamespace eval\fR commands.
For example, the following series of commands has the same effect
as the namespace definition shown above:
.PP
.CS
\fBnamespace eval\fR Counter {
    variable num 0
    proc bump {} {
        variable num
        return [incr num]
    }
   variable num 0
   proc bump {} {
      variable num
      return [incr num]
   }
}
\fBnamespace eval\fR Counter {
    proc test {args} {
        return $args
    }
   proc test {args} {
      return $args
   }
}
\fBnamespace eval\fR Counter {
     rename test ""
    rename test ""
}
.CE
.PP
Note that the \fBtest\fR procedure is added to the \fBCounter\fR namespace,
and later removed via the \fBrename\fR command.
.PP
Namespaces can have other namespaces within them,
so they nest hierarchically.
A nested namespace is encapsulated inside its parent namespace
and can not interfere with other namespaces.
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
457
458
459
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







-




-

-



-





-







-



-

-







which in turn is a child of the global namespace, \fB::\fR.
.PP
If you want to access commands and variables from another namespace,
you must use some extra syntax.
Names must be qualified by the namespace that contains them.
From the global namespace,
we might access the \fBCounter\fR procedures like this:
.PP
.CS
Counter::bump 5
Counter::Reset
.CE
.PP
We could access the current count like this:
.PP
.CS
puts "count = $Counter::num"
.CE
.PP
When one namespace contains another, you may need more than one
qualifier to reach its elements.
If we had a namespace \fBFoo\fR that contained the namespace \fBCounter\fR,
you could invoke its \fBbump\fR procedure
from the global namespace like this:
.PP
.CS
Foo::Counter::bump 3
.CE
.PP
You can also use qualified names when you create and rename commands.
For example, you could add a procedure to the \fBFoo\fR
namespace like this:
.PP
.CS
proc Foo::Test {args} {return $args}
.CE
.PP
And you could move the same procedure to another namespace like this:
.PP
.CS
rename Foo::Test Bar::Test
.CE
.PP
There are a few remaining points about qualified names
that we should cover.
Namespaces have nonempty names except for the global namespace.
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
545
546
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







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


-



-
+


-






-



-
+

-
-
-
+
+
+


-









-



-


-



-







\fBset\fR, \fBproc\fR, \fBrename\fR, and \fBinterp alias\fR.
If you provide a fully-qualified name that starts with a \fB::\fR,
there is no question about what command, variable, or namespace
you mean.
However, if the name does not start with a \fB::\fR
(i.e., is \fIrelative\fR),
Tcl follows basic rules for looking it up:
.IP \(bu
\fBVariable names\fR are always resolved by looking first in the current
namespace, and then in the global namespace.
.IP \(bu
\fBCommand names\fR are always resolved by looking in the current namespace
first. If not found there, they are searched for in every namespace on the
current namespace's command path (which is empty by default). If not found
there, command names are looked up in the global namespace (or, failing that,
are processed by the appropriate \fBnamespace unknown\fR handler.)
.IP \(bu
\fBNamespace names\fR are always resolved by looking in only the current
namespace.
Variable names are always resolved
by looking first in the current namespace,
and then in the global namespace.
.VS 8.5
Command names are also always resolved by looking in the current
namespace first. If not found there, they are searched for in every
namespace on the current namespace's command path (which is empty by
default). If not found there, command names are looked up in the
global namespace (or, failing that, are processed by the \fBunknown\fR
command.)
.VE 8.5
Namespace names, on the other hand, are always resolved
by looking in only the current namespace.
.PP
In the following example,
.PP
.CS
set traceLevel 0
\fBnamespace eval\fR Debug {
    printTrace $traceLevel
   printTrace $traceLevel
}
.CE
.PP
Tcl looks for \fBtraceLevel\fR in the namespace \fBDebug\fR
and then in the global namespace.
It looks up the command \fBprintTrace\fR in the same way.
If a variable or command name is not found in either context,
the name is undefined.
To make this point absolutely clear, consider the following example:
.PP
.CS
set traceLevel 0
\fBnamespace eval\fR Foo {
    variable traceLevel 3
   variable traceLevel 3

    \fBnamespace eval\fR Debug {
        printTrace $traceLevel
    }
   \fBnamespace eval\fR Debug {
      printTrace $traceLevel
   }
}
.CE
.PP
Here Tcl looks for \fBtraceLevel\fR first in the namespace \fBFoo::Debug\fR.
Since it is not found there, Tcl then looks for it
in the global namespace.
The variable \fBFoo::traceLevel\fR is completely ignored
during the name resolution process.
.PP
You can use the \fBnamespace which\fR command to clear up any question
about name resolution.
For example, the command:
.PP
.CS
\fBnamespace eval\fR Foo::Debug {\fBnamespace which\fR \-variable traceLevel}
.CE
.PP
returns \fB::traceLevel\fR.
On the other hand, the command,
.PP
.CS
\fBnamespace eval\fR Foo {\fBnamespace which\fR \-variable traceLevel}
.CE
.PP
returns \fB::Foo::traceLevel\fR.
.PP
As mentioned above,
namespace names are looked up differently
than the names of variables and commands.
Namespace names are always resolved in the current namespace.
This means, for example,
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
618
619
620
621
622
623
624
625
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
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
756
757
758
759
760
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
611
612
613
614
615
616

617
618
619

620
621
622

623
624
625
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
686
687
688
689
690

691
692
693
694
695
696
697







-




-




-



-


-




-








-



-










-



-


-



-






-



-



-


-
-
-
+
+
+

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


-



-



-




















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











+













-










-






-







.PP
Namespaces are often used to represent libraries.
Some library commands are used so frequently
that it is a nuisance to type their qualified names.
For example, suppose that all of the commands in a package
like BLT are contained in a namespace called \fBBlt\fR.
Then you might access these commands like this:
.PP
.CS
Blt::graph .g \-background red
Blt::table . .g 0,0
.CE
.PP
If you use the \fBgraph\fR and \fBtable\fR commands frequently,
you may want to access them without the \fBBlt::\fR prefix.
You can do this by importing the commands into the current namespace,
like this:
.PP
.CS
\fBnamespace import\fR Blt::*
.CE
.PP
This adds all exported commands from the \fBBlt\fR namespace
into the current namespace context, so you can write code like this:
.PP
.CS
graph .g \-background red
table . .g 0,0
.CE
.PP
The \fBnamespace import\fR command only imports commands
from a namespace that that namespace exported
with a \fBnamespace export\fR command.
.PP
Importing \fIevery\fR command from a namespace is generally
a bad idea since you do not know what you will get.
It is better to import just the specific commands you need.
For example, the command
.PP
.CS
\fBnamespace import\fR Blt::graph Blt::table
.CE
.PP
imports only the \fBgraph\fR and \fBtable\fR commands into the
current context.
.PP
If you try to import a command that already exists, you will get an
error.  This prevents you from importing the same command from two
different packages.  But from time to time (perhaps when debugging),
you may want to get around this restriction.  You may want to
reissue the \fBnamespace import\fR command to pick up new commands
that have appeared in a namespace.  In that case, you can use the
\fB\-force\fR option, and existing commands will be silently overwritten:
.PP
.CS
\fBnamespace import\fR \-force Blt::graph Blt::table
.CE
.PP
If for some reason, you want to stop using the imported commands,
you can remove them with a \fBnamespace forget\fR command, like this:
.PP
.CS
\fBnamespace forget\fR Blt::*
.CE
.PP
This searches the current namespace for any commands imported from \fBBlt\fR.
If it finds any, it removes them.  Otherwise, it does nothing.
After this, the \fBBlt\fR commands must be accessed with the \fBBlt::\fR
prefix.
.PP
When you delete a command from the exporting namespace like this:
.PP
.CS
rename Blt::graph ""
.CE
.PP
the command is automatically removed from all namespaces that import it.
.SH "EXPORTING COMMANDS"
You can export commands from a namespace like this:
.PP
.CS
\fBnamespace eval\fR Counter {
    \fBnamespace export\fR bump reset
    variable Num 0
    variable Max 100
   \fBnamespace export\fR bump reset
   variable Num 0
   variable Max 100

    proc bump {{by 1}} {
        variable Num
        incr Num $by
        Check
        return $Num
    }
    proc reset {} {
        variable Num
        set Num 0
    }
    proc Check {} {
        variable Num
        variable Max
        if {$Num > $Max} {
            error "too high!"
        }
    }
   proc bump {{by 1}} {
      variable Num
      incr Num $by
      Check
      return $Num
   }
   proc reset {} {
      variable Num
      set Num 0
   }
   proc Check {} {
      variable Num
      variable Max
      if {$Num > $Max} {
         error "too high!"
      }
   }
}
.CE
.PP
The procedures \fBbump\fR and \fBreset\fR are exported,
so they are included when you import from the \fBCounter\fR namespace,
like this:
.PP
.CS
\fBnamespace import\fR Counter::*
.CE
.PP
However, the \fBCheck\fR procedure is not exported,
so it is ignored by the import operation.
.PP
The \fBnamespace import\fR command only imports commands
that were declared as exported by their namespace.
The \fBnamespace export\fR command specifies what commands
may be imported by other namespaces.
If a \fBnamespace import\fR command specifies a command
that is not exported, the command is not imported.
.SH "SCOPED SCRIPTS"
.PP
The \fBnamespace code\fR command is the means by which a script may be
packaged for evaluation in a namespace other than the one in which it
was created.  It is used most often to create event handlers, Tk bindings,
and traces for evaluation in the global context.  For instance, the following
code indicates how to direct a variable \fBtrace\fR callback into the current
namespace:
.PP
.CS
\fBnamespace eval\fR a {
    variable b
    proc theTraceCallback { n1 n2 op } {
        upvar 1 $n1 var
        puts "the value of $n1 has changed to $var"
        return
    }
    trace add variable b write [\fBnamespace code\fR theTraceCallback]
   variable b
   proc theTraceCallback { n1 n2 op } {
      upvar 1 $n1 var
      puts "the value of $n1 has changed to $var"
      return
   }
   trace add variable b write [\fBnamespace code\fR theTraceCallback]
}
set a::b c
.CE
.PP
When executed, it prints the message:
.PP
.CS
the value of a::b has changed to c
.CE
.SH ENSEMBLES
.PP
.VS 8.5
The \fBnamespace ensemble\fR is used to create and manipulate ensemble
commands, which are commands formed by grouping subcommands together.
The commands typically come from the current namespace when the
ensemble was created, though this is configurable.  Note that there
may be any number of ensembles associated with any namespace
(including none, which is true of all namespaces by default), though
all the ensembles associated with a namespace are deleted when that
namespace is deleted.  The link between an ensemble command and its
namespace is maintained however the ensemble is renamed.
.PP
Three subcommands of the \fBnamespace ensemble\fR command are defined:
.TP
\fBnamespace ensemble create\fR ?\fIoption value ...\fR?
.
Creates a new ensemble command linked to the current namespace,
returning the fully qualified name of the command created.  The
arguments to \fBnamespace ensemble create\fR allow the configuration
of the command as if with the \fBnamespace ensemble configure\fR
command.  If not overridden with the \fB\-command\fR option, this
command creates an ensemble with exactly the same name as the linked
namespace.  See the section \fBENSEMBLE OPTIONS\fR below for a full
list of options supported and their effects.
.TP
\fBnamespace ensemble configure \fIcommand\fR ?\fIoption\fR? ?\fIvalue ...\fR?
.
Retrieves the value of an option associated with the ensemble command
named \fIcommand\fR, or updates some options associated with that
ensemble command.  See the section \fBENSEMBLE OPTIONS\fR below for a
full list of options supported and their effects.
.TP
\fBnamespace ensemble exists\fR \fIcommand\fR
.
Returns a boolean value that describes whether the command
\fIcommand\fR exists and is an ensemble command.  This command only
ever returns an error if the number of arguments to the command is
wrong.
.PP
When called, an ensemble command takes its first argument and looks it
up (according to the rules described below) to discover a list of
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
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







-













-
-
-
-
-
-

-






-










-













-










-







.SS "ENSEMBLE OPTIONS"
.PP
The following options, supported by the \fBnamespace ensemble
create\fR and \fBnamespace ensemble configure\fR commands, control how
an ensemble command behaves:
.TP
\fB\-map\fR
.
When non-empty, this option supplies a dictionary that provides a
mapping from subcommand names to a list of prefix words to substitute
in place of the ensemble command and subcommand words (in a manner
similar to an alias created with \fBinterp alias\fR; the words are not
reparsed after substitution); if the first word of any target is not
fully qualified when set, it is assumed to be relative to the
\fIcurrent\fR namespace and changed to be exactly that (that is, it is
always fully qualified when read). When this option is empty, the mapping
will be from the local name of the subcommand to its fully-qualified
name.  Note that when this option is non-empty and the
\fB\-subcommands\fR option is empty, the ensemble subcommand names
will be exactly those words that have mappings in the dictionary.
.TP
\fB\-parameters\fR
This option gives a list of named arguments (the names being used during
generation of error messages) that are passed by the caller of the ensemble
between the name of the ensemble and the subcommand argument. By default, it
is the empty list.
.TP
\fB\-prefixes\fR
.
This option (which is enabled by default) controls whether the
ensemble command recognizes unambiguous prefixes of its subcommands.
When turned off, the ensemble command requires exact matching of
subcommand names.
.TP
\fB\-subcommands\fR
.
When non-empty, this option lists exactly what subcommands are in the
ensemble.  The mapping for each of those commands will be either whatever
is defined in the \fB\-map\fR option, or to the command with the same
name in the namespace linked to the ensemble.  If this option is
empty, the subcommands of the namespace will either be the keys of the
dictionary listed in the \fB\-map\fR option or the exported commands
of the linked namespace at the time of the invocation of the ensemble
command.
.TP
\fB\-unknown\fR
.
When non-empty, this option provides a partial command (to which all
the words that are arguments to the ensemble command, including the
fully-qualified name of the ensemble, are appended) to handle the case
where an ensemble subcommand is not recognized and would otherwise
generate an error.  When empty (the default) an error (in the style of
\fBTcl_GetIndexFromObj\fR) is generated whenever the ensemble is
unable to determine how to implement a particular subcommand.  See
\fBUNKNOWN HANDLER BEHAVIOUR\fR for more details.
.PP
The following extra option is allowed by \fBnamespace ensemble
create\fR:
.TP
\fB\-command\fR
.
This write-only option allows the name of the ensemble created by
\fBnamespace ensemble create\fR to be anything in any existing
namespace.  The default value for this option is the fully-qualified
name of the namespace in which the \fBnamespace ensemble create\fR
command is invoked.
.PP
The following extra option is allowed by \fBnamespace ensemble
configure\fR:
.TP
\fB\-namespace\fR
.
This read-only option allows the retrieval of the fully-qualified name
of the namespace which the ensemble was created within.
.SS "UNKNOWN HANDLER BEHAVIOUR"
.PP
If an unknown handler is specified for an ensemble, that handler is
called when the ensemble command would otherwise return an error due
to it being unable to decide which subcommand to invoke. The exact
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
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










+


-


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




-






-
-
+
+









-
-
+
+






-





-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
Where an empty \fB\-unknown\fR handler is given (the default), the
ensemble command will generate an error message based on the list of
commands that the ensemble has defined (formatted similarly to the
error message from \fBTcl_GetIndexFromObj\fR). This is the error that
will be thrown when the subcommand is still not recognized during
reparsing. It is also an error for an \fB\-unknown\fR handler to
delete its namespace.
.VE 8.5
.SH EXAMPLES
Create a namespace containing a variable and an exported command:
.PP
.CS
\fBnamespace eval\fR foo {
    variable bar 0
    proc grill {} {
        variable bar
        puts "called [incr bar] times"
    }
    \fBnamespace export\fR grill
   variable bar 0
   proc grill {} {
      variable bar
      puts "called [incr bar] times"
   }
   \fBnamespace export\fR grill
}
.CE
.PP
Call the command defined in the previous example in various ways.
.PP
.CS
# Direct call
::foo::grill

# Use the command resolution path to find the name
\fBnamespace eval\fR boo {
    \fBnamespace path\fR ::foo
    grill
   \fBnamespace path\fR ::foo
   grill
}

# Import into current namespace, then call local alias
\fBnamespace import\fR foo::grill
grill

# Create two ensembles, one with the default name and one with a
# specified name.  Then call through the ensembles.
\fBnamespace eval\fR foo {
    \fBnamespace ensemble\fR create
    \fBnamespace ensemble\fR create -command ::foobar
   \fBnamespace ensemble\fR create
   \fBnamespace ensemble\fR create -command ::foobar
}
foo grill
foobar grill
.CE
.PP
Look up where the command imported in the previous example came from:
.PP
.CS
puts "grill came from [\fBnamespace origin\fR grill]"
.CE
.PP
Remove all imported commands from the current namespace:
.PP
.CS
namespace forget {*}[namespace import]
.CE
.PP
Create an ensemble for simple working with numbers, using the
\fB\-parameters\fR option to allow the operator to be put between the first
and second arguments.
.PP
.CS
\fBnamespace eval\fR do {
    \fBnamespace export\fR *
    \fBnamespace ensemble\fR create -parameters x
    proc plus  {x y} {expr { $x + $y }}
    proc minus {x y} {expr { $x - $y }}
}

# In use, the ensemble works like this:
puts [do 1 plus [do 9 minus 7]]
.CE
.SH "SEE ALSO"
interp(n), upvar(n), variable(n)
.SH KEYWORDS
command, ensemble, exported, internal, variable
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/next.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
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





















































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH next n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
next, nextto \- invoke superclass method implementations
.SH SYNOPSIS
.nf
package require TclOO

\fBnext\fR ?\fIarg ...\fR?
\fBnextto\fI class\fR ?\fIarg ...\fR?
.fi
.BE

.SH DESCRIPTION
.PP
The \fBnext\fR command is used to call implementations of a method by a class,
superclass or mixin that are overridden by the current method. It can only be
used from within a method. It is also used within filters to indicate the
point where a filter calls the actual implementation (the filter may decide to
not go along the chain, and may process the results of going along the chain
of methods as it chooses). The result of the \fBnext\fR command is the result
of the next method in the method chain; if there are no further methods in the
method chain, the result of \fBnext\fR will be an error. The arguments,
\fIarg\fR, to \fBnext\fR are the arguments to pass to the next method in the
chain.
.PP
The \fBnextto\fR command is the same as the \fBnext\fR command, except that it
takes an additional \fIclass\fR argument that identifies a class whose
implementation of the current method chain (see \fBinfo object\fR \fBcall\fR) should
be used; the method implementation selected will be the one provided by the
given class, and it must refer to an existing non-filter invocation that lies
further along the chain than the current implementation.
.SH "THE METHOD CHAIN"
.PP
When a method of an object is invoked, things happen in several stages:
.IP [1]
The structure of the object, its class, superclasses, filters, and mixins, are
examined to build a \fImethod chain\fR, which contains a list of method
implementations to invoke.
.IP [2]
The first method implementation on the chain is invoked.
.IP [3]
If that method implementation invokes the \fBnext\fR command, the next method
implementation is invoked (with its arguments being those that were passed to
\fBnext\fR).
.IP [4]
The result from the overall method call is the result from the outermost
method implementation; inner method implementations return their results
through \fBnext\fR.
.IP [5]
The method chain is cached for future use.
.SS "METHOD SEARCH ORDER"
.PP
When constructing the method chain, method implementations are searched for in
the following order:
.IP [1]
In the classes mixed into the object, in class traversal order. The list of
mixins is checked in natural order.
.IP [2]
In the classes mixed into the classes of the object, with sources of mixing in
being searched in class traversal order. Within each class, the list of mixins
is processed in natural order.
.IP [3]
In the object itself.
.IP [4]
In the object's class.
.IP [5]
In the superclasses of the class, following each superclass in a depth-first
fashion in the natural order of the superclass list.
.PP
Any particular method implementation always comes as \fIlate\fR in the
resulting list of implementations as possible; this means that if some class,
A, is both mixed into a class, B, and is also a superclass of B, the instances
of B will always treat A as a superclass from the perspective of inheritance.
This is true even when the multiple inheritance is processed indirectly.
.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 invoked when processing an invokation of the \fBunknown\fR
method because of a failure to locate a method implementation, but \fInot\fR
when invoking either constructors or destructors. (Note however that the
\fBdestroy\fR method is a conventional method, and filters are invoked as
normal when it is called.)
.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
.CS
oo::class create theSuperclass {
    method example {args} {
        puts "in the superclass, args = $args"
    }
}

oo::class create theSubclass {
    superclass theSuperclass
    method example {args} {
        puts "before chaining from subclass, args = $args"
        \fBnext\fR a {*}$args b
        \fBnext\fR pureSynthesis
        puts "after chaining from subclass"
    }
}

theSubclass create obj
oo::objdefine obj method example args {
    puts "per-object method, args = $args"
    \fBnext\fR x {*}$args y
    \fBnext\fR
}
obj example 1 2 3
.CE
.PP
prints the following:
.PP
.CS
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
.CS
oo::class create cache {
    filter Memoize
    method Memoize args {
        \fI# Do not filter the core method implementations\fR
        if {[lindex [self target] 0] eq "::oo::object"} {
            return [\fBnext\fR {*}$args]
        }

        \fI# Check if the value is already in the cache\fR
        my variable ValueCache
        set key [self target],$args
        if {[info exist ValueCache($key)]} {
            return $ValueCache($key)
        }

        \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::objdefine demo {
    mixin cache

    method compute {a b c} {
        after 3000 \fI;# Simulate deep thought\fR
        return [expr {$a + $b * $c}]
    }

    method compute2 {a b c} {
        after 3000 \fI;# Simulate deep thought\fR
        return [expr {$a * $b + $c}]
    }
}

puts [demo compute  1 2 3]      \fI\(-> prints "7" after delay\fR
puts [demo compute2 4 5 6]      \fI\(-> prints "26" after delay\fR
puts [demo compute  1 2 3]      \fI\(-> prints "7" instantly\fR
puts [demo compute2 4 5 6]      \fI\(-> prints "26" instantly\fR
puts [demo compute  4 5 6]      \fI\(-> prints "34" after delay\fR
puts [demo compute  4 5 6]      \fI\(-> prints "34" instantly\fR
puts [demo compute  1 2 3]      \fI\(-> prints "7" instantly\fR
demo flushCache
puts [demo compute  1 2 3]      \fI\(-> prints "7" after delay\fR
.CE
.SH "SEE ALSO"
oo::class(n), oo::define(n), oo::object(n), self(n)
.SH KEYWORDS
call, method, method chain
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Deleted doc/object.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
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
































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" 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.
'\"
.TH object n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::object \- root class of the class hierarchy
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::object\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
.fi
.BE
.SH DESCRIPTION
.PP
The \fBoo::object\fR class is the root class of the object hierarchy; every
object is an instance of this class. Since classes are themselves objects,
they are instances of this class too. Objects are always referred to by their
name, and may be \fBrename\fRd while maintaining their identity.
.PP
Instances of objects may be made with either the \fBcreate\fR or \fBnew\fR
methods of the \fBoo::object\fR object itself, or by invoking those methods on
any of the subclass objects; see \fBoo::class\fR for more details. The
configuration of individual objects (i.e., instance-specific methods, mixed-in
classes, etc.) may be controlled with the \fBoo::objdefine\fR command.
.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:
.TP
\fIobj \fBdestroy\fR
.
This method destroys the object, \fIobj\fR, that it is invoked upon, invoking
any destructors on the object's class in the process. It is equivalent to
using \fBrename\fR to delete the object command. The result of this method is
always the empty string.
.SS "NON-EXPORTED METHODS"
.PP
The \fBoo::object\fR class supports the following non-exported methods:
.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
oo::objdefine $obj method foo {} {
    my \fBvariable\fR count
    puts "bar[incr count]"
}
$obj foo             \fI\(-> prints "bar1"\fR
$obj foo             \fI\(-> prints "bar2"\fR
$obj variable count  \fI\(-> error "unknown method variable"\fR
$obj \fBdestroy\fR
$obj foo             \fI\(-> error "unknown command obj"\fR
.CE
.SH "SEE ALSO"
my(n), oo::class(n)
.SH KEYWORDS
base class, class, object, root class
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/open.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH open n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
open \- Open a file-based or command pipeline channel
.SH SYNOPSIS
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
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







-




-




-




-




-





-



+



-
-
+
+

+


-
+



-



-



-



-

+


-

+


-




-




-




-









-









-
+







-
+
-
-
+

-
+
-







conventions described in the \fBfilename\fR manual entry.
.PP
The \fIaccess\fR argument, if present, indicates the way in which the file
(or command pipeline) is to be accessed.
In the first form \fIaccess\fR may have any of the following values:
.TP 15
\fBr\fR
.
Open the file for reading only; the file must already exist. This is the
default value if \fIaccess\fR is not specified.
.TP 15
\fBr+\fR
.
Open the file for both reading and writing; the file must
already exist.
.TP 15
\fBw\fR
.
Open the file for writing only.  Truncate it if it exists.  If it does not
exist, create a new file.
.TP 15
\fBw+\fR
.
Open the file for reading and writing.  Truncate it if it exists.
If it does not exist, create a new file.
.TP 15
\fBa\fR
.
Open the file for writing only.  If the file does not exist,
create a new empty file.
Set the file pointer to the end of the file prior to each write.
.TP 15
\fBa+\fR
.
Open the file for reading and writing.  If the file does not exist,
create a new empty file.
Set the initial access position  to the end of the file.
.VS 8.5
.PP
All of the legal \fIaccess\fR values above may have the character
\fBb\fR added as the second or third character in the value to
indicate that the opened channel should be configured as if with the
\fBfconfigure\fR \fB\-translation binary\fR option, making the channel suitable for
indicate that the opened channel should be configured with the
\fB\-translation binary\fR option, making the channel suitable for 
reading or writing of binary data.
.VE 8.5
.PP
In the second form, \fIaccess\fR consists of a list of any of the
following flags, all of which have the standard POSIX meanings.
following flags, most of which have the standard POSIX meanings.
One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR.
.TP 15
\fBRDONLY\fR
.
Open the file for reading only.
.TP 15
\fBWRONLY\fR
.
Open the file for writing only.
.TP 15
\fBRDWR\fR
.
Open the file for both reading and writing.
.TP 15
\fBAPPEND\fR
.
Set the file pointer to the end of the file prior to each write.
.VS 8.5
.TP 15
\fBBINARY\fR
.
Configure the opened channel with the \fB\-translation binary\fR option.
.VE 8.5
.TP 15
\fBCREAT\fR
.
Create the file if it does not already exist (without this flag it
is an error for the file not to exist).
.TP 15
\fBEXCL\fR
.
If \fBCREAT\fR is also specified, an error is returned if the
file already exists.
.TP 15
\fBNOCTTY\fR
.
If the file is a terminal device, this flag prevents the file from
becoming the controlling terminal of the process.
.TP 15
\fBNONBLOCK\fR
.
Prevents the process from blocking while opening the file, and
possibly in subsequent I/O operations.  The exact behavior of
this flag is system- and device-dependent;  its use is discouraged
(it is better to use the \fBfconfigure\fR command to put a file
in nonblocking mode).
For details refer to your system documentation on the \fBopen\fR system
call's \fBO_NONBLOCK\fR flag.
.TP 15
\fBTRUNC\fR
.
If the file exists it is truncated to zero length.
.PP
If a new file is created as part of opening it, \fIpermissions\fR
(an integer) is used to set the permissions for the new file in
conjunction with the process's file mode creation mask.
\fIPermissions\fR defaults to 0666.
.SH "COMMAND PIPELINES"
.PP
If the first character of \fIfileName\fR is
.QW \fB|\fR
.QW |
then the
remaining characters of \fIfileName\fR are treated as a list of arguments
that describe a command pipeline to invoke, in the same style as the
arguments for \fBexec\fR.
In this case, the channel identifier returned by \fBopen\fR may be used
to write to the command's input pipe or read from its output pipe,
depending on the value of \fIaccess\fR.
If write-only access is used (e.g. \fIaccess\fR is
If write-only access is used (e.g. \fIaccess\fR is \fBw\fR), then
.QW \fBw\fR ),
then standard output for the pipeline is directed to the current standard
standard output for the pipeline is directed to the current standard
output unless overridden by the command.
If read-only access is used (e.g. \fIaccess\fR is
If read-only access is used (e.g. \fIaccess\fR is \fBr\fR),
.QW \fBr\fR ),
standard input for the pipeline is taken from the current standard
input unless overridden by the command.
The id of the spawned process is accessible through the \fBpid\fR
command, using the channel id returned by \fBopen\fR as argument.
.PP
If the command (or one of the commands) executed in the command
pipeline returns an error (according to the definition in \fBexec\fR),
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

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
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
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
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
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










-
-
+
+
-


-
















-

















-





-









-












-








-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-










-







-



-
+

-
+









-
+

-
+

-
+



-
+


-
+



-
+


-
+



-
+








-
+






-
+



-

-
+



-




-






-

-
+



-

-
+



-

-
+


-







-

+











+
+
+
+
+
+



-















-
+





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

-
-
-
-
-
-
-
-
-
-
+

-
-
+
-
-
+
+
+











-
-
-
+
+
+
+
+


-
-
-
+
-
-
-
+
+
-
-

-






-
-
-
.SH "SERIAL COMMUNICATIONS"
.PP
If \fIfileName\fR refers to a serial port, then the specified serial port
is opened and initialized in a platform-dependent manner.  Acceptable
values for the \fIfileName\fR to use to open a serial port are described in
the PORTABILITY ISSUES section.
.PP
The \fBchan configure\fR and \fBfconfigure\fR commands can be used to query
and set additional configuration options specific to serial ports (where
The \fBfconfigure\fR command can be used to query and set additional
configuration options specific to serial ports (where supported):
supported):
.TP
\fB\-mode\fR \fIbaud\fB,\fIparity\fB,\fIdata\fB,\fIstop\fR
.
This option is a set of 4 comma-separated values: the baud rate, parity,
number of data bits, and number of stop bits for this serial port.  The
\fIbaud\fR rate is a simple integer that specifies the connection speed.
\fIParity\fR is one of the following letters: \fBn\fR, \fBo\fR, \fBe\fR,
\fBm\fR, \fBs\fR; respectively signifying the parity options of
.QW none ,
.QW odd ,
.QW even ,
.QW mark ,
or
.QW space .
\fIData\fR is the number of
data bits and should be an integer from 5 to 8, while \fIstop\fR is the
number of stop bits and should be the integer 1 or 2.
.TP
\fB\-handshake\fR \fItype\fR
.
(Windows and Unix). This option is used to setup automatic handshake
control. Note that not all handshake types maybe supported by your operating
system. The \fItype\fR parameter is case-independent.
.RS
.PP
If \fItype\fR is \fBnone\fR then any handshake is switched off.
\fBrtscts\fR activates hardware handshake. Hardware handshake signals
are described below.
For software handshake \fBxonxoff\fR the handshake characters can be redefined
with \fB\-xchar\fR.
An additional hardware handshake \fBdtrdsr\fR is available only under Windows.
There is no default handshake configuration, the initial value depends
on your operating system settings.
The \fB\-handshake\fR option cannot be queried.
.RE
.TP
\fB\-queue\fR
.
(Windows and Unix). The \fB\-queue\fR option can only be queried.
It returns a list of two integers representing the current number
of bytes in the input and output queue respectively.
.TP
\fB\-timeout\fR \fImsec\fR
.
(Windows and Unix). This option is used to set the timeout for blocking
read operations. It specifies the maximum interval between the
reception of two bytes in milliseconds.
For Unix systems the granularity is 100 milliseconds.
The \fB\-timeout\fR option does not affect write operations or
nonblocking reads.
This option cannot be queried.
.TP
\fB\-ttycontrol\fR \fI{signal boolean signal boolean ...}\fR
.
(Windows and Unix). This option is used to setup the handshake
output lines (see below) permanently or to send a BREAK over the serial line.
The \fIsignal\fR names are case-independent.
\fB{RTS 1 DTR 0}\fR sets the RTS output to high and the DTR output to low.
The BREAK condition (see below) is enabled and disabled with \fB{BREAK 1}\fR and
\fB{BREAK 0}\fR respectively.
It is not a good idea to change the \fBRTS\fR (or \fBDTR\fR) signal
with active hardware handshake \fBrtscts\fR (or \fBdtrdsr\fR).
The result is unpredictable.
The \fB\-ttycontrol\fR option cannot be queried.
.TP
\fB\-ttystatus\fR
.
(Windows and Unix). The \fB\-ttystatus\fR option can only be
queried.  It returns the current modem status and handshake input signals
(see below).
The result is a list of signal,value pairs with a fixed order,
e.g. \fB{CTS 1 DSR 0 RING 1 DCD 0}\fR.
The \fIsignal\fR names are returned upper case.
.TP
\fB\-xchar\fR \fI{xonChar xoffChar}\fR
.
(Windows and Unix). This option is used to query or change the software
handshake characters. Normally the operating system default should be
DC1 (0x11) and DC3 (0x13) representing the ASCII standard
XON and XOFF characters.
.TP
\fB\-closemode\fR \fIcloseMode\fR
.VS "8.7, TIP 160"
(Windows and Unix). This option is used to query or change the close mode of
the serial channel, which defines how pending output in operating system
buffers is handled when the channel is closed. The following values for
\fIcloseMode\fR are supported:
.RS
.TP
\fBdefault\fR
.
indicates that a system default operation should be used; all serial channels
default to this.
.TP
\fBdiscard\fR
.
indicates that the contents of the OS buffers should be discarded.  Note that
this is \fInot recommended\fR when writing to a POSIX terminal, as it can
interact unexpectedly with handling of \fBstderr\fR.
.TP
\fBdrain\fR
.
indicates that Tcl should wait when closing the channel until all output has
been consumed. This may slow down \fBclose\fR noticeably.
.RE
.VE "8.7, TIP 160"
.TP
\fB\-inputmode\fR \fIinputMode\fR
.VS "8.7, TIP 160"
(Unix only; Windows has the equivalent option on console channels). This
option is used to query or change the input mode of the serial channel under
the assumption that it is talking to a terminal, which controls how interactive
input from users is handled. The following values for \fIinputMode\fR are
supported:
.RS
.TP
\fBnormal\fR
.
indicates that normal line-oriented input should be used, with standard
terminal editing capabilities enabled.
.TP
\fBpassword\fR
.
indicates that non-echoing input should be used, with standard terminal
editing capabilities enabled but no writing of typed characters to the
terminal (except for newlines). Some terminals may indicate this specially.
.TP
\fBraw\fR
.
indicates that all keyboard input should be given directly to Tcl with the
terminal doing no processing at all. It does not echo the keys, leaving it up
to the Tcl script to interpret what to do.
.TP
\fBreset\fR (set only)
.
indicates that the terminal should be reset to what state it was in when the
terminal was opened.
.PP
Note that setting this option (technically, anything that changes the terminal
state from its initial value \fIvia this option\fR) will cause the channel to
turn on an automatic reset of the terminal when the channel is closed.
.RE
.TP
\fB\-winsize\fR
.
(Unix only; Windows has the equivalent option on console channels). This
option is query only. It retrieves a two-element list with the the current
width and height of the terminal.
.VE "8.7, TIP 160"
.TP
\fB\-pollinterval\fR \fImsec\fR
.
(Windows only). This option is used to set the maximum time between
polling for fileevents.
This affects the time interval between checking for events throughout the Tcl
interpreter (the smallest value always wins).  Use this option only if
you want to poll the serial port more or less often than 10 msec
(the default).
.TP
\fB\-sysbuffer\fR \fIinSize\fR
.TP
\fB\-sysbuffer\fR \fI{inSize outSize}\fR
.
(Windows only). This option is used to change the size of Windows
system buffers for a serial channel. Especially at higher communication
rates the default input buffer size of 4096 bytes can overrun
for latent systems. The first form specifies the input buffer size,
in the second form both input and output buffers are defined.
.TP
\fB\-lasterror\fR
.
(Windows only). This option is query only.
In case of a serial communication error, \fBread\fR or \fBputs\fR
returns a general Tcl file I/O error.
\fBfconfigure\fR \fB\-lasterror\fR can be called to get a list of error details.
\fBfconfigure -lasterror\fR can be called to get a list of error details.
See below for an explanation of the various error codes.
.SS "SERIAL PORT SIGNALS"
.SH "SERIAL PORT SIGNALS"
.PP
RS-232 is the most commonly used standard electrical interface for serial
communications. A negative voltage (-3V..-12V) define a mark (on=1) bit and
a positive voltage (+3..+12V) define a space (off=0) bit (RS-232C).  The
following signals are specified for incoming and outgoing data, status
lines and handshaking. Here we are using the terms \fIworkstation\fR for
your computer and \fImodem\fR for the external device, because some signal
names (DCD, RI) come from modems. Of course your external device may use
these signal lines for other purposes.
.IP \fBTXD\fR(output)
.IP \fBTXD(output)\fR
\fBTransmitted Data:\fR Outgoing serial data.
.IP \fBRXD\fR(input)
.IP \fBRXD(input)\fR
\fBReceived Data:\fRIncoming serial data.
.IP \fBRTS\fR(output)
.IP \fBRTS(output)\fR
\fBRequest To Send:\fR This hardware handshake line informs the modem that
your workstation is ready to receive data. Your workstation may
automatically reset this signal to indicate that the input buffer is full.
.IP \fBCTS\fR(input)
.IP \fBCTS(input)\fR
\fBClear To Send:\fR The complement to RTS. Indicates that the modem is
ready to receive data.
.IP \fBDTR\fR(output)
.IP \fBDTR(output)\fR
\fBData Terminal Ready:\fR This signal tells the modem that the workstation
is ready to establish a link. DTR is often enabled automatically whenever a
serial port is opened.
.IP \fBDSR\fR(input)
.IP \fBDSR(input)\fR
\fBData Set Ready:\fR The complement to DTR. Tells the workstation that the
modem is ready to establish a link.
.IP \fBDCD\fR(input)
.IP \fBDCD(input)\fR
\fBData Carrier Detect:\fR This line becomes active when a modem detects a
.QW Carrier
signal.
.IP \fBRI\fR(input)
.IP \fBRI(input)\fR
\fBRing Indicator:\fR Goes active when the modem detects an incoming call.
.IP \fBBREAK\fR
A BREAK condition is not a hardware signal line, but a logical zero on the
TXD or RXD lines for a long period of time, usually 250 to 500
milliseconds.  Normally a receive or transmit data signal stays at the mark
(on=1) voltage until the next character is transferred. A BREAK is sometimes
used to reset the communications line or change the operating mode of
communications hardware.
.SS "ERROR CODES (Windows only)"
.SH "ERROR CODES (Windows only)"
.PP
A lot of different errors may occur during serial read operations or during
event polling in background. The external device may have been switched
off, the data lines may be noisy, system buffers may overrun or your mode
settings may be wrong.  That is why a reliable software should always
\fBcatch\fR serial read operations.  In cases of an error Tcl returns a
general file I/O error.  Then \fBfconfigure\fR \fB\-lasterror\fR may help to
general file I/O error.  Then \fBfconfigure -lasterror\fR may help to
locate the problem.  The following error codes may be returned.
.TP 10
\fBRXOVER\fR
.
Windows input buffer overrun. The data comes faster than your scripts reads
it or your system is overloaded. Use \fBfconfigure\fR \fB\-sysbuffer\fR to avoid a
it or your system is overloaded. Use \fBfconfigure -sysbuffer\fR to avoid a
temporary bottleneck and/or make your script faster.
.TP 10
\fBTXFULL\fR
.
Windows output buffer overrun. Complement to RXOVER. This error should
practically not happen, because Tcl cares about the output buffer status.
.TP 10
\fBOVERRUN\fR
.
UART buffer overrun (hardware) with data lost.
The data comes faster than the system driver receives it.
Check your advanced serial port settings to enable the FIFO (16550) buffer
and/or setup a lower(1) interrupt threshold value.
.TP 10
\fBRXPARITY\fR
.
A parity error has been detected by your UART.
Wrong parity settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD)
Wrong parity settings with \fBfconfigure -mode\fR or a noisy data line (RXD)
may cause this error.
.TP 10
\fBFRAME\fR
.
A stop-bit error has been detected by your UART.
Wrong mode settings with \fBfconfigure\fR \fB\-mode\fR or a noisy data line (RXD)
Wrong mode settings with \fBfconfigure -mode\fR or a noisy data line (RXD)
may cause this error.
.TP 10
\fBBREAK\fR
.
A BREAK condition has been detected by your UART (see above).
.SS "PORTABILITY ISSUES"
.SH "PORTABILITY ISSUES"
.TP
\fBWindows \fR
.
Valid values for \fIfileName\fR to open a serial port are of the form
\fBcom\fIX\fB\fR, where \fIX\fR is a number, generally from 1 to 9.
A legacy form accepted as well is \fBcom\fIX\fB:\fR. This notation only
works for serial ports from 1 to 9.  An attempt to open a serial port that
does not exist or has a number greater than 9 will fail.  An alternate
form of opening serial ports is to use the filename \fB//./comX\fR,
where X is any number that corresponds to a serial port.
.PP
.RS
.PP
When running Tcl interactively, there may be some strange interactions
between the real console, if one is present, and a command pipeline that uses
standard input or output.  If a command pipeline is opened for reading, some
of the lines entered at the console will be sent to the command pipeline and
some will be sent to the Tcl evaluator.  If a command pipeline is opened for
writing, keystrokes entered into the console are not visible until the
pipe is closed.  These problems only occur because both Tcl and the child
application are competing for the console at the same time.  If the command
pipeline is started from a script, so that Tcl is not accessing the console,
or if the command pipeline does not use standard input or output, but is
redirected from or to a file, then the above problems do not occur.
.PP
Files opened in the
.QW \fBa\fR
mode or with the \fBAPPEND\fR flag set are implemented by seeking immediately
before each write, which is not an atomic operation and does not carry the
guarantee of strict appending that is present on POSIX platforms.
.RE
.TP
\fBUnix\fR\0\0\0\0\0\0\0
.
Valid values for \fIfileName\fR to open a serial port are generally of the
form \fB/dev/tty\fIX\fR, where \fIX\fR is \fBa\fR or \fBb\fR, but the name
of any pseudo-file that maps to a serial port may be used.
Advanced configuration options are only supported for serial ports
when Tcl is built to use the POSIX serial interface.
.RS
.PP
When running Tcl interactively, there may be some strange interactions
between the console, if one is present, and a command pipeline that uses
standard input.  If a command pipeline is opened for reading, some
of the lines entered at the console will be sent to the command pipeline and
some will be sent to the Tcl evaluator.  This problem only occurs because
both Tcl and the child application are competing for the console at the
same time.  If the command pipeline is started from a script, so that Tcl is
not accessing the console, or if the command pipeline does not use standard
input, but is redirected from a file, then the above problem does not occur.
input, but is redirected from a file, then the above problem does not occur.  
.RE
.PP
See the \fBPORTABILITY ISSUES\fR section of the \fBexec\fR command for
additional information not specific to command pipelines about executing
applications on the various platforms
.SH "CONSOLE CHANNELS"
.VS "8.7, TIP 160"
.SH "EXAMPLES"
Open a file for writing, forcing it to be created and raising an error if it
On Windows only, console channels (usually \fBstdin\fR or \fBstdout\fR)
support the following options:
.TP
\fB\-inputmode\fR \fIinputMode\fR
.
This option is used to query or change the input mode of the console channel,
which controls how interactive input from users is handled. The following
values for \fIinputMode\fR are supported:
.RS
.TP
\fBnormal\fR
.
already exists.
.PP
indicates that normal line-oriented input should be used, with standard
console editing capabilities enabled.
.TP
\fBpassword\fR
.
.CS
indicates that non-echoing input should be used, with standard console
editing capabilitied enabled but no writing of typed characters to the
terminal (except for newlines).
.TP
\fBraw\fR
.
indicates that all keyboard input should be given directly to Tcl with the
console doing no processing at all. It does not echo the keys, leaving it up
to the Tcl script to interpret what to do.
.TP
\fBreset\fR (set only)
.
set myNewFile [\fBopen\fR filename.txt {WRONLY CREAT EXCL}]
.CE
indicates that the console should be reset to what state it was in when the
console channel was opened.
.PP
Note that setting this option (technically, anything that changes the console
state from its default \fIvia this option\fR) will cause the channel to turn
on an automatic reset of the console when the channel is closed.
.RE
.TP
\fB\-winsize\fR
.
This option is query only.
It retrieves a two-element list with the the current width and height of the
console that this channel is talking to.
Open a file for writing as a log file.
.PP
Note that the equivalent options exist on Unix, but are on the serial channel
type.
.CS
.VE "8.7, TIP 160"
.SH "EXAMPLES"
set myLogFile [\fBopen\fR filename.log "a"]
fconfigure $myLogFile -buffering line
.CE
.PP
Open a command pipeline and catch any errors:
.PP
.CS
set fl [\fBopen\fR "| ls this_file_does_not_exist"]
set data [read $fl]
if {[catch {close $fl} err]} {
    puts "ls command failed: $err"
}
.CE
.PP
.VS "8.7, TIP 160"
Read a password securely from the user (assuming that the script is being run
interactively):
Open a command pipeline and read binary data from it. Note the unusual form
with
.QW |[list
that handles non-trivial edge cases with arguments that potentially have
spaces in.
.PP
.CS
chan configure stdin \fB-inputmode password\fR
try {
    chan puts -nonewline "Password: "
set fl [\fBopen\fR |[list create_image_data $input] "rb"]
    chan flush stdout
    set thePassword [chan gets stdin]
} finally {
set binData [read $fl]
close $fl
    chan configure stdin \fB-inputmode reset\fR
}
.CE
.VE "8.7, TIP 160"
.SH "SEE ALSO"
file(n), close(n), filename(n), fconfigure(n), gets(n), read(n),
puts(n), exec(n), pid(n), fopen(3)
.SH KEYWORDS
access mode, append, create, file, non-blocking, open, permissions,
pipeline, process, serial
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/package.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
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
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





-
+








-
-
+














+
















-
-
-
-
-
-
-
-
+
-





-







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH package n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
package \- Facilities for package loading and version control
.SH SYNOPSIS
.nf
\fBpackage files\fR \fIpackage\fR
\fBpackage forget\fR ?\fIpackage package ...\fR?
\fBpackage forget ?\fIpackage package ...\fR?
\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
\fBpackage names\fR
\fBpackage present \fIpackage \fR?\fIrequirement...\fR?
\fBpackage present \-exact \fIpackage version\fR
\fBpackage provide \fIpackage \fR?\fIversion\fR?
\fBpackage require \fIpackage \fR?\fIrequirement...\fR?
\fBpackage require \-exact \fIpackage version\fR
\fBpackage unknown \fR?\fIcommand\fR?
\fBpackage vcompare \fIversion1 version2\fR
\fBpackage versions \fIpackage\fR
\fBpackage vsatisfies \fIversion requirement...\fR
\fBpackage prefer \fR?\fBlatest\fR|\fBstable\fR?
.fi
.BE

.SH DESCRIPTION
.PP
This command keeps a simple database of the packages available for
use by the current interpreter and how to load them into the
interpreter.
It supports multiple versions of each package and arranges
for the correct version of a package to be loaded based on what
is needed by the application.
This command also detects and reports version clashes.
Typically, only the \fBpackage require\fR and \fBpackage provide\fR
commands are invoked in normal Tcl scripts;  the other commands are used
primarily by system scripts that maintain the package database.
.PP
The behavior of the \fBpackage\fR command is determined by its first argument.
The following forms are permitted:
.TP
\fBpackage files\fR \fIpackage\fR
.
Lists all files forming part of \fIpackage\fR. Auto-loaded files are not
included in this list, only files which were directly sourced during package
initialization. The list order corresponds with the order in which the
files were sourced.
.TP
\fBpackage forget\fR ?\fIpackage package ...\fR?
\fBpackage forget ?\fIpackage package ...\fR?
.
Removes all information about each specified package from this interpreter,
including information provided by both \fBpackage ifneeded\fR and
\fBpackage provide\fR.
.TP
\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
.
This command typically appears only in system configuration
scripts to set up the package database.
It indicates that a particular version of
a particular package is available if needed, and that the package
can be added to the interpreter by executing \fIscript\fR.
The script is saved in a database for use by subsequent
\fBpackage require\fR commands;  typically, \fIscript\fR
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
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







-












-









-
+

-
+
-







one.
If the \fIscript\fR argument is omitted, the current script for
version \fIversion\fR of package \fIpackage\fR is returned,
or an empty string if no \fBpackage ifneeded\fR command has
been invoked for this \fIpackage\fR and \fIversion\fR.
.TP
\fBpackage names\fR
.
Returns a list of the names of all packages in the
interpreter for which a version has been provided (via
\fBpackage provide\fR) or for which a \fBpackage ifneeded\fR
script is available.
The order of elements in the list is arbitrary.
.TP
\fBpackage present\fR ?\fB\-exact\fR? \fIpackage\fR ?\fIrequirement...\fR?
.
This command is equivalent to \fBpackage require\fR except that it
does not try and load the package if it is not already loaded.
.TP
\fBpackage provide \fIpackage \fR?\fIversion\fR?
.
This command is invoked to indicate that version \fIversion\fR
of package \fIpackage\fR is now present in the interpreter.
It is typically invoked once as part of an \fBifneeded\fR script,
and again by the package itself when it is finally loaded.
An error occurs if a different version of \fIpackage\fR has been
provided by a previous \fBpackage provide\fR command.
If the \fIversion\fR argument is omitted, then the command
returns the version number that is currently provided, or an
empty string if no \fBpackage provide\fR command has been
invoked for \fIpackage\fR in this interpreter.
invoked for \fIpackage\fR in this interpreter.  
.TP
\fBpackage require \fR\fIpackage \fR?\fIrequirement...\fR?
\fBpackage require\fR \fIpackage \fR?\fIrequirement...\fR?
.
This command is typically invoked by Tcl code that wishes to use
a particular version of a particular package.  The arguments
indicate which package is wanted, and the command ensures that
a suitable version of the package is loaded into the interpreter.
If the command succeeds, it returns the version number that is
loaded;  otherwise it generates an error.
.RS
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
136
137
138
139
140
141
142

143
144
145
146
147

148
149
150
151
152
153
154







-





-







it completes, Tcl checks again to see if the package is now provided
or if there is a \fBpackage ifneeded\fR script for it.
If all of these steps fail to provide an acceptable version of the
package, then the command returns an error.
.RE
.TP
\fBpackage require \-exact \fIpackage version\fR
.
This form of the command is used when only the given \fIversion\fR
of \fIpackage\fR is acceptable to the caller.  This command is
equivalent to \fBpackage require \fIpackage version\fR-\fIversion\fR.
.TP
\fBpackage unknown \fR?\fIcommand\fR?
.
This command supplies a
.QW "last resort"
command to invoke during
\fBpackage require\fR if no suitable version of a package can be found
in the \fBpackage ifneeded\fR database.
If the \fIcommand\fR argument is supplied, it contains the first part
of a command;  when the command is invoked during a \fBpackage require\fR
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
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







-


-
+


-





-






-




-




-







If the \fBpackage unknown\fR command is invoked without a \fIcommand\fR
argument, then the current \fBpackage unknown\fR script is returned,
or an empty string if there is none.
If \fIcommand\fR is specified as an empty string, then the current
\fBpackage unknown\fR script is removed, if there is one.
.TP
\fBpackage vcompare \fIversion1 version2\fR
.
Compares the two version numbers given by \fIversion1\fR and \fIversion2\fR.
Returns -1 if \fIversion1\fR is an earlier version than \fIversion2\fR,
0 if they are equal, and 1 if \fIversion1\fR is later than \fIversion2\fR.
0 if they are equal, and 1 if \fIversion1\fR is later than \fBversion2\fR.
.TP
\fBpackage versions \fIpackage\fR
.
Returns a list of all the version numbers of \fIpackage\fR
for which information has been provided by \fBpackage ifneeded\fR
commands.
.TP
\fBpackage vsatisfies \fIversion requirement...\fR
.
Returns 1 if the \fIversion\fR satisfies at least one of the given
requirements, and 0 otherwise. Each \fIrequirement\fR is allowed to
have any of the forms:
.RS
.TP
min
.
This form is called
.QW min-bounded .
.TP
min-
.
This form is called
.QW min-unbound .
.TP
min-max
.
This form is called
.QW bounded .
.RE
.RS
.PP
where
.QW min
287
288
289
290
291
292
293
294
295


296
297
298
299
300
301
302
267
268
269
270
271
272
273


274
275
276
277
278
279
280
281
282







-
-
+
+







.QW latest .
.PP
When passed any other value as an argument, raise an invalid argument
error.
.PP
When an interpreter is created, its initial selection mode value is set to
.QW stable
unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR is set
(to any value) or the Tcl package itself is unstable. Otherwise
unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR
is set.  If that environment variable is defined (with any value) then
the initial (and permanent) selection mode value is set to
.QW latest .
.RE
.SH "VERSION NUMBERS"
.PP
Version numbers consist of one or more decimal numbers separated
by dots, such as 2 or 1.162 or 3.1.13.1.
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
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










-


-








-


-
-
+
+

-
+






-
-
-
The recommended way to use packages in Tcl is to invoke \fBpackage require\fR
and \fBpackage provide\fR commands in scripts, and use the procedure
\fBpkg_mkIndex\fR to create package index files.
Once you have done this, packages will be loaded automatically
in response to \fBpackage require\fR commands.
See the documentation for \fBpkg_mkIndex\fR for details.
.SH EXAMPLES
.PP
To state that a Tcl script requires the Tk and http packages, put this
at the top of the script:
.PP
.CS
\fBpackage require\fR Tk
\fBpackage require\fR http
.CE
.PP
To test to see if the Snack package is available and load if it is
(often useful for optional enhancements to programs where the loss of
the functionality is not critical) do this:
.PP
.CS
if {[catch {\fBpackage require\fR Snack}]} {
    # Error thrown - package not found.
    # Set up a dummy interface to work around the absence
   # Error thrown - package not found.
   # Set up a dummy interface to work around the absence
} else {
    # We have the package, configure the app to use it
   # We have the package, configure the app to use it
}
.CE
.SH "SEE ALSO"
msgcat(n), packagens(n), pkgMkIndex(n)
.SH KEYWORDS
package, version
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/packagens.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
44
45
46
47
48
49
50
51
52
53
54
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







-
+







-
+












-
+


-
+


-
+








-
+










-
-
-
-
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
'\"
'\" 
.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pkg::create \- Construct an appropriate 'package ifneeded' command for a given package specification
.SH SYNOPSIS
\fB::pkg::create\fR \fB\-name \fIpackageName \fB\-version \fIpackageVersion\fR ?\fB\-load \fIfilespec\fR? ... ?\fB\-source \fIfilespec\fR? ...
\fB::pkg::create \fI\-name packageName\fR \fI\-version packageVersion\fR ?\fI\-load filespec\fR? ... ?\fI\-source filespec\fR? ...
.BE

.SH DESCRIPTION
.PP
\fB::pkg::create\fR is a utility procedure that is part of the standard Tcl
library.  It is used to create an appropriate \fBpackage ifneeded\fR
command for a given package specification.  It can be used to construct a
\fBpkgIndex.tcl\fR file for use with the \fBpackage\fR mechanism.

.SH OPTIONS
The parameters supported are:
.TP
\fB\-name \fIpackageName\fR
\fB\-name\fR\0\fIpackageName\fR
This parameter specifies the name of the package.  It is required.
.TP
\fB\-version \fIpackageVersion\fR
\fB\-version\fR\0\fIpackageVersion\fR
This parameter specifies the version of the package.  It is required.
.TP
\fB\-load \fIfilespec\fR
\fB\-load\fR\0\fIfilespec\fR
This parameter specifies a binary library that must be loaded with the
\fBload\fR command.  \fIfilespec\fR is a list with two elements.  The
first element is the name of the file to load.  The second, optional
element is a list of commands supplied by loading that file.  If the
list of procedures is empty or omitted, \fB::pkg::create\fR will
set up the library for direct loading (see \fBpkg_mkIndex\fR).  Any
number of \fB\-load\fR parameters may be specified.
.TP
\fB\-source \fIfilespec\fR
\fB\-source\fR\0\fIfilespec\fR
This parameter is similar to the \fB\-load\fR parameter, except that it
specifies a Tcl library that must be loaded with the
\fBsource\fR command.  Any number of \fB\-source\fR parameters may be
specified.
.PP
At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
.SH "SEE ALSO"
package(n)
.SH KEYWORDS
auto-load, index, package, version
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/pid.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH pid n 7.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pid \- Retrieve process identifiers
.SH SYNOPSIS
39
40
41
42
43
44
45

46
47
48
49
50
51
39
40
41
42
43
44
45
46
47
48











+


-
-
-
-
puts [string repeat - 70]
puts [read $pipeline]
close $pipeline
.CE

.SH "SEE ALSO"
exec(n), open(n)

.SH KEYWORDS
file, pipeline, process identifier
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/pkgMkIndex.n.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
1
2
3
4
5

6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22





-
+








-
+







'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH pkg_mkIndex n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pkg_mkIndex \- Build an index for automatic loading of packages
.SH SYNOPSIS
.nf
\fBpkg_mkIndex\fR ?\fIoptions...\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
\fBpkg_mkIndex ?\fI\-direct\fR?  ?\fI\-lazy\fR?  ?\fI\-load pkgPat\fR? ?\fI\-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP
\fBPkg_mkIndex\fR is a utility procedure that is part of the standard
Tcl library.
It is used to create index files that allow packages to be loaded
38
39
40
41
42
43
44
45

46
47
48
49
50

51
52
53
54
55
56
57
38
39
40
41
42
43
44

45
46
47
48
49

50
51
52
53
54
55
56
57







-
+




-
+







script or binary files in \fIdir\fR.
The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
.RS
.PP
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
with package information about all the files given by the \fIpattern\fR
arguments.
It does this by loading each file into a child
It does this by loading each file into a slave
interpreter and seeing what packages
and new commands appear (this is why it is essential to have
\fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
in the files, as described above).
If you have a package split among scripts and binary files,
If you have a package split among scripts and binary files, 
or if you have dependencies among files,
you may have to use the \fB\-load\fR option
or adjust the order in which \fBpkg_mkIndex\fR processes
the files.  See \fBCOMPLEX CASES\fR below.
.RE
.IP [3]
Install the package as a subdirectory of one of the directories given by
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
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







-
+


-
+



















-
+




















-
+














-
+







The generated index will manage to delay loading the package until the
use of one of the commands provided by the package, instead of loading
it immediately upon \fBpackage require\fR.  This is not compatible with
the use of \fIauto_reset\fR, and therefore its use is discouraged.
.TP 15
\fB\-load \fIpkgPat\fR
The index process will pre-load any packages that exist in the
current interpreter and match \fIpkgPat\fR into the child interpreter used to
current interpreter and match \fIpkgPat\fR into the slave interpreter used to
generate the index.  The pattern match uses string match rules, but without
making case distinctions.
See \fBCOMPLEX CASES\fR below.
See COMPLEX CASES below.
.TP 15
\fB\-verbose\fR
Generate output during the indexing process.  Output is via
the \fBtclLog\fR procedure, which by default prints to stderr.
.TP 15
\fB\-\-\fR
End of the flags, in case \fIdir\fR begins with a dash.
.SH "PACKAGES AND THE AUTO-LOADER"
.PP
The package management facilities overlap somewhat with the auto-loader,
in that both arrange for files to be loaded on-demand.
However, package management is a higher-level mechanism that uses
the auto-loader for the last step in the loading process.
It is generally better to index a package with \fBpkg_mkIndex\fR
rather than \fBauto_mkindex\fR because the package mechanism provides
version control:  several versions of a package can be made available
in the index files, with different applications using different
versions based on \fBpackage require\fR commands.
In contrast, \fBauto_mkindex\fR does not understand versions so
it can only handle a single version of each package.
it can only handle a single version of each package. 
It is probably not a good idea to index a given package with both
\fBpkg_mkIndex\fR and \fBauto_mkindex\fR.
If you use \fBpkg_mkIndex\fR to index a package, its commands cannot
be invoked until \fBpackage require\fR has been used to select a
version;  in contrast, packages indexed with \fBauto_mkindex\fR
can be used immediately since there is no version control.
.SH "HOW IT WORKS"
.PP
\fBPkg_mkIndex\fR depends on the \fBpackage unknown\fR command,
the \fBpackage ifneeded\fR command, and the auto-loader.
The first time a \fBpackage require\fR command is invoked,
the \fBpackage unknown\fR script is invoked.
This is set by Tcl initialization to a script that
evaluates all of the \fBpkgIndex.tcl\fR files in the
\fBauto_path\fR.
The \fBpkgIndex.tcl\fR files contain \fBpackage ifneeded\fR
commands for each version of each available package;  these commands
invoke \fBpackage provide\fR commands to announce the
availability of the package, and they setup auto-loader
information to load the files of the package.
If the \fB\-lazy\fR flag was provided when the \fBpkgIndex.tcl\fR
If the \fI\-lazy\fR flag was provided when the \fBpkgIndex.tcl\fR
was generated,
a given file of a given version of a given package is not
actually loaded until the first time one of its commands
is invoked.
Thus, after invoking \fBpackage require\fR you may
not see the package's commands in the interpreter, but you will be able
to invoke the commands and they will be auto-loaded.
.SH "DIRECT LOADING"
.PP
Some packages, for instance packages which use namespaces and export
commands or those which require special initialization, might select
that their package files be loaded immediately upon \fBpackage require\fR
instead of delaying the actual loading to the first use of one of the
package's command. This is the default mode when generating the package
index.  It can be overridden by specifying the \fB\-lazy\fR argument.
index.  It can be overridden by specifying the \fI\-lazy\fR argument.
.SH "COMPLEX CASES"
Most complex cases of dependencies among scripts
and binary files, and packages being split among scripts and
binary files are handled OK.  However, you may have to adjust
the order in which files are processed by \fBpkg_mkIndex\fR.
These issues are described in detail below.
.PP
224
225
226
227
228
229
230
231
232
233
224
225
226
227
228
229
230










-
-
-
If you must use \fB\-load\fR,
then you must specify the scripts first; otherwise the package loaded from
the binary file may mask the package defined by the scripts.
.SH "SEE ALSO"
package(n)
.SH KEYWORDS
auto-load, index, package, version
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/platform.n.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
1
2
3
4
5

6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22





-
+








-
+







'\"
'\" Copyright (c) 2006 ActiveState Software Inc
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH "platform" n 1.0.4 platform "Tcl Bundled Packages"
.so man.macros
.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\fR ?\fB1.0.10\fR?
\fBpackage require platform ?1.0.4?\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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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
\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/platform_shell.n.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
1
2
3
4
5

6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22





-
+








-
+







'\"
'\" Copyright (c) 2006-2008 ActiveState Software Inc
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH "platform::shell" n 1.1.4 platform::shell "Tcl Bundled Packages"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform::shell \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform::shell\fR ?\fB1.1.4\fR?
\fBpackage require platform::shell ?1.1.4?\fR
.sp
\fBplatform::shell::generic \fIshell\fR
\fBplatform::shell::identify \fIshell\fR
\fBplatform::shell::platform \fIshell\fR
.fi
.BE
.SH DESCRIPTION
51
52
53
54
55
56
57
58
59
60
61
51
52
53
54
55
56
57











-
-
-
-
for the specified Tcl shell, in contrast to the running shell.
.TP
\fBplatform::shell::platform \fIshell\fR
This command returns the contents of \fBtcl_platform(platform)\fR for
the specified Tcl shell.
.SH KEYWORDS
operating system, cpu architecture, platform, architecture
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/prefix.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
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




















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2008 Peter Spjuth <pspjuth@users.sourceforge.net>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH prefix n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::prefix \- facilities for prefix matching
.SH SYNOPSIS
.nf
\fB::tcl::prefix all\fR \fItable string\fR
\fB::tcl::prefix longest\fR \fItable string\fR
\fB::tcl::prefix match\fR ?\fIoption ...\fR? \fItable string\fR
.fi
.BE
.SH DESCRIPTION
.PP
This document describes commands looking up a prefix in a list of strings.
The following commands are supported:
.TP
\fB::tcl::prefix all\fR \fItable string\fR
.
Returns a list of all elements in \fItable\fR that begin with the prefix
\fIstring\fR.
.TP
\fB::tcl::prefix longest\fR \fItable string\fR
.
Returns the longest common prefix of all elements in \fItable\fR that
begin with the prefix \fIstring\fR.
.TP
\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable string\fR
.
If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
one element, the matched element is returned. If not, the result depends
on the \fB\-error\fR option. (It is recommended that the \fItable\fR be sorted
before use with this subcommand, so that the list of matches presented in the
error message also becomes sorted, though this is not strictly necessary for
the operation of this subcommand itself.)
.RS
.TP
\fB\-exact\fR\0
.
Accept only exact matches.
.TP
\fB\-message\0\fIstring\fR
.
Use \fIstring\fR in the error message at a mismatch. Default is
.QW option .
.TP
\fB\-error\0\fIoptions\fR
.
The \fIoptions\fR are used when no match is found. If \fIoptions\fR is empty,
no error is generated and an empty string is returned. Otherwise the
\fIoptions\fR are used as \fBreturn\fR options when generating the error
message. The default corresponds to setting
.QW "\-level 0" .
Example: If
.QW "\fB\-error\fR {\-errorcode MyError \-level 1}"
is used, an error would be generated as:
.RS
.PP
.CS
return \-errorcode MyError \-level 1 \-code error \e
       "ambiguous option ..."
.CE
.RE
.RE
.SH "EXAMPLES"
.PP
Basic use:
.PP
.CS
namespace import ::tcl::prefix
\fBprefix match\fR {apa bepa cepa} apa
     \fI\(-> apa\fR
\fBprefix match\fR {apa bepa cepa} a
     \fI\(-> apa\fR
\fBprefix match\fR \-exact {apa bepa cepa} a
     \fI\(-> bad option "a": must be apa, bepa, or cepa\fR
\fBprefix match\fR \-message "switch" {apa ada bepa cepa} a
     \fI\(-> ambiguous switch "a": must be apa, ada, bepa, or cepa\fR
\fBprefix longest\fR {fblocked fconfigure fcopy file fileevent flush} fc
     \fI\(-> fco\fR
\fBprefix all\fR {fblocked fconfigure fcopy file fileevent flush} fc
     \fI\(-> fconfigure fcopy\fR
.CE
.PP
Simplifying option matching:
.PP
.CS
array set opts {\-apa 1 \-bepa "" \-cepa 0}
foreach {arg val} $args {
    set opts([\fBprefix match\fR {\-apa \-bepa \-cepa} $arg]) $val
}
.CE
.PP
Creating a \fBswitch\fR that supports prefixes:
.PP
.CS
switch [\fBprefix match\fR {apa bepa cepa} $arg] {
    apa  { }
    bepa { }
    cepa { }
}
.CE
.SH "SEE ALSO"
lsearch(n), namespace(n), string(n), Tcl_GetIndexFromObj(3)
.SH "KEYWORDS"
prefix, table lookup
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/proc.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
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
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









-
+









+


















-
+

-
+
-
-
+










-
+

-
-
+
+
-
-


-
-
-
+
+








-
+

-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-


-
-
-
+
+
+






-


-
-
+
+


+


+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH proc n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
proc \- Create a Tcl procedure
.SH SYNOPSIS
\fBproc \fIname args body\fR
.BE

.SH DESCRIPTION
.PP
The \fBproc\fR command creates a new Tcl procedure named
\fIname\fR, replacing
any existing command or procedure there may have been by that name.
Whenever the new command is invoked, the contents of \fIbody\fR will
be executed by the Tcl interpreter.
Normally, \fIname\fR is unqualified
(does not include the names of any containing namespaces),
and the new procedure is created in the current namespace.
If \fIname\fR includes any namespace qualifiers,
the procedure is created in the specified namespace.
\fIArgs\fR specifies the formal arguments to the
procedure.  It consists of a list, possibly empty, each of whose
elements specifies
one argument.  Each argument specifier is also a list with either
one or two fields.  If there is only a single field in the specifier
then it is the name of the argument; if there are two fields, then
the first is the argument name and the second is its default value.
the first is the argument name and the second is its default value. 
Arguments with default values that are followed by non-defaulted
arguments become required arguments; enough actual arguments must be
arguments become required arguments.  In 8.6 this will be considered an 
supplied to allow all arguments up to and including the last required
formal argument.
error. 
.PP
When \fIname\fR is invoked a local variable
will be created for each of the formal arguments to the procedure; its
value will be the value of corresponding argument in the invoking command
or the argument's default value.
Actual arguments are assigned to formal arguments strictly in order.
Arguments with default values need not be
specified in a procedure invocation.  However, there must be enough
actual arguments for all the
formal arguments that do not have defaults, and there must not be any extra
actual arguments.
actual arguments.  
Arguments with default values that are followed by non-defaulted
arguments become de-facto required arguments, though this may change
in a future version of Tcl; portable code should ensure that all
arguments become required arguments (in 8.6 it will be considered an 
error).
optional arguments come after all required arguments.
.PP
There is one special case to permit procedures with
variable numbers of arguments.  If the last formal argument has the name
.QW \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
\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,
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
\fBreturn\fR, then its return value is the value of the last command
executed in the procedure's body.
If an error occurs while executing the procedure
body, then the procedure-as-a-whole will return that same error.
.SH EXAMPLES
.PP
This is a procedure that takes two arguments and prints both their sum
and their product. It also returns the string
.QW OK
to the caller as an explicit result.
.PP
.CS
\fBproc\fR printSumProduct {x y} {
    set sum [expr {$x + $y}]
    set prod [expr {$x * $y}]
    puts "sum is $sum, product is $prod"
    return "OK"
}
.CE
.PP
This is a procedure that accepts arbitrarily many arguments and prints
them out, one by one.
.PP
.CS
\fBproc\fR printArguments args {
    foreach arg $args {
        puts $arg
    }
   foreach arg $args {
      puts $arg
   }
}
.CE
.PP
This procedure is a bit like the \fBincr\fR command, except it
multiplies the contents of the named variable by the value, which
defaults to \fB2\fR:
.PP
.CS
\fBproc\fR mult {varName {multiplier 2}} {
    upvar 1 $varName var
    set var [expr {$var * $multiplier}]
   upvar 1 $varName var
   set var [expr {$var * $multiplier}]
}
.CE

.SH "SEE ALSO"
info(n), unknown(n)

.SH KEYWORDS
argument, procedure
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/process.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
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






















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2017 Frederic Bonnet.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH process n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tcl::process \- Subprocess management
.SH SYNOPSIS
\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command provides a way to manage subprocesses created by the \fBopen\fR
and \fBexec\fR commands, as identified by the process identifiers (PIDs) of
those subprocesses. The legal \fIoptions\fR (which may be abbreviated) are:
.TP
\fB::tcl::process autopurge\fR ?\fIflag\fR?
.
Automatic purge facility. If \fIflag\fR is specified as a boolean value then
it activates or deactivate autopurge. In all cases it returns the current
status as a boolean value. When autopurge is active,
\fBTcl_ReapDetachedProcs\fR is called each time the \fBexec\fR command is
executed or a pipe channel created by \fBopen\fR is closed. When autopurge is
inactive, \fB::tcl::process\fR purge must be called explicitly. By default
autopurge is active.
.TP
\fB::tcl::process list\fR
.
Returns the list of subprocess PIDs. This includes all currently executing
subprocesses and all terminated subprocesses that have not yet had their
corresponding process table entries purged.
.TP
\fB::tcl::process purge\fR ?\fIpids\fR?
.
Cleans up all data associated with terminated subprocesses. If \fIpids\fR is
specified as a list of PIDs then the command only cleanup data for the matching
subprocesses if they exist, and raises an error otherwise. If a process listed is
still active, this command does nothing to that process.
.TP
\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
.
Returns a dictionary mapping subprocess PIDs to their respective status. If
\fIpids\fR is specified as a list of PIDs then the command only returns the
status of the matching subprocesses if they exist, and raises an error
otherwise. For active processes, the status is an empty value. For terminated
processes, the status is a list with the following format:
.QW "\fB{\fIcode\fR ?\fImsg errorCode\fR?\fB}\fR" ,
where:
.RS
.TP
\fIcode\fR\0
.
is a standard Tcl return code, i.e., \fB0\fR for TCL_OK and \fB1\fR
for TCL_ERROR,
.TP
\fImsg\fR\0
.
is the human-readable error message,
.TP
\fIerrorCode\fR\0
.
uses the same format as the \fBerrorCode\fR global variable
.PP
Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
terminated processes (i.e. those where the \fIcode\fR is nonzero). Under the
hood this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
.PP
Additionally, \fB::tcl::process status\fR accepts the following switches:
.TP
\fB\-wait\fR\0
.
By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fIpids\fR
is specified as a list of PIDs then the command waits until the status of the
matching subprocesses are available. If \fIpids\fR was not specified, this
command will wait for all known subprocesses.
.TP
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
.RE
.SH "EXAMPLES"
.PP
These show the use of \fB::tcl::process\fR. Some of the results from
\fB::tcl::process status\fR are split over multiple lines for readability.
.PP
.CS
\fB::tcl::process autopurge\fR
     \fI\(-> true\fR
\fB::tcl::process autopurge\fR false
     \fI\(-> false\fR

set pid1 [exec command1 a b c | command2 d e f &]
     \fI\(-> 123 456\fR
set chan [open "|command1 a b c | command2 d e f"]
     \fI\(-> file123\fR
set pid2 [pid $chan]
     \fI\(-> 789 1011\fR

\fB::tcl::process list\fR
     \fI\(-> 123 456 789 1011\fR

\fB::tcl::process status\fR
     \fI\(-> 123 0
       456 {1 "child killed: write on pipe with no readers" {
         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
       789 {1 "child suspended: background tty read" {
         CHILDSUSP 789 SIGTTIN "background tty read"}}
       1011 {}\fR

\fB::tcl::process status\fR 123
     \fI\(-> 123 0\fR

\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {}\fR

\fB::tcl::process status\fR -wait
     \fI\(-> 123 0
       456 {1 "child killed: write on pipe with no readers" {
         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
       789 {1 "child suspended: background tty read" {
         CHILDSUSP 789 SIGTTIN "background tty read"}}
       1011 {1 "child process exited abnormally" {
         CHILDSTATUS 1011 -1}}\fR

\fB::tcl::process status\fR 1011
     \fI\(-> 1011 {1 "child process exited abnormally" {
         CHILDSTATUS 1011 -1}}\fR

\fB::tcl::process purge\fR
exec command1 1 2 3 &
     \fI\(-> 1213\fR
\fB::tcl::process list\fR
     \fI\(-> 1213\fR
.CE
.SH "SEE ALSO"
exec(n), open(n), pid(n),
Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
.SH "KEYWORDS"
background, child, detach, process, wait
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/puts.n.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24






-
+









+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH puts n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
puts \- Write to a channel
.SH SYNOPSIS
\fBputs \fR?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR
.BE

.SH DESCRIPTION
.PP
Writes the characters given by \fIstring\fR to the channel given
by \fIchannelId\fR.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a
Tcl standard channel (\fBstdout\fR or \fBstderr\fR), the return
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
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











-


-





-






-





-






+


+


-
-
-
-
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 \fBfileevent\fR command
(do not invoke \fBputs\fR unless you have recently been notified
via a file event that the channel is ready for more output data).
.SH EXAMPLES
.PP
Write a short message to the console (or wherever \fBstdout\fR is
directed):
.PP
.CS
\fBputs\fR "Hello, World!"
.CE
.PP
Print a message in several parts:
.PP
.CS
\fBputs\fR -nonewline "Hello, "
\fBputs\fR "World!"
.CE
.PP
Print a message to the standard error channel:
.PP
.CS
\fBputs\fR stderr "Hello, World!"
.CE
.PP
Append a log message to a file:
.PP
.CS
set chan [open my.log a]
set timestamp [clock format [clock seconds]]
\fBputs\fR $chan "$timestamp - Hello, World!"
close $chan
.CE

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

.SH KEYWORDS
channel, newline, output, write
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/pwd.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
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










-
+









+




-






-









+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH pwd n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
pwd \- Return the absolute path of the current working directory
.SH SYNOPSIS
\fBpwd\fR
.BE

.SH DESCRIPTION
.PP
Returns the absolute path name of the current working directory.
.SH EXAMPLE
.PP
Sometimes it is useful to change to a known directory when running
some external command using \fBexec\fR, but it is important to keep
the application usually running in the directory that it was started
in (unless the user specifies otherwise) since that minimizes user
confusion. The way to do this is to save the current directory while
the external command is being run:
.PP
.CS
set tarFile [file normalize somefile.tar]
set savedDir [\fBpwd\fR]
cd /tmp
exec tar -xf $tarFile
cd $savedDir
.CE
.SH "SEE ALSO"
file(n), cd(n), glob(n), filename(n)

.SH KEYWORDS
working directory
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/re_syntax.n.

1
2
3
4
5
6
7
8
9
10
11

12
13
14
15
16
17
18
1
2
3
4
5
6
7



8
9
10
11
12
13
14
15
16







-
-
-

+







'\"
'\" Copyright (c) 1998 Sun Microsystems, Inc.
'\" Copyright (c) 1999 Scriptics Corporation
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.so man.macros
.ie '\w'o''\w'\C'^o''' .ds qo \C'^o'
.el .ds qo u
.TH re_syntax n "8.1" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.SH NAME
re_syntax \- Syntax of Tcl regular expressions
.BE
.SH DESCRIPTION
.PP
A \fIregular expression\fR describes strings of characters.
133
134
135
136
137
138
139
140



141
142
143
144














145
146
147
148
149
150
151
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







-
+
+
+



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







are met. A constraint may not be followed by a quantifier. The
simple constraints are as follows; some more constraints are described
later, under \fBESCAPES\fR.
.RS 2
.TP 8
\fB^\fR
.
matches at the beginning of a line
matches at the beginning of the string or a line (according to whether
matching is newline-sensitive or not, as described in \fBMATCHING\fR,
below).
.TP
\fB$\fR
.
matches at the end of a line
matches at the end of the string or a line (according to whether
matching is newline-sensitive or not, as described in \fBMATCHING\fR,
below).
.RS
.PP
The difference between string and line matching modes is immaterial
when the string does not contain a newline character.  The \fB\eA\fR
and \fB\eZ\fR constraint escapes have a similar purpose but are
always constraints for the overall string.
.PP
The default newline-sensitivity depends on the command that uses the
regular expression, and can be overridden as described in
\fBMETASYNTAX\fR, below.
.RE
.TP
\fB(?=\fIre\fB)\fR
.
\fIpositive lookahead\fR (AREs only), matches at any point where a
substring matching \fIre\fR begins
.TP
\fB(?!\fIre\fB)\fR
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
234
232
233
234
235
236
237
238

239

240
241
242
243
244
245
246







-
+
-







.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
A character with a visible representation (includes both alnum and punct).
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
289
290
291
292
293
294
295
296

297
298
299

300
301

302
303
304
305
306
307
308
301
302
303
304
305
306
307

308
309
310

311
312

313
314
315
316
317
318
319
320







-
+


-
+

-
+







and \fB=]\fR is an equivalence class, standing for the sequences of
characters of all collating elements equivalent to that one, including
itself. (If there are no other equivalent collating elements, the
treatment is as if the enclosing delimiters were
.QW \fB[.\fR \&
and
.QW \fB.]\fR .)
For example, if \fBo\fR and \fB\[^o]\fR are the members of an
For example, if \fBo\fR and \fB\N'244'\fR are the members of an
equivalence class, then
.QW \fB[[=o=]]\fR ,
.QW \fB[[=\[^o]=]]\fR ,
.QW \fB[[=\N'244'=]]\fR ,
and
.QW \fB[o\[^o]]\fR \&
.QW \fB[o\N'244']\fR \&
are all synonymous. An equivalence class may not be an endpoint of a range.
.RS
.PP
(\fINote:\fR Tcl implements only the Unicode locale. It does not define any
equivalence classes. The examples above are just illustrations.)
.RE
.SH ESCAPES
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
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







-
+




-
-
+
+
-
-
-



-
+

-
+

-
-
+
+
+





-
-
-
-
-
-
-





+
+
+
+
+
+







.TP
\fB\et\fR
.
horizontal tab, as in C
.TP
\fB\eu\fIwxyz\fR
.
(where \fIwxyz\fR is one up to four hexadecimal digits) the Unicode
(where \fIwxyz\fR is exactly four hexadecimal digits) the Unicode
character \fBU+\fIwxyz\fR in the local byte ordering
.TP
\fB\eU\fIstuvwxyz\fR
.
(where \fIstuvwxyz\fR is one up to eight hexadecimal digits) reserved
for a Unicode extension up to 21 bits. The digits are parsed until the
(where \fIstuvwxyz\fR is exactly eight hexadecimal digits) reserved
for a somewhat-hypothetical Unicode extension to 32 bits
first non-hexadecimal character is encountered, the maximun of eight
hexadecimal digits are reached, or an overflow would occur in the maximum
value of \fBU+\fI10ffff\fR.
.TP
\fB\ev\fR
.
vertical tab, as in C
vertical tab, as in C are all available.
.TP
\fB\ex\fIhh\fR
\fB\ex\fIhhh\fR
.
(where \fIhh\fR is one or two hexadecimal digits) the character
whose hexadecimal value is \fB0x\fIhh\fR.
(where \fIhhh\fR is any sequence of hexadecimal digits) the character
whose hexadecimal value is \fB0x\fIhhh\fR (a single character no
matter how many hexadecimal digits are used).
.TP
\fB\e0\fR
.
the character whose value is \fB0\fR
.TP
\fB\e\fIxyz\fR
.
(where \fIxyz\fR is exactly three octal digits, and is not a \fIback
reference\fR (see below)) the character whose octal value is
\fB0\fIxyz\fR. The first digit must be in the range 0-3, otherwise
the two-digit form is assumed.
.TP
\fB\e\fIxy\fR
.
(where \fIxy\fR is exactly two octal digits, and is not a \fIback
reference\fR (see below)) the character whose octal value is
\fB0\fIxy\fR
.TP
\fB\e\fIxyz\fR
.
(where \fIxyz\fR is exactly three octal digits, and is not a back
reference (see below)) the character whose octal value is
\fB0\fIxyz\fR
.RE
.PP
Hexadecimal digits are
.QR \fB0\fR \fB9\fR ,
.QR \fBa\fR \fBf\fR ,
and
.QR \fBA\fR \fBF\fR .
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
688
689
690
691
692
693
694

695
696
697
























698
699
700
701
702
703
704







-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







Subject to the constraints imposed by the rules for matching the whole
RE, subexpressions also match the longest or shortest possible
substrings, based on their preferences, with subexpressions starting
earlier in the RE taking priority over ones starting later. Note that
outer subexpressions thus take priority over their component
subexpressions.
.PP
The quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
Note that the quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
force longest and shortest preference, respectively, on a
subexpression or a whole RE.
.RS
.PP
\fBNOTE:\fR This means that you can usually make a RE be non-greedy overall by
putting \fB{1,1}?\fR after one of the first non-constraint atoms or
parenthesized sub-expressions in it. \fIIt pays to experiment\fR with the
placing of this non-greediness override on a suitable range of input texts
when you are writing a RE if you are using this level of complexity.
.PP
For example, this regular expression is non-greedy, and will match the
shortest substring possible given that
.QW \fBabc\fR
will be matched as early as possible (the quantifier does not change that):
.PP
.CS
ab{1,1}?c.*x.*cba
.CE
.PP
The atom
.QW \fBa\fR
has no greediness preference, we explicitly give one for
.QW \fBb\fR ,
and the remaining quantifiers are overridden to be non-greedy by the preceding
non-greedy quantifier.
.RE
.PP
Match lengths are measured in characters, not collating elements. An
empty string is considered longer than no match at all. For example,
.QW \fBbb*\fR
matches the three middle characters of
.QW \fBabbbc\fR ,
.QW \fB(week|wee)(night|knights)\fR

Changes to doc/read.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
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






-
+











+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH read n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
read \- Read from a channel
.SH SYNOPSIS
\fBread \fR?\fB\-nonewline\fR? \fIchannelId\fR
.sp
\fBread \fIchannelId numChars\fR
.BE

.SH DESCRIPTION
.PP
In the first form, the \fBread\fR command reads all of the data from
\fIchannelId\fR up to the end of the file.  If the \fB\-nonewline\fR
switch is specified then the last character of the file is discarded
if it is a newline.  In the second form, the extra argument specifies
how many characters to read.  Exactly that many characters will be
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
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 command returns before reaching the end of the file.
.PP
\fBRead\fR translates end-of-line sequences in the input into
newline characters according to the \fB\-translation\fR option
for the channel.
See the \fBfconfigure\fR manual entry for a discussion on ways in
which \fBfconfigure\fR will alter input.

.SH "USE WITH SERIAL PORTS"
'\" Note:  this advice actually applies to many versions of Tcl
.PP

For most applications a channel connected to a serial port should be
configured to be nonblocking: \fBfconfigure\fI channelId \fB\-blocking
configured to be nonblocking: \fBfconfigure \fIchannelId \fB\-blocking
\fI0\fR.  Then \fBread\fR behaves much like described above.  Care
must be taken when using \fBread\fR on blocking serial ports:
.TP
\fBread \fIchannelId numChars\fR
\fBread \fIchannelId numChars\fR 
.
In this form \fBread\fR blocks until \fInumChars\fR have been received
from the serial port.
.TP
\fBread \fIchannelId\fR
\fBread \fIchannelId\fR 
.
In this form \fBread\fR blocks until the reception of the end-of-file
character, see \fBfconfigure\fR \fB\-eofchar\fR. If there no end-of-file
character, see \fBfconfigure -eofchar\fR. If there no end-of-file
character has been configured for the channel, then \fBread\fR will
block forever.
.SH "EXAMPLE"
.PP
This example code reads a file all at once, and splits it into a list,
with each line in the file corresponding to an element in the list:
.PP
.CS
set fl [open /proc/meminfo]
set data [\fBread\fR $fl]
close $fl
set lines [split $data \en]
.CE

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

.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation, encoding
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to doc/refchan.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

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
-
+










-
+







-
+

-
-
+







'\"
'\" 
'\" Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH refchan n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
refchan \- command handler API of reflected channels
refchan \- Command handler API of reflected channels, version 1
.SH SYNOPSIS
\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
The Tcl-level handler for a reflected channel has to be a command with
subcommands (termed an \fIensemble\fR, as it is a command such as that
created by \fBnamespace ensemble\fR \fBcreate\fR, though the implementation
created by \fBnamespace ensemble create\fR, though the implementation
of handlers for reflected channel \fIis not\fR tied to \fBnamespace
ensemble\fRs in any way; see \fBEXAMPLE\fR below for how to build an
\fBoo::class\fR that supports the API). Note that \fIcmdPrefix\fR is whatever was
ensemble\fRs in any way). Note that \fIcmdPrefix\fR is whatever was
specified in the call to \fBchan create\fR, and may consist of
multiple arguments; this will be expanded to multiple words in place
of the prefix.
.PP
Of all the possible subcommands, the handler \fImust\fR support
\fBinitialize\fR, \fBfinalize\fR, and \fBwatch\fR. Support for the
other subcommands is optional.
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55







-
+







of all subcommands supported by the \fIcmdPrefix\fR. This also tells
the Tcl core which version of the API for reflected channels is used by
this command handler.
.PP
Any error thrown by the method will abort the creation of the channel
and no channel will be created. The thrown error will appear as error
thrown by \fBchan create\fR. Any exception other than an \fBerror\fR
(e.g.,\ \fBbreak\fR, etc.) is treated as (and converted to) an error.
(e.g. \fBbreak\fR, etc.) is treated as (and converted to) an error.
.PP
\fBNote:\fR If the creation of the channel was aborted due to failures
here, then the \fBfinalize\fR subcommand will not be called.
.PP
The \fImode\fR argument tells the handler whether the channel was
opened for reading, writing, or both. It is a list containing any of
the strings \fBread\fR or \fBwrite\fR. The list will always
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
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







-
-
+
+

















-
+











-
+







called, any internal resources allocated to this channel must be
cleaned up.
.RS
.PP
The return value of this subcommand is ignored.
.PP
If the subcommand throws an error the command which caused its
invocation (usually \fBchan close\fR) will appear to have thrown this
error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is
invocation (usually \fBclose\fR) will appear to have thrown this
error. Any exception beyond \fIerror\fR (e.g. \fIbreak\fR, etc.) is
treated as (and converted to) an error.
.PP
This subcommand is not invoked if the creation of the channel was
aborted during \fBinitialize\fR (See above).
.RE
.TP
\fIcmdPrefix \fBwatch \fIchannelId eventspec\fR
.
This subcommand notifies the \fIcmdPrefix\fR that the specified
\fIchannelId\fR is interested in the events listed in the
\fIeventspec\fR. This argument is a list containing any of \fBread\fR
and \fBwrite\fR. The list may be empty, which signals that the
channel does not wish to be notified of any events. In that situation,
the handler should disable event generation completely.
.RS
.PP
\fBWarning:\fR Any return value of the subcommand is ignored. This
includes all errors thrown by the subcommand, \fBbreak\fR, \fBcontinue\fR, and
includes all errors thrown by the subcommand, break, continue, and
custom return codes.
.PP
This subcommand interacts with \fBchan postevent\fR. Trying to post an
event which was not listed in the last call to \fBwatch\fR will cause
\fBchan postevent\fR to throw an error.
.RE
.SS "OPTIONAL SUBCOMMANDS"
.TP
\fIcmdPrefix \fBread \fIchannelId count\fR
.
This \fIoptional\fR subcommand is called when the user requests data from the
channel \fIchannelId\fR. \fIcount\fR specifies how many \fIbytes\fR have been
channel \fIchannelId\fR. \fIcount\fR specifies how many \fBbytes\fR have been
requested. If the subcommand is not supported then it is not possible to read
from the channel handled by the command.
.RS
.PP
The return value of this subcommand is taken as the requested data
\fIbytes\fR. If the returned data contains more bytes than requested,
an error will be signaled and later thrown by the command which
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
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







-
+
-
-
-
-
+









-
+
-
-
-
-
+
-



-
-
+
+







or
.CS
error EAGAIN
.CE
.PP
For extensibility any error whose value is a negative integer number
will cause the higher layers to set the C-level variable "\fBerrno\fR"
to the absolute value of this number, signaling a system error.
to the absolute value of this number, signaling a system error. This
However, note that the exact mapping between these error numbers and
their meanings is operating system dependent.
.PP
For example, while on Linux both
means that both
.PP
.CS
return -code error -11
.CE
and
.CS
error -11
.CE
.PP
are equivalent to the examples above, using the more readable string "EAGAIN",
are equivalent to the examples above, using the more readable string "EAGAIN".
this is not true for BSD, where the equivalent number is -35.
.PP
The symbolic string however is the same across systems, and internally
translated to the correct number. No other error value has such a mapping
No other error value has such a mapping to a symbolic string.
to a symbolic string.
.PP
If the subcommand throws any other error, the command which caused its
invocation (usually \fBgets\fR, or \fBread\fR) will appear to have
thrown this error. Any exception beyond \fBerror\fR, (e.g.,\ \fBbreak\fR,
etc.) is treated as and converted to an error.
thrown this error. Any exception beyond \fIerror\fR, (e.g.
\fIbreak\fR, etc.) is treated as and converted to an error.
.RE
.TP
\fIcmdPrefix \fBwrite \fIchannelId data\fR
.
This \fIoptional\fR subcommand is called when the user writes data to
the channel \fIchannelId\fR. The \fIdata\fR argument contains \fIbytes\fR, not
characters. Any type of transformation (EOL, encoding) configured for
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
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
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










-
+






-
-
+
+
-


-
+
-












+
+
+




+






+

-
-
+
+


-
-
+
+
















-
-
-
+
+
+













-
-
-
+
+
+













-
-
-
+
+
+













-
-
-
+
+
+





-
-
+
+


-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+

-
+
-
-
-
.PP
The symbolic string however is the same across systems, and internally
translated to the correct number. No other error value has such a mapping
to a symbolic string.
.PP
If the subcommand throws any other error the command which caused its
invocation (usually \fBputs\fR) will appear to have thrown this error.
Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated
Any exception beyond \fIerror\fR (e.g.\ \fIbreak\fR, etc.) is treated
as and converted to an error.
.RE
.TP
\fIcmdPrefix \fBseek \fIchannelId offset base\fR
.
This \fIoptional\fR subcommand is responsible for the handling of
\fBchan seek\fR and \fBchan tell\fR requests on the channel
\fIchannelId\fR. If it is not supported then seeking will not be possible for
\fBseek\fR and \fBtell\fR requests on the channel \fIchannelId\fR. If it is not
supported then seeking will not be possible for the channel.
the channel.
.RS
.PP
The \fIbase\fR argument is the same as the equivalent argument of the
The \fIbase\fR argument is one of
builtin \fBchan seek\fR, namely:
.TP 10
\fBstart\fR
.
Seeking is relative to the beginning of the channel.
.TP 10
\fBcurrent\fR
.
Seeking is relative to the current seek position.
.TP 10
\fBend\fR
.
Seeking is relative to the end of the channel.
.PP
The \fIbase\fR argument of the builtin \fBchan seek\fR command takes
the same names.
.PP
The \fIoffset\fR is an integer number specifying the amount of
\fBbytes\fR to seek forward or backward. A positive number should seek
forward, and a negative number should seek backward.
.PP
A channel may provide only limited seeking. For example sockets can
seek forward, but not backward.
.PP
The return value of the subcommand is taken as the (new) location of
the channel, counted from the start. This has to be an integer number
greater than or equal to zero.
.PP
If the subcommand throws an error the command which caused its
invocation (usually \fBchan seek\fR, or \fBchan tell\fR) will appear to have
thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
invocation (usually \fBseek\fR, or \fBtell\fR) will appear to have
thrown this error. Any exception beyond \fIerror\fR (e.g. \fIbreak\fR,
etc.) is treated as and converted to an error.
.PP
The offset/base combination of 0/\fBcurrent\fR signals a \fBchan tell\fR
request, i.e.,\ seek nothing relative to the current location, making
The offset/base combination of 0/\fBcurrent\fR signals a \fBtell\fR
request, i.e. seek nothing relative to the current location, making
the new location identical to the current one, which is then returned.
.RE
.TP
\fIcmdPrefix \fBconfigure \fIchannelId option value\fR
.
This \fIoptional\fR subcommand is for setting the type-specific options of
channel \fIchannelId\fR. The \fIoption\fR argument indicates the option to be
written, and the \fIvalue\fR argument indicates the value to set the option to.
.RS
.PP
This subcommand will never try to update more than one option at a
time; that is behavior implemented in the Tcl channel core.
.PP
The return value of the subcommand is ignored.
.PP
If the subcommand throws an error the command which performed the
(re)configuration or query (usually \fBfconfigure\fR or
\fBchan configure\fR) will appear to have thrown this error. Any exception
beyond \fBerror\fR (e.g.,\ \fBbreak\fR, etc.) is treated as and
(re)configuration or query (usually \fBfconfigure\fR or \fBchan
configure\fR) will appear to have thrown this error. Any exception
beyond \fIerror\fR (e.g. \fIbreak\fR, etc.) is treated as and
converted to an error.
.RE
.TP
\fIcmdPrefix \fBcget \fIchannelId option\fR
.
This \fIoptional\fR subcommand is used when reading a single type-specific
option of channel \fIchannelId\fR. If this subcommand is supported then the
subcommand \fBcgetall\fR must be supported as well.
.RS
.PP
The subcommand should return the value of the specified \fIoption\fR.
.PP
If the subcommand throws an error, the command which performed the
(re)configuration or query (usually \fBfconfigure\fR or \fBchan configure\fR)
will appear to have thrown this error. Any exception beyond \fIerror\fR
(e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error.
(re)configuration or query (usually \fBfconfigure\fR) will appear to
have thrown this error. Any exception beyond \fIerror\fR (e.g.
\fIbreak\fR, etc.) is treated as and converted to an error.
.RE
.TP
\fIcmdPrefix \fBcgetall \fIchannelId\fR
.
This \fIoptional\fR subcommand is used for reading all type-specific options
of channel \fIchannelId\fR. If this subcommand is supported then the
subcommand \fBcget\fR has to be supported as well.
.RS
.PP
The subcommand should return a list of all options and their values.
This list must have an even number of elements.
.PP
If the subcommand throws an error the command which performed the
(re)configuration or query (usually \fBfconfigure\fR or \fBchan configure\fR)
will appear to have thrown this error. Any exception beyond \fBerror\fR
(e.g.,\ \fBbreak\fR, etc.) is treated as and converted to an error.
(re)configuration or query (usually \fBfconfigure\fR) will appear to
have thrown this error. Any exception beyond \fIerror\fR (e.g.
\fIbreak\fR, etc.) is treated as and converted to an error.
.RE
.TP
\fIcmdPrefix \fBblocking \fIchannelId mode\fR
.
This \fIoptional\fR subcommand handles changes to the blocking mode of the
channel \fIchannelId\fR. The \fImode\fR is a boolean flag. A true value means
that the channel has to be set to blocking, and a false value means that the
channel should be non-blocking.
.RS
.PP
The return value of the subcommand is ignored.
.PP
If the subcommand throws an error the command which caused its
invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to
have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
etc.) is treated as and converted to an error.
invocation (usually \fBfconfigure\fR) will appear to have thrown this
error. Any exception beyond \fIerror\fR (e.g. \fIbreak\fR, etc.) is
treated as and converted to an error.
.RE
.SH NOTES
Some of the functions supported in channels defined in Tcl's C
interface are not available to channels reflected to the Tcl level.
.PP
The function \fBTcl_DriverGetHandleProc\fR is not supported;
i.e.,\ reflected channels do not have OS specific handles.
The function \fBTcl_DriverGetHandleProc\fR is not supported; i.e.
reflected channels do not have OS specific handles.
.PP
The function \fBTcl_DriverHandlerProc\fR is not supported. This driver
function is relevant only for stacked channels, i.e.,\ transformations.
function is relevant only for stacked channels, i.e. transformations.
Reflected channels are always base channels, not transformations.
.PP
The function \fBTcl_DriverFlushProc\fR is not supported. This is
because the current generic I/O layer of Tcl does not use this
function anywhere at all. Therefore support at the Tcl level makes no
sense either. This may be altered in the future (through extending the
API defined here and changing its version number) should the function
be used at some time in the future.
.SH EXAMPLE
.PP
This demonstrates how to make a channel that reads from a string.
.PP
.CS
oo::class create stringchan {
    variable data pos
    constructor {string {encoding {}}} {
        if {$encoding eq ""} {set encoding [encoding system]}
        set data [encoding convertto $encoding $string]
        set pos 0
    }

    method \fBinitialize\fR {ch mode} {
        return "initialize finalize watch read seek"
    }
    method \fBfinalize\fR {ch} {
        my destroy
    }
    method \fBwatch\fR {ch events} {
        # Must be present but we ignore it because we do not
        # post any events
    }

    # Must be present on a readable channel
    method \fBread\fR {ch count} {
        set d [string range $data $pos [expr {$pos+$count-1}]]
        incr pos [string length $d]
        return $d
    }

    # This method is optional, but useful for the example below
    method \fBseek\fR {ch offset base} {
        switch $base {
            start {
                set pos $offset
            }
            current {
                incr pos $offset
            }
            end {
                set pos [string length $data]
                incr pos $offset
            }
        }
        if {$pos < 0} {
            set pos 0
        } elseif {$pos > [string length $data]} {
            set pos [string length $data]
        }
        return $pos
    }
}

# Now we create an instance...
set string "The quick brown fox jumps over the lazy dog.\\n"
set ch [\fBchan create\fR read [stringchan new $string]]

puts [gets $ch];   # Prints the whole string

seek $ch -5 end;
puts [read $ch];   # Prints just the last word
.CE
.SH "SEE ALSO"
chan(n), transchan(n)
chan(n)
.SH KEYWORDS
API, channel, ensemble, prefix, reflection
channel, reflection
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/regexp.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
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
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








-
+






+



+







-
+















-







-





-
-
+







-

















-









-












-




-






-







-
-






-


-

-
+
+


+









-















-



-







-



-



-





-







-




-
+
+
+
+


-
-
-
'\"
'\" Copyright (c) 1998 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH regexp n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
regexp \- Match a regular expression against a string

.SH SYNOPSIS
\fBregexp \fR?\fIswitches\fR? \fIexp string \fR?\fImatchVar\fR? ?\fIsubMatchVar subMatchVar ...\fR?
.BE

.SH DESCRIPTION
.PP
Determines whether the regular expression \fIexp\fR matches part or
all of \fIstring\fR and returns 1 if it does, 0 if it does not, unless
\fB\-inline\fR is specified (see below).
(Regular expression matching is described in the \fBre_syntax\fR
reference page.)
.PP
.LP
If additional arguments are specified after \fIstring\fR then they
are treated as the names of variables in which to return
information about which part(s) of \fIstring\fR matched \fIexp\fR.
\fIMatchVar\fR will be set to the range of \fIstring\fR that
matched all of \fIexp\fR.  The first \fIsubMatchVar\fR will contain
the characters in \fIstring\fR that matched the leftmost parenthesized
subexpression within \fIexp\fR, the next \fIsubMatchVar\fR will
contain the characters that matched the next parenthesized
subexpression to the right in \fIexp\fR, and so on.
.PP
If the initial arguments to \fBregexp\fR start with \fB\-\fR then
they are treated as switches.  The following switches are
currently supported:
.TP 15
\fB\-about\fR
.
Instead of attempting to match the regular expression, returns a list
containing information about the regular expression.  The first
element of the list is a subexpression count.  The second element is a
list of property names that describe various attributes of the regular
expression. This switch is primarily intended for debugging purposes.
.TP 15
\fB\-expanded\fR
.
Enables use of the expanded regular expression syntax where
whitespace and comments are ignored.  This is the same as specifying
the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-indices\fR
.
Changes what is stored in the \fImatchVar\fR and \fIsubMatchVar\fRs.
Changes what is stored in the \fIsubMatchVar\fRs. 
Instead of storing the matching characters from \fIstring\fR,
each variable
will contain a list of two decimal strings giving the indices
in \fIstring\fR of the first and last characters in the matching
range of characters.
.TP 15
\fB\-line\fR
.
Enables newline-sensitive matching.  By default, newline is a
completely ordinary character with no special meaning.  With this
flag,
.QW [^
bracket expressions and
.QW .
never match newline,
.QW ^
matches an empty string after any newline in addition to its normal
function, and
.QW $
matches an empty string before any newline in
addition to its normal function.  This flag is equivalent to
specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the
\fB(?n)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-linestop\fR
.
Changes the behavior of
.QW [^
bracket expressions and
.QW .
so that they
stop at newlines.  This is the same as specifying the \fB(?p)\fR
embedded option (see the \fBre_syntax\fR manual page).
.TP 15
\fB\-lineanchor\fR
.
Changes the behavior of
.QW ^
and
.QW $
(the
.QW anchors )
so they match the
beginning and end of a line respectively.  This is the same as
specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR
manual page).
.TP 15
\fB\-nocase\fR
.
Causes upper-case characters in \fIstring\fR to be treated as
lower case during the matching process.
.TP 15
\fB\-all\fR
.
Causes the regular expression to be matched as many times as possible
in the string, returning the total number of matches found.  If this
is specified with match variables, they will contain information for
the last match only.
.TP 15
\fB\-inline\fR
.
Causes the command to return, as a list, the data that would otherwise
be placed in match variables.  When using \fB\-inline\fR,
match variables may not be specified.  If used with \fB\-all\fR, the
list will be concatenated at each iteration, such that a flat list is
always returned.  For each match iteration, the command will append the
overall match data, plus one element for each subexpression in the
regular expression.  Examples are:
.RS
.PP
.CS
\fBregexp\fR -inline -- {\ew(\ew)} " inlined "
      \fI\(-> in n\fR
\fBregexp\fR -all -inline -- {\ew(\ew)} " inlined "
      \fI\(-> in n li i ne e\fR
.CE
.RE
.TP 15
\fB\-start\fR \fIindex\fR
.
Specifies a character index offset into the string to start
matching the regular expression at.
matching the regular expression at.  
.VS 8.5
The \fIindex\fR value is interpreted in the same manner
as the \fIindex\fR argument to \fBstring index\fR.
.VE 8.5
When using this switch,
.QW ^
will not match the beginning of the line, and \eA will still
match the start of the string at \fIindex\fR.  If \fB\-indices\fR
is specified, the indices will be indexed starting from the
absolute beginning of the input string.
\fIindex\fR will be constrained to the bounds of the input string.
.TP 15
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as \fIexp\fR even if it starts with a \fB\-\fR.
.PP
If there are more \fIsubMatchVar\fRs than parenthesized
subexpressions within \fIexp\fR, or if a particular subexpression
in \fIexp\fR does not match the string (e.g. because it was in a
portion of the expression that was not matched), then the corresponding
\fIsubMatchVar\fR will be set to
.QW "\fB\-1 \-1\fR"
if \fB\-indices\fR has been specified or to an empty string otherwise.
.SH EXAMPLES
.PP
Find the first occurrence of a word starting with \fBfoo\fR in a
string that is not actually an instance of \fBfoobar\fR, and get the
letters following it up to the end of the word into a variable:
.PP
.CS
\fBregexp\fR {\emfoo(?!bar\eM)(\ew*)} $string \-> restOfWord
.CE
.PP
Note that the whole matched substring has been placed in the variable
.QW \fB\->\fR ,
which is a name chosen to look nice given that we are not
actually interested in its contents.
.PP
Find the index of the word \fBbadger\fR (in any case) within a string
and store that in the variable \fBlocation\fR:
.PP
.CS
\fBregexp\fR \-indices {(?i)\embadger\eM} $string location
.CE
.PP
This could also be written as a \fIbasic\fR regular expression (as opposed
to using the default syntax of \fIadvanced\fR regular expressions) match by
prefixing the expression with a suitable flag:
.PP
.CS
\fBregexp\fR \-indices {(?ib)\e<badger\e>} $string location
.CE
.PP
This counts the number of octal digits in a string:
.PP
.CS
\fBregexp\fR \-all {[0\-7]} $string
.CE
.PP
This lists all words (consisting of all sequences of non-whitespace
characters) in a string, and is useful as a more powerful version of the
\fBsplit\fR command:
.PP
.CS
\fBregexp\fR \-all \-inline {\eS+} $string
.CE
.SH "SEE ALSO"
re_syntax(n), regsub(n), string(n)
re_syntax(n), regsub(n),
.VS 8.5
string(n)
.VE
.SH KEYWORDS
match, parsing, pattern, regular expression, splitting, string
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/registry.n.

9
10
11
12
13
14
15
16

17
18

19
20
21
22
23
24
25
9
10
11
12
13
14
15

16
17

18
19
20
21
22
23
24
25







-
+

-
+







.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
registry \- Manipulate the Windows registry
.SH SYNOPSIS
.sp
\fBpackage require registry 1.3\fR
\fBpackage require registry 1.1\fR
.sp
\fBregistry \fR?\fI\-mode\fR? \fIoption\fR \fIkeyName\fR ?\fIarg arg ...\fR?
\fBregistry \fIoption\fR \fIkeyName\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fBregistry\fR package provides a general set of operations for
manipulating the Windows registry.  The package implements the
\fBregistry\fR Tcl command.  This command is only supported on the
Windows platform.  Warning: this command should be used with caution
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
40
41
42
43
44
45
46






47
48
49
50
51
52
53







-
-
-
-
-
-







host that exports its registry.  The \fIrootname\fR component must be
one of \fBHKEY_LOCAL_MACHINE\fR, \fBHKEY_USERS\fR,
\fBHKEY_CLASSES_ROOT\fR, \fBHKEY_CURRENT_USER\fR,
\fBHKEY_CURRENT_CONFIG\fR, \fBHKEY_PERFORMANCE_DATA\fR, or
\fBHKEY_DYN_DATA\fR.  The \fIkeypath\fR can be one or more
registry key names separated by backslash (\fB\e\fR) characters.
.PP
The optional \fI\-mode\fR argument indicates which registry to work
with; when it is \fB\-32bit\fR the 32-bit registry will be used, and
when it is \fB\-64bit\fR the 64-bit registry will be used. If this
argument is omitted, the system's default registry will be the subject
of the requested operation.
.PP
\fIOption\fR indicates what to do with the registry key name.  Any
unique abbreviation for \fIoption\fR is acceptable.  The valid options
are:
.TP
\fBregistry broadcast \fIkeyName\fR ?\fB\-timeout \fImilliseconds\fR?
.
Sends a broadcast message to the system and running programs to notify them
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
91
92
93
94
95
96
97

98
99
100
101
102
103
104
105







-
+







data, see \fBSUPPORTED TYPES\fR, below.
.TP
\fBregistry keys \fIkeyName\fR ?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of names of all the
subkeys of \fIkeyName\fR.  If \fIpattern\fR is specified, only those
names matching \fIpattern\fR are returned.  Matching is determined
using the same rules as for \fBstring match\fR.  If the
using the same rules as for \fBstring\fR \fBmatch\fR.  If the
specified \fIkeyName\fR does not exist, then an error is generated.
.TP
\fBregistry set \fIkeyName\fR ?\fIvalueName data \fR?\fItype\fR??
.
If \fIvalueName\fR is not specified, creates the key \fIkeyName\fR if
it does not already exist.  If \fIvalueName\fR is specified, creates
the key \fIkeyName\fR and value \fIvalueName\fR if necessary.  The
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129







-
+







\fBSUPPORTED TYPES\fR, below.
.TP
\fBregistry values \fIkeyName\fR ?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of names of all the
values of \fIkeyName\fR.  If \fIpattern\fR is specified, only those
names matching \fIpattern\fR are returned.  Matching is determined
using the same rules as for \fBstring match\fR.
using the same rules as for \fBstring\fR \fBmatch\fR.
.SH "SUPPORTED TYPES"
Each value under a key in the registry contains some data of a
particular type in a type-specific representation.  The \fBregistry\fR
command converts between this internal representation and one that can
be manipulated by Tcl scripts.  In most cases, the data is simply
returned as a Tcl string.  The type indicates the intended use for the
data, but does not actually change the representation.  For some
146
147
148
149
150
151
152
153

154
155
156
157
158
159
160
140
141
142
143
144
145
146

147
148
149
150
151
152
153
154







-
+







.
The registry value contains arbitrary binary data with no defined
type.  The data is represented exactly in Tcl, including any embedded
nulls.
.TP
\fBsz\fR
.
The registry value contains a null-terminated string.  The data is
The registry value contains a null-terminated string.  The data is 
represented in Tcl as a string.
.TP
\fBexpand_sz\fR
.
The registry value contains a null-terminated string that contains
unexpanded references to environment variables in the normal Windows
style (for example,
207
208
209
210
211
212
213
214
215
216
201
202
203
204
205
206
207










-
-
-
# Read the command!
set command [\fBregistry get\fR $path {}]

puts "$ext opens with $command"
.CE
.SH KEYWORDS
registry
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/regsub.n.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH regsub n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
regsub \- Perform substitutions based on regular expression pattern matching
.SH SYNOPSIS
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
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










-
+

-










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

-



-
+

-














-
+

-







-
+

-










-
+

-



-
+

-

-
+
+


+





-
+

-












-



-



-






-






-














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
+
+
+

-
+
-
-
-
with the Tcl parser's use of backslashes, so it is generally
safest to enclose \fIsubSpec\fR in braces if it includes
backslashes.
.LP
If the initial arguments to \fBregsub\fR start with \fB\-\fR then
they are treated as switches.  The following switches are
currently supported:
.TP
.TP 10
\fB\-all\fR
.
All ranges in \fIstring\fR that match \fIexp\fR are found and
substitution is performed for each of these ranges.
Without this switch only the first
matching range is found and substituted.
If \fB\-all\fR is specified, then
.QW &
and
.QW \e\fIn\fR
sequences are handled for each substitution using the information
from the corresponding match.
.TP
.TP 15
\fB\-command\fR
.VS 8.7
Changes the handling of \fIsubSpec\fR so that it is not treated
as a template for a substitution string and the substrings
.QW &
and
.QW \e\fIn\fR
no longer have special meaning. Instead \fIsubSpec\fR must be a
command prefix, that is, a non-empty list.  The substring of \fIstring\fR
that matches \fIexp\fR, and then each substring that matches each
capturing sub-RE within \fIexp\fR are appended as additional elements
to that list. (The items appended to the list are much like what
\fBregexp\fR \fB-inline\fR would return).  The completed list is then
evaluated as a Tcl command, and the result of that command is the
substitution string.  Any error or exception from command evaluation
becomes an error or exception from the \fBregsub\fR command.
.RS
.PP
If \fB\-all\fR is not also given, the command callback will be invoked at most
once (exactly when the regular expression matches). If \fB\-all\fR is given,
the command callback will be invoked for each matched location, in sequence.
The exact location indices that matched are not made available to the script.
.PP
See \fBEXAMPLES\fR below for illustrative cases.
.RE
.VE 8.7
.TP
\fB\-expanded\fR
.
Enables use of the expanded regular expression syntax where
whitespace and comments are ignored.  This is the same as specifying
the \fB(?x)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP
.TP 15
\fB\-line\fR
.
Enables newline-sensitive matching.  By default, newline is a
completely ordinary character with no special meaning.  With this flag,
.QW [^
bracket expressions and
.QW .
never match newline,
.QW ^
matches an empty string after any newline in addition to its normal
function, and
.QW $
matches an empty string before any newline in
addition to its normal function.  This flag is equivalent to
specifying both \fB\-linestop\fR and \fB\-lineanchor\fR, or the
\fB(?n)\fR embedded option (see the \fBre_syntax\fR manual page).
.TP
.TP 15
\fB\-linestop\fR
.
Changes the behavior of
.QW [^
bracket expressions and
.QW .
so that they
stop at newlines.  This is the same as specifying the \fB(?p)\fR
embedded option (see the \fBre_syntax\fR manual page).
.TP
.TP 15
\fB\-lineanchor\fR
.
Changes the behavior of
.QW ^
and
.QW $
(the
.QW anchors )
so they match the
beginning and end of a line respectively.  This is the same as
specifying the \fB(?w)\fR embedded option (see the \fBre_syntax\fR
manual page).
.TP
.TP 10
\fB\-nocase\fR
.
Upper-case characters in \fIstring\fR will be converted to lower-case
before matching against \fIexp\fR;  however, substitutions specified
by \fIsubSpec\fR use the original unconverted form of \fIstring\fR.
.TP
.TP 10
\fB\-start\fR \fIindex\fR
.
Specifies a character index offset into the string to start
matching the regular expression at.
matching the regular expression at.  
.VS 8.5
The \fIindex\fR value is interpreted in the same manner
as the \fIindex\fR argument to \fBstring index\fR.
.VE 8.5
When using this switch,
.QW ^
will not match the beginning of the line, and \eA will still
match the start of the string at \fIindex\fR.
\fIindex\fR will be constrained to the bounds of the input string.
.TP
.TP 10
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as \fIexp\fR even if it starts with a \fB\-\fR.
.PP
If \fIvarName\fR is supplied, the command returns a count of the
number of matching ranges that were found and replaced, otherwise the
string after replacement is returned.
See the manual entry for \fBregexp\fR for details on the interpretation
of regular expressions.
.SH EXAMPLES
.PP
Replace (in the string in variable \fIstring\fR) every instance of
\fBfoo\fR which is a word by itself with \fBbar\fR:
.PP
.CS
\fBregsub\fR -all {\emfoo\eM} $string bar string
.CE
.PP
or (using the
.QW "basic regular expression"
syntax):
.PP
.CS
\fBregsub\fR -all {(?b)\e<foo\e>} $string bar string
.CE
.PP
Insert double-quotes around the first instance of the word
\fBinteresting\fR, however it is capitalized.
.PP
.CS
\fBregsub\fR -nocase {\eyinteresting\ey} $string {"&"} string
.CE
.PP
Convert all non-ASCII and Tcl-significant characters into \eu escape
sequences by using \fBregsub\fR and \fBsubst\fR in combination:
.PP
.CS
# This RE is just a character class for almost everything "bad"
set RE {[][{};#\e\e\e$ \er\et\eu0080-\euffff]}

# We will substitute with a fragment of Tcl script in brackets
set substitution {[format \e\e\e\eu%04x [scan "\e\e&" %c]]}

# Now we apply the substitution to get a subst-string that
# will perform the computational parts of the conversion. Note
# that newline is handled specially through \fBstring map\fR since
# backslash-newline is a special sequence.
set quoted [subst [string map {\en {\e\eu000a}} \e
        [\fBregsub\fR -all $RE $string $substitution]]]
.CE
.PP
.VS 8.7
The above operation can be done using \fBregsub \-command\fR instead, which is
often faster. (A full pre-computed \fBstring map\fR would be faster still, but
the cost of computing the map for a transformation as complex as this can be
quite large.)
.PP
.CS
# This RE is just a character class for everything "bad"
set RE {[][{};#\e\e\e$\es\eu0080-\euffff]}

# This encodes what the RE described above matches
proc encodeChar {ch} {
    # newline is handled specially since backslash-newline is a
    # special sequence.
    if {$ch eq "\en"} {
        return "\e\eu000a"
    }
    # No point in writing this as a one-liner
    scan $ch %c charNumber
    format "\e\eu%04x" $charNumber
}

set quoted [\fBregsub\fR -all -command $RE $string encodeChar]
.CE
.PP
Decoding a URL-encoded string using \fBregsub \-command\fR, a lambda term and
the \fBapply\fR command.
.PP
.CS
# Match one of the sequences in a URL-encoded string that needs
# fixing, converting + to space and %XX to the right character
# (e.g., %7e becomes ~)
set RE {(\e+)|%([0-9A-Fa-f]{2})}

# Note that -command uses a command prefix, not a command name
set decoded [\fBregsub\fR -all -command $RE $string {apply {{- p h} {
    # + is a special case; handle directly
    if {$p eq "+"} {
        return " "
    }
    # convert hex to a char
    scan $h %x charNumber
    format %c $charNumber
}}}]
.CE
.VE 8.7
.SH "SEE ALSO"
regexp(n), re_syntax(n), subst(n), string(n)
regexp(n), re_syntax(n), subst(n),
.VS 8.5
string(n)
.VE
.SH KEYWORDS
match, pattern, quoting, regular expression, substitution
match, pattern, quoting, regular expression, substitute
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/rename.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

44
45
46
47
48
49
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










-
+









+











-



-









+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH rename n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
rename \- Rename or delete a command
.SH SYNOPSIS
\fBrename \fIoldName newName\fR
.BE

.SH DESCRIPTION
.PP
Rename the command that used to be called \fIoldName\fR so that it
is now called \fInewName\fR.
If \fInewName\fR is an empty string then \fIoldName\fR is deleted.
\fIoldName\fR and \fInewName\fR may include namespace qualifiers
(names of containing namespaces).
If a command is renamed into a different namespace,
future invocations of it will execute in the new namespace.
The \fBrename\fR command returns an empty string as result.
.SH EXAMPLE
.PP
The \fBrename\fR command can be used to wrap the standard Tcl commands
with your own monitoring machinery.  For example, you might wish to
count how often the \fBsource\fR command is called:
.PP
.CS
\fBrename\fR ::source ::theRealSource
set sourceCount 0
proc ::source args {
    global sourceCount
    puts "called source for the [incr sourceCount]'th time"
    uplevel 1 ::theRealSource $args
}
.CE

.SH "SEE ALSO"
namespace(n), proc(n)

.SH KEYWORDS
command, delete, namespace, rename
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/return.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
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
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







-
+


















-
+




















-
+
-



-
+
-


-
+


-
+
-




-
+
-




-
+
-





-
















+








+






-






-
+




-




-
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+









+


-
+



+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2003.  (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.
'\"
'\" 
.TH return n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
return \- Return from a procedure, or set return code of a script
.SH SYNOPSIS
\fBreturn \fR?\fIresult\fR?
.sp
\fBreturn \fR?\fB\-code \fIcode\fR? ?\fIresult\fR?
.sp
\fBreturn \fR?\fIoption value \fR...? ?\fIresult\fR?
.BE
.SH DESCRIPTION
.PP
In its simplest usage, the \fBreturn\fR command is used without options
in the body of a procedure to immediately return control to the caller
of the procedure.  If a \fIresult\fR argument is provided, its value
becomes the result of the procedure passed back to the caller.
becomes the result of the procedure passed back to the caller.  
If \fIresult\fR is not specified then an empty string will be returned
to the caller as the result of the procedure.
.PP
The \fBreturn\fR command serves a similar function within script
files that are evaluated by the \fBsource\fR command.  When \fBsource\fR
evaluates the contents of a file as a script, an invocation of
the \fBreturn\fR command will cause script evaluation
to immediately cease, and the value \fIresult\fR (or an empty string)
will be returned as the result of the \fBsource\fR command.
.SH "EXCEPTIONAL RETURN CODES"
.PP
In addition to the result of a procedure, the return
code of a procedure may also be set by \fBreturn\fR
through use of the \fB\-code\fR option.
In the usual case where the \fB\-code\fR option is not
specified the procedure will return normally.
However, the \fB\-code\fR option may be used to generate an
exceptional return from the procedure.
\fICode\fR may have any of the following values:
.TP 13
\fBok\fR (or \fB0\fR)
\fBok (or 0)\fR
.
Normal return:  same as if the option is omitted.  The return code
of the procedure is 0 (\fBTCL_OK\fR).
.TP 13
\fBerror\fR (or \fB1\fR)
\fBerror (1)\fR
.
Error return: the return code of the procedure is 1 (\fBTCL_ERROR\fR).
The procedure command behaves in its calling context as if it
were the command \fBerror\fR \fIresult\fR.  See below for additional
were the command \fBerror \fIresult\fR.  See below for additional
options.
.TP 13
\fBreturn\fR (or \fB2\fR)
\fBreturn (2)\fR
.
The return code of the procedure is 2 (\fBTCL_RETURN\fR).  The
procedure command behaves in its calling context as if it
were the command \fBreturn\fR (with no arguments).
.TP 13
\fBbreak\fR (or \fB3\fR)
\fBbreak (3)\fR
.
The return code of the procedure is 3 (\fBTCL_BREAK\fR).  The
procedure command behaves in its calling context as if it
were the command \fBbreak\fR.
.TP 13
\fBcontinue\fR (or \fB4\fR)
\fBcontinue (4)\fR
.
The return code of the procedure is 4 (\fBTCL_CONTINUE\fR).  The
procedure command behaves in its calling context as if it
were the command \fBcontinue\fR.
.TP 13
\fIvalue\fR
.
\fIValue\fR must be an integer;  it will be returned as the
return code for the current procedure.
.LP
When a procedure wants to signal that it has received invalid
arguments from its caller, it may use \fBreturn -code error\fR
with \fIresult\fR set to a suitable error message.  Otherwise
usage of the \fBreturn -code\fR option is mostly limited to
procedures that implement a new control structure.
.PP
The \fBreturn \-code\fR command acts similarly within script
files that are evaluated by the \fBsource\fR command.  During the
evaluation of the contents of a file as a script by \fBsource\fR,
an invocation of the \fBreturn \-code \fIcode\fR command will cause
the return code of \fBsource\fR to be \fIcode\fR.
.SH "RETURN OPTIONS"
.PP
.VS 8.5
In addition to a result and a return code, evaluation of a command
in Tcl also produces a dictionary of return options.  In general
usage, all \fIoption value\fR pairs given as arguments to \fBreturn\fR
become entries in the return options dictionary, and any values at all
are acceptable except as noted below.  The \fBcatch\fR command may be
used to capture all of this information \(em the return code, the result,
and the return options dictionary \(em that arise from evaluation of a
script.
.VE 8.5
.PP
As documented above, the \fB\-code\fR entry in the return options dictionary
receives special treatment by Tcl.  There are other return options also
recognized and treated specially by Tcl.  They are:
.TP
\fB\-errorcode \fIlist\fR
.
The \fB\-errorcode\fR option receives special treatment only when the value
of the \fB\-code\fR option is \fBTCL_ERROR\fR.  Then the \fIlist\fR value
is meant to be additional information about the error,
presented as a Tcl list for further processing by programs.
If no \fB\-errorcode\fR option is provided to \fBreturn\fR when
the \fB\-code error\fR option is provided, Tcl will set the value
of the \fB\-errorcode\fR entry in the return options dictionary
of the \fB\-errorcode\fR entry in the return options dictionary 
to the default value of \fBNONE\fR.  The \fB\-errorcode\fR return
option will also be stored in the global variable \fBerrorCode\fR.
.TP
\fB\-errorinfo \fIinfo\fR
.
The \fB\-errorinfo\fR option receives special treatment only when the value
of the \fB\-code\fR option is \fBTCL_ERROR\fR.  Then \fIinfo\fR is the initial
stack trace, meant to provide to a human reader additional information
about the context in which the error occurred.  The stack trace will
also be stored in the global variable \fBerrorInfo\fR.
also be stored in the global variable \fBerrorInfo\fR.  
If no \fB\-errorinfo\fR option is provided to \fBreturn\fR when
the \fB\-code error\fR option is provided, Tcl will provide its own
initial stack trace value in the entry for \fB\-errorinfo\fR.  Tcl's
initial stack trace will include only the call to the procedure, and
stack unwinding will append information about higher stack levels, but
there will be no information about the context of the error within
the procedure.  Typically the \fIinfo\fR value is supplied from
the value of \fB\-errorinfo\fR in a return options dictionary captured
by the \fBcatch\fR command (or from the copy of that information
stored in the global variable \fBerrorInfo\fR).
.TP
\fB\-errorstack \fIlist\fR
The \fB\-errorstack\fR option receives special treatment only when the value
of the \fB\-code\fR option is \fBTCL_ERROR\fR.  Then \fIlist\fR is the initial
error stack, recording actual argument values passed to each proc level.  The error stack will
also be reachable through \fBinfo errorstack\fR.
If no \fB\-errorstack\fR option is provided to \fBreturn\fR when
the \fB\-code error\fR option is provided, Tcl will provide its own
initial error stack in the entry for \fB\-errorstack\fR.  Tcl's
initial error stack will include only the call to the procedure, and
stack unwinding will append information about higher stack levels, but
there will be no information about the context of the error within
the procedure.  Typically the \fIlist\fR value is supplied from
the value of \fB\-errorstack\fR in a return options dictionary captured
by the \fBcatch\fR command (or from the copy of that information from
\fBinfo errorstack\fR).
.TP
\fB\-level \fIlevel\fR
.
.VS 8.5
The \fB\-level\fR and \fB\-code\fR options work together to set the return
code to be returned by one of the commands currently being evaluated.
The \fIlevel\fR value must be a non-negative integer representing a number
of levels on the call stack.  It defines the number of levels up the stack
at which the return code of a command currently being evaluated should
be \fIcode\fR.  If no \fB\-level\fR option is provided, the default value
of \fIlevel\fR is 1, so that \fBreturn\fR sets the return code that the
current procedure returns to its caller, 1 level up the call stack.  The
mechanism by which these options work is described in more detail below.
.VE 8.5
.TP
\fB\-options \fIoptions\fR
.
.VS 8.5
The value \fIoptions\fR must be a valid dictionary.  The entries of that
dictionary are treated as additional \fIoption value\fR pairs for the
\fBreturn\fR command.
.VE 8.5
.SH "RETURN CODE HANDLING MECHANISMS"
.PP
Return codes are used in Tcl to control program flow.  A Tcl script
is a sequence of Tcl commands.  So long as each command evaluation
returns a return code of \fBTCL_OK\fR, evaluation will continue to the next
command in the script.  Any exceptional return code (non-\fBTCL_OK\fR)
returned by a command evaluation causes the flow on to the next
190
191
192
193
194
195
196

197
198
199

200
201
202
203
204
205
206
170
171
172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187







+


-
+







Tcl commands that provide loops \(em such as \fBwhile\fR, \fBfor\fR,
and \fBforeach\fR \(em evaluate a script that is the body of the
loop.  If evaluation of the loop body returns the return code
of \fBTCL_BREAK\fR or \fBTCL_CONTINUE\fR, the loop command can react in such
a way as to give the \fBbreak\fR and \fBcontinue\fR commands
their documented interpretation in loops.
.PP
.VS 8.5
Procedure invocation also involves evaluation of a script, the body
of the procedure.  Procedure invocation provides special treatment
when evaluation of the procedure body returns the return code
when evaluation of the procedure body returns the return code 
\fBTCL_RETURN\fR.  In that circumstance, the \fB\-level\fR entry in the
return options dictionary is decremented.  If after decrementing,
the value of the \fB\-level\fR entry is 0, then the value of
the \fB\-code\fR entry becomes the return code of the procedure.
If after decrementing, the value of the \fB\-level\fR entry is
greater than zero, then the return code of the procedure is
\fBTCL_RETURN\fR.  If the procedure invocation occurred during the
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
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










+

-


-


-
-
-
+
+
+





-







-


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




-


-
+



+

-
+
-






-


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





-


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


+

-
+
-

-
+
-
-
-
special handling by procedure invocation.  If \fBreturn\fR
is provided the option \fB\-level 0\fR, then the return code
of the \fBreturn\fR command itself will be the value \fIcode\fR
of the \fB\-code\fR option (or \fBTCL_OK\fR by default).  Any other value
for the \fB\-level\fR option (including the default value of 1)
will cause the return code of the \fBreturn\fR command itself
to be \fBTCL_RETURN\fR, triggering a return from the enclosing procedure.
.VE 8.5
.SH EXAMPLES
.PP
First, a simple example of using \fBreturn\fR to return from a
procedure, interrupting the procedure body.
.PP
.CS
proc printOneLine {} {
    puts "line 1"    ;# This line will be printed.
    \fBreturn\fR
    puts "line 2"    ;# This line will not be printed.
   puts "line 1"    ;# This line will be printed.
   \fBreturn\fR		
   puts "line 2"    ;# This line will not be printed.
}
.CE
.PP
Next, an example of using \fBreturn\fR to set the value
returned by the procedure.
.PP
.CS
proc returnX {} {\fBreturn\fR X}
puts [returnX]    ;# prints "X"
.CE
.PP
Next, a more complete example, using \fBreturn -code error\fR
to report invalid arguments.
.PP
.CS
proc factorial {n} {
    if {![string is integer $n] || ($n < 0)} {
        \fBreturn\fR -code error \e
                "expected non-negative integer,\e
                but got \e"$n\e""
    }
    if {$n < 2} {
        \fBreturn\fR 1
    }
    set m [expr {$n - 1}]
    set code [catch {factorial $m} factor]
    if {$code != 0} {
        \fBreturn\fR -code $code $factor
    }
    set product [expr {$n * $factor}]
    if {$product < 0} {
        \fBreturn\fR -code error \e
                "overflow computing factorial of $n"
    }
    \fBreturn\fR $product
   if {![string is integer $n] || ($n < 0)} {
      \fBreturn\fR -code error \e
            "expected non-negative integer,\e
             but got \e"$n\e""
   }
   if {$n < 2} {
      \fBreturn\fR 1
   }
   set m [expr {$n - 1}]
   set code [catch {factorial $m} factor]
   if {$code != 0} {
      \fBreturn\fR -code $code $factor
   }
   set product [expr {$n * $factor}]
   if {$product < 0} {
      \fBreturn\fR -code error \e
            "overflow computing factorial of $n"
   }
   \fBreturn\fR $product
}
.CE
.PP
Next, a procedure replacement for \fBbreak\fR.
.PP
.CS
proc myBreak {} {
    \fBreturn\fR -code break
   \fBreturn\fR -code break
}
.CE
.PP
.VS 8.5
With the \fB\-level 0\fR option, \fBreturn\fR itself can serve
as a replacement for \fBbreak\fR, with the help of \fBinterp alias\fR.
as a replacement for \fBbreak\fR.
.PP
.CS
interp alias {} Break {} \fBreturn\fR -level 0 -code break
.CE
.PP
An example of using \fBcatch\fR and \fBreturn -options\fR to
re-raise a caught error:
.PP
.CS
proc doSomething {} {
    set resource [allocate]
    catch {
        # Long script of operations
        # that might raise an error
    } result options
    deallocate $resource
    \fBreturn\fR -options $options $result
   set resource [allocate]
   catch {
      # Long script of operations
      # that might raise an error
   } result options
   deallocate $resource
   \fBreturn\fR -options $options $result
}
.CE
.PP
Finally an example of advanced use of the \fBreturn\fR options
to create a procedure replacement for \fBreturn\fR itself:
.PP
.CS
proc myReturn {args} {
    set result ""
    if {[llength $args] % 2} {
        set result [lindex $args end]
        set args [lrange $args 0 end-1]
    }
    set options [dict merge {-level 1} $args]
    dict incr options -level
    \fBreturn\fR -options $options $result
   set result ""
   if {[llength $args] % 2} {
      set result [lindex $args end]
      set args [lrange $args 0 end-1]
   }
   set options [dict merge {-level 1} $args]
   dict incr options -level
   \fBreturn\fR -options $options $result
}
.CE
.VE 8.5
.SH "SEE ALSO"
break(n), catch(n), continue(n), dict(n), error(n), errorCode(n),
break(n), catch(n), continue(n), dict(n), error(n), proc(n), source(n), tclvars(n)
errorInfo(n), proc(n), source(n), throw(n), try(n)
.SH KEYWORDS
break, catch, continue, error, exception, procedure, result, return
break, catch, continue, error, procedure, return
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/safe.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
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
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





-
+





-
+

-
+

-
+

-
+

-
+

-
+

-
+














-
+

-
+





-
+








-
-
+
+




-
+


-
+

-
+





-
+

-
-
-
-
-
-

-
+

-
-
+
+
-
-

-
+


-
+



-
+



















-
-
-
+
+
+




-
+







-
+




-
+

-
+







-
+







'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
safe \- Creating and manipulating safe interpreters
Safe\ Base \- A mechanism for creating and manipulating safe interpreters
.SH SYNOPSIS
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
.sp
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
.sp
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
.sp
\fB::safe::interpDelete\fR \fIchild\fR
\fB::safe::interpDelete\fR \fIslave\fR
.sp
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
.sp
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
.sp
\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
.SS OPTIONS
.PP
?\fB\-accessPath\fR \fIpathList\fR?
?\fB\-statics\fR \fIboolean\fR? ?\fB\-noStatics\fR?
?\fB\-nested\fR \fIboolean\fR? ?\fB\-nestedLoadOk\fR?
?\fB\-deleteHook\fR \fIscript\fR?
.BE
.SH DESCRIPTION
Safe Tcl is a mechanism for executing untrusted Tcl scripts
safely and for providing mediated access by such scripts to
potentially dangerous functionality.
.PP
Safe Tcl ensures that untrusted Tcl scripts cannot harm the
The Safe Base ensures that untrusted Tcl scripts cannot harm the
hosting application.
It prevents integrity and privacy attacks. Untrusted Tcl
The Safe Base prevents integrity and privacy attacks. Untrusted Tcl
scripts are prevented from corrupting the state of the hosting
application or computer. Untrusted scripts are also prevented from
disclosing information stored on the hosting computer or in the
hosting application to any party.
.PP
Safe Tcl allows a parent interpreter to create safe, restricted
The Safe Base allows a master interpreter to create safe, restricted
interpreters that contain a set of predefined aliases for the \fBsource\fR,
\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
are able to use the auto-loading and package mechanisms.
.PP
No knowledge of the file system structure is leaked to the
safe interpreter, because it has access only to a virtualized path
containing tokens. When the safe interpreter requests to source a file, it
uses the token in the virtual path as part of the file name to source; the
parent interpreter transparently
translates the token into a real directory name and executes the
master interpreter transparently 
translates the token into a real directory name and executes the 
requested operation (see the section \fBSECURITY\fR below for details).
Different levels of security can be selected by using the optional flags
of the commands described below.
.PP
All commands provided in the parent interpreter by Safe Tcl reside in
All commands provided in the master interpreter by the Safe Base reside in
the \fBsafe\fR namespace.
.SH COMMANDS
The following commands are provided in the parent interpreter:
The following commands are provided in the master interpreter:
.TP
\fB::safe::interpCreate\fR ?\fIchild\fR? ?\fIoptions...\fR?
\fB::safe::interpCreate\fR ?\fIslave\fR? ?\fIoptions...\fR?
Creates a safe interpreter, installs the aliases described in the section
\fBALIASES\fR and initializes the auto-loading and package mechanism as
specified by the supplied \fIoptions\fR.
See the \fBOPTIONS\fR section below for a description of the
optional arguments.
If the \fIchild\fR argument is omitted, a name will be generated.
If the \fIslave\fR argument is omitted, a name will be generated.
\fB::safe::interpCreate\fR always returns the interpreter name.
.sp
The interpreter name \fIchild\fR may include namespace separators,
but may not have leading or trailing namespace separators, or excess
colon characters in namespace separators.  The interpreter name is
qualified relative to the global namespace ::, not the namespace in which
the \fB::safe::interpCreate\fR command is evaluated.
.TP
\fB::safe::interpInit\fR \fIchild\fR ?\fIoptions...\fR?
\fB::safe::interpInit\fR \fIslave\fR ?\fIoptions...\fR?
This command is similar to \fBinterpCreate\fR except it that does not
create the safe interpreter. \fIchild\fR must have been created by some
other means, like \fBinterp create\fR \fB\-safe\fR.  The interpreter
create the safe interpreter. \fIslave\fR must have been created by some
other means, like \fBinterp create \-safe\fR.
name \fIchild\fR may include namespace separators, subject to the same
restrictions as for \fBinterpCreate\fR.
.TP
\fB::safe::interpConfigure\fR \fIchild\fR ?\fIoptions...\fR?
\fB::safe::interpConfigure\fR \fIslave\fR ?\fIoptions...\fR?
If no \fIoptions\fR are given, returns the settings for all options for the
named safe interpreter as a list of options and their current values
for that \fIchild\fR.
for that \fIslave\fR. 
If a single additional argument is provided,
it will return a list of 2 elements \fIname\fR and \fIvalue\fR where
\fIname\fR is the full name of that option and \fIvalue\fR the current value
for that option and the \fIchild\fR.
for that option and the \fIslave\fR.
If more than two additional arguments are provided, it will reconfigure the
safe interpreter and change each and only the provided options.
See the section on \fBOPTIONS\fR below for options description.
Example of use:
.RS
.PP
.CS
# Create new interp with the same configuration as "$i0":
set i1 [safe::interpCreate {*}[safe::interpConfigure $i0]]

# Get the current deleteHook
set dh [safe::interpConfigure $i0  \-del]

# Change (only) the statics loading ok attribute of an
# interp and its deleteHook (leaving the rest unchanged):
safe::interpConfigure $i0  \-delete {foo bar} \-statics 0
.CE
.RE
.TP
\fB::safe::interpDelete\fR \fIchild\fR
Deletes the safe interpreter and cleans up the corresponding
parent interpreter data structures.
\fB::safe::interpDelete\fR \fIslave\fR
Deletes the safe interpreter and cleans up the corresponding  
master interpreter data structures.
If a \fIdeleteHook\fR script was specified for this interpreter it is
evaluated before the interpreter is deleted, with the name of the
interpreter as an additional argument.
.TP
\fB::safe::interpFindInAccessPath\fR \fIchild\fR \fIdirectory\fR
\fB::safe::interpFindInAccessPath\fR \fIslave\fR \fIdirectory\fR
This command finds and returns the token for the real directory
\fIdirectory\fR in the safe interpreter's current virtual access path.
It generates an error if the directory is not found.
Example of use:
.RS
.PP
.CS
$child eval [list set tk_library \e
$slave eval [list set tk_library \e
      [::safe::interpFindInAccessPath $name $tk_library]]
.CE
.RE
.TP
\fB::safe::interpAddToAccessPath\fR \fIchild\fR \fIdirectory\fR
\fB::safe::interpAddToAccessPath\fR \fIslave\fR \fIdirectory\fR
This command adds \fIdirectory\fR to the virtual path maintained for the
safe interpreter in the parent, and returns the token that can be used in
safe interpreter in the master, and returns the token that can be used in
the safe interpreter to obtain access to files in that directory.
If the directory is already in the virtual path, it only returns the token
without adding the directory to the virtual path again.
Example of use:
.RS
.PP
.CS
$child eval [list set tk_library \e
$slave eval [list set tk_library \e
      [::safe::interpAddToAccessPath $name $tk_library]]
.CE
.RE
.TP
\fB::safe::setLogCmd\fR ?\fIcmd arg...\fR?
This command installs a script that will be called when interesting
life cycle events occur for a safe interpreter.
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
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







-
-
-
-
+
+
+
+



-
-
+
+

-
+


-
+





-
-
+
+





-
+










-
+







-
+


-
+







.PP
Below is the output of a sample session in which a safe interpreter
attempted to source a file not found in its virtual access path.
Note that the safe interpreter only received an error message saying that
the file was not found:
.PP
.CS
NOTICE for child interp10 : Created
NOTICE for child interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
NOTICE for child interp10 : auto_path in interp10 has been set to {$p(:0:)}
ERROR for child interp10 : /foo/bar/init.tcl: no such file or directory
NOTICE for slave interp10 : Created
NOTICE for slave interp10 : Setting accessPath=(/foo/bar) staticsok=1 nestedok=0 deletehook=()
NOTICE for slave interp10 : auto_path in interp10 has been set to {$p(:0:)}
ERROR for slave interp10 : /foo/bar/init.tcl: no such file or directory
.CE
.RE
.SS OPTIONS
The following options are common to
\fB::safe::interpCreate\fR, \fB::safe::interpInit\fR,
The following options are common to 
\fB::safe::interpCreate\fR, \fB::safe::interpInit\fR, 
and \fB::safe::interpConfigure\fR.
Any option name can be abbreviated to its minimal
Any option name can be abbreviated to its minimal 
non-ambiguous name.
Option names are not case sensitive.
.TP
.TP 
\fB\-accessPath\fR \fIdirectoryList\fR
This option sets the list of directories from which the safe interpreter
can \fBsource\fR and \fBload\fR files.
If this option is not specified, or if it is given as the
empty list, the safe interpreter will use the same directories as its
parent for auto-loading.
See the section \fBSECURITY\fR below for more detail about virtual paths,
master for auto-loading.
See the section \fBSECURITY\fR below for more detail about virtual paths, 
tokens and access control.
.TP
\fB\-statics\fR \fIboolean\fR
This option specifies if the safe interpreter will be allowed
to load statically linked packages (like \fBload {} Tk\fR).
The default value is \fBtrue\fR :
The default value is \fBtrue\fR : 
safe interpreters are allowed to load statically linked packages.
.TP
\fB\-noStatics\fR
This option is a convenience shortcut for \fB\-statics false\fR and
thus specifies that the safe interpreter will not be allowed
to load statically linked packages.
.TP
\fB\-nested\fR \fIboolean\fR
This option specifies if the safe interpreter will be allowed
to load packages into its own sub-interpreters.
The default value is \fBfalse\fR :
The default value is \fBfalse\fR : 
safe interpreters are not allowed to load packages into
their own sub-interpreters.
.TP
\fB\-nestedLoadOk\fR
This option is a convenience shortcut for \fB\-nested true\fR and
thus specifies the safe interpreter will be allowed
to load packages into its own sub-interpreters.
.TP
.TP 
\fB\-deleteHook\fR \fIscript\fR
When this option is given a non-empty \fIscript\fR, it will be
evaluated in the parent with the name of
evaluated in the master with the name of
the safe interpreter as an additional argument
just before actually deleting the safe interpreter.
Giving an empty value removes any currently installed deletion hook
script for that safe interpreter.
The default value (\fB{}\fR) is not to have any deletion call back.
.SH ALIASES
The following aliases are provided in a safe interpreter:
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
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







-
+





-
+













-
-
+
+



-
+




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







the system encoding, but allows all other subcommands including
\fBsystem\fR to check the current encoding.
.TP
\fBexit\fR
The calling interpreter is deleted and its computation is stopped, but the
Tcl process in which this interpreter exists is not terminated.
.SH SECURITY
Safe Tcl does not attempt to completely prevent annoyance and
The Safe Base does not attempt to completely prevent annoyance and
denial of service attacks. These forms of attack prevent the
application or user from temporarily using the computer to perform
useful work, for example by consuming all available CPU time or
all available screen real estate.
These attacks, while aggravating, are deemed to be of lesser importance
in general than integrity and privacy attacks that Safe Tcl
in general than integrity and privacy attacks that the Safe Base
is to prevent.
.PP
The commands available in a safe interpreter, in addition to
the safe set as defined in \fBinterp\fR manual page, are mediated aliases
for \fBsource\fR, \fBload\fR, \fBexit\fR, and safe subsets of
\fBfile\fR and \fBencoding\fR. The safe interpreter can also auto-load
code and it can request that packages be loaded.
.PP
Because some of these commands access the local file system, there is a
potential for information leakage about its directory structure.
To prevent this, commands that take file names as arguments in a safe
interpreter use tokens instead of the real directory names.
These tokens are translated to the real directory name while a request to,
e.g., source a file is mediated by the parent interpreter.
This virtual path system is maintained in the parent interpreter for each safe
e.g., source a file is mediated by the master interpreter.
This virtual path system is maintained in the master interpreter for each safe
interpreter created by \fB::safe::interpCreate\fR or initialized by
\fB::safe::interpInit\fR and
the path maps tokens accessible in the safe interpreter into real path
names on the local file system thus preventing safe interpreters
names on the local file system thus preventing safe interpreters 
from gaining knowledge about the
structure of the file system of the host on which the interpreter is
executing.
The only valid file names arguments
for the \fBsource\fR and \fBload\fR aliases provided to the child
are path in the form of
\fB[file join \fItoken filename\fB]\fR (i.e. when using the
native file path formats: \fItoken\fB/\fIfilename\fR
on Unix and \fItoken\fB\e\fIfilename\fR on Windows),
where \fItoken\fR is representing one of the directories
for the \fBsource\fR and \fBload\fR aliases provided to the slave
are path in the form of 
\fB[file join \fR\fItoken filename\fR\fB]\fR (i.e. when using the
native file path formats: \fItoken\fR\fB/\fR\fIfilename\fR
on Unix and \fItoken\fR\fB\e\fIfilename\fR on Windows),
where \fItoken\fR is representing one of the directories 
of the \fIaccessPath\fR list and \fIfilename\fR is
one file in that directory (no sub directories access are allowed).
.PP
When a token is used in a safe interpreter in a request to source or
load a file, the token is checked and
translated to a real path name and the file to be
sourced or loaded is located on the file system.
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
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










-
-
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

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

-
+










-
-
+
+
-
-
-
must end up with the extension
.PQ \fB.tcl\fR
or be called
.PQ \fBtclIndex\fR .
.PP
Each element of the initial access path
list will be assigned a token that will be set in
the child \fBauto_path\fR and the first element of that list will be set as
the \fBtcl_library\fR for that child.
the slave \fBauto_path\fR and the first element of that list will be set as
the \fBtcl_library\fR for that slave.
.PP
If the access path argument is not given or is the empty list,
the default behavior is to let the child access the same packages
as the parent has access to (Or to be more precise:
If the access path argument is not given or is the empty list, 
the default behavior is to let the slave access the same packages
as the master has access to (Or to be more precise: 
only packages written in Tcl (which by definition cannot be dangerous
as they run in the child interpreter) and C extensions that
provides a _SafeInit entry point). For that purpose, the parent's
\fBauto_path\fR will be used to construct the child access path.
In order that the child successfully loads the Tcl library files
as they run in the slave interpreter) and C extensions that
provides a _SafeInit entry point). For that purpose, the master's 
\fBauto_path\fR will be used to construct the slave access path. 
In order that the slave successfully loads the Tcl library files
(which includes the auto-loading mechanism itself) the \fBtcl_library\fR will be
added or moved to the first position if necessary, in the
child access path, so the child
\fBtcl_library\fR will be the same as the parent's (its real
path will still be invisible to the child though).
In order that auto-loading works the same for the child and
the parent in this by default case, the first-level
sub directories of each directory in the parent \fBauto_path\fR will
also be added (if not already included) to the child access path.
added or moved to the first position if necessary, in the 
slave access path, so the slave
\fBtcl_library\fR will be the same as the master's (its real
path will still be invisible to the slave though). 
In order that auto-loading works the same for the slave and
the master in this by default case, the first-level
sub directories of each directory in the master \fBauto_path\fR will
also be added (if not already included) to the slave access path.
You can always specify a more
restrictive path for which sub directories will never be searched by
restrictive path for which sub directories will never be searched by 
explicitly specifying your directory list with the \fB\-accessPath\fR flag
instead of relying on this default mechanism.
.PP
When the \fIaccessPath\fR is changed after the first creation or
initialization (i.e. through \fBinterpConfigure -accessPath \fR\fIlist\fR),
an \fBauto_reset\fR is automatically evaluated in the safe interpreter
to synchronize its \fBauto_index\fR with the new token list.
.SH "SEE ALSO"
interp(n), library(n), load(n), package(n), source(n), unknown(n)
.SH KEYWORDS
alias, auto\-loading, auto_mkindex, load, parent interpreter, safe
interpreter, child interpreter, source
alias, auto\-loading, auto_mkindex, load, master interpreter, safe
interpreter, slave interpreter, source
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/scan.n.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH scan n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
scan \- Parse string using conversion specifiers in the style of sscanf
.SH SYNOPSIS
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
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







-
+














-
+


-











-

+














-
+


-
+

-



-
+

-
-
+


-
+

-



-
+
-
-
-
-
-
-

-







-
-
+
+
-
-
+
+
+

-
+

-
-
+



-
+

-
-
+

-
+

-
-
+

-
-
+
+


-
+

-










-
+

-


-
-
+
+







-
+

-


-
+


-
+


-
+

-
+







performed.
.SH "DETAILS ON SCANNING"
.PP
\fBScan\fR operates by scanning \fIstring\fR and \fIformat\fR together.
If the next character in \fIformat\fR is a blank or tab then it
matches any number of white space characters in \fIstring\fR (including
zero).
Otherwise, if it is not a \fB%\fR character then it
Otherwise, if it is not a \fB%\fR character then it 
must match the next character of \fIstring\fR.
When a \fB%\fR is encountered in \fIformat\fR, it indicates
the start of a conversion specifier.
A conversion specifier contains up to four fields after the \fB%\fR:
a XPG3 position specifier (or a \fB*\fR to indicate the converted
value is to be discarded instead of assigned to any variable); a number
indicating a maximum substring width; a size modifier; and a
conversion character.
All of these fields are optional except for the conversion character.
The fields that are present must appear in the order given above.
.PP
When \fBscan\fR finds a conversion specifier in \fIformat\fR, it
first skips any white-space characters in \fIstring\fR (unless the
conversion character is \fB[\fR or \fBc\fR).
Then it converts the next input characters according to the
Then it converts the next input characters according to the 
conversion specifier and stores the result in the variable given
by the next argument to \fBscan\fR.
.SS "OPTIONAL POSITIONAL SPECIFIER"
.PP
If the \fB%\fR is followed by a decimal number and a \fB$\fR, as in
.QW \fB%2$d\fR ,
then the variable to use is not taken from the next
sequential argument.  Instead, it is taken from the argument indicated
by the number, where 1 corresponds to the first \fIvarName\fR.  If
there are any positional specifiers in \fIformat\fR then all of the
specifiers must be positional.  Every \fIvarName\fR on the argument
list must correspond to exactly one conversion specifier or an error
is generated, or in the inline case, any position can be specified
at most once and the empty positions will be filled in with empty strings.
.SS "OPTIONAL SIZE MODIFIER"
.PP
.VS 8.5
The size modifier field is used only when scanning a substring into
one of Tcl's integer values.  The size modifier field dictates the
integer range acceptable to be stored in a variable, or, for the inline
case, in a position in the result list.
The syntactically valid values for the size modifier are \fBh\fR, \fBL\fR,
\fBl\fR, and \fBll\fR.  The \fBh\fR size modifier value is equivalent
to the absence of a size modifier in the the conversion specifier.
Either one indicates the integer range to be stored is limited to
the same range produced by the \fBint()\fR function of the \fBexpr\fR
command.  The \fBL\fR size modifier is equivalent to the \fBl\fR size
modifier. Either one indicates the integer range to be stored is
limited to the same range produced by the \fBwide()\fR function of
the \fBexpr\fR command.  The \fBll\fR size modifier indicates that
the integer range to be stored is unlimited.
.SS "MANDATORY CONVERSION CHARACTER"
.VE 8.5
.PP
The following conversion characters are supported:
.TP
.TP 10
\fBd\fR
.
The input substring must be a decimal integer.
It is read in and the integer value is stored in the variable,
truncated as required by the size modifier value.
.TP
.TP 10
\fBo\fR
.
The input substring must be an octal integer. It is read in and the
The input substring must be an octal integer. It is read in and the 
integer value is stored in the variable,
truncated as required by the size modifier value.
.TP
.TP 10
\fBx\fR or \fBX\fR
.
The input substring must be a hexadecimal integer.
It is read in and the integer value is stored in the variable,
truncated as required by the size modifier value.
.TP
.TP 10
\fBb\fR
.
The input substring must be a binary integer.
It is read in and the integer value is stored in the variable,
truncated as required by the size modifier value.
.TP
\fBu\fR
.
The input substring must be a decimal integer.
The integer value is truncated as required by the size modifier
value, and the corresponding unsigned value for that truncated
range is computed and stored in the variable as a decimal string.
The conversion makes no sense without reference to a truncation range,
so the size modifier \fBll\fR is not permitted in combination
with conversion character \fBu\fR.
.TP
\fBi\fR
.TP 10
\fBi\fR 
.
The input substring must be an integer.  The base (i.e. decimal, octal, or hexadecimal) is determined by the C convention (leading 0 for octal; prefix 0x for hexadecimal).  The integer value is stored in the variable,
The input substring must be an integer.  The base (i.e. decimal, binary,
octal, or hexadecimal) is determined in the same fashion as described in
\fBexpr\fR.  The integer value is stored in the variable,
truncated as required by the size modifier value.
.TP
.TP 10
\fBc\fR
.
A single character is read in and its Unicode value is stored in
A single character is read in and its Unicode value is stored in 
the variable as an integer value.
Initial white space is not skipped in this case, so the input
substring may be a white-space character.
.TP
.TP 10
\fBs\fR
.
The input substring consists of all the characters up to the next
The input substring consists of all the characters up to the next 
white-space character; the characters are copied to the variable.
.TP
.TP 10
\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR
.
The input substring must be a floating-point number consisting
The input substring must be a floating-point number consisting 
of an optional sign, a string of decimal digits possibly
containing a decimal point, and an optional exponent consisting
of an \fBe\fR or \fBE\fR followed by an optional sign and a string of
containing a decimal point, and an optional exponent consisting 
of an \fBe\fR or \fBE\fR followed by an optional sign and a string of 
decimal digits.
It is read in and stored in the variable as a floating-point value.
.TP
.TP 10
\fB[\fIchars\fB]\fR
.
The input substring consists of one or more characters in \fIchars\fR.
The matching string is stored in the variable.
If the first character between the brackets is a \fB]\fR then
it is treated as part of \fIchars\fR rather than the closing
bracket for the set.
If \fIchars\fR
contains a sequence of the form \fIa\fB\-\fIb\fR then any
character between \fIa\fR and \fIb\fR (inclusive) will match.
If the first or last character between the brackets is a \fB\-\fR, then
it is treated as part of \fIchars\fR rather than indicating a range.
.TP
.TP 10
\fB[^\fIchars\fB]\fR
.
The input substring consists of one or more characters not in \fIchars\fR.
The matching string is stored in the variable.
If the character immediately following the \fB^\fR is a \fB]\fR then it is
treated as part of the set rather than the closing bracket for
If the character immediately following the \fB^\fR is a \fB]\fR then it is 
treated as part of the set rather than the closing bracket for 
the set.
If \fIchars\fR
contains a sequence of the form \fIa\fB\-\fIb\fR then any
character between \fIa\fR and \fIb\fR (inclusive) will be excluded
from the set.
If the first or last character between the brackets is a \fB\-\fR, then
it is treated as part of \fIchars\fR rather than indicating a range value.
.TP
.TP 10
\fBn\fR
.
No input is consumed from the input string.  Instead, the total number
of characters scanned from the input string so far is stored in the variable.
.PP
.LP
The number of characters read from the input for a conversion is the
largest number that makes sense for that particular conversion (e.g.
as many decimal digits as possible for \fB%d\fR, as
as many decimal digits as possible for \fB%d\fR, as 
many octal digits as possible for \fB%o\fR, and so on).
The input substring for a given conversion terminates either when a
white-space character is encountered or when the maximum substring
white-space character is encountered or when the maximum substring 
width has been reached, whichever comes first.
If a \fB*\fR is present in the conversion specifier
If a \fB*\fR is present in the conversion specifier 
then no variable is assigned and the next scan argument is not consumed.
.SH "DIFFERENCES FROM ANSI SSCANF"
.PP
The behavior of the \fBscan\fR command is the same as the behavior of
the ANSI C \fBsscanf\fR procedure except for the following differences:
.IP [1]
\fB%p\fR conversion specifier is not supported.
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
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










-

-







-





-
+
-
+
+

-
+

-
+



-
+






-




-
-
+
+





-






-
-
+
+

-
+




+


-

-
+

-
+

-
+

-
+


+




-
-
-
modifiers are ignored when converting real values (i.e. type
\fBdouble\fR is used for the internal representation).  The \fBll\fR
modifier has no \fBsscanf\fR counterpart.
.IP [4]
If the end of the input string is reached before any conversions have been
performed and no variables are given, an empty string is returned.
.SH EXAMPLES
.PP
Convert a UNICODE character to its numeric value:
.PP
.CS
set char "x"
set value [\fBscan\fR $char %c]
.CE
.PP
Parse a simple color specification of the form \fI#RRGGBB\fR using
hexadecimal conversions with substring sizes:
.PP
.CS
set string "#08D03F"
\fBscan\fR $string "#%2x%2x%2x" r g b
.CE
.PP
Parse a \fIHH:MM\fR time string:
Parse a \fIHH:MM\fR time string, noting that this avoids problems with
.PP
octal numbers by forcing interpretation as decimals (if we did not
care, we would use the \fB%i\fR conversion instead):
.CS
set string "08:08"
set string "08:08"   ;# *Not* octal!
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
    error "not a valid time string"
   error "not a valid time string"
}
# We have to understand numeric ranges ourselves...
if {$minutes < 0 || $minutes > 59} {
    error "invalid number of minutes"
   error "invalid number of minutes"
}
.CE
.PP
Break a string up into sequences of non-whitespace characters (note
the use of the \fB%n\fR conversion so that we get skipping over
leading whitespace correct):
.PP
.CS
set string " a string {with braced words} + leading space "
set words {}
while {[\fBscan\fR $string %s%n word length] == 2} {
    lappend words $word
    set string [string range $string $length end]
   lappend words $word
   set string [string range $string $length end]
}
.CE
.PP
Parse a simple coordinate string, checking that it is complete by
looking for the terminating character explicitly:
.PP
.CS
set string "(5.2,-4e-2)"
# Note that the spaces before the literal parts of
# the scan pattern are significant, and that ")" is
# the Unicode character \eu0029
if {
    [\fBscan\fR $string " (%f ,%f %c" x y last] != 3
    || $last != 0x0029
   [\fBscan\fR $string " (%f ,%f %c" x y last] != 3
   || $last != 0x0029
} then {
    error "invalid coordinate string"
   error "invalid coordinate string"
}
puts "X=$x, Y=$y"
.CE
.PP
.VS 8.5
An interactive session demonstrating the truncation of integer
values determined by size modifiers:
.PP
.CS
\fI%\fR set tcl_platform(wordSize)
% set tcl_platform(wordSize)
4
\fI%\fR scan 20000000000000000000 %d
% scan 20000000000000000000 %d
2147483647
\fI%\fR scan 20000000000000000000 %ld
% scan 20000000000000000000 %ld
9223372036854775807
\fI%\fR scan 20000000000000000000 %lld
% scan 20000000000000000000 %lld
20000000000000000000
.CE
.VE 8.5
.SH "SEE ALSO"
format(n), sscanf(3)
.SH KEYWORDS
conversion specifier, parse, scan
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/seek.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
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
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










-
+









+















-




-





-




-
+



-
+









-

-






-
+



-









+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH seek n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
seek \- Change the access position for an open channel
.SH SYNOPSIS
\fBseek \fIchannelId offset \fR?\fIorigin\fR?
.BE

.SH DESCRIPTION
.PP
Changes the current access position for \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 \fIoffset\fR and \fIorigin\fR
arguments specify the position at which the next read or write will occur
for \fIchannelId\fR. \fIOffset\fR must be an integer (which may be
negative) and \fIorigin\fR must be one of the following:
.TP 10
\fBstart\fR
.
The new access position will be \fIoffset\fR bytes from the start
of the underlying file or device.
.TP 10
\fBcurrent\fR
.
The new access position will be \fIoffset\fR bytes from the current
access position; a negative \fIoffset\fR moves the access position
backwards in the underlying file or device.
.TP 10
\fBend\fR
.
The new access position will be \fIoffset\fR bytes from the end of
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
.LP
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.
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,
not characters, unlike \fBread\fR.
.SH EXAMPLES
.PP
Read a file twice:
.PP
.CS
set f [open file.txt]
set data1 [read $f]
\fBseek\fR $f 0
set data2 [read $f]
close $f
# $data1 eq $data2 if the file wasn't updated
# $data1 == $data2 if the file wasn't updated
.CE
.PP
Read the last 10 bytes from a file:
.PP
.CS
set f [open file.data]
# This is guaranteed to work with binary data but
# may fail with other encodings...
fconfigure $f -translation binary
\fBseek\fR $f -10 end
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:

Deleted doc/self.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
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





























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2007 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH self n 0.1 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
self \- method call internal introspection
.SH SYNOPSIS
.nf
package require TclOO

\fBself\fR ?\fIsubcommand\fR?
.fi
.BE
.SH DESCRIPTION
The \fBself\fR command, which should only be used from within the context of a
call to a method (i.e. inside a method, constructor or destructor body) is
used to allow the method to discover information about how it was called. It
takes an argument, \fIsubcommand\fR, that tells it what sort of information is
actually desired; if omitted the result will be the same as if \fBself
object\fR was invoked. The supported subcommands are:
.TP
\fBself call\fR
.
This returns a two-element list describing the method implementations used to
implement the current call chain. The first element is the same as would be
reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
also reports useful values from within constructors and destructors, whose
names are reported as \fB<constructor>\fR and \fB<destructor>\fR
respectively,
.VS TIP500
and for private methods, which are described as being \fBprivate\fR instead of
being a \fBmethod\fR),
.VE TIP500
and the second element is an index into the first element's
list that indicates which actual implementation is currently executing (the
first implementation to execute is always at index 0).
.TP
\fBself caller\fR
.
When the method was invoked from inside another object method, this subcommand
returns a three element list describing the containing object and method. The
first element describes the declaring object or class of the method, the
second element is the name of the object on which the containing method was
invoked, and the third element is the name of the method (with the strings
\fB<constructor>\fR and \fB<destructor>\fR indicating constructors and
destructors respectively).
.TP
\fBself class\fR
.
This returns the name of the class that the current method was defined within.
Note that this will change as the chain of method implementations is traversed
with \fBnext\fR, and that if the method was defined on an object then this
will fail.
.RS
.PP
If you want the class of the current object, you need to use this other
construct:
.PP
.CS
info object class [\fBself object\fR]
.CE
.RE
.TP
\fBself filter\fR
.
When invoked inside a filter, this subcommand returns a three element list
describing the filter. The first element gives the name of the object or class
that declared the filter (note that this may be different from the object or
class that provided the implementation of the filter), the second element is
either \fBobject\fR or \fBclass\fR depending on whether the declaring entity
was an object or class, and the third element is the name of the filter.
.TP
\fBself method\fR
.
This returns the name of the current method (with the strings
\fB<constructor>\fR and \fB<destructor>\fR indicating constructors and
destructors respectively).
.TP
\fBself namespace\fR
.
This returns the name of the unique namespace of the object that the method
was invoked upon.
.TP
\fBself next\fR
.
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
.
When invoked inside a filter implementation, this subcommand returns a two
element list describing the method being filtered. The first element will be
the name of the declarer of the method, and the second element will be the
actual name of the method.
.SH EXAMPLES
.PP
This example shows basic use of \fBself\fR to provide information about the
current object:
.PP
.CS
oo::class create c {
    method foo {} {
        puts "this is the [\fBself\fR] object"
    }
}
c create a
c create b
a foo                \fI\(-> prints "this is the ::a object"\fR
b foo                \fI\(-> prints "this is the ::b object"\fR
.CE
.PP
This demonstrates what a method call chain looks like, and how traversing
along it changes the index into it:
.PP
.CS
oo::class create c {
    method x {} {
        puts "Cls: [\fBself call\fR]"
    }
}
c create a
oo::objdefine a {
    method x {} {
        puts "Obj: [\fBself call\fR]"
        next
        puts "Obj: [\fBself call\fR]"
    }
}
a x     \fI\(-> Obj: {{method x object method} {method x ::c method}} 0\fR
        \fI\(-> Cls: {{method x object method} {method x ::c method}} 1\fR
        \fI\(-> Obj: {{method x object method} {method x ::c method}} 0\fR
.CE
.SH "SEE ALSO"
info(n), next(n)
.SH KEYWORDS
call, introspection, object
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/set.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH set n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
set \- Read and write variables
.SH SYNOPSIS
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
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











-
+






-
+


-

-





-





-








-










-
-
-
-
before the first open parenthesis are the name of the array,
and the characters between the parentheses are the index within the array.
Otherwise \fIvarName\fR refers to a scalar variable.
.PP
If \fIvarName\fR includes namespace qualifiers
(in the array name if it refers to an array element), or if \fIvarName\fR
is unqualified (does not include the names of any containing namespaces)
but no procedure is active,
but no procedure is active, 
\fIvarName\fR refers to a namespace variable
resolved according to the rules described under \fBNAME RESOLUTION\fR in
the \fBnamespace\fR manual page.
.PP
If a procedure is active and \fIvarName\fR is unqualified, then
\fIvarName\fR refers to a parameter or local variable of the procedure,
unless \fIvarName\fR was declared to resolve differently through one of the
unless \fIvarName\fR was declared to resolve differently through one of the 
\fBglobal\fR, \fBvariable\fR or \fBupvar\fR commands.
.SH EXAMPLES
.PP
Store a random number in the variable \fIr\fR:
.PP
.CS
\fBset\fR r [expr {rand()}]
.CE
.PP
Store a short message in an array element:
.PP
.CS
\fBset\fR anAry(msg) "Hello, World!"
.CE
.PP
Store a short message in an array element specified by a variable:
.PP
.CS
\fBset\fR elemName "msg"
\fBset\fR anAry($elemName) "Hello, World!"
.CE
.PP
Copy a value into the variable \fIout\fR from a variable whose name is
stored in the \fIvbl\fR (note that it is often easier to use arrays in
practice instead of doing double-dereferencing):
.PP
.CS
\fBset\fR in0 "small random"
\fBset\fR in1 "large random"
\fBset\fR vbl in[expr {rand() >= 0.5}]
\fBset\fR out [\fBset\fR $vbl]
.CE
.SH "SEE ALSO"
expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
.SH KEYWORDS
read, write, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/singleton.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
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



































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH singleton n 0.3 TclOO "TclOO Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
oo::singleton \- a class that does only allows one instance of itself
.SH SYNOPSIS
.nf
package require TclOO

\fBoo::singleton\fI method \fR?\fIarg ...\fR?
.fi
.SH "CLASS HIERARCHY"
.nf
\fBoo::object\fR
   \(-> \fBoo::class\fR
       \(-> \fBoo::singleton\fR
.fi
.BE
.SH DESCRIPTION
Singleton classes are classes that only permit at most one instance of
themselves to exist. They unexport the \fBcreate\fR and
\fBcreateWithNamespace\fR methods entirely, and override the \fBnew\fR method
so that it only makes a new instance if there is no existing instance.  It is
not recommended to inherit from a singleton class; singleton-ness is \fInot\fR
inherited. It is not recommended that a singleton class's constructor take any
arguments.
.PP
Instances have their\fB destroy\fR method overridden with a method that always
returns an error in order to discourage destruction of the object, but
destruction remains possible if strictly necessary (e.g., by destroying the
class or using \fBrename\fR to delete it). They also have a (non-exported)
\fB<cloned>\fR method defined on them that similarly always returns errors to
make attempts to use the singleton instance with \fBoo::copy\fR fail.
.SS CONSTRUCTOR
The \fBoo::singleton\fR class does not define an explicit constructor; this
means that it is effectively the same as the constructor of the
\fBoo::class\fR class.
.SS DESTRUCTOR
The \fBoo::singleton\fR class does not define an explicit destructor;
destroying an instance of it is just like destroying an ordinary class (and
will destroy the singleton object).
.SS "EXPORTED METHODS"
.TP
\fIcls \fBnew \fR?\fIarg ...\fR?
.
This returns the current instance of the singleton class, if one exists, and
creates a new instance only if there is no existing instance. The additional
arguments, \fIarg ...\fR, are only used if a new instance is actually
manufactured; that construction is via the \fBoo::class\fR class's \fBnew\fR
method.
.RS
.PP
This is an override of the behaviour of a superclass's method with an
identical call signature to the superclass's implementation.
.RE
.SS "NON-EXPORTED METHODS"
The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and
\fBcreateWithNamespace\fR are unexported; callers should not assume that they
have control over either the name or the namespace name of the singleton instance.
.SH EXAMPLE
.PP
This example demonstrates that there is only one instance even though the
\fBnew\fR method is called three times.
.PP
.CS
\fBoo::singleton\fR create Highlander {
    method say {} {
        puts "there can be only one"
    }
}

set h1 [Highlander new]
set h2 [Highlander new]
if {$h1 eq $h2} {
    puts "equal objects"    \fI\(-> prints "equal objects"\fR
}
set h3 [Highlander new]
if {$h1 eq $h3} {
    puts "equal objects"    \fI\(-> prints "equal objects"\fR
}
.CE
.PP
Note that the name of the instance of the singleton is not guaranteed to be
anything in particular.
.SH "SEE ALSO"
oo::class(n)
.SH KEYWORDS
class, metaclass, object, single instance
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/socket.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
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
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










-
+











+


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



-
+














-
+






-







-







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

-
+


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



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

-
+
-
-
-
-
+
+
+




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
















-
+


-
-
+



-




-
+
-


-


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


-





-
-
-
-


-

-

-
-
+
+
-
-
+
-
-
+


-
+



-
+
-
-



-
+
-

-
+
-

-
+
-

-
+
+

-
+
-
-
-
'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\" 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.
'\"
.TH socket n 8.6 Tcl "Tcl Built-In Commands"
.TH socket n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
socket \- Open a TCP network connection
.SH SYNOPSIS
.sp
\fBsocket \fR?\fIoptions\fR? \fIhost port\fR
.sp
\fBsocket\fR \fB\-server \fIcommand\fR ?\fIoptions\fR? \fIport\fR
.BE

.SH DESCRIPTION
.PP
This command opens a network socket and returns a channel identifier
that may be used in future invocations of commands like \fBread\fR,
\fBputs\fR and \fBflush\fR.  At present only the TCP network protocol
is supported over IPv4 and IPv6; future releases may include support
for additional protocols.  The \fBsocket\fR command may be used to
open either the client or server side of a connection, depending on
whether the \fB\-server\fR switch is specified.
This command opens a network socket and returns a channel
identifier that may be used in future invocations of commands like
\fBread\fR, \fBputs\fR and \fBflush\fR.
At present only the TCP network protocol is supported;  future
releases may include support for additional protocols.
The \fBsocket\fR command may be used to open either the client or
server side of a connection, depending on whether the \fB\-server\fR
switch is specified.
.PP
Note that the default encoding for \fIall\fR sockets is the system
encoding, as returned by \fBencoding system\fR.  Most of the time, you
will need to use \fBchan configure\fR to alter this to something else,
will need to use \fBfconfigure\fR to alter this to something else,
such as \fIutf\-8\fR (ideal for communicating with other Tcl
processes) or \fIiso8859\-1\fR (useful for many network protocols,
especially the older ones).
.SH "CLIENT SOCKETS"
.PP
If the \fB\-server\fR option is not specified, then the client side of a
connection is opened and the command returns a channel identifier
that can be used for both reading and writing.
\fIPort\fR and \fIhost\fR specify a port
to connect to;  there must be a server accepting connections on
this port.  \fIPort\fR is an integer port number
(or service name, where supported and understood by the host operating
system) and \fIhost\fR
is either a domain-style name such as \fBwww.tcl.tk\fR or
a numerical IPv4 or IPv6 address such as \fB127.0.0.1\fR or \fB2001:DB8::1\fR.
a numerical IP address such as \fB127.0.0.1\fR.
Use \fIlocalhost\fR to refer to the host on which the command is invoked.
.PP
The following options may also be present before \fIhost\fR
to specify additional information about the connection:
.TP
\fB\-myaddr\fI addr\fR
.
\fIAddr\fR gives the domain-style name or numerical IP address of
the client-side network interface to use for the connection.
This option may be useful if the client machine has multiple network
interfaces.  If the option is omitted then the client-side interface
will be chosen by the system software.
.TP
\fB\-myport\fI port\fR
.
\fIPort\fR specifies an integer port number (or service name, where
supported and understood by the host operating system) to use for the
client's
side of the connection.  If this option is omitted, the client's
port number will be chosen at random by the system software.
.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
The \fB\-async\fR 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
\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
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
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
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
.CS
\fBchan configure \fIchan \fB\-blocking 0\fR
\fBfconfigure \fIchan \fB\-blocking 0\fR
.CE
.PP
See the \fBchan configure\fR command for more details.
See the \fBfconfigure\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.
.PP
The \fBchan configure\fR option \fB-connecting\fR may be used to check if the connect is still running. To verify a successful connect, the option \fB-error\fR may be checked when \fB-connecting\fR returned 0.
.PP
Operation without the event queue requires at the moment calls to \fBchan configure\fR to advance the internal state machine.
.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
free port to the server socket which may be discovered by using
\fBchan configure\fR to read the \fB\-sockname\fR option). If the host
If the \fB\-server\fR option is specified then the new socket
will be a server for the port given by \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 free port to the server socket which may be discovered by
using \fBfconfigure\fR to read the \fB\-sockname\fR option).
supports both, IPv4 and IPv6, the socket will listen on both address
families. Tcl will automatically accept connections to the given port.
Tcl will automatically accept connections to the given port.
For each connection Tcl will create a new channel that may be used to
communicate with the client.  Tcl then invokes \fIcommand\fR (properly
communicate with the client.  Tcl then invokes \fIcommand\fR
a command prefix list, see the \fBEXAMPLES\fR below) with three
additional arguments: the name of the new channel, the address, in
network address notation, of the client's host, and the client's port
number.
with three additional arguments: the name of the new channel, the
address, in network address notation, of the client's host, and
the client's port number.
.PP
The following additional option may also be specified before \fIport\fR:
.TP
\fB\-myaddr\fI addr\fR
.
\fIAddr\fR gives the domain-style name or numerical IP address of the
server-side network interface to use for the connection.  This option
may be useful if the server machine has multiple network interfaces.
If the option is omitted then the server socket is bound to the
wildcard address so that it can accept connections from any
interface. If \fIaddr\fR is a domain name that resolves to multiple IP
\fIAddr\fR gives the domain-style name or numerical IP address of
the server-side network interface to use for the connection.
This option may be useful if the server machine has multiple network
interfaces.  If the option is omitted then the server socket is bound
to the special address INADDR_ANY so that it can accept connections from
any interface.
addresses that are available on the local machine, the socket will
listen on all of them.
.TP
\fB\-reuseaddr\fI boolean\fR
.
Tells the kernel whether to reuse the local address if there is no socket
actively listening on it. This is the default on Windows.
.TP
\fB\-reuseport\fI boolean\fR
.
Tells the kernel whether to allow the binding of multiple sockets to the same
address and port.
.PP
Server channels cannot be used for input or output; their sole use is to
accept new client connections. The channels created for each incoming
client connection are opened for input and output. Closing the server
channel shuts down the server so that no new connections will be
accepted;  however, existing connections will be unaffected.
.PP
Server sockets depend on the Tcl event mechanism to find out when
new connections are opened.  If the application does not enter the
event loop, for example by invoking the \fBvwait\fR command or
calling the C procedure \fBTcl_DoOneEvent\fR, then no connections
will be accepted.
.PP
If \fIport\fR is specified as zero, the operating system will allocate
an unused port for use as a server socket.  The port number actually
allocated may be retrieved from the created server socket using the
\fBchan configure\fR command to retrieve the \fB\-sockname\fR option as
\fBfconfigure\fR command to retrieve the \fB\-sockname\fR option as
described below.
.SH "CONFIGURATION OPTIONS"
.PP
The \fBchan configure\fR command can be used to query several readonly
The \fBfconfigure\fR command can be used to query several readonly
configuration options for socket channels:
.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.
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
.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.
list.
.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
list is identical to the address, its first element.
.TP
\fB\-connecting\fR
.
This option is not supported by server sockets. For client sockets, this option returns 1 if an asyncroneous connect is still in progress, 0 otherwise.
.PP
.SH "EXAMPLES"
.PP
Here is a very simple time server:
.PP
.CS
proc Server {startTime channel clientaddr clientport} {
    puts "Connection from $clientaddr registered"
proc Server {channel clientaddr clientport} {
   puts "Connection from $clientaddr registered"
    set now [clock seconds]
    puts $channel [clock format $now]
   puts $channel [clock format [clock seconds]]
    puts $channel "[expr {$now - $startTime}] since start"
    close $channel
   close $channel
}

\fBsocket -server\fR [list Server [clock seconds]] 9900
\fBsocket\fR -server Server 9900
vwait forever
.CE
.PP
And here is the corresponding client to talk to the server and extract
And here is the corresponding client to talk to the server:
some information:
.PP
.CS
set server localhost
set sockChan [\fBsocket\fR $server 9900]
gets $sockChan line1
gets $sockChan line
gets $sockChan line2
close $sockChan
puts "The time on $server is $line1"
puts "The time on $server is $line"
puts "That is [lindex $line2 0]s since the server started"
.CE
.SH "HISTORY"

Support for IPv6 was added in Tcl 8.6.
.SH "SEE ALSO"
chan(n), flush(n), open(n), read(n)
fconfigure(n), flush(n), open(n), read(n)

.SH KEYWORDS
asynchronous I/O, bind, channel, connection, domain name, host, network address, socket, tcp
bind, channel, connection, domain name, host, network address, socket, tcp
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/source.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
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







-
+









+

+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Scriptics Corporation.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH source n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
source \- Evaluate a file or resource as a Tcl script
.SH SYNOPSIS
\fBsource \fIfileName\fR
.sp
.VS 8.5
\fBsource\fR \fB\-encoding \fIencodingName fileName\fR
.VE 8.5
.BE
.SH DESCRIPTION
.PP
This command takes the contents of the specified file or resource
and passes it to the Tcl interpreter as a text script.  The return
value from \fBsource\fR is the return value of the last command
executed in the script.  If an error occurs in evaluating the contents
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
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











-
+

+


-
+
+

-


-




-

-


-
+






-
-
-
-
in code for string comparison, you can use
.QW \e032
or
.QW \eu001a ,
which will be safely substituted by the Tcl interpreter into
.QW ^Z .
.PP
A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, utf-16, ucs-2).
A leading BOM (Byte order mark) contained in the file is ignored for unicode encodings (utf-8, unicode).
.PP
.VS 8.5
The \fB\-encoding\fR option is used to specify the encoding of
the data stored in \fIfileName\fR.  When the \fB\-encoding\fR option
is omitted, the utf-8 encoding is assumed.
is omitted, the system encoding is assumed.
.VE 8.5
.SH EXAMPLE
.PP
Run the script in the file \fBfoo.tcl\fR and then the script in the
file \fBbar.tcl\fR:
.PP
.CS
\fBsource\fR foo.tcl
\fBsource\fR bar.tcl
.CE
.PP
Alternatively:
.PP
.CS
foreach scriptFile {foo.tcl bar.tcl} {
    \fBsource\fR $scriptFile
   \fBsource\fR $scriptFile
}
.CE
.SH "SEE ALSO"
file(n), cd(n), encoding(n), info(n)
.SH KEYWORDS
file, script
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/split.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
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
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









-
+









+














-

-

-
-
+
+





-






-






-





-


-












-
-
+
+

-
-
-
-
+
+
+
+


+


+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH split n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
split \- Split a string into a proper Tcl list
.SH SYNOPSIS
\fBsplit \fIstring \fR?\fIsplitChars\fR?
.BE

.SH DESCRIPTION
.PP
Returns a list created by splitting \fIstring\fR at each character
that is in the \fIsplitChars\fR argument.
Each element of the result list will consist of the
characters from \fIstring\fR that lie between instances of the
characters in \fIsplitChars\fR.
Empty list elements will be generated if \fIstring\fR contains
adjacent characters in \fIsplitChars\fR, or if the first or last
character of \fIstring\fR is in \fIsplitChars\fR.
If \fIsplitChars\fR is an empty string then each character of
\fIstring\fR becomes a separate element of the result list.
\fISplitChars\fR defaults to the standard white-space characters.
.SH EXAMPLES
.PP
Divide up a USENET group name into its hierarchical components:
.PP
.CS
\fBsplit\fR "comp.lang.tcl" .
      \fI\(-> comp lang tcl\fR
\fBsplit\fR "comp.lang.tcl.announce" .
      \fI\(-> comp lang tcl announce\fR
.CE
.PP
See how the \fBsplit\fR command splits on \fIevery\fR character in
\fIsplitChars\fR, which can result in information loss if you are not
careful:
.PP
.CS
\fBsplit\fR "alpha beta gamma" "temp"
      \fI\(-> al {ha b} {} {a ga} {} a\fR
.CE
.PP
Extract the list words from a string that is not a well-formed list:
.PP
.CS
\fBsplit\fR "Example with {unbalanced brace character"
      \fI\(-> Example with \e{unbalanced brace character\fR
.CE
.PP
Split a string into its constituent characters
.PP
.CS
\fBsplit\fR "Hello world" {}
      \fI\(-> H e l l o { } w o r l d\fR
.CE
.SS "PARSING RECORD-ORIENTED FILES"
.PP
Parse a Unix /etc/passwd file, which consists of one entry per line,
with each line consisting of a colon-separated list of fields:
.PP
.CS
## Read the file
set fid [open /etc/passwd]
set content [read $fid]
close $fid

## Split into records on newlines
set records [\fBsplit\fR $content "\en"]

## Iterate over the records
foreach rec $records {

    ## Split into fields on colons
    set fields [\fBsplit\fR $rec ":"]
   ## Split into fields on colons
   set fields [\fBsplit\fR $rec ":"]

    ## Assign fields to variables and print some out...
    lassign $fields \e
            userName password uid grp longName homeDir shell
    puts "$longName uses [file tail $shell] for a login shell"
   ## Assign fields to variables and print some out...
   lassign $fields \e
         userName password uid grp longName homeDir shell
   puts "$longName uses [file tail $shell] for a login shell"
}
.CE

.SH "SEE ALSO"
join(n), list(n), string(n)

.SH KEYWORDS
list, split, string
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/string.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
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
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






-
+







-
+

+





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








-
+
-








-




-
+



-



-

-



-




-


-
+
-
+

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




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


-




















-
-
-
-
-
-
-
-





-
-
-
-
-







.\"
.\" Copyright (c) 1993 The Regents of the University of California.
.\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
.\"
.\" See the file "license.terms" for information on usage and redistribution
.\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
.\"
.\" 
.TH string n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
.\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
\fBstring \fIoption arg \fR?\fIarg ...\fR?
\fBstring \fIoption arg \fR?\fIarg ...?\fR
.BE

.SH DESCRIPTION
.PP
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?
.
Concatenate the given \fIstring\fRs just like placing them directly
next to each other and return the resulting compound string.  If no
\fIstring\fRs are present, the result is an empty string.
.RS
.PP
This primitive is occasionally handier than juxtaposition of strings
when mixed quoting is wanted, or when the aim is to return the result
of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR,
and is more efficient than building a list of arguments and using
\fBjoin\fR with an empty join string.
.RE
.TP
\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
.
Perform a character-by-character comparison of strings \fIstring1\fR
and \fIstring2\fR.  Returns \-1, 0, or 1, depending on whether
\fIstring1\fR is lexicographically less than, equal to, or greater
than \fIstring2\fR.  If \fB\-length\fR is specified, then only the
first \fIlength\fR characters are used in the comparison.  If
\fB\-length\fR is negative, it is ignored.  If \fB\-nocase\fR is
specified, then the strings are compared in a case-insensitive manner.
.TP
\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
\fBstring equal\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
.
Perform a character-by-character comparison of strings \fIstring1\fR
and \fIstring2\fR.  Returns 1 if \fIstring1\fR and \fIstring2\fR are
identical, or 0 when not.  If \fB\-length\fR is specified, then only
the first \fIlength\fR characters are used in the comparison.  If
\fB\-length\fR is negative, it is ignored.  If \fB\-nocase\fR is
specified, then the strings are compared in a case-insensitive manner.
.TP
\fBstring first \fIneedleString haystackString\fR ?\fIstartIndex\fR?
.
Search \fIhaystackString\fR for a sequence of characters that exactly match
the characters in \fIneedleString\fR.  If found, return the index of the
first character in the first such match within \fIhaystackString\fR.  If not
found, return \-1.  If \fIstartIndex\fR is specified (in any of the
forms described in \fBSTRING INDICES\fR), then the search is
forms accepted by the \fBindex\fR method), then the search is
constrained to start with the character in \fIhaystackString\fR specified by
the index.  For example,
.RS
.PP
.CS
\fBstring first a 0a23456789abcdef 5\fR
.CE
.PP
will return \fB10\fR, but
.PP
.CS
\fBstring first a 0123456789abcdef 11\fR
.CE
.PP
will return \fB\-1\fR.
.RE
.TP
\fBstring index \fIstring charIndex\fR
.
Returns the \fIcharIndex\fR'th character of the \fIstring\fR argument.
A \fIcharIndex\fR of 0 corresponds to the first character of the
string.  \fIcharIndex\fR may be specified as described in the
string.  \fIcharIndex\fR may be specified as follows:
\fBSTRING INDICES\fR section.
.VS 8.5
.RS
.IP \fIinteger\fR 10
For any index value that passes \fBstring is integer -strict\fR,
the char specified at this integral index
(e.g. \fB2\fR would refer to the
.QW c
in
.QW abcd ).
.IP \fBend\fR 10
The last char of the string
(e.g. \fBend\fR would refer to the
.QW d
in
.QW abcd ).
.IP \fBend\fR\-\fIN\fR 10
The last char of the string minus the specified integer offset \fIN\fR
(e.g. \fBend\fR\-1 would refer to the
.QW c
in
.QW abcd ).
.IP \fBend\fR+\fIN\fR 10
The last char of the string plus the specified integer offset \fIN\fR
(e.g. \fBend\fR+\-1 would refer to the
.QW c
in
.QW abcd ).
.IP \fIM\fR+\fIN\fR 10
The char specified at the integral index that is the sum of 
integer values \fIM\fR and \fIN\fR
(e.g. \fB1+1\fR would refer to the
.QW c
in
.QW abcd ).
.IP \fIM\fR\-\fIN\fR 10
The char specified at the integral index that is the difference of 
integer values \fIM\fR and \fIN\fR
(e.g. \fB2\-1\fR would refer to the
.QW b
in
.QW abcd ).
.PP
In the specifications above, the integer value \fIM\fR contains no
trailing whitespace and the integer value \fIN\fR contains no
leading whitespace.
.PP
If \fIcharIndex\fR is less than 0 or greater than or equal to the
length of the string then this command returns an empty string.
.RE
.TP
\fBstring insert \fIstring index insertString\fR
.VS "TIP 504"
Returns a copy of \fIstring\fR with \fIinsertString\fR inserted at the
\fIindex\fR'th character.  The \fIindex\fR may be specified as described in the
\fBSTRING INDICES\fR section.
.RS
.PP
If \fIindex\fR is start-relative, the first character inserted in the returned
string will be at the specified index.  If \fIindex\fR is end-relative, the last
character inserted in the returned string will be at the specified index.
.PP
If \fIindex\fR is at or before the start of \fIstring\fR (e.g., \fIindex\fR is
\fB0\fR), \fIinsertString\fR is prepended to \fIstring\fR.  If \fIindex\fR is at
or after the end of \fIstring\fR (e.g., \fIindex\fR is \fBend\fR),
\fIinsertString\fR is appended to \fIstring\fR.
.RE
.VE "TIP 504"
.VE
.TP
\fBstring is \fIclass\fR ?\fB\-strict\fR? ?\fB\-failindex \fIvarname\fR? \fIstring\fR
.
Returns 1 if \fIstring\fR is a valid member of the specified character
class, otherwise returns 0.  If \fB\-strict\fR is specified, then an
empty string returns 0, otherwise an empty string will return 1 on
any class.  If \fB\-failindex\fR is specified, then if the function
returns 0, the index in the string where the class was no longer valid
will be stored in the variable named \fIvarname\fR.  The \fIvarname\fR
will not be set if \fBstring is\fR returns 1.  The following character
classes are recognized (the class name can be abbreviated):
.RS
.IP \fBalnum\fR 12
Any Unicode alphabet or digit character.
.IP \fBalpha\fR 12
Any Unicode alphabet character.
.IP \fBascii\fR 12
Any character with a value less than \eu0080 (those that are in the
7\-bit ascii range).
.IP \fBboolean\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR.
.IP \fBcontrol\fR 12
Any Unicode control character.
.IP \fBdict\fR 12
.VS TIP501
Any proper dict structure, with optional surrounding whitespace. In
case of improper dict structure, 0 is returned and the \fIvarname\fR
will contain the index of the
.QW element
where the dict parsing fails, or \-1 if this cannot be determined.
.VE TIP501
.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 forms allowed to \fBTcl_GetDoubleFromObj\fR.
.IP \fBentier\fR 12
.
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.
.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,
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
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







-
-
+
+
-





+




+












-




-
+



-



-

-



-




-


-
-
-
+
+
+


-











-



-





-



-




-







.IP \fBlower\fR 12
Any Unicode lower case alphabet character.
.IP \fBprint\fR 12
Any Unicode printing character, including space.
.IP \fBpunct\fR 12
Any Unicode punctuation character.
.IP \fBspace\fR 12
Any Unicode whitespace character, mongolian vowel separator
(U+180e), zero width space (U+200b), word joiner (U+2060) or
Any Unicode whitespace character or mongolian vowel separator (U+180e),
but not NEL/Next Line (U+0085).
zero width no-break space (U+feff) (=BOM).
.IP \fBtrue\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
true.
.IP \fBupper\fR 12
Any upper case alphabet character in the Unicode character set.
.VS 8.5
.IP \fBwideinteger\fR 12
Any of the valid forms for a wide integer in Tcl, with optional
surrounding whitespace.  In case of overflow in the value, 0 is
returned and the \fIvarname\fR will contain \-1.
.VE 8.5
.IP \fBwordchar\fR 12
Any Unicode word character.  That is any alphanumeric character, and
any Unicode connector punctuation characters (e.g. underscore).
.IP \fBxdigit\fR 12
Any hexadecimal digit character ([0\-9A\-Fa\-f]).
.PP
In the case of \fBboolean\fR, \fBtrue\fR and \fBfalse\fR, if the
function will return 0, then the \fIvarname\fR will always be set to
0, due to the varied nature of a valid boolean value.
.RE
.TP
\fBstring last \fIneedleString haystackString\fR ?\fIlastIndex\fR?
.
Search \fIhaystackString\fR for a sequence of characters that exactly match
the characters in \fIneedleString\fR.  If found, return the index of the
first character in the last such match within \fIhaystackString\fR.  If there
is no match, then return \-1.  If \fIlastIndex\fR is specified (in any
of the forms described in \fBSTRING INDICES\fR), then only the
of the forms accepted by the \fBindex\fR method), then only the
characters in \fIhaystackString\fR at or before the specified \fIlastIndex\fR
will be considered by the search.  For example,
.RS
.PP
.CS
\fBstring last a 0a23456789abcdef 15\fR
.CE
.PP
will return \fB10\fR, but
.PP
.CS
\fBstring last a 0a23456789abcdef 9\fR
.CE
.PP
will return \fB1\fR.
.RE
.TP
\fBstring length \fIstring\fR
.
Returns a decimal string giving the number of characters in
\fIstring\fR.  Note that this is not necessarily the same as the
number of bytes used to store the string.  If the value is a
byte array value (such as those returned from reading a binary encoded
channel), then this will return the actual byte length of the value.
number of bytes used to store the string.  If the object is a
ByteArray object (such as those returned from reading a binary encoded
channel), then this will return the actual byte length of the object.
.TP
\fBstring map\fR ?\fB\-nocase\fR? \fImapping string\fR
.
Replaces substrings in \fIstring\fR based on the key-value pairs in
\fImapping\fR.  \fImapping\fR is a list of \fIkey value key value ...\fR
as in the form returned by \fBarray get\fR.  Each instance of a
key in the string will be replaced with its corresponding value.  If
\fB\-nocase\fR is specified, then matching is done without regard to
case differences. Both \fIkey\fR and \fIvalue\fR may be multiple
characters.  Replacement is done in an ordered manner, so the key
appearing first in the list will be checked first, and so on.
\fIstring\fR is only iterated over once, so earlier key replacements
will have no affect for later key matches.  For example,
.RS
.PP
.CS
\fBstring map {abc 1 ab 2 a 3 1 0} 1abcaababcabababc\fR
.CE
.PP
will return the string \fB01321221\fR.
.PP
Note that if an earlier \fIkey\fR is a prefix of a later one, it will
completely mask the later one.  So if the previous example is
reordered like this,
.PP
.CS
\fBstring map {1 0 ab 2 a 3 abc 1} 1abcaababcabababc\fR
.CE
.PP
it will return the string \fB02c322c222c\fR.
.RE
.TP
\fBstring match\fR ?\fB\-nocase\fR? \fIpattern\fR \fIstring\fR
.
See if \fIpattern\fR matches \fIstring\fR; return 1 if it does, 0 if
it does not.  If \fB\-nocase\fR is specified, then the pattern attempts
to match against the string in a case insensitive manner.  For the two
strings to match, their contents must be identical except that the
following special sequences may appear in \fIpattern\fR:
.RS
.IP \fB*\fR 10
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
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
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







-


-
+
-
-








-
-
+
-
-


-


-
+
-








+


-


+


-





-
+


-






-
-
+
+


-





-
+


-


-
+
-
+


-


-
+
-
+


-


-
+
-
-
+
+






-

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

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-


-
+





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

-


-





-
+


+


+

-
+

+



.IP \fB\e\fIx\fR 10
Matches the single character \fIx\fR.  This provides a way of avoiding
the special interpretation of the characters \fB*?[]\e\fR in
\fIpattern\fR.
.RE
.TP
\fBstring range \fIstring first last\fR
.
Returns a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR (using the forms described in
character whose index is \fIlast\fR. An index of 0 refers to the first
\fBSTRING INDICES\fR). An index of \fB0\fR refers to the first
character of the string; an index of \fBend\fR refers to last
character of the string.  \fIfirst\fR and \fIlast\fR may be specified
as for the \fBindex\fR method.  If \fIfirst\fR is less than zero then
it is treated as if it were zero, and if \fIlast\fR is greater than or
equal to the length of the string then it is treated as if it were
\fBend\fR.  If \fIfirst\fR is greater than \fIlast\fR then an empty
string is returned.
.TP
\fBstring repeat \fIstring count\fR
.
Returns a string consisting of \fIstring\fR concatenated with itself
Returns \fIstring\fR repeated \fIcount\fR number of times.
\fIcount\fR times. If \fIcount\fR is 0, the empty string will be
returned.
.TP
\fBstring replace \fIstring first last\fR ?\fInewstring\fR?
.
Removes a range of consecutive characters from \fIstring\fR, starting
with the character whose index is \fIfirst\fR and ending with the
character whose index is \fIlast\fR (using the forms described in
character whose index is \fIlast\fR.  An index of 0 refers to the
\fBSTRING INDICES\fR).  An index of 0 refers to the
first character of the string.  \fIFirst\fR and \fIlast\fR may be
specified as for the \fBindex\fR method.  If \fInewstring\fR is
specified, then it is placed in the removed character range.  If
\fIfirst\fR is less than zero then it is treated as if it were zero,
and if \fIlast\fR is greater than or equal to the length of the string
then it is treated as if it were \fBend\fR.  If \fIfirst\fR is greater
than \fIlast\fR or the length of the initial string, or \fIlast\fR is
less than 0, then the initial string is returned untouched.
.VS 8.5
.TP
\fBstring reverse \fIstring\fR
.
Returns a string that is the same length as \fIstring\fR but with its
characters in the reverse order.
.VE 8.5
.TP
\fBstring tolower \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
.
Returns a value equal to \fIstring\fR except that all upper (or title)
case letters have been converted to lower case.  If \fIfirst\fR is
specified, it refers to the first char index in the string to start
modifying.  If \fIlast\fR is specified, it refers to the char index in
the string to stop at (inclusive).  \fIfirst\fR and \fIlast\fR may be
specified using the forms described in \fBSTRING INDICES\fR.
specified as for the \fBindex\fR method.
.TP
\fBstring totitle \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
.
Returns a value equal to \fIstring\fR except that the first character
in \fIstring\fR is converted to its Unicode title case variant (or
upper case if there is no title case variant) and the rest of the
string is converted to lower case.  If \fIfirst\fR is specified, it
refers to the first char index in the string to start modifying.  If
\fIlast\fR is specified, it refers to the char index in the string to
stop at (inclusive).  \fIfirst\fR and \fIlast\fR may be specified
using the forms described in \fBSTRING INDICES\fR.
stop at (inclusive).  \fIfirst\fR and \fIlast\fR may be specified as
for the \fBindex\fR method.
.TP
\fBstring toupper \fIstring\fR ?\fIfirst\fR? ?\fIlast\fR?
.
Returns a value equal to \fIstring\fR except that all lower (or title)
case letters have been converted to upper case.  If \fIfirst\fR is
specified, it refers to the first char index in the string to start
modifying.  If \fIlast\fR is specified, it refers to the char index in
the string to stop at (inclusive).  \fIfirst\fR and \fIlast\fR may be
specified using the forms described in \fBSTRING INDICES\fR.
specified as for the \fBindex\fR method.
.TP
\fBstring trim \fIstring\fR ?\fIchars\fR?
.
Returns a value equal to \fIstring\fR except that any leading or
trailing characters present in the string given by \fIchars\fR are removed.  If
\fIchars\fR is not specified then white space is removed (any character
\fIchars\fR is not specified then white space is removed (spaces,
for which \fBstring is space\fR returns 1, and "\e0").
tabs, newlines, and carriage returns).
.TP
\fBstring trimleft \fIstring\fR ?\fIchars\fR?
.
Returns a value equal to \fIstring\fR except that any leading
characters present in the string given by \fIchars\fR are removed.  If
\fIchars\fR is not specified then white space is removed (any character
\fIchars\fR is not specified then white space is removed (spaces,
for which \fBstring is space\fR returns 1, and "\e0").
tabs, newlines, and carriage returns).
.TP
\fBstring trimright \fIstring\fR ?\fIchars\fR?
.
Returns a value equal to \fIstring\fR except that any trailing
characters present in the string given by \fIchars\fR are removed.  If
\fIchars\fR is not specified then white space is removed (any character
\fIchars\fR is not specified then white space is removed (spaces,
for which \fBstring is space\fR returns 1, and "\e0").
.SS "OBSOLETE SUBCOMMANDS"
tabs, newlines, and carriage returns).
.SH "OBSOLETE SUBCOMMANDS"
.PP
These subcommands are currently supported, but are likely to go away in a
future release as their functionality is either virtually never used or highly
misleading.
.TP
\fBstring bytelength \fIstring\fR
.
Returns a decimal string giving the number of bytes used to represent
\fIstring\fR in memory when encoded as Tcl's internal modified UTF\-8;
\fIstring\fR in memory.  Because UTF\-8 uses one to three bytes to
Tcl may use other encodings for \fIstring\fR as well, and does not
guarantee to only use a single encoding for a particular \fIstring\fR.
Because UTF\-8 uses a variable number of bytes to represent Unicode
characters, the byte length will not be the same as the character
length in general.  The cases where a script cares about the byte
represent Unicode characters, the byte length will not be the same as
the character length in general.  The cases where a script cares about
length are rare.
.RS
.PP
In almost all cases, you should use the
the byte length are rare.  In almost all cases, you should use the
\fBstring length\fR operation (including determining the length of a
Tcl byte array value).  Refer to the \fBTcl_NumUtfChars\fR manual
Tcl ByteArray object).  Refer to the \fBTcl_NumUtfChars\fR manual
entry for more details on the UTF\-8 representation.
.PP
Formally, the \fBstring bytelength\fR operation returns the content of
the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
\fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
denormalized NUL (identical to that used in a number of places by
Java's serialization mechanism) to enable basic processing with
non-Unicode-aware C functions.  As this representation should only
ever be used by Tcl's implementation, the number of bytes used to
store the representation is of very low value (except to C extension
code, which has direct access for the purpose of memory management,
etc.)
.PP
\fICompatibility note:\fR it is likely that this subcommand will be
withdrawn in a future version of Tcl. It is better to use the
\fBencoding convertto\fR command to convert a string to a known
encoding and then apply \fBstring length\fR to that.
.PP
.CS
\fBstring length\fR [encoding convertto utf-8 $theString]
.CE
.RE
.TP
\fBstring wordend \fIstring charIndex\fR
.
Returns the index of the character just after the last one in the word
containing character \fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR
may be specified using the forms in \fBSTRING INDICES\fR.  A word is
may be specified as for the \fBindex\fR method.  A word is
considered to be any contiguous range of alphanumeric (Unicode letters
or decimal digits) or underscore (Unicode connector punctuation)
characters, or any single character other than these.
.TP
\fBstring wordstart \fIstring charIndex\fR
.
Returns the index of the first character in the word containing character
\fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR may be specified using the
forms in \fBSTRING INDICES\fR.  A word is considered to be any contiguous
range of alphanumeric (Unicode letters or decimal digits) or underscore
(Unicode connector punctuation) characters, or any single character other than
these.
Returns the index of the first character in the word containing
character \fIcharIndex\fR of \fIstring\fR.  \fIcharIndex\fR may be
specified as for the \fBindex\fR method.  A word is considered to be any
contiguous range of alphanumeric (Unicode letters or decimal digits)
or underscore (Unicode connector punctuation) characters, or any
single character other than these.
.SH "STRING INDICES"
.PP
When referring to indices into a string (e.g., for \fBstring index\fR
or \fBstring range\fR) the following formats are supported:
.IP \fIinteger\fR 10
For any index value that passes \fBstring is integer \-strict\fR,
the char specified at this integral index (e.g., \fB2\fR would refer to the
.QW c
in
.QW abcd ).
.IP \fBend\fR 10
The last char of the string (e.g., \fBend\fR would refer to the
.QW d
in
.QW abcd ).
.IP \fBend\-\fIN\fR 10
The last char of the string minus the specified integer offset \fIN\fR (e.g.,
.QW \fBend\-1\fR
would refer to the
.QW c
in
.QW abcd ).
.IP \fBend+\fIN\fR 10
The last char of the string plus the specified integer offset \fIN\fR (e.g.,
.QW \fBend+\-1\fR
would refer to the
.QW c
in
.QW abcd ).
.IP \fIM\fB+\fIN\fR 10
The char specified at the integral index that is the sum of
integer values \fIM\fR and \fIN\fR (e.g.,
.QW \fB1+1\fR
would refer to the
.QW c
in
.QW abcd ).
.IP \fIM\fB\-\fIN\fR 10
The char specified at the integral index that is the difference of
integer values \fIM\fR and \fIN\fR (e.g.,
.QW \fB2\-1\fR
would refer to the
.QW b
in
.QW abcd ).
.PP
In the specifications above, the integer value \fIM\fR contains no
trailing whitespace and the integer value \fIN\fR contains no
leading whitespace.
.SH EXAMPLE
.PP
Test if the string in the variable \fIstring\fR is a proper non-empty
prefix of the string \fBfoobar\fR.
.PP
.CS
set length [\fBstring length\fR $string]
if {$length == 0} {
    set isPrefix 0
} else {
    set isPrefix [\fBstring equal\fR \-length $length $string "foobar"]
    set isPrefix [\fBstring equal\fR -length $length $string "foobar"]
}
.CE

.SH "SEE ALSO"
expr(n), list(n)

.SH KEYWORDS
case conversion, compare, index, integer value, match, pattern, string, word, equal,
case conversion, compare, index, match, pattern, string, word, equal,
ctype, character, reverse

.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/subst.n.

1
2
3
4
5
6
7
8

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

8
9
10
11
12
13
14
15







-
+







'\"
'\" Copyright (c) 1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2001 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH subst n 7.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
subst \- Perform backslash, command, and variable substitutions
.SH SYNOPSIS
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43







-
+







If any of the \fB\-nobackslashes\fR, \fB\-nocommands\fR, or
\fB\-novariables\fR are specified, then the corresponding substitutions
are not performed.
For example, if \fB\-nocommands\fR is specified, command substitution
is not performed:  open and close brackets are treated as ordinary characters
with no special interpretation.
.PP
Note that the substitution of one kind can include substitution of
Note that the substitution of one kind can include substitution of 
other kinds.  For example, even when the \fB\-novariables\fR option
is specified, command substitution is performed without restriction.
This means that any variable substitution necessary to complete the
command substitution will still take place.  Likewise, any command
substitution necessary to complete a variable substitution will
take place, even when \fB\-nocommands\fR is specified.  See the
\fBEXAMPLES\fR below.
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
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










-




-





-




-







-




-







-





-









-



-





-



-






-



-





-



-







-
+
-
-
-
by \fBsubst\fR.  The \fBsubst\fR command
itself will either return an error, or will complete successfully.
.SH EXAMPLES
.PP
When it performs its substitutions, \fIsubst\fR does not give any
special treatment to double quotes or curly braces (except within
command substitutions) so the script
.PP
.CS
set a 44
\fBsubst\fR {xyz {$a}}
.CE
.PP
returns
.QW "\fBxyz {44}\fR" ,
not
.QW "\fBxyz {$a}\fR"
and the script
.PP
.CS
set a "p\e} q \e{r"
\fBsubst\fR {xyz {$a}}
.CE
.PP
returns
.QW "\fBxyz {p} q {r}\fR" ,
not
.QW "\fBxyz {p\e} q \e{r}\fR".
.PP
When command substitution is performed, it includes any variable
substitution necessary to evaluate the script.
.PP
.CS
set a 44
\fBsubst\fR -novariables {$a [format $a]}
.CE
.PP
returns
.QW "\fB$a 44\fR" ,
not
.QW "\fB$a $a\fR" .
Similarly, when
variable substitution is performed, it includes any command
substitution necessary to retrieve the value of the variable.
.PP
.CS
proc b {} {return c}
array set a {c c [b] tricky}
\fBsubst\fR -nocommands {[b] $a([b])}
.CE
.PP
returns
.QW "\fB[b] c\fR" ,
not
.QW "\fB[b] tricky\fR" .
.PP
The continue and break exceptions allow command substitutions to
prevent substitution of the rest of the command substitution and the
rest of \fIstring\fR respectively, giving script authors more options
when processing text using \fIsubst\fR.  For example, the script
.PP
.CS
\fBsubst\fR {abc,[break],def}
.CE
.PP
returns
.QW \fBabc,\fR ,
not
.QW \fBabc,,def\fR
and the script
.PP
.CS
\fBsubst\fR {abc,[continue;expr {1+2}],def}
.CE
.PP
returns
.QW \fBabc,,def\fR ,
not
.QW \fBabc,3,def\fR .
.PP
Other exceptional return codes substitute the returned value
.PP
.CS
\fBsubst\fR {abc,[return foo;expr {1+2}],def}
.CE
.PP
returns
.QW \fBabc,foo,def\fR ,
not
.QW \fBabc,3,def\fR
and
.PP
.CS
\fBsubst\fR {abc,[return -code 10 foo;expr {1+2}],def}
.CE
.PP
also returns
.QW \fBabc,foo,def\fR ,
not
.QW \fBabc,3,def\fR .
.SH "SEE ALSO"
Tcl(n), eval(n), break(n), continue(n)
.SH KEYWORDS
backslash substitution, command substitution, quoting, substitution, variable substitution
backslash substitution, command substitution, variable substitution
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/switch.n.

1
2
3
4
5
6
7

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

7
8
9
10
11
12
13
14






-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH switch n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
switch \- Evaluate one of several scripts, depending on a given value
.SH SYNOPSIS
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
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







+



+



-




-




-



+
+


-



-












-














+


-


+


+







anything.
If no \fIpattern\fR argument
matches \fIstring\fR and no default is given, then the \fBswitch\fR
command returns an empty string.
.PP
If the initial arguments to \fBswitch\fR start with \fB\-\fR then
they are treated as options
.VS 8.5
unless there are exactly two arguments to \fBswitch\fR (in which case the
first must the \fIstring\fR and the second must be the
\fIpattern\fR/\fIbody\fR list).
.VE 8.5
The following options are currently supported:
.TP 10
\fB\-exact\fR
.
Use exact matching when comparing \fIstring\fR to a pattern.  This
is the default.
.TP 10
\fB\-glob\fR
.
When matching \fIstring\fR to the patterns, use glob-style matching
(i.e. the same as implemented by the \fBstring match\fR command).
.TP 10
\fB\-regexp\fR
.
When matching \fIstring\fR to the patterns, use regular
expression matching
(as described in the \fBre_syntax\fR reference page).
'\" Options defined by TIP#75
.VS 8.5
.TP 10
\fB\-nocase\fR
.
Causes comparisons to be handled in a case-insensitive manner.
.TP 10
\fB\-matchvar\fR \fIvarName\fR
.
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of matches
found by the regular expression engine will be written.  The first
element of the list written will be the overall substring of the input
string (i.e. the \fIstring\fR argument to \fBswitch\fR) matched, the
second element of the list will be the substring matched by the first
capturing parenthesis in the regular expression that matched, and so
on.  When a \fBdefault\fR branch is taken, the variable will have the
empty list written to it.  This option may be specified at the same
time as the \fB\-indexvar\fR option.
.TP 10
\fB\-indexvar\fR \fIvarName\fR
.
This option (only legal when \fB\-regexp\fR is also specified)
specifies the name of a variable into which the list of indices
referring to matching substrings
found by the regular expression engine will be written.  The first
element of the list written will be a two-element list specifying the
index of the start and index of the first character after the end of
the overall substring of the input
string (i.e. the \fIstring\fR argument to \fBswitch\fR) matched, in a
similar way to the \fB\-indices\fR option to the \fBregexp\fR can
obtain.  Similarly, the second element of the list refers to the first
capturing parenthesis in the regular expression that matched, and so
on.  When a \fBdefault\fR branch is taken, the variable will have the
empty list written to it.  This option may be specified at the same
time as the \fB\-matchvar\fR option.
.VE 8.5
.TP 10
\fB\-\|\-\fR
.
Marks the end of options.  The argument following this one will
be treated as \fIstring\fR even if it starts with a \fB\-\fR.
.VS 8.5
This is not required when the matching patterns and bodies are grouped
together in a single argument.
.VE 8.5
.PP
Two syntaxes are provided for the \fIpattern\fR and \fIbody\fR arguments.
The first uses a separate argument for each of the patterns and commands;
this form is convenient if substitutions are desired on some of the
patterns or commands.
The second form places all of the patterns and commands together into
a single argument; the argument must have proper list structure, with
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
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







-


-








-


-
-
-
-
+
+
+
+





-


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



+


-


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


+







This feature makes it possible to share a single \fIbody\fR among
several patterns.
.PP
Beware of how you place comments in \fBswitch\fR commands.  Comments
should only be placed \fBinside\fR the execution body of one of the
patterns, and not intermingled with the patterns.
.SH "EXAMPLES"
.PP
The \fBswitch\fR command can match against variables and not just
literals, as shown here (the result is \fI2\fR):
.PP
.CS
set foo "abc"
\fBswitch\fR abc a \- b {expr {1}} $foo {expr {2}} default {expr {3}}
.CE
.PP
Using glob matching and the fall-through body is an alternative to
writing regular expressions with alternations, as can be seen here
(this returns \fI1\fR):
.PP
.CS
\fBswitch\fR \-glob aaab {
    a*b     \-
    b       {expr {1}}
    a*      {expr {2}}
    default {expr {3}}
   a*b     \-
   b       {expr {1}}
   a*      {expr {2}}
   default {expr {3}}
}
.CE
.PP
Whenever nothing matches, the \fBdefault\fR clause (which must be
last) is taken.  This example has a result of \fI3\fR:
.PP
.CS
\fBswitch\fR xyz {
    a \-
    b {
        # Correct Comment Placement
        expr {1}
    }
    c {
        expr {2}
    }
    default {
        expr {3}
    }
   a \-
   b {
      # Correct Comment Placement
      expr {1}
   }
   c {
      expr {2}
   }
   default {
      expr {3}
   }
}
.CE
.PP
.VS 8.5
When matching against regular expressions, information about what
exactly matched is easily obtained using the \fB\-matchvar\fR option:
.PP
.CS
\fBswitch\fR \-regexp \-matchvar foo \-\- $bar {
    a(b*)c {
        puts "Found [string length [lindex $foo 1]] 'b's"
    }
    d(e*)f(g*)h {
        puts "Found [string length [lindex $foo 1]] 'e's and\e
                [string length [lindex $foo 2]] 'g's"
    }
   a(b*)c {
      puts "Found [string length [lindex $foo 1]] 'b's"
   }
   d(e*)f(g*)h {
      puts "Found [string length [lindex $foo 1]] 'e's and\e
            [string length [lindex $foo 2]] 'g's"
   }
}
.CE
.VE 8.5
.SH "SEE ALSO"
for(n), if(n), regexp(n)
.SH KEYWORDS
switch, match, regular expression
.\" Local Variables:
.\" mode: nroff
.\" End:

Deleted doc/tailcall.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
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





































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH tailcall n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tailcall \- Replace the current procedure with another command
.SH SYNOPSIS
\fBtailcall \fIcommand\fR ?\fIarg ...\fR?
.BE
.SH DESCRIPTION
.PP
The \fBtailcall\fR command replaces the currently executing procedure, lambda
application, or method with another command. The \fIcommand\fR, which will
have \fIarg ...\fR passed as arguments if they are supplied, will be looked up
in the current namespace context, not in the caller's. Apart from that
difference in resolution, it is equivalent to:
.PP
.CS
return [uplevel 1 [list \fIcommand\fR ?\fIarg ...\fR?]]
.CE
.PP
This command may not be invoked from within an \fBuplevel\fR into a procedure
or inside a \fBcatch\fR inside a procedure or lambda.
'\" TODO: sort out the mess with the [try] command!
.SH EXAMPLE
.PP
Compute the factorial of a number.
.PP
.CS
proc factorial {n {accum 1}} {
    if {$n < 2} {
        return $accum
    }
    \fBtailcall\fR factorial [expr {$n - 1}] [expr {$accum * $n}]
}
.CE
.PP
Print the elements of a list with alternating lines having different
indentations.
.PP
.CS
proc printList {theList} {
    if {[llength $theList]} {
        puts "> [lindex $theList 0]"
        \fBtailcall\fR printList2 [lrange $theList 1 end]
    }
}
proc printList2 {theList} {
    if {[llength $theList]} {
        puts "< [lindex $theList 0]"
        \fBtailcall\fR printList [lrange $theList 1 end]
    }
}
.CE
.SH "SEE ALSO"
apply(n), proc(n), uplevel(n)
.SH KEYWORDS
call, recursion, tail recursion
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/tclsh.1.

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
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






-
+







-
+

+













+


+


-
+
+
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH tclsh 1 "" Tcl "Tcl Applications"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tclsh \- Simple shell containing Tcl interpreter
.SH SYNOPSIS
\fBtclsh\fR ?\fB\-encoding \fIname\fR? ?\fIfileName arg arg ...\fR?
\fBtclsh\fR ?-encoding \fIname\fR? ?\fIfileName arg arg ...\fR?
.BE

.SH DESCRIPTION
.PP
\fBTclsh\fR is a shell-like application that reads Tcl commands
from its standard input or from a file and evaluates them.
If invoked with no arguments then it runs interactively, reading
Tcl commands from standard input and printing command results and
error messages to standard output.
It runs until the \fBexit\fR command is invoked or until it
reaches end-of-file on its standard input.
If there exists a file \fB.tclshrc\fR (or \fBtclshrc.tcl\fR on
the Windows platforms) in the home directory of
the user, interactive \fBtclsh\fR evaluates the file as a Tcl script
just before reading the first command from standard input.

.SH "SCRIPT FILES"
.PP
.VS 8.5
If \fBtclsh\fR is invoked with arguments then the first few arguments
specify the name of a script file, and, optionally, the encoding of
the text data stored in that script file. Any additional arguments
the text data stored in that script file. 
.VE 8.5
Any additional arguments
are made available to the script as variables (see below).
Instead of reading commands from standard input \fBtclsh\fR will
read Tcl commands from the named file;  \fBtclsh\fR will exit
when it reaches the end of the file.
The end of the file may be marked either by the physical end of
the medium, or by the character,
.QW \e032
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
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







-



-











-





-







.QW \eu001a ;
or may generate it by use of commands such as \fBformat\fR or \fBbinary\fR.
There is no automatic evaluation of \fB.tclshrc\fR when the name
of a script file is presented on the \fBtclsh\fR command
line, but the script file can always \fBsource\fR it if desired.
.PP
If you create a Tcl script in a file whose first line is
.PP
.CS
\fB#!/usr/local/bin/tclsh\fR
.CE
.PP
then you can invoke the script file directly from your shell if
you mark the file as executable.
This assumes that \fBtclsh\fR has been installed in the default
location in /usr/local/bin;  if it is installed somewhere else
then you will have to modify the above line to match.
Many UNIX systems do not allow the \fB#!\fR line to exceed about
30 characters in length, so be sure that the \fBtclsh\fR
executable can be accessed with a short file name.
.PP
An even better approach is to start your script files with the
following three lines:
.PP
.CS
\fB#!/bin/sh
# the next line restarts using tclsh \e
exec tclsh "$0" ${1+"$@"}\fR
.CE
.PP
This approach has three advantages over the approach in the previous
paragraph.  First, the location of the \fBtclsh\fR binary does not have
to be hard-wired into the script:  it can be anywhere in your shell
search path.  Second, it gets around the 30-character file name limit
in the previous approach.
Third, this approach will work even if \fBtclsh\fR is
itself a shell script (this is done on some systems in order to
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

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







+


-
+
-
-


-




-




-




-



+





-
+








+



-
+
-
-
-
-
-
-
-
-

-
+
+

-
+
line to be treated as part of the comment on the second line.
.PP
You should note that it is also common practice to install tclsh with
its version number as part of the name.  This has the advantage of
allowing multiple versions of Tcl to exist on the same system at once,
but also the disadvantage of making it harder to write scripts that
start up uniformly across different versions of Tcl.

.SH "VARIABLES"
.PP
\fBTclsh\fR sets the following global Tcl variables in addition to those
\fBTclsh\fR sets the following Tcl variables:
created by the Tcl library itself (such as \fBenv\fR, which maps
environment variables such as \fBPATH\fR into Tcl):
.TP 15
\fBargc\fR
.
Contains a count of the number of \fIarg\fR arguments (0 if none),
not including the name of the script file.
.TP 15
\fBargv\fR
.
Contains a Tcl list whose elements are the \fIarg\fR arguments,
in order, or an empty string if there are no \fIarg\fR arguments.
.TP 15
\fBargv0\fR
.
Contains \fIfileName\fR if it was specified.
Otherwise, contains the name by which \fBtclsh\fR was invoked.
.TP 15
\fBtcl_interactive\fR
.
Contains 1 if \fBtclsh\fR is running interactively (no
\fIfileName\fR was specified and standard input is a terminal-like
device), 0 otherwise.

.SH PROMPTS
.PP
When \fBtclsh\fR is invoked interactively it normally prompts for each
command with
.QW "\fB% \fR" .
You can change the prompt by setting the global
You can change the prompt by setting the
variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR.  If variable
\fBtcl_prompt1\fR exists then it must consist of a Tcl script
to output a prompt;  instead of outputting a prompt \fBtclsh\fR
will evaluate the script in \fBtcl_prompt1\fR.
The variable \fBtcl_prompt2\fR is used in a similar way when
a newline is typed but the current command is not yet complete;
if \fBtcl_prompt2\fR is not set then no prompt is output for
incomplete commands.

.SH "STANDARD CHANNELS"
.PP
See \fBTcl_StandardChannels\fR for more explanations.
.SH ZIPVFS

.PP
When a zipfile is concatenated to the end of a \fBtclsh\fR, on
startup the contents of the zip archive will be mounted as the
virtual file system /zvfs. If a top level directory tcl8.6 is
present in the zip archive, it will become the directory loaded
as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
in the top level directory of the zip archive, it will be sourced
instead of the shell's normal command line handing.
.SH "SEE ALSO"
auto_path(n), encoding(n), env(n), fconfigure(n)
encoding(n), fconfigure(n), tclvars(n)

.SH KEYWORDS
application, argument, interpreter, prompt, script file, shell
argument, interpreter, prompt, script file, shell

Changes to doc/tcltest.n.

199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
199
200
201
202
203
204
205

206
207
208
209
210
211
212
213







-
+







to \fBoutputChannel\fR.  This command also restores the original
shell environment, as described by the global \fBenv\fR
array. Returns an empty string.
.RE
.TP
\fBrunAllTests\fR
.
This is a main command meant to run an entire suite of tests,
This is a master command meant to run an entire suite of tests,
spanning multiple files and/or directories, as governed by
the configurable options of \fBtcltest\fR.  See \fBRUNNING ALL TESTS\fR
below for a complete description of the many variations possible
with \fBrunAllTests\fR.
.SS "CONFIGURATION COMMANDS"
.TP
\fBconfigure\fR
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
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







-
+

-
+



-
-
+
+


-
+







and sorted.  Then each file will be evaluated in turn.  If
\fBconfigure \-singleproc\fR is true, then each file will
be \fBsource\fRd in the caller's context.  If it is false,
then a copy of \fBinterpreter\fR will be \fBexec\fR'd to
evaluate each file.  The multi-process operation is useful
when testing can cause errors so severe that a process
terminates.  Although such an error may terminate a child
process evaluating one file, the main process can continue
process evaluating one file, the master process can continue
with the rest of the test suite.  In multi-process operation,
the configuration of \fBtcltest\fR in the main process is
the configuration of \fBtcltest\fR in the master process is
passed to the child processes as command line arguments,
with the exception of \fBconfigure \-outfile\fR.  The
\fBrunAllTests\fR command in the
main process collects all output from the child processes
and collates their results into one main report.  Any
master process collects all output from the child processes
and collates their results into one master report.  Any
reports of individual test failures, or messages requested
by a \fBconfigure \-verbose\fR setting are passed directly
on to \fBoutputChannel\fR by the main process.
on to \fBoutputChannel\fR by the master process.
.PP
After evaluating all selected test files, a summary of the
results is printed to \fBoutputChannel\fR.  The summary
includes the total number of \fBtest\fRs evaluated, broken
down into those skipped, those passed, and those failed.
The summary also notes the number of files evaluated, and the names
of any files with failing tests or errors.  A list of
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
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







-
+










-
+







all files to be evaluated in a common interpreter.  A simple way to
achieve this is to have your tests define all their commands and variables
in a namespace that is deleted when the test file evaluation is complete.
A good namespace to use is a child namespace \fBtest\fR of the namespace
of the module you are testing.
.PP
A test file should also be able to be evaluated directly as a script,
not depending on being called by a main \fBrunAllTests\fR.  This
not depending on being called by a master \fBrunAllTests\fR.  This
means that each test file should process command line arguments to give
the tester all the configuration control that \fBtcltest\fR provides.
.PP
After all \fBtest\fRs in a test file, the command \fBcleanupTests\fR
should be called.
.IP [7]
Here is a sketch of a sample test file illustrating those points:
.RS
.PP
.CS
package require tcltest 2.5
package require tcltest 2.2
eval \fB::tcltest::configure\fR $argv
package require example
namespace eval ::example::test {
    namespace import ::tcltest::*
    \fBtestConstraint\fR X [expr {...}]
    variable SETUP {#common setup code}
    variable CLEANUP {#common cleanup code}
1171
1172
1173
1174
1175
1176
1177
1178

1179
1180
1181
1182
1183


1184
1185
1186
1187
1188
1189
1190
1171
1172
1173
1174
1175
1176
1177

1178
1179
1180
1181


1182
1183
1184
1185
1186
1187
1188
1189
1190







-
+



-
-
+
+







The next level of organization is a full test suite, made up of several
test files.  One script is used to control the entire suite.  The
basic function of this script is to call \fBrunAllTests\fR after
doing any necessary setup.  This script is usually named \fBall.tcl\fR
because that is the default name used by \fBrunAllTests\fR when combining
multiple test suites into one testing run.
.IP [8]
Here is a sketch of a sample test suite main script:
Here is a sketch of a sample test suite master script:
.RS
.PP
.CS
package require Tcl 8.6
package require tcltest 2.5
package require Tcl 8.4
package require tcltest 2.2
package require example
\fB::tcltest::configure\fR -testdir \e
        [file dirname [file normalize [info script]]]
eval \fB::tcltest::configure\fR $argv
\fB::tcltest::runAllTests\fR
.CE
.RE

Changes to doc/tclvars.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
44
45
46
47
48
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






-
+





-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH tclvars n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
argc, argv, argv0, auto_path, env, errorCode, errorInfo, tcl_interactive, tcl_library, tcl_nonwordchars, tcl_patchLevel, tcl_pkgPath, tcl_platform, tcl_rcFileName, tcl_traceCompile, tcl_traceExec, tcl_wordchars, tcl_version \- Variables used by Tcl
tclvars \- Variables used by Tcl
.BE
.SH DESCRIPTION
.PP
The following global variables are created and managed automatically
by the Tcl library.  Except where noted below, these variables should
normally be treated as read-only by application-specific code and by users.
.TP
\fBauto_path\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations (including for package index
files when using the default \fBpackage unknown\fR handler).
This variable is initialized during startup to contain, in order:
the directories listed in the \fBTCLLIBPATH\fR environment variable,
the directory named by the \fBtcl_library\fR global variable,
the parent directory of \fBtcl_library\fR,
the directories listed in the \fBtcl_pkgPath\fR variable.
Additional locations to look for files and package indices should
normally be added to this variable using \fBlappend\fR.
.RS
.PP
Additional variables relating to package management exist. More
details are listed in the \fBVARIABLES\fR section of the \fBlibrary\fR
manual page.
.RE
.TP
\fBenv\fR
.
This variable is maintained by Tcl as an array
whose elements are the environment variables for the process.
Reading an element will return the value of the corresponding
environment variable.
Setting an element of the array will modify the corresponding
environment variable or create a new one if it does not already
exist.
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
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







-
+





-
-
-
-
-
-
-
-
-
-
-


-
+
-




-







.PP
Note that this environment variable should \fInot\fR normally be set.
.RE
.TP
\fBenv(TCLLIBPATH)\fR
.
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations.  Directories must be specified in
search during auto-load operations.  Directories must be specified in 
Tcl format, using
.QW /
as the path separator, regardless of platform.
This variable is only used when initializing the \fBauto_path\fR variable.
.TP
\fBenv(TCL_TZ)\fR, \fBenv(TZ)\fR
.
These specify the default timezone used for parsing and formatting times and
dates in the \fBclock\fR command. On many platforms, the TZ environment
variable is set up by the operating system.
.TP
\fBenv(LC_ALL)\fR, \fBenv(LC_MESSAGES)\fR, \fBenv(LANG)\fR
.
These environment variables are used by the \fBmsgcat\fR package to
determine what locale to format messages using.
.TP
\fBenv(TCL_INTERP_DEBUG_FRAME)\fR
.
If existing, it has the same effect as running \fBinterp debug\fR
If existing, it has the same effect as running \fBinterp debug {} -frame 1\fR
\fB{} -frame 1\fR
as the very first command of each new Tcl interpreter.
.RE
.TP
\fBerrorCode\fR
.
This variable holds the value of the \fB\-errorcode\fR return option
set by the most recent error that occurred in this interpreter.
This list value represents additional information about the error
in a form that is easy to process with programs.
The first element of the list identifies a general class of
errors, and determines the format of the rest of the list.
The following formats for \fB\-errorcode\fR return options
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
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







-











-






-












-







-









-
-
-
-
-









+
+
+
+
+


-









-



-
+







.RS
.PP
Detection of these errors depends in part on the underlying hardware
and system libraries.
.RE
.TP
\fBCHILDKILLED\fI pid sigName msg\fR
.
This format is used when a child process has been killed because of
a signal.  The \fIpid\fR element will be the process's identifier (in decimal).
The \fIsigName\fR element will be the symbolic name of the signal that caused
the process to terminate; it will be one of the names from the
include file signal.h, such as \fBSIGPIPE\fR.
The \fImsg\fR element will be a short human-readable message
describing the signal, such as
.QW "write on pipe with no readers"
for \fBSIGPIPE\fR.
.TP
\fBCHILDSTATUS\fI pid code\fR
.
This format is used when a child process has exited with a non-zero
exit status.  The \fIpid\fR element will be the
process's identifier (in decimal) and the \fIcode\fR element will be the exit
code returned by the process (also in decimal).
.TP
\fBCHILDSUSP\fI pid sigName msg\fR
.
This format is used when a child process has been suspended because
of a signal.
The \fIpid\fR element will be the process's identifier, in decimal.
The \fIsigName\fR element will be the symbolic name of the signal that caused
the process to suspend; this will be one of the names from the
include file signal.h, such as \fBSIGTTIN\fR.
The \fImsg\fR element will be a short human-readable message
describing the signal, such as
.QW "background tty read"
for \fBSIGTTIN\fR.
.TP
\fBNONE\fR
.
This format is used for errors where no additional information is
available for an error besides the message returned with the
error.  In these cases the \fB\-errorcode\fR return option
will consist of a list containing a single element whose
contents are \fBNONE\fR.
.TP
\fBPOSIX \fIerrName msg\fR
.
If the first element is \fBPOSIX\fR, then
the error occurred during a POSIX kernel call.
The \fIerrName\fR element will contain the symbolic name
of the error that occurred, such as \fBENOENT\fR; this will
be one of the values defined in the include file errno.h.
The \fImsg\fR element will be a human-readable
message corresponding to \fIerrName\fR, such as
.QW "no such file or directory"
for the \fBENOENT\fR case.
.TP
\fBTCL\fR ...
.
Indicates some sort of problem generated in relation to Tcl itself, e.g. a
failure to look up a channel or variable.
.PP
To set the \fB\-errorcode\fR return option, applications should use library
procedures such as \fBTcl_SetObjErrorCode\fR, \fBTcl_SetReturnOptions\fR,
and \fBTcl_PosixError\fR, or they may invoke the \fB\-errorcode\fR
option of the \fBreturn\fR command.
If none of these methods for setting the error code has been used,
the Tcl interpreter will reset the variable to \fBNONE\fR after
the next error.
.RE
.\" .TP
.\" \fBTCL\fR ...
.\" .
.\" Indicates some sort of problem generated in relation to Tcl itself,
.\" e.g. a failure to look up a channel or variable.
.TP
\fBerrorInfo\fR
.
This variable holds the value of the \fB\-errorinfo\fR return option
set by the most recent error that occurred in this interpreter.
This string value will contain one or more lines
identifying the Tcl commands and procedures that were being executed
when the most recent error occurred.
Its contents take the form of a stack trace showing the various
nested Tcl commands that had been invoked at the time of the error.
.TP
\fBtcl_library\fR
.
This variable holds the name of a directory containing the
system library of Tcl scripts, such as those used for auto-loading.
The value of this variable is returned by the \fBinfo library\fR command.
See the \fBlibrary\fR manual entry for details of the facilities
See the \fBlibrary\fR manual entry for details of the facilities 
provided by the Tcl script library.
Normally each application or package will have its own application-specific
script library in addition to the Tcl script library;
each application should set a global variable with a name like
\fB$\fIapp\fB_library\fR (where \fIapp\fR is the application's name)
to hold the network file name for that application's library directory.
The initial value of \fBtcl_library\fR is set when an interpreter
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
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
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
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
450
451
452
453

454
455
456

457












458
459


460


461








462
463










464

465
466

467











-






-
+
-
-
+









-











-

-
+


-












-




-
+
-

-
+

+
+
+


-

-
-
+
+
+
-
-
-
-


-



-
-
-
-
-

-




-






+
+
-
-
-
+
+
+
+


-
+

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



-
-
+
+

-
+










-



-
-
+
+






-
+













-










-










-








-





-



-



-





-



-

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

-
+

-
+
-
-
-
-
hold a string giving the current patch level for Tcl, such as
\fB8.4.16\fR for Tcl 8.4 with the first sixteen official patches, or
\fB8.5b3\fR for the third beta release of Tcl 8.5.
The value of this variable is returned by the \fBinfo patchlevel\fR
command.
.TP
\fBtcl_pkgPath\fR
.
This variable holds a list of directories indicating where packages are
normally installed.  It is not used on Windows.  It typically contains
either one or two entries; if it contains two entries, the first is
normally a directory for platform-dependent packages (e.g., shared library
binaries) and the second is normally a directory for platform-independent
packages (e.g., script files). Typically a package is installed as a
subdirectory of one of the entries in the \fBtcl_pkgPath\fR
subdirectory of one of the entries in \fB$tcl_pkgPath\fR. The directories
variable. The directories in the \fBtcl_pkgPath\fR variable are
included by default in the \fBauto_path\fR
in \fB$tcl_pkgPath\fR are included by default in the \fBauto_path\fR
variable, so they and their immediate subdirectories are automatically
searched for packages during \fBpackage require\fR commands.  Note:
\fBtcl_pkgPath\fR is not intended to be modified by the application.  Its
value is added to \fBauto_path\fR at startup; changes to \fBtcl_pkgPath\fR
are not reflected in \fBauto_path\fR.  If you want Tcl to search additional
directories for packages you should add the names of those directories to
\fBauto_path\fR, not \fBtcl_pkgPath\fR.
.TP
\fBtcl_platform\fR
.
This is an associative array whose elements contain information about
the platform on which the application is running, such as the name of
the operating system, its current release number, and the machine's
instruction set.  The elements listed below will always
be defined, but they may have empty strings as values if Tcl could not
retrieve any relevant information.  In addition, extensions
and applications may add additional values to the array.  The
predefined elements are:
.RS
.TP
\fBbyteOrder\fR
.
The native byte order of this machine: either \fBlittleEndian\fR or
\fBbigEndian\fR.
\fBbigEndian\fR. 
.TP
\fBdebug\fR
.
If this variable exists, then the interpreter was compiled with and linked
to a debug-enabled C run-time.  This variable will only exist on Windows,
so extension writers can specify which package to load depending on the
C run-time library that is in use.  This is not an indication that this core
contains symbols.
.TP
\fBengine\fR
.
The name of the Tcl language implementation.  When the interpreter is first
created, this is always set to the string \fBTcl\fR.
.TP
\fBmachine\fR
.
The instruction set executed by this machine, such as
\fBintel\fR, \fBPPC\fR, \fB68k\fR, or \fBsun4m\fR.  On UNIX machines, this
is the value returned by \fBuname -m\fR.
.TP
\fBos\fR
\fBos\fR 
.
The name of the operating system running on this machine,
such as \fBWindows NT\fR or \fBSunOS\fR.
such as \fBWindows 95\fR, \fBWindows NT\fR, or \fBSunOS\fR.
On UNIX machines, this is the value returned by \fBuname -s\fR.
On Windows 95 and Windows 98, the value returned will be \fBWindows
95\fR to provide better backwards compatibility to Windows 95; to
distinguish between the two, check the \fBosVersion\fR.
.TP
\fBosVersion\fR
.
The version number for the operating system running on this machine.
On UNIX machines, this is the value returned by \fBuname -r\fR.
.TP
On UNIX machines, this is the value returned by \fBuname -r\fR.  On
Windows 95, the version will be 4.0; on Windows 98, the version will
be 4.10.
\fBpathSeparator\fR
'\" Defined by TIP #315
The character that should be used to \fBsplit\fR PATH-like environment
variables into their corresponding list of directory names.
.TP
\fBplatform\fR
.
Either \fBwindows\fR, or \fBunix\fR.  This identifies the
general operating environment of the machine.
.TP
\fBpointerSize\fR
.
This gives the size of the native-machine pointer in bytes (strictly, it
is same as the result of evaluating \fIsizeof(void*)\fR in C.)
.TP
\fBthreaded\fR
.
If this variable exists, then the interpreter
was compiled with threads enabled.
.TP
\fBuser\fR
.
This identifies the
current user based on the login information available on the platform.
This value comes from the getuid() and getpwuid() system calls on Unix,
and the value from the GetUserName() system call on Windows.
.TP
\fBwordSize\fR
This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.
This gives the size of the native-machine word in bytes (strictly, it
is same as the result of evaluating \fIsizeof(long)\fR in C.)
.TP
\fBpointerSize\fR
This gives the size of the native-machine pointer in bytes (strictly, it
is same as the result of evaluating \fIsizeof(void*)\fR in C.)
.RE
.TP
\fBtcl_traceCompile\fR
\fBtcl_precision\fR
.
This variable controls the number of digits to generate
when converting floating-point values to strings.  It defaults
to 0.  \fIApplications should not change this value;\fR it is
provided for compatibility with legacy code.
.PP
.RS
The default value of 0 is special, meaning that Tcl should
convert numbers using as few digits as possible while still
distinguishing any floating point number from its nearest
neighbours.  It differs from using an arbitrarily high value
for \fItcl_precision\fR in that an inexact number like \fI1.4\fR
will convert as \fI1.4\fR rather than \fI1.3999999999999999\fR
even though the latter is nearer to the exact value of the
binary number.
.RE
.PP
.RS
If \fBtcl_precision\fR is not zero, then when Tcl converts a floating
point number, it creates a decimal representation of at most 
\fBtcl_precision\fR significant digits; the result may be shorter if
the shorter result represents the original number exactly. If no
result of at most \fBtcl_precision\fR digits is an exact representation
of the original number, the one that is closest to the original
number is chosen.
If the original number lies precisely between two equally accurate
decimal representations, then the one with an even value for the least
significant digit is chosen; for instance, if \fBtcl_precision\fR is 3, then
0.3125 will convert to 0.312, not 0.313, while 0.6875 will convert to
0.688, not 0.687. Any string of trailing zeroes that remains is trimmed.
.RE
.PP
.RS
a \fBtcl_precision\fR value of 17 digits is
.QW perfect
for IEEE floating-point in that it allows
double-precision values to be converted to strings and back to
binary with no loss of information. For this reason, you will often
see it as a value in legacy code that must run on Tcl versions before
8.5. It is no longer recommended; as noted above, a zero value is the
preferred method.
.RE
.PP
.RS
All interpreters in a thread share a single \fBtcl_precision\fR value:
changing it in one interpreter will affect all other interpreters as
well.  Safe interpreters are not allowed to modify the
variable.
.RE
.PP
.RS
Valid values for \fBtcl_precision\fR range from 0 to 17.
.RE
.TP
\fBtcl_rcFileName\fR
This variable is used during initialization to indicate the name of a
user-specific startup file.  If it is set by application-specific
initialization, then the Tcl startup code will check for the existence
of this file and \fBsource\fR it if it exists.  For example, for \fBwish\fR
the variable is set to \fB~/.wishrc\fR for Unix and \fB~/wishrc.tcl\fR
for Windows.
.TP
\fBtcl_traceCompile\fR
The value of this variable can be set to control
how much tracing information
is displayed during bytecode compilation.
By default, \fBtcl_traceCompile\fR is zero and no information is displayed.
Setting \fBtcl_traceCompile\fR to 1 generates a one-line summary in \fBstdout\fR
By default, tcl_traceCompile is zero and no information is displayed.
Setting tcl_traceCompile to 1 generates a one-line summary in stdout
whenever a procedure or top-level command is compiled.
Setting it to 2 generates a detailed listing in \fBstdout\fR of the
Setting it to 2 generates a detailed listing in stdout of the
bytecode instructions emitted during every compilation.
This variable is useful in
tracking down suspected problems with the Tcl compiler.
.PP
.RS
This variable and functionality only exist if
\fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation.
.RE
.TP
\fBtcl_traceExec\fR
.
The value of this variable can be set to control
how much tracing information
is displayed during bytecode execution.
By default, \fBtcl_traceExec\fR is zero and no information is displayed.
Setting \fBtcl_traceExec\fR to 1 generates a one-line trace in \fBstdout\fR
By default, tcl_traceExec is zero and no information is displayed.
Setting tcl_traceExec to 1 generates a one-line trace in stdout
on each call to a Tcl procedure.
Setting it to 2 generates a line of output
whenever any Tcl command is invoked
that contains the name of the command and its arguments.
Setting it to 3 produces a detailed trace showing the result of
executing each bytecode instruction.
Note that when \fBtcl_traceExec\fR is 2 or 3,
Note that when tcl_traceExec is 2 or 3,
commands such as \fBset\fR and \fBincr\fR
that have been entirely replaced by a sequence
of bytecode instructions are not shown.
Setting this variable is useful in
tracking down suspected problems with the bytecode compiler
and interpreter.
.PP
.RS
This variable and functionality only exist if
\fBTCL_COMPILE_DEBUG\fR was defined during Tcl's compilation.
.RE
.TP
\fBtcl_wordchars\fR
.
The value of this variable is a regular expression that can be set to
control what are considered
.QW word
characters, for instances like
selecting a word by double-clicking in text in Tk.  It is platform
dependent.  On Windows, it defaults to \fB\eS\fR, meaning anything
but a Unicode space character.  Otherwise it defaults to \fB\ew\fR,
which is any Unicode word character (number, letter, or underscore).
.TP
\fBtcl_nonwordchars\fR
.
The value of this variable is a regular expression that can be set to
control what are considered
.QW non-word
characters, for instances like
selecting a word by double-clicking in text in Tk.  It is platform
dependent.  On Windows, it defaults to \fB\es\fR, meaning any Unicode space
character.  Otherwise it defaults to \fB\eW\fR, which is anything but a
Unicode word character (number, letter, or underscore).
.TP
\fBtcl_version\fR
.
When an interpreter is created Tcl initializes this variable to
hold the version number for this version of Tcl in the form \fIx.y\fR.
Changes to \fIx\fR represent major changes with probable
incompatibilities and changes to \fIy\fR represent small enhancements and
bug fixes that retain backward compatibility.
The value of this variable is returned by the \fBinfo tclversion\fR
command.
.SH "OTHER GLOBAL VARIABLES"
.PP
The following variables are only guaranteed to exist in \fBtclsh\fR
and \fBwish\fR executables; the Tcl library does not define them
itself but many Tcl environments do.
.TP 6
\fBargc\fR
.
The number of arguments to \fBtclsh\fR or \fBwish\fR.
.TP 6
\fBargv\fR
.
Tcl list of arguments to \fBtclsh\fR or \fBwish\fR.
.TP 6
\fBargv0\fR
.
The script that \fBtclsh\fR or \fBwish\fR started executing (if it was
specified) or otherwise the name by which \fBtclsh\fR or \fBwish\fR
was invoked.
.TP 6
\fBtcl_interactive\fR
.
Contains 1 if \fBtclsh\fR or \fBwish\fR is running interactively (no
script was specified and standard input is a terminal-like device), 0
otherwise.
.SH EXAMPLES
.PP
To add a directory to the collection of locations searched by
\fBpackage require\fR, e.g., because of some application-specific
packages that are used, the \fBauto_path\fR variable needs to be
updated:
.PP
.CS
lappend ::\fBauto_path\fR [file join [pwd] "theLibDir"]
.CE
.PP
A simple though not very robust way to handle command line arguments
of the form
.QW "\-foo 1 \-bar 2"
The \fBwish\fR executable additionally specifies the following global
variable:
is to load them into an array having first loaded in the default settings:
.CS
.TP 6
array set arguments {-foo 0 -bar 0 -grill 0}
array set arguments $::\fBargv\fR
\fBgeometry\fR
puts "foo is $arguments(-foo)"
puts "bar is $arguments(-bar)"
puts "grill is $arguments(-grill)"
.CE
.PP
The \fBargv0\fR global variable can be used (in conjunction with the
\fBinfo script\fR command) to determine whether the current script is
being executed as the main script or loaded as a library.  This is
If set, contains the user-supplied geometry specification to use for
the main Tk window.
useful because it allows a single script to be used as both a library
and a demonstration of that library:
.PP
.CS
if {$::\fBargv0\fR eq [info script]} {
    # running as: tclsh example.tcl
} else {
    package provide Example 1.0
}
.CE
.SH "SEE ALSO"
eval(n), library(n), tclsh(1), tkvars(n), wish(1)
eval(n), tclsh(1), wish(1)
.SH KEYWORDS
arithmetic, bytecode, compiler, error, environment, POSIX, precision,
arithmetic, bytecode, compiler, error, environment, POSIX, precision, subprocess, variables
subprocess, user, variables
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/tell.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
44

45
46

47
48
49
50
51
52
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










-
+









+


-
+











-

-











+


+


-
-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH tell n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tell \- Return current access position for an open channel
.SH SYNOPSIS
\fBtell \fIchannelId\fR
.BE

.SH DESCRIPTION
.PP
Returns an integer giving the current access position in
Returns an integer string giving the current access position in
\fIchannelId\fR.  This value returned is a byte offset that can be passed to
\fBseek\fR in order to set the channel to a particular position.  Note
that this value is in terms of bytes, not characters like \fBread\fR.
The value returned is -1 for channels that do not support
seeking.
.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.
.SH EXAMPLE
.PP
Read a line from a file channel only if it starts with \fBfoobar\fR:
.PP
.CS
# Save the offset in case we need to undo the read...
set offset [\fBtell\fR $chan]
if {[read $chan 6] eq "foobar"} {
    gets $chan line
} else {
    set line {}
    # Undo the read...
    seek $chan $offset
}
.CE

.SH "SEE ALSO"
file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)

.SH KEYWORDS
access position, channel, seeking
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/throw.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
44
45
46
47
48
















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 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.
'\"
.TH throw n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
throw \- Generate a machine-readable error
.SH SYNOPSIS
\fBthrow\fI type message\fR
.BE
.SH DESCRIPTION
.PP
This command causes the current evaluation to be unwound with an error. The
error created is described by the \fItype\fR and \fImessage\fR arguments:
\fItype\fR must contain a list of words describing the error in a form that is
machine-readable (and which will form the error-code part of the result
dictionary), and \fImessage\fR should contain text that is intended for
display to a human being.
.PP
The stack will be unwound until the error is trapped by a suitable \fBcatch\fR
or \fBtry\fR command. If it reaches the event loop without being trapped, it
will be reported through the \fBbgerror\fR mechanism. If it reaches the top
level of script evaluation in \fBtclsh\fR, it will be printed on the console
before, in the non-interactive case, causing an exit (the behavior in other
programs will depend on the details of how Tcl is embedded and used).
.PP
By convention, the words in the \fItype\fR argument should go from most
general to most specific.
.SH EXAMPLES
.PP
The following produces an error that is identical to that produced by
\fBexpr\fR when trying to divide a value by zero.
.PP
.CS
\fBthrow\fR {ARITH DIVZERO {divide by zero}} {divide by zero}
.CE
.SH "SEE ALSO"
catch(n), error(n), errorCode(n), errorInfo(n), return(n), try(n)
.SH "KEYWORDS"
error, exception
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/time.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
44
45
46
47
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









-
+









+





-

-
+

-






-







+


+


-
-
-
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH time n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
time \- Time the execution of a script
.SH SYNOPSIS
\fBtime \fIscript\fR ?\fIcount\fR?
.BE

.SH DESCRIPTION
.PP
This command will call the Tcl interpreter \fIcount\fR
times to evaluate \fIscript\fR (or once if \fIcount\fR is not
specified).  It will then return a string of the form
.PP
.CS
\fB503.2 microseconds per iteration\fR
\fB503 microseconds per iteration\fR
.CE
.PP
which indicates the average amount of time required per iteration,
in microseconds.
Time is measured in elapsed time, not CPU time.
.SH EXAMPLE
Estimate how long it takes for a simple Tcl \fBfor\fR loop to count to
a thousand:
.PP
.CS
time {
    for {set i 0} {$i<1000} {incr i} {
        # empty body
    }
}
.CE

.SH "SEE ALSO"
clock(n)

.SH KEYWORDS
script, time
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/tm.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
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





-
+















-







'\"
'\" Copyright (c) 2004-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH tm n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
tm \- Facilities for locating and loading of Tcl Modules
.SH SYNOPSIS
.nf
\fB::tcl::tm::path add \fR?\fIpath\fR...?
\fB::tcl::tm::path remove \fR?\fIpath\fR...?
\fB::tcl::tm::path list\fR
\fB::tcl::tm::roots \fR?\fIpath\fR...?
.fi
.BE
.SH DESCRIPTION
.PP
This document describes the facilities for locating and loading Tcl
Modules (see \fBMODULE DEFINITION\fR for the definition of a Tcl Module).
The following commands are supported:
.TP
\fB::tcl::tm::path add \fR?\fIpath\fR...?
.
The paths are added at the head to the list of module paths, in order
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
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







-



-













-








-



-

+







This command is used internally by the system to set up the
system-specific default paths.
.PP
The command has been exposed to allow a build system to define
additional root paths beyond those described by this document.
.RE
.SH "MODULE DEFINITION"
.PP
A Tcl Module is a Tcl Package contained in a single file, and no other
files required by it. This file has to be \fBsource\fRable. In other
words, a Tcl Module is always imported via:
.PP
.CS
source module_file
.CE
.PP
The \fBload\fR command is not directly used. This restriction is not
an actual limitation, as some may believe.
Ever since 8.4 the Tcl \fBsource\fR command reads only until the first
^Z character. This allows us to combine an arbitrary Tcl script with
arbitrary binary data into one file, where the script processes the
attached data in any it chooses to fully import and activate the
package.
.PP
The name of a module file has to match the regular expression:
.PP
.CS
([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)\e.tm
.CE
.PP
The first capturing parentheses provides the name of the package, the
second clause its version. In addition to matching the pattern, the
extracted version number must not raise an error when used in the
command:
.PP
.CS
package vcompare $version 0
.CE
.SH "FINDING MODULES"
.PP
.SH "FINDING MODULES"
The directory tree for storing Tcl modules is separate from other
parts of the filesystem and independent of \fBauto_path\fR.
.PP
Tcl Modules are searched for in all directories listed in the result
of the command \fB::tcl::tm::path list\fR.
This is called the \fIModule path\fR. Neither the \fBauto_path\fR nor
the \fBtcl_pkgPath\fR variables are used.
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
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







-



-

-







-







the found module files satisfy the request. If the request was
satisfied the fall-back is ignored.
.PP
Note that packages in module form have \fIno\fR control over the
\fIindex\fR and \fIprovide script\fRs entered into the package
database for them.
For a module file \fBMF\fR the \fIindex script\fR is always:
.PP
.CS
package ifneeded \fBPNAME PVERSION\fR [list source \fBMF\fR]
.CE
.PP
and the \fIprovide script\fR embedded in the above is:
.PP
.CS
source \fBMF\fR
.CE
.PP
Both package name \fBPNAME\fR and package version \fBPVERSION\fR are
extracted from the filename \fBMF\fR according to the definition
below:
.PP
.CS
\fBMF\fR = /module_path/\fBPNAME\(fm\fR-\fBPVERSION\fR.tm
.CE
.PP
Where \fBPNAME\(fm\fR is the partial path of the module as defined in
section \fBFINDING MODULES\fR, and translated into \fBPNAME\fR by
changing all directory separators to
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
195
196
197
198
199
200
201

202
203
204
205
206
207
208







-







Given the above we allow the names for packages in Tcl modules to have
mixed-case, but also require that there are no collisions when
comparing names in a case-insensitive manner. In other words, if a
package \fBFoo\fR is deployed in the form of a Tcl Module,
packages like \fBfoo\fR, \fBfOo\fR, etc. are not allowed
anymore.
.SH "DEFAULT PATHS"
.PP
The default list of paths on the module path is computed by a
\fBtclsh\fR as follows, where \fIX\fR is the major version of the Tcl
interpreter and \fIy\fR is less than or equal to the minor version of
the Tcl interpreter.
.PP
All the default paths are added to the module path, even those paths
which do not exist. Non-existent paths are filtered out during actual
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
219
220
221
222
223
224
225

226
227
228
229
230
231
232







-







.
In other words, the interpreter will look into a directory specified
by its major version and whose minor versions are less than or equal
to the minor version of the interpreter.
.RS
.PP
For example for Tcl 8.4 the paths searched are:
.PP
.CS
\fB[info library]/../tcl8/8.4\fR
\fB[info library]/../tcl8/8.3\fR
\fB[info library]/../tcl8/8.2\fR
\fB[info library]/../tcl8/8.1\fR
\fB[info library]/../tcl8/8.0\fR
.CE
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
270
271
272
273
274
275
276

277
278

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293










-
+

-















-
-
-
variable has been kept only for backward compatibility with the
original specification, i.e. TIP 189.
.PP
These paths are seen and therefore shared by all Tcl shells in the
\fB$::env(PATH)\fR of the user.
.PP
Note that \fIX\fR and \fIy\fR follow the general rules set out
above. In other words, Tcl 8.4, for example, will look at these 10
above. In other words, Tcl 8.4, for example, will look at these 5
environment variables:
.PP
.CS
\fB$::env(TCL8.4_TM_PATH)\fR  \fB$::env(TCL8_4_TM_PATH)\fR
\fB$::env(TCL8.3_TM_PATH)\fR  \fB$::env(TCL8_3_TM_PATH)\fR
\fB$::env(TCL8.2_TM_PATH)\fR  \fB$::env(TCL8_2_TM_PATH)\fR
\fB$::env(TCL8.1_TM_PATH)\fR  \fB$::env(TCL8_1_TM_PATH)\fR
\fB$::env(TCL8.0_TM_PATH)\fR  \fB$::env(TCL8_0_TM_PATH)\fR
.CE
.SH "SEE ALSO"
package(n), Tcl Improvement Proposal #189
.QW "\fITcl Modules\fR"
(online at http://tip.tcl.tk/189.html), Tcl Improvement Proposal #190
.QW "\fIImplementation Choices for Tcl Modules\fR"
(online at http://tip.tcl.tk/190.html)
.SH "KEYWORDS"
modules, package
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/trace.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
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







-
+














-
+
-







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH trace n "8.4" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
trace \- Monitor variable accesses, command usages and command executions
.SH SYNOPSIS
\fBtrace \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command causes Tcl commands to be executed whenever certain operations are
invoked.  The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBtrace add \fItype name ops\fR ?\fIargs\fR?
\fBtrace add \fItype name ops ?args?\fR
.
Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
.RS
.TP
\fBtrace add command\fR \fIname ops commandPrefix\fR
.
Arrange for \fIcommandPrefix\fR to be executed (with additional arguments)
whenever command \fIname\fR is modified in one of the ways given by the list
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
50
51
52
53
54
55
56

57
58
59

60
61
62
63
64
65
66







-



-







an empty string. Commands are also deleted when the interpreter is deleted,
but traces will not be invoked because there is no interpreter in which to
execute them.
.PP
When the trace triggers, depending on the operations being traced, a number of
arguments are appended to \fIcommandPrefix\fR so that the actual command is as
follows:
.PP
.CS
\fIcommandPrefix oldName newName op\fR
.CE
.PP
\fIOldName\fR and \fInewName\fR give the traced command's current (old) name,
and the name to which it is being renamed (the empty string if this is a
.QW delete
operation).
\fIOp\fR indicates what operation is being performed on the
command, and is one of \fBrename\fR or \fBdelete\fR as
defined above.  The trace operation cannot be used to stop a command
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
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







-



-













-



-







a procedure will not result in an error and is simply ignored.
.PP
When the trace triggers, depending on the operations being traced, a
number of arguments are appended to \fIcommandPrefix\fR so that the actual
command is as follows:
.PP
For \fBenter\fR and \fBenterstep\fR operations:
.PP
.CS
\fIcommandPrefix command-string op\fR
.CE
.PP
\fICommand-string\fR gives the complete current command being
executed (the traced command for a \fBenter\fR operation, an
arbitrary command for a \fBenterstep\fR operation), including
all arguments in their fully expanded form.
\fIOp\fR indicates what operation is being performed on the
command execution, and is one of \fBenter\fR or \fBenterstep\fR as
defined above.  The trace operation can be used to stop the
command from executing, by deleting the command in question.  Of
course when the command is subsequently executed, an
.QW "invalid command"
error will occur.
.PP
For \fBleave\fR and \fBleavestep\fR operations:
.PP
.CS
\fIcommandPrefix command-string code result op\fR
.CE
.PP
\fICommand-string\fR gives the complete current command being
executed (the traced command for a \fBenter\fR operation, an
arbitrary command for a \fBenterstep\fR operation), including
all arguments in their fully expanded form.
\fICode\fR gives the result code of that execution, and \fIresult\fR
the result string.
\fIOp\fR indicates what operation is being performed on the
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
213
214
215
216
217
218
219

220
221
222

223
224
225
226
227
228
229







-



-







implicitly when procedures return (all of their local variables
are unset).  Variables are also unset when interpreters are
deleted, but traces will not be invoked because there is no
interpreter in which to execute them.
.PP
When the trace triggers, three arguments are appended to
\fIcommandPrefix\fR so that the actual command is as follows:
.PP
.CS
\fIcommandPrefix name1 name2 op\fR
.CE
.PP
\fIName1\fR and \fIname2\fR give the name(s) for the variable
being accessed:  if the variable is a scalar then \fIname1\fR
gives the variable's name and \fIname2\fR is an empty string;
if the variable is an array element then \fIname1\fR gives the
name of the array and name2 gives the index into the array;
if an entire array is being deleted and the trace was registered
on the overall array, rather than a single element, then \fIname1\fR
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
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










-



-











-











-
















-
-
-
These subcommands are deprecated and will likely be removed in a
future version of Tcl.  They use an older syntax in which \fBarray\fR,
\fBread\fR, \fBwrite\fR, \fBunset\fR are replaced by \fBa\fR, \fBr\fR,
\fBw\fR and \fBu\fR respectively, and the \fIops\fR argument is not a
list, but simply a string concatenation of the operations, such as
\fBrwua\fR.
.SH EXAMPLES
.PP
Print a message whenever either of the global variables \fBfoo\fR and
\fBbar\fR are updated, even if they have a different local name at the
time (which can be done with the \fBupvar\fR command):
.PP
.CS
proc tracer {varname args} {
    upvar #0 $varname var
    puts "$varname was updated to be \e"$var\e""
}
\fBtrace add\fR variable foo write "tracer foo"
\fBtrace add\fR variable bar write "tracer bar"
.CE
.PP
Ensure that the global variable \fBfoobar\fR always contains the
product of the global variables \fBfoo\fR and \fBbar\fR:
.PP
.CS
proc doMult args {
    global foo bar foobar
    set foobar [expr {$foo * $bar}]
}
\fBtrace add\fR variable foo write doMult
\fBtrace add\fR variable bar write doMult
.CE
.PP
Print a trace of what commands are executed during the processing of a Tcl
procedure:
.PP
.CS
proc x {} { y }
proc y {} { z }
proc z {} { puts hello }
proc report args {puts [info level 0]}
\fBtrace add\fR execution x enterstep report
x
  \(-> \fIreport y enterstep\fR
    \fIreport z enterstep\fR
    \fIreport {puts hello} enterstep\fR
    \fIhello\fR
.CE
.SH "SEE ALSO"
set(n), unset(n)
.SH KEYWORDS
read, command, rename, variable, write, trace, unset
.\" Local Variables:
.\" mode: nroff
.\" End:

Deleted doc/transchan.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
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
































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 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.
'\"
.TH transchan n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
transchan \- command handler API of channel transforms
.SH SYNOPSIS
\fBcmdPrefix \fIoption\fR ?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
The Tcl-level handler for a channel transformation has to be a command with
subcommands (termed an \fIensemble\fR despite not implying that it must be
created with \fBnamespace ensemble create\fR; this mechanism is not tied to
\fBnamespace ensemble\fR in any way). Note that \fIcmdPrefix\fR is whatever
was specified in the call to \fBchan push\fR, and may consist of multiple
arguments; this will be expanded to multiple words in place of the prefix.
.PP
Of all the possible subcommands, the handler \fImust\fR support
\fBinitialize\fR and \fBfinalize\fR. Transformations for writable channels
must also support \fBwrite\fR, and transformations for readable channels must
also support \fBread\fR.
.PP
Note that in the descriptions below \fIcmdPrefix\fR may be more than one word,
and \fIhandle\fR is the value returned by the \fBchan push\fR call used to
create the transformation.
.SS "GENERIC SUBCOMMANDS"
.PP
The following subcommands are relevant to all types of channel.
.TP
\fIcmdPrefix \fBclear \fIhandle\fR
.
This optional subcommand is called to signify to the transformation that any
data stored in internal buffers (either incoming or outgoing) must be
cleared. It is called when a \fBchan seek\fR is performed on the channel being
transformed.
.TP
\fIcmdPrefix \fBfinalize \fIhandle\fR
.
This mandatory subcommand is called last for the given \fIhandle\fR, and then
never again, and it exists to allow for cleaning up any Tcl-level data
structures associated with the transformation. \fIWarning!\fR Any errors
thrown by this subcommand will be ignored. It is not guaranteed to be called
if the interpreter is deleted.
.TP
\fIcmdPrefix \fBinitialize \fIhandle mode\fR
.
This mandatory subcommand is called first, and then never again (for the given
\fIhandle\fR). Its responsibility is to initialize all parts of the
transformation at the Tcl level. The \fImode\fR is a list containing any of
\fBread \fRand \fBwrite\fR.
.RS
.TP
\fBwrite\fR
.
implies that the channel is writable.
.TP
\fBread\fR
.
implies that the channel is readable.
.PP
The return value of the subcommand should be a list containing the names of
all subcommands supported by this handler. Any error thrown by the subcommand
will prevent the creation of the transformation. The thrown error will appear
as error thrown by \fBchan push\fR.
.RE
.SS "READ-RELATED SUBCOMMANDS"
.PP
These subcommands are used for handling transformations applied to readable
channels; though strictly \fBread \fRis optional, it must be supported if any
of the others is or the channel will be made non-readable.
.TP
\fIcmdPrefix \fBdrain \fIhandle\fR
.
This optional subcommand is called whenever data in the transformation input
(i.e. read) buffer has to be forced upward, i.e. towards the user or script.
The result returned by the method is taken as the \fIbinary\fR data to push
upward to the level above this transformation (the reader or a higher-level
transformation).
.RS
.PP
In other words, when this method is called the transformation cannot defer the
actual transformation operation anymore and has to transform all data waiting
in its internal read buffers and return the result of that action.
.RE
.TP
\fIcmdPrefix \fBlimit? \fIhandle\fR
.
This optional subcommand is called to allow the Tcl I/O engine to determine
how far ahead it should read. If present, it should return an integer number
greater than zero which indicates how many bytes ahead should be read, or an
integer less than zero to indicate that the I/O engine may read as far ahead
as it likes.
.TP
\fIcmdPrefix \fBread \fIhandle buffer\fR
.
This subcommand, which must be present if the transformation is to work with
readable channels, is called whenever the base channel, or a transformation
below this transformation, pushes data upward. The \fIbuffer\fR contains the
binary data which has been given to us from below. It is the responsibility of
this subcommand to actually transform the data. The result returned by the
subcommand is taken as the binary data to push further upward to the
transformation above this transformation. This can also be the user or script
that originally read from the channel.
.RS
.PP
Note that the result is allowed to be empty, or even less than the data we
received; the transformation is not required to transform everything given to
it right now. It is allowed to store incoming data in internal buffers and to
defer the actual transformation until it has more data.
.RE
.SS "WRITE-RELATED SUBCOMMANDS"
.PP
These subcommands are used for handling transformations applied to writable
channels; though strictly \fBwrite\fR is optional, it must be supported if any
of the others is or the channel will be made non-writable.
.TP
\fIcmdPrefix \fBflush \fIhandle\fR
.
This optional subcommand is called whenever data in the transformation 'write'
buffer has to be forced downward, i.e. towards the base channel. The result
returned by the subcommand is taken as the binary data to write to the
transformation below the current transformation. This can be the base channel
as well.
.RS
.PP
In other words, when this subcommand is called the transformation cannot defer
the actual transformation operation anymore and has to transform all data
waiting in its internal write buffers and return the result of that action.
.RE
.TP
\fIcmdPrefix \fBwrite \fIhandle buffer\fR
.
This subcommand, which must be present if the transformation is to work with
writable channels, is called whenever the user, or a transformation above this
transformation, writes data downward. The \fIbuffer\fR contains the binary
data which has been written to us. It is the responsibility of this subcommand
to actually transform the data.
.RS
.PP
The result returned by the subcommand is taken as the binary data to write to
the transformation below this transformation. This can be the base channel as
well. Note that the result is allowed to be empty, or less than the data we
got; the transformation is not required to transform everything which was
written to it right now. It is allowed to store this data in internal buffers
and to defer the actual transformation until it has more data.
.RE
.SH "SEE ALSO"
chan(n), refchan(n)
.SH KEYWORDS
API, channel, ensemble, prefix, transformation
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/try.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
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







































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 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.
'\"
.TH try n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
try \- Trap and process errors and exceptions
.SH SYNOPSIS
\fBtry\fI body\fR ?\fIhandler...\fR? ?\fBfinally\fI script\fR?
.BE
.SH DESCRIPTION
.PP
This command executes the script \fIbody\fR and, depending on what the outcome
of that script is (normal exit, error, or some other exceptional result), runs
a handler script to deal with the case. Once that has all happened, if the
\fBfinally\fR clause is present, the \fIscript\fR it includes will be run and
the result of the handler (or the \fIbody\fR if no handler matched) is allowed
to continue to propagate. Note that the \fBfinally\fR clause is processed even
if an error occurs and irrespective of which, if any, \fIhandler\fR is used.
.PP
The \fIhandler\fR clauses are each expressed as several words, and must have
one of the following forms:
.TP
\fBon \fIcode variableList script\fR
.
This clause matches if the evaluation of \fIbody\fR completed with the
exception code \fIcode\fR. The \fIcode\fR may be expressed as an integer or
one of the following literal words: \fBok\fR, \fBerror\fR, \fBreturn\fR,
\fBbreak\fR, or \fBcontinue\fR. Those literals correspond to the integers 0
through 4 respectively.
.TP
\fBtrap \fIpattern variableList script\fR
.
This clause matches if the evaluation of \fIbody\fR resulted in an error and
the prefix of the \fB\-errorcode\fR from the interpreter's status dictionary
is equal to the \fIpattern\fR. The number of prefix words taken from the
\fB\-errorcode\fR is equal to the list-length of \fIpattern\fR, and inter-word
spaces are normalized in both the \fB\-errorcode\fR and \fIpattern\fR before
comparison.
.PP
The \fIvariableList\fR word in each \fIhandler\fR is always interpreted as a
list of variable names. If the first word of the list is present and
non-empty, it names a variable into which the result of the evaluation of
\fIbody\fR (from the main \fBtry\fR) will be placed; this will contain the
human-readable form of any errors. If the second word of the list is present
and non-empty, it names a variable into which the options dictionary of the
interpreter at the moment of completion of execution of \fIbody\fR
will be placed.
.PP
The \fIscript\fR word of each \fIhandler\fR is also always interpreted the
same: as a Tcl script to evaluate if the clause is matched. If \fIscript\fR is
a literal
.QW \-
and the \fIhandler\fR is not the last one, the \fIscript\fR of the following
\fIhandler\fR is invoked instead (just like with the \fBswitch\fR command).
.PP
Note that \fIhandler\fR clauses are matched against in order, and that the
first matching one is always selected. At most one \fIhandler\fR clause will
selected. As a consequence, an \fBon error\fR will mask any subsequent
\fBtrap\fR in the \fBtry\fR. Also note that \fBon error\fR is equivalent to
\fBtrap {}\fR.
.PP
If an exception (i.e. any non-\fBok\fR result) occurs during the evaluation of
either the \fIhandler\fR or the \fBfinally\fR clause, the original exception's
status dictionary will be added to the new exception's status dictionary under
the \fB\-during\fR key.
.SH EXAMPLES
.PP
Ensure that a file is closed no matter what:
.PP
.CS
set f [open /some/file/name a]
\fBtry\fR {
    puts $f "some message"
    # ...
} \fBfinally\fR {
    close $f
}
.CE
.PP
Handle different reasons for a file to not be openable for reading:
.PP
.CS
\fBtry\fR {
    set f [open /some/file/name w]
} \fBtrap\fR {POSIX EISDIR} {} {
    puts "failed to open /some/file/name: it's a directory"
} \fBtrap\fR {POSIX ENOENT} {} {
    puts "failed to open /some/file/name: it doesn't exist"
}
.CE
.SH "SEE ALSO"
catch(n), error(n), return(n), throw(n)
.SH "KEYWORDS"
cleanup, error, exception, final, resource management
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/unknown.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
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






-
+
















-
+



-
+


-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH unknown n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
unknown \- Handle attempts to use non-existent commands
.SH SYNOPSIS
\fBunknown \fIcmdName \fR?\fIarg arg ...\fR?
.BE
.SH DESCRIPTION
.PP
This command is invoked by the Tcl interpreter whenever a script
tries to invoke a command that does not exist.  The default implementation
of \fBunknown\fR is a library procedure defined when Tcl initializes an
interpreter.  You can override the default \fBunknown\fR to change its
functionality, or you can register a new handler for individual namespaces
using the \fBnamespace unknown\fR command.  Note that there is no default
using the \fBnamespace unknown\fR command.  Note that there is no default 
implementation of \fBunknown\fR in a safe interpreter.
.PP
If the Tcl interpreter encounters a command name for which there
is not a defined command (in either the current namespace, or the
is not a defined command (in either the current namespace, or the 
global namespace), then Tcl checks for the existence of
an unknown handler for the current namespace. By default, this
handler is a command named \fB::unknown\fR.  If there is no such
handler is a command named \fB::unknown\fR.  If there is no such 
command, then the interpreter returns an error.
If the \fBunknown\fR command exists (or a new handler has been
registered for the current namespace), then it is invoked with
arguments consisting of the fully-substituted name and arguments
for the original non-existent command.
The \fBunknown\fR command typically does things like searching
through library directories for a command procedure with the name
84
85
86
87
88
89
90
91

92
93
94
95
84
85
86
87
88
89
90

91











-
+
-
-
-
-
    puts stderr "WARNING: unknown command: $args"
    uplevel 1 [list _original_unknown {*}$args]
}
.CE
.SH "SEE ALSO"
info(n), proc(n), interp(n), library(n), namespace(n)
.SH KEYWORDS
error, non-existent command, unknown
error, non-existent command
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/unload.n.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







'\"
'\" Copyright (c) 2003 George Petasis <petasis@iit.demokritos.gr>.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH unload n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
unload \- Unload machine code
.SH SYNOPSIS
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55







-
+







.
Suppresses all error messages. If this switch is given, \fBunload\fR will
never report an error.
.TP
\fB\-keeplibrary\fR
.
This switch will prevent \fBunload\fR from issuing the operating system call
that will unload the library from the process.
that will unload the library from the process. 
.TP
\fB\-\|\-\fR
.
Marks the end of switches.  The argument following this one will
be treated as a \fIfileName\fR even if it starts with a \fB\-\fR.
.SS "UNLOAD OPERATION"
.PP
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
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







-

-
-
+
-
















-
+







procedure. If the unload procedure returns \fBTCL_OK\fR, \fBunload\fR will proceed
and decrease the proper reference count (depending on the target interpreter
type). When both reference counts have reached 0, the library will be
detached from the process.
.SS "UNLOAD HOOK PROTOTYPE"
.PP
The unload procedure must match the following prototype:
.PP
.CS
typedef int \fBTcl_PackageUnloadProc\fR(
        Tcl_Interp *\fIinterp\fR,
typedef int Tcl_PackageUnloadProc(Tcl_Interp *\fIinterp\fR, int \fIflags\fR);
        int \fIflags\fR);
.CE
.PP
The \fIinterp\fR argument identifies the interpreter from which the
library is to be unloaded.  The unload procedure must return
\fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
successfully;  in the event of an error it should set the interpreter's result
to point to an error message.  In this case, the result of the
\fBunload\fR command will be the result returned by the unload procedure.
.PP
The \fIflags\fR argument can be either \fBTCL_UNLOAD_DETACH_FROM_INTERPRETER\fR
or \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR. In case the library will remain
attached to the process after the unload procedure returns (i.e. because
the library is used by other interpreters),
\fBTCL_UNLOAD_DETACH_FROM_INTERPRETER\fR will be defined. However, if the
library is used only by the target interpreter and the library will be
detached from the application as soon as the unload procedure returns,
the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR.
the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR. 
.SS NOTES
.PP
The \fBunload\fR command cannot unload libraries that are statically
linked with the application.
If \fIfileName\fR is an empty string, then the \fIpackageName\fR argument must
be specified.
.PP
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
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










-


-



-

-












-
-
-
behavior of this varies from system to system (some systems may
detect the redundant loads, others may not). In case a library has been
silently detached by the operating system (and as a result Tcl thinks the
library is still loaded), it may be dangerous to use
\fBunload\fR on such a library (as the library will be completely detached
from the application while some interpreters will continue to use it).
.SH EXAMPLE
.PP
If an unloadable module in the file \fBfoobar.dll\fR had been loaded
using the \fBload\fR command like this (on Windows):
.PP
.CS
load c:/some/dir/foobar.dll
.CE
.PP
then it would be unloaded like this:
.PP
.CS
\fBunload\fR c:/some/dir/foobar.dll
.CE
.PP
This allows a C code module to be installed temporarily into a
long-running Tcl program and then removed again (either because it is
no longer needed or because it is being updated with a new version)
without having to shut down the overall Tcl process.
.SH "SEE ALSO"
info sharedlibextension, load(n), safe(n)
.SH KEYWORDS
binary code, unloading, safe interpreter, shared library
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/unset.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
44
45
46
47
48
49
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







-
+







-
+











-
+

-
+


-
-
+
+




-


-







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2000 Ajuba Solutions.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH unset n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
unset \- Delete variables
.SH SYNOPSIS
\fBunset \fR?\fB\-nocomplain\fR? ?\fB\-\-\fR? ?\fIname name name ...\fR?
\fBunset \fR?\fI\-nocomplain\fR? ?\fI\-\-\fR? ?\fIname name name ...\fR?
.BE
.SH DESCRIPTION
.PP
This command removes one or more variables.
Each \fIname\fR is a variable name, specified in any of the
ways acceptable to the \fBset\fR command.
If a \fIname\fR refers to an element of an array then that
element is removed without affecting the rest of the array.
If a \fIname\fR consists of an array name with no parenthesized
index, then the entire array is deleted.
The \fBunset\fR command returns an empty string as result.
If \fB\-nocomplain\fR is specified as the first argument, any possible
If \fI\-nocomplain\fR is specified as the first argument, any possible
errors are suppressed.  The option may not be abbreviated, in order to
disambiguate it from possible variable names.  The option \fB\-\-\fR
disambiguate it from possible variable names.  The option \fI\-\-\fR
indicates the end of the options, and should be used if you wish to
remove a variable with the same name as any of the options.
If an error occurs during variable deletion, any variables after the named one
causing the error are not
If an error occurs, any variables after the named one causing the error
are not
deleted.  An error can occur when the named variable does not exist, or the
name refers to an array element but the variable is a scalar, or the name
refers to a variable in a non-existent namespace.
.SH EXAMPLE
.PP
Create an array containing a mapping from some numbers to their
squares and remove the array elements for non-prime numbers:
.PP
.CS
array set squares {
    1 1    6 36
    2 4    7 49
    3 9    8 64
    4 16   9 81
    5 25  10 100
58
59
60
61
62
63
64
65
66
67
68
56
57
58
59
60
61
62











-
-
-
-
puts "The prime squares are:"
parray squares
.CE
.SH "SEE ALSO"
set(n), trace(n), upvar(n)
.SH KEYWORDS
remove, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/update.n.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24






-
+









+







'\"
'\" Copyright (c) 1990-1992 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH update n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
update \- Process pending events and idle callbacks
.SH SYNOPSIS
\fBupdate\fR ?\fBidletasks\fR?
.BE

.SH DESCRIPTION
.PP
This command is used to bring the application
.QW "up to date"
by entering the event loop repeatedly until all pending events
(including idle callbacks) have been processed.
.PP
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
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











-

-














+


+

-
+
-
-
-
-
.PP
The \fBupdate\fR command with no options is useful in scripts where
you are performing a long-running computation but you still want
the application to respond to events such as user interactions;  if
you occasionally call \fBupdate\fR then user input will be processed
during the next call to \fBupdate\fR.
.SH EXAMPLE
.PP
Run computations for about a second and then finish:
.PP
.CS
set x 1000
set done 0
after 1000 set done 1
while {!$done} {
    # A very silly example!
    set x [expr {log($x) ** 2.8}]

    # Test to see if our time-limit has been hit.  This would
    # also give a chance for serving network sockets and, if
    # the Tk package is loaded, updating a user interface.
    \fBupdate\fR
}
.CE

.SH "SEE ALSO"
after(n), interp(n)

.SH KEYWORDS
asynchronous I/O, event, flush, handler, idle, update
event, flush, handler, idle, update
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/uplevel.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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
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






-
+



















-
+

-
+













-



-




-



-







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH uplevel n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
uplevel \- Execute a script in a different stack frame
.SH SYNOPSIS
\fBuplevel \fR?\fIlevel\fR?\fI arg \fR?\fIarg ...\fR?
.BE
.SH DESCRIPTION
.PP
All of the \fIarg\fR arguments are concatenated as if they had
been passed to \fBconcat\fR; the result is then evaluated in the
variable context indicated by \fIlevel\fR.  \fBUplevel\fR returns
the result of that evaluation.
.PP
If \fIlevel\fR is an integer then
it gives a distance (up the procedure calling stack) to move before
executing the command.  If \fIlevel\fR consists of \fB#\fR followed by
a integer then the level gives an absolute level.  If \fIlevel\fR
a number then the number gives an absolute level number.  If \fIlevel\fR
is omitted then it defaults to \fB1\fR.  \fILevel\fR cannot be
defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR.
defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR.
.PP
For example, suppose that procedure \fBa\fR was invoked
from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
Suppose that \fBc\fR invokes the \fBuplevel\fR command.  If \fIlevel\fR
is \fB1\fR or \fB#2\fR  or omitted, then the command will be executed
in the variable context of \fBb\fR.  If \fIlevel\fR is \fB2\fR or \fB#1\fR
then the command will be executed in the variable context of \fBa\fR.
If \fIlevel\fR is \fB3\fR or \fB#0\fR then the command will be executed
at top-level (only global variables will be visible).
.PP
The \fBuplevel\fR command causes the invoking procedure to disappear
from the procedure calling stack while the command is being executed.
In the above example, suppose \fBc\fR invokes the command
.PP
.CS
\fBuplevel\fR 1 {set x 43; d}
.CE
.PP
where \fBd\fR is another Tcl procedure.  The \fBset\fR command will
modify the variable \fBx\fR in \fBb\fR's context, and \fBd\fR will execute
at level 3, as if called from \fBb\fR.  If it in turn executes
the command
.PP
.CS
\fBuplevel\fR {set x 42}
.CE
.PP
then the \fBset\fR command will modify the same variable \fBx\fR in \fBb\fR's
context:  the procedure \fBc\fR does not appear to be on the call stack
when \fBd\fR is executing.  The \fBinfo level\fR command may
be used to obtain the level of the current procedure.
.PP
\fBUplevel\fR makes it possible to implement new control
constructs as Tcl procedures (for example, \fBuplevel\fR could
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
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










-

















-
+
-
-
-
at top-level in the outermost namespace (the global namespace).
.SH EXAMPLE
As stated above, the \fBuplevel\fR command is useful for creating new
control constructs.  This example shows how (without error handling)
it can be used to create a \fBdo\fR command that is the counterpart of
\fBwhile\fR except for always performing the test after running the
loop body:
.PP
.CS
proc do {body while condition} {
    if {$while ne "while"} {
        error "required word missing"
    }
    set conditionCmd [list expr $condition]
    while {1} {
        \fBuplevel\fR 1 $body
        if {![\fBuplevel\fR 1 $conditionCmd]} {
            break
        }
    }
}
.CE
.SH "SEE ALSO"
apply(n), namespace(n), upvar(n)
.SH KEYWORDS
context, level, namespace, stack frame, variable
context, level, namespace, stack frame, variables
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/upvar.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
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
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






-
+
















-
+
+




















-


-
-
+
+


-



-
+







-
+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH upvar n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
upvar \- Create link to variable in a different stack frame
.SH SYNOPSIS
\fBupvar \fR?\fIlevel\fR? \fIotherVar myVar \fR?\fIotherVar myVar \fR...?
.BE

.SH DESCRIPTION
.PP
This command arranges for one or more local variables in the current
procedure to refer to variables in an enclosing procedure call or
to global variables.
\fILevel\fR may have any of the forms permitted for the \fBuplevel\fR
command, and may be omitted (it defaults to \fB1\fR).
command, and may be omitted if the first letter of the first \fIotherVar\fR
is not \fB#\fR or a digit (it defaults to \fB1\fR).
For each \fIotherVar\fR argument, \fBupvar\fR makes the variable
by that name in the procedure frame given by \fIlevel\fR (or at
global level, if \fIlevel\fR is \fB#0\fR) accessible
in the current procedure by the name given in the corresponding
\fImyVar\fR argument.
The variable named by \fIotherVar\fR need not exist at the time of the
call;  it will be created the first time \fImyVar\fR is referenced, just like
an ordinary variable.  There must not exist a variable by the
name \fImyVar\fR at the time \fBupvar\fR is invoked.
\fIMyVar\fR is always treated as the name of a variable, not an
array element.  An error is returned if the name looks like an array element,
such as \fBa(b)\fR.
\fIOtherVar\fR may refer to a scalar variable, an array,
or an array element.
\fBUpvar\fR returns an empty string.
.PP
The \fBupvar\fR command simplifies the implementation of call-by-name
procedure calling and also makes it easier to build new control constructs
as Tcl procedures.
For example, consider the following procedure:
.PP
.CS
proc \fIadd2\fR name {
    \fBupvar\fR $name x
    set x [expr {$x + 2}]
   \fBupvar\fR $name x
   set x [expr {$x + 2}]
}
.CE
.PP
If \fIadd2\fR is invoked with an argument giving the name of a variable,
it adds two to the value of that variable.
Although \fIadd2\fR could have been implemented using \fBuplevel\fR
instead of \fBupvar\fR, \fBupvar\fR makes it simpler for \fIadd2\fR
instead of \fBupvar\fR, \fBupvar\fR makes it simpler for \fBadd2\fR
to access the variable in the caller's procedure frame.
.PP
\fBnamespace eval\fR is another way (besides procedure calls)
that the Tcl naming context can change.
It adds a call frame to the stack to represent the namespace context.
This means each \fBnamespace eval\fR command
counts as another call level for \fBuplevel\fR and \fBupvar\fR commands.
For example, \fBinfo level\fR \fB1\fR will return a list
For example, \fBinfo level 1\fR will return a list
describing a command that is either
the outermost procedure call or the outermost \fBnamespace eval\fR command.
Also, \fBuplevel #0\fR evaluates a script
at top-level in the outermost namespace (the global namespace).
.PP
If an upvar variable is unset (e.g. \fBx\fR in \fBadd2\fR above), the
\fBunset\fR operation affects the variable it is linked to, not the
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
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










-


-
+


-
-
+
+














-






+


+

-
+
-
-
-
trace will be triggered by actions involving \fImyVar\fR.  However,
the trace procedure will be passed the name of \fImyVar\fR, rather
than the name of \fIotherVar\fR.  Thus, the output of the following code
will be
.QW "\fIlocalVar\fR"
rather than
.QW "\fIoriginalVar\fR" :
.PP
.CS
proc \fItraceproc\fR { name index op } {
    puts $name
   puts $name
}
proc \fIsetByUpvar\fR { name value } {
    \fBupvar\fR $name localVar
    set localVar $value
   \fBupvar\fR $name localVar
   set localVar $value
}
set originalVar 1
trace variable originalVar w \fItraceproc\fR
\fIsetByUpvar\fR originalVar 2
.CE
.PP
If \fIotherVar\fR refers to an element of an array, then variable
traces set for the entire array will not be invoked when \fImyVar\fR
is accessed (but traces on the particular element will still be
invoked).  In particular, if the array is \fBenv\fR, then changes
made to \fImyVar\fR will not be passed to subprocesses correctly.
.SH EXAMPLE
A \fBdecr\fR command that works like \fBincr\fR except it subtracts
the value from the variable instead of adding it:
.PP
.CS
proc decr {varName {decrement 1}} {
    \fBupvar\fR 1 $varName var
    incr var [expr {-$decrement}]
}
.CE

.SH "SEE ALSO"
global(n), namespace(n), uplevel(n), variable(n)

.SH KEYWORDS
context, frame, global, level, namespace, procedure, upvar, variable
context, frame, global, level, namespace, procedure, variable
.\" Local Variables:
.\" mode: nroff
.\" End:

Changes to doc/variable.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
1
2
3
4
5
6

7
8
9
10
11
12
13
14



15
16
17
18
19
20
21
22
23
24






-
+







-
-
-
+

+







'\"
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 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.
'\"
'\" 
.TH variable n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
variable \- create and initialize a namespace variable
.SH SYNOPSIS
\fBvariable \fR\fIname\fR
.sp
\fBvariable \fR?\fIname value...\fR?
\fBvariable \fR?\fIname value...\fR? \fIname \fR?\fIvalue\fR?
.BE

.SH DESCRIPTION
.PP
This command is normally used within a
\fBnamespace eval\fR command to create one or more variables
within a namespace.
Each variable \fIname\fR is initialized with \fIvalue\fR.
The \fIvalue\fR for the last variable is optional.
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
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











-
+
-












-

-







-











-













+


+


-
-
-
-
.PP
If the \fBvariable\fR command is executed inside a Tcl procedure,
it creates local variables
linked to the corresponding namespace variables (and therefore these
variables are listed by \fBinfo vars\fR.)
In this way the \fBvariable\fR command resembles the \fBglobal\fR command,
although the \fBglobal\fR command
resolves variable names with respect to the global namespace instead
only links to variables in the global namespace.
of the current namespace of the procedure.
If any \fIvalue\fRs are given,
they are used to modify the values of the associated namespace variables.
If a namespace variable does not exist,
it is created and optionally initialized.
.PP
A \fIname\fR argument cannot reference an element within an array.
Instead, \fIname\fR should reference the entire array,
and the initialization \fIvalue\fR should be left off.
After the variable has been declared,
elements within the array can be set using ordinary
\fBset\fR or \fBarray\fR commands.
.SH EXAMPLES
.PP
Create a variable in a namespace:
.PP
.CS
namespace eval foo {
    \fBvariable\fR bar 12345
}
.CE
.PP
Create an array in a namespace:
.PP
.CS
namespace eval someNS {
    \fBvariable\fR someAry
    array set someAry {
        someName  someValue
        otherName otherValue
    }
}
.CE
.PP
Access variables in namespaces from a procedure:
.PP
.CS
namespace eval foo {
    proc spong {} {
        # Variable in this namespace
        \fBvariable\fR bar
        puts "bar is $bar"

        # Variable in another namespace
        \fBvariable\fR ::someNS::someAry
        parray someAry
    }
}
.CE

.SH "SEE ALSO"
global(n), namespace(n), upvar(n)

.SH KEYWORDS
global, namespace, procedure, variable
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/vwait.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
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
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









-
+









+




-
+


-
-
-
+
+
+


-
+





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

-



-






-





-
-
-
+
+
+











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


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


+

-
+
-
-
-
-
'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
'\" 
.TH vwait n 8.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
vwait \- Process events until a variable is written
.SH SYNOPSIS
\fBvwait\fR \fIvarName\fR
.BE

.SH DESCRIPTION
.PP
This command enters the Tcl event loop to process events, blocking
the application if no events are ready.  It continues processing
events until some event handler sets the value of the global variable
events until some event handler sets the value of variable
\fIvarName\fR.  Once \fIvarName\fR has been set, the \fBvwait\fR
command will return as soon as the event handler that modified
\fIvarName\fR completes.  The \fIvarName\fR argument is always interpreted as
a variable name with respect to the global namespace, but can refer to any
namespace's variables if the fully-qualified name is given.
\fIvarName\fR completes.  \fIvarName\fR must be globally scoped
(either with a call to \fBglobal\fR for the \fIvarName\fR, or with
the full namespace path specification).
.PP
In some cases the \fBvwait\fR command may not return immediately
after \fIvarName\fR is set.  This happens if the event handler
after \fIvarName\fR is set.  This can happen if the event handler
that sets \fIvarName\fR does not complete immediately.  For example,
if an event handler sets \fIvarName\fR and then itself calls
\fBvwait\fR to wait for a different variable, then it may not return
for a long time.  During this time the top-level \fBvwait\fR is
blocked waiting for the event handler to complete, so it cannot
return either. (See the \fBNESTED VWAITS BY EXAMPLE\fR below.)
return either.
.PP
To be clear, \fImultiple \fBvwait\fI calls will nest and will not happen in
parallel\fR.  The outermost call to \fBvwait\fR will not return until all the
inner ones do.  It is recommended that code should never nest \fBvwait\fR
calls (by avoiding putting them in event callbacks) but when that is not
possible, care should be taken to add interlock variables to the code to
prevent all reentrant calls to \fBvwait\fR that are not \fIstrictly\fR
necessary. Be aware that the synchronous modes of operation of some Tcl
packages (e.g.,\ \fBhttp\fR) use \fBvwait\fR internally; if using the event
loop, it is best to use the asynchronous callback-based modes of operation of
those packages where available.
.SH EXAMPLES
.PP
Run the event-loop continually until some event calls \fBexit\fR.
(You can use any variable not mentioned elsewhere, but the name
\fIforever\fR reminds you at a glance of the intent.)
.PP
.CS
\fBvwait\fR forever
.CE
.PP
Wait five seconds for a connection to a server socket, otherwise
close the socket and continue running the script:
.PP
.CS
# Initialise the state
after 5000 set state timeout
set server [socket -server accept 12345]
proc accept {args} {
    global state connectionInfo
    set state accepted
    set connectionInfo $args
   global state connectionInfo
   set state accepted
   set connectionInfo $args
}

# Wait for something to happen
\fBvwait\fR state

# Clean up events that could have happened
close $server
after cancel set state timeout

# Do something based on how the vwait finished...
switch $state {
    timeout {
        puts "no connection on port 12345"
    }
    accepted {
       puts "connection: $connectionInfo"
       puts [lindex $connectionInfo 0] "Hello there!"
    }
   timeout {
      puts "no connection on port 12345"
   }
   accepted {
      puts "connection: $connectionInfo"
      puts [lindex $connectionInfo 0] "Hello there!"
   }
}
.CE
.PP
A command that will wait for some time delay by waiting for a namespace
variable to be set.  Includes an interlock to prevent nested waits.
.PP
.CS
namespace eval example {
    variable v done
    proc wait {delay} {
        variable v
        if {$v ne "waiting"} {
            set v waiting
            after $delay [namespace code {set v done}]
            \fBvwait\fR [namespace which -variable v]
        }

        return $v
    }
}
.CE
.PP
When running inside a \fBcoroutine\fR, an alternative to using \fBvwait\fR is
to \fByield\fR to an outer event loop and to get recommenced when the variable
is set, or at an idle moment after that.
.PP
.CS
coroutine task apply {{} {
    # simulate [after 1000]
    after 1000 [info coroutine]
    yield

    # schedule the setting of a global variable, as normal
    after 2000 {set var 1}

    # simulate [\fBvwait\fR var]
    proc updatedVar {task args} {
        after idle $task
        trace remove variable ::var write "updatedVar $task"
    }
    trace add variable ::var write "updatedVar [info coroutine]"
    yield
}}
.CE
.SS "NESTED VWAITS BY EXAMPLE"
.PP
This example demonstrates what can happen when the \fBvwait\fR command is
nested. The script will never finish because the waiting for the \fIa\fR
variable never finishes; that \fBvwait\fR command is still waiting for a
script scheduled with \fBafter\fR to complete, which just happens to be
running an inner \fBvwait\fR (for \fIb\fR) even though the event that the
outer \fBvwait\fR was waiting for (the setting of \fIa\fR) has occurred.
.PP
.CS
after 500 {
    puts "waiting for b"
    \fBvwait\fR b
    puts "b was set"
}
after 1000 {
    puts "setting a"
    set a 10
}
puts "waiting for a"
\fBvwait\fR a
puts "a was set"
puts "setting b"
set b 42
.CE
.PP
If you run the above code, you get this output:
.PP
.CS
waiting for a
waiting for b
setting a
.CE
.PP
The script will never print
.QW "a was set"
until after it has printed
.QW "b was set"
because of the nesting of \fBvwait\fR commands, and yet \fIb\fR will not be
set until after the outer \fBvwait\fR returns, so the script has deadlocked.
The only ways to avoid this are to either structure the overall program in
continuation-passing style or to use \fBcoroutine\fR to make the continuations
implicit. The first of these options would be written as:
.PP
.CS
after 500 {
    puts "waiting for b"
    trace add variable b write {apply {args {
        global a b
        trace remove variable ::b write \e
                [lrange [info level 0] 0 1]
        puts "b was set"
        set ::done ok
    }}}
}
after 1000 {
    puts "setting a"
    set a 10
}
puts "waiting for a"
trace add variable a write {apply {args {
    global a b
    trace remove variable a write [lrange [info level 0] 0 1]
    puts "a was set"
    puts "setting b"
    set b 42
}}}
\fBvwait\fR done
.CE
.PP
The second option, with \fBcoroutine\fR and some helper procedures, is done
like this:
.PP
.CS
# A coroutine-based wait-for-variable command
proc waitvar globalVar {
    trace add variable ::$globalVar write \e
            [list apply {{v c args} {
        trace remove variable $v write \e
                [lrange [info level 0] 0 3]
        after 0 $c
    }} ::$globalVar [info coroutine]]
    yield
}
# A coroutine-based wait-for-some-time command
proc waittime ms {
    after $ms [info coroutine]
    yield
}

coroutine task-1 eval {
    puts "waiting for a"
    waitvar a
    puts "a was set"
    puts "setting b"
    set b 42
}
coroutine task-2 eval {
    waittime 500
    puts "waiting for b"
    waitvar b
    puts "b was set"
    set done ok
}
coroutine task-3 eval {
    waittime 1000
    puts "setting a"
    set a 10
}
\fBvwait\fR done
.CE
.SH "SEE ALSO"
global(n), update(n)

.SH KEYWORDS
asynchronous I/O, event, variable, wait
event, variable, wait
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/while.n.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24






-
+









+







'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-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.
'\"
'\" 
.TH while n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
while \- Execute script repeatedly as long as a condition is met
.SH SYNOPSIS
\fBwhile \fItest body\fR
.BE

.SH DESCRIPTION
.PP
The \fBwhile\fR command evaluates \fItest\fR as an expression
(in the same way that \fBexpr\fR evaluates its argument).
The value of the expression must a proper boolean
value; if it is a true value
then \fIbody\fR is executed by passing it to the Tcl interpreter.
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
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











-








-


-






+


+

-
+
-
-
-
-
made by the loop body will not be considered in the expression.
This is likely to result in an infinite loop.  If \fItest\fR is
enclosed in braces, variable substitutions are delayed until the
expression is evaluated (before
each loop iteration), so changes in the variables will be visible.
For an example, try the following script with and without the braces
around \fB$x<10\fR:
.PP
.CS
set x 0
\fBwhile\fR {$x<10} {
    puts "x is $x"
    incr x
}
.CE
.SH EXAMPLE
.PP
Read lines from a channel until we get to the end of the stream, and
print them out with a line-number prepended:
.PP
.CS
set lineCount 0
\fBwhile\fR {[gets $chan line] >= 0} {
    puts "[incr lineCount]: $line"
}
.CE

.SH "SEE ALSO"
break(n), continue(n), for(n), foreach(n)

.SH KEYWORDS
boolean, loop, test, while
boolean value, loop, test, while
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Deleted doc/zipfs.3.

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
























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
'\" Copyright (c) 2017 Sean Woods <yoda@etoyoc.com>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
.SH NAME
TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
.SH SYNOPSIS
.nf
int
\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
.sp
int
\fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR)
.sp
int
\fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR)
.sp
int
\fBTclzipfs_Unmount\fR(\fIinterp, mountpoint\fR)
.fi
.SH ARGUMENTS
.AS Tcl_Interp *mountpoint in
.AP "int" *argcPtr in
Pointer to a variable holding the number of command line arguments from
\fBmain\fR().
.AP "char" ***argvPtr in
Pointer to an array of strings containing the command line arguments to
\fBmain\fR().
.AP Tcl_Interp *interp in
Interpreter in which the ZIP file system is mounted.  The interpreter's result is
modified to hold the result or error message from the script.
.AP "const char" *zipname in
Name of a ZIP file. Must not be NULL when either mounting or unmounting a ZIP.
.AP "const char" *mountpoint in
Name of a mount point, which must be a legal Tcl file or directory name. May
be NULL to query current mount points.
.AP "const char" *password in
An (optional) password. Use NULL if no password is wanted to read the file.
.AP "unsigned char" *data in
A data buffer to mount. The data buffer must hold the contents of a ZIP
archive, and must not be NULL.
.AP size_t dataLen in
The number of bytes in the supplied data buffer argument, \fIdata\fR.
.AP int copy in
If non-zero, the ZIP archive in the data buffer will be internally copied
before mounting, allowing the data buffer to be disposed once
\fBTclZipfs_MountBuffer\fR returns. If zero, the caller guarantees that the
buffer will be valid to read from for the duration of the mount.
.BE
.SH DESCRIPTION
\fBTclZipfs_AppHook\fR is a utility function to perform standard application
initialization procedures, taking into account available ZIP archives as
follows:
.IP [1]
If the current application has a mountable ZIP archive, that archive is
mounted under \fIZIPFS_VOLUME\fB/app\fR as a read-only Tcl virtual file
system. \fIZIPFS_VOLUME\fR is usually \fB//zipfs:\fR on all platforms, but
\fBzipfs:\fR may also be used on Windows (due to differences in the
platform's filename parsing).
.IP [2]
If a file named \fBmain.tcl\fR is located in the root directory of that file
system (i.e., at \fIZIPROOT\fB/app/main.tcl\fR after the ZIP archive is
mounted as described above) it is treated as the startup script for the
process.
.IP [3]
If the file \fIZIPROOT\fB/app/tcl_library/init.tcl\fR is present, the
\fBtcl_library\fR global variable in the initial Tcl interpreter is set to
\fIZIPROOT\fB/app/tcl_library\fR.
.IP [4]
If the directory \fBtcl_library\fR was not found in the main application
mount, the system will then search for it as either a VFS attached to the
application dynamic library, or as a zip archive named
\fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the
present working directory or in the standard Tcl install location. (For
example, the Tcl 8.7.2 release would be searched for in a file
\fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only.
.PP
On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since
it uses WCHAR instead of char. As a result, it requires your application to
be compiled with the UNICODE preprocessor symbol defined (e.g., via the
\fB-DUNICODE\fR compiler flag).
.PP
The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR
when the function is successful). The function \fImay\fR modify the variables
pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
current implementation does not do so, but callers \fIshould not\fR assume
that this will be true in the future.
.PP
\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
Errors during that process are reported in the interpreter \fIinterp\fR.  If
\fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
file systems is written into \fIinterp\fR's result as a sequence of mount
points and ZIP file names.  The result of this call is a standard Tcl result
code.
.PP
\fBTclzipfs_MountBuffer\fR mounts the ZIP archive in the buffer pointed to by
\fIdata\fR on the mount point given in \fImountpoint\fR. The ZIP archive is
assumed to be not password protected.  Errors during that process are reported
in the interpreter \fIinterp\fR. The \fIcopy\fR argument determines whether
the buffer is internally copied before mounting or not. The result of this
call is a standard Tcl result code.
.PP
\fBTclzipfs_Unmount\fR undoes the effect of \fBTclzipfs_Mount\fR, i.e., it
unmounts the mounted ZIP file system that was mounted from \fIzipname\fR (at
\fImountpoint\fR). Errors are reported in the interpreter \fIinterp\fR.  The
result of this call is a standard Tcl result code.
.PP
\fBTclZipfs_AppHook\fR can not be used in stub-enabled extensions.
.SH "SEE ALSO"
zipfs(n)
.SH KEYWORDS
compress, filesystem, zip

Deleted doc/zipfs.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
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






























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
'\" Copyright (c) 2015 Sean Woods <yoda@etoyoc.com>
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
.TH zipfs n 1.0 Zipfs "zipfs Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
.SH SYNOPSIS
.nf
\fBpackage require zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
\fBzipfs mkkey\fR \fIpassword\fR
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
\fBzipfs root\fR
\fBzipfs unmount\fR \fImountpoint\fR
.fi
'\" The following subcommand is *UNDOCUMENTED*
'\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR?
.BE
.SH DESCRIPTION
.PP
The \fBzipfs\fR command (the sole public command provided by the built-in
package with the same name) provides Tcl with the ability to mount the
contents of a ZIP archive file as a virtual file system. ZIP archives support
simple encryption, sufficient to prevent casual inspection of their contents
but not able to prevent access by even a moderately determined attacker.
.TP
\fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIinZipfs\fR?
.
This takes the name of a file, \fIfilename\fR, and produces where it would be
mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says
within which mount the mapping will be done; if omitted, the main root of the
zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean
which controls whether to fully canonicalise the name; it defaults to true.
.TP
\fBzipfs exists\fR \fIfilename\fR
.
Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
.TP
\fBzipfs find\fR \fIdirectoryName\fR
.
Recursively lists files including and below the directory \fIdirectoryName\fR.
The result list consists of relative path names starting from the given
directory. This command is also used by the \fBzipfs mkzip\fR and \fBzipfs
mkimg\fR commands.
.TP
\fBzipfs info\fR \fIfile\fR
.
Return information about the given \fIfile\fR in the mounted zipfs.  The
information consists of:
.RS
.IP (1)
the name of the ZIP archive file that contains the file,
.IP (2)
the size of the file after decompressions,
.IP (3)
the compressed size of the file, and
.IP (4)
the offset of the compressed data in the ZIP archive file.
.PP
Note: querying the mount point gives the start of the zip data as the offset
in (4), which can be used to truncate the zip information from an executable.
.RE
.TP
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
.
Return a list of all files in the mounted zipfs, or just those matching
\fIpattern\fR (optionally controlled by the option parameters).  The order of
the names in the list is arbitrary.
.TP
\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
.
The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
filesystem at \fImountpoint\fR.  After this command executes, files contained
in \fIzipfile\fR will appear to Tcl to be regular files at the mount point.
.RS
.PP
With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR.  With
no \fImountpoint\fR, return all zipfile/mount pairs.  If \fImountpoint\fR is
specified as an empty string, mount on file path.
.PP
\fBNB:\fR because the current working directory is a concept maintained by the
operating system, using \fBcd\fR into a mounted archive will only work in the
current process, and then not entirely consistently (e.g., if a shared library
uses direct access to the OS rather than through Tcl's filesystem API, it will
not see the current directory as being inside the mount and will not be able
to access the files inside the mount).
.RE
.TP
\fBzipfs root\fR
.
Returns a constant string which indicates the mount point for zipfs volumes
for the current platform. On Windows, this value is
.QW \fBzipfs:/\fR .
On Unix, this value is
.QW \fB//zipfs:/\fR .
.TP
\fBzipfs unmount \fImountpoint\fR
.
Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
.SS "ZIP CREATION COMMANDS"
This package also provides several commands to aid the creation of ZIP
archives as Tcl applications.
.TP
\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
.
Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
directory \fIindir\fR (contained regular files only) with optional ZIP
password \fIpassword\fR. While processing the files below \fIindir\fR the
optional file name prefix given in \fIstrip\fR is stripped off the beginning
of the respective file name.  When stripping, it is common to remove either
the whole source directory name or the name of its parent directory.
.RS
.PP
\fBCaution:\fR the choice of the \fIindir\fR parameter (less the optional
stripped prefix) determines the later root name of the archive's content.
.RE
.TP
\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
.
Creates an image (potentially a new executable file) similar to \fBzipfs
mkzip\fR; see that command for a description of most parameters to this
command, as they behave identically here.
.RS
.PP
If the \fIinfile\fR parameter is specified, this file is prepended in front of
the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR
(i.e., the executable file of the running process) is used. If the
\fIpassword\fR parameter is not empty, an obfuscated version of that password
(see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
output file and the contents of the ZIP chunk are protected with that
password.
.PP
If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
archive and the image file that the archive is attached to is a \fBtclsh\fR
(or \fBwish\fR) instance (true by default, but depends on your configuration),
then the resulting image is an executable that will \fBsource\fR the script in
that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once
that script has been executed.
.PP
\fBCaution:\fR highly experimental, not usable on Android, only partially
tested on Linux and Windows.
.RE
.TP
\fBzipfs mkkey\fR \fIpassword\fR
.
Given the clear text \fIpassword\fR argument, an obfuscated string version is
returned with the same format used in the \fBzipfs mkimg\fR command.
.TP
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
.
This command is like \fBzipfs mkimg\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive in the image, and the even elements are their
respective names within that archive.
.TP
\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
.
This command is like \fBzipfs mkzip\fR, but instead of an input directory,
\fIinlist\fR must be a Tcl list where the odd elements are the names of files
to be copied into the archive, and the even elements are their respective
names within that archive.
.SH "EXAMPLES"
.PP
Mounting an ZIP archive as an application directory and running code out of it
before unmounting it again:
.PP
.CS
set zip myApp.zip
set base [file join [\fBzipfs root\fR] myApp]

\fBzipfs mount\fR $base $zip
# $base now has the contents of myApp.zip

source [file join $base app.tcl]
# use the contents, load libraries from it, etc...

\fBzipfs unmount\fR $zip
.CE
.PP
Creating a ZIP archive, given that a directory exists containing the content
to put in the archive. Note that the source directory is given twice, in order
to strip the exterior directory name from each filename in the archive.
.PP
.CS
set sourceDirectory [file normalize myApp]
set targetZip myApp.zip

\fBzipfs mkzip\fR $targetZip $sourceDirectory $sourceDirectory
.CE
.PP
Encryption can be applied to ZIP archives by providing a password when
building the ZIP and when mounting it.
.PP
.CS
set zip myApp.zip
set sourceDir [file normalize myApp]
set password "hunter2"
set base [file join [\fBzipfs root\fR] myApp]

# Create with password
\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password

# Mount with password
\fBzipfs mount\fR $base $zip $password
.CE
.PP
When creating an executable image with a password, the password is placed
within the executable in a shrouded form so that the application can read
files inside the embedded ZIP archive yet casual inspection cannot read it.
.PP
.CS
set appDir [file normalize myApp]
set img "myApp.bin"
set password "hunter2"

# Create some simple content to define a basic application
file mkdir $appDir
set f [open $appDir/main.tcl]
puts $f {
    puts "Hi. This is [info script]"
}
close $f

# Create the executable
\fBzipfs mkimg\fR $img $appDir $appDir $password

# Launch the executable, printing its output to stdout
exec $img >@stdout
#    prints: \fIHi. This is //zipfs:/app/main.tcl\fR
.CE
.SH "SEE ALSO"
tclsh(1), file(n), zipfs(3), zlib(n)
.SH "KEYWORDS"
compress, filesystem, zip
'\" Local Variables:
'\" mode: nroff
'\" End:

Deleted doc/zlib.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
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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
























































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
'\"
'\" Copyright (c) 2008-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.
'\"
.TH zlib n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zlib \- compression and decompression operations
.SH SYNOPSIS
.nf
\fBzlib \fIsubcommand arg ...\fR
.fi
.BE
.SH DESCRIPTION
.PP
The \fBzlib\fR command provides access to the compression and check-summing
facilities of the Zlib library by Jean-loup Gailly and Mark Adler. It has the
following subcommands.
.SS "COMPRESSION SUBCOMMANDS"
.TP
\fBzlib compress\fI string\fR ?\fIlevel\fR?
.
Returns the zlib-format compressed binary data of the binary string in
\fIstring\fR. If present, \fIlevel\fR gives the compression level to use (from
0, which is uncompressed, to 9, maximally compressed).
.TP
\fBzlib decompress\fI string\fR ?\fIbufferSize\fR?
.
Returns the uncompressed version of the raw compressed binary data in
\fIstring\fR. If present, \fIbufferSize\fR is a hint as to what size of buffer
is to be used to receive the data.
.TP
\fBzlib deflate\fI string\fR ?\fIlevel\fR?
.
Returns the raw compressed binary data of the binary string in \fIstring\fR.
If present, \fIlevel\fR gives the compression level to use (from 0, which is
uncompressed, to 9, maximally compressed).
.TP
\fBzlib gunzip\fI string\fR ?\fB\-headerVar \fIvarName\fR?
.
Return the uncompressed contents of binary string \fIstring\fR, which must
have been in gzip format. If \fB\-headerVar\fR is given, store a dictionary
describing the contents of the gzip header in the variable called
\fIvarName\fR. The keys of the dictionary that may be present are:
.RS
.TP
\fBcomment\fR
.
The comment field from the header, if present.
.TP
\fBcrc\fR
.
A boolean value describing whether a CRC of the header is computed.
.TP
\fBfilename\fR
.
The filename field from the header, if present.
.TP
\fBos\fR
.
The operating system type code field from the header (if not the
QW unknown
value). See RFC 1952 for the meaning of these codes.
.TP
\fBsize\fR
.
The size of the uncompressed data.
.TP
\fBtime\fR
.
The time field from the header if non-zero, expected to be time that the file
named by the \fBfilename\fR field was modified. Suitable for use with
\fBclock format\fR.
.TP
\fBtype\fR
.
The type of the uncompressed data (\fBbinary\fR or \fBtext\fR) if known.
.RE
.TP
\fBzlib gzip\fI string\fR ?\fB\-level \fIlevel\fR? ?\fB\-header \fIdict\fR?
.
Return the compressed contents of binary string \fIstring\fR in gzip format.
If \fB\-level\fR is given, \fIlevel\fR gives the compression level to use
(from 0, which is uncompressed, to 9, maximally compressed). If \fB\-header\fR
is given, \fIdict\fR is a dictionary containing values used for the gzip
header. The following keys may be defined:
.RS
.TP
\fBcomment\fR
.
Add the given comment to the header of the gzip-format data.
.TP
\fBcrc\fR
.
A boolean saying whether to compute a CRC of the header. Note that if the data
is to be interchanged with the \fBgzip\fR program, a header CRC should
\fInot\fR be computed.
.TP
\fBfilename\fR
.
The name of the file that the data to be compressed came from.
.TP
\fBos\fR
.
The operating system type code, which should be one of the values described in
RFC 1952.
.TP
\fBtime\fR
.
The time that the file named in the \fBfilename\fR key was last modified. This
will be in the same as is returned by \fBclock seconds\fR or \fBfile mtime\fR.
.TP
\fBtype\fR
.
The type of the data being compressed, being \fBbinary\fR or \fBtext\fR.
.RE
.TP
\fBzlib inflate\fI string\fR ?\fIbufferSize\fR?
.
Returns the uncompressed version of the raw compressed binary data in
\fIstring\fR. If present, \fIbufferSize\fR is a hint as to what size of buffer
is to be used to receive the data.
.SS "CHANNEL SUBCOMMAND"
.TP
\fBzlib push\fI mode channel\fR ?\fIoptions ...\fR?
.
Pushes a compressing or decompressing transformation onto the channel
\fIchannel\fR.
The transformation can be removed again with \fBchan pop\fR.
The \fImode\fR argument determines what type of transformation
is pushed; the following are supported:
.RS
.TP
\fBcompress\fR
.
The transformation will be a compressing transformation that produces
zlib-format data on \fIchannel\fR, which must be writable.
.TP
\fBdecompress\fR
.
The transformation will be a decompressing transformation that reads
zlib-format data from \fIchannel\fR, which must be readable.
.TP
\fBdeflate\fR
.
The transformation will be a compressing transformation that produces raw
compressed data on \fIchannel\fR, which must be writable.
.TP
\fBgunzip\fR
.
The transformation will be a decompressing transformation that reads
gzip-format data from \fIchannel\fR, which must be readable.
.TP
\fBgzip\fR
.
The transformation will be a compressing transformation that produces
gzip-format data on \fIchannel\fR, which must be writable.
.TP
\fBinflate\fR
.
The transformation will be a decompressing transformation that reads raw
compressed data from \fIchannel\fR, which must be readable.
.PP
The following options may be set when creating a transformation via
the
.QW "\fIoptions ...\fR"
to the \fBzlib push\fR command:
.TP
\fB\-dictionary\fI binData\fR
.VS "TIP 400"
Sets the compression dictionary to use when working with compressing or
decompressing the data to be \fIbinData\fR. Not valid for transformations that
work with gzip-format data.  The dictionary should consist of strings (byte
sequences) that are likely to be encountered later in the data to be compressed,
with the most commonly used strings preferably put towards the end of the
dictionary. Tcl provides no mechanism for choosing a good such dictionary for
a particular data sequence.
.VE
.TP
\fB\-header\fI dictionary\fR
.
Passes a description of the gzip header to create, in the same format that
\fBzlib gzip\fR understands.
.TP
\fB\-level\fI compressionLevel\fR
.
How hard to compress the data. Must be an integer from 0 (uncompressed) to 9
(maximally compressed).
.TP
\fB\-limit\fI readaheadLimit\fR
.
The maximum number of bytes ahead to read when decompressing.
.RS
.PP
This option has become \fBirrelevant\fR. It was originally introduced
to prevent Tcl from reading beyond the end of a compressed stream in
multi-stream channels to ensure that the data after was left alone for
further reading, at the cost of speed.
.PP
Tcl now automatically returns any bytes it has read beyond the end of
a compressed stream back to the channel, making them appear as unread
to further readers.
.RE
.PP
Both compressing and decompressing channel transformations add extra
configuration options that may be accessed through \fBchan configure\fR. The
options are:
.TP
\fB\-checksum\fI checksum\fR
.
This read-only option gets the current checksum for the uncompressed data that
the compression engine has seen so far. It is valid for both compressing and
decompressing transforms, but not for the raw inflate and deflate formats. The
compression algorithm depends on what format is being produced or consumed.
.TP
\fB\-dictionary\fI binData\fR
.VS "TIP 400"
This read-write options gets or sets the initial compression dictionary to use
when working with compressing or decompressing the data to be \fIbinData\fR.
It is not valid for transformations that work with gzip-format data, and should
not normally be set on compressing transformations other than at the point where
the transformation is stacked. Note that this cannot be used to get the
current active compression dictionary mid-stream, as that information is not
exposed by the underlying library.
.VE
.TP
\fB\-flush\fI type\fR
.
This write-only operation flushes the current state of the compressor to the
underlying channel. It is only valid for compressing transformations. The
\fItype\fR must be either \fBsync\fR or \fBfull\fR for a normal flush or an
expensive flush respectively. Flushing degrades the compression ratio, but
makes it easier for a decompressor to recover more of the file in the case of
data corruption.
.TP
\fB\-header\fI dictionary\fR
.
This read-only option, only valid for decompressing transforms that are
processing gzip-format data, returns the dictionary describing the header read
off the data stream.
.TP
\fB\-limit\fI readaheadLimit\fR
.
This read-write option is used by decompressing channels to control the
maximum number of bytes ahead to read from the underlying data source. See
above for more information.
.RE
.SS "STREAMING SUBCOMMAND"
.TP
\fBzlib stream\fI mode\fR ?\fIoptions\fR?
.
Creates a streaming compression or decompression command based on the
\fImode\fR, and return the name of the command. For a description of how that
command works, see \fBSTREAMING INSTANCE COMMAND\fR below. The following modes
and \fIoptions\fR are supported:
.RS
.TP
\fBzlib stream compress\fR ?\fB\-dictionary \fIbindata\fR? ?\fB\-level \fIlevel\fR?
.
The stream will be a compressing stream that produces zlib-format output,
using compression level \fIlevel\fR (if specified) which will be an integer
from 0 to 9,
.VS "TIP 400"
and the compression dictionary \fIbindata\fR (if specified).
.VE
.TP
\fBzlib stream decompress\fR ?\fB\-dictionary \fIbindata\fR?
.
The stream will be a decompressing stream that takes zlib-format input and
produces uncompressed output.
.VS "TIP 400"
If \fIbindata\fR is supplied, it is a compression dictionary to use if
required.
.VE
.TP
\fBzlib stream deflate\fR ?\fB\-dictionary \fIbindata\fR? ?\fB\-level \fIlevel\fR?
.
The stream will be a compressing stream that produces raw output, using
compression level \fIlevel\fR (if specified) which will be an integer from 0
to 9,
.VS "TIP 400"
and the compression dictionary \fIbindata\fR (if specified). Note that
the raw compressed data includes no metadata about what compression
dictionary was used, if any; that is a feature of the zlib-format data.
.VE
.TP
\fBzlib stream gunzip\fR
.
The stream will be a decompressing stream that takes gzip-format input and
produces uncompressed output.
.TP
\fBzlib stream gzip\fR ?\fB\-header \fIheader\fR? ?\fB\-level \fIlevel\fR?
.
The stream will be a compressing stream that produces gzip-format output,
using compression level \fIlevel\fR (if specified) which will be an integer
from 0 to 9, and the header descriptor dictionary \fIheader\fR (if specified;
for keys see \fBzlib gzip\fR).
.TP
\fBzlib stream inflate\fR ?\fB\-dictionary \fIbindata\fR?
.
The stream will be a decompressing stream that takes raw compressed input and
produces uncompressed output.
.VS "TIP 400"
If \fIbindata\fR is supplied, it is a compression dictionary to use. Note that
there are no checks in place to determine whether the compression dictionary
is correct.
.VE
.RE
.SS "CHECKSUMMING SUBCOMMANDS"
.TP
\fBzlib adler32\fI string\fR ?\fIinitValue\fR?
.
Compute a checksum of binary string \fIstring\fR using the Adler-32 algorithm.
If given, \fIinitValue\fR is used to initialize the checksum engine.
.TP
\fBzlib crc32\fI string\fR ?\fIinitValue\fR?
.
Compute a checksum of binary string \fIstring\fR using the CRC-32 algorithm.
If given, \fIinitValue\fR is used to initialize the checksum engine.
.SH "STREAMING INSTANCE COMMAND"
.PP
Streaming compression instance commands are produced by the \fBzlib stream\fR
command. They are used by calling their \fBput\fR subcommand one or more times
to load data in, and their \fBget\fR subcommand one or more times to extract
the transformed data.
.PP
The full set of subcommands supported by a streaming instance command,
\fIstream\fR, is as follows:
.TP
\fIstream \fBadd\fR ?\fIoption...\fR? \fIdata\fR
.
A short-cut for
.QW "\fIstream \fBput \fR?\fIoption...\fR? \fIdata\fR"
followed by
.QW "\fIstream \fBget\fR" .
.TP
\fIstream \fBchecksum\fR
.
Returns the checksum of the uncompressed data seen so far by this stream.
.TP
\fIstream \fBclose\fR
.
Deletes this stream and frees up all resources associated with it.
.TP
\fIstream \fBeof\fR
.
Returns a boolean indicating whether the end of the stream (as determined by
the compressed data itself) has been reached. Not all formats support
detection of the end of the stream.
.TP
\fIstream \fBfinalize\fR
.
A short-cut for
.QW "\fIstream \fBput \-finalize {}\fR" .
.TP
\fIstream \fBflush\fR
.
A short-cut for
.QW "\fIstream \fBput \-flush {}\fR" .
.TP
\fIstream \fBfullflush\fR
.
A short-cut for
.QW "\fIstream \fBput \-fullflush {}\fR" .
.TP
\fIstream \fBget \fR?\fIcount\fR?
.
Return up to \fIcount\fR bytes from \fIstream\fR's internal buffers with the
transformation applied. If \fIcount\fR is omitted, the entire contents of the
buffers are returned.
.
\fIstream \fBheader\fR
.
Return the gzip header description dictionary extracted from the stream. Only
supported for streams created with their \fImode\fR parameter set to
\fBgunzip\fR.
.TP
\fIstream \fBput\fR ?\fIoption...\fR? \fIdata\fR
.
Append the contents of the binary string \fIdata\fR to \fIstream\fR's internal
buffers while applying the transformation. The following \fIoption\fRs are
supported (or an unambiguous prefix of them), which are used to modify the
way in which the transformation is applied:
.RS
.TP
\fB\-dictionary\fI binData\fR
.VS "TIP 400"
Sets the compression dictionary to use when working with compressing or
decompressing the data to be \fIbinData\fR.
.VE
.TP
\fB\-finalize\fR
.
Mark the stream as finished, ensuring that all bytes have been wholly
compressed or decompressed. For gzip streams, this also ensures that the
footer is written to the stream. The stream will need to be reset before
having more data written to it after this, though data can still be read out
of the stream with the \fBget\fR subcommand.
.RS
.PP
This option is mutually exclusive with the \fB\-flush\fR and \fB\-fullflush\fR
options.
.RE
.TP
\fB\-flush\fR
.
Ensure that a decompressor consuming the bytes that the current (compressing)
stream is producing will be able to produce all the bytes that have been
compressed so far, at some performance penalty.
.RS
.PP
This option is mutually exclusive with the \fB\-finalize\fR and
\fB\-fullflush\fR options.
.RE
.TP
\fB\-fullflush\fR
.
Ensure that not only can a decompressor handle all the bytes produced so far
(as with \fB\-flush\fR above) but also that it can restart from this point if
it detects that the stream is partially corrupt. This incurs a substantial
performance penalty.
.RS
.PP
This option is mutually exclusive with the \fB\-finalize\fR and \fB\-flush\fR
options.
.RE
.RE
.TP
\fIstream \fBreset\fR
.
Puts any stream, including those that have been finalized or that have reached
eof, back into a state where it can process more data. Throws away all
internally buffered data.
.SH EXAMPLES
.PP
To compress a Tcl string, it should be first converted to a particular charset
encoding since the \fBzlib\fR command always operates on binary strings.
.PP
.CS
set binData [encoding convertto utf-8 $string]
set compData [\fBzlib compress\fR $binData]
.CE
.PP
When converting back, it is also important to reverse the charset encoding:
.PP
.CS
set binData [\fBzlib decompress\fR $compData]
set string [encoding convertfrom utf-8 $binData]
.CE
.PP
The compression operation from above can also be done with streams, which is
especially helpful when you want to accumulate the data by stages:
.PP
.CS
set strm [\fBzlib stream\fR compress]
$\fIstrm \fBput\fR [encoding convertto utf-8 $string]
# ...
$\fIstrm \fBfinalize\fR
set compData [$\fIstrm \fBget\fR]
$\fIstrm \fBclose\fR
.CE
.SH "SEE ALSO"
binary(n), chan(n), encoding(n), Tcl_ZlibDeflate(3), RFC1950 \- RFC1952
.SH "KEYWORDS"
compress, decompress, deflate, gzip, inflate, zlib
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to generic/regc_color.c.

33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47







-
+







 */

#define	CISERR()	VISERR(cm->v)
#define	CERR(e)		VERR(cm->v, (e))

/*
 - initcm - set up new colormap
 ^ static void initcm(struct vars *, struct colormap *);
 ^ static VOID initcm(struct vars *, struct colormap *);
 */
static void
initcm(
    struct vars *v,
    struct colormap *cm)
{
    int i;
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98







-
+







	t->tcolor[i] = WHITE;
    }
    cd->block = t;
}

/*
 - freecm - free dynamically-allocated things in a colormap
 ^ static void freecm(struct colormap *);
 ^ static VOID freecm(struct colormap *);
 */
static void
freecm(
    struct colormap *cm)
{
    size_t i;
    union tree *cb;
112
113
114
115
116
117
118
119

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

119
120
121
122
123
124
125
126







-
+







    if (cm->cd != cm->cdspace) {
	FREE(cm->cd);
    }
}

/*
 - cmtreefree - free a non-terminal part of a colormap tree
 ^ static void cmtreefree(struct colormap *, union tree *, int);
 ^ static VOID cmtreefree(struct colormap *, union tree *, int);
 */
static void
cmtreefree(
    struct colormap *cm,
    union tree *tree,
    int level)			/* level number (top == 0) of this block */
{
290
291
292
293
294
295
296
297

298
299
300
301
302
303
304
290
291
292
293
294
295
296

297
298
299
300
301
302
303
304







-
+







    cd->block = NULL;

    return (color) (cd - cm->cd);
}

/*
 - freecolor - free a color (must have no arcs or subcolor)
 ^ static void freecolor(struct colormap *, pcolor);
 ^ static VOID freecolor(struct colormap *, pcolor);
 */
static void
freecolor(
    struct colormap *cm,
    pcolor co)
{
    struct colordesc *cd = &cm->cd[co];
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
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







-
+











-
+







	    cm->max--;
	}
	assert(cm->free >= 0);
	while ((size_t) cm->free > cm->max) {
	    cm->free = cm->cd[cm->free].sub;
	}
	if (cm->free > 0) {
	    assert((size_t)cm->free < cm->max);
	    assert(cm->free < cm->max);
	    pco = cm->free;
	    nco = cm->cd[pco].sub;
	    while (nco > 0) {
		if ((size_t) nco > cm->max) {
		    /*
		     * Take this one out of freelist.
		     */

		    nco = cm->cd[nco].sub;
		    cm->cd[pco].sub = nco;
		} else {
		    assert((size_t)nco < cm->max);
		    assert(nco < cm->max);
		    pco = nco;
		    nco = cm->cd[pco].sub;
		}
	    }
	}
    } else {
	cd->sub = cm->free;
425
426
427
428
429
430
431
432

433
434
435
436
437
438
439
425
426
427
428
429
430
431

432
433
434
435
436
437
438
439







-
+







    assert(sco != NOSUB);

    return sco;
}

/*
 - subrange - allocate new subcolors to this range of chrs, fill in arcs
 ^ static void subrange(struct vars *, pchr, pchr, struct state *,
 ^ static VOID subrange(struct vars *, pchr, pchr, struct state *,
 ^ 	struct state *);
 */
static void
subrange(
    struct vars *v,
    pchr from,
    pchr to,
473
474
475
476
477
478
479
480

481
482
483
484
485
486
487
473
474
475
476
477
478
479

480
481
482
483
484
485
486
487







-
+







    for (; from<=to ; from++) {
	newarc(v->nfa, PLAIN, subcolor(v->cm, from), lp, rp);
    }
}

/*
 - subblock - allocate new subcolors for one tree block of chrs, fill in arcs
 ^ static void subblock(struct vars *, pchr, struct state *, struct state *);
 ^ static VOID subblock(struct vars *, pchr, struct state *, struct state *);
 */
static void
subblock(
    struct vars *v,
    pchr start,			/* first of BYTTAB chrs */
    struct state *lp,
    struct state *rp)
578
579
580
581
582
583
584
585

586
587
588
589
590
591
592
578
579
580
581
582
583
584

585
586
587
588
589
590
591
592







-
+







	cm->cd[co].nchrs -= ndone;
	cm->cd[sco].nchrs += ndone;
    }
}

/*
 - okcolors - promote subcolors to full colors
 ^ static void okcolors(struct nfa *, struct colormap *);
 ^ static VOID okcolors(struct nfa *, struct colormap *);
 */
static void
okcolors(
    struct nfa *nfa,
    struct colormap *cm)
{
    struct colordesc *cd;
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
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







-
+


















-
+







	    }
	}
    }
}

/*
 - colorchain - add this arc to the color chain of its color
 ^ static void colorchain(struct colormap *, struct arc *);
 ^ static VOID colorchain(struct colormap *, struct arc *);
 */
static void
colorchain(
    struct colormap *cm,
    struct arc *a)
{
    struct colordesc *cd = &cm->cd[a->co];

    if (cd->arcs != NULL) {
	cd->arcs->colorchainRev = a;
    }
    a->colorchain = cd->arcs;
    a->colorchainRev = NULL;
    cd->arcs = a;
}

/*
 - uncolorchain - delete this arc from the color chain of its color
 ^ static void uncolorchain(struct colormap *, struct arc *);
 ^ static VOID uncolorchain(struct colormap *, struct arc *);
 */
static void
uncolorchain(
    struct colormap *cm,
    struct arc *a)
{
    struct colordesc *cd = &cm->cd[a->co];
684
685
686
687
688
689
690
691

692
693
694
695
696
697
698
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698







-
+







    }
    a->colorchain = NULL;	/* paranoia */
    a->colorchainRev = NULL;
}

/*
 - rainbow - add arcs of all full colors (but one) between specified states
 ^ static void rainbow(struct nfa *, struct colormap *, int, pcolor,
 ^ static VOID rainbow(struct nfa *, struct colormap *, int, pcolor,
 ^ 	struct state *, struct state *);
 */
static void
rainbow(
    struct nfa *nfa,
    struct colormap *cm,
    int type,
711
712
713
714
715
716
717
718

719
720
721
722
723
724
725
711
712
713
714
715
716
717

718
719
720
721
722
723
724
725







-
+







	}
    }
}

/*
 - colorcomplement - add arcs of complementary colors
 * The calling sequence ought to be reconciled with cloneouts().
 ^ static void colorcomplement(struct nfa *, struct colormap *, int,
 ^ static VOID colorcomplement(struct nfa *, struct colormap *, int,
 ^ 	struct state *, struct state *, struct state *);
 */
static void
colorcomplement(
    struct nfa *nfa,
    struct colormap *cm,
    int type,
744
745
746
747
748
749
750
751

752
753
754
755
756
757
758
744
745
746
747
748
749
750

751
752
753
754
755
756
757
758







-
+







#ifdef REG_DEBUG
/*
 ^ #ifdef REG_DEBUG
 */

/*
 - dumpcolors - debugging output
 ^ static void dumpcolors(struct colormap *, FILE *);
 ^ static VOID dumpcolors(struct colormap *, FILE *);
 */
static void
dumpcolors(
    struct colormap *cm,
    FILE *f)
{
    struct colordesc *cd;
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
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







-
+
-
-
-
-
-


-
+



+
+
+
+








-
+







	    if (cd->flags&PSEUDO) {
		fprintf(f, "#%2ld%s(ps): ", (long) co, has);
	    } else {
		fprintf(f, "#%2ld%s(%2d): ", (long) co, has, cd->nchrs);
	    }

	    /*
	     * Unfortunately, it's hard to do this next bit more efficiently.
	     * It's hard to do this more efficiently.
	     *
	     * Spencer's original coding has the loop iterating from CHR_MIN
	     * to CHR_MAX, but that's utterly unusable for 32-bit chr, or
	     * even 16-bit.  For debugging purposes it seems fine to print
	     * only chr codes up to 1000 or so.
	     */

	    for (c=CHR_MIN ; c<1000 ; c++) {
	    for (c=CHR_MIN ; c<CHR_MAX ; c++) {
		if (GETCOLOR(cm, c) == co) {
		    dumpchr(c, f);
		}
	    }
	    assert(c == CHR_MAX);
	    if (GETCOLOR(cm, c) == co) {
		dumpchr(c, f);
	    }
	    fprintf(f, "\n");
	}
    }
}

/*
 - fillcheck - check proper filling of a tree
 ^ static void fillcheck(struct colormap *, union tree *, int, FILE *);
 ^ static VOID fillcheck(struct colormap *, union tree *, int, FILE *);
 */
static void
fillcheck(
    struct colormap *cm,
    union tree *tree,
    int level,			/* level number (top == 0) of this block */
    FILE *f)
822
823
824
825
826
827
828
829

830
831
832
833
834
835
836
821
822
823
824
825
826
827

828
829
830
831
832
833
834
835







-
+







	}
    }
}

/*
 - dumpchr - print a chr
 * Kind of char-centric but works well enough for debug use.
 ^ static void dumpchr(pchr, FILE *);
 ^ static VOID dumpchr(pchr, FILE *);
 */
static void
dumpchr(
    pchr c,
    FILE *f)
{
    if (c == '\\') {

Changes to generic/regc_cvec.c.

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
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







-
+






-





-
+







    cv->nchrs = 0;
    cv->nranges = 0;
    return cv;
}

/*
 - addchr - add a chr to a cvec
 ^ static void addchr(struct cvec *, pchr);
 ^ static VOID addchr(struct cvec *, pchr);
 */
static void
addchr(
    struct cvec *cv,		/* character vector */
    pchr c)			/* character to add */
{
    assert(cv->nchrs < cv->chrspace);
    cv->chrs[cv->nchrs++] = (chr)c;
}

/*
 - addrange - add a range to a cvec
 ^ static void addrange(struct cvec *, pchr, pchr);
 ^ static VOID addrange(struct cvec *, pchr, pchr);
 */
static void
addrange(
    struct cvec *cv,		/* character vector */
    pchr from,			/* first character of range */
    pchr to)			/* last character of range */
{
125
126
127
128
129
130
131
132

133
134
135
136
137
138
139
124
125
126
127
128
129
130

131
132
133
134
135
136
137
138







-
+







    }

    return v->cv;
}

/*
 - freecvec - free a cvec
 ^ static void freecvec(struct cvec *);
 ^ static VOID freecvec(struct cvec *);
 */
static void
freecvec(
    struct cvec *cv)		/* character vector */
{
    FREE(cv);
}

Changes to generic/regc_lex.c.

423
424
425
426
427
428
429
430

431
432
433
434
435
436
437
423
424
425
426
427
428
429

430
431
432
433
434
435
436
437







-
+







		FAILW(REG_BADBR);
	    }
	    break;
	case CHR('\\'):		/* BRE bound ends with \} */
	    if (INCON(L_BBND) && NEXT1('}')) {
		v->now++;
		INTOCON(L_BRE);
		RET('}');
		RETV('}', 1);
	    } else {
		FAILW(REG_BADBR);
	    }
	    break;
	default:
	    FAILW(REG_BADBR);
	    break;
453
454
455
456
457
458
459
460

461
462
463
464
465
466
467
453
454
455
456
457
458
459

460
461
462
463
464
465
466
467







-
+







	    if (!(v->cflags&REG_ADVF)) {
		RETV(PLAIN, c);
	    }
	    NOTE(REG_UNONPOSIX);
	    if (ATEOS()) {
		FAILW(REG_EESCAPE);
	    }
	    (void)lexescape(v);
	    (DISCARD)lexescape(v);
	    switch (v->nexttype) {	/* not all escapes okay here */
	    case PLAIN:
		return 1;
		break;
	    case CCLASS:
		switch (v->nextvalue) {
		case 'd':
712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
712
713
714
715
716
717
718

719
720
721
722
723
724
725
726







-
+







    if (!(v->cflags&REG_ADVF)) {/* only AREs have non-trivial escapes */
	if (iscalnum(*v->now)) {
	    NOTE(REG_UBSALNUM);
	    NOTE(REG_UUNSPEC);
	}
	RETV(PLAIN, *v->now++);
    }
    (void)lexescape(v);
    (DISCARD)lexescape(v);
    if (ISERR()) {
	FAILW(REG_EESCAPE);
    }
    if (v->nexttype == CCLASS) {/* fudge at lexical level */
	switch (v->nextvalue) {
	case 'd':	lexnest(v, backd, ENDOF(backd)); break;
	case 'D':	lexnest(v, backD, ENDOF(backD)); break;
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
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







-
+






-
+



+
+
+
+
+
-
+
-
-


+
-
+














-
+







	NOTE(REG_ULOCALE);
	RETV(CCLASS, 'S');
	break;
    case CHR('t'):
	RETV(PLAIN, CHR('\t'));
	break;
    case CHR('u'):
	c = (uchr) lexdigits(v, 16, 1, 4);
	c = (uchr) lexdigits(v, 16, 4, 4);
	if (ISERR()) {
	    FAILW(REG_EESCAPE);
	}
	RETV(PLAIN, c);
	break;
    case CHR('U'):
	i = lexdigits(v, 16, 1, 8);
	i = lexdigits(v, 16, 8, 8);
	if (ISERR()) {
	    FAILW(REG_EESCAPE);
	}
#if CHRBITS > 16
	if ((unsigned)i > 0x10FFFF) {
	    i = 0xFFFD;
	}
#else
	if (i > 0xFFFF) {
	if ((unsigned)i & ~0xFFFF) {
	    /* TODO: output a Surrogate pair
	     */
	    i = 0xFFFD;
	}
#endif
	RETV(PLAIN, (uchr) i);
	RETV(PLAIN, (uchr)i);
	break;
    case CHR('v'):
	RETV(PLAIN, CHR('\v'));
	break;
    case CHR('w'):
	NOTE(REG_ULOCALE);
	RETV(CCLASS, 'w');
	break;
    case CHR('W'):
	NOTE(REG_ULOCALE);
	RETV(CCLASS, 'W');
	break;
    case CHR('x'):
	NOTE(REG_UUNPORT);
	c = (uchr) lexdigits(v, 16, 1, 2);
	c = lexdigits(v, 16, 1, 255);	/* REs >255 long outside spec */
	if (ISERR()) {
	    FAILW(REG_EESCAPE);
	}
	RETV(PLAIN, c);
	break;
    case CHR('y'):
	NOTE(REG_ULOCALE);
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
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







-
+








-
+















-
+



-
-
-
-
-












-
+

-
+






-
+



-
+



-
-
-
-







	RETV(SEND, 0);
	break;
    case CHR('1'): case CHR('2'): case CHR('3'): case CHR('4'):
    case CHR('5'): case CHR('6'): case CHR('7'): case CHR('8'):
    case CHR('9'):
	save = v->now;
	v->now--;		/* put first digit back */
	c = (uchr) lexdigits(v, 10, 1, 255);	/* REs >255 long outside spec */
	c = lexdigits(v, 10, 1, 255);	/* REs >255 long outside spec */
	if (ISERR()) {
	    FAILW(REG_EESCAPE);
	}

	/*
	 * Ugly heuristic (first test is "exactly 1 digit?")
	 */

	if (v->now - save == 0 || ((int) c > 0 && (size_t)c <= v->nsubexp)) {
	if (v->now - save == 0 || ((int) c > 0 && (int)c <= v->nsubexp)) {
	    NOTE(REG_UBACKREF);
	    RETV(BACKREF, (chr)c);
	}

	/*
	 * Oops, doesn't look like it's a backref after all...
	 */

	v->now = save;

	/* FALLTHRU */

    case CHR('0'):
	NOTE(REG_UUNPORT);
	v->now--;		/* put first digit back */
	c = (uchr) lexdigits(v, 8, 1, 3);
	c = lexdigits(v, 8, 1, 3);
	if (ISERR()) {
	    FAILW(REG_EESCAPE);
	}
	if (c > 0xFF) {
	    /* out of range, so we handled one digit too much */
	    v->now--;
	    c >>= 3;
	}
	RETV(PLAIN, c);
	break;
    default:
	assert(iscalpha(c));
	FAILW(REG_EESCAPE);	/* unknown alphabetic escape */
	break;
    }
    assert(NOTREACHED);
}

/*
 - lexdigits - slurp up digits and return chr value
 ^ static int lexdigits(struct vars *, int, int, int);
 ^ static chr lexdigits(struct vars *, int, int, int);
 */
static int			/* chr value; errors signalled via ERR */
static chr			/* chr value; errors signalled via ERR */
lexdigits(
    struct vars *v,
    int base,
    int minlen,
    int maxlen)
{
    int n;
    uchr n;			/* unsigned to avoid overflow misbehavior */
    int len;
    chr c;
    int d;
    const uchr ub = (uchr) base;
    CONST uchr ub = (uchr) base;

    n = 0;
    for (len = 0; len < maxlen && !ATEOS(); len++) {
	if (n > 0x10FFF) {
	    /* Stop when continuing would otherwise overflow */
	    break;
	}
	c = *v->now++;
	switch (c) {
	case CHR('0'): case CHR('1'): case CHR('2'): case CHR('3'):
	case CHR('4'): case CHR('5'): case CHR('6'): case CHR('7'):
	case CHR('8'): case CHR('9'):
	    d = DIGITVAL(c);
	    break;
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
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







-
+




















-
+







	}
	n = n*ub + (uchr)d;
    }
    if (len < minlen) {
	ERR(REG_EESCAPE);
    }

    return n;
    return (chr)n;
}

/*
 - brenext - get next BRE token
 * This is much like EREs except for all the stupid backslashes and the
 * context-dependency of some things.
 ^ static int brenext(struct vars *, pchr);
 */
static int			/* 1 normal, 0 failure */
brenext(
    struct vars *v,
    pchr pc)
{
    chr c = (chr)pc;

    switch (c) {
    case CHR('*'):
	if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) {
	    RETV(PLAIN, c);
	}
	RET('*');
	RETV('*', 1);
	break;
    case CHR('['):
	if (HAVE(6) &&	*(v->now+0) == CHR('[') &&
		*(v->now+1) == CHR(':') &&
		(*(v->now+2) == CHR('<') || *(v->now+2) == CHR('>')) &&
		*(v->now+3) == CHR(':') &&
		*(v->now+4) == CHR(']') &&
1102
1103
1104
1105
1106
1107
1108
1109

1110
1111
1112
1113
1114
1115
1116
1097
1098
1099
1100
1101
1102
1103

1104
1105
1106
1107
1108
1109
1110
1111







-
+







    }

    assert(NOTREACHED);
}

/*
 - skip - skip white space and comments in expanded form
 ^ static void skip(struct vars *);
 ^ static VOID skip(struct vars *);
 */
static void
skip(
    struct vars *v)
{
    const chr *start = v->now;

1137
1138
1139
1140
1141
1142
1143
1144

1145
1146
1147
1148
1149
1150
1151


















1152
1153
1154
1155
1156
1157
1158
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







-
+







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







	NOTE(REG_UNONPOSIX);
    }
}

/*
 - newline - return the chr for a newline
 * This helps confine use of CHR to this source file.
 ^ static chr newline(void);
 ^ static chr newline(NOPARMS);
 */
static chr
newline(void)
{
    return CHR('\n');
}

/*
 - ch - return the chr sequence for regc_locale.c's fake collating element ch
 * This helps confine use of CHR to this source file.  Beware that the caller
 * knows how long the sequence is.
 ^ #ifdef REG_DEBUG
 ^ static const chr *ch(NOPARMS);
 ^ #endif
 */
#ifdef REG_DEBUG
static const chr *
ch(void)
{
    static const chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };

    return chstr;
}
#endif

/*
 - chrnamed - return the chr known by a given (chr string) name
 * The code is a bit clumsy, but this routine gets only such specialized
 * use that it hardly matters.
 ^ static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
 */
static chr

Changes to generic/regc_locale.c.

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
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







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



-
+








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






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


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














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

+
-
-
-
+
+
+


-
-
-
-
-
+
+
+
+
+
+














-
+







-
+







static const crange alphaRangeTable[] = {
    {0x41, 0x5A}, {0x61, 0x7A}, {0xC0, 0xD6}, {0xD8, 0xF6},
    {0xF8, 0x2C1}, {0x2C6, 0x2D1}, {0x2E0, 0x2E4}, {0x370, 0x374},
    {0x37A, 0x37D}, {0x388, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x3F5},
    {0x3F7, 0x481}, {0x48A, 0x52F}, {0x531, 0x556}, {0x560, 0x588},
    {0x5D0, 0x5EA}, {0x5EF, 0x5F2}, {0x620, 0x64A}, {0x671, 0x6D3},
    {0x6FA, 0x6FC}, {0x712, 0x72F}, {0x74D, 0x7A5}, {0x7CA, 0x7EA},
    {0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86A}, {0x8A0, 0x8B4},
    {0x8B6, 0x8C7}, {0x904, 0x939}, {0x958, 0x961}, {0x971, 0x980},
    {0x985, 0x98C}, {0x993, 0x9A8}, {0x9AA, 0x9B0}, {0x9B6, 0x9B9},
    {0x9DF, 0x9E1}, {0xA05, 0xA0A}, {0xA13, 0xA28}, {0xA2A, 0xA30},
    {0xA59, 0xA5C}, {0xA72, 0xA74}, {0xA85, 0xA8D}, {0xA8F, 0xA91},
    {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9}, {0xB05, 0xB0C},
    {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39}, {0xB5F, 0xB61},
    {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95}, {0xBA8, 0xBAA},
    {0xBAE, 0xBB9}, {0xC05, 0xC0C}, {0xC0E, 0xC10}, {0xC12, 0xC28},
    {0xC2A, 0xC39}, {0xC58, 0xC5A}, {0xC85, 0xC8C}, {0xC8E, 0xC90},
    {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9}, {0xD04, 0xD0C},
    {0xD0E, 0xD10}, {0xD12, 0xD3A}, {0xD54, 0xD56}, {0xD5F, 0xD61},
    {0xD7A, 0xD7F}, {0xD85, 0xD96}, {0xD9A, 0xDB1}, {0xDB3, 0xDBB},
    {0xDC0, 0xDC6}, {0xE01, 0xE30}, {0xE40, 0xE46}, {0xE86, 0xE8A},
    {0xE8C, 0xEA3}, {0xEA7, 0xEB0}, {0xEC0, 0xEC4}, {0xEDC, 0xEDF},
    {0xF40, 0xF47}, {0xF49, 0xF6C}, {0xF88, 0xF8C}, {0x1000, 0x102A},
    {0x1050, 0x1055}, {0x105A, 0x105D}, {0x106E, 0x1070}, {0x1075, 0x1081},
    {0x10A0, 0x10C5}, {0x10D0, 0x10FA}, {0x10FC, 0x1248}, {0x124A, 0x124D},
    {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288}, {0x128A, 0x128D},
    {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE}, {0x12C2, 0x12C5},
    {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135A},
    {0x1380, 0x138F}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD}, {0x1401, 0x166C},
    {0x166F, 0x167F}, {0x1681, 0x169A}, {0x16A0, 0x16EA}, {0x16F1, 0x16F8},
    {0x1700, 0x170C}, {0x170E, 0x1711}, {0x1720, 0x1731}, {0x1740, 0x1751},
    {0x800, 0x815}, {0x840, 0x858}, {0x860, 0x86A}, {0x870, 0x887},
    {0x889, 0x88E}, {0x8A0, 0x8C9}, {0x904, 0x939}, {0x958, 0x961},
    {0x971, 0x980}, {0x985, 0x98C}, {0x993, 0x9A8}, {0x9AA, 0x9B0},
    {0x9B6, 0x9B9}, {0x9DF, 0x9E1}, {0xA05, 0xA0A}, {0xA13, 0xA28},
    {0xA2A, 0xA30}, {0xA59, 0xA5C}, {0xA72, 0xA74}, {0xA85, 0xA8D},
    {0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9},
    {0xB05, 0xB0C}, {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39},
    {0xB5F, 0xB61}, {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95},
    {0xBA8, 0xBAA}, {0xBAE, 0xBB9}, {0xC05, 0xC0C}, {0xC0E, 0xC10},
    {0xC12, 0xC28}, {0xC2A, 0xC39}, {0xC58, 0xC5A}, {0xC85, 0xC8C},
    {0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9},
    {0xD04, 0xD0C}, {0xD0E, 0xD10}, {0xD12, 0xD3A}, {0xD54, 0xD56},
    {0xD5F, 0xD61}, {0xD7A, 0xD7F}, {0xD85, 0xD96}, {0xD9A, 0xDB1},
    {0xDB3, 0xDBB}, {0xDC0, 0xDC6}, {0xE01, 0xE30}, {0xE40, 0xE46},
    {0xE86, 0xE8A}, {0xE8C, 0xEA3}, {0xEA7, 0xEB0}, {0xEC0, 0xEC4},
    {0xEDC, 0xEDF}, {0xF40, 0xF47}, {0xF49, 0xF6C}, {0xF88, 0xF8C},
    {0x1000, 0x102A}, {0x1050, 0x1055}, {0x105A, 0x105D}, {0x106E, 0x1070},
    {0x1075, 0x1081}, {0x10A0, 0x10C5}, {0x10D0, 0x10FA}, {0x10FC, 0x1248},
    {0x124A, 0x124D}, {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288},
    {0x128A, 0x128D}, {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE},
    {0x12C2, 0x12C5}, {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315},
    {0x1318, 0x135A}, {0x1380, 0x138F}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD},
    {0x1401, 0x166C}, {0x166F, 0x167F}, {0x1681, 0x169A}, {0x16A0, 0x16EA},
    {0x16F1, 0x16F8}, {0x1700, 0x1711}, {0x171F, 0x1731}, {0x1740, 0x1751},
    {0x1760, 0x176C}, {0x176E, 0x1770}, {0x1780, 0x17B3}, {0x1820, 0x1878},
    {0x1880, 0x1884}, {0x1887, 0x18A8}, {0x18B0, 0x18F5}, {0x1900, 0x191E},
    {0x1950, 0x196D}, {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9},
    {0x1A00, 0x1A16}, {0x1A20, 0x1A54}, {0x1B05, 0x1B33}, {0x1B45, 0x1B4B},
    {0x1A00, 0x1A16}, {0x1A20, 0x1A54}, {0x1B05, 0x1B33}, {0x1B45, 0x1B4C},
    {0x1B83, 0x1BA0}, {0x1BBA, 0x1BE5}, {0x1C00, 0x1C23}, {0x1C4D, 0x1C4F},
    {0x1C5A, 0x1C7D}, {0x1C80, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF},
    {0x1CE9, 0x1CEC}, {0x1CEE, 0x1CF3}, {0x1D00, 0x1DBF}, {0x1E00, 0x1F15},
    {0x1F18, 0x1F1D}, {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57},
    {0x1F5F, 0x1F7D}, {0x1F80, 0x1FB4}, {0x1FB6, 0x1FBC}, {0x1FC2, 0x1FC4},
    {0x1FC6, 0x1FCC}, {0x1FD0, 0x1FD3}, {0x1FD6, 0x1FDB}, {0x1FE0, 0x1FEC},
    {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFC}, {0x2090, 0x209C}, {0x210A, 0x2113},
    {0x2119, 0x211D}, {0x212A, 0x212D}, {0x212F, 0x2139}, {0x213C, 0x213F},
    {0x2145, 0x2149}, {0x2C00, 0x2C2E}, {0x2C30, 0x2C5E}, {0x2C60, 0x2CE4},
    {0x2CEB, 0x2CEE}, {0x2D00, 0x2D25}, {0x2D30, 0x2D67}, {0x2D80, 0x2D96},
    {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE}, {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE},
    {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE}, {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE},
    {0x3031, 0x3035}, {0x3041, 0x3096}, {0x309D, 0x309F}, {0x30A1, 0x30FA},
    {0x30FC, 0x30FF}, {0x3105, 0x312F}, {0x3131, 0x318E}, {0x31A0, 0x31BF},
    {0x31F0, 0x31FF}, {0x3400, 0x4DBF}, {0x4E00, 0x9FFC}, {0xA000, 0xA48C},
    {0xA4D0, 0xA4FD}, {0xA500, 0xA60C}, {0xA610, 0xA61F}, {0xA640, 0xA66E},
    {0xA67F, 0xA69D}, {0xA6A0, 0xA6E5}, {0xA717, 0xA71F}, {0xA722, 0xA788},
    {0xA78B, 0xA7BF}, {0xA7C2, 0xA7CA}, {0xA7F5, 0xA801}, {0xA803, 0xA805},
    {0xA807, 0xA80A}, {0xA80C, 0xA822}, {0xA840, 0xA873}, {0xA882, 0xA8B3},
    {0xA8F2, 0xA8F7}, {0xA90A, 0xA925}, {0xA930, 0xA946}, {0xA960, 0xA97C},
    {0xA984, 0xA9B2}, {0xA9E0, 0xA9E4}, {0xA9E6, 0xA9EF}, {0xA9FA, 0xA9FE},
    {0xAA00, 0xAA28}, {0xAA40, 0xAA42}, {0xAA44, 0xAA4B}, {0xAA60, 0xAA76},
    {0xAA7E, 0xAAAF}, {0xAAB9, 0xAABD}, {0xAADB, 0xAADD}, {0xAAE0, 0xAAEA},
    {0xAAF2, 0xAAF4}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E}, {0xAB11, 0xAB16},
    {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB5A}, {0xAB5C, 0xAB69},
    {0xAB70, 0xABE2}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6}, {0xD7CB, 0xD7FB},
    {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17},
    {0xFB1F, 0xFB28}, {0xFB2A, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB46, 0xFBB1},
    {0xFBD3, 0xFD3D}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7}, {0xFDF0, 0xFDFB},
    {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF21, 0xFF3A}, {0xFF41, 0xFF5A},
    {0xFF66, 0xFFBE}, {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7},
    {0xFFDA, 0xFFDC}
    {0x2145, 0x2149}, {0x2C00, 0x2CE4}, {0x2CEB, 0x2CEE}, {0x2D00, 0x2D25},
    {0x2D30, 0x2D67}, {0x2D80, 0x2D96}, {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE},
    {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE}, {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE},
    {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE}, {0x3031, 0x3035}, {0x3041, 0x3096},
    {0x309D, 0x309F}, {0x30A1, 0x30FA}, {0x30FC, 0x30FF}, {0x3105, 0x312F},
    {0x3131, 0x318E}, {0x31A0, 0x31BF}, {0x31F0, 0x31FF}, {0x3400, 0x4DBF},
    {0x4E00, 0xA48C}, {0xA4D0, 0xA4FD}, {0xA500, 0xA60C}, {0xA610, 0xA61F},
    {0xA640, 0xA66E}, {0xA67F, 0xA69D}, {0xA6A0, 0xA6E5}, {0xA717, 0xA71F},
    {0xA722, 0xA788}, {0xA78B, 0xA7CA}, {0xA7D5, 0xA7D9}, {0xA7F2, 0xA801},
    {0xA803, 0xA805}, {0xA807, 0xA80A}, {0xA80C, 0xA822}, {0xA840, 0xA873},
    {0xA882, 0xA8B3}, {0xA8F2, 0xA8F7}, {0xA90A, 0xA925}, {0xA930, 0xA946},
    {0xA960, 0xA97C}, {0xA984, 0xA9B2}, {0xA9E0, 0xA9E4}, {0xA9E6, 0xA9EF},
    {0xA9FA, 0xA9FE}, {0xAA00, 0xAA28}, {0xAA40, 0xAA42}, {0xAA44, 0xAA4B},
    {0xAA60, 0xAA76}, {0xAA7E, 0xAAAF}, {0xAAB9, 0xAABD}, {0xAADB, 0xAADD},
    {0xAAE0, 0xAAEA}, {0xAAF2, 0xAAF4}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E},
    {0xAB11, 0xAB16}, {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB5A},
    {0xAB5C, 0xAB69}, {0xAB70, 0xABE2}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6},
    {0xD7CB, 0xD7FB}, {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06},
    {0xFB13, 0xFB17}, {0xFB1F, 0xFB28}, {0xFB2A, 0xFB36}, {0xFB38, 0xFB3C},
    {0xFB46, 0xFBB1}, {0xFBD3, 0xFD3D}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7},
    {0xFDF0, 0xFDFB}, {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF21, 0xFF3A},
    {0xFF41, 0xFF5A}, {0xFF66, 0xFFBE}, {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF},
    {0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC}
#if CHRBITS > 16
    ,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D},
    {0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10280, 0x1029C}, {0x102A0, 0x102D0},
    {0x10300, 0x1031F}, {0x1032D, 0x10340}, {0x10342, 0x10349}, {0x10350, 0x10375},
    {0x10380, 0x1039D}, {0x103A0, 0x103C3}, {0x103C8, 0x103CF}, {0x10400, 0x1049D},
    {0x104B0, 0x104D3}, {0x104D8, 0x104FB}, {0x10500, 0x10527}, {0x10530, 0x10563},
    {0x10570, 0x1057A}, {0x1057C, 0x1058A}, {0x1058C, 0x10592}, {0x10597, 0x105A1},
    {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10800, 0x10805},
    {0x1080A, 0x10835}, {0x1083F, 0x10855}, {0x10860, 0x10876}, {0x10880, 0x1089E},
    {0x108E0, 0x108F2}, {0x10900, 0x10915}, {0x10920, 0x10939}, {0x10980, 0x109B7},
    {0x10A10, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35}, {0x10A60, 0x10A7C},
    {0x10A80, 0x10A9C}, {0x10AC0, 0x10AC7}, {0x10AC9, 0x10AE4}, {0x10B00, 0x10B35},
    {0x10B40, 0x10B55}, {0x10B60, 0x10B72}, {0x10B80, 0x10B91}, {0x10C00, 0x10C48},
    {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10D00, 0x10D23}, {0x10E80, 0x10EA9},
    {0x10F00, 0x10F1C}, {0x10F30, 0x10F45}, {0x10FB0, 0x10FC4}, {0x10FE0, 0x10FF6},
    {0x11003, 0x11037}, {0x11083, 0x110AF}, {0x110D0, 0x110E8}, {0x11103, 0x11126},
    {0x11150, 0x11172}, {0x11183, 0x111B2}, {0x111C1, 0x111C4}, {0x11200, 0x11211},
    {0x11213, 0x1122B}, {0x11280, 0x11286}, {0x1128A, 0x1128D}, {0x1128F, 0x1129D},
    {0x1129F, 0x112A8}, {0x112B0, 0x112DE}, {0x11305, 0x1130C}, {0x11313, 0x11328},
    {0x1132A, 0x11330}, {0x11335, 0x11339}, {0x1135D, 0x11361}, {0x11400, 0x11434},
    {0x11447, 0x1144A}, {0x1145F, 0x11461}, {0x11480, 0x114AF}, {0x11580, 0x115AE},
    {0x115D8, 0x115DB}, {0x11600, 0x1162F}, {0x11680, 0x116AA}, {0x11700, 0x1171A},
    {0x11800, 0x1182B}, {0x118A0, 0x118DF}, {0x118FF, 0x11906}, {0x1190C, 0x11913},
    {0x11918, 0x1192F}, {0x119A0, 0x119A7}, {0x119AA, 0x119D0}, {0x11A0B, 0x11A32},
    {0x11A5C, 0x11A89}, {0x11AC0, 0x11AF8}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C2E},
    {0x11C72, 0x11C8F}, {0x11D00, 0x11D06}, {0x11D0B, 0x11D30}, {0x11D60, 0x11D65},
    {0x11D6A, 0x11D89}, {0x11EE0, 0x11EF2}, {0x12000, 0x12399}, {0x12480, 0x12543},
    {0x13000, 0x1342E}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E},
    {0x105A3, 0x105B1}, {0x105B3, 0x105B9}, {0x10600, 0x10736}, {0x10740, 0x10755},
    {0x10760, 0x10767}, {0x10780, 0x10785}, {0x10787, 0x107B0}, {0x107B2, 0x107BA},
    {0x10800, 0x10805}, {0x1080A, 0x10835}, {0x1083F, 0x10855}, {0x10860, 0x10876},
    {0x10880, 0x1089E}, {0x108E0, 0x108F2}, {0x10900, 0x10915}, {0x10920, 0x10939},
    {0x10980, 0x109B7}, {0x10A10, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35},
    {0x10A60, 0x10A7C}, {0x10A80, 0x10A9C}, {0x10AC0, 0x10AC7}, {0x10AC9, 0x10AE4},
    {0x10B00, 0x10B35}, {0x10B40, 0x10B55}, {0x10B60, 0x10B72}, {0x10B80, 0x10B91},
    {0x10C00, 0x10C48}, {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10D00, 0x10D23},
    {0x10E80, 0x10EA9}, {0x10F00, 0x10F1C}, {0x10F30, 0x10F45}, {0x10F70, 0x10F81},
    {0x10FB0, 0x10FC4}, {0x10FE0, 0x10FF6}, {0x11003, 0x11037}, {0x11083, 0x110AF},
    {0x110D0, 0x110E8}, {0x11103, 0x11126}, {0x11150, 0x11172}, {0x11183, 0x111B2},
    {0x111C1, 0x111C4}, {0x11200, 0x11211}, {0x11213, 0x1122B}, {0x11280, 0x11286},
    {0x1128A, 0x1128D}, {0x1128F, 0x1129D}, {0x1129F, 0x112A8}, {0x112B0, 0x112DE},
    {0x11305, 0x1130C}, {0x11313, 0x11328}, {0x1132A, 0x11330}, {0x11335, 0x11339},
    {0x1135D, 0x11361}, {0x11400, 0x11434}, {0x11447, 0x1144A}, {0x1145F, 0x11461},
    {0x11480, 0x114AF}, {0x11580, 0x115AE}, {0x115D8, 0x115DB}, {0x11600, 0x1162F},
    {0x11680, 0x116AA}, {0x11700, 0x1171A}, {0x11740, 0x11746}, {0x11800, 0x1182B},
    {0x118A0, 0x118DF}, {0x118FF, 0x11906}, {0x1190C, 0x11913}, {0x11918, 0x1192F},
    {0x119A0, 0x119A7}, {0x119AA, 0x119D0}, {0x11A0B, 0x11A32}, {0x11A5C, 0x11A89},
    {0x11AB0, 0x11AF8}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C2E}, {0x11C72, 0x11C8F},
    {0x11D00, 0x11D06}, {0x11D0B, 0x11D30}, {0x11D60, 0x11D65}, {0x11D6A, 0x11D89},
    {0x11EE0, 0x11EF2}, {0x11F04, 0x11F10}, {0x11F12, 0x11F33}, {0x12000, 0x12399},
    {0x12480, 0x12543}, {0x12F90, 0x12FF0}, {0x13000, 0x1342F}, {0x13441, 0x13446},
    {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E}, {0x16A70, 0x16ABE},
    {0x16AD0, 0x16AED}, {0x16B00, 0x16B2F}, {0x16B40, 0x16B43}, {0x16B63, 0x16B77},
    {0x16B7D, 0x16B8F}, {0x16E40, 0x16E7F}, {0x16F00, 0x16F4A}, {0x16F93, 0x16F9F},
    {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08}, {0x1B000, 0x1B11E},
    {0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB}, {0x1BC00, 0x1BC6A},
    {0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99}, {0x1D400, 0x1D454},
    {0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3},
    {0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C},
    {0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550},
    {0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D6C0}, {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6FA},
    {0x1D6FC, 0x1D714}, {0x1D716, 0x1D734}, {0x1D736, 0x1D74E}, {0x1D750, 0x1D76E},
    {0x1D770, 0x1D788}, {0x1D78A, 0x1D7A8}, {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7CB},
    {0x1E100, 0x1E12C}, {0x1E137, 0x1E13D}, {0x1E2C0, 0x1E2EB}, {0x1E800, 0x1E8C4},
    {0x1E900, 0x1E943}, {0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32},
    {0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72},
    {0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B},
    {0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x20000, 0x2A6DD},
    {0x2A700, 0x2B734}, {0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0},
    {0x2F800, 0x2FA1D}, {0x30000, 0x3134A}
    {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08}, {0x1AFF0, 0x1AFF3},
    {0x1AFF5, 0x1AFFB}, {0x1B000, 0x1B122}, {0x1B150, 0x1B152}, {0x1B164, 0x1B167},
    {0x1B170, 0x1B2FB}, {0x1BC00, 0x1BC6A}, {0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88},
    {0x1BC90, 0x1BC99}, {0x1D400, 0x1D454}, {0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC},
    {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A},
    {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E},
    {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, {0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D6C0},
    {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6FA}, {0x1D6FC, 0x1D714}, {0x1D716, 0x1D734},
    {0x1D736, 0x1D74E}, {0x1D750, 0x1D76E}, {0x1D770, 0x1D788}, {0x1D78A, 0x1D7A8},
    {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7CB}, {0x1DF00, 0x1DF1E}, {0x1DF25, 0x1DF2A},
    {0x1E030, 0x1E06D}, {0x1E100, 0x1E12C}, {0x1E137, 0x1E13D}, {0x1E290, 0x1E2AD},
    {0x1E2C0, 0x1E2EB}, {0x1E4D0, 0x1E4EB}, {0x1E7E0, 0x1E7E6}, {0x1E7E8, 0x1E7EB},
    {0x1E7F0, 0x1E7FE}, {0x1E800, 0x1E8C4}, {0x1E900, 0x1E943}, {0x1EE00, 0x1EE03},
    {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32}, {0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F},
    {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72}, {0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C},
    {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B}, {0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9},
    {0x1EEAB, 0x1EEBB}, {0x20000, 0x2A6DF}, {0x2A700, 0x2B739}, {0x2B740, 0x2B81D},
    {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0}, {0x2F800, 0x2FA1D}, {0x30000, 0x3134A},
    {0x31350, 0x323AF}
#endif
};

#define NUM_ALPHA_RANGE (sizeof(alphaRangeTable)/sizeof(crange))

static const chr alphaCharTable[] = {
    0xAA, 0xB5, 0xBA, 0x2EC, 0x2EE, 0x376, 0x377, 0x37F, 0x386,
    0x38C, 0x559, 0x66E, 0x66F, 0x6D5, 0x6E5, 0x6E6, 0x6EE, 0x6EF,
    0x6FF, 0x710, 0x7B1, 0x7F4, 0x7F5, 0x7FA, 0x81A, 0x824, 0x828,
    0x93D, 0x950, 0x98F, 0x990, 0x9B2, 0x9BD, 0x9CE, 0x9DC, 0x9DD,
    0x9F0, 0x9F1, 0x9FC, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36,
    0xA38, 0xA39, 0xA5E, 0xAB2, 0xAB3, 0xABD, 0xAD0, 0xAE0, 0xAE1,
    0xAF9, 0xB0F, 0xB10, 0xB32, 0xB33, 0xB3D, 0xB5C, 0xB5D, 0xB71,
    0xB83, 0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0,
    0xC3D, 0xC60, 0xC61, 0xC80, 0xCBD, 0xCDE, 0xCE0, 0xCE1, 0xCF1,
    0xCF2, 0xD3D, 0xD4E, 0xDBD, 0xE32, 0xE33, 0xE81, 0xE82, 0xE84,
    0xEA5, 0xEB2, 0xEB3, 0xEBD, 0xEC6, 0xF00, 0x103F, 0x1061, 0x1065,
    0x1066, 0x108E, 0x10C7, 0x10CD, 0x1258, 0x12C0, 0x17D7, 0x17DC, 0x18AA,
    0x1AA7, 0x1BAE, 0x1BAF, 0x1CF5, 0x1CF6, 0x1CFA, 0x1F59, 0x1F5B, 0x1F5D,
    0x1FBE, 0x2071, 0x207F, 0x2102, 0x2107, 0x2115, 0x2124, 0x2126, 0x2128,
    0x214E, 0x2183, 0x2184, 0x2CF2, 0x2CF3, 0x2D27, 0x2D2D, 0x2D6F, 0x2E2F,
    0x3005, 0x3006, 0x303B, 0x303C, 0xA62A, 0xA62B, 0xA8FB, 0xA8FD, 0xA8FE,
    0xA9CF, 0xAA7A, 0xAAB1, 0xAAB5, 0xAAB6, 0xAAC0, 0xAAC2, 0xFB1D, 0xFB3E,
    0xFB40, 0xFB41, 0xFB43, 0xFB44
    0xC3D, 0xC5D, 0xC60, 0xC61, 0xC80, 0xCBD, 0xCDD, 0xCDE, 0xCE0,
    0xCE1, 0xCF1, 0xCF2, 0xD3D, 0xD4E, 0xDBD, 0xE32, 0xE33, 0xE81,
    0xE82, 0xE84, 0xEA5, 0xEB2, 0xEB3, 0xEBD, 0xEC6, 0xF00, 0x103F,
    0x1061, 0x1065, 0x1066, 0x108E, 0x10C7, 0x10CD, 0x1258, 0x12C0, 0x17D7,
    0x17DC, 0x18AA, 0x1AA7, 0x1BAE, 0x1BAF, 0x1CF5, 0x1CF6, 0x1CFA, 0x1F59,
    0x1F5B, 0x1F5D, 0x1FBE, 0x2071, 0x207F, 0x2102, 0x2107, 0x2115, 0x2124,
    0x2126, 0x2128, 0x214E, 0x2183, 0x2184, 0x2CF2, 0x2CF3, 0x2D27, 0x2D2D,
    0x2D6F, 0x2E2F, 0x3005, 0x3006, 0x303B, 0x303C, 0xA62A, 0xA62B, 0xA7D0,
    0xA7D1, 0xA7D3, 0xA8FB, 0xA8FD, 0xA8FE, 0xA9CF, 0xAA7A, 0xAAB1, 0xAAB5,
    0xAAB6, 0xAAC0, 0xAAC2, 0xFB1D, 0xFB3E, 0xFB40, 0xFB41, 0xFB43, 0xFB44
#if CHRBITS > 16
    ,0x1003C, 0x1003D, 0x10594, 0x10595, 0x105BB, 0x105BC, 0x10808, 0x10837, 0x10838,
    ,0x1003C, 0x1003D, 0x10808, 0x10837, 0x10838, 0x1083C, 0x108F4, 0x108F5, 0x109BE,
    0x109BF, 0x10A00, 0x10EB0, 0x10EB1, 0x10F27, 0x11144, 0x11147, 0x11176, 0x111DA,
    0x111DC, 0x11288, 0x1130F, 0x11310, 0x11332, 0x11333, 0x1133D, 0x11350, 0x114C4,
    0x1083C, 0x108F4, 0x108F5, 0x109BE, 0x109BF, 0x10A00, 0x10EB0, 0x10EB1, 0x10F27,
    0x11071, 0x11072, 0x11075, 0x11144, 0x11147, 0x11176, 0x111DA, 0x111DC, 0x1123F,
    0x11240, 0x11288, 0x1130F, 0x11310, 0x11332, 0x11333, 0x1133D, 0x11350, 0x114C4,
    0x114C5, 0x114C7, 0x11644, 0x116B8, 0x11909, 0x11915, 0x11916, 0x1193F, 0x11941,
    0x119E1, 0x119E3, 0x11A00, 0x11A3A, 0x11A50, 0x11A9D, 0x11C40, 0x11D08, 0x11D09,
    0x11D46, 0x11D67, 0x11D68, 0x11D98, 0x11FB0, 0x16F50, 0x16FE0, 0x16FE1, 0x16FE3,
    0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E14E, 0x1E94B,
    0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42, 0x1EE47, 0x1EE49,
    0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B, 0x1EE5D, 0x1EE5F,
    0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E
    0x11D46, 0x11D67, 0x11D68, 0x11D98, 0x11F02, 0x11FB0, 0x16F50, 0x16FE0, 0x16FE1,
    0x16FE3, 0x1AFFD, 0x1AFFE, 0x1B132, 0x1B155, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5,
    0x1D4A6, 0x1D4BB, 0x1D546, 0x1E14E, 0x1E7ED, 0x1E7EE, 0x1E94B, 0x1EE21, 0x1EE22,
    0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42, 0x1EE47, 0x1EE49, 0x1EE4B, 0x1EE51,
    0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B, 0x1EE5D, 0x1EE5F, 0x1EE61, 0x1EE62,
    0x1EE64, 0x1EE7E
#endif
};

#define NUM_ALPHA_CHAR (sizeof(alphaCharTable)/sizeof(chr))

/*
 * Unicode: control characters.
 */

static const crange controlRangeTable[] = {
    {0x0, 0x1F}, {0x7F, 0x9F}, {0x600, 0x605}, {0x200B, 0x200F},
    {0x202A, 0x202E}, {0x2060, 0x2064}, {0x2066, 0x206F}, {0xE000, 0xF8FF},
    {0xFFF9, 0xFFFB}
#if CHRBITS > 16
    ,{0x13430, 0x13438}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F},
    ,{0x13430, 0x1343F}, {0x1BCA0, 0x1BCA3}, {0x1D173, 0x1D17A}, {0xE0020, 0xE007F},
    {0xF0000, 0xFFFFD}, {0x100000, 0x10FFFD}
#endif
};

#define NUM_CONTROL_RANGE (sizeof(controlRangeTable)/sizeof(crange))

static const chr controlCharTable[] = {
    0xAD, 0x61C, 0x6DD, 0x70F, 0x8E2, 0x180E, 0xFEFF
    0xAD, 0x61C, 0x6DD, 0x70F, 0x890, 0x891, 0x8E2, 0x180E, 0xFEFF
#if CHRBITS > 16
    ,0x110BD, 0x110CD, 0xE0001
#endif
};

#define NUM_CONTROL_CHAR (sizeof(controlCharTable)/sizeof(chr))

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
450
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463







+
-
-
+
+















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


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









-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+



-
-
+
+
+
















-
+




















-
+



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







    {0xA9D0, 0xA9D9}, {0xA9F0, 0xA9F9}, {0xAA50, 0xAA59}, {0xABF0, 0xABF9},
    {0xFF10, 0xFF19}
#if CHRBITS > 16
    ,{0x104A0, 0x104A9}, {0x10D30, 0x10D39}, {0x11066, 0x1106F}, {0x110F0, 0x110F9},
    {0x11136, 0x1113F}, {0x111D0, 0x111D9}, {0x112F0, 0x112F9}, {0x11450, 0x11459},
    {0x114D0, 0x114D9}, {0x11650, 0x11659}, {0x116C0, 0x116C9}, {0x11730, 0x11739},
    {0x118E0, 0x118E9}, {0x11950, 0x11959}, {0x11C50, 0x11C59}, {0x11D50, 0x11D59},
    {0x11DA0, 0x11DA9}, {0x11F50, 0x11F59}, {0x16A60, 0x16A69}, {0x16AC0, 0x16AC9},
    {0x11DA0, 0x11DA9}, {0x16A60, 0x16A69}, {0x16B50, 0x16B59}, {0x1D7CE, 0x1D7FF},
    {0x1E140, 0x1E149}, {0x1E2F0, 0x1E2F9}, {0x1E950, 0x1E959}, {0x1FBF0, 0x1FBF9}
    {0x16B50, 0x16B59}, {0x1D7CE, 0x1D7FF}, {0x1E140, 0x1E149}, {0x1E2F0, 0x1E2F9},
    {0x1E4F0, 0x1E4F9}, {0x1E950, 0x1E959}, {0x1FBF0, 0x1FBF9}
#endif
};

#define NUM_DIGIT_RANGE (sizeof(digitRangeTable)/sizeof(crange))

/*
 * no singletons of digit characters.
 */

/*
 * Unicode: punctuation characters.
 */

static const crange punctRangeTable[] = {
    {0x21, 0x23}, {0x25, 0x2A}, {0x2C, 0x2F}, {0x5B, 0x5D},
    {0x55A, 0x55F}, {0x66A, 0x66D}, {0x700, 0x70D}, {0x7F7, 0x7F9},
    {0x830, 0x83E}, {0xF04, 0xF12}, {0xF3A, 0xF3D}, {0xFD0, 0xFD4},
    {0x104A, 0x104F}, {0x1360, 0x1368}, {0x16EB, 0x16ED}, {0x17D4, 0x17D6},
    {0x17D8, 0x17DA}, {0x1800, 0x180A}, {0x1AA0, 0x1AA6}, {0x1AA8, 0x1AAD},
    {0x1B5A, 0x1B60}, {0x1BFC, 0x1BFF}, {0x1C3B, 0x1C3F}, {0x1CC0, 0x1CC7},
    {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051}, {0x2053, 0x205E},
    {0x2308, 0x230B}, {0x2768, 0x2775}, {0x27E6, 0x27EF}, {0x2983, 0x2998},
    {0x29D8, 0x29DB}, {0x2CF9, 0x2CFC}, {0x2E00, 0x2E2E}, {0x2E30, 0x2E4F},
    {0x3001, 0x3003}, {0x3008, 0x3011}, {0x3014, 0x301F}, {0xA60D, 0xA60F},
    {0xA6F2, 0xA6F7}, {0xA874, 0xA877}, {0xA8F8, 0xA8FA}, {0xA9C1, 0xA9CD},
    {0xAA5C, 0xAA5F}, {0xFE10, 0xFE19}, {0xFE30, 0xFE52}, {0xFE54, 0xFE61},
    {0xFF01, 0xFF03}, {0xFF05, 0xFF0A}, {0xFF0C, 0xFF0F}, {0xFF3B, 0xFF3D},
    {0xFF5F, 0xFF65}
    {0x55A, 0x55F}, {0x61D, 0x61F}, {0x66A, 0x66D}, {0x700, 0x70D},
    {0x7F7, 0x7F9}, {0x830, 0x83E}, {0xF04, 0xF12}, {0xF3A, 0xF3D},
    {0xFD0, 0xFD4}, {0x104A, 0x104F}, {0x1360, 0x1368}, {0x16EB, 0x16ED},
    {0x17D4, 0x17D6}, {0x17D8, 0x17DA}, {0x1800, 0x180A}, {0x1AA0, 0x1AA6},
    {0x1AA8, 0x1AAD}, {0x1B5A, 0x1B60}, {0x1BFC, 0x1BFF}, {0x1C3B, 0x1C3F},
    {0x1CC0, 0x1CC7}, {0x2010, 0x2027}, {0x2030, 0x2043}, {0x2045, 0x2051},
    {0x2053, 0x205E}, {0x2308, 0x230B}, {0x2768, 0x2775}, {0x27E6, 0x27EF},
    {0x2983, 0x2998}, {0x29D8, 0x29DB}, {0x2CF9, 0x2CFC}, {0x2E00, 0x2E2E},
    {0x2E30, 0x2E4F}, {0x2E52, 0x2E5D}, {0x3001, 0x3003}, {0x3008, 0x3011},
    {0x3014, 0x301F}, {0xA60D, 0xA60F}, {0xA6F2, 0xA6F7}, {0xA874, 0xA877},
    {0xA8F8, 0xA8FA}, {0xA9C1, 0xA9CD}, {0xAA5C, 0xAA5F}, {0xFE10, 0xFE19},
    {0xFE30, 0xFE52}, {0xFE54, 0xFE61}, {0xFF01, 0xFF03}, {0xFF05, 0xFF0A},
    {0xFF0C, 0xFF0F}, {0xFF3B, 0xFF3D}, {0xFF5F, 0xFF65}
#if CHRBITS > 16
    ,{0x10100, 0x10102}, {0x10A50, 0x10A58}, {0x10AF0, 0x10AF6}, {0x10B39, 0x10B3F},
    {0x10B99, 0x10B9C}, {0x10F55, 0x10F59}, {0x11047, 0x1104D}, {0x110BE, 0x110C1},
    {0x11140, 0x11143}, {0x111C5, 0x111C8}, {0x111DD, 0x111DF}, {0x11238, 0x1123D},
    {0x1144B, 0x1144F}, {0x115C1, 0x115D7}, {0x11641, 0x11643}, {0x11660, 0x1166C},
    {0x1173C, 0x1173E}, {0x11944, 0x11946}, {0x11A3F, 0x11A46}, {0x11A9A, 0x11A9C},
    {0x11A9E, 0x11AA2}, {0x11C41, 0x11C45}, {0x12470, 0x12474}, {0x16B37, 0x16B3B},
    {0x16E97, 0x16E9A}, {0x1DA87, 0x1DA8B}
    {0x10B99, 0x10B9C}, {0x10F55, 0x10F59}, {0x10F86, 0x10F89}, {0x11047, 0x1104D},
    {0x110BE, 0x110C1}, {0x11140, 0x11143}, {0x111C5, 0x111C8}, {0x111DD, 0x111DF},
    {0x11238, 0x1123D}, {0x1144B, 0x1144F}, {0x115C1, 0x115D7}, {0x11641, 0x11643},
    {0x11660, 0x1166C}, {0x1173C, 0x1173E}, {0x11944, 0x11946}, {0x11A3F, 0x11A46},
    {0x11A9A, 0x11A9C}, {0x11A9E, 0x11AA2}, {0x11B00, 0x11B09}, {0x11C41, 0x11C45},
    {0x11F43, 0x11F4F}, {0x12470, 0x12474}, {0x16B37, 0x16B3B}, {0x16E97, 0x16E9A},
    {0x1DA87, 0x1DA8B}
#endif
};

#define NUM_PUNCT_RANGE (sizeof(punctRangeTable)/sizeof(crange))

static const chr punctCharTable[] = {
    0x3A, 0x3B, 0x3F, 0x40, 0x5F, 0x7B, 0x7D, 0xA1, 0xA7,
    0xAB, 0xB6, 0xB7, 0xBB, 0xBF, 0x37E, 0x387, 0x589, 0x58A,
    0x5BE, 0x5C0, 0x5C3, 0x5C6, 0x5F3, 0x5F4, 0x609, 0x60A, 0x60C,
    0x60D, 0x61B, 0x61E, 0x61F, 0x6D4, 0x85E, 0x964, 0x965, 0x970,
    0x9FD, 0xA76, 0xAF0, 0xC77, 0xC84, 0xDF4, 0xE4F, 0xE5A, 0xE5B,
    0xF14, 0xF85, 0xFD9, 0xFDA, 0x10FB, 0x1400, 0x166E, 0x169B, 0x169C,
    0x1735, 0x1736, 0x1944, 0x1945, 0x1A1E, 0x1A1F, 0x1C7E, 0x1C7F, 0x1CD3,
    0x60D, 0x61B, 0x6D4, 0x85E, 0x964, 0x965, 0x970, 0x9FD, 0xA76,
    0xAF0, 0xC77, 0xC84, 0xDF4, 0xE4F, 0xE5A, 0xE5B, 0xF14, 0xF85,
    0xFD9, 0xFDA, 0x10FB, 0x1400, 0x166E, 0x169B, 0x169C, 0x1735, 0x1736,
    0x1944, 0x1945, 0x1A1E, 0x1A1F, 0x1B7D, 0x1B7E, 0x1C7E, 0x1C7F, 0x1CD3,
    0x207D, 0x207E, 0x208D, 0x208E, 0x2329, 0x232A, 0x27C5, 0x27C6, 0x29FC,
    0x29FD, 0x2CFE, 0x2CFF, 0x2D70, 0x2E52, 0x3030, 0x303D, 0x30A0, 0x30FB,
    0xA4FE, 0xA4FF, 0xA673, 0xA67E, 0xA8CE, 0xA8CF, 0xA8FC, 0xA92E, 0xA92F,
    0xA95F, 0xA9DE, 0xA9DF, 0xAADE, 0xAADF, 0xAAF0, 0xAAF1, 0xABEB, 0xFD3E,
    0xFD3F, 0xFE63, 0xFE68, 0xFE6A, 0xFE6B, 0xFF1A, 0xFF1B, 0xFF1F, 0xFF20,
    0xFF3F, 0xFF5B, 0xFF5D
    0x29FD, 0x2CFE, 0x2CFF, 0x2D70, 0x3030, 0x303D, 0x30A0, 0x30FB, 0xA4FE,
    0xA4FF, 0xA673, 0xA67E, 0xA8CE, 0xA8CF, 0xA8FC, 0xA92E, 0xA92F, 0xA95F,
    0xA9DE, 0xA9DF, 0xAADE, 0xAADF, 0xAAF0, 0xAAF1, 0xABEB, 0xFD3E, 0xFD3F,
    0xFE63, 0xFE68, 0xFE6A, 0xFE6B, 0xFF1A, 0xFF1B, 0xFF1F, 0xFF20, 0xFF3F,
    0xFF5B, 0xFF5D
#if CHRBITS > 16
    ,0x1039F, 0x103D0, 0x1056F, 0x10857, 0x1091F, 0x1093F, 0x10A7F, 0x10EAD, 0x110BB,
    0x110BC, 0x11174, 0x11175, 0x111CD, 0x111DB, 0x112A9, 0x1145A, 0x1145B, 0x1145D,
    0x114C6, 0x1183B, 0x119E2, 0x11C70, 0x11C71, 0x11EF7, 0x11EF8, 0x11FFF, 0x16A6E,
    0x16A6F, 0x16AF5, 0x16B44, 0x16FE2, 0x1BC9F, 0x1E95E, 0x1E95F
    0x114C6, 0x116B9, 0x1183B, 0x119E2, 0x11C70, 0x11C71, 0x11EF7, 0x11EF8, 0x11FFF,
    0x12FF1, 0x12FF2, 0x16A6E, 0x16A6F, 0x16AF5, 0x16B44, 0x16FE2, 0x1BC9F, 0x1E95E,
    0x1E95F
#endif
};

#define NUM_PUNCT_CHAR (sizeof(punctCharTable)/sizeof(chr))

/*
 * Unicode: white space characters.
 */

static const crange spaceRangeTable[] = {
    {0x9, 0xD}, {0x2000, 0x200B}
};

#define NUM_SPACE_RANGE (sizeof(spaceRangeTable)/sizeof(crange))

static const chr spaceCharTable[] = {
    0x20, 0x85, 0xA0, 0x1680, 0x180E, 0x2028, 0x2029, 0x202F, 0x205F,
    0x20, 0xA0, 0x1680, 0x180E, 0x2028, 0x2029, 0x202F, 0x205F,
    0x2060, 0x3000, 0xFEFF
};

#define NUM_SPACE_CHAR (sizeof(spaceCharTable)/sizeof(chr))

/*
 * Unicode: lowercase characters.
 */

static const crange lowerRangeTable[] = {
    {0x61, 0x7A}, {0xDF, 0xF6}, {0xF8, 0xFF}, {0x17E, 0x180},
    {0x199, 0x19B}, {0x1BD, 0x1BF}, {0x233, 0x239}, {0x24F, 0x293},
    {0x295, 0x2AF}, {0x37B, 0x37D}, {0x3AC, 0x3CE}, {0x3D5, 0x3D7},
    {0x3EF, 0x3F3}, {0x430, 0x45F}, {0x560, 0x588}, {0x10D0, 0x10FA},
    {0x10FD, 0x10FF}, {0x13F8, 0x13FD}, {0x1C80, 0x1C88}, {0x1D00, 0x1D2B},
    {0x1D6B, 0x1D77}, {0x1D79, 0x1D9A}, {0x1E95, 0x1E9D}, {0x1EFF, 0x1F07},
    {0x1F10, 0x1F15}, {0x1F20, 0x1F27}, {0x1F30, 0x1F37}, {0x1F40, 0x1F45},
    {0x1F50, 0x1F57}, {0x1F60, 0x1F67}, {0x1F70, 0x1F7D}, {0x1F80, 0x1F87},
    {0x1F90, 0x1F97}, {0x1FA0, 0x1FA7}, {0x1FB0, 0x1FB4}, {0x1FC2, 0x1FC4},
    {0x1FD0, 0x1FD3}, {0x1FE0, 0x1FE7}, {0x1FF2, 0x1FF4}, {0x2146, 0x2149},
    {0x2C30, 0x2C5E}, {0x2C76, 0x2C7B}, {0x2D00, 0x2D25}, {0xA72F, 0xA731},
    {0x2C30, 0x2C5F}, {0x2C76, 0x2C7B}, {0x2D00, 0x2D25}, {0xA72F, 0xA731},
    {0xA771, 0xA778}, {0xA793, 0xA795}, {0xAB30, 0xAB5A}, {0xAB60, 0xAB68},
    {0xAB70, 0xABBF}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17}, {0xFF41, 0xFF5A}
#if CHRBITS > 16
    ,{0x10428, 0x1044F}, {0x104D8, 0x104FB}, {0x10CC0, 0x10CF2}, {0x118C0, 0x118DF},
    {0x16E60, 0x16E7F}, {0x1D41A, 0x1D433}, {0x1D44E, 0x1D454}, {0x1D456, 0x1D467},
    {0x1D482, 0x1D49B}, {0x1D4B6, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D4CF},
    {0x1D4EA, 0x1D503}, {0x1D51E, 0x1D537}, {0x1D552, 0x1D56B}, {0x1D586, 0x1D59F},
    {0x1D5BA, 0x1D5D3}, {0x1D5EE, 0x1D607}, {0x1D622, 0x1D63B}, {0x1D656, 0x1D66F},
    {0x1D68A, 0x1D6A5}, {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6E1}, {0x1D6FC, 0x1D714},
    {0x1D716, 0x1D71B}, {0x1D736, 0x1D74E}, {0x1D750, 0x1D755}, {0x1D770, 0x1D788},
    {0x1D78A, 0x1D78F}, {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7C9}, {0x1E922, 0x1E943}
    ,{0x10428, 0x1044F}, {0x104D8, 0x104FB}, {0x10597, 0x105A1}, {0x105A3, 0x105B1},
    {0x105B3, 0x105B9}, {0x10CC0, 0x10CF2}, {0x118C0, 0x118DF}, {0x16E60, 0x16E7F},
    {0x1D41A, 0x1D433}, {0x1D44E, 0x1D454}, {0x1D456, 0x1D467}, {0x1D482, 0x1D49B},
    {0x1D4B6, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D4CF}, {0x1D4EA, 0x1D503},
    {0x1D51E, 0x1D537}, {0x1D552, 0x1D56B}, {0x1D586, 0x1D59F}, {0x1D5BA, 0x1D5D3},
    {0x1D5EE, 0x1D607}, {0x1D622, 0x1D63B}, {0x1D656, 0x1D66F}, {0x1D68A, 0x1D6A5},
    {0x1D6C2, 0x1D6DA}, {0x1D6DC, 0x1D6E1}, {0x1D6FC, 0x1D714}, {0x1D716, 0x1D71B},
    {0x1D736, 0x1D74E}, {0x1D750, 0x1D755}, {0x1D770, 0x1D788}, {0x1D78A, 0x1D78F},
    {0x1D7AA, 0x1D7C2}, {0x1D7C4, 0x1D7C9}, {0x1DF00, 0x1DF09}, {0x1DF0B, 0x1DF1E},
    {0x1DF25, 0x1DF2A}, {0x1E922, 0x1E943}
#endif
};

#define NUM_LOWER_RANGE (sizeof(lowerRangeTable)/sizeof(crange))

static const chr lowerCharTable[] = {
    0xB5, 0x101, 0x103, 0x105, 0x107, 0x109, 0x10B, 0x10D, 0x10F,
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
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







-
-
+
+

-
+


















-
+



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







    0xA691, 0xA693, 0xA695, 0xA697, 0xA699, 0xA69B, 0xA723, 0xA725, 0xA727,
    0xA729, 0xA72B, 0xA72D, 0xA733, 0xA735, 0xA737, 0xA739, 0xA73B, 0xA73D,
    0xA73F, 0xA741, 0xA743, 0xA745, 0xA747, 0xA749, 0xA74B, 0xA74D, 0xA74F,
    0xA751, 0xA753, 0xA755, 0xA757, 0xA759, 0xA75B, 0xA75D, 0xA75F, 0xA761,
    0xA763, 0xA765, 0xA767, 0xA769, 0xA76B, 0xA76D, 0xA76F, 0xA77A, 0xA77C,
    0xA77F, 0xA781, 0xA783, 0xA785, 0xA787, 0xA78C, 0xA78E, 0xA791, 0xA797,
    0xA799, 0xA79B, 0xA79D, 0xA79F, 0xA7A1, 0xA7A3, 0xA7A5, 0xA7A7, 0xA7A9,
    0xA7AF, 0xA7B5, 0xA7B7, 0xA7B9, 0xA7BB, 0xA7BD, 0xA7BF, 0xA7C3, 0xA7C8,
    0xA7CA, 0xA7F6, 0xA7FA
    0xA7AF, 0xA7B5, 0xA7B7, 0xA7B9, 0xA7BB, 0xA7BD, 0xA7BF, 0xA7C1, 0xA7C3,
    0xA7C8, 0xA7CA, 0xA7D1, 0xA7D3, 0xA7D5, 0xA7D7, 0xA7D9, 0xA7F6, 0xA7FA
#if CHRBITS > 16
    ,0x1D4BB, 0x1D7CB
    ,0x105BB, 0x105BC, 0x1D4BB, 0x1D7CB
#endif
};

#define NUM_LOWER_CHAR (sizeof(lowerCharTable)/sizeof(chr))

/*
 * Unicode: uppercase characters.
 */

static const crange upperRangeTable[] = {
    {0x41, 0x5A}, {0xC0, 0xD6}, {0xD8, 0xDE}, {0x189, 0x18B},
    {0x18E, 0x191}, {0x196, 0x198}, {0x1B1, 0x1B3}, {0x1F6, 0x1F8},
    {0x243, 0x246}, {0x388, 0x38A}, {0x391, 0x3A1}, {0x3A3, 0x3AB},
    {0x3D2, 0x3D4}, {0x3FD, 0x42F}, {0x531, 0x556}, {0x10A0, 0x10C5},
    {0x13A0, 0x13F5}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CBF}, {0x1F08, 0x1F0F},
    {0x1F18, 0x1F1D}, {0x1F28, 0x1F2F}, {0x1F38, 0x1F3F}, {0x1F48, 0x1F4D},
    {0x1F68, 0x1F6F}, {0x1FB8, 0x1FBB}, {0x1FC8, 0x1FCB}, {0x1FD8, 0x1FDB},
    {0x1FE8, 0x1FEC}, {0x1FF8, 0x1FFB}, {0x210B, 0x210D}, {0x2110, 0x2112},
    {0x2119, 0x211D}, {0x212A, 0x212D}, {0x2130, 0x2133}, {0x2C00, 0x2C2E},
    {0x2119, 0x211D}, {0x212A, 0x212D}, {0x2130, 0x2133}, {0x2C00, 0x2C2F},
    {0x2C62, 0x2C64}, {0x2C6D, 0x2C70}, {0x2C7E, 0x2C80}, {0xA7AA, 0xA7AE},
    {0xA7B0, 0xA7B4}, {0xA7C4, 0xA7C7}, {0xFF21, 0xFF3A}
#if CHRBITS > 16
    ,{0x10400, 0x10427}, {0x104B0, 0x104D3}, {0x10C80, 0x10CB2}, {0x118A0, 0x118BF},
    {0x16E40, 0x16E5F}, {0x1D400, 0x1D419}, {0x1D434, 0x1D44D}, {0x1D468, 0x1D481},
    {0x1D4A9, 0x1D4AC}, {0x1D4AE, 0x1D4B5}, {0x1D4D0, 0x1D4E9}, {0x1D507, 0x1D50A},
    {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544},
    {0x1D54A, 0x1D550}, {0x1D56C, 0x1D585}, {0x1D5A0, 0x1D5B9}, {0x1D5D4, 0x1D5ED},
    {0x1D608, 0x1D621}, {0x1D63C, 0x1D655}, {0x1D670, 0x1D689}, {0x1D6A8, 0x1D6C0},
    {0x1D6E2, 0x1D6FA}, {0x1D71C, 0x1D734}, {0x1D756, 0x1D76E}, {0x1D790, 0x1D7A8},
    ,{0x10400, 0x10427}, {0x104B0, 0x104D3}, {0x10570, 0x1057A}, {0x1057C, 0x1058A},
    {0x1058C, 0x10592}, {0x10C80, 0x10CB2}, {0x118A0, 0x118BF}, {0x16E40, 0x16E5F},
    {0x1D400, 0x1D419}, {0x1D434, 0x1D44D}, {0x1D468, 0x1D481}, {0x1D4A9, 0x1D4AC},
    {0x1D4AE, 0x1D4B5}, {0x1D4D0, 0x1D4E9}, {0x1D507, 0x1D50A}, {0x1D50D, 0x1D514},
    {0x1D516, 0x1D51C}, {0x1D53B, 0x1D53E}, {0x1D540, 0x1D544}, {0x1D54A, 0x1D550},
    {0x1D56C, 0x1D585}, {0x1D5A0, 0x1D5B9}, {0x1D5D4, 0x1D5ED}, {0x1D608, 0x1D621},
    {0x1D63C, 0x1D655}, {0x1D670, 0x1D689}, {0x1D6A8, 0x1D6C0}, {0x1D6E2, 0x1D6FA},
    {0x1D71C, 0x1D734}, {0x1D756, 0x1D76E}, {0x1D790, 0x1D7A8}, {0x1E900, 0x1E921}
    {0x1E900, 0x1E921}
#endif
};

#define NUM_UPPER_RANGE (sizeof(upperRangeTable)/sizeof(crange))

static const chr upperCharTable[] = {
    0x100, 0x102, 0x104, 0x106, 0x108, 0x10A, 0x10C, 0x10E, 0x110,
609
610
611
612
613
614
615
616


617
618
619


620
621
622
623
624
625
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
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
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
622
623
624
625
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
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
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







-
+
+

-
-
+
+













-
+

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





-
+






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


-
+


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







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

+
-
-
+
+




-
-
-
+
+
+
+
+







-
-
+
+

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











-
+


-
-
+
+

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








+
+







    0xA698, 0xA69A, 0xA722, 0xA724, 0xA726, 0xA728, 0xA72A, 0xA72C, 0xA72E,
    0xA732, 0xA734, 0xA736, 0xA738, 0xA73A, 0xA73C, 0xA73E, 0xA740, 0xA742,
    0xA744, 0xA746, 0xA748, 0xA74A, 0xA74C, 0xA74E, 0xA750, 0xA752, 0xA754,
    0xA756, 0xA758, 0xA75A, 0xA75C, 0xA75E, 0xA760, 0xA762, 0xA764, 0xA766,
    0xA768, 0xA76A, 0xA76C, 0xA76E, 0xA779, 0xA77B, 0xA77D, 0xA77E, 0xA780,
    0xA782, 0xA784, 0xA786, 0xA78B, 0xA78D, 0xA790, 0xA792, 0xA796, 0xA798,
    0xA79A, 0xA79C, 0xA79E, 0xA7A0, 0xA7A2, 0xA7A4, 0xA7A6, 0xA7A8, 0xA7B6,
    0xA7B8, 0xA7BA, 0xA7BC, 0xA7BE, 0xA7C2, 0xA7C9, 0xA7F5
    0xA7B8, 0xA7BA, 0xA7BC, 0xA7BE, 0xA7C0, 0xA7C2, 0xA7C9, 0xA7D0, 0xA7D6,
    0xA7D8, 0xA7F5
#if CHRBITS > 16
    ,0x1D49C, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D504, 0x1D505, 0x1D538,
    0x1D539, 0x1D546, 0x1D7CA
    ,0x10594, 0x10595, 0x1D49C, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D504,
    0x1D505, 0x1D538, 0x1D539, 0x1D546, 0x1D7CA
#endif
};

#define NUM_UPPER_CHAR (sizeof(upperCharTable)/sizeof(chr))

/*
 * Unicode: unicode print characters excluding space.
 */

static const crange graphRangeTable[] = {
    {0x21, 0x7E}, {0xA1, 0xAC}, {0xAE, 0x377}, {0x37A, 0x37F},
    {0x384, 0x38A}, {0x38E, 0x3A1}, {0x3A3, 0x52F}, {0x531, 0x556},
    {0x559, 0x58A}, {0x58D, 0x58F}, {0x591, 0x5C7}, {0x5D0, 0x5EA},
    {0x5EF, 0x5F4}, {0x606, 0x61B}, {0x61E, 0x6DC}, {0x6DE, 0x70D},
    {0x5EF, 0x5F4}, {0x606, 0x61B}, {0x61D, 0x6DC}, {0x6DE, 0x70D},
    {0x710, 0x74A}, {0x74D, 0x7B1}, {0x7C0, 0x7FA}, {0x7FD, 0x82D},
    {0x830, 0x83E}, {0x840, 0x85B}, {0x860, 0x86A}, {0x8A0, 0x8B4},
    {0x8B6, 0x8C7}, {0x8D3, 0x8E1}, {0x8E3, 0x983}, {0x985, 0x98C},
    {0x993, 0x9A8}, {0x9AA, 0x9B0}, {0x9B6, 0x9B9}, {0x9BC, 0x9C4},
    {0x9CB, 0x9CE}, {0x9DF, 0x9E3}, {0x9E6, 0x9FE}, {0xA01, 0xA03},
    {0xA05, 0xA0A}, {0xA13, 0xA28}, {0xA2A, 0xA30}, {0xA3E, 0xA42},
    {0xA4B, 0xA4D}, {0xA59, 0xA5C}, {0xA66, 0xA76}, {0xA81, 0xA83},
    {0xA85, 0xA8D}, {0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0},
    {0xAB5, 0xAB9}, {0xABC, 0xAC5}, {0xAC7, 0xAC9}, {0xACB, 0xACD},
    {0xAE0, 0xAE3}, {0xAE6, 0xAF1}, {0xAF9, 0xAFF}, {0xB01, 0xB03},
    {0xB05, 0xB0C}, {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39},
    {0xB3C, 0xB44}, {0xB4B, 0xB4D}, {0xB55, 0xB57}, {0xB5F, 0xB63},
    {0xB66, 0xB77}, {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95},
    {0xBA8, 0xBAA}, {0xBAE, 0xBB9}, {0xBBE, 0xBC2}, {0xBC6, 0xBC8},
    {0xBCA, 0xBCD}, {0xBE6, 0xBFA}, {0xC00, 0xC0C}, {0xC0E, 0xC10},
    {0xC12, 0xC28}, {0xC2A, 0xC39}, {0xC3D, 0xC44}, {0xC46, 0xC48},
    {0xC4A, 0xC4D}, {0xC58, 0xC5A}, {0xC60, 0xC63}, {0xC66, 0xC6F},
    {0xC77, 0xC8C}, {0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3},
    {0xCB5, 0xCB9}, {0xCBC, 0xCC4}, {0xCC6, 0xCC8}, {0xCCA, 0xCCD},
    {0xCE0, 0xCE3}, {0xCE6, 0xCEF}, {0xD00, 0xD0C}, {0xD0E, 0xD10},
    {0x830, 0x83E}, {0x840, 0x85B}, {0x860, 0x86A}, {0x870, 0x88E},
    {0x898, 0x8E1}, {0x8E3, 0x983}, {0x985, 0x98C}, {0x993, 0x9A8},
    {0x9AA, 0x9B0}, {0x9B6, 0x9B9}, {0x9BC, 0x9C4}, {0x9CB, 0x9CE},
    {0x9DF, 0x9E3}, {0x9E6, 0x9FE}, {0xA01, 0xA03}, {0xA05, 0xA0A},
    {0xA13, 0xA28}, {0xA2A, 0xA30}, {0xA3E, 0xA42}, {0xA4B, 0xA4D},
    {0xA59, 0xA5C}, {0xA66, 0xA76}, {0xA81, 0xA83}, {0xA85, 0xA8D},
    {0xA8F, 0xA91}, {0xA93, 0xAA8}, {0xAAA, 0xAB0}, {0xAB5, 0xAB9},
    {0xABC, 0xAC5}, {0xAC7, 0xAC9}, {0xACB, 0xACD}, {0xAE0, 0xAE3},
    {0xAE6, 0xAF1}, {0xAF9, 0xAFF}, {0xB01, 0xB03}, {0xB05, 0xB0C},
    {0xB13, 0xB28}, {0xB2A, 0xB30}, {0xB35, 0xB39}, {0xB3C, 0xB44},
    {0xB4B, 0xB4D}, {0xB55, 0xB57}, {0xB5F, 0xB63}, {0xB66, 0xB77},
    {0xB85, 0xB8A}, {0xB8E, 0xB90}, {0xB92, 0xB95}, {0xBA8, 0xBAA},
    {0xBAE, 0xBB9}, {0xBBE, 0xBC2}, {0xBC6, 0xBC8}, {0xBCA, 0xBCD},
    {0xBE6, 0xBFA}, {0xC00, 0xC0C}, {0xC0E, 0xC10}, {0xC12, 0xC28},
    {0xC2A, 0xC39}, {0xC3C, 0xC44}, {0xC46, 0xC48}, {0xC4A, 0xC4D},
    {0xC58, 0xC5A}, {0xC60, 0xC63}, {0xC66, 0xC6F}, {0xC77, 0xC8C},
    {0xC8E, 0xC90}, {0xC92, 0xCA8}, {0xCAA, 0xCB3}, {0xCB5, 0xCB9},
    {0xCBC, 0xCC4}, {0xCC6, 0xCC8}, {0xCCA, 0xCCD}, {0xCE0, 0xCE3},
    {0xCE6, 0xCEF}, {0xCF1, 0xCF3}, {0xD00, 0xD0C}, {0xD0E, 0xD10},
    {0xD12, 0xD44}, {0xD46, 0xD48}, {0xD4A, 0xD4F}, {0xD54, 0xD63},
    {0xD66, 0xD7F}, {0xD81, 0xD83}, {0xD85, 0xD96}, {0xD9A, 0xDB1},
    {0xDB3, 0xDBB}, {0xDC0, 0xDC6}, {0xDCF, 0xDD4}, {0xDD8, 0xDDF},
    {0xDE6, 0xDEF}, {0xDF2, 0xDF4}, {0xE01, 0xE3A}, {0xE3F, 0xE5B},
    {0xE86, 0xE8A}, {0xE8C, 0xEA3}, {0xEA7, 0xEBD}, {0xEC0, 0xEC4},
    {0xEC8, 0xECD}, {0xED0, 0xED9}, {0xEDC, 0xEDF}, {0xF00, 0xF47},
    {0xEC8, 0xECE}, {0xED0, 0xED9}, {0xEDC, 0xEDF}, {0xF00, 0xF47},
    {0xF49, 0xF6C}, {0xF71, 0xF97}, {0xF99, 0xFBC}, {0xFBE, 0xFCC},
    {0xFCE, 0xFDA}, {0x1000, 0x10C5}, {0x10D0, 0x1248}, {0x124A, 0x124D},
    {0x1250, 0x1256}, {0x125A, 0x125D}, {0x1260, 0x1288}, {0x128A, 0x128D},
    {0x1290, 0x12B0}, {0x12B2, 0x12B5}, {0x12B8, 0x12BE}, {0x12C2, 0x12C5},
    {0x12C8, 0x12D6}, {0x12D8, 0x1310}, {0x1312, 0x1315}, {0x1318, 0x135A},
    {0x135D, 0x137C}, {0x1380, 0x1399}, {0x13A0, 0x13F5}, {0x13F8, 0x13FD},
    {0x1400, 0x167F}, {0x1681, 0x169C}, {0x16A0, 0x16F8}, {0x1700, 0x170C},
    {0x170E, 0x1714}, {0x1720, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176C},
    {0x176E, 0x1770}, {0x1780, 0x17DD}, {0x17E0, 0x17E9}, {0x17F0, 0x17F9},
    {0x1800, 0x180D}, {0x1810, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18AA},
    {0x18B0, 0x18F5}, {0x1900, 0x191E}, {0x1920, 0x192B}, {0x1930, 0x193B},
    {0x1944, 0x196D}, {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9},
    {0x19D0, 0x19DA}, {0x19DE, 0x1A1B}, {0x1A1E, 0x1A5E}, {0x1A60, 0x1A7C},
    {0x1A7F, 0x1A89}, {0x1A90, 0x1A99}, {0x1AA0, 0x1AAD}, {0x1AB0, 0x1AC0},
    {0x1B00, 0x1B4B}, {0x1B50, 0x1B7C}, {0x1B80, 0x1BF3}, {0x1BFC, 0x1C37},
    {0x1C3B, 0x1C49}, {0x1C4D, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CC7},
    {0x1400, 0x167F}, {0x1681, 0x169C}, {0x16A0, 0x16F8}, {0x1700, 0x1715},
    {0x171F, 0x1736}, {0x1740, 0x1753}, {0x1760, 0x176C}, {0x176E, 0x1770},
    {0x1780, 0x17DD}, {0x17E0, 0x17E9}, {0x17F0, 0x17F9}, {0x1800, 0x180D},
    {0x180F, 0x1819}, {0x1820, 0x1878}, {0x1880, 0x18AA}, {0x18B0, 0x18F5},
    {0x1900, 0x191E}, {0x1920, 0x192B}, {0x1930, 0x193B}, {0x1944, 0x196D},
    {0x1970, 0x1974}, {0x1980, 0x19AB}, {0x19B0, 0x19C9}, {0x19D0, 0x19DA},
    {0x19DE, 0x1A1B}, {0x1A1E, 0x1A5E}, {0x1A60, 0x1A7C}, {0x1A7F, 0x1A89},
    {0x1A90, 0x1A99}, {0x1AA0, 0x1AAD}, {0x1AB0, 0x1ACE}, {0x1B00, 0x1B4C},
    {0x1B50, 0x1B7E}, {0x1B80, 0x1BF3}, {0x1BFC, 0x1C37}, {0x1C3B, 0x1C49},
    {0x1C4D, 0x1C88}, {0x1C90, 0x1CBA}, {0x1CBD, 0x1CC7}, {0x1CD0, 0x1CFA},
    {0x1CD0, 0x1CFA}, {0x1D00, 0x1DF9}, {0x1DFB, 0x1F15}, {0x1F18, 0x1F1D},
    {0x1F20, 0x1F45}, {0x1F48, 0x1F4D}, {0x1F50, 0x1F57}, {0x1F5F, 0x1F7D},
    {0x1F80, 0x1FB4}, {0x1FB6, 0x1FC4}, {0x1FC6, 0x1FD3}, {0x1FD6, 0x1FDB},
    {0x1FDD, 0x1FEF}, {0x1FF2, 0x1FF4}, {0x1FF6, 0x1FFE}, {0x2010, 0x2027},
    {0x2030, 0x205E}, {0x2074, 0x208E}, {0x2090, 0x209C}, {0x20A0, 0x20BF},
    {0x20D0, 0x20F0}, {0x2100, 0x218B}, {0x2190, 0x2426}, {0x2440, 0x244A},
    {0x2460, 0x2B73}, {0x2B76, 0x2B95}, {0x2B97, 0x2C2E}, {0x2C30, 0x2C5E},
    {0x2C60, 0x2CF3}, {0x2CF9, 0x2D25}, {0x2D30, 0x2D67}, {0x2D7F, 0x2D96},
    {0x1D00, 0x1F15}, {0x1F18, 0x1F1D}, {0x1F20, 0x1F45}, {0x1F48, 0x1F4D},
    {0x1F50, 0x1F57}, {0x1F5F, 0x1F7D}, {0x1F80, 0x1FB4}, {0x1FB6, 0x1FC4},
    {0x1FC6, 0x1FD3}, {0x1FD6, 0x1FDB}, {0x1FDD, 0x1FEF}, {0x1FF2, 0x1FF4},
    {0x1FF6, 0x1FFE}, {0x2010, 0x2027}, {0x2030, 0x205E}, {0x2074, 0x208E},
    {0x2090, 0x209C}, {0x20A0, 0x20C0}, {0x20D0, 0x20F0}, {0x2100, 0x218B},
    {0x2190, 0x2426}, {0x2440, 0x244A}, {0x2460, 0x2B73}, {0x2B76, 0x2B95},
    {0x2B97, 0x2CF3}, {0x2CF9, 0x2D25}, {0x2D30, 0x2D67}, {0x2D7F, 0x2D96},
    {0x2DA0, 0x2DA6}, {0x2DA8, 0x2DAE}, {0x2DB0, 0x2DB6}, {0x2DB8, 0x2DBE},
    {0x2DC0, 0x2DC6}, {0x2DC8, 0x2DCE}, {0x2DD0, 0x2DD6}, {0x2DD8, 0x2DDE},
    {0x2DE0, 0x2E52}, {0x2E80, 0x2E99}, {0x2E9B, 0x2EF3}, {0x2F00, 0x2FD5},
    {0x2DE0, 0x2E5D}, {0x2E80, 0x2E99}, {0x2E9B, 0x2EF3}, {0x2F00, 0x2FD5},
    {0x2FF0, 0x2FFB}, {0x3001, 0x303F}, {0x3041, 0x3096}, {0x3099, 0x30FF},
    {0x3105, 0x312F}, {0x3131, 0x318E}, {0x3190, 0x31E3}, {0x31F0, 0x321E},
    {0x3220, 0x9FFC}, {0xA000, 0xA48C}, {0xA490, 0xA4C6}, {0xA4D0, 0xA62B},
    {0xA640, 0xA6F7}, {0xA700, 0xA7BF}, {0xA7C2, 0xA7CA}, {0xA7F5, 0xA82C},
    {0xA830, 0xA839}, {0xA840, 0xA877}, {0xA880, 0xA8C5}, {0xA8CE, 0xA8D9},
    {0xA8E0, 0xA953}, {0xA95F, 0xA97C}, {0xA980, 0xA9CD}, {0xA9CF, 0xA9D9},
    {0xA9DE, 0xA9FE}, {0xAA00, 0xAA36}, {0xAA40, 0xAA4D}, {0xAA50, 0xAA59},
    {0xAA5C, 0xAAC2}, {0xAADB, 0xAAF6}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E},
    {0xAB11, 0xAB16}, {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB6B},
    {0xAB70, 0xABED}, {0xABF0, 0xABF9}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6},
    {0xD7CB, 0xD7FB}, {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06},
    {0xFB13, 0xFB17}, {0xFB1D, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB46, 0xFBC1},
    {0x3220, 0xA48C}, {0xA490, 0xA4C6}, {0xA4D0, 0xA62B}, {0xA640, 0xA6F7},
    {0xA700, 0xA7CA}, {0xA7D5, 0xA7D9}, {0xA7F2, 0xA82C}, {0xA830, 0xA839},
    {0xA840, 0xA877}, {0xA880, 0xA8C5}, {0xA8CE, 0xA8D9}, {0xA8E0, 0xA953},
    {0xA95F, 0xA97C}, {0xA980, 0xA9CD}, {0xA9CF, 0xA9D9}, {0xA9DE, 0xA9FE},
    {0xAA00, 0xAA36}, {0xAA40, 0xAA4D}, {0xAA50, 0xAA59}, {0xAA5C, 0xAAC2},
    {0xAADB, 0xAAF6}, {0xAB01, 0xAB06}, {0xAB09, 0xAB0E}, {0xAB11, 0xAB16},
    {0xAB20, 0xAB26}, {0xAB28, 0xAB2E}, {0xAB30, 0xAB6B}, {0xAB70, 0xABED},
    {0xABF0, 0xABF9}, {0xAC00, 0xD7A3}, {0xD7B0, 0xD7C6}, {0xD7CB, 0xD7FB},
    {0xF900, 0xFA6D}, {0xFA70, 0xFAD9}, {0xFB00, 0xFB06}, {0xFB13, 0xFB17},
    {0xFB1D, 0xFB36}, {0xFB38, 0xFB3C}, {0xFB46, 0xFBC2}, {0xFBD3, 0xFD8F},
    {0xFBD3, 0xFD3F}, {0xFD50, 0xFD8F}, {0xFD92, 0xFDC7}, {0xFDF0, 0xFDFD},
    {0xFE00, 0xFE19}, {0xFE20, 0xFE52}, {0xFE54, 0xFE66}, {0xFE68, 0xFE6B},
    {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF01, 0xFFBE}, {0xFFC2, 0xFFC7},
    {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC}, {0xFFE0, 0xFFE6},
    {0xFFE8, 0xFFEE}
    {0xFD92, 0xFDC7}, {0xFDF0, 0xFE19}, {0xFE20, 0xFE52}, {0xFE54, 0xFE66},
    {0xFE68, 0xFE6B}, {0xFE70, 0xFE74}, {0xFE76, 0xFEFC}, {0xFF01, 0xFFBE},
    {0xFFC2, 0xFFC7}, {0xFFCA, 0xFFCF}, {0xFFD2, 0xFFD7}, {0xFFDA, 0xFFDC},
    {0xFFE0, 0xFFE6}, {0xFFE8, 0xFFEE}
#if CHRBITS > 16
    ,{0x10000, 0x1000B}, {0x1000D, 0x10026}, {0x10028, 0x1003A}, {0x1003F, 0x1004D},
    {0x10050, 0x1005D}, {0x10080, 0x100FA}, {0x10100, 0x10102}, {0x10107, 0x10133},
    {0x10137, 0x1018E}, {0x10190, 0x1019C}, {0x101D0, 0x101FD}, {0x10280, 0x1029C},
    {0x102A0, 0x102D0}, {0x102E0, 0x102FB}, {0x10300, 0x10323}, {0x1032D, 0x1034A},
    {0x10350, 0x1037A}, {0x10380, 0x1039D}, {0x1039F, 0x103C3}, {0x103C8, 0x103D5},
    {0x10400, 0x1049D}, {0x104A0, 0x104A9}, {0x104B0, 0x104D3}, {0x104D8, 0x104FB},
    {0x10500, 0x10527}, {0x10530, 0x10563}, {0x10600, 0x10736}, {0x10740, 0x10755},
    {0x10760, 0x10767}, {0x10800, 0x10805}, {0x1080A, 0x10835}, {0x1083F, 0x10855},
    {0x10857, 0x1089E}, {0x108A7, 0x108AF}, {0x108E0, 0x108F2}, {0x108FB, 0x1091B},
    {0x1091F, 0x10939}, {0x10980, 0x109B7}, {0x109BC, 0x109CF}, {0x109D2, 0x10A03},
    {0x10A0C, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35}, {0x10A38, 0x10A3A},
    {0x10A3F, 0x10A48}, {0x10A50, 0x10A58}, {0x10A60, 0x10A9F}, {0x10AC0, 0x10AE6},
    {0x10AEB, 0x10AF6}, {0x10B00, 0x10B35}, {0x10B39, 0x10B55}, {0x10B58, 0x10B72},
    {0x10B78, 0x10B91}, {0x10B99, 0x10B9C}, {0x10BA9, 0x10BAF}, {0x10C00, 0x10C48},
    {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10CFA, 0x10D27}, {0x10D30, 0x10D39},
    {0x10E60, 0x10E7E}, {0x10E80, 0x10EA9}, {0x10EAB, 0x10EAD}, {0x10F00, 0x10F27},
    {0x10F30, 0x10F59}, {0x10FB0, 0x10FCB}, {0x10FE0, 0x10FF6}, {0x11000, 0x1104D},
    {0x11052, 0x1106F}, {0x1107F, 0x110BC}, {0x110BE, 0x110C1}, {0x110D0, 0x110E8},
    {0x110F0, 0x110F9}, {0x11100, 0x11134}, {0x11136, 0x11147}, {0x11150, 0x11176},
    {0x11180, 0x111DF}, {0x111E1, 0x111F4}, {0x11200, 0x11211}, {0x11213, 0x1123E},
    {0x11280, 0x11286}, {0x1128A, 0x1128D}, {0x1128F, 0x1129D}, {0x1129F, 0x112A9},
    {0x112B0, 0x112EA}, {0x112F0, 0x112F9}, {0x11300, 0x11303}, {0x11305, 0x1130C},
    {0x11313, 0x11328}, {0x1132A, 0x11330}, {0x11335, 0x11339}, {0x1133B, 0x11344},
    {0x1134B, 0x1134D}, {0x1135D, 0x11363}, {0x11366, 0x1136C}, {0x11370, 0x11374},
    {0x11400, 0x1145B}, {0x1145D, 0x11461}, {0x11480, 0x114C7}, {0x114D0, 0x114D9},
    {0x11580, 0x115B5}, {0x115B8, 0x115DD}, {0x11600, 0x11644}, {0x11650, 0x11659},
    {0x11660, 0x1166C}, {0x11680, 0x116B8}, {0x116C0, 0x116C9}, {0x11700, 0x1171A},
    {0x1171D, 0x1172B}, {0x11730, 0x1173F}, {0x11800, 0x1183B}, {0x118A0, 0x118F2},
    {0x118FF, 0x11906}, {0x1190C, 0x11913}, {0x11918, 0x11935}, {0x1193B, 0x11946},
    {0x11950, 0x11959}, {0x119A0, 0x119A7}, {0x119AA, 0x119D7}, {0x119DA, 0x119E4},
    {0x11A00, 0x11A47}, {0x11A50, 0x11AA2}, {0x11AC0, 0x11AF8}, {0x11C00, 0x11C08},
    {0x11C0A, 0x11C36}, {0x11C38, 0x11C45}, {0x11C50, 0x11C6C}, {0x11C70, 0x11C8F},
    {0x11C92, 0x11CA7}, {0x11CA9, 0x11CB6}, {0x11D00, 0x11D06}, {0x11D0B, 0x11D36},
    {0x11D3F, 0x11D47}, {0x11D50, 0x11D59}, {0x11D60, 0x11D65}, {0x11D6A, 0x11D8E},
    {0x11D93, 0x11D98}, {0x11DA0, 0x11DA9}, {0x11EE0, 0x11EF8}, {0x11FC0, 0x11FF1},
    {0x11FFF, 0x12399}, {0x12400, 0x1246E}, {0x12470, 0x12474}, {0x12480, 0x12543},
    {0x13000, 0x1342E}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E},
    {0x16A60, 0x16A69}, {0x16AD0, 0x16AED}, {0x16AF0, 0x16AF5}, {0x16B00, 0x16B45},
    {0x16B50, 0x16B59}, {0x16B5B, 0x16B61}, {0x16B63, 0x16B77}, {0x16B7D, 0x16B8F},
    {0x16E40, 0x16E9A}, {0x16F00, 0x16F4A}, {0x16F4F, 0x16F87}, {0x16F8F, 0x16F9F},
    {0x16FE0, 0x16FE4}, {0x17000, 0x187F7}, {0x18800, 0x18CD5}, {0x18D00, 0x18D08},
    {0x1B000, 0x1B11E}, {0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB},
    {0x10500, 0x10527}, {0x10530, 0x10563}, {0x1056F, 0x1057A}, {0x1057C, 0x1058A},
    {0x1058C, 0x10592}, {0x10597, 0x105A1}, {0x105A3, 0x105B1}, {0x105B3, 0x105B9},
    {0x10600, 0x10736}, {0x10740, 0x10755}, {0x10760, 0x10767}, {0x10780, 0x10785},
    {0x10787, 0x107B0}, {0x107B2, 0x107BA}, {0x10800, 0x10805}, {0x1080A, 0x10835},
    {0x1083F, 0x10855}, {0x10857, 0x1089E}, {0x108A7, 0x108AF}, {0x108E0, 0x108F2},
    {0x108FB, 0x1091B}, {0x1091F, 0x10939}, {0x10980, 0x109B7}, {0x109BC, 0x109CF},
    {0x109D2, 0x10A03}, {0x10A0C, 0x10A13}, {0x10A15, 0x10A17}, {0x10A19, 0x10A35},
    {0x10A38, 0x10A3A}, {0x10A3F, 0x10A48}, {0x10A50, 0x10A58}, {0x10A60, 0x10A9F},
    {0x10AC0, 0x10AE6}, {0x10AEB, 0x10AF6}, {0x10B00, 0x10B35}, {0x10B39, 0x10B55},
    {0x10B58, 0x10B72}, {0x10B78, 0x10B91}, {0x10B99, 0x10B9C}, {0x10BA9, 0x10BAF},
    {0x10C00, 0x10C48}, {0x10C80, 0x10CB2}, {0x10CC0, 0x10CF2}, {0x10CFA, 0x10D27},
    {0x10D30, 0x10D39}, {0x10E60, 0x10E7E}, {0x10E80, 0x10EA9}, {0x10EAB, 0x10EAD},
    {0x10EFD, 0x10F27}, {0x10F30, 0x10F59}, {0x10F70, 0x10F89}, {0x10FB0, 0x10FCB},
    {0x10FE0, 0x10FF6}, {0x11000, 0x1104D}, {0x11052, 0x11075}, {0x1107F, 0x110BC},
    {0x110BE, 0x110C2}, {0x110D0, 0x110E8}, {0x110F0, 0x110F9}, {0x11100, 0x11134},
    {0x11136, 0x11147}, {0x11150, 0x11176}, {0x11180, 0x111DF}, {0x111E1, 0x111F4},
    {0x11200, 0x11211}, {0x11213, 0x11241}, {0x11280, 0x11286}, {0x1128A, 0x1128D},
    {0x1128F, 0x1129D}, {0x1129F, 0x112A9}, {0x112B0, 0x112EA}, {0x112F0, 0x112F9},
    {0x11300, 0x11303}, {0x11305, 0x1130C}, {0x11313, 0x11328}, {0x1132A, 0x11330},
    {0x11335, 0x11339}, {0x1133B, 0x11344}, {0x1134B, 0x1134D}, {0x1135D, 0x11363},
    {0x11366, 0x1136C}, {0x11370, 0x11374}, {0x11400, 0x1145B}, {0x1145D, 0x11461},
    {0x11480, 0x114C7}, {0x114D0, 0x114D9}, {0x11580, 0x115B5}, {0x115B8, 0x115DD},
    {0x11600, 0x11644}, {0x11650, 0x11659}, {0x11660, 0x1166C}, {0x11680, 0x116B9},
    {0x116C0, 0x116C9}, {0x11700, 0x1171A}, {0x1171D, 0x1172B}, {0x11730, 0x11746},
    {0x11800, 0x1183B}, {0x118A0, 0x118F2}, {0x118FF, 0x11906}, {0x1190C, 0x11913},
    {0x11918, 0x11935}, {0x1193B, 0x11946}, {0x11950, 0x11959}, {0x119A0, 0x119A7},
    {0x119AA, 0x119D7}, {0x119DA, 0x119E4}, {0x11A00, 0x11A47}, {0x11A50, 0x11AA2},
    {0x11AB0, 0x11AF8}, {0x11B00, 0x11B09}, {0x11C00, 0x11C08}, {0x11C0A, 0x11C36},
    {0x11C38, 0x11C45}, {0x11C50, 0x11C6C}, {0x11C70, 0x11C8F}, {0x11C92, 0x11CA7},
    {0x11CA9, 0x11CB6}, {0x11D00, 0x11D06}, {0x11D0B, 0x11D36}, {0x11D3F, 0x11D47},
    {0x11D50, 0x11D59}, {0x11D60, 0x11D65}, {0x11D6A, 0x11D8E}, {0x11D93, 0x11D98},
    {0x11DA0, 0x11DA9}, {0x11EE0, 0x11EF8}, {0x11F00, 0x11F10}, {0x11F12, 0x11F3A},
    {0x11F3E, 0x11F59}, {0x11FC0, 0x11FF1}, {0x11FFF, 0x12399}, {0x12400, 0x1246E},
    {0x12470, 0x12474}, {0x12480, 0x12543}, {0x12F90, 0x12FF2}, {0x13000, 0x1342F},
    {0x13440, 0x13455}, {0x14400, 0x14646}, {0x16800, 0x16A38}, {0x16A40, 0x16A5E},
    {0x16A60, 0x16A69}, {0x16A6E, 0x16ABE}, {0x16AC0, 0x16AC9}, {0x16AD0, 0x16AED},
    {0x16AF0, 0x16AF5}, {0x16B00, 0x16B45}, {0x16B50, 0x16B59}, {0x16B5B, 0x16B61},
    {0x16B63, 0x16B77}, {0x16B7D, 0x16B8F}, {0x16E40, 0x16E9A}, {0x16F00, 0x16F4A},
    {0x16F4F, 0x16F87}, {0x16F8F, 0x16F9F}, {0x16FE0, 0x16FE4}, {0x17000, 0x187F7},
    {0x18800, 0x18CD5}, {0x18D00, 0x18D08}, {0x1AFF0, 0x1AFF3}, {0x1AFF5, 0x1AFFB},
    {0x1B000, 0x1B122}, {0x1B150, 0x1B152}, {0x1B164, 0x1B167}, {0x1B170, 0x1B2FB},
    {0x1BC00, 0x1BC6A}, {0x1BC70, 0x1BC7C}, {0x1BC80, 0x1BC88}, {0x1BC90, 0x1BC99},
    {0x1BC9C, 0x1BC9F}, {0x1CF00, 0x1CF2D}, {0x1CF30, 0x1CF46}, {0x1CF50, 0x1CFC3},
    {0x1BC9C, 0x1BC9F}, {0x1D000, 0x1D0F5}, {0x1D100, 0x1D126}, {0x1D129, 0x1D172},
    {0x1D17B, 0x1D1E8}, {0x1D200, 0x1D245}, {0x1D2E0, 0x1D2F3}, {0x1D300, 0x1D356},
    {0x1D000, 0x1D0F5}, {0x1D100, 0x1D126}, {0x1D129, 0x1D172}, {0x1D17B, 0x1D1EA},
    {0x1D200, 0x1D245}, {0x1D2C0, 0x1D2D3}, {0x1D2E0, 0x1D2F3}, {0x1D300, 0x1D356},
    {0x1D360, 0x1D378}, {0x1D400, 0x1D454}, {0x1D456, 0x1D49C}, {0x1D4A9, 0x1D4AC},
    {0x1D4AE, 0x1D4B9}, {0x1D4BD, 0x1D4C3}, {0x1D4C5, 0x1D505}, {0x1D507, 0x1D50A},
    {0x1D50D, 0x1D514}, {0x1D516, 0x1D51C}, {0x1D51E, 0x1D539}, {0x1D53B, 0x1D53E},
    {0x1D540, 0x1D544}, {0x1D54A, 0x1D550}, {0x1D552, 0x1D6A5}, {0x1D6A8, 0x1D7CB},
    {0x1D7CE, 0x1DA8B}, {0x1DA9B, 0x1DA9F}, {0x1DAA1, 0x1DAAF}, {0x1E000, 0x1E006},
    {0x1E008, 0x1E018}, {0x1E01B, 0x1E021}, {0x1E026, 0x1E02A}, {0x1E100, 0x1E12C},
    {0x1E130, 0x1E13D}, {0x1E140, 0x1E149}, {0x1E2C0, 0x1E2F9}, {0x1E800, 0x1E8C4},
    {0x1D7CE, 0x1DA8B}, {0x1DA9B, 0x1DA9F}, {0x1DAA1, 0x1DAAF}, {0x1DF00, 0x1DF1E},
    {0x1DF25, 0x1DF2A}, {0x1E000, 0x1E006}, {0x1E008, 0x1E018}, {0x1E01B, 0x1E021},
    {0x1E026, 0x1E02A}, {0x1E030, 0x1E06D}, {0x1E100, 0x1E12C}, {0x1E130, 0x1E13D},
    {0x1E140, 0x1E149}, {0x1E290, 0x1E2AE}, {0x1E2C0, 0x1E2F9}, {0x1E4D0, 0x1E4F9},
    {0x1E7E0, 0x1E7E6}, {0x1E7E8, 0x1E7EB}, {0x1E7F0, 0x1E7FE}, {0x1E800, 0x1E8C4},
    {0x1E8C7, 0x1E8D6}, {0x1E900, 0x1E94B}, {0x1E950, 0x1E959}, {0x1EC71, 0x1ECB4},
    {0x1ED01, 0x1ED3D}, {0x1EE00, 0x1EE03}, {0x1EE05, 0x1EE1F}, {0x1EE29, 0x1EE32},
    {0x1EE34, 0x1EE37}, {0x1EE4D, 0x1EE4F}, {0x1EE67, 0x1EE6A}, {0x1EE6C, 0x1EE72},
    {0x1EE74, 0x1EE77}, {0x1EE79, 0x1EE7C}, {0x1EE80, 0x1EE89}, {0x1EE8B, 0x1EE9B},
    {0x1EEA1, 0x1EEA3}, {0x1EEA5, 0x1EEA9}, {0x1EEAB, 0x1EEBB}, {0x1F000, 0x1F02B},
    {0x1F030, 0x1F093}, {0x1F0A0, 0x1F0AE}, {0x1F0B1, 0x1F0BF}, {0x1F0C1, 0x1F0CF},
    {0x1F0D1, 0x1F0F5}, {0x1F100, 0x1F1AD}, {0x1F1E6, 0x1F202}, {0x1F210, 0x1F23B},
    {0x1F240, 0x1F248}, {0x1F260, 0x1F265}, {0x1F300, 0x1F6D7}, {0x1F6E0, 0x1F6EC},
    {0x1F6F0, 0x1F6FC}, {0x1F700, 0x1F773}, {0x1F780, 0x1F7D8}, {0x1F7E0, 0x1F7EB},
    {0x1F240, 0x1F248}, {0x1F260, 0x1F265}, {0x1F300, 0x1F6D7}, {0x1F6DC, 0x1F6EC},
    {0x1F6F0, 0x1F6FC}, {0x1F700, 0x1F776}, {0x1F77B, 0x1F7D9}, {0x1F7E0, 0x1F7EB},
    {0x1F800, 0x1F80B}, {0x1F810, 0x1F847}, {0x1F850, 0x1F859}, {0x1F860, 0x1F887},
    {0x1F890, 0x1F8AD}, {0x1F900, 0x1F978}, {0x1F97A, 0x1F9CB}, {0x1F9CD, 0x1FA53},
    {0x1FA60, 0x1FA6D}, {0x1FA70, 0x1FA74}, {0x1FA78, 0x1FA7A}, {0x1FA80, 0x1FA86},
    {0x1FA90, 0x1FAA8}, {0x1FAB0, 0x1FAB6}, {0x1FAC0, 0x1FAC2}, {0x1FAD0, 0x1FAD6},
    {0x1FB00, 0x1FB92}, {0x1FB94, 0x1FBCA}, {0x1FBF0, 0x1FBF9}, {0x20000, 0x2A6DD},
    {0x2A700, 0x2B734}, {0x2B740, 0x2B81D}, {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0},
    {0x2F800, 0x2FA1D}, {0x30000, 0x3134A}, {0xE0100, 0xE01EF}
    {0x1F890, 0x1F8AD}, {0x1F900, 0x1FA53}, {0x1FA60, 0x1FA6D}, {0x1FA70, 0x1FA7C},
    {0x1FA80, 0x1FA88}, {0x1FA90, 0x1FABD}, {0x1FABF, 0x1FAC5}, {0x1FACE, 0x1FADB},
    {0x1FAE0, 0x1FAE8}, {0x1FAF0, 0x1FAF8}, {0x1FB00, 0x1FB92}, {0x1FB94, 0x1FBCA},
    {0x1FBF0, 0x1FBF9}, {0x20000, 0x2A6DF}, {0x2A700, 0x2B739}, {0x2B740, 0x2B81D},
    {0x2B820, 0x2CEA1}, {0x2CEB0, 0x2EBE0}, {0x2F800, 0x2FA1D}, {0x30000, 0x3134A},
    {0x31350, 0x323AF}, {0xE0100, 0xE01EF}
#endif
};

#define NUM_GRAPH_RANGE (sizeof(graphRangeTable)/sizeof(crange))

static const chr graphCharTable[] = {
    0x38C, 0x85E, 0x98F, 0x990, 0x9B2, 0x9C7, 0x9C8, 0x9D7, 0x9DC,
    0x9DD, 0xA0F, 0xA10, 0xA32, 0xA33, 0xA35, 0xA36, 0xA38, 0xA39,
    0xA3C, 0xA47, 0xA48, 0xA51, 0xA5E, 0xAB2, 0xAB3, 0xAD0, 0xB0F,
    0xB10, 0xB32, 0xB33, 0xB47, 0xB48, 0xB5C, 0xB5D, 0xB82, 0xB83,
    0xB99, 0xB9A, 0xB9C, 0xB9E, 0xB9F, 0xBA3, 0xBA4, 0xBD0, 0xBD7,
    0xC55, 0xC56, 0xCD5, 0xCD6, 0xCDE, 0xCF1, 0xCF2, 0xDBD, 0xDCA,
    0xC55, 0xC56, 0xC5D, 0xCD5, 0xCD6, 0xCDD, 0xCDE, 0xDBD, 0xDCA,
    0xDD6, 0xE81, 0xE82, 0xE84, 0xEA5, 0xEC6, 0x10C7, 0x10CD, 0x1258,
    0x12C0, 0x1772, 0x1773, 0x1940, 0x1F59, 0x1F5B, 0x1F5D, 0x2070, 0x2071,
    0x2D27, 0x2D2D, 0x2D6F, 0x2D70, 0xFB3E, 0xFB40, 0xFB41, 0xFB43, 0xFB44,
    0xFFFC, 0xFFFD
    0x2D27, 0x2D2D, 0x2D6F, 0x2D70, 0xA7D0, 0xA7D1, 0xA7D3, 0xFB3E, 0xFB40,
    0xFB41, 0xFB43, 0xFB44, 0xFDCF, 0xFFFC, 0xFFFD
#if CHRBITS > 16
    ,0x1003C, 0x1003D, 0x101A0, 0x1056F, 0x10808, 0x10837, 0x10838, 0x1083C, 0x108F4,
    0x108F5, 0x1093F, 0x10A05, 0x10A06, 0x10EB0, 0x10EB1, 0x11288, 0x1130F, 0x11310,
    0x11332, 0x11333, 0x11347, 0x11348, 0x11350, 0x11357, 0x11909, 0x11915, 0x11916,
    0x11937, 0x11938, 0x11D08, 0x11D09, 0x11D3A, 0x11D3C, 0x11D3D, 0x11D67, 0x11D68,
    0x11D90, 0x11D91, 0x11FB0, 0x16A6E, 0x16A6F, 0x16FF0, 0x16FF1, 0x1D49E, 0x1D49F,
    0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB, 0x1D546, 0x1E023, 0x1E024, 0x1E14E, 0x1E14F,
    0x1E2FF, 0x1E95E, 0x1E95F, 0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B,
    0x1EE42, 0x1EE47, 0x1EE49, 0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59,
    0x1EE5B, 0x1EE5D, 0x1EE5F, 0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E, 0x1EEF0, 0x1EEF1,
    0x1F250, 0x1F251, 0x1F8B0, 0x1F8B1
    ,0x1003C, 0x1003D, 0x101A0, 0x10594, 0x10595, 0x105BB, 0x105BC, 0x10808, 0x10837,
    0x10838, 0x1083C, 0x108F4, 0x108F5, 0x1093F, 0x10A05, 0x10A06, 0x10EB0, 0x10EB1,
    0x11288, 0x1130F, 0x11310, 0x11332, 0x11333, 0x11347, 0x11348, 0x11350, 0x11357,
    0x11909, 0x11915, 0x11916, 0x11937, 0x11938, 0x11D08, 0x11D09, 0x11D3A, 0x11D3C,
    0x11D3D, 0x11D67, 0x11D68, 0x11D90, 0x11D91, 0x11FB0, 0x16FF0, 0x16FF1, 0x1AFFD,
    0x1AFFE, 0x1B132, 0x1B155, 0x1D49E, 0x1D49F, 0x1D4A2, 0x1D4A5, 0x1D4A6, 0x1D4BB,
    0x1D546, 0x1E023, 0x1E024, 0x1E08F, 0x1E14E, 0x1E14F, 0x1E2FF, 0x1E7ED, 0x1E7EE,
    0x1E95E, 0x1E95F, 0x1EE21, 0x1EE22, 0x1EE24, 0x1EE27, 0x1EE39, 0x1EE3B, 0x1EE42,
    0x1EE47, 0x1EE49, 0x1EE4B, 0x1EE51, 0x1EE52, 0x1EE54, 0x1EE57, 0x1EE59, 0x1EE5B,
    0x1EE5D, 0x1EE5F, 0x1EE61, 0x1EE62, 0x1EE64, 0x1EE7E, 0x1EEF0, 0x1EEF1, 0x1F250,
    0x1F251, 0x1F7F0, 0x1F8B0, 0x1F8B1
#endif
};

#define NUM_GRAPH_CHAR (sizeof(graphCharTable)/sizeof(chr))

/*
 *	End of auto-generated Unicode character ranges declarations.
 */

#define	CH	NOCELT

/*
 - element - map collating-element name to celt
 ^ static celt element(struct vars *, const chr *, const chr *);
 */
static celt
element(
834
835
836
837
838
839
840
841

842
843
844
845
846
847
848
857
858
859
860
861
862
863

864
865
866
867
868
869
870
871







-
+







    NOTE(REG_ULOCALE);

    /*
     * Search table.
     */

    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, len, &ds);
    np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);
    for (cn=cnames; cn->name!=NULL; cn++) {
	if (strlen(cn->name)==len && strncmp(cn->name, np, len)==0) {
	    break;			/* NOTE BREAK OUT */
	}
    }
    Tcl_DStringFree(&ds);
    if (cn->name != NULL) {
893
894
895
896
897
898
899
900
901
902



903
904
905
906
907
908
909
916
917
918
919
920
921
922



923
924
925
926
927
928
929
930
931
932







-
-
-
+
+
+







    nchrs = (b - a + 1)*2 + 4;

    cv = getcvec(v, nchrs, 0);
    NOERRN();

    for (c=a; c<=b; c++) {
	addchr(cv, c);
	lc = Tcl_UniCharToLower(c);
	uc = Tcl_UniCharToUpper(c);
	tc = Tcl_UniCharToTitle(c);
	lc = Tcl_UniCharToLower((chr)c);
	uc = Tcl_UniCharToUpper((chr)c);
	tc = Tcl_UniCharToTitle((chr)c);
	if (c != lc) {
	    addchr(cv, lc);
	}
	if (c != uc) {
	    addchr(cv, uc);
	}
	if (c != tc && tc != uc) {
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
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







-
-
+
+

-
-
+
+













-
+




















-
-
+








    /*
     * Crude fake equivalence class for testing.
     */

    if ((v->cflags&REG_FAKE) && c == 'x') {
	cv = getcvec(v, 4, 0);
	addchr(cv, 'x');
	addchr(cv, 'y');
	addchr(cv, (chr)'x');
	addchr(cv, (chr)'y');
	if (cases) {
	    addchr(cv, 'X');
	    addchr(cv, 'Y');
	    addchr(cv, (chr)'X');
	    addchr(cv, (chr)'Y');
	}
	return cv;
    }

    /*
     * Otherwise, none.
     */

    if (cases) {
	return allcases(v, c);
    }
    cv = getcvec(v, 1, 0);
    assert(cv != NULL);
    addchr(cv, c);
    addchr(cv, (chr)c);
    return cv;
}

/*
 - cclass - supply cvec for a character class
 * Must include case counterparts on request.
 ^ static struct cvec *cclass(struct vars *, const chr *, const chr *, int);
 */
static struct cvec *
cclass(
    struct vars *v,		/* context */
    const chr *startp,		/* where the name starts */
    const chr *endp,		/* just past the end of the name */
    int cases)			/* case-independent? */
{
    size_t len;
    struct cvec *cv = NULL;
    Tcl_DString ds;
    const char *np;
    const char *const *namePtr;
    size_t i;
    int index;
    int i, index;

    /*
     * The following arrays define the valid character class names.
     */

    static const char *const classNames[] = {
	"alnum", "alpha", "ascii", "blank", "cntrl", "digit", "graph",
1007
1008
1009
1010
1011
1012
1013
1014

1015
1016
1017
1018
1019
1020
1021
1029
1030
1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1043







-
+








    /*
     * Extract the class name
     */

    len = endp - startp;
    Tcl_DStringInit(&ds);
    np = Tcl_UniCharToUtfDString(startp, len, &ds);
    np = Tcl_UniCharToUtfDString(startp, (int)len, &ds);

    /*
     * Map the name to the corresponding enumerated value.
     */

    index = -1;
    for (namePtr=classNames,i=0 ; *namePtr!=NULL ; namePtr++,i++) {
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
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
1140
1141
1142







-
+


-
+



-
+








-
+



-
+


















-
+



-
+







-
+








-
+



-
+







     * Now compute the character class contents.
     */

    switch((enum classes) index) {
    case CC_ALNUM:
	cv = getcvec(v, NUM_ALPHA_CHAR, NUM_DIGIT_RANGE + NUM_ALPHA_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_ALPHA_CHAR ; i++) {
		addchr(cv, alphaCharTable[i]);
	    }
	    for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_ALPHA_RANGE ; i++) {
		addrange(cv, alphaRangeTable[i].start,
			alphaRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_DIGIT_RANGE ; i++) {
		addrange(cv, digitRangeTable[i].start,
			digitRangeTable[i].end);
	    }
	}
	break;
    case CC_ALPHA:
	cv = getcvec(v, NUM_ALPHA_CHAR, NUM_ALPHA_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_ALPHA_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_ALPHA_RANGE ; i++) {
		addrange(cv, alphaRangeTable[i].start,
			alphaRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_ALPHA_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_ALPHA_CHAR ; i++) {
		addchr(cv, alphaCharTable[i]);
	    }
	}
	break;
    case CC_ASCII:
	cv = getcvec(v, 0, 1);
	if (cv) {
	    addrange(cv, 0, 0x7F);
	}
	break;
    case CC_BLANK:
	cv = getcvec(v, 2, 0);
	addchr(cv, '\t');
	addchr(cv, ' ');
	break;
    case CC_CNTRL:
	cv = getcvec(v, NUM_CONTROL_CHAR, NUM_CONTROL_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_CONTROL_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_CONTROL_RANGE ; i++) {
		addrange(cv, controlRangeTable[i].start,
			controlRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_CONTROL_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_CONTROL_CHAR ; i++) {
		addchr(cv, controlCharTable[i]);
	    }
	}
	break;
    case CC_DIGIT:
	cv = getcvec(v, 0, NUM_DIGIT_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_DIGIT_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_DIGIT_RANGE ; i++) {
		addrange(cv, digitRangeTable[i].start,
			digitRangeTable[i].end);
	    }
	}
	break;
    case CC_PUNCT:
	cv = getcvec(v, NUM_PUNCT_CHAR, NUM_PUNCT_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_PUNCT_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_PUNCT_RANGE ; i++) {
		addrange(cv, punctRangeTable[i].start,
			punctRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_PUNCT_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_PUNCT_CHAR ; i++) {
		addchr(cv, punctCharTable[i]);
	    }
	}
	break;
    case CC_XDIGIT:
	/*
	 * This is a 3 instead of (NUM_DIGIT_RANGE+2) because I've no idea how
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
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







-
+



-
+







-
+



-
+







-
+



-
+







-
+



-
+


-
+



-
+







-
+



-
+







	    addrange(cv, 'a', 'f');
	    addrange(cv, 'A', 'F');
	}
	break;
    case CC_SPACE:
	cv = getcvec(v, NUM_SPACE_CHAR, NUM_SPACE_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_SPACE_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_SPACE_RANGE ; i++) {
		addrange(cv, spaceRangeTable[i].start,
			spaceRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_SPACE_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_SPACE_CHAR ; i++) {
		addchr(cv, spaceCharTable[i]);
	    }
	}
	break;
    case CC_LOWER:
	cv  = getcvec(v, NUM_LOWER_CHAR, NUM_LOWER_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_LOWER_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_LOWER_RANGE ; i++) {
		addrange(cv, lowerRangeTable[i].start,
			lowerRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_LOWER_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_LOWER_CHAR ; i++) {
		addchr(cv, lowerCharTable[i]);
	    }
	}
	break;
    case CC_UPPER:
	cv  = getcvec(v, NUM_UPPER_CHAR, NUM_UPPER_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_UPPER_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_UPPER_RANGE ; i++) {
		addrange(cv, upperRangeTable[i].start,
			upperRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_UPPER_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_UPPER_CHAR ; i++) {
		addchr(cv, upperCharTable[i]);
	    }
	}
	break;
    case CC_PRINT:
    	cv  = getcvec(v, NUM_SPACE_CHAR + NUM_GRAPH_CHAR, NUM_SPACE_RANGE + NUM_GRAPH_RANGE  - 1);
    	if (cv) {
    	    for (i=1 ; i<NUM_SPACE_RANGE ; i++) {
    	    for (i=1 ; (size_t)i<NUM_SPACE_RANGE ; i++) {
    		addrange(cv, spaceRangeTable[i].start,
    				spaceRangeTable[i].end);
    	    }
    	    for (i=0 ; i<NUM_SPACE_CHAR ; i++) {
    	    for (i=0 ; (size_t)i<NUM_SPACE_CHAR ; i++) {
    		addchr(cv, spaceCharTable[i]);
    	    }
    	    for (i=0 ; i<NUM_GRAPH_RANGE ; i++) {
    	    for (i=0 ; (size_t)i<NUM_GRAPH_RANGE ; i++) {
    		addrange(cv, graphRangeTable[i].start,
    				graphRangeTable[i].end);
    	    }
    	    for (i=0 ; i<NUM_GRAPH_CHAR ; i++) {
    	    for (i=0 ; (size_t)i<NUM_GRAPH_CHAR ; i++) {
    		addchr(cv, graphCharTable[i]);
    	    }
    	}
    	break;
    case CC_GRAPH:
	cv  = getcvec(v, NUM_GRAPH_CHAR, NUM_GRAPH_RANGE);
	if (cv) {
	    for (i=0 ; i<NUM_GRAPH_RANGE ; i++) {
	    for (i=0 ; (size_t)i<NUM_GRAPH_RANGE ; i++) {
		addrange(cv, graphRangeTable[i].start,
			graphRangeTable[i].end);
	    }
	    for (i=0 ; i<NUM_GRAPH_CHAR ; i++) {
	    for (i=0 ; (size_t)i<NUM_GRAPH_CHAR ; i++) {
		addchr(cv, graphCharTable[i]);
	    }
	}
	break;
    }
    if (cv == NULL) {
	ERR(REG_ESPACE);
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226



1227
1228
1229
1230
1231
1232
1233
1239
1240
1241
1242
1243
1244
1245



1246
1247
1248
1249
1250
1251
1252
1253
1254
1255







-
-
-
+
+
+







    struct vars *v,		/* context */
    pchr pc)			/* character to get case equivs of */
{
    struct cvec *cv;
    chr c = (chr)pc;
    chr lc, uc, tc;

    lc = Tcl_UniCharToLower(c);
    uc = Tcl_UniCharToUpper(c);
    tc = Tcl_UniCharToTitle(c);
    lc = Tcl_UniCharToLower((chr)c);
    uc = Tcl_UniCharToUpper((chr)c);
    tc = Tcl_UniCharToTitle((chr)c);

    if (tc != uc) {
	cv = getcvec(v, 3, 0);
	addchr(cv, tc);
    } else {
	cv = getcvec(v, 2, 0);
    }
1247
1248
1249
1250
1251
1252
1253
1254

1255
1256
1257
1258
1259
1260
1261
1269
1270
1271
1272
1273
1274
1275

1276
1277
1278
1279
1280
1281
1282
1283







-
+







 ^ static int cmp(const chr *, const chr *, size_t);
 */
static int			/* 0 for equal, nonzero for unequal */
cmp(
    const chr *x, const chr *y,	/* strings to compare */
    size_t len)			/* exact length of comparison */
{
    return memcmp((void*)(x), (void*)(y), len*sizeof(chr));
    return memcmp(VS(x), VS(y), len*sizeof(chr));
}

/*
 - casecmp - case-independent chr-substring compare
 * REG_ICASE backrefs need this.  It should preferably be efficient.
 * Note that it does not need to report anything except equal/unequal.
 * Note also that the length is exact, and the comparison should not

Changes to generic/regc_nfa.c.

58
59
60
61
62
63
64

65
66
67
68
69
70
71
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72







+








    nfa->states = NULL;
    nfa->slast = NULL;
    nfa->free = NULL;
    nfa->nstates = 0;
    nfa->cm = cm;
    nfa->v = v;
    nfa->size = 0;
    nfa->bos[0] = nfa->bos[1] = COLORLESS;
    nfa->eos[0] = nfa->eos[1] = COLORLESS;
    nfa->parent = parent;	/* Precedes newfstate so parent is valid. */
    nfa->post = newfstate(nfa, '@');	/* number 0 */
    nfa->pre = newfstate(nfa, '>');	/* number 1 */

    nfa->init = newstate(nfa);	/* May become invalid later. */
83
84
85
86
87
88
89
90
91























































92
93

94
95
96
97
98
99
100
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









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

-
+








    if (ISERR()) {
	freenfa(nfa);
	return NULL;
    }
    return nfa;
}

/*
 - TooManyStates - checks if the max states exceeds the compile-time value
 ^ static int TooManyStates(struct nfa *);
 */
static int
TooManyStates(
    struct nfa *nfa)
{
    struct nfa *parent = nfa->parent;
    size_t sz = nfa->size;

    while (parent != NULL) {
	sz = parent->size;
	parent = parent->parent;
    }
    if (sz > REG_MAX_STATES) {
	return 1;
    }
    return 0;
}

/*
 - IncrementSize - increases the tracked size of the NFA and its parents.
 ^ static void IncrementSize(struct nfa *);
 */
static void
IncrementSize(
    struct nfa *nfa)
{
    struct nfa *parent = nfa->parent;

    nfa->size++;
    while (parent != NULL) {
	parent->size++;
	parent = parent->parent;
    }
}

/*
 - DecrementSize - increases the tracked size of the NFA and its parents.
 ^ static void DecrementSize(struct nfa *);
 */
static void
DecrementSize(
    struct nfa *nfa)
{
    struct nfa *parent = nfa->parent;

    nfa->size--;
    while (parent != NULL) {
	parent->size--;
	parent = parent->parent;
    }
}

/*
 - freenfa - free an entire NFA
 ^ static void freenfa(struct nfa *);
 ^ static VOID freenfa(struct nfa *);
 */
static void
freenfa(
    struct nfa *nfa)
{
    struct state *s;

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
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







+
+
+
+
+




-
-
-
-





-







 */
static struct state *		/* NULL on error */
newstate(
    struct nfa *nfa)
{
    struct state *s;

    if (TooManyStates(nfa)) {
	/* XXX: add specific error for this */
	NERR(REG_ETOOBIG);
	return NULL;
    }
    if (nfa->free != NULL) {
	s = nfa->free;
	nfa->free = s->next;
    } else {
	if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
	    NERR(REG_ETOOBIG);
	    return NULL;
	}
	s = (struct state *) MALLOC(sizeof(struct state));
	if (s == NULL) {
	    NERR(REG_ESPACE);
	    return NULL;
	}
	nfa->v->spaceused += sizeof(struct state);
	s->oas.next = NULL;
	s->free = NULL;
	s->noas = 0;
    }

    assert(nfa->nstates >= 0);
    s->no = nfa->nstates++;
157
158
159
160
161
162
163






164
165
166
167
168
169
170
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232







+
+
+
+
+
+







    s->next = NULL;
    if (nfa->slast != NULL) {
	assert(nfa->slast->next == NULL);
	nfa->slast->next = s;
    }
    s->prev = nfa->slast;
    nfa->slast = s;

    /*
     * Track the current size and the parent size.
     */

    IncrementSize(nfa);
    return s;
}

/*
 - newfstate - allocate an NFA state with a specified flag value
 ^ static struct state *newfstate(struct nfa *, int flag);
 */
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
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







-
+



















-
+







	s->flag = (char) flag;
    }
    return s;
}

/*
 - dropstate - delete a state's inarcs and outarcs and free it
 ^ static void dropstate(struct nfa *, struct state *);
 ^ static VOID dropstate(struct nfa *, struct state *);
 */
static void
dropstate(
    struct nfa *nfa,
    struct state *s)
{
    struct arc *a;

    while ((a = s->ins) != NULL) {
	freearc(nfa, a);
    }
    while ((a = s->outs) != NULL) {
	freearc(nfa, a);
    }
    freestate(nfa, s);
}

/*
 - freestate - free a state, which has no in-arcs or out-arcs
 ^ static void freestate(struct nfa *, struct state *);
 ^ static VOID freestate(struct nfa *, struct state *);
 */
static void
freestate(
    struct nfa *nfa,
    struct state *s)
{
    assert(s != NULL);
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
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







+




-
+













-





-




-
+







    } else {
	assert(s == nfa->states);
	nfa->states = s->next;
    }
    s->prev = NULL;
    s->next = nfa->free;	/* don't delete it, put it on the free list */
    nfa->free = s;
    DecrementSize(nfa);
}

/*
 - destroystate - really get rid of an already-freed state
 ^ static void destroystate(struct nfa *, struct state *);
 ^ static VOID destroystate(struct nfa *, struct state *);
 */
static void
destroystate(
    struct nfa *nfa,
    struct state *s)
{
    struct arcbatch *ab;
    struct arcbatch *abnext;

    assert(s->no == FREESTATE);
    for (ab=s->oas.next ; ab!=NULL ; ab=abnext) {
	abnext = ab->next;
	FREE(ab);
	nfa->v->spaceused -= sizeof(struct arcbatch);
    }
    s->ins = NULL;
    s->outs = NULL;
    s->next = NULL;
    FREE(s);
    nfa->v->spaceused -= sizeof(struct state);
}

/*
 - newarc - set up a new arc within an NFA
 ^ static void newarc(struct nfa *, int, pcolor, struct state *,
 ^ static VOID newarc(struct nfa *, int, pcolor, struct state *,
 ^	struct state *);
 */
/*
 * This function checks to make sure that no duplicate arcs are created.
 * In general we never want duplicates.
 */
static void
289
290
291
292
293
294
295
296

297
298
299
300
301
302
303
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364







-
+







    } else {
	for (a = to->ins; a != NULL; a = a->inchain) {
	    if (a->from == from && a->co == co && a->type == t) {
		return;
	    }
	}
    }

  
    /* no dup, so create the arc */
    createarc(nfa, t, co, from, to);
}

/*
 * createarc - create a new arc within an NFA
 *
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
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







-
+
+


-
-
-
-
-




-



















-
+







    }

    /*
     * if none at hand, get more
     */

    if (s->free == NULL) {
	struct arcbatch *newAb;
	struct arcbatch *newAb = (struct arcbatch *)
		MALLOC(sizeof(struct arcbatch));
	int i;

	if (nfa->v->spaceused >= REG_MAX_COMPILE_SPACE) {
	    NERR(REG_ETOOBIG);
	    return NULL;
	}
	newAb = (struct arcbatch *) MALLOC(sizeof(struct arcbatch));
	if (newAb == NULL) {
	    NERR(REG_ESPACE);
	    return NULL;
	}
	nfa->v->spaceused += sizeof(struct arcbatch);
	newAb->next = s->oas.next;
	s->oas.next = newAb;

	for (i=0 ; i<ABSIZE ; i++) {
	    newAb->a[i].type = 0;
	    newAb->a[i].freechain = &newAb->a[i+1];
	}
	newAb->a[ABSIZE-1].freechain = NULL;
	s->free = &newAb->a[0];
    }
    assert(s->free != NULL);

    a = s->free;
    s->free = a->freechain;
    return a;
}

/*
 - freearc - free an arc
 ^ static void freearc(struct nfa *, struct arc *);
 ^ static VOID freearc(struct nfa *, struct arc *);
 */
static void
freearc(
    struct nfa *nfa,
    struct arc *victim)
{
    struct state *from = victim->from;
565
566
567
568
569
570
571
572

573
574
575
576
577
578
579
621
622
623
624
625
626
627

628
629
630
631
632
633
634
635







-
+







	}
    }
    return NULL;
}

/*
 - cparc - allocate a new arc within an NFA, copying details from old one
 ^ static void cparc(struct nfa *, struct arc *, struct state *,
 ^ static VOID cparc(struct nfa *, struct arc *, struct state *,
 ^ 	struct state *);
 */
static void
cparc(
    struct nfa *nfa,
    struct arc *oa,
    struct state *from,
653
654
655
656
657
658
659
660

661
662
663
664
665
666
667
709
710
711
712
713
714
715

716
717
718
719
720
721
722
723







-
+







 	return -1;
    }
    if (aa->type > bb->type) {
 	return 1;
    }
    return 0;
}

 
/*
 * sortouts - sort the out arcs of a state by to/color/type
 */
static void
sortouts(
    struct nfa * nfa,
    struct state * s)
752
753
754
755
756
757
758
759

760
761
762
763
764
765
766
808
809
810
811
812
813
814

815
816
817
818
819
820
821
822







-
+







 * for duplicate suppression, which makes it easier to just make new
 * ones to exploit the suppression built into newarc.
 *
 * However, if we have a whole lot of arcs to deal with, retail duplicate
 * checks become too slow.  In that case we proceed by sorting and merging
 * the arc lists, and then we can indeed just update the arcs in-place.
 *
 ^ static void moveins(struct nfa *, struct state *, struct state *);
 ^ static VOID moveins(struct nfa *, struct state *, struct state *);
 */
static void
moveins(
    struct nfa *nfa,
    struct state *oldState,
    struct state *newState)
{
839
840
841
842
843
844
845
846

847
848
849
850
851
852
853
895
896
897
898
899
900
901

902
903
904
905
906
907
908
909







-
+








    assert(oldState->nins == 0);
    assert(oldState->ins == NULL);
}

/*
 - copyins - copy in arcs of a state to another state
 ^ static void copyins(struct nfa *, struct state *, struct state *, int);
 ^ static VOID copyins(struct nfa *, struct state *, struct state *, int);
 */
static void
copyins(
    struct nfa *nfa,
    struct state *oldState,
    struct state *newState)
{
1012
1013
1014
1015
1016
1017
1018
1019

1020
1021
1022
1023
1024
1025
1026
1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
1082







-
+







	createarc(nfa, a->type, a->co, a->from, s);
	i++;
    }
}

/*
 - moveouts - move all out arcs of a state to another state
 ^ static void moveouts(struct nfa *, struct state *, struct state *);
 ^ static VOID moveouts(struct nfa *, struct state *, struct state *);
 */
static void
moveouts(
    struct nfa *nfa,
    struct state *oldState,
    struct state *newState)
{
1096
1097
1098
1099
1100
1101
1102
1103

1104
1105
1106
1107
1108
1109
1110
1152
1153
1154
1155
1156
1157
1158

1159
1160
1161
1162
1163
1164
1165
1166







-
+








    assert(oldState->nouts == 0);
    assert(oldState->outs == NULL);
}

/*
 - copyouts - copy out arcs of a state to another state
 ^ static void copyouts(struct nfa *, struct state *, struct state *, int);
 ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int);
 */
static void
copyouts(
    struct nfa *nfa,
    struct state *oldState,
    struct state *newState)
{
1172
1173
1174
1175
1176
1177
1178
1179

1180
1181
1182
1183
1184
1185
1186
1228
1229
1230
1231
1232
1233
1234

1235
1236
1237
1238
1239
1240
1241
1242







-
+







	    createarc(nfa, a->type, a->co, newState, a->to);
	}
    }
}

/*
 - cloneouts - copy out arcs of a state to another state pair, modifying type
 ^ static void cloneouts(struct nfa *, struct state *, struct state *,
 ^ static VOID cloneouts(struct nfa *, struct state *, struct state *,
 ^ 	struct state *, int);
 */
static void
cloneouts(
    struct nfa *nfa,
    struct state *old,
    struct state *from,
1196
1197
1198
1199
1200
1201
1202
1203

1204
1205
1206
1207
1208
1209
1210
1252
1253
1254
1255
1256
1257
1258

1259
1260
1261
1262
1263
1264
1265
1266







-
+







    }
}

/*
 - delsub - delete a sub-NFA, updating subre pointers if necessary
 * This uses a recursive traversal of the sub-NFA, marking already-seen
 * states using their tmp pointer.
 ^ static void delsub(struct nfa *, struct state *, struct state *);
 ^ static VOID delsub(struct nfa *, struct state *, struct state *);
 */
static void
delsub(
    struct nfa *nfa,
    struct state *lp,		/* the sub-NFA goes from here... */
    struct state *rp)		/* ...to here, *not* inclusive */
{
1219
1220
1221
1222
1223
1224
1225
1226

1227
1228
1229
1230
1231
1232
1233
1275
1276
1277
1278
1279
1280
1281

1282
1283
1284
1285
1286
1287
1288
1289







-
+







    rp->tmp = NULL;		/* unmark end */
    lp->tmp = NULL;		/* and begin, marked by deltraverse */
}

/*
 - deltraverse - the recursive heart of delsub
 * This routine's basic job is to destroy all out-arcs of the state.
 ^ static void deltraverse(struct nfa *, struct state *, struct state *);
 ^ static VOID deltraverse(struct nfa *, struct state *, struct state *);
 */
static void
deltraverse(
    struct nfa *nfa,
    struct state *leftend,
    struct state *s)
{
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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361

1362
1363
1364
1365
1366
1367
1368
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
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
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







-
+
















-
+








-
+





-
+
-













-
-
-
-
-
-
-
-
-
-
-
-

-
+










-
+




















-
+







}

/*
 - dupnfa - duplicate sub-NFA
 * Another recursive traversal, this time using tmp to point to duplicates as
 * well as mark already-seen states. (You knew there was a reason why it's a
 * state pointer, didn't you? :-))
 ^ static void dupnfa(struct nfa *, struct state *, struct state *,
 ^ static VOID dupnfa(struct nfa *, struct state *, struct state *,
 ^ 	struct state *, struct state *);
 */
static void
dupnfa(
    struct nfa *nfa,
    struct state *start,	/* duplicate of subNFA starting here */
    struct state *stop,		/* and stopping here */
    struct state *from,		/* stringing duplicate from here */
    struct state *to)		/* to here */
{
    if (start == stop) {
	newarc(nfa, EMPTY, 0, from, to);
	return;
    }

    stop->tmp = to;
    duptraverse(nfa, start, from, 0);
    duptraverse(nfa, start, from);
    /* done, except for clearing out the tmp pointers */

    stop->tmp = NULL;
    cleartraverse(nfa, start);
}

/*
 - duptraverse - recursive heart of dupnfa
 ^ static void duptraverse(struct nfa *, struct state *, struct state *);
 ^ static VOID duptraverse(struct nfa *, struct state *, struct state *);
 */
static void
duptraverse(
    struct nfa *nfa,
    struct state *s,
    struct state *stmp,		/* s's duplicate, or NULL */
    struct state *stmp)		/* s's duplicate, or NULL */
    int depth)
{
    struct arc *a;

    if (s->tmp != NULL) {
	return;			/* already done */
    }

    s->tmp = (stmp == NULL) ? newstate(nfa) : stmp;
    if (s->tmp == NULL) {
	assert(NISERR());
	return;
    }

    /*
     * Arbitrary depth limit. Needs tuning, but this value is sufficient to
     * make all normal tests (not reg-33.14) pass.
     */
#ifndef DUPTRAVERSE_MAX_DEPTH
#define DUPTRAVERSE_MAX_DEPTH 15000
#endif

    if (depth++ > DUPTRAVERSE_MAX_DEPTH) {
	NERR(REG_ESPACE);
    }

    for (a=s->outs ; a!=NULL && !NISERR() ; a=a->outchain) {
	duptraverse(nfa, a->to, NULL, depth);
	duptraverse(nfa, a->to, NULL);
	if (NISERR()) {
	    break;
	}
	assert(a->to->tmp != NULL);
	cparc(nfa, a, s->tmp, a->to->tmp);
    }
}

/*
 - cleartraverse - recursive cleanup for algorithms that leave tmp ptrs set
 ^ static void cleartraverse(struct nfa *, struct state *);
 ^ static VOID cleartraverse(struct nfa *, struct state *);
 */
static void
cleartraverse(
    struct nfa *nfa,
    struct state *s)
{
    struct arc *a;

    if (s->tmp == NULL) {
	return;
    }
    s->tmp = NULL;

    for (a=s->outs ; a!=NULL ; a=a->outchain) {
	cleartraverse(nfa, a->to);
    }
}

/*
 - specialcolors - fill in special colors for an NFA
 ^ static void specialcolors(struct nfa *);
 ^ static VOID specialcolors(struct nfa *);
 */
static void
specialcolors(
    struct nfa *nfa)
{
    /*
     * False colors for BOS, BOL, EOS, EOL
1437
1438
1439
1440
1441
1442
1443
1444

1445
1446
1447
1448
1449
1450
1451
1480
1481
1482
1483
1484
1485
1486

1487
1488
1489
1490
1491
1492
1493
1494







-
+







    }
#endif
    return analyze(nfa);	/* and analysis */
}

/*
 - pullback - pull back constraints backward to eliminate them
 ^ static void pullback(struct nfa *, FILE *);
 ^ static VOID pullback(struct nfa *, FILE *);
 */
static void
pullback(
    struct nfa *nfa,
    FILE *f)			/* for debug output; NULL none */
{
    struct state *s;
1617
1618
1619
1620
1621
1622
1623
1624

1625
1626
1627
1628
1629
1630
1631
1660
1661
1662
1663
1664
1665
1666

1667
1668
1669
1670
1671
1672
1673
1674







-
+







    freearc(nfa, con);
    /* from state is now useless, but we leave it to pullback() to clean up */
    return 1;
}

/*
 - pushfwd - push forward constraints forward to eliminate them
 ^ static void pushfwd(struct nfa *, FILE *);
 ^ static VOID pushfwd(struct nfa *, FILE *);
 */
static void
pushfwd(
    struct nfa *nfa,
    FILE *f)			/* for debug output; NULL none */
{
    struct state *s;
1856
1857
1858
1859
1860
1861
1862
1863

1864
1865
1866
1867
1868
1869
1870
1899
1900
1901
1902
1903
1904
1905

1906
1907
1908
1909
1910
1911
1912
1913







-
+







    }
    assert(NOTREACHED);
    return INCOMPATIBLE;	/* for benefit of blind compilers */
}

/*
 - fixempties - get rid of EMPTY arcs
 ^ static void fixempties(struct nfa *, FILE *);
 ^ static VOID fixempties(struct nfa *, FILE *);
 */
static void
fixempties(
    struct nfa *nfa,
    FILE *f)			/* for debug output; NULL none */
{
    struct state *s;
2016
2017
2018
2019
2020
2021
2022
2023

2024
2025
2026
2027
2028
2029
2030
2059
2060
2061
2062
2063
2064
2065

2066
2067
2068
2069
2070
2071
2072
2073







-
+







	for (s2 = emptyreachable(nfa, s, s, inarcsorig); s2 != s; s2 = nexts) {
	    /* Add s2's original inarcs to arcarray[], but ignore empties */
	    for (a = inarcsorig[s2->no]; a != NULL; a = a->inchain) {
		if (a->type != EMPTY) {
		    arcarray[arccount++] = a;
		}
	    }

  
  	    /* Reset the tmp fields as we walk back */
  	    nexts = s2->tmp;
  	    s2->tmp = NULL;
  	}
  	s->tmp = NULL;
	assert(arccount <= totalinarcs);

2038
2039
2040
2041
2042
2043
2044
2045

2046
2047
2048
2049
2050
2051
2052
2081
2082
2083
2084
2085
2086
2087

2088
2089
2090
2091
2092
2093
2094
2095







-
+







	nskip = s->nins - prevnins;
	a = s->ins;
	while (nskip-- > 0) {
	    a = a->inchain;
	}
	inarcsorig[s->no] = a;
    }

  
    FREE(arcarray);
    FREE(inarcsorig);

    if (NISERR()) {
	return;
    }

2189
2190
2191
2192
2193
2194
2195
2196

2197
2198
2199
2200
2201
2202
2203
2232
2233
2234
2235
2236
2237
2238

2239
2240
2241
2242
2243
2244
2245
2246







-
+







	    }
	}
 	/* If we removed all the outarcs, the state is useless. */
 	if (s->nouts == 0 && !s->flag) {
 	    dropstate(nfa, s);
	}
    }

 
    /* Nothing to do if no remaining constraint arcs */
    if (NISERR() || !hasconstraints) {
	return;
    }

    /*
     * Starting from each remaining NFA state, search outwards for a
2679
2680
2681
2682
2683
2684
2685
2686

2687
2688
2689
2690
2691
2692
2693
2722
2723
2724
2725
2726
2727
2728

2729
2730
2731
2732
2733
2734
2735
2736







-
+







	/* Don't forget to free sclone's donemap when done with it */
	FREE(donemap);
    }
}

/*
 - cleanup - clean up NFA after optimizations
 ^ static void cleanup(struct nfa *);
 ^ static VOID cleanup(struct nfa *);
 */
static void
cleanup(
    struct nfa *nfa)
{
    struct state *s;
    struct state *nexts;
2720
2721
2722
2723
2724
2725
2726
2727

2728
2729
2730
2731
2732
2733
2734
2763
2764
2765
2766
2767
2768
2769

2770
2771
2772
2773
2774
2775
2776
2777







-
+







	s->no = n++;
    }
    nfa->nstates = n;
}

/*
 - markreachable - recursive marking of reachable states
 ^ static void markreachable(struct nfa *, struct state *, struct state *,
 ^ static VOID markreachable(struct nfa *, struct state *, struct state *,
 ^ 	struct state *);
 */
static void
markreachable(
    struct nfa *nfa,
    struct state *s,
    struct state *okay,		/* consider only states with this mark */
2744
2745
2746
2747
2748
2749
2750
2751

2752
2753
2754
2755
2756
2757
2758
2787
2788
2789
2790
2791
2792
2793

2794
2795
2796
2797
2798
2799
2800
2801







-
+







    for (a = s->outs; a != NULL; a = a->outchain) {
	markreachable(nfa, a->to, okay, mark);
    }
}

/*
 - markcanreach - recursive marking of states which can reach here
 ^ static void markcanreach(struct nfa *, struct state *, struct state *,
 ^ static VOID markcanreach(struct nfa *, struct state *, struct state *,
 ^ 	struct state *);
 */
static void
markcanreach(
    struct nfa *nfa,
    struct state *s,
    struct state *okay,		/* consider only states with this mark */
2792
2793
2794
2795
2796
2797
2798
2799

2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819


2820
2821
2822
2823
2824
2825

2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2835
2836
2837
2838
2839
2840
2841

2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861

2862
2863
2864
2865

2866
2867

2868



2869
2870
2871
2872
2873
2874
2875







-
+



















-
+
+


-


-
+
-
-
-







	}
    }
    return 0;
}

/*
 - compact - construct the compact representation of an NFA
 ^ static void compact(struct nfa *, struct cnfa *);
 ^ static VOID compact(struct nfa *, struct cnfa *);
 */
static void
compact(
    struct nfa *nfa,
    struct cnfa *cnfa)
{
    struct state *s;
    struct arc *a;
    size_t nstates;
    size_t narcs;
    struct carc *ca;
    struct carc *first;

    assert(!NISERR());

    nstates = 0;
    narcs = 0;
    for (s = nfa->states; s != NULL; s = s->next) {
	nstates++;
	narcs += s->nouts + 1;	/* need one extra for endmarker */
	narcs += 1 + s->nouts + 1;
	/* 1 as a fake for flags, nouts for arcs, 1 as endmarker */
    }

    cnfa->stflags = (char *) MALLOC(nstates * sizeof(char));
    cnfa->states = (struct carc **) MALLOC(nstates * sizeof(struct carc *));
    cnfa->arcs = (struct carc *) MALLOC(narcs * sizeof(struct carc));
    if (cnfa->stflags == NULL || cnfa->states == NULL || cnfa->arcs == NULL) {
    if (cnfa->states == NULL || cnfa->arcs == NULL) {
	if (cnfa->stflags != NULL) {
	    FREE(cnfa->stflags);
	}
	if (cnfa->states != NULL) {
	    FREE(cnfa->states);
	}
	if (cnfa->arcs != NULL) {
	    FREE(cnfa->arcs);
	}
	NERR(REG_ESPACE);
2844
2845
2846
2847
2848
2849
2850
2851
2852


2853
2854
2855
2856
2857
2858
2859
2884
2885
2886
2887
2888
2889
2890

2891
2892
2893
2894
2895
2896
2897
2898
2899
2900







-

+
+







    cnfa->eos[1] = nfa->eos[1];
    cnfa->ncolors = maxcolor(nfa->cm) + 1;
    cnfa->flags = 0;

    ca = cnfa->arcs;
    for (s = nfa->states; s != NULL; s = s->next) {
	assert((size_t) s->no < nstates);
	cnfa->stflags[s->no] = 0;
	cnfa->states[s->no] = ca;
	ca->co = 0;		/* clear and skip flags "arc" */
	ca++;
	first = ca;
	for (a = s->outs; a != NULL; a = a->outchain) {
	    switch (a->type) {
	    case PLAIN:
		ca->co = a->co;
		ca->to = a->to->no;
		ca++;
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
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







-
+

-
+




-
+


















-
+

















-
+







-






-
+







    assert(cnfa->nstates != 0);

    /*
     * Mark no-progress states.
     */

    for (a = nfa->pre->outs; a != NULL; a = a->outchain) {
	cnfa->stflags[a->to->no] = CNFA_NOPROGRESS;
	cnfa->states[a->to->no]->co = 1;
    }
    cnfa->stflags[nfa->pre->no] = CNFA_NOPROGRESS;
    cnfa->states[nfa->pre->no]->co = 1;
}

/*
 - carcsort - sort compacted-NFA arcs by color
 ^ static void carcsort(struct carc *, struct carc *);
 ^ static VOID carcsort(struct carc *, struct carc *);
 */
static void
carcsort(
    struct carc *first,
    size_t n)
{
    if (n > 1) {
	qsort(first, n, sizeof(struct carc), carc_cmp);
    }
}

static int
carc_cmp(
    const void *a,
    const void *b)
{
    const struct carc *aa = (const struct carc *) a;
    const struct carc *bb = (const struct carc *) b;

  
    if (aa->co < bb->co) {
	return -1;
    }
    if (aa->co > bb->co) {
	return +1;
    }
    if (aa->to < bb->to) {
	return -1;
    }
    if (aa->to > bb->to) {
	return +1;
    }
    return 0;
}

/*
 - freecnfa - free a compacted NFA
 ^ static void freecnfa(struct cnfa *);
 ^ static VOID freecnfa(struct cnfa *);
 */
static void
freecnfa(
    struct cnfa *cnfa)
{
    assert(cnfa->nstates != 0);	/* not empty already */
    cnfa->nstates = 0;
    FREE(cnfa->stflags);
    FREE(cnfa->states);
    FREE(cnfa->arcs);
}

/*
 - dumpnfa - dump an NFA in human-readable form
 ^ static void dumpnfa(struct nfa *, FILE *);
 ^ static VOID dumpnfa(struct nfa *, FILE *);
 */
static void
dumpnfa(
    struct nfa *nfa,
    FILE *f)
{
#ifdef REG_DEBUG
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
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







-
-
-










-
+







	narcs += s->nouts;
    }
    fprintf(f, "total of %d states, %d arcs\n", nstates, narcs);
    if (nfa->parent == NULL) {
	dumpcolors(nfa->cm, f);
    }
    fflush(f);
#else
    (void)nfa;
    (void)f;
#endif
}

#ifdef REG_DEBUG		/* subordinates of dumpnfa */
/*
 ^ #ifdef REG_DEBUG
 */

/*
 - dumpstate - dump an NFA state in human-readable form
 ^ static void dumpstate(struct state *, FILE *);
 ^ static VOID dumpstate(struct state *, FILE *);
 */
static void
dumpstate(
    struct state *s,
    FILE *f)
{
    struct arc *a;
3017
3018
3019
3020
3021
3022
3023
3024

3025
3026
3027
3028
3029
3030
3031
3054
3055
3056
3057
3058
3059
3060

3061
3062
3063
3064
3065
3066
3067
3068







-
+







		    a->from->no, a->to->no, s->no);
	}
    }
}

/*
 - dumparcs - dump out-arcs in human-readable form
 ^ static void dumparcs(struct state *, FILE *);
 ^ static VOID dumparcs(struct state *, FILE *);
 */
static void
dumparcs(
    struct state *s,
    FILE *f)
{
    int pos;
3051
3052
3053
3054
3055
3056
3057
3058

3059
3060
3061
3062
3063
3064
3065
3088
3089
3090
3091
3092
3093
3094

3095
3096
3097
3098
3099
3100
3101
3102







-
+







    if (pos != 1) {
	fprintf(f, "\n");
    }
}

/*
 - dumparc - dump one outarc in readable form, including prefixing tab
 ^ static void dumparc(struct arc *, struct state *, FILE *);
 ^ static VOID dumparc(struct arc *, struct state *, FILE *);
 */
static void
dumparc(
    struct arc *a,
    struct state *s,
    FILE *f)
{
3125
3126
3127
3128
3129
3130
3131
3132

3133
3134
3135
3136
3137
3138
3139
3162
3163
3164
3165
3166
3167
3168

3169
3170
3171
3172
3173
3174
3175
3176







-
+







/*
 ^ #endif
 */
#endif				/* ifdef REG_DEBUG */

/*
 - dumpcnfa - dump a compacted NFA in human-readable form
 ^ static void dumpcnfa(struct cnfa *, FILE *);
 ^ static VOID dumpcnfa(struct cnfa *, FILE *);
 */
static void
dumpcnfa(
    struct cnfa *cnfa,
    FILE *f)
{
#ifdef REG_DEBUG
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
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







-
+


-
-
-










-
+




+



-
+


-
+

-
-
-
+
+
+

-
+








-
+







	fprintf(f, ", eol [%ld]", (long) cnfa->eos[1]);
    }
    if (cnfa->flags&HASLACONS) {
	fprintf(f, ", haslacons");
    }
    fprintf(f, "\n");
    for (st = 0; st < cnfa->nstates; st++) {
	dumpcstate(st, cnfa, f);
	dumpcstate(st, cnfa->states[st], cnfa, f);
    }
    fflush(f);
#else
    (void)cnfa;
    (void)f;
#endif
}

#ifdef REG_DEBUG		/* subordinates of dumpcnfa */
/*
 ^ #ifdef REG_DEBUG
 */

/*
 - dumpcstate - dump a compacted-NFA state in human-readable form
 ^ static void dumpcstate(int, struct cnfa *, FILE *);
 ^ static VOID dumpcstate(int, struct carc *, struct cnfa *, FILE *);
 */
static void
dumpcstate(
    int st,
    struct carc *ca,
    struct cnfa *cnfa,
    FILE *f)
{
    struct carc *ca;
    int i;
    int pos;

    fprintf(f, "%d%s", st, (cnfa->stflags[st] & CNFA_NOPROGRESS) ? ":" : ".");
    fprintf(f, "%d%s", st, (ca[0].co) ? ":" : ".");
    pos = 1;
    for (ca = cnfa->states[st]; ca->co != COLORLESS; ca++) {
	if (ca->co < cnfa->ncolors) {
	    fprintf(f, "\t[%ld]->%d", (long) ca->co, ca->to);
    for (i = 1; ca[i].co != COLORLESS; i++) {
	if (ca[i].co < cnfa->ncolors) {
	    fprintf(f, "\t[%ld]->%d", (long) ca[i].co, ca[i].to);
	} else {
	    fprintf(f, "\t:%ld:->%d", (long) (ca->co - cnfa->ncolors), ca->to);
	    fprintf(f, "\t:%ld:->%d", (long) ca[i].co-cnfa->ncolors,ca[i].to);
	}
	if (pos == 5) {
	    fprintf(f, "\n");
	    pos = 1;
	} else {
	    pos++;
	}
    }
    if (ca == cnfa->states[st] || pos != 1) {
    if (i == 1 || pos != 1) {
	fprintf(f, "\n");
    }
    fflush(f);
}

/*
 ^ #endif

Changes to generic/regcomp.c.

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
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







-
+
















-
+


+



















-
+


-
+
+
+
+







/*
 * forward declarations, up here so forward datatypes etc. are defined early
 */
/* =====^!^===== begin forwards =====^!^===== */
/* automatically gathered by fwd; do not hand-edit */
/* === regcomp.c === */
int compile(regex_t *, const chr *, size_t, int);
static void moresubs(struct vars *, size_t);
static void moresubs(struct vars *, int);
static int freev(struct vars *, int);
static void makesearch(struct vars *, struct nfa *);
static struct subre *parse(struct vars *, int, int, struct state *, struct state *);
static struct subre *parsebranch(struct vars *, int, int, struct state *, struct state *, int);
static void parseqatom(struct vars *, int, int, struct state *, struct state *, struct subre *);
static void nonword(struct vars *, int, struct state *, struct state *);
static void word(struct vars *, int, struct state *, struct state *);
static int scannum(struct vars *);
static void repeat(struct vars *, struct state *, struct state *, int, int);
static void bracket(struct vars *, struct state *, struct state *);
static void cbracket(struct vars *, struct state *, struct state *);
static void brackpart(struct vars *, struct state *, struct state *);
static const chr *scanplain(struct vars *);
static void onechr(struct vars *, pchr, struct state *, struct state *);
static void dovec(struct vars *, struct cvec *, struct state *, struct state *);
static void wordchrs(struct vars *);
static struct subre *sub_re(struct vars *, int, int, struct state *, struct state *);
static struct subre *subre(struct vars *, int, int, struct state *, struct state *);
static void freesubre(struct vars *, struct subre *);
static void freesrnode(struct vars *, struct subre *);
static void optst(struct vars *, struct subre *);
static int numst(struct subre *, int);
static void markst(struct subre *);
static void cleanst(struct vars *);
static long nfatree(struct vars *, struct subre *, FILE *);
static long nfanode(struct vars *, struct subre *, FILE *);
static int newlacon(struct vars *, struct state *, struct state *, int);
static void freelacons(struct subre *, int);
static void rfree(regex_t *);
static void dump(regex_t *, FILE *);
static void dumpst(struct subre *, FILE *, int);
static void stdump(struct subre *, FILE *, int);
static const char *stid(struct subre *, char *, size_t);
/* === regc_lex.c === */
static void lexstart(struct vars *);
static void prefixes(struct vars *);
static void lexnest(struct vars *, const chr *, const chr *);
static void lexword(struct vars *);
static int next(struct vars *);
static int lexescape(struct vars *);
static int lexdigits(struct vars *, int, int, int);
static chr lexdigits(struct vars *, int, int, int);
static int brenext(struct vars *, pchr);
static void skip(struct vars *);
static chr newline(void);
static chr newline(NOPARMS);
#ifdef REG_DEBUG
static const chr *ch(NOPARMS);
#endif
static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
/* === regc_color.c === */
static void initcm(struct vars *, struct colormap *);
static void freecm(struct colormap *);
static void cmtreefree(struct colormap *, union tree *, int);
static color setcolor(struct colormap *, pchr, pcolor);
static color maxcolor(struct colormap *);
131
132
133
134
135
136
137
138

139
140
141
142
143
144
145
135
136
137
138
139
140
141

142
143
144
145
146
147
148
149







-
+







static void mergeins(struct nfa *, struct state *, struct arc **, int);
static void moveouts(struct nfa *, struct state *, struct state *);
static void copyouts(struct nfa *, struct state *, struct state *);
static void cloneouts(struct nfa *, struct state *, struct state *, struct state *, int);
static void delsub(struct nfa *, struct state *, struct state *);
static void deltraverse(struct nfa *, struct state *, struct state *);
static void dupnfa(struct nfa *, struct state *, struct state *, struct state *, struct state *);
static void duptraverse(struct nfa *, struct state *, struct state *, int);
static void duptraverse(struct nfa *, struct state *, struct state *);
static void cleartraverse(struct nfa *, struct state *);
static void specialcolors(struct nfa *);
static long optimize(struct nfa *, FILE *);
static void pullback(struct nfa *, FILE *);
static int pull(struct nfa *, struct arc *, struct state **);
static void pushfwd(struct nfa *, FILE *);
static int push(struct nfa *, struct arc *, struct state **);
169
170
171
172
173
174
175
176

177
178
179
180
181
182
183
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187







-
+







#ifdef REG_DEBUG
static void dumpstate(struct state *, FILE *);
static void dumparcs(struct state *, FILE *);
static void dumparc(struct arc *, struct state *, FILE *);
#endif
static void dumpcnfa(struct cnfa *, FILE *);
#ifdef REG_DEBUG
static void dumpcstate(int, struct cnfa *, FILE *);
static void dumpcstate(int, struct carc *, struct cnfa *, FILE *);
#endif
/* === regc_cvec.c === */
static struct cvec *clearcvec(struct cvec *);
static void addchr(struct cvec *, pchr);
static void addrange(struct cvec *, pchr, pchr);
static struct cvec *newcvec(int, int);
static struct cvec *getcvec(struct vars *, int, int);
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
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







-
+

-
+










-
+



-
+
-








-
-
+
+




-
+




-







    const chr *stop;		/* end of string */
    const chr *savenow;		/* saved now and stop for "subroutine call" */
    const chr *savestop;
    int err;			/* error code (0 if none) */
    int cflags;			/* copy of compile flags */
    int lasttype;		/* type of previous token */
    int nexttype;		/* type of next token */
    size_t nextvalue;		/* value (if any) of next token */
    chr nextvalue;		/* value (if any) of next token */
    int lexcon;			/* lexical context type (see lex.c) */
    size_t nsubexp;		/* subexpression count */
    int nsubexp;		/* subexpression count */
    struct subre **subs;	/* subRE pointer vector */
    size_t nsubs;		/* length of vector */
    struct subre *sub10[10];	/* initial vector, enough for most */
    struct nfa *nfa;		/* the NFA */
    struct colormap *cm;	/* character color map */
    color nlcolor;		/* color of newline */
    struct state *wordchrs;	/* state in nfa holding word-char outarcs */
    struct subre *tree;		/* subexpression tree */
    struct subre *treechain;	/* all tree nodes allocated */
    struct subre *treefree;	/* any free tree nodes */
    int ntree;			/* number of tree nodes, plus one */
    int ntree;			/* number of tree nodes */
    struct cvec *cv;		/* interface cvec */
    struct cvec *cv2;		/* utility cvec */
    struct subre *lacons;	/* lookahead-constraint vector */
    size_t nlacons;		/* size of lacons */
    int nlacons;		/* size of lacons */
    size_t spaceused;		/* approx. space used for compilation */
};

/* parsing macros; most know that `v' is the struct vars pointer */
#define	NEXT()	(next(v))		/* advance by one token */
#define	SEE(t)	(v->nexttype == (t))	/* is next token this? */
#define	EAT(t)	(SEE(t) && next(v))	/* if next is this, swallow it */
#define	VISERR(vv)	((vv)->err != 0)/* have we seen an error yet? */
#define	ISERR()	VISERR(v)
#define VERR(vv,e)	((vv)->nexttype = EOS, \
			 (vv)->err = ((vv)->err ? (vv)->err : (e)))
#define	VERR(vv,e) \
	((vv)->nexttype = EOS, ((vv)->err) ? (vv)->err : ((vv)->err = (e)))
#define	ERR(e)	VERR(v, e)		/* record an error */
#define	NOERR()	{if (ISERR()) return;}	/* if error seen, return */
#define	NOERRN()	{if (ISERR()) return NULL;}	/* NOERR with retval */
#define	NOERRZ()	{if (ISERR()) return 0;}	/* NOERR with retval */
#define INSIST(c, e) do { if (!(c)) ERR(e); } while (0)	/* error if c false */
#define	INSIST(c, e)	((c) ? 0 : ERR(e))	/* if condition false, error */
#define	NOTE(b)	(v->re->re_info |= (b))		/* note visible condition */
#define	EMPTYARC(x, y)	newarc(v->nfa, EMPTY, 0, x, y)

/* token type codes, some also used as NFA arc types */
#undef	DIGIT /* prevent conflict with libtommath */
#define	EMPTY	'n'		/* no token present */
#define	EOS	'e'		/* end of string */
#define	PLAIN	'p'		/* ordinary character */
#define	DIGIT	'd'		/* digit (in bound) */
#define	BACKREF	'b'		/* back reference */
#define	COLLEL	'I'		/* start of [. */
#define	ECLASS	'E'		/* start of [= */
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
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







-
+





-
-











+
-
+







#define	PREFER	'P'		/* length preference */

/* is an arc colored, and hence on a color chain? */
#define	COLORED(a) \
	((a)->type == PLAIN || (a)->type == AHEAD || (a)->type == BEHIND)

/* static function list */
static const struct fns functions = {
static struct fns functions = {
    rfree,			/* regfree insides */
};

/*
 - compile - compile regular expression
 * Note: on failure, no resources remain allocated, so regfree()
 * need not be applied to re.
 ^ int compile(regex_t *, const chr *, size_t, int);
 */
int
compile(
    regex_t *re,
    const chr *string,
    size_t len,
    int flags)
{
    AllocVars(v);
    struct guts *g;
    int i;
    size_t i, j;
    size_t j;
    FILE *debug = (flags&REG_PROGRESS) ? stdout : NULL;
#define	CNOERR()	{ if (ISERR()) return freev(v, v->err); }

    /*
     * Sanity checks.
     */

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
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







-


+

-
+





-
+







    v->tree = NULL;
    v->treechain = NULL;
    v->treefree = NULL;
    v->cv = NULL;
    v->cv2 = NULL;
    v->lacons = NULL;
    v->nlacons = 0;
    v->spaceused = 0;
    re->re_magic = REMAGIC;
    re->re_info = 0;		/* bits get set during parse */
    re->re_csize = sizeof(chr);
    re->re_guts = NULL;
    re->re_fns = (void*)(&functions);
    re->re_fns = VS(&functions);

    /*
     * More complex setup, malloced things.
     */

    re->re_guts = (void*)(MALLOC(sizeof(struct guts)));
    re->re_guts = VS(MALLOC(sizeof(struct guts)));
    if (re->re_guts == NULL) {
	return freev(v, REG_ESPACE);
    }
    g = (struct guts *) re->re_guts;
    g->tree = NULL;
    initcm(v, &g->cmap);
    v->cm = &g->cmap;
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
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







+

















-
+




















-
+







    specialcolors(v->nfa);
    CNOERR();
    if (debug != NULL) {
	fprintf(debug, "\n\n\n========= RAW ==========\n");
	dumpnfa(v->nfa, debug);
	dumpst(v->tree, debug, 1);
    }
    optst(v, v->tree);
    v->ntree = numst(v->tree, 1);
    markst(v->tree);
    cleanst(v);
    if (debug != NULL) {
	fprintf(debug, "\n\n\n========= TREE FIXED ==========\n");
	dumpst(v->tree, debug, 1);
    }

    /*
     * Build compacted NFAs for tree and lacons.
     */

    re->re_info |= nfatree(v, v->tree, debug);
    CNOERR();
    assert(v->nlacons == 0 || v->lacons != NULL);
    for (i = 1; i < v->nlacons; i++) {
	if (debug != NULL) {
	    fprintf(debug, "\n\n\n========= LA%" TCL_Z_MODIFIER "d ==========\n", i);
	    fprintf(debug, "\n\n\n========= LA%d ==========\n", i);
	}
	nfanode(v, &v->lacons[i], debug);
    }
    CNOERR();
    if (v->tree->flags&SHORTER) {
	NOTE(REG_USHORTEST);
    }

    /*
     * Build compacted NFAs for tree, lacons, fast search.
     */

    if (debug != NULL) {
	fprintf(debug, "\n\n\n========= SEARCH ==========\n");
    }

    /*
     * Can sacrifice main NFA now, so use it as work area.
     */

    (void) optimize(v->nfa, debug);
    (DISCARD) optimize(v->nfa, debug);
    CNOERR();
    makesearch(v, v->nfa);
    CNOERR();
    compact(v->nfa, &g->search);
    CNOERR();

    /*
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
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







-
+




-
+




-
-
+
+


















-
+













-
+








    assert(v->err == 0);
    return freev(v, 0);
}

/*
 - moresubs - enlarge subRE vector
 ^ static void moresubs(struct vars *, size_t);
 ^ static void moresubs(struct vars *, int);
 */
static void
moresubs(
    struct vars *v,
    size_t wanted)			/* want enough room for this one */
    int wanted)			/* want enough room for this one */
{
    struct subre **p;
    size_t n;

    assert(wanted > 0 && wanted >= v->nsubs);
    n = wanted * 3 / 2 + 1;
    assert(wanted > 0 && (size_t)wanted >= v->nsubs);
    n = (size_t)wanted * 3 / 2 + 1;
    if (v->subs == v->sub10) {
	p = (struct subre **) MALLOC(n * sizeof(struct subre *));
	if (p != NULL) {
	    memcpy(p, v->subs, v->nsubs * sizeof(struct subre *));
	}
    } else {
	p = (struct subre **) REALLOC(v->subs, n*sizeof(struct subre *));
    }
    if (p == NULL) {
	ERR(REG_ESPACE);
	return;
    }

    v->subs = p;
    for (p = &v->subs[v->nsubs]; v->nsubs < n; p++, v->nsubs++) {
	*p = NULL;
    }
    assert(v->nsubs == n);
    assert(wanted < v->nsubs);
    assert((size_t)wanted < v->nsubs);
}

/*
 - freev - free vars struct's substructures where necessary
 * Optionally does error-number setting, and always returns error code (if
 * any), to make error-handling code terser.
 ^ static int freev(struct vars *, int);
 */
static int
freev(
    struct vars *v,
    int err)
{
    int ret;
    register int ret;

    if (v->re != NULL) {
	rfree(v->re);
    }
    if (v->subs != v->sub10) {
	FREE(v->subs);
    }
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
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







-
+









-
+







    struct subre *branches;	/* top level */
    struct subre *branch;	/* current branch */
    struct subre *t;		/* temporary */
    int firstbranch;		/* is this the first branch? */

    assert(stopper == ')' || stopper == EOS);

    branches = sub_re(v, '|', LONGER, init, final);
    branches = subre(v, '|', LONGER, init, final);
    NOERRN();
    branch = branches;
    firstbranch = 1;
    do {	/* a branch */
	if (!firstbranch) {
	    /*
	     * Need a place to hang the branch.
	     */

	    branch->right = sub_re(v, '|', LONGER, init, final);
	    branch->right = subre(v, '|', LONGER, init, final);
	    NOERRN();
	    branch = branch->right;
	}
	firstbranch = 0;
	left = newstate(v->nfa);
	right = newstate(v->nfa);
	NOERRN();
739
740
741
742
743
744
745
746

747
748
749
750
751
752
753
741
742
743
744
745
746
747

748
749
750
751
752
753
754
755







-
+







{
    struct state *lp;		/* left end of current construct */
    int seencontent;		/* is there anything in this branch yet? */
    struct subre *t;

    lp = left;
    seencontent = 0;
    t = sub_re(v, '=', 0, left, right);	/* op '=' is tentative */
    t = subre(v, '=', 0, left, right);	/* op '=' is tentative */
    NOERRN();
    while (!SEE('|') && !SEE(stopper) && !SEE(EOS)) {
	if (seencontent) {	/* implicit concat operator */
	    lp = newstate(v->nfa);
	    NOERRN();
	    moveins(v->nfa, right, lp);
	}
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
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







-
+












-
+







    struct state *s2;
#define	ARCV(t, val)	newarc(v->nfa, t, val, lp, rp)
    int m, n;
    struct subre *atom;		/* atom's subtree */
    struct subre *t;
    int cap;			/* capturing parens? */
    int pos;			/* positive lookahead? */
    size_t subno;		/* capturing-parens or backref number */
    int subno;			/* capturing-parens or backref number */
    int atomtype;
    int qprefer;		/* quantifier short/long preference */
    int f;
    struct subre **atomp;	/* where the pointer to atom is */

    /*
     * Initial bookkeeping.
     */

    atom = NULL;
    assert(lp->nouts == 0);	/* must string new code */
    assert(rp->nins == 0);	/* between lp and rp */
    subno = 0;
    subno = 0;			/* just to shut lint up */

    /*
     * An atom or constraint...
     */

    atomtype = v->nexttype;
    switch (atomtype) {
947
948
949
950
951
952
953
954

955
956
957

958
959
960
961
962
963
964
949
950
951
952
953
954
955

956
957
958

959
960
961
962
963
964
965
966







-
+


-
+







	 */

    case '(':			/* value flags as capturing or non */
	cap = (type == LACON) ? 0 : v->nextvalue;
	if (cap) {
	    v->nsubexp++;
	    subno = v->nsubexp;
	    if (subno >= v->nsubs) {
	    if ((size_t)subno >= v->nsubs) {
		moresubs(v, subno);
	    }
	    assert(subno < v->nsubs);
	    assert((size_t)subno < v->nsubs);
	} else {
	    atomtype = PLAIN;	/* something that's not '(' */
	}
	NEXT();

	/*
	 * Need new endpoints because tree will contain pointers.
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
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







-
+

















-
+







	NOERR();
	atom = parse(v, ')', PLAIN, s, s2);
	assert(SEE(')') || ISERR());
	NEXT();
	NOERR();
	if (cap) {
	    v->subs[subno] = atom;
	    t = sub_re(v, '(', atom->flags|CAP, lp, rp);
	    t = subre(v, '(', atom->flags|CAP, lp, rp);
	    NOERR();
	    t->subno = subno;
	    t->left = atom;
	    atom = t;
	}

	/*
	 * Postpone everything else pending possible {0}.
	 */

	break;
    case BACKREF:		/* the Feature From The Black Lagoon */
	INSIST(type != LACON, REG_ESUBREG);
	INSIST(v->nextvalue < v->nsubs, REG_ESUBREG);
	INSIST(v->subs[v->nextvalue] != NULL, REG_ESUBREG);
	NOERR();
	assert(v->nextvalue > 0);
	atom = sub_re(v, 'b', BACKR, lp, rp);
	atom = subre(v, 'b', BACKR, lp, rp);
	NOERR();
	subno = v->nextvalue;
	atom->subno = subno;
	EMPTYARC(lp, rp);	/* temporarily, so there's something */
	NEXT();
	break;
    }
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
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
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
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







-
+






-
-
-
+
+
+

-
+
-
-
-
-
-
-










-
+
+


+






-
+













-
+







     */

    /*
     * Now we'll need a subre for the contents even if they're boring.
     */

    if (atom == NULL) {
	atom = sub_re(v, '=', 0, lp, rp);
	atom = subre(v, '=', 0, lp, rp);
	NOERR();
    }

    /*
     * Prepare a general-purpose state skeleton.
     *
     * In the no-backrefs case, we want this:
     *
     * [lp] ---> [s] ---prefix---> [begin] ---atom---> [end] ---rest---> [rp]
     *    ---> [s] ---prefix---> [begin] ---atom---> [end] ----rest---> [rp]
     *   /                                            /
     * [lp] ----> [s2] ----bypass---------------------
     *
     * where prefix is some repetitions of atom.  In the general case we need
     * where bypass is an empty, and prefix is some repetitions of atom
     *
     * [lp] ---> [s] ---iterator---> [s2] ---rest---> [rp]
     *
     * where the iterator wraps around [begin] ---atom---> [end]
     *
     * We make the s state here for both cases; s2 is made below if needed
     */

    s = newstate(v->nfa);	/* first, new endpoints for the atom */
    s2 = newstate(v->nfa);
    NOERR();
    moveouts(v->nfa, lp, s);
    moveins(v->nfa, rp, s2);
    NOERR();
    atom->begin = s;
    atom->end = s2;
    s = newstate(v->nfa);	/* set up starting state */
    s = newstate(v->nfa);	/* and spots for prefix and bypass */
    s2 = newstate(v->nfa);
    NOERR();
    EMPTYARC(lp, s);
    EMPTYARC(lp, s2);
    NOERR();

    /*
     * Break remaining subRE into x{...} and what follows.
     */

    t = sub_re(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
    t = subre(v, '.', COMBINE(qprefer, atom->flags), lp, rp);
    NOERR();
    t->left = atom;
    atomp = &t->left;

    /*
     * Here we should recurse... but we must postpone that to the end.
     */

    /*
     * Split top into prefix and remaining.
     */

    assert(top->op == '=' && top->left == NULL && top->right == NULL);
    top->left = sub_re(v, '=', top->flags, top->begin, lp);
    top->left = subre(v, '=', top->flags, top->begin, lp);
    NOERR();
    top->op = '.';
    top->right = t;

    /*
     * If it's a backref, now is the time to replicate the subNFA.
     */
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
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







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

















-
-






-
-
-
+

-
-
+
-
-
-
-
+






-
+

-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+

-
-
+
+








	dupnfa(v->nfa, v->subs[subno]->begin, v->subs[subno]->end,
		atom->begin, atom->end);
	NOERR();
    }

    /*
     * It's quantifier time; first, turn x{0,...} into x{1,...}|empty
     */
     * It's quantifier time.  If the atom is just a backref, we'll let it deal
     * with quantifiers internally.

    if (m == 0) {
	EMPTYARC(s2, atom->end);/* the bypass */
	assert(PREF(qprefer) != 0);
	f = COMBINE(qprefer, atom->flags);
	t = subre(v, '|', f, lp, atom->end);
	NOERR();
	t->left = atom;
	t->right = subre(v, '|', PREF(f), s2, atom->end);
	NOERR();
	t->right->left = subre(v, '=', 0, s2, atom->end);
	NOERR();
	*atomp = t;
	atomp = &t->left;
	m = 1;
    }

    /*
     * Deal with the rest of the quantifier.
     */

    if (atomtype == BACKREF) {
	/*
	 * Special case: backrefs have internal quantifiers.
	 */

	EMPTYARC(s, atom->begin);	/* empty prefix */

	/*
	 * Just stuff everything into atom.
	 */

	repeat(v, atom->begin, atom->end, m, n);
	atom->min = (short) m;
	atom->max = (short) n;
	atom->flags |= COMBINE(qprefer, atom->flags);
	/* rest of branch can be strung starting from atom->end */
	s2 = atom->end;
    } else if (m == 1 && n == 1) {
	/*
	 * No/vacuous quantifier: done.
	 */

	EMPTYARC(s, atom->begin);	/* empty prefix */
	/* rest of branch can be strung starting from atom->end */
	s2 = atom->end;
    } else if (m > 0 && !(atom->flags & BACKR)) {
    } else {
	/*
	 * If there's no backrefs involved, we can turn x{m,n} into
	 * x{m-1,n-1}x, with capturing parens in only the second x.  This
	 * Turn x{m,n} into x{m-1,n-1}x, with capturing parens in only second
	 * is valid because we only care about capturing matches from the
	 * final iteration of the quantifier.  It's a win because we can
	 * implement the backref-free left side as a plain DFA node, since
	 * we don't really care where its submatches are.
	 * x
	 */

	dupnfa(v->nfa, atom->begin, atom->end, s, atom->begin);
	assert(m >= 1 && m != DUPINF && n >= 1);
	repeat(v, s, atom->begin, m-1, (n == DUPINF) ? n : n-1);
	f = COMBINE(qprefer, atom->flags);
	t = sub_re(v, '.', f, s, atom->end);	/* prefix and atom */
	t = subre(v, '.', f, s, atom->end);	/* prefix and atom */
	NOERR();
	t->left = sub_re(v, '=', PREF(f), s, atom->begin);
	t->left = subre(v, '=', PREF(f), s, atom->begin);
	NOERR();
	t->right = atom;
	*atomp = t;
	/* rest of branch can be strung starting from atom->end */
	s2 = atom->end;
    } else {
	/* general case: need an iteration node */
	s2 = newstate(v->nfa);
	NOERR();
	moveouts(v->nfa, atom->end, s2);
	NOERR();
	dupnfa(v->nfa, atom->begin, atom->end, s, s2);
	repeat(v, s, s2, m, n);
	f = COMBINE(qprefer, atom->flags);
	t = sub_re(v, '*', f, s, s2);
	NOERR();
	t->min = (short) m;
	t->max = (short) n;
	t->left = atom;
	*atomp = t;
	/* rest of branch is to be strung from iteration's end state */
    }

    /*
     * And finally, look after that postponed recursion.
     */

    t = top->right;
    if (!(SEE('|') || SEE(stopper) || SEE(EOS))) {
	t->right = parsebranch(v, stopper, type, s2, rp, 1);
	t->right = parsebranch(v, stopper, type, atom->end, rp, 1);
    } else {
	EMPTYARC(s2, rp);
	t->right = sub_re(v, '=', 0, s2, rp);
	EMPTYARC(atom->end, rp);
	t->right = subre(v, '=', 0, atom->end, rp);
    }
    NOERR();
    assert(SEE('|') || SEE(stopper) || SEE(EOS));
    t->flags |= COMBINE(t->flags, t->right->flags);
    top->flags |= COMBINE(top->flags, t->flags);
}

1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1318
1319
1320
1321
1322
1323
1324


1325
1326
1327
1328
1329
1330
1331







-
-







	return 0;
    }
    return n;
}

/*
 - repeat - replicate subNFA for quantifiers
 * The sub-NFA strung from lp to rp is modified to represent m to n
 * repetitions of its initial contents.
 * The duplication sequences used here are chosen carefully so that any
 * pointers starting out pointing into the subexpression end up pointing into
 * the last occurrence. (Note that it may not be strung between the same left
 * and right end states, however!) This used to be important for the subRE
 * tree, although the important bits are now handled by the in-line code in
 * parse(), and when this is called, it doesn't matter any more.
 ^ static void repeat(struct vars *, struct state *, struct state *, int, int);
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
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







-
+











-
+







-
+


-
+







    struct vars *v,
    struct state *lp,
    struct state *rp)
{
    celt startc, endc;
    struct cvec *cv;
    const chr *startp, *endp;
    chr c;
    chr c[1];

    /*
     * Parse something, get rid of special cases, take shortcuts.
     */

    switch (v->nexttype) {
    case RANGE:			/* a-b-c or other botch */
	ERR(REG_ERANGE);
	return;
	break;
    case PLAIN:
	c = v->nextvalue;
	c[0] = v->nextvalue;
	NEXT();

	/*
	 * Shortcut for ordinary chr (not range).
	 */

	if (!SEE(RANGE)) {
	    onechr(v, c, lp, rp);
	    onechr(v, c[0], lp, rp);
	    return;
	}
	startc = element(v, &c, &c+1);
	startc = element(v, c, c+1);
	NOERR();
	break;
    case COLLEL:
	startp = v->now;
	endp = scanplain(v);
	INSIST(startp < endp, REG_ECOLLATE);
	NOERR();
1556
1557
1558
1559
1560
1561
1562
1563

1564
1565

1566
1567
1568
1569
1570
1571
1572
1545
1546
1547
1548
1549
1550
1551

1552
1553

1554
1555
1556
1557
1558
1559
1560
1561







-
+

-
+







    }

    if (SEE(RANGE)) {
	NEXT();
	switch (v->nexttype) {
	case PLAIN:
	case RANGE:
	    c = v->nextvalue;
	    c[0] = v->nextvalue;
	    NEXT();
	    endc = element(v, &c, &c+1);
	    endc = element(v, c, c+1);
	    NOERR();
	    break;
	case COLLEL:
	    startp = v->now;
	    endp = scanplain(v);
	    INSIST(startp < endp, REG_ECOLLATE);
	    NOERR();
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
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







-
-
+
+



-
+




















-
+



-
+







    assert((v->savenow != NULL && SEE(']')) || ISERR());
    NEXT();
    NOERR();
    v->wordchrs = left;
}

/*
 - sub_re - allocate a subre
 ^ static struct subre *sub_re(struct vars *, int, int, struct state *,
 - subre - allocate a subre
 ^ static struct subre *subre(struct vars *, int, int, struct state *,
 ^	struct state *);
 */
static struct subre *
sub_re(
subre(
    struct vars *v,
    int op,
    int flags,
    struct state *begin,
    struct state *end)
{
    struct subre *ret = v->treefree;

    if (ret != NULL) {
	v->treefree = ret->left;
    } else {
	ret = (struct subre *) MALLOC(sizeof(struct subre));
	if (ret == NULL) {
	    ERR(REG_ESPACE);
	    return NULL;
	}
	ret->chain = v->treechain;
	v->treechain = ret;
    }

    assert(strchr("=b|.*(", op) != NULL);
    assert(strchr("|.b(=", op) != NULL);

    ret->op = op;
    ret->flags = flags;
    ret->id = 0;		/* will be assigned later */
    ret->retry = 0;
    ret->subno = 0;
    ret->min = ret->max = 1;
    ret->left = NULL;
    ret->right = NULL;
    ret->begin = begin;
    ret->end = end;
    ZAPCNFA(ret->cnfa);
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
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
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
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







-
+
-








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












-
+











-
-
-
-
-
-
-
-
-
-
-
-
-







    }

    if (!NULLCNFA(sr->cnfa)) {
	freecnfa(&sr->cnfa);
    }
    sr->flags = 0;

    if (v != NULL && v->treechain != NULL) {
    if (v != NULL) {
	/* we're still parsing, maybe we can reuse the subre */
	sr->left = v->treefree;
	v->treefree = sr;
    } else {
	FREE(sr);
    }
}

/*
 - optst - optimize a subRE subtree
 ^ static void optst(struct vars *, struct subre *);
 */
static void
optst(
    struct vars *v,
    struct subre *t)
{
    /*
     * DGP (2007-11-13): I assume it was the programmer's intent to eventually
     * come back and add code to optimize subRE trees, but the routine coded
     * just spends effort traversing the tree and doing nothing. We can do
     * nothing with less effort.
     */

    return;
}

/*
 - numst - number tree nodes (assigning "id" indexes)
 - numst - number tree nodes (assigning retry indexes)
 ^ static int numst(struct subre *, int);
 */
static int			/* next number */
numst(
    struct subre *t,
    int start)			/* starting point for subtree numbers */
{
    int i;

    assert(t != NULL);

    i = start;
    t->id = (short) i++;
    t->retry = (short) i++;
    if (t->left != NULL) {
	i = numst(t->left, i);
    }
    if (t->right != NULL) {
	i = numst(t->right, i);
    }
    return i;
}

/*
 - markst - mark tree nodes as INUSE
 * Note: this is a great deal more subtle than it looks.  During initial
 * parsing of a regex, all subres are linked into the treechain list;
 * discarded ones are also linked into the treefree list for possible reuse.
 * After we are done creating all subres required for a regex, we run markst()
 * then cleanst(), which results in discarding all subres not reachable from
 * v->tree.  We then clear v->treechain, indicating that subres must be found
 * by descending from v->tree.  This changes the behavior of freesubre(): it
 * will henceforth FREE() unwanted subres rather than sticking them into the
 * treefree list.  (Doing that any earlier would result in dangling links in
 * the treechain list.)  This all means that freev() will clean up correctly
 * if invoked before or after markst()+cleanst(); but it would not work if
 * called partway through this state conversion, so we mustn't error out
 * in or between these two functions.
 ^ static void markst(struct subre *);
 */
static void
markst(
    struct subre *t)
{
    assert(t != NULL);
1894
1895
1896
1897
1898
1899
1900
1901

1902
1903
1904

1905
1906
1907
1908
1909
1910
1911
1888
1889
1890
1891
1892
1893
1894

1895
1896
1897

1898
1899
1900
1901
1902
1903
1904
1905







-
+


-
+







    struct vars *v,
    struct subre *t,
    FILE *f)			/* for debug output */
{
    assert(t != NULL && t->begin != NULL);

    if (t->left != NULL) {
	(void) nfatree(v, t->left, f);
	(DISCARD) nfatree(v, t->left, f);
    }
    if (t->right != NULL) {
	(void) nfatree(v, t->right, f);
	(DISCARD) nfatree(v, t->right, f);
    }

    return nfanode(v, t, f);
}

/*
 - nfanode - do one NFA for nfatree
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
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







-
-
-
+
+


+

-
+

-
-
-
+
+
+


-
+




-
-







static int			/* lacon number */
newlacon(
    struct vars *v,
    struct state *begin,
    struct state *end,
    int pos)
{
    int n;
    struct subre *newlacons;
    struct subre *sub;
    struct subre *sub;
    int n;

    if (v->nlacons == 0) {
	v->lacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
	n = 1;		/* skip 0th */
	newlacons = (struct subre *) MALLOC(2 * sizeof(struct subre));
	v->nlacons = 2;
    } else {
	n = v->nlacons;
	newlacons = (struct subre *) REALLOC(v->lacons,
					     (n + 1) * sizeof(struct subre));
	v->lacons = (struct subre *) REALLOC(v->lacons,
		(v->nlacons+1)*sizeof(struct subre));
	n = v->nlacons++;
    }

    if (newlacons == NULL) {
    if (v->lacons == NULL) {
	ERR(REG_ESPACE);
	return 0;
    }

    v->lacons = newlacons;
    v->nlacons = n + 1;
    sub = &v->lacons[n];
    sub->begin = begin;
    sub->end = end;
    sub->subno = pos;
    ZAPCNFA(sub->cnfa);
    return n;
}
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
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







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







	return;
    }

    re->re_magic = 0;	/* invalidate RE */
    g = (struct guts *) re->re_guts;
    re->re_guts = NULL;
    re->re_fns = NULL;
    if (g != NULL) {
	g->magic = 0;
	freecm(&g->cmap);
	if (g->tree != NULL) {
	    freesubre(NULL, g->tree);
	}
	if (g->lacons != NULL) {
	    freelacons(g->lacons, g->nlacons);
	}
	if (!NULLCNFA(g->search)) {
	    freecnfa(&g->search);
	}
	FREE(g);
    g->magic = 0;
    freecm(&g->cmap);
    if (g->tree != NULL) {
	freesubre(NULL, g->tree);
    }
    if (g->lacons != NULL) {
	freelacons(g->lacons, g->nlacons);
    }
    if (!NULLCNFA(g->search)) {
	freecnfa(&g->search);
    }
    FREE(g);
    }
}

/*
 - dump - dump an RE in human-readable form
 ^ static void dump(regex_t *, FILE *);
 */
static void
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
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







-
-
+
+













-
-
-







    g = (struct guts *) re->re_guts;
    if (g->magic != GUTSMAGIC) {
	fprintf(f, "bad guts magic number (0x%x not 0x%x)\n",
		g->magic, GUTSMAGIC);
    }

    fprintf(f, "\n\n\n========= DUMP ==========\n");
    fprintf(f, "nsub %" TCL_Z_MODIFIER "d, info 0%lo, ntree %d\n",
	    re->re_nsub, re->re_info, g->ntree);
    fprintf(f, "nsub %d, info 0%lo, csize %d, ntree %d\n",
	    re->re_nsub, re->re_info, re->re_csize, g->ntree);

    dumpcolors(&g->cmap, f);
    if (!NULLCNFA(g->search)) {
	fprintf(f, "\nsearch:\n");
	dumpcnfa(&g->search, f);
    }
    for (i = 1; i < g->nlacons; i++) {
	fprintf(f, "\nla%d (%s):\n", i,
		(g->lacons[i].subno) ? "positive" : "negative");
	dumpcnfa(&g->lacons[i].cnfa, f);
    }
    fprintf(f, "\n");
    dumpst(g->tree, f, 0);
#else
    (void)re;
    (void)f;
#endif
}

/*
 - dumpst - dump a subRE tree
 ^ static void dumpst(struct subre *, FILE *, int);
 */
2173
2174
2175
2176
2177
2178
2179
2180

2181
2182
2183

2184
2185
2186
2187


2188
2189
2190
2191
2192
2193
2194
2160
2161
2162
2163
2164
2165
2166

2167
2168
2169

2170
2171
2172


2173
2174
2175
2176
2177
2178
2179
2180
2181







-
+


-
+


-
-
+
+







static const char *			/* points to buf or constant string */
stid(
    struct subre *t,
    char *buf,
    size_t bufsize)
{
    /*
     * Big enough for hex int or decimal t->id?
     * Big enough for hex int or decimal t->retry?
     */

    if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->id)*3 + 1) {
    if (bufsize < sizeof(void*)*2 + 3 || bufsize < sizeof(t->retry)*3 + 1) {
	return "unable";
    }
    if (t->id != 0) {
	sprintf(buf, "%d", t->id);
    if (t->retry != 0) {
	sprintf(buf, "%d", t->retry);
    } else {
	sprintf(buf, "%p", t);
    }
    return buf;
}

#include "regc_lex.c"

Changes to generic/regcustom.h.

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
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







-
+





+
-
-
-
+
+
+
















+
+
+
+
+
+
+
+
+









+
+
+







 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

/*
 * Headers if any.
 */

#include "regex.h"
#include "tclInt.h"

/*
 * Overrides for regguts.h definitions, if any.
 */

#define	FUNCPTR(name, args)	(*name)args
#define	MALLOC(n)		Tcl_AttemptAlloc(n)
#define	FREE(p)			Tcl_Free(p)
#define	REALLOC(p,n)		Tcl_AttemptRealloc(p,n)
#define	MALLOC(n)		ckalloc(n)
#define	FREE(p)			ckfree(VS(p))
#define	REALLOC(p,n)		ckrealloc(VS(p),n)

/*
 * Do not insert extras between the "begin" and "end" lines - this chunk is
 * automatically extracted to be fitted into regex.h.
 */

/* --- begin --- */
/* Ensure certain things don't sneak in from system headers. */
#ifdef __REG_WIDE_T
#undef __REG_WIDE_T
#endif
#ifdef __REG_WIDE_COMPILE
#undef __REG_WIDE_COMPILE
#endif
#ifdef __REG_WIDE_EXEC
#undef __REG_WIDE_EXEC
#endif
#ifdef __REG_REGOFF_T
#undef __REG_REGOFF_T
#endif
#ifdef __REG_VOID_T
#undef __REG_VOID_T
#endif
#ifdef __REG_CONST
#undef __REG_CONST
#endif
#ifdef __REG_NOFRONT
#undef __REG_NOFRONT
#endif
#ifdef __REG_NOCHAR
#undef __REG_NOCHAR
#endif
/* Interface types */
#define	__REG_WIDE_T	Tcl_UniChar
#define	__REG_REGOFF_T	long	/* Not really right, but good enough... */
#define	__REG_VOID_T	void
#define	__REG_CONST	const
/* Names and declarations */
#define	__REG_WIDE_COMPILE	TclReComp
#define	__REG_WIDE_EXEC		TclReExec
#define	__REG_NOFRONT		/* Don't want regcomp() and regexec() */
#define	__REG_NOCHAR		/* Or the char versions */
#define	regfree		TclReFree
#define	regerror	TclReError
83
84
85
86
87
88
89
90

91
92
93
94

95
96
97
98
99
100
101
96
97
98
99
100
101
102

103
104
105
106

107
108
109
110
111
112
113
114







-
+



-
+







typedef int celt;		/* Type to hold chr, or NOCELT */
#define	NOCELT (-1)		/* Celt value which is not valid chr */
#define	CHR(c) (UCHAR(c))	/* Turn char literal into chr literal */
#define	DIGITVAL(c) ((c)-'0')	/* Turn chr digit into its value */
#if TCL_UTF_MAX > 3
#define	CHRBITS	32		/* Bits in a chr; must not use sizeof */
#define	CHR_MIN	0x00000000	/* Smallest and largest chr; the value */
#define	CHR_MAX	0x10FFFF	/* CHR_MAX-CHR_MIN+1 should fit in uchr */
#define	CHR_MAX	0xffffffff	/* CHR_MAX-CHR_MIN+1 should fit in uchr */
#else
#define	CHRBITS	16		/* Bits in a chr; must not use sizeof */
#define	CHR_MIN	0x0000		/* Smallest and largest chr; the value */
#define	CHR_MAX	0xFFFF		/* CHR_MAX-CHR_MIN+1 should fit in uchr */
#define	CHR_MAX	0xffff		/* CHR_MAX-CHR_MIN+1 should fit in uchr */
#endif

/*
 * Functions operating on chr.
 */

#define	iscalnum(x)	Tcl_UniCharIsAlnum(x)
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


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







-
+








-
+





-
-
+
-
-
-

+
+
 * space to store this because the regular expression engine is never
 * reentered from the same thread; it doesn't make any callbacks.
 */

#if 1
#define AllocVars(vPtr) \
    static Tcl_ThreadDataKey varsKey; \
    struct vars *vPtr = (struct vars *) \
    register struct vars *vPtr = (struct vars *) \
	    Tcl_GetThreadData(&varsKey, sizeof(struct vars))
#else
/*
 * This strategy for allocating workspace is "more proper" in some sense, but
 * quite a bit slower. Using TSD (as above) leads to code that is quite a bit
 * faster in practice (measured!)
 */
#define AllocVars(vPtr) \
    struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars))
    register struct vars *vPtr = (struct vars *) MALLOC(sizeof(struct vars))
#define FreeVars(vPtr) \
    FREE(vPtr)
#endif

/*
 * Local Variables:
 * mode: c
 * And pick up the standard header.
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

#include "regex.h"

Changes to generic/rege_dfa.c.

32
33
34
35
36
37
38
39
40
41
42
43





44
45
46
47
48


49
50
51
52
53
54
55
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







-
-
-
-
-
+
+
+
+
+




-
+
+








/*
 - longest - longest-preferred matching engine
 ^ static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
 */
static chr *			/* endpoint, or NULL */
longest(
    struct vars *const v,	/* used only for debug and exec flags */
    struct dfa *const d,
    chr *const start,		/* where the match should start */
    chr *const stop,		/* match must end at or before here */
    int *const hitstopp)	/* record whether hit v->stop, if non-NULL */
    struct vars *v,		/* used only for debug and exec flags */
    struct dfa *d,
    chr *start,			/* where the match should start */
    chr *stop,			/* match must end at or before here */
    int *hitstopp)		/* record whether hit v->stop, if non-NULL */
{
    chr *cp;
    chr *realstop = (stop == v->stop) ? stop : stop + 1;
    color co;
    struct sset *css, *ss;
    struct sset *css;
    struct sset *ss;
    chr *post;
    int i;
    struct colormap *cm = d->cm;

    /*
     * Initialize.
     */
80
81
82
83
84
85
86
87

88
89
90
91
92
93
94
81
82
83
84
85
86
87

88
89
90
91
92
93
94
95







-
+








    /*
     * Main loop.
     */

    if (v->eflags&REG_FTRACE) {
	while (cp < realstop) {
	    FDEBUG(("+++ at c%d +++\n", (int) (css - d->ssets)));
	    FDEBUG(("+++ at c%d +++\n", css - d->ssets));
	    co = GETCOLOR(cm, *cp);
	    FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
	    ss = css->outs[co];
	    if (ss == NULL) {
		ss = miss(v, d, css, co, cp+1, start);
		if (ss == NULL) {
		    break;	/* NOTE BREAK OUT */
114
115
116
117
118
119
120
121

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

122
123
124
125
126
127
128
129







-
+







	}
    }

    /*
     * Shutdown.
     */

    FDEBUG(("+++ shutdown at c%d +++\n", (int) (css - d->ssets)));
    FDEBUG(("+++ shutdown at c%d +++\n", css - d->ssets));
    if (cp == v->stop && stop == v->stop) {
	if (hitstopp != NULL) {
	    *hitstopp = 1;
	}
	co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
	FDEBUG(("color %ld\n", (long)co));
	ss = miss(v, d, css, co, cp, start);
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
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







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





-
+
+







/*
 - shortest - shortest-preferred matching engine
 ^ static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *,
 ^ 	chr **, int *);
 */
static chr *			/* endpoint, or NULL */
shortest(
    struct vars *const v,
    struct dfa *const d,
    chr *const start,		/* where the match should start */
    chr *const min,		/* match must end at or after here */
    chr *const max,		/* match must end at or before here */
    chr **const coldp,		/* store coldstart pointer here, if nonNULL */
    int *const hitstopp)	/* record whether hit v->stop, if non-NULL */
    struct vars *v,
    struct dfa *d,
    chr *start,			/* where the match should start */
    chr *min,			/* match must end at or after here */
    chr *max,			/* match must end at or before here */
    chr **coldp,		/* store coldstart pointer here, if nonNULL */
    int *hitstopp)		/* record whether hit v->stop, if non-NULL */
{
    chr *cp;
    chr *realmin = (min == v->stop) ? min : min + 1;
    chr *realmax = (max == v->stop) ? max : max + 1;
    color co;
    struct sset *css, *ss;
    struct sset *css;
    struct sset *ss;
    struct colormap *cm = d->cm;

    /*
     * Initialize.
     */

    css = initialize(v, d, start);
209
210
211
212
213
214
215
216

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

218
219
220
221
222
223
224
225







-
+








    /*
     * Main loop.
     */

    if (v->eflags&REG_FTRACE) {
	while (cp < realmax) {
	    FDEBUG(("--- at c%d ---\n", (int) (css - d->ssets)));
	    FDEBUG(("--- at c%d ---\n", css - d->ssets));
	    co = GETCOLOR(cm, *cp);
	    FDEBUG(("char %c, color %ld\n", (char)*cp, (long)co));
	    ss = css->outs[co];
	    if (ss == NULL) {
		ss = miss(v, d, css, co, cp+1, start);
		if (ss == NULL) {
		    break;	/* NOTE BREAK OUT */
250
251
252
253
254
255
256
257

258
259
260
261
262
263
264
252
253
254
255
256
257
258

259
260
261
262
263
264
265
266







-
+







    }

    if (ss == NULL) {
	return NULL;
    }

    if (coldp != NULL) {	/* report last no-progress state set, if any */
	*coldp = lastCold(v, d);
	*coldp = lastcold(v, d);
    }

    if ((ss->flags&POSTSTATE) && cp > min) {
	assert(cp >= realmin);
	cp--;
    } else if (cp == v->stop && max == v->stop) {
	co = d->cnfa->eos[(v->eflags&REG_NOTEOL) ? 0 : 1];
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
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







-
-
+
+


-
-
-
+
+
+


-
+


+












-
-
+
+



-
-
-
-
+
+
+
+







	return NULL;
    }

    return cp;
}

/*
 - lastCold - determine last point at which no progress had been made
 ^ static chr *lastCold(struct vars *, struct dfa *);
 - lastcold - determine last point at which no progress had been made
 ^ static chr *lastcold(struct vars *, struct dfa *);
 */
static chr *			/* endpoint, or NULL */
lastCold(
    struct vars *const v,
    struct dfa *const d)
lastcold(
    struct vars *v,
    struct dfa *d)
{
    struct sset *ss;
    chr *nopr = d->lastnopr;
    chr *nopr;
    int i;

    nopr = d->lastnopr;
    if (nopr == NULL) {
	nopr = v->start;
    }
    for (ss = d->ssets, i = d->nssused; i > 0; ss++, i--) {
	if ((ss->flags&NOPROGRESS) && nopr < ss->lastseen) {
	    nopr = ss->lastseen;
	}
    }
    return nopr;
}

/*
 - newDFA - set up a fresh DFA
 ^ static struct dfa *newDFA(struct vars *, struct cnfa *,
 - newdfa - set up a fresh DFA
 ^ static struct dfa *newdfa(struct vars *, struct cnfa *,
 ^ 	struct colormap *, struct smalldfa *);
 */
static struct dfa *
newDFA(
    struct vars *const v,
    struct cnfa *const cnfa,
    struct colormap *const cm,
newdfa(
    struct vars *v,
    struct cnfa *cnfa,
    struct colormap *cm,
    struct smalldfa *sml)	/* preallocated space, may be NULL */
{
    struct dfa *d;
    size_t nss = cnfa->nstates * 2;
    int wordsper = (cnfa->nstates + UBITS - 1) / UBITS;
    struct smalldfa *smallwas = sml;

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
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







-
+




-
+











-
+







	d->statesarea = sml->statesarea;
	d->work = &d->statesarea[nss];
	d->outsarea = sml->outsarea;
	d->incarea = sml->incarea;
	d->cptsmalloced = 0;
	d->mallocarea = (smallwas == NULL) ? (char *)sml : NULL;
    } else {
	d = (struct dfa *) MALLOC(sizeof(struct dfa));
	d = (struct dfa *)MALLOC(sizeof(struct dfa));
	if (d == NULL) {
	    ERR(REG_ESPACE);
	    return NULL;
	}
	d->ssets = (struct sset *) MALLOC(nss * sizeof(struct sset));
	d->ssets = (struct sset *)MALLOC(nss * sizeof(struct sset));
	d->statesarea = (unsigned *)
		MALLOC((nss+WORK) * wordsper * sizeof(unsigned));
	d->work = &d->statesarea[nss * wordsper];
	d->outsarea = (struct sset **)
		MALLOC(nss * cnfa->ncolors * sizeof(struct sset *));
	d->incarea = (struct arcp *)
		MALLOC(nss * cnfa->ncolors * sizeof(struct arcp));
	d->cptsmalloced = 1;
	d->mallocarea = (char *)d;
	if (d->ssets == NULL || d->statesarea == NULL ||
		d->outsarea == NULL || d->incarea == NULL) {
	    freeDFA(d);
	    freedfa(d);
	    ERR(REG_ESPACE);
	    return NULL;
	}
    }

    d->nssets = (v->eflags&REG_SMALL) ? 7 : nss;
    d->nssused = 0;
380
381
382
383
384
385
386
387
388


389
390
391
392


393
394
395
396
397
398
399
383
384
385
386
387
388
389


390
391
392
393


394
395
396
397
398
399
400
401
402







-
-
+
+


-
-
+
+







     * Initialization of sset fields is done as needed.
     */

    return d;
}

/*
 - freeDFA - free a DFA
 ^ static void freeDFA(struct dfa *);
 - freedfa - free a DFA
 ^ static void freedfa(struct dfa *);
 */
static void
freeDFA(
    struct dfa *const d)
freedfa(
    struct dfa *d)
{
    if (d->cptsmalloced) {
	if (d->ssets != NULL) {
	    FREE(d->ssets);
	}
	if (d->statesarea != NULL) {
	    FREE(d->statesarea);
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
457
458
459
460
461
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

457
458
459
460
461
462
463
464







-
-
+
+

















-
-
-
+
+
+











-
+







/*
 - hash - construct a hash code for a bitvector
 * There are probably better ways, but they're more expensive.
 ^ static unsigned hash(unsigned *, int);
 */
static unsigned
hash(
    unsigned *const uv,
    const int n)
    unsigned *uv,
    int n)
{
    int i;
    unsigned h;

    h = 0;
    for (i = 0; i < n; i++) {
	h ^= uv[i];
    }
    return h;
}

/*
 - initialize - hand-craft a cache entry for startup, otherwise get ready
 ^ static struct sset *initialize(struct vars *, struct dfa *, chr *);
 */
static struct sset *
initialize(
    struct vars *const v,	/* used only for debug flags */
    struct dfa *const d,
    chr *const start)
    struct vars *v,		/* used only for debug flags */
    struct dfa *d,
    chr *start)
{
    struct sset *ss;
    int i;

    /*
     * Is previous one still there?
     */

    if (d->nssused > 0 && (d->ssets[0].flags&STARTER)) {
	ss = &d->ssets[0];
    } else {			/* no, must (re)build it */
	ss = getVacantSS(v, d, start, start);
	ss = getvacant(v, d, start, start);
	for (i = 0; i < d->wordsper; i++) {
	    ss->states[i] = 0;
	}
	BSET(ss->states, d->cnfa->pre);
	ss->hash = HASH(ss->states, d->wordsper);
	assert(d->cnfa->pre != d->cnfa->post);
	ss->flags = STARTER|LOCKED|NOPROGRESS;
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

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
611
612
613
614
615
616





617
618
619
620
621
622
623
624
625
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
686
687
688
689


690
691
692
693
694
695
696
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
595
596
597
598
599
600
601
602
603


604
605

606
607
608

609
610
611
612
613
614


615
616
617
618





619
620
621
622
623
624
625
626
627
628
629
630
631
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
686
687
688
689
690
691
692

693
694
695
696
697

698
699
700
701
702
703
704
705
706







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


+



+
-
+
+
+
+


















-
-
-
+
+
+


-
+


-
+

-
+

-
-
+
+






-
-
-
-
+
+
+
+


-
-
-
+
+
+

-
+

-
+

-
-
+
+


-
+

-
+

-
-
+
+






-
+










-
+




-
+





-
-
+
+








-
-
+
+
-



-
+





-
-
+
+


-
-
-
-
-
+
+
+
+
+











-
+




-
-
+
+





-
+


-
+


-
-
-
-
-
+
+
+
+
+


-
-
+
+
+
+


-
+









-
+
















-
+




-
+
+







/*
 - miss - handle a cache miss
 ^ static struct sset *miss(struct vars *, struct dfa *, struct sset *,
 ^ 	pcolor, chr *, chr *);
 */
static struct sset *		/* NULL if goes to empty set */
miss(
    struct vars *const v,	/* used only for debug flags */
    struct dfa *const d,
    struct sset *const css,
    const pcolor co,
    chr *const cp,		/* next chr */
    chr *const start)		/* where the attempt got started */
    struct vars *v,		/* used only for debug flags */
    struct dfa *d,
    struct sset *css,
    pcolor co,
    chr *cp,			/* next chr */
    chr *start)			/* where the attempt got started */
{
    struct cnfa *cnfa = d->cnfa;
    int i;
    unsigned h;
    struct carc *ca;
    struct sset *p;
    int ispost;
    int i, isPost, noProgress, gotState, doLAConstraints, sawLAConstraints;
    int noprogress;
    int gotstate;
    int dolacons;
    int sawlacons;

    /*
     * For convenience, we can be called even if it might not be a miss.
     */

    if (css->outs[co] != NULL) {
	FDEBUG(("hit\n"));
	return css->outs[co];
    }
    FDEBUG(("miss\n"));

    /*
     * First, what set of states would we end up in?
     */

    for (i = 0; i < d->wordsper; i++) {
	d->work[i] = 0;
    }
    isPost = 0;
    noProgress = 1;
    gotState = 0;
    ispost = 0;
    noprogress = 1;
    gotstate = 0;
    for (i = 0; i < d->nstates; i++) {
	if (ISBSET(css->states, i)) {
	    for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
	    for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
		if (ca->co == co) {
		    BSET(d->work, ca->to);
		    gotState = 1;
		    gotstate = 1;
		    if (ca->to == cnfa->post) {
			isPost = 1;
			ispost = 1;
		    }
		    if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
			noProgress = 0;
		    if (!cnfa->states[ca->to]->co) {
			noprogress = 0;
		    }
		    FDEBUG(("%d -> %d\n", i, ca->to));
		}
	    }
	}
    }
    doLAConstraints = (gotState ? (cnfa->flags&HASLACONS) : 0);
    sawLAConstraints = 0;
    while (doLAConstraints) {		/* transitive closure */
	doLAConstraints = 0;
    dolacons = (gotstate) ? (cnfa->flags&HASLACONS) : 0;
    sawlacons = 0;
    while (dolacons) {		/* transitive closure */
	dolacons = 0;
	for (i = 0; i < d->nstates; i++) {
	    if (ISBSET(d->work, i)) {
		for (ca = cnfa->states[i]; ca->co != COLORLESS; ca++) {
		    if (ca->co < cnfa->ncolors) {
			continue;	/* NOTE CONTINUE */
		for (ca = cnfa->states[i]+1; ca->co != COLORLESS; ca++) {
		    if (ca->co <= cnfa->ncolors) {
			continue; /* NOTE CONTINUE */
		    }
		    sawLAConstraints = 1;
		    sawlacons = 1;
		    if (ISBSET(d->work, ca->to)) {
			continue;	/* NOTE CONTINUE */
			continue; /* NOTE CONTINUE */
		    }
		    if (!checkLAConstraint(v, cnfa, cp, ca->co)) {
			continue;	/* NOTE CONTINUE */
		    if (!lacon(v, cnfa, cp, ca->co)) {
			continue; /* NOTE CONTINUE */
		    }
		    BSET(d->work, ca->to);
		    doLAConstraints = 1;
		    dolacons = 1;
		    if (ca->to == cnfa->post) {
			isPost = 1;
			ispost = 1;
		    }
		    if (!(cnfa->stflags[ca->to] & CNFA_NOPROGRESS)) {
			noProgress = 0;
		    if (!cnfa->states[ca->to]->co) {
			noprogress = 0;
		    }
		    FDEBUG(("%d :> %d\n", i, ca->to));
		}
	    }
	}
    }
    if (!gotState) {
    if (!gotstate) {
	return NULL;
    }
    h = HASH(d->work, d->wordsper);

    /*
     * Next, is that in the cache?
     */

    for (p = d->ssets, i = d->nssused; i > 0; p++, i--) {
	 if (HIT(h, d->work, p, d->wordsper)) {
	     FDEBUG(("cached c%d\n", (int) (p - d->ssets)));
	     FDEBUG(("cached c%d\n", p - d->ssets));
	     break;			/* NOTE BREAK OUT */
	 }
    }
    if (i == 0) {		/* nope, need a new cache entry */
	p = getVacantSS(v, d, cp, start);
	p = getvacant(v, d, cp, start);
	assert(p != css);
	for (i = 0; i < d->wordsper; i++) {
	    p->states[i] = d->work[i];
	}
	p->hash = h;
	p->flags = (isPost ? POSTSTATE : 0);
	if (noProgress) {
	p->flags = (ispost) ? POSTSTATE : 0;
	if (noprogress) {
	    p->flags |= NOPROGRESS;
	}

	/*
	 * lastseen to be dealt with by caller
	 */
    }

    if (!sawLAConstraints) {	/* lookahead conds. always cache miss */
	FDEBUG(("c%d[%d]->c%d\n",
    if (!sawlacons) {		/* lookahead conds. always cache miss */
	FDEBUG(("c%d[%d]->c%d\n", css - d->ssets, co, p - d->ssets));
		(int) (css - d->ssets), co, (int) (p - d->ssets)));
	css->outs[co] = p;
	css->inchain[co] = p->ins;
	p->ins.ss = css;
	p->ins.co = (color) co;
	p->ins.co = (color)co;
    }
    return p;
}

/*
 - checkLAConstraint - lookahead-constraint checker for miss()
 ^ static int checkLAConstraint(struct vars *, struct cnfa *, chr *, pcolor);
 - lacon - lookahead-constraint checker for miss()
 ^ static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
 */
static int			/* predicate:  constraint satisfied? */
checkLAConstraint(
    struct vars *const v,
    struct cnfa *const pcnfa,	/* parent cnfa */
    chr *const cp,
    const pcolor co)		/* "color" of the lookahead constraint */
lacon(
    struct vars *v,
    struct cnfa *pcnfa,		/* parent cnfa */
    chr *cp,
    pcolor co)			/* "color" of the lookahead constraint */
{
    int n;
    struct subre *sub;
    struct dfa *d;
    struct smalldfa sd;
    chr *end;

    n = co - pcnfa->ncolors;
    assert(n < v->g->nlacons && v->g->lacons != NULL);
    FDEBUG(("=== testing lacon %d\n", n));
    sub = &v->g->lacons[n];
    d = newDFA(v, &sub->cnfa, &v->g->cmap, &sd);
    d = newdfa(v, &sub->cnfa, &v->g->cmap, &sd);
    if (d == NULL) {
	ERR(REG_ESPACE);
	return 0;
    }
    end = longest(v, d, cp, v->stop, NULL);
    freeDFA(d);
    end = longest(v, d, cp, v->stop, (int *)NULL);
    freedfa(d);
    FDEBUG(("=== lacon %d match %d\n", n, (end != NULL)));
    return (sub->subno) ? (end != NULL) : (end == NULL);
}

/*
 - getVacantSS - get a vacant state set
 - getvacant - get a vacant state set
 * This routine clears out the inarcs and outarcs, but does not otherwise
 * clear the innards of the state set -- that's up to the caller.
 ^ static struct sset *getVacantSS(struct vars *, struct dfa *, chr *, chr *);
 ^ static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
 */
static struct sset *
getVacantSS(
    struct vars *const v,	/* used only for debug flags */
    struct dfa *const d,
    chr *const cp,
    chr *const start)
getvacant(
    struct vars *v,		/* used only for debug flags */
    struct dfa *d,
    chr *cp,
    chr *start)
{
    int i;
    struct sset *ss, *p;
    struct arcp ap, lastap = {NULL, 0}; /* silence gcc 4 warning */
    struct sset *ss;
    struct sset *p;
    struct arcp ap;
    struct arcp lastap = {NULL, 0}; /* silence gcc 4 warning */
    color co;

    ss = pickNextSS(v, d, cp, start);
    ss = pickss(v, d, cp, start);
    assert(!(ss->flags&LOCKED));

    /*
     * Clear out its inarcs, including self-referential ones.
     */

    ap = ss->ins;
    while ((p = ap.ss) != NULL) {
	co = ap.co;
	FDEBUG(("zapping c%d's %ld outarc\n", (int) (p - d->ssets), (long)co));
	FDEBUG(("zapping c%d's %ld outarc\n", p - d->ssets, (long)co));
	p->outs[co] = NULL;
	ap = p->inchain[co];
	p->inchain[co].ss = NULL; /* paranoia */
    }
    ss->ins.ss = NULL;

    /*
     * Take it off the inarc chains of the ssets reached by its outarcs.
     */

    for (i = 0; i < d->ncolors; i++) {
	p = ss->outs[i];
	assert(p != ss);	/* not self-referential */
	if (p == NULL) {
	    continue;		/* NOTE CONTINUE */
	}
	FDEBUG(("del outarc %d from c%d's in chn\n", i, (int) (p - d->ssets)));
	FDEBUG(("del outarc %d from c%d's in chn\n", i, p - d->ssets));
	if (p->ins.ss == ss && p->ins.co == i) {
	    p->ins = ss->inchain[i];
	} else {
	    assert(p->ins.ss != NULL);
	    for (ap = p->ins; ap.ss != NULL && !(ap.ss == ss && ap.co == i);
	    for (ap = p->ins; ap.ss != NULL &&
		    !(ap.ss == ss && ap.co == i);
		    ap = ap.ss->inchain[ap.co]) {
		lastap = ap;
	    }
	    assert(ap.ss != NULL);
	    lastap.ss->inchain[lastap.co] = ss->inchain[i];
	}
	ss->outs[i] = NULL;
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
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







-
-
+
+


-
-
-
-
-
+
+
+
+
+


-
+
+







	d->lastnopr = ss->lastseen;
    }

    return ss;
}

/*
 - pickNextSS - pick the next stateset to be used
 ^ static struct sset *pickNextSS(struct vars *, struct dfa *, chr *, chr *);
 - pickss - pick the next stateset to be used
 ^ static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
 */
static struct sset *
pickNextSS(
    struct vars *const v,	/* used only for debug flags */
    struct dfa *const d,
    chr *const cp,
    chr *const start)
pickss(
    struct vars *v,		/* used only for debug flags */
    struct dfa *d,
    chr *cp,
    chr *start)
{
    int i;
    struct sset *ss, *end;
    struct sset *ss;
    struct sset *end;
    chr *ancient;

    /*
     * Shortcut for cases where cache isn't full.
     */

    if (d->nssused < d->nssets) {
769
770
771
772
773
774
775
776

777
778
779
780
781
782
783
784

785
786
787
788
789
790
791
780
781
782
783
784
785
786

787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
802







-
+







-
+







    } else {
	ancient = start;
    }
    for (ss = d->search, end = &d->ssets[d->nssets]; ss < end; ss++) {
	if ((ss->lastseen == NULL || ss->lastseen < ancient)
		&& !(ss->flags&LOCKED)) {
	    d->search = ss + 1;
	    FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
	    FDEBUG(("replacing c%d\n", ss - d->ssets));
	    return ss;
	}
    }
    for (ss = d->ssets, end = d->search; ss < end; ss++) {
	if ((ss->lastseen == NULL || ss->lastseen < ancient)
		&& !(ss->flags&LOCKED)) {
	    d->search = ss + 1;
	    FDEBUG(("replacing c%d\n", (int) (ss - d->ssets)));
	    FDEBUG(("replacing c%d\n", ss - d->ssets));
	    return ss;
	}
    }

    /*
     * Nobody's old enough?!? -- something's really wrong.
     */

Changes to generic/regerror.c.

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
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







-
+












+



+



-
+








static const char unk[] = "*** unknown regex error code 0x%x ***";

/*
 * Struct to map among codes, code names, and explanations.
 */

static const struct rerr {
static struct rerr {
    int code;
    const char *name;
    const char *explain;
} rerrs[] = {
    /* The actual table is built from regex.h */
#include "regerrs.h"
    { -1, "", "oops" },		/* explanation special-cased in code */
};

/*
 - regerror - the interface to error numbers
 */
/* ARGSUSED */
size_t				/* Actual space needed (including NUL) */
regerror(
    int code,			/* Error code, or REG_ATOI or REG_ITOA */
    const regex_t *preg,	/* Associated regex_t (unused at present) */
    char *errbuf,		/* Result buffer (unless errbuf_size==0) */
    size_t errbuf_size)		/* Available space in errbuf, can be 0 */
{
    const struct rerr *r;
    struct rerr *r;
    const char *msg;
    char convbuf[sizeof(unk)+50]; /* 50 = plenty for int */
    size_t len;
    int icode;

    switch (code) {
    case REG_ATOI:		/* Convert name to number */
82
83
84
85
86
87
88
89

90
91
92
93
94
95
96
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98







-
+







	    if (r->code == icode) {
		break;
	    }
	}
	if (r->code >= 0) {
	    msg = r->name;
	} else {		/* Unknown; tell him the number */
	    sprintf(convbuf, "REG_%u", icode);
	    sprintf(convbuf, "REG_%u", (unsigned)icode);
	    msg = convbuf;
	}
	break;
    default:			/* A real, normal error code */
	for (r = rerrs; r->code >= 0; r++) {
	    if (r->code == code) {
		break;

Changes to generic/regerrs.h.

12
13
14
15
16
17
18
19

20
12
13
14
15
16
17
18

19
20







-
+

{ REG_ERANGE,	"REG_ERANGE",	"invalid character range" },
{ REG_ESPACE,	"REG_ESPACE",	"out of memory" },
{ REG_BADRPT,	"REG_BADRPT",	"quantifier operand invalid" },
{ REG_ASSERT,	"REG_ASSERT",	"\"can't happen\" -- you found a bug" },
{ REG_INVARG,	"REG_INVARG",	"invalid argument to regex function" },
{ REG_MIXED,	"REG_MIXED",	"character widths of regex and string differ" },
{ REG_BADOPT,	"REG_BADOPT",	"invalid embedded option" },
{ REG_ETOOBIG,	"REG_ETOOBIG",	"regular expression is too complex" },
{ REG_ETOOBIG,	"REG_ETOOBIG",	"nfa has too many states" },
{ REG_ECOLORS,	"REG_ECOLORS",	"too many colors" },

Changes to generic/regex.h.

1
2
3
4
5
6
7
8
9
10
11
12
1
2



3
4
5
6
7
8
9


-
-
-







#ifndef _REGEX_H_
#define	_REGEX_H_	/* never again */

#include "tclInt.h"

/*
 * regular expressions
 *
 * Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
 *
 * Development of this software was funded, in part, by Cray Research Inc.,
 * UUNET Communications Services Inc., Sun Microsystems Inc., and Scriptics
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
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







+
+
+
+
+
+
+
+
+









+
+
+












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








-

+














+


-
-
+
+




-
-
+
+










-
+


-
+


-
+







#undef __REG_WIDE_T
#endif
#ifdef __REG_WIDE_COMPILE
#undef __REG_WIDE_COMPILE
#endif
#ifdef __REG_WIDE_EXEC
#undef __REG_WIDE_EXEC
#endif
#ifdef __REG_REGOFF_T
#undef __REG_REGOFF_T
#endif
#ifdef __REG_VOID_T
#undef __REG_VOID_T
#endif
#ifdef __REG_CONST
#undef __REG_CONST
#endif
#ifdef __REG_NOFRONT
#undef __REG_NOFRONT
#endif
#ifdef __REG_NOCHAR
#undef __REG_NOCHAR
#endif
/* interface types */
#define	__REG_WIDE_T	Tcl_UniChar
#define	__REG_REGOFF_T	long	/* not really right, but good enough... */
#define	__REG_VOID_T	VOID
#define	__REG_CONST	CONST
/* names and declarations */
#define	__REG_WIDE_COMPILE	TclReComp
#define	__REG_WIDE_EXEC		TclReExec
#define	__REG_NOFRONT		/* don't want regcomp() and regexec() */
#define	__REG_NOCHAR		/* or the char versions */
#define	regfree		TclReFree
#define	regerror	TclReError
/* --- end --- */

/*
 * interface types etc.
 */

/*
 * regoff_t has to be large enough to hold either off_t or ssize_t, and must
 * be signed; it's only a guess that long is suitable, so we offer
 * <sys/types.h> an override.
 */
#ifdef __REG_REGOFF_T
typedef __REG_REGOFF_T regoff_t;
#else
typedef long regoff_t;
#endif

/*
 * For benefit of old compilers, we offer <sys/types.h> the option of
 * overriding the `void' type used to declare nonexistent return types.
 */
#ifdef __REG_VOID_T
typedef __REG_VOID_T re_void;
#else
typedef void re_void;
#endif

/*
 * Also for benefit of old compilers, <sys/types.h> can supply a macro which
 * expands to a substitute for `const'.
 */
#ifndef __REG_CONST
#define	__REG_CONST	const
#endif



/*
 * other interface types
 */

/* the biggie, a compiled RE (or rather, a front end to same) */
typedef struct {
    int re_magic;		/* magic number */
    long re_info;		/* information about RE */
    size_t re_nsub;		/* number of subexpressions */
    long re_info;		/* information about RE */
#define	REG_UBACKREF		000001
#define	REG_ULOOKAHEAD		000002
#define	REG_UBOUNDS		000004
#define	REG_UBRACES		000010
#define	REG_UBSALNUM		000020
#define	REG_UPBOTCH		000040
#define	REG_UBBS		000100
#define	REG_UNONPOSIX		000200
#define	REG_UUNSPEC		000400
#define	REG_UUNPORT		001000
#define	REG_ULOCALE		002000
#define	REG_UEMPTYMATCH		004000
#define	REG_UIMPOSSIBLE		010000
#define	REG_USHORTEST		020000
    int re_csize;		/* sizeof(character) */
    char *re_endp;		/* backward compatibility kludge */
    /* the rest is opaque pointers to hidden innards */
    void *re_guts;
    void *re_fns;
    char *re_guts;		/* `char *' is more portable than `void *' */
    char *re_fns;
} regex_t;

/* result reporting (may acquire more fields later) */
typedef struct {
    size_t rm_so;		/* start of substring */
    size_t rm_eo;		/* end of substring */
    regoff_t rm_so;		/* start of substring */
    regoff_t rm_eo;		/* end of substring */
} regmatch_t;

/* supplementary control and reporting */
typedef struct {
    regmatch_t rm_extend;	/* see REG_EXPECT */
} rm_detail_t;

/*
 * compilation
 ^ #ifndef __REG_NOCHAR
 ^ int re_comp(regex_t *, const char *, size_t, int);
 ^ int re_comp(regex_t *, __REG_CONST char *, size_t, int);
 ^ #endif
 ^ #ifndef __REG_NOFRONT
 ^ int regcomp(regex_t *, const char *, int);
 ^ int regcomp(regex_t *, __REG_CONST char *, int);
 ^ #endif
 ^ #ifdef __REG_WIDE_T
 ^ int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
 ^ int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
 ^ #endif
 */
#define	REG_BASIC	000000	/* BREs (convenience) */
#define	REG_EXTENDED	000001	/* EREs */
#define	REG_ADVF	000002	/* advanced features in EREs */
#define	REG_ADVANCED	000003	/* AREs (which are also EREs) */
#define	REG_QUOTE	000004	/* no special characters, none */
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
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















-
+



-
+


-
+












-
+











-
+



















-
+












-
+


-
+


-
+


-
+


-
+


-
+

-
-
+
+











-
-
-
-
-
-
-
-
#define	REG_DUMP	004000	/* none of your business :-) */
#define	REG_FAKE	010000	/* none of your business :-) */
#define	REG_PROGRESS	020000	/* none of your business :-) */

/*
 * execution
 ^ #ifndef __REG_NOCHAR
 ^ int re_exec(regex_t *, const char *, size_t,
 ^ int re_exec(regex_t *, __REG_CONST char *, size_t,
 ^				rm_detail_t *, size_t, regmatch_t [], int);
 ^ #endif
 ^ #ifndef __REG_NOFRONT
 ^ int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
 ^ int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
 ^ #endif
 ^ #ifdef __REG_WIDE_T
 ^ int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t,
 ^ int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t,
 ^				rm_detail_t *, size_t, regmatch_t [], int);
 ^ #endif
 */
#define	REG_NOTBOL	0001	/* BOS is not BOL */
#define	REG_NOTEOL	0002	/* EOS is not EOL */
#define	REG_STARTEND	0004	/* backward compatibility kludge */
#define	REG_FTRACE	0010	/* none of your business */
#define	REG_MTRACE	0020	/* none of your business */
#define	REG_SMALL	0040	/* none of your business */

/*
 * misc generics (may be more functions here eventually)
 ^ void regfree(regex_t *);
 ^ re_void regfree(regex_t *);
 */

/*
 * error reporting
 * Be careful if modifying the list of error codes -- the table used by
 * regerror() is generated automatically from this file!
 *
 * Note that there is no wide-char variant of regerror at this time; what kind
 * of character is used for error reports is independent of what kind is used
 * in matching.
 *
 ^ extern size_t regerror(int, char *, size_t);
 ^ extern size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
 */
#define	REG_OKAY	 0	/* no errors detected */
#define	REG_NOMATCH	 1	/* failed to match */
#define	REG_BADPAT	 2	/* invalid regexp */
#define	REG_ECOLLATE	 3	/* invalid collating element */
#define	REG_ECTYPE	 4	/* invalid character class */
#define	REG_EESCAPE	 5	/* invalid escape \ sequence */
#define	REG_ESUBREG	 6	/* invalid backreference number */
#define	REG_EBRACK	 7	/* brackets [] not balanced */
#define	REG_EPAREN	 8	/* parentheses () not balanced */
#define	REG_EBRACE	 9	/* braces {} not balanced */
#define	REG_BADBR	10	/* invalid repetition count(s) */
#define	REG_ERANGE	11	/* invalid character range */
#define	REG_ESPACE	12	/* out of memory */
#define	REG_BADRPT	13	/* quantifier operand invalid */
#define	REG_ASSERT	15	/* "can't happen" -- you found a bug */
#define	REG_INVARG	16	/* invalid argument to regex function */
#define	REG_MIXED	17	/* character widths of regex and string differ */
#define	REG_BADOPT	18	/* invalid embedded option */
#define	REG_ETOOBIG	19	/* regular expression is too complex */
#define	REG_ETOOBIG	19	/* nfa has too many states */
#define	REG_ECOLORS	20	/* too many colors */
/* two specials for debugging and testing */
#define	REG_ATOI	101	/* convert error-code name to number */
#define	REG_ITOA	102	/* convert error-code number to name */

/*
 * the prototypes, as possibly munched by regfwd
 */
/* =====^!^===== begin forwards =====^!^===== */
/* automatically gathered by fwd; do not hand-edit */
/* === regproto.h === */
#ifndef __REG_NOCHAR
int re_comp(regex_t *, const char *, size_t, int);
int re_comp(regex_t *, __REG_CONST char *, size_t, int);
#endif
#ifndef __REG_NOFRONT
int regcomp(regex_t *, const char *, int);
int regcomp(regex_t *, __REG_CONST char *, int);
#endif
#ifdef __REG_WIDE_T
MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, const __REG_WIDE_T *, size_t, int);
MODULE_SCOPE int __REG_WIDE_COMPILE(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, int);
#endif
#ifndef __REG_NOCHAR
int re_exec(regex_t *, const char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
int re_exec(regex_t *, __REG_CONST char *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
#ifndef __REG_NOFRONT
int regexec(regex_t *, const char *, size_t, regmatch_t [], int);
int regexec(regex_t *, __REG_CONST char *, size_t, regmatch_t [], int);
#endif
#ifdef __REG_WIDE_T
MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, const __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
MODULE_SCOPE int __REG_WIDE_EXEC(regex_t *, __REG_CONST __REG_WIDE_T *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
#endif
MODULE_SCOPE void regfree(regex_t *);
MODULE_SCOPE size_t regerror(int, char *, size_t);
MODULE_SCOPE re_void regfree(regex_t *);
MODULE_SCOPE size_t regerror(int, __REG_CONST regex_t *, char *, size_t);
/* automatically gathered by fwd; do not hand-edit */
/* =====^!^===== end forwards =====^!^===== */

/*
 * more C++ voodoo
 */
#ifdef __cplusplus
}
#endif

#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/regexec.c.

40
41
42
43
44
45
46
47

48
49
50
51
52
53
54
40
41
42
43
44
45
46

47
48
49
50
51
52
53
54







-
+







};

struct sset {			/* state set */
    unsigned *states;		/* pointer to bitvector */
    unsigned hash;		/* hash of bitvector */
#define	HASH(bv, nw)	(((nw) == 1) ? *(bv) : hash(bv, nw))
#define	HIT(h,bv,ss,nw)	((ss)->hash == (h) && ((nw) == 1 || \
	memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0))
	memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
    int flags;
#define	STARTER		01	/* the initial state set */
#define	POSTSTATE	02	/* includes the goal state */
#define	LOCKED		04	/* locked in cache */
#define	NOPROGRESS	010	/* zero-progress state set */
    struct arcp ins;		/* chain of inarcs pointing here */
    chr *lastseen;		/* last entered on arrival here */
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
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







-
+

















+















-
+





-
+











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

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





-
+





-
+







-
-
-
+
+
+


-
-
+
+








+
+
+
+







    struct arcp *incarea;	/* inchain storage */
    struct cnfa *cnfa;
    struct colormap *cm;
    chr *lastpost;		/* location of last cache-flushed success */
    chr *lastnopr;		/* location of last cache-flushed NOPROGRESS */
    struct sset *search;	/* replacement-search-pointer memory */
    int cptsmalloced;		/* were the areas individually malloced? */
    char *mallocarea;		/* self, or malloced area, or NULL */
    char *mallocarea;		/* self, or master malloced area, or NULL */
};

#define	WORK	1		/* number of work bitvectors needed */

/*
 * Setup for non-malloc allocation for small cases.
 */

#define	FEWSTATES	20	/* must be less than UBITS */
#define	FEWCOLORS	15
struct smalldfa {
    struct dfa dfa;
    struct sset ssets[FEWSTATES*2];
    unsigned statesarea[FEWSTATES*2 + WORK];
    struct sset *outsarea[FEWSTATES*2 * FEWCOLORS];
    struct arcp incarea[FEWSTATES*2 * FEWCOLORS];
};
#define	DOMALLOC	((struct smalldfa *)NULL)	/* force malloc */

/*
 * Internal variables, bundled for easy passing around.
 */

struct vars {
    regex_t *re;
    struct guts *g;
    int eflags;			/* copies of arguments */
    size_t nmatch;
    regmatch_t *pmatch;
    rm_detail_t *details;
    chr *start;			/* start of string */
    chr *stop;			/* just past end of string */
    int err;			/* error code if any (0 none) */
    struct dfa **subdfas;	/* per-subre DFAs */
    regoff_t *mem;		/* memory vector for backtracking */
    struct smalldfa dfa1;
    struct smalldfa dfa2;
};
#define	VISERR(vv) ((vv)->err != 0)	/* have we seen an error yet? */
#define	ISERR()	VISERR(v)
#define VERR(vv,e) ((vv)->err = ((vv)->err ? (vv)->err : (e)))
#define	VERR(vv,e) (((vv)->err) ? (vv)->err : ((vv)->err = (e)))
#define	ERR(e)	VERR(v, e)	/* record an error */
#define	NOERR()	{if (ISERR()) return v->err;}	/* if error seen, return it */
#define	OFF(p)	((p) - v->start)
#define	LOFF(p)	((long)OFF(p))

/*
 * forward declarations
 */
/* =====^!^===== begin forwards =====^!^===== */
/* automatically gathered by fwd; do not hand-edit */
/* === regexec.c === */
int exec(regex_t *, const chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
static struct dfa *getsubdfa(struct vars *, struct subre *);
static int simpleFind(struct vars *const, struct cnfa *const, struct colormap *const);
int exec(regex_t *, CONST chr *, size_t, rm_detail_t *, size_t, regmatch_t [], int);
static int find(struct vars *, struct cnfa *, struct colormap *);
static int cfind(struct vars *, struct cnfa *, struct colormap *);
static int complicatedFind(struct vars *const, struct cnfa *const, struct colormap *const);
static int complicatedFindLoop(struct vars *const, struct dfa *const, struct dfa *const, chr **const);
static void zapallsubs(regmatch_t *const, const size_t);
static void zaptreesubs(struct vars *const, struct subre *const);
static void subset(struct vars *const, struct subre *const, chr *const, chr *const);
static int cdissect(struct vars *, struct subre *, chr *, chr *);
static int ccondissect(struct vars *, struct subre *, chr *, chr *);
static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
static int caltdissect(struct vars *, struct subre *, chr *, chr *);
static int citerdissect(struct vars *, struct subre *, chr *, chr *);
static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
static int cfindloop(struct vars *, struct cnfa *, struct colormap *, struct dfa *, struct dfa *, chr **);
static VOID zapsubs(regmatch_t *, size_t);
static VOID zapmem(struct vars *, struct subre *);
static VOID subset(struct vars *, struct subre *, chr *, chr *);
static int dissect(struct vars *, struct subre *, chr *, chr *);
static int condissect(struct vars *, struct subre *, chr *, chr *);
static int altdissect(struct vars *, struct subre *, chr *, chr *);
static int cdissect(struct vars *, struct subre *, chr *, chr *);
static int ccondissect(struct vars *, struct subre *, chr *, chr *);
static int crevdissect(struct vars *, struct subre *, chr *, chr *);
static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
static int caltdissect(struct vars *, struct subre *, chr *, chr *);
/* === rege_dfa.c === */
static chr *longest(struct vars *const, struct dfa *const, chr *const, chr *const, int *const);
static chr *shortest(struct vars *const, struct dfa *const, chr *const, chr *const, chr *const, chr **const, int *const);
static chr *lastCold(struct vars *const, struct dfa *const);
static struct dfa *newDFA(struct vars *const, struct cnfa *const, struct colormap *const, struct smalldfa *);
static void freeDFA(struct dfa *const);
static unsigned hash(unsigned *const, const int);
static struct sset *initialize(struct vars *const, struct dfa *const, chr *const);
static struct sset *miss(struct vars *const, struct dfa *const, struct sset *const, const pcolor, chr *const, chr *const);
static int checkLAConstraint(struct vars *const, struct cnfa *const, chr *const, const pcolor);
static struct sset *getVacantSS(struct vars *const, struct dfa *const, chr *const, chr *const);
static struct sset *pickNextSS(struct vars *const, struct dfa *const, chr *const, chr *const);
static chr *longest(struct vars *, struct dfa *, chr *, chr *, int *);
static chr *shortest(struct vars *, struct dfa *, chr *, chr *, chr *, chr **, int *);
static chr *lastcold(struct vars *, struct dfa *);
static struct dfa *newdfa(struct vars *, struct cnfa *, struct colormap *, struct smalldfa *);
static VOID freedfa(struct dfa *);
static unsigned hash(unsigned *, int);
static struct sset *initialize(struct vars *, struct dfa *, chr *);
static struct sset *miss(struct vars *, struct dfa *, struct sset *, pcolor, chr *, chr *);
static int lacon(struct vars *, struct cnfa *, chr *, pcolor);
static struct sset *getvacant(struct vars *, struct dfa *, chr *, chr *);
static struct sset *pickss(struct vars *, struct dfa *, chr *, chr *);
/* automatically gathered by fwd; do not hand-edit */
/* =====^!^===== end forwards =====^!^===== */

/*
 - exec - match regular expression
 ^ int exec(regex_t *, const chr *, size_t, rm_detail_t *,
 ^ int exec(regex_t *, CONST chr *, size_t, rm_detail_t *,
 ^					size_t, regmatch_t [], int);
 */
int
exec(
    regex_t *re,
    const chr *string,
    CONST chr *string,
    size_t len,
    rm_detail_t *details,
    size_t nmatch,
    regmatch_t pmatch[],
    int flags)
{
    AllocVars(v);
    int st, backref;
    int n;
    int i;
    int st;
    size_t n;
    int backref;
#define	LOCALMAT	20
    regmatch_t mat[LOCALMAT];
#define LOCALDFAS	40
    struct dfa *subdfas[LOCALDFAS];
#define	LOCALMEM	40
    regoff_t mem[LOCALMEM];

    /*
     * Sanity checks.
     */

    if (re == NULL || string == NULL || re->re_magic != REMAGIC) {
	FreeVars(v);
	return REG_INVARG;
    }
    if (re->re_csize != sizeof(chr)) {
	FreeVars(v);
	return REG_MIXED;
    }

    /*
     * Setup.
     */

    v->re = re;
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
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







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







-
+

-
+







-
+

-
+









-
-
-
-
+
+

-
-





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


-
-
-
-
+
+
+
+

-
-
+
+
+
+

-
+

+







-
+





-
+







    } else {
	v->pmatch = pmatch;
    }
    v->details = details;
    v->start = (chr *)string;
    v->stop = (chr *)string + len;
    v->err = 0;
    if (backref) {
	/*
	 * Need retry memory.
	 */

    assert(v->g->ntree >= 0);
    n = v->g->ntree;
    if (n <= LOCALDFAS)
	v->subdfas = subdfas;
    else
	v->subdfas = (struct dfa **) MALLOC(n * sizeof(struct dfa *));
    if (v->subdfas == NULL) {
	if (v->pmatch != pmatch && v->pmatch != mat)
	    FREE(v->pmatch);
	FreeVars(v);
	return REG_ESPACE;
    }
	assert(v->g->ntree >= 0);
	n = (size_t)v->g->ntree;
	if (n <= LOCALMEM) {
	    v->mem = mem;
	} else {
	    v->mem = (regoff_t *) MALLOC(n*sizeof(regoff_t));
	}
	if (v->mem == NULL) {
	    if (v->pmatch != pmatch && v->pmatch != mat) {
		FREE(v->pmatch);
	    }
	    FreeVars(v);
	    return REG_ESPACE;
	}
    for (i = 0; i < n; i++)
	v->subdfas[i] = NULL;
    } else {
	v->mem = NULL;
    }

    /*
     * Do it.
     */

    assert(v->g->tree != NULL);
    if (backref) {
	st = complicatedFind(v, &v->g->tree->cnfa, &v->g->cmap);
	st = cfind(v, &v->g->tree->cnfa, &v->g->cmap);
    } else {
	st = simpleFind(v, &v->g->tree->cnfa, &v->g->cmap);
	st = find(v, &v->g->tree->cnfa, &v->g->cmap);
    }

    /*
     * Copy (portion of) match vector over if necessary.
     */

    if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
	zapallsubs(pmatch, nmatch);
	zapsubs(pmatch, nmatch);
	n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
	memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t));
	memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
    }

    /*
     * Clean up.
     */

    if (v->pmatch != pmatch && v->pmatch != mat) {
	FREE(v->pmatch);
    }
    n = v->g->ntree;
    for (i = 0; i < n; i++) {
	if (v->subdfas[i] != NULL)
	    freeDFA(v->subdfas[i]);
    if (v->mem != NULL && v->mem != mem) {
	FREE(v->mem);
    }
    if (v->subdfas != subdfas)
	FREE(v->subdfas);
    FreeVars(v);
    return st;
}

/*
 - getsubdfa - create or re-fetch the DFA for a subre node
 * We only need to create the DFA once per overall regex execution.
 * The DFA will be freed by the cleanup step in exec().
 */
static struct dfa *
getsubdfa(struct vars * v,
	  struct subre * t)
{
    if (v->subdfas[t->id] == NULL) {
	v->subdfas[t->id] = newDFA(v, &t->cnfa, &v->g->cmap, NULL);
	if (ISERR())
	    return NULL;
    }
    return v->subdfas[t->id];
}

/*
 - simpleFind - find a match for the main NFA (no-complications case)
 ^ static int simpleFind(struct vars *, struct cnfa *, struct colormap *);
 - find - find a match for the main NFA (no-complications case)
 ^ static int find(struct vars *, struct cnfa *, struct colormap *);
 */
static int
simpleFind(
    struct vars *const v,
    struct cnfa *const cnfa,
    struct colormap *const cm)
find(
    struct vars *v,
    struct cnfa *cnfa,
    struct colormap *cm)
{
    struct dfa *s, *d;
    chr *begin, *end = NULL;
    struct dfa *s;
    struct dfa *d;
    chr *begin;
    chr *end = NULL;
    chr *cold;
    chr *open, *close;		/* Open and close of range of possible
    chr *open;			/* Open and close of range of possible
				 * starts */
    chr *close;
    int hitend;
    int shorter = (v->g->tree->flags&SHORTER) ? 1 : 0;

    /*
     * First, a shot with the search RE.
     */

    s = newDFA(v, &v->g->search, cm, &v->dfa1);
    s = newdfa(v, &v->g->search, cm, &v->dfa1);
    assert(!(ISERR() && s != NULL));
    NOERR();
    MDEBUG(("\nsearch at %ld\n", LOFF(v->start)));
    cold = NULL;
    close = shortest(v, s, v->start, v->start, v->stop, &cold, NULL);
    freeDFA(s);
    freedfa(s);
    NOERR();
    if (v->g->cflags&REG_EXPECT) {
	assert(v->details != NULL);
	if (cold != NULL) {
	    v->details->rm_extend.rm_so = OFF(cold);
	} else {
	    v->details->rm_extend.rm_so = OFF(v->stop);
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
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







-
+









-
+
-
-
-








-
+







     * Find starting point and match.
     */

    assert(cold != NULL);
    open = cold;
    cold = NULL;
    MDEBUG(("between %ld and %ld\n", LOFF(open), LOFF(close)));
    d = newDFA(v, cnfa, cm, &v->dfa1);
    d = newdfa(v, cnfa, cm, &v->dfa1);
    assert(!(ISERR() && d != NULL));
    NOERR();
    for (begin = open; begin <= close; begin++) {
	MDEBUG(("\nfind trying at %ld\n", LOFF(begin)));
	if (shorter) {
	    end = shortest(v, d, begin, begin, v->stop, NULL, &hitend);
	} else {
	    end = longest(v, d, begin, v->stop, &hitend);
	}
	if (ISERR()) {
	NOERR();
	    freeDFA(d);
	    return v->err;
	}
	if (hitend && cold == NULL) {
	    cold = begin;
	}
	if (end != NULL) {
	    break;		/* NOTE BREAK OUT */
	}
    }
    assert(end != NULL);	/* search RE succeeded so loop should */
    freeDFA(d);
    freedfa(d);

    /*
     * And pin down details.
     */

    assert(v->nmatch > 0);
    v->pmatch[0].rm_so = OFF(begin);
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
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
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
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







-
+


-
-
+
+



-
-
+
+


-
-
-
-
+
+
+
+

-
+
+



-
+

-
+


-
+



-
+

-
-
+
+














-
-
+
+



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

-
+
+

-
+

+
-
-
+
+
+

+















-
+
















-
+
+











-







	v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
    }
    if (v->nmatch == 1) {	/* no need for submatches */
	return REG_OKAY;
    }

    /*
     * Find submatches.
     * Submatches.
     */

    zapallsubs(v->pmatch, v->nmatch);
    return cdissect(v, v->g->tree, begin, end);
    zapsubs(v->pmatch, v->nmatch);
    return dissect(v, v->g->tree, begin, end);
}

/*
 - complicatedFind - find a match for the main NFA (with complications)
 ^ static int complicatedFind(struct vars *, struct cnfa *, struct colormap *);
 - cfind - find a match for the main NFA (with complications)
 ^ static int cfind(struct vars *, struct cnfa *, struct colormap *);
 */
static int
complicatedFind(
    struct vars *const v,
    struct cnfa *const cnfa,
    struct colormap *const cm)
cfind(
    struct vars *v,
    struct cnfa *cnfa,
    struct colormap *cm)
{
    struct dfa *s, *d;
    struct dfa *s;
    struct dfa *d;
    chr *cold = NULL; /* silence gcc 4 warning */
    int ret;

    s = newDFA(v, &v->g->search, cm, &v->dfa1);
    s = newdfa(v, &v->g->search, cm, &v->dfa1);
    NOERR();
    d = newDFA(v, cnfa, cm, &v->dfa2);
    d = newdfa(v, cnfa, cm, &v->dfa2);
    if (ISERR()) {
	assert(d == NULL);
	freeDFA(s);
	freedfa(s);
	return v->err;
    }

    ret = complicatedFindLoop(v, d, s, &cold);
    ret = cfindloop(v, cnfa, cm, d, s, &cold);

    freeDFA(d);
    freeDFA(s);
    freedfa(d);
    freedfa(s);
    NOERR();
    if (v->g->cflags&REG_EXPECT) {
	assert(v->details != NULL);
	if (cold != NULL) {
	    v->details->rm_extend.rm_so = OFF(cold);
	} else {
	    v->details->rm_extend.rm_so = OFF(v->stop);
	}
	v->details->rm_extend.rm_eo = OFF(v->stop);	/* unknown */
    }
    return ret;
}

/*
 - complicatedFindLoop - the heart of complicatedFind
 ^ static int complicatedFindLoop(struct vars *,
 - cfindloop - the heart of cfind
 ^ static int cfindloop(struct vars *, struct cnfa *, struct colormap *,
 ^	struct dfa *, struct dfa *, chr **);
 */
static int
complicatedFindLoop(
    struct vars *const v,
    struct dfa *const d,
    struct dfa *const s,
    chr **const coldp)		/* where to put coldstart pointer */
cfindloop(
    struct vars *v,
    struct cnfa *cnfa,
    struct colormap *cm,
    struct dfa *d,
    struct dfa *s,
    chr **coldp)		/* where to put coldstart pointer */
{
    chr *begin, *end;
    chr *begin;
    chr *end;
    chr *cold;
    chr *open, *close;		/* Open and close of range of possible
    chr *open;			/* Open and close of range of possible
				 * starts */
    chr *close;
    chr *estart, *estop;
    int er, hitend;
    chr *estart;
    chr *estop;
    int er;
    int shorter = v->g->tree->flags&SHORTER;
    int hitend;

    assert(d != NULL && s != NULL);
    cold = NULL;
    close = v->start;
    do {
	MDEBUG(("\ncsearch at %ld\n", LOFF(close)));
	close = shortest(v, s, close, close, v->stop, &cold, NULL);
	if (close == NULL) {
	    break;		/* NOTE BREAK */
	}
	assert(cold != NULL);
	open = cold;
	cold = NULL;
	MDEBUG(("cbetween %ld and %ld\n", LOFF(open), LOFF(close)));
	for (begin = open; begin <= close; begin++) {
	    MDEBUG(("\ncomplicatedFind trying at %ld\n", LOFF(begin)));
	    MDEBUG(("\ncfind trying at %ld\n", LOFF(begin)));
	    estart = begin;
	    estop = v->stop;
	    for (;;) {
		if (shorter) {
		    end = shortest(v, d, begin, estart, estop, NULL, &hitend);
		} else {
		    end = longest(v, d, begin, estop, &hitend);
		}
		if (hitend && cold == NULL) {
		    cold = begin;
		}
		if (end == NULL) {
		    break;	/* NOTE BREAK OUT */
		}

		MDEBUG(("tentative end %ld\n", LOFF(end)));
		zapallsubs(v->pmatch, v->nmatch);
		zapsubs(v->pmatch, v->nmatch);
		zapmem(v, v->g->tree);
		er = cdissect(v, v->g->tree, begin, end);
		if (er == REG_OKAY) {
		    if (v->nmatch > 0) {
			v->pmatch[0].rm_so = OFF(begin);
			v->pmatch[0].rm_eo = OFF(end);
		    }
		    *coldp = cold;
		    return REG_OKAY;
		}
		if (er != REG_NOMATCH) {
		    ERR(er);
		    *coldp = cold;
		    return er;
		}
		if ((shorter) ? end == estop : end == begin) {
		    break;
		}

		/*
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
611
612
613











































































































































































614
615
616
617
618
619
620
621


622
623
624
625
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
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
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
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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




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
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







-
-
+
+


-
-
-
+
+
+










-
-
+
+


-
-
-
+
+
+

+
+
+
+
+
+

-
+
-
-
-
-
+
+
-



-
+


-
+




-
-
+
+



-
-
-
-
+
+
+
+














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






-
-
+
+









-
-
-
+
+
+
+
+

-
+
-


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







-
+

-
+
-

-
-
-
-
-
-
-
-
-



-
+
+
+






-
-
+
+



+




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




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











-
+
-






-
+

+
+



-
+
+
+













-
+
+
+








-
+
+
+


-
-
-
+
+
+
+




-
-
+
+
+
+


-
+


-
-
+
+

-
+
+

+






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





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











-
+
-








+
+



-
+
+
+













-
+
+
+








-
+
+
+


-
-
-
+
+
+
+




-
+






-
-
+
+

+
-
+
-
-
-
-
+
+

+
+
+






-
+

-
-
+


-
-
+
+

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






-
-
+


-
-
+
+
-

+
-
-
-
+
+
+
+
+

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

-
+






-
-
+
+



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

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

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

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

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











    } while (close < v->stop);

    *coldp = cold;
    return REG_NOMATCH;
}

/*
 - zapallsubs - initialize all subexpression matches to "no match"
 ^ static void zapallsubs(regmatch_t *, size_t);
 - zapsubs - initialize the subexpression matches to "no match"
 ^ static VOID zapsubs(regmatch_t *, size_t);
 */
static void
zapallsubs(
    regmatch_t *const p,
    const size_t n)
zapsubs(
    regmatch_t *p,
    size_t n)
{
    size_t i;

    for (i = n-1; i > 0; i--) {
	p[i].rm_so = -1;
	p[i].rm_eo = -1;
    }
}

/*
 - zaptreesubs - initialize subexpressions within subtree to "no match"
 ^ static void zaptreesubs(struct vars *, struct subre *);
 - zapmem - initialize the retry memory of a subtree to zeros
 ^ static VOID zapmem(struct vars *, struct subre *);
 */
static void
zaptreesubs(
    struct vars *const v,
    struct subre *const t)
zapmem(
    struct vars *v,
    struct subre *t)
{
    if (t == NULL) {
	return;
    }

    assert(v->mem != NULL);
    v->mem[t->retry] = 0;
    if (t->op == '(') {
	int n = t->subno;
	assert(t->subno > 0);
	assert(n > 0);
	if ((size_t) n < v->nmatch) {
	    v->pmatch[n].rm_so = -1;
	    v->pmatch[n].rm_eo = -1;
	v->pmatch[t->subno].rm_so = -1;
		v->pmatch[t->subno].rm_eo = -1;
	}
    }

    if (t->left != NULL) {
	zaptreesubs(v, t->left);
	zapmem(v, t->left);
    }
    if (t->right != NULL) {
	zaptreesubs(v, t->right);
	zapmem(v, t->right);
    }
}

/*
 - subset - set subexpression match data for a successful subre
 ^ static void subset(struct vars *, struct subre *, chr *, chr *);
 - subset - set any subexpression relevant to a successful subre
 ^ static VOID subset(struct vars *, struct subre *, chr *, chr *);
 */
static void
subset(
    struct vars *const v,
    struct subre *const sub,
    chr *const begin,
    chr *const end)
    struct vars *v,
    struct subre *sub,
    chr *begin,
    chr *end)
{
    int n = sub->subno;

    assert(n > 0);
    if ((size_t)n >= v->nmatch) {
	return;
    }

    MDEBUG(("setting %d\n", n));
    v->pmatch[n].rm_so = OFF(begin);
    v->pmatch[n].rm_eo = OFF(end);
}

/*
 - cdissect - check backrefs and determine subexpression matches
 * cdissect recursively processes a subre tree to check matching of backrefs
 * and/or identify submatch boundaries for capture nodes.  The proposed match
 * runs from "begin" to "end" (not including "end"), and we are basically
 * "dissecting" it to see where the submatches are.
 * Before calling any level of cdissect, the caller must have run the node's
 * DFA and found that the proposed substring satisfies the DFA.  (We make
 * the caller do that because in concatenation and iteration nodes, it's
 * much faster to check all the substrings against the child DFAs before we
 * recurse.)  Also, caller must have cleared subexpression match data via
 * zaptreesubs (or zapallsubs at the top level).
 - dissect - determine subexpression matches (uncomplicated case)
 ^ static int dissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
dissect(
    struct vars *v,
    struct subre *t,
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    assert(t != NULL);
    MDEBUG(("dissect %ld-%ld\n", LOFF(begin), LOFF(end)));

    switch (t->op) {
    case '=':			/* terminal node */
	assert(t->left == NULL && t->right == NULL);
	return REG_OKAY;	/* no action, parent did the work */
    case '|':			/* alternation */
	assert(t->left != NULL);
	return altdissect(v, t, begin, end);
    case 'b':			/* back ref -- shouldn't be calling us! */
	return REG_ASSERT;
    case '.':			/* concatenation */
	assert(t->left != NULL && t->right != NULL);
	return condissect(v, t, begin, end);
    case '(':			/* capturing */
	assert(t->left != NULL && t->right == NULL);
	assert(t->subno > 0);
	subset(v, t, begin, end);
	return dissect(v, t->left, begin, end);
    default:
	return REG_ASSERT;
    }
}

/*
 - condissect - determine concatenation subexpression matches (uncomplicated)
 ^ static int condissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
condissect(
    struct vars *v,
    struct subre *t,
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    struct dfa *d;
    struct dfa *d2;
    chr *mid;
    int i;
    int shorter = (t->left->flags&SHORTER) ? 1 : 0;
    chr *stop = (shorter) ? end : begin;

    assert(t->op == '.');
    assert(t->left != NULL && t->left->cnfa.nstates > 0);
    assert(t->right != NULL && t->right->cnfa.nstates > 0);

    d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
    NOERR();
    d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, &v->dfa2);
    if (ISERR()) {
	assert(d2 == NULL);
	freedfa(d);
	return v->err;
    }

    /*
     * Pick a tentative midpoint.
     */

    if (shorter) {
	mid = shortest(v, d, begin, begin, end, NULL, NULL);
    } else {
	mid = longest(v, d, begin, end, NULL);
    }
    if (mid == NULL) {
	freedfa(d);
	freedfa(d2);
	return REG_ASSERT;
    }
    MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));

    /*
     * Iterate until satisfaction or failure.
     */

    while (longest(v, d2, mid, end, NULL) != end) {
	/*
	 * That midpoint didn't work, find a new one.
	 */

	if (mid == stop) {
	    /*
	     * All possibilities exhausted!
	     */

	    MDEBUG(("no midpoint!\n"));
	    freedfa(d);
	    freedfa(d2);
	    return REG_ASSERT;
	}
	if (shorter) {
	    mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
	} else {
	    mid = longest(v, d, begin, mid-1, NULL);
	}
	if (mid == NULL) {
	    /*
	     * Failed to find a new one!
	     */

	    MDEBUG(("failed midpoint!\n"));
	    freedfa(d);
	    freedfa(d2);
	    return REG_ASSERT;
	}
	MDEBUG(("new midpoint %ld\n", LOFF(mid)));
    }

    /*
     * Satisfaction.
     */

    MDEBUG(("successful\n"));
    freedfa(d);
    freedfa(d2);
    i = dissect(v, t->left, begin, mid);
    if (i != REG_OKAY) {
	return i;
    }
    return dissect(v, t->right, mid, end);
}

/*
 - altdissect - determine alternative subexpression matches (uncomplicated)
 ^ static int altdissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
altdissect(
    struct vars *v,
    struct subre *t,
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    struct dfa *d;
    int i;

    assert(t != NULL);
    assert(t->op == '|');

    for (i = 0; t != NULL; t = t->right, i++) {
	MDEBUG(("trying %dth\n", i));
	assert(t->left != NULL && t->left->cnfa.nstates > 0);
	d = newdfa(v, &t->left->cnfa, &v->g->cmap, &v->dfa1);
	if (ISERR()) {
	    return v->err;
	}
	if (longest(v, d, begin, end, NULL) == end) {
	    MDEBUG(("success\n"));
	    freedfa(d);
	    return dissect(v, t->left, begin, end);
	}
	freedfa(d);
    }
    return REG_ASSERT;		/* none of them matched?!? */
}

/*
 - cdissect - determine subexpression matches (with complications)
 * The retry memory stores the offset of the trial midpoint from begin, plus 1
 * so that 0 uniquely means "clean slate".
 ^ static int cdissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
cdissect(
    struct vars *v,
    struct subre *t,
    chr *begin,		/* beginning of relevant substring */
    chr *end)		/* end of same */
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    int er;

    assert(t != NULL);
    MDEBUG(("cdissect %ld-%ld %c\n", LOFF(begin), LOFF(end), t->op));

    switch (t->op) {
    case '=':			/* terminal node */
	assert(t->left == NULL && t->right == NULL);
	er = REG_OKAY;		/* no action, parent did the work */
	break;
    case 'b':			/* back reference */
	return REG_OKAY;	/* no action, parent did the work */
    case '|':			/* alternation */
	assert(t->left != NULL);
	return caltdissect(v, t, begin, end);
    case 'b':			/* back ref -- shouldn't be calling us! */
	assert(t->left == NULL && t->right == NULL);
	er = cbrdissect(v, t, begin, end);
	return cbrdissect(v, t, begin, end);
	break;
    case '.':			/* concatenation */
	assert(t->left != NULL && t->right != NULL);
	if (t->left->flags & SHORTER) /* reverse scan */
	    er = crevcondissect(v, t, begin, end);
	else
	    er = ccondissect(v, t, begin, end);
	return ccondissect(v, t, begin, end);
	break;
    case '|':			/* alternation */
	assert(t->left != NULL);
	er = caltdissect(v, t, begin, end);
	break;
    case '*':			/* iteration */
	assert(t->left != NULL);
	if (t->left->flags & SHORTER) /* reverse scan */
	    er = creviterdissect(v, t, begin, end);
	else
	    er = citerdissect(v, t, begin, end);
	break;
    case '(':			/* capturing */
	assert(t->left != NULL && t->right == NULL);
	assert(t->subno > 0);
	er = cdissect(v, t->left, begin, end);
	if (er == REG_OKAY) {
	    subset(v, t, begin, end);
	}
	break;
	return er;
    default:
	er = REG_ASSERT;
	return REG_ASSERT;
	break;
    }

    /*
     * We should never have a match failure unless backrefs lurk below;
     * otherwise, either caller failed to check the DFA, or there's some
     * inconsistency between the DFA and the node's innards.
     */
    assert(er != REG_NOMATCH || (t->flags & BACKR));

    return er;
}

/*
 - ccondissect - dissect match for concatenation node
 - ccondissect - concatenation subexpression matches (with complications)
 * The retry memory stores the offset of the trial midpoint from begin, plus 1
 * so that 0 uniquely means "clean slate".
 ^ static int ccondissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
ccondissect(
    struct vars *v,
    struct subre *t,
    chr *begin,		/* beginning of relevant substring */
    chr *end)		/* end of same */
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    struct dfa *d, *d2;
    chr *mid;
    int er;

    assert(t->op == '.');
    assert(t->left != NULL && t->left->cnfa.nstates > 0);
    assert(t->right != NULL && t->right->cnfa.nstates > 0);

    assert(!(t->left->flags & SHORTER));

    d = getsubdfa(v, t->left);
    NOERR();
    d2 = getsubdfa(v, t->right);
    NOERR();

    MDEBUG(("cConcat %d\n", t->id));
    if (t->left->flags&SHORTER) { /* reverse scan */
	return crevdissect(v, t, begin, end);
    }

    d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
    if (ISERR()) {
	return v->err;
    }
    d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
    if (ISERR()) {
	freedfa(d);
	return v->err;
    }
    MDEBUG(("cconcat %d\n", t->retry));

    /*
     * Pick a tentative midpoint.
     */

    if (v->mem[t->retry] == 0) {
    mid = longest(v, d, begin, end, (int *) NULL);
    if (mid == NULL) {
	return REG_NOMATCH;
    }
    MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
	mid = longest(v, d, begin, end, NULL);
	if (mid == NULL) {
	    freedfa(d);
	    freedfa(d2);
	    return REG_NOMATCH;
	}
	MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
	v->mem[t->retry] = (mid - begin) + 1;
    } else {
	mid = begin + (v->mem[t->retry] - 1);
	MDEBUG(("working midpoint %ld\n", LOFF(mid)));
    }

    /*
     * Iterate until satisfaction or failure.
     */

    for (;;) {
	/*
	 * Try this midpoint on for size.
	 */

	if (longest(v, d2, mid, end, NULL) == end) {
	    int er = cdissect(v, t->left, begin, mid);
	    er = cdissect(v, t->left, begin, mid);

	    if (er == REG_OKAY) {
		er = cdissect(v, t->right, mid, end);
		if (er == REG_OKAY) {
		    /*
		     * Satisfaction.
		     */

		    
		    MDEBUG(("successful\n"));
		    freedfa(d);
		    freedfa(d2);
		    return REG_OKAY;
		}
	    }
	    if (er != REG_NOMATCH) {
	    if ((er != REG_OKAY) && (er != REG_NOMATCH)) {
		freedfa(d);
		freedfa(d2);
		return er;
	    }
	}

	/*
	 * That midpoint didn't work, find a new one.
	 */

	if (mid == begin) {
	    /*
	     * All possibilities exhausted.
	     */

	    MDEBUG(("%d no midpoint\n", t->id));
	    MDEBUG(("%d no midpoint\n", t->retry));
	    freedfa(d);
	    freedfa(d2);
	    return REG_NOMATCH;
	}
	mid = longest(v, d, begin, mid-1, NULL);
	if (mid == NULL) {
	    /*
	     * Failed to find a new one.
	     */

	    MDEBUG(("%d failed midpoint\n", t->id));
	    MDEBUG(("%d failed midpoint\n", t->retry));
	    freedfa(d);
	    freedfa(d2);
	    return REG_NOMATCH;
	}
	MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid)));
	zaptreesubs(v, t->left);
	zaptreesubs(v, t->right);
	MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
	v->mem[t->retry] = (mid - begin) + 1;
	zapmem(v, t->left);
	zapmem(v, t->right);
    }
}

/*
 - crevcondissect - dissect match for concatenation node, shortest-first
 ^ static int crevcondissect(struct vars *, struct subre *, chr *, chr *);
 - crevdissect - determine backref shortest-first subexpression matches
 * The retry memory stores the offset of the trial midpoint from begin, plus 1
 * so that 0 uniquely means "clean slate".
 ^ static int crevdissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
crevcondissect(
crevdissect(
    struct vars *v,
    struct subre *t,
    chr *begin,		/* beginning of relevant substring */
    chr *end)		/* end of same */
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    struct dfa *d, *d2;
    struct dfa *d;
    struct dfa *d2;
    chr *mid;
    int er;

    assert(t->op == '.');
    assert(t->left != NULL && t->left->cnfa.nstates > 0);
    assert(t->right != NULL && t->right->cnfa.nstates > 0);
    assert(t->left->flags&SHORTER);

    /*
     * Concatenation -- need to split the substring between parts.
     */
    d = getsubdfa(v, t->left);
    NOERR();
    d2 = getsubdfa(v, t->right);
    NOERR();

    MDEBUG(("crevcon %d\n", t->id));

    d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
    if (ISERR()) {
	return v->err;
    }
    d2 = newdfa(v, &t->right->cnfa, &v->g->cmap, DOMALLOC);
    if (ISERR()) {
	freedfa(d);
	return v->err;
    }
    MDEBUG(("crev %d\n", t->retry));

    /*
     * Pick a tentative midpoint.
     */

    if (v->mem[t->retry] == 0) {
    mid = shortest(v, d, begin, begin, end, (chr **) NULL, (int *) NULL);
    if (mid == NULL) {
	return REG_NOMATCH;
    }
    MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
	mid = shortest(v, d, begin, begin, end, NULL, NULL);
	if (mid == NULL) {
	    freedfa(d);
	    freedfa(d2);
	    return REG_NOMATCH;
	}
	MDEBUG(("tentative midpoint %ld\n", LOFF(mid)));
	v->mem[t->retry] = (mid - begin) + 1;
    } else {
	mid = begin + (v->mem[t->retry] - 1);
	MDEBUG(("working midpoint %ld\n", LOFF(mid)));
    }

    /*
     * Iterate until satisfaction or failure.
     */

    for (;;) {
	/*
	 * Try this midpoint on for size.
	 */

	if (longest(v, d2, mid, end, NULL) == end) {
	    int er = cdissect(v, t->left, begin, mid);
	    er = cdissect(v, t->left, begin, mid);

	    if (er == REG_OKAY) {
		er = cdissect(v, t->right, mid, end);
		if (er == REG_OKAY) {
		    /*
		     * Satisfaction.
		     */

		    MDEBUG(("successful\n"));
		    freedfa(d);
		    freedfa(d2);
		    return REG_OKAY;
		}
	    }
	    if (er != REG_NOMATCH) {
	    if (er != REG_OKAY && er != REG_NOMATCH) {
		freedfa(d);
		freedfa(d2);
		return er;
	    }
	}

	/*
	 * That midpoint didn't work, find a new one.
	 */

	if (mid == end) {
	    /*
	     * All possibilities exhausted.
	     */

	    MDEBUG(("%d no midpoint\n", t->id));
	    MDEBUG(("%d no midpoint\n", t->retry));
	    freedfa(d);
	    freedfa(d2);
	    return REG_NOMATCH;
	}
	mid = shortest(v, d, begin, mid+1, end, NULL, NULL);
	if (mid == NULL) {
	    /*
	     * Failed to find a new one.
	     */

	    MDEBUG(("%d failed midpoint\n", t->id));
	    MDEBUG(("%d failed midpoint\n", t->retry));
	    freedfa(d);
	    freedfa(d2);
	    return REG_NOMATCH;
	}
	MDEBUG(("%d: new midpoint %ld\n", t->id, LOFF(mid)));
	zaptreesubs(v, t->left);
	zaptreesubs(v, t->right);
	MDEBUG(("%d: new midpoint %ld\n", t->retry, LOFF(mid)));
	v->mem[t->retry] = (mid - begin) + 1;
	zapmem(v, t->left);
	zapmem(v, t->right);
    }
}

/*
 - cbrdissect - dissect match for backref node
 - cbrdissect - determine backref subexpression matches
 ^ static int cbrdissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
cbrdissect(
    struct vars *v,
    struct subre *t,
    chr *begin,		/* beginning of relevant substring */
    chr *end)		/* end of same */
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    int i;
    int n = t->subno, min = t->min, max = t->max;
    int n = t->subno;
    size_t numreps;
    size_t tlen;
    size_t brlen;
    chr *brstring;
    size_t len;
    chr *paren;
    chr *p;
    chr *stop;
    int min = t->min;
    int max = t->max;

    assert(t != NULL);
    assert(t->op == 'b');
    assert(n >= 0);
    assert((size_t)n < v->nmatch);

    MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max));
    MDEBUG(("cbackref n%d %d{%d-%d}\n", t->retry, n, min, max));

    /* get the backreferenced string */
    if (v->pmatch[n].rm_so == TCL_INDEX_NONE) {
    if (v->pmatch[n].rm_so == -1) {
	return REG_NOMATCH;
    }
    brstring = v->start + v->pmatch[n].rm_so;
    brlen = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;
    paren = v->start + v->pmatch[n].rm_so;
    len = v->pmatch[n].rm_eo - v->pmatch[n].rm_so;

    /* special cases for zero-length strings */
    if (brlen == 0) {
	/*
    /*
	 * matches only if target is zero length, but any number of
	 * repetitions can be considered to be present
	 */
	if (begin == end && min <= max) {
     * No room to maneuver -- retries are pointless.
     */

	    MDEBUG(("cbackref matched trivially\n"));
	    return REG_OKAY;
	}
	return REG_NOMATCH;
    }
    if (begin == end) {
    if (v->mem[t->retry]) {
	return REG_NOMATCH;
    }
    v->mem[t->retry] = 1;

    /*
     * Special-case zero-length string.
     */

    if (len == 0) {
	if (begin == end) {
	/* matches only if zero repetitions are okay */
	if (min == 0) {
	    MDEBUG(("cbackref matched trivially\n"));
	    return REG_OKAY;
	}
	return REG_NOMATCH;
    }

    /*
     * check target length to see if it could possibly be an allowed number of
     * repetitions of brstring
     * And too-short string.
     */

    assert(end > begin);
    tlen = end - begin;
    assert(end >= begin);
    if ((size_t)(end - begin) < len) {
    if (tlen % brlen != 0)
	return REG_NOMATCH;
    }
    numreps = tlen / brlen;
    if (numreps < (size_t)min || (numreps > (size_t)max && max != DUPINF))
	return REG_NOMATCH;
    stop = end - len;

    /*
     * Count occurrences.
     */

    /* okay, compare the actual string contents */
    p = begin;
    while (numreps-- > 0) {
	if ((*v->g->compare) (brstring, p, brlen) != 0)
    i = 0;
    for (p = begin; p <= stop && (i < max || max == DUPINF); p += len) {
	if ((*v->g->compare)(paren, p, len) != 0) {
	    return REG_NOMATCH;
	p += brlen;
    }

    MDEBUG(("cbackref matched\n"));
    return REG_OKAY;
}

	    break;
	}
	i++;
    }
    MDEBUG(("cbackref found %d\n", i));

    /*
     * And sort it out.
     */

    if (p != end) {		/* didn't consume all of it */
	return REG_NOMATCH;
    }
    if (min <= i && (i <= max || max == DUPINF)) {
	return REG_OKAY;
    }
    return REG_NOMATCH;		/* out of range */
}

/*
 - caltdissect - dissect match for alternation node
 - caltdissect - determine alternative subexpression matches (w. complications)
 ^ static int caltdissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
caltdissect(
    struct vars *v,
    struct subre *t,
    chr *begin,		/* beginning of relevant substring */
    chr *end)		/* end of same */
    chr *begin,			/* beginning of relevant substring */
    chr *end)			/* end of same */
{
    struct dfa *d;
    int er;

#define	UNTRIED	0		/* not yet tried at all */
    /* We loop, rather than tail-recurse, to handle a chain of alternatives */
    while (t != NULL) {
	assert(t->op == '|');
	assert(t->left != NULL && t->left->cnfa.nstates > 0);

#define	TRYING	1		/* top matched, trying submatches */
	MDEBUG(("calt n%d\n", t->id));

#define	TRIED	2		/* top didn't match or submatches exhausted */
	d = getsubdfa(v, t->left);
	NOERR();
	if (longest(v, d, begin, end, (int *) NULL) == end) {
	    MDEBUG(("calt matched\n"));
	    er = cdissect(v, t->left, begin, end);
	    if (er != REG_NOMATCH) {
		return er;
	    }

	}

    if (t == NULL) {
	t = t->right;
    }

    return REG_NOMATCH;
}
	return REG_NOMATCH;
    }

/*
 - citerdissect - dissect match for iteration node
 ^ static int citerdissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
citerdissect(struct vars * v,
	     struct subre * t,
	     chr *begin,	/* beginning of relevant substring */
	     chr *end)		/* end of same */
{
    struct dfa *d;
    chr	  **endpts;
    chr	   *limit;
    int		min_matches;
    size_t	max_matches;
    int		nverified;
    int		k;
    int		i;
    int		er;

    assert(t->op == '*');
    assert(t->op == '|');
    assert(t->left != NULL && t->left->cnfa.nstates > 0);
    assert(!(t->left->flags & SHORTER));
    assert(begin <= end);

    if (v->mem[t->retry] == TRIED) {
    /*
     * If zero matches are allowed, and target string is empty, just declare
     * victory.  OTOH, if target string isn't empty, zero matches can't work
     * so we pretend the min is 1.
     */
    min_matches = t->min;
    if (min_matches <= 0) {
	if (begin == end)
	    return REG_OKAY;
	min_matches = 1;
    }

	return caltdissect(v, t->right, begin, end);
    /*
     * We need workspace to track the endpoints of each sub-match.  Normally
     * we consider only nonzero-length sub-matches, so there can be at most
     * end-begin of them.  However, if min is larger than that, we will also
     * consider zero-length sub-matches in order to find enough matches.
     *
     * For convenience, endpts[0] contains the "begin" pointer and we store
     * sub-match endpoints in endpts[1..max_matches].
     */
    max_matches = end - begin;
    if (max_matches > (size_t)t->max && t->max != DUPINF)
	max_matches = t->max;
    if (max_matches < (size_t)min_matches)
	max_matches = min_matches;
    endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
    if (endpts == NULL)
	return REG_ESPACE;
    endpts[0] = begin;

    }
    d = getsubdfa(v, t->left);
    if (ISERR()) {
	FREE(endpts);
	return v->err;
    }
    MDEBUG(("citer %d\n", t->id));

    /*
     * Our strategy is to first find a set of sub-match endpoints that are
     * valid according to the child node's DFA, and then recursively dissect
     * each sub-match to confirm validity.  If any validity check fails,
     * backtrack the last sub-match and try again.  And, when we next try for
     * a validity check, we need not recheck any successfully verified
     * sub-matches that we didn't move the endpoints of.  nverified remembers
     * how many sub-matches are currently known okay.
     */

    /* initialize to consider first sub-match */
    nverified = 0;
    k = 1;
    limit = end;

    MDEBUG(("calt n%d\n", t->retry));
    /* iterate until satisfaction or failure */
    while (k > 0) {
	/* try to find an endpoint for the k'th sub-match */
	endpts[k] = longest(v, d, endpts[k - 1], limit, (int *) NULL);
	if (endpts[k] == NULL) {
	    /* no match possible, so see if we can shorten previous one */
	    k--;
	    goto backtrack;
	}
	MDEBUG(("%d: working endpoint %d: %ld\n",
		t->id, k, LOFF(endpts[k])));

    assert(t->left != NULL);
	/* k'th sub-match can no longer be considered verified */
	if (nverified >= k)
	    nverified = k - 1;

	if (endpts[k] != end) {
	    /* haven't reached end yet, try another iteration if allowed */
	    if ((size_t)k >= max_matches) {
		/* must try to shorten some previous match */
		k--;
		goto backtrack;
	    }

    if (v->mem[t->retry] == UNTRIED) {
	    /* reject zero-length match unless necessary to achieve min */
	    if (endpts[k] == endpts[k - 1] &&
		(k >= min_matches || min_matches - k < end - endpts[k]))
		goto backtrack;

	d = newdfa(v, &t->left->cnfa, &v->g->cmap, DOMALLOC);
	    k++;
	    limit = end;
	    continue;
	}

	if (ISERR()) {
	/*
	 * We've identified a way to divide the string into k sub-matches
	 * that works so far as the child DFA can tell.  If k is an allowed
	 * number of matches, start the slow part: recurse to verify each
	 * sub-match.  We always have k <= max_matches, needn't check that.
	 */
	if (k < min_matches)
	    goto backtrack;

	MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));

	for (i = nverified + 1; i <= k; i++) {
	    zaptreesubs(v, t->left);
	    er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
	    if (er == REG_OKAY) {
		nverified = i;
		continue;
	    }
	    if (er == REG_NOMATCH)
		break;
	    /* oops, something failed */
	    FREE(endpts);
	    return er;
	    return v->err;
	}

	if (i > k) {
	    /* satisfaction */
	    MDEBUG(("%d successful\n", t->id));
	    FREE(endpts);
	    return REG_OKAY;
	}

	/* match failed to verify, so backtrack */

    backtrack:
	/*
	 * Must consider shorter versions of the current sub-match.  However,
	 * we'll only ask for a zero-length match if necessary.
	 */
	while (k > 0) {
	    chr	   *prev_end = endpts[k - 1];

	    if (endpts[k] > prev_end) {
		limit = endpts[k] - 1;
		if (limit > prev_end ||
		    (k < min_matches && min_matches - k >= end - prev_end)) {
		    /* break out of backtrack loop, continue the outer one */
		    break;
		}
	}
	    }
	    /* can't shorten k'th sub-match any more, consider previous one */
	    k--;
	}
    }

	if (longest(v, d, begin, end, NULL) != end) {
    /* all possibilities exhausted */
    MDEBUG(("%d failed\n", t->id));
    FREE(endpts);
    return REG_NOMATCH;
}

	    freedfa(d);
/*
 - creviterdissect - dissect match for iteration node, shortest-first
 ^ static int creviterdissect(struct vars *, struct subre *, chr *, chr *);
 */
static int			/* regexec return code */
creviterdissect(struct vars * v,
		struct subre * t,
		chr *begin,	/* beginning of relevant substring */
		chr *end)	/* end of same */
{
    struct dfa *d;
    chr	  **endpts;
    chr	   *limit;
    int		min_matches;
    size_t	max_matches;
    int		nverified;
    int		k;
    int		i;
    int		er;

	    v->mem[t->retry] = TRIED;
    assert(t->op == '*');
    assert(t->left != NULL && t->left->cnfa.nstates > 0);
    assert(t->left->flags & SHORTER);
    assert(begin <= end);

	    return caltdissect(v, t->right, begin, end);
    /*
     * If zero matches are allowed, and target string is empty, just declare
     * victory.  OTOH, if target string isn't empty, zero matches can't work
     * so we pretend the min is 1.
     */
    min_matches = t->min;
    if (min_matches <= 0) {
	if (begin == end)
	    return REG_OKAY;
	min_matches = 1;
    }

	}
	freedfa(d);
    /*
     * We need workspace to track the endpoints of each sub-match.  Normally
     * we consider only nonzero-length sub-matches, so there can be at most
     * end-begin of them.  However, if min is larger than that, we will also
     * consider zero-length sub-matches in order to find enough matches.
     *
     * For convenience, endpts[0] contains the "begin" pointer and we store
     * sub-match endpoints in endpts[1..max_matches].
     */
    max_matches = end - begin;
    if (max_matches > (size_t)t->max && t->max != DUPINF)
	max_matches = t->max;
    if (max_matches < (size_t)min_matches)
	max_matches = min_matches;
    endpts = (chr **) MALLOC((max_matches + 1) * sizeof(chr *));
    if (endpts == NULL)
	return REG_ESPACE;
    endpts[0] = begin;

	MDEBUG(("calt matched\n"));
    d = getsubdfa(v, t->left);
    if (ISERR()) {
	FREE(endpts);
	return v->err;
    }
    MDEBUG(("creviter %d\n", t->id));

	v->mem[t->retry] = TRYING;
    /*
     * Our strategy is to first find a set of sub-match endpoints that are
     * valid according to the child node's DFA, and then recursively dissect
     * each sub-match to confirm validity.  If any validity check fails,
     * backtrack the last sub-match and try again.  And, when we next try for
     * a validity check, we need not recheck any successfully verified
     * sub-matches that we didn't move the endpoints of.  nverified remembers
     * how many sub-matches are currently known okay.
     */

    }
    /* initialize to consider first sub-match */
    nverified = 0;
    k = 1;
    limit = begin;

    /* iterate until satisfaction or failure */
    while (k > 0) {
	/* disallow zero-length match unless necessary to achieve min */
	if (limit == endpts[k - 1] &&
	    limit != end &&
	    (k >= min_matches || min_matches - k < end - limit))
	    limit++;

	/* if this is the last allowed sub-match, it must reach to the end */
	if ((size_t)k >= max_matches)
	    limit = end;

	/* try to find an endpoint for the k'th sub-match */
	endpts[k] = shortest(v, d, endpts[k - 1], limit, end,
			     (chr **) NULL, (int *) NULL);
	if (endpts[k] == NULL) {
	    /* no match possible, so see if we can lengthen previous one */
	    k--;
	    goto backtrack;
	}
	MDEBUG(("%d: working endpoint %d: %ld\n",
		t->id, k, LOFF(endpts[k])));

	/* k'th sub-match can no longer be considered verified */
	if (nverified >= k)
	    nverified = k - 1;

	if (endpts[k] != end) {
	    /* haven't reached end yet, try another iteration if allowed */
	    if ((size_t)k >= max_matches) {
		/* must try to lengthen some previous match */
		k--;
		goto backtrack;
	    }

	    k++;
	    limit = endpts[k - 1];
	    continue;
	}

	/*
	 * We've identified a way to divide the string into k sub-matches
	 * that works so far as the child DFA can tell.  If k is an allowed
	 * number of matches, start the slow part: recurse to verify each
	 * sub-match.  We always have k <= max_matches, needn't check that.
	 */
	if (k < min_matches)
	    goto backtrack;

	MDEBUG(("%d: verifying %d..%d\n", t->id, nverified + 1, k));

	for (i = nverified + 1; i <= k; i++) {
	    zaptreesubs(v, t->left);
	    er = cdissect(v, t->left, endpts[i - 1], endpts[i]);
    er = cdissect(v, t->left, begin, end);
	    if (er == REG_OKAY) {
		nverified = i;
		continue;
	    }
	    if (er == REG_NOMATCH)
    if (er != REG_NOMATCH) {
		break;
	    /* oops, something failed */
	    FREE(endpts);
	    return er;
	}
	return er;
    }

	if (i > k) {
	    /* satisfaction */
	    MDEBUG(("%d successful\n", t->id));
	    FREE(endpts);
	    return REG_OKAY;
	}

    v->mem[t->retry] = TRIED;
	/* match failed to verify, so backtrack */

    return caltdissect(v, t->right, begin, end);
    backtrack:
	/*
	 * Must consider longer versions of the current sub-match.
	 */
	while (k > 0) {
	    if (endpts[k] < end) {
		limit = endpts[k] + 1;
		/* break out of backtrack loop, continue the outer one */
		break;
	    }
	    /* can't lengthen k'th sub-match any more, consider previous one */
	    k--;
	}
    }

    /* all possibilities exhausted */
    MDEBUG(("%d failed\n", t->id));
    FREE(endpts);
    return REG_NOMATCH;
}

#include "rege_dfa.c"

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/regfronts.c.

35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49







-
+








/*
 - regcomp - compile regular expression
 */
int
regcomp(
    regex_t *re,
    const char *str,
    CONST char *str,
    int flags)
{
    size_t len;
    int f = flags;

    if (f&REG_PEND) {
	len = re->re_endp - str;
57
58
59
60
61
62
63
64

65
66
67
68
69

70
71
72
73
74
75
76
57
58
59
60
61
62
63

64
65
66
67
68

69
70
71
72
73
74
75
76







-
+




-
+








/*
 - regexec - execute regular expression
 */
int
regexec(
    regex_t *re,
    const char *str,
    CONST char *str,
    size_t nmatch,
    regmatch_t pmatch[],
    int flags)
{
    const char *start;
    CONST char *start;
    size_t len;
    int f = flags;

    if (f & REG_STARTEND) {
	start = str + pmatch[0].rm_so;
	len = pmatch[0].rm_eo - pmatch[0].rm_so;
	f &= ~REG_STARTEND;

Changes to generic/regguts.h.

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
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







+
+
+
+
+
+
+
+
+










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






-
+


-
+



+
+
+









+




-
+







 * care here and elsewhere.
 */
#include "regcustom.h"

/*
 * Things that regcustom.h might override.
 */

/* standard header files (NULL is a reasonable indicator for them) */
#ifndef NULL
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <limits.h>
#include <string.h>
#endif

/* assertions */
#ifndef assert
#ifndef REG_DEBUG
#ifndef NDEBUG
#define	NDEBUG		/* no assertions */
#endif
#endif /* !REG_DEBUG */
#include <assert.h>
#endif

/* voids */
#ifndef VOID
#define	VOID	void		/* for function return values */
#endif
#ifndef DISCARD
#define	DISCARD	void		/* for throwing values away */
#endif
#ifndef PVOID
#define	PVOID	void *		/* generic pointer */
#endif
#ifndef VS
#define	VS(x)	((void*)(x))	/* cast something to generic ptr */
#endif
#ifndef NOPARMS
#define	NOPARMS	void		/* for empty parm lists */
#endif

/* const */
#ifndef CONST
#define	CONST	const		/* for old compilers, might be empty */
#endif

/* function-pointer declarator */
#ifndef FUNCPTR
#if __STDC__ >= 1
#define	FUNCPTR(name, args)	(*name)args
#else
#define	FUNCPTR(name, args)	(*name)()
#endif
#endif

/* memory allocation */
#ifndef MALLOC
#define	MALLOC(n)	malloc(n)
#endif
#ifndef REALLOC
#define	REALLOC(p, n)	realloc(p, n)
#define	REALLOC(p, n)	realloc(VS(p), n)
#endif
#ifndef FREE
#define	FREE(p)		free(p)
#define	FREE(p)		free(VS(p))
#endif

/* want size of a char in bits, and max value in bounded quantifiers */
#ifndef CHAR_BIT
#include <limits.h>
#endif
#ifndef _POSIX2_RE_DUP_MAX
#define	_POSIX2_RE_DUP_MAX 255	/* normally from <limits.h> */
#endif

/*
 * misc
 */

#define	NOTREACHED	0
#define	xxx		1

#define	DUPMAX	_POSIX2_RE_DUP_MAX
#define	DUPINF	(DUPMAX+1)

#define	REMAGIC	0xFED7		/* magic number for main struct */
#define	REMAGIC	0xfed7		/* magic number for main struct */

/*
 * debugging facilities
 */
#ifdef REG_DEBUG
/* FDEBUG does finite-state tracing */
#define	FDEBUG(arglist)	{ if (v->eflags&REG_FTRACE) printf arglist; }
155
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
171
172
173
174
175
176
199
200
201
202
203
204
205


206






207
208
209
210
211
212
213







-
-
+
-
-
-
-
-
-







    int flags;
#define	FREECOL	01		/* currently free */
#define	PSEUDO	02		/* pseudocolor, no real chars */
#define	UNUSEDCOLOR(cd)	((cd)->flags&FREECOL)
    union tree *block;		/* block of solid color, if any */
};

/*
 * The color map itself
/* the color map itself */
 *
 * Much of the data in the colormap struct is only used at compile time.
 * However, the bulk of the space usage is in the "tree" structure, so it's
 * not clear that there's much point in converting the rest to a more compact
 * form when compilation is finished.
 */
struct colormap {
    int magic;
#define	CMMAGIC	0x876
    struct vars *v;		/* for compile error reporting */
    size_t ncds;		/* number of colordescs */
    size_t max;			/* highest in use */
    color free;			/* beginning of free chain (if non-0) */
218
219
220
221
222
223
224
225


226
227
228
229

230
231
232
233
234
235
236
255
256
257
258
259
260
261

262
263
264
265
266

267
268
269
270
271
272
273
274







-
+
+



-
+







 * Having a "from" pointer within each arc may seem redundant, but it saves a
 * lot of hassle.
 */

struct state;

struct arc {
    int type;			/* 0 if free, else an NFA arc type code */
    int type;
#define	ARCFREE	'\0'
    color co;
    struct state *from;		/* where it's from (and contained within) */
    struct state *to;		/* where it's to */
    struct arc *outchain;	/* link in *from's outs chain or free chain */
    struct arc *outchain;	/* *from's outs chain or free chain */
    struct arc *outchainRev;	/* back-link in *from's outs chain */
#define	freechain outchain	/* we do not maintain "freechainRev" */
    struct arc *inchain;	/* *to's ins chain */
    struct arc *inchainRev;	/* back-link in *to's ins chain */
    struct arc *colorchain;	/* color's arc chain */
    struct arc *colorchainRev;	/* back-link in color's arc chain */
};
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
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







+
+
+






-
-
-
-
-
-
-
-
-
-
-




-
+











-
-

-






-
-
+
-
-
-
-

+
-
-
+
+
-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+
+















-
+

-
-
+
+














-
+








-
+





-
+

-
+












-
+












    int nstates;		/* for numbering states */
    struct state *states;	/* state-chain header */
    struct state *slast;	/* tail of the chain */
    struct state *free;		/* free list */
    struct colormap *cm;	/* the color map */
    color bos[2];		/* colors, if any, assigned to BOS and BOL */
    color eos[2];		/* colors, if any, assigned to EOS and EOL */
    size_t size;		/* Current NFA size; differs from nstates as
				 * it also counts the number of states created
				 * by children of this state. */
    struct vars *v;		/* simplifies compile error reporting */
    struct nfa *parent;		/* parent NFA, if any */
};

/*
 * definitions for compacted NFA
 *
 * The main space savings in a compacted NFA is from making the arcs as small
 * as possible.  We store only the transition color and next-state number for
 * each arc.  The list of out arcs for each state is an array beginning at
 * cnfa.states[statenumber], and terminated by a dummy carc struct with
 * co == COLORLESS.
 *
 * The non-dummy carc structs are of two types: plain arcs and LACON arcs.
 * Plain arcs just store the transition color number as "co".  LACON arcs
 * store the lookahead constraint number plus cnfa.ncolors as "co".  LACON
 * arcs can be distinguished from plain by testing for co >= cnfa.ncolors.
 */

struct carc {
    color co;			/* COLORLESS is list terminator */
    int to;			/* next-state number */
    int to;			/* state number */
};

struct cnfa {
    int nstates;		/* number of states */
    int ncolors;		/* number of colors */
    int flags;
#define	HASLACONS	01	/* uses lookahead constraints */
    int pre;			/* setup state number */
    int post;			/* teardown state number */
    color bos[2];		/* colors, if any, assigned to BOS and BOL */
    color eos[2];		/* colors, if any, assigned to EOS and EOL */
    char *stflags;		/* vector of per-state flags bytes */
#define CNFA_NOPROGRESS	01	/* flag bit for a no-progress state */
    struct carc **states;	/* vector of pointers to outarc lists */
    /* states[n] are pointers into a single malloc'd array of arcs */
    struct carc *arcs;		/* the area for the lists */
};
#define	ZAPCNFA(cnfa)	((cnfa).nstates = 0)
#define	NULLCNFA(cnfa)	((cnfa).nstates == 0)

/*
 * This symbol limits the transient heap space used by the regex compiler,
 * and thereby also the maximum complexity of NFAs that we'll deal with.
 * Used to limit the maximum NFA size to something sane. [Bug 1810264]
 * Currently we only count NFA states and arcs against this; the other
 * transient data is generally not large enough to notice compared to those.
 * Note that we do not charge anything for the final output data structures
 * (the compacted NFA and the colormap).
 */

#ifndef REG_MAX_COMPILE_SPACE
#define REG_MAX_COMPILE_SPACE  \
#ifndef REG_MAX_STATES
#   define REG_MAX_STATES	100000
	(100000 * sizeof(struct state) + 100000 * sizeof(struct arcbatch))
#endif

/*
 * subexpression tree
 *
 * "op" is one of:
 *	'='  plain regex without interesting substructure (implemented as DFA)
 *	'b'  back-reference (has no substructure either)
 *	'('  capture node: captures the match of its single child
 *	'.'  concatenation: matches a match for left, then a match for right
 *	'|'  alternation: matches a match for left or a match for right
 *	'*'  iteration: matches some number of matches of its single child
 *
 * Note: the right child of an alternation must be another alternation or
 * NULL; hence, an N-way branch requires N alternation nodes, not N-1 as you
 * might expect.  This could stand to be changed.  Actually I'd rather see
 * a single alternation node with N children, but that will take revising
 * the representation of struct subre.
 *
 * Note: when a backref is directly quantified, we stick the min/max counts
 * into the backref rather than plastering an iteration node on top.  This is
 * for efficiency: there is no need to search for possible division points.
 */

struct subre {
    char op;			/* see type codes above */
    char op;			/* '|', '.' (concat), 'b' (backref), '(',
				 * '=' */
    char flags;
#define	LONGER	01		/* prefers longer match */
#define	SHORTER	02		/* prefers shorter match */
#define	MIXED	04		/* mixed preference below */
#define	CAP	010		/* capturing parens below */
#define	BACKR	020		/* back reference below */
#define	INUSE	0100		/* in use in final tree */
#define	NOPROP	03		/* bits which may not propagate up */
#define	LMIX(f)	((f)<<2)	/* LONGER -> MIXED */
#define	SMIX(f)	((f)<<1)	/* SHORTER -> MIXED */
#define	UP(f)	(((f)&~NOPROP) | (LMIX(f) & SMIX(f) & MIXED))
#define	MESSY(f)	((f)&(MIXED|CAP|BACKR))
#define	PREF(f)	((f)&NOPROP)
#define	PREF2(f1, f2)	((PREF(f1) != 0) ? PREF(f1) : PREF(f2))
#define	COMBINE(f1, f2)	(UP((f1)|(f2)) | PREF2(f1, f2))
    short id;			/* ID of subre (1..ntree-1) */
    short retry;		/* index into retry memory */
    int subno;			/* subexpression number (for 'b' and '(') */
    short min;			/* min repetitions for iteration or backref */
    short max;			/* max repetitions for iteration or backref */
    short min;			/* min repetitions, for backref only */
    short max;			/* max repetitions, for backref only */
    struct subre *left;		/* left child, if any (also freelist chain) */
    struct subre *right;	/* right child, if any */
    struct state *begin;	/* outarcs from here... */
    struct state *end;		/* ...ending in inarcs here */
    struct cnfa cnfa;		/* compacted NFA, if any */
    struct subre *chain;	/* for bookkeeping and error cleanup */
};

/*
 * table of function pointers for generic manipulation functions. A regex_t's
 * re_fns points to one of these.
 */

struct fns {
    void (*free) (regex_t *);
    VOID FUNCPTR(free, (regex_t *));
};

/*
 * the insides of a regex_t, hidden behind a void *
 */

struct guts {
    int magic;
#define	GUTSMAGIC	0xFED9
#define	GUTSMAGIC	0xfed9
    int cflags;			/* copy of compile flags */
    long info;			/* copy of re_info */
    size_t nsub;		/* copy of re_nsub */
    struct subre *tree;
    struct cnfa search;		/* for fast preliminary search */
    int ntree;			/* number of subre's, plus one */
    int ntree;
    struct colormap cmap;
    int (*compare) (const chr *, const chr *, size_t);
    int FUNCPTR(compare, (CONST chr *, CONST chr *, size_t));
    struct subre *lacons;	/* lookahead-constraint vector */
    int nlacons;		/* size of lacons */
};

/*
 * Magic for allocating a variable workspace. This default version is
 * stack-hungry.
 */

#ifndef AllocVars
#define AllocVars(vPtr) \
    struct vars var; \
    struct vars *vPtr = &var
    register struct vars *vPtr = &var
#endif
#ifndef FreeVars
#define FreeVars(vPtr) ((void) 0)
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tcl.decls.

1
2
3
4
5
6
7
8
9


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


8
9
10
11
12
13
14
15
16







-
-
+
+







# tcl.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Tcl library via the stubs table.
#	This file is used to generate the tclDecls.h, tclPlatDecls.h
#	and tclStubInit.c files.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2001, 2002 Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

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
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







-
+


-
+

-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+









-
+





-
+





-
+








-
+






-
+










-
-
-
+
+
-
+

-
+










-
-
-
+
+
-
+




-
+









-
+



-
+











-
-
-
-
+
+
+
-
+










-
+








# Declare each of the functions in the public Tcl interface.  Note that
# the an index should never be reused for a different function in order
# to preserve backwards compatibility.

declare 0 {
    int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name,
	    const char *version, const void *clientData)
	    const char *version, ClientData clientData)
}
declare 1 {
    const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
    CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
	    ClientData *clientDataPtr)
}
declare 2 {
    TCL_NORETURN void Tcl_Panic(const char *format, ...)
    void Tcl_Panic(const char *format, ...)
}
declare 3 {
    void *Tcl_Alloc(size_t size)
    char *Tcl_Alloc(unsigned int size)
}
declare 4 {
    void Tcl_Free(void *ptr)
    void Tcl_Free(char *ptr)
}
declare 5 {
    void *Tcl_Realloc(void *ptr, size_t size)
    char *Tcl_Realloc(char *ptr, unsigned int size)
}
declare 6 {
    void *Tcl_DbCkalloc(size_t size, const char *file, int line)
    char *Tcl_DbCkalloc(unsigned int size, const char *file, int line)
}
declare 7 {
    void Tcl_DbCkfree(void *ptr, const char *file, int line)
    void Tcl_DbCkfree(char *ptr, const char *file, int line)
}
declare 8 {
    void *Tcl_DbCkrealloc(void *ptr, size_t size,
    char *Tcl_DbCkrealloc(char *ptr, unsigned int size,
	    const char *file, int line)
}

# Tcl_CreateFileHandler and Tcl_DeleteFileHandler are only available on unix,
# but they are part of the old generic interface, so we include them here for
# compatibility reasons.

declare 9 unix {
    void Tcl_CreateFileHandler(int fd, int mask, Tcl_FileProc *proc,
	    void *clientData)
	    ClientData clientData)
}
declare 10 unix {
    void Tcl_DeleteFileHandler(int fd)
}
declare 11 {
    void Tcl_SetTimer(const Tcl_Time *timePtr)
    void Tcl_SetTimer(Tcl_Time *timePtr)
}
declare 12 {
    void Tcl_Sleep(int ms)
}
declare 13 {
    int Tcl_WaitForEvent(const Tcl_Time *timePtr)
    int Tcl_WaitForEvent(Tcl_Time *timePtr)
}
declare 14 {
    int Tcl_AppendAllObjTypes(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 15 {
    void Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...)
}
declare 16 {
    void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, size_t length)
    void Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
declare 17 {
    Tcl_Obj *Tcl_ConcatObj(int objc, Tcl_Obj *const objv[])
}
declare 18 {
    int Tcl_ConvertToType(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const Tcl_ObjType *typePtr)
	    Tcl_ObjType *typePtr)
}
declare 19 {
    void Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file, int line)
}
declare 20 {
    void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file, int line)
}
declare 21 {
    int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 22 {
#    Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
declare 22 {
    Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
#}
}
declare 23 {
    Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, size_t length,
    Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int length,
	    const char *file, int line)
}
declare 24 {
    Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
	    int line)
}
declare 25 {
    Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
	    const char *file, int line)
}
# Removed in 9.0 (changed to macro):
#declare 26 {
#    Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
declare 26 {
    Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
#}
}
declare 27 {
    Tcl_Obj *Tcl_DbNewObj(const char *file, int line)
}
declare 28 {
    Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, size_t length,
    Tcl_Obj *Tcl_DbNewStringObj(const char *bytes, int length,
	    const char *file, int line)
}
declare 29 {
    Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr)
}
declare 30 {
    void TclFreeObj(Tcl_Obj *objPtr)
}
declare 31 {
    int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr)
    int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *intPtr)
}
declare 32 {
    int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int *boolPtr)
	    int *intPtr)
}
declare 33 {
    unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 34 {
    int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
}
declare 35 {
    int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    double *doublePtr)
}
# Removed in 9.0, replaced by macro.
#declare 36 {
#    int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
#	    const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
declare 36 {
    int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CONST84 char **tablePtr, const char *msg, int flags, int *indexPtr)
#}
}
declare 37 {
    int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
}
declare 38 {
    int Tcl_GetIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr)
}
declare 39 {
    int Tcl_GetLongFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr)
}
declare 40 {
    const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
    Tcl_ObjType *Tcl_GetObjType(const char *typeName)
}
declare 41 {
    char *Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}
declare 42 {
    void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
}
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
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
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

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







-
-
-
+
+
-
+

-
+




-
-
-
+
+
-
+



-
-
-
+
+
-
+




-
+

-
-
-
+
+
-
+

-
+



-
+




-
-
-
+
+
-
+



-
-
-
+
+
-
+

-
+


-
+

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











-
+













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






-
+


-
+

-
-
-
+
+
-
+




-
+


-
+


-
+





-
+







-
-
+
+



-
+



-
+



-
+




-
+


-
+




-
-
-
-
-
+
+
+
+
-
+



-
+



-
+




-
+



-
+






-
+



-
+








-
+



-
+


-
+







    int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int *lengthPtr)
}
declare 48 {
    int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
	    int count, int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 49 {
#    Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
declare 49 {
    Tcl_Obj *Tcl_NewBooleanObj(int intValue)
#}
}
declare 50 {
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, size_t length)
    Tcl_Obj *Tcl_NewByteArrayObj(const unsigned char *bytes, int length)
}
declare 51 {
    Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 52 {
#    Tcl_Obj *Tcl_NewIntObj(int intValue)
declare 52 {
    Tcl_Obj *Tcl_NewIntObj(int intValue)
#}
}
declare 53 {
    Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 54 {
#    Tcl_Obj *Tcl_NewLongObj(long longValue)
declare 54 {
    Tcl_Obj *Tcl_NewLongObj(long longValue)
#}
}
declare 55 {
    Tcl_Obj *Tcl_NewObj(void)
}
declare 56 {
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, size_t length)
    Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
# Removed in 9.0 (changed to macro):
#declare 57 {
#    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
declare 57 {
    void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue)
#}
}
declare 58 {
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, size_t length)
    unsigned char *Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes)
}
declare 59 {
    void Tcl_SetByteArrayObj(Tcl_Obj *objPtr, const unsigned char *bytes,
	    size_t length)
	    int numBytes)
}
declare 60 {
    void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
# Removed in 9.0 (changed to macro):
#declare 61 {
#    void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
declare 61 {
    void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
#}
}
declare 62 {
    void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
# Removed in 9.0 (changed to macro):
#declare 63 {
#    void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
declare 63 {
    void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
#}
}
declare 64 {
    void Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length)
    void Tcl_SetObjLength(Tcl_Obj *objPtr, int length)
}
declare 65 {
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, size_t length)
    void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
# Removed in 9.0, replaced by macro.
#declare 66 {
#    void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
declare 66 {
    void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
#}
# Removed in 9.0, replaced by macro.
#declare 67 {
#    void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
#	    int length)
}
declare 67 {
    void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
	    int length)
#}
}
declare 68 {
    void Tcl_AllowExceptions(Tcl_Interp *interp)
}
declare 69 {
    void Tcl_AppendElement(Tcl_Interp *interp, const char *element)
}
declare 70 {
    void Tcl_AppendResult(Tcl_Interp *interp, ...)
}
declare 71 {
    Tcl_AsyncHandler Tcl_AsyncCreate(Tcl_AsyncProc *proc,
	    void *clientData)
	    ClientData clientData)
}
declare 72 {
    void Tcl_AsyncDelete(Tcl_AsyncHandler async)
}
declare 73 {
    int Tcl_AsyncInvoke(Tcl_Interp *interp, int code)
}
declare 74 {
    void Tcl_AsyncMark(Tcl_AsyncHandler async)
}
declare 75 {
    int Tcl_AsyncReady(void)
}
# Removed in 9.0
#declare 76 {
#    void Tcl_BackgroundError(Tcl_Interp *interp)
declare 76 {
    void Tcl_BackgroundError(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 77 {
#    char Tcl_Backslash(const char *src, int *readPtr)
}
declare 77 {
    char Tcl_Backslash(const char *src, int *readPtr)
#}
}
declare 78 {
    int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
	    const char *optionList)
}
declare 79 {
    void Tcl_CallWhenDeleted(Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
	    void *clientData)
	    ClientData clientData)
}
declare 80 {
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, void *clientData)
    void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
}
# Removed in 9.0:
#declare 81 {
#    int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
declare 81 {
    int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
#}
}
declare 82 {
    int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
    char *Tcl_Concat(int argc, const char *const *argv)
    char *Tcl_Concat(int argc, CONST84 char *const *argv)
}
declare 84 {
    size_t Tcl_ConvertElement(const char *src, char *dst, int flags)
    int Tcl_ConvertElement(const char *src, char *dst, int flags)
}
declare 85 {
    size_t Tcl_ConvertCountedElement(const char *src, size_t length, char *dst,
    int Tcl_ConvertCountedElement(const char *src, int length, char *dst,
	    int flags)
}
declare 86 {
    int Tcl_CreateAlias(Tcl_Interp *childInterp, const char *childCmd,
	    Tcl_Interp *target, const char *targetCmd, int argc,
	    const char *const *argv)
	    CONST84 char *const *argv)
}
declare 87 {
    int Tcl_CreateAliasObj(Tcl_Interp *childInterp, const char *childCmd,
	    Tcl_Interp *target, const char *targetCmd, int objc,
	    Tcl_Obj *const objv[])
}
declare 88 {
    Tcl_Channel Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
	    const char *chanName, void *instanceData, int mask)
    Tcl_Channel Tcl_CreateChannel(Tcl_ChannelType *typePtr,
	    const char *chanName, ClientData instanceData, int mask)
}
declare 89 {
    void Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
	    Tcl_ChannelProc *proc, void *clientData)
	    Tcl_ChannelProc *proc, ClientData clientData)
}
declare 90 {
    void Tcl_CreateCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    void *clientData)
	    ClientData clientData)
}
declare 91 {
    Tcl_Command Tcl_CreateCommand(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdProc *proc, void *clientData,
	    Tcl_CmdProc *proc, ClientData clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 92 {
    void Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, void *clientData)
	    Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, void *clientData)
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}
# Removed in 9.0:
#declare 95 {
#    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
#	    int numArgs, Tcl_ValueType *argTypes,
#	    Tcl_MathProc *proc, void *clientData)
declare 95 {
    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
	    int numArgs, Tcl_ValueType *argTypes,
	    Tcl_MathProc *proc, ClientData clientData)
#}
}
declare 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
	    Tcl_ObjCmdProc *proc, void *clientData,
	    Tcl_ObjCmdProc *proc, ClientData clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 97 {
    Tcl_Interp *Tcl_CreateChild(Tcl_Interp *interp, const char *name,
    Tcl_Interp *Tcl_CreateSlave(Tcl_Interp *interp, const char *name,
	    int isSafe)
}
declare 98 {
    Tcl_TimerToken Tcl_CreateTimerHandler(int milliseconds,
	    Tcl_TimerProc *proc, void *clientData)
	    Tcl_TimerProc *proc, ClientData clientData)
}
declare 99 {
    Tcl_Trace Tcl_CreateTrace(Tcl_Interp *interp, int level,
	    Tcl_CmdTraceProc *proc, void *clientData)
	    Tcl_CmdTraceProc *proc, ClientData clientData)
}
declare 100 {
    void Tcl_DeleteAssocData(Tcl_Interp *interp, const char *name)
}
declare 101 {
    void Tcl_DeleteChannelHandler(Tcl_Channel chan, Tcl_ChannelProc *proc,
	    void *clientData)
	    ClientData clientData)
}
declare 102 {
    void Tcl_DeleteCloseHandler(Tcl_Channel chan, Tcl_CloseProc *proc,
	    void *clientData)
	    ClientData clientData)
}
declare 103 {
    int Tcl_DeleteCommand(Tcl_Interp *interp, const char *cmdName)
}
declare 104 {
    int Tcl_DeleteCommandFromToken(Tcl_Interp *interp, Tcl_Command command)
}
declare 105 {
    void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, void *clientData)
    void Tcl_DeleteEvents(Tcl_EventDeleteProc *proc, ClientData clientData)
}
declare 106 {
    void Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
	    Tcl_EventCheckProc *checkProc, void *clientData)
	    Tcl_EventCheckProc *checkProc, ClientData clientData)
}
declare 107 {
    void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, void *clientData)
    void Tcl_DeleteExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 108 {
    void Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
}
declare 109 {
    void Tcl_DeleteHashTable(Tcl_HashTable *tablePtr)
}
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
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
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







-
+





-
+


-
+




















-
+








-
+


-
+

-
-
-
+
+
-
+



-
-
-
+
+
-
+

-
+


-
+







    void Tcl_DeleteTimerHandler(Tcl_TimerToken token)
}
declare 113 {
    void Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace)
}
declare 114 {
    void Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
	    Tcl_InterpDeleteProc *proc, void *clientData)
	    Tcl_InterpDeleteProc *proc, ClientData clientData)
}
declare 115 {
    int Tcl_DoOneEvent(int flags)
}
declare 116 {
    void Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData)
    void Tcl_DoWhenIdle(Tcl_IdleProc *proc, ClientData clientData)
}
declare 117 {
    char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, size_t length)
    char *Tcl_DStringAppend(Tcl_DString *dsPtr, const char *bytes, int length)
}
declare 118 {
    char *Tcl_DStringAppendElement(Tcl_DString *dsPtr, const char *element)
}
declare 119 {
    void Tcl_DStringEndSublist(Tcl_DString *dsPtr)
}
declare 120 {
    void Tcl_DStringFree(Tcl_DString *dsPtr)
}
declare 121 {
    void Tcl_DStringGetResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
declare 122 {
    void Tcl_DStringInit(Tcl_DString *dsPtr)
}
declare 123 {
    void Tcl_DStringResult(Tcl_Interp *interp, Tcl_DString *dsPtr)
}
declare 124 {
    void Tcl_DStringSetLength(Tcl_DString *dsPtr, size_t length)
    void Tcl_DStringSetLength(Tcl_DString *dsPtr, int length)
}
declare 125 {
    void Tcl_DStringStartSublist(Tcl_DString *dsPtr)
}
declare 126 {
    int Tcl_Eof(Tcl_Channel chan)
}
declare 127 {
    const char *Tcl_ErrnoId(void)
    CONST84_RETURN char *Tcl_ErrnoId(void)
}
declare 128 {
    const char *Tcl_ErrnoMsg(int err)
    CONST84_RETURN char *Tcl_ErrnoMsg(int err)
}
# Removed in 9.0, replaced by macro.
#declare 129 {
#    int Tcl_Eval(Tcl_Interp *interp, const char *script)
declare 129 {
    int Tcl_Eval(Tcl_Interp *interp, const char *script)
#}
}
declare 130 {
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
# Removed in 9.0, replaced by macro.
#declare 131 {
#    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
declare 131 {
    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
}
declare 132 {
    void Tcl_EventuallyFree(void *clientData, Tcl_FreeProc *freeProc)
    void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
}
declare 133 {
    TCL_NORETURN void Tcl_Exit(int status)
    void Tcl_Exit(int status)
}
declare 134 {
    int Tcl_ExposeCommand(Tcl_Interp *interp, const char *hiddenCmdToken,
	    const char *cmdName)
}
declare 135 {
    int Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr, int *ptr)
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
611
612
613
614
615
616
617

618
619
620
621

622
623
624
625
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
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
595
596
597

598
599
600
601

602
603
604
605
606
607
608
609

610
611
612

613
614
615
616
617
618

619
620
621
622
623



624
625





626
627
628
629

630
631

632
633
634



635
636




637
638
639

640
641
642
643
644
645
646
647







-
-
-
+
+
-
+







-
-
-
+
+
-
+

-
-
-
+
+
+


-
-
+
+



-
+











-
+


-
+





-
+






-
+






-
+






-
+





-
+









-
+



-
+







-
+


-
+





-
+




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

-
+


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







}
declare 142 {
    int Tcl_ExprString(Tcl_Interp *interp, const char *expr)
}
declare 143 {
    void Tcl_Finalize(void)
}
# Removed in 9.0 (stub entry only)
#declare 144 {
#    void Tcl_FindExecutable(const char *argv0)
declare 144 {
    void Tcl_FindExecutable(const char *argv0)
#}
}
declare 145 {
    Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
	    Tcl_HashSearch *searchPtr)
}
declare 146 {
    int Tcl_Flush(Tcl_Channel chan)
}
# Removed in 9.0, TIP 559
#declare 147 {
#    void Tcl_FreeResult(Tcl_Interp *interp)
declare 147 {
    void Tcl_FreeResult(Tcl_Interp *interp)
#}
}
declare 148 {
    int Tcl_GetAlias(Tcl_Interp *interp, const char *childCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
	    int *argcPtr, const char ***argvPtr)
    int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
	    Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
	    int *argcPtr, CONST84 char ***argvPtr)
}
declare 149 {
    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd,
	    Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
    int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
	    Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
	    int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
    void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
    ClientData Tcl_GetAssocData(Tcl_Interp *interp, const char *name,
	    Tcl_InterpDeleteProc **procPtr)
}
declare 151 {
    Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName,
	    int *modePtr)
}
declare 152 {
    int Tcl_GetChannelBufferSize(Tcl_Channel chan)
}
declare 153 {
    int Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
	    void **handlePtr)
	    ClientData *handlePtr)
}
declare 154 {
    void *Tcl_GetChannelInstanceData(Tcl_Channel chan)
    ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan)
}
declare 155 {
    int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
    const char *Tcl_GetChannelName(Tcl_Channel chan)
    CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 {
    int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
	    const char *optionName, Tcl_DString *dsPtr)
}
declare 158 {
    const Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
    Tcl_ChannelType *Tcl_GetChannelType(Tcl_Channel chan)
}
declare 159 {
    int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName,
	    Tcl_CmdInfo *infoPtr)
}
declare 160 {
    const char *Tcl_GetCommandName(Tcl_Interp *interp,
    CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp,
	    Tcl_Command command)
}
declare 161 {
    int Tcl_GetErrno(void)
}
declare 162 {
    const char *Tcl_GetHostName(void)
    CONST84_RETURN char *Tcl_GetHostName(void)
}
declare 163 {
    int Tcl_GetInterpPath(Tcl_Interp *interp, Tcl_Interp *childInterp)
}
declare 164 {
    Tcl_Interp *Tcl_GetParent(Tcl_Interp *interp)
    Tcl_Interp *Tcl_GetMaster(Tcl_Interp *interp)
}
declare 165 {
    const char *Tcl_GetNameOfExecutable(void)
}
declare 166 {
    Tcl_Obj *Tcl_GetObjResult(Tcl_Interp *interp)
}

# Tcl_GetOpenFile is only available on unix, but it is a part of the old
# generic interface, so we include it here for compatibility reasons.
# generic interface, so we inlcude it here for compatibility reasons.

declare 167 unix {
    int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
	    int checkUsage, void **filePtr)
	    int checkUsage, ClientData *filePtr)
}
# Obsolete.  Should now use Tcl_FSGetPathType which is objectified
# and therefore usually faster.
declare 168 {
    Tcl_PathType Tcl_GetPathType(const char *path)
}
declare 169 {
    size_t Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
    int Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr)
}
declare 170 {
    size_t Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr)
    int Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 171 {
    int Tcl_GetServiceMode(void)
}
declare 172 {
    Tcl_Interp *Tcl_GetChild(Tcl_Interp *interp, const char *name)
    Tcl_Interp *Tcl_GetSlave(Tcl_Interp *interp, const char *slaveName)
}
declare 173 {
    Tcl_Channel Tcl_GetStdChannel(int type)
}
# Removed in 9.0, replaced by macro.
#declare 174 {
#    const char *Tcl_GetStringResult(Tcl_Interp *interp)
declare 174 {
    CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp)
#}
# Removed in 9.0, replaced by macro.
#declare 175 {
#    const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
#	    int flags)
}
declare 175 {
    CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
	    int flags)
#}
}
declare 176 {
    const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
    CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}
# Removed in 9.0, replaced by macro.
#declare 177 {
#    int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
declare 177 {
    int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
#}
# Removed in 9.0, replaced by macro.
#declare 178 {
#    int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 178 {
    int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
}
declare 179 {
    int Tcl_HideCommand(Tcl_Interp *interp, const char *cmdName,
	    const char *hiddenCmdToken)
}
declare 180 {
    int Tcl_Init(Tcl_Interp *interp)
}
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

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
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
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
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
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

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







-
+



-
+









-
+





-
+


-
+

















-
+








-
+




-
+


-
+








-
+





-
+














-
+













-
-
+
+


-
+





-
+


-
+

-
-
-
+
+
+
-
+








-
+



















-
+

-
-
-
+
+
-
+



-
-
-
-
+
+
+
-
+












-
-
-
-
+
+
+
-
+

-
+



-
+


-
+






-
+



-
+

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


-
+






-
+







-
-
-
+
+
-
+




-
-
-
-
+
+
+
-
+



-
+




-
-
-
-
+
+
+
-
+







-
-
-
-
+
+
+
-
+

-
+

-
+


-
+











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




-
-
+
+

-
-
-
-
+
+
+
-
+

-
+

-
+

-
-
-
-
+
+
+
-
+

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



-
-
-
+
+
-
+







    int Tcl_InterpDeleted(Tcl_Interp *interp)
}
declare 185 {
    int Tcl_IsSafe(Tcl_Interp *interp)
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
    char *Tcl_JoinPath(int argc, const char *const *argv,
    char *Tcl_JoinPath(int argc, CONST84 char *const *argv,
	    Tcl_DString *resultPtr)
}
declare 187 {
    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, void *addr,
    int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, char *addr,
	    int type)
}

# This slot is reserved for use by the plus patch:
#  declare 188 {
#	Tcl_MainLoop
#  }

declare 189 {
    Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode)
    Tcl_Channel Tcl_MakeFileChannel(ClientData handle, int mode)
}
declare 190 {
    int Tcl_MakeSafe(Tcl_Interp *interp)
}
declare 191 {
    Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket)
    Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
    char *Tcl_Merge(int argc, const char *const *argv)
    char *Tcl_Merge(int argc, CONST84 char *const *argv)
}
declare 193 {
    Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
}
declare 194 {
    void Tcl_NotifyChannel(Tcl_Channel channel, int mask)
}
declare 195 {
    Tcl_Obj *Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	    Tcl_Obj *part2Ptr, int flags)
}
declare 196 {
    Tcl_Obj *Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	    Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags)
}
declare 197 {
    Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
	    const char **argv, int flags)
	    CONST84 char **argv, int flags)
}
# This is obsolete, use Tcl_FSOpenFileChannel
declare 198 {
    Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName,
	    const char *modeString, int permissions)
}
declare 199 {
    Tcl_Channel Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
	    const char *address, const char *myaddr, int myport, int async)
	    const char *address, const char *myaddr, int myport, int flags)
}
declare 200 {
    Tcl_Channel Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
	    const char *host, Tcl_TcpAcceptProc *acceptProc,
	    void *callbackData)
	    ClientData callbackData)
}
declare 201 {
    void Tcl_Preserve(void *data)
    void Tcl_Preserve(ClientData data)
}
declare 202 {
    void Tcl_PrintDouble(Tcl_Interp *interp, double value, char *dst)
}
declare 203 {
    int Tcl_PutEnv(const char *assignment)
}
declare 204 {
    const char *Tcl_PosixError(Tcl_Interp *interp)
    CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
    void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
}
declare 206 {
    size_t Tcl_Read(Tcl_Channel chan, char *bufPtr, size_t toRead)
    int Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead)
}
declare 207 {
    void Tcl_ReapDetachedProcs(void)
}
declare 208 {
    int Tcl_RecordAndEval(Tcl_Interp *interp, const char *cmd, int flags)
}
declare 209 {
    int Tcl_RecordAndEvalObj(Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags)
}
declare 210 {
    void Tcl_RegisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 211 {
    void Tcl_RegisterObjType(const Tcl_ObjType *typePtr)
    void Tcl_RegisterObjType(Tcl_ObjType *typePtr)
}
declare 212 {
    Tcl_RegExp Tcl_RegExpCompile(Tcl_Interp *interp, const char *pattern)
}
declare 213 {
    int Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
	    const char *text, const char *start)
}
declare 214 {
    int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
	    const char *pattern)
}
declare 215 {
    void Tcl_RegExpRange(Tcl_RegExp regexp, size_t index,
	    const char **startPtr, const char **endPtr)
    void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
	    CONST84 char **startPtr, CONST84 char **endPtr)
}
declare 216 {
    void Tcl_Release(void *clientData)
    void Tcl_Release(ClientData clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
    size_t Tcl_ScanElement(const char *src, int *flagPtr)
    int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    size_t Tcl_ScanCountedElement(const char *src, size_t length, int *flagPtr)
    int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Removed in 9.0:
#declare 220 {
#    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
# Obsolete
declare 220 {
    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
#}
}
declare 221 {
    int Tcl_ServiceAll(void)
}
declare 222 {
    int Tcl_ServiceEvent(int flags)
}
declare 223 {
    void Tcl_SetAssocData(Tcl_Interp *interp, const char *name,
	    Tcl_InterpDeleteProc *proc, void *clientData)
	    Tcl_InterpDeleteProc *proc, ClientData clientData)
}
declare 224 {
    void Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz)
}
declare 225 {
    int Tcl_SetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
	    const char *optionName, const char *newValue)
}
declare 226 {
    int Tcl_SetCommandInfo(Tcl_Interp *interp, const char *cmdName,
	    const Tcl_CmdInfo *infoPtr)
}
declare 227 {
    void Tcl_SetErrno(int err)
}
declare 228 {
    void Tcl_SetErrorCode(Tcl_Interp *interp, ...)
}
declare 229 {
    void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
    void Tcl_SetMaxBlockTime(Tcl_Time *timePtr)
}
# Removed in 9.0 (stub entry only)
#declare 230 {
#    void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
declare 230 {
    void Tcl_SetPanicProc(Tcl_PanicProc *panicProc)
#}
}
declare 231 {
    int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth)
}
# Removed in 9.0, replaced by macro.
#declare 232 {
#    void Tcl_SetResult(Tcl_Interp *interp, char *result,
#	    Tcl_FreeProc *freeProc)
declare 232 {
    void Tcl_SetResult(Tcl_Interp *interp, char *result,
	    Tcl_FreeProc *freeProc)
#}
}
declare 233 {
    int Tcl_SetServiceMode(int mode)
}
declare 234 {
    void Tcl_SetObjErrorCode(Tcl_Interp *interp, Tcl_Obj *errorObjPtr)
}
declare 235 {
    void Tcl_SetObjResult(Tcl_Interp *interp, Tcl_Obj *resultObjPtr)
}
declare 236 {
    void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
# Removed in 9.0, replaced by macro.
#declare 237 {
#    const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
#	    const char *newValue, int flags)
declare 237 {
    CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
	    const char *newValue, int flags)
#}
}
declare 238 {
    const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
    CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, const char *newValue, int flags)
}
declare 239 {
    const char *Tcl_SignalId(int sig)
    CONST84_RETURN char *Tcl_SignalId(int sig)
}
declare 240 {
    const char *Tcl_SignalMsg(int sig)
    CONST84_RETURN char *Tcl_SignalMsg(int sig)
}
declare 241 {
    void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 {
    int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
	    const char ***argvPtr)
	    CONST84 char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
    void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
    void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr)
}
# Removed in 9.0 (stub entry only)
#declare 244  {
#    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
#	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
declare 244 {
    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
#}
# Removed in 9.0 (stub entry only)
#declare 245 {
#    int Tcl_StringMatch(const char *str, const char *pattern)
#}
}
declare 245 {
    int Tcl_StringMatch(const char *str, const char *pattern)
}
# Obsolete
# Removed in 9.0:
#declare 246 {
#    int Tcl_TellOld(Tcl_Channel chan)
declare 246 {
    int Tcl_TellOld(Tcl_Channel chan)
#}
# Removed in 9.0, replaced by macro.
#declare 247 {
#    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 247 {
    int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_VarTraceProc *proc, ClientData clientData)
#}
}
declare 248 {
    int Tcl_TraceVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags, Tcl_VarTraceProc *proc, void *clientData)
	    int flags, Tcl_VarTraceProc *proc, ClientData clientData)
}
declare 249 {
    char *Tcl_TranslateFileName(Tcl_Interp *interp, const char *name,
	    Tcl_DString *bufferPtr)
}
declare 250 {
    size_t Tcl_Ungets(Tcl_Channel chan, const char *str, size_t len, int atHead)
    int Tcl_Ungets(Tcl_Channel chan, const char *str, int len, int atHead)
}
declare 251 {
    void Tcl_UnlinkVar(Tcl_Interp *interp, const char *varName)
}
declare 252 {
    int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
# Removed in 9.0, replaced by macro.
#declare 253 {
#    int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
declare 253 {
    int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
#}
}
declare 254 {
    int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
	    int flags)
}
# Removed in 9.0, replaced by macro.
#declare 255 {
#    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
#	    Tcl_VarTraceProc *proc, ClientData clientData)
declare 255 {
    void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_VarTraceProc *proc, ClientData clientData)
#}
}
declare 256 {
    void Tcl_UntraceVar2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *proc,
	    void *clientData)
	    ClientData clientData)
}
declare 257 {
    void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
# Removed in 9.0, replaced by macro.
#declare 258 {
#    int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
#	    const char *varName, const char *localName, int flags)
declare 258 {
    int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
	    const char *varName, const char *localName, int flags)
#}
}
declare 259 {
    int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName, const char *part1,
	    const char *part2, const char *localName, int flags)
}
declare 260 {
    int Tcl_VarEval(Tcl_Interp *interp, ...)
}
# Removed in 9.0, replaced by macro.
#declare 261 {
#    ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
#	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
declare 261 {
    ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
#}
}
declare 262 {
    void *Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
    ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags, Tcl_VarTraceProc *procPtr,
	    void *prevClientData)
	    ClientData prevClientData)
}
declare 263 {
    size_t Tcl_Write(Tcl_Channel chan, const char *s, size_t slen)
    int Tcl_Write(Tcl_Channel chan, const char *s, int slen)
}
declare 264 {
    void Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
	    Tcl_Obj *const objv[], const char *message)
}
declare 265 {
    int Tcl_DumpActiveMemory(const char *fileName)
}
declare 266 {
    void Tcl_ValidateAllMemory(const char *file, int line)
}
# Removed in 9.0:
#declare 267 {
#    void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
declare 267 {
    void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0:
#declare 268 {
#    void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 268 {
    void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
#}
}
declare 269 {
    char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
    const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
	    const char **termPtr)
    CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
	    CONST84 char **termPtr)
}
# Removed in 9.0, replaced by macro.
#declare 271 {
#    const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
#	    const char *version, int exact)
declare 271 {
    CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
	    const char *version, int exact)
#}
}
declare 272 {
    const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
    CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
	    const char *name, const char *version, int exact,
	    void *clientDataPtr)
	    ClientData *clientDataPtr)
}
# Removed in 9.0, replaced by macro.
#declare 273 {
#    int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
#	    const char *version)
declare 273 {
    int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
	    const char *version)
#}
}
# TIP #268: The internally used new Require function is in slot 573.
# Removed in 9.0, replaced by macro.
#declare 274 {
#    const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
#	    const char *version, int exact)
declare 274 {
    CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
	    const char *version, int exact)
#}
# Removed in 9.0:
#declare 275 {
#    void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
declare 275 {
    void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
#}
# Removed in 9.0:
#declare 276 {
#    int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
declare 276 {
    int  Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
#}
}
declare 277 {
    Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
# Removed in 9.0:
#declare 278 {
#    TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
declare 278 {
    void Tcl_PanicVA(const char *format, va_list argList)
#}
}
declare 279 {
    void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
}
declare 280 {
    void Tcl_InitMemory(Tcl_Interp *interp)
}

1047
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1006
1007
1008
1009
1010
1011
1012

1013
1014
1015
1016
1017
1018
1019
1020







-
+







# to the alphabetical order used elsewhere in this file, but I decided
# against that to ease the maintenance of the patch across new tcl versions
# (patch usually has no problems to integrate the patch file for the last
# version into the new one).

declare 281 {
    Tcl_Channel Tcl_StackChannel(Tcl_Interp *interp,
	    const Tcl_ChannelType *typePtr, void *instanceData,
	    Tcl_ChannelType *typePtr, ClientData instanceData,
	    int mask, Tcl_Channel prevChan)
}
declare 282 {
    int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 283 {
    Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan)
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
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
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
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







-
+


-
+

-
-
-
+
+
-
+

-
+










-
+



-
-
+
+




-
+





-
+











-
+






-
+



-
+






-
+












-
+


-
+


-
-
+
+

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















-
+


-
+


-
+


-
+





-
+


-
+


-
+


-
+


-
+


-
+


-
+



-
-
+
+




-
+








-
+





-
+


-
+




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

-
+







declare 286 {
    void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr)
}
declare 287 {
    Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr)
}
declare 288 {
    void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, void *clientData)
    void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 289 {
    void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, void *clientData)
    void Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
# Removed in 9.0, replaced by macro.
#declare 290 {
#    void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
declare 290 {
    void Tcl_DiscardResult(Tcl_SavedResult *statePtr)
#}
}
declare 291 {
    int Tcl_EvalEx(Tcl_Interp *interp, const char *script, size_t numBytes,
    int Tcl_EvalEx(Tcl_Interp *interp, const char *script, int numBytes,
	    int flags)
}
declare 292 {
    int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
declare 293 {
    int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 294 {
    TCL_NORETURN void Tcl_ExitThread(int status)
    void Tcl_ExitThread(int status)
}
declare 295 {
    int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, size_t srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, size_t dstLen,
	    const char *src, int srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, int dstLen,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 296 {
    char *Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
	    const char *src, size_t srcLen, Tcl_DString *dsPtr)
	    const char *src, int srcLen, Tcl_DString *dsPtr)
}
declare 297 {
    void Tcl_FinalizeThread(void)
}
declare 298 {
    void Tcl_FinalizeNotifier(void *clientData)
    void Tcl_FinalizeNotifier(ClientData clientData)
}
declare 299 {
    void Tcl_FreeEncoding(Tcl_Encoding encoding)
}
declare 300 {
    Tcl_ThreadId Tcl_GetCurrentThread(void)
}
declare 301 {
    Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
    const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
    CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 {
    void Tcl_GetEncodingNames(Tcl_Interp *interp)
}
declare 304 {
    int Tcl_GetIndexFromObjStruct(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const void *tablePtr, size_t offset, const char *msg, int flags,
	    const void *tablePtr, int offset, const char *msg, int flags,
	    int *indexPtr)
}
declare 305 {
    void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, size_t size)
    void *Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size)
}
declare 306 {
    Tcl_Obj *Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
	    const char *part2, int flags)
}
declare 307 {
    void *Tcl_InitNotifier(void)
    ClientData Tcl_InitNotifier(void)
}
declare 308 {
    void Tcl_MutexLock(Tcl_Mutex *mutexPtr)
}
declare 309 {
    void Tcl_MutexUnlock(Tcl_Mutex *mutexPtr)
}
declare 310 {
    void Tcl_ConditionNotify(Tcl_Condition *condPtr)
}
declare 311 {
    void Tcl_ConditionWait(Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr,
	    const Tcl_Time *timePtr)
	    Tcl_Time *timePtr)
}
declare 312 {
    size_t Tcl_NumUtfChars(const char *src, size_t length)
    int Tcl_NumUtfChars(const char *src, int length)
}
declare 313 {
    size_t Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
	    size_t charsToRead, int appendFlag)
    int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
	    int charsToRead, int appendFlag)
}
# Removed in 9.0, replaced by macro.
#declare 314 {
#    void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
declare 314 {
    void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
# Removed in 9.0, replaced by macro.
#declare 315 {
#    void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
}
declare 315 {
    void Tcl_SaveResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
#}
}
declare 316 {
    int Tcl_SetSystemEncoding(Tcl_Interp *interp, const char *name)
}
declare 317 {
    Tcl_Obj *Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
	    const char *part2, Tcl_Obj *newValuePtr, int flags)
}
declare 318 {
    void Tcl_ThreadAlert(Tcl_ThreadId threadId)
}
declare 319 {
    void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId, Tcl_Event *evPtr,
	    Tcl_QueuePosition position)
}
declare 320 {
    int Tcl_UniCharAtIndex(const char *src, size_t index)
    Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index)
}
declare 321 {
    int Tcl_UniCharToLower(int ch)
    Tcl_UniChar Tcl_UniCharToLower(int ch)
}
declare 322 {
    int Tcl_UniCharToTitle(int ch)
    Tcl_UniChar Tcl_UniCharToTitle(int ch)
}
declare 323 {
    int Tcl_UniCharToUpper(int ch)
    Tcl_UniChar Tcl_UniCharToUpper(int ch)
}
declare 324 {
    int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
    const char *Tcl_UtfAtIndex(const char *src, size_t index)
    CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index)
}
declare 326 {
    int Tcl_UtfCharComplete(const char *src, size_t length)
    int Tcl_UtfCharComplete(const char *src, int length)
}
declare 327 {
    size_t Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
    int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
    const char *Tcl_UtfFindFirst(const char *src, int ch)
    CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
    const char *Tcl_UtfFindLast(const char *src, int ch)
    CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
    const char *Tcl_UtfNext(const char *src)
    CONST84_RETURN char *Tcl_UtfNext(const char *src)
}
declare 331 {
    const char *Tcl_UtfPrev(const char *src, const char *start)
    CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
    int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
	    const char *src, size_t srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, size_t dstLen,
	    const char *src, int srcLen, int flags,
	    Tcl_EncodingState *statePtr, char *dst, int dstLen,
	    int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr)
}
declare 333 {
    char *Tcl_UtfToExternalDString(Tcl_Encoding encoding,
	    const char *src, size_t srcLen, Tcl_DString *dsPtr)
	    const char *src, int srcLen, Tcl_DString *dsPtr)
}
declare 334 {
    int Tcl_UtfToLower(char *src)
}
declare 335 {
    int Tcl_UtfToTitle(char *src)
}
declare 336 {
    int Tcl_UtfToChar16(const char *src, unsigned short *chPtr)
    int Tcl_UtfToUniChar(const char *src, Tcl_UniChar *chPtr)
}
declare 337 {
    int Tcl_UtfToUpper(char *src)
}
declare 338 {
    size_t Tcl_WriteChars(Tcl_Channel chan, const char *src, size_t srcLen)
    int Tcl_WriteChars(Tcl_Channel chan, const char *src, int srcLen)
}
declare 339 {
    size_t Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
    int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 341 {
#    const char *Tcl_GetDefaultEncodingDir(void)
declare 341 {
    CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
#}
# Removed in 9.0:
#declare 342 {
#    void Tcl_SetDefaultEncodingDir(const char *path)
}
declare 342 {
    void Tcl_SetDefaultEncodingDir(const char *path)
#}
}
declare 343 {
    void Tcl_AlertNotifier(void *clientData)
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
}
declare 345 {
    int Tcl_UniCharIsAlnum(int ch)
}
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
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
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
1439
1440
1441
1442
1443
1444
1445


1446
1447
1448
1449
1450

1451
1452
1453

1454
1455
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475



1476

1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492



1493

1494
1495
1496
1497
1498
1499
1500
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

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
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
1439

1440
1441
1442
1443
1444
1445
1446
1447







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

-
-
+
+


-
-
+
+





-
-
-
-
+
+
+
-
+





-
+



-
-
+
+



-
+


-
-
+
+



-
-
+
+



-
+
















-
+


-
+


















-
+





-
+



-
+


-
+


-
+

-
-
-
+
+
-
+

-
+

-
-
-
-
+
+
+
-
+

















-
+









-
-
+
+




-
+


-
+








-
+









-
-
-
-
+
+
+
-
+












-
-
-
-
+
+
+
-
+







}
declare 350 {
    int Tcl_UniCharIsUpper(int ch)
}
declare 351 {
    int Tcl_UniCharIsWordChar(int ch)
}
# Removed in 9.0:
#declare 352 {
#    size_t Tcl_UniCharLen(const Tcl_UniChar *uniStr)
declare 352 {
    int Tcl_UniCharLen(const Tcl_UniChar *uniStr)
#}
# Removed in 9.0:
#declare 353 {
#    int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
#	    size_t numChars)
}
declare 353 {
    int Tcl_UniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    unsigned long numChars)
#}
}
declare 354 {
    char *Tcl_Char16ToUtfDString(const unsigned short *uniStr,
	    size_t uniLength, Tcl_DString *dsPtr)
    char *Tcl_UniCharToUtfDString(const Tcl_UniChar *uniStr,
	    int uniLength, Tcl_DString *dsPtr)
}
declare 355 {
    unsigned short *Tcl_UtfToChar16DString(const char *src,
	    size_t length, Tcl_DString *dsPtr)
    Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
	    int length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}
# Removed in 9.0:
#declare 357 {
#    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
#	    int count)
declare 357 {
    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    int count)
#}
}
declare 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
    void Tcl_LogCommandInfo(Tcl_Interp *interp, const char *script,
	    const char *command, size_t length)
	    const char *command, int length)
}
declare 360 {
    int Tcl_ParseBraces(Tcl_Interp *interp, const char *start,
	    size_t numBytes, Tcl_Parse *parsePtr, int append,
	    const char **termPtr)
	    int numBytes, Tcl_Parse *parsePtr, int append,
	    CONST84 char **termPtr)
}
declare 361 {
    int Tcl_ParseCommand(Tcl_Interp *interp, const char *start,
	    size_t numBytes, int nested, Tcl_Parse *parsePtr)
	    int numBytes, int nested, Tcl_Parse *parsePtr)
}
declare 362 {
    int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, size_t numBytes,
	    Tcl_Parse *parsePtr)
    int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
	    int numBytes, Tcl_Parse *parsePtr)
}
declare 363 {
    int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
	    size_t numBytes, Tcl_Parse *parsePtr, int append,
	    const char **termPtr)
	    int numBytes, Tcl_Parse *parsePtr, int append,
	    CONST84 char **termPtr)
}
declare 364 {
    int Tcl_ParseVarName(Tcl_Interp *interp, const char *start,
	    size_t numBytes, Tcl_Parse *parsePtr, int append)
	    int numBytes, Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
# Tcl_FSAccess and Tcl_FSStat
declare 365 {
    char *Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 366 {
   int Tcl_Chdir(const char *dirName)
}
declare 367 {
   int Tcl_Access(const char *path, int mode)
}
declare 368 {
    int Tcl_Stat(const char *path, struct stat *bufPtr)
}
declare 369 {
    int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n)
    int Tcl_UtfNcmp(const char *s1, const char *s2, unsigned long n)
}
declare 370 {
    int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n)
    int Tcl_UtfNcasecmp(const char *s1, const char *s2, unsigned long n)
}
declare 371 {
    int Tcl_StringCaseMatch(const char *str, const char *pattern, int nocase)
}
declare 372 {
    int Tcl_UniCharIsControl(int ch)
}
declare 373 {
    int Tcl_UniCharIsGraph(int ch)
}
declare 374 {
    int Tcl_UniCharIsPrint(int ch)
}
declare 375 {
    int Tcl_UniCharIsPunct(int ch)
}
declare 376 {
    int Tcl_RegExpExecObj(Tcl_Interp *interp, Tcl_RegExp regexp,
	    Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags)
	    Tcl_Obj *textObj, int offset, int nmatches, int flags)
}
declare 377 {
    void Tcl_RegExpGetInfo(Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr)
}
declare 378 {
    Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, size_t numChars)
    Tcl_Obj *Tcl_NewUnicodeObj(const Tcl_UniChar *unicode, int numChars)
}
declare 379 {
    void Tcl_SetUnicodeObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    size_t numChars)
	    int numChars)
}
declare 380 {
    size_t Tcl_GetCharLength(Tcl_Obj *objPtr)
    int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
    int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index)
    Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
# Removed in 9.0, replaced by macro.
#declare 382 {
#    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
declare 382 {
    Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
#}
}
declare 383 {
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last)
    Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
}
# Removed in 9.0
#declare 384 {
#    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
#	    size_t length)
declare 384 {
    void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
	    int length)
#}
}
declare 385 {
    int Tcl_RegExpMatchObj(Tcl_Interp *interp, Tcl_Obj *textObj,
	    Tcl_Obj *patternObj)
}
declare 386 {
    void Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr)
}
declare 387 {
    Tcl_Mutex *Tcl_GetAllocMutex(void)
}
declare 388 {
    int Tcl_GetChannelNames(Tcl_Interp *interp)
}
declare 389 {
    int Tcl_GetChannelNamesEx(Tcl_Interp *interp, const char *pattern)
}
declare 390 {
    int Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp,
    int Tcl_ProcObjCmd(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 391 {
    void Tcl_ConditionFinalize(Tcl_Condition *condPtr)
}
declare 392 {
    void Tcl_MutexFinalize(Tcl_Mutex *mutex)
}
declare 393 {
    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc,
	    void *clientData, size_t stackSize, int flags)
    int Tcl_CreateThread(Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc,
	    ClientData clientData, int stackSize, int flags)
}

# Introduced in 8.3.2
declare 394 {
    size_t Tcl_ReadRaw(Tcl_Channel chan, char *dst, size_t bytesToRead)
    int Tcl_ReadRaw(Tcl_Channel chan, char *dst, int bytesToRead)
}
declare 395 {
    size_t Tcl_WriteRaw(Tcl_Channel chan, const char *src, size_t srcLen)
    int Tcl_WriteRaw(Tcl_Channel chan, const char *src, int srcLen)
}
declare 396 {
    Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan)
}
declare 397 {
    int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 {
    const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
    CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
}
declare 399 {
    Tcl_ChannelTypeVersion Tcl_ChannelVersion(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 400 {
    Tcl_DriverBlockModeProc *Tcl_ChannelBlockModeProc(
	    const Tcl_ChannelType *chanTypePtr)
}
# Removed in 9.0
#declare 401 {
#    Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
#	    const Tcl_ChannelType *chanTypePtr)
declare 401 {
    Tcl_DriverCloseProc *Tcl_ChannelCloseProc(
	    const Tcl_ChannelType *chanTypePtr)
#}
}
declare 402 {
    Tcl_DriverClose2Proc *Tcl_ChannelClose2Proc(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 403 {
    Tcl_DriverInputProc *Tcl_ChannelInputProc(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 404 {
    Tcl_DriverOutputProc *Tcl_ChannelOutputProc(
	    const Tcl_ChannelType *chanTypePtr)
}
# Removed in 9.0
#declare 405 {
#    Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
#	    const Tcl_ChannelType *chanTypePtr)
declare 405 {
    Tcl_DriverSeekProc *Tcl_ChannelSeekProc(
	    const Tcl_ChannelType *chanTypePtr)
#}
}
declare 406 {
    Tcl_DriverSetOptionProc *Tcl_ChannelSetOptionProc(
	    const Tcl_ChannelType *chanTypePtr)
}
declare 407 {
    Tcl_DriverGetOptionProc *Tcl_ChannelGetOptionProc(
	    const Tcl_ChannelType *chanTypePtr)
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544



1545
1546
1547
1548
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
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
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
1531
1532

1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550





1551
1552
1553
1554




1555
1556
1557

1558
1559
1560
1561
1562
1563
1564
1565







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


-
+





-
+

-
+



-
+



-
+


-
+


-
+


-
+


-
+



-
+













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







}
declare 417 {
    void Tcl_ClearChannelHandlers(Tcl_Channel channel)
}
declare 418 {
    int Tcl_IsChannelExisting(const char *channelName)
}
# Removed in 9.0:
#declare 419 {
#    int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
#	    size_t numChars)
declare 419 {
    int Tcl_UniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct,
	    unsigned long numChars)
#}
# Removed in 9.0:
#declare 420 {
#    int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
#	    const Tcl_UniChar *uniPattern, int nocase)
}
declare 420 {
    int Tcl_UniCharCaseMatch(const Tcl_UniChar *uniStr,
	    const Tcl_UniChar *uniPattern, int nocase)
#}
# Removed in 9.0, as it is actually a macro:
#declare 421 {
#    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const void *key)
}
declare 421 {
    Tcl_HashEntry *Tcl_FindHashEntry(Tcl_HashTable *tablePtr, const char *key)
#}
# Removed in 9.0, as it is actually a macro:
#declare 422 {
#    Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
#	    const void *key, int *newPtr)
}
declare 422 {
    Tcl_HashEntry *Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
	    const char *key, int *newPtr)
#}
}
declare 423 {
    void Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr, int keyType,
	    const Tcl_HashKeyType *typePtr)
	    Tcl_HashKeyType *typePtr)
}
declare 424 {
    void Tcl_InitObjHashTable(Tcl_HashTable *tablePtr)
}
declare 425 {
    void *Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName,
    ClientData Tcl_CommandTraceInfo(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *procPtr,
	    void *prevClientData)
	    ClientData prevClientData)
}
declare 426 {
    int Tcl_TraceCommand(Tcl_Interp *interp, const char *varName, int flags,
	    Tcl_CommandTraceProc *proc, void *clientData)
	    Tcl_CommandTraceProc *proc, ClientData clientData)
}
declare 427 {
    void Tcl_UntraceCommand(Tcl_Interp *interp, const char *varName,
	    int flags, Tcl_CommandTraceProc *proc, void *clientData)
	    int flags, Tcl_CommandTraceProc *proc, ClientData clientData)
}
declare 428 {
    void *Tcl_AttemptAlloc(size_t size)
    char *Tcl_AttemptAlloc(unsigned int size)
}
declare 429 {
    void *Tcl_AttemptDbCkalloc(size_t size, const char *file, int line)
    char *Tcl_AttemptDbCkalloc(unsigned int size, const char *file, int line)
}
declare 430 {
    void *Tcl_AttemptRealloc(void *ptr, size_t size)
    char *Tcl_AttemptRealloc(char *ptr, unsigned int size)
}
declare 431 {
    void *Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
    char *Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
	    const char *file, int line)
}
declare 432 {
    int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, size_t length)
    int Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length)
}

# TIP#10 (thread-aware channels) akupries
declare 433 {
    Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel)
}

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
# Removed in 9.0:
#declare 435 {
#    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
#	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
#	    Tcl_MathProc **procPtr, void **clientDataPtr)
declare 435 {
    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
	    Tcl_MathProc **procPtr, ClientData *clientDataPtr)
#}
# Removed in 9.0:
#declare 436 {
#    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}
declare 436 {
    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
#}
}

# TIP#36 (better access to 'subst') dkf
declare 437 {
    Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}

# TIP#17 (virtual filesystem layer) vdarley
1672
1673
1674
1675
1676
1677
1678
1679

1680
1681
1682
1683
1684
1685
1686
1613
1614
1615
1616
1617
1618
1619

1620
1621
1622
1623
1624
1625
1626
1627







-
+







	    int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)
}
declare 452 {
    int Tcl_FSFileAttrsSet(Tcl_Interp *interp,
	    int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr)
}
declare 453 {
    const char *const *Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
    const char **Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
	    Tcl_Obj **objPtrRef)
}
declare 454 {
    int Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
}
declare 455 {
    int Tcl_FSAccess(Tcl_Obj *pathPtr, int mode)
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
1772
1773
1774

1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785

1786
1787
1788
1789
1790
1791
1792
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







-
-
+
+








-
-
+
+


-
+











-
+


-
+


-
+






-
+










-
+





-
+










-
+







    Tcl_Obj *Tcl_FSGetNormalizedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 464 {
    Tcl_Obj *Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
	    Tcl_Obj *const objv[])
}
declare 465 {
    void *Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
	    const Tcl_Filesystem *fsPtr)
    ClientData Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
	    Tcl_Filesystem *fsPtr)
}
declare 466 {
    Tcl_Obj *Tcl_FSGetTranslatedPath(Tcl_Interp *interp, Tcl_Obj *pathPtr)
}
declare 467 {
    int Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName)
}
declare 468 {
    Tcl_Obj *Tcl_FSNewNativePath(const Tcl_Filesystem *fromFilesystem,
	    void *clientData)
    Tcl_Obj *Tcl_FSNewNativePath(Tcl_Filesystem *fromFilesystem,
	    ClientData clientData)
}
declare 469 {
    const void *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
    const char *Tcl_FSGetNativePath(Tcl_Obj *pathPtr)
}
declare 470 {
    Tcl_Obj *Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr)
}
declare 471 {
    Tcl_Obj *Tcl_FSPathSeparator(Tcl_Obj *pathPtr)
}
declare 472 {
    Tcl_Obj *Tcl_FSListVolumes(void)
}
declare 473 {
    int Tcl_FSRegister(void *clientData, const Tcl_Filesystem *fsPtr)
    int Tcl_FSRegister(ClientData clientData, Tcl_Filesystem *fsPtr)
}
declare 474 {
    int Tcl_FSUnregister(const Tcl_Filesystem *fsPtr)
    int Tcl_FSUnregister(Tcl_Filesystem *fsPtr)
}
declare 475 {
    void *Tcl_FSData(const Tcl_Filesystem *fsPtr)
    ClientData Tcl_FSData(Tcl_Filesystem *fsPtr)
}
declare 476 {
    const char *Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
	    Tcl_Obj *pathPtr)
}
declare 477 {
    const Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
    Tcl_Filesystem *Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr)
}
declare 478 {
    Tcl_PathType Tcl_FSGetPathType(Tcl_Obj *pathPtr)
}

# TIP#49 (detection of output buffering) akupries
declare 479 {
    int Tcl_OutputBuffered(Tcl_Channel chan)
}
declare 480 {
    void Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr)
    void Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr)
}

# TIP#56 (evaluate a parsed script) msofer
declare 481 {
    int Tcl_EvalTokensStandard(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    size_t count)
	    int count)
}

# TIP#73 (access to current time) kbk
declare 482 {
    void Tcl_GetTime(Tcl_Time *timeBuf)
}

# TIP#32 (object-enabled traces) kbk
declare 483 {
    Tcl_Trace Tcl_CreateObjTrace(Tcl_Interp *interp, int level, int flags,
	    Tcl_CmdObjTraceProc *objProc, void *clientData,
	    Tcl_CmdObjTraceProc *objProc, ClientData clientData,
	    Tcl_CmdObjTraceDeleteProc *delProc)
}
declare 484 {
    int Tcl_GetCommandInfoFromToken(Tcl_Command token, Tcl_CmdInfo *infoPtr)
}
declare 485 {
    int Tcl_SetCommandInfoFromToken(Tcl_Command token,
1869
1870
1871
1872
1873
1874
1875
1876

1877
1878
1879
1880
1881
1882
1883

1884
1885
1886
1887
1888
1889
1890
1810
1811
1812
1813
1814
1815
1816

1817
1818
1819
1820
1821
1822
1823

1824
1825
1826
1827
1828
1829
1830
1831







-
+






-
+







declare 504 {
    Tcl_Obj *Tcl_DbNewDictObj(const char *file, int line)
}

# TIP#59 (configuration reporting) akupries
declare 505 {
    void Tcl_RegisterConfig(Tcl_Interp *interp, const char *pkgName,
	    const Tcl_Config *configuration, const char *valEncoding)
	    Tcl_Config *configuration, const char *valEncoding)
}

# TIP #139 (partial exposure of namespace API - transferred from tclInt.decls)
# dkf, API by Brent Welch?
declare 506 {
    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
	    void *clientData, Tcl_NamespaceDeleteProc *deleteProc)
	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 507 {
    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 508 {
    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    Tcl_Obj *objPtr)
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
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







-
-
-
+
+
+
-
+




-
+




-
+








# TIP#137 (encoding-aware source command) dgp for Anton Kovalenko
declare 518 {
    int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName,
	    const char *encodingName)
}

# Removed in 9.0 (stub entry only)
#declare 519 {nostub {Don't use this function in a stub-enabled extension}} {
#    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
# TIP#121 (exit handler) dkf for Joe Mistachkin
declare 519 {
    Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc)
#}
}

# TIP#143 (resource limits) dkf
declare 520 {
    void Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, void *clientData,
	    Tcl_LimitHandlerProc *handlerProc, ClientData clientData,
	    Tcl_LimitHandlerDeleteProc *deleteProc)
}
declare 521 {
    void Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
	    Tcl_LimitHandlerProc *handlerProc, void *clientData)
	    Tcl_LimitHandlerProc *handlerProc, ClientData clientData)
}
declare 522 {
    int Tcl_LimitReady(Tcl_Interp *interp)
}
declare 523 {
    int Tcl_LimitCheck(Tcl_Interp *interp)
}
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
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







-
+




-
+










-
+


-
+


-
+


-
+


-
+







	    Tcl_Namespace **namespacePtrPtr)
}

# TIP#233 (virtualized time) akupries
declare 552 {
    void Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
	    Tcl_ScaleTimeProc *scaleProc,
	    void *clientData)
	    ClientData clientData)
}
declare 553 {
    void Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
	    Tcl_ScaleTimeProc **scaleProc,
	    void **clientData)
	    ClientData *clientData)
}

# TIP#218 (driver thread actions) davygrvy/akupries ChannelType ver 4
declare 554 {
    Tcl_DriverThreadActionProc *Tcl_ChannelThreadActionProc(
	    const Tcl_ChannelType *chanTypePtr)
}

# TIP#237 (arbitrary-precision integers) kbk
declare 555 {
    Tcl_Obj *Tcl_NewBignumObj(void *value)
    Tcl_Obj *Tcl_NewBignumObj(mp_int *value)
}
declare 556 {
    Tcl_Obj *Tcl_DbNewBignumObj(void *value, const char *file, int line)
    Tcl_Obj *Tcl_DbNewBignumObj(mp_int *value, const char *file, int line)
}
declare 557 {
    void Tcl_SetBignumObj(Tcl_Obj *obj, void *value)
    void Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value)
}
declare 558 {
    int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value)
    int Tcl_GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value)
}
declare 559 {
    int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, void *value)
    int Tcl_TakeBignumFromObj(Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value)
}

# TIP #208 ('chan' command) jeffh
declare 560 {
    int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length)
}
declare 561 {
2108
2109
2110
2111
2112
2113
2114
2115

2116
2117
2118
2119
2120
2121
2122
2049
2050
2051
2052
2053
2054
2055

2056
2057
2058
2059
2060
2061
2062
2063







-
+







declare 565 {
    void Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg)
}

# TIP #237 (additional conversion functions for bignum support) kbk/dgp
declare 566 {
    int Tcl_InitBignumFromDouble(Tcl_Interp *interp, double initval,
	    void *toInit)
	    mp_int *toInit)
}

# TIP#181 (namespace unknown command) dgp for Neil Madden
declare 567 {
    Tcl_Obj *Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
	    Tcl_Namespace *nsPtr)
}
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
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







-
+








-
+


















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

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















-
+

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




-
-
-
-
-
+
+
+
+
-
+



-
+
+
+
+







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
















+
+
+

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





declare 572 {
    const char *Tcl_GetEncodingNameFromEnvironment(Tcl_DString *bufPtr)
}

# TIP#268 (extended version numbers and requirements) akupries
declare 573 {
    int Tcl_PkgRequireProc(Tcl_Interp *interp, const char *name,
	    int objc, Tcl_Obj *const objv[], void *clientDataPtr)
	    int objc, Tcl_Obj *const objv[], ClientData *clientDataPtr)
}

# TIP#270 (utility C routines for string formatting) dgp
declare 574 {
    void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 575 {
    void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes,
	    size_t length, size_t limit, const char *ellipsis)
	    int length, int limit, const char *ellipsis)
}
declare 576 {
    Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc,
	    Tcl_Obj *const objv[])
}
declare 577 {
    int Tcl_AppendFormatToObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    const char *format, int objc, Tcl_Obj *const objv[])
}
declare 578 {
    Tcl_Obj *Tcl_ObjPrintf(const char *format, ...)
}
declare 579 {
    void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...)
}

# ----- BASELINE -- FOR -- 8.5.0 ----- #

# TIP #285 (script cancellation support) jmistachkin
declare 580 {
    int Tcl_CancelEval(Tcl_Interp *interp, Tcl_Obj *resultObjPtr,
	    void *clientData, int flags)
}
declare 581 {
    int Tcl_Canceled(Tcl_Interp *interp, int flags)
}

# TIP#304 (chan pipe) aferrieux
declare 582 {
    int Tcl_CreatePipe(Tcl_Interp  *interp, Tcl_Channel *rchan,
	    Tcl_Channel *wchan, int flags)
}

# TIP #322 (NRE public interface) msofer
declare 583 {
    Tcl_Command Tcl_NRCreateCommand(Tcl_Interp *interp,
	    const char *cmdName, Tcl_ObjCmdProc *proc,
	    Tcl_ObjCmdProc *nreProc, void *clientData,
	    Tcl_CmdDeleteProc *deleteProc)
}
declare 584 {
    int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 585 {
    int Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
	    Tcl_Obj *const objv[], int flags)
}
declare 586 {
    int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc,
	    Tcl_Obj *const objv[], int flags)
}
declare 587 {
    void Tcl_NRAddCallback(Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr,
	    void *data0, void *data1, void *data2,
	    void *data3)
}
# For use by NR extenders, to have a simple way to also provide a (required!)
# classic objProc
declare 588 {
    int Tcl_NRCallObjProc(Tcl_Interp *interp, Tcl_ObjCmdProc *objProc,
	    void *clientData, int objc, Tcl_Obj *const objv[])
}

# TIP#316 (Tcl_StatBuf reader functions) dkf
declare 589 {
    unsigned Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr)
}
declare 590 {
    unsigned Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr)
}
declare 591 {
    unsigned Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr)
}
declare 592 {
    int Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr)
}
declare 593 {
    int Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr)
}
declare 594 {
    int Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr)
}
declare 595 {
    int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr)
}
declare 596 {
    Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 597 {
    Tcl_WideInt Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 598 {
    Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
}
declare 599 {
    Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
}
declare 600 {
    Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr)
}
declare 601 {
    unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr)
}

# TIP#314 (ensembles with parameters) dkf for Lars Hellstr"om
declare 602 {
    int Tcl_SetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
	    Tcl_Obj *paramList)
}
declare 603 {
    int Tcl_GetEnsembleParameterList(Tcl_Interp *interp, Tcl_Command token,
	    Tcl_Obj **paramListPtr)
}

# TIP#265 (option parser) dkf for Sam Bromley
declare 604 {
    int Tcl_ParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
	    int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}

# TIP#336 (manipulate the error line) dgp
declare 605 {
    int Tcl_GetErrorLine(Tcl_Interp *interp)
}
declare 606 {
    void Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum)
}

# TIP#307 (move results between interpreters) dkf
declare 607 {
    void Tcl_TransferResult(Tcl_Interp *sourceInterp, int code,
	    Tcl_Interp *targetInterp)
}

# TIP#335 (detect if interpreter in use) jmistachkin
declare 608 {
    int Tcl_InterpActive(Tcl_Interp *interp)
}

# TIP#337 (log exception for background processing) dgp
declare 609 {
    void Tcl_BackgroundException(Tcl_Interp *interp, int code)
}

# TIP#234 (zlib interface) dkf/Pascal Scheffers
declare 610 {
    int Tcl_ZlibDeflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
	    int level, Tcl_Obj *gzipHeaderDictObj)
}
declare 611 {
    int Tcl_ZlibInflate(Tcl_Interp *interp, int format, Tcl_Obj *data,
	    size_t buffersize, Tcl_Obj *gzipHeaderDictObj)
}
declare 612 {
    unsigned int Tcl_ZlibCRC32(unsigned int crc, const unsigned char *buf,
	    size_t len)
}
declare 613 {
    unsigned int Tcl_ZlibAdler32(unsigned int adler, const unsigned char *buf,
	    size_t len)
}
declare 614 {
    int Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode, int format,
	    int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle)
}
declare 615 {
declare 687 {
    Tcl_Obj *Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle)
}
declare 616 {
    int Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle)
}
declare 617 {
    int Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle)
}
declare 618 {
    int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush)
}
declare 619 {
    int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data,
	    size_t count)
}
declare 620 {
    int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle)
}
declare 621 {
    int Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle)
}

    void TclUnusedStubEntry(void)
# TIP 338 (control over startup script) dgp
declare 622 {
    void Tcl_SetStartupScript(Tcl_Obj *path, const char *encoding)
}
declare 623 {
    Tcl_Obj *Tcl_GetStartupScript(const char **encodingPtr)
}


# TIP#332 (half-close made public) aferrieux
declare 624 {
    int Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan, int flags)
}

# TIP #353 (NR-enabled expressions) dgp
declare 625 {
    int Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr)
}

# TIP #356 (NR-enabled substitution) dgp
declare 626 {
    int Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}

# 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)
}

# TIP #400
declare 630 {
    void Tcl_ZlibStreamSetCompressionDictionary(Tcl_ZlibStream zhandle,
	    Tcl_Obj *compressionDictionaryObj)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #
# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #

# TIP #456
declare 631 {
    Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
	    const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
	    void *callbackData)
}

# TIP #430
declare 632 {
    int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
	    const char *zipname, const char *passwd)
}
declare 633 {
    int TclZipfs_Unmount(Tcl_Interp *interp, const char *mountPoint)
}
declare 634 {
    Tcl_Obj *TclZipfs_TclLibrary(void)
}
declare 635 {
    int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
	    unsigned char *data, size_t datalen, int copy)
}

# TIP #445
declare 636 {
    void Tcl_FreeIntRep(Tcl_Obj *objPtr)
}
declare 637 {
    char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
	    size_t numBytes)
}
declare 638 {
    Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr)
}
declare 639 {
    void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr,
	    const Tcl_ObjIntRep *irPtr)
}
declare 640 {
    int Tcl_HasStringRep(Tcl_Obj *objPtr)
}

# TIP #506
declare 641 {
    void Tcl_IncrRefCount(Tcl_Obj *objPtr)
}

declare 642 {
    void Tcl_DecrRefCount(Tcl_Obj *objPtr)
}

declare 643 {
    int Tcl_IsShared(Tcl_Obj *objPtr)
}

# TIP#312 New Tcl_LinkArray() function
declare 644 {
    int Tcl_LinkArray(Tcl_Interp *interp, const char *varName, void *addr,
	    int type, size_t size)
}

declare 645 {
    int Tcl_GetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    size_t endValue, size_t *indexPtr)
}

# TIP #548
declare 646 {
    int Tcl_UtfToUniChar(const char *src, int *chPtr)
}
declare 647 {
    char *Tcl_UniCharToUtfDString(const int *uniStr,
	    size_t uniLength, Tcl_DString *dsPtr)
}
declare 648 {
    int *Tcl_UtfToUniCharDString(const char *src,
	    size_t length, Tcl_DString *dsPtr)
}

# ----- BASELINE -- FOR -- 8.7.0 ----- #

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

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat

################################
# Unix specific functions
#   (none)

################################
# Windows specific functions

# Added in Tcl 8.1, Removed in Tcl 9.0 (converted to macro)
# Added in Tcl 8.1

#declare 0 win {
#    TCHAR *Tcl_WinUtfToTChar(const char *str, size_t len, Tcl_DString *dsPtr)
declare 0 win {
    TCHAR *Tcl_WinUtfToTChar(const char *str, int len, Tcl_DString *dsPtr)
#}
#declare 1 win {
#    char *Tcl_WinTCharToUtf(const TCHAR *str, size_t len, Tcl_DString *dsPtr)
}
declare 1 win {
    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
#}
}
declare 3 win {
    void TclUnusedStubEntry(void)
}

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

# Removed in 9.0
#declare 0 macosx {
#    int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
#	    const char *bundleName, int hasResourceFile,
#	    size_t maxPathLen, char *libraryPath)
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, size_t maxPathLen, char *libraryPath)
	    int hasResourceFile, int maxPathLen, char *libraryPath)
}
declare 2 macosx {
    void TclUnusedStubEntry(void)
}

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

# Public functions that are not accessible via the stubs table.

export {
    void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
    void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
    Tcl_Interp *interp)
}
export {
    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
export {
    void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
export {
    Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
export {
    void Tcl_FindExecutable(const char *argv0)
}
export {
    const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
	int exact)
}
export {
    const char *TclTomMathInitializeStubs(Tcl_Interp* interp,
	const char* version, int epoch, int revision)
}
export {
    const char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, const char *version,
	int exact)
}
export {
    void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
}

# Global variables that need to be exported from the tcl shared library.

export {
    void Tcl_InitSubsystems(void)
    TclStubs *tclStubsPtr                       (fool checkstubs)
}
export {
    TclPlatStubs *tclPlatStubsPtr               (fool checkstubs)
}
export {
    TclIntStubs *tclIntStubsPtr                 (fool checkstubs)
}
export {
    TclIntPlatStubs *tclIntPlatStubsPtr         (fool checkstubs)
}
export {
    TclTomMathStubs *tclTomMathStubsPtr         (fool checkstubs)
}

# Local Variables:
# mode: tcl
# End:

Changes to generic/tcl.h.

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
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







-
-
+
+

+

+
+
+
+




+
+


-
-
-
-
+
+
+
+

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













-













-
+
+


+

+
+
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+

-
-
+
+
+
+
+


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



-












-
+







#define TCL_FINAL_RELEASE	2

/*
 * When version numbers change here, must also go into the following files and
 * update the version numbers:
 *
 * library/init.tcl	(1 LOC patch)
 * unix/configure.ac	(2 LOC Major, 2 LOC minor, 1 LOC patch)
 * win/configure.ac	(as above)
 * unix/configure.in	(2 LOC Major, 2 LOC minor, 1 LOC patch)
 * win/configure.in	(as above)
 * win/tcl.m4		(not patchlevel)
 * win/makefile.bc	(not patchlevel) 2 LOC
 * README		(sections 0 and 2, with and without separator)
 * macosx/Tcl.pbproj/project.pbxproj (not patchlevel) 1 LOC
 * macosx/Tcl.pbproj/default.pbxuser (not patchlevel) 1 LOC
 * macosx/Tcl.xcode/project.pbxproj (not patchlevel) 2 LOC
 * macosx/Tcl.xcode/default.pbxuser (not patchlevel) 1 LOC
 * macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
 * win/README		(not patchlevel) (sections 0 and 2)
 * unix/tcl.spec	(1 LOC patch)
 * tools/tcl.hpj.in	(not patchlevel, for windows installer)
 * tools/tcl.wse.in	(for windows installer)
 * tools/tclSplash.bmp	(not patchlevel)
 */

#define TCL_MAJOR_VERSION   9
#define TCL_MINOR_VERSION   0
#define TCL_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define TCL_RELEASE_SERIAL  2
#define TCL_MAJOR_VERSION   8
#define TCL_MINOR_VERSION   5
#define TCL_RELEASE_LEVEL   TCL_FINAL_RELEASE
#define TCL_RELEASE_SERIAL  19

#define TCL_VERSION	    "9.0"
#define TCL_PATCH_LEVEL	    "9.0a2"

#if defined(RC_INVOKED)
#define TCL_VERSION	    "8.5"
#define TCL_PATCH_LEVEL	    "8.5.19"

/*
 * The following definitions set up the proper options for Windows compilers.
 * We use this method because there is no autoconf equivalent.
 */

#ifndef __WIN32__
#   if defined(_WIN32) || defined(WIN32) || defined(__MSVCRT__) || defined(__BORLANDC__) || (defined(__WATCOMC__) && defined(__WINDOWS_386__))
#	define __WIN32__
#	ifndef WIN32
#	    define WIN32
#	endif
#	ifndef _WIN32
#	    define _WIN32
#	endif
#   endif
#endif

/*
 * STRICT: See MSDN Article Q83456
 */

#ifdef __WIN32__
#   ifndef STRICT
#	define STRICT
#   endif
#endif /* __WIN32__ */

/*
 * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
 * quotation marks), JOIN joins two arguments.
 */

#ifndef STRINGIFY
#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#endif
#ifndef JOIN
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
#endif
#endif /* RC_INVOKED */

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

#ifndef RC_INVOKED

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

#ifdef TCL_THREADS
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
#else
#define TCL_DECLARE_MUTEX(name)
#endif

/*
 * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
 * SEEK_END, all #define'd by stdio.h .
 *
 * Also, many extensions need stdio.h, and they've grown accustomed to tcl.h
 * providing it for them rather than #include-ing it themselves as they
 * should, so also for their sake, we keep the #include to be consistent with
 * prior Tcl releases.
 */

#include <stdio.h>

#if defined(__GNUC__) && (__GNUC__ > 2)
#   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
#   define TCL_NORETURN __attribute__ ((noreturn))
#   define TCL_NOINLINE __attribute__ ((noinline))
#   define TCL_NORETURN1 __attribute__ ((noreturn))
#else
#   define TCL_FORMAT_PRINTF(a,b)
#   if defined(_MSC_VER) && (_MSC_VER >= 1310)
#	define TCL_NORETURN _declspec(noreturn)
#	define TCL_NOINLINE __declspec(noinline)
#   else
#	define TCL_NORETURN /* nothing */
#	define TCL_NOINLINE /* nothing */
#   endif
#   define TCL_NORETURN1 /* nothing */
#endif

/*
 * Allow a part of Tcl's API to be explicitly marked as deprecated.
 * Support for functions with a variable number of arguments.
 *
 * 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.
 * The following TCL_VARARGS* macros are to support old extensions
 * written for older versions of Tcl where the macros permitted
 * support for the varargs.h system as well as stdarg.h .
 *
 * New code should just directly be written to use stdarg.h conventions.
 */

#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__))
#include <stdarg.h>
#ifndef TCL_NO_DEPRECATED
#    define TCL_VARARGS(type, name) (type name, ...)
#    define TCL_VARARGS_DEF(type, name) (type name, ...)
#   endif
#else
#   define TCL_DEPRECATED_API(msg)	/* nothing portable */
#    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#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.
 *
 * Note: when building static but linking dynamically to MSVCRT we must still
 *       correctly decorate the C library imported function.  Use CRTIMPORT
 *       for this purpose.  _DLL is defined by the compiler when linking to
 *       MSVCRT.
 */

#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
#if (defined(__WIN32__) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
#   define HAVE_DECLSPEC 1
#   ifdef STATIC_BUILD
#       define DLLIMPORT
#       define DLLEXPORT
#       ifdef _DLL
#           define CRTIMPORT __declspec(dllimport)
#       else
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
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
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
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
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
524
525
526
527
528

529
530
531
532
533
534
535
536







-
+




















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

















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



+
+
-
+
+
+
+
+
+



















+
+
+
+
+
+
+
+
+






-
-
+
+














-
+

+
-
-
-
-
+
+
+
+

+
-
-
+
+




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

-
-
-
-
+
+
+
+




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

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












-
-
-
+
+
+
+








-


















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




















-


-





-
-
+
+

-
+








-
+








/*
 * These macros are used to control whether functions are being declared for
 * import or export. If a function is being declared while it is being built
 * to be included in a shared library, then it should have the DLLEXPORT
 * storage class. If is being declared for use by a module that is going to
 * link against the shared library, then it should have the DLLIMPORT storage
 * class. If the symbol is being declared for a static build or for use from a
 * class. If the symbol is beind declared for a static build or for use from a
 * stub library, then the storage class should be empty.
 *
 * The convention is that a macro called BUILD_xxxx, where xxxx is the name of
 * a library we are building, is set on the compile line for sources that are
 * to be placed in the library. When this macro is set, the storage class will
 * be set to DLLEXPORT. At the end of the header file, the storage class will
 * be reset to DLLIMPORT.
 */

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

/*
 * Definitions that allow this header file to be used either with or without
 * ANSI C features like function prototypes.
 */
#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
#      define CONST86 const

#undef _ANSI_ARGS_
#undef CONST
#ifndef INLINE
#   define INLINE
#endif

#ifndef NO_CONST
#   define CONST const
#else
#   define CONST
#endif

#ifndef NO_PROTOTYPES
#   define _ANSI_ARGS_(x)	x
#else
#   define _ANSI_ARGS_(x)	()
#endif

#ifdef USE_NON_CONST
#   ifdef USE_COMPAT_CONST
#      error define at most one of USE_NON_CONST and USE_COMPAT_CONST
#   endif
#   define CONST84
#   define CONST84_RETURN
#else
#   ifdef USE_COMPAT_CONST
#      define CONST84
#      define CONST84_RETURN CONST
#   else
#      define CONST84 CONST
#      define CONST84_RETURN CONST
#   endif
#endif

/*
 * Make sure EXTERN isn't defined elsewhere.
 */

#ifdef EXTERN
#   undef EXTERN
#endif /* EXTERN */

#ifdef __cplusplus
#   define EXTERN extern "C" TCL_STORAGE_CLASS
#else
#   define EXTERN extern TCL_STORAGE_CLASS
#endif

/*
 * The following code is copied from winnt.h. If we don't replicate it here,
 * then <windows.h> can't be included after tcl.h, since tcl.h also defines
 * VOID. This block is skipped under Cygwin and Mingw.
 */

#if defined(__WIN32__) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
#endif /* __WIN32__ && !HAVE_WINNT_IGNORE_VOID */

/*
 * Macro to use instead of "void" for arguments that must have type "void *"
 * in ANSI C; maps them to type "char *" in non-ANSI systems.
 */

#ifndef __VXWORKS__
#   ifndef NO_VOID
#	define VOID void
#   else
#	define VOID char
#   endif
#endif

/*
 * Miscellaneous declarations.
 */

#ifndef _CLIENTDATA
#   ifndef NO_VOID
typedef void *ClientData;
	typedef void *ClientData;
#   else
	typedef int *ClientData;
#   endif
#   define _CLIENTDATA
#endif

/*
 * Darwin specific configure overrides (to support fat compiles, where
 * configure runs only once for multiple architectures):
 */

#ifdef __APPLE__
#   ifdef __LP64__
#	undef TCL_WIDE_INT_TYPE
#	define TCL_WIDE_INT_IS_LONG 1
#	define TCL_CFG_DO64BIT 1
#    else /* !__LP64__ */
#	define TCL_WIDE_INT_TYPE long long
#	undef TCL_WIDE_INT_IS_LONG
#	undef TCL_CFG_DO64BIT
#    endif /* __LP64__ */
#    undef HAVE_STRUCT_STAT64
#endif /* __APPLE__ */

/* Cross-compiling 32-bit on a 64-bit platform? Then our
 * configure script does the wrong thing. Correct that here.
 */
#if defined(__GNUC__) && !defined(_WIN32) && !defined(__LP64__)
#   undef TCL_WIDE_INT_IS_LONG
#   undef TCL_WIDE_INT_TYPE
#   define TCL_WIDE_INT_TYPE long long
#endif

/*
 * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define
 * Tcl_WideUInt to be the unsigned variant of that type (assuming that where
 * we have one, we can have the other.)
 *
 * Also defines the following macros:
 * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a
 *	LP64 system such as modern Solaris or Linux ... not including Win64)
 * TCL_WIDE_INT_IS_LONG - if wide ints are really longs (i.e. we're on a real
 *	64-bit system.)
 * Tcl_WideAsLong - forgetful converter from wideInt to long.
 * Tcl_LongAsWide - sign-extending converter from long to wideInt.
 * Tcl_WideAsDouble - converter from wideInt to double.
 * Tcl_DoubleAsWide - converter from double to wideInt.
 *
 * The following invariant should hold for any long value 'longVal':
 *	longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal))
 *
 * 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(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
#   if defined(__WIN32__) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
#      define TCL_WIDE_INT_TYPE __int64
#      ifdef __BORLANDC__
#      define TCL_LL_MODIFIER	"I64"
#      if defined(_WIN64)
#         define TCL_Z_MODIFIER	"I"
#      endif
#         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_Z_MODIFIER	"z"
#   else /* ! _WIN32 && ! __GNUC__ */
#      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
#      else /* !NO_LIMITS_H */
#      include <limits.h>
#      if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
#         define TCL_WIDE_INT_IS_LONG	1
#      endif
#   endif /* _WIN32 */
#	  include <limits.h>
#	  if (INT_MAX < LONG_MAX)
#	     define TCL_WIDE_INT_IS_LONG	1
#	  else
#	     define TCL_WIDE_INT_TYPE long long
#         endif
#      endif /* NO_LIMITS_H */
#   endif /* __WIN32__ */
#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */

#ifndef TCL_WIDE_INT_TYPE
#   define TCL_WIDE_INT_TYPE		long long
#endif /* !TCL_WIDE_INT_TYPE */
#ifdef TCL_WIDE_INT_IS_LONG
#   undef TCL_WIDE_INT_TYPE
#   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	"ll"
#endif /* !TCL_LL_MODIFIER */
#ifndef TCL_Z_MODIFIER
#   if defined(__GNUC__) && !defined(_WIN32)
#	define TCL_Z_MODIFIER	"z"
#   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) || defined(_USE_64BIT_TIME_T)
	typedef struct __stat64 Tcl_StatBuf;
#   elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T)
	typedef struct _stati64	Tcl_StatBuf;
#   else
#	define TCL_Z_MODIFIER	""
#   endif
	typedef struct _stat32i64 Tcl_StatBuf;
#   endif /* _MSC_VER < 1400 */
#endif /* !TCL_Z_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)))

#if defined(_WIN32)
    typedef struct __stat64 Tcl_StatBuf;
#elif defined(__CYGWIN__)
    typedef struct {
	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 long tv_sec;} st_atim;
	struct {long long tv_sec;} st_mtim;
	struct {long long tv_sec;} st_ctim;
	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) && !defined(__APPLE__)
    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
 * interpreter result is either an object or a string, and the two values are
 * kept consistent unless some C code sets interp->result directly.
 * Programmers should use either the function Tcl_GetObjResult() or
 * Tcl_GetStringResult() to read the interpreter's result. See the SetResult
 * man page for details.
 *
 * Note: any change to the Tcl_Interp definition below must be mirrored in the
 * "real" definition in tclInt.h.
 *
 * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
 * Instead, they set a Tcl_Obj member in the "real" structure that can be
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */

typedef struct Tcl_Interp Tcl_Interp;
typedef struct Tcl_Interp {
    char *result;		/* If the last command returned a string
				 * result, this points to it. */
    void (*freeProc) _ANSI_ARGS_((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. */
    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number within the command where the
				 * error occurred (1 if first line). */
} 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;
typedef struct Tcl_Condition_ *Tcl_Condition;
typedef struct Tcl_Dict_ *Tcl_Dict;
typedef struct Tcl_EncodingState_ *Tcl_EncodingState;
typedef struct Tcl_Encoding_ *Tcl_Encoding;
typedef struct Tcl_Event Tcl_Event;
typedef struct Tcl_InterpState_ *Tcl_InterpState;
typedef struct Tcl_LoadHandle_ *Tcl_LoadHandle;
typedef struct Tcl_Mutex_ *Tcl_Mutex;
typedef struct Tcl_Pid_ *Tcl_Pid;
typedef struct Tcl_RegExp_ *Tcl_RegExp;
typedef struct Tcl_ThreadDataKey_ *Tcl_ThreadDataKey;
typedef struct Tcl_ThreadId_ *Tcl_ThreadId;
typedef struct Tcl_TimerToken_ *Tcl_TimerToken;
typedef struct Tcl_Trace_ *Tcl_Trace;
typedef struct Tcl_Var_ *Tcl_Var;
typedef struct Tcl_ZLibStream_ *Tcl_ZlibStream;

/*
 *----------------------------------------------------------------------------
 * Definition of the interface to functions implementing threads. A function
 * following this definition is given to each call of 'Tcl_CreateThread' and
 * will be called as the main fuction of the new thread created by that call.
 */

#if defined _WIN32
typedef unsigned (__stdcall Tcl_ThreadCreateProc) (void *clientData);
#if defined __WIN32__
typedef unsigned (__stdcall Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
#else
typedef void (Tcl_ThreadCreateProc) (void *clientData);
typedef void (Tcl_ThreadCreateProc) _ANSI_ARGS_((ClientData clientData));
#endif

/*
 * Threading function return types used for abstracting away platform
 * differences when writing a Tcl_ThreadCreateProc. See the NewThread function
 * in generic/tclThreadTest.c for it's usage.
 */

#if defined _WIN32
#if defined __WIN32__
#   define Tcl_ThreadCreateType		unsigned __stdcall
#   define TCL_THREAD_CREATE_RETURN	return 0
#else
#   define Tcl_ThreadCreateType		void
#   define TCL_THREAD_CREATE_RETURN
#endif

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
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







-
+

-
+




-
+


-
+

+











-







/*
 * Structures filled in by Tcl_RegExpInfo. Note that all offset values are
 * relative to the start of the match string, not the beginning of the entire
 * string.
 */

typedef struct Tcl_RegExpIndices {
    size_t start;			/* Character offset of first character in
    long start;			/* Character offset of first character in
				 * match. */
    size_t end;			/* Character offset of first character after
    long end;			/* Character offset of first character after
				 * the match. */
} Tcl_RegExpIndices;

typedef struct Tcl_RegExpInfo {
    size_t nsubs;			/* Number of subexpressions in the compiled
    int nsubs;			/* Number of subexpressions in the compiled
				 * expression. */
    Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
    size_t extendStart;		/* The offset at which a subsequent match
    long extendStart;		/* The offset at which a subsequent match
				 * might begin. */
    long reserved;		/* Reserved for later use. */
} Tcl_RegExpInfo;

/*
 * Picky compilers complain if this typdef doesn't appear before the struct's
 * reference in tclDecls.h.
 */

typedef Tcl_StatBuf *Tcl_Stat_;
typedef struct stat *Tcl_OldStat_;

/*
 *----------------------------------------------------------------------------
 * When a TCL command returns, the interpreter contains a result from the
 * command. Programmers are strongly encouraged to use one of the functions
 * Tcl_GetObjResult() or Tcl_GetStringResult() to read the interpreter's
 * result. See the SetResult man page for details. Besides this result, the
 * command function returns an integer code, which is one of the following:
 *
 * TCL_OK		Command completed normally; the interpreter's result
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
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
686
687
688
689
690
691
692
693
694
695
696
697
698
699
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
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
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







+
+

-








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








-



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

-






-
+
















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+





-
+





-
+

-
+



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


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

-
-
-
+
+
+


+
+
+
+
+
+
+
+
-
+


-












-
+











-








#define TCL_OK			0
#define TCL_ERROR		1
#define TCL_RETURN		2
#define TCL_BREAK		3
#define TCL_CONTINUE		4

#define TCL_RESULT_SIZE		200

/*
 *----------------------------------------------------------------------------
 * Flags to control what substitutions are performed by Tcl_SubstObj():
 */

#define TCL_SUBST_COMMANDS	001
#define TCL_SUBST_VARIABLES	002
#define TCL_SUBST_BACKSLASHES	004
#define TCL_SUBST_ALL		007

/*
 * Argument descriptors for math function callbacks in expressions:
 */

typedef enum {
    TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
} Tcl_ValueType;

typedef struct Tcl_Value {
    Tcl_ValueType type;		/* Indicates intValue or doubleValue is valid,
				 * or both. */
    long intValue;		/* Integer value. */
    double doubleValue;		/* Double-precision floating value. */
    Tcl_WideInt wideValue;	/* Wide (min. 64-bit) integer value. */
} Tcl_Value;

/*
 * Forward declaration of Tcl_Obj to prevent an error when the forward
 * reference to Tcl_Obj is encountered in the function types declared below.
 */

struct Tcl_Obj;

/*
 *----------------------------------------------------------------------------
 * Function types defined by Tcl:
 */

typedef int (Tcl_AppInitProc) (Tcl_Interp *interp);
typedef int (Tcl_AsyncProc) (void *clientData, Tcl_Interp *interp,
	int code);
typedef void (Tcl_ChannelProc) (void *clientData, int mask);
typedef void (Tcl_CloseProc) (void *data);
typedef void (Tcl_CmdDeleteProc) (void *clientData);
typedef int (Tcl_CmdProc) (void *clientData, Tcl_Interp *interp,
	int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, char *command, Tcl_CmdProc *proc,
	void *cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp,
	int level, const char *command, Tcl_Command commandInfo, int objc,
	struct Tcl_Obj *const *objv);
typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData);
typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr);
typedef int (Tcl_EncodingConvertProc) (void *clientData, const char *src,
	int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst,
	int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr);
#define Tcl_EncodingFreeProc Tcl_FreeProc
typedef int (Tcl_EventProc) (Tcl_Event *evPtr, int flags);
typedef void (Tcl_EventCheckProc) (void *clientData, int flags);
typedef int (Tcl_EventDeleteProc) (Tcl_Event *evPtr, void *clientData);
typedef void (Tcl_EventSetupProc) (void *clientData, int flags);
#define Tcl_ExitProc Tcl_FreeProc
typedef void (Tcl_FileProc) (void *clientData, int mask);
#define Tcl_FileFreeProc Tcl_FreeProc
typedef void (Tcl_FreeInternalRepProc) (struct Tcl_Obj *objPtr);
typedef void (Tcl_FreeProc) (void *blockPtr);
typedef void (Tcl_IdleProc) (void *clientData);
typedef void (Tcl_InterpDeleteProc) (void *clientData,
	Tcl_Interp *interp);
typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
	int objc, struct Tcl_Obj *const *objv);
typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
typedef void (Tcl_PanicProc) (const char *format, ...);
typedef void (Tcl_TcpAcceptProc) (void *callbackData, Tcl_Channel chan,
	char *address, int port);
typedef void (Tcl_TimerProc) (void *clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
typedef char * (Tcl_VarTraceProc) (void *clientData, Tcl_Interp *interp,
	const char *part1, const char *part2, int flags);
typedef void (Tcl_CommandTraceProc) (void *clientData, Tcl_Interp *interp,
	const char *oldName, const char *newName, int flags);
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
	void *clientData);
typedef void (Tcl_DeleteFileHandlerProc) (int fd);
typedef void (Tcl_AlertNotifierProc) (void *clientData);
typedef void (Tcl_ServiceModeHookProc) (int mode);
typedef void *(Tcl_InitNotifierProc) (void);
typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
typedef void (Tcl_MainLoopProc) (void);

typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int code));
typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask));
typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data));
typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int argc, CONST84 char *argv[]));
typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
	ClientData cmdClientData, int argc, CONST84 char *argv[]));
typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int level, CONST char *command,
	Tcl_Command commandInfo, int objc, struct Tcl_Obj * CONST * objv));
typedef void (Tcl_CmdObjTraceDeleteProc) _ANSI_ARGS_((ClientData clientData));
typedef void (Tcl_DupInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *srcPtr,
	struct Tcl_Obj *dupPtr));
typedef int (Tcl_EncodingConvertProc)_ANSI_ARGS_((ClientData clientData,
	CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr,
	char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr,
	int *dstCharsPtr));
typedef void (Tcl_EncodingFreeProc)_ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_EventProc) _ANSI_ARGS_((Tcl_Event *evPtr, int flags));
typedef void (Tcl_EventCheckProc) _ANSI_ARGS_((ClientData clientData,
	int flags));
typedef int (Tcl_EventDeleteProc) _ANSI_ARGS_((Tcl_Event *evPtr,
	ClientData clientData));
typedef void (Tcl_EventSetupProc) _ANSI_ARGS_((ClientData clientData,
	int flags));
typedef void (Tcl_ExitProc) _ANSI_ARGS_((ClientData clientData));
typedef void (Tcl_FileProc) _ANSI_ARGS_((ClientData clientData, int mask));
typedef void (Tcl_FileFreeProc) _ANSI_ARGS_((ClientData clientData));
typedef void (Tcl_FreeInternalRepProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
typedef void (Tcl_IdleProc) _ANSI_ARGS_((ClientData clientData));
typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp));
typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
typedef void (Tcl_NamespaceDeleteProc) _ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST * objv));
typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
typedef int (Tcl_PackageUnloadProc) _ANSI_ARGS_((Tcl_Interp *interp,
	int flags));
typedef void (Tcl_PanicProc) _ANSI_ARGS_((CONST char *format, ...));
typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
	Tcl_Channel chan, char *address, int port));
typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp,
	struct Tcl_Obj *objPtr));
typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr));
typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2,
	int flags));
typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp, CONST char *oldName, CONST char *newName,
	int flags));
typedef void (Tcl_CreateFileHandlerProc) _ANSI_ARGS_((int fd, int mask,
	Tcl_FileProc *proc, ClientData clientData));
typedef void (Tcl_DeleteFileHandlerProc) _ANSI_ARGS_((int fd));
typedef void (Tcl_AlertNotifierProc) _ANSI_ARGS_((ClientData clientData));
typedef void (Tcl_ServiceModeHookProc) _ANSI_ARGS_((int mode));
typedef ClientData (Tcl_InitNotifierProc) _ANSI_ARGS_((VOID));
typedef void (Tcl_FinalizeNotifierProc) _ANSI_ARGS_((ClientData clientData));
typedef void (Tcl_MainLoopProc) _ANSI_ARGS_((void));

/*
 *----------------------------------------------------------------------------
 * The following structure represents a type of object, which is a particular
 * internal representation for an object plus a set of functions that provide
 * standard operations on objects of that type.
 */

typedef struct Tcl_ObjType {
    const char *name;		/* Name of the type, e.g. "int". */
    char *name;			/* Name of the type, e.g. "int". */
    Tcl_FreeInternalRepProc *freeIntRepProc;
				/* Called to free any storage for the type's
				 * internal rep. NULL if the internal rep does
				 * not need freeing. */
    Tcl_DupInternalRepProc *dupIntRepProc;
				/* Called to create a new object as a copy of
				 * an existing object. */
    Tcl_UpdateStringProc *updateStringProc;
				/* Called to update the string rep from the
				 * type's internal representation. */
    Tcl_SetFromAnyProc *setFromAnyProc;
				/* Called to convert the object's internal rep
				 * to this type. Frees the internal rep of the
				 * old type. Returns TCL_ERROR on failure. */
} Tcl_ObjType;

/*
 * The following structure stores an internal representation (intrep) for
 * a Tcl value. An intrep is associated with an Tcl_ObjType when both
 * are stored in the same Tcl_Obj.  The routines of the Tcl_ObjType govern
 * the handling of the intrep.
 */

typedef union Tcl_ObjIntRep {	/* The internal representation: */
    long longValue;		/*   - an long integer value. */
    double doubleValue;		/*   - a double-precision floating value. */
    void *otherValuePtr;	/*   - another, type-specific value, */
				/*     not used internally any more. */
    Tcl_WideInt wideValue;	/*   - an integer value >= 64bits */
    struct {			/*   - internal rep as two pointers. */
	void *ptr1;
	void *ptr2;
    } twoPtrValue;
    struct {			/*   - internal rep as a pointer and a long, */
	void *ptr;		/*     not used internally any more. */
	unsigned long value;
    } ptrAndLongRep;
} Tcl_ObjIntRep;

/*
 * One of the following structures exists for each object in the Tcl system.
 * An object stores a value as either a string, some internal representation,
 * or both.
 */

typedef struct Tcl_Obj {
    size_t refCount;		/* When 0 the object will be freed. */
    int refCount;		/* When 0 the object will be freed. */
    char *bytes;		/* This points to the first byte of the
				 * object's string representation. The array
				 * must be followed by a null byte (i.e., at
				 * offset length) but may also contain
				 * embedded null characters. The array's
				 * storage is allocated by Tcl_Alloc. NULL means
				 * storage is allocated by ckalloc. NULL means
				 * the string rep is invalid and must be
				 * regenerated from the internal rep.  Clients
				 * should use Tcl_GetStringFromObj or
				 * Tcl_GetString to get a pointer to the byte
				 * array as a readonly value. */
    size_t length;		/* The number of bytes at *bytes, not
    int length;			/* The number of bytes at *bytes, not
				 * including the terminating null. */
    const Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
    Tcl_ObjType *typePtr;	/* Denotes the object's type. Always
				 * corresponds to the type of the object's
				 * internal rep. NULL indicates the object has
				 * no internal rep (has no type). */
    Tcl_ObjIntRep internalRep;	/* The internal representation: */
    union {			/* The internal representation: */
	long longValue;		/*   - an long integer value. */
	double doubleValue;	/*   - a double-precision floating value. */
	VOID *otherValuePtr;	/*   - another, type-specific value. */
	Tcl_WideInt wideValue;	/*   - a long long value. */
	struct {		/*   - internal rep as two pointers. */
	    VOID *ptr1;
	    VOID *ptr2;
	} twoPtrValue;
	struct {		/*   - internal rep as a wide int, tightly
				 *     packed fields. */
	    VOID *ptr;		/* Pointer to digits. */
	    unsigned long value;/* Alloc, used, and signum packed into a
				 * single word. */
	} ptrAndLongRep;
    } internalRep;
} Tcl_Obj;

/*
 * Macros to increment and decrement a Tcl_Obj's reference count, and to test
 * whether an object is shared (i.e. has reference count > 1). Note: clients
 * should use Tcl_DecrRefCount() when they are finished using an object, and
 * should never call TclFreeObj() directly. TclFreeObj() is only defined and
 * made public in tcl.h to support Tcl_DecrRefCount's macro definition.
 */


void		Tcl_IncrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
void		Tcl_DecrRefCount _ANSI_ARGS_((Tcl_Obj *objPtr));
int		Tcl_IsShared _ANSI_ARGS_((Tcl_Obj *objPtr));

/*
 *----------------------------------------------------------------------------
 * The following type contains the state needed by Tcl_SaveResult. It
 * is typically allocated on the stack.
 * The following structure contains the state needed by Tcl_SaveResult. No-one
 * outside of Tcl should access any of these fields. This structure is
 * typically allocated on the stack.
 */

typedef struct Tcl_SavedResult {
    char *result;
    Tcl_FreeProc *freeProc;
    Tcl_Obj *objResultPtr;
    char *appendResult;
    int appendAvl;
    int appendUsed;
    char resultSpace[TCL_RESULT_SIZE+1];
typedef Tcl_Obj *Tcl_SavedResult;
} Tcl_SavedResult;

/*
 *----------------------------------------------------------------------------
 * The following definitions support Tcl's namespace facility. Note: the first
 * five fields must match exactly the fields in a Namespace structure (see
 * tclInt.h).
 */

typedef struct Tcl_Namespace {
    char *name;			/* The namespace's name within its parent
				 * namespace. This contains no ::'s. The name
				 * of the global namespace is "" although "::"
				 * is an synonym. */
    char *fullName;		/* The namespace's fully qualified name. This
				 * starts with ::. */
    void *clientData;	/* Arbitrary value associated with this
    ClientData clientData;	/* Arbitrary value associated with this
				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Function invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Tcl_Namespace *parentPtr;
				/* Points to the namespace that contains this
				 * one. NULL if this is the global
				 * namespace. */
} Tcl_Namespace;

/*
 *----------------------------------------------------------------------------
 * The following structure represents a call frame, or activation record. A
 * call frame defines a naming context for a procedure call: its local scope
 * (for local variables) and its namespace scope (used for non-local
 * variables; often the global :: namespace). A call frame can also define the
 * naming context for a namespace eval or namespace inscope command: the
 * namespace in which the command's code should execute. The Tcl_CallFrame
 * structures exist only while procedures or namespace eval/inscope's are
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
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







-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+



-



















-
+

-
+



-
+









-









-
+

-
+








+



-
-
+
+







 * CallFrame structure in tclInt.h. If you change one, change the other.
 */

typedef struct Tcl_CallFrame {
    Tcl_Namespace *nsPtr;
    int dummy1;
    int dummy2;
    void *dummy3;
    void *dummy4;
    void *dummy5;
    VOID *dummy3;
    VOID *dummy4;
    VOID *dummy5;
    int dummy6;
    void *dummy7;
    void *dummy8;
    VOID *dummy7;
    VOID *dummy8;
    int dummy9;
    void *dummy10;
    void *dummy11;
    void *dummy12;
    void *dummy13;
    VOID *dummy10;
    VOID *dummy11;
    VOID *dummy12;
    VOID *dummy13;
} Tcl_CallFrame;

/*
 *----------------------------------------------------------------------------
 * Information about commands that is returned by Tcl_GetCommandInfo and
 * passed to Tcl_SetCommandInfo. objProc is an objc/objv object-based command
 * function while proc is a traditional Tcl argc/argv string-based function.
 * Tcl_CreateObjCommand and Tcl_CreateCommand ensure that both objProc and
 * proc are non-NULL and can be called to execute the command. However, it may
 * be faster to call one instead of the other. The member isNativeObjectProc
 * is set to 1 if an object-based function was registered by
 * Tcl_CreateObjCommand, and to 0 if a string-based function was registered by
 * Tcl_CreateCommand. The other function is typically set to a compatibility
 * wrapper that does string-to-object or object-to-string argument conversions
 * then calls the other function.
 */

typedef struct Tcl_CmdInfo {
    int isNativeObjectProc;	/* 1 if objProc was registered by a call to
				 * Tcl_CreateObjCommand; 0 otherwise.
				 * Tcl_SetCmdInfo does not modify this
				 * field. */
    Tcl_ObjCmdProc *objProc;	/* Command's object-based function. */
    void *objClientData;	/* ClientData for object proc. */
    ClientData objClientData;	/* ClientData for object proc. */
    Tcl_CmdProc *proc;		/* Command's string-based function. */
    void *clientData;	/* ClientData for string proc. */
    ClientData clientData;	/* ClientData for string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Function to call when command is
				 * deleted. */
    void *deleteData;	/* Value to pass to deleteProc (usually the
    ClientData deleteData;	/* Value to pass to deleteProc (usually the
				 * same as clientData). */
    Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this
				 * command. Note that Tcl_SetCmdInfo will not
				 * change a command's namespace; use
				 * TclRenameCommand or Tcl_Eval (of 'rename')
				 * to do that. */
} Tcl_CmdInfo;

/*
 *----------------------------------------------------------------------------
 * The structure defined below is used to hold dynamic strings. The only
 * fields that clients should use are string and length, accessible via the
 * macros Tcl_DStringValue and Tcl_DStringLength.
 */

#define TCL_DSTRING_STATIC_SIZE 200
typedef struct Tcl_DString {
    char *string;		/* Points to beginning of string: either
				 * staticSpace below or a malloced array. */
    size_t length;		/* Number of non-NULL characters in the
    int length;			/* Number of non-NULL characters in the
				 * string. */
    size_t spaceAvl;		/* Total number of bytes available for the
    int spaceAvl;		/* Total number of bytes available for the
				 * string and its terminating NULL char. */
    char staticSpace[TCL_DSTRING_STATIC_SIZE];
				/* Space to use in common case where string is
				 * small. */
} Tcl_DString;

#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
#define Tcl_DStringTrunc Tcl_DStringSetLength

/*
 * Definitions for the maximum number of digits of precision that may be
 * produced by Tcl_PrintDouble, and the number of bytes of buffer space
 * required by Tcl_PrintDouble.
 * specified in the "tcl_precision" variable, and the number of bytes of
 * buffer space required by Tcl_PrintDouble.
 */

#define TCL_MAX_PREC		17
#define TCL_DOUBLE_SPACE	(TCL_MAX_PREC+10)

/*
 * Definition for a number of bytes of buffer space sufficient to hold the
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
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
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
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







-
-
+
+
-
-


-
+
-


-













-
-
-
-
-

-
-
-
-
-
+
+
+
+
-
-












-
-










-
+



-
+


-
+















-
-
+
+



+
+
+
+
+
+
+
+
+
+
+














-
-
-
-


-


-
-

-
+

-



-
-
-
-




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










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







-
+

















+
+
+
+
+
+
+




+







 *	that condition.
 */

#define TCL_DONT_USE_BRACES	1
#define TCL_DONT_QUOTE_HASH	8

/*
 * Flags that may be passed to Tcl_GetIndexFromObj.
 * TCL_EXACT disallows abbreviated strings.
 * Flag that may be passed to Tcl_GetIndexFromObj to force it to disallow
 * abbreviated strings.
 * TCL_INDEX_TEMP_TABLE disallows caching of lookups. A possible use case is
 *      a table that will not live long enough to make it worthwhile.
 */

#define TCL_EXACT		1
#define TCL_EXACT	1
#define TCL_INDEX_TEMP_TABLE	2

/*
 *----------------------------------------------------------------------------
 * Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
 * WARNING: these bit choices must not conflict with the bit choices for
 * evalFlag bits in tclInt.h!
 *
 * Meanings:
 *	TCL_NO_EVAL:		Just record this command
 *	TCL_EVAL_GLOBAL:	Execute script in global namespace
 *	TCL_EVAL_DIRECT:	Do not compile this script
 *	TCL_EVAL_INVOKE:	Magical Tcl_EvalObjv mode for aliases/ensembles
 *				o Run in iPtr->lookupNsPtr or global namespace
 *				o Cut out of error traces
 *				o Don't reset the flags controlling ensemble
 *				  error message rewriting.
 *	TCL_CANCEL_UNWIND:	Magical Tcl_CancelEval mode that causes the
 *				stack for the script in progress to be
 *				completely unwound.
 *	TCL_EVAL_NOERR:	Do no exception reporting at all, just return
 *				as the caller will report.
 */

#define TCL_NO_EVAL		0x010000
#define TCL_EVAL_GLOBAL		0x020000
#define TCL_EVAL_DIRECT		0x040000
#define TCL_EVAL_INVOKE		0x080000
#define TCL_NO_EVAL		0x10000
#define TCL_EVAL_GLOBAL		0x20000
#define TCL_EVAL_DIRECT		0x40000
#define TCL_EVAL_INVOKE		0x80000
#define TCL_CANCEL_UNWIND	0x100000
#define TCL_EVAL_NOERR          0x200000

/*
 * Special freeProc values that may be passed to Tcl_SetResult (see the man
 * page for details):
 */

#define TCL_VOLATILE		((Tcl_FreeProc *) 1)
#define TCL_STATIC		((Tcl_FreeProc *) 0)
#define TCL_DYNAMIC		((Tcl_FreeProc *) 3)

/*
 * Flag values passed to variable-related functions.
 * WARNING: these bit choices must not conflict with the bit choice for
 * TCL_CANCEL_UNWIND, above.
 */

#define TCL_GLOBAL_ONLY		 1
#define TCL_NAMESPACE_ONLY	 2
#define TCL_APPEND_VALUE	 4
#define TCL_LIST_ELEMENT	 8
#define TCL_TRACE_READS		 0x10
#define TCL_TRACE_WRITES	 0x20
#define TCL_TRACE_UNSETS	 0x40
#define TCL_TRACE_DESTROYED	 0x80

#define TCL_INTERP_DESTROYED	 0x100
#define TCL_LEAVE_ERR_MSG	 0x200
#define TCL_TRACE_ARRAY		 0x800
#ifndef TCL_REMOVE_OBSOLETE_TRACES
/* Required to support old variable/vdelete/vinfo traces. */
/* Required to support old variable/vdelete/vinfo traces */
#define TCL_TRACE_OLD_STYLE	 0x1000
#endif
/* Indicate the semantics of the result of a trace. */
/* Indicate the semantics of the result of a trace */
#define TCL_TRACE_RESULT_DYNAMIC 0x8000
#define TCL_TRACE_RESULT_OBJECT  0x10000

/*
 * Flag values for ensemble commands.
 */

#define TCL_ENSEMBLE_PREFIX 0x02/* Flag value to say whether to allow
				 * unambiguous prefixes of commands or to
				 * require exact matches for command names. */

/*
 * Flag values passed to command-related functions.
 */

#define TCL_TRACE_RENAME	0x2000
#define TCL_TRACE_DELETE	0x4000
#define TCL_TRACE_RENAME 0x2000
#define TCL_TRACE_DELETE 0x4000

#define TCL_ALLOW_INLINE_COMPILATION 0x20000

/*
 * The TCL_PARSE_PART1 flag is deprecated and has no effect. The part1 is now
 * always parsed whenever the part2 is NULL. (This is to avoid a common error
 * when converting code to use the new object based APIs and forgetting to
 * give the flag)
 */

#ifndef TCL_NO_DEPRECATED
#   define TCL_PARSE_PART1	0x400
#endif

/*
 * Types for linked variables:
 */

#define TCL_LINK_INT		1
#define TCL_LINK_DOUBLE		2
#define TCL_LINK_BOOLEAN	3
#define TCL_LINK_STRING		4
#define TCL_LINK_WIDE_INT	5
#define TCL_LINK_CHAR		6
#define TCL_LINK_UCHAR		7
#define TCL_LINK_SHORT		8
#define TCL_LINK_USHORT		9
#define TCL_LINK_UINT		10
#if defined(TCL_WIDE_INT_IS_LONG) || defined(_WIN32) || defined(__CYGWIN__)
#define TCL_LINK_LONG		((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT)
#define TCL_LINK_ULONG		((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
#else
#define TCL_LINK_LONG		11
#define TCL_LINK_ULONG		12
#endif
#define TCL_LINK_FLOAT		13
#define TCL_LINK_WIDE_UINT	14
#define TCL_LINK_CHARS		15
#define TCL_LINK_BINARY		16
#define TCL_LINK_READ_ONLY	0x80


/*
 *----------------------------------------------------------------------------
 * Forward declarations of Tcl_HashTable and related types.
 */

#ifndef TCL_HASH_TYPE
#  define TCL_HASH_TYPE size_t
#endif

typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;

typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
	void *keyPtr);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);
typedef unsigned int (Tcl_HashKeyProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
	VOID *keyPtr));
typedef int (Tcl_CompareHashKeysProc) _ANSI_ARGS_((VOID *keyPtr,
	Tcl_HashEntry *hPtr));
typedef Tcl_HashEntry *(Tcl_AllocHashEntryProc) _ANSI_ARGS_((
	Tcl_HashTable *tablePtr, VOID *keyPtr));
typedef void (Tcl_FreeHashEntryProc) _ANSI_ARGS_((Tcl_HashEntry *hPtr));

/*
 * This flag controls whether the hash table stores the hash of a key, or
 * recalculates it. There should be no reason for turning this flag off as it
 * is completely binary and source compatible unless you directly access the
 * bucketPtr member of the Tcl_HashTableEntry structure. This member has been
 * removed and the space used to store the hash value.
 */

#ifndef TCL_HASH_KEY_STORE_HASH
#   define TCL_HASH_KEY_STORE_HASH 1
#endif

/*
 * Structure definition for an entry in a hash table. No-one outside Tcl
 * should access any of these fields directly; use the macros defined below.
 */

struct Tcl_HashEntry {
    Tcl_HashEntry *nextPtr;	/* Pointer to next entry in this hash bucket,
				 * or NULL for end of chain. */
    Tcl_HashTable *tablePtr;	/* Pointer to table containing entry. */
#if TCL_HASH_KEY_STORE_HASH
    size_t hash;		/* Hash value. */
    void *clientData;		/* Application stores something here with
    VOID *hash;			/* Hash value, stored as pointer to ensure
				 * that the offsets of the fields in this
				 * structure are not changed. */
#else
    Tcl_HashEntry **bucketPtr;	/* Pointer to bucket that points to first
				 * entry in this entry's chain: used for
				 * deleting the entry. */
#endif
    ClientData clientData;	/* Application stores something here with
				 * Tcl_SetHashValue. */
    union {			/* Key has one of these forms: */
	char *oneWordValue;	/* One-word value for key. */
	Tcl_Obj *objPtr;	/* Tcl_Obj * key value. */
	int words[1];		/* Multiple integer words for key. The actual
				 * size will be as large as necessary for this
				 * table's keys. */
	char string[1];		/* String for key. The actual size will be as
	char string[4];		/* String for key. The actual size will be as
				 * large as needed to hold the key. */
    } key;			/* MUST BE LAST FIELD IN RECORD!! */
};

/*
 * Flags used in Tcl_HashKeyType.
 *
 * TCL_HASH_KEY_RANDOMIZE_HASH -
 *				There are some things, pointers for example
 *				which don't hash well because they do not use
 *				the lower bits. If this flag is set then the
 *				hash table will attempt to rectify this by
 *				randomising the bits and then using the upper
 *				N bits as the index into the table.
 * TCL_HASH_KEY_SYSTEM_HASH -	If this flag is set then all memory internally
 *                              allocated for the hash table that is not for an
 *                              entry will use the system heap.
 * TCL_HASH_KEY_DIRECT_COMPARE -
 * 	                        Allows fast comparison for hash keys directly
 *                              by compare of their key.oneWordValue values,
 *                              before call of compareKeysProc (much slower
 *                              than a direct compare, so it is speed-up only
 *                              flag). Don't use it if keys contain values rather
 *                              than pointers.
 */

#define TCL_HASH_KEY_RANDOMIZE_HASH 0x1
#define TCL_HASH_KEY_SYSTEM_HASH    0x2
#define TCL_HASH_KEY_DIRECT_COMPARE 0x4

/*
 * Structure definition for the methods associated with a hash table key type.
 */

#define TCL_HASH_KEY_TYPE_VERSION 1
struct Tcl_HashKeyType {
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
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







-
+

-
+

-
+

-



+





-
-
-
+
+
+
+
-
-
+










-
+







struct Tcl_HashTable {
    Tcl_HashEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables (to
				 * avoid mallocs and frees). */
    size_t numBuckets;		/* Total number of buckets allocated at
    int numBuckets;		/* Total number of buckets allocated at
				 * **bucketPtr. */
    size_t numEntries;		/* Total number of entries present in
    int numEntries;		/* Total number of entries present in
				 * table. */
    size_t rebuildSize;		/* Enlarge table when numEntries gets to be
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t mask;		/* Mask value used in hashing function. */
    int downShift;		/* Shift count used in hashing function.
				 * Designed to use high-order bits of
				 * randomized keys. */
    int mask;			/* Mask value used in hashing function. */
    int keyType;		/* Type of keys used in this table. It's
				 * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
				 * TCL_ONE_WORD_KEYS, or an integer giving the
				 * number of ints that is the size of the
				 * key. */
    Tcl_HashEntry *(*findProc) (Tcl_HashTable *tablePtr, const char *key);
    Tcl_HashEntry *(*createProc) (Tcl_HashTable *tablePtr, const char *key,
	    int *newPtr);
    Tcl_HashEntry *(*findProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
	    CONST char *key));
    Tcl_HashEntry *(*createProc) _ANSI_ARGS_((Tcl_HashTable *tablePtr,
	    CONST char *key, int *newPtr));
    const Tcl_HashKeyType *typePtr;
				/* Type of the keys used in the
    Tcl_HashKeyType *typePtr;	/* Type of the keys used in the
				 * Tcl_HashTable. */
};

/*
 * Structure definition for information used to keep track of searches through
 * hash tables:
 */

typedef struct Tcl_HashSearch {
    Tcl_HashTable *tablePtr;	/* Table being searched. */
    size_t nextIndex;		/* Index of next bucket to be enumerated after
    int nextIndex;		/* Index of next bucket to be enumerated after
				 * present one. */
    Tcl_HashEntry *nextEntryPtr;/* Next entry to be enumerated in the current
				 * bucket. */
} Tcl_HashSearch;

/*
 * Acceptable key types for hash tables:
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
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







-
-
-
-
+
+
+
+










-
-
+
+


-
+

-







 * which don't have a typePtr and new ones which do. Once binary compatibility
 * is discarded in favour of making more wide spread changes TCL_STRING_KEYS
 * can be the same as TCL_CUSTOM_TYPE_KEYS, and TCL_ONE_WORD_KEYS can be the
 * same as TCL_CUSTOM_PTR_KEYS because they simply determine how the key is
 * accessed from the entry and not the behaviour.
 */

#define TCL_STRING_KEYS		(0)
#define TCL_ONE_WORD_KEYS	(1)
#define TCL_CUSTOM_TYPE_KEYS	(-2)
#define TCL_CUSTOM_PTR_KEYS	(-1)
#define TCL_STRING_KEYS		0
#define TCL_ONE_WORD_KEYS	1
#define TCL_CUSTOM_TYPE_KEYS	-2
#define TCL_CUSTOM_PTR_KEYS	-1

/*
 * Structure definition for information used to keep track of searches through
 * dictionaries. These fields should not be accessed by code outside
 * tclDictObj.c
 */

typedef struct {
    void *next;			/* Search position for underlying hash
				 * table. */
    size_t epoch;		/* Epoch marker for dictionary being searched,
				 * or 0 if search has terminated. */
    int epoch;			/* Epoch marker for dictionary being searched,
				 * or -1 if search has terminated. */
    Tcl_Dict dictionaryPtr;	/* Reference to dictionary being searched. */
} Tcl_DictSearch;


/*
 *----------------------------------------------------------------------------
 * Flag values to pass to Tcl_DoOneEvent to disable searches for some kinds of
 * events:
 */

#define TCL_DONT_WAIT		(1<<1)
#define TCL_WINDOW_EVENTS	(1<<2)
#define TCL_FILE_EVENTS		(1<<3)
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
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







-
-
+
+





-
-
+
+
+
+


-







 */

typedef struct Tcl_Time {
    long sec;			/* Seconds. */
    long usec;			/* Microseconds. */
} Tcl_Time;

typedef void (Tcl_SetTimerProc) (const Tcl_Time *timePtr);
typedef int (Tcl_WaitForEventProc) (const Tcl_Time *timePtr);
typedef void (Tcl_SetTimerProc) _ANSI_ARGS_((Tcl_Time *timePtr));
typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));

/*
 * TIP #233 (Virtualized Time)
 */

typedef void (Tcl_GetTimeProc)   (Tcl_Time *timebuf, void *clientData);
typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
typedef void (Tcl_GetTimeProc)   _ANSI_ARGS_((Tcl_Time *timebuf,
	ClientData clientData));
typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_((Tcl_Time *timebuf,
	ClientData clientData));

/*
 *----------------------------------------------------------------------------
 * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
 * indicate what sorts of events are of interest:
 */

#define TCL_READABLE		(1<<1)
#define TCL_WRITABLE		(1<<2)
#define TCL_EXCEPTION		(1<<3)
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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463


1464
1465
1466
1467
1468


1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483

1484
1485
1486
1487
1488


1489
1490
1491
1492
1493
1494
1495
1496


1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564

1565
1566
1567
1568
1569
1570
1571







-
+





+
+
+
+













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



-
-
+
+



-
-
+
+













-
+




-
-
+
+
+
+




-
-
+
+
+

















+
+
+







+
+
+





+
+
+
+




+
+
+
+
+

















-







#define TCL_CLOSE_WRITE		(1<<2)

/*
 * Value to use as the closeProc for a channel that supports the close2Proc
 * interface.
 */

#define TCL_CLOSE2PROC		NULL
#define TCL_CLOSE2PROC		((Tcl_DriverCloseProc *) 1)

/*
 * Channel version tag. This was introduced in 8.3.2/8.4.
 */

#define TCL_CHANNEL_VERSION_1	((Tcl_ChannelTypeVersion) 0x1)
#define TCL_CHANNEL_VERSION_2	((Tcl_ChannelTypeVersion) 0x2)
#define TCL_CHANNEL_VERSION_3	((Tcl_ChannelTypeVersion) 0x3)
#define TCL_CHANNEL_VERSION_4	((Tcl_ChannelTypeVersion) 0x4)
#define TCL_CHANNEL_VERSION_5	((Tcl_ChannelTypeVersion) 0x5)

/*
 * TIP #218: Channel Actions, Ids for Tcl_DriverThreadActionProc.
 */

#define TCL_CHANNEL_THREAD_INSERT (0)
#define TCL_CHANNEL_THREAD_REMOVE (1)

/*
 * Typedefs for the various operations in a channel type:
 */

typedef int	(Tcl_DriverBlockModeProc) (void *instanceData, int mode);
typedef void Tcl_DriverCloseProc;
typedef int	(Tcl_DriverClose2Proc) (void *instanceData,
			Tcl_Interp *interp, int flags);
typedef int	(Tcl_DriverInputProc) (void *instanceData, char *buf,
			int toRead, int *errorCodePtr);
typedef int	(Tcl_DriverOutputProc) (void *instanceData,
			const char *buf, int toWrite, int *errorCodePtr);
typedef void Tcl_DriverSeekProc;
typedef int	(Tcl_DriverSetOptionProc) (void *instanceData,
			Tcl_Interp *interp, const char *optionName,
			const char *value);
typedef int	(Tcl_DriverGetOptionProc) (void *instanceData,
			Tcl_Interp *interp, const char *optionName,
			Tcl_DString *dsPtr);
typedef void	(Tcl_DriverWatchProc) (void *instanceData, int mask);
typedef int	(Tcl_DriverGetHandleProc) (void *instanceData,
			int direction, void **handlePtr);
typedef int	(Tcl_DriverFlushProc) (void *instanceData);
typedef int	(Tcl_DriverHandlerProc) (void *instanceData,
			int interestMask);
typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (void *instanceData,
			Tcl_WideInt offset, int mode, int *errorCodePtr);
typedef int	(Tcl_DriverBlockModeProc) _ANSI_ARGS_((
		    ClientData instanceData, int mode));
typedef int	(Tcl_DriverCloseProc) _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp));
typedef int	(Tcl_DriverClose2Proc) _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp, int flags));
typedef int	(Tcl_DriverInputProc) _ANSI_ARGS_((ClientData instanceData,
		    char *buf, int toRead, int *errorCodePtr));
typedef int	(Tcl_DriverOutputProc) _ANSI_ARGS_((ClientData instanceData,
		    CONST84 char *buf, int toWrite, int *errorCodePtr));
typedef int	(Tcl_DriverSeekProc) _ANSI_ARGS_((ClientData instanceData,
		    long offset, int mode, int *errorCodePtr));
typedef int	(Tcl_DriverSetOptionProc) _ANSI_ARGS_((
		    ClientData instanceData, Tcl_Interp *interp,
		    CONST char *optionName, CONST char *value));
typedef int	(Tcl_DriverGetOptionProc) _ANSI_ARGS_((
		    ClientData instanceData, Tcl_Interp *interp,
		    CONST84 char *optionName, Tcl_DString *dsPtr));
typedef void	(Tcl_DriverWatchProc) _ANSI_ARGS_((
		    ClientData instanceData, int mask));
typedef int	(Tcl_DriverGetHandleProc) _ANSI_ARGS_((
		    ClientData instanceData, int direction,
		    ClientData *handlePtr));
typedef int	(Tcl_DriverFlushProc) _ANSI_ARGS_((ClientData instanceData));
typedef int	(Tcl_DriverHandlerProc) _ANSI_ARGS_((
		    ClientData instanceData, int interestMask));
typedef Tcl_WideInt (Tcl_DriverWideSeekProc) _ANSI_ARGS_((
		    ClientData instanceData, Tcl_WideInt offset,
		    int mode, int *errorCodePtr));
/*
 * TIP #218, Channel Thread Actions
 */
typedef void	(Tcl_DriverThreadActionProc) (void *instanceData,
			int action);
typedef void	(Tcl_DriverThreadActionProc) _ANSI_ARGS_ ((
		    ClientData instanceData, int action));
/*
 * TIP #208, File Truncation (etc.)
 */
typedef int	(Tcl_DriverTruncateProc) (void *instanceData,
			Tcl_WideInt length);
typedef int	(Tcl_DriverTruncateProc) _ANSI_ARGS_((
		    ClientData instanceData, Tcl_WideInt length));

/*
 * struct Tcl_ChannelType:
 *
 * One such structure exists for each type (kind) of channel. It collects
 * together in one place all the functions that are part of the specific
 * channel type.
 *
 * It is recommend that the Tcl_Channel* functions are used to access elements
 * of this structure, instead of direct accessing.
 */

typedef struct Tcl_ChannelType {
    const char *typeName;	/* The name of the channel type in Tcl
    char *typeName;		/* The name of the channel type in Tcl
				 * commands. This storage is owned by channel
				 * type. */
    Tcl_ChannelTypeVersion version;
				/* Version of the channel type. */
    void *closeProc;
				/* Not used any more. */
    Tcl_DriverCloseProc *closeProc;
				/* Function to call to close the channel, or
				 * TCL_CLOSE2PROC if the close2Proc should be
				 * used instead. */
    Tcl_DriverInputProc *inputProc;
				/* Function to call for input on channel. */
    Tcl_DriverOutputProc *outputProc;
				/* Function to call for output on channel. */
    void *seekProc;
				/* Not used any more. */
    Tcl_DriverSeekProc *seekProc;
				/* Function to call to seek on the channel.
				 * May be NULL. */
    Tcl_DriverSetOptionProc *setOptionProc;
				/* Set an option on a channel. */
    Tcl_DriverGetOptionProc *getOptionProc;
				/* Get an option from a channel. */
    Tcl_DriverWatchProc *watchProc;
				/* Set up the notifier to watch for events on
				 * this channel. */
    Tcl_DriverGetHandleProc *getHandleProc;
				/* Get an OS handle from the channel or NULL
				 * if not supported. */
    Tcl_DriverClose2Proc *close2Proc;
				/* Function to call to close the channel if
				 * the device supports closing the read &
				 * write sides independently. */
    Tcl_DriverBlockModeProc *blockModeProc;
				/* Set blocking mode for the raw channel. May
				 * be NULL. */
    /*
     * Only valid in TCL_CHANNEL_VERSION_2 channels or later.
     */
    Tcl_DriverFlushProc *flushProc;
				/* Function to call to flush a channel. May be
				 * NULL. */
    Tcl_DriverHandlerProc *handlerProc;
				/* Function to call to handle a channel event.
				 * This will be passed up the stacked channel
				 * chain. */
    /*
     * Only valid in TCL_CHANNEL_VERSION_3 channels or later.
     */
    Tcl_DriverWideSeekProc *wideSeekProc;
				/* Function to call to seek on the channel
				 * which can handle 64-bit offsets. May be
				 * NULL, and must be NULL if seekProc is
				 * NULL. */
    /*
     * Only valid in TCL_CHANNEL_VERSION_4 channels or later.
     * TIP #218, Channel Thread Actions.
     */
    Tcl_DriverThreadActionProc *threadActionProc;
				/* Function to call to notify the driver of
				 * thread specific activity for a channel. May
				 * be NULL. */

    /*
     * Only valid in TCL_CHANNEL_VERSION_5 channels or later.
     * TIP #208, File Truncation.
     */
    Tcl_DriverTruncateProc *truncateProc;
				/* Function to call to truncate the underlying
				 * file to a particular length. May be NULL if
				 * the channel does not support truncation. */
} Tcl_ChannelType;

/*
 * The following flags determine whether the blockModeProc above should set
 * the channel into blocking or nonblocking mode. They are passed as arguments
 * to the blockModeProc function in the above structure.
 */

#define TCL_MODE_BLOCKING	0	/* Put channel into blocking mode. */
#define TCL_MODE_NONBLOCKING	1	/* Put channel into nonblocking
					 * mode. */

/*
 *----------------------------------------------------------------------------
 * Enum for different types of file paths.
 */

typedef enum Tcl_PathType {
    TCL_PATH_ABSOLUTE,
    TCL_PATH_RELATIVE,
    TCL_PATH_VOLUME_RELATIVE
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449




























1450
1451
1452
1453
1454

1455

1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479


1480
1481
1482
1483

1484
1485
1486
1487
1488


1489
1490
1491
1492
1493



1494

1495
1496
1497



1498

1499
1500
1501
1502
1503
1504






1505
1506
1507
1508




1509
1510
1511


1512
1513
1514
1515
1516






1517
1518
1519



1520

1521
1522



1523

1524

1525
1526
1527
1528
1529
1530
1531
1532












1533
1534
1535
1536




1537
1538
1539
1540
1541
1542






1543

1544
1545


1546

1547
1548


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
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

1631


1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642



1643
1644
1645
1646
1647
1648
1649
1609
1610
1611
1612
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





















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
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
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
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
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







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


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




-
+

+





-






-
+









-
-
+
+



-
+



-
-
+
+
-

-
-
-
+
+
+

+
-
-
-
+
+
+

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

-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+
+
+

-
-
+
+
+

+
-
-
+
+
+

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

-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+

+
-
-
+
+

+
-
-
+
+

+
-
-
+
+

+
-
-
+
+

-
-
+
+
+

-
+
-
-
+
+
+
+

-
+
-
-
-
+
+
+

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

-
+
-
-
-
+
+
+

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
















-














-
+

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

+
-
+
+








-
-
-
+
+
+







#define TCL_UNLOAD_DETACH_FROM_INTERPRETER	(1<<0)
#define TCL_UNLOAD_DETACH_FROM_PROCESS		(1<<1)

/*
 * Typedefs for the various filesystem operations:
 */

typedef int (Tcl_FSStatProc) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
typedef int (Tcl_FSAccessProc) (Tcl_Obj *pathPtr, int mode);
typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) (Tcl_Interp *interp,
	Tcl_Obj *pathPtr, int mode, int permissions);
typedef int (Tcl_FSMatchInDirectoryProc) (Tcl_Interp *interp, Tcl_Obj *result,
	Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types);
typedef Tcl_Obj * (Tcl_FSGetCwdProc) (Tcl_Interp *interp);
typedef int (Tcl_FSChdirProc) (Tcl_Obj *pathPtr);
typedef int (Tcl_FSLstatProc) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
typedef int (Tcl_FSCreateDirectoryProc) (Tcl_Obj *pathPtr);
typedef int (Tcl_FSDeleteFileProc) (Tcl_Obj *pathPtr);
typedef int (Tcl_FSCopyDirectoryProc) (Tcl_Obj *srcPathPtr,
	Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
typedef int (Tcl_FSCopyFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
typedef int (Tcl_FSRemoveDirectoryProc) (Tcl_Obj *pathPtr, int recursive,
	Tcl_Obj **errorPtr);
typedef int (Tcl_FSRenameFileProc) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr);
typedef void (Tcl_FSUnloadFileProc) (Tcl_LoadHandle loadHandle);
typedef Tcl_Obj * (Tcl_FSListVolumesProc) (void);
typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((
	Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions));
typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp *interp,
	Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern,
	Tcl_GlobTypeData * types));
typedef Tcl_Obj * (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
	Tcl_StatBuf *buf));
typedef int (Tcl_FSCreateDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef int (Tcl_FSDeleteFileProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
typedef int (Tcl_FSCopyDirectoryProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
	Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr));
typedef int (Tcl_FSCopyFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
	Tcl_Obj *destPathPtr));
typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
	int recursive, Tcl_Obj **errorPtr));
typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
	Tcl_Obj *destPathPtr));
typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
typedef Tcl_Obj * (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
/* We have to declare the utime structure here. */
struct utimbuf;
typedef int (Tcl_FSUtimeProc) (Tcl_Obj *pathPtr, struct utimbuf *tval);
typedef int (Tcl_FSNormalizePathProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	int nextCheckpoint);
typedef int (Tcl_FSFileAttrsGetProc) (Tcl_Interp *interp, int index,
	Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
typedef const char *const * (Tcl_FSFileAttrStringsProc) (Tcl_Obj *pathPtr,
	Tcl_Obj **objPtrRef);
typedef int (Tcl_FSFileAttrsSetProc) (Tcl_Interp *interp, int index,
	Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
typedef Tcl_Obj * (Tcl_FSLinkProc) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
	int linkType);
typedef int (Tcl_FSLoadFileProc) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr);
typedef int (Tcl_FSPathInFilesystemProc) (Tcl_Obj *pathPtr,
	void **clientDataPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) (Tcl_Obj *pathPtr);
typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) (Tcl_Obj *pathPtr);
#define Tcl_FSFreeInternalRepProc Tcl_FreeProc
typedef void *(Tcl_FSDupInternalRepProc) (void *clientData);
typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) (void *clientData);
typedef void *(Tcl_FSCreateInternalRepProc) (Tcl_Obj *pathPtr);
typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
	struct utimbuf *tval));
typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp,
	Tcl_Obj *pathPtr, int nextCheckpoint));
typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp,
	int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef));
typedef CONST char ** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((
	Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef));
typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp,
	int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr));
typedef Tcl_Obj * (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
	Tcl_Obj *toPtr, int linkType));
typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp,
	Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr,
	Tcl_FSUnloadFileProc **unloadProcPtr));
typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
	ClientData *clientDataPtr));
typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) _ANSI_ARGS_((
	Tcl_Obj *pathPtr));
typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) _ANSI_ARGS_((
	Tcl_Obj *pathPtr));
typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData));
typedef ClientData (Tcl_FSDupInternalRepProc) _ANSI_ARGS_((
	ClientData clientData));
typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) _ANSI_ARGS_((
	ClientData clientData));
typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((
	Tcl_Obj *pathPtr));

typedef struct Tcl_FSVersion_ *Tcl_FSVersion;

/*
 *----------------------------------------------------------------------------
 *----------------------------------------------------------------
 * Data structures related to hooking into the filesystem
 *----------------------------------------------------------------
 */

/*
 * Filesystem version tag.  This was introduced in 8.4.
 */

#define TCL_FILESYSTEM_VERSION_1	((Tcl_FSVersion) 0x1)

/*
 * struct Tcl_Filesystem:
 *
 * One such structure exists for each type (kind) of filesystem. It collects
 * together the functions that form the interface for a particulr the
 * together in one place all the functions that are part of the specific
 * filesystem. Tcl always accesses the filesystem through one of these
 * structures.
 *
 * Not all entries need be non-NULL; any which are NULL are simply ignored.
 * However, a complete filesystem should provide all of these functions. The
 * explanations in the structure show the importance of each function.
 */

typedef struct Tcl_Filesystem {
    const char *typeName;	/* The name of the filesystem. */
    size_t structureLength;	/* Length of this structure, so future binary
    CONST char *typeName;	/* The name of the filesystem. */
    int structureLength;	/* Length of this structure, so future binary
				 * compatibility can be assured. */
    Tcl_FSVersion version;	/* Version of the filesystem type. */
    Tcl_FSPathInFilesystemProc *pathInFilesystemProc;
				/* Determines whether the pathname is in this
				/* Function to check whether a path is in this
				 * filesystem. This is the most important
				 * filesystem function. */
    Tcl_FSDupInternalRepProc *dupInternalRepProc;
				/* Duplicates the internal handle of the node.
				 * If it is NULL, the filesystem is less
				/* Function to duplicate internal fs rep. May
				 * be NULL (but then fs is less efficient). */
				 * performant. */
    Tcl_FSFreeInternalRepProc *freeInternalRepProc;
				/* Frees the internal handle of the node.  NULL
				 * only if there is no need to free resources
				 * used for the internal handle. */
				/* Function to free internal fs rep. Must be
				 * implemented if internal representations
				 * need freeing, otherwise it can be NULL. */
    Tcl_FSInternalToNormalizedProc *internalToNormalizedProc;
				/* Function to convert internal representation
				/* Converts the internal handle to a normalized
				 * path.  NULL if the filesystem creates nodes
				 * having no pathname. */
				 * to a normalized path. Only required if the
				 * fs creates pure path objects with no
				 * string/path representation. */
    Tcl_FSCreateInternalRepProc *createInternalRepProc;
				/* Function to create a filesystem-specific
				/* Creates an internal handle for a pathname.
				 * May be NULL if pathnames have no internal
				 * handle or if pathInFilesystemProc always
				 * immediately creates an internal
				 * representation for pathnames in the
				 * filesystem. */
				 * internal representation. May be NULL if
				 * paths have no internal representation, or
				 * if the Tcl_FSPathInFilesystemProc for this
				 * filesystem always immediately creates an
				 * internal representation for paths it
				 * accepts. */
    Tcl_FSNormalizePathProc *normalizePathProc;
				/* Normalizes a path.  Should be implemented if
				 * the filesystems supports multiple paths to
				 * the same node. */
				/* Function to normalize a path.  Should be
				 * implemented for all filesystems which can
				 * have multiple string representations for
				 * the same path object. */
    Tcl_FSFilesystemPathTypeProc *filesystemPathTypeProc;
				/* Determines the type of a path in this
				 * filesystem. May be NULL. */
				/* Function to determine the type of a path in
				 * this filesystem. May be NULL. */
    Tcl_FSFilesystemSeparatorProc *filesystemSeparatorProc;
				/* Produces the separator character(s) for this
				 * filesystem. Must not be NULL. */
    Tcl_FSStatProc *statProc;	/* Called by 'Tcl_FSStat()'.  Provided by any
				 * reasonable filesystem. */
				/* Function to return the separator
				 * character(s) for this filesystem. Must be
				 * implemented. */
    Tcl_FSStatProc *statProc;	/* Function to process a 'Tcl_FSStat()' call.
				 * Must be implemented for any reasonable
				 * filesystem. */
    Tcl_FSAccessProc *accessProc;
				/* Called by 'Tcl_FSAccess()'.  Implemented by
				 * any reasonable filesystem. */
				/* Function to process a 'Tcl_FSAccess()'
				 * call. Must be implemented for any
				 * reasonable filesystem. */
    Tcl_FSOpenFileChannelProc *openFileChannelProc;
				/* Function to process a
				/* Called by 'Tcl_FSOpenFileChannel()'.
				 * Provided by any reasonable filesystem. */
				 * 'Tcl_FSOpenFileChannel()' call. Must be
				 * implemented for any reasonable
				 * filesystem. */
    Tcl_FSMatchInDirectoryProc *matchInDirectoryProc;
				/* Function to process a
				/* Called by 'Tcl_FSMatchInDirectory()'.  NULL
				 * 'Tcl_FSMatchInDirectory()'.  If not
				 * if the filesystem does not support glob or
				 * recursive copy. */
    Tcl_FSUtimeProc *utimeProc;	/* Called by 'Tcl_FSUtime()', by 'file
				 *  mtime' to set (not read) times, 'file
				 *  atime', and the open-r/open-w/fcopy variant
				 *  of 'file copy'. */
    Tcl_FSLinkProc *linkProc;	/* Called by 'Tcl_FSLink()'. NULL if reading or
				 *  creating links is not supported. */
				 * implemented, then glob and recursive copy
				 * functionality will be lacking in the
				 * filesystem. */
    Tcl_FSUtimeProc *utimeProc;	/* Function to process a 'Tcl_FSUtime()' call.
				 * Required to allow setting (not reading) of
				 * times with 'file mtime', 'file atime' and
				 * the open-r/open-w/fcopy implementation of
				 * 'file copy'. */
    Tcl_FSLinkProc *linkProc;	/* Function to process a 'Tcl_FSLink()' call.
				 * Should be implemented only if the
				 * filesystem supports links (reading or
				 * creating). */
    Tcl_FSListVolumesProc *listVolumesProc;
				/* Lists filesystem volumes added by this
				 * filesystem. NULL if the filesystem does not
				 * use volumes. */
				/* Function to list any filesystem volumes
				 * added by this filesystem. Should be
				 * implemented only if the filesystem adds
				 * volumes at the head of the filesystem. */
    Tcl_FSFileAttrStringsProc *fileAttrStringsProc;
				/* List all valid attributes strings.  NULL if
				 * the filesystem does not support the 'file
				 * attributes' command.  Can be used to attach
				 * arbitrary additional data to files in a
				 * filesystem. */
				/* Function to list all attributes strings
				 * which are valid for this filesystem. If not
				 * implemented the filesystem will not support
				 * the 'file attributes' command. This allows
				 * arbitrary additional information to be
				 * attached to files in the filesystem. */
    Tcl_FSFileAttrsGetProc *fileAttrsGetProc;
				/* Function to process a
				/* Called by 'Tcl_FSFileAttrsGet()' and by
				 * 'file attributes'. */
				 * 'Tcl_FSFileAttrsGet()' call, used by 'file
				 * attributes'. */
    Tcl_FSFileAttrsSetProc *fileAttrsSetProc;
				/* Function to process a
				/* Called by 'Tcl_FSFileAttrsSet()' and by
				 * 'file attributes'.  */
				 * 'Tcl_FSFileAttrsSet()' call, used by 'file
				 * attributes'.  */
    Tcl_FSCreateDirectoryProc *createDirectoryProc;
				/* Function to process a
				/* Called by 'Tcl_FSCreateDirectory()'.  May be
				 * NULL if the filesystem is read-only. */
				 * 'Tcl_FSCreateDirectory()' call. Should be
				 * implemented unless the FS is read-only. */
    Tcl_FSRemoveDirectoryProc *removeDirectoryProc;
				/* Function to process a
				/* Called by 'Tcl_FSRemoveDirectory()'.  May be
				 * NULL if the filesystem is read-only. */
				 * 'Tcl_FSRemoveDirectory()' call. Should be
				 * implemented unless the FS is read-only. */
    Tcl_FSDeleteFileProc *deleteFileProc;
				/* Called by 'Tcl_FSDeleteFile()' May be NULL
				 * if the filesystem is is read-only. */
				/* Function to process a 'Tcl_FSDeleteFile()'
				 * call. Should be implemented unless the FS
				 * is read-only. */
    Tcl_FSCopyFileProc *copyFileProc;
				/* Called by 'Tcl_FSCopyFile()'.  If NULL, for
				/* Function to process a 'Tcl_FSCopyFile()'
				 * a copy operation at the script level (not
				 * C) Tcl uses open-r, open-w and fcopy. */
				 * call. If not implemented Tcl will fall back
				 * on open-r, open-w and fcopy as a copying
				 * mechanism, for copying actions initiated in
				 * Tcl (not C). */
    Tcl_FSRenameFileProc *renameFileProc;
				/* Called by 'Tcl_FSRenameFile()'. If NULL, for
				/* Function to process a 'Tcl_FSRenameFile()'
				 * a rename operation at the script level (not
				 * C) Tcl performs a copy operation followed
				 * by a delete operation. */
				 * call. If not implemented, Tcl will fall
				 * back on a copy and delete mechanism, for
				 * rename actions initiated in Tcl (not C). */
    Tcl_FSCopyDirectoryProc *copyDirectoryProc;
				/* Called by 'Tcl_FSCopyDirectory()'. If NULL,
				 * for a copy operation at the script level
				 * (not C) Tcl recursively creates directories
				 * and copies files. */
    Tcl_FSLstatProc *lstatProc;	/* Called by 'Tcl_FSLstat()'. If NULL, Tcl
				 * attempts to use 'statProc' instead. */
				/* Function to process a
				 * 'Tcl_FSCopyDirectory()' call. If not
				 * implemented, Tcl will fall back on a
				 * recursive create-dir, file copy mechanism,
				 * for copying actions initiated in Tcl (not
				 * C). */
    Tcl_FSLstatProc *lstatProc;	/* Function to process a 'Tcl_FSLstat()' call.
				 * If not implemented, Tcl will attempt to use
				 * the 'statProc' defined above instead. */
    Tcl_FSLoadFileProc *loadFileProc;
				/* Called by 'Tcl_FSLoadFile()'. If NULL, Tcl
				/* Function to process a 'Tcl_FSLoadFile()'
				 * performs a copy to a temporary file in the
				 * native filesystem and then calls
				 * Tcl_FSLoadFile() on that temporary copy. */
				 * call. If not implemented, Tcl will fall
				 * back on a copy to native-temp followed by a
				 * Tcl_FSLoadFile on that temporary copy. */
    Tcl_FSGetCwdProc *getCwdProc;
				/* Called by 'Tcl_FSGetCwd()'.  Normally NULL.
				 * Usually only called once:  If 'getcwd' is
				 * called before 'chdir' is ever called. */
    Tcl_FSChdirProc *chdirProc;	/* Called by 'Tcl_FSChdir()'.  For a virtual
				 * filesystem, chdirProc just returns zero
				 * (success) if the pathname is a valid
				/* Function to process a 'Tcl_FSGetCwd()'
				 * call. Most filesystems need not implement
				 * this. It will usually only be called once,
				 * if 'getcwd' is called before 'chdir'. May
				 * be NULL. */
    Tcl_FSChdirProc *chdirProc;	/* Function to process a 'Tcl_FSChdir()' call.
				 * If filesystems do not implement this, it
				 * will be emulated by a series of directory
				 * access checks. Otherwise, virtual
				 * filesystems which do implement it need only
				 * respond with a positive return result if
				 * the dirName is a valid directory in their
				 * directory, and some other value otherwise.
				 * For A real filesystem, chdirProc performs
				 * the correct action, e.g.  calls the system
				 * 'chdir' function. If not implemented, then
				 * 'cd' and 'pwd' fail for a pathname in this
				 * filesystem. On success Tcl stores the
				 * filesystem. They need not remember the
				 * result, since that will be automatically
				 * remembered for use by GetCwd. Real
				 * filesystems should carry out the correct
				 * action (i.e. call the correct system
				 * 'chdir' api). If not implemented, then 'cd'
				 * and 'pwd' will fail inside the
				 * filesystem. */
				 * pathname for use by GetCwd.  If NULL, Tcl
				 * performs records the pathname as the new
				 * current directory if it passes a series of
				 * directory access checks. */
} Tcl_Filesystem;

/*
 * The following definitions are used as values for the 'linkAction' flag to
 * Tcl_FSLink, or the linkProc of any filesystem. Any combination of flags can
 * be given. For link creation, the linkProc should create a link which
 * matches any of the types given.
 *
 * TCL_CREATE_SYMBOLIC_LINK -	Create a symbolic or soft link.
 * TCL_CREATE_HARD_LINK -	Create a hard link.
 */

#define TCL_CREATE_SYMBOLIC_LINK	0x01
#define TCL_CREATE_HARD_LINK		0x02

/*
 *----------------------------------------------------------------------------
 * The following structure represents the Notifier functions that you can
 * override with the Tcl_SetNotifier call.
 */

typedef struct Tcl_NotifierProcs {
    Tcl_SetTimerProc *setTimerProc;
    Tcl_WaitForEventProc *waitForEventProc;
    Tcl_CreateFileHandlerProc *createFileHandlerProc;
    Tcl_DeleteFileHandlerProc *deleteFileHandlerProc;
    Tcl_InitNotifierProc *initNotifierProc;
    Tcl_FinalizeNotifierProc *finalizeNotifierProc;
    Tcl_AlertNotifierProc *alertNotifierProc;
    Tcl_ServiceModeHookProc *serviceModeHookProc;
} Tcl_NotifierProcs;


/*
 * The following structure represents a user-defined encoding. It collects
 * together all the functions that are used by the specific encoding.
 */
 *----------------------------------------------------------------------------

typedef struct Tcl_EncodingType {
    CONST char *encodingName;	/* The name of the encoding, e.g. "euc-jp".
				 * This name is the unique key for this
				 * encoding type. */
    Tcl_EncodingConvertProc *toUtfProc;
				/* Function to convert from external encoding
				 * into UTF-8. */
    Tcl_EncodingConvertProc *fromUtfProc;
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_EncodingFreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    ClientData clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    int nullSize;		/* Number of zero bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. Must be 1 or 2. */
} Tcl_EncodingType;

/*
 * The following definitions are used as values for the conversion control
 * flags argument when converting text from one character set to another:
 *
 * TCL_ENCODING_START -		Signifies that the source buffer is the first
 *				block in a (potentially multi-block) input
 *				stream. Tells the conversion function to reset
 *				to an initial state and perform any
 *				initialization that needs to occur before the
 *				first byte is converted. If the source buffer
 *				contains the entire input stream to be
 *				converted, this flag should be set.
 * TCL_ENCODING_END -		Signifies that the source buffer is the last
 *				block in a (potentially multi-block) input
 *				stream. Tells the conversion routine to
 *				perform any finalization that needs to occur
 *				after the last byte is converted and then to
 *				reset to an initial state. If the source
 *				buffer contains the entire input stream to be
 *				converted, this flag should be set.
 * TCL_ENCODING_STOPONERROR -	If set, then the converter will return
 *				immediately upon encountering an invalid byte
 *				sequence or a source character that has no
 *				mapping in the target encoding. If clear, then
 *				the converter will skip the problem,
 *				substituting one or more "close" characters in
 *				the destination buffer and then continue to
 *				convert the source.
 */

#define TCL_ENCODING_START		0x01
#define TCL_ENCODING_END		0x02
#define TCL_ENCODING_STOPONERROR	0x04

/*
 * The following data structures and declarations are for the new Tcl parser.
 */
 *

/*
 * For each word of a command, and for each piece of a word such as a variable
 * reference, one of the following structures is created to describe the
 * token.
 */

typedef struct Tcl_Token {
    int type;			/* Type of token, such as TCL_TOKEN_WORD; see
				 * below for valid types. */
    const char *start;		/* First character in token. */
    size_t size;			/* Number of bytes in token. */
    size_t numComponents;		/* If this token is composed of other tokens,
    CONST char *start;		/* First character in token. */
    int size;			/* Number of bytes in token. */
    int numComponents;		/* If this token is composed of other tokens,
				 * this field tells how many of them there are
				 * (including components of components, etc.).
				 * The component tokens immediately follow
				 * this one. */
} Tcl_Token;

/*
1747
1748
1749
1750
1751
1752
1753
1754

1755
1756

1757
1758
1759
1760

1761
1762
1763
1764
1765
1766
1767
2055
2056
2057
2058
2059
2060
2061

2062
2063

2064
2065
2066
2067

2068
2069
2070
2071
2072
2073
2074
2075







-
+

-
+



-
+







 * A structure of the following type is filled in by Tcl_ParseCommand. It
 * describes a single command parsed from an input string.
 */

#define NUM_STATIC_TOKENS 20

typedef struct Tcl_Parse {
    const char *commentStart;	/* Pointer to # that begins the first of one
    CONST char *commentStart;	/* Pointer to # that begins the first of one
				 * or more comments preceding the command. */
    size_t commentSize;		/* Number of bytes in comments (up through
    int commentSize;		/* Number of bytes in comments (up through
				 * newline character that terminates the last
				 * comment). If there were no comments, this
				 * field is 0. */
    const char *commandStart;	/* First character in first word of
    CONST char *commandStart;	/* First character in first word of
				 * command. */
    int commandSize;		/* Number of bytes in command, including first
				 * character of first word, up through the
				 * terminating newline, close bracket, or
				 * semicolon. */
    int numWords;		/* Total number of words in command. May be
				 * 0. */
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
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
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







-
+

-
+



-
+
















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







				 * above. */

    /*
     * The fields below are intended only for the private use of the parser.
     * They should not be used by functions that invoke Tcl_ParseCommand.
     */

    const char *string;		/* The original command string passed to
    CONST char *string;		/* The original command string passed to
				 * Tcl_ParseCommand. */
    const char *end;		/* Points to the character just after the last
    CONST char *end;		/* Points to the character just after the last
				 * one in the command string. */
    Tcl_Interp *interp;		/* Interpreter to use for error reporting, or
				 * NULL. */
    const char *term;		/* Points to character in string that
    CONST char *term;		/* Points to character in string that
				 * terminated most recent token. Filled in by
				 * ParseTokens. If an error occurs, points to
				 * beginning of region where the error
				 * occurred (e.g. the open brace if the close
				 * brace is missing). */
    int incomplete;		/* This field is set to 1 by Tcl_ParseCommand
				 * if the command appears to be incomplete.
				 * This information is used by
				 * Tcl_CommandComplete. */
    Tcl_Token staticTokens[NUM_STATIC_TOKENS];
				/* Initial space for tokens for command. This
				 * space should be large enough to accommodate
				 * most commands; dynamic space is allocated
				 * for very large commands that don't fit
				 * here. */
} Tcl_Parse;

/*
 *----------------------------------------------------------------------------
 * The following structure represents a user-defined encoding. It collects
 * together all the functions that are used by the specific encoding.
 */

typedef struct Tcl_EncodingType {
    const char *encodingName;	/* The name of the encoding, e.g. "euc-jp".
				 * This name is the unique key for this
				 * encoding type. */
    Tcl_EncodingConvertProc *toUtfProc;
				/* Function to convert from external encoding
				 * into UTF-8. */
    Tcl_EncodingConvertProc *fromUtfProc;
				/* Function to convert from UTF-8 into
				 * external encoding. */
    Tcl_FreeProc *freeProc;
				/* If non-NULL, function to call when this
				 * encoding is deleted. */
    void *clientData;	/* Arbitrary value associated with encoding
				 * type. Passed to conversion functions. */
    int nullSize;		/* Number of zero bytes that signify
				 * end-of-string in this encoding. This number
				 * is used to determine the source string
				 * length when the srcLen argument is
				 * negative. Must be 1 or 2. */
} Tcl_EncodingType;

/*
 * The following definitions are used as values for the conversion control
 * flags argument when converting text from one character set to another:
 *
 * TCL_ENCODING_START -		Signifies that the source buffer is the first
 *				block in a (potentially multi-block) input
 *				stream. Tells the conversion function to reset
 *				to an initial state and perform any
 *				initialization that needs to occur before the
 *				first byte is converted. If the source buffer
 *				contains the entire input stream to be
 *				converted, this flag should be set.
 * TCL_ENCODING_END -		Signifies that the source buffer is the last
 *				block in a (potentially multi-block) input
 *				stream. Tells the conversion routine to
 *				perform any finalization that needs to occur
 *				after the last byte is converted and then to
 *				reset to an initial state. If the source
 *				buffer contains the entire input stream to be
 *				converted, this flag should be set.
 * TCL_ENCODING_STOPONERROR -	If set, the converter returns immediately upon
 *				encountering an invalid byte sequence or a
 *				source character that has no mapping in the
 *				target encoding. If clear, the converter
 *				substitues the problematic character(s) with
 *				one or more "close" characters in the
 *				destination buffer and then continues to
 *				convert the source.
 * TCL_ENCODING_NO_TERMINATE - 	If set, Tcl_ExternalToUtf does not append a
 *				terminating NUL byte.  Since it does not need
 *				an extra byte for a terminating NUL, it fills
 *				all dstLen bytes with encoded UTF-8 content if
 *				needed.  If clear, a byte is reserved in the
 *				dst space for NUL termination, and a
 *				terminating NUL is appended.
 * TCL_ENCODING_CHAR_LIMIT -	If set and dstCharsPtr is not NULL, then
 *				Tcl_ExternalToUtf takes the initial value of
 *				*dstCharsPtr as a limit of the maximum number
 *				of chars to produce in the encoded UTF-8
 *				content.  Otherwise, the number of chars
 *				produced is controlled only by other limiting
 *				factors.
 */

#define TCL_ENCODING_START		0x01
#define TCL_ENCODING_END		0x02
#define TCL_ENCODING_STOPONERROR	0x04
#define TCL_ENCODING_NO_TERMINATE	0x08
#define TCL_ENCODING_CHAR_LIMIT		0x10

/*
 * The following definitions are the error codes returned by the conversion
 * routines:
 *
 * TCL_OK -			All characters were converted.
 * TCL_CONVERT_NOSPACE -	The output buffer would not have been large
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
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







-
-
-
-
+
+
+
+



-
-
-
-
-
+
+
+
+
+
+



-
+









-
+
-
-
+
+
+
+

-
+



-
+

-





-
+

-
+




-












-
-
+
+
+

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

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

-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


+
+
+


-
+








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

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

-
+
+
+
+
+






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

-
+

-








-
+
-


-
-
-
-
-



-
-
-
+
+
+


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

-
+







+
+
+
+
+










-


-


-



-






-



-
+



-
















-
+






+
+
+



+
+
+












-




-
+

-
+









+

-
+
+

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







 *				was specified.
 * TCL_CONVERT_UNKNOWN -	The source string contained a character that
 *				could not be represented in the target
 *				encoding. This error is reported only if
 *				TCL_ENCODING_STOPONERROR was specified.
 */

#define TCL_CONVERT_MULTIBYTE	(-1)
#define TCL_CONVERT_SYNTAX	(-2)
#define TCL_CONVERT_UNKNOWN	(-3)
#define TCL_CONVERT_NOSPACE	(-4)
#define TCL_CONVERT_MULTIBYTE	-1
#define TCL_CONVERT_SYNTAX	-2
#define TCL_CONVERT_UNKNOWN	-3
#define TCL_CONVERT_NOSPACE	-4

/*
 * The maximum number of bytes that are necessary to represent a single
 * Unicode character in UTF-8. The valid values are 3 and 4
 * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
 * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
 * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
 * mode is the default and recommended mode.
 * Unicode character in UTF-8. The valid values should be 3 or 6 (or perhaps 1
 * if we want to support a non-unicode enabled core). If 3, then Tcl_UniChar
 * must be 2-bytes in size (UCS-2) (the default). If 6, then Tcl_UniChar must
 * be 4-bytes in size (UCS-4). At this time UCS-2 mode is the default and
 * recommended mode. UCS-4 is experimental and not recommended. It works for
 * the core, but most extensions expect UCS-2.
 */

#ifndef TCL_UTF_MAX
#define TCL_UTF_MAX		4
#define TCL_UTF_MAX		3
#endif

/*
 * This represents a Unicode character. Any changes to this should also be
 * reflected in regcustom.h.
 */

#if TCL_UTF_MAX > 3
    /*
     * int isn't 100% accurate as it should be a strict 4-byte value
     * unsigned int isn't 100% accurate as it should be a strict 4-byte value.
     * (perhaps wchar_t). ILP64/SILP64 systems may have troubles. The
     * size of this value must be reflected correctly in regcustom.h.
     * The size of this value must be reflected correctly in regcustom.h.
     * XXX: Tcl is currently UCS-2 and planning UTF-16 for the Unicode
     * XXX: string rep that Tcl_UniChar represents.  Changing the size
     * XXX: of Tcl_UniChar is /not/ supported.
     */
typedef int Tcl_UniChar;
typedef unsigned int Tcl_UniChar;
#else
typedef unsigned short Tcl_UniChar;
#endif


/*
 *----------------------------------------------------------------------------
 * TIP #59: The following structure is used in calls 'Tcl_RegisterConfig' to
 * provide the system with the embedded configuration data.
 */

typedef struct Tcl_Config {
    const char *key;		/* Configuration key to register. ASCII
    CONST char *key;		/* Configuration key to register. ASCII
				 * encoded, thus UTF-8. */
    const char *value;		/* The value associated with the key. System
    CONST char *value;		/* The value associated with the key. System
				 * encoding. */
} Tcl_Config;

/*
 *----------------------------------------------------------------------------
 * Flags for TIP#143 limits, detailing which limits are active in an
 * interpreter. Used for Tcl_{Add,Remove}LimitHandler type argument.
 */

#define TCL_LIMIT_COMMANDS	0x01
#define TCL_LIMIT_TIME		0x02

/*
 * Structure containing information about a limit handler to be called when a
 * command- or time-limit is exceeded by an interpreter.
 */

typedef void (Tcl_LimitHandlerProc) (void *clientData, Tcl_Interp *interp);
typedef void (Tcl_LimitHandlerDeleteProc) (void *clientData);
typedef void (Tcl_LimitHandlerProc) _ANSI_ARGS_((ClientData clientData,
	Tcl_Interp *interp));
typedef void (Tcl_LimitHandlerDeleteProc) _ANSI_ARGS_((ClientData clientData));

#if 0
/*
 *----------------------------------------------------------------------------
 * We would like to provide an anonymous structure "mp_int" here, which is
 * compatible with libtommath's "mp_int", but without duplicating anything
 * from <tommath.h> or including <tommath.h> here. But the libtommath project
 * didn't honor our request. See: <https://github.com/libtom/libtommath/pull/473>
 *
 * That's why this part is commented out, and we are using (void *) in
 * various API's in stead of the more correct (mp_int *).
 */

typedef struct mp_int mp_int;
#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
typedef struct mp_int mp_int;
#endif

#endif

/*
 *----------------------------------------------------------------------------
 * Definitions needed for Tcl_ParseArgvObj routines.
 * Based on tkArgv.c.
 * Modifications from the original are copyright (c) Sam Bromley 2006
 */

typedef struct {
typedef unsigned int mp_digit;
    int type;			/* Indicates the option type; see below. */
    const char *keyStr;		/* The key string that flags the option in the
				 * argv array. */
    void *srcPtr;		/* Value to be used in setting dst; usage
				 * depends on type.*/
    void *dstPtr;		/* Address of value to be modified; usage
				 * depends on type.*/
    const char *helpStr;	/* Documentation message describing this
				 * option. */
    void *clientData;	/* Word to pass to function callbacks. */
} Tcl_ArgvInfo;

#define MP_DIGIT_DECLARED
/*
 * Legal values for the type field of a Tcl_ArgInfo: see the user
 * documentation for details.
 */

#define TCL_ARGV_CONSTANT	15
#define TCL_ARGV_INT		16
#define TCL_ARGV_STRING		17
#define TCL_ARGV_REST		18
#define TCL_ARGV_FLOAT		19
#define TCL_ARGV_FUNC		20
#define TCL_ARGV_GENFUNC	21
#define TCL_ARGV_HELP		22
#define TCL_ARGV_END		23

/*
 * Types of callback functions for the TCL_ARGV_FUNC and TCL_ARGV_GENFUNC
 * argument types:
 */

typedef int (Tcl_ArgvFuncProc)(void *clientData, Tcl_Obj *objPtr,
	void *dstPtr);
typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
	int objc, Tcl_Obj *const *objv, void *dstPtr);

/*
 * Shorthand for commonly used argTable entries.
 */

#define TCL_ARGV_AUTO_HELP \
    {TCL_ARGV_HELP,	"-help",	NULL,	NULL, \
	    "Print summary of command-line options and abort", NULL}
#define TCL_ARGV_AUTO_REST \
    {TCL_ARGV_REST,	"--",		NULL,	NULL, \
	    "Marks the end of the options", NULL}
#define TCL_ARGV_TABLE_END \
    {TCL_ARGV_END, NULL, NULL, NULL, NULL, NULL}

/*
 *----------------------------------------------------------------------------
 * Definitions needed for Tcl_Zlib routines. [TIP #234]
 *
 * Constants for the format flags describing what sort of data format is
 * desired/expected for the Tcl_ZlibDeflate, Tcl_ZlibInflate and
 * Tcl_ZlibStreamInit functions.
 */

#define TCL_ZLIB_FORMAT_RAW	1
#define TCL_ZLIB_FORMAT_ZLIB	2
#define TCL_ZLIB_FORMAT_GZIP	4
#define TCL_ZLIB_FORMAT_AUTO	8

/*
 * Constants that describe whether the stream is to operate in compressing or
 * decompressing mode.
 */

#define TCL_ZLIB_STREAM_DEFLATE	16
#define TCL_ZLIB_STREAM_INFLATE	32

/*
 * Constants giving compression levels. Use of TCL_ZLIB_COMPRESS_DEFAULT is
 * recommended.
 */

#define TCL_ZLIB_COMPRESS_NONE	0
#define TCL_ZLIB_COMPRESS_FAST	1
#define TCL_ZLIB_COMPRESS_BEST	9
#define TCL_ZLIB_COMPRESS_DEFAULT (-1)

/*
 * Constants for types of flushing, used with Tcl_ZlibFlush.
 */

#define TCL_ZLIB_NO_FLUSH	0
#define TCL_ZLIB_FLUSH		2
#define TCL_ZLIB_FULLFLUSH	3
#define TCL_ZLIB_FINALIZE	4

/*
 *----------------------------------------------------------------------------
 * Definitions needed for the Tcl_LoadFile function. [TIP #416]
 */

#define TCL_LOAD_GLOBAL 1
#define TCL_LOAD_LAZY 2

/*
 *----------------------------------------------------------------------------
 * Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
 */
#define TCL_TCPSERVER_REUSEADDR (1<<0)
#define TCL_TCPSERVER_REUSEPORT (1<<1)

/*
 * Constants for special size_t-typed values, see TIP #494
 */

#define TCL_IO_FAILURE	((size_t)-1)
#define TCL_AUTO_LENGTH	((size_t)-1)
#define TCL_INDEX_NONE  ((size_t)-1)

/*
 *----------------------------------------------------------------------------
 * Single public declaration for NRE.
 */

typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
				int result);

/*
 *----------------------------------------------------------------------------
 * The following constant is used to test for older versions of Tcl in the
 * stubs tables.
 *
 * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different
 * value since the stubs tables don't match.
 */

#define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *))
#define TCL_STUB_MAGIC		((int) 0xFCA3BACF)

/*
 * The following function is required to be defined in all stubs aware
 * extensions. The function is actually implemented in the stub library, not
 * the main Tcl library, although there is a trivial implementation in the
 * main library in case an extension is statically linked into an application.
 */

const char *		Tcl_InitStubs(Tcl_Interp *interp, const char *version,
			    int exact, int magic);
const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
			    const char *version, int epoch, int revision);
EXTERN CONST char *	Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *version, int exact));
EXTERN CONST char *	TclTomMathInitializeStubs _ANSI_ARGS_((
			    Tcl_Interp *interp, CONST char *version,
			    int epoch, int revision));
#if defined(_WIN32)
    TCL_NORETURN1 void Tcl_ConsolePanic(const char *format, ...);
#else
#   define Tcl_ConsolePanic NULL
#endif

#ifdef USE_TCL_STUBS
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
#ifndef USE_TCL_STUBS

/*
 * When not using stubs, make it a macro.
 */

	(Tcl_InitStubs)(interp, version, \
	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
#else
#   define Tcl_InitStubs(interp, version, exact) \
#define Tcl_InitStubs(interp, version, exact) \
	(Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \
	    1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
	    TCL_STUB_MAGIC)
#endif
#else
#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
#   define Tcl_InitStubs(interp, version, exact) \
	Tcl_PkgInitStubsCheck(interp, version, \
		(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
    Tcl_PkgInitStubsCheck(interp, version, exact)

#else
#   define Tcl_InitStubs(interp, version, exact) \
	Tcl_PkgInitStubsCheck(interp, TCL_PATCH_LEVEL, \
		1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
#endif
#endif

    /*
     * TODO - tommath stubs export goes here!
     */


/*
 * Public functions that are not accessible via the stubs table.
 * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
 */

#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
	    ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)()))
EXTERN TCL_NORETURN void Tcl_MainEx(int argc, char **argv,
			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
			    const char *version, int exact);
EXTERN void		Tcl_Main _ANSI_ARGS_((int argc, char **argv,
			    Tcl_AppInitProc *appInitProc));
EXTERN CONST char *	Tcl_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
			    CONST char *version, int exact));
EXTERN void		Tcl_InitSubsystems(void);
EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
EXTERN void		Tcl_FindExecutable(const char *argv0);
EXTERN void		Tcl_SetPanicProc(
			    TCL_NORETURN1 Tcl_PanicProc *panicProc);
EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
			    const char *pkgName,
			    Tcl_PackageInitProc *initProc,
			    Tcl_PackageInitProc *safeInitProc);
EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
#ifdef _WIN32
EXTERN int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
#else
EXTERN int		TclZipfs_AppHook(int *argc, char ***argv);
#endif


/*
 *----------------------------------------------------------------------------
 * Include the public function declarations that are accessible via the stubs
 * table.
 */

#include "tclDecls.h"

/*
 * Include platform specific public function declarations that are accessible
 * via the stubs table. Make all TclOO symbols MODULE_SCOPE (which only
 * via the stubs table.
 * has effect on building it as a shared library). See ticket [3010352].
 */

#if defined(BUILD_tcl)
#   undef TCLAPI
#   define TCLAPI MODULE_SCOPE
#endif

#include "tclPlatDecls.h"

/*
 *----------------------------------------------------------------------------
 * The following declarations map ckalloc and ckfree to Tcl_Alloc and
 * Tcl_Free for use in Tcl-8.x-compatible extensions.
 * The following declarations either map ckalloc and ckfree to malloc and
 * free, or they map them to functions with all sorts of debugging hooks
 * defined in tclCkalloc.c.
 */

#ifdef TCL_MEM_DEBUG
#ifndef BUILD_tcl
#   define ckalloc Tcl_Alloc

#   define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
#   define attemptckalloc Tcl_AttemptAlloc
#   ifdef _MSC_VER
	/* Silence invalid C4090 warnings */
#	define ckfree(a) Tcl_Free((char *)(a))
#	define ckrealloc(a,b) Tcl_Realloc((char *)(a),(b))
#	define attemptckrealloc(a,b) Tcl_AttemptRealloc((char *)(a),(b))
#   define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
#   define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
#   define attemptckalloc(x) Tcl_AttemptDbCkalloc(x, __FILE__, __LINE__)
#   else
#	define ckfree Tcl_Free
#	define ckrealloc Tcl_Realloc
#	define attemptckrealloc Tcl_AttemptRealloc
#   define attemptckrealloc(x,y) Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__)
#   endif
#endif

#ifndef TCL_MEM_DEBUG
#else /* !TCL_MEM_DEBUG */

/*
 * If we are not using the debugging allocator, we should call the Tcl_Alloc,
 * et al. routines in order to guarantee that every module is using the same
 * memory allocator both inside and outside of the Tcl library.
 */

#   define ckalloc(x) Tcl_Alloc(x)
#   define ckfree(x) Tcl_Free(x)
#   define ckrealloc(x,y) Tcl_Realloc(x,y)
#   define attemptckalloc(x) Tcl_AttemptAlloc(x)
#   define attemptckrealloc(x,y) Tcl_AttemptRealloc(x,y)
#   undef  Tcl_InitMemory
#   define Tcl_InitMemory(x)
#   undef  Tcl_DumpActiveMemory
#   define Tcl_DumpActiveMemory(x)
#   undef  Tcl_ValidateAllMemory
#   define Tcl_ValidateAllMemory(x,y)

#endif /* !TCL_MEM_DEBUG */

#ifdef TCL_MEM_DEBUG
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
#else
#   undef Tcl_IncrRefCount
#   define Tcl_IncrRefCount(objPtr) \
	++(objPtr)->refCount
    /*
     * Use do/while0 idiom for optimum correctness without compiler warnings.
     * http://c2.com/cgi/wiki?TrivialDoWhileLoop
     */
#   undef Tcl_DecrRefCount
#   define Tcl_DecrRefCount(objPtr) \
	do { \
	    Tcl_Obj *_objPtr = (objPtr); \
	    if (_objPtr->refCount-- <= 1) { \
	    if (--(_objPtr)->refCount <= 0) { \
		TclFreeObj(_objPtr); \
	    } \
	} while(0)
#   undef Tcl_IsShared
#   define Tcl_IsShared(objPtr) \
	((objPtr)->refCount > 1)
#endif

/*
 * Macros and definitions that help to debug the use of Tcl objects. When
 * TCL_MEM_DEBUG is defined, the Tcl_New declarations are overridden to call
 * debugging versions of the object creation functions.
 */

#ifdef TCL_MEM_DEBUG
#  undef  Tcl_NewBignumObj
#  define Tcl_NewBignumObj(val) \
     Tcl_DbNewBignumObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewBooleanObj
#  define Tcl_NewBooleanObj(val) \
     Tcl_DbNewWideIntObj((val)!=0, __FILE__, __LINE__)
     Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewByteArrayObj
#  define Tcl_NewByteArrayObj(bytes, len) \
     Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
#  undef  Tcl_NewDoubleObj
#  define Tcl_NewDoubleObj(val) \
     Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewIntObj
#  define Tcl_NewIntObj(val) \
     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewListObj
#  define Tcl_NewListObj(objc, objv) \
     Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
#  undef  Tcl_NewLongObj
#  define Tcl_NewLongObj(val) \
     Tcl_DbNewLongObj(val, __FILE__, __LINE__)
#  undef  Tcl_NewObj
#  define Tcl_NewObj() \
     Tcl_DbNewObj(__FILE__, __LINE__)
#  undef  Tcl_NewStringObj
#  define Tcl_NewStringObj(bytes, len) \
     Tcl_DbNewStringObj(bytes, len, __FILE__, __LINE__)
#  undef  Tcl_NewWideIntObj
#  define Tcl_NewWideIntObj(val) \
     Tcl_DbNewWideIntObj(val, __FILE__, __LINE__)
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------------
 * Macros for clients to use to access fields of hash entries:
 */

#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (void *) (value))
#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
#define Tcl_GetHashKey(tablePtr, h) \
	((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
	((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
		    (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \
		   ? (h)->key.oneWordValue \
		   : (h)->key.string))

/*
 * Macros to use for clients to use to invoke find and create functions for
 * hash tables:
 */

#undef  Tcl_FindHashEntry
#define Tcl_FindHashEntry(tablePtr, key) \
	(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
	(*((tablePtr)->findProc))(tablePtr, key)
#undef  Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
	(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)
	(*((tablePtr)->createProc))(tablePtr, key, newPtr)

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

#ifndef TCL_THREADS
#undef  Tcl_MutexLock
#define Tcl_MutexLock(mutexPtr)
#undef  Tcl_MutexUnlock
#define Tcl_MutexUnlock(mutexPtr)
#undef  Tcl_MutexFinalize
#define Tcl_MutexFinalize(mutexPtr)
#undef  Tcl_ConditionNotify
#define Tcl_ConditionNotify(condPtr)
#undef  Tcl_ConditionWait
#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#undef  Tcl_ConditionFinalize
#define Tcl_ConditionFinalize(condPtr)
#endif /* TCL_THREADS */

#ifndef TCL_NO_DEPRECATED
    /*
     * These function have been renamed. The old names are deprecated, but we
     * define these macros for backwards compatibilty.
     */

#   define Tcl_Ckalloc		Tcl_Alloc
#   define Tcl_Ckfree		Tcl_Free
#   define Tcl_Ckrealloc	Tcl_Realloc
#   define Tcl_Return		Tcl_SetResult
#   define Tcl_TildeSubst	Tcl_TranslateFileName
#if !defined(__APPLE__) /* On OSX, there is a conflict with "mach/mach.h" */
#   define panic		Tcl_Panic
#endif
#   define panicVA		Tcl_PanicVA
#endif

/*
 * Convenience declaration of Tcl_AppInit for backwards compatibility. This
 * function is not *implemented* by the tcl library, so the storage class is
 * neither DLLEXPORT nor DLLIMPORT.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS

EXTERN int		Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* RC_INVOKED */

/*
 * end block for C++
 */

Changes to generic/tclAlloc.c.

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
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







-
+

-
+







-
+








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

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

#if defined(USE_TCLALLOC) && USE_TCLALLOC
#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(__MSVCRT__) || defined(__BORLANDC__)
typedef size_t caddr_t;
typedef unsigned long caddr_t;
#endif

/*
 * The overhead on a block is at least 8 bytes. When free, this space contains
 * a pointer to the next free block, and the bottom two bits must be zero.
 * When in use, the first byte is set to MAGIC, and the second byte is the
 * size index. The remaining bytes are for alignment. If range checking is
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
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







-
+











-
+



-
+







    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 */
	size_t size;		/* actual block size */
	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 MAGIC		0xef	/* magic # on accounting info */
#define RMAGIC		0x5555	/* magic # on range info */

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

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

/*
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
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







-
+











-
+
+














-
+







/*
 * The allocator is protected by a special mutex that must be explicitly
 * initialized. Futhermore, because Tcl_Alloc may be used before anything else
 * in Tcl, we make this module self-initializing after all with the allocInit
 * variable.
 */

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

#ifdef MSTATS

/*
 * numMallocs[i] is the difference between the number of mallocs and frees for
 * a given block size.
 */

static	size_t numMallocs[NBUCKETS+1];
static	unsigned int numMallocs[NBUCKETS+1];
#include <stdio.h>
#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

/*
 * Prototypes for functions used only in this file.
 */

static void		MoreCore(size_t bucket);
static void 		MoreCore(int bucket);

/*
 *-------------------------------------------------------------------------
 *
 * TclInitAlloc --
 *
 *	Initialize the memory system.
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182







-
+







 */

void
TclInitAlloc(void)
{
    if (!allocInit) {
	allocInit = 1;
#if TCL_THREADS
#ifdef TCL_THREADS
	allocMutexPtr = Tcl_GetAllocMutex();
#endif
    }
}

/*
 *-------------------------------------------------------------------------
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
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







-
+

-
+

-
-
-
+
+
+


















-
-
+
+












-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
char *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    union overhead *overPtr;
    size_t bucket;
    size_t amount;
    register union overhead *overPtr;
    register long bucket;
    register unsigned amount;
    struct block *bigBlockPtr = NULL;

    if (!allocInit) {
	/*
	 * We have to make the "self initializing" because Tcl_Alloc may be
	 * used before any other part of Tcl. E.g., see main() for tclsh!
	 */

	TclInitAlloc();
    }
    Tcl_MutexLock(allocMutexPtr);

    /*
     * First the simple case: we simple allocate big blocks directly.
     */

    if (numBytes >= MAXMALLOC - OVERHEAD) {
	if (numBytes <= UINT_MAX - OVERHEAD -sizeof(struct block)) {
	    bigBlockPtr = TclpSysAlloc(
		    sizeof(struct block) + OVERHEAD + numBytes);
	    bigBlockPtr = (struct block *) TclpSysAlloc((unsigned)
		    (sizeof(struct block) + OVERHEAD + numBytes), 0);
	}
	if (bigBlockPtr == NULL) {
	    Tcl_MutexUnlock(allocMutexPtr);
	    return NULL;
	}
	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
	bigBlocks.nextPtr = bigBlockPtr;
	bigBlockPtr->prevPtr = &bigBlocks;
	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;

	overPtr = (union overhead *) (bigBlockPtr + 1);
	overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
	overPtr->bucketIndex = 0xFF;
	overPtr->bucketIndex = 0xff;
#ifdef MSTATS
	numMallocs[NBUCKETS]++;
#endif

#ifndef NDEBUG
	/*
	 * Record allocated size of block and bound space with magic numbers.
341
342
343
344
345
346
347
348

349
350
351
352
353
354
355
342
343
344
345
346
347
348

349
350
351
352
353
354
355
356







-
+








    /*
     * Remove from linked list
     */

    nextf[bucket] = overPtr->next;
    overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
    overPtr->bucketIndex = UCHAR(bucket);
    overPtr->bucketIndex = (unsigned char) bucket;

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

#ifndef NDEBUG
    /*
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
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







-
+

-
-
-
-
+
+
+
+







-
+






+
-
+







 *	Attempts to get more memory from the system.
 *
 *----------------------------------------------------------------------
 */

static void
MoreCore(
    size_t bucket)	/* What bucket to allocate to. */
    int bucket)			/* What bucket to allocat to. */
{
    union overhead *overPtr;
    size_t size;	/* size of desired block */
    size_t amount;		/* amount to allocate */
    size_t numBlocks;		/* how many blocks we get */
    register union overhead *overPtr;
    register long size;		/* size of desired block */
    long amount;		/* amount to allocate */
    int numBlocks;		/* how many blocks we get */
    struct block *blockPtr;

    /*
     * sbrk_size <= 0 only for big, FLUFFY, requests (about 2^30 bytes on a
     * VAX, I think) or for a negative arg.
     */

    size = ((size_t)1) << (bucket + 3);
    size = 1 << (bucket + 3);
    ASSERT(size > 0);

    amount = MAXMALLOC;
    numBlocks = amount / size;
    ASSERT(numBlocks*size == amount);

    blockPtr = (struct block *) TclpSysAlloc((unsigned)
    blockPtr = TclpSysAlloc(sizeof(struct block) + amount);
	    (sizeof(struct block) + amount), 1);
    /* no more room! */
    if (blockPtr == NULL) {
	return;
    }
    blockPtr->nextPtr = blockList;
    blockList = blockPtr;

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
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







-
+

-
-
+
+







-
+











-
+







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

void
TclpFree(
    void *oldPtr)		/* Pointer to memory to free. */
    char *oldPtr)		/* Pointer to memory to free. */
{
    size_t size;
    union overhead *overPtr;
    register long size;
    register union overhead *overPtr;
    struct block *bigBlockPtr;

    if (oldPtr == NULL) {
	return;
    }

    Tcl_MutexLock(allocMutexPtr);
    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));

    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
    ASSERT(overPtr->overMagic1 == MAGIC);
    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
	Tcl_MutexUnlock(allocMutexPtr);
	return;
    }

    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
    size = overPtr->bucketIndex;
    if (size == 0xFF) {
    if (size == 0xff) {
#ifdef MSTATS
	numMallocs[NBUCKETS]--;
#endif

	bigBlockPtr = (struct block *) overPtr - 1;
	bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
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
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







-
+

-
-
+
+





-
+







-
+
















-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
char *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
    char *oldPtr,		/* Pointer to alloced block. */
    unsigned int numBytes)	/* New size of memory. */
{
    int i;
    union overhead *overPtr;
    struct block *bigBlockPtr;
    int expensive;
    size_t maxSize;
    unsigned long maxSize;

    if (oldPtr == NULL) {
	return TclpAlloc(numBytes);
    }

    Tcl_MutexLock(allocMutexPtr);

    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof(union overhead));
    overPtr = (union overhead *)((caddr_t)oldPtr - sizeof (union overhead));

    ASSERT(overPtr->overMagic0 == MAGIC);	/* make sure it was in use */
    ASSERT(overPtr->overMagic1 == MAGIC);
    if (overPtr->overMagic0 != MAGIC || overPtr->overMagic1 != MAGIC) {
	Tcl_MutexUnlock(allocMutexPtr);
	return NULL;
    }

    RANGE_ASSERT(overPtr->rangeCheckMagic == RMAGIC);
    RANGE_ASSERT(BLOCK_END(overPtr) == RMAGIC);
    i = overPtr->bucketIndex;

    /*
     * If the block isn't in a bin, just realloc it.
     */

    if (i == 0xFF) {
    if (i == 0xff) {
	struct block *prevPtr, *nextPtr;
	bigBlockPtr = (struct block *) overPtr - 1;
	prevPtr = bigBlockPtr->prevPtr;
	nextPtr = bigBlockPtr->nextPtr;
	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr,
		sizeof(struct block) + OVERHEAD + numBytes);
	if (bigBlockPtr == NULL) {
576
577
578
579
580
581
582
583

584
585
586
587
588
589
590
578
579
580
581
582
583
584

585
586
587
588
589
590
591
592







-
+







	 */

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

	Tcl_MutexUnlock(allocMutexPtr);
	return (void *)(overPtr+1);
	return (char *)(overPtr+1);
    }
    maxSize = 1 << (i+3);
    expensive = 0;
    if (numBytes+OVERHEAD > maxSize) {
	expensive = 1;
    } else if (i>0 && numBytes+OVERHEAD < maxSize/2) {
	expensive = 1;
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615







-
+







	if (newPtr == NULL) {
	    return NULL;
	}
	maxSize -= OVERHEAD;
	if (maxSize < numBytes) {
	    numBytes = maxSize;
	}
	memcpy(newPtr, oldPtr, numBytes);
	memcpy(newPtr, oldPtr, (size_t) numBytes);
	TclpFree(oldPtr);
	return newPtr;
    }

    /*
     * Ok, we don't have to copy, it fits as-is
     */
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
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







-
-
-
+
+
+






-
+

-
+




-
+



-
-
-
+
+
+







 */

#ifdef MSTATS
void
mstats(
    char *s)			/* Where to write info. */
{
    unsigned int i, j;
    union overhead *overPtr;
    size_t totalFree = 0, totalUsed = 0;
    register int i, j;
    register union overhead *overPtr;
    int totalFree = 0, totalUsed = 0;

    Tcl_MutexLock(allocMutexPtr);

    fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
    for (i = 0; i < NBUCKETS; i++) {
	for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
	    fprintf(stderr, " %u", j);
	    fprintf(stderr, " %d", j);
	}
	totalFree += ((size_t)j) * (1 << (i + 3));
	totalFree += j * (1 << (i + 3));
    }

    fprintf(stderr, "\nused:\t");
    for (i = 0; i < NBUCKETS; i++) {
	fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
	fprintf(stderr, " %d", numMallocs[i]);
	totalUsed += numMallocs[i] * (1 << (i + 3));
    }

    fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
	totalUsed, totalFree);
    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
    fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
	    totalUsed, totalFree);
    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
	    MAXMALLOC, numMallocs[NBUCKETS]);

    Tcl_MutexUnlock(allocMutexPtr);
}
#endif

#else	/* !USE_TCLALLOC */
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
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







-
-
+

-
+

-
+


















-


-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef TclpAlloc
void *
char *
TclpAlloc(
    size_t numBytes)	/* Number of bytes to allocate. */
    unsigned int numBytes)	/* Number of bytes to allocate. */
{
    return malloc(numBytes);
    return (char*) malloc(numBytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFree --
 *
 *	Free memory.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef TclpFree
void
TclpFree(
    void *oldPtr)		/* Pointer to memory to free. */
    char *oldPtr)		/* Pointer to memory to free. */
{
    free(oldPtr);
    return;
}

/*
 *----------------------------------------------------------------------
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
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







-
+

-
-
+
+

-
+












 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
char *
TclpRealloc(
    void *oldPtr,		/* Pointer to alloced block. */
    size_t numBytes)	/* New size of memory. */
    char *oldPtr,		/* Pointer to alloced block. */
    unsigned int numBytes)	/* New size of memory. */
{
    return realloc(oldPtr, numBytes);
    return (char*) realloc(oldPtr, numBytes);
}

#endif /* !USE_TCLALLOC */
#endif /* !TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclAssembly.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclAssembly.c --
 *
 *	Assembler for Tcl bytecodes.
 *
 * This file contains the procedures that convert Tcl Assembly Language (TAL)
 * to a sequence of bytecode instructions for the Tcl execution engine.
 *
 * Copyright (c) 2010 by Ozgur Dogan Ugurlu.
 * Copyright (c) 2010 by Kevin B. Kenny.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*-
 *- THINGS TO DO:
 *- More instructions:
 *-   done - alternate exit point (affects stack and exception range checking)
 *-   break and continue - if exception ranges can be sorted out.
 *-   foreach_start4, foreach_step4
 *-   returnImm, returnStk
 *-   expandStart, expandStkTop, invokeExpanded, expandDrop
 *-   dictFirst, dictNext, dictDone
 *-   dictUpdateStart, dictUpdateEnd
 *-   jumpTable testing
 *-   syntax (?)
 *-   returnCodeBranch
 *-   tclooNext, tclooNextClass
 */

#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
#include <assert.h>

/*
 * Structure that represents a range of instructions in the bytecode.
 */

typedef struct CodeRange {
    int startOffset;		/* Start offset in the bytecode array */
    int endOffset;		/* End offset in the bytecode array */
} CodeRange;

/*
 * State identified for a basic block's catch context.
 */

typedef enum BasicBlockCatchState {
    BBCS_UNKNOWN = 0,		/* Catch context has not yet been identified */
    BBCS_NONE,			/* Block is outside of any catch */
    BBCS_INCATCH,		/* Block is within a catch context */
    BBCS_CAUGHT 		/* Block is within a catch context and
				 * may be executed after an exception fires */
} BasicBlockCatchState;

/*
 * Structure that defines a basic block - a linear sequence of bytecode
 * instructions with no jumps in or out (including not changing the
 * state of any exception range).
 */

typedef struct BasicBlock {
    int originalStartOffset;	/* Instruction offset before JUMP1s were
				 * substituted with JUMP4's */
    int startOffset;		/* Instruction offset of the start of the
				 * block */
    int startLine;		/* Line number in the input script of the
				 * instruction at the start of the block */
    int jumpOffset;		/* Bytecode offset of the 'jump' instruction
				 * that ends the block, or -1 if there is no
				 * jump. */
    int jumpLine;		/* Line number in the input script of the
				 * 'jump' instruction that ends the block, or
				 * -1 if there is no jump */
    struct BasicBlock* prevPtr;	/* Immediate predecessor of this block */
    struct BasicBlock* predecessor;
				/* Predecessor of this block in the spanning
				 * tree */
    struct BasicBlock* successor1;
				/* BasicBlock structure of the following
				 * block: NULL at the end of the bytecode
				 * sequence. */
    Tcl_Obj* jumpTarget;	/* Jump target label if the jump target is
				 * unresolved */
    int initialStackDepth;	/* Absolute stack depth on entry */
    int minStackDepth;		/* Low-water relative stack depth */
    int maxStackDepth;		/* High-water relative stack depth */
    int finalStackDepth;	/* Relative stack depth on exit */
    enum BasicBlockCatchState catchState;
				/* State of the block for 'catch' analysis */
    int catchDepth;		/* Number of nested catches in which the basic
				 * block appears */
    struct BasicBlock* enclosingCatch;
				/* BasicBlock structure of the last startCatch
				 * executed on a path to this block, or NULL
				 * if there is no enclosing catch */
    int foreignExceptionBase;	/* Base index of foreign exceptions */
    int foreignExceptionCount;	/* Count of foreign exceptions */
    ExceptionRange* foreignExceptions;
				/* ExceptionRange structures for exception
				 * ranges belonging to embedded scripts and
				 * expressions in this block */
    JumptableInfo* jtPtr;	/* Jump table at the end of this basic block */
    int flags;			/* Boolean flags */
} BasicBlock;

/*
 * Flags that pertain to a basic block.
 */

enum BasicBlockFlags {
    BB_VISITED = (1 << 0),	/* Block has been visited in the current
				 * traversal */
    BB_FALLTHRU = (1 << 1),	/* Control may pass from this block to a
				 * successor */
    BB_JUMP1 = (1 << 2),	/* Basic block ends with a 1-byte-offset jump
				 * and may need expansion */
    BB_JUMPTABLE = (1 << 3),	/* Basic block ends with a jump table */
    BB_BEGINCATCH = (1 << 4),	/* Block ends with a 'beginCatch' instruction,
				 * marking it as the start of a 'catch'
				 * sequence. The 'jumpTarget' is the exception
				 * exit from the catch block. */
    BB_ENDCATCH = (1 << 5)	/* Block ends with an 'endCatch' instruction,
				 * unwinding the catch from the exception
				 * stack. */
};

/*
 * Source instruction type recognized by the assembler.
 */

typedef enum {
    ASSEM_1BYTE,		/* Fixed arity, 1-byte instruction */
    ASSEM_BEGIN_CATCH,		/* Begin catch: one 4-byte jump offset to be
				 * converted to appropriate exception
				 * ranges */
    ASSEM_BOOL,			/* One Boolean operand */
    ASSEM_BOOL_LVT4,		/* One Boolean, one 4-byte LVT ref. */
    ASSEM_CLOCK_READ,		/* 1-byte unsigned-integer case number, in the
				 * range 0-3 */
    ASSEM_CONCAT1,		/* 1-byte unsigned-integer operand count, must
				 * be strictly positive, consumes N, produces
				 * 1 */
    ASSEM_DICT_GET,		/* 'dict get' and related - consumes N+1
				 * operands, produces 1, N > 0 */
    ASSEM_DICT_SET,		/* specifies key count and LVT index, consumes
				 * N+1 operands, produces 1, N > 0 */
    ASSEM_DICT_UNSET,		/* specifies key count and LVT index, consumes
				 * N operands, produces 1, N > 0 */
    ASSEM_END_CATCH,		/* End catch. No args. Exception range popped
				 * from stack and stack pointer restored. */
    ASSEM_EVAL,			/* 'eval' - evaluate a constant script (by
				 * compiling it in line with the assembly
				 * code! I love Tcl!) */
    ASSEM_INDEX,		/* 4 byte operand, integer or end-integer */
    ASSEM_INVOKE,		/* 1- or 4-byte operand count, must be
				 * strictly positive, consumes N, produces
				 * 1. */
    ASSEM_JUMP,			/* Jump instructions */
    ASSEM_JUMP4,		/* Jump instructions forcing a 4-byte offset */
    ASSEM_JUMPTABLE,		/* Jumptable (switch -exact) */
    ASSEM_LABEL,		/* The assembly directive that defines a
				 * label */
    ASSEM_LINDEX_MULTI,		/* 4-byte operand count, must be strictly
				 * positive, consumes N, produces 1 */
    ASSEM_LIST,			/* 4-byte operand count, must be nonnegative,
				 * consumses N, produces 1 */
    ASSEM_LSET_FLAT,		/* 4-byte operand count, must be >= 3,
				 * consumes N, produces 1 */
    ASSEM_LVT,			/* One operand that references a local
				 * variable */
    ASSEM_LVT1,			/* One 1-byte operand that references a local
				 * variable */
    ASSEM_LVT1_SINT1,		/* One 1-byte operand that references a local
				 * variable, one signed-integer 1-byte
				 * operand */
    ASSEM_LVT4,			/* One 4-byte operand that references a local
				 * variable */
    ASSEM_OVER,			/* OVER: 4-byte operand count, consumes N+1,
				 * produces N+2 */
    ASSEM_PUSH,			/* one literal operand */
    ASSEM_REGEXP,		/* One Boolean operand, but weird mapping to
				 * call flags */
    ASSEM_REVERSE,		/* REVERSE: 4-byte operand count, consumes N,
				 * produces N */
    ASSEM_SINT1,		/* One 1-byte signed-integer operand
				 * (INCR_STK_IMM) */
    ASSEM_SINT4_LVT4,		/* Signed 4-byte integer operand followed by
				 * LVT entry.  Fixed arity */
    ASSEM_DICT_GET_DEF		/* 'dict getwithdefault' - consumes N+2
				 * operands, produces 1, N > 0 */
} TalInstType;

/*
 * Description of an instruction recognized by the assembler.
 */

typedef struct TalInstDesc {
    const char *name;		/* Name of instruction. */
    TalInstType instType;	/* The type of instruction */
    int tclInstCode;		/* Instruction code. For instructions having
				 * 1- and 4-byte variables, tclInstCode is
				 * ((1byte)<<8) || (4byte) */
    int operandsConsumed;	/* Number of operands consumed by the
				 * operation, or INT_MIN if the operation is
				 * variadic */
    int operandsProduced;	/* Number of operands produced by the
				 * operation. If negative, the operation has a
				 * net stack effect of -1-operandsProduced */
} TalInstDesc;

/*
 * Structure that holds the state of the assembler while generating code.
 */

typedef struct AssemblyEnv {
    CompileEnv* envPtr;		/* Compilation environment being used for code
				 * generation */
    Tcl_Parse* parsePtr;	/* Parse of the current line of source */
    Tcl_HashTable labelHash;	/* Hash table whose keys are labels and whose
				 * values are 'label' objects storing the code
				 * offsets of the labels. */
    int cmdLine;		/* Current line number within the assembly
				 * code */
    int* clNext;		/* Invisible continuation line for
				 * [info frame] */
    BasicBlock* head_bb;	/* First basic block in the code */
    BasicBlock* curr_bb;	/* Current basic block */
    int maxDepth;		/* Maximum stack depth encountered */
    int curCatchDepth;		/* Current depth of catches */
    int maxCatchDepth;		/* Maximum depth of catches encountered */
    int flags;			/* Compilation flags (TCL_EVAL_DIRECT) */
} AssemblyEnv;

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

static void		AddBasicBlockRangeToErrorInfo(AssemblyEnv*,
			    BasicBlock*);
static BasicBlock *	AllocBB(AssemblyEnv*);
static int		AssembleOneLine(AssemblyEnv* envPtr);
static void		BBAdjustStackDepth(BasicBlock* bbPtr, int consumed,
			    int produced);
static void		BBUpdateStackReqs(BasicBlock* bbPtr, int tblIdx,
			    int count);
static void		BBEmitInstInt1(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int opnd, int count);
static void		BBEmitInstInt4(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int opnd, int count);
static void		BBEmitInst1or4(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int param, int count);
static void		BBEmitOpcode(AssemblyEnv* assemEnvPtr, int tblIdx,
			    int count);
static int		BuildExceptionRanges(AssemblyEnv* assemEnvPtr);
static int		CalculateJumpRelocations(AssemblyEnv*, int*);
static int		CheckForUnclosedCatches(AssemblyEnv*);
static int		CheckForThrowInWrongContext(AssemblyEnv*);
static int		CheckNonThrowingBlock(AssemblyEnv*, BasicBlock*);
static int		BytecodeMightThrow(unsigned char);
static int		CheckJumpTableLabels(AssemblyEnv*, BasicBlock*);
static int		CheckNamespaceQualifiers(Tcl_Interp*, const char*,
			    int);
static int		CheckNonNegative(Tcl_Interp*, int);
static int		CheckOneByte(Tcl_Interp*, int);
static int		CheckSignedOneByte(Tcl_Interp*, int);
static int		CheckStack(AssemblyEnv*);
static int		CheckStrictlyPositive(Tcl_Interp*, int);
static ByteCode *	CompileAssembleObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
			    const TalInstDesc*);
static int		DefineLabel(AssemblyEnv* envPtr, const char* label);
static void		DeleteMirrorJumpTable(JumptableInfo* jtPtr);
static void		FillInJumpOffsets(AssemblyEnv*);
static int		CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
			    Tcl_Obj* jumpTable);
static int		FindLocalVar(AssemblyEnv* envPtr,
			    Tcl_Token** tokenPtrPtr);
static int		FinishAssembly(AssemblyEnv*);
static void		FreeAssemblyEnv(AssemblyEnv*);
static int		GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
static int		GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
static int		GetIntegerOperand(AssemblyEnv*, Tcl_Token**, int*);
static int		GetNextOperand(AssemblyEnv*, Tcl_Token**, Tcl_Obj**);
static void		LookForFreshCatches(BasicBlock*, BasicBlock**);
static void		MoveCodeForJumps(AssemblyEnv*, int);
static void		MoveExceptionRangesToBasicBlock(AssemblyEnv*, int);
static AssemblyEnv*	NewAssemblyEnv(CompileEnv*, int);
static int		ProcessCatches(AssemblyEnv*);
static int		ProcessCatchesInBasicBlock(AssemblyEnv*, BasicBlock*,
			    BasicBlock*, enum BasicBlockCatchState, int);
static void		ResetVisitedBasicBlocks(AssemblyEnv*);
static void		ResolveJumpTableTargets(AssemblyEnv*, BasicBlock*);
static void		ReportUndefinedLabel(AssemblyEnv*, BasicBlock*,
			    Tcl_Obj*);
static void		RestoreEmbeddedExceptionRanges(AssemblyEnv*);
static int		StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
			    BasicBlock *, int);
static BasicBlock*	StartBasicBlock(AssemblyEnv*, int fallthrough,
			    Tcl_Obj* jumpLabel);
/* static int		AdvanceIp(const unsigned char *pc); */
static int		StackCheckBasicBlock(AssemblyEnv*, BasicBlock *,
			    BasicBlock *, int);
static int		StackCheckExit(AssemblyEnv*);
static void		StackFreshCatches(AssemblyEnv*, BasicBlock*, int,
			    BasicBlock**, int*);
static void		SyncStackDepth(AssemblyEnv*);
static int		TclAssembleCode(CompileEnv* envPtr, const char* code,
			    int codeLen, int flags);
static void		UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
			    BasicBlock**, int*);

/*
 * Tcl_ObjType that describes bytecode emitted by the assembler.
 */

static Tcl_FreeInternalRepProc	FreeAssembleCodeInternalRep;
static Tcl_DupInternalRepProc	DupAssembleCodeInternalRep;

static const Tcl_ObjType assembleCodeType = {
    "assemblecode",
    FreeAssembleCodeInternalRep, /* freeIntRepProc */
    DupAssembleCodeInternalRep,	 /* dupIntRepProc */
    NULL,			 /* updateStringProc */
    NULL			 /* setFromAnyProc */
};

/*
 * Source instructions recognized in the Tcl Assembly Language (TAL)
 */

static const TalInstDesc TalInstructionTable[] = {
    /* PUSH must be first, see the code near the end of TclAssembleCode */
    {"push",		ASSEM_PUSH,	(INST_PUSH1<<8
					 | INST_PUSH4),		0,	1},

    {"add",		ASSEM_1BYTE,	INST_ADD,		2,	1},
    {"append",		ASSEM_LVT,	(INST_APPEND_SCALAR1<<8
					 | INST_APPEND_SCALAR4),1,	1},
    {"appendArray",	ASSEM_LVT,	(INST_APPEND_ARRAY1<<8
					 | INST_APPEND_ARRAY4),	2,	1},
    {"appendArrayStk",	ASSEM_1BYTE,	INST_APPEND_ARRAY_STK,	3,	1},
    {"appendStk",	ASSEM_1BYTE,	INST_APPEND_STK,	2,	1},
    {"arrayExistsImm",	ASSEM_LVT4,	INST_ARRAY_EXISTS_IMM,	0,	1},
    {"arrayExistsStk",	ASSEM_1BYTE,	INST_ARRAY_EXISTS_STK,	1,	1},
    {"arrayMakeImm",	ASSEM_LVT4,	INST_ARRAY_MAKE_IMM,	0,	0},
    {"arrayMakeStk",	ASSEM_1BYTE,	INST_ARRAY_MAKE_STK,	1,	0},
    {"beginCatch",	ASSEM_BEGIN_CATCH,
					INST_BEGIN_CATCH4,	0,	0},
    {"bitand",		ASSEM_1BYTE,	INST_BITAND,		2,	1},
    {"bitnot",		ASSEM_1BYTE,	INST_BITNOT,		1,	1},
    {"bitor",		ASSEM_1BYTE,	INST_BITOR,		2,	1},
    {"bitxor",		ASSEM_1BYTE,	INST_BITXOR,		2,	1},
    {"clockRead",	ASSEM_CLOCK_READ, INST_CLOCK_READ,	0,	1},
    {"concat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
    {"concatStk",	ASSEM_LIST,	INST_CONCAT_STK,	INT_MIN,1},
    {"coroName",	ASSEM_1BYTE,	INST_COROUTINE_NAME,	0,	1},
    {"currentNamespace",ASSEM_1BYTE,	INST_NS_CURRENT,	0,	1},
    {"dictAppend",	ASSEM_LVT4,	INST_DICT_APPEND,	2,	1},
    {"dictExists",	ASSEM_DICT_GET, INST_DICT_EXISTS,	INT_MIN,1},
    {"dictExpand",	ASSEM_1BYTE,	INST_DICT_EXPAND,	3,	1},
    {"dictGet",		ASSEM_DICT_GET, INST_DICT_GET,		INT_MIN,1},
    {"dictGetDef",	ASSEM_DICT_GET_DEF, INST_DICT_GET_DEF,	INT_MIN,1},
    {"dictIncrImm",	ASSEM_SINT4_LVT4,
					INST_DICT_INCR_IMM,	1,	1},
    {"dictLappend",	ASSEM_LVT4,	INST_DICT_LAPPEND,	2,	1},
    {"dictRecombineStk",ASSEM_1BYTE,	INST_DICT_RECOMBINE_STK,3,	0},
    {"dictRecombineImm",ASSEM_LVT4,	INST_DICT_RECOMBINE_IMM,2,	0},
    {"dictSet",		ASSEM_DICT_SET, INST_DICT_SET,		INT_MIN,1},
    {"dictUnset",	ASSEM_DICT_UNSET,
					INST_DICT_UNSET,	INT_MIN,1},
    {"div",		ASSEM_1BYTE,	INST_DIV,		2,	1},
    {"dup",		ASSEM_1BYTE,	INST_DUP,		1,	2},
    {"endCatch",	ASSEM_END_CATCH,INST_END_CATCH,		0,	0},
    {"eq",		ASSEM_1BYTE,	INST_EQ,		2,	1},
    {"eval",		ASSEM_EVAL,	INST_EVAL_STK,		1,	1},
    {"evalStk",		ASSEM_1BYTE,	INST_EVAL_STK,		1,	1},
    {"exist",		ASSEM_LVT4,	INST_EXIST_SCALAR,	0,	1},
    {"existArray",	ASSEM_LVT4,	INST_EXIST_ARRAY,	1,	1},
    {"existArrayStk",	ASSEM_1BYTE,	INST_EXIST_ARRAY_STK,	2,	1},
    {"existStk",	ASSEM_1BYTE,	INST_EXIST_STK,		1,	1},
    {"expon",		ASSEM_1BYTE,	INST_EXPON,		2,	1},
    {"expr",		ASSEM_EVAL,	INST_EXPR_STK,		1,	1},
    {"exprStk",		ASSEM_1BYTE,	INST_EXPR_STK,		1,	1},
    {"ge",		ASSEM_1BYTE,	INST_GE,		2,	1},
    {"gt",		ASSEM_1BYTE,	INST_GT,		2,	1},
    {"incr",		ASSEM_LVT1,	INST_INCR_SCALAR1,	1,	1},
    {"incrArray",	ASSEM_LVT1,	INST_INCR_ARRAY1,	2,	1},
    {"incrArrayImm",	ASSEM_LVT1_SINT1,
					INST_INCR_ARRAY1_IMM,	1,	1},
    {"incrArrayStk",	ASSEM_1BYTE,	INST_INCR_ARRAY_STK,	3,	1},
    {"incrArrayStkImm", ASSEM_SINT1,	INST_INCR_ARRAY_STK_IMM,2,	1},
    {"incrImm",		ASSEM_LVT1_SINT1,
					INST_INCR_SCALAR1_IMM,	0,	1},
    {"incrStk",		ASSEM_1BYTE,	INST_INCR_STK,		2,	1},
    {"incrStkImm",	ASSEM_SINT1,	INST_INCR_STK_IMM,	1,	1},
    {"infoLevelArgs",	ASSEM_1BYTE,	INST_INFO_LEVEL_ARGS,	1,	1},
    {"infoLevelNumber",	ASSEM_1BYTE,	INST_INFO_LEVEL_NUM,	0,	1},
    {"invokeStk",	ASSEM_INVOKE,	(INST_INVOKE_STK1 << 8
					 | INST_INVOKE_STK4),	INT_MIN,1},
    {"jump",		ASSEM_JUMP,	INST_JUMP1,		0,	0},
    {"jump4",		ASSEM_JUMP4,	INST_JUMP4,		0,	0},
    {"jumpFalse",	ASSEM_JUMP,	INST_JUMP_FALSE1,	1,	0},
    {"jumpFalse4",	ASSEM_JUMP4,	INST_JUMP_FALSE4,	1,	0},
    {"jumpTable",	ASSEM_JUMPTABLE,INST_JUMP_TABLE,	1,	0},
    {"jumpTrue",	ASSEM_JUMP,	INST_JUMP_TRUE1,	1,	0},
    {"jumpTrue4",	ASSEM_JUMP4,	INST_JUMP_TRUE4,	1,	0},
    {"label",		ASSEM_LABEL,	0,			0,	0},
    {"lappend",		ASSEM_LVT,	(INST_LAPPEND_SCALAR1<<8
					 | INST_LAPPEND_SCALAR4),
								1,	1},
    {"lappendArray",	ASSEM_LVT,	(INST_LAPPEND_ARRAY1<<8
					 | INST_LAPPEND_ARRAY4),2,	1},
    {"lappendArrayStk", ASSEM_1BYTE,	INST_LAPPEND_ARRAY_STK,	3,	1},
    {"lappendList",	ASSEM_LVT4,	INST_LAPPEND_LIST,	1,	1},
    {"lappendListArray",ASSEM_LVT4,	INST_LAPPEND_LIST_ARRAY,2,	1},
    {"lappendListArrayStk", ASSEM_1BYTE,INST_LAPPEND_LIST_ARRAY_STK, 3,	1},
    {"lappendListStk",	ASSEM_1BYTE,	INST_LAPPEND_LIST_STK,	2,	1},
    {"lappendStk",	ASSEM_1BYTE,	INST_LAPPEND_STK,	2,	1},
    {"le",		ASSEM_1BYTE,	INST_LE,		2,	1},
    {"lindexMulti",	ASSEM_LINDEX_MULTI,
					INST_LIST_INDEX_MULTI,	INT_MIN,1},
    {"list",		ASSEM_LIST,	INST_LIST,		INT_MIN,1},
    {"listConcat",	ASSEM_1BYTE,	INST_LIST_CONCAT,	2,	1},
    {"listIn",		ASSEM_1BYTE,	INST_LIST_IN,		2,	1},
    {"listIndex",	ASSEM_1BYTE,	INST_LIST_INDEX,	2,	1},
    {"listIndexImm",	ASSEM_INDEX,	INST_LIST_INDEX_IMM,	1,	1},
    {"listLength",	ASSEM_1BYTE,	INST_LIST_LENGTH,	1,	1},
    {"listNotIn",	ASSEM_1BYTE,	INST_LIST_NOT_IN,	2,	1},
    {"load",		ASSEM_LVT,	(INST_LOAD_SCALAR1 << 8
					 | INST_LOAD_SCALAR4),	0,	1},
    {"loadArray",	ASSEM_LVT,	(INST_LOAD_ARRAY1<<8
					 | INST_LOAD_ARRAY4),	1,	1},
    {"loadArrayStk",	ASSEM_1BYTE,	INST_LOAD_ARRAY_STK,	2,	1},
    {"loadStk",		ASSEM_1BYTE,	INST_LOAD_STK,		1,	1},
    {"lsetFlat",	ASSEM_LSET_FLAT,INST_LSET_FLAT,		INT_MIN,1},
    {"lsetList",	ASSEM_1BYTE,	INST_LSET_LIST,		3,	1},
    {"lshift",		ASSEM_1BYTE,	INST_LSHIFT,		2,	1},
    {"lt",		ASSEM_1BYTE,	INST_LT,		2,	1},
    {"mod",		ASSEM_1BYTE,	INST_MOD,		2,	1},
    {"mult",		ASSEM_1BYTE,	INST_MULT,		2,	1},
    {"neq",		ASSEM_1BYTE,	INST_NEQ,		2,	1},
    {"nop",		ASSEM_1BYTE,	INST_NOP,		0,	0},
    {"not",		ASSEM_1BYTE,	INST_LNOT,		1,	1},
    {"nsupvar",		ASSEM_LVT4,	INST_NSUPVAR,		2,	1},
    {"numericType",	ASSEM_1BYTE,	INST_NUM_TYPE,		1,	1},
    {"originCmd",	ASSEM_1BYTE,	INST_ORIGIN_COMMAND,	1,	1},
    {"over",		ASSEM_OVER,	INST_OVER,		INT_MIN,-1-1},
    {"pop",		ASSEM_1BYTE,	INST_POP,		1,	0},
    {"pushReturnCode",	ASSEM_1BYTE,	INST_PUSH_RETURN_CODE,	0,	1},
    {"pushReturnOpts",	ASSEM_1BYTE,	INST_PUSH_RETURN_OPTIONS,
								0,	1},
    {"pushResult",	ASSEM_1BYTE,	INST_PUSH_RESULT,	0,	1},
    {"regexp",		ASSEM_REGEXP,	INST_REGEXP,		2,	1},
    {"resolveCmd",	ASSEM_1BYTE,	INST_RESOLVE_COMMAND,	1,	1},
    {"reverse",		ASSEM_REVERSE,	INST_REVERSE,		INT_MIN,-1-0},
    {"rshift",		ASSEM_1BYTE,	INST_RSHIFT,		2,	1},
    {"store",		ASSEM_LVT,	(INST_STORE_SCALAR1<<8
					 | INST_STORE_SCALAR4),	1,	1},
    {"storeArray",	ASSEM_LVT,	(INST_STORE_ARRAY1<<8
					 | INST_STORE_ARRAY4),	2,	1},
    {"storeArrayStk",	ASSEM_1BYTE,	INST_STORE_ARRAY_STK,	3,	1},
    {"storeStk",	ASSEM_1BYTE,	INST_STORE_STK,		2,	1},
    {"strcaseLower",	ASSEM_1BYTE,	INST_STR_LOWER,		1,	1},
    {"strcaseTitle",	ASSEM_1BYTE,	INST_STR_TITLE,		1,	1},
    {"strcaseUpper",	ASSEM_1BYTE,	INST_STR_UPPER,		1,	1},
    {"strcmp",		ASSEM_1BYTE,	INST_STR_CMP,		2,	1},
    {"strcat",		ASSEM_CONCAT1,	INST_STR_CONCAT1,	INT_MIN,1},
    {"streq",		ASSEM_1BYTE,	INST_STR_EQ,		2,	1},
    {"strfind",		ASSEM_1BYTE,	INST_STR_FIND,		2,	1},
    {"strge",		ASSEM_1BYTE,	INST_STR_GE,		2,	1},
    {"strgt",		ASSEM_1BYTE,	INST_STR_GT,		2,	1},
    {"strindex",	ASSEM_1BYTE,	INST_STR_INDEX,		2,	1},
    {"strle",		ASSEM_1BYTE,	INST_STR_LE,		2,	1},
    {"strlen",		ASSEM_1BYTE,	INST_STR_LEN,		1,	1},
    {"strlt",		ASSEM_1BYTE,	INST_STR_LT,		2,	1},
    {"strmap",		ASSEM_1BYTE,	INST_STR_MAP,		3,	1},
    {"strmatch",	ASSEM_BOOL,	INST_STR_MATCH,		2,	1},
    {"strneq",		ASSEM_1BYTE,	INST_STR_NEQ,		2,	1},
    {"strrange",	ASSEM_1BYTE,	INST_STR_RANGE,		3,	1},
    {"strreplace",	ASSEM_1BYTE,	INST_STR_REPLACE,	4,	1},
    {"strrfind",	ASSEM_1BYTE,	INST_STR_FIND_LAST,	2,	1},
    {"strtrim",		ASSEM_1BYTE,	INST_STR_TRIM,		2,	1},
    {"strtrimLeft",	ASSEM_1BYTE,	INST_STR_TRIM_LEFT,	2,	1},
    {"strtrimRight",	ASSEM_1BYTE,	INST_STR_TRIM_RIGHT,	2,	1},
    {"sub",		ASSEM_1BYTE,	INST_SUB,		2,	1},
    {"tclooClass",	ASSEM_1BYTE,	INST_TCLOO_CLASS,	1,	1},
    {"tclooIsObject",	ASSEM_1BYTE,	INST_TCLOO_IS_OBJECT,	1,	1},
    {"tclooNamespace",	ASSEM_1BYTE,	INST_TCLOO_NS,		1,	1},
    {"tclooSelf",	ASSEM_1BYTE,	INST_TCLOO_SELF,	0,	1},
    {"tryCvtToBoolean",	ASSEM_1BYTE,	INST_TRY_CVT_TO_BOOLEAN,1,	2},
    {"tryCvtToNumeric",	ASSEM_1BYTE,	INST_TRY_CVT_TO_NUMERIC,1,	1},
    {"uminus",		ASSEM_1BYTE,	INST_UMINUS,		1,	1},
    {"unset",		ASSEM_BOOL_LVT4,INST_UNSET_SCALAR,	0,	0},
    {"unsetArray",	ASSEM_BOOL_LVT4,INST_UNSET_ARRAY,	1,	0},
    {"unsetArrayStk",	ASSEM_BOOL,	INST_UNSET_ARRAY_STK,	2,	0},
    {"unsetStk",	ASSEM_BOOL,	INST_UNSET_STK,		1,	0},
    {"uplus",		ASSEM_1BYTE,	INST_UPLUS,		1,	1},
    {"upvar",		ASSEM_LVT4,	INST_UPVAR,		2,	1},
    {"variable",	ASSEM_LVT4,	INST_VARIABLE,		1,	0},
    {"verifyDict",	ASSEM_1BYTE,	INST_DICT_VERIFY,	1,	0},
    {"yield",		ASSEM_1BYTE,	INST_YIELD,		1,	1},
    {NULL,		ASSEM_1BYTE,		0,			0,	0}
};

/*
 * List of instructions that cannot throw an exception under any
 * circumstances.  These instructions are the ones that are permissible after
 * an exception is caught but before the corresponding exception range is
 * popped from the stack.
 * The instructions must be in ascending order by numeric operation code.
 */

static const unsigned char NonThrowingByteCodes[] = {
    INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP,			/* 1-4 */
    INST_JUMP1, INST_JUMP4,					/* 34-35 */
    INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE,	/* 70-72 */
    INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN,	/* 73-76 */
    INST_LIST,							/* 79 */
    INST_OVER,							/* 95 */
    INST_PUSH_RETURN_OPTIONS,					/* 108 */
    INST_REVERSE,						/* 126 */
    INST_NOP,							/* 132 */
    INST_STR_MAP,						/* 143 */
    INST_STR_FIND,						/* 144 */
    INST_COROUTINE_NAME,					/* 149 */
    INST_NS_CURRENT,						/* 151 */
    INST_INFO_LEVEL_NUM,					/* 152 */
    INST_RESOLVE_COMMAND,					/* 154 */
    INST_STR_TRIM, INST_STR_TRIM_LEFT, INST_STR_TRIM_RIGHT,	/* 166-168 */
    INST_CONCAT_STK,						/* 169 */
    INST_STR_UPPER, INST_STR_LOWER, INST_STR_TITLE,		/* 170-172 */
    INST_NUM_TYPE,						/* 180 */
    INST_STR_LT, INST_STR_GT, INST_STR_LE, INST_STR_GE		/* 191-194 */
};

/*
 * Helper macros.
 */

#if defined(TCL_DEBUG_ASSEMBLY) && defined(__GNUC__) && __GNUC__ > 2
#define DEBUG_PRINT(...)	fprintf(stderr, ##__VA_ARGS__);fflush(stderr)
#elif defined(__GNUC__) && __GNUC__ > 2
#define DEBUG_PRINT(...)	/* nothing */
#else
#define DEBUG_PRINT		/* nothing */
#endif

/*
 *-----------------------------------------------------------------------------
 *
 * BBAdjustStackDepth --
 *
 *	When an opcode is emitted, adjusts the stack information in the basic
 *	block to reflect the number of operands produced and consumed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates minimum, maximum and final stack requirements in the basic
 *	block.
 *
 *-----------------------------------------------------------------------------
 */

static void
BBAdjustStackDepth(
    BasicBlock *bbPtr,		/* Structure describing the basic block */
    int consumed,		/* Count of operands consumed by the
				 * operation */
    int produced)		/* Count of operands produced by the
				 * operation */
{
    int depth = bbPtr->finalStackDepth;

    depth -= consumed;
    if (depth < bbPtr->minStackDepth) {
	bbPtr->minStackDepth = depth;
    }
    depth += produced;
    if (depth > bbPtr->maxStackDepth) {
	bbPtr->maxStackDepth = depth;
    }
    bbPtr->finalStackDepth = depth;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BBUpdateStackReqs --
 *
 *	Updates the stack requirements of a basic block, given the opcode
 *	being emitted and an operand count.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates min, max and final stack requirements in the basic block.
 *
 * Notes:
 *	This function must not be called for instructions such as REVERSE and
 *	OVER that are variadic but do not consume all their operands. Instead,
 *	BBAdjustStackDepth should be called directly.
 *
 *	count should be provided only for variadic operations. For operations
 *	with known arity, count should be 0.
 *
 *-----------------------------------------------------------------------------
 */

static void
BBUpdateStackReqs(
    BasicBlock* bbPtr,		/* Structure describing the basic block */
    int tblIdx,			/* Index in TalInstructionTable of the
				 * operation being assembled */
    int count)			/* Count of operands for variadic insts */
{
    int consumed = TalInstructionTable[tblIdx].operandsConsumed;
    int produced = TalInstructionTable[tblIdx].operandsProduced;

    if (consumed == INT_MIN) {
	/*
	 * The instruction is variadic; it consumes 'count' operands, or
	 * 'count+1' for ASSEM_DICT_GET_DEF.
	 */

	consumed = count;
	if (TalInstructionTable[tblIdx].instType == ASSEM_DICT_GET_DEF) {
	    consumed++;
	}
    }
    if (produced < 0) {
	/*
	 * The instruction leaves some of its variadic operands on the stack,
	 * with net stack effect of '-1-produced'
	 */

	produced = consumed - produced - 1;
    }
    BBAdjustStackDepth(bbPtr, consumed, produced);
}

/*
 *-----------------------------------------------------------------------------
 *
 * BBEmitOpcode, BBEmitInstInt1, BBEmitInstInt4 --
 *
 *	Emit the opcode part of an instruction, or the entirety of an
 *	instruction with a 1- or 4-byte operand, and adjust stack
 *	requirements.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores instruction and operand in the operand stream, and adjusts the
 *	stack.
 *
 *-----------------------------------------------------------------------------
 */

static void
BBEmitOpcode(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int tblIdx,			/* Table index in TalInstructionTable of op */
    int count)			/* Operand count for variadic ops */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
				/* Current basic block */
    int op = TalInstructionTable[tblIdx].tclInstCode & 0xFF;

    /*
     * If this is the first instruction in a basic block, record its line
     * number.
     */

    if (bbPtr->startOffset == envPtr->codeNext - envPtr->codeStart) {
	bbPtr->startLine = assemEnvPtr->cmdLine;
    }

    TclEmitInt1(op, envPtr);
    TclUpdateAtCmdStart(op, envPtr);
    BBUpdateStackReqs(bbPtr, tblIdx, count);
}

static void
BBEmitInstInt1(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int tblIdx,			/* Index in TalInstructionTable of op */
    int opnd,			/* 1-byte operand */
    int count)			/* Operand count for variadic ops */
{
    BBEmitOpcode(assemEnvPtr, tblIdx, count);
    TclEmitInt1(opnd, assemEnvPtr->envPtr);
}

static void
BBEmitInstInt4(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int tblIdx,			/* Index in TalInstructionTable of op */
    int opnd,			/* 4-byte operand */
    int count)			/* Operand count for variadic ops */
{
    BBEmitOpcode(assemEnvPtr, tblIdx, count);
    TclEmitInt4(opnd, assemEnvPtr->envPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * BBEmitInst1or4 --
 *
 *	Emits a 1- or 4-byte operation according to the magnitude of the
 *	operand.
 *
 *-----------------------------------------------------------------------------
 */

static void
BBEmitInst1or4(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int tblIdx,			/* Index in TalInstructionTable of op */
    int param,			/* Variable-length parameter */
    int count)			/* Arity if variadic */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
				/* Current basic block */
    int op = TalInstructionTable[tblIdx].tclInstCode;

    if (param <= 0xFF) {
	op >>= 8;
    } else {
	op &= 0xFF;
    }
    TclEmitInt1(op, envPtr);
    if (param <= 0xFF) {
	TclEmitInt1(param, envPtr);
    } else {
	TclEmitInt4(param, envPtr);
    }
    TclUpdateAtCmdStart(op, envPtr);
    BBUpdateStackReqs(bbPtr, tblIdx, count);
}

/*
 *-----------------------------------------------------------------------------
 *
 * Tcl_AssembleObjCmd, TclNRAssembleObjCmd --
 *
 *	Direct evaluation path for tcl::unsupported::assemble
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Assembles the code in objv[1], and executes it, so side effects
 *	include whatever the code does.
 *
 *-----------------------------------------------------------------------------
 */

int
Tcl_AssembleObjCmd(
    ClientData clientData,		/* clientData */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    /*
     * Boilerplate - make sure that there is an NRE trampoline on the C stack
     * because there needs to be one in place to execute bytecode.
     */

    return Tcl_NRCallObjProc(interp, TclNRAssembleObjCmd, clientData, objc, objv);
}

int
TclNRAssembleObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    ByteCode *codePtr;		/* Pointer to the bytecode to execute */
    Tcl_Obj* backtrace;		/* Object where extra error information is
				 * constructed. */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytecodeList");
	return TCL_ERROR;
    }

    /*
     * Assemble the source to bytecode.
     */

    codePtr = CompileAssembleObj(interp, objv[1]);

    /*
     * On failure, report error line.
     */

    if (codePtr == NULL) {
	Tcl_AddErrorInfo(interp, "\n    (\"");
	Tcl_AppendObjToErrorInfo(interp, objv[0]);
	Tcl_AddErrorInfo(interp, "\" body, line ");
	TclNewIntObj(backtrace, Tcl_GetErrorLine(interp));
	Tcl_AppendObjToErrorInfo(interp, backtrace);
	Tcl_AddErrorInfo(interp, ")");
	return TCL_ERROR;
    }

    /*
     * Use NRE to evaluate the bytecode from the trampoline.
     */

    return TclNRExecuteByteCode(interp, codePtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * CompileAssembleObj --
 *
 *	Sets up and assembles Tcl bytecode for the direct-execution path in
 *	the Tcl bytecode assembler.
 *
 * Results:
 *	Returns a pointer to the assembled code. Returns NULL if the assembly
 *	fails for any reason, with an appropriate error message in the
 *	interpreter.
 *
 *-----------------------------------------------------------------------------
 */

static ByteCode *
CompileAssembleObj(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Source code to assemble */
{
    Interp *iPtr = (Interp *) interp;
				/* Internals of the interpreter */
    CompileEnv compEnv;		/* Compilation environment structure */
    ByteCode *codePtr = NULL;
				/* Bytecode resulting from the assembly */
    Namespace* namespacePtr;	/* Namespace in which variable and command
				 * names in the bytecode resolve */
    int status;			/* Status return from Tcl_AssembleCode */
    const char* source;		/* String representation of the source code */
    size_t sourceLen;		/* Length of the source code in bytes */

    /*
     * Get the expression ByteCode from the object. If it exists, make sure it
     * is valid in the current context.
     */

    ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);

    if (codePtr) {
	namespacePtr = iPtr->varFramePtr->nsPtr;
	if (((Interp *) *codePtr->interpHandle == iPtr)
		&& (codePtr->compileEpoch == iPtr->compileEpoch)
		&& (codePtr->nsPtr == namespacePtr)
		&& (codePtr->nsEpoch == namespacePtr->resolverEpoch)
		&& (codePtr->localCachePtr
			== iPtr->varFramePtr->localCachePtr)) {
	    return codePtr;
	}

	/*
	 * Not valid, so free it and regenerate.
	 */

	Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
    }

    /*
     * Set up the compilation environment, and assemble the code.
     */

    source = TclGetStringFromObj(objPtr, &sourceLen);
    TclInitCompileEnv(interp, &compEnv, source, sourceLen, NULL, 0);
    status = TclAssembleCode(&compEnv, source, sourceLen, TCL_EVAL_DIRECT);
    if (status != TCL_OK) {
	/*
	 * Assembly failed. Clean up and report the error.
	 */
	TclFreeCompileEnv(&compEnv);
	return NULL;
    }

    /*
     * Add a "done" instruction as the last instruction and change the object
     * into a ByteCode object. Ownership of the literal objects and aux data
     * items is given to the ByteCode object.
     */

    TclEmitOpcode(INST_DONE, &compEnv);
    codePtr = TclInitByteCodeObj(objPtr, &assembleCodeType, &compEnv);
    TclFreeCompileEnv(&compEnv);

    /*
     * Record the local variable context to which the bytecode pertains
     */

    if (iPtr->varFramePtr->localCachePtr) {
	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	codePtr->localCachePtr->refCount++;
    }

    /*
     * Report on what the assembler did.
     */

#ifdef TCL_COMPILE_DEBUG
    if (tclTraceCompile >= 2) {
	TclPrintByteCodeObj(interp, objPtr);
	fflush(stdout);
    }
#endif /* TCL_COMPILE_DEBUG */

    return codePtr;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclCompileAssembleCmd --
 *
 *	Compilation procedure for the '::tcl::unsupported::assemble' command.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Puts the result of assembling the code into the bytecode stream in
 *	'compileEnv'.
 *
 * This procedure makes sure that the command has a single arg, which is
 * constant. If that condition is met, the procedure calls TclAssembleCode to
 * produce bytecode for the given assembly code, and returns any error
 * resulting from the assembly.
 *
 *-----------------------------------------------------------------------------
 */

int
TclCompileAssembleCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;	/* Token in the input script */

    int numCommands = envPtr->numCommands;
    int offset = envPtr->codeNext - envPtr->codeStart;
    int depth = envPtr->currStackDepth;
    /*
     * Make sure that the command has a single arg that is a simple word.
     */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }

    /*
     * Compile the code and convert any error from the compilation into
     * bytecode reporting the error;
     */

    if (TCL_ERROR == TclAssembleCode(envPtr, tokenPtr[1].start,
	    tokenPtr[1].size, TCL_EVAL_DIRECT)) {

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s\" body, line %d)",
		(int)parsePtr->tokenPtr->size, parsePtr->tokenPtr->start,
		Tcl_GetErrorLine(interp)));
	envPtr->numCommands = numCommands;
	envPtr->codeNext = envPtr->codeStart + offset;
	envPtr->currStackDepth = depth;
	TclCompileSyntaxError(interp, envPtr);
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclAssembleCode --
 *
 *	Take a list of instructions in a Tcl_Obj, and assemble them to Tcl
 *	bytecodes
 *
 * Results:
 *	Returns TCL_OK on success, TCL_ERROR on failure.  If 'flags' includes
 *	TCL_EVAL_DIRECT, places an error message in the interpreter result.
 *
 * Side effects:
 *	Adds byte codes to the compile environment, and updates the
 *	environment's stack depth.
 *
 *-----------------------------------------------------------------------------
 */

static int
TclAssembleCode(
    CompileEnv *envPtr,		/* Compilation environment that is to receive
				 * the generated bytecode */
    const char* codePtr,	/* Assembly-language code to be processed */
    int codeLen,		/* Length of the code */
    int flags)			/* OR'ed combination of flags */
{
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    /*
     * Walk through the assembly script using the Tcl parser.  Each 'command'
     * will be an instruction or assembly directive.
     */

    const char* instPtr = codePtr;
				/* Where to start looking for a line of code */
    const char* nextPtr;	/* Pointer to the end of the line of code */
    int bytesLeft = codeLen;	/* Number of bytes of source code remaining to
				 * be parsed */
    int status;			/* Tcl status return */
    AssemblyEnv* assemEnvPtr = NewAssemblyEnv(envPtr, flags);
    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;

    do {
	/*
	 * Parse out one command line from the assembly script.
	 */

	status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);

	/*
	 * Report errors in the parse.
	 */

	if (status != TCL_OK) {
	    if (flags & TCL_EVAL_DIRECT) {
		Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
			parsePtr->term + 1 - parsePtr->commandStart);
	    }
	    FreeAssemblyEnv(assemEnvPtr);
	    return TCL_ERROR;
	}

	/*
	 * Advance the pointers around any leading commentary.
	 */

	TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr,
		parsePtr->commandStart);
	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
		parsePtr->commandStart - envPtr->source);

	/*
	 * Process the line of code.
	 */

	if (parsePtr->numWords > 0) {
	    size_t instLen = parsePtr->commandSize;
		    /* Length in bytes of the current command */

	    if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
		--instLen;
	    }

	    /*
	     * If tracing, show each line assembled as it happens.
	     */

#ifdef TCL_COMPILE_DEBUG
	    if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) {
		printf("  %4" TCL_Z_MODIFIER "d Assembling: ",
			envPtr->codeNext - envPtr->codeStart);
		TclPrintSource(stdout, parsePtr->commandStart,
			TclMin(instLen, 55));
		printf("\n");
	    }
#endif
	    if (AssembleOneLine(assemEnvPtr) != TCL_OK) {
		if (flags & TCL_EVAL_DIRECT) {
		    Tcl_LogCommandInfo(interp, codePtr,
			    parsePtr->commandStart, instLen);
		}
		Tcl_FreeParse(parsePtr);
		FreeAssemblyEnv(assemEnvPtr);
		return TCL_ERROR;
	    }
	}

	/*
	 * Advance to the next line of code.
	 */

	nextPtr = parsePtr->commandStart + parsePtr->commandSize;
	bytesLeft -= (nextPtr - instPtr);
	instPtr = nextPtr;
	TclAdvanceLines(&assemEnvPtr->cmdLine, parsePtr->commandStart,
		instPtr);
	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
		instPtr - envPtr->source);
	Tcl_FreeParse(parsePtr);
    } while (bytesLeft > 0);

    /*
     * Done with parsing the code.
     */

    status = FinishAssembly(assemEnvPtr);
    FreeAssemblyEnv(assemEnvPtr);
    return status;
}

/*
 *-----------------------------------------------------------------------------
 *
 * NewAssemblyEnv --
 *
 *	Creates an environment for the assembler to run in.
 *
 * Results:
 *	Allocates, initialises and returns an assembler environment
 *
 *-----------------------------------------------------------------------------
 */

static AssemblyEnv*
NewAssemblyEnv(
    CompileEnv* envPtr,		/* Compilation environment being used for code
				 * generation*/
    int flags)			/* Compilation flags (TCL_EVAL_DIRECT) */
{
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    AssemblyEnv* assemEnvPtr = (AssemblyEnv*)TclStackAlloc(interp, sizeof(AssemblyEnv));
				/* Assembler environment under construction */
    Tcl_Parse* parsePtr = (Tcl_Parse*)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Parse of one line of assembly code */

    assemEnvPtr->envPtr = envPtr;
    assemEnvPtr->parsePtr = parsePtr;
    assemEnvPtr->cmdLine = 1;
    assemEnvPtr->clNext = envPtr->clNext;

    /*
     * Make the hashtables that store symbol resolution.
     */

    Tcl_InitHashTable(&assemEnvPtr->labelHash, TCL_STRING_KEYS);

    /*
     * Start the first basic block.
     */

    assemEnvPtr->curr_bb = NULL;
    assemEnvPtr->head_bb = AllocBB(assemEnvPtr);
    assemEnvPtr->curr_bb = assemEnvPtr->head_bb;
    assemEnvPtr->head_bb->startLine = 1;

    /*
     * Stash compilation flags.
     */

    assemEnvPtr->flags = flags;
    return assemEnvPtr;
}

/*
 *-----------------------------------------------------------------------------
 *
 * FreeAssemblyEnv --
 *
 *	Cleans up the assembler environment when assembly is complete.
 *
 *-----------------------------------------------------------------------------
 */

static void
FreeAssemblyEnv(
    AssemblyEnv* assemEnvPtr)	/* Environment to free */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment being used for code
				 * generation */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* thisBB;		/* Pointer to a basic block being deleted */
    BasicBlock* nextBB;		/* Pointer to a deleted basic block's
				 * successor */

    /*
     * Free all the basic block structures.
     */

    for (thisBB = assemEnvPtr->head_bb; thisBB != NULL; thisBB = nextBB) {
	if (thisBB->jumpTarget != NULL) {
	    Tcl_DecrRefCount(thisBB->jumpTarget);
	}
	if (thisBB->foreignExceptions != NULL) {
	    Tcl_Free(thisBB->foreignExceptions);
	}
	nextBB = thisBB->successor1;
	if (thisBB->jtPtr != NULL) {
	    DeleteMirrorJumpTable(thisBB->jtPtr);
	    thisBB->jtPtr = NULL;
	}
	Tcl_Free(thisBB);
    }

    /*
     * Dispose what's left.
     */

    Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
    TclStackFree(interp, assemEnvPtr->parsePtr);
    TclStackFree(interp, assemEnvPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * AssembleOneLine --
 *
 *	Assembles a single command from an assembly language source.
 *
 * Results:
 *	Returns TCL_ERROR with an appropriate error message if the assembly
 *	fails. Returns TCL_OK if the assembly succeeds. Updates the assembly
 *	environment with the state of the assembly.
 *
 *-----------------------------------------------------------------------------
 */

static int
AssembleOneLine(
    AssemblyEnv* assemEnvPtr)	/* State of the assembly */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment being used for code
				 * gen */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
				/* Parse of the line of code */
    Tcl_Token* tokenPtr;	/* Current token within the line of code */
    Tcl_Obj* instNameObj;	/* Name of the instruction */
    int tblIdx;			/* Index in TalInstructionTable of the
				 * instruction */
    TalInstType instType;	/* Type of the instruction */
    Tcl_Obj* operand1Obj = NULL;
				/* First operand to the instruction */
    const char* operand1;	/* String rep of the operand */
    size_t operand1Len;		/* String length of the operand */
    int opnd;			/* Integer representation of an operand */
    int litIndex;		/* Literal pool index of a constant */
    int localVar;		/* LVT index of a local variable */
    int flags;			/* Flags for a basic block */
    JumptableInfo* jtPtr;	/* Pointer to a jumptable */
    int infoIndex;		/* Index of the jumptable in auxdata */
    int status = TCL_ERROR;	/* Return value from this function */

    /*
     * Make sure that the instruction name is known at compile time.
     */

    tokenPtr = parsePtr->tokenPtr;
    if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Look up the instruction name.
     */

    if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
	    &TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
	    TCL_EXACT, &tblIdx) != TCL_OK) {
	goto cleanup;
    }

    /*
     * Vector on the type of instruction being processed.
     */

    instType = TalInstructionTable[tblIdx].instType;
    switch (instType) {

    case ASSEM_PUSH:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "value");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
	BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
	break;

    case ASSEM_1BYTE:
	if (parsePtr->numWords != 1) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
	    goto cleanup;
	}
	BBEmitOpcode(assemEnvPtr, tblIdx, 0);
	break;

    case ASSEM_BEGIN_CATCH:
	/*
	 * Emit the BEGIN_CATCH instruction with the code offset of the
	 * exception branch target instead of the exception range index. The
	 * correct index will be generated and inserted later, when catches
	 * are being resolved.
	 */

	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
	BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
	assemEnvPtr->curr_bb->flags |= BB_BEGINCATCH;
	StartBasicBlock(assemEnvPtr, BB_FALLTHRU, operand1Obj);
	break;

    case ASSEM_BOOL:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
	    goto cleanup;
	}
	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
	break;

    case ASSEM_BOOL_LVT4:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
	    goto cleanup;
	}
	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_CLOCK_READ:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	if (opnd < 0 || opnd > 3) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj("operand must be [0..3]", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND<0,>3", NULL);
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_CONCAT1:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckOneByte(interp, opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_DICT_GET:
    case ASSEM_DICT_GET_DEF:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
	break;

    case ASSEM_DICT_SET:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_DICT_UNSET:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	TclEmitInt4(localVar, envPtr);
	break;

    case ASSEM_END_CATCH:
	if (parsePtr->numWords != 1) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "");
	    goto cleanup;
	}
	assemEnvPtr->curr_bb->flags |= BB_ENDCATCH;
	BBEmitOpcode(assemEnvPtr, tblIdx, 0);
	StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
	break;

    case ASSEM_EVAL:
	/* TODO - Refactor this stuff into a subroutine that takes the inst
	 * code, the message ("script" or "expression") and an evaluator
	 * callback that calls TclCompileScript or TclCompileExpr. */

	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj,
		    ((TalInstructionTable[tblIdx].tclInstCode
		    == INST_EVAL_STK) ? "script" : "expression"));
	    goto cleanup;
	}
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    CompileEmbeddedScript(assemEnvPtr, tokenPtr+1,
		    TalInstructionTable+tblIdx);
	} else if (GetNextOperand(assemEnvPtr, &tokenPtr,
		&operand1Obj) != TCL_OK) {
	    goto cleanup;
	} else {
	    operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
	    litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);

	    /*
	     * Assumes that PUSH is the first slot!
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
	    BBEmitOpcode(assemEnvPtr, tblIdx, 0);
	}
	break;

    case ASSEM_INVOKE:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}

	BBEmitInst1or4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_JUMP:
    case ASSEM_JUMP4:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "label");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
	if (instType == ASSEM_JUMP) {
	    flags = BB_JUMP1;
	    BBEmitInstInt1(assemEnvPtr, tblIdx, 0, 0);
	} else {
	    flags = 0;
	    BBEmitInstInt4(assemEnvPtr, tblIdx, 0, 0);
	}

	/*
	 * Start a new basic block at the instruction following the jump.
	 */

	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
	if (TalInstructionTable[tblIdx].operandsConsumed != 0) {
	    flags |= BB_FALLTHRU;
	}
	StartBasicBlock(assemEnvPtr, flags, operand1Obj);
	break;

    case ASSEM_JUMPTABLE:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "table");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}

	jtPtr = (JumptableInfo*)Tcl_Alloc(sizeof(JumptableInfo));

	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
	assemEnvPtr->curr_bb->jumpLine = assemEnvPtr->cmdLine;
	assemEnvPtr->curr_bb->jumpOffset = envPtr->codeNext-envPtr->codeStart;
	DEBUG_PRINT("bb %p jumpLine %d jumpOffset %d\n",
		assemEnvPtr->curr_bb, assemEnvPtr->cmdLine,
		envPtr->codeNext - envPtr->codeStart);

	infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
	DEBUG_PRINT("auxdata index=%d\n", infoIndex);

	BBEmitInstInt4(assemEnvPtr, tblIdx, infoIndex, 0);
	if (CreateMirrorJumpTable(assemEnvPtr, operand1Obj) != TCL_OK) {
	    goto cleanup;
	}
	StartBasicBlock(assemEnvPtr, BB_JUMPTABLE|BB_FALLTHRU, NULL);
	break;

    case ASSEM_LABEL:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "name");
	    goto cleanup;
	}
	if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
	    goto cleanup;
	}

	/*
	 * Add the (label_name, address) pair to the hash table.
	 */

	if (DefineLabel(assemEnvPtr, TclGetString(operand1Obj)) != TCL_OK) {
	    goto cleanup;
	}
	break;

    case ASSEM_LINDEX_MULTI:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckStrictlyPositive(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_LIST:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckNonNegative(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_INDEX:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetListIndexOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_LSET_FLAT:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	if (opnd < 2) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("operand must be >=2", -1));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "OPERAND>=2", NULL);
	    }
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_LVT:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_LVT1:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0 || CheckOneByte(interp, localVar)) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_LVT1_SINT1:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0 || CheckOneByte(interp, localVar)
		|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckSignedOneByte(interp, opnd)) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
	TclEmitInt1(opnd, envPtr);
	break;

    case ASSEM_LVT4:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
	break;

    case ASSEM_OVER:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckNonNegative(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
	break;

    case ASSEM_REGEXP:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean");
	    goto cleanup;
	}
	if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	{
	    BBEmitInstInt1(assemEnvPtr, tblIdx, TCL_REG_ADVANCED | (opnd ? TCL_REG_NOCASE : 0), 0);
	}
	break;

    case ASSEM_REVERSE:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckNonNegative(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
	break;

    case ASSEM_SINT1:
	if (parsePtr->numWords != 2) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "imm8");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
		|| CheckSignedOneByte(interp, opnd) != TCL_OK) {
	    goto cleanup;
	}
	BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
	break;

    case ASSEM_SINT4_LVT4:
	if (parsePtr->numWords != 3) {
	    Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
	    goto cleanup;
	}
	if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
	    goto cleanup;
	}
	localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
	if (localVar < 0) {
	    goto cleanup;
	}
	BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
	TclEmitInt4(localVar, envPtr);
	break;

    default:
	Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
		TclGetString(instNameObj));
    }

    status = TCL_OK;
 cleanup:
    Tcl_DecrRefCount(instNameObj);
    if (operand1Obj) {
	Tcl_DecrRefCount(operand1Obj);
    }
    return status;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CompileEmbeddedScript --
 *
 *	Compile an embedded 'eval' or 'expr' that appears in assembly code.
 *
 * This procedure is called when the 'eval' or 'expr' assembly directive is
 * encountered, and the argument to the directive is a simple word that
 * requires no substitution. The appropriate compiler (TclCompileScript or
 * TclCompileExpr) is invoked recursively, and emits bytecode.
 *
 * Before the compiler is invoked, the compilation environment's stack
 * consumption is reset to zero. Upon return from the compilation, the net
 * stack effect of the compilation is in the compiler env, and this stack
 * effect is posted to the assembler environment. The compile environment's
 * stack consumption is then restored to what it was before (which is actually
 * the state of the stack on entry to the block of assembly code).
 *
 * Any exception ranges pushed by the compilation are copied to the basic
 * block and removed from the compiler environment. They will be rebuilt at
 * the end of assembly, when the exception stack depth is actually known.
 *
 *-----------------------------------------------------------------------------
 */

static void
CompileEmbeddedScript(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token* tokenPtr,	/* Tcl_Token containing the script */
    const TalInstDesc* instPtr)	/* Instruction that determines whether
				 * the script is 'expr' or 'eval' */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */

    /*
     * The expression or script is not only known at compile time, but
     * actually a "simple word". It can be compiled inline by invoking the
     * compiler recursively.
     *
     * Save away the stack depth and reset it before compiling the script.
     * We'll record the stack usage of the script in the BasicBlock, and
     * accumulate it together with the stack usage of the enclosing assembly
     * code.
     */

    int savedStackDepth = envPtr->currStackDepth;
    int savedMaxStackDepth = envPtr->maxStackDepth;
    int savedExceptArrayNext = envPtr->exceptArrayNext;

    envPtr->currStackDepth = 0;
    envPtr->maxStackDepth = 0;

    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
    switch(instPtr->tclInstCode) {
    case INST_EVAL_STK:
	TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr);
	break;
    case INST_EXPR_STK:
	TclCompileExpr(interp, tokenPtr->start, tokenPtr->size, envPtr, 1);
	break;
    default:
	Tcl_Panic("no ASSEM_EVAL case for %s (%d), can't happen",
		instPtr->name, instPtr->tclInstCode);
    }

    /*
     * Roll up the stack usage of the embedded block into the assembler
     * environment.
     */

    SyncStackDepth(assemEnvPtr);
    envPtr->currStackDepth = savedStackDepth;
    envPtr->maxStackDepth = savedMaxStackDepth;

    /*
     * Save any exception ranges that were pushed by the compiler; they will
     * need to be fixed up once the stack depth is known.
     */

    MoveExceptionRangesToBasicBlock(assemEnvPtr, savedExceptArrayNext);

    /*
     * Flush the current basic block.
     */

    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);
}

/*
 *-----------------------------------------------------------------------------
 *
 * SyncStackDepth --
 *
 *	Copies the stack depth from the compile environment to a basic block.
 *
 * Side effects:
 *	Current and max stack depth in the current basic block are adjusted.
 *
 * This procedure is called on return from invoking the compiler for the
 * 'eval' and 'expr' operations. It adjusts the stack depth of the current
 * basic block to reflect the stack required by the just-compiled code.
 *
 *-----------------------------------------------------------------------------
 */

static void
SyncStackDepth(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
				/* Current basic block */
    int maxStackDepth = curr_bb->finalStackDepth + envPtr->maxStackDepth;
				/* Max stack depth in the basic block */

    if (maxStackDepth > curr_bb->maxStackDepth) {
	curr_bb->maxStackDepth = maxStackDepth;
    }
    curr_bb->finalStackDepth += envPtr->currStackDepth;
}

/*
 *-----------------------------------------------------------------------------
 *
 * MoveExceptionRangesToBasicBlock --
 *
 *	Removes exception ranges that were created by compiling an embedded
 *	script from the CompileEnv, and stores them in the BasicBlock. They
 *	will be reinstalled, at the correct stack depth, after control flow
 *	analysis is complete on the assembly code.
 *
 *-----------------------------------------------------------------------------
 */

static void
MoveExceptionRangesToBasicBlock(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int savedExceptArrayNext)	/* Saved index of the end of the exception
				 * range array */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
				/* Current basic block */
    int exceptionCount = envPtr->exceptArrayNext - savedExceptArrayNext;
				/* Number of ranges that must be moved */
    int i;

    if (exceptionCount == 0) {
	/* Nothing to do */
	return;
    }

    /*
     * Save the exception ranges in the basic block. They will be re-added at
     * the conclusion of assembly; at this time, the INST_BEGIN_CATCH
     * instructions in the block will be adjusted from whatever range indices
     * they have [savedExceptArrayNext .. envPtr->exceptArrayNext) to the
     * indices that the exceptions acquire. The saved exception ranges are
     * converted to a relative nesting depth. The depth will be recomputed
     * once flow analysis has determined the actual stack depth of the block.
     */

    DEBUG_PRINT("basic block %p has %d exceptions starting at %d\n",
	    curr_bb, exceptionCount, savedExceptArrayNext);
    curr_bb->foreignExceptionBase = savedExceptArrayNext;
    curr_bb->foreignExceptionCount = exceptionCount;
    curr_bb->foreignExceptions =
    		(ExceptionRange*)Tcl_Alloc(exceptionCount * sizeof(ExceptionRange));
    memcpy(curr_bb->foreignExceptions,
	    envPtr->exceptArrayPtr + savedExceptArrayNext,
	    exceptionCount * sizeof(ExceptionRange));
    for (i = 0; i < exceptionCount; ++i) {
	curr_bb->foreignExceptions[i].nestingLevel -= envPtr->exceptDepth;
    }
    envPtr->exceptArrayNext = savedExceptArrayNext;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CreateMirrorJumpTable --
 *
 *	Makes a jump table with comparison values and assembly code labels.
 *
 * Results:
 *	Returns a standard Tcl status, with an error message in the
 *	interpreter on error.
 *
 * Side effects:
 *	Initializes the jump table pointer in the current basic block to a
 *	JumptableInfo. The keys in the JumptableInfo are the comparison
 *	strings. The values, instead of being jump displacements, are
 *	Tcl_Obj's with the code labels.
 */

static int
CreateMirrorJumpTable(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Obj* jumps)		/* List of alternating keywords and labels */
{
    int objc;			/* Number of elements in the 'jumps' list */
    Tcl_Obj** objv;		/* Pointers to the elements in the list */
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* bbPtr = assemEnvPtr->curr_bb;
				/* Current basic block */
    JumptableInfo* jtPtr;
    Tcl_HashTable* jtHashPtr;	/* Hashtable in the JumptableInfo */
    Tcl_HashEntry* hashEntry;	/* Entry for a key in the hashtable */
    int isNew;			/* Flag==1 if the key is not yet in the
				 * table. */
    int i;

    if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (objc % 2 != 0) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "jump table must have an even number of list elements",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADJUMPTABLE", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Allocate the jumptable.
     */

    jtPtr = (JumptableInfo*)Tcl_Alloc(sizeof(JumptableInfo));
    jtHashPtr = &jtPtr->hashTable;
    Tcl_InitHashTable(jtHashPtr, TCL_STRING_KEYS);

    /*
     * Fill the keys and labels into the table.
     */

    DEBUG_PRINT("jump table {\n");
    for (i = 0; i < objc; i+=2) {
	DEBUG_PRINT("  %s -> %s\n", TclGetString(objv[i]),
		TclGetString(objv[i+1]));
	hashEntry = Tcl_CreateHashEntry(jtHashPtr, TclGetString(objv[i]),
		&isNew);
	if (!isNew) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"duplicate entry in jump table for \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
		DeleteMirrorJumpTable(jtPtr);
		return TCL_ERROR;
	    }
	}
	Tcl_SetHashValue(hashEntry, objv[i+1]);
	Tcl_IncrRefCount(objv[i+1]);
    }
    DEBUG_PRINT("}\n");

    /*
     * Put the mirror jumptable in the basic block struct.
     */

    bbPtr->jtPtr = jtPtr;
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * DeleteMirrorJumpTable --
 *
 *	Cleans up a jump table when the basic block is deleted.
 *
 *-----------------------------------------------------------------------------
 */

static void
DeleteMirrorJumpTable(
    JumptableInfo* jtPtr)
{
    Tcl_HashTable* jtHashPtr = &jtPtr->hashTable;
				/* Hash table pointer */
    Tcl_HashSearch search;	/* Hash search control */
    Tcl_HashEntry* entry;	/* Hash table entry containing a jump label */
    Tcl_Obj* label;		/* Jump label from the hash table */

    for (entry = Tcl_FirstHashEntry(jtHashPtr, &search);
	    entry != NULL;
	    entry = Tcl_NextHashEntry(&search)) {
	label = (Tcl_Obj*)Tcl_GetHashValue(entry);
	Tcl_DecrRefCount(label);
	Tcl_SetHashValue(entry, NULL);
    }
    Tcl_DeleteHashTable(jtHashPtr);
    Tcl_Free(jtPtr);
}

/*
 *-----------------------------------------------------------------------------
 *
 * GetNextOperand --
 *
 *	Retrieves the next operand in sequence from an assembly instruction,
 *	and makes sure that its value is known at compile time.
 *
 * Results:
 *	If successful, returns TCL_OK and leaves a Tcl_Obj with the operand
 *	text in *operandObjPtr. In case of failure, returns TCL_ERROR and
 *	leaves *operandObjPtr untouched.
 *
 * Side effects:
 *	Advances *tokenPtrPtr around the token just processed.
 *
 *-----------------------------------------------------------------------------
 */

static int
GetNextOperand(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token** tokenPtrPtr,	/* INPUT/OUTPUT: Pointer to the token holding
				 * the operand */
    Tcl_Obj** operandObjPtr)	/* OUTPUT: Tcl object holding the operand text
				 * with \-substitutions done. */
{
    Tcl_Interp* interp = (Tcl_Interp*) assemEnvPtr->envPtr->iPtr;
    Tcl_Obj* operandObj;

    TclNewObj(operandObj);
    if (!TclWordKnownAtCompileTime(*tokenPtrPtr, operandObj)) {
	Tcl_DecrRefCount(operandObj);
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "assembly code may not contain substitutions", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOSUBST", NULL);
	}
	return TCL_ERROR;
    }
    *tokenPtrPtr = TokenAfter(*tokenPtrPtr);
    Tcl_IncrRefCount(operandObj);
    *operandObjPtr = operandObj;
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * GetBooleanOperand --
 *
 *	Retrieves a Boolean operand from the input stream and advances
 *	the token pointer.
 *
 * Results:
 *	Returns a standard Tcl result (with an error message in the
 *	interpreter on failure).
 *
 * Side effects:
 *	Stores the Boolean value in (*result) and advances (*tokenPtrPtr)
 *	to the next token.
 *
 *-----------------------------------------------------------------------------
 */

static int
GetBooleanOperand(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
    int* result)		/* OUTPUT: Integer extracted from the token */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */
    Tcl_Obj* intObj;		/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */

    status = Tcl_GetBooleanFromObj(interp, intObj, result);
    Tcl_DecrRefCount(intObj);
    *tokenPtrPtr = TokenAfter(tokenPtr);
    return status;
}

/*
 *-----------------------------------------------------------------------------
 *
 * GetIntegerOperand --
 *
 *	Retrieves an integer operand from the input stream and advances the
 *	token pointer.
 *
 * Results:
 *	Returns a standard Tcl result (with an error message in the
 *	interpreter on failure).
 *
 * Side effects:
 *	Stores the integer value in (*result) and advances (*tokenPtrPtr) to
 *	the next token.
 *
 *-----------------------------------------------------------------------------
 */

static int
GetIntegerOperand(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
    int* result)		/* OUTPUT: Integer extracted from the token */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */
    Tcl_Obj* intObj;		/* Integer from the source code */
    int status;			/* Tcl status return */

    /*
     * Extract the next token as a string.
     */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Convert to an integer, advance to the next token and return.
     */

    status = Tcl_GetIntFromObj(interp, intObj, result);
    Tcl_DecrRefCount(intObj);
    *tokenPtrPtr = TokenAfter(tokenPtr);
    return status;
}

/*
 *-----------------------------------------------------------------------------
 *
 * GetListIndexOperand --
 *
 *	Gets the value of an operand intended to serve as a list index.
 *
 * Results:
 *	Returns a standard Tcl result: TCL_OK if the parse is successful and
 *	TCL_ERROR (with an appropriate error message) if the parse fails.
 *
 * Side effects:
 *	Stores the list index at '*index'. Values between -1 and 0x7FFFFFFF
 *	have their natural meaning; values between -2 and -0x80000000
 *	represent 'end-2-N'.
 *
 *-----------------------------------------------------------------------------
 */

static int
GetListIndexOperand(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token** tokenPtrPtr,	/* Current token from the parser */
    int* result)		/* OUTPUT: Integer extracted from the token */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code */
    Tcl_Obj *value;
    int status;

    /* General operand validity check */
    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
	return TCL_ERROR;
    }

    /* Convert to an integer, advance to the next token and return. */
    /*
     * NOTE: Indexing a list with an index before it yields the
     * same result as indexing after it, and might be more easily portable
     * when list size limits grow.
     */
    status = TclIndexEncode(interp, value,
	    TCL_INDEX_NONE,TCL_INDEX_NONE, result);

    Tcl_DecrRefCount(value);
    *tokenPtrPtr = TokenAfter(tokenPtr);
    return status;
}

/*
 *-----------------------------------------------------------------------------
 *
 * FindLocalVar --
 *
 *	Gets the name of a local variable from the input stream and advances
 *	the token pointer.
 *
 * Results:
 *	Returns the LVT index of the local variable.  Returns -1 if the
 *	variable is non-local, not known at compile time, or cannot be
 *	installed in the LVT (leaving an error message in the interpreter
 *	result if necessary).
 *
 * Side effects:
 *	Advances the token pointer.  May define a new LVT slot if the variable
 *	has not yet been seen and the execution context allows for it.
 *
 *-----------------------------------------------------------------------------
 */

static int
FindLocalVar(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    Tcl_Token** tokenPtrPtr)
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Token* tokenPtr = *tokenPtrPtr;
				/* INOUT: Pointer to the next token in the
				 * source code. */
    Tcl_Obj* varNameObj;	/* Name of the variable */
    const char* varNameStr;
    size_t varNameLen;
    int localVar;		/* Index of the variable in the LVT */

    if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
	return -1;
    }
    varNameStr = TclGetStringFromObj(varNameObj, &varNameLen);
    if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
	Tcl_DecrRefCount(varNameObj);
	return -1;
    }
    localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
    Tcl_DecrRefCount(varNameObj);
    if (localVar == -1) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot use this instruction to create a variable"
		    " in a non-proc context", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "LVT", NULL);
	}
	return -1;
    }
    *tokenPtrPtr = TokenAfter(tokenPtr);
    return localVar;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckNamespaceQualifiers --
 *
 *	Verify that a variable name has no namespace qualifiers before
 *	attempting to install it in the LVT.
 *
 * Results:
 *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
 *	an error message in the interpreter result.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckNamespaceQualifiers(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    const char* name,		/* Variable name to check */
    int nameLen)		/* Length of the variable */
{
    const char* p;

    for (p = name; p+2 < name+nameLen;  p++) {
	if ((*p == ':') && (p[1] == ':')) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "variable \"%s\" is not local", name));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckOneByte --
 *
 *	Verify that a constant fits in a single byte in the instruction
 *	stream.
 *
 * Results:
 *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
 *	an error message in the interpreter result.
 *
 * This code is here primarily to verify that instructions like INCR_SCALAR1
 * are possible on a given local variable. The fact that there is no
 * INCR_SCALAR4 is puzzling.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckOneByte(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value < 0 || value > 0xFF) {
	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckSignedOneByte --
 *
 *	Verify that a constant fits in a single signed byte in the instruction
 *	stream.
 *
 * Results:
 *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
 *	an error message in the interpreter result.
 *
 * This code is here primarily to verify that instructions like INCR_SCALAR1
 * are possible on a given local variable. The fact that there is no
 * INCR_SCALAR4 is puzzling.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckSignedOneByte(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value > 0x7F || value < -0x80) {
	result = Tcl_NewStringObj("operand does not fit in one byte", -1);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "1BYTE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckNonNegative --
 *
 *	Verify that a constant is nonnegative
 *
 * Results:
 *	On success, returns TCL_OK. On failure, returns TCL_ERROR and stores
 *	an error message in the interpreter result.
 *
 * This code is here primarily to verify that instructions like INCR_INVOKE
 * are consuming a positive number of operands
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckNonNegative(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value < 0) {
	result = Tcl_NewStringObj("operand must be nonnegative", -1);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONNEGATIVE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckStrictlyPositive --
 *
 *	Verify that a constant is positive
 *
 * Results:
 *	On success, returns TCL_OK. On failure, returns TCL_ERROR and
 *	stores an error message in the interpreter result.
 *
 * This code is here primarily to verify that instructions like INCR_INVOKE
 * are consuming a positive number of operands
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckStrictlyPositive(
    Tcl_Interp* interp,		/* Tcl interpreter for error reporting */
    int value)			/* Value to check */
{
    Tcl_Obj* result;		/* Error message */

    if (value <= 0) {
	result = Tcl_NewStringObj("operand must be positive", -1);
	Tcl_SetObjResult(interp, result);
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "POSITIVE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * DefineLabel --
 *
 *	Defines a label appearing in the assembly sequence.
 *
 * Results:
 *	Returns a standard Tcl result. Returns TCL_OK and an empty result if
 *	the definition succeeds; returns TCL_ERROR and an appropriate message
 *	if a duplicate definition is found.
 *
 *-----------------------------------------------------------------------------
 */

static int
DefineLabel(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    const char* labelName)	/* Label being defined */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_HashEntry* entry;	/* Label's entry in the symbol table */
    int isNew;			/* Flag == 1 iff the label was previously
				 * undefined */

    /* TODO - This can now be simplified! */

    StartBasicBlock(assemEnvPtr, BB_FALLTHRU, NULL);

    /*
     * Look up the newly-defined label in the symbol table.
     */

    entry = Tcl_CreateHashEntry(&assemEnvPtr->labelHash, labelName, &isNew);
    if (!isNew) {
	/*
	 * This is a duplicate label.
	 */

	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "duplicate definition of label \"%s\"", labelName));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
		    NULL);
	}
	return TCL_ERROR;
    }

    /*
     * This is the first appearance of the label in the code.
     */

    Tcl_SetHashValue(entry, assemEnvPtr->curr_bb);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * StartBasicBlock --
 *
 *	Starts a new basic block when a label or jump is encountered.
 *
 * Results:
 *	Returns a pointer to the BasicBlock structure of the new
 *	basic block.
 *
 *-----------------------------------------------------------------------------
 */

static BasicBlock*
StartBasicBlock(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int flags,			/* Flags to apply to the basic block being
				 * closed, if there is one. */
    Tcl_Obj* jumpLabel)		/* Label of the location that the block jumps
				 * to, or NULL if the block does not jump */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* newBB;		/* BasicBlock structure for the new block */
    BasicBlock* currBB = assemEnvPtr->curr_bb;

    /*
     * Coalesce zero-length blocks.
     */

    if (currBB->startOffset == envPtr->codeNext - envPtr->codeStart) {
	currBB->startLine = assemEnvPtr->cmdLine;
	return currBB;
    }

    /*
     * Make the new basic block.
     */

    newBB = AllocBB(assemEnvPtr);

    /*
     * Record the jump target if there is one.
     */

    currBB->jumpTarget = jumpLabel;
    if (jumpLabel != NULL) {
	Tcl_IncrRefCount(currBB->jumpTarget);
    }

    /*
     * Record the fallthrough if there is one.
     */

    currBB->flags |= flags;

    /*
     * Record the successor block.
     */

    currBB->successor1 = newBB;
    assemEnvPtr->curr_bb = newBB;
    return newBB;
}

/*
 *-----------------------------------------------------------------------------
 *
 * AllocBB --
 *
 *	Allocates a new basic block
 *
 * Results:
 *	Returns a pointer to the newly allocated block, which is initialized
 *	to contain no code and begin at the current instruction pointer.
 *
 *-----------------------------------------------------------------------------
 */

static BasicBlock *
AllocBB(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
    BasicBlock *bb = (BasicBlock*)Tcl_Alloc(sizeof(BasicBlock));

    bb->originalStartOffset =
	    bb->startOffset = envPtr->codeNext - envPtr->codeStart;
    bb->startLine = assemEnvPtr->cmdLine + 1;
    bb->jumpOffset = -1;
    bb->jumpLine = -1;
    bb->prevPtr = assemEnvPtr->curr_bb;
    bb->predecessor = NULL;
    bb->successor1 = NULL;
    bb->jumpTarget = NULL;
    bb->initialStackDepth = 0;
    bb->minStackDepth = 0;
    bb->maxStackDepth = 0;
    bb->finalStackDepth = 0;
    bb->catchDepth = 0;
    bb->enclosingCatch = NULL;
    bb->foreignExceptionBase = -1;
    bb->foreignExceptionCount = 0;
    bb->foreignExceptions = NULL;
    bb->jtPtr = NULL;
    bb->flags = 0;

    return bb;
}

/*
 *-----------------------------------------------------------------------------
 *
 * FinishAssembly --
 *
 *	Postprocessing after all bytecode has been generated for a block of
 *	assembly code.
 *
 * Results:
 *	Returns a standard Tcl result, with an error message left in the
 *	interpreter if appropriate.
 *
 * Side effects:
 *	The program is checked to see if any undefined labels remain.  The
 *	initial stack depth of all the basic blocks in the flow graph is
 *	calculated and saved.  The stack balance on exit is computed, checked
 *	and saved.
 *
 *-----------------------------------------------------------------------------
 */

static int
FinishAssembly(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    int mustMove;		/* Amount by which the code needs to be grown
				 * because of expanding jumps */

    /*
     * Resolve the targets of all jumps and determine whether code needs to be
     * moved around.
     */

    if (CalculateJumpRelocations(assemEnvPtr, &mustMove)) {
	return TCL_ERROR;
    }

    /*
     * Move the code if necessary.
     */

    if (mustMove) {
	MoveCodeForJumps(assemEnvPtr, mustMove);
    }

    /*
     * Resolve jump target labels to bytecode offsets.
     */

    FillInJumpOffsets(assemEnvPtr);

    /*
     * Label each basic block with its catch context. Quit on inconsistency.
     */

    if (ProcessCatches(assemEnvPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Make sure that no block accessible from a catch's error exit that hasn't
     * popped the exception stack can throw an exception.
     */

    if (CheckForThrowInWrongContext(assemEnvPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Compute stack balance throughout the program.
     */

    if (CheckStack(assemEnvPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * TODO - Check for unreachable code. Or maybe not; unreachable code is
     * Mostly Harmless.
     */

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CalculateJumpRelocations --
 *
 *	Calculate any movement that has to be done in the assembly code to
 *	expand JUMP1 instructions to JUMP4 (because they jump more than a
 *	1-byte range).
 *
 * Results:
 *	Returns a standard Tcl result, with an appropriate error message if
 *	anything fails.
 *
 * Side effects:
 *	Sets the 'startOffset' pointer in every basic block to the new origin
 *	of the block, and turns off JUMP1 flags on instructions that must be
 *	expanded (and adjusts them to the corresponding JUMP4's).  Does *not*
 *	store the jump offsets at this point.
 *
 *	Sets *mustMove to 1 if and only if at least one instruction changed
 *	size so the code must be moved.
 *
 *	As a side effect, also checks for undefined labels and reports them.
 *
 *-----------------------------------------------------------------------------
 */

static int
CalculateJumpRelocations(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    int* mustMove)		/* OUTPUT: Number of bytes that have been
				 * added to the code */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
    Tcl_HashEntry* entry;	/* Exit label's entry in the symbol table */
    BasicBlock* jumpTarget;	/* Basic block where the jump goes */
    int motion;			/* Amount by which the code has expanded */
    int offset;			/* Offset in the bytecode from a jump
				 * instruction to its target */
    unsigned opcode;		/* Opcode in the bytecode being adjusted */

    /*
     * Iterate through basic blocks as long as a change results in code
     * expansion.
     */

    *mustMove = 0;
    do {
	motion = 0;
	for (bbPtr = assemEnvPtr->head_bb;
		bbPtr != NULL;
		bbPtr = bbPtr->successor1) {
	    /*
	     * Advance the basic block start offset by however many bytes we
	     * have inserted in the code up to this point
	     */

	    bbPtr->startOffset += motion;

	    /*
	     * If the basic block references a label (and hence performs a
	     * jump), find the location of the label. Report an error if the
	     * label is missing.
	     */

	    if (bbPtr->jumpTarget != NULL) {
		entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
			TclGetString(bbPtr->jumpTarget));
		if (entry == NULL) {
		    ReportUndefinedLabel(assemEnvPtr, bbPtr,
			    bbPtr->jumpTarget);
		    return TCL_ERROR;
		}

		/*
		 * If the instruction is a JUMP1, turn it into a JUMP4 if its
		 * target is out of range.
		 */

		jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
		if (bbPtr->flags & BB_JUMP1) {
		    offset = jumpTarget->startOffset
			    - (bbPtr->jumpOffset + motion);
		    if (offset < -0x80 || offset > 0x7F) {
			opcode = TclGetUInt1AtPtr(envPtr->codeStart
				+ bbPtr->jumpOffset);
			++opcode;
			TclStoreInt1AtPtr(opcode,
				envPtr->codeStart + bbPtr->jumpOffset);
			motion += 3;
			bbPtr->flags &= ~BB_JUMP1;
		    }
		}
	    }

	    /*
	     * If the basic block references a jump table, that doesn't affect
	     * the code locations, but resolve the labels now, and store basic
	     * block pointers in the jumptable hash.
	     */

	    if (bbPtr->flags & BB_JUMPTABLE) {
		if (CheckJumpTableLabels(assemEnvPtr, bbPtr) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	}
	*mustMove += motion;
    } while (motion != 0);

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckJumpTableLabels --
 *
 *	Make sure that all the labels in a jump table are defined.
 *
 * Results:
 *	Returns TCL_OK if they are, TCL_ERROR if they aren't.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckJumpTableLabels(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* bbPtr)		/* Basic block that ends in a jump table */
{
    Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
				/* Hash table with the symbols */
    Tcl_HashSearch search;	/* Hash table iterator */
    Tcl_HashEntry* symEntryPtr;	/* Hash entry for the symbols */
    Tcl_Obj* symbolObj;		/* Jump target */
    Tcl_HashEntry* valEntryPtr;	/* Hash entry for the resolutions */

    /*
     * Look up every jump target in the jump hash.
     */

    DEBUG_PRINT("check jump table labels %p {\n", bbPtr);
    for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
	    symEntryPtr != NULL;
	    symEntryPtr = Tcl_NextHashEntry(&search)) {
	symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr);
	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		TclGetString(symbolObj));
	DEBUG_PRINT("  %s -> %s (%d)\n",
		(char *)Tcl_GetHashKey(symHash, symEntryPtr),
		TclGetString(symbolObj), (valEntryPtr != NULL));
	if (valEntryPtr == NULL) {
	    ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
	    return TCL_ERROR;
	}
    }
    DEBUG_PRINT("}\n");
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ReportUndefinedLabel --
 *
 *	Report that a basic block refers to an undefined jump label
 *
 * Side effects:
 *	Stores an error message, error code, and line number information in
 *	the assembler's Tcl interpreter.
 *
 *-----------------------------------------------------------------------------
 */

static void
ReportUndefinedLabel(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* bbPtr,		/* Basic block that contains the undefined
				 * label */
    Tcl_Obj* jumpTarget)	/* Label of a jump target */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */

    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"undefined label \"%s\"", TclGetString(jumpTarget)));
	Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
		TclGetString(jumpTarget), NULL);
	Tcl_SetErrorLine(interp, bbPtr->jumpLine);
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * MoveCodeForJumps --
 *
 *	Move bytecodes in memory to accommodate JUMP1 instructions that have
 *	expanded to become JUMP4's.
 *
 *-----------------------------------------------------------------------------
 */

static void
MoveCodeForJumps(
    AssemblyEnv* assemEnvPtr,	/* Assembler environment */
    int mustMove)		/* Number of bytes of added code */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
    int topOffset;		/* Bytecode offset of the following basic
				 * block before code motion */

    /*
     * Make sure that there is enough space in the bytecode array to
     * accommodate the expanded code.
     */

    while (envPtr->codeEnd < envPtr->codeNext + mustMove) {
	TclExpandCodeArray(envPtr);
    }

    /*
     * Iterate through the bytecodes in reverse order, and move them upward to
     * their new homes.
     */

    topOffset = envPtr->codeNext - envPtr->codeStart;
    for (bbPtr = assemEnvPtr->curr_bb; bbPtr != NULL; bbPtr = bbPtr->prevPtr) {
	DEBUG_PRINT("move code from %d to %d\n",
		bbPtr->originalStartOffset, bbPtr->startOffset);
	memmove(envPtr->codeStart + bbPtr->startOffset,
		envPtr->codeStart + bbPtr->originalStartOffset,
		topOffset - bbPtr->originalStartOffset);
	topOffset = bbPtr->originalStartOffset;
	bbPtr->jumpOffset += (bbPtr->startOffset - bbPtr->originalStartOffset);
    }
    envPtr->codeNext += mustMove;
}

/*
 *-----------------------------------------------------------------------------
 *
 * FillInJumpOffsets --
 *
 *	Fill in the final offsets of all jump instructions once bytecode
 *	locations have been completely determined.
 *
 *-----------------------------------------------------------------------------
 */

static void
FillInJumpOffsets(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr;		/* Pointer to a basic block being checked */
    Tcl_HashEntry* entry;	/* Hashtable entry for a jump target label */
    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
    int fromOffset;		/* Bytecode location of a jump instruction */
    int targetOffset;		/* Bytecode location of a jump instruction's
				 * target */

    for (bbPtr = assemEnvPtr->head_bb;
	    bbPtr != NULL;
	    bbPtr = bbPtr->successor1) {
	if (bbPtr->jumpTarget != NULL) {
	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		    TclGetString(bbPtr->jumpTarget));
	    jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
	    fromOffset = bbPtr->jumpOffset;
	    targetOffset = jumpTarget->startOffset;
	    if (bbPtr->flags & BB_JUMP1) {
		TclStoreInt1AtPtr(targetOffset - fromOffset,
			envPtr->codeStart + fromOffset + 1);
	    } else {
		TclStoreInt4AtPtr(targetOffset - fromOffset,
			envPtr->codeStart + fromOffset + 1);
	    }
	}
	if (bbPtr->flags & BB_JUMPTABLE) {
	    ResolveJumpTableTargets(assemEnvPtr, bbPtr);
	}
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * ResolveJumpTableTargets --
 *
 *	Puts bytecode addresses for the targets of a jumptable into the
 *	table
 *
 * Results:
 *	Returns TCL_OK if they are, TCL_ERROR if they aren't.
 *
 *-----------------------------------------------------------------------------
 */

static void
ResolveJumpTableTargets(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* bbPtr)		/* Basic block that ends in a jump table */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_HashTable* symHash = &bbPtr->jtPtr->hashTable;
				/* Hash table with the symbols */
    Tcl_HashSearch search;	/* Hash table iterator */
    Tcl_HashEntry* symEntryPtr;	/* Hash entry for the symbols */
    Tcl_Obj* symbolObj;		/* Jump target */
    Tcl_HashEntry* valEntryPtr;	/* Hash entry for the resolutions */
    int auxDataIndex;		/* Index of the auxdata */
    JumptableInfo* realJumpTablePtr;
				/* Jump table in the actual code */
    Tcl_HashTable* realJumpHashPtr;
				/* Jump table hash in the actual code */
    Tcl_HashEntry* realJumpEntryPtr;
				/* Entry in the jump table hash in
				 * the actual code */
    BasicBlock* jumpTargetBBPtr;
				/* Basic block that the jump proceeds to */
    int junk;

    auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
    DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
	    bbPtr, bbPtr->jumpOffset, auxDataIndex);
    realJumpTablePtr = (JumptableInfo*)TclFetchAuxData(envPtr, auxDataIndex);
    realJumpHashPtr = &realJumpTablePtr->hashTable;

    /*
     * Look up every jump target in the jump hash.
     */

    DEBUG_PRINT("resolve jump table {\n");
    for (symEntryPtr = Tcl_FirstHashEntry(symHash, &search);
	    symEntryPtr != NULL;
	    symEntryPtr = Tcl_NextHashEntry(&search)) {
	symbolObj = (Tcl_Obj*)Tcl_GetHashValue(symEntryPtr);
	DEBUG_PRINT("     symbol %s\n", TclGetString(symbolObj));

	valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		TclGetString(symbolObj));
	jumpTargetBBPtr = (BasicBlock*)Tcl_GetHashValue(valEntryPtr);

	realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
		Tcl_GetHashKey(symHash, symEntryPtr), &junk);
	DEBUG_PRINT("  %s -> %s -> bb %p (pc %d)    hash entry %p\n",
		(char *)Tcl_GetHashKey(symHash, symEntryPtr),
		TclGetString(symbolObj), jumpTargetBBPtr,
		jumpTargetBBPtr->startOffset, realJumpEntryPtr);

	Tcl_SetHashValue(realJumpEntryPtr,
		INT2PTR(jumpTargetBBPtr->startOffset - bbPtr->jumpOffset));
    }
    DEBUG_PRINT("}\n");
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckForThrowInWrongContext --
 *
 *	Verify that no beginCatch/endCatch sequence can throw an exception
 *	after an original exception is caught and before its exception context
 *	is removed from the stack.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Stores an appropriate error message in the interpreter as needed.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckForThrowInWrongContext(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    BasicBlock* blockPtr;	/* Current basic block */

    /*
     * Walk through the basic blocks in turn, checking all the ones that have
     * caught an exception and not disposed of it properly.
     */

    for (blockPtr = assemEnvPtr->head_bb;
	    blockPtr != NULL;
	    blockPtr = blockPtr->successor1) {
	if (blockPtr->catchState == BBCS_CAUGHT) {
	    /*
	     * Walk through the instructions in the basic block.
	     */

	    if (CheckNonThrowingBlock(assemEnvPtr, blockPtr) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckNonThrowingBlock --
 *
 *	Check that a basic block cannot throw an exception.
 *
 * Results:
 *	Returns TCL_ERROR if the block cannot be proven to be nonthrowing.
 *
 * Side effects:
 *	Stashes an error message in the interpreter result.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckNonThrowingBlock(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* blockPtr)	/* Basic block where exceptions are not
				 * allowed */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* nextPtr;	/* Pointer to the succeeding basic block */
    int offset;			/* Bytecode offset of the current
				 * instruction */
    int bound;			/* Bytecode offset following the last
				 * instruction of the block. */
    unsigned char opcode;	/* Current bytecode instruction */

    /*
     * Determine where in the code array the basic block ends.
     */

    nextPtr = blockPtr->successor1;
    if (nextPtr == NULL) {
	bound = envPtr->codeNext - envPtr->codeStart;
    } else {
	bound = nextPtr->startOffset;
    }

    /*
     * Walk through the instructions of the block.
     */

    offset = blockPtr->startOffset;
    while (offset < bound) {
	/*
	 * Determine whether an instruction is nonthrowing.
	 */

	opcode = (envPtr->codeStart)[offset];
	if (BytecodeMightThrow(opcode)) {
	    /*
	     * Report an error for a throw in the wrong context.
	     */

	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" instruction may not appear in "
			"a context where an exception has been "
			"caught and not disposed of.",
			tclInstructionTable[opcode].name));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
		AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
	    }
	    return TCL_ERROR;
	}
	offset += tclInstructionTable[opcode].numBytes;
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BytecodeMightThrow --
 *
 *	Tests if a given bytecode instruction might throw an exception.
 *
 * Results:
 *	Returns 1 if the bytecode might throw an exception, 0 if the
 *	instruction is known never to throw.
 *
 *-----------------------------------------------------------------------------
 */

static int
BytecodeMightThrow(
    unsigned char opcode)
{
    /*
     * Binary search on the non-throwing bytecode list.
     */

    int min = 0;
    int max = sizeof(NonThrowingByteCodes) - 1;
    int mid;
    unsigned char c;

    while (max >= min) {
	mid = (min + max) / 2;
	c = NonThrowingByteCodes[mid];
	if (opcode < c) {
	    max = mid-1;
	} else if (opcode > c) {
	    min = mid+1;
	} else {
	    /*
	     * Opcode is nonthrowing.
	     */

	    return 0;
	}
    }

    return 1;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckStack --
 *
 *	Audit stack usage in a block of assembly code.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Updates stack depth on entry for all basic blocks in the flowgraph.
 *	Calculates the max stack depth used in the program, and updates the
 *	compilation environment to reflect it.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckStack(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    int maxDepth;		/* Maximum stack depth overall */

    /*
     * Checking the head block will check all the other blocks recursively.
     */

    assemEnvPtr->maxDepth = 0;
    if (StackCheckBasicBlock(assemEnvPtr, assemEnvPtr->head_bb, NULL,
	    0) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Post the max stack depth back to the compilation environment.
     */

    maxDepth = assemEnvPtr->maxDepth + envPtr->currStackDepth;
    if (maxDepth > envPtr->maxStackDepth) {
	envPtr->maxStackDepth = maxDepth;
    }

    /*
     * If the exit is reachable, make sure that the program exits with 1
     * operand on the stack.
     */

    if (StackCheckExit(assemEnvPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Reset the visited state on all basic blocks.
     */

    ResetVisitedBasicBlocks(assemEnvPtr);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * StackCheckBasicBlock --
 *
 *	Checks stack consumption for a basic block (and recursively for its
 *	successors).
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Updates initial stack depth for the basic block and its successors.
 *	(Final and maximum stack depth are relative to initial, and are not
 *	touched).
 *
 * This procedure eventually checks, for the entire flow graph, whether stack
 * balance is consistent.  It is an error for a given basic block to be
 * reachable along multiple flow paths with different stack depths.
 *
 *-----------------------------------------------------------------------------
 */

static int
StackCheckBasicBlock(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* blockPtr,	/* Pointer to the basic block being checked */
    BasicBlock* predecessor,	/* Pointer to the block that passed control to
				 * this one. */
    int initialStackDepth)	/* Stack depth on entry to the block */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
    int stackDepth;		/* Current stack depth */
    int maxDepth;		/* Maximum stack depth so far */
    int result;			/* Tcl status return */
    Tcl_HashSearch jtSearch;	/* Search structure for the jump table */
    Tcl_HashEntry* jtEntry;	/* Hash entry in the jump table */
    Tcl_Obj* targetLabel;	/* Target label from the jump table */
    Tcl_HashEntry* entry;	/* Hash entry in the label table */

    if (blockPtr->flags & BB_VISITED) {
	/*
	 * If the block is already visited, check stack depth for consistency
	 * among the paths that reach it.
	 */

	if (blockPtr->initialStackDepth == initialStackDepth) {
	    return TCL_OK;
	}
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "inconsistent stack depths on two execution paths", -1));

	    /*
	     * TODO - add execution trace of both paths
	     */

	    Tcl_SetErrorLine(interp, blockPtr->startLine);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * If the block is not already visited, set the 'predecessor' link to
     * indicate how control got to it. Set the initial stack depth to the
     * current stack depth in the flow of control.
     */

    blockPtr->flags |= BB_VISITED;
    blockPtr->predecessor = predecessor;
    blockPtr->initialStackDepth = initialStackDepth;

    /*
     * Calculate minimum stack depth, and flag an error if the block
     * underflows the stack.
     */

    if (initialStackDepth + blockPtr->minStackDepth < 0) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("stack underflow", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
	    Tcl_SetErrorLine(interp, blockPtr->startLine);
	}
	return TCL_ERROR;
    }

    /*
     * Make sure that the block doesn't try to pop below the stack level of an
     * enclosing catch.
     */

    if (blockPtr->enclosingCatch != 0 &&
	    initialStackDepth + blockPtr->minStackDepth
	    < (blockPtr->enclosingCatch->initialStackDepth
		+ blockPtr->enclosingCatch->finalStackDepth)) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "code pops stack below level of enclosing catch", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACKINCATCH", -1);
	    AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
	    Tcl_SetErrorLine(interp, blockPtr->startLine);
	}
	return TCL_ERROR;
    }

    /*
     * Update maximum stgack depth.
     */

    maxDepth = initialStackDepth + blockPtr->maxStackDepth;
    if (maxDepth > assemEnvPtr->maxDepth) {
	assemEnvPtr->maxDepth = maxDepth;
    }

    /*
     * Calculate stack depth on exit from the block, and invoke this procedure
     * recursively to check successor blocks.
     */

    stackDepth = initialStackDepth + blockPtr->finalStackDepth;
    result = TCL_OK;
    if (blockPtr->flags & BB_FALLTHRU) {
	result = StackCheckBasicBlock(assemEnvPtr, blockPtr->successor1,
		blockPtr, stackDepth);
    }

    if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		TclGetString(blockPtr->jumpTarget));
	jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
	result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
		stackDepth);
    }

    /*
     * All blocks referenced in a jump table are successors.
     */

    if (blockPtr->flags & BB_JUMPTABLE) {
	for (jtEntry = Tcl_FirstHashEntry(&blockPtr->jtPtr->hashTable,
		    &jtSearch);
		result == TCL_OK && jtEntry != NULL;
		jtEntry = Tcl_NextHashEntry(&jtSearch)) {
	    targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry);
	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		    TclGetString(targetLabel));
	    jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
	    result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
		    blockPtr, stackDepth);
	}
    }

    return result;
}

/*
 *-----------------------------------------------------------------------------
 *
 * StackCheckExit --
 *
 *	Makes sure that the net stack effect of an entire assembly language
 *	script is to push 1 result.
 *
 * Results:
 *	Returns a standard Tcl result, with an error message in the
 *	interpreter result if the stack is wrong.
 *
 * Side effects:
 *	If the assembly code had a net stack effect of zero, emits code to the
 *	concluding block to push a null result. In any case, updates the stack
 *	depth in the compile environment to reflect the net effect of the
 *	assembly code.
 *
 *-----------------------------------------------------------------------------
 */

static int
StackCheckExit(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    int depth;			/* Net stack effect */
    int litIndex;		/* Index in the literal pool of the empty
				 * string */
    BasicBlock* curr_bb = assemEnvPtr->curr_bb;
				/* Final basic block in the assembly */

    /*
     * Don't perform these checks if execution doesn't reach the exit (either
     * because of an infinite loop or because the only return is from the
     * middle.
     */

    if (curr_bb->flags & BB_VISITED) {
	/*
	 * Exit with no operands; push an empty one.
	 */

	depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
	if (depth == 0) {
	    /*
	     * Emit a 'push' of the empty literal.
	     */

	    litIndex = TclRegisterLiteral(envPtr, "", 0, 0);

	    /*
	     * Assumes that 'push' is at slot 0 in TalInstructionTable.
	     */

	    BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
	    ++depth;
	}

	/*
	 * Exit with unbalanced stack.
	 */

	if (depth != 1) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"stack is unbalanced on exit from the code (depth=%d)",
			depth));
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Record stack usage.
	 */

	envPtr->currStackDepth += depth;
    }

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ProcessCatches --
 *
 *	First pass of 'catch' processing.
 *
 * Results:
 *	Returns a standard Tcl result, with an appropriate error message if
 *	the result is TCL_ERROR.
 *
 * Side effects:
 *	Labels all basic blocks with their enclosing catches.
 *
 *-----------------------------------------------------------------------------
 */

static int
ProcessCatches(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    BasicBlock* blockPtr;	/* Pointer to a basic block */

    /*
     * Clear the catch state of all basic blocks.
     */

    for (blockPtr = assemEnvPtr->head_bb;
	    blockPtr != NULL;
	    blockPtr = blockPtr->successor1) {
	blockPtr->catchState = BBCS_UNKNOWN;
	blockPtr->enclosingCatch = NULL;
    }

    /*
     * Start the check recursively from the first basic block, which is
     * outside any exception context
     */

    if (ProcessCatchesInBasicBlock(assemEnvPtr, assemEnvPtr->head_bb,
	    NULL, BBCS_NONE, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check for unclosed catch on exit.
     */

    if (CheckForUnclosedCatches(assemEnvPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Now there's enough information to build the exception ranges.
     */

    if (BuildExceptionRanges(assemEnvPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Finally, restore any exception ranges from embedded scripts.
     */

    RestoreEmbeddedExceptionRanges(assemEnvPtr);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ProcessCatchesInBasicBlock --
 *
 *	First-pass catch processing for one basic block.
 *
 * Results:
 *	Returns a standard Tcl result, with error message in the interpreter
 *	result if an error occurs.
 *
 * This procedure checks consistency of the exception context through the
 * assembler program, and records the enclosing 'catch' for every basic block.
 *
 *-----------------------------------------------------------------------------
 */

static int
ProcessCatchesInBasicBlock(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* bbPtr,		/* Basic block being processed */
    BasicBlock* enclosing,	/* Start basic block of the enclosing catch */
    enum BasicBlockCatchState state,
				/* BBCS_NONE, BBCS_INCATCH, or BBCS_CAUGHT */
    int catchDepth)		/* Depth of nesting of catches */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    int result;			/* Return value from this procedure */
    BasicBlock* fallThruEnclosing;
				/* Enclosing catch if execution falls thru */
    enum BasicBlockCatchState fallThruState;
				/* Catch state of the successor block */
    BasicBlock* jumpEnclosing;	/* Enclosing catch if execution goes to jump
				 * target */
    enum BasicBlockCatchState jumpState;
				/* Catch state of the jump target */
    int changed = 0;		/* Flag == 1 iff successor blocks need to be
				 * checked because the state of this block has
				 * changed. */
    BasicBlock* jumpTarget;	/* Basic block where a jump goes */
    Tcl_HashSearch jtSearch;	/* Hash search control for a jumptable */
    Tcl_HashEntry* jtEntry;	/* Entry in a jumptable */
    Tcl_Obj* targetLabel;	/* Target label from a jumptable */
    Tcl_HashEntry* entry;	/* Entry from the label table */

    /*
     * Update the state of the current block, checking for consistency.  Set
     * 'changed' to 1 if the state changes and successor blocks need to be
     * rechecked.
     */

    if (bbPtr->catchState == BBCS_UNKNOWN) {
	bbPtr->enclosingCatch = enclosing;
    } else if (bbPtr->enclosingCatch != enclosing) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "execution reaches an instruction in inconsistent "
		    "exception contexts", -1));
	    Tcl_SetErrorLine(interp, bbPtr->startLine);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADCATCH", NULL);
	}
	return TCL_ERROR;
    }
    if (state > bbPtr->catchState) {
	bbPtr->catchState = state;
	changed = 1;
    }

    /*
     * If this block has been visited before, and its state hasn't changed,
     * we're done with it for now.
     */

    if (!changed) {
	return TCL_OK;
    }
    bbPtr->catchDepth = catchDepth;

    /*
     * Determine enclosing catch and 'caught' state for the fallthrough and
     * the jump target. Default for both is the state of the current block.
     */

    fallThruEnclosing = enclosing;
    fallThruState = state;
    jumpEnclosing = enclosing;
    jumpState = state;

    /*
     * TODO: Make sure that the test cases include validating that a natural
     * loop can't include 'beginCatch' or 'endCatch'
     */

    if (bbPtr->flags & BB_BEGINCATCH) {
	/*
	 * If the block begins a catch, the state for the successor is 'in
	 * catch'. The jump target is the exception exit, and the state of the
	 * jump target is 'caught.'
	 */

	fallThruEnclosing = bbPtr;
	fallThruState = BBCS_INCATCH;
	jumpEnclosing = bbPtr;
	jumpState = BBCS_CAUGHT;
	++catchDepth;
    }

    if (bbPtr->flags & BB_ENDCATCH) {
	/*
	 * If the block ends a catch, the state for the successor is whatever
	 * the state was on entry to the catch.
	 */

	if (enclosing == NULL) {
	    if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"endCatch without a corresponding beginCatch", -1));
		Tcl_SetErrorLine(interp, bbPtr->startLine);
		Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADENDCATCH", NULL);
	    }
	    return TCL_ERROR;
	}
	fallThruEnclosing = enclosing->enclosingCatch;
	fallThruState = enclosing->catchState;
	--catchDepth;
    }

    /*
     * Visit any successor blocks with the appropriate exception context
     */

    result = TCL_OK;
    if (bbPtr->flags & BB_FALLTHRU) {
	result = ProcessCatchesInBasicBlock(assemEnvPtr, bbPtr->successor1,
		fallThruEnclosing, fallThruState, catchDepth);
    }
    if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
	entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		TclGetString(bbPtr->jumpTarget));
	jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
	result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
		jumpEnclosing, jumpState, catchDepth);
    }

    /*
     * All blocks referenced in a jump table are successors.
     */

    if (bbPtr->flags & BB_JUMPTABLE) {
	for (jtEntry = Tcl_FirstHashEntry(&bbPtr->jtPtr->hashTable,&jtSearch);
		result == TCL_OK && jtEntry != NULL;
		jtEntry = Tcl_NextHashEntry(&jtSearch)) {
	    targetLabel = (Tcl_Obj*)Tcl_GetHashValue(jtEntry);
	    entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		    TclGetString(targetLabel));
	    jumpTarget = (BasicBlock*)Tcl_GetHashValue(entry);
	    result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
		    jumpEnclosing, jumpState, catchDepth);
	}
    }

    return result;
}

/*
 *-----------------------------------------------------------------------------
 *
 * CheckForUnclosedCatches --
 *
 *	Checks that a sequence of assembly code has no unclosed catches on
 *	exit.
 *
 * Results:
 *	Returns a standard Tcl result, with an error message for unclosed
 *	catches.
 *
 *-----------------------------------------------------------------------------
 */

static int
CheckForUnclosedCatches(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */

    if (assemEnvPtr->curr_bb->catchState >= BBCS_INCATCH) {
	if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "catch still active on exit from assembly code", -1));
	    Tcl_SetErrorLine(interp,
		    assemEnvPtr->curr_bb->enclosingCatch->startLine);
	    Tcl_SetErrorCode(interp, "TCL", "ASSEM", "UNCLOSEDCATCH", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * BuildExceptionRanges --
 *
 *	Walks through the assembly code and builds exception ranges for the
 *	catches embedded therein.
 *
 * Results:
 *	Returns a standard Tcl result with an error message in the interpreter
 *	if anything is unsuccessful.
 *
 * Side effects:
 *	Each contiguous block of code with a given catch exit is assigned an
 *	exception range at the appropriate level.
 *	Exception ranges in embedded blocks have their levels corrected and
 *	collated into the table.
 *	Blocks that end with 'beginCatch' are associated with the innermost
 *	exception range of the following block.
 *
 *-----------------------------------------------------------------------------
 */

static int
BuildExceptionRanges(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr;		/* Current basic block */
    BasicBlock* prevPtr = NULL;	/* Previous basic block */
    int catchDepth = 0;		/* Current catch depth */
    int maxCatchDepth = 0;	/* Maximum catch depth in the program */
    BasicBlock** catches;	/* Stack of catches in progress */
    int* catchIndices;		/* Indices of the exception ranges of catches
				 * in progress */
    int i;

    /*
     * Determine the max catch depth for the entire assembly script
     * (excluding embedded eval's and expr's, which will be handled later).
     */

    for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
	if (bbPtr->catchDepth > maxCatchDepth) {
	    maxCatchDepth = bbPtr->catchDepth;
	}
    }

    /*
     * Allocate memory for a stack of active catches.
     */

    catches = (BasicBlock**)Tcl_Alloc(maxCatchDepth * sizeof(BasicBlock*));
    catchIndices = (int *)Tcl_Alloc(maxCatchDepth * sizeof(int));
    for (i = 0; i < maxCatchDepth; ++i) {
	catches[i] = NULL;
	catchIndices[i] = -1;
    }

    /*
     * Walk through the basic blocks and manage exception ranges.
     */

    for (bbPtr=assemEnvPtr->head_bb; bbPtr != NULL; bbPtr=bbPtr->successor1) {
	UnstackExpiredCatches(envPtr, bbPtr, catchDepth, catches,
		catchIndices);
	LookForFreshCatches(bbPtr, catches);
	StackFreshCatches(assemEnvPtr, bbPtr, catchDepth, catches,
		catchIndices);

	/*
	 * If the last block was a 'begin catch', fill in the exception range.
	 */

	catchDepth = bbPtr->catchDepth;
	if (prevPtr != NULL && (prevPtr->flags & BB_BEGINCATCH)) {
	    TclStoreInt4AtPtr(catchIndices[catchDepth-1],
		    envPtr->codeStart + bbPtr->startOffset - 4);
	}

	prevPtr = bbPtr;
    }

    /* Make sure that all catches are closed */

    if (catchDepth != 0) {
	Tcl_Panic("unclosed catch at end of code in "
		"tclAssembly.c:BuildExceptionRanges, can't happen");
    }

    /* Free temp storage */

    Tcl_Free(catchIndices);
    Tcl_Free(catches);

    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * UnstackExpiredCatches --
 *
 *	Unstacks and closes the exception ranges for any catch contexts that
 *	were active in the previous basic block but are inactive in the
 *	current one.
 *
 *-----------------------------------------------------------------------------
 */

static void
UnstackExpiredCatches(
    CompileEnv* envPtr,		/* Compilation environment */
    BasicBlock* bbPtr,		/* Basic block being processed */
    int catchDepth,		/* Depth of nesting of catches prior to entry
				 * to this block */
    BasicBlock** catches,	/* Array of catch contexts */
    int* catchIndices)		/* Indices of the exception ranges
				 * corresponding to the catch contexts */
{
    ExceptionRange* range;	/* Exception range for a specific catch */
    BasicBlock* block;		/* Catch block being examined */
    BasicBlockCatchState catchState;
				/* State of the code relative to the catch
				 * block being examined ("in catch" or
				 * "caught"). */

    /*
     * Unstack any catches that are deeper than the nesting level of the basic
     * block being entered.
     */

    while (catchDepth > bbPtr->catchDepth) {
	--catchDepth;
	if (catches[catchDepth] != NULL) {
	    range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
	    range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
	    catches[catchDepth] = NULL;
	    catchIndices[catchDepth] = -1;
	}
    }

    /*
     * Unstack any catches that don't match the basic block being entered,
     * either because they are no longer part of the context, or because the
     * context has changed from INCATCH to CAUGHT.
     */

    catchState = bbPtr->catchState;
    block = bbPtr->enclosingCatch;
    while (catchDepth > 0) {
	--catchDepth;
	if (catches[catchDepth] != NULL) {
	    if (catches[catchDepth] != block || catchState >= BBCS_CAUGHT) {
		range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
		range->numCodeBytes = bbPtr->startOffset - range->codeOffset;
		catches[catchDepth] = NULL;
		catchIndices[catchDepth] = -1;
	    }
	    catchState = block->catchState;
	    block = block->enclosingCatch;
	}
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * LookForFreshCatches --
 *
 *	Determines whether a basic block being entered needs any exception
 *	ranges that are not already stacked.
 *
 * Does not create the ranges: this procedure iterates from the innermost
 * catch outward, but exception ranges must be created from the outermost
 * catch inward.
 *
 *-----------------------------------------------------------------------------
 */

static void
LookForFreshCatches(
    BasicBlock* bbPtr,		/* Basic block being entered */
    BasicBlock** catches)	/* Array of catch contexts that are already
				 * entered */
{
    BasicBlockCatchState catchState;
				/* State ("in catch" or "caught") of the
				 * current catch. */
    BasicBlock* block;		/* Current enclosing catch */
    int catchDepth;		/* Nesting depth of the current catch */

    catchState = bbPtr->catchState;
    block = bbPtr->enclosingCatch;
    catchDepth = bbPtr->catchDepth;
    while (catchDepth > 0) {
	--catchDepth;
	if (catches[catchDepth] != block && catchState < BBCS_CAUGHT) {
	    catches[catchDepth] = block;
	}
	catchState = block->catchState;
	block = block->enclosingCatch;
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * StackFreshCatches --
 *
 *	Make ExceptionRange records for any catches that are in the basic
 *	block being entered and were not in the previous basic block.
 *
 *-----------------------------------------------------------------------------
 */

static void
StackFreshCatches(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* bbPtr,		/* Basic block being processed */
    int catchDepth,		/* Depth of nesting of catches prior to entry
				 * to this block */
    BasicBlock** catches,	/* Array of catch contexts */
    int* catchIndices)		/* Indices of the exception ranges
				 * corresponding to the catch contexts */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    ExceptionRange* range;	/* Exception range for a specific catch */
    BasicBlock* block;		/* Catch block being examined */
    BasicBlock* errorExit;	/* Error exit from the catch block */
    Tcl_HashEntry* entryPtr;

    catchDepth = 0;

    /*
     * Iterate through the enclosing catch blocks from the outside in,
     * looking for ones that don't have exception ranges (and are uncaught)
     */

    for (catchDepth = 0; catchDepth < bbPtr->catchDepth; ++catchDepth) {
	if (catchIndices[catchDepth] == -1 && catches[catchDepth] != NULL) {
	    /*
	     * Create an exception range for a block that needs one.
	     */

	    block = catches[catchDepth];
	    catchIndices[catchDepth] =
		    TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	    range = envPtr->exceptArrayPtr + catchIndices[catchDepth];
	    range->nestingLevel = envPtr->exceptDepth + catchDepth;
	    envPtr->maxExceptDepth =
		    TclMax(range->nestingLevel + 1, envPtr->maxExceptDepth);
	    range->codeOffset = bbPtr->startOffset;

	    entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
		    TclGetString(block->jumpTarget));
	    if (entryPtr == NULL) {
		Tcl_Panic("undefined label in tclAssembly.c:"
			"BuildExceptionRanges, can't happen");
	    }

	    errorExit = (BasicBlock*)Tcl_GetHashValue(entryPtr);
	    range->catchOffset = errorExit->startOffset;
	}
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * RestoreEmbeddedExceptionRanges --
 *
 *	Processes an assembly script, replacing any exception ranges that
 *	were present in embedded code.
 *
 *-----------------------------------------------------------------------------
 */

static void
RestoreEmbeddedExceptionRanges(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    BasicBlock* bbPtr;		/* Current basic block */
    int rangeBase;		/* Base of the foreign exception ranges when
				 * they are reinstalled */
    int rangeIndex;		/* Index of the current foreign exception
				 * range as reinstalled */
    ExceptionRange* range;	/* Current foreign exception range */
    unsigned char opcode;	/* Current instruction's opcode */
    int catchIndex;		/* Index of the exception range to which the
				 * current instruction refers */
    int i;

    /*
     * Walk the basic blocks looking for exceptions in embedded scripts.
     */

    for (bbPtr = assemEnvPtr->head_bb;
	    bbPtr != NULL;
	    bbPtr = bbPtr->successor1) {
	if (bbPtr->foreignExceptionCount != 0) {
	    /*
	     * Reinstall the embedded exceptions and track their nesting level
	     */

	    rangeBase = envPtr->exceptArrayNext;
	    for (i = 0; i < bbPtr->foreignExceptionCount; ++i) {
		range = bbPtr->foreignExceptions + i;
		rangeIndex = TclCreateExceptRange(range->type, envPtr);
		range->nestingLevel += envPtr->exceptDepth + bbPtr->catchDepth;
		memcpy(envPtr->exceptArrayPtr + rangeIndex, range,
			sizeof(ExceptionRange));
		if (range->nestingLevel >= envPtr->maxExceptDepth) {
		    envPtr->maxExceptDepth = range->nestingLevel + 1;
		}
	    }

	    /*
	     * Walk through the bytecode of the basic block, and relocate
	     * INST_BEGIN_CATCH4 instructions to the new locations
	     */

	    i = bbPtr->startOffset;
	    while (i < bbPtr->successor1->startOffset) {
		opcode = envPtr->codeStart[i];
		if (opcode == INST_BEGIN_CATCH4) {
		    catchIndex = TclGetUInt4AtPtr(envPtr->codeStart + i + 1);
		    if (catchIndex >= bbPtr->foreignExceptionBase
			    && catchIndex < (bbPtr->foreignExceptionBase +
			    bbPtr->foreignExceptionCount)) {
			catchIndex -= bbPtr->foreignExceptionBase;
			catchIndex += rangeBase;
			TclStoreInt4AtPtr(catchIndex, envPtr->codeStart+i+1);
		    }
		}
		i += tclInstructionTable[opcode].numBytes;
	    }
	}
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * ResetVisitedBasicBlocks --
 *
 *	Turns off the 'visited' flag in all basic blocks at the conclusion
 *	of a pass.
 *
 *-----------------------------------------------------------------------------
 */

static void
ResetVisitedBasicBlocks(
    AssemblyEnv* assemEnvPtr)	/* Assembly environment */
{
    BasicBlock* block;

    for (block = assemEnvPtr->head_bb; block != NULL;
	    block = block->successor1) {
	block->flags &= ~BB_VISITED;
    }
}

/*
 *-----------------------------------------------------------------------------
 *
 * AddBasicBlockRangeToErrorInfo --
 *
 *	Updates the error info of the Tcl interpreter to show a given basic
 *	block in the code.
 *
 * This procedure is used to label the callstack with source location
 * information when reporting an error in stack checking.
 *
 *-----------------------------------------------------------------------------
 */

static void
AddBasicBlockRangeToErrorInfo(
    AssemblyEnv* assemEnvPtr,	/* Assembly environment */
    BasicBlock* bbPtr)		/* Basic block in which the error is found */
{
    CompileEnv* envPtr = assemEnvPtr->envPtr;
				/* Compilation environment */
    Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
				/* Tcl interpreter */
    Tcl_Obj* lineNo;		/* Line number in the source */

    Tcl_AddErrorInfo(interp, "\n    in assembly code between lines ");
    TclNewIntObj(lineNo, bbPtr->startLine);
    Tcl_IncrRefCount(lineNo);
    Tcl_AppendObjToErrorInfo(interp, lineNo);
    Tcl_AddErrorInfo(interp, " and ");
    if (bbPtr->successor1 != NULL) {
	TclSetIntObj(lineNo, bbPtr->successor1->startLine);
	Tcl_AppendObjToErrorInfo(interp, lineNo);
    } else {
	Tcl_AddErrorInfo(interp, "end of assembly code");
    }
    Tcl_DecrRefCount(lineNo);
}

/*
 *-----------------------------------------------------------------------------
 *
 * DupAssembleCodeInternalRep --
 *
 *	Part of the Tcl object type implementation for Tcl assembly language
 *	bytecode. We do not copy the bytecode intrep. Instead, we return
 *	without setting copyPtr->typePtr, so the copy is a plain string copy
 *	of the assembly source, and if it is to be used as a compiled
 *	expression, it will need to be reprocessed.
 *
 *	This makes sense, because with Tcl's copy-on-write practices, the
 *	usual (only?) time Tcl_DuplicateObj() will be called is when the copy
 *	is about to be modified, which would invalidate any copied bytecode
 *	anyway. The only reason it might make sense to copy the bytecode is if
 *	we had some modifying routines that operated directly on the intrep,
 *	as we do for lists and dicts.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-----------------------------------------------------------------------------
 */

static void
DupAssembleCodeInternalRep(
    TCL_UNUSED(Tcl_Obj *),
    TCL_UNUSED(Tcl_Obj *))
{
    return;
}

/*
 *-----------------------------------------------------------------------------
 *
 * FreeAssembleCodeInternalRep --
 *
 *	Part of the Tcl object type implementation for Tcl expression
 *	bytecode. Frees the storage allocated to hold the internal rep, unless
 *	ref counts indicate bytecode execution is still in progress.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May free allocated memory. Leaves objPtr untyped.
 *
 *-----------------------------------------------------------------------------
 */

static void
FreeAssembleCodeInternalRep(
    Tcl_Obj *objPtr)
{
    ByteCode *codePtr;

    ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
    assert(codePtr != NULL);

    TclReleaseByteCode(codePtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclAsync.c.

114
115
116
117
118
119
120
121

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

121
122
123
124
125
126
127
128







-
+







    Tcl_AsyncProc *proc,	/* Procedure to call when handler is
				 * invoked. */
    ClientData clientData)	/* Argument to pass to handler. */
{
    AsyncHandler *asyncPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    asyncPtr = (AsyncHandler*)Tcl_Alloc(sizeof(AsyncHandler));
    asyncPtr = (AsyncHandler *) ckalloc(sizeof(AsyncHandler));
    asyncPtr->ready = 0;
    asyncPtr->nextPtr = NULL;
    asyncPtr->proc = proc;
    asyncPtr->clientData = clientData;
    asyncPtr->originTsd = tsdPtr;
    asyncPtr->originThrdId = Tcl_GetCurrentThread();

231
232
233
234
235
236
237
238

239
240
241
242
243
244
245
231
232
233
234
235
236
237

238
239
240
241
242
243
244
245







-
+







	    }
	}
	if (asyncPtr == NULL) {
	    break;
	}
	asyncPtr->ready = 0;
	Tcl_MutexUnlock(&tsdPtr->asyncMutex);
	code = asyncPtr->proc(asyncPtr->clientData, interp, code);
	code = (*asyncPtr->proc)(asyncPtr->clientData, interp, code);
	Tcl_MutexLock(&tsdPtr->asyncMutex);
    }
    tsdPtr->asyncActive = 0;
    Tcl_MutexUnlock(&tsdPtr->asyncMutex);
    return code;
}

256
257
258
259
260
261
262
263

264
265
266
267
268
269
270
256
257
258
259
260
261
262

263
264
265
266
267
268
269
270







-
+







 *
 * Side effects:
 *	The state associated with the handler is deleted.
 *
 *	Failure to locate the handler in current thread private list
 *	of async handlers will result in panic; exception: the list
 *	is already empty (potential trouble?).
 *	Consequently, threads should create and delete handlers
 *	Consequently, threads should create and delete handlers 
 *	themselves.  I.e. a handler created by one should not be
 *	deleted by some other thread.
 *
 *----------------------------------------------------------------------
 */

void
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320







-
+







	    prevPtr->nextPtr = asyncPtr->nextPtr;
	}
	if (asyncPtr == tsdPtr->lastHandler) {
	    tsdPtr->lastHandler = prevPtr;
	}
    }
    Tcl_MutexUnlock(&tsdPtr->asyncMutex);
    Tcl_Free(asyncPtr);
    ckfree((char *) asyncPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AsyncReady --
 *

Changes to generic/tclBasic.c.

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


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

82
83
84

85
86
87
88
89
90

91
92
93
94
95
96
97
98
99
100
101
102
103

104
105
106
107
108
109
110

111
112
113
114

115
116
117
118
119

120
121
122
123
124
125

126
127
128
129
130
131

132
133
134
135
136
137
138
139
140
141
142
143
144
145











































146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189

190
191
192
193

194
195
196
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212
213

214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237

238
239
240

241
242
243
244

245
246
247
248
249
250
251
252

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277











278
279
280
281
282
283
284
285
286






287
288
289
290
291
292
293
294
295
296
297










298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318



















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
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
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












-
-






-

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












-
+
-
-
-
+
-
-
-


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




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

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

-
+

-
-
-
-
-
-
-
-
-
-
-








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










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





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








-
+

-
+


-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-

-
-
-
-
+
+
-
-
-
+


-
-
-
+
+
+

-
-
-
+
+
+







/*
 * tclBasic.c --
 *
 *	Contains the basic facilities for TCL command interpretation,
 *	including interpreter creation and deletion, command creation and
 *	deletion, and command/script execution.
 *
 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 Miguel Sofer <msofer@users.sourceforge.net>
 *
 * 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"
#include "tclCompile.h"
#include "tclTomMath.h"
#include <math.h>
#include <assert.h>
#include <float.h>
#include <limits.h>

/*
 * TCL_FPCLASSIFY_MODE:
 *	0  - fpclassify
 *	1  - _fpclass
 *	2  - simulate
 *	3  - __builtin_fpclassify
 */

#ifndef TCL_FPCLASSIFY_MODE
#if defined(__MINGW32__) && defined(_X86_) /* mingw 32-bit */
/*
 * MINGW x86 (tested up to gcc 8.1) seems to have a bug in fpclassify,
 * [fpclassify 1e-314], x86 => normal, x64 => subnormal, so switch to using a
 * version using a compiler built-in.
 */
#define TCL_FPCLASSIFY_MODE 1
#elif defined(fpclassify)		/* fpclassify */
/*
 * This is the C99 standard.
 */
#include <float.h>
#include <math.h>
#define TCL_FPCLASSIFY_MODE 0
#elif defined(_FPCLASS_NN)		/* _fpclass */
/*
 * This case handles newer MSVC on Windows, which doesn't have the standard
 * operation but does have something that can tell us the same thing.
 */
#define TCL_FPCLASSIFY_MODE 1
#else	/* !fpclassify && !_fpclass (older MSVC), simulate */
/*
 * Older MSVC on Windows. So broken that we just have to do it our way. This
 * assumes that we're on x86 (or at least a system with classic little-endian
 * double layout and a 32-bit 'int' type).
 */
#define TCL_FPCLASSIFY_MODE 2
#endif /* !fpclassify */
/* actually there is no fallback to builtin fpclassify */
#endif /* !TCL_FPCLASSIFY_MODE */

#include "tommath.h"

#define INTERP_STACK_INITIAL_SIZE 2000
#define CORO_STACK_INITIAL_SIZE    200

/*
 * Determine whether we're using IEEE floating point
 */

#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
#   define IEEE_FLOATING_POINT
/* Largest odd integer that can be represented exactly in a double */
#   define MAX_EXACT 9007199254740991.0
#endif

/*
 * This is the script cancellation struct and hash table. The hash table is
 * The following structure defines the client data for a math function
 * used to keep track of the information necessary to process script
 * cancellation requests, including the original interp, asynchronous handler
 * tokens (created by Tcl_AsyncCreate), and the clientData and flags arguments
 * registered with Tcl_CreateMathFunc
 * passed to Tcl_CancelEval on a per-interp basis. The cancelLock mutex is
 * used for protecting calls to Tcl_CancelEval as well as protecting access to
 * the hash table below.
 */

typedef struct {
typedef struct OldMathFuncData {
    Tcl_Interp *interp;		/* Interp this struct belongs to. */
    Tcl_AsyncHandler async;	/* Async handler token for script
				 * cancellation. */
    char *result;		/* The script cancellation result or NULL for
				 * a default result. */
    size_t length;		/* Length of the above error message. */
    ClientData clientData;		/* Not used. */
    int flags;			/* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(cancelLock);

    Tcl_MathProc *proc;		/* Handler function */
/*
 * Table used to map command implementation functions to a human-readable type
 * name, for [info type]. The keys in the table are function addresses, and
 * the values in the table are static char* containing strings in Tcl's
 * internal encoding (almost UTF-8).
 */

    int numArgs;		/* Number of args expected */
static Tcl_HashTable commandTypeTable;
static int commandTypeInit = 0;
TCL_DECLARE_MUTEX(commandTypeLock);

    Tcl_ValueType *argTypes;	/* Types of the args */
/*
 * Declarations for managing contexts for non-recursive coroutines. Contexts
 * are used to save the evaluation state between NR calls to each coro.
 */

    ClientData clientData;	/* Client data for the handler function */
#define SAVE_CONTEXT(context)				\
    (context).framePtr = iPtr->framePtr;		\
    (context).varFramePtr = iPtr->varFramePtr;		\
    (context).cmdFramePtr = iPtr->cmdFramePtr;		\
    (context).lineLABCPtr = iPtr->lineLABCPtr

} OldMathFuncData;
#define RESTORE_CONTEXT(context)			\
    iPtr->framePtr = (context).framePtr;		\
    iPtr->varFramePtr = (context).varFramePtr;		\
    iPtr->cmdFramePtr = (context).cmdFramePtr;		\
    iPtr->lineLABCPtr = (context).lineLABCPtr


/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc   BadEnsembleSubcommand;
static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
			    const char *oldName, const char *newName,
			    int flags);
static int		CancelEvalProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void		DeleteCoroutine(ClientData clientData);
static void		DeleteInterpProc(Tcl_Interp *interp);
static void		DeleteOpCmdClientData(ClientData clientData);
static char *	CallCommandTraces(Interp *iPtr, Command *cmdPtr,
		    const char *oldName, const char *newName, int flags);
static int	CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void	DeleteInterpProc(Tcl_Interp *interp);
static void	DeleteOpCmdClientData(ClientData clientData);
static Tcl_Obj *GetCommandSource(Interp *iPtr, const char *command,
	            int numChars, int objc, Tcl_Obj *const objv[]);
static void	ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode);
static int	OldMathFuncProc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static void	OldMathFuncDeleteProc(ClientData clientData);
static int	ExprAbsFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprBinaryFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprBoolFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprCeilFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprDoubleFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprEntierFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprFloorFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprIntFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprIsqrtFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprRandFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprRoundFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprSqrtFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprSrandFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprUnaryFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static int	ExprWideFunc(ClientData clientData, Tcl_Interp *interp,
		    int argc, Tcl_Obj *const *objv);
static void	MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
		    int actual, Tcl_Obj *const *objv);
#ifdef USE_DTRACE
static Tcl_ObjCmdProc	DTraceObjCmd;
static Tcl_NRPostProc	DTraceCmdReturn;
#else
#   define DTraceCmdReturn	NULL
#endif /* USE_DTRACE */
static Tcl_ObjCmdProc	ExprAbsFunc;
static Tcl_ObjCmdProc	ExprBinaryFunc;
static Tcl_ObjCmdProc	ExprBoolFunc;
static Tcl_ObjCmdProc	ExprCeilFunc;
static Tcl_ObjCmdProc	ExprDoubleFunc;
static Tcl_ObjCmdProc	ExprFloorFunc;
static Tcl_ObjCmdProc	ExprIntFunc;
static Tcl_ObjCmdProc	ExprIsqrtFunc;
static Tcl_ObjCmdProc   ExprIsFiniteFunc;
static Tcl_ObjCmdProc   ExprIsInfinityFunc;
static Tcl_ObjCmdProc   ExprIsNaNFunc;
static Tcl_ObjCmdProc   ExprIsNormalFunc;
static Tcl_ObjCmdProc   ExprIsSubnormalFunc;
static Tcl_ObjCmdProc   ExprIsUnorderedFunc;
static Tcl_ObjCmdProc	ExprMaxFunc;
static Tcl_ObjCmdProc	ExprMinFunc;
static Tcl_ObjCmdProc	ExprRandFunc;
static Tcl_ObjCmdProc	ExprRoundFunc;
static Tcl_ObjCmdProc	ExprSqrtFunc;
static Tcl_ObjCmdProc	ExprSrandFunc;
static Tcl_ObjCmdProc	ExprUnaryFunc;
static Tcl_ObjCmdProc	ExprWideFunc;
static Tcl_ObjCmdProc   FloatClassifyObjCmd;
static void		MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
			    int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc	NRCoroutineCallerCallback;
static Tcl_NRPostProc	NRCoroutineExitCallback;
static Tcl_NRPostProc	NRCommand;

static void		ProcessUnexpectedResult(Tcl_Interp *interp,
			    int returnCode);
static int		RewindCoroutine(CoroutineData *corPtr, int result);
static void		TEOV_SwitchVarFrame(Tcl_Interp *interp);
static void		TEOV_PushExceptionHandlers(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[], int flags);
static inline Command *	TEOV_LookupCmdFromObj(Tcl_Interp *interp,
			    Tcl_Obj *namePtr, Namespace *lookupNsPtr);
static int		TEOV_NotFound(Tcl_Interp *interp, int objc,
static int	DTraceObjCmd(ClientData dummy, Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Namespace *lookupNsPtr);
static int		TEOV_RunEnterTraces(Tcl_Interp *interp,
			    Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
			    Tcl_Obj *const objv[]);
		    Tcl_Obj *const objv[]);
static Tcl_NRPostProc	RewindCoroutineCallback;
static Tcl_NRPostProc	TEOEx_ByteCodeCallback;
static Tcl_NRPostProc	TEOEx_ListCallback;
static Tcl_NRPostProc	TEOV_Error;
static Tcl_NRPostProc	TEOV_Exception;
static Tcl_NRPostProc	TEOV_NotFoundCallback;
static Tcl_NRPostProc	TEOV_RestoreVarFrame;
static Tcl_NRPostProc	TEOV_RunLeaveTraces;
static Tcl_NRPostProc	EvalObjvCore;
static Tcl_NRPostProc	Dispatch;

#endif
static Tcl_ObjCmdProc NRInjectObjCmd;
static Tcl_NRPostProc NRPostInvoke;
static Tcl_ObjCmdProc CoroTypeObjCmd;
static Tcl_ObjCmdProc TclNRCoroInjectObjCmd;
static Tcl_ObjCmdProc TclNRCoroProbeObjCmd;
static Tcl_NRPostProc InjectHandler;
static Tcl_NRPostProc InjectHandlerPostCall;

MODULE_SCOPE const TclStubs tclStubs;
extern TclStubs tclStubs;

/*
 * Magical counts for the number of arguments accepted by a coroutine command
 * after particular kinds of [yield].
 */

#define CORO_ACTIVATE_YIELD    PTR2INT(NULL)
#define CORO_ACTIVATE_YIELDM   PTR2INT(NULL)+1

#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL     (-1)
#define COROUTINE_ARGUMENTS_ARBITRARY           (-2)

/*
 * The following structure define the commands in the Tcl core.
 */

typedef struct {
    const char *name;		/* Name of object-based command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
    CompileProc *compileProc;	/* Function called to compile command. */
    Tcl_ObjCmdProc *nreProc;	/* NR-based function for command */
    int flags;			/* Various flag bits, as defined below. */
} CmdInfo;

    int isSafe;			/* If non-zero, command will be present in
#define CMD_IS_SAFE         1   /* Whether this command is part of the set of
                                 * commands present by default in a safe
                                 * interpreter. */
				 * safe interpreter. Otherwise it will be
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
 * expansion for itself rather than needing the generic layer to take care of
 * it for it. Defined in tclInt.h. */

				 * hidden. */
/*
 * The following struct states that the command it talks about (a subcommand
 * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an
 * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these
 * structs.) Alas, we can't sensibly just store the information directly in
 * the commands.
 */

} CmdInfo;
typedef struct {
    const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for
                                 * the end of the list of commands to hide. */
    const char *commandName;    /* The name of the command within the
                                 * ensemble. If this is NULL, we want to also
                                 * make the overall command be hidden, an ugly
                                 * hack because it is expected by security
                                 * policies in the wild. */
} UnsafeEnsembleInfo;

/*
 * The built-in commands, and the functions that implement them:
 */

static const CmdInfo builtInCmds[] = {
    /*
     * Commands in the generic core.
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	1},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			1},
    {"array",		Tcl_ArrayObjCmd,	NULL,			1},
    {"binary",		Tcl_BinaryObjCmd,	NULL,			1},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	1},
#ifndef EXCLUDE_OBSOLETE_COMMANDS
    {"case",		Tcl_CaseObjCmd,		NULL,			1},
#endif
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	1},
    {"concat",		Tcl_ConcatObjCmd,	NULL,			1},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	1},
    {"coroinject",	NULL,			NULL,                   TclNRCoroInjectObjCmd,	CMD_IS_SAFE},
    {"coroprobe",	NULL,			NULL,                   TclNRCoroProbeObjCmd,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},
    {"eval",		Tcl_EvalObjCmd,		NULL,			TclNREvalObjCmd,	CMD_IS_SAFE},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	TclNRExprObjCmd,	CMD_IS_SAFE},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	TclNRForObjCmd,	CMD_IS_SAFE},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	TclNRForeachCmd,	CMD_IS_SAFE},
    {"format",		Tcl_FormatObjCmd,	TclCompileFormatCmd,	NULL,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	NULL,			1},
    {"eval",		Tcl_EvalObjCmd,		NULL,			1},
    {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	1},
    {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	1},
    {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	1},
    {"format",		Tcl_FormatObjCmd,	NULL,			1},
    {"fpclassify",      FloatClassifyObjCmd,    NULL,                   NULL,   CMD_IS_SAFE},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	NULL,	CMD_IS_SAFE},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	TclNRIfObjCmd,	CMD_IS_SAFE},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	NULL,	CMD_IS_SAFE},
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	CMD_IS_SAFE},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	CMD_IS_SAFE},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	CMD_IS_SAFE},
    {"linsert",		Tcl_LinsertObjCmd,	TclCompileLinsertCmd,	NULL,	CMD_IS_SAFE},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	CMD_IS_SAFE},
    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	1},
    {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	1},
    {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	1},
    {"join",		Tcl_JoinObjCmd,		NULL,			1},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	1},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	1},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	1},
    {"linsert",		Tcl_LinsertObjCmd,	NULL,			1},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	1},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	1},
    {"lmap",		Tcl_LmapObjCmd,		TclCompileLmapCmd,	TclNRLmapCmd,	CMD_IS_SAFE},
    {"lpop",		Tcl_LpopObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	CMD_IS_SAFE},
    {"lremove", 	Tcl_LremoveObjCmd,	NULL,           	NULL,	CMD_IS_SAFE},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	CMD_IS_SAFE},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	CMD_IS_SAFE},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"package",		Tcl_PackageObjCmd,	NULL,			TclNRPackageObjCmd,	CMD_IS_SAFE},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	CMD_IS_SAFE},
    {"regsub",		Tcl_RegsubObjCmd,	TclCompileRegsubCmd,	NULL,	CMD_IS_SAFE},
    {"rename",		Tcl_RenameObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	NULL,	CMD_IS_SAFE},
    {"scan",		Tcl_ScanObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	NULL,	CMD_IS_SAFE},
    {"split",		Tcl_SplitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"subst",		Tcl_SubstObjCmd,	TclCompileSubstCmd,	TclNRSubstObjCmd,	CMD_IS_SAFE},
    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	TclNRSwitchObjCmd, CMD_IS_SAFE},
    {"lrange",		Tcl_LrangeObjCmd,	NULL,			1},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			1},
    {"lreplace",	Tcl_LreplaceObjCmd,	NULL,			1},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			1},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			1},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	1},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			1},
    {"namespace",	Tcl_NamespaceObjCmd,	TclCompileNamespaceCmd,	1},
    {"package",		Tcl_PackageObjCmd,	NULL,			1},
    {"proc",		Tcl_ProcObjCmd,		NULL,			1},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	1},
    {"regsub",		Tcl_RegsubObjCmd,	NULL,			1},
    {"rename",		Tcl_RenameObjCmd,	NULL,			1},
    {"return",		Tcl_ReturnObjCmd,	TclCompileReturnCmd,	1},
    {"scan",		Tcl_ScanObjCmd,		NULL,			1},
    {"set",		Tcl_SetObjCmd,		TclCompileSetCmd,	1},
    {"split",		Tcl_SplitObjCmd,	NULL,			1},
    {"subst",		Tcl_SubstObjCmd,	NULL,			1},
    {"switch",		Tcl_SwitchObjCmd,	TclCompileSwitchCmd,	1},
    {"tailcall",	NULL,			TclCompileTailcallCmd,	TclNRTailcallObjCmd,	CMD_IS_SAFE},
    {"throw",		Tcl_ThrowObjCmd,	TclCompileThrowCmd,	NULL,	CMD_IS_SAFE},
    {"trace",		Tcl_TraceObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"trace",		Tcl_TraceObjCmd,	NULL,			1},
    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	CMD_IS_SAFE},
    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	CMD_IS_SAFE},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	CMD_IS_SAFE},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	CMD_IS_SAFE},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	CMD_IS_SAFE},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	CMD_IS_SAFE},
    {"unset",		Tcl_UnsetObjCmd,	NULL,			1},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			1},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	1},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	1},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	1},
    {"yield",		NULL,			TclCompileYieldCmd,	TclNRYieldObjCmd,	CMD_IS_SAFE},
    {"yieldto",		NULL,			TclCompileYieldToCmd,	TclNRYieldToObjCmd,	CMD_IS_SAFE},

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

    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},
    {"close",		Tcl_CloseObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"eof",		Tcl_EofObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"exec",		Tcl_ExecObjCmd,		NULL,			NULL,	0},
    {"exit",		Tcl_ExitObjCmd,		NULL,			NULL,	0},
    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			NULL,	0},
    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"after",		Tcl_AfterObjCmd,	NULL,			1},
    {"cd",		Tcl_CdObjCmd,		NULL,			0},
    {"close",		Tcl_CloseObjCmd,	NULL,			1},
    {"eof",		Tcl_EofObjCmd,		NULL,			1},
    {"encoding",	Tcl_EncodingObjCmd,	NULL,			0},
    {"exec",		Tcl_ExecObjCmd,		NULL,			0},
    {"exit",		Tcl_ExitObjCmd,		NULL,			0},
    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			1},
    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			0},
    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			1},
    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"flush",		Tcl_FlushObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"gets",		Tcl_GetsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"glob",		Tcl_GlobObjCmd,		NULL,			NULL,	0},
    {"load",		Tcl_LoadObjCmd,		NULL,			NULL,	0},
    {"open",		Tcl_OpenObjCmd,		NULL,			NULL,	0},
    {"pid",		Tcl_PidObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"pwd",		Tcl_PwdObjCmd,		NULL,			NULL,	0},
    {"read",		Tcl_ReadObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"seek",		Tcl_SeekObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"socket",		Tcl_SocketObjCmd,	NULL,			NULL,	0},
    {"source",		Tcl_SourceObjCmd,	NULL,			TclNRSourceObjCmd,	0},
    {"tell",		Tcl_TellObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"time",		Tcl_TimeObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
    {"timerate",	Tcl_TimeRateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*
 * Information about which pieces of ensembles to hide when making an
 * interpreter safe:
 */

static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
    /* [encoding] has two unsafe commands. Assumed by older security policies
     * to be overall unsafe; it isn't but... */
    {"encoding", NULL},
    {"encoding", "dirs"},
    {"encoding", "system"},
    /* [file] has MANY unsafe commands! Assumed by older security policies to
     * be overall unsafe; it isn't but... */
    {"file", NULL},
    {"file", "atime"},
    {"file", "attributes"},
    {"file", "copy"},
    {"file", "delete"},
    {"file", "dirname"},
    {"file", "executable"},
    {"file", "exists"},
    {"file", "extension"},
    {"file", "isdirectory"},
    {"file", "isfile"},
    {"file", "link"},
    {"file", "lstat"},
    {"file", "mtime"},
    {"file", "mkdir"},
    {"file", "nativename"},
    {"file", "normalize"},
    {"file", "owned"},
    {"file", "readable"},
    {"file", "readlink"},
    {"file", "rename"},
    {"file", "rootname"},
    {"file", "size"},
    {"file", "stat"},
    {"file",		Tcl_FileObjCmd,		NULL,			0},
    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			1},
    {"flush",		Tcl_FlushObjCmd,	NULL,			1},
    {"gets",		Tcl_GetsObjCmd,		NULL,			1},
    {"glob",		Tcl_GlobObjCmd,		NULL,			0},
    {"load",		Tcl_LoadObjCmd,		NULL,			0},
    {"open",		Tcl_OpenObjCmd,		NULL,			0},
    {"pid",		Tcl_PidObjCmd,		NULL,			1},
    {"puts",		Tcl_PutsObjCmd,		NULL,			1},
    {"pwd",		Tcl_PwdObjCmd,		NULL,			0},
    {"read",		Tcl_ReadObjCmd,		NULL,			1},
    {"seek",		Tcl_SeekObjCmd,		NULL,			1},
    {"socket",		Tcl_SocketObjCmd,	NULL,			0},
    {"source",		Tcl_SourceObjCmd,	NULL,			0},
    {"tell",		Tcl_TellObjCmd,		NULL,			1},
    {"time",		Tcl_TimeObjCmd,		NULL,			1},
#ifdef TCL_TIMERATE
    {"timerate",	Tcl_TimeRateObjCmd,	NULL,			1},
#endif
    {"unload",		Tcl_UnloadObjCmd,	NULL,			0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			1},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			1},
    {"file", "tail"},
    {"file", "tempdir"},
    {"file", "tempfile"},
    {"file", "type"},
    {"file", "volumes"},
    {"file", "writable"},
    /* [info] has two unsafe commands */
    {"info", "cmdtype"},
    {"info", "nameofexecutable"},
    /* [tcl::process] has ONLY unsafe commands! */
    {"process", "list"},
    {"process", "status"},
    {"process", "purge"},
    {"process", "autopurge"},
    /* [zipfs] has MANY unsafe commands! */
    {"zipfs", "lmkimg"},
    {"zipfs", "lmkzip"},
    {"zipfs", "mkimg"},
    {"zipfs", "mkkey"},
    {"zipfs", "mkzip"},
    {"zipfs", "mount"},
    {"zipfs", "mount_data"},
    {"zipfs", "unmount"},
    {NULL, NULL}
    {NULL,		NULL,			NULL,			0}
};

/*
 * Math functions. All are safe.
 */

typedef struct {
    const char *name;		/* Name of the function. The full name is
				 * "::tcl::mathfunc::<name>". */
				 * "::tcl::mathfunc::<name>".  */
    Tcl_ObjCmdProc *objCmdProc;	/* Function that evaluates the function */
    double (*fn)(double x);	/* Real function pointer */
    ClientData clientData;	/* Client data for the function */
} BuiltinFuncDef;
static const BuiltinFuncDef BuiltinFuncTable[] = {
    { "abs",	ExprAbsFunc,	NULL			},
    { "acos",	ExprUnaryFunc,	acos			},
    { "asin",	ExprUnaryFunc,	asin			},
    { "atan",	ExprUnaryFunc,	atan			},
    { "atan2",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) atan2},
    { "abs",	ExprAbsFunc,	NULL 			},
    { "acos",	ExprUnaryFunc,	(ClientData) acos 	},
    { "asin",	ExprUnaryFunc,	(ClientData) asin 	},
    { "atan",	ExprUnaryFunc,	(ClientData) atan 	},
    { "atan2",	ExprBinaryFunc,	(ClientData) atan2 	},
    { "bool",	ExprBoolFunc,	NULL			},
    { "ceil",	ExprCeilFunc,	NULL			},
    { "cos",	ExprUnaryFunc,	cos				},
    { "cosh",	ExprUnaryFunc,	cosh			},
    { "ceil",	ExprCeilFunc,	NULL		 	},
    { "cos",	ExprUnaryFunc,	(ClientData) cos 	},
    { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
    { "double",	ExprDoubleFunc,	NULL			},
    { "entier",	ExprIntFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	exp				},
    { "floor",	ExprFloorFunc,	NULL			},
    { "fmod",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) fmod},
    { "hypot",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) hypot},
    { "entier",	ExprEntierFunc,	NULL			},
    { "exp",	ExprUnaryFunc,	(ClientData) exp	},
    { "floor",	ExprFloorFunc,	NULL		 	},
    { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
    { "hypot",	ExprBinaryFunc,	(ClientData) hypot 	},
    { "int",	ExprIntFunc,	NULL			},
    { "isfinite", ExprIsFiniteFunc, NULL        	},
    { "isinf",	ExprIsInfinityFunc, NULL        	},
    { "isnan",	ExprIsNaNFunc,	NULL            	},
    { "isnormal", ExprIsNormalFunc, NULL        	},
    { "isqrt",	ExprIsqrtFunc,	NULL			},
    { "issubnormal", ExprIsSubnormalFunc, NULL,         },
    { "isunordered", ExprIsUnorderedFunc, NULL,         },
    { "log",	ExprUnaryFunc,	log				},
    { "log10",	ExprUnaryFunc,	log10			},
    { "log",	ExprUnaryFunc,	(ClientData) log 	},
    { "log10",	ExprUnaryFunc,	(ClientData) log10 	},
    { "max",	ExprMaxFunc,	NULL			},
    { "min",	ExprMinFunc,	NULL			},
    { "pow",	ExprBinaryFunc,	(double (*)(double))(void *)(double (*)(double, double)) pow},
    { "pow",	ExprBinaryFunc,	(ClientData) pow 	},
    { "rand",	ExprRandFunc,	NULL			},
    { "round",	ExprRoundFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	sin				},
    { "sinh",	ExprUnaryFunc,	sinh			},
    { "sqrt",	ExprSqrtFunc,	NULL			},
    { "sin",	ExprUnaryFunc,	(ClientData) sin 	},
    { "sinh",	ExprUnaryFunc,	(ClientData) sinh 	},
    { "sqrt",	ExprSqrtFunc,	NULL		 	},
    { "srand",	ExprSrandFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	tan				},
    { "tanh",	ExprUnaryFunc,	tanh			},
    { "wide",	ExprWideFunc,	NULL			},
    { "tan",	ExprUnaryFunc,	(ClientData) tan 	},
    { "tanh",	ExprUnaryFunc,	(ClientData) tanh 	},
    { "wide",	ExprWideFunc,	NULL		 	},
    { NULL, NULL, NULL }
};

/*
 * TIP#174's math operators. All are safe.
 */

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
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







-
-
-
-
-
-
-
-



-
+

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


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







		/* unused */ {0},	NULL},
    { ">=",	TclSortingOpCmd,	TclCompileGeqOpCmd,
		/* unused */ {0},	NULL},
    { "==",	TclSortingOpCmd,	TclCompileEqOpCmd,
		/* unused */ {0},	NULL},
    { "eq",	TclSortingOpCmd,	TclCompileStreqOpCmd,
		/* unused */ {0},	NULL},
    { "lt",	TclSortingOpCmd,	TclCompileStrLtOpCmd,
		/* unused */ {0},	NULL},
    { "le",	TclSortingOpCmd,	TclCompileStrLeOpCmd,
		/* unused */ {0},	NULL},
    { "gt",	TclSortingOpCmd,	TclCompileStrGtOpCmd,
		/* unused */ {0},	NULL},
    { "ge",	TclSortingOpCmd,	TclCompileStrGeOpCmd,
		/* unused */ {0},	NULL},
    { NULL,	NULL,			NULL,
		{0},			NULL}
};


/*
 *----------------------------------------------------------------------
 * Macros for stack checks. The goal of these macros is to allow the size of
 *
 * TclFinalizeEvaluation --
 *
 *	Finalizes the script cancellation hash table.
 * the stack to be checked (so preventing overflow) in a *cheap* way. Note
 *
 * Results:
 *	None.
 * that the check needs to be (amortized) cheap since it is on the critical
 * path for recursion.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
#if defined(TCL_NO_STACK_CHECK)
TclFinalizeEvaluation(void)
{
/*
 * Stack check disabled: make them noops.
 */

    Tcl_MutexLock(&cancelLock);
    if (cancelTableInitialized == 1) {
	Tcl_DeleteHashTable(&cancelTable);
	cancelTableInitialized = 0;
    }
#   define CheckCStack(interp, localIntPtr)	1
#   define GetCStackParams(iPtr)		/* do nothing */
#elif defined(TCL_CROSS_COMPILE)

    Tcl_MutexUnlock(&cancelLock);

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
/*
 * This variable is static and only set *once*, during library initialization.
 * It therefore needs no thread guards.
        Tcl_DeleteHashTable(&commandTypeTable);
        commandTypeInit = 0;
    }
    Tcl_MutexUnlock(&commandTypeLock);
 */

static int stackGrowsDown = 1;
#   define GetCStackParams(iPtr) \
}
    stackGrowsDown = TclpGetCStackParams(&((iPtr)->stackBound))
#   define CheckCStack(iPtr, localIntPtr) \
    (stackGrowsDown \
	    ? ((localIntPtr) > (iPtr)->stackBound) \
	    : ((localIntPtr) < (iPtr)->stackBound) \
    )
#else /* !TCL_NO_STACK_CHECK && !TCL_CROSS_COMPILE */
#   define GetCStackParams(iPtr) \
    TclpGetCStackParams(&((iPtr)->stackBound))
#   ifdef TCL_STACK_GROWS_UP
#	define CheckCStack(iPtr, localIntPtr) \
	   (!(iPtr)->stackBound || (localIntPtr) < (iPtr)->stackBound)
#    else /* TCL_STACK_GROWS_UP */
#	define CheckCStack(iPtr, localIntPtr) \
	   ((localIntPtr) > (iPtr)->stackBound)
#    endif /* TCL_STACK_GROWS_UP */
#endif /* TCL_NO_STACK_CHECK/TCL_CROSS_COMPILE */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateInterp --
 *
 *	Create a new TCL command interpreter.
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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

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
756
757


758
759
760
761
762
763
764
765
766
767
768
769
770
771

772
773
774
775
776
777
778
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
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







-
-
-









+

-
+







+



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



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+


-
+
-
-
-
+

-







-
-






-
-
+
+



-
-
-
-
+
+
+
+












-
-
-
-
-
-
-
-
-
-
-








+
+
+
+





-


-
+
-

-
+
+

-
-
+
+














+







    Interp *iPtr;
    Tcl_Interp *interp;
    Command *cmdPtr;
    const BuiltinFuncDef *builtinFuncPtr;
    const OpCmdInfo *opcmdInfoPtr;
    const CmdInfo *cmdInfoPtr;
    Tcl_Namespace *nsPtr;
    Tcl_HashEntry *hPtr;
    int isNew;
    CancelInfo *cancelInfo;
    union {
	char c[sizeof(short)];
	short s;
    } order;
#ifdef TCL_COMPILE_STATS
    ByteCodeStats *statsPtr;
#endif /* TCL_COMPILE_STATS */
    char mathFuncName[32];
    CallFrame *framePtr;
    int result;

    Tcl_InitSubsystems();
    TclInitSubsystems();

    /*
     * Panic if someone updated the CallFrame structure without also updating
     * the Tcl_CallFrame structure (or vice versa).
     */

    if (sizeof(Tcl_CallFrame) < sizeof(CallFrame)) {
	/*NOTREACHED*/
	Tcl_Panic("Tcl_CallFrame must not be smaller than CallFrame");
    }

#if defined(_WIN32) && !defined(_WIN64)
    if (sizeof(time_t) != 8) {
	Tcl_Panic("<time.h> is not compatible with VS2005+");
#if defined(_WIN32) && !defined(_WIN64) && !defined(_USE_64BIT_TIME_T)
    /* If Tcl is compiled on Win32 using -D_USE_64BIT_TIME_T
     * the result is a binary incompatible with the 'standard' build of
    }
    if ((offsetof(Tcl_StatBuf,st_atime) != 32)
	    || (offsetof(Tcl_StatBuf,st_ctime) != 48)) {
	Tcl_Panic("<sys/stat.h> is not compatible with VS2005+");
     * Tcl: All extensions using Tcl_StatBuf need to be recompiled in
     * the same way. Therefore, this is not officially supported.
     * In stead, it is recommended to use Win64 or Tcl 9.0 (not released yet)
     */
    if ((TclOffset(Tcl_StatBuf,st_atime) != 32)
	    || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) {
	/*NOTREACHED*/
	Tcl_Panic("<sys/stat.h> is not compatible with MSVC");
    }
#endif

    if (cancelTableInitialized == 0) {
	Tcl_MutexLock(&cancelLock);
	if (cancelTableInitialized == 0) {
	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
	    cancelTableInitialized = 1;
	}

	Tcl_MutexUnlock(&cancelLock);
    }

    if (commandTypeInit == 0) {
        TclRegisterCommandTypeName(TclObjInterpProc, "proc");
        TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
        TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
        TclRegisterCommandTypeName(TclChildObjCmd, "interp");
        TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
        TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
        TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
        TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass");
        TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine");
    }

    /*
     * Initialize support for namespaces and create the global namespace
     * (whose name is ""; an alias is "::"). This also initializes the Tcl
     * object type table and other object management code.
     */

    iPtr = (Interp *)Tcl_Alloc(sizeof(Interp));
    iPtr = (Interp *) ckalloc(sizeof(Interp));
    interp = (Tcl_Interp *) iPtr;

    iPtr->legacyResult = NULL;
    iPtr->result = iPtr->resultSpace;
    /* Special invalid value: Any attempt to free the legacy result
     * will cause a crash. */
    iPtr->legacyFreeProc = (void (*) (void))-1;
    iPtr->freeProc = NULL;
    iPtr->errorLine = 0;
    iPtr->stubTable = &tclStubs;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

    iPtr->optimizer = TclOptimizeBytecode;

    iPtr->numLevels = 0;
    iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
    iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
    iPtr->varFramePtr = NULL;	/* Initialise as soon as :: is available */

    /*
     * TIP #280 - Initialize the arrays used to extend the ByteCode and Proc
     * structures.
     * TIP #280 - Initialize the arrays used to extend the ByteCode and
     * Proc structures.
     */

    iPtr->cmdFramePtr = NULL;
    iPtr->linePBodyPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
    iPtr->lineLAPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
    iPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
    iPtr->linePBodyPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineBCPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    iPtr->lineLAPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
    iPtr->lineLABCPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
    Tcl_InitHashTable(iPtr->linePBodyPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS);
    Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);
    iPtr->scriptCLLocPtr = NULL;

    iPtr->activeVarTracePtr = NULL;

    iPtr->returnOpts = NULL;
    iPtr->errorInfo = NULL;
    TclNewLiteralStringObj(iPtr->eiVar, "::errorInfo");
    Tcl_IncrRefCount(iPtr->eiVar);
    iPtr->errorStack = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(iPtr->errorStack);
    iPtr->resetErrorStack = 1;
    TclNewLiteralStringObj(iPtr->upLiteral,"UP");
    Tcl_IncrRefCount(iPtr->upLiteral);
    TclNewLiteralStringObj(iPtr->callLiteral,"CALL");
    Tcl_IncrRefCount(iPtr->callLiteral);
    TclNewLiteralStringObj(iPtr->innerLiteral,"INNER");
    Tcl_IncrRefCount(iPtr->innerLiteral);
    iPtr->innerContext = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(iPtr->innerContext);
    iPtr->errorCode = NULL;
    TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
    Tcl_IncrRefCount(iPtr->ecVar);
    iPtr->returnLevel = 1;
    iPtr->returnCode = TCL_OK;

    iPtr->rootFramePtr = NULL;	/* Initialise as soon as :: is available */
    iPtr->lookupNsPtr = NULL;

    iPtr->appendResult = NULL;
    iPtr->appendAvl = 0;
    iPtr->appendUsed = 0;

    Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
    iPtr->packageUnknown = NULL;

    /* TIP #268 */
#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
    if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
	iPtr->packagePrefer = PKG_PREFER_STABLE;
    } else
    } else {
#endif
	iPtr->packagePrefer = PKG_PREFER_LATEST;

    }

    iPtr->cmdCount = 0;
    TclInitLiteralTable(&iPtr->literalTable);
    iPtr->compileEpoch = 1;
    TclInitLiteralTable(&(iPtr->literalTable));
    iPtr->compileEpoch = 0;
    iPtr->compiledProcPtr = NULL;
    iPtr->resolverPtr = NULL;
    iPtr->evalFlags = 0;
    iPtr->scriptFile = NULL;
    iPtr->flags = 0;
    iPtr->tracePtr = NULL;
    iPtr->tracesForbiddingInline = 0;
    iPtr->activeCmdTracePtr = NULL;
    iPtr->activeInterpTracePtr = NULL;
    iPtr->assocData = NULL;
    iPtr->execEnvPtr = NULL;	/* Set after namespaces initialized. */
    iPtr->emptyObjPtr = Tcl_NewObj();
				/* Another empty object. */
    Tcl_IncrRefCount(iPtr->emptyObjPtr);
    iPtr->resultSpace[0] = 0;
    iPtr->threadId = Tcl_GetCurrentThread();

    /* TIP #378 */
#ifdef TCL_INTERP_DEBUG_FRAME
    iPtr->flags |= INTERP_DEBUG_FRAME;
#else
    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
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
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
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
611
612
613
614
615
616
617
618
619

620
621
622
623
624
625
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
686

687
688
689
690
691




692
693
694
695
696


697
698


699

700


701
702
703
704
705
706
707







-
-
+
+

+
+
+













-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+



-
+






-
-
-
+
+
+










-
+


+
+
+
+
+
+




-
+
+
+








-
+
-


-
-
+
+





-
+
+
+
+
+
+
+












-
+
+
+
+

-
+
-






-
+












-
-
-


-





-
-
-
-
+
+
+


-
-


-
-

-

-
-








    /*
     * Initialise the rootCallframe. It cannot be allocated on the stack, as
     * it has to be in place before TclCreateExecEnv tries to use a variable.
     */

    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
    framePtr = (CallFrame *)Tcl_Alloc(sizeof(CallFrame));
    (void) Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
    framePtr = (CallFrame *) ckalloc(sizeof(CallFrame));
    result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
	    (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
    if (result != TCL_OK) {
	Tcl_Panic("Tcl_CreateInterp: failed to push the root stack frame");
    }
    framePtr->objc = 0;

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;
    iPtr->rootFramePtr = framePtr;

    /*
     * Initialize support for code compilation and execution. We call
     * TclCreateExecEnv after initializing namespaces since it tries to
     * reference a Tcl variable (it links to the Tcl "tcl_traceExec"
     * variable).
     */

    iPtr->execEnvPtr = TclCreateExecEnv(interp, INTERP_STACK_INITIAL_SIZE);
    iPtr->execEnvPtr = TclCreateExecEnv(interp);

    /*
     * TIP #219, Tcl Channel Reflection API support.
     */

    iPtr->chanMsg = NULL;

    /*
     * TIP #285, Script cancellation support.
     */

    iPtr->asyncCancelMsg = Tcl_NewObj();

    cancelInfo = (CancelInfo *)Tcl_Alloc(sizeof(CancelInfo));
    cancelInfo->interp = interp;

    iPtr->asyncCancel = Tcl_AsyncCreate(CancelEvalProc, cancelInfo);
    cancelInfo->async = iPtr->asyncCancel;
    cancelInfo->result = NULL;
    cancelInfo->length = 0;

    Tcl_MutexLock(&cancelLock);
    hPtr = Tcl_CreateHashEntry(&cancelTable, iPtr, &isNew);
    Tcl_SetHashValue(hPtr, cancelInfo);
    Tcl_MutexUnlock(&cancelLock);

    /*
     * Initialize the compilation and execution statistics kept for this
     * interpreter.
     */

#ifdef TCL_COMPILE_STATS
    statsPtr = &iPtr->stats;
    statsPtr = &(iPtr->stats);
    statsPtr->numExecutions = 0;
    statsPtr->numCompilations = 0;
    statsPtr->numByteCodesFreed = 0;
    memset(statsPtr->instructionCount, 0,
    (void) memset(statsPtr->instructionCount, 0,
	    sizeof(statsPtr->instructionCount));

    statsPtr->totalSrcBytes = 0.0;
    statsPtr->totalByteCodeBytes = 0.0;
    statsPtr->currentSrcBytes = 0.0;
    statsPtr->currentByteCodeBytes = 0.0;
    memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
    memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount));
    memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount));
    (void) memset(statsPtr->srcCount, 0, sizeof(statsPtr->srcCount));
    (void) memset(statsPtr->byteCodeCount, 0, sizeof(statsPtr->byteCodeCount));
    (void) memset(statsPtr->lifetimeCount, 0, sizeof(statsPtr->lifetimeCount));

    statsPtr->currentInstBytes = 0.0;
    statsPtr->currentLitBytes = 0.0;
    statsPtr->currentExceptBytes = 0.0;
    statsPtr->currentAuxBytes = 0.0;
    statsPtr->currentCmdMapBytes = 0.0;

    statsPtr->numLiteralsCreated = 0;
    statsPtr->totalLitStringBytes = 0.0;
    statsPtr->currentLitStringBytes = 0.0;
    memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
    (void) memset(statsPtr->literalCount, 0, sizeof(statsPtr->literalCount));
#endif /* TCL_COMPILE_STATS */

    /*
     * Initialise the stub table pointer.
     */

    iPtr->stubTable = &tclStubs;

    /*
     * Initialize the ensemble error message rewriting support.
     */

    TclResetRewriteEnsemble(interp, 1);
    iPtr->ensembleRewrite.sourceObjs = NULL;
    iPtr->ensembleRewrite.numRemovedObjs = 0;
    iPtr->ensembleRewrite.numInsertedObjs = 0;

    /*
     * TIP#143: Initialise the resource limit support.
     */

    TclInitLimitSupport(interp);

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

#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = (AllocCache *)TclpGetAllocCache();
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

    /*
     * Insure that the stack checking mechanism for this interp is
     * initialized.
     */

    GetCStackParams(iPtr);

    /*
     * Create the core commands. Do it here, rather than calling
     * Tcl_CreateCommand, because it's faster (there's no need to check for a
     * pre-existing command by the same name). If a command has a Tcl_CmdProc
     * but no Tcl_ObjCmdProc, set the Tcl_ObjCmdProc to
     * TclInvokeStringCommand. This is an object-based wrapper function that
     * extracts strings, calls the string function, and creates an object for
     * the result. Similarly, if a command has a Tcl_ObjCmdProc but no
     * Tcl_CmdProc, set the Tcl_CmdProc to TclInvokeObjectCommand.
     */

    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
    for (cmdInfoPtr = builtInCmds;  cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	int isNew;
	Tcl_HashEntry *hPtr;

	if ((cmdInfoPtr->objProc == NULL)
		&& (cmdInfoPtr->compileProc == NULL)
		&& (cmdInfoPtr->compileProc == NULL)) {
		&& (cmdInfoPtr->nreProc == NULL)) {
	    Tcl_Panic("builtin command with NULL object command proc and a NULL compile proc");
	}

	hPtr = Tcl_CreateHashEntry(&iPtr->globalNsPtr->cmdTable,
		cmdInfoPtr->name, &isNew);
	if (isNew) {
	    cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
	    cmdPtr = (Command *) ckalloc(sizeof(Command));
	    cmdPtr->hPtr = hPtr;
	    cmdPtr->nsPtr = iPtr->globalNsPtr;
	    cmdPtr->refCount = 1;
	    cmdPtr->cmdEpoch = 0;
	    cmdPtr->compileProc = cmdInfoPtr->compileProc;
	    cmdPtr->proc = TclInvokeObjectCommand;
	    cmdPtr->clientData = cmdPtr;
	    cmdPtr->objProc = cmdInfoPtr->objProc;
	    cmdPtr->objClientData = NULL;
	    cmdPtr->deleteProc = NULL;
	    cmdPtr->deleteData = NULL;
	    cmdPtr->flags = 0;
            if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) {
                cmdPtr->flags |= CMD_COMPILES_EXPANDED;
            }
	    cmdPtr->importRefPtr = NULL;
	    cmdPtr->tracePtr = NULL;
	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

    /*
     * Create the "array", "binary", "chan", "clock", "dict", "encoding",
     * "file", "info", "namespace" and "string" ensembles. Note that all these
     * commands (and their subcommands that are not present in the global
     * namespace) are wholly safe *except* for "clock", "encoding" and "file".
     * Create the "chan", "dict", "info" and "string" ensembles. Note that all
     * these commands (and their subcommands that are not present in the
     * global namespace) are wholly safe.
     */

    TclInitArrayCmd(interp);
    TclInitBinaryCmd(interp);
    TclInitChanCmd(interp);
    TclInitDictCmd(interp);
    TclInitEncodingCmd(interp);
    TclInitFileCmd(interp);
    TclInitInfoCmd(interp);
    TclInitNamespaceCmd(interp);
    TclInitStringCmd(interp);
    TclInitPrefixCmd(interp);
    TclInitProcessCmd(interp);

    /*
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */

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
716
717
718
719
720
721
722

723
724
725
726

727




728






729





730
731
732
733
734
735
736
737
738







-
+



-
+
-
-
-
-

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







     * Register the default [interp bgerror] handler.
     */

    Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
	    TclDefaultBgErrorHandlerObjCmd, NULL, NULL);

    /*
     * Create unsupported commands for debugging bytecode and objects.
     * Create an unsupported command for debugging bytecode.
     */

    Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
	    Tcl_DisassembleObjCmd, INT2PTR(0), NULL);
	    Tcl_DisassembleObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode",
	    Tcl_DisassembleObjCmd, INT2PTR(1), NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
	    Tcl_RepresentationCmd, NULL, NULL);

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

    /* Create an unsupported command for timerate */
    /* Coroutine monkeybusiness */
    Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
	    NRInjectObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
            CoroTypeObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::timerate",
	    Tcl_TimeRateObjCmd, NULL, NULL);

    /* Export unsupported commands */
    nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
    if (nsPtr) {
	Tcl_Export(interp, nsPtr, "*", 1);
    }

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
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







+

-




-
+








+



-
+
-
-
+

-
+
+







     * Register the builtin math functions.
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("Can't create math function namespace");
    }
    strcpy(mathFuncName, "::tcl::mathfunc::");
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
	    builtinFuncPtr++) {
	strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name);
	Tcl_CreateObjCommand(interp, mathFuncName,
		builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL);
		builtinFuncPtr->objCmdProc, builtinFuncPtr->clientData, NULL);
	Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0);
    }

    /*
     * Register the mathematical "operator" commands. [TIP #174]
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathop", NULL, NULL);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    if (nsPtr == NULL) {
	Tcl_Panic("can't create math operator namespace");
    }
    Tcl_Export(interp, nsPtr, "*", 1);
    (void) Tcl_Export(interp, nsPtr, "*", 1);
#define MATH_OP_PREFIX_LEN 15 /* == strlen("::tcl::mathop::") */
    memcpy(mathFuncName, "::tcl::mathop::", MATH_OP_PREFIX_LEN);
    strcpy(mathFuncName, "::tcl::mathop::");
    for (opcmdInfoPtr=mathOpCmds ; opcmdInfoPtr->name!=NULL ; opcmdInfoPtr++){
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)Tcl_Alloc(sizeof(TclOpCmdClientData));
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)
		ckalloc(sizeof(TclOpCmdClientData));

	occdPtr->op = opcmdInfoPtr->name;
	occdPtr->i.numArgs = opcmdInfoPtr->i.numArgs;
	occdPtr->expected = opcmdInfoPtr->expected;
	strcpy(mathFuncName + MATH_OP_PREFIX_LEN, opcmdInfoPtr->name);
	cmdPtr = (Command *) Tcl_CreateObjCommand(interp, mathFuncName,
		opcmdInfoPtr->objProc, occdPtr, DeleteOpCmdClientData);
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

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
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







-
+



-
+





-
-
+
+
+
+
+


-
+

















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

-

-







-
+

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








    order.s = 1;
    Tcl_SetVar2(interp, "tcl_platform", "byteOrder",
	    ((order.c[0] == 1) ? "littleEndian" : "bigEndian"),
	    TCL_GLOBAL_ONLY);

    Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
	    Tcl_NewWideIntObj(sizeof(long)), TCL_GLOBAL_ONLY);
	    Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);

    /* TIP #291 */
    Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
	    Tcl_NewWideIntObj(sizeof(void *)), TCL_GLOBAL_ONLY);
	    Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);

    /*
     * Set up other variables such as tcl_version and tcl_library
     */

    Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
    Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, NULL);
    TclpSetVariables(interp);

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

    Tcl_SetVar2(interp, "tcl_platform", "threaded", "1", TCL_GLOBAL_ONLY);
#endif

    /*
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);

    if (TclTommath_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }

#ifdef Tcl_InitStubs
    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }

#undef Tcl_InitStubs
    /*
     * Only build in zlib support if we've successfully detected a library to
     * compile and link against.
     */

#endif
#ifdef HAVE_ZLIB
    if (TclZlibInit(interp) != TCL_OK) {
    Tcl_InitStubs(interp, TCL_VERSION, 1);
	Tcl_Panic("%s", Tcl_GetStringResult(interp));
    }
    if (TclZipfs_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetStringResult(interp));

    if (TclTommath_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
    }
#endif

    TOP_CB(iPtr) = NULL;
    return interp;
}

static void
DeleteOpCmdClientData(
    ClientData clientData)
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    TclOpCmdClientData *occdPtr = clientData;

    Tcl_Free(occdPtr);
    ckfree((char *) occdPtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * TclRegisterCommandTypeName, TclGetCommandTypeName --
 *
 *      Command type registration and lookup mechanism. Everything is keyed by
 *      the Tcl_ObjCmdProc for the command, and that is used as the *key* into
 *      the hash table that maps to constant strings that are names. (It is
 *      recommended that those names be ASCII.)
 *
 * ---------------------------------------------------------------------
 */

void
TclRegisterCommandTypeName(
    Tcl_ObjCmdProc *implementationProc,
    const char *nameStr)
{
    Tcl_HashEntry *hPtr;

    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit == 0) {
        Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
        commandTypeInit = 1;
    }
    if (nameStr != NULL) {
        int isNew;

        hPtr = Tcl_CreateHashEntry(&commandTypeTable,
                (void *) implementationProc, &isNew);
        Tcl_SetHashValue(hPtr, (void *) nameStr);
    } else {
        hPtr = Tcl_FindHashEntry(&commandTypeTable,
                (void *) implementationProc);
        if (hPtr != NULL) {
            Tcl_DeleteHashEntry(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);
}

const char *
TclGetCommandTypeName(
    Tcl_Command command)
{
    Command *cmdPtr = (Command *) command;
    Tcl_ObjCmdProc *procPtr = cmdPtr->objProc;
    const char *name = "native";

    if (procPtr == NULL) {
        procPtr = cmdPtr->nreProc;
    }
    Tcl_MutexLock(&commandTypeLock);
    if (commandTypeInit) {
        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);

        if (hPtr && Tcl_GetHashValue(hPtr)) {
            name = (const char *) Tcl_GetHashValue(hPtr);
        }
    }
    Tcl_MutexUnlock(&commandTypeLock);

    return name;
}

/*
 *----------------------------------------------------------------------
 *
 * TclHideUnsafeCommands --
 *
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
1348
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







-
+
-





-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







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

int
TclHideUnsafeCommands(
    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
{
    const CmdInfo *cmdInfoPtr;
    register const CmdInfo *cmdInfoPtr;
    const UnsafeEnsembleInfo *unsafePtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	if (!cmdInfoPtr->isSafe) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }

    for (unsafePtr = unsafeEnsembleCommands;
            unsafePtr->ensembleNsName; unsafePtr++) {
        if (unsafePtr->commandName) {
            /*
             * Hide an ensemble subcommand.
             */

            Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s",
                    unsafePtr->ensembleNsName, unsafePtr->commandName);
            Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s",
                    unsafePtr->ensembleNsName, unsafePtr->commandName);

            if (TclRenameCommand(interp, TclGetString(cmdName),
                        "___tmp") != TCL_OK
                    || Tcl_HideCommand(interp, "___tmp",
                            TclGetString(hideName)) != TCL_OK) {
                Tcl_Panic("problem making '%s %s' safe: %s",
                        unsafePtr->ensembleNsName, unsafePtr->commandName,
                        Tcl_GetStringResult(interp));
            }
            Tcl_CreateObjCommand(interp, TclGetString(cmdName),
                    BadEnsembleSubcommand, (void *)unsafePtr, NULL);
            TclDecrRefCount(cmdName);
            TclDecrRefCount(hideName);
        } else {
            /*
             * Hide an ensemble main command (for compatibility).
             */

            if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName,
                    unsafePtr->ensembleNsName) != TCL_OK) {
                Tcl_Panic("problem making '%s' safe: %s",
                        unsafePtr->ensembleNsName,
                        Tcl_GetStringResult(interp));
            }
        }
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BadEnsembleSubcommand --
 *
 *	Command used to act as a backstop implementation when subcommands of
 *	ensembles are unsafe (the real implementations of the subcommands are
 *	hidden). The clientData is description of what was hidden.
 *
 * Results:
 *	A standard Tcl result (always a TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
BadEnsembleSubcommand(
    ClientData clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
    const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData;

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "not allowed to invoke subcommand %s of %s",
            infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
    return TCL_ERROR;
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *	Arrange for a function to be called before a given interpreter is
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
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







-
+


-
+






-
+







    Tcl_InterpDeleteProc *proc,	/* Function to call when interpreter is about
				 * to be deleted. */
    ClientData clientData)	/* One-word value to pass to proc. */
{
    Interp *iPtr = (Interp *) interp;
    static Tcl_ThreadDataKey assocDataCounterKey;
    int *assocDataCounterPtr =
	    (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
	    Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
    int isNew;
    char buffer[32 + TCL_INTEGER_SPACE];
    AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData));
    AssocData *dPtr = (AssocData *) ckalloc(sizeof(AssocData));
    Tcl_HashEntry *hPtr;

    sprintf(buffer, "Assoc Data Key #%d", *assocDataCounterPtr);
    (*assocDataCounterPtr)++;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, buffer, &isNew);
    dPtr->proc = proc;
    dPtr->clientData = clientData;
    Tcl_SetHashValue(hPtr, dPtr);
}
1424
1425
1426
1427
1428
1429
1430
1431

1432
1433

1434
1435
1436
1437
1438
1439
1440
995
996
997
998
999
1000
1001

1002
1003

1004
1005
1006
1007
1008
1009
1010
1011







-
+

-
+








    hTablePtr = iPtr->assocData;
    if (hTablePtr == NULL) {
	return;
    }
    for (hPtr = Tcl_FirstHashEntry(hTablePtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	dPtr = (AssocData *) Tcl_GetHashValue(hPtr);
	if ((dPtr->proc == proc) && (dPtr->clientData == clientData)) {
	    Tcl_Free(dPtr);
	    ckfree((char *) dPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    return;
	}
    }
}

/*
1466
1467
1468
1469
1470
1471
1472
1473

1474
1475
1476
1477
1478

1479
1480

1481
1482
1483
1484
1485
1486
1487
1037
1038
1039
1040
1041
1042
1043

1044
1045
1046
1047
1048

1049
1050

1051
1052
1053
1054
1055
1056
1057
1058







-
+




-
+

-
+







{
    Interp *iPtr = (Interp *) interp;
    AssocData *dPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (iPtr->assocData == NULL) {
	iPtr->assocData = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	iPtr->assocData = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(iPtr->assocData, TCL_STRING_KEYS);
    }
    hPtr = Tcl_CreateHashEntry(iPtr->assocData, name, &isNew);
    if (isNew == 0) {
	dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	dPtr = Tcl_GetHashValue(hPtr);
    } else {
	dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData));
	dPtr = (AssocData *) ckalloc(sizeof(AssocData));
    }
    dPtr->proc = proc;
    dPtr->clientData = clientData;

    Tcl_SetHashValue(hPtr, dPtr);
}

1514
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525

1526
1527
1528
1529
1530
1531
1532
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095

1096
1097
1098
1099
1100
1101
1102
1103







-
+



-
+







    if (iPtr->assocData == NULL) {
	return;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
	return;
    }
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    dPtr = Tcl_GetHashValue(hPtr);
    if (dPtr->proc != NULL) {
	dPtr->proc(dPtr->clientData, interp);
    }
    Tcl_Free(dPtr);
    ckfree((char *) dPtr);
    Tcl_DeleteHashEntry(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAssocData --
1559
1560
1561
1562
1563
1564
1565
1566

1567
1568
1569
1570
1571
1572
1573
1130
1131
1132
1133
1134
1135
1136

1137
1138
1139
1140
1141
1142
1143
1144







-
+







    if (iPtr->assocData == NULL) {
	return NULL;
    }
    hPtr = Tcl_FindHashEntry(iPtr->assocData, name);
    if (hPtr == NULL) {
	return NULL;
    }
    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
    dPtr = Tcl_GetHashValue(hPtr);
    if (procPtr != NULL) {
	*procPtr = dPtr->proc;
    }
    return dPtr->clientData;
}

/*
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683

1684
1685
1686
1687

1688
1689
1690
1691
1692
1693
1694
1244
1245
1246
1247
1248
1249
1250

1251
1252

1253

1254
1255

1256
1257
1258
1259
1260
1261
1262
1263







-


-
+
-


-
+







    Tcl_Interp *interp)		/* Interpreter to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *hTablePtr;
    ResolverScheme *resPtr, *nextResPtr;
    int i;

    /*
     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup,
     * Punt if there is an error in the Tcl_Release/Tcl_Preserve matchup.
	 * unless we are exiting.
     */

    if ((iPtr->numLevels > 0) && !TclInExit()) {
    if (iPtr->numLevels > 0) {
	Tcl_Panic("DeleteInterpProc called with active evals");
    }

    /*
     * The interpreter should already be marked deleted; otherwise how did we
     * get here?
     */
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
1271
1272
1273
1274
1275
1276
1277































1278
1279
1280
1281
1282
1283
1284







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







     */

    if (iPtr->chanMsg != NULL) {
	Tcl_DecrRefCount(iPtr->chanMsg);
	iPtr->chanMsg = NULL;
    }

    /*
     * TIP #285, Script cancellation support. Delete this interp from the
     * global hash table of CancelInfo structs.
     */

    Tcl_MutexLock(&cancelLock);
    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) iPtr);
    if (hPtr != NULL) {
	CancelInfo *cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr);

	if (cancelInfo != NULL) {
	    if (cancelInfo->result != NULL) {
		Tcl_Free(cancelInfo->result);
	    }
	    Tcl_Free(cancelInfo);
	}

	Tcl_DeleteHashEntry(hPtr);
    }

    if (iPtr->asyncCancel != NULL) {
	Tcl_AsyncDelete(iPtr->asyncCancel);
	iPtr->asyncCancel = NULL;
    }

    if (iPtr->asyncCancelMsg != NULL) {
	Tcl_DecrRefCount(iPtr->asyncCancelMsg);
	iPtr->asyncCancelMsg = NULL;
    }
    Tcl_MutexUnlock(&cancelLock);

    /*
     * Shut down all limit handler callback scripts that call back into this
     * interpreter. Then eliminate all limit handlers for this interpreter.
     */

    TclRemoveScriptLimitCallbacks(interp);
    TclLimitRemoveAllHandlers(interp);
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
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
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
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
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
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
1439
1440



1441
1442
1443
1444




1445
1446
1447
1448
1449






1450
1451
1452
1453
1454
1455
1456



1457
1458
1459
1460
1461






1462
1463
1464
1465
1466
1467
1468
1469




1470
1471
1472
1473


1474




1475
1476
1477
1478
1479
1480
1481
1482


1483
1484
1485



1486
1487
1488
1489





1490
1491
1492
1493
1494
1495


1496
1497
1498




1499
1500
1501
1502




1503
1504
1505
1506

1507
1508
1509
1510
1511
1512
1513
1514







-
+





-
+
+


-
+















-
+




-
+


-
+







-
+



-
+








+
+












-
-
-
-
-
-


+
+
+
+


















-
-
+
+








-
+






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

-
-
-
+
+
+

-
-
-
-
+
+
+
+

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

-
-
-
+
+
+

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

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


+
+
+
+
+
+
-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

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




-
+







     */

    hTablePtr = iPtr->hiddenCmdTablePtr;
    if (hTablePtr != NULL) {
	/*
	 * Non-pernicious deletion. The deletion callbacks will not be allowed
	 * to create any new hidden or non-hidden commands.
	 * Tcl_DeleteCommandFromToken will remove the entry from the
	 * Tcl_DeleteCommandFromToken() will remove the entry from the
	 * hiddenCmdTablePtr.
	 */

	hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
	for (; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Tcl_DeleteCommandFromToken(interp, (Tcl_Command)Tcl_GetHashValue(hPtr));
	    Tcl_DeleteCommandFromToken(interp,
		    (Tcl_Command) Tcl_GetHashValue(hPtr));
	}
	Tcl_DeleteHashTable(hTablePtr);
	Tcl_Free(hTablePtr);
	ckfree((char *) hTablePtr);
    }

    /*
     * Invoke deletion callbacks; note that a callback can create new
     * callbacks, so we iterate.
     */

    while (iPtr->assocData != NULL) {
	AssocData *dPtr;

	hTablePtr = iPtr->assocData;
	iPtr->assocData = NULL;
	for (hPtr = Tcl_FirstHashEntry(hTablePtr, &search);
		hPtr != NULL;
		hPtr = Tcl_FirstHashEntry(hTablePtr, &search)) {
	    dPtr = (AssocData *)Tcl_GetHashValue(hPtr);
	    dPtr = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (dPtr->proc != NULL) {
		dPtr->proc(dPtr->clientData, interp);
	    }
	    Tcl_Free(dPtr);
	    ckfree((char *) dPtr);
	}
	Tcl_DeleteHashTable(hTablePtr);
	Tcl_Free(hTablePtr);
	ckfree((char *) hTablePtr);
    }

    /*
     * Pop the root frame pointer and finish deleting the global
     * namespace. The order is important [Bug 1658572].
     */

    if ((iPtr->framePtr != iPtr->rootFramePtr) && !TclInExit()) {
    if (iPtr->framePtr != iPtr->rootFramePtr) {
	Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
    }
    Tcl_PopCallFrame(interp);
    Tcl_Free(iPtr->rootFramePtr);
    ckfree((char *) iPtr->rootFramePtr);
    iPtr->rootFramePtr = NULL;
    Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
    interp->result = NULL;
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }
    Tcl_DecrRefCount(iPtr->eiVar);
    if (iPtr->errorInfo) {
	Tcl_DecrRefCount(iPtr->errorInfo);
	iPtr->errorInfo = NULL;
    }
    Tcl_DecrRefCount(iPtr->errorStack);
    iPtr->errorStack = NULL;
    Tcl_DecrRefCount(iPtr->upLiteral);
    Tcl_DecrRefCount(iPtr->callLiteral);
    Tcl_DecrRefCount(iPtr->innerLiteral);
    Tcl_DecrRefCount(iPtr->innerContext);
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
    }
    if (iPtr->appendResult != NULL) {
	ckfree(iPtr->appendResult);
	iPtr->appendResult = NULL;
    }
    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
	Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
    }
    if (iPtr->execEnvPtr != NULL) {
	TclDeleteExecEnv(iPtr->execEnvPtr);
    }
    if (iPtr->scriptFile) {
	Tcl_DecrRefCount(iPtr->scriptFile);
	iPtr->scriptFile = NULL;
    }
    Tcl_DecrRefCount(iPtr->emptyObjPtr);
    iPtr->emptyObjPtr = NULL;

    resPtr = iPtr->resolverPtr;
    while (resPtr) {
	nextResPtr = resPtr->nextPtr;
	Tcl_Free(resPtr->name);
	Tcl_Free(resPtr);
	ckfree(resPtr->name);
	ckfree((char *) resPtr);
	resPtr = nextResPtr;
    }

    /*
     * Free up literal objects created for scripts compiled by the
     * interpreter.
     */

    TclDeleteLiteralTable(interp, &iPtr->literalTable);
    TclDeleteLiteralTable(interp, &(iPtr->literalTable));

    /*
     * TIP #280 - Release the arrays for ByteCode/Proc extension, and
     * contents.
     */

    {
	Tcl_HashEntry *hPtr;
	Tcl_HashSearch hSearch;
	int i;

    for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	CmdFrame *cfPtr = (CmdFrame *)Tcl_GetHashValue(hPtr);
	Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);
	for (hPtr = Tcl_FirstHashEntry(iPtr->linePBodyPtr, &hSearch);
		hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    CmdFrame *cfPtr = Tcl_GetHashValue(hPtr);
	    Proc *procPtr = (Proc *) Tcl_GetHashKey(iPtr->linePBodyPtr, hPtr);

	procPtr->iPtr = NULL;
	if (cfPtr) {
	    if (cfPtr->type == TCL_LOCATION_SOURCE) {
		Tcl_DecrRefCount(cfPtr->data.eval.path);
	    }
	    Tcl_Free(cfPtr->line);
	    Tcl_Free(cfPtr);
	}
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->linePBodyPtr);
    Tcl_Free(iPtr->linePBodyPtr);
    iPtr->linePBodyPtr = NULL;
	    procPtr->iPtr = NULL;
	    if (cfPtr) {
		if (cfPtr->type == TCL_LOCATION_SOURCE) {
		    Tcl_DecrRefCount(cfPtr->data.eval.path);
		}
		ckfree((char *) cfPtr->line);
		ckfree((char *) cfPtr);
	    }
	    Tcl_DeleteHashEntry(hPtr);
	}
	Tcl_DeleteHashTable(iPtr->linePBodyPtr);
	ckfree((char *) iPtr->linePBodyPtr);
	iPtr->linePBodyPtr = NULL;

    /*
     * See also tclCompile.c, TclCleanupByteCode
     */
	/*
	 * See also tclCompile.c, TclCleanupByteCode
	 */

    for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &search);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ExtCmdLoc *eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hPtr);
	for (hPtr = Tcl_FirstHashEntry(iPtr->lineBCPtr, &hSearch);
		hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ExtCmdLoc *eclPtr = (ExtCmdLoc *) Tcl_GetHashValue(hPtr);

	if (eclPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(eclPtr->path);
	}
	for (i=0; i< eclPtr->nuloc; i++) {
	    Tcl_Free(eclPtr->loc[i].line);
	}
	    if (eclPtr->type == TCL_LOCATION_SOURCE) {
		Tcl_DecrRefCount(eclPtr->path);
	    }
	    for (i=0; i< eclPtr->nuloc; i++) {
		ckfree((char *) eclPtr->loc[i].line);
	    }

	if (eclPtr->loc != NULL) {
	    Tcl_Free(eclPtr->loc);
	}
	    if (eclPtr->loc != NULL) {
		ckfree((char *) eclPtr->loc);
	    }

	    Tcl_DeleteHashTable (&eclPtr->litInfo);
	Tcl_Free(eclPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(iPtr->lineBCPtr);
    Tcl_Free(iPtr->lineBCPtr);
    iPtr->lineBCPtr = NULL;

	    ckfree((char *) eclPtr);
	    Tcl_DeleteHashEntry(hPtr);
	}
	Tcl_DeleteHashTable(iPtr->lineBCPtr);
	ckfree((char *) iPtr->lineBCPtr);
	iPtr->lineBCPtr = NULL;

    /*
     * Location stack for uplevel/eval/... scripts which were passed through
     * proc arguments. Actually we track all arguments as we do not and cannot
     * know which arguments will be used as scripts and which will not.
	/*
	 * Location stack for uplevel/eval/... scripts which were passed
	 * through proc arguments. Actually we track all arguments as we
	 * don't, cannot know which arguments will be used as scripts and
     */

	 * which won't.
    if (iPtr->lineLAPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */

	if (iPtr->lineLAPtr->numEntries) {
	    /*
	     * When the interp goes away we have nothing on the stack, so
	     * there are no arguments, so this table has to be empty.
	     */

	Tcl_Panic("Argument location tracking table not empty");
    }
	    Tcl_Panic ("Argument location tracking table not empty");
	}

    Tcl_DeleteHashTable(iPtr->lineLAPtr);
    Tcl_Free(iPtr->lineLAPtr);
    iPtr->lineLAPtr = NULL;
	Tcl_DeleteHashTable (iPtr->lineLAPtr);
	ckfree((char*) iPtr->lineLAPtr);
	iPtr->lineLAPtr = NULL;

    if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
	/*
	 * When the interp goes away we have nothing on the stack, so there
	 * are no arguments, so this table has to be empty.
	 */
	if (iPtr->lineLABCPtr->numEntries) {
	    /*
	     * When the interp goes away we have nothing on the stack, so
	     * there are no arguments, so this table has to be empty.
	     */

	Tcl_Panic("Argument location tracking table not empty");
    }
	    Tcl_Panic ("Argument location tracking table not empty");
	}

    Tcl_DeleteHashTable(iPtr->lineLABCPtr);
    Tcl_Free(iPtr->lineLABCPtr);
    iPtr->lineLABCPtr = NULL;

	Tcl_DeleteHashTable (iPtr->lineLABCPtr);
	ckfree((char*) iPtr->lineLABCPtr);
	iPtr->lineLABCPtr = NULL;
    }
    /*
     * Squelch the tables of traces on variables and searches over arrays in
     * the in the interpreter.
     */

    Tcl_DeleteHashTable(&iPtr->varTraces);
    Tcl_DeleteHashTable(&iPtr->varSearches);

    Tcl_Free(iPtr);
    ckfree((char *) iPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_HideCommand --
 *
2024
2025
2026
2027
2028
2029
2030
2031

2032
2033

2034
2035
2036
2037
2038
2039
2040
2041
1566
1567
1568
1569
1570
1571
1572

1573
1574

1575

1576
1577
1578
1579
1580
1581
1582







-
+

-
+
-







     *
     * But as we currently limit ourselves to the global namespace only for
     * the source, in order to avoid potential confusion, lets prevent "::" in
     * the token too. - dl
     */

    if (strstr(hiddenCmdToken, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	Tcl_AppendResult(interp,
		"cannot use namespace qualifiers in hidden command"
		" token (rename)", -1));
		" token (rename)", NULL);
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", NULL);
	return TCL_ERROR;
    }

    /*
     * Find the command to hide. An error is returned if cmdName can't be
     * found. Look up the command only from the global namespace. Full path of
     * the command must be given if using namespaces.
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
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







-
-
+
+
-
-









-
+
+












-
-
+
+
-
-







    cmdPtr = (Command *) cmd;

    /*
     * Check that the command is really in global namespace
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only hide global namespace commands (use rename then hide)",
	Tcl_AppendResult(interp, "can only hide global namespace commands"
		" (use rename then hide)", NULL);
                -1));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", NULL);
	return TCL_ERROR;
    }

    /*
     * Initialize the hidden command table if necessary.
     */

    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr == NULL) {
	hiddenCmdTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	hiddenCmdTablePtr = (Tcl_HashTable *)
		ckalloc((unsigned) sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hiddenCmdTablePtr, TCL_STRING_KEYS);
	iPtr->hiddenCmdTablePtr = hiddenCmdTablePtr;
    }

    /*
     * It is an error to move an exposed command to a hidden command with
     * hiddenCmdToken if a hidden command with the name hiddenCmdToken already
     * exists.
     */

    hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "hidden command named \"%s\" already exists",
	Tcl_AppendResult(interp, "hidden command named \"", hiddenCmdToken,
		"\" already exists", NULL);
                hiddenCmdToken));
        Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", NULL);
	return TCL_ERROR;
    }

    /*
     * NB: This code is currently 'like' a rename to a specialy set apart name
     * table. Changes here and in TclRenameCommand must be kept in synch until
     * the common parts are actually factorized out.
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
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
1786
1787







-
-
+
+
-
-













-
-
+
-
-
+


-
+



-
+





-
+



-
-
-
+
+
+
















-
-
+
+
-



-
-
-
-
-
-
-
-
-
-
-







    /*
     * Check that we have a regular name for the command (that the user is not
     * trying to do an expose and a rename (to another namespace) at the same
     * time).
     */

    if (strstr(cmdName, "::") != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "cannot expose to a namespace (use expose to toplevel, then rename)",
	Tcl_AppendResult(interp, "cannot expose to a namespace "
		"(use expose to toplevel, then rename)", NULL);
                -1));
        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", NULL);
	return TCL_ERROR;
    }

    /*
     * Get the command from the hidden command table:
     */

    hPtr = NULL;
    hiddenCmdTablePtr = iPtr->hiddenCmdTablePtr;
    if (hiddenCmdTablePtr != NULL) {
	hPtr = Tcl_FindHashEntry(hiddenCmdTablePtr, hiddenCmdToken);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown hidden command \"%s\"", hiddenCmdToken));
	Tcl_AppendResult(interp, "unknown hidden command \"", hiddenCmdToken,
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN",
                hiddenCmdToken, NULL);
		"\"", NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
    cmdPtr = Tcl_GetHashValue(hPtr);

    /*
     * Check that we have a true global namespace command (enforced by
     * Tcl_HideCommand but let's double check. (If it was not, we would not
     * Tcl_HideCommand() but let's double check. (If it was not, we would not
     * really know how to handle it).
     */

    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
	/*
	 * This case is theoritically impossible, we might rather Tcl_Panic
	 * This case is theoritically impossible, we might rather Tcl_Panic()
	 * than 'nicely' erroring out ?
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"trying to expose a non-global command namespace command",
		-1));
	Tcl_AppendResult(interp,
		"trying to expose a non global command name space command",
		NULL);
	return TCL_ERROR;
    }

    /*
     * This is the global table.
     */

    nsPtr = cmdPtr->nsPtr;

    /*
     * It is an error to overwrite an existing exposed command as a result of
     * exposing a previously hidden command.
     */

    hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "exposed command \"%s\" already exists", cmdName));
	Tcl_AppendResult(interp, "exposed command \"", cmdName,
		"\" already exists", NULL);
        Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", NULL);
	return TCL_ERROR;
    }

    /*
     * Command resolvers (per-interp, per-namespace) might have resolved to a
     * command for the given namespace scope with this command not being
     * registered with the namespace's command table. During BC compilation,
     * the so-resolved command turns into a CmdName literal. Without
     * invalidating a possible CmdName literal here explicitly, such literals
     * keep being reused while pointing to overhauled commands.
     */

    TclInvalidateCmdLiteral(interp, cmdName, nsPtr);

    /*
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(nsPtr);
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
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







-
+





-
+

-
-
+
-
-
-
+


-
-
-
+
+
+
+



















-
-
-
+
+
+


-
+



-
-
-
-
-
-
-
-
-
-
-










-
+















-










-
+







        } else {
	    nsPtr = iPtr->globalNsPtr;
	    tail = cmdName;
        }

        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);

	if (isNew || deleted) {
        if (isNew || deleted) {
	    /*
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}
        }

	/*
         * An existing command conflicts. Try to delete it...
	/* An existing command conflicts. Try to delete it.. */
         */

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
	 * Be careful to preserve any existing import links so we can restore
	 * them down below. That way, you can redefine a command and its
	 * import status will remain intact.
	 * Be careful to preserve
	 * any existing import links so we can restore them down below. That
	 * way, you can redefine a command and its import status will remain
	 * intact.
	 */

	cmdPtr->refCount++;
	if (cmdPtr->importRefPtr) {
	    cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
	}

	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);

	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
	    oldRefPtr = cmdPtr->importRefPtr;
	    cmdPtr->importRefPtr = NULL;
	}
	TclCleanupCommandMacro(cmdPtr);
	deleted = 1;
    }

    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away the
	 * new command (if we try to delete it again, we could get stuck in an
	 * infinite loop).
	 * If the deletion callback recreated the command, just throw away
	 * the new command (if we try to delete it again, we could get
	 * stuck in an infinite loop).
	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
	ckfree((char *) Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {
	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
	 * being registered with the namespace's command table. During BC
	 * compilation, the so-resolved command turns into a CmdName literal.
	 * Without invalidating a possible CmdName literal here explicitly,
	 * such literals keep being reused while pointing to overhauled
	 * commands.
	 */

	TclInvalidateCmdLiteral(interp, tail, nsPtr);

	/*
	 * The list of command exported from the namespace might have changed.
	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
    cmdPtr = (Command *) ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = TclInvokeStringCommand;
    cmdPtr->objClientData = cmdPtr;
    cmdPtr->proc = proc;
    cmdPtr->clientData = clientData;
    cmdPtr->deleteProc = deleteProc;
    cmdPtr->deleteData = clientData;
    cmdPtr->flags = 0;
    cmdPtr->importRefPtr = NULL;
    cmdPtr->tracePtr = NULL;
    cmdPtr->nreProc = NULL;

    /*
     * Plug in any existing import references found above. Be sure to update
     * all of these references to point to the new command.
     */

    if (oldRefPtr != NULL) {
	cmdPtr->importRefPtr = oldRefPtr;
	while (oldRefPtr != NULL) {
	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;
	    dataPtr = (ImportedCmdData *)refCmdPtr->objClientData;
	    dataPtr = refCmdPtr->objClientData;
	    dataPtr->realCmdPtr = cmdPtr;
	    oldRefPtr = oldRefPtr->nextPtr;
	}
    }

    /*
     * We just created a command, so in its namespace and all of its parent
2511
2512
2513
2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033







+







 * Results:
 *	The return value is a token for the command, which can be used in
 *	future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *	If a command named "cmdName" already exists for interp, it is
 *	first deleted.  Then the new command is created from the arguments.
 *	[***] (See below for exception).
 *
 *	In the future, during bytecode evaluation when "cmdName" is seen as
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *
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






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
2658
2659



2660
2661
2662

2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715

2716
2717
2718
2719
2720
2721
2722
2723
2724
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







-
-
+
+


-


+

+
+

+
+






+



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

-
-
+
+

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

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

-
+





-
+

+
+
+

-
-
+
+
+
+
+
+

+
+
+
+
+
+
-
-
+
+
+

-
+










-
-
-
-
-
-

-
-
-








+


-
-
-
+
+
+


-
+



-
-
-
-
-
-
-
-
-
-
-
-









-
+















-










-
-
+
-
-







    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
				 * specified namespace; otherwise it is put in
				 * the global namespace. */
    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
				 * name. */
    ClientData clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc
    				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
)
{
    Interp *iPtr = (Interp *) interp;
    ImportRef *oldRefPtr = NULL;
    Namespace *nsPtr;
    Command *cmdPtr;
    Tcl_HashEntry *hPtr;
    const char *tail;
    int isNew = 0, deleted = 0;
    ImportedCmdData *dataPtr;

    if (iPtr->flags & DELETED) {
	/*
	 * The interpreter is being deleted. Don't create any new commands;
	 * it's not safe to muck with the interpreter anymore.
	 */

	return (Tcl_Command) NULL;
    }

    /*
     * If the command name we seek to create already exists, we need to
     * delete that first.  That can be tricky in the presence of traces.
     * Loop until we no longer find an existing command in the way, or
     * until we've deleted one command and that didn't finish the job.
     */

    while (1) {
    /*
     * Determine where the command should reside. If its name contains
     * namespace qualifiers, we put it in the specified namespace;
     * otherwise, we always put it in the global namespace.
     */
        /*
         * Determine where the command should reside. If its name contains
         * namespace qualifiers, we put it in the specified namespace;
	 * otherwise, we always put it in the global namespace.
         */

    if (strstr(cmdName, "::") != NULL) {
	Namespace *dummy1, *dummy2;
        if (strstr(cmdName, "::") != NULL) {
	    Namespace *dummy1, *dummy2;

	TclGetNamespaceForQualName(interp, cmdName, NULL,
	    TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
	if ((nsPtr == NULL) || (tail == NULL)) {
	    return (Tcl_Command) NULL;
	}
    } else {
	nsPtr = iPtr->globalNsPtr;
	tail = cmdName;
    }
	    TclGetNamespaceForQualName(interp, cmdName, NULL,
		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
	    if ((nsPtr == NULL) || (tail == NULL)) {
	        return (Tcl_Command) NULL;
	    }
        } else {
	    nsPtr = iPtr->globalNsPtr;
	    tail = cmdName;
        }

    return TclCreateObjCommandInNs(interp, tail, (Tcl_Namespace *) nsPtr,
	proc, clientData, deleteProc);
}

Tcl_Command
TclCreateObjCommandInNs(
    Tcl_Interp *interp,
    const char *cmdName,	/* Name of command, without any namespace
                                 * components. */
    Tcl_Namespace *namesp,   /* The namespace to create the command in */
    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
				 * name. */
    ClientData clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    int deleted = 0, isNew = 0;
    Command *cmdPtr;
    ImportRef *oldRefPtr = NULL;
    ImportedCmdData *dataPtr;
    Tcl_HashEntry *hPtr;
    Namespace *nsPtr = (Namespace *) namesp;

    /*
     * If the command name we seek to create already exists, we need to delete
     * that first. That can be tricky in the presence of traces. Loop until we
     * no longer find an existing command in the way, or until we've deleted
     * one command and that didn't finish the job.
     */

    while (1) {
	hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
        hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);

	if (isNew || deleted) {
        if (isNew || deleted) {
	    /*
	     * isNew - No conflict with existing command.
	     * deleted - We've already deleted a conflicting command
	     */
	    break;
	}
        }

	/* An existing command conflicts. Try to delete it.. */
	cmdPtr = Tcl_GetHashValue(hPtr);

	/*
         * An existing command conflicts. Try to delete it...
         */
	 * [***] This is wrong.  See Tcl Bug a16752c252.
	 * However, this buggy behavior is kept under particular
	 * circumstances to accommodate deployed binaries of the
	 * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
	 * that crash if the bug is fixed.
	 */

	if (cmdPtr->objProc == TclInvokeStringCommand
		&& cmdPtr->clientData == clientData
		&& cmdPtr->deleteData == clientData
		&& cmdPtr->deleteProc == deleteProc) {
	    cmdPtr->objProc = proc;
	    cmdPtr->objClientData = clientData;
	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);

	    return (Tcl_Command) cmdPtr;
	}

	/*
	 * Command already exists; delete it. Be careful to preserve any
	 * Otherwise, we delete the old command. Be careful to preserve any
	 * existing import links so we can restore them down below. That way,
	 * you can redefine a command and its import status will remain
	 * intact.
	 */

	cmdPtr->refCount++;
	if (cmdPtr->importRefPtr) {
	    cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
	}

	/*
         * Make sure namespace doesn't get deallocated.
         */

	cmdPtr->nsPtr->refCount++;

	Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
	nsPtr = (Namespace *) TclEnsureNamespace(interp,
                (Tcl_Namespace *) cmdPtr->nsPtr);
	TclNsDecrRefCount(cmdPtr->nsPtr);

	if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
	    oldRefPtr = cmdPtr->importRefPtr;
	    cmdPtr->importRefPtr = NULL;
	}
	TclCleanupCommandMacro(cmdPtr);
	deleted = 1;
    }

    if (!isNew) {
	/*
	 * If the deletion callback recreated the command, just throw away the
	 * new command (if we try to delete it again, we could get stuck in an
	 * infinite loop).
	 * If the deletion callback recreated the command, just throw away
	 * the new command (if we try to delete it again, we could get
	 * stuck in an infinite loop).
	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
	ckfree(Tcl_GetHashValue(hPtr));
    }

    if (!deleted) {
	/*
	 * Command resolvers (per-interp, per-namespace) might have resolved
	 * to a command for the given namespace scope with this command not
	 * being registered with the namespace's command table. During BC
	 * compilation, the so-resolved command turns into a CmdName literal.
	 * Without invalidating a possible CmdName literal here explicitly,
	 * such literals keep being reused while pointing to overhauled
	 * commands.
	 */

	TclInvalidateCmdLiteral(interp, cmdName, nsPtr);

	/*
	 * The list of command exported from the namespace might have changed.
	 * However, we do not need to recompute this just yet; next time we
	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = (Command *)Tcl_Alloc(sizeof(Command));
    cmdPtr = (Command *) ckalloc(sizeof(Command));
    Tcl_SetHashValue(hPtr, cmdPtr);
    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
    cmdPtr->objClientData = clientData;
    cmdPtr->proc = TclInvokeObjectCommand;
    cmdPtr->clientData = cmdPtr;
    cmdPtr->deleteProc = deleteProc;
    cmdPtr->deleteData = clientData;
    cmdPtr->flags = 0;
    cmdPtr->importRefPtr = NULL;
    cmdPtr->tracePtr = NULL;
    cmdPtr->nreProc = NULL;

    /*
     * Plug in any existing import references found above. Be sure to update
     * all of these references to point to the new command.
     */

    if (oldRefPtr != NULL) {
	cmdPtr->importRefPtr = oldRefPtr;
	while (oldRefPtr != NULL) {
	    Command *refCmdPtr = oldRefPtr->importedCmdPtr;

	    dataPtr = (ImportedCmdData*)refCmdPtr->objClientData;
	    dataPtr = refCmdPtr->objClientData;
	    cmdPtr->refCount++;
	    TclCleanupCommandMacro(dataPtr->realCmdPtr);
	    dataPtr->realCmdPtr = cmdPtr;
	    oldRefPtr = oldRefPtr->nextPtr;
	}
    }

    /*
     * We just created a command, so in its namespace and all of its parent
2752
2753
2754
2755
2756
2757
2758
2759

2760
2761
2762

2763
2764
2765

2766
2767
2768


2769
2770
2771
2772
2773
2774
2775
2776

2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794

2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808

2809
2810

2811
2812
2813
2814

2815
2816

2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832








2833
2834
2835
2836
2837
2838
2839

2840
2841
2842
2843
2844
2845
2846
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







-
+


-
+


-
+

-
-
+
+







-
+

















-
+













-
+

-
+



-
+

-
+










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






-
+







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

int
TclInvokeStringCommand(
    ClientData clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    register int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr = (Command *)clientData;
    Command *cmdPtr = clientData;
    int i, result;
    const char **argv = (const char **)
	    TclStackAlloc(interp, (objc + 1) * sizeof(char *));
	    TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));

    for (i = 0; i < objc; i++) {
	argv[i] = TclGetString(objv[i]);
    for (i = 0;  i < objc;  i++) {
	argv[i] = Tcl_GetString(objv[i]);
    }
    argv[objc] = 0;

    /*
     * Invoke the command's string-based Tcl_CmdProc.
     */

    result = cmdPtr->proc(cmdPtr->clientData, interp, objc, argv);
    result = (*cmdPtr->proc)(cmdPtr->clientData, interp, objc, argv);

    TclStackFree(interp, (void *) argv);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvokeObjectCommand --
 *
 *	"Wrapper" Tcl_CmdProc used to call an existing object-based
 *	Tcl_ObjCmdProc if no string-based function exists for a command. A
 *	pointer to this function is stored as the Tcl_CmdProc in a Command
 *	structure. It simply turns around and calls the object Tcl_ObjCmdProc
 *	in the Command structure.
 *
 * Results:
 *	A standard Tcl result value.
 *	A standard Tcl string result value.
 *
 * Side effects:
 *	Besides those side effects of the called Tcl_ObjCmdProc,
 *	TclInvokeObjectCommand allocates and frees storage.
 *
 *----------------------------------------------------------------------
 */

int
TclInvokeObjectCommand(
    ClientData clientData,	/* Points to command's Command structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)	/* Argument strings. */
    register const char **argv)	/* Argument strings. */
{
    Command *cmdPtr = ( Command *) clientData;
    Command *cmdPtr = (Command *) clientData;
    Tcl_Obj *objPtr;
    int i, length, result;
    Tcl_Obj **objv = (Tcl_Obj **)
	    TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *)));
	    TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));

    for (i = 0; i < argc; i++) {
    for (i = 0;  i < argc;  i++) {
	length = strlen(argv[i]);
	TclNewStringObj(objPtr, argv[i], length);
	Tcl_IncrRefCount(objPtr);
	objv[i] = objPtr;
    }

    /*
     * Invoke the command's object-based Tcl_ObjCmdProc.
     */

    if (cmdPtr->objProc != NULL) {
	result = cmdPtr->objProc(cmdPtr->objClientData, interp, argc, objv);
    } else {
	result = Tcl_NRCallObjProc(interp, cmdPtr->nreProc,
		cmdPtr->objClientData, argc, objv);
    }
    result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, argc, objv);

    /*
     * Move the interpreter's object result to the string result, then reset
     * the object result.
     */

    (void) Tcl_GetStringResult(interp);

    /*
     * Decrement the ref counts for the argument objects created above, then
     * free the objv array if malloc'ed storage was used.
     */

    for (i = 0; i < argc; i++) {
    for (i = 0;  i < argc;  i++) {
	objPtr = objv[i];
	Tcl_DecrRefCount(objPtr);
    }
    TclStackFree(interp, objv);
    return result;
}

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
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







-
+
-

-
+
-


+
+
+
+








-
+
+


-
-
-
-
-










-
-
+
+
-




-
-
+
+
-
-






-
+







     * Find the existing command. An error is returned if cmdName can't be
     * found.
     */

    cmd = Tcl_FindCommand(interp, oldName, NULL, /*flags*/ 0);
    cmdPtr = (Command *) cmd;
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_AppendResult(interp, "can't ",
                "can't %s \"%s\": command doesn't exist",
		((newName == NULL)||(*newName == '\0'))? "delete":"rename",
		oldName));
		" \"", oldName, "\": command doesn't exist", NULL);
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, NULL);
	return TCL_ERROR;
    }
    cmdNsPtr = cmdPtr->nsPtr;
    oldFullName = Tcl_NewObj();
    Tcl_IncrRefCount(oldFullName);
    Tcl_GetCommandFullName(interp, cmd, oldFullName);

    /*
     * If the new command name is NULL or empty, delete the command. Do this
     * with Tcl_DeleteCommandFromToken, since we already have the command.
     */

    if ((newName == NULL) || (*newName == '\0')) {
	Tcl_DeleteCommandFromToken(interp, cmd);
	return TCL_OK;
	result = TCL_OK;
	goto done;
    }

    cmdNsPtr = cmdPtr->nsPtr;
    oldFullName = Tcl_NewObj();
    Tcl_IncrRefCount(oldFullName);
    Tcl_GetCommandFullName(interp, cmd, oldFullName);

    /*
     * Make sure that the destination command does not already exist. The
     * rename operation is like creating a command, so we should automatically
     * create the containing namespaces just like Tcl_CreateCommand would.
     */

    TclGetNamespaceForQualName(interp, newName, NULL,
	    TCL_CREATE_NS_IF_UNKNOWN, &newNsPtr, &dummy1, &dummy2, &newTail);

    if ((newNsPtr == NULL) || (newTail == NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't rename to \"%s\": bad command name", newName));
	Tcl_AppendResult(interp, "can't rename to \"", newName,
		"\": bad command name", NULL);
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	result = TCL_ERROR;
	goto done;
    }
    if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't rename to \"%s\": command already exists", newName));
	Tcl_AppendResult(interp, "can't rename to \"", newName,
		 "\": command already exists", NULL);
        Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME",
                "TARGET_EXISTS", NULL);
	result = TCL_ERROR;
	goto done;
    }

    /*
     * Warning: any changes done in the code here are likely to be needed in
     * Tcl_HideCommand code too (until the common parts are extracted out).
     * Tcl_HideCommand() code too (until the common parts are extracted out).
     * - dl
     */

    /*
     * Put the command in the new namespace so we can check for an alias loop.
     * Since we are adding a new command to a namespace, we must handle any
     * shadowing of the global commands that this might create.
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
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







-
-
-
-
-
-
-
-
-
-
-















-
+



-
+







     * the info will be soon enough. These might refer to the same variable,
     * but that's no big deal.
     */

    TclInvalidateNsCmdLookup(cmdNsPtr);
    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);

    /*
     * Command resolvers (per-interp, per-namespace) might have resolved to a
     * command for the given namespace scope with this command not being
     * registered with the namespace's command table. During BC compilation,
     * the so-resolved command turns into a CmdName literal. Without
     * invalidating a possible CmdName literal here explicitly, such literals
     * keep being reused while pointing to overhauled commands.
     */

    TclInvalidateCmdLiteral(interp, newTail, cmdPtr->nsPtr);

    /*
     * Script for rename traces can delete the command "oldName". Therefore
     * increment the reference count for cmdPtr so that it's Command structure
     * is freed only towards the end of this function by calling
     * TclCleanupCommand.
     *
     * The trace function needs to get a fully qualified name for old and new
     * commands [Tcl bug #651271], or else there's no way for the trace
     * function to get the namespace from which the old command is being
     * renamed!
     */

    Tcl_DStringInit(&newFullName);
    Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1);
    if (newNsPtr != iPtr->globalNsPtr) {
	TclDStringAppendLiteral(&newFullName, "::");
	Tcl_DStringAppend(&newFullName, "::", 2);
    }
    Tcl_DStringAppend(&newFullName, newTail, -1);
    cmdPtr->refCount++;
    CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName),
    CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
	    Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
    Tcl_DStringFree(&newFullName);

    /*
     * The new command name is okay, so remove the command from its current
     * namespace. This is like deleting the command, so bump the cmdEpoch to
     * invalidate any cached references to the command.
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
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







-
+













-

-
-
-
+
-







int
Tcl_SetCommandInfoFromToken(
    Tcl_Command cmd,
    const Tcl_CmdInfo *infoPtr)
{
    Command *cmdPtr;		/* Internal representation of the command */

    if (cmd == NULL) {
    if (cmd == (Tcl_Command) NULL) {
	return 0;
    }

    /*
     * The isNativeObjectProc and nsPtr members of *infoPtr are ignored.
     */

    cmdPtr = (Command *) cmd;
    cmdPtr->proc = infoPtr->proc;
    cmdPtr->clientData = infoPtr->clientData;
    if (infoPtr->objProc == NULL) {
	cmdPtr->objProc = TclInvokeStringCommand;
	cmdPtr->objClientData = cmdPtr;
	cmdPtr->nreProc = NULL;
    } else {
	if (infoPtr->objProc != cmdPtr->objProc) {
	    cmdPtr->nreProc = NULL;
	    cmdPtr->objProc = infoPtr->objProc;
	cmdPtr->objProc = infoPtr->objProc;
	}
	cmdPtr->objClientData = infoPtr->objClientData;
    }
    cmdPtr->deleteProc = infoPtr->deleteProc;
    cmdPtr->deleteData = infoPtr->deleteData;
    return 1;
}

3192
3193
3194
3195
3196
3197
3198
3199

3200
3201
3202
3203
3204
3205
3206
2653
2654
2655
2656
2657
2658
2659

2660
2661
2662
2663
2664
2665
2666
2667







-
+







int
Tcl_GetCommandInfoFromToken(
    Tcl_Command cmd,
    Tcl_CmdInfo *infoPtr)
{
    Command *cmdPtr;		/* Internal representation of the command */

    if (cmd == NULL) {
    if (cmd == (Tcl_Command) NULL) {
	return 0;
    }

    /*
     * Set isNativeObjectProc 1 if objProc was registered by a call to
     * Tcl_CreateObjCommand. Otherwise set it to 0.
     */
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
2695
2696
2697
2698
2699
2700
2701

2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718

2719
2720
2721
2722
2723
2724
2725
2726







-
+
















-
+







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

const char *
Tcl_GetCommandName(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Interpreter containing the command. */
    Tcl_Command command)	/* Token for command returned by a previous
				 * call to Tcl_CreateCommand. The command must
				 * not have been deleted. */
{
    Command *cmdPtr = (Command *) command;

    if ((cmdPtr == NULL) || (cmdPtr->hPtr == NULL)) {
	/*
	 * This should only happen if command was "created" after the
	 * interpreter began to be deleted, so there isn't really any command.
	 * Just return an empty string.
	 */

	return "";
    }

    return (const char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
    return Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCommandFullName --
 *
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
2746
2747
2748
2749
2750
2751
2752

2753
2754
2755
2756
2757
2758
2759
2760

2761
2762
2763
2764
2765
2766
2767
2768

2769
2770
2771
2772
2773
2774
2775
2776







-
+







-
+







-
+







				 * call to Tcl_CreateCommand. The command must
				 * not have been deleted. */
    Tcl_Obj *objPtr)		/* Points to the object onto which the
				 * command's full name is appended. */

{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = (Command *) command;
    register Command *cmdPtr = (Command *) command;
    char *name;

    /*
     * Add the full name of the containing namespace, followed by the "::"
     * separator, and the command name.
     */

    if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) {
    if (cmdPtr != NULL) {
	if (cmdPtr->nsPtr != NULL) {
	    Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1);
	    if (cmdPtr->nsPtr != iPtr->globalNsPtr) {
		Tcl_AppendToObj(objPtr, "::", 2);
	    }
	}
	if (cmdPtr->hPtr != NULL) {
	    name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
	    name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
	    Tcl_AppendToObj(objPtr, name, -1);
	}
    }
}

/*
 *----------------------------------------------------------------------
3337
3338
3339
3340
3341
3342
3343
3344

3345
3346
3347
3348
3349
3350
3351
2798
2799
2800
2801
2802
2803
2804

2805
2806
2807
2808
2809
2810
2811
2812







-
+







    Tcl_Command cmd;

    /*
     * Find the desired command and delete it.
     */

    cmd = Tcl_FindCommand(interp, cmdName, NULL, /*flags*/ 0);
    if (cmd == NULL) {
    if (cmd == (Tcl_Command) NULL) {
	return -1;
    }
    return Tcl_DeleteCommandFromToken(interp, cmd);
}

/*
 *----------------------------------------------------------------------
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
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
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







+
+
+
+
+
+
+









-
+












-
-
-
-
-
-
-
-






-
+




-
+






-
-











-
-
-
+
+







-
+





-














-
-
-
-
-
-
-
-
-
-
-
-
-






+
-
+
+



-
+

-
-
+
+


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












-
-
-
-
-
-
-



-
-
-
-
+
+
+
+
+









-
-
+
+


-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
+










-
+







    Tcl_Command cmd)		/* Token for command to delete. */
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = (Command *) cmd;
    ImportRef *refPtr, *nextRefPtr;
    Tcl_Command importCmd;

    /*
     * Bump the command epoch counter. This will invalidate all cached
     * references that point to this command.
     */

    cmdPtr->cmdEpoch++;

    /*
     * The code here is tricky. We can't delete the hash table entry before
     * invoking the deletion callback because there are cases where the
     * deletion callback needs to invoke the command (e.g. object systems such
     * as OTcl). However, this means that the callback could try to delete or
     * rename the command. The deleted flag allows us to detect these cases
     * and skip nested deletes.
     */

    if (cmdPtr->flags & CMD_DYING) {
    if (cmdPtr->flags & CMD_IS_DELETED) {
	/*
	 * Another deletion is already in progress. Remove the hash table
	 * entry now, but don't invoke a callback or free the command
	 * structure. Take care to only remove the hash entry if it has not
	 * already been removed; otherwise if we manage to hit this function
	 * three times, everything goes up in smoke. [Bug 1220058]
	 */

	if (cmdPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(cmdPtr->hPtr);
	    cmdPtr->hPtr = NULL;
	}

	/*
	 * Bump the command epoch counter. This will invalidate all cached
	 * references that point to this command.
	 */

	cmdPtr->cmdEpoch++;

	return 0;
    }

    /*
     * We must delete this command, even though both traces and delete procs
     * may try to avoid this (renaming the command etc). Also traces and
     * delete procs may try to delete the command themselves. This flag
     * delete procs may try to delete the command themsevles. This flag
     * declares that a delete is in progress and that recursive deletes should
     * be ignored.
     */

    cmdPtr->flags |= CMD_DYING;
    cmdPtr->flags |= CMD_IS_DELETED;

    /*
     * Call trace functions for the command being deleted. Then delete its
     * traces.
     */

    cmdPtr->nsPtr->refCount++;

    if (cmdPtr->tracePtr != NULL) {
	CommandTrace *tracePtr;
	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);

	/*
	 * Now delete these traces.
	 */

	tracePtr = cmdPtr->tracePtr;
	while (tracePtr != NULL) {
	    CommandTrace *nextPtr = tracePtr->nextPtr;

	    if (tracePtr->refCount-- <= 1) {
		Tcl_Free(tracePtr);
	    if ((--tracePtr->refCount) <= 0) {
		ckfree((char *) tracePtr);
	    }
	    tracePtr = nextPtr;
	}
	cmdPtr->tracePtr = NULL;
    }

    /*
     * The list of commands exported from the namespace might have changed.
     * The list of command exported from the namespace might have changed.
     * However, we do not need to recompute this just yet; next time we need
     * the info will be soon enough.
     */

    TclInvalidateNsCmdLookup(cmdPtr->nsPtr);
    TclNsDecrRefCount(cmdPtr->nsPtr);

    /*
     * If the command being deleted has a compile function, increment the
     * interpreter's compileEpoch to invalidate its compiled code. This makes
     * sure that we don't later try to execute old code compiled with
     * command-specific (i.e., inline) bytecodes for the now-deleted command.
     * This field is checked in Tcl_EvalObj and ObjInterpProc, and code whose
     * compilation epoch doesn't match is recompiled.
     */

    if (cmdPtr->compileProc != NULL) {
	iPtr->compileEpoch++;
    }

    if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
	/*
	 * Delete any imports of this routine before deleting this routine itself.
	 * See issue 688fcc7082fa.
	 */
	for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
		refPtr = nextRefPtr) {
	    nextRefPtr = refPtr->nextPtr;
	    importCmd = (Tcl_Command) refPtr->importedCmdPtr;
	    Tcl_DeleteCommandFromToken(interp, importCmd);
	}
    }

    if (cmdPtr->deleteProc != NULL) {
	/*
	 * Delete the command's client data. If this was an imported command
	 * created when a command was imported into a namespace, this client
	 * data will be a pointer to a ImportedCmdData structure describing
	 * the "real" command that this imported command refers to.
	 */
	 *

	/*
	 * If you are getting a crash during the call to deleteProc and
	 * cmdPtr->deleteProc is a pointer to the function free(), the most
	 * likely cause is that your extension allocated memory for the
	 * clientData argument to Tcl_CreateObjCommand with the Tcl_Alloc()
	 * clientData argument to Tcl_CreateObjCommand() with the ckalloc()
	 * macro and you are now trying to deallocate this memory with free()
	 * instead of Tcl_Free(). You should pass a pointer to your own method
	 * that calls Tcl_Free().
	 * instead of ckfree(). You should pass a pointer to your own method
	 * that calls ckfree().
	 */

	cmdPtr->deleteProc(cmdPtr->deleteData);
	(*cmdPtr->deleteProc)(cmdPtr->deleteData);
    }

    /*
     * If this command was imported into other namespaces, then imported
     * commands were created that refer back to this command. Delete these
     * imported commands now.
     */
    if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
	for (refPtr = cmdPtr->importRefPtr;  refPtr != NULL;
		refPtr = nextRefPtr) {
	    nextRefPtr = refPtr->nextPtr;
	    importCmd = (Tcl_Command) refPtr->importedCmdPtr;
	    Tcl_DeleteCommandFromToken(interp, importCmd);
	}
    }

    /*
     * Don't use hPtr to delete the hash entry here, because it's possible
     * that the deletion callback renamed the command. Instead, use
     * cmdPtr->hptr, and make sure that no-one else has already deleted the
     * hash entry.
     */

    if (cmdPtr->hPtr != NULL) {
	Tcl_DeleteHashEntry(cmdPtr->hPtr);
	cmdPtr->hPtr = NULL;

	/*
	 * Bump the command epoch counter. This will invalidate all cached
	 * references that point to this command.
	 */

	cmdPtr->cmdEpoch++;
    }

    /*
     * A number of tests for particular kinds of commands are done by checking
     * whether the objProc field holds a known value. Set the field to NULL so
     * that such tests won't have false positives when applied to deleted
     * commands.
     * Mark the Command structure as no longer valid. This allows
     * TclExecuteByteCode to recognize when a Command has logically been
     * deleted and a pointer to this Command structure cached in a CmdName
     * object is invalid. TclExecuteByteCode will look up the command again in
     * the interpreter's command hashtable.
     */

    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).
     * CmdName Command reference is found to be invalid and TclExecuteByteCode
     * looks up the command in the command hashtable).
     */

    cmdPtr->flags |= CMD_DEAD;
    TclCleanupCommandMacro(cmdPtr);
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * CallCommandTraces --
 *
 *	Abstraction of the code to call traces on a command.
 *
 * Results:
 *	Currently always NULL.
 *
 * Side effects:
 *	Anything; this may recursively evaluate scripts and code exists to do
 *	just that.
 *
 *----------------------------------------------------------------------
 */

static char *
CallCommandTraces(
    Interp *iPtr,		/* Interpreter containing command. */
    Command *cmdPtr,		/* Command whose traces are to be invoked. */
    const char *oldName,	/* Command's old name, or NULL if we must get
				 * the name from cmdPtr */
    const char *newName,	/* Command's new name, or NULL if the command
				 * is not being renamed */
    int flags)			/* Flags indicating the type of traces to
				 * trigger, either TCL_TRACE_DELETE or
				 * TCL_TRACE_RENAME. */
{
    CommandTrace *tracePtr;
    register CommandTrace *tracePtr;
    ActiveCommandTrace active;
    char *result;
    Tcl_Obj *oldNamePtr = NULL;
    Tcl_InterpState state = NULL;

    if (cmdPtr->flags & CMD_TRACE_ACTIVE) {
	/*
	 * While a rename trace is active, we will not process any more rename
	 * traces; while a delete trace is active we will never reach here -
	 * because Tcl_DeleteCommandFromToken checks for the condition
	 * (cmdPtr->flags & CMD_DYING) and returns immediately when a
	 * (cmdPtr->flags & CMD_IS_DELETED) and returns immediately when a
	 * command deletion is in progress. For all other traces, delete
	 * traces will not be invoked but a call to TraceCommandProc will
	 * ensure that tracePtr->clientData is freed whenever the command
	 * "oldName" is deleted.
	 */

	if (cmdPtr->flags & TCL_TRACE_RENAME) {
3627
3628
3629
3630
3631
3632
3633
3634
3635


3636
3637
3638


3639
3640
3641
3642
3643
3644
3645
3062
3063
3064
3065
3066
3067
3068


3069
3070
3071


3072
3073
3074
3075
3076
3077
3078
3079
3080







-
-
+
+

-
-
+
+







		    (Tcl_Command) cmdPtr, oldNamePtr);
	    oldName = TclGetString(oldNamePtr);
	}
	tracePtr->refCount++;
	if (state == NULL) {
	    state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, TCL_OK);
	}
	tracePtr->traceProc(tracePtr->clientData, (Tcl_Interp *) iPtr,
		oldName, newName, flags);
	(*tracePtr->traceProc)(tracePtr->clientData,
		(Tcl_Interp *) iPtr, oldName, newName, flags);
	cmdPtr->flags &= ~tracePtr->flags;
	if (tracePtr->refCount-- <= 1) {
	    Tcl_Free(tracePtr);
	if ((--tracePtr->refCount) <= 0) {
	    ckfree((char *) tracePtr);
	}
    }

    if (state) {
	Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
    }

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
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







-
+



-
+

-
+
-
-
+
-
-
-
+
-
-

-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

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

+
+
-
-
+
+








    cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
    cmdPtr->refCount--;
    iPtr->activeCmdTracePtr = active.nextPtr;
    Tcl_Release(iPtr);
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * CancelEvalProc --
 * GetCommandSource --
 *
 *	Marks this interpreter as being canceled. This causes current
 *	This function returns a Tcl_Obj with the full source string for the
 *	executions to be unwound as the interpreter enters a state where it
 *	refuses to execute more commands or handle [catch] or [try], yet the
 *	command. This insures that traces get a correct NUL-terminated command
 *	interpreter is still able to execute further commands after the
 *	cancelation is cleared (unlike if it is deleted).
 *
 *	string.
 * Results:
 *	The value given for the code argument.
 *
 * Side effects:
 *	Transfers a message from the cancelation message to the interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
CancelEvalProc(
    ClientData clientData,	/* Interp to cancel the script in progress. */
    TCL_UNUSED(Tcl_Interp *),
    int code)			/* Current return code from command. */
{
    CancelInfo *cancelInfo = (CancelInfo *)clientData;
    Interp *iPtr;

    if (cancelInfo != NULL) {
	Tcl_MutexLock(&cancelLock);
	iPtr = (Interp *) cancelInfo->interp;

	if (iPtr != NULL) {
	    /*
	     * Setting the CANCELED flag will cause the script in progress to
	     * be canceled as soon as possible. The core honors this flag at
	     * all the necessary places to ensure script cancellation is
	     * responsive. Extensions can check for this flag by calling
	     * Tcl_Canceled and checking if TCL_ERROR is returned or they can
	     * choose to ignore the script cancellation flag and the
	     * associated functionality altogether. Currently, the only other
	     * flag we care about here is the TCL_CANCEL_UNWIND flag (from
	     * Tcl_CancelEval). We do not want to simply combine all the flags
	     * from original Tcl_CancelEval call with the interp flags here
	     * just in case the caller passed flags that might cause behaviour
	     * unrelated to script cancellation.
	     */

	    TclSetCancelFlags(iPtr, cancelInfo->flags | CANCELED);

static Tcl_Obj *
	    /*
	     * Now, we must set the script cancellation flags on all the child
	     * interpreters belonging to this one.
	     */

	    TclSetChildCancelFlags((Tcl_Interp *) iPtr,
GetCommandSource(
    Interp *iPtr,
		    cancelInfo->flags | CANCELED, 0);

    const char *command,
	    /*
	     * Create the result object now so that Tcl_Canceled can avoid
    int numChars,
    int objc,
	     * locking the cancelLock mutex.
	     */

	    if (cancelInfo->result != NULL) {
    Tcl_Obj *const objv[])
{
    if (!command) {
		Tcl_SetStringObj(iPtr->asyncCancelMsg, cancelInfo->result,
			cancelInfo->length);
	    } else {
		Tcl_SetObjLength(iPtr->asyncCancelMsg, 0);
	    }
	}
	Tcl_MutexUnlock(&cancelLock);
	return Tcl_NewListObj(objc, objv);
    }
    if (command == (char *) -1) {
	command = TclGetSrcInfoForCmd(iPtr, &numChars);

    return code;
    }
    return Tcl_NewStringObj(command, numChars);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupCommand --
 *
3759
3760
3761
3762
3763
3764
3765
3766

3767
3768

3769
3770


3771
3772







































































































































































































































































































































































3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787

3788
3789
3790
3791
3792
3793
3794
3795



3796

3797
3798
3799
3800


3801
3802
3803
3804
3805
3806
3807
3808
3809

3810
3811


3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835


3836
3837
3838

3839
3840





3841

3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862

3863
3864
3865
3866
3867
3868
3869

3870
3871
3872
3873

3874
3875
3876
3877
3878
3879

3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904

3905
3906
3907
3908
3909
3910
3911

3912
3913
3914
3915
3916

3917
3918
3919
3920

3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998



3999
4000
4001
4002

4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018




















4019
4020
4021
4022
4023












4024
4025

4026
4027
4028



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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408

4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428

4429
4430

4431
4432
4433

4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454

4455
4456
4457
4458
4459

4460
4461
4462
4463
4464

4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510

4511
4512
4513

4514
4515
4516
4517
4518
4519
4520
4521
4522








4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614

4615
4616
4617
4618
4619
4620
4621

4622
4623
4624
4625
4626
4627
4628
4629
4630

4631
4632
4633
4634
4635
4636
4637

4638
4639
4640
4641
4642

4643
4644
4645
4646
4647
4648
4649
4650
4651
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
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
3775
3776
3777
3778
3779
3780
3781
3782




3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804

3805
3806
3807
3808








3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851




3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862

3863
3864
3865
3866



3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885




3886
3887
3888
3889
3890
3891
3892
3893
3894



3895
3896
3897
3898
3899



3900



3901
3902
3903
3904
3905
3906


3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918





3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967

3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981


3982
3983
3984






















3985

3986







3987





3988
3989


























3990



















































































































































































































3991
3992




3993




















3994


3995



3996





















3997





3998





3999







4000






































4001



4002









4003
4004
4005
4006
4007
4008
4009
4010





















































































4011






4012







4013









4014







4015





4016





































4017
4018













4019





4020




4021






4022












4023




4024














4025















































4026


4027
4028










4029


4030



4031
4032
4033
4034
4035
4036
4037







-
+


+
-
-
+
+


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














-
+








+
+
+
-
+


-
-
+
+









+
-
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-





-
+
+



+
-
-
+
+
+
+
+
-
+






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



-
-
+
+
+


-
-
+
-





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

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

-
+



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

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


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

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


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

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


-
+
+
+

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

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















-
+













-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

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


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


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

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

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

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

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

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

-
-
-







 *	deleted or when the last ByteCode referring to it is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclCleanupCommand(
    Command *cmdPtr)	/* Points to the Command structure to
    register Command *cmdPtr)	/* Points to the Command structure to
				 * be freed. */
{
    cmdPtr->refCount--;
    if (cmdPtr->refCount-- <= 1) {
	Tcl_Free(cmdPtr);
    if (cmdPtr->refCount <= 0) {
	ckfree((char *) cmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateMathFunc --
 *
 *	Creates a new math function for expressions in a given interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Tcl function defined by "name" is created or redefined. If the
 *	function already exists then its definition is replaced; this includes
 *	the builtin functions. Redefining a builtin function forces all
 *	existing code to be invalidated since that code may be compiled using
 *	an instruction specific to the replaced function. In addition,
 *	redefioning a non-builtin function will force existing code to be
 *	invalidated if the number of arguments has changed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateMathFunc(
    Tcl_Interp *interp,		/* Interpreter in which function is to be
				 * available. */
    const char *name,		/* Name of function (e.g. "sin"). */
    int numArgs,		/* Nnumber of arguments required by
				 * function. */
    Tcl_ValueType *argTypes,	/* Array of types acceptable for each
				 * argument. */
    Tcl_MathProc *proc,		/* C function that implements the math
				 * function. */
    ClientData clientData)	/* Additional value to pass to the
				 * function. */
{
    Tcl_DString bigName;
    OldMathFuncData *data = (OldMathFuncData *)
	    ckalloc(sizeof(OldMathFuncData));

    data->proc = proc;
    data->numArgs = numArgs;
    data->argTypes = (Tcl_ValueType *)
	    ckalloc(numArgs * sizeof(Tcl_ValueType));
    memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType));
    data->clientData = clientData;

    Tcl_DStringInit(&bigName);
    Tcl_DStringAppend(&bigName, "::tcl::mathfunc::", -1);
    Tcl_DStringAppend(&bigName, name, -1);

    Tcl_CreateObjCommand(interp, Tcl_DStringValue(&bigName),
	    OldMathFuncProc, data, OldMathFuncDeleteProc);
    Tcl_DStringFree(&bigName);
}

/*
 *----------------------------------------------------------------------
 *
 * OldMathFuncProc --
 *
 *	Dispatch to a math function created with Tcl_CreateMathFunc
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Whatever the math function does.
 *
 *----------------------------------------------------------------------
 */

static int
OldMathFuncProc(
    ClientData clientData,	/* Ponter to OldMathFuncData describing the
				 * function being called */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    Tcl_Obj *valuePtr;
    OldMathFuncData *dataPtr = clientData;
    Tcl_Value funcResult, *args;
    int result;
    int j, k;
    double d;

    /*
     * Check argument count.
     */

    if (objc != dataPtr->numArgs + 1) {
	MathFuncWrongNumArgs(interp, dataPtr->numArgs+1, objc, objv);
	return TCL_ERROR;
    }

    /*
     * Convert arguments from Tcl_Obj's to Tcl_Value's.
     */

    args = (Tcl_Value *) ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
    for (j = 1, k = 0; j < objc; ++j, ++k) {

	/* TODO: Convert to TclGetNumberFromObj() ? */
	valuePtr = objv[j];
	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
	if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
	    d = valuePtr->internalRep.doubleValue;
	    result = TCL_OK;
	}
#endif
	if (result != TCL_OK) {
	    /*
	     * We have a non-numeric argument.
	     */

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument to math function didn't have numeric value",-1));
	    TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
	    ckfree((char *)args);
	    return TCL_ERROR;
	}

	/*
	 * Copy the object's numeric value to the argument record, converting
	 * it if necessary.
	 *
	 * NOTE: no bignum support; use the new mathfunc interface for that.
	 */

	args[k].type = dataPtr->argTypes[k];
	switch (args[k].type) {
	case TCL_EITHER:
	    if (Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue))
		    == TCL_OK) {
		args[k].type = TCL_INT;
		break;
	    }
	    if (Tcl_GetWideIntFromObj(interp, valuePtr, &(args[k].wideValue))
		    == TCL_OK) {
		args[k].type = TCL_WIDE_INT;
		break;
	    }
	    args[k].type = TCL_DOUBLE;
	    /* FALLTHROUGH */

	case TCL_DOUBLE:
	    args[k].doubleValue = d;
	    break;
	case TCL_INT:
	    if (ExprIntFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
		ckfree((char *)args);
		return TCL_ERROR;
	    }
	    valuePtr = Tcl_GetObjResult(interp);
	    Tcl_GetLongFromObj(NULL, valuePtr, &(args[k].intValue));
	    Tcl_ResetResult(interp);
	    break;
	case TCL_WIDE_INT:
	    if (ExprWideFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
		ckfree((char *)args);
		return TCL_ERROR;
	    }
	    valuePtr = Tcl_GetObjResult(interp);
	    Tcl_GetWideIntFromObj(NULL, valuePtr, &(args[k].wideValue));
	    Tcl_ResetResult(interp);
	    break;
	}
    }

    /*
     * Call the function.
     */

    errno = 0;
    result = (*dataPtr->proc)(dataPtr->clientData, interp, args, &funcResult);
    ckfree((char *)args);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Return the result of the call.
     */

    if (funcResult.type == TCL_INT) {
	TclNewLongObj(valuePtr, funcResult.intValue);
    } else if (funcResult.type == TCL_WIDE_INT) {
	valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
    } else {
	return CheckDoubleResult(interp, funcResult.doubleValue);
    }
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * OldMathFuncDeleteProc --
 *
 *	Cleans up after deleting a math function registered with
 *	Tcl_CreateMathFunc
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees allocated memory.
 *
 *----------------------------------------------------------------------
 */

static void
OldMathFuncDeleteProc(
     ClientData clientData)
{
    OldMathFuncData *dataPtr = clientData;

    ckfree((void *) dataPtr->argTypes);
    ckfree((void *) dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMathFuncInfo --
 *
 *	Discovers how a particular math function was created in a given
 *	interpreter.
 *
 * Results:
 *	TCL_OK if it succeeds, TCL_ERROR else (leaving an error message in the
 *	interpreter result if that happens.)
 *
 * Side effects:
 *	If this function succeeds, the variables pointed to by the numArgsPtr
 *	and argTypePtr arguments will be updated to detail the arguments
 *	allowed by the function. The variable pointed to by the procPtr
 *	argument will be set to NULL if the function is a builtin function,
 *	and will be set to the address of the C function used to implement the
 *	math function otherwise (in which case the variable pointed to by the
 *	clientDataPtr argument will also be updated.)
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetMathFuncInfo(
    Tcl_Interp *interp,
    const char *name,
    int *numArgsPtr,
    Tcl_ValueType **argTypesPtr,
    Tcl_MathProc **procPtr,
    ClientData *clientDataPtr)
{
    Tcl_Obj *cmdNameObj;
    Command *cmdPtr;

    /*
     * Get the command that implements the math function.
     */

    TclNewLiteralStringObj(cmdNameObj, "tcl::mathfunc::");
    Tcl_AppendToObj(cmdNameObj, name, -1);
    Tcl_IncrRefCount(cmdNameObj);
    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdNameObj);
    Tcl_DecrRefCount(cmdNameObj);

    /*
     * Report unknown functions.
     */

    if (cmdPtr == NULL) {
	Tcl_Obj *message;

	TclNewLiteralStringObj(message, "unknown math function \"");
	Tcl_AppendToObj(message, name, -1);
	Tcl_AppendToObj(message, "\"", 1);
	Tcl_SetObjResult(interp, message);
	*numArgsPtr = -1;
	*argTypesPtr = NULL;
	*procPtr = NULL;
	*clientDataPtr = NULL;
	return TCL_ERROR;
    }

    /*
     * Retrieve function info for user defined functions; return dummy
     * information for builtins.
     */

    if (cmdPtr->objProc == &OldMathFuncProc) {
	OldMathFuncData *dataPtr = cmdPtr->clientData;

	*procPtr = dataPtr->proc;
	*numArgsPtr = dataPtr->numArgs;
	*argTypesPtr = dataPtr->argTypes;
	*clientDataPtr = dataPtr->clientData;
    } else {
	*procPtr = NULL;
	*numArgsPtr = -1;
	*argTypesPtr = NULL;
	*procPtr = NULL;
	*clientDataPtr = NULL;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListMathFuncs --
 *
 *	Produces a list of all the math functions defined in a given
 *	interpreter.
 *
 * Results:
 *	A pointer to a Tcl_Obj structure with a reference count of zero, or
 *	NULL in the case of an error (in which case a suitable error message
 *	will be left in the interpreter result.)
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ListMathFuncs(
    Tcl_Interp *interp,
    const char *pattern)
{
    Tcl_Obj *script = Tcl_NewStringObj("::info functions ", -1);
    Tcl_Obj *result;
    Tcl_InterpState state;

    if (pattern) {
	Tcl_Obj *patternObj = Tcl_NewStringObj(pattern, -1);
	Tcl_Obj *arg = Tcl_NewListObj(1, &patternObj);

	Tcl_AppendObjToObj(script, arg);
	Tcl_DecrRefCount(arg);	/* Should tear down patternObj too */
    }

    state = Tcl_SaveInterpState(interp, TCL_OK);
    Tcl_IncrRefCount(script);
    if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) {
	result = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
    } else {
	result = Tcl_NewObj();
    }
    Tcl_DecrRefCount(script);
    Tcl_RestoreInterpState(interp, state);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInterpReady --
 *
 *	Check if an interpreter is ready to eval commands or scripts, i.e., if
 *	it was not deleted and if the nesting level is not too high.
 *
 * Results:
 *	The return value is TCL_OK if it the interpreter is ready, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	The interpreter's result is cleared.
 *	The interpreters object and string results are cleared.
 *
 *----------------------------------------------------------------------
 */

int
TclInterpReady(
    Tcl_Interp *interp)
{
#if !defined(TCL_NO_STACK_CHECK)
    int localInt; /* used for checking the stack */
#endif
    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;

    /*
     * Reset the interpreter's result and clear out any previous error
     * information.
     * Reset both the interpreter's string and object results and clear out
     * any previous error information.
     */

    Tcl_ResetResult(interp);

    /*
     * If the interpreter has been deleted, return an error.
     */

    if (iPtr->flags & DELETED) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to call eval in deleted interpreter", -1));
	Tcl_AppendResult(interp,
		"attempt to call eval in deleted interpreter", NULL);
	Tcl_SetErrorCode(interp, "TCL", "IDELETE",
		"attempt to call eval in deleted interpreter", NULL);
	return TCL_ERROR;
    }

    if (iPtr->execEnvPtr->rewind) {
	return TCL_ERROR;
    }

    /*
     * Make sure the script being evaluated (if any) has not been canceled.
     */

    if (TclCanceled(iPtr) &&
	    (TCL_OK != Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG))) {
	return TCL_ERROR;
    }

    /*
     * Check depth of nested calls to Tcl_Eval: if this gets too large, it's
     * probably because of an infinite loop somewhere.
     */

    if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) {
    if (((iPtr->numLevels) <= iPtr->maxNestingDepth)
	    && CheckCStack(iPtr, &localInt)) {
	return TCL_OK;
    }

    if (!CheckCStack(iPtr, &localInt)) {
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "too many nested evaluations (infinite loop?)", -1));
	Tcl_AppendResult(interp,
		"out of stack space (infinite loop?)", NULL);
    } else {
	Tcl_AppendResult(interp,
		"too many nested evaluations (infinite loop?)", NULL);
    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclResetCancellation --
 *
 *	Reset the script cancellation flags if the nesting level
 *	(iPtr->numLevels) for the interp is zero or argument force is
 *	non-zero.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The script cancellation flags for the interp may be reset.
 *
 *----------------------------------------------------------------------
 */

 * TclEvalObjvInternal
int
TclResetCancellation(
    Tcl_Interp *interp,
    int force)
{
    Interp *iPtr = (Interp *) interp;

 *
    if (iPtr == NULL) {
	return TCL_ERROR;
    }

 *	This function evaluates a Tcl command that has already been parsed
    if (force || (iPtr->numLevels == 0)) {
	TclUnsetCancelFlags(iPtr);
    }
    return TCL_OK;
}

 *	into words, with one Tcl_Obj holding each word. The caller is
/*
 *----------------------------------------------------------------------
 *
 * Tcl_Canceled --
 *
 *	Check if the script in progress has been canceled, i.e.,
 *	Tcl_CancelEval was called for this interpreter or any of its parent
 *	interpreters.
 *
 * Results:
 *	The return value is TCL_OK if the script evaluation has not been
 *	canceled, TCL_ERROR otherwise.
 *
 *	If "flags" contains TCL_LEAVE_ERR_MSG, an error message is returned in
 *	the interpreter's result object. Otherwise, the interpreter's result
 *	object is left unchanged. If "flags" contains TCL_CANCEL_UNWIND,
 *	TCL_ERROR will only be returned if the script evaluation is being
 *	completely unwound.
 *
 * Side effects:
 *	The CANCELED flag for the interp will be reset if it is set.
 *
 *----------------------------------------------------------------------
 */

 *	responsible for managing the iPtr->numLevels.
int
Tcl_Canceled(
    Tcl_Interp *interp,
    int flags)
{
    Interp *iPtr = (Interp *) interp;

 *
    /*
     * Has the current script in progress for this interpreter been canceled
     * or is the stack being unwound due to the previous script cancellation?
     */

 *      TclEvalObjvInternal is the backend for Tcl_EvalObjv, the bytecode
    if (!TclCanceled(iPtr)) {
        return TCL_OK;
    }

 *      engine also calls it directly.
    /*
     * The CANCELED flag is a one-shot flag that is reset immediately upon
     * being detected; however, if the TCL_CANCEL_UNWIND flag is set we will
     * continue to report that the script in progress has been canceled
     * thereby allowing the evaluation stack for the interp to be fully
     * unwound.
     */

    iPtr->flags &= ~CANCELED;

    /*
     * The CANCELED flag was detected and reset; however, if the caller
     * specified the TCL_CANCEL_UNWIND flag, we only return TCL_ERROR
     * (indicating that the script in progress has been canceled) if the
     * evaluation stack for the interp is being fully unwound.
     */

    if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) {
        return TCL_OK;
    }

    /*
     * If the TCL_LEAVE_ERR_MSG flags bit is set, place an error in the
     * interp's result; otherwise, we leave it alone.
     */

    if (flags & TCL_LEAVE_ERR_MSG) {
        const char *id, *message = NULL;
        size_t length;

        /*
         * Setup errorCode variables so that we can differentiate between
         * being canceled and unwound.
         */

        if (iPtr->asyncCancelMsg != NULL) {
            message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length);
        } else {
            length = 0;
        }

        if (iPtr->flags & TCL_CANCEL_UNWIND) {
            id = "IUNWIND";
            if (length == 0) {
                message = "eval unwound";
            }
        } else {
            id = "ICANCEL";
            if (length == 0) {
                message = "eval canceled";
            }
        }

        Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1));
        Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, NULL);
    }

    /*
     * Return TCL_ERROR to the caller (not necessarily just the Tcl core
     * itself) that indicates further processing of the script or command in
     * progress should halt gracefully and as soon as possible.
     */

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CancelEval --
 *
 *	This function schedules the cancellation of the current script in the
 *	given interpreter.
 *
 * Results:
 *	The return value is a standard Tcl completion code such as TCL_OK or
 *	TCL_ERROR. Since the interp may belong to a different thread, no error
 *	message can be left in the interp's result.
 *	TCL_ERROR. A result or error message is left in interp's result. If an
 *	error occurs, this function does NOT add any information to the
 *	errorInfo variable.
 *
 * Side effects:
 *	The script in progress in the specified interpreter will be canceled
 *	with TCL_ERROR after asynchronous handlers are invoked at the next
 *	Depends on the command.
 *	Tcl_Canceled check.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CancelEval(
    Tcl_Interp *interp,		/* Interpreter in which to cancel the
				 * script. */
    Tcl_Obj *resultObjPtr,	/* The script cancellation error message or
				 * NULL for a default error message. */
    ClientData clientData,	/* Passed to CancelEvalProc. */
    int flags)			/* Collection of OR-ed bits that control
				 * the cancellation of the script. Only
				 * TCL_CANCEL_UNWIND is currently
				 * supported. */
TclEvalObjvInternal(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    int objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    const char *command,	/* Points to the beginning of the string
				 * representation of the command; this is used
				 * for traces. NULL if the string
				 * representation of the command is unknown is
				 * to be generated from (objc,objv), -1 if it
				 * is to be generated from bytecode
				 * source. This is only needed the traces. */
    int length,			/* Number of bytes in command; if -1, all
				 * characters up to the first null byte are
				 * used. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
				 * currently supported. */
{
    Tcl_HashEntry *hPtr;
    CancelInfo *cancelInfo;
    int code = TCL_ERROR;
    const char *result;
    Command *cmdPtr;
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **newObjv;
    int i;
    CallFrame *savedVarFramePtr = NULL;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    int code = TCL_OK;
    int traceCode = TCL_OK;
    int checkTraces = 1, traced;
    Namespace *savedNsPtr = NULL;
    Namespace *lookupNsPtr = iPtr->lookupNsPtr;
    Tcl_Obj *commandPtr = NULL;

    if (interp == NULL) {
    if (TclInterpReady(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

    if (objc == 0) {
	return TCL_OK;
    }
    Tcl_MutexLock(&cancelLock);
    if (cancelTableInitialized != 1) {
	/*
	 * No CancelInfo hash table (Tcl_CreateInterp has never been called?)
	 */

	goto done;
    }
    hPtr = Tcl_FindHashEntry(&cancelTable, (char *) interp);

    /*
     * If any execution traces rename or delete the current command, we may
     * need (at most) two passes here.
     */

  reparseBecauseOfTraces:

    /*
     * Configure evaluation context to match the requested flags.
     */

    if (flags) {
	if (flags & TCL_EVAL_INVOKE) {
	    savedNsPtr = varFramePtr->nsPtr;
	    if (lookupNsPtr) {
		varFramePtr->nsPtr = lookupNsPtr;
		iPtr->lookupNsPtr = NULL;
	    } else {
		varFramePtr->nsPtr = iPtr->globalNsPtr;
	    }
	} else if ((flags & TCL_EVAL_GLOBAL)
		&& (varFramePtr != iPtr->rootFramePtr) && !savedVarFramePtr) {
	    varFramePtr = iPtr->rootFramePtr;
	    savedVarFramePtr = iPtr->varFramePtr;
	    iPtr->varFramePtr = varFramePtr;
	}
    }

    /*
     * Find the function to execute this command. If there isn't one, then see
     * if there is an unknown command handler registered for this namespace.
     * If so, create a new word array with the handler as the first words and
     * the original command words as arguments. Then call ourselves
     * recursively to execute it.
     */

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[0]);
    if (!cmdPtr) {
	goto notFound;
    }

    if (savedNsPtr) {
	varFramePtr->nsPtr = savedNsPtr;
    } else if (iPtr->ensembleRewrite.sourceObjs) {
	/*
	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
	 */

	iPtr->ensembleRewrite.sourceObjs = NULL;
    }

    /*
     * Call trace functions if needed.
     */

    traced = (iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES));
    if (traced && checkTraces) {
	int cmdEpoch = cmdPtr->cmdEpoch;
	int newEpoch;

    if (hPtr == NULL) {
	/*
	 * Insure that we have a correct nul-terminated command string for the
	 * trace code.
	 */
	 * No CancelInfo record for this interpreter.

	commandPtr = GetCommandSource(iPtr, command, length, objc, objv);
	command = TclGetStringFromObj(commandPtr, &length);

	/*
	 * Execute any command or execution traces. Note that we bump up the
	 * command's reference count for the duration of the calling of the
	 * traces so that the structure doesn't go away underneath our feet.
	 */

	cmdPtr->refCount++;
	if (iPtr->tracePtr && (traceCode == TCL_OK)) {
	    traceCode = TclCheckInterpTraces(interp, command, length,
		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
	}
	if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv);
	}
	newEpoch = cmdPtr->cmdEpoch;
	TclCleanupCommandMacro(cmdPtr);
	goto done;
    }
    cancelInfo = (CancelInfo *)Tcl_GetHashValue(hPtr);


	/*
	 * If the traces modified/deleted the command or any existing traces,
	 * they will update the command's epoch. When that happens, set
	 * checkTraces is set to 0 to prevent the re-calling of traces (and
	 * any possible infinite loop) and we go back to re-find the command
	 * implementation.
	 */

	if (traceCode == TCL_OK && cmdEpoch != newEpoch) {
	    checkTraces = 0;
	    if (commandPtr) {
		Tcl_DecrRefCount(commandPtr);
		commandPtr = NULL;
	    }
	    goto reparseBecauseOfTraces;
	}
    }

#ifdef USE_DTRACE
    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	char *a[10];
	int i = 0;

	while (i < 10) {
	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
	}
	TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
		a[8], a[9]);
    }
    if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
	char *a[4]; int i[2];

	TclDTraceInfo(info, a, i);
	TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
	TclDecrRefCount(info);
    }
#endif /* USE_DTRACE */

    /*
     * Finally, invoke the command's Tcl_ObjCmdProc.
     */
     * Populate information needed by the interpreter thread to fulfill the
     * cancellation request. Currently, clientData is ignored. If the
     * TCL_CANCEL_UNWIND flags bit is set, the script in progress is not
     * allowed to catch the script cancellation because the evaluation stack

    cmdPtr->refCount++;
    iPtr->cmdCount++;
    if (code == TCL_OK && traceCode == TCL_OK
	    && !TclLimitExceeded(iPtr->limit)) {
	if (TCL_DTRACE_CMD_ENTRY_ENABLED()) {
	    TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
		    (Tcl_Obj **)(objv + 1));
	}
	code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
	if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
	    TCL_DTRACE_CMD_RETURN(TclGetString(objv[0]), code);
	}
    }

    if (TclAsyncReady(iPtr)) {
	code = Tcl_AsyncInvoke(interp, code);
    }
    if (code == TCL_OK && TclLimitReady(iPtr->limit)) {
	code = Tcl_LimitCheck(interp);
    }

     * for the interp is completely unwound.
    /*
     * Call 'leave' command traces
     */

    if (resultObjPtr != NULL) {
	result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
	cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length);
	memcpy(cancelInfo->result, result, cancelInfo->length);
	TclDecrRefCount(resultObjPtr);	/* Discard their result object. */
    } else {
	cancelInfo->result = NULL;
	cancelInfo->length = 0;
    if (traced) {
	if (!(cmdPtr->flags & CMD_IS_DELETED)) {
	    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && traceCode == TCL_OK){
		traceCode = TclCheckExecutionTraces(interp, command, length,
			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
	    }
	    if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
		traceCode = TclCheckInterpTraces(interp, command, length,
			cmdPtr, code, TCL_TRACE_LEAVE_EXEC, objc, objv);
	    }
	}

	/*
	 * If one of the trace invocation resulted in error, then change the
	 * result code accordingly. Note, that the interp->result should
	 * already be set correctly by the call to TraceExecutionProc.
	 */

	if (traceCode != TCL_OK) {
	    code = traceCode;
	}
	if (commandPtr) {
	    Tcl_DecrRefCount(commandPtr);
	}
    }

    /*
     * Decrement the reference count of cmdPtr and deallocate it if it has
     * dropped to zero.
     */

    TclCleanupCommandMacro(cmdPtr);

    /*
     * If the interpreter has a non-empty string result, the result object is
     * either empty or stale because some function set interp->result
     * directly. If so, move the string result to the result object, then
     * reset the string result.
     */

    if (*(iPtr->result) != 0) {
	(void) Tcl_GetObjResult(interp);
    }
    cancelInfo->clientData = clientData;
    cancelInfo->flags = flags;
    Tcl_AsyncMark(cancelInfo->async);
    code = TCL_OK;

#ifdef USE_DTRACE
    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
	Tcl_Obj *r;

	r = Tcl_GetObjResult(interp);
	TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r);
    }
#endif /* USE_DTRACE */

  done:
    Tcl_MutexUnlock(&cancelLock);
    if (savedVarFramePtr) {
	iPtr->varFramePtr = savedVarFramePtr;
    }
    return code;
}

/*

  notFound:
    {
	Namespace *currNsPtr = NULL;	/* Used to check for and invoke any
					 * registered unknown command handler
					 * for the current namespace (TIP
					 * 181). */
	int newObjc, handlerObjc;
	Tcl_Obj **handlerObjv;

	currNsPtr = varFramePtr->nsPtr;
	if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
	    currNsPtr = iPtr->globalNsPtr;
	    if (currNsPtr == NULL) {
		Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
	    }
	}

	/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpActive --
 *
	 * Check to see if the resolution namespace has lost its unknown
	 * handler. If so, reset it to "::unknown".
	 */

	if (currNsPtr->unknownHandlerPtr == NULL) {
	    TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
	    Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
	}

 *	Returns non-zero if the specified interpreter is in use, i.e. if there
 *	is an evaluation currently active in the interpreter.
 *
	/*
	 * Get the list of words for the unknown handler and allocate enough
	 * space to hold both the handler prefix and all words of the command
	 * invokation itself.
	 */
 * Results:
 *	See above.
 *

 * Side effects:
 *	None.
 *
	Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
		&handlerObjc, &handlerObjv);
	newObjc = objc + handlerObjc;
	newObjv = (Tcl_Obj **) TclStackAlloc(interp,
		(int) sizeof(Tcl_Obj *) * newObjc);

 *----------------------------------------------------------------------
 */
	/*
	 * Copy command prefix from unknown handler and add on the real
	 * command's full argument list. Note that we only use memcpy() once
	 * because we have to increment the reference count of all the handler
	 * arguments anyway.
	 */

	for (i = 0; i < handlerObjc; ++i) {
	    newObjv[i] = handlerObjv[i];
	    Tcl_IncrRefCount(newObjv[i]);
	}
	memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
int
Tcl_InterpActive(
    Tcl_Interp *interp)
{
    return ((Interp *) interp)->numLevels > 0;

	/*
	 * Look up and invoke the handler (by recursive call to this
	 * function). If there is no handler at all, instead of doing the
	 * recursive call we just generate a generic error message; it would
	 * be an infinite-recursion nightmare otherwise.
	 */

	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, newObjv[0]);
	if (cmdPtr == NULL) {
	    Tcl_AppendResult(interp, "invalid command name \"",
		    TclGetString(objv[0]), "\"", NULL);
	    code = TCL_ERROR;
	} else {
	    iPtr->numLevels++;
	    code = TclEvalObjvInternal(interp, newObjc, newObjv, command,
		    length, 0);
	    iPtr->numLevels--;
	}

	/*
	 * Release any resources we locked and allocated during the handler
	 * call.
	 */

	for (i = 0; i < handlerObjc; ++i) {
	    Tcl_DecrRefCount(newObjv[i]);
	}
	TclStackFree(interp, newObjv);
	if (savedNsPtr) {
	    varFramePtr->nsPtr = savedNsPtr;
	}
	goto done;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObjv --
 *
 *	This function evaluates a Tcl command that has already been parsed
 *	into words, with one Tcl_Obj holding each word.
 *
 * Results:
 *	The return value is a standard Tcl completion code such as TCL_OK or
 *	TCL_ERROR. A result or error message is left in interp's result.
 *
 * Side effects:
 *	Always pushes a callback. Other side effects depend on the command.
 *	Depends on the command.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_EvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    int objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
				 * TCL_EVAL_GLOBAL and TCL_EVAL_INVOKE are
				 * currently supported. */
{
    int result;
    NRE_callback *rootPtr = TOP_CB(interp);

    result = TclNREvalObjv(interp, objc, objv, flags, NULL);
    return TclNRRunCallbacks(interp, result, rootPtr);
}

int
TclNREvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    int objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
    Command *cmdPtr)		/* NULL if the Command is to be looked up
				 * here, otherwise the pointer to the
				 * requested Command struct to be invoked. */
{
    Interp *iPtr = (Interp *) interp;

    int code = TCL_OK;
    /*
     * data[1] stores a marker for use by tailcalls; it will be set to 1 by
     * command redirectors (imports, alias, ensembles) so that tailcall skips
     * this callback (that marks the end of the target command) and goes back
     * to the end of the source command.
     */

    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    if (iPtr->deferredCallbacks) {
        iPtr->deferredCallbacks = NULL;
    } else {
	TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
    }

    iPtr->numLevels++;
    TclNRAddCallback(interp, EvalObjvCore, cmdPtr, INT2PTR(flags),
	    INT2PTR(objc), objv);
    return TCL_OK;
}

static int
EvalObjvCore(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0];
    int flags = PTR2INT(data[1]);
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    Interp *iPtr = (Interp *) interp;
    Namespace *lookupNsPtr = NULL;
    int enterTracesDone = 0;

    /*
     * Push records for task to be done on return, in INVERSE order. First, if
     * needed, the exception handlers (as they should happen last).
     */

    if (!(flags & TCL_EVAL_NOERR)) {
	TEOV_PushExceptionHandlers(interp, objc, objv, flags);
    code = TclEvalObjvInternal(interp, objc, objv, NULL, 0, flags);
    }

    if (TCL_OK != TclInterpReady(interp)) {
	return TCL_ERROR;
    }

    if (objc == 0) {
	return TCL_OK;
    }

    if (TclLimitExceeded(iPtr->limit)) {
	return TCL_ERROR;
    }

    /*
     * Configure evaluation context to match the requested flags.
     */

    if (iPtr->lookupNsPtr) {

	/*
	 * Capture the namespace we should do command name resolution in, as
	 * instructed by our caller sneaking it in to us in a private interp
	 * field.  Clear that field right away so we cannot possibly have its
	 * use leak where it should not.  The sneaky message pass is done.
	 *
	 * Use of this mechanism overrides the TCL_EVAL_GLOBAL flag.
	 * TODO: Is that a bug?
	 */

	lookupNsPtr = iPtr->lookupNsPtr;
	iPtr->lookupNsPtr = NULL;
    } else if (flags & TCL_EVAL_INVOKE) {
	lookupNsPtr = iPtr->globalNsPtr;
    } else {

	/*
	 * TCL_EVAL_INVOKE was not set: clear rewrite rules
	 */

	TclResetRewriteEnsemble(interp, 1);

	if (flags & TCL_EVAL_GLOBAL) {
	    TEOV_SwitchVarFrame(interp);
	    lookupNsPtr = iPtr->globalNsPtr;
	}
    }

    /*
     * Lookup the Command to dispatch.
     */

    reresolve:
    assert(cmdPtr == NULL);
    if (preCmdPtr) {
	/*
         * Caller gave it to us.
         */

	if (!(preCmdPtr->flags & CMD_DEAD)) {
	    /*
             * So long as it exists, use it.
             */

	    cmdPtr = preCmdPtr;
	} else if (flags & TCL_EVAL_NORESOLVE) {
	    /*
	     * When it's been deleted, and we're told not to attempt resolving
	     * it ourselves, all we can do is raise an error.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "attempt to invoke a deleted command"));
	    Tcl_SetErrorCode(interp, "TCL", "EVAL", "DELETEDCOMMAND", NULL);
	    return TCL_ERROR;
	}
    }
    if (cmdPtr == NULL) {
	cmdPtr = TEOV_LookupCmdFromObj(interp, objv[0], lookupNsPtr);
	if (!cmdPtr) {
	    return TEOV_NotFound(interp, objc, objv, lookupNsPtr);
	}
    }

    if (enterTracesDone || iPtr->tracePtr
	    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
	Tcl_Obj *commandPtr = TclGetSourceFromFrame(
		flags & TCL_EVAL_SOURCE_IN_FRAME ?  iPtr->cmdFramePtr : NULL,
		objc, objv);

	Tcl_IncrRefCount(commandPtr);
	if (!enterTracesDone) {
	    int code = TEOV_RunEnterTraces(interp, &cmdPtr, commandPtr,
		    objc, objv);

	    /*
	     * Send any exception from enter traces back as an exception
	     * raised by the traced command.
	     * TODO: Is this a bug?  Letting an execution trace BREAK or
	     * CONTINUE or RETURN in the place of the traced command?  Would
	     * either converting all exceptions to TCL_ERROR, or just
	     * swallowing them be better?  (Swallowing them has the problem of
	     * permanently hiding program errors.)
	     */

	    if (code != TCL_OK) {
		Tcl_DecrRefCount(commandPtr);
		return code;
	    }

	    /*
	     * If the enter traces made the resolved cmdPtr unusable, go back
	     * and resolve again, but next time don't run enter traces again.
	     */

	    if (cmdPtr == NULL) {
		enterTracesDone = 1;
		Tcl_DecrRefCount(commandPtr);
		goto reresolve;
	    }
	}

	/*
	 * Schedule leave traces.  Raise the refCount on the resolved cmdPtr,
	 * so that when it passes to the leave traces we know it's still
	 * valid.
	 */

	cmdPtr->refCount++;
	TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc),
		    commandPtr, cmdPtr, objv);
    }

    TclNRAddCallback(interp, Dispatch,
	    cmdPtr->nreProc ? cmdPtr->nreProc : cmdPtr->objProc,
	    cmdPtr->objClientData, INT2PTR(objc), objv);
    return TCL_OK;
}

static int
Dispatch(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0];
    ClientData clientData = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    Interp *iPtr = (Interp *) interp;

#ifdef USE_DTRACE
    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
	const char *a[10];
	int i = 0;

	while (i < 10) {
	    a[i] = i < objc ? TclGetString(objv[i]) : NULL; i++;
	}
	TCL_DTRACE_CMD_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
		a[8], a[9]);
    }
    if (TCL_DTRACE_CMD_INFO_ENABLED() && iPtr->cmdFramePtr) {
	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
	const char *a[6]; int i[2];

	TclDTraceInfo(info, a, i);
	TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
	TclDecrRefCount(info);
    }
    if ((TCL_DTRACE_CMD_RETURN_ENABLED() || TCL_DTRACE_CMD_RESULT_ENABLED())
	    && objc) {
	TclNRAddCallback(interp, DTraceCmdReturn, objv[0], NULL, NULL, NULL);
    }
    if (TCL_DTRACE_CMD_ENTRY_ENABLED() && objc) {
	TCL_DTRACE_CMD_ENTRY(TclGetString(objv[0]), objc - 1,
		(Tcl_Obj **)(objv + 1));
    }
#endif /* USE_DTRACE */

    iPtr->cmdCount++;
    return objProc(clientData, interp, objc, objv);
}

int
TclNRRunCallbacks(
    Tcl_Interp *interp,
    int result,
    struct NRE_callback *rootPtr)
				/* All callbacks down to rootPtr not inclusive
				 * are to be run. */
{
    while (TOP_CB(interp) != rootPtr) {
        NRE_callback *callbackPtr = TOP_CB(interp);
        Tcl_NRPostProc *procPtr = callbackPtr->procPtr;

	TOP_CB(interp) = callbackPtr->nextPtr;
	result = procPtr(callbackPtr->data, interp, result);
	TCLNR_FREE(interp, callbackPtr);
    }
    return result;
}

static int
NRCommand(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;

    iPtr->numLevels--;

     /*
      * If there is a tailcall, schedule it next
      */

    if (code == TCL_OK) {
    if (data[1] && (data[1] != INT2PTR(1))) {
        TclNRAddCallback(interp, TclNRTailcallEval, data[1], NULL, NULL, NULL);
    }

    /* OPT ??
     * Do not interrupt a series of cleanups with async or limit checks:
     * just check at the end?
     */

    if (TclAsyncReady(iPtr)) {
	result = Tcl_AsyncInvoke(interp, result);
    }
    if ((result == TCL_OK) && TclCanceled(iPtr)) {
	result = Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG);
    }
    if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
	result = Tcl_LimitCheck(interp);
    }

    return result;
	return code;
}

    } else {
/*
 *----------------------------------------------------------------------
 *

 * TEOV_Exception	 -
 * TEOV_LookupCmdFromObj -
 * TEOV_RunEnterTraces	 -
 * TEOV_RunLeaveTraces	 -
 * TEOV_NotFound	 -
 *
 *	These are helper functions for Tcl_EvalObjv.
 *
 *----------------------------------------------------------------------
 */

static void
TEOV_PushExceptionHandlers(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[],
    int flags)
{
    Interp *iPtr = (Interp *) interp;

    /*
	/*
     * If any error processing is necessary, push the appropriate records.
     * Note that we have to push them in the inverse order: first the one that
     * has to run last.
     */

	 * If we are again at the top level, process any unusual return code
    if (!(flags & TCL_EVAL_INVOKE)) {
	/*
	 * Error messages
	 */

	 * returned by the evaluated code.
	TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc),
		(ClientData) objv, NULL, NULL);
    }

    if (iPtr->numLevels == 1) {
	/*
	 * No CONTINUE or BREAK at level 0, manage RETURN
	 */

	TclNRAddCallback(interp, TEOV_Exception, INT2PTR(iPtr->evalFlags),
		NULL, NULL, NULL);
    }
}

static void
TEOV_SwitchVarFrame(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    /*
     * Change the varFrame to be the rootVarFrame, and push a record to
     * restore things at the end.
     */

    TclNRAddCallback(interp, TEOV_RestoreVarFrame, iPtr->varFramePtr, NULL,
	    NULL, NULL);
    iPtr->varFramePtr = iPtr->rootFramePtr;
}

static int
TEOV_RestoreVarFrame(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ((Interp *) interp)->varFramePtr = (CallFrame *)data[0];
    return result;
}

static int
TEOV_Exception(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{

    Interp *iPtr = (Interp *) interp;
    int allowExceptions = (PTR2INT(data[0]) & TCL_ALLOW_EXCEPTIONS);

	if (iPtr->numLevels == 0) {
    if (result != TCL_OK) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	}
    }
	    if (code == TCL_RETURN) {
		code = TclUpdateReturnInfo(iPtr);
	    }
	    if ((code != TCL_ERROR) && !allowExceptions) {
		ProcessUnexpectedResult(interp, code);
		code = TCL_ERROR;
	    }
	}

    /*
     * We are returning to level 0, so should process TclResetCancellation. As
     * numLevels has not *yet* been decreased, do not call it: do the thing
     * here directly.
     */

    TclUnsetCancelFlags(iPtr);
    return result;
}

static int
TEOV_Error(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr;
    const char *cmdString;
    size_t cmdLen;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = (Tcl_Obj **)data[1];

    if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
	/*
	 * If there was an error, a command string will be needed for the
	 * error log: get it out of the itemPtr. The details depend on the
	 * type.
	 */

	listPtr = Tcl_NewListObj(objc, objv);
	cmdString = TclGetStringFromObj(listPtr, &cmdLen);
	Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
	Tcl_DecrRefCount(listPtr);
    }
    iPtr->flags &= ~ERR_ALREADY_LOGGED;
    return result;
}

static int
TEOV_NotFound(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[],
    Namespace *lookupNsPtr)
{
    Command * cmdPtr;
    Interp *iPtr = (Interp *) interp;
    int i, newObjc, handlerObjc;
    Tcl_Obj **newObjv, **handlerObjv;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Namespace *currNsPtr = NULL;/* Used to check for and invoke any registered
				 * unknown command handler for the current
				 * namespace (TIP 181). */
    Namespace *savedNsPtr = NULL;

    currNsPtr = varFramePtr->nsPtr;
    if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
	currNsPtr = iPtr->globalNsPtr;
	if (currNsPtr == NULL) {
	    Tcl_Panic("Tcl_EvalObjv: NULL global namespace pointer");
	}
    }

    /*
     * Check to see if the resolution namespace has lost its unknown handler.
     * If so, reset it to "::unknown".
     */

    if (currNsPtr->unknownHandlerPtr == NULL) {
	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
	Tcl_IncrRefCount(currNsPtr->unknownHandlerPtr);
    }

    /*
     * Get the list of words for the unknown handler and allocate enough space
     * to hold both the handler prefix and all words of the command invokation
     * itself.
     */

    Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
	    &handlerObjc, &handlerObjv);
    newObjc = objc + handlerObjc;
    newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);

    /*
     * Copy command prefix from unknown handler and add on the real command's
     * full argument list. Note that we only use memcpy() once because we have
     * to increment the reference count of all the handler arguments anyway.
     */

	if ((code == TCL_ERROR) && !(flags & TCL_EVAL_INVOKE)) {
    for (i = 0; i < handlerObjc; ++i) {
	newObjv[i] = handlerObjv[i];
	Tcl_IncrRefCount(newObjv[i]);
    }
    memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc);

    /*
	    /*
     * Look up and invoke the handler (by recursive call to this function). If
     * there is no handler at all, instead of doing the recursive call we just
     * generate a generic error message; it would be an infinite-recursion
     * nightmare otherwise.
     *
     * In this case we worry a bit less about recursion for now, and call the
     * "blocking" interface.
     */

	     * If there was an error, a command string will be needed for the
    cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr);
    if (cmdPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid command name \"%s\"", TclGetString(objv[0])));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
                TclGetString(objv[0]), NULL);

	     * error log: generate it now. Do not worry too much about doing
	/*
	 * Release any resources we locked and allocated during the handler
	 * call.
	 */

	     * it expensively.
	for (i = 0; i < handlerObjc; ++i) {
	    Tcl_DecrRefCount(newObjv[i]);
	}
	TclStackFree(interp, newObjv);
	return TCL_ERROR;
    }

    if (lookupNsPtr) {
	savedNsPtr = varFramePtr->nsPtr;
	varFramePtr->nsPtr = lookupNsPtr;
    }
    TclSkipTailcall(interp);
    TclNRAddCallback(interp, TEOV_NotFoundCallback, INT2PTR(handlerObjc),
	    newObjv, savedNsPtr, NULL);
    return TclNREvalObjv(interp, newObjc, newObjv, TCL_EVAL_NOERR, NULL);
}

static int
TEOV_NotFoundCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj **objv = (Tcl_Obj **)data[1];
    Namespace *savedNsPtr = (Namespace *)data[2];

    int i;

    if (savedNsPtr) {
	iPtr->varFramePtr->nsPtr = savedNsPtr;
    }

    /*
     * Release any resources we locked and allocated during the handler call.
     */
	     */

    for (i = 0; i < objc; ++i) {
	Tcl_DecrRefCount(objv[i]);
    }
    TclStackFree(interp, objv);

    return result;
}

static int
TEOV_RunEnterTraces(
    Tcl_Interp *interp,
    Command **cmdPtrPtr,
    Tcl_Obj *commandPtr,
	    Tcl_Obj *listPtr;
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr = *cmdPtrPtr;
	    char *cmdString;
    size_t length, newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
    int traceCode = TCL_OK;
    const char *command = TclGetStringFromObj(commandPtr, &length);

	    int cmdLen;
    /*
     * Call trace functions.
     * Execute any command or execution traces. Note that we bump up the
     * command's reference count for the duration of the calling of the
     * traces so that the structure doesn't go away underneath our feet.
     */

    cmdPtr->refCount++;
    if (iPtr->tracePtr) {
	traceCode = TclCheckInterpTraces(interp, command, length,
		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
    }
    if ((cmdPtr->flags & CMD_HAS_EXEC_TRACES) && (traceCode == TCL_OK)) {
	traceCode = TclCheckExecutionTraces(interp, command, length,
		cmdPtr, TCL_OK, TCL_TRACE_ENTER_EXEC, objc, objv);
    }
    newEpoch = cmdPtr->cmdEpoch;
    TclCleanupCommandMacro(cmdPtr);

	    listPtr = Tcl_NewListObj(objc, objv);
    if (traceCode != TCL_OK) {
	if (traceCode == TCL_ERROR) {
	    Tcl_Obj *info;

	    cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
	    TclNewLiteralStringObj(info, "\n    (enter trace on \"");
	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
	    Tcl_AppendToObj(info, "\")", 2);
	    Tcl_AppendObjToErrorInfo(interp, info);
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	}
	return traceCode;
    }
    if (cmdEpoch != newEpoch) {
	*cmdPtrPtr = NULL;
    }
    return TCL_OK;
}

	    Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
static int
TEOV_RunLeaveTraces(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int traceCode = TCL_OK;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *commandPtr = (Tcl_Obj *)data[1];
    Command *cmdPtr = (Command *)data[2];
    Tcl_Obj **objv = (Tcl_Obj **)data[3];
    size_t length;
    const char *command = TclGetStringFromObj(commandPtr, &length);

    if (!(cmdPtr->flags & CMD_DYING)) {
	if (cmdPtr->flags & CMD_HAS_EXEC_TRACES) {
	    traceCode = TclCheckExecutionTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
	if (iPtr->tracePtr != NULL && traceCode == TCL_OK) {
	    traceCode = TclCheckInterpTraces(interp, command, length,
		    cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv);
	}
    }

    /*
     * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels.
     * Prevent that by resetting the cmdPtr field and dealing right here with
     * cmdPtr->refCount.
     */

    TclCleanupCommandMacro(cmdPtr);

    if (traceCode != TCL_OK) {
	if (traceCode == TCL_ERROR) {
	    Tcl_Obj *info;

	    TclNewLiteralStringObj(info, "\n    (leave trace on \"");
	    Tcl_AppendLimitedToObj(info, command, length, 55, "...");
	    Tcl_AppendToObj(info, "\")", 2);
	    Tcl_AppendObjToErrorInfo(interp, info);
	    iPtr->flags |= ERR_ALREADY_LOGGED;
	}
	result = traceCode;
    }
    Tcl_DecrRefCount(commandPtr);
	    Tcl_DecrRefCount(listPtr);
    return result;
}
	}

static inline Command *
TEOV_LookupCmdFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *namePtr,
    Namespace *lookupNsPtr)
{
    Interp *iPtr = (Interp *) interp;
    Command *cmdPtr;
    Namespace *savedNsPtr = iPtr->varFramePtr->nsPtr;

	return code;
    if (lookupNsPtr) {
	iPtr->varFramePtr->nsPtr = lookupNsPtr;
    }
    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, namePtr);
    iPtr->varFramePtr->nsPtr = savedNsPtr;
    return cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalTokensStandard --
 *
4828
4829
4830
4831
4832
4833
4834
4835

4836
4837
4838
4839

















































4840
4841
4842
4843
4844
4845
4846
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







-
+



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







int
Tcl_EvalTokensStandard(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    size_t count)			/* Number of tokens to consider at tokenPtr.
    int count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1,
	    NULL, NULL);
			  NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalTokens --
 *
 *	Given an array of tokens parsed from a Tcl command (e.g., the tokens
 *	that make up a word or the index for an array variable) this function
 *	evaluates the tokens and concatenates their values to form a single
 *	result value.
 *
 * Results:
 *	The return value is a pointer to a newly allocated Tcl_Obj containing
 *	the value of the array of tokens. The reference count of the returned
 *	object has been incremented. If an error occurs in evaluating the
 *	tokens then a NULL value is returned and an error message is left in
 *	interp's result.
 *
 * Side effects:
 *	A new object is allocated to hold the result.
 *
 *----------------------------------------------------------------------
 *
 * This uses a non-standard return convention; its use is now deprecated. It
 * is a wrapper for the new function Tcl_EvalTokensStandard, and is not used
 * in the core any longer. It is only kept for backward compatibility.
 */

Tcl_Obj *
Tcl_EvalTokens(
    Tcl_Interp *interp,		/* Interpreter in which to lookup variables,
				 * execute nested commands, and report
				 * errors. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * evaluate and concatenate. */
    int count)			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
{
    Tcl_Obj *resPtr;

    if (Tcl_EvalTokensStandard(interp, tokenPtr, count) != TCL_OK) {
	return NULL;
    }
    resPtr = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(resPtr);
    Tcl_ResetResult(interp);
    return resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalEx, TclEvalEx --
 *
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
4955
4956
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







-
+






-
+







-
+






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







-
+
-









-
-
+
+
+
+


-
-
+
+


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









-
+







 */

int
Tcl_EvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
{
    return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
  return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script);
}

int
TclEvalEx(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * script. Also used for error reporting. */
    const char *script,		/* First character of script to evaluate. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first NUL character. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL is currently supported. */
    int line,			/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set only in
				 * TclSubstTokens(), to properly handle
				 * [...]-nested commands. The 'outerScript'
				 * refers to the most-outer script containing
				 * the embedded command, which is refered to
				 * by 'script'. The 'clNextOuter' refers to
				 * the current entry in the table of
				 * continuation lines in this "main script",
				 * and the character offsets are relative to
				 * the 'outerScript' as well.
				 *
				 * If outerScript == script, then this call is
				 * for the outer-most script/command. See
				 * Tcl_EvalEx() and TclEvalObjEx() for places
				 * generating arguments for which this is
				 * true. */
    int*  clNextOuter,       /* Information about an outer context for */
    CONST char* outerScript) /* continuation line data. This is set only in
			      * TclSubstTokens(), to properly handle
			      * [...]-nested commands. The 'outerScript'
			      * refers to the most-outer script containing the
			      * embedded command, which is refered to by
			      * 'script'. The 'clNextOuter' refers to the
			      * current entry in the table of continuation
			      * lines in this "master script", and the
			      * character offsets are relative to the
			      * 'outerScript' as well.
			      *
			      * If outerScript == script, then this call is
			      * for the outer-most script/command. See
			      * Tcl_EvalEx() and TclEvalObjEx() for places
			      * generating arguments for which this is true.
			      */
{
    Interp *iPtr = (Interp *) interp;
    const char *p, *next;
    const unsigned int minObjs = 20;
    Tcl_Obj **objv, **objvSpace;
    int *expand, *lines, *lineSpace;
    Tcl_Token *tokenPtr;
    int bytesLeft, expandRequested, code = TCL_OK;
    int commandLength, bytesLeft, expandRequested, code = TCL_OK;
    size_t commandLength;
    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
				 * TCL_EVAL_GLOBAL was set. */
    int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
    int gotParse = 0;
    unsigned int i, objectsUsed = 0;
				/* These variables keep track of how much
				 * state has been allocated while evaluating
				 * the script, so that it can be freed
				 * properly if an error occurs. */
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Parse *parsePtr = (Tcl_Parse *)
	    TclStackAlloc(interp, sizeof(Tcl_Parse));
    CmdFrame *eeFramePtr = (CmdFrame *)
	    TclStackAlloc(interp, sizeof(CmdFrame));
    Tcl_Obj **stackObjArray = (Tcl_Obj **)
	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
    int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
    int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
    int *expandStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
    int *linesStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int));
				/* TIP #280 Structures for tracking of command
				 * locations. */
    /*
    int *clNext = NULL;		/* Pointer for the tracking of invisible
     * Pointer for the tracking of invisible continuation lines. Initialized
				 * continuation lines. Initialized only if the
				 * caller gave us a table of locations to
				 * track, via scriptCLLocPtr. It always refers
     * only if the caller gave us a table of locations to track, via
     * scriptCLLocPtr. It always refers to the table entry holding the
				 * to the table entry holding the location of
				 * the next invisible continuation line to
				 * look for, while parsing the script. */
     * location of the next invisible continuation line to look for, while
     * parsing the script.
     */

    int* clNext = NULL;

    if (iPtr->scriptCLLocPtr) {
	if (clNextOuter) {
	    clNext = clNextOuter;
	} else {
	    clNext = &iPtr->scriptCLLocPtr->loc[0];
	}
    }

    if (numBytes == TCL_INDEX_NONE) {
    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);

    savedVarFramePtr = iPtr->varFramePtr;
    if (flags & TCL_EVAL_GLOBAL) {
	iPtr->varFramePtr = iPtr->rootFramePtr;
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026






5027
5028
5029
5030
5031
5032
5033

5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044


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
5095
5096
5097
5098
5099
5100

5101
5102
5103
5104
5105

5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122

5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135


5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155





5156
5157
5158
5159
5160
5161
5162
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
4328
4329
4330
4331
4332
4333
4334

4335
4336

4337


4338
4339
4340
4341
4342
4343
4344
4345
4346



4347
4348
4349
4350
4351
4352
4353
4354
4355

4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367


4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380

4381
4382
4383
4384
4385

4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402

4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414


4415
4416
4417
4418




4419
4420
4421
4422
4423
4424
4425
4426
4427
4428




4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440







+
-
-
-
-
-
+
+
+
+
+


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




















-

















+
+
+
+
+
+




-
-
-
+









-
-
+
+










-
+

-
+
-
-





+
+
+

-
-
-
+
+
+
+





-












-
-
+
+











-
+




-
+
















-
+











-
-
+
+


-
-
-
-










-
-
-
-
+
+
+
+
+







    expand = expandStack;
    p = script;
    bytesLeft = numBytes;

    /*
     * TIP #280 Initialize tracking. Do not push on the frame stack yet.
     *
     * We may continue counting based on a specific context (CTX), or open a
     * We open a new context, either for a sourced script, or 'eval'.
     * For sourced files we always have a path object, even if nothing was
     * specified in the interp itself. That makes code using it simpler as
     * NULL checks can be left out. Sourced file without path in the
     * 'scriptFile' is possible during Tcl initialization.
     * new context, either for a sourced script, or 'eval'. For sourced files
     * we always have a path object, even if nothing was specified in the
     * interp itself. That makes code using it simpler as NULL checks can be
     * left out. Sourced file without path in the 'scriptFile' is possible
     * during Tcl initialization.
     */

    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
    eeFramePtr->framePtr = iPtr->framePtr;
    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
    eeFramePtr->nline = 0;
    eeFramePtr->line = NULL;
    eeFramePtr->cmdObj = NULL;
    if (iPtr->evalFlags & TCL_EVAL_CTX) {
	/*
	 * Path information comes out of the context.
	 */

	eeFramePtr->type = TCL_LOCATION_SOURCE;
	eeFramePtr->data.eval.path = iPtr->invokeCmdFramePtr->data.eval.path;
	Tcl_IncrRefCount(eeFramePtr->data.eval.path);

    iPtr->cmdFramePtr = eeFramePtr;
    if (iPtr->evalFlags & TCL_EVAL_FILE) {
    } else if (iPtr->evalFlags & TCL_EVAL_FILE) {
	/*
	 * Set up for a sourced file.
	 */

	eeFramePtr->type = TCL_LOCATION_SOURCE;

	if (iPtr->scriptFile) {
	    /*
	     * Normalization here, to have the correct pwd. Should have
	     * negligible impact on performance, as the norm should have been
	     * done already by the 'source' invoking us, and it caches the
	     * result.
	     */

	    Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);

	    if (norm == NULL) {
		/*
		 * Error message in the interp result.
		 */

		code = TCL_ERROR;
		goto error;
	    }
	    eeFramePtr->data.eval.path = norm;
	} else {
	    TclNewLiteralStringObj(eeFramePtr->data.eval.path, "");
	}
	Tcl_IncrRefCount(eeFramePtr->data.eval.path);
    } else {
	/*
	 * Set up for plain eval.
	 */

	eeFramePtr->type = TCL_LOCATION_EVAL;
	eeFramePtr->data.eval.path = NULL;
    }

    eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1;
    eeFramePtr->framePtr = iPtr->framePtr;
    eeFramePtr->nextPtr = iPtr->cmdFramePtr;
    eeFramePtr->nline = 0;
    eeFramePtr->line = NULL;

    iPtr->evalFlags = 0;
    do {
	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
	    code = TCL_ERROR;
	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		    parsePtr->term + 1 - parsePtr->commandStart);
	    goto posterror;
	    goto error;
	}

	/*
	 * TIP #280 Track lines. The parser may have skipped text till it
	 * found the command we are now at. We have to count the lines in this
	 * block, and do not forget invisible continuation lines.
	 */

	TclAdvanceLines(&line, p, parsePtr->commandStart);
	TclAdvanceContinuations(&line, &clNext,
		parsePtr->commandStart - outerScript);
	TclAdvanceContinuations (&line, &clNext,
				 parsePtr->commandStart - outerScript);

	gotParse = 1;
	if (parsePtr->numWords > 0) {
	    /*
	     * TIP #280. Track lines within the words of the current
	     * command. We use a separate pointer into the table of
	     * continuation line locations to not lose our position for the
	     * per-command parsing.
	     */

	    int wordLine = line;
	    int wordLine  = line;
	    const char *wordStart = parsePtr->commandStart;
	    int *wordCLNext = clNext;
	    int*        wordCLNext = clNext;
	    unsigned int objectsNeeded = 0;
	    unsigned int numWords = parsePtr->numWords;

	    /*
	     * Generate an array of objects for the words of the command.
	     */

	    unsigned int objectsNeeded = 0;
	    unsigned int numWords = parsePtr->numWords;

	    if (numWords > minObjs) {
		expand =    (int *)Tcl_Alloc(numWords * sizeof(int));
		objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int));
		expand = (int *) ckalloc(numWords * sizeof(int));
		objvSpace = (Tcl_Obj **)
			ckalloc(numWords * sizeof(Tcl_Obj *));
		lineSpace = (int *) ckalloc(numWords * sizeof(int));
	    }
	    expandRequested = 0;
	    objv = objvSpace;
	    lines = lineSpace;

	    iPtr->cmdFramePtr = eeFramePtr->nextPtr;
	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
		    objectsUsed < numWords;
		    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
		/*
		 * TIP #280. Track lines to current word. Save the information
		 * on a per-word basis, signaling dynamic words as needed.
		 * Make the information available to the recursively called
		 * evaluator as well, including the type of context (source
		 * vs. eval).
		 */

		TclAdvanceLines(&wordLine, wordStart, tokenPtr->start);
		TclAdvanceContinuations(&wordLine, &wordCLNext,
			tokenPtr->start - outerScript);
		TclAdvanceContinuations (&wordLine, &wordCLNext,
					 tokenPtr->start - outerScript);
		wordStart = tokenPtr->start;

		lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
			? wordLine : -1;

		if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
		    iPtr->evalFlags |= TCL_EVAL_FILE;
		}

		code = TclSubstTokens(interp, tokenPtr+1,
			tokenPtr->numComponents, NULL, wordLine,
			wordCLNext, outerScript);
		        wordCLNext, outerScript);

		iPtr->evalFlags = 0;

		if (code != TCL_OK) {
		    break;
		    goto error;
		}
		objv[objectsUsed] = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(objv[objectsUsed]);
		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    int numElements;

		    code = TclListObjLength(interp, objv[objectsUsed],
			    &numElements);
		    if (code == TCL_ERROR) {
			/*
			 * Attempt to expand a non-list.
			 */

			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
				"\n    (expanding word %d)", objectsUsed));
			Tcl_DecrRefCount(objv[objectsUsed]);
			break;
			goto error;
		    }
		    expandRequested = 1;
		    expand[objectsUsed] = 1;

		    objectsNeeded += (numElements ? numElements : 1);
		} else {
		    expand[objectsUsed] = 0;
		    objectsNeeded++;
		}

		if (wordCLNext) {
		    TclContinuationsEnterDerived(objv[objectsUsed],
			    wordStart - outerScript, wordCLNext);
		    TclContinuationsEnterDerived (objv[objectsUsed],
				  wordStart - outerScript, wordCLNext);
		}
	    } /* for loop */
	    iPtr->cmdFramePtr = eeFramePtr;
	    if (code != TCL_OK) {
		goto error;
	    }
	    if (expandRequested) {
		/*
		 * Some word expansion was requested. Check for objv resize.
		 */

		Tcl_Obj **copy = objvSpace;
		int *lcopy = lineSpace;
		int wordIdx = numWords;
		int objIdx = objectsNeeded - 1;

		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
		    objv = objvSpace =
			    (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
		if ((numWords > minObjs) || (objectsNeeded >  minObjs)) {
		    objv = objvSpace = (Tcl_Obj **)
			    ckalloc(objectsNeeded * sizeof(Tcl_Obj *));
		    lines = lineSpace = (int *)
			    ckalloc(objectsNeeded * sizeof(int));
		}

		objectsUsed = 0;
		while (wordIdx--) {
		    if (expand[wordIdx]) {
			int numElements;
			Tcl_Obj **elements, *temp = copy[wordIdx];
5175
5176
5177
5178
5179
5180
5181
5182

5183
5184
5185

5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200


5201
5202
5203
5204

5205
5206
5207
5208
5209
5210
5211




5212
5213




5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230

5231
5232

5233
5234
5235
5236
5237
5238
5239
5240
5241
5242

5243
5244
5245
5246
5247
5248
5249
4453
4454
4455
4456
4457
4458
4459

4460
4461
4462

4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476


4477
4478
4479
4480
4481

4482
4483
4484
4485
4486
4487


4488
4489
4490
4491


4492
4493
4494
4495
4496
4497
4498




4499
4500
4501
4502
4503
4504
4505
4506
4507

4508
4509

4510
4511
4512
4513
4514
4515
4516
4517
4518
4519

4520
4521
4522
4523
4524
4525
4526
4527







-
+


-
+













-
-
+
+



-
+





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



-
-
-
-









-
+

-
+









-
+







			objv[objIdx--] = copy[wordIdx];
			objectsUsed++;
		    }
		}
		objv += objIdx+1;

		if (copy != stackObjArray) {
		    Tcl_Free(copy);
		    ckfree((char *) copy);
		}
		if (lcopy != linesStack) {
		    Tcl_Free(lcopy);
		    ckfree((char *) lcopy);
		}
	    }

	    /*
	     * Execute the command and free the objects for its words.
	     *
	     * TIP #280: Remember the command itself for 'info frame'. We
	     * shorten the visible command by one char to exclude the
	     * termination character, if necessary. Here is where we put our
	     * frame on the stack of frames too. _After_ the nested commands
	     * have been executed.
	     */

	    eeFramePtr->cmd = parsePtr->commandStart;
	    eeFramePtr->len = parsePtr->commandSize;
	    eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
	    eeFramePtr->cmd.str.len = parsePtr->commandSize;

	    if (parsePtr->term ==
		    parsePtr->commandStart + parsePtr->commandSize - 1) {
		eeFramePtr->len--;
		eeFramePtr->cmd.str.len--;
	    }

	    eeFramePtr->nline = objectsUsed;
	    eeFramePtr->line = lines;

	    TclArgumentEnter(interp, objv, objectsUsed, eeFramePtr);
	    code = Tcl_EvalObjv(interp, objectsUsed, objv,
	    TclArgumentEnter (interp, objv, objectsUsed, eeFramePtr);
	    iPtr->cmdFramePtr = eeFramePtr;
	    iPtr->numLevels++;
	    code = TclEvalObjvInternal(interp, objectsUsed, objv,
		    TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME);
	    TclArgumentRelease(interp, objv, objectsUsed);
		    parsePtr->commandStart, parsePtr->commandSize, 0);
	    iPtr->numLevels--;
	    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
	    TclArgumentRelease (interp, objv, objectsUsed);

	    eeFramePtr->line = NULL;
	    eeFramePtr->nline = 0;
	    if (eeFramePtr->cmdObj) {
		Tcl_DecrRefCount(eeFramePtr->cmdObj);
		eeFramePtr->cmdObj = NULL;
	    }

	    if (code != TCL_OK) {
		goto error;
	    }
	    for (i = 0; i < objectsUsed; i++) {
		Tcl_DecrRefCount(objv[i]);
	    }
	    objectsUsed = 0;
	    if (objvSpace != stackObjArray) {
		Tcl_Free(objvSpace);
		ckfree((char *) objvSpace);
		objvSpace = stackObjArray;
		Tcl_Free(lineSpace);
		ckfree((char *) lineSpace);
		lineSpace = linesStack;
	    }

	    /*
	     * Free expand separately since objvSpace could have been
	     * reallocated above.
	     */

	    if (expand != expandStack) {
		Tcl_Free(expand);
		ckfree((char *) expand);
		expand = expandStack;
	    }
	}

	/*
	 * Advance to the next command in the script.
	 *
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309


5310
5311
5312

5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
4565
4566
4567
4568
4569
4570
4571

4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584


4585
4586
4587
4588

4589
4590
4591
4592
4593
4594
4595
4596
4597

4598
4599
4600
4601
4602
4603
4604







-













-
-
+
+


-
+








-







	     */

	    commandLength -= 1;
	}
	Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		commandLength);
    }
 posterror:
    iPtr->flags &= ~ERR_ALREADY_LOGGED;

    /*
     * Then free resources that had been allocated to the command.
     */

    for (i = 0; i < objectsUsed; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    if (gotParse) {
	Tcl_FreeParse(parsePtr);
    }
    if (objvSpace != stackObjArray) {
	Tcl_Free(objvSpace);
	Tcl_Free(lineSpace);
	ckfree((char *) objvSpace);
	ckfree((char *) lineSpace);
    }
    if (expand != expandStack) {
	Tcl_Free(expand);
	ckfree((char *) expand);
    }
    iPtr->varFramePtr = savedVarFramePtr;

 cleanup_return:
    /*
     * TIP #280. Release the local CmdFrame, and its contents.
     */

    iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
    if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eeFramePtr->data.eval.path);
    }
    TclStackFree(interp, linesStack);
    TclStackFree(interp, expandStack);
    TclStackFree(interp, stackObjArray);
    TclStackFree(interp, eeFramePtr);
5351
5352
5353
5354
5355
5356
5357
5358

5359
5360
5361
5362
5363
5364
5365
4627
4628
4629
4630
4631
4632
4633

4634
4635
4636
4637
4638
4639
4640
4641







-
+








void
TclAdvanceLines(
    int *line,
    const char *start,
    const char *end)
{
    const char *p;
    register const char *p;

    for (p = start; p < end; p++) {
	if (*p == '\n') {
	    (*line)++;
	}
    }
}
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391




5392
5393
5394
5395
5396



5397
5398
5399
5400
5401
5402
5403

5404
5405
5406
5407
5408
5409
5410
5411
5412


5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431


5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450





5451
5452
5453
5454
5455




5456
5457

5458
5459
5460
5461



5462
5463
5464
5465
5466

5467
5468
5469
5470
5471
5472
5473
5474






5475
5476
5477
5478
5479
5480





5481
5482
5483
5484
5485




5486
5487
5488


5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501




5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517




5518
5519



5520
5521
5522

5523
5524
5525

5526
5527

5528
5529
5530

5531
5532
5533
5534
5535




5536
5537

5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548



5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568







5569
5570
5571
5572
5573
5574
5575

5576
5577

5578
5579

5580
5581
5582
5583
5584







5585
5586
5587

5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602

5603
5604
5605
5606
5607
5608
5609
5610
5611








5612




5613
5614
5615
5616
5617
5618







5619
5620

5621
5622
5623


5624
5625
5626
5627
5628
5629
5630
5631





5632
5633
5634
5635
5636
5637
5638
5639
5640








5641
5642
5643


5644
5645
5646
5647
5648




5649

5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660




5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675






5676
5677
5678


5679
5680
5681


5682
5683

5684
5685
5686

5687
5688














5689
5690
5691
5692
5693
5694





5695
5696

5697
5698
5699


5700



5701
5702
5703
5704
5705
5706
5707
5708
5709


5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726





5727
5728
5729
5730



5731
5732
5733
5734
5735
5736
5737
5738
5739

5740
5741
5742
5743
5744
5745
5746
5747
5748

5749
5750
5751
5752


5753
5754
5755
5756
5757
5758
5759
5760
5761
5762


5763
5764

5765
5766
5767

5768
5769
5770

5771
5772
5773











































































5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807

5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820

5821
5822
5823
5824
5825
5826
5827



5828

5829


5830
5831
5832
5833
5834







5835
5836
5837
5838
5839
5840
5841
5842

5843
5844
5845
5846
5847
5848
5849


5850
5851
5852


5853


5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890



5891
5892
5893
5894
5895
5896
5897
5898

5899
5900
5901
5902
5903




5904
5905
5906
5907
5908
5909
5910
5911





5912



5913
5914


5915
5916

5917

5918
5919
5920



5921
5922

5923
5924
5925
5926


5927
5928
5929
5930

5931
5932

5933
5934

5935
5936
5937

5938
5939
5940


5941
5942
5943
5944
5945
5946
5947
5948
5949
5950


5951
5952

5953
5954

5955
5956
5957
5958
5959

5960
5961
5962
5963
5964



5965
5966


5967
5968







5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979

5980
5981
5982
5983
5984
5985
5986
5987


5988







5989




5990















5991




5992






5993
5994
5995
5996
















5997

















5998
5999













6000
6001
6002
6003













6004
6005
6006
6007
6008

6009
6010

6011
6012
6013
6014




6015
6016
6017
6018
6019
6020





6021
6022
6023
6024
6025
6026
6027
6028
6029







6030
6031
6032
6033
6034
6035
6036
6037

6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
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

4955



4956
4957

4958
4959
4960
4961
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
5016
5017
5018
5019
5020

5021
5022
5023

5024
5025
5026

5027
5028
5029

5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118





5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136

5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149

5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160

5161

5162
5163
5164




5165
5166
5167
5168
5169
5170
5171








5172







5173
5174



5175
5176

5177
5178
5179
5180
5181




5182





























5183
5184
5185








5186





5187
5188
5189
5190


5191





5192
5193
5194
5195
5196
5197
5198
5199
5200


5201
5202


5203
5204
5205



5206
5207
5208


5209




5210
5211




5212


5213


5214



5215
5216


5217
5218



5219






5220
5221


5222


5223





5224

5225



5226
5227
5228
5229
5230
5231
5232


5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249

5250
5251
5252
5253
5254
5255
5256
5257

5258
5259
5260
5261
5262
5263
5264
5265
5266
5267

5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287

5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298




5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332


5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346



5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360




5361


5362




5363
5364
5365
5366
5367





5368
5369
5370
5371
5372









5373
5374
5375
5376
5377
5378
5379








5380






5381
5382
5383
5384

























5385
5386
5387
5388
5389
5390
5391







-
-
-
-
+
+
+
+


-
-
-
+
+
+






-
+
-





-
-
-
+
+

















-
-
+
+














-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
+

-
-
-
+
+
+




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

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









-
-
-
-
+
+
+
+












-
-
-
-
+
+
+
+

-
+
+
+


-
+
-
-
-
+

-
+
-
-
-
+

-
-
-
-
+
+
+
+
-
-
+








-
-
-
+
+
+













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

-
-
-
-
-
+
-
-
+

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

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

-
+
-
-
-
+
+
-
-

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

-
-
-
-
+
+
+
+
-
+







-
-
-
-
+
+
+
+












-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
+
+
-
-
+
-

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

-
-
-
-
-
+
+
+
+
+

-
+
-
-
-
+
+
-
+
+
+







-
-
+
+












-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+








-
+








-
+

-
-
-
+
+









-
+
+

-
+


-
+


-
+



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










-
-
-
-
-


















-
+












-
+







+
+
+
-
+
-
+
+

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



-
-
-
-

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

-
-
-
-
-
+
+
+
+
+

+
+
+
-
-
+
+
-
-
+

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

-
-
+
+
-
-
-

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

-
-
-
+
+
+


+
+
-
-
+
+
+
+
+
+
+










-
+







-
+
+

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

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

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

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

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

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

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




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *	found.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclAdvanceContinuations(
    int *line,
    int **clNextPtrPtr,
    int loc)
TclAdvanceContinuations (line,clNextPtrPtr,loc)
     int* line;
     int** clNextPtrPtr;
     int loc;
{
    /*
     * Track the invisible continuation lines embedded in a script, if any.
     * Here they are just spaces (already). They were removed by
     * TclSubstTokens via TclParseBackslash.
     * Track the invisible continuation lines embedded in a script, if
     * any. Here they are just spaces (already). They were removed by
     * TclSubstTokens() via TclParseBackslash().
     *
     * *clNextPtrPtr         <=> We have continuation lines to track.
     * **clNextPtrPtr >= 0   <=> We are not beyond the last possible location.
     * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line.
     */

    while (*clNextPtrPtr && (**clNextPtrPtr >= 0)
    while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) {
	    && (loc >= **clNextPtrPtr)) {
	/*
	 * We just stepped over an invisible continuation line. Adjust the
	 * line counter and step to the table entry holding the location of
	 * the next continuation line to track.
	 */

	(*line)++;
	(*clNextPtrPtr)++;
	(*line) ++;
	(*clNextPtrPtr) ++;
    }
}

/*
 *----------------------------------------------------------------------
 * Note: The whole data structure access for argument location tracking is
 * hidden behind these three functions. The only parts open are the lineLAPtr
 * field in the Interp structure. The CFWord definition is internal to here.
 * Should make it easier to redo the data structures if we find something more
 * space/time efficient.
 */

/*
 *----------------------------------------------------------------------
 *
 * TclArgumentEnter --
 *
 *	This procedure is a helper for the TIP #280 uplevel extension. It
 *	enters location references for the arguments of a command to be
 *	This procedure is a helper for the TIP #280 uplevel extension.
 *	It enters location references for the arguments of a command to be
 *	invoked. Only the first entry has the actual data, further entries
 *	simply count the usage up.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May allocate memory.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclArgumentEnter(
    Tcl_Interp *interp,
    Tcl_Obj **objv,
    int objc,
    CmdFrame *cfPtr)
TclArgumentEnter(interp,objv,objc,cfPtr)
     Tcl_Interp* interp;
     Tcl_Obj**   objv;
     int         objc;
     CmdFrame*   cfPtr;
{
    Interp *iPtr = (Interp *) interp;
    int isNew, i;
    Tcl_HashEntry *hPtr;
    CFWord *cfwPtr;
    Interp* iPtr = (Interp*) interp;
    int new, i;
    Tcl_HashEntry* hPtr;
    CFWord* cfwPtr;

    for (i = 1; i < objc; i++) {
    for (i=1; i < objc; i++) {
	/*
	 * Ignore argument words without line information (= dynamic). If they
	 * are variables they may have location information associated with
	 * that, either through globally recorded 'set' invokations, or
	 * Ignore argument words without line information (= dynamic).  If
	 * they are variables they may have location information associated
	 * with that, either through globally recorded 'set' invokations, or
	 * literals in bytecode. Eitehr way there is no need to record
	 * something here.
	 */

	if (cfPtr->line[i] < 0) {
	if (cfPtr->line [i] < 0) continue;
	    continue;
	}
	hPtr = Tcl_CreateHashEntry(iPtr->lineLAPtr, objv[i], &isNew);
	if (isNew) {
	    /*
	     * The word is not on the stack yet, remember the current location
	     * and initialize references.
	     */
	hPtr = Tcl_CreateHashEntry (iPtr->lineLAPtr, (char*) objv[i], &new);
	if (new) {
           /*
	    * The word is not on the stack yet, remember the current location
	    * and initialize references.
            */

	    cfwPtr = (CFWord *)Tcl_Alloc(sizeof(CFWord));
	    cfwPtr->framePtr = cfPtr;
	    cfwPtr->word = i;
	    cfwPtr->refCount = 1;
	    Tcl_SetHashValue(hPtr, cfwPtr);
           cfwPtr = (CFWord*) ckalloc (sizeof (CFWord));
           cfwPtr->framePtr = cfPtr;
           cfwPtr->word     = i;
           cfwPtr->refCount = 1;
           Tcl_SetHashValue (hPtr, cfwPtr);
	} else {
	    /*
	     * The word is already on the stack, its current location is not
	     * relevant. Just remember the reference to prevent early removal.
	     */
           /*
	    * The word is already on the stack, its current location is not
            * relevant. Just remember the reference to prevent early removal.
            */

	    cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);
	    cfwPtr->refCount++;
           cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
           cfwPtr->refCount ++;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclArgumentRelease --
 *
 *	This procedure is a helper for the TIP #280 uplevel extension. It
 *	removes the location references for the arguments of a command just
 *	done. Usage is counted down, the data is removed only when no user is
 *	left over.
 *	This procedure is a helper for the TIP #280 uplevel extension.
 *	It removes the location references for the arguments of a command
 *	just done. Usage is counted down, the data is removed only when
 *	no user is left over.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May release memory.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclArgumentRelease(
    Tcl_Interp *interp,
    Tcl_Obj **objv,
    int objc)
TclArgumentRelease(interp,objv,objc)
     Tcl_Interp* interp;
     Tcl_Obj**   objv;
     int         objc;
{
    Interp *iPtr = (Interp *) interp;
    Interp*        iPtr = (Interp*) interp;
    Tcl_HashEntry* hPtr;
    CFWord*        cfwPtr;
    int i;

    for (i = 1; i < objc; i++) {
    for (i=1; i < objc; i++) {
	CFWord *cfwPtr;
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) objv[i]);
       hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) objv[i]);

	if (!hPtr) {
       if (!hPtr) { continue; }
	    continue;
	}
	cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);
       cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);

	if (cfwPtr->refCount-- > 1) {
	    continue;
	}

       cfwPtr->refCount --;
       if (cfwPtr->refCount > 0) { continue; }

       ckfree ((char*) cfwPtr);
	Tcl_Free(cfwPtr);
	Tcl_DeleteHashEntry(hPtr);
       Tcl_DeleteHashEntry (hPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclArgumentBCEnter --
 *
 *	This procedure is a helper for the TIP #280 uplevel extension. It
 *	enters location references for the literal arguments of commands in
 *	bytecode about to be invoked. Only the first entry has the actual
 *	This procedure is a helper for the TIP #280 uplevel extension.
 *	It enters location references for the literal arguments of commands
 *	in bytecode about to be invoked. Only the first entry has the actual
 *	data, further entries simply count the usage up.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May allocate memory.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclArgumentBCEnter(
    Tcl_Interp *interp,
    Tcl_Obj *objv[],
    int objc,
    void *codePtr,
    CmdFrame *cfPtr,
    int cmd,
TclArgumentBCEnter(interp,objv,objc,codePtr,cfPtr,pc)
     Tcl_Interp* interp;
     Tcl_Obj*    objv[];
     int         objc;
     void*       codePtr;
     CmdFrame*   cfPtr;
     int         pc;
    size_t pc)
{
    ExtCmdLoc *eclPtr;
    int word;
    ECL *ePtr;
    CFWordBC *lastPtr = NULL;
    Interp *iPtr = (Interp *) interp;
    Interp*        iPtr  = (Interp*) interp;
    Tcl_HashEntry *hePtr =
	    Tcl_FindHashEntry(iPtr->lineBCPtr, (char *) codePtr);
    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);

    if (!hePtr) {
    if (hePtr) {
	return;
    }
    eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
    ePtr = &eclPtr->loc[cmd];

	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));

	if (hePtr) {
	    int  cmd  = PTR2INT(Tcl_GetHashValue(hePtr));
	    ECL* ePtr = &eclPtr->loc[cmd];
	    int word;
    /*
     * ePtr->nline is the number of words originally parsed.
     *

     * objc is the number of elements getting invoked.
     *
     * If they are not the same, we arrived here by compiling an
     * ensemble dispatch.  Ensemble subcommands that lead to script
     * evaluation are not supposed to get compiled, because a command
     * such as [info level] in the script can expose some of the dispatch
     * shenanigans.  This means that we don't have to tend to the
     * housekeeping, and can escape now.
     */

    if (ePtr->nline != objc) {
        return;
    }

    /*
	    /*
     * Having disposed of the ensemble cases, we can state...
     * A few truths ...
     * (1) ePtr->nline == objc
     * (2) (ePtr->line[word] < 0) => !literal, for all words
     * (3) (word == 0) => !literal
     *
     * Item (2) is why we can use objv to get the literals, and do not
     * have to save them at compile time.
     */
	     * A few truths ...
	     * (1) ePtr->nline == objc
	     * (2) (ePtr->line[word] < 0) => !literal, for all words
	     * (3) (word == 0) => !literal
	     *
	     * Item (2) is why we can use objv to get the literals, and do not
	     * have to save them at compile time.
	     */

	    if (ePtr->nline != objc) {
		Tcl_Panic ("TIP 280 data structure inconsistency");
	    }

    for (word = 1; word < objc; word++) {
	if (ePtr->line[word] >= 0) {
	    int isNew;
	    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr,
		objv[word], &isNew);
	    CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC));
	    for (word = 1; word < objc; word++) {
		if (ePtr->line[word] >= 0) {
		    int isnew;
		    Tcl_HashEntry* hPtr =
			Tcl_CreateHashEntry (iPtr->lineLABCPtr,
					     (char*) objv[word], &isnew);
		    CFWordBC* cfwPtr = (CFWordBC*) ckalloc (sizeof (CFWordBC));

	    cfwPtr->framePtr = cfPtr;
		    cfwPtr->framePtr = cfPtr;
	    cfwPtr->obj = objv[word];
	    cfwPtr->pc = pc;
	    cfwPtr->word = word;
		    cfwPtr->pc       = pc;
		    cfwPtr->word     = word;
	    cfwPtr->nextPtr = lastPtr;
	    lastPtr = cfwPtr;

	    if (isNew) {
		/*
		 * The word is not on the stack yet, remember the current
		 * location and initialize references.
		 */
		    if (isnew) {
			/*
			 * The word is not on the stack yet, remember the
			 * current location and initialize references.
			 */

		cfwPtr->prevPtr = NULL;
	    } else {
		/*
		 * The object is already on the stack, however it may have
		 * a different location now (literal sharing may map
		 * multiple location to a single Tcl_Obj*. Save the old
		 * information in the new structure.
		 */
			cfwPtr->prevPtr = NULL;
		    } else {
			/*
			 * The object is already on the stack, however it may
			 * have a different location now (literal sharing may
			 * map multiple location to a single Tcl_Obj*. Save
			 * the old information in the new structure.
			 */

		cfwPtr->prevPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);
	    }
			cfwPtr->prevPtr = (CFWordBC*) Tcl_GetHashValue(hPtr);
		    }

	    Tcl_SetHashValue(hPtr, cfwPtr);
	}
    } /* for */

		    Tcl_SetHashValue (hPtr, cfwPtr);
		}
	    } /* for */
	} /* if */
    cfPtr->litarg = lastPtr;
    } /* if */
}

/*
 *----------------------------------------------------------------------
 *
 * TclArgumentBCRelease --
 *
 *	This procedure is a helper for the TIP #280 uplevel extension. It
 *	removes the location references for the literal arguments of commands
 *	in bytecode just done. Usage is counted down, the data is removed only
 *	when no user is left over.
 *	This procedure is a helper for the TIP #280 uplevel extension.
 *	It removes the location references for the literal arguments of
 *	commands in bytecode just done. Usage is counted down, the data
 *	is removed only when no user is left over.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May release memory.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclArgumentBCRelease(
    Tcl_Interp *interp,
    CmdFrame *cfPtr)
TclArgumentBCRelease(interp,objv,objc,codePtr,pc)
     Tcl_Interp* interp;
     Tcl_Obj*    objv[];
     int         objc;
     void*       codePtr;
     int         pc;
{
    Interp *iPtr = (Interp *) interp;
    CFWordBC *cfwPtr = (CFWordBC *) cfPtr->litarg;
    Interp*        iPtr  = (Interp*) interp;
    Tcl_HashEntry* hePtr = Tcl_FindHashEntry (iPtr->lineBCPtr, (char *) codePtr);

    while (cfwPtr) {
	CFWordBC *nextPtr = cfwPtr->nextPtr;
    if (hePtr) {
	ExtCmdLoc* eclPtr = (ExtCmdLoc*) Tcl_GetHashValue (hePtr);
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) cfwPtr->obj);
	hePtr = Tcl_FindHashEntry(&eclPtr->litInfo, INT2PTR(pc));
	CFWordBC *xPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);

	if (xPtr != cfwPtr) {
	if (hePtr) {
	    Tcl_Panic("TclArgumentBC Enter/Release Mismatch");
	}
	    int  cmd  = PTR2INT(Tcl_GetHashValue(hePtr));
	    ECL* ePtr = &eclPtr->loc[cmd];
	    int word;

	    /*
	     * Iterate in reverse order, to properly match our pop to the push
	     * in TclArgumentBCEnter().
	     */
	    for (word = objc-1; word >= 1; word--) {
		if (ePtr->line[word] >= 0) {
		    Tcl_HashEntry* hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr,
						    (char *) objv[word]);
		    if (hPtr) {
			CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);

	if (cfwPtr->prevPtr) {
	    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
	} else {
	    Tcl_DeleteHashEntry(hPtr);
	}
			if (cfwPtr->prevPtr) {
			    Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
			} else {
			    Tcl_DeleteHashEntry(hPtr);
			}

	Tcl_Free(cfwPtr);
			ckfree((char *) cfwPtr);
	cfwPtr = nextPtr;
    }

		    }
		}
    cfPtr->litarg = NULL;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclArgumentGet --
 *
 *	This procedure is a helper for the TIP #280 uplevel extension. It
 *	finds the location references for a Tcl_Obj, if any.
 *	This procedure is a helper for the TIP #280 uplevel extension.
 *	It find the location references for a Tcl_Obj, if any.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Writes found location information into the result arguments.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclArgumentGet(
    Tcl_Interp *interp,
    Tcl_Obj *obj,
    CmdFrame **cfPtrPtr,
    int *wordPtr)
TclArgumentGet(interp,obj,cfPtrPtr,wordPtr)
     Tcl_Interp* interp;
     Tcl_Obj*    obj;
     CmdFrame**  cfPtrPtr;
     int*        wordPtr;
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    CmdFrame *framePtr;
    Interp*        iPtr = (Interp*) interp;
    Tcl_HashEntry* hPtr;
    CmdFrame*      framePtr;

    /*
     * An object which either has no string rep or else is a canonical list is
     * guaranteed to have been generated dynamically: bail out, this cannot
     * have a usable absolute location. _Do not touch_ the information the set
     * up by the caller. It knows better than us.
     */

    if (!TclHasStringRep(obj) || TclListObjIsCanonical(obj)) {
    if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
	return;
    }

    /*
     * First look for location information recorded in the argument
     * stack. That is nearest.
     */

    hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, (char *) obj);
    hPtr = Tcl_FindHashEntry (iPtr->lineLAPtr, (char *) obj);
    if (hPtr) {
	CFWord *cfwPtr = (CFWord *)Tcl_GetHashValue(hPtr);

	*wordPtr = cfwPtr->word;
	CFWord* cfwPtr = (CFWord*) Tcl_GetHashValue (hPtr);
	*wordPtr  = cfwPtr->word;
	*cfPtrPtr = cfwPtr->framePtr;
	return;
    }

    /*
     * Check if the Tcl_Obj has location information as a bytecode literal, in
     * that stack.
     */

    hPtr = Tcl_FindHashEntry(iPtr->lineLABCPtr, (char *) obj);
    hPtr = Tcl_FindHashEntry (iPtr->lineLABCPtr, (char *) obj);

    if (hPtr) {
	CFWordBC *cfwPtr = (CFWordBC *)Tcl_GetHashValue(hPtr);
	CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);

	framePtr = cfwPtr->framePtr;
	framePtr->data.tebc.pc = (char *) (((ByteCode *)
	framePtr->data.tebc.pc = (char *) (((ByteCode*)
		framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc);
	*cfPtrPtr = cfwPtr->framePtr;
	*wordPtr = cfwPtr->word;
	*wordPtr  = cfwPtr->word;
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Eval --
 *
 *	Execute a Tcl command in a string. This function executes the script
 *	directly, rather than compiling it to bytecodes. Before the arrival of
 *	the bytecode compiler in Tcl 8.0 Tcl_Eval was the main function used
 *	for executing Tcl commands, but nowadays it isn't used much.
 *
 * Results:
 *	The return value is one of the return codes defined in tcl.h (such as
 *	TCL_OK), and interp's result contains a value to supplement the return
 *	code. The value of the result will persist only until the next call to
 *	Tcl_Eval or Tcl_EvalObj: you must copy it or lose it!
 *
 * Side effects:
 *	Can be almost arbitrary, depending on the commands in the script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_Eval(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *script)		/* Pointer to TCL command to execute. */
{
    int code = Tcl_EvalEx(interp, script, -1, 0);

    /*
     * For backwards compatibility with old C code that predates the object
     * system in Tcl 8.0, we have to mirror the object result back into the
     * string result (some callers may expect it there).
     */

    (void) Tcl_GetStringResult(interp);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObj, Tcl_GlobalEvalObj --
 *
 *	These functions are deprecated but we keep them around for backwards
 *	compatibility reasons.
 *
 * Results:
 *	See the functions they call.
 *
 * Side effects:
 *	See the functions they call.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_EvalObj
int
Tcl_EvalObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    return Tcl_EvalObjEx(interp, objPtr, 0);
}

#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EvalObjEx, TclEvalObjEx --
 *
 *	Execute Tcl commands stored in a Tcl object. These commands are
 *	compiled into bytecodes if necessary, unless TCL_EVAL_DIRECT is
 *	specified.
 *
 *	If the flag TCL_EVAL_DIRECT is passed in, the value of invoker
 *	must be NULL.  Support for non-NULL invokers in that mode has
 *	been removed since it was unused and untested.  Failure to
 *	follow this limitation will lead to an assertion panic.
 *
 * Results:
 *	The return value is one of the return codes defined in tcl.h (such as
 *	TCL_OK), and the interpreter's result contains a value to supplement
 *	the return code.
 *
 * Side effects:
 *	The object is converted, if necessary, to a ByteCode object that holds
 *	the bytecode instructions for the commands. Executing the commands
 *	will almost certainly have side effects that depend on those commands.
 *
 * TIP #280 : Keep public API, internally extended API.
 *----------------------------------------------------------------------
 */

int
Tcl_EvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    Tcl_Obj *objPtr,	/* Pointer to object containing commands to
    register Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
{
    return TclEvalObjEx(interp, objPtr, flags, NULL, 0);
}

int
TclEvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    Tcl_Obj *objPtr,	/* Pointer to object containing commands to
    register Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
    const CmdFrame *invoker,	/* Frame of the command doing the eval. */
    int word)			/* Index of the word which is in objPtr. */
{
    register Interp *iPtr = (Interp *) interp;
    char *script;
    int numSrcBytes;
    int result = TCL_OK;
    int result;
    NRE_callback *rootPtr = TOP_CB(interp);
    CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
				 * TCL_EVAL_GLOBAL was set. */

    result = TclNREvalObjEx(interp, objPtr, flags, invoker, word);
    return TclNRRunCallbacks(interp, result, rootPtr);
}

    Tcl_IncrRefCount(objPtr);

    /* Pure List Optimization (no string representation). In this case, we can
     * safely use Tcl_EvalObjv instead and get an appreciable improvement in
     * execution speed. This is because it allows us to avoid a setFromAny
     * step that would just pack everything into a string and back out again.
     *
int
TclNREvalObjEx(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * a previous call to Tcl_CreateInterp). */
    Tcl_Obj *objPtr,	/* Pointer to object containing commands to
				 * execute. */
    int flags,			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Supported values
     * This also preserves any associations between list elements and location
				 * are TCL_EVAL_GLOBAL and TCL_EVAL_DIRECT. */
    const CmdFrame *invoker,	/* Frame of the command doing the eval. */
    int word)			/* Index of the word which is in objPtr. */
{
    Interp *iPtr = (Interp *) interp;
    int result;

     * information for such elements.
     *
    /*
     * This function consists of three independent blocks for: direct
     * evaluation of canonical lists, compilation and bytecode execution and
     * This restriction has been relaxed a bit by storing in lists whether
     * they are "canonical" or not (a canonical list being one that is either
     * finally direct evaluation. Precisely one of these blocks will be run.
     * pure or that has its string rep derived by UpdateStringOfList from the
     * internal rep).
     */

    if (TclListObjIsCanonical(objPtr)) {
	CmdFrame *eoFramePtr = NULL;
	int objc;
	Tcl_Obj *listPtr, **objv;

	/*
	 * Canonical List Optimization:  In this case, we
	 * can safely use Tcl_EvalObjv instead and get an appreciable
	 * improvement in execution speed. This is because it allows us to
	 * avoid a setFromAny step that would just pack everything into a
	 * string and back out again.
	 *
	 * This also preserves any associations between list elements and
	 * location information for such elements.
	 */

	/*
	 * Shimmer protection! Always pass an unshared obj. The caller could
	 * incr the refCount of objPtr AFTER calling us! To be completely safe
	 * we always make a copy. The callback takes care of the refCounts for
	 * both listPtr and objPtr.
	 *
	 * TODO: Create a test to demo this need, or eliminate it.
	 * FIXME OPT: preserve just the internal rep?
	 */

	Tcl_IncrRefCount(objPtr);
	listPtr = TclListObjCopy(interp, objPtr);
	Tcl_IncrRefCount(listPtr);

	if (word != INT_MIN) {
	    /*
	     * TIP #280 Structures for tracking lines. As we know that this is
	     * dynamic execution we ignore the invoker, even if known.
	     *
	 * TIP #280 Structures for tracking lines. As we know that this is
	 * dynamic execution we ignore the invoker, even if known.
	 */
	     * TIP #280. We do _not_ compute all the line numbers for the
	     * words in the command. For the eval of a pure list the most
	     * sensible choice is to put all words on line 1. Given that we
	     * neither need memory for them nor compute anything. 'line' is
	     * left NULL. The two places using this information (TclInfoFrame,
	     * and TclInitCompileEnv), are special-cased to use the proper
	     * line number directly instead of accessing the 'line' array.
	     *

	     * Note that we use (word==INTMIN) to signal that no command frame
	     * should be pushed, as needed by alias and ensemble redirections.
	     */

	    eoFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	int nelements;
	Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
	CmdFrame *eoFramePtr = (CmdFrame *)
		TclStackAlloc(interp, sizeof(CmdFrame));
	    eoFramePtr->nline = 0;
	    eoFramePtr->line = NULL;

	    eoFramePtr->type = TCL_LOCATION_EVAL;
	    eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
		    1 : iPtr->cmdFramePtr->level + 1);
	    eoFramePtr->framePtr = iPtr->framePtr;
	    eoFramePtr->nextPtr = iPtr->cmdFramePtr;
	eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
	eoFramePtr->level = (iPtr->cmdFramePtr == NULL?  1
		: iPtr->cmdFramePtr->level + 1);
	eoFramePtr->framePtr = iPtr->framePtr;
	eoFramePtr->nextPtr = iPtr->cmdFramePtr;

	eoFramePtr->nline = 0;
	eoFramePtr->line = NULL;

	    eoFramePtr->cmdObj = objPtr;
	    eoFramePtr->cmd = NULL;
	eoFramePtr->cmd.listPtr  = objPtr;
	Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
	    eoFramePtr->len = 0;
	    eoFramePtr->data.eval.path = NULL;
	eoFramePtr->data.eval.path = NULL;

	/*
	    iPtr->cmdFramePtr = eoFramePtr;

	    flags |= TCL_EVAL_SOURCE_IN_FRAME;
	 * TIP #280 We do _not_ compute all the line numbers for the words
	 * in the command. For the eval of a pure list the most sensible
	 * choice is to put all words on line 1. Given that we neither
	}

	 * need memory for them nor compute anything.  'line' is left
	TclMarkTailcall(interp);
        TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
		objPtr, NULL);

	 * NULL. The two places using this information (TclInfoFrame, and
	 * TclInitCompileEnv), are special-cased to use the proper line
	TclListObjGetElements(NULL, listPtr, &objc, &objv);
	return TclNREvalObjv(interp, objc, objv, flags, NULL);
    }

	 * number directly instead of accessing the 'line' array.
    if (!(flags & TCL_EVAL_DIRECT)) {
	/*
	 */
	 * Let the compiler/engine subsystem do the evaluation.
	 *

	 * TIP #280 The invoker provides us with the context for the script.
	 * We transfer this to the byte code compiler.
	 */
	Tcl_ListObjGetElements(NULL, copyPtr, &nelements, &elements);

	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
	ByteCode *codePtr;
	iPtr->cmdFramePtr = eoFramePtr;
	result = Tcl_EvalObjv(interp, nelements, elements, flags);
	CallFrame *savedVarFramePtr = NULL;	/* Saves old copy of
						 * iPtr->varFramePtr in case
						 * TCL_EVAL_GLOBAL was set. */

        if (TclInterpReady(interp) != TCL_OK) {
            return TCL_ERROR;
        }
	if (flags & TCL_EVAL_GLOBAL) {
	    savedVarFramePtr = iPtr->varFramePtr;
	    iPtr->varFramePtr = iPtr->rootFramePtr;
	Tcl_DecrRefCount(copyPtr);
	iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
	}
	Tcl_IncrRefCount(objPtr);
	Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
	codePtr = TclCompileObj(interp, objPtr, invoker, word);

	TclStackFree(interp, eoFramePtr);
	TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr,
		objPtr, INT2PTR(allowExceptions), NULL);
        return TclNRExecuteByteCode(interp, codePtr);
    }

    } else if (flags & TCL_EVAL_DIRECT) {
    {
	/*
	 * We're not supposed to use the compiler or byte-code
	 * interpreter. Let Tcl_EvalEx evaluate the command directly (and
	 * probably more slowly).
	 * We're not supposed to use the compiler or byte-code interpreter.
	 * Let Tcl_EvalEx evaluate the command directly (and probably more
	 * slowly).
	 */

	/*
	 * TIP #280. Propagate context as much as we can. Especially if the
	const char *script;
	size_t numSrcBytes;
	 * script to evaluate is a single literal it makes sense to look if
	 * our context is one with absolute line numbers we can then track
	 * into the literal itself too.
	 *
	 * See also tclCompile.c, TclInitCompileEnv, for the equivalent code
	 * in the bytecode compiler.
	 */

	/*
	 * Now we check if we have data about invisible continuation lines for
	 * the script, and make it available to the direct script parser and
	 * evaluator we are about to call, if so.
	 *
	 * It may be possible that the script Tcl_Obj* can be free'd while the
	 * evaluator is using it, leading to the release of the associated
	 * ContLineLoc structure as well. To ensure that the latter doesn't
	 * happen we set a lock on it. We release this lock later in this
	 * function, after the evaluator is done. The relevant "lineCLPtr"
	 * function, after the evaluator is done.  The relevant "lineCLPtr"
	 * hashtable is managed in the file "tclObj.c".
	 *
	 * Another important action is to save (and later restore) the
	 * continuation line information of the caller, in case we are
	 * executing nested commands in the eval/direct path.
	 */

	ContLineLoc *saveCLLocPtr = iPtr->scriptCLLocPtr;
	ContLineLoc* saveCLLocPtr = iPtr->scriptCLLocPtr;
	ContLineLoc* clLocPtr = TclContinuationsGet (objPtr);

	if (clLocPtr) {
	    iPtr->scriptCLLocPtr = clLocPtr;
	    Tcl_Preserve (iPtr->scriptCLLocPtr);
	} else {
	    iPtr->scriptCLLocPtr = NULL;
	}

	assert(invoker == NULL);
	if (invoker == NULL) {
	    /*
	     * No context, force opening of our own.
	     */

	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
	    result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
	} else {
	    /*
	     * We have an invoker, describing the command asking for the
	     * evaluation of a subordinate script. This script may originate
	     * in a literal word, or from a variable, etc. Using the line
	     * array we now check if we have good line information for the
	     * relevant word. The type of context is relevant as well. In a
	     * non-'source' context we don't have to try tracking lines.
	     *
	     * First see if the word exists and is a literal. If not we go
	     * through the easy dynamic branch. No need to perform more
	     * complex invokations.
	     */
	iPtr->scriptCLLocPtr = TclContinuationsGet(objPtr);

	    int pc = 0;
	    CmdFrame *ctxPtr = (CmdFrame *)
		TclStackAlloc(interp, sizeof(CmdFrame));

	    *ctxPtr = *invoker;
	    if (invoker->type == TCL_LOCATION_BC) {
		/*
		 * Note: Type BC => ctxPtr->data.eval.path is not used.
		 * ctxPtr->data.tebc.codePtr is used instead.
		 */
	Tcl_IncrRefCount(objPtr);

	script = TclGetStringFromObj(objPtr, &numSrcBytes);
	result = Tcl_EvalEx(interp, script, numSrcBytes, flags);

		TclGetSrcInfoForPc(ctxPtr);
		pc = 1;
	    }

	    script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);

	    if ((ctxPtr->nline <= word) ||
		(ctxPtr->line[word] < 0) ||
		(ctxPtr->type != TCL_LOCATION_SOURCE)) {
		/*
		 * Dynamic script, or dynamic context, force our own
		 * context.
		 */

		result = Tcl_EvalEx(interp, script, numSrcBytes, flags);

	    } else {
		/*
		 * Absolute context to reuse.
		 */

		iPtr->invokeCmdFramePtr = ctxPtr;
		iPtr->evalFlags |= TCL_EVAL_CTX;

		result = TclEvalEx(interp, script, numSrcBytes, flags,
				   ctxPtr->line[word], NULL, script);
	    }

	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
		/*
		 * Death of SrcInfo reference.
		 */

	TclDecrRefCount(objPtr);

		Tcl_DecrRefCount(ctxPtr->data.eval.path);
	    }
	    TclStackFree(interp, ctxPtr);
	}

	/*
	 * Now release the lock on the continuation line information, if
	 * any, and restore the caller's settings.
	 */

	if (iPtr->scriptCLLocPtr) {
	    Tcl_Release (iPtr->scriptCLLocPtr);
	}
	iPtr->scriptCLLocPtr = saveCLLocPtr;
	return result;
    }
}
    } else {
	/*
	 * Let the compiler/engine subsystem do the evaluation.
	 *
	 * TIP #280 The invoker provides us with the context for the script.
	 * We transfer this to the byte code compiler.
	 */
	int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);

	savedVarFramePtr = iPtr->varFramePtr;
	if (flags & TCL_EVAL_GLOBAL) {
	    iPtr->varFramePtr = iPtr->rootFramePtr;
	}

static int
TEOEx_ByteCodeCallback(
    ClientData data[],
    Tcl_Interp *interp,
	result = TclCompEvalObj(interp, objPtr, invoker, word);
    int result)
{

    Interp *iPtr = (Interp *) interp;
    CallFrame *savedVarFramePtr = (CallFrame *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];
    int allowExceptions = PTR2INT(data[2]);
	/*
	 * If we are again at the top level, process any unusual return code
	 * returned by the evaluated code.
	 */

    if (iPtr->numLevels == 0) {
	if (result == TCL_RETURN) {
	    result = TclUpdateReturnInfo(iPtr);
	}
	if ((result != TCL_OK) && (result != TCL_ERROR) && !allowExceptions) {
	if (iPtr->numLevels == 0) {
	    if (result == TCL_RETURN) {
		result = TclUpdateReturnInfo(iPtr);
	    }
	    if ((result != TCL_OK) && (result != TCL_ERROR)
	    const char *script;
	    size_t numSrcBytes;

	    ProcessUnexpectedResult(interp, result);
	    result = TCL_ERROR;
	    script = TclGetStringFromObj(objPtr, &numSrcBytes);
	    Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	}

		    && !allowExceptions) {
		ProcessUnexpectedResult(interp, result);
		result = TCL_ERROR;
		script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
		Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
	    }
	}
	/*
	 * We are returning to level 0, so should call TclResetCancellation.
	 * Let us just unset the flags inline.
	 */

	TclUnsetCancelFlags(iPtr);
    }
    iPtr->evalFlags = 0;
	iPtr->evalFlags = 0;

    /*
     * Restore the callFrame if this was a TCL_EVAL_GLOBAL.
     */

    if (savedVarFramePtr) {
	iPtr->varFramePtr = savedVarFramePtr;
    }

    TclDecrRefCount(objPtr);
    return result;
}

static int
TEOEx_ListCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];
    CmdFrame *eoFramePtr = (CmdFrame *)data[1];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[2];

    /*
     * Remove the cmdFrame
     */

    if (eoFramePtr) {
	iPtr->cmdFramePtr = eoFramePtr->nextPtr;
	TclStackFree(interp, eoFramePtr);
    }
    TclDecrRefCount(objPtr);
    TclDecrRefCount(listPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcessUnexpectedResult --
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107


6108
6109
6110


6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
5407
5408
5409
5410
5411
5412
5413


5414
5415


5416
5417
5418


5419
5420
5421
5422
5423
5424


5425
5426
5427
5428
5429
5430
5431







-
-


-
-
+
+

-
-
+
+




-
-








static void
ProcessUnexpectedResult(
    Tcl_Interp *interp,		/* The interpreter in which the unexpected
				 * result code was returned. */
    int returnCode)		/* The unexpected result code. */
{
    char buf[TCL_INTEGER_SPACE];

    Tcl_ResetResult(interp);
    if (returnCode == TCL_BREAK) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"break\" outside of a loop", -1));
	Tcl_AppendResult(interp,
		"invoked \"break\" outside of a loop", NULL);
    } else if (returnCode == TCL_CONTINUE) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"invoked \"continue\" outside of a loop", -1));
	Tcl_AppendResult(interp,
		"invoked \"continue\" outside of a loop", NULL);
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"command returned bad code: %d", returnCode));
    }
    sprintf(buf, "%d", returnCode);
    Tcl_SetErrorCode(interp, "TCL", "UNEXPECTED_RESULT_CODE", buf, NULL);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_ExprLong, Tcl_ExprDouble, Tcl_ExprBoolean --
 *
6140
6141
6142
6143
6144
6145
6146
6147

6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159



6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171

6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185



6186
6187
6188
6189
6190
6191
6192
5448
5449
5450
5451
5452
5453
5454

5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481

5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506







-
+












+
+
+











-
+














+
+
+







int
Tcl_ExprLong(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    const char *exprstring,	/* Expression to evaluate. */
    long *ptr)			/* Where to store result. */
{
    Tcl_Obj *exprPtr;
    register Tcl_Obj *exprPtr;
    int result = TCL_OK;
    if (*exprstring == '\0') {
	/*
	 * Legacy compatibility - return 0 for the zero-length string.
	 */

	*ptr = 0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprLongObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}
    }
    return result;
}

int
Tcl_ExprDouble(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    const char *exprstring,	/* Expression to evaluate. */
    double *ptr)		/* Where to store result. */
{
    Tcl_Obj *exprPtr;
    register Tcl_Obj *exprPtr;
    int result = TCL_OK;

    if (*exprstring == '\0') {
	/*
	 * Legacy compatibility - return 0 for the zero-length string.
	 */

	*ptr = 0.0;
    } else {
	exprPtr = Tcl_NewStringObj(exprstring, -1);
	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
				/* Discard the expression object. */
	if (result != TCL_OK) {
	    (void) Tcl_GetStringResult(interp);
	}
    }
    return result;
}

int
Tcl_ExprBoolean(
    Tcl_Interp *interp,		/* Context in which to evaluate the
6204
6205
6206
6207
6208
6209
6210








6211
6212
6213
6214
6215
6216
6217
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539







+
+
+
+
+
+
+
+







    } else {
	int result;
	Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1);

	Tcl_IncrRefCount(exprPtr);
	result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
	Tcl_DecrRefCount(exprPtr);
	if (result != TCL_OK) {
	    /*
	     * Move the interpreter's object result to the string result, then
	     * reset the object result.
	     */

	    (void) Tcl_GetStringResult(interp);
	}
	return result;
    }
}

/*
 *--------------------------------------------------------------
 *
6233
6234
6235
6236
6237
6238
6239
6240

6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253

6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
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
5555
5556
5557
5558
5559
5560
5561

5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574

5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590

5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609

5610
5611
5612
5613
5614
5615
5616
5617







-
+












-
+















-
+
+

















-
+







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

int
Tcl_ExprLongObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,	/* Expression to evaluate. */
    register Tcl_Obj *objPtr,	/* Expression to evaluate. */
    long *ptr)			/* Where to store long result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    double d;
    ClientData internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) {
    if (TclGetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK){
	return TCL_ERROR;
    }

    switch (type) {
    case TCL_NUMBER_DOUBLE: {
	mp_int big;

	d = *((const double *) internalPtr);
	Tcl_DecrRefCount(resultPtr);
	if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
	    return TCL_ERROR;
	}
	resultPtr = Tcl_NewBignumObj(&big);
    }
    /* FALLTHRU */
    case TCL_NUMBER_INT:
    case TCL_NUMBER_LONG:
    case TCL_NUMBER_WIDE:
    case TCL_NUMBER_BIG:
	result = TclGetLongFromObj(interp, resultPtr, ptr);
	break;

    case TCL_NUMBER_NAN:
	Tcl_GetDoubleFromObj(interp, resultPtr, &d);
	result = TCL_ERROR;
    }

    Tcl_DecrRefCount(resultPtr);/* Discard the result object. */
    return result;
}

int
Tcl_ExprDoubleObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,	/* Expression to evaluate. */
    register Tcl_Obj *objPtr,	/* Expression to evaluate. */
    double *ptr)		/* Where to store double result. */
{
    Tcl_Obj *resultPtr;
    int result, type;
    ClientData internalPtr;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
6316
6317
6318
6319
6320
6321
6322
6323

6324
6325
6326
6327
6328
6329
6330
5639
5640
5641
5642
5643
5644
5645

5646
5647
5648
5649
5650
5651
5652
5653







-
+







    return result;
}

int
Tcl_ExprBooleanObj(
    Tcl_Interp *interp,		/* Context in which to evaluate the
				 * expression. */
    Tcl_Obj *objPtr,	/* Expression to evaluate. */
    register Tcl_Obj *objPtr,	/* Expression to evaluate. */
    int *ptr)			/* Where to store 0/1 result. */
{
    Tcl_Obj *resultPtr;
    int result;

    result = Tcl_ExprObj(interp, objPtr, &resultPtr);
    if (result == TCL_OK) {
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
5661
5662
5663
5664
5665
5666
5667

5668
5669
5670
5671
5672
5673
5674







-







/*
 *----------------------------------------------------------------------
 *
 * TclObjInvokeNamespace --
 *
 *	Object version: Invokes a Tcl command, given an objv/objc, from either
 *	the exposed or hidden set of commands in the given interpreter.
 *
 *	NOTE: The command is invoked in the global stack frame of the
 *	interpreter or namespace, thus it cannot see any current state on the
 *	stack of that interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
6372
6373
6374
6375
6376
6377
6378
6379





6380
6381
6382
6383
6384
6385
6386
5694
5695
5696
5697
5698
5699
5700

5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712







-
+
+
+
+
+







    Tcl_CallFrame *framePtr;

    /*
     * Make the specified namespace the current namespace and invoke the
     * command.
     */

    (void) TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
    result = TclPushStackFrame(interp, &framePtr, nsPtr, /*isProcFrame*/0);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    result = TclObjInvoke(interp, objc, objv, flags);

    TclPopStackFrame(interp);
    return result;
}

/*
6407
6408
6409
6410
6411
6412
6413







6414
6415
6416

6417
6418
6419

6420
6421

6422
6423
6424
6425
6426
6427




6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448

6449
6450

6451
6452
6453

6454
6455
6456

6457
6458
6459
6460


6461
6462
6463
6464
6465


6466
6467
6468

6469
6470
6471



6472
6473
6474
6475
6476
6477
6478









6479
6480
6481
6482
6483
6484
6485
6486
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751


5752
5753
5754
5755
5756
5757
5758



5759
5760
5761
5762












5763
5764
5765
5766
5767
5768
5769


5770


5771
5772
5773

5774
5775
5776

5777
5778
5779


5780
5781
5782
5783



5784
5785
5786
5787

5788



5789
5790
5791







5792
5793
5794
5795
5796
5797
5798
5799
5800

5801
5802
5803
5804
5805
5806
5807







+
+
+
+
+
+
+



+

-
-
+


+



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







-
-
+
-
-
+


-
+


-
+


-
-
+
+


-
-
-
+
+


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







    int objc,			/* Count of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects; objv[0] points to the
				 * name of the command to invoke. */
    int flags)			/* Combination of flags controlling the call:
				 * TCL_INVOKE_HIDDEN, TCL_INVOKE_NO_UNKNOWN,
				 * or TCL_INVOKE_NO_TRACEBACK. */
{
    register Interp *iPtr = (Interp *) interp;
    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
    char *cmdName;		/* Name of the command from objv[0]. */
    Tcl_HashEntry *hPtr = NULL;
    Command *cmdPtr;
    int result;

    if (interp == NULL) {
	return TCL_ERROR;
    }

    if ((objc < 1) || (objv == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "illegal argument vector", -1));
	Tcl_AppendResult(interp, "illegal argument vector", NULL);
	return TCL_ERROR;
    }

    if ((flags & TCL_INVOKE_HIDDEN) == 0) {
	Tcl_Panic("TclObjInvoke: called without TCL_INVOKE_HIDDEN");
    }
    return Tcl_NRCallObjProc(interp, TclNRInvoke, NULL, objc, objv);
}


    if (TclInterpReady(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
int
TclNRInvoke(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashTable *hTblPtr;	/* Table of hidden commands. */
    const char *cmdName;	/* Name of the command from objv[0]. */
    Tcl_HashEntry *hPtr = NULL;
    Command *cmdPtr;

    cmdName = TclGetString(objv[0]);
    hTblPtr = iPtr->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	hPtr = Tcl_FindHashEntry(hTblPtr, cmdName);
    }
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid hidden command name \"%s\"", cmdName));
	Tcl_AppendResult(interp, "invalid hidden command name \"",
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName,
                NULL);
		cmdName, "\"", NULL);
	return TCL_ERROR;
    }
    cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
    cmdPtr = Tcl_GetHashValue(hPtr);

    /*
     * Avoid the exception-handling brain damage when numLevels == 0
     * Invoke the command function.
     */

    iPtr->numLevels++;
    Tcl_NRAddCallback(interp, NRPostInvoke, NULL, NULL, NULL, NULL);
    iPtr->cmdCount++;
    result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);

    /*
     * Normal command resolution of objv[0] isn't going to find cmdPtr.
     * That's the whole point of **hidden** commands.  So tell the Eval core
     * machinery not to even try (and risk finding something wrong).
     * If an error occurred, record information about what was being executed
     * when the error occurred.
     */

    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NORESOLVE, cmdPtr);
    if ((result == TCL_ERROR)
}

static int
	    && ((flags & TCL_INVOKE_NO_TRACEBACK) == 0)
	    && ((iPtr->flags & ERR_ALREADY_LOGGED) == 0)) {
	int length;
NRPostInvoke(
    TCL_UNUSED(ClientData *),
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *)interp;

	Tcl_Obj *command = Tcl_NewListObj(objc, objv);
	const char *cmdString;

	Tcl_IncrRefCount(command);
	cmdString = Tcl_GetStringFromObj(command, &length);
	Tcl_LogCommandInfo(interp, cmdString, cmdString, length);
	Tcl_DecrRefCount(command);
	iPtr->flags &= ~ERR_ALREADY_LOGGED;
    }
    iPtr->numLevels--;
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_ExprString --
6509
6510
6511
6512
6513
6514
6515
6516

6517
6518
6519
6520
6521
6522
6523
6524
6525
6526






6527
6528
6529
6530
6531
6532
6533
5830
5831
5832
5833
5834
5835
5836

5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860







-
+










+
+
+
+
+
+







    int code = TCL_OK;

    if (expr[0] == '\0') {
	/*
	 * An empty string. Just set the interpreter's result to 0.
	 */

	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
	Tcl_SetResult(interp, "0", TCL_VOLATILE);
    } else {
	Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1);

	Tcl_IncrRefCount(exprObj);
	code = Tcl_ExprObj(interp, exprObj, &resultPtr);
	Tcl_DecrRefCount(exprObj);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(interp, resultPtr);
	    Tcl_DecrRefCount(resultPtr);
	}

	/*
	 * Force the string rep of the interp result.
	 */

	(void) Tcl_GetStringResult(interp);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
6549
6550
6551
6552
6553
6554
6555
6556

6557
6558
6559
6560































































6561
6562
6563
6564
6565
6566
6567
6568











6569


6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587

6588














































6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601

6602
6603
6604
6605
6606
6607
6608

6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619






6620
6621
6622













6623
6624





6625

6626

6627
6628


6629
6630
6631





6632
6633
6634
6635



6636

6637
6638
6639
6640
6641
6642
6643
5876
5877
5878
5879
5880
5881
5882

5883
5884

5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968

5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989

5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047

6048
6049
6050
6051
6052
6053
6054

6055
6056
6057
6058
6059
6060
6061
6062


6063
6064
6065
6066
6067
6068
6069
6070



6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083


6084
6085
6086
6087
6088
6089
6090

6091


6092
6093



6094
6095
6096
6097
6098




6099
6100
6101

6102
6103
6104
6105
6106
6107
6108
6109







-
+

-


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








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


















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












-
+






-
+







-
-


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

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








void
Tcl_AppendObjToErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    Tcl_Obj *objPtr)		/* Message to record. */
{
    size_t length;
    int length;
    const char *message = TclGetStringFromObj(objPtr, &length);
    Interp *iPtr = (Interp *) interp;

    Tcl_IncrRefCount(objPtr);
    Tcl_AddObjErrorInfo(interp, message, length);
    Tcl_DecrRefCount(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AddErrorInfo --
 *
 *	Add information to the errorInfo field that describes the current
 *	error.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The contents of message are appended to the errorInfo field. If we are
 *	just starting to log an error, errorInfo is initialized from the error
 *	message in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AddErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    const char *message)	/* Message to record. */
{
    Tcl_AddObjErrorInfo(interp, message, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AddObjErrorInfo --
 *
 *	Add information to the errorInfo field that describes the current
 *	error. This routine differs from Tcl_AddErrorInfo by taking a byte
 *	pointer and length.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	"length" bytes from "message" are appended to the errorInfo field. If
 *	"length" is negative, use bytes up to the first NULL byte. If we are
 *	just starting to log an error, errorInfo is initialized from the error
 *	message in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AddObjErrorInfo(
    Tcl_Interp *interp,		/* Interpreter to which error information
				 * pertains. */
    const char *message,	/* Points to the first byte of an array of
				 * bytes of the message. */
    int length)			/* The number of bytes in the message. If < 0,
				 * then append all bytes up to a NULL byte. */
{
    register Interp *iPtr = (Interp *) interp;

    /*
     * If we are just starting to log an error, errorInfo is initialized from
     * the error message in the interpreter's result.
     */

    iPtr->flags |= ERR_LEGACY_COPY;
    if (iPtr->errorInfo == NULL) {
	if (iPtr->result[0] != 0) {
	    /*
	     * The interp's string result is set, apparently by some extension
	     * making a deprecated direct write to it. That extension may
	     * expect interp->result to continue to be set, so we'll take
	     * special pains to avoid clearing it, until we drop support for
	     * interp->result completely.
	     */

	    iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1);
	} else {
	iPtr->errorInfo = iPtr->objResultPtr;
	    iPtr->errorInfo = iPtr->objResultPtr;
	}
	Tcl_IncrRefCount(iPtr->errorInfo);
	if (!iPtr->errorCode) {
	    Tcl_SetErrorCode(interp, "NONE", NULL);
	}
    }

    /*
     * Now append "message" to the end of errorInfo.
     */

    if (length != 0) {
	if (Tcl_IsShared(iPtr->errorInfo)) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = Tcl_DuplicateObj(iPtr->errorInfo);
	    Tcl_IncrRefCount(iPtr->errorInfo);
	}
	Tcl_AppendToObj(iPtr->errorInfo, message, length);
    }
}
    Tcl_DecrRefCount(objPtr);

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_VarEvalVA --
 *
 *	Given a variable number of string arguments, concatenate them all
 *	together and execute the result as a Tcl command.
 *
 * Results:
 *	A standard Tcl return result. An error message or other result may be
 *	left in the interp's result.
 *
 * Side effects:
 *	Depends on what was done by the command.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_VarEvalVA(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate command. */
    va_list argList)		/* Variable argument list. */
{
    Tcl_DString buf;
    char *string;
    int result;

    /*
     * Copy the strings one after the other into a single larger string. Use
     * stack-allocated space for small commands, but if the command gets too
     * large than call ckalloc to create the space.
     */

    Tcl_DStringInit(&buf);
    while (1) {
	string = va_arg(argList, char *);
	if (string == NULL) {
	    break;
	}
	Tcl_DStringAppend(&buf, string, -1);
    }

    result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
    Tcl_DStringFree(&buf);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VarEval --
 *
 *	Given a variable number of string arguments, concatenate them all
 *	together and execute the result as a Tcl command.
 *
 * Results:
 *	A standard Tcl return result. An error message or other result may be
 *	left in the interp.
 *	left in interp->result.
 *
 * Side effects:
 *	Depends on what was done by the command.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_VarEval(
    Tcl_Interp *interp,
    ...)
{
    va_list argList;
    int result;
    Tcl_DString buf;
    char *string;

    va_start(argList, interp);
    result = Tcl_VarEvalVA(interp, argList);
    va_end(argList);

    return result;
}

    /*
     * Copy the strings one after the other into a single larger string. Use
     * stack-allocated space for small commands, but if the command gets too
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GlobalEval --
 *
 *	Evaluate a command at global level in an interpreter.
 *
 * Results:
 *	A standard Tcl result is returned, and the interp's result is modified
 *	accordingly.
 *
 * Side effects:
 *	The command string is executed in interp, and the execution is carried
     * large than call Tcl_Alloc to create the space.
     */
 *	out in the variable context of global level (no functions active),
 *	just as if an "uplevel #0" command were being executed.
 *
 *----------------------------------------------------------------------
 */

int
    Tcl_DStringInit(&buf);
Tcl_GlobalEval(
    while (1) {
	string = va_arg(argList, char *);
    Tcl_Interp *interp,		/* Interpreter in which to evaluate command. */
    const char *command)	/* Command to evaluate. */
	if (string == NULL) {
	    break;
	}
{
    register Interp *iPtr = (Interp *) interp;
    int result;
    CallFrame *savedVarFramePtr;

	Tcl_DStringAppend(&buf, string, -1);
    }

    result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
    savedVarFramePtr = iPtr->varFramePtr;
    iPtr->varFramePtr = iPtr->rootFramePtr;
    result = Tcl_Eval(interp, command);
    Tcl_DStringFree(&buf);
    iPtr->varFramePtr = savedVarFramePtr;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetRecursionLimit --
6753
6754
6755
6756
6757
6758
6759
6760

6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776

6777
6778
6779
6780
6781


6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800

6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816

6817
6818
6819
6820
6821


6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840

6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851



6852
6853
6854
6855
6856
6857
6858
6219
6220
6221
6222
6223
6224
6225

6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241

6242





6243
6244

6245
6246
6247
6248
6249

6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260

6261
6262
6263
6264
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







-
+















-
+
-
-
-
-
-
+
+
-





-











-
+















-
+
-
-
-
-
-
+
+
-





-











-
+









-
-
+
+
+







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

static int
ExprCeilFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }

    if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclCeil(&big)));
	mp_clear(&big);
    } else {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ceil(d)));
    }
    return TCL_OK;
}

static int
ExprFloorFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }

    if (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclFloor(&big)));
	mp_clear(&big);
    } else {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(floor(d)));
    }
    return TCL_OK;
}

static int
ExprIsqrtFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored */
    Tcl_Interp *interp,		/* The interpreter in which to execute. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    ClientData ptr;
    int type;
    double d;
    Tcl_WideInt w;
    mp_int big;
    int exact = 0;		/* Flag ==1 if the argument can be represented
				 * in a double as an exact integer. */
    int exact = 0;		/* Flag == 1 if the argument can be
				 * represented in a double as an exact
				 * integer. */

    /*
     * Check syntax.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
6893
6894
6895
6896
6897
6898
6899
6900

6901
6902
6903
6904
6905
6906
6907
6350
6351
6352
6353
6354
6355
6356

6357
6358
6359
6360
6361
6362
6363
6364







-
+







	}
	if (mp_isneg(&big)) {
	    mp_clear(&big);
	    goto negarg;
	}
	break;
    default:
	if (TclGetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
	if (Tcl_GetWideIntFromObj(interp, objv[1], &w) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (w < 0) {
	    goto negarg;
	}
	d = (double) w;
#ifdef IEEE_FLOATING_POINT
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924

6925
6926

6927
6928
6929
6930
6931
6932
6933

6934
6935
6936
6937
6938


6939
6940
6941
6942
6943
6944
6945
6946

6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958
6959
6960
6961
6962

6963
6964
6965
6966
6967


6968
6969
6970
6971
6972
6973
6974
6975
6976
6977
6978
6979

6980
6981

6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6372
6373
6374
6375
6376
6377
6378

6379

6380


6381

6382



6383
6384
6385
6386
6387
6388


6389
6390


6391
6392
6393
6394
6395

6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411

6412





6413
6414

6415
6416
6417
6418
6419
6420
6421
6422

6423

6424


6425

6426




6427
6428
6429
6430
6431
6432
6433







-

-
+
-
-
+
-

-
-
-


+



-
-
+
+
-
-





-
+















-
+
-
-
-
-
-
+
+
-








-

-
+
-
-
+
-

-
-
-
-







	break;
    }

    if (exact) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) sqrt(d)));
    } else {
	mp_int root;
	mp_err err;

	err = mp_init(&root);
	mp_init(&root);
	if (err == MP_OKAY) {
	    err = mp_sqrt(&big, &root);
	mp_sqrt(&big, &root);
	}
	mp_clear(&big);
	if (err != MP_OKAY) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewBignumObj(&root));
    }

    return TCL_OK;

  negarg:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
            "square root of negative argument", -1));
    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj("square root of negative argument", -1));
    Tcl_SetErrorCode(interp, "ARITH", "DOMAIN",
	    "domain error: argument not in valid range", NULL);
    return TCL_ERROR;
}

static int
ExprSqrtFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter list. */
{
    int code;
    double d;
    mp_int big;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);

	if (irPtr) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    if ((d >= 0.0) && TclIsInfinite(d)
	    && (Tcl_GetBignumFromObj(NULL, objv[1], &big) == TCL_OK)) {
	mp_int root;
	mp_err err;

	err = mp_init(&root);
	mp_init(&root);
	if (err == MP_OKAY) {
	    err = mp_sqrt(&big, &root);
	mp_sqrt(&big, &root);
	}
	mp_clear(&big);
	if (err != MP_OKAY) {
	    mp_clear(&root);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(TclBignumToDouble(&root)));
	mp_clear(&root);
    } else {
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(sqrt(d)));
    }
    return TCL_OK;
}
7009
7010
7011
7012
7013
7014
7015
7016

7017
7018

7019
7020
7021
7022


7023
7024
7025
7026
7027
7028
7029
7030

7031
7032
7033
7034
7035
7036
7037
6448
6449
6450
6451
6452
6453
6454

6455


6456




6457
6458

6459
6460
6461
6462
6463
6464

6465
6466
6467
6468
6469
6470
6471
6472







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






-
+








    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);

	d = objv[1]->internalRep.doubleValue;
	if (irPtr) {
	    d = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	Tcl_ResetResult(interp);
	code = TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    errno = 0;
    return CheckDoubleResult(interp, func(d));
    return CheckDoubleResult(interp, (*func)(d));
}

static int
CheckDoubleResult(
    Tcl_Interp *interp,
    double dResult)
{
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

7137
7138

7139
7140
7141
7142
7143
7144
7145





7146
7147
7148

7149
7150
7151
7152
7153


7154
7155
7156
7157
7158

7159
7160
7161
7162
7163
7164
7165
7166
7167
7168


7169
7170
7171
7172
7173


7174

7175
7176



7177
7178
7179
7180
7181

7182
7183
7184
7185









7186
7187
7188











7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213

7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234

7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248

7249
7250
7251
7252
7253
7254
7255
7256
7257
7258
7259
7260
7261


7262
7263
7264
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281

7282
7283
7284
7285
7286
7287
7288
7289
7290
7291

7292
7293

7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
































7316
7317

7318
7319
7320
7321
7322
7323
7324
7325


7326
7327
7328

7329
7330
7331
7332
7333


7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
7349

7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362

7363
7364

7365
7366
7367
7368
7369








7370
7371
7372

7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400

7401
7402
7403
7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
7417
7418
7419
7420
7421
7422


7423
7424
7425
7426
7427
7428
7429
7430
7431
7432


7433
7434
7435
7436
7437
7438
7439
6508
6509
6510
6511
6512
6513
6514

6515


6516




6517
6518

6519
6520
6521
6522
6523
6524
6525

6526


6527




6528
6529

6530
6531
6532
6533
6534
6535

6536
6537
6538
6539
6540

6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559


6560
6561
6562

6563
6564

6565







6566
6567
6568
6569
6570
6571
6572

6573
6574
6575
6576


6577
6578


6579
6580

6581
6582
6583
6584
6585
6586
6587
6588



6589
6590
6591

6592


6593
6594
6595
6596


6597
6598
6599
6600
6601
6602
6603
6604
6605




6606
6607
6608
6609
6610
6611
6612
6613
6614



6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639

6640
6641
6642
6643
6644
6645
6646
6647
6648

6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669

6670
6671
6672
6673
6674
6675
6676

6677
6678
6679
6680
6681
6682

6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694


6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715

6716
6717
6718
6719
6720
6721
6722
6723
6724
6725

6726
6727

6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783

6784
6785
6786
6787
6788
6789
6790


6791
6792
6793
6794

6795





6796
6797
















6798













6799
6800

6801





6802
6803
6804
6805
6806
6807
6808
6809



6810
6811
6812
6813
6814






















6815

6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836


6837
6838
6839
6840
6841
6842
6843
6844
6845
6846


6847
6848
6849
6850
6851
6852
6853
6854
6855







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







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






-
+




-
+


















-
-
+
+

-
+

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


-
+



-
-
+
+
-
-


-
+







-
-
-
+
+

-

-
-
+
+

+
-
-
+
+
+





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














-









-
+




















-
+






-






-
+











-
-
+
+



















-
+









-
+

-
+






















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

-
+






-
-
+
+


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

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




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+




















-
-
+
+








-
-
+
+








    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);

	d1 = objv[1]->internalRep.doubleValue;
	if (irPtr) {
	    d1 = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	Tcl_ResetResult(interp);
	code = TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
    if (code != TCL_OK) {
    if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);

	d2 = objv[2]->internalRep.doubleValue;
	if (irPtr) {
	    d2 = irPtr->doubleValue;
	    Tcl_ResetResult(interp);
	    code = TCL_OK;
	Tcl_ResetResult(interp);
	code = TCL_OK;
	}
    }
#endif
    if (code != TCL_OK) {
	return TCL_ERROR;
    }
    errno = 0;
    return CheckDoubleResult(interp, func(d1, d2));
    return CheckDoubleResult(interp, (*func)(d1, d2));
}

static int
ExprAbsFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    ClientData ptr;
    int type;
    mp_int big;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_INT) {
	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);
    if (type == TCL_NUMBER_LONG) {
	long l = *((const long *) ptr);

	if (l > 0) {
	if (l > (long)0) {
	    goto unChanged;
	} else if (l == 0) {
	} else if (l == (long)0) {
	    if (TclHasStringRep(objv[1])) {
		size_t numBytes;
		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);

		while (numBytes) {
		    if (*bytes == '-') {
			Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
	    const char *string = objv[1]->bytes;
	    if (string) {
		while (*string != '0') {
		    if (*string == '-') {
			Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
			return TCL_OK;
		    }
		    bytes++; numBytes--;
		    string++;
		}
	    }
	    goto unChanged;
	} else if (l == WIDE_MIN) {
	    if (mp_init_i64(&big, l) != MP_OKAY) {
	} else if (l == LONG_MIN) {
	    TclBNInitBignumFromLong(&big, l);
		return TCL_ERROR;
	    }
	    goto tooLarge;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
	Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
	return TCL_OK;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	double d = *((const double *) ptr);
	static const double poszero = 0.0;

	/*
	 * We need to distinguish here between positive 0.0 and negative -0.0.
	 * [Bug 2954959]
	/* We need to distinguish here between positive 0.0 and
	 * negative -0.0, see Bug ID #2954959.
	 */

	if (d == -0.0) {
	    if (!memcmp(&d, &poszero, sizeof(double))) {
		goto unChanged;
		if (!memcmp(&d, &poszero, sizeof(double))) {
	    goto unChanged;
	    }
	} else {
	} else if (d > -0.0) {
	    goto unChanged;
	    if (d > -0.0) {
		goto unChanged;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
	return TCL_OK;
    }

#ifndef NO_WIDE_TYPE
    if (type == TCL_NUMBER_BIG) {
	if (mp_isneg((const mp_int *) ptr)) {
	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
	tooLarge:
    if (type == TCL_NUMBER_WIDE) {
	Tcl_WideInt w = *((const Tcl_WideInt *) ptr);

	if (w >= (Tcl_WideInt)0) {
	    goto unChanged;
	}
	if (w == LLONG_MIN) {
	    TclBNInitBignumFromWideInt(&big, w);
	    goto tooLarge;
	    if (mp_neg(&big, &big) != MP_OKAY) {
		return TCL_ERROR;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
	return TCL_OK;
    }
#endif

    if (type == TCL_NUMBER_BIG) {
	if (mp_cmp_d(ptr, 0) == MP_LT) {
	    Tcl_GetBignumFromObj(NULL, objv[1], &big);
	tooLarge:
	    mp_neg(&big, &big);
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	} else {
	unChanged:
	    Tcl_SetObjResult(interp, objv[1]);
	}
	return TCL_OK;
    }

    if (type == TCL_NUMBER_NAN) {
#ifdef ACCEPT_NAN
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
#else
	double d;

	Tcl_GetDoubleFromObj(interp, objv[1], &d);
	return TCL_ERROR;
#endif
    }
    return TCL_OK;
}

static int
ExprBoolFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    int value;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
}

static int
ExprDoubleFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    double dResult;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
	if (TclHasIntRep(objv[1], &tclDoubleType)) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}
#endif
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(dResult));
    return TCL_OK;
}

static int
ExprIntFunc(
    TCL_UNUSED(void *),
ExprEntierFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    double d;
    int type;
    ClientData ptr;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	d = *((const double *) ptr);
	if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
	if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
	    mp_int big;

	    if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
		/* Infinity */
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	    return TCL_OK;
	} else {
	    Tcl_WideInt result = (Tcl_WideInt) d;
	    long result = (long) d;

	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
	    return TCL_OK;
	}
    }

    if (type != TCL_NUMBER_NAN) {
	/*
	 * All integers are already of integer type.
	 */

	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

    /*
     * Get the error message for NaN.
     */

    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprIntFunc(
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    long iResult;
    Tcl_Obj *objPtr;
    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    objPtr = Tcl_GetObjResult(interp);
    if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
	/*
	 * Truncate the bignum; keep only bits in long range.
	 */

	mp_int big;

	Tcl_GetBignumFromObj(NULL, objPtr, &big);
	mp_mod_2d(&big, CHAR_BIT * sizeof(long), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetLongFromObj(NULL, objPtr, &iResult);
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
    return TCL_OK;
}

static int
ExprWideFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    Tcl_WideInt wResult;

    if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
    Tcl_Obj *objPtr;
    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
    objPtr = Tcl_GetObjResult(interp);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
    return TCL_OK;
}

/*
    if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
	/*
 * Common implmentation of max() and min().
 */
static int
ExprMaxMinFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv,	/* Actual parameter vector. */
    int op)			/* Comparison direction */
{
    Tcl_Obj *res;
    double d;
    int type, i;
    ClientData ptr;

	 * Truncate the bignum; keep only bits in wide int range.
    if (objc < 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }
    res = objv[1];
    for (i = 1; i < objc; i++) {
        if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
            return TCL_ERROR;
        }
        if (type == TCL_NUMBER_NAN) {
            /*
             * Get the error message for NaN.
             */
	 */

            Tcl_GetDoubleFromObj(interp, objv[i], &d);
	mp_int big;
            return TCL_ERROR;
        }
        if (TclCompareTwoNumbers(objv[i], res) == op)  {
            res = objv[i];
        }

	Tcl_GetBignumFromObj(NULL, objPtr, &big);
	mp_mod_2d(&big, CHAR_BIT * sizeof(Tcl_WideInt), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
	Tcl_DecrRefCount(objPtr);
    }
    }

    Tcl_SetObjResult(interp, res);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
    return TCL_OK;
}

static int
ExprMaxFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    return ExprMaxMinFunc(NULL, interp, objc, objv, MP_GT);
}

static int
ExprMinFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    return ExprMaxMinFunc(NULL, interp, objc, objv, MP_LT);
}

static int
ExprRandFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    double dResult;
    long tmp;			/* Algorithm assumes at least 32 bits. Only
				 * long guarantees that. See below. */
    Tcl_Obj *oResult;

    if (objc != 1) {
	MathFuncWrongNumArgs(interp, 1, objc, objv);
	return TCL_ERROR;
    }

    if (!(iPtr->flags & RAND_SEED_INITIALIZED)) {
	iPtr->flags |= RAND_SEED_INITIALIZED;

	/*
	 * To ensure different seeds in different threads (bug #416643),
	 * take into consideration the thread this interp is running in.
	 * Take into consideration the thread this interp is running in order
	 * to insure different seeds in different threads (bug #416643)
	 */

	iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);

	/*
	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
	 */

	iPtr->randSeed &= 0x7FFFFFFF;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFF)) {
	iPtr->randSeed &= (unsigned long) 0x7fffffff;
	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	    iPtr->randSeed ^= 123459876;
	}
    }

    /*
     * Generate the random number using the linear congruential generator
     * defined by the following recurrence:
7486
7487
7488
7489
7490
7491
7492
7493

7494
7495
7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514

7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
7528
7529
7530
7531

7532
7533

7534
7535
7536
7537
7538
7539
7540
7541

7542
7543
7544
7545
7546
7547
7548

7549
7550
7551
7552
7553
7554
7555
6902
6903
6904
6905
6906
6907
6908

6909
6910
6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929

6930
6931
6932
6933
6934
6935
6936
6937
6938
6939

6940
6941
6942
6943
6944
6945

6946
6947

6948



6949
6950
6951
6952

6953
6954
6955
6956
6957
6958
6959

6960
6961
6962
6963
6964
6965
6966
6967







-
+




















-
+









-






-
+

-
+
-
-
-




-
+






-
+







    TclNewDoubleObj(oResult, dResult);
    Tcl_SetObjResult(interp, oResult);
    return TCL_OK;
}

static int
ExprRoundFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    double d;
    ClientData ptr;
    int type;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
	return TCL_ERROR;
    }

    if (type == TCL_NUMBER_DOUBLE) {
	double fractPart, intPart;
	Tcl_WideInt max = WIDE_MAX, min = WIDE_MIN;
	long max = LONG_MAX, min = LONG_MIN;

	fractPart = modf(*((const double *) ptr), &intPart);
	if (fractPart <= -0.5) {
	    min++;
	} else if (fractPart >= 0.5) {
	    max--;
	}
	if ((intPart >= (double)max) || (intPart <= (double)min)) {
	    mp_int big;
	    mp_err err = MP_OKAY;

	    if (Tcl_InitBignumFromDouble(interp, intPart, &big) != TCL_OK) {
		/* Infinity */
		return TCL_ERROR;
	    }
	    if (fractPart <= -0.5) {
		err = mp_sub_d(&big, 1, &big);
		mp_sub_d(&big, 1, &big);
	    } else if (fractPart >= 0.5) {
		err = mp_add_d(&big, 1, &big);
		mp_add_d(&big, 1, &big);
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
	    return TCL_OK;
	} else {
	    Tcl_WideInt result = (Tcl_WideInt)intPart;
	    long result = (long)intPart;

	    if (fractPart <= -0.5) {
		result--;
	    } else if (fractPart >= 0.5) {
		result++;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
	    return TCL_OK;
	}
    }

    if (type != TCL_NUMBER_NAN) {
	/*
	 * All integers are already rounded
7565
7566
7567
7568
7569
7570
7571
7572

7573
7574
7575
7576
7577
7578
7579

7580
7581
7582
7583
7584
7585
7586
7587
7588
7589
7590
7591














7592
7593
7594
7595
7596

7597
7598
7599
7600
7601



7602
7603
7604
7605
7606
7607
7608
7609
7610
7611

7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
7635
7636
7637
7638
7639
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732
7733
7734
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
7769
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
7803
7804
7805
7806
7807
7808
7809
7810
7811
7812
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822
7823
7824
7825
7826
7827
7828
7829
7830
7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
7841
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
7892
7893
7894
7895
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916
7917
7918
7919
7920
7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
7963
7964
7965
7966
7967
7968
7969
7970
7971
7972
7973
7974
7975
7976
7977
7978
7979
7980
7981
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
6977
6978
6979
6980
6981
6982
6983

6984
6985
6986
6987
6988
6989
6990

6991
6992
6993
6994
6995
6996
6997
6998
6999
7000
7001


7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014
7015
7016
7017
7018
7019

7020
7021
7022
7023


7024
7025
7026
7027
7028
7029
7030
7031
7032
7033
7034
7035

7036





































































































































































































































































































































































































7037
7038
7039
7040
7041
7042
7043







-
+






-
+










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




-
+



-
-
+
+
+









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








    Tcl_GetDoubleFromObj(interp, objv[1], &d);
    return TCL_ERROR;
}

static int
ExprSrandFunc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Parameter vector. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_WideInt w = 0;		/* Initialized to avoid compiler warning. */
    long i = 0;			/* Initialized to avoid compiler warning. */

    /*
     * Convert argument and use it to reset the seed.
     */

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetWideBitsFromObj(NULL, objv[1], &w) != TCL_OK) {
	return TCL_ERROR;
    if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
	Tcl_Obj *objPtr;
	mp_int big;

	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
	    /* TODO: more ::errorInfo here? or in caller? */
	    return TCL_ERROR;
	}

	mp_mod_2d(&big, CHAR_BIT * sizeof(long), &big);
	objPtr = Tcl_NewBignumObj(&big);
	Tcl_IncrRefCount(objPtr);
	TclGetLongFromObj(NULL, objPtr, &i);
	Tcl_DecrRefCount(objPtr);
    }

    /*
     * Reset the seed. Make sure 1 <= randSeed <= 2^31 - 2. See comments in
     * ExprRandFunc for more details.
     * ExprRandFunc() for more details.
     */

    iPtr->flags |= RAND_SEED_INITIALIZED;
    iPtr->randSeed = (long) w & 0x7FFFFFFF;
    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFF)) {
    iPtr->randSeed = i;
    iPtr->randSeed &= (unsigned long) 0x7fffffff;
    if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
	iPtr->randSeed ^= 123459876;
    }

    /*
     * To avoid duplicating the random number generation code we simply clean
     * up our state and call the real random number function. That function
     * will always succeed.
     */

    return ExprRandFunc(NULL, interp, 1, objv);
    return ExprRandFunc(clientData, interp, 1, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Double Classification Functions --
 *
 *	This page contains the functions that implement all of the built-in
 *	math functions for classifying IEEE doubles.
 *
 *      These have to be a little bit careful while Tcl_GetDoubleFromObj()
 *      rejects NaN values, which these functions *explicitly* accept.
 *
 * Results:
 *	Each function returns TCL_OK if it succeeds and pushes an Tcl object
 *	holding the result. If it fails it returns TCL_ERROR and leaves an
 *	error message in the interpreter's result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 *
 * Older MSVC is supported by Tcl, but doesn't have fpclassify(). Of course.
 * But it does sometimes have _fpclass() which does almost the same job; if
 * even that is absent, we grobble around directly in the platform's binary
 * representation of double.
 *
 * The ClassifyDouble() function makes all that conform to a common API
 * (effectively the C99 standard API renamed), and just delegates to the
 * standard macro on platforms that do it correctly.
 */

static inline int
ClassifyDouble(
    double d)
{
#if TCL_FPCLASSIFY_MODE == 0
    return fpclassify(d);
#else /* TCL_FPCLASSIFY_MODE != 0 */
    /*
     * If we don't have fpclassify(), we also don't have the values it returns.
     * Hence we define those here.
     */
#ifndef FP_NAN
#   define FP_NAN          1	/* Value is NaN */
#   define FP_INFINITE     2	/* Value is an infinity */
#   define FP_ZERO         3	/* Value is a zero */
#   define FP_NORMAL       4	/* Value is a normal float */
#   define FP_SUBNORMAL    5	/* Value has lost accuracy */
#endif /* !FP_NAN */

#if TCL_FPCLASSIFY_MODE == 3
    return __builtin_fpclassify(
            FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d);
#elif TCL_FPCLASSIFY_MODE == 2
    /*
     * We assume this hack is only needed on little-endian systems.
     * Specifically, x86 running Windows.  It's fairly easy to enable for
     * others if they need it (because their libc/libm is broken) but we'll
     * jump that hurdle when requred.  We can solve the word ordering then.
     */

    union {
        double d;               /* Interpret as double */
        struct {
            unsigned int low;   /* Lower 32 bits */
            unsigned int high;  /* Upper 32 bits */
        } w;                    /* Interpret as unsigned integer words */
    } doubleMeaning;            /* So we can look at the representation of a
                                 * double directly. Platform (i.e., processor)
                                 * specific; this is for x86 (and most other
                                 * little-endian processors, but those are
                                 * untested). */
    unsigned int exponent, mantissaLow, mantissaHigh;
                                /* The pieces extracted from the double. */
    int zeroMantissa;           /* Was the mantissa zero? That's special. */

    /*
     * Shifts and masks to use with the doubleMeaning variable above.
     */

#define EXPONENT_MASK   0x7FF   /* 11 bits (after shifting) */
#define EXPONENT_SHIFT  20      /* Moves exponent to bottom of word */
#define MANTISSA_MASK   0xFFFFF /* 20 bits (plus 32 from other word) */

    /*
     * Extract the exponent (11 bits) and mantissa (52 bits).  Note that we
     * totally ignore the sign bit.
     */

    doubleMeaning.d = d;
    exponent = (doubleMeaning.w.high >> EXPONENT_SHIFT) & EXPONENT_MASK;
    mantissaLow = doubleMeaning.w.low;
    mantissaHigh = doubleMeaning.w.high & MANTISSA_MASK;
    zeroMantissa = (mantissaHigh == 0 && mantissaLow == 0);

    /*
     * Look for the special cases of exponent.
     */

    switch (exponent) {
    case 0:
        /*
         * When the exponent is all zeros, it's a ZERO or a SUBNORMAL.
         */

        return zeroMantissa ? FP_ZERO : FP_SUBNORMAL;
    case EXPONENT_MASK:
        /*
         * When the exponent is all ones, it's an INF or a NAN.
         */

        return zeroMantissa ? FP_INFINITE : FP_NAN;
    default:
        /*
         * Everything else is a NORMAL double precision float.
         */

        return FP_NORMAL;
    }
#elif TCL_FPCLASSIFY_MODE == 1
    switch (_fpclass(d)) {
    case _FPCLASS_NZ:
    case _FPCLASS_PZ:
        return FP_ZERO;
    case _FPCLASS_NN:
    case _FPCLASS_PN:
        return FP_NORMAL;
    case _FPCLASS_ND:
    case _FPCLASS_PD:
        return FP_SUBNORMAL;
    case _FPCLASS_NINF:
    case _FPCLASS_PINF:
        return FP_INFINITE;
    default:
        Tcl_Panic("result of _fpclass() outside documented range!");
    case _FPCLASS_QNAN:
    case _FPCLASS_SNAN:
        return FP_NAN;
    }
#else /* TCL_FPCLASSIFY_MODE not in (0..3) */
#error "unknown or unexpected TCL_FPCLASSIFY_MODE"
#endif /* TCL_FPCLASSIFY_MODE */
#endif /* !fpclassify */
}

static int
ExprIsFiniteFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        type = ClassifyDouble(d);
        result = (type != FP_INFINITE && type != FP_NAN);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsInfinityFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_INFINITE);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsNaNFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 1;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_NAN);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsNormalFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_NORMAL);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsSubnormalFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;

    if (objc != 2) {
	MathFuncWrongNumArgs(interp, 2, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type != TCL_NUMBER_NAN) {
        if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
            return TCL_ERROR;
        }
        result = (ClassifyDouble(d) == FP_SUBNORMAL);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
ExprIsUnorderedFunc(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    ClientData ptr;
    int type, result = 0;

    if (objc != 3) {
	MathFuncWrongNumArgs(interp, 3, objc, objv);
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type == TCL_NUMBER_NAN) {
        result = 1;
    } else {
        d = *((const double *) ptr);
        result = (ClassifyDouble(d) == FP_NAN);
    }

    if (TclGetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type == TCL_NUMBER_NAN) {
        result |= 1;
    } else {
        d = *((const double *) ptr);
        result |= (ClassifyDouble(d) == FP_NAN);
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
FloatClassifyObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* The interpreter in which to execute the
				 * function. */
    int objc,			/* Actual parameter count */
    Tcl_Obj *const *objv)	/* Actual parameter list */
{
    double d;
    Tcl_Obj *objPtr;
    ClientData ptr;
    int type;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "floatValue");
	return TCL_ERROR;
    }

    if (TclGetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) {
        return TCL_ERROR;
    }
    if (type == TCL_NUMBER_NAN) {
        goto gotNaN;
    } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
        return TCL_ERROR;
    }
    switch (ClassifyDouble(d)) {
    case FP_INFINITE:
        TclNewLiteralStringObj(objPtr, "infinite");
        break;
    case FP_NAN:
    gotNaN:
        TclNewLiteralStringObj(objPtr, "nan");
        break;
    case FP_NORMAL:
        TclNewLiteralStringObj(objPtr, "normal");
        break;
    case FP_SUBNORMAL:
        TclNewLiteralStringObj(objPtr, "subnormal");
        break;
    case FP_ZERO:
        TclNewLiteralStringObj(objPtr, "zero");
        break;
    default:
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unable to classify number: %f", d));
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * MathFuncWrongNumArgs --
 *
8020
8021
8022
8023
8024
8025
8026
8027

8028
8029
8030
8031

8032
8033
8034
8035
8036
8037
8038
8039


8040
8041
8042
8043

8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063


8064
8065
8066
8067
8068
8069
8070
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







-
+



-
+






-
-
+
+
-

-

+


















-
-
+
+







static void
MathFuncWrongNumArgs(
    Tcl_Interp *interp,		/* Tcl interpreter */
    int expected,		/* Formal parameter count. */
    int found,			/* Actual parameter count. */
    Tcl_Obj *const *objv)	/* Actual parameter vector. */
{
    const char *name = TclGetString(objv[0]);
    const char *name = Tcl_GetString(objv[0]);
    const char *tail = name + strlen(name);

    while (tail > name+1) {
	tail--;
	--tail;
	if (*tail == ':' && tail[-1] == ':') {
	    name = tail+1;
	    break;
	}
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s arguments for math function \"%s\"",
	    (found < expected ? "not enough" : "too many"), name));
	    "too %s arguments for math function \"%s\"",
	    (found < expected ? "few" : "many"), name));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
}

#ifdef USE_DTRACE

/*
 *----------------------------------------------------------------------
 *
 * DTraceObjCmd --
 *
 *	This function is invoked to process the "::tcl::dtrace" Tcl command.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	The 'tcl-probe' DTrace probe is triggered (if it is enabled).
 *
 *----------------------------------------------------------------------
 */

static int
DTraceObjCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (TCL_DTRACE_TCL_PROBE_ENABLED()) {
	char *a[10];
	int i = 0;

8092
8093
8094
8095
8096
8097
8098
8099

8100
8101
8102

8103
8104

8105
8106
8107
8108
8109
8110







8111
8112
8113

8114
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140

8141
8142
8143
8144
8145
8146
8147
8148
8149
8150
8151
8152
8153
8154
8155
8156
8157
8158
8159
8160
8161
8162
8163
8164
8165
8166
8167
8168
8169
8170
8171
8172
8173
8174
8175
8176
8177
8178
8179
8180
8181
8182
8183
8184
8185
8186
8187
8188
8189
8190
8191
8192
8193
8194
8195
8196
8197
8198
8199
8200
8201
8202
8203
8204
8205
8206
8207
8208
8209
8210
8211
8212
8213
8214
8215
8216
8217
8218
8219
8220
8221
8222
8223
8224
8225
8226
8227
8228
8229
8230
8231
8232
8233
8234
8235
8236
8237
8238
8239
8240
8241
8242
8243
8244
8245
8246
8247
8248
8249
8250
8251
8252
8253
8254
8255
8256
8257
8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
8275
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302
8303
8304
8305
8306
8307
8308
8309
8310
8311
8312
8313
8314
8315
8316
8317
8318
8319
8320
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
8334
8335
8336
8337
8338
8339
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
8367
8368
8369
8370
8371
8372
8373
8374
8375
8376
8377
8378
8379
8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
8412
8413
8414
8415
8416
8417
8418
8419
8420
8421
8422
8423
8424
8425
8426
8427
8428
8429
8430
8431
8432
8433
8434
8435
8436
8437
8438
8439
8440
8441
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451
8452
8453
8454
8455
8456
8457
8458
8459
8460
8461
8462
8463
8464
8465
8466
8467
8468
8469
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
8480
8481
8482
8483
8484
8485
8486
8487
8488
8489
8490
8491
8492
8493
8494
8495
8496
8497
8498
8499
8500
8501
8502
8503
8504
8505
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
8552
8553
8554
8555
8556
8557
8558
8559
8560
8561
8562
8563
8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575
8576
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
8591
8592
8593
8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8604
8605
8606
8607
8608
8609
8610
8611
8612
8613
8614
8615
8616
8617
8618
8619
8620
8621
8622
8623
8624
8625
8626
8627
8628
8629
8630
8631
8632
8633
8634
8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
8654
8655
8656
8657
8658
8659
8660
8661
8662
8663
8664
8665
8666
8667
8668
8669
8670
8671
8672
8673
8674
8675
8676
8677
8678
8679
8680
8681
8682
8683
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694
8695
8696
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
8853
8854
8855
8856
8857
8858
8859
8860
8861
8862
8863
8864
8865
8866
8867
8868
8869
8870
8871
8872
8873
8874
8875
8876
8877
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
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
8934
8935
8936
8937
8938
8939
8940
8941
8942
8943
8944
8945
8946
8947
8948
8949
8950
8951
8952
8953
8954
8955
8956
8957
8958
8959
8960
8961
8962
8963
8964
8965
8966
8967
8968
8969
8970
8971
8972
8973
8974
8975
8976
8977
8978
8979
8980
8981
8982
8983
8984
8985
8986
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
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
9054
9055
9056
9057
9058
9059
9060
9061
9062
9063
9064
9065
9066
9067
9068
9069
9070
9071
9072
9073
9074
9075
9076
9077
9078
9079
9080
9081
9082
9083
9084
9085
9086
9087
9088
9089
9090
9091
9092
9093
9094
9095
9096
9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110
9111
9112
9113
9114
9115
9116
9117
9118
9119
9120
9121
9122
9123
9124
9125
9126
9127
9128
9129
9130
9131
9132
9133
9134
9135
9136
9137
9138
9139
9140
9141
9142
9143
9144
9145
9146
9147
9148
9149
9150
9151
9152
9153
9154
9155
9156
9157
9158
9159
9160
9161
9162
9163
9164
9165
9166
9167
9168
9169
9170
9171
9172
9173
9174
9175
9176
9177
9178
9179
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
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
9272
9273
9274
9275
9276
9277
9278
9279
9280
9281
9282
9283
9284
9285
9286
9287
9288
9289
9290
9291
9292
9293
9294
9295
9296
9297
9298
9299
9300
9301
9302
9303
9304
9305
9306
9307
9308
9309
9310
9311
9312
9313
9314
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
9351
9352
9353
9354
9355
9356
9357
9358
9359
9360
9361
9362
9363
9364
9365
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408
9409
9410
9411
9412
9413
9414
9415
9416
9417
9418
9419
9420
9421
9422
9423
9424
9425
9426
9427
9428
9429
9430
9431
9432
9433
9434
9435
9436
9437
9438
9439
9440
9441
9442
9443
9444
9445
9446
9447
9448
9449
9450
9451
9452
9453
9454
9455
9456
9457
9458
9459
9460
9461
9462
9463
9464
9465
9466
9467
9468
9469
9470
9471
9472
9473
9474
9475
9476
9477
9478
9479
9480
9481
9482
9483
9484
9485
9486
9487
9488
9489
9490
9491
9492
9493
9494
9495
9496
9497
9498
9499
9500
9501
9502
9503
9504
9505
9506
9507
9508
9509
9510
9511
9512
9513
9514
9515
9516
9517
9518
9519
9520
9521
9522
9523
9524
9525
9526
9527
9528
9529
9530
9531
9532
9533
9534
9535
9536
9537
9538
9539
9540
9541
9542
9543
9544
9545
9546
9547
9548
9549
9550
9551
7127
7128
7129
7130
7131
7132
7133

7134
7135
7136

7137
7138

7139
7140
7141




7142
7143
7144
7145
7146
7147
7148

7149

7150
7151
7152
7153





7154
7155
7156
7157










7158
7159
7160
7161

7162
7163
7164
7165
7166
7167



































7168
7169
7170
7171
7172













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































7173
7174
7175
7176
7177


7178
7179







-
+


-
+

-
+


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

-
+



-
-
-
-
-




-
-
-
-
-
-
-
-
-
-




-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-


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

void
TclDTraceInfo(
    Tcl_Obj *info,
    const char **args,
    char **args,
    int *argsi)
{
    static Tcl_Obj *keys[10] = { NULL };
    static Tcl_Obj *keys[7] = { NULL };
    Tcl_Obj **k = keys, *val;
    int i = 0;
    int i;

    if (!*k) {
#define kini(s) TclNewLiteralStringObj(keys[i], s); i++
	kini("cmd");	kini("type");	kini("proc");	kini("file");
	kini("method");	kini("class");	kini("lambda");	kini("object");
	kini("line");	kini("level");
	TclNewLiteralStringObj(keys[0], "cmd");
	TclNewLiteralStringObj(keys[1], "type");
	TclNewLiteralStringObj(keys[2], "proc");
	TclNewLiteralStringObj(keys[3], "file");
	TclNewLiteralStringObj(keys[4], "lambda");
	TclNewLiteralStringObj(keys[5], "line");
	TclNewLiteralStringObj(keys[6], "level");
#undef kini
    }
    for (i = 0; i < 6; i++) {
    for (i = 0; i < 4; i++) {
	Tcl_DictObjGet(NULL, info, *k++, &val);
	args[i] = val ? TclGetString(val) : NULL;
    }

    /*
     * no "proc" -> use "lambda"
     */

    if (!args[2]) {
	Tcl_DictObjGet(NULL, info, *k, &val);
	args[2] = val ? TclGetString(val) : NULL;
    }
    k++;

    /*
     * no "class" -> use "object"
     */

    if (!args[5]) {
	Tcl_DictObjGet(NULL, info, *k, &val);
	args[5] = val ? TclGetString(val) : NULL;
    }
    k++;
    for (i = 0; i < 2; i++) {
	Tcl_DictObjGet(NULL, info, *k++, &val);
	if (val) {
	    TclGetIntFromObj(NULL, val, &argsi[i]);
	    TclGetIntFromObj(NULL, val, &(argsi[i]));
	} else {
	    argsi[i] = 0;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DTraceCmdReturn --
 *
 *	NR callback for DTrace command return probes.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
DTraceCmdReturn(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    char *cmdName = TclGetString((Tcl_Obj *) data[0]);

    if (TCL_DTRACE_CMD_RETURN_ENABLED()) {
	TCL_DTRACE_CMD_RETURN(cmdName, result);
    }
    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
	Tcl_Obj *r = Tcl_GetObjResult(interp);

	TCL_DTRACE_CMD_RESULT(cmdName, result, TclGetString(r), r);
    }
    return result;
}

TCL_DTRACE_DEBUG_LOG()

#endif /* USE_DTRACE */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NRCallObjProc --
 *
 *	This function calls an objProc directly while managing things properly
 *	if it happens to be an NR objProc. It is meant to be used by extenders
 *	that provide an NR implementation of a command, as this function
 *	permits a trivial coding of the non-NR objProc.
 *
 * Results:
 *	The return value is a standard Tcl completion code such as TCL_OK or
 *	TCL_ERROR. A result or error message is left in interp's result.
 *
 * Side effects:
 *	Depends on the objProc.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_NRCallObjProc(
    Tcl_Interp *interp,
    Tcl_ObjCmdProc *objProc,
    ClientData clientData,
    int objc,
    Tcl_Obj *const objv[])
{
    NRE_callback *rootPtr = TOP_CB(interp);

    TclNRAddCallback(interp, Dispatch, objProc, clientData,
	    INT2PTR(objc), objv);
    return TclNRRunCallbacks(interp, TCL_OK, rootPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NRCreateCommand --
 *
 *	Define a new NRE-enabled object-based command in a command table.
 *
 * Results:
 *	The return value is a token for the command, which can be used in
 *	future calls to Tcl_GetCommandName.
 *
 * Side effects:
 *	If no command named "cmdName" already exists for interp, one is
 *	created. Otherwise, if a command does exist, then if the object-based
 *	Tcl_ObjCmdProc is TclInvokeStringCommand, we assume Tcl_CreateCommand
 *	was called previously for the same command and just set its
 *	Tcl_ObjCmdProc to the argument "proc"; otherwise, we delete the old
 *	command.
 *
 *	In the future, during bytecode evaluation when "cmdName" is seen as
 *	the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based
 *	Tcl_ObjCmdProc proc will be called. When the command is deleted from
 *	the table, deleteProc will be called. See the manual entry for details
 *	on the calling sequence.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_NRCreateCommand(
    Tcl_Interp *interp,		/* Token for command interpreter (returned by
				 * previous call to Tcl_CreateInterp). */
    const char *cmdName,	/* Name of command. If it contains namespace
				 * qualifiers, the new command is put in the
				 * specified namespace; otherwise it is put in
				 * the global namespace. */
    Tcl_ObjCmdProc *proc,	/* Object-based function to associate with
				 * name, provides direct access for direct
				 * calls. */
    Tcl_ObjCmdProc *nreProc,	/* Object-based function to associate with
				 * name, provides NR implementation */
    ClientData clientData,	/* Arbitrary value to pass to object
				 * function. */
    Tcl_CmdDeleteProc *deleteProc)
				/* If not NULL, gives a function to call when
				 * this command is deleted. */
{
    Command *cmdPtr = (Command *)
	    Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
                    deleteProc);

    cmdPtr->nreProc = nreProc;
    return (Tcl_Command) cmdPtr;
}

Tcl_Command
TclNRCreateCommandInNs(
    Tcl_Interp *interp,
    const char *cmdName,
    Tcl_Namespace *nsPtr,
    Tcl_ObjCmdProc *proc,
    Tcl_ObjCmdProc *nreProc,
    ClientData clientData,
    Tcl_CmdDeleteProc *deleteProc)
{
    Command *cmdPtr = (Command *)
            TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
                    deleteProc);

    cmdPtr->nreProc = nreProc;
    return (Tcl_Command) cmdPtr;
}

/****************************************************************************
 * Stuff for the public api
 ****************************************************************************/

int
Tcl_NREvalObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int flags)
{
    return TclNREvalObjEx(interp, objPtr, flags, NULL, INT_MIN);
}

int
Tcl_NREvalObjv(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the
				 * command. Also used for error reporting. */
    int objc,			/* Number of words in command. */
    Tcl_Obj *const objv[],	/* An array of pointers to objects that are
				 * the words that make up the command. */
    int flags)			/* Collection of OR-ed bits that control the
				 * evaluation of the script. Only
				 * TCL_EVAL_GLOBAL, TCL_EVAL_INVOKE and
				 * TCL_EVAL_NOERR are currently supported. */
{
    return TclNREvalObjv(interp, objc, objv, flags, NULL);
}

int
Tcl_NRCmdSwap(
    Tcl_Interp *interp,
    Tcl_Command cmd,
    int objc,
    Tcl_Obj *const objv[],
    int flags)
{
    return TclNREvalObjv(interp, objc, objv, flags|TCL_EVAL_NOERR,
	    (Command *) cmd);
}

/*****************************************************************************
 * Tailcall related code
 *****************************************************************************
 *
 * The steps of the tailcall dance are as follows:
 *
 *   1. when [tailcall] is invoked, it stores the corresponding callback in
 *      the current CallFrame and returns TCL_RETURN
 *   2. when the CallFrame is popped, it calls TclSetTailcall to store the
 *      callback in the proper NRCommand callback - the spot where the command
 *      that pushed the CallFrame is completely cleaned up
 *   3. when the NRCommand callback runs, it schedules the tailcall callback
 *      to run immediately after it returns
 *
 *   One delicate point is to properly define the NRCommand where the tailcall
 *   will execute. There are functions whose purpose is to help define the
 *   precise spot:
 *     TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution
 *         should continue right here
 *     TclSkipTailcall:  if the NEXT command to be pushed tailcalls, execution
 *         should continue after the CURRENT command is fully returned ("skip
 *         the next command: we are redirecting to it, tailcalls should run
 *         after WE return")
 *     TclPushTailcallPoint: the search for a tailcalling spot cannot traverse
 *         this point. This is special for OO, as some of the oo constructs
 *         that behave like commands may not push an NRCommand callback.
 */

void
TclMarkTailcall(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->deferredCallbacks == NULL) {
	TclNRAddCallback(interp, NRCommand, NULL, NULL,
                NULL, NULL);
        iPtr->deferredCallbacks = TOP_CB(interp);
    }
}

void
TclSkipTailcall(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    TclMarkTailcall(interp);
    iPtr->deferredCallbacks->data[1] = INT2PTR(1);
}

void
TclPushTailcallPoint(
    Tcl_Interp *interp)
{
    TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
    ((Interp *) interp)->numLevels++;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetTailcall --
 *
 *	Splice a tailcall command in the proper spot of the NRE callback
 *	stack, so that it runs at the right time.
 *
 *----------------------------------------------------------------------
 */

void
TclSetTailcall(
    Tcl_Interp *interp,
    Tcl_Obj *listPtr)
{
    /*
     * Find the splicing spot: right before the NRCommand of the thing
     * being tailcalled. Note that we skip NRCommands marked by a 1 in data[1]
     * (used by command redirectors).
     */

    NRE_callback *runPtr;

    for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) {
        if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) {
            break;
        }
    }
    if (!runPtr) {
        Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!");
    }
    runPtr->data[1] = listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRTailcallObjCmd --
 *
 *	Prepare the tailcall as a list and store it in the current
 *	varFrame. When the frame is later popped the tailcall will be spliced
 *	at the proper place.
 *
 * Results:
 *	The first NRCommand callback that is not marked to be skipped is
 *	updated so that its data[1] field contains the tailcall list.
 *
 *----------------------------------------------------------------------
 */

int
TclNRTailcallObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;

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

    if (!(iPtr->varFramePtr->isProcCallFrame & 1)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "tailcall can only be called from a proc, lambda or method", -1));
        Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", NULL);
	return TCL_ERROR;
    }

    /*
     * Invocation without args just clears a scheduled tailcall; invocation
     * with an argument replaces any previously scheduled tailcall.
     */

    if (iPtr->varFramePtr->tailcallPtr) {
        Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr);
        iPtr->varFramePtr->tailcallPtr = NULL;
    }

    /*
     * Create the callback to actually evaluate the tailcalled
     * command, then set it in the varFrame so that PopCallFrame can use it
     * at the proper time.
     */

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

        /*
         * The tailcall data is in a Tcl list: the first element is the
         * namespace, the rest the command to be tailcalled.
         */

        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        listPtr = Tcl_NewListObj(objc, objv);
 	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

        iPtr->varFramePtr->tailcallPtr = listPtr;
    }
    return TCL_RETURN;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRTailcallEval --
 *
 *	This NREcallback actually causes the tailcall to be evaluated.
 *
 *----------------------------------------------------------------------
 */

int
TclNRTailcallEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0], *nsObjPtr;
    Tcl_Namespace *nsPtr;
    int objc;
    Tcl_Obj **objv;

    Tcl_ListObjGetElements(interp, listPtr, &objc, &objv);
    nsObjPtr = objv[0];

    if (result == TCL_OK) {
	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    }

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

	Tcl_DecrRefCount(listPtr);
        return result;
    }

    /*
     * Perform the tailcall
     */

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
    iPtr->lookupNsPtr = (Namespace *) nsPtr;
    return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}

int
TclNRReleaseValues(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    int i = 0;

    while (i < 4) {
	if (data[i]) {
	    Tcl_DecrRefCount((Tcl_Obj *) data[i]);
	} else {
	    break;
	}
	i++;
    }
    return result;
}

void
Tcl_NRAddCallback(
    Tcl_Interp *interp,
    Tcl_NRPostProc *postProcPtr,
    ClientData data0,
    ClientData data1,
    ClientData data2,
    ClientData data3)
{
    if (!(postProcPtr)) {
	Tcl_Panic("Adding a callback without an objProc?!");
    }
    TclNRAddCallback(interp, postProcPtr, data0, data1, data2, data3);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroutineObjCmd -- (and friends)
 *
 *	This object-based function is invoked to process the "coroutine" Tcl
 *	command. It is heavily based on "apply".
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	A new procedure gets created.
 *
 * ** FIRST EXPERIMENTAL IMPLEMENTATION **
 *
 * It is fairly amateurish and not up to our standards - mainly in terms of
 * error messages and [info] interaction. Just to test the infrastructure in
 * teov and tebc.
 *----------------------------------------------------------------------
 */

#define iPtr ((Interp *) interp)

int
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_SetObjResult(interp, Tcl_NewStringObj(
                "yield can only be called in a coroutine", -1));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    if (objc == 2) {
	Tcl_SetObjResult(interp, objv[1]);
    }

    NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
            clientData, NULL, NULL);
    return TCL_OK;
}

int
TclNRYieldToObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    Tcl_Obj *listPtr, *nsObjPtr;
    Tcl_Namespace *nsPtr = TclGetCurrentNamespace(interp);

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

    if (!corPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "yieldto can only be called in a coroutine", -1));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    if (((Namespace *) nsPtr)->flags & NS_DYING) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"yieldto called in deleted namespace", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED",
		NULL);
        return TCL_ERROR;
    }

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

    listPtr = Tcl_NewListObj(objc, objv);
    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
    TclListObjSetElement(interp, listPtr, 0, nsObjPtr);

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;
    TclSetTailcall(interp, listPtr);
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}

static int
RewindCoroutineCallback(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    return Tcl_RestoreInterpState(interp, (Tcl_InterpState)data[0]);
}

static int
RewindCoroutine(
    CoroutineData *corPtr,
    int result)
{
    Tcl_Interp *interp = corPtr->eePtr->interp;
    Tcl_InterpState state = Tcl_SaveInterpState(interp, result);

    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    NRE_ASSERT(corPtr->eePtr != NULL);
    NRE_ASSERT(corPtr->eePtr != iPtr->execEnvPtr);

    corPtr->eePtr->rewind = 1;
    TclNRAddCallback(interp, RewindCoroutineCallback, state,
	    NULL, NULL, NULL);
    return TclNRInterpCoroutine(corPtr, interp, 0, NULL);
}

static void
DeleteCoroutine(
    ClientData clientData)
{
    CoroutineData *corPtr = (CoroutineData *)clientData;
    Tcl_Interp *interp = corPtr->eePtr->interp;
    NRE_callback *rootPtr = TOP_CB(interp);

    if (COR_IS_SUSPENDED(corPtr)) {
	TclNRRunCallbacks(interp, RewindCoroutine(corPtr,TCL_OK), rootPtr);
    }
}

static int
NRCoroutineCallerCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Command *cmdPtr = corPtr->cmdPtr;

    /*
     * This is the last callback in the caller execEnv, right before switching
     * to the coroutine's
     */

    NRE_ASSERT(iPtr->execEnvPtr == corPtr->callerEEPtr);

    if (!corPtr->eePtr) {
	/*
	 * The execEnv was wound down but not deleted for our sake. We finish
	 * the job here. The caller context has already been restored.
	 */

	NRE_ASSERT(iPtr->varFramePtr == corPtr->caller.varFramePtr);
	NRE_ASSERT(iPtr->framePtr == corPtr->caller.framePtr);
	NRE_ASSERT(iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr);
	Tcl_Free(corPtr);
	return result;
    }

    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);

    if (cmdPtr->flags & CMD_DYING) {
	/*
	 * 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.
	 */

	return RewindCoroutine(corPtr, result);
    }

    return result;
}

static int
NRCoroutineExitCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Command *cmdPtr = corPtr->cmdPtr;

    /*
     * This runs at the bottom of the Coroutine's execEnv: it will be executed
     * when the coroutine returns or is wound down, but not when it yields. It
     * deletes the coroutine and restores the caller's environment.
     */

    NRE_ASSERT(interp == corPtr->eePtr->interp);
    NRE_ASSERT(TOP_CB(interp) == NULL);
    NRE_ASSERT(iPtr->execEnvPtr == corPtr->eePtr);
    NRE_ASSERT(!COR_IS_SUSPENDED(corPtr));
    NRE_ASSERT((corPtr->callerEEPtr->callbackPtr->procPtr == NRCoroutineCallerCallback));

    cmdPtr->deleteProc = NULL;
    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
    TclCleanupCommandMacro(cmdPtr);

    corPtr->eePtr->corPtr = NULL;
    TclDeleteExecEnv(corPtr->eePtr);
    corPtr->eePtr = NULL;

    corPtr->stackLevel = NULL;

    /*
     * #280.
     * Drop the coroutine-owned copy of the lineLABCPtr hashtable for literal
     * command arguments in bytecode.
     */

    Tcl_DeleteHashTable(corPtr->lineLABCPtr);
    Tcl_Free(corPtr->lineLABCPtr);
    corPtr->lineLABCPtr = NULL;

    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    iPtr->numLevels++;

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroutineActivateCallback --
 *
 *      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.
 *
 *----------------------------------------------------------------------
 */

int
TclNRCoroutineActivateCallback(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    CoroutineData *corPtr = (CoroutineData *)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_SetObjResult(interp, Tcl_NewStringObj(
                    "cannot yield: C stack busy", -1));
            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;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNREvalList --
 *
 *      Callback to invoke command as list, used in order to delayed
 *	processing of canonical list command in sane environment.
 *
 *----------------------------------------------------------------------
 */

static int
TclNREvalList(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    int objc;
    Tcl_Obj **objv;
    Tcl_Obj *listPtr = (Tcl_Obj *)data[0];

    Tcl_IncrRefCount(listPtr);

    TclMarkTailcall(interp);
    TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * CoroTypeObjCmd --
 *
 *      Implementation of [::tcl::unsupported::corotype] command.
 *
 *----------------------------------------------------------------------
 */

static int
CoroTypeObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr;
    CoroutineData *corPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName");
	return TCL_ERROR;
    }

    /*
     * Look up the coroutine.
     */

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only get coroutine type of a coroutine", -1));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);
        return TCL_ERROR;
    }

    /*
     * An active coroutine is "active". Can't tell what it might do in the
     * future.
     */

    corPtr = (CoroutineData *)cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1));
        return TCL_OK;
    }

    /*
     * Inactive coroutines are classified by the (effective) command used to
     * suspend them, which matters when you're injecting a probe.
     */

    switch (corPtr->nargs) {
    case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1));
        return TCL_OK;
    case COROUTINE_ARGUMENTS_ARBITRARY:
        Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1));
        return TCL_OK;
    default:
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unknown coroutine type", -1));
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", NULL);
        return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd --
 *
 *      Implementation of [coroinject] and [coroprobe] commands.
 *
 *----------------------------------------------------------------------
 */

static inline CoroutineData *
GetCoroutineFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    const char *errMsg)
{
    /*
     * How to get a coroutine from its handle.
     */

    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);

    if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objPtr), NULL);
        return NULL;
    }
    return (CoroutineData *)cmdPtr->objClientData;
}

static int
TclNRCoroInjectObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;

    /*
     * Usage more or less like tailcall:
     *   coroinject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", -1));
        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;
    TclNRAddCallback(interp, InjectHandler, corPtr,
            Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

static int
TclNRCoroProbeObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    int numLevels, unused;
    int *stackLevel = &unused;

    /*
     * Usage more or less like tailcall:
     *   coroprobe coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a probe command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a probe command into a suspended coroutine",
                -1));
        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;
    TclNRAddCallback(interp, InjectHandler, corPtr,
            Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr);
    iPtr->execEnvPtr = savedEEPtr;

    /*
     * Now we immediately transfer control to the coroutine to run our probe.
     * TRICKY STUFF copied from the [yield] implementation.
     *
     * Push the callback to restore the caller's context on yield back.
     */

    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;

    /*
     * Do the actual stack swap.
     */

    SAVE_CONTEXT(corPtr->caller);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    RESTORE_CONTEXT(corPtr->running);
    iPtr->execEnvPtr = corPtr->eePtr;
    iPtr->numLevels += numLevels;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InjectHandler, InjectHandlerPostProc --
 *
 *      Part of the implementation of [coroinject] and [coroprobe]. These are
 *      run inside the context of the coroutine being injected/probed into.
 *
 *      InjectHandler runs a script (possibly adding arguments) in the context
 *      of the coroutine. The script is specified as a one-shot list (with
 *      reference count equal to 1) in data[1]. This function also arranges
 *      for InjectHandlerPostProc to be the part that runs after the script
 *      completes.
 *
 *      InjectHandlerPostProc cleans up after InjectHandler (deleting the
 *      list) and, for the [coroprobe] command *only*, yields back to the
 *      caller context (i.e., where [coroprobe] was run).
 *s
 *----------------------------------------------------------------------
 */

static int
InjectHandler(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int objc;
    Tcl_Obj **objv;

    if (!isProbe) {
        /*
         * If this is [coroinject], add the extra arguments now.
         */

        if (nargs == COROUTINE_ARGUMENTS_SINGLE_OPTIONAL) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yield", -1));
        } else if (nargs == COROUTINE_ARGUMENTS_ARBITRARY) {
            Tcl_ListObjAppendElement(NULL, listPtr,
                    Tcl_NewStringObj("yieldto", -1));
        } else {
            /*
             * I don't think this is reachable...
             */

            Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewIntObj(nargs));
        }
        Tcl_ListObjAppendElement(NULL, listPtr, Tcl_GetObjResult(interp));
    }

    /*
     * Call the user's script; we're in the right place.
     */

    Tcl_IncrRefCount(listPtr);
    TclMarkTailcall(interp);
    TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr,
            INT2PTR(nargs), isProbe);
    TclListObjGetElements(NULL, listPtr, &objc, &objv);
    return TclNREvalObjv(interp, objc, objv, 0, NULL);
}

static int
InjectHandlerPostCall(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = (CoroutineData *)data[0];
    Tcl_Obj *listPtr = (Tcl_Obj *)data[1];
    int nargs = PTR2INT(data[2]);
    ClientData isProbe = data[3];
    int numLevels;

    /*
     * Delete the command words for what we just executed.
     */

    Tcl_DecrRefCount(listPtr);

    /*
     * If we were doing a probe, splice ourselves back out of the stack
     * cleanly here. General injection should instead just look after itself.
     *
     * Code from guts of [yield] implementation.
     */

    if (isProbe) {
        if (result == TCL_ERROR) {
            Tcl_AddErrorInfo(interp,
                    "\n    (injected coroutine probe command)");
        }
        corPtr->nargs = nargs;
        corPtr->stackLevel = NULL;
        numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;
        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * NRInjectObjCmd --
 *
 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

static int
NRInjectObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    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;
    }

    corPtr = GetCoroutineFromObj(interp, objv[1],
            "can only inject a command into a coroutine");
    if (!corPtr) {
        return TCL_ERROR;
    }
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "can only inject a command into a suspended coroutine", -1));
        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;
    TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
	NULL, NULL, NULL);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

int
TclNRInterpCoroutine(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CoroutineData *corPtr = (CoroutineData *)clientData;

    if (!COR_IS_SUSPENDED(corPtr)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "coroutine \"%s\" is already running",
                TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse all the arguments to work out what to feed as the result of the
     * [yield]. TRICKY POINT: objc==0 happens here! It occurs when a coroutine
     * is deleted!
     */

    switch (corPtr->nargs) {
    case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL:
        if (objc == 2) {
            Tcl_SetObjResult(interp, objv[1]);
        } else if (objc > 2) {
            Tcl_WrongNumArgs(interp, 1, objv, "?arg?");
            return TCL_ERROR;
        }
        break;
    default:
        if (corPtr->nargs != objc-1) {
            Tcl_SetObjResult(interp,
                    Tcl_NewStringObj("wrong coro nargs; how did we get here? "
                    "not implemented!", -1));
            Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
            return TCL_ERROR;
        }
        /* fallthrough */
    case COROUTINE_ARGUMENTS_ARBITRARY:
        if (objc > 1) {
            Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1));
        }
        break;
    }

    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroutineObjCmd --
 *
 *      Implementation of [coroutine] command; see documentation for
 *      description of what this does.
 *
 *----------------------------------------------------------------------
 */

int
TclNRCoroutineObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    const char *procName, *simpleName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr,
	*inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
    Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
	return TCL_ERROR;
    }

    procName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, procName, inNsPtr, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": unknown namespace",
                procName));
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", NULL);
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't create procedure \"%s\": bad procedure name",
                procName));
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, NULL);
	return TCL_ERROR;
    }

    /*
     * We ARE creating the coroutine command: allocate the corresponding
     * struct and create the corresponding command.
     */

    corPtr = (CoroutineData *)Tcl_Alloc(sizeof(CoroutineData));

    cmdPtr = (Command *) TclNRCreateCommandInNs(interp, simpleName,
	    (Tcl_Namespace *)nsPtr, /*objProc*/ NULL, TclNRInterpCoroutine,
	    corPtr, DeleteCoroutine);

    corPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;

    /*
     * #280.
     * Provide the new coroutine with its own copy of the lineLABCPtr
     * hashtable for literal command arguments in bytecode. Note that that
     * CFWordBC chains are not duplicated, only the entrypoints to them. This
     * means that in the presence of coroutines each chain is potentially a
     * tree. Like the chain -> tree conversion of the CmdFrame stack.
     */

    {
	Tcl_HashSearch hSearch;
	Tcl_HashEntry *hePtr;

	corPtr->lineLABCPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(corPtr->lineLABCPtr, TCL_ONE_WORD_KEYS);

	for (hePtr = Tcl_FirstHashEntry(iPtr->lineLABCPtr,&hSearch);
		hePtr; hePtr = Tcl_NextHashEntry(&hSearch)) {
	    int isNew;
	    Tcl_HashEntry *newPtr =
		    Tcl_CreateHashEntry(corPtr->lineLABCPtr,
		    Tcl_GetHashKey(iPtr->lineLABCPtr, hePtr),
		    &isNew);

	    Tcl_SetHashValue(newPtr, Tcl_GetHashValue(hePtr));
	}
    }

    /*
     * Create the base context.
     */

    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;

    /*
     * 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);

    /*
     * Ensure that the command is looked up in the correct namespace.
     */

    iPtr->lookupNsPtr = lookupNsPtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc - 2, objv + 2), 0);
    iPtr->numLevels--;

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;

    /*
     * Now just resume the coroutine.
     */

    TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);
    return TCL_OK;
}

/*
 * This is used in the [info] ensemble
 */

int
TclInfoCoroutineCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    if (corPtr && !(corPtr->cmdPtr->flags & CMD_DYING)) {
	Tcl_Obj *namePtr;

	TclNewObj(namePtr);
	Tcl_GetCommandFullName(interp, (Tcl_Command) corPtr->cmdPtr, namePtr);
	Tcl_SetObjResult(interp, namePtr);
    }
    return TCL_OK;
}

#undef iPtr

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to generic/tclBinary.c.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
26


27
28
29
30
31
32
33
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







-
+


-






-
-
+
+







 * 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"
#include "tclTomMath.h"
#include "tommath.h"

#include <math.h>
#include <assert.h>

/*
 * The following constants are used by GetFormatSpec to indicate various
 * special conditions in the parsing of a format specifier.
 */

#define BINARY_ALL ((size_t)-1)		/* Use all elements in the argument. */
#define BINARY_NOCOUNT ((size_t)-2)	/* No count was specified in format. */
#define BINARY_ALL -1		/* Use all elements in the argument. */
#define BINARY_NOCOUNT -2	/* No count was specified in format. */

/*
 * The following flags may be ORed together and returned by GetFormatSpec
 */

#define BINARY_SIGNED 0		/* Field to be read as signed data */
#define BINARY_UNSIGNED 1	/* Field to be read as unsigned data */
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
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







-
-



-
-
-
+
+








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

-
-
-
-
-
-
-
-
-
-
-
-

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



-
+










-
+
-
-
-
-
+

-
+

-
+





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



















+






-
+
+

-

+
+

+
+
+
+
+
+
+
+





-

+








/*
 * Prototypes for local procedures defined in this file:
 */

static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static int		FormatNumber(Tcl_Interp *interp, int type,
			    Tcl_Obj *src, unsigned char **cursorPtr);
static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
static void		FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
static int		GetFormatSpec(const char **formatPtr, char *cmdPtr,
			    size_t *countPtr, int *flagsPtr);
static int		GetFormatSpec(char **formatPtr, char *cmdPtr,
			    int *countPtr, int *flagsPtr);
static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
			    int flags, Tcl_HashTable **numberCachePtr);
static int		SetByteArrayFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		UpdateStringOfByteArray(Tcl_Obj *listPtr);
static void		DeleteScanNumberCache(Tcl_HashTable *numberCachePtr);
static int		NeedReversing(int format);
static void		CopyNumber(const void *from, void *to,
			    size_t length, int type);
			    unsigned int length, int type);
/* Binary ensemble commands */
static int		BinaryFormatCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryScanCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
/* Binary encoding sub-ensemble commands */
static int		BinaryEncodeHex(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryDecodeHex(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryEncode64(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryDecode64(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryEncodeUu(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		BinaryDecodeUu(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);

/*
 * The following tables are used by the binary encoders
 */

static const char HexDigits[16] = {
    '0', '1', '2', '3', '4', '5', '6', '7',
    '8', '9', 'a', 'b', 'c', 'd', 'e', 'f'
};

static const char UueDigits[65] = {
    '`', '!', '"', '#', '$', '%', '&', '\'',
    '(', ')', '*', '+', ',', '-', '.', '/',
    '0', '1', '2', '3', '4', '5', '6', '7',
    '8', '9', ':', ';', '<', '=', '>', '?',
    '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
    'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
    'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
    'X', 'Y', 'Z', '[', '\\',']', '^', '_',
    '`'
};

static const char B64Digits[65] = {
    'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
    'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
    'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
    'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
    'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
    'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
    'w', 'x', 'y', 'z', '0', '1', '2', '3',
    '4', '5', '6', '7', '8', '9', '+', '/',
    '='
};

/*
 * How to construct the ensembles.
 */

 * The following object type represents an array of bytes. An array of bytes
 * is not equivalent to an internationalized string. Conceptually, a string is
 * an array of 16-bit quantities organized as a sequence of properly formed
 * UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
 * Accessor functions are provided to convert a ByteArray to a String or a
 * String to a ByteArray. Two or more consecutive bytes in an array of bytes
 * may look like a single UTF-8 character if the array is casually treated as
 * a string. But obtaining the String from a ByteArray is guaranteed to
 * produced properly formed UTF-8 sequences so that there is a one-to-one map
 * between bytes and characters.
 *
static const EnsembleImplMap binaryMap[] = {
    { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
    { "scan",   BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 },
    { "encode", NULL, NULL, NULL, NULL, 0 },
    { "decode", NULL, NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap encodeMap[] = {
    { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },
    { "base64",   BinaryEncode64,  NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap decodeMap[] = {
    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};

/*
 * Converting a ByteArray to a String proceeds by casting each byte in the
 * array to a 16-bit quantity, treating that number as a Unicode character,
 * and storing the UTF-8 version of that Unicode character in the String. For
 * ByteArrays consisting entirely of values 1..127, the corresponding String
 * representation is the same as the ByteArray representation.
 *
 * Converting a String to a ByteArray proceeds by getting the Unicode
 * representation of each character in the String, casting it to a byte by
 * truncating the upper 8 bits, and then storing the byte in the ByteArray.
 * Converting from ByteArray to String and back to ByteArray is not lossy, but
 * converting an arbitrary String to a ByteArray may be.
 */
 * The following object types represent an array of bytes. The intent is to
 * allow arbitrary binary data to pass through Tcl as a Tcl value without loss
 * or damage. Such values are useful for things like encoded strings or Tk
 * images to name just two.
 *

 * It's strange to have two Tcl_ObjTypes in place for this task when one would
 * do, so a bit of detail and history how we got to this point and where we
 * might go from here.
 *
 * A bytearray is an ordered sequence of bytes. Each byte is an integer value
 * in the range [0-255].  To be a Tcl value type, we need a way to encode each
 * value in the value set as a Tcl string.  The simplest encoding is to
 * represent each byte value as the same codepoint value.  A bytearray of N
 * bytes is encoded into a Tcl string of N characters where the codepoint of
 * each character is the value of corresponding byte.  This approach creates a
 * one-to-one map between all bytearray values and a subset of Tcl string
 * values.
 *
 * When converting a Tcl string value to the bytearray internal rep, the
 * question arises what to do with strings outside that subset?  That is,
 * those Tcl strings containing at least one codepoint greater than 255?  The
 * obviously correct answer is to raise an error!  That string value does not
 * represent any valid bytearray value. Full Stop.  The setFromAnyProc
 * signature has a completion code return value for just this reason, to
 * reject invalid inputs.
 *
 * Unfortunately this was not the path taken by the authors of the original
 * tclByteArrayType.  They chose to accept all Tcl string values as acceptable
 * string encodings of the bytearray values that result from masking away the
 * high bits of any codepoint value at all. This meant that every bytearray
 * value had multiple accepted string representations.
 *
 * The implications of this choice are truly ugly.  When a Tcl value has a
 * string representation, we are required to accept that as the true value.
 * Bytearray values that possess a string representation cannot be processed
 * as bytearrays because we cannot know which true value that bytearray
 * represents.  The consequence is that we drag around an internal rep that we
 * cannot make any use of.  This painful price is extracted at any point after
 * a string rep happens to be generated for the value.  This happens even when
 * the troublesome codepoints outside the byte range never show up.  This
 * happens rather routinely in normal Tcl operations unless we burden the
 * script writer with the cognitive burden of avoiding it.  The price is also
 * paid by callers of the C interface.  The routine
 *
 *	unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
 *
 * has a guarantee to always return a non-NULL value, but that value points to
 * a byte sequence that cannot be used by the caller to process the Tcl value
 * absent some sideband testing that objPtr is "pure".  Tcl offers no public
 * interface to perform this test, so callers either break encapsulation or
 * are unavoidably buggy.  Tcl has defined a public interface that cannot be
 * used correctly. The Tcl source code itself suffers the same problem, and
 * has been buggy, but progressively less so as more and more portions of the
 * code have been retrofitted with the required "purity testing".  The set of
 * values able to pass the purity test can be increased via the introduction
 * of a "canonical" flag marker, but the only way the broken interface itself
 * can be discarded is to start over and define the Tcl_ObjType properly.
 * Bytearrays should simply be usable as bytearrays without a kabuki dance of
 * testing.
 *
 * The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation
 * of bytearrays.  Any Tcl value with the type properByteArrayType can have
 * its bytearray value fetched and used with confidence that acting on that
 * value is equivalent to acting on the true Tcl string value.  This still
 * implies a side testing burden -- past mistakes will not let us avoid that
 * immediately, but it is at least a conventional test of type, and can be
 * implemented entirely by examining the objPtr fields, with no need to query
 * the intrep, as a canonical flag would require.
 *
 * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can be revised
 * to admit the possibility of returning NULL when the true value is not a
 * valid bytearray, we need a mechanism to retain compatibility with the
 * deployed callers of the broken interface.  That's what the retained
 * "tclByteArrayType" provides.  In those unusual circumstances where we
 * convert an invalid bytearray value to a bytearray type, it is to this
 * legacy type.  Essentially any time this legacy type gets used, it's a
 * signal of a bug being ignored.  A TIP should be drafted to remove this
 * connection to the broken past so that Tcl 9 will no longer have any trace
 * of it.  Prescribing a migration path will be the key element of that work.
 * The internal changes now in place are the limit of what can be done short
 * of interface repair.  They provide a great expansion of the histories over
 * which bytearray values can be useful in the meanwhile.
 */

static const Tcl_ObjType properByteArrayType = {
    "bytearray",
    FreeProperByteArrayInternalRep,
    DupProperByteArrayInternalRep,
    UpdateStringOfByteArray,
    NULL
};

const Tcl_ObjType tclByteArrayType = {
Tcl_ObjType tclByteArrayType = {
    "bytearray",
    FreeByteArrayInternalRep,
    DupByteArrayInternalRep,
    NULL,
    UpdateStringOfByteArray,
    SetByteArrayFromAny
};

/*
 * The following structure is the internal rep for a ByteArray object. Keeps
 * track of how much memory has been used and how much has been allocated for
 * the byte array to enable growing and shrinking of the ByteArray object with
 * fewer mallocs.
 */

typedef struct {
typedef struct ByteArray {
    size_t bad;			/* Index of the character that is a nonbyte.
				 * If all characters are bytes, bad = used,
				 * though then we should never read it. */
    size_t used;		/* The number of bytes used in the byte
    int used;			/* The number of bytes used in the byte
				 * array. */
    size_t allocated;		/* The amount of space actually allocated
    int allocated;		/* The amount of space actually allocated
				 * minus 1 byte. */
    unsigned char bytes[TCLFLEXARRAY];	/* The array of bytes. The actual size of this
    unsigned char bytes[4];	/* The array of bytes. The actual size of this
				 * field depends on the 'allocated' field
				 * above. */
} ByteArray;

#define BYTEARRAY_SIZE(len) \
		(offsetof(ByteArray, bytes) + (len))
#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
#define SET_BYTEARRAY(irPtr, baPtr) \
		(irPtr)->twoPtrValue.ptr1 = (baPtr)

		((unsigned) (sizeof(ByteArray) - 4 + (len)))
#define GET_BYTEARRAY(objPtr) \
		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_BYTEARRAY(objPtr, baPtr) \
		(objPtr)->internalRep.twoPtrValue.ptr1 = (VOID *) (baPtr)

int
TclIsPureByteArray(
    Tcl_Obj * objPtr)
{
    return TclHasIntRep(objPtr, &properByteArrayType);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewByteArrayObj --
 *
 *	This procedure is creates a new ByteArray object and initializes it
 *	from the given array of bytes.
 *
 * Results:
 *	The newly create object is returned. This object will have no initial
 *	string representation. The returned object has a ref count of 0.
 *
 * Side effects:
 *	Memory allocated for new object and copy of byte array argument.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewByteArrayObj

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t length)		/* Length of the array of bytes */
    int length)			/* Length of the array of bytes, which must be
				 * >= 0. */
{
#ifdef TCL_MEM_DEBUG
    return Tcl_DbNewByteArrayObj(bytes, length, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    int length)			/* Length of the array of bytes, which must be
				 * >= 0. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    Tcl_SetByteArrayObj(objPtr, bytes, length);
    return objPtr;
#endif /* TCL_MEM_DEBUG */
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbNewByteArrayObj --
 *
 *	This procedure is normally called when debugging: i.e., when
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
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







+




-
+
+











+

+




-
+

-
-
+
+
+
+




-
+







 * Side effects:
 *	Memory allocated for new object and copy of byte array argument.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t length,		/* Length of the array of bytes. */
    int length,			/* Length of the array of bytes, which must be
				 * >= 0. */
    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    Tcl_SetByteArrayObj(objPtr, bytes, length);
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewByteArrayObj(
    const unsigned char *bytes,	/* The array of bytes used to initialize the
				 * new object. */
    size_t length,		/* Length of the array of bytes, which must be
    int length,			/* Length of the array of bytes, which must be
				 * >= 0. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    const char *file,		/* The name of the source file calling this
				 * procedure; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewByteArrayObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */


/*
 *---------------------------------------------------------------------------
 *
 * Tcl_SetByteArrayObj --
 *
 *	Modify an object to be a ByteArray object and to have the specified
 *	array of bytes as its value.
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
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
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







-
-
-
-
+
+
+
+


-




+


-
-
+
+
+
+




-
+

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







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

void
Tcl_SetByteArrayObj(
    Tcl_Obj *objPtr,		/* Object to initialize as a ByteArray. */
    const unsigned char *bytes,	/* The array of bytes to use as the new value.
				 * May be NULL even if length > 0. */
    size_t length)			/* Length of the array of bytes, which must
				 * be >= 0. */
    const unsigned char *bytes,	/* The array of bytes to use as the new
				 * value. */
    int length)			/* Length of the array of bytes, which must be
				 * >= 0. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
    TclInvalidateStringRep(objPtr);

    byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->bad = length;
    if (length < 0) {
	length = 0;
    }
    byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if ((bytes != NULL) && (length > 0)) {
	memcpy(byteArrayPtr->bytes, bytes, length);
	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
    }
    SET_BYTEARRAY(&ir, byteArrayPtr);

    Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetBytesFromObj --
 *
 *	Attempt to extract the value from objPtr in the representation
 *	of a byte sequence. On success return the extracted byte sequence.
 *	On failures, return NULL and record error message and code in
 *	interp (if not NULL).
 *
 * Results:
 *	Pointer to array of bytes, or NULL. representing the ByteArray object.
 *	Writes number of bytes in array to *lengthPtr.
 *
 *----------------------------------------------------------------------
 */

unsigned char *
TclGetBytesFromObj(
    Tcl_Interp *interp,		/* For error reporting */
    Tcl_Obj *objPtr,		/* Value to extract from */
    size_t *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    ByteArray *baPtr;
    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);

    if (irPtr == NULL) {
	SetByteArrayFromAny(NULL, objPtr);
	irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	if (irPtr == NULL) {
	    if (interp) {
		const char *nonbyte;
		int ucs4;

		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
		baPtr = GET_BYTEARRAY(irPtr);
    objPtr->typePtr = &tclByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
		nonbyte = Tcl_UtfAtIndex(Tcl_GetString(objPtr), baPtr->bad);
		TclUtfToUCS4(nonbyte, &ucs4);

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected byte sequence but character %" TCL_Z_MODIFIER "u "
			"was '%1s' (U+%06X)", baPtr->bad, nonbyte, ucs4));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BYTES", NULL);
	    }
	    return NULL;
	}
    }
    baPtr = GET_BYTEARRAY(irPtr);

    if (lengthPtr != NULL) {
	*lengthPtr = baPtr->used;
    }
    return baPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetByteArrayFromObj --
 *
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
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







-
-
-
-
-
+
-

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








unsigned char *
Tcl_GetByteArrayFromObj(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    int *lengthPtr)		/* If non-NULL, filled with length of the
				 * array of bytes in the ByteArray object. */
{
    size_t numBytes = 0;
    unsigned char *bytes = TclGetBytesFromObj(NULL, objPtr, &numBytes);

    if (bytes == NULL) {
	ByteArray *baPtr;
    ByteArray *baPtr;
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);

	assert(irPtr != NULL);

	baPtr = GET_BYTEARRAY(irPtr);
    if (objPtr->typePtr != &tclByteArrayType) {
	SetByteArrayFromAny(NULL, objPtr);
    }
    baPtr = GET_BYTEARRAY(objPtr);
	bytes = baPtr->bytes;
	numBytes = baPtr->used;
    }


    /* Macro TclGetByteArrayFromObj passes NULL for lengthPtr as
     * a trick to get around changing size. */
    if (lengthPtr) {
    if (lengthPtr != NULL) {
	if (numBytes > INT_MAX) {
	    /* Caller asked for an int length, but true length is outside
	     * the int range. This case will be developed out of existence
	     * in Tcl 9. As interim measure, fail. */

	    *lengthPtr = 0;
	*lengthPtr = baPtr->used;
	    return NULL;
	} else {
	    *lengthPtr = (int) numBytes;
	}
    }
    }
    return bytes;
    return (unsigned char *) baPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetByteArrayLength --
 *
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
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







-
+


-




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

-
+
+

-
+


-
-







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

unsigned char *
Tcl_SetByteArrayLength(
    Tcl_Obj *objPtr,		/* The ByteArray object. */
    size_t length)		/* New length for internal byte array. */
    int length)			/* New length for internal byte array. */
{
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep *irPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
    }

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
    if (objPtr->typePtr != &tclByteArrayType) {
	if (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	SetByteArrayFromAny(NULL, objPtr);
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
	}
    }

    }

    byteArrayPtr = GET_BYTEARRAY(irPtr);
    byteArrayPtr = GET_BYTEARRAY(objPtr);
    if (length > byteArrayPtr->allocated) {
	byteArrayPtr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr = (ByteArray *) ckrealloc(
		(char *) byteArrayPtr, BYTEARRAY_SIZE(length));
	byteArrayPtr->allocated = length;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }
    TclInvalidateStringRep(objPtr);
    objPtr->typePtr = &properByteArrayType;
    byteArrayPtr->bad = length;
    byteArrayPtr->used = length;
    return byteArrayPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
616
617
618
619
620
621
622
623

624
625
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
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







-
+


-
-
+
+

-

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

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

-
-
+
+
-

-
-
-
+
-
-
-
+
+

-







 *	A ByteArray object is stored as the internal rep of objPtr.
 *
 *----------------------------------------------------------------------
 */

static int
SetByteArrayFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Obj *objPtr)		/* The object to convert to type ByteArray. */
{
    size_t length, bad;
    const char *src, *srcEnd;
    int length;
    char *src, *srcEnd;
    unsigned char *dst;
    Tcl_UniChar ch = 0;
    ByteArray *byteArrayPtr;
    Tcl_ObjIntRep ir;

    Tcl_UniChar ch;
    if (TclHasIntRep(objPtr, &properByteArrayType)) {
	return TCL_OK;
    }
    if (TclHasIntRep(objPtr, &tclByteArrayType)) {

    if (objPtr->typePtr != &tclByteArrayType) {
	return TCL_OK;
    }

    src = TclGetStringFromObj(objPtr, &length);
	src = TclGetStringFromObj(objPtr, &length);
    bad = length;
    srcEnd = src + length;
	srcEnd = src + length;

    byteArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
    for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	src += TclUtfToUniChar(src, &ch);
	byteArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
	for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
	    src += Tcl_UtfToUniChar(src, &ch);
	if ((bad == length) && (ch > 255)) {
	    bad = dst - byteArrayPtr->bytes;
	}
	*dst++ = UCHAR(ch);
    }
	    *dst++ = (unsigned char) ch;
	}

    SET_BYTEARRAY(&ir, byteArrayPtr);
    byteArrayPtr->allocated = length;
	byteArrayPtr->used = dst - byteArrayPtr->bytes;
	byteArrayPtr->allocated = length;
    byteArrayPtr->used = dst - byteArrayPtr->bytes;

    if (bad == length) {
	byteArrayPtr->bad = byteArrayPtr->used;
	Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
	TclFreeIntRep(objPtr);
    } else {
	byteArrayPtr->bad = bad;
	Tcl_StoreIntRep(objPtr, &tclByteArrayType, &ir);
	objPtr->typePtr = &tclByteArrayType;
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeByteArrayInternalRep --
682
683
684
685
686
687
688
689

690
691

692
693
694
695
696
697
698
699
700
701
702
703
436
437
438
439
440
441
442

443


444





445
446
447
448
449
450
451







-
+
-
-
+
-
-
-
-
-







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

static void
FreeByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType)));
    ckfree((char *) GET_BYTEARRAY(objPtr));
}

    objPtr->typePtr = NULL;
static void
FreeProperByteArrayInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType)));
}

/*
 *----------------------------------------------------------------------
 *
 * DupByteArrayInternalRep --
 *
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
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
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







-
+

-

-
+


-
+
-


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







-
+
+
+







+
+
+









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





+
-
+




+
+
-
-
-
+
+
+
+
+

+
-
+
+

-
-
-



-
+







 */

static void
DupByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    size_t length;
    int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
    srcArrayPtr = GET_BYTEARRAY(srcPtr);
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
    copyArrayPtr = (ByteArray *) ckalloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->bad = srcArrayPtr->bad;
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    SET_BYTEARRAY(copyPtr, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
}


    copyPtr->typePtr = &tclByteArrayType;
static void
DupProperByteArrayInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    unsigned int length;
    ByteArray *srcArrayPtr, *copyArrayPtr;
    Tcl_ObjIntRep ir;

    srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
    length = srcArrayPtr->used;

    copyArrayPtr = (ByteArray *)Tcl_Alloc(BYTEARRAY_SIZE(length));
    copyArrayPtr->bad = length;
    copyArrayPtr->used = length;
    copyArrayPtr->allocated = length;
    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, length);

    SET_BYTEARRAY(&ir, copyArrayPtr);
    Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfByteArray --
 *
 *	Update the string representation for a ByteArray data object.
 *	Update the string representation for a ByteArray data object. Note:
 *	This procedure does not invalidate an existing old string rep so
 *	storage will be lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	ByteArray-to-string conversion.
 *
 *	The object becomes a string object -- the internal rep is discarded
 *	and the typePtr becomes NULL.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfByteArray(
    Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
				 * update. */
{
    int i, length, size;
    unsigned char *src;
    char *dst;
    ByteArray *byteArrayPtr;
    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
    unsigned char *src = byteArrayPtr->bytes;
    size_t i, length = byteArrayPtr->used;

    byteArrayPtr = GET_BYTEARRAY(objPtr);
    src = byteArrayPtr->bytes;
    length = byteArrayPtr->used;
    size_t size = length;

    /*
     * How much space will string rep need?
     */

    size = length;
    for (i = 0; i < length; i++) {
    for (i = 0; i < length && size >= 0; i++) {
	if ((src[i] == 0) || (src[i] > 127)) {
	    size++;
	}
    }
    if (size < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);

    if (size == length) {
	char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);
    }

    dst = (char *) ckalloc((unsigned) (size + 1));
    objPtr->bytes = dst;
    objPtr->length = size;

    if (size == length) {
	TclOOM(dst, size);
	memcpy(dst, src, (size_t) size);
	dst[size] = '\0';
    } else {
	char *dst = Tcl_InitStringRep(objPtr, NULL, size);

	TclOOM(dst, size);
	for (i = 0; i < length; i++) {
	    dst += Tcl_UniCharToUtf(src[i], dst);
	}
	(void) Tcl_InitStringRep(objPtr, NULL, size);
	*dst = '\0';
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclAppendBytesToByteArray --
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477


1478
1479
1480
1481
1482
1483
1484
1485
1486

1487
1488
1489

1490
1491
1492



1493
1494
1495
1496





















































































































1497






1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522



































































































































































































































































































































































1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537














1538
1539
1540


1541
1542
1543
1544



1545
1546
1547
1548
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
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
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
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
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
1820

1821
1822
1823
1824
1825


1826
1827
1828
1829
1830
1831
1832
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
618
619
620

621
622
623


624


625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448

1449
1450
1451
1452

1453
1454
1455
1456

1457
1458


1459
1460
1461

1462
1463


1464
1465
1466
1467


1468
1469
1470
1471
1472
1473
1474
1475
1476







+




-
+


-
+
-




-
+




-
-
+
-
-


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

-
-
+
+









-
+


-
-
+
-
-

+
-
+


-
-
+
-
-
-
-
-
+
+
+


+
-
+


-
-
+
-
-

+
-
+



-
+







-





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











-
-
+
+








-
+


-
+



+
+
+

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

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

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

-
-
+
+

-
-
-
+
+
+

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

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


-
+

-
+


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

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

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

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

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

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

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

-
-
+
+

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

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

-
-
-
+
+
+

-
-
-
-
+
+
+
+
+
+


+
+
+
+
+
+
-
+



-
+



-
+

-
-
+
+

-
+

-
-
+



-
-
+
+







 * Side effects:
 *	Allocates enough memory for an array of bytes of the requested total
 *	size, or possibly larger. [Bug 2992970]
 *
 *----------------------------------------------------------------------
 */

#define TCL_MIN_GROWTH 1024
void
TclAppendBytesToByteArray(
    Tcl_Obj *objPtr,
    const unsigned char *bytes,
    size_t len)
    int len)
{
    ByteArray *byteArrayPtr;
    size_t needed;
    int needed;
    Tcl_ObjIntRep *irPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
    }
    if (len == TCL_INDEX_NONE) {
    if (len < 0) {
	Tcl_Panic("%s must be called with definite number of bytes to append",
		"TclAppendBytesToByteArray");
    }
    if (len == 0) {
	/*
	 * Append zero bytes is a no-op.
	/* Append zero bytes is a no-op. */
	 */

	return;
    }

    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
    if (irPtr == NULL) {
	irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
    if (objPtr->typePtr != &tclByteArrayType) {
	if (irPtr == NULL) {
	    SetByteArrayFromAny(NULL, objPtr);
	SetByteArrayFromAny(NULL, objPtr);
	    irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
	    if (irPtr == NULL) {
		irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
	    }
    }
	}
    }
    byteArrayPtr = GET_BYTEARRAY(irPtr);
    byteArrayPtr = GET_BYTEARRAY(objPtr);

    if (len > UINT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%u bytes) exceeded", UINT_MAX);
    if (len > INT_MAX - byteArrayPtr->used) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }

    needed = byteArrayPtr->used + len;
    /*
     * If we need to, resize the allocated space in the byte array.
     */

    if (needed > byteArrayPtr->allocated) {
	ByteArray *ptr = NULL;
	size_t attempt;
	int attempt;

	if (needed <= INT_MAX/2) {
	    /*
	     * Try to allocate double the total space that is needed.
	    /* Try to allocate double the total space that is needed. */
	     */

	    attempt = 2 * needed;
	    ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
	    ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
		    BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Try to allocate double the increment that is needed (plus).
	    /* Try to allocate double the increment that is needed (plus). */
	     */

	    size_t limit = UINT_MAX - needed;
	    size_t extra = len + TCL_MIN_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;
	    unsigned int limit = INT_MAX - needed;
	    unsigned int extra = len + TCL_MIN_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    attempt = needed + growth;
	    ptr = (ByteArray *) attemptckrealloc((void *) byteArrayPtr,
	    ptr = (ByteArray *)Tcl_AttemptRealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
		    BYTEARRAY_SIZE(attempt));
	}
	if (ptr == NULL) {
	    /*
	     * Last chance: Try to allocate exactly what is needed.
	    /* Last chance: Try to allocate exactly what is needed. */
	     */

	    attempt = needed;
	    ptr = (ByteArray *) ckrealloc((void *)byteArrayPtr,
	    ptr = (ByteArray *)Tcl_Realloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
		    BYTEARRAY_SIZE(attempt));
	}
	byteArrayPtr = ptr;
	byteArrayPtr->allocated = attempt;
	SET_BYTEARRAY(irPtr, byteArrayPtr);
	SET_BYTEARRAY(objPtr, byteArrayPtr);
    }

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
    }
    byteArrayPtr->used += len;
    TclInvalidateStringRep(objPtr);
    objPtr->typePtr = &properByteArrayType;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitBinaryCmd --
 *
 *	This function is called to create the "binary" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A command token for the new command.
 *
 * Side effects:
 *	Creates a new binary command as a mapped ensemble.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitBinaryCmd(
    Tcl_Interp *interp)
{
    Tcl_Command binaryEnsemble;

    binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap);
    TclMakeEnsemble(interp, "binary encode", encodeMap);
    TclMakeEnsemble(interp, "binary decode", decodeMap);
    return binaryEnsemble;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryFormatCmd --
 *
 *	This procedure implements the "binary format" Tcl command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
BinaryFormatCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
    const char *errorValue, *str;
    int offset, size;
    size_t length;

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

    /*
     * To avoid copying the data, we format the string in two passes. The
     * first pass computes the size of the output buffer. The second pass
     * places the formatted data into the buffer.
     */

    format = TclGetString(objv[1]);
    arg = 2;
    offset = 0;
    length = 0;
    while (*format != '\0') {
	str = format;
	flags = 0;
	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
	    break;
	}
	switch (cmd) {
	case 'a':
	case 'A':
	case 'b':
	case 'B':
	case 'h':
	case 'H':
	    /*
	     * For string-type specifiers, the count corresponds to the number
	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		(void)TclGetByteArrayFromObj(objv[arg], &count);
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    arg++;
	    if (cmd == 'a' || cmd == 'A') {
		offset += count;
	    } else if (cmd == 'b' || cmd == 'B') {
		offset += (count + 7) / 8;
	    } else {
		offset += (count + 1) / 2;
	    }
	    break;
	case 'c':
	    size = 1;
	    goto doNumbers;
	case 't':
	case 's':
	case 'S':
	    size = 2;
	    goto doNumbers;
	case 'n':
	case 'i':
	case 'I':
	    size = 4;
	    goto doNumbers;
	case 'm':
	case 'w':
	case 'W':
	    size = 8;
	    goto doNumbers;
	case 'r':
	case 'R':
	case 'f':
	    size = sizeof(float);
	    goto doNumbers;
	case 'q':
	case 'Q':
	case 'd':
	    size = sizeof(double);

	doNumbers:
	    if (arg >= objc) {
		goto badIndex;
	    }

	    /*
	     * For number-type specifiers, the count corresponds to the number
	     * of elements in the list stored in a single argument. If no
	     * count is specified, then the argument is taken as a single
	     * non-list value.
	     */

	    if (count == BINARY_NOCOUNT) {
		arg++;
		count = 1;
	    } else {
		int listc;
		Tcl_Obj **listv;

		/*
		 * The macro evals its args more than once: avoid arg++
		 */

		if (TclListObjGetElements(interp, objv[arg], &listc,
			&listv) != TCL_OK) {
		    return TCL_ERROR;
		}
		arg++;

		if (count == BINARY_ALL) {
		    count = listc;
		} else if (count > (size_t)listc) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "number of elements in list does not match count",
			    -1));
		    return TCL_ERROR;
		}
	    }
	    offset += count*size;
	    break;

	case 'x':
	    if (count == BINARY_ALL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot use \"*\" in format string with \"x\"", -1));
		return TCL_ERROR;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    offset += count;
	    break;
	case 'X':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count > (size_t)offset) || (count == BINARY_ALL)) {
		count = offset;
	    }
	    if (offset > (int)length) {
		length = offset;
	    }
	    offset -= count;
	    break;
	case '@':
	    if (offset > (int)length) {
		length = offset;
	    }
	    if (count == BINARY_ALL) {
		offset = length;
	    } else if (count == BINARY_NOCOUNT) {
		goto badCount;
	    } else {
		offset = count;
	    }
	    break;
	default:
	    errorString = str;
	    goto badField;
	}
    }
    if (offset > (int)length) {
	length = offset;
    }
    if (length == 0) {
	return TCL_OK;
    }

    /*
     * Prepare the result object by preallocating the caclulated number of
     * bytes and filling with nulls.
     */

    TclNewObj(resultPtr);
    buffer = Tcl_SetByteArrayLength(resultPtr, length);
    memset(buffer, 0, length);

    /*
     * Pack the data into the result object. Note that we can skip the error
     * checking during this pass, since we have already parsed the string
     * once.
     */

    arg = 2;
    format = TclGetString(objv[1]);
    cursor = buffer;
    maxPos = cursor;
    while (*format != 0) {
	flags = 0;
	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
	    break;
	}
	if ((count == 0) && (cmd != '@')) {
	    if (cmd != 'x') {
		arg++;
	    }
	    continue;
	}
	switch (cmd) {
	case 'a':
	case 'A': {
	    char pad = (char) (cmd == 'a' ? '\0' : ' ');
	    unsigned char *bytes;

	    bytes = TclGetByteArrayFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if (length >= count) {
		memcpy(cursor, bytes, count);
	    } else {
		memcpy(cursor, bytes, length);
		memset(cursor + length, pad, count - length);
	    }
	    cursor += count;
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *last;

 * Tcl_BinaryObjCmd --
	    str = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 7) / 8);
	    if (count > length) {
		count = length;
	    }
	    value = 0;
	    errorString = "binary";
	    if (cmd == 'B') {
		for (offset = 0; (size_t)offset < count; offset++) {
		    value <<= 1;
		    if (str[offset] == '1') {
			value |= 1;
		    } else if (str[offset] != '0') {
			errorValue = str;
			Tcl_DecrRefCount(resultPtr);
			goto badValue;
		    }
		    if (((offset + 1) % 8) == 0) {
			*cursor++ = UCHAR(value);
			value = 0;
		    }
		}
	    } else {
		for (offset = 0; (size_t)offset < count; offset++) {
		    value >>= 1;
		    if (str[offset] == '1') {
			value |= 128;
		    } else if (str[offset] != '0') {
			errorValue = str;
			Tcl_DecrRefCount(resultPtr);
			goto badValue;
		    }
		    if (!((offset + 1) % 8)) {
			*cursor++ = UCHAR(value);
			value = 0;
		    }
		}
	    }
	    if ((offset % 8) != 0) {
		if (cmd == 'B') {
		    value <<= 8 - (offset % 8);
		} else {
		    value >>= 8 - (offset % 8);
		}
		*cursor++ = UCHAR(value);
	    }
	    while (cursor < last) {
		*cursor++ = '\0';
	    }
	    break;
	}
	case 'h':
	case 'H': {
	    unsigned char *last;
	    int c;

 *
	    str = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 1) / 2);
	    if (count > length) {
		count = length;
	    }
	    value = 0;
	    errorString = "hexadecimal";
	    if (cmd == 'H') {
		for (offset = 0; (size_t)offset < count; offset++) {
		    value <<= 4;
		    if (!isxdigit(UCHAR(str[offset]))) {     /* INTL: digit */
			errorValue = str;
			Tcl_DecrRefCount(resultPtr);
			goto badValue;
		    }
		    c = str[offset] - '0';
		    if (c > 9) {
			c += ('0' - 'A') + 10;
		    }
		    if (c > 16) {
			c += ('A' - 'a');
		    }
		    value |= (c & 0xF);
		    if (offset % 2) {
			*cursor++ = (char) value;
			value = 0;
		    }
		}
	    } else {
		for (offset = 0; (size_t)offset < count; offset++) {
		    value >>= 4;

		    if (!isxdigit(UCHAR(str[offset]))) {     /* INTL: digit */
			errorValue = str;
			Tcl_DecrRefCount(resultPtr);
			goto badValue;
		    }
		    c = str[offset] - '0';
		    if (c > 9) {
			c += ('0' - 'A') + 10;
		    }
		    if (c > 16) {
			c += ('A' - 'a');
		    }
		    value |= ((c << 4) & 0xF0);
		    if (offset % 2) {
			*cursor++ = UCHAR(value & 0xFF);
			value = 0;
		    }
		}
	    }
	    if (offset % 2) {
		if (cmd == 'H') {
		    value <<= 4;
		} else {
		    value >>= 4;
		}
		*cursor++ = UCHAR(value);
	    }

	    while (cursor < last) {
		*cursor++ = '\0';
	    }
	    break;
	}
	case 'c':
	case 't':
	case 's':
	case 'S':
	case 'n':
	case 'i':
	case 'I':
	case 'm':
	case 'w':
	case 'W':
	case 'r':
	case 'R':
	case 'd':
	case 'q':
	case 'Q':
	case 'f': {
	    int listc, i;
	    Tcl_Obj **listv;

	    if (count == BINARY_NOCOUNT) {
		/*
		 * Note that we are casting away the const-ness of objv, but
		 * this is safe since we aren't going to modify the array.
		 */

		listv = (Tcl_Obj **) (objv + arg);
		listc = 1;
		count = 1;
	    } else {
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; (size_t)i < count; i++) {
		if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) {
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	}
	case 'x':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    memset(cursor, 0, count);
	    cursor += count;
	    break;
	case 'X':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count == BINARY_ALL) || (count > (size_t)(cursor - buffer))) {
		cursor = buffer;
	    } else {
		cursor -= count;
	    }
	    break;
	case '@':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_ALL) {
		cursor = maxPos;
	    } else {
		cursor = buffer + count;
	    }
	    break;
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;

 badValue:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected %s string but got \"%s\" instead",
	    errorString, errorValue));
    return TCL_ERROR;

 badCount:
    errorString = "missing count for \"@\" field specifier";
    goto error;

 badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
    {
	Tcl_UniChar ch = 0;
	char buf[5] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

 error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryScanCmd --
 *
 *	This procedure implements the "binary scan" Tcl command.
 *	This procedure implements the "binary" Tcl command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
BinaryScanCmd(
    TCL_UNUSED(ClientData),
Tcl_BinaryObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    size_t count;			/* Count associated with current format
    int count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
    char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *resultPtr = NULL;	/* Object holding result buffer. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
    const char *str;
    int offset, size, i;
    size_t length = 0;
    char *errorValue, *str;
    int offset, size, length, index;
    static const char *options[] = {
	"format",	"scan",		NULL
    };
    enum options {
	BINARY_FORMAT,	BINARY_SCAN
    };

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

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
	    &index) != TCL_OK) {
    	return TCL_ERROR;
    }

    switch ((enum options) index) {
    case BINARY_FORMAT:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "formatString ?arg arg ...?");
	    return TCL_ERROR;
	}

	/*
	 * To avoid copying the data, we format the string in two passes. The
	 * first pass computes the size of the output buffer. The second pass
	 * places the formatted data into the buffer.
	 */

	format = TclGetString(objv[2]);
	arg = 3;
	offset = 0;
	length = 0;
	while (*format != '\0') {
	    str = format;
	    flags = 0;
	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
		break;
	    }
	    switch (cmd) {
	    case 'a':
	    case 'A':
	    case 'b':
	    case 'B':
	    case 'h':
	    case 'H':
		/*
		 * For string-type specifiers, the count corresponds to the
		 * number of bytes in a single argument.
		 */

		if (arg >= objc) {
		    goto badIndex;
		}
		if (count == BINARY_ALL) {
		    Tcl_GetByteArrayFromObj(objv[arg], &count);
		} else if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		arg++;
		if (cmd == 'a' || cmd == 'A') {
		    offset += count;
		} else if (cmd == 'b' || cmd == 'B') {
		    offset += (count + 7) / 8;
		} else {
		    offset += (count + 1) / 2;
		}
		break;
	    case 'c':
		size = 1;
		goto doNumbers;
	    case 't':
	    case 's':
	    case 'S':
		size = 2;
		goto doNumbers;
	    case 'n':
	    case 'i':
	    case 'I':
		size = 4;
		goto doNumbers;
	    case 'm':
	    case 'w':
	    case 'W':
		size = 8;
		goto doNumbers;
	    case 'r':
	    case 'R':
	    case 'f':
		size = sizeof(float);
		goto doNumbers;
	    case 'q':
	    case 'Q':
	    case 'd':
		size = sizeof(double);

	    doNumbers:
		if (arg >= objc) {
		    goto badIndex;
		}

		/*
		 * For number-type specifiers, the count corresponds to the
		 * number of elements in the list stored in a single argument.
		 * If no count is specified, then the argument is taken as a
		 * single non-list value.
		 */

		if (count == BINARY_NOCOUNT) {
		    arg++;
		    count = 1;
		} else {
		    int listc;
		    Tcl_Obj **listv;

		    /* The macro evals its args more than once: avoid arg++ */		    
		    if (TclListObjGetElements(interp, objv[arg], &listc,
			    &listv) != TCL_OK) {
			return TCL_ERROR;
		    }
		    arg++;
    Tcl_Obj *valuePtr, *elementPtr;
    Tcl_HashTable numberCacheHash;
    Tcl_HashTable *numberCachePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"value formatString ?varName ...?");
	return TCL_ERROR;
    }
    numberCachePtr = &numberCacheHash;
    Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
    buffer = TclGetByteArrayFromObj(objv[1], &length);
    format = TclGetString(objv[2]);
    arg = 3;
    offset = 0;
    while (*format != '\0') {
	str = format;
	flags = 0;
	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
	    goto done;
	}
	switch (cmd) {
	case 'a':
	case 'A': {
	    unsigned char *src;
		    
		    if (count == BINARY_ALL) {
			count = listc;
		    } else if (count > listc) {
			Tcl_AppendResult(interp,
				"number of elements in list does not match count",
				NULL);
			return TCL_ERROR;
		    }
		}
		offset += count*size;
		break;

	    case 'x':
		if (count == BINARY_ALL) {
		    Tcl_AppendResult(interp,
			    "cannot use \"*\" in format string with \"x\"",
			    NULL);
		    return TCL_ERROR;
		} else if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		offset += count;
		break;
	    case 'X':
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if ((count > offset) || (count == BINARY_ALL)) {
		    count = offset;
		}
		if (offset > length) {
		    length = offset;
		}
		offset -= count;
		break;
	    case '@':
		if (offset > length) {
		    length = offset;
		}
		if (count == BINARY_ALL) {
		    offset = length;
		} else if (count == BINARY_NOCOUNT) {
		    goto badCount;
		} else {
		    offset = count;
		}
		break;
	    default:
		errorString = str;
		goto badField;
	    }
	}
	if (offset > length) {
	    length = offset;
	}
	if (length == 0) {
	    return TCL_OK;
	}

	/*
	 * Prepare the result object by preallocating the caclulated number of
	 * bytes and filling with nulls.
	 */

	resultPtr = Tcl_NewObj();
	buffer = Tcl_SetByteArrayLength(resultPtr, length);
	memset(buffer, 0, (size_t) length);

	/*
	 * Pack the data into the result object. Note that we can skip the
	 * error checking during this pass, since we have already parsed the
	 * string once.
	 */

	arg = 3;
	format = TclGetString(objv[2]);
	cursor = buffer;
	maxPos = cursor;
	while (*format != 0) {
	    flags = 0;
	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
		break;
	    }
	    if ((count == 0) && (cmd != '@')) {
		if (cmd != 'x') {
		    arg++;
		}
		continue;
	    }
	    switch (cmd) {
	    case 'a':
	    case 'A': {
		char pad = (char) (cmd == 'a' ? '\0' : ' ');
		unsigned char *bytes;

		bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);

		if (count == BINARY_ALL) {
		    count = length;
		} else if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if (length >= count) {
		    memcpy(cursor, bytes, (size_t) count);
		} else {
		    memcpy(cursor, bytes, (size_t) length);
		    memset(cursor + length, pad, (size_t) (count - length));
		}
		cursor += count;
		break;
	    }
	    case 'b':
	    case 'B': {
		unsigned char *last;

		str = TclGetStringFromObj(objv[arg], &length);
		arg++;
		if (count == BINARY_ALL) {
		    count = length;
		} else if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		last = cursor + ((count + 7) / 8);
		if (count > length) {
		    count = length;
		}
		value = 0;
		errorString = "binary";
		if (cmd == 'B') {
		    for (offset = 0; offset < count; offset++) {
			value <<= 1;
			if (str[offset] == '1') {
			    value |= 1;
			} else if (str[offset] != '0') {
			    errorValue = str;
			    Tcl_DecrRefCount(resultPtr);
			    goto badValue;
			}
			if (((offset + 1) % 8) == 0) {
			    *cursor++ = (unsigned char) value;
			    value = 0;
			}
		    }
		} else {
		    for (offset = 0; offset < count; offset++) {
			value >>= 1;
			if (str[offset] == '1') {
			    value |= 128;
			} else if (str[offset] != '0') {
			    errorValue = str;
			    Tcl_DecrRefCount(resultPtr);
			    goto badValue;
			}
			if (!((offset + 1) % 8)) {
			    *cursor++ = (unsigned char) value;
			    value = 0;
			}
		    }
		}
		if ((offset % 8) != 0) {
		    if (cmd == 'B') {
			value <<= 8 - (offset % 8);
		    } else {
			value >>= 8 - (offset % 8);
		    }
		    *cursor++ = (unsigned char) value;
		}
		while (cursor < last) {
		    *cursor++ = '\0';
		}
		break;
	    }
	    case 'h':
	    case 'H': {
		unsigned char *last;
		int c;

		str = TclGetStringFromObj(objv[arg], &length);
		arg++;
		if (count == BINARY_ALL) {
		    count = length;
		} else if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		last = cursor + ((count + 1) / 2);
		if (count > length) {
		    count = length;
		}
		value = 0;
		errorString = "hexadecimal";
		if (cmd == 'H') {
		    for (offset = 0; offset < count; offset++) {
			value <<= 4;
			if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
			    errorValue = str;
			    Tcl_DecrRefCount(resultPtr);
			    goto badValue;
			}
			c = str[offset] - '0';
			if (c > 9) {
			    c += ('0' - 'A') + 10;
			}
			if (c > 16) {
			    c += ('A' - 'a');
			}
			value |= (c & 0xf);
			if (offset % 2) {
			    *cursor++ = (char) value;
			    value = 0;
			}
		    }
		} else {
		    for (offset = 0; offset < count; offset++) {
			value >>= 4;

			if (!isxdigit(UCHAR(str[offset]))) { /* INTL: digit */
			    errorValue = str;
			    Tcl_DecrRefCount(resultPtr);
			    goto badValue;
			}
			c = str[offset] - '0';
			if (c > 9) {
			    c += ('0' - 'A') + 10;
			}
			if (c > 16) {
			    c += ('A' - 'a');
			}
			value |= ((c << 4) & 0xf0);
			if (offset % 2) {
			    *cursor++ = (unsigned char)(value & 0xff);
			    value = 0;
			}
		    }
		}
		if (offset % 2) {
		    if (cmd == 'H') {
			value <<= 4;
		    } else {
			value >>= 4;
		    }
		    *cursor++ = (unsigned char) value;
		}

		while (cursor < last) {
		    *cursor++ = '\0';
		}
		break;
	    }
	    case 'c':
	    case 't':
	    case 's':
	    case 'S':
	    case 'n':
	    case 'i':
	    case 'I':
	    case 'm':
	    case 'w':
	    case 'W':
	    case 'r':
	    case 'R':
	    case 'd':
	    case 'q':
	    case 'Q':
	    case 'f': {
		int listc, i;
		Tcl_Obj **listv;

		if (count == BINARY_NOCOUNT) {
		    /*
		     * Note that we are casting away the const-ness of objv,
		     * but this is safe since we aren't going to modify the
		     * array.
		     */

		    listv = (Tcl_Obj**)(objv + arg);
		    listc = 1;
		    count = 1;
		} else {
		    TclListObjGetElements(interp, objv[arg], &listc, &listv);
		    if (count == BINARY_ALL) {
			count = listc;
		    }
		}
		arg++;
		for (i = 0; i < count; i++) {
		    if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) {
			Tcl_DecrRefCount(resultPtr);
			return TCL_ERROR;
		    }
		}
		break;
	    }
	    case 'x':
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		memset(cursor, 0, (size_t) count);
		cursor += count;
		break;
	    case 'X':
		if (cursor > maxPos) {
		    maxPos = cursor;
		}
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if ((count == BINARY_ALL) || (count > (cursor - buffer))) {
		    cursor = buffer;
		} else {
		    cursor -= count;
		}
		break;
	    case '@':
		if (cursor > maxPos) {
		    maxPos = cursor;
		}
		if (count == BINARY_ALL) {
		    cursor = maxPos;
		} else {
		    cursor = buffer + count;
		}
		break;
	    }
	}
	Tcl_SetObjResult(interp, resultPtr);
	break;
    case BINARY_SCAN: {
	int i;
	Tcl_Obj *valuePtr, *elementPtr;
	Tcl_HashTable numberCacheHash;
	Tcl_HashTable *numberCachePtr;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "value formatString ?varName varName ...?");
	    return TCL_ERROR;
	}
	numberCachePtr = &numberCacheHash;
	Tcl_InitHashTable(numberCachePtr, TCL_ONE_WORD_KEYS);
	buffer = Tcl_GetByteArrayFromObj(objv[2], &length);
	format = TclGetString(objv[3]);
	cursor = buffer;
	arg = 4;
	offset = 0;
	while (*format != '\0') {
	    str = format;
	    flags = 0;
	    if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
		goto done;
	    }
	    switch (cmd) {
	    case 'a':
	    case 'A': {
		unsigned char *src;

	    if (arg >= objc) {
		DeleteScanNumberCache(numberCachePtr);
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		count = length - offset;
	    } else {
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if (count > length - offset) {
		    goto done;
		}
	    }
		if (arg >= objc) {
		    DeleteScanNumberCache(numberCachePtr);
		    goto badIndex;
		}
		if (count == BINARY_ALL) {
		    count = length - offset;
		} else {
		    if (count == BINARY_NOCOUNT) {
			count = 1;
		    }
		    if (count > (length - offset)) {
			goto done;
		    }
		}

	    src = buffer + offset;
	    size = count;
		src = buffer + offset;
		size = count;

	    /*
	     * Trim trailing nulls and spaces, if necessary.
	     */
		/*
		 * Trim trailing nulls and spaces, if necessary.
		 */

	    if (cmd == 'A') {
		while (size > 0) {
		    if (src[size - 1] != '\0' && src[size - 1] != ' ') {
			break;
		    }
		    size--;
		}
	    }
		if (cmd == 'A') {
		    while (size > 0) {
			if (src[size-1] != '\0' && src[size-1] != ' ') {
			    break;
			}
			size--;
		    }
		}

	    /*
	     * Have to do this #ifdef-fery because (as part of defining
	     * Tcl_NewByteArrayObj) we removed the #def that hides this stuff
	     * normally. If this code ever gets copied to another file, it
	     * should be changed back to the simpler version.
	     */
		/*
		 * Have to do this #ifdef-fery because (as part of defining
		 * Tcl_NewByteArrayObj) we removed the #def that hides this
		 * stuff normally. If this code ever gets copied to another
		 * file, it should be changed back to the simpler version.
		 */

#ifdef TCL_MEM_DEBUG
	    valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__, __LINE__);
		valuePtr = Tcl_DbNewByteArrayObj(src, size, __FILE__,__LINE__);
#else
	    valuePtr = Tcl_NewByteArrayObj(src, size);
		valuePtr = Tcl_NewByteArrayObj(src, size);
#endif /* TCL_MEM_DEBUG */

	    resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
		    TCL_LEAVE_ERR_MSG);
	    arg++;
	    if (resultPtr == NULL) {
		DeleteScanNumberCache(numberCachePtr);
		return TCL_ERROR;
	    }
	    offset += count;
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *src;
	    char *dest;
		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    return TCL_ERROR;
		}
		offset += count;
		break;
	    }
	    case 'b':
	    case 'B': {
		unsigned char *src;
		char *dest;

	    if (arg >= objc) {
		DeleteScanNumberCache(numberCachePtr);
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		count = (length - offset) * 8;
	    } else {
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if (count > (size_t)(length - offset) * 8) {
		    goto done;
		}
	    }
	    src = buffer + offset;
	    TclNewObj(valuePtr);
	    Tcl_SetObjLength(valuePtr, count);
	    dest = TclGetString(valuePtr);
		if (arg >= objc) {
		    DeleteScanNumberCache(numberCachePtr);
		    goto badIndex;
		}
		if (count == BINARY_ALL) {
		    count = (length - offset) * 8;
		} else {
		    if (count == BINARY_NOCOUNT) {
			count = 1;
		    }
		    if (count > (length - offset) * 8) {
			goto done;
		    }
		}
		src = buffer + offset;
		valuePtr = Tcl_NewObj();
		Tcl_SetObjLength(valuePtr, count);
		dest = TclGetString(valuePtr);

	    if (cmd == 'b') {
		for (i = 0; (size_t)i < count; i++) {
		    if (i % 8) {
			value >>= 1;
		    } else {
			value = *src++;
		    }
		    *dest++ = (char) ((value & 1) ? '1' : '0');
		}
	    } else {
		for (i = 0; (size_t)i < count; i++) {
		    if (i % 8) {
			value <<= 1;
		    } else {
			value = *src++;
		    }
		    *dest++ = (char) ((value & 0x80) ? '1' : '0');
		}
	    }
		if (cmd == 'b') {
		    for (i = 0; i < count; i++) {
			if (i % 8) {
			    value >>= 1;
			} else {
			    value = *src++;
			}
			*dest++ = (char) ((value & 1) ? '1' : '0');
		    }
		} else {
		    for (i = 0; i < count; i++) {
			if (i % 8) {
			    value <<= 1;
			} else {
			    value = *src++;
			}
			*dest++ = (char) ((value & 0x80) ? '1' : '0');
		    }
		}

	    resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
		    TCL_LEAVE_ERR_MSG);
	    arg++;
	    if (resultPtr == NULL) {
		DeleteScanNumberCache(numberCachePtr);
		return TCL_ERROR;
	    }
	    offset += (count + 7) / 8;
	    break;
	}
	case 'h':
	case 'H': {
	    char *dest;
	    unsigned char *src;
	    static const char hexdigit[] = "0123456789abcdef";
		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    return TCL_ERROR;
		}
		offset += (count + 7) / 8;
		break;
	    }
	    case 'h':
	    case 'H': {
		char *dest;
		unsigned char *src;
		int i;
		static const char hexdigit[] = "0123456789abcdef";

	    if (arg >= objc) {
		DeleteScanNumberCache(numberCachePtr);
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		count = (length - offset)*2;
	    } else {
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if (count > (length - offset)*2) {
		    goto done;
		}
	    }
	    src = buffer + offset;
	    TclNewObj(valuePtr);
	    Tcl_SetObjLength(valuePtr, count);
	    dest = TclGetString(valuePtr);
		if (arg >= objc) {
		    DeleteScanNumberCache(numberCachePtr);
		    goto badIndex;
		}
		if (count == BINARY_ALL) {
		    count = (length - offset)*2;
		} else {
		    if (count == BINARY_NOCOUNT) {
			count = 1;
		    }
		    if (count > (length - offset)*2) {
			goto done;
		    }
		}
		src = buffer + offset;
		valuePtr = Tcl_NewObj();
		Tcl_SetObjLength(valuePtr, count);
		dest = TclGetString(valuePtr);

	    if (cmd == 'h') {
		for (i = 0; (size_t)i < count; i++) {
		    if (i % 2) {
			value >>= 4;
		    } else {
			value = *src++;
		    }
		    *dest++ = hexdigit[value & 0xF];
		}
	    } else {
		for (i = 0; (size_t)i < count; i++) {
		    if (i % 2) {
			value <<= 4;
		    } else {
			value = *src++;
		    }
		    *dest++ = hexdigit[(value >> 4) & 0xF];
		}
	    }
		if (cmd == 'h') {
		    for (i = 0; i < count; i++) {
			if (i % 2) {
			    value >>= 4;
			} else {
			    value = *src++;
			}
			*dest++ = hexdigit[value & 0xf];
		    }
		} else {
		    for (i = 0; i < count; i++) {
			if (i % 2) {
			    value <<= 4;
			} else {
			    value = *src++;
			}
			*dest++ = hexdigit[(value >> 4) & 0xf];
		    }
		}

	    resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
		    TCL_LEAVE_ERR_MSG);
	    arg++;
	    if (resultPtr == NULL) {
		DeleteScanNumberCache(numberCachePtr);
		return TCL_ERROR;
	    }
	    offset += (count + 1) / 2;
	    break;
	}
	case 'c':
	    size = 1;
	    goto scanNumber;
	case 't':
	case 's':
	case 'S':
	    size = 2;
	    goto scanNumber;
	case 'n':
	case 'i':
	case 'I':
	    size = 4;
	    goto scanNumber;
	case 'm':
	case 'w':
	case 'W':
	    size = 8;
	    goto scanNumber;
	case 'r':
	case 'R':
	case 'f':
	    size = sizeof(float);
	    goto scanNumber;
	case 'q':
	case 'Q':
	case 'd': {
	    unsigned char *src;
		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    return TCL_ERROR;
		}
		offset += (count + 1) / 2;
		break;
	    }
	    case 'c':
		size = 1;
		goto scanNumber;
	    case 't':
	    case 's':
	    case 'S':
		size = 2;
		goto scanNumber;
	    case 'n':
	    case 'i':
	    case 'I':
		size = 4;
		goto scanNumber;
	    case 'm':
	    case 'w':
	    case 'W':
		size = 8;
		goto scanNumber;
	    case 'r':
	    case 'R':
	    case 'f':
		size = sizeof(float);
		goto scanNumber;
	    case 'q':
	    case 'Q':
	    case 'd': {
		unsigned char *src;

	    size = sizeof(double);
	    /* fall through */
		size = sizeof(double);
		/* fall through */

	scanNumber:
	    if (arg >= objc) {
		DeleteScanNumberCache(numberCachePtr);
		goto badIndex;
	    }
	    if (count == BINARY_NOCOUNT) {
		if ((length - offset) < (size_t)size) {
		    goto done;
		}
		valuePtr = ScanNumber(buffer+offset, cmd, flags,
			&numberCachePtr);
		offset += size;
	    } else {
		if (count == BINARY_ALL) {
		    count = (length - offset) / size;
		}
		if ((length - offset) < (count * size)) {
		    goto done;
		}
		TclNewObj(valuePtr);
		src = buffer + offset;
		for (i = 0; (size_t)i < count; i++) {
		    elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr);
		    src += size;
		    Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
		}
		offset += count * size;
	    }
	    scanNumber:
		if (arg >= objc) {
		    DeleteScanNumberCache(numberCachePtr);
		    goto badIndex;
		}
		if (count == BINARY_NOCOUNT) {
		    if ((length - offset) < size) {
			goto done;
		    }
		    valuePtr = ScanNumber(buffer+offset, cmd, flags,
			    &numberCachePtr);
		    offset += size;
		} else {
		    if (count == BINARY_ALL) {
			count = (length - offset) / size;
		    }
		    if ((length - offset) < (count * size)) {
			goto done;
		    }
		    valuePtr = Tcl_NewObj();
		    src = buffer+offset;
		    for (i = 0; i < count; i++) {
			elementPtr = ScanNumber(src, cmd, flags,
				&numberCachePtr);
			src += size;
			Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
		    }
		    offset += count*size;
		}

	    resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
		    TCL_LEAVE_ERR_MSG);
	    arg++;
	    if (resultPtr == NULL) {
		DeleteScanNumberCache(numberCachePtr);
		return TCL_ERROR;
	    }
	    break;
	}
	case 'x':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count == BINARY_ALL) || (count > length - offset)) {
		offset = length;
	    } else {
		offset += count;
	    }
	    break;
	case 'X':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count == BINARY_ALL) || (count > (size_t)offset)) {
		offset = 0;
	    } else {
		offset -= count;
	    }
	    break;
	case '@':
	    if (count == BINARY_NOCOUNT) {
		DeleteScanNumberCache(numberCachePtr);
		goto badCount;
	    }
	    if ((count == BINARY_ALL) || (count > length)) {
		offset = length;
	    } else {
		offset = count;
	    }
	    break;
	default:
	    DeleteScanNumberCache(numberCachePtr);
	    errorString = str;
	    goto badField;
	}
    }
		resultPtr = Tcl_ObjSetVar2(interp, objv[arg], NULL, valuePtr,
			TCL_LEAVE_ERR_MSG);
		arg++;
		if (resultPtr == NULL) {
		    DeleteScanNumberCache(numberCachePtr);
		    return TCL_ERROR;
		}
		break;
	    }
	    case 'x':
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if ((count == BINARY_ALL) || (count > (length - offset))) {
		    offset = length;
		} else {
		    offset += count;
		}
		break;
	    case 'X':
		if (count == BINARY_NOCOUNT) {
		    count = 1;
		}
		if ((count == BINARY_ALL) || (count > offset)) {
		    offset = 0;
		} else {
		    offset -= count;
		}
		break;
	    case '@':
		if (count == BINARY_NOCOUNT) {
		    DeleteScanNumberCache(numberCachePtr);
		    goto badCount;
		}
		if ((count == BINARY_ALL) || (count > length)) {
		    offset = length;
		} else {
		    offset = count;
		}
		break;
	    default:
		DeleteScanNumberCache(numberCachePtr);
		errorString = str;
		goto badField;
	    }
	}

    /*
     * Set the result to the last position of the cursor.
     */
	/*
	 * Set the result to the last position of the cursor.
	 */

 done:
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(arg - 3));
    DeleteScanNumberCache(numberCachePtr);

    done:
	Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 4));
	DeleteScanNumberCache(numberCachePtr);
	break;
    }
    }
    return TCL_OK;

  badValue:
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "expected ", errorString,
	    " string but got \"", errorValue, "\" instead", NULL);
    return TCL_ERROR;

 badCount:
  badCount:
    errorString = "missing count for \"@\" field specifier";
    goto error;

 badIndex:
  badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
  badField:
    {
	Tcl_UniChar ch = 0;
	char buf[5] = "";
	Tcl_UniChar ch;
	char buf[TCL_UTF_MAX + 1];

	TclUtfToUniChar(errorString, &ch);
	Tcl_UtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	Tcl_AppendResult(interp, "bad field specifier \"", buf, "\"", NULL);
	return TCL_ERROR;
    }

 error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
  error:
    Tcl_AppendResult(interp, errorString, NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * GetFormatSpec --
1845
1846
1847
1848
1849
1850
1851
1852

1853
1854

1855
1856
1857
1858
1859
1860
1861
1489
1490
1491
1492
1493
1494
1495

1496
1497

1498
1499
1500
1501
1502
1503
1504
1505







-
+

-
+







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

static int
GetFormatSpec(
    const char **formatPtr,	/* Pointer to format string. */
    char **formatPtr,		/* Pointer to format string. */
    char *cmdPtr,		/* Pointer to location of command char. */
    size_t *countPtr,		/* Pointer to repeat count value. */
    int *countPtr,		/* Pointer to repeat count value. */
    int *flagsPtr)		/* Pointer to field flags */
{
    /*
     * Skip any leading blanks.
     */

    while (**formatPtr == ' ') {
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
1518
1519
1520
1521
1522
1523
1524

1525
1526
1527
1528

1529
1530
1531
1532
1533

1534
1535

1536
1537

1538
1539
1540

1541
1542
1543
1544
1545
1546
1547
1548







-
+



-
+




-
+

-
+

-
+


-
+







     * Extract the command character and any trailing digits or '*'.
     */

    *cmdPtr = **formatPtr;
    (*formatPtr)++;
    if (**formatPtr == 'u') {
	(*formatPtr)++;
	*flagsPtr |= BINARY_UNSIGNED;
	(*flagsPtr) |= BINARY_UNSIGNED;
    }
    if (**formatPtr == '*') {
	(*formatPtr)++;
	*countPtr = BINARY_ALL;
	(*countPtr) = BINARY_ALL;
    } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
	unsigned long int count;

	errno = 0;
	count = strtoul(*formatPtr, (char **) formatPtr, 10);
	count = strtoul(*formatPtr, formatPtr, 10);
	if (errno || (count > (unsigned long) INT_MAX)) {
	    *countPtr = INT_MAX;
	    (*countPtr) = INT_MAX;
	} else {
	    *countPtr = (int) count;
	    (*countPtr) = (int) count;
	}
    } else {
	*countPtr = BINARY_NOCOUNT;
	(*countPtr) = BINARY_NOCOUNT;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
2013
2014
2015
2016
2017
2018
2019
2020

2021
2022
2023
2024

2025
2026
2027
2028
2029


2030
2031
2032
2033
2034
2035
2036
1657
1658
1659
1660
1661
1662
1663

1664
1665
1666
1667

1668
1669
1670
1671


1672
1673
1674
1675
1676
1677
1678
1679
1680







-
+



-
+



-
-
+
+







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

static void
CopyNumber(
    const void *from,		/* source */
    void *to,			/* destination */
    size_t length,		/* Number of bytes to copy */
    unsigned int length,	/* Number of bytes to copy */
    int type)			/* What type of thing are we copying? */
{
    switch (NeedReversing(type)) {
    case 0:
    case 0: 
	memcpy(to, from, length);
	break;
    case 1: {
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;
	const unsigned char *fromPtr = from;
	unsigned char *toPtr = to;

	switch (length) {
	case 4:
	    toPtr[0] = fromPtr[3];
	    toPtr[1] = fromPtr[2];
	    toPtr[2] = fromPtr[1];
	    toPtr[3] = fromPtr[0];
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
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







-
-
+
+












-
-
+
+







	    toPtr[6] = fromPtr[1];
	    toPtr[7] = fromPtr[0];
	    break;
	}
	break;
    }
    case 2: {
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;
	const unsigned char *fromPtr = from;
	unsigned char *toPtr = to;

	toPtr[0] = fromPtr[4];
	toPtr[1] = fromPtr[5];
	toPtr[2] = fromPtr[6];
	toPtr[3] = fromPtr[7];
	toPtr[4] = fromPtr[0];
	toPtr[5] = fromPtr[1];
	toPtr[6] = fromPtr[2];
	toPtr[7] = fromPtr[3];
	break;
    }
    case 3: {
	const unsigned char *fromPtr = (const unsigned char *)from;
	unsigned char *toPtr = (unsigned char *)to;
	const unsigned char *fromPtr = from;
	unsigned char *toPtr = to;

	toPtr[0] = fromPtr[3];
	toPtr[1] = fromPtr[2];
	toPtr[2] = fromPtr[1];
	toPtr[3] = fromPtr[0];
	toPtr[4] = fromPtr[7];
	toPtr[5] = fromPtr[6];
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
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


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
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







+















-
+
-


-
+















-
-
+
-


-
+








-
+














-
+



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

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









-
+



-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+









-
+



-
-
+
+

-
-
+
+







-
+


-
+







FormatNumber(
    Tcl_Interp *interp,		/* Current interpreter, used to report
				 * errors. */
    int type,			/* Type of number to format. */
    Tcl_Obj *src,		/* Number to format. */
    unsigned char **cursorPtr)	/* Pointer to index into destination buffer. */
{
    long value;
    double dvalue;
    Tcl_WideInt wvalue;
    float fvalue;

    switch (type) {
    case 'd':
    case 'q':
    case 'Q':
	/*
	 * Double-precision floating point values. Tcl_GetDoubleFromObj
	 * returns TCL_ERROR for NaN, but we can check by comparing the
	 * object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType);
	    if (src->typePtr != &tclDoubleType) {
	    if (irPtr == NULL) {
		return TCL_ERROR;
	    }
	    dvalue = irPtr->doubleValue;
	    dvalue = src->internalRep.doubleValue;
	}
	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
	*cursorPtr += sizeof(double);
	return TCL_OK;

    case 'f':
    case 'r':
    case 'R':
	/*
	 * Single-precision floating point values. Tcl_GetDoubleFromObj
	 * returns TCL_ERROR for NaN, but we can check by comparing the
	 * object's type pointer.
	 */

	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
	    const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType);

	    if (src->typePtr != &tclDoubleType) {
	    if (irPtr == NULL) {
		return TCL_ERROR;
	    }
	    dvalue = irPtr->doubleValue;
	    dvalue = src->internalRep.doubleValue;
	}

	/*
	 * Because some compilers will generate floating point exceptions on
	 * an overflow cast (e.g. Borland), we restrict the values to the
	 * valid range for float.
	 */

	if (fabs(dvalue) > (double) FLT_MAX) {
	if (fabs(dvalue) > (double)FLT_MAX) {
	    fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX;
	} else {
	    fvalue = (float) dvalue;
	}
	CopyNumber(&fvalue, *cursorPtr, sizeof(float), type);
	*cursorPtr += sizeof(float);
	return TCL_OK;

	/*
	 * 64-bit integer values.
	 */
    case 'w':
    case 'W':
    case 'm':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 32);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 40);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 48);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 56);
	    *(*cursorPtr)++ = (unsigned char) wvalue;
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
	} else {
	    *(*cursorPtr)++ = UCHAR(wvalue >> 56);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 48);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 40);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 32);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 56);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 48);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 40);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 32);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 24);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 16);
	    *(*cursorPtr)++ = (unsigned char) (wvalue >> 8);
	    *(*cursorPtr)++ = (unsigned char) wvalue;
	}
	return TCL_OK;

	/*
	 * 32-bit integer values.
	 */
    case 'i':
    case 'I':
    case 'n':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	    *(*cursorPtr)++ = (unsigned char) value;
	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
	} else {
	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = (unsigned char) (value >> 24);
	    *(*cursorPtr)++ = (unsigned char) (value >> 16);
	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
	    *(*cursorPtr)++ = (unsigned char) value;
	}
	return TCL_OK;

	/*
	 * 16-bit integer values.
	 */
    case 's':
    case 'S':
    case 't':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (NeedReversing(type)) {
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = (unsigned char) value;
	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
	} else {
	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
	    *(*cursorPtr)++ = UCHAR(wvalue);
	    *(*cursorPtr)++ = (unsigned char) (value >> 8);
	    *(*cursorPtr)++ = (unsigned char) value;
	}
	return TCL_OK;

	/*
	 * 8-bit integer values.
	 */
    case 'c':
	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
	    return TCL_ERROR;
	}
	*(*cursorPtr)++ = UCHAR(wvalue);
	*(*cursorPtr)++ = (unsigned char) value;
	return TCL_OK;

    default:
	Tcl_Panic("unexpected fallthrough");
	return TCL_ERROR;
    }
}
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279



2280
2281
2282
2283
2284
2285
2286
1912
1913
1914
1915
1916
1917
1918



1919
1920
1921
1922
1923
1924
1925
1926
1927
1928







-
-
-
+
+
+








static Tcl_Obj *
ScanNumber(
    unsigned char *buffer,	/* Buffer to scan number from. */
    int type,			/* Format character from "binary scan" */
    int flags,			/* Format field flags */
    Tcl_HashTable **numberCachePtrPtr)
				/* Place to look for cache of scanned value
				 * objects, or NULL if too many different
				 * numbers have been scanned. */
				/* Place to look for cache of scanned
				 * value objects, or NULL if too many
				 * different numbers have been scanned. */
{
    long value;
    float fvalue;
    double dvalue;
    Tcl_WideUInt uwvalue;

    /*
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
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







-
+





-







-
-
-
+
+
+




-
+

-
-
+
+




-
+


-
+

-

-
+














-
+







		    + (buffer[1] << 8)
		    + (buffer[2] << 16)
		    + (((long)buffer[3]) << 24));
	} else {
	    value = (long) (buffer[3]
		    + (buffer[2] << 8)
		    + (buffer[1] << 16)
		    + (((long) buffer[0]) << 24));
		    + (((long)buffer[0]) << 24));
	}

	/*
	 * Check to see if the value was sign extended properly on systems
	 * where an int is more than 32-bits.
	 *
	 * We avoid caching unsigned integers as we cannot distinguish between
	 * 32bit signed and unsigned in the hash (short and char are ok).
	 */

	if (flags & BINARY_UNSIGNED) {
	    return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value);
	}
	if ((value & (((unsigned) 1) << 31)) && (value > 0)) {
	    value -= (((unsigned) 1) << 31);
	    value -= (((unsigned) 1) << 31);
	if ((value & (((unsigned int)1)<<31)) && (value > 0)) {
	    value -= (((unsigned int)1)<<31);
	    value -= (((unsigned int)1)<<31);
	}

    returnNumericObject:
	if (*numberCachePtrPtr == NULL) {
	    return Tcl_NewWideIntObj(value);
	    return Tcl_NewLongObj(value);
	} else {
	    Tcl_HashTable *tablePtr = *numberCachePtrPtr;
	    Tcl_HashEntry *hPtr;
	    register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
	    register Tcl_HashEntry *hPtr;
	    int isNew;

	    hPtr = Tcl_CreateHashEntry(tablePtr, INT2PTR(value), &isNew);
	    if (!isNew) {
		return (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
	    }
	    if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
		Tcl_Obj *objPtr;
		register Tcl_Obj *objPtr = Tcl_NewLongObj(value);

		TclNewIntObj(objPtr, value);
		Tcl_IncrRefCount(objPtr);
		Tcl_SetHashValue(hPtr, objPtr);
		Tcl_SetHashValue(hPtr, (ClientData) objPtr);
		return objPtr;
	    }

	    /*
	     * We've overflowed the cache! Someone's parsing a LOT of varied
	     * binary data in a single call! Bail out by switching back to the
	     * old behaviour for the rest of the scan.
	     *
	     * Note that anyone just using the 'c' conversion (for bytes)
	     * cannot trigger this.
	     */

	    DeleteScanNumberCache(tablePtr);
	    *numberCachePtrPtr = NULL;
	    return Tcl_NewWideIntObj(value);
	    return Tcl_NewLongObj(value);
	}

	/*
	 * Do not cache wide (64-bit) values; they are already too large to
	 * use as keys.
	 */

2425
2426
2427
2428
2429
2430
2431
2432
2433


2434
2435
2436
2437
2438
2439
2440
2441
2065
2066
2067
2068
2069
2070
2071


2072
2073

2074
2075
2076
2077
2078
2079
2080







-
-
+
+
-







		    | (((Tcl_WideUInt) buffer[1]) << 48)
		    | (((Tcl_WideUInt) buffer[0]) << 56);
	}
	if (flags & BINARY_UNSIGNED) {
	    Tcl_Obj *bigObj = NULL;
	    mp_int big;

	    if (mp_init_u64(&big, uwvalue) == MP_OKAY) {
		bigObj = Tcl_NewBignumObj(&big);
	    TclBNInitBignumFromWideUInt(&big, uwvalue);
	    bigObj = Tcl_NewBignumObj(&big);
	    }
	    return bigObj;
	}
	return Tcl_NewWideIntObj((Tcl_WideInt) uwvalue);

	/*
	 * Do not cache double values; they are already too large to use as
	 * keys and the values stored are utterly incompatible with the
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
2132
2133
2134
2135
2136
2137
2138

2139
2140
2141
2142
2143
2144
2145
2146
2147








































































































































































































































































































































































































































































































































































































































































































































































































































2148
2149
2150
2151
2152
2153
2154
2155







-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









    if (numberCachePtr == NULL) {
	return;
    }

    hEntry = Tcl_FirstHashEntry(numberCachePtr, &search);
    while (hEntry != NULL) {
	Tcl_Obj *value = (Tcl_Obj *)Tcl_GetHashValue(hEntry);
	register Tcl_Obj *value = Tcl_GetHashValue(hEntry);

	if (value != NULL) {
	    Tcl_DecrRefCount(value);
	}
	hEntry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(numberCachePtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * NOTES --
 *
 *	Some measurements show that it is faster to use a table to to perform
 *	uuencode and base64 value encoding than to calculate the output (at
 *	least on intel P4 arch).
 *
 *	Conversely using a lookup table for the decoding is slower than just
 *	calculating the values. We therefore use the fastest of each method.
 *
 *	Presumably this has to do with the size of the tables. The base64
 *	decode table is 255 bytes while the encode table is only 65 bytes. The
 *	choice likely depends on CPU memory cache sizes.
 */

/*
 *----------------------------------------------------------------------
 *
 * BinaryEncodeHex --
 *
 *	Implement the [binary encode hex] binary encoding. clientData must be
 *	a table to convert values to hexadecimal digits.
 *
 * Results:
 *	Interp result set to an encoded byte array object
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryEncodeHex(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data = NULL;
    unsigned char *cursor = NULL;
    size_t offset = 0, count = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "data");
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(objv[1], &count);
    cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
    for (offset = 0; offset < count; ++offset) {
	*cursor++ = HexDigits[(data[offset] >> 4) & 0x0F];
	*cursor++ = HexDigits[data[offset] & 0x0F];
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryDecodeHex --
 *
 *	Implement the [binary decode hex] binary encoding.
 *
 * Results:
 *	Interp result set to an decoded byte array object
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryDecodeHex(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor, c;
    int i, index, value, pure = 1, strict = 0;
    size_t size, cut = 0, count = 0;
    int ucs4;
    enum {OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = (count + 1) / 2;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	value = 0;
	for (i = 0 ; i < 2 ; i++) {
	    if (data >= dataend) {
		value <<= 4;
		break;
	    }

	    c = *data++;
	    if (!isxdigit(UCHAR(c))) {
		if (strict || !TclIsSpaceProc(c)) {
		    goto badChar;
		}
		i--;
		continue;
	    }

	    value <<= 4;
	    c -= '0';
	    if (c > 9) {
		c += ('0' - 'A') + 10;
	    }
	    if (c > 16) {
		c += ('A' - 'a');
	    }
	    value |= c & 0xF;
	}
	if (i < 2) {
	    cut++;
	}
	*cursor++ = UCHAR(value);
	value = 0;
    }
    if (cut > size) {
	cut = size;
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  badChar:
    if (pure) {
	ucs4 = c;
    } else {
	TclUtfToUCS4((const char *)(data - 1), &ucs4);
    }
    TclDecrRefCount(resultObj);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid hexadecimal digit \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryEncode64 --
 *
 *	This procedure implements the "binary encode base64" Tcl command.
 *
 * Results:
 *	The base64 encoded value prescribed by the input arguments.
 *
 *----------------------------------------------------------------------
 */

#define OUTPUT(c) \
    do {						\
	*cursor++ = (c);				\
	outindex++;					\
	if (maxlen > 0 && cursor != limit) {		\
	    if (outindex == maxlen) {			\
		memcpy(cursor, wrapchar, wrapcharlen);	\
		cursor += wrapcharlen;			\
		outindex = 0;				\
	    }						\
	}						\
	if (cursor > limit) {				\
	    Tcl_Panic("limit hit");			\
	}						\
    } while (0)

static int
BinaryEncode64(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *limit;
    int maxlen = 0;
    const char *wrapchar = "\n";
    size_t wrapcharlen = 1;
    int i, index, size, outindex = 0, purewrap = 1;
    size_t offset, count = 0;
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (maxlen < 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const char *)TclGetBytesFromObj(NULL,
		    objv[i + 1], &wrapcharlen);
	    if (wrapchar == NULL) {
		purewrap = 0;
		wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen);
	    }
	    break;
	}
    }
    if (wrapcharlen == 0) {
	maxlen = 0;
    }

    TclNewObj(resultObj);
    data = TclGetByteArrayFromObj(objv[objc - 1], &count);
    if (count > 0) {
	unsigned char *cursor = NULL;

	size = (((count * 4) / 3) + 3) & ~3;	/* ensure 4 byte chunks */
	if (maxlen > 0 && size > maxlen) {
	    int adjusted = size + (wrapcharlen * (size / maxlen));

	    if (size % maxlen == 0) {
		adjusted -= wrapcharlen;
	    }
	    size = adjusted;

	    if (purewrap == 0) {
		/* Wrapchar is (possibly) non-byte, so build result as
		 * general string, not bytearray */
		Tcl_SetObjLength(resultObj, size);
		cursor = (unsigned char *) TclGetString(resultObj);
	    }
	}
	if (cursor == NULL) {
	    cursor = Tcl_SetByteArrayLength(resultObj, size);
	}
	limit = cursor + size;
	for (offset = 0; offset < count; offset += 3) {
	    unsigned char d[3] = {0, 0, 0};

	    for (i = 0; i < 3 && offset + i < count; ++i) {
		d[i] = data[offset + i];
	    }
	    OUTPUT(B64Digits[d[0] >> 2]);
	    OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]);
	    if (offset + 1 < count) {
		OUTPUT(B64Digits[((d[1] & 0x0F) << 2) | (d[2] >> 6)]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	    if (offset+2 < count) {
		OUTPUT(B64Digits[d[2] & 0x3F]);
	    } else {
		OUTPUT(B64Digits[64]);
	    }
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}
#undef OUTPUT

/*
 *----------------------------------------------------------------------
 *
 * BinaryEncodeUu --
 *
 *	This implements the uuencode binary encoding. Input is broken into 6
 *	bit chunks and a lookup table is used to turn these values into output
 *	characters. This differs from the generic code above in that line
 *	lengths are also encoded.
 *
 * Results:
 *	Interp result set to an encoded byte array object
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryEncodeUu(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj;
    unsigned char *data, *start, *cursor;
    int rawLength, n, i, bits, index;
    int lineLength = 61;
    const unsigned char SingleNewline[] = { UCHAR('\n') };
    const unsigned char *wrapchar = SingleNewline;
    size_t j, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
    enum { OPT_MAXLEN, OPT_WRAPCHAR };
    static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };

    if (objc < 2 || objc % 2 != 0) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-maxlen len? ?-wrapchar char? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_MAXLEN:
	    if (Tcl_GetIntFromObj(interp, objv[i + 1],
		    &lineLength) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (lineLength < 5 || lineLength > 85) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"line length out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE",
			"LINE_LENGTH", NULL);
		return TCL_ERROR;
	    }
	    lineLength = ((lineLength - 1) & -4) + 1; /* 5, 9, 13 ... */
	    break;
	case OPT_WRAPCHAR:
	    wrapchar = (const unsigned char *) TclGetStringFromObj(
		    objv[i + 1], &wrapcharlen);
	    {
		const unsigned char *p = wrapchar;
		size_t numBytes = wrapcharlen;

		while (numBytes) {
		    switch (*p) {
			case '\t':
			case '\v':
			case '\f':
			case '\r':
			    p++; numBytes--;
			    continue;
			case '\n':
			    numBytes--;
			    break;
			default:
			badwrap:
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
				    "invalid wrapchar; will defeat decoding",
				    -1));
			    Tcl_SetErrorCode(interp, "TCL", "BINARY",
				    "ENCODE", "WRAPCHAR", NULL);
			    return TCL_ERROR;
		    }
		}
		if (numBytes) {
		    goto badwrap;
		}
	    }
	    break;
	}
    }

    /*
     * Allocate the buffer. This is a little bit too long, but is "good
     * enough".
     */

    TclNewObj(resultObj);
    offset = 0;
    data = TclGetByteArrayFromObj(objv[objc - 1], &count);
    rawLength = (lineLength - 1) * 3 / 4;
    start = cursor = Tcl_SetByteArrayLength(resultObj,
	    (lineLength + wrapcharlen) *
	    ((count + (rawLength - 1)) / rawLength));
    n = bits = 0;

    /*
     * Encode the data. Each output line first has the length of raw data
     * encoded by the output line described in it by one encoded byte, then
     * the encoded data follows (encoding each 6 bits as one character).
     * Encoded lines are always terminated by a newline.
     */

    while (offset < count) {
	int lineLen = count - offset;

	if (lineLen > rawLength) {
	    lineLen = rawLength;
	}
	*cursor++ = UueDigits[lineLen];
	for (i = 0 ; i < lineLen ; i++) {
	    n <<= 8;
	    n |= data[offset++];
	    for (bits += 8; bits > 6 ; bits -= 6) {
		*cursor++ = UueDigits[(n >> (bits - 6)) & 0x3F];
	    }
	}
	if (bits > 0) {
	    n <<= 8;
	    *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3F];
	    bits = 0;
	}
	for (j = 0 ; j < wrapcharlen ; ++j) {
	    *cursor++ = wrapchar[j];
	}
    }

    /*
     * Fix the length of the output bytearray.
     */

    Tcl_SetByteArrayLength(resultObj, cursor - start);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryDecodeUu --
 *
 *	Decode a uuencoded string.
 *
 * Results:
 *	Interp result set to an byte array object
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryDecodeUu(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend;
    unsigned char *begin, *cursor;
    int i, index, pure = 1, strict = 0, lineLen;
    size_t size, count = 0;
    unsigned char c;
    int ucs4;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    lineLen = -1;

    /*
     * The decoding loop. First, we get the length of line (strictly, the
     * number of data bytes we expect to generate from the line) we're
     * processing this time round if it is not already known (i.e., when the
     * lineLen variable is set to the magic value, -1).
     */

    while (data < dataend) {
	char d[4] = {0, 0, 0, 0};

	if (lineLen < 0) {
	    c = *data++;
	    if (c < 32 || c > 96) {
		if (strict || !TclIsSpaceProc(c)) {
		    goto badUu;
		}
		i--;
		continue;
	    }
	    lineLen = (c - 32) & 0x3F;
	}

	/*
	 * Now we read a four-character grouping.
	 */

	for (i = 0 ; i < 4 ; i++) {
	    if (data < dataend) {
		d[i] = c = *data++;
		if (c < 32 || c > 96) {
		    if (strict) {
			if (!TclIsSpaceProc(c)) {
			    goto badUu;
			} else if (c == '\n') {
			    goto shortUu;
			}
		    }
		    i--;
		    continue;
		}
	    }
	}

	/*
	 * Translate that grouping into (up to) three binary bytes output.
	 */

	if (lineLen > 0) {
	    *cursor++ = (((d[0] - 0x20) & 0x3F) << 2)
		    | (((d[1] - 0x20) & 0x3F) >> 4);
	    if (--lineLen > 0) {
		*cursor++ = (((d[1] - 0x20) & 0x3F) << 4)
			| (((d[2] - 0x20) & 0x3F) >> 2);
		if (--lineLen > 0) {
		    *cursor++ = (((d[2] - 0x20) & 0x3F) << 6)
			    | (((d[3] - 0x20) & 0x3F));
		    lineLen--;
		}
	    }
	}

	/*
	 * If we've reached the end of the line, skip until we process a
	 * newline.
	 */

	if (lineLen == 0 && data < dataend) {
	    lineLen = -1;
	    do {
		c = *data++;
		if (c == '\n') {
		    break;
		} else if (c >= 32 && c <= 96) {
		    data--;
		    break;
		} else if (strict || !TclIsSpaceProc(c)) {
		    goto badUu;
		}
	    } while (data < dataend);
	}
    }

    /*
     * Sanity check, clean up and finish.
     */

    if (lineLen > 0 && strict) {
	goto shortUu;
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  shortUu:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("short uuencode data"));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "SHORT", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;

  badUu:
    if (pure) {
	ucs4 = c;
    } else {
	TclUtfToUCS4((const char *)(data - 1), &ucs4);
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid uuencode character \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryDecode64 --
 *
 *	Decode a base64 encoded string.
 *
 * Results:
 *	Interp result set to an byte array object
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
BinaryDecode64(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *resultObj = NULL;
    unsigned char *data, *datastart, *dataend, c = '\0';
    unsigned char *begin = NULL;
    unsigned char *cursor = NULL;
    int pure = 1, strict = 0;
    int i, index, cut = 0;
    size_t size, count = 0;
    int ucs4;
    enum { OPT_STRICT };
    static const char *const optStrings[] = { "-strict", NULL };

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? data");
	return TCL_ERROR;
    }
    for (i = 1; i < objc - 1; ++i) {
	if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case OPT_STRICT:
	    strict = 1;
	    break;
	}
    }

    TclNewObj(resultObj);
    data = TclGetBytesFromObj(NULL, objv[objc - 1], &count);
    if (data == NULL) {
	pure = 0;
	data = (unsigned char *) TclGetStringFromObj(objv[objc - 1], &count);
    }
    datastart = data;
    dataend = data + count;
    size = ((count + 3) & ~3) * 3 / 4;
    begin = cursor = Tcl_SetByteArrayLength(resultObj, size);
    while (data < dataend) {
	unsigned long value = 0;

	/*
	 * Decode the current block. Each base64 block consists of four input
	 * characters A-Z, a-z, 0-9, +, or /. Each character supplies six bits
	 * of output data, so each block's output is 24 bits (three bytes) in
	 * length. The final block can be shorter by one or two bytes, denoted
	 * by the input ending with one or two ='s, respectively.
	 */

	for (i = 0; i < 4; i++) {
	    /*
	     * Get the next input character. At end of input, pad with at most
	     * two ='s. If more than two ='s would be needed, instead discard
	     * the block read thus far.
	     */

	    if (data < dataend) {
		c = *data++;
	    } else if (i > 1) {
		c = '=';
	    } else {
		if (strict && i <= 1) {
		    /*
		     * Single resp. unfulfilled char (each 4th next single
		     * char) is rather bad64 error case in strict mode.
		     */

		    goto bad64;
		}
		cut += 3;
		break;
	    }

	    /*
	     * Load the character into the block value. Handle ='s specially
	     * because they're only valid as the last character or two of the
	     * final block of input. Unless strict mode is enabled, skip any
	     * input whitespace characters.
	     */

	    if (cut) {
		if (c == '=' && i > 1) {
		    value <<= 6;
		    cut++;
		} else if (!strict) {
		    i--;
		} else {
		    goto bad64;
		}
	    } else if (c >= 'A' && c <= 'Z') {
		value = (value << 6) | ((c - 'A') & 0x3F);
	    } else if (c >= 'a' && c <= 'z') {
		value = (value << 6) | ((c - 'a' + 26) & 0x3F);
	    } else if (c >= '0' && c <= '9') {
		value = (value << 6) | ((c - '0' + 52) & 0x3F);
	    } else if (c == '+') {
		value = (value << 6) | 0x3E;
	    } else if (c == '/') {
		value = (value << 6) | 0x3F;
	    } else if (c == '=' && (!strict || i > 1)) {
		/*
		 * "=" and "a=" is rather bad64 error case in strict mode.
		 */

		value <<= 6;
		if (i) {
		    cut++;
		}
	    } else if (strict) {
		goto bad64;
	    } else {
		i--;
	    }
	}
	*cursor++ = UCHAR((value >> 16) & 0xFF);
	*cursor++ = UCHAR((value >> 8) & 0xFF);
	*cursor++ = UCHAR(value & 0xFF);

	/*
	 * Since = is only valid within the final block, if it was encountered
	 * but there are still more input characters, confirm that strict mode
	 * is off and all subsequent characters are whitespace.
	 */

	if (cut && data < dataend) {
	    if (strict) {
		goto bad64;
	    }
	}
    }
    Tcl_SetByteArrayLength(resultObj, cursor - begin - cut);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

  bad64:
    if (pure) {
	ucs4 = c;
    } else {
	/* The decoder is byte-oriented. If we saw a byte that's not a
	 * valid member of the base64 alphabet, it could be the lead byte
	 * of a multi-byte character. */

	/* Safe because we know data is NUL-terminated */
	TclUtfToUCS4((const char *)(data - 1), &ucs4);
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid base64 character \"%c\" (U+%06X) at position %"
	    TCL_Z_MODIFIER "u", ucs4, ucs4, data - datastart - 1));
    Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
    TclDecrRefCount(resultObj);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclCkalloc.c.

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
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







-
-
-
-
-
-







-
-
+
+

-
+




-
+










-
+





-
-
+
+







 */

#include "tclInt.h"

#define FALSE	0
#define TRUE	1

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
#undef Tcl_AttemptAlloc
#undef Tcl_AttemptRealloc

#ifdef TCL_MEM_DEBUG

/*
 * One of the following structures is allocated each time the
 * "memory tag" command is invoked, to hold the current tag.
 */

typedef struct {
    size_t refCount;		/* Number of mem_headers referencing this
typedef struct MemTag {
    int refCount;		/* Number of mem_headers referencing this
				 * tag. */
    char string[1];		/* Actual size of string will be as large as
    char string[4];		/* Actual size of string will be as large as
				 * needed for actual tag. This must be the
				 * last field in the structure. */
} MemTag;

#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1) + bytesInString)
#define TAG_SIZE(bytesInString) ((unsigned) sizeof(MemTag) + bytesInString - 3)

static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
				 * by "memory tag" command). */

/*
 * One of the following structures is allocated just before each dynamically
 * allocated chunk of memory, both to record information about the chunk and
 * to help detect chunk under-runs.
 */

#define LOW_GUARD_SIZE (8 + (32 - (sizeof(size_t) + sizeof(int)))%8)
#define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
struct mem_header {
    struct mem_header *flink;
    struct mem_header *blink;
    MemTag *tagPtr;		/* Tag from "memory tag" command; may be
				 * NULL. */
    const char *file;
    size_t length;
    CONST char *file;
    long length;
    int line;
    unsigned char low_guard[LOW_GUARD_SIZE];
				/* Aligns body on 8-byte boundary, plus
				 * provides at least 8 additional guard bytes
				 * to detect underruns. */
    char body[1];		/* First byte of client's space. Actual size
				 * of this field will be larger than one. */
85
86
87
88
89
90
91
92
93


94
95
96
97
98
99




100
101
102
103
104
105
106
79
80
81
82
83
84
85


86
87
88
89




90
91
92
93
94
95
96
97
98
99
100







-
-
+
+


-
-
-
-
+
+
+
+







 * mem_header. It is used to get back to the header pointer from the body
 * pointer that's used by clients.
 */

#define BODY_OFFSET \
	((size_t) (&((struct mem_header *) 0)->body))

static unsigned int total_mallocs = 0;
static unsigned int total_frees = 0;
static int total_mallocs = 0;
static int total_frees = 0;
static size_t current_bytes_malloced = 0;
static size_t maximum_bytes_malloced = 0;
static unsigned int current_malloc_packets = 0;
static unsigned int  maximum_malloc_packets = 0;
static unsigned int break_on_malloc = 0;
static unsigned int trace_on_at_malloc = 0;
static int current_malloc_packets = 0;
static int maximum_malloc_packets = 0;
static int break_on_malloc = 0;
static int trace_on_at_malloc = 0;
static int alloc_tracing = FALSE;
static int init_malloced_bodies = TRUE;
#ifdef MEM_VALIDATE
static int validate_memory = TRUE;
#else
static int validate_memory = FALSE;
#endif
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
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







-
+









-
+
-
-
-
+
+
-
-
+

-
+








-
+










-
+

















-
+
-
-



-
+
-
-

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



-
+

-
+







static char *onExitMemDumpFileName = NULL;
static char dumpFile[100];	/* Records where to dump memory allocation
				 * information. */

/*
 * Mutex to serialize allocations. This is a low-level mutex that must be
 * explicitly initialized. This is necessary because the self initializing
 * mutexes use Tcl_Alloc...
 * mutexes use ckalloc...
 */

static Tcl_Mutex *ckallocMutexPtr;
static int ckallocInit = 0;

/*
 * Prototypes for procedures defined in this file:
 */

static int		CheckmemCmd(ClientData clientData,
static int		CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		MemoryCmd(ClientData clientData,
			    int argc, CONST char *argv[]);
static int		MemoryCmd(ClientData clientData, Tcl_Interp *interp,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
			    int argc, CONST char *argv[]);
static void		ValidateMemory(struct mem_header *memHeaderP,
			    const char *file, int line, int nukeGuards);
			    CONST char *file, int line, int nukeGuards);

/*
 *----------------------------------------------------------------------
 *
 * TclInitDbCkalloc --
 *
 *	Initialize the locks used by the allocator. This is only appropriate
 *	to call in a single threaded environment, such as during
 *	Tcl_InitSubsystems.
 *	TclInitSubsystems.
 *
 *----------------------------------------------------------------------
 */

void
TclInitDbCkalloc(void)
{
    if (!ckallocInit) {
	ckallocInit = 1;
	ckallocMutexPtr = Tcl_GetAllocMutex();
#if !TCL_THREADS
#ifndef TCL_THREADS
	/* Silence compiler warning */
	(void)ckallocMutexPtr;
#endif
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclDumpMemoryInfo --
 *
 *	Display the global memory management statistics.
 *
 *----------------------------------------------------------------------
 */

int
TclDumpMemoryInfo(
TclDumpMemoryInfo(ClientData clientData, int flags)
    ClientData clientData,
    int flags)
{
    char buf[1024];

    if (clientData == NULL) {
    if (clientData == NULL) { return 0; }
        return 0;
    }
    sprintf(buf,
	    "total mallocs             %10u\n"
	    "total frees               %10u\n"
	    "current packets allocated %10u\n"
	    "current bytes allocated   %10" TCL_Z_MODIFIER "u\n"
	    "maximum packets allocated %10u\n"
	    "maximum bytes allocated   %10" TCL_Z_MODIFIER "u\n",
	    "total mallocs             %10d\n"
	    "total frees               %10d\n"
	    "current packets allocated %10d\n"
	    "current bytes allocated   %10lu\n"
	    "maximum packets allocated %10d\n"
	    "maximum bytes allocated   %10lu\n",
	    total_mallocs,
	    total_frees,
	    current_malloc_packets,
	    current_bytes_malloced,
	    (unsigned long)current_bytes_malloced,
	    maximum_malloc_packets,
	    maximum_bytes_malloced);
	    (unsigned long)maximum_bytes_malloced);
    if (flags == 0) {
	fprintf((FILE *)clientData, "%s", buf);
    } else {
	/* Assume objPtr to append to */
	Tcl_AppendToObj((Tcl_Obj *) clientData, buf, -1);
    }
    return 1;
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
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







-
+

















-
-
+
+




-
-
-
+
+
+

-
+










-
-
+
+





-
-
-
+
+
+

-
+







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

static void
ValidateMemory(
    struct mem_header *memHeaderP,
				/* Memory chunk to validate */
    const char *file,		/* File containing the call to
    CONST char *file,		/* File containing the call to
				 * Tcl_ValidateAllMemory */
    int line,			/* Line number of call to
				 * Tcl_ValidateAllMemory */
    int nukeGuards)		/* If non-zero, indicates that the memory
				 * guards are to be reset to 0 after they have
				 * been printed */
{
    unsigned char *hiPtr;
    size_t idx;
    int guard_failed = FALSE;
    int byte;

    for (idx = 0; idx < LOW_GUARD_SIZE; idx++) {
	byte = *(memHeaderP->low_guard + idx);
	if (byte != GUARD_VALUE) {
	    guard_failed = TRUE;
	    fflush(stdout);
	    byte &= 0xFF;
	    fprintf(stderr, "low guard byte %" TCL_Z_MODIFIER "u is 0x%x  \t%c\n", idx, byte,
	    byte &= 0xff;
	    fprintf(stderr, "low guard byte %d is 0x%x  \t%c\n", (int)idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }
    if (guard_failed) {
	TclDumpMemoryInfo(stderr, 0);
	fprintf(stderr, "low guard failed at %p, %s %d\n",
		memHeaderP->body, file, line);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "low guard failed at %lx, %s %d\n",
		(long unsigned int) memHeaderP->body, file, line);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
	fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
		memHeaderP->file, memHeaderP->line);
	Tcl_Panic("Memory validation failure");
    }

    hiPtr = (unsigned char *)memHeaderP->body + memHeaderP->length;
    for (idx = 0; idx < HIGH_GUARD_SIZE; idx++) {
	byte = *(hiPtr + idx);
	if (byte != GUARD_VALUE) {
	    guard_failed = TRUE;
	    fflush(stdout);
	    byte &= 0xFF;
	    fprintf(stderr, "hi guard byte %" TCL_Z_MODIFIER "u is 0x%x  \t%c\n", idx, byte,
	    byte &= 0xff;
	    fprintf(stderr, "hi guard byte %d is 0x%x  \t%c\n", (int)idx, byte,
		    (isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
	}
    }

    if (guard_failed) {
	TclDumpMemoryInfo(stderr, 0);
	fprintf(stderr, "high guard failed at %p, %s %d\n",
		memHeaderP->body, file, line);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	fprintf(stderr, "high guard failed at %lx, %s %d\n",
		(long unsigned int) memHeaderP->body, file, line);
	fflush(stderr);			/* In case name pointer is bad. */
	fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
	fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
		memHeaderP->length, memHeaderP->file,
		memHeaderP->line);
	Tcl_Panic("Memory validation failure");
    }

    if (nukeGuards) {
	memset(memHeaderP->low_guard, 0, LOW_GUARD_SIZE);
305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307







-
+







 *	Displays memory validation information to stderr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ValidateAllMemory(
    const char *file,		/* File from which Tcl_ValidateAllMemory was
    CONST char *file,		/* File from which Tcl_ValidateAllMemory was
				 * called. */
    int line)			/* Line number of call to
				 * Tcl_ValidateAllMemory */
{
    struct mem_header *memScanP;

    if (!ckallocInit) {
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
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







-
+
















-
-
-
+
+
+
+















-
+








-
+





-
+

-
-
+
+










-
+




-
-
+
+







 *	have the file error number left in it.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DumpActiveMemory(
    const char *fileName)	/* Name of the file to write info to */
    CONST char *fileName)	/* Name of the file to write info to */
{
    FILE *fileP;
    struct mem_header *memScanP;
    char *address;

    if (fileName == NULL) {
	fileP = stderr;
    } else {
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    return TCL_ERROR;
	}
    }

    Tcl_MutexLock(ckallocMutexPtr);
    for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
	address = &memScanP->body[0];
	fprintf(fileP, "%p - %p  %" TCL_Z_MODIFIER "u @ %s %d %s",
		address, address + memScanP->length - 1,
	address = &memScanP->body [0];
	fprintf(fileP, "%8lx - %8lx  %7ld @ %s %d %s",
		(long unsigned int) address,
		(long unsigned int) address + memScanP->length - 1,
		memScanP->length, memScanP->file, memScanP->line,
		(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
	(void) fputc('\n', fileP);
    }
    Tcl_MutexUnlock(ckallocMutexPtr);

    if (fileP != stderr) {
	fclose(fileP);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkalloc - debugging Tcl_Alloc
 * Tcl_DbCkalloc - debugging ckalloc
 *
 *	Allocate the requested amount of space plus some extra for guard bands
 *	at both ends of the request, plus a size, panicing if there isn't
 *	enough space, then write in the guard bands and return the address of
 *	the space in the middle that the user asked for.
 *
 *	The second and third arguments are file and line, these contain the
 *	filename and line number corresponding to the caller. These are sent
 *	by the Tcl_Alloc macro; it uses the preprocessor autodefines __FILE__
 *	by the ckalloc macro; it uses the preprocessor autodefines __FILE__
 *	and __LINE__.
 *
 *----------------------------------------------------------------------
 */

void *
char *
Tcl_DbCkalloc(
    size_t size,
    const char *file,
    unsigned int size,
    CONST char *file,
    int line)
{
    struct mem_header *result = NULL;

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE -sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc(size +
	result = (struct mem_header *) TclpAlloc((unsigned)size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo(stderr, 0);
	Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d", size, file, line);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
    }

    /*
     * Fill in guard zones and size. Also initialize the contents of the block
     * with bogus bytes to detect uses of initialized data. Link into
     * allocated list.
     */
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
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







-
+







-
-
+
+





-
+
+
+
+
+
















-
+

-
-
+
+










-
+




-
+







	allocHead->blink = result;
    }
    allocHead = result;

    total_mallocs++;
    if (trace_on_at_malloc && (total_mallocs >= trace_on_at_malloc)) {
	(void) fflush(stdout);
	fprintf(stderr, "reached malloc trace enable point (%u)\n",
	fprintf(stderr, "reached malloc trace enable point (%d)\n",
		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
		result->body, size, file, line);
	fprintf(stderr,"ckalloc %lx %u %s %d\n",
		(long unsigned int) result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%u)", total_mallocs);
	fprintf(stderr,"reached malloc break limit (%d)\n",
		total_mallocs);
	fprintf(stderr, "program will now enter C debugger\n");
	(void) fflush(stderr);
	abort();
    }

    current_malloc_packets++;
    if (current_malloc_packets > maximum_malloc_packets) {
	maximum_malloc_packets = current_malloc_packets;
    }
    current_bytes_malloced += size;
    if (current_bytes_malloced > maximum_bytes_malloced) {
	maximum_bytes_malloced = current_bytes_malloced;
    }

    Tcl_MutexUnlock(ckallocMutexPtr);

    return result->body;
}

void *
char *
Tcl_AttemptDbCkalloc(
    size_t size,
    const char *file,
    unsigned int size,
    CONST char *file,
    int line)
{
    struct mem_header *result = NULL;

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    /* Don't let size argument to TclpAlloc overflow */
    if (size <= UINT_MAX - HIGH_GUARD_SIZE - sizeof(struct mem_header)) {
	result = (struct mem_header *) TclpAlloc(size +
	result = (struct mem_header *) TclpAlloc((unsigned)size +
		sizeof(struct mem_header) + HIGH_GUARD_SIZE);
    }
    if (result == NULL) {
	fflush(stdout);
	TclDumpMemoryInfo(stderr, 0);
	TclDumpMemoryInfo((ClientData) stderr, 0);
	return NULL;
    }

    /*
     * Fill in guard zones and size. Also initialize the contents of the block
     * with bogus bytes to detect uses of initialized data. Link into
     * allocated list.
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
611
612
613
614
615
616
617


618
619
620
621
622
623
624
625
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
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
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
611
612


613
614
615
616
617
618
619
620
621
622
623

624
625
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
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







-
-
+
+





-
+
+
+
+
+



















-
+








-
+







-
-
+
+



















-
-
+
+









-
+







-
-
+
+
+
















-
+






-
+









-
+

-
-
-
+
+
+



-
+













-
+


-
-
+
+




-
+

-
-
-
+
+
+



-
+













-
+


-
+



-
+







		total_mallocs);
	fflush(stderr);
	alloc_tracing = TRUE;
	trace_on_at_malloc = 0;
    }

    if (alloc_tracing) {
	fprintf(stderr,"Tcl_Alloc %p %" TCL_Z_MODIFIER "u %s %d\n",
		result->body, size, file, line);
	fprintf(stderr,"ckalloc %lx %u %s %d\n",
		(long unsigned int) result->body, size, file, line);
    }

    if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
	break_on_malloc = 0;
	(void) fflush(stdout);
	Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
	fprintf(stderr,"reached malloc break limit (%d)\n",
		total_mallocs);
	fprintf(stderr, "program will now enter C debugger\n");
	(void) fflush(stderr);
	abort();
    }

    current_malloc_packets++;
    if (current_malloc_packets > maximum_malloc_packets) {
	maximum_malloc_packets = current_malloc_packets;
    }
    current_bytes_malloced += size;
    if (current_bytes_malloced > maximum_bytes_malloced) {
	maximum_bytes_malloced = current_bytes_malloced;
    }

    Tcl_MutexUnlock(ckallocMutexPtr);

    return result->body;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbCkfree - debugging Tcl_Free
 * Tcl_DbCkfree - debugging ckfree
 *
 *	Verify that the low and high guards are intact, and if so then free
 *	the buffer else Tcl_Panic.
 *
 *	The guards are erased after being checked to catch duplicate frees.
 *
 *	The second and third arguments are file and line, these contain the
 *	filename and line number corresponding to the caller. These are sent
 *	by the Tcl_Free macro; it uses the preprocessor autodefines __FILE__ and
 *	by the ckfree macro; it uses the preprocessor autodefines __FILE__ and
 *	__LINE__.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DbCkfree(
    void *ptr,
    const char *file,
    char *ptr,
    CONST char *file,
    int line)
{
    struct mem_header *memp;

    if (ptr == NULL) {
	return;
    }

    /*
     * The following cast is *very* tricky. Must convert the pointer to an
     * integer before doing arithmetic on it, because otherwise the arithmetic
     * will be done differently (and incorrectly) on word-addressed machines
     * such as Crays (will subtract only bytes, even though BODY_OFFSET is in
     * words on these machines).
     */

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    if (alloc_tracing) {
	fprintf(stderr, "Tcl_Free %p %" TCL_Z_MODIFIER "u %s %d\n",
		memp->body, memp->length, file, line);
	fprintf(stderr, "ckfree %lx %ld %s %d\n",
		(long unsigned int) memp->body, memp->length, file, line);
    }

    if (validate_memory) {
	Tcl_ValidateAllMemory(file, line);
    }

    Tcl_MutexLock(ckallocMutexPtr);
    ValidateMemory(memp, file, line, TRUE);
    if (init_malloced_bodies) {
	memset(ptr, GUARD_VALUE, memp->length);
	memset(ptr, GUARD_VALUE, (size_t) memp->length);
    }

    total_frees++;
    current_malloc_packets--;
    current_bytes_malloced -= memp->length;

    if (memp->tagPtr != NULL) {
	if ((memp->tagPtr->refCount-- <= 1) && (curTagPtr != memp->tagPtr)) {
	    TclpFree(memp->tagPtr);
	memp->tagPtr->refCount--;
	if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
	    TclpFree((char *) memp->tagPtr);
	}
    }

    /*
     * Delink from allocated list
     */

    if (memp->flink != NULL) {
	memp->flink->blink = memp->blink;
    }
    if (memp->blink != NULL) {
	memp->blink->flink = memp->flink;
    }
    if (allocHead == memp) {
	allocHead = memp->flink;
    }
    TclpFree(memp);
    TclpFree((char *) memp);
    Tcl_MutexUnlock(ckallocMutexPtr);
}

/*
 *--------------------------------------------------------------------
 *
 * Tcl_DbCkrealloc - debugging Tcl_Realloc
 * Tcl_DbCkrealloc - debugging ckrealloc
 *
 *	Reallocate a chunk of memory by allocating a new one of the right
 *	size, copying the old data to the new location, and then freeing the
 *	old memory space, using all the memory checking features of this
 *	package.
 *
 *--------------------------------------------------------------------
 */

void *
char *
Tcl_DbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    char *ptr,
    unsigned int size,
    CONST char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    unsigned int copySize;
    struct mem_header *memp;

    if (ptr == NULL) {
	return Tcl_DbCkalloc(size, file, line);
    }

    /*
     * See comment from Tcl_DbCkfree before you change the following line.
     */

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
    if (copySize > (unsigned int) memp->length) {
	copySize = memp->length;
    }
    newPtr = (char *)Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, copySize);
    newPtr = Tcl_DbCkalloc(size, file, line);
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}

void *
char *
Tcl_AttemptDbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    char *ptr,
    unsigned int size,
    CONST char *file,
    int line)
{
    char *newPtr;
    size_t copySize;
    unsigned int copySize;
    struct mem_header *memp;

    if (ptr == NULL) {
	return Tcl_AttemptDbCkalloc(size, file, line);
    }

    /*
     * See comment from Tcl_DbCkfree before you change the following line.
     */

    memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);

    copySize = size;
    if (copySize > memp->length) {
    if (copySize > (unsigned int) memp->length) {
	copySize = memp->length;
    }
    newPtr = (char *)Tcl_AttemptDbCkalloc(size, file, line);
    newPtr = Tcl_AttemptDbCkalloc(size, file, line);
    if (newPtr == NULL) {
	return NULL;
    }
    memcpy(newPtr, ptr, copySize);
    memcpy(newPtr, ptr, (size_t) copySize);
    Tcl_DbCkfree(ptr, file, line);
    return newPtr;
}


/*
 *----------------------------------------------------------------------
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
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







+
+
+
+
+
-
+
+

-
+




-
+

-
+






-
+




-
+

-
-
+
+



-
+

-
-
+
+







 *
 * Side effects:
 *	Same as the debug versions.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
#undef Tcl_AttemptAlloc
#undef Tcl_AttemptRealloc
void *

char *
Tcl_Alloc(
    size_t size)
    unsigned int size)
{
    return Tcl_DbCkalloc(size, "unknown", 0);
}

void *
char *
Tcl_AttemptAlloc(
    size_t size)
    unsigned int size)
{
    return Tcl_AttemptDbCkalloc(size, "unknown", 0);
}

void
Tcl_Free(
    void *ptr)
    char *ptr)
{
    Tcl_DbCkfree(ptr, "unknown", 0);
}

void *
char *
Tcl_Realloc(
    void *ptr,
    size_t size)
    char *ptr,
    unsigned int size)
{
    return Tcl_DbCkrealloc(ptr, size, "unknown", 0);
}
void *
char *
Tcl_AttemptRealloc(
    void *ptr,
    size_t size)
    char *ptr,
    unsigned int size)
{
    return Tcl_AttemptDbCkrealloc(ptr, size, "unknown", 0);
}

/*
 *----------------------------------------------------------------------
 *
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
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
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







+


-
+

-
-
+
+

-
+





-
-
+
+
+



-
-
-
+
+
+
+


-
+



-
+


-
+
-




-
+
-
-
+


-
+


-


-
+

-
+







-
-
+
+


-
+


-
-
-
+
+
+
+


-
+





-
-
+
-







-
-
-
+
+
+
+


-
+








-
-
-
+
+
+
+



-
+

-
+


-
+


-
-
+
+


-
+



-
+
-
-
+


-
+


-


-
-
+
+


-
+



-
-
-
+
+
+
-



-
+
+



-
+
+




















-
-
-



-
+

-
-
+
+

-
-
+
+
+



-
+







 *		memory validate on|off
 *
 * Results:
 *	Standard TCL results.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */
static int
MemoryCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Obj values of arguments. */
    int argc,
    CONST char *argv[])
{
    const char *fileName;
    CONST char *fileName;
    FILE *fileP;
    Tcl_DString buffer;
    int result;
    size_t len;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option [args..]");
    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option [args..]\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
    if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " ", argv[1], " file\"", NULL);
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	result = Tcl_DumpActiveMemory (fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
	    Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
                    TclGetString(objv[2]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
    if (strcmp(argv[1],"break_on_malloc") == 0) {
	int value;
	if (objc != 3) {
	if (argc != 3) {
	    goto argError;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
	if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
	    return TCL_ERROR;
	}
	break_on_malloc = (unsigned int) value;
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"info") == 0) {
    if (strcmp(argv[1],"info") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
		"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", maximum_bytes_malloced));
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "init") == 0) {
	if (objc != 3) {
    if (strcmp(argv[1],"init") == 0) {
	if (argc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
	init_malloced_bodies = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]), "objs") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
    if (strcmp(argv[1],"objs") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " objs file\"", NULL);
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "cannot open output file: %s",
	    Tcl_AppendResult(interp, "cannot open output file", NULL);
                    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"onexit") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
    if (strcmp(argv[1],"onexit") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " onexit file\"", NULL);
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	onExitMemDumpFileName = dumpFile;
	strcpy(onExitMemDumpFileName,fileName);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"tag") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "file");
    if (strcmp(argv[1],"tag") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " tag string\"", NULL);
	    return TCL_ERROR;
	}
	if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
	    TclpFree(curTagPtr);
	    TclpFree((char *) curTagPtr);
	}
	len = strlen(TclGetString(objv[2]));
	len = strlen(argv[2]);
	curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
	curTagPtr->refCount = 0;
	memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1);
	memcpy(curTagPtr->string, argv[2], len + 1);
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"trace") == 0) {
	if (objc != 3) {
    if (strcmp(argv[1],"trace") == 0) {
	if (argc != 3) {
	    goto bad_suboption;
	}
	alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0);
	alloc_tracing = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }

    if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) {
    if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
	int value;
	if (objc != 3) {
	if (argc != 3) {
	    goto argError;
	}
	if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
	if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
	    return TCL_ERROR;
	}
	trace_on_at_malloc = value;
	return TCL_OK;
    }
    if (strcmp(TclGetString(objv[1]),"validate") == 0) {
	if (objc != 3) {
    if (strcmp(argv[1],"validate") == 0) {
	if (argc != 3) {
	    goto bad_suboption;
	}
	validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
	validate_memory = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
            "bad option \"%s\": should be active, break_on_malloc, info, "
            "init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
    Tcl_AppendResult(interp, "bad option \"", argv[1],
	    "\": should be active, break_on_malloc, info, init, onexit, "
	    "tag, trace, trace_on_at_malloc, or validate", NULL);
            TclGetString(objv[1])));
    return TCL_ERROR;

  argError:
    Tcl_WrongNumArgs(interp, 2, objv, "count");
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	    " ", argv[1], " count\"", NULL);
    return TCL_ERROR;

  bad_suboption:
    Tcl_WrongNumArgs(interp, 2, objv, "on|off");
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
	    " ", argv[1], " on|off\"", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * CheckmemCmd --
 *
 *	This is the command procedure for the "checkmem" command, which causes
 *	the application to exit after printing information about memory usage
 *	to the file passed to this command as its first argument.
 *
 * Results:
 *	Returns a standard Tcl completion code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static int		CheckmemCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static int
CheckmemCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter for evaluation. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Obj values of arguments. */
    int argc,			/* Number of arguments. */
    CONST char *argv[])		/* String values of arguments. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName");
    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" fileName\"", NULL);
	return TCL_ERROR;
    }
    tclMemDumpFileName = dumpFile;
    strcpy(tclMemDumpFileName, TclGetString(objv[1]));
    strcpy(tclMemDumpFileName, argv[1]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitMemory --
1018
1019
1020
1021
1022
1023
1024
1025
1026


1027
1028
1029
1030
1031
1032
1033
1020
1021
1022
1023
1024
1025
1026


1027
1028
1029
1030
1031
1032
1033
1034
1035







-
-
+
+








void
Tcl_InitMemory(
    Tcl_Interp *interp)		/* Interpreter in which commands should be
				 * added */
{
    TclInitDbCkalloc();
    Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "memory", MemoryCmd, (ClientData) NULL, NULL);
    Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, (ClientData) 0, NULL);
}


#else	/* TCL_MEM_DEBUG */

/* This is the !TCL_MEM_DEBUG case */

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

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
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
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







-
+

-
+

+
+
-
+












-
+




-
+

-
-
+
+


+
+
-
+



-
+
-















-
+

-
+

+
+
-
+
+


-
+

-
-
-
+
+
+

+
+
-
+
+













-
+

-
-
+
+

+
+
-
+


-
+




-
+

-
-
-
+
+
+


+
+
-
+



-
+
-















-
+

-
-
+
+

+
+
-
+
+


-
+

-
-
-
-
+
+
+
+

+
+
-
+
+
















-
+






-
-
-
+
+
+














+


-
+





-
+






-
-
+
+




-
+
-
-







 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
char *
Tcl_Alloc(
    size_t size)
    unsigned int size)
{
    char *result;

    void *result = TclpAlloc(size);
    result = TclpAlloc(size);

    /*
     * Most systems will not alloc(0), instead bumping it to one so that NULL
     * isn't returned. Some systems (AIX, Tru64) will alloc(0) by returning
     * NULL, so we have to check that the NULL we get is not in response to
     * alloc(0).
     *
     * The ANSI spec actually says that systems either return NULL *or* a
     * special pointer on failure, but we only check for NULL
     */

    if ((result == NULL) && size) {
	Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", size);
	Tcl_Panic("unable to alloc %u bytes", size);
    }
    return result;
}

void *
char *
Tcl_DbCkalloc(
    size_t size,
    const char *file,
    unsigned int size,
    CONST char *file,
    int line)
{
    char *result;

    void *result = TclpAlloc(size);
    result = (char *) TclpAlloc(size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes, %s line %d",
	Tcl_Panic("unable to alloc %u bytes, %s line %d", size, file, line);
		size, file, line);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptAlloc --
 *
 *	Interface to TclpAlloc when TCL_MEM_DEBUG is disabled. It does not
 *	check that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
char *
Tcl_AttemptAlloc(
    size_t size)
    unsigned int size)
{
    char *result;

    return (char *)TclpAlloc(size);
    result = TclpAlloc(size);
    return result;
}

void *
char *
Tcl_AttemptDbCkalloc(
    size_t size,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    unsigned int size,
    CONST char *file,
    int line)
{
    char *result;

    return (char *)TclpAlloc(size);
    result = (char *) TclpAlloc(size);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Realloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does check
 *	that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
char *
Tcl_Realloc(
    void *ptr,
    size_t size)
    char *ptr,
    unsigned int size)
{
    char *result;

    void *result = TclpRealloc(ptr, size);
    result = TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes", size);
	Tcl_Panic("unable to realloc %u bytes", size);
    }
    return result;
}

void *
char *
Tcl_DbCkrealloc(
    void *ptr,
    size_t size,
    const char *file,
    char *ptr,
    unsigned int size,
    CONST char *file,
    int line)
{
    char *result;

    void *result = TclpRealloc(ptr, size);
    result = (char *) TclpRealloc(ptr, size);

    if ((result == NULL) && size) {
	fflush(stdout);
	Tcl_Panic("unable to realloc %" TCL_Z_MODIFIER "u bytes, %s line %d",
	Tcl_Panic("unable to realloc %u bytes, %s line %d", size, file, line);
		size, file, line);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptRealloc --
 *
 *	Interface to TclpRealloc when TCL_MEM_DEBUG is disabled. It does not
 *	check that memory was actually allocated.
 *
 *----------------------------------------------------------------------
 */

void *
char *
Tcl_AttemptRealloc(
    void *ptr,
    size_t size)
    char *ptr,
    unsigned int size)
{
    char *result;

    return (char *)TclpRealloc(ptr, size);
    result = TclpRealloc(ptr, size);
    return result;
}

void *
char *
Tcl_AttemptDbCkrealloc(
    void *ptr,
    size_t size,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    char *ptr,
    unsigned int size,
    CONST char *file,
    int line)
{
    char *result;

    return (char *)TclpRealloc(ptr, size);
    result = (char *) TclpRealloc(ptr, size);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Free --
 *
 *	Interface to TclpFree when TCL_MEM_DEBUG is disabled. Done here rather
 *	in the macro to keep some modules from being compiled with
 *	TCL_MEM_DEBUG enabled and some with it disabled.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Free(
    void *ptr)
    char *ptr)
{
    TclpFree(ptr);
}

void
Tcl_DbCkfree(
    void *ptr,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    char *ptr,
    CONST char *file,
    int line)
{
    TclpFree(ptr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitMemory --
 *
 *	Dummy initialization for memory command, which is only available if
 *	TCL_MEM_DEBUG is on.
 *
 *----------------------------------------------------------------------
 */
	/* ARGSUSED */
void
Tcl_InitMemory(
    TCL_UNUSED(Tcl_Interp *) /*interp*/)
    Tcl_Interp *interp)
{
}

int
Tcl_DumpActiveMemory(
    TCL_UNUSED(const char *) /*fileName*/)
    CONST char *fileName)
{
    return TCL_OK;
}

void
Tcl_ValidateAllMemory(
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    CONST char *file,
    int line)
{
}

int
TclDumpMemoryInfo(
TclDumpMemoryInfo(ClientData clientData, int flags)
    TCL_UNUSED(ClientData),
    TCL_UNUSED(int) /*flags*/)
{
    return 1;
}

#endif	/* TCL_MEM_DEBUG */

/*
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
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







-
+







-
+









-
-


    } else if (onExitMemDumpFileName != NULL) {
	Tcl_DumpActiveMemory(onExitMemDumpFileName);
    }

    Tcl_MutexLock(ckallocMutexPtr);

    if (curTagPtr != NULL) {
	TclpFree(curTagPtr);
	TclpFree((char *) curTagPtr);
	curTagPtr = NULL;
    }
    allocHead = NULL;

    Tcl_MutexUnlock(ckallocMutexPtr);
#endif

#if defined(USE_TCLALLOC) && USE_TCLALLOC
#if USE_TCLALLOC
    TclFinalizeAllocSubsystem();
#endif
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to generic/tclClock.c.

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39



40
41
42
43
44
45
46
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









-
+











-
+











-
+


-
-
-
+
+
+







/*
 * tclClock.c --
 *
 *	Contains the time and date related commands. This code is derived from
 *	the time and date facilities of TclX, by Mark Diekhans and Karl
 *	Lehenbauer.
 *
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2004 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"

/*
 * Windows has mktime. The configurators do not check.
 */

#ifdef _WIN32
#ifdef __WIN32__
#define HAVE_MKTIME 1
#endif

/*
 * Constants
 */

#define JULIAN_DAY_POSIX_EPOCH		2440588
#define SECONDS_PER_DAY			86400
#define JULIAN_SEC_POSIX_EPOCH	      (((Tcl_WideInt) JULIAN_DAY_POSIX_EPOCH) \
					* SECONDS_PER_DAY)
#define FOUR_CENTURIES			146097	/* days */
#define FOUR_CENTURIES			146097 /* days */
#define JDAY_1_JAN_1_CE_JULIAN		1721424
#define JDAY_1_JAN_1_CE_GREGORIAN	1721426
#define ONE_CENTURY_GREGORIAN		36524	/* days */
#define FOUR_YEARS			1461	/* days */
#define ONE_YEAR			365	/* days */
#define ONE_CENTURY_GREGORIAN		36524  /* days */
#define FOUR_YEARS			1461   /* days */
#define ONE_YEAR			365    /* days */

/*
 * Table of the days in each month, leap and common years
 */

static const int hath[2][12] = {
    {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
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
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







-
+















-
+
















-
-
-
+
+
+






-
+






-
+

-
+









-
+



















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

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







/*
 * Enumeration of the string literals used in [clock]
 */

typedef enum ClockLiteral {
    LIT__NIL,
    LIT__DEFAULT_FORMAT,
    LIT_BCE,		LIT_C,
    LIT_BCE,		LIT_C,			
    LIT_CANNOT_USE_GMT_AND_TIMEZONE,
    LIT_CE,
    LIT_DAYOFMONTH,	LIT_DAYOFWEEK,		LIT_DAYOFYEAR,
    LIT_ERA,		LIT_GMT,		LIT_GREGORIAN,
    LIT_INTEGER_VALUE_TOO_LARGE,
    LIT_ISO8601WEEK,	LIT_ISO8601YEAR,
    LIT_JULIANDAY,	LIT_LOCALSECONDS,
    LIT_MONTH,
    LIT_SECONDS,	LIT_TZNAME,		LIT_TZOFFSET,
    LIT_YEAR,
    LIT__END
} ClockLiteral;
static const char *const literals[] = {
    "",
    "%a %b %d %H:%M:%S %Z %Y",
    "BCE",		"C",
    "BCE",		"C",			
    "cannot use -gmt and -timezone in same call",
    "CE",
    "dayOfMonth",	"dayOfWeek",		"dayOfYear",
    "era",		":GMT",			"gregorian",
    "integer value too large to represent",
    "iso8601Week",	"iso8601Year",
    "julianDay",	"localSeconds",
    "month",
    "seconds",		"tzName",		"tzOffset",
    "year"
};

/*
 * Structure containing the client data for [clock]
 */

typedef struct {
    size_t refCount;		/* Number of live references. */
    Tcl_Obj **literals;		/* Pool of object literals. */
typedef struct ClockClientData {
    int refCount;		/* Number of live references */
    Tcl_Obj** literals;		/* Pool of object literals */
} ClockClientData;

/*
 * Structure containing the fields used in [clock format] and [clock scan]
 */

typedef struct {
typedef struct TclDateFields {
    Tcl_WideInt seconds;	/* Time expressed in seconds from the Posix
				 * epoch */
    Tcl_WideInt localSeconds;	/* Local time expressed in nominal seconds
				 * from the Posix epoch */
    int tzOffset;		/* Time zone offset in seconds east of
				 * Greenwich */
    Tcl_Obj *tzName;		/* Time zone name */
    Tcl_Obj* tzName;		/* Time zone name */
    int julianDay;		/* Julian Day Number in local time zone */
    int isBce;			/* 1 if BCE */
    enum {BCE=1, CE=0} era;	/* Era */
    int gregorian;		/* Flag == 1 if the date is Gregorian */
    int year;			/* Year of the era */
    int dayOfYear;		/* Day of the year (1 January == 1) */
    int month;			/* Month number */
    int dayOfMonth;		/* Day of the month */
    int iso8601Year;		/* ISO8601 week-based year */
    int iso8601Week;		/* ISO8601 week number */
    int dayOfWeek;		/* Day of the week */
} TclDateFields;
static const char *const eras[] = { "CE", "BCE", NULL };
static const char* eras[] = { "CE", "BCE", NULL };

/*
 * Thread specific data block holding a 'struct tm' for the 'gmtime' and
 * 'localtime' library calls.
 */

static Tcl_ThreadDataKey tmKey;

/*
 * Mutex protecting 'gmtime', 'localtime' and 'mktime' calls and the statics
 * in the date parsing code.
 */

TCL_DECLARE_MUTEX(clockMutex)

/*
 * Function prototypes for local procedures in this file:
 */

static int		ConvertUTCToLocal(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertUTCToLocalUsingTable(Tcl_Interp *,
			    TclDateFields *, int, Tcl_Obj *const[]);
static int		ConvertUTCToLocalUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static int		ConvertLocalToUTC(Tcl_Interp *,
			    TclDateFields *, Tcl_Obj *, int);
static int		ConvertLocalToUTCUsingTable(Tcl_Interp *,
			    TclDateFields *, int, Tcl_Obj *const[]);
static int		ConvertLocalToUTCUsingC(Tcl_Interp *,
			    TclDateFields *, int);
static Tcl_Obj *	LookupLastTransition(Tcl_Interp *, Tcl_WideInt,
static int		ConvertUTCToLocal(Tcl_Interp*,
			    TclDateFields*, Tcl_Obj*, int);
static int		ConvertUTCToLocalUsingTable(Tcl_Interp*,
			    TclDateFields*, int, Tcl_Obj *const[]);
static int		ConvertUTCToLocalUsingC(Tcl_Interp*,
			    TclDateFields*, int);
static int		ConvertLocalToUTC(Tcl_Interp*,
			    TclDateFields*, Tcl_Obj*, int);
static int		ConvertLocalToUTCUsingTable(Tcl_Interp*,
			    TclDateFields*, int, Tcl_Obj *const[]);
static int		ConvertLocalToUTCUsingC(Tcl_Interp*,
			    TclDateFields*, int);
static Tcl_Obj*		LookupLastTransition(Tcl_Interp*, Tcl_WideInt,
			    int, Tcl_Obj *const *);
static void		GetYearWeekDay(TclDateFields *, int);
static void		GetGregorianEraYearDay(TclDateFields *, int);
static void		GetMonthDay(TclDateFields *);
static void		GetJulianDayFromEraYearWeekDay(TclDateFields *, int);
static void		GetJulianDayFromEraYearMonthDay(TclDateFields *, int);
static int		IsGregorianLeapYear(TclDateFields *);
static void		GetYearWeekDay(TclDateFields*, int);
static void		GetGregorianEraYearDay(TclDateFields*, int);
static void		GetMonthDay(TclDateFields*);
static void		GetJulianDayFromEraYearWeekDay(TclDateFields*, int);
static void		GetJulianDayFromEraYearMonthDay(TclDateFields*, int);
static int		IsGregorianLeapYear(TclDateFields*);
static int		WeekdayOnOrBefore(int, int);
static int		ClockClicksObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockConvertlocaltoutcObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
181
182
183
184
185
186
187
188

189
190
191
192
193
194
195
181
182
183
184
185
186
187

188
189
190
191
192
193
194
195







-
+







static int		ClockMicrosecondsObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockMillisecondsObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockParseformatargsObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    ClientData clientData, Tcl_Interp* interp,
			    int objc, Tcl_Obj *const objv[]);
static int		ClockSecondsObjCmd(
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static struct tm *	ThreadSafeLocalTime(const time_t *);
static void		TzsetIfNecessary(void);
static void		ClockDeleteCmdProc(ClientData);
204
205
206
207
208
209
210

211



212
213
214
215
216
217
218

219
220
221
222
223
224
225
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







+

+
+
+






-
+







				 * the end of the table. */
    Tcl_ObjCmdProc *objCmdProc;	/* Function that implements the command. This
				 * will always have the ClockClientData sent
				 * to it, but may well ignore this data. */
};

static const struct ClockCommand clockCommands[] = {
    { "clicks",			ClockClicksObjCmd },
    { "getenv",			ClockGetenvObjCmd },
    { "microseconds",		ClockMicrosecondsObjCmd },
    { "milliseconds",		ClockMillisecondsObjCmd },
    { "seconds",		ClockSecondsObjCmd },
    { "Oldscan",		TclClockOldscanObjCmd },
    { "ConvertLocalToUTC",	ClockConvertlocaltoutcObjCmd },
    { "GetDateFields",		ClockGetdatefieldsObjCmd },
    { "GetJulianDayFromEraYearMonthDay",
		ClockGetjuliandayfromerayearmonthdayObjCmd },
    { "GetJulianDayFromEraYearWeekDay",
		ClockGetjuliandayfromerayearweekdayObjCmd },
    		ClockGetjuliandayfromerayearweekdayObjCmd },
    { "ParseFormatArgs",	ClockParseformatargsObjCmd },
    { NULL, NULL }
};

/*
 *----------------------------------------------------------------------
 *
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
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







-
+



-
-
-
-
-
-
-
-
-
-
-
-
-

-
+











-
+

-
+







-


+

-






-
-
-
-







void
TclClockInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    const struct ClockCommand *clockCmdPtr;
    char cmdName[50];		/* Buffer large enough to hold the string
				 *::tcl::clock::GetJulianDayFromEraYearMonthDay
				 * plus a terminating NUL. */
				 * plus a terminating NULL. */
    ClockClientData *data;
    int i;

    /* Structure of the 'clock' ensemble */

    static const EnsembleImplMap clockImplMap[] = {
	{"add",          NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL,       0},
	{"clicks",       ClockClicksObjCmd,       TclCompileClockClicksCmd,  NULL, NULL,       0},
	{"format",       NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL,       0},
	{"microseconds", ClockMicrosecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(1), 0},
	{"milliseconds", ClockMillisecondsObjCmd, TclCompileClockReadingCmd, NULL, INT2PTR(2), 0},
	{"scan",         NULL,                    TclCompileBasicMin1ArgCmd, NULL, NULL      , 0},
	{"seconds",      ClockSecondsObjCmd,      TclCompileClockReadingCmd, NULL, INT2PTR(3), 0},
	{NULL,           NULL,                    NULL,                      NULL, NULL,       0}
    };

    /*
     * Safe interps get [::clock] as alias to a parent, so do not need their
     * Safe interps get [::clock] as alias to a master, so do not need their
     * own copies of the support routines.
     */

    if (Tcl_IsSafe(interp)) {
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = (ClockClientData *)Tcl_Alloc(sizeof(ClockClientData));
    data = (ClockClientData *) ckalloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = (Tcl_Obj **)Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*));
    data->literals = (Tcl_Obj**) ckalloc(LIT__END * sizeof(Tcl_Obj*));
    for (i = 0; i < LIT__END; ++i) {
	data->literals[i] = Tcl_NewStringObj(literals[i], -1);
	Tcl_IncrRefCount(data->literals[i]);
    }

    /*
     * Install the commands.
     * TODO - Let Tcl_MakeEnsemble do this?
     */

    strcpy(cmdName, "::tcl::clock::");
#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
    memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
    for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
	strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
	data->refCount++;
	Tcl_CreateObjCommand(interp, cmdName, clockCmdPtr->objCmdProc, data,
		ClockDeleteCmdProc);
    }

    /* Make the clock ensemble */

    TclMakeEnsemble(interp, "clock", clockImplMap);
}

/*
 *----------------------------------------------------------------------
 *
 * ClockConvertlocaltoutcObjCmd --
 *
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
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







-
-
+
+



-
-
-
-
+
+
+
+














-
-
+
+




-
+


-
-
+
+















-
+







 *	leaves an error message in the interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ClockConvertlocaltoutcObjCmd(
    ClientData clientData,	/* Client data */
    Tcl_Interp *interp,		/* Tcl interpreter */
    ClientData clientData,	/* Client data  */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    ClockClientData* data = (ClockClientData*) clientData;
    Tcl_Obj* const * literals = data->literals;
    Tcl_Obj* secondsObj;
    Tcl_Obj* dict;
    int changeover;
    TclDateFields fields;
    int created = 0;
    int status;

    /*
     * Check params and convert time.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict tzdata changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (Tcl_DictObjGet(interp, dict, lit[LIT_LOCALSECONDS],
	    &secondsObj)!= TCL_OK) {
    if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS],
		       &secondsObj)!= TCL_OK) {
	return TCL_ERROR;
    }
    if (secondsObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not "
		"found in dictionary", -1));
						  "found in dictionary", -1));
	return TCL_ERROR;
    }
    if ((TclGetWideIntFromObj(interp, secondsObj,
	    &fields.localSeconds) != TCL_OK)
    if ((Tcl_GetWideIntFromObj(interp, secondsObj,
			      &(fields.localSeconds)) != TCL_OK)
	|| (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK)
	|| ConvertLocalToUTC(interp, &fields, objv[2], changeover)) {
	return TCL_ERROR;
    }

    /*
     * Copy-on-write; set the 'seconds' field in the dictionary and place the
     * modified dictionary in the interpreter result.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	created = 1;
	Tcl_IncrRefCount(dict);
    }
    status = Tcl_DictObjPut(interp, dict, lit[LIT_SECONDS],
    status = Tcl_DictObjPut(interp, dict, literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (created) {
	Tcl_DecrRefCount(dict);
    }
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
450
451
452



453
454
455
456


457
458
459
460
461
462
463
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







-
-
+
+






-
-
+
+










-
+




-
-
-
+
+
+










-
+




-
-
-
+
+
+


-
-
+
+







 *	formatting a date, and populates a dictionary with them.
 *
 * Usage:
 *	::tcl::clock::GetDateFields seconds tzdata changeover
 *
 * Parameters:
 *	seconds - Time expressed in seconds from the Posix epoch.
 *	tzdata - Time zone data of the time zone in which time is to be
 *		 expressed.
 *	tzdata - Time zone data of the time zone in which time is to
 *                 be expressed.
 *	changeover - Julian Day Number at which the current locale adopted
 *		     the Gregorian calendar
 *
 * Results:
 *	Returns a dictonary populated with the fields:
 *		seconds - Seconds from the Posix epoch
 *		localSeconds - Nominal seconds from the Posix epoch in the
 *			       local time zone.
 *		localSeconds - Nominal seconds from the Posix epoch in
 *			       the local time zone.
 *		tzOffset - Time zone offset in seconds east of Greenwich
 *		tzName - Time zone name
 *		julianDay - Julian Day Number in the local time zone
 *
 *----------------------------------------------------------------------
 */

int
ClockGetdatefieldsObjCmd(
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    Tcl_Obj* dict;
    ClockClientData* data = (ClockClientData*) clientData;
    Tcl_Obj* const * literals = data->literals;
    int changeover;

    /*
     * Check params.
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "seconds tzdata changeover");
	return TCL_ERROR;
    }
    if (TclGetWideIntFromObj(interp, objv[1], &fields.seconds) != TCL_OK
    if (Tcl_GetWideIntFromObj(interp, objv[1], &(fields.seconds)) != TCL_OK
	    || TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * fields.seconds could be an unsigned number that overflowed. Make sure
     * that it isn't.
    /* 
     * fields.seconds could be an unsigned number that overflowed.  Make
     * sure that it isn't.
     */

    if (TclHasIntRep(objv[1], &tclBignumType)) {
	Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
    if (objv[1]->typePtr == &tclBignumType) {
	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
	return TCL_ERROR;
    }

    /*
     * Convert UTC time to local.
     */

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
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







-
+

-
+

-
+

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







     */

    GetGregorianEraYearDay(&fields, changeover);
    GetMonthDay(&fields);
    GetYearWeekDay(&fields, changeover);

    dict = Tcl_NewDictObj();
    Tcl_DictObjPut(NULL, dict, lit[LIT_LOCALSECONDS],
    Tcl_DictObjPut(NULL, dict, literals[LIT_LOCALSECONDS],
	    Tcl_NewWideIntObj(fields.localSeconds));
    Tcl_DictObjPut(NULL, dict, lit[LIT_SECONDS],
    Tcl_DictObjPut(NULL, dict, literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    Tcl_DictObjPut(NULL, dict, lit[LIT_TZNAME], fields.tzName);
    Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName);
    Tcl_DecrRefCount(fields.tzName);
    Tcl_DictObjPut(NULL, dict, lit[LIT_TZOFFSET],
	    Tcl_NewWideIntObj(fields.tzOffset));
    Tcl_DictObjPut(NULL, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    Tcl_DictObjPut(NULL, dict, lit[LIT_GREGORIAN],
	    Tcl_NewWideIntObj(fields.gregorian));
    Tcl_DictObjPut(NULL, dict, lit[LIT_ERA],
	    lit[fields.isBce ? LIT_BCE : LIT_CE]);
    Tcl_DictObjPut(NULL, dict, lit[LIT_YEAR],
	    Tcl_NewWideIntObj(fields.year));
    Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFYEAR],
	    Tcl_NewWideIntObj(fields.dayOfYear));
    Tcl_DictObjPut(NULL, dict, lit[LIT_MONTH],
	    Tcl_NewWideIntObj(fields.month));
    Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFMONTH],
	    Tcl_NewWideIntObj(fields.dayOfMonth));
    Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601YEAR],
	    Tcl_NewWideIntObj(fields.iso8601Year));
    Tcl_DictObjPut(NULL, dict, lit[LIT_ISO8601WEEK],
	    Tcl_NewWideIntObj(fields.iso8601Week));
    Tcl_DictObjPut(NULL, dict, lit[LIT_DAYOFWEEK],
	    Tcl_NewWideIntObj(fields.dayOfWeek));
    Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET],
	    Tcl_NewIntObj(fields.tzOffset));
    Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY],
	    Tcl_NewIntObj(fields.julianDay));
    Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN],
	    Tcl_NewIntObj(fields.gregorian));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ERA],
	    literals[fields.era ? LIT_BCE : LIT_CE]);
    Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR],
	    Tcl_NewIntObj(fields.year));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR],
	    Tcl_NewIntObj(fields.dayOfYear));
    Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH],
	    Tcl_NewIntObj(fields.month));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH],
	    Tcl_NewIntObj(fields.dayOfMonth));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601YEAR],
	    Tcl_NewIntObj(fields.iso8601Year));
    Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
	    Tcl_NewIntObj(fields.iso8601Week));
    Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
	    Tcl_NewIntObj(fields.dayOfWeek));
    Tcl_SetObjResult(interp, dict);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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



611
612
613

614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631


632
633
634
635
636
637
638
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







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

-
+




-
-
-
+
+
+
+



-
+










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

+
+
+


-
+
















-
-
+
+







 *	dictionary augmented with a 'julianDay' key, or TCL_ERROR,
 *	with the result being an error message.
 *
 *----------------------------------------------------------------------
 */

static int
FetchEraField(
    Tcl_Interp *interp,
    Tcl_Obj *dict,
    Tcl_Obj *key,
    int *storePtr)
{
    Tcl_Obj *value = NULL;

    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (value == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"expected key(s) not found in dictionary", -1));
	return TCL_ERROR;
    }
    return Tcl_GetIndexFromObj(interp, value, eras, "era", TCL_EXACT, storePtr);
}

static int
FetchIntField(
    Tcl_Interp *interp,
    Tcl_Obj *dict,
    Tcl_Obj *key,
    int *storePtr)
{
    Tcl_Obj *value = NULL;

    if (Tcl_DictObjGet(interp, dict, key, &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (value == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"expected key(s) not found in dictionary", -1));
	return TCL_ERROR;
    }
    return TclGetIntFromObj(interp, value, storePtr);
}

static int
ClockGetjuliandayfromerayearmonthdayObjCmd(
ClockGetjuliandayfromerayearmonthdayObjCmd (
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    Tcl_Obj* dict;
    ClockClientData* data = (ClockClientData*) clientData;
    Tcl_Obj* const * literals = data->literals;
    Tcl_Obj* fieldPtr;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;
    int era = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_YEAR], &fields.year)
		!= TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_MONTH], &fields.month)
		!= TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_DAYOFMONTH],
		&fields.dayOfMonth) != TCL_OK
    if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
		&era) != TCL_OK
	    || Tcl_DictObjGet(interp, dict, literals[LIT_YEAR], &fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || TclGetIntFromObj(interp, fieldPtr, &(fields.year)) != TCL_OK
	    || Tcl_DictObjGet(interp, dict, literals[LIT_MONTH],	&fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || TclGetIntFromObj(interp, fieldPtr, &(fields.month)) != TCL_OK
	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFMONTH], &fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || TclGetIntFromObj(interp, fieldPtr,
		&(fields.dayOfMonth)) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	if (fieldPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
	}
	return TCL_ERROR;
    }
    fields.isBce = isBce;
    fields.era = era;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearMonthDay(&fields, changeover);

    /*
     * Store Julian day in the dictionary - copy on write.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
	    Tcl_NewIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
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
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
613
614
615
616
617
618
619

620
621

622
623
624
625
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
686
687
688
689







-
+

-
+




-
-
-
+
+
+
+



-
+










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

+
+
+


-
+
















-
-
+
+







 *	dictionary augmented with a 'julianDay' key, or TCL_ERROR, with the
 *	result being an error message.
 *
 *----------------------------------------------------------------------
 */

static int
ClockGetjuliandayfromerayearweekdayObjCmd(
ClockGetjuliandayfromerayearweekdayObjCmd (
    ClientData clientData,	/* Opaque pointer to literal pool, etc. */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter vector */
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    Tcl_Obj* dict;
    ClockClientData* data = (ClockClientData*) clientData;
    Tcl_Obj* const * literals = data->literals;
    Tcl_Obj* fieldPtr;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;
    int era = 0;

    /*
     * Check params.
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dict changeover");
	return TCL_ERROR;
    }
    dict = objv[1];
    if (Tcl_DictObjGet(interp, dict, literals[LIT_ERA], &fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || Tcl_GetIndexFromObj(interp, fieldPtr, eras, "era", TCL_EXACT,
    if (FetchEraField(interp, dict, lit[LIT_ERA], &isBce) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_ISO8601YEAR],
		&fields.iso8601Year) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_ISO8601WEEK],
		&fields.iso8601Week) != TCL_OK
	    || FetchIntField(interp, dict, lit[LIT_DAYOFWEEK],
		&fields.dayOfWeek) != TCL_OK
		&era) != TCL_OK
	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601YEAR], &fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Year)) != TCL_OK
	    || Tcl_DictObjGet(interp, dict, literals[LIT_ISO8601WEEK], &fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || TclGetIntFromObj(interp, fieldPtr, &(fields.iso8601Week)) != TCL_OK
	    || Tcl_DictObjGet(interp, dict, literals[LIT_DAYOFWEEK], &fieldPtr) != TCL_OK
		 || fieldPtr == NULL
	    || TclGetIntFromObj(interp, fieldPtr, &(fields.dayOfWeek)) != TCL_OK
	    || TclGetIntFromObj(interp, objv[2], &changeover) != TCL_OK) {
	if (fieldPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("expected key(s) not found in dictionary", -1));
	}
	return TCL_ERROR;
    }
    fields.isBce = isBce;
    fields.era = era;

    /*
     * Get Julian day.
     */

    GetJulianDayFromEraYearWeekDay(&fields, changeover);

    /*
     * Store Julian day in the dictionary - copy on write.
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
	    Tcl_NewIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
738
739
740
741
742
743
744
745
746
747



748
749
750
751

752
753
754
755
756
757
758
705
706
707
708
709
710
711



712
713
714
715
716
717

718
719
720
721
722
723
724
725







-
-
-
+
+
+



-
+







 *	in the interpreter result on failure.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    Tcl_Interp* interp,		/* Tcl interpreter */
    TclDateFields* fields,	/* Fields of the time */
    Tcl_Obj* tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    int rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */
    Tcl_Obj** rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
	return TCL_ERROR;
786
787
788
789
790
791
792
793
794


795
796
797
798

799
800

801
802
803
804
805
806
807
753
754
755
756
757
758
759


760
761
762
763
764

765
766

767
768
769
770
771
772
773
774







-
-
+
+



-
+

-
+







 *	successful, stores the 'seconds' field in 'fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    Tcl_Interp* interp,		/* Tcl interpreter */
    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
    int rowc,			/* Number of points at which time changes */
    Tcl_Obj *const rowv[])	/* Points at which time changes */
{
    Tcl_Obj *row;
    Tcl_Obj* row;
    int cellc;
    Tcl_Obj **cellv;
    Tcl_Obj** cellv;
    int have[8];
    int nHave = 0;
    int i;
    int found;

    /*
     * Perform an initial lookup assuming that local == UTC, and locate the
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
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







-
+













-
+
+







    fields->seconds = fields->localSeconds;
    while (!found) {
	row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
	if ((row == NULL)
		|| TclListObjGetElements(interp, row, &cellc,
		    &cellv) != TCL_OK
		|| TclGetIntFromObj(interp, cellv[1],
		    &fields->tzOffset) != TCL_OK) {
		    &(fields->tzOffset)) != TCL_OK) {
	    return TCL_ERROR;
	}
	found = 0;
	for (i = 0; !found && i < nHave; ++i) {
	    if (have[i] == fields->tzOffset) {
		found = 1;
		break;
	    }
	}
	if (!found) {
	    if (nHave == 8) {
		Tcl_Panic("loop in ConvertLocalToUTCUsingTable");
	    }
	    have[nHave++] = fields->tzOffset;
	    have[nHave] = fields->tzOffset;
	    ++nHave;
	}
	fields->seconds = fields->localSeconds - fields->tzOffset;
    }
    fields->tzOffset = have[i];
    fields->seconds = fields->localSeconds - fields->tzOffset;
    return TCL_OK;
}
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
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







-
-
+
+
















-
+







 *	successful, stores the 'seconds' field in 'fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertLocalToUTCUsingC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    Tcl_Interp* interp,		/* Tcl interpreter */
    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    struct tm timeVal;
    int localErrno;
    int secondOfDay;
    Tcl_WideInt jsec;

    /*
     * Convert the given time to a date.
     */

    jsec = fields->localSeconds + JULIAN_SEC_POSIX_EPOCH;
    fields->julianDay = (int) (jsec / SECONDS_PER_DAY);
    secondOfDay = (int)(jsec % SECONDS_PER_DAY);
    if (secondOfDay < 0) {
	secondOfDay += SECONDS_PER_DAY;
	fields->julianDay--;
	--fields->julianDay;
    }
    GetGregorianEraYearDay(fields, changeover);
    GetMonthDay(fields);

    /*
     * Convert the date/time to a 'struct tm'.
     */
916
917
918
919
920
921
922
923
924


925
926
927
928
929
930
931
884
885
886
887
888
889
890


891
892
893
894
895
896
897
898
899







-
-
+
+








    /*
     * If conversion fails, report an error.
     */

    if (localErrno != 0
	    || (fields->seconds == -1 && timeVal.tm_yday == -1)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"time value too large/small to represent", -1));
	Tcl_SetResult(interp, "time value too large/small to represent",
		TCL_STATIC);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
941
942
943
944
945
946
947
948
949
950



951
952
953
954

955
956
957
958
959
960
961
909
910
911
912
913
914
915



916
917
918
919
920
921

922
923
924
925
926
927
928
929







-
-
-
+
+
+



-
+







 *	Populates the 'tzName' and 'tzOffset' fields.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocal(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the time */
    Tcl_Obj *tzdata,		/* Time zone data */
    Tcl_Interp* interp,		/* Tcl interpreter */
    TclDateFields* fields,	/* Fields of the time */
    Tcl_Obj* tzdata,		/* Time zone data */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    int rowc;			/* Number of rows in tzdata */
    Tcl_Obj **rowv;		/* Pointers to the rows */
    Tcl_Obj** rowv;		/* Pointers to the rows */

    /*
     * Unpack the tz data.
     */

    if (TclListObjGetElements(interp, tzdata, &rowc, &rowv) != TCL_OK) {
	return TCL_ERROR;
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
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







-
-
+
+




-
+

-
+








-
+







 *	interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingTable(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Fields of the date */
    Tcl_Interp* interp,		/* Tcl interpreter */
    TclDateFields* fields,	/* Fields of the date */
    int rowc,			/* Number of rows in the conversion table
				 * (>= 1) */
    Tcl_Obj *const rowv[])	/* Rows of the conversion table */
{
    Tcl_Obj *row;		/* Row containing the current information */
    Tcl_Obj* row;		/* Row containing the current information */
    int cellc;			/* Count of cells in the row (must be 4) */
    Tcl_Obj **cellv;		/* Pointers to the cells */
    Tcl_Obj** cellv;		/* Pointers to the cells */

    /*
     * Look up the nearest transition time.
     */

    row = LookupLastTransition(interp, fields->seconds, rowc, rowv);
    if (row == NULL ||
	    TclListObjGetElements(interp, row, &cellc, &cellv) != TCL_OK ||
	    TclGetIntFromObj(interp, cellv[1], &fields->tzOffset) != TCL_OK) {
	    TclGetIntFromObj(interp,cellv[1],&(fields->tzOffset)) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Convert the time.
     */

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
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







-
-
+
+



-
+









-
-
+
+






-
+

-
+








-
+







 *	interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
ConvertUTCToLocalUsingC(
    Tcl_Interp *interp,		/* Tcl interpreter */
    TclDateFields *fields,	/* Time to convert, with 'seconds' filled in */
    Tcl_Interp* interp,		/* Tcl interpreter */
    TclDateFields* fields,	/* Time to convert, with 'seconds' filled in */
    int changeover)		/* Julian Day of the Gregorian transition */
{
    time_t tock;
    struct tm *timeVal;		/* Time after conversion */
    struct tm* timeVal;		/* Time after conversion */
    int diff;			/* Time zone diff local-Greenwich */
    char buffer[16];		/* Buffer for time zone name */

    /*
     * Use 'localtime' to determine local year, month, day, time of day.
     */

    tock = (time_t) fields->seconds;
    if ((Tcl_WideInt) tock != fields->seconds) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"number too large to represent as a Posix time", -1));
	Tcl_AppendResult(interp,
		"number too large to represent as a Posix time", NULL);
	Tcl_SetErrorCode(interp, "CLOCK", "argTooLarge", NULL);
	return TCL_ERROR;
    }
    TzsetIfNecessary();
    timeVal = ThreadSafeLocalTime(&tock);
    if (timeVal == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	Tcl_AppendResult(interp,
		"localtime failed (clock value may be too "
		"large/small to represent)", -1));
		"large/small to represent)", NULL);
	Tcl_SetErrorCode(interp, "CLOCK", "localtimeFailed", NULL);
	return TCL_ERROR;
    }

    /*
     * Fill in the date in 'fields' and use it to derive Julian Day.
     */

    fields->isBce = 0;
    fields->era = CE;
    fields->year = timeVal->tm_year + 1900;
    fields->month = timeVal->tm_mon + 1;
    fields->dayOfMonth = timeVal->tm_mday;
    GetJulianDayFromEraYearMonthDay(fields, changeover);

    /*
     * Convert that value to seconds.
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
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







-
+

-
+






-
+







-
+







 *
 * Results:
 *	Returns a pointer to the row, or NULL if an error occurs.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
static Tcl_Obj*
LookupLastTransition(
    Tcl_Interp *interp,		/* Interpreter for error messages */
    Tcl_Interp* interp,		/* Interpreter for error messages */
    Tcl_WideInt tick,		/* Time from the epoch */
    int rowc,			/* Number of rows of tzdata */
    Tcl_Obj *const *rowv)	/* Rows in tzdata */
{
    int l;
    int u;
    Tcl_Obj *compObj;
    Tcl_Obj* compObj;
    Tcl_WideInt compVal;

    /*
     * Examine the first row to make sure we're in bounds.
     */

    if (Tcl_ListObjIndex(interp, rowv[0], 0, &compObj) != TCL_OK
	    || TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
	    || Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
	return NULL;
    }

    /*
     * Bizarre case - first row doesn't begin at MIN_WIDE_INT. Return it
     * anyway.
     */
1167
1168
1169
1170
1171
1172
1173
1174

1175
1176
1177
1178
1179
1180
1181
1135
1136
1137
1138
1139
1140
1141

1142
1143
1144
1145
1146
1147
1148
1149







-
+








    l = 0;
    u = rowc-1;
    while (l < u) {
	int m = (l + u + 1) / 2;

	if (Tcl_ListObjIndex(interp, rowv[m], 0, &compObj) != TCL_OK ||
		TclGetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
		Tcl_GetWideIntFromObj(interp, compObj, &compVal) != TCL_OK) {
	    return NULL;
	}
	if (tick >= compVal) {
	    l = m;
	} else {
	    u = m-1;
	}
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
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







-
+













-
+















-
+







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

static void
GetYearWeekDay(
    TclDateFields *fields,	/* Date to convert, must have 'julianDay' */
    TclDateFields* fields,	/* Date to convert, must have 'julianDay' */
    int changeover)		/* Julian Day Number of the Gregorian
				 * transition */
{
    TclDateFields temp;
    int dayOfFiscalYear;

    /*
     * Find the given date, minus three days, plus one year. That date's
     * iso8601 year is an upper bound on the ISO8601 year of the given date.
     */

    temp.julianDay = fields->julianDay - 3;
    GetGregorianEraYearDay(&temp, changeover);
    if (temp.isBce) {
    if (temp.era == BCE) {
	temp.iso8601Year = temp.year - 1;
    } else {
	temp.iso8601Year = temp.year + 1;
    }
    temp.iso8601Week = 1;
    temp.dayOfWeek = 1;
    GetJulianDayFromEraYearWeekDay(&temp, changeover);

    /*
     * temp.julianDay is now the start of an ISO8601 year, either the one
     * corresponding to the given date, or the one after. If we guessed high,
     * move one year earlier
     */

    if (fields->julianDay < temp.julianDay) {
	if (temp.isBce) {
	if (temp.era == BCE) {
	    temp.iso8601Year += 1;
	} else {
	    temp.iso8601Year -= 1;
	}
	GetJulianDayFromEraYearWeekDay(&temp, changeover);
    }

1266
1267
1268
1269
1270
1271
1272
1273

1274
1275
1276
1277
1278
1279
1280
1234
1235
1236
1237
1238
1239
1240

1241
1242
1243
1244
1245
1246
1247
1248







-
+







 *	Stores 'era', 'gregorian', 'year', and 'dayOfYear'.
 *
 *----------------------------------------------------------------------
 */

static void
GetGregorianEraYearDay(
    TclDateFields *fields,	/* Date fields containing 'julianDay' */
    TclDateFields* fields,	/* Date fields containing 'julianDay' */
    int changeover)		/* Gregorian transition date */
{
    int jday = fields->julianDay;
    int day;
    int year;
    int n;

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
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







-
+



















+








+










-
+







	 */

	day = jday - JDAY_1_JAN_1_CE_GREGORIAN;
	n = day / FOUR_CENTURIES;
	day %= FOUR_CENTURIES;
	if (day < 0) {
	    day += FOUR_CENTURIES;
	    n--;
	    --n;
	}
	year += 400 * n;

	/*
	 * n = number of centuries since the start of (year);
	 * day = remaining days
	 */

	n = day / ONE_CENTURY_GREGORIAN;
	day %= ONE_CENTURY_GREGORIAN;
	if (n > 3) {
	    /*
	     * 31 December in the last year of a 400-year cycle.
	     */

	    n = 3;
	    day += ONE_CENTURY_GREGORIAN;
	}
	year += 100 * n;

    } else {
	/*
	 * Julian calendar.
	 */

	fields->gregorian = 0;
	year = 1;
	day = jday - JDAY_1_JAN_1_CE_JULIAN;

    }

    /*
     * n = number of 4-year cycles; days = remaining days.
     */

    n = day / FOUR_YEARS;
    day %= FOUR_YEARS;
    if (day < 0) {
	day += FOUR_YEARS;
	n--;
	--n;
    }
    year += 4 * n;

    /*
     * n = number of years; days = remaining days.
     */

1355
1356
1357
1358
1359
1360
1361
1362

1363
1364
1365

1366
1367
1368
1369
1370
1371
1372
1325
1326
1327
1328
1329
1330
1331

1332
1333
1334

1335
1336
1337
1338
1339
1340
1341
1342







-
+


-
+







    year += n;

    /*
     * store era/year/day back into fields.
     */

    if (year <= 0) {
	fields->isBce = 1;
	fields->era = BCE;
	fields->year = 1 - year;
    } else {
	fields->isBce = 0;
	fields->era = CE;
	fields->year = year;
    }
    fields->dayOfYear = day + 1;
}

/*
 *----------------------------------------------------------------------
1382
1383
1384
1385
1386
1387
1388
1389

1390
1391
1392
1393

1394
1395
1396
1397
1398
1399
1400
1352
1353
1354
1355
1356
1357
1358

1359
1360
1361
1362

1363
1364
1365
1366
1367
1368
1369
1370







-
+



-
+







 *	Stores 'month' and 'dayOfMonth' in the 'fields' structure.
 *
 *----------------------------------------------------------------------
 */

static void
GetMonthDay(
    TclDateFields *fields)	/* Date to convert */
    TclDateFields* fields)	/* Date to convert */
{
    int day = fields->dayOfYear;
    int month;
    const int *h = hath[IsGregorianLeapYear(fields)];
    const int* h = hath[IsGregorianLeapYear(fields)];

    for (month = 0; month < 12 && day > h[month]; ++month) {
	day -= h[month];
    }
    fields->month = month+1;
    fields->dayOfMonth = day;
}
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
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







-
+





-





+
-
+







 *	Stores 'julianDay' in the fields.
 *
 *----------------------------------------------------------------------
 */

static void
GetJulianDayFromEraYearWeekDay(
    TclDateFields *fields,	/* Date to convert */
    TclDateFields* fields,	/* Date to convert */
    int changeover)		/* Julian Day Number of the Gregorian
				 * transition */
{
    int firstMonday;		/* Julian day number of week 1, day 1 in the
				 * given year */
    TclDateFields firstWeek;

    /*
     * Find January 4 in the ISO8601 year, which will always be in week 1.
     */

    TclDateFields firstWeek;
    firstWeek.isBce = fields->isBce;
    firstWeek.era = fields->era;
    firstWeek.year = fields->iso8601Year;
    firstWeek.month = 1;
    firstWeek.dayOfMonth = 4;
    GetJulianDayFromEraYearMonthDay(&firstWeek, changeover);

    /*
     * Find Monday of week 1.
1465
1466
1467
1468
1469
1470
1471
1472

1473
1474
1475




1476
1477

1478
1479
1480
1481
1482
1483
1484
1435
1436
1437
1438
1439
1440
1441

1442
1443
1444

1445
1446
1447
1448
1449

1450
1451
1452
1453
1454
1455
1456
1457







-
+


-
+
+
+
+

-
+







 *	Stores day number in 'julianDay'
 *
 *----------------------------------------------------------------------
 */

static void
GetJulianDayFromEraYearMonthDay(
    TclDateFields *fields,	/* Date to convert */
    TclDateFields* fields,	/* Date to convert */
    int changeover)		/* Gregorian transition date as a Julian Day */
{
    int year, ym1, month, mm1, q, r, ym1o4, ym1o100, ym1o400;
    int year;  int ym1;
    int month; int mm1;
    int q; int r;
    int ym1o4; int ym1o100; int ym1o400;

    if (fields->isBce) {
    if (fields->era == BCE) {
	year = 1 - fields->year;
    } else {
	year = fields->year;
    }

    /*
     * Reduce month modulo 12.
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

1531
1532
1533
1534

1535
1536
1537
1538

1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
1531
1532
1533
1534
1535
1536
1537
1538
1539

1540
1541

1542
1543


1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554







-
+


-
+







-

-
-
-
-
-
-
-
-
-
-
-

-
+



-
+



-
+



















-
-
+
+



















-
+

-
+

-
-
+
+
+
+








    /*
     * Adjust the year after reducing the month.
     */

    fields->gregorian = 1;
    if (year < 1) {
	fields->isBce = 1;
	fields->era = BCE;
	fields->year = 1-year;
    } else {
	fields->isBce = 0;
	fields->era = CE;
	fields->year = year;
    }

    /*
     * Try an initial conversion in the Gregorian calendar.
     */

#if 0 /* BUG https://core.tcl-lang.org/tcl/tktview?name=da340d4f32 */
    ym1o4 = ym1 / 4;
#else
    /*
     * Have to make sure quotient is truncated towards 0 when negative.
     * See above bug for details. The casts are necessary.
     */
    if (ym1 >= 0)
	ym1o4 = ym1 / 4;
    else {
	ym1o4 = - (int) (((unsigned int) -ym1) / 4);
    }
#endif
    if (ym1 % 4 < 0) {
	ym1o4--;
	--ym1o4;
    }
    ym1o100 = ym1 / 100;
    if (ym1 % 100 < 0) {
	ym1o100--;
	--ym1o100;
    }
    ym1o400 = ym1 / 400;
    if (ym1 % 400 < 0) {
	ym1o400--;
	--ym1o400;
    }
    fields->julianDay = JDAY_1_JAN_1_CE_GREGORIAN - 1
	    + fields->dayOfMonth
	    + daysInPriorMonths[IsGregorianLeapYear(fields)][month - 1]
	    + (ONE_YEAR * ym1)
	    + ym1o4
	    - ym1o100
	    + ym1o400;

    /*
     * If the resulting date is before the Gregorian changeover, convert in
     * the Julian calendar instead.
     */

    if (fields->julianDay < changeover) {
	fields->gregorian = 0;
	fields->julianDay = JDAY_1_JAN_1_CE_JULIAN - 1
		+ fields->dayOfMonth
		+ daysInPriorMonths[year%4 == 0][month - 1]
		+ (365 * ym1)
		+ ym1o4;
		+ (ONE_YEAR * ym1)
	        + ym1o4;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * IsGregorianLeapYear --
 *
 *	Tests whether a given year is a leap year, in either Julian or
 *	Gregorian calendar.
 *
 * Results:
 *	Returns 1 for a leap year, 0 otherwise.
 *
 *----------------------------------------------------------------------
 */

static int
IsGregorianLeapYear(
    TclDateFields *fields)	/* Date to test */
    TclDateFields* fields)	/* Date to test */
{
    int year = fields->year;
    int year;

    if (fields->isBce) {
	year = 1 - year;
    if (fields->era == BCE) {
	year = 1 - fields->year;
    } else {
	year = fields->year;
    }
    if (year%4 != 0) {
	return 0;
    } else if (!(fields->gregorian)) {
	return 1;
    } else if (year%400 == 0) {
	return 1;
1641
1642
1643
1644
1645
1646
1647
1648
1649


1650
1651
1652
1653
1654


1655
1656
1657
1658
1659
1660
1661
1604
1605
1606
1607
1608
1609
1610


1611
1612
1613
1614
1615


1616
1617
1618
1619
1620
1621
1622
1623
1624







-
-
+
+



-
-
+
+







 *	the value of the variable if the variable does exist,
 *
 *----------------------------------------------------------------------
 */

int
ClockGetenvObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    ClientData clientData,
    Tcl_Interp* interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *varName;
    const char *varValue;
    const char* varName;
    const char* varValue;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    varName = TclGetString(objv[1]);
    varValue = getenv(varName);
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
1651
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







-
+
+










-
-
-
+
+
+
+







    const time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * Get a thread-local buffer to hold the returned time.
     */

    struct tm *tmPtr = (struct tm *)Tcl_GetThreadData(&tmKey, sizeof(struct tm));
    struct tm *tmPtr = (struct tm *)
	    Tcl_GetThreadData(&tmKey, (int) sizeof(struct tm));
#ifdef HAVE_LOCALTIME_R
    localtime_r(timePtr, tmPtr);
#else
    struct tm *sysTmPtr;

    Tcl_MutexLock(&clockMutex);
    sysTmPtr = localtime(timePtr);
    if (sysTmPtr == NULL) {
	Tcl_MutexUnlock(&clockMutex);
	return NULL;
    }
    memcpy(tmPtr, localtime(timePtr), sizeof(struct tm));
    Tcl_MutexUnlock(&clockMutex);
    } else {
	memcpy((void *) tmPtr, (void *) localtime(timePtr), sizeof(struct tm));
	Tcl_MutexUnlock(&clockMutex);
    }
#endif
    return tmPtr;
}

/*----------------------------------------------------------------------
 *
 * ClockClicksObjCmd --
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
1786
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







-
-
+
+

-
+

-
+



-
+



-











-
+






+
-
+

-
-
-
+
+
+

-
+

+

+

-
+



-







 * documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockClicksObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Tcl interpreter */
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
    Tcl_Obj* const* objv)	/* Parameter values */
{
    static const char *const clicksSwitches[] = {
    static const char *clicksSwitches[] = {
	"-milliseconds", "-microseconds", NULL
    };
    enum ClicksSwitch {
	CLICKS_MILLIS, CLICKS_MICROS, CLICKS_NATIVE
	CLICKS_MILLIS,   CLICKS_MICROS,   CLICKS_NATIVE
    };
    int index = CLICKS_NATIVE;
    Tcl_Time now;
    Tcl_WideInt clicks = 0;

    switch (objc) {
    case 1:
	break;
    case 2:
	if (Tcl_GetIndexFromObj(interp, objv[1], clicksSwitches, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	break;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "?-switch?");
	Tcl_WrongNumArgs(interp, 1, objv, "?option?");
	return TCL_ERROR;
    }

    switch (index) {
    case CLICKS_MILLIS:
	Tcl_GetTime(&now);
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
	clicks = (Tcl_WideInt) now.sec * 1000 + now.usec / 1000;
		now.sec * 1000 + now.usec / 1000));
	break;
    case CLICKS_NATIVE:
#ifdef TCL_WIDE_CLICKS
	clicks = TclpGetWideClicks();
    case CLICKS_NATIVE: {
#ifndef TCL_WIDE_CLICKS
	unsigned long clicks = TclpGetClicks();
#else
	clicks = (Tcl_WideInt) TclpGetClicks();
	Tcl_WideInt clicks = TclpGetWideClicks();
#endif
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) clicks));
	break;
    }
    case CLICKS_MICROS:
	clicks = TclpGetMicroseconds();
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
	break;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(clicks));
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ClockMillisecondsObjCmd -
 *
1796
1797
1798
1799
1800
1801
1802
1803
1804


1805
1806

1807
1808
1809
1810
1811
1812
1813
1814
1815

1816
1817
1818
1819
1820
1821
1822
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







-
-
+
+

-
+








-
+







 * user documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockMillisecondsObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Tcl interpreter */
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
    Tcl_Obj* const* objv)	/* Parameter values */
{
    Tcl_Time now;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetTime(&now);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj( (Tcl_WideInt)
	    now.sec * 1000 + now.usec / 1000));
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ClockMicrosecondsObjCmd -
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
1799
1800
1801
1802
1803
1804
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
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







-
-
+
+

-
+

















-
-
+
+


-
-
+
+







-
+

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




+
-
-
-
+
+
+
+
+


-
+

-
-
-
+
+
+


-
-
+
-



-
-
+
+




-
-
+
-





-
-
-
-
+
+
+
+







-
+










-
+


-
-
+
-

-
+



-
+








-
-
+
-







+







 * user documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockMicrosecondsObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Tcl interpreter */
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
    Tcl_Obj* const* objv)	/* Parameter values */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclpGetMicroseconds()));
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * ClockParseformatargsObjCmd --
 *
 *	Parses the arguments for [clock format].
 *
 * Results:
 *	Returns a standard Tcl result, whose value is a four-element list
 *	comprising the time format, the locale, and the timezone.
 *	Returns a standard Tcl result, whose value is a four-element 
 *	list comprising the time format, the locale, and the timezone.
 *
 * This function exists because the loop that parses the [clock format]
 * options is a known performance "hot spot", and is implemented in an effort
 * to speed that particular code up.
 * options is a known performance "hot spot", and is implemented in an 
 * effort to speed that particular code up.
 *
 *-----------------------------------------------------------------------------
 */

static int
ClockParseformatargsObjCmd(
    ClientData clientData,	/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    Tcl_Obj **litPtr = dataPtr->literals;
    Tcl_Obj *results[3];	/* Format, locale and timezone */
    Tcl_Obj *const objv[]	/* Parameter vector */
) {

    ClockClientData* dataPtr = (ClockClientData*) clientData;
    Tcl_Obj** litPtr = dataPtr->literals;

    /* Format, locale and timezone */

    Tcl_Obj* results[3];
#define formatObj results[0]
#define localeObj results[1]
#define timezoneObj results[2]
    int gmtFlag = 0;

    static const char *const options[] = { /* Command line options expected */
	"-format",	"-gmt",		"-locale",
	"-timezone",	NULL };
    /* Command line options expected */

    static const char* options[] = {
	"-format",		"-gmt",			"-locale",
	"-timezone",		NULL };
    enum optionInd {
	CLOCK_FORMAT_FORMAT,	CLOCK_FORMAT_GMT,	CLOCK_FORMAT_LOCALE,
	CLOCK_FORMAT_TIMEZONE
	CLOCK_FORMAT_TIMEZONE 
    };
    int optionIndex;		/* Index of an option. */
    int saw = 0;		/* Flag == 1 if option was seen already. */
    Tcl_WideInt clockVal;	/* Clock value - just used to parse. */
    int optionIndex;		/* Index of an option */
    int saw = 0;		/* Flag == 1 if option was seen already */
    Tcl_WideInt clockVal;	/* Clock value - just used to parse */
    int i;

    /*
     * Args consist of a time followed by keyword-value pairs.
    /* Args consist of a time followed by keyword-value pairs */
     */

    if (objc < 2 || (objc % 2) != 0) {
	Tcl_WrongNumArgs(interp, 0, objv,
		"clock format clockval ?-format string? "
		"?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?");
			 "clock format clockval ?-format string? "
			 "?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?");
	Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", NULL);
	return TCL_ERROR;
    }

    /*
     * Extract values for the keywords.
    /* Extract values for the keywords */
     */

    formatObj = litPtr[LIT__DEFAULT_FORMAT];
    localeObj = litPtr[LIT_C];
    timezoneObj = litPtr[LIT__NIL];
    for (i = 2; i < objc; i+=2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		&optionIndex) != TCL_OK) {
	    Tcl_SetErrorCode(interp, "CLOCK", "badOption",
		    TclGetString(objv[i]), NULL);
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", 0,
				&optionIndex) != TCL_OK) {
	    Tcl_SetErrorCode(interp, "CLOCK", "badSwitch",
			     Tcl_GetString(objv[i]), NULL);
	    return TCL_ERROR;
	}
	switch (optionIndex) {
	case CLOCK_FORMAT_FORMAT:
	    formatObj = objv[i+1];
	    break;
	case CLOCK_FORMAT_GMT:
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK){
	    if (Tcl_GetBooleanFromObj(interp, objv[i+1], &gmtFlag) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case CLOCK_FORMAT_LOCALE:
	    localeObj = objv[i+1];
	    break;
	case CLOCK_FORMAT_TIMEZONE:
	    timezoneObj = objv[i+1];
	    break;
	}
	saw |= 1 << optionIndex;
	saw |= (1 << optionIndex);
    }

    /*
     * Check options.
    /* Check options */
     */

    if (TclGetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
    if (Tcl_GetWideIntFromObj(interp, objv[1], &clockVal) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((saw & (1 << CLOCK_FORMAT_GMT))
	    && (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
	&& (saw & (1 << CLOCK_FORMAT_TIMEZONE))) {
	Tcl_SetObjResult(interp, litPtr[LIT_CANNOT_USE_GMT_AND_TIMEZONE]);
	Tcl_SetErrorCode(interp, "CLOCK", "gmtWithTimezone", NULL);
	return TCL_ERROR;
    }
    if (gmtFlag) {
	timezoneObj = litPtr[LIT_GMT];
    }

    /*
     * Return options as a list.
    /* Return options as a list */
     */

    Tcl_SetObjResult(interp, Tcl_NewListObj(3, results));
    return TCL_OK;

#undef timezoneObj
#undef localeObj
#undef formatObj

}

/*----------------------------------------------------------------------
 *
 * ClockSecondsObjCmd -
 *
 *	Returns a count of microseconds since the epoch.
1984
1985
1986
1987
1988
1989
1990
1991
1992


1993
1994

1995
1996
1997
1998
1999
2000
2001
1950
1951
1952
1953
1954
1955
1956


1957
1958
1959

1960
1961
1962
1963
1964
1965
1966
1967







-
-
+
+

-
+







 * documentation for details on what it does.
 *
 *----------------------------------------------------------------------
 */

int
ClockSecondsObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Tcl interpreter */
    ClientData clientData,	/* Client data is unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const *objv)	/* Parameter values */
    Tcl_Obj* const* objv)	/* Parameter values */
{
    Tcl_Time now;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
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
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







-
+

-
+







-
+

-
+



-
+







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

static void
TzsetIfNecessary(void)
{
    static char* tzWas = (char *)INT2PTR(-1);	/* Previous value of TZ, protected by
    static char* tzWas = INT2PTR(-1);	/* Previous value of TZ, protected by
				 * clockMutex. */
    const char *tzIsNow;	/* Current value of TZ */
    const char* tzIsNow;	/* Current value of TZ */

    Tcl_MutexLock(&clockMutex);
    tzIsNow = getenv("TZ");
    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
	    || strcmp(tzIsNow, tzWas) != 0)) {
	tzset();
	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
	    Tcl_Free(tzWas);
	    ckfree(tzWas);
	}
	tzWas = (char *)Tcl_Alloc(strlen(tzIsNow) + 1);
	tzWas = ckalloc(strlen(tzIsNow) + 1);
	strcpy(tzWas, tzIsNow);
    } else if (tzIsNow == NULL && tzWas != NULL) {
	tzset();
	if (tzWas != INT2PTR(-1)) Tcl_Free(tzWas);
	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
	tzWas = NULL;
    }
    Tcl_MutexUnlock(&clockMutex);
}

/*
 *----------------------------------------------------------------------
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
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







-
+


+
-
+



-
-
+
+










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

static void
ClockDeleteCmdProc(
    ClientData clientData)	/* Opaque pointer to the client data */
{
    ClockClientData *data = (ClockClientData *)clientData;
    ClockClientData *data = (ClockClientData*) clientData;
    int i;

    --(data->refCount);
    if (data->refCount-- <= 1) {
    if (data->refCount == 0) {
	for (i = 0; i < LIT__END; ++i) {
	    Tcl_DecrRefCount(data->literals[i]);
	}
	Tcl_Free(data->literals);
	Tcl_Free(data);
	ckfree((char*) (data->literals));
	ckfree((char*) data);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclCmdAH.c.

8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
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
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







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







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


-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef _WIN32
#   include "tclWinInt.h"
#include <locale.h>
#endif

/*
 * The state structure used by [foreach]. Note that the actual structure has
 * all its working arrays appended afterwards so they can be allocated and
 * freed in a single step.
 */

struct ForeachState {
    Tcl_Obj *bodyPtr;		/* The script body of the command. */
    int bodyIdx;		/* The argument index of the body. */
    int j, maxj;		/* Number of loop iterations. */
    int numLists;		/* Count of value lists. */
    int *index;			/* Array of value list indices. */
    int *varcList;		/* # loop variables per list. */
    Tcl_Obj ***varvList;	/* Array of var name lists. */
    Tcl_Obj **vCopyList;	/* Copies of var name list arguments. */
    int *argcList;		/* Array of value list sizes. */
    Tcl_Obj ***argvList;	/* Array of value lists. */
    Tcl_Obj **aCopyList;	/* Copies of value list arguments. */
    Tcl_Obj *resultList;	/* List of result values from the loop body,
				 * or NULL if we're not collecting them
				 * ([lmap] vs [foreach]). */
};

/*
 * Prototypes for local procedures defined in this file:
 */

static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int mode);
static Tcl_ObjCmdProc	EncodingConvertfromObjCmd;
static Tcl_ObjCmdProc	EncodingConverttoObjCmd;
static Tcl_ObjCmdProc	EncodingDirsObjCmd;
static int		EncodingDirsObjCmd(ClientData dummy,
static Tcl_ObjCmdProc	EncodingNamesObjCmd;
static Tcl_ObjCmdProc	EncodingSystemObjCmd;
static inline int	ForeachAssignments(Tcl_Interp *interp,
			    Tcl_Interp *interp, int objc,
			    struct ForeachState *statePtr);
static inline void	ForeachCleanup(Tcl_Interp *interp,
			    Tcl_Obj *const objv[]);
			    struct ForeachState *statePtr);
static int		GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_FSStatProc *statProc, Tcl_StatBuf *statPtr);
static const char *	GetTypeFromMode(int mode);
static const char *		GetTypeFromMode(int mode);
static int		StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName,
			    Tcl_StatBuf *statPtr);
static int	EachloopCmd(Tcl_Interp *interp, int collect,
			    int objc, Tcl_Obj *const objv[]);
static Tcl_NRPostProc	CatchObjCmdCallback;
static Tcl_NRPostProc	ExprCallback;
static Tcl_NRPostProc	ForSetupCallback;
static Tcl_NRPostProc	ForCondCallback;
static Tcl_NRPostProc	ForNextCallback;
static Tcl_NRPostProc	ForPostNextCallback;
static Tcl_NRPostProc	ForeachLoopStep;
static Tcl_NRPostProc	EvalCmdErrMsg;

static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
static Tcl_ObjCmdProc FileAttrIsExistingCmd;
static Tcl_ObjCmdProc FileAttrIsFileCmd;
static Tcl_ObjCmdProc FileAttrIsOwnedCmd;
static Tcl_ObjCmdProc FileAttrIsReadableCmd;
static Tcl_ObjCmdProc FileAttrIsWritableCmd;
static Tcl_ObjCmdProc FileAttrLinkStatCmd;
static Tcl_ObjCmdProc FileAttrModifyTimeCmd;
static Tcl_ObjCmdProc FileAttrSizeCmd;
static Tcl_ObjCmdProc FileAttrStatCmd;
static Tcl_ObjCmdProc FileAttrTypeCmd;
static Tcl_ObjCmdProc FilesystemSeparatorCmd;
static Tcl_ObjCmdProc FilesystemVolumesCmd;
static Tcl_ObjCmdProc PathDirNameCmd;
static Tcl_ObjCmdProc PathExtensionCmd;
static Tcl_ObjCmdProc PathFilesystemCmd;
static Tcl_ObjCmdProc PathJoinCmd;
static Tcl_ObjCmdProc PathNativeNameCmd;
static Tcl_ObjCmdProc PathNormalizeCmd;
static Tcl_ObjCmdProc PathRootNameCmd;
static Tcl_ObjCmdProc PathSplitCmd;
static Tcl_ObjCmdProc PathTailCmd;
static Tcl_ObjCmdProc PathTypeCmd;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BreakObjCmd --
 *
 *	This procedure is invoked to process the "break" Tcl command. See the
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
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







+


-
+










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


















+


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






+















-
-
-




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





-
+

-
+





-
+
+
+
+





-

-
+
-
-
+
+
+





-
+




















+


-
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_BreakObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_BREAK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CaseObjCmd --
 *
 *	This procedure is invoked to process the "case" Tcl command. See the
 *	user documentation for details on what it does. THIS COMMAND IS
 *	OBSOLETE AND DEPRECATED. SLATED FOR REMOVAL IN TCL 9.0.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_CaseObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    register int i;
    int body, result, caseObjc;
    char *stringPtr, *arg;
    Tcl_Obj *const *caseObjv;
    Tcl_Obj *armPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string ?in? patList body ... ?default body?");
	return TCL_ERROR;
    }

    stringPtr = TclGetString(objv[1]);
    body = -1;

    arg = TclGetString(objv[2]);
    if (strcmp(arg, "in") == 0) {
	i = 3;
    } else {
	i = 2;
    }
    caseObjc = objc - i;
    caseObjv = objv + i;

    /*
     * If all of the pattern/command pairs are lumped into a single argument,
     * split them out again.
     */

    if (caseObjc == 1) {
	Tcl_Obj **newObjv;

	TclListObjGetElements(interp, caseObjv[0], &caseObjc, &newObjv);
	caseObjv = newObjv;
    }

    for (i = 0;  i < caseObjc;  i += 2) {
	int patObjc, j;
	const char **patObjv;
	char *pat, *p;

	if (i == (caseObjc - 1)) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "extra case pattern with no body", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Check for special case of single pattern (no list) with no
	 * backslash sequences.
	 */

	pat = TclGetString(caseObjv[i]);
	for (p = pat; *p != '\0'; p++) {
	    if (TclIsSpaceProcM(*p) || (*p == '\\')) {
		break;
	    }
	}
	if (*p == '\0') {
	    if ((*pat == 'd') && (strcmp(pat, "default") == 0)) {
		body = i + 1;
	    }
	    if (Tcl_StringMatch(stringPtr, pat)) {
		body = i + 1;
		goto match;
	    }
	    continue;
	}

	/*
	 * Break up pattern lists, then check each of the patterns in the
	 * list.
	 */

	result = Tcl_SplitList(interp, pat, &patObjc, &patObjv);
	if (result != TCL_OK) {
	    return result;
	}
	for (j = 0; j < patObjc; j++) {
	    if (Tcl_StringMatch(stringPtr, patObjv[j])) {
		body = i + 1;
		break;
	    }
	}
	ckfree((char *) patObjv);
	if (j < patObjc) {
	    break;
	}
    }

  match:
    if (body != -1) {
	armPtr = caseObjv[body - 1];
	result = Tcl_EvalObjEx(interp, caseObjv[body], 0);
	if (result == TCL_ERROR) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (\"%.50s\" arm line %d)",
		    TclGetString(armPtr), interp->errorLine));
	}
	return result;
    }

    /*
     * Nothing matched: return nothing.
     */

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CatchObjCmd --
 *
 *	This object-based procedure is invoked to process the "catch" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_CatchObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRCatchObjCmd, clientData, objc, objv);
}

int
TclNRCatchObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varNamePtr = NULL;
    Tcl_Obj *optionVarNamePtr = NULL;
    int result;
    Interp *iPtr = (Interp *) interp;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"script ?resultVarName? ?optionVarName?");
	return TCL_ERROR;
    }

    if (objc >= 3) {
	varNamePtr = objv[2];
    }
    if (objc == 4) {
	optionVarNamePtr = objv[3];
    }

    TclNRAddCallback(interp, CatchObjCmdCallback, INT2PTR(objc),
	    varNamePtr, optionVarNamePtr, NULL);

    /*
     * TIP #280. Make invoking context available to caught script.
     */

    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
}

static int
CatchObjCmdCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *varNamePtr = (Tcl_Obj *)data[1];
    Tcl_Obj *optionVarNamePtr = (Tcl_Obj *)data[2];
    int rewind = iPtr->execEnvPtr->rewind;

    /*
     * We disable catch in interpreters where the limit has been exceeded.
     */

    if (rewind || Tcl_LimitExceeded(interp)) {
    if (Tcl_LimitExceeded(interp)) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"catch\" body line %d)", Tcl_GetErrorLine(interp)));
		"\n    (\"catch\" body line %d)", interp->errorLine));
	return TCL_ERROR;
    }

    if (objc >= 3) {
	if (NULL == Tcl_ObjSetVar2(interp, varNamePtr, NULL,
		Tcl_GetObjResult(interp), TCL_LEAVE_ERR_MSG)) {
		Tcl_GetObjResult(interp), 0)) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp,
		    "couldn't save command result in variable", NULL);
	    return TCL_ERROR;
	}
    }
    if (objc == 4) {
	Tcl_Obj *options = Tcl_GetReturnOptions(interp, result);

	if (NULL == Tcl_ObjSetVar2(interp, optionVarNamePtr, NULL,
		options, TCL_LEAVE_ERR_MSG)) {
		options, 0)) {
	    /* Do not decrRefCount 'options', it was already done by
	     * Tcl_ObjSetVar2 */
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp,
		    "couldn't save return options in variable", NULL);
	    return TCL_ERROR;
	}
    }

    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CdObjCmd --
 *
 *	This procedure is invoked to process the "cd" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_CdObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dir;
    int result;

275
276
277
278
279
280
281
282
283
284


285
286
287
288
289
290
291
324
325
326
327
328
329
330



331
332
333
334
335
336
337
338
339







-
-
-
+
+







	Tcl_IncrRefCount(dir);
    }
    if (Tcl_FSConvertToPathType(interp, dir) != TCL_OK) {
	result = TCL_ERROR;
    } else {
	result = Tcl_FSChdir(dir);
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't change working directory to \"%s\": %s",
		    TclGetString(dir), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "couldn't change working directory to \"",
		    TclGetString(dir), "\": ", Tcl_PosixError(interp), NULL);
	    result = TCL_ERROR;
	}
    }
    if (objc != 2) {
	Tcl_DecrRefCount(dir);
    }
    return result;
304
305
306
307
308
309
310

311
312
313

314
315
316
317
318
319
320
352
353
354
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369







+


-
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ConcatObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc >= 2) {
	Tcl_SetObjResult(interp, Tcl_ConcatObj(objc-1, objv+1));
    }
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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







+


-
+












-
+

-
+

-
+


-
+


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





-
-
+
+




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

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

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

-
-
-
-
+
+
+
+

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

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


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

-




















-
+






-
-
+
+


-
+




-
+

-
-
-
+
+
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















+


-
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ContinueObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_CONTINUE;
}

/*
 *-----------------------------------------------------------------------------
 *----------------------------------------------------------------------
 *
 * TclInitEncodingCmd --
 * Tcl_EncodingObjCmd --
 *
 *	This function creates the 'encoding' ensemble.
 *	This command manipulates encodings.
 *
 * Results:
 *	Returns the Tcl_Command so created.
 *	A standard Tcl result.
 *
 * Side effects:
 *	The ensemble is initialized.
 *
 * This command is hidden in a safe interpreter.
 */

 *	See the user documentation.
Tcl_Command
TclInitEncodingCmd(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const EnsembleImplMap encodingImplMap[] = {
	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}

/*
 *----------------------------------------------------------------------
 *
 * EncodingConvertfromObjCmd --
 *
 *	This command converts a byte array in an external encoding into a
 *	Tcl string
 *
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */

int
EncodingConvertfromObjCmd(
    TCL_UNUSED(ClientData),
Tcl_EncodingObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;
    Tcl_Obj *data;		/* Byte array to convert */
    Tcl_DString ds;		/* Buffer to hold the string */
    Tcl_Encoding encoding;	/* Encoding to use */
    size_t length = 0;			/* Length of the byte array being converted */

    static const char *optionStrings[] = {
	"convertfrom", "convertto", "dirs", "names", "system",
	NULL
    };
    enum options {
	ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    const char *bytesPtr;	/* Pointer to the first byte of the array */
    switch ((enum options) index) {
    case ENC_CONVERTTO:
    case ENC_CONVERTFROM: {
	Tcl_Obj *data;
	Tcl_DString ds;
	Tcl_Encoding encoding;
	int length;
	char *stringPtr;

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	data = objv[1];
    } else if (objc == 3) {
	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
	    return TCL_ERROR;
	}
	data = objv[2];
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
	return TCL_ERROR;
    }
	if (objc == 3) {
	    encoding = Tcl_GetEncoding(interp, NULL);
	    data = objv[2];
	} else if (objc == 4) {
	    if (Tcl_GetEncodingFromObj(interp, objv[2], &encoding) != TCL_OK) {
		return TCL_ERROR;
	    }
	    data = objv[3];
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding? data");
	    return TCL_ERROR;
	}

	if ((enum options) index == ENC_CONVERTFROM) {
    /*
     * Convert the string into a byte array in 'ds'
     */
    bytesPtr = (char *) TclGetByteArrayFromObj(data, &length);
    Tcl_ExternalToUtfDString(encoding, bytesPtr, length, &ds);
	    /*
	     * Treat the string as binary data.
	     */

	    stringPtr = (char *) Tcl_GetByteArrayFromObj(data, &length);
	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);

    /*
     * Note that we cannot use Tcl_DStringResult here because it will
     * truncate the string at the first null byte.
     */
	    /*
	     * Note that we cannot use Tcl_DStringResult here because it will
	     * truncate the string at the first null byte.
	     */

    Tcl_SetObjResult(interp, TclDStringToObj(&ds));

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
    /*
     * We're done with the encoding
     */

	    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
    return TCL_OK;

	} else {
}

/*
	    /*
 *----------------------------------------------------------------------
 *
	     * Store the result as binary data.
	     */
 * EncodingConverttoObjCmd --
 *
 *	This command converts a Tcl string into a byte array that
 *	encodes the string according to some encoding.

	    stringPtr = TclGetStringFromObj(data, &length);
	    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
 *
 * Results:
 *	A standard Tcl result.
	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(
		    (unsigned char *) Tcl_DStringValue(&ds),
		    Tcl_DStringLength(&ds)));
	    Tcl_DStringFree(&ds);
 *
 *----------------------------------------------------------------------
 */

	}
int
EncodingConverttoObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *data;		/* String to convert */
    Tcl_DString ds;		/* Buffer to hold the byte array */
    Tcl_Encoding encoding;	/* Encoding to use */
    size_t length;			/* Length of the string being converted */
    const char *stringPtr;	/* Pointer to the first byte of the string */

    /* TODO - ADJUST OBJ INDICES WHEN ENSEMBLIFYING THIS */

    if (objc == 2) {
	encoding = Tcl_GetEncoding(interp, NULL);
	Tcl_FreeEncoding(encoding);
	break;
    }
    case ENC_DIRS:
	return EncodingDirsObjCmd(dummy, interp, objc, objv);
    case ENC_NAMES:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	data = objv[1];
    } else if (objc == 3) {
	if (Tcl_GetEncodingFromObj(interp, objv[1], &encoding) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_GetEncodingNames(interp);
	data = objv[2];
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?encoding? data");
	return TCL_ERROR;
    }

	break;
    case ENC_SYSTEM:
	if (objc > 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?encoding?");
	    return TCL_ERROR;
	}
	if (objc == 2) {
    /*
     * Convert the string to a byte array in 'ds'
     */

    stringPtr = TclGetStringFromObj(data, &length);
    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
    Tcl_SetObjResult(interp,
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		     Tcl_NewByteArrayObj((unsigned char*) Tcl_DStringValue(&ds),
					 Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);

		    Tcl_GetEncodingName(NULL), -1));
	} else {
	    return Tcl_SetSystemEncoding(interp, TclGetString(objv[2]));
	}
    /*
     * We're done with the encoding
	break;
     */

    }
    Tcl_FreeEncoding(encoding);
    return TCL_OK;

}

/*
 *----------------------------------------------------------------------
 *
 * EncodingDirsObjCmd --
 *
 *	This command manipulates the encoding search path.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Can set the encoding search path.
 *
 *----------------------------------------------------------------------
 */

int
EncodingDirsObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dirListObj;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "?dirList?");
	return TCL_ERROR;
    }
    if (objc == 1) {
    if (objc == 2) {
	Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
	return TCL_OK;
    }

    dirListObj = objv[1];
    dirListObj = objv[2];
    if (Tcl_SetEncodingSearchPath(dirListObj) == TCL_ERROR) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"expected directory list but got \"%s\"",
		TclGetString(dirListObj)));
	Tcl_AppendResult(interp, "expected directory list but got \"",
		TclGetString(dirListObj), "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "ENCODING", "BADPATH",
		NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirListObj);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * EncodingNamesObjCmd --
 *
 *	This command returns a list of the available encoding names
 *
 * Results:
 *	Returns a standard Tcl result
 *
 *-----------------------------------------------------------------------------
 */

int
EncodingNamesObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp* interp,	    /* Tcl interpreter */
    int objc,		    /* Number of command line args */
    Tcl_Obj* const objv[])  /* Vector of command line args */
{
    if (objc > 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_GetEncodingNames(interp);
    return TCL_OK;
}

/*
 *-----------------------------------------------------------------------------
 *
 * EncodingSystemObjCmd --
 *
 *	This command retrieves or changes the system encoding
 *
 * Results:
 *	Returns a standard Tcl result
 *
 * Side effects:
 *	May change the system encoding.
 *
 *-----------------------------------------------------------------------------
 */

int
EncodingSystemObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp* interp,     /* Tcl interpreter */
    int objc,		    /* Number of command line args */
    Tcl_Obj* const objv[])  /* Vector of command line args */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?encoding?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp,
			 Tcl_NewStringObj(Tcl_GetEncodingName(NULL), -1));
    } else {
	return Tcl_SetSystemEncoding(interp, TclGetString(objv[1]));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ErrorObjCmd --
 *
 *	This procedure is invoked to process the "error" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ErrorObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *options, *optName;

    if ((objc < 2) || (objc > 4)) {
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
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
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
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







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


-
+




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

-
-











-
-
-
-
+
+
+
+
+
+





-
-
-



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



















+


-
+




-
+








-
+


-
+
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
EvalCmdErrMsg(
    TCL_UNUSED(ClientData *),
    Tcl_Interp *interp,
    int result)
{
    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"eval\" body line %d)", Tcl_GetErrorLine(interp)));
    }
    return result;
}

	/* ARGSUSED */
int
Tcl_EvalObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNREvalObjCmd, clientData, objc, objv);
}

int
    int result;
TclNREvalObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;
    Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker = NULL;
    int word = 0;

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

    if (objc == 2) {
	/*
	 * TIP #280. Make argument location available to eval'd script.
	 */

	invoker = iPtr->cmdFramePtr;
	word = 1;
	objPtr = objv[1];
	TclArgumentGet(interp, objPtr, &invoker, &word);
	CmdFrame* invoker = iPtr->cmdFramePtr;
	int word          = 1;
	TclArgumentGet (interp, objv[1], &invoker, &word);

	result = TclEvalObjEx(interp, objv[1], TCL_EVAL_DIRECT,
		invoker, word);
    } else {
	/*
	 * More than one argument: concatenate them together with spaces
	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
	 * object when it decrements its refcount after eval'ing it.
	 *
	 * TIP #280. Make invoking context available to eval'd script, done
	 * with the default values.
	 */

	objPtr = Tcl_ConcatObj(objc-1, objv+1);
    }
    TclNRAddCallback(interp, EvalCmdErrMsg, NULL, NULL, NULL, NULL);
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);

	/*
	 * TIP #280. Make invoking context available to eval'd script.
	 */

	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
    }
    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"eval\" body line %d)", interp->errorLine));
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ExitObjCmd --
 *
 *	This procedure is invoked to process the "exit" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ExitObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_WideInt value;
    int value;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnCode?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	value = 0;
    } else if (TclGetWideBitsFromObj(interp, objv[1], &value) != TCL_OK) {
    } else if (Tcl_GetIntFromObj(interp, objv[1], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_Exit((int)value);
    Tcl_Exit(value);
    /*NOTREACHED*/
    return TCL_OK;		/* Better not ever reach this! */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ExprObjCmd --
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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











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
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
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
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
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
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







+


-
+




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






-
-

-
+
-

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





+

-
+






-
+

-
-
+
+
-
-
-
-
+
+
+










+
-
-
-
+
+
+
+
+
+

+
+
+
+

-
-
-
+

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

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

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

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

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

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

+
+
+
+
+
+
-
+
+
+
+

+
-
+


+
+
+
-
-
+
+
+
-
+

-
-
+
+
-
-




-
-
+


-
+
-
+
+
+

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

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

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

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

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

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

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







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ExprObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRExprObjCmd, clientData, objc, objv);
}

int
TclNRExprObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr, *objPtr;
    Tcl_Obj *resultPtr;
    int result;

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

    TclNewObj(resultPtr);
    Tcl_IncrRefCount(resultPtr);
    if (objc == 2) {
	objPtr = objv[1];
	result = Tcl_ExprObj(interp, objv[1], &resultPtr);
	TclNRAddCallback(interp, ExprCallback, resultPtr, NULL, NULL, NULL);
    } else {
	objPtr = Tcl_ConcatObj(objc-1, objv+1);
	Tcl_Obj *objPtr = Tcl_ConcatObj(objc-1, objv+1);
	TclNRAddCallback(interp, ExprCallback, resultPtr, objPtr, NULL, NULL);
    }

    return Tcl_NRExprObj(interp, objPtr, resultPtr);
	Tcl_IncrRefCount(objPtr);
	result = Tcl_ExprObj(interp, objPtr, &resultPtr);
}

static int
ExprCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultPtr = (Tcl_Obj *)data[0];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[1];

    if (objPtr != NULL) {
	Tcl_DecrRefCount(objPtr);
    }

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
	Tcl_DecrRefCount(resultPtr);	/* Done with the result object */
    }
    Tcl_DecrRefCount(resultPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitFileCmd --
 * Tcl_FileObjCmd --
 *
 *	This function builds the "file" Tcl command ensemble. See the user
 *	documentation for details on what that ensemble does.
 *	This procedure is invoked to process the "file" Tcl command. See the
 *	user documentation for details on what it does. PLEASE NOTE THAT THIS
 *
 *	PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH EMBEDDED
 *	NULLS. With the object-based Tcl_FS APIs, the above NOTE may no longer
 *	be true. In any case this assertion should be tested.
 *	FAILS WITH FILENAMES AND PATHS WITH EMBEDDED NULLS. With the
 *	object-based Tcl_FS APIs, the above NOTE may no longer be true. In any
 *	case this assertion should be tested.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
Tcl_Command
TclInitFileCmd(
    Tcl_Interp *interp)
int
Tcl_FileObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index, value;
    Tcl_StatBuf buf;
    struct utimbuf tval;

    /*
     * Note that most subcommands are unsafe because either they manipulate
     * the native filesystem or because they reveal information about the
     * native filesystem.
     * This list of constants should match the fileOption string array below.
     */

    static const EnsembleImplMap initMap[] = {
	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 1},
	{"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 1},
	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"join",	PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},

    static const char *fileOptions[] = {
	"atime",	"attributes",	"channels",	"copy",
	"delete",
	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 1},
	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	"dirname",	"executable",	"exists",	"extension",
	"isdirectory",	"isfile",	"join",		"link",
	"lstat",	"mtime",	"mkdir",	"nativename",
	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	"normalize",    "owned",
	"pathtype",	"readable",	"readlink",	"rename",
	"rootname",	"separator",    "size",		"split",
	"stat",		"system",
	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"tempdir",	TclFileTempDirCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
	"tail",		"type",		"volumes",	"writable",
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
	NULL
    };
    enum options {
	FCMD_ATIME,	FCMD_ATTRIBUTES, FCMD_CHANNELS,	FCMD_COPY,
	FCMD_DELETE,
	FCMD_DIRNAME,	FCMD_EXECUTABLE, FCMD_EXISTS,	FCMD_EXTENSION,
	FCMD_ISDIRECTORY, FCMD_ISFILE,	FCMD_JOIN,	FCMD_LINK,
	FCMD_LSTAT,	FCMD_MTIME,	FCMD_MKDIR,	FCMD_NATIVENAME,
    return TclMakeEnsemble(interp, "file", initMap);
}
	FCMD_NORMALIZE,	FCMD_OWNED,
	FCMD_PATHTYPE,	FCMD_READABLE,	FCMD_READLINK,	FCMD_RENAME,
	FCMD_ROOTNAME,	FCMD_SEPARATOR,	FCMD_SIZE,	FCMD_SPLIT,
	FCMD_STAT,	FCMD_SYSTEM,
	FCMD_TAIL,	FCMD_TYPE,	FCMD_VOLUMES,	FCMD_WRITABLE
    };

/*
 *----------------------------------------------------------------------
 *
 * FileAttrAccessTimeCmd --
 *
 *	This function is invoked to process the "file atime" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	return TCL_ERROR;
 *
 * Side effects:
 *	May update the access time on the file, if requested by the user.
 *
 *----------------------------------------------------------------------
 */

static int
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], fileOptions, "option", 0,
	    &index) != TCL_OK) {
FileAttrAccessTimeCmd(
    TCL_UNUSED(ClientData),
	return TCL_ERROR;
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    }

    Tcl_StatBuf buf;
    struct utimbuf tval;
    switch ((enum options) index) {

    case FCMD_ATIME:
    case FCMD_MTIME:
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
	if ((objc < 3) || (objc > 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ?time?");
	    return TCL_ERROR;
	}
	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc == 4) {
	    Tcl_WideInt newTime;
#if defined(_WIN32)
    /* We use a value of 0 to indicate the access time not available */
    if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                             "could not get access time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }

#endif

	    
    if (objc == 3) {
	/*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */

	Tcl_WideInt newTime;

	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    return TCL_ERROR;
	}
	    if (Tcl_GetWideIntFromObj(interp, objv[3], &newTime) != TCL_OK) {
		    return TCL_ERROR;
	    }

	    if (index == FCMD_ATIME) {
	tval.actime = newTime;
	tval.modtime = Tcl_GetModificationTimeFromStat(&buf);

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set access time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
		tval.actime = newTime;
		tval.modtime = buf.st_mtime;
	    } else {	/* index == FCMD_MTIME */
		tval.actime = buf.st_atime;
		tval.modtime = newTime;
	    }

	    if (Tcl_FSUtime(objv[2], &tval) != 0) {
		Tcl_AppendResult(interp, "could not set ",
			(index == FCMD_ATIME ? "access" : "modification"),
			" time for file \"", TclGetString(objv[2]), "\": ",
			Tcl_PosixError(interp), NULL);
		return TCL_ERROR;
	    }

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * atime - hopefully the same as the one we sent in. However, fs's
	 * like FAT don't even know what atime is.
	 */
	    /*
	     * Do another stat to ensure that the we return the new recognized
	     * atime - hopefully the same as the one we sent in. However, fs's
	     * like FAT don't even know what atime is.
	     */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
	    if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
		return TCL_ERROR;
	    }
	}

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(&buf)));
    return TCL_OK;
}

	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
		(index == FCMD_ATIME ? buf.st_atime : buf.st_mtime)));
	return TCL_OK;
    case FCMD_ATTRIBUTES:
	return TclFileAttrsCmd(interp, objc, objv);
    case FCMD_CHANNELS:
	if ((objc < 2) || (objc > 3)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?pattern?");
	    return TCL_ERROR;
	}
	return Tcl_GetChannelNamesEx(interp,
		((objc == 2) ? NULL : TclGetString(objv[2])));
    case FCMD_COPY:
	return TclFileCopyCmd(interp, objc, objv);
    case FCMD_DELETE:
	return TclFileDeleteCmd(interp, objc, objv);
    case FCMD_DIRNAME: {
	Tcl_Obj *dirPtr;

	if (objc != 3) {
	    goto only3Args;
	}
	dirPtr = TclPathPart(interp, objv[2], TCL_PATH_DIRNAME);
	if (dirPtr == NULL) {
	    return TCL_ERROR;
	} else {
	    Tcl_SetObjResult(interp, dirPtr);
	    Tcl_DecrRefCount(dirPtr);
	    return TCL_OK;
	}
    }
/*
 *----------------------------------------------------------------------
 *
 * FileAttrModifyTimeCmd --
 *
 *	This function is invoked to process the "file mtime" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May update the modification time on the file, if requested by the
 *	user.
    case FCMD_EXECUTABLE:
 *
 *----------------------------------------------------------------------
 */

	if (objc != 3) {
	    goto only3Args;
	}
static int
FileAttrModifyTimeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    struct utimbuf tval;

	return CheckAccess(interp, objv[2], X_OK);
    case FCMD_EXISTS:
	if (objc != 3) {
	    goto only3Args;
	}
	return CheckAccess(interp, objv[2], F_OK);
    case FCMD_EXTENSION: {
	Tcl_Obj *ext;

	if (objc != 3) {
	    goto only3Args;
	}
	ext = TclPathPart(interp, objv[2], TCL_PATH_EXTENSION);
	if (ext != NULL) {
	    Tcl_SetObjResult(interp, ext);
	    Tcl_DecrRefCount(ext);
	    return TCL_OK;
	} else {
	    return TCL_ERROR;
	}
    }
    case FCMD_ISDIRECTORY:
	if (objc != 3) {
	    goto only3Args;
	}
	value = 0;
	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
	    value = S_ISDIR(buf.st_mode);
	}
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?time?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
	return TCL_OK;
    case FCMD_ISFILE:
	if (objc != 3) {
	    goto only3Args;
	}
	value = 0;
	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
	return TCL_ERROR;
    }
	    value = S_ISREG(buf.st_mode);
	}
#if defined(_WIN32)
    /* We use a value of 0 to indicate the modification time not available */
    if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
                             "could not get modification time for file \"%s\"",
                             TclGetString(objv[1])));
        return TCL_ERROR;
    }
#endif
    if (objc == 3) {
	/*
	return TCL_OK;
    case FCMD_OWNED:
	if (objc != 3) {
	    goto only3Args;
	}
	value = 0;
	if (GetStatBuf(NULL, objv[2], Tcl_FSStat, &buf) == TCL_OK) {
	    /*
	 * Need separate variable for reading longs from an object on 64-bit
	 * platforms. [Bug 698146]
	 */
	     * For Windows, there are no user ids associated with a file, so
	     * we always return 1.
	     */

#if defined(__WIN32__) || defined(__CYGWIN__)
	    value = 1;
#else
	    value = (geteuid() == buf.st_uid);
#endif
	}
	Tcl_WideInt newTime;
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
	return TCL_OK;
    case FCMD_JOIN: {
	Tcl_Obj *resObj;

	if (objc < 3) {
	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
	    return TCL_ERROR;
	}
	resObj = Tcl_FSJoinToPath(NULL, objc - 2, objv + 2);
	Tcl_SetObjResult(interp, resObj);
	return TCL_OK;

	tval.actime = Tcl_GetAccessTimeFromStat(&buf);
    }
    case FCMD_LINK: {
	Tcl_Obj *contents;
	tval.modtime = newTime;
	int index;

	if (Tcl_FSUtime(objv[1], &tval) != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	if (objc < 3 || objc > 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-linktype? linkname ?target?");
		    "could not set modification time for file \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * Do another stat to ensure that the we return the new recognized
	 * mtime - hopefully the same as the one we sent in.
	 * Index of the 'source' argument.
	 */

	if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	if (objc == 5) {
	    return TCL_ERROR;
	    index = 3;
	} else {
	    index = 2;
	}
    }


	if (objc > 3) {
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(&buf)));
    return TCL_OK;
}

	    int linkAction;
	    if (objc == 5) {
		/*
		 * We have a '-linktype' argument.
/*
 *----------------------------------------------------------------------
 *
		 */
 * FileAttrLinkStatCmd --
 *
 *	This function is invoked to process the "file lstat" Tcl command. See
 *	the user documentation for details on what it does.
 *

		static const char *linkTypes[] = {
		    "-symbolic", "-hard", NULL
		};
		if (Tcl_GetIndexFromObj(interp, objv[2], linkTypes, "switch",
			0, &linkAction) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (linkAction == 0) {
		    linkAction = TCL_CREATE_SYMBOLIC_LINK;
		} else {
		    linkAction = TCL_CREATE_HARD_LINK;
		}
	    } else {
		linkAction = TCL_CREATE_SYMBOLIC_LINK|TCL_CREATE_HARD_LINK;
	    }
	    if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
		return TCL_ERROR;
	    }

 * Results:
 *	A standard Tcl result.
 *
	    /*
	     * Create link from source to target.
	     */
 * Side effects:
 *	Writes to an array named by the user.
 *

 *----------------------------------------------------------------------
 */
	    contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
	    if (contents == NULL) {
		/*
		 * We handle three common error cases specially, and for all
		 * other errors, we use the standard posix error message.
		 */

static int
FileAttrLinkStatCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
		if (errno == EEXIST) {
		    Tcl_AppendResult(interp, "could not create new link \"",
			    TclGetString(objv[index]),
			    "\": that path already exists", NULL);
		} else if (errno == ENOENT) {
		    /*
		     * There are two cases here: either the target doesn't
		     * exist, or the directory of the src doesn't exist.
		     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
    return StoreStatData(interp, objv[2], &buf);
}

		    int access;
		    Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
			    TCL_PATH_DIRNAME);

		    if (dirPtr == NULL) {
			return TCL_ERROR;
		    }
		    access = Tcl_FSAccess(dirPtr, F_OK);
		    Tcl_DecrRefCount(dirPtr);
		    if (access != 0) {
			Tcl_AppendResult(interp,
				"could not create new link \"",
				TclGetString(objv[index]),
				"\": no such file or directory", NULL);
		    } else {
			Tcl_AppendResult(interp,
				"could not create new link \"",
				TclGetString(objv[index]), "\": target \"",
				TclGetString(objv[index+1]),
				"\" doesn't exist", NULL);
		    }
		} else {
/*
 *----------------------------------------------------------------------
 *
 * FileAttrStatCmd --
 *
 *	This function is invoked to process the "file stat" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
		    Tcl_AppendResult(interp,
 *	A standard Tcl result.
 *
 * Side effects:
 *	Writes to an array named by the user.
 *
 *----------------------------------------------------------------------
 */

			    "could not create new link \"",
			    TclGetString(objv[index]), "\" pointing to \"",
			    TclGetString(objv[index+1]), "\": ",
			    Tcl_PosixError(interp), NULL);
		}
static int
FileAttrStatCmd(
    TCL_UNUSED(ClientData),
		return TCL_ERROR;
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
	    }
	} else {
	    if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
		return TCL_ERROR;
	    }

    Tcl_StatBuf buf;
	    /*
	     * Read link
	     */

	    contents = Tcl_FSLink(objv[index], NULL, 0);
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name varName");
	return TCL_ERROR;
    }
	    if (contents == NULL) {
		Tcl_AppendResult(interp, "could not read link \"",
			TclGetString(objv[index]), "\": ",
			Tcl_PosixError(interp), NULL);
		return TCL_ERROR;
	    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
    return StoreStatData(interp, objv[2], &buf);
}

	}
	Tcl_SetObjResult(interp, contents);
	if (objc == 3) {
	    /*
	     * If we are reading a link, we need to free this result refCount.
	     * If we are creating a link, this will just be objv[index+1], and
	     * so we don't own it.
	     */

	    Tcl_DecrRefCount(contents);
	}
	return TCL_OK;
    }
/*
 *----------------------------------------------------------------------
 *
 * FileAttrTypeCmd --
    case FCMD_LSTAT:
 *
 *	This function is invoked to process the "file type" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name varName");
	    return TCL_ERROR;
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
	}
	if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
FileAttrTypeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
	    return TCL_ERROR;
	}
	return StoreStatData(interp, objv[3], &buf);
    case FCMD_STAT:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name varName");
{
    Tcl_StatBuf buf;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    GetTypeFromMode((unsigned short) buf.st_mode), -1));
    return TCL_OK;
	    return TCL_ERROR;
	}
	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
	return StoreStatData(interp, objv[3], &buf);
    case FCMD_SIZE:
	if (objc != 3) {
	    goto only3Args;
	}
	if (GetStatBuf(interp, objv[2], Tcl_FSStat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp,
		Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
	return TCL_OK;
    case FCMD_TYPE:
	if (objc != 3) {
	    goto only3Args;
	}
	if (GetStatBuf(interp, objv[2], Tcl_FSLstat, &buf) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		GetTypeFromMode((unsigned short) buf.st_mode), -1));
	return TCL_OK;
}

    case FCMD_MKDIR:
/*
 *----------------------------------------------------------------------
 *
 * FileAttrSizeCmd --
 *
 *	This function is invoked to process the "file size" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrSizeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ?name ...?");
	return TCL_ERROR;
    }
    if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) buf.st_size));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrIsDirectoryCmd --
 *
 *	This function is invoked to process the "file isdirectory" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsDirectoryCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    int value = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
	value = S_ISDIR(buf.st_mode);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrIsExecutableCmd --
 *
 *	This function is invoked to process the "file executable" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsExecutableCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], X_OK);
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrIsExistingCmd --
 *
 *	This function is invoked to process the "file exists" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsExistingCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], F_OK);
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrIsFileCmd --
 *
 *	This function is invoked to process the "file isfile" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsFileCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_StatBuf buf;
    int value = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
	    return TCL_ERROR;
	}
    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
	value = S_ISREG(buf.st_mode);
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
	return TclFileMakeDirsCmd(interp, objc, objv);
}

    case FCMD_NATIVENAME: {
/*
 *----------------------------------------------------------------------
 *
 * FileAttrIsOwnedCmd --
 *
 *	This function is invoked to process the "file owned" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	const char *fileName;
static int
FileAttrIsOwnedCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
#ifdef __CYGWIN__
#define geteuid() (short)(geteuid)()
#endif
#if !defined(_WIN32)
    Tcl_StatBuf buf;
#endif
    int value = 0;

	Tcl_DString ds;
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
#if defined(_WIN32)
    value = TclWinFileOwned(objv[1]);
#else
    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
	value = (geteuid() == buf.st_uid);
    }
#endif
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrIsReadableCmd --
 *
 *	This function is invoked to process the "file readable" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsReadableCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], R_OK);
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrIsWritableCmd --
 *
 *	This function is invoked to process the "file writable" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileAttrIsWritableCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    return CheckAccess(interp, objv[1], W_OK);
}

/*
 *----------------------------------------------------------------------
 *
 * PathDirNameCmd --
 *
 *	This function is invoked to process the "file dirname" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathDirNameCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_DIRNAME);
    if (dirPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirPtr);
    Tcl_DecrRefCount(dirPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathExtensionCmd --
 *
 *	This function is invoked to process the "file extension" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathExtensionCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_EXTENSION);
    if (dirPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirPtr);
    Tcl_DecrRefCount(dirPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

 * PathRootNameCmd --
 *
 *	This function is invoked to process the "file root" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathRootNameCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirPtr;

    if (objc != 2) {
	if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_ROOT);
    if (dirPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirPtr);
    Tcl_DecrRefCount(dirPtr);
    return TCL_OK;
}

	    goto only3Args;
/*
 *----------------------------------------------------------------------
 *
 * PathTailCmd --
 *
 *	This function is invoked to process the "file tail" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	}
static int
PathTailCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
	fileName = TclGetString(objv[2]);
{
    Tcl_Obj *dirPtr;

	fileName = Tcl_TranslateFileName(interp, fileName, &ds);
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    dirPtr = TclPathPart(interp, objv[1], TCL_PATH_TAIL);
    if (dirPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirPtr);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(fileName,
    Tcl_DecrRefCount(dirPtr);
    return TCL_OK;
}

		Tcl_DStringLength(&ds)));
/*
 *----------------------------------------------------------------------
 *
 * PathFilesystemCmd --
 *
 *	This function is invoked to process the "file system" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	Tcl_DStringFree(&ds);
static int
PathFilesystemCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *fsInfo;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    fsInfo = Tcl_FSFileSystemInfo(objv[1]);
    if (fsInfo == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unrecognised path", -1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
		TclGetString(objv[1]), NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, fsInfo);
    return TCL_OK;
}

	return TCL_OK;
    }
    case FCMD_NORMALIZE: {
/*
 *----------------------------------------------------------------------
 *
 * PathJoinCmd --
 *
 *	This function is invoked to process the "file join" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathJoinCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
	Tcl_Obj *fileName;
{
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclJoinPath(objc - 1, objv + 1, 0));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathNativeNameCmd --
 *
 *	This function is invoked to process the "file nativename" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathNativeNameCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_DString ds;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "filename");
	    return TCL_ERROR;
	}
    if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclDStringToObj(&ds));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathNormalizeCmd --
 *
 *	This function is invoked to process the "file normalize" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathNormalizeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *fileName;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    fileName = Tcl_FSGetNormalizedPath(interp, objv[1]);
    if (fileName == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, fileName);
    return TCL_OK;
}

	fileName = Tcl_FSGetNormalizedPath(interp, objv[2]);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, fileName);
	return TCL_OK;
    }
    case FCMD_PATHTYPE: {
/*
 *----------------------------------------------------------------------
 *
 * PathSplitCmd --
 *
 *	This function is invoked to process the "file split" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PathSplitCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *res;
	Tcl_Obj *typeName;

    if (objc != 2) {
	if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    res = Tcl_FSSplitPath(objv[1], NULL);
    if (res == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": no such file or directory",
		TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PATHSPLIT", "NONESUCH",
		NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

	    goto only3Args;
/*
 *----------------------------------------------------------------------
 *
 * PathTypeCmd --
 *
 *	This function is invoked to process the "file pathtype" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	}
static int
PathTypeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{

    Tcl_Obj *typeName;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    switch (Tcl_FSGetPathType(objv[1])) {
    case TCL_PATH_ABSOLUTE:
	TclNewLiteralStringObj(typeName, "absolute");
	break;
    case TCL_PATH_RELATIVE:
	TclNewLiteralStringObj(typeName, "relative");
	break;
    case TCL_PATH_VOLUME_RELATIVE:
	TclNewLiteralStringObj(typeName, "volumerelative");
	break;
    default:
	switch (Tcl_FSGetPathType(objv[2])) {
	case TCL_PATH_ABSOLUTE:
	    TclNewLiteralStringObj(typeName, "absolute");
	    break;
	case TCL_PATH_RELATIVE:
	    TclNewLiteralStringObj(typeName, "relative");
	    break;
	case TCL_PATH_VOLUME_RELATIVE:
	    TclNewLiteralStringObj(typeName, "volumerelative");
	    break;
	default:
	/* Should be unreachable */
	return TCL_OK;
    }
    Tcl_SetObjResult(interp, typeName);
    return TCL_OK;
}

/*
	    return TCL_OK;
	}
	Tcl_SetObjResult(interp, typeName);
	return TCL_OK;
    }
    case FCMD_READABLE:
	if (objc != 3) {
	    goto only3Args;
	}
	return CheckAccess(interp, objv[2], R_OK);
    case FCMD_READLINK: {
	Tcl_Obj *contents;
 *----------------------------------------------------------------------
 *
 * FilesystemSeparatorCmd --
 *

	if (objc != 3) {
	    goto only3Args;
	}

 *	This function is invoked to process the "file separator" Tcl command.
 *	See the user documentation for details on what it does.
 *
	if (Tcl_FSConvertToPathType(interp, objv[2]) != TCL_OK) {
	    return TCL_ERROR;
	}

 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
	contents = Tcl_FSLink(objv[2], NULL, 0);

	if (contents == NULL) {
	    Tcl_AppendResult(interp, "could not readlink \"",
		    TclGetString(objv[2]), "\": ", Tcl_PosixError(interp),
		    NULL);
 *
 *----------------------------------------------------------------------
 */

	    return TCL_ERROR;
	}
static int
FilesystemSeparatorCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
	Tcl_SetObjResult(interp, contents);
    int objc,
    Tcl_Obj *const objv[])
	Tcl_DecrRefCount(contents);
{
    if (objc < 1 || objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	const char *separator = NULL;
	return TCL_OK;
    }
    case FCMD_RENAME:
	return TclFileRenameCmd(interp, objc, objv);
    case FCMD_ROOTNAME: {
	Tcl_Obj *root;

	if (objc != 3) {
	    goto only3Args;
	}
	root = TclPathPart(interp, objv[2], TCL_PATH_ROOT);
	if (root != NULL) {
	    Tcl_SetObjResult(interp, root);
	    Tcl_DecrRefCount(root);
	    return TCL_OK;
	} else {
	    return TCL_ERROR;
	}
    }
    case FCMD_SEPARATOR:
	if ((objc < 2) || (objc > 3)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?name?");
	    return TCL_ERROR;
	}
	if (objc == 2) {
	    const char *separator = NULL; /* lint */

	switch (tclPlatform) {
	case TCL_PLATFORM_UNIX:
	    separator = "/";
	    break;
	case TCL_PLATFORM_WINDOWS:
	    separator = "\\";
	    break;
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
    } else {
	Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[1]);
	    switch (tclPlatform) {
	    case TCL_PLATFORM_UNIX:
		separator = "/";
		break;
	    case TCL_PLATFORM_WINDOWS:
		separator = "\\";
		break;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(separator, 1));
	} else {
	    Tcl_Obj *separatorObj = Tcl_FSPathSeparator(objv[2]);

	if (separatorObj == NULL) {
	    if (separatorObj == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unrecognised path", -1));
		Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "FILESYSTEM",
		    TclGetString(objv[1]), NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, separatorObj);
    }
    return TCL_OK;
}

		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, separatorObj);
	}
	return TCL_OK;
    case FCMD_SPLIT: {
	Tcl_Obj *res;

	if (objc != 3) {
	    goto only3Args;
	}
/*
 *----------------------------------------------------------------------
 *
 * FilesystemVolumesCmd --
	res = Tcl_FSSplitPath(objv[2], NULL);
	if (res == NULL) {
 *
 *	This function is invoked to process the "file volumes" Tcl command.
 *	See the user documentation for details on what it does.
	    /* How can the interp be NULL here?! DKF */
 *
 * Results:
 *	A standard Tcl result.
 *
	    if (interp != NULL) {
		Tcl_AppendResult(interp, "could not read \"",
			TclGetString(objv[2]),
			"\": no such file or directory", NULL);
	    }
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, res);
	return TCL_OK;
    }
    case FCMD_SYSTEM: {
	Tcl_Obj *fsInfo;

 * Side effects:
 *	None.
	if (objc != 3) {
	    goto only3Args;
 *
 *----------------------------------------------------------------------
 */

static int
	}
	fsInfo = Tcl_FSFileSystemInfo(objv[2]);
	if (fsInfo == NULL) {
	    Tcl_SetResult(interp, "Unrecognised path", TCL_STATIC);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, fsInfo);
	return TCL_OK;
    }
    case FCMD_TAIL: {
FilesystemVolumesCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_FSListVolumes());
    return TCL_OK;
	Tcl_Obj *dirPtr;

	if (objc != 3) {
	    goto only3Args;
	}
	dirPtr = TclPathPart(interp, objv[2], TCL_PATH_TAIL);
	if (dirPtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, dirPtr);
	Tcl_DecrRefCount(dirPtr);
	return TCL_OK;
    }
    case FCMD_VOLUMES:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_FSListVolumes());
	return TCL_OK;
    case FCMD_WRITABLE:
	if (objc != 3) {
	    goto only3Args;
	}
	return CheckAccess(interp, objv[2], W_OK);
    }

  only3Args:
    Tcl_WrongNumArgs(interp, 2, objv, "name");
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * CheckAccess --
 *
2053
2054
2055
2056
2057
2058
2059
2060

2061
2062
2063
2064
2065
2066



2067
2068
2069
2070
2071
2072
2073
1441
1442
1443
1444
1445
1446
1447

1448
1449
1450
1451



1452
1453
1454
1455
1456
1457
1458
1459
1460
1461







-
+



-
-
-
+
+
+







{
    int status;

    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    status = statProc(pathPtr, statPtr);
    status = (*statProc)(pathPtr, statPtr);

    if (status < 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(pathPtr), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
2094
2095
2096
2097
2098
2099
2100
2101

2102
2103
2104
2105
2106
2107
2108
1482
1483
1484
1485
1486
1487
1488

1489
1490
1491
1492
1493
1494
1495
1496







-
+







    Tcl_Interp *interp,		/* Interpreter for error reports. */
    Tcl_Obj *varName,		/* Name of associative array variable in which
				 * to store stat results. */
    Tcl_StatBuf *statPtr)	/* Pointer to buffer containing stat data to
				 * store in varName. */
{
    Tcl_Obj *field, *value;
    unsigned short mode;
    register unsigned short mode;

    /*
     * Assume Tcl_ObjSetVar2() does not keep a copy of the field name!
     *
     * Might be a better idea to call Tcl_SetVar2Ex() instead, except we want
     * to have an object (i.e. possibly cached) array variable name but a
     * string element name, so no API exists. Messy.
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
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
1531
1532
1533
1534
1535
1536
1537







-
+


-
+

-
-
-
+
+
+





-
+

-
-
-
+
+
+

-
+







	TclDecrRefCount(field);						\
	return TCL_ERROR;						\
    }									\
    TclDecrRefCount(field);

    /*
     * Watch out porters; the inode is meant to be an *unsigned* value, so the
     * cast might fail when there isn't a real arithmetic 'long long' type...
     * cast might fail when there isn't a real arithmentic 'long long' type...
     */

    STORE_ARY("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
    STORE_ARY("dev",	Tcl_NewLongObj((long)statPtr->st_dev));
    STORE_ARY("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
    STORE_ARY("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
    STORE_ARY("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
    STORE_ARY("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
    STORE_ARY("nlink",	Tcl_NewLongObj((long)statPtr->st_nlink));
    STORE_ARY("uid",	Tcl_NewLongObj((long)statPtr->st_uid));
    STORE_ARY("gid",	Tcl_NewLongObj((long)statPtr->st_gid));
    STORE_ARY("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    STORE_ARY("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
    STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
    STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
#endif
    STORE_ARY("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
    STORE_ARY("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
    STORE_ARY("atime",	Tcl_NewWideIntObj(statPtr->st_atime));
    STORE_ARY("mtime",	Tcl_NewWideIntObj(statPtr->st_mtime));
    STORE_ARY("ctime",	Tcl_NewWideIntObj(statPtr->st_ctime));
    mode = (unsigned short) statPtr->st_mode;
    STORE_ARY("mode",	Tcl_NewWideIntObj(mode));
    STORE_ARY("mode",	Tcl_NewIntObj(mode));
    STORE_ARY("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY

    return TCL_OK;
}

/*
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
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






2658
2659
2660
2661

2662
2663

2664
2665


2666
2667
2668
2669
2670
2671
2672
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
2709

2710
2711
2712
2713
2714




2715
2716
2717


2718
2719
2720
2721

2722
2723



2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742

2743
2744
2745

2746
2747
2748
2749
2750
2751
2752
2753

2754
2755
2756
2757
2758
2759
2760
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
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





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
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



+


-
+




-
-
-
+
-
-
-
-
-
-
-

-






-
-
-
-
-
-
-
-
-




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




-


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

-
-
-
+
+
+



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





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






-
+













+


-
+




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









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


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

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





+

+
-
-
+
+



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




-
-
+
+



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

+
-
+
-


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

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

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

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

-
-
+
+


-
-
+
-
-
+
+
+



















+


-
+







-
+







 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 * Notes:
 *	This command is split into a lot of pieces so that it can avoid doing
 *	reentrant TEBC calls. This makes things rather hard to follow, but
 *	here's the plan:
 *
 *	NR:	---------------_\
 *	Direct:	Tcl_ForObjCmd -> TclNRForObjCmd
 *					|
 *				ForSetupCallback
 *					|
 *	[while] ------------> TclNRForIterCallback <---------.
 *					|		     |
 *				 ForCondCallback	     |
 *					|		     |
 *				 ForNextCallback ------------|
 *					|		     |
 *			       ForPostNextCallback	     |
 *					|____________________|
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ForObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRForObjCmd, clientData, objc, objv);
}

    int result, value;
int
TclNRForObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "start test next command");
	return TCL_ERROR;
    }

    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
    iterPtr->cond = objv[2];
    iterPtr->body = objv[4];
    iterPtr->next = objv[3];
    iterPtr->msg  = "\n    (\"for\" body line %d)";
    iterPtr->word = 4;

    TclNRAddCallback(interp, ForSetupCallback, iterPtr, NULL, NULL, NULL);

    /*
     * TIP #280. Make invoking context available to initial script.
     */

    return TclNREvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
    result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
}

static int
ForSetupCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = (ForIterData *)data[0];

    if (result != TCL_OK) {
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" initial command)");
	}
	TclSmallFreeEx(interp, iterPtr);
	return result;
    }
    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
    return TCL_OK;
}

    while (1) {
int
TclNRForIterCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *boolObj;

    switch (result) {
    case TCL_OK:
    case TCL_CONTINUE:
	/*
	 * We need to reset the result before evaluating the expression.
	 * Otherwise, any error message will be appended to the result of the
	 * last evaluation.
	 * We need to reset the result before passing it off to
	 * Tcl_ExprBooleanObj. Otherwise, any error message will be appended
	 * to the result of the last evaluation.
	 */

	Tcl_ResetResult(interp);
	TclNewObj(boolObj);
	TclNRAddCallback(interp, ForCondCallback, iterPtr, boolObj, NULL,
		NULL);
	return Tcl_NRExprObj(interp, iterPtr->cond, boolObj);
    case TCL_BREAK:
	result = TCL_OK;
	result = Tcl_ExprBooleanObj(interp, objv[2], &value);
	Tcl_ResetResult(interp);
	break;
    case TCL_ERROR:
	if (result != TCL_OK) {
	Tcl_AppendObjToErrorInfo(interp,
		Tcl_ObjPrintf(iterPtr->msg, Tcl_GetErrorLine(interp)));
    }
    TclSmallFreeEx(interp, iterPtr);
    return result;
}

	    return result;
	}
	if (!value) {
	    break;
	}
static int
ForCondCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{

    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *boolObj = (Tcl_Obj *)data[1];
    int value;

	/*
    if (result != TCL_OK) {
	Tcl_DecrRefCount(boolObj);
	TclSmallFreeEx(interp, iterPtr);
	return result;
    } else if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
	Tcl_DecrRefCount(boolObj);
	 * TIP #280. Make invoking context available to loop body.
	 */
	TclSmallFreeEx(interp, iterPtr);
	return TCL_ERROR;
    }

    Tcl_DecrRefCount(boolObj);

    if (value) {
	result = TclEvalObjEx(interp, objv[4], 0, iPtr->cmdFramePtr, 4);
	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
	/* TIP #280. */
	if (iterPtr->next) {
	    if (result == TCL_ERROR) {
	    TclNRAddCallback(interp, ForNextCallback, iterPtr, NULL, NULL,
		    NULL);
	} else {
	    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    NULL, NULL);
	}
	return TclNREvalObjEx(interp, iterPtr->body, 0, iPtr->cmdFramePtr,
		iterPtr->word);
    }
    TclSmallFreeEx(interp, iterPtr);
			"\n    (\"for\" body line %d)", interp->errorLine));
    return result;
}

	    }
	    break;
static int
ForNextCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ForIterData *iterPtr = (ForIterData *)data[0];
    Tcl_Obj *next = iterPtr->next;

	}
    if ((result == TCL_OK) || (result == TCL_CONTINUE)) {
	TclNRAddCallback(interp, ForPostNextCallback, iterPtr, NULL, NULL,
		NULL);

	/*
	 * TIP #280. Make invoking context available to next script.
	 */

	return TclNREvalObjEx(interp, next, 0, iPtr->cmdFramePtr, 3);
    }
	result = TclEvalObjEx(interp, objv[3], 0, iPtr->cmdFramePtr, 3);
	if (result == TCL_BREAK) {
	    break;
	} else if (result != TCL_OK) {
	    if (result == TCL_ERROR) {
		Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
	    }

    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
    return result;
}

	    return result;
	}
    }
static int
ForPostNextCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
    if (result == TCL_BREAK) {
	result = TCL_OK;
{
    ForIterData *iterPtr = (ForIterData *)data[0];

    }
    if ((result != TCL_BREAK) && (result != TCL_OK)) {
	if (result == TCL_ERROR) {
    if (result == TCL_OK) {
	    Tcl_AddErrorInfo(interp, "\n    (\"for\" loop-end command)");
	    TclSmallFreeEx(interp, iterPtr);
	}
	Tcl_ResetResult(interp);
    }
	return result;
    }
    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL, NULL, NULL);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ForeachObjCmd, TclNRForeachCmd, EachloopCmd --
 * Tcl_ForeachObjCmd --
 *
 *	This object-based procedure is invoked to process the "foreach" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ForeachObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRForeachCmd, clientData, objc, objv);
}

    int result = TCL_OK;
int
TclNRForeachCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv);
}

    int i;			/* i selects a value list */
int
Tcl_LmapObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    int j, maxj;		/* Number of loop iterations */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRLmapCmd, clientData, objc, objv);
}

    int v;			/* v selects a loop variable */
int
TclNRLmapCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
    int numLists = (objc-2)/2;	/* Count of value lists */
    Tcl_Obj *bodyPtr;
{
    return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv);
}

    Interp *iPtr = (Interp *) interp;

    int *index;			/* Array of value list indices */
static int
EachloopCmd(
    int *varcList;		/* # loop variables per list */
    Tcl_Interp *interp,		/* Our context for variables and script
				 * evaluation. */
    int collect,		/* Select collecting or accumulating mode
				 * (TCL_EACH_*) */
    int objc,			/* The arguments being passed in... */
    Tcl_Obj *const objv[])
    Tcl_Obj ***varvList;	/* Array of var name lists */
    Tcl_Obj **vCopyList;	/* Copies of var name list arguments */
    int *argcList;		/* Array of value list sizes */
    Tcl_Obj ***argvList;	/* Array of value lists */
{
    int numLists = (objc-2) / 2;
    Tcl_Obj **aCopyList;	/* Copies of value list arguments */
    struct ForeachState *statePtr;
    int i, j, result;

    if (objc < 4 || (objc%2 != 0)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"varList list ?varList list ...? command");
	return TCL_ERROR;
    }

    /*
     * Manage numList parallel value lists.
     * statePtr->argvList[i] is a value list counted by statePtr->argcList[i];
     * statePtr->varvList[i] is the list of variables associated with the
     * argvList[i] is a value list counted by argcList[i]l;
     * varvList[i] is the list of variables associated with the value list;
     *		value list;
     * statePtr->varcList[i] is the number of variables associated with the
     * varcList[i] is the number of variables associated with the value list;
     *		value list;
     * statePtr->index[i] is the current pointer into the value list
     * index[i] is the current pointer into the value list argvList[i].
     *		statePtr->argvList[i].
     *
     * The setting up of all of these pointers is moderately messy, but allows
     * the rest of this code to be simple and for us to use a single memory
     * allocation for better performance.
     */

    statePtr = (struct ForeachState *)TclStackAlloc(interp,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    index = (int *) TclStackAlloc(interp, 3 * numLists * sizeof(int));
    varcList = index + numLists;
    argcList = varcList + numLists;
    memset(statePtr, 0,
	    sizeof(struct ForeachState) + 3 * numLists * sizeof(int)
	    + 2 * numLists * (sizeof(Tcl_Obj **) + sizeof(Tcl_Obj *)));
    statePtr->varvList = (Tcl_Obj ***) (statePtr + 1);
    statePtr->argvList = statePtr->varvList + numLists;
    memset(index, 0, 3 * numLists * sizeof(int));

    varvList = (Tcl_Obj ***)
	    TclStackAlloc(interp, 2 * numLists * sizeof(Tcl_Obj **));
    statePtr->vCopyList = (Tcl_Obj **) (statePtr->argvList + numLists);
    statePtr->aCopyList = statePtr->vCopyList + numLists;
    statePtr->index = (int *) (statePtr->aCopyList + numLists);
    statePtr->varcList = statePtr->index + numLists;
    argvList = varvList + numLists;
    memset(varvList, 0, 2 * numLists * sizeof(Tcl_Obj **));
    statePtr->argcList = statePtr->varcList + numLists;

    statePtr->numLists = numLists;
    vCopyList = (Tcl_Obj **)
    statePtr->bodyPtr = objv[objc - 1];
    statePtr->bodyIdx = objc - 1;

	    TclStackAlloc(interp, 2 * numLists * sizeof(Tcl_Obj *));
    if (collect == TCL_EACH_COLLECT) {
	statePtr->resultList = Tcl_NewListObj(0, NULL);
    aCopyList = vCopyList + numLists;
    } else {
	statePtr->resultList = NULL;
    memset(vCopyList, 0, 2 * numLists * sizeof(Tcl_Obj *));
    }

    /*
     * Break up the value lists and variable lists into elements.
     */

    maxj = 0;
    for (i=0 ; i<numLists ; i++) {

	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
	if (statePtr->vCopyList[i] == NULL) {
	vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
	if (vCopyList[i] == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->vCopyList[i],
	TclListObjGetElements(NULL, vCopyList[i], &varcList[i], &varvList[i]);
		&statePtr->varcList[i], &statePtr->varvList[i]);
	if (statePtr->varcList[i] < 1) {
	if (varcList[i] < 1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s varlist is empty",
	    Tcl_AppendResult(interp, "foreach varlist is empty", NULL);
		    (statePtr->resultList != NULL ? "lmap" : "foreach")));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION",
		    (statePtr->resultList != NULL ? "LMAP" : "FOREACH"),
		    "NEEDVARS", NULL);
	    result = TCL_ERROR;
	    goto done;
	}

	statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
	if (statePtr->aCopyList[i] == NULL) {
	aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
	if (aCopyList[i] == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}
	TclListObjGetElements(NULL, statePtr->aCopyList[i],
	TclListObjGetElements(NULL, aCopyList[i], &argcList[i], &argvList[i]);
		&statePtr->argcList[i], &statePtr->argvList[i]);

	j = statePtr->argcList[i] / statePtr->varcList[i];
	if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) {
	    j++;
	}
	if (j > statePtr->maxj) {
	    statePtr->maxj = j;
	}
    }

    /*
     * If there is any work to do, assign the variables and set things going
     * non-recursively.
     */

    if (statePtr->maxj > 0) {
	result = ForeachAssignments(interp, statePtr);
	if (result == TCL_ERROR) {
	    goto done;
	}

	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
	return TclNREvalObjEx(interp, objv[objc-1], 0,
		((Interp *) interp)->cmdFramePtr, objc-1);
    }


	j = argcList[i] / varcList[i];
    /*
     * This cleanup stage is only used when an error occurs during setup or if
     * there is no work to do.
     */

	if ((argcList[i] % varcList[i]) != 0) {
    result = TCL_OK;
  done:
    ForeachCleanup(interp, statePtr);
    return result;
}

	    j++;
	}
	if (j > maxj) {
	    maxj = j;
	}
/*
 * Post-body processing handler.
 */

    }
static int
ForeachLoopStep(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{

    struct ForeachState *statePtr = (struct ForeachState *)data[0];

    /*
     * Iterate maxj times through the lists in parallel. If some value lists
     * Process the result code from this run of the [foreach] body. Note that
     * run out of values, set loop vars to ""
     * this switch uses fallthroughs in several places. Maintainer aware!
     */

    switch (result) {
    case TCL_CONTINUE:
	result = TCL_OK;
    bodyPtr = objv[objc-1];
	break;
    case TCL_OK:
	if (statePtr->resultList != NULL) {
    for (j=0 ; j<maxj ; j++) {
	for (i=0 ; i<numLists ; i++) {
	    Tcl_ListObjAppendElement(interp, statePtr->resultList,
		    Tcl_GetObjResult(interp));
	    for (v=0 ; v<varcList[i] ; v++) {
		int k = index[i]++;
	}
	break;
    case TCL_BREAK:
	result = TCL_OK;
	goto finish;
    case TCL_ERROR:
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		Tcl_Obj *valuePtr, *varValuePtr;
		"\n    (\"%s\" body line %d)",
		(statePtr->resultList != NULL ? "lmap" : "foreach"),
		Tcl_GetErrorLine(interp)));
    default:
	goto done;
    }


		if (k < argcList[i]) {
    /*
     * Test if there is work still to be done. If so, do the next round of
     * variable assignments, reschedule ourselves and run the body again.
     */

		    valuePtr = argvList[i][k];
    if (statePtr->maxj > ++statePtr->j) {
	result = ForeachAssignments(interp, statePtr);
	if (result == TCL_ERROR) {
	    goto done;
	}

		} else {
		    valuePtr = Tcl_NewObj(); /* Empty string */
	TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL);
	return TclNREvalObjEx(interp, statePtr->bodyPtr, 0,
		((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx);
    }

		}
		varValuePtr = Tcl_ObjSetVar2(interp, varvList[i][v], NULL,
    /*
     * We're done. Tidy up our work space and finish off.
     */

			valuePtr, TCL_LEAVE_ERR_MSG);
  finish:
    if (statePtr->resultList == NULL) {
	Tcl_ResetResult(interp);
		if (varValuePtr == NULL) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
    } else {
	Tcl_SetObjResult(interp, statePtr->resultList);
	statePtr->resultList = NULL;	/* Don't clean it up */
    }

			    "\n    (setting foreach loop variable \"%s\")",
			    TclGetString(varvList[i][v])));
		    result = TCL_ERROR;
		    goto done;
		}
	    }
  done:
    ForeachCleanup(interp, statePtr);
    return result;
}
	}

/*
	/*
 * Factored out code to do the assignments in [foreach].
 */
	 * TIP #280. Make invoking context available to loop body.
	 */

static inline int
ForeachAssignments(
    Tcl_Interp *interp,
    struct ForeachState *statePtr)
{
    int i, v, k;
    Tcl_Obj *valuePtr, *varValuePtr;

    for (i=0 ; i<statePtr->numLists ; i++) {
	for (v=0 ; v<statePtr->varcList[i] ; v++) {
	    k = statePtr->index[i]++;

	result = TclEvalObjEx(interp, bodyPtr, 0, iPtr->cmdFramePtr, objc-1);
	    if (k < statePtr->argcList[i]) {
		valuePtr = statePtr->argvList[i][k];
	    } else {
	if (result != TCL_OK) {
	    if (result == TCL_CONTINUE) {
		result = TCL_OK;
	    } else if (result == TCL_BREAK) {
		TclNewObj(valuePtr);	/* Empty string */
	    }

		result = TCL_OK;
	    varValuePtr = Tcl_ObjSetVar2(interp, statePtr->varvList[i][v],
		    NULL, valuePtr, TCL_LEAVE_ERR_MSG);

	    if (varValuePtr == NULL) {
		break;
	    } else if (result == TCL_ERROR) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (setting %s loop variable \"%s\")",
			"\n    (\"foreach\" body line %d)",
			(statePtr->resultList != NULL ? "lmap" : "foreach"),
			TclGetString(statePtr->varvList[i][v])));
		return TCL_ERROR;
	    }
	}
    }
			interp->errorLine));
		break;
	    } else {
		break;
	    }
	}

    return TCL_OK;
}

    }
    if (result == TCL_OK) {
/*
 * Factored out code for cleaning up the state of the foreach.
 */

	Tcl_ResetResult(interp);
    }
static inline void
ForeachCleanup(
    Tcl_Interp *interp,
    struct ForeachState *statePtr)
{

    int i;

    for (i=0 ; i<statePtr->numLists ; i++) {
	if (statePtr->vCopyList[i]) {
	    TclDecrRefCount(statePtr->vCopyList[i]);
  done:
    for (i=0 ; i<numLists ; i++) {
	if (vCopyList[i]) {
	    Tcl_DecrRefCount(vCopyList[i]);
	}
	if (statePtr->aCopyList[i]) {
	    TclDecrRefCount(statePtr->aCopyList[i]);
	if (aCopyList[i]) {
	    Tcl_DecrRefCount(aCopyList[i]);
	}
    }
    if (statePtr->resultList != NULL) {
	TclDecrRefCount(statePtr->resultList);
    TclStackFree(interp, vCopyList);	/* Tcl_Obj * arrays */
    }
    TclStackFree(interp, statePtr);
    TclStackFree(interp, varvList);	/* Tcl_Obj ** arrays */
    TclStackFree(interp, index);	/* int arrays */
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FormatObjCmd --
 *
 *	This procedure is invoked to process the "format" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FormatObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *resultPtr;		/* Where result is stored finally. */

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

    resultPtr = Tcl_Format(interp, TclGetString(objv[1]), objc-2, objv+2);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }

Changes to generic/tclCmdIL.c.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







/*
 * tclCmdIL.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters I through L. It
 *	contains only commands in the generic core (i.e., those that don't
 *	contains only commands in the generic core (i.e. those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
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
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







-
-
-
+
+
+


-
-
+
+
-
-
-



















-
+







-
-
+
+
-







/*
 * During execution of the "lsort" command, structures of the following type
 * are used to arrange the objects being sorted into a collection of linked
 * lists.
 */

typedef struct SortElement {
    union {			/* The value that we sorting by. */
	const char *strValuePtr;
	Tcl_WideInt wideValue;
    union {
	char *strValuePtr;
	long   intValue;
	double doubleValue;
	Tcl_Obj *objValuePtr;
    } collationKey;
    union {			/* Object being sorted, or its index. */
    } index;
    Tcl_Obj *objPtr;	        /* Object being sorted, or its index. */
	Tcl_Obj *objPtr;
	size_t index;
    } payload;
    struct SortElement *nextPtr;/* Next element in the list, or NULL for end
				 * of list. */
} SortElement;

/*
 * These function pointer types are used with the "lsearch" and "lsort"
 * commands to facilitate the "-nocase" option.
 */

typedef int (*SortStrCmpFn_t) (const char *, const char *);
typedef int (*SortMemCmpFn_t) (const void *, const void *, size_t);

/*
 * The "lsort" command needs to pass certain information down to the function
 * that compares two list elements, and the comparison function needs to pass
 * success or failure information back up to the top-level "lsort" command.
 * The following structure is used to pass this information.
 */

typedef struct {
typedef struct SortInfo {
    int isIncreasing;		/* Nonzero means sort in increasing order. */
    int sortMode;		/* The sort mode. One of SORTMODE_* values
				 * defined below. */
    Tcl_Obj *compareCmdPtr;	/* The Tcl comparison command when sortMode is
				 * SORTMODE_COMMAND. Pre-initialized to hold
				 * base of command. */
    int *indexv;		/* If the -index option was specified, this
				 * holds an encoding of the indexes contained
				 * in the list supplied as an argument to
				 * holds the indexes contained in the list
				 * supplied as an argument to that option.
				 * that option.
				 * NULL if no indexes supplied, and points to
				 * singleIndex field when only one
				 * supplied. */
    int indexc;			/* Number of indexes in indexv array. */
    int singleIndex;		/* Static space for common index case. */
    int unique;
    int numElements;
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
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







+
+
+
+
+
+
+
+




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

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












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







#define SORTMODE_ASCII		0
#define SORTMODE_INTEGER	1
#define SORTMODE_REAL		2
#define SORTMODE_COMMAND	3
#define SORTMODE_DICTIONARY	4
#define SORTMODE_ASCII_NC	8

/*
 * Magic values for the index field of the SortInfo structure. Note that the
 * index "end-1" will be translated to SORTIDX_END-1, etc.
 */

#define SORTIDX_NONE	-1	/* Not indexed; use whole value. */
#define SORTIDX_END	-2	/* Indexed from end. */

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

static int		DictionaryCompare(const char *left, const char *right);
static Tcl_NRPostProc	IfConditionCallback;
static Tcl_ObjCmdProc	InfoArgsCmd;
static Tcl_ObjCmdProc	InfoBodyCmd;
static Tcl_ObjCmdProc	InfoCmdCountCmd;
static Tcl_ObjCmdProc	InfoCommandsCmd;
static Tcl_ObjCmdProc	InfoCompleteCmd;
static Tcl_ObjCmdProc	InfoDefaultCmd;
static int		DictionaryCompare(char *left, char *right);
static int		InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCmdCountCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCommandsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoCompleteCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoDefaultCmd(ClientData dummy, Tcl_Interp *interp,
/* TIP #348 - New 'info' subcommand 'errorstack' */
static Tcl_ObjCmdProc	InfoErrorStackCmd;
			    int objc, Tcl_Obj *const objv[]);
/* TIP #280 - New 'info' subcommand 'frame' */
static Tcl_ObjCmdProc	InfoFrameCmd;
static Tcl_ObjCmdProc	InfoFunctionsCmd;
static Tcl_ObjCmdProc	InfoHostnameCmd;
static Tcl_ObjCmdProc	InfoLevelCmd;
static Tcl_ObjCmdProc	InfoLibraryCmd;
static Tcl_ObjCmdProc	InfoLoadedCmd;
static Tcl_ObjCmdProc	InfoNameOfExecutableCmd;
static Tcl_ObjCmdProc	InfoPatchLevelCmd;
static Tcl_ObjCmdProc	InfoProcsCmd;
static Tcl_ObjCmdProc	InfoScriptCmd;
static Tcl_ObjCmdProc	InfoSharedlibCmd;
static Tcl_ObjCmdProc	InfoCmdTypeCmd;
static Tcl_ObjCmdProc	InfoTclVersionCmd;
static SortElement *	MergeLists(SortElement *leftPtr, SortElement *rightPtr,
static int		InfoFrameCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoFunctionsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoHostnameCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoLevelCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoLibraryCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoLoadedCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoNameOfExecutableCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		InfoPatchLevelCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoProcsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static SortElement *    MergeLists(SortElement *leftPtr, SortElement *rightPtr,
			    SortInfo *infoPtr);
static int		SortCompare(SortElement *firstPtr, SortElement *second,
			    SortInfo *infoPtr);
static Tcl_Obj *	SelectObjFromSublist(Tcl_Obj *firstPtr,
			    SortInfo *infoPtr);

/*
 * Array of values describing how to implement each standard subcommand of the
 * "info" command.
 */

static const EnsembleImplMap defaultInfoMap[] = {
    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"args",		   InfoArgsCmd,		    NULL},
    {"body",		   InfoBodyCmd,		    NULL},
    {"cmdcount",	   InfoCmdCountCmd,	    NULL},
    {"cmdtype",		   InfoCmdTypeCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"commands",	   InfoCommandsCmd,	    NULL},
    {"complete",	   InfoCompleteCmd,	    NULL},
    {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
    {"default",		   InfoDefaultCmd,	    TclCompileBasic3ArgCmd, NULL, NULL, 0},
    {"default",		   InfoDefaultCmd,	    NULL},
    {"errorstack",	   InfoErrorStackCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd, NULL, NULL, 0},
    {"frame",		   InfoFrameCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"functions",	   InfoFunctionsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"globals",		   TclInfoGlobalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"hostname",	   InfoHostnameCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"level",		   InfoLevelCmd,	    TclCompileInfoLevelCmd, NULL, NULL, 0},
    {"library",		   InfoLibraryCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"loaded",		   InfoLoadedCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
    {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"sharedlibextension", InfoSharedlibCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"tclversion",	   InfoTclVersionCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"vars",		   TclInfoVarsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
    {"exists",		   TclInfoExistsCmd,	    TclCompileInfoExistsCmd},
    {"frame",		   InfoFrameCmd,	    NULL},
    {"functions",	   InfoFunctionsCmd,	    NULL},
    {"globals",		   TclInfoGlobalsCmd,	    NULL},
    {"hostname",	   InfoHostnameCmd,	    NULL},
    {"level",		   InfoLevelCmd,	    NULL},
    {"library",		   InfoLibraryCmd,	    NULL},
    {"loaded",		   InfoLoadedCmd,	    NULL},
    {"locals",		   TclInfoLocalsCmd,	    NULL},
    {"nameofexecutable",   InfoNameOfExecutableCmd, NULL},
    {"patchlevel",	   InfoPatchLevelCmd,	    NULL},
    {"procs",		   InfoProcsCmd,	    NULL},
    {"script",		   InfoScriptCmd,	    NULL},
    {"sharedlibextension", InfoSharedlibCmd,	    NULL},
    {"tclversion",	   InfoTclVersionCmd,	    NULL},
    {"vars",		   TclInfoVarsCmd,	    NULL},
    {NULL, NULL, NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IfObjCmd --
 *
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
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







-
+




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

-
-
-
+
-
-
-
+

-
-
-
-
-
-
-
-
-
-
+

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


-
+
+
+
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_IfObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRIfObjCmd, clientData, objc, objv);
}

    int thenScriptIndex = 0;	/* "then" script to be evaled after syntax
int
TclNRIfObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *boolObj;

				 * check. */
    if (objc <= 1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"wrong # args: no expression after \"%s\" argument",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	return TCL_ERROR;
    }

    /*
     * At this point, objv[1] refers to the main expression to test. The
     * arguments after the expression must be "then" (optional) and a script
     * to execute if the expression is true.
     */

    TclNewObj(boolObj);
    Tcl_NRAddCallback(interp, IfConditionCallback, INT2PTR(objc),
	    (ClientData) objv, INT2PTR(1), boolObj);
    return Tcl_NRExprObj(interp, objv[1], boolObj);
}

static int
IfConditionCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    int objc = PTR2INT(data[0]);
    Tcl_Obj *const *objv = (Tcl_Obj *const *)data[1];
    int i = PTR2INT(data[2]);
    int i, result, value;
    Tcl_Obj *boolObj = (Tcl_Obj *)data[3];
    int value, thenScriptIndex = 0;
    const char *clause;
    char *clause;

    if (result != TCL_OK) {
	TclDecrRefCount(boolObj);
	return result;
    }
    if (Tcl_GetBooleanFromObj(interp, boolObj, &value) != TCL_OK) {
	TclDecrRefCount(boolObj);
	return TCL_ERROR;
    }
    TclDecrRefCount(boolObj);

    i = 1;
    while (1) {
	/*
	 * At this point in the loop, objv and objc refer to an expression to
	 * test, either for the main expression or an expression following an
	 * "elseif". The arguments after the expression must be "then"
	 * (optional) and a script to execute if the expression is true.
	 */

	if (i >= objc) {
	    clause = TclGetString(objv[i-1]);
	    Tcl_AppendResult(interp, "wrong # args: ",
		    "no expression after \"", clause, "\" argument", NULL);
	    return TCL_ERROR;
	}
	if (!thenScriptIndex) {
	    result = Tcl_ExprBooleanObj(interp, objv[i], &value);
	    if (result != TCL_OK) {
		return result;
	    }
	}
	i++;
	if (i >= objc) {
	    goto missingScript;
	missingScript:
	    clause = TclGetString(objv[i-1]);
	    Tcl_AppendResult(interp, "wrong # args: ",
		    "no script following \"", clause, "\" argument", NULL);
	    return TCL_ERROR;
	}
	clause = TclGetString(objv[i]);
	if ((i < objc) && (strcmp(clause, "then") == 0)) {
	    i++;
	}
	if (i >= objc) {
	    goto missingScript;
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
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







-
+





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











+
-
+
+



-
-
+
+
-
-







-
+


-
+
-
-
-
-
-
-
-







	i++;
	if (i >= objc) {
	    if (thenScriptIndex) {
		/*
		 * TIP #280. Make invoking context available to branch.
		 */

		return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
		return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
			iPtr->cmdFramePtr, thenScriptIndex);
	    }
	    return TCL_OK;
	}
	clause = TclGetString(objv[i]);
	if ((clause[0] != 'e') || (strcmp(clause, "elseif") != 0)) {
	if ((clause[0] == 'e') && (strcmp(clause, "elseif") == 0)) {
	    break;
	}
	i++;

	    i++;
	    continue;
	/*
	 * At this point in the loop, objv and objc refer to an expression to
	 * test, either for the main expression or an expression following an
	 * "elseif". The arguments after the expression must be "then"
	 * (optional) and a script to execute if the expression is true.
	 */

	}
	if (i >= objc) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "wrong # args: no expression after \"%s\" argument",
		    clause));
	    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	    return TCL_ERROR;
	break;
	}
	if (!thenScriptIndex) {
	    TclNewObj(boolObj);
	    Tcl_NRAddCallback(interp, IfConditionCallback, data[0], data[1],
		    INT2PTR(i), boolObj);
	    return Tcl_NRExprObj(interp, objv[i], boolObj);
	}
    }

    /*
     * Couldn't find a "then" or "elseif" clause to execute. Check now for an
     * "else" clause. We know that there's at least one more argument when we
     * get here.
     */

    if (strcmp(clause, "else") == 0) {
	i++;
	if (i >= objc) {
	    Tcl_AppendResult(interp, "wrong # args: ",
	    goto missingScript;
		    "no script following \"else\" argument", NULL);
	    return TCL_ERROR;
	}
    }
    if (i < objc - 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"wrong # args: extra words after \"else\" clause in \"if\" command",
	Tcl_AppendResult(interp, "wrong # args: ",
		"extra words after \"else\" clause in \"if\" command", NULL);
		-1));
	Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
	return TCL_ERROR;
    }
    if (thenScriptIndex) {
	/*
	 * TIP #280. Make invoking context available to branch/else.
	 */

	return TclNREvalObjEx(interp, objv[thenScriptIndex], 0,
	return TclEvalObjEx(interp, objv[thenScriptIndex], 0,
		iPtr->cmdFramePtr, thenScriptIndex);
    }
    return TclNREvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);
    return TclEvalObjEx(interp, objv[i], 0, iPtr->cmdFramePtr, i);

  missingScript:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "wrong # args: no script following \"%s\" argument",
	    TclGetString(objv[i-1])));
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IncrObjCmd --
 *
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
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







-
+














-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_IncrObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *newValuePtr, *incrPtr;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?increment?");
	return TCL_ERROR;
    }

    if (objc == 3) {
	incrPtr = objv[2];
    } else {
	TclNewIntObj(incrPtr, 1);
	incrPtr = Tcl_NewIntObj(1);
    }
    Tcl_IncrRefCount(incrPtr);
    newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
	    incrPtr, TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(incrPtr);

    if (newValuePtr == NULL) {
408
409
410
411
412
413
414
415

416
417
418
419
420
421
422
371
372
373
374
375
376
377

378
379
380
381
382
383
384
385







-
+







 *
 * TclInitInfoCmd --
 *
 *	This function is called to create the "info" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	Handle for the info command, or NULL on failure.
 *	FIXME
 *
 * Side effects:
 *	none
 *
 *----------------------------------------------------------------------
 */

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
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







-
+




-
-
+
+












-
-
+
-







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoArgsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name;
    register Interp *iPtr = (Interp *) interp;
    char *name;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *listObjPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", name));
	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
	return TCL_ERROR;
    }

    /*
     * Build a return list containing the arguments.
     */

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
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







-
+




-
-
+
+

-
+









-
-
+
-












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







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoBodyCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name, *bytes;
    register Interp *iPtr = (Interp *) interp;
    char *name;
    Proc *procPtr;
    size_t numBytes;
    Tcl_Obj *bodyPtr, *resultPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "procname");
	return TCL_ERROR;
    }

    name = TclGetString(objv[1]);
    procPtr = TclFindProc(iPtr, name);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", name));
	Tcl_AppendResult(interp, "\"", name, "\" isn't a procedure", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", name, NULL);
	return TCL_ERROR;
    }

    /*
     * Here we used to return procPtr->bodyPtr, except when the body was
     * bytecompiled - in that case, the return was a copy of the body's string
     * rep. In order to better isolate the implementation details of the
     * compiler/engine subsystem, we now always return a copy of the string
     * rep. It is important to return a copy so that later manipulations of
     * the object do not invalidate the internal rep.
     */

    bytes = TclGetStringFromObj(procPtr->bodyPtr, &numBytes);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
    bodyPtr = procPtr->bodyPtr;
    if (bodyPtr->bytes == NULL) {
	/*
	 * The string rep might not be valid if the procedure has never been
	 * run before. [Bug #545644]
	 */

	(void) TclGetString(bodyPtr);
    }
    resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);

    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoCmdCountCmd --
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
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







-
+











-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoCmdCountCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iPtr->cmdCount));
    Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoCommandsCmd --
611
612
613
614
615
616
617
618

619
620
621
622
623

624
625

626
627
628
629
630
631
632
633

634
635
636
637
638
639
640
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







-
+




-
+

-
+







-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoCommandsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *cmdName, *pattern;
    char *cmdName, *pattern;
    const char *simplePattern;
    Tcl_HashEntry *entryPtr;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Command cmd;
    size_t i;
    int i;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * commands.
     */

    if (objc == 1) {
649
650
651
652
653
654
655
656
657


658
659
660
661
662
663
664
618
619
620
621
622
623
624


625
626
627
628
629
630
631
632
633







-
-
+
+







	 * namespace wasn't found, just leave nsPtr NULL: we will return an
	 * empty list since no commands there can be found.
	 */

	Namespace *dummy1NsPtr, *dummy2NsPtr;

	pattern = TclGetString(objv[1]);
	TclGetNamespaceForQualName(interp, pattern, NULL, 0, &nsPtr,
		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL, 0,
		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);

	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
	}
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
686
687
688
689
690
691
692
693

694
695
696
697

698
699
700
701
702
703
704
655
656
657
658
659
660
661

662
663
664
665

666
667
668
669
670
671
672
673







-
+



-
+







	 * Special case for when the pattern doesn't include any of glob's
	 * special characters. This lets us avoid scans of any hash tables.
	 */

	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    if (specificNsInPattern) {
		cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
		elemObjPtr = Tcl_NewObj();
		Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
	    } else {
		cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
	    }
	    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    Tcl_SetObjResult(interp, listPtr);
	    return TCL_OK;
	}
	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
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
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







-
+















-
+



-
+







		}
	    }
	    if (entryPtr == NULL) {
		tablePtr = &globalNsPtr->cmdTable;
		entryPtr = Tcl_FindHashEntry(tablePtr, simplePattern);
	    }
	    if (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(tablePtr, entryPtr);
		cmdName = Tcl_GetHashKey(tablePtr, entryPtr);
		Tcl_ListObjAppendElement(interp, listPtr,
			Tcl_NewStringObj(cmdName, -1));
		Tcl_SetObjResult(interp, listPtr);
		return TCL_OK;
	    }
	}
    } else if (nsPtr->commandPathLength == 0 || specificNsInPattern) {
	/*
	 * The pattern is non-trivial, but either there is no explicit path or
	 * there is an explicit namespace in the pattern. In both cases, the
	 * old matching scheme is perfect.
	 */

	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		if (specificNsInPattern) {
		    cmd = (Tcl_Command)Tcl_GetHashValue(entryPtr);
		    cmd = (Tcl_Command) Tcl_GetHashValue(entryPtr);
		    elemObjPtr = Tcl_NewObj();
		    Tcl_GetCommandFullName(interp, cmd, elemObjPtr);
		} else {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		}
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
	    }
759
760
761
762
763
764
765
766

767
768
769
770
771
772
773
728
729
730
731
732
733
734

735
736
737
738
739
740
741
742







-
+







	 * in only those commands that aren't hidden by a command in the
	 * effective namespace.
	 */

	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr,
				Tcl_NewStringObj(cmdName, -1));
		    }
		}
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
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







-
+





-
+



















-
+




-
+







	 * We keep a hash of the objects already added to the result list.
	 */

	Tcl_InitObjHashTable(&addedCommandsTable);

	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		(void) Tcl_CreateHashEntry(&addedCommandsTable,
			elemObjPtr, &isNew);
			(char *)elemObjPtr, &isNew);
	    }
	    entryPtr = Tcl_NextHashEntry(&search);
	}

	/*
	 * Search the path next.
	 */

	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	    Namespace *pathNsPtr = nsPtr->commandPathArray[i].nsPtr;

	    if (pathNsPtr == NULL) {
		continue;
	    }
	    if (pathNsPtr == globalNsPtr) {
		foundGlobal = 1;
	    }
	    entryPtr = Tcl_FirstHashEntry(&pathNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
		cmdName = Tcl_GetHashKey(&pathNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    (void) Tcl_CreateHashEntry(&addedCommandsTable,
			    elemObjPtr, &isNew);
			    (char *) elemObjPtr, &isNew);
		    if (isNew) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    } else {
			TclDecrRefCount(elemObjPtr);
		    }
		}
		entryPtr = Tcl_NextHashEntry(&search);
843
844
845
846
847
848
849
850

851
852
853
854
855
856
857
812
813
814
815
816
817
818

819
820
821
822
823
824
825
826







-
+







	 * in only those commands that aren't hidden by a command in the
	 * effective namespace.
	 */

	if (!foundGlobal) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    elemObjPtr = Tcl_NewStringObj(cmdName, -1);
		    if (Tcl_FindHashEntry(&addedCommandsTable,
			    (char *) elemObjPtr) == NULL) {
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    } else {
888
889
890
891
892
893
894
895

896
897
898
899
900
901
902
857
858
859
860
861
862
863

864
865
866
867
868
869
870
871







-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoCompleteCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command");
	return TCL_ERROR;
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
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







-
+





-
+














-
-
+
-
-









-
+

-
+

-
+


-

-
+

-
+

-
+





-
-
+
+
-
-

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







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoDefaultCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *procName, *argName;
    char *procName, *argName, *varName;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *valueObjPtr;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "procname arg varname");
	return TCL_ERROR;
    }

    procName = TclGetString(objv[1]);
    argName = TclGetString(objv[2]);

    procPtr = TclFindProc(iPtr, procName);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" isn't a procedure", procName));
	Tcl_AppendResult(interp, "\"", procName, "\" isn't a procedure",NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROCEDURE", procName,
		NULL);
	return TCL_ERROR;
    }

    for (localPtr = procPtr->firstLocalPtr;  localPtr != NULL;
	    localPtr = localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)
		&& (strcmp(argName, localPtr->name) == 0)) {
	    if (localPtr->defValuePtr != NULL) {
		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			localPtr->defValuePtr, TCL_LEAVE_ERR_MSG);
			localPtr->defValuePtr, 0);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		    goto defStoreError;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
		Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
	    } else {
		Tcl_Obj *nullObjPtr = Tcl_NewObj();

		valueObjPtr = Tcl_ObjSetVar2(interp, objv[3], NULL,
			nullObjPtr, TCL_LEAVE_ERR_MSG);
			nullObjPtr, 0);
		if (valueObjPtr == NULL) {
		    return TCL_ERROR;
		    goto defStoreError;
		}
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
		Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	    }
	    return TCL_OK;
	}
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "procedure \"%s\" doesn't have an argument \"%s\"",
    Tcl_AppendResult(interp, "procedure \"", procName,
	    "\" doesn't have an argument \"", argName, "\"", NULL);
	    procName, argName));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARGUMENT", argName, NULL);
    return TCL_ERROR;
}


  defStoreError:
/*
 *----------------------------------------------------------------------
 *
 * InfoErrorStackCmd --
 *
 *	Called to implement the "info errorstack" command that returns information
 *	about the last error's call stack. Handles the following syntax:
 *
 *	    info errorstack ?interp?
 *
 * Results:
 *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
 *
 * Side effects:
 *	Returns a result in the interpreter's result object. If there is an
 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

    varName = TclGetString(objv[3]);
static int
InfoErrorStackCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *target;
    Interp *iPtr;

    Tcl_AppendResult(interp, "couldn't store default value in variable \"",
    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
	return TCL_ERROR;
    }

	    varName, "\"", NULL);
    target = interp;
    if (objc == 2) {
	target = Tcl_GetChild(interp, TclGetString(objv[1]));
	if (target == NULL) {
	    return TCL_ERROR;
    return TCL_ERROR;
	}
    }

    iPtr = (Interp *) target;
    Tcl_SetObjResult(interp, iPtr->errorStack);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInfoExistsCmd --
 *
1056
1057
1058
1059
1060
1061
1062
1063

1064
1065
1066
1067
1068

1069
1070
1071
1072
1073
1074
1075
976
977
978
979
980
981
982

983
984
985
986
987

988
989
990
991
992
993
994
995







-
+




-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

int
TclInfoExistsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *varName;
    char *varName;
    Var *varPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName");
	return TCL_ERROR;
    }

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
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
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







-
+





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






+
+
+
-
+
-
+
+
+
+







-
+
-

+
+
+
+
+

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

-
-
-
+
+
+

-
+
-


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



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







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoFrameCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    int level, code = TCL_OK;
    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
    int level;
    CmdFrame *framePtr;
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    int topLevel = 0;

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

    while (corPtr) {
	while (*cmdFramePtrPtr) {
	    topLevel++;
	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
	}
	if (corPtr->caller.cmdFramePtr) {
	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
	}
	corPtr = corPtr->callerEEPtr->corPtr;
    }
    topLevel += (*cmdFramePtrPtr)->level;

    if (topLevel != iPtr->cmdFramePtr->level) {
	framePtr = iPtr->cmdFramePtr;
	while (framePtr) {
	    framePtr->level = topLevel--;
	    framePtr = framePtr->nextPtr;
	}
	if (topLevel) {
	    Tcl_Panic("Broken frame level calculation");
	}
	topLevel = iPtr->cmdFramePtr->level;
    }

    if (objc == 1) {
	/*
	 * Just "info frame".
	 */

	int levels =
		(iPtr->cmdFramePtr == NULL ? 0 : iPtr->cmdFramePtr->level);

	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(topLevel));
	Tcl_SetObjResult(interp, Tcl_NewIntObj (levels));
	goto done;
	return TCL_OK;
    } else if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
	return TCL_ERROR;
    }

    /*
     * We've got "info frame level" and must parse the level first.
     */

    if (TclGetIntFromObj(interp, objv[1], &level) != TCL_OK) {
	code = TCL_ERROR;
	return TCL_ERROR;
	goto done;
    }
    if (level <= 0) {
	/*
	 * Negative levels are adressing relative to the current frame's
	 * depth.
	 */

    if ((level > topLevel) || (level <= - topLevel)) {
    levelError:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	if (iPtr->cmdFramePtr == NULL) {
	levelError:
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad level \"",
		"bad level \"%s\"", TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
		TclGetString(objv[1]), NULL);
	code = TCL_ERROR;
		    TclGetString(objv[1]), "\"", NULL);
	    return TCL_ERROR;
	goto done;
    }
	}

    /*
     * Let us convert to relative so that we know how many levels to go back
     */
	/*
	 * Convert to absolute.
	 */

    if (level > 0) {
	level += iPtr->cmdFramePtr->level;
	level -= topLevel;
    }

    framePtr = iPtr->cmdFramePtr;
    for (framePtr = iPtr->cmdFramePtr; framePtr != NULL;
    while (++level <= 0) {
	framePtr = framePtr->nextPtr;
	if (!framePtr) {
	    goto levelError;
	    framePtr = framePtr->nextPtr) {
	if (framePtr->level == level) {
	    break;
	}
    }
    if (framePtr == NULL) {
	goto levelError;
	}
    }

    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));

  done:
    cmdFramePtrPtr = &iPtr->cmdFramePtr;
    corPtr = iPtr->execEnvPtr->corPtr;
    while (corPtr) {
	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;

	if (endPtr) {
	    if (*cmdFramePtrPtr == endPtr) {
		*cmdFramePtrPtr = NULL;
	    } else {
		CmdFrame *runPtr = *cmdFramePtrPtr;

		while (runPtr->nextPtr != endPtr) {
		    runPtr->level -= endPtr->level;
		    runPtr = runPtr->nextPtr;
		}
		runPtr->level = 1;
		runPtr->nextPtr = NULL;
	    }
	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
	}
	corPtr = corPtr->callerEEPtr->corPtr;
    }
    return code;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInfoFrame --
 *
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
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
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
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
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







-







-
+


+
+
-
+
-

-
+

















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















-
+

+

















-
+












-
-
+
+
-
-










-
+







-
+
+
















-
-




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

-
-
+
+












-
+




















-
+





-
+
-
-
-
-








Tcl_Obj *
TclInfoFrame(
    Tcl_Interp *interp,		/* Current interpreter. */
    CmdFrame *framePtr)		/* Frame to get info for. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *tmpObj;
    Tcl_Obj *lv[20];		/* Keep uptodate when more keys are added to
				 * the dict. */
    int lc = 0;
    /*
     * This array is indexed by the TCL_LOCATION_... values, except
     * for _LAST.
     */
    static const char *const typeString[TCL_LOCATION_LAST] = {
    static const char *typeString[TCL_LOCATION_LAST] = {
	"eval", "eval", "eval", "precompiled", "source", "proc"
    };
    Tcl_Obj *tmpObj;
    Proc *procPtr =
    Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
	framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
    int needsFree = -1;

    /*
   /*
     * Pull the information and construct the dictionary to return, as list.
     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
     */

#define ADD_PAIR(name, value) \
	TclNewLiteralStringObj(tmpObj, name); \
	lv[lc++] = tmpObj; \
	lv[lc++] = (value)

    switch (framePtr->type) {
    case TCL_LOCATION_EVAL:
	/*
	 * Evaluation, dynamic script. Type, line, cmd, the latter through
	 * str.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
	if (framePtr->line) {
	    ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0]));
	} else {
	    ADD_PAIR("line", Tcl_NewWideIntObj(1));
	}
	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
		framePtr->cmd.str.len));
	break;

    case TCL_LOCATION_EVAL_LIST:
	/*
	 * List optimized evaluation. Type, line, cmd, the latter through
	 * listPtr, possibly a frame.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
	ADD_PAIR("line", Tcl_NewIntObj(1));

	/*
	 * We put a duplicate of the command list obj into the result to
	 * ensure that the 'pure List'-property of the command itself is not
	 * destroyed. Otherwise the query here would disable the list
	 * optimization path in Tcl_EvalObjEx.
	 */

	ADD_PAIR("cmd", Tcl_DuplicateObj(framePtr->cmd.listPtr));
	break;

    case TCL_LOCATION_PREBC:
	/*
	 * Precompiled. Result contains the type as signal, nothing else.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
	break;

    case TCL_LOCATION_BC: {
	/*
	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
	 */

	CmdFrame *fPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame *fPtr;

	fPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
	*fPtr = *framePtr;

	/*
	 * Note:
	 * Type BC => f.data.eval.path	  is not used.
	 *	      f.data.tebc.codePtr is used instead.
	 */

	TclGetSrcInfoForPc(fPtr);

	/*
	 * Now filled: cmd.str.(cmd,len), line
	 * Possibly modified: type, path!
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
	if (fPtr->line) {
	    ADD_PAIR("line", Tcl_NewWideIntObj(fPtr->line[0]));
	    ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
	}

	if (fPtr->type == TCL_LOCATION_SOURCE) {
	    ADD_PAIR("file", fPtr->data.eval.path);

	    /*
	     * Death of reference by TclGetSrcInfoForPc.
	     */

	    Tcl_DecrRefCount(fPtr->data.eval.path);
	}

	ADD_PAIR("cmd", TclGetSourceFromFrame(fPtr, 0, NULL));
	if (fPtr->cmdObj && framePtr->cmdObj == NULL) {
	ADD_PAIR("cmd",
		Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len));
	    needsFree = lc - 1;
	}
	TclStackFree(interp, fPtr);
	break;
    }

    case TCL_LOCATION_SOURCE:
	/*
	 * Evaluation of a script file.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
	ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0]));
	ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
	ADD_PAIR("file", framePtr->data.eval.path);

	/*
	 * Refcount framePtr->data.eval.path goes up when lv is converted into
	 * the result list object.
	 */

	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
	ADD_PAIR("cmd", Tcl_NewStringObj(framePtr->cmd.str.cmd,
		framePtr->cmd.str.len));
	break;

    case TCL_LOCATION_PROC:
	Tcl_Panic("TCL_LOCATION_PROC found in standard frame");
	break;
    }

    /*
     * 'proc'. Common to all frame types. Conditional on having an associated
     * Procedure CallFrame.
     */

    if (procPtr != NULL) {
	Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr;

	if (namePtr) {
	    Tcl_Obj *procNameObj;

	    /*
	     * This is a regular command.
	     */

	    TclNewObj(procNameObj);
	    Tcl_GetCommandFullName(interp, (Tcl_Command) procPtr->cmdPtr,
		    procNameObj);
	    ADD_PAIR("proc", procNameObj);
	    char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr);
	    char *nsName = procPtr->cmdPtr->nsPtr->fullName;

	    ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1));

	    if (strcmp(nsName, "::") != 0) {
		Tcl_AppendToObj(lv[lc-1], "::", -1);
	    }
	    Tcl_AppendToObj(lv[lc-1], procName, -1);
	} else if (procPtr->cmdPtr->clientData) {
	    ExtraFrameInfo *efiPtr = (ExtraFrameInfo *)procPtr->cmdPtr->clientData;
	    size_t i;
	    ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData;
	    int i;

	    /*
	     * This is a non-standard command. Luckily, it's told us how to
	     * render extra information about its frame.
	     */

	    for (i=0 ; i<efiPtr->length ; i++) {
		lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1);
		if (efiPtr->fields[i].proc) {
		    lv[lc++] =
			efiPtr->fields[i].proc(efiPtr->fields[i].clientData);
		} else {
		    lv[lc++] = (Tcl_Obj *)efiPtr->fields[i].clientData;
		    lv[lc++] = efiPtr->fields[i].clientData;
		}
	    }
	}
    }

    /*
     * 'level'. Common to all frame types. Conditional on having an associated
     * _visible_ CallFrame.
     */

    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
	CallFrame *current = framePtr->framePtr;
	CallFrame *top = iPtr->varFramePtr;
	CallFrame *idx;

	for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
	    if (idx == current) {
		int c = framePtr->framePtr->level;
		int t = iPtr->varFramePtr->level;

		ADD_PAIR("level", Tcl_NewWideIntObj(t - c));
		ADD_PAIR("level", Tcl_NewIntObj(t - c));
		break;
	    }
	}
    }

    tmpObj = Tcl_NewListObj(lc, lv);
    return Tcl_NewListObj(lc, lv);
    if (needsFree >= 0) {
	Tcl_DecrRefCount(lv[needsFree]);
    }
    return tmpObj;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoFunctionsCmd --
 *
1441
1442
1443
1444
1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
1329
1330
1331
1332
1333
1334
1335

1336
1337
1338
1339
1340
1341
1342
1343







-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoFunctionsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *script;
    int code;

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
1531
1532

1533
1534
1535
1536
1537
1538
1539
1540
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







-
+
















-
-
-
+
-







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoHostnameCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    name = Tcl_GetHostName();
    if (name) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(name, -1));
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "unable to determine name of host", -1));
    Tcl_SetResult(interp, "unable to determine name of host", TCL_STATIC);
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "HOSTNAME", "UNKNOWN", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoLevelCmd --
1552
1553
1554
1555
1556
1557
1558
1559

1560
1561
1562
1563
1564
1565
1566
1567

1568
1569
1570
1571
1572
1573
1574
1437
1438
1439
1440
1441
1442
1443

1444
1445
1446
1447
1448
1449
1450
1451

1452
1453
1454
1455
1456
1457
1458
1459







-
+







-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoLevelCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;

    if (objc == 1) {		/* Just "info level" */
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iPtr->varFramePtr->level));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
	return TCL_OK;
    }

    if (objc == 2) {
	int level;
	CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;

1596
1597
1598
1599
1600
1601
1602
1603
1604

1605
1606

1607
1608
1609
1610
1611
1612
1613
1481
1482
1483
1484
1485
1486
1487


1488


1489
1490
1491
1492
1493
1494
1495
1496







-
-
+
-
-
+







	return TCL_OK;
    }

    Tcl_WrongNumArgs(interp, 1, objv, "?number?");
    return TCL_ERROR;

  levelError:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad level \"%s\"", TclGetString(objv[1])));
    Tcl_AppendResult(interp, "bad level \"", TclGetString(objv[1]), "\"",
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
	    TclGetString(objv[1]), NULL);
	    NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoLibraryCmd --
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
1509
1510
1511
1512
1513
1514
1515

1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532



1533

1534
1535
1536
1537
1538
1539
1540







-
+











-
+




-
-
-
+
-







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoLibraryCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *libDirName;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
    if (libDirName != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
	return TCL_OK;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "no library has been specified for Tcl", -1));
    Tcl_SetResult(interp, "no library has been specified for Tcl",TCL_STATIC);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", "tcl_library",NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoLoadedCmd --
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
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







-
+




-
+

-
-
+
+



-
+




-
-
-
-
-
-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoLoadedCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *interpName, *packageName;
    char *interpName;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp? ?packageName?");
    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
	return TCL_ERROR;
    }

    if (objc < 2) {		/* Get loaded pkgs in all interpreters. */
    if (objc == 1) {		/* Get loaded pkgs in all interpreters. */
	interpName = NULL;
    } else {			/* Get pkgs just in specified interp. */
	interpName = TclGetString(objv[1]);
    }
    if (objc < 3) {		/* Get loaded files in all packages. */
	packageName = NULL;
    } else {			/* Get pkgs just in specified interp. */
	packageName = TclGetString(objv[2]);
    }
    return TclGetLoadedPackagesEx(interp, interpName, packageName);
    return TclGetLoadedPackages(interp, interpName);
}

/*
 *----------------------------------------------------------------------
 *
 * InfoNameOfExecutableCmd --
 *
1721
1722
1723
1724
1725
1726
1727
1728

1729
1730
1731
1732
1733
1734
1735
1596
1597
1598
1599
1600
1601
1602

1603
1604
1605
1606
1607
1608
1609
1610







-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoNameOfExecutableCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
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
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







-
+











-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoPatchLevelCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *patchlevel;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL,
    patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
	    (TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
    if (patchlevel != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1));
	return TCL_OK;
    }
    return TCL_ERROR;
}
1804
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
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







-
+




-
+








-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoProcsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *cmdName, *pattern;
    char *cmdName, *pattern;
    const char *simplePattern;
    Namespace *nsPtr;
#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
#endif
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_HashEntry *entryPtr;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Command *cmdPtr, *realCmdPtr;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * procs.
     */
1843
1844
1845
1846
1847
1848
1849
1850
1851



1852
1853
1854
1855
1856
1857
1858
1718
1719
1720
1721
1722
1723
1724


1725
1726
1727
1728
1729
1730
1731
1732
1733
1734







-
-
+
+
+







	 * namespace wasn't found, just leave nsPtr NULL: we will return an
	 * empty list since no commands there can be found.
	 */

	Namespace *dummy1NsPtr, *dummy2NsPtr;

	pattern = TclGetString(objv[1]);
	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0, &nsPtr,
		&dummy1NsPtr, &dummy2NsPtr, &simplePattern);
	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
		&simplePattern);

	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
	}
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
1870
1871
1872
1873
1874
1875
1876
1877

1878
1879
1880
1881
1882
1883
1884
1746
1747
1748
1749
1750
1751
1752

1753
1754
1755
1756
1757
1758
1759
1760







-
+







     */

    listPtr = Tcl_NewListObj(0, NULL);
#ifndef INFO_PROCS_SEARCH_GLOBAL_NS
    if (simplePattern != NULL && TclMatchIsTrivial(simplePattern)) {
	entryPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	if (entryPtr != NULL) {
	    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
	    cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);

	    if (!TclIsProc(cmdPtr)) {
		realCmdPtr = (Command *)
			TclGetOriginalCommand((Tcl_Command) cmdPtr);
		if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
		    goto simpleProcOK;
		}
1895
1896
1897
1898
1899
1900
1901
1902

1903
1904
1905

1906
1907
1908
1909
1910
1911
1912
1771
1772
1773
1774
1775
1776
1777

1778
1779
1780

1781
1782
1783
1784
1785
1786
1787
1788







-
+


-
+







	    }
	}
    } else
#endif /* !INFO_PROCS_SEARCH_GLOBAL_NS */
    {
	entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	while (entryPtr != NULL) {
	    cmdName = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, entryPtr);
	    if ((simplePattern == NULL)
		    || Tcl_StringMatch(cmdName, simplePattern)) {
		cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);

		if (!TclIsProc(cmdPtr)) {
		    realCmdPtr = (Command *)
			    TclGetOriginalCommand((Tcl_Command) cmdPtr);
		    if (realCmdPtr != NULL && TclIsProc(realCmdPtr)) {
			goto procOK;
		    }
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
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







-
+







-
+



-
+







	 * namespace.
	 */

#ifdef INFO_PROCS_SEARCH_GLOBAL_NS
	/*
	 * If "info procs" worked like "info commands", returning the commands
	 * also seen in the global namespace, then you would include this
	 * code. As this could break backwards compatibility with 8.0-8.2, we
	 * code. As this could break backwards compatibilty with 8.0-8.2, we
	 * decided not to "fix" it in 8.3, leaving the behavior slightly
	 * different.
	 */

	if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
	    entryPtr = Tcl_FirstHashEntry(&globalNsPtr->cmdTable, &search);
	    while (entryPtr != NULL) {
		cmdName = (const char *)Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		cmdName = Tcl_GetHashKey(&globalNsPtr->cmdTable, entryPtr);
		if ((simplePattern == NULL)
			|| Tcl_StringMatch(cmdName, simplePattern)) {
		    if (Tcl_FindHashEntry(&nsPtr->cmdTable,cmdName) == NULL) {
			cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
			cmdPtr = (Command *) Tcl_GetHashValue(entryPtr);
			realCmdPtr = (Command *) TclGetOriginalCommand(
				(Tcl_Command) cmdPtr);

			if (TclIsProc(cmdPtr) || ((realCmdPtr != NULL)
				&& TclIsProc(realCmdPtr))) {
			    Tcl_ListObjAppendElement(interp, listPtr,
				    Tcl_NewStringObj(cmdName, -1));
1991
1992
1993
1994
1995
1996
1997
1998

1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
1867
1868
1869
1870
1871
1872
1873

1874
1875
1876
1877
1878
1879

1880
1881
1882
1883
1884
1885
1886







-
+





-







 *	script filename.
 *
 *----------------------------------------------------------------------
 */

static int
InfoScriptCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;

    if ((objc != 1) && (objc != 2)) {
	Tcl_WrongNumArgs(interp, 1, objv, "?filename?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	if (iPtr->scriptFile != NULL) {
2039
2040
2041
2042
2043
2044
2045
2046

2047
2048
2049
2050
2051
2052
2053
1914
1915
1916
1917
1918
1919
1920

1921
1922
1923
1924
1925
1926
1927
1928







-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoSharedlibCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
2077
2078
2079
2080
2081
2082
2083
2084

2085
2086
2087
2088
2089
2090
2091
1952
1953
1954
1955
1956
1957
1958

1959
1960
1961
1962
1963
1964
1965
1966







-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoTclVersionCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *version;

    if (objc != 1) {
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















-
+




-
-
-
+
+
















-
-
-
-
-
-
-
-
-
-



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

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

-
-
-
-
+
+
+
+
-

-
-
-
+
+
-
-







    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * InfoCmdTypeCmd --
 *
 *	Called to implement the "info cmdtype" command that returns the type
 *	of a given command. Handles the following syntax:
 *
 *	    info cmdtype cmdName
 *
 * Results:
 *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
 *
 * Side effects:
 *	Returns a type name. If there is an error, the result is an error
 *	message.
 *
 *----------------------------------------------------------------------
 */

static int
InfoCmdTypeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Command command;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "commandName");
	return TCL_ERROR;
    }
    command = Tcl_FindCommand(interp, TclGetString(objv[1]), NULL,
	    TCL_LEAVE_ERR_MSG);
    if (command == NULL) {
	return TCL_ERROR;
    }

    /*
     * There's one special case: safe child interpreters can't see aliases as
     * aliases as they're part of the security mechanisms.
     */

    if (Tcl_IsSafe(interp)
	    && (((Command *) command)->objProc == TclAliasObjCmd)) {
	Tcl_AppendResult(interp, "native", NULL);
    } else {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(TclGetCommandTypeName(command), -1));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_JoinObjCmd --
 *
 *	This procedure is invoked to process the "join" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_JoinObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    size_t length;
    int listLen;
    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
    int listLen, i;
    Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    if (TclListObjGetElements(interp, objv[1], &listLen,
	    &elemPtrs) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listLen == 0) {
	/* No elements to join; default empty result is correct. */
	return TCL_OK;
    }
    if (listLen == 1) {
	/* One element; return it */
	Tcl_SetObjResult(interp, elemPtrs[0]);
	return TCL_OK;
    }

    joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
    Tcl_IncrRefCount(joinObjPtr);

    (void) TclGetStringFromObj(joinObjPtr, &length);
    if (length == 0) {
	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
    } else {
	int i;

	resObjPtr = Tcl_NewObj();
	for (i = 0;  i < listLen;  i++) {
	    if (i > 0) {
    resObjPtr = Tcl_NewObj();
    for (i = 0;  i < listLen;  i++) {
	if (i > 0) {

		/*
		 * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
		 * to shimmer joinObjPtr.  If it did, then the case where
		 * objv[1] and objv[2] are the same value would not be safe.
		 * Accessing elemPtrs would crash.
		 */
	    /*
	     * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
	     * to shimmer joinObjPtr.  If it did, then the case where
	     * objv[1] and objv[2] are the same value would not be safe.
	     * Accessing elemPtrs would crash.
	     */

		Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
	    }
	    Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
	}
	    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
	}
	Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
    }
    }
    Tcl_DecrRefCount(joinObjPtr);
    if (resObjPtr) {
	Tcl_SetObjResult(interp, resObjPtr);
	return TCL_OK;
    Tcl_SetObjResult(interp, resObjPtr);
    return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LassignObjCmd --
 *
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
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







-
+









-
-
+
+













-
-
+
+


-
+
-




-



-
-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LassignObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listCopyPtr;
    Tcl_Obj **listObjv;		/* The contents of the list. */
    int listObjc;		/* The length of the list. */
    int code = TCL_OK;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?varName ...?");
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list varName ?varName ...?");
	return TCL_ERROR;
    }

    listCopyPtr = TclListObjCopy(interp, objv[1]);
    if (listCopyPtr == NULL) {
	return TCL_ERROR;
    }

    TclListObjGetElements(NULL, listCopyPtr, &listObjc, &listObjv);

    objc -= 2;
    objv += 2;
    while (code == TCL_OK && objc > 0 && listObjc > 0) {
	if (Tcl_ObjSetVar2(interp, *objv++, NULL, *listObjv++,
		TCL_LEAVE_ERR_MSG) == NULL) {
	if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
		*listObjv++, TCL_LEAVE_ERR_MSG)) {
	    code = TCL_ERROR;
	}
	objc--;
	objc--; listObjc--;
	listObjc--;
    }

    if (code == TCL_OK && objc > 0) {
	Tcl_Obj *emptyObj;

	TclNewObj(emptyObj);
	Tcl_IncrRefCount(emptyObj);
	while (code == TCL_OK && objc-- > 0) {
	    if (Tcl_ObjSetVar2(interp, *objv++, NULL, emptyObj,
		    TCL_LEAVE_ERR_MSG) == NULL) {
	    if (NULL == Tcl_ObjSetVar2(interp, *objv++, NULL,
		    emptyObj, TCL_LEAVE_ERR_MSG)) {
		code = TCL_ERROR;
	    }
	}
	Tcl_DecrRefCount(emptyObj);
    }

    if (code == TCL_OK && listObjc > 0) {
2331
2332
2333
2334
2335
2336
2337
2338

2339
2340
2341
2342

2343
2344
2345
2346

2347
2348
2349
2350
2351
2352
2353
2129
2130
2131
2132
2133
2134
2135

2136
2137
2138
2139
2140
2141
2142
2143
2144

2145
2146
2147
2148
2149
2150
2151
2152







-
+




+



-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LindexObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    Tcl_Obj *elemPtr;		/* Pointer to the element being extracted. */

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

    /*
     * If objc==3, then objv[2] may be either a single index or a list of
     * indices: go to TclLindexList to determine which. If objc>=4, or
     * objc==2, then objv[2 .. objc-2] are all single indices and processed as
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373





2374
2375
2376
2377
2378
2379
2380
2161
2162
2163
2164
2165
2166
2167





2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179







-
-
-
-
-
+
+
+
+
+








    /*
     * Set the interpreter's object result to the last element extracted.
     */

    if (elemPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, elemPtr);
    Tcl_DecrRefCount(elemPtr);
    return TCL_OK;
    } else {
	Tcl_SetObjResult(interp, elemPtr);
	Tcl_DecrRefCount(elemPtr);
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LinsertObjCmd --
 *
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
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







-
+

-
+



-
-
+

-
-
+
+


















-
+













-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LinsertObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    register int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    size_t index;
    int len, result;
    int index, len, result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index ?element ...?");
    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list index element ?element ...?");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &len);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Get the index. "end" is interpreted to be the index after the last
     * element, such that using it will cause any inserted elements to be
     * appended to the list.
     */

    result = TclGetIntForIndexM(interp, objv[2], /*end*/ len, &index);
    if (result != TCL_OK) {
	return result;
    }
    if (index + 1 > (size_t)len + 1) {
    if (index > len) {
	index = len;
    }

    /*
     * If the list object is unshared we can modify it directly. Otherwise we
     * create a copy to modify: this is "copy on write".
     */

    listPtr = objv[1];
    if (Tcl_IsShared(listPtr)) {
	listPtr = TclListObjCopy(NULL, listPtr);
    }

    if ((objc == 4) && (index == (size_t)len)) {
    if ((objc == 4) && (index == len)) {
	/*
	 * Special case: insert one element at the end of the list.
	 */

	Tcl_ListObjAppendElement(NULL, listPtr, objv[3]);
    } else {
	if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0,
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
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







-
+

-
-
+
+








-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
    register int objc,		/* Number of arguments. */
    register Tcl_Obj *const objv[])
				/* The argument objects. */
{
    /*
     * If there are no list elements, the result is an empty object.
     * Otherwise set the interpreter's result object to be a list object.
     */

    if (objc > 1) {
	Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, &objv[1]));
	Tcl_SetObjResult(interp, Tcl_NewListObj((objc-1), &(objv[1])));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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
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







-
+


-
+



















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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LlengthObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
    register Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Set the interpreter's object result to an integer object holding the
     * length.
     */

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(listLen));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LpopObjCmd --
 *
 *	This procedure is invoked to process the "lpop" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LpopObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
				/* Argument objects. */
{
    int listLen, result;
    Tcl_Obj *elemPtr, *stored;
    Tcl_Obj *listPtr, **elemPtrs;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
	return TCL_ERROR;
    }

    listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * First, extract the element to be returned.
     * TclLindexFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (!listLen) {
	    /* empty list, throw the same error as with index "end" */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
    Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen));
		"index \"end\" out of range", -1));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
		"OUTOFRANGE", NULL);
	    return TCL_ERROR;
	}
	elemPtr = elemPtrs[listLen - 1];
	Tcl_IncrRefCount(elemPtr);
    } else {
	elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2);

	if (elemPtr == NULL) {
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, elemPtr);
    Tcl_DecrRefCount(elemPtr);

    /*
     * Second, remove the element.
     * TclLsetFlat adds a ref count which is handled.
     */

    if (objc == 2) {
	if (Tcl_IsShared(listPtr)) {
	    listPtr = TclListObjCopy(NULL, listPtr);
	}
	result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_IncrRefCount(listPtr);
    } else {
	listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);

	if (listPtr == NULL) {
	    return TCL_ERROR;
	}
    }

    stored = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
    Tcl_DecrRefCount(listPtr);
    if (stored == NULL) {
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrangeObjCmd --
2655
2656
2657
2658
2659
2660
2661
2662

2663
2664
2665

2666
2667

2668

2669
2670
2671
2672
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
2709
2710
2711
2712
2713

2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725

2726
2727
2728

2729
2730
2731

2732
2733
2734
2735
2736

2737
2738
2739


2740
2741
2742
2743
2744

2745
2746
2747
2748

2749
2750
2751
2752

2753
2754
2755
2756

2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772

2773
2774
2775
2776


2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788

2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828

2829
2830
2831
2832
2833
2834
2835
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







-
+


-
+


+
-
+
-






+
+
+
+
+
-
-
-
+
+
+

+



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

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

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

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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LrangeObjCmd(
    TCL_UNUSED(ClientData),
    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])
    register Tcl_Obj *const objv[])
				/* Argument objects. */
{
    Tcl_Obj *listPtr, **elemPtrs;
    int listLen, result;
    int listLen, first, result;
    size_t first, last;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
	return TCL_ERROR;
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    result = TclListObjLength(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    listPtr = TclListObjCopy(interp, objv[1]);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }
    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);

    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
	    &first);
    if (result != TCL_OK) {
    if (result == TCL_OK) {
	return result;
    }

    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
	    &last);
	int last;
    if (result != TCL_OK) {
	return result;
    }


	if (first < 0) {
    Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
    return TCL_OK;
}

	    first = 0;
/*
 *----------------------------------------------------------------------
 *
 * Tcl_LremoveObjCmd --
 *
 *	This procedure is invoked to process the "lremove" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	}
static int
LremoveIndexCompare(
    const void *el1Ptr,
    const void *el2Ptr)
{
    size_t idx1 = *((const size_t *) el1Ptr);
    size_t idx2 = *((const size_t *) el2Ptr);

    /*
     * This will put the larger element first.
     */

	result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
    return (idx1 < idx2) ? 1 : (idx1 > idx2) ? -1 : 0;
}

		&last);
int
Tcl_LremoveObjCmd(
    TCL_UNUSED(ClientData),
	if (result == TCL_OK) {
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, idxc, listLen, prevIdx, first, num;
	    if (last >= listLen) {
    size_t *idxv;
    Tcl_Obj *listObj;

		last = (listLen - 1);
	    }
    /*
     * Parse the arguments.
     */

    if (objc < 2) {
	    if (first <= last) {
	Tcl_WrongNumArgs(interp, 1, objv, "list ?index ...?");
	return TCL_ERROR;
    }

		int numElems = (last - first + 1);
    listObj = objv[1];
    if (TclListObjLength(interp, listObj, &listLen) != TCL_OK) {
	return TCL_ERROR;
    }


    idxc = objc - 2;
    if (idxc == 0) {
	Tcl_SetObjResult(interp, listObj);
		Tcl_SetObjResult(interp,
	return TCL_OK;
    }
    idxv = (size_t *)Tcl_Alloc((objc - 2) * sizeof(size_t));
    for (i = 2; i < objc; i++) {
	if (TclGetIntForIndexM(interp, objv[i], /*endValue*/ listLen - 1,
		&idxv[i - 2]) != TCL_OK) {
	    Tcl_Free(idxv);
	    return TCL_ERROR;
	}
    }

			Tcl_NewListObj(numElems, &(elemPtrs[first])));
    /*
     * Sort the indices, large to small so that when we remove an index we
     * don't change the indices still to be processed.
     */

	    }
    if (idxc > 1) {
	qsort(idxv, idxc, sizeof(size_t), LremoveIndexCompare);
    }

	}
    }
    /*
     * Make our working copy, then do the actual removes piecemeal.
     */

    if (Tcl_IsShared(listObj)) {
	listObj = TclListObjCopy(NULL, listObj);
    }
    num = 0;
    first = listLen;
    for (i = 0, prevIdx = -1 ; i < idxc ; i++) {
	int idx = idxv[i];

    Tcl_DecrRefCount(listPtr);
	/*
	 * Repeated index and sanity check.
	 */

	if (idx == prevIdx) {
	    continue;
	}
	prevIdx = idx;
	if (idx < 0 || idx >= listLen) {
	    continue;
	}

	/*
	 * Coalesce adjacent removes to reduce the number of copies.
	 */

	if (num == 0) {
	    num = 1;
	    first = idx;
	} else if (idx + 1 == first) {
	    num++;
	    first = idx;
	} else {
	    /*
	     * Note that this operation can't fail now; we know we have a list
	     * and we're only ever contracting that list.
	     */

	    (void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
	    listLen -= num;
	    num = 1;
	    first = idx;
	}
    }
    if (num != 0) {
	(void) Tcl_ListObjReplace(interp, listObj, first, num, 0, NULL);
    }
    Tcl_Free(idxv);
    Tcl_SetObjResult(interp, listObj);
    return TCL_OK;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LrepeatObjCmd --
 *
2843
2844
2845
2846
2847
2848
2849
2850

2851
2852
2853


2854
2855
2856
2857


2858
2859
2860
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
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







-
+

-
-
+
+



-
+
+



-
+


-
-
+
+


-
+


-
-
+
+
-
-
-












-
+


-










-
-
+
-
-
-
+
+
-








-

-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LrepeatObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,		/* Number of arguments. */
    Tcl_Obj *const objv[])
    register int objc,		/* Number of arguments. */
    register Tcl_Obj *const objv[])
				/* The argument objects. */
{
    int elementCount, i, totalElems;
    Tcl_Obj *listPtr, **dataArray = NULL;
    Tcl_Obj *listPtr, **dataArray;
    List *listRepPtr;

    /*
     * Check arguments for legality:
     *		lrepeat count ?value ...?
     *		lrepeat posInt value ?value ...?
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "count ?value ...?");
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "positiveCount value ?value ...?");
	return TCL_ERROR;
    }
    if (TCL_OK != TclGetIntFromObj(interp, objv[1], &elementCount)) {
    if (TCL_ERROR == TclGetIntFromObj(interp, objv[1], &elementCount)) {
	return TCL_ERROR;
    }
    if (elementCount < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (elementCount < 1) {
	Tcl_AppendResult(interp, "must have a count of at least 1", NULL);
		"bad count \"%d\": must be integer >= 0", elementCount));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPEAT", "NEGARG",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Skip forward to the interesting arguments now we've finished parsing.
     */

    objc -= 2;
    objv += 2;

    /* Final sanity check. Do not exceed limits on max list length. */

    if (elementCount && objc > LIST_MAX/elementCount) {
    if (objc > LIST_MAX/elementCount) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"max length of a Tcl list (%d elements) exceeded", LIST_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    totalElems = objc * elementCount;

    /*
     * Get an empty list object that is allocated large enough to hold each
     * init value elementCount times.
     */

    listPtr = Tcl_NewListObj(totalElems, NULL);
    if (totalElems) {
	List *listRepPtr = ListRepPtr(listPtr);
    listRepPtr = ListRepPtr(listPtr);

	listRepPtr->elemCount = elementCount*objc;
	dataArray = &listRepPtr->elements;
    listRepPtr->elemCount = elementCount*objc;
    dataArray = &listRepPtr->elements;
    }

    /*
     * Set the elements. Note that we handle the common degenerate case of a
     * single value being repeated separately to permit the compiler as much
     * room as possible to optimize a loop that might be run a very large
     * number of times.
     */

    CLANG_ASSERT(dataArray || totalElems == 0 );
    if (objc == 1) {
	Tcl_Obj *tmpPtr = objv[0];
	register Tcl_Obj *tmpPtr = objv[0];

	tmpPtr->refCount += elementCount;
	for (i=0 ; i<elementCount ; i++) {
	    dataArray[i] = tmpPtr;
	}
    } else {
	int j, k = 0;
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
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







-
+




-
+
-
-
+



-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LreplaceObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *listPtr;
    register Tcl_Obj *listPtr;
    size_t first, last;
    int listLen, numToDelete, result;
    int first, last, listLen, numToDelete, result;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"list first last ?element ...?");
		"list first last ?element element ...?");
	return TCL_ERROR;
    }

    result = TclListObjLength(interp, objv[1], &listLen);
    if (result != TCL_OK) {
	return result;
    }
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
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







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

-
-
+
+







    }

    result = TclGetIntForIndexM(interp, objv[3], /*end*/ listLen-1, &last);
    if (result != TCL_OK) {
	return result;
    }

    if (first == TCL_INDEX_NONE) {
	first = 0;
    } else if (first > (size_t)listLen) {
	first = listLen;
    }

    if (last + 1 > (size_t)listLen) {
	last = listLen - 1;
    if (first < 0) {
    	first = 0;
    }

    /*
     * Complain if the user asked for a start element that is greater than the
     * list length. This won't ever trigger for the "end-*" case as that will
     * be properly constrained by TclGetIntForIndex because we use listLen-1
     * (to allow for replacing the last elem).
     */

    if ((first >= listLen) && (listLen > 0)) {
	Tcl_AppendResult(interp, "list doesn't contain element ",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    if (last >= listLen) {
    	last = (listLen - 1);
    }
    if (first + 1 <= last + 1) {
	numToDelete = last - first + 1;
    if (first <= last) {
	numToDelete = (last - first + 1);
    } else {
	numToDelete = 0;
    }

    /*
     * If the list object is unshared we can modify it directly, otherwise we
     * create a copy to modify: this is "copy on write".
3022
3023
3024
3025
3026
3027
3028
3029

3030
3031
3032
3033
3034
3035
3036
2606
2607
2608
2609
2610
2611
2612

2613
2614
2615
2616
2617
2618
2619
2620







-
+







     * objc == 4. In this case, the list value of listPtr is not changed (no
     * elements are removed or added), but by making the call we are assured
     * we end up with a list in canonical form. Resist any temptation to
     * optimize this case away.
     */

    if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete,
	    objc-4, objv+4)) {
	    objc-4, &(objv[4]))) {
	return TCL_ERROR;
    }

    /*
     * Set the interpreter's object result.
     */

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
2637
2638
2639
2640
2641
2642
2643

2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660

2661
2662
2663
2664
2665
2666
2667
2668







-
+
















-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LreverseObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj **elemv;
    int elemc, i, j;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "list");
	return TCL_ERROR;
    }
    if (TclListObjGetElements(interp, objv[1], &elemc, &elemv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * If the list is empty, just return it. [Bug 1876793]
     * If the list is empty, just return it [Bug 1876793]
     */

    if (!elemc) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
    }

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
2716
2717
2718
2719
2720
2721
2722

2723
2724
2725
2726
2727


2728
2729



2730

2731
2732
2733
2734

2735
2736


2737
2738
2739
2740

2741
2742
2743






2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756

2757
2758
2759
2760
2761
2762
2763
2764

2765
2766


2767

2768
2769
2770
2771
2772
2773
2774
2775
2776
2777

2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790

2791

2792

2793
2794
2795
2796
2797
2798
2799




2800
2801
2802
2803
2804
2805
2806







-
+




-
-
+
+
-
-
-
+
-




-
+

-
-
+
+


-
+


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







-








-


-
-
+
-










-
+






+
+
+
+
+
+
-
+
-

-
+






-
-
-
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsearchObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    const char *bytes, *patternBytes;
    int i, match, index, result=TCL_OK, listc, bisect;
    char *bytes, *patternBytes;
    int i, match, mode, index, result, listc, length, elemLen;
    size_t length = 0, elemLen, start, groupSize, groupOffset, lower, upper;
    int allocatedIndexVector = 0;
    int dataType, isIncreasing;
    int dataType, isIncreasing, lower, upper, patInt, objInt, offset;
    Tcl_WideInt patWide, objWide, wide;
    int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
    double patDouble, objDouble;
    SortInfo sortInfo;
    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
    SortStrCmpFn_t strCmpFn = TclUtfCmp;
    SortStrCmpFn_t strCmpFn = strcmp;
    Tcl_RegExp regexp = NULL;
    static const char *const options[] = {
	"-all",	    "-ascii",   "-bisect", "-decreasing", "-dictionary",
    static const char *options[] = {
	"-all",	    "-ascii",   "-decreasing", "-dictionary",
	"-exact",   "-glob",    "-increasing", "-index",
	"-inline",  "-integer", "-nocase",     "-not",
	"-real",    "-regexp",  "-sorted",     "-start", "-stride",
	"-real",    "-regexp",  "-sorted",     "-start",
	"-subindices", NULL
    };
    enum lsearchoptions {
	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_BISECT, LSEARCH_DECREASING,
	LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING,
	LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE,
	LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED,
	LSEARCH_START, LSEARCH_STRIDE, LSEARCH_SUBINDICES
    enum options {
	LSEARCH_ALL, LSEARCH_ASCII, LSEARCH_DECREASING, LSEARCH_DICTIONARY,
	LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING, LSEARCH_INDEX,
	LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE, LSEARCH_NOT,
	LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED, LSEARCH_START,
	LSEARCH_SUBINDICES
    };
    enum datatypes {
	ASCII, DICTIONARY, INTEGER, REAL
    };
    enum modes {
	EXACT, GLOB, REGEXP, SORTED
    };
    enum modes mode;

    mode = GLOB;
    dataType = ASCII;
    isIncreasing = 1;
    allMatches = 0;
    inlineReturn = 0;
    returnSubindices = 0;
    negatedMatch = 0;
    bisect = 0;
    listPtr = NULL;
    startPtr = NULL;
    groupSize = 1;
    groupOffset = 0;
    offset = 0;
    start = 0;
    noCase = 0;
    sortInfo.compareCmdPtr = NULL;
    sortInfo.isIncreasing = 1;
    sortInfo.sortMode = 0;
    sortInfo.interp = interp;
    sortInfo.resultCode = TCL_OK;
    sortInfo.indexv = NULL;
    sortInfo.indexc = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list pattern");
	Tcl_WrongNumArgs(interp, 1, objv, "?options? list pattern");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
		!= TCL_OK) {
	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
	    }
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    result = TCL_ERROR;
	    return TCL_ERROR;
	    goto done;
	}
	switch ((enum lsearchoptions) index) {
	switch ((enum options) index) {
	case LSEARCH_ALL:		/* -all */
	    allMatches = 1;
	    break;
	case LSEARCH_ASCII:		/* -ascii */
	    dataType = ASCII;
	    break;
	case LSEARCH_BISECT:		/* -bisect */
	    mode = SORTED;
	    bisect = 1;
	    break;
	case LSEARCH_DECREASING:	/* -decreasing */
	    isIncreasing = 0;
	    sortInfo.isIncreasing = 0;
	    break;
	case LSEARCH_DICTIONARY:	/* -dictionary */
	    dataType = DICTIONARY;
	    break;
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
2843
2844
2845
2846
2847
2848
2849

2850
2851
2852


2853
2854
2855


2856

2857
2858
2859
2860
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







-


+
-
-
+
+
+
-
-
+
-













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

-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
+
+
-


+
+
+
-
+

-
+
-
-
+
-











+
+
+
-
+
-










-
+
-
-









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


-
+

-











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


-
+







	    /*
	     * If there was a previous -start option, release its saved index
	     * because it will either be replaced or there will be an error.
	     */

	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
		startPtr = NULL;
	    }
	    if (i > objc-4) {
		if (sortInfo.indexc > 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing starting index", -1));
		    ckfree((char *) sortInfo.indexv);
		}
		Tcl_AppendResult(interp, "missing starting index", NULL);
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		return TCL_ERROR;
		goto done;
	    }
	    i++;
	    if (objv[i] == objv[objc - 2]) {
		/*
		 * Take copy to prevent shimmering problems. Note that it does
		 * not matter if the index obj is also a component of the list
		 * being searched. We only need to copy where the list and the
		 * index are one-and-the-same.
		 */

		startPtr = Tcl_DuplicateObj(objv[i]);
	    } else {
		startPtr = objv[i];
	    }
	    Tcl_IncrRefCount(startPtr);
		Tcl_IncrRefCount(startPtr);
	    break;
	case LSEARCH_STRIDE:		/* -stride */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) {
		result = TCL_ERROR;
		goto done;
	    }
	    if (wide < 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"stride length must be at least 1", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
			"BADSTRIDE", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	    groupSize = wide;
	    i++;
	    break;
	case LSEARCH_INDEX: {		/* -index */
	    Tcl_Obj **indices;
	    int j;

	    if (allocatedIndexVector) {
		TclStackFree(interp, sortInfo.indexv);
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
		allocatedIndexVector = 0;
	    }
	    if (i > objc-4) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
		Tcl_AppendResult(interp,
			"\"-index\" option must be followed by list index",
			-1));
			NULL);
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		result = TCL_ERROR;
		return TCL_ERROR;
		goto done;
	    }

	    /*
	     * Store the extracted indices for processing by sublist
	     * extraction. Note that we don't do this using objects because
	     * that has shimmering problems.
	     */

	    i++;
	    if (TclListObjGetElements(interp, objv[i],
		    &sortInfo.indexc, &indices) != TCL_OK) {
		if (startPtr != NULL) {
		    Tcl_DecrRefCount(startPtr);
		}
		result = TCL_ERROR;
		return TCL_ERROR;
		goto done;
	    }
	    switch (sortInfo.indexc) {
	    case 0:
		sortInfo.indexv = NULL;
		break;
	    case 1:
		sortInfo.indexv = &sortInfo.singleIndex;
		break;
	    default:
		sortInfo.indexv = (int *)
			TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
			ckalloc(sizeof(int) * sortInfo.indexc);
		allocatedIndexVector = 1; /* Cannot use indexc field, as it
					   * might be decreased by 1 later. */
	    }

	    /*
	     * Fill the array by parsing each index. We don't know whether
	     * their scale is sensible yet, but we at least perform the
	     * syntactic check here.
	     */

	    for (j=0 ; j<sortInfo.indexc ; j++) {
		int encoded = 0;
		if (TclIndexEncode(interp, indices[j], TCL_INDEX_NONE,
			TCL_INDEX_NONE, &encoded) != TCL_OK) {
		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
			&sortInfo.indexv[j]) != TCL_OK) {
		    result = TCL_ERROR;
		}
		if (encoded == (int)TCL_INDEX_NONE) {
		    if (sortInfo.indexc > 1) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" out of range",
			ckfree((char *) sortInfo.indexv);
			    TclGetString(indices[j])));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		    }
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %d)", j));
		    goto done;
		    return TCL_ERROR;
		}
		sortInfo.indexv[j] = encoded;
	    }
	    break;
	}
	}
    }

    /*
     * Subindices only make sense if asked for with -index option set.
     */

    if (returnSubindices && sortInfo.indexc==0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"-subindices cannot be used without -index option", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	if (startPtr != NULL) {
	result = TCL_ERROR;
	goto done;
    }
	    Tcl_DecrRefCount(startPtr);
	}

    if (bisect && (allMatches || negatedMatch)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	Tcl_AppendResult(interp,
		"-bisect is not compatible with -all or -not", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
		"BAD_OPTION_MIX", NULL);
	result = TCL_ERROR;
		"-subindices cannot be used without -index option", NULL);
	return TCL_ERROR;
	goto done;
    }

    if (mode == REGEXP) {
    if ((enum modes) mode == REGEXP) {
	/*
	 * We can shimmer regexp/list if listv[i] == pattern, so get the
	 * regexp rep before the list rep. First time round, omit the interp
	 * and hope that the compilation will succeed. If it fails, we'll
	 * recompile in "expensive" mode with a place to put error messages.
	 */

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
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
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







+
+
+
+
+
+
-
+
-










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

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







-
+
+

-
-
-
-
+
+
+
+
+
+
+







-
+
+
+
+



-
-
+

-
-
-
+
-
-
-
-
-
-





-
+






-
+

-
+
+
+
+












-
+
+
+
+







	     */

	    regexp = Tcl_GetRegExpFromObj(interp, objv[objc - 1],
		    TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
	}

	if (regexp == NULL) {
	    if (startPtr != NULL) {
		Tcl_DecrRefCount(startPtr);
	    }
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    result = TCL_ERROR;
	    return TCL_ERROR;
	    goto done;
	}
    }

    /*
     * Make sure the list argument is a list object and get its length and a
     * pointer to its array of element pointers.
     */

    result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
    if (result != TCL_OK) {
	goto done;
    }

	if (startPtr != NULL) {
    /*
     * Check for sanity when grouping elements of the overall list together
     * because of the -stride option. [TIP #351]
     */

	    Tcl_DecrRefCount(startPtr);
    if (groupSize > 1) {
	if (listc % groupSize) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list size must be a multiple of the stride length",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE",
		    NULL);
	    result = TCL_ERROR;
	    goto done;
	}
	if (sortInfo.indexc > 0) {
	if (sortInfo.indexc > 1) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    ckfree((char *) sortInfo.indexv);
	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
			"BADINDEX", NULL);
		result = TCL_ERROR;
		goto done;
	    }
	}
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;
		sortInfo.indexv = NULL;
	    } else {
		sortInfo.indexc--;

	return result;
		for (i = 0; i < sortInfo.indexc; i++) {
		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
		}
	    }
	}
    }

    /*
     * Get the user-specified start offset.
     */

    if (startPtr) {
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
	result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
	Tcl_DecrRefCount(startPtr);
	if (result != TCL_OK) {
	    goto done;
	}
	if (start == TCL_INDEX_NONE) {
	    start = TCL_INDEX_START;
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    return result;
	}
	if (offset < 0) {
	    offset = 0;
	}

	/*
	 * If the search started past the end of the list, we just return a
	 * "did not match anything at all" result straight away. [Bug 1374778]
	 */

	if (start >= (size_t)listc) {
	if (offset > listc-1) {
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    if (allMatches || inlineReturn) {
		Tcl_ResetResult(interp);
	    } else {
		TclNewIndexObj(itemPtr, TCL_INDEX_NONE);
		Tcl_SetObjResult(interp, itemPtr);
		Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	    }
	    goto done;
	}

	    return TCL_OK;
	/*
	 * If start points within a group, it points to the start of the group.
	 */

	if (groupSize > 1) {
	    start -= (start % groupSize);
	}
    }

    patObj = objv[objc - 1];
    patternBytes = NULL;
    if (mode == EXACT || mode == SORTED) {
    if ((enum modes) mode == EXACT || (enum modes) mode == SORTED) {
	switch ((enum datatypes) dataType) {
	case ASCII:
	case DICTIONARY:
	    patternBytes = TclGetStringFromObj(patObj, &length);
	    break;
	case INTEGER:
	    result = TclGetWideIntFromObj(interp, patObj, &patWide);
	    result = TclGetIntFromObj(interp, patObj, &patInt);
	    if (result != TCL_OK) {
		goto done;
		if (sortInfo.indexc > 1) {
		    ckfree((char *) sortInfo.indexv);
		}
		return result;
	    }

	    /*
	     * List representation might have been shimmered; restore it. [Bug
	     * 1844789]
	     */

	    TclListObjGetElements(NULL, objv[objc - 2], &listc, &listv);
	    break;
	case REAL:
	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
	    if (result != TCL_OK) {
		goto done;
		if (sortInfo.indexc > 1) {
		    ckfree((char *) sortInfo.indexv);
		}
		return result;
	    }

	    /*
	     * List representation might have been shimmered; restore it. [Bug
	     * 1844789]
	     */

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
3775
3776
3777
3778
3779
3780
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







-
+







-
-
-
-
-
+

-
+

-

-
+

+
+
+
-
+
-


-
+











-
+

-
-
-
+
+
+
+
+
+

-
+








-
+
+
+
+














-
+


-
-
+
+




-
-



-
-
-
-
+
-














-
-
-
+











-
+

-
-
+
+




+
+
+
-
+
-


-
+

-
-
+
+














-
+
+










-
+




-
-
-
+
+
+
+
+
+








-
+
+
+
+


















+
+
+
-
+
-







     * Set default index value to -1, indicating failure; if we find the item
     * in the course of our search, index will be set to the correct value.
     */

    index = -1;
    match = 0;

    if (mode == SORTED && !allMatches && !negatedMatch) {
    if ((enum modes) mode == SORTED && !allMatches && !negatedMatch) {
	/*
	 * If the data is sorted, we can do a more intelligent search. Note
	 * that there is no point in being smart when -all was specified; in
	 * that case, we have to look at all items anyway, and there is no
	 * sense in doing this when the match sense is inverted.
	 */

	/*
	 * With -stride, lower, upper and i are kept as multiples of groupSize.
	 */

	lower = start - groupSize;
	lower = offset - 1;
	upper = listc;
	while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
	while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
	    i = (lower + upper)/2;
	    i -= i % groupSize;
	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    if (sortInfo.indexc > 1) {
			ckfree((char *) sortInfo.indexv);
		    }
		    result = sortInfo.resultCode;
		    return sortInfo.resultCode;
		    goto done;
		}
	    } else {
		itemPtr = listv[i+groupOffset];
		itemPtr = listv[i];
	    }
	    switch ((enum datatypes) dataType) {
	    case ASCII:
		bytes = TclGetString(itemPtr);
		match = strCmpFn(patternBytes, bytes);
		break;
	    case DICTIONARY:
		bytes = TclGetString(itemPtr);
		match = DictionaryCompare(patternBytes, bytes);
		break;
	    case INTEGER:
		result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
		result = TclGetIntFromObj(interp, itemPtr, &objInt);
		if (result != TCL_OK) {
		    goto done;
		}
		if (patWide == objWide) {
		    if (sortInfo.indexc > 1) {
			ckfree((char *) sortInfo.indexv);
		    }
		    return result;
		}
		if (patInt == objInt) {
		    match = 0;
		} else if (patWide < objWide) {
		} else if (patInt < objInt) {
		    match = -1;
		} else {
		    match = 1;
		}
		break;
	    case REAL:
		result = Tcl_GetDoubleFromObj(interp, itemPtr, &objDouble);
		if (result != TCL_OK) {
		    goto done;
		    if (sortInfo.indexc > 1) {
			ckfree((char *) sortInfo.indexv);
		    }
		    return result;
		}
		if (patDouble == objDouble) {
		    match = 0;
		} else if (patDouble < objDouble) {
		    match = -1;
		} else {
		    match = 1;
		}
		break;
	    }
	    if (match == 0) {
		/*
		 * Normally, binary search is written to stop when it finds a
		 * match. If there are duplicates of an element in the list,
		 * our first match might not be the first occurrence.
		 * our first match might not be the first occurance.
		 * Consider: 0 0 0 1 1 1 2 2 2
		 *
		 * To maintain consistency with standard lsearch semantics, we
		 * must find the leftmost occurrence of the pattern in the
		 * To maintain consistancy with standard lsearch semantics, we
		 * must find the leftmost occurance of the pattern in the
		 * list. Thus we don't just stop searching here. This
		 * variation means that a search always makes log n
		 * comparisons (normal binary search might "get lucky" with an
		 * early comparison).
		 *
		 * In bisect mode though, we want the last of equals.
		 */

		index = i;
		if (bisect) {
		    lower = i;
		} else {
		    upper = i;
		upper = i;
		}
	    } else if (match > 0) {
		if (isIncreasing) {
		    lower = i;
		} else {
		    upper = i;
		}
	    } else {
		if (isIncreasing) {
		    upper = i;
		} else {
		    lower = i;
		}
	    }
	}
	if (bisect && index < 0) {
	    index = lower;
	}

    } else {
	/*
	 * We need to do a linear search, because (at least one) of:
	 *   - our matcher can only tell equal vs. not equal
	 *   - our matching sense is negated
	 *   - we're building a list of all matched items
	 */

	if (allMatches) {
	    listPtr = Tcl_NewListObj(0, NULL);
	}
	for (i = start; i < listc; i += groupSize) {
	for (i = offset; i < listc; i++) {
	    match = 0;
	    if (sortInfo.indexc != 0) {
		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
	    if (sortInfo.indexc != 0) {	    
		itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
		if (sortInfo.resultCode != TCL_OK) {
		    if (listPtr != NULL) {
			Tcl_DecrRefCount(listPtr);
		    }
		    if (sortInfo.indexc > 1) {
			ckfree((char *) sortInfo.indexv);
		    }
		    result = sortInfo.resultCode;
		    return sortInfo.resultCode;
		    goto done;
		}
	    } else {
		itemPtr = listv[i+groupOffset];
		itemPtr = listv[i];
	    }

	    switch (mode) {
		
	    switch ((enum modes) mode) {
	    case SORTED:
	    case EXACT:
		switch ((enum datatypes) dataType) {
		case ASCII:
		    bytes = TclGetStringFromObj(itemPtr, &elemLen);
		    if (length == elemLen) {
			/*
			 * This split allows for more optimal compilation of
			 * memcmp/strcasecmp.
			 */

			if (noCase) {
			    match = (TclUtfCasecmp(bytes, patternBytes) == 0);
			} else {
			    match = (memcmp(bytes, patternBytes, length) == 0);
			    match = (memcmp(bytes, patternBytes,
				    (size_t) length) == 0);
			}
		    }
		    break;

		case DICTIONARY:
		    bytes = TclGetString(itemPtr);
		    match = (DictionaryCompare(bytes, patternBytes) == 0);
		    break;

		case INTEGER:
		    result = TclGetWideIntFromObj(interp, itemPtr, &objWide);
		    result = TclGetIntFromObj(interp, itemPtr, &objInt);
		    if (result != TCL_OK) {
			if (listPtr != NULL) {
			    Tcl_DecrRefCount(listPtr);
			}
			goto done;
		    }
		    match = (objWide == patWide);
			if (sortInfo.indexc > 1) {
			    ckfree((char *) sortInfo.indexv);
			}
			return result;
		    }
		    match = (objInt == patInt);
		    break;

		case REAL:
		    result = Tcl_GetDoubleFromObj(interp,itemPtr, &objDouble);
		    if (result != TCL_OK) {
			if (listPtr) {
			    Tcl_DecrRefCount(listPtr);
			}
			goto done;
			if (sortInfo.indexc > 1) {
			    ckfree((char *) sortInfo.indexv);
			}
			return result;
		    }
		    match = (objDouble == patDouble);
		    break;
		}
		break;

	    case GLOB:
		match = Tcl_StringCaseMatch(TclGetString(itemPtr),
			patternBytes, noCase);
		break;

	    case REGEXP:
		match = Tcl_RegExpExecObj(interp, regexp, itemPtr, 0, 0, 0);
		if (match < 0) {
		    Tcl_DecrRefCount(patObj);
		    if (listPtr != NULL) {
			Tcl_DecrRefCount(listPtr);
		    }
		    if (sortInfo.indexc > 1) {
			ckfree((char *) sortInfo.indexv);
		    }
		    result = TCL_ERROR;
		    return TCL_ERROR;
		    goto done;
		}
		break;
	    }

	    /*
	     * Invert match condition for -not.
	     */
3790
3791
3792
3793
3794
3795
3796
3797

3798
3799
3800
3801
3802
3803
3804
3805
3806

3807
3808
3809
3810

3811
3812
3813
3814
3815


3816
3817
3818
3819

3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834

3835
3836
3837
3838
3839


3840
3841
3842
3843
3844
3845

3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862


3863
3864
3865
3866
3867
3868
3869
3870
3871

3872
3873
3874
3875

3876
3877

3878
3879
3880
3881
3882
3883
3884
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







-
+
-
-
-
-
-


-

+



-
+

-
-
-
-
+
+



-
+














-
+

-
-
-
-
+
+



-
-
-
+









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





-
-
+
-
-
-
-
+

-
+







		break;
	    } else if (inlineReturn) {
		/*
		 * Note that these appends are not expected to fail.
		 */

		if (returnSubindices && (sortInfo.indexc != 0)) {
		    itemPtr = SelectObjFromSublist(listv[i+groupOffset],
		    itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
			    &sortInfo);
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		} else if (groupSize > 1) {
		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
			    groupSize, &listv[i]);
		} else {
		    itemPtr = listv[i];
		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else if (returnSubindices) {
		int j;

		TclNewIndexObj(itemPtr, i+groupOffset);
		itemPtr = Tcl_NewIntObj(i);
		for (j=0 ; j<sortInfo.indexc ; j++) {
		    Tcl_Obj *elObj;
		    size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		    TclNewIndexObj(elObj, elValue);
		    Tcl_ListObjAppendElement(interp, itemPtr, elObj);
		    Tcl_ListObjAppendElement(interp, itemPtr,
			    Tcl_NewIntObj(sortInfo.indexv[j]));
		}
		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
	    } else {
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(i));
	    }
	}
    }

    /*
     * Return everything or a single value.
     */

    if (allMatches) {
	Tcl_SetObjResult(interp, listPtr);
    } else if (!inlineReturn) {
	if (returnSubindices) {
	    int j;

	    TclNewIndexObj(itemPtr, index+groupOffset);
	    itemPtr = Tcl_NewIntObj(index);
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		Tcl_Obj *elObj;
		size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
		TclNewIndexObj(elObj, elValue);
		Tcl_ListObjAppendElement(interp, itemPtr, elObj);
		Tcl_ListObjAppendElement(interp, itemPtr,
			Tcl_NewIntObj(sortInfo.indexv[j]));
	    }
	    Tcl_SetObjResult(interp, itemPtr);
	} else {
		Tcl_Obj *elObj;
		TclNewIndexObj(elObj, index);
	    Tcl_SetObjResult(interp, elObj);
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
	}
    } else if (index < 0) {
	/*
	 * Is this superfluous? The result should be a blank object by
	 * default...
	 */

	Tcl_SetObjResult(interp, Tcl_NewObj());
    } else {
	if (returnSubindices) {
	    Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
		    &sortInfo));
	} else if (groupSize > 1) {
	    Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
	} else {
	    Tcl_SetObjResult(interp, listv[index]);
	}
	Tcl_SetObjResult(interp, listv[index]);
    }
    }
    result = TCL_OK;

    /*
     * Cleanup the index list array.
     */

  done:
    if (startPtr != NULL) {
    if (sortInfo.indexc > 1) {
	Tcl_DecrRefCount(startPtr);
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
	ckfree((char *) sortInfo.indexv);
    }
    return result;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LsetObjCmd --
 *
3892
3893
3894
3895
3896
3897
3898
3899

3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912

3913
3914
3915
3916
3917
3918
3919
3920
3921


3922
3923
3924
3925
3926
3927
3928
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







-
+












-
+
-







-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsetObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    Tcl_Obj *listPtr;		/* Pointer to the list being altered. */
    Tcl_Obj *finalValuePtr;	/* Value finally assigned to the variable. */

    /*
     * Check parameter count.
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
	Tcl_WrongNumArgs(interp, 1, objv, "listVar ?index? ?index...? value");
		"listVar ?index? ?index ...? value");
	return TCL_ERROR;
    }

    /*
     * Look up the list variable's value.
     */

    listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
    listPtr = Tcl_ObjGetVar2(interp, objv[1], (Tcl_Obj *) NULL,
	    TCL_LEAVE_ERR_MSG);
    if (listPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Substitute the value in the value. Return either the value or else an
     * unshared copy of it.
3977
3978
3979
3980
3981
3982
3983
3984

3985
3986
3987
3988
3989

3990
3991
3992
3993
3994
3995
3996

3997
3998
3999
4000
4001
4002
4003
4004
4005
4006

4007
4008

4009
4010
4011
4012
4013
4014

4015
4016








4017
4018

4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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

4328
4329
4330
4331
4332
4333
4334
4335
4336
4337

4338
4339
4340
4341
4342
4343

4344
4345

4346
4347
4348

4349
4350
4351
4352
4353
4354

4355
4356

4357
4358
4359
4360


4361
4362

4363
4364

4365
4366
4367
4368

4369
4370
4371

4372
4373

4374
4375

4376
4377
4378
4379
4380
4381
4382

4383
4384

4385
4386
4387
4388
4389
4390
4391
4392
4393

4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409

4410
4411
4412
4413
4414

4415
4416
4417
4418

4419
4420
4421

4422
4423


4424
4425
4426
4427
4428
4429
4430

4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443


4444
4445
4446
4447
4448
4449


4450
4451
4452
4453
4454
4455
4456







4457
4458
4459
4460
4461
4462
4463
4464
4465

4466
4467
4468
4469
4470
4471

4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489

4490
4491

4492
4493
4494

4495
4496
4497
4498
4499
4500
4501
4502
4503
4504






4505
4506
4507
4508
4509
4510
4511
4512
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
3775
3776
3777
3778
3779
3780
3781

3782
3783
3784
3785
3786
3787
3788
3789
3790
3791

3792
3793
3794
3795
3796


3797
3798
3799
3800





3801













3802
3803
3804
3805
3806
3807


3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830


3831






3832

3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848

3849
3850

3851
3852
3853

3854
3855
3856
3857







3858
3859
3860
3861
3862
3863

3864
3865
3866
3867
3868
3869
3870







-
+




-
+

-
-
-


-
+


-
-
-
-
-
-
-
-
+

-
+
-




-
+


+
+
+
+
+
+
+
+

-
+













-
+


-
-
-
-



+
+
+
-
+
-






-
-
+
+
+
+
+

-
+
-
-
+
-















-
-
+

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



+
+
-
+
-
-
-
-


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

-
-
+
+
-


-


















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


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















+
+
+
-
+
-
















+
+
+
-
+
-










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+







-
+








-
+











-
+

-
+









-
+
-




-
+

-
+


-
+





-
+

-
+

-
-
-
+
+

-
+

-
+


-
-
+
-

-
+

-
+

-
+






-
+
-
-
+
-
-
-





-
+















-
+





+



-
+



+
-
-
+
+


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




-
-
+
+







+
+
+
+
+
+
+







-
-
+
-
-
-
-
-
-
+
-
















-
+

-
+


-
+



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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LsortObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument values. */
{
    int i, index, indices, length, nocase = 0, indexc;
    int i, j, index, indices, length, nocase = 0, indexc;
    int sortMode = SORTMODE_ASCII;
    int group, allocatedIndexVector = 0;
    size_t j, idx, groupSize, groupOffset;
    Tcl_WideInt wide;
    Tcl_Obj *resultPtr, *cmdPtr, **listObjPtrs, *listObj, *indexPtr;
    size_t elmArrSize;
    SortElement *elementArray = NULL, *elementPtr;
    SortElement *elementArray, *elementPtr;
    SortInfo sortInfo;		/* Information about this sort that needs to
				 * be passed to the comparison function. */
#   define MAXCALLOC 1024000
#   define NUM_LISTS 30
    SortElement *subList[NUM_LISTS+1];
				/* This array holds pointers to temporary
				 * lists built during the merge sort. Element
				 * i of the array holds a list of length
				 * 2**i. */
    static const char *const switches[] = {
    static const char *switches[] = {
	"-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
	"-index", "-indices", "-integer", "-nocase", "-real", "-stride",
	"-index", "-indices", "-integer", "-nocase", "-real", "-unique", NULL
	"-unique", NULL
    };
    enum Lsort_Switches {
	LSORT_ASCII, LSORT_COMMAND, LSORT_DECREASING, LSORT_DICTIONARY,
	LSORT_INCREASING, LSORT_INDEX, LSORT_INDICES, LSORT_INTEGER,
	LSORT_NOCASE, LSORT_REAL, LSORT_STRIDE, LSORT_UNIQUE
	LSORT_NOCASE, LSORT_REAL, LSORT_UNIQUE
    };

    /*
     * The subList array below holds pointers to temporary lists built during
     * the merge sort. Element i of the array holds a list of length 2**i.
     */
#   define MAXCALLOC 1024000
#   define NUM_LISTS 30
    SortElement *subList[NUM_LISTS+1];

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-option value ...? list");
	Tcl_WrongNumArgs(interp, 1, objv, "?options? list");
	return TCL_ERROR;
    }

    /*
     * Parse arguments to set up the mode for the sort.
     */

    sortInfo.isIncreasing = 1;
    sortInfo.sortMode = SORTMODE_ASCII;
    sortInfo.indexv = NULL;
    sortInfo.indexc = 0;
    sortInfo.unique = 0;
    sortInfo.interp = interp;
    sortInfo.resultCode = TCL_OK;
    sortInfo.resultCode = TCL_OK;    
    cmdPtr = NULL;
    indices = 0;
    group = 0;
    groupSize = 1;
    groupOffset = 0;
    indexPtr = NULL;
    for (i = 1; i < objc-1; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
		&index) != TCL_OK) {
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    sortInfo.resultCode = TCL_ERROR;
	    return TCL_ERROR;
	    goto done;
	}
	switch ((enum Lsort_Switches) index) {
	case LSORT_ASCII:
	    sortInfo.sortMode = SORTMODE_ASCII;
	    break;
	case LSORT_COMMAND:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    if (i == (objc-2)) {
		if (sortInfo.indexc > 1) {
		    ckfree((char *) sortInfo.indexv);
		}
		Tcl_AppendResult(interp,
			"\"-command\" option must be followed "
			"by comparison command", -1));
			"by comparison command", NULL);
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		return TCL_ERROR;
		goto done;
	    }
	    sortInfo.sortMode = SORTMODE_COMMAND;
	    cmdPtr = objv[i+1];
	    i++;
	    break;
	case LSORT_DECREASING:
	    sortInfo.isIncreasing = 0;
	    break;
	case LSORT_DICTIONARY:
	    sortInfo.sortMode = SORTMODE_DICTIONARY;
	    break;
	case LSORT_INCREASING:
	    sortInfo.isIncreasing = 1;
	    break;
	case LSORT_INDEX: {
	    int sortindex;
	    Tcl_Obj **indexv;
	    Tcl_Obj **indices;

	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-index\" option must be followed by list index",
	    if (i == (objc-2)) {
		Tcl_AppendResult(interp, "\"-index\" option must be "
			"followed by list index", NULL);
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (TclListObjGetElements(interp, objv[i+1], &sortindex,
		    &indexv) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done;
		return TCL_ERROR;
	    }

	    /*
	     * Take copy to prevent shimmering problems.
	     */

	    if (TclListObjGetElements(interp, objv[i+1], &sortInfo.indexc,
		    &indices) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (sortInfo.indexc) {
	    case 0:
		sortInfo.indexv = NULL;
		break;
	    case 1:
		sortInfo.indexv = &sortInfo.singleIndex;
		break;
	    default:
		sortInfo.indexv = (int *)
			ckalloc(sizeof(int) * sortInfo.indexc);
	    }

	    /*
	     * Fill the array by parsing each index. We don't know whether
	     * their scale is sensible yet, but we at least perform the
	     * Check each of the indices for syntactic correctness. Note that
	     * syntactic check here.
	     * we do not store the converted values here because we do not
	     * know if this is the only -index option yet and so we can't
	     * allocate any space; that happens after the scan through all the
	     * options is done.
	     */

	    for (j=0 ; j<(size_t)sortindex ; j++) {
	    for (j=0 ; j<sortInfo.indexc ; j++) {
		int encoded = 0;
		int result = TclIndexEncode(interp, indexv[j],
			TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded);

		if ((result == TCL_OK) && (encoded == (int)TCL_INDEX_NONE)) {
		if (TclGetIntForIndexM(interp, indices[j], SORTIDX_END,
			&sortInfo.indexv[j]) != TCL_OK) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "index \"%s\" out of range",
			    TclGetString(indexv[j])));
		    if (sortInfo.indexc > 1) {
			ckfree((char *) sortInfo.indexv);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			    "OUTOFRANGE", NULL);
		    result = TCL_ERROR;
		}
		    }
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (-index option item number %" TCL_Z_MODIFIER "d)", j));
		    sortInfo.resultCode = TCL_ERROR;
			    "\n    (-index option item number %d)", j));
		    return TCL_ERROR;
		    goto done;
		}
	    }
	    indexPtr = objv[i+1];
	    i++;
	    break;
	}
	case LSORT_INTEGER:
	    sortInfo.sortMode = SORTMODE_INTEGER;
	    break;
	case LSORT_NOCASE:
	    nocase = 1;
	    break;
	case LSORT_REAL:
	    sortInfo.sortMode = SORTMODE_REAL;
	    break;
	case LSORT_UNIQUE:
	    sortInfo.unique = 1;
	    break;
	case LSORT_INDICES:
	    indices = 1;
	    break;
	case LSORT_STRIDE:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-stride\" option must be "
			"followed by stride length", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	}
	    if (Tcl_GetWideIntFromObj(interp, objv[i+1], &wide) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
    }
	    if (wide < 2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"stride length must be at least 2", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADSTRIDE", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    groupSize = wide;
	    group = 1;
	    i++;
	    break;
	}
    }
    if (nocase && (sortInfo.sortMode == SORTMODE_ASCII)) {
	sortInfo.sortMode = SORTMODE_ASCII_NC;
    }

    /*
     * Now extract the -index list for real, if present. No failures are
     * expected here; the values are all of the right type or convertible to
     * it.
     */

    if (indexPtr) {
	Tcl_Obj **indexv;

	TclListObjGetElements(interp, indexPtr, &sortInfo.indexc, &indexv);
	switch (sortInfo.indexc) {
	case 0:
	    sortInfo.indexv = NULL;
	    break;
	case 1:
	    sortInfo.indexv = &sortInfo.singleIndex;
	    break;
	default:
	    sortInfo.indexv = (int *)
		    TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
	    allocatedIndexVector = 1;	/* Cannot use indexc field, as it
					 * might be decreased by 1 later. */
	}
	for (j=0 ; j<(size_t)sortInfo.indexc ; j++) {
	    /* Prescreened values, no errors or out of range possible */
	    TclIndexEncode(NULL, indexv[j], TCL_INDEX_NONE,
		    TCL_INDEX_NONE, &sortInfo.indexv[j]);
	}
    }

    listObj = objv[objc-1];

    if (sortInfo.sortMode == SORTMODE_COMMAND) {
	Tcl_Obj *newCommandPtr, *newObjPtr;

	/*
	 * When sorting using a command, we are reentrant and therefore might
	 * have the representation of the list being sorted shimmered out from
	 * underneath our feet. Take a copy (cheap) to prevent this. [Bug
	 * 1675116]
	 */

	listObj = TclListObjCopy(interp, listObj);
	if (listObj == NULL) {
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    sortInfo.resultCode = TCL_ERROR;
	    return TCL_ERROR;
	    goto done;
	}

	/*
	 * The existing command is a list. We want to flatten it, append two
	 * dummy arguments on the end, and replace these arguments later.
	 */

	newCommandPtr = Tcl_DuplicateObj(cmdPtr);
	TclNewObj(newObjPtr);
	Tcl_IncrRefCount(newCommandPtr);
	if (Tcl_ListObjAppendElement(interp, newCommandPtr, newObjPtr)
		!= TCL_OK) {
	    TclDecrRefCount(newCommandPtr);
	    TclDecrRefCount(listObj);
	    Tcl_IncrRefCount(newObjPtr);
	    TclDecrRefCount(newObjPtr);
	    if (sortInfo.indexc > 1) {
		ckfree((char *) sortInfo.indexv);
	    }
	    sortInfo.resultCode = TCL_ERROR;
	    return TCL_ERROR;
	    goto done;
	}
	Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj());
	sortInfo.compareCmdPtr = newCommandPtr;
    }

    sortInfo.resultCode = TclListObjGetElements(interp, listObj,
	    &length, &listObjPtrs);
    if (sortInfo.resultCode != TCL_OK || length <= 0) {
	goto done;
    }

    /*
     * Check for sanity when grouping elements of the overall list together
     * because of the -stride option. [TIP #326]
     */

    if (group) {
	if (length % groupSize) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list size must be a multiple of the stride length",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT", "BADSTRIDE",
		    NULL);
	    sortInfo.resultCode = TCL_ERROR;
	    goto done;
	}
	length = length / groupSize;
	if (sortInfo.indexc > 0) {
	    /*
	     * Use the first value in the list supplied to -index as the
	     * offset of the element within each group by which to sort.
	     */

	    groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
	    if (groupOffset >= groupSize) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"when used with \"-stride\", the leading \"-index\""
			" value must be within the group", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
			"BADINDEX", NULL);
		sortInfo.resultCode = TCL_ERROR;
		goto done;
	    }
	    if (sortInfo.indexc == 1) {
		sortInfo.indexc = 0;
		sortInfo.indexv = NULL;
	    } else {
		sortInfo.indexc--;

		/*
		 * Do not shrink the actual memory block used; that doesn't
		 * work with TclStackAlloc-allocated memory. [Bug 2918962]
		 *
		 * TODO: Consider a pointer increment to replace this
		 * array shift.
		 */

		for (i = 0; i < sortInfo.indexc; i++) {
		    sortInfo.indexv[i] = sortInfo.indexv[i+1];
		}
	    }
	}
    }

    sortInfo.numElements = length;

    
    indexc = sortInfo.indexc;
    sortMode = sortInfo.sortMode;
    if ((sortMode == SORTMODE_ASCII_NC)
	    || (sortMode == SORTMODE_DICTIONARY)) {
	/*
	 * For this function's purpose all string-based modes are equivalent
	 */

	
	sortMode = SORTMODE_ASCII;
    }

    /*
     * Initialize the sublists. After the following loop, subList[i] will
     * contain a sorted sublist of length 2**i. Use one extra subList at the
     * end, always at NULL, to indicate the end of the lists.
     */

    
    for (j=0 ; j<=NUM_LISTS ; j++) {
	subList[j] = NULL;
    }

    /*
     * The following loop creates a SortElement for each list element and
     * begins sorting it into the sublists as it appears.
     */

    elmArrSize = length * sizeof(SortElement);
    if (elmArrSize <= MAXCALLOC) {
	elementArray = (SortElement *)Tcl_Alloc(elmArrSize);
	elementArray = (SortElement *) ckalloc(elmArrSize);
    } else {
	elementArray = (SortElement *)malloc(elmArrSize);
	elementArray = (SortElement *) malloc(elmArrSize);
    }
    if (!elementArray) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no enough memory to proccess sort of %d items", length));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	sortInfo.resultCode = TCL_ERROR;
	goto done;
    }

    for (i=0; i < length; i++) {
    for (i=0; i < length; i++){
	idx = groupSize * i + groupOffset;
	if (indexc) {
	    /*
	     * If this is an indexed sort, retrieve the corresponding element
	     */
	    indexPtr = SelectObjFromSublist(listObjPtrs[idx], &sortInfo);
	    indexPtr = SelectObjFromSublist(listObjPtrs[i], &sortInfo);
	    if (sortInfo.resultCode != TCL_OK) {
		goto done;
		goto done1;
	    }
	} else {
	    indexPtr = listObjPtrs[idx];
	    indexPtr = listObjPtrs[i];
	}

	/*
	 * Determine the "value" of this object for sorting purposes
	 */

	
	if (sortMode == SORTMODE_ASCII) {
	    elementArray[i].collationKey.strValuePtr = TclGetString(indexPtr);
	    elementArray[i].index.strValuePtr = TclGetString(indexPtr);
	} else if (sortMode == SORTMODE_INTEGER) {
	    Tcl_WideInt a;

	    if (TclGetWideIntFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
	    long a;
	    if (TclGetLongFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done;
		goto done1;
	    }
	    elementArray[i].collationKey.wideValue = a;
	    elementArray[i].index.intValue = a;
	} else if (sortMode == SORTMODE_REAL) {
	    double a;

	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr,
	    if (Tcl_GetDoubleFromObj(sortInfo.interp, indexPtr, &a) != TCL_OK) {
		    &a) != TCL_OK) {
		sortInfo.resultCode = TCL_ERROR;
		goto done;
		goto done1;
	    }
	    elementArray[i].collationKey.doubleValue = a;
	    elementArray[i].index.doubleValue = a;
	} else {
	    elementArray[i].collationKey.objValuePtr = indexPtr;
	    elementArray[i].index.objValuePtr = indexPtr;
	}

	/*
	 * Determine the representation of this element in the result: either
	 * the objPtr itself, or its index in the original list.
	 */

	
	if (indices || group) {
	    elementArray[i].payload.index = idx;
	elementArray[i].objPtr = (indices ? INT2PTR(i) : listObjPtrs[i]);
	} else {
	    elementArray[i].payload.objPtr = listObjPtrs[idx];
	}

	/*
	 * Merge this element in the pre-existing sublists (and merge together
	 * sublists when we have two of the same size).
	 */

	
	elementArray[i].nextPtr = NULL;
	elementPtr = &elementArray[i];
	for (j=0 ; subList[j] ; j++) {
	    elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
	    subList[j] = NULL;
	}
	if (j >= NUM_LISTS) {
	    j = NUM_LISTS-1;
	}
	subList[j] = elementPtr;
    }

    /*
     * Merge all sublists
     */

    
    elementPtr = subList[0];
    for (j=1 ; j<NUM_LISTS ; j++) {
	elementPtr = MergeLists(subList[j], elementPtr, &sortInfo);
    }


    /*
     * Now store the sorted elements in the result list.
     */

    
    if (sortInfo.resultCode == TCL_OK) {
	List *listRepPtr;
	Tcl_Obj **newArray, *objPtr;
	int i;

	resultPtr = Tcl_NewListObj(sortInfo.numElements * groupSize, NULL);
	
	resultPtr = Tcl_NewListObj(sortInfo.numElements, NULL);
	listRepPtr = ListRepPtr(resultPtr);
	newArray = &listRepPtr->elements;
	if (group) {
	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
		idx = elementPtr->payload.index;
		for (j = 0; j < groupSize; j++) {
		    if (indices) {
	if (indices) {
			TclNewIndexObj(objPtr, idx + j - groupOffset);
			newArray[i++] = objPtr;
			Tcl_IncrRefCount(objPtr);
		    } else {
			objPtr = listObjPtrs[idx + j - groupOffset];
			newArray[i++] = objPtr;
			Tcl_IncrRefCount(objPtr);
		    }
		}
	    }
	} else if (indices) {
	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
		TclNewIndexObj(objPtr, elementPtr->payload.index);
	    for (i = 0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){
		objPtr = Tcl_NewIntObj(PTR2INT(elementPtr->objPtr));
		newArray[i++] = objPtr;
		Tcl_IncrRefCount(objPtr);
	    }
	} else {
	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
		objPtr = elementPtr->payload.objPtr;
	    for (i = 0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr){
		objPtr = elementPtr->objPtr;
		newArray[i++] = objPtr;
		Tcl_IncrRefCount(objPtr);
	    }
	}
	listRepPtr->elemCount = i;
	Tcl_SetObjResult(interp, resultPtr);
    }

  done1:
    if (elmArrSize <= MAXCALLOC) {
	ckfree((char *)elementArray);
    } else {
	free((char *)elementArray);
    }

  done:
    if (sortMode == SORTMODE_COMMAND) {
	TclDecrRefCount(sortInfo.compareCmdPtr);
	TclDecrRefCount(listObj);
	sortInfo.compareCmdPtr = NULL;
    }
    if (allocatedIndexVector) {
	TclStackFree(interp, sortInfo.indexv);
    if (sortInfo.indexc > 1) {
    }
    if (elementArray) {
	if (elmArrSize <= MAXCALLOC) {
	    Tcl_Free(elementArray);
	} else {
	    free((char *)elementArray);
	ckfree((char *) sortInfo.indexv);
	}
    }
    return sortInfo.resultCode;
}

/*
 *----------------------------------------------------------------------
 *
 * MergeLists -
 *
 *	This procedure combines two sorted lists of SortElement structures
 *	into a single sorted list.
 *
 * Results:
 *	The unified list of SortElement structures.
 *
 * Side effects:
 *	If infoPtr->unique is set then infoPtr->numElements may be updated.
 *      If infoPtr->unique is set then infoPtr->numElements may be updated.
 *	Possibly others, if a user-defined comparison command does something
 *	weird.
 *      weird. 
 *
 * Note:
 *	If infoPtr->unique is set, the merge assumes that there are no
 *      If infoPtr->unique is set, the merge assumes that there are no
 *	"repeated" elements in each of the left and right lists. In that case,
 *	if any element of the left list is equivalent to one in the right list
 *	it is omitted from the merged list.
 *
 *	This simplified mechanism works because of the special way our
 *	MergeSort creates the sublists to be merged and will fail to eliminate
 *	all repeats in the general case where they are already present in
 *	either the left or right list. A general code would need to skip
 *	adjacent initial repeats in the left and right lists before comparing
 *	their initial elements, at each step.
 *      This simplified mechanism works because of the special way
 *	our MergeSort creates the sublists to be merged and will fail to
 *	eliminate all repeats in the general case where they are already
 *	present in either the left or right list. A general code would need to
 *	skip adjacent initial repeats in the left and right lists before
 *	comparing their initial elements, at each step. 
 *
 *----------------------------------------------------------------------
 */

static SortElement *
MergeLists(
    SortElement *leftPtr,	/* First list to be merged; may be NULL. */
    SortElement *rightPtr,	/* Second list to be merged; may be NULL. */
4600
4601
4602
4603
4604
4605
4606
4607
4608


4609
4610
4611


4612
4613
4614


4615
4616

4617
4618
4619


4620
4621
4622
4623
4624
4625


4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637

4638
4639
4640
4641
4642
4643
4644



4645
4646
4647
4648
4649
4650
4651
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
3958
3959
3960
3961
3962
3963
3964


3965
3966
3967


3968
3969
3970


3971
3972
3973

3974
3975


3976
3977
3978
3979
3980
3981


3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994

3995
3996
3997
3998
3999



4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019

4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031


4032
4033


4034
4035
4036
4037
4038
4039
4040







-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
-
+
+




-
-
+
+











-
+




-
-
-
+
+
+

















-
+
+









+
-
-
+
+
-
-







				/* Values to be compared. */
    SortInfo *infoPtr)		/* Information passed from the top-level
				 * "lsort" command. */
{
    int order = 0;

    if (infoPtr->sortMode == SORTMODE_ASCII) {
	order = TclUtfCmp(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
	order = strcmp(elemPtr1->index.strValuePtr,
		elemPtr2->index.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
	order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
	order = TclUtfCasecmp(elemPtr1->index.strValuePtr,
		elemPtr2->index.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_DICTIONARY) {
	order = DictionaryCompare(elemPtr1->collationKey.strValuePtr,
		elemPtr2->collationKey.strValuePtr);
	order = DictionaryCompare(elemPtr1->index.strValuePtr,
		elemPtr2->index.strValuePtr);
    } else if (infoPtr->sortMode == SORTMODE_INTEGER) {
	Tcl_WideInt a, b;
	long a, b;

	a = elemPtr1->collationKey.wideValue;
	b = elemPtr2->collationKey.wideValue;
	a = elemPtr1->index.intValue;
	b = elemPtr2->index.intValue;
	order = ((a >= b) - (a <= b));
    } else if (infoPtr->sortMode == SORTMODE_REAL) {
	double a, b;

	a = elemPtr1->collationKey.doubleValue;
	b = elemPtr2->collationKey.doubleValue;
	a = elemPtr1->index.doubleValue;
	b = elemPtr2->index.doubleValue;
	order = ((a >= b) - (a <= b));
    } else {
	Tcl_Obj **objv, *paramObjv[2];
	int objc;
	Tcl_Obj *objPtr1, *objPtr2;

	if (infoPtr->resultCode != TCL_OK) {
	    /*
	     * Once an error has occurred, skip any future comparisons so as
	     * to preserve the error message in sortInterp->result.
	     */

	    
	    return 0;
	}


	objPtr1 = elemPtr1->collationKey.objValuePtr;
	objPtr2 = elemPtr2->collationKey.objValuePtr;

	objPtr1 = elemPtr1->index.objValuePtr;
	objPtr2 = elemPtr2->index.objValuePtr;
	
	paramObjv[0] = objPtr1;
	paramObjv[1] = objPtr2;

	/*
	 * We made space in the command list for the two things to compare.
	 * Replace them and evaluate the result.
	 */

	TclListObjLength(infoPtr->interp, infoPtr->compareCmdPtr, &objc);
	Tcl_ListObjReplace(infoPtr->interp, infoPtr->compareCmdPtr, objc - 2,
		2, 2, paramObjv);
	TclListObjGetElements(infoPtr->interp, infoPtr->compareCmdPtr,
		&objc, &objv);

	infoPtr->resultCode = Tcl_EvalObjv(infoPtr->interp, objc, objv, 0);

	if (infoPtr->resultCode != TCL_OK) {
	    Tcl_AddErrorInfo(infoPtr->interp, "\n    (-compare command)");
	    Tcl_AddErrorInfo(infoPtr->interp,
		    "\n    (-compare command)");
	    return 0;
	}

	/*
	 * Parse the result of the command.
	 */

	if (TclGetIntFromObj(infoPtr->interp,
		Tcl_GetObjResult(infoPtr->interp), &order) != TCL_OK) {
	    Tcl_ResetResult(infoPtr->interp);
	    Tcl_SetObjResult(infoPtr->interp, Tcl_NewStringObj(
		    "-compare command returned non-integer result", -1));
	    Tcl_AppendResult(infoPtr->interp,
		    "-compare command returned non-integer result", NULL);
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "COMPARISONFAILED", NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return 0;
	}
    }
    if (!infoPtr->isIncreasing) {
	order = -order;
    }
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
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







-
+

-
+














-
+



-
+







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

static int
DictionaryCompare(
    const char *left, const char *right)	/* The strings to compare. */
    char *left, char *right)	/* The strings to compare. */
{
    int uniLeft = 0, uniRight = 0, uniLeftLower, uniRightLower;
    Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
    int diff, zeros;
    int secondaryDiff = 0;

    while (1) {
	if (isdigit(UCHAR(*right))		/* INTL: digit */
		&& isdigit(UCHAR(*left))) {	/* INTL: digit */
	    /*
	     * There are decimal numbers embedded in the two strings. Compare
	     * them as numbers, rather than strings. If one number has more
	     * leading zeros than the other, the number with more leading
	     * zeros sorts later, but only as a secondary choice.
	     */

	    zeros = 0;
	    while ((*right == '0') && isdigit(UCHAR(right[1]))) {
	    while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
		right++;
		zeros--;
	    }
	    while ((*left == '0') && isdigit(UCHAR(left[1]))) {
	    while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
		left++;
		zeros++;
	    }
	    if (secondaryDiff == 0) {
		secondaryDiff = zeros;
	    }

4776
4777
4778
4779
4780
4781
4782
4783
4784


4785
4786
4787
4788
4789
4790
4791
4134
4135
4136
4137
4138
4139
4140


4141
4142
4143
4144
4145
4146
4147
4148
4149







-
-
+
+







	/*
	 * Convert character to Unicode for comparison purposes. If either
	 * string is at the terminating null, do a byte-wise comparison and
	 * bail out immediately.
	 */

	if ((*left != '\0') && (*right != '\0')) {
	    left += TclUtfToUCS4(left, &uniLeft);
	    right += TclUtfToUCS4(right, &uniRight);
	    left += Tcl_UtfToUniChar(left, &uniLeft);
	    right += Tcl_UtfToUniChar(right, &uniRight);

	    /*
	     * Convert both chars to lower for the comparison, because
	     * dictionary sorts are case insensitve. Covert to lower, not
	     * upper, so chars between Z and a will sort before A (where most
	     * other interesting punctuations occur).
	     */
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
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







+

+
+
+
-
+
+
+
+







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













-


	int listLen, index;
	Tcl_Obj *currentObj;

	if (TclListObjLength(infoPtr->interp, objPtr, &listLen) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	index = infoPtr->indexv[i];

	/*
	 * Adjust for end-based indexing.
	 */
	index = TclIndexDecode(infoPtr->indexv[i], listLen - 1);

	if (index < SORTIDX_NONE) {
	    index += listLen + 1;
	}

	if (Tcl_ListObjIndex(infoPtr->interp, objPtr, index,
		&currentObj) != TCL_OK) {
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	if (currentObj == NULL) {
	    if (index == (int)TCL_INDEX_NONE) {
		index = TCL_INDEX_END - infoPtr->indexv[i];
	    char buffer[TCL_INTEGER_SPACE];

		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
			"element end-%d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
	    TclFormatInt(buffer, index);
	    } else {
		Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
	    Tcl_AppendResult(infoPtr->interp, "element ", buffer,
			"element %d missing from sublist \"%s\"",
			index, TclGetString(objPtr)));
		    " missing from sublist \"", TclGetString(objPtr), "\"",
	    }
	    Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
		    "INDEXFAILED", NULL);
		    NULL);
	    infoPtr->resultCode = TCL_ERROR;
	    return NULL;
	}
	objPtr = currentObj;
    }
    return objPtr;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to generic/tclCmdMZ.c.

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

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
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












-
+








-

-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+







/*
 * tclCmdMZ.c --
 *
 *	This file contains the top-level command routines for most of the Tcl
 *	built-in commands whose names begin with the letters M to Z. It
 *	contains only commands in the generic core (i.e. those that don't
 *	depend much upon UNIX facilities).
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003-2009 Donal K. Fellows.
 * Copyright (c) 2003 Donal K. Fellows.
 *
 * 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 "tclCompile.h"
#include "tclRegexp.h"
#include "tclStringTrim.h"

static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static Tcl_NRPostProc	SwitchPostProc;
static Tcl_NRPostProc	TryPostBody;
static Tcl_NRPostProc	TryPostFinal;
static Tcl_NRPostProc	TryPostHandler;
static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */

const char tclDefaultTrimSet[] =
	"\x09\x0a\x0b\x0c\x0d " /* ASCII */
	"\xc0\x80" /*     nul (U+0000) */
	"\xc2\x85" /*     next line (U+0085) */
	"\xc2\xa0" /*     non-breaking space (U+00a0) */
	"\xe1\x9a\x80" /* ogham space mark (U+1680) */
	"\xe1\xa0\x8e" /* mongolian vowel separator (U+180e) */
	"\xe2\x80\x80" /* en quad (U+2000) */
	"\xe2\x80\x81" /* em quad (U+2001) */
	"\xe2\x80\x82" /* en space (U+2002) */
	"\xe2\x80\x83" /* em space (U+2003) */
	"\xe2\x80\x84" /* three-per-em space (U+2004) */
	"\xe2\x80\x85" /* four-per-em space (U+2005) */
	"\xe2\x80\x86" /* six-per-em space (U+2006) */
	"\xe2\x80\x87" /* figure space (U+2007) */
	"\xe2\x80\x88" /* punctuation space (U+2008) */
	"\xe2\x80\x89" /* thin space (U+2009) */
	"\xe2\x80\x8a" /* hair space (U+200a) */
	"\xe2\x80\x8b" /* zero width space (U+200b) */
	"\xe2\x80\xa8" /* line separator (U+2028) */
	"\xe2\x80\xa9" /* paragraph separator (U+2029) */
	"\xe2\x80\xaf" /* narrow no-break space (U+202f) */
	"\xe2\x81\x9f" /* medium mathematical space (U+205f) */
	"\xe2\x81\xa0" /* word joiner (U+2060) */
	"\xe3\x80\x80" /* ideographic space (U+3000) */
	"\xef\xbb\xbf" /* zero width no-break space (U+feff) */
;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PwdObjCmd --
 *
 *	This procedure is invoked to process the "pwd" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_PwdObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *retVal;

    if (objc != 1) {
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
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







-
+




+
-
+
-



-
+




-
+








+
-
+




-
+






-
+



-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RegexpObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, indices, match, about, offset, all, doinline, numMatchesSaved;
    size_t offset, stringLength, matchLength, cflags, eflags;
    int cflags, eflags, stringLength, matchLength;
    int i, indices, match, about, all, doinline, numMatchesSaved;
    Tcl_RegExp regExpr;
    Tcl_Obj *objPtr, *startIndex = NULL, *resultPtr = NULL;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
    static const char *options[] = {
	"-all",		"-about",	"-indices",	"-inline",
	"-expanded",	"-line",	"-linestop",	"-lineanchor",
	"-nocase",	"-start",	"--",		NULL
    };
    enum regexpoptions {
    enum options {
	REGEXP_ALL,	REGEXP_ABOUT,	REGEXP_INDICES,	REGEXP_INLINE,
	REGEXP_EXPANDED,REGEXP_LINE,	REGEXP_LINESTOP,REGEXP_LINEANCHOR,
	REGEXP_NOCASE,	REGEXP_START,	REGEXP_LAST
    };

    indices = 0;
    about = 0;
    cflags = TCL_REG_ADVANCED;
    eflags = 0;
    offset = TCL_INDEX_START;
    offset = 0;
    all = 0;
    doinline = 0;

    for (i = 1; i < objc; i++) {
	const char *name;
	char *name;
	int index;

	name = TclGetString(objv[i]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
		&index) != TCL_OK) {
	    goto optionError;
	}
	switch ((enum regexpoptions) index) {
	switch ((enum options) index) {
	case REGEXP_ALL:
	    all = 1;
	    break;
	case REGEXP_INDICES:
	    indices = 1;
	    break;
	case REGEXP_INLINE:
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
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







-
+



-
+


















-
+











-
-
+
-
-
+







	case REGEXP_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGEXP_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGEXP_START: {
	    size_t temp;
	    int temp;
	    if (++i >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[i], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) {
	    if (TclGetIntForIndexM(interp, objv[i], 0, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[i];
	    Tcl_IncrRefCount(startIndex);
	    break;
	}
	case REGEXP_LAST:
	    i++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((objc - i) < (2 - about)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string ?matchVar? ?subMatchVar ...?");
	    "?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
	goto optionError;
    }
    objc -= i;
    objv += i;

    /*
     * Check if the user requested -inline, but specified match variables; a
     * no-no.
     */

    if (doinline && ((objc - 2) != 0)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"regexp match variables not allowed when using -inline", -1));
	Tcl_AppendResult(interp, "regexp match variables not allowed"
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGEXP",
		"MIX_VAR_INLINE", NULL);
		" when using -inline", NULL);
	goto optionError;
    }

    /*
     * Handle the odd about case separately.
     */

255
256
257
258
259
260
261
262

263
264
265


266
267
268
269
270
271
272
214
215
216
217
218
219
220

221
222


223
224
225
226
227
228
229
230
231







-
+

-
-
+
+







     * regexp to avoid shimmering problems.
     */

    objPtr = objv[1];
    stringLength = Tcl_GetCharLength(objPtr);

    if (startIndex) {
	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset == TCL_INDEX_NONE) {
	    offset = TCL_INDEX_START;
	if (offset < 0) {
	    offset = 0;
	}
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;
    }
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
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







-
+

-
+

-
+













-
+











-
+







	 * Pass either 0 or TCL_REG_NOTBOL in the eflags. Passing
	 * TCL_REG_NOTBOL indicates that the character at offset should not be
	 * considered the start of the line. If for example the pattern {^} is
	 * passed and -start is positive, then the pattern will not match the
	 * start of the string unless the previous character is a newline.
	 */

	if (offset == TCL_INDEX_START) {
	if (offset == 0) {
	    eflags = 0;
	} else if (offset + 1 > stringLength + 1) {
	} else if (offset > stringLength) {
	    eflags = TCL_REG_NOTBOL;
	} else if (Tcl_GetUniChar(objPtr, offset-1) == '\n') {
	} else if (Tcl_GetUniChar(objPtr, offset-1) == (Tcl_UniChar)'\n') {
	    eflags = 0;
	} else {
	    eflags = TCL_REG_NOTBOL;
	}

	match = Tcl_RegExpExecObj(interp, regExpr, objPtr, offset,
		numMatchesSaved, eflags);
	if (match < 0) {
	    return TCL_ERROR;
	}

	if (match == 0) {
	    /*
	     * We want to set the value of the interpreter result only when
	     * We want to set the value of the intepreter result only when
	     * this is the first time through the loop.
	     */

	    if (all <= 1) {
		/*
		 * If inlining, the interpreter's object result remains an
		 * empty list, otherwise set it to an integer object w/ value
		 * 0.
		 */

		if (!doinline) {
		    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
		    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
		}
		return TCL_OK;
	    }
	    break;
	}

	/*
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
450
451
452
453
454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
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







-
+







-
+








-
+



-
-
+
+


-
-
+
+



-
+















+
-
-
+
+
+
+



















-
+
-











-
+













-
+







		resultPtr = Tcl_NewObj();
	    }
	}
	for (i = 0; i < objc; i++) {
	    Tcl_Obj *newPtr;

	    if (indices) {
		size_t start, end;
		int start, end;
		Tcl_Obj *objs[2];

		/*
		 * Only adjust the match area if there was a match for that
		 * area. (Scriptics Bug 4391/SF Bug #219232)
		 */

		if (i <= (int)info.nsubs && info.matches[i].start != TCL_INDEX_NONE) {
		if (i <= info.nsubs && info.matches[i].start >= 0) {
		    start = offset + info.matches[i].start;
		    end = offset + info.matches[i].end;

		    /*
		     * Adjust index so it refers to the last character in the
		     * match instead of the first character after the match.
		     */

		    if (end + 1 >= offset + 1) {
		    if (end >= offset) {
			end--;
		    }
		} else {
		    start = TCL_INDEX_NONE;
		    end = TCL_INDEX_NONE;
		    start = -1;
		    end = -1;
		}

		TclNewIndexObj(objs[0], start);
		TclNewIndexObj(objs[1], end);
		objs[0] = Tcl_NewLongObj(start);
		objs[1] = Tcl_NewLongObj(end);

		newPtr = Tcl_NewListObj(2, objs);
	    } else {
		if (i <= (int)info.nsubs) {
		if (i <= info.nsubs) {
		    newPtr = Tcl_GetRange(objPtr,
			    offset + info.matches[i].start,
			    offset + info.matches[i].end - 1);
		} else {
		    newPtr = Tcl_NewObj();
		}
	    }
	    if (doinline) {
		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
			!= TCL_OK) {
		    Tcl_DecrRefCount(newPtr);
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    } else {
		Tcl_Obj *valuePtr;
		if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr,
			TCL_LEAVE_ERR_MSG) == NULL) {
		valuePtr = Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr, 0);
		if (valuePtr == NULL) {
		    Tcl_AppendResult(interp, "couldn't set variable \"",
			    TclGetString(objv[i]), "\"", NULL);
		    return TCL_ERROR;
		}
	    }
	}

	if (all == 0) {
	    break;
	}

	/*
	 * Adjust the offset to the character just after the last one in the
	 * matchVar and increment all to count how many times we are making a
	 * match. We always increment the offset by at least one to prevent
	 * endless looping (as in the case: regexp -all {a*} a). Otherwise,
	 * when we match the NULL string at the end of the input string, we
	 * will loop indefinately (because the length of the match is 0, so
	 * offset never changes).
	 */

	matchLength = (info.matches[0].end - info.matches[0].start);
	matchLength = info.matches[0].end - info.matches[0].start;

	offset += info.matches[0].end;

	/*
	 * A match of length zero could happen for {^} {$} or {.*} and in
	 * these cases we always want to bump the index up one.
	 */

	if (matchLength == 0) {
	    offset++;
	}
	all++;
	if (offset + 1 >= stringLength + 1) {
	if (offset >= stringLength) {
	    break;
	}
    }

    /*
     * Set the interpreter's object result to an integer object with value 1
     * if -all wasn't specified, otherwise it's all-1 (the number of times
     * through the while - 1).
     */

    if (doinline) {
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(all ? all-1 : 1));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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
611
612
613



614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625






















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







-
+




-
+
-
-
+



-
+

-
-
-
+
+
+


-
-
-
+
+
+





-
+
-


-
-
+
+






-
+



-
+






-
-
-













-
-
+
+


-
+
















-
+

-
+











-
+

-
+

-
-
+
+



-
+







-
+
-
-
-
+
+



-
+

-
-
-
+
+
+













-
-
+
+









-
+
+





-
+






-
+


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
+





-
-
+
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RegsubObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result, cflags, all, match, command, numParts;
    int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
    size_t idx, wlen, wsublen = 0, offset, numMatches;
    size_t start, end, subStart, subEnd;
    int start, end, subStart, subEnd, match;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
	"-linestop",	"-lineanchor",	"-nocase",	"-start",
    static const char *options[] = {
	"-all",		"-nocase",	"-expanded",
	"-line",	"-linestop",	"-lineanchor",	"-start",
	"--",		NULL
    };
    enum regsubobjoptions {
	REGSUB_ALL,	 REGSUB_COMMAND,    REGSUB_EXPANDED, REGSUB_LINE,
	REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_NOCASE,   REGSUB_START,
    enum options {
	REGSUB_ALL,	REGSUB_NOCASE,	REGSUB_EXPANDED,
	REGSUB_LINE,	REGSUB_LINESTOP, REGSUB_LINEANCHOR,	REGSUB_START,
	REGSUB_LAST
    };

    cflags = TCL_REG_ADVANCED;
    all = 0;
    offset = TCL_INDEX_START;
    offset = 0;
    command = 0;
    resultPtr = NULL;

    for (idx = 1; idx < (size_t)objc; idx++) {
	const char *name;
    for (idx = 1; idx < objc; idx++) {
	char *name;
	int index;

	name = TclGetString(objv[idx]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "option",
	if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
		TCL_EXACT, &index) != TCL_OK) {
	    goto optionError;
	}
	switch ((enum regsubobjoptions) index) {
	switch ((enum options) index) {
	case REGSUB_ALL:
	    all = 1;
	    break;
	case REGSUB_NOCASE:
	    cflags |= TCL_REG_NOCASE;
	    break;
	case REGSUB_COMMAND:
	    command = 1;
	    break;
	case REGSUB_EXPANDED:
	    cflags |= TCL_REG_EXPANDED;
	    break;
	case REGSUB_LINE:
	    cflags |= TCL_REG_NEWLINE;
	    break;
	case REGSUB_LINESTOP:
	    cflags |= TCL_REG_NLSTOP;
	    break;
	case REGSUB_LINEANCHOR:
	    cflags |= TCL_REG_NLANCH;
	    break;
	case REGSUB_START: {
	    size_t temp;
	    if (++idx >= (size_t)objc) {
	    int temp;
	    if (++idx >= objc) {
		goto endOfForLoop;
	    }
	    if (TclGetIntForIndexM(interp, objv[idx], (size_t)WIDE_MAX - 1, &temp) != TCL_OK) {
	    if (TclGetIntForIndexM(interp, objv[idx], 0, &temp) != TCL_OK) {
		goto optionError;
	    }
	    if (startIndex) {
		Tcl_DecrRefCount(startIndex);
	    }
	    startIndex = objv[idx];
	    Tcl_IncrRefCount(startIndex);
	    break;
	}
	case REGSUB_LAST:
	    idx++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((size_t)objc < idx + 3 || (size_t)objc > idx + 4) {
    if (objc-idx < 3 || objc-idx > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? exp string subSpec ?varName?");
		"?switches? exp string subSpec ?varName?");
    optionError:
	if (startIndex) {
	    Tcl_DecrRefCount(startIndex);
	}
	return TCL_ERROR;
    }

    objc -= idx;
    objv += idx;

    if (startIndex) {
	size_t stringLength = Tcl_GetCharLength(objv[1]);
	int stringLength = Tcl_GetCharLength(objv[1]);

	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
	Tcl_DecrRefCount(startIndex);
	if (offset == TCL_INDEX_NONE) {
	    offset = TCL_INDEX_START;
	if (offset < 0) {
	    offset = 0;
	}
    }

    if (all && (offset == TCL_INDEX_START) && (command == 0)
    if (all && (offset == 0)
	    && (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
	    && (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
	/*
	 * This is a simple one pair string map situation. We make use of a
	 * slightly modified version of the one pair STR_MAP code.
	 */

	size_t slen;
	int slen, nocase;
	int nocase, wsrclc;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,size_t);
	Tcl_UniChar *p;
	int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
	Tcl_UniChar *p, wsrclc;

	numMatches = 0;
	nocase = (cflags & TCL_REG_NOCASE);
	strCmpFn = nocase ? TclUniCharNcasecmp : TclUniCharNcmp;
	strCmpFn = nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;

	wsrc = TclGetUnicodeFromObj(objv[0], &slen);
	wstring = TclGetUnicodeFromObj(objv[1], &wlen);
	wsubspec = TclGetUnicodeFromObj(objv[2], &wsublen);
	wsrc = Tcl_GetUnicodeFromObj(objv[0], &slen);
	wstring = Tcl_GetUnicodeFromObj(objv[1], &wlen);
	wsubspec = Tcl_GetUnicodeFromObj(objv[2], &wsublen);
	wend = wstring + wlen - (slen ? slen - 1 : 0);
	result = TCL_OK;

	if (slen == 0) {
	    /*
	     * regsub behavior for "" matches between each character. 'string
	     * map' skips the "" case.
	     */

	    if (wstring < wend) {
		resultPtr = Tcl_NewUnicodeObj(wstring, 0);
		Tcl_IncrRefCount(resultPtr);
		for (; wstring < wend; wstring++) {
		    TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    TclAppendUnicodeToObj(resultPtr, wstring, 1);
		    Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    Tcl_AppendUnicodeToObj(resultPtr, wstring, 1);
		    numMatches++;
		}
		wlen = 0;
	    }
	} else {
	    wsrclc = Tcl_UniCharToLower(*wsrc);
	    for (p = wfirstChar = wstring; wstring < wend; wstring++) {
		if ((*wstring == *wsrc ||
			(nocase && Tcl_UniCharToLower(*wstring)==wsrclc)) &&
			(slen==1 || (strCmpFn(wstring, wsrc, slen) == 0))) {
			(slen==1 || (strCmpFn(wstring, wsrc,
				(unsigned long) slen) == 0))) {
		    if (numMatches == 0) {
			resultPtr = Tcl_NewUnicodeObj(wstring, 0);
			Tcl_IncrRefCount(resultPtr);
		    }
		    if (p != wstring) {
			TclAppendUnicodeToObj(resultPtr, p, wstring - p);
			Tcl_AppendUnicodeToObj(resultPtr, p, wstring - p);
			p = wstring + slen;
		    } else {
			p += slen;
		    }
		    wstring = p - 1;

		    TclAppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    Tcl_AppendUnicodeToObj(resultPtr, wsubspec, wsublen);
		    numMatches++;
		}
	    }
	    if (numMatches) {
		wlen    = wfirstChar + wlen - p;
		wstring = p;
	    }
	}
	objPtr = NULL;
	subPtr = NULL;
	goto regsubDone;
    }

    regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    if (regExpr == NULL) {
	return TCL_ERROR;
    }

    if (command) {
	/*
	 * In command-prefix mode, we require that the third non-option
	 * argument be a list, so we enforce that here. Afterwards, we fetch
	 * the RE compilation again in case objv[0] and objv[2] are the same
	 * object. (If they aren't, that's cheap to do.)
	 */

	if (Tcl_ListObjLength(interp, objv[2], &numParts) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (numParts < 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command prefix must be a list of at least one element",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGSUB",
		    "CMDEMPTY", NULL);
	    return TCL_ERROR;
	}
	regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
    }

    /*
     * Make sure to avoid problems where the objects are shared. This can
     * cause RegExpObj <> UnicodeObj shimmering that causes data corruption.
     * [Bug #461322]
     */

    if (objv[1] == objv[0]) {
	objPtr = Tcl_DuplicateObj(objv[1]);
    } else {
	objPtr = objv[1];
    }
    wstring = TclGetUnicodeFromObj(objPtr, &wlen);
    wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
    if (objv[2] == objv[0]) {
	subPtr = Tcl_DuplicateObj(objv[2]);
    } else {
	subPtr = objv[2];
    }
    if (!command) {
	wsubspec = TclGetUnicodeFromObj(subPtr, &wsublen);
    wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
    }

    result = TCL_OK;

    /*
     * The following loop is to handle multiple matches within the same source
     * string; each iteration handles one match and its corresponding
     * substitution. If "-all" hasn't been specified then the loop body only
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
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
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
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







-
+





-
+












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



















-
+













-
+






-
-
+
+











-
+









-
+











-
+







	}
	if (match == 0) {
	    break;
	}
	if (numMatches == 0) {
	    resultPtr = Tcl_NewUnicodeObj(wstring, 0);
	    Tcl_IncrRefCount(resultPtr);
	    if (offset > TCL_INDEX_START) {
	    if (offset > 0) {
		/*
		 * Copy the initial portion of the string in if an offset was
		 * specified.
		 */

		TclAppendUnicodeToObj(resultPtr, wstring, offset);
		Tcl_AppendUnicodeToObj(resultPtr, wstring, offset);
	    }
	}
	numMatches++;

	/*
	 * Copy the portion of the source string before the match to the
	 * result variable.
	 */

	Tcl_RegExpGetInfo(regExpr, &info);
	start = info.matches[0].start;
	end = info.matches[0].end;
	TclAppendUnicodeToObj(resultPtr, wstring + offset, start);
	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);

	/*
	 * In command-prefix mode, the substitutions are added as quoted
	 * arguments to the subSpec to form a command, that is then executed
	 * and the result used as the string to substitute in. Actually,
	 * everything is passed through Tcl_EvalObjv, as that's much faster.
	 */

	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    int numArgs;

	    Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
			    wstring + offset + subStart, subEnd - subStart);
		} else {
		    args[idx + numParts] = Tcl_NewObj();
		}
		Tcl_IncrRefCount(args[idx + numParts]);
	    }

	    /*
	     * At this point, we're locally holding the references to the
	     * argument words we added for this time round the loop, and the
	     * subPtr is holding the references to the words that the user
	     * supplied directly. None are zero-refcount, which is important
	     * because Tcl_EvalObjv is "hairy monster" in terms of refcount
	     * handling, being able to optionally add references to any of its
	     * argument words. We'll drop the local refs immediately
	     * afterwards; subPtr is handled in the main exit stanza.
	     */

	    result = Tcl_EvalObjv(interp, numArgs, args, 0);
	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		TclDecrRefCount(args[idx + numParts]);
	    }
	    Tcl_Free(args);
	    if (result != TCL_OK) {
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (%s substitution computation script)",
			    options[REGSUB_COMMAND]));
		}
		goto done;
	    }

	    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
	    Tcl_ResetResult(interp);

	    /*
	     * Refetch the unicode, in case the representation was smashed by
	     * the user code.
	     */

	    wstring = TclGetUnicodeFromObj(objPtr, &wlen);

	    offset += end;
	    if (end == 0 || start == end) {
		/*
		 * Always consume at least one character of the input string
		 * in order to prevent infinite loops, even when we
		 * technically matched the empty string; we must not match
		 * again at the same spot.
		 */

		if (offset < wlen) {
		    TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	    if (all) {
		continue;
	    } else {
		break;
	    }
	}

	/*
	 * Append the subSpec argument to the variable, making appropriate
	 * substitutions. This code is a bit hairy because of the backslash
	 * conventions and because the code saves up ranges of characters in
	 * subSpec to reduce the number of calls to Tcl_SetVar.
	 */

	wsrc = wfirstChar = wsubspec;
	wend = wsubspec + wsublen;
	for (ch = *wsrc; wsrc != wend; wsrc++, ch = *wsrc) {
	    if (ch == '&') {
		idx = 0;
	    } else if (ch == '\\') {
		ch = wsrc[1];
		if ((ch >= '0') && (ch <= '9')) {
		    idx = ch - '0';
		} else if ((ch == '\\') || (ch == '&')) {
		    *wsrc = ch;
		    TclAppendUnicodeToObj(resultPtr, wfirstChar,
		    Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
			    wsrc - wfirstChar + 1);
		    *wsrc = '\\';
		    wfirstChar = wsrc + 2;
		    wsrc++;
		    continue;
		} else {
		    continue;
		}
	    } else {
		continue;
	    }

	    if (wfirstChar != wsrc) {
		TclAppendUnicodeToObj(resultPtr, wfirstChar,
		Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
			wsrc - wfirstChar);
	    }

	    if (idx <= info.nsubs) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart != TCL_INDEX_NONE) && (subEnd != TCL_INDEX_NONE)) {
		    TclAppendUnicodeToObj(resultPtr,
		if ((subStart >= 0) && (subEnd >= 0)) {
		    Tcl_AppendUnicodeToObj(resultPtr,
			    wstring + offset + subStart, subEnd - subStart);
		}
	    }

	    if (*wsrc == '\\') {
		wsrc++;
	    }
	    wfirstChar = wsrc + 1;
	}

	if (wfirstChar != wsrc) {
	    TclAppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
	    Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
	}

	if (end == 0) {
	    /*
	     * Always consume at least one character of the input string in
	     * order to prevent infinite loops.
	     */

	    if (offset < wlen) {
		TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
		Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
	    }
	    offset++;
	} else {
	    offset += end;
	    if (start == end) {
		/*
		 * We matched an empty string, which means we must go forward
		 * one more step so we don't match again at the same spot.
		 */

		if (offset < wlen) {
		    TclAppendUnicodeToObj(resultPtr, wstring + offset, 1);
		    Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
		}
		offset++;
	    }
	}
	if (!all) {
	    break;
	}
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
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







-
+


-
-
+
+
+







-
+







	 * On zero matches, just ignore the offset, since it shouldn't matter
	 * to us in this case, and the user may have skewed it.
	 */

	resultPtr = objv[1];
	Tcl_IncrRefCount(resultPtr);
    } else if (offset < wlen) {
	TclAppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
    }
    if (objc == 4) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr, 0) == NULL) {
	    Tcl_AppendResult(interp, "couldn't set variable \"",
		    TclGetString(objv[3]), "\"", NULL);
	    result = TCL_ERROR;
	} else {
	    /*
	     * Set the interpreter's object result to an integer object
	     * holding the number of matches.
	     */

	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(numMatches));
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches));
	}
    } else {
	/*
	 * No varname supplied, so just return the modified string.
	 */

	Tcl_SetObjResult(interp, resultPtr);
999
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010
1011

1012
1013
1014
1015
1016
1017
1018
848
849
850
851
852
853
854

855
856
857
858
859

860
861
862
863
864
865
866
867







-
+




-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RenameObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Arbitrary value passed to the command. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *oldName, *newName;
    char *oldName, *newName;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
	return TCL_ERROR;
    }

    oldName = TclGetString(objv[1]);
1035
1036
1037
1038
1039
1040
1041
1042

1043
1044
1045
1046
1047
1048
1049
884
885
886
887
888
889
890

891
892
893
894
895
896
897
898







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ReturnObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int code, level;
    Tcl_Obj *returnOpts;

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

1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
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







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






-
-
-

-
+







-
+









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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SourceObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRSourceObjCmd, clientData, objc, objv);
}

int
TclNRSourceObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *encodingName = NULL;
    Tcl_Obj *fileName;
    int result;
    void **pkgFiles = NULL;
    void *names = NULL;

    if (objc < 2 || objc > 4) {
    if (objc != 2 && objc !=4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
	return TCL_ERROR;
    }

    fileName = objv[objc-1];

    if (objc == 4) {
	static const char *const options[] = {
	static const char *options[] = {
	    "-encoding", NULL
	};
	int index;

	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], options,
		"option", TCL_EXACT, &index)) {
	    return TCL_ERROR;
	}
	encodingName = TclGetString(objv[2]);
    } else if (objc == 3) {
	/* Handle undocumented -nopkg option. This should only be
	 * used by the internal ::tcl::Pkg::source utility function. */
	static const char *const nopkgoptions[] = {
	    "-nopkg", NULL
	};
	int index;

    }
	if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions,
		"option", TCL_EXACT, &index)) {
	    return TCL_ERROR;
	}

	pkgFiles = (void **)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
	/* Make sure that during the following TclNREvalFile no filenames
	 * are recorded for inclusion in the "package files" command */
	names = *pkgFiles;
	*pkgFiles = NULL;
    }
    result = TclNREvalFile(interp, fileName, encodingName);
    return Tcl_FSEvalFileEx(interp, fileName, encodingName);
    if (pkgFiles) {
	/* restore "tclPkgFiles" assocdata to how it was. */
	*pkgFiles = names;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SplitObjCmd --
 *
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
981
982
983
984
985
986
987

988
989
990
991
992

993
994
995

996


997
998
999
1000
1001
1002
1003
1004







-
+




-
+


-
+
-
-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SplitObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch = 0;
    Tcl_UniChar ch;
    int len;
    const char *splitChars;
    const char *stringPtr;
    char *stringPtr, *end;
    const char *end;
    size_t splitCharLen, stringLen;
    int splitCharLen, stringLen;
    Tcl_Obj *listPtr, *objPtr;

    if (objc == 2) {
	splitChars = " \n\t\r";
	splitCharLen = 4;
    } else if (objc == 3) {
	splitChars = TclGetStringFromObj(objv[2], &splitCharLen);
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
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







-
-
+
+
+
+
+
+
+







-
+

-
+






-
+







-
+







-
-
-
+
+
+
+









-
+

-
+







	 * is a *major* win when splitting on a long string (especially in the
	 * megabyte range!) - DKF
	 */

	Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);

	for ( ; stringPtr < end; stringPtr += len) {
	    len = TclUtfToUCS4(stringPtr, &ch);
	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
	    len = TclUtfToUniChar(stringPtr, &ch);

	    /*
	     * Assume Tcl_UniChar is an integral type...
	     */

	    hPtr = Tcl_CreateHashEntry(&charReuseTable, (char*)0+ch, &isNew);
	    if (isNew) {
		TclNewStringObj(objPtr, stringPtr, len);

		/*
		 * Don't need to fiddle with refcount...
		 */

		Tcl_SetHashValue(hPtr, objPtr);
		Tcl_SetHashValue(hPtr, (ClientData) objPtr);
	    } else {
		objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		objPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
	    }
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	}
	Tcl_DeleteHashTable(&charReuseTable);

    } else if (splitCharLen == 1) {
	const char *p;
	char *p;

	/*
	 * Handle the special case of splitting on a single character. This is
	 * only true for the one-char ASCII case, as one unicode char is > 1
	 * byte in length.
	 */

	while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) {
	while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) {
	    objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
	    stringPtr = p + 1;
	}
	TclNewStringObj(objPtr, stringPtr, end - stringPtr);
	Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
    } else {
	const char *element, *p, *splitEnd;
	size_t splitLen;
	int splitChar;
	char *element;
	const char *p, *splitEnd;
	int splitLen;
	Tcl_UniChar splitChar;

	/*
	 * Normal case: split on any of a given set of characters. Discard
	 * instances of the split characters.
	 */

	splitEnd = splitChars + splitCharLen;

	for (element = stringPtr; stringPtr < end; stringPtr += len) {
	    len = TclUtfToUCS4(stringPtr, &ch);
	    len = TclUtfToUniChar(stringPtr, &ch);
	    for (p = splitChars; p < splitEnd; p += splitLen) {
		splitLen = TclUtfToUCS4(p, &splitChar);
		splitLen = TclUtfToUniChar(p, &splitChar);
		if (ch == splitChar) {
		    TclNewStringObj(objPtr, element, stringPtr - element);
		    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
		    element = stringPtr + len;
		    break;
		}
	    }
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
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
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
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







-
+
-












-
+




+
-
+







+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
+


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









-
+
-












-
+




-
+
+



-
+



+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
+


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








/*
 *----------------------------------------------------------------------
 *
 * StringFirstCmd --
 *
 *	This procedure is invoked to process the "string first" Tcl command.
 *	See the user documentation for details on what it does. Note that this
 *	See the user documentation for details on what it does.
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringFirstCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *ustring1, *ustring2;
    size_t start = TCL_INDEX_START;
    int match, start, length1, length2;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    /*
     * We are searching string2 for the sequence string1.
     */

    match = -1;
    start = 0;
    length2 = -1;

    ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
    ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);

    if (objc == 4) {
	size_t end = Tcl_GetCharLength(objv[2]) - 1;
	/*
	 * If a startIndex is specified, we will need to fast forward to that
	 * point in the string before we think about a match.
	 */

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &start)) {
	if (TclGetIntForIndexM(interp, objv[3], length2-1, &start) != TCL_OK){
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringFirst(objv[1], objv[2], start));

	/*
	 * Reread to prevent shimmering problems.
	 */

	ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
	ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);

	if (start >= length2) {
	    goto str_first_done;
	} else if (start > 0) {
	    ustring2 += start;
	    length2 -= start;
	} else if (start < 0) {
	    /*
	     * Invalid start index mapped to string start; Bug #423581
	     */

	    start = 0;
	}
    }

    /*
     * If the length of the needle is more than the length of the haystack, it
     * cannot be contained in there so we can avoid searching. [Bug 2960021]
     */

    if (length1 > 0 && length1 <= length2) {
	register Tcl_UniChar *p, *end;

	end = ustring2 + length2 - length1 + 1;
	for (p = ustring2;  p < end;  p++) {
	    /*
	     * Scan forward to find the first character.
	     */

	    if ((*p == *ustring1) && (TclUniCharNcmp(ustring1, p,
		    (unsigned long) length1) == 0)) {
		match = p - ustring2;
		break;
	    }
	}
    }

    /*
     * Compute the character index of the matching string by counting the
     * number of characters before the match.
     */

    if ((match != -1) && (objc == 4)) {
	match += start;
    }

  str_first_done:
    Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringLastCmd --
 *
 *	This procedure is invoked to process the "string last" Tcl command.
 *	See the user documentation for details on what it does. Note that this
 *	See the user documentation for details on what it does.
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringLastCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t last = TCL_INDEX_END;
    Tcl_UniChar *ustring1, *ustring2, *p;
    int match, start, length1, length2;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"needleString haystackString ?lastIndex?");
		"needleString haystackString ?startIndex?");
	return TCL_ERROR;
    }

    /*
     * We are searching string2 for the sequence string1.
     */

    match = -1;
    start = 0;
    length2 = -1;

    ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
    ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);

    if (objc == 4) {
	size_t end = Tcl_GetCharLength(objv[2]) - 1;
	/*
	 * If a startIndex is specified, we will need to restrict the string
	 * range to that char index in the string
	 */

	if (TCL_OK != TclGetIntForIndexM(interp, objv[3], end, &last)) {
	if (TclGetIntForIndexM(interp, objv[3], length2-1, &start) != TCL_OK){
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, TclStringLast(objv[1], objv[2], last));

	/*
	 * Reread to prevent shimmering problems.
	 */

	ustring1 = Tcl_GetUnicodeFromObj(objv[1], &length1);
	ustring2 = Tcl_GetUnicodeFromObj(objv[2], &length2);

	if (start < 0) {
	    goto str_last_done;
	} else if (start < length2) {
	    p = ustring2 + start + 1 - length1;
	} else {
	    p = ustring2 + length2 - length1;
	}
    } else {
	p = ustring2 + length2 - length1;
    }

    /*
     * If the length of the needle is more than the length of the haystack, it
     * cannot be contained in there so we can avoid searching. [Bug 2960021]
     */

    if (length1 > 0 && length1 <= length2) {
	for (; p >= ustring2; p--) {
	    /*
	     * Scan backwards to find the first character.
	     */

	    if ((*p == *ustring1) && !memcmp(ustring1, p,
		    sizeof(Tcl_UniChar) * (size_t)length1)) {
		match = p - ustring2;
		break;
	    }
	}
    }

  str_last_done:
    Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringIndexCmd --
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

1439
1440
1441
1442
1443
1444


1445
1446


1447
1448
1449
1450
1451
1452
1453
1454
1455

1456
1457
1458
1459
1460
1461

1462
1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482




1483
1484
1485



1486
1487
1488
1489

1490
1491
1492

1493
1494

1495
1496
1497
1498



1499
1500
1501
1502
1503
1504
1505
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
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
1385
1386
1387
1388







-
+




-
+







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

-
-
+
+
+

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

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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringIndexCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t index, end;
    int length, index;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string charIndex");
	return TCL_ERROR;
    }

    /*
     * Get the char length to calculate what 'end' means.
     */

     * If we have a ByteArray object, avoid indexing in the Utf string since
    end = Tcl_GetCharLength(objv[1]) - 1;
    if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
	return TCL_ERROR;
    }

     * the byte array contains one byte per character. Otherwise, use the
    if ((index != TCL_INDEX_NONE) && (index + 1 <= end + 1)) {
	int ch = Tcl_GetUniChar(objv[1], index);

     * Unicode string rep to get the index'th char.
	if (ch == -1) {
	    return TCL_OK;
	}

	/*
	 * If we have a ByteArray object, we're careful to generate a new
	 * bytearray for a result.
	 */
     */

	if (TclIsPureByteArray(objv[1])) {
	    unsigned char uch = UCHAR(ch);
    if (TclIsPureByteArray(objv[1])) {
	const unsigned char *string =
		Tcl_GetByteArrayFromObj(objv[1], &length);

	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
	} else {
	    char buf[4] = "";

	    end = Tcl_UniCharToUtf(ch, buf);
	    if ((ch >= 0xD800) && (end < 3)) {
	if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK){
	    return TCL_ERROR;
	}
	string = Tcl_GetByteArrayFromObj(objv[1], &length);
	if ((index >= 0) && (index < length)) {
		end += Tcl_UniCharToUtf(-1, buf + end);
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(string + index, 1));
	}
    }
    return TCL_OK;
}

/*
    } else {
	/*
 *----------------------------------------------------------------------
 *
	 * Get Unicode char length to calulate what 'end' means.
	 */
 * StringInsertCmd --
 *
 *	This procedure is invoked to process the "string insert" Tcl command.
 *	See the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:
 *	A standard Tcl result.
 *

 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	length = Tcl_GetCharLength(objv[1]);
static int
StringInsertCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{

    size_t length;		/* String length */
    size_t index;		/* Insert index */
    Tcl_Obj *outObj;		/* Output object */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index insertString");
	return TCL_ERROR;
    }

    length = Tcl_GetCharLength(objv[1]);
    if (TclGetIntForIndexM(interp, objv[2], length, &index) != TCL_OK) {
	return TCL_ERROR;
    }

	if (TclGetIntForIndexM(interp, objv[2], length-1, &index) != TCL_OK){
	    return TCL_ERROR;
	}
	if ((index >= 0) && (index < length)) {
    if (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    }
	    char buf[TCL_UTF_MAX];
	    Tcl_UniChar ch;

    if (index > length) {
	index = length;
    }

	    ch = Tcl_GetUniChar(objv[1], index);
    outObj = TclStringReplace(interp, objv[1], index, 0, objv[3],
	    TCL_STRING_IN_PLACE);

	    length = Tcl_UniCharToUtf(ch, buf);
    if (outObj != NULL) {
	Tcl_SetObjResult(interp, outObj);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
	return TCL_OK;
    }

    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringIsCmd --
 *
1514
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526

1527
1528

1529
1530
1531
1532
1533
1534

1535
1536
1537
1538
1539
1540





1541
1542
1543
1544
1545
1546
1547






1548
1549
1550

1551
1552
1553

1554
1555
1556
1557
1558
1559
1560
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
1439
1440
1441







-
+





+

-
+
-
-



-
+

-
-
-
-
-
+
+
+
+
+

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

-
+


-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringIsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *end, *stop;
    Tcl_UniChar ch;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, result = 1, strict = 0, index, length3;
    int i, failat = 0, result = 1, strict = 0, index, length1, length2;
    size_t failat = 0;
    size_t length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
    static const char *isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict",		"digit",	"double",
	"entier",	"false",	"graph",	"integer",
	"list",		"lower",	"print",	"punct",
	"space",	"true",		"upper",	"wideinteger",
	"wordchar",	"xdigit",	NULL
	"boolean",	"digit",	"double",	"false",
	"graph",	"integer",	"list",		"lower",
	"print",	"punct",	"space",	"true",
	"upper",	"wideinteger",	"wordchar",	"xdigit",
	NULL
    };
    enum isClassesEnum {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_DICT,	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,
    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
	STR_IS_WORD,	STR_IS_XDIGIT
    };
    static const char *const isOptions[] = {
    static const char *isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptionsEnum {
    enum isOptions {
	OPT_STRICT, OPT_FAILIDX
    };

    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"class ?-strict? ?-failindex var? str");
	return TCL_ERROR;
1568
1569
1570
1571
1572
1573
1574
1575

1576
1577
1578
1579
1580
1581
1582
1449
1450
1451
1452
1453
1454
1455

1456
1457
1458
1459
1460
1461
1462
1463







-
+







	for (i = 2; i < objc-1; i++) {
	    int idx2;

	    if (Tcl_GetIndexFromObj(interp, objv[i], isOptions, "option", 0,
		    &idx2) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum isOptionsEnum) idx2) {
	    switch ((enum isOptions) idx2) {
	    case OPT_STRICT:
		strict = 1;
		break;
	    case OPT_FAILIDX:
		if (i+1 >= objc-1) {
		    Tcl_WrongNumArgs(interp, 2, objv,
			    "?-strict? ?-failindex var? str");
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
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
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
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
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552





















1553
1554








1555









1556




1557

1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569







-
+












-
+
-






+
-
-
+
+
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
+
+
+
+
+
+



















+








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

-
+



+








    objPtr = objv[objc-1];

    /*
     * When entering here, result == 1 and failat == 0.
     */

    switch ((enum isClassesEnum) index) {
    switch ((enum isClasses) index) {
    case STR_IS_ALNUM:
	chcomp = Tcl_UniCharIsAlnum;
	break;
    case STR_IS_ALPHA:
	chcomp = Tcl_UniCharIsAlpha;
	break;
    case STR_IS_ASCII:
	chcomp = UniCharIsAscii;
	break;
    case STR_IS_BOOL:
    case STR_IS_TRUE:
    case STR_IS_FALSE:
	if (!TclHasIntRep(objPtr, &tclBooleanType)
	if (TCL_OK != Tcl_ConvertToType(NULL, objPtr, &tclBooleanType)) {
		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
	    if (strict) {
		result = 0;
	    } else {
		string1 = TclGetStringFromObj(objPtr, &length1);
		result = length1 == 0;
	    }
	} else if (((index == STR_IS_TRUE) &&
	} else if ((objPtr->internalRep.wideValue != 0)
		? (index == STR_IS_FALSE) : (index == STR_IS_TRUE)) {
		objPtr->internalRep.longValue == 0)
	    || ((index == STR_IS_FALSE) &&
		objPtr->internalRep.longValue != 0)) {
	    result = 0;
	}
	break;
    case STR_IS_CONTROL:
	chcomp = Tcl_UniCharIsControl;
	break;
    case STR_IS_DICT: {
	int dresult, dsize;

	dresult = Tcl_DictObjSize(interp, objPtr, &dsize);
	Tcl_ResetResult(interp);
	result = (dresult == TCL_OK) ? 1 : 0;
	if (dresult != TCL_OK && failVarObj != NULL) {
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetDictFromAny().
	     */

	    const char *elemStart, *nextElem;
	    int lenRemain;
	    size_t elemSize;
	    const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
			&elemStart, &nextElem, &elemSize, NULL)) {
		    Tcl_Obj *tmpStr;

		    /*
		     * This is the simplest way of getting the number of
		     * characters parsed. Note that this is not the same as
		     * the number of bytes when parsing strings with non-ASCII
		     * characters in them.
		     *
		     * Skip leading spaces first. This is only really an issue
		     * if it is the first "element" that has the failure.
		     */

		    while (TclIsSpaceProc(*p)) {
			p++;
		    }
		    TclNewStringObj(tmpStr, string1, p-string1);
		    failat = Tcl_GetCharLength(tmpStr);
		    TclDecrRefCount(tmpStr);
		    break;
		}
	    }
	}
	break;
    }
    case STR_IS_DIGIT:
	chcomp = Tcl_UniCharIsDigit;
	break;
    case STR_IS_DOUBLE: {
	if (TclHasIntRep(objPtr, &tclDoubleType) ||
		TclHasIntRep(objPtr, &tclIntType) ||
		TclHasIntRep(objPtr, &tclBignumType)) {
	if ((objPtr->typePtr == &tclDoubleType) ||
		(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, 0) != TCL_OK) {
	    result = 0;
	    failat = 0;
	} else {
	    failat = stop - string1;
	    if (stop < end) {
		result = 0;
		TclFreeIntRep(objPtr);
		objPtr->typePtr = NULL;
	    }
	}
	break;
    }
    case STR_IS_GRAPH:
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
    case STR_IS_ENTIER:
	if (TclHasIntRep(objPtr, &tclIntType) ||
		TclHasIntRep(objPtr, &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;
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    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.
	     */

	goto failedIntParse;
	    result = 0;
	    failat = 0;
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == TclGetWideIntFromObj(NULL, objPtr, &w)) {
	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
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
1820
1821
1822
1823
1824
1825
1826
1827
1828

1829
1830

1831
1832
1833
1834
1835
1836
1837
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
1631
1632
1633
1634
1635
1636
1637







+















-
+











-
+
-
-
+







		 * 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.
		 */

		failat = stop - string1;
		TclFreeIntRep(objPtr);
		objPtr->typePtr = NULL;
	    }
	} else {
	    /*
	     * No prefix is a valid integer. Fail at beginning.
	     */

	    failat = 0;
	}
	break;
    case STR_IS_LIST:
	/*
	 * We ignore the strictness here, since empty strings are always
	 * well-formed lists.
	 */

	if (TCL_OK == TclListObjLength(NULL, objPtr, &length3)) {
	if (TCL_OK == TclListObjLength(NULL, objPtr, &length2)) {
	    break;
	}

	if (failVarObj != NULL) {
	    /*
	     * Need to figure out where the list parsing failed, which is
	     * fairly expensive. This is adapted from the core of
	     * SetListFromAny().
	     */

	    const char *elemStart, *nextElem;
	    size_t lenRemain;
	    int lenRemain, elemSize;
	    size_t elemSize;
	    const char *p;
	    register const char *p;

	    string1 = TclGetStringFromObj(objPtr, &length1);
	    end = string1 + length1;
	    failat = -1;
	    for (p=string1, lenRemain=length1; lenRemain > 0;
		    p=nextElem, lenRemain=end-nextElem) {
		if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
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
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







-
-
-
-
+
+












-
-
-
-
+
+
+
+
-
















-
+







	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	for (; string1 < end; string1 += length2, failat++) {
	    int ucs4;

	    length2 = TclUtfToUCS4(string1, &ucs4);
	    if (!chcomp(ucs4)) {
	    length2 = TclUtfToUniChar(string1, &ch);
	    if (!chcomp(ch)) {
		result = 0;
		break;
	    }
	}
    }

    /*
     * Only set the failVarObj when we will return 0 and we have indicated a
     * valid fail index (>= 0).
     */

 str_is_done:
    if ((result == 0) && (failVarObj != NULL)) {
	TclNewIndexObj(objPtr, failat);
	if (Tcl_ObjSetVar2(interp, failVarObj, NULL, objPtr, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
    if ((result == 0) && (failVarObj != NULL) &&
	Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
		TCL_LEAVE_ERR_MSG) == NULL) {
	return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;
}

static int
UniCharIsAscii(
    int character)
{
    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
    return (character >= 0) && (character < 0x80) && isxdigit(character);
}

/*
 *----------------------------------------------------------------------
 *
 * StringMapCmd --
 *
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
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
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
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







-
+




-
+



-
+










-
+


-
-
+
+
-
-






-
+


-
+
-








-
-
+
+








-
+







+
-
+


-
-
+
+



-
-
+



-














-
-















-
+









-
+















-
+
-
-
+

-
+








-
+





-
+

-
+






-
+




-
-
+
+
-








-
-
+
+
+

+
-
+


-
+
















-
-
+
+





-
+















-
+
















-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringMapCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2,  mapElemc, index;
    int length1, length2, mapElemc, index;
    int nocase = 0, mapWithDict = 0, copySource = 0;
    Tcl_Obj **mapElemv, *sourceObj, *resultPtr;
    Tcl_UniChar *ustring1, *ustring2, *p, *end;
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, size_t);
    int (*strCmpFn)(const Tcl_UniChar*, const Tcl_UniChar*, unsigned long);

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? charMap string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	const char *string = TclGetStringFromObj(objv[1], &length2);

	if ((length2 > 1) &&
		strncmp(string, "-nocase", length2) == 0) {
		strncmp(string, "-nocase", (size_t) length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_AppendResult(interp, "bad option \"", string,
		    "\": must be -nocase", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20.1 for illustration why!)
     * inconsistencies (see test string-10.20 for illustration why!)
     */

    if (!TclHasStringRep(objv[objc-2])
    if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
	    && TclHasIntRep(objv[objc-2], &tclDictType)) {
	int i, done;
	Tcl_DictSearch search;

	/*
	 * We know the type exactly, so all dict operations will succeed for
	 * sure. This shortens this code quite a bit.
	 */

	Tcl_DictObjSize(interp, objv[objc-2], &i);
	if (i == 0) {
	Tcl_DictObjSize(interp, objv[objc-2], &mapElemc);
	if (mapElemc == 0) {
	    /*
	     * Empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
	}

	mapElemc = 2 * i;
	mapElemc *= 2;
	mapWithDict = 1;

	/*
	 * Copy the dictionary out into an array; that's the easiest way to
	 * adapt this code...
	 */

	mapElemv = (Tcl_Obj **)
	mapElemv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
		TclStackAlloc(interp, sizeof(Tcl_Obj *) * mapElemc);
	Tcl_DictObjFirst(interp, objv[objc-2], &search, mapElemv+0,
		mapElemv+1, &done);
	for (index=2 ; index<mapElemc ; index+=2) {
	    Tcl_DictObjNext(&search, mapElemv+index, mapElemv+index+1, &done);
	for (i=2 ; i<mapElemc ; i+=2) {
	    Tcl_DictObjNext(&search, mapElemv+i, mapElemv+i+1, &done);
	}
	Tcl_DictObjDone(&search);
    } else {
	int i;
	if (TclListObjGetElements(interp, objv[objc-2], &i,
	if (TclListObjGetElements(interp, objv[objc-2], &mapElemc,
		&mapElemv) != TCL_OK) {
	    return TCL_ERROR;
	}
	mapElemc = i;
	if (mapElemc == 0) {
	    /*
	     * empty charMap, just return whatever string was given.
	     */

	    Tcl_SetObjResult(interp, objv[objc-1]);
	    return TCL_OK;
	} else if (mapElemc & 1) {
	    /*
	     * The charMap must be an even number of key/value items.
	     */

	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("char map list unbalanced", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
		    "UNBALANCED", NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Take a copy of the source string object if it is the same as the map
     * string to cut out nasty sharing crashes. [Bug 1018562]
     */

    if (objv[objc-2] == objv[objc-1]) {
	sourceObj = Tcl_DuplicateObj(objv[objc-1]);
	copySource = 1;
    } else {
	sourceObj = objv[objc-1];
    }
    ustring1 = TclGetUnicodeFromObj(sourceObj, &length1);
    ustring1 = Tcl_GetUnicodeFromObj(sourceObj, &length1);
    if (length1 == 0) {
	/*
	 * Empty input string, just stop now.
	 */

	goto done;
    }
    end = ustring1 + length1;

    strCmpFn = (nocase ? TclUniCharNcasecmp : TclUniCharNcmp);
    strCmpFn = (nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);

    /*
     * Force result to be Unicode
     */

    resultPtr = Tcl_NewUnicodeObj(ustring1, 0);

    if (mapElemc == 2) {
	/*
	 * Special case for one map pair which avoids the extra for loop and
	 * extra calls to get Unicode data. The algorithm is otherwise
	 * identical to the multi-pair case. This will be >30% faster on
	 * larger strings.
	 */

	size_t mapLen;
	int mapLen;
	int u2lc;
	Tcl_UniChar *mapString;
	Tcl_UniChar *mapString, u2lc;

	ustring2 = TclGetUnicodeFromObj(mapElemv[0], &length2);
	ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
	p = ustring1;
	if ((length2 > length1) || (length2 == 0)) {
	    /*
	     * Match string is either longer than input or empty.
	     */

	    ustring1 = end;
	} else {
	    mapString = TclGetUnicodeFromObj(mapElemv[1], &mapLen);
	    mapString = Tcl_GetUnicodeFromObj(mapElemv[1], &mapLen);
	    u2lc = (nocase ? Tcl_UniCharToLower(*ustring2) : 0);
	    for (; ustring1 < end; ustring1++) {
		if (((*ustring1 == *ustring2) ||
			(nocase&&Tcl_UniCharToLower(*ustring1)==u2lc)) &&
			(length2==1 || strCmpFn(ustring1, ustring2,
				length2) == 0)) {
				(unsigned long) length2) == 0)) {
		    if (p != ustring1) {
			TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }
		    ustring1 = p - 1;

		    TclAppendUnicodeToObj(resultPtr, mapString, mapLen);
		    Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
		}
	    }
	}
    } else {
	Tcl_UniChar **mapStrings;
	size_t *mapLens;
	Tcl_UniChar **mapStrings, *u2lc = NULL;
	int *mapLens;
	int *u2lc = 0;

	/*
	 * Precompute pointers to the unicode string and length. This saves us
	 * repeated function calls later, significantly speeding up the
	 * algorithm. We only need the lowercase first char in the nocase
	 * case.
	 */

	mapStrings = (Tcl_UniChar **)TclStackAlloc(interp, mapElemc*sizeof(Tcl_UniChar *)*2);
	mapLens = (size_t *)TclStackAlloc(interp, mapElemc * sizeof(size_t) * 2);
	mapStrings = (Tcl_UniChar **) TclStackAlloc(interp,
		mapElemc * 2 * sizeof(Tcl_UniChar *));
	mapLens = (int *) TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
	if (nocase) {
	    u2lc = (Tcl_UniChar *) TclStackAlloc(interp,
	    u2lc = (int *)TclStackAlloc(interp, mapElemc * sizeof(int));
		    mapElemc * sizeof(Tcl_UniChar));
	}
	for (index = 0; index < mapElemc; index++) {
	    mapStrings[index] = TclGetUnicodeFromObj(mapElemv[index],
	    mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
		    mapLens+index);
	    if (nocase && ((index % 2) == 0)) {
		u2lc[index/2] = Tcl_UniCharToLower(*mapStrings[index]);
	    }
	}
	for (p = ustring1; ustring1 < end; ustring1++) {
	    for (index = 0; index < mapElemc; index += 2) {
		/*
		 * Get the key string to match on.
		 */

		ustring2 = mapStrings[index];
		length2 = mapLens[index];
		if ((length2 > 0) && ((*ustring1 == *ustring2) || (nocase &&
			(Tcl_UniCharToLower(*ustring1) == u2lc[index/2]))) &&
			/* Restrict max compare length. */
			((size_t)(end-ustring1) >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, length2))) {
			(end-ustring1 >= length2) && ((length2 == 1) ||
			!strCmpFn(ustring2, ustring1, (unsigned) length2))) {
		    if (p != ustring1) {
			/*
			 * Put the skipped chars onto the result first.
			 */

			TclAppendUnicodeToObj(resultPtr, p, ustring1-p);
			Tcl_AppendUnicodeToObj(resultPtr, p, ustring1-p);
			p = ustring1 + length2;
		    } else {
			p += length2;
		    }

		    /*
		     * Adjust len to be full length of matched string.
		     */

		    ustring1 = p - 1;

		    /*
		     * Append the map value to the unicode string.
		     */

		    TclAppendUnicodeToObj(resultPtr,
		    Tcl_AppendUnicodeToObj(resultPtr,
			    mapStrings[index+1], mapLens[index+1]);
		    break;
		}
	    }
	}
	if (nocase) {
	    TclStackFree(interp, u2lc);
	}
	TclStackFree(interp, mapLens);
	TclStackFree(interp, mapStrings);
    }
    if (p != ustring1) {
	/*
	 * Put the rest of the unmapped chars onto result.
	 */

	TclAppendUnicodeToObj(resultPtr, p, ustring1 - p);
	Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
    }
    Tcl_SetObjResult(interp, resultPtr);
  done:
    if (mapWithDict) {
	TclStackFree(interp, mapElemv);
    }
    if (copySource) {
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
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







-
+












-
+



-
+


-
-
+
+
-
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringMatchCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int nocase = 0;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-nocase? pattern string");
	return TCL_ERROR;
    }

    if (objc == 4) {
	size_t length;
	int length;
	const char *string = TclGetStringFromObj(objv[1], &length);

	if ((length > 1) &&
	    strncmp(string, "-nocase", length) == 0) {
	    strncmp(string, "-nocase", (size_t) length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase", string));
	    Tcl_AppendResult(interp, "bad option \"", string,
		    "\": must be -nocase", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
    return TCL_OK;
}
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
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







-
+




+
-
+







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

+
-
-
-
-
+
+
+
+
+



-
-
+
+

-
-
+
+

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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringRangeCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const unsigned char *string;
    size_t first, last, end;
    int length, first, last;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last");
	return TCL_ERROR;
    }

    /*
     * If we have a ByteArray object, avoid indexing in the Utf string since
     * the byte array contains one byte per character. Otherwise, use the
     * Unicode string rep to get the range.
     */

    if (TclIsPureByteArray(objv[1])) {
	string = Tcl_GetByteArrayFromObj(objv[1], &length);
	length--;
    } else {
	/*
     * Get the length in actual characters; Then reduce it by one because
	 * Get the length in actual characters.
     * 'end' refers to the last character, not one past it.
     */
	 */

	string = NULL;
    end = Tcl_GetCharLength(objv[1]) - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	length = Tcl_GetCharLength(objv[1]) - 1;
    }

    if (TclGetIntForIndexM(interp, objv[2], length, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], length, &last) != TCL_OK) {
	return TCL_ERROR;
    }

    if (first == TCL_INDEX_NONE) {
	first = TCL_INDEX_START;
    if (first < 0) {
	first = 0;
    }
    if (last + 1 >= end + 1) {
	last = end;
    if (last >= length) {
	last = length;
    }
    if (last + 1 >= first + 1) {
	Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
    if (last >= first) {
	if (string != NULL) {
	    /*
	     * Reread the string to prevent shimmering nasties.
	     */

	    string = Tcl_GetByteArrayFromObj(objv[1], &length);
	    Tcl_SetObjResult(interp,
		    Tcl_NewByteArrayObj(string+first, last - first + 1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_GetRange(objv[1], first, last));
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+




+
+
-
+

















-
+

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

+

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

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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringReptCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1;
    char *string2;
    int count;
    int count, index, length1, length2;
    Tcl_Obj *resultPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string count");
	return TCL_ERROR;
    }

    if (TclGetIntFromObj(interp, objv[2], &count) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check for cases that allow us to skip copying stuff.
     */

    if (count == 1) {
	Tcl_SetObjResult(interp, objv[1]);
	return TCL_OK;
	goto done;
    } else if (count < 1) {
	goto done;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);
    if (length1 <= 0) {
	goto done;
    }

    /*
     * Only build up a string that has data. Instead of building it up with
     * repeated appends, we just allocate the necessary space once and copy
     * the string value in.
     *
     * We have to worry about overflow [Bugs 714106, 2561746].
     * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX.
     * We need to keep 2 <= length2 <= INT_MAX.
     */

    if (count > (INT_MAX / length1)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"result exceeds max size for a Tcl value (%d bytes)", INT_MAX));
	return TCL_OK;
	return TCL_ERROR;
    }
    length2 = length1 * count;

    /*
     * Include space for the NUL.
     */
    resultPtr = TclStringRepeat(interp, objv[1], count, TCL_STRING_IN_PLACE);
    if (resultPtr) {
	Tcl_SetObjResult(interp, resultPtr);
	return TCL_OK;

    string2 = attemptckalloc((unsigned) length2 + 1);
    if (string2 == NULL) {
	/*
	 * Alloc failed. Note that in this case we try to do an error message
	 * since this is a case that's most likely when the alloc is large and
	 * that's easy to do with this API. Note that if we fail allocating a
	 * short string, this will likely keel over too (and fatally).
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"string size overflow, out of memory allocating %u bytes",
		length2 + 1));
	return TCL_ERROR;
    }
    for (index = 0; index < count; index++) {
	memcpy(string2 + (length1 * index), string1, (size_t) length1);
    }
    string2[length2] = '\0';

    /*
     * We have to directly assign this instead of using Tcl_SetStringObj (and
     * indirectly TclInitStringRep) because that makes another copy of the
     * data.
     */

    TclNewObj(resultPtr);
    resultPtr->bytes = string2;
    resultPtr->length = length2;
    Tcl_SetObjResult(interp, resultPtr);

  done:
    return TCL_ERROR;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringRplcCmd --
 *
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
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







-
+




+
-
+






-
+
+


-
+




-
-
-
+
+
+

-
-
-
-
+
+
+
+





-




-
-
-
-
-
+
+
+
+
+


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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringRplcCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *ustring;
	size_t first, last, end;
    int first, last, length, end;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "string first last ?string?");
	return TCL_ERROR;
    }

    end = Tcl_GetCharLength(objv[1]) - 1;
    ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
    end = length - 1;

    if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK) {
	    TclGetIntForIndexM(interp, objv[3], end, &last) != TCL_OK){
	return TCL_ERROR;
    }

    /*
     * The following test screens out most empty substrings as candidates for
     * replacement. When they are detected, no replacement is done, and the
     * result is the original string.
     * The following test screens out most empty substrings as
     * candidates for replacement. When they are detected, no
     * replacement is done, and the result is the original string,
     */

    if ((last == TCL_INDEX_NONE) ||	/* Range ends before start of string */
	    (first + 1 > end + 1) ||	/* Range begins after end of string */
	    (last + 1 < first + 1)) {	/* Range begins after it starts */
    if ((last < 0) ||		/* Range ends before start of string */
	    (first > end) ||	/* Range begins after end of string */
	    (last < first)) {	/* Range begins after it starts */

	/*
	 * BUT!!! when (end < 0) -- an empty original string -- we can
	 * have (first <= end < 0 <= last) and an empty string is permitted
	 * to be replaced.
	 */

	Tcl_SetObjResult(interp, objv[1]);
    } else {
	Tcl_Obj *resultPtr;

	if (first == TCL_INDEX_NONE) {
	    first = TCL_INDEX_START;
	}
	if (last + 1 > end + 1) {
	    last = end;
	ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
	end = length-1;

	if (first < 0) {
	    first = 0;
	}

	resultPtr = TclStringReplace(interp, objv[1], first,
		last + 1 - first, (objc == 5) ? objv[4] : NULL,
		TCL_STRING_IN_PLACE);

	resultPtr = Tcl_NewUnicodeObj(ustring, first);
	if (objc == 5) {
	    Tcl_AppendObjToObj(resultPtr, objv[4]);
	}
	if (last < end) {
	    Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
		    end - last);
	}
	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
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







-
+









-
+









-
+
+
+












-
+




-
+

-
+
-







-
-
+
+


-
-
-
+
+
+


-
+


-
-
+
+










-
+







-
-
+









-
+
+












-
+




-
+

-
+
-







-
-
+
+



-
-
+
+

-
+



-
+








-
+

-
-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringRevCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
    Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringStartCmd --
 *
 *	This procedure is invoked to process the "string wordstart" Tcl
 *	command. See the user documentation for details on what it does.
 *	command. See the user documentation for details on what it does. Note
 *	that this command only functions correctly on properly formed Tcl UTF
 *	strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringStartCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    Tcl_UniChar ch;
    const char *p, *string;
    size_t numChars, length, cur, index;
    int cur, index, length, numChars;
    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetStringFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length) - 1;
    if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) {
    numChars = Tcl_NumUtfChars(string, length);
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetString(objv[1]);
    if (index + 1 > numChars + 1) {
	index = numChars;
    string = TclGetStringFromObj(objv[1], &length);
    if (index >= numChars) {
	index = numChars - 1;
    }
    cur = 0;
    if (index + 1 > 1) {
    if (index > 0) {
	p = Tcl_UtfAtIndex(string, index);

	TclUtfToUCS4(p, &ch);
	for (cur = index; cur != TCL_INDEX_NONE; cur--) {
	TclUtfToUniChar(p, &ch);
	for (cur = index; cur >= 0; cur--) {
	    int delta = 0;
	    const char *next;

	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }

	    next = TclUtfPrev(p, string);
	    do {
		next += delta;
		delta = TclUtfToUCS4(next, &ch);
		delta = TclUtfToUniChar(next, &ch);
	    } while (next + delta < p);
	    p = next;
	}
	if (cur != index) {
	    cur += 1;
	}
    }
    TclNewIndexObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringEndCmd --
 *
 *	This procedure is invoked to process the "string wordend" Tcl command.
 *	See the user documentation for details on what it does.
 *	See the user documentation for details on what it does. Note that this
 *	command only functions correctly on properly formed Tcl UTF strings.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringEndCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int ch;
    Tcl_UniChar ch;
    const char *p, *end, *string;
    size_t length, numChars, cur, index;
    int cur, index, length, numChars;
    Tcl_Obj *obj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string index");
	return TCL_ERROR;
    }

    string = TclGetStringFromObj(objv[1], &length);
    numChars = Tcl_NumUtfChars(string, length) - 1;
    if (TclGetIntForIndexM(interp, objv[2], numChars, &index) != TCL_OK) {
    numChars = Tcl_NumUtfChars(string, length);
    if (TclGetIntForIndexM(interp, objv[2], numChars-1, &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = TclGetStringFromObj(objv[1], &length);
    if (index == TCL_INDEX_NONE) {
	index = TCL_INDEX_START;
    if (index < 0) {
	index = 0;
    }
    if (index + 1 <= numChars + 1) {
    if (index < numChars) {
	p = Tcl_UtfAtIndex(string, index);
	end = string+length;
	for (cur = index; p < end; cur++) {
	    p += TclUtfToUCS4(p, &ch);
	    p += TclUtfToUniChar(p, &ch);
	    if (!Tcl_UniCharIsWordChar(ch)) {
		break;
	    }
	}
	if (cur == index) {
	    cur++;
	}
    } else {
	cur = numChars + 1;
	cur = numChars;
    }
    TclNewIndexObj(obj, cur);
    Tcl_SetObjResult(interp, obj);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringEqualCmd --
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
2658
2659
2660
2661
2662


2663
2664
2665


2666
2667
2668
2669

2670
2671
2672
2673
2674
2675


2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689










































































2690
2691
2692
2693
2694
2695
2696
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
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635







-
+










-
-
-
+
+
+
+









-
-
+
+

-
-
+
+



-
+




-
-
+
+
-
-
-










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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringEqualCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    const char *string2;
    int i, match, nocase = 0, reqlength = -1;
    size_t length;
    char *string1, *string2;
    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
    strCmpFn_t strCmpFn;

    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string2 = TclGetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string2, "-nocase", length)) {
	string2 = TclGetStringFromObj(objv[i], &length2);
	if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
	    nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string2, "-length", length)) {
	} else if ((length2 > 1)
		&& !strncmp(string2, "-length", (size_t)length2)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    ++i;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
	    Tcl_AppendResult(interp, "bad option \"", string2,
		    "\": must be -nocase or -length", NULL);
		    string2));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);

    if ((reqlength == 0) || (objv[0] == objv[1])) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
	return TCL_OK;
    }

    if (!nocase && TclIsPureByteArray(objv[0]) &&
	    TclIsPureByteArray(objv[1])) {
	/*
	 * Use binary versions of comparisons since that won't cause undue
	 * type conversions and it is much faster. Only do this if we're
	 * case-sensitive (which is all that really makes sense with byte
	 * arrays anyway, and we have no memcasecmp() for some reason... :^)
	 */

	string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t) memcmp;
    } else if ((objv[0]->typePtr == &tclStringType)
	    && (objv[1]->typePtr == &tclStringType)) {
	/*
	 * Do a unicode-specific comparison if both of the args are of String
	 * type. In benchmark testing this proved the most efficient check
	 * between the unicode and string comparison operations.
	 */

	string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t)
		(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
    } else {
	/*
	 * As a catch-all we will work with UTF-8. We cannot use memcmp() as
	 * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
	 * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
	 * case-sensitive and no specific length was requested.
	 */

	string1 = (char *) TclGetStringFromObj(objv[0], &length1);
	string2 = (char *) TclGetStringFromObj(objv[1], &length2);
	if ((reqlength < 0) && !nocase) {
	    strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
	} else {
	    length1 = Tcl_NumUtfChars(string1, length1);
	    length2 = Tcl_NumUtfChars(string2, length2);
	    strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
	}
    }

    if ((reqlength < 0) && (length1 != length2)) {
	match = 1;		/* This will be reversed below. */
    } else {
	length = (length1 < length2) ? length1 : length2;
	if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	} else if (reqlength < 0) {
	    /*
	     * The requested length is negative, so we ignore it by setting it
	     * to length + 1 so we correct the match var.
	     */

	    reqlength = length + 1;
	}

	match = strCmpFn(string1, string2, (unsigned) length);
	if ((match == 0) && (reqlength > length)) {
	    match = length1 - length2;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(match ? 0 : 1));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
2707
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726

2727
2728
2729
2730
2731

2732
2733
2734
2735
2736
2737

2738
2739
2740
2741
2742
2743
2744
2745
2746
2747

2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764





2765
2766
2767
2768
2769


2770
2771
2772
2773
2774


2775
2776
2777
2778
2779
2780
2781
2782
2783













2784
2785
2786




2787
2788
2789


2790
2791
2792
2793
2794






2795
2796
2797
2798
2799











2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810



























2811
2812
2813


2814
2815
2816
2817



2818
2819

2820

2821
2822

2823
2824


2825

2826
2827
2828
2829
2830
2831
2832
2646
2647
2648
2649
2650
2651
2652

2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663


2664





2665






2666










2667

2668


2669
2670
2671
2672
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
2709
2710
2711



2712
2713





2714
2715
2716
2717
2718
2719





2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731










2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759


2760
2761
2762



2763
2764
2765

2766
2767

2768


2769
2770
2771
2772
2773

2774
2775
2776
2777
2778
2779
2780
2781







-
+










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

-
-








-
-
-
-
-
+
+
+
+
+



-
-
+
+



-
-
+
+
-
-
-



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

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

-
-
+
+

-
-
-
+
+
+
-

+
-
+
-
-
+


+
+
-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringCmpCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    /*
     * Remember to keep code here in some sync with the byte-compiled versions
     * in tclExecute.c (INST_STR_EQ, INST_STR_NEQ and INST_STR_CMP as well as
     * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
     */

    int match, nocase, reqlength, status;

    char *string1, *string2;
    status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
    if (status != TCL_OK) {
	return status;
    }

    int length1, length2, i, match, length, nocase = 0, reqlength = -1;
    objv += objc-2;
    match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(match));
    return TCL_OK;
}

    typedef int (*strCmpFn_t)(const char *, const char *, unsigned int);
int
TclStringCmpOpts(
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    int *nocase,
    int *reqlength)
{
    int i;
    size_t length;
    strCmpFn_t strCmpFn;
    const char *string;

    *reqlength = -1;
    *nocase = 0;
    if (objc < 3 || objc > 6) {
    str_cmp_args:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nocase? ?-length int? string1 string2");
	return TCL_ERROR;
    }

    for (i = 1; i < objc-2; i++) {
	string = TclGetStringFromObj(objv[i], &length);
	if ((length > 1) && !strncmp(string, "-nocase", length)) {
	    *nocase = 1;
	} else if ((length > 1)
		&& !strncmp(string, "-length", length)) {
	string2 = TclGetStringFromObj(objv[i], &length2);
	if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
	    nocase = 1;
	} else if ((length2 > 1)
		&& !strncmp(string2, "-length", (size_t)length2)) {
	    if (i+1 >= objc-2) {
		goto str_cmp_args;
	    }
	    i++;
	    if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
	    ++i;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\": must be -nocase or -length",
	    Tcl_AppendResult(interp, "bad option \"", string2,
		    "\": must be -nocase or -length", NULL);
		    string));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}


    /*
     * From now on, we only access the two objects at the end of the argument
     * array.
     */

    objv += objc-2;

    if ((reqlength == 0) || (objv[0] == objv[1])) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */

/*
 *----------------------------------------------------------------------
 *
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
	return TCL_OK;
    }

 * StringCatCmd --
 *
 *	This procedure is invoked to process the "string cat" Tcl command.
    if (!nocase && TclIsPureByteArray(objv[0]) &&
	    TclIsPureByteArray(objv[1])) {
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
	/*
	 * Use binary versions of comparisons since that won't cause undue
	 * type conversions and it is much faster. Only do this if we're
	 * case-sensitive (which is all that really makes sense with byte
	 * arrays anyway, and we have no memcasecmp() for some reason... :^)
	 */
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	string1 = (char *) Tcl_GetByteArrayFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetByteArrayFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t) memcmp;
    } else if ((objv[0]->typePtr == &tclStringType)
	    && (objv[1]->typePtr == &tclStringType)) {
	/*
	 * Do a unicode-specific comparison if both of the args are of String
	 * type. In benchmark testing this proved the most efficient check
	 * between the unicode and string comparison operations.
	 */

static int
StringCatCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *objResultPtr;

    if (objc < 2) {
	string1 = (char *) Tcl_GetUnicodeFromObj(objv[0], &length1);
	string2 = (char *) Tcl_GetUnicodeFromObj(objv[1], &length2);
	strCmpFn = (strCmpFn_t)
		(nocase ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp);
    } else {
	/*
	 * As a catch-all we will work with UTF-8. We cannot use memcmp() as
	 * that is unsafe with any string containing NUL (\xC0\x80 in Tcl's
	 * utf rep). We can use the more efficient TclpUtfNcmp2 if we are
	 * case-sensitive and no specific length was requested.
	 */

	string1 = (char *) TclGetStringFromObj(objv[0], &length1);
	string2 = (char *) TclGetStringFromObj(objv[1], &length2);
	if ((reqlength < 0) && !nocase) {
	    strCmpFn = (strCmpFn_t) TclpUtfNcmp2;
	} else {
	    length1 = Tcl_NumUtfChars(string1, length1);
	    length2 = Tcl_NumUtfChars(string2, length2);
	    strCmpFn = (strCmpFn_t) (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
	}
    }

    length = (length1 < length2) ? length1 : length2;
    if (reqlength > 0 && reqlength < length) {
	length = reqlength;
    } else if (reqlength < 0) {
	/*
	 * If there are no args, the result is an empty object.
	 * Just leave the preset empty interp result.
	 * The requested length is negative, so we ignore it by setting it to
	 * length + 1 so we correct the match var.
	 */
	return TCL_OK;
    }


	reqlength = length + 1;
    }
    objResultPtr = TclStringCat(interp, objc-1, objv+1, TCL_STRING_IN_PLACE);

    match = strCmpFn(string1, string2, (unsigned) length);
    if (objResultPtr) {
    if ((match == 0) && (reqlength > length)) {
	Tcl_SetObjResult(interp, objResultPtr);
	return TCL_OK;
	match = length1 - length2;
    }

    Tcl_SetObjResult(interp,
	    Tcl_NewIntObj((match > 0) ? 1 : (match < 0) ? -1 : 0));
    return TCL_ERROR;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringBytesCmd --
 *
2842
2843
2844
2845
2846
2847
2848
2849

2850
2851
2852
2853
2854

2855
2856
2857
2858
2859
2860
2861
2862

2863
2864
2865
2866
2867
2868
2869
2791
2792
2793
2794
2795
2796
2797

2798
2799
2800
2801
2802

2803
2804
2805
2806
2807
2808
2809
2810

2811
2812
2813
2814
2815
2816
2817
2818







-
+




-
+







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringBytesCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length;
    int length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    (void) TclGetStringFromObj(objv[1], &length);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
    Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringLenCmd --
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
2828
2829
2830
2831
2832
2833
2834

2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863
2864
2865







-
+




+
+





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







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringLenCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
	return TCL_ERROR;
    }

    /*
     * If we have a ByteArray object, avoid recomputing the string since the
     * byte array contains one byte per character. Otherwise, use the Unicode
     * string rep to calculate the length.
     */

    if (objv[1]->typePtr == &tclByteArrayType) {
	(void) Tcl_GetByteArrayFromObj(objv[1], &length);
    } else {
	length = Tcl_GetCharLength(objv[1]);
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetCharLength(objv[1])));
    Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * StringLowerCmd --
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
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







-
+




-
+
-
-
+















-
+







-
+









-
+


-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringLowerCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    int length1, length2;
    const char *string1;
    char *string2;
    char *string1, *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToLower(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	size_t first, last;
	int first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == TCL_INDEX_NONE) {
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	if (last >= length1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
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
3042
3043
3044
3045
3046

3047
3048
3049

3050
3051
3052
3053
3054
3055
3056
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







-
+




-
+
-
-
+















-
+







-
-
+
+








-
+


-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringUpperCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    int length1, length2;
    const char *string1;
    char *string2;
    char *string1, *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToUpper(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	size_t first, last;
	int first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == TCL_INDEX_NONE) {
	    first = TCL_INDEX_START;
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	if (last >= length1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
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
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







-
+




-
+
-
-
+















-
+







-
-
+
+








-
+


-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringTitleCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    size_t length1, length2;
    int length1, length2;
    const char *string1;
    char *string2;
    char *string1, *string2;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?first? ?last?");
	return TCL_ERROR;
    }

    string1 = TclGetStringFromObj(objv[1], &length1);

    if (objc == 2) {
	Tcl_Obj *resultPtr = Tcl_NewStringObj(string1, length1);

	length1 = Tcl_UtfToTitle(TclGetString(resultPtr));
	Tcl_SetObjLength(resultPtr, length1);
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	size_t first, last;
	int first, last;
	const char *start, *end;
	Tcl_Obj *resultPtr;

	length1 = Tcl_NumUtfChars(string1, length1) - 1;
	if (TclGetIntForIndexM(interp,objv[2],length1, &first) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (first == TCL_INDEX_NONE) {
	    first = TCL_INDEX_START;
	if (first < 0) {
	    first = 0;
	}
	last = first;

	if ((objc == 4) && (TclGetIntForIndexM(interp, objv[3], length1,
		&last) != TCL_OK)) {
	    return TCL_ERROR;
	}

	if (last + 1 >= length1 + 1) {
	if (last >= length1) {
	    last = length1;
	}
	if (last + 1 < first + 1) {
	if (last < first) {
	    Tcl_SetObjResult(interp, objv[1]);
	    return TCL_OK;
	}

	string1 = TclGetStringFromObj(objv[1], &length1);
	start = Tcl_UtfAtIndex(string1, first);
	end = Tcl_UtfAtIndex(start, last - first + 1);
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
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







-
+





-
+




-
-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringTrimCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    size_t triml, trimr, length1, length2;
    int triml, trimr, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
	string2 = " \t\n\r";
	length2 = strlen(string2);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    triml = TclTrim(string1, length1, string2, length2, &trimr);
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
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







-
+





-
-
+




-
-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringTrimLCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;
    int trim, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
	string2 = " \t\n\r";
	length2 = strlen(string2);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    trim = TclTrimLeft(string1, length1, string2, length2);
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
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







-
+





-
-
+




-
-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringTrimRCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *string1, *string2;
    int trim;
    size_t length1, length2;
    int trim, length1, length2;

    if (objc == 3) {
	string2 = TclGetStringFromObj(objv[2], &length2);
    } else if (objc == 2) {
	string2 = tclDefaultTrimSet;
	length2 = strlen(tclDefaultTrimSet);
	string2 = " \t\n\r";
	length2 = strlen(string2);
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
	return TCL_ERROR;
    }
    string1 = TclGetStringFromObj(objv[1], &length1);

    trim = TclTrimRight(string1, length1, string2, length2);
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
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







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







 */

Tcl_Command
TclInitStringCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap stringImplMap[] = {
	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"bytelength",	StringBytesCmd,	NULL},
	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd},
	{"first",	StringFirstCmd,	NULL},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd},
	{"insert",	StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"replace",	StringRplcCmd,	TclCompileStringReplaceCmd, NULL, NULL, 0},
	{"reverse",	StringRevCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"tolower",	StringLowerCmd,	TclCompileStringToLowerCmd, NULL, NULL, 0},
	{"toupper",	StringUpperCmd,	TclCompileStringToUpperCmd, NULL, NULL, 0},
	{"totitle",	StringTitleCmd,	TclCompileStringToTitleCmd, NULL, NULL, 0},
	{"trim",	StringTrimCmd,	TclCompileStringTrimCmd, NULL, NULL, 0},
	{"trimleft",	StringTrimLCmd,	TclCompileStringTrimLCmd, NULL, NULL, 0},
	{"trimright",	StringTrimRCmd,	TclCompileStringTrimRCmd, NULL, NULL, 0},
	{"wordend",	StringEndCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"wordstart",	StringStartCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
	{"is",		StringIsCmd,	NULL},
	{"last",	StringLastCmd,	NULL},
	{"length",	StringLenCmd,	TclCompileStringLenCmd},
	{"map",		StringMapCmd,	NULL},
	{"match",	StringMatchCmd,	TclCompileStringMatchCmd},
	{"range",	StringRangeCmd,	NULL},
	{"repeat",	StringReptCmd,	NULL},
	{"replace",	StringRplcCmd,	NULL},
	{"reverse",	StringRevCmd,	NULL},
	{"tolower",	StringLowerCmd,	NULL},
	{"toupper",	StringUpperCmd,	NULL},
	{"totitle",	StringTitleCmd,	NULL},
	{"trim",	StringTrimCmd,	NULL},
	{"trimleft",	StringTrimLCmd,	NULL},
	{"trimright",	StringTrimRCmd,	NULL},
	{"wordend",	StringEndCmd,	NULL},
	{"wordstart",	StringStartCmd,	NULL},
	{NULL, NULL, NULL}
    };

    return TclMakeEnsemble(interp, "string", stringImplMap);
}

/*
 *----------------------------------------------------------------------
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
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







-
-
-
-
+
+
+
+
+
-

-
+


-
+


+
-
+

+
+
+
-
+
+
+


-
+

















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





+
+
+
-
+
+
+
+


+
-
+







 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclSubstOptions(
    Tcl_Interp *interp,
    int numOpts,
    Tcl_Obj *const opts[],
Tcl_SubstObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    int *flagPtr)
{
    static const char *const substOptions[] = {
    static const char *substOptions[] = {
	"-nobackslashes", "-nocommands", "-novariables", NULL
    };
    enum {
    enum substOptions {
	SUBST_NOBACKSLASHES, SUBST_NOCOMMANDS, SUBST_NOVARS
    };
    Tcl_Obj *resultPtr;
    int i, flags = TCL_SUBST_ALL;
    int flags, i;

    /*
     * Parse command-line options.
     */
    for (i = 0; i < numOpts; i++) {

    flags = TCL_SUBST_ALL;
    for (i = 1; i < (objc-1); i++) {
	int optionIndex;

	if (Tcl_GetIndexFromObj(interp, opts[i], substOptions, "option", 0,
	if (Tcl_GetIndexFromObj(interp, objv[i], substOptions, "switch", 0,
		&optionIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (optionIndex) {
	case SUBST_NOBACKSLASHES:
	    flags &= ~TCL_SUBST_BACKSLASHES;
	    break;
	case SUBST_NOCOMMANDS:
	    flags &= ~TCL_SUBST_COMMANDS;
	    break;
	case SUBST_NOVARS:
	    flags &= ~TCL_SUBST_VARIABLES;
	    break;
	default:
	    Tcl_Panic("Tcl_SubstObjCmd: bad option index to SubstOptions");
	}
    }
    *flagPtr = flags;
    return TCL_OK;
}

    if (i != objc-1) {
int
Tcl_SubstObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRSubstObjCmd, clientData, objc, objv);
}

int
TclNRSubstObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int flags;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-nobackslashes? ?-nocommands? ?-novariables? string");
	return TCL_ERROR;
    }

    /*
     * Perform the substitution.
     */
    if (TclSubstOptions(interp, objc-2, objv+1, &flags) != TCL_OK) {

    resultPtr = Tcl_SubstObj(interp, objv[i], flags);

    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return Tcl_NRSubstObj(interp, objv[objc-1], flags);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SwitchObjCmd --
 *
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
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







-
+




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















-
+



-
+




-
+















-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SwitchObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRSwitchObjCmd, clientData, objc, objv);
}
int
TclNRSwitchObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, index, mode, foundmode, splitObjs, numMatchesSaved;
    int noCase;
    int i,j, index, mode, foundmode, result, splitObjs, numMatchesSaved;
    int noCase, patternLength;
    size_t patternLength, j;
    const char *pattern;
    char *pattern;
    Tcl_Obj *stringObj, *indexVarObj, *matchVarObj;
    Tcl_Obj *const *savedObjv = objv;
    Tcl_RegExp regExpr = NULL;
    Interp *iPtr = (Interp *) interp;
    int pc = 0;
    int bidx = 0;		/* Index of body argument. */
    Tcl_Obj *blist = NULL;	/* List obj which is the body */
    CmdFrame *ctxPtr;		/* Copy of the topmost cmdframe, to allow us
				 * to mess with the line information */

    /*
     * If you add options that make -e and -g not unique prefixes of -exact or
     * -glob, you *must* fix TclCompileSwitchCmd's option parser as well.
     */

    static const char *const options[] = {
    static const char *options[] = {
	"-exact", "-glob", "-indexvar", "-matchvar", "-nocase", "-regexp",
	"--", NULL
    };
    enum switchOptionsEnum {
    enum options {
	OPT_EXACT, OPT_GLOB, OPT_INDEXV, OPT_MATCHV, OPT_NOCASE, OPT_REGEXP,
	OPT_LAST
    };
    typedef int (*strCmpFn_t)(const char *, const char *);
    strCmpFn_t strCmpFn = TclUtfCmp;
    strCmpFn_t strCmpFn = strcmp;

    mode = OPT_EXACT;
    foundmode = 0;
    indexVarObj = NULL;
    matchVarObj = NULL;
    numMatchesSaved = 0;
    noCase = 0;
    for (i = 1; i < objc-2; i++) {
	if (TclGetString(objv[i])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum switchOptionsEnum) index) {
	switch ((enum options) index) {
	    /*
	     * General options.
	     */

	case OPT_LAST:
	    i++;
	    goto finishedOptions;
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
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







-
+
-
-
+
-
-
+

-
-
-
-
+
+
+
+
+









-
-
-
+
+
-
-








-
-
-
+
+
-
-











-
+



-
-
+
+
-
-



-
-
+
+
-
-




















-

+
-
+









-
+













-
-
+
-
-












-
-
-
-
+
+
+
+
-
-














-
-
-
+
+
+
-
-








	default:
	    if (foundmode) {
		/*
		 * Mode already set via -exact, -glob, or -regexp.
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		Tcl_AppendResult(interp, "bad option \"",
			"bad option \"%s\": %s option already found",
			TclGetString(objv[i]), options[mode]));
			TclGetString(objv[i]), "\": ", options[mode],
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"DOUBLEOPT", NULL);
			" option already found", NULL);
		return TCL_ERROR;
	    }
	    foundmode = 1;
	    mode = index;
	    break;
	    } else {
		foundmode = 1;
		mode = index;
		break;
	    }

	    /*
	     * Check for TIP#75 options specifying the variables to write
	     * regexp information into.
	     */

	case OPT_INDEXV:
	    i++;
	    if (i >= objc-2) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"missing variable name argument to %s option",
			"-indexvar"));
		Tcl_AppendResult(interp, "missing variable name argument to ",
			"-indexvar", " option", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", NULL);
		return TCL_ERROR;
	    }
	    indexVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	case OPT_MATCHV:
	    i++;
	    if (i >= objc-2) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"missing variable name argument to %s option",
			"-matchvar"));
		Tcl_AppendResult(interp, "missing variable name argument to ",
			"-matchvar", " option", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", NULL);
		return TCL_ERROR;
	    }
	    matchVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	}
    }

  finishedOptions:
    if (objc - i < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option ...? string ?pattern body ...? ?default body?");
		"?switches? string pattern body ... ?default body?");
	return TCL_ERROR;
    }
    if (indexVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s option requires -regexp option", "-indexvar"));
	Tcl_AppendResult(interp,
		"-indexvar option requires -regexp option", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", NULL);
	return TCL_ERROR;
    }
    if (matchVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s option requires -regexp option", "-matchvar"));
	Tcl_AppendResult(interp,
		"-matchvar option requires -regexp option", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", NULL);
	return TCL_ERROR;
    }

    stringObj = objv[i];
    objc -= i + 1;
    objv += i + 1;
    bidx = i + 1;		/* First after the match string. */

    /*
     * If all of the pattern/command pairs are lumped into a single argument,
     * split them out again.
     *
     * TIP #280: Determine the lines the words in the list start at, based on
     * the same data for the list word itself. The cmdFramePtr line
     * information is manipulated directly.
     */

    splitObjs = 0;
    if (objc == 1) {
	Tcl_Obj **listv;

	blist = objv[0];

	if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK) {
	if (TclListObjGetElements(interp, objv[0], &objc, &listv) != TCL_OK){
	    return TCL_ERROR;
	}

	/*
	 * Ensure that the list is non-empty.
	 */

	if (objc < 1) {
	    Tcl_WrongNumArgs(interp, 1, savedObjv,
		    "?-option ...? string {?pattern body ...? ?default body?}");
		    "?switches? string {pattern body ... ?default body?}");
	    return TCL_ERROR;
	}
	objv = listv;
	splitObjs = 1;
    }

    /*
     * Complain if there is an odd number of words in the list of patterns and
     * bodies.
     */

    if (objc % 2) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"extra switch pattern with no body", -1));
	Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		NULL);

	/*
	 * Check if this can be due to a badly placed comment in the switch
	 * block.
	 *
	 * The following is an heuristic to detect the infamous "comment in
	 * switch" error: just check if a pattern begins with '#'.
	 */

	if (splitObjs) {
	    for (i=0 ; i<objc ; i+=2) {
		if (TclGetString(objv[i])[0] == '#') {
		    Tcl_AppendToObj(Tcl_GetObjResult(interp),
			    ", this may be due to a comment incorrectly"
			    " placed outside of a switch body - see the"
			    " \"switch\" documentation", -1);
		    Tcl_AppendResult(interp, ", this may be due to a "
			    "comment incorrectly placed outside of a "
			    "switch body - see the \"switch\" "
			    "documentation", NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			    "BADARM", "COMMENT?", NULL);
		    break;
		}
	    }
	}

	return TCL_ERROR;
    }

    /*
     * Complain if the last body is a continuation. Note that this check
     * assumes that the list is non-empty!
     */

    if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no body specified for pattern \"%s\"",
		TclGetString(objv[objc-2])));
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "no body specified for pattern \"",
		TclGetString(objv[objc-2]), "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		"FALLTHROUGH", NULL);
	return TCL_ERROR;
    }

    for (i = 0; i < objc; i += 2) {
	/*
	 * See if the pattern matches the string.
	 */
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
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







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

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







		}
		if (Tcl_ObjSetVar2(interp, matchVarObj, NULL, emptyObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    return TCL_ERROR;
		}
	    }
	    goto matchFound;
	}

	switch (mode) {
	case OPT_EXACT:
	    if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
		goto matchFound;
	    }
	    break;
	case OPT_GLOB:
	    if (Tcl_StringCaseMatch(TclGetString(stringObj),pattern,noCase)) {
		goto matchFound;
	    }
	    break;
	case OPT_REGEXP:
	    regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
		    TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
	    if (regExpr == NULL) {
		return TCL_ERROR;
	    } else {
		int matched = Tcl_RegExpExecObj(interp, regExpr, stringObj, 0,
			numMatchesSaved, 0);
	} else {
	    switch (mode) {
	    case OPT_EXACT:
		if (strCmpFn(TclGetString(stringObj), pattern) == 0) {
		    goto matchFound;
		}
		break;
	    case OPT_GLOB:
		if (Tcl_StringCaseMatch(TclGetString(stringObj), pattern,
			noCase)) {
		    goto matchFound;
		}
		break;
	    case OPT_REGEXP:
		regExpr = Tcl_GetRegExpFromObj(interp, objv[i],
			TCL_REG_ADVANCED | (noCase ? TCL_REG_NOCASE : 0));
		if (regExpr == NULL) {
		    return TCL_ERROR;
		} else {
		    int matched = Tcl_RegExpExecObj(interp, regExpr,
			    stringObj, 0, numMatchesSaved, 0);

		if (matched < 0) {
		    return TCL_ERROR;
		} else if (matched) {
		    goto matchFoundRegexp;
		}
	    }
	    break;
		    if (matched < 0) {
			return TCL_ERROR;
		    } else if (matched) {
			goto matchFoundRegexp;
		    }
		}
		break;
	    }
	}
    }
    return TCL_OK;

  matchFoundRegexp:
    /*
     * We are operating in REGEXP mode and we need to store information about
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790



3791
3792
3793

3794
3795
3796
3797
3798
3799
3800
3699
3700
3701
3702
3703
3704
3705



3706
3707
3708
3709


3710
3711
3712
3713
3714
3715
3716
3717







-
-
-
+
+
+

-
-
+







	    TclNewObj(indicesObj);
	}

	for (j=0 ; j<=info.nsubs ; j++) {
	    if (indexVarObj != NULL) {
		Tcl_Obj *rangeObjAry[2];

		if (info.matches[j].end + 1 > 1) {
		    TclNewIndexObj(rangeObjAry[0], info.matches[j].start);
		    TclNewIndexObj(rangeObjAry[1], info.matches[j].end-1);
		if (info.matches[j].end > 0) {
		    rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
		    rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
		} else {
		    TclNewIndexObj(rangeObjAry[1], TCL_INDEX_NONE);
		    rangeObjAry[0] = rangeObjAry[1];
		    rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
		}

		/*
		 * Never fails; the object is always clean at this point.
		 */

		Tcl_ListObjAppendElement(NULL, indicesObj,
3848
3849
3850
3851
3852
3853
3854
3855

3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870

3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885

3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899

3900
3901
3902
3903
3904
3905
3906
3907
3908

3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927

3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949

3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964

3965
3966
3967
3968
3969
3970


3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
3765
3766
3767
3768
3769
3770
3771

3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786

3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801

3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815

3816
3817
3818
3819
3820
3821
3822
3823
3824

3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841



3842




















3843

3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858

3859
3860
3861
3862
3863


3864
3865
3866
3867
3868
3869






























































3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889

3890
3891
3892
3893
3894

3895
3896

3897
3898
3899
3900
3901
3902
3903
3904







-
+














-
+














-
+













-
+








-
+
















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

-
+














-
+




-
-
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+




-
+

-
+








    /*
     * We've got a match. Find a body to execute, skipping bodies that are
     * "-".
     */

  matchFound:
    ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
    ctxPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
    *ctxPtr = *iPtr->cmdFramePtr;

    if (splitObjs) {
	/*
	 * We have to perform the GetSrc and other type dependent handling of
	 * the frame here because we are munging with the line numbers,
	 * something the other commands like if, etc. are not doing. Them are
	 * fine with simply passing the CmdFrame through and having the
	 * special handling done in 'info frame', or the bc compiler
	 */

	if (ctxPtr->type == TCL_LOCATION_BC) {
	    /*
	     * Type BC => ctxPtr->data.eval.path    is not used.
	     *		  ctxPtr->data.tebc.codePtr is used instead.
	     *            ctxPtr->data.tebc.codePtr is used instead.
	     */

	    TclGetSrcInfoForPc(ctxPtr);
	    pc = 1;

	    /*
	     * The line information in the cmdFrame is now a copy we do not
	     * own.
	     */
	}

	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
	    int bline = ctxPtr->line[bidx];

	    ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
	    ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
	} else {
	    /*
	     * This is either a dynamic code word, when all elements are
	     * relative to themselves, or something else less expected and
	     * where we have no information. The result is the same in both
	     * cases; tell the code to come that it doesn't know where it is,
	     * which triggers reversion to the old behavior.
	     */

	    int k;

	    ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
	    ctxPtr->line = (int *) ckalloc(objc * sizeof(int));
	    ctxPtr->nline = objc;
	    for (k=0; k < objc; k++) {
		ctxPtr->line[k] = -1;
	    }
	}
    }

    for (j = i + 1; ; j += 2) {
	if (j >= (size_t)objc) {
	if (j >= objc) {
	    /*
	     * This shouldn't happen since we've checked that the last body is
	     * not a continuation...
	     */

	    Tcl_Panic("fall-out when searching for body to match pattern");
	}
	if (strcmp(TclGetString(objv[j]), "-") != 0) {
	    break;
	}
    }

    /*
     * TIP #280: Make invoking context available to switch branch.
     */

    Tcl_NRAddCallback(interp, SwitchPostProc, INT2PTR(splitObjs), ctxPtr,
	    INT2PTR(pc), (ClientData) pattern);
    return TclNREvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
    result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j);
}

static int
SwitchPostProc(
    ClientData data[],		/* Data passed from Tcl_NRAddCallback above */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int result)			/* Result to return*/
{
    /* Unpack the preserved data */

    int splitObjs = PTR2INT(data[0]);
    CmdFrame *ctxPtr = (CmdFrame *)data[1];
    int pc = PTR2INT(data[2]);
    const char *pattern = (const char *)data[3];
    size_t patternLength = strlen(pattern);

    /*
     * Clean up TIP 280 context information
     */

    if (splitObjs) {
	Tcl_Free(ctxPtr->line);
	ckfree((char *) ctxPtr->line);
	if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
	    /*
	     * Death of SrcInfo reference.
	     */

	    Tcl_DecrRefCount(ctxPtr->data.eval.path);
	}
    }

    /*
     * Generate an error message if necessary.
     */

    if (result == TCL_ERROR) {
	unsigned limit = 50;
	int limit = 50;
	int overflow = (patternLength > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%.*s%s\" arm line %d)",
		(overflow ? limit : (unsigned)patternLength), pattern,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
		(overflow ? limit : patternLength), pattern,
		(overflow ? "..." : ""), interp->errorLine));
    }
    TclStackFree(interp, ctxPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ThrowObjCmd --
 *
 *	This procedure is invoked to process the "throw" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ThrowObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *options;
    int len;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "type message");
	return TCL_ERROR;
    }

    /*
     * The type must be a list of at least length 1.
     */

    if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
	return TCL_ERROR;
    } else if (len < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"type must be non-empty list", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Now prepare the result options dictionary. We use the list API as it is
     * slightly more convenient.
     */

    TclNewLiteralStringObj(options, "-code error -level 0 -errorcode");
    Tcl_ListObjAppendElement(NULL, options, objv[1]);

    /*
     * We're ready to go. Fire things into the low-level result machinery.
     */

    Tcl_SetObjResult(interp, objv[2]);
    return Tcl_SetReturnOptions(interp, options);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TimeObjCmd --
 *
 *	This object-based procedure is invoked to process the "time" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_TimeObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;
    Tcl_Obj *objs[4];
    int i, result;
    register int i, result;
    int count;
    double totalMicroSec;
#ifndef TCL_WIDE_CLICKS
    Tcl_Time start, stop;
#else
    Tcl_WideInt start, stop;
#endif
4086
4087
4088
4089
4090
4091
4092
4093

4094
4095
4096
4097
4098
4099
4100
3919
3920
3921
3922
3923
3924
3925

3926
3927
3928
3929
3930
3931
3932
3933







-
+







    i = count;
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&start);
#else
    start = TclpGetWideClicks();
#endif
    while (i-- > 0) {
	result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	result = Tcl_EvalObjEx(interp, objPtr, 0);
	if (result != TCL_OK) {
	    return result;
	}
    }
#ifndef TCL_WIDE_CLICKS
    Tcl_GetTime(&stop);
    totalMicroSec = ((double) (stop.sec - start.sec)) * 1.0e6
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
3981
3982
3983
3984
3985
3986
3987

3988
3989
3990
3991
3992
3993
3994
3995


3996
3997
3998

3999
4000
4001

4002
4003

4004
4005

4006
4007
4008
4009
4010

4011
4012
4013
4014
4015
4016
4017

4018
4019
4020

4021
4022
4023
4024
4025
4026
4027
4028
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







-
+







-
-
+
+

-
+


-
+

-
+

-
+




-
+






-
+


-













-
+














-
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_TimeRateObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static double measureOverhead = 0;
				/* global measure-overhead */
    double overhead = -1;	/* given measure-overhead */
    Tcl_Obj *objPtr;
    int result, i;
    register Tcl_Obj *objPtr;
    register int result, i;
    Tcl_Obj *calibrate = NULL, *direct = NULL;
    Tcl_WideUInt count = 0;	/* Holds repetition count */
    TclWideMUInt count = 0;	/* Holds repetition count */
    Tcl_WideInt maxms = WIDE_MIN;
				/* Maximal running time (in milliseconds) */
    Tcl_WideUInt maxcnt = WIDE_MAX;
    TclWideMUInt maxcnt = WIDE_MAX;
				/* Maximal count of iterations. */
    Tcl_WideUInt threshold = 1;	/* Current threshold for check time (faster
    TclWideMUInt threshold = 1;	/* Current threshold for check time (faster
				 * repeat count without time check) */
    Tcl_WideUInt maxIterTm = 1;	/* Max time of some iteration as max
    TclWideMUInt maxIterTm = 1;	/* Max time of some iteration as max
				 * threshold, additionally avoiding divide to
				 * zero (i.e., never < 1) */
    unsigned short factor = 50;	/* Factor (4..50) limiting threshold to avoid
				 * growth of execution time. */
    Tcl_WideInt start, middle, stop;
    register Tcl_WideInt start, middle, stop;
#ifndef TCL_WIDE_CLICKS
    Tcl_Time now;
#endif /* !TCL_WIDE_CLICKS */
    static const char *const options[] = {
	"-direct",	"-overhead",	"-calibrate",	"--",	NULL
    };
    enum timeRateOptionsEnum {
    enum options {
	TMRT_EV_DIRECT,	TMRT_OVERHEAD,	TMRT_CALIBRATE,	TMRT_LAST
    };
    NRE_callback *rootPtr;
    ByteCode *codePtr = NULL;

    for (i = 1; i < objc - 1; i++) {
	int index;

	if (Tcl_GetIndexFromObj(NULL, objv[i], options, "option", TCL_EXACT,
		&index) != TCL_OK) {
	    break;
	}
	if (index == TMRT_LAST) {
	    i++;
	    break;
	}
	switch ((enum timeRateOptionsEnum)index) {
	switch (index) {
	case TMRT_EV_DIRECT:
	    direct = objv[i];
	    break;
	case TMRT_OVERHEAD:
	    if (++i >= objc - 1) {
		goto usage;
	    }
	    if (Tcl_GetDoubleFromObj(interp, objv[i], &overhead) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case TMRT_CALIBRATE:
	    calibrate = objv[i];
	    break;
	case TMRT_LAST:
	    break;
	}
    }

    if (i >= objc || i < objc - 3) {
    usage:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-direct? ?-calibrate? ?-overhead double? "
4271
4272
4273
4274
4275
4276
4277
4278

4279
4280
4281
4282
4283
4284
4285
4101
4102
4103
4104
4105
4106
4107

4108
4109
4110
4111
4112
4113
4114
4115







-
+







	    measureOverhead = (double) 0;

	    /*
	     * Self-call with 100 milliseconds to warm-up, before entering the
	     * calibration cycle.
	     */

	    TclNewIntObj(clobjv[i], 100);
	    TclNewLongObj(clobjv[i], 100);
	    Tcl_IncrRefCount(clobjv[i]);
	    result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
	    Tcl_DecrRefCount(clobjv[i]);
	    if (result != TCL_OK) {
		return result;
	    }

4296
4297
4298
4299
4300
4301
4302
4303

4304
4305
4306
4307
4308
4309
4310
4126
4127
4128
4129
4130
4131
4132

4133
4134
4135
4136
4137
4138
4139
4140







-
+







	    /*
	     * Run the calibration cycle until it is more precise.
	     */

	    maxms = -1000;
	    do {
		lastMeasureOverhead = measureOverhead;
		TclNewIntObj(clobjv[i], (int) maxms);
		TclNewLongObj(clobjv[i], (int) maxms);
		Tcl_IncrRefCount(clobjv[i]);
		result = Tcl_TimeRateObjCmd(NULL, interp, i + 1, clobjv);
		Tcl_DecrRefCount(clobjv[i]);
		if (result != TCL_OK) {
		    return result;
		}
		maxCalTime += maxms;
4326
4327
4328
4329
4330
4331
4332
4333

4334
4335
4336
4337
4338
4339
4340
4156
4157
4158
4159
4160
4161
4162

4163
4164
4165
4166
4167
4168
4169
4170







-
+







	}
	if (maxms == 0) {
	    /*
	     * Reset last measurement overhead
	     */

	    measureOverhead = 0;
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
	    Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
	    return TCL_OK;
	}

	/*
	 * If time is negative, make current overhead more precise.
	 */

4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423

4424
4425
4426
4427
4428
4429
4430
4431
4239
4240
4241
4242
4243
4244
4245

4246
4247
4248
4249
4250
4251

4252

4253
4254
4255
4256
4257
4258
4259







-






-
+
-







	while (1) {
	    /*
	     * Evaluate a single iteration.
	     */

	    count++;
	    if (!direct) {		/* precompiled */
		rootPtr = TOP_CB(interp);
		/*
		 * Use loop optimized TEBC call (TCL_EVAL_DISCARD_RESULT): it's a part of
		 * iteration, this way evaluation will be more similar to a cycle (also
		 * avoids extra overhead to set result to interp, etc.)
		 */
		((Interp *)interp)->evalFlags |= TCL_EVAL_DISCARD_RESULT;
		result = TclNRExecuteByteCode(interp, codePtr);
		result = TclExecuteByteCode(interp, codePtr);
		result = TclNRRunCallbacks(interp, result, rootPtr);
	    } else {			/* eval */
		result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
	    }
	    /*
	     * Allow break and continue from measurement cycle (used for
	     * conditional stop and flow control of iterations).
	     */
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4314
4315
4316
4317
4318
4319
4320

4321
4322
4323

4324
4325
4326
4327
4328
4329
4330







-



-







	    /*
	     * Average iteration time in microsecs.
	     */

	    threshold = (middle - start) / count;
	    if (threshold > maxIterTm) {
		maxIterTm = threshold;

		/*
		 * Iterations seem to be longer.
		 */

		if (threshold > maxIterTm * 2) {
		    factor *= 2;
		    if (factor > 50) {
			factor = 50;
		    }
		} else {
		    if (factor < 50) {
4540
4541
4542
4543
4544
4545
4546
4547

4548
4549
4550
4551
4552
4553

4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565

4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583

4584
4585
4586
4587
4588
4589
4590
4366
4367
4368
4369
4370
4371
4372

4373
4374
4375
4376
4377
4378

4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389


4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407

4408
4409
4410
4411
4412
4413
4414
4415







-
+





-
+










-
-
+

















-
+







		threshold = maxcnt - count;
	    }
	}
    }

    {
	Tcl_Obj *objarr[8], **objs = objarr;
	Tcl_WideUInt usec, val;
	TclWideMUInt usec, val;
	int digits;

	/*
	 * Absolute execution time in microseconds or in wide clicks.
	 */
	usec = (Tcl_WideUInt)(middle - start);
	usec = (TclWideMUInt)(middle - start);

#ifdef TCL_WIDE_CLICKS
	/*
	 * convert execution time (in wide clicks) to microsecs.
	 */

	usec *= TclpWideClickInMicrosec();
#endif /* TCL_WIDE_CLICKS */

	if (!count) {		/* no iterations - avoid divide by zero */
	    TclNewIntObj(objs[4], 0);
	    objs[0] = objs[2] = objs[4];
	    objs[0] = objs[2] = objs[4] = Tcl_NewWideIntObj(0);
	    goto retRes;
	}

	/*
	 * If not calibrating...
	 */

	if (!calibrate) {
	    /*
	     * Minimize influence of measurement overhead.
	     */

	    if (overhead > 0) {
		/*
		 * Estimate the time of overhead (microsecs).
		 */

		Tcl_WideUInt curOverhead = overhead * count;
		TclWideMUInt curOverhead = overhead * count;

		if (usec > curOverhead) {
		    usec -= curOverhead;
		} else {
		    usec = 0;
		}
	    }
4599
4600
4601
4602
4603
4604
4605
4606

4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622

4623
4624
4625
4626
4627
4628
4629
4424
4425
4426
4427
4428
4429
4430

4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446

4447
4448
4449
4450
4451
4452
4453
4454







-
+















-
+







	    objs[0] = Tcl_NewDoubleObj(measureOverhead);
	    TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#-overhead"); /* mics */
	    objs += 2;
	}

	val = usec / count;		/* microsecs per iteration */
	if (val >= 1000000) {
	    TclNewIntObj(objs[0], val);
	    objs[0] = Tcl_NewWideIntObj(val);
	} else {
	    if (val < 10) {
		digits = 6;
	    } else if (val < 100) {
		digits = 4;
	    } else if (val < 1000) {
		digits = 3;
	    } else if (val < 10000) {
		digits = 2;
	    } else {
		digits = 1;
	    }
	    objs[0] = Tcl_ObjPrintf("%.*f", digits, ((double) usec)/count);
	}

	TclNewIntObj(objs[2], count); /* iterations */
	objs[2] = Tcl_NewWideIntObj(count); /* iterations */

	/*
	 * Calculate speed as rate (count) per sec
	 */

	if (!usec) {
	    usec++;			/* Avoid divide by zero. */
4637
4638
4639
4640
4641
4642
4643
4644

4645
4646
4647
4648
4649
4650
4651
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
4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
4462
4463
4464
4465
4466
4467
4468

4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483

4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503





























































































































































































































































































































































































































































































































































































4504
4505
4506
4507
4508
4509
4510







-
+














-
+



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







		    digits = 2;
		} else {
		    digits = 1;
		}
		objs[4] = Tcl_ObjPrintf("%.*f",
			digits, ((double) (count * 1000000)) / usec);
	    } else {
		TclNewIntObj(objs[4], val);
		objs[4] = Tcl_NewWideIntObj(val);
	    }
	} else {
	    objs[4] = Tcl_NewWideIntObj((count / usec) * 1000000);
	}

    retRes:
	/*
	 * Estimated net execution time (in millisecs).
	 */

	if (!calibrate) {
	    if (usec >= 1) {
		objs[6] = Tcl_ObjPrintf("%.3f", (double)usec / 1000);
	    } else {
		TclNewIntObj(objs[6], 0);
		objs[6] = Tcl_NewWideIntObj(0);
	    }
	    TclNewLiteralStringObj(objs[7], "net-ms");
	}

	/*
	 * Construct the result as a list because many programs have always
	 * parsed as such (extracting the first element, typically).
	 */

	TclNewLiteralStringObj(objs[1], "\xC2\xB5s/#"); /* mics/# */
	TclNewLiteralStringObj(objs[3], "#");
	TclNewLiteralStringObj(objs[5], "#/sec");
	Tcl_SetObjResult(interp, Tcl_NewListObj(8, objarr));
    }

  done:
    if (codePtr != NULL) {
	TclReleaseByteCode(codePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TryObjCmd, TclNRTryObjCmd --
 *
 *	This procedure is invoked to process the "try" Tcl command. See the
 *	user documentation (or TIP #329) for details on what it does.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_TryObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRTryObjCmd, clientData, objc, objv);
}

int
TclNRTryObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *bodyObj, *handlersObj, *finallyObj = NULL;
    int i, bodyShared, haveHandlers, dummy, code;
    static const char *const handlerNames[] = {
	"finally", "on", "trap", NULL
    };
    enum Handlers {
	TryFinally, TryOn, TryTrap
    };

    /*
     * Parse the arguments. The handlers are passed to subsequent callbacks as
     * a Tcl_Obj list of the 5-tuples like (type, returnCode, errorCodePrefix,
     * bindVariables, script), and the finally script is just passed as it is.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"body ?handler ...? ?finally script?");
	return TCL_ERROR;
    }
    bodyObj = objv[1];
    handlersObj = Tcl_NewObj();
    bodyShared = 0;
    haveHandlers = 0;
    for (i=2 ; i<objc ; i++) {
	int type;
	Tcl_Obj *info[5];

	if (Tcl_GetIndexFromObj(interp, objv[i], handlerNames, "handler type",
		0, &type) != TCL_OK) {
	    Tcl_DecrRefCount(handlersObj);
	    return TCL_ERROR;
	}
	switch ((enum Handlers) type) {
	case TryFinally:	/* finally script */
	    if (i < objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"finally clause must be last", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"NONTERMINAL", NULL);
		return TCL_ERROR;
	    } else if (i == objc-1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to finally clause: must be"
			" \"... finally script\"", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    finallyObj = objv[++i];
	    break;

	case TryOn:		/* on code variableList script */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to on clause: must be \"... on code"
			" variableList script\"", -1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    if (TclGetCompletionCodeFromObj(interp, objv[i+1],
		    &code) != TCL_OK) {
		Tcl_DecrRefCount(handlersObj);
		return TCL_ERROR;
	    }
	    info[2] = NULL;
	    goto commonHandler;

	case TryTrap:		/* trap pattern variableList script */
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong # args to trap clause: "
			"must be \"... trap pattern variableList script\"",
			-1));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    code = 1;
	    if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad prefix '%s': must be a list",
			TclGetString(objv[i+1])));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"EXNFORMAT", NULL);
		return TCL_ERROR;
	    }
	    info[2] = objv[i+1];

	commonHandler:
	    if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
		Tcl_DecrRefCount(handlersObj);
		return TCL_ERROR;
	    }

	    info[0] = objv[i];			/* type */
	    TclNewIntObj(info[1], code);	/* returnCode */
	    if (info[2] == NULL) {		/* errorCodePrefix */
		TclNewObj(info[2]);
	    }
	    info[3] = objv[i+2];		/* bindVariables */
	    info[4] = objv[i+3];		/* script */

	    bodyShared = !strcmp(TclGetString(objv[i+3]), "-");
	    Tcl_ListObjAppendElement(NULL, handlersObj,
		    Tcl_NewListObj(5, info));
	    haveHandlers = 1;
	    i += 3;
	    break;
	}
    }
    if (bodyShared) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"last non-finally clause must not have a body of \"-\"", -1));
	Tcl_DecrRefCount(handlersObj);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
		NULL);
	return TCL_ERROR;
    }
    if (!haveHandlers) {
	Tcl_DecrRefCount(handlersObj);
	handlersObj = NULL;
    }

    /*
     * Execute the body.
     */

    Tcl_NRAddCallback(interp, TryPostBody, handlersObj, finallyObj,
	    (ClientData)objv, INT2PTR(objc));
    return TclNREvalObjEx(interp, bodyObj, 0,
	    ((Interp *) interp)->cmdFramePtr, 1);
}

/*
 *----------------------------------------------------------------------
 *
 * During --
 *
 *	This helper function patches together the updates to the interpreter's
 *	return options that are needed when things fail during the processing
 *	of a handler or finally script for the [try] command.
 *
 * Returns:
 *	The new option dictionary.
 *
 *----------------------------------------------------------------------
 */

static inline Tcl_Obj *
During(
    Tcl_Interp *interp,
    int resultCode,		/* The result code from the just-evaluated
				 * script. */
    Tcl_Obj *oldOptions,	/* The old option dictionary. */
    Tcl_Obj *errorInfo)		/* An object to append to the errorinfo and
				 * release, or NULL if nothing is to be added.
				 * Designed to be used with Tcl_ObjPrintf. */
{
    Tcl_Obj *during, *options;

    if (errorInfo != NULL) {
	Tcl_AppendObjToErrorInfo(interp, errorInfo);
    }
    options = Tcl_GetReturnOptions(interp, resultCode);
    TclNewLiteralStringObj(during, "-during");
    Tcl_IncrRefCount(during);
    Tcl_DictObjPut(interp, options, during, oldOptions);
    Tcl_DecrRefCount(during);
    Tcl_IncrRefCount(options);
    Tcl_DecrRefCount(oldOptions);
    return options;
}

/*
 *----------------------------------------------------------------------
 *
 * TryPostBody --
 *
 *	Callback to handle the outcome of the execution of the body of a 'try'
 *	command.
 *
 *----------------------------------------------------------------------
 */

static int
TryPostBody(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *handlersObj, *finallyObj, *cmdObj, **objv;
    int i, code, objc;
    int numHandlers = 0;

    handlersObj = (Tcl_Obj *)data[0];
    finallyObj = (Tcl_Obj *)data[1];
    objv = (Tcl_Obj **)data[2];
    objc = PTR2INT(data[3]);

    cmdObj = objv[0];

    /*
     * Check for limits/rewinding, which override normal trapping behaviour.
     */

    if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%s\" body line %d)", TclGetString(cmdObj),
		Tcl_GetErrorLine(interp)));
	if (handlersObj != NULL) {
	    Tcl_DecrRefCount(handlersObj);
	}
	return TCL_ERROR;
    }

    /*
     * Basic processing of the outcome of the script, including adding of
     * errorinfo trace.
     */

    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"%s\" body line %d)", TclGetString(cmdObj),
		Tcl_GetErrorLine(interp)));
    }
    resultObj = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(resultObj);
    options = Tcl_GetReturnOptions(interp, result);
    Tcl_IncrRefCount(options);
    Tcl_ResetResult(interp);

    /*
     * Handle the results.
     */

    if (handlersObj != NULL) {
	int found = 0;
	Tcl_Obj **handlers, **info;

	Tcl_ListObjGetElements(NULL, handlersObj, &numHandlers, &handlers);
	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *handlerBodyObj;
	    int numElems = 0;

	    Tcl_ListObjGetElements(NULL, handlers[i], &numElems, &info);
	    if (!found) {
		Tcl_GetIntFromObj(NULL, info[1], &code);
		if (code != result) {
		    continue;
		}

		/*
		 * When processing an error, we must also perform list-prefix
		 * matching of the errorcode list. However, if this was an
		 * 'on' handler, the list that we are matching against will be
		 * empty.
		 */

		if (code == TCL_ERROR) {
		    Tcl_Obj *errorCodeName, *errcode, **bits1, **bits2;
		    int len1, len2, j;

		    TclNewLiteralStringObj(errorCodeName, "-errorcode");
		    Tcl_DictObjGet(NULL, options, errorCodeName, &errcode);
		    Tcl_DecrRefCount(errorCodeName);
		    Tcl_ListObjGetElements(NULL, info[2], &len1, &bits1);
		    if (Tcl_ListObjGetElements(NULL, errcode, &len2,
			    &bits2) != TCL_OK) {
			continue;
		    }
		    if (len2 < len1) {
			continue;
		    }
		    for (j=0 ; j<len1 ; j++) {
			if (strcmp(TclGetString(bits1[j]),
				TclGetString(bits2[j])) != 0) {
			    /*
			     * Really want 'continue outerloop;', but C does
			     * not give us that.
			     */

			    goto didNotMatch;
			}
		    }
		}

		found = 1;
	    }

	    /*
	     * Now we need to scan forward over "-" bodies. Note that we've
	     * already checked that the last body is not a "-", so this search
	     * will terminate successfully.
	     */

	    if (!strcmp(TclGetString(info[4]), "-")) {
		continue;
	    }

	    /*
	     * Bind the variables. We already know this is a list of variable
	     * names, but it might be empty.
	     */

	    Tcl_ResetResult(interp);
	    result = TCL_ERROR;
	    Tcl_ListObjLength(NULL, info[3], &numElems);
	    if (numElems> 0) {
		Tcl_Obj *varName;

		Tcl_ListObjIndex(NULL, info[3], 0, &varName);
		if (Tcl_ObjSetVar2(interp, varName, NULL, resultObj,
			TCL_LEAVE_ERR_MSG) == NULL) {
		    Tcl_DecrRefCount(resultObj);
		    goto handlerFailed;
		}
		Tcl_DecrRefCount(resultObj);
		if (numElems> 1) {
		    Tcl_ListObjIndex(NULL, info[3], 1, &varName);
		    if (Tcl_ObjSetVar2(interp, varName, NULL, options,
			    TCL_LEAVE_ERR_MSG) == NULL) {
			goto handlerFailed;
		    }
		}
	    } else {
		/*
		 * Dispose of the result to prevent a memleak. [Bug 2910044]
		 */

		Tcl_DecrRefCount(resultObj);
	    }

	    /*
	     * Evaluate the handler body and process the outcome. Note that we
	     * need to keep the kind of handler for debugging purposes, and in
	     * any case anything we want from info[] must be extracted right
	     * now because the info[] array is about to become invalid. There
	     * is very little refcount handling here however, since we know
	     * that the objects that we still want to refer to now were input
	     * arguments to [try] and so are still on the Tcl value stack.
	     */

	    handlerBodyObj = info[4];
	    Tcl_NRAddCallback(interp, TryPostHandler, objv, options, info[0],
		    INT2PTR((finallyObj == NULL) ? 0 : objc - 1));
	    Tcl_DecrRefCount(handlersObj);
	    return TclNREvalObjEx(interp, handlerBodyObj, 0,
		    ((Interp *) interp)->cmdFramePtr, 4*i + 5);

	handlerFailed:
	    resultObj = Tcl_GetObjResult(interp);
	    Tcl_IncrRefCount(resultObj);
	    options = During(interp, result, options, NULL);
	    break;

	didNotMatch:
	    continue;
	}

	/*
	 * No handler matched; get rid of the list of handlers.
	 */

	Tcl_DecrRefCount(handlersObj);
    }

    /*
     * Process the finally clause.
     */

    if (finallyObj != NULL) {
	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
		NULL);
	return TclNREvalObjEx(interp, finallyObj, 0,
		((Interp *) interp)->cmdFramePtr, objc - 1);
    }

    /*
     * Install the correct result/options into the interpreter and clean up
     * any temporary storage.
     */

    result = Tcl_SetReturnOptions(interp, options);
    Tcl_DecrRefCount(options);
    Tcl_SetObjResult(interp, resultObj);
    Tcl_DecrRefCount(resultObj);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TryPostHandler --
 *
 *	Callback to handle the outcome of the execution of a handler of a
 *	'try' command.
 *
 *----------------------------------------------------------------------
 */

static int
TryPostHandler(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *cmdObj, *options, *handlerKindObj, **objv;
    Tcl_Obj *finallyObj;
    int finally;

    objv = (Tcl_Obj **)data[0];
    options = (Tcl_Obj *)data[1];
    handlerKindObj = (Tcl_Obj *)data[2];
    finally = PTR2INT(data[3]);

    cmdObj = objv[0];
    finallyObj = finally ? objv[finally] : 0;

    /*
     * Check for limits/rewinding, which override normal trapping behaviour.
     */

    if (((Interp*) interp)->execEnvPtr->rewind || Tcl_LimitExceeded(interp)) {
	options = During(interp, result, options, Tcl_ObjPrintf(
		"\n    (\"%s ... %s\" handler line %d)",
		TclGetString(cmdObj), TclGetString(handlerKindObj),
		Tcl_GetErrorLine(interp)));
	Tcl_DecrRefCount(options);
	return TCL_ERROR;
    }

    /*
     * The handler result completely substitutes for the result of the body.
     */

    resultObj = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(resultObj);
    if (result == TCL_ERROR) {
	options = During(interp, result, options, Tcl_ObjPrintf(
		"\n    (\"%s ... %s\" handler line %d)",
		TclGetString(cmdObj), TclGetString(handlerKindObj),
		Tcl_GetErrorLine(interp)));
    } else {
	Tcl_DecrRefCount(options);
	options = Tcl_GetReturnOptions(interp, result);
	Tcl_IncrRefCount(options);
    }

    /*
     * Process the finally clause if it is present.
     */

    if (finallyObj != NULL) {
	Interp *iPtr = (Interp *) interp;

	Tcl_NRAddCallback(interp, TryPostFinal, resultObj, options, cmdObj,
		NULL);

	/* The 'finally' script is always the last argument word. */
	return TclNREvalObjEx(interp, finallyObj, 0, iPtr->cmdFramePtr,
		finally);
    }

    /*
     * Install the correct result/options into the interpreter and clean up
     * any temporary storage.
     */

    result = Tcl_SetReturnOptions(interp, options);
    Tcl_DecrRefCount(options);
    Tcl_SetObjResult(interp, resultObj);
    Tcl_DecrRefCount(resultObj);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TryPostFinal --
 *
 *	Callback to handle the outcome of the execution of the finally script
 *	of a 'try' command.
 *
 *----------------------------------------------------------------------
 */

static int
TryPostFinal(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *resultObj, *options, *cmdObj;

    resultObj = (Tcl_Obj *)data[0];
    options = (Tcl_Obj *)data[1];
    cmdObj = (Tcl_Obj *)data[2];

    /*
     * If the result wasn't OK, we need to adjust the result options.
     */

    if (result != TCL_OK) {
	Tcl_DecrRefCount(resultObj);
	resultObj = NULL;
	if (result == TCL_ERROR) {
	    options = During(interp, result, options, Tcl_ObjPrintf(
		    "\n    (\"%s ... finally\" body line %d)",
		    TclGetString(cmdObj), Tcl_GetErrorLine(interp)));
	} else {
	    Tcl_Obj *origOptions = options;

	    options = Tcl_GetReturnOptions(interp, result);
	    Tcl_IncrRefCount(options);
	    Tcl_DecrRefCount(origOptions);
	}
    }

    /*
     * Install the correct result/options into the interpreter and clean up
     * any temporary storage.
     */

    result = Tcl_SetReturnOptions(interp, options);
    Tcl_DecrRefCount(options);
    if (resultObj != NULL) {
	Tcl_SetObjResult(interp, resultObj);
	Tcl_DecrRefCount(resultObj);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WhileObjCmd --
5271
5272
5273
5274
5275
5276
5277
5278

5279
5280
5281
5282
5283
5284
5285

5286
5287
5288
5289

5290
5291
5292

5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304









5305
5306
5307
5308
5309
5310
5311















5312
5313


5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336




5337
5338
5339
5340

5341
5342
5343
5344


5345
5346
5347
5348


5349
5350
5351
5352
5353
5354
5355

5356
5357


5358
5359
5360
5361
5362
5363
5364
4523
4524
4525
4526
4527
4528
4529

4530
4531
4532
4533
4534



4535




4536



4537


4538
4539
4540
4541
4542





4543
4544
4545
4546
4547
4548
4549
4550
4551







4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566


4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588



4589
4590
4591
4592
4593
4594
4595

4596
4597
4598


4599
4600
4601
4602


4603
4604
4605
4606
4607
4608
4609
4610

4611
4612

4613
4614
4615
4616
4617
4618
4619
4620
4621







-
+




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





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




















-
-
-
+
+
+
+



-
+


-
-
+
+


-
-
+
+






-
+

-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WhileObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRWhileObjCmd, clientData, objc, objv);
}

    int result, value;
int
TclNRWhileObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    Interp *iPtr = (Interp *) interp;
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    ForIterData *iterPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "test command");
	return TCL_ERROR;
    }

    /*
     * We reuse [for]'s callback, passing a NULL for the 'next' script.
     */

    TclSmallAllocEx(interp, sizeof(ForIterData), iterPtr);
    while (1) {
	result = Tcl_ExprBooleanObj(interp, objv[1], &value);
	if (result != TCL_OK) {
	    return result;
	}
	if (!value) {
	    break;
	}

    iterPtr->cond = objv[1];
    iterPtr->body = objv[2];
    iterPtr->next = NULL;
    iterPtr->msg  = "\n    (\"while\" body line %d)";
    iterPtr->word = 2;

    TclNRAddCallback(interp, TclNRForIterCallback, iterPtr, NULL,
	/* TIP #280. */
        result = TclEvalObjEx(interp, objv[2], 0, iPtr->cmdFramePtr, 2);
	if ((result != TCL_OK) && (result != TCL_CONTINUE)) {
	    if (result == TCL_ERROR) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (\"while\" body line %d)", interp->errorLine));
	    }
	    break;
	}
    }
    if (result == TCL_BREAK) {
	result = TCL_OK;
    }
    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
	    NULL, NULL);
    return TCL_OK;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListLines --
 *
 *	???
 *
 * Results:
 *	Filled in array of line numbers?
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclListLines(
    Tcl_Obj *listObj,		/* Pointer to obj holding a string with list
				 * structure. Assumed to be valid. Assumed to
				 * contain n elements. */
    Tcl_Obj* listObj,          /* Pointer to obj holding a string with list
				* structure.  Assumed to be valid. Assumed to
				* contain n elements.
				*/
    int line,			/* Line the list as a whole starts on. */
    int n,			/* #elements in lines */
    int *lines,			/* Array of line numbers, to fill. */
    Tcl_Obj *const *elems)      /* The list elems as Tcl_Obj*, in need of
    Tcl_Obj* const* elems)      /* The list elems as Tcl_Obj*, in need of
				 * derived continuation data */
{
    const char *listStr = TclGetString(listObj);
    const char *listHead = listStr;
    const char*  listStr  = Tcl_GetString (listObj);
    const char*  listHead = listStr;
    int i, length = strlen(listStr);
    const char *element = NULL, *next = NULL;
    ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
    int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
    ContLineLoc* clLocPtr = TclContinuationsGet(listObj);
    int* clNext   = (clLocPtr ? &clLocPtr->loc[0] : NULL);

    for (i = 0; i < n; i++) {
	TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);

	TclAdvanceLines(&line, listStr, element);
				/* Leading whitespace */
	TclAdvanceContinuations(&line, &clNext, element - listHead);
	TclAdvanceContinuations (&line, &clNext, element - listHead);
	if (elems && clNext) {
	    TclContinuationsEnterDerived(elems[i], element-listHead, clNext);
	    TclContinuationsEnterDerived (elems[i], element - listHead,
					  clNext);
	}
	lines[i] = line;
	length -= (next - listStr);
	TclAdvanceLines(&line, element, next);
				/* Element */
	listStr = next;

Changes to generic/tclCompCmds.c.

1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18





















































































































19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39



















































40
41
42
43
44
45

46
47
48
49

50
51
52
53
54
55
56
57





58
59
60
61

62
63
64
65

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111


112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131


132
133
134
135
136
137
138
139
140
141
142
143
144
145

146
147
148
149

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


164
165
166
167
168
169
170

171
172

173
174
175
176
177

178
179
180


181
182

183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203

204
205
206

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271

272
273
274
275
276

277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294

295
296
297
298


299
300
301
302
303
304
305
306

307
308
309
310

311
312
313
314
315
316
317
318
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
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
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
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









-
+







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





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





-
+



-
+
-


-
-
-
-
-
+
+
+
+
+
-


-
+



-
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
+
+

















-

-
+
+

-











-
+
-


-
+












-
-
+
+







+


+





+



+
+

-
+




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











-
-
+
+










-
+


-
+
+


-
-
-





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

-
+
-
-
-







/*
 * tclCompCmds.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands into a sequence of instructions ("bytecodes").
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2013 by Donal K. Fellows.
 * Copyright (c) 2004-2006 by Donal K. Fellows.
 *
 * 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 "tclCompile.h"
#include <assert.h>

/*
 * Macro that encapsulates an efficiency trick that avoids a function call for
 * the simplest of compiles. The ANSI C "prototype" for this macro is:
 *
 * static void		CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp, int word);
 */

#define CompileWord(envPtr, tokenPtr, interp, word) \
    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) { \
	TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \
		(tokenPtr)[1].size), (envPtr)); \
    } else { \
        envPtr->line   = mapPtr->loc[eclIndex].line[word]; \
        envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \
	TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
		(envPtr)); \
    }

/*
 * TIP #280: Remember the per-word line information of the current command. An
 * index is used instead of a pointer as recursive compilation may reallocate,
 * i.e. move, the array. This is also the reason to save the nuloc now, it may
 * change during the course of the function.
 *
 * Macro to encapsulate the variable definition and setup.
 */

#define DefineLineInformation \
    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \
    int eclIndex = mapPtr->nuloc - 1

#define SetLineInformation(word) \
    envPtr->line   = mapPtr->loc [eclIndex].line [(word)]; \
    envPtr->clNext = mapPtr->loc [eclIndex].next [(word)]

/*
 * Convenience macro for use when compiling bodies of commands. The ANSI C
 * "prototype" for this macro is:
 *
 * static void		CompileBody(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp);
 */

#define CompileBody(envPtr, tokenPtr, interp) \
    TclCompileCmdWord((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
	    (envPtr))

/*
 * Convenience macro for use when compiling tokens to be pushed. The ANSI C
 * "prototype" for this macro is:
 *
 * static void		CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp);
 */

#define CompileTokens(envPtr, tokenPtr, interp) \
    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
            (envPtr));
/*
 * Convenience macro for use when pushing literals. The ANSI C "prototype" for
 * this macro is:
 *
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, int length);
 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))

/*
 * Macro to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
 *
 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

#define TokenAfter(tokenPtr) \
    ((tokenPtr) + ((tokenPtr)->numComponents + 1))

/*
 * Macro to get the offset to the next instruction to be issued. The ANSI C
 * "prototype" for this macro is:
 *
 * static int	CurrentOffset(CompileEnv *envPtr);
 */

#define CurrentOffset(envPtr) \
    ((envPtr)->codeNext - (envPtr)->codeStart)

/*
 * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
 * maximal depth of nested CATCH ranges in order to alloc runtime
 * memory. These macros should compute precisely that? OTOH, the nesting depth
 * of LOOP ranges is an interesting datum for debugging purposes, and that is
 * what we compute now.
 *
 * static int	DeclareExceptionRange(CompileEnv *envPtr, int type);
 * static int	ExceptionRangeStarts(CompileEnv *envPtr, int index);
 * static void	ExceptionRangeEnds(CompileEnv *envPtr, int index);
 * static void	ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
 */

#define DeclareExceptionRange(envPtr, type) \
    (TclCreateExceptRange((type), (envPtr)))
#define ExceptionRangeStarts(envPtr, index) \
    (((envPtr)->exceptDepth++), \
    ((envPtr)->maxExceptDepth = \
	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)), \
    ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
#define ExceptionRangeEnds(envPtr, index) \
    (((envPtr)->exceptDepth--), \
    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes = \
	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
#define ExceptionRangeTarget(envPtr, index, targetType) \
    ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))

/*
 * Prototypes for procedures defined later in this file:
 */

static AuxDataDupProc	DupDictUpdateInfo;
static AuxDataFreeProc	FreeDictUpdateInfo;
static AuxDataPrintProc	PrintDictUpdateInfo;
static AuxDataPrintProc	DisassembleDictUpdateInfo;
static AuxDataDupProc	DupForeachInfo;
static AuxDataFreeProc	FreeForeachInfo;
static AuxDataPrintProc	PrintForeachInfo;
static AuxDataPrintProc	DisassembleForeachInfo;
static AuxDataPrintProc	PrintNewForeachInfo;
static AuxDataPrintProc	DisassembleNewForeachInfo;
static int		CompileEachloopCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    CompileEnv *envPtr, int collect);
static int		CompileDictEachCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr, int collect);
static ClientData	DupDictUpdateInfo(ClientData clientData);
static void		FreeDictUpdateInfo(ClientData clientData);
static void		PrintDictUpdateInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static ClientData	DupForeachInfo(ClientData clientData);
static void		FreeForeachInfo(ClientData clientData);
static void		PrintForeachInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static ClientData	DupJumptableInfo(ClientData clientData);
static void		FreeJumptableInfo(ClientData clientData);
static void		PrintJumptableInfo(ClientData clientData,
			    Tcl_Obj *appendObj, ByteCode *codePtr,
			    unsigned int pcOffset);
static int		LocalScalarFromToken(Tcl_Token *tokenPtr,
			    CompileEnv *envPtr);
static int		LocalScalar(const char *bytes, int numBytes,
			    CompileEnv *envPtr);
static int		PushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *simpleVarNamePtr, int *isScalarPtr,
			    int line, int* clNext);
static int		CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, const char *identity,
			    int instruction, CompileEnv *envPtr);
static int		CompileComparisonOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static int		CompileStrictlyBinaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static int		CompileUnaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static void		CompileReturnInternal(CompileEnv *envPtr,
			    unsigned char op, int code, int level,
			    Tcl_Obj *returnOpts);

#define PushVarNameWord(i,v,e,f,l,s,sc,word) \
    PushVarName (i,v,e,f,l,s,sc,                       \
                    mapPtr->loc [eclIndex].line [(word)], \
	            mapPtr->loc [eclIndex].next [(word)])

/*
 * Flags bits used by PushVarName.
 */

#define TCL_CREATE_VAR     1	/* Create a compiled local if none is found */
#define TCL_NO_LARGE_INDEX 2	/* Do not return localIndex value > 255 */

/*
 * The structures below define the AuxData types defined in this file.
 */

static const AuxDataType foreachInfoType = {
AuxDataType tclForeachInfoType = {
    "ForeachInfo",		/* name */
    DupForeachInfo,		/* dupProc */
    FreeForeachInfo,		/* freeProc */
    PrintForeachInfo,		/* printProc */
    PrintForeachInfo		/* printProc */
    DisassembleForeachInfo	/* disassembleProc */
};

static const AuxDataType newForeachInfoType = {
    "NewForeachInfo",		/* name */
    DupForeachInfo,		/* dupProc */
    FreeForeachInfo,		/* freeProc */
    PrintNewForeachInfo,	/* printProc */
AuxDataType tclJumptableInfoType = {
    "JumptableInfo",		/* name */
    DupJumptableInfo,		/* dupProc */
    FreeJumptableInfo,		/* freeProc */
    PrintJumptableInfo		/* printProc */
    DisassembleNewForeachInfo	/* disassembleProc */
};

static const AuxDataType dictUpdateInfoType = {
AuxDataType tclDictUpdateInfoType = {
    "DictUpdateInfo",		/* name */
    DupDictUpdateInfo,		/* dupProc */
    FreeDictUpdateInfo,		/* freeProc */
    PrintDictUpdateInfo,	/* printProc */
    PrintDictUpdateInfo		/* printProc */
    DisassembleDictUpdateInfo	/* disassembleProc */
};

/*
 *----------------------------------------------------------------------
 *
 * TclGetAuxDataType --
 *
 *	This procedure looks up an Auxdata type by name.
 *
 * Results:
 *	If an AuxData type with name matching "typeName" is found, a pointer
 *	to its AuxDataType structure is returned; otherwise, NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const AuxDataType *
TclGetAuxDataType(
    const char *typeName)	/* Name of AuxData type to look up. */
{
    if (!strcmp(typeName, foreachInfoType.name)) {
	return &foreachInfoType;
    } else if (!strcmp(typeName, newForeachInfoType.name)) {
	return &newForeachInfoType;
    } else if (!strcmp(typeName, dictUpdateInfoType.name)) {
	return &dictUpdateInfoType;
    } else if (!strcmp(typeName, tclJumptableInfoType.name)) {
	return &tclJumptableInfoType;
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileAppendCmd --
 *
 *	Procedure called to compile the "append" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "append" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileAppendCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex, numWords, i;
    int simpleVarName, isScalar, localIndex, numWords;
    DefineLineInformation;	/* TIP #280 */

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    } else if (numWords == 2) {
	/*
	 * append varName == set varName
	 */

	return TclCompileSetCmd(interp, parsePtr, cmdPtr, envPtr);
    } else if (numWords > 3) {
	/*
	 * APPEND instructions currently only handle one value, but we can
	 * APPEND instructions currently only handle one value.
	 * handle some multi-value cases by stringing them together.
	 */

	goto appendMultiple;
	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
	    &localIndex, &isScalar, 1);
    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
		    &localIndex, &simpleVarName, &isScalar, 1);

    /*
     * We are doing an assignment, otherwise TclCompileSetCmd was called, so
     * push the new value. This will need to be extended to push a value for
     * each argument.
     */

    if (numWords > 2) {
	valueTokenPtr = TokenAfter(varTokenPtr);
	CompileWord(envPtr, valueTokenPtr, interp, 2);
    }

    /*
     * Emit instructions to set/get the variable.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_STK, envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1(INST_APPEND_SCALAR1, localIndex, envPtr);
	    } else {
		Emit14Inst(INST_APPEND_SCALAR, localIndex, envPtr);
		TclEmitInstInt4(INST_APPEND_SCALAR4, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_APPEND_ARRAY_STK, envPtr);
	    } else {
		Emit14Inst(INST_APPEND_ARRAY, localIndex, envPtr);
	    }
	}

    return TCL_OK;

  appendMultiple:
    /*
     * Can only handle the case where we are appending to a local scalar when
     * there are multiple values to append.  Fortunately, this is common.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    localIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (localIndex < 0) {
	    } else if (localIndex <= 255) {
	return TCL_ERROR;
    }

		TclEmitInstInt1(INST_APPEND_ARRAY1, localIndex, envPtr);
    /*
     * Definitely appending to a local scalar; generate the words and append
     * them.
     */

    valueTokenPtr = TokenAfter(varTokenPtr);
    for (i = 2 ; i < numWords ; i++) {
	CompileWord(envPtr, valueTokenPtr, interp, i);
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    TclEmitInstInt4(	  INST_REVERSE, numWords-2,		envPtr);
    for (i = 2 ; i < numWords ;) {
	Emit14Inst(	  INST_APPEND_SCALAR, localIndex,	envPtr);
	if (++i < numWords) {
	    TclEmitOpcode(INST_POP,				envPtr);
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileArray*Cmd --
 *
 *	Functions called to compile "array" sucommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "array" subcommand at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileArrayExistsCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int isScalar, localIndex;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &isScalar, 1);
    if (!isScalar) {
	return TCL_ERROR;
    }

    if (localIndex >= 0) {
	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
    } else {
	    } else {
	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
    }
    return TCL_OK;
}

		TclEmitInstInt4(INST_APPEND_ARRAY4, localIndex, envPtr);
int
TclCompileArraySetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *dataTokenPtr;
    int isScalar, localIndex, code = TCL_OK;
    int isDataLiteral, isDataValid, isDataEven, len;
    int keyVar, valVar, infoIndex;
    int fwd, offsetBack, offsetFwd;
    Tcl_Obj *literalObj;
    ForeachInfo *infoPtr;

	    }
    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

	}
    } else {
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    dataTokenPtr = TokenAfter(varTokenPtr);
    TclNewObj(literalObj);
    isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
    isDataValid = (isDataLiteral
	    && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK);
    isDataEven = (isDataValid && (len & 1) == 0);

	TclEmitOpcode(INST_APPEND_STK, envPtr);
    /*
     * Special case: literal odd-length argument is always an error.
     */

    }
    if (isDataValid && !isDataEven) {
	/* Abandon custom compile and let invocation raise the error */
	code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	goto done;

	/*
	 * We used to compile to the bytecode that would throw the error,
	 * but that was wrong because it would not invoke the array trace
	 * on the variable.
	 *
	PushStringLiteral(envPtr, "list must have an even number of elements");
	PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
	TclEmitInt4(		0,				envPtr);
	goto done;
	 *
	 */
    }

    /*
     * Except for the special "ensure array" case below, when we're not in
     * a proc, we cannot do a better compile than generic.
     */

    if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) ||
	    (envPtr->procPtr == NULL && !(isDataEven && len == 0))) {
	code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	goto done;
    }


    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &isScalar, 1);
    if (!isScalar) {
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Special case: literal empty value argument is just an "ensure array"
     * operation.
     */

    if (isDataEven && len == 0) {
	if (localIndex >= 0) {
	    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
	    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);
	} else {
	    TclEmitOpcode(  INST_DUP,				envPtr);
	    TclEmitOpcode(  INST_ARRAY_EXISTS_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP_TRUE1, 5,			envPtr);
	    TclEmitOpcode(  INST_ARRAY_MAKE_STK,		envPtr);
	    TclEmitInstInt1(INST_JUMP1, 3,			envPtr);
	    /* Each branch decrements stack depth, but we only take one. */
	    TclAdjustStackDepth(1, envPtr);
	    TclEmitOpcode(  INST_POP,				envPtr);
	}
	PushStringLiteral(envPtr, "");
	goto done;
    }

    if (localIndex < 0) {
	/*
	 * a non-local variable: upvar from a local one! This consumes the
	 * variable name that was left at stacktop.
	 */

	localIndex = TclFindCompiledLocal(varTokenPtr->start,
		varTokenPtr->size, 1, envPtr);
	PushStringLiteral(envPtr, "0");
	TclEmitInstInt4(INST_REVERSE, 2,        		envPtr);
	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
	TclEmitOpcode(INST_POP,          			envPtr);
    }

    /*
     * Prepare for the internal foreach.
     */

    keyVar = AnonymousLocal(envPtr);
    valVar = AnonymousLocal(envPtr);

    infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists) + sizeof(ForeachVarList *));
    infoPtr->numLists = 1;
    infoPtr->varLists[0] = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes) + 2 * sizeof(int));
    infoPtr->varLists[0]->numVars = 2;
    infoPtr->varLists[0]->varIndexes[0] = keyVar;
    infoPtr->varLists[0]->varIndexes[1] = valVar;
    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);

    /*
     * Start issuing instructions to write to the array.
     */

    TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
    TclEmitInstInt1(INST_JUMP_TRUE1, 7,			envPtr);
    TclEmitInstInt4(INST_ARRAY_MAKE_IMM, localIndex,	envPtr);

    CompileWord(envPtr, dataTokenPtr, interp, 2);
    if (!isDataLiteral || !isDataValid) {
	/*
	 * Only need this safety check if we're handling a non-literal or list
	 * containing an invalid literal; with valid list literals, we've
	 * already checked (worth it because literals are a very common
	 * use-case with [array set]).
	 */

	TclEmitOpcode(	INST_DUP,				envPtr);
	TclEmitOpcode(	INST_LIST_LENGTH,			envPtr);
	PushStringLiteral(envPtr, "1");
	TclEmitOpcode(	INST_BITAND,				envPtr);
	offsetFwd = CurrentOffset(envPtr);
	TclEmitInstInt1(INST_JUMP_FALSE1, 0,			envPtr);
	PushStringLiteral(envPtr, "list must have an even number of elements");
	PushStringLiteral(envPtr, "-errorcode {TCL ARGUMENT FORMAT}");
	TclEmitInstInt4(INST_RETURN_IMM, TCL_ERROR,		envPtr);
	TclEmitInt4(		0,				envPtr);
	TclAdjustStackDepth(-1, envPtr);
	fwd = CurrentOffset(envPtr) - offsetFwd;
	TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
    }

    TclEmitInstInt4(INST_FOREACH_START, infoIndex,	envPtr);
    offsetBack = CurrentOffset(envPtr);
    Emit14Inst(	INST_LOAD_SCALAR, keyVar,		envPtr);
    Emit14Inst(	INST_LOAD_SCALAR, valVar,		envPtr);
    Emit14Inst(	INST_STORE_ARRAY, localIndex,		envPtr);
    TclEmitOpcode(	INST_POP,			envPtr);
    infoPtr->loopCtTemp = offsetBack - CurrentOffset(envPtr); /*misuse */
    TclEmitOpcode( INST_FOREACH_STEP,			envPtr);
    TclEmitOpcode( INST_FOREACH_END,			envPtr);
    TclAdjustStackDepth(-3, envPtr);
    PushStringLiteral(envPtr,	"");

    done:
    Tcl_DecrRefCount(literalObj);
    return code;
}

int
TclCompileArrayUnsetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    int isScalar, localIndex;

    if (parsePtr->numWords != 2) {
	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    PushVarNameWord(interp, tokenPtr, envPtr, TCL_NO_ELEMENT,
	    &localIndex, &isScalar, 1);
    if (!isScalar) {
	return TCL_ERROR;
    }

    if (localIndex >= 0) {
	TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex,	envPtr);
	TclEmitInstInt1(INST_JUMP_FALSE1, 8,			envPtr);
	TclEmitInstInt1(INST_UNSET_SCALAR, 1,			envPtr);
	TclEmitInt4(		localIndex,			envPtr);
    } else {
	TclEmitOpcode(	INST_DUP,				envPtr);
	TclEmitOpcode(	INST_ARRAY_EXISTS_STK,			envPtr);
	TclEmitInstInt1(INST_JUMP_FALSE1, 6,			envPtr);
	TclEmitInstInt1(INST_UNSET_STK, 1,			envPtr);
	TclEmitInstInt1(INST_JUMP1, 3,				envPtr);
	/* Each branch decrements stack depth, but we only take one. */
	TclAdjustStackDepth(1, envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);
    }
    PushStringLiteral(envPtr,	"");
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileBreakCmd --
 *
 *	Procedure called to compile the "break" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "break" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileBreakCmd(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    /*
     * Find the innermost exception range that contains this command.
     */

    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxPtr);
    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
	/*
	 * Found the target! No need for a nasty INST_BREAK here.
	 */

	TclCleanupStackForBreakContinue(envPtr, auxPtr);
	TclAddLoopBreakFixup(envPtr, auxPtr);
    } else {
	/*
	 * Emit a real break.
	 */
     * Emit a break instruction.
     */

	TclEmitOpcode(INST_BREAK, envPtr);
    TclEmitOpcode(INST_BREAK, envPtr);
    }
    TclAdjustStackDepth(1, envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileCatchCmd --
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
618
619
620
621
622
623
624
625
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
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
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
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
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

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
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
611
612
613
614
615
616
617
618
619


620
621
622
623
624
625
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







-
+
+


-


-
-
+
+
+
+










-
-
-
-
-
-
-
-
-









-





-










-
-
-
+
+
+
+
+
+
+



-
-
-
-
+
+
+
+





-
+

+
-
+

-
+

-

+
-
+

-
+
-
-
-
-
-
+

-
-
+
+
+
+


-
-
+
+


-
-
+

+


-
-
+
+


+

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

-
+
-
-
-
-
-

-
-
+
+


-
-
+
-
-


-
+






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



-
-
+
+


+
-
+
+
+
+
+
+
+
+
+

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

-
+

-
+
-

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

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


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

-
-
-











-
-
+
+










-
+


-
+
+


-
-
-









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

-
+
-
-
-











-
-
+
+




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









-
+
+


-
-
+

-
+


-
+







 */

int
TclCompileCatchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    JumpFixup jumpFixup;
    Tcl_Token *cmdTokenPtr, *resultNameTokenPtr, *optsNameTokenPtr;
    int resultIndex, optsIndex, range, dropScript = 0;
    int depth = TclGetStackDepth(envPtr);
    int resultIndex, optsIndex, range;
    int initStackDepth = envPtr->currStackDepth;
    int savedStackDepth;
    DefineLineInformation;	/* TIP #280 */

    /*
     * If syntax does not match what we expect for [catch], do not compile.
     * Let runtime checks determine if syntax has changed.
     */

    if ((parsePtr->numWords < 2) || (parsePtr->numWords > 4)) {
	return TCL_ERROR;
    }

    /*
     * If variables were specified and the catch command is at global level
     * (not in a procedure), don't compile it inline: the payoff is too small.
     */

    if ((parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) {
	return TCL_ERROR;
    }

    /*
     * Make sure the variable names, if any, have no substitutions and just
     * refer to local scalars.
     */

    resultIndex = optsIndex = -1;
    cmdTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (parsePtr->numWords >= 3) {
	resultNameTokenPtr = TokenAfter(cmdTokenPtr);
	/* DGP */
	resultIndex = LocalScalarFromToken(resultNameTokenPtr, envPtr);
	if (resultIndex < 0) {
	    return TCL_ERROR;
	}

	/* DKF */
	if (parsePtr->numWords == 4) {
	    optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
	    optsIndex = LocalScalarFromToken(optsNameTokenPtr, envPtr);
	    if (optsIndex < 0) {
		return TCL_ERROR;
	    }
	}
    }

    /*
     * We will compile the catch command. Declare the exception range that it
     * uses.
     *
     * We will compile the catch command. Declare the exception range
     * that it uses.
     */

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);

    /*
     * If the body is a simple word, compile a BEGIN_CATCH instruction,
     * followed by the instructions to eval the body.
     * Otherwise, compile instructions to substitute the body text before
     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to evaluate the
     * substituted body.
     * Care has to be taken to make sure that substitution happens outside the
     * catch range so that errors in the substitution are not caught.
     * starting the catch, then BEGIN_CATCH, and then EVAL_STK to
     * evaluate the substituted body.
     * Care has to be taken to make sure that substitution happens outside
     * the catch range so that errors in the substitution are not caught.
     * [Bug 219184]
     * The reason for duplicating the script is that EVAL_STK would otherwise
     * begin by undeflowing the stack below the mark set by BEGIN_CATCH4.
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    SetLineInformation(1);
    if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
	ExceptionRangeStarts(envPtr, range);
	BODY(cmdTokenPtr, 1);
	CompileBody(envPtr, cmdTokenPtr, interp);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, cmdTokenPtr, interp);
	savedStackDepth = envPtr->currStackDepth;
	TclEmitInstInt4(	INST_BEGIN_CATCH4, range,	envPtr);
	TclEmitInstInt4(INST_BEGIN_CATCH4, range, envPtr);
	ExceptionRangeStarts(envPtr, range);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(INST_DUP, envPtr);
	TclEmitInvoke(envPtr,	INST_EVAL_STK);
	/* drop the script */
	dropScript = 1;
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
	TclEmitOpcode(INST_EVAL_STK, envPtr);
    }
    ExceptionRangeEnds(envPtr, range);

    /* Stack at this point:
     *    nonsimple:  script <mark> result
     *    simple:            <mark> result
     */

    /*
     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result,
     * and jump around the "error case" code.
     * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch
     * result, and jump around the "error case" code.
     */

    TclCheckStackDepth(depth+1, envPtr);
    PushStringLiteral(envPtr, "0");
    PushLiteral(envPtr, "0", 1);
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);
    /* Stack at this point: ?script? <mark> result TCL_OK */

    /*
     * Emit the "error case" epilogue. Push the interpreter result and the
     * return code.
     * Emit the "error case" epilogue. Push the interpreter result
     * and the return code.
     */

    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclSetStackDepth(depth + dropScript, envPtr);

    /* Stack at this point:  ?script? */
    TclEmitOpcode(INST_PUSH_RESULT, envPtr);
    if (dropScript) {
	TclEmitOpcode(		INST_POP,			envPtr);
    }

    TclEmitOpcode(INST_PUSH_RETURN_CODE, envPtr);

    /*
     * Update the target of the jump after the "no errors" code.
     */

    /* Stack at this point is empty */
    /* Stack at this point: ?script? result returnCode */
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_PUSH_RETURN_CODE,		envPtr);

    /* Stack at this point on both branches: result returnCode */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %" TCL_Z_MODIFIER "d",
		(CurrentOffset(envPtr) - jumpFixup.codeOffset));
	Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }

    /*
     * Push the return options if the caller wants them. This needs to happen
    /* Push the return options if the caller wants them */
     * before INST_END_CATCH
     */

    if (optsIndex != -1) {
	TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
	TclEmitOpcode(INST_PUSH_RETURN_OPTIONS, envPtr);
    }

    /*
     * End the catch
     */

    TclEmitOpcode(		INST_END_CATCH,			envPtr);

    ExceptionRangeEnds(envPtr, range);
    /*
     * Save the result and return options if the caller wants them. This needs
     * to happen after INST_END_CATCH (compile-3.6/7).
     */

    if (optsIndex != -1) {
	Emit14Inst(		INST_STORE_SCALAR, optsIndex,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    TclEmitOpcode(INST_END_CATCH, envPtr);
    }

    /*
     * At this point, the top of the stack is inconveniently ordered:
     *		result returnCode
     * Reverse the stack to store the result.
     *		?script? result returnCode ?returnOptions?
     * Reverse the stack to bring the result to the top.
     */

    if (optsIndex != -1) {
    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitInstInt4(INST_REVERSE, 3, envPtr);
    } else {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
    }

    /*
     * Store the result if requested, and remove it from the stack
     */

    if (resultIndex != -1) {
	Emit14Inst(	INST_STORE_SCALAR, resultIndex,	envPtr);
	if (resultIndex <= 255) {
    }
    TclEmitOpcode(	INST_POP,			envPtr);

    TclCheckStackDepth(depth+1, envPtr);
	    TclEmitInstInt1(INST_STORE_SCALAR1, resultIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, resultIndex, envPtr);
    return TCL_OK;
}

	}
    }
/*----------------------------------------------------------------------
 *
 * TclCompileClockClicksCmd --
 *
 *	Procedure called to compile the "tcl::clock::clicks" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to run time.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "clock clicks"
 *	command at runtime.
 *
 *----------------------------------------------------------------------
 */

    TclEmitOpcode(INST_POP, envPtr);
int
TclCompileClockClicksCmd(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{

    Tcl_Token* tokenPtr;

    switch (parsePtr->numWords) {
    case 1:
	/*
    /*
	 * No args
	 */
	TclEmitInstInt1(INST_CLOCK_READ, 0, envPtr);
     * Stack is now ?script? ?returnOptions? returnCode.
     * If the options dict has been requested, it is buried on the stack
     * under the return code. Reverse the stack to bring it to the top,
     * store it and remove it from the stack.
     */

	break;
    case 2:
	/*
	 * -milliseconds or -microseconds
	 */
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD
	    || tokenPtr[1].size < 4
	    || tokenPtr[1].size > 13) {
	    return TCL_ERROR;
	} else if (!strncmp(tokenPtr[1].start, "-microseconds",
			    tokenPtr[1].size)) {
	    TclEmitInstInt1(INST_CLOCK_READ, 1, envPtr);
    if (optsIndex != -1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	    break;
	} else if (!strncmp(tokenPtr[1].start, "-milliseconds",
			    tokenPtr[1].size)) {
	    TclEmitInstInt1(INST_CLOCK_READ, 2, envPtr);
	if (optsIndex <= 255) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, optsIndex, envPtr);
	    break;
	} else {
	    return TCL_ERROR;
	    TclEmitInstInt4(INST_STORE_SCALAR4, optsIndex, envPtr);
	}
    default:
	TclEmitOpcode(INST_POP, envPtr);
	return TCL_ERROR;
    }
    return TCL_OK;
}



    /*
     * Stack is now ?script? result. Get rid of the subst'ed script
/*----------------------------------------------------------------------
 *
 * TclCompileClockReadingCmd --
 *
 *	Procedure called to compile the "tcl::clock::microseconds",
 *	"tcl::clock::milliseconds" and "tcl::clock::seconds" commands.
 *
 * Results:
     * if it's hanging arond.
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to run time.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "clock clicks"
 *	command at runtime.
 *
 * Client data is 1 for microseconds, 2 for milliseconds, 3 for seconds.
 *----------------------------------------------------------------------
 */
     */

int
TclCompileClockReadingCmd(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    if (cmdTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
    TclEmitInstInt1(INST_CLOCK_READ, PTR2INT(cmdPtr->objClientData), envPtr);

	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
    return TCL_OK;
}

	TclEmitOpcode(INST_POP, envPtr);
/*
 *----------------------------------------------------------------------
 *
 * TclCompileConcatCmd --
 *
 *	Procedure called to compile the "concat" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "concat" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

    }
int
TclCompileConcatCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{

    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *objPtr, *listObj;
    Tcl_Token *tokenPtr;
    int i;

    /* TODO: Consider compiling expansion case. */
    if (parsePtr->numWords == 1) {
	/*
    /*
	 * [concat] without arguments just pushes an empty object.
	 */

     * Result of all this, on either branch, should have been to leave
	PushStringLiteral(envPtr, "");
	return TCL_OK;
    }

     * one operand -- the return code -- on the stack.
    /*
     * Test if all arguments are compile-time known. If they are, we can
     * implement with a simple push.
     */

    TclNewObj(listObj);
    for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	TclNewObj(objPtr);
	if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	    Tcl_DecrRefCount(objPtr);
	    Tcl_DecrRefCount(listObj);
	    listObj = NULL;
	    break;
	}
	(void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
    }
    if (listObj != NULL) {
	Tcl_Obj **objs;
	const char *bytes;
	int len;
	size_t slen;

    if (envPtr->currStackDepth != initStackDepth + 1) {
	Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
	objPtr = Tcl_ConcatObj(len, objs);
	Tcl_DecrRefCount(listObj);
	bytes = TclGetStringFromObj(objPtr, &slen);
	PushLiteral(envPtr, bytes, slen);
	Tcl_DecrRefCount(objPtr);
	return TCL_OK;
    }

	Tcl_Panic("in TclCompileCatchCmd, currStackDepth = %d should be %d",
    /*
     * General case: runtime concat.
     */

		  envPtr->currStackDepth, initStackDepth+1);
    for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }

    TclEmitInstInt4(	INST_CONCAT_STK, i-1,		envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileContinueCmd --
 *
 *	Procedure called to compile the "continue" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "continue" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileContinueCmd(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;

    /*
     * There should be no argument after the "continue".
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    /*
     * See if we can find a valid continueOffset (i.e., not -1) in the
     * innermost containing exception range.
     */

    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, &auxPtr);
    if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
	/*
	 * Found the target! No need for a nasty INST_CONTINUE here.
	 */

	TclCleanupStackForBreakContinue(envPtr, auxPtr);
	TclAddLoopContinueFixup(envPtr, auxPtr);
    } else {
	/*
	 * Emit a real continue.
	 */
     * Emit a continue instruction.
     */

	TclEmitOpcode(INST_CONTINUE, envPtr);
    TclEmitOpcode(INST_CONTINUE, envPtr);
    }
    TclAdjustStackDepth(1, envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileDict*Cmd --
 *
 *	Functions called to compile "dict" sucommands.
 *
 * Results:
 *	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 *	evaluation to runtime.
 * 	All return TCL_OK for a successful compile, and TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "dict" subcommand at
 *	runtime.
 *
 * Notes:
 *	The following commands are in fairly common use and are possibly worth
 *	bytecoding:
 *		dict append
 *		dict create	[*]
 *		dict exists	[*]
 *		dict for
 *		dict get	[*]
 *		dict incr
 *		dict keys	[*]
 *		dict lappend
 *		dict set
 *		dict unset
 *
 *	In practice, those that are pure-value operators (marked with [*]) can
 *	probably be left alone (except perhaps [dict get] which is very very
 *	common) and [dict update] should be considered instead (really big
 *	win!)
 *
 *----------------------------------------------------------------------
 */

int
TclCompileDictSetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    Tcl_Token *tokenPtr, *varTokenPtr;
    int i, dictVarIndex;
    Tcl_Token *varTokenPtr;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least one argument after the command.
     * There must be at least three arguments after the (sub-)command.
     */

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }

    /*
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501

1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529

1530
1531

1532
1533
1534
1535






1536
1537
1538

1539
1540
1541
1542


1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
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




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
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
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







-












-


+








+
+
+
+
+
+
+

+
+
+
+
+







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





-
-
-
-
-
-
-
-
-
-
-















-
+
+


-


+






-














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












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

-
+

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


-
+


-
-
+
+





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







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

-
-
-
-
+
+
+
+
+
+
+


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








-
+
-
-
-





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



+
+
+






-
-
+
+


-
-
-
-





-
-
-
-
+
+
+
+





-
+






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















-
+

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

-
+






-

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







+



-
-
-
-
-
+
+
-
-
-
+



-
-
+
+


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












-




-
+
-
-
-
-
-
-
-










+
+
+










-
+








-
+
+

-
+
+



+
+





+
+
+
+
+

+
+
+
+
+
-
+
+

-
+
-


-
+
-
-
-



-
+
+
+








-
+




-
-
-
+
+
+

-
-
+
+


-
+
+







-
-
-
-
+
+
+
+














-
-
-
-
+
+
+
+

-
-
-
+
+
+


-
-
+
+



-
-
-
-
-
-
-
-
-
-











-


+


-
-
-
+
+
+


-
-
+










-
+












-
+



















-


+





-
-




-
-
-
-





-
-
-
+
-
-
-
-
+


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















-





-









-
+

-
-
-
+
+
+








-
+






-
-
+
+

-
-
+
+








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



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
+
+













-
+
+








    /*
     * Now emit the instruction to do the dict manipulation.
     */

    TclEmitInstInt4( INST_DICT_SET, parsePtr->numWords-3,	envPtr);
    TclEmitInt4(     dictVarIndex,			envPtr);
    TclAdjustStackDepth(-1, envPtr);
    return TCL_OK;
}

int
TclCompileDictIncrCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *keyTokenPtr;
    int dictVarIndex, incrAmount;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two arguments after the command.
     */

    if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TCL_ERROR;
    }

    keyTokenPtr = TokenAfter(varTokenPtr);

    /*
     * Parse the increment amount, if present.
     */

    if (parsePtr->numWords == 4) {
	const char *word;
	size_t numBytes;
	int code;
	Tcl_Token *incrTokenPtr;
	Tcl_Obj *intObj;

	Tcl_Token *incrTokenPtr = TokenAfter(keyTokenPtr);
	Tcl_Obj *intObj = Tcl_NewObj();
	int fail = (!TclWordKnownAtCompileTime(incrTokenPtr, intObj)
	incrTokenPtr = TokenAfter(keyTokenPtr);
	if (incrTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	}
	word = incrTokenPtr[1].start;
	numBytes = incrTokenPtr[1].size;

	intObj = Tcl_NewStringObj(word, numBytes);
	Tcl_IncrRefCount(intObj);
	code = TclGetIntFromObj(NULL, intObj, &incrAmount);
	TclDecrRefCount(intObj);
	if (code != TCL_OK) {
	    return TclCompileBasic2Or3ArgCmd(interp, parsePtr,cmdPtr, envPtr);
		|| TCL_ERROR == TclGetIntFromObj(NULL, intObj, &incrAmount));
	Tcl_DecrRefCount(intObj);
	if (fail) {
	    return TCL_ERROR;
	}
    } else {
	incrAmount = 1;
    }

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasic2Or3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Emit the key and the code to actually do the increment.
     */

    CompileWord(envPtr, keyTokenPtr, interp, 2);
    TclEmitInstInt4( INST_DICT_INCR_IMM, incrAmount,	envPtr);
    TclEmitInt4(     dictVarIndex,			envPtr);
    return TCL_OK;
}

int
TclCompileDictGetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Only compile this because we need INST_DICT_GET anyway.
     */

    for (i=1 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt4(INST_DICT_GET, parsePtr->numWords-2, envPtr);
    TclAdjustStackDepth(-1, envPtr);
    return TCL_OK;
}

int
TclCompileDictGetWithDefaultCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i;

    /*
     * There must be at least three arguments after the command.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    for (i=1 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt4(INST_DICT_GET_DEF, parsePtr->numWords-3, envPtr);
    TclAdjustStackDepth(-2, envPtr);
    return TCL_OK;
}

int
TclCompileDictExistsCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i;

    /*
     * There must be at least two arguments after the command (the single-arg
     * case is legal, but too special and magic for us to deal with here).
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Now we do the code generation.
     */

    for (i=1 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt4(INST_DICT_EXISTS, parsePtr->numWords-2, envPtr);
    TclAdjustStackDepth(-1, envPtr);
    return TCL_OK;
}

int
TclCompileDictUnsetCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i, dictVarIndex;

    /*
     * There must be at least one argument after the variable name for us to
     * compile to bytecode.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Remaining words (the key path) can be handled normally.
     */

    for (i=2 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }

    /*
     * Now emit the instruction to do the dict manipulation.
     */

    TclEmitInstInt4( INST_DICT_UNSET, parsePtr->numWords-2,	envPtr);
    TclEmitInt4(	dictVarIndex,				envPtr);
    return TCL_OK;
}

int
TclCompileDictCreateCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int worker;			/* Temp var for building the value in. */
    Tcl_Token *tokenPtr;
    Tcl_Obj *keyObj, *valueObj, *dictObj;
    const char *bytes;
    int i;
    size_t len;

    if ((parsePtr->numWords & 1) == 0) {
	return TCL_ERROR;
    }

    /*
     * See if we can build the value at compile time...
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    TclNewObj(dictObj);
    Tcl_IncrRefCount(dictObj);
    for (i=1 ; i<parsePtr->numWords ; i+=2) {
	TclNewObj(keyObj);
	Tcl_IncrRefCount(keyObj);
	if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) {
	    Tcl_DecrRefCount(keyObj);
	    Tcl_DecrRefCount(dictObj);
	    goto nonConstant;
	}
	tokenPtr = TokenAfter(tokenPtr);
	TclNewObj(valueObj);
	Tcl_IncrRefCount(valueObj);
	if (!TclWordKnownAtCompileTime(tokenPtr, valueObj)) {
	    Tcl_DecrRefCount(keyObj);
	    Tcl_DecrRefCount(valueObj);
	    Tcl_DecrRefCount(dictObj);
	    goto nonConstant;
	}
	tokenPtr = TokenAfter(tokenPtr);
	Tcl_DictObjPut(NULL, dictObj, keyObj, valueObj);
	Tcl_DecrRefCount(keyObj);
	Tcl_DecrRefCount(valueObj);
    }

    /*
     * We did! Excellent. The "verifyDict" is to do type forcing.
     */

    bytes = TclGetStringFromObj(dictObj, &len);
    PushLiteral(envPtr, bytes, len);
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
    Tcl_DecrRefCount(dictObj);
    return TCL_OK;

    /*
     * Otherwise, we've got to issue runtime code to do the building, which we
     * do by [dict set]ting into an unnamed local variable. This requires that
     * we are in a context with an LVT.
     */

  nonConstant:
    worker = AnonymousLocal(envPtr);
    if (worker < 0) {
	return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    PushStringLiteral(envPtr,		"");
    Emit14Inst(			INST_STORE_SCALAR, worker,	envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i=1 ; i<parsePtr->numWords ; i+=2) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i+1);
	tokenPtr = TokenAfter(tokenPtr);
	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
	TclEmitInt4(			worker,			envPtr);
	TclAdjustStackDepth(-1, envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    Emit14Inst(			INST_LOAD_SCALAR, worker,	envPtr);
    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
    TclEmitInt4(			worker,			envPtr);
    return TCL_OK;
}

int
TclCompileDictMergeCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i, workerIndex, infoIndex, outLoop;

    /*
     * Deal with some special edge cases. Note that in the case with one
     * argument, the only thing to do is to verify the dict-ness.
     */

    /* TODO: Consider support for compiling expanded args. (less likely) */
    if (parsePtr->numWords < 2) {
	PushStringLiteral(envPtr, "");
	return TCL_OK;
    } else if (parsePtr->numWords == 2) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	TclEmitOpcode(		INST_DUP,			envPtr);
	TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
	return TCL_OK;
    }

    /*
     * There's real merging work to do.
     *
     * Allocate some working space. This means we'll only ever compile this
     * command when there's an LVT present.
     */

    workerIndex = AnonymousLocal(envPtr);
    if (workerIndex < 0) {
	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }
    infoIndex = AnonymousLocal(envPtr);

    /*
     * Get the first dictionary and verify that it is so.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    TclEmitOpcode(		INST_DUP,			envPtr);
    TclEmitOpcode(		INST_DICT_VERIFY,		envPtr);
    Emit14Inst(			INST_STORE_SCALAR, workerIndex,	envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * For each of the remaining dictionaries...
     */

    outLoop = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    TclEmitInstInt4(		INST_BEGIN_CATCH4, outLoop,	envPtr);
    ExceptionRangeStarts(envPtr, outLoop);
    for (i=2 ; i<parsePtr->numWords ; i++) {
	/*
	 * Get the dictionary, and merge its pairs into the first dict (using
	 * a small loop).
	 */

	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
	TclEmitInstInt4(	INST_DICT_FIRST, infoIndex,	envPtr);
	TclEmitInstInt1(	INST_JUMP_TRUE1, 24,		envPtr);
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitInstInt4(	INST_DICT_SET, 1,		envPtr);
	TclEmitInt4(			workerIndex,		envPtr);
	TclAdjustStackDepth(-1, envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
	TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,	envPtr);
	TclEmitInstInt1(	INST_JUMP_FALSE1, -20,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
	TclEmitInstInt1(	INST_UNSET_SCALAR, 0,		envPtr);
	TclEmitInt4(			infoIndex,		envPtr);
    }
    ExceptionRangeEnds(envPtr, outLoop);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);

    /*
     * Clean up any state left over.
     */

    Emit14Inst(			INST_LOAD_SCALAR, workerIndex,	envPtr);
    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
    TclEmitInt4(			workerIndex,		envPtr);
    TclEmitInstInt1(		INST_JUMP1, 18,			envPtr);

    /*
     * If an exception happens when starting to iterate over the second (and
     * subsequent) dicts. This is strictly not necessary, but it is nice.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, outLoop, catchOffset);
    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
    TclEmitInt4(			workerIndex,		envPtr);
    TclEmitInstInt1(		INST_UNSET_SCALAR, 0,		envPtr);
    TclEmitInt4(			infoIndex,		envPtr);
    TclEmitOpcode(		INST_RETURN_STK,		envPtr);

    return TCL_OK;
}

int
TclCompileDictForCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
	    TCL_EACH_KEEP_NONE);
}

    Proc *procPtr = envPtr->procPtr;
int
TclCompileDictMapCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr,
	    TCL_EACH_COLLECT);
}

int
CompileDictEachCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int collect)		/* Flag == TCL_EACH_COLLECT to collect and
				 * construct a new dictionary with the loop
				 * body result. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
    int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
    int keyVarIndex, valueVarIndex, loopRange, catchRange;
    int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
    int numVars, endTargetOffset;
    int numVars, endTargetOffset, numBytes;
    int collectVar = -1;	/* Index of temp var holding the result
				 * dict. */
    const char **argv;
    Tcl_DString buffer;
    const char *bytes;
    int savedStackDepth = envPtr->currStackDepth;
				/* Needed because jumps confuse the stack
				 * space calculator. */
    Tcl_Obj *varNameObj, *varListObj = NULL;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be three arguments after the command.
     * There must be exactly three arguments after the command.
     */

    if (parsePtr->numWords != 4) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    if (parsePtr->numWords != 4 || procPtr == NULL) {
	return TCL_ERROR;
    }

    varsTokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictTokenPtr = TokenAfter(varsTokenPtr);
    bodyTokenPtr = TokenAfter(dictTokenPtr);
    if (varsTokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
	    bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }


    if (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
    /*
     * Create temporary variable to capture return values from loop body when
     * we're collecting results.
     */

	return TCL_ERROR;
    if (collect == TCL_EACH_COLLECT) {
	collectVar = AnonymousLocal(envPtr);
	if (collectVar < 0) {
	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
    }

    /*
     * Check we've got a pair of variables and that they are local variables.
     * Then extract their indices in the LVT.
     */

    Tcl_DStringInit(&buffer);
    TclDStringAppendToken(&buffer, &varsTokenPtr[1]);
    if (Tcl_SplitList(NULL, Tcl_DStringValue(&buffer), &numVars,
	    &argv) != TCL_OK) {
	Tcl_DStringFree(&buffer);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    varListObj = Tcl_NewObj();
    if (!TclWordKnownAtCompileTime(varsTokenPtr, varListObj) ||
	    TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
	    numVars != 2) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }
    Tcl_DStringFree(&buffer);
    if (numVars != 2) {
	Tcl_Free((void *)argv);
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);

    Tcl_ListObjIndex(NULL, varListObj, 0, &varNameObj);
    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
    keyVarIndex = LocalScalar(bytes, numBytes, envPtr);
    if (keyVarIndex < 0) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }

    nameChars = strlen(argv[0]);
    keyVarIndex = LocalScalar(argv[0], nameChars, envPtr);
    nameChars = strlen(argv[1]);
    valueVarIndex = LocalScalar(argv[1], nameChars, envPtr);
    Tcl_Free((void *)argv);

    Tcl_ListObjIndex(NULL, varListObj, 1, &varNameObj);
    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
    valueVarIndex = LocalScalar(bytes, numBytes, envPtr);
    if (valueVarIndex < 0) {
	Tcl_DecrRefCount(varListObj);
	return TCL_ERROR;
    }
    if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    Tcl_DecrRefCount(varListObj);

    /*
     * Allocate a temporary variable to store the iterator reference. The
     * variable will contain a Tcl_DictSearch reference which will be
     * allocated by INST_DICT_FIRST and disposed when the variable is unset
     * (at which point it should also have been finished with).
     */

    infoIndex = AnonymousLocal(envPtr);
    infoIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr);
    if (infoIndex < 0) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Preparation complete; issue instructions. Note that this code issues
     * fixed-sized jumps. That simplifies things a lot!
     *
     * First up, initialize the accumulator dictionary if needed.
     */

    if (collect == TCL_EACH_COLLECT) {
	PushStringLiteral(envPtr, "");
	Emit14Inst(	INST_STORE_SCALAR, collectVar,		envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);
    }

    /*
     * Get the dictionary and start the iteration. No catching of errors at
     * this point.
     * First up, get the dictionary and start the iteration. No catching of
     * errors at this point.
     */

    CompileWord(envPtr, dictTokenPtr, interp, 2);
    TclEmitInstInt4( INST_DICT_FIRST, infoIndex,		envPtr);
    emptyTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4( INST_JUMP_TRUE4, 0,			envPtr);

    /*
     * Now we catch errors from here on so that we can finalize the search
     * started by Tcl_DictObjFirst above.
     */

    catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, catchRange,		envPtr);
    catchRange = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4( INST_BEGIN_CATCH4, catchRange,		envPtr);
    ExceptionRangeStarts(envPtr, catchRange);

    TclEmitInstInt4(	INST_DICT_FIRST, infoIndex,		envPtr);
    emptyTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_TRUE4, 0,			envPtr);

    /*
     * Inside the iteration, write the loop variables.
     */

    bodyTargetOffset = CurrentOffset(envPtr);
    Emit14Inst(		INST_STORE_SCALAR, keyVarIndex,		envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    Emit14Inst(		INST_STORE_SCALAR, valueVarIndex,	envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitInstInt4( INST_STORE_SCALAR4, keyVarIndex,		envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    TclEmitInstInt4( INST_STORE_SCALAR4, valueVarIndex,		envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);

    /*
     * Set up the loop exception targets.
     */

    loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
    ExceptionRangeStarts(envPtr, loopRange);

    /*
     * Compile the loop body itself. It should be stack-neutral.
     */

    SetLineInformation(3);
    BODY(bodyTokenPtr, 3);
    CompileBody(envPtr, bodyTokenPtr, interp);
    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(	INST_LOAD_SCALAR, keyVarIndex,		envPtr);
	TclEmitInstInt4(INST_OVER, 1,				envPtr);
	TclEmitInstInt4(INST_DICT_SET, 1,			envPtr);
	TclEmitInt4(		collectVar,			envPtr);
	TclAdjustStackDepth(-1, envPtr);
	TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    }
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Both exception target ranges (error and loop) end here.
     */

    ExceptionRangeEnds(envPtr, loopRange);
    ExceptionRangeEnds(envPtr, catchRange);

    /*
     * Continue (or just normally process) by getting the next pair of items
     * from the dictionary and jumping back to the code to write them into
     * variables if there is another pair.
     */

    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
    TclEmitInstInt4(	INST_DICT_NEXT, infoIndex,		envPtr);
    TclEmitInstInt4( INST_DICT_NEXT, infoIndex,			envPtr);
    jumpDisplacement = bodyTargetOffset - CurrentOffset(envPtr);
    TclEmitInstInt4(	INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    TclEmitInstInt4( INST_JUMP_FALSE4, jumpDisplacement,	envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);

    /*
     * Now do the final cleanup for the no-error case (this is where we break
     * out of the loop to) by force-terminating the iteration (if not already
     * terminated), ditching the exception info and jumping to the last
     * instruction for this command. In theory, this could be done using the
     * "finally" clause (next generated) but this is faster.
     */

    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    endTargetOffset = CurrentOffset(envPtr);
    TclEmitInstInt1(	INST_JUMP1, 0,				envPtr);
    TclEmitInstInt4( INST_JUMP4, 0,				envPtr);

    /*
     * Error handler "finally" clause, which force-terminates the iteration
     * and rethrows the error.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, catchRange, catchOffset);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,			envPtr);
    TclEmitOpcode(   INST_PUSH_RESULT,				envPtr);
    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);
    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    if (collect == TCL_EACH_COLLECT) {
	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
	TclEmitInt4(		collectVar,			envPtr);
    }
    TclEmitOpcode(	INST_RETURN_STK,			envPtr);
    TclEmitOpcode(   INST_RETURN_STK,				envPtr);

    /*
     * Otherwise we're done (the jump after the DICT_FIRST points here) and we
     * need to pop the bogus key/value pair (pushed to keep stack calculations
     * easy!) Note that we skip the END_CATCH. [Bug 1382528]
     */

    envPtr->currStackDepth = savedStackDepth+2;
    jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
    TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
	    envPtr->codeStart + emptyTargetOffset);
    jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDisplacement,
	    envPtr->codeStart + endTargetOffset);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(	INST_POP,				envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    TclEmitOpcode(   INST_POP,					envPtr);
    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
    TclFinalizeLoopExceptionRange(envPtr, loopRange);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4( INST_DICT_DONE, infoIndex,			envPtr);

    /*
     * Final stage of the command (normal case) is that we push an empty
     * object (or push the accumulator as the result object). This is done
     * last to promote peephole optimization when it's dropped immediately.
     * object. This is done last to promote peephole optimization when it's
     * dropped immediately.
     */

    TclEmitInstInt1(	INST_UNSET_SCALAR, 0,			envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset;
    if (collect == TCL_EACH_COLLECT) {
	Emit14Inst(	INST_LOAD_SCALAR, collectVar,		envPtr);
	TclEmitInstInt1(INST_UNSET_SCALAR, 0,			envPtr);
	TclEmitInt4(		collectVar,			envPtr);
    TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement,
	    envPtr->codeStart + endTargetOffset);
    } else {
	PushStringLiteral(envPtr, "");
    PushLiteral(envPtr, "", 0);
    }
    return TCL_OK;
}

int
TclCompileDictUpdateCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int i, dictIndex, numVars, range, infoIndex;
    Tcl_Token **keyTokenPtrs, *dictVarTokenPtr, *bodyTokenPtr, *tokenPtr;
    DictUpdateInfo *duiPtr;
    JumpFixup jumpFixup;

    DefineLineInformation;	/* TIP #280 */
    /*
     * There must be at least one argument after the command.
     */

    if (parsePtr->numWords < 5) {
	return TCL_ERROR;
    }

    /*
     * Parse the command. Expect the following:
     *   dict update <lit(eral)> <any> <lit> ?<any> <lit> ...? <lit>
     */

    if ((parsePtr->numWords - 1) & 1) {
	return TCL_ERROR;
    }
    numVars = (parsePtr->numWords - 3) / 2;
    if (numVars < 1) {
	return TCL_ERROR;
    }

    /*
     * The dictionary variable must be a local scalar that is knowable at
     * compile time; anything else exceeds the complexity of the opcode. So
     * discover what the index is.
     */

    dictVarTokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictIndex = LocalScalarFromToken(dictVarTokenPtr, envPtr);
    if (dictIndex < 0) {
	goto issueFallback;
	return TCL_ERROR;
    }

    /*
     * Assemble the instruction metadata. This is complex enough that it is
     * represented as auxData; it holds an ordered list of variable indices
     * that are to be used.
     */

    duiPtr = (DictUpdateInfo *)Tcl_Alloc(offsetof(DictUpdateInfo, varIndices) + sizeof(int) * numVars);
    duiPtr = (DictUpdateInfo *)
	    ckalloc(sizeof(DictUpdateInfo) + sizeof(int) * (numVars - 1));
    duiPtr->length = numVars;
    keyTokenPtrs = (Tcl_Token **)TclStackAlloc(interp, sizeof(Tcl_Token *) * numVars);
    keyTokenPtrs = (Tcl_Token **) TclStackAlloc(interp,
	    sizeof(Tcl_Token *) * numVars);
    tokenPtr = TokenAfter(dictVarTokenPtr);

    for (i=0 ; i<numVars ; i++) {
	int index;

	/*
	 * Put keys to one side for later compilation to bytecode.
	 */

	keyTokenPtrs[i] = tokenPtr;

	/*
	 * Variables first need to be checked for sanity.
	 */

	tokenPtr = TokenAfter(tokenPtr);
	index = LocalScalarFromToken(tokenPtr, envPtr);
	if (index < 0) {
	    ckfree((char *) duiPtr);
	    TclStackFree(interp, keyTokenPtrs);
	    return TCL_ERROR;

	}

	/*
	 * Stash the index in the auxiliary data (if it is indeed a local
	 * Stash the index in the auxiliary data.
	 * scalar that is resolvable at compile-time).
	 */

	duiPtr->varIndices[i] = LocalScalarFromToken(tokenPtr, envPtr);
	duiPtr->varIndices[i] = index;
	if (duiPtr->varIndices[i] < 0) {
	    goto failedUpdateInfoAssembly;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	goto failedUpdateInfoAssembly;
	ckfree((char *) duiPtr);
	TclStackFree(interp, keyTokenPtrs);
	return TCL_ERROR;
    }
    bodyTokenPtr = tokenPtr;

    /*
     * The list of variables to bind is stored in auxiliary data so that it
     * can't be snagged by literal sharing and forced to shimmer dangerously.
     */

    infoIndex = TclCreateAuxData(duiPtr, &dictUpdateInfoType, envPtr);
    infoIndex = TclCreateAuxData(duiPtr, &tclDictUpdateInfoType, envPtr);

    for (i=0 ; i<numVars ; i++) {
	CompileWord(envPtr, keyTokenPtrs[i], interp, 2*i+2);
    }
    TclEmitInstInt4(	INST_LIST, numVars,			envPtr);
    TclEmitInstInt4(	INST_DICT_UPDATE_START, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitInstInt4( INST_LIST, numVars,			envPtr);
    TclEmitInstInt4( INST_DICT_UPDATE_START, dictIndex,		envPtr);
    TclEmitInt4(     infoIndex,					envPtr);

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);
    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4( INST_BEGIN_CATCH4, range,			envPtr);

    ExceptionRangeStarts(envPtr, range);
    BODY(bodyTokenPtr, parsePtr->numWords - 1);
    SetLineInformation(parsePtr->numWords - 1);
    CompileBody(envPtr, bodyTokenPtr, interp);
    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.
     */

    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 2,			envPtr);
    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    TclEmitInstInt4( INST_REVERSE, 2,				envPtr);
    TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,		envPtr);
    TclEmitInt4(     infoIndex,					envPtr);

    /*
     * Jump around the exceptional termination code.
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Termination code for non-ok returns: stash the result and return
     * options in the stack, bring up the key list, finish the update code,
     * and finally return with the catched return data
     */

    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(	INST_PUSH_RESULT,			envPtr);
    TclEmitOpcode(	INST_PUSH_RETURN_OPTIONS,		envPtr);
    TclEmitOpcode(	INST_END_CATCH,				envPtr);
    TclEmitInstInt4(	INST_REVERSE, 3,			envPtr);
    TclEmitOpcode(   INST_PUSH_RESULT,				envPtr);
    TclEmitOpcode(   INST_PUSH_RETURN_OPTIONS,			envPtr);
    TclEmitOpcode(   INST_END_CATCH,				envPtr);
    TclEmitInstInt4( INST_REVERSE, 3,				envPtr);

    TclEmitInstInt4(	INST_DICT_UPDATE_END, dictIndex,	envPtr);
    TclEmitInt4(		infoIndex,			envPtr);
    TclEmitInvoke(envPtr,INST_RETURN_STK);
    TclEmitInstInt4( INST_DICT_UPDATE_END, dictIndex,		envPtr);
    TclEmitInt4(     infoIndex,					envPtr);
    TclEmitOpcode(   INST_RETURN_STK,				envPtr);

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d",
		CurrentOffset(envPtr) - jumpFixup.codeOffset);
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
		(int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
    }
    TclStackFree(interp, keyTokenPtrs);
    return TCL_OK;

    /*
     * Clean up after a failure to create the DictUpdateInfo structure.
     */

  failedUpdateInfoAssembly:
    Tcl_Free(duiPtr);
    TclStackFree(interp, keyTokenPtrs);
  issueFallback:
    return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileDictAppendCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i, dictVarIndex;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be at least two argument after the command. And we impose an
     * (arbirary) safe limit; anyone exceeding it should stop worrying about
     * speed quite so much. ;-)
     * There must be at least two argument after the command. Since we
     * implement using INST_CONCAT1, make sure the number of arguments
     * stays within its range.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords<4 || parsePtr->numWords>100) {
    if (parsePtr->numWords<4 || parsePtr->numWords>258) {
	return TCL_ERROR;
    }

    /*
     * Get the index of the local variable that we will be working with.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    dictVarIndex = LocalScalarFromToken(tokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasicMin2ArgCmd(interp, parsePtr,cmdPtr, envPtr);
	return TCL_ERROR;
    }

    /*
     * Produce the string to concatenate onto the dictionary entry.
     */

    tokenPtr = TokenAfter(tokenPtr);
    for (i=2 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (parsePtr->numWords > 4) {
	TclEmitInstInt1(INST_STR_CONCAT1, parsePtr->numWords-3, envPtr);
	TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr);
    }

    /*
     * Do the concatenation.
     */

    TclEmitInstInt4(INST_DICT_APPEND, dictVarIndex, envPtr);
    return TCL_OK;
}

int
TclCompileDictLappendCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
    int dictVarIndex;
    DefineLineInformation;	/* TIP #280 */

    /*
     * There must be three arguments after the command.
     */

    /* TODO: Consider support for compiling expanded args. */
    /* Probably not.  Why is INST_DICT_LAPPEND limited to one value? */
    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    /*
     * Parse the arguments.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    keyTokenPtr = TokenAfter(varTokenPtr);
    valueTokenPtr = TokenAfter(keyTokenPtr);
    dictVarIndex = LocalScalarFromToken(varTokenPtr, envPtr);
    if (dictVarIndex < 0) {
	return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

	return TCL_ERROR;
    /*
     * Issue the implementation.
     */

    }
    CompileWord(envPtr, keyTokenPtr, interp, 2);
    CompileWord(envPtr, valueTokenPtr, interp, 3);
    TclEmitInstInt4(	INST_DICT_LAPPEND, dictVarIndex,	envPtr);
    TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
    return TCL_OK;
}

int
TclCompileDictWithCmd(
    Tcl_Interp *interp,		/* Used for looking up stuff. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int i, range, varNameTmp = -1, pathTmp = -1, keysTmp, gotPath;
    int dictVar, bodyIsEmpty = 1;
    Tcl_Token *varTokenPtr, *tokenPtr;
    JumpFixup jumpFixup;
    const char *ptr, *end;

    /*
     * There must be at least one argument after the command.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Parse the command (trivially). Expect the following:
     *   dict with <any (varName)> ?<any> ...? <literal>
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(varTokenPtr);
    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Test if the last word is an empty script; if so, we can compile it in
     * all cases, but if it is non-empty we need local variable table entries
     * to hold the temporary variables (used to keep stack usage simple).
     */

    for (ptr=tokenPtr[1].start,end=ptr+tokenPtr[1].size ; ptr!=end ; ptr++) {
	if (*ptr!=' ' && *ptr!='\t' && *ptr!='\n' && *ptr!='\r') {
	    if (envPtr->procPtr == NULL) {
		return TclCompileBasicMin2ArgCmd(interp, parsePtr, cmdPtr,
			envPtr);
	    }
	    bodyIsEmpty = 0;
	    break;
	}
    }

    /*
     * Determine if we're manipulating a dict in a simple local variable.
     */

    gotPath = (parsePtr->numWords > 3);
    dictVar = LocalScalarFromToken(varTokenPtr, envPtr);

    /*
     * Special case: an empty body means we definitely have no need to issue
     * try-finally style code or to allocate local variable table entries for
     * storing temporaries. Still need to do both INST_DICT_EXPAND and
     * INST_DICT_RECOMBINE_* though, because we can't determine if we're free
     * of traces.
     */

    if (bodyIsEmpty) {
	if (dictVar >= 0) {
	    if (gotPath) {
		/*
		 * Case: Path into dict in LVT with empty body.
		 */

		tokenPtr = TokenAfter(varTokenPtr);
		for (i=2 ; i<parsePtr->numWords-1 ; i++) {
		    CompileWord(envPtr, tokenPtr, interp, i);
		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
	    } else {
		/*
		 * Case: Direct dict in LVT with empty body.
		 */

		PushStringLiteral(envPtr, "");
		Emit14Inst(	INST_LOAD_SCALAR, dictVar,	envPtr);
		PushStringLiteral(envPtr, "");
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitInstInt4(INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
	    }
	} else {
	    if (gotPath) {
		/*
		 * Case: Path into dict in non-simple var with empty body.
		 */

		tokenPtr = varTokenPtr;
		for (i=1 ; i<parsePtr->numWords-1 ; i++) {
		    CompileWord(envPtr, tokenPtr, interp, i);
		    tokenPtr = TokenAfter(tokenPtr);
		}
		TclEmitInstInt4(INST_LIST, parsePtr->numWords-3,envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
	    } else {
		/*
		 * Case: Direct dict in non-simple var with empty body.
		 */

		CompileWord(envPtr, varTokenPtr, interp, 1);
		TclEmitOpcode(	INST_DUP,			envPtr);
		TclEmitOpcode(	INST_LOAD_STK,			envPtr);
		PushStringLiteral(envPtr, "");
		TclEmitOpcode(	INST_DICT_EXPAND,		envPtr);
		PushStringLiteral(envPtr, "");
		TclEmitInstInt4(INST_REVERSE, 2,		envPtr);
		TclEmitOpcode(	INST_DICT_RECOMBINE_STK,	envPtr);
	    }
	}
	PushStringLiteral(envPtr, "");
	return TCL_OK;
    }

    /*
     * OK, we have a non-trivial body. This means that the focus is on
     * generating a try-finally structure where the INST_DICT_RECOMBINE_* goes
     * in the 'finally' clause.
     *
     * Start by allocating local (unnamed, untraced) working variables.
     */

    if (dictVar == -1) {
	varNameTmp = AnonymousLocal(envPtr);
    }
    if (gotPath) {
	pathTmp = AnonymousLocal(envPtr);
    }
    keysTmp = AnonymousLocal(envPtr);

    /*
     * Issue instructions. First, the part to expand the dictionary.
     */

    if (dictVar == -1) {
	CompileWord(envPtr, varTokenPtr, interp, 1);
	Emit14Inst(		INST_STORE_SCALAR, varNameTmp,	envPtr);
    }
    tokenPtr = TokenAfter(varTokenPtr);
    if (gotPath) {
	for (i=2 ; i<parsePtr->numWords-1 ; i++) {
	    CompileWord(envPtr, tokenPtr, interp, i);
	    tokenPtr = TokenAfter(tokenPtr);
	}
	TclEmitInstInt4(	INST_LIST, parsePtr->numWords-3,envPtr);
	Emit14Inst(		INST_STORE_SCALAR, pathTmp,	envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
    }
    if (dictVar == -1) {
	TclEmitOpcode(		INST_LOAD_STK,			envPtr);
    } else {
	Emit14Inst(		INST_LOAD_SCALAR, dictVar,	envPtr);
    }
    if (gotPath) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushStringLiteral(envPtr, "");
    }
    TclEmitOpcode(		INST_DICT_EXPAND,		envPtr);
    Emit14Inst(			INST_STORE_SCALAR, keysTmp,	envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);

    /*
     * Now the body of the [dict with].
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    TclEmitInstInt4(		INST_BEGIN_CATCH4, range,	envPtr);

    ExceptionRangeStarts(envPtr, range);
    BODY(tokenPtr, parsePtr->numWords - 1);
    ExceptionRangeEnds(envPtr, range);

    /*
     * Now fold the results back into the dictionary in the OK case.
     */

    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (dictVar == -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
    }
    if (gotPath) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushStringLiteral(envPtr, "");
    }
    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup);

    /*
     * Now fold the results back into the dictionary in the exception case.
     */

    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, range, catchOffset);
    TclEmitOpcode(		INST_PUSH_RETURN_OPTIONS,	envPtr);
    TclEmitOpcode(		INST_PUSH_RESULT,		envPtr);
    TclEmitOpcode(		INST_END_CATCH,			envPtr);
    if (dictVar == -1) {
	Emit14Inst(		INST_LOAD_SCALAR, varNameTmp,	envPtr);
    }
    if (parsePtr->numWords > 3) {
	Emit14Inst(		INST_LOAD_SCALAR, pathTmp,	envPtr);
    } else {
	PushStringLiteral(envPtr, "");
    }
    Emit14Inst(			INST_LOAD_SCALAR, keysTmp,	envPtr);
    if (dictVar == -1) {
	TclEmitOpcode(		INST_DICT_RECOMBINE_STK,	envPtr);
    } else {
	TclEmitInstInt4(	INST_DICT_RECOMBINE_IMM, dictVar, envPtr);
    }
    TclEmitInvoke(envPtr,	INST_RETURN_STK);

    /*
     * Prepare for the start of the next command.
     */

    if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
	Tcl_Panic("TclCompileDictCmd(update): bad jump distance %" TCL_Z_MODIFIER "d",
		CurrentOffset(envPtr) - jumpFixup.codeOffset);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DupDictUpdateInfo, FreeDictUpdateInfo --
 *
 *	Functions to duplicate, release and print the aux data created for use
 *	with the INST_DICT_UPDATE_START and INST_DICT_UPDATE_END instructions.
 *
 * Results:
 *	DupDictUpdateInfo: a copy of the auxiliary data
 *	FreeDictUpdateInfo: none
 *	PrintDictUpdateInfo: none
 *	DisassembleDictUpdateInfo: none
 *
 * Side effects:
 *	DupDictUpdateInfo: allocates memory
 *	FreeDictUpdateInfo: releases memory
 *	PrintDictUpdateInfo: none
 *	DisassembleDictUpdateInfo: none
 *
 *----------------------------------------------------------------------
 */

static ClientData
DupDictUpdateInfo(
    ClientData clientData)
{
    DictUpdateInfo *dui1Ptr, *dui2Ptr;
    size_t len;
    unsigned len;

    dui1Ptr = (DictUpdateInfo *)clientData;
    len = offsetof(DictUpdateInfo, varIndices) + sizeof(int) * dui1Ptr->length;
    dui2Ptr = (DictUpdateInfo *)Tcl_Alloc(len);
    dui1Ptr = clientData;
    len = sizeof(DictUpdateInfo) + sizeof(int) * (dui1Ptr->length - 1);
    dui2Ptr = (DictUpdateInfo *) ckalloc(len);
    memcpy(dui2Ptr, dui1Ptr, len);
    return dui2Ptr;
}

static void
FreeDictUpdateInfo(
    ClientData clientData)
{
    Tcl_Free(clientData);
    ckfree(clientData);
}

static void
PrintDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    size_t i;
    DictUpdateInfo *duiPtr = clientData;
    int i;

    for (i=0 ; i<duiPtr->length ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	}
	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
    }
}


static void
DisassembleDictUpdateInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
{
    DictUpdateInfo *duiPtr = (DictUpdateInfo *)clientData;
    size_t i;
    Tcl_Obj *variables;

    TclNewObj(variables);
    for (i=0 ; i<duiPtr->length ; i++) {
	Tcl_ListObjAppendElement(NULL, variables,
		Tcl_NewWideIntObj(duiPtr->varIndices[i]));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
	    variables);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileErrorCmd --
 *
 *	Procedure called to compile the "error" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "error" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileErrorCmd(
    Tcl_Interp *interp,		/* Used for context. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /*
     * General syntax: [error message ?errorInfo? ?errorCode?]
     */

    if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }

    /*
     * Handle the message.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /*
     * Construct the options. Note that -code and -level are not here.
     */

    if (parsePtr->numWords == 2) {
	PushStringLiteral(envPtr, "");
    } else {
	PushStringLiteral(envPtr, "-errorinfo");
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	if (parsePtr->numWords == 3) {
	    TclEmitInstInt4(	INST_LIST, 2,			envPtr);
	} else {
	    PushStringLiteral(envPtr, "-errorcode");
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 3);
	    TclEmitInstInt4(	INST_LIST, 4,			envPtr);
	}
    }

    /*
     * Issue the error via 'returnImm error 0'.
     */

    TclEmitInstInt4(		INST_RETURN_IMM, TCL_ERROR,	envPtr);
    TclEmitInt4(			0,			envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileExprCmd --
 *
 *	Procedure called to compile the "expr" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "expr" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileExprCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *firstWordPtr;

    if (parsePtr->numWords == 1) {
	return TCL_ERROR;
    }
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
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







-
-
+
+













-
+
+


-


-
+

+
+







 *----------------------------------------------------------------------
 *
 * TclCompileForCmd --
 *
 *	Procedure called to compile the "for" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "for" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileForCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int bodyCodeOffset, nextCodeOffset, jumpDist;
    int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist;
    int bodyRange, nextRange;
    int savedStackDepth = envPtr->currStackDepth;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords != 5) {
	return TCL_ERROR;
    }

    /*
     * If the test expression requires substitutions, don't compile the for
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
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
1439
1440
1441
1442

1443


1444
1445


1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492


1493
1494
1495
1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511


1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
































































1531

1532
1533
1534

1535
1536
1537


1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549







+
+
+
+
+
+
+
+
+




+
-
+




















-

+
-
+

+



-
+
-
-


-
-
+

+
-
+

+

+






+
+
+
-
+


+


-
+
+

+




















-
-





+
-
+












-
-
+
+

















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+


-

+
+
-
-
+
+
+

+







    nextTokenPtr = TokenAfter(testTokenPtr);
    bodyTokenPtr = TokenAfter(nextTokenPtr);
    if ((nextTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
	return TCL_ERROR;
    }

    /*
     * Create ExceptionRange records for the body and the "next" command. The
     * "next" command's ExceptionRange supports break but not continue (and
     * has a -1 continueOffset).
     */

    bodyRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
    nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);

    /*
     * Inline compile the initial command.
     */

    SetLineInformation (1);
    BODY(startTokenPtr, 1);
    CompileBody(envPtr, startTokenPtr, interp);
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Jump to the evaluation of the condition. This code uses the "loop
     * rotation" optimisation (which eliminates one branch from the loop).
     * "for start cond next body" produces then:
     *       start
     *       goto A
     *    B: body                : bodyCodeOffset
     *       next                : nextCodeOffset, continueOffset
     *    A: cond -> result      : testCodeOffset
     *       if (result) goto B
     */

    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);

    /*
     * Compile the loop body.
     */

    bodyRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange);
    SetLineInformation (4);
    BODY(bodyTokenPtr, 4);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, bodyRange);
    envPtr->currStackDepth = savedStackDepth + 1;
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Compile the "next" subcommand. Note that this exception range will not
     * Compile the "next" subcommand.
     * have a continueOffset (other than -1) connected to it; it won't trap
     * TCL_CONTINUE but rather just TCL_BREAK.
     */

    nextRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
    envPtr->exceptAuxArrayPtr[nextRange].supportsContinue = 0;
    envPtr->currStackDepth = savedStackDepth;
    nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange);
    SetLineInformation (3);
    BODY(nextTokenPtr, 3);
    CompileBody(envPtr, nextTokenPtr, interp);
    ExceptionRangeEnds(envPtr, nextRange);
    envPtr->currStackDepth = savedStackDepth + 1;
    TclEmitOpcode(INST_POP, envPtr);
    envPtr->currStackDepth = savedStackDepth;

    /*
     * Compile the test expression then emit the conditional jump that
     * terminates the for.
     */

    testCodeOffset = CurrentOffset(envPtr);

    jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
    if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) {
    if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
	bodyCodeOffset += 3;
	nextCodeOffset += 3;
	testCodeOffset += 3;
    }

    SetLineInformation(2);
    SetLineInformation (2);
    envPtr->currStackDepth = savedStackDepth;
    TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
    envPtr->currStackDepth = savedStackDepth + 1;

    jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
    if (jumpDist > 127) {
	TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
    } else {
	TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
    }

    /*
     * Fix the starting points of the exception ranges (may have moved due to
     * jump type modification) and set where the exceptions target.
     */

    envPtr->exceptArrayPtr[bodyRange].codeOffset = bodyCodeOffset;
    envPtr->exceptArrayPtr[bodyRange].continueOffset = nextCodeOffset;

    envPtr->exceptArrayPtr[nextRange].codeOffset = nextCodeOffset;

    ExceptionRangeTarget(envPtr, bodyRange, breakOffset);
    ExceptionRangeTarget(envPtr, nextRange, breakOffset);
    TclFinalizeLoopExceptionRange(envPtr, bodyRange);
    TclFinalizeLoopExceptionRange(envPtr, nextRange);

    /*
     * The for command's result is an empty string.
     */

    envPtr->currStackDepth = savedStackDepth;
    PushStringLiteral(envPtr, "");
    PushLiteral(envPtr, "", 0);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileForeachCmd --
 *
 *	Procedure called to compile the "foreach" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "foreach" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileForeachCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
	    TCL_EACH_KEEP_NONE);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLmapCmd --
 *
 *	Procedure called to compile the "lmap" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lmap" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLmapCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr,
	    TCL_EACH_COLLECT);
}

/*
 *----------------------------------------------------------------------
 *
 * CompileEachloopCmd --
 *
 *	Procedure called to compile the "foreach" and "lmap" commands.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "foreach" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileEachloopCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int collect)		/* Select collecting or accumulating mode
				 * (TCL_EACH_*) */
{
    DefineLineInformation;	/* TIP #280 */
    Proc *procPtr = envPtr->procPtr;
    ForeachInfo *infoPtr=NULL;	/* Points to the structure describing this
    ForeachInfo *infoPtr = NULL;/* Points to the structure describing this
				 * foreach command. Stored in a AuxData
				 * record in the ByteCode. */

    Tcl_Token *tokenPtr, *bodyTokenPtr;
    unsigned char *jumpPc;
    JumpFixup jumpFalseFixup;
    int jumpBackOffset, infoIndex, range;
    int numWords, numLists, i, j, code = TCL_OK;
    int jumpBackDist, jumpBackOffset, infoIndex, range;
    int numWords, numLists, tempVar, i, j, code = TCL_OK;
    int savedStackDepth = envPtr->currStackDepth;
    Tcl_Obj *varListObj = NULL;
    DefineLineInformation;	/* TIP #280 */

    /*
     * If the foreach command isn't in a procedure, don't compile it inline:
     * the payoff is too small.
     */

    if (procPtr == NULL) {
2721
2722
2723
2724
2725
2726
2727
2728
2729


2730
2731
2732
2733

2734
2735
2736
2737
2738

2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752


2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763


2764
2765
2766
2767
2768
2769

2770
2771
2772
2773
2774
2775
2776
2777
2778



2779
2780
2781
2782
2783
2784
2785
2786
2787





2788

2789
2790







2791

2792
2793
2794

2795
2796
2797
2798
2799


2800
2801
2802

2803
2804
2805
2806
2807
2808

2809
2810
2811
2812
2813

























2814
2815
2816
2817
2818
2819
2820

2821
2822

2823


2824






2825
2826





2827
2828

2829
2830
2831
2832

2833
2834
2835
2836
2837
2838





2839
2840

2841
2842
2843

2844
2845
2846



2847
2848
2849
2850
2851










2852
2853
2854

2855
2856

2857
2858
2859








2860
2861

2862

2863
2864
2865






2866
2867
2868
2869
2870
2871
2872
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
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
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
1772
1773
1774







-
-
+
+



-
+




-
+












-
-
+
+









-
-
+
+






+

-
-

-

-
-
-
+
+
+



-





+
+
+
+
+
-
+


+
+
+
+
+
+
+
-
+


-
+


-
-
-
+
+
-

-
+






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





-
-
+

-
+

+
+

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

-
+



-
+
-


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

-
+
-
-
-
+
+
+

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

-
-
+


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

-
+

+
-
-
-
+
+
+
+
+
+







    /*
     * Create and initialize the ForeachInfo and ForeachVarList data
     * structures describing this command. Then create a AuxData record
     * pointing to the ForeachInfo structure.
     */

    numLists = (numWords - 2)/2;
    infoPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists)
	    + numLists * sizeof(ForeachVarList *));
    infoPtr = (ForeachInfo *) ckalloc((unsigned)
	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
    infoPtr->numLists = 0;	/* Count this up as we go */

    /*
     * Parse each var list into sequence of var names.  Don't
     * Parse each var list into sequence of var names. Don't
     * compile the foreach inline if any var name needs substitutions or isn't
     * a scalar, or if any var list needs substitutions.
     */

    TclNewObj(varListObj);
    varListObj = Tcl_NewObj();
    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	ForeachVarList *varListPtr;
	int numVars;

	if (i%2 != 1) {
	    continue;
	}

	/*
	 * If the variable list is empty, we can enter an infinite loop when
	 * the interpreted version would not.  Take care to ensure this does
	 * not happen.  [Bug 1671138]
	 * the interpreted version would not. Take care to ensure this does
	 * not happen. [Bug 1671138]
	 */

	if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) ||
		TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) ||
		numVars == 0) {
	    code = TCL_ERROR;
	    goto done;
	}

	varListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes)
		+ numVars * sizeof(int));
	varListPtr = (ForeachVarList *) ckalloc((unsigned)
		sizeof(ForeachVarList) + numVars*sizeof(int));
	varListPtr->numVars = numVars;
	infoPtr->varLists[i/2] = varListPtr;
	infoPtr->numLists++;

	for (j = 0;  j < numVars;  j++) {
	    Tcl_Obj *varNameObj;
	    int numBytes;
	    const char *bytes;
	    int varIndex;
	    size_t length;


	    Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
	    bytes = TclGetStringFromObj(varNameObj, &length);
	    varIndex = LocalScalar(bytes, length, envPtr);
	    if (varIndex < 0) {
	    bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
	    varListPtr->varIndexes[j] = LocalScalar(bytes, numBytes, envPtr);
	    if (varListPtr->varIndexes[j] < 0) {
		code = TCL_ERROR;
		goto done;
	    }
	    varListPtr->varIndexes[j] = varIndex;
	}
	Tcl_SetObjLength(varListObj, 0);
    }

    /*
     * Reserve (numLists + 1) temporary variables:
     *    - numLists temps to hold each value list
     *    - 1 temp for the loop counter (index of next element in each list)
     *
     * At this time we don't try to reuse temporaries; if there are two
     * We will compile the foreach command.
     * nonoverlapping foreach loops, they don't share any temps.
     */

    tempVar = TclFindCompiledLocal(NULL, 0, 1, procPtr);
    infoPtr->firstValueTemp = tempVar;
    for (i= 1;  i < numLists;  i++) {
	TclFindCompiledLocal(NULL, 0, 1, procPtr);
    }
    infoPtr->loopCtTemp = TclFindCompiledLocal(NULL, 0, 1, procPtr);

    infoIndex = TclCreateAuxData(infoPtr, &newForeachInfoType, envPtr);
    infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr);

    /*
     * Create the collecting object, unshared.
     * Create an exception record to handle [break] and [continue].
     */

    if (collect == TCL_EACH_COLLECT) {
	TclEmitInstInt4(INST_LIST, 0, envPtr);
    }
    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);


    /*
     * Evaluate each value list and leave it on stack.
     * Evaluate then store each value list in the associated temporary.
     */

    for (i = 0, tokenPtr = parsePtr->tokenPtr;
	    i < numWords-1;
	    i++, tokenPtr = TokenAfter(tokenPtr)) {
	if ((i%2 == 0) && (i > 0)) {
	    SetLineInformation (i);
	    CompileWord(envPtr, tokenPtr, interp, i);
	}
    }

    TclEmitInstInt4(INST_FOREACH_START, infoIndex, envPtr);
	    CompileTokens(envPtr, tokenPtr, interp);
	    if (tempVar <= 255) {
		TclEmitInstInt1(INST_STORE_SCALAR1, tempVar, envPtr);
	    } else {
		TclEmitInstInt4(INST_STORE_SCALAR4, tempVar, envPtr);
	    }
	    TclEmitOpcode(INST_POP, envPtr);
	    tempVar++;
	}
    }

    /*
     * Initialize the temporary var that holds the count of loop iterations.
     */

    TclEmitInstInt4(INST_FOREACH_START4, infoIndex, envPtr);

    /*
     * Top of loop code: assign each loop variable and check whether
     * to terminate the loop.
     */

    ExceptionRangeTarget(envPtr, range, continueOffset);
    TclEmitInstInt4(INST_FOREACH_STEP4, infoIndex, envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFalseFixup);

    /*
     * Inline compile the loop body.
     */

    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);

    SetLineInformation (numWords - 1);
    ExceptionRangeStarts(envPtr, range);
    BODY(bodyTokenPtr, numWords - 1);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, range);
    envPtr->currStackDepth = savedStackDepth + 1;
    TclEmitOpcode(INST_POP, envPtr);

    /*
     * Jump back to the test at the top of the loop. Generate a 4 byte jump if
     * the distance to the test is > 120 bytes. This is conservative and
     * ensures that we won't have to replace this jump if we later need to
     * replace the ifFalse jump with a 4 byte jump.
     */
    if (collect == TCL_EACH_COLLECT) {
	TclEmitOpcode(INST_LMAP_COLLECT, envPtr);

    jumpBackOffset = CurrentOffset(envPtr);
    jumpBackDist = jumpBackOffset-envPtr->exceptArrayPtr[range].continueOffset;
    if (jumpBackDist > 120) {
	TclEmitInstInt4(INST_JUMP4, -jumpBackDist, envPtr);
    } else {
	TclEmitOpcode(		INST_POP,			envPtr);
	TclEmitInstInt1(INST_JUMP1, -jumpBackDist, envPtr);
    }

    /*
     * Bottom of loop code: assign each loop variable and check whether
     * Fix the target of the jump after the foreach_step test.
     * to terminate the loop. Set the loop's break target.
     */

    ExceptionRangeTarget(envPtr, range, continueOffset);
    TclEmitOpcode(INST_FOREACH_STEP, envPtr);
    ExceptionRangeTarget(envPtr, range, breakOffset);
    if (TclFixupForwardJumpToHere(envPtr, &jumpFalseFixup, 127)) {
	/*
	 * Update the loop body's starting PC offset since it moved down.
	 */

    TclFinalizeLoopExceptionRange(envPtr, range);
    TclEmitOpcode(INST_FOREACH_END, envPtr);
	envPtr->exceptArrayPtr[range].codeOffset += 3;
    TclAdjustStackDepth(-(numLists+2), envPtr);

    /*
	/*
     * Set the jumpback distance from INST_FOREACH_STEP to the start of the
     * body's code. Misuse loopCtTemp for storing the jump size.
     */
	 * Update the jump back to the test at the top of the loop since it
	 * also moved down 3 bytes.
	 */

    jumpBackOffset = envPtr->exceptArrayPtr[range].continueOffset -
	    envPtr->exceptArrayPtr[range].codeOffset;
    infoPtr->loopCtTemp = -jumpBackOffset;

	jumpBackOffset += 3;
	jumpPc = (envPtr->codeStart + jumpBackOffset);
	jumpBackDist += 3;
	if (jumpBackDist > 120) {
	    TclUpdateInstInt4AtPc(INST_JUMP4, -jumpBackDist, jumpPc);
	} else {
	    TclUpdateInstInt1AtPc(INST_JUMP1, -jumpBackDist, jumpPc);
	}
    }

    /*
     * The command's result is an empty string if not collecting. If
     * collecting, it is automatically left on stack after FOREACH_END.
     * Set the loop's break target.
     */

    ExceptionRangeTarget(envPtr, range, breakOffset);
    if (collect != TCL_EACH_COLLECT) {
	PushStringLiteral(envPtr, "");
    }

    /*
     * The foreach command's result is an empty string.
     */

    envPtr->currStackDepth = savedStackDepth;
    PushLiteral(envPtr, "", 0);
    envPtr->currStackDepth = savedStackDepth + 1;

    done:
  done:
    if (code == TCL_ERROR) {
	if (infoPtr) {
	FreeForeachInfo(infoPtr);
    }
    Tcl_DecrRefCount(varListObj);
	    FreeForeachInfo(infoPtr);
	}
    }
    if (varListObj) {
	Tcl_DecrRefCount(varListObj);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * DupForeachInfo --
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
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







-
+

-
+


-
-
+
+







-
-
+
+







 */

static ClientData
DupForeachInfo(
    ClientData clientData)	/* The foreach command's compilation auxiliary
				 * data to duplicate. */
{
    ForeachInfo *srcPtr = (ForeachInfo *)clientData;
    register ForeachInfo *srcPtr = clientData;
    ForeachInfo *dupPtr;
    ForeachVarList *srcListPtr, *dupListPtr;
    register ForeachVarList *srcListPtr, *dupListPtr;
    int numVars, i, j, numLists = srcPtr->numLists;

    dupPtr = (ForeachInfo *)Tcl_Alloc(offsetof(ForeachInfo, varLists)
	    + numLists * sizeof(ForeachVarList *));
    dupPtr = (ForeachInfo *) ckalloc((unsigned)
	    sizeof(ForeachInfo) + numLists*sizeof(ForeachVarList *));
    dupPtr->numLists = numLists;
    dupPtr->firstValueTemp = srcPtr->firstValueTemp;
    dupPtr->loopCtTemp = srcPtr->loopCtTemp;

    for (i = 0;  i < numLists;  i++) {
	srcListPtr = srcPtr->varLists[i];
	numVars = srcListPtr->numVars;
	dupListPtr = (ForeachVarList *)Tcl_Alloc(offsetof(ForeachVarList, varIndexes)
		+ numVars * sizeof(int));
	dupListPtr = (ForeachVarList *) ckalloc((unsigned)
		sizeof(ForeachVarList) + numVars*sizeof(int));
	dupListPtr->numVars = numVars;
	for (j = 0;  j < numVars;  j++) {
	    dupListPtr->varIndexes[j] =	srcListPtr->varIndexes[j];
	}
	dupPtr->varLists[i] = dupListPtr;
    }
    return dupPtr;
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
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







-
-
+
+

-
+



-
+

-
+





-
+

-
-
+
+














-
-
+
+

-
-
+
+







 */

static void
FreeForeachInfo(
    ClientData clientData)	/* The foreach command's compilation auxiliary
				 * data to free. */
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *listPtr;
    register ForeachInfo *infoPtr = clientData;
    register ForeachVarList *listPtr;
    int numLists = infoPtr->numLists;
    int i;
    register int i;

    for (i = 0;  i < numLists;  i++) {
	listPtr = infoPtr->varLists[i];
	Tcl_Free(listPtr);
	ckfree((char *) listPtr);
    }
    Tcl_Free(infoPtr);
    ckfree((char *) infoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PrintForeachInfo, DisassembleForeachInfo --
 * PrintForeachInfo --
 *
 *	Functions to write a human-readable or script-readablerepresentation
 *	of a ForeachInfo structure to a Tcl_Obj for debugging.
 *	Function to write a human-readable representation of a ForeachInfo
 *	structure to stdout for debugging.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
PrintForeachInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    register ForeachInfo *infoPtr = clientData;
    register ForeachVarList *varsPtr;
    int i, j;

    Tcl_AppendToObj(appendObj, "data=[", -1);

    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793














3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529

4530
4531

4532

4533
4534


4535
4536
4537
4538

4539
4540
4541
4542
4543
4544
4545

4546
4547
4548
4549

4550
4551
4552
4553





4554
4555
4556
4557



4558
4559



4560




4561




4562



4563


4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574



4575
4576
4577





4578
4579
4580
4581
4582



4583

4584
4585
4586
4587

4588



4589



4590
4591



4592



4593
4594



4595
4596
4597
4598






4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610



4611
4612



4613
4614



4615
4616





4617







4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629





4630


4631
4632




4633
4634
4635


4636
4637
4638





4639
4640
4641
4642
4643
4644

4645



4646
4647





4648
4649
4650
4651




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



4955
4956
4957
4958
4959

4960

4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
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
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







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

+
+
+
+
+
+
+
+
+

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

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


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

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

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

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

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

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

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

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





-
+

-
+
-


-
-
+
+


-
+






-
+



-
+
+


-
-
-
-
-
+
+
+
+
-
-
-
+
+
-
-
-
+
-
-
-
-
+
-
-
-
-

-
-
-
+
-
-



+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+

-
-
-
+
-
+
+


-
+
-
-
-
+
-
-
-
+
+
-
-
-
+
-
-
-
+
+
-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
-
-
-


-
-
-
+
+
-
-
-
-
-

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
-
-
+
+
-
-
-
-
+
+
+
-
-
+
+
+
-
-
-
-
-

+
+
+
+

-
+
-
-
-


-
-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
+
-

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


-
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
+
+
+

+
-
+
-
+






-
+






-
-
-
+
+
+


-
+




-
-
+
+



-
+

-
+
+






-
-
+
+

-
+


-
-
+
+



-
+





-
+





-
+
-
-
-
-
-
-
-
-
-
+
-
-
-


-
+
+




-
-
+
+



-
+

+
-
+
+
+

-
-
-
+
+
+

-
-
+












-
+











-
-
+
+



-

-
-
-
-
-
-
-
+
+
+
+
+
+
-



-
+





-
+
+



-
+







-
+
+





-
-
+
+






-
+








-
+

-
+




-
+

-
-
+
+

-
-
+





-
+
+



-
+









-
+






-










-
+
-
-
+











-
-
+
+
+
+









-
+



-
+
-


-
-
-
+
+
+
+
+
-

-
+







+
+




-
+





+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









	    }
	    Tcl_AppendPrintfToObj(appendObj, "%%v%u",
		    (unsigned) varsPtr->varIndexes[j]);
	}
	Tcl_AppendToObj(appendObj, "]", -1);
    }
}

static void
PrintNewForeachInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;

    Tcl_AppendPrintfToObj(appendObj, "jumpOffset=%+d, vars=",
	    infoPtr->loopCtTemp);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	if (i) {
	    Tcl_AppendToObj(appendObj, ",", -1);
	}
	Tcl_AppendToObj(appendObj, "[", -1);
	varsPtr = infoPtr->varLists[i];
	for (j=0 ; j<varsPtr->numVars ; j++) {
	    if (j) {

/*
 *----------------------------------------------------------------------
 *
 * TclCompileIfCmd --
 *
 *	Procedure called to compile the "if" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "if" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileIfCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    JumpFixupArray jumpFalseFixupArray;
    				/* Used to fix the ifFalse jump after each
				 * test when its target PC is determined. */
    JumpFixupArray jumpEndFixupArray;
				/* Used to fix the jump after each "then" body
				 * to the end of the "if" when that PC is
				 * determined. */
    Tcl_Token *tokenPtr, *testTokenPtr;
    int jumpIndex = 0;		/* Avoid compiler warning. */
    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
    const char *word;
    int savedStackDepth = envPtr->currStackDepth;
				/* Saved stack depth at the start of the first
				 * test; the envPtr current depth is restored
				 * to this value at the start of each test. */
    int realCond = 1;		/* Set to 0 for static conditions:
				 * "if 0 {..}" */
    int boolVal;		/* Value of static condition. */
    int compileScripts = 1;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Only compile the "if" command if all arguments are simple words, in
     * order to insure correct substitution [Bug 219166]
     */

    tokenPtr = parsePtr->tokenPtr;
    wordIdx = 0;
    numWords = parsePtr->numWords;

    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }

    TclInitJumpFixupArray(&jumpFalseFixupArray);
    TclInitJumpFixupArray(&jumpEndFixupArray);
    code = TCL_OK;

    /*
     * Each iteration of this loop compiles one "if expr ?then? body" or
     * "elseif expr ?then? body" clause.
     */

    tokenPtr = parsePtr->tokenPtr;
    wordIdx = 0;
    while (wordIdx < numWords) {
	/*
	 * Stop looping if the token isn't "if" or "elseif".
	 */

	word = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;
	if ((tokenPtr == parsePtr->tokenPtr)
		|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
	    tokenPtr = TokenAfter(tokenPtr);
	    wordIdx++;
	} else {
	    break;
	}
	if (wordIdx >= numWords) {
	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Compile the test expression then emit the conditional jump around
	 * the "then" part.
	 */

	envPtr->currStackDepth = savedStackDepth;
	testTokenPtr = tokenPtr;

	if (realCond) {
	    /*
	     * Find out if the condition is a constant.
	     */

	    Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
		    testTokenPtr[1].size);
	    Tcl_IncrRefCount(boolObj);
	    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
	    TclDecrRefCount(boolObj);
	    if (code == TCL_OK) {
		/*
		 * A static condition.
		 */

		realCond = 0;
		if (!boolVal) {
		    compileScripts = 0;
		}
	    } else {
		SetLineInformation (wordIdx);
		Tcl_ResetResult(interp);
		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
		}
		jumpIndex = jumpFalseFixupArray.next;
		jumpFalseFixupArray.next++;
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
			jumpFalseFixupArray.fixup+jumpIndex);
	    }
	    code = TCL_OK;
	}

	/*
	 * Skip over the optional "then" before the then clause.
	 */

	tokenPtr = TokenAfter(testTokenPtr);
	wordIdx++;
	if (wordIdx >= numWords) {
	    code = TCL_ERROR;
	    goto done;
	}
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    word = tokenPtr[1].start;
	    numBytes = tokenPtr[1].size;
	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
		tokenPtr = TokenAfter(tokenPtr);
		wordIdx++;
		if (wordIdx >= numWords) {
		    code = TCL_ERROR;
		    goto done;
		}
	    }
	}

	/*
	 * Compile the "then" command body.
	 */

	if (compileScripts) {
	    SetLineInformation (wordIdx);
	    envPtr->currStackDepth = savedStackDepth;
	    CompileBody(envPtr, tokenPtr, interp);
	}

	if (realCond) {
	    /*
	     * Jump to the end of the "if" command. Both jumpFalseFixupArray
	     * and jumpEndFixupArray are indexed by "jumpIndex".
	     */

	    if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
		TclExpandJumpFixupArray(&jumpEndFixupArray);
	    }
	    jumpEndFixupArray.next++;
	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
		    jumpEndFixupArray.fixup+jumpIndex);

	    /*
	     * Fix the target of the jumpFalse after the test. Generate a 4
	     * byte jump if the distance is > 120 bytes. This is conservative,
	     * and ensures that we won't have to replace this jump if we later
	     * also need to replace the proceeding jump to the end of the "if"
	     * with a 4 byte jump.
	     */

	    if (TclFixupForwardJumpToHere(envPtr,
		    jumpFalseFixupArray.fixup+jumpIndex, 120)) {
		/*
		 * Adjust the code offset for the proceeding jump to the end
		 * of the "if" command.
		 */

		jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
	    }
	} else if (boolVal) {
	    /*
	     * We were processing an "if 1 {...}"; stop compiling scripts.
	     */

	    compileScripts = 0;
	} else {
	    /*
	     * We were processing an "if 0 {...}"; reset so that the rest
	     * (elseif, else) is compiled correctly.
	     */

	    realCond = 1;
	    compileScripts = 1;
	}

	tokenPtr = TokenAfter(tokenPtr);
	wordIdx++;
    }

    /*
     * Restore the current stack depth in the environment; the "else" clause
     * (or its default) will add 1 to this.
     */

    envPtr->currStackDepth = savedStackDepth;

    /*
     * Check for the optional else clause. Do not compile anything if this was
     * an "if 1 {...}" case.
     */

    if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
	/*
	 * There is an else clause. Skip over the optional "else" word.
	 */

	word = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;
	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
	    tokenPtr = TokenAfter(tokenPtr);
	    wordIdx++;
	    if (wordIdx >= numWords) {
		code = TCL_ERROR;
		goto done;
	    }
	}

	if (compileScripts) {
	    /*
	     * Compile the else command body.
	     */

	    SetLineInformation (wordIdx);
	    CompileBody(envPtr, tokenPtr, interp);
	}

	/*
	 * Make sure there are no words after the else clause.
	 */

	wordIdx++;
	if (wordIdx < numWords) {
	    code = TCL_ERROR;
	    goto done;
	}
    } else {
	/*
	 * No else clause: the "if" command's result is an empty string.
	 */

	if (compileScripts) {
	    PushLiteral(envPtr, "", 0);
	}
    }

    /*
     * Fix the unconditional jumps to the end of the "if" command.
     */

    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
	if (TclFixupForwardJumpToHere(envPtr,
		jumpEndFixupArray.fixup+jumpIndex, 127)) {
	    /*
	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
	     * target (just after this jump) down three bytes.
	     */

	    unsigned char *ifFalsePc = envPtr->codeStart
		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
	    unsigned char opCode = *ifFalsePc;

	    if (opCode == INST_JUMP_FALSE1) {
		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */

  done:
    envPtr->currStackDepth = savedStackDepth + 1;
    TclFreeJumpFixupArray(&jumpFalseFixupArray);
    TclFreeJumpFixupArray(&jumpEndFixupArray);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileIncrCmd --
 *
 *	Procedure called to compile the "incr" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "incr" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileIncrCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *incrTokenPtr;
    int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
    DefineLineInformation;	/* TIP #280 */

    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
	return TCL_ERROR;
    }

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR,
		    &localIndex, &simpleVarName, &isScalar, 1);

    /*
     * If an increment is given, push it, but see first if it's a small
     * integer.
     */

    haveImmValue = 0;
    immValue = 1;
    if (parsePtr->numWords == 3) {
	incrTokenPtr = TokenAfter(varTokenPtr);
	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    const char *word = incrTokenPtr[1].start;
	    int numBytes = incrTokenPtr[1].size;
	    int code;
	    Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);
	    Tcl_IncrRefCount(intObj);
	    code = TclGetIntFromObj(NULL, intObj, &immValue);
	    TclDecrRefCount(intObj);
	    if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) {
		haveImmValue = 1;
	    }
	    if (!haveImmValue) {
		PushLiteral(envPtr, word, numBytes);
	    }
	} else {
	    SetLineInformation (2);
	    CompileTokens(envPtr, incrTokenPtr, interp);
	}
    } else {			/* No incr amount given so use 1. */
	haveImmValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex >= 0) {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
		    TclEmitInt1(immValue, envPtr);
		} else {
		    TclEmitInstInt1(INST_INCR_SCALAR1, localIndex, envPtr);
		}
	    } else {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_SCALAR_STK_IMM, immValue, envPtr);
		} else {
		    TclEmitOpcode(INST_INCR_SCALAR_STK, envPtr);
		}
	    }
	} else {
	    if (localIndex >= 0) {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
		    TclEmitInt1(immValue, envPtr);
		} else {
		    TclEmitInstInt1(INST_INCR_ARRAY1, localIndex, envPtr);
		}
	    } else {
		if (haveImmValue) {
		    TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
		} else {
		    TclEmitOpcode(INST_INCR_ARRAY_STK, envPtr);
		}
	    }
	}
    } else {			/* Non-simple variable name. */
	if (haveImmValue) {
	    TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
	} else {
	    TclEmitOpcode(INST_INCR_STK, envPtr);
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLappendCmd --
 *
 *	Procedure called to compile the "lappend" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lappend" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLappendCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int simpleVarName, isScalar, localIndex, numWords;
    DefineLineInformation;	/* TIP #280 */

    /*
     * If we're not in a procedure, don't compile.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = parsePtr->numWords;
    if (numWords == 1) {
	return TCL_ERROR;
    }
    if (numWords != 3) {
	/*
	 * LAPPEND instructions currently only handle one value appends.
	 */

	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we
     * need to emit code to compute and push the name at runtime. We use a
     * frame slot (entry in the array of local vars) if we are compiling a
     * procedure body and if the name is simple text that does not include
     * namespace qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
		    &localIndex, &simpleVarName, &isScalar, 1);

    /*
     * If we are doing an assignment, push the new value. In the no values
     * case, create an empty object.
     */

    if (numWords > 2) {
	Tcl_Token *valueTokenPtr = TokenAfter(varTokenPtr);
	CompileWord(envPtr, valueTokenPtr, interp, 2);
    }

    /*
     * Emit instructions to set/get the variable.
     */

    /*
     * The *_STK opcodes should be refactored to make better use of existing
     * LOAD/STORE instructions.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_LAPPEND_STK, envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1(INST_LAPPEND_SCALAR1, localIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_LAPPEND_SCALAR4, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_LAPPEND_ARRAY_STK, envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1(INST_LAPPEND_ARRAY1, localIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_LAPPEND_ARRAY4, localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode(INST_LAPPEND_STK, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLassignCmd --
 *
 *	Procedure called to compile the "lassign" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lassign" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLassignCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int simpleVarName, isScalar, localIndex, numWords, idx;
    DefineLineInformation;	/* TIP #280 */

    numWords = parsePtr->numWords;

    /*
     * Check for command syntax error, but we'll punt that to runtime.
     */

    if (numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Generate code to push list being taken apart by [lassign].
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /*
     * Generate code to assign values from the list to variables.
     */

    for (idx=0 ; idx<numWords-2 ; idx++) {
	tokenPtr = TokenAfter(tokenPtr);

	/*
	 * Generate the next variable name.
	 */

	PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
			&simpleVarName, &isScalar, idx+2);

	/*
	 * Emit instructions to get the idx'th item out of the list value on
	 * the stack and assign it to the variable.
	 */

	if (simpleVarName) {
	    if (isScalar) {
		Tcl_AppendToObj(appendObj, ",", -1);
	    }
		if (localIndex >= 0) {
		    TclEmitOpcode(INST_DUP, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    if (localIndex <= 255) {
			TclEmitInstInt1(INST_STORE_SCALAR1,localIndex,envPtr);
		    } else {
			TclEmitInstInt4(INST_STORE_SCALAR4,localIndex,envPtr);
		    }
	    Tcl_AppendPrintfToObj(appendObj, "%%v%u",
		    (unsigned) varsPtr->varIndexes[j]);
	}
	Tcl_AppendToObj(appendObj, "]", -1);
    }
}

static void
DisassembleForeachInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    Tcl_Obj *objPtr, *innerPtr;
		} else {
		    TclEmitInstInt4(INST_OVER, 1, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
		}
	    } else {
		if (localIndex >= 0) {
		    TclEmitInstInt4(INST_OVER, 1, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    if (localIndex <= 255) {
			TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
		    } else {
			TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
		    }
		} else {
		    TclEmitInstInt4(INST_OVER, 2, envPtr);
		    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
		    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
		}
	    }
	} else {
	    TclEmitInstInt4(INST_OVER, 1, envPtr);
	    TclEmitInstInt4(INST_LIST_INDEX_IMM, idx, envPtr);
	    TclEmitOpcode(INST_STORE_STK, envPtr);
	}
	TclEmitOpcode(INST_POP, envPtr);
    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr);
    TclEmitInt4(-2, envPtr);	/* -2 == "end" */

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLindexCmd --
 *
 *	Procedure called to compile the "lindex" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lindex" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLindexCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *idxTokenPtr, *valTokenPtr;
    int i, numWords = parsePtr->numWords;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Quit if too few args.
     */

    if (numWords <= 1) {
	return TCL_ERROR;
    }

    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (numWords != 3) {
	goto emitComplexLindex;
    }

    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;
	}

	/*
	 * If the conversion failed or the value was negative, we just keep on
	 * going with the more complex compilation.
	 */
    }

    /*
     * Push the operands onto the stack.
     */

  emitComplexLindex:
    for (i=1 ; i<numWords ; i++) {
	CompileWord(envPtr, valTokenPtr, interp, i);
	valTokenPtr = TokenAfter(valTokenPtr);
    }

    /*
     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
     * multiple index args.
     */

    if (numWords == 3) {
	TclEmitOpcode(INST_LIST_INDEX, envPtr);
    } else {
 	TclEmitInstInt4(INST_LIST_INDEX_MULTI, numWords-1, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileListCmd --
 *
 *	Procedure called to compile the "list" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "list" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileListCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */

    /*
     * If we're not in a procedure, don't compile.
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

	PushLiteral(envPtr, "", 0);
    } else {
	/*
	 * Push the all values onto the stack.
	 */

	Tcl_Token *valueTokenPtr;
	int i, numWords;

	numWords = parsePtr->numWords;

	valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
	for (i = 1; i < numWords; i++) {
	    CompileWord(envPtr, valueTokenPtr, interp, i);
	    valueTokenPtr = TokenAfter(valueTokenPtr);
	}
	TclEmitInstInt4(INST_LIST, numWords - 1, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLlengthCmd --
 *
 *	Procedure called to compile the "llength" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "llength" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLlengthCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    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.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lset" command at
 *	runtime.
 *
 * The general template for execution of the "lset" command is:
 *	(1) Instructions to push the variable name, unless the variable is
 *	    local to the stack frame.
 *	(2) If the variable is an array element, instructions to push the
 *	    array element name.
 *	(3) Instructions to push each of zero or more "index" arguments to the
 *	    stack, followed with the "newValue" element.
 *	(4) Instructions to duplicate the variable name and/or array element
 *	    name onto the top of the stack, if either was pushed at steps (1)
 *	    and (2).
 *	(5) The appropriate INST_LOAD_* instruction to place the original
 *	    value of the list variable at top of stack.
 *	(6) At this point, the stack contains:
 *		varName? arrayElementName? index1 index2 ... newValue oldList
 *	    The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST
 *	    according as whether there is exactly one index element (LIST) or
 *	    either zero or else two or more (FLAT). This instruction removes
 *	    everything from the stack except for the two names and pushes the
 *	    new value of the variable.
 *	(7) Finally, INST_STORE_* stores the new value in the variable and
 *	    cleans up the stack.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLsetCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
    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. */
{
    int tempDepth;		/* Depth used for emitting one part of the
				 * code burst. */
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the variable name. */
    int localIndex;		/* Index of var in local var table. */
    int simpleVarName;		/* Flag == 1 if var name is simple. */
    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
    int i;
    DefineLineInformation;	/* TIP #280 */

    /*
     * Check argument count.
     */

    if (parsePtr->numWords < 3) {
	/*
	 * Fail at run time, not in compilation.
	 */

	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
		    &localIndex, &simpleVarName, &isScalar, 1);

    /*
     * Push the "index" args and the new element value.
     */

    for (i=2 ; i<parsePtr->numWords ; ++i) {
	varTokenPtr = TokenAfter(varTokenPtr);
	CompileWord(envPtr, varTokenPtr, interp, i);
    }

    /*
     * Duplicate the variable name if it's been pushed.
     */

    if (!simpleVarName || localIndex < 0) {
	if (!simpleVarName || isScalar) {
	    tempDepth = parsePtr->numWords - 2;
	} else {
	    tempDepth = parsePtr->numWords - 1;
	}
	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
    }

    /*
     * Duplicate an array index if one's been pushed.
     */

    if (simpleVarName && !isScalar) {
	if (localIndex < 0) {
	    tempDepth = parsePtr->numWords - 1;
	} else {
	    tempDepth = parsePtr->numWords - 2;
	}
	TclEmitInstInt4(INST_OVER, tempDepth, envPtr);
    }

    /*
     * Emit code to load the variable's value.
     */
     * Data stores.

    if (!simpleVarName) {
	TclEmitOpcode(INST_LOAD_STK, envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_LOAD_SCALAR1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_SCALAR4, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_LOAD_ARRAY1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_ARRAY4, localIndex, envPtr);
	}
    }

    /*
     * Emit the correct variety of 'lset' instruction.
     */

    if (parsePtr->numWords == 4) {
	TclEmitOpcode(INST_LSET_LIST, envPtr);
    } else {
	TclEmitInstInt4(INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
    }

    /*
     * Emit code to put the value back in the variable.
     */

    if (!simpleVarName) {
	TclEmitOpcode(INST_STORE_STK, envPtr);
    } else if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_STORE_SCALAR_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(INST_STORE_ARRAY_STK, envPtr);
	} else if (localIndex < 0x100) {
	    TclEmitInstInt1(INST_STORE_ARRAY1, localIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_ARRAY4, localIndex, envPtr);
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileRegexpCmd --
 *
 *	Procedure called to compile the "regexp" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "regexp" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileRegexpCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
    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. */

    TclNewObj(objPtr);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewWideIntObj(infoPtr->firstValueTemp + i));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);

    /*
     * Loop counter.
{
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the RE or string. */
    int i, len, nocase, exact, sawLast, simple;
    char *str;
    DefineLineInformation;	/* TIP #280 */

    /*
     * We are only interested in compiling simple regexp cases. Currently
     * supported compile cases are:
     *   regexp ?-nocase? ?--? staticString $var
     *   regexp ?-nocase? ?--? {^staticString$} $var
     */

    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    simple = 0;
    nocase = 0;
    sawLast = 0;
    varTokenPtr = parsePtr->tokenPtr;

    /*
     * We only look for -nocase and -- as options. Everything else gets pushed
     * to runtime execution. This is different than regexp's runtime option
     * handling, but satisfies our stricter needs.
     */

    for (i = 1; i < parsePtr->numWords - 2; i++) {
	varTokenPtr = TokenAfter(varTokenPtr);
	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    /*
	     * Not a simple string, so punt to runtime.
	     */

	    return TCL_ERROR;
	}
	str = (char *) varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
	    sawLast++;
	    i++;
	    break;
	} else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) {
	    nocase = 1;
	} else {
	    /*
	     * Not an option we recognize.
	     */

	    return TCL_ERROR;
	}
    }

    if ((parsePtr->numWords - i) != 2) {
	/*
	 * We don't support capturing to variables.
	 */

	return TCL_ERROR;
    }

    /*
     * Get the regexp string. If it is not a simple string or can't be
     * converted to a glob pattern, push the word for the INST_REGEXP.
     * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp.
     */

    varTokenPtr = TokenAfter(varTokenPtr);

    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	Tcl_DString ds;

	str = (char *) varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	/*
	 * If it has a '-', it could be an incorrectly formed regexp command.
	 */

	if ((*str == '-') && !sawLast) {
	    return TCL_ERROR;
	}

	if (len == 0) {
	    /*
	     * The semantics of regexp are always match on re == "".
	     */

	    PushLiteral(envPtr, "1", 1);
	    return TCL_OK;
	}

	/*
	 * Attempt to convert pattern to glob.  If successful, push the
	 * converted pattern as a literal.
	 */

	if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
		== TCL_OK) {
	    simple = 1;
	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	}
    }

    if (!simple) {
	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
    }

    /*
     * Push the string arg.
     */

    varTokenPtr = TokenAfter(varTokenPtr);
    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);

    if (simple) {
	if (exact && !nocase) {
	    TclEmitOpcode(INST_STR_EQ, envPtr);
	} else {
	    TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
	}
    } else {
	/*
	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
	 * that handles all the flags we want to pass.
	 * Don't use TCL_REG_NOSUB as we may have backrefs.
	 */
	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
	TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileReturnCmd --
 *
 *	Procedure called to compile the "return" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "return" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileReturnCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * General syntax: [return ?-option value ...? ?result?]
     * An even number of words means an explicit result argument is present.
     */
    int level, code, objc, size, status = TCL_OK;
    int numWords = parsePtr->numWords;
    int explicitResult = (0 == (numWords % 2));
    int numOptionWords = numWords - 1 - explicitResult;
    Tcl_Obj *returnOpts, **objv;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    DefineLineInformation;	/* TIP #280 */

    /*
     * Check for special case which can always be compiled:
     *	    return -options <opts> <msg>
     * Unlike the normal [return] compilation, this version does everything at
     * runtime so it can handle arbitrary words and not just literals. Note
     * that if INST_RETURN_STK wasn't already needed for something else
     * ('finally' clause processing) this piece of code would not be present.
     */

    if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD)
	    && (wordTokenPtr[1].size == 8)
	    && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);

	CompileWord(envPtr, optsTokenPtr, interp, 2);
	CompileWord(envPtr, msgTokenPtr,  interp, 3);
	TclEmitOpcode(INST_RETURN_STK, envPtr);
	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

    objv = (Tcl_Obj **) TclStackAlloc(interp,
	    numOptionWords * sizeof(Tcl_Obj *));

    /*
     * Scan through the return options. If any are unknown at compile time,
     * there is no value in bytecompiling. Save the option values known in an
     * objv array for merging into a return options dictionary.
     */

    for (objc = 0; objc < numOptionWords; objc++) {
	objv[objc] = Tcl_NewObj();
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    objc++;
	    status = TCL_ERROR;
	    goto cleanup;
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    status = TclMergeReturnOptions(interp, objc, objv,
	    &returnOpts, &code, &level);
  cleanup:
    while (--objc >= 0) {
	TclDecrRefCount(objv[objc]);
    }
    TclStackFree(interp, objv);
    if (TCL_ERROR == status) {
	/*
	 * Something was bogus in the return options. Clear the error message,
	 * and report back to the compiler that this must be interpreted at
	 * runtime.
	 */

	Tcl_ResetResult(interp);
	return TCL_ERROR;
    }

    /*
     * All options are known at compile time, so we're going to bytecompile.
     * Emit instructions to push the result on the stack.
     */

    if (explicitResult) {
	 CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
    } else {
	/*
	 * No explict result argument, so default result is empty string.
	 */
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
	   Tcl_NewWideIntObj(infoPtr->loopCtTemp));

    /*
     * Assignment targets.

	PushLiteral(envPtr, "", 0);
    }

    /*
     * Check for optimization: When [return] is in a proc, and there's no
     * enclosing [catch], and there are no return options, then the INST_DONE
     * instruction is equivalent, and may be more efficient.
     */

    if (numOptionWords == 0 && envPtr->procPtr != NULL) {
	/*
	 * We have default return options and we're in a proc ...
	 */

	int index = envPtr->exceptArrayNext - 1;
	int enclosingCatch = 0;

	while (index >= 0) {
	    ExceptionRange range = envPtr->exceptArrayPtr[index];
	    if ((range.type == CATCH_EXCEPTION_RANGE)
		    && (range.catchOffset == -1)) {
		enclosingCatch = 1;
		break;
	    }
	    index--;
	}
	if (!enclosingCatch) {
	    /*
	     * ... and there is no enclosing catch. Issue the maximally
	     * efficient exit instruction.
	     */

	    Tcl_DecrRefCount(returnOpts);
	    TclEmitOpcode(INST_DONE, envPtr);
	    return TCL_OK;
	}
    }

    /* Optimize [return -level 0 $x]. */
    Tcl_DictObjSize(NULL, returnOpts, &size);
    if (size == 0 && level == 0 && code == TCL_OK) {
	Tcl_DecrRefCount(returnOpts);
	return TCL_OK;
    }

    /*
     * Could not use the optimization, so we push the return options dict, and
     * emit the INST_RETURN_IMM instruction with code and level as operands.
     */

    CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
    return TCL_OK;
}

static void
CompileReturnInternal(
    CompileEnv *envPtr,
    unsigned char op,
    int code,
    int level,
    Tcl_Obj *returnOpts)
{
    TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
    TclEmitInstInt4(op, code, envPtr);
    TclEmitInt4(level, envPtr);
}

void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    int numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);

    TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    Tcl_GetReturnOptions(interp, TCL_ERROR));
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSetCmd --
 *
 *	Procedure called to compile the "set" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "set" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSetCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isAssignment, isScalar, simpleVarName, localIndex, numWords;
    DefineLineInformation;	/* TIP #280 */

    numWords = parsePtr->numWords;
    if ((numWords != 2) && (numWords != 3)) {
	return TCL_ERROR;
    }
    isAssignment = (numWords == 3);

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
		    &localIndex, &simpleVarName, &isScalar, 1);

    /*
     * If we are doing an assignment, push the new value.
     */

    if (isAssignment) {
	valueTokenPtr = TokenAfter(varTokenPtr);
	CompileWord(envPtr, valueTokenPtr, interp, 2);
    }

    /*
     * Emit instructions to set/get the variable.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode((isAssignment?
			INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1((isAssignment?
			INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
			localIndex, envPtr);
	    } else {
		TclEmitInstInt4((isAssignment?
			INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
			localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode((isAssignment?
			INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1((isAssignment?
			INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
			localIndex, envPtr);
	    } else {
		TclEmitInstInt4((isAssignment?
			INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
			localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode((isAssignment? INST_STORE_STK : INST_LOAD_STK), envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileStringCmpCmd --
 *
 *	Procedure called to compile the simplest and most common form of the
 *	"string compare" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "string compare"
 *	command at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileStringCmpCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the test.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_CMP, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileStringEqualCmd --
 *
 *	Procedure called to compile the simplest and most common form of the
 *	"string equal" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "string equal" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileStringEqualCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the test.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_EQ, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileStringIndexCmd --
 *
 *	Procedure called to compile the simplest and most common form of the
 *	"string index" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "string index" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileStringIndexCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the index operation.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_INDEX, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileStringMatchCmd --
 *
 *	Procedure called to compile the simplest and most common form of the
 *	"string match" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "string match" command
 *	at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileStringMatchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int i, length, exactMatch = 0, nocase = 0;
    const char *str;

    if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Check if we have a -nocase flag.
     */

    if (parsePtr->numWords == 4) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	str = tokenPtr[1].start;
	length = tokenPtr[1].size;
	if ((length <= 1) || strncmp(str, "-nocase", (size_t) length)) {
	    /*
	     * Fail at run time, not in compilation.
	     */

	    return TCL_ERROR;
	}
	nocase = 1;
	tokenPtr = TokenAfter(tokenPtr);
    }

    /*
     * Push the strings to match against each other.
     */

    for (i = 0; i < 2; i++) {
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    str = tokenPtr[1].start;
	    length = tokenPtr[1].size;
	    if (!nocase && (i == 0)) {
		/*
		 * Trivial matches can be done by 'string equal'. If -nocase
		 * was specified, we can't do this because INST_STR_EQ has no
		 * support for nocase.
		 */

		Tcl_Obj *copy = Tcl_NewStringObj(str, length);
    TclNewObj(objPtr);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	TclNewObj(innerPtr);
	varsPtr = infoPtr->varLists[i];
	for (j=0 ; j<varsPtr->numVars ; j++) {
	    Tcl_ListObjAppendElement(NULL, innerPtr,
		    Tcl_NewWideIntObj(varsPtr->varIndexes[j]));
	}
	Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);

		Tcl_IncrRefCount(copy);
		exactMatch = TclMatchIsTrivial(TclGetString(copy));
		TclDecrRefCount(copy);
	    }
	    PushLiteral(envPtr, str, length);
	} else {
	    SetLineInformation (i+1+nocase);
	    CompileTokens(envPtr, tokenPtr, interp);
	}
	tokenPtr = TokenAfter(tokenPtr);
    }

    /*
     * Push the matcher.
     */

    if (exactMatch) {
	TclEmitOpcode(INST_STR_EQ, envPtr);
    } else {
	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileStringLenCmd --
 *
 *	Procedure called to compile the simplest and most common form of the
 *	"string length" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "string length"
 *	command at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileStringLenCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	/*
	 * Here someone is asking for the length of a static string. Just push
	 * the actual character (not byte) length.
	 */

	char buf[TCL_INTEGER_SPACE];
	int len = Tcl_NumUtfChars(tokenPtr[1].start, tokenPtr[1].size);

	len = sprintf(buf, "%d", len);
	PushLiteral(envPtr, buf, len);
    } else {
	SetLineInformation (1);
	CompileTokens(envPtr, tokenPtr, interp);
	TclEmitOpcode(INST_STR_LEN, envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSwitchCmd --
 *
 *	Procedure called to compile the "switch" command.
 *
 * Results:
 * 	Returns TCL_OK for successful compile, or TCL_ERROR to defer
 * 	evaluation to runtime (either when it is too complex to get the
 * 	semantics right, or when we know for sure that it is an error but need
 * 	the error to happen at the right time).
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "switch" command at
 *	runtime.
 *
 * FIXME:
 *	Stack depths are probably not calculated correctly.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSwitchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;	/* Pointer to tokens in command. */
    int numWords;		/* Number of words in command. */

    Tcl_Token *valueTokenPtr;	/* Token for the value to switch on. */
    enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
				/* What kind of switch are we doing? */

    Tcl_Token *bodyTokenArray;	/* Array of real pattern list items. */
    Tcl_Token **bodyToken;	/* Array of pointers to pattern list items. */
    int *bodyLines;		/* Array of line numbers for body list
				 * items. */
    int** bodyNext;
    int foundDefault;		/* Flag to indicate whether a "default" clause
				 * is present. */

    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
    int *fixupTargetArray;	/* Array of places for fixups to point at. */
    int fixupCount;		/* Number of places to fix up. */
    int contFixIndex;		/* Where the first of the jumps due to a group
				 * of continuation bodies starts, or -1 if
				 * there aren't any. */
    int contFixCount;		/* Number of continuation bodies pointing to
				 * the current (or next) real body. */

    int savedStackDepth = envPtr->currStackDepth;
    int noCase;			/* Has the -nocase flag been given? */
    int foundMode = 0;		/* Have we seen a mode flag yet? */
    int i, valueIndex;
    DefineLineInformation;	/* TIP #280 */
    int* clNext = envPtr->clNext;

    /*
     * Only handle the following versions:
     *   switch         ?--? word {pattern body ...}
     *   switch -exact  ?--? word {pattern body ...}
     *   switch -glob   ?--? word {pattern body ...}
     *   switch -regexp ?--? word {pattern body ...}
     *   switch         --   word simpleWordPattern simpleWordBody ...
     *   switch -exact  --   word simpleWordPattern simpleWordBody ...
     *   switch -glob   --   word simpleWordPattern simpleWordBody ...
     *   switch -regexp --   word simpleWordPattern simpleWordBody ...
     * When the mode is -glob, can also handle a -nocase flag.
     *
     * First off, we don't care how the command's word was generated; we're
     * compiling it anyway! So skip it...
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    valueIndex = 1;
    numWords = parsePtr->numWords-1;

    /*
static void
DisassembleNewForeachInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
{
    ForeachInfo *infoPtr = (ForeachInfo *)clientData;
    ForeachVarList *varsPtr;
    int i, j;
    Tcl_Obj *objPtr, *innerPtr;

    /*
     * Jump offset.
     * Check for options.
     */

    noCase = 0;
    mode = Switch_Exact;
    if (numWords == 2) {
	/*
	 * There's just the switch value and the bodies list. In that case, we
	 * can skip all option parsing and move on to consider switch values
	 * and the body list.
	 */

	goto finishedOptionParse;
    }

    /*
     * There must be at least one option, --, because without that there is no
     * way to statically avoid the problems you get from strings-to-be-matched
     * that start with a - (the interpreted code falls apart if it encounters
     * them, so we punt if we *might* encounter them as that is the easiest
     * way of emulating the behaviour).
     */

    for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
	register unsigned size = tokenPtr[1].size;
	register const char *chrs = tokenPtr[1].start;

	/*
	 * We only process literal options, and we assume that -e, -g and -n
	 * are unique prefixes of -exact, -glob and -nocase respectively (true
	 * at time of writing). Note that -exact and -glob may only be given
	 * at most once or we bail out (error case).
	 */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) {
	    return TCL_ERROR;
	}

	if ((size <= 6) && !memcmp(chrs, "-exact", size)) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Exact;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if ((size <= 5) && !memcmp(chrs, "-glob", size)) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Glob;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if ((size <= 7) && !memcmp(chrs, "-regexp", size)) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Regexp;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if ((size <= 7) && !memcmp(chrs, "-nocase", size)) {
	    noCase = 1;
	    valueIndex++;
	    continue;
	} else if ((size == 2) && !memcmp(chrs, "--", 2)) {
	    valueIndex++;
	    break;
	}

	/*
	 * The switch command has many flags we cannot compile at all (e.g.
	 * all the RE-related ones) which we must have encountered. Either
	 * that or we have run off the end. The action here is the same: punt
	 * to interpreted version.
	 */

	return TCL_ERROR;
    }
    if (numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(tokenPtr);
    numWords--;
    if (noCase && (mode == Switch_Exact)) {
	/*
	 * Can't compile this case; no opcode for case-insensitive equality!
	 */

	return TCL_ERROR;
    }

    /*
     * The value to test against is going to always get pushed on the stack.
     * But not yet; we need to verify that the rest of the command is
     * compilable too.
     */

  finishedOptionParse:
    valueTokenPtr = tokenPtr;
    /* For valueIndex, see previous loop. */
    tokenPtr = TokenAfter(tokenPtr);
    numWords--;

    /*
     * Build an array of tokens for the matcher terms and script bodies. Note
     * that in the case of the quoted bodies, this is tricky as we cannot use
     * copies of the string from the input token for the generated tokens (it
     * causes a crash during exception handling). When multiple tokens are
     * available at this point, this is pretty easy.
     */

    if (numWords == 1) {
	CONST char *bytes;
	int maxLen, numBytes;
	int bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	bytes = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;

	/* Allocate enough space to work in. */
	maxLen = TclMaxListLength(bytes, numBytes, NULL);
	if (maxLen < 2) {
	    return TCL_ERROR;
	}
	bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = (int *) ckalloc(sizeof(int) * maxLen);
	bodyNext  = (int **) ckalloc(sizeof(int*) * maxLen);

	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
	numWords = 0;

	while (numBytes > 0) {
	    CONST char *prevBytes = bytes;
	    int literal;

	    if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
		    &(bodyTokenArray[numWords].start), &bytes,
		    &(bodyTokenArray[numWords].size), &literal) || !literal) {
		goto abort;
	    }

	    bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
	    bodyTokenArray[numWords].numComponents = 0;
	    bodyToken[numWords] = bodyTokenArray + numWords;

	    /*
	     * TIP #280: Now determine the line the list element starts on
	     * (there is no need to do it earlier, due to the possibility of
	     * aborting, see above).
	     */

	    TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start);
	    TclAdvanceContinuations (&bline, &clNext,
		    bodyTokenArray[numWords].start - envPtr->source);
	    bodyLines[numWords] = bline;
	    bodyNext[numWords] = clNext;
	    TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
	    TclAdvanceContinuations (&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    ckfree((char *) bodyToken);
	    ckfree((char *) bodyTokenArray);
	    ckfree((char *) bodyLines);
	    ckfree((char *) bodyNext);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably
	 * should get caught earlier, but it's easy to check here again anyway
	 * because it'd cause a nasty crash otherwise.
	 */

	return TCL_ERROR;
    } else {
	/*
	 * Multi-word definition of patterns & actions.
	 */

	bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = (int *) ckalloc(sizeof(int) * numWords);
	bodyNext  = (int **) ckalloc(sizeof(int*) * numWords);
	bodyTokenArray = NULL;
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to
	     * traces, etc.
	     */

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		ckfree((char *) bodyToken);
		ckfree((char *) bodyLines);
		ckfree((char *) bodyNext);
		return TCL_ERROR;
	    }
	    bodyToken[i] = tokenPtr+1;

	    /*
	     * TIP #280: Copy line information from regular cmd info.
	     */

	    bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
	    bodyNext[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
	    tokenPtr = TokenAfter(tokenPtr);
	}
    }

    /*
     * Fall back to interpreted if the last body is a continuation (it's
     * illegal, but this makes the error happen at the right time).
     */

    if (bodyToken[numWords-1]->size == 1 &&
	    bodyToken[numWords-1]->start[0] == '-') {
	ckfree((char *) bodyToken);
	ckfree((char *) bodyLines);
	ckfree((char *) bodyNext);
	if (bodyTokenArray != NULL) {
	    ckfree((char *) bodyTokenArray);
	}
	return TCL_ERROR;
    }

    /*
     * Now we commit to generating code; the parsing stage per se is done.
     * First, we push the value we're matching against on the stack.
     */

    SetLineInformation (valueIndex);
    CompileTokens(envPtr, valueTokenPtr, interp);
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
	   Tcl_NewWideIntObj(infoPtr->loopCtTemp));

    /*
     * Check if we can generate a jump table, since if so that's faster than
     * doing an explicit compare with each body. Note that we're definitely
     * over-conservative with determining whether we can do the jump table,
     * but it handles the most common case well enough.
     */

    if (mode == Switch_Exact) {
	JumptableInfo *jtPtr;
	int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
	int mustGenerate, jumpToDefault;
	Tcl_DString buffer;
	Tcl_HashEntry *hPtr;

    /*
     * Assignment targets.
     */

    TclNewObj(objPtr);
    for (i=0 ; i<infoPtr->numLists ; i++) {
	TclNewObj(innerPtr);
	varsPtr = infoPtr->varLists[i];
	for (j=0 ; j<varsPtr->numVars ; j++) {
	    Tcl_ListObjAppendElement(NULL, innerPtr,
		    Tcl_NewWideIntObj(varsPtr->varIndexes[j]));
	}
	Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
	/*
	 * Compile the switch by using a jump table, which is basically a
	 * hashtable that maps from literal values to match against to the
	 * offset (relative to the INST_JUMP_TABLE instruction) to jump to.
	 * The jump table itself is independent of any invokation of the
	 * bytecode, and as such is stored in an auxData block.
	 *
	 * Start by allocating the jump table itself, plus some workspace.
	 */

	jtPtr = (JumptableInfo *) ckalloc(sizeof(JumptableInfo));
	Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
	infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
	finalFixups = (int *) ckalloc(sizeof(int) * (numWords/2));
	foundDefault = 0;
	mustGenerate = 1;

	/*
	 * Next, issue the instruction to do the jump, together with what we
	 * want to do if things do not work out (jump to either the default
	 * clause or the "default" default, which just sets the result to
	 * empty). Note that we will come back and rewrite the jump's offset
	 * parameter when we know what it should be, and that all jumps we
	 * issue are of the wide kind because that makes the code much easier
	 * to debug!
	 */

	jumpLocation = CurrentOffset(envPtr);
	TclEmitInstInt4(INST_JUMP_TABLE, infoIndex, envPtr);
	jumpToDefault = CurrentOffset(envPtr);
	TclEmitInstInt4(INST_JUMP4, 0, envPtr);

	for (i=0 ; i<numWords ; i+=2) {
	    /*
	     * For each arm, we must first work out what to do with the match
	     * term.
	     */

	    if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
		    memcmp(bodyToken[numWords-2]->start, "default", 7)) {
		/*
		 * This is not a default clause, so insert the current
		 * location as a target in the jump table (assuming it isn't
		 * already there, which would indicate that this clause is
		 * probably masked by an earlier one). Note that we use a
		 * Tcl_DString here simply because the hash API does not let
		 * us specify the string length.
		 */

		Tcl_DStringInit(&buffer);
		Tcl_DStringAppend(&buffer, bodyToken[i]->start,
			bodyToken[i]->size);
		hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
			Tcl_DStringValue(&buffer), &isNew);
		if (isNew) {
		    /*
		     * First time we've encountered this match clause, so it
		     * must point to here.
		     */

		    Tcl_SetHashValue(hPtr, (ClientData)
			    (CurrentOffset(envPtr) - jumpLocation));
		}
		Tcl_DStringFree(&buffer);
	    } else {
		/*
		 * This is a default clause, so patch up the fallthrough from
		 * the INST_JUMP_TABLE instruction to here.
		 */

		foundDefault = 1;
		isNew = 1;
		TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
			envPtr->codeStart+jumpToDefault+1);
	    }

	    /*
	     * Now, for each arm we must deal with the body of the clause.
	     *
	     * If this is a continuation body (never true of a final clause,
	     * whether default or not) we're done because the next jump target
	     * will also point here, so we advance to the next clause.
	     */

	    if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') {
		mustGenerate = 1;
		continue;
	    }

	    /*
	     * Also skip this arm if its only match clause is masked. (We
	     * could probably be more aggressive about this, but that would be
	     * much more difficult to get right.)
	     */

	    if (!isNew && !mustGenerate) {
		continue;
	    }
	    mustGenerate = 0;

	    /*
	     * Compile the body of the arm.
	     */

	    envPtr->line = bodyLines[i+1];	/* TIP #280 */
	    envPtr->clNext = bodyNext[i+1];	/* TIP #280 */
	    TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);

	    /*
	     * Compile a jump in to the end of the command if this body is
	     * anything other than a user-supplied default arm (to either skip
	     * over the remaining bodies or the code that generates an empty
	     * result).
	     */

	    if (i+2 < numWords || !foundDefault) {
		finalFixups[numRealBodies++] = CurrentOffset(envPtr);

		/*
		 * Easier by far to issue this jump as a fixed-width jump.
		 * Otherwise we'd need to do a lot more (and more awkward)
		 * rewriting when we fixed this all up.
		 */

		TclEmitInstInt4(INST_JUMP4, 0, envPtr);
	    }
	}

	/*
	 * We're at the end. If we've not already done so through the
	 * processing of a user-supplied default clause, add in a "default"
	 * default clause now.
	 */

	if (!foundDefault) {
	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
		    envPtr->codeStart+jumpToDefault+1);
	    PushLiteral(envPtr, "", 0);
	}

	/*
	 * No more instructions to be issued; everything that needs to jump to
	 * the end of the command is fixed up at this point.
	 */

	for (i=0 ; i<numRealBodies ; i++) {
	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i],
		    envPtr->codeStart+finalFixups[i]+1);
	}

	/*
	 * Clean up all our temporary space and return.
	 */

	ckfree((char *) finalFixups);
	ckfree((char *) bodyToken);
	ckfree((char *) bodyLines);
	ckfree((char *) bodyNext);
	if (bodyTokenArray != NULL) {
	    ckfree((char *) bodyTokenArray);
	}
	return TCL_OK;
    }

    /*
     * Generate a test for each arm.
     */

    contFixIndex = -1;
    contFixCount = 0;
    fixupArray = (JumpFixup *) ckalloc(sizeof(JumpFixup) * numWords);
    fixupTargetArray = (int *) ckalloc(sizeof(int) * numWords);
    memset(fixupTargetArray, 0, numWords * sizeof(int));
    fixupCount = 0;
    foundDefault = 0;
    for (i=0 ; i<numWords ; i+=2) {
	int nextArmFixupIndex = -1;

	envPtr->currStackDepth = savedStackDepth + 1;
	if (i!=numWords-2 || bodyToken[numWords-2]->size != 7 ||
		memcmp(bodyToken[numWords-2]->start, "default", 7)) {
	    /*
	     * Generate the test for the arm.
	     */

	    switch (mode) {
	    case Switch_Exact:
		TclEmitOpcode(INST_DUP, envPtr);
		TclCompileTokens(interp, bodyToken[i], 1, envPtr);
		TclEmitOpcode(INST_STR_EQ, envPtr);
		break;
	    case Switch_Glob:
		TclCompileTokens(interp, bodyToken[i], 1, envPtr);
		TclEmitInstInt4(INST_OVER, 1, envPtr);
		TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
		break;
	    case Switch_Regexp: {
		int simple = 0, exact = 0;

		/*
		 * Keep in sync with TclCompileRegexpCmd.
		 */

		if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
		    Tcl_DString ds;

		    if (bodyToken[i]->size == 0) {
			/*
			 * The semantics of regexps are that they always match
			 * when the RE == "".
			 */

			PushLiteral(envPtr, "1", 1);
			break;
		    }

		    /*
		     * Attempt to convert pattern to glob. If successful, push
		     * the converted pattern.
		     */

		    if (TclReToGlob(NULL, bodyToken[i]->start,
			    bodyToken[i]->size, &ds, &exact) == TCL_OK) {
			simple = 1;
			PushLiteral(envPtr, Tcl_DStringValue(&ds),
				Tcl_DStringLength(&ds));
			Tcl_DStringFree(&ds);
		    }
		}
		if (!simple) {
		    TclCompileTokens(interp, bodyToken[i], 1, envPtr);
		}

		TclEmitInstInt4(INST_OVER, 1, envPtr);
		if (simple) {
		    if (exact && !noCase) {
			TclEmitOpcode(INST_STR_EQ, envPtr);
		    } else {
			TclEmitInstInt1(INST_STR_MATCH, noCase, envPtr);
		    }
		} else {
		    /*
		     * Pass correct RE compile flags. We use only Int1
		     * (8-bit), but that handles all the flags we want to
		     * pass. Don't use TCL_REG_NOSUB as we may have backrefs
		     * or capture vars.
		     */

		    int cflags = TCL_REG_ADVANCED
			    | (noCase ? TCL_REG_NOCASE : 0);

		    TclEmitInstInt1(INST_REGEXP, cflags, envPtr);
		}
		break;
	    }
	    default:
		Tcl_Panic("unknown switch mode: %d", mode);
	    }

	    /*
	     * In a fall-through case, we will jump on _true_ to the place
	     * where the body starts (generated later, with guarantee of this
	     * ensured earlier; the final body is never a fall-through).
	     */

	    if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') {
		if (contFixIndex == -1) {
		    contFixIndex = fixupCount;
		    contFixCount = 0;
		}
		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
			fixupArray+contFixIndex+contFixCount);
		fixupCount++;
		contFixCount++;
		continue;
	    }

	    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, fixupArray+fixupCount);
	    nextArmFixupIndex = fixupCount;
	    fixupCount++;
	} else {
	    /*
	     * Got a default clause; set a flag to inhibit the generation of
	     * the jump after the body and the cleanup of the intermediate
	     * value that we are switching against.
	     *
	     * Note that default clauses (which are always terminal clauses)
	     * cannot be fall-through clauses as well, since the last clause
	     * is never a fall-through clause (which we have already
	     * verified).
	     */

	    foundDefault = 1;
	}

	/*
	 * Generate the body for the arm. This is guaranteed not to be a
	 * fall-through case, but it might have preceding fall-through cases,
	 * so we must process those first.
	 */

	if (contFixIndex != -1) {
	    int j;

	    for (j=0 ; j<contFixCount ; j++) {
		fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr);
	    }
	    contFixIndex = -1;
	}

	/*
	 * Now do the actual compilation. Note that we do not use CompileBody
	 * because we may have synthesized the tokens in a non-standard
	 * pattern.
	 */

	TclEmitOpcode(INST_POP, envPtr);
	envPtr->currStackDepth = savedStackDepth + 1;
	envPtr->line = bodyLines[i+1];		/* TIP #280 */
	envPtr->clNext = bodyNext[i+1];		/* TIP #280 */
	TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);

	if (!foundDefault) {
	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
		    fixupArray+fixupCount);
	    fixupCount++;
	    fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr);
	}
    }

    /*
     * Clean up all our temporary space and return.
     */

    ckfree((char *) bodyToken);
    ckfree((char *) bodyLines);
    ckfree((char *) bodyNext);
    if (bodyTokenArray != NULL) {
	ckfree((char *) bodyTokenArray);
    }

    /*
     * Discard the value we are matching against unless we've had a default
     * clause (in which case it will already be gone due to the code at the
     * start of processing an arm, guaranteed) and make the result of the
     * command an empty string.
     */

    if (!foundDefault) {
	TclEmitOpcode(INST_POP, envPtr);
	PushLiteral(envPtr, "", 0);
    }

    /*
     * Do jump fixups for arms that were executed. First, fill in the jumps of
     * all jumps that don't point elsewhere to point to here.
     */

    for (i=0 ; i<fixupCount ; i++) {
	if (fixupTargetArray[i] == 0) {
	    fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart;
	}
    }

    /*
     * Now scan backwards over all the jumps (all of which are forward jumps)
     * doing each one. When we do one and there is a size changes, we must
     * scan back over all the previous ones and see if they need adjusting
     * before proceeding with further jump fixups (the interleaved nature of
     * all the jumps makes this impossible to do without nested loops).
     */

    for (i=fixupCount-1 ; i>=0 ; i--) {
	if (TclFixupForwardJump(envPtr, &fixupArray[i],
		fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) {
	    int j;

	    for (j=i-1 ; j>=0 ; j--) {
		if (fixupTargetArray[j] > fixupArray[i].codeOffset) {
		    fixupTargetArray[j] += 3;
		}
	    }
	}
    }
    ckfree((char *) fixupArray);
    ckfree((char *) fixupTargetArray);

    envPtr->currStackDepth = savedStackDepth + 1;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DupJumptableInfo, FreeJumptableInfo --
 *
 *	Functions to duplicate, release and print a jump-table created for use
 *	with the INST_JUMP_TABLE instruction.
 *
 * Results:
 *	DupJumptableInfo: a copy of the jump-table
 *	FreeJumptableInfo: none
 *	PrintJumptableInfo: none
 *
 * Side effects:
 *	DupJumptableInfo: allocates memory
 *	FreeJumptableInfo: releases memory
 *	PrintJumptableInfo: none
 *
 *----------------------------------------------------------------------
 */

static ClientData
DupJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;
    JumptableInfo *newJtPtr = (JumptableInfo *)
	    ckalloc(sizeof(JumptableInfo));
    Tcl_HashEntry *hPtr, *newHPtr;
    Tcl_HashSearch search;
    int isNew;

    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    while (hPtr != NULL) {
	newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
		Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
	Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
    }
    return newJtPtr;
}

static void
FreeJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = clientData;

    Tcl_DeleteHashTable(&jtPtr->hashTable);
    ckfree((char *) jtPtr);
}

static void
PrintJumptableInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    ByteCode *codePtr,
    unsigned int pcOffset)
{
    register JumptableInfo *jtPtr = clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    const char *keyPtr;
    int offset, i = 0;

    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	offset = PTR2INT(Tcl_GetHashValue(hPtr));

	if (i++) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	    if (i%4==0) {
		Tcl_AppendToObj(appendObj, "\n\t\t", -1);
	    }
	}
	Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
		keyPtr, pcOffset + offset);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileFormatCmd --
 * TclCompileWhileCmd --
 *
 *	Procedure called to compile the "format" command. Handles cases that
 *	Procedure called to compile the "while" command.
 *	can be done as constants or simple string concatenation only.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "format" command at
 *	Instructions are added to envPtr to execute the "while" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileFormatCmd(
TclCompileWhileCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Obj **objv, *formatObj, *tmpObj;
    const char *bytes, *start;
    int i, j;
    Tcl_Token *testTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
    int savedStackDepth = envPtr->currStackDepth;
    size_t len;

    /*
    int loopMayEnd = 1;		/* This is set to 0 if it is recognized as an
				 * infinite loop. */
     * Don't handle any guaranteed-error cases.
     */

    Tcl_Obj *boolObj;
    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
    }

    DefineLineInformation;	/* TIP #280 */
    /*
     * Check if the argument words are all compile-time-known literals; that's
     * a case we can handle by compiling to a constant.
     */

    TclNewObj(formatObj);
    Tcl_IncrRefCount(formatObj);
    tokenPtr = TokenAfter(tokenPtr);
    if (parsePtr->numWords != 3) {
    if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

    /*
     * If the test expression requires substitutions, don't compile the while
     * command inline. E.g., the expression might cause the loop to never
     * execute or execute forever, as in "while "$x < 5" {}".
     *
     * Bail out also if the body expression requires substitutions in order to
     * insure correct behaviour [Bug 219166]
     */
    objv = (Tcl_Obj **)Tcl_Alloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *));
    for (i=0 ; i+2 < parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);

    testTokenPtr = TokenAfter(parsePtr->tokenPtr);
    bodyTokenPtr = TokenAfter(testTokenPtr);
	TclNewObj(objv[i]);
	Tcl_IncrRefCount(objv[i]);
	if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) {
	    goto checkForStringConcatCase;
	}

    if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
	return TCL_ERROR;
    }

    /*
     * Everything is a literal, so the result is constant too (or an error if

     * the format is broken). Do the format now.
    /*
     * Find out if the condition is a constant.
     */

    tmpObj = Tcl_Format(interp, TclGetString(formatObj),
    boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
	    parsePtr->numWords-2, objv);
    for (; --i>=0 ;) {
	Tcl_DecrRefCount(objv[i]);
    Tcl_IncrRefCount(boolObj);
    }
    Tcl_Free(objv);
    Tcl_DecrRefCount(formatObj);
    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
    TclDecrRefCount(boolObj);
    if (tmpObj == NULL) {
	TclCompileSyntaxError(interp, envPtr);
	return TCL_OK;
    if (code == TCL_OK) {
    }

    /*
	if (boolVal) {
	    /*
     * Not an error, always a constant result, so just push the result as a
     * literal. Job done.
     */
	     * It is an infinite loop; flag it so that we generate a more
	     * efficient body.
	     */

    bytes = TclGetStringFromObj(tmpObj, &len);
    PushLiteral(envPtr, bytes, len);
    Tcl_DecrRefCount(tmpObj);
    return TCL_OK;

  checkForStringConcatCase:
	    loopMayEnd = 0;
	} else {
	    /*
	     * This is an empty loop: "while 0 {...}" or such. Compile no
	     * bytecodes.
	     */

	    goto pushResult;
	}
    }

    /*
     * See if we can generate a sequence of things to concatenate. This
     * requires that all the % sequences be %s or %%, as everything else is
     * sufficiently complex that we don't bother.
     * Create a ExceptionRange record for the loop body. This is used to
     * implement break and continue.
     *
     * First, get the state of the system relatively sensible (cleaning up
     * after our attempt to spot a literal).
     */

    for (; i>=0 ; i--) {
	Tcl_DecrRefCount(objv[i]);
    }
    range = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);

    Tcl_Free(objv);
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    tokenPtr = TokenAfter(tokenPtr);
    i = 0;

    /*
     * Now scan through and check for non-%s and non-%% substitutions.
     */

    for (bytes = TclGetString(formatObj) ; *bytes ; bytes++) {
	if (*bytes == '%') {
	    bytes++;
	    if (*bytes == 's') {
     * Jump to the evaluation of the condition. This code uses the "loop
     * rotation" optimisation (which eliminates one branch from the loop).
     * "while cond body" produces then:
     *       goto A
     *    B: body                : bodyCodeOffset
     *    A: cond -> result      : testCodeOffset, continueOffset
     *       if (result) goto B
     *
     * The infinite loop "while 1 body" produces:
     *    B: body                : all three offsets here
     *       goto B
     */
		i++;
		continue;
	    } else if (*bytes == '%') {
		continue;
	    }

	    Tcl_DecrRefCount(formatObj);
	    return TCL_ERROR;
    if (loopMayEnd) {
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup);
	}
    }

    /*
	testCodeOffset = 0;	/* Avoid compiler warning. */
    } else {
	/*
     * Check if the number of things to concatenate will fit in a byte.
     */
	 * Make sure that the first command in the body is preceded by an
	 * INST_START_CMD, and hence counted properly. [Bug 1752146]
	 */

    if (i+2 != parsePtr->numWords || i > 125) {
	Tcl_DecrRefCount(formatObj);
	return TCL_ERROR;
    }

	envPtr->atCmdStart = 0;
	testCodeOffset = CurrentOffset(envPtr);
    }

    /*
     * Generate the pushes of the things to concatenate, a sequence of
     * Compile the loop body.
     * literals and compiled tokens (of which at least one is non-literal or
     * we'd have the case in the first half of this function) which we will
     * concatenate.
     */

    i = 0;			/* The count of things to concat. */
    j = 2;			/* The index into the argument tokens, for
				 * TIP#280 handling. */
    start = TclGetString(formatObj);
				/* The start of the currently-scanned literal
    SetLineInformation (2);
    bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
    CompileBody(envPtr, bodyTokenPtr, interp);
    ExceptionRangeEnds(envPtr, range);
				 * in the format string. */
    TclNewObj(tmpObj);	/* The buffer used to accumulate the literal
				 * being built. */
    for (bytes = start ; *bytes ; bytes++) {
    envPtr->currStackDepth = savedStackDepth + 1;
	if (*bytes == '%') {
	    Tcl_AppendToObj(tmpObj, start, bytes - start);
	    if (*++bytes == '%') {
		Tcl_AppendToObj(tmpObj, "%", 1);
	    } else {
    TclEmitOpcode(INST_POP, envPtr);
		const char *b = TclGetStringFromObj(tmpObj, &len);

		/*
		 * If there is a non-empty literal from the format string,
		 * push it and reset.
		 */
    /*
     * Compile the test expression then emit the conditional jump that
     * terminates the while. We already know it's a simple word.
     */

		if (len > 0) {
		    PushLiteral(envPtr, b, len);
		    Tcl_DecrRefCount(tmpObj);
		    TclNewObj(tmpObj);
		    i++;
		}

    if (loopMayEnd) {
	testCodeOffset = CurrentOffset(envPtr);
	jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
	if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
	    bodyCodeOffset += 3;
	    testCodeOffset += 3;
	}
	envPtr->currStackDepth = savedStackDepth;
		/*
		 * Push the code to produce the string that would be
	SetLineInformation (1);
		 * substituted with %s, except we'll be concatenating
		 * directly.
		 */

		CompileWord(envPtr, tokenPtr, interp, j);
	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
	envPtr->currStackDepth = savedStackDepth + 1;
		tokenPtr = TokenAfter(tokenPtr);
		j++;
		i++;
	    }
	    start = bytes + 1;
	}
    }


	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
	if (jumpDist > 127) {
	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
	} else {
	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
	}
    } else {
	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
	if (jumpDist > 127) {
	    TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
	} else {
	    TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
	}
    }

    /*
     * Handle the case of a trailing literal.
     * Set the loop's body, continue and break offsets.
     */

    Tcl_AppendToObj(tmpObj, start, bytes - start);
    bytes = TclGetStringFromObj(tmpObj, &len);
    if (len > 0) {
	PushLiteral(envPtr, bytes, len);
    envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
    envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
    ExceptionRangeTarget(envPtr, range, breakOffset);
	i++;
    }

    Tcl_DecrRefCount(tmpObj);
    Tcl_DecrRefCount(formatObj);

    if (i > 1) {
	/*
	 * Do the concatenation, which produces the result.
	 */
    /*
     * The while command's result is an empty string.
     */

  pushResult:
	TclEmitInstInt1(INST_STR_CONCAT1, i, envPtr);
    envPtr->currStackDepth = savedStackDepth;
    }
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLocalScalarFromToken --
 * LocalScalar(FromToken) --
 *
 *	Get the index into the table of compiled locals that corresponds
 *	to a local scalar variable name.
 *
 * Results:
 * 	Returns the non-negative integer index value into the table of
 * 	compiled locals corresponding to a local scalar variable name.
 * 	If the arguments passed in do not identify a local scalar variable
 * 	then return -1.
 *	compiled locals corresponding to a local scalar variable name.
 *	If the arguments passed in do not identify a local scalar variable
 *	then return -1.
 *
 * Side effects:
 *	May add an entery into the table of compiled locals.
 *	May add an entry into the table of compiled locals.
 *
 *----------------------------------------------------------------------
 */

int
TclLocalScalarFromToken(
static int
LocalScalarFromToken(
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)
{
    int isScalar, index;
    int isSimple, isScalar, index;

    TclPushVarName(NULL, tokenPtr, envPtr, TCL_NO_ELEMENT, &index, &isScalar);
    PushVarName(NULL, tokenPtr, envPtr, TCL_CREATE_VAR, &index,
	    &isSimple, &isScalar, 0 /* ignored */, NULL /* ignored */);
    if (!isScalar) {
	index = -1;
    }
    return index;
}

int
TclLocalScalar(
static int
LocalScalar(
    const char *bytes,
    size_t numBytes,
    int numBytes,
    CompileEnv *envPtr)
{
    Tcl_Token token[2] =        {{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
                                 {TCL_TOKEN_TEXT, NULL, 0, 0}};
    Tcl_Token token[2] =	{{TCL_TOKEN_SIMPLE_WORD, NULL, 0, 1},
				 {TCL_TOKEN_TEXT, NULL, 0, 0}};

    token[1].start = bytes;
    token[1].size = numBytes;
    return TclLocalScalarFromToken(token, envPtr);
    return LocalScalarFromToken(token, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPushVarName --
 * PushVarName --
 *
 *	Procedure used in the compiling where pushing a variable name is
 *	necessary (append, lappend, set).
 *
 * Results:
 *	The values written to *localIndexPtr and *isScalarPtr signal to
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	the caller what the instructions emitted by this routine will do:
 *
 *	*isScalarPtr	(*localIndexPtr < 0)
 *	1		1	Push the varname on the stack. (Stack +1)
 *	1		0	*localIndexPtr is the index of the compiled
 *				local for this varname.  No instructions
 *				emitted.	(Stack +0)
 *	0		1	Push part1 and part2 names of array element
 *				on the stack.	(Stack +2)
 * 	evaluation to runtime.
 *	0		0	*localIndexPtr is the index of the compiled
 *				local for this array.  Element name is pushed
 *				on the stack.	(Stack +1)
 *
 * Side effects:
 *	Instructions are added to envPtr.
 *	Instructions are added to envPtr to execute the "set" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

void
TclPushVarName(
static int
PushVarName(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Token *varTokenPtr,	/* Points to a variable token. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int flags,			/* TCL_NO_LARGE_INDEX | TCL_NO_ELEMENT. */
    int flags,			/* TCL_CREATE_VAR or TCL_NO_LARGE_INDEX. */
    int *localIndexPtr,		/* Must not be NULL. */
    int *simpleVarNamePtr,	/* Must not be NULL. */
    int *isScalarPtr)		/* Must not be NULL. */
    int *isScalarPtr,		/* Must not be NULL. */
    int line,                   /* Line the token starts on. */
    int* clNext)                /* Reference to offset of next hidden cont. line */
{
    const char *p;
    const char *last, *name, *elName;
    size_t n;
    register const char *p;
    const char *name, *elName;
    register int i, n;
    Tcl_Token *elemTokenPtr = NULL;
	size_t nameLen, elNameLen;
    int simpleVarName, localIndex;
    int nameChars, elNameChars, simpleVarName, localIndex;
    int elemTokenCount = 0, allocedTokens = 0, removedParen = 0;

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    simpleVarName = 0;
    name = elName = NULL;
    nameLen = elNameLen = 0;
    nameChars = elNameChars = 0;
    localIndex = -1;

    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	/*
	 * A simple variable name. Divide it up into "name" and "elName"
	 * strings. If it is not a local variable, look it up at runtime.
	 */

	simpleVarName = 1;

	name = varTokenPtr[1].start;
	nameLen = varTokenPtr[1].size;
	if (name[nameLen-1] == ')') {
	nameChars = varTokenPtr[1].size;
	if (name[nameChars-1] == ')') {
	    /*
	     * last char is ')' => potential array reference.
	     */
	    last = &name[nameLen-1];

	    if (*last == ')') {
		for (p = name;  p < last;  p++) {
		    if (*p == '(') {
			elName = p + 1;
			elNameLen = last - elName;
			nameLen = p - name;
			break;
	    for (i=0,p=name ; i<nameChars ; i++,p++) {
		if (*p == '(') {
		    elName = p + 1;
		    elNameChars = nameChars - i - 2;
		    nameChars = i;
		    break;
		    }
		}
	    }

	    if (!(flags & TCL_NO_ELEMENT) && elNameLen) {
	    if (interp && (elName != NULL) && elNameChars) {
		/*
		 * An array element, the element name is a simple string:
		 * assemble the corresponding token.
		 */

		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, sizeof(Tcl_Token));
		elemTokenPtr = (Tcl_Token *) TclStackAlloc(interp,
			sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = elNameLen;
		elemTokenPtr->size = elNameChars;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = 1;
	    }
	}
    } else if (interp && ((n = varTokenPtr->numComponents) > 1)
	    && (varTokenPtr[1].type == TCL_TOKEN_TEXT)
	    && (varTokenPtr[n].type == TCL_TOKEN_TEXT)
	    && (*(varTokenPtr[n].start + varTokenPtr[n].size - 1) == ')')) {
	    && (varTokenPtr[n].start[varTokenPtr[n].size - 1] == ')')) {

	/*
	 * Check for parentheses inside first token.
	 */

	simpleVarName = 0;
	for (p = varTokenPtr[1].start,
	     last = p + varTokenPtr[1].size;  p < last;  p++) {
	for (i = 0, p = varTokenPtr[1].start;
		i < varTokenPtr[1].size; i++, p++) {
	    if (*p == '(') {
		simpleVarName = 1;
		break;
	    }
	}
	if (simpleVarName) {
	    size_t remainingLen;
	    int remainingChars;

	    /*
	     * Check the last token: if it is just ')', do not count it.
	     * Otherwise, remove the ')' and flag so that it is restored at
	     * the end.
	     */

	    if (varTokenPtr[n].size == 1) {
		n--;
		--n;
	    } else {
		varTokenPtr[n].size--;
		--varTokenPtr[n].size;
		removedParen = n;
	    }

	    name = varTokenPtr[1].start;
	    nameLen = p - varTokenPtr[1].start;
	    nameChars = p - varTokenPtr[1].start;
	    elName = p + 1;
	    remainingLen = (varTokenPtr[2].start - p) - 1;
	    elNameLen = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;
	    remainingChars = (varTokenPtr[2].start - p) - 1;
	    elNameChars = (varTokenPtr[n].start-p) + varTokenPtr[n].size - 1;

	    if (!(flags & TCL_NO_ELEMENT)) {
	      if (remainingLen) {
	    if (remainingChars) {
		/*
		 * Make a first token with the extra characters in the first
		 * token.
		 */

		elemTokenPtr = (Tcl_Token *)TclStackAlloc(interp, n * sizeof(Tcl_Token));
		elemTokenPtr = (Tcl_Token *) TclStackAlloc(interp,
			n * sizeof(Tcl_Token));
		allocedTokens = 1;
		elemTokenPtr->type = TCL_TOKEN_TEXT;
		elemTokenPtr->start = elName;
		elemTokenPtr->size = remainingLen;
		elemTokenPtr->size = remainingChars;
		elemTokenPtr->numComponents = 0;
		elemTokenCount = n;

		/*
		 * Copy the remaining tokens.
		 */

		memcpy(elemTokenPtr+1, varTokenPtr+2,
			(n-1) * sizeof(Tcl_Token));
	      } else {
	    } else {
		/*
		 * Use the already available tokens.
		 */

		elemTokenPtr = &varTokenPtr[2];
		elemTokenCount = n - 1;
	      }
	    }
	}
    }

    if (simpleVarName) {
	/*
	 * See whether name has any namespace separators (::'s).
	 */

	int hasNsQualifiers = 0;

	for (i = 0, p = name;  i < nameChars;  i++, p++) {
	for (p = name, last = p + nameLen-1;  p < last;  p++) {
	    if ((*p == ':') && (*(p+1) == ':')) {
	    if ((*p == ':') && ((i+1) < nameChars) && (*(p+1) == ':')) {
		hasNsQualifiers = 1;
		break;
	    }
	}

	/*
	 * Look up the var name's index in the array of local vars in the proc
	 * frame. If retrieving the var's value and it doesn't already exist,
	 * push its name and look it up at runtime.
	 */

	if (!hasNsQualifiers) {
	    localIndex = TclFindCompiledLocal(name, nameLen, 1, envPtr);
	if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
	    localIndex = TclFindCompiledLocal(name, nameChars,
		    /*create*/ flags & TCL_CREATE_VAR,
		    envPtr->procPtr);
	    if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
		/*
		 * We'll push the name.
		 */

		localIndex = -1;
	    }
	}
	if (interp && localIndex < 0) {
	    PushLiteral(envPtr, name, nameLen);
	    PushLiteral(envPtr, name, nameChars);
	}

	/*
	 * Compile the element script, if any, and only if not inhibited. [Bug
	 * Compile the element script, if any.
	 * 3600328]
	 */

	if (elName != NULL && !(flags & TCL_NO_ELEMENT)) {
	    if (elNameLen) {
		TclCompileTokens(interp, elemTokenPtr, elemTokenCount,
	if (interp && elName != NULL) {
	    if (elNameChars) {
		envPtr->line = line;
		envPtr->clNext = clNext;
		TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr);
			envPtr);
	    } else {
		PushStringLiteral(envPtr, "");
		PushLiteral(envPtr, "", 0);
	    }
	}
    } else if (interp) {
	/*
	 * The var name isn't simple: compile and push it.
	 */

	envPtr->line = line;
	envPtr->clNext = clNext;
	CompileTokens(envPtr, varTokenPtr, interp);
    }

    if (removedParen) {
	varTokenPtr[removedParen].size++;
	++varTokenPtr[removedParen].size;
    }
    if (allocedTokens) {
	TclStackFree(interp, elemTokenPtr);
    }
    *localIndexPtr = localIndex;
    *simpleVarNamePtr = simpleVarName;
    *isScalarPtr = (elName == NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileUnaryOpCmd --
 *
 *	Utility routine to compile the unary operator commands.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileUnaryOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    TclEmitOpcode(instruction, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileAssociativeBinaryOpCmd --
 *
 *	Utility routine to compile the binary operator commands that accept an
 *	arbitrary number of arguments, and that are associative operations.
 *	Because of the associativity, we may combine operations from right to
 *	left, saving us any effort of re-ordering the arguments on the stack
 *	after substitutions are completed.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileAssociativeBinaryOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    const char *identity,
    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;

    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, identity, -1);
	words++;
    }
    if (words > 3) {
	/*
	 * Reverse order of arguments to get precise agreement with
	 * [expr] in calcuations, including roundoff errors.
	 */
	TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    }
    while (--words > 1) {
	TclEmitOpcode(instruction, envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileStrictlyBinaryOpCmd --
 *
 *	Utility routine to compile the binary operator commands, that strictly
 *	accept exactly two arguments.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileStrictlyBinaryOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }
    return CompileAssociativeBinaryOpCmd(interp, parsePtr,
	    NULL, instruction, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CompileComparisonOpCmd --
 *
 *	Utility routine to compile the n-ary comparison operator commands.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileComparisonOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords < 3) {
	PushLiteral(envPtr, "1", 1);
    } else if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	TclEmitOpcode(instruction, envPtr);
    } else if (envPtr->procPtr == NULL) {
	/*
	 * No local variable space!
	 */

	return TCL_ERROR;
    } else {
	int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr->procPtr);
	int words;

	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	if (tmpIndex <= 255) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
	}
	TclEmitOpcode(instruction, envPtr);
	for (words=3 ; words<parsePtr->numWords ;) {
	    if (tmpIndex <= 255) {
		TclEmitInstInt1(INST_LOAD_SCALAR1, tmpIndex, envPtr);
	    } else {
		TclEmitInstInt4(INST_LOAD_SCALAR4, tmpIndex, envPtr);
	    }
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, words);
	    if (++words < parsePtr->numWords) {
		if (tmpIndex <= 255) {
		    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
		} else {
		    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
		}
	    }
	    TclEmitOpcode(instruction, envPtr);
	}
	for (; words>3 ; words--) {
	    TclEmitOpcode(INST_BITAND, envPtr);
	}

	/*
	 * Drop the value from the temp variable; retaining that reference
	 * might be expensive elsewhere.
	 */

	PushLiteral(envPtr, "", 0);
	if (tmpIndex <= 255) {
	    TclEmitInstInt1(INST_STORE_SCALAR1, tmpIndex, envPtr);
	} else {
	    TclEmitInstInt4(INST_STORE_SCALAR4, tmpIndex, envPtr);
	}
	TclEmitOpcode(INST_POP, envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompile*OpCmd --
 *
 *	Procedures called to compile the corresponding "::tcl::mathop::*"
 *	commands. These are all wrappers around the utility operator command
 *	compiler functions, except for the compilers for subtraction and
 *	division, which are special.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileInvertOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
}

int
TclCompileNotOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
}

int
TclCompileAddOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD,
	    envPtr);
}

int
TclCompileMulOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT,
	    envPtr);
}

int
TclCompileAndOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND,
	    envPtr);
}

int
TclCompileOrOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR,
	    envPtr);
}

int
TclCompileXorOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR,
	    envPtr);
}

int
TclCompilePowOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    /*
     * This one has its own implementation because the ** operator is
     * the only one with right associativity.
     */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;

    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, "1", 1);
	words++;
    }
    while (--words > 1) {
	TclEmitOpcode(INST_EXPON, envPtr);
    }
    return TCL_OK;
}

int
TclCompileLshiftOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr);
}

int
TclCompileRshiftOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr);
}

int
TclCompileModOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr);
}

int
TclCompileNeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr);
}

int
TclCompileStrneqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr);
}

int
TclCompileInOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr);
}

int
TclCompileNiOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN,
	    envPtr);
}

int
TclCompileLessOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr);
}

int
TclCompileLeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr);
}

int
TclCompileGreaterOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr);
}

int
TclCompileGeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr);
}

int
TclCompileEqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr);
}

int
TclCompileStreqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr);
}

int
TclCompileMinusOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;

    if (parsePtr->numWords == 1) {
	/* Fallback to direct eval to report syntax error */
	return TCL_ERROR;
    }
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (words == 2) {
	TclEmitOpcode(INST_UMINUS, envPtr);
	return TCL_OK;
    }
    if (words == 3) {
	TclEmitOpcode(INST_SUB, envPtr);
	return TCL_OK;
    }
    /*
     * Reverse order of arguments to get precise agreement with
     * [expr] in calcuations, including roundoff errors.
     */
    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_SUB, envPtr);
    }
    return TCL_OK;
}

int
TclCompileDivOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    DefineLineInformation;	/* TIP #280 */
    int words;

    if (parsePtr->numWords == 1) {
	/* Fallback to direct eval to report syntax error */
	return TCL_ERROR;
    }
    if (parsePtr->numWords == 2) {
	PushLiteral(envPtr, "1.0", 3);
    }
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (words <= 3) {
	TclEmitOpcode(INST_DIV, envPtr);
	return TCL_OK;
    }
    /*
     * Reverse order of arguments to get precise agreement with
     * [expr] in calcuations, including roundoff errors.
     */
    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_DIV, envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * IndexTailVarIfKnown --
 *
 *	Procedure used in compiling [global] and [variable] commands. It
 *	inspects the variable name described by varTokenPtr and, if the tail
 *	is known at compile time, defines a corresponding local variable.
 *
 * Results:
 * 	Returns the variable's index in the table of compiled locals if the
 *      tail is known at compile time, or -1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
IndexTailVarIfKnown(
    Tcl_Interp *interp,
    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Obj *tailPtr;
    const char *tailName, *p;
    int len, n = varTokenPtr->numComponents;
    Tcl_Token *lastTokenPtr;
    int full, localIndex;

    /*
     * Determine if the tail is (a) known at compile time, and (b) not an
     * array element. Should any of these fail, return an error so that
     * the non-compiled command will be called at runtime.
     * In order for the tail to be known at compile time, the last token
     * in the word has to be constant and contain "::" if it is not the
     * only one.
     */

    if (envPtr->procPtr == NULL) {
	return -1;
    }

    TclNewObj(tailPtr);
    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
	full = 1;
	lastTokenPtr = varTokenPtr;
    } else {
	full = 0;
	lastTokenPtr = varTokenPtr + n;
	if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
    }

    tailName = TclGetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName+len-1) == ')') {
	    /*
	     * Possible array: bail out
	     */

	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}

	/*
	 * Get the tail: immediately after the last '::'
	 */

	for(p = tailName + len -1; p > tailName; p--) {
	    if ((*p == ':') && (*(p-1) == ':')) {
		p++;
		break;
	    }
	}
	if (!full && (p == tailName)) {
	    /*
	     * No :: in the last component
	     */
	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
	len -= p - tailName;
	tailName = p;
    }

    localIndex = TclFindCompiledLocal(tailName, len,
	    /*create*/ TCL_CREATE_VAR,
	    envPtr->procPtr);
    Tcl_DecrRefCount(tailPtr);
    return localIndex;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileUpvarCmd --
 *
 *	Procedure called to compile the "upvar" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "upvar" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileUpvarCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *objPtr;

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Push the frame index if it is known at compile time
     */

    objPtr = Tcl_NewObj();
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    if(TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	CallFrame *framePtr;
	Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr;

	/*
	 * Attempt to convert to a level reference. Note that TclObjGetFrame
	 * only changes the obj type when a conversion was successful.
	 */

	TclObjGetFrame(interp, objPtr, &framePtr);
	newTypePtr = objPtr->typePtr;
	Tcl_DecrRefCount(objPtr);

	if (newTypePtr != typePtr) {
	    if(numWords%2) {
		return TCL_ERROR;
	    }
	    /* TODO: Push the known value instead? */
	    CompileWord(envPtr, tokenPtr, interp, 1);
	    otherTokenPtr = TokenAfter(tokenPtr);
	    i = 2;
	} else {
	    if(!(numWords%2)) {
		return TCL_ERROR;
	    }
	    PushLiteral(envPtr, "1", 1);
	    otherTokenPtr = tokenPtr;
	    i = 1;
	}
    } else {
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    /*
     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
     * local variable, return an error so that the non-compiled command will
     * be called at runtime.
     */

    for(; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
    }

    /*
     * Pop the frame index, and set the result to empty
     */

    TclEmitOpcode(INST_POP, envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileNamespaceCmd --
 *
 *	Procedure called to compile the "namespace" command; currently, only
 *	the subcommand "namespace upvar" is compiled to bytecodes.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "namespace upvar"
 *      command at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileNamespaceCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Only compile [namespace upvar ...]: needs an odd number of args, >=5
     */

    numWords = parsePtr->numWords;
    if (!(numWords%2) || (numWords < 5)) {
	return TCL_ERROR;
    }

    /*
     * Check if the second argument is "upvar"
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    if ((tokenPtr->size != 5)  /* 5 == strlen("upvar") */
	    || strncmp(tokenPtr->start, "upvar", 5)) {
	return TCL_ERROR;
    }

    /*
     * Push the namespace
     */

    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);

    /*
     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
     * local variable, return an error so that the non-compiled command will
     * be called at runtime.
     */

    localTokenPtr = tokenPtr;
    for(i=3; i<numWords; i+=2) {
	otherTokenPtr = TokenAfter(localTokenPtr);
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(INST_POP, envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileGlobalCmd --
 *
 *	Procedure called to compile the "global" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "global" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileGlobalCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */

    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * 'global' has no effect outside of proc bodies; handle that at runtime
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Push the namespace
     */

    PushLiteral(envPtr, "::", 2);

    /*
     * Loop over the variables.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for(i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if(localIndex < 0) {
	    return TCL_ERROR;
	}

	/* TODO: Consider what values can pass through the
	 * IndexTailVarIfKnown() screen.  Full CompileWord()
	 * likely does not apply here.  Push known value instead. */
	CompileWord(envPtr, varTokenPtr, interp, i);
	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(INST_POP, envPtr);
    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileVariableCmd --
 *
 *	Procedure called to compile the "variable" command.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "variable" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileVariableCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int localIndex, numWords, i;
    DefineLineInformation;	/* TIP #280 */

    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * Bail out if not compiling a proc body
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Loop over the (var, value) pairs.
     */

    valueTokenPtr = parsePtr->tokenPtr;
    for(i=1; i<numWords; i+=2) {
	varTokenPtr = TokenAfter(valueTokenPtr);
	valueTokenPtr = TokenAfter(varTokenPtr);

	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if(localIndex < 0) {
	    return TCL_ERROR;
	}

	/* TODO: Consider what values can pass through the
	 * IndexTailVarIfKnown() screen.  Full CompileWord()
	 * likely does not apply here.  Push known value instead. */
	CompileWord(envPtr, varTokenPtr, interp, i);
	TclEmitInstInt4(INST_VARIABLE, localIndex, envPtr);

	if (i != numWords-1) {
	    /*
	     * A value has been given: set the variable, pop the value
	     */

	    CompileWord(envPtr, valueTokenPtr, interp, i+1);
	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
	    TclEmitOpcode(INST_POP, envPtr);
	}
    }

    /*
     * Set the result to empty
     */

    PushLiteral(envPtr, "", 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileEnsemble --
 *
 *	Procedure called to compile an ensemble command. Note that most
 *	ensembles are not compiled, since modifying a compiled ensemble causes
 *	a invalidation of all existing bytecode (expensive!) which is not
 *	normally warranted.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the subcommands of the
 *	ensemble at runtime if a compile-time mapping is possible.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileEnsemble(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
    Tcl_Command ensemble = (Tcl_Command) cmdPtr;
    Tcl_Parse synthetic;
    int len, numBytes, result, flags = 0, i;
    const char *word;
    DefineLineInformation;

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	/*
	 * Too hard.
	 */

	return TCL_ERROR;
    }

    word = tokenPtr[1].start;
    numBytes = tokenPtr[1].size;

    /*
     * There's a sporting chance we'll be able to compile this. But now we
     * must check properly. To do that, check that we're compiling an ensemble
     * that has a compilable command as its appropriate subcommand.
     */

    if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK
	    || mapObj == NULL) {
	/*
	 * Either not an ensemble or a mapping isn't installed. Crud. Too hard
	 * to proceed.
	 */

	return TCL_ERROR;
    }

    /*
     * Next, get the flags. We need them on several code paths.
     */

    (void) Tcl_GetEnsembleFlags(NULL, ensemble, &flags);

    /*
     * Check to see if there's also a subcommand list; must check to see if
     * the subcommand we are calling is in that list if it exists, since that
     * list filters the entries in the map.
     */

    (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
    if (listObj != NULL) {
	int sclen;
	const char *str;
	Tcl_Obj *matchObj = NULL;

	if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
	    return TCL_ERROR;
	}
	for (i=0 ; i<len ; i++) {
	    str = Tcl_GetStringFromObj(elems[i], &sclen);
	    if (sclen==numBytes && !memcmp(word, str, (unsigned) numBytes)) {
		/*
		 * Exact match! Excellent!
		 */

		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
		if (result != TCL_OK || targetCmdObj == NULL) {
		    return TCL_ERROR;
		}
		goto doneMapLookup;
	    }

	    /*
	     * Check to see if we've got a prefix match. A single prefix match
	     * is fine, and allows us to refine our dictionary lookup, but
	     * multiple prefix matches is a Bad Thing and will prevent us from
	     * making progress. Note that we cannot do the lookup immediately
	     * in the prefix case; might be another entry later in the list
	     * that causes things to fail.
	     */

	    if ((flags & TCL_ENSEMBLE_PREFIX)
		    && strncmp(word, str, (unsigned) numBytes) == 0) {
		if (matchObj != NULL) {
		    return TCL_ERROR;
		}
		matchObj = elems[i];
	    }
	}
	if (matchObj != NULL) {
	    result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
	    if (result != TCL_OK || targetCmdObj == NULL) {
		return TCL_ERROR;
	    }
	    goto doneMapLookup;
	}
	return TCL_ERROR;
    } else {
	/*
	 * No map, so check the dictionary directly.
	 */

	TclNewStringObj(subcmdObj, word, numBytes);
	result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
	TclDecrRefCount(subcmdObj);
	if (result == TCL_OK && targetCmdObj != NULL) {
	    /*
	     * Got it. Skip the fiddling around with prefixes.
	     */

	    goto doneMapLookup;
	}

	/*
	 * We've not literally got a valid subcommand. But maybe we have a
	 * prefix. Check if prefix matches are allowed.
	 */

	if (flags & TCL_ENSEMBLE_PREFIX) {
	    Tcl_DictSearch s;
	    int done, matched;
	    Tcl_Obj *tmpObj;

	    /*
	     * Iterate over the keys in the dictionary, checking to see if
	     * we're a prefix.
	     */

	    Tcl_DictObjFirst(NULL,mapObj,&s,&subcmdObj,&tmpObj,&done);
	    matched = 0;
	    while (!done) {
		if (strncmp(TclGetString(subcmdObj), word,
			(unsigned) numBytes) == 0) {
		    if (matched++) {
			/*
			 * Must have matched twice! Not unique, so no point
			 * looking further.
			 */

			break;
		    }
		    targetCmdObj = tmpObj;
		}
		Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
	    }
	    Tcl_DictObjDone(&s);

	    /*
	     * If we have anything other than a single match, we've failed the
	     * unique prefix check.
	     */

	    if (matched != 1) {
		return TCL_ERROR;
	    }
	} else {
	    return TCL_ERROR;
	}
    }

    /*
     * OK, we definitely map to something. But what?
     *
     * The command we map to is the first word out of the map element. Note
     * that we also reject dealing with multi-element rewrites if we are in a
     * safe interpreter, as there is otherwise a (highly gnarly!) way to make
     * Tcl crash open to exploit.
     */

  doneMapLookup:
    if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
	return TCL_ERROR;
    }
    if (len > 1 && Tcl_IsSafe(interp)) {
	return TCL_ERROR;
    }
    targetCmdObj = elems[0];

    Tcl_IncrRefCount(targetCmdObj);
    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
    TclDecrRefCount(targetCmdObj);
    if (cmdPtr == NULL || cmdPtr->compileProc == NULL
	    || 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;
    }

    /*
     * Now we've done the mapping process, can now actually try to compile.
     * We do this by handing off to the subcommand's actual compiler. But to
     * do that, we have to perform some trickery to rewrite the arguments.
     */

    TclParseInit(interp, NULL, 0, &synthetic);
    synthetic.numWords = parsePtr->numWords - 2 + len;
    TclGrowParseTokenArray(&synthetic, 2*len);
    synthetic.numTokens = 2*len;

    /*
     * Now we have the space to work in, install something rewritten. Note
     * that we are here praying for all our might that none of these words are
     * a script; the error detection code will crash if that happens and there
     * is nothing we can do to avoid it!
     */

    for (i=0 ; i<len ; i++) {
	int sclen;
	const char *str = Tcl_GetStringFromObj(elems[i], &sclen);

	synthetic.tokenPtr[2*i].type = TCL_TOKEN_SIMPLE_WORD;
	synthetic.tokenPtr[2*i].start = str;
	synthetic.tokenPtr[2*i].size = sclen;
	synthetic.tokenPtr[2*i].numComponents = 1;

	synthetic.tokenPtr[2*i+1].type = TCL_TOKEN_TEXT;
	synthetic.tokenPtr[2*i+1].start = str;
	synthetic.tokenPtr[2*i+1].size = sclen;
	synthetic.tokenPtr[2*i+1].numComponents = 0;
    }

    /*
     * Copy over the real argument tokens.
     */

    for (i=len; i<synthetic.numWords; i++) {
	int toCopy;
	tokenPtr = TokenAfter(tokenPtr);
	toCopy = tokenPtr->numComponents + 1;
	TclGrowParseTokenArray(&synthetic, toCopy);
	memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr,
		sizeof(Tcl_Token) * toCopy);
	synthetic.numTokens += toCopy;
    }

    /*
     * Hand off compilation to the subcommand compiler. At last!
     */

    mapPtr->loc[eclIndex].line++;
    mapPtr->loc[eclIndex].next++;

    result = cmdPtr->compileProc(interp, &synthetic, cmdPtr, envPtr);

    mapPtr->loc[eclIndex].line--;
    mapPtr->loc[eclIndex].next--;

    /*
     * Clean up if necessary.
     */

    Tcl_FreeParse(&synthetic);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileInfoExistsCmd --
 *
 *	Procedure called to compile the "info exists" subcommand.
 *
 * Results:
 * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 * 	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "info exists"
 *	subcommand at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileInfoExistsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int isScalar, simpleVarName, localIndex;
    DefineLineInformation;	/* TIP #280 */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
		    &simpleVarName, &isScalar, 1);

    /*
     * Emit instruction to check the variable for existence.
     */

    if (simpleVarName) {
	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_EXIST_STK, envPtr);
	    } else {
		TclEmitInstInt4(INST_EXIST_SCALAR, localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode(INST_EXIST_ARRAY_STK, envPtr);
	    } else {
		TclEmitInstInt4(INST_EXIST_ARRAY, localIndex, envPtr);
	    }
	}
    } else {
	TclEmitOpcode(INST_EXIST_STK, envPtr);
    }

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclCompCmdsGR.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclCompCmdsGR.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 'g' through 'r') into a sequence
 *	of instructions ("bytecodes").
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2013 by Donal K. Fellows.
 *
 * 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 "tclCompile.h"
#include <assert.h>

/*
 * Prototypes for procedures defined later in this file:
 */

static void		CompileReturnInternal(CompileEnv *envPtr,
			    unsigned char op, int code, int level,
			    Tcl_Obj *returnOpts);
static int		IndexTailVarIfKnown(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr);

/*
 *----------------------------------------------------------------------
 *
 * TclGetIndexFromToken --
 *
 *	Parse a token to determine if an index value is known at
 *	compile time.
 *
 * Returns:
 *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
 *
 * Side effects:
 *	When TCL_OK is returned, the encoded index value is written
 *	to *index.
 *
 *----------------------------------------------------------------------
 */

int
TclGetIndexFromToken(
    Tcl_Token *tokenPtr,
    size_t before,
    size_t after,
    int *indexPtr)
{
    Tcl_Obj *tmpObj;
    int result = TCL_ERROR;

    TclNewObj(tmpObj);
    if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
	result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr);
    }
    Tcl_DecrRefCount(tmpObj);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileGlobalCmd --
 *
 *	Procedure called to compile the "global" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "global" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileGlobalCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr;
    int localIndex, numWords, i;

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * 'global' has no effect outside of proc bodies; handle that at runtime
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Push the namespace
     */

    PushStringLiteral(envPtr, "::");

    /*
     * Loop over the variables.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i=1; i<numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	/*
	 * TODO: Consider what value can pass through the
	 * IndexTailVarIfKnown() screen. Full CompileWord() likely does not
	 * apply here. Push known value instead.
	 */

	CompileWord(envPtr, varTokenPtr, interp, i);
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushStringLiteral(envPtr, "");
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileIfCmd --
 *
 *	Procedure called to compile the "if" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "if" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileIfCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    JumpFixupArray jumpFalseFixupArray;
				/* Used to fix the ifFalse jump after each
				 * test when its target PC is determined. */
    JumpFixupArray jumpEndFixupArray;
				/* Used to fix the jump after each "then" body
				 * to the end of the "if" when that PC is
				 * determined. */
    Tcl_Token *tokenPtr, *testTokenPtr;
    int jumpIndex = 0;		/* Avoid compiler warning. */
	size_t numBytes;
    int jumpFalseDist, numWords, wordIdx, j, code;
    const char *word;
    int realCond = 1;		/* Set to 0 for static conditions:
				 * "if 0 {..}" */
    int boolVal;		/* Value of static condition. */
    int compileScripts = 1;

    /*
     * Only compile the "if" command if all arguments are simple words, in
     * order to insure correct substitution [Bug 219166]
     */

    tokenPtr = parsePtr->tokenPtr;
    wordIdx = 0;
    numWords = parsePtr->numWords;

    for (wordIdx = 0; wordIdx < numWords; wordIdx++) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }

    TclInitJumpFixupArray(&jumpFalseFixupArray);
    TclInitJumpFixupArray(&jumpEndFixupArray);
    code = TCL_OK;

    /*
     * Each iteration of this loop compiles one "if expr ?then? body" or
     * "elseif expr ?then? body" clause.
     */

    tokenPtr = parsePtr->tokenPtr;
    wordIdx = 0;
    while (wordIdx < numWords) {
	/*
	 * Stop looping if the token isn't "if" or "elseif".
	 */

	word = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;
	if ((tokenPtr == parsePtr->tokenPtr)
		|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
	    tokenPtr = TokenAfter(tokenPtr);
	    wordIdx++;
	} else {
	    break;
	}
	if (wordIdx >= numWords) {
	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Compile the test expression then emit the conditional jump around
	 * the "then" part.
	 */

	testTokenPtr = tokenPtr;

	if (realCond) {
	    /*
	     * Find out if the condition is a constant.
	     */

	    Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start,
		    testTokenPtr[1].size);

	    Tcl_IncrRefCount(boolObj);
	    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
	    TclDecrRefCount(boolObj);
	    if (code == TCL_OK) {
		/*
		 * A static condition.
		 */

		realCond = 0;
		if (!boolVal) {
		    compileScripts = 0;
		}
	    } else {
		SetLineInformation(wordIdx);
		Tcl_ResetResult(interp);
		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
		}
		jumpIndex = jumpFalseFixupArray.next;
		jumpFalseFixupArray.next++;
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
			jumpFalseFixupArray.fixup + jumpIndex);
	    }
	    code = TCL_OK;
	}

	/*
	 * Skip over the optional "then" before the then clause.
	 */

	tokenPtr = TokenAfter(testTokenPtr);
	wordIdx++;
	if (wordIdx >= numWords) {
	    code = TCL_ERROR;
	    goto done;
	}
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    word = tokenPtr[1].start;
	    numBytes = tokenPtr[1].size;
	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
		tokenPtr = TokenAfter(tokenPtr);
		wordIdx++;
		if (wordIdx >= numWords) {
		    code = TCL_ERROR;
		    goto done;
		}
	    }
	}

	/*
	 * Compile the "then" command body.
	 */

	if (compileScripts) {
	    BODY(tokenPtr, wordIdx);
	}

	if (realCond) {
	    /*
	     * Jump to the end of the "if" command. Both jumpFalseFixupArray
	     * and jumpEndFixupArray are indexed by "jumpIndex".
	     */

	    if (jumpEndFixupArray.next >= jumpEndFixupArray.end) {
		TclExpandJumpFixupArray(&jumpEndFixupArray);
	    }
	    jumpEndFixupArray.next++;
	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
		    jumpEndFixupArray.fixup + jumpIndex);

	    /*
	     * Fix the target of the jumpFalse after the test. Generate a 4
	     * byte jump if the distance is > 120 bytes. This is conservative,
	     * and ensures that we won't have to replace this jump if we later
	     * also need to replace the proceeding jump to the end of the "if"
	     * with a 4 byte jump.
	     */

	    TclAdjustStackDepth(-1, envPtr);
	    if (TclFixupForwardJumpToHere(envPtr,
		    jumpFalseFixupArray.fixup + jumpIndex, 120)) {
		/*
		 * Adjust the code offset for the proceeding jump to the end
		 * of the "if" command.
		 */

		jumpEndFixupArray.fixup[jumpIndex].codeOffset += 3;
	    }
	} else if (boolVal) {
	    /*
	     * We were processing an "if 1 {...}"; stop compiling scripts.
	     */

	    compileScripts = 0;
	} else {
	    /*
	     * We were processing an "if 0 {...}"; reset so that the rest
	     * (elseif, else) is compiled correctly.
	     */

	    realCond = 1;
	    compileScripts = 1;
	}

	tokenPtr = TokenAfter(tokenPtr);
	wordIdx++;
    }

    /*
     * Check for the optional else clause. Do not compile anything if this was
     * an "if 1 {...}" case.
     */

    if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
	/*
	 * There is an else clause. Skip over the optional "else" word.
	 */

	word = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;
	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
	    tokenPtr = TokenAfter(tokenPtr);
	    wordIdx++;
	    if (wordIdx >= numWords) {
		code = TCL_ERROR;
		goto done;
	    }
	}

	if (compileScripts) {
	    /*
	     * Compile the else command body.
	     */

	    BODY(tokenPtr, wordIdx);
	}

	/*
	 * Make sure there are no words after the else clause.
	 */

	wordIdx++;
	if (wordIdx < numWords) {
	    code = TCL_ERROR;
	    goto done;
	}
    } else {
	/*
	 * No else clause: the "if" command's result is an empty string.
	 */

	if (compileScripts) {
	    PushStringLiteral(envPtr, "");
	}
    }

    /*
     * Fix the unconditional jumps to the end of the "if" command.
     */

    for (j = jumpEndFixupArray.next;  j > 0;  j--) {
	jumpIndex = (j - 1);	/* i.e. process the closest jump first. */
	if (TclFixupForwardJumpToHere(envPtr,
		jumpEndFixupArray.fixup + jumpIndex, 127)) {
	    /*
	     * Adjust the immediately preceeding "ifFalse" jump. We moved it's
	     * target (just after this jump) down three bytes.
	     */

	    unsigned char *ifFalsePc = envPtr->codeStart
		    + jumpFalseFixupArray.fixup[jumpIndex].codeOffset;
	    unsigned char opCode = *ifFalsePc;

	    if (opCode == INST_JUMP_FALSE1) {
		jumpFalseDist = TclGetInt1AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt1AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else if (opCode == INST_JUMP_FALSE4) {
		jumpFalseDist = TclGetInt4AtPtr(ifFalsePc + 1);
		jumpFalseDist += 3;
		TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
	    } else {
		Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", opCode);
	    }
	}
    }

    /*
     * Free the jumpFixupArray array if malloc'ed storage was used.
     */

  done:
    TclFreeJumpFixupArray(&jumpFalseFixupArray);
    TclFreeJumpFixupArray(&jumpEndFixupArray);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileIncrCmd --
 *
 *	Procedure called to compile the "incr" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "incr" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileIncrCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *incrTokenPtr;
    int isScalar, localIndex, haveImmValue, immValue;

    if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
	return TCL_ERROR;
    }

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
	    &localIndex, &isScalar, 1);

    /*
     * If an increment is given, push it, but see first if it's a small
     * integer.
     */

    haveImmValue = 0;
    immValue = 1;
    if (parsePtr->numWords == 3) {
	incrTokenPtr = TokenAfter(varTokenPtr);
	if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    const char *word = incrTokenPtr[1].start;
	    size_t numBytes = incrTokenPtr[1].size;
	    int code;
	    Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes);

	    Tcl_IncrRefCount(intObj);
	    code = TclGetIntFromObj(NULL, intObj, &immValue);
	    TclDecrRefCount(intObj);
	    if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) {
		haveImmValue = 1;
	    }
	    if (!haveImmValue) {
		PushLiteral(envPtr, word, numBytes);
	    }
	} else {
	    SetLineInformation(2);
	    CompileTokens(envPtr, incrTokenPtr, interp);
	}
    } else {			/* No incr amount given so use 1. */
	haveImmValue = 1;
    }

    /*
     * Emit the instruction to increment the variable.
     */

    if (isScalar) {	/* Simple scalar variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_SCALAR1, localIndex,	envPtr);
	    }
	} else {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
	    } else {
		TclEmitOpcode(	INST_INCR_STK,		envPtr);
	    }
	}
    } else {			/* Simple array variable. */
	if (localIndex >= 0) {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
		TclEmitInt1(immValue, envPtr);
	    } else {
		TclEmitInstInt1(INST_INCR_ARRAY1, localIndex,	envPtr);
	    }
	} else {
	    if (haveImmValue) {
		TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
	    } else {
		TclEmitOpcode(	INST_INCR_ARRAY_STK,		envPtr);
	    }
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileInfo*Cmd --
 *
 *	Procedures called to compile "info" subcommands.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "info" subcommand at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileInfoCommandsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    Tcl_Obj *objPtr;
    const char *bytes;

    /*
     * We require one compile-time known argument for the case we can compile.
     */

    if (parsePtr->numWords == 1) {
	return TclCompileBasic0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    } else if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	goto notCompilable;
    }
    bytes = TclGetString(objPtr);

    /*
     * We require that the argument start with "::" and not have any of "*\[?"
     * in it. (Theoretically, we should look in only the final component, but
     * the difference is so slight given current naming practices.)
     */

    if (bytes[0] != ':' || bytes[1] != ':' || !TclMatchIsTrivial(bytes)) {
	goto notCompilable;
    }
    Tcl_DecrRefCount(objPtr);

    /*
     * Confirmed as a literal that will not frighten the horses. Compile. Note
     * that the result needs to be list-ified.
     */

    /* TODO: Just push the known value */
    CompileWord(envPtr, tokenPtr,		interp, 1);
    TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
    TclEmitOpcode(	INST_DUP,		envPtr);
    TclEmitOpcode(	INST_STR_LEN,		envPtr);
    TclEmitInstInt1(	INST_JUMP_FALSE1, 7,	envPtr);
    TclEmitInstInt4(	INST_LIST, 1,		envPtr);
    return TCL_OK;

  notCompilable:
    Tcl_DecrRefCount(objPtr);
    return TclCompileBasic1ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileInfoCoroutineCmd(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Only compile [info coroutine] without arguments.
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    /*
     * Not much to do; we compile to a single instruction...
     */

    TclEmitOpcode(		INST_COROUTINE_NAME,		envPtr);
    return TCL_OK;
}

int
TclCompileInfoExistsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int isScalar, localIndex;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex, &isScalar, 1);

    /*
     * Emit instruction to check the variable for existence.
     */

    if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_EXIST_STK,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_EXIST_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_EXIST_ARRAY_STK,		envPtr);
	} else {
	    TclEmitInstInt4(	INST_EXIST_ARRAY, localIndex,	envPtr);
	}
    }

    return TCL_OK;
}

int
TclCompileInfoLevelCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Only compile [info level] without arguments or with a single argument.
     */

    if (parsePtr->numWords == 1) {
	/*
	 * Not much to do; we compile to a single instruction...
	 */

	TclEmitOpcode(		INST_INFO_LEVEL_NUM,		envPtr);
    } else if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    } else {
	DefineLineInformation;	/* TIP #280 */

	/*
	 * Compile the argument, then add the instruction to convert it into a
	 * list of arguments.
	 */

	CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
	TclEmitOpcode(		INST_INFO_LEVEL_ARGS,		envPtr);
    }
    return TCL_OK;
}

int
TclCompileInfoObjectClassCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    CompileWord(envPtr,		tokenPtr,		interp, 1);
    TclEmitOpcode(		INST_TCLOO_CLASS,	envPtr);
    return TCL_OK;
}

int
TclCompileInfoObjectIsACmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * We only handle [info object isa object <somevalue>]. The first three
     * words are compressed to a single token by the ensemble compilation
     * engine.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size < 1
	    || strncmp(tokenPtr[1].start, "object", tokenPtr[1].size)) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(tokenPtr);

    /*
     * Issue the code.
     */

    CompileWord(envPtr,		tokenPtr,		interp, 2);
    TclEmitOpcode(		INST_TCLOO_IS_OBJECT,	envPtr);
    return TCL_OK;
}

int
TclCompileInfoObjectNamespaceCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    CompileWord(envPtr,		tokenPtr,		interp, 1);
    TclEmitOpcode(		INST_TCLOO_NS,		envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLappendCmd --
 *
 *	Procedure called to compile the "lappend" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lappend" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLappendCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isScalar, localIndex, numWords, i;

    /* TODO: Consider support for compiling expanded args. */
    numWords = parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

    if (numWords != 3 || envPtr->procPtr == NULL) {
	goto lappendMultiple;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we
     * need to emit code to compute and push the name at runtime. We use a
     * frame slot (entry in the array of local vars) if we are compiling a
     * procedure body and if the name is simple text that does not include
     * namespace qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
	    &localIndex, &isScalar, 1);

    /*
     * If we are doing an assignment, push the new value. In the no values
     * case, create an empty object.
     */

    if (numWords > 2) {
	valueTokenPtr = TokenAfter(varTokenPtr);

	CompileWord(envPtr, valueTokenPtr, interp, 2);
    }

    /*
     * Emit instructions to set/get the variable.
     */

    /*
     * The *_STK opcodes should be refactored to make better use of existing
     * LOAD/STORE instructions.
     */

    if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LAPPEND_STK,		envPtr);
	} else {
	    Emit14Inst(		INST_LAPPEND_SCALAR, localIndex, envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LAPPEND_ARRAY_STK,		envPtr);
	} else {
	    Emit14Inst(		INST_LAPPEND_ARRAY, localIndex,	envPtr);
	}
    }

    return TCL_OK;

  lappendMultiple:
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
	    &localIndex, &isScalar, 1);
    valueTokenPtr = TokenAfter(varTokenPtr);
    for (i = 2 ; i < numWords ; i++) {
	CompileWord(envPtr, valueTokenPtr, interp, i);
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    TclEmitInstInt4(	    INST_LIST, numWords - 2,		envPtr);
    if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(  INST_LAPPEND_LIST_STK,		envPtr);
	} else {
	    TclEmitInstInt4(INST_LAPPEND_LIST, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(  INST_LAPPEND_LIST_ARRAY_STK,	envPtr);
	} else {
	    TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr);
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLassignCmd --
 *
 *	Procedure called to compile the "lassign" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lassign" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLassignCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int isScalar, localIndex, numWords, idx;

    numWords = parsePtr->numWords;

    /*
     * Check for command syntax error, but we'll punt that to runtime.
     */

    if (numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Generate code to push list being taken apart by [lassign].
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /*
     * Generate code to assign values from the list to variables.
     */

    for (idx=0 ; idx<numWords-2 ; idx++) {
	tokenPtr = TokenAfter(tokenPtr);

	/*
	 * Generate the next variable name.
	 */

	PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
		&isScalar, idx + 2);

	/*
	 * Emit instructions to get the idx'th item out of the list value on
	 * the stack and assign it to the variable.
	 */

	if (isScalar) {
	    if (localIndex >= 0) {
		TclEmitOpcode(	INST_DUP,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		Emit14Inst(	INST_STORE_SCALAR, localIndex,	envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    } else {
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		TclEmitOpcode(	INST_STORE_STK,			envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    }
	} else {
	    if (localIndex >= 0) {
		TclEmitInstInt4(INST_OVER, 1,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		Emit14Inst(	INST_STORE_ARRAY, localIndex,	envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    } else {
		TclEmitInstInt4(INST_OVER, 2,			envPtr);
		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
		TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
		TclEmitOpcode(	INST_POP,			envPtr);
	    }
	}
    }

    /*
     * Generate code to leave the rest of the list on the stack.
     */

    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
    TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLindexCmd --
 *
 *	Procedure called to compile the "lindex" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lindex" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLindexCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *idxTokenPtr, *valTokenPtr;
    int i, idx, numWords = parsePtr->numWords;

    /*
     * Quit if not enough args.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (numWords <= 1) {
	return TCL_ERROR;
    }

    valTokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (numWords != 3) {
	goto emitComplexLindex;
    }

    idxTokenPtr = TokenAfter(valTokenPtr);
    if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_NONE,
	    TCL_INDEX_NONE, &idx) == TCL_OK) {
	/*
	 * The idxTokenPtr parsed as a valid index value and was
	 * encoded as expected by INST_LIST_INDEX_IMM.
	 *
	 * NOTE: that we rely on indexing before a list producing the
	 * same result as indexing after a list.
	 */

	CompileWord(envPtr, valTokenPtr, interp, 1);
	TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	return TCL_OK;
    }

    /*
     * If the value was not known at compile time, the conversion failed or
     * the value was negative, we just keep on going with the more complex
     * compilation.
     */

    /*
     * Push the operands onto the stack.
     */

  emitComplexLindex:
    for (i=1 ; i<numWords ; i++) {
	CompileWord(envPtr, valTokenPtr, interp, i);
	valTokenPtr = TokenAfter(valTokenPtr);
    }

    /*
     * Emit INST_LIST_INDEX if objc==3, or INST_LIST_INDEX_MULTI if there are
     * multiple index args.
     */

    if (numWords == 3) {
	TclEmitOpcode(		INST_LIST_INDEX,		envPtr);
    } else {
	TclEmitInstInt4(	INST_LIST_INDEX_MULTI, numWords-1, envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileListCmd --
 *
 *	Procedure called to compile the "list" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "list" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileListCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *valueTokenPtr;
    int i, numWords, concat, build;
    Tcl_Obj *listObj, *objPtr;

    if (parsePtr->numWords == 1) {
	/*
	 * [list] without arguments just pushes an empty object.
	 */

	PushStringLiteral(envPtr, "");
	return TCL_OK;
    }

    /*
     * Test if all arguments are compile-time known. If they are, we can
     * implement with a simple push.
     */

    numWords = parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    TclNewObj(listObj);
    for (i = 1; i < numWords && listObj != NULL; i++) {
	TclNewObj(objPtr);
	if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) {
	    (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr);
	} else {
	    Tcl_DecrRefCount(objPtr);
	    Tcl_DecrRefCount(listObj);
	    listObj = NULL;
	}
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    if (listObj != NULL) {
	TclEmitPush(TclAddLiteralObj(envPtr, listObj, NULL), envPtr);
	return TCL_OK;
    }

    /*
     * Push the all values onto the stack.
     */

    numWords = parsePtr->numWords;
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    concat = build = 0;
    for (i = 1; i < numWords; i++) {
	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
	    TclEmitInstInt4(	INST_LIST, build,	envPtr);
	    if (concat) {
		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
	    }
	    build = 0;
	    concat = 1;
	}
	CompileWord(envPtr, valueTokenPtr, interp, i);
	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
	    if (concat) {
		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
	    } else {
		concat = 1;
	    }
	} else {
	    build++;
	}
	valueTokenPtr = TokenAfter(valueTokenPtr);
    }
    if (build > 0) {
	TclEmitInstInt4(	INST_LIST, build,	envPtr);
	if (concat) {
	    TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
	}
    }

    /*
     * If there was just one expanded word, we must ensure that it is a list
     * at this point. We use an [lrange ... 0 end] for this (instead of
     * [llength], as with literals) as we must drop any string representation
     * that might be hanging around.
     */

    if (concat && numWords == 2) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,	envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLlengthCmd --
 *
 *	Procedure called to compile the "llength" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "llength" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLlengthCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    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. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *listTokenPtr;
    int idx1, idx2;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if ((TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
	    &idx1) != TCL_OK) || (idx1 == (int)TCL_INDEX_NONE)) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "first" indices
     * before the list same as the start of the list.
     */

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
	    &idx2) != TCL_OK) {
	return TCL_ERROR;
    }
    /*
     * Token was an index value, and we treat all "last" indices
     * after the list same as the end of the list.
     */

    /*
     * 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;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLinsertCmd --
 *
 *	How to compile the "linsert" command. We only bother with the case
 *	where the index is constant.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLinsertCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for context. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *listTokenPtr;
    int idx, i;

    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Parse the 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) or an end-based index greater than 'end' itself.
     */

    tokenPtr = TokenAfter(listTokenPtr);

    /*
     * NOTE: This command treats all inserts at indices before the list
     * the same as inserts at the start of the list, and all inserts
     * after the list the same as inserts at the end of the list. We
     * make that transformation here so we can use the optimized bytecode
     * as much as possible.
     */
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END,
	    &idx) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * There are four main cases. If there are no values to insert, this is
     * just a confirm-listiness check. If the index is '0', this is a prepend.
     * If the index is 'end' (== TCL_INDEX_END), this is an append. Otherwise,
     * this is a splice (== split, insert values as list, concat-3).
     */

    CompileWord(envPtr, listTokenPtr, interp, 1);
    if (parsePtr->numWords == 3) {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    for (i=3 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }
    TclEmitInstInt4(		INST_LIST, i - 3,		envPtr);

    if (idx == (int)TCL_INDEX_START) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else if (idx == (int)TCL_INDEX_END) {
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    } else {
	/*
	 * Here we handle two ranges for idx. First when idx > 0, we
	 * want the first half of the split to end at index idx-1 and
	 * the second half to start at index idx.
	 * Second when idx < TCL_INDEX_END, indicating "end-N" indexing,
	 * we want the first half of the split to end at index end-N and
	 * the second half to start at index end-N+1. We accomplish this
	 * with a pre-adjustment of the end-N value.
	 * The root of this is that the commands [lrange] and [linsert]
	 * differ in their interpretation of the "end" index.
	 */

	if (idx < (int)TCL_INDEX_END) {
	    idx++;
	}
	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx - 1,		envPtr);
	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLreplaceCmd --
 *
 *	How to compile the "lreplace" command. We only bother with the case
 *	where the indices are constant.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLreplaceCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for context. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *listTokenPtr;
    int idx1, idx2, i;
    int emptyPrefix=1, suffixStart = 0;

    if (parsePtr->numWords < 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    tokenPtr = TokenAfter(listTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
	    &idx1) != TCL_OK) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
	    &idx2) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * General structure of the [lreplace] result is
     *		prefix replacement suffix
     * In a few cases we can predict various parts will be empty and
     * take advantage.
     *
     * The proper suffix begins with the greater of indices idx1 or
     * idx2 + 1. If we cannot tell at compile time which is greater,
     * we must defer to direct evaluation.
     */

    if (idx1 == (int)TCL_INDEX_NONE) {
	suffixStart = (int)TCL_INDEX_NONE;
    } else if (idx2 == (int)TCL_INDEX_NONE) {
	suffixStart = idx1;
    } else if (idx2 == (int)TCL_INDEX_END) {
	suffixStart = (int)TCL_INDEX_NONE;
    } else if (((idx2 < (int)TCL_INDEX_END) && (idx1 <= (int)TCL_INDEX_END))
	    || ((idx2 >= (int)TCL_INDEX_START) && (idx1 >= (int)TCL_INDEX_START))) {
	suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
    } else {
	return TCL_ERROR;
    }

    /* All paths start with computing/pushing the original value. */
    CompileWord(envPtr, listTokenPtr, interp, 1);

    /*
     * Push all the replacement values next so any errors raised in
     * creating them get raised first.
     */
    if (parsePtr->numWords > 4) {
	/* Push the replacement arguments */
	tokenPtr = TokenAfter(tokenPtr);
	for (i=4 ; i<parsePtr->numWords ; i++) {
	    CompileWord(envPtr, tokenPtr, interp, i);
	    tokenPtr = TokenAfter(tokenPtr);
	}

	/* Make a list of them... */
	TclEmitInstInt4(	INST_LIST, i - 4,		envPtr);

	emptyPrefix = 0;
    }

    if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
	/*
	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
	 * We still do a list operation to get list-verification
	 * and canonicalization side effects.
	 */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	return TCL_OK;
    }

    if (idx1 != (int)TCL_INDEX_START) {
	/* Prefix may not be empty; generate bytecode to push it */
	if (emptyPrefix) {
	    TclEmitOpcode(	INST_DUP,			envPtr);
	} else {
	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
	}
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
	TclEmitInt4(			idx1 - 1,		envPtr);
	if (!emptyPrefix) {
	    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
	}
	emptyPrefix = 0;
    }

    if (!emptyPrefix) {
	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
    }

    if (suffixStart == (int)TCL_INDEX_NONE) {
	TclEmitOpcode(		INST_POP,			envPtr);
	if (emptyPrefix) {
	    PushStringLiteral(envPtr, "");
	}
    } else {
	/* Suffix may not be empty; generate bytecode to push it */
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, suffixStart, envPtr);
	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
	if (!emptyPrefix) {
	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --
 *
 *	Procedure called to compile the "lset" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "lset" command at
 *	runtime.
 *
 * The general template for execution of the "lset" command is:
 *	(1) Instructions to push the variable name, unless the variable is
 *	    local to the stack frame.
 *	(2) If the variable is an array element, instructions to push the
 *	    array element name.
 *	(3) Instructions to push each of zero or more "index" arguments to the
 *	    stack, followed with the "newValue" element.
 *	(4) Instructions to duplicate the variable name and/or array element
 *	    name onto the top of the stack, if either was pushed at steps (1)
 *	    and (2).
 *	(5) The appropriate INST_LOAD_* instruction to place the original
 *	    value of the list variable at top of stack.
 *	(6) At this point, the stack contains:
 *		varName? arrayElementName? index1 index2 ... newValue oldList
 *	    The compiler emits one of INST_LSET_FLAT or INST_LSET_LIST
 *	    according as whether there is exactly one index element (LIST) or
 *	    either zero or else two or more (FLAT). This instruction removes
 *	    everything from the stack except for the two names and pushes the
 *	    new value of the variable.
 *	(7) Finally, INST_STORE_* stores the new value in the variable and
 *	    cleans up the stack.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLsetCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int tempDepth;		/* Depth used for emitting one part of the
				 * code burst. */
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the variable name. */
    int localIndex;		/* Index of var in local var table. */
    int isScalar;		/* Flag == 1 if scalar, 0 if array. */
    int i;

    /*
     * Check argument count.
     */

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	/*
	 * Fail at run time, not in compilation.
	 */

	return TCL_ERROR;
    }

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
	    &localIndex, &isScalar, 1);

    /*
     * Push the "index" args and the new element value.
     */

    for (i=2 ; i<parsePtr->numWords ; ++i) {
	varTokenPtr = TokenAfter(varTokenPtr);
	CompileWord(envPtr, varTokenPtr, interp, i);
    }

    /*
     * Duplicate the variable name if it's been pushed.
     */

    if (localIndex < 0) {
	if (isScalar) {
	    tempDepth = parsePtr->numWords - 2;
	} else {
	    tempDepth = parsePtr->numWords - 1;
	}
	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
    }

    /*
     * Duplicate an array index if one's been pushed.
     */

    if (!isScalar) {
	if (localIndex < 0) {
	    tempDepth = parsePtr->numWords - 1;
	} else {
	    tempDepth = parsePtr->numWords - 2;
	}
	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
    }

    /*
     * Emit code to load the variable's value.
     */

    if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LOAD_STK,			envPtr);
	} else {
	    Emit14Inst(		INST_LOAD_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_LOAD_ARRAY_STK,		envPtr);
	} else {
	    Emit14Inst(		INST_LOAD_ARRAY, localIndex,	envPtr);
	}
    }

    /*
     * Emit the correct variety of 'lset' instruction.
     */

    if (parsePtr->numWords == 4) {
	TclEmitOpcode(		INST_LSET_LIST,			envPtr);
    } else {
	TclEmitInstInt4(	INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
    }

    /*
     * Emit code to put the value back in the variable.
     */

    if (isScalar) {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_STORE_STK,			envPtr);
	} else {
	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
	}
    } else {
	if (localIndex < 0) {
	    TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
	} else {
	    Emit14Inst(		INST_STORE_ARRAY, localIndex,	envPtr);
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileNamespace*Cmd --
 *
 *	Procedures called to compile the "namespace" command; currently, only
 *	the subcommands "namespace current" and "namespace upvar" are compiled
 *	to bytecodes, and the latter only inside a procedure(-like) context.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "namespace upvar"
 *	command at runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileNamespaceCurrentCmd(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Only compile [namespace current] without arguments.
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    /*
     * Not much to do; we compile to a single instruction...
     */

    TclEmitOpcode(		INST_NS_CURRENT,		envPtr);
    return TCL_OK;
}

int
TclCompileNamespaceCodeCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * The specification of [namespace code] is rather shocking, in that it is
     * supposed to check if the argument is itself the result of [namespace
     * code] and not apply itself in that case. Which is excessively cautious,
     * but what the test suite checks for.
     */

    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || (tokenPtr[1].size > 20
	    && strncmp(tokenPtr[1].start, "::namespace inscope ", 20) == 0)) {
	/*
	 * Technically, we could just pass a literal '::namespace inscope '
	 * term through, but that's something which really shouldn't be
	 * occurring as something that the user writes so we'll just punt it.
	 */

	return TCL_ERROR;
    }

    /*
     * Now we can compile using the same strategy as [namespace code]'s normal
     * implementation does internally. Note that we can't bind the namespace
     * name directly here, because TclOO plays complex games with namespaces;
     * the value needs to be determined at runtime for safety.
     */

    PushStringLiteral(envPtr,		"::namespace");
    PushStringLiteral(envPtr,		"inscope");
    TclEmitOpcode(		INST_NS_CURRENT,	envPtr);
    CompileWord(envPtr,		tokenPtr,		interp, 1);
    TclEmitInstInt4(		INST_LIST, 4,		envPtr);
    return TCL_OK;
}

int
TclCompileNamespaceOriginCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr,	tokenPtr,			interp, 1);
    TclEmitOpcode(	INST_ORIGIN_COMMAND,		envPtr);
    return TCL_OK;
}

int
TclCompileNamespaceQualifiersCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    int off;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    CompileWord(envPtr, tokenPtr, interp, 1);
    PushStringLiteral(envPtr, "0");
    PushStringLiteral(envPtr, "::");
    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
    off = CurrentOffset(envPtr);
    PushStringLiteral(envPtr, "1");
    TclEmitOpcode(	INST_SUB,			envPtr);
    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
    TclEmitOpcode(	INST_STR_INDEX,			envPtr);
    PushStringLiteral(envPtr, ":");
    TclEmitOpcode(	INST_STR_EQ,			envPtr);
    off = off - CurrentOffset(envPtr);
    TclEmitInstInt1(	INST_JUMP_TRUE1, off,		envPtr);
    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
    return TCL_OK;
}

int
TclCompileNamespaceTailCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    JumpFixup jumpFixup;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    /*
     * Take care; only add 2 to found index if the string was actually found.
     */

    CompileWord(envPtr, tokenPtr, interp, 1);
    PushStringLiteral(envPtr, "::");
    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
    TclEmitOpcode(	INST_DUP,			envPtr);
    PushStringLiteral(envPtr, "0");
    TclEmitOpcode(	INST_GE,			envPtr);
    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
    PushStringLiteral(envPtr, "2");
    TclEmitOpcode(	INST_ADD,			envPtr);
    TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
    PushStringLiteral(envPtr, "end");
    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
    return TCL_OK;
}

int
TclCompileNamespaceUpvarCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int localIndex, numWords, i;

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Only compile [namespace upvar ...]: needs an even number of args, >=4
     */

    numWords = parsePtr->numWords;
    if ((numWords % 2) || (numWords < 4)) {
	return TCL_ERROR;
    }

    /*
     * Push the namespace
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /*
     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
     * local variable, return an error so that the non-compiled command will
     * be called at runtime.
     */

    localTokenPtr = tokenPtr;
    for (i=2; i<numWords; i+=2) {
	otherTokenPtr = TokenAfter(localTokenPtr);
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
    }

    /*
     * Pop the namespace, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushStringLiteral(envPtr, "");
    return TCL_OK;
}

int
TclCompileNamespaceWhichCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *opt;
    int idx;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    idx = 1;

    /*
     * If there's an option, check that it's "-command". We don't handle
     * "-variable" (currently) and anything else is an error.
     */

    if (parsePtr->numWords == 3) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	opt = tokenPtr + 1;
	if (opt->size < 2 || opt->size > 8
		|| strncmp(opt->start, "-command", opt->size) != 0) {
	    return TCL_ERROR;
	}
	tokenPtr = TokenAfter(tokenPtr);
	idx++;
    }

    /*
     * Issue the bytecode.
     */

    CompileWord(envPtr,		tokenPtr,		interp, idx);
    TclEmitOpcode(		INST_RESOLVE_COMMAND,	envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileRegexpCmd --
 *
 *	Procedure called to compile the "regexp" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "regexp" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileRegexpCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr;	/* Pointer to the Tcl_Token representing the
				 * parse of the RE or string. */
    size_t len;
    int i, nocase, exact, sawLast, simple;
    const char *str;

    /*
     * We are only interested in compiling simple regexp cases. Currently
     * supported compile cases are:
     *   regexp ?-nocase? ?--? staticString $var
     *   regexp ?-nocase? ?--? {^staticString$} $var
     */

    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    simple = 0;
    nocase = 0;
    sawLast = 0;
    varTokenPtr = parsePtr->tokenPtr;

    /*
     * We only look for -nocase and -- as options. Everything else gets pushed
     * to runtime execution. This is different than regexp's runtime option
     * handling, but satisfies our stricter needs.
     */

    for (i = 1; i < parsePtr->numWords - 2; i++) {
	varTokenPtr = TokenAfter(varTokenPtr);
	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    /*
	     * Not a simple string, so punt to runtime.
	     */

	    return TCL_ERROR;
	}
	str = varTokenPtr[1].start;
	len = varTokenPtr[1].size;
	if ((len == 2) && (str[0] == '-') && (str[1] == '-')) {
	    sawLast++;
	    i++;
	    break;
	} else if ((len > 1) && (strncmp(str,"-nocase", len) == 0)) {
	    nocase = 1;
	} else {
	    /*
	     * Not an option we recognize.
	     */

	    return TCL_ERROR;
	}
    }

    if ((parsePtr->numWords - i) != 2) {
	/*
	 * We don't support capturing to variables.
	 */

	return TCL_ERROR;
    }

    /*
     * Get the regexp string. If it is not a simple string or can't be
     * converted to a glob pattern, push the word for the INST_REGEXP.
     * Keep changes here in sync with TclCompileSwitchCmd Switch_Regexp.
     */

    varTokenPtr = TokenAfter(varTokenPtr);

    if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	Tcl_DString ds;

	str = varTokenPtr[1].start;
	len = varTokenPtr[1].size;

	/*
	 * If it has a '-', it could be an incorrectly formed regexp command.
	 */

	if ((*str == '-') && !sawLast) {
	    return TCL_ERROR;
	}

	if (len == 0) {
	    /*
	     * The semantics of regexp are always match on re == "".
	     */

	    PushStringLiteral(envPtr, "1");
	    return TCL_OK;
	}

	/*
	 * Attempt to convert pattern to glob.  If successful, push the
	 * converted pattern as a literal.
	 */

	if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL)
		== TCL_OK) {
	    simple = 1;
	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	}
    }

    if (!simple) {
	CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2);
    }

    /*
     * Push the string arg.
     */

    varTokenPtr = TokenAfter(varTokenPtr);
    CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1);

    if (simple) {
	if (exact && !nocase) {
	    TclEmitOpcode(	INST_STR_EQ,			envPtr);
	} else {
	    TclEmitInstInt1(	INST_STR_MATCH, nocase,		envPtr);
	}
    } else {
	/*
	 * Pass correct RE compile flags.  We use only Int1 (8-bit), but
	 * that handles all the flags we want to pass.
	 * Don't use TCL_REG_NOSUB as we may have backrefs.
	 */

	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);

	TclEmitInstInt1(	INST_REGEXP, cflags,		envPtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileRegsubCmd --
 *
 *	Procedure called to compile the "regsub" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "regsub" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileRegsubCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    /*
     * We only compile the case with [regsub -all] where the pattern is both
     * known at compile time and simple (i.e., no RE metacharacters). That is,
     * the pattern must be translatable into a glob like "*foo*" with no other
     * glob metacharacters inside it; there must be some "foo" in there too.
     * The substitution string must also be known at compile time and free of
     * metacharacters ("\digit" and "&"). Finally, there must not be a
     * variable mentioned in the [regsub] to write the result back to (because
     * we can't get the count of substitutions that would be the result in
     * that case). The key is that these are the conditions under which a
     * [string map] could be used instead, in particular a [string map] of the
     * form we can compile to bytecode.
     *
     * In short, we look for:
     *
     *   regsub -all [--] simpleRE string simpleReplacement
     *
     * The only optional part is the "--", and no other options are handled.
     */

    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *stringTokenPtr;
    Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
    Tcl_DString pattern;
    const char *bytes;
    int exact, quantified, result = TCL_ERROR;
    size_t len;

    if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
	return TCL_ERROR;
    }

    /*
     * Parse the "-all", which must be the first argument (other options not
     * supported, non-"-all" substitution we can't compile).
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 4
	    || strncmp(tokenPtr[1].start, "-all", 4)) {
	return TCL_ERROR;
    }

    /*
     * Get the pattern into patternObj, checking for "--" in the process.
     */

    Tcl_DStringInit(&pattern);
    tokenPtr = TokenAfter(tokenPtr);
    TclNewObj(patternObj);
    if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
	goto done;
    }
    if (TclGetString(patternObj)[0] == '-') {
	if (strcmp(TclGetString(patternObj), "--") != 0
		|| parsePtr->numWords == 5) {
	    goto done;
	}
	tokenPtr = TokenAfter(tokenPtr);
	Tcl_DecrRefCount(patternObj);
	TclNewObj(patternObj);
	if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) {
	    goto done;
	}
    } else if (parsePtr->numWords == 6) {
	goto done;
    }

    /*
     * Identify the code which produces the string to apply the substitution
     * to (stringTokenPtr), and the replacement string (into replacementObj).
     */

    stringTokenPtr = TokenAfter(tokenPtr);
    tokenPtr = TokenAfter(stringTokenPtr);
    TclNewObj(replacementObj);
    if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) {
	goto done;
    }

    /*
     * Next, higher-level checks. Is the RE a very simple glob? Is the
     * replacement "simple"?
     */

    bytes = TclGetStringFromObj(patternObj, &len);
    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
	    != TCL_OK || exact || quantified) {
	goto done;
    }
    bytes = Tcl_DStringValue(&pattern);
    if (*bytes++ != '*') {
	goto done;
    }
    while (1) {
	switch (*bytes) {
	case '*':
	    if (bytes[1] == '\0') {
		/*
		 * OK, we've proved there are no metacharacters except for the
		 * '*' at each end.
		 */

		len = Tcl_DStringLength(&pattern) - 2;
		if (len + 2 > 2) {
		    goto isSimpleGlob;
		}

		/*
		 * The pattern is "**"! I believe that should be impossible,
		 * but we definitely can't handle that at all.
		 */
	    }
	case '\0': case '?': case '[': case '\\':
	    goto done;
	}
	bytes++;
    }
  isSimpleGlob:
    for (bytes = TclGetString(replacementObj); *bytes; bytes++) {
	switch (*bytes) {
	case '\\': case '&':
	    goto done;
	}
    }

    /*
     * Proved the simplicity constraints! Time to issue the code.
     */

    result = TCL_OK;
    bytes = Tcl_DStringValue(&pattern) + 1;
    PushLiteral(envPtr,	bytes, len);
    bytes = TclGetStringFromObj(replacementObj, &len);
    PushLiteral(envPtr,	bytes, len);
    CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords - 2);
    TclEmitOpcode(	INST_STR_MAP,	envPtr);

  done:
    Tcl_DStringFree(&pattern);
    if (patternObj) {
	Tcl_DecrRefCount(patternObj);
    }
    if (replacementObj) {
	Tcl_DecrRefCount(replacementObj);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileReturnCmd --
 *
 *	Procedure called to compile the "return" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "return" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileReturnCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    /*
     * General syntax: [return ?-option value ...? ?result?]
     * An even number of words means an explicit result argument is present.
     */
    int level, code, objc, size, status = TCL_OK;
    int numWords = parsePtr->numWords;
    int explicitResult = (0 == (numWords % 2));
    int numOptionWords = numWords - 1 - explicitResult;
    Tcl_Obj *returnOpts, **objv;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Check for special case which can always be compiled:
     *	    return -options <opts> <msg>
     * Unlike the normal [return] compilation, this version does everything at
     * runtime so it can handle arbitrary words and not just literals. Note
     * that if INST_RETURN_STK wasn't already needed for something else
     * ('finally' clause processing) this piece of code would not be present.
     */

    if ((numWords == 4) && (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD)
	    && (wordTokenPtr[1].size == 8)
	    && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);

	CompileWord(envPtr, optsTokenPtr, interp, 2);
	CompileWord(envPtr, msgTokenPtr,  interp, 3);
	TclEmitInvoke(envPtr, INST_RETURN_STK);
	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

    objv = (Tcl_Obj **)TclStackAlloc(interp, numOptionWords * sizeof(Tcl_Obj *));

    /*
     * Scan through the return options. If any are unknown at compile time,
     * there is no value in bytecompiling. Save the option values known in an
     * objv array for merging into a return options dictionary.
     *
     * TODO: There is potential for improvement if all option keys are known
     * at compile time and all option values relating to '-code' and '-level'
     * are known at compile time.
     */

    for (objc = 0; objc < numOptionWords; objc++) {
	TclNewObj(objv[objc]);
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    /*
	     * Non-literal, so punt to run-time assembly of the dictionary.
	     */

	    for (; objc>=0 ; objc--) {
		TclDecrRefCount(objv[objc]);
	    }
	    TclStackFree(interp, objv);
	    goto issueRuntimeReturn;
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    status = TclMergeReturnOptions(interp, objc, objv,
	    &returnOpts, &code, &level);
    while (--objc >= 0) {
	TclDecrRefCount(objv[objc]);
    }
    TclStackFree(interp, objv);
    if (TCL_ERROR == status) {
	/*
	 * Something was bogus in the return options. Clear the error message,
	 * and report back to the compiler that this must be interpreted at
	 * runtime.
	 */

	Tcl_ResetResult(interp);
	return TCL_ERROR;
    }

    /*
     * All options are known at compile time, so we're going to bytecompile.
     * Emit instructions to push the result on the stack.
     */

    if (explicitResult) {
	 CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
    } else {
	/*
	 * No explict result argument, so default result is empty string.
	 */

	PushStringLiteral(envPtr, "");
    }

    /*
     * Check for optimization: When [return] is in a proc, and there's no
     * enclosing [catch], and there are no return options, then the INST_DONE
     * instruction is equivalent, and may be more efficient.
     */

    if (numOptionWords == 0 && envPtr->procPtr != NULL) {
	/*
	 * We have default return options and we're in a proc ...
	 */

	int index = envPtr->exceptArrayNext - 1;
	int enclosingCatch = 0;

	while (index >= 0) {
	    ExceptionRange range = envPtr->exceptArrayPtr[index];

	    if ((range.type == CATCH_EXCEPTION_RANGE)
		    && (range.catchOffset == -1)) {
		enclosingCatch = 1;
		break;
	    }
	    index--;
	}
	if (!enclosingCatch) {
	    /*
	     * ... and there is no enclosing catch. Issue the maximally
	     * efficient exit instruction.
	     */

	    Tcl_DecrRefCount(returnOpts);
	    TclEmitOpcode(INST_DONE, envPtr);
	    TclAdjustStackDepth(1, envPtr);
	    return TCL_OK;
	}
    }

    /* Optimize [return -level 0 $x]. */
    Tcl_DictObjSize(NULL, returnOpts, &size);
    if (size == 0 && level == 0 && code == TCL_OK) {
	Tcl_DecrRefCount(returnOpts);
	return TCL_OK;
    }

    /*
     * Could not use the optimization, so we push the return options dict, and
     * emit the INST_RETURN_IMM instruction with code and level as operands.
     */

    CompileReturnInternal(envPtr, INST_RETURN_IMM, code, level, returnOpts);
    return TCL_OK;

  issueRuntimeReturn:
    /*
     * Assemble the option dictionary (as a list as that's good enough).
     */

    wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (objc=1 ; objc<=numOptionWords ; objc++) {
	CompileWord(envPtr, wordTokenPtr, interp, objc);
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);

    /*
     * Push the result.
     */

    if (explicitResult) {
	CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
    } else {
	PushStringLiteral(envPtr, "");
    }

    /*
     * Issue the RETURN itself.
     */

    TclEmitInvoke(envPtr, INST_RETURN_STK);
    return TCL_OK;
}

static void
CompileReturnInternal(
    CompileEnv *envPtr,
    unsigned char op,
    int code,
    int level,
    Tcl_Obj *returnOpts)
{
    if (level == 0 && (code == TCL_BREAK || code == TCL_CONTINUE)) {
	ExceptionRange *rangePtr;
	ExceptionAux *exceptAux;

	rangePtr = TclGetInnermostExceptionRange(envPtr, code, &exceptAux);
	if (rangePtr && rangePtr->type == LOOP_EXCEPTION_RANGE) {
	    TclCleanupStackForBreakContinue(envPtr, exceptAux);
	    if (code == TCL_BREAK) {
		TclAddLoopBreakFixup(envPtr, exceptAux);
	    } else {
		TclAddLoopContinueFixup(envPtr, exceptAux);
	    }
	    Tcl_DecrRefCount(returnOpts);
	    return;
	}
    }

    TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
    TclEmitInstInt4(op, code, envPtr);
    TclEmitInt4(level, envPtr);
}

void
TclCompileSyntaxError(
    Tcl_Interp *interp,
    CompileEnv *envPtr)
{
    Tcl_Obj *msg = Tcl_GetObjResult(interp);
    size_t numBytes;
    const char *bytes = TclGetStringFromObj(msg, &numBytes);

    TclErrorStackResetIf(interp, bytes, numBytes);
    TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
    CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
	    TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
    Tcl_ResetResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileUpvarCmd --
 *
 *	Procedure called to compile the "upvar" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "upvar" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileUpvarCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
    int localIndex, numWords, i;
    Tcl_Obj *objPtr;

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    numWords = parsePtr->numWords;
    if (numWords < 3) {
	return TCL_ERROR;
    }

    /*
     * Push the frame index if it is known at compile time
     */

    TclNewObj(objPtr);
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	CallFrame *framePtr;
	const Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr;

	/*
	 * Attempt to convert to a level reference. Note that TclObjGetFrame
	 * only changes the obj type when a conversion was successful.
	 */

	TclObjGetFrame(interp, objPtr, &framePtr);
	newTypePtr = objPtr->typePtr;
	Tcl_DecrRefCount(objPtr);

	if (newTypePtr != typePtr) {
	    if (numWords%2) {
		return TCL_ERROR;
	    }
	    /* TODO: Push the known value instead? */
	    CompileWord(envPtr, tokenPtr, interp, 1);
	    otherTokenPtr = TokenAfter(tokenPtr);
	    i = 2;
	} else {
	    if (!(numWords%2)) {
		return TCL_ERROR;
	    }
	    PushStringLiteral(envPtr, "1");
	    otherTokenPtr = tokenPtr;
	    i = 1;
	}
    } else {
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    /*
     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
     * local variable, return an error so that the non-compiled command will
     * be called at runtime.
     */

    for (; i<numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
	localTokenPtr = TokenAfter(otherTokenPtr);

	CompileWord(envPtr, otherTokenPtr, interp, i);
	localIndex = LocalScalarFromToken(localTokenPtr, envPtr);
	if (localIndex < 0) {
	    return TCL_ERROR;
	}
	TclEmitInstInt4(	INST_UPVAR, localIndex,		envPtr);
    }

    /*
     * Pop the frame index, and set the result to empty
     */

    TclEmitOpcode(		INST_POP,			envPtr);
    PushStringLiteral(envPtr, "");
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileVariableCmd --
 *
 *	Procedure called to compile the "variable" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "variable" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileVariableCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int localIndex, numWords, i;

    numWords = parsePtr->numWords;
    if (numWords < 2) {
	return TCL_ERROR;
    }

    /*
     * Bail out if not compiling a proc body
     */

    if (envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Loop over the (var, value) pairs.
     */

    valueTokenPtr = parsePtr->tokenPtr;
    for (i=1; i<numWords; i+=2) {
	varTokenPtr = TokenAfter(valueTokenPtr);
	valueTokenPtr = TokenAfter(varTokenPtr);

	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);

	if (localIndex < 0) {
	    return TCL_ERROR;
	}

	/* TODO: Consider what value can pass through the
	 * IndexTailVarIfKnown() screen.  Full CompileWord()
	 * likely does not apply here.  Push known value instead. */
	CompileWord(envPtr, varTokenPtr, interp, i);
	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);

	if (i + 1 < numWords) {
	    /*
	     * A value has been given: set the variable, pop the value
	     */

	    CompileWord(envPtr, valueTokenPtr, interp, i + 1);
	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
	    TclEmitOpcode(	INST_POP,			envPtr);
	}
    }

    /*
     * Set the result to empty
     */

    PushStringLiteral(envPtr, "");
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * IndexTailVarIfKnown --
 *
 *	Procedure used in compiling [global] and [variable] commands. It
 *	inspects the variable name described by varTokenPtr and, if the tail
 *	is known at compile time, defines a corresponding local variable.
 *
 * Results:
 *	Returns the variable's index in the table of compiled locals if the
 *	tail is known at compile time, or -1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
IndexTailVarIfKnown(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Token *varTokenPtr,	/* Token representing the variable name */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Obj *tailPtr;
    const char *tailName, *p;
    int n = varTokenPtr->numComponents;
    size_t len;
    Tcl_Token *lastTokenPtr;
    int full, localIndex;

    /*
     * Determine if the tail is (a) known at compile time, and (b) not an
     * array element. Should any of these fail, return an error so that the
     * non-compiled command will be called at runtime.
     *
     * In order for the tail to be known at compile time, the last token in
     * the word has to be constant and contain "::" if it is not the only one.
     */

    if (!EnvHasLVT(envPtr)) {
	return -1;
    }

    TclNewObj(tailPtr);
    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
	full = 1;
	lastTokenPtr = varTokenPtr;
    } else {
	full = 0;
	lastTokenPtr = varTokenPtr + n;

	if (lastTokenPtr->type != TCL_TOKEN_TEXT) {
	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
	Tcl_SetStringObj(tailPtr, lastTokenPtr->start, lastTokenPtr->size);
    }

    tailName = TclGetStringFromObj(tailPtr, &len);

    if (len) {
	if (*(tailName + len - 1) == ')') {
	    /*
	     * Possible array: bail out
	     */

	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}

	/*
	 * Get the tail: immediately after the last '::'
	 */

	for (p = tailName + len -1; p > tailName; p--) {
	    if ((*p == ':') && (*(p - 1) == ':')) {
		p++;
		break;
	    }
	}
	if (!full && (p == tailName)) {
	    /*
	     * No :: in the last component.
	     */

	    Tcl_DecrRefCount(tailPtr);
	    return -1;
	}
	len -= p - tailName;
	tailName = p;
    }

    localIndex = TclFindCompiledLocal(tailName, len, 1, envPtr);
    Tcl_DecrRefCount(tailPtr);
    return localIndex;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclCompileObjectNextCmd, TclCompileObjectSelfCmd --
 *
 *	Compilations of the TclOO utility commands [next] and [self].
 *
 * ----------------------------------------------------------------------
 */

int
TclCompileObjectNextCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;

    if (parsePtr->numWords > 255) {
	return TCL_ERROR;
    }

    for (i=0 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt1(	INST_TCLOO_NEXT, i,		envPtr);
    return TCL_OK;
}

int
TclCompileObjectNextToCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 255) {
	return TCL_ERROR;
    }

    for (i=0 ; i<parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    TclEmitInstInt1(	INST_TCLOO_NEXT_CLASS, i,	envPtr);
    return TCL_OK;
}

int
TclCompileObjectSelfCmd(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * We only handle [self] and [self object] (which is the same operation).
     * These are the only very common operations on [self] for which
     * bytecoding is at all reasonable.
     */

    if (parsePtr->numWords == 1) {
	goto compileSelfObject;
    } else if (parsePtr->numWords == 2) {
	Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr), *subcmd;

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size==0) {
	    return TCL_ERROR;
	}

	subcmd = tokenPtr + 1;
	if (strncmp(subcmd->start, "object", subcmd->size) == 0) {
	    goto compileSelfObject;
	} else if (strncmp(subcmd->start, "namespace", subcmd->size) == 0) {
	    goto compileSelfNamespace;
	}
    }

    /*
     * Can't compile; handle with runtime call.
     */

    return TCL_ERROR;

  compileSelfObject:

    /*
     * This delegates the entire problem to a single opcode.
     */

    TclEmitOpcode(		INST_TCLOO_SELF,		envPtr);
    return TCL_OK;

  compileSelfNamespace:

    /*
     * This is formally only correct with TclOO methods as they are currently
     * implemented; it assumes that the current namespace is invariably when a
     * TclOO context is present is the object's namespace, and that's
     * technically only something that's a matter of current policy. But it
     * avoids creating another opcode, so that's all good!
     */

    TclEmitOpcode(		INST_TCLOO_SELF,		envPtr);
    TclEmitOpcode(		INST_POP,			envPtr);
    TclEmitOpcode(		INST_NS_CURRENT,		envPtr);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclCompCmdsSZ.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590














































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclCompCmdsSZ.c --
 *
 *	This file contains compilation procedures that compile various Tcl
 *	commands (beginning with the letters 's' through 'z', except for
 *	[upvar] and [variable]) into a sequence of instructions ("bytecodes").
 *	Also includes the operator command compilers.
 *
 * Copyright (c) 1997-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2004-2010 by Donal K. Fellows.
 *
 * 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 "tclCompile.h"
#include "tclStringTrim.h"

/*
 * Prototypes for procedures defined later in this file:
 */

static AuxDataDupProc	DupJumptableInfo;
static AuxDataFreeProc	FreeJumptableInfo;
static AuxDataPrintProc	PrintJumptableInfo;
static AuxDataPrintProc	DisassembleJumptableInfo;
static int		CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, const char *identity,
			    int instruction, CompileEnv *envPtr);
static int		CompileComparisonOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static int		CompileStrictlyBinaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static int		CompileUnaryOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int instruction,
			    CompileEnv *envPtr);
static void		IssueSwitchChainedTests(Tcl_Interp *interp,
			    CompileEnv *envPtr, int mode, int noCase,
			    int numWords, Tcl_Token **bodyToken,
				int *bodyLines, int **bodyNext);
static void		IssueSwitchJumpTable(Tcl_Interp *interp,
			    CompileEnv *envPtr, int numWords,
				Tcl_Token **bodyToken, int *bodyLines,
				int **bodyContLines);
static int		IssueTryClausesInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
			    int numHandlers, int *matchCodes,
			    Tcl_Obj **matchClauses, int *resultVarIndices,
			    int *optionVarIndices, Tcl_Token **handlerTokens);
static int		IssueTryClausesFinallyInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
			    int numHandlers, int *matchCodes,
			    Tcl_Obj **matchClauses, int *resultVarIndices,
			    int *optionVarIndices, Tcl_Token **handlerTokens,
			    Tcl_Token *finallyToken);
static int		IssueTryFinallyInstructions(Tcl_Interp *interp,
			    CompileEnv *envPtr, Tcl_Token *bodyToken,
			    Tcl_Token *finallyToken);

/*
 * The structures below define the AuxData types defined in this file.
 */

const AuxDataType tclJumptableInfoType = {
    "JumptableInfo",		/* name */
    DupJumptableInfo,		/* dupProc */
    FreeJumptableInfo,		/* freeProc */
    PrintJumptableInfo,		/* printProc */
    DisassembleJumptableInfo	/* disassembleProc */
};

/*
 * Shorthand macros for instruction issuing.
 */

#define OP(name)	TclEmitOpcode(INST_##name, envPtr)
#define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
#define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
#define OP14(name,val1,val2) \
    TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define OP44(name,val1,val2) \
    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
#define PUSH(str) \
    PushStringLiteral(envPtr, str)
#define JUMP4(name,var) \
    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
#define FIXJUMP4(var) \
    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
#define JUMP1(name,var) \
    (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
#define FIXJUMP1(var) \
    TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
#define LOAD(idx) \
    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
#define STORE(idx) \
    if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
#define INVOKE(name) \
    TclEmitInvoke(envPtr,INST_##name)


/*
 *----------------------------------------------------------------------
 *
 * TclCompileSetCmd --
 *
 *	Procedure called to compile the "set" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "set" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSetCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr, *valueTokenPtr;
    int isAssignment, isScalar, localIndex, numWords;

    numWords = parsePtr->numWords;
    if ((numWords != 2) && (numWords != 3)) {
	return TCL_ERROR;
    }
    isAssignment = (numWords == 3);

    /*
     * Decide if we can use a frame slot for the var/array name or if we need
     * to emit code to compute and push the name at runtime. We use a frame
     * slot (entry in the array of local vars) if we are compiling a procedure
     * body and if the name is simple text that does not include namespace
     * qualifiers.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    PushVarNameWord(interp, varTokenPtr, envPtr, 0,
	    &localIndex, &isScalar, 1);

    /*
     * If we are doing an assignment, push the new value.
     */

    if (isAssignment) {
	valueTokenPtr = TokenAfter(varTokenPtr);
	CompileWord(envPtr, valueTokenPtr, interp, 2);
    }

    /*
     * Emit instructions to set/get the variable.
     */

	if (isScalar) {
	    if (localIndex < 0) {
		TclEmitOpcode((isAssignment?
			INST_STORE_STK : INST_LOAD_STK), envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1((isAssignment?
			INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
			localIndex, envPtr);
	    } else {
		TclEmitInstInt4((isAssignment?
			INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
			localIndex, envPtr);
	    }
	} else {
	    if (localIndex < 0) {
		TclEmitOpcode((isAssignment?
			INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
	    } else if (localIndex <= 255) {
		TclEmitInstInt1((isAssignment?
			INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
			localIndex, envPtr);
	    } else {
		TclEmitInstInt4((isAssignment?
			INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
			localIndex, envPtr);
	    }
	}

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileString*Cmd --
 *
 *	Procedures called to compile various subcommands of the "string"
 *	command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "string" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileStringCatCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int i, numWords = parsePtr->numWords, numArgs;
    Tcl_Token *wordTokenPtr;
    Tcl_Obj *obj, *folded;

    /* Trivial case, no arg */

    if (numWords<2) {
	PushStringLiteral(envPtr, "");
	return TCL_OK;
    }

    /* General case: issue CONCAT1's (by chunks of 254 if needed), folding
       contiguous constants along the way */

    numArgs = 0;
    folded = NULL;
    wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i = 1; i < numWords; i++) {
	TclNewObj(obj);
	if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) {
	    if (folded) {
		Tcl_AppendObjToObj(folded, obj);
		Tcl_DecrRefCount(obj);
	    } else {
		folded = obj;
	    }
	} else {
	    Tcl_DecrRefCount(obj);
	    if (folded) {
		size_t len;
		const char *bytes = TclGetStringFromObj(folded, &len);

		PushLiteral(envPtr, bytes, len);
		Tcl_DecrRefCount(folded);
		folded = NULL;
		numArgs ++;
	    }
	    CompileWord(envPtr, wordTokenPtr, interp, i);
	    numArgs ++;
	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
		numArgs = 1;	/* concat pushes 1 obj, the result */
	    }
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }
    if (folded) {
	size_t len;
	const char *bytes = TclGetStringFromObj(folded, &len);

	PushLiteral(envPtr, bytes, len);
	Tcl_DecrRefCount(folded);
	folded = NULL;
	numArgs ++;
    }
    if (numArgs > 1) {
	TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
    }

    return TCL_OK;
}

int
TclCompileStringCmpCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the test.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_CMP, envPtr);
    return TCL_OK;
}

int
TclCompileStringEqualCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the test.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_EQ, envPtr);
    return TCL_OK;
}

int
TclCompileStringFirstCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the test.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    OP(STR_FIND);
    return TCL_OK;
}

int
TclCompileStringLastCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /*
     * We don't support any flags; the bytecode isn't that sophisticated.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the test.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    OP(STR_FIND_LAST);
    return TCL_OK;
}

int
TclCompileStringIndexCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * Push the two operands onto the stack and then the index operation.
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 2);
    TclEmitOpcode(INST_STR_INDEX, envPtr);
    return TCL_OK;
}

int
TclCompileStringInsertCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    int idx;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    /* Compute and push the string in which to insert */
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);

    /* See what can be discovered about index at compile time */
    tokenPtr = TokenAfter(tokenPtr);
    if (TCL_OK != TclGetIndexFromToken(tokenPtr, TCL_INDEX_START,
	    TCL_INDEX_END, &idx)) {

	/* Nothing useful knowable - cease compile; let it direct eval */
	return TCL_ERROR;
    }

    /* Compute and push the string to be inserted */
    tokenPtr = TokenAfter(tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 3);

    if (idx == (int)TCL_INDEX_START) {
	/* Prepend the insertion string */
	OP4(	REVERSE, 2);
	OP1(	STR_CONCAT1, 2);
    } else  if (idx == (int)TCL_INDEX_END) {
	/* Append the insertion string */
	OP1(	STR_CONCAT1, 2);
    } else {
	/* Prefix + insertion + suffix */
	if (idx < (int)TCL_INDEX_END) {
	    /* See comments in compiler for [linsert]. */
	    idx++;
	}
	OP4(	OVER, 1);
	OP44(	STR_RANGE_IMM, 0, idx-1);
	OP4(	REVERSE, 3);
	OP44(	STR_RANGE_IMM, idx, TCL_INDEX_END);
	OP1(	STR_CONCAT1, 3);
    }

    return TCL_OK;
}

int
TclCompileStringIsCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"dict", "digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",
	"lower",	"print",	"punct",	"space",
	"true",		"upper",	"wideinteger",	"wordchar",
	"xdigit",	NULL
    };
    enum isClassesEnum {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_DICT, 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
    };
    int t, range, allowEmpty = 0, end;
    InstStringClassType strClassType;
    Tcl_Obj *isClass;

    if (parsePtr->numWords < 3 || parsePtr->numWords > 6) {
	return TCL_ERROR;
    }
    TclNewObj(isClass);
    if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) {
	Tcl_DecrRefCount(isClass);
	return TCL_ERROR;
    } else if (Tcl_GetIndexFromObj(interp, isClass, isClasses, "class", 0,
	    &t) != TCL_OK) {
	Tcl_DecrRefCount(isClass);
	TclCompileSyntaxError(interp, envPtr);
	return TCL_OK;
    }
    Tcl_DecrRefCount(isClass);

#define GotLiteral(tokenPtr, word) \
    ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD &&			\
     (tokenPtr)[1].size > 1 &&						\
     (tokenPtr)[1].start[0] == word[0] &&				\
     strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)

    /*
     * Cannot handle the -failindex option at all, and that's the only legal
     * way to have more than 4 arguments.
     */

    if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(tokenPtr);
    if (parsePtr->numWords == 3) {
	allowEmpty = 1;
    } else {
	if (!GotLiteral(tokenPtr, "-strict")) {
	    return TCL_ERROR;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }
#undef GotLiteral

    /*
     * Compile the code. There are several main classes of check here.
     *	1. Character classes
     *	2. Booleans
     *	3. Integers
     *	4. Floats
     *	5. Lists
     */

    CompileWord(envPtr, tokenPtr, interp, parsePtr->numWords-1);

    switch ((enum isClassesEnum) t) {
    case STR_IS_ALNUM:
	strClassType = STR_CLASS_ALNUM;
	goto compileStrClass;
    case STR_IS_ALPHA:
	strClassType = STR_CLASS_ALPHA;
	goto compileStrClass;
    case STR_IS_ASCII:
	strClassType = STR_CLASS_ASCII;
	goto compileStrClass;
    case STR_IS_CONTROL:
	strClassType = STR_CLASS_CONTROL;
	goto compileStrClass;
    case STR_IS_DIGIT:
	strClassType = STR_CLASS_DIGIT;
	goto compileStrClass;
    case STR_IS_GRAPH:
	strClassType = STR_CLASS_GRAPH;
	goto compileStrClass;
    case STR_IS_LOWER:
	strClassType = STR_CLASS_LOWER;
	goto compileStrClass;
    case STR_IS_PRINT:
	strClassType = STR_CLASS_PRINT;
	goto compileStrClass;
    case STR_IS_PUNCT:
	strClassType = STR_CLASS_PUNCT;
	goto compileStrClass;
    case STR_IS_SPACE:
	strClassType = STR_CLASS_SPACE;
	goto compileStrClass;
    case STR_IS_UPPER:
	strClassType = STR_CLASS_UPPER;
	goto compileStrClass;
    case STR_IS_WORD:
	strClassType = STR_CLASS_WORD;
	goto compileStrClass;
    case STR_IS_XDIGIT:
	strClassType = STR_CLASS_XDIGIT;
    compileStrClass:
	if (allowEmpty) {
	    OP1(	STR_CLASS, strClassType);
	} else {
	    int over, over2;

	    OP(		DUP);
	    OP1(	STR_CLASS, strClassType);
	    JUMP1(	JUMP_TRUE, over);
	    OP(		POP);
	    PUSH(	"0");
	    JUMP1(	JUMP, over2);
	    FIXJUMP1(over);
	    PUSH(	"");
	    OP(		STR_NEQ);
	    FIXJUMP1(over2);
	}
	return TCL_OK;

    case STR_IS_BOOL:
    case STR_IS_FALSE:
    case STR_IS_TRUE:
	OP(		TRY_CVT_TO_BOOLEAN);
	switch (t) {
	    int over, over2;

	case STR_IS_BOOL:
	    if (allowEmpty) {
		JUMP1(	JUMP_TRUE, over);
		PUSH(	"");
		OP(	STR_EQ);
		JUMP1(	JUMP, over2);
		FIXJUMP1(over);
		OP(	POP);
		PUSH(	"1");
		FIXJUMP1(over2);
	    } else {
		OP4(	REVERSE, 2);
		OP(	POP);
	    }
	    return TCL_OK;
	case STR_IS_TRUE:
	    JUMP1(	JUMP_TRUE, over);
	    if (allowEmpty) {
		PUSH(	"");
		OP(	STR_EQ);
	    } else {
		OP(	POP);
		PUSH(	"0");
	    }
	    FIXJUMP1(	over);
	    OP(		LNOT);
	    OP(		LNOT);
	    return TCL_OK;
	case STR_IS_FALSE:
	    JUMP1(	JUMP_TRUE, over);
	    if (allowEmpty) {
		PUSH(	"");
		OP(	STR_NEQ);
	    } else {
		OP(	POP);
		PUSH(	"1");
	    }
	    FIXJUMP1(	over);
	    OP(		LNOT);
	    return TCL_OK;
	}
    break;

    case STR_IS_DOUBLE: {
	int satisfied, isEmpty;

	if (allowEmpty) {
	    OP(		DUP);
	    PUSH(	"");
	    OP(		STR_EQ);
	    JUMP1(	JUMP_TRUE, isEmpty);
	    OP(		NUM_TYPE);
	    JUMP1(	JUMP_TRUE, satisfied);
	    PUSH(	"0");
	    JUMP1(	JUMP, end);
	    FIXJUMP1(	isEmpty);
	    OP(		POP);
	    FIXJUMP1(	satisfied);
	} else {
	    OP(		NUM_TYPE);
	    JUMP1(	JUMP_TRUE, satisfied);
	    PUSH(	"0");
	    JUMP1(	JUMP, end);
	    TclAdjustStackDepth(-1, envPtr);
	    FIXJUMP1(	satisfied);
	}
	PUSH(		"1");
	FIXJUMP1(	end);
	return TCL_OK;
    }

    case STR_IS_INT:
    case STR_IS_WIDE:
    case STR_IS_ENTIER:
	if (allowEmpty) {
	    int testNumType;

	    OP(		DUP);
	    OP(		NUM_TYPE);
	    OP(		DUP);
	    JUMP1(	JUMP_TRUE, testNumType);
	    OP(		POP);
	    PUSH(	"");
	    OP(		STR_EQ);
	    JUMP1(	JUMP, end);
	    TclAdjustStackDepth(1, envPtr);
	    FIXJUMP1(	testNumType);
	    OP4(	REVERSE, 2);
	    OP(		POP);
	} else {
	    OP(		NUM_TYPE);
	    OP(		DUP);
	    JUMP1(	JUMP_FALSE, end);
	}

	switch (t) {
	case STR_IS_WIDE:
	    PUSH(	"2");
	    OP(		LE);
	    break;
	case STR_IS_INT:
	case STR_IS_ENTIER:
	    PUSH(	"3");
	    OP(		LE);
	    break;
	}
	FIXJUMP1(	end);
	return TCL_OK;
    case STR_IS_DICT:
	range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	OP4(		BEGIN_CATCH4, range);
	ExceptionRangeStarts(envPtr, range);
	OP(		DUP);
	OP(		DICT_VERIFY);
	ExceptionRangeEnds(envPtr, range);
	ExceptionRangeTarget(envPtr, range, catchOffset);
	OP(		POP);
	OP(		PUSH_RETURN_CODE);
	OP(		END_CATCH);
	OP(		LNOT);
	return TCL_OK;
    case STR_IS_LIST:
	range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	OP4(		BEGIN_CATCH4, range);
	ExceptionRangeStarts(envPtr, range);
	OP(		DUP);
	OP(		LIST_LENGTH);
	OP(		POP);
	ExceptionRangeEnds(envPtr, range);
	ExceptionRangeTarget(envPtr, range, catchOffset);
	OP(		POP);
	OP(		PUSH_RETURN_CODE);
	OP(		END_CATCH);
	OP(		LNOT);
	return TCL_OK;
    }

    return TclCompileBasicMin0ArgCmd(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileStringMatchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
	size_t length;
    int i, exactMatch = 0, nocase = 0;
    const char *str;

    if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Check if we have a -nocase flag.
     */

    if (parsePtr->numWords == 4) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	str = tokenPtr[1].start;
	length = tokenPtr[1].size;
	if ((length <= 1) || strncmp(str, "-nocase", length)) {
	    /*
	     * Fail at run time, not in compilation.
	     */

	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
	}
	nocase = 1;
	tokenPtr = TokenAfter(tokenPtr);
    }

    /*
     * Push the strings to match against each other.
     */

    for (i = 0; i < 2; i++) {
	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    str = tokenPtr[1].start;
	    length = tokenPtr[1].size;
	    if (!nocase && (i == 0)) {
		/*
		 * Trivial matches can be done by 'string equal'. If -nocase
		 * was specified, we can't do this because INST_STR_EQ has no
		 * support for nocase.
		 */

		Tcl_Obj *copy = Tcl_NewStringObj(str, length);

		Tcl_IncrRefCount(copy);
		exactMatch = TclMatchIsTrivial(TclGetString(copy));
		TclDecrRefCount(copy);
	    }
	    PushLiteral(envPtr, str, length);
	} else {
	    SetLineInformation(i+1+nocase);
	    CompileTokens(envPtr, tokenPtr, interp);
	}
	tokenPtr = TokenAfter(tokenPtr);
    }

    /*
     * Push the matcher.
     */

    if (exactMatch) {
	TclEmitOpcode(INST_STR_EQ, envPtr);
    } else {
	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
    }
    return TCL_OK;
}

int
TclCompileStringLenCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;
    Tcl_Obj *objPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    TclNewObj(objPtr);
    if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
	/*
	 * Here someone is asking for the length of a static string (or
	 * something with backslashes). Just push the actual character (not
	 * byte) length.
	 */

	char buf[TCL_INTEGER_SPACE];
	size_t len = Tcl_GetCharLength(objPtr);

	len = sprintf(buf, "%" TCL_Z_MODIFIER "d", len);
	PushLiteral(envPtr, buf, len);
    } else {
	SetLineInformation(1);
	CompileTokens(envPtr, tokenPtr, interp);
	TclEmitOpcode(INST_STR_LEN, envPtr);
    }
    TclDecrRefCount(objPtr);
    return TCL_OK;
}

int
TclCompileStringMapCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *mapTokenPtr, *stringTokenPtr;
    Tcl_Obj *mapObj, **objv;
    const char *bytes;
    int len;
    size_t slen;

    /*
     * We only handle the case:
     *
     *    string map {foo bar} $thing
     *
     * That is, a literal two-element list (doesn't need to be brace-quoted,
     * but does need to be compile-time knowable) and any old argument (the
     * thing to map).
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }
    mapTokenPtr = TokenAfter(parsePtr->tokenPtr);
    stringTokenPtr = TokenAfter(mapTokenPtr);
    TclNewObj(mapObj);
    Tcl_IncrRefCount(mapObj);
    if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) {
	Tcl_DecrRefCount(mapObj);
	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) {
	Tcl_DecrRefCount(mapObj);
	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    } else if (len != 2) {
	Tcl_DecrRefCount(mapObj);
	return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    /*
     * Now issue the opcodes. Note that in the case that we know that the
     * first word is an empty word, we don't issue the map at all. That is the
     * correct semantics for mapping.
     */

    bytes = TclGetStringFromObj(objv[0], &slen);
    if (slen == 0) {
	CompileWord(envPtr, stringTokenPtr, interp, 2);
    } else {
	PushLiteral(envPtr, bytes, slen);
	bytes = TclGetStringFromObj(objv[1], &slen);
	PushLiteral(envPtr, bytes, slen);
	CompileWord(envPtr, stringTokenPtr, interp, 2);
	OP(STR_MAP);
    }
    Tcl_DecrRefCount(mapObj);
    return TCL_OK;
}

int
TclCompileStringRangeCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *stringTokenPtr, *fromTokenPtr, *toTokenPtr;
    int idx1, idx2;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    stringTokenPtr = TokenAfter(parsePtr->tokenPtr);
    fromTokenPtr = TokenAfter(stringTokenPtr);
    toTokenPtr = TokenAfter(fromTokenPtr);

    /* Every path must push the string argument */
    CompileWord(envPtr, stringTokenPtr,			interp, 1);

    /*
     * Parse the two indices.
     */

    if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
	    &idx1) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices before
     * the string the same as the start of the string.
     */

    if (idx1 == (int)TCL_INDEX_NONE) {
	/* [string range $s end+1 $last] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
	    &idx2) != TCL_OK) {
	goto nonConstantIndices;
    }
    /*
     * Token parsed as an index expression. We treat all indices after
     * the string the same as the end of the string.
     */
    if (idx2 == (int)TCL_INDEX_NONE) {
	/* [string range $s $first -1] must be empty string */
	OP(		POP);
	PUSH(		"");
	return TCL_OK;
    }

    /*
     * Push the operand onto the stack and then the substring operation.
     */

    OP44(		STR_RANGE_IMM, idx1, idx2);
    return TCL_OK;

    /*
     * Push the operands onto the stack and then the substring operation.
     */

  nonConstantIndices:
    CompileWord(envPtr, fromTokenPtr,			interp, 2);
    CompileWord(envPtr, toTokenPtr,			interp, 3);
    OP(			STR_RANGE);
    return TCL_OK;
}

int
TclCompileStringReplaceCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for context. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr, *valueTokenPtr;
    int first, last;

    if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
	return TCL_ERROR;
    }

    /* Bytecode to compute/push string argument being replaced */
    valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, valueTokenPtr, interp, 1);

    /*
     * Check for first index known and useful at compile time.
     */
    tokenPtr = TokenAfter(valueTokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
	    &first) != TCL_OK) {
	goto genericReplace;
    }

    /*
     * Check for last index known and useful at compile time.
     */
    tokenPtr = TokenAfter(tokenPtr);
    if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
	    &last) != TCL_OK) {
	goto genericReplace;
    }

    /*
     * [string replace] is an odd bird.  For many arguments it is
     * a conventional substring replacer.  However it also goes out
     * of its way to become a no-op for many cases where it would be
     * replacing an empty substring.  Precisely, it is a no-op when
     *
     *		(last < first)		OR
     *		(last < 0)		OR
     *		(end < first)
     *
     * For some compile-time values we can detect these cases, and
     * compile direct to bytecode implementing the no-op.
     */

    if ((last == (int)TCL_INDEX_NONE)		/* Know (last < 0) */
	    || (first == (int)TCL_INDEX_NONE)	/* Know (first > end) */

	/*
	 * Tricky to determine when runtime (last < first) can be
	 * certainly known based on the encoded values. Consider the
	 * cases...
	 *
	 * (first <= TCL_INDEX_END) &&
	 *	(last <= TCL_INDEX END) && (last < first) => ACCEPT
	 *	else => cannot tell REJECT
	 */
	    || ((first <= (int)TCL_INDEX_END) && (last <= (int)TCL_INDEX_END)
		&& (last < first))		/* Know (last < first) */
	/*
	 * (first == TCL_INDEX_NONE) &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else		=> (first < last) REJECT
	 *
	 * else [[first >= TCL_INDEX_START]] &&
	 *	(last <= TCL_INDEX_END) => cannot tell REJECT
	 *	else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
	 */
	    || ((first >= (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)
		&& (last < first))) {		/* Know (last < first) */
	if (parsePtr->numWords == 5) {
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	    OP(		POP);		/* Pop newString */
	}
	/* Original string argument now on TOS as result */
	return TCL_OK;
    }

    if (parsePtr->numWords == 5) {
    /*
     * When we have a string replacement, we have to take care about
     * not replacing empty substrings that [string replace] promises
     * not to replace
     *
     * The remaining index values might be suitable for conventional
     * string replacement, but only if they cannot possibly meet the
     * conditions described above at runtime. If there's a chance they
     * might, we would have to emit bytecode to check and at that point
     * we're paying more in bytecode execution time than would make
     * things worthwhile. Trouble is we are very limited in
     * how much we can detect that at compile time. After decoding,
     * we need, first:
     *
     *		(first <= end)
     *
     * The encoded indices (first <= TCL_INDEX END) and
     * (first == TCL_INDEX_NONE) always meets this condition, but
     * any other encoded first index has some list for which it fails.
     *
     * We also need, second:
     *
     *		(last >= 0)
     *
     * The encoded index (last >= TCL_INDEX_START) always meet this
     * condition but any other encoded last index has some list for
     * which it fails.
     *
     * Finally we need, third:
     *
     *		(first <= last)
     *
     * Considered in combination with the constraints we already have,
     * we see that we can proceed when (first == TCL_INDEX_NONE).
     * These also permit simplification of the prefix|replace|suffix
     * construction. The other constraints, though, interfere with
     * getting a guarantee that first <= last.
     */

    if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
	/* empty prefix */
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP4(		REVERSE, 2);
	if (last == INT_MAX) {
	    OP(		POP);		/* Pop  original */
	} else {
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	}
	return TCL_OK;
    }

    if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
	OP44(		STR_RANGE_IMM, 0, first-1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 4);
	OP1(		STR_CONCAT1, 2);
	return TCL_OK;
    }

	/* FLOW THROUGH TO genericReplace */

    } else {
	/*
	 * When we have no replacement string to worry about, we may
	 * have more luck, because the forbidden empty string replacements
	 * are harmless when they are replaced by another empty string.
	 */

	if (first == (int)TCL_INDEX_START) {
	    /* empty prefix - build suffix only */

	    if (last == (int)TCL_INDEX_END) {
		/* empty suffix too => empty result */
		OP(	POP);		/* Pop  original */
		PUSH	(	"");
		return TCL_OK;
	    }
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    return TCL_OK;
	} else {
	    if (last == (int)TCL_INDEX_END) {
		/* empty suffix - build prefix only */
		OP44(	STR_RANGE_IMM, 0, first-1);
		return TCL_OK;
	    }
	    OP(		DUP);
	    OP44(	STR_RANGE_IMM, 0, first-1);
	    OP4(	REVERSE, 2);
	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
	    OP1(	STR_CONCAT1, 2);
	    return TCL_OK;
	}
    }

    genericReplace:
	tokenPtr = TokenAfter(valueTokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 3);
	if (parsePtr->numWords == 5) {
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, 4);
	} else {
	    PUSH(	"");
	}
	OP(		STR_REPLACE);
	return TCL_OK;
}

int
TclCompileStringTrimLCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
    if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr,			interp, 2);
    } else {
	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
    }
    OP(			STR_TRIM_LEFT);
    return TCL_OK;
}

int
TclCompileStringTrimRCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
    if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr,			interp, 2);
    } else {
	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
    }
    OP(			STR_TRIM_RIGHT);
    return TCL_OK;
}

int
TclCompileStringTrimCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
    if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr,			interp, 2);
    } else {
	PushLiteral(envPtr, tclDefaultTrimSet, strlen(tclDefaultTrimSet));
    }
    OP(			STR_TRIM);
    return TCL_OK;
}

int
TclCompileStringToUpperCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2) {
	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
    OP(			STR_UPPER);
    return TCL_OK;
}

int
TclCompileStringToLowerCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2) {
	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
    OP(			STR_LOWER);
    return TCL_OK;
}

int
TclCompileStringToTitleCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2) {
	return TclCompileBasic1To3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
    }

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr,			interp, 1);
    OP(			STR_TITLE);
    return TCL_OK;
}

/*
 * Support definitions for the [string is] compilation.
 */

static int
UniCharIsAscii(
    int character)
{
    return (character >= 0) && (character < 0x80);
}

static int
UniCharIsHexDigit(
    int character)
{
    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}

StringClassDesc const tclStringClassTable[] = {
    {"alnum",	Tcl_UniCharIsAlnum},
    {"alpha",	Tcl_UniCharIsAlpha},
    {"ascii",	UniCharIsAscii},
    {"control", Tcl_UniCharIsControl},
    {"digit",	Tcl_UniCharIsDigit},
    {"graph",	Tcl_UniCharIsGraph},
    {"lower",	Tcl_UniCharIsLower},
    {"print",	Tcl_UniCharIsPrint},
    {"punct",	Tcl_UniCharIsPunct},
    {"space",	Tcl_UniCharIsSpace},
    {"upper",	Tcl_UniCharIsUpper},
    {"word",	Tcl_UniCharIsWordChar},
    {"xdigit",	UniCharIsHexDigit},
    {"",	NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSubstCmd --
 *
 *	Procedure called to compile the "subst" command.
 *
 * Results:
 *	Returns TCL_OK for successful compile, or TCL_ERROR to defer
 *	evaluation to runtime (either when it is too complex to get the
 *	semantics right, or when we know for sure that it is an error but need
 *	the error to happen at the right time).
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "subst" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSubstCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int numArgs = parsePtr->numWords - 1;
    int numOpts = numArgs - 1;
    int objc, flags = TCL_SUBST_ALL;
    Tcl_Obj **objv/*, *toSubst = NULL*/;
    Tcl_Token *wordTokenPtr = TokenAfter(parsePtr->tokenPtr);
    int code = TCL_ERROR;

    if (numArgs == 0) {
	return TCL_ERROR;
    }

    objv = (Tcl_Obj **)TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *));

    for (objc = 0; objc < /*numArgs*/ numOpts; objc++) {
	TclNewObj(objv[objc]);
	Tcl_IncrRefCount(objv[objc]);
	if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) {
	    objc++;
	    goto cleanup;
	}
	wordTokenPtr = TokenAfter(wordTokenPtr);
    }

/*
    if (TclSubstOptions(NULL, numOpts, objv, &flags) == TCL_OK) {
	toSubst = objv[numOpts];
	Tcl_IncrRefCount(toSubst);
    }
*/

    /* TODO: Figure out expansion to cover WordKnownAtCompileTime
     *	The difficulty is that WKACT makes a copy, and if TclSubstParse
     *	below parses the copy of the original source string, some deep
     *	parts of the compile machinery get upset.  They want all pointers
     *	stored in Tcl_Tokens to point back to the same original string.
     */
    if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	code = TclSubstOptions(NULL, numOpts, objv, &flags);
    }

  cleanup:
    while (--objc >= 0) {
	TclDecrRefCount(objv[objc]);
    }
    TclStackFree(interp, objv);
    if (/*toSubst == NULL*/ code != TCL_OK) {
	return TCL_ERROR;
    }

    SetLineInformation(numArgs);
    TclSubstCompile(interp, wordTokenPtr[1].start, wordTokenPtr[1].size,
	    flags, mapPtr->loc[eclIndex].line[numArgs], envPtr);

/*    TclDecrRefCount(toSubst);*/
    return TCL_OK;
}

void
TclSubstCompile(
    Tcl_Interp *interp,
    const char *bytes,
    size_t numBytes,
    int flags,
    int line,
    CompileEnv *envPtr)
{
    Tcl_Token *endTokenPtr, *tokenPtr;
    int breakOffset = 0, count = 0, bline = line;
    Tcl_Parse parse;
    Tcl_InterpState state = NULL;

    TclSubstParse(interp, bytes, numBytes, flags, &parse, &state);
    if (state != NULL) {
	Tcl_ResetResult(interp);
    }

    /*
     * Tricky point! If the first token does not result in a *guaranteed* push
     * of a Tcl_Obj on the stack, we must push an empty object. Otherwise it
     * is possible to get to an INST_STR_CONCAT1 or INST_DONE without enough
     * values on the stack, resulting in a crash. Thanks to Joe Mistachkin for
     * identifying a script that could trigger this case.
     */

    tokenPtr = parse.tokenPtr;
    if (tokenPtr->type != TCL_TOKEN_TEXT && tokenPtr->type != TCL_TOKEN_BS) {
	PUSH("");
	count++;
    }

    for (endTokenPtr = tokenPtr + parse.numTokens;
	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
	size_t length;
	int literal, catchRange, breakJump;
	char buf[4] = "";
	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
	JumpFixup continueFixup, otherFixup, endFixup;

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    literal = TclRegisterLiteral(envPtr,
		    tokenPtr->start, tokenPtr->size, 0);
	    TclEmitPush(literal, envPtr);
	    TclAdvanceLines(&bline, tokenPtr->start,
		    tokenPtr->start + tokenPtr->size);
	    count++;
	    continue;
	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buf);
	    literal = TclRegisterLiteral(envPtr, buf, length, 0);
	    TclEmitPush(literal, envPtr);
	    count++;
	    continue;
	case TCL_TOKEN_VARIABLE:
	    /*
	     * Check for simple variable access; see if we can only generate
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
	     * there is no need to generate elaborate exception-management
	     * code. Note that the first component of TCL_TOKEN_VARIABLE is
	     * always TCL_TOKEN_TEXT...
	     */

	    if (tokenPtr->numComponents > 1) {
		size_t i;
		int foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
			foundCommand = 1;
			break;
		    }
		}
		if (foundCommand) {
		    break;
		}
	    }

	    envPtr->line = bline;
	    TclCompileVarSubst(interp, tokenPtr, envPtr);
	    bline = envPtr->line;
	    count++;
	    continue;
	}

	while (count > 255) {
	    OP1(		STR_CONCAT1, 255);
	    count -= 254;
	}
	if (count > 1) {
	    OP1(		STR_CONCAT1, count);
	    count = 1;
	}

	if (breakOffset == 0) {
	    /* Jump to the start (jump over the jump to end) */
	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup);

	    /* Jump to the end (all BREAKs land here) */
	    breakOffset = CurrentOffset(envPtr);
	    TclEmitInstInt4(INST_JUMP4, 0, envPtr);

	    /* Start */
	    if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
		Tcl_Panic("TclCompileSubstCmd: bad start jump distance %" TCL_Z_MODIFIER "d",
			CurrentOffset(envPtr) - startFixup.codeOffset);
	    }
	}

	envPtr->line = bline;
	catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	OP4(	BEGIN_CATCH4, catchRange);
	ExceptionRangeStarts(envPtr, catchRange);

	switch (tokenPtr->type) {
	case TCL_TOKEN_COMMAND:
	    TclCompileScript(interp, tokenPtr->start+1, tokenPtr->size-2,
		    envPtr);
	    count++;
	    break;
	case TCL_TOKEN_VARIABLE:
	    TclCompileVarSubst(interp, tokenPtr, envPtr);
	    count++;
	    break;
	default:
	    Tcl_Panic("unexpected token type in TclCompileSubstCmd: %d",
		    tokenPtr->type);
	}

	ExceptionRangeEnds(envPtr, catchRange);

	/* Substitution produced TCL_OK */
	OP(	END_CATCH);
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
	TclAdjustStackDepth(-1, envPtr);

	/* Exceptional return codes processed here */
	ExceptionRangeTarget(envPtr, catchRange, catchOffset);
	OP(	PUSH_RETURN_OPTIONS);
	OP(	PUSH_RESULT);
	OP(	PUSH_RETURN_CODE);
	OP(	END_CATCH);
	OP(	RETURN_CODE_BRANCH);

	/* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
	OP(	RETURN_STK);
	OP(	NOP);

	/* RETURN */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);

	/* BREAK */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &breakFixup);

	/* CONTINUE */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &continueFixup);

	/* OTHER */
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &otherFixup);

	TclAdjustStackDepth(1, envPtr);
	/* BREAK destination */
	if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - breakFixup.codeOffset);
	}
	OP(	POP);
	OP(	POP);

	breakJump = CurrentOffset(envPtr) - breakOffset;
	if (breakJump > 127) {
	    OP4(JUMP4, -breakJump);
	} else {
	    OP1(JUMP1, -breakJump);
	}

	TclAdjustStackDepth(2, envPtr);
	/* CONTINUE destination */
	if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - continueFixup.codeOffset);
	}
	OP(	POP);
	OP(	POP);
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &endFixup);

	TclAdjustStackDepth(2, envPtr);
	/* RETURN + other destination */
	if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad return jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - returnFixup.codeOffset);
	}
	if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad other jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - otherFixup.codeOffset);
	}

	/*
	 * Pull the result to top of stack, discard options dict.
	 */

	OP4(	REVERSE, 2);
	OP(	POP);

	/* OK destination */
	if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - okFixup.codeOffset);
	}
	if (count > 1) {
	    OP1(STR_CONCAT1, count);
	    count = 1;
	}

	/* CONTINUE jump to here */
	if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
	    Tcl_Panic("TclCompileSubstCmd: bad end jump distance %" TCL_Z_MODIFIER "d",
		    CurrentOffset(envPtr) - endFixup.codeOffset);
	}
	bline = envPtr->line;
    }

    while (count > 255) {
	OP1(	STR_CONCAT1, 255);
	count -= 254;
    }
    if (count > 1) {
	OP1(	STR_CONCAT1, count);
    }

    Tcl_FreeParse(&parse);

    if (state != NULL) {
	Tcl_RestoreInterpState(interp, state);
	TclCompileSyntaxError(interp, envPtr);
	TclAdjustStackDepth(-1, envPtr);
    }

    /* Final target of the multi-jump from all BREAKs */
    if (breakOffset > 0) {
	TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset,
		envPtr->codeStart + breakOffset);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileSwitchCmd --
 *
 *	Procedure called to compile the "switch" command.
 *
 * Results:
 *	Returns TCL_OK for successful compile, or TCL_ERROR to defer
 *	evaluation to runtime (either when it is too complex to get the
 *	semantics right, or when we know for sure that it is an error but need
 *	the error to happen at the right time).
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "switch" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileSwitchCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;	/* Pointer to tokens in command. */
    int numWords;		/* Number of words in command. */

    Tcl_Token *valueTokenPtr;	/* Token for the value to switch on. */
    enum {Switch_Exact, Switch_Glob, Switch_Regexp} mode;
				/* What kind of switch are we doing? */

    Tcl_Token *bodyTokenArray;	/* Array of real pattern list items. */
    Tcl_Token **bodyToken;	/* Array of pointers to pattern list items. */
    int *bodyLines;		/* Array of line numbers for body list
				 * items. */
    int **bodyContLines;	/* Array of continuation line info. */
    int noCase;			/* Has the -nocase flag been given? */
    int foundMode = 0;		/* Have we seen a mode flag yet? */
    int i, valueIndex;
    int result = TCL_ERROR;
    int *clNext = envPtr->clNext;

    /*
     * Only handle the following versions:
     *   switch         ?--? word {pattern body ...}
     *   switch -exact  ?--? word {pattern body ...}
     *   switch -glob   ?--? word {pattern body ...}
     *   switch -regexp ?--? word {pattern body ...}
     *   switch         --   word simpleWordPattern simpleWordBody ...
     *   switch -exact  --   word simpleWordPattern simpleWordBody ...
     *   switch -glob   --   word simpleWordPattern simpleWordBody ...
     *   switch -regexp --   word simpleWordPattern simpleWordBody ...
     * When the mode is -glob, can also handle a -nocase flag.
     *
     * First off, we don't care how the command's word was generated; we're
     * compiling it anyway! So skip it...
     */

    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    valueIndex = 1;
    numWords = parsePtr->numWords-1;

    /*
     * Check for options.
     */

    noCase = 0;
    mode = Switch_Exact;
    if (numWords == 2) {
	/*
	 * There's just the switch value and the bodies list. In that case, we
	 * can skip all option parsing and move on to consider switch values
	 * and the body list.
	 */

	goto finishedOptionParse;
    }

    /*
     * There must be at least one option, --, because without that there is no
     * way to statically avoid the problems you get from strings-to-be-matched
     * that start with a - (the interpreted code falls apart if it encounters
     * them, so we punt if we *might* encounter them as that is the easiest
     * way of emulating the behaviour).
     */

    for (; numWords>=3 ; tokenPtr=TokenAfter(tokenPtr),numWords--) {
	size_t size = tokenPtr[1].size;
	const char *chrs = tokenPtr[1].start;

	/*
	 * We only process literal options, and we assume that -e, -g and -n
	 * are unique prefixes of -exact, -glob and -nocase respectively (true
	 * at time of writing). Note that -exact and -glob may only be given
	 * at most once or we bail out (error case).
	 */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || size < 2) {
	    return TCL_ERROR;
	}

	if ((size <= 6) && !memcmp(chrs, "-exact", size)) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Exact;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if ((size <= 5) && !memcmp(chrs, "-glob", size)) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Glob;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if ((size <= 7) && !memcmp(chrs, "-regexp", size)) {
	    if (foundMode) {
		return TCL_ERROR;
	    }
	    mode = Switch_Regexp;
	    foundMode = 1;
	    valueIndex++;
	    continue;
	} else if ((size <= 7) && !memcmp(chrs, "-nocase", size)) {
	    noCase = 1;
	    valueIndex++;
	    continue;
	} else if ((size == 2) && !memcmp(chrs, "--", 2)) {
	    valueIndex++;
	    break;
	}

	/*
	 * The switch command has many flags we cannot compile at all (e.g.
	 * all the RE-related ones) which we must have encountered. Either
	 * that or we have run off the end. The action here is the same: punt
	 * to interpreted version.
	 */

	return TCL_ERROR;
    }
    if (numWords < 3) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(tokenPtr);
    numWords--;
    if (noCase && (mode == Switch_Exact)) {
	/*
	 * Can't compile this case; no opcode for case-insensitive equality!
	 */

	return TCL_ERROR;
    }

    /*
     * The value to test against is going to always get pushed on the stack.
     * But not yet; we need to verify that the rest of the command is
     * compilable too.
     */

  finishedOptionParse:
    valueTokenPtr = tokenPtr;
    /* For valueIndex, see previous loop. */
    tokenPtr = TokenAfter(tokenPtr);
    numWords--;

    /*
     * Build an array of tokens for the matcher terms and script bodies. Note
     * that in the case of the quoted bodies, this is tricky as we cannot use
     * copies of the string from the input token for the generated tokens (it
     * causes a crash during exception handling). When multiple tokens are
     * available at this point, this is pretty easy.
     */

    if (numWords == 1) {
	const char *bytes;
	size_t maxLen, numBytes;
	int bline;		/* TIP #280: line of the pattern/action list,
				 * and start of list for when tracking the
				 * location. This list comes immediately after
				 * the value we switch on. */

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    return TCL_ERROR;
	}
	bytes = tokenPtr[1].start;
	numBytes = tokenPtr[1].size;

	/* Allocate enough space to work in. */
	maxLen = TclMaxListLength(bytes, numBytes, NULL);
	if (maxLen < 2)  {
	    return TCL_ERROR;
	}
	bodyTokenArray = (Tcl_Token *)Tcl_Alloc(sizeof(Tcl_Token) * maxLen);
	bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * maxLen);
	bodyLines = (int *)Tcl_Alloc(sizeof(int) * maxLen);
	bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * maxLen);

	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
	numWords = 0;

	while (numBytes > 0) {
	    const char *prevBytes = bytes;
	    int literal;

	    if (TCL_OK != TclFindElement(NULL, bytes, numBytes,
		    &(bodyTokenArray[numWords].start), &bytes,
		    &(bodyTokenArray[numWords].size), &literal) || !literal) {
		goto abort;
	    }

	    bodyTokenArray[numWords].type = TCL_TOKEN_TEXT;
	    bodyTokenArray[numWords].numComponents = 0;
	    bodyToken[numWords] = bodyTokenArray + numWords;

	    /*
	     * TIP #280: Now determine the line the list element starts on
	     * (there is no need to do it earlier, due to the possibility of
	     * aborting, see above).
	     */

	    TclAdvanceLines(&bline, prevBytes, bodyTokenArray[numWords].start);
	    TclAdvanceContinuations(&bline, &clNext,
		    bodyTokenArray[numWords].start - envPtr->source);
	    bodyLines[numWords] = bline;
	    bodyContLines[numWords] = clNext;
	    TclAdvanceLines(&bline, bodyTokenArray[numWords].start, bytes);
	    TclAdvanceContinuations(&bline, &clNext, bytes - envPtr->source);

	    numBytes -= (bytes - prevBytes);
	    numWords++;
	}
	if (numWords % 2) {
	abort:
	    Tcl_Free(bodyToken);
	    Tcl_Free(bodyTokenArray);
	    Tcl_Free(bodyLines);
	    Tcl_Free(bodyContLines);
	    return TCL_ERROR;
	}
    } else if (numWords % 2 || numWords == 0) {
	/*
	 * Odd number of words (>1) available, or no words at all available.
	 * Both are error cases, so punt and let the interpreted-version
	 * generate the error message. Note that the second case probably
	 * should get caught earlier, but it's easy to check here again anyway
	 * because it'd cause a nasty crash otherwise.
	 */

	return TCL_ERROR;
    } else {
	/*
	 * Multi-word definition of patterns & actions.
	 */

	bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * numWords);
	bodyLines = (int *)Tcl_Alloc(sizeof(int) * numWords);
	bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * numWords);
	bodyTokenArray = NULL;
	for (i=0 ; i<numWords ; i++) {
	    /*
	     * We only handle the very simplest case. Anything more complex is
	     * a good reason to go to the interpreted case anyway due to
	     * traces, etc.
	     */

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto freeTemporaries;
	    }
	    bodyToken[i] = tokenPtr+1;

	    /*
	     * TIP #280: Copy line information from regular cmd info.
	     */

	    bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i];
	    bodyContLines[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i];
	    tokenPtr = TokenAfter(tokenPtr);
	}
    }

    /*
     * Fall back to interpreted if the last body is a continuation (it's
     * illegal, but this makes the error happen at the right time).
     */

    if (bodyToken[numWords-1]->size == 1 &&
	    bodyToken[numWords-1]->start[0] == '-') {
	goto freeTemporaries;
    }

    /*
     * Now we commit to generating code; the parsing stage per se is done.
     * Check if we can generate a jump table, since if so that's faster than
     * doing an explicit compare with each body. Note that we're definitely
     * over-conservative with determining whether we can do the jump table,
     * but it handles the most common case well enough.
     */

    /* Both methods push the value to match against onto the stack. */
    CompileWord(envPtr, valueTokenPtr, interp, valueIndex);

    if (mode == Switch_Exact) {
	IssueSwitchJumpTable(interp, envPtr, numWords, bodyToken,
		bodyLines, bodyContLines);
    } else {
	IssueSwitchChainedTests(interp, envPtr, mode, noCase,
		numWords, bodyToken, bodyLines, bodyContLines);
    }
    result = TCL_OK;

    /*
     * Clean up all our temporary space and return.
     */

  freeTemporaries:
    Tcl_Free(bodyToken);
    Tcl_Free(bodyLines);
    Tcl_Free(bodyContLines);
    if (bodyTokenArray != NULL) {
	Tcl_Free(bodyTokenArray);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * IssueSwitchChainedTests --
 *
 *	Generate instructions for a [switch] command that is to be compiled
 *	into a sequence of tests. This is the generic handle-everything mode
 *	that inherently has performance that is (on average) linear in the
 *	number of tests. It is the only mode that can handle -glob and -regexp
 *	matches, or anything that is case-insensitive. It does not handle the
 *	wild-and-wooly end of regexp matching (i.e., capture of match results)
 *	so that's when we spill to the interpreted version.
 *
 *----------------------------------------------------------------------
 */

static void
IssueSwitchChainedTests(
    Tcl_Interp *interp,		/* Context for compiling script bodies. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int mode,			/* Exact, Glob or Regexp */
    int noCase,			/* Case-insensitivity flag. */
    int numBodyTokens,		/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    int *bodyLines,		/* Array of line numbers for body list
				 * items. */
    int **bodyContLines)	/* Array of continuation line info. */
{
    enum {Switch_Exact, Switch_Glob, Switch_Regexp};
    int foundDefault;		/* Flag to indicate whether a "default" clause
				 * is present. */
    JumpFixup *fixupArray;	/* Array of forward-jump fixup records. */
    unsigned int *fixupTargetArray; /* Array of places for fixups to point at. */
    int fixupCount;		/* Number of places to fix up. */
    int contFixIndex;		/* Where the first of the jumps due to a group
				 * of continuation bodies starts, or -1 if
				 * there aren't any. */
    int contFixCount;		/* Number of continuation bodies pointing to
				 * the current (or next) real body. */
    int nextArmFixupIndex;
    int simple, exact;		/* For extracting the type of regexp. */
    int i;

    /*
     * Generate a test for each arm.
     */

    contFixIndex = -1;
    contFixCount = 0;
    fixupArray = (JumpFixup *)TclStackAlloc(interp, sizeof(JumpFixup) * numBodyTokens);
    fixupTargetArray = (unsigned int *)TclStackAlloc(interp, sizeof(int) * numBodyTokens);
    memset(fixupTargetArray, 0, numBodyTokens * sizeof(int));
    fixupCount = 0;
    foundDefault = 0;
    for (i=0 ; i<numBodyTokens ; i+=2) {
	nextArmFixupIndex = -1;
	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
		memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
	    /*
	     * Generate the test for the arm.
	     */

	    switch (mode) {
	    case Switch_Exact:
		OP(	DUP);
		TclCompileTokens(interp, bodyToken[i], 1,	envPtr);
		OP(	STR_EQ);
		break;
	    case Switch_Glob:
		TclCompileTokens(interp, bodyToken[i], 1,	envPtr);
		OP4(	OVER, 1);
		OP1(	STR_MATCH, noCase);
		break;
	    case Switch_Regexp:
		simple = exact = 0;

		/*
		 * Keep in sync with TclCompileRegexpCmd.
		 */

		if (bodyToken[i]->type == TCL_TOKEN_TEXT) {
		    Tcl_DString ds;

		    if (bodyToken[i]->size == 0) {
			/*
			 * The semantics of regexps are that they always match
			 * when the RE == "".
			 */

			PUSH("1");
			break;
		    }

		    /*
		     * Attempt to convert pattern to glob. If successful, push
		     * the converted pattern.
		     */

		    if (TclReToGlob(NULL, bodyToken[i]->start,
			    bodyToken[i]->size, &ds, &exact, NULL) == TCL_OK){
			simple = 1;
			PushLiteral(envPtr, Tcl_DStringValue(&ds),
				Tcl_DStringLength(&ds));
			Tcl_DStringFree(&ds);
		    }
		}
		if (!simple) {
		    TclCompileTokens(interp, bodyToken[i], 1, envPtr);
		}

		OP4(	OVER, 1);
		if (!simple) {
		    /*
		     * Pass correct RE compile flags. We use only Int1
		     * (8-bit), but that handles all the flags we want to
		     * pass. Don't use TCL_REG_NOSUB as we may have backrefs
		     * or capture vars.
		     */

		    int cflags = TCL_REG_ADVANCED
			    | (noCase ? TCL_REG_NOCASE : 0);

		    OP1(REGEXP, cflags);
		} else if (exact && !noCase) {
		    OP(	STR_EQ);
		} else {
		    OP1(STR_MATCH, noCase);
		}
		break;
	    default:
		Tcl_Panic("unknown switch mode: %d", mode);
	    }

	    /*
	     * In a fall-through case, we will jump on _true_ to the place
	     * where the body starts (generated later, with guarantee of this
	     * ensured earlier; the final body is never a fall-through).
	     */

	    if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') {
		if (contFixIndex == -1) {
		    contFixIndex = fixupCount;
		    contFixCount = 0;
		}
		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP,
			&fixupArray[contFixIndex+contFixCount]);
		fixupCount++;
		contFixCount++;
		continue;
	    }

	    TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
		    &fixupArray[fixupCount]);
	    nextArmFixupIndex = fixupCount;
	    fixupCount++;
	} else {
	    /*
	     * Got a default clause; set a flag to inhibit the generation of
	     * the jump after the body and the cleanup of the intermediate
	     * value that we are switching against.
	     *
	     * Note that default clauses (which are always terminal clauses)
	     * cannot be fall-through clauses as well, since the last clause
	     * is never a fall-through clause (which we have already
	     * verified).
	     */

	    foundDefault = 1;
	}

	/*
	 * Generate the body for the arm. This is guaranteed not to be a
	 * fall-through case, but it might have preceding fall-through cases,
	 * so we must process those first.
	 */

	if (contFixIndex != -1) {
	    int j;

	    for (j=0 ; j<contFixCount ; j++) {
		fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr);
	    }
	    contFixIndex = -1;
	}

	/*
	 * Now do the actual compilation. Note that we do not use BODY()
	 * because we may have synthesized the tokens in a non-standard
	 * pattern.
	 */

	OP(	POP);
	envPtr->line = bodyLines[i+1];		/* TIP #280 */
	envPtr->clNext = bodyContLines[i+1];	/* TIP #280 */
	TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);

	if (!foundDefault) {
	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
		    &fixupArray[fixupCount]);
	    fixupCount++;
	    fixupTargetArray[nextArmFixupIndex] = CurrentOffset(envPtr);
	}
    }

    /*
     * Discard the value we are matching against unless we've had a default
     * clause (in which case it will already be gone due to the code at the
     * start of processing an arm, guaranteed) and make the result of the
     * command an empty string.
     */

    if (!foundDefault) {
	OP(	POP);
	PUSH("");
    }

    /*
     * Do jump fixups for arms that were executed. First, fill in the jumps of
     * all jumps that don't point elsewhere to point to here.
     */

    for (i=0 ; i<fixupCount ; i++) {
	if (fixupTargetArray[i] == 0) {
	    fixupTargetArray[i] = envPtr->codeNext-envPtr->codeStart;
	}
    }

    /*
     * Now scan backwards over all the jumps (all of which are forward jumps)
     * doing each one. When we do one and there is a size changes, we must
     * scan back over all the previous ones and see if they need adjusting
     * before proceeding with further jump fixups (the interleaved nature of
     * all the jumps makes this impossible to do without nested loops).
     */

    for (i=fixupCount-1 ; i>=0 ; i--) {
	if (TclFixupForwardJump(envPtr, &fixupArray[i],
		fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) {
	    int j;

	    for (j=i-1 ; j>=0 ; j--) {
		if (fixupTargetArray[j] > fixupArray[i].codeOffset) {
		    fixupTargetArray[j] += 3;
		}
	    }
	}
    }
    TclStackFree(interp, fixupTargetArray);
    TclStackFree(interp, fixupArray);
}

/*
 *----------------------------------------------------------------------
 *
 * IssueSwitchJumpTable --
 *
 *	Generate instructions for a [switch] command that is to be compiled
 *	into a jump table. This only handles the case where case-sensitive,
 *	exact matching is used, but this is actually the most common case in
 *	real code.
 *
 *----------------------------------------------------------------------
 */

static void
IssueSwitchJumpTable(
    Tcl_Interp *interp,		/* Context for compiling script bodies. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int numBodyTokens,		/* Number of tokens describing things the
				 * switch can match against and bodies to
				 * execute when the match succeeds. */
    Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
    int *bodyLines,		/* Array of line numbers for body list
				 * items. */
    int **bodyContLines)	/* Array of continuation line info. */
{
    JumptableInfo *jtPtr;
    int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;
    int mustGenerate, foundDefault, jumpToDefault, i;
    Tcl_DString buffer;
    Tcl_HashEntry *hPtr;

    /*
     * Compile the switch by using a jump table, which is basically a
     * hashtable that maps from literal values to match against to the offset
     * (relative to the INST_JUMP_TABLE instruction) to jump to. The jump
     * table itself is independent of any invokation of the bytecode, and as
     * such is stored in an auxData block.
     *
     * Start by allocating the jump table itself, plus some workspace.
     */

    jtPtr = (JumptableInfo *)Tcl_Alloc(sizeof(JumptableInfo));
    Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS);
    infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr);
    finalFixups = (int *)TclStackAlloc(interp, sizeof(int) * (numBodyTokens/2));
    foundDefault = 0;
    mustGenerate = 1;

    /*
     * Next, issue the instruction to do the jump, together with what we want
     * to do if things do not work out (jump to either the default clause or
     * the "default" default, which just sets the result to empty). Note that
     * we will come back and rewrite the jump's offset parameter when we know
     * what it should be, and that all jumps we issue are of the wide kind
     * because that makes the code much easier to debug!
     */

    jumpLocation = CurrentOffset(envPtr);
    OP4(	JUMP_TABLE, infoIndex);
    jumpToDefault = CurrentOffset(envPtr);
    OP4(	JUMP4, 0);

    for (i=0 ; i<numBodyTokens ; i+=2) {
	/*
	 * For each arm, we must first work out what to do with the match
	 * term.
	 */

	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
		memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
	    /*
	     * This is not a default clause, so insert the current location as
	     * a target in the jump table (assuming it isn't already there,
	     * which would indicate that this clause is probably masked by an
	     * earlier one). Note that we use a Tcl_DString here simply
	     * because the hash API does not let us specify the string length.
	     */

	    Tcl_DStringInit(&buffer);
	    TclDStringAppendToken(&buffer, bodyToken[i]);
	    hPtr = Tcl_CreateHashEntry(&jtPtr->hashTable,
		    Tcl_DStringValue(&buffer), &isNew);
	    if (isNew) {
		/*
		 * First time we've encountered this match clause, so it must
		 * point to here.
		 */

		Tcl_SetHashValue(hPtr, CurrentOffset(envPtr) - jumpLocation);
	    }
	    Tcl_DStringFree(&buffer);
	} else {
	    /*
	     * This is a default clause, so patch up the fallthrough from the
	     * INST_JUMP_TABLE instruction to here.
	     */

	    foundDefault = 1;
	    isNew = 1;
	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
		    envPtr->codeStart+jumpToDefault+1);
	}

	/*
	 * Now, for each arm we must deal with the body of the clause.
	 *
	 * If this is a continuation body (never true of a final clause,
	 * whether default or not) we're done because the next jump target
	 * will also point here, so we advance to the next clause.
	 */

	if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') {
	    mustGenerate = 1;
	    continue;
	}

	/*
	 * Also skip this arm if its only match clause is masked. (We could
	 * probably be more aggressive about this, but that would be much more
	 * difficult to get right.)
	 */

	if (!isNew && !mustGenerate) {
	    continue;
	}
	mustGenerate = 0;

	/*
	 * Compile the body of the arm.
	 */

	envPtr->line = bodyLines[i+1];		/* TIP #280 */
	envPtr->clNext = bodyContLines[i+1];	/* TIP #280 */
	TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr);

	/*
	 * Compile a jump in to the end of the command if this body is
	 * anything other than a user-supplied default arm (to either skip
	 * over the remaining bodies or the code that generates an empty
	 * result).
	 */

	if (i+2 < numBodyTokens || !foundDefault) {
	    finalFixups[numRealBodies++] = CurrentOffset(envPtr);

	    /*
	     * Easier by far to issue this jump as a fixed-width jump, since
	     * otherwise we'd need to do a lot more (and more awkward)
	     * rewriting when we fixed this all up.
	     */

	    OP4(	JUMP4, 0);
	    TclAdjustStackDepth(-1, envPtr);
	}
    }

    /*
     * We're at the end. If we've not already done so through the processing
     * of a user-supplied default clause, add in a "default" default clause
     * now.
     */

    if (!foundDefault) {
	TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
		envPtr->codeStart+jumpToDefault+1);
	PUSH("");
    }

    /*
     * No more instructions to be issued; everything that needs to jump to the
     * end of the command is fixed up at this point.
     */

    for (i=0 ; i<numRealBodies ; i++) {
	TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i],
		envPtr->codeStart+finalFixups[i]+1);
    }

    /*
     * Clean up all our temporary space and return.
     */

    TclStackFree(interp, finalFixups);
}

/*
 *----------------------------------------------------------------------
 *
 * DupJumptableInfo, FreeJumptableInfo --
 *
 *	Functions to duplicate, release and print a jump-table created for use
 *	with the INST_JUMP_TABLE instruction.
 *
 * Results:
 *	DupJumptableInfo: a copy of the jump-table
 *	FreeJumptableInfo: none
 *	PrintJumptableInfo: none
 *	DisassembleJumptableInfo: none
 *
 * Side effects:
 *	DupJumptableInfo: allocates memory
 *	FreeJumptableInfo: releases memory
 *	PrintJumptableInfo: none
 *	DisassembleJumptableInfo: none
 *
 *----------------------------------------------------------------------
 */

static ClientData
DupJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    JumptableInfo *newJtPtr = (JumptableInfo *)Tcl_Alloc(sizeof(JumptableInfo));
    Tcl_HashEntry *hPtr, *newHPtr;
    Tcl_HashSearch search;
    int isNew;

    Tcl_InitHashTable(&newJtPtr->hashTable, TCL_STRING_KEYS);
    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    while (hPtr != NULL) {
	newHPtr = Tcl_CreateHashEntry(&newJtPtr->hashTable,
		Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew);
	Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr));
    }
    return newJtPtr;
}

static void
FreeJumptableInfo(
    ClientData clientData)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;

    Tcl_DeleteHashTable(&jtPtr->hashTable);
    Tcl_Free(jtPtr);
}

static void
PrintJumptableInfo(
    ClientData clientData,
    Tcl_Obj *appendObj,
    TCL_UNUSED(ByteCode *),
    unsigned int pcOffset)
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    const char *keyPtr;
    int offset, i = 0;

    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
	keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	offset = PTR2INT(Tcl_GetHashValue(hPtr));

	if (i++) {
	    Tcl_AppendToObj(appendObj, ", ", -1);
	    if (i%4==0) {
		Tcl_AppendToObj(appendObj, "\n\t\t", -1);
	    }
	}
	Tcl_AppendPrintfToObj(appendObj, "\"%s\"->pc %d",
		keyPtr, pcOffset + offset);
    }
}

static void
DisassembleJumptableInfo(
    ClientData clientData,
    Tcl_Obj *dictObj,
    TCL_UNUSED(ByteCode *),
    TCL_UNUSED(unsigned int))
{
    JumptableInfo *jtPtr = (JumptableInfo *)clientData;
    Tcl_Obj *mapping;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    const char *keyPtr;
    size_t offset;

    TclNewObj(mapping);
    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
	keyPtr = (const char *)Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
	offset = PTR2INT(Tcl_GetHashValue(hPtr));
	Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
		Tcl_NewWideIntObj(offset));
    }
    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTailcallCmd --
 *
 *	Procedure called to compile the "tailcall" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "tailcall" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileTailcallCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int i;

    if (parsePtr->numWords < 2 || parsePtr->numWords > 256
	    || envPtr->procPtr == NULL) {
	return TCL_ERROR;
    }

    /* make room for the nsObjPtr */
    /* TODO: Doesn't this have to be a known value? */
    CompileWord(envPtr, tokenPtr, interp, 0);
    for (i=1 ; i<parsePtr->numWords ; i++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, i);
    }
    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords,	envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileThrowCmd --
 *
 *	Procedure called to compile the "throw" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "throw" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileThrowCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    int numWords = parsePtr->numWords;
    Tcl_Token *codeToken, *msgToken;
    Tcl_Obj *objPtr;
    int codeKnown, codeIsList, codeIsValid, len;

    if (numWords != 3) {
	return TCL_ERROR;
    }
    codeToken = TokenAfter(parsePtr->tokenPtr);
    msgToken = TokenAfter(codeToken);

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);

    codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr);

    /*
     * First we must emit the code to substitute the arguments.  This
     * must come first in case substitution raises errors.
     */
    if (!codeKnown) {
	CompileWord(envPtr, codeToken, interp, 1);
	PUSH(			"-errorcode");
    }
    CompileWord(envPtr, msgToken, interp, 2);

    codeIsList = codeKnown && (TCL_OK ==
	    Tcl_ListObjLength(interp, objPtr, &len));
    codeIsValid = codeIsList && (len != 0);

    if (codeIsValid) {
	Tcl_Obj *errPtr, *dictPtr;

	TclNewLiteralStringObj(errPtr, "-errorcode");
	TclNewObj(dictPtr);
	Tcl_DictObjPut(NULL, dictPtr, errPtr, objPtr);
	TclEmitPush(TclAddLiteralObj(envPtr, dictPtr, NULL), envPtr);
    }
    TclDecrRefCount(objPtr);

    /*
     * Simpler bytecodes when we detect invalid arguments at compile time.
     */
    if (codeKnown && !codeIsValid) {
	OP(			POP);
	if (codeIsList) {
	    /* Must be an empty list */
	    goto issueErrorForEmptyCode;
	}
	TclCompileSyntaxError(interp, envPtr);
	return TCL_OK;
    }

    if (!codeKnown) {
	/*
	 * Argument validity checking has to be done by bytecode at
	 * run time.
	 */
	OP4(			REVERSE, 3);
	OP(			DUP);
	OP(			LIST_LENGTH);
	OP1(			JUMP_FALSE1, 16);
	OP4(			LIST, 2);
	OP44(			RETURN_IMM, TCL_ERROR, 0);
	TclAdjustStackDepth(2, envPtr);
	OP(			POP);
	OP(			POP);
	OP(			POP);
    issueErrorForEmptyCode:
	PUSH(			"type must be non-empty list");
	PUSH(			"-errorcode {TCL OPERATION THROW BADEXCEPTION}");
    }
    OP44(			RETURN_IMM, TCL_ERROR, 0);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTryCmd --
 *
 *	Procedure called to compile the "try" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "try" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileTryCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    int numWords = parsePtr->numWords, numHandlers, result = TCL_ERROR;
    Tcl_Token *bodyToken, *finallyToken, *tokenPtr;
    Tcl_Token **handlerTokens = NULL;
    Tcl_Obj **matchClauses = NULL;
    int *matchCodes=NULL, *resultVarIndices=NULL, *optionVarIndices=NULL;
    int i;

    if (numWords < 2) {
	return TCL_ERROR;
    }

    bodyToken = TokenAfter(parsePtr->tokenPtr);

    if (numWords == 2) {
	/*
	 * No handlers or finally; do nothing beyond evaluating the body.
	 */

	DefineLineInformation;	/* TIP #280 */
	BODY(bodyToken, 1);
	return TCL_OK;
    }

    numWords -= 2;
    tokenPtr = TokenAfter(bodyToken);

    /*
     * Extract information about what handlers there are.
     */

    numHandlers = numWords >> 2;
    numWords -= numHandlers * 4;
    if (numHandlers > 0) {
	handlerTokens = (Tcl_Token**)TclStackAlloc(interp, sizeof(Tcl_Token*)*numHandlers);
	matchClauses = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * numHandlers);
	memset(matchClauses, 0, sizeof(Tcl_Obj *) * numHandlers);
	matchCodes = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	resultVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);
	optionVarIndices = (int *)TclStackAlloc(interp, sizeof(int) * numHandlers);

	for (i=0 ; i<numHandlers ; i++) {
	    Tcl_Obj *tmpObj, **objv;
	    int objc;

	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto failedToCompile;
	    }
	    if (tokenPtr[1].size == 4
		    && !strncmp(tokenPtr[1].start, "trap", 4)) {
		/*
		 * Parse the list of errorCode words to match against.
		 */

		matchCodes[i] = TCL_ERROR;
		tokenPtr = TokenAfter(tokenPtr);
		TclNewObj(tmpObj);
		Tcl_IncrRefCount(tmpObj);
		if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)
			|| Tcl_ListObjLength(NULL, tmpObj, &objc) != TCL_OK
			|| (objc == 0)) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
		Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL);
		matchClauses[i] = tmpObj;
	    } else if (tokenPtr[1].size == 2
		    && !strncmp(tokenPtr[1].start, "on", 2)) {
		int code;

		/*
		 * Parse the result code to look for.
		 */

		tokenPtr = TokenAfter(tokenPtr);
		TclNewObj(tmpObj);
		Tcl_IncrRefCount(tmpObj);
		if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
		if (TCL_ERROR == TclGetCompletionCodeFromObj(NULL, tmpObj, &code)) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
		matchCodes[i] = code;
		TclDecrRefCount(tmpObj);
	    } else {
		goto failedToCompile;
	    }

	    /*
	     * Parse the variable binding.
	     */

	    tokenPtr = TokenAfter(tokenPtr);
	    TclNewObj(tmpObj);
	    Tcl_IncrRefCount(tmpObj);
	    if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK
		    || (objc > 2)) {
		TclDecrRefCount(tmpObj);
		goto failedToCompile;
	    }
	    if (objc > 0) {
		size_t len;
		const char *varname = TclGetStringFromObj(objv[0], &len);

		resultVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (resultVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {
		resultVarIndices[i] = -1;
	    }
	    if (objc == 2) {
		size_t len;
		const char *varname = TclGetStringFromObj(objv[1], &len);

		optionVarIndices[i] = LocalScalar(varname, len, envPtr);
		if (optionVarIndices[i] < 0) {
		    TclDecrRefCount(tmpObj);
		    goto failedToCompile;
		}
	    } else {
		optionVarIndices[i] = -1;
	    }
	    TclDecrRefCount(tmpObj);

	    /*
	     * Extract the body for this handler.
	     */

	    tokenPtr = TokenAfter(tokenPtr);
	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		goto failedToCompile;
	    }
	    if (tokenPtr[1].size == 1 && tokenPtr[1].start[0] == '-') {
		handlerTokens[i] = NULL;
	    } else {
		handlerTokens[i] = tokenPtr;
	    }

	    tokenPtr = TokenAfter(tokenPtr);
	}

	if (handlerTokens[numHandlers-1] == NULL) {
	    goto failedToCompile;
	}
    }

    /*
     * Parse the finally clause
     */

    if (numWords == 0) {
	finallyToken = NULL;
    } else if (numWords == 2) {
	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 7
		|| strncmp(tokenPtr[1].start, "finally", 7)) {
	    goto failedToCompile;
	}
	finallyToken = TokenAfter(tokenPtr);
    } else {
	goto failedToCompile;
    }

    /*
     * Issue the bytecode.
     */

    if (!finallyToken) {
	result = IssueTryClausesInstructions(interp, envPtr, bodyToken,
		numHandlers, matchCodes, matchClauses, resultVarIndices,
		optionVarIndices, handlerTokens);
    } else if (numHandlers == 0) {
	result = IssueTryFinallyInstructions(interp, envPtr, bodyToken,
		finallyToken);
    } else {
	result = IssueTryClausesFinallyInstructions(interp, envPtr, bodyToken,
		numHandlers, matchCodes, matchClauses, resultVarIndices,
		optionVarIndices, handlerTokens, finallyToken);
    }

    /*
     * Delete any temporary state and finish off.
     */

  failedToCompile:
    if (numHandlers > 0) {
	for (i=0 ; i<numHandlers ; i++) {
	    if (matchClauses[i]) {
		TclDecrRefCount(matchClauses[i]);
	    }
	}
	TclStackFree(interp, optionVarIndices);
	TclStackFree(interp, resultVarIndices);
	TclStackFree(interp, matchCodes);
	TclStackFree(interp, matchClauses);
	TclStackFree(interp, handlerTokens);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * IssueTryClausesInstructions, IssueTryClausesFinallyInstructions,
 * IssueTryFinallyInstructions --
 *
 *	The code generators for [try]. Split from the parsing engine for
 *	reasons of developer sanity, and also split between no-finally,
 *	just-finally and with-finally cases because so many of the details of
 *	generation vary between the three.
 *
 *	The macros below make the instruction issuing easier to follow.
 *
 *----------------------------------------------------------------------
 */

static int
IssueTryClausesInstructions(
    Tcl_Interp *interp,
    CompileEnv *envPtr,
    Tcl_Token *bodyToken,
    int numHandlers,
    int *matchCodes,
    Tcl_Obj **matchClauses,
    int *resultVars,
    int *optionVars,
    Tcl_Token **handlerTokens)
{
    DefineLineInformation;	/* TIP #280 */
    int range, resultVar, optionsVar;
    int i, j, len, forwardsNeedFixing = 0, trapZero = 0, afterBody = 0;
    size_t slen;
    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
    int *noError;
    char buf[TCL_INTEGER_SPACE];

    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {
	return TCL_ERROR;
    }

    /*
     * Check if we're supposed to trap a normal TCL_OK completion of the body.
     * If not, we can handle that case much more efficiently.
     */

    for (i=0 ; i<numHandlers ; i++) {
	if (matchCodes[i] == 0) {
	    trapZero = 1;
	    break;
	}
    }

    /*
     * Compile the body, trapping any error in it so that we can trap on it
     * and/or run a finally clause. Note that there must be at least one
     * on/trap clause; when none is present, this whole function is not called
     * (and it's never called when there's a finally clause).
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    OP4(				BEGIN_CATCH4, range);
    ExceptionRangeStarts(envPtr, range);
    BODY(				bodyToken, 1);
    ExceptionRangeEnds(envPtr, range);
    if (!trapZero) {
	OP(				END_CATCH);
	JUMP4(				JUMP, afterBody);
	TclAdjustStackDepth(-1, envPtr);
    } else {
	PUSH(				"0");
	OP4(				REVERSE, 2);
	OP1(				JUMP1, 4);
	TclAdjustStackDepth(-2, envPtr);
    }
    ExceptionRangeTarget(envPtr, range, catchOffset);
    OP(					PUSH_RETURN_CODE);
    OP(					PUSH_RESULT);
    OP(					PUSH_RETURN_OPTIONS);
    OP(					END_CATCH);
    STORE(				optionsVar);
    OP(					POP);
    STORE(				resultVar);
    OP(					POP);

    /*
     * Now we handle all the registered 'on' and 'trap' handlers in order.
     * For us to be here, there must be at least one handler.
     *
     * Slight overallocation, but reduces size of this function.
     */

    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    noError = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	noError[i] = -1;
	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);
	JUMP4(				JUMP_FALSE, notCodeJumpSource);
	if (matchClauses[i]) {
	    const char *p;
	    Tcl_ListObjLength(NULL, matchClauses[i], &len);

	    /*
	     * Match the errorcode according to try/trap rules.
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &slen);
	    PushLiteral(envPtr, p, slen);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);

	/*
	 * There is no finally clause, so we can avoid wrapping a catch
	 * context around the handler. That simplifies what instructions need
	 * to be issued a lot since we can let errors just fall through.
	 */

	if (resultVars[i] >= 0) {
	    LOAD(			resultVar);
	    STORE(			resultVars[i]);
	    OP(				POP);
	    if (optionVars[i] >= 0) {
		LOAD(			optionsVar);
		STORE(			optionVars[i]);
		OP(			POP);
	    }
	}
	if (!handlerTokens[i]) {
	    forwardsNeedFixing = 1;
	    JUMP4(			JUMP, forwardsToFix[i]);
	    TclAdjustStackDepth(1, envPtr);
	} else {
	    int dontChangeOptions;

	    forwardsToFix[i] = -1;
	    if (forwardsNeedFixing) {
		forwardsNeedFixing = 0;
		for (j=0 ; j<i ; j++) {
		    if (forwardsToFix[j] == -1) {
			continue;
		    }
		    FIXJUMP4(forwardsToFix[j]);
		    forwardsToFix[j] = -1;
		}
	    }
	    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	    OP4(			BEGIN_CATCH4, range);
	    ExceptionRangeStarts(envPtr, range);
	    BODY(			handlerTokens[i], 5+i*4);
	    ExceptionRangeEnds(envPtr, range);
	    OP(				END_CATCH);
	    JUMP4(			JUMP, noError[i]);
	    ExceptionRangeTarget(envPtr, range, catchOffset);
	    TclAdjustStackDepth(-1, envPtr);
	    OP(				PUSH_RESULT);
	    OP(				PUSH_RETURN_OPTIONS);
	    OP(				PUSH_RETURN_CODE);
	    OP(				END_CATCH);
	    PUSH(			"1");
	    OP(				EQ);
	    JUMP1(			JUMP_FALSE, dontChangeOptions);
	    LOAD(			optionsVar);
	    OP4(			REVERSE, 2);
	    STORE(			optionsVar);
	    OP(				POP);
	    PUSH(			"-during");
	    OP4(			REVERSE, 2);
	    OP44(			DICT_SET, 1, optionsVar);
	    TclAdjustStackDepth(-1, envPtr);
	    FIXJUMP1(		dontChangeOptions);
	    OP4(			REVERSE, 2);
	    INVOKE(			RETURN_STK);
	}

	JUMP4(				JUMP, addrsToFix[i]);
	if (matchClauses[i]) {
	    FIXJUMP4(	notECJumpSource);
	}
	FIXJUMP4(	notCodeJumpSource);
    }

    /*
     * Drop the result code since it didn't match any clause, and reissue the
     * exception. Note also that INST_RETURN_STK can proceed to the next
     * instruction.
     */

    OP(					POP);
    LOAD(				optionsVar);
    LOAD(				resultVar);
    INVOKE(				RETURN_STK);

    /*
     * Fix all the jumps from taken clauses to here (which is the end of the
     * [try]).
     */

    if (!trapZero) {
	FIXJUMP4(afterBody);
    }
    for (i=0 ; i<numHandlers ; i++) {
	FIXJUMP4(addrsToFix[i]);
	if (noError[i] != -1) {
	    FIXJUMP4(noError[i]);
	}
    }
    TclStackFree(interp, noError);
    TclStackFree(interp, forwardsToFix);
    TclStackFree(interp, addrsToFix);
    return TCL_OK;
}

static int
IssueTryClausesFinallyInstructions(
    Tcl_Interp *interp,
    CompileEnv *envPtr,
    Tcl_Token *bodyToken,
    int numHandlers,
    int *matchCodes,
    Tcl_Obj **matchClauses,
    int *resultVars,
    int *optionVars,
    Tcl_Token **handlerTokens,
    Tcl_Token *finallyToken)	/* Not NULL */
{
    DefineLineInformation;	/* TIP #280 */
    int range, resultVar, optionsVar, i, j, len, forwardsNeedFixing = 0;
    int trapZero = 0, afterBody = 0, finalOK, finalError, noFinalError;
    int *addrsToFix, *forwardsToFix, notCodeJumpSource, notECJumpSource;
    char buf[TCL_INTEGER_SPACE];
    size_t slen;

    resultVar = AnonymousLocal(envPtr);
    optionsVar = AnonymousLocal(envPtr);
    if (resultVar < 0 || optionsVar < 0) {
	return TCL_ERROR;
    }

    /*
     * Check if we're supposed to trap a normal TCL_OK completion of the body.
     * If not, we can handle that case much more efficiently.
     */

    for (i=0 ; i<numHandlers ; i++) {
	if (matchCodes[i] == 0) {
	    trapZero = 1;
	    break;
	}
    }

    /*
     * Compile the body, trapping any error in it so that we can trap on it
     * (if any trap matches) and run a finally clause.
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    OP4(				BEGIN_CATCH4, range);
    ExceptionRangeStarts(envPtr, range);
    BODY(				bodyToken, 1);
    ExceptionRangeEnds(envPtr, range);
    if (!trapZero) {
	OP(				END_CATCH);
	STORE(				resultVar);
	OP(				POP);
	PUSH(				"-level 0 -code 0");
	STORE(				optionsVar);
	OP(				POP);
	JUMP4(				JUMP, afterBody);
    } else {
	PUSH(				"0");
	OP4(				REVERSE, 2);
	OP1(				JUMP1, 4);
	TclAdjustStackDepth(-2, envPtr);
    }
    ExceptionRangeTarget(envPtr, range, catchOffset);
    OP(					PUSH_RETURN_CODE);
    OP(					PUSH_RESULT);
    OP(					PUSH_RETURN_OPTIONS);
    OP(					END_CATCH);
    STORE(				optionsVar);
    OP(					POP);
    STORE(				resultVar);
    OP(					POP);

    /*
     * Now we handle all the registered 'on' and 'trap' handlers in order.
     *
     * Slight overallocation, but reduces size of this function.
     */

    addrsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);
    forwardsToFix = (int *)TclStackAlloc(interp, sizeof(int)*numHandlers);

    for (i=0 ; i<numHandlers ; i++) {
	int noTrapError, trapError;
	const char *p;

	sprintf(buf, "%d", matchCodes[i]);
	OP(				DUP);
	PushLiteral(envPtr, buf, strlen(buf));
	OP(				EQ);
	JUMP4(				JUMP_FALSE, notCodeJumpSource);
	if (matchClauses[i]) {
	    Tcl_ListObjLength(NULL, matchClauses[i], &len);

	    /*
	     * Match the errorcode according to try/trap rules.
	     */

	    LOAD(			optionsVar);
	    PUSH(			"-errorcode");
	    OP4(			DICT_GET, 1);
	    TclAdjustStackDepth(-1, envPtr);
	    OP44(			LIST_RANGE_IMM, 0, len-1);
	    p = TclGetStringFromObj(matchClauses[i], &slen);
	    PushLiteral(envPtr, p, slen);
	    OP(				STR_EQ);
	    JUMP4(			JUMP_FALSE, notECJumpSource);
	} else {
	    notECJumpSource = -1;
	}
	OP(				POP);

	/*
	 * There is a finally clause, so we need a fairly complex sequence of
	 * instructions to deal with an on/trap handler because we must call
	 * the finally handler *and* we need to substitute the result from a
	 * failed trap for the result from the main script.
	 */

	if (resultVars[i] >= 0 || handlerTokens[i]) {
	    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
	    OP4(			BEGIN_CATCH4, range);
	    ExceptionRangeStarts(envPtr, range);
	}
	if (resultVars[i] >= 0) {
	    LOAD(			resultVar);
	    STORE(			resultVars[i]);
	    OP(				POP);
	    if (optionVars[i] >= 0) {
		LOAD(			optionsVar);
		STORE(			optionVars[i]);
		OP(			POP);
	    }

	    if (!handlerTokens[i]) {
		/*
		 * No handler. Will not be the last handler (that is a
		 * condition that is checked by the caller). Chain to the next
		 * one.
		 */

		ExceptionRangeEnds(envPtr, range);
		OP(			END_CATCH);
		forwardsNeedFixing = 1;
		JUMP4(			JUMP, forwardsToFix[i]);
		goto finishTrapCatchHandling;
	    }
	} else if (!handlerTokens[i]) {
	    /*
	     * No handler. Will not be the last handler (that condition is
	     * checked by the caller). Chain to the next one.
	     */

	    forwardsNeedFixing = 1;
	    JUMP4(			JUMP, forwardsToFix[i]);
	    goto endOfThisArm;
	}

	/*
	 * Got a handler. Make sure that any pending patch-up actions from
	 * previous unprocessed handlers are dealt with now that we know where
	 * they are to jump to.
	 */

	if (forwardsNeedFixing) {
	    forwardsNeedFixing = 0;
	    OP1(			JUMP1, 7);
	    for (j=0 ; j<i ; j++) {
		if (forwardsToFix[j] == -1) {
		    continue;
		}
		FIXJUMP4(	forwardsToFix[j]);
		forwardsToFix[j] = -1;
	    }
	    OP4(			BEGIN_CATCH4, range);
	}
	BODY(				handlerTokens[i], 5+i*4);
	ExceptionRangeEnds(envPtr, range);
	PUSH(				"0");
	OP(				PUSH_RETURN_OPTIONS);
	OP4(				REVERSE, 3);
	OP1(				JUMP1, 5);
	TclAdjustStackDepth(-3, envPtr);
	forwardsToFix[i] = -1;

	/*
	 * Error in handler or setting of variables; replace the stored
	 * exception with the new one. Note that we only push this if we have
	 * either a body or some variable setting here. Otherwise this code is
	 * unreachable.
	 */

    finishTrapCatchHandling:
	ExceptionRangeTarget(envPtr, range, catchOffset);
	OP(				PUSH_RETURN_OPTIONS);
	OP(				PUSH_RETURN_CODE);
	OP(				PUSH_RESULT);
	OP(				END_CATCH);
	STORE(				resultVar);
	OP(				POP);
	PUSH(				"1");
	OP(				EQ);
	JUMP1(				JUMP_FALSE, noTrapError);
	LOAD(				optionsVar);
	PUSH(				"-during");
	OP4(				REVERSE, 3);
	STORE(				optionsVar);
	OP(				POP);
	OP44(				DICT_SET, 1, optionsVar);
	TclAdjustStackDepth(-1, envPtr);
	JUMP1(				JUMP, trapError);
	FIXJUMP1(		noTrapError);
	STORE(				optionsVar);
	FIXJUMP1(		trapError);
	/* Skip POP at end; can clean up with subsequent POP */
	if (i+1 < numHandlers) {
	    OP(				POP);
	}

    endOfThisArm:
	if (i+1 < numHandlers) {
	    JUMP4(			JUMP, addrsToFix[i]);
	    TclAdjustStackDepth(1, envPtr);
	}
	if (matchClauses[i]) {
	    FIXJUMP4(		notECJumpSource);
	}
	FIXJUMP4(		notCodeJumpSource);
    }

    /*
     * Drop the result code, and fix all the jumps from taken clauses - which
     * drop the result code as their first action - to point straight after
     * (i.e., to the start of the finally clause).
     */

    OP(					POP);
    for (i=0 ; i<numHandlers-1 ; i++) {
	FIXJUMP4(		addrsToFix[i]);
    }
    TclStackFree(interp, forwardsToFix);
    TclStackFree(interp, addrsToFix);

    /*
     * Process the finally clause (at last!) Note that we do not wrap this in
     * error handlers because we would just rethrow immediately anyway. Then
     * (on normal success) we reissue the exception. Note also that
     * INST_RETURN_STK can proceed to the next instruction; that'll be the
     * next command (or some inter-command manipulation).
     */

    if (!trapZero) {
	FIXJUMP4(		afterBody);
    }
    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    OP4(				BEGIN_CATCH4, range);
    ExceptionRangeStarts(envPtr, range);
    BODY(				finallyToken, 3 + 4*numHandlers);
    ExceptionRangeEnds(envPtr, range);
    OP(					END_CATCH);
    OP(					POP);
    JUMP1(				JUMP, finalOK);
    ExceptionRangeTarget(envPtr, range, catchOffset);
    OP(					PUSH_RESULT);
    OP(					PUSH_RETURN_OPTIONS);
    OP(					PUSH_RETURN_CODE);
    OP(					END_CATCH);
    PUSH(				"1");
    OP(					EQ);
    JUMP1(				JUMP_FALSE, noFinalError);
    LOAD(				optionsVar);
    PUSH(				"-during");
    OP4(				REVERSE, 3);
    STORE(				optionsVar);
    OP(					POP);
    OP44(				DICT_SET, 1, optionsVar);
    TclAdjustStackDepth(-1, envPtr);
    OP(					POP);
    JUMP1(				JUMP, finalError);
    TclAdjustStackDepth(1, envPtr);
    FIXJUMP1(			noFinalError);
    STORE(				optionsVar);
    OP(					POP);
    FIXJUMP1(			finalError);
    STORE(				resultVar);
    OP(					POP);
    FIXJUMP1(			finalOK);
    LOAD(				optionsVar);
    LOAD(				resultVar);
    INVOKE(				RETURN_STK);

    return TCL_OK;
}

static int
IssueTryFinallyInstructions(
    Tcl_Interp *interp,
    CompileEnv *envPtr,
    Tcl_Token *bodyToken,
    Tcl_Token *finallyToken)
{
    DefineLineInformation;	/* TIP #280 */
    int range, jumpOK, jumpSplice;

    /*
     * Note that this one is simple enough that we can issue it without
     * needing a local variable table, making it a universal compilation.
     */

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    OP4(				BEGIN_CATCH4, range);
    ExceptionRangeStarts(envPtr, range);
    BODY(				bodyToken, 1);
    ExceptionRangeEnds(envPtr, range);
    OP1(				JUMP1, 3);
    TclAdjustStackDepth(-1, envPtr);
    ExceptionRangeTarget(envPtr, range, catchOffset);
    OP(					PUSH_RESULT);
    OP(					PUSH_RETURN_OPTIONS);
    OP(					END_CATCH);

    range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
    OP4(				BEGIN_CATCH4, range);
    ExceptionRangeStarts(envPtr, range);
    BODY(				finallyToken, 3);
    ExceptionRangeEnds(envPtr, range);
    OP(					END_CATCH);
    OP(					POP);
    JUMP1(				JUMP, jumpOK);
    ExceptionRangeTarget(envPtr, range, catchOffset);
    OP(					PUSH_RESULT);
    OP(					PUSH_RETURN_OPTIONS);
    OP(					PUSH_RETURN_CODE);
    OP(					END_CATCH);
    PUSH(				"1");
    OP(					EQ);
    JUMP1(				JUMP_FALSE, jumpSplice);
    PUSH(				"-during");
    OP4(				OVER, 3);
    OP4(				LIST, 2);
    OP(					LIST_CONCAT);
    FIXJUMP1(		jumpSplice);
    OP4(				REVERSE, 4);
    OP(					POP);
    OP(					POP);
    OP1(				JUMP1, 7);
    FIXJUMP1(		jumpOK);
    OP4(				REVERSE, 2);
    INVOKE(				RETURN_STK);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileUnsetCmd --
 *
 *	Procedure called to compile the "unset" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "unset" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileUnsetCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *varTokenPtr;
    int isScalar, localIndex, flags = 1, i, varCount = 0, haveFlags = 0;

    /* TODO: Consider support for compiling expanded args. */

    /*
     * Verify that all words - except the first non-option one - are known at
     * compile time so that we can handle them without needing to do a nasty
     * push/rotate. [Bug 3970f54c4e]
     */

    for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) {
	Tcl_Obj *leadingWord;

	TclNewObj(leadingWord);
	varTokenPtr = TokenAfter(varTokenPtr);
	if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) {
	    TclDecrRefCount(leadingWord);

	    /*
	     * We can tolerate non-trivial substitutions in the first variable
	     * to be unset. If a '--' or '-nocomplain' was present, anything
	     * goes in that one place! (All subsequent variable names must be
	     * constants since we don't want to have to push them all first.)
	     */

	    if (varCount == 0) {
		if (haveFlags) {
		    continue;
		}

		/*
		 * In fact, we're OK as long as we're the first argument *and*
		 * we provably don't start with a '-'. If that is true, then
		 * even if everything else is varying, we still can't be a
		 * flag. Otherwise we'll spill to runtime to place a limit on
		 * the trickiness.
		 */

		if (varTokenPtr->type == TCL_TOKEN_WORD
			&& varTokenPtr[1].type == TCL_TOKEN_TEXT
			&& varTokenPtr[1].size > 0
			&& varTokenPtr[1].start[0] != '-') {
		    continue;
		}
	    }
	    return TCL_ERROR;
	}
	if (varCount == 0) {
	    const char *bytes;
	    size_t len;

	    bytes = TclGetStringFromObj(leadingWord, &len);
	    if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
		flags = 0;
		haveFlags++;
	    } else if (i == (2 - flags) && len == 2 && !strncmp("--", bytes, 2)) {
		haveFlags++;
	    } else {
		varCount++;
	    }
	} else {
	    varCount++;
	}
	TclDecrRefCount(leadingWord);
    }

    /*
     * Issue instructions to unset each of the named variables.
     */

    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
    for (i=0; i<haveFlags;i++) {
	varTokenPtr = TokenAfter(varTokenPtr);
    }
    for (i=1+haveFlags ; i<parsePtr->numWords ; i++) {
	/*
	 * Decide if we can use a frame slot for the var/array name or if we
	 * need to emit code to compute and push the name at runtime. We use a
	 * frame slot (entry in the array of local vars) if we are compiling a
	 * procedure body and if the name is simple text that does not include
	 * namespace qualifiers.
	 */

	PushVarNameWord(interp, varTokenPtr, envPtr, 0,
		&localIndex, &isScalar, i);

	/*
	 * Emit instructions to unset the variable.
	 */

	if (isScalar) {
	    if (localIndex < 0) {
		OP1(	UNSET_STK, flags);
	    } else {
		OP14(	UNSET_SCALAR, flags, localIndex);
	    }
	} else {
	    if (localIndex < 0) {
		OP1(	UNSET_ARRAY_STK, flags);
	    } else {
		OP14(	UNSET_ARRAY, flags, localIndex);
	    }
	}

	varTokenPtr = TokenAfter(varTokenPtr);
    }
    PUSH("");
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileWhileCmd --
 *
 *	Procedure called to compile the "while" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "while" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileWhileCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *testTokenPtr, *bodyTokenPtr;
    JumpFixup jumpEvalCondFixup;
    int testCodeOffset, bodyCodeOffset, jumpDist, range, code, boolVal;
    int loopMayEnd = 1;		/* This is set to 0 if it is recognized as an
				 * infinite loop. */
    Tcl_Obj *boolObj;

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    /*
     * If the test expression requires substitutions, don't compile the while
     * command inline. E.g., the expression might cause the loop to never
     * execute or execute forever, as in "while "$x < 5" {}".
     *
     * Bail out also if the body expression requires substitutions in order to
     * insure correct behaviour [Bug 219166]
     */

    testTokenPtr = TokenAfter(parsePtr->tokenPtr);
    bodyTokenPtr = TokenAfter(testTokenPtr);

    if ((testTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)
	    || (bodyTokenPtr->type != TCL_TOKEN_SIMPLE_WORD)) {
	return TCL_ERROR;
    }

    /*
     * Find out if the condition is a constant.
     */

    boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size);
    Tcl_IncrRefCount(boolObj);
    code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal);
    TclDecrRefCount(boolObj);
    if (code == TCL_OK) {
	if (boolVal) {
	    /*
	     * It is an infinite loop; flag it so that we generate a more
	     * efficient body.
	     */

	    loopMayEnd = 0;
	} else {
	    /*
	     * This is an empty loop: "while 0 {...}" or such. Compile no
	     * bytecodes.
	     */

	    goto pushResult;
	}
    }

    /*
     * Create a ExceptionRange record for the loop body. This is used to
     * implement break and continue.
     */

    range = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);

    /*
     * Jump to the evaluation of the condition. This code uses the "loop
     * rotation" optimisation (which eliminates one branch from the loop).
     * "while cond body" produces then:
     *       goto A
     *    B: body                : bodyCodeOffset
     *    A: cond -> result      : testCodeOffset, continueOffset
     *       if (result) goto B
     *
     * The infinite loop "while 1 body" produces:
     *    B: body                : all three offsets here
     *       goto B
     */

    if (loopMayEnd) {
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
		&jumpEvalCondFixup);
	testCodeOffset = 0;	/* Avoid compiler warning. */
    } else {
	/*
	 * Make sure that the first command in the body is preceded by an
	 * INST_START_CMD, and hence counted properly. [Bug 1752146]
	 */

	envPtr->atCmdStart &= ~1;
	testCodeOffset = CurrentOffset(envPtr);
    }

    /*
     * Compile the loop body.
     */

    bodyCodeOffset = ExceptionRangeStarts(envPtr, range);
    if (!loopMayEnd) {
	envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
	envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
    }
    BODY(bodyTokenPtr, 2);
    ExceptionRangeEnds(envPtr, range);
    OP(		POP);

    /*
     * Compile the test expression then emit the conditional jump that
     * terminates the while. We already know it's a simple word.
     */

    if (loopMayEnd) {
	testCodeOffset = CurrentOffset(envPtr);
	jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset;
	if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) {
	    bodyCodeOffset += 3;
	    testCodeOffset += 3;
	}
	SetLineInformation(1);
	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);

	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
	if (jumpDist > 127) {
	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
	} else {
	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
	}
    } else {
	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
	if (jumpDist > 127) {
	    TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
	} else {
	    TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
	}
    }

    /*
     * Set the loop's body, continue and break offsets.
     */

    envPtr->exceptArrayPtr[range].continueOffset = testCodeOffset;
    envPtr->exceptArrayPtr[range].codeOffset = bodyCodeOffset;
    ExceptionRangeTarget(envPtr, range, breakOffset);
    TclFinalizeLoopExceptionRange(envPtr, range);

    /*
     * The while command's result is an empty string.
     */

  pushResult:
    PUSH("");
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileYieldCmd --
 *
 *	Procedure called to compile the "yield" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "yield" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileYieldCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    if (parsePtr->numWords < 1 || parsePtr->numWords > 2) {
	return TCL_ERROR;
    }

    if (parsePtr->numWords == 1) {
	PUSH("");
    } else {
	DefineLineInformation;	/* TIP #280 */
	Tcl_Token *valueTokenPtr = TokenAfter(parsePtr->tokenPtr);

	CompileWord(envPtr, valueTokenPtr, interp, 1);
    }
    OP(		YIELD);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileYieldToCmd --
 *
 *	Procedure called to compile the "yieldto" command.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the "yieldto" command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileYieldToCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    int i;

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
    }

    OP(		NS_CURRENT);
    for (i = 1 ; i < parsePtr->numWords ; i++) {
	CompileWord(envPtr, tokenPtr, interp, i);
	tokenPtr = TokenAfter(tokenPtr);
    }
    OP4(	LIST, i);
    OP(		YIELD_TO_INVOKE);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileUnaryOpCmd --
 *
 *	Utility routine to compile the unary operator commands.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileUnaryOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }
    tokenPtr = TokenAfter(parsePtr->tokenPtr);
    CompileWord(envPtr, tokenPtr, interp, 1);
    TclEmitOpcode(instruction, envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileAssociativeBinaryOpCmd --
 *
 *	Utility routine to compile the binary operator commands that accept an
 *	arbitrary number of arguments, and that are associative operations.
 *	Because of the associativity, we may combine operations from right to
 *	left, saving us any effort of re-ordering the arguments on the stack
 *	after substitutions are completed.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileAssociativeBinaryOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    const char *identity,
    int instruction,
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int words;

    /* TODO: Consider support for compiling expanded args. */
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PushLiteral(envPtr, identity, -1);
	words++;
    }
    if (words > 3) {
	/*
	 * Reverse order of arguments to get precise agreement with [expr] in
	 * calcuations, including roundoff errors.
	 */

	OP4(	REVERSE, words-1);
    }
    while (--words > 1) {
	TclEmitOpcode(instruction, envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileStrictlyBinaryOpCmd --
 *
 *	Utility routine to compile the binary operator commands, that strictly
 *	accept exactly two arguments.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileStrictlyBinaryOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }
    return CompileAssociativeBinaryOpCmd(interp, parsePtr,
	    NULL, instruction, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CompileComparisonOpCmd --
 *
 *	Utility routine to compile the n-ary comparison operator commands.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

static int
CompileComparisonOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    int instruction,
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords < 3) {
	PUSH("1");
    } else if (parsePtr->numWords == 3) {
	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	TclEmitOpcode(instruction, envPtr);
    } else if (envPtr->procPtr == NULL) {
	/*
	 * No local variable space!
	 */

	return TCL_ERROR;
    } else {
	int tmpIndex = AnonymousLocal(envPtr);
	int words;

	tokenPtr = TokenAfter(parsePtr->tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 1);
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, 2);
	STORE(tmpIndex);
	TclEmitOpcode(instruction, envPtr);
	for (words=3 ; words<parsePtr->numWords ;) {
	    LOAD(tmpIndex);
	    tokenPtr = TokenAfter(tokenPtr);
	    CompileWord(envPtr, tokenPtr, interp, words);
	    if (++words < parsePtr->numWords) {
		STORE(tmpIndex);
	    }
	    TclEmitOpcode(instruction, envPtr);
	}
	for (; words>3 ; words--) {
	    OP(	BITAND);
	}

	/*
	 * Drop the value from the temp variable; retaining that reference
	 * might be expensive elsewhere.
	 */

	OP14(	UNSET_SCALAR, 0, tmpIndex);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompile*OpCmd --
 *
 *	Procedures called to compile the corresponding "::tcl::mathop::*"
 *	commands. These are all wrappers around the utility operator command
 *	compiler functions, except for the compilers for subtraction and
 *	division, which are special.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the compiled command at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileInvertOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileUnaryOpCmd(interp, parsePtr, INST_BITNOT, envPtr);
}

int
TclCompileNotOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileUnaryOpCmd(interp, parsePtr, INST_LNOT, envPtr);
}

int
TclCompileAddOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_ADD,
	    envPtr);
}

int
TclCompileMulOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "1", INST_MULT,
	    envPtr);
}

int
TclCompileAndOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "-1", INST_BITAND,
	    envPtr);
}

int
TclCompileOrOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITOR,
	    envPtr);
}

int
TclCompileXorOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileAssociativeBinaryOpCmd(interp, parsePtr, "0", INST_BITXOR,
	    envPtr);
}

int
TclCompilePowOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int words;

    /*
     * This one has its own implementation because the ** operator is the only
     * one with right associativity.
     */

    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (parsePtr->numWords <= 2) {
	PUSH("1");
	words++;
    }
    while (--words > 1) {
	TclEmitOpcode(INST_EXPON, envPtr);
    }
    return TCL_OK;
}

int
TclCompileLshiftOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LSHIFT, envPtr);
}

int
TclCompileRshiftOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_RSHIFT, envPtr);
}

int
TclCompileModOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_MOD, envPtr);
}

int
TclCompileNeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_NEQ, envPtr);
}

int
TclCompileStrneqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_STR_NEQ, envPtr);
}

int
TclCompileInOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_IN, envPtr);
}

int
TclCompileNiOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileStrictlyBinaryOpCmd(interp, parsePtr, INST_LIST_NOT_IN,
	    envPtr);
}

int
TclCompileLessOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_LT, envPtr);
}

int
TclCompileLeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_LE, envPtr);
}

int
TclCompileGreaterOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_GT, envPtr);
}

int
TclCompileGeqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_GE, envPtr);
}

int
TclCompileEqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_EQ, envPtr);
}

int
TclCompileStreqOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_EQ, envPtr);
}

int
TclCompileStrLtOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LT, envPtr);
}

int
TclCompileStrLeOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_LE, envPtr);
}

int
TclCompileStrGtOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GT, envPtr);
}

int
TclCompileStrGeOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    return CompileComparisonOpCmd(interp, parsePtr, INST_STR_GE, envPtr);
}

int
TclCompileMinusOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

	return TCL_ERROR;
    }
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (words == 2) {
	TclEmitOpcode(INST_UMINUS, envPtr);
	return TCL_OK;
    }
    if (words == 3) {
	TclEmitOpcode(INST_SUB, envPtr);
	return TCL_OK;
    }

    /*
     * Reverse order of arguments to get precise agreement with [expr] in
     * calcuations, including roundoff errors.
     */

    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_SUB, envPtr);
    }
    return TCL_OK;
}

int
TclCompileDivOpCmd(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    TCL_UNUSED(Command *),
    CompileEnv *envPtr)
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    int words;

    /* TODO: Consider support for compiling expanded args. */
    if (parsePtr->numWords == 1) {
	/*
	 * Fallback to direct eval to report syntax error.
	 */

	return TCL_ERROR;
    }
    if (parsePtr->numWords == 2) {
	PUSH("1.0");
    }
    for (words=1 ; words<parsePtr->numWords ; words++) {
	tokenPtr = TokenAfter(tokenPtr);
	CompileWord(envPtr, tokenPtr, interp, words);
    }
    if (words <= 3) {
	TclEmitOpcode(INST_DIV, envPtr);
	return TCL_OK;
    }

    /*
     * Reverse order of arguments to get precise agreement with [expr] in
     * calcuations, including roundoff errors.
     */

    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
    while (--words > 1) {
	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
	TclEmitOpcode(INST_DIV, envPtr);
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclCompExpr.c.

1
2
3
4
5


6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22





23
24
25

26
27
28
29
30
31
32
33
34
35
36
37
38
39

40
41
42
43
44
45

46
47
48


49
50
51
52
53
54
55
56
57
58
59
60







61
62
63
64
65
66
67
68



69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84



85
86
87
88
89
90



91
92
93
94
95



96
97
98
99



100
101
102
103
104
105


106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123



124
125
126
127
128
129
130
131
132
133
134






135
136
137
138
139
140
141





142
143
144
145
146
147


148
149
150
151
152


153
154
155
156

157
158

159
160

161
162
163

164
165

166
167
168
169
170

171
172
173

174
175

176
177

178
179

180
181
182
183
184
185





186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206




















207
208
209
210
211
212
213
214
215
216
217
218
219
220














221
222
223
224
225


226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
















242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261




















262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

























284
285
286

287
288
289
290
291
292
293
294







295
296
297
298
299
300
301
302





303
304
305
306
307
308
309
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



-
-
+
+












-
-
-
-
-
+
+
+
+
+


-
+













-
+





-
+

-
-
+
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+





-
-
-
+
+
+













-
-
-
+
+
+



-
-
-
+
+
+


-
-
-
+
+
+


-
-
+
+
+




-
-
+
+















-
-
-
+
+
+





-
-
-
-
-
-
+
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+




-
-
+
+




-
+
+



-
+

-
+

-
+


-
+

-
+




-
+
-
-
-
+
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-



-
-
-
-
+
+
+
+
+







/*
 * tclCompExpr.c --
 *
 *	This file contains the code to parse and compile Tcl expressions and
 *	implementations of the Tcl commands corresponding to expression
 *	This file contains the code to parse and compile Tcl expressions
 *	and implementations of the Tcl commands corresponding to expression
 *	operators, such as the command ::tcl::mathop::+ .
 *
 * Contributions from Don Porter, NIST, 2006-2007. (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 "tclCompile.h"		/* CompileEnv */

/*
 * Expression parsing takes place in the routine ParseExpr(). It takes a
 * string as input, parses that string, and generates a representation of the
 * expression in the form of a tree of operators, a list of literals, a list
 * of function names, and an array of Tcl_Token's within a Tcl_Parse struct.
 * The tree is composed of OpNodes.
 * Expression parsing takes place in the routine ParseExpr().  It takes a
 * string as input, parses that string, and generates a representation of
 * the expression in the form of a tree of operators, a list of literals,
 * a list of function names, and an array of Tcl_Token's within a Tcl_Parse
 * struct.  The tree is composed of OpNodes.
 */

typedef struct {
typedef struct OpNode {
    int left;			/* "Pointer" to the left operand. */
    int right;			/* "Pointer" to the right operand. */
    union {
	int parent;		/* "Pointer" to the parent operand. */
	int prev;		/* "Pointer" joining incomplete tree stack */
    } p;
    unsigned char lexeme;	/* Code that identifies the operator. */
    unsigned char precedence;	/* Precedence of the operator */
    unsigned char mark;		/* Mark used to control traversal. */
    unsigned char constant;	/* Flag marking constant subexpressions. */
} OpNode;

/*
 * The storage for the tree is dynamically allocated array of OpNodes. The
 * The storage for the tree is dynamically allocated array of OpNodes.  The
 * array is grown as parsing needs dictate according to a scheme similar to
 * Tcl's string growth algorithm, so that the resizing costs are O(N) and so
 * that we use at least half the memory allocated as expressions get large.
 *
 * Each OpNode in the tree represents an operator in the expression, either
 * unary or binary. When parsing is completed successfully, a binary operator
 * unary or binary.  When parsing is completed successfully, a binary operator
 * OpNode will have its left and right fields filled with "pointers" to its
 * left and right operands. A unary operator OpNode will have its right field
 * filled with a pointer to its single operand. When an operand is a
 * left and right operands.  A unary operator OpNode will have its right field
 * filled with a pointer to its single operand.  When an operand is a
 * subexpression the "pointer" takes the form of the index -- a non-negative
 * integer -- into the OpNode storage array where the root of that
 * subexpression parse tree is found.
 *
 * Non-operator elements of the expression do not get stored in the OpNode
 * tree. They are stored in the other structures according to their type.
 * Literal values get appended to the literal list. Elements that denote forms
 * of quoting or substitution known to the Tcl parser get stored as
 * Tcl_Tokens. These non-operator elements of the expression are the leaves of
 * the completed parse tree. When an operand of an OpNode is one of these leaf
 * elements, the following negative integer codes are used to indicate which
 * kind of elements it is.
 * tree.  They are stored in the other structures according to their type.
 * Literal values get appended to the literal list.  Elements that denote
 * forms of quoting or substitution known to the Tcl parser get stored as
 * Tcl_Tokens.  These non-operator elements of the expression are the
 * leaves of the completed parse tree.  When an operand of an OpNode is
 * one of these leaf elements, the following negative integer codes are used
 * to indicate which kind of elements it is.
 */

enum OperandTypes {
    OT_LITERAL = -3,	/* Operand is a literal in the literal list */
    OT_TOKENS = -2,	/* Operand is sequence of Tcl_Tokens */
    OT_EMPTY = -1	/* "Operand" is an empty string. This is a special
			 * case used only to represent the EMPTY lexeme. See
			 * below. */
    OT_EMPTY = -1	/* "Operand" is an empty string.  This is a
			 * special case used only to represent the
			 * EMPTY lexeme.  See below. */
};

/*
 * Readable macros to test whether a "pointer" value points to an operator.
 * They operate on the "non-negative integer -> operator; negative integer ->
 * a non-operator OperandType" distinction.
 */

#define IsOperator(l)	((l) >= 0)
#define NotOperator(l)	((l) < 0)

/*
 * Note that it is sufficient to store in the tree just the type of leaf
 * operand, without any explicit pointer to which leaf. This is true because
 * the traversals of the completed tree we perform are known to visit the
 * leaves in the same order as the original parse.
 * operand, without any explicit pointer to which leaf.  This is true because
 * the traversals of the completed tree we perform are known to visit
 * the leaves in the same order as the original parse.
 *
 * In a completed parse tree, those OpNodes that are themselves (roots of
 * subexpression trees that are) operands of some operator store in their
 * p.parent field a "pointer" to the OpNode of that operator. The p.parent
 * field permits a traversal of the tree within a non-recursive routine
 * (ConvertTreeToTokens() and CompileExprTree()). This means that even
 * p.parent field a "pointer" to the OpNode of that operator.  The p.parent
 * field permits a traversal of the tree within a * non-recursive routine
 * (ConvertTreeToTokens() and CompileExprTree()).  This means that even
 * expression trees of great depth pose no risk of blowing the C stack.
 *
 * While the parse tree is being constructed, the same memory space is used to
 * hold the p.prev field which chains together a stack of incomplete trees
 * awaiting their right operands.
 * While the parse tree is being constructed, the same memory space is used
 * to hold the p.prev field which chains together a stack of incomplete
 * trees awaiting their right operands.
 *
 * The lexeme field is filled in with the lexeme of the operator that is
 * returned by the ParseLexeme() routine. Only lexemes for unary and binary
 * operators get stored in an OpNode. Other lexmes get different treatement.
 * returned by the ParseLexeme() routine.  Only lexemes for unary and
 * binary operators get stored in an OpNode.  Other lexmes get different
 * treatement.
 *
 * The precedence field provides a place to store the precedence of the
 * operator, so it need not be looked up again and again.
 *
 * The mark field is use to control the traversal of the tree, so that it can
 * be done non-recursively. The mark values are:
 * The mark field is use to control the traversal of the tree, so
 * that it can be done non-recursively.  The mark values are:
 */

enum Marks {
    MARK_LEFT,		/* Next step of traversal is to visit left subtree */
    MARK_RIGHT,		/* Next step of traversal is to visit right subtree */
    MARK_PARENT		/* Next step of traversal is to return to parent */
};

/*
 * The constant field is a boolean flag marking which subexpressions are
 * completely known at compile time, and are eligible for computing then
 * rather than waiting until run time.
 */

/*
 * Each lexeme belongs to one of four categories, which determine its place in
 * the parse tree. We use the two high bits of the (unsigned char) value to
 * store a NODE_TYPE code.
 * Each lexeme belongs to one of four categories, which determine
 * its place in the parse tree.  We use the two high bits of the
 * (unsigned char) value to store a NODE_TYPE code.
 */

#define NODE_TYPE	0xC0

/*
 * The four category values are LEAF, UNARY, and BINARY, explained below, and
 * "uncategorized", which is used either temporarily, until context determines
 * which of the other three categories is correct, or for lexemes like
 * INVALID, which aren't really lexemes at all, but indicators of a parsing
 * error. Note that the codes must be distinct to distinguish categories, but
 * need not take the form of a bit array.
 * The four category values are LEAF, UNARY, and BINARY, explained below,
 * and "uncategorized", which is used either temporarily, until context
 * determines which of the other three categories is correct, or for
 * lexemes like INVALID, which aren't really lexemes at all, but indicators
 * of a parsing error.  Note that the codes must be distinct to distinguish
 * categories, but need not take the form of a bit array.
 */

#define BINARY		0x40	/* This lexeme is a binary operator. An OpNode
				 * representing it should go into the parse
				 * tree, and two operands should be parsed for
				 * it in the expression. */
#define UNARY		0x80	/* This lexeme is a unary operator. An OpNode
#define BINARY		0x40	/* This lexeme is a binary operator.  An
				 * OpNode representing it should go into the
				 * parse tree, and two operands should be
				 * parsed for it in the expression.  */
#define UNARY		0x80	/* This lexeme is a unary operator.  An OpNode
				 * representing it should go into the parse
				 * tree, and one operand should be parsed for
				 * it in the expression. */
#define LEAF		0xC0	/* This lexeme is a leaf operand in the parse
				 * tree. No OpNode will be placed in the tree
				 * for it. Either a literal value will be
				 * tree.  No OpNode will be placed in the tree
				 * for it.  Either a literal value will be
				 * appended to the list of literals in this
				 * expression, or appropriate Tcl_Tokens will
				 * be appended in a Tcl_Parse struct to
				 * represent those leaves that require some
				 * form of substitution. */
				 * form of substitution.
				 */

/* Uncategorized lexemes */

#define PLUS		1	/* Ambiguous. Resolves to UNARY_PLUS or
#define PLUS		1	/* Ambiguous.  Resolves to UNARY_PLUS or
				 * BINARY_PLUS according to context. */
#define MINUS		2	/* Ambiguous. Resolves to UNARY_MINUS or
#define MINUS		2	/* Ambiguous.  Resolves to UNARY_MINUS or
				 * BINARY_MINUS according to context. */
#define BAREWORD	3	/* Ambigous. Resolves to BOOLEAN or to
#define BAREWORD	3	/* Ambigous.  Resolves to BOOLEAN or to
				 * FUNCTION or a parse error according to
				 * context and value. */
#define INCOMPLETE	4	/* A parse error. Used only when the single
#define INCOMPLETE	4	/* A parse error.  Used only when the single
				 * "=" is encountered.  */
#define INVALID		5	/* A parse error. Used when any punctuation
#define INVALID		5	/* A parse error.  Used when any punctuation
				 * appears that's not a supported operator. */

/* Leaf lexemes */

#define NUMBER		(LEAF | 1)
#define NUMBER		( LEAF | 1)	/* For literal numbers */
				/* For literal numbers */
#define SCRIPT		(LEAF | 2)
				/* Script substitution; [foo] */
#define SCRIPT		( LEAF | 2)	/* Script substitution; [foo] */
#define BOOLEAN		(LEAF | BAREWORD)
				/* For literal booleans */
#define BOOLEAN		( LEAF | BAREWORD)	/* For literal booleans */
#define BRACED		(LEAF | 4)
				/* Braced string; {foo bar} */
#define BRACED		( LEAF | 4)	/* Braced string; {foo bar} */
#define VARIABLE	(LEAF | 5)
				/* Variable substitution; $x */
#define VARIABLE	( LEAF | 5)	/* Variable substitution; $x */
#define QUOTED		(LEAF | 6)
				/* Quoted string; "foo $bar [soom]" */
#define EMPTY		(LEAF | 7)
				/* Used only for an empty argument list to a
				 * function. Represents the empty string
				 * within parens in the expression: rand() */
#define QUOTED		( LEAF | 6)	/* Quoted string; "foo $bar [soom]" */
#define EMPTY		( LEAF | 7)	/* Used only for an empty argument
					 * list to a function.  Represents
					 * the empty string within parens in
					 * the expression: rand() */

/* Unary operator lexemes */

#define UNARY_PLUS	(UNARY | PLUS)
#define UNARY_MINUS	(UNARY | MINUS)
#define FUNCTION	(UNARY | BAREWORD)
				/* This is a bit of "creative interpretation"
				 * on the part of the parser. A function call
				 * is parsed into the parse tree according to
				 * the perspective that the function name is a
				 * unary operator and its argument list,
				 * enclosed in parens, is its operand. The
				 * additional requirements not implied
				 * generally by treatment as a unary operator
				 * -- for example, the requirement that the
				 * operand be enclosed in parens -- are hard
				 * coded in the relevant portions of
				 * ParseExpr(). We trade off the need to
				 * include such exceptional handling in the
				 * code against the need we would otherwise
				 * have for more lexeme categories. */
#define UNARY_PLUS	( UNARY | PLUS)
#define UNARY_MINUS	( UNARY | MINUS)
#define FUNCTION	( UNARY | BAREWORD)	/* This is a bit of "creative
					 * interpretation" on the part of the
					 * parser.  A function call is parsed
					 * into the parse tree according to
					 * the perspective that the function
					 * name is a unary operator and its
					 * argument list, enclosed in parens,
					 * is its operand.  The additional
					 * requirements not implied generally
					 * by treatment as a unary operator --
					 * for example, the requirement that
					 * the operand be enclosed in parens --
					 * are hard coded in the relevant
					 * portions of ParseExpr().  We trade
					 * off the need to include such
					 * exceptional handling in the code
					 * against the need we would otherwise
					 * have for more lexeme categories. */
#define START		(UNARY | 4)
				/* This lexeme isn't parsed from the
				 * expression text at all. It represents the
				 * start of the expression and sits at the
				 * root of the parse tree where it serves as
				 * the start/end point of traversals. */
#define OPEN_PAREN	(UNARY | 5)
				/* Another bit of creative interpretation,
				 * where we treat "(" as a unary operator with
				 * the sub-expression between it and its
				 * matching ")" as its operand. See
				 * CLOSE_PAREN below. */
#define NOT		(UNARY | 6)
#define BIT_NOT		(UNARY | 7)
#define START		( UNARY | 4)	/* This lexeme isn't parsed from the
					 * expression text at all.  It
					 * represents the start of the
					 * expression and sits at the root of
					 * the parse tree where it serves as
					 * the start/end point of traversals. */
#define OPEN_PAREN	( UNARY | 5)	/* Another bit of creative
					 * interpretation, where we treat "("
					 * as a unary operator with the
					 * sub-expression between it and its
					 * matching ")" as its operand. See
					 * CLOSE_PAREN below. */
#define NOT		( UNARY | 6)
#define BIT_NOT		( UNARY | 7)

/* Binary operator lexemes */

#define BINARY_PLUS	(BINARY |  PLUS)
#define BINARY_MINUS	(BINARY |  MINUS)
#define BINARY_PLUS	( BINARY |  PLUS)
#define BINARY_MINUS	( BINARY |  MINUS)
#define COMMA		(BINARY |  3)
				/* The "," operator is a low precedence binary
				 * operator that separates the arguments in a
				 * function call. The additional constraint
				 * that this operator can only legally appear
				 * at the right places within a function call
				 * argument list are hard coded within
				 * ParseExpr().  */
#define MULT		(BINARY |  4)
#define DIVIDE		(BINARY |  5)
#define MOD		(BINARY |  6)
#define LESS		(BINARY |  7)
#define GREATER		(BINARY |  8)
#define BIT_AND		(BINARY |  9)
#define BIT_XOR		(BINARY | 10)
#define BIT_OR		(BINARY | 11)
#define COMMA		( BINARY |  3)	/* The "," operator is a low precedence
					 * binary operator that separates the
					 * arguments in a function call.  The
					 * additional constraint that this
					 * operator can only legally appear
					 * at the right places within a
					 * function call argument list are
					 * hard coded within ParseExpr().  */
#define MULT		( BINARY |  4)
#define DIVIDE		( BINARY |  5)
#define MOD		( BINARY |  6)
#define LESS		( BINARY |  7)
#define GREATER		( BINARY |  8)
#define BIT_AND		( BINARY |  9)
#define BIT_XOR		( BINARY | 10)
#define BIT_OR		( BINARY | 11)
#define QUESTION	(BINARY | 12)
				/* These two lexemes make up the */
#define COLON		(BINARY | 13)
				/* ternary conditional operator, $x ? $y : $z.
				 * We treat them as two binary operators to
				 * avoid another lexeme category, and code the
				 * additional constraints directly in
				 * ParseExpr(). For instance, the right
				 * operand of a "?" operator must be a ":"
				 * operator. */
#define LEFT_SHIFT	(BINARY | 14)
#define RIGHT_SHIFT	(BINARY | 15)
#define LEQ		(BINARY | 16)
#define GEQ		(BINARY | 17)
#define EQUAL		(BINARY | 18)
#define NEQ		(BINARY | 19)
#define AND		(BINARY | 20)
#define OR		(BINARY | 21)
#define STREQ		(BINARY | 22)
#define STRNEQ		(BINARY | 23)
#define QUESTION	( BINARY | 12)	/* These two lexemes make up the */
#define COLON		( BINARY | 13)	/* ternary conditional operator,
					 * $x ? $y : $z .  We treat them as
					 * two binary operators to avoid
					 * another lexeme category, and
					 * code the additional constraints
					 * directly in ParseExpr().  For
					 * instance, the right operand of
					 * a "?" operator must be a ":"
					 * operator. */
#define LEFT_SHIFT	( BINARY | 14)
#define RIGHT_SHIFT	( BINARY | 15)
#define LEQ		( BINARY | 16)
#define GEQ		( BINARY | 17)
#define EQUAL		( BINARY | 18)
#define NEQ		( BINARY | 19)
#define AND		( BINARY | 20)
#define OR		( BINARY | 21)
#define STREQ		( BINARY | 22)
#define STRNEQ		( BINARY | 23)
#define EXPON		(BINARY | 24)
				/* Unlike the other binary operators, EXPON is
				 * right associative and this distinction is
				 * coded directly in ParseExpr(). */
#define IN_LIST		(BINARY | 25)
#define NOT_IN_LIST	(BINARY | 26)
#define CLOSE_PAREN	(BINARY | 27)
				/* By categorizing the CLOSE_PAREN lexeme as a
				 * BINARY operator, the normal parsing rules
				 * for binary operators assure that a close
				 * paren will not directly follow another
				 * operator, and the machinery already in
				 * place to connect operands to operators
				 * according to precedence performs most of
				 * the work of matching open and close parens
				 * for us. In the end though, a close paren is
				 * not really a binary operator, and some
				 * special coding in ParseExpr() make sure we
				 * never put an actual CLOSE_PAREN node in the
				 * parse tree. The sub-expression between
				 * parens becomes the single argument of the
				 * matching OPEN_PAREN unary operator. */
#define EXPON		( BINARY | 24)	/* Unlike the other binary operators,
					 * EXPON is right associative and this
					 * distinction is coded directly in
					 * ParseExpr(). */
#define IN_LIST		( BINARY | 25)
#define NOT_IN_LIST	( BINARY | 26)
#define CLOSE_PAREN	( BINARY | 27)	/* By categorizing the CLOSE_PAREN
					 * lexeme as a BINARY operator, the
					 * normal parsing rules for binary
					 * operators assure that a close paren
					 * will not directly follow another
					 * operator, and the machinery already
					 * in place to connect operands to
					 * operators according to precedence
					 * performs most of the work of
					 * matching open and close parens for
					 * us.  In the end though, a close
					 * paren is not really a binary
					 * operator, and some special coding
					 * in ParseExpr() make sure we never
					 * put an actual CLOSE_PAREN node
					 * in the parse tree.   The
					 * sub-expression between parens
					 * becomes the single argument of
					 * the matching OPEN_PAREN unary
#define STR_LT		(BINARY | 28)
#define STR_GT		(BINARY | 29)
#define STR_LEQ		(BINARY | 30)
					 * operator. */
#define STR_GEQ		(BINARY | 31)
#define END		(BINARY | 32)
				/* This lexeme represents the end of the
				 * string being parsed. Treating it as a
				 * binary operator follows the same logic as
				 * the CLOSE_PAREN lexeme and END pairs with
				 * START, in the same way that CLOSE_PAREN
				 * pairs with OPEN_PAREN. */
#define END		( BINARY | 28)	/* This lexeme represents the end of
					 * the string being parsed.  Treating
					 * it as a binary operator follows the
					 * same logic as the CLOSE_PAREN lexeme
					 * and END pairs with START, in the
					 * same way that CLOSE_PAREN pairs with
					 * OPEN_PAREN. */

/*
 * When ParseExpr() builds the parse tree it must choose which operands to
 * connect to which operators.  This is done according to operator precedence.
 * The greater an operator's precedence the greater claim it has to link to an
 * available operand.  The Precedence enumeration lists the precedence values
 * used by Tcl expression operators, from lowest to highest claim.  Each
 * precedence level is commented with the operators that hold that precedence.
 * The greater an operator's precedence the greater claim it has to link to
 * an available operand.  The Precedence enumeration lists the precedence
 * values used by Tcl expression operators, from lowest to highest claim.
 * Each precedence level is commented with the operators that hold that
 * precedence.
 */

enum Precedence {
    PREC_END = 1,	/* END */
    PREC_START,		/* START */
    PREC_CLOSE_PAREN,	/* ")" */
    PREC_OPEN_PAREN,	/* "(" */
320
321
322
323
324
325
326
327
328
329



330
331
332
333
334
335
336
318
319
320
321
322
323
324



325
326
327
328
329
330
331
332
333
334







-
-
-
+
+
+







    PREC_ADD,		/* "+", "-" */
    PREC_MULT,		/* "*", "/", "%" */
    PREC_EXPON,		/* "**" */
    PREC_UNARY		/* "+", "-", FUNCTION, "!", "~" */
};

/*
 * Here the same information contained in the comments above is stored in
 * inverted form, so that given a lexeme, one can quickly look up its
 * precedence value.
 * Here the same information contained in the comments above is stored
 * in inverted form, so that given a lexeme, one can quickly look up
 * its precedence value.
 */

static const unsigned char prec[] = {
    /* Non-operator lexemes */
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
360
361
362
363
364
365
366
367
368
369
370
371
372

373
374

375
376
377
378
379
380
381
358
359
360
361
362
363
364




365
366
367
368
369
370
371
372
373
374
375
376
377







-
-
-
-


+


+







    PREC_OR,		/* OR */
    PREC_EQUAL,		/* STREQ */
    PREC_EQUAL,		/* STRNEQ */
    PREC_EXPON,		/* EXPON */
    PREC_EQUAL,		/* IN_LIST */
    PREC_EQUAL,		/* NOT_IN_LIST */
    PREC_CLOSE_PAREN,	/* CLOSE_PAREN */
    PREC_COMPARE,	/* STR_LT */
    PREC_COMPARE,	/* STR_GT */
    PREC_COMPARE,	/* STR_LEQ */
    PREC_COMPARE,	/* STR_GEQ */
    PREC_END,		/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,
    /* Unary operator lexemes */
    PREC_UNARY,		/* UNARY_PLUS */
    PREC_UNARY,		/* UNARY_MINUS */
    PREC_UNARY,		/* FUNCTION */
    PREC_START,		/* START */
    PREC_OPEN_PAREN,	/* OPEN_PAREN */
    PREC_UNARY,		/* NOT*/
417
418
419
420
421
422
423
424
425
426
427
428
429

430
431

432
433
434
435
436
437
438
413
414
415
416
417
418
419




420
421
422
423
424
425
426
427
428
429
430
431
432







-
-
-
-


+


+







    0,			/* OR */
    INST_STR_EQ,	/* STREQ */
    INST_STR_NEQ,	/* STRNEQ */
    INST_EXPON,		/* EXPON */
    INST_LIST_IN,	/* IN_LIST */
    INST_LIST_NOT_IN,	/* NOT_IN_LIST */
    0,			/* CLOSE_PAREN */
    INST_STR_LT,	/* STR_LT */
    INST_STR_GT,	/* STR_GT */
    INST_STR_LE,	/* STR_LEQ */
    INST_STR_GE,	/* STR_GEQ */
    0,			/* END */
    /* Expansion room for more binary operators */
    0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
    0,
    /* Unary operator lexemes */
    INST_UPLUS,		/* UNARY_PLUS */
    INST_UMINUS,	/* UNARY_MINUS */
    0,			/* FUNCTION */
    0,			/* START */
    0,			/* OPEN_PAREN */
    INST_LNOT,		/* NOT*/
457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
451
452
453
454
455
456
457

458
459
460
461
462
463
464
465







-
+







	INVALID		/* DC2 */,	INVALID		/* DC3 */,
	INVALID		/* DC4 */,	INVALID		/* NAK */,
	INVALID		/* SYN */,	INVALID		/* ETB */,
	INVALID		/* CAN */,	INVALID		/* EM */,
	INVALID		/* SUB */,	INVALID		/* ESC */,
	INVALID		/* FS */,	INVALID		/* GS */,
	INVALID		/* RS */,	INVALID		/* US */,
	INVALID		/* SPACE */,	0		/* ! or != */,
	INVALID		/* SPACE */,	0 		/* ! or != */,
	QUOTED		/* " */,	INVALID		/* # */,
	VARIABLE	/* $ */,	MOD		/* % */,
	0		/* & or && */,	INVALID		/* ' */,
	OPEN_PAREN	/* ( */,	CLOSE_PAREN	/* ) */,
	0		/* * or ** */,	PLUS		/* + */,
	COMMA		/* , */,	MINUS		/* - */,
	0		/* . */,	DIVIDE		/* / */,
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
595
596
597
598
599
600
601






602
603
604

605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623






624
625
626

627
628
629
630



631
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
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
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
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
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
595
596






597
598
599
600
601
602
603


604


605
606
607
608
609












610
611
612
613
614
615
616
617

618
619



620
621
622
623
624
625

626
627
628

629
630
631


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
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
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
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







+
+
+
+
+
+
+











-
+





-
+


-
+

+







-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
+
+
+
+


-
-
-
-
-
-
+
+
+
+
+
+








-
+









-
-
-
+
+
+



-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+


-
+


-
-
-
-
+
+
+
+



-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
-
-





-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+


-
+

-
-
-
+
+
+



-
+


-



-
-
+
-
-








-
-
-
-
+
+
+
+



-
-
+
+

-
-
-
+
+
+







-
+




+
-
+






-







-
-
+
-
-






-
-
+
-
-

-
-


-
-
+
+
-


-
-
+
+
-




-
-
-
-
+
+
+
+
+














+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+





+

-
-
+
+









-
-
+
-
-

-
-
-
-
-
-
-
+
+
+
+
+
+
+

+












-



-
-
+
-
-
















-
-
-
+
+
+


-
-
-
+
+
+

-











-
-
+
+


















-
+














-






-
-
+
+









-
+







-
+

-
-
+
+









-










-

+

+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
-







+



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+




-
+







 * Keeping a stack permits the CompileExprTree() routine to be non-recursive.
 */

typedef struct JumpList {
    JumpFixup jump;		/* Pass this argument to matching calls of
				 * TclEmitForwardJump() and
				 * TclFixupForwardJump(). */
    int depth;			/* Remember the currStackDepth of the
				 * CompileEnv here. */
    int offset;			/* Data used to compute jump lengths to pass
				 * to TclFixupForwardJump() */
    int convert;		/* Temporary storage used to compute whether
				 * numeric conversion will be needed following
				 * the operator we're compiling. */
    struct JumpList *next;	/* Point to next item on the stack */
} JumpList;

/*
 * Declarations for local functions to this file:
 */

static void		CompileExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj *const **litObjvPtr,
			    Tcl_Obj *const *funcObjv, Tcl_Token *tokenPtr,
			    CompileEnv *envPtr, int optimize);
static void		ConvertTreeToTokens(const char *start, size_t numBytes,
static void		ConvertTreeToTokens(const char *start, int numBytes,
			    OpNode *nodes, Tcl_Token *tokenPtr,
			    Tcl_Parse *parsePtr);
static int		ExecConstantExprTree(Tcl_Interp *interp, OpNode *nodes,
			    int index, Tcl_Obj * const **litObjvPtr);
static int		ParseExpr(Tcl_Interp *interp, const char *start,
			    size_t numBytes, OpNode **opTreePtr,
			    int numBytes, OpNode **opTreePtr,
			    Tcl_Obj *litList, Tcl_Obj *funcList,
			    Tcl_Parse *parsePtr, int parseOnly);
static size_t		ParseLexeme(const char *start, size_t numBytes,
static int		ParseLexeme(const char *start, int numBytes,
			    unsigned char *lexemePtr, Tcl_Obj **literalPtr);


/*
 *----------------------------------------------------------------------
 *
 * ParseExpr --
 *
 *	Given a string, the numBytes bytes starting at start, this function
 *	parses it as a Tcl expression and constructs a tree representing the
 *	structure of the expression. The caller must pass in empty lists as
 *	the funcList and litList arguments. The elements of the parsed
 *	expression are returned to the caller as that tree, a list of literal
 *	values, a list of function names, and in Tcl_Tokens added to a
 *	Tcl_Parse struct passed in by the caller.
 *	parses it as a Tcl expression and constructs a tree representing
 *	the structure of the expression.  The caller must pass in empty
 * 	lists as the funcList and litList arguments.  The elements of the
 *	parsed expression are returned to the caller as that tree, a list of
 *	literal values, a list of function names, and in Tcl_Tokens
 *	added to a Tcl_Parse struct passed in by the caller.
 *
 * Results:
 *	If the string is successfully parsed as a valid Tcl expression, TCL_OK
 *	is returned, and data about the expression structure is written to the
 *	last four arguments. If the string cannot be parsed as a valid Tcl
 *	expression, TCL_ERROR is returned, and if interp is non-NULL, an error
 *	message is written to interp.
 *	is returned, and data about the expression structure is written to
 *	the last four arguments.  If the string cannot be parsed as a valid
 *	Tcl expression, TCL_ERROR is returned, and if interp is non-NULL, an
 *	error message is written to interp.
 *
 * Side effects:
 *	Memory will be allocated. If TCL_OK is returned, the caller must clean
 *	up the returned data structures. The (OpNode *) value written to
 *	opTreePtr should be passed to Tcl_Free() and the parsePtr argument
 *	should be passed to Tcl_FreeParse(). The elements appended to the
 *	litList and funcList will automatically be freed whenever the refcount
 *	on those lists indicates they can be freed.
 *	Memory will be allocated.  If TCL_OK is returned, the caller must
 *	clean up the returned data structures.  The (OpNode *) value written
 *	to opTreePtr should be passed to ckfree() and the parsePtr argument
 *	should be passed to Tcl_FreeParse().  The elements appended to the
 *	litList and funcList will automatically be freed whenever the
 *	refcount on those lists indicates they can be freed.
 *
 *----------------------------------------------------------------------
 */

static int
ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    size_t numBytes,		/* Number of bytes in string. */
    int numBytes,		/* Number of bytes in string. */
    OpNode **opTreePtr,		/* Points to space where a pointer to the
				 * allocated OpNode tree should go. */
    Tcl_Obj *litList,		/* List to append literals to. */
    Tcl_Obj *funcList,		/* List to append function names to. */
    Tcl_Parse *parsePtr,	/* Structure to fill with tokens representing
				 * those operands that require run time
				 * substitutions. */
    int parseOnly)		/* A boolean indicating whether the caller's
				 * aim is just a parse, or whether it will go
				 * on to compile the expression. Different
				 * optimizations are appropriate for the two
				 * scenarios. */
				 * on to compile the expression.  Different
				 * optimizations are appropriate for the
				 * two scenarios. */
{
    OpNode *nodes = NULL;	/* Pointer to the OpNode storage array where
				 * we build the parse tree. */
    unsigned int nodesAvailable = 64; /* Initial size of the storage array. This
				 * value establishes a minimum tree memory
				 * cost of only about 1 kibyte, and is large
				 * enough for most expressions to parse with
				 * no need for array growth and
    unsigned nodesAvailable = 64;	/* Initial size of the storage array.  This
				 * value establishes a minimum tree memory cost
				 * of only about 1 kibyte, and is large enough
				 * for most expressions to parse with no need
				 * for array growth and reallocation. */
				 * reallocation. */
    unsigned int nodesUsed = 0;	/* Number of OpNodes filled. */
    size_t scanned = 0;		/* Capture number of byte scanned by parsing
				 * routines. */
    unsigned nodesUsed = 0;		/* Number of OpNodes filled. */
    int scanned = 0;		/* Capture number of byte scanned by
				 * parsing routines. */
    int lastParsed;		/* Stores info about what the lexeme parsed
				 * the previous pass through the parsing loop
				 * was. If it was an operator, lastParsed is
				 * was.  If it was an operator, lastParsed is
				 * the index of the OpNode for that operator.
				 * If it was not an operator, lastParsed holds
				 * an OperandTypes value encoding what we need
				 * to know about it. */
    int incomplete;		/* Index of the most recent incomplete tree in
				 * the OpNode array. Heads a stack of
				 * an OperandTypes value encoding what we
				 * need to know about it. */
    int incomplete;		/* Index of the most recent incomplete tree
				 * in the OpNode array.  Heads a stack of
				 * incomplete trees linked by p.prev. */
    int complete = OT_EMPTY;	/* "Index" of the complete tree (that is, a
				 * complete subexpression) determined at the
				 * moment. OT_EMPTY is a nonsense value used
				 * only to silence compiler warnings. During a
				 * parse, complete will always hold an index
				 * or an OperandTypes value pointing to an
				 * actual leaf at the time the complete tree
				 * is needed. */
				 * moment.   OT_EMPTY is a nonsense value
				 * used only to silence compiler warnings.
				 * During a parse, complete will always hold
				 * an index or an OperandTypes value pointing
				 * to an actual leaf at the time the complete
				 * tree is needed. */

    /*
     * These variables control generation of the error message.
    /* These variables control generation of the error message. */
     */

    Tcl_Obj *msg = NULL;	/* The error message. */
    Tcl_Obj *post = NULL;	/* In a few cases, an additional postscript
				 * for the error message, supplying more
				 * information after the error msg and
				 * location have been reported. */
    const char *errCode = NULL;	/* The detail word of the errorCode list, or
				 * NULL to indicate that no changes to the
				 * errorCode are to be done. */
    const char *subErrCode = NULL;
				/* Extra information for use in generating the
				 * errorCode. */
    const char *mark = "_@_";	/* In the portion of the complete error
				 * message where the error location is
				 * reported, this "mark" substring is inserted
				 * into the string being parsed to aid in
				 * pinpointing the location of the syntax
				 * error in the expression. */
    const char *mark = "_@_";	/* In the portion of the complete error message
				 * where the error location is reported, this
				 * "mark" substring is inserted into the
				 * string being parsed to aid in pinpointing
				 * the location of the syntax error in the
				 * expression. */
    int insertMark = 0;		/* A boolean controlling whether the "mark"
				 * should be inserted. */
    const unsigned limit = 25;	/* Portions of the error message are
    const int limit = 25;	/* Portions of the error message are
				 * constructed out of substrings of the
				 * original expression. In order to keep the
				 * error message readable, we impose this
				 * limit on the substring size we extract. */
				 * original expression.  In order to keep the
				 * error message readable, we impose this limit
				 * on the substring size we extract. */

    TclParseInit(interp, start, numBytes, parsePtr);

    nodes = (OpNode *)Tcl_AttemptAlloc(nodesAvailable * sizeof(OpNode));
    nodes = (OpNode *) attemptckalloc(nodesAvailable * sizeof(OpNode));
    if (nodes == NULL) {
	TclNewLiteralStringObj(msg, "not enough memory to parse expression");
	errCode = "NOMEM";
	goto error;
    }

    /*
     * Initialize the parse tree with the special "START" node.
    /* Initialize the parse tree with the special "START" node. */
     */

    nodes->lexeme = START;
    nodes->precedence = prec[START];
    nodes->mark = MARK_RIGHT;
    nodes->constant = 1;
    incomplete = lastParsed = nodesUsed;
    nodesUsed++;

    /*
     * Main parsing loop parses one lexeme per iteration. We exit the loop
     * only when there's a syntax error with a "goto error" which takes us to
     * the error handling code following the loop, or when we've successfully
     * completed the parse and we return to the caller.
     * Main parsing loop parses one lexeme per iteration.  We exit the
     * loop only when there's a syntax error with a "goto error" which
     * takes us to the error handling code following the loop, or when
     * we've successfully completed the parse and we return to the caller.
     */

    while (1) {
	OpNode *nodePtr;	/* Points to the OpNode we may fill this pass
				 * through the loop. */
	OpNode *nodePtr;	/* Points to the OpNode we may fill this
				 * pass through the loop. */
	unsigned char lexeme;	/* The lexeme we parse this iteration. */
	Tcl_Obj *literal;	/* Filled by the ParseLexeme() call when a
				 * literal is parsed that has a Tcl_Obj rep
				 * worth preserving. */
	Tcl_Obj *literal;	/* Filled by the ParseLexeme() call when
				 * a literal is parsed that has a Tcl_Obj
				 * rep worth preserving. */

	/*
	 * Each pass through this loop adds up to one more OpNode. Allocate
	 * space for one if required.
	 */

	if (nodesUsed >= nodesAvailable) {
	    unsigned int size = nodesUsed * 2;
	    unsigned size = nodesUsed * 2;
	    OpNode *newPtr = NULL;

	    do {
	      if (size <= UINT_MAX/sizeof(OpNode)) {
		newPtr = (OpNode *) attemptckrealloc((char *) nodes,
		newPtr = (OpNode *)Tcl_AttemptRealloc(nodes, size * sizeof(OpNode));
			(unsigned int) size * sizeof(OpNode));
	      }
	    } while ((newPtr == NULL)
		    && ((size -= (size - nodesUsed) / 2) > nodesUsed));
	    if (newPtr == NULL) {
		TclNewLiteralStringObj(msg,
			"not enough memory to parse expression");
		errCode = "NOMEM";
		goto error;
	    }
	    nodesAvailable = size;
	    nodes = newPtr;
	}
	nodePtr = nodes + nodesUsed;

	/*
	 * Skip white space between lexemes.
	/* Skip white space between lexemes. */
	 */

	scanned = TclParseAllWhiteSpace(start, numBytes);
	start += scanned;
	numBytes -= scanned;

	scanned = ParseLexeme(start, numBytes, &lexeme, &literal);

	/*
	 * Use context to categorize the lexemes that are ambiguous.
	/* Use context to categorize the lexemes that are ambiguous. */
	 */

	if ((NODE_TYPE & lexeme) == 0) {
	    int b;

	    switch (lexeme) {
	    case INVALID:
		msg = Tcl_ObjPrintf("invalid character \"%.*s\"",
			(int)scanned, start);
		msg = Tcl_ObjPrintf(
			"invalid character \"%.*s\"", scanned, start);
		errCode = "BADCHAR";
		goto error;
	    case INCOMPLETE:
		msg = Tcl_ObjPrintf("incomplete operator \"%.*s\"",
			(int)scanned, start);
		msg = Tcl_ObjPrintf(
			"incomplete operator \"%.*s\"", scanned, start);
		errCode = "PARTOP";
		goto error;
	    case BAREWORD:

		/*
		 * Most barewords in an expression are a syntax error. The
		 * exceptions are that when a bareword is followed by an open
		 * paren, it might be a function call, and when the bareword
		 * is a legal literal boolean value, we accept that as well.
		 * Most barewords in an expression are a syntax error.
		 * The exceptions are that when a bareword is followed by
		 * an open paren, it might be a function call, and when the
		 * bareword is a legal literal boolean value, we accept that
		 * as well.
		 */

		if (start[scanned+TclParseAllWhiteSpace(
			start+scanned, numBytes-scanned)] == '(') {
		    lexeme = FUNCTION;

		    /*
		     * When we compile the expression we'll need the function
		     * name, and there's no place in the parse tree to store
		     * it, so we keep a separate list of all the function
		     * names we've parsed in the order we found them.
		     */

		    Tcl_ListObjAppendElement(NULL, funcList, literal);
		} else {
		    int b;
		} else if (Tcl_GetBooleanFromObj(NULL,literal,&b) == TCL_OK) {
		    lexeme = BOOLEAN;
		} else {
		    Tcl_DecrRefCount(literal);
		    msg = Tcl_ObjPrintf("invalid bareword \"%.*s%s\"",
			    (scanned < limit) ? (int)scanned : (int)limit - 3, start,
			    (scanned < limit) ? "" : "...");
		    post = Tcl_ObjPrintf(
			    "should be \"$%.*s%s\" or \"{%.*s%s}\"",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    Tcl_AppendPrintfToObj(post, " or \"%.*s%s(...)\" or ...",
			    (scanned < limit) ? (int)scanned : (int)limit - 3,
			    start, (scanned < limit) ? "" : "...");
		    if (Tcl_GetBooleanFromObj(NULL, literal, &b) == TCL_OK) {
			lexeme = BOOLEAN;
		    } else {
			Tcl_DecrRefCount(literal);
			msg = Tcl_ObjPrintf(
				"invalid bareword \"%.*s%s\"",
				(scanned < limit) ? scanned : limit - 3, start,
				(scanned < limit) ? "" : "...");
			post = Tcl_ObjPrintf(
				"should be \"$%.*s%s\" or \"{%.*s%s}\"",
				(scanned < limit) ? scanned : limit - 3,
				start, (scanned < limit) ? "" : "...",
				(scanned < limit) ? scanned : limit - 3,
				start, (scanned < limit) ? "" : "...");
			Tcl_AppendPrintfToObj(post,
				" or \"%.*s%s(...)\" or ...",
				(scanned < limit) ? scanned : limit - 3,
				start, (scanned < limit) ? "" : "...");
		    errCode = "BAREWORD";
		    if (start[0] == '0') {
			const char *stop;
			TclParseNumber(NULL, NULL, NULL, start, scanned,
				&stop, TCL_PARSE_NO_WHITESPACE);
			if (start[0] == '0') {
			    const char *stop;
			    TclParseNumber(NULL, NULL, NULL, start, scanned,
				    &stop, TCL_PARSE_NO_WHITESPACE);

			if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
			    switch (start[1]) {
			    case 'b':
				Tcl_AppendToObj(post,
					" (invalid binary number?)", -1);
			    if (isdigit(UCHAR(*stop)) || (stop == start + 1)) {
				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;

				switch (start[1]) {
				case 'b':
				    Tcl_AppendToObj(post,
					    " (invalid binary number?)", -1);
				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
				errCode = "BADNUMBER";
				subErrCode = "BINARY";
				break;
			    case 'o':
				Tcl_AppendToObj(post,
					" (invalid octal number?)", -1);
				    break;
				case 'o':
				    Tcl_AppendToObj(post,
					    " (invalid octal number?)", -1);
				parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
				errCode = "BADNUMBER";
				subErrCode = "OCTAL";
				break;
			    default:
				if (isdigit(UCHAR(start[1]))) {
				    Tcl_AppendToObj(post,
					    " (invalid octal number?)", -1);
				    break;
				default:
				    if (isdigit(UCHAR(start[1]))) {
				        Tcl_AppendToObj(post,
						" (invalid octal number?)", -1);
				    parsePtr->errorType = TCL_PARSE_BAD_NUMBER;
				    errCode = "BADNUMBER";
				    subErrCode = "OCTAL";
				}
				break;
			    }
			}
		    }
		    goto error;
				    }
				    break;
				}
			    }
			}
			goto error;
		    }
		}
		break;
	    case PLUS:
	    case MINUS:
		if (IsOperator(lastParsed)) {

		    /*
		     * A "+" or "-" coming just after another operator must be
		     * interpreted as a unary operator.
		     * A "+" or "-" coming just after another operator
		     * must be interpreted as a unary operator.
		     */

		    lexeme |= UNARY;
		} else {
		    lexeme |= BINARY;
		}
	    }
	}	/* Uncategorized lexemes */

	/*
	 * Handle lexeme based on its category.
	/* Handle lexeme based on its category. */
	 */

	switch (NODE_TYPE & lexeme) {
	case LEAF: {
	    /*
	     * Each LEAF results in either a literal getting appended to the
	     * litList, or a sequence of Tcl_Tokens representing a Tcl word
	     * getting appended to the parsePtr->tokens. No OpNode is filled
	     * for this lexeme.
	     */

	/*
	 * Each LEAF results in either a literal getting appended to the
	 * litList, or a sequence of Tcl_Tokens representing a Tcl word
	 * getting appended to the parsePtr->tokens.  No OpNode is filled
	 * for this lexeme.
	 */

	case LEAF: {
	    Tcl_Token *tokenPtr;
	    const char *end = start;
	    int wordIndex;
	    int code = TCL_OK;

	    /*
	     * A leaf operand appearing just after something that's not an
	     * operator is a syntax error.
	     */

	    if (NotOperator(lastParsed)) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		errCode = "MISSING";
		scanned = 0;
		insertMark = 1;

		/*
		 * Free any literal to avoid a memleak.
		/* Free any literal to avoid a memleak. */
		 */

		if ((lexeme == NUMBER) || (lexeme == BOOLEAN)) {
		    Tcl_DecrRefCount(literal);
		}
		goto error;
	    }

	    switch (lexeme) {
	    case NUMBER:
	    case BOOLEAN:
		/*
		 * TODO: Consider using a dict or hash to collapse all
		 * duplicate literals into a single representative value.
		 * (Like what is done with [split $s {}]).
		 * Pro:	~75% memory saving on expressions like
		 *	{1+1+1+1+1+.....+1} (Convert "pointer + Tcl_Obj" cost
		 *	to "pointer" cost only)
		 * Con:	Cost of the dict store/retrieve on every literal in
		 *	every expression when expressions like the above tend
		 *	to be uncommon.
		 * Con:	Cost of the dict store/retrieve on every literal
		 *	in every expression when expressions like the above
		 *	tend to be uncommon.
		 *	The memory savings is temporary; Compiling to bytecode
		 *	will collapse things as literals are registered
		 *	anyway, so the savings applies only to the time
		 *	between parsing and compiling. Possibly important due
		 *	to high-water mark nature of memory allocation.
		 * 	anyway, so the savings applies only to the time
		 *	between parsing and compiling.  Possibly important
		 *	due to high-water mark nature of memory allocation.
		 */

		Tcl_ListObjAppendElement(NULL, litList, literal);
		complete = lastParsed = OT_LITERAL;
		start += scanned;
		numBytes -= scanned;
		continue;

	    default:
		break;
	    }

	    /*
	     * Remaining LEAF cases may involve filling Tcl_Tokens, so make
	     * room for at least 2 more tokens.
	     * Remaining LEAF cases may involve filling Tcl_Tokens, so
	     * make room for at least 2 more tokens.
	     */

	    TclGrowParseTokenArray(parsePtr, 2);
	    wordIndex = parsePtr->numTokens;
	    tokenPtr = parsePtr->tokenPtr + wordIndex;
	    tokenPtr->type = TCL_TOKEN_WORD;
	    tokenPtr->start = start;
	    parsePtr->numTokens++;

	    switch (lexeme) {
	    case QUOTED:
		code = Tcl_ParseQuotedString(NULL, start, numBytes,
			parsePtr, 1, &end);
		scanned = end - start;
		break;

	    case BRACED:
		code = Tcl_ParseBraces(NULL, start, numBytes,
			parsePtr, 1, &end);
			    parsePtr, 1, &end);
		scanned = end - start;
		break;

	    case VARIABLE:
		code = Tcl_ParseVarName(NULL, start, numBytes, parsePtr, 1);

		/*
		 * Handle the quirk that Tcl_ParseVarName reports a successful
		 * parse even when it gets only a "$" with no variable name.
		 */

		tokenPtr = parsePtr->tokenPtr + wordIndex + 1;
		if (code == TCL_OK && tokenPtr->type != TCL_TOKEN_VARIABLE) {
		    TclNewLiteralStringObj(msg, "invalid character \"$\"");
		    errCode = "BADCHAR";
		    goto error;
		}
		scanned = tokenPtr->size;
		break;

	    case SCRIPT: {
		Tcl_Parse *nestedPtr = (Tcl_Parse *)
			TclStackAlloc(interp, sizeof(Tcl_Parse));
		Tcl_Parse *nestedPtr =
			(Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));

		tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		tokenPtr->type = TCL_TOKEN_COMMAND;
		tokenPtr->start = start;
		tokenPtr->numComponents = 0;

		end = start + numBytes;
		start++;
		while (1) {
		    code = Tcl_ParseCommand(interp, start, end - start, 1,
		    code = Tcl_ParseCommand(interp, start, (end - start), 1,
			    nestedPtr);
		    if (code != TCL_OK) {
			parsePtr->term = nestedPtr->term;
			parsePtr->errorType = nestedPtr->errorType;
			parsePtr->incomplete = nestedPtr->incomplete;
			break;
		    }
		    start = nestedPtr->commandStart + nestedPtr->commandSize;
		    start = (nestedPtr->commandStart + nestedPtr->commandSize);
		    Tcl_FreeParse(nestedPtr);
		    if ((nestedPtr->term < end) && (nestedPtr->term[0] == ']')
			    && !nestedPtr->incomplete) {
		    if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
			    && !(nestedPtr->incomplete)) {
			break;
		    }

		    if (start == end) {
			TclNewLiteralStringObj(msg, "missing close-bracket");
			parsePtr->term = tokenPtr->start;
			parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
			parsePtr->incomplete = 1;
			code = TCL_ERROR;
			errCode = "UNBALANCED";
			break;
		    }
		}
		TclStackFree(interp, nestedPtr);
		end = start;
		start = tokenPtr->start;
		scanned = end - start;
		tokenPtr->size = scanned;
		parsePtr->numTokens++;
		break;
	    }			/* SCRIPT case */
	    }
	    }
	    if (code != TCL_OK) {

		/*
		 * Here we handle all the syntax errors generated by the
		 * Tcl_Token generating parsing routines called in the switch
		 * just above. If the value of parsePtr->incomplete is 1, then
		 * the error was an unbalanced '[', '(', '{', or '"' and
		 * parsePtr->term is pointing to that unbalanced character. If
		 * the value of parsePtr->incomplete is 0, then the error is
		 * one of lacking whitespace following a quoted word, for
		 * example: expr {[an error {foo}bar]}, and parsePtr->term
		 * points to where the whitespace is missing. We reset our
		 * values of start and scanned so that when our error message
		 * is constructed, the location of the syntax error is sure to
		 * appear in it, even if the quoted expression is truncated.
		 * Here we handle all the syntax errors generated by
		 * the Tcl_Token generating parsing routines called in the
		 * switch just above.  If the value of parsePtr->incomplete
		 * is 1, then the error was an unbalanced '[', '(', '{',
		 * or '"' and parsePtr->term is pointing to that unbalanced
		 * character.  If the value of parsePtr->incomplete is 0,
		 * then the error is one of lacking whitespace following a
		 * quoted word, for example: expr {[an error {foo}bar]},
		 * and parsePtr->term points to where the whitespace is
		 * missing.  We reset our values of start and scanned so that
		 * when our error message is constructed, the location of
		 * the syntax error is sure to appear in it, even if the
		 * quoted expression is truncated.
		 */

		start = parsePtr->term;
		scanned = parsePtr->incomplete;
		if (parsePtr->incomplete) {
		    errCode = "UNBALANCED";
		}
		goto error;
	    }

	    tokenPtr = parsePtr->tokenPtr + wordIndex;
	    tokenPtr->size = scanned;
	    tokenPtr->numComponents = parsePtr->numTokens - wordIndex - 1;
	    if (!parseOnly && ((lexeme == QUOTED) || (lexeme == BRACED))) {

		/*
		 * When this expression is destined to be compiled, and a
		 * braced or quoted word within an expression is known at
		 * compile time (no runtime substitutions in it), we can store
		 * it as a literal rather than in its tokenized form. This is
		 * an advantage since the compiled bytecode is going to need
		 * the argument in Tcl_Obj form eventually, so it's just as
		 * well to get there now. Another advantage is that with this
		 * conversion, larger constant expressions might be grown and
		 * optimized.
		 * compile time (no runtime substitutions in it), we can
		 * store it as a literal rather than in its tokenized form.
		 * This is an advantage since the compiled bytecode is going
		 * to need the argument in Tcl_Obj form eventually, so it's
		 * just as well to get there now.  Another advantage is that
		 * with this conversion, larger constant expressions might
		 * be grown and optimized.
		 *
		 * On the contrary, if the end goal of this parse is to fill a
		 * Tcl_Parse for a caller of Tcl_ParseExpr(), then it's
		 * On the contrary, if the end goal of this parse is to
		 * fill a Tcl_Parse for a caller of Tcl_ParseExpr(), then it's
		 * wasteful to convert to a literal only to convert back again
		 * later.
		 */

		TclNewObj(literal);
		literal = Tcl_NewObj();
		if (TclWordKnownAtCompileTime(tokenPtr, literal)) {
		    Tcl_ListObjAppendElement(NULL, litList, literal);
		    complete = lastParsed = OT_LITERAL;
		    parsePtr->numTokens = wordIndex;
		    break;
		}
		Tcl_DecrRefCount(literal);
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
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
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

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
1439

1440
1441
1442
1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467




1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482

1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504

1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516

1517
1518
1519
1520

1521
1522
1523
1524

1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541

1542
1543
1544
1545

1546
1547
1548
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
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
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
1668
1669
1670
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
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


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
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
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
1439
1440
1441
1442
1443
1444


1445


1446

1447
1448
1449


1450


1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470
1471











1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489

1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501
1502



1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514

1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1527


1528


1529
1530


1531


1532

1533
1534
1535


1536


1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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







-



-
-
+
-
-







-
+






-
-
-
+
+
+




















+




-
-
-
-
+
+
+
+









-







-





-


-

+
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
+





-





-
-
-
-
-
-
-
+
+
+
+
+
+
+




-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+










-
-
+
+
-
-





-
-
-
+
+
+













-
-
+
-






-







+
-
+


-










-



















-
-
-
+
+
+








+











-
-
+
+











-
-
+
-





-










-








-



-
-
+
-
-




-
-
+
-
-







-
-
-
+
+
+














-
-
-
+
+
+














+
+

-
-
+
+
+


-




-
-
+
-
-

-
+



-
-
+
+
-
-




+

-
-
+
+














-
+


-
+


-
+



-
-
+
-
-







-
-
+
-
-



-
+

-
-
-
-













-
-
-
-
+
+
+
+














-
+




















-
-
+
-
-








-
-
+
-
-

-
+


-
-
+
-
-














-
+




+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+





+

-
+






-
+



+

-
-
-
+
+
+









-
+




-
+







-
-
+
-
-


-
-
+
-
-

-
+


-
-
+
-
-
















-
+






-
-
-
+
+
+


















-
+







	     * operand of an operator that doesn't take one.
	     */

	    if (NotOperator(lastParsed)) {
		msg = Tcl_ObjPrintf("missing operator at %s", mark);
		scanned = 0;
		insertMark = 1;
		errCode = "MISSING";
		goto error;
	    }

	    /*
	     * Create an OpNode for the unary operator.
	    /* Create an OpNode for the unary operator */
	     */

	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = prec[lexeme];
	    nodePtr->mark = MARK_RIGHT;

	    /*
	     * A FUNCTION cannot be a constant expression, because Tcl allows
	     * functions to return variable results with the same arguments;
	     * for example, rand(). Other unary operators can root a constant
	     * for example, rand().  Other unary operators can root a constant
	     * expression, so long as the argument is a constant expression.
	     */

	    nodePtr->constant = (lexeme != FUNCTION);

	    /*
	     * This unary operator is a new incomplete tree, so push it onto
	     * our stack of incomplete trees. Also remember it as the last
	     * lexeme we parsed.
	     * This unary operator is a new incomplete tree, so push it
	     * onto our stack of incomplete trees.  Also remember it as
	     * the last lexeme we parsed.
	     */

	    nodePtr->p.prev = incomplete;
	    incomplete = lastParsed = nodesUsed;
	    nodesUsed++;
	    break;

	case BINARY: {
	    OpNode *incompletePtr;
	    unsigned char precedence = prec[lexeme];

	    /*
	     * A binary operator appearing just after another operator is a
	     * syntax error -- one of the two operators is missing an operand.
	     */

	    if (IsOperator(lastParsed)) {
		if ((lexeme == CLOSE_PAREN)
			&& (nodePtr[-1].lexeme == OPEN_PAREN)) {
		    if (nodePtr[-2].lexeme == FUNCTION) {

			/*
			 * Normally, "()" is a syntax error, but as a special
			 * case accept it as an argument list for a function.
			 * Treat this as a special LEAF lexeme, and restart
			 * the parsing loop with zero characters scanned. We
			 * will parse the ")" again the next time through, but
			 * with the OT_EMPTY leaf as the subexpression between
			 * the parens.
			 * the parsing loop with zero characters scanned.
			 * We'll parse the ")" again the next time through,
			 * but with the OT_EMPTY leaf as the subexpression
			 * between the parens.
			 */

			scanned = 0;
			complete = lastParsed = OT_EMPTY;
			break;
		    }
		    msg = Tcl_ObjPrintf("empty subexpression at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    errCode = "EMPTY";
		    goto error;
		}

		if (nodePtr[-1].precedence > precedence) {
		    if (nodePtr[-1].lexeme == OPEN_PAREN) {
			TclNewLiteralStringObj(msg, "unbalanced open paren");
			parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
			errCode = "UNBALANCED";
		    } else if (nodePtr[-1].lexeme == COMMA) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
			errCode = "MISSING";
		    } else if (nodePtr[-1].lexeme == START) {
			TclNewLiteralStringObj(msg, "empty expression");
			errCode = "EMPTY";
		    }
		} else {
		} else if (lexeme == CLOSE_PAREN) {
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		    if (lexeme == CLOSE_PAREN) {
			TclNewLiteralStringObj(msg, "unbalanced close paren");
		    errCode = "UNBALANCED";
		} else if ((lexeme == COMMA)
			&& (nodePtr[-1].lexeme == OPEN_PAREN)
			&& (nodePtr[-2].lexeme == FUNCTION)) {
		    msg = Tcl_ObjPrintf("missing function argument at %s",
			    mark);
		    scanned = 0;
		    insertMark = 1;
		    } else if ((lexeme == COMMA)
			    && (nodePtr[-1].lexeme == OPEN_PAREN)
			    && (nodePtr[-2].lexeme == FUNCTION)) {
			msg = Tcl_ObjPrintf(
				"missing function argument at %s", mark);
			scanned = 0;
			insertMark = 1;
		    errCode = "UNBALANCED";
		    }
		}
		if (msg == NULL) {
		    msg = Tcl_ObjPrintf("missing operand at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    errCode = "MISSING";
		}
		goto error;
	    }

	    /*
	     * Here is where the tree comes together. At this point, we have a
	     * stack of incomplete trees corresponding to substrings that are
	     * incomplete expressions, followed by a complete tree
	     * corresponding to a substring that is itself a complete
	     * expression, followed by the binary operator we have just
	     * parsed. The incomplete trees can each be completed by adding a
	     * right operand.
	     * Here is where the tree comes together.  At this point, we
	     * have a stack of incomplete trees corresponding to
	     * substrings that are incomplete expressions, followed by
	     * a complete tree corresponding to a substring that is itself
	     * a complete expression, followed by the binary operator we have
	     * just parsed.  The incomplete trees can each be completed by
	     * adding a right operand.
	     *
	     * To illustrate with an example, when we parse the expression
	     * "1+2*3-4" and we reach this point having just parsed the "-"
	     * operator, we have these incomplete trees: START, "1+", and
	     * "2*". Next we have the complete subexpression "3". Last is the
	     * "-" we've just parsed.
	     * "2*".  Next we have the complete subexpression "3".  Last is
	     * the "-" we've just parsed.
	     *
	     * The next step is to join our complete tree to an operator. The
	     * choice is governed by the precedence and associativity of the
	     * competing operators. If we connect it as the right operand of
	     * our most recent incomplete tree, we get a new complete tree,
	     * and we can repeat the process. The while loop following repeats
	     * this until precedence indicates it is time to join the complete
	     * tree as the left operand of the just parsed binary operator.
	     * The next step is to join our complete tree to an operator.
	     * The choice is governed by the precedence and associativity
	     * of the competing operators.  If we connect it as the right
	     * operand of our most recent incomplete tree, we get a new
	     * complete tree, and we can repeat the process.  The while
	     * loop following repeats this until precedence indicates it
	     * is time to join the complete tree as the left operand of
	     * the just parsed binary operator.
	     *
	     * Continuing the example, the first pass through the loop will
	     * join "3" to "2*"; the next pass will join "2*3" to "1+". Then
	     * we'll exit the loop and join "1+2*3" to "-". When we return to
	     * parse another lexeme, our stack of incomplete trees is START
	     * and "1+2*3-".
	     * Continuing the example, the first pass through the loop
	     * will join "3" to "2*"; the next pass will join "2*3" to
	     * "1+".  Then we'll exit the loop and join "1+2*3" to "-".
	     * When we return to parse another lexeme, our stack of
	     * incomplete trees is START and "1+2*3-".
	     */

	    while (1) {
		incompletePtr = nodes + incomplete;

		if (incompletePtr->precedence < precedence) {
		    break;
		}

		if (incompletePtr->precedence == precedence) {
		    /*
		     * Right association rules for exponentiation.

		    /* Right association rules for exponentiation. */
		     */

		    if (lexeme == EXPON) {
			break;
		    }

		    /*
		     * Special association rules for the conditional
		     * operators. The "?" and ":" operators have equal
		     * precedence, but must be linked up in sensible pairs.
		     * Special association rules for the conditional operators.
		     * The "?" and ":" operators have equal precedence, but
		     * must be linked up in sensible pairs.
		     */

		    if ((incompletePtr->lexeme == QUESTION)
			    && (NotOperator(complete)
			    || (nodes[complete].lexeme != COLON))) {
			break;
		    }
		    if ((incompletePtr->lexeme == COLON)
			    && (lexeme == QUESTION)) {
			break;
		    }
		}

		/*
		 * Some special syntax checks...
		/* Some special syntax checks... */
		 */

		/* Parens must balance */
		if ((incompletePtr->lexeme == OPEN_PAREN)
			&& (lexeme != CLOSE_PAREN)) {
		    TclNewLiteralStringObj(msg, "unbalanced open paren");
		    parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
		    errCode = "UNBALANCED";
		    goto error;
		}

		/* Right operand of "?" must be ":" */
		if ((incompletePtr->lexeme == QUESTION)
			&& (NotOperator(complete)
			|| (nodes[complete].lexeme != COLON))) {
		    msg = Tcl_ObjPrintf(
		    msg = Tcl_ObjPrintf("missing operator \":\" at %s", mark);
			    "missing operator \":\" at %s", mark);
		    scanned = 0;
		    insertMark = 1;
		    errCode = "MISSING";
		    goto error;
		}

		/* Operator ":" may only be right operand of "?" */
		if (IsOperator(complete)
			&& (nodes[complete].lexeme == COLON)
			&& (incompletePtr->lexeme != QUESTION)) {
		    TclNewLiteralStringObj(msg,
			    "unexpected operator \":\" "
			    "without preceding \"?\"");
		    errCode = "SURPRISE";
		    goto error;
		}

		/*
		 * Attach complete tree as right operand of most recent
		 * incomplete tree.
		 */

		incompletePtr->right = complete;
		if (IsOperator(complete)) {
		    nodes[complete].p.parent = incomplete;
		    incompletePtr->constant = incompletePtr->constant
			    && nodes[complete].constant;
		} else {
		    incompletePtr->constant = incompletePtr->constant
			    && (complete == OT_LITERAL);
		}

		/*
		 * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations
		 * each make up a single operator. Force them to agree whether
		 * they have a constant expression.
		 * The QUESTION/COLON and FUNCTION/OPEN_PAREN combinations each
		 * make up a single operator.  Force them to agree whether they
		 * have a constant expression.
		 */

		if ((incompletePtr->lexeme == QUESTION)
			|| (incompletePtr->lexeme == FUNCTION)) {
		    nodes[complete].constant = incompletePtr->constant;
		}

		if (incompletePtr->lexeme == START) {

		    /*
		     * Completing the START tree indicates we're done.
		     * Transfer the parse tree to the caller and return.
		     */

		    *opTreePtr = nodes;
		    return TCL_OK;
		}

		/*
		 * With a right operand attached, last incomplete tree has
		 * become the complete tree. Pop it from the incomplete tree
		 * stack.
		 * become the complete tree.  Pop it from the incomplete
		 * tree stack.
		 */

		complete = incomplete;
		incomplete = incompletePtr->p.prev;

		/* CLOSE_PAREN can only close one OPEN_PAREN. */
		if (incompletePtr->lexeme == OPEN_PAREN) {
		    break;
		}
	    }

	    /*
	     * More syntax checks...
	    /* More syntax checks... */
	     */

	    /* Parens must balance. */
	    if (lexeme == CLOSE_PAREN) {
		if (incompletePtr->lexeme != OPEN_PAREN) {
		    TclNewLiteralStringObj(msg, "unbalanced close paren");
		    errCode = "UNBALANCED";
		    goto error;
		}
	    }

	    /* Commas must appear only in function argument lists. */
	    if (lexeme == COMMA) {
		if  ((incompletePtr->lexeme != OPEN_PAREN)
			|| (incompletePtr[-1].lexeme != FUNCTION)) {
		    TclNewLiteralStringObj(msg,
			    "unexpected \",\" outside function argument list");
		    errCode = "SURPRISE";
		    goto error;
		}
	    }

	    /* Operator ":" may only be right operand of "?" */
	    if (IsOperator(complete) && (nodes[complete].lexeme == COLON)) {
		TclNewLiteralStringObj(msg,
			"unexpected operator \":\" without preceding \"?\"");
		errCode = "SURPRISE";
		goto error;
	    }

	    /*
	     * Create no node for a CLOSE_PAREN lexeme.
	    /* Create no node for a CLOSE_PAREN lexeme. */
	     */

	    if (lexeme == CLOSE_PAREN) {
		break;
	    }

	    /*
	     * Link complete tree as left operand of new node.
	    /* Link complete tree as left operand of new node. */
	     */

	    nodePtr->lexeme = lexeme;
	    nodePtr->precedence = precedence;
	    nodePtr->mark = MARK_LEFT;
	    nodePtr->left = complete;

	    /*
	     * The COMMA operator cannot be optimized, since the function
	     * needs all of its arguments, and optimization would reduce the
	     * number. Other binary operators root constant expressions when
	     * both arguments are constant expressions.
	     * needs all of its arguments, and optimization would reduce
	     * the number.  Other binary operators root constant expressions
	     * when both arguments are constant expressions.
	     */

	    nodePtr->constant = (lexeme != COMMA);

	    if (IsOperator(complete)) {
		nodes[complete].p.parent = nodesUsed;
		nodePtr->constant = nodePtr->constant
			&& nodes[complete].constant;
	    } else {
		nodePtr->constant = nodePtr->constant
			&& (complete == OT_LITERAL);
	    }

	    /*
	     * With a left operand attached and a right operand missing, the
	     * just-parsed binary operator is root of a new incomplete tree.
	     * Push it onto the stack of incomplete trees.
	     * With a left operand attached and a right operand missing,
	     * the just-parsed binary operator is root of a new incomplete
	     * tree.  Push it onto the stack of incomplete trees.
	     */

	    nodePtr->p.prev = incomplete;
	    incomplete = lastParsed = nodesUsed;
	    nodesUsed++;
	    break;
	}	/* case BINARY */
	}	/* lexeme handler */

	/* Advance past the just-parsed lexeme */
	start += scanned;
	numBytes -= scanned;
    }	/* main parsing loop */

  error:

    /*
     * We only get here if there's been an error. Any errors that didn't get a
     * suitable parsePtr->errorType, get recorded as syntax errors.
     * We only get here if there's been an error.
     * Any errors that didn't get a suitable parsePtr->errorType,
     * get recorded as syntax errors.
     */

  error:
    if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
	parsePtr->errorType = TCL_PARSE_SYNTAX;
    }

    /*
     * Free any partial parse tree we've built.
    /* Free any partial parse tree we've built. */
     */

    if (nodes != NULL) {
	Tcl_Free(nodes);
	ckfree((char*) nodes);
    }

    if (interp == NULL) {
	/*
	 * Nowhere to report an error message, so just free it.

	/* Nowhere to report an error message, so just free it */
	 */

	if (msg) {
	    Tcl_DecrRefCount(msg);
	}
    } else {

	/*
	 * Construct the complete error message. Start with the simple error
	 * message, pulled from the interp result if necessary...
	 * Construct the complete error message.  Start with the simple
	 * error message, pulled from the interp result if necessary...
	 */

	if (msg == NULL) {
	    msg = Tcl_GetObjResult(interp);
	}

	/*
	 * Add a detailed quote from the bad expression, displaying and
	 * sometimes marking the precise location of the syntax error.
	 */

	Tcl_AppendPrintfToObj(msg, "\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
		((start - limit) < parsePtr->string) ? "" : "...",
		((start - limit) < parsePtr->string)
			? (int) (start - parsePtr->string) : (int)limit - 3,
			? (int) (start - parsePtr->string) : limit - 3,
		((start - limit) < parsePtr->string)
			? parsePtr->string : start - limit + 3,
		(scanned < limit) ? (int)scanned : (int)limit - 3, start,
		(scanned < limit) ? scanned : limit - 3, start,
		(scanned < limit) ? "" : "...", insertMark ? mark : "",
		(start + scanned + limit > parsePtr->end)
			? (int) (parsePtr->end - start) - (int)scanned : (int)limit-3,
			? (int) (parsePtr->end - start) - scanned : limit-3,
		start + scanned,
		(start + scanned + limit > parsePtr->end) ? "" : "...");

	/*
	 * Next, append any postscript message.
	/* Next, append any postscript message. */
	 */

	if (post != NULL) {
	    Tcl_AppendToObj(msg, ";\n", -1);
	    Tcl_AppendObjToObj(msg, post);
	    Tcl_DecrRefCount(post);
	}
	Tcl_SetObjResult(interp, msg);

	/*
	 * Finally, place context information in the errorInfo.
	/* Finally, place context information in the errorInfo. */
	 */

	numBytes = parsePtr->end - parsePtr->string;
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (parsing expression \"%.*s%s\")",
		(numBytes < limit) ? (int)numBytes : (int)limit - 3,
		(numBytes < limit) ? numBytes : limit - 3,
		parsePtr->string, (numBytes < limit) ? "" : "..."));
	if (errCode) {
	    Tcl_SetErrorCode(interp, "TCL", "PARSE", "EXPR", errCode,
		    subErrCode, NULL);
	}
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertTreeToTokens --
 *
 *	Given a string, the numBytes bytes starting at start, and an OpNode
 *	tree and Tcl_Token array created by passing that same string to
 *	ParseExpr(), this function writes into *parsePtr the sequence of
 *	Tcl_Tokens needed so to satisfy the historical interface provided by
 *	Tcl_ParseExpr(). Note that this routine exists only for the sake of
 *	the public Tcl_ParseExpr() routine. It is not used by Tcl itself at
 *	all.
 * 	Tcl_Tokens needed so to satisfy the historical interface provided
 * 	by Tcl_ParseExpr().  Note that this routine exists only for the sake
 *	of the public Tcl_ParseExpr() routine.  It is not used by Tcl itself
 * 	at all.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The Tcl_Parse *parsePtr is filled with Tcl_Tokens representing the
 *	parsed expression.
 *
 *----------------------------------------------------------------------
 */

static void
ConvertTreeToTokens(
    const char *start,
    size_t numBytes,
    int numBytes,
    OpNode *nodes,
    Tcl_Token *tokenPtr,
    Tcl_Parse *parsePtr)
{
    int subExprTokenIdx = 0;
    OpNode *nodePtr = nodes;
    int next = nodePtr->right;

    while (1) {
	Tcl_Token *subExprTokenPtr;
	int scanned, parentIdx;
	unsigned char lexeme;

	/*
	 * Advance the mark so the next exit from this node won't retrace
	 * steps over ground already covered.
	 */

	nodePtr->mark++;

	/*
	 * Handle next child node or leaf.
	/* Handle next child node or leaf */
	 */

	switch (next) {
	case OT_EMPTY:

	    /* No tokens and no characters for the OT_EMPTY leaf. */
	    break;

	case OT_LITERAL:

	    /*
	     * Skip any white space that comes before the literal.
	    /* Skip any white space that comes before the literal */
	     */

	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start += scanned;
	    start +=scanned;
	    numBytes -= scanned;

	    /*
	     * Reparse the literal to get pointers into source string.
	    /* Reparse the literal to get pointers into source string */
	     */

	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);

	    TclGrowParseTokenArray(parsePtr, 2);
	    subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
	    subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
	    subExprTokenPtr->start = start;
	    subExprTokenPtr->size = scanned;
	    subExprTokenPtr->numComponents = 1;
	    subExprTokenPtr[1].type = TCL_TOKEN_TEXT;
	    subExprTokenPtr[1].start = start;
	    subExprTokenPtr[1].size = scanned;
	    subExprTokenPtr[1].numComponents = 0;

	    parsePtr->numTokens += 2;
	    start += scanned;
	    start +=scanned;
	    numBytes -= scanned;
	    break;

	case OT_TOKENS: {

	    /*
	     * tokenPtr points to a token sequence that came from parsing a
	     * Tcl word. A Tcl word is made up of a sequence of one or more
	     * elements. When the word is only a single element, it's been the
	     * historical practice to replace the TCL_TOKEN_WORD token
	     * directly with a TCL_TOKEN_SUB_EXPR token. However, when the
	     * word has multiple elements, a TCL_TOKEN_WORD token is kept as a
	     * grouping device so that TCL_TOKEN_SUB_EXPR always has only one
	     * element. Wise or not, these are the rules the Tcl expr parser
	     * has followed, and for the sake of those few callers of
	     * Tcl_ParseExpr() we do not change them now. Internally, we can
	     * do better.
	     * tokenPtr points to a token sequence that came from parsing
	     * a Tcl word.  A Tcl word is made up of a sequence of one or
	     * more elements.  When the word is only a single element, it's
	     * been the historical practice to replace the TCL_TOKEN_WORD
	     * token directly with a TCL_TOKEN_SUB_EXPR token.  However,
	     * when the word has multiple elements, a TCL_TOKEN_WORD token
	     * is kept as a grouping device so that TCL_TOKEN_SUB_EXPR
	     * always has only one element.  Wise or not, these are the
	     * rules the Tcl expr parser has followed, and for the sake
	     * of those few callers of Tcl_ParseExpr() we do not change
	     * them now.  Internally, we can do better.
	     */

	    int toCopy = tokenPtr->numComponents + 1;

	    if (tokenPtr->numComponents == tokenPtr[1].numComponents + 1) {

		/*
		 * Single element word. Copy tokens and convert the leading
		 * Single element word.  Copy tokens and convert the leading
		 * token to TCL_TOKEN_SUB_EXPR.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		memcpy(subExprTokenPtr, tokenPtr,
			toCopy * sizeof(Tcl_Token));
			(size_t) toCopy * sizeof(Tcl_Token));
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		parsePtr->numTokens += toCopy;
	    } else {

		/*
		 * Multiple element word. Create a TCL_TOKEN_SUB_EXPR token to
		 * lead, with fields initialized from the leading token, then
		 * copy entire set of word tokens.
		 * Multiple element word.  Create a TCL_TOKEN_SUB_EXPR
		 * token to lead, with fields initialized from the leading
		 * token, then copy entire set of word tokens.
		 */

		TclGrowParseTokenArray(parsePtr, toCopy+1);
		subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
		*subExprTokenPtr = *tokenPtr;
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		subExprTokenPtr->numComponents++;
		subExprTokenPtr++;
		memcpy(subExprTokenPtr, tokenPtr,
			toCopy * sizeof(Tcl_Token));
			(size_t) toCopy * sizeof(Tcl_Token));
		parsePtr->numTokens += toCopy + 1;
	    }

	    scanned = tokenPtr->start + tokenPtr->size - start;
	    start += scanned;
	    start +=scanned;
	    numBytes -= scanned;
	    tokenPtr += toCopy;
	    break;
	}

	default:

	    /*
	     * Advance to the child node, which is an operator.
	    /* Advance to the child node, which is an operator. */
	     */

	    nodePtr = nodes + next;

	    /*
	     * Skip any white space that comes before the subexpression.
	    /* Skip any white space that comes before the subexpression */
	     */

	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start += scanned;
	    start +=scanned;
	    numBytes -= scanned;

	    /*
	     * Generate tokens for the operator / subexpression...
	    /* Generate tokens for the operator / subexpression... */
	     */

	    switch (nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/*
		 * Historical practice has been to have no Tcl_Tokens for
		 * these operators.
		 */

		break;

	    default: {

		/*
		 * Remember the index of the last subexpression we were
		 * working on -- that of our parent. We'll stack it later.
		 * working on -- that of our parent.  We'll stack it later.
		 */

		parentIdx = subExprTokenIdx;

		/*
		 * Verify space for the two leading Tcl_Tokens representing
		 * the subexpression rooted by this operator. The first
		 * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second of
		 * type TCL_TOKEN_OPERATOR.
		 * the subexpression rooted by this operator.  The first
		 * Tcl_Token will be of type TCL_TOKEN_SUB_EXPR; the second
		 * of type TCL_TOKEN_OPERATOR.
		 */

		TclGrowParseTokenArray(parsePtr, 2);
		subExprTokenIdx = parsePtr->numTokens;
		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		parsePtr->numTokens += 2;
		subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR;
		subExprTokenPtr[1].type = TCL_TOKEN_OPERATOR;

		/*
		 * Our current position scanning the string is the starting
		 * point for this subexpression.
		 */

		subExprTokenPtr->start = start;

		/*
		 * Eventually, we know that the numComponents field of the
		 * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0. This means
		 * Tcl_Token of type TCL_TOKEN_OPERATOR will be 0.  This means
		 * we can make other use of this field for now to track the
		 * stack of subexpressions we have pending.
		 */

		subExprTokenPtr[1].numComponents = parentIdx;
		break;
	    }
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
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
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
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
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







-
-
+
-
-

-
+














-
-
+
-
-















-
+


















-
-
+
-
-

-
+


-
+



-
+














-
+


















-
-
-
+
+
+
-
-







	case MARK_LEFT:
	    next = nodePtr->left;
	    break;

	case MARK_RIGHT:
	    next = nodePtr->right;

	    /*
	     * Skip any white space that comes before the operator.
	    /* Skip any white space that comes before the operator */
	     */

	    scanned = TclParseAllWhiteSpace(start, numBytes);
	    start += scanned;
	    start +=scanned;
	    numBytes -= scanned;

	    /*
	     * Here we scan from the string the operator corresponding to
	     * nodePtr->lexeme.
	     */

	    scanned = ParseLexeme(start, numBytes, &lexeme, NULL);

	    switch(nodePtr->lexeme) {
	    case OPEN_PAREN:
	    case COMMA:
	    case COLON:

		/*
		 * No tokens for these lexemes -> nothing to do.
		/* No tokens for these lexemes -> nothing to do. */
		 */

		break;

	    default:

		/*
		 * Record in the TCL_TOKEN_OPERATOR token the pointers into
		 * the string marking where the operator is.
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr[1].start = start;
		subExprTokenPtr[1].size = scanned;
		break;
	    }

	    start += scanned;
	    start +=scanned;
	    numBytes -= scanned;
	    break;

	case MARK_PARENT:
	    switch (nodePtr->lexeme) {
	    case START:

		/* When we get back to the START node, we're done. */
		return;

	    case COMMA:
	    case COLON:

		/* No tokens for these lexemes -> nothing to do. */
		break;

	    case OPEN_PAREN:

		/*
		 * Skip past matching close paren.
		/* Skip past matching close paren. */
		 */

		scanned = TclParseAllWhiteSpace(start, numBytes);
		start += scanned;
		start +=scanned;
		numBytes -= scanned;
		scanned = ParseLexeme(start, numBytes, &lexeme, NULL);
		start += scanned;
		start +=scanned;
		numBytes -= scanned;
		break;

	    default:
	    default: {

		/*
		 * Before we leave this node/operator/subexpression for the
		 * last time, finish up its tokens....
		 *
		 * Our current position scanning the string is where the
		 * substring for the subexpression ends.
		 */

		subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx;
		subExprTokenPtr->size = start - subExprTokenPtr->start;

		/*
		 * All the Tcl_Tokens allocated and filled belong to
		 * this subexpression. The first token is the leading
		 * this subexpresion.  The first token is the leading
		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
		 * are its components.
		 */

		subExprTokenPtr->numComponents =
			(parsePtr->numTokens - subExprTokenIdx) - 1;

		/*
		 * Finally, as we return up the tree to our parent, pop the
		 * parent subexpression off our subexpression stack, and
		 * fill in the zero numComponents for the operator Tcl_Token.
		 */

		parentIdx = subExprTokenPtr[1].numComponents;
		subExprTokenPtr[1].numComponents = 0;
		subExprTokenIdx = parentIdx;
		break;
	    }

	    /*
	     * Since we're returning to parent, skip child handling code.
	    }

	    /* Since we're returning to parent, skip child handling code. */
	     */

	    nodePtr = nodes + nodePtr->p.parent;
	    goto router;
	}
    }
}

/*
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
1893
1894
1895
1896

1897

1898
1899
1900
1901
1902
1903
1904
1905

1906
1907
1908
1909
1910
1911
1912
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
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







-
+







-
-
-
-
-
+
+
+
+
+
+

-
-
-
+



-
-
+
+














-
+




















-
+


-
+






+
-
+







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_ParseExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *start,		/* Start of source string to parse. */
    size_t numBytes,		/* Number of bytes in string. If -1, the
    int numBytes,		/* Number of bytes in string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Structure to fill with information about
				 * the parsed expression; any previous
				 * information in the structure is ignored. */
{
    int code;
    OpNode *opTree = NULL;	/* Will point to the tree of operators. */
    Tcl_Obj *litList;	/* List to hold the literals. */
    Tcl_Obj *funcList;	/* List to hold the functon names. */
    Tcl_Parse *exprParsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions. */
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *exprParsePtr =
	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */

    TclNewObj(litList);
    TclNewObj(funcList);
    if (numBytes == TCL_INDEX_NONE) {
    if (numBytes < 0) {
	numBytes = (start ? strlen(start) : 0);
    }

    code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList,
	    exprParsePtr, 1 /* parseOnly */);
    code = ParseExpr(interp, start, numBytes, &opTree, litList,
	    funcList, exprParsePtr, 1 /* parseOnly */);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);

    TclParseInit(interp, start, numBytes, parsePtr);
    if (code == TCL_OK) {
	ConvertTreeToTokens(start, numBytes,
		opTree, exprParsePtr->tokenPtr, parsePtr);
    } else {
	parsePtr->term = exprParsePtr->term;
	parsePtr->errorType = exprParsePtr->errorType;
    }

    Tcl_FreeParse(exprParsePtr);
    TclStackFree(interp, exprParsePtr);
    Tcl_Free(opTree);
    ckfree((char *) opTree);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseLexeme --
 *
 *	Parse a single lexeme from the start of a string, scanning no more
 *	than numBytes bytes.
 *
 * Results:
 *	Returns the number of bytes scanned to produce the lexeme.
 *
 * Side effects:
 *	Code identifying lexeme parsed is writen to *lexemePtr.
 *
 *----------------------------------------------------------------------
 */

static size_t
static int
ParseLexeme(
    const char *start,		/* Start of lexeme to parse. */
    size_t numBytes,		/* Number of bytes in string. */
    int numBytes,		/* Number of bytes in string. */
    unsigned char *lexemePtr,	/* Write code of parsed lexeme to this
				 * storage. */
    Tcl_Obj **literalPtr)	/* Write corresponding literal value to this
				   storage, if non-NULL. */
{
    const char *end;
    int scanned;
    Tcl_UniChar ch = 0;
    Tcl_UniChar ch;
    Tcl_Obj *literal = NULL;
    unsigned char byte;

    if (numBytes == 0) {
	*lexemePtr = END;
	return 0;
    }
    byte = UCHAR(*start);
    byte = (unsigned char)(*start);
    if (byte < sizeof(Lexeme) && Lexeme[byte] != 0) {
	*lexemePtr = Lexeme[byte];
	return 1;
    }
    switch (byte) {
    case '*':
	if ((numBytes > 1) && (start[1] == '*')) {
1975
1976
1977
1978
1979
1980
1981

1982
1983
1984
1985



1986
1987
1988
1989
1990
1991
1992
1882
1883
1884
1885
1886
1887
1888
1889
1890



1891
1892
1893
1894
1895
1896
1897
1898
1899
1900







+

-
-
-
+
+
+







	}
	*lexemePtr = GREATER;
	return 1;

    case 'i':
	if ((numBytes > 1) && (start[1] == 'n')
		&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {

	    /*
	     * Must make this check so we can tell the difference between the
	     * "in" operator and the "int" function name and the "infinity"
	     * numeric value.
	     * Must make this check so we can tell the difference between
	     * the "in" operator and the "int" function name and the
	     * "infinity" numeric value.
	     */

	    *lexemePtr = IN_LIST;
	    return 2;
	}
	break;

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
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







-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+



















-
+

-



-
+















-










-
+


-

-
+

-
+
-
-
+

-
+







		*lexemePtr = STRNEQ;
		return 2;
	    case 'i':
		*lexemePtr = NOT_IN_LIST;
		return 2;
	    }
	}
	break;

    }
    case 'l':
	if ((numBytes > 1)
		&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
	    switch (start[1]) {
	    case 't':
		*lexemePtr = STR_LT;
		return 2;
	    case 'e':
		*lexemePtr = STR_LEQ;
		return 2;
	    }

	}
	break;

    literal = Tcl_NewObj();
    case 'g':
	if ((numBytes > 1)
		&& ((numBytes == 2) || start[2] & 0x80 || !isalpha(UCHAR(start[2])))) {
	    switch (start[1]) {
	    case 't':
		*lexemePtr = STR_GT;
		return 2;
	    case 'e':
		*lexemePtr = STR_GEQ;
		return 2;
	    }
	}
	break;
    }

    TclNewObj(literal);
    if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end,
	    TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
	if (end < start + numBytes && !TclIsBareword(*end)) {

	
	number:
	    TclInitStringRep(literal, start, end-start);
	    *lexemePtr = NUMBER;
	    if (literalPtr) {
		*literalPtr = literal;
	    } else {
		Tcl_DecrRefCount(literal);
	    }
	    return (end-start);
	} else {
	    unsigned char lexeme;

	    /*
	     * We have a number followed directly by bareword characters
	     * (alpha, digit, underscore).  Is this a number followed by
	     * bareword syntax error?  Or should we join into one bareword?
	     * Example: Inf + luence + () becomes a valid function call.
	     * [Bug 3401704]
	     */
	    if (TclHasIntRep(literal, &tclDoubleType)) {
	    if (literal->typePtr == &tclDoubleType) {
		const char *p = start;

		while (p < end) {
		    if (!TclIsBareword(*p++)) {
			/*
			 * The number has non-bareword characters, so we
			 * The number has non-bareword characters, so we 
			 * must treat it as a number.
			 */
			goto number;
		    }
		}
	    }
	    ParseLexeme(end, numBytes-(end-start), &lexeme, NULL);
	    if ((NODE_TYPE & lexeme) == BINARY) {
		/*
		 * The bareword characters following the number take the
		 * form of an operator (eq, ne, in, ni, ...) so we treat
		 * as number + operator.
		 */
		goto number;
	    }

	    /*
	     * Otherwise, fall through and parse the whole as a bareword.
	     */
	}
    }

    /*
     * We reject leading underscores in bareword.  No sensible reason why.
     * Might be inspired by reserved identifier rules in C, which of course
     * have no direct relevance here.
     */
     */  

    if (!TclIsBareword(*start) || *start == '_') {
	size_t scanned;
	if (Tcl_UtfCharComplete(start, numBytes)) {
	    scanned = TclUtfToUniChar(start, &ch);
	    scanned = Tcl_UtfToUniChar(start, &ch);
	} else {
	    char utfBytes[4];
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, start, numBytes);
	    memcpy(utfBytes, start, (size_t) numBytes);
	    utfBytes[numBytes] = '\0';
	    scanned = TclUtfToUniChar(utfBytes, &ch);
	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
	}
	*lexemePtr = INVALID;
	Tcl_DecrRefCount(literal);
	return scanned;
    }
    end = start;
    while (numBytes && TclIsBareword(*end)) {
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
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







-
+

-
+


-
-
-
+
+
+
+

-

-
-
-
+



-
-
+
+
-
-




















-
+







 *----------------------------------------------------------------------
 */

void
TclCompileExpr(
    Tcl_Interp *interp,		/* Used for error reporting. */
    const char *script,		/* The source script to compile. */
    size_t numBytes,		/* Number of bytes in script. */
    int numBytes,		/* Number of bytes in script. */
    CompileEnv *envPtr,		/* Holds resulting instructions. */
    int optimize)		/* 0 for one-off expressions. */
    int optimize)               /* 0 for one-off expressions */
{
    OpNode *opTree = NULL;	/* Will point to the tree of operators */
    Tcl_Obj *litList;		/* List to hold the literals */
    Tcl_Obj *funcList;		/* List to hold the functon names*/
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    Tcl_Obj *litList = Tcl_NewObj();	/* List to hold the literals */
    Tcl_Obj *funcList = Tcl_NewObj();	/* List to hold the functon names*/
    Tcl_Parse *parsePtr =
	    (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
				/* Holds the Tcl_Tokens of substitutions */
    int code;

    TclNewObj(litList);
    TclNewObj(funcList);
    code = ParseExpr(interp, script, numBytes, &opTree, litList,
    int code = ParseExpr(interp, script, numBytes, &opTree, litList,
	    funcList, parsePtr, 0 /* parseOnly */);

    if (code == TCL_OK) {
	/*
	 * Valid parse; compile the tree.

	/* Valid parse; compile the tree. */
	 */

	int objc;
	Tcl_Obj *const *litObjv;
	Tcl_Obj **funcObjv;

	/* TIP #280 : Track Lines within the expression */
	TclAdvanceLines(&envPtr->line, script,
		script + TclParseAllWhiteSpace(script, numBytes));

	TclListObjGetElements(NULL, litList, &objc, (Tcl_Obj ***)&litObjv);
	TclListObjGetElements(NULL, funcList, &objc, &funcObjv);
	CompileExprTree(interp, opTree, 0, &litObjv, funcObjv,
		parsePtr->tokenPtr, envPtr, optimize);
    } else {
	TclCompileSyntaxError(interp, envPtr);
    }

    Tcl_FreeParse(parsePtr);
    TclStackFree(interp, parsePtr);
    Tcl_DecrRefCount(funcList);
    Tcl_DecrRefCount(litList);
    Tcl_Free(opTree);
    ckfree((char *) opTree);
}

/*
 *----------------------------------------------------------------------
 *
 * ExecConstantExprTree --
 *	Compiles and executes bytecode for the subexpression tree at index
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
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







-
+







-
+




+
-
+


+
-
+
-
-
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+






-
+







    OpNode *nodes,
    int index,
    Tcl_Obj *const **litObjvPtr)
{
    CompileEnv *envPtr;
    ByteCode *byteCodePtr;
    int code;
    NRE_callback *rootPtr = TOP_CB(interp);
    Tcl_Obj *byteCodeObj = Tcl_NewObj();

    /*
     * Note we are compiling an expression with literal arguments. This means
     * there can be no [info frame] calls when we execute the resulting
     * bytecode, so there's no need to tend to TIP 280 issues.
     */

    envPtr = (CompileEnv *)TclStackAlloc(interp, sizeof(CompileEnv));
    envPtr = (CompileEnv *) TclStackAlloc(interp, sizeof(CompileEnv));
    TclInitCompileEnv(interp, envPtr, NULL, 0, NULL, 0);
    CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
	    0 /* optimize */);
    TclEmitOpcode(INST_DONE, envPtr);
    Tcl_IncrRefCount(byteCodeObj);
    byteCodePtr = TclInitByteCode(envPtr);
    TclInitByteCodeObj(byteCodeObj, envPtr);
    TclFreeCompileEnv(envPtr);
    TclStackFree(interp, envPtr);
    byteCodePtr = (ByteCode *) byteCodeObj->internalRep.twoPtrValue.ptr1;
    TclNRExecuteByteCode(interp, byteCodePtr);
    code = TclExecuteByteCode(interp, byteCodePtr);
    code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
    TclReleaseByteCode(byteCodePtr);
    Tcl_DecrRefCount(byteCodeObj);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * CompileExprTree --
 *
 *	Compiles and writes to envPtr instructions for the subexpression tree
 *	at index in the nodes array. (*litObjvPtr) must point to the proper
 *	location in a corresponding literals list. Likewise, when non-NULL,
 *	funcObjv and tokenPtr must point into matching arrays of function
 *	names and Tcl_Token's derived from earlier call to ParseExpr(). When
 *	optimize is true, any constant subexpressions will be precomputed.
 *	Compiles and writes to envPtr instructions for the subexpression
 *	tree at index in the nodes array.  (*litObjvPtr) must point to the
 *	proper location in a corresponding literals list.  Likewise, when
 *	non-NULL, funcObjv and tokenPtr must point into matching arrays of
 * 	function names and Tcl_Token's derived from earlier call to
 *	ParseExpr().  When optimize is true, any constant subexpressions
 *	will be precomputed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the expression at runtime.
 *	Consumes subtree of nodes rooted at index. Advances the pointer
 *	Consumes subtree of nodes rooted at index.  Advances the pointer
 *	*litObjvPtr.
 *
 *----------------------------------------------------------------------
 */

static void
CompileExprTree(
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
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







-
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+


-
+



-
+

-
+




-
-
-
+
+
+







-
-
-
-
+


-
-
-

-
-
-
+
+
+
+
-
-



+
+

-
-
-
-
+
-



-
-












+

-
-
+
+



-
+

-
+


-
-
+
-
-




-
-
+
+
-
-



-
-
-
+
+
+
+
-

+
-
-
+
+
-
-
+



-
-
-






-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
-
+
+

-
-
-
+
+
+
-
+

+
+
+
+
+
+
+










-

+
















-
+

-
-
+
+

+
+
+










-
-
+
+
-
-
+
+




-
+


-
-
-
-
+
+
+
+



-






-
+
+





-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
















-









-
+
















-
+







    while (1) {
	int next;
	JumpList *freePtr, *newJump;

	if (nodePtr->mark == MARK_LEFT) {
	    next = nodePtr->left;

	    if (nodePtr->lexeme == QUESTION) {
	    switch (nodePtr->lexeme) {
	    case QUESTION:
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		convert = 1;
		break;
	    case AND:
	    case OR:
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		newJump = (JumpList *) TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		jumpPtr->depth = envPtr->currStackDepth;
		break;
	    }
	} else if (nodePtr->mark == MARK_RIGHT) {
	    next = nodePtr->right;

	    switch (nodePtr->lexeme) {
	    case FUNCTION: {
		Tcl_DString cmdName;
		const char *p;
		size_t length;
		int length;

		Tcl_DStringInit(&cmdName);
		TclDStringAppendLiteral(&cmdName, "tcl::mathfunc::");
		Tcl_DStringAppend(&cmdName, "tcl::mathfunc::", -1);
		p = TclGetStringFromObj(*funcObjv, &length);
		funcObjv++;
		Tcl_DStringAppend(&cmdName, p, length);
		TclEmitPush(TclRegisterLiteral(envPtr,
		TclEmitPush(TclRegisterNewNSLiteral(envPtr,
			Tcl_DStringValue(&cmdName),
			Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
			Tcl_DStringLength(&cmdName)), envPtr);
		Tcl_DStringFree(&cmdName);

		/*
		 * Start a count of the number of words in this function
		 * command invocation. In case there's already a count in
		 * progress (nested functions), save it in our unused "left"
		 * field for restoring later.
		 * command invocation.  In case there's already a count
		 * in progress (nested functions), save it in our unused
		 * "left" field for restoring later.
		 */

		nodePtr->left = numWords;
		numWords = 2;	/* Command plus one argument */
		break;
	    }
	    case QUESTION:
		newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump);
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
		break;
	    case COLON:
		newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
			&jumpPtr->jump);
		TclAdjustStackDepth(-1, envPtr);
		if (convert) {
			&(jumpPtr->next->jump));
		envPtr->currStackDepth = jumpPtr->depth;
		jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart);
		jumpPtr->convert = convert;
		    jumpPtr->jump.jumpType = TCL_TRUE_JUMP;
		}
		convert = 1;
		break;
	    case AND:
		TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &(jumpPtr->jump));
		break;
	    case OR:
		newJump = (JumpList *)TclStackAlloc(interp, sizeof(JumpList));
		newJump->next = jumpPtr;
		jumpPtr = newJump;
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
		TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &(jumpPtr->jump));
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump);
		break;
	    }
	} else {
	    int pc1, pc2, target;

	    switch (nodePtr->lexeme) {
	    case START:
	    case QUESTION:
		if (convert && (nodePtr == rootPtr)) {
		    TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
		}
		break;
	    case OPEN_PAREN:

		/* do nothing */
		break;
	    case FUNCTION:

		/*
		 * Use the numWords count we've kept to invoke the function
		 * command with the correct number of arguments.
		 * Use the numWords count we've kept to invoke the
		 * function command with the correct number of arguments.
		 */

		if (numWords < 255) {
		    TclEmitInvoke(envPtr, INST_INVOKE_STK1, numWords);
		    TclEmitInstInt1(INST_INVOKE_STK1, numWords, envPtr);
		} else {
		    TclEmitInvoke(envPtr, INST_INVOKE_STK4, numWords);
		    TclEmitInstInt4(INST_INVOKE_STK4, numWords, envPtr);
		}

		/*
		 * Restore any saved numWords value.
		/* Restore any saved numWords value. */
		 */

		numWords = nodePtr->left;
		convert = 1;
		break;
	    case COMMA:
		/*
		 * Each comma implies another function argument.

		/* Each comma implies another function argument. */
		 */

		numWords++;
		break;
	    case COLON:
		CLANG_ASSERT(jumpPtr);
		if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) {
		    jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP;
		if (TclFixupForwardJump(envPtr, &(jumpPtr->next->jump),
			(envPtr->codeNext - envPtr->codeStart)
			- jumpPtr->next->jump.codeOffset, 127)) {
		    jumpPtr->offset += 3;
		    convert = 1;
		}
		TclFixupForwardJump(envPtr, &(jumpPtr->jump),
		target = jumpPtr->jump.codeOffset + 2;
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
			jumpPtr->offset - jumpPtr->jump.codeOffset, 127);
		convert |= jumpPtr->convert;
		    target += 3;
		}
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		TclFixupForwardJump(envPtr, &jumpPtr->jump,
			target - jumpPtr->jump.codeOffset, 127);

		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    case AND:
	    case OR:
		CLANG_ASSERT(jumpPtr);
		pc1 = CurrentOffset(envPtr);
		TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
			: INST_JUMP_TRUE1, 0, envPtr);
		TclEmitPush(TclRegisterLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1, 0), envPtr);
		pc2 = CurrentOffset(envPtr);
		TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND)
			?  TCL_FALSE_JUMP : TCL_TRUE_JUMP,
			&(jumpPtr->next->jump));
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
		TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
		TclEmitInstInt1(INST_JUMP1, 0, envPtr);
		TclAdjustStackDepth(-1, envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1,
			&(jumpPtr->next->next->jump));
		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->jump), 127);
			envPtr->codeStart + pc1 + 1);
		if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
		    pc2 += 3;
		if (TclFixupForwardJumpToHere(envPtr, &(jumpPtr->jump), 127)) {
		    jumpPtr->next->next->jump.codeOffset += 3;
		}
		TclEmitPush(TclRegisterLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1, 0), envPtr);
		TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
		TclEmitPush(TclRegisterNewLiteral(envPtr,
			(nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
		TclFixupForwardJumpToHere(envPtr, &(jumpPtr->next->next->jump),
			envPtr->codeStart + pc2 + 1);
			127);
		convert = 0;
		envPtr->currStackDepth = jumpPtr->depth + 1;
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		freePtr = jumpPtr;
		jumpPtr = jumpPtr->next;
		TclStackFree(interp, freePtr);
		break;
	    default:
		TclEmitOpcode(instruction[nodePtr->lexeme], envPtr);
		convert = 0;
		break;
	    }
	    if (nodePtr == rootPtr) {
		/* We're done */

		/* We're done */
		return;
	    }
	    nodePtr = nodes + nodePtr->p.parent;
	    continue;
	}

	nodePtr->mark++;
	switch (next) {
	case OT_EMPTY:
	    numWords = 1;	/* No arguments, so just the command */
	    break;
	case OT_LITERAL: {
	    Tcl_Obj *const *litObjv = *litObjvPtr;
	    Tcl_Obj *literal = *litObjv;

	    if (optimize) {
		size_t length;
		int length, index;
		const char *bytes = TclGetStringFromObj(literal, &length);
		int idx = TclRegisterLiteral(envPtr, bytes, length, 0);
		Tcl_Obj *objPtr = TclFetchLiteral(envPtr, idx);
		LiteralEntry *lePtr;
		Tcl_Obj *objPtr;

		index = TclRegisterNewLiteral(envPtr, bytes, length);
		lePtr = envPtr->literalArrayPtr + index;
		objPtr = lePtr->objPtr;
		if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
		    /*
		     * Would like to do this:
		     *
		     * lePtr->objPtr = literal;
		     * Tcl_IncrRefCount(literal);
		     * Tcl_DecrRefCount(objPtr);
		     *
		     * However, the design of the "global" and "local"
		     * LiteralTable does not permit the value of lePtr->objPtr
		     * to change. So rather than replace lePtr->objPtr, we do
		     * surgery to transfer our desired intrep into it.
		     * to change.  So rather than replace lePtr->objPtr, we
		     * do surgery to transfer our desired intrep into it.
		     */

		     *
		     */
		    objPtr->typePtr = literal->typePtr;
		    objPtr->internalRep = literal->internalRep;
		    literal->typePtr = NULL;
		}
		TclEmitPush(idx, envPtr);
		TclEmitPush(index, envPtr);
	    } else {
		/*
		 * When optimize==0, we know the expression is a one-off and
		 * there's nothing to be gained from sharing literals when
		 * they won't live long, and the copies we have already have
		 * an appropriate intrep. In this case, skip literal
		 * When optimize==0, we know the expression is a one-off
		 * and there's nothing to be gained from sharing literals
		 * when they won't live long, and the copies we have already
		 * have an appropriate intrep.  In this case, skip literal
		 * registration that would enable sharing, and use the routine
		 * that preserves intreps.
		 */

		TclEmitPush(TclAddLiteralObj(envPtr, literal, NULL), envPtr);
	    }
	    (*litObjvPtr)++;
	    break;
	}
	case OT_TOKENS:
	    CompileTokens(envPtr, tokenPtr, interp);
	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
		    envPtr);
	    tokenPtr += tokenPtr->numComponents + 1;
	    break;
	default:
	    if (optimize && nodes[next].constant) {
		Tcl_InterpState save = Tcl_SaveInterpState(interp, TCL_OK);

		if (ExecConstantExprTree(interp, nodes, next, litObjvPtr)
			== TCL_OK) {
		    int idx;
		    Tcl_Obj *objPtr = Tcl_GetObjResult(interp);

		    /*
		     * Don't generate a string rep, but if we have one
		     * already, then use it to share via the literal table.
		     */

		    if (TclHasStringRep(objPtr)) {
			Tcl_Obj *tableValue;
			size_t numBytes;
			const char *bytes
				= TclGetStringFromObj(objPtr, &numBytes);

			idx = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
			tableValue = TclFetchLiteral(envPtr, idx);
			if ((tableValue->typePtr == NULL) &&
				(objPtr->typePtr != NULL)) {
			    /*
			     * Same intrep surgery as for OT_LITERAL.
			     */

			    tableValue->typePtr = objPtr->typePtr;
			    tableValue->internalRep = objPtr->internalRep;
			    objPtr->typePtr = NULL;
			}
		    } else {
			idx = TclAddLiteralObj(envPtr, objPtr, NULL);
		    TclEmitPush(TclAddLiteralObj(envPtr,
		    }
		    TclEmitPush(idx, envPtr);
			    Tcl_GetObjResult(interp), NULL), envPtr);
		} else {
		    TclCompileSyntaxError(interp, envPtr);
		}
		Tcl_RestoreInterpState(interp, save);
		convert = 0;
	    } else {
		nodePtr = nodes + next;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclSingleOpCmd --
 *
 *	Implements the commands: ~, !, <<, >>, %, !=, ne, in, ni
 *	in the ::tcl::mathop namespace.  These commands have no
 *	extension to arbitrary arguments; they accept only exactly one
 *	or exactly two arguments as suitable for the operator.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclSingleOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    OpNode nodes[2];
    Tcl_Obj *const *litObjv = objv + 1;

    if (objc != 1 + occdPtr->i.numArgs) {
    if (objc != 1+occdPtr->i.numArgs) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }

    ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
    nodes[0].lexeme = START;
    nodes[0].mark = MARK_RIGHT;
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
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642




2643
2644
2645
2646
2647
2648
2649
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







-
+
-
-
+

-
+





-
+

















-
-
-
+
+
+
+







    return ExecConstantExprTree(interp, nodes, 0, &litObjv);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSortingOpCmd --
 *	Implements the commands:
 *	Implements the commands: <, <=, >, >=, ==, eq
 *		<, <=, >, >=, ==, eq, lt, le, gt, ge
 *	in the ::tcl::mathop namespace. These commands are defined for
 *	in the ::tcl::mathop namespace.  These commands are defined for
 *	arbitrary number of arguments by computing the AND of the base
 *	operator applied to all neighbor argument pairs.
 * 	operator applied to all neighbor argument pairs.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclSortingOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int code = TCL_OK;

    if (objc < 3) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
    } else {
	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
	Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
		2 * (objc-2) * sizeof(Tcl_Obj *));
	OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
	Tcl_Obj **litObjv = (Tcl_Obj **) TclStackAlloc(interp,
		2*(objc-2)*sizeof(Tcl_Obj *));
	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
		2*(objc-2)*sizeof(OpNode));
	unsigned char lexeme;
	int i, lastAnd = 1;
	Tcl_Obj *const *litObjPtrPtr = litObjv;

	ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);

	litObjv[0] = objv[1];
2686
2687
2688
2689
2690
2691
2692
2693

2694
2695

2696
2697
2698
2699
2700
2701
2702

2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719

2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733

2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749

2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769


2770
2771
2772
2773
2774
2775

2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786

2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802

2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815




2816
2817
2818
2819
2820
2821

2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
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

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
2658
2659
2660
2661
2662
2663
2664
2665
2666




2667
2668
2669
2670
2671
2672
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







-
+

-
+






-
+
















-
+













-
+















-
+



















-
+
+





-
+










-
+
















+









-
-
-
-
+
+
+
+





-
+












-













}

/*
 *----------------------------------------------------------------------
 *
 * TclVariadicOpCmd --
 *	Implements the commands: +, *, &, |, ^, **
 *	in the ::tcl::mathop namespace. These commands are defined for
 *	in the ::tcl::mathop namespace.  These commands are defined for
 *	arbitrary number of arguments by repeatedly applying the base
 *	operator with suitable associative rules. When fewer than two
 *	operator with suitable associative rules.  When fewer than two
 *	arguments are provided, suitable identity values are returned.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclVariadicOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
    unsigned char lexeme;
    int code;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(occdPtr->i.identity));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(occdPtr->i.identity));
	return TCL_OK;
    }

    ParseLexeme(occdPtr->op, strlen(occdPtr->op), &lexeme, NULL);
    lexeme |= BINARY;

    if (objc == 2) {
	Tcl_Obj *litObjv[2];
	OpNode nodes[2];
	int decrMe = 0;
	Tcl_Obj *const *litObjPtrPtr = litObjv;

	if (lexeme == EXPON) {
	    TclNewIntObj(litObjv[1], occdPtr->i.identity);
	    litObjv[1] = Tcl_NewIntObj(occdPtr->i.identity);
	    Tcl_IncrRefCount(litObjv[1]);
	    decrMe = 1;
	    litObjv[0] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;
	    nodes[0].right = 1;
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	} else {
	    if (lexeme == DIVIDE) {
		litObjv[0] = Tcl_NewDoubleObj(1.0);
	    } else {
		TclNewIntObj(litObjv[0], occdPtr->i.identity);
		litObjv[0] = Tcl_NewIntObj(occdPtr->i.identity);
	    }
	    Tcl_IncrRefCount(litObjv[0]);
	    litObjv[1] = objv[1];
	    nodes[0].lexeme = START;
	    nodes[0].mark = MARK_RIGHT;
	    nodes[0].right = 1;
	    nodes[1].lexeme = lexeme;
	    nodes[1].mark = MARK_LEFT;
	    nodes[1].left = OT_LITERAL;
	    nodes[1].right = OT_LITERAL;
	    nodes[1].p.parent = 0;
	}

	code = ExecConstantExprTree(interp, nodes, 0, &litObjPtrPtr);

	Tcl_DecrRefCount(litObjv[decrMe]);
	return code;
    } else {
	Tcl_Obj *const *litObjv = objv + 1;
	OpNode *nodes = (OpNode *)TclStackAlloc(interp, (objc-1) * sizeof(OpNode));
	OpNode *nodes = (OpNode *) TclStackAlloc(interp,
		(objc-1)*sizeof(OpNode));
	int i, lastOp = OT_LITERAL;

	nodes[0].lexeme = START;
	nodes[0].mark = MARK_RIGHT;
	if (lexeme == EXPON) {
	    for (i=objc-2; i>0; i--) {
	    for (i=objc-2; i>0; i-- ) {
		nodes[i].lexeme = lexeme;
		nodes[i].mark = MARK_LEFT;
		nodes[i].left = OT_LITERAL;
		nodes[i].right = lastOp;
		if (lastOp >= 0) {
		    nodes[lastOp].p.parent = i;
		}
		lastOp = i;
	    }
	} else {
	    for (i=1; i<objc-1; i++) {
	    for (i=1; i<objc-1; i++ ) {
		nodes[i].lexeme = lexeme;
		nodes[i].mark = MARK_LEFT;
		nodes[i].left = lastOp;
		if (lastOp >= 0) {
		    nodes[lastOp].p.parent = i;
		}
		nodes[i].right = OT_LITERAL;
		lastOp = i;
	    }
	}
	nodes[0].right = lastOp;
	nodes[lastOp].p.parent = 0;

	code = ExecConstantExprTree(interp, nodes, 0, &litObjv);

	TclStackFree(interp, nodes);

	return code;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclNoIdentOpCmd --
 *	Implements the commands: -, /
 *	in the ::tcl::mathop namespace. These commands are defined for
 *	arbitrary non-zero number of arguments by repeatedly applying the base
 *	operator with suitable associative rules. When no arguments are
 *	provided, an error is raised.
 *	in the ::tcl::mathop namespace.  These commands are defined for
 *	arbitrary non-zero number of arguments by repeatedly applying
 *	the base operator with suitable associative rules.  When no
 *	arguments are provided, an error is raised.
 *
 * Results:
 *	A standard Tcl return code and result left in interp.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclNoIdentOpCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, occdPtr->expected);
	return TCL_ERROR;
    }
    return TclVariadicOpCmd(clientData, interp, objc, objv);
}
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclCompile.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
42
43
44
45

46
47
48
49

50
51

52
53
54
55
56
57

58
59
60
61
62
63
64
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







-
+
+
+
+
+
+
+
+
+














-
+












-
+



-
+

-
+





-
+







 *
 * 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 "tclCompile.h"
#include <assert.h>

/*
 * Table of all AuxData types.
 */

static Tcl_HashTable auxDataTypeTable;
static int auxDataTypeTableInitialized; /* 0 means not yet initialized. */

TCL_DECLARE_MUTEX(tableMutex)

/*
 * Variable that controls whether compilation tracing is enabled and, if so,
 * what level of tracing is desired:
 *    0: no compilation tracing
 *    1: summarize compilation of top level cmds and proc bodies
 *    2: display all instructions of each ByteCode compiled
 * This variable is linked to the Tcl variable "tcl_traceCompile".
 */

#ifdef TCL_COMPILE_DEBUG
int tclTraceCompile = 0;
static int traceInitialized = 0;
#endif


/*
 * A table describing the Tcl bytecode instructions. Entries in this table
 * must correspond to the instruction opcode definitions in tclCompile.h. The
 * names "op1" and "op4" refer to an instruction's one or four byte first
 * operand. Similarly, "stktop" and "stknext" refer to the topmost and next to
 * topmost stack elements.
 *
 * Note that the load, store, and incr instructions do not distinguish local
 * from global variables; the bytecode interpreter at runtime uses the
 * existence of a procedure call frame to distinguish these.
 */

InstructionDesc const tclInstructionTable[] = {
InstructionDesc tclInstructionTable[] = {
    /* Name	      Bytes stackEffect #Opnds  Operand types */
    {"done",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Finish ByteCode execution and return stktop (top stack item) */
    {"push1",		  2,   +1,         1,	{OPERAND_LIT1}},
    {"push1",		  2,   +1,         1,	{OPERAND_UINT1}},
	/* Push object at ByteCode objArray[op1] */
    {"push4",		  5,   +1,         1,	{OPERAND_LIT4}},
    {"push4",		  5,   +1,         1,	{OPERAND_UINT4}},
	/* Push object at ByteCode objArray[op4] */
    {"pop",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Pop the topmost stack object */
    {"dup",		  1,   +1,         0,	{OPERAND_NONE}},
	/* Duplicate the topmost stack object and push the result */
    {"strcat",		  2,   INT_MIN,    1,	{OPERAND_UINT1}},
    {"concat1",		  2,   INT_MIN,    1,	{OPERAND_UINT1}},
	/* Concatenate the top op1 items and push result */
    {"invokeStk1",	  2,   INT_MIN,    1,	{OPERAND_UINT1}},
	/* Invoke command named objv[0]; <objc,objv> = <op1,top op1> */
    {"invokeStk4",	  5,   INT_MIN,    1,	{OPERAND_UINT4}},
	/* Invoke command named objv[0]; <objc,objv> = <op4,top op4> */
    {"evalStk",		  1,   0,          0,	{OPERAND_NONE}},
	/* Evaluate command in stktop using Tcl_EvalObj. */
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
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







-
+

-
+

-
+

-
+

-
+

-
+


+
+
+
+













-
+

-
+

-
+







	/* Incr array elem; array at slot op1 <= 255, elem is stktop,
	 * amount is 2nd operand byte */
    {"incrArrayStkImm",	  2,   -1,         1,	{OPERAND_INT1}},
	/* Incr array element; elem is top then array name, amount is op1 */
    {"incrStkImm",	  2,   0,	   1,	{OPERAND_INT1}},
	/* Incr general variable; unparsed name is top, amount is op1 */

    {"jump1",		  2,   0,          1,	{OPERAND_OFFSET1}},
    {"jump1",		  2,   0,          1,	{OPERAND_INT1}},
	/* Jump relative to (pc + op1) */
    {"jump4",		  5,   0,          1,	{OPERAND_OFFSET4}},
    {"jump4",		  5,   0,          1,	{OPERAND_INT4}},
	/* Jump relative to (pc + op4) */
    {"jumpTrue1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
    {"jumpTrue1",	  2,   -1,         1,	{OPERAND_INT1}},
	/* Jump relative to (pc + op1) if stktop expr object is true */
    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_INT4}},
	/* Jump relative to (pc + op4) if stktop expr object is true */
    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_INT1}},
	/* Jump relative to (pc + op1) if stktop expr object is false */
    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_INT4}},
	/* Jump relative to (pc + op4) if stktop expr object is false */

    {"lor",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Logical or:	push (stknext || stktop) */
    {"land",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Logical and:	push (stknext && stktop) */
    {"bitor",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Bitwise or:	push (stknext | stktop) */
    {"bitxor",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Bitwise xor	push (stknext ^ stktop) */
    {"bitand",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Bitwise and:	push (stknext & stktop) */
    {"eq",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Equal:	push (stknext == stktop) */
    {"neq",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Not equal:	push (stknext != stktop) */
    {"lt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Less:	push (stknext < stktop) */
    {"gt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Greater:	push (stknext > stktop) */
	/* Greater:	push (stknext || stktop) */
    {"le",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Less or equal: push (stknext <= stktop) */
	/* Less or equal: push (stknext || stktop) */
    {"ge",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Greater or equal: push (stknext >= stktop) */
	/* Greater or equal: push (stknext || stktop) */
    {"lshift",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Left shift:	push (stknext << stktop) */
    {"rshift",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Right shift:	push (stknext >> stktop) */
    {"add",		  1,   -1,         0,	{OPERAND_NONE}},
	/* Add:		push (stknext + stktop) */
    {"sub",		  1,   -1,         0,	{OPERAND_NONE}},
165
166
167
168
169
170
171




172
173
174
175
176
177
178
179







180
181
182
183
184
185
186
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







+
+
+
+








+
+
+
+
+
+
+







	/* Unary plus:	push +stktop */
    {"uminus",		  1,   0,          0,	{OPERAND_NONE}},
	/* Unary minus:	push -stktop */
    {"bitnot",		  1,   0,          0,	{OPERAND_NONE}},
	/* Bitwise not:	push ~stktop */
    {"not",		  1,   0,          0,	{OPERAND_NONE}},
	/* Logical not:	push !stktop */
    {"callBuiltinFunc1",  2,   1,          1,	{OPERAND_UINT1}},
	/* Call builtin math function with index op1; any args are on stk */
    {"callFunc1",	  2,   INT_MIN,    1,	{OPERAND_UINT1}},
	/* Call non-builtin func objv[0]; <objc,objv>=<op1,top op1> */
    {"tryCvtToNumeric",	  1,   0,          0,	{OPERAND_NONE}},
	/* Try converting stktop to first int then double if possible. */

    {"break",		  1,   0,          0,	{OPERAND_NONE}},
	/* Abort closest enclosing loop; if none, return TCL_BREAK code. */
    {"continue",	  1,   0,          0,	{OPERAND_NONE}},
	/* Skip to next iteration of closest enclosing loop; if none, return
	 * TCL_CONTINUE code. */

    {"foreach_start4",	  5,   0,          1,	{OPERAND_AUX4}},
	/* Initialize execution of a foreach loop. Operand is aux data index
	 * of the ForeachInfo structure for the foreach command. */
    {"foreach_step4",	  5,   +1,         1,	{OPERAND_AUX4}},
	/* "Step" or begin next iteration of foreach loop. Push 0 if to
	 * terminate loop, else push 1. */

    {"beginCatch4",	  5,   0,          1,	{OPERAND_UINT4}},
	/* Record start of catch with the operand's exception index. Push the
	 * current stack depth onto a special catch stack. */
    {"endCatch",	  1,   0,          0,	{OPERAND_NONE}},
	/* End of last catch. Pop the bytecode interpreter's catch stack. */
    {"pushResult",	  1,   +1,         0,	{OPERAND_NONE}},
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
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







-
+











-
+







    {"invokeExpanded",    1,    0,          0,	{OPERAND_NONE}},
	/* Invoke the command marked by the last 'expandStart' */

    {"listIndexImm",	  5,	0,	   1,	{OPERAND_IDX4}},
	/* List Index:	push (lindex stktop op4) */
    {"listRangeImm",	  9,	0,	   2,	{OPERAND_IDX4, OPERAND_IDX4}},
	/* List Range:	push (lrange stktop op4 op4) */
    {"startCommand",	  9,	0,	   2,	{OPERAND_OFFSET4, OPERAND_UINT4}},
    {"startCommand",	  9,	0,	   2,	{OPERAND_INT4,OPERAND_UINT4}},
	/* Start of bytecoded command: op is the length of the cmd's code, op2
	 * is number of commands here */

    {"listIn",		  1,	-1,	   0,	{OPERAND_NONE}},
	/* List containment: push [lsearch stktop stknext]>=0) */
    {"listNotIn",	  1,	-1,	   0,	{OPERAND_NONE}},
	/* List negated containment: push [lsearch stktop stknext]<0) */

    {"pushReturnOpts",	  1,	+1,	   0,	{OPERAND_NONE}},
	/* Push the interpreter's return option dictionary as an object on the
	 * stack. */
    {"returnStk",	  1,	-1,	   0,	{OPERAND_NONE}},
    {"returnStk",	  1,	-2,	   0,	{OPERAND_NONE}},
	/* Compiled [return]; options and result are on the stack, code and
	 * level are in the options. */

    {"dictGet",		  5,	INT_MIN,   1,	{OPERAND_UINT4}},
	/* The top op4 words (min 1) are a key path into the dictionary just
	 * below the keys on the stack, and all those values are replaced by
	 * the value read out of that key-path (like [dict get]).
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
450
451
452
453
454
455







-
-
+
+
-




+
+




-
-
-
+
+
+







-
+






-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
+




-
-
-









-

-
-



+


+
+
-
-
+
+





-
-
-
+
+
+







-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	 * Stack:  ... key valueToAppend => ... newDict */
    {"dictLappend",	  5,	-1,	   1,	{OPERAND_LVT4}},
	/* Update a dictionary value such that the value pointed to by key has
	 * some value list-appended onto it. op4 = LVTindex
	 * Stack:  ... key valueToAppend => ... newDict */
    {"dictFirst",	  5,	+2,	   1,	{OPERAND_LVT4}},
	/* Begin iterating over the dictionary, using the local scalar
	 * indicated by op4 to hold the iterator state. The local scalar
	 * should not refer to a named variable as the value is not wholly
	 * indicated by op4 to hold the iterator state. If doneBool is true,
	 * dictDone *must* be called later on.
	 * managed correctly.
	 * Stack:  ... dict => ... value key doneBool */
    {"dictNext",	  5,	+3,	   1,	{OPERAND_LVT4}},
	/* Get the next iteration from the iterator in op4's local scalar.
	 * Stack:  ... => ... value key doneBool */
    {"dictDone",	  5,	0,	   1,	{OPERAND_LVT4}},
	/* Terminate the iterator in op4's local scalar. */
    {"dictUpdateStart",   9,    0,	   2,	{OPERAND_LVT4, OPERAND_AUX4}},
	/* Create the variables (described in the aux data referred to by the
	 * second immediate argument) to mirror the state of the dictionary in
	 * the variable referred to by the first immediate argument. The list
	 * of keys (top of the stack, not popped) must be the same length as
	 * the list of variables.
	 * Stack:  ... keyList => ... keyList */
	 * of keys (popped from the stack) must be the same length as the list
	 * of variables.
	 * Stack:  ... keyList => ... */
    {"dictUpdateEnd",	  9,    -1,	   2,	{OPERAND_LVT4, OPERAND_AUX4}},
	/* Reflect the state of local variables (described in the aux data
	 * referred to by the second immediate argument) back to the state of
	 * the dictionary in the variable referred to by the first immediate
	 * argument. The list of keys (popped from the stack) must be the same
	 * length as the list of variables.
	 * Stack:  ... keyList => ... */
    {"jumpTable",	 5,	-1,	   1,	{OPERAND_AUX4}},
    {"jumpTable",	  5,	-1,	   1,	{OPERAND_AUX4}},
	/* Jump according to the jump-table (in AuxData as indicated by the
	 * operand) and the argument popped from the list. Always executes the
	 * next instruction if no match against the table's entries was found.
	 * Stack:  ... value => ...
	 * Note that the jump table contains offsets relative to the PC when
	 * it points to this instruction; the code is relocatable. */
    {"upvar",            5,    -1,        1,   {OPERAND_LVT4}},
	/* finds level and otherName in stack, links to local variable at
	 * index op1. Leaves the level on stack. */
    {"nsupvar",          5,    -1,        1,   {OPERAND_LVT4}},
	/* finds namespace and otherName in stack, links to local variable at
	 * index op1. Leaves the namespace on stack. */
    {"variable",         5,    -1,        1,   {OPERAND_LVT4}},
	/* finds namespace and otherName in stack, links to local variable at
	 * index op1. Leaves the namespace on stack. */
    {"syntax",		 9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
	/* Compiled bytecodes to signal syntax error. Equivalent to returnImm
    {"upvar",            5,     0,        1,   {OPERAND_LVT4}},
         /* finds level and otherName in stack, links to local variable at
	  * index op1. Leaves the level on stack. */
    {"nsupvar",          5,     0,        1,   {OPERAND_LVT4}},
         /* finds namespace and otherName in stack, links to local variable at
	  * index op1. Leaves the namespace on stack. */
    {"variable",         5,     0,        1,   {OPERAND_LVT4}},
         /* finds namespace and otherName in stack, links to local variable at
	  * index op1. Leaves the namespace on stack. */
    {"syntax",	 	 9,   -1,         2,	{OPERAND_INT4, OPERAND_UINT4}},
	/* Compiled bytecodes to signal syntax error. */
	 * except for the ERR_ALREADY_LOGGED flag in the interpreter. */
    {"reverse",		 5,    0,         1,	{OPERAND_UINT4}},
	/* Reverse the order of the arg elements at the top of stack */

    {"regexp",		 2,   -1,         1,	{OPERAND_INT1}},
	/* Regexp:	push (regexp stknext stktop) opnd == nocase */

    {"existScalar",	 5,    1,         1,	{OPERAND_LVT4}},
	/* Test if scalar variable at index op1 in call frame exists */
    {"existArray",	 5,    0,         1,	{OPERAND_LVT4}},
	/* Test if array element exists; array at slot op1, element is
	 * stktop */
    {"existArrayStk",	 1,    -1,        0,	{OPERAND_NONE}},
	/* Test if array element exists; element is stktop, array name is
	 * stknext */
    {"existStk",	 1,    0,         0,	{OPERAND_NONE}},
	/* Test if general variable exists; unparsed variable name is stktop*/

    {"nop",		 1,    0,         0,	{OPERAND_NONE}},
	/* Do nothing */
    {"returnCodeBranch", 1,   -1,	  0,	{OPERAND_NONE}},
	/* Jump to next instruction based on the return code on top of stack
	 * ERROR: +1;	RETURN: +3;	BREAK: +5;	CONTINUE: +7;
	 * Other non-OK: +9
	 */

    {"unsetScalar",	 6,    0,         2,	{OPERAND_UINT1, OPERAND_LVT4}},
	/* Make scalar variable at index op2 in call frame cease to exist;
	 * op1 is 1 for errors on problems, 0 otherwise */
    {"unsetArray",	 6,    -1,        2,	{OPERAND_UINT1, OPERAND_LVT4}},
	/* Make array element cease to exist; array at slot op2, element is
	 * stktop; op1 is 1 for errors on problems, 0 otherwise */
    {"unsetArrayStk",	 2,    -2,        1,	{OPERAND_UINT1}},
	/* Make array element cease to exist; element is stktop, array name is
	 * stknext; op1 is 1 for errors on problems, 0 otherwise */
    {"unsetStk",	 2,    -1,        1,	{OPERAND_UINT1}},
	/* Make general variable cease to exist; unparsed variable name is
	 * stktop; op1 is 1 for errors on problems, 0 otherwise */

    {"dictExpand",       1,    -1,        0,    {OPERAND_NONE}},
        /* Probe into a dict and extract it (or a subdict of it) into
         * variables with matched names. Produces list of keys bound as
         * result. Part of [dict with].
	 * Stack:  ... dict path => ... keyList */
    {"dictRecombineStk", 1,    -3,        0,    {OPERAND_NONE}},
        /* Map variable contents back into a dictionary in a variable. Part of
         * [dict with].
	 * Stack:  ... dictVarName path keyList => ... */
    {"dictRecombineImm", 5,    -2,        1,    {OPERAND_LVT4}},
        /* Map variable contents back into a dictionary in the local variable
         * indicated by the LVT index. Part of [dict with].
	 * Stack:  ... path keyList => ... */
    {"dictExists",	 5,	INT_MIN,  1,	{OPERAND_UINT4}},
	/* The top op4 words (min 1) are a key path into the dictionary just
	 * below the keys on the stack, and all those values are replaced by a
	 * boolean indicating whether it is possible to read out a value from
	 * that key-path (like [dict exists]).
	 * Stack:  ... dict key1 ... keyN => ... boolean */
    {"verifyDict",	 1,    -1,	  0,	{OPERAND_NONE}},
	/* Verifies that the word on the top of the stack is a dictionary,
	 * popping it if it is and throwing an error if it is not.
	 * Stack:  ... value => ... */

    {"strmap",		 1,    -2,	  0,	{OPERAND_NONE}},
	/* Simplified version of [string map] that only applies one change
	 * string, and only case-sensitively.
	 * Stack:  ... from to string => ... changedString */
    {"strfind",		 1,    -1,	  0,	{OPERAND_NONE}},
	/* Find the first index of a needle string in a haystack string,
	 * producing the index (integer) or -1 if nothing found.
	 * Stack:  ... needle haystack => ... index */
    {"strrfind",	 1,    -1,	  0,	{OPERAND_NONE}},
	/* Find the last index of a needle string in a haystack string,
	 * producing the index (integer) or -1 if nothing found.
	 * Stack:  ... needle haystack => ... index */
    {"strrangeImm",	 9,	0,	  2,	{OPERAND_IDX4, OPERAND_IDX4}},
	/* String Range: push (string range stktop op4 op4) */
    {"strrange",	 1,    -2,	  0,	{OPERAND_NONE}},
	/* String Range with non-constant arguments.
	 * Stack:  ... string idxA idxB => ... substring */

    {"yield",		 1,	0,	  0,	{OPERAND_NONE}},
	/* Makes the current coroutine yield the value at the top of the
	 * stack, and places the response back on top of the stack when it
	 * resumes.
	 * Stack:  ... valueToYield => ... resumeValue */
    {"coroName",         1,    +1,	  0,	{OPERAND_NONE}},
	/* Push the name of the interpreter's current coroutine as an object
	 * on the stack. */
    {"tailcall",	 2,    INT_MIN,	  1,	{OPERAND_UINT1}},
	/* Do a tailcall with the opnd items on the stack as the thing to
	 * tailcall to; opnd must be greater than 0 for the semantics to work
	 * right. */

    {"currentNamespace", 1,    +1,	  0,	{OPERAND_NONE}},
	/* Push the name of the interpreter's current namespace as an object
	 * on the stack. */
    {"infoLevelNumber",  1,    +1,	  0,	{OPERAND_NONE}},
	/* Push the stack depth (i.e., [info level]) of the interpreter as an
	 * object on the stack. */
    {"infoLevelArgs",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Push the argument words to a stack depth (i.e., [info level <n>])
	 * of the interpreter as an object on the stack.
	 * Stack:  ... depth => ... argList */
    {"resolveCmd",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Resolves the command named on the top of the stack to its fully
	 * qualified version, or produces the empty string if no such command
	 * exists. Never generates errors.
	 * Stack:  ... cmdName => ... fullCmdName */

    {"tclooSelf",	 1,	+1,	  0,	{OPERAND_NONE}},
	/* Push the identity of the current TclOO object (i.e., the name of
	 * its current public access command) on the stack. */
    {"tclooClass",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Push the class of the TclOO object named at the top of the stack
	 * onto the stack.
	 * Stack:  ... object => ... class */
    {"tclooNamespace",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Push the namespace of the TclOO object named at the top of the
	 * stack onto the stack.
	 * Stack:  ... object => ... namespace */
    {"tclooIsObject",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Push whether the value named at the top of the stack is a TclOO
	 * object (i.e., a boolean). Can corrupt the interpreter result
	 * despite not throwing, so not safe for use in a post-exception
	 * context.
	 * Stack:  ... value => ... boolean */

    {"arrayExistsStk",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Looks up the element on the top of the stack and tests whether it
	 * is an array. Pushes a boolean describing whether this is the
	 * case. Also runs the whole-array trace on the named variable, so can
	 * throw anything.
	 * Stack:  ... varName => ... boolean */
    {"arrayExistsImm",	 5,	+1,	  1,	{OPERAND_LVT4}},
	/* Looks up the variable indexed by opnd and tests whether it is an
	 * array. Pushes a boolean describing whether this is the case. Also
	 * runs the whole-array trace on the named variable, so can throw
	 * anything.
	 * Stack:  ... => ... boolean */
    {"arrayMakeStk",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* Forces the element on the top of the stack to be the name of an
	 * array.
	 * Stack:  ... varName => ... */
    {"arrayMakeImm",	 5,	0,	  1,	{OPERAND_LVT4}},
	/* Forces the variable indexed by opnd to be an array. Does not touch
	 * the stack. */

    {"invokeReplace",	 6,	INT_MIN,  2,	{OPERAND_UINT4,OPERAND_UINT1}},
	/* Invoke command named objv[0], replacing the first two words with
	 * the word at the top of the stack;
	 * <objc,objv> = <op4,top op4 after popping 1> */

    {"listConcat",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* Concatenates the two lists at the top of the stack into a single
	 * list and pushes that resulting list onto the stack.
	 * Stack: ... list1 list2 => ... [lconcat list1 list2] */

    {"expandDrop",       1,    0,          0,	{OPERAND_NONE}},
	/* Drops an element from the auxiliary stack, popping stack elements
	 * until the matching stack depth is reached. */

    /* New foreach implementation */
    {"foreach_start",	 5,	+2,	  1,	{OPERAND_AUX4}},
	/* Initialize execution of a foreach loop. Operand is aux data index
	 * of the ForeachInfo structure for the foreach command. It pushes 2
	 * elements which hold runtime params for foreach_step, they are later
	 * dropped by foreach_end together with the value lists. NOTE that the
	 * iterator-tracker and info reference must not be passed to bytecodes
	 * that handle normal Tcl values. NOTE that this instruction jumps to
	 * the foreach_step instruction paired with it; the stack info below
	 * is only nominal.
	 * Stack: ... listObjs... => ... listObjs... iterTracker info */
    {"foreach_step",	 1,	 0,	  0,	{OPERAND_NONE}},
	/* "Step" or begin next iteration of foreach loop. Assigns to foreach
	 * iteration variables. May jump to straight after the foreach_start
	 * that pushed the iterTracker and info values. MUST be followed
	 * immediately by a foreach_end.
	 * Stack: ... listObjs... iterTracker info =>
	 *				... listObjs... iterTracker info */
    {"foreach_end",	 1,	 0,	  0,	{OPERAND_NONE}},
	/* Clean up a foreach loop by dropping the info value, the tracker
	 * value and the lists that were being iterated over.
	 * Stack: ... listObjs... iterTracker info => ... */
    {"lmap_collect",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* Appends the value at the top of the stack to the list located on
	 * the stack the "other side" of the foreach-related values.
	 * Stack: ... collector listObjs... iterTracker info value =>
	 *			... collector listObjs... iterTracker info */

    {"strtrim",		 1,	-1,	  0,	{OPERAND_NONE}},
	/* [string trim] core: removes the characters (designated by the value
	 * at the top of the stack) from both ends of the string and pushes
	 * the resulting string.
	 * Stack: ... string charset => ... trimmedString */
    {"strtrimLeft",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* [string trimleft] core: removes the characters (designated by the
	 * value at the top of the stack) from the left of the string and
	 * pushes the resulting string.
	 * Stack: ... string charset => ... trimmedString */
    {"strtrimRight",	 1,	-1,	  0,	{OPERAND_NONE}},
	/* [string trimright] core: removes the characters (designated by the
	 * value at the top of the stack) from the right of the string and
	 * pushes the resulting string.
	 * Stack: ... string charset => ... trimmedString */

    {"concatStk",	 5,	INT_MIN,  1,	{OPERAND_UINT4}},
	/* Wrapper round Tcl_ConcatObj(), used for [concat] and [eval]. opnd
	 * is number of values to concatenate.
	 * Operation:	push concat(stk1 stk2 ... stktop) */

    {"strcaseUpper",	 1,	0,	  0,	{OPERAND_NONE}},
	/* [string toupper] core: converts whole string to upper case using
	 * the default (extended "C" locale) rules.
	 * Stack: ... string => ... newString */
    {"strcaseLower",	 1,	0,	  0,	{OPERAND_NONE}},
	/* [string tolower] core: converts whole string to upper case using
	 * the default (extended "C" locale) rules.
	 * Stack: ... string => ... newString */
    {"strcaseTitle",	 1,	0,	  0,	{OPERAND_NONE}},
	/* [string totitle] core: converts whole string to upper case using
	 * the default (extended "C" locale) rules.
	 * Stack: ... string => ... newString */
    {"strreplace",	 1,	-3,	  0,	{OPERAND_NONE}},
	/* [string replace] core: replaces a non-empty range of one string
	 * with the contents of another.
	 * Stack: ... string fromIdx toIdx replacement => ... newString */

    {"originCmd",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Reports which command was the origin (via namespace import chain)
	 * of the command named on the top of the stack.
	 * Stack:  ... cmdName => ... fullOriginalCmdName */

    {"tclooNext",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
	/* Call the next item on the TclOO call chain, passing opnd arguments
	 * (min 1, max 255, *includes* "next").  The result of the invoked
	 * method implementation will be pushed on the stack in place of the
	 * arguments (similar to invokeStk).
	 * Stack:  ... "next" arg2 arg3 -- argN => ... result */
    {"tclooNextClass",	 2,	INT_MIN,  1,	{OPERAND_UINT1}},
	/* Call the following item on the TclOO call chain defined by class
	 * className, passing opnd arguments (min 2, max 255, *includes*
	 * "nextto" and the class name). The result of the invoked method
	 * implementation will be pushed on the stack in place of the
	 * arguments (similar to invokeStk).
	 * Stack:  ... "nextto" className arg3 arg4 -- argN => ... result */

    {"yieldToInvoke",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Makes the current coroutine yield the value at the top of the
	 * stack, invoking the given command/args with resolution in the given
	 * namespace (all packed into a list), and places the list of values
	 * that are the response back on top of the stack when it resumes.
	 * Stack:  ... [list ns cmd arg1 ... argN] => ... resumeList */

    {"numericType",	 1,	0,	  0,	{OPERAND_NONE}},
	/* Pushes the numeric type code of the word at the top of the stack.
	 * Stack:  ... value => ... typeCode */
    {"tryCvtToBoolean",	 1,	+1,	  0,	{OPERAND_NONE}},
	/* Try converting stktop to boolean if possible. No errors.
	 * Stack:  ... value => ... value isStrictBool */
    {"strclass",	 2,	0,	  1,	{OPERAND_SCLS1}},
	/* See if all the characters of the given string are a member of the
	 * specified (by opnd) character class. Note that an empty string will
	 * satisfy the class check (standard definition of "all").
	 * Stack:  ... stringValue => ... boolean */

    {"lappendList",	 5,	0,	1,	{OPERAND_LVT4}},
	/* Lappend list to scalar variable at op4 in frame.
	 * Stack:  ... list => ... listVarContents */
    {"lappendListArray", 5,	-1,	1,	{OPERAND_LVT4}},
	/* Lappend list to array element; array at op4.
	 * Stack:  ... elem list => ... listVarContents */
    {"lappendListArrayStk", 1,	-2,	0,	{OPERAND_NONE}},
	/* Lappend list to array element.
	 * Stack:  ... arrayName elem list => ... listVarContents */
    {"lappendListStk",	 1,	-1,	0,	{OPERAND_NONE}},
	/* Lappend list to general variable.
	 * Stack:  ... varName list => ... listVarContents */

    {"clockRead",	 2,	+1,	1,	{OPERAND_UINT1}},
        /* Read clock out to the stack. Operand is which clock to read
	 * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds.
	 * Stack: ... => ... time */

    {"dictGetDef",	  5,	INT_MIN,   1,	{OPERAND_UINT4}},
	/* The top word is the default, the next op4 words (min 1) are a key
	 * path into the dictionary just below the keys on the stack, and all
	 * those values are replaced by the value read out of that key-path
	 * (like [dict get]) except if there is no such key, when instead the
	 * default is pushed instead.
	 * Stack:  ... dict key1 ... keyN default => ... value */

    {"strlt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Less:			push (stknext < stktop) */
    {"strgt",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Greater:		push (stknext > stktop) */
    {"strle",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Less or equal:	push (stknext <= stktop) */
    {"strge",		  1,   -1,         0,	{OPERAND_NONE}},
	/* String Greater or equal:	push (stknext >= stktop) */

    {NULL, 0, 0, 0, {OPERAND_NONE}}
    {0, 0, 0, 0, {0}}
};


/*
 * Prototypes for procedures defined later in this file:
 */

static void		CleanupByteCode(ByteCode *codePtr);
static ByteCode *	CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
static void		DupByteCodeInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static unsigned char *	EncodeCmdLocMap(CompileEnv *envPtr,
			    ByteCode *codePtr, unsigned char *startPtr);
static void		EnterCmdExtentData(CompileEnv *envPtr,
			    int cmdNumber, int numSrcBytes, int numCodeBytes);
static void		EnterCmdStartData(CompileEnv *envPtr,
			    int cmdNumber, int srcOffset, int codeOffset);
static void		FreeByteCodeInternalRep(Tcl_Obj *objPtr);
static void		FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int		GetCmdLocEncodingSize(CompileEnv *envPtr);
static int		IsCompactibleCompileEnv(CompileEnv *envPtr);
static void		PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void		RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
static void		RegisterAuxDataType(AuxDataType *typePtr);
static int		SetByteCodeFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    unsigned char *pc, Tcl_Obj *bufferObj);
static void		StartExpanding(CompileEnv *envPtr);

static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, int maxChars);
/*
 * TIP #280: Helper for building the per-word line information of all compiled
 * commands.
 */
static void		EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset,
			    Tcl_Token *tokenPtr, const char *cmd,
			    int numWords, int line, int *clNext, int **lines,
			    CompileEnv *envPtr);
			    Tcl_Token *tokenPtr, const char *cmd, int len,
			    int numWords, int line, int* clNext, int **lines,
			    CompileEnv* envPtr);
static void		ReleaseCmdWordData(ExtCmdLoc *eclPtr);

/*
 * The structure below defines the bytecode Tcl object type by means of
 * procedures that can be invoked by generic object code.
 */

const Tcl_ObjType tclByteCodeType = {
Tcl_ObjType tclByteCodeType = {
    "bytecode",			/* name */
    FreeByteCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetByteCodeFromAny		/* setFromAnyProc */
};

/*
 * The structure below defines a bytecode Tcl object type to hold the
 * compiled bytecode for the [subst]itution of Tcl values.
 */

static const Tcl_ObjType substCodeType = {
    "substcode",		/* name */
    FreeSubstCodeInternalRep,	/* freeIntRepProc */
    DupByteCodeInternalRep,	/* dupIntRepProc - shared with bytecode */
    NULL,			/* updateStringProc */
    NULL,			/* setFromAnyProc */
};
#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2

/*
 * Helper macros.
 */

#define TclIncrUInt4AtPtr(ptr, delta) \
    TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr))

/*
 *----------------------------------------------------------------------
 *
 * TclSetByteCodeFromAny --
 *
 *	Part of the bytecode Tcl object type implementation. Attempts to
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
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







-
-
+

-
-
+




-
+
















-







-
+




-
+

+
-
+
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+












-
+







    Tcl_Obj *objPtr,		/* The object to make a ByteCode object. */
    CompileHookProc *hookProc,	/* Procedure to invoke after compilation. */
    ClientData clientData)	/* Hook procedure private data. */
{
    Interp *iPtr = (Interp *) interp;
    CompileEnv compEnv;		/* Compilation environment structure allocated
				 * in frame. */
    size_t length;
    int result = TCL_OK;
    int length, result = TCL_OK;
    const char *stringPtr;
    Proc *procPtr = iPtr->compiledProcPtr;
    ContLineLoc *clLocPtr;
    ContLineLoc* clLocPtr;

#ifdef TCL_COMPILE_DEBUG
    if (!traceInitialized) {
	if (Tcl_LinkVar(interp, "tcl_traceCompile",
		&tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
		(char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) {
	    Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable");
	}
	traceInitialized = 1;
    }
#endif

    stringPtr = TclGetStringFromObj(objPtr, &length);

    /*
     * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and
     * use to initialize the tracking in the compiler. This information was
     * stored by TclCompEvalObj and ProcCompileProc.
     */

    TclInitCompileEnv(interp, &compEnv, stringPtr, length,
	    iPtr->invokeCmdFramePtr, iPtr->invokeWord);

    /*
     * Now we check if we have data about invisible continuation lines for the
     * script, and make it available to the compile environment, if so.
     *
     * It is not clear if the script Tcl_Obj* can be free'd while the compiler
     * is using it, leading to the release of the associated ContLineLoc
     * structure as well. To ensure that the latter doesn't happen we set a
     * lock on it. We release this lock in the function TclFreeCompileEnv(),
     * lock on it. We release this lock in the function TclFreeCompileEnv (),
     * found in this file. The "lineCLPtr" hashtable is managed in the file
     * "tclObj.c".
     */

    clLocPtr = TclContinuationsGet(objPtr);
    clLocPtr = TclContinuationsGet (objPtr);
    if (clLocPtr) {
	compEnv.clLoc  = clLocPtr;
	compEnv.clNext = &clLocPtr->loc[0];
	compEnv.clNext = &compEnv.clLoc->loc[0];
	Tcl_Preserve (compEnv.clLoc);
    }

    TclCompileScript(interp, stringPtr, length, &compEnv);

    /*
     * Successful compilation. Add a "done" instruction at the end.
     */

    TclEmitOpcode(INST_DONE, &compEnv);

    /*
     * Check for optimizations!
     *
     * Test if the generated code is free of most hazards; if so, recompile
     * but with generation of INST_START_CMD disabled. This produces somewhat
     * faster code in some cases, and more compact code in more.
     */

    if (Tcl_GetParent(interp) == NULL &&
	    !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME)
	    && IsCompactibleCompileEnv(&compEnv)) {
	TclFreeCompileEnv(&compEnv);
	iPtr->compiledProcPtr = procPtr;
	TclInitCompileEnv(interp, &compEnv, stringPtr, length,
		iPtr->invokeCmdFramePtr, iPtr->invokeWord);
	if (clLocPtr) {
	    compEnv.clNext = &clLocPtr->loc[0];
	}
	compEnv.atCmdStart = 2;		/* The disabling magic. */
	TclCompileScript(interp, stringPtr, length, &compEnv);
	assert (compEnv.atCmdStart > 1);
	TclEmitOpcode(INST_DONE, &compEnv);
	assert (compEnv.atCmdStart > 1);
    }

    /*
     * Apply some peephole optimizations that can cross specific/generic
     * instruction generator boundaries.
     */

    if (iPtr->optimizer) {
	(iPtr->optimizer)(&compEnv);
    }

    /*
     * Invoke the compilation hook procedure if one exists.
     */

    if (hookProc) {
	result = hookProc(interp, &compEnv, clientData);
	result = (*hookProc)(interp, &compEnv, clientData);
    }

    /*
     * Change the object into a ByteCode object. Ownership of the literal
     * objects and aux data items is given to the ByteCode object.
     */

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(&compEnv);
#endif /*TCL_COMPILE_DEBUG*/

    if (result == TCL_OK) {
	(void) TclInitByteCodeObj(objPtr, &tclByteCodeType, &compEnv);
	TclInitByteCodeObj(objPtr, &compEnv);
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile >= 2) {
	    TclPrintByteCodeObj(interp, objPtr);
	    fflush(stdout);
	}
#endif /* TCL_COMPILE_DEBUG */
    }
914
915
916
917
918
919
920
921


922
923
924
925
926
927
928
594
595
596
597
598
599
600

601
602
603
604
605
606
607
608
609







-
+
+







    Tcl_Interp *interp,		/* The interpreter for which the code is being
				 * compiled. Must not be NULL. */
    Tcl_Obj *objPtr)		/* The object to make a ByteCode object. */
{
    if (interp == NULL) {
	return TCL_ERROR;
    }
    return TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
    (void) TclSetByteCodeFromAny(interp, objPtr, NULL, (ClientData) NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DupByteCodeInternalRep --
 *
938
939
940
941
942
943
944
945
946


947
948
949
950
951
952
953
619
620
621
622
623
624
625


626
627
628
629
630
631
632
633
634







-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
DupByteCodeInternalRep(
    TCL_UNUSED(Tcl_Obj *) /*srcPtr*/,
    TCL_UNUSED(Tcl_Obj *) /*copyPtr*/)
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    return;
}

/*
 *----------------------------------------------------------------------
 *
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
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





















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







-
+

-
+
+

-
-
-
-
+
+
+
+
+





-
+
















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+





-
-
+
+








-
+







 *	cleanup is delayed until the last execution of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeByteCodeInternalRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
    register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    ByteCode *codePtr;
    register ByteCode *codePtr = (ByteCode *)
	    objPtr->internalRep.twoPtrValue.ptr1;

    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
    assert(codePtr != NULL);

    TclReleaseByteCode(codePtr);
    codePtr->refCount--;
    if (codePtr->refCount <= 0) {
	TclCleanupByteCode(codePtr);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclReleaseByteCode --
 * TclCleanupByteCode --
 *
 *	This procedure does all the real work of freeing up a bytecode
 *	object's ByteCode structure. It's called only when the structure's
 *	reference count becomes zero.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees objPtr's bytecode internal representation and sets its type NULL
 *	Also releases its literals and frees its auxiliary data items.
 *
 *----------------------------------------------------------------------
 */

void
TclPreserveByteCode(
    ByteCode *codePtr)
{
    codePtr->refCount++;
}

void
TclReleaseByteCode(
    ByteCode *codePtr)
{
    if (codePtr->refCount-- > 1) {
	return;
    }

    /* Just dropped to refcount==0.  Clean up. */
    CleanupByteCode(codePtr);
}

static void
CleanupByteCode(
    ByteCode *codePtr)	/* Points to the ByteCode to free. */
TclCleanupByteCode(
    register ByteCode *codePtr)	/* Points to the ByteCode to free. */
{
    Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
    Interp *iPtr = (Interp *) interp;
    int numLitObjects = codePtr->numLitObjects;
    int numAuxDataItems = codePtr->numAuxDataItems;
    Tcl_Obj **objArrayPtr, *objPtr;
    const AuxData *auxDataPtr;
    register Tcl_Obj **objArrayPtr, *objPtr;
    register AuxData *auxDataPtr;
    int i;
#ifdef TCL_COMPILE_STATS

    if (interp != NULL) {
	ByteCodeStats *statsPtr;
	Tcl_Time destroyTime;
	int lifetimeSec, lifetimeMicroSec, log2;

	statsPtr = &iPtr->stats;
	statsPtr = &((Interp *) interp)->stats;

	statsPtr->numByteCodesFreed++;
	statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
	statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;

	statsPtr->currentInstBytes -= (double) codePtr->numCodeBytes;
	statsPtr->currentLitBytes -= (double)
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
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
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
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394

1395
1396
1397
1398

1399
1400

1401


1402
1403
1404
1405
1406
1407
1408
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







-
+












-
-
-
+
+
+
+
+
+
+
+
+
+
+






-
+















-

-
+




-
+




-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
+



-
+


+
-
+
+







     * when it contains non-shared literals [Bug 983660], we also distinguish
     * the case of an interpreter being deleted (signaled by interp == NULL).
     * Also, as the interp deletion will remove the global literal table
     * anyway, we avoid the extra cost of updating it for each literal being
     * released.
     */

    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
    if ((codePtr->flags & TCL_BYTECODE_PRECOMPILED) || (interp == NULL)) {

	objArrayPtr = codePtr->objArrayPtr;
	for (i = 0;  i < numLitObjects;  i++) {
	    objPtr = *objArrayPtr;
	    if (objPtr) {
		Tcl_DecrRefCount(objPtr);
	    }
	    objArrayPtr++;
	}
	codePtr->numLitObjects = 0;
    } else {
	objArrayPtr = codePtr->objArrayPtr;
	while (numLitObjects--) {
	    /* TclReleaseLiteral calls Tcl_DecrRefCount() for us */
	    TclReleaseLiteral(interp, *objArrayPtr++);
	for (i = 0;  i < numLitObjects;  i++) {
	    /*
	     * TclReleaseLiteral sets a ByteCode's object array entry NULL to
	     * indicate that it has already freed the literal.
	     */

	    objPtr = *objArrayPtr;
	    if (objPtr != NULL) {
		TclReleaseLiteral(interp, objPtr);
	    }
	    objArrayPtr++;
	}
    }

    auxDataPtr = codePtr->auxDataArrayPtr;
    for (i = 0;  i < numAuxDataItems;  i++) {
	if (auxDataPtr->type->freeProc != NULL) {
	    auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    (auxDataPtr->type->freeProc)(auxDataPtr->clientData);
	}
	auxDataPtr++;
    }

    /*
     * TIP #280. Release the location data associated with this byte code
     * structure, if any. NOTE: The interp we belong to may be gone already,
     * and the data with it.
     *
     * See also tclBasic.c, DeleteInterpProc
     */

    if (iPtr) {
	Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr,
		(char *) codePtr);

	if (hePtr) {
	    ReleaseCmdWordData((ExtCmdLoc *)Tcl_GetHashValue(hePtr));
	    ReleaseCmdWordData(Tcl_GetHashValue(hePtr));
	    Tcl_DeleteHashEntry(hePtr);
	}
    }

    if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
    if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
	TclFreeLocalCache(interp, codePtr->localCachePtr);
    }

    TclHandleRelease(codePtr->interpHandle);
    Tcl_Free(codePtr);
    ckfree((char *) codePtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * IsCompactibleCompileEnv --
 *
 *	Checks to see if we may apply some basic compaction optimizations to a
 *	piece of bytecode. Idempotent.
 *
 * ---------------------------------------------------------------------
 */

static int
IsCompactibleCompileEnv(
    CompileEnv *envPtr)
{
    unsigned char *pc;
    int size;

    /*
     * Special: procedures in the '::tcl' namespace (or its children) are
     * considered to be well-behaved and so can have compaction applied even
     * if it would otherwise be invalid.
     */

    if (envPtr->procPtr != NULL && envPtr->procPtr->cmdPtr != NULL
	    && envPtr->procPtr->cmdPtr->nsPtr != NULL) {
	Namespace *nsPtr = envPtr->procPtr->cmdPtr->nsPtr;

	if (strcmp(nsPtr->fullName, "::tcl") == 0
		|| strncmp(nsPtr->fullName, "::tcl::", 7) == 0) {
	    return 1;
	}
    }

    /*
     * Go through and ensure that no operation involved can cause a desired
     * change of bytecode sequence during running. This comes down to ensuring
     * that there are no mapped variables (due to traces) or calls to external
     * commands (traces, [uplevel] trickery). This is actually a very
     * conservative check; it turns down a lot of code that is OK in practice.
     */

    for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) {
	switch (*pc) {
	    /* Invokes */
	case INST_INVOKE_STK1:
	case INST_INVOKE_STK4:
	case INST_INVOKE_EXPANDED:
	case INST_INVOKE_REPLACE:
	    return 0;
	    /* Runtime evals */
	case INST_EVAL_STK:
	case INST_EXPR_STK:
	case INST_YIELD:
	    return 0;
	    /* Upvars */
	case INST_UPVAR:
	case INST_NSUPVAR:
	case INST_VARIABLE:
	    return 0;
	default:
	    size = tclInstructionTable[*pc].numBytes;
	    assert (size > 0);
	    break;
	}
    }

    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SubstObj --
 *
 *	This function performs the substitutions specified on the given string
 *	as described in the user documentation for the "subst" Tcl command.
 *
 * Results:
 *	A Tcl_Obj* containing the substituted string, or NULL to indicate that
 *	an error occurred.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_SubstObj(
    Tcl_Interp *interp,		/* Interpreter in which substitution occurs */
    Tcl_Obj *objPtr,		/* The value to be substituted. */
    int flags)			/* What substitutions to do. */
{
    NRE_callback *rootPtr = TOP_CB(interp);

    if (TclNRRunCallbacks(interp, Tcl_NRSubstObj(interp, objPtr, flags),
	    rootPtr) != TCL_OK) {
	return NULL;
    }
    return Tcl_GetObjResult(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NRSubstObj --
 *
 *	Request substitution of a Tcl value by the NR stack.
 *
 * Results:
 *	Returns TCL_OK.
 *
 * Side effects:
 *	Compiles objPtr into bytecode that performs the substitutions as
 *	governed by flags and places callbacks on the NR stack to execute
 *	the bytecode and store the result in the interp.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_NRSubstObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int flags)
{
    ByteCode *codePtr = CompileSubstObj(interp, objPtr, flags);

    /* TODO: Confirm we do not need this. */
    /* Tcl_ResetResult(interp); */
    return TclNRExecuteByteCode(interp, codePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CompileSubstObj --
 *
 *	Compile a Tcl value into ByteCode implementing its substitution, as
 *	governed by flags.
 *
 * Results:
 *	A (ByteCode *) is returned pointing to the resulting ByteCode.
 *
 * Side effects:
 *	The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
 *	ByteCode and governing flags value are kept in the internal rep for
 *	faster operations the next time CompileSubstObj is called on the same
 *	value.
 *
 *----------------------------------------------------------------------
 */

static ByteCode *
CompileSubstObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    int flags)
{
    Interp *iPtr = (Interp *) interp;
    ByteCode *codePtr = NULL;

    ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);

    if (codePtr != NULL) {
	Namespace *nsPtr = iPtr->varFramePtr->nsPtr;

	if (flags != PTR2INT(SubstFlags(objPtr))
		|| ((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
		|| (codePtr->localCachePtr !=
		iPtr->varFramePtr->localCachePtr)) {
	    Tcl_StoreIntRep(objPtr, &substCodeType, NULL);
	    codePtr = NULL;
	}
    }
    if (codePtr == NULL) {
	CompileEnv compEnv;
	size_t numBytes;
	const char *bytes = TclGetStringFromObj(objPtr, &numBytes);

	/* TODO: Check for more TIP 280 */
	TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);

	TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);

	TclEmitOpcode(INST_DONE, &compEnv);
	codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);
	TclFreeCompileEnv(&compEnv);

	SubstFlags(objPtr) = INT2PTR(flags);
	if (iPtr->varFramePtr->localCachePtr) {
	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
	    codePtr->localCachePtr->refCount++;
	}
#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile >= 2) {
	    TclPrintByteCodeObj(interp, objPtr);
	    fflush(stdout);
	}
#endif /* TCL_COMPILE_DEBUG */
    }
    return codePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeSubstCodeInternalRep --
 *
 *	Part of the substcode Tcl object type implementation. Frees the
 *	storage associated with a substcode object's internal representation
 *	unless its code is actively being executed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The substcode object's internal rep is marked invalid and its code
 *	gets freed unless the code is actively being executed. In that case
 *	the cleanup is delayed until the last execution of the code completes.
 *
 *----------------------------------------------------------------------
 */

static void
FreeSubstCodeInternalRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
{
    ByteCode *codePtr;

    ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);
    assert(codePtr != NULL);

    TclReleaseByteCode(codePtr);
}

static void
ReleaseCmdWordData(
    ExtCmdLoc *eclPtr)
{
    int i;

    if (eclPtr->type == TCL_LOCATION_SOURCE) {
	Tcl_DecrRefCount(eclPtr->path);
    }
    for (i=0 ; i<eclPtr->nuloc ; i++) {
	Tcl_Free(eclPtr->loc[i].line);
	ckfree((char *) eclPtr->loc[i].line);
    }

    if (eclPtr->loc != NULL) {
	Tcl_Free(eclPtr->loc);
	ckfree((char *) eclPtr->loc);
    }

    Tcl_DeleteHashTable (&eclPtr->litInfo);
    Tcl_Free(eclPtr);

    ckfree((char *) eclPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompileEnv --
 *
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
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480

1481
1482
1483
1484

1485
1486
1487



1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525

1526
1527
1528
1529

1530
1531
1532
1533
1534
1535
1536

1537
1538
1539

1540
1541
1542
1543

1544
1545
1546
1547
1548
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
1596
1597



1598
1599

1600
1601
1602
1603
1604
1605
1606
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







-
+


-
+






-
-










-
+



-
+








-








-










-
+




+

-
-
+
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-

-
+






-
+



+



-
+



















-




















-
+










-
-
-
+
+
+


+







 *----------------------------------------------------------------------
 */

void
TclInitCompileEnv(
    Tcl_Interp *interp,		/* The interpreter for which a CompileEnv
				 * structure is initialized. */
    CompileEnv *envPtr,/* Points to the CompileEnv structure to
    register CompileEnv *envPtr,/* Points to the CompileEnv structure to
				 * initialize. */
    const char *stringPtr,	/* The source string to be compiled. */
    size_t numBytes,		/* Number of bytes in source string. */
    int numBytes,		/* Number of bytes in source string. */
    const CmdFrame *invoker,	/* Location context invoking the bcc */
    int word)			/* Index of the word in that context getting
				 * compiled */
{
    Interp *iPtr = (Interp *) interp;

    assert(tclInstructionTable[LAST_INST_OPCODE].name == NULL);

    envPtr->iPtr = iPtr;
    envPtr->source = stringPtr;
    envPtr->numSrcBytes = numBytes;
    envPtr->procPtr = iPtr->compiledProcPtr;
    iPtr->compiledProcPtr = NULL;
    envPtr->numCommands = 0;
    envPtr->exceptDepth = 0;
    envPtr->maxExceptDepth = 0;
    envPtr->maxStackDepth = 0;
    envPtr->currStackDepth = 0;
    TclInitLiteralTable(&envPtr->localLitTable);
    TclInitLiteralTable(&(envPtr->localLitTable));

    envPtr->codeStart = envPtr->staticCodeSpace;
    envPtr->codeNext = envPtr->codeStart;
    envPtr->codeEnd = envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES;
    envPtr->codeEnd = (envPtr->codeStart + COMPILEENV_INIT_CODE_BYTES);
    envPtr->mallocedCodeArray = 0;

    envPtr->literalArrayPtr = envPtr->staticLiteralSpace;
    envPtr->literalArrayNext = 0;
    envPtr->literalArrayEnd = COMPILEENV_INIT_NUM_OBJECTS;
    envPtr->mallocedLiteralArray = 0;

    envPtr->exceptArrayPtr = envPtr->staticExceptArraySpace;
    envPtr->exceptAuxArrayPtr = envPtr->staticExAuxArraySpace;
    envPtr->exceptArrayNext = 0;
    envPtr->exceptArrayEnd = COMPILEENV_INIT_EXCEPT_RANGES;
    envPtr->mallocedExceptArray = 0;

    envPtr->cmdMapPtr = envPtr->staticCmdMapSpace;
    envPtr->cmdMapEnd = COMPILEENV_INIT_CMD_MAP_SIZE;
    envPtr->mallocedCmdMap = 0;
    envPtr->atCmdStart = 1;
    envPtr->expandCount = 0;

    /*
     * TIP #280: Set up the extended command location information, based on
     * the context invoking the byte code compiler. This structure is used to
     * keep the per-word line information for all compiled commands.
     *
     * See also tclBasic.c, TclEvalObjEx, for the equivalent code in the
     * non-compiling evaluator
     */

    envPtr->extCmdMapPtr = (ExtCmdLoc *)Tcl_Alloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr = (ExtCmdLoc *) ckalloc(sizeof(ExtCmdLoc));
    envPtr->extCmdMapPtr->loc = NULL;
    envPtr->extCmdMapPtr->nloc = 0;
    envPtr->extCmdMapPtr->nuloc = 0;
    envPtr->extCmdMapPtr->path = NULL;
    Tcl_InitHashTable(&envPtr->extCmdMapPtr->litInfo, TCL_ONE_WORD_KEYS);

    if (invoker == NULL) {
	/*
    if (invoker == NULL ||
	(invoker->type == TCL_LOCATION_EVAL_LIST)) {
        /*
	 * Initialize the compiler for relative counting in case of a
	 * dynamic context.
	 */

	envPtr->line = 1;
	if (iPtr->evalFlags & TCL_EVAL_FILE) {
	    iPtr->evalFlags &= ~TCL_EVAL_FILE;
	    envPtr->extCmdMapPtr->type = TCL_LOCATION_SOURCE;

	    if (iPtr->scriptFile) {
		/*
		 * Normalization here, to have the correct pwd. Should have
		 * negligible impact on performance, as the norm should have
		 * been done already by the 'source' invoking us, and it
		 * caches the result.
		 */

		Tcl_Obj *norm =
			Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile);

		if (norm == NULL) {
		    /*
		     * Error message in the interp result. No place to put it.
		     * And no place to serve the error itself to either. Fake
		     * a path, empty string.
		     */

		    TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
		} else {
		    envPtr->extCmdMapPtr->path = norm;
		}
	    } else {
		TclNewLiteralStringObj(envPtr->extCmdMapPtr->path, "");
	    }

	    Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
	} else {
	    envPtr->extCmdMapPtr->type =
	envPtr->extCmdMapPtr->type =
		(envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);
	}
    } else {
	/*
        /*
	 * Initialize the compiler using the context, making counting absolute
	 * to that context. Note that the context can be byte code execution.
	 * In that case we have to fill out the missing pieces (line, path,
	 * ...) which may make change the type as well.
	 */

	CmdFrame *ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame* ctxPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
	int pc = 0;

	*ctxPtr = *invoker;

	if (invoker->type == TCL_LOCATION_BC) {
	    /*
	     * Note: Type BC => ctx.data.eval.path    is not used.
	     *			ctx.data.tebc.codePtr is used instead.
	     *                  ctx.data.tebc.codePtr is used instead.
	     */

	    TclGetSrcInfoForPc(ctxPtr);
	    pc = 1;
	}

	if ((ctxPtr->nline <= word) || (ctxPtr->line[word] < 0)) {
	    /*
	     * Word is not a literal, relative counting.
	     */

	    envPtr->line = 1;
	    envPtr->extCmdMapPtr->type =
		    (envPtr->procPtr ? TCL_LOCATION_PROC : TCL_LOCATION_BC);

	    if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) {
		/*
		 * The reference made by 'TclGetSrcInfoForPc' is dead.
		 */

		Tcl_DecrRefCount(ctxPtr->data.eval.path);
	    }
	} else {
	    envPtr->line = ctxPtr->line[word];
	    envPtr->extCmdMapPtr->type = ctxPtr->type;

	    if (ctxPtr->type == TCL_LOCATION_SOURCE) {
		envPtr->extCmdMapPtr->path = ctxPtr->data.eval.path;

		if (pc) {
		    /*
		     * The reference 'TclGetSrcInfoForPc' made is transfered.
		     */

		    ctxPtr->data.eval.path = NULL;
		} else {
		    /*
		     * We have a new reference here.
		     */

		    Tcl_IncrRefCount(envPtr->extCmdMapPtr->path);
		    Tcl_IncrRefCount(ctxPtr->data.eval.path);
		}
	    }
	}

	TclStackFree(interp, ctxPtr);
    }

    envPtr->extCmdMapPtr->start = envPtr->line;

    /*
     * Initialize the data about invisible continuation lines as empty, i.e.
     * not used. The caller (TclSetByteCodeFromAny) will set this up, if such
     * data is available.
     * Initialize the data about invisible continuation lines as empty,
     * i.e. not used. The caller (TclSetByteCodeFromAny) will set this up, if
     * such data is available.
     */

    envPtr->clLoc  = NULL;
    envPtr->clNext = NULL;

    envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
    envPtr->auxDataArrayNext = 0;
    envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE;
    envPtr->mallocedAuxDataArray = 0;
}
1625
1626
1627
1628
1629
1630
1631
1632

1633
1634
1635


1636
1637
1638
1639

1640
1641
1642
1643
1644
1645
1646
1024
1025
1026
1027
1028
1029
1030

1031
1032


1033
1034
1035
1036
1037

1038
1039
1040
1041
1042
1043
1044
1045







-
+

-
-
+
+



-
+







 *	corresponding ByteCode structure.
 *
 *----------------------------------------------------------------------
 */

void
TclFreeCompileEnv(
    CompileEnv *envPtr)/* Points to the CompileEnv structure. */
    register CompileEnv *envPtr)/* Points to the CompileEnv structure. */
{
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets){
	Tcl_Free(envPtr->localLitTable.buckets);
    if (envPtr->localLitTable.buckets != envPtr->localLitTable.staticBuckets) {
	ckfree((char *) envPtr->localLitTable.buckets);
	envPtr->localLitTable.buckets = envPtr->localLitTable.staticBuckets;
    }
    if (envPtr->iPtr) {
	/*
	/* 
	 * We never converted to Bytecode, so free the things we would
	 * have transferred to it.
	 */

	int i;
	LiteralEntry *entryPtr = envPtr->literalArrayPtr;
	AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
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
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







-
+


-
+


-
+
-


-
+


-
+





+
+
+
+
+
+
+
+
+
+







	    if (auxDataPtr->type->freeProc != NULL) {
		auxDataPtr->type->freeProc(auxDataPtr->clientData);
	    }
	    auxDataPtr++;
	}
    }
    if (envPtr->mallocedCodeArray) {
	Tcl_Free(envPtr->codeStart);
	ckfree((char *) envPtr->codeStart);
    }
    if (envPtr->mallocedLiteralArray) {
	Tcl_Free(envPtr->literalArrayPtr);
	ckfree((char *) envPtr->literalArrayPtr);
    }
    if (envPtr->mallocedExceptArray) {
	Tcl_Free(envPtr->exceptArrayPtr);
	ckfree((char *) envPtr->exceptArrayPtr);
	Tcl_Free(envPtr->exceptAuxArrayPtr);
    }
    if (envPtr->mallocedCmdMap) {
	Tcl_Free(envPtr->cmdMapPtr);
	ckfree((char *) envPtr->cmdMapPtr);
    }
    if (envPtr->mallocedAuxDataArray) {
	Tcl_Free(envPtr->auxDataArrayPtr);
	ckfree((char *) envPtr->auxDataArrayPtr);
    }
    if (envPtr->extCmdMapPtr) {
	ReleaseCmdWordData(envPtr->extCmdMapPtr);
	envPtr->extCmdMapPtr = NULL;
    }

    /*
     * If we used data about invisible continuation lines, then now is the
     * time to release on our hold on it. The lock was set in function
     * TclSetByteCodeFromAny(), found in this file.
     */

    if (envPtr->clLoc) {
	Tcl_Release (envPtr->clLoc);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclWordKnownAtCompileTime --
 *
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
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







-
+












-
-
+
+

-







	return 1;
    }
    if (tokenPtr->type != TCL_TOKEN_WORD) {
	return 0;
    }
    tokenPtr++;
    if (valuePtr != NULL) {
	TclNewObj(tempPtr);
	tempPtr = Tcl_NewObj();
	Tcl_IncrRefCount(tempPtr);
    }
    while (numComponents--) {
	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    if (tempPtr != NULL) {
		Tcl_AppendToObj(tempPtr, tokenPtr->start, tokenPtr->size);
	    }
	    break;

	case TCL_TOKEN_BS:
	    if (tempPtr != NULL) {
		char utfBuf[4] = "";
		size_t length = TclParseBackslash(tokenPtr->start,
		char utfBuf[TCL_UTF_MAX];
		int length = TclParseBackslash(tokenPtr->start,
			tokenPtr->size, NULL, utfBuf);

		Tcl_AppendToObj(tempPtr, utfBuf, length);
	    }
	    break;

	default:
	    if (tempPtr != NULL) {
		Tcl_DecrRefCount(tempPtr);
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485



1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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





























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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+




+
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+













+
+
+
+
+

+
-
+
+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-

+
+
+
+
-
+
-
-
-
+

-
+



+
-
+
+
+

-
-
+

+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
-
-
+

-
+
-
-
-
-
-
-
+
+
+
+
+


-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+



-
+


-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+
-
-
+

-
+

-
-
-
-
-
-
+
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
+
+
+
+
+

-
-
-
+
+

-
+
+
+
+







 *
 * Side effects:
 *	Adds instructions to envPtr to evaluate the script at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
ExpandRequested(
    Tcl_Token *tokenPtr,
    size_t numWords)
{
    /* Determine whether any words of the command require expansion */
    while (numWords--) {
	if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
	    return 1;
	}
	tokenPtr = TokenAfter(tokenPtr);
    }
    return 0;
}

static void
CompileCmdLiteral(
    Tcl_Interp *interp,
    Tcl_Obj *cmdObj,
    CompileEnv *envPtr)
{
    const char *bytes;
    Command *cmdPtr;
    int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
    size_t length;

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }

    bytes = TclGetStringFromObj(cmdObj, &length);
    cmdLitIdx = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);

    if (cmdPtr && TclRoutineHasName(cmdPtr)) {
	TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
    }
    TclEmitPush(cmdLitIdx, envPtr);
}

void
TclCompileInvocation(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    Tcl_Obj *cmdObj,
    size_t numWords,
    CompileEnv *envPtr)
{
    DefineLineInformation;
    size_t wordIdx = 0;
    int depth = TclGetStackDepth(envPtr);

    if (cmdObj) {
	CompileCmdLiteral(interp, cmdObj, envPtr);
	wordIdx = 1;
	tokenPtr = TokenAfter(tokenPtr);
    }

    for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
	int objIdx;

	SetLineInformation(wordIdx);

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    CompileTokens(envPtr, tokenPtr, interp);
	    continue;
	}

	objIdx = TclRegisterLiteral(envPtr,
		tokenPtr[1].start, tokenPtr[1].size, 0);
	if (envPtr->clNext) {
	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
	}
	TclEmitPush(objIdx, envPtr);
    }

    if (wordIdx <= 255) {
	TclEmitInvoke(envPtr, INST_INVOKE_STK1, wordIdx);
    } else {
	TclEmitInvoke(envPtr, INST_INVOKE_STK4, wordIdx);
    }
    TclCheckStackDepth(depth+1, envPtr);
}

static void
CompileExpanded(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    Tcl_Obj *cmdObj,
    int numWords,
    CompileEnv *envPtr)
{
    DefineLineInformation;
    int wordIdx = 0;
    int depth = TclGetStackDepth(envPtr);

    StartExpanding(envPtr);
    if (cmdObj) {
	CompileCmdLiteral(interp, cmdObj, envPtr);
	wordIdx = 1;
	tokenPtr = TokenAfter(tokenPtr);
    }

    for (; wordIdx < numWords; wordIdx++, tokenPtr = TokenAfter(tokenPtr)) {
	int objIdx;

	SetLineInformation(wordIdx);

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    CompileTokens(envPtr, tokenPtr, interp);
	    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		TclEmitInstInt4(INST_EXPAND_STKTOP,
			envPtr->currStackDepth, envPtr);
	    }
	    continue;
	}

	objIdx = TclRegisterLiteral(envPtr,
		tokenPtr[1].start, tokenPtr[1].size, 0);
	if (envPtr->clNext) {
	    TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
		    tokenPtr[1].start - envPtr->source, envPtr->clNext);
	}
	TclEmitPush(objIdx, envPtr);
    }

    /*
     * The stack depth during argument expansion can only be managed at
     * runtime, as the number of elements in the expanded lists is not known
     * at compile time. We adjust here the stack depth estimate so that it is
     * correct after the command with expanded arguments returns.
     *
     * The end effect of this command's invocation is that all the words of
     * the command are popped from the stack, and the result is pushed: the
     * stack top changes by (1-wordIdx).
     *
     * Note that the estimates are not correct while the command is being
     * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general.
     */

    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);
    TclCheckStackDepth(depth+1, envPtr);
}

static int
CompileCmdCompileProc(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,
    CompileEnv *envPtr)
{
    DefineLineInformation;
    int unwind = 0, incrOffset = -1;
    int depth = TclGetStackDepth(envPtr);

    /*
     * Emit of the INST_START_CMD instruction is controlled by the value of
     * envPtr->atCmdStart:
     *
     * atCmdStart == 2	: We are not using the INST_START_CMD instruction.
     * atCmdStart == 1	: INST_START_CMD was the last instruction emitted.
     *			: We do not need to emit another.  Instead we
     *			: increment the number of cmds started at it (except
     *			: for the special case at the start of a script.)
     * atCmdStart == 0	: The last instruction was something else.  We need
     *			: to emit INST_START_CMD here.
     */

    switch (envPtr->atCmdStart) {
    case 0:
	unwind = tclInstructionTable[INST_START_CMD].numBytes;
	TclEmitInstInt4(INST_START_CMD, 0, envPtr);
	incrOffset = envPtr->codeNext - envPtr->codeStart;
	TclEmitInt4(0, envPtr);
	break;
    case 1:
	if (envPtr->codeNext > envPtr->codeStart) {
	    incrOffset = envPtr->codeNext - 4 - envPtr->codeStart;
	}
	break;
    case 2:
	/* Nothing to do */
	;
    }

    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) {
	if (incrOffset >= 0) {
	    /*
	     * We successfully compiled a command.  Increment the number of
	     * commands that start at the currently active INST_START_CMD.
	     */

	    unsigned char *incrPtr = envPtr->codeStart + incrOffset;
	    unsigned char *startPtr = incrPtr - 5;

	    TclIncrUInt4AtPtr(incrPtr, 1);
	    if (unwind) {
		/* We started the INST_START_CMD.  Record the code length. */
		TclStoreInt4AtPtr(envPtr->codeNext - startPtr, startPtr + 1);
	    }
	}
	TclCheckStackDepth(depth+1, envPtr);
	return TCL_OK;
    }

    envPtr->codeNext -= unwind; /* Unwind INST_START_CMD */

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
	mapPtr->nuloc--;
	Tcl_Free(mapPtr->loc[mapPtr->nuloc].line);
	mapPtr->loc[mapPtr->nuloc].line = NULL;
    }

    /*
     * Reset the index of next command.  Toss out any from failed nested
     * partial compiles.
     */

    envPtr->numCommands = mapPtr->nuloc;
    return TCL_ERROR;
}

static int
CompileCommandTokens(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    CompileEnv *envPtr)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    Tcl_Obj *cmdObj;
    Command *cmdPtr = NULL;
    int code = TCL_ERROR;
    int cmdKnown, expand = -1;
    int *wlines, wlineat;
    int cmdLine = envPtr->line;
    int *clNext = envPtr->clNext;
    int cmdIdx = envPtr->numCommands;
    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
    int depth = TclGetStackDepth(envPtr);

    assert (parsePtr->numWords > 0);

    /* Pre-Compile */

    TclNewObj(cmdObj);
    envPtr->numCommands++;
    EnterCmdStartData(envPtr, cmdIdx,
	    parsePtr->commandStart - envPtr->source, startCodeOffset);

    /*
     * TIP #280. Scan the words and compute the extended location information.
     * The map first contain full per-word line information for use by the
     * compiler. This is later replaced by a reduced form which signals
     * non-literal words, stored in 'wlines'.
     */

    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
	    parsePtr->tokenPtr, parsePtr->commandStart,
	    parsePtr->numWords, cmdLine,
	    clNext, &wlines, envPtr);
    wlineat = eclPtr->nuloc - 1;

    envPtr->line = eclPtr->loc[wlineat].line[0];
    envPtr->clNext = eclPtr->loc[wlineat].next[0];

    /* Do we know the command word? */
    Tcl_IncrRefCount(cmdObj);
    tokenPtr = parsePtr->tokenPtr;
    cmdKnown = TclWordKnownAtCompileTime(tokenPtr, cmdObj);

    /* Is this a command we should (try to) compile with a compileProc ? */
    if (cmdKnown && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
	cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
	if (cmdPtr) {
	    /*
	     * Found a command.  Test the ways we can be told not to attempt
	     * to compile it.
	     */
	    if ((cmdPtr->compileProc == NULL)
		    || (cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION)
		    || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) {
		cmdPtr = NULL;
	    }
	}
	if (cmdPtr && !(cmdPtr->flags & CMD_COMPILES_EXPANDED)) {
	    expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
	    if (expand) {
		/* We need to expand, but compileProc cannot. */
		cmdPtr = NULL;
	    }
	}
    }

    /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */
    if (cmdPtr) {
	code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr);
    }

    if (code == TCL_ERROR) {
	if (expand < 0) {
	    expand = ExpandRequested(parsePtr->tokenPtr, parsePtr->numWords);
	}

	if (expand) {
	    CompileExpanded(interp, parsePtr->tokenPtr,
		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
	} else {
	    TclCompileInvocation(interp, parsePtr->tokenPtr,
		    cmdKnown ? cmdObj : NULL, parsePtr->numWords, envPtr);
	}
    }

    Tcl_DecrRefCount(cmdObj);

    TclEmitOpcode(INST_POP, envPtr);
    EnterCmdExtentData(envPtr, cmdIdx,
	    parsePtr->term - parsePtr->commandStart,
	    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);

    /*
     * TIP #280: Free full form of per-word line data and insert the reduced
     * form now
     */

    envPtr->line = cmdLine;
    envPtr->clNext = clNext;
    Tcl_Free(eclPtr->loc[wlineat].line);
    Tcl_Free(eclPtr->loc[wlineat].next);
    eclPtr->loc[wlineat].line = wlines;
    eclPtr->loc[wlineat].next = NULL;

    TclCheckStackDepth(depth, envPtr);
    return cmdIdx;
}

void
TclCompileScript(
    Tcl_Interp *interp,		/* Used for error and status reporting. Also
				 * serves as context for finding and compiling
				 * commands. May not be NULL. */
    const char *script,		/* The source script to compile. */
    size_t numBytes,		/* Number of bytes in script. If -1, the
    int numBytes,		/* Number of bytes in script. If < 0, the
				 * script consists of all bytes up to the
				 * first null character. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Interp *iPtr = (Interp *) interp;
    int lastCmdIdx = -1;	/* Index into envPtr->cmdMapPtr of the last
				 * command this routine compiles into bytecode.
    int lastTopLevelCmdIndex = -1;
    				/* Index of most recent toplevel command in
 				 * the command location table. Initialized to
 				 * avoid compiler warning. */
				 * Initial value of -1 indicates this routine
				 * has not yet generated any bytecode. */
    const char *p = script;	/* Where we are in our compile. */
    int depth = TclGetStackDepth(envPtr);
    Interp *iPtr = (Interp *) interp;
    int startCodeOffset = -1;	/* Offset of first byte of current command's
				 * code. Init. to avoid compiler warning. */
    unsigned char *entryCodeNext = envPtr->codeNext;
    const char *p, *next;
    Namespace *cmdNsPtr;
    Command *cmdPtr;
    Tcl_Token *tokenPtr;
    int bytesLeft, isFirstCmd, wordIdx, currCmdIndex;
    int commandLength, objIndex;
    Tcl_DString ds;
    /* TIP #280 */
    ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
    int *wlines, wlineat, cmdLine;
    int* clNext;
    Tcl_Parse *parsePtr;

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclCompileScript() called on uninitialized CompileEnv");
    }
    /*
    /* 
     * Check depth to avoid overflow of the C execution stack by too many
     * nested calls of TclCompileScript (considering interp recursionlimit).
     * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition
     * during "mixed" evaluation and compilation process (nested eval+compile)
     * and is good enough for default recursionlimit (1000).
     */
    if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "too many nested compilations (infinite loop?)", -1));
	Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", NULL);
	TclCompileSyntaxError(interp, envPtr);
	return;
    }
    /* 
     * Avoid stack exhaustion by too many nested calls of TclCompileScript
     * (considering interp recursionlimit).
     */
    iPtr->numLevels++;

    parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    /* Each iteration compiles one command from the script. */

    Tcl_DStringInit(&ds);

    if (numBytes + 1 > 1) {
      /*
    if (numBytes < 0) {
	numBytes = strlen(script);
    }
    Tcl_ResetResult(interp);
    isFirstCmd = 1;

    if (envPtr->procPtr != NULL) {
	cmdNsPtr = envPtr->procPtr->cmdPtr->nsPtr;
    } else {
	cmdNsPtr = NULL;	/* use current NS */
    }

    /*
       * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so
       * many nested compilations (body enclosed in body) can cause abnormal
       * program termination with a stack overflow exception, bug [fec0c17d39].
       */
     * Each iteration through the following loop compiles the next command
     * from the script.
     */
      Tcl_Parse *parsePtr = (Tcl_Parse *)Tcl_Alloc(sizeof(Tcl_Parse));

    p = script;
    bytesLeft = numBytes;
    cmdLine = envPtr->line;
    clNext = envPtr->clNext;
      do {
    do {
	const char *next;

	if (TCL_OK != Tcl_ParseCommand(interp, p, numBytes, 0, parsePtr)) {
	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
	    /*
	     * Compile bytecodes to report the parsePtr error at runtime.
	     * Compile bytecodes to report the parse error at runtime.
	     */

	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		    /* Drop the command terminator (";","]") if appropriate */
		    parsePtr->term + 1 - parsePtr->commandStart);
		    (parsePtr->term ==
		    parsePtr->commandStart + parsePtr->commandSize - 1)?
		    parsePtr->commandSize - 1 : parsePtr->commandSize);
	    TclCompileSyntaxError(interp, envPtr);
	    Tcl_Free(parsePtr);
	    return;
	    break;
	}
	if (parsePtr->numWords > 0) {
	    int expand = 0;	/* Set if there are dynamic expansions to
				 * handle */

	    /*
	     * If not the first command, pop the previous command's result
	     * and, if we're compiling a top level command, update the last
	     * command's code size to account for the pop instruction.
	     */

	    if (!isFirstCmd) {
		TclEmitOpcode(INST_POP, envPtr);
		envPtr->cmdMapPtr[lastTopLevelCmdIndex].numCodeBytes =
			(envPtr->codeNext - envPtr->codeStart)
			- startCodeOffset;
	    }

	    /*
	     * Determine the actual length of the command.
	     */

	    commandLength = parsePtr->commandSize;
	    if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
		/*
		 * The command terminator character (such as ; or ]) is the
		 * last character in the parsed command. Reduce the length by
		 * one so that the trace message doesn't include the
		 * terminator character.
		 */

		commandLength -= 1;
	    }

#ifdef TCL_COMPILE_DEBUG
	/*
	 * If tracing, print a line for each top level command compiled.
	    /*
	     * If tracing, print a line for each top level command compiled.
	 * TODO: Suppress when numWords == 0 ?
	 */
	     */

	if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
	    if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
	    int commandLength = parsePtr->term - parsePtr->commandStart;
	    fprintf(stdout, "  Compiling: ");
	    TclPrintSource(stdout, parsePtr->commandStart,
		    TclMin(commandLength, 55));
	    fprintf(stdout, "\n");
	}
		fprintf(stdout, "  Compiling: ");
		TclPrintSource(stdout, parsePtr->commandStart,
			TclMin(commandLength, 55));
		fprintf(stdout, "\n");
	    }
#endif

	/*
	 * TIP #280: Count newlines before the command start.
	 * (See test info-30.33).
	 */
	    /*
	     * Check whether expansion has been requested for any of the
	     * words.
	     */

	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
		    wordIdx < parsePtr->numWords;
		    wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
		if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
		    expand = 1;
		    break;
		}
	    }

	    envPtr->numCommands++;
	    currCmdIndex = (envPtr->numCommands - 1);
	    lastTopLevelCmdIndex = currCmdIndex;
	    startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
	    EnterCmdStartData(envPtr, currCmdIndex,
		    parsePtr->commandStart - envPtr->source, startCodeOffset);

	    /*
	     * Should only start issuing instructions after the "command has
	     * started" so that the command range is correct in the bytecode.
	     */

	    if (expand) {
		TclEmitOpcode(INST_EXPAND_START, envPtr);
	    }

	    /*
	     * TIP #280. Scan the words and compute the extended location
	     * information. The map first contain full per-word line
	     * information for use by the compiler. This is later replaced by
	     * a reduced form which signals non-literal words, stored in
	     * 'wlines'.
	     */

	    TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
	    TclAdvanceContinuations (&cmdLine, &clNext,
				     parsePtr->commandStart - envPtr->source);
	    EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
			     parsePtr->tokenPtr, parsePtr->commandStart,
			     parsePtr->commandSize, parsePtr->numWords, cmdLine,
			     clNext, &wlines, envPtr);
	    wlineat = eclPtr->nuloc - 1;

	    /*
	     * Each iteration of the following loop compiles one word from the
	     * command.
	     */

	    for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
		    wordIdx < parsePtr->numWords; wordIdx++,
		    tokenPtr += (tokenPtr->numComponents + 1)) {

		envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
		envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx];

		if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
		    /*
		     * The word is not a simple string of characters.
		     */

		    TclCompileTokens(interp, tokenPtr+1,
			    tokenPtr->numComponents, envPtr);
		    if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
			TclEmitInstInt4(INST_EXPAND_STKTOP,
				envPtr->currStackDepth, envPtr);
		    }
		    continue;
		}

		/*
		 * This is a simple string of literal characters (i.e. we know
		 * it absolutely and can use it directly). If this is the
		 * first word and the command has a compile procedure, let it
		 * compile the command.
		 */

		if ((wordIdx == 0) && !expand) {
		    /*
		     * We copy the string before trying to find the command by
		     * name. We used to modify the string in place, but this
		     * is not safe because the name resolution handlers could
		     * have side effects that rely on the unmodified string.
		     */

		    Tcl_DStringSetLength(&ds, 0);
		    Tcl_DStringAppend(&ds, tokenPtr[1].start,tokenPtr[1].size);

		    cmdPtr = (Command *) Tcl_FindCommand(interp,
			    Tcl_DStringValue(&ds),
			    (Tcl_Namespace *) cmdNsPtr, /*flags*/ 0);

		    if ((cmdPtr != NULL)
			    && (cmdPtr->compileProc != NULL)
			    && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
			    && !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
			int savedNumCmds = envPtr->numCommands;
			unsigned savedCodeNext =
				envPtr->codeNext - envPtr->codeStart;
			int update = 0, code;

			/*
			 * Mark the start of the command; the proper bytecode
			 * length will be updated later. There is no need to
			 * do this for the first bytecode in the compile env,
			 * as the check is done before calling
			 * TclExecuteByteCode(). Do emit an INST_START_CMD in
			 * special cases where the first bytecode is in a
			 * loop, to insure that the corresponding command is
			 * counted properly. Compilers for commands able to
			 * produce such a beast (currently 'while 1' only) set
			 * envPtr->atCmdStart to 0 in order to signal this
			 * case. [Bug 1752146]
			 *
			 * Note that the environment is initialised with
			 * atCmdStart=1 to avoid emitting ISC for the first
			 * command.
			 */

			if (envPtr->atCmdStart) {
			    if (savedCodeNext != 0) {
				/*
				 * Increase the number of commands being
				 * started at the current point. Note that
				 * this depends on the exact layout of the
				 * INST_START_CMD's operands, so be careful!
				 */

				unsigned char *fixPtr = envPtr->codeNext - 4;

				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)+1,
					fixPtr);
			    }
			} else {
			    TclEmitInstInt4(INST_START_CMD, 0, envPtr);
			    TclEmitInt4(1, envPtr);
			    update = 1;
			}

			code = (cmdPtr->compileProc)(interp, parsePtr,
				cmdPtr, envPtr);

			if (code == TCL_OK) {
			    if (update) {
				/*
				 * Fix the bytecode length.
				 */

				unsigned char *fixPtr = envPtr->codeStart
					+ savedCodeNext + 1;
				unsigned fixLen = envPtr->codeNext
					- envPtr->codeStart - savedCodeNext;
	TclAdvanceLines(&envPtr->line, p, parsePtr->commandStart);
	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
		parsePtr->commandStart - envPtr->source);

				TclStoreInt4AtPtr(fixLen, fixPtr);
			    }
			    goto finishCommand;
			} else {
			    if (envPtr->atCmdStart && savedCodeNext != 0) {
				/*
				 * Decrease the number of commands being
				 * started at the current point. Note that
				 * this depends on the exact layout of the
				 * INST_START_CMD's operands, so be careful!
				 */

				unsigned char *fixPtr = envPtr->codeNext - 4;

				TclStoreInt4AtPtr(TclGetUInt4AtPtr(fixPtr)-1,
					fixPtr);
			    }

			    /*
			     * Restore numCommands and codeNext to their
			     * correct values, removing any commands compiled
			     * before the failure to produce bytecode got
			     * reported. [Bugs 705406 and 735055]
			     */

			    envPtr->numCommands = savedNumCmds;
			    envPtr->codeNext = envPtr->codeStart+savedCodeNext;
			}
		    }

		    /*
		     * No compile procedure so push the word. If the command
		     * was found, push a CmdName object to reduce runtime
		     * lookups. Avoid sharing this literal among different
		     * namespaces to reduce shimmering.
		     */

		    objIndex = TclRegisterNewNSLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);
		    if (cmdPtr != NULL) {
			TclSetCmdNameObj(interp,
			      envPtr->literalArrayPtr[objIndex].objPtr,cmdPtr);
		    }
		    if ((wordIdx == 0) && (parsePtr->numWords == 1)) {
			/*
			 * Single word script: unshare the command name to
			 * avoid shimmering between bytecode and cmdName
			 * representations [Bug 458361]
			 */

			TclHideLiteral(interp, envPtr, objIndex);
		    }
		} else {
		    /*
		     * Simple argument word of a command. We reach this if and
		     * only if the command word was not compiled for whatever
		     * reason. Register the literal's location for use by
		     * uplevel, etc. commands, should they encounter it
		     * unmodified. We care only if the we are in a context
		     * which already allows absolute counting.
		     */
		    objIndex = TclRegisterNewLiteral(envPtr,
			    tokenPtr[1].start, tokenPtr[1].size);

		    if (envPtr->clNext) {
			TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr,
						      tokenPtr[1].start - envPtr->source,
						      eclPtr->loc [wlineat].next [wordIdx]);
		    }
		}
		TclEmitPush(objIndex, envPtr);
	    } /* for loop */

	    /*
	     * Emit an invoke instruction for the command. We skip this if a
	     * compile procedure was found for the command.
	     */

	    if (expand) {
		/*
		 * The stack depth during argument expansion can only be
		 * managed at runtime, as the number of elements in the
		 * expanded lists is not known at compile time. We adjust here
		 * the stack depth estimate so that it is correct after the
		 * command with expanded arguments returns.
		 *
		 * The end effect of this command's invocation is that all the
		 * words of the command are popped from the stack, and the
		 * result is pushed: the stack top changes by (1-wordIdx).
		 *
		 * Note that the estimates are not correct while the command
		 * is being prepared and run, INST_EXPAND_STKTOP is not
		 * stack-neutral in general.
		 */

		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
		TclAdjustStackDepth((1-wordIdx), envPtr);
	    } else if (wordIdx > 0) {
		/*
		 * Save PC -> command map for the TclArgumentBC* functions.
		 */

		int isnew;
		Tcl_HashEntry* hePtr = Tcl_CreateHashEntry(&eclPtr->litInfo,
			   (char*) (envPtr->codeNext - envPtr->codeStart), &isnew);
		Tcl_SetHashValue(hePtr, INT2PTR(wlineat));

		if (wordIdx <= 255) {
		    TclEmitInstInt1(INST_INVOKE_STK1, wordIdx, envPtr);
		} else {
		    TclEmitInstInt4(INST_INVOKE_STK4, wordIdx, envPtr);
		}
	    }

	    /*
	     * Update the compilation environment structure and record the
	     * offsets of the source and code for the command.
	     */

	finishCommand:
	    EnterCmdExtentData(envPtr, currCmdIndex, commandLength,
		    (envPtr->codeNext-envPtr->codeStart) - startCodeOffset);
	    isFirstCmd = 0;

	    /*
	     * TIP #280: Free full form of per-word line data and insert the
	     * reduced form now
	     */

	    ckfree((char *) eclPtr->loc[wlineat].line);
	    ckfree((char *) eclPtr->loc[wlineat].next);
	    eclPtr->loc[wlineat].line = wlines;
	    eclPtr->loc[wlineat].next = NULL;
	} /* end if parsePtr->numWords > 0 */

	/*
	 * Advance parser to the next command in the script.
	 * Advance to the next command in the script.
	 */

	next = parsePtr->commandStart + parsePtr->commandSize;
	numBytes -= next - p;
	bytesLeft -= next - p;
	p = next;

	if (parsePtr->numWords == 0) {
	    /*
	/*
	     * The "command" parsed has no words.  In this case we can skip
	     * the rest of the loop body.  With no words, clearly
	     * CompileCommandTokens() has nothing to do.  Since the parser
	     * aggressively sucks up leading comment and white space,
	     * including newlines, parsePtr->commandStart must be pointing at
	     * either the end of script, or a command-terminating semi-colon.
	     * In either case, the TclAdvance*() calls have nothing to do.
	     * Finally, when no words are parsed, no tokens have been
	     * allocated at parsePtr->tokenPtr so there's also nothing for
	     * Tcl_FreeParse() to do.
	     *
	     * The advantage of this shortcut is that CompileCommandTokens()
	     * can be written with an assumption that parsePtr->numWords > 0, with
	     * the implication the CCT() always generates bytecode.
	     */
	    continue;
	}

	/*
	 * Avoid stack exhaustion by too many nested calls of TclCompileScript
	 * (considering interp recursionlimit).
	 */
	iPtr->numLevels++;

	lastCmdIdx = CompileCommandTokens(interp, parsePtr, envPtr);

	iPtr->numLevels--;

	/*
	 * TIP #280: Track lines in the just compiled command.
	 */

	TclAdvanceLines(&envPtr->line, parsePtr->commandStart, p);
	TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
	TclAdvanceContinuations(&envPtr->line, &envPtr->clNext,
		p - envPtr->source);
	TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source);
	Tcl_FreeParse(parsePtr);
      } while (numBytes > 0);
    } while (bytesLeft > 0);

      Tcl_Free(parsePtr);
    }

    if (lastCmdIdx == -1) {
	/*
	 * Compiling the script yielded no bytecode.  The script must be all
    /*
     * If the source script yielded no instructions (e.g., if it was empty),
	 * whitespace, comments, and empty commands.  Such scripts are defined
	 * to successfully produce the empty string result, so we emit the
     * push an empty string as the command's result.
	 * simple bytecode that makes that happen.
	 */

     *
	PushStringLiteral(envPtr, "");
    } else {
	/*
	 * We compiled at least one command to bytecode.  The routine
	 * CompileCommandTokens() follows the bytecode of each compiled
	 * command with an INST_POP, so that stack balance is maintained when
	 * several commands are in sequence.  (The result of each command is
	 * thrown away before moving on to the next command).  For the last
	 * command compiled, we need to undo that INST_POP so that the result
	 * of the last command becomes the result of the script.  The code
     * WARNING: push an unshared object! If the script being compiled is a
	 * here removes that trailing INST_POP.
	 */
     * shared empty string, it will otherwise be self-referential and cause
     * difficulties with literal management [Bugs 467523, 983660]. We used to
     * have special code in TclReleaseLiteral to handle this particular
     * self-reference, but now opt for avoiding its creation altogether.
     */

	envPtr->cmdMapPtr[lastCmdIdx].numCodeBytes--;
	envPtr->codeNext--;
	envPtr->currStackDepth++;
    if (envPtr->codeNext == entryCodeNext) {
	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewObj(), NULL), envPtr);
    }
    TclCheckStackDepth(depth+1, envPtr);

    iPtr->numLevels--;
    TclStackFree(interp, parsePtr);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileTokens --
 *
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
-
-
+
+
+
+



-
+
-





-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
+
+


-
-
+
+






-
-
+
+


-





-
+
-
-







 * Side effects:
 *	Instructions are added to envPtr to push and evaluate the tokens at
 *	runtime.
 *
 *----------------------------------------------------------------------
 */

void
TclCompileVarSubst(
    Tcl_Interp *interp,
    Tcl_Token *tokenPtr,
    CompileEnv *envPtr)
{
    const char *p, *name = tokenPtr[1].start;
    size_t i, nameBytes = tokenPtr[1].size;
    int localVar, localVarName = 1;

    /*
     * Determine how the variable name should be handled: if it contains any
     * namespace qualifiers it is not a local variable (localVarName=-1); if
     * it looks like an array element and the token has a single component, it
     * should not be created here [Bug 569438] (localVarName=0); otherwise,
     * the local variable can safely be created (localVarName=1).
     */

    for (i = 0, p = name;  i < nameBytes;  i++, p++) {
	if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
	    localVarName = -1;
	    break;
	} else if ((*p == '(')
		&& (tokenPtr->numComponents == 1)
		&& (*(name + nameBytes - 1) == ')')) {
	    localVarName = 0;
	    break;
	}
    }

    /*
     * Either push the variable's name, or find its index in the array
     * of local variables in a procedure frame.
     */

    localVar = -1;
    if (localVarName != -1) {
	localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
    }
    if (localVar < 0) {
	PushLiteral(envPtr, name, nameBytes);
    }

    /*
     * Emit instructions to load the variable.
     */

    TclAdvanceLines(&envPtr->line, tokenPtr[1].start,
	    tokenPtr[1].start + tokenPtr[1].size);

    if (tokenPtr->numComponents == 1) {
	if (localVar < 0) {
	    TclEmitOpcode(INST_LOAD_STK, envPtr);
	} else if (localVar <= 255) {
	    TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
	}
    } else {
	TclCompileTokens(interp, tokenPtr+2, tokenPtr->numComponents-1, envPtr);
	if (localVar < 0) {
	    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
	} else if (localVar <= 255) {
	    TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
	} else {
	    TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
	}
    }
}

void
TclCompileTokens(
    Tcl_Interp *interp,		/* Used for error and status reporting. */
    Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
				 * compile. */
    int count,			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_DString textBuffer;	/* Holds concatenated chars from adjacent
				 * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
    char buffer[4] = "";
    int i, numObjsToConcat, adjust;
    size_t length;
    char buffer[TCL_UTF_MAX];
    const char *name, *p;
    int numObjsToConcat, nameBytes, localVarName, localVar;
    int length, i;
    unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL;
    int *clPosition = NULL;
    int* clPosition = NULL;
    int depth = TclGetStackDepth(envPtr);

    /*
     * For the handling of continuation lines in literals we first check if
     * this is actually a literal. For if not we can forego the additional
     * processing. Otherwise we pre-allocate a small table to store the
     * locations of all continuation lines we find in this literal, if any.
     * The table is extended if needed.
     * locations of all continuation lines we find in this literal, if
     * any. The table is extended if needed.
     *
     * Note: Different to the equivalent code in function 'TclSubstTokens()'
     * (see file "tclParse.c") we do not seem to need the 'adjust' variable.
     * We also do not seem to need code which merges continuation line
     * information of multiple words which concat'd at runtime. Either that or
     * I have not managed to find a test case for these two possibilities yet.
     * It might be a difference between compile- versus run-time processing.
     * Note: Different to the equivalent code in function
     * 'TclSubstTokens()' (see file "tclParse.c") we do not seem to need
     * the 'adjust' variable. We also do not seem to need code which merges
     * continuation line information of multiple words which concat'd at
     * runtime. Either that or I have not managed to find a test case for
     * these two possibilities yet. It might be a difference between compile-
     * versus runtime processing.
     */

    numCL = 0;
    maxNumCL = 0;
    numCL     = 0;
    maxNumCL  = 0;
    isLiteral = 1;
    for (i=0 ; i < count; i++) {
	if ((tokenPtr[i].type != TCL_TOKEN_TEXT)
		&& (tokenPtr[i].type != TCL_TOKEN_BS)) {
	if ((tokenPtr[i].type != TCL_TOKEN_TEXT) &&
	    (tokenPtr[i].type != TCL_TOKEN_BS)) {
	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
	maxNumCL   = NUM_STATIC_POS;
	clPosition = (int*) ckalloc (maxNumCL*sizeof(int));
    }

    adjust = 0;
    Tcl_DStringInit(&textBuffer);
    numObjsToConcat = 0;
    for ( ;  count > 0;  count--, tokenPtr++) {
	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    TclDStringAppendToken(&textBuffer, tokenPtr);
	    Tcl_DStringAppend(&textBuffer, tokenPtr->start, tokenPtr->size);
	    TclAdvanceLines(&envPtr->line, tokenPtr->start,
		    tokenPtr->start + tokenPtr->size);
	    break;

	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buffer);
	    Tcl_DStringAppend(&textBuffer, buffer, length);

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
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
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
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







-
+



-
-
+
+




-









-
+
+
+






-
-
+
+




-


-











-
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+







-
+








-
+

+
+


+

-
-
+
+









-
+



-
+







-
+




-
-
+
+



-
+

-







	     * everything, just the number of lines we have to add as
	     * correction.
	     */

	    if ((length == 1) && (buffer[0] == ' ') &&
		(tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    int clPos = Tcl_DStringLength(&textBuffer);
		    int clPos = Tcl_DStringLength (&textBuffer);

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (int *)Tcl_Realloc(clPosition,
                                maxNumCL * sizeof(int));
			clPosition = (int*) ckrealloc ((char*)clPosition,
						       maxNumCL*sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL ++;
		}
		adjust++;
	    }
	    break;

	case TCL_TOKEN_COMMAND:
	    /*
	     * Push any accumulated chars appearing before the command.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
		int literal = TclRegisterNewLiteral(envPtr,
			Tcl_DStringValue(&textBuffer),
			Tcl_DStringLength(&textBuffer));

		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);

		if (numCL) {
		    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
			    numCL, clPosition);
		    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
					  numCL, clPosition);
		}
		numCL = 0;
	    }

	    envPtr->line += adjust;
	    TclCompileScript(interp, tokenPtr->start+1,
		    tokenPtr->size-2, envPtr);
	    envPtr->line -= adjust;
	    numObjsToConcat++;
	    break;

	case TCL_TOKEN_VARIABLE:
	    /*
	     * Push any accumulated chars appearing before the $<var>.
	     */

	    if (Tcl_DStringLength(&textBuffer) > 0) {
		int literal;

		literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
		literal = TclRegisterNewLiteral(envPtr,
			Tcl_DStringValue(&textBuffer),
			Tcl_DStringLength(&textBuffer));
		TclEmitPush(literal, envPtr);
		numObjsToConcat++;
		Tcl_DStringFree(&textBuffer);
	    }

	    /*
	     * Determine how the variable name should be handled: if it
	     * contains any namespace qualifiers it is not a local variable
	     * (localVarName=-1); if it looks like an array element and the
	     * token has a single component, it should not be created here
	     * [Bug 569438] (localVarName=0); otherwise, the local variable
	     * can safely be created (localVarName=1).
	     */

	    name = tokenPtr[1].start;
	    nameBytes = tokenPtr[1].size;
	    localVarName = -1;
	    if (envPtr->procPtr != NULL) {
		localVarName = 1;
		for (i = 0, p = name;  i < nameBytes;  i++, p++) {
		    if ((*p == ':') && (i < nameBytes-1) && (*(p+1) == ':')) {
			localVarName = -1;
			break;
		    } else if ((*p == '(')
			    && (tokenPtr->numComponents == 1)
			    && (*(name + nameBytes - 1) == ')')) {
			localVarName = 0;
			break;
		    }
		}
	    }

	    /*
	     * Either push the variable's name, or find its index in the array
	     * of local variables in a procedure frame.
	     */

	    localVar = -1;
	    if (localVarName != -1) {
		localVar = TclFindCompiledLocal(name, nameBytes, localVarName,
			envPtr->procPtr);
	    }
	    if (localVar < 0) {
		TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
			envPtr);
	    }

	    /*
	     * Emit instructions to load the variable.
	     */

	    if (tokenPtr->numComponents == 1) {
		if (localVar < 0) {
		    TclEmitOpcode(INST_LOAD_SCALAR_STK, envPtr);
		} else if (localVar <= 255) {
		    TclEmitInstInt1(INST_LOAD_SCALAR1, localVar, envPtr);
		} else {
		    TclEmitInstInt4(INST_LOAD_SCALAR4, localVar, envPtr);
		}
	    } else {
	    TclCompileVarSubst(interp, tokenPtr, envPtr);
		TclCompileTokens(interp, tokenPtr+2,
			tokenPtr->numComponents-1, envPtr);
		if (localVar < 0) {
		    TclEmitOpcode(INST_LOAD_ARRAY_STK, envPtr);
		} else if (localVar <= 255) {
		    TclEmitInstInt1(INST_LOAD_ARRAY1, localVar, envPtr);
		} else {
		    TclEmitInstInt4(INST_LOAD_ARRAY4, localVar, envPtr);
		}
	    }
	    numObjsToConcat++;
	    count -= tokenPtr->numComponents;
	    tokenPtr += tokenPtr->numComponents;
	    break;

	default:
	    Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s",
		    tokenPtr->type, (int)tokenPtr->size, tokenPtr->start);
		    tokenPtr->type, tokenPtr->size, tokenPtr->start);
	}
    }

    /*
     * Push any accumulated characters appearing at the end.
     */

    if (Tcl_DStringLength(&textBuffer) > 0) {
	int literal = TclRegisterDStringLiteral(envPtr, &textBuffer);
	int literal;

	literal = TclRegisterNewLiteral(envPtr, Tcl_DStringValue(&textBuffer),
		Tcl_DStringLength(&textBuffer));
	TclEmitPush(literal, envPtr);
	numObjsToConcat++;

	if (numCL) {
	    TclContinuationsEnter(TclFetchLiteral(envPtr, literal),
		    numCL, clPosition);
	    TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
				  numCL, clPosition);
	}
	numCL = 0;
    }

    /*
     * If necessary, concatenate the parts of the word.
     */

    while (numObjsToConcat > 255) {
	TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
	numObjsToConcat -= 254;	/* concat pushes 1 obj, the result */
    }
    if (numObjsToConcat > 1) {
	TclEmitInstInt1(INST_STR_CONCAT1, numObjsToConcat, envPtr);
	TclEmitInstInt1(INST_CONCAT1, numObjsToConcat, envPtr);
    }

    /*
     * If the tokens yielded no instructions, push an empty string.
     */

    if (envPtr->codeNext == entryCodeNext) {
	PushStringLiteral(envPtr, "");
	TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    }
    Tcl_DStringFree(&textBuffer);

    /*
     * Release the temp table we used to collect the locations of continuation
     * lines, if any.
     * Release the temp table we used to collect the locations of
     * continuation lines, if any.
     */

    if (maxNumCL) {
	Tcl_Free(clPosition);
	ckfree ((char*) clPosition);
    }
    TclCheckStackDepth(depth+1, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileCmdWord --
 *
2619
2620
2621
2622
2623
2624
2625
2626

2627
2628
2629
2630
2631
2632
2633
1982
1983
1984
1985
1986
1987
1988

1989
1990
1991
1992
1993
1994
1995
1996







-
+







	/*
	 * Multiple tokens or the single token involves substitutions. Emit
	 * instructions to invoke the eval command procedure at runtime on the
	 * result of evaluating the tokens.
	 */

	TclCompileTokens(interp, tokenPtr, count, envPtr);
	TclEmitInvoke(envPtr, INST_EVAL_STK);
	TclEmitOpcode(INST_EVAL_STK, envPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileExprWords --
2664
2665
2666
2667
2668
2669
2670
2671

2672
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
2709
2710
2711
2712


2713
2714
2715
2716
2717
2718
2719
2720
2721
2722


2723
2724
2725
2726

2727
2728
2729

2730

2731
2732
2733


2734
2735
2736

2737

2738
2739
2740
2741
2742
2743
2744
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







-
+










-
+

-
+

-
+



-
+



-
+
















-
-
+
+









-
+
+




+


-
+

+


-
+
+



+
-
+








    /*
     * If the expression is a single word that doesn't require substitutions,
     * just compile its string into inline instructions.
     */

    if ((numWords == 1) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
	TclCompileExpr(interp, tokenPtr[1].start,tokenPtr[1].size, envPtr, 1);
	TclCompileExpr(interp, tokenPtr[1].start, tokenPtr[1].size, envPtr, 1);
	return;
    }

    /*
     * Emit code to call the expr command proc at runtime. Concatenate the
     * (already substituted once) expr tokens with a space between each.
     */

    wordPtr = tokenPtr;
    for (i = 0;  i < numWords;  i++) {
	CompileTokens(envPtr, wordPtr, interp);
	TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
	if (i < (numWords - 1)) {
	    PushStringLiteral(envPtr, " ");
	    TclEmitPush(TclRegisterNewLiteral(envPtr, " ", 1), envPtr);
	}
	wordPtr += wordPtr->numComponents + 1;
	wordPtr += (wordPtr->numComponents + 1);
    }
    concatItems = 2*numWords - 1;
    while (concatItems > 255) {
	TclEmitInstInt1(INST_STR_CONCAT1, 255, envPtr);
	TclEmitInstInt1(INST_CONCAT1, 255, envPtr);
	concatItems -= 254;
    }
    if (concatItems > 1) {
	TclEmitInstInt1(INST_STR_CONCAT1, concatItems, envPtr);
	TclEmitInstInt1(INST_CONCAT1, concatItems, envPtr);
    }
    TclEmitOpcode(INST_EXPR_STK, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileNoOp --
 *
 *	Function called to compile no-op's
 *
 * Results:
 *	The return value is TCL_OK, indicating successful compilation.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute a no-op at runtime. No
 *	result is pushed onto the stack: the compiler has to take care of this
 *	itself if the last compiled command is a NoOp.
 *      result is pushed onto the stack: the compiler has to take care of this
 *      itself if the last compiled command is a NoOp.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileNoOp(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    TCL_UNUSED(Command *),
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Token *tokenPtr;
    int i;
    int savedStackDepth = envPtr->currStackDepth;

    tokenPtr = parsePtr->tokenPtr;
    for (i = 1; i < parsePtr->numWords; i++) {
    for(i = 1; i < parsePtr->numWords; i++) {
	tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
	envPtr->currStackDepth = savedStackDepth;

	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    CompileTokens(envPtr, tokenPtr, interp);
	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
		    envPtr);
	    TclEmitOpcode(INST_POP, envPtr);
	}
    }
    envPtr->currStackDepth = savedStackDepth;
    PushStringLiteral(envPtr, "");
    TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitByteCodeObj --
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768



2769
2770
2771
2772

2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789

2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800

2801
2802
2803

2804
2805
2806

2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824




2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844

2845
2846
2847
2848
2849
2850

2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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







-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+


-
+


-
+














-
-
-
-
+
+
+
+



















-
+





-
+
-




















-
+




-
+





-
+







-
+










-
+











-
+




+
+
+
+
+
+
+
+
+





-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *	"ownership" (i.e., the pointers to) the Tcl objects and aux data items
 *	will be handed over to the new ByteCode structure from the CompileEnv
 *	structure.
 *
 *----------------------------------------------------------------------
 */

static void
PreventCycle(
    Tcl_Obj *objPtr,
void
TclInitByteCodeObj(
    Tcl_Obj *objPtr,		/* Points object that should be initialized,
    CompileEnv *envPtr)
{
    int i;

				 * and whose string rep contains the source
    for (i = 0;  i < envPtr->literalArrayNext; i++) {
	if (objPtr == TclFetchLiteral(envPtr, i)) {
	    /*
	     * Prevent circular reference where the bytecode intrep of
	     * a value contains a literal which is that same value.
	     * If this is allowed to happen, refcount decrements may not
	     * reach zero, and memory may leak.  Bugs 467523, 3357771
	     *
	     * NOTE:  [Bugs 3392070, 3389764] We make a copy based completely
	     * on the string value, and do not call Tcl_DuplicateObj() so we
             * can be sure we do not have any lingering cycles hiding in
	     * the intrep.
	     */
	    size_t numBytes;
	    const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
	    Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);

				 * code. */
	    Tcl_IncrRefCount(copyPtr);
	    TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);

	    envPtr->literalArrayPtr[i].objPtr = copyPtr;
	}
    }
}

ByteCode *
TclInitByteCode(
    CompileEnv *envPtr)/* Points to the CompileEnv structure from
    register CompileEnv *envPtr)/* Points to the CompileEnv structure from
				 * which to create a ByteCode structure. */
{
    ByteCode *codePtr;
    register ByteCode *codePtr;
    size_t codeBytes, objArrayBytes, exceptArrayBytes, cmdLocBytes;
    size_t auxDataArrayBytes, structureSize;
    unsigned char *p;
    register unsigned char *p;
#ifdef TCL_COMPILE_DEBUG
    unsigned char *nextPtr;
#endif
    int numLitObjects = envPtr->literalArrayNext;
    Namespace *namespacePtr;
    int i, isNew;
    Interp *iPtr;

    if (envPtr->iPtr == NULL) {
	Tcl_Panic("TclInitByteCodeObj() called on uninitialized CompileEnv");
    }

    iPtr = envPtr->iPtr;

    codeBytes = envPtr->codeNext - envPtr->codeStart;
    objArrayBytes = envPtr->literalArrayNext * sizeof(Tcl_Obj *);
    exceptArrayBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange);
    auxDataArrayBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
    codeBytes = (envPtr->codeNext - envPtr->codeStart);
    objArrayBytes = (envPtr->literalArrayNext * sizeof(Tcl_Obj *));
    exceptArrayBytes = (envPtr->exceptArrayNext * sizeof(ExceptionRange));
    auxDataArrayBytes = (envPtr->auxDataArrayNext * sizeof(AuxData));
    cmdLocBytes = GetCmdLocEncodingSize(envPtr);

    /*
     * Compute the total number of bytes needed for this bytecode.
     */

    structureSize = sizeof(ByteCode);
    structureSize += TCL_ALIGN(codeBytes);	  /* align object array */
    structureSize += TCL_ALIGN(objArrayBytes);	  /* align exc range arr */
    structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */
    structureSize += auxDataArrayBytes;
    structureSize += cmdLocBytes;

    if (envPtr->iPtr->varFramePtr != NULL) {
	namespacePtr = envPtr->iPtr->varFramePtr->nsPtr;
    } else {
	namespacePtr = envPtr->iPtr->globalNsPtr;
    }

    p = (unsigned char *)Tcl_Alloc(structureSize);
    p = (unsigned char *) ckalloc((size_t) structureSize);
    codePtr = (ByteCode *) p;
    codePtr->interpHandle = TclHandlePreserve(iPtr->handle);
    codePtr->compileEpoch = iPtr->compileEpoch;
    codePtr->nsPtr = namespacePtr;
    codePtr->nsEpoch = namespacePtr->resolverEpoch;
    codePtr->refCount = 0;
    codePtr->refCount = 1;
    TclPreserveByteCode(codePtr);
    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
    } else {
	codePtr->flags = 0;
    }
    codePtr->source = envPtr->source;
    codePtr->procPtr = envPtr->procPtr;

    codePtr->numCommands = envPtr->numCommands;
    codePtr->numSrcBytes = envPtr->numSrcBytes;
    codePtr->numCodeBytes = codeBytes;
    codePtr->numLitObjects = numLitObjects;
    codePtr->numExceptRanges = envPtr->exceptArrayNext;
    codePtr->numAuxDataItems = envPtr->auxDataArrayNext;
    codePtr->numCmdLocBytes = cmdLocBytes;
    codePtr->maxExceptDepth = envPtr->maxExceptDepth;
    codePtr->maxStackDepth = envPtr->maxStackDepth;

    p += sizeof(ByteCode);
    codePtr->codeStart = p;
    memcpy(p, envPtr->codeStart, codeBytes);
    memcpy(p, envPtr->codeStart, (size_t) codeBytes);

    p += TCL_ALIGN(codeBytes);		/* align object array */
    codePtr->objArrayPtr = (Tcl_Obj **) p;
    for (i = 0;  i < numLitObjects;  i++) {
	codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i);
	codePtr->objArrayPtr[i] = envPtr->literalArrayPtr[i].objPtr;
    }

    p += TCL_ALIGN(objArrayBytes);	/* align exception range array */
    if (exceptArrayBytes > 0) {
	codePtr->exceptArrayPtr = (ExceptionRange *) p;
	memcpy(p, envPtr->exceptArrayPtr, exceptArrayBytes);
	memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes);
    } else {
	codePtr->exceptArrayPtr = NULL;
    }

    p += TCL_ALIGN(exceptArrayBytes);	/* align AuxData array */
    if (auxDataArrayBytes > 0) {
	codePtr->auxDataArrayPtr = (AuxData *) p;
	memcpy(p, envPtr->auxDataArrayPtr, auxDataArrayBytes);
	memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes);
    } else {
	codePtr->auxDataArrayPtr = NULL;
    }

    p += auxDataArrayBytes;
#ifndef TCL_COMPILE_DEBUG
    EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
#else
    nextPtr = EncodeCmdLocMap(envPtr, codePtr, (unsigned char *) p);
    if (((size_t)(nextPtr - p)) != cmdLocBytes) {
	Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %lu != expected size %lu", (unsigned long)(nextPtr - p), (unsigned long)cmdLocBytes);
	Tcl_Panic("TclInitByteCodeObj: encoded cmd location bytes %d != expected size %d", (nextPtr - p), cmdLocBytes);
    }
#endif

    /*
     * Record various compilation-related statistics about the new ByteCode
     * structure. Don't include overhead for statistics-related fields.
     */

#ifdef TCL_COMPILE_STATS
    codePtr->structureSize = structureSize
	    - (sizeof(size_t) + sizeof(Tcl_Time));
    Tcl_GetTime(&codePtr->createTime);
    Tcl_GetTime(&(codePtr->createTime));

    RecordByteCodeStats(codePtr);
#endif /* TCL_COMPILE_STATS */

    /*
     * Free the old internal rep then convert the object to a bytecode object
     * by making its internal rep point to the just compiled ByteCode.
     */

    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = (void *) codePtr;
    objPtr->typePtr = &tclByteCodeType;

    /*
     * TIP #280. Associate the extended per-word line information with the
     * byte code object (internal rep), for use with the bc compiler.
     */

    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, codePtr,
    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->lineBCPtr, (char *) codePtr,
	    &isNew), envPtr->extCmdMapPtr);
    envPtr->extCmdMapPtr = NULL;

    /* We've used up the CompileEnv.  Mark as uninitialized. */
    envPtr->iPtr = NULL;

    codePtr->localCachePtr = NULL;
    return codePtr;
}

ByteCode *
TclInitByteCodeObj(
    Tcl_Obj *objPtr,		/* Points object that should be initialized,
				 * and whose string rep contains the source
				 * code. */
    const Tcl_ObjType *typePtr,
    CompileEnv *envPtr)/* Points to the CompileEnv structure from
				 * which to create a ByteCode structure. */
{
    ByteCode *codePtr;

    PreventCycle(objPtr, envPtr);

    codePtr = TclInitByteCode(envPtr);

    /*
     * Free the old internal rep then convert the object to a bytecode object
     * by making its internal rep point to the just compiled ByteCode.
     */

    ByteCodeSetIntRep(objPtr, typePtr, codePtr);
    return codePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFindCompiledLocal --
 *
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
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
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







-
+


-
-
-
-
+
+
+
+
+

-
+

-
+
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
+













-
+
+
+

















-
+







 *	variable is unknown, or if the name is NULL.
 *
 *----------------------------------------------------------------------
 */

int
TclFindCompiledLocal(
    const char *name,	/* Points to first character of the name of a
    register const char *name,	/* Points to first character of the name of a
				 * scalar or array variable. If NULL, a
				 * temporary var should be created. */
    size_t nameBytes,		/* Number of bytes in the name. */
    int create,			/* If 1, allocate a local frame entry for the
				 * variable if it is new. */
    CompileEnv *envPtr)		/* Points to the current compile environment*/
    int nameBytes,		/* Number of bytes in the name. */
    int create,			/* If non-zero, allocate a local frame entry
				 * for the variable if it is new. */
    register Proc *procPtr)	/* Points to structure describing procedure
				 * containing the variable reference. */
{
    CompiledLocal *localPtr;
    register CompiledLocal *localPtr;
    int localVar = -1;
    int i;
    register int i;
    Proc *procPtr;

    /*
     * If not creating a temporary, does a local variable of the specified
     * name already exist?
     */

    procPtr = envPtr->procPtr;

    if (procPtr == NULL) {
	/*
	 * Compiling a non-body script: give it read access to the LVT in the
	 * current localCache
	 */

	LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
	const char *localName;
	Tcl_Obj **varNamePtr;
	size_t len;

	if (!cachePtr || !name) {
	    return -1;
	}

	varNamePtr = &cachePtr->varName0;
	for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
	    if (*varNamePtr) {
		localName = TclGetStringFromObj(*varNamePtr, &len);
		if ((len == nameBytes) && !strncmp(name, localName, len)) {
		    return i;
		}
	    }
	}
	return -1;
    }

    if (name != NULL) {
	int localCt = procPtr->numCompiledLocals;

	localPtr = procPtr->firstLocalPtr;
	for (i = 0;  i < localCt;  i++) {
	    if (!TclIsVarTemporary(localPtr)) {
		char *localName = localPtr->name;

		if ((nameBytes == localPtr->nameLength) &&
			(strncmp(name,localName,nameBytes) == 0)) {
			(strncmp(name,localName,(unsigned)nameBytes) == 0)) {
		    return i;
		}
	    }
	    localPtr = localPtr->nextPtr;
	}
    }

    /*
     * Create a new variable if appropriate.
     */

    if (create || (name == NULL)) {
	localVar = procPtr->numCompiledLocals;
	localPtr = (CompiledLocal *)Tcl_Alloc(offsetof(CompiledLocal, name) + nameBytes + 1);
	localPtr = (CompiledLocal *) ckalloc((unsigned)
		(sizeof(CompiledLocal) - sizeof(localPtr->name)
		+ nameBytes + 1));
	if (procPtr->firstLocalPtr == NULL) {
	    procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	} else {
	    procPtr->lastLocalPtr->nextPtr = localPtr;
	    procPtr->lastLocalPtr = localPtr;
	}
	localPtr->nextPtr = NULL;
	localPtr->nameLength = nameBytes;
	localPtr->frameIndex = localVar;
	localPtr->flags = 0;
	if (name == NULL) {
	    localPtr->flags |= VAR_TEMPORARY;
	}
	localPtr->defValuePtr = NULL;
	localPtr->resolveInfo = NULL;

	if (name != NULL) {
	    memcpy(localPtr->name, name, nameBytes);
	    memcpy(localPtr->name, name, (size_t) nameBytes);
	}
	localPtr->name[nameBytes] = '\0';
	procPtr->numCompiledLocals++;
    }
    return localVar;
}

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
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







-
+









-
-
+
+


-
+
+


-
-
+
+

-
-
+
-





-
-
+
+







 */

void
TclExpandCodeArray(
    void *envArgPtr)		/* Points to the CompileEnv whose code array
				 * must be enlarged. */
{
    CompileEnv *envPtr = (CompileEnv *)envArgPtr;
    CompileEnv *envPtr = (CompileEnv *) envArgPtr;
				/* The CompileEnv containing the code array to
				 * be doubled in size. */

    /*
     * envPtr->codeNext is equal to envPtr->codeEnd. The currently defined
     * code bytes are stored between envPtr->codeStart and envPtr->codeNext-1
     * [inclusive].
     */

    size_t currBytes = envPtr->codeNext - envPtr->codeStart;
    size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart);
    size_t currBytes = (envPtr->codeNext - envPtr->codeStart);
    size_t newBytes = 2*(envPtr->codeEnd - envPtr->codeStart);

    if (envPtr->mallocedCodeArray) {
	envPtr->codeStart = (unsigned char *)Tcl_Realloc(envPtr->codeStart, newBytes);
	envPtr->codeStart = (unsigned char *)
		ckrealloc((char *)envPtr->codeStart, newBytes);
    } else {
	/*
	 * envPtr->codeStart isn't a Tcl_Alloc'd pointer, so we must code a
	 * Tcl_Realloc equivalent for ourselves.
	 * envPtr->codeStart isn't a ckalloc'd pointer, so we must
	 * code a ckrealloc equivalent for ourselves.
	 */

	unsigned char *newPtr = (unsigned char *)Tcl_Alloc(newBytes);
	unsigned char *newPtr = (unsigned char *) ckalloc((unsigned) newBytes);

	memcpy(newPtr, envPtr->codeStart, currBytes);
	envPtr->codeStart = newPtr;
	envPtr->mallocedCodeArray = 1;
    }

    envPtr->codeNext = envPtr->codeStart + currBytes;
    envPtr->codeEnd = envPtr->codeStart + newBytes;
    envPtr->codeNext = (envPtr->codeStart + currBytes);
    envPtr->codeEnd = (envPtr->codeStart + newBytes);
}

/*
 *----------------------------------------------------------------------
 *
 * EnterCmdStartData --
 *
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
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







-
+




-
+
+


-
-
+
+

-
-
+
-













-
+







	/*
	 * Expand the command location array by allocating more storage from
	 * the heap. The currently allocated CmdLocation entries are stored
	 * from cmdMapPtr[0] up to cmdMapPtr[envPtr->cmdMapEnd] (inclusive).
	 */

	size_t currElems = envPtr->cmdMapEnd;
	size_t newElems = 2 * currElems;
	size_t newElems = 2*currElems;
	size_t currBytes = currElems * sizeof(CmdLocation);
	size_t newBytes = newElems * sizeof(CmdLocation);

	if (envPtr->mallocedCmdMap) {
	    envPtr->cmdMapPtr = (CmdLocation *)Tcl_Realloc(envPtr->cmdMapPtr, newBytes);
	    envPtr->cmdMapPtr = (CmdLocation *)
		    ckrealloc((char *) envPtr->cmdMapPtr, newBytes);
	} else {
	    /*
	     * envPtr->cmdMapPtr isn't a Tcl_Alloc'd pointer, so we must code a
	     * Tcl_Realloc equivalent for ourselves.
	     * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    CmdLocation *newPtr = (CmdLocation *)Tcl_Alloc(newBytes);
	    CmdLocation *newPtr = (CmdLocation *) ckalloc((unsigned) newBytes);

	    memcpy(newPtr, envPtr->cmdMapPtr, currBytes);
	    envPtr->cmdMapPtr = newPtr;
	    envPtr->mallocedCmdMap = 1;
	}
	envPtr->cmdMapEnd = newElems;
    }

    if (cmdIndex > 0) {
	if (codeOffset < envPtr->cmdMapPtr[cmdIndex-1].codeOffset) {
	    Tcl_Panic("EnterCmdStartData: cmd map not sorted by code offset");
	}
    }

    cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
    cmdLocPtr->codeOffset = codeOffset;
    cmdLocPtr->srcOffset = srcOffset;
    cmdLocPtr->numSrcBytes = -1;
    cmdLocPtr->numCodeBytes = -1;
}

/*
3251
3252
3253
3254
3255
3256
3257
3258

3259
3260
3261
3262
3263
3264
3265
2544
2545
2546
2547
2548
2549
2550

2551
2552
2553
2554
2555
2556
2557
2558







-
+







    }

    if (cmdIndex > envPtr->cmdMapEnd) {
	Tcl_Panic("EnterCmdExtentData: missing start data for command %d",
		cmdIndex);
    }

    cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
    cmdLocPtr = &(envPtr->cmdMapPtr[cmdIndex]);
    cmdLocPtr->numSrcBytes = numSrcBytes;
    cmdLocPtr->numCodeBytes = numCodeBytes;
}

/*
 *----------------------------------------------------------------------
 * TIP #280
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
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
2631
2632







+


-
+

-
+



-
+
+












-
+





-
-
+
+

-
+






-
-
-
+
+
+







EnterCmdWordData(
    ExtCmdLoc *eclPtr,		/* Points to the map environment structure in
				 * which to enter command location
				 * information. */
    int srcOffset,		/* Offset of first char of the command. */
    Tcl_Token *tokenPtr,
    const char *cmd,
    int len,
    int numWords,
    int line,
    int *clNext,
    int* clNext,
    int **wlines,
    CompileEnv *envPtr)
    CompileEnv* envPtr)
{
    ECL *ePtr;
    const char *last;
    int wordIdx, wordLine, *wwlines, *wordNext;
    int wordIdx, wordLine, *wwlines;
    int* wordNext;

    if (eclPtr->nuloc >= eclPtr->nloc) {
	/*
	 * Expand the ECL array by allocating more storage from the heap. The
	 * currently allocated ECL entries are stored from eclPtr->loc[0] up
	 * to eclPtr->loc[eclPtr->nuloc-1] (inclusive).
	 */

	size_t currElems = eclPtr->nloc;
	size_t newElems = (currElems ? 2*currElems : 1);
	size_t newBytes = newElems * sizeof(ECL);

	eclPtr->loc = (ECL *)Tcl_Realloc(eclPtr->loc, newBytes);
	eclPtr->loc = (ECL *) ckrealloc((char *)(eclPtr->loc), newBytes);
	eclPtr->nloc = newElems;
    }

    ePtr = &eclPtr->loc[eclPtr->nuloc];
    ePtr->srcOffset = srcOffset;
    ePtr->line = (int *)Tcl_Alloc(numWords * sizeof(int));
    ePtr->next = (int **)Tcl_Alloc(numWords * sizeof(int *));
    ePtr->line = (int *) ckalloc(numWords * sizeof(int));
    ePtr->next = (int**) ckalloc (numWords * sizeof (int*));
    ePtr->nline = numWords;
    wwlines = (int *)Tcl_Alloc(numWords * sizeof(int));
    wwlines = (int *) ckalloc(numWords * sizeof(int));

    last = cmd;
    wordLine = line;
    wordNext = clNext;
    for (wordIdx=0 ; wordIdx<numWords;
	    wordIdx++, tokenPtr += tokenPtr->numComponents + 1) {
	TclAdvanceLines(&wordLine, last, tokenPtr->start);
	TclAdvanceContinuations(&wordLine, &wordNext,
		tokenPtr->start - envPtr->source);
        TclAdvanceLines         (&wordLine, last, tokenPtr->start);
	TclAdvanceContinuations (&wordLine, &wordNext,
				 tokenPtr->start - envPtr->source);
	/* See Ticket 4b61afd660 */
	wwlines[wordIdx] =
		((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
		? wordLine : -1;
	ePtr->line[wordIdx] = wordLine;
	ePtr->next[wordIdx] = wordNext;
	last = tokenPtr->start;
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
2655
2656
2657
2658
2659
2660
2661

2662
2663
2664

2665

2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714







-
+


-
+
-











-


-


-
+
-
-
+
-


-
-
+
+

-
-
+
-
-
+

-

-






-
+







-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *
 *----------------------------------------------------------------------
 */

int
TclCreateExceptRange(
    ExceptionRangeType type,	/* The kind of ExceptionRange desired. */
    CompileEnv *envPtr)/* Points to CompileEnv for which to create a
    register CompileEnv *envPtr)/* Points to CompileEnv for which to create a
				 * new ExceptionRange structure. */
{
    ExceptionRange *rangePtr;
    register ExceptionRange *rangePtr;
    ExceptionAux *auxPtr;
    int index = envPtr->exceptArrayNext;

    if (index >= envPtr->exceptArrayEnd) {
	/*
	 * Expand the ExceptionRange array. The currently allocated entries
	 * are stored between elements 0 and (envPtr->exceptArrayNext - 1)
	 * [inclusive].
	 */

	size_t currBytes =
		envPtr->exceptArrayNext * sizeof(ExceptionRange);
	size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
	int newElems = 2*envPtr->exceptArrayEnd;
	size_t newBytes = newElems * sizeof(ExceptionRange);
	size_t newBytes2 = newElems * sizeof(ExceptionAux);

	if (envPtr->mallocedExceptArray) {
	    envPtr->exceptArrayPtr =
	    envPtr->exceptArrayPtr = (ExceptionRange *)
		    (ExceptionRange *)Tcl_Realloc(envPtr->exceptArrayPtr, newBytes);
	    envPtr->exceptAuxArrayPtr =
		    ckrealloc((char *)(envPtr->exceptArrayPtr), newBytes);
		    (ExceptionAux *)Tcl_Realloc(envPtr->exceptAuxArrayPtr, newBytes2);
	} else {
	    /*
	     * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	     * code a Tcl_Realloc equivalent for ourselves.
	     * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    ExceptionRange *newPtr = (ExceptionRange *)Tcl_Alloc(newBytes);
	    ExceptionRange *newPtr = (ExceptionRange *)
	    ExceptionAux *newPtr2 = (ExceptionAux *)Tcl_Alloc(newBytes2);

		    ckalloc((unsigned) newBytes);
	    memcpy(newPtr, envPtr->exceptArrayPtr, currBytes);
	    memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2);
	    envPtr->exceptArrayPtr = newPtr;
	    envPtr->exceptAuxArrayPtr = newPtr2;
	    envPtr->mallocedExceptArray = 1;
	}
	envPtr->exceptArrayEnd = newElems;
    }
    envPtr->exceptArrayNext++;

    rangePtr = &envPtr->exceptArrayPtr[index];
    rangePtr = &(envPtr->exceptArrayPtr[index]);
    rangePtr->type = type;
    rangePtr->nestingLevel = envPtr->exceptDepth;
    rangePtr->codeOffset = -1;
    rangePtr->numCodeBytes = -1;
    rangePtr->breakOffset = -1;
    rangePtr->continueOffset = -1;
    rangePtr->catchOffset = -1;
    auxPtr = &envPtr->exceptAuxArrayPtr[index];
    auxPtr->supportsContinue = 1;
    auxPtr->stackDepth = envPtr->currStackDepth;
    auxPtr->expandTarget = envPtr->expandCount;
    auxPtr->expandTargetDepth = -1;
    auxPtr->numBreakTargets = 0;
    auxPtr->breakTargets = NULL;
    auxPtr->allocBreakTargets = 0;
    auxPtr->numContinueTargets = 0;
    auxPtr->continueTargets = NULL;
    auxPtr->allocContinueTargets = 0;
    return index;
}

/*
 * ---------------------------------------------------------------------
 *
 * TclGetInnermostExceptionRange --
 *
 *	Returns the innermost exception range that covers the current code
 *	creation point, and (optionally) the stack depth that is expected at
 *	that point. Relies on the fact that the range has a numCodeBytes = -1
 *	when it is being populated and that inner ranges come after outer
 *	ranges.
 *
 * ---------------------------------------------------------------------
 */

ExceptionRange *
TclGetInnermostExceptionRange(
    CompileEnv *envPtr,
    int returnCode,
    ExceptionAux **auxPtrPtr)
{
    int i = envPtr->exceptArrayNext;
    ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i;

    while (i > 0) {
	rangePtr--; i--;

	if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
		(rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
			rangePtr->codeOffset+rangePtr->numCodeBytes) &&
		(returnCode != TCL_CONTINUE ||
			envPtr->exceptAuxArrayPtr[i].supportsContinue)) {

	    if (auxPtrPtr) {
		*auxPtrPtr = envPtr->exceptAuxArrayPtr + i;
	    }
	    return rangePtr;
	}
    }
    return NULL;
}

/*
 * ---------------------------------------------------------------------
 *
 * TclAddLoopBreakFixup, TclAddLoopContinueFixup --
 *
 *	Adds a place that wants to break/continue to the loop exception range
 *	tracking that will be fixed up once the loop can be finalized. These
 *	functions will generate an INST_JUMP4 that will be fixed up during the
 *	loop finalization.
 *
 * ---------------------------------------------------------------------
 */

void
TclAddLoopBreakFixup(
    CompileEnv *envPtr,
    ExceptionAux *auxPtr)
{
    int range = auxPtr - envPtr->exceptAuxArrayPtr;

    if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
	Tcl_Panic("trying to add 'break' fixup to full exception range");
    }

    if (++auxPtr->numBreakTargets > auxPtr->allocBreakTargets) {
	auxPtr->allocBreakTargets *= 2;
	auxPtr->allocBreakTargets += 2;
	if (auxPtr->breakTargets) {
	    auxPtr->breakTargets = (unsigned int *)Tcl_Realloc(auxPtr->breakTargets,
		    sizeof(int) * auxPtr->allocBreakTargets);
	} else {
	    auxPtr->breakTargets =
		    (unsigned int *)Tcl_Alloc(sizeof(int) * auxPtr->allocBreakTargets);
	}
    }
    auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

void
TclAddLoopContinueFixup(
    CompileEnv *envPtr,
    ExceptionAux *auxPtr)
{
    int range = auxPtr - envPtr->exceptAuxArrayPtr;

    if (envPtr->exceptArrayPtr[range].type != LOOP_EXCEPTION_RANGE) {
	Tcl_Panic("trying to add 'continue' fixup to full exception range");
    }

    if (++auxPtr->numContinueTargets > auxPtr->allocContinueTargets) {
	auxPtr->allocContinueTargets *= 2;
	auxPtr->allocContinueTargets += 2;
	if (auxPtr->continueTargets) {
	    auxPtr->continueTargets = (unsigned int *)Tcl_Realloc(auxPtr->continueTargets,
		    sizeof(int) * auxPtr->allocContinueTargets);
	} else {
	    auxPtr->continueTargets =
		    (unsigned int *)Tcl_Alloc(sizeof(int) * auxPtr->allocContinueTargets);
	}
    }
    auxPtr->continueTargets[auxPtr->numContinueTargets - 1] =
	    CurrentOffset(envPtr);
    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
}

/*
 * ---------------------------------------------------------------------
 *
 * TclCleanupStackForBreakContinue --
 *
 *	Ditch the extra elements from the auxiliary stack and the main stack.
 *	How to do this exactly depends on whether there are any elements on
 *	the auxiliary stack to pop.
 *
 * ---------------------------------------------------------------------
 */

void
TclCleanupStackForBreakContinue(
    CompileEnv *envPtr,
    ExceptionAux *auxPtr)
{
    int savedStackDepth = envPtr->currStackDepth;
    int toPop = envPtr->expandCount - auxPtr->expandTarget;

    if (toPop > 0) {
	while (toPop --> 0) {
	    TclEmitOpcode(INST_EXPAND_DROP, envPtr);
	}
	TclAdjustStackDepth(auxPtr->expandTargetDepth - envPtr->currStackDepth,
		envPtr);
	envPtr->currStackDepth = auxPtr->expandTargetDepth;
    }
    toPop = envPtr->currStackDepth - auxPtr->stackDepth;
    while (toPop --> 0) {
	TclEmitOpcode(INST_POP, envPtr);
    }
    envPtr->currStackDepth = savedStackDepth;
}

/*
 * ---------------------------------------------------------------------
 *
 * StartExpanding --
 *
 *	Pushes an INST_EXPAND_START and does some additional housekeeping so
 *	that the [break] and [continue] compilers can use an exception-free
 *	issue to discard it.
 *
 * ---------------------------------------------------------------------
 */

static void
StartExpanding(
    CompileEnv *envPtr)
{
    int i;

    TclEmitOpcode(INST_EXPAND_START, envPtr);

    /*
     * Update inner exception ranges with information about the environment
     * where this expansion started.
     */

    for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];
	ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[i];

	/*
	 * Ignore loops unless they're still being built.
	 */

	if (rangePtr->codeOffset > CurrentOffset(envPtr)) {
	    continue;
	}
	if (rangePtr->numCodeBytes != -1) {
	    continue;
	}

	/*
	 * Adequate condition: further out loops and further in exceptions
	 * don't actually need this information.
	 */

	if (auxPtr->expandTarget == envPtr->expandCount) {
	    auxPtr->expandTargetDepth = envPtr->currStackDepth;
	}
    }

    /*
     * There's now one more expansion being processed on the auxiliary stack.
     */

    envPtr->expandCount++;
}

/*
 * ---------------------------------------------------------------------
 *
 * TclFinalizeLoopExceptionRange --
 *
 *	Finalizes a loop exception range, binding the registered [break] and
 *	[continue] implementations so that they jump to the correct place.
 *	Note that this must only be called after *all* the exception range
 *	target offsets have been set.
 *
 * ---------------------------------------------------------------------
 */

void
TclFinalizeLoopExceptionRange(
    CompileEnv *envPtr,
    int range)
{
    ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[range];
    ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[range];
    int i, offset;
    unsigned char *site;

    if (rangePtr->type != LOOP_EXCEPTION_RANGE) {
	Tcl_Panic("trying to finalize a loop exception range");
    }

    /*
     * Do the jump fixups. Note that these are always issued as INST_JUMP4 so
     * there is no need to fuss around with updating code offsets.
     */

    for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
	site = envPtr->codeStart + auxPtr->breakTargets[i];
	offset = rangePtr->breakOffset - auxPtr->breakTargets[i];
	TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
    }
    for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
	site = envPtr->codeStart + auxPtr->continueTargets[i];
	if (rangePtr->continueOffset == -1) {
	    int j;

	    /*
	     * WTF? Can't bind, so revert to an INST_CONTINUE. Not enough
	     * space to do anything else.
	     */

	    *site = INST_CONTINUE;
	    for (j=0 ; j<4 ; j++) {
		*++site = INST_NOP;
	    }
	} else {
	    offset = rangePtr->continueOffset - auxPtr->continueTargets[i];
	    TclUpdateInstInt4AtPc(INST_JUMP4, offset, site);
	}
    }

    /*
     * Drop the arrays we were holding the only reference to.
     */

    if (auxPtr->breakTargets) {
	Tcl_Free(auxPtr->breakTargets);
	auxPtr->breakTargets = NULL;
	auxPtr->numBreakTargets = 0;
    }
    if (auxPtr->continueTargets) {
	Tcl_Free(auxPtr->continueTargets);
	auxPtr->continueTargets = NULL;
	auxPtr->numContinueTargets = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateAuxData --
 *
 *	Procedure that allocates and initializes a new AuxData structure in a
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
3775
3776
3777
3778
3779
3780
2729
2730
2731
2732
2733
2734
2735

2736
2737

2738
2739
2740
2741


2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757


2758
2759
2760
2761


2762
2763
2764


2765

2766
2767
2768
2769
2770
2771
2772
2773

2774
2775
2776
2777
2778
2779
2780
2781







-
+

-
+



-
-
+
+














-
-
+
+


-
-
+
+

-
-
+
-








-
+







 *----------------------------------------------------------------------
 */

int
TclCreateAuxData(
    ClientData clientData,	/* The compilation auxiliary data to store in
				 * the new aux data record. */
    const AuxDataType *typePtr,	/* Pointer to the type to attach to this
    AuxDataType *typePtr,	/* Pointer to the type to attach to this
				 * AuxData */
    CompileEnv *envPtr)/* Points to the CompileEnv for which a new
    register CompileEnv *envPtr)/* Points to the CompileEnv for which a new
				 * aux data structure is to be allocated. */
{
    int index;			/* Index for the new AuxData structure. */
    AuxData *auxDataPtr;
				/* Points to the new AuxData structure */
    register AuxData *auxDataPtr;
    				/* Points to the new AuxData structure */

    index = envPtr->auxDataArrayNext;
    if (index >= envPtr->auxDataArrayEnd) {
	/*
	 * Expand the AuxData array. The currently allocated entries are
	 * stored between elements 0 and (envPtr->auxDataArrayNext - 1)
	 * [inclusive].
	 */

	size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
	int newElems = 2*envPtr->auxDataArrayEnd;
	size_t newBytes = newElems * sizeof(AuxData);

	if (envPtr->mallocedAuxDataArray) {
	    envPtr->auxDataArrayPtr =
		    (AuxData *)Tcl_Realloc(envPtr->auxDataArrayPtr, newBytes);
	    envPtr->auxDataArrayPtr = (AuxData *)
		    ckrealloc((char *)(envPtr->auxDataArrayPtr), newBytes);
	} else {
	    /*
	     * envPtr->auxDataArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	     * code a Tcl_Realloc equivalent for ourselves.
	     * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must
	     * code a ckrealloc equivalent for ourselves.
	     */

	    AuxData *newPtr = (AuxData *)Tcl_Alloc(newBytes);
	    AuxData *newPtr = (AuxData *) ckalloc((unsigned) newBytes);

	    memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes);
	    envPtr->auxDataArrayPtr = newPtr;
	    envPtr->mallocedAuxDataArray = 1;
	}
	envPtr->auxDataArrayEnd = newElems;
    }
    envPtr->auxDataArrayNext++;

    auxDataPtr = &envPtr->auxDataArrayPtr[index];
    auxDataPtr = &(envPtr->auxDataArrayPtr[index]);
    auxDataPtr->clientData = clientData;
    auxDataPtr->type = typePtr;
    return index;
}

/*
 *----------------------------------------------------------------------
3791
3792
3793
3794
3795
3796
3797
3798

3799
3800
3801
3802
3803
3804

3805
3806
3807
3808
3809
3810
3811
2792
2793
2794
2795
2796
2797
2798

2799
2800
2801
2802
2803
2804

2805
2806
2807
2808
2809
2810
2811
2812







-
+





-
+







 *	The JumpFixupArray structure is initialized.
 *
 *----------------------------------------------------------------------
 */

void
TclInitJumpFixupArray(
    JumpFixupArray *fixupArrayPtr)
    register JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure to
				 * initialize. */
{
    fixupArrayPtr->fixup = fixupArrayPtr->staticFixupSpace;
    fixupArrayPtr->next = 0;
    fixupArrayPtr->end = JUMPFIXUP_INIT_ENTRIES - 1;
    fixupArrayPtr->end = (JUMPFIXUP_INIT_ENTRIES - 1);
    fixupArrayPtr->mallocedArray = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclExpandJumpFixupArray --
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832



3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845


3846
3847
3848
3849


3850
3851
3852

3853
3854
3855
3856
3857
3858
3859
3860
2824
2825
2826
2827
2828
2829
2830



2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845

2846
2847
2848
2849


2850
2851
2852


2853

2854
2855
2856
2857
2858
2859
2860







-
-
-
+
+
+












-
+
+


-
-
+
+

-
-
+
-







 *	array to the new one.
 *
 *----------------------------------------------------------------------
 */

void
TclExpandJumpFixupArray(
    JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure to
				 * enlarge. */
    register JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure
				 * to enlarge. */
{
    /*
     * The currently allocated jump fixup entries are stored from fixup[0] up
     * to fixup[fixupArrayPtr->fixupNext] (*not* inclusive). We assume
     * fixupArrayPtr->fixupNext is equal to fixupArrayPtr->fixupEnd.
     */

    size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
    int newElems = 2*(fixupArrayPtr->end + 1);
    size_t newBytes = newElems * sizeof(JumpFixup);

    if (fixupArrayPtr->mallocedArray) {
	fixupArrayPtr->fixup = (JumpFixup *)Tcl_Realloc(fixupArrayPtr->fixup, newBytes);
	fixupArrayPtr->fixup = (JumpFixup *)
		ckrealloc((char *)(fixupArrayPtr->fixup), newBytes);
    } else {
	/*
	 * fixupArrayPtr->fixup isn't a Tcl_Alloc'd pointer, so we must code a
	 * Tcl_Realloc equivalent for ourselves.
	 * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must
	 * code a ckrealloc equivalent for ourselves.
	 */

	JumpFixup *newPtr = (JumpFixup *)Tcl_Alloc(newBytes);
	JumpFixup *newPtr = (JumpFixup *) ckalloc((unsigned) newBytes);

	memcpy(newPtr, fixupArrayPtr->fixup, currBytes);
	fixupArrayPtr->fixup = newPtr;
	fixupArrayPtr->mallocedArray = 1;
    }
    fixupArrayPtr->end = newElems;
}

3872
3873
3874
3875
3876
3877
3878
3879

3880
3881
3882
3883
3884

3885
3886
3887
3888
3889
3890
3891
2872
2873
2874
2875
2876
2877
2878

2879
2880
2881
2882
2883

2884
2885
2886
2887
2888
2889
2890
2891







-
+




-
+







 *	Allocated storage in the JumpFixupArray structure is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclFreeJumpFixupArray(
    JumpFixupArray *fixupArrayPtr)
    register JumpFixupArray *fixupArrayPtr)
				/* Points to the JumpFixupArray structure to
				 * free. */
{
    if (fixupArrayPtr->mallocedArray) {
	Tcl_Free(fixupArrayPtr->fixup);
	ckfree((char *) fixupArrayPtr->fixup);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclEmitForwardJump --
3922
3923
3924
3925
3926
3927
3928
3929

3930
3931
3932
3933
3934
3935
3936
2922
2923
2924
2925
2926
2927
2928

2929
2930
2931
2932
2933
2934
2935
2936







-
+







     *    - codeOffset is offset of first byte of jump below
     *    - cmdIndex is index of the command after the current one
     *    - exceptIndex is the index of the first ExceptionRange after the
     *	    current one.
     */

    jumpFixupPtr->jumpType = jumpType;
    jumpFixupPtr->codeOffset = envPtr->codeNext - envPtr->codeStart;
    jumpFixupPtr->codeOffset = (envPtr->codeNext - envPtr->codeStart);
    jumpFixupPtr->cmdIndex = envPtr->numCommands;
    jumpFixupPtr->exceptIndex = envPtr->exceptArrayNext;

    switch (jumpType) {
    case TCL_UNCONDITIONAL_JUMP:
	TclEmitInstInt1(INST_JUMP1, 0, envPtr);
	break;
3977
3978
3979
3980
3981
3982
3983
3984

3985
3986
3987

3988
3989
3990
3991
3992
3993
3994
2977
2978
2979
2980
2981
2982
2983

2984
2985
2986

2987
2988
2989
2990
2991
2992
2993
2994







-
+


-
+







				 * describes the forward jump. */
    int jumpDist,		/* Jump distance to set in jump instr. */
    int distThreshold)		/* Maximum distance before the two byte jump
				 * is grown to five bytes. */
{
    unsigned char *jumpPc, *p;
    int firstCmd, lastCmd, firstRange, lastRange, k;
    size_t numBytes;
    unsigned numBytes;

    if (jumpDist <= distThreshold) {
	jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
	jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
	switch (jumpFixupPtr->jumpType) {
	case TCL_UNCONDITIONAL_JUMP:
	    TclUpdateInstInt1AtPc(INST_JUMP1, jumpDist, jumpPc);
	    break;
	case TCL_TRUE_JUMP:
	    TclUpdateInstInt1AtPc(INST_JUMP_TRUE1, jumpDist, jumpPc);
	    break;
4005
4006
4007
4008
4009
4010
4011
4012

4013
4014
4015
4016
4017
4018
4019
3005
3006
3007
3008
3009
3010
3011

3012
3013
3014
3015
3016
3017
3018
3019







-
+







     * change; be careful about updating any of these addresses held in
     * variables.
     */

    if ((envPtr->codeNext + 3) > envPtr->codeEnd) {
	TclExpandCodeArray(envPtr);
    }
    jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
    jumpPc = (envPtr->codeStart + jumpFixupPtr->codeOffset);
    numBytes = envPtr->codeNext-jumpPc-2;
    p = jumpPc+2;
    memmove(p+3, p, numBytes);

    envPtr->codeNext += 3;
    jumpDist += 3;
    switch (jumpFixupPtr->jumpType) {
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
3030
3031
3032
3033
3034
3035
3036

3037
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







-
+


-
+




-
+

-
+
-

+
















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-

-
+
-
-
-
+
+
-
-
-
-
+

+
-
-
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+

-
+
-
-
+
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
-


-
-
-
+
-
-
-
-
-
+
-
-
+


-
-
-
+
-
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-








    /*
     * Adjust the code offsets for any commands and any ExceptionRange records
     * between the jump and the current code address.
     */

    firstCmd = jumpFixupPtr->cmdIndex;
    lastCmd = envPtr->numCommands - 1;
    lastCmd = (envPtr->numCommands - 1);
    if (firstCmd < lastCmd) {
	for (k = firstCmd;  k <= lastCmd;  k++) {
	    envPtr->cmdMapPtr[k].codeOffset += 3;
	    (envPtr->cmdMapPtr[k]).codeOffset += 3;
	}
    }

    firstRange = jumpFixupPtr->exceptIndex;
    lastRange = envPtr->exceptArrayNext - 1;
    lastRange = (envPtr->exceptArrayNext - 1);
    for (k = firstRange;  k <= lastRange;  k++) {
	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[k];
	ExceptionRange *rangePtr = &(envPtr->exceptArrayPtr[k]);

	rangePtr->codeOffset += 3;

	switch (rangePtr->type) {
	case LOOP_EXCEPTION_RANGE:
	    rangePtr->breakOffset += 3;
	    if (rangePtr->continueOffset != -1) {
		rangePtr->continueOffset += 3;
	    }
	    break;
	case CATCH_EXCEPTION_RANGE:
	    rangePtr->catchOffset += 3;
	    break;
	default:
	    Tcl_Panic("TclFixupForwardJump: bad ExceptionRange type %d",
		    rangePtr->type);
	}
    }

    for (k = 0 ; k < envPtr->exceptArrayNext ; k++) {
	ExceptionAux *auxPtr = &envPtr->exceptAuxArrayPtr[k];
	int i;

	for (i=0 ; i<auxPtr->numBreakTargets ; i++) {
	    if (jumpFixupPtr->codeOffset < auxPtr->breakTargets[i]) {
		auxPtr->breakTargets[i] += 3;
	    }
	}
	for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
	    if (jumpFixupPtr->codeOffset < auxPtr->continueTargets[i]) {
		auxPtr->continueTargets[i] += 3;
	    }
	}
    }

    return 1;			/* the jump was grown */
}

/*
    /*
 *----------------------------------------------------------------------
 *
 * TclEmitInvoke --
 *
 *	Emit one of the invoke-related instructions, wrapping it if necessary
 *	in code that ensures that any break or continue operation passing
     * TIP #280: Adjust the mapping from PC values to the per-command
     * information about arguments and their line numbers.
 *	through it gets the stack unwinding correct, converting it into an
 *	internal jump if in an appropriate context.
 *
 * Results:
     *
     * Note: We cannot simply remove an out-of-date entry and then reinsert
     * with the proper PC, because then we might overwrite another entry which
     * was at that location. Therefore we pull (copy + delete) all effected
     * entries (beyond the fixed PC) into an array, update them there, and at
     * last reinsert them all.
 *	None
 *
     */
 * Side effects:
 *	Issues the jump with all correct stack management. May create another
 *	loop exception range; pointers to ExceptionRange and ExceptionAux
 *	structures should not be held across this call.
 *

 *----------------------------------------------------------------------
 */

    {
void
TclEmitInvoke(
    CompileEnv *envPtr,
	ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
    int opcode,
    ...)
{

    va_list argList;
    ExceptionRange *rangePtr;
	/* A helper structure */
    ExceptionAux *auxBreakPtr, *auxContinuePtr;
    int arg1, arg2, wordCount = 0, expandCount = 0;
    int loopRange = 0, breakRange = 0, continueRange = 0;
    int cleanup, depth = TclGetStackDepth(envPtr);

    /*
     * Parse the arguments.
     */

	typedef struct {
    va_start(argList, opcode);
    switch (opcode) {
    case INST_INVOKE_STK1:
	wordCount = arg1 = cleanup = va_arg(argList, int);
	arg2 = 0;
	break;
    case INST_INVOKE_STK4:
	wordCount = arg1 = cleanup = va_arg(argList, int);
	arg2 = 0;
	break;
    case INST_INVOKE_REPLACE:
	arg1 = va_arg(argList, int);
	arg2 = va_arg(argList, int);
	wordCount = arg1 + arg2 - 1;
	cleanup = arg1 + 1;
	break;
    default:
	Tcl_Panic("unexpected opcode");
    case INST_EVAL_STK:
	wordCount = cleanup = 1;
	    int pc;
	arg1 = arg2 = 0;
	break;
    case INST_RETURN_STK:
	wordCount = cleanup = 2;
	arg1 = arg2 = 0;
	break;
    case INST_INVOKE_EXPANDED:
	wordCount = arg1 = cleanup = va_arg(argList, int);
	arg2 = 0;
	expandCount = 1;
	    int cmd;
	break;
    }
	} MAP;
    va_end(argList);

    /*
	/*
     * Determine if we need to handle break and continue exceptions with a
     * special handling exception range (so that we can correctly unwind the
     * stack).
	 * And the helper array. At most the whole hashtable is placed into
	 * this.
     *
     * These must be done separately; they can be different (especially for
     * calls from inside a [for] increment clause).
     */
	 */

	MAP *map = (MAP*) ckalloc (sizeof(MAP) * eclPtr->litInfo.numEntries);
    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
	    &auxContinuePtr);

	Tcl_HashSearch hSearch;
	Tcl_HashEntry* hPtr;
    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
	auxContinuePtr = NULL;
	int n, k, isnew;
    } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
	    && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) {
	auxContinuePtr = NULL;
    } else {
	continueRange = auxContinuePtr - envPtr->exceptAuxArrayPtr;
    }

	/*
	 * Phase I: Locate the affected entries, and save them in adjusted
	 * form to the array. This removes them from the hash.
	 */

    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
	for (n = 0, hPtr = Tcl_FirstHashEntry(&eclPtr->litInfo, &hSearch);
    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
	auxBreakPtr = NULL;
	     hPtr != NULL;
    } else if (auxContinuePtr == NULL
	    && auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
	    && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
	auxBreakPtr = NULL;
	     hPtr = Tcl_NextHashEntry(&hSearch)) {
    } else {
	breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
    }


	    map [n].cmd = PTR2INT(Tcl_GetHashValue(hPtr));
    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
	loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
	ExceptionRangeStarts(envPtr, loopRange);
    }

	    map [n].pc  = PTR2INT(Tcl_GetHashKey (&eclPtr->litInfo,hPtr));

	    if (map[n].pc >= (jumpFixupPtr->codeOffset + 2)) {
    /*
     * Issue the invoke itself.
     */

    switch (opcode) {
		Tcl_DeleteHashEntry(hPtr);
		map [n].pc += 3;
    case INST_INVOKE_STK1:
	TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr);
	break;
    case INST_INVOKE_STK4:
	TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr);
	break;
    case INST_INVOKE_EXPANDED:
	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
	envPtr->expandCount--;
	TclAdjustStackDepth(1 - arg1, envPtr);
	break;
    case INST_EVAL_STK:
	TclEmitOpcode(INST_EVAL_STK, envPtr);
	break;
    case INST_RETURN_STK:
	TclEmitOpcode(INST_RETURN_STK, envPtr);
	break;
    case INST_INVOKE_REPLACE:
	TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
	TclEmitInt1(arg2, envPtr);
	TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
	break;
    }

		n++;
	    }
	}
    /*
     * If we're generating a special wrapper exception range, we need to
     * finish that up now.
     */

    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
	int savedStackDepth = envPtr->currStackDepth;
	int savedExpandCount = envPtr->expandCount;
	JumpFixup nonTrapFixup;

	if (auxBreakPtr != NULL) {
	    auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange;
	}
	if (auxContinuePtr != NULL) {
	    auxContinuePtr = envPtr->exceptAuxArrayPtr + continueRange;
	}

	ExceptionRangeEnds(envPtr, loopRange);
	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &nonTrapFixup);

	/*
	 * Careful! When generating these stack unwinding sequences, the depth
	 * of stack in the cases where they are taken is not the same as if
	 * Phase II: Re-insert the modified entries into the hash.
	 * the exception is not taken.
	 */

	if (auxBreakPtr != NULL) {
	    TclAdjustStackDepth(-1, envPtr);

	for (k=0;k<n;k++) {
	    ExceptionRangeTarget(envPtr, loopRange, breakOffset);
	    TclCleanupStackForBreakContinue(envPtr, auxBreakPtr);
	    TclAddLoopBreakFixup(envPtr, auxBreakPtr);
	    TclAdjustStackDepth(1, envPtr);

	    hPtr = Tcl_CreateHashEntry(&eclPtr->litInfo, INT2PTR(map[k].pc), &isnew);
	    envPtr->currStackDepth = savedStackDepth;
	    envPtr->expandCount = savedExpandCount;
	    Tcl_SetHashValue(hPtr, INT2PTR(map[k].cmd));
	}

	if (auxContinuePtr != NULL) {
	    TclAdjustStackDepth(-1, envPtr);

	ckfree ((char *) map);
	    ExceptionRangeTarget(envPtr, loopRange, continueOffset);
	    TclCleanupStackForBreakContinue(envPtr, auxContinuePtr);
	    TclAddLoopContinueFixup(envPtr, auxContinuePtr);
	    TclAdjustStackDepth(1, envPtr);

    }
	    envPtr->currStackDepth = savedStackDepth;
	    envPtr->expandCount = savedExpandCount;
	}


    return 1;			/* the jump was grown */
	TclFinalizeLoopExceptionRange(envPtr, loopRange);
	TclFixupForwardJumpToHere(envPtr, &nonTrapFixup, 127);
    }
    TclCheckStackDepth(depth+1-cleanup, envPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetInstructionTable --
 *
4290
4291
4292
4293
4294
4295
4296
4297

4298
4299
4300
4301






























































































































































4302
4303
4304
4305
4306
4307
4308
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







-
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const void * /* == InstructionDesc* == */
void * /* == InstructionDesc* == */
TclGetInstructionTable(void)
{
    return &tclInstructionTable[0];
}

/*
 *--------------------------------------------------------------
 *
 * RegisterAuxDataType --
 *
 *	This procedure is called to register a new AuxData type in the table
 *	of all AuxData types supported by Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The type is registered in the AuxData type table. If there was already
 *	a type with the same name as in typePtr, it is replaced with the new
 *	type.
 *
 *--------------------------------------------------------------
 */

static void
RegisterAuxDataType(
    AuxDataType *typePtr)	/* Information about object type; storage must
				 * be statically allocated (must live forever;
				 * will not be deallocated). */
{
    register Tcl_HashEntry *hPtr;
    int isNew;

    Tcl_MutexLock(&tableMutex);
    if (!auxDataTypeTableInitialized) {
	TclInitAuxDataTypeTable();
    }

    /*
     * If there's already a type with the given name, remove it.
     */

    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typePtr->name);
    if (hPtr != NULL) {
	Tcl_DeleteHashEntry(hPtr);
    }

    /*
     * Now insert the new object type.
     */

    hPtr = Tcl_CreateHashEntry(&auxDataTypeTable, typePtr->name, &isNew);
    if (isNew) {
	Tcl_SetHashValue(hPtr, typePtr);
    }
    Tcl_MutexUnlock(&tableMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetAuxDataType --
 *
 *	This procedure looks up an Auxdata type by name.
 *
 * Results:
 *	If an AuxData type with name matching "typeName" is found, a pointer
 *	to its AuxDataType structure is returned; otherwise, NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

AuxDataType *
TclGetAuxDataType(
    char *typeName)		/* Name of AuxData type to look up. */
{
    register Tcl_HashEntry *hPtr;
    AuxDataType *typePtr = NULL;

    Tcl_MutexLock(&tableMutex);
    if (!auxDataTypeTableInitialized) {
	TclInitAuxDataTypeTable();
    }

    hPtr = Tcl_FindHashEntry(&auxDataTypeTable, typeName);
    if (hPtr != NULL) {
	typePtr = (AuxDataType *) Tcl_GetHashValue(hPtr);
    }
    Tcl_MutexUnlock(&tableMutex);

    return typePtr;
}

/*
 *--------------------------------------------------------------
 *
 * TclInitAuxDataTypeTable --
 *
 *	This procedure is invoked to perform once-only initialization of the
 *	AuxData type table. It also registers the AuxData types defined in
 *	this file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Initializes the table of defined AuxData types "auxDataTypeTable" with
 *	builtin AuxData types defined in this file.
 *
 *--------------------------------------------------------------
 */

void
TclInitAuxDataTypeTable(void)
{
    /*
     * The table mutex must already be held before this routine is invoked.
     */

    auxDataTypeTableInitialized = 1;
    Tcl_InitHashTable(&auxDataTypeTable, TCL_STRING_KEYS);

    /*
     * There are only two AuxData type at this time, so register them here.
     */

    RegisterAuxDataType(&tclForeachInfoType);
    RegisterAuxDataType(&tclJumptableInfoType);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeAuxDataTypeTable --
 *
 *	This procedure is called by Tcl_Finalize after all exit handlers have
 *	been run to free up storage associated with the table of AuxData
 *	types. This procedure is called by TclFinalizeExecution() which is
 *	called by Tcl_Finalize().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes all entries in the hash table of AuxData types.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeAuxDataTypeTable(void)
{
    Tcl_MutexLock(&tableMutex);
    if (auxDataTypeTableInitialized) {
	Tcl_DeleteHashTable(&auxDataTypeTable);
	auxDataTypeTableInitialized = 0;
    }
    Tcl_MutexUnlock(&tableMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * GetCmdLocEncodingSize --
 *
 *	Computes the total number of bytes needed to encode the command
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
4346
4347
4348
4349
4350
4351
4352
4353
4354

4355
4356
4357
4358


4359
4360
4361

4362
4363
4364
4365
4366
4367
4368
4369
4370
4371

4372
4373
4374
4375
4376
4377
4378
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







-
+











-
+





-
+









-
+


-
-
+
+


-
+









-
+








static int
GetCmdLocEncodingSize(
    CompileEnv *envPtr)		/* Points to compilation environment structure
				 * containing the CmdLocation structure to
				 * encode. */
{
    CmdLocation *mapPtr = envPtr->cmdMapPtr;
    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
    int numCmds = envPtr->numCommands;
    int codeDelta, codeLen, srcDelta, srcLen;
    int codeDeltaNext, codeLengthNext, srcDeltaNext, srcLengthNext;
				/* The offsets in their respective byte
				 * sequences where the next encoded offset or
				 * length should go. */
    int prevCodeOffset, prevSrcOffset, i;

    codeDeltaNext = codeLengthNext = srcDeltaNext = srcLengthNext = 0;
    prevCodeOffset = prevSrcOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	codeDelta = mapPtr[i].codeOffset - prevCodeOffset;
	codeDelta = (mapPtr[i].codeOffset - prevCodeOffset);
	if (codeDelta < 0) {
	    Tcl_Panic("GetCmdLocEncodingSize: bad code offset");
	} else if (codeDelta <= 127) {
	    codeDeltaNext++;
	} else {
	    codeDeltaNext += 5;	/* 1 byte for 0xFF, 4 for positive delta */
	    codeDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for positive delta */
	}
	prevCodeOffset = mapPtr[i].codeOffset;

	codeLen = mapPtr[i].numCodeBytes;
	if (codeLen < 0) {
	    Tcl_Panic("GetCmdLocEncodingSize: bad code length");
	} else if (codeLen <= 127) {
	    codeLengthNext++;
	} else {
	    codeLengthNext += 5;/* 1 byte for 0xFF, 4 for length */
	    codeLengthNext += 5; /* 1 byte for 0xFF, 4 for length */
	}

	srcDelta = mapPtr[i].srcOffset - prevSrcOffset;
	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
	srcDelta = (mapPtr[i].srcOffset - prevSrcOffset);
	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
	    srcDeltaNext++;
	} else {
	    srcDeltaNext += 5;	/* 1 byte for 0xFF, 4 for delta */
	    srcDeltaNext += 5;	 /* 1 byte for 0xFF, 4 for delta */
	}
	prevSrcOffset = mapPtr[i].srcOffset;

	srcLen = mapPtr[i].numSrcBytes;
	if (srcLen < 0) {
	    Tcl_Panic("GetCmdLocEncodingSize: bad source length");
	} else if (srcLen <= 127) {
	    srcLengthNext++;
	} else {
	    srcLengthNext += 5;	/* 1 byte for 0xFF, 4 for length */
	    srcLengthNext += 5;	 /* 1 byte for 0xFF, 4 for length */
	}
    }

    return (codeDeltaNext + codeLengthNext + srcDeltaNext + srcLengthNext);
}

/*
4403
4404
4405
4406
4407
4408
4409
4410

4411
4412

4413
4414

4415
4416
4417
4418
4419
4420
4421
4422
4423

4424
4425
4426
4427
4428
4429
4430
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







-
+

-
+

-
+








-
+







				 * encode. */
    ByteCode *codePtr,		/* ByteCode in which to encode envPtr's
				 * command location information. */
    unsigned char *startPtr)	/* Points to the first byte in codePtr's
				 * memory block where the location information
				 * is to be stored. */
{
    CmdLocation *mapPtr = envPtr->cmdMapPtr;
    register CmdLocation *mapPtr = envPtr->cmdMapPtr;
    int numCmds = envPtr->numCommands;
    unsigned char *p = startPtr;
    register unsigned char *p = startPtr;
    int codeDelta, codeLen, srcDelta, srcLen, prevOffset;
    int i;
    register int i;

    /*
     * Encode the code offset for each command as a sequence of deltas.
     */

    codePtr->codeDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	codeDelta = mapPtr[i].codeOffset - prevOffset;
	codeDelta = (mapPtr[i].codeOffset - prevOffset);
	if (codeDelta < 0) {
	    Tcl_Panic("EncodeCmdLocMap: bad code offset");
	} else if (codeDelta <= 127) {
	    TclStoreInt1AtPtr(codeDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
4458
4459
4460
4461
4462
4463
4464
4465
4466


4467
4468
4469
4470
4471
4472
4473
3470
3471
3472
3473
3474
3475
3476


3477
3478
3479
3480
3481
3482
3483
3484
3485







-
-
+
+







    /*
     * Encode the source offset for each command as a sequence of deltas.
     */

    codePtr->srcDeltaStart = p;
    prevOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	srcDelta = mapPtr[i].srcOffset - prevOffset;
	if ((-127 <= srcDelta) && (srcDelta <= 127) && (srcDelta != -1)) {
	srcDelta = (mapPtr[i].srcOffset - prevOffset);
	if ((-127 <= srcDelta) && (srcDelta <= 127)) {
	    TclStoreInt1AtPtr(srcDelta, p);
	    p++;
	} else {
	    TclStoreInt1AtPtr(0xFF, p);
	    p++;
	    TclStoreInt4AtPtr(srcDelta, p);
	    p += 4;
4493
4494
4495
4496
4497
4498
4499




















































































































































































































































































































































































































































































































































































































4500
4501
4502
4503
4504
4505
4506
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    TclStoreInt4AtPtr(srcLen, p);
	    p += 4;
	}
    }

    return p;
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
 * TclPrintByteCodeObj --
 *
 *	This procedure prints ("disassembles") the instructions of a bytecode
 *	object to stdout.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintByteCodeObj(
    Tcl_Interp *interp,		/* Used only for Tcl_GetStringFromObj. */
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);

    fprintf(stdout, "\n%s", TclGetString(bufPtr));
    Tcl_DecrRefCount(bufPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintInstruction --
 *
 *	This procedure prints ("disassembles") one instruction from a bytecode
 *	object to stdout.
 *
 * Results:
 *	Returns the length in bytes of the current instruiction.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclPrintInstruction(
    ByteCode *codePtr,		/* Bytecode containing the instruction. */
    unsigned char *pc)		/* Points to first byte of instruction. */
{
    Tcl_Obj *bufferObj;
    int numBytes;

    TclNewObj(bufferObj);
    numBytes = FormatInstruction(codePtr, pc, bufferObj);
    fprintf(stdout, "%s", TclGetString(bufferObj));
    Tcl_DecrRefCount(bufferObj);
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintObject --
 *
 *	This procedure prints up to a specified number of characters from the
 *	argument Tcl object's string representation to a specified file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Outputs characters to the specified file.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintObject(
    FILE *outFile,		/* The file to print the source to. */
    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    int maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    int length;

    bytes = Tcl_GetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
 *
 *	This procedure prints up to a specified number of characters from the
 *	argument string to a specified file. It tries to produce legible
 *	output by adding backslashes as necessary.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Outputs characters to the specified file.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintSource(
    FILE *outFile,		/* The file to print the source to. */
    const char *stringPtr,	/* The string to print. */
    int maxChars)		/* Maximum number of chars to print. */
{
    Tcl_Obj *bufferObj;

    TclNewObj(bufferObj);
    PrintSourceToObj(bufferObj, stringPtr, maxChars);
    fprintf(outFile, "%s", TclGetString(bufferObj));
    Tcl_DecrRefCount(bufferObj);
}
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclDisassembleByteCodeObj --
 *
 *	Given an object which is of bytecode type, return a disassembled
 *	version of the bytecode (in a new refcount 0 object). No guarantees
 *	are made about the details of the contents of the result.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDisassembleByteCodeObj(
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
    unsigned char *codeStart, *codeLimit, *pc;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
    Interp *iPtr = (Interp *) *codePtr->interpHandle;
    Tcl_Obj *bufferObj;
    char ptrBuf1[20], ptrBuf2[20];

    TclNewObj(bufferObj);
    if (codePtr->refCount <= 0) {
	return bufferObj;	/* Already freed. */
    }

    codeStart = codePtr->codeStart;
    codeLimit = (codeStart + codePtr->numCodeBytes);
    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    sprintf(ptrBuf1, "%p", codePtr);
    sprintf(ptrBuf2, "%p", iPtr);
    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
	    ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
	    iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    Tcl_AppendPrintfToObj(bufferObj,
	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
	    codePtr->numLitObjects, codePtr->numAuxDataItems,
	    codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
	    (unsigned long) codePtr->structureSize,
	    (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
	    codePtr->numCodeBytes,
	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */

    /*
     * If the ByteCode is the compiled body of a Tcl procedure, print
     * information about that procedure. Note that we don't know the
     * procedure's name since ByteCode's can be shared among procedures.
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	sprintf(ptrBuf1, "%p", procPtr);
	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
		ptrBuf1, procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
			"      slot %d%s%s%s%s%s%s", i,
			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
			(localPtr->flags & VAR_LINK) ? ", link" : "",
			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
		if (TclIsVarTemporary(localPtr)) {
		    Tcl_AppendToObj(bufferObj, "\n", -1);
		} else {
		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
			    localPtr->name);
		}
		localPtr = localPtr->nextPtr;
	    }
	}
    }

    /*
     * Print the ExceptionRange array.
     */

    if (codePtr->numExceptRanges > 0) {
	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
		codePtr->numExceptRanges, codePtr->maxExceptDepth);
	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
	    ExceptionRange *rangePtr = &(codePtr->exceptArrayPtr[i]);

	    Tcl_AppendPrintfToObj(bufferObj,
		    "      %d: level %d, %s, pc %d-%d, ",
		    i, rangePtr->nestingLevel,
		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
		    rangePtr->codeOffset,
		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
	    switch (rangePtr->type) {
	    case LOOP_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
			rangePtr->continueOffset, rangePtr->breakOffset);
		break;
	    case CATCH_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
			rangePtr->catchOffset);
		break;
	    default:
		Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
			rangePtr->type);
	    }
	}
    }

    /*
     * If there were no commands (e.g., an expression or an empty string was
     * compiled), just print all instructions and return.
     */

    if (numCmds == 0) {
	pc = codeStart;
	while (pc < codeLimit) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}
	return bufferObj;
    }

    /*
     * Print table showing the code offset, source offset, and source length
     * for each command. These are encoded as a sequence of bytes.
     */

    Tcl_AppendPrintfToObj(bufferObj, "  Commands %d:", numCmds);
    codeDeltaNext = codePtr->codeDeltaStart;
    codeLengthNext = codePtr->codeLengthStart;
    srcDeltaNext = codePtr->srcDeltaStart;
    srcLengthNext = codePtr->srcLengthStart;
    codeOffset = srcOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
	    codeDeltaNext++;
	    delta = TclGetInt4AtPtr(codeDeltaNext);
	    codeDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(codeDeltaNext);
	    codeDeltaNext++;
	}
	codeOffset += delta;

	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
	    codeLengthNext++;
	    codeLen = TclGetInt4AtPtr(codeLengthNext);
	    codeLengthNext += 4;
	} else {
	    codeLen = TclGetInt1AtPtr(codeLengthNext);
	    codeLengthNext++;
	}

	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
	    srcDeltaNext++;
	    delta = TclGetInt4AtPtr(srcDeltaNext);
	    srcDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(srcDeltaNext);
	    srcDeltaNext++;
	}
	srcOffset += delta;

	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
	    srcLengthNext++;
	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}

	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
		((i % 2)? "   	" : "\n   "),
		(i+1), codeOffset, (codeOffset + codeLen - 1),
		srcOffset, (srcOffset + srcLen - 1));
    }
    if (numCmds > 0) {
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }

    /*
     * Print each instruction. If the instruction corresponds to the start of
     * a command, print the command's source. Note that we don't need the code
     * length here.
     */

    codeDeltaNext = codePtr->codeDeltaStart;
    srcDeltaNext = codePtr->srcDeltaStart;
    srcLengthNext = codePtr->srcLengthStart;
    codeOffset = srcOffset = 0;
    pc = codeStart;
    for (i = 0;  i < numCmds;  i++) {
	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
	    codeDeltaNext++;
	    delta = TclGetInt4AtPtr(codeDeltaNext);
	    codeDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(codeDeltaNext);
	    codeDeltaNext++;
	}
	codeOffset += delta;

	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
	    srcDeltaNext++;
	    delta = TclGetInt4AtPtr(srcDeltaNext);
	    srcDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(srcDeltaNext);
	    srcDeltaNext++;
	}
	srcOffset += delta;

	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
	    srcLengthNext++;
	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}

	/*
	 * Print instructions before command i.
	 */

	while ((pc-codeStart) < codeOffset) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}

	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
		TclMin(srcLen, 55));
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }
    if (pc < codeLimit) {
	/*
	 * Print instructions after the last command.
	 */

	while (pc < codeLimit) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}
    }
    return bufferObj;
}

/*
 *----------------------------------------------------------------------
 *
 * FormatInstruction --
 *
 *	Appends a representation of a bytecode instruction to a Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

static int
FormatInstruction(
    ByteCode *codePtr,		/* Bytecode containing the instruction. */
    unsigned char *pc,		/* Points to first byte of instruction. */
    Tcl_Obj *bufferObj)		/* Object to append instruction info to. */
{
    Proc *procPtr = codePtr->procPtr;
    unsigned char opCode = *pc;
    register InstructionDesc *instDesc = &tclInstructionTable[opCode];
    unsigned char *codeStart = codePtr->codeStart;
    unsigned pcOffset = pc - codeStart;
    int opnd = 0, i, j, numBytes = 1;
    int localCt = procPtr ? procPtr->numCompiledLocals : 0;
    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
    char suffixBuffer[128];	/* Additional info to print after main opcode
				 * and immediates. */
    char *suffixSrc = NULL;
    Tcl_Obj *suffixObj = NULL;
    AuxData *auxPtr = NULL;

    suffixBuffer[0] = '\0';
    Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
    for (i = 0;  i < instDesc->numOperands;  i++) {
	switch (instDesc->opTypes[i]) {
	case OPERAND_INT1:
	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
	    if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
		    || opCode == INST_JUMP_FALSE1) {
		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_INT4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
		    || opCode == INST_JUMP_FALSE4) {
		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
	    } else if (opCode == INST_START_CMD) {
		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_UINT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    if (opCode == INST_PUSH1) {
		suffixObj = codePtr->objArrayPtr[opnd];
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
	    break;
	case OPERAND_AUX4:
	case OPERAND_UINT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_PUSH4) {
		suffixObj = codePtr->objArrayPtr[opnd];
	    } else if (opCode == INST_START_CMD && opnd != 1) {
		sprintf(suffixBuffer+strlen(suffixBuffer),
			", %u cmds start here", opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
	    if (instDesc->opTypes[i] == OPERAND_AUX4) {
		auxPtr = &codePtr->auxDataArrayPtr[opnd];
	    }
	    break;
	case OPERAND_IDX4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opnd >= -1) {
		Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
	    } else if (opnd == -2) {
		Tcl_AppendPrintfToObj(bufferObj, "end ");
	    } else {
		Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
	    }
	    break;
	case OPERAND_LVT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    goto printLVTindex;
	case OPERAND_LVT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	printLVTindex:
	    if (localPtr != NULL) {
		if (opnd >= localCt) {
		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
			    (unsigned) opnd, localCt);
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
		} else {
		    sprintf(suffixBuffer, "var ");
		    suffixSrc = localPtr->name;
		}
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
	    break;
	case OPERAND_NONE:
	default:
	    break;
	}
    }
    if (suffixObj) {
	char *bytes;
	int length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }
    Tcl_AppendToObj(bufferObj, "\n", -1);
    if (auxPtr && auxPtr->type->printProc) {
	Tcl_AppendToObj(bufferObj, "\t\t[", -1);
	auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
		pcOffset);
	Tcl_AppendToObj(bufferObj, "]\n", -1);
    }
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * PrintSourceToObj --
 *
 *	Appends a quoted representation of a string to a Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

static void
PrintSourceToObj(
    Tcl_Obj *appendObj,		/* The object to print the source to. */
    const char *stringPtr,	/* The string to print. */
    int maxChars)		/* Maximum number of chars to print. */
{
    register const char *p;
    register int i = 0;

    if (stringPtr == NULL) {
	Tcl_AppendToObj(appendObj, "\"\"", -1);
	return;
    }

    Tcl_AppendToObj(appendObj, "\"", -1);
    p = stringPtr;
    for (;  (*p != '\0') && (i < maxChars);  p++, i++) {
	switch (*p) {
	case '"':
	    Tcl_AppendToObj(appendObj, "\\\"", -1);
	    continue;
	case '\f':
	    Tcl_AppendToObj(appendObj, "\\f", -1);
	    continue;
	case '\n':
	    Tcl_AppendToObj(appendObj, "\\n", -1);
	    continue;
	case '\r':
	    Tcl_AppendToObj(appendObj, "\\r", -1);
	    continue;
	case '\t':
	    Tcl_AppendToObj(appendObj, "\\t", -1);
	    continue;
	case '\v':
	    Tcl_AppendToObj(appendObj, "\\v", -1);
	    continue;
	default:
	    Tcl_AppendPrintfToObj(appendObj, "%c", *p);
	    continue;
	}
    }
    Tcl_AppendToObj(appendObj, "\"", -1);
}

#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------
 *
 * RecordByteCodeStats --
 *
4521
4522
4523
4524
4525
4526
4527
4528

4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543

4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
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







-
+














-
+

















-



void
RecordByteCodeStats(
    ByteCode *codePtr)		/* Points to ByteCode structure with info
				 * to add to accumulated statistics. */
{
    Interp *iPtr = (Interp *) *codePtr->interpHandle;
    ByteCodeStats *statsPtr;
    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;

    statsPtr->srcCount[TclLog2(codePtr->numSrcBytes)]++;
    statsPtr->byteCodeCount[TclLog2((int) codePtr->structureSize)]++;
    statsPtr->byteCodeCount[TclLog2((int)(codePtr->structureSize))]++;

    statsPtr->currentInstBytes += (double) codePtr->numCodeBytes;
    statsPtr->currentLitBytes += (double)
	    codePtr->numLitObjects * sizeof(Tcl_Obj *);
    statsPtr->currentExceptBytes += (double)
	    codePtr->numExceptRanges * sizeof(ExceptionRange);
    statsPtr->currentAuxBytes += (double)
	    codePtr->numAuxDataItems * sizeof(AuxData);
    statsPtr->currentCmdMapBytes += (double) codePtr->numCmdLocBytes;
}
#endif /* TCL_COMPILE_STATS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to generic/tclCompile.h.

44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
44
45
46
47
48
49
50







51
52
53
54
55
56
57







-
-
-
-
-
-
-







 *    2: trace invocations of all (not compiled away) commands
 *    3: display each instruction executed
 * This variable is linked to the Tcl variable "tcl_traceExec".
 */

MODULE_SCOPE int 	tclTraceExec;
#endif

/*
 * The type of lambda expressions. Note that every lambda will *always* have a
 * string representation.
 */

MODULE_SCOPE const Tcl_ObjType tclLambdaType;

/*
 *------------------------------------------------------------------------
 * Data structures related to compilation.
 *------------------------------------------------------------------------
 */

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
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







-
+


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+

















-
-
-
+
+
+


-
+




-
+

-
+

+
-
+





+
+
+
+
+
+
+

















-
-
-
+
+
+











-
+













-
-
-
-
-
-
-
-
-
-









-
+

-
+







				 * and continue "exceptions" cause jumps to
				 * appropriate PC offsets. */
    CATCH_EXCEPTION_RANGE	/* Exception's range is controlled by a catch
				 * command. Errors in the range cause a jump
				 * to a catch PC offset. */
} ExceptionRangeType;

typedef struct {
typedef struct ExceptionRange {
    ExceptionRangeType type;	/* The kind of ExceptionRange. */
    int nestingLevel;		/* Static depth of the exception range. Used
				 * to find the most deeply-nested range
				 * surrounding a PC at runtime. */
    int codeOffset;		/* Offset of the first instruction byte of the
				 * code range. */
    int numCodeBytes;		/* Number of bytes in the code range. */
    int breakOffset;		/* If LOOP_EXCEPTION_RANGE, the target PC
				 * offset for a break command in the range. */
    int continueOffset;		/* If LOOP_EXCEPTION_RANGE and not -1, the
				 * target PC offset for a continue command in
				 * the code range. Otherwise, ignore this
				 * range when processing a continue
				 * command. */
    int catchOffset;		/* If a CATCH_EXCEPTION_RANGE, the target PC
				 * offset for any "exception" in range. */
} ExceptionRange;

/*
 * Auxiliary data used when issuing (currently just loop) exception ranges,
 * but which is not required during execution.
 */

typedef struct ExceptionAux {
    int supportsContinue;	/* Whether this exception range will have a
				 * continueOffset created for it; if it is a
				 * loop exception range that *doesn't* have
				 * one (see [for] next-clause) then we must
				 * not pick up the range when scanning for a
				 * target to continue to. */
    int stackDepth;		/* The stack depth at the point where the
				 * exception range was created. This is used
				 * to calculate the number of POPs required to
				 * restore the stack to its prior state. */
    int expandTarget;		/* The number of expansions expected on the
				 * auxData stack at the time the loop starts;
				 * we can't currently discard them except by
				 * doing INST_INVOKE_EXPANDED; this is a known
				 * problem. */
    int expandTargetDepth;	/* The stack depth expected at the outermost
				 * expansion within the loop. Not meaningful
				 * if there are no open expansions between the
				 * looping level and the point of jump
				 * issue. */
    int numBreakTargets;	/* The number of [break]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    unsigned int *breakTargets;	/* The offsets of the INST_JUMP4 instructions
				 * issued by the [break]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numBreakTargets==0, this is NULL. */
    int allocBreakTargets;	/* The size of the breakTargets array. */
    int numContinueTargets;	/* The number of [continue]s that want to be
				 * targeted to the place where this loop
				 * exception will be bound to. */
    unsigned int *continueTargets; /* The offsets of the INST_JUMP4 instructions
				 * issued by the [continue]s that we must
				 * update. Note that resizing a jump (via
				 * TclFixupForwardJump) can cause the contents
				 * of this array to be updated. When
				 * numContinueTargets==0, this is NULL. */
    int allocContinueTargets;	/* The size of the continueTargets array. */
} ExceptionAux;

/*
 * Structure used to map between instruction pc and source locations. It
 * defines for each compiled Tcl command its code's starting offset and its
 * source's starting offset and length. Note that the code offset increases
 * monotonically: that is, the table is sorted in code offset order. The
 * source offset is not monotonic.
 */

typedef struct {
typedef struct CmdLocation {
    int codeOffset;		/* Offset of first byte of command code. */
    int numCodeBytes;		/* Number of bytes for command's code. */
    int srcOffset;		/* Offset of first char of the command. */
    int numSrcBytes;		/* Number of command source chars. */
} CmdLocation;

/*
 * TIP #280
 * Structure to record additional location information for byte code. This
 * information is internal and not saved. i.e. tbcload'ed code will not have
 * this information. It records the lines for all words of all commands found
 * in the byte code. The association with a ByteCode structure BC is done
 * through the 'lineBCPtr' HashTable in Interp, keyed by the address of BC.
 * Also recorded is information coming from the context, i.e. type of the
 * frame and associated information, like the path of a sourced file.
 */

typedef struct {
    size_t srcOffset;		/* Command location to find the entry. */
    int nline;			/* Number of words in the command */
typedef struct ECL {
    int srcOffset;		/* Command location to find the entry. */
    int nline;                  /* Number of words in the command */
    int *line;			/* Line information for all words in the
				 * command. */
    int **next;			/* Transient information used by the compiler
    int** next;                 /* Transient information used by the compiler
				 * for tracking of hidden continuation
				 * lines. */
} ECL;

typedef struct {
typedef struct ExtCmdLoc {
    int type;			/* Context type. */
    int start;			/* Starting line for compiled script. Needed
    int start;                  /* Starting line for compiled script. Needed
				 * for the extended recompile check in
				 * TclCompEvalObj. */
				 * tclCompileObj. */

    Tcl_Obj *path;		/* Path of the sourced file the command is
				 * in. */
    ECL *loc;			/* Command word locations (lines). */
    int nloc;			/* Number of allocated entries in 'loc'. */
    int nuloc;			/* Number of used entries in 'loc'. */
    Tcl_HashTable litInfo;      /* Indexed by bytecode 'PC', to have the
				 * information accessible per command and
				 * argument, not per whole bytecode. Value is
				 * index of command in 'loc', giving us the
				 * literals to associate with line information
				 * as command argument, see
				 * TclArgumentBCEnter() */
} ExtCmdLoc;

/*
 * CompileProcs need the ability to record information during compilation that
 * can be used by bytecode instructions during execution. The AuxData
 * structure provides this "auxiliary data" mechanism. An arbitrary number of
 * these structures can be stored in the ByteCode record (during compilation
 * they are stored in a CompileEnv structure). Each AuxData record holds one
 * word of client-specified data (often a pointer) and is given an index that
 * instructions can later use to look up the structure and its data.
 *
 * The following definitions declare the types of procedures that are called
 * to duplicate or free this auxiliary data when the containing ByteCode
 * objects are duplicated and freed. Pointers to these procedures are kept in
 * the AuxData structure.
 */

typedef void *(AuxDataDupProc)  (void *clientData);
typedef void	   (AuxDataFreeProc) (void *clientData);
typedef void	   (AuxDataPrintProc)(void *clientData,
typedef ClientData (AuxDataDupProc)  (ClientData clientData);
typedef void       (AuxDataFreeProc) (ClientData clientData);
typedef void	   (AuxDataPrintProc)(ClientData clientData,
			    Tcl_Obj *appendObj, struct ByteCode *codePtr,
			    unsigned int pcOffset);

/*
 * We define a separate AuxDataType struct to hold type-related information
 * for the AuxData structure. This separation makes it possible for clients
 * outside of the TCL core to manipulate (in a limited fashion!) AuxData; for
 * example, it makes it possible to pickle and unpickle AuxData structs.
 */

typedef struct AuxDataType {
    const char *name;		/* The name of the type. Types can be
    char *name;			/* The name of the type. Types can be
				 * registered and found by name */
    AuxDataDupProc *dupProc;	/* Callback procedure to invoke when the aux
				 * data is duplicated (e.g., when the ByteCode
				 * structure containing the aux data is
				 * duplicated). NULL means just copy the
				 * source clientData bits; no proc need be
				 * called. */
    AuxDataFreeProc *freeProc;	/* Callback procedure to invoke when the aux
				 * data is freed. NULL means no proc need be
				 * called. */
    AuxDataPrintProc *printProc;/* Callback function to invoke when printing
				 * the aux data as part of debugging. NULL
				 * means that the data can't be printed. */
    AuxDataPrintProc *disassembleProc;
				/* Callback function to invoke when doing a
				 * disassembly of the aux data (like the
				 * printProc, except that the output is
				 * intended to be script-readable). The
				 * appendObj argument should be filled in with
				 * a descriptive dictionary; it will start out
				 * with "name" mapped to the content of the
				 * name field. NULL means that the printProc
				 * should be used instead. */
} AuxDataType;

/*
 * The definition of the AuxData structure that holds information created
 * during compilation by CompileProcs and used by instructions during
 * execution.
 */

typedef struct AuxData {
    const AuxDataType *type;	/* Pointer to the AuxData type associated with
    AuxDataType *type;		/* Pointer to the AuxData type associated with
				 * this ClientData. */
    void *clientData;	/* The compilation data itself. */
    ClientData clientData;	/* The compilation data itself. */
} AuxData;

/*
 * Structure defining the compilation environment. After compilation, fields
 * describing bytecode instructions are copied out into the more compact
 * ByteCode structure defined below.
 */
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
272
273
274
275
276
277
278





279
280
281
282
283
284
285







-
-
-
-
-







				 * exceptArrayNext is the number of ranges and
				 * (exceptArrayNext-1) is the index of the
				 * current range's array entry. */
    int exceptArrayEnd;		/* Index after the last ExceptionRange array
				 * entry. */
    int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
				 * exceptArrayPtr points in heap, else 0. */
    ExceptionAux *exceptAuxArrayPtr;
				/* Array of information used to restore the
				 * state when processing BREAK/CONTINUE
				 * exceptions. Must be the same size as the
				 * exceptArrayPtr. */
    CmdLocation *cmdMapPtr;	/* Points to start of CmdLocation array.
				 * numCommands is the index of the next entry
				 * to use; (numCommands-1) is the entry index
				 * for the last command. */
    int cmdMapEnd;		/* Index after last CmdLocation entry. */
    int mallocedCmdMap;		/* 1 if command map array was expanded and
				 * cmdMapPtr points in the heap, else 0. */
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
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







-
-
-













-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+







				 * auxDataArrayPtr points in heap else 0. */
    unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
				/* Initial storage for code. */
    LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
				/* Initial storage of LiteralEntry array. */
    ExceptionRange staticExceptArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
				/* Initial ExceptionRange array storage. */
    ExceptionAux staticExAuxArraySpace[COMPILEENV_INIT_EXCEPT_RANGES];
				/* Initial static except auxiliary info array
				 * storage. */
    CmdLocation staticCmdMapSpace[COMPILEENV_INIT_CMD_MAP_SIZE];
				/* Initial storage for cmd location map. */
    AuxData staticAuxDataArraySpace[COMPILEENV_INIT_AUX_DATA_SIZE];
				/* Initial storage for aux data array. */
    /* TIP #280 */
    ExtCmdLoc *extCmdMapPtr;	/* Extended command location information for
				 * 'info frame'. */
    int line;			/* First line of the script, based on the
				 * invoking context, then the line of the
				 * command currently compiled. */
    int atCmdStart;		/* Flag to say whether an INST_START_CMD
				 * should be issued; they should never be
				 * issued repeatedly, as that is significantly
				 * inefficient. If set to 2, that instruction
				 * should not be issued at all (by the generic
				 * part of the command compiler). */
    int expandCount;		/* Number of INST_EXPAND_START instructions
				 * encountered that have not yet been paired
				 * inefficient. */
    ContLineLoc* clLoc;  /* If not NULL, the table holding the
			  * locations of the invisible continuation
			  * lines in the input script, to adjust the
			  * line counter. */
				 * with a corresponding
				 * INST_INVOKE_EXPANDED. */
    int *clNext;		/* If not NULL, it refers to the next slot in
				 * clLoc to check for an invisible
				 * continuation line. */
    int*         clNext; /* If not NULL, it refers to the next slot in
			  * clLoc to check for an invisible
			  * continuation line. */
} CompileEnv;

/*
 * The structure defining the bytecode instructions resulting from compiling a
 * Tcl script. Note that this structure is variable length: a single heap
 * object is allocated to hold the ByteCode structure immediately followed by
 * the code bytes, the literal object array, the ExceptionRange array, the
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
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







-
-






-
+







-
+



-
+







/*
 * When a bytecode is compiled, interp or namespace resolvers have not been
 * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
 */

#define TCL_BYTECODE_RESOLVE_VARS		0x0002

#define TCL_BYTECODE_RECOMPILE			0x0004

typedef struct ByteCode {
    TclHandle interpHandle;	/* Handle for interpreter containing the
				 * compiled code. Commands and their compile
				 * procs are specific to an interpreter so the
				 * code emitted will depend on the
				 * interpreter. */
    size_t compileEpoch;	/* Value of iPtr->compileEpoch when this
    int compileEpoch;		/* Value of iPtr->compileEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when, e.g., commands with compile
				 * procs are redefined. */
    Namespace *nsPtr;		/* Namespace context in which this code was
				 * compiled. If the code is executed if a
				 * different namespace, it must be
				 * recompiled. */
    size_t nsEpoch;		/* Value of nsPtr->resolverEpoch when this
    int nsEpoch;		/* Value of nsPtr->resolverEpoch when this
				 * ByteCode was compiled. Used to invalidate
				 * code when new namespace resolution rules
				 * are put into effect. */
    size_t refCount;		/* Reference count: set 1 when created plus 1
    int refCount;		/* Reference count: set 1 when created plus 1
				 * for each execution of the code currently
				 * active. This structure can be freed when
				 * refCount becomes zero. */
    unsigned int flags;		/* flags describing state for the codebyte.
				 * this variable holds ORed values from the
				 * TCL_BYTECODE_ masks defined above */
    const char *source;		/* The source string from which this ByteCode
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613


























614
615
616
617



618




619
620
621
622
623





624
625
626
627
628
629
630
631







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
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
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
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
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
611
612
613
614
615
616
617













618
619
620
621
622
623
624
625
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







-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+



-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

+
+
+
+
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+
+

-
-
+
+
+

-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-

-
-
-
+
-
-

-
-
-
-
-
-
+
-
-
-

-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
+
-

-
-
+
-

-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
+
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-







    unsigned char *srcLengthStart;
				/* Points to the first of a sequence of bytes
				 * that encode the length of each command's
				 * source. The encoding is the same as for
				 * code deltas. Source lengths are always
				 * positive. This sequence is just after the
				 * last byte in the source delta sequence. */
    LocalCache *localCachePtr;	/* Pointer to the start of the cached variable
    LocalCache *localCachePtr;  /* Pointer to the start of the cached variable
				 * names and initialisation data for local
				 * variables. */
#ifdef TCL_COMPILE_STATS
    Tcl_Time createTime;	/* Absolute time when the ByteCode was
				 * created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;

#define ByteCodeSetIntRep(objPtr, typePtr, codePtr)			\
    do {								\
	Tcl_ObjIntRep ir;						\
	ir.twoPtrValue.ptr1 = (codePtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), (typePtr), &ir);			\
    } while (0)



#define ByteCodeGetIntRep(objPtr, typePtr, codePtr)			\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), (typePtr));			\
	(codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * Opcodes for the Tcl bytecode instructions. These must correspond to the
 * entries in the table of instruction descriptions, tclInstructionTable, in
 * tclCompile.c. Also, the order and number of the expression opcodes (e.g.,
 * INST_BITOR) must match the entries in the array operatorStrings in
 * INST_LOR) must match the entries in the array operatorStrings in
 * tclExecute.c.
 */

enum TclInstruction {
    /* Opcodes 0 to 9 */
    INST_DONE = 0,
    INST_PUSH1,
    INST_PUSH4,
    INST_POP,
    INST_DUP,
    INST_STR_CONCAT1,
    INST_INVOKE_STK1,
    INST_INVOKE_STK4,
    INST_EVAL_STK,
    INST_EXPR_STK,
/* Opcodes 0 to 9 */
#define INST_DONE			0
#define INST_PUSH1			1
#define INST_PUSH4			2
#define INST_POP			3
#define INST_DUP			4
#define INST_CONCAT1			5
#define INST_INVOKE_STK1		6
#define INST_INVOKE_STK4		7
#define INST_EVAL_STK			8
#define INST_EXPR_STK			9

    /* Opcodes 10 to 23 */
    INST_LOAD_SCALAR1,
    INST_LOAD_SCALAR4,
    INST_LOAD_SCALAR_STK,
    INST_LOAD_ARRAY1,
    INST_LOAD_ARRAY4,
    INST_LOAD_ARRAY_STK,
    INST_LOAD_STK,
    INST_STORE_SCALAR1,
    INST_STORE_SCALAR4,
    INST_STORE_SCALAR_STK,
    INST_STORE_ARRAY1,
    INST_STORE_ARRAY4,
    INST_STORE_ARRAY_STK,
    INST_STORE_STK,
/* Opcodes 10 to 23 */
#define INST_LOAD_SCALAR1		10
#define INST_LOAD_SCALAR4		11
#define INST_LOAD_SCALAR_STK		12
#define INST_LOAD_ARRAY1		13
#define INST_LOAD_ARRAY4		14
#define INST_LOAD_ARRAY_STK		15
#define INST_LOAD_STK			16
#define INST_STORE_SCALAR1		17
#define INST_STORE_SCALAR4		18
#define INST_STORE_SCALAR_STK		19
#define INST_STORE_ARRAY1		20
#define INST_STORE_ARRAY4		21
#define INST_STORE_ARRAY_STK		22
#define INST_STORE_STK			23

    /* Opcodes 24 to 33 */
    INST_INCR_SCALAR1,
    INST_INCR_SCALAR_STK,
    INST_INCR_ARRAY1,
    INST_INCR_ARRAY_STK,
    INST_INCR_STK,
    INST_INCR_SCALAR1_IMM,
    INST_INCR_SCALAR_STK_IMM,
    INST_INCR_ARRAY1_IMM,
    INST_INCR_ARRAY_STK_IMM,
    INST_INCR_STK_IMM,
/* Opcodes 24 to 33 */
#define INST_INCR_SCALAR1		24
#define INST_INCR_SCALAR_STK		25
#define INST_INCR_ARRAY1		26
#define INST_INCR_ARRAY_STK		27
#define INST_INCR_STK			28
#define INST_INCR_SCALAR1_IMM		29
#define INST_INCR_SCALAR_STK_IMM	30
#define INST_INCR_ARRAY1_IMM		31
#define INST_INCR_ARRAY_STK_IMM		32
#define INST_INCR_STK_IMM		33

    /* Opcodes 34 to 39 */
    INST_JUMP1,
    INST_JUMP4,
    INST_JUMP_TRUE1,
    INST_JUMP_TRUE4,
    INST_JUMP_FALSE1,
    INST_JUMP_FALSE4,
/* Opcodes 34 to 39 */
#define INST_JUMP1			34
#define INST_JUMP4			35
#define INST_JUMP_TRUE1			36
#define INST_JUMP_TRUE4			37
#define INST_JUMP_FALSE1		38
#define INST_JUMP_FALSE4		39

    /* Opcodes 42 to 64 */
    INST_BITOR,
    INST_BITXOR,
    INST_BITAND,
    INST_EQ,
    INST_NEQ,
    INST_LT,
    INST_GT,
    INST_LE,
    INST_GE,
    INST_LSHIFT,
    INST_RSHIFT,
    INST_ADD,
    INST_SUB,
    INST_MULT,
    INST_DIV,
    INST_MOD,
    INST_UPLUS,
    INST_UMINUS,
    INST_BITNOT,
    INST_LNOT,
    INST_TRY_CVT_TO_NUMERIC,
/* Opcodes 40 to 64 */
#define INST_LOR			40
#define INST_LAND			41
#define INST_BITOR			42
#define INST_BITXOR			43
#define INST_BITAND			44
#define INST_EQ				45
#define INST_NEQ			46
#define INST_LT				47
#define INST_GT				48
#define INST_LE				49
#define INST_GE				50
#define INST_LSHIFT			51
#define INST_RSHIFT			52
#define INST_ADD			53
#define INST_SUB			54
#define INST_MULT			55
#define INST_DIV			56
#define INST_MOD			57
#define INST_UPLUS			58
#define INST_UMINUS			59
#define INST_BITNOT			60
#define INST_LNOT			61
#define INST_CALL_BUILTIN_FUNC1		62
#define INST_CALL_FUNC1			63
#define INST_TRY_CVT_TO_NUMERIC		64

    /* Opcodes 65 to 66 */
    INST_BREAK,
    INST_CONTINUE,
/* Opcodes 65 to 66 */
#define INST_BREAK			65
#define INST_CONTINUE			66

/* Opcodes 67 to 68 */
#define INST_FOREACH_START4		67
#define INST_FOREACH_STEP4		68

    /* Opcodes 69 to 72 */
    INST_BEGIN_CATCH4,
    INST_END_CATCH,
    INST_PUSH_RESULT,
    INST_PUSH_RETURN_CODE,
/* Opcodes 69 to 72 */
#define INST_BEGIN_CATCH4		69
#define INST_END_CATCH			70
#define INST_PUSH_RESULT		71
#define INST_PUSH_RETURN_CODE		72

    /* Opcodes 73 to 78 */
    INST_STR_EQ,
    INST_STR_NEQ,
    INST_STR_CMP,
    INST_STR_LEN,
    INST_STR_INDEX,
    INST_STR_MATCH,
/* Opcodes 73 to 78 */
#define INST_STR_EQ			73
#define INST_STR_NEQ			74
#define INST_STR_CMP			75
#define INST_STR_LEN			76
#define INST_STR_INDEX			77
#define INST_STR_MATCH			78

    /* Opcodes 79 to 81 */
    INST_LIST,
    INST_LIST_INDEX,
    INST_LIST_LENGTH,
/* Opcodes 78 to 81 */
#define INST_LIST			79
#define INST_LIST_INDEX			80
#define INST_LIST_LENGTH		81

    /* Opcodes 82 to 87 */
    INST_APPEND_SCALAR1,
    INST_APPEND_SCALAR4,
    INST_APPEND_ARRAY1,
    INST_APPEND_ARRAY4,
    INST_APPEND_ARRAY_STK,
    INST_APPEND_STK,
/* Opcodes 82 to 87 */
#define INST_APPEND_SCALAR1		82
#define INST_APPEND_SCALAR4		83
#define INST_APPEND_ARRAY1		84
#define INST_APPEND_ARRAY4		85
#define INST_APPEND_ARRAY_STK		86
#define INST_APPEND_STK			87

    /* Opcodes 88 to 93 */
    INST_LAPPEND_SCALAR1,
    INST_LAPPEND_SCALAR4,
    INST_LAPPEND_ARRAY1,
    INST_LAPPEND_ARRAY4,
    INST_LAPPEND_ARRAY_STK,
    INST_LAPPEND_STK,
/* Opcodes 88 to 93 */
#define INST_LAPPEND_SCALAR1		88
#define INST_LAPPEND_SCALAR4		89
#define INST_LAPPEND_ARRAY1		90
#define INST_LAPPEND_ARRAY4		91
#define INST_LAPPEND_ARRAY_STK		92
#define INST_LAPPEND_STK		93

    /* TIP #22 - LINDEX operator with flat arg list */
    INST_LIST_INDEX_MULTI,
/* TIP #22 - LINDEX operator with flat arg list */

#define INST_LIST_INDEX_MULTI		94

    /*
     * TIP #33 - 'lset' command. Code gen also required a Forth-like
     *	     OVER operation.
     */
    INST_OVER,
    INST_LSET_LIST,
    INST_LSET_FLAT,
/*
 * TIP #33 - 'lset' command. Code gen also required a Forth-like
 *	     OVER operation.
 */

#define INST_OVER			95
#define INST_LSET_LIST			96
#define INST_LSET_FLAT			97

    /* TIP#90 - 'return' command. */
    INST_RETURN_IMM,
/* TIP#90 - 'return' command. */

#define INST_RETURN_IMM			98

    /* TIP#123 - exponentiation operator. */
    INST_EXPON,
/* TIP#123 - exponentiation operator. */

#define INST_EXPON			99

    /* TIP #157 - {*}... (word expansion) language syntax support. */
    INST_EXPAND_START,
    INST_EXPAND_STKTOP,
    INST_INVOKE_EXPANDED,
/* TIP #157 - {*}... (word expansion) language syntax support. */

#define INST_EXPAND_START		100
#define INST_EXPAND_STKTOP		101
#define INST_INVOKE_EXPANDED		102

    /*
     * TIP #57 - 'lassign' command. Code generation requires immediate
     *	     LINDEX and LRANGE operators.
     */
    INST_LIST_INDEX_IMM,
    INST_LIST_RANGE_IMM,
    INST_START_CMD,
    INST_LIST_IN,
    INST_LIST_NOT_IN,
    INST_PUSH_RETURN_OPTIONS,
    INST_RETURN_STK,
/*
 * TIP #57 - 'lassign' command. Code generation requires immediate
 *	     LINDEX and LRANGE operators.
 */

#define INST_LIST_INDEX_IMM		103
#define INST_LIST_RANGE_IMM		104

#define INST_START_CMD			105

#define INST_LIST_IN			106
#define INST_LIST_NOT_IN		107

#define INST_PUSH_RETURN_OPTIONS	108
#define INST_RETURN_STK			109

    /*
     * Dictionary (TIP#111) related commands.
     */
    INST_DICT_GET,
    INST_DICT_SET,
    INST_DICT_UNSET,
    INST_DICT_INCR_IMM,
    INST_DICT_APPEND,
    INST_DICT_LAPPEND,
    INST_DICT_FIRST,
    INST_DICT_NEXT,
    INST_DICT_UPDATE_START,
    INST_DICT_UPDATE_END,
/*
 * Dictionary (TIP#111) related commands.
 */

#define INST_DICT_GET			110
#define INST_DICT_SET			111
#define INST_DICT_UNSET			112
#define INST_DICT_INCR_IMM		113
#define INST_DICT_APPEND		114
#define INST_DICT_LAPPEND		115
#define INST_DICT_FIRST			116
#define INST_DICT_NEXT			117
#define INST_DICT_DONE			118
#define INST_DICT_UPDATE_START		119
#define INST_DICT_UPDATE_END		120

    /*
     * Instruction to support jumps defined by tables (instead of the classic
     * [switch] technique of chained comparisons).
     */
    INST_JUMP_TABLE,
/*
 * Instruction to support jumps defined by tables (instead of the classic
 * [switch] technique of chained comparisons).
 */

#define INST_JUMP_TABLE			121

    /*
     * Instructions to support compilation of global, variable, upvar and
     * [namespace upvar].
     */
    INST_UPVAR,
    INST_NSUPVAR,
    INST_VARIABLE,
/*
 * Instructions to support compilation of global, variable, upvar and
 * [namespace upvar].
 */

#define INST_UPVAR			122
#define INST_NSUPVAR			123
#define INST_VARIABLE			124

    /* Instruction to support compiling syntax error to bytecode */
/* Instruction to support compiling syntax error to bytecode */
    INST_SYNTAX,

    /* Instruction to reverse N items on top of stack */
    INST_REVERSE,

#define INST_SYNTAX			125
    /* regexp instruction */
    INST_REGEXP,

    /* For [info exists] compilation */
    INST_EXIST_SCALAR,
    INST_EXIST_ARRAY,
    INST_EXIST_ARRAY_STK,
    INST_EXIST_STK,

/* Instruction to reverse N items on top of stack */
    /* For [subst] compilation */
    INST_NOP,
    INST_RETURN_CODE_BRANCH,

    /* For [unset] compilation */
    INST_UNSET_SCALAR,
    INST_UNSET_ARRAY,
    INST_UNSET_ARRAY_STK,
    INST_UNSET_STK,

#define INST_REVERSE			126
    /* For [dict with], [dict exists], [dict create] and [dict merge] */
    INST_DICT_EXPAND,
    INST_DICT_RECOMBINE_STK,
    INST_DICT_RECOMBINE_IMM,
    INST_DICT_EXISTS,
    INST_DICT_VERIFY,

    /* For [string map] and [regsub] compilation */
    INST_STR_MAP,
    INST_STR_FIND,
    INST_STR_FIND_LAST,
    INST_STR_RANGE_IMM,
    INST_STR_RANGE,

    /* For operations to do with coroutines and other NRE-manipulators */
    INST_YIELD,
    INST_COROUTINE_NAME,
    INST_TAILCALL,

    /* For compilation of basic information operations */
    INST_NS_CURRENT,
    INST_INFO_LEVEL_NUM,
    INST_INFO_LEVEL_ARGS,
    INST_RESOLVE_COMMAND,

    /* For compilation relating to TclOO */
    INST_TCLOO_SELF,
    INST_TCLOO_CLASS,
    INST_TCLOO_NS,
    INST_TCLOO_IS_OBJECT,

    /* For compilation of [array] subcommands */
    INST_ARRAY_EXISTS_STK,
    INST_ARRAY_EXISTS_IMM,
    INST_ARRAY_MAKE_STK,
    INST_ARRAY_MAKE_IMM,

/* regexp instruction */
    INST_INVOKE_REPLACE,

    INST_LIST_CONCAT,

#define INST_REGEXP			127
    INST_EXPAND_DROP,

    /* New foreach implementation */
    INST_FOREACH_START,
    INST_FOREACH_STEP,
    INST_FOREACH_END,
    INST_LMAP_COLLECT,

/* For [info exists] compilation */
    /* For compilation of [string trim] and related */
    INST_STR_TRIM,
    INST_STR_TRIM_LEFT,
    INST_STR_TRIM_RIGHT,

#define INST_EXIST_SCALAR		128
    INST_CONCAT_STK,

#define INST_EXIST_ARRAY		129
    INST_STR_UPPER,
    INST_STR_LOWER,
    INST_STR_TITLE,
    INST_STR_REPLACE,

#define INST_EXIST_ARRAY_STK		130
    INST_ORIGIN_COMMAND,

#define INST_EXIST_STK			131
    INST_TCLOO_NEXT,
    INST_TCLOO_NEXT_CLASS,

    INST_YIELD_TO_INVOKE,

    INST_NUM_TYPE,
    INST_TRY_CVT_TO_BOOLEAN,
    INST_STR_CLASS,

    INST_LAPPEND_LIST,
    INST_LAPPEND_LIST_ARRAY,
    INST_LAPPEND_LIST_ARRAY_STK,
    INST_LAPPEND_LIST_STK,

    INST_CLOCK_READ,

    INST_DICT_GET_DEF,

	/* TIP 461 */
	INST_STR_LT,
	INST_STR_GT,
	INST_STR_LE,
	INST_STR_GE,

    /* The last opcode */
    LAST_INST_OPCODE
/* The last opcode */
#define LAST_INST_OPCODE		131
};

/*
 * Table describing the Tcl bytecode instructions: their name (for displaying
 * code), total number of code bytes required (including operand bytes), and a
 * description of the type of each operand. These operand types include signed
 * and unsigned integers of length one and four bytes. The unsigned integers
 * are used for indexes or for, e.g., the count of objects to push in a "push"
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
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







-
+

-
-
-
-
-
-
-



-
-
+
+










-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    OPERAND_UINT4,		/* Four byte unsigned integer. */
    OPERAND_IDX4,		/* Four byte signed index (actually an
				 * integer, but displayed differently.) */
    OPERAND_LVT1,		/* One byte unsigned index into the local
				 * variable table. */
    OPERAND_LVT4,		/* Four byte unsigned index into the local
				 * variable table. */
    OPERAND_AUX4,		/* Four byte unsigned index into the aux data
    OPERAND_AUX4		/* Four byte unsigned index into the aux data
				 * table. */
    OPERAND_OFFSET1,		/* One byte signed jump offset. */
    OPERAND_OFFSET4,		/* Four byte signed jump offset. */
    OPERAND_LIT1,		/* One byte unsigned index into table of
				 * literals. */
    OPERAND_LIT4,		/* Four byte unsigned index into table of
				 * literals. */
    OPERAND_SCLS1		/* Index into tclStringClassTable. */
} InstOperandType;

typedef struct InstructionDesc {
    const char *name;		/* Name of instruction. */
    size_t numBytes;		/* Total number of bytes for instruction. */
    char *name;			/* Name of instruction. */
    int numBytes;		/* Total number of bytes for instruction. */
    int stackEffect;		/* The worst-case balance stack effect of the
				 * instruction, used for stack requirements
				 * computations. The value INT_MIN signals
				 * that the instruction's worst case effect is
				 * (1-opnd1). */
    int numOperands;		/* Number of operands. */
    InstOperandType opTypes[MAX_INSTRUCTION_OPERANDS];
				/* The type of each operand. */
} InstructionDesc;

MODULE_SCOPE InstructionDesc const tclInstructionTable[];
MODULE_SCOPE InstructionDesc tclInstructionTable[];

/*
 * Constants used by INST_STRING_CLASS to indicate character classes. These
 * correspond closely by name with what [string is] can support, but there is
 * no requirement to keep the values the same.
 */

typedef enum InstStringClassType {
    STR_CLASS_ALNUM,		/* Unicode alphabet or digit characters. */
    STR_CLASS_ALPHA,		/* Unicode alphabet characters. */
    STR_CLASS_ASCII,		/* Characters in range U+000000..U+00007F. */
    STR_CLASS_CONTROL,		/* Unicode control characters. */
    STR_CLASS_DIGIT,		/* Unicode digit characters. */
    STR_CLASS_GRAPH,		/* Unicode printing characters, excluding
				 * space. */
    STR_CLASS_LOWER,		/* Unicode lower-case alphabet characters. */
    STR_CLASS_PRINT,		/* Unicode printing characters, including
				 * spaces. */
    STR_CLASS_PUNCT,		/* Unicode punctuation characters. */
    STR_CLASS_SPACE,		/* Unicode space characters. */
    STR_CLASS_UPPER,		/* Unicode upper-case alphabet characters. */
    STR_CLASS_WORD,		/* Unicode word (alphabetic, digit, connector
				 * punctuation) characters. */
    STR_CLASS_XDIGIT		/* Characters that can be used as digits in
				 * hexadecimal numbers ([0-9A-Fa-f]). */
} InstStringClassType;

typedef struct StringClassDesc {
    char name[8];		/* Name of the class. */
    int (*comparator)(int);	/* Function to test if a single unicode
				 * character is a member of the class. */
} StringClassDesc;

MODULE_SCOPE StringClassDesc const tclStringClassTable[];

/*
 * Compilation of some Tcl constructs such as if commands and the logical or
 * (||) and logical and (&&) operators in expressions requires the generation
 * of forward jumps. Since the PC target of these jumps isn't known when the
 * jumps are emitted, we record the offset of each jump in an array of
 * JumpFixup structures. There is one array for each sequence of jumps to one
929
930
931
932
933
934
935
936

937
938
939
940
941
942
943
727
728
729
730
731
732
733

734
735
736
737
738
739
740
741







-
+







    TCL_UNCONDITIONAL_JUMP,
    TCL_TRUE_JUMP,
    TCL_FALSE_JUMP
} TclJumpType;

typedef struct JumpFixup {
    TclJumpType jumpType;	/* Indicates the kind of jump. */
    unsigned int codeOffset;	/* Offset of the first byte of the one-byte
    int codeOffset;		/* Offset of the first byte of the one-byte
				 * forward jump's code. */
    int cmdIndex;		/* Index of the first command after the one
				 * for which the jump was emitted. Used to
				 * update the code offsets for subsequent
				 * commands if the two-byte jump at jumpPc
				 * must be replaced with a five-byte one. */
    int exceptIndex;		/* Index of the first range entry in the
965
966
967
968
969
970
971
972

973
974
975
976
977
978
979
763
764
765
766
767
768
769

770
771
772
773
774
775
776
777







-
+







 * only foreach commands inside procedure bodies are compiled inline so a
 * ForeachVarList structure always describes local variables. Furthermore,
 * only scalar variables are supported for inline-compiled foreach loops.
 */

typedef struct ForeachVarList {
    int numVars;		/* The number of variables in the list. */
    int varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers")
    int varIndexes[1];		/* An array of the indexes ("slot numbers")
				 * for each variable in the procedure's array
				 * of local variables. Only scalar variables
				 * are supported. The actual size of this
				 * field will be large enough to numVars
				 * indexes. THIS MUST BE THE LAST FIELD IN THE
				 * STRUCTURE! */
} ForeachVarList;
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
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
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
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
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







-
+





+
+












-
+
-
-
-








-
-
+
+







+
+





-
+













-
-
+
+
+








+
+
+








-
-
-
-
+
-



-
-
+
+



-
-
-

-
+






-
-
-
-
+
+


-
-
-
-
-
+
+
+
+
+





-

-
+

-
+

-
-
-
+
+
+





-
+
-
-
-
-
+
+


-
+


-
-
-
-
-
-
-
-




-
-
-
-
-




-
-
+
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+






-
-
-
-
-
-
-
-
-
-
-








+
+
+

-
+
+

-
+
+


-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
-
-
-
+
+
+
-
-
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-












-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
+
+
+
+
+
+
-










-
-
-
-
-
+
+
+
+
-


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-












-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-











-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
+














-
-
-
-
-
+
+
+
+
-











-
-
-
+
+
-


-
-
-
+
+
-











-
+







				 * lists of the foreach command. */
    int firstValueTemp;		/* Index of the first temp var in a proc frame
				 * used to point to a value list. */
    int loopCtTemp;		/* Index of temp var in a proc frame holding
				 * the loop's iteration count. Used to
				 * determine next value list element to assign
				 * each loop var. */
    ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList
    ForeachVarList *varLists[1];/* An array of pointers to ForeachVarList
				 * structures describing each var list. The
				 * actual size of this field will be large
				 * enough to numVars indexes. THIS MUST BE THE
				 * LAST FIELD IN THE STRUCTURE! */
} ForeachInfo;

MODULE_SCOPE AuxDataType	tclForeachInfoType;

/*
 * Structure used to hold information about a switch command that is needed
 * during program execution. These structures are stored in CompileEnv and
 * ByteCode structures as auxiliary data.
 */

typedef struct JumptableInfo {
    Tcl_HashTable hashTable;	/* Hash that maps strings to signed ints (PC
				 * offsets). */
} JumptableInfo;

MODULE_SCOPE const AuxDataType tclJumptableInfoType;
MODULE_SCOPE AuxDataType	tclJumptableInfoType;

#define JUMPTABLEINFO(envPtr, index) \
    ((JumptableInfo*)((envPtr)->auxDataArrayPtr[TclGetUInt4AtPtr(index)].clientData))

/*
 * Structure used to hold information about a [dict update] command that is
 * needed during program execution. These structures are stored in CompileEnv
 * and ByteCode structures as auxiliary data.
 */

typedef struct {
    size_t length;		/* Size of array */
    int varIndices[TCLFLEXARRAY];		/* Array of variable indices to manage when
    int length;			/* Size of array */
    int varIndices[1];		/* Array of variable indices to manage when
				 * processing the start and end of a [dict
				 * update]. There is really more than one
				 * entry, and the structure is allocated to
				 * take account of this. MUST BE LAST FIELD IN
				 * STRUCTURE. */
} DictUpdateInfo;

MODULE_SCOPE AuxDataType	tclDictUpdateInfoType;

/*
 * ClientData type used by the math operator commands.
 */

typedef struct {
    const char *op;		/* Do not call it 'operator': C++ reserved */
    const char *op;   /* Do not call it 'operator': C++ reserved */
    const char *expected;
    union {
	int numArgs;
	int identity;
    } i;
} TclOpCmdClientData;

/*
 *----------------------------------------------------------------
 * Procedures exported by tclBasic.c to be used within the engine.
 *----------------------------------------------------------------
 */

MODULE_SCOPE Tcl_ObjCmdProc	TclNRInterpCoroutine;

MODULE_SCOPE int	TclEvalObjvInternal(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    CONST char *command, int length, int flags);
/*
 *----------------------------------------------------------------
 * Procedures exported by the engine to be used by tclBasic.c
 *----------------------------------------------------------------
 */

MODULE_SCOPE ByteCode *	TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const CmdFrame *invoker, int word);

MODULE_SCOPE int	TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const CmdFrame *invoker, int word);

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl bytecode compilation and execution modules but
 * not used outside:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclAttemptCompileProc(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCleanupStackForBreakContinue(CompileEnv *envPtr,
MODULE_SCOPE void	TclCleanupByteCode(ByteCode *codePtr);
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclCompileCmdWord(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, const char *script,
			    size_t numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExpr(Tcl_Interp *interp, CONST char *script,
	                    int numBytes, CompileEnv *envPtr, int optimize);
MODULE_SCOPE void	TclCompileExprWords(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
			    const char *script, size_t numBytes,
			    CONST char *script, int numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileTokens(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, int count,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclCompileVarSubst(Tcl_Interp *interp,
			    Tcl_Token *tokenPtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(void *clientData,
			    const AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateAuxData(ClientData clientData,
			    AuxDataType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE int	TclCreateExceptRange(ExceptionRangeType type,
			    CompileEnv *envPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp, size_t size);
MODULE_SCOPE Tcl_Obj *	TclCreateLiteral(Interp *iPtr, const char *bytes,
			    size_t length, size_t hash, int *newPtr,
			    Namespace *nsPtr, int flags,
			    LiteralEntry **globalPtrPtr);
MODULE_SCOPE ExecEnv *	TclCreateExecEnv(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *  TclCreateLiteral(Interp *iPtr, char *bytes,
	                    int length, unsigned int hash, int *newPtr,
	                    Namespace *nsPtr, int flags,
	                    LiteralEntry **globalPtrPtr);
MODULE_SCOPE void	TclDeleteExecEnv(ExecEnv *eePtr);
MODULE_SCOPE void	TclDeleteLiteralTable(Tcl_Interp *interp,
			    LiteralTable *tablePtr);
MODULE_SCOPE void	TclEmitForwardJump(CompileEnv *envPtr,
			    TclJumpType jumpType, JumpFixup *jumpFixupPtr);
MODULE_SCOPE void	TclEmitInvoke(CompileEnv *envPtr, int opcode, ...);
MODULE_SCOPE ExceptionRange * TclGetExceptionRangeForPc(unsigned char *pc,
			    int catchOnly, ByteCode *codePtr);
			    int catchOnly, ByteCode* codePtr);
MODULE_SCOPE void	TclExpandJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclNRExecuteByteCode(Tcl_Interp *interp,
MODULE_SCOPE int	TclExecuteByteCode(Tcl_Interp *interp,
			    ByteCode *codePtr);
MODULE_SCOPE Tcl_Obj *	TclFetchLiteral(CompileEnv *envPtr, size_t index);
MODULE_SCOPE int	TclFindCompiledLocal(const char *name, size_t nameChars,
			    int create, CompileEnv *envPtr);
MODULE_SCOPE void	TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int	TclFindCompiledLocal(CONST char *name, int nameChars,
			    int create, Proc *procPtr);
MODULE_SCOPE int	TclFixupForwardJump(CompileEnv *envPtr,
			    JumpFixup *jumpFixupPtr, int jumpDist,
			    int distThreshold);
MODULE_SCOPE void	TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void	TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int	TclGetIndexFromToken(Tcl_Token *tokenPtr,
MODULE_SCOPE void	TclInitAuxDataTypeTable(void);
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE ByteCode *	TclInitByteCode(CompileEnv *envPtr);
MODULE_SCOPE ByteCode *	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void	TclInitByteCodeObj(Tcl_Obj *objPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclInitCompileEnv(Tcl_Interp *interp,
			    CompileEnv *envPtr, const char *string,
			    size_t numBytes, const CmdFrame *invoker, int word);
			    int numBytes, CONST CmdFrame* invoker, int word);
MODULE_SCOPE void	TclInitJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE void	TclInitLiteralTable(LiteralTable *tablePtr);
MODULE_SCOPE ExceptionRange *TclGetInnermostExceptionRange(CompileEnv *envPtr,
			    int returnCode, ExceptionAux **auxPtrPtr);
MODULE_SCOPE void	TclAddLoopBreakFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclAddLoopContinueFixup(CompileEnv *envPtr,
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
			    int range);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int	TclLog2(int value);
#endif
MODULE_SCOPE int	TclLocalScalar(const char *bytes, size_t numBytes,
			    CompileEnv *envPtr);
MODULE_SCOPE int	TclLocalScalarFromToken(Tcl_Token *tokenPtr,
			    CompileEnv *envPtr);
MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE int	TclPrintInstruction(ByteCode* codePtr,
			    unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,
			    Tcl_Obj *objPtr, size_t maxChars);
			    Tcl_Obj *objPtr, int maxChars);
MODULE_SCOPE void	TclPrintSource(FILE *outFile,
			    const char *string, size_t maxChars);
MODULE_SCOPE void	TclPushVarName(Tcl_Interp *interp,
			    Tcl_Token *varTokenPtr, CompileEnv *envPtr,
			    int flags, int *localIndexPtr,
			    int *isScalarPtr);
MODULE_SCOPE void	TclPreserveByteCode(ByteCode *codePtr);
MODULE_SCOPE void	TclReleaseByteCode(ByteCode *codePtr);
			    CONST char *string, int maxChars);

static inline void
TclPreserveByteCode(
    register ByteCode *codePtr)
{
    codePtr->refCount++;
}

static inline void
TclReleaseByteCode(
    register ByteCode *codePtr)
{
    if (codePtr->refCount-- > 1) {
	return;
    }
    /* Just dropped to refcount==0.  Clean up. */
    TclCleanupByteCode(codePtr);
}

MODULE_SCOPE void	TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclInvalidateCmdLiteral(Tcl_Interp *interp,
			    const char *name, Namespace *nsPtr);
MODULE_SCOPE int	TclSingleOpCmd(void *clientData,
MODULE_SCOPE int	TclSingleOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclSortingOpCmd(void *clientData,
			    Tcl_Obj *CONST objv[]);
MODULE_SCOPE int	TclSortingOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclVariadicOpCmd(void *clientData,
			    Tcl_Obj *CONST objv[]);
MODULE_SCOPE int	TclVariadicOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNoIdentOpCmd(void *clientData,
			    Tcl_Obj *CONST objv[]);
MODULE_SCOPE int	TclNoIdentOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
			    Tcl_Obj *CONST objv[]);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
#endif
MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
			    Tcl_Obj *valuePtr);
MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
			    const char *script, const char *command,
			    size_t length, const unsigned char *pc,
			    Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
			    const unsigned char *pc, Tcl_Obj **tosPtr);
MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int isLambda);


/*
 *----------------------------------------------------------------
 * Macros and flag values used by Tcl bytecode compilation and execution
 * modules inside the Tcl core but not used outside.
 *----------------------------------------------------------------
 */

#define LITERAL_ON_HEAP    0x01
#define LITERAL_NS_SCOPE   0x02

/*
 * Simplified form to access AuxData.
 * Form of TclRegisterLiteral with onHeap == 0. In that case, it is safe to
 * cast away CONSTness, and it is cleanest to do that here, all in one place.
 *
 * void *TclFetchAuxData(CompileEng *envPtr, int index);
 * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
 *			     int length);
 */

#define TclFetchAuxData(envPtr, index) \
    (envPtr)->auxDataArrayPtr[(index)].clientData

#define LITERAL_ON_HEAP		0x01
#define LITERAL_CMD_NAME	0x02
#define LITERAL_UNSHARED	0x04
#define TclRegisterNewLiteral(envPtr, bytes, length) \
	TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)

/*
 * Form of TclRegisterNSLiteral with onHeap == 0. In that case, it is safe to
 * cast away CONSTness, and it is cleanest to do that here, all in one place.
 *
 * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
 *			       int length);
 */

#define TclRegisterNewNSLiteral(envPtr, bytes, length) \
	TclRegisterLiteral(envPtr, (char *)(bytes), length, \
		/*flags*/ LITERAL_NS_SCOPE)

/*
 * Macro used to manually adjust the stack requirements; used in cases where
 * the stack effect cannot be computed from the opcode and its operands, but
 * is still known at compile time.
 *
 * void TclAdjustStackDepth(int delta, CompileEnv *envPtr);
 */

#define TclAdjustStackDepth(delta, envPtr) \
    do {								\
	if ((delta) < 0) {						\
	    if ((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {	\
		(envPtr)->maxStackDepth = (envPtr)->currStackDepth;	\
    if ((delta) < 0) {\
	if((envPtr)->maxStackDepth < (envPtr)->currStackDepth) {\
	    (envPtr)->maxStackDepth = (envPtr)->currStackDepth;\
	    }								\
	}								\
	(envPtr)->currStackDepth += (delta);				\
    } while (0)

	}\
#define TclGetStackDepth(envPtr)		\
    ((envPtr)->currStackDepth)

    }\
#define TclSetStackDepth(depth, envPtr)		\
    (envPtr)->currStackDepth = (depth)
    (envPtr)->currStackDepth += (delta)

#define TclCheckStackDepth(depth, envPtr)				\
    do {								\
	int _dd = (depth);						\
	if (_dd != (envPtr)->currStackDepth) {				\
	    Tcl_Panic("bad stack depth computations: is %i, should be %i", \
		    (envPtr)->currStackDepth, _dd);		\
	}								\
    } while (0)

/*
 * Macro used to update the stack requirements. It is called by the macros
 * TclEmitOpCode, TclEmitInst1 and TclEmitInst4.
 * Remark that the very last instruction of a bytecode always reduces the
 * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always
 * updated.
 *
 * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr);
 */

#define TclUpdateStackReqs(op, i, envPtr) \
    do {							\
	int _delta = tclInstructionTable[(op)].stackEffect;	\
	if (_delta) {						\
	    if (_delta == INT_MIN) {				\
		_delta = 1 - (i);				\
	    }							\
	    TclAdjustStackDepth(_delta, envPtr);			\
    {\
	int delta = tclInstructionTable[(op)].stackEffect;\
	if (delta) {\
	    if (delta == INT_MIN) {\
		delta = 1 - (i);\
	    }\
	    TclAdjustStackDepth(delta, envPtr);\
	}							\
    } while (0)

	}\
/*
 * Macros used to update the flag that indicates if we are at the start of a
 * command, based on whether the opcode is INST_START_COMMAND.
 *
 * void TclUpdateAtCmdStart(unsigned char op, CompileEnv *envPtr);
 */

#define TclUpdateAtCmdStart(op, envPtr) \
    if ((envPtr)->atCmdStart < 2) {				     \
	(envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0);     \
    }

/*
 * Macro to emit an opcode byte into a CompileEnv's code array. The ANSI C
 * "prototype" for this macro is:
 *
 * void TclEmitOpcode(unsigned char op, CompileEnv *envPtr);
 */

#define TclEmitOpcode(op, envPtr) \
    do {							\
	if ((envPtr)->codeNext == (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(envPtr);				\
	}							\
	*(envPtr)->codeNext++ = (unsigned char) (op);		\
	TclUpdateAtCmdStart(op, envPtr);			\
	TclUpdateStackReqs(op, 0, envPtr);			\
    if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
	TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) (op);\
    (envPtr)->atCmdStart = ((op) == INST_START_CMD); \
    TclUpdateStackReqs(op, 0, envPtr)
    } while (0)

/*
 * Macros to emit an integer operand. The ANSI C "prototype" for these macros
 * are:
 *
 * void TclEmitInt1(int i, CompileEnv *envPtr);
 * void TclEmitInt4(int i, CompileEnv *envPtr);
 */

#define TclEmitInt1(i, envPtr) \
    do {								\
	if ((envPtr)->codeNext == (envPtr)->codeEnd) {			\
	    TclExpandCodeArray(envPtr);					\
	}								\
	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
    if ((envPtr)->codeNext == (envPtr)->codeEnd) { \
	TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i))
    } while (0)

#define TclEmitInt4(i, envPtr) \
    do {								\
	if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(envPtr);					\
	}								\
	*(envPtr)->codeNext++ =						\
		(unsigned char) ((unsigned int) (i) >> 24);		\
	*(envPtr)->codeNext++ =						\
		(unsigned char) ((unsigned int) (i) >> 16);		\
	*(envPtr)->codeNext++ =						\
		(unsigned char) ((unsigned int) (i) >>  8);		\
	*(envPtr)->codeNext++ =						\
		(unsigned char) ((unsigned int) (i)      );		\
    if (((envPtr)->codeNext + 4) > (envPtr)->codeEnd) { \
	TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i) >> 24); \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i) >> 16); \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i) >>  8); \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i)      )
    } while (0)

/*
 * Macros to emit an instruction with signed or unsigned integer operands.
 * Four byte integers are stored in "big-endian" order with the high order
 * byte stored at the lowest address. The ANSI C "prototypes" for these macros
 * are:
 *
 * void TclEmitInstInt1(unsigned char op, int i, CompileEnv *envPtr);
 * void TclEmitInstInt4(unsigned char op, int i, CompileEnv *envPtr);
 */

#define TclEmitInstInt1(op, i, envPtr) \
    do {								\
	if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) {		\
	    TclExpandCodeArray(envPtr);					\
	}								\
	*(envPtr)->codeNext++ = (unsigned char) (op);			\
	*(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));	\
	TclUpdateAtCmdStart(op, envPtr);				\
	TclUpdateStackReqs(op, i, envPtr);				\
    if (((envPtr)->codeNext + 2) > (envPtr)->codeEnd) { \
	TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) (op); \
    *(envPtr)->codeNext++ = (unsigned char) ((unsigned int) (i));\
    (envPtr)->atCmdStart = ((op) == INST_START_CMD); \
    TclUpdateStackReqs(op, i, envPtr)
    } while (0)

#define TclEmitInstInt4(op, i, envPtr) \
    do {							\
	if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) {	\
	    TclExpandCodeArray(envPtr);				\
	}							\
	*(envPtr)->codeNext++ = (unsigned char) (op);		\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >> 24);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >> 16);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i) >>  8);	\
	*(envPtr)->codeNext++ =					\
		(unsigned char) ((unsigned int) (i)      );	\
	TclUpdateAtCmdStart(op, envPtr);			\
	TclUpdateStackReqs(op, i, envPtr);			\
    if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \
	TclExpandCodeArray(envPtr); \
    } \
    *(envPtr)->codeNext++ = (unsigned char) (op); \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i) >> 24); \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i) >> 16); \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i) >>  8); \
    *(envPtr)->codeNext++ = \
	(unsigned char) ((unsigned int) (i)      );\
    (envPtr)->atCmdStart = ((op) == INST_START_CMD); \
    TclUpdateStackReqs(op, i, envPtr)
    } while (0)

/*
 * Macro to push a Tcl object onto the Tcl evaluation stack. It emits the
 * object's one or four byte array index into the CompileEnv's code array.
 * These support, respectively, a maximum of 256 (2**8) and 2**32 objects in a
 * CompileEnv. The ANSI C "prototype" for this macro is:
 *
 * void	TclEmitPush(int objIndex, CompileEnv *envPtr);
 */

#define TclEmitPush(objIndex, envPtr) \
    do {							 \
	int _objIndexCopy = (objIndex);			 \
	if (_objIndexCopy <= 255) {				 \
	    TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \
	} else {						 \
	    TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \
	}							 \
    {\
	register int objIndexCopy = (objIndex);\
	if (objIndexCopy <= 255) { \
	    TclEmitInstInt1(INST_PUSH1, objIndexCopy, (envPtr)); \
	} else { \
	    TclEmitInstInt4(INST_PUSH4, objIndexCopy, (envPtr)); \
	}\
    } while (0)
    }

/*
 * Macros to update a (signed or unsigned) integer starting at a pointer. The
 * two variants depend on the number of bytes. The ANSI C "prototypes" for
 * these macros are:
 *
 * void TclStoreInt1AtPtr(int i, unsigned char *p);
 * void TclStoreInt4AtPtr(int i, unsigned char *p);
 */

#define TclStoreInt1AtPtr(i, p) \
    *(p)   = (unsigned char) ((unsigned int) (i))

#define TclStoreInt4AtPtr(i, p) \
    do {							\
	*(p)   = (unsigned char) ((unsigned int) (i) >> 24);	\
	*(p+1) = (unsigned char) ((unsigned int) (i) >> 16);	\
	*(p+2) = (unsigned char) ((unsigned int) (i) >>  8);	\
	*(p+3) = (unsigned char) ((unsigned int) (i)      );	\
    *(p)   = (unsigned char) ((unsigned int) (i) >> 24); \
    *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \
    *(p+2) = (unsigned char) ((unsigned int) (i) >>  8); \
    *(p+3) = (unsigned char) ((unsigned int) (i)      )
    } while (0)

/*
 * Macros to update instructions at a particular pc with a new op code and a
 * (signed or unsigned) int operand. The ANSI C "prototypes" for these macros
 * are:
 *
 * void TclUpdateInstInt1AtPc(unsigned char op, int i, unsigned char *pc);
 * void TclUpdateInstInt4AtPc(unsigned char op, int i, unsigned char *pc);
 */

#define TclUpdateInstInt1AtPc(op, i, pc) \
    do {					\
	*(pc) = (unsigned char) (op);		\
	TclStoreInt1AtPtr((i), ((pc)+1));	\
    *(pc) = (unsigned char) (op); \
    TclStoreInt1AtPtr((i), ((pc)+1))
    } while (0)

#define TclUpdateInstInt4AtPc(op, i, pc) \
    do {					\
	*(pc) = (unsigned char) (op);		\
	TclStoreInt4AtPtr((i), ((pc)+1));	\
    *(pc) = (unsigned char) (op); \
    TclStoreInt4AtPtr((i), ((pc)+1))
    } while (0)

/*
 * Macro to fix up a forward jump to point to the current code-generation
 * position in the bytecode being created (the most common case). The ANSI C
 * "prototypes" for this macro is:
 *
 * int TclFixupForwardJumpToHere(CompileEnv *envPtr, JumpFixup *fixupPtr,
 *				 int threshold);
 */

#define TclFixupForwardJumpToHere(envPtr, fixupPtr, threshold) \
    TclFixupForwardJump((envPtr), (fixupPtr),				\
    TclFixupForwardJump((envPtr), (fixupPtr), \
	    (envPtr)->codeNext-(envPtr)->codeStart-(fixupPtr)->codeOffset, \
	    (threshold))

/*
 * Macros to get a signed integer (GET_INT{1,2}) or an unsigned int
 * (GET_UINT{1,2}) from a pointer. There are two variants for each return type
 * that depend on the number of bytes fetched. The ANSI C "prototypes" for
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474
1475






1476
1477
1478

1479
1480
1481
1482



1483
1484

1485
1486

1487
1488
1489
1490



1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501


1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
1668
1669
1670
1671
1672
1673
1674
1675
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







+
-
-
-
-
-
+
+
+
+
+
+


-
+
-
-
-
-
+
+
+

-
+
-
-
+
-
-
-
-
+
+
+









-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * platforms so sign-extension doesn't always happen automatically. Sometimes
 * we can explicitly declare the pointer to be signed, but other times we have
 * to explicitly sign-extend the value in software.
 */

#ifndef __CHAR_UNSIGNED__
#   define TclGetInt1AtPtr(p) ((int) *((char *) p))
#else
#elif defined(HAVE_SIGNED_CHAR)
#   define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#else
#   define TclGetInt1AtPtr(p) \
    (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0))
#   ifdef HAVE_SIGNED_CHAR
#	define TclGetInt1AtPtr(p) ((int) *((signed char *) p))
#   else
#	define TclGetInt1AtPtr(p) (((int) *((char *) p)) \
		| ((*(p) & 0200) ? (-256) : 0))
#   endif
#endif

#define TclGetInt4AtPtr(p) \
#define TclGetInt4AtPtr(p) (((int) TclGetInt1AtPtr(p) << 24) | \
    (((int) (TclGetUInt1AtPtr(p) << 24)) |				\
		     (*((p)+1) << 16) |				\
		     (*((p)+2) <<  8) |				\
		     (*((p)+3)))
					    (*((p)+1) << 16) | \
				  	    (*((p)+2) <<  8) | \
				  	    (*((p)+3)))

#define TclGetUInt1AtPtr(p) \
#define TclGetUInt1AtPtr(p) ((unsigned int) *(p))
    ((unsigned int) *(p))
#define TclGetUInt4AtPtr(p) \
#define TclGetUInt4AtPtr(p) ((unsigned int) (*(p)     << 24) | \
    ((unsigned int) (*(p)     << 24) |				\
		    (*((p)+1) << 16) |				\
		    (*((p)+2) <<  8) |				\
		    (*((p)+3)))
					    (*((p)+1) << 16) | \
					    (*((p)+2) <<  8) | \
					    (*((p)+3)))

/*
 * Macros used to compute the minimum and maximum of two integers. The ANSI C
 * "prototypes" for these macros are:
 *
 * int TclMin(int i, int j);
 * int TclMax(int i, int j);
 */

#define TclMin(i, j)	((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j)	((((int) i) > ((int) j))? (i) : (j))
#define TclMin(i, j)   ((((int) i) < ((int) j))? (i) : (j))
#define TclMax(i, j)   ((((int) i) > ((int) j))? (i) : (j))

/*
 * Convenience macros for use when compiling bodies of commands. The ANSI C
 * "prototype" for these macros are:
 *
 * static void		BODY(Tcl_Token *tokenPtr, int word);
 */

#define BODY(tokenPtr, word)						\
    SetLineInformation((word));						\
    TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents,	\
	    envPtr)

/*
 * Convenience macro for use when compiling tokens to be pushed. The ANSI C
 * "prototype" for this macro is:
 *
 * static void		CompileTokens(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp);
 */

#define CompileTokens(envPtr, tokenPtr, interp) \
    TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \
	    (envPtr));
/*
 * Convenience macros for use when pushing literals. The ANSI C "prototype" for
 * these macros are:
 *
 * static void		PushLiteral(CompileEnv *envPtr,
 *			    const char *string, size_t length);
 * static void		PushStringLiteral(CompileEnv *envPtr,
 *			    const char *string);
 */

#define PushLiteral(envPtr, string, length) \
    TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr))
#define PushStringLiteral(envPtr, string) \
    PushLiteral(envPtr, string, sizeof(string "") - 1)

/*
 * Macro to advance to the next token; it is more mnemonic than the address
 * arithmetic that it replaces. The ANSI C "prototype" for this macro is:
 *
 * static Tcl_Token *	TokenAfter(Tcl_Token *tokenPtr);
 */

#define TokenAfter(tokenPtr) \
    ((tokenPtr) + ((tokenPtr)->numComponents + 1))

/*
 * Macro to get the offset to the next instruction to be issued. The ANSI C
 * "prototype" for this macro is:
 *
 * static ptrdiff_t	CurrentOffset(CompileEnv *envPtr);
 */

#define CurrentOffset(envPtr) \
    ((envPtr)->codeNext - (envPtr)->codeStart)

/*
 * Note: the exceptDepth is a bit of a misnomer: TEBC only needs the
 * maximal depth of nested CATCH ranges in order to alloc runtime
 * memory. These macros should compute precisely that? OTOH, the nesting depth
 * of LOOP ranges is an interesting datum for debugging purposes, and that is
 * what we compute now.
 *
 * static int	ExceptionRangeStarts(CompileEnv *envPtr, int index);
 * static void	ExceptionRangeEnds(CompileEnv *envPtr, int index);
 * static void	ExceptionRangeTarget(CompileEnv *envPtr, int index, LABEL);
 */

#define ExceptionRangeStarts(envPtr, index) \
    (((envPtr)->exceptDepth++),						\
    ((envPtr)->maxExceptDepth =						\
	    TclMax((envPtr)->exceptDepth, (envPtr)->maxExceptDepth)),	\
    ((envPtr)->exceptArrayPtr[(index)].codeOffset = CurrentOffset(envPtr)))
#define ExceptionRangeEnds(envPtr, index) \
    (((envPtr)->exceptDepth--),						\
    ((envPtr)->exceptArrayPtr[(index)].numCodeBytes =			\
	CurrentOffset(envPtr) - (envPtr)->exceptArrayPtr[(index)].codeOffset))
#define ExceptionRangeTarget(envPtr, index, targetType) \
    ((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))

/*
 * Check if there is an LVT for compiled locals
 */

#define EnvHasLVT(envPtr) \
    (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)

/*
 * Macros for making it easier to deal with tokens and DStrings.
 */

#define TclDStringAppendToken(dsPtr, tokenPtr) \
    Tcl_DStringAppend((dsPtr), (tokenPtr)->start, (tokenPtr)->size)
#define TclRegisterDStringLiteral(envPtr, dsPtr) \
    TclRegisterLiteral(envPtr, Tcl_DStringValue(dsPtr), \
	    Tcl_DStringLength(dsPtr), /*flags*/ 0)

/*
 * Macro that encapsulates an efficiency trick that avoids a function call for
 * the simplest of compiles. The ANSI C "prototype" for this macro is:
 *
 * static void		CompileWord(CompileEnv *envPtr, Tcl_Token *tokenPtr,
 *			    Tcl_Interp *interp, int word);
 */

#define CompileWord(envPtr, tokenPtr, interp, word) \
    if ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD) {			\
	PushLiteral((envPtr), (tokenPtr)[1].start, (tokenPtr)[1].size);	\
    } else {								\
	SetLineInformation((word));					\
	CompileTokens((envPtr), (tokenPtr), (interp));			\
    }

/*
 * TIP #280: Remember the per-word line information of the current command. An
 * index is used instead of a pointer as recursive compilation may reallocate,
 * i.e. move, the array. This is also the reason to save the nuloc now, it may
 * change during the course of the function.
 *
 * Macro to encapsulate the variable definition and setup.
 */

#define DefineLineInformation \
    ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr;				\
    int eclIndex = mapPtr->nuloc - 1

#define SetLineInformation(word) \
    envPtr->line = mapPtr->loc[eclIndex].line[(word)];			\
    envPtr->clNext = mapPtr->loc[eclIndex].next[(word)]

#define PushVarNameWord(i,v,e,f,l,sc,word) \
    SetLineInformation(word);						\
    TclPushVarName(i,v,e,f,l,sc)

/*
 * Often want to issue one of two versions of an instruction based on whether
 * the argument will fit in a single byte or not. This makes it much clearer.
 */

#define Emit14Inst(nm,idx,envPtr) \
    if (idx <= 255) {							\
	TclEmitInstInt1(nm##1,idx,envPtr);				\
    } else {								\
	TclEmitInstInt4(nm##4,idx,envPtr);				\
    }

/*
 * How to get an anonymous local variable (used for holding temporary values
 * off the stack) or a local simple scalar.
 */

#define AnonymousLocal(envPtr) \
    (TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, (envPtr)))
#define LocalScalar(chars,len,envPtr) \
    TclLocalScalar(chars, len, envPtr)
#define LocalScalarFromToken(tokenPtr,envPtr) \
    TclLocalScalarFromToken(tokenPtr, envPtr)

/*
 * Flags bits used by TclPushVarName.
 */

#define TCL_NO_LARGE_INDEX 1	/* Do not return localIndex value > 255 */
#define TCL_NO_ELEMENT 2	/* Do not push the array element. */

/*
 * DTrace probe macros (NOPs if DTrace support is not enabled).
 */

/*
 * Define the following macros to enable debug logging of the DTrace proc,
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
1772
1773
1774
1775
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
1348
1349
1350
1351
1352








+
+

-
-
+
-















-
-
+
+











-
-
+
+












-
+
-








-
-
-
+
+
+

-
+










-
+







#define TCL_DTRACE_DEBUG_LOG_ENABLED 1
#define TCL_DTRACE_DEBUG_INST_PROBES 1
*/

#if !(defined(TCL_DTRACE_DEBUG) && defined(__GNUC__))

#ifdef USE_DTRACE

#include "tclDTrace.h"

#if defined(__GNUC__) && __GNUC__ > 2
/*
 * Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks.
/* Use gcc branch prediction hint to minimize cost of DTrace ENABLED checks. */
 */
#define unlikely(x) (__builtin_expect((x), 0))
#else
#define unlikely(x) (x)
#endif

#define TCL_DTRACE_PROC_ENTRY_ENABLED()	    unlikely(TCL_PROC_ENTRY_ENABLED())
#define TCL_DTRACE_PROC_RETURN_ENABLED()    unlikely(TCL_PROC_RETURN_ENABLED())
#define TCL_DTRACE_PROC_RESULT_ENABLED()    unlikely(TCL_PROC_RESULT_ENABLED())
#define TCL_DTRACE_PROC_ARGS_ENABLED()	    unlikely(TCL_PROC_ARGS_ENABLED())
#define TCL_DTRACE_PROC_INFO_ENABLED()	    unlikely(TCL_PROC_INFO_ENABLED())
#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   TCL_PROC_ENTRY(a0, a1, a2)
#define TCL_DTRACE_PROC_RETURN(a0, a1)	    TCL_PROC_RETURN(a0, a1)
#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) TCL_PROC_RESULT(a0, a1, a2, a3)
#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TCL_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
	TCL_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \
	TCL_PROC_INFO(a0, a1, a2, a3, a4, a5)

#define TCL_DTRACE_CMD_ENTRY_ENABLED()	    unlikely(TCL_CMD_ENTRY_ENABLED())
#define TCL_DTRACE_CMD_RETURN_ENABLED()	    unlikely(TCL_CMD_RETURN_ENABLED())
#define TCL_DTRACE_CMD_RESULT_ENABLED()	    unlikely(TCL_CMD_RESULT_ENABLED())
#define TCL_DTRACE_CMD_ARGS_ENABLED()	    unlikely(TCL_CMD_ARGS_ENABLED())
#define TCL_DTRACE_CMD_INFO_ENABLED()	    unlikely(TCL_CMD_INFO_ENABLED())
#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2)    TCL_CMD_ENTRY(a0, a1, a2)
#define TCL_DTRACE_CMD_RETURN(a0, a1)	    TCL_CMD_RETURN(a0, a1)
#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) TCL_CMD_RESULT(a0, a1, a2, a3)
#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TCL_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)
#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
	TCL_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7)
#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \
	TCL_CMD_INFO(a0, a1, a2, a3, a4, a5)

#define TCL_DTRACE_INST_START_ENABLED()	    unlikely(TCL_INST_START_ENABLED())
#define TCL_DTRACE_INST_DONE_ENABLED()	    unlikely(TCL_INST_DONE_ENABLED())
#define TCL_DTRACE_INST_START(a0, a1, a2)   TCL_INST_START(a0, a1, a2)
#define TCL_DTRACE_INST_DONE(a0, a1, a2)    TCL_INST_DONE(a0, a1, a2)

#define TCL_DTRACE_TCL_PROBE_ENABLED()	    unlikely(TCL_TCL_PROBE_ENABLED())
#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TCL_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9)

#define TCL_DTRACE_DEBUG_LOG()

MODULE_SCOPE void	TclDTraceInfo(Tcl_Obj *info, const char **args,
MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);
			    int *argsi);

#else /* USE_DTRACE */

#define TCL_DTRACE_PROC_ENTRY_ENABLED()	    0
#define TCL_DTRACE_PROC_RETURN_ENABLED()    0
#define TCL_DTRACE_PROC_RESULT_ENABLED()    0
#define TCL_DTRACE_PROC_ARGS_ENABLED()	    0
#define TCL_DTRACE_PROC_INFO_ENABLED()	    0
#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   {if (a0) {}}
#define TCL_DTRACE_PROC_RETURN(a0, a1)	    {if (a0) {}}
#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {if (a0) {}; if (a3) {}}
#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2)   {}
#define TCL_DTRACE_PROC_RETURN(a0, a1)	    {}
#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) {}
#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) {}

#define TCL_DTRACE_CMD_ENTRY_ENABLED()	    0
#define TCL_DTRACE_CMD_RETURN_ENABLED()	    0
#define TCL_DTRACE_CMD_RESULT_ENABLED()	    0
#define TCL_DTRACE_CMD_ARGS_ENABLED()	    0
#define TCL_DTRACE_CMD_INFO_ENABLED()	    0
#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2)    {}
#define TCL_DTRACE_CMD_RETURN(a0, a1)	    {}
#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) {}
#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) {}
#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) {}
#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) {}

#define TCL_DTRACE_INST_START_ENABLED()	    0
#define TCL_DTRACE_INST_DONE_ENABLED()	    0
#define TCL_DTRACE_INST_START(a0, a1, a2)   {}
#define TCL_DTRACE_INST_DONE(a0, a1, a2)    {}

#define TCL_DTRACE_TCL_PROBE_ENABLED()	    0
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
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
1893
1894
1895
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
1439
1440
1441
1442
1443
1444
1445
1446


1447
1448

1449

1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461







-
+


-
-
-
-
+
+
+
+
-
-
+
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
+
-
-
+

















-
-
-
+
+
+

















-
-
-
+
+
+










-
-
+

-
+
-












#undef TCL_DTRACE_DEBUG_INST_PROBES
#define TCL_DTRACE_DEBUG_INST_PROBES 0
#endif

MODULE_SCOPE int tclDTraceDebugEnabled, tclDTraceDebugIndent;
MODULE_SCOPE FILE *tclDTraceDebugLog;
MODULE_SCOPE void TclDTraceOpenDebugLog(void);
MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, int *argsi);
MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, char **args, int *argsi);

#define TCL_DTRACE_DEBUG_LOG() \
    int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;	\
    int tclDTraceDebugIndent = 0;				\
    FILE *tclDTraceDebugLog = NULL;				\
    void TclDTraceOpenDebugLog(void) {				\
	int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED;\
	int tclDTraceDebugIndent = 0; \
	FILE *tclDTraceDebugLog = NULL; \
	void TclDTraceOpenDebugLog(void) { char n[35]; \
	char n[35];						\
	sprintf(n, "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log",		\
	sprintf(n, "/tmp/tclDTraceDebug-%lu.log", (unsigned long) getpid()); \
		(size_t) getpid());			\
	tclDTraceDebugLog = fopen(n, "a");			\
    }
	tclDTraceDebugLog = fopen(n, "a"); } \


#define TclDTraceDbgMsg(p, m, ...) \
#define TclDTraceDbgMsg(p, m, ...) do { if (tclDTraceDebugEnabled) { \
    do {								\
	if (tclDTraceDebugEnabled) {					\
	    int _l, _t = 0;						\
	    if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); }	\
	    fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n",			\
		    strrchr(__FILE__, '/')+1, __LINE__, &_l); _t += _l; \
	    fprintf(tclDTraceDebugLog, " %.*s():%n",			\
		    (_t < 18 ? 18 - _t : 0) + 18, __func__, &_l); _t += _l; \
	    fprintf(tclDTraceDebugLog, "%*s" p "%n",			\
	int _l, _t = 0; if (!tclDTraceDebugLog) { TclDTraceOpenDebugLog(); } \
	fprintf(tclDTraceDebugLog, "%.12s:%.4d:%n", strrchr(__FILE__, '/') + \
		1, __LINE__, &_l); _t += _l; \
	fprintf(tclDTraceDebugLog, " %.*s():%n", (_t < 18 ? 18 - _t : 0) + \
		18, __func__, &_l); _t += _l; \
	fprintf(tclDTraceDebugLog, "%*s" p "%n", (_t < 40 ? 40 - _t : 0) + \
		    (_t < 40 ? 40 - _t : 0) + 2 * tclDTraceDebugIndent, \
		    "", &_l); _t += _l;					\
	    fprintf(tclDTraceDebugLog, "%*s" m "\n",			\
		2 * tclDTraceDebugIndent, "", &_l); _t += _l; \
	fprintf(tclDTraceDebugLog, "%*s" m "\n", (_t < 64 ? 64 - _t : 1), "", \
		    (_t < 64 ? 64 - _t : 1), "", ##__VA_ARGS__);	\
	    fflush(tclDTraceDebugLog);					\
		##__VA_ARGS__); fflush(tclDTraceDebugLog); \
	}								\
    } while (0)
	} } while (0)

#define TCL_DTRACE_PROC_ENTRY_ENABLED()	    1
#define TCL_DTRACE_PROC_RETURN_ENABLED()    1
#define TCL_DTRACE_PROC_RESULT_ENABLED()    1
#define TCL_DTRACE_PROC_ARGS_ENABLED()	    1
#define TCL_DTRACE_PROC_INFO_ENABLED()	    1
#define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \
	tclDTraceDebugIndent++; \
	TclDTraceDbgMsg("-> proc-entry", "%s %d %p", a0, a1, a2)
#define TCL_DTRACE_PROC_RETURN(a0, a1) \
	TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \
	tclDTraceDebugIndent--
#define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \
	TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3)
#define TCL_DTRACE_PROC_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TclDTraceDbgMsg(" | proc-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
		a1, a2, a3, a4, a5, a6, a7, a8, a9)
#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
	TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d %s %s", a0, a1, \
		a2, a3, a4, a5, a6, a7)
#define TCL_DTRACE_PROC_INFO(a0, a1, a2, a3, a4, a5) \
	TclDTraceDbgMsg(" | proc-info", "%s %s %s %s %d %d", a0, a1, \
		a2, a3, a4, a5)

#define TCL_DTRACE_CMD_ENTRY_ENABLED()	    1
#define TCL_DTRACE_CMD_RETURN_ENABLED()	    1
#define TCL_DTRACE_CMD_RESULT_ENABLED()	    1
#define TCL_DTRACE_CMD_ARGS_ENABLED()	    1
#define TCL_DTRACE_CMD_INFO_ENABLED()	    1
#define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \
	tclDTraceDebugIndent++; \
	TclDTraceDbgMsg("-> cmd-entry", "%s %d %p", a0, a1, a2)
#define TCL_DTRACE_CMD_RETURN(a0, a1) \
	TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \
	tclDTraceDebugIndent--
#define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \
	TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3)
#define TCL_DTRACE_CMD_ARGS(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
	TclDTraceDbgMsg(" | cmd-args", "%s %s %s %s %s %s %s %s %s %s", a0, \
		a1, a2, a3, a4, a5, a6, a7, a8, a9)
#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5, a6, a7) \
	TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d %s %s", a0, a1, \
		a2, a3, a4, a5, a6, a7)
#define TCL_DTRACE_CMD_INFO(a0, a1, a2, a3, a4, a5) \
	TclDTraceDbgMsg(" | cmd-info", "%s %s %s %s %d %d", a0, a1, \
		a2, a3, a4, a5)

#define TCL_DTRACE_INST_START_ENABLED()	    TCL_DTRACE_DEBUG_INST_PROBES
#define TCL_DTRACE_INST_DONE_ENABLED()	    TCL_DTRACE_DEBUG_INST_PROBES
#define TCL_DTRACE_INST_START(a0, a1, a2) \
	TclDTraceDbgMsg(" | inst-start", "%s %d %p", a0, a1, a2)
#define TCL_DTRACE_INST_DONE(a0, a1, a2) \
	TclDTraceDbgMsg(" | inst-end", "%s %d %p", a0, a1, a2)

#define TCL_DTRACE_TCL_PROBE_ENABLED()	    1
#define TCL_DTRACE_TCL_PROBE(a0, a1, a2, a3, a4, a5, a6, a7, a8, a9) \
    do {								\
	tclDTraceDebugEnabled = 1;					\
	tclDTraceDebugEnabled = 1; \
	TclDTraceDbgMsg(" | tcl-probe", "%s %s %s %s %s %s %s %s %s %s", a0, \
		a1, a2, a3, a4, a5, a6, a7, a8, a9);			\
		a1, a2, a3, a4, a5, a6, a7, a8, a9)
    } while (0)

#endif /* TCL_DTRACE_DEBUG */

#endif /* _TCLCOMPILATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclConfig.c.

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
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







-
+









-
-
+
+
+
+
-

+
+








/*
 * A ClientData struct for the QueryConfig command.  Store the three bits
 * of data we need; the package name for which we store a config dict,
 * the (Tcl_Interp *) in which it is stored, and the encoding.
 */

typedef struct {
typedef struct QCCD {
    Tcl_Obj *pkg;
    Tcl_Interp *interp;
    char *encoding;
} QCCD;

/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc		QueryConfigObjCmd;
static Tcl_CmdDeleteProc	QueryConfigDelete;
static int		QueryConfigObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    struct Tcl_Obj *CONST *objv);
static void		QueryConfigDelete(ClientData clientData);
static Tcl_InterpDeleteProc	ConfigDictDeleteProc;
static Tcl_Obj *	GetConfigDict(Tcl_Interp *interp);
static void		ConfigDictDeleteProc(ClientData clientData,
			    Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RegisterConfig --
 *
 *	See TIP#59 for details on what this function does.
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
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







-
+


-
-
+
+




-
-
+
+



-
+







 *----------------------------------------------------------------------
 */

void
Tcl_RegisterConfig(
    Tcl_Interp *interp,		/* Interpreter the configuration command is
				 * registered in. */
    const char *pkgName,	/* Name of the package registering the
    CONST char *pkgName,	/* Name of the package registering the
				 * embedded configuration. ASCII, thus in
				 * UTF-8 too. */
    const Tcl_Config *configuration,	/* Embedded configuration. */
    const char *valEncoding)	/* Name of the encoding used to store the
    Tcl_Config *configuration,	/* Embedded configuration. */
    CONST char *valEncoding)	/* Name of the encoding used to store the
				 * configuration values, ASCII, thus UTF-8. */
{
    Tcl_Obj *pDB, *pkgDict;
    Tcl_DString cmdName;
    const Tcl_Config *cfg;
    QCCD *cdPtr = (QCCD *)Tcl_Alloc(sizeof(QCCD));
    Tcl_Config *cfg;
    QCCD *cdPtr = (QCCD *)ckalloc(sizeof(QCCD));

    cdPtr->interp = interp;
    if (valEncoding) {
	cdPtr->encoding = (char *)Tcl_Alloc(strlen(valEncoding)+1);
	cdPtr->encoding = ckalloc(strlen(valEncoding)+1);
	strcpy(cdPtr->encoding, valEncoding);
    } else {
	cdPtr->encoding = NULL;
    }
    cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);

    /*
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
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







-
+

















-
+


-
+








    /*
     * Now create the interface command for retrieval of the package
     * information.
     */

    Tcl_DStringInit(&cmdName);
    TclDStringAppendLiteral(&cmdName, "::");
    Tcl_DStringAppend(&cmdName, "::", -1);
    Tcl_DStringAppend(&cmdName, pkgName, -1);

    /*
     * The incomplete command name is the name of the namespace to place it
     * in.
     */

    if (Tcl_FindNamespace(interp, Tcl_DStringValue(&cmdName), NULL,
	    TCL_GLOBAL_ONLY) == NULL) {
	if (Tcl_CreateNamespace(interp, Tcl_DStringValue(&cmdName),
		NULL, NULL) == NULL) {
	    Tcl_Panic("%s.\n%s: %s",
		    Tcl_GetStringResult(interp), "Tcl_RegisterConfig",
		    "Unable to create namespace for package configuration.");
	}
    }

    TclDStringAppendLiteral(&cmdName, "::pkgconfig");
    Tcl_DStringAppend(&cmdName, "::pkgconfig", -1);

    if (Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdName),
	    QueryConfigObjCmd, cdPtr, QueryConfigDelete) == NULL) {
	    QueryConfigObjCmd, (ClientData) cdPtr, QueryConfigDelete) == NULL) {
	Tcl_Panic("%s: %s", "Tcl_RegisterConfig",
		"Unable to create query command for package configuration");
    }

    Tcl_DStringFree(&cmdName);
}

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
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







-
+

-
+


-
-
-
+
+







-
+


-
+















-
+
-
-












-
+
-
-













-
+












-
-
+
+


-
-
-
+
+



-
+







 */

static int
QueryConfigObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    struct Tcl_Obj *const *objv)
    struct Tcl_Obj *CONST *objv)
{
    QCCD *cdPtr = (QCCD *)clientData;
    QCCD *cdPtr = (QCCD *) clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB, *pkgDict, *val, *listPtr;
    size_t n = 0;
    int index, m;
    static const char *const subcmdStrings[] = {
    int n, index;
    static CONST char *subcmdStrings[] = {
	"get", "list", NULL
    };
    enum subcmds {
	CFG_GET, CFG_LIST
    };
    Tcl_DString conv;
    Tcl_Encoding venc = NULL;
    const char *value;
    CONST char *value;

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmdStrings, "subcommand", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    pDB = GetConfigDict(interp);
    if (Tcl_DictObjGet(interp, pDB, pkgName, &pkgDict) != TCL_OK
	    || pkgDict == NULL) {
	/*
	 * Maybe a Tcl_Panic is better, because the package data has to be
	 * present.
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
	Tcl_SetResult(interp, "package not known", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
		TclGetString(pkgName), NULL);
	return TCL_ERROR;
    }

    switch ((enum subcmds) index) {
    case CFG_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "key");
	    return TCL_ERROR;
	}

	if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
		|| val == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
	    Tcl_SetResult(interp, "key not known", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	if (cdPtr->encoding) {
	    venc = Tcl_GetEncoding(interp, cdPtr->encoding);
	    if (!venc) {
		return TCL_ERROR;
	    }
	}
	/*
	 * Value is stored as-is in a byte array, see Bug [9b2e636361],
	 * so we have to decode it first.
	 */
	value = (const char *) TclGetByteArrayFromObj(val, &n);
	value = (const char *) Tcl_GetByteArrayFromObj(val, &n);
	value = Tcl_ExternalToUtfDString(venc, value, n, &conv);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(value,
		Tcl_DStringLength(&conv)));
	Tcl_DStringFree(&conv);
	return TCL_OK;

    case CFG_LIST:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}

	Tcl_DictObjSize(interp, pkgDict, &m);
	listPtr = Tcl_NewListObj(m, NULL);
	Tcl_DictObjSize(interp, pkgDict, &n);
	listPtr = Tcl_NewListObj(n, NULL);

	if (!listPtr) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "insufficient memory to create list", -1));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    Tcl_SetResult(interp, "insufficient memory to create list",
		    TCL_STATIC);
	    return TCL_ERROR;
	}

	if (m) {
	if (n) {
	    Tcl_DictSearch s;
	    Tcl_Obj *key;
	    int done;

	    for (Tcl_DictObjFirst(interp, pkgDict, &s, &key, NULL, &done);
		    !done; Tcl_DictObjNext(&s, &key, NULL, &done)) {
		Tcl_ListObjAppendElement(NULL, listPtr, key);
320
321
322
323
324
325
326
327

328
329
330
331
332
333
334

335
336

337
338
339
340
341
342
343
317
318
319
320
321
322
323

324
325
326
327
328
329
330

331
332

333
334
335
336
337
338
339
340







-
+






-
+

-
+







 *-------------------------------------------------------------------------
 */

static void
QueryConfigDelete(
    ClientData clientData)
{
    QCCD *cdPtr = (QCCD *)clientData;
    QCCD *cdPtr = (QCCD *) clientData;
    Tcl_Obj *pkgName = cdPtr->pkg;
    Tcl_Obj *pDB = GetConfigDict(cdPtr->interp);

    Tcl_DictObjRemove(NULL, pDB, pkgName);
    Tcl_DecrRefCount(pkgName);
    if (cdPtr->encoding) {
	Tcl_Free(cdPtr->encoding);
	ckfree((char *)cdPtr->encoding);
    }
    Tcl_Free(cdPtr);
    ckfree((char *)cdPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * GetConfigDict --
 *
353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
350
351
352
353
354
355
356

357
358
359
360
361
362
363
364







-
+







 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
GetConfigDict(
    Tcl_Interp *interp)
{
    Tcl_Obj *pDB = (Tcl_Obj *)Tcl_GetAssocData(interp, ASSOC_KEY, NULL);
    Tcl_Obj *pDB = Tcl_GetAssocData(interp, ASSOC_KEY, NULL);

    if (pDB == NULL) {
	pDB = Tcl_NewDictObj();
	Tcl_IncrRefCount(pDB);
	Tcl_SetAssocData(interp, ASSOC_KEY, ConfigDictDeleteProc, pDB);
    }

386
387
388
389
390
391
392
393

394


395

396
397
398
399
400
401
402
403
404
383
384
385
386
387
388
389

390
391
392
393

394
395
396
397
398
399
400
401
402
403







-
+

+
+
-
+









 *
 *----------------------------------------------------------------------
 */

static void
ConfigDictDeleteProc(
    ClientData clientData,	/* Pointer to Tcl_Obj. */
    TCL_UNUSED(Tcl_Interp *))
    Tcl_Interp *interp)		/* Interpreter being deleted. */
{
    Tcl_Obj *pDB = (Tcl_Obj *) clientData;

    Tcl_DecrRefCount((Tcl_Obj *)clientData);
    Tcl_DecrRefCount(pDB);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclDTrace.d.

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
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





-
+




















-
+






-
+








-
-
+







-
-
+
+
-
-
+










-
-

-
-
+
+
-









-
+






-
+








-
-
+







-
-
+
+
-
-
+










-
-

-
-
+
+
-









-
+







-
+







/*
 * tclDTrace.d --
 *
 *	Tcl DTrace provider.
 *
 * Copyright (c) 2007-2008 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

typedef struct Tcl_Obj Tcl_Obj;

/*
 * Tcl DTrace probes
 */

provider tcl {
    /***************************** proc probes *****************************/
    /*
     *	tcl*:::proc-entry probe
     *	    triggered immediately before proc bytecode execution
     *		arg0: proc name				(string)
     *		arg1: number of arguments		(int)
     *		arg2: array of proc argument objects	(Tcl_Obj**)
     */
    probe proc__entry(const char *name, int objc, struct Tcl_Obj **objv);
    probe proc__entry(char* name, int objc, struct Tcl_Obj **objv);
    /*
     *	tcl*:::proc-return probe
     *	    triggered immediately after proc bytecode execution
     *		arg0: proc name				(string)
     *		arg1: return code			(int)
     */
    probe proc__return(const char *name, int code);
    probe proc__return(char* name, int code);
    /*
     *	tcl*:::proc-result probe
     *	    triggered after proc-return probe and result processing
     *		arg0: proc name				(string)
     *		arg1: return code			(int)
     *		arg2: proc result			(string)
     *		arg3: proc result object		(Tcl_Obj*)
     */
    probe proc__result(const char *name, int code, const char *result,
	    struct Tcl_Obj *resultobj);
    probe proc__result(char* name, int code, char* result, struct Tcl_Obj *resultobj);
    /*
     *	tcl*:::proc-args probe
     *	    triggered before proc-entry probe, gives access to string
     *	    representation of proc arguments
     *		arg0: proc name				(string)
     *		arg1-arg9: proc arguments or NULL	(strings)
     */
    probe proc__args(const char *name, const char *arg1, const char *arg2,
	    const char *arg3, const char *arg4, const char *arg5,
    probe proc__args(char* name, char* arg1, char* arg2, char* arg3,
	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
	    const char *arg6, const char *arg7, const char *arg8,
	    const char *arg9);
	    char* arg9);
    /*
     *	tcl*:::proc-info probe
     *	    triggered before proc-entry probe, gives access to TIP 280
     *	    information for the proc invocation (i.e. [info frame 0])
     *		arg0: TIP 280 cmd			(string)
     *		arg1: TIP 280 type			(string)
     *		arg2: TIP 280 proc			(string)
     *		arg3: TIP 280 file			(string)
     *		arg4: TIP 280 line			(int)
     *		arg5: TIP 280 level			(int)
     *		arg6: TclOO method			(string)
     *		arg7: TclOO class/object		(string)
     */
    probe proc__info(const char *cmd, const char *type, const char *proc,
	    const char *file, int line, int level, const char *method,
    probe proc__info(char* cmd, char* type, char* proc, char* file, int line,
	    int level);
	    const char *class);

    /***************************** cmd probes ******************************/
    /*
     *	tcl*:::cmd-entry probe
     *	    triggered immediately before commmand execution
     *		arg0: command name			(string)
     *		arg1: number of arguments		(int)
     *		arg2: array of command argument objects	(Tcl_Obj**)
     */
    probe cmd__entry(const char *name, int objc, struct Tcl_Obj **objv);
    probe cmd__entry(char* name, int objc, struct Tcl_Obj **objv);
    /*
     *	tcl*:::cmd-return probe
     *	    triggered immediately after commmand execution
     *		arg0: command name			(string)
     *		arg1: return code			(int)
     */
    probe cmd__return(const char *name, int code);
    probe cmd__return(char* name, int code);
    /*
     *	tcl*:::cmd-result probe
     *	    triggered after cmd-return probe and result processing
     *		arg0: command name			(string)
     *		arg1: return code			(int)
     *		arg2: command result			(string)
     *		arg3: command result object		(Tcl_Obj*)
     */
    probe cmd__result(const char *name, int code, const char *result,
	    struct Tcl_Obj *resultobj);
    probe cmd__result(char* name, int code, char* result, struct Tcl_Obj *resultobj);
    /*
     *	tcl*:::cmd-args probe
     *	    triggered before cmd-entry probe, gives access to string
     *	    representation of command arguments
     *		arg0: command name			(string)
     *		arg1-arg9: command arguments or NULL	(strings)
     */
    probe cmd__args(const char *name, const char *arg1, const char *arg2,
	    const char *arg3, const char *arg4, const char *arg5,
    probe cmd__args(char* name, char* arg1, char* arg2, char* arg3,
	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
	    const char *arg6, const char *arg7, const char *arg8,
	    const char *arg9);
	    char* arg9);
    /*
     *	tcl*:::cmd-info probe
     *	    triggered before cmd-entry probe, gives access to TIP 280
     *	    information for the command invocation (i.e. [info frame 0])
     *		arg0: TIP 280 cmd			(string)
     *		arg1: TIP 280 type			(string)
     *		arg2: TIP 280 proc			(string)
     *		arg3: TIP 280 file			(string)
     *		arg4: TIP 280 line			(int)
     *		arg5: TIP 280 level			(int)
     *		arg6: TclOO method			(string)
     *		arg7: TclOO class/object		(string)
     */
    probe cmd__info(const char *cmd, const char *type, const char *proc,
	    const char *file, int line, int level, const char *method,
    probe cmd__info(char* cmd, char* type, char* proc, char* file, int line,
	    int level);
	    const char *class);

    /***************************** inst probes *****************************/
    /*
     *	tcl*:::inst-start probe
     *	    triggered immediately before execution of a bytecode
     *		arg0: bytecode name			(string)
     *		arg1: depth of stack			(int)
     *		arg2: top of stack			(Tcl_Obj**)
     */
    probe inst__start(const char *name, int depth, struct Tcl_Obj **stack);
    probe inst__start(char* name, int depth, struct Tcl_Obj **stack);
    /*
     *	tcl*:::inst-done probe
     *	    triggered immediately after execution of a bytecode
     *		arg0: bytecode name			(string)
     *		arg1: depth of stack			(int)
     *		arg2: top of stack			(Tcl_Obj**)
     */
    probe inst__done(const char *name, int depth, struct Tcl_Obj **stack);
    probe inst__done(char* name, int depth, struct Tcl_Obj **stack);

    /***************************** obj probes ******************************/
    /*
     *	tcl*:::obj-create probe
     *	    triggered immediately after a new Tcl_Obj has been created
     *		arg0: object created			(Tcl_Obj*)
     */
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
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







-
-
+
+
-
-
+







-
+







-
+

-
-
+
+








    /***************************** tcl probes ******************************/
    /*
     *	tcl*:::tcl-probe probe
     *	    triggered when the ::tcl::dtrace command is called
     *		arg0-arg9: command arguments		(strings)
     */
    probe tcl__probe(const char *arg0, const char *arg1, const char *arg2,
	    const char *arg3, const char *arg4, const char *arg5,
    probe tcl__probe(char* arg0, char* arg1, char* arg2, char* arg3,
	    char* arg4, char* arg5, char* arg6, char* arg7, char* arg8,
	    const char *arg6, const char *arg7, const char *arg8,
	    const char *arg9);
	    char* arg9);
};

/*
 * Tcl types and constants for use in DTrace scripts
 */

typedef struct Tcl_ObjType {
    const char *name;
    char *name;
    void *freeIntRepProc;
    void *dupIntRepProc;
    void *updateStringProc;
    void *setFromAnyProc;
} Tcl_ObjType;

struct Tcl_Obj {
    size_t refCount;
    int refCount;
    char *bytes;
    size_t length;
    const Tcl_ObjType *typePtr;
    int length;
    Tcl_ObjType *typePtr;
    union {
	long longValue;
	double doubleValue;
	void *otherValuePtr;
	int64_t wideValue;
	struct {
	    void *ptr1;

Changes to generic/tclDate.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

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
-
+

-
+

+
-
+

-
+

-
-
+
+







-
+
+
+







/* A Bison parser, made by GNU Bison 3.1.  */
/* A Bison parser, made by GNU Bison 2.3.  */

/* Bison implementation for Yacc-like parsers in C
/* Skeleton implementation for Bison's Yacc-like parsers in C

   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
   Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc.
   Free Software Foundation, Inc.

   This program is free software: you can redistribute it and/or modify
   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation, either version 3 of the License, or
   (at your option) any later version.
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
   along with this program; if not, write to the Free Software
   Foundation, Inc., 51 Franklin Street, Fifth Floor,
   Boston, MA 02110-1301, USA.  */

/* As a special exception, you may create a larger work that contains
   part or all of the Bison parser skeleton and distribute that work
   under terms of your choice, so long as that work isn't itself a
   parser generator using the skeleton or a modified version thereof
   as a parser skeleton.  Alternatively, if you modify or redistribute
   the parser skeleton itself, you may (at your option) remove this
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
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







-
+







-
-
-
+
-
-
+

-

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-












-
-
-
-
-
-
-
-


















-
+







   define necessary library symbols; they are noted "INFRINGES ON
   USER NAME SPACE" below.  */

/* Identify Bison output.  */
#define YYBISON 1

/* Bison version.  */
#define YYBISON_VERSION "3.1"
#define YYBISON_VERSION "2.3"

/* Skeleton name.  */
#define YYSKELETON_NAME "yacc.c"

/* Pure parsers.  */
#define YYPURE 1

/* Push parsers.  */
#define YYPUSH 0

/* Using locations.  */
/* Pull parsers.  */
#define YYPULL 1
#define YYLSP_NEEDED 1


/* Substitute the variable and function names.  */
#define yyparse         TclDateparse
#define yylex           TclDatelex
#define yyerror         TclDateerror
#define yydebug         TclDatedebug
#define yynerrs         TclDatenerrs
#define yyparse TclDateparse
#define yylex   TclDatelex
#define yyerror TclDateerror
#define yylval  TclDatelval
#define yychar  TclDatechar
#define yydebug TclDatedebug
#define yynerrs TclDatenerrs
#define yylloc TclDatelloc

/* Tokens.  */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
   /* Put the tokens into the symbol table, so that GDB and other debuggers
      know about them.  */
   enum yytokentype {
     tAGO = 258,
     tDAY = 259,
     tDAYZONE = 260,
     tID = 261,
     tMERIDIAN = 262,
     tMONTH = 263,
     tMONTH_UNIT = 264,
     tSTARDATE = 265,
     tSEC_UNIT = 266,
     tSNUMBER = 267,
     tUNUMBER = 268,
     tZONE = 269,
     tEPOCH = 270,
     tDST = 271,
     tISOBASE = 272,
     tDAY_UNIT = 273,
     tNEXT = 274
   };
#endif
/* Tokens.  */
#define tAGO 258
#define tDAY 259
#define tDAYZONE 260
#define tID 261
#define tMERIDIAN 262
#define tMONTH 263
#define tMONTH_UNIT 264
#define tSTARDATE 265
#define tSEC_UNIT 266
#define tSNUMBER 267
#define tUNUMBER 268
#define tZONE 269
#define tEPOCH 270
#define tDST 271
#define tISOBASE 272
#define tDAY_UNIT 273
#define tNEXT 274




/* Copy the first part of user declarations.  */


/*
 * tclDate.c --
 *
 *	This file is generated from a yacc grammar defined in the file
 *	tclGetDate.y. It should not be edited directly.
 *
 * Copyright (c) 1992-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
#include "tclInt.h"

/*
 * Bison generates several labels that happen to be unused. MS Visual C++
 * doesn't like that, and complains. Tell it to shut up.
 */

#ifdef _MSC_VER
#pragma warning( disable : 4102 )
#endif /* _MSC_VER */

/*
 * Meridian: am, pm, or 24-hour style.
 */

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
 * parsed fields will be returned.
 */

typedef struct DateInfo {

    Tcl_Obj* messages;		/* Error messages */
    const char* separatrix;	/* String separating messages */

    time_t dateYear;
    time_t dateMonth;
    time_t dateDay;
    int dateHaveDate;

    time_t dateHour;
    time_t dateMinutes;
    time_t dateSeconds;
    MERIDIAN dateMeridian;
    int dateMeridian;
    int dateHaveTime;

    time_t dateTimezone;
    int dateDSTmode;
    int dateHaveZone;

    time_t dateRelMonth;
142
143
144
145
146
147
148
149
150


151
152
153
154
155
156
157
181
182
183
184
185
186
187


188
189
190
191
192
193
194
195
196







-
-
+
+







    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((void*) (x)))
#define YYMALLOC	ckalloc
#define YYFREE(x)	(ckfree((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#define yyMonthOrdinal	(info->dateMonthOrdinal)
#define yyHaveDate	(info->dateHaveDate)
#define yyHaveDay	(info->dateHaveDay)
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
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







+
+
+
+
+
+
+



+
-
+
-
-
-
-
+
-
-
+









-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-

-
-
-
-
+
+
+
-


-
-
+
+
-

-
-
-
+
+
+
+


-

-
+
-





-
+
+



-
-
-
-
-







 * Daylight-savings mode: on, off, or not yet known.
 */

typedef enum _DSTMODE {
    DSTon, DSToff, DSTmaybe
} DSTMODE;

/*
 * Meridian: am, pm, or 24-hour style.
 */

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;



/* Enabling traces.  */
# ifndef YY_NULLPTR
#ifndef YYDEBUG
#  if defined __cplusplus && 201103L <= __cplusplus
#   define YY_NULLPTR nullptr
#  else
#   define YY_NULLPTR 0
# define YYDEBUG 0
#  endif
# endif
#endif

/* Enabling verbose error messages.  */
#ifdef YYERROR_VERBOSE
# undef YYERROR_VERBOSE
# define YYERROR_VERBOSE 1
#else
# define YYERROR_VERBOSE 0
#endif


/* Enabling the token table.  */
/* Debug traces.  */
#ifndef YYDEBUG
# define YYDEBUG 0
#endif
#if YYDEBUG
extern int TclDatedebug;
#endif

/* Token type.  */
#ifndef YYTOKENTYPE
# define YYTOKENTYPE
#ifndef YYTOKEN_TABLE
# define YYTOKEN_TABLE 0
  enum yytokentype
  {
    tAGO = 258,
    tDAY = 259,
    tDAYZONE = 260,
    tID = 261,
    tMERIDIAN = 262,
    tMONTH = 263,
    tMONTH_UNIT = 264,
    tSTARDATE = 265,
    tSEC_UNIT = 266,
    tSNUMBER = 267,
    tUNUMBER = 268,
    tZONE = 269,
    tEPOCH = 270,
    tDST = 271,
    tISOBASE = 272,
    tDAY_UNIT = 273,
    tNEXT = 274
  };
#endif

/* Value type.  */
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED

union YYSTYPE
{

typedef union YYSTYPE

{

    time_t Number;
    enum _MERIDIAN Meridian;


}
/* Line 187 of yacc.c.  */
};

typedef union YYSTYPE YYSTYPE;
# define YYSTYPE_IS_TRIVIAL 1
# define YYSTYPE_IS_DECLARED 1
	YYSTYPE;
# define yystype YYSTYPE /* obsolescent; will be withdrawn */
# define YYSTYPE_IS_DECLARED 1
# define YYSTYPE_IS_TRIVIAL 1
#endif

/* Location type.  */
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
typedef struct YYLTYPE YYLTYPE;
typedef struct YYLTYPE
struct YYLTYPE
{
  int first_line;
  int first_column;
  int last_line;
  int last_column;
};
} YYLTYPE;
# define yyltype YYLTYPE /* obsolescent; will be withdrawn */
# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif



int TclDateparse (DateInfo* info);



/* Copy the second part of user declarations.  */



/*
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
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
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
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

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
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







+
+













+
+
+

-
+





-
+





-
+





-
-
-
-
-

-
+






-
+


-
+



-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+

-
+


-
+
-
-
+
-
-
-
-
+
-

-
+
-
-
-
+
-
-
-
+
+
+
+
+
-
+

-
+
+
+
+


















-
+
+

-
-
-
+
+







-
-
+
+













-
+

-
+

-
-
+
+




-
+
+





-
+
+









-
-
+
+




-
-
-
+
+
+











+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+







-
-
+
+

-
+
-



-
-
+
+

-
+
-






-
+







				   DateInfo* info);
static time_t		ToSeconds(time_t Hours, time_t Minutes,
			    time_t Seconds, MERIDIAN Meridian);
MODULE_SCOPE int	yyparse(DateInfo*);



/* Line 216 of yacc.c.  */


#ifdef short
# undef short
#endif

#ifdef YYTYPE_UINT8
typedef YYTYPE_UINT8 yytype_uint8;
#else
typedef unsigned char yytype_uint8;
#endif

#ifdef YYTYPE_INT8
typedef YYTYPE_INT8 yytype_int8;
#elif (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
typedef signed char yytype_int8;
#else
typedef signed char yytype_int8;
typedef short int yytype_int8;
#endif

#ifdef YYTYPE_UINT16
typedef YYTYPE_UINT16 yytype_uint16;
#else
typedef unsigned short yytype_uint16;
typedef unsigned short int yytype_uint16;
#endif

#ifdef YYTYPE_INT16
typedef YYTYPE_INT16 yytype_int16;
#else
typedef short yytype_int16;
typedef short int yytype_int16;
#endif

#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
#  define YYSIZE_T __SIZE_TYPE__
# elif defined size_t
#  define YYSIZE_T size_t
# elif ! defined YYSIZE_T
#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
#  define YYSIZE_T size_t
# else
#  define YYSIZE_T unsigned
#  define YYSIZE_T size_t
# endif
#endif

#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)

#ifndef YY_
# if defined YYENABLE_NLS && YYENABLE_NLS
# if YYENABLE_NLS
#  if ENABLE_NLS
#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
#   define YY_(msgid) dgettext ("bison-runtime", msgid)
#  endif
# endif
# ifndef YY_
#  define YY_(Msgid) Msgid
#  define YY_(msgid) msgid
# endif
#endif

#ifndef YY_ATTRIBUTE
# if (defined __GNUC__                                               \
      && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__)))  \
     || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C
#  define YY_ATTRIBUTE(Spec) __attribute__(Spec)
# else
#  define YY_ATTRIBUTE(Spec) /* empty */
# endif
#endif

#ifndef YY_ATTRIBUTE_PURE
# define YY_ATTRIBUTE_PURE   YY_ATTRIBUTE ((__pure__))
#endif

#ifndef YY_ATTRIBUTE_UNUSED
# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__))
#endif

#if !defined _Noreturn \
     && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112)
# if defined _MSC_VER && 1200 <= _MSC_VER
#  define _Noreturn __declspec (noreturn)
# else
#  define _Noreturn YY_ATTRIBUTE ((__noreturn__))
# endif
#endif

/* Suppress unused-variable warnings by "using" E.  */
#if ! defined lint || defined __GNUC__
# define YYUSE(E) ((void) (E))
# define YYUSE(e) ((void) (e))
#else
# define YYUSE(E) /* empty */
# define YYUSE(e) /* empty */
#endif

#if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__
/* Identity function, used to suppress warnings about constant conditions.  */
/* Suppress an incorrect diagnostic about yylval being uninitialized.  */
# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \
#ifndef lint
    _Pragma ("GCC diagnostic push") \
    _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\
    _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"")
# define YY_IGNORE_MAYBE_UNINITIALIZED_END \
# define YYID(n) (n)
    _Pragma ("GCC diagnostic pop")
#else
# define YY_INITIAL_VALUE(Value) Value
#if (defined __STDC__ || defined __C99__FUNC__ \
#endif
#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
     || defined __cplusplus || defined _MSC_VER)
# define YY_IGNORE_MAYBE_UNINITIALIZED_END
#endif
#ifndef YY_INITIAL_VALUE
static int
YYID (int i)
#else
static int
YYID (i)
# define YY_INITIAL_VALUE(Value) /* Nothing. */
    int i;
#endif

{
  return i;
}
#endif

#if ! defined yyoverflow || YYERROR_VERBOSE

/* The parser invokes alloca or malloc; define the necessary symbols.  */

# ifdef YYSTACK_USE_ALLOCA
#  if YYSTACK_USE_ALLOCA
#   ifdef __GNUC__
#    define YYSTACK_ALLOC __builtin_alloca
#   elif defined __BUILTIN_VA_ARG_INCR
#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
#   elif defined _AIX
#    define YYSTACK_ALLOC __alloca
#   elif defined _MSC_VER
#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
#    define alloca _alloca
#   else
#    define YYSTACK_ALLOC alloca
#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS
#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
#     ifndef EXIT_SUCCESS
#      define EXIT_SUCCESS 0
#     ifndef _STDLIB_H
#      define _STDLIB_H 1
#     endif
#    endif
#   endif
#  endif
# endif

# ifdef YYSTACK_ALLOC
   /* Pacify GCC's 'empty if-body' warning.  */
#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
   /* Pacify GCC's `empty if-body' warning.  */
#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
#  ifndef YYSTACK_ALLOC_MAXIMUM
    /* The OS might guarantee only one guard page at the bottom of the stack,
       and a page size can be as small as 4096 bytes.  So we cannot safely
       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
       to allow for a few compiler-allocated temporary stack slots.  */
#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
#  endif
# else
#  define YYSTACK_ALLOC YYMALLOC
#  define YYSTACK_FREE YYFREE
#  ifndef YYSTACK_ALLOC_MAXIMUM
#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
#  endif
#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
#  if (defined __cplusplus && ! defined _STDLIB_H \
       && ! ((defined YYMALLOC || defined malloc) \
             && (defined YYFREE || defined free)))
	     && (defined YYFREE || defined free)))
#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
#   ifndef EXIT_SUCCESS
#    define EXIT_SUCCESS 0
#   ifndef _STDLIB_H
#    define _STDLIB_H 1
#   endif
#  endif
#  ifndef YYMALLOC
#   define YYMALLOC malloc
#   if ! defined malloc && ! defined EXIT_SUCCESS
#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
#  ifndef YYFREE
#   define YYFREE free
#   if ! defined free && ! defined EXIT_SUCCESS
#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
void free (void *); /* INFRINGES ON USER NAME SPACE */
#   endif
#  endif
# endif
#endif /* ! defined yyoverflow || YYERROR_VERBOSE */


#if (! defined yyoverflow \
     && (! defined __cplusplus \
         || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
             && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
	 || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
	     && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))

/* A type that is properly aligned for any stack member.  */
union yyalloc
{
  yytype_int16 yyss_alloc;
  YYSTYPE yyvs_alloc;
  YYLTYPE yyls_alloc;
  yytype_int16 yyss;
  YYSTYPE yyvs;
    YYLTYPE yyls;
};

/* The size of the maximum gap between one aligned stack and the next.  */
# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)

/* The size of an array large to enough to hold all stacks, each with
   N elements.  */
# define YYSTACK_BYTES(N) \
     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
      + 2 * YYSTACK_GAP_MAXIMUM)

/* Copy COUNT objects from FROM to TO.  The source and destination do
   not overlap.  */
# ifndef YYCOPY
#  if defined __GNUC__ && 1 < __GNUC__
# define YYCOPY_NEEDED 1
#   define YYCOPY(To, From, Count) \
      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
#  else
#   define YYCOPY(To, From, Count)		\
      do					\
	{					\
	  YYSIZE_T yyi;				\
	  for (yyi = 0; yyi < (Count); yyi++)	\
	    (To)[yyi] = (From)[yyi];		\
	}					\
      while (YYID (0))
#  endif
# endif

/* Relocate STACK from its old location to the new one.  The
   local variables YYSIZE and YYSTACKSIZE give the old and new number of
   elements in the stack, and YYPTR gives the new location of the
   stack.  Advance YYPTR to a properly aligned location for the next
   stack.  */
# define YYSTACK_RELOCATE(Stack_alloc, Stack)                           \
    do                                                                  \
      {                                                                 \
        YYSIZE_T yynewbytes;                                            \
        YYCOPY (&yyptr->Stack_alloc, Stack, yysize);                    \
        Stack = &yyptr->Stack_alloc;                                    \
        yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
        yyptr += yynewbytes / sizeof (*yyptr);                          \
      }                                                                 \
    while (0)
# define YYSTACK_RELOCATE(Stack)					\
    do									\
      {									\
	YYSIZE_T yynewbytes;						\
	YYCOPY (&yyptr->Stack, Stack, yysize);				\
	Stack = &yyptr->Stack;						\
	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
	yyptr += yynewbytes / sizeof (*yyptr);				\
      }									\
    while (YYID (0))

#endif

#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
/* Copy COUNT objects from SRC to DST.  The source and destination do
   not overlap.  */
# ifndef YYCOPY
#  if defined __GNUC__ && 1 < __GNUC__
#   define YYCOPY(Dst, Src, Count) \
      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
#  else
#   define YYCOPY(Dst, Src, Count)              \
      do                                        \
        {                                       \
          YYSIZE_T yyi;                         \
          for (yyi = 0; yyi < (Count); yyi++)   \
            (Dst)[yyi] = (Src)[yyi];            \
        }                                       \
      while (0)
#  endif
# endif
#endif /* !YYCOPY_NEEDED */

/* YYFINAL -- State number of the termination state.  */
#define YYFINAL  2
/* YYLAST -- Last index in YYTABLE.  */
#define YYLAST   81
#define YYLAST   79

/* YYNTOKENS -- Number of terminals.  */
#define YYNTOKENS  26
/* YYNNTS -- Number of nonterminals.  */
#define YYNNTS  16
/* YYNRULES -- Number of rules.  */
#define YYNRULES  56
/* YYNSTATES -- Number of states.  */
#define YYNSTATES  85
/* YYNRULES -- Number of states.  */
#define YYNSTATES  83

/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned
/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
   by yylex, with out-of-bounds checking.  */
#define YYUNDEFTOK  2
#define YYMAXUTOK   274

#define YYTRANSLATE(YYX)                                                \
  ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
#define YYTRANSLATE(YYX)						\
  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)

/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM
/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
   as returned by yylex, without out-of-bounds checking.  */
static const yytype_uint8 yytranslate[] =
{
       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,    25,    21,    23,    24,    22,     2,     2,
       2,     2,     2,    25,    22,    21,    24,    23,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,    20,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
610
611
612
613
614
615
616



































617

618
619
620

621
622
623
624
625





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
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
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
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
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
618
619
620
621
622
623

624
625
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
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
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
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+


-
+
-
-
-
-
-
+
+
+
+
+



-
+







-
+


-
+




-
-
+
+




-
+



-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+

-
-
-
-
-
+
+
+
+
+
-
-
-
-
+


-
-
-
+
+
+


-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+


-
-
+
+

+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+

-
-
+
+


-
-
-
+
+
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+




-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-


-
-
+
+



-
+

-
-
-
-
-
-
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-
-
-
+
+
+

+
+
+
+
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+






+

-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
-
+
+


-
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
-
-
-
+
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+

+
+
+


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


+
+



+
+

-
+
+
+
+
+







+
+


+
+
+
+
+
+
+
+
+

+
-
-
+
+
+












+
+

-
+
+
+
+
+
+
+


-
+
-
-
-
+
-



-
-
-
-
-
+
+
+
+
+






+
+

-
+
+
+
+
+
+
+
+
+

-


+

-
+



-
-
+
+
-
-
-
-
+
+
+



-
-
-
-
-
+
+
+
+
+













-
+














+








+
+


+
+
+
+
+















+
+


+
+
+
+
+
+







       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
       5,     6,     7,     8,     9,    10,    11,    12,    13,    14,
      15,    16,    17,    18,    19
};

#if YYDEBUG
/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
   YYRHS.  */
static const yytype_uint8 yyprhs[] =
{
       0,     0,     3,     4,     7,     9,    11,    13,    15,    17,
      19,    21,    23,    25,    28,    33,    39,    46,    54,    57,
      59,    61,    63,    66,    69,    73,    76,    80,    86,    88,
      94,   100,   103,   108,   111,   113,   117,   120,   124,   128,
     136,   139,   144,   147,   149,   153,   156,   159,   163,   165,
     167,   169,   171,   173,   175,   177,   178
};

/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
static const yytype_int8 yyrhs[] =
{
      27,     0,    -1,    -1,    27,    28,    -1,    29,    -1,    30,
      -1,    32,    -1,    33,    -1,    31,    -1,    36,    -1,    34,
      -1,    35,    -1,    40,    -1,    13,     7,    -1,    13,    20,
      13,    41,    -1,    13,    20,    13,    21,    13,    -1,    13,
      20,    13,    20,    13,    41,    -1,    13,    20,    13,    20,
      13,    21,    13,    -1,    14,    16,    -1,    14,    -1,     5,
      -1,     4,    -1,     4,    22,    -1,    13,     4,    -1,    38,
      13,     4,    -1,    19,     4,    -1,    13,    23,    13,    -1,
      13,    23,    13,    23,    13,    -1,    17,    -1,    13,    21,
       8,    21,    13,    -1,    13,    21,    13,    21,    13,    -1,
       8,    13,    -1,     8,    13,    22,    13,    -1,    13,     8,
      -1,    15,    -1,    13,     8,    13,    -1,    19,     8,    -1,
      19,    13,     8,    -1,    17,    14,    17,    -1,    17,    14,
      13,    20,    13,    20,    13,    -1,    17,    17,    -1,    10,
      13,    24,    13,    -1,    37,     3,    -1,    37,    -1,    38,
      13,    39,    -1,    13,    39,    -1,    19,    39,    -1,    19,
      13,    39,    -1,    39,    -1,    21,    -1,    25,    -1,    11,
      -1,    18,    -1,     9,    -1,    13,    -1,    -1,     7,    -1
};

  /* YYRLINE[YYN] -- Source line where rule number YYN was defined.  */
/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
static const yytype_uint16 yyrline[] =
{
       0,   223,   223,   224,   227,   230,   233,   236,   239,   242,
       0,   225,   225,   226,   229,   232,   235,   238,   241,   244,
     245,   249,   254,   257,   263,   269,   277,   282,   287,   291,
     297,   301,   305,   309,   313,   319,   323,   328,   333,   338,
     343,   347,   352,   356,   361,   368,   372,   378,   388,   397,
     406,   416,   430,   435,   438,   441,   444,   447,   450,   455,
     458,   463,   467,   471,   477,   495,   498
     247,   251,   256,   259,   265,   271,   279,   285,   296,   300,
     304,   310,   314,   318,   322,   326,   332,   336,   341,   346,
     351,   356,   360,   365,   369,   374,   381,   385,   391,   400,
     409,   419,   433,   438,   441,   444,   447,   450,   453,   458,
     461,   466,   470,   474,   480,   498,   501
};
#endif

#if YYDEBUG || YYERROR_VERBOSE || 0
#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
static const char *const yytname[] =
{
  "$end", "error", "$undefined", "tAGO", "tDAY", "tDAYZONE", "tID",
  "tMERIDIAN", "tMONTH", "tMONTH_UNIT", "tSTARDATE", "tSEC_UNIT",
  "tSNUMBER", "tUNUMBER", "tZONE", "tEPOCH", "tDST", "tISOBASE",
  "tDAY_UNIT", "tNEXT", "':'", "','", "'/'", "'-'", "'.'", "'+'",
  "tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
  "$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
  "iso", "trek", "relspec", "relunits", "sign", "unit", "number",
  "o_merid", YY_NULLPTR
  "o_merid", 0
};
#endif

# ifdef YYPRINT
/* YYTOKNUM[NUM] -- (External) token number corresponding to the
   (internal) symbol number NUM (which must be that of a token).  */
/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
   token YYLEX-NUM.  */
static const yytype_uint16 yytoknum[] =
{
       0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
     265,   266,   267,   268,   269,   270,   271,   272,   273,   274,
      58,    44,    47,    45,    46,    43
      58,    45,    44,    47,    46,    43
};
# endif

#define YYPACT_NINF -18

/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
#define yypact_value_is_default(Yystate) \
  (!!((Yystate) == (-18)))

#define YYTABLE_NINF -1

#define yytable_value_is_error(Yytable_value) \
  0

static const yytype_uint8 yyr1[] =
{
       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
      28,    28,    28,    29,    29,    29,    29,    29,    30,    30,
      30,    31,    31,    31,    31,    31,    32,    32,    32,    32,
      32,    32,    32,    32,    32,    32,    33,    33,    34,    34,
      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
      38,    39,    39,    39,    40,    41,    41
};

/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
  /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
     STATE-NUM.  */
static const yytype_int8 yypact[] =
static const yytype_uint8 yyr2[] =
{
     -18,     2,   -18,   -17,   -18,    -4,   -18,    10,   -18,    22,
       8,   -18,    18,   -18,    39,   -18,   -18,   -18,   -18,   -18,
     -18,   -18,   -18,   -18,   -18,   -18,    25,    21,   -18,   -18,
     -18,    16,    14,   -18,   -18,    28,    36,    41,    -5,   -18,
     -18,     5,   -18,   -18,   -18,    47,   -18,   -18,    42,    46,
       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
       1,     1,     1,     2,     4,     5,     6,     7,     2,     1,
       1,     1,     2,     2,     3,     2,     3,     5,     1,     5,
       5,     2,     4,     2,     1,     3,     2,     3,     3,     7,
       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,
      48,   -18,    -6,    40,    43,    44,    49,   -18,   -18,   -18,
     -18,   -18,   -18,   -18,   -18,    50,   -18,    51,    55,    57,
      58,    65,   -18,   -18,    59,    54,   -18,    62,    63,    60,
     -18,    64,    61,    66,   -18
       1,     1,     1,     1,     1,     0,     1
};

  /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
     Performed when YYTABLE does not specify something else to do.  Zero
     means the default is an error.  */
/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
   means the default is an error.  */
static const yytype_uint8 yydefact[] =
{
       2,     0,     1,    20,    18,     0,    53,     0,    51,    54,
      17,    33,    27,    52,     0,    49,    50,     3,     4,     5,
       2,     0,     1,    21,    20,     0,    53,     0,    51,    54,
      19,    34,    28,    52,     0,    49,    50,     3,     4,     5,
       8,     6,     7,    10,    11,     9,    43,     0,    48,    12,
      21,    30,     0,    22,    13,    32,     0,     0,     0,    45,
      16,     0,    40,    24,    35,     0,    46,    42,    19,     0,
       0,    34,    55,    25,     0,     0,     0,    38,    36,    47,
      23,    44,    31,    41,    56,     0,    14,     0,     0,     0,
       0,    55,    26,    28,    29,     0,    15,     0,     0,     0,
      39,     0,     0,     0,    37
      22,    31,     0,    23,    13,    33,     0,     0,     0,    45,
      18,     0,    40,    25,    36,     0,    46,    42,     0,     0,
       0,    35,    55,     0,     0,    26,     0,    38,    37,    47,
      24,    44,    32,    41,    56,     0,     0,    14,     0,     0,
       0,     0,    55,    15,    29,    30,    27,     0,     0,    16,
       0,    17,    39
};

  /* YYPGOTO[NTERM-NUM].  */
static const yytype_int8 yypgoto[] =
/* YYDEFGOTO[NTERM-NUM].  */
static const yytype_int8 yydefgoto[] =
{
      -1,     1,    17,    18,    19,    20,    21,    22,    23,    24,
      25,    26,    27,    28,    29,    67
};
     -18,   -18,   -18,   -18,   -18,   -18,   -18,   -18,   -18,   -18,
     -18,   -18,   -18,    -9,   -18,     7

/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
   STATE-NUM.  */
#define YYPACT_NINF -22
static const yytype_int8 yypact[] =
{
     -22,     2,   -22,   -21,   -22,    -4,   -22,     1,   -22,    22,
      18,   -22,     8,   -22,    40,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,   -22,    32,    28,   -22,   -22,
     -22,    24,    26,   -22,   -22,    42,    47,    -5,    49,   -22,
     -22,    15,   -22,   -22,   -22,    48,   -22,   -22,    43,    50,
      51,   -22,    17,    44,    46,    45,    52,   -22,   -22,   -22,
     -22,   -22,   -22,   -22,   -22,    56,    57,   -22,    58,    60,
      61,    62,    -3,   -22,   -22,   -22,   -22,    59,    63,   -22,
      64,   -22,   -22
};

  /* YYDEFGOTO[NTERM-NUM].  */
static const yytype_int8 yydefgoto[] =
/* YYPGOTO[NTERM-NUM].  */
static const yytype_int8 yypgoto[] =
{
      -1,     1,    17,    18,    19,    20,    21,    22,    23,    24,
      25,    26,    27,    28,    29,    66
     -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,   -22,
     -22,   -22,   -22,    -9,   -22,     6
};

  /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM.  If
     positive, shift that token.  If negative, reduce the rule whose
     number is the opposite.  If YYTABLE_NINF, syntax error.  */
/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
   positive, shift that token.  If negative, reduce the rule which
   number is the opposite.  If zero, do what YYDEFACT says.
   If YYTABLE_NINF, syntax error.  */
#define YYTABLE_NINF -1
static const yytype_uint8 yytable[] =
{
      39,    64,     2,    54,    30,    46,     3,     4,    55,    31,
       5,     6,     7,     8,    65,     9,    10,    11,    56,    12,
      13,    14,    57,    32,    40,    15,    33,    16,    47,    34,
      35,     6,    41,     8,    48,    42,    59,    49,    50,    61,
      13,    51,    36,    43,    37,    38,    60,    44,     6,    52,
       8,     6,    45,     8,    53,    58,     6,    13,     8,    62,
      13,    63,    67,    71,    72,    13,    68,    69,    73,    70,
      39,    30,     2,    53,    64,    46,     3,     4,    54,    31,
       5,     6,     7,     8,    32,     9,    10,    11,    78,    12,
      13,    14,    41,    15,    64,    42,    33,    16,    56,    34,
      35,     6,    57,     8,    40,    47,    59,    65,    66,    61,
      13,    48,    36,    37,    43,    38,    49,    60,    44,     6,
      50,     8,     6,    45,     8,    51,    58,     6,    13,     8,
      52,    13,    55,    62,    63,    68,    13,    69,    70,    72,
      74,    75,    64,    77,    78,    79,    80,    82,    76,    84,
      81,    83
      73,    74,    71,    75,    76,    77,    81,    82,    79,    80
};

static const yytype_uint8 yycheck[] =
{
       9,     7,     0,     8,    21,    14,     4,     5,    13,    13,
       8,     9,    10,    11,    20,    13,    14,    15,    13,    17,
      18,    19,    17,    13,    16,    23,     4,    25,     3,     7,
       8,     9,    14,    11,    13,    17,    45,    21,    24,    48,
      18,    13,    20,     4,    22,    23,     4,     8,     9,    13,
      11,     9,    13,    11,    13,     8,     9,    18,    11,    13,
      18,    13,    22,    13,    13,    18,    23,    23,    13,    20,
      13,    13,     7,    14,    20,    13,    13,    13,    71,    13,
       9,    22,     0,     8,     7,    14,     4,     5,    13,    13,
       8,     9,    10,    11,    13,    13,    14,    15,    21,    17,
      18,    19,    14,    21,     7,    17,     4,    25,    13,     7,
       8,     9,    17,    11,    16,     3,    45,    20,    21,    48,
      18,    13,    20,    21,     4,    23,    22,     4,     8,     9,
      24,    11,     9,    13,    11,    13,     8,     9,    18,    11,
      13,    18,    13,    13,    13,    21,    18,    21,    23,    13,
      13,    13,    20,    13,    13,    13,    13,    13,    72,    20
      20,    20
};

  /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
     symbol of state STATE-NUM.  */
/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
   symbol of state STATE-NUM.  */
static const yytype_uint8 yystos[] =
{
       0,    27,     0,     4,     5,     8,     9,    10,    11,    13,
      14,    15,    17,    18,    19,    23,    25,    28,    29,    30,
      14,    15,    17,    18,    19,    21,    25,    28,    29,    30,
      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
      21,    13,    13,     4,     7,     8,    20,    22,    23,    39,
      16,    14,    17,     4,     8,    13,    39,     3,    13,    21,
      24,    13,    13,    13,     8,    13,    13,    17,     8,    39,
       4,    39,    13,    13,     7,    20,    41,    22,    23,    23,
      20,    13,    13,    13,    13,    13,    41,    14,    20,    13,
      13,    20,    13,    20,    13
      22,    13,    13,     4,     7,     8,    20,    21,    23,    39,
      16,    14,    17,     4,     8,    13,    39,     3,    13,    22,
      24,    13,    13,     8,    13,    13,    13,    17,     8,    39,
       4,    39,    13,    13,     7,    20,    21,    41,    21,    21,
      23,    20,    13,    13,    13,    13,    13,    13,    21,    41,
      20,    13,    13
};

  /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
static const yytype_uint8 yyr1[] =
{
       0,    26,    27,    27,    28,    28,    28,    28,    28,    28,
      28,    28,    28,    29,    29,    29,    30,    30,    30,    30,
      31,    31,    31,    31,    31,    32,    32,    32,    32,    32,
      32,    32,    32,    32,    32,    33,    33,    34,    34,    34,
      34,    35,    36,    36,    37,    37,    37,    37,    37,    38,
      38,    39,    39,    39,    40,    41,    41
};

  /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN.  */
static const yytype_uint8 yyr2[] =
{
       0,     2,     0,     2,     1,     1,     1,     1,     1,     1,
       1,     1,     1,     2,     4,     6,     2,     1,     1,     2,
       1,     2,     2,     3,     2,     3,     5,     1,     5,     5,
       2,     4,     2,     1,     3,     2,     3,    11,     3,     7,
       2,     4,     2,     1,     3,     2,     2,     3,     1,     1,
       1,     1,     1,     1,     1,     0,     1
};


#define yyerrok         (yyerrstatus = 0)
#define yyclearin       (yychar = YYEMPTY)
#define YYEMPTY         (-2)
#define YYEOF           0
#define yyerrok		(yyerrstatus = 0)
#define yyclearin	(yychar = YYEMPTY)
#define YYEMPTY		(-2)
#define YYEOF		0

#define YYACCEPT        goto yyacceptlab
#define YYABORT         goto yyabortlab
#define YYERROR         goto yyerrorlab
#define YYACCEPT	goto yyacceptlab
#define YYABORT		goto yyabortlab
#define YYERROR		goto yyerrorlab


/* Like YYERROR except do call yyerror.  This remains here temporarily
   to ease the transition to the new meaning of YYERROR, for GCC.
   Once GCC version 2 has supplanted version 1, this can go.  */

#define YYFAIL		goto yyerrlab

#define YYRECOVERING()  (!!yyerrstatus)

#define YYBACKUP(Token, Value)                                  \
do                                                              \
  if (yychar == YYEMPTY)                                        \
    {                                                           \
      yychar = (Token);                                         \
      yylval = (Value);                                         \
      YYPOPSTACK (yylen);                                       \
#define YYBACKUP(Token, Value)					\
do								\
  if (yychar == YYEMPTY && yylen == 1)				\
    {								\
      yychar = (Token);						\
      yylval = (Value);						\
      yytoken = YYTRANSLATE (yychar);				\
      YYPOPSTACK (1);						\
      yystate = *yyssp;                                         \
      goto yybackup;                                            \
    }                                                           \
  else                                                          \
    {                                                           \
      goto yybackup;						\
    }								\
  else								\
    {								\
      yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
      YYERROR;                                                  \
    }                                                           \
while (0)
      YYERROR;							\
    }								\
while (YYID (0))

/* Error token number */
#define YYTERROR        1
#define YYERRCODE       256

#define YYTERROR	1
#define YYERRCODE	256


/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
   If N is 0, then set CURRENT to the empty location which ends
   the previous symbol: RHS[0] (always defined).  */

#define YYRHSLOC(Rhs, K) ((Rhs)[K])
#ifndef YYLLOC_DEFAULT
# define YYLLOC_DEFAULT(Current, Rhs, N)                                \
# define YYLLOC_DEFAULT(Current, Rhs, N)				\
    do                                                                  \
      if (N)                                                            \
        {                                                               \
          (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;        \
          (Current).first_column = YYRHSLOC (Rhs, 1).first_column;      \
          (Current).last_line    = YYRHSLOC (Rhs, N).last_line;         \
          (Current).last_column  = YYRHSLOC (Rhs, N).last_column;       \
    do									\
      if (YYID (N))                                                    \
	{								\
	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
        }                                                               \
      else                                                              \
	}								\
      else								\
        {                                                               \
          (Current).first_line   = (Current).last_line   =              \
            YYRHSLOC (Rhs, 0).last_line;                                \
          (Current).first_column = (Current).last_column =              \
            YYRHSLOC (Rhs, 0).last_column;                              \
	{								\
	  (Current).first_line   = (Current).last_line   =		\
	    YYRHSLOC (Rhs, 0).last_line;				\
	  (Current).first_column = (Current).last_column =		\
	    YYRHSLOC (Rhs, 0).last_column;				\
        }                                                               \
    while (0)
	}								\
    while (YYID (0))
#endif

#define YYRHSLOC(Rhs, K) ((Rhs)[K])

/* YY_LOCATION_PRINT -- Print the location on the stream.
   This macro was not mandated originally: define only if we know
   we won't break user code: when these are the locations we know.  */

#ifndef YY_LOCATION_PRINT
# if YYLTYPE_IS_TRIVIAL
#  define YY_LOCATION_PRINT(File, Loc)			\
     fprintf (File, "%d.%d-%d.%d",			\
	      (Loc).first_line, (Loc).first_column,	\
	      (Loc).last_line,  (Loc).last_column)
# else
#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
#endif


/* YYLEX -- calling `yylex' with the right arguments.  */

#ifdef YYLEX_PARAM
# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM)
#else
# define YYLEX yylex (&yylval, &yylloc, info)
#endif

/* Enable debugging if requested.  */
#if YYDEBUG

# ifndef YYFPRINTF
#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
#  define YYFPRINTF fprintf
# endif

# define YYDPRINTF(Args)                        \
do {                                            \
  if (yydebug)                                  \
    YYFPRINTF Args;                             \
} while (0)
# define YYDPRINTF(Args)			\
do {						\
  if (yydebug)					\
    YYFPRINTF Args;				\
} while (YYID (0))


/* YY_LOCATION_PRINT -- Print the location on the stream.
   This macro was not mandated originally: define only if we know
# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
do {									  \
  if (yydebug)								  \
   we won't break user code: when these are the locations we know.  */

#ifndef YY_LOCATION_PRINT
    {									  \
      YYFPRINTF (stderr, "%s ", Title);					  \
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL

      yy_symbol_print (stderr,						  \
/* Print *YYLOCP on YYO.  Private, do not rely on its existence. */

		  Type, Value, Location, info); \
YY_ATTRIBUTE_UNUSED
static unsigned
yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp)
{
  unsigned res = 0;
  int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0;
  if (0 <= yylocp->first_line)
    {
      res += YYFPRINTF (yyo, "%d", yylocp->first_line);
      YYFPRINTF (stderr, "\n");						  \
      if (0 <= yylocp->first_column)
        res += YYFPRINTF (yyo, ".%d", yylocp->first_column);
    }
  if (0 <= yylocp->last_line)
    }									  \
} while (YYID (0))
    {
      if (yylocp->first_line < yylocp->last_line)
        {
          res += YYFPRINTF (yyo, "-%d", yylocp->last_line);
          if (0 <= end_col)
            res += YYFPRINTF (yyo, ".%d", end_col);
        }

      else if (0 <= end_col && yylocp->first_column < end_col)
        res += YYFPRINTF (yyo, "-%d", end_col);
    }

  return res;
 }

#  define YY_LOCATION_PRINT(File, Loc)          \
  yy_location_print_ (File, &(Loc))

# else
#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
#endif


# define YY_SYMBOL_PRINT(Title, Type, Value, Location)                    \
do {                                                                      \
  if (yydebug)                                                            \
    {                                                                     \
      YYFPRINTF (stderr, "%s ", Title);                                   \
      yy_symbol_print (stderr,                                            \
                  Type, Value, Location, info); \
      YYFPRINTF (stderr, "\n");                                           \
    }                                                                     \
} while (0)


/*----------------------------------------.
| Print this symbol's value on YYOUTPUT.  |
`----------------------------------------*/
/*--------------------------------.
| Print this symbol on YYOUTPUT.  |
`--------------------------------*/

/*ARGSUSED*/
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
{
  FILE *yyo = yyoutput;
  YYUSE (yyo);
  YYUSE (yylocationp);
  YYUSE (info);
#else
static void
yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
    FILE *yyoutput;
    int yytype;
    YYSTYPE const * const yyvaluep;
    YYLTYPE const * const yylocationp;
    DateInfo* info;
#endif
{
  if (!yyvaluep)
    return;
  YYUSE (yylocationp);
  YYUSE (info);
# ifdef YYPRINT
  if (yytype < YYNTOKENS)
    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
# else
  YYUSE (yyoutput);
# endif
  YYUSE (yytype);
  switch (yytype)
    {
      default:
	break;
    }
}


/*--------------------------------.
| Print this symbol on YYOUTPUT.  |
`--------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
#else
static void
yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
    FILE *yyoutput;
    int yytype;
    YYSTYPE const * const yyvaluep;
    YYLTYPE const * const yylocationp;
    DateInfo* info;
#endif
{
  if (yytype < YYNTOKENS)
  YYFPRINTF (yyoutput, "%s %s (",
             yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]);
    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
  else
    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);

  YY_LOCATION_PRINT (yyoutput, *yylocationp);
  YYFPRINTF (yyoutput, ": ");
  yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info);
  YYFPRINTF (yyoutput, ")");
}

/*------------------------------------------------------------------.
| yy_stack_print -- Print the state stack from its BOTTOM up to its |
| TOP (included).                                                   |
`------------------------------------------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
#else
static void
yy_stack_print (bottom, top)
    yytype_int16 *bottom;
    yytype_int16 *top;
#endif
{
  YYFPRINTF (stderr, "Stack now");
  for (; yybottom <= yytop; yybottom++)
  for (; bottom <= top; ++bottom)
    {
      int yybot = *yybottom;
      YYFPRINTF (stderr, " %d", yybot);
    YYFPRINTF (stderr, " %d", *bottom);
    }
  YYFPRINTF (stderr, "\n");
}

# define YY_STACK_PRINT(Bottom, Top)                            \
do {                                                            \
  if (yydebug)                                                  \
    yy_stack_print ((Bottom), (Top));                           \
} while (0)
# define YY_STACK_PRINT(Bottom, Top)				\
do {								\
  if (yydebug)							\
    yy_stack_print ((Bottom), (Top));				\
} while (YYID (0))


/*------------------------------------------------.
| Report that the YYRULE is going to be reduced.  |
`------------------------------------------------*/

#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
#else
static void
yy_reduce_print (yyvsp, yylsp, yyrule, info)
    YYSTYPE *yyvsp;
    YYLTYPE *yylsp;
    int yyrule;
    DateInfo* info;
#endif
{
  unsigned long yylno = yyrline[yyrule];
  int yynrhs = yyr2[yyrule];
  int yyi;
  unsigned long int yylno = yyrline[yyrule];
  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
             yyrule - 1, yylno);
	     yyrule - 1, yylno);
  /* The symbols being reduced.  */
  for (yyi = 0; yyi < yynrhs; yyi++)
    {
      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
      yy_symbol_print (stderr,
      fprintf (stderr, "   $%d = ", yyi + 1);
      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
                       yystos[yyssp[yyi + 1 - yynrhs]],
                       &(yyvsp[(yyi + 1) - (yynrhs)])
                       , &(yylsp[(yyi + 1) - (yynrhs)])                       , info);
      YYFPRINTF (stderr, "\n");
		       &(yyvsp[(yyi + 1) - (yynrhs)])
		       , &(yylsp[(yyi + 1) - (yynrhs)])		       , info);
      fprintf (stderr, "\n");
    }
}

# define YY_REDUCE_PRINT(Rule)          \
do {                                    \
  if (yydebug)                          \
    yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \
} while (0)
# define YY_REDUCE_PRINT(Rule)		\
do {					\
  if (yydebug)				\
    yy_reduce_print (yyvsp, yylsp, Rule, info); \
} while (YYID (0))

/* Nonzero means print parse trace.  It is left uninitialized so that
   multiple parsers can coexist.  */
int yydebug;
#else /* !YYDEBUG */
# define YYDPRINTF(Args)
# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
# define YY_STACK_PRINT(Bottom, Top)
# define YY_REDUCE_PRINT(Rule)
#endif /* !YYDEBUG */


/* YYINITDEPTH -- initial size of the parser's stacks.  */
#ifndef YYINITDEPTH
#ifndef	YYINITDEPTH
# define YYINITDEPTH 200
#endif

/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
   if the built-in stack extension method is used).

   Do not make this value too large; the results are undefined if
   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
   evaluated with infinite-precision integer arithmetic.  */

#ifndef YYMAXDEPTH
# define YYMAXDEPTH 10000
#endif



#if YYERROR_VERBOSE

# ifndef yystrlen
#  if defined __GLIBC__ && defined _STRING_H
#   define yystrlen strlen
#  else
/* Return the length of YYSTR.  */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static YYSIZE_T
yystrlen (const char *yystr)
#else
static YYSIZE_T
yystrlen (yystr)
    const char *yystr;
#endif
{
  YYSIZE_T yylen;
  for (yylen = 0; yystr[yylen]; yylen++)
    continue;
  return yylen;
}
#  endif
# endif

# ifndef yystpcpy
#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
#   define yystpcpy stpcpy
#  else
/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
   YYDEST.  */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static char *
yystpcpy (char *yydest, const char *yysrc)
#else
static char *
yystpcpy (yydest, yysrc)
    char *yydest;
    const char *yysrc;
#endif
{
  char *yyd = yydest;
  const char *yys = yysrc;

  while ((*yyd++ = *yys++) != '\0')
    continue;

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
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
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
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
1439
1440

1441
1442
1443

1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459

1460
1461

1462
1463

1464
1465
1466

1467
1468

1469
1470
1471
1472

1473
1474
1475
1476
1477
1478
1479
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450






1451
1452
1453
1454
1455
1456
1457









1458
1459
1460
1461
1462
1463
1464
1465
1466




1467
1468
1469
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479

1480
1481
1482








1483
1484
1485
1486
1487
1488
1489
1490
1491


1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502

1503
1504
1505

1506
1507
1508
1509
1510



1511
1512
1513
1514
1515
1516
1517
1518

1519
1520

1521
1522

1523
1524
1525

1526
1527

1528
1529
1530
1531

1532
1533
1534
1535
1536
1537
1538
1539







-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+










-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
+

-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+

+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+





+
+
+


+
+
+
+
+
+
+
+
+




+




+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








+
+
+

+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+

-
+


-
-
+
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-

-
-
-
-
+
-


+
+
-
+

-
-
-
-
-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+





-
-
-
-
-





-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+







-
+


-
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+









-
+


-
+




-
-
-








-
+

-
+

-
+


-
+

-
+



-
+







{
  if (*yystr == '"')
    {
      YYSIZE_T yyn = 0;
      char const *yyp = yystr;

      for (;;)
        switch (*++yyp)
          {
          case '\'':
          case ',':
            goto do_not_strip_quotes;
	switch (*++yyp)
	  {
	  case '\'':
	  case ',':
	    goto do_not_strip_quotes;

          case '\\':
            if (*++yyp != '\\')
              goto do_not_strip_quotes;
            /* Fall through.  */
          default:
            if (yyres)
              yyres[yyn] = *yyp;
            yyn++;
            break;
	  case '\\':
	    if (*++yyp != '\\')
	      goto do_not_strip_quotes;
	    /* Fall through.  */
	  default:
	    if (yyres)
	      yyres[yyn] = *yyp;
	    yyn++;
	    break;

          case '"':
            if (yyres)
              yyres[yyn] = '\0';
            return yyn;
          }
	  case '"':
	    if (yyres)
	      yyres[yyn] = '\0';
	    return yyn;
	  }
    do_not_strip_quotes: ;
    }

  if (! yyres)
    return yystrlen (yystr);

  return yystpcpy (yyres, yystr) - yyres;
}
# endif

/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
   about the unexpected token YYTOKEN for the state stack whose top is
   YYSSP.

   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
/* Copy into YYRESULT an error message about the unexpected token
   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
   including the terminating null byte.  If YYRESULT is null, do not
   copy anything; just return the number of bytes that would be
   copied.  As a special case, return 0 if an ordinary "syntax error"
   not large enough to hold the message.  In that case, also set
   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
   required number of bytes is too large to store.  */
static int
yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
                yytype_int16 *yyssp, int yytoken)
{
  YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]);
  YYSIZE_T yysize = yysize0;
  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
   size calculation.  */
static YYSIZE_T
yysyntax_error (char *yyresult, int yystate, int yychar)
{
  int yyn = yypact[yystate];

  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
    return 0;
  else
    {
      int yytype = YYTRANSLATE (yychar);
      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
      YYSIZE_T yysize = yysize0;
      YYSIZE_T yysize1;
      int yysize_overflow = 0;
      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
  /* Internationalized format string. */
  const char *yyformat = YY_NULLPTR;
  /* Arguments of yyformat. */
  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
  /* Number of reported tokens (one for the "unexpected", one per
     "expected"). */
  int yycount = 0;
      int yyx;

  /* There are many possibilities here to consider:
     - If this state is a consistent state with a default action, then
       the only way this function was invoked is if the default action
       is an error action.  In that case, don't check for expected
       tokens because there are none.
# if 0
      /* This is so xgettext sees the translatable formats that are
	 constructed on the fly.  */
     - The only way there can be no lookahead present (in yychar) is if
       this state is a consistent state with a default action.  Thus,
       detecting the absence of a lookahead is sufficient to determine
       that there is no unexpected or expected token to report.  In that
       case, just report a simple "syntax error".
     - Don't assume there isn't a lookahead just because this state is a
       consistent state with a default action.  There might have been a
       previous inconsistent state, consistent state with a non-default
       action, or user semantic action that manipulated yychar.
     - Of course, the expected token list depends on states to have
       correct lookahead information, and it depends on the parser not
       to perform extra reductions after fetching a lookahead from the
       scanner and before detecting a syntax error.  Thus, state merging
       (from LALR or IELR) and default reductions corrupt the expected
       token list.  However, the list is correct for canonical LR with
       one exception: it will still contain any token that will not be
       accepted due to an error action in a later state.
      YY_("syntax error, unexpected %s");
      YY_("syntax error, unexpected %s, expecting %s");
      YY_("syntax error, unexpected %s, expecting %s or %s");
      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
# endif
      char *yyfmt;
      char const *yyf;
      static char const yyunexpected[] = "syntax error, unexpected %s";
      static char const yyexpecting[] = ", expecting %s";
      static char const yyor[] = " or %s";
      char yyformat[sizeof yyunexpected
		    + sizeof yyexpecting - 1
  */
  if (yytoken != YYEMPTY)
		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
    {
      int yyn = yypact[*yyssp];
      yyarg[yycount++] = yytname[yytoken];
		       * (sizeof yyor - 1))];
      char const *yyprefix = yyexpecting;
      if (!yypact_value_is_default (yyn))
        {
          /* Start YYX at -YYN if negative to avoid negative indexes in
             YYCHECK.  In other words, skip the first -YYN actions for

      /* Start YYX at -YYN if negative to avoid negative indexes in
	 YYCHECK.  */
             this state because they are default actions.  */
          int yyxbegin = yyn < 0 ? -yyn : 0;
          /* Stay within bounds of both yycheck and yytname.  */
          int yychecklim = YYLAST - yyn + 1;
          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
          int yyx;
      int yyxbegin = yyn < 0 ? -yyn : 0;

      /* Stay within bounds of both yycheck and yytname.  */
      int yychecklim = YYLAST - yyn + 1;
      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
      int yycount = 1;

      yyarg[0] = yytname[yytype];
      yyfmt = yystpcpy (yyformat, yyunexpected);

          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
                && !yytable_value_is_error (yytable[yyx + yyn]))
              {
                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
                  {
                    yycount = 1;
                    yysize = yysize0;
                    break;
                  }
                yyarg[yycount++] = yytname[yyx];
	  {
	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
	      {
		yycount = 1;
		yysize = yysize0;
		yyformat[sizeof yyunexpected - 1] = '\0';
		break;
	      }
	    yyarg[yycount++] = yytname[yyx];
                {
                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]);
                  if (! (yysize <= yysize1
	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
	    yysize_overflow |= (yysize1 < yysize);
                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
                    return 2;
                  yysize = yysize1;
                }
              }
	    yysize = yysize1;
	    yyfmt = yystpcpy (yyfmt, yyprefix);
	    yyprefix = yyor;
	  }

        }
    }

  switch (yycount)
      yyf = YY_(yyformat);
      yysize1 = yysize + yystrlen (yyf);
    {
# define YYCASE_(N, S)                      \
      case N:                               \
        yyformat = S;                       \
      yysize_overflow |= (yysize1 < yysize);
      yysize = yysize1;
      break
    default: /* Avoid compiler warnings. */
      YYCASE_(0, YY_("syntax error"));
      YYCASE_(1, YY_("syntax error, unexpected %s"));
      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
# undef YYCASE_
    }


      if (yysize_overflow)
  {
    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
	return YYSIZE_MAXIMUM;
    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
      return 2;
    yysize = yysize1;
  }


      if (yyresult)
  if (*yymsg_alloc < yysize)
    {
	{
      *yymsg_alloc = 2 * yysize;
      if (! (yysize <= *yymsg_alloc
             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
      return 1;
    }

  /* Avoid sprintf, as that infringes on the user's name space.
     Don't have undefined behavior even if the translation
     produced a string with the wrong number of "%s"s.  */
	  /* Avoid sprintf, as that infringes on the user's name space.
	     Don't have undefined behavior even if the translation
	     produced a string with the wrong number of "%s"s.  */
  {
    char *yyp = *yymsg;
    int yyi = 0;
    while ((*yyp = *yyformat) != '\0')
      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
        {
          yyp += yytnamerr (yyp, yyarg[yyi++]);
          yyformat += 2;
        }
      else
        {
          yyp++;
          yyformat++;
        }
  }
  return 0;
	  char *yyp = yyresult;
	  int yyi = 0;
	  while ((*yyp = *yyf) != '\0')
	    {
	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
		{
		  yyp += yytnamerr (yyp, yyarg[yyi++]);
		  yyf += 2;
		}
	      else
		{
		  yyp++;
		  yyf++;
		}
	    }
	}
      return yysize;
    }
}
#endif /* YYERROR_VERBOSE */


/*-----------------------------------------------.
| Release the memory associated to this symbol.  |
`-----------------------------------------------*/

/*ARGSUSED*/
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
static void
yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
#else
static void
yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
    const char *yymsg;
    int yytype;
    YYSTYPE *yyvaluep;
    YYLTYPE *yylocationp;
    DateInfo* info;
#endif
{
  YYUSE (yyvaluep);
  YYUSE (yylocationp);
  YYUSE (info);

  if (!yymsg)
    yymsg = "Deleting";
  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);

  switch (yytype)
    {
  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  YYUSE (yytype);
  YY_IGNORE_MAYBE_UNINITIALIZED_END
}

      default:
	break;
    }
}


/* Prevent warnings from -Wmissing-prototypes.  */

#ifdef YYPARSE_PARAM
#if defined __STDC__ || defined __cplusplus
int yyparse (void *YYPARSE_PARAM);
#else
int yyparse ();
#endif
#else /* ! YYPARSE_PARAM */
#if defined __STDC__ || defined __cplusplus
int yyparse (DateInfo* info);
#else
int yyparse ();
#endif
#endif /* ! YYPARSE_PARAM */






/*----------.
| yyparse.  |
`----------*/

#ifdef YYPARSE_PARAM
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
int
yyparse (void *YYPARSE_PARAM)
#else
int
yyparse (YYPARSE_PARAM)
    void *YYPARSE_PARAM;
#endif
#else /* ! YYPARSE_PARAM */
#if (defined __STDC__ || defined __C99__FUNC__ \
     || defined __cplusplus || defined _MSC_VER)
int
yyparse (DateInfo* info)
#else
int
yyparse (info)
    DateInfo* info;
#endif
#endif
{
/* The lookahead symbol.  */
  /* The look-ahead symbol.  */
int yychar;


/* The semantic value of the lookahead symbol.  */
/* The semantic value of the look-ahead symbol.  */
/* Default value used for initialization, for pacifying older GCCs
   or non-GCC compilers.  */
YY_INITIAL_VALUE (static YYSTYPE yyval_default;)
YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default);
YYSTYPE yylval = {0};

/* Location data for the lookahead symbol.  */
static YYLTYPE yyloc_default
# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
  = { 1, 1, 1, 1 }
# endif
;
YYLTYPE yylloc = yyloc_default;

    /* Number of syntax errors so far.  */
    int yynerrs;

/* Number of syntax errors so far.  */
int yynerrs;
/* Location data for the look-ahead symbol.  */
    int yystate;
    /* Number of tokens to shift before error messages enabled.  */
    int yyerrstatus;

    /* The stacks and their tools:
       'yyss': related to states.
       'yyvs': related to semantic values.
       'yyls': related to locations.

       Refer to the stacks through separate pointers, to allow yyoverflow
       to reallocate them elsewhere.  */

    /* The state stack.  */
    yytype_int16 yyssa[YYINITDEPTH];
    yytype_int16 *yyss;
    yytype_int16 *yyssp;

    /* The semantic value stack.  */
    YYSTYPE yyvsa[YYINITDEPTH];
    YYSTYPE *yyvs;
    YYSTYPE *yyvsp;

    /* The location stack.  */
    YYLTYPE yylsa[YYINITDEPTH];
    YYLTYPE *yyls;
YYLTYPE yylloc;
    YYLTYPE *yylsp;

    /* The locations where the error started and ended.  */
    YYLTYPE yyerror_range[3];

    YYSIZE_T yystacksize;
  int yystate;

  int yyn;
  int yyresult;
  /* Number of tokens to shift before error messages enabled.  */
  int yyerrstatus;
  /* Lookahead token as an internal (translated) token number.  */
  /* Look-ahead token as an internal (translated) token number.  */
  int yytoken = 0;
  /* The variables used to return semantic value and location from the
     action routines.  */
  YYSTYPE yyval;
  YYLTYPE yyloc;

#if YYERROR_VERBOSE
  /* Buffer for error messages, and its allocated size.  */
  char yymsgbuf[128];
  char *yymsg = yymsgbuf;
  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
#endif

  /* Three stacks and their tools:
     `yyss': related to states,
     `yyvs': related to semantic values,
     `yyls': related to locations.

     Refer to the stacks thru separate pointers, to allow yyoverflow
     to reallocate them elsewhere.  */

  /* The state stack.  */
  yytype_int16 yyssa[YYINITDEPTH];
  yytype_int16 *yyss = yyssa;
  yytype_int16 *yyssp;

  /* The semantic value stack.  */
  YYSTYPE yyvsa[YYINITDEPTH];
  YYSTYPE *yyvs = yyvsa;
  YYSTYPE *yyvsp;

  /* The location stack.  */
  YYLTYPE yylsa[YYINITDEPTH];
  YYLTYPE *yyls = yylsa;
  YYLTYPE *yylsp;
  /* The locations where the error started and ended.  */
  YYLTYPE yyerror_range[2];

#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N), yylsp -= (N))

  YYSIZE_T yystacksize = YYINITDEPTH;

  /* The variables used to return semantic value and location from the
     action routines.  */
  YYSTYPE yyval;
  YYLTYPE yyloc;

  /* The number of symbols on the RHS of the reduced rule.
     Keep to zero when no symbol should be popped.  */
  int yylen = 0;

  yyssp = yyss = yyssa;
  yyvsp = yyvs = yyvsa;
  yylsp = yyls = yylsa;
  yystacksize = YYINITDEPTH;

  YYDPRINTF ((stderr, "Starting parse\n"));

  yystate = 0;
  yyerrstatus = 0;
  yynerrs = 0;
  yychar = YYEMPTY; /* Cause a token to be read.  */
  yylsp[0] = yylloc;
  yychar = YYEMPTY;		/* Cause a token to be read.  */

  /* Initialize stack pointers.
     Waste one element of value and location stack
     so that they stay on the same level as the state stack.
     The wasted elements are never initialized.  */

  yyssp = yyss;
  yyvsp = yyvs;
  yylsp = yyls;
#if YYLTYPE_IS_TRIVIAL
  /* Initialize the default location before parsing starts.  */
  yylloc.first_line   = yylloc.last_line   = 1;
  yylloc.first_column = yylloc.last_column = 0;
#endif

  goto yysetstate;

/*------------------------------------------------------------.
| yynewstate -- Push a new state, which is found in yystate.  |
`------------------------------------------------------------*/
 yynewstate:
  /* In all cases, when you get here, the value and location stacks
     have just been pushed.  So pushing a state here evens the stacks.  */
  yyssp++;

 yysetstate:
  *yyssp = yystate;

  if (yyss + yystacksize - 1 <= yyssp)
    {
      /* Get the current used size of the three stacks, in elements.  */
      YYSIZE_T yysize = yyssp - yyss + 1;

#ifdef yyoverflow
      {
        /* Give user a chance to reallocate the stack.  Use copies of
           these so that the &'s don't force the real ones into
           memory.  */
        YYSTYPE *yyvs1 = yyvs;
        yytype_int16 *yyss1 = yyss;
        YYLTYPE *yyls1 = yyls;
	/* Give user a chance to reallocate the stack.  Use copies of
	   these so that the &'s don't force the real ones into
	   memory.  */
	YYSTYPE *yyvs1 = yyvs;
	yytype_int16 *yyss1 = yyss;
	YYLTYPE *yyls1 = yyls;

        /* Each stack pointer address is followed by the size of the
           data in use in that stack, in bytes.  This used to be a
           conditional around just the two extra args, but that might
           be undefined if yyoverflow is a macro.  */
        yyoverflow (YY_("memory exhausted"),
                    &yyss1, yysize * sizeof (*yyssp),
                    &yyvs1, yysize * sizeof (*yyvsp),
                    &yyls1, yysize * sizeof (*yylsp),
                    &yystacksize);
	/* Each stack pointer address is followed by the size of the
	   data in use in that stack, in bytes.  This used to be a
	   conditional around just the two extra args, but that might
	   be undefined if yyoverflow is a macro.  */
	yyoverflow (YY_("memory exhausted"),
		    &yyss1, yysize * sizeof (*yyssp),
		    &yyvs1, yysize * sizeof (*yyvsp),
		    &yyls1, yysize * sizeof (*yylsp),
		    &yystacksize);

        yyls = yyls1;
        yyss = yyss1;
        yyvs = yyvs1;
	yyls = yyls1;
	yyss = yyss1;
	yyvs = yyvs1;
      }
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
      goto yyexhaustedlab;
# else
      /* Extend the stack our own way.  */
      if (YYMAXDEPTH <= yystacksize)
        goto yyexhaustedlab;
	goto yyexhaustedlab;
      yystacksize *= 2;
      if (YYMAXDEPTH < yystacksize)
        yystacksize = YYMAXDEPTH;
	yystacksize = YYMAXDEPTH;

      {
        yytype_int16 *yyss1 = yyss;
        union yyalloc *yyptr =
          (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
        if (! yyptr)
          goto yyexhaustedlab;
        YYSTACK_RELOCATE (yyss_alloc, yyss);
        YYSTACK_RELOCATE (yyvs_alloc, yyvs);
        YYSTACK_RELOCATE (yyls_alloc, yyls);
	yytype_int16 *yyss1 = yyss;
	union yyalloc *yyptr =
	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
	if (! yyptr)
	  goto yyexhaustedlab;
	YYSTACK_RELOCATE (yyss);
	YYSTACK_RELOCATE (yyvs);
	YYSTACK_RELOCATE (yyls);
#  undef YYSTACK_RELOCATE
        if (yyss1 != yyssa)
          YYSTACK_FREE (yyss1);
	if (yyss1 != yyssa)
	  YYSTACK_FREE (yyss1);
      }
# endif
#endif /* no yyoverflow */

      yyssp = yyss + yysize - 1;
      yyvsp = yyvs + yysize - 1;
      yylsp = yyls + yysize - 1;

      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
                  (unsigned long) yystacksize));
		  (unsigned long int) yystacksize));

      if (yyss + yystacksize - 1 <= yyssp)
        YYABORT;
	YYABORT;
    }

  YYDPRINTF ((stderr, "Entering state %d\n", yystate));

  if (yystate == YYFINAL)
    YYACCEPT;

  goto yybackup;

/*-----------.
| yybackup.  |
`-----------*/
yybackup:

  /* Do appropriate processing given the current state.  Read a
     lookahead token if we need one and don't already have one.  */
     look-ahead token if we need one and don't already have one.  */

  /* First try to decide what to do without reference to lookahead token.  */
  /* First try to decide what to do without reference to look-ahead token.  */
  yyn = yypact[yystate];
  if (yypact_value_is_default (yyn))
  if (yyn == YYPACT_NINF)
    goto yydefault;

  /* Not known => get a lookahead token if don't already have one.  */
  /* Not known => get a look-ahead token if don't already have one.  */

  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
  if (yychar == YYEMPTY)
    {
      YYDPRINTF ((stderr, "Reading a token: "));
      yychar = yylex (&yylval, &yylloc, info);
      yychar = YYLEX;
    }

  if (yychar <= YYEOF)
    {
      yychar = yytoken = YYEOF;
      YYDPRINTF ((stderr, "Now at end of input.\n"));
    }
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
1547
1548
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







-
-
+
+



+
+
+






-
+


-
-
+
+
+


-

-







     detect an error, take that action.  */
  yyn += yytoken;
  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
    goto yydefault;
  yyn = yytable[yyn];
  if (yyn <= 0)
    {
      if (yytable_value_is_error (yyn))
        goto yyerrlab;
      if (yyn == 0 || yyn == YYTABLE_NINF)
	goto yyerrlab;
      yyn = -yyn;
      goto yyreduce;
    }

  if (yyn == YYFINAL)
    YYACCEPT;

  /* Count tokens shifted since error; after three, turn off error
     status.  */
  if (yyerrstatus)
    yyerrstatus--;

  /* Shift the lookahead token.  */
  /* Shift the look-ahead token.  */
  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);

  /* Discard the shifted token.  */
  yychar = YYEMPTY;
  /* Discard the shifted token unless it is eof.  */
  if (yychar != YYEOF)
    yychar = YYEMPTY;

  yystate = yyn;
  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END
  *++yylsp = yylloc;
  goto yynewstate;


/*-----------------------------------------------------------.
| yydefault -- do the default action for the current state.  |
`-----------------------------------------------------------*/
1530
1531
1532
1533
1534
1535
1536
1537

1538
1539
1540
1541
1542
1543
1544
1545
1546

1547
1548
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
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
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
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

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

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
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
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


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
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


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
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
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







-
+








-
+

-







-
-
+






-
-
+






-
-
+






-
-
+






-
-
+






-
-
+







-
-
+








-
-
+





-
+


-
+
-
-
+





-
-
+
+

-
+
-
-
+





-
-
+
+
-
-
+
-
-
+
+
+
+





-
-
-
+
+
+
-
-
+
+





-
-
+
+
+
+

-
-
+
+
+





-
+

-
-
+





-
+

-
-
+





-
-
+
-
-
+
+






-
+
-
-
+





-
-
+
+
-
-
+





-
-
+
+
-
-
+





-
-
+
+
-
-
+





-
-
+
+
-
-
+





-
-
+
+
-
-
-
+





-
-
-
+
+
+
-
-
+





-
-
-
+
+
+
-
-
+





+
-
+
-
-
+
-
-
+





-
-
+
+
-
-
+
+





-
-
+
+
-
-
-
+





-
-
+
+
-
-
+
+





-
-
+
+
-
-
-
+





-
-
-
+
+
+
-
-
+





-
-
+
-
-
+
+
+





-
-
+
+
-
-
+





-
-
-
+
+
-
-
-
-
-
-
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+





-
-
-
-
-
-
+
+
+
+
+
+
-
-
+










-
+


-
-
+
+
-
-
+








-
-
+





-
+
-
-
+





-
+
-
-
+





-
+
-
-
+





-
+
-
-
+





-
+
-
-
+






-
-
+






-
-
+





-
+

-
-
+





-
+

-
-
+





-
+

-
-
+






-
+



-
+


-
-
+
+




-
-
+






-
-
+





-
+
-
-
+



+



-
-
-
-
-
-
-
-
-
-
-









-
+














-
-
-
+
+
+

-
-
-
-







-
-

-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
+



-
+



-
-
+
+


-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+


-
+















+
-
+












-
+




-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+



-
+

-
+

-
+





+
+
-
+

-

-
+

-
-
+
+







| yyreduce -- Do a reduction.  |
`-----------------------------*/
yyreduce:
  /* yyn is the number of a rule to reduce with.  */
  yylen = yyr2[yyn];

  /* If YYLEN is nonzero, implement the default value of the action:
     '$$ = $1'.
     `$$ = $1'.

     Otherwise, the following line sets YYVAL to garbage.
     This behavior is undocumented and Bison
     users should not rely upon it.  Assigning to YYVAL
     unconditionally makes the parser a bit smaller, and it avoids a
     GCC warning that YYVAL may be used uninitialized.  */
  yyval = yyvsp[1-yylen];

  /* Default location. */
  /* Default location.  */
  YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
  yyerror_range[1] = yyloc;
  YY_REDUCE_PRINT (yyn);
  switch (yyn)
    {
        case 4:

    {
	    yyHaveTime++;
	}

	;}
    break;

  case 5:

    {
	    yyHaveZone++;
	}

	;}
    break;

  case 6:

    {
	    yyHaveDate++;
	}

	;}
    break;

  case 7:

    {
	    yyHaveOrdinalMonth++;
	}

	;}
    break;

  case 8:

    {
	    yyHaveDay++;
	}

	;}
    break;

  case 9:

    {
	    yyHaveRel++;
	}

	;}
    break;

  case 10:

    {
	    yyHaveTime++;
	    yyHaveDate++;
	}

	;}
    break;

  case 11:

    {
	    yyHaveTime++;
	    yyHaveDate++;
	    yyHaveRel++;
	}

	;}
    break;

  case 13:

    {
	    yyHour = (yyvsp[-1].Number);
	    yyHour = (yyvsp[(1) - (2)].Number);
	    yyMinutes = 0;
	    yySeconds = 0;
	    yyMeridian = (yyvsp[0].Meridian);
	    yyMeridian = (yyvsp[(2) - (2)].Meridian);
	}

	;}
    break;

  case 14:

    {
	    yyHour = (yyvsp[-3].Number);
	    yyMinutes = (yyvsp[-1].Number);
	    yyHour = (yyvsp[(1) - (4)].Number);
	    yyMinutes = (yyvsp[(3) - (4)].Number);
	    yySeconds = 0;
	    yyMeridian = (yyvsp[0].Meridian);
	    yyMeridian = (yyvsp[(4) - (4)].Meridian);
	}

	;}
    break;

  case 15:

    {
	    yyHour = (yyvsp[-5].Number);
	    yyMinutes = (yyvsp[-3].Number);
	    yyHour = (yyvsp[(1) - (5)].Number);
	    yyMinutes = (yyvsp[(3) - (5)].Number);
	    yySeconds = (yyvsp[-1].Number);
	    yyMeridian = (yyvsp[0].Meridian);
	    yyMeridian = MER24;
	}

	    yyDSTmode = DSToff;
	    yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60);
	    ++yyHaveZone;
	;}
    break;

  case 16:

    {
	    yyTimezone = (yyvsp[-1].Number);
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyDSTmode = DSTon;
	    yyHour = (yyvsp[(1) - (6)].Number);
	    yyMinutes = (yyvsp[(3) - (6)].Number);
	    yySeconds = (yyvsp[(5) - (6)].Number);
	}

	    yyMeridian = (yyvsp[(6) - (6)].Meridian);
	;}
    break;

  case 17:

    {
	    yyTimezone = (yyvsp[0].Number);
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyHour = (yyvsp[(1) - (7)].Number);
	    yyMinutes = (yyvsp[(3) - (7)].Number);
	    yySeconds = (yyvsp[(5) - (7)].Number);
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	}

	    yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60);
	    ++yyHaveZone;
	;}
    break;

  case 18:

    {
	    yyTimezone = (yyvsp[0].Number);
	    yyTimezone = (yyvsp[(1) - (2)].Number);
	    yyDSTmode = DSTon;
	}

	;}
    break;

  case 19:

    {
	    yyTimezone = -(yyvsp[-1].Number)*((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
	    yyTimezone = (yyvsp[(1) - (1)].Number);
	    yyDSTmode = DSToff;
	}

	;}
    break;

  case 20:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[0].Number);
	    yyTimezone = (yyvsp[(1) - (1)].Number);
	}

	    yyDSTmode = DSTon;
	;}
    break;

  case 21:

    {
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[(1) - (1)].Number);
	}

	;}
    break;

  case 22:

    {
	    yyDayOrdinal = (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	    yyDayOrdinal = 1;
	    yyDayNumber = (yyvsp[(1) - (2)].Number);
	}

	;}
    break;

  case 23:

    {
	    yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number);
	    yyDayNumber = (yyvsp[0].Number);
	    yyDayOrdinal = (yyvsp[(1) - (2)].Number);
	    yyDayNumber = (yyvsp[(2) - (2)].Number);
	}

	;}
    break;

  case 24:

    {
	    yyDayOrdinal = 2;
	    yyDayNumber = (yyvsp[0].Number);
	    yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number);
	    yyDayNumber = (yyvsp[(3) - (3)].Number);
	}

	;}
    break;

  case 25:

    {
	    yyMonth = (yyvsp[-2].Number);
	    yyDay = (yyvsp[0].Number);
	    yyDayOrdinal = 2;
	    yyDayNumber = (yyvsp[(2) - (2)].Number);
	}

	;}
    break;

  case 26:

    {
	    yyMonth = (yyvsp[-4].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyMonth = (yyvsp[(1) - (3)].Number);
	    yyDay = (yyvsp[(3) - (3)].Number);
	    yyYear = (yyvsp[0].Number);
	}

	;}
    break;

  case 27:

    {
	    yyYear = (yyvsp[0].Number) / 10000;
	    yyMonth = ((yyvsp[0].Number) % 10000)/100;
	    yyDay = (yyvsp[0].Number) % 100;
	    yyMonth = (yyvsp[(1) - (5)].Number);
	    yyDay = (yyvsp[(3) - (5)].Number);
	    yyYear = (yyvsp[(5) - (5)].Number);
	}

	;}
    break;

  case 28:

    {
	    yyDay = (yyvsp[-4].Number);
	    yyMonth = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	    yyYear = (yyvsp[(1) - (1)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (1)].Number) % 100;
	}

	;}
    break;

  case 29:

    {
	    yyDay = (yyvsp[(1) - (5)].Number);
	    yyMonth = (yyvsp[-2].Number);
	    yyMonth = (yyvsp[(3) - (5)].Number);
	    yyDay = (yyvsp[0].Number);
	    yyYear = (yyvsp[-4].Number);
	    yyYear = (yyvsp[(5) - (5)].Number);
	}

	;}
    break;

  case 30:

    {
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[0].Number);
	    yyMonth = (yyvsp[(3) - (5)].Number);
	    yyDay = (yyvsp[(5) - (5)].Number);
	}

	    yyYear = (yyvsp[(1) - (5)].Number);
	;}
    break;

  case 31:

    {
	    yyMonth = (yyvsp[-3].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyMonth = (yyvsp[(1) - (2)].Number);
	    yyDay = (yyvsp[(2) - (2)].Number);
	    yyYear = (yyvsp[0].Number);
	}

	;}
    break;

  case 32:

    {
	    yyMonth = (yyvsp[0].Number);
	    yyDay = (yyvsp[-1].Number);
	    yyMonth = (yyvsp[(1) - (4)].Number);
	    yyDay = (yyvsp[(2) - (4)].Number);
	}

	    yyYear = (yyvsp[(4) - (4)].Number);
	;}
    break;

  case 33:

    {
	    yyMonth = 1;
	    yyDay = 1;
	    yyMonth = (yyvsp[(2) - (2)].Number);
	    yyDay = (yyvsp[(1) - (2)].Number);
	    yyYear = EPOCH;
	}

	;}
    break;

  case 34:

    {
	    yyMonth = (yyvsp[-1].Number);
	    yyDay = (yyvsp[-2].Number);
	    yyYear = (yyvsp[0].Number);
	    yyMonth = 1;
	    yyDay = 1;
	    yyYear = EPOCH;
	}

	;}
    break;

  case 35:

    {
	    yyMonthOrdinal = 1;
	    yyMonth = (yyvsp[0].Number);
	    yyMonth = (yyvsp[(2) - (3)].Number);
	}

	    yyDay = (yyvsp[(1) - (3)].Number);
	    yyYear = (yyvsp[(3) - (3)].Number);
	;}
    break;

  case 36:

    {
	    yyMonthOrdinal = (yyvsp[-1].Number);
	    yyMonth = (yyvsp[0].Number);
	    yyMonthOrdinal = 1;
	    yyMonth = (yyvsp[(2) - (2)].Number);
	}

	;}
    break;

  case 37:

    {
	    if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = (yyvsp[-10].Number);
	    yyMonth = (yyvsp[-8].Number);
	    yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
	    yyMonth = (yyvsp[(3) - (3)].Number);
	    yyDay = (yyvsp[-6].Number);
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yySeconds = (yyvsp[0].Number);
	}

	;}
    break;

  case 38:

    {
	    if ((yyvsp[-1].Number) != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = (yyvsp[-2].Number) / 10000;
	    yyMonth = ((yyvsp[-2].Number) % 10000)/100;
	    yyDay = (yyvsp[-2].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	    if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[(1) - (3)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (3)].Number) % 100;
	    yyHour = (yyvsp[(3) - (3)].Number) / 10000;
	    yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100;
	    yySeconds = (yyvsp[(3) - (3)].Number) % 100;
	}

	;}
    break;

  case 39:

    {
	    if ((yyvsp[-5].Number) != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = (yyvsp[-6].Number) / 10000;
	    yyMonth = ((yyvsp[-6].Number) % 10000)/100;
	    yyDay = (yyvsp[-6].Number) % 100;
	    yyHour = (yyvsp[-4].Number);
	    yyMinutes = (yyvsp[-2].Number);
	    yySeconds = (yyvsp[0].Number);
	    if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT;
	    yyYear = (yyvsp[(1) - (7)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (7)].Number) % 100;
	    yyHour = (yyvsp[(3) - (7)].Number);
	    yyMinutes = (yyvsp[(5) - (7)].Number);
	    yySeconds = (yyvsp[(7) - (7)].Number);
	}

	;}
    break;

  case 40:

    {
	    yyYear = (yyvsp[-1].Number) / 10000;
	    yyMonth = ((yyvsp[-1].Number) % 10000)/100;
	    yyDay = (yyvsp[-1].Number) % 100;
	    yyHour = (yyvsp[0].Number) / 10000;
	    yyMinutes = ((yyvsp[0].Number) % 10000)/100;
	    yySeconds = (yyvsp[0].Number) % 100;
	    yyYear = (yyvsp[(1) - (2)].Number) / 10000;
	    yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100;
	    yyDay = (yyvsp[(1) - (2)].Number) % 100;
	    yyHour = (yyvsp[(2) - (2)].Number) / 10000;
	    yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100;
	    yySeconds = (yyvsp[(2) - (2)].Number) % 100;
	}

	;}
    break;

  case 41:

    {
	    /*
	     * Offset computed year by -377 so that the returned years will be
	     * in a range accessible with a 32 bit clock seconds value.
	     */

	    yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377;
	    yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377;
	    yyDay  = 1;
	    yyMonth = 1;
	    yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += (yyvsp[0].Number) * 144 * 60;
	    yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
	    yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60;
	}

	;}
    break;

  case 42:

    {
	    yyRelSeconds *= -1;
	    yyRelMonth *= -1;
	    yyRelDay *= -1;
	}

	;}
    break;

  case 44:

    {
	    *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number);
	    *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
	}

	;}
    break;

  case 45:

    {
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	    *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number);
	}

	;}
    break;

  case 46:

    {
	    *yyRelPointer += (yyvsp[0].Number);
	    *yyRelPointer += (yyvsp[(2) - (2)].Number);
	}

	;}
    break;

  case 47:

    {
	    *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
	    *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
	}

	;}
    break;

  case 48:

    {
	    *yyRelPointer += (yyvsp[0].Number);
	    *yyRelPointer += (yyvsp[(1) - (1)].Number);
	}

	;}
    break;

  case 49:

    {
	    (yyval.Number) = -1;
	}

	;}
    break;

  case 50:

    {
	    (yyval.Number) =  1;
	}

	;}
    break;

  case 51:

    {
	    (yyval.Number) = (yyvsp[0].Number);
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    yyRelPointer = &yyRelSeconds;
	}

	;}
    break;

  case 52:

    {
	    (yyval.Number) = (yyvsp[0].Number);
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    yyRelPointer = &yyRelDay;
	}

	;}
    break;

  case 53:

    {
	    (yyval.Number) = (yyvsp[0].Number);
	    (yyval.Number) = (yyvsp[(1) - (1)].Number);
	    yyRelPointer = &yyRelMonth;
	}

	;}
    break;

  case 54:

    {
	    if (yyHaveTime && yyHaveDate && !yyHaveRel) {
		yyYear = (yyvsp[0].Number);
		yyYear = (yyvsp[(1) - (1)].Number);
	    } else {
		yyHaveTime++;
		if (yyDigitCount <= 2) {
		    yyHour = (yyvsp[0].Number);
		    yyHour = (yyvsp[(1) - (1)].Number);
		    yyMinutes = 0;
		} else {
		    yyHour = (yyvsp[0].Number) / 100;
		    yyMinutes = (yyvsp[0].Number) % 100;
		    yyHour = (yyvsp[(1) - (1)].Number) / 100;
		    yyMinutes = (yyvsp[(1) - (1)].Number) % 100;
		}
		yySeconds = 0;
		yyMeridian = MER24;
	    }
	}

	;}
    break;

  case 55:

    {
	    (yyval.Meridian) = MER24;
	}

	;}
    break;

  case 56:

    {
	    (yyval.Meridian) = (yyvsp[0].Meridian);
	    (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
	}

	;}
    break;


/* Line 1267 of yacc.c.  */

      default: break;
    }
  /* User semantic actions sometimes alter yychar, and that requires
     that yytoken be updated with the new translation.  We take the
     approach of translating immediately before every use of yytoken.
     One alternative is translating here after every semantic action,
     but that translation would be missed if the semantic action invokes
     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
     incorrect destructor might then be invoked immediately.  In the
     case of YYERROR or YYBACKUP, subsequent parser actions might lead
     to an incorrect destructor call or verbose syntax error message
     before the lookahead is translated.  */
  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);

  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);

  *++yyvsp = yyval;
  *++yylsp = yyloc;

  /* Now 'shift' the result of the reduction.  Determine what state
  /* Now `shift' the result of the reduction.  Determine what state
     that goes to, based on the state we popped back to and the rule
     number reduced by.  */

  yyn = yyr1[yyn];

  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
    yystate = yytable[yystate];
  else
    yystate = yydefgoto[yyn - YYNTOKENS];

  goto yynewstate;


/*--------------------------------------.
| yyerrlab -- here on detecting error.  |
`--------------------------------------*/
/*------------------------------------.
| yyerrlab -- here on detecting error |
`------------------------------------*/
yyerrlab:
  /* Make sure we have latest lookahead translation.  See comments at
     user semantic actions for why this is necessary.  */
  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);

  /* If not already recovering from an error, report this error.  */
  if (!yyerrstatus)
    {
      ++yynerrs;
#if ! YYERROR_VERBOSE
      yyerror (&yylloc, info, YY_("syntax error"));
#else
# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
                                        yyssp, yytoken)
      {
        char const *yymsgp = YY_("syntax error");
        int yysyntax_error_status;
	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
        yysyntax_error_status = YYSYNTAX_ERROR;
        if (yysyntax_error_status == 0)
	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
          yymsgp = yymsg;
        else if (yysyntax_error_status == 1)
          {
            if (yymsg != yymsgbuf)
              YYSTACK_FREE (yymsg);
            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
            if (!yymsg)
              {
                yymsg = yymsgbuf;
                yymsg_alloc = sizeof yymsgbuf;
	  {
	    YYSIZE_T yyalloc = 2 * yysize;
	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
	    if (yymsg != yymsgbuf)
	      YYSTACK_FREE (yymsg);
	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
	    if (yymsg)
	      yymsg_alloc = yyalloc;
	    else
	      {
		yymsg = yymsgbuf;
		yymsg_alloc = sizeof yymsgbuf;
                yysyntax_error_status = 2;
              }
            else
              {
                yysyntax_error_status = YYSYNTAX_ERROR;
                yymsgp = yymsg;
              }
	      }
	  }

	if (0 < yysize && yysize <= yymsg_alloc)
	  {
	    (void) yysyntax_error (yymsg, yystate, yychar);
	    yyerror (&yylloc, info, yymsg);
	  }
          }
        yyerror (&yylloc, info, yymsgp);
        if (yysyntax_error_status == 2)
          goto yyexhaustedlab;
      }
	else
	  {
	    yyerror (&yylloc, info, YY_("syntax error"));
	    if (yysize != 0)
	      goto yyexhaustedlab;
	  }
# undef YYSYNTAX_ERROR
      }
#endif
    }

  yyerror_range[1] = yylloc;
  yyerror_range[0] = yylloc;

  if (yyerrstatus == 3)
    {
      /* If just tried and failed to reuse lookahead token after an
         error, discard it.  */
      /* If just tried and failed to reuse look-ahead token after an
	 error, discard it.  */

      if (yychar <= YYEOF)
        {
          /* Return failure if at end of input.  */
          if (yychar == YYEOF)
            YYABORT;
        }
	{
	  /* Return failure if at end of input.  */
	  if (yychar == YYEOF)
	    YYABORT;
	}
      else
        {
          yydestruct ("Error: discarding",
                      yytoken, &yylval, &yylloc, info);
          yychar = YYEMPTY;
        }
	{
	  yydestruct ("Error: discarding",
		      yytoken, &yylval, &yylloc, info);
	  yychar = YYEMPTY;
	}
    }

  /* Else will try to reuse lookahead token after shifting the error
  /* Else will try to reuse look-ahead token after shifting the error
     token.  */
  goto yyerrlab1;


/*---------------------------------------------------.
| yyerrorlab -- error raised explicitly by YYERROR.  |
`---------------------------------------------------*/
yyerrorlab:

  /* Pacify compilers like GCC when the user code never invokes
     YYERROR and the label yyerrorlab therefore never appears in user
     code.  */
  if (/*CONSTCOND*/ 0)
     goto yyerrorlab;

  yyerror_range[0] = yylsp[1-yylen];
  /* Do not reclaim the symbols of the rule whose action triggered
  /* Do not reclaim the symbols of the rule which action triggered
     this YYERROR.  */
  YYPOPSTACK (yylen);
  yylen = 0;
  YY_STACK_PRINT (yyss, yyssp);
  yystate = *yyssp;
  goto yyerrlab1;


/*-------------------------------------------------------------.
| yyerrlab1 -- common code for both syntax error and YYERROR.  |
`-------------------------------------------------------------*/
yyerrlab1:
  yyerrstatus = 3;      /* Each real token shifted decrements this.  */
  yyerrstatus = 3;	/* Each real token shifted decrements this.  */

  for (;;)
    {
      yyn = yypact[yystate];
      if (!yypact_value_is_default (yyn))
        {
          yyn += YYTERROR;
          if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
            {
              yyn = yytable[yyn];
              if (0 < yyn)
                break;
            }
        }
      if (yyn != YYPACT_NINF)
	{
	  yyn += YYTERROR;
	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
	    {
	      yyn = yytable[yyn];
	      if (0 < yyn)
		break;
	    }
	}

      /* Pop the current state because it cannot handle the error token.  */
      if (yyssp == yyss)
        YYABORT;
	YYABORT;

      yyerror_range[1] = *yylsp;
      yyerror_range[0] = *yylsp;
      yydestruct ("Error: popping",
                  yystos[yystate], yyvsp, yylsp, info);
		  yystos[yystate], yyvsp, yylsp, info);
      YYPOPSTACK (1);
      yystate = *yyssp;
      YY_STACK_PRINT (yyss, yyssp);
    }

  if (yyn == YYFINAL)
    YYACCEPT;
  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN

  *++yyvsp = yylval;
  YY_IGNORE_MAYBE_UNINITIALIZED_END

  yyerror_range[2] = yylloc;
  yyerror_range[1] = yylloc;
  /* Using YYLLOC is tempting, but would change the location of
     the lookahead.  YYLOC is available though.  */
  YYLLOC_DEFAULT (yyloc, yyerror_range, 2);
     the look-ahead.  YYLOC is available though.  */
  YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
  *++yylsp = yyloc;

  /* Shift the error token.  */
  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);

  yystate = yyn;
  goto yynewstate;
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
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







-
+










-
+
-
-
-
-
-
-
+
+
-
-
+






-
+










+
-
+



+
+
+
+
+
+







/*-----------------------------------.
| yyabortlab -- YYABORT comes here.  |
`-----------------------------------*/
yyabortlab:
  yyresult = 1;
  goto yyreturn;

#if !defined yyoverflow || YYERROR_VERBOSE
#ifndef yyoverflow
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here.  |
`-------------------------------------------------*/
yyexhaustedlab:
  yyerror (&yylloc, info, YY_("memory exhausted"));
  yyresult = 2;
  /* Fall through.  */
#endif

yyreturn:
  if (yychar != YYEMPTY)
  if (yychar != YYEOF && yychar != YYEMPTY)
    {
      /* Make sure we have latest lookahead translation.  See comments at
         user semantic actions for why this is necessary.  */
      yytoken = YYTRANSLATE (yychar);
      yydestruct ("Cleanup: discarding lookahead",
                  yytoken, &yylval, &yylloc, info);
     yydestruct ("Cleanup: discarding lookahead",
		 yytoken, &yylval, &yylloc, info);
    }
  /* Do not reclaim the symbols of the rule whose action triggered
  /* Do not reclaim the symbols of the rule which action triggered
     this YYABORT or YYACCEPT.  */
  YYPOPSTACK (yylen);
  YY_STACK_PRINT (yyss, yyssp);
  while (yyssp != yyss)
    {
      yydestruct ("Cleanup: popping",
                  yystos[*yyssp], yyvsp, yylsp, info);
		  yystos[*yyssp], yyvsp, yylsp, info);
      YYPOPSTACK (1);
    }
#ifndef yyoverflow
  if (yyss != yyssa)
    YYSTACK_FREE (yyss);
#endif
#if YYERROR_VERBOSE
  if (yymsg != yymsgbuf)
    YYSTACK_FREE (yymsg);
#endif
  /* Make sure YYID is used.  */
  return yyresult;
  return YYID (yyresult);
}




MODULE_SCOPE int yychar;
MODULE_SCOPE YYSTYPE yylval;
MODULE_SCOPE int yynerrs;

/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {
    { "january",	tMONTH,	 1 },
    { "february",	tMONTH,	 2 },
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
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







-
+

















-
+







    { "wednesday",	tDAY, 3 },
    { "wednes",		tDAY, 3 },
    { "thursday",	tDAY, 4 },
    { "thur",		tDAY, 4 },
    { "thurs",		tDAY, 4 },
    { "friday",		tDAY, 5 },
    { "saturday",	tDAY, 6 },
    { NULL, 0, 0 }
    { NULL }
};

/*
 * Time units table.
 */

static const TABLE UnitsTable[] = {
    { "year",		tMONTH_UNIT,	12 },
    { "month",		tMONTH_UNIT,	 1 },
    { "fortnight",	tDAY_UNIT,	14 },
    { "week",		tDAY_UNIT,	 7 },
    { "day",		tDAY_UNIT,	 1 },
    { "hour",		tSEC_UNIT, 60 * 60 },
    { "minute",		tSEC_UNIT,	60 },
    { "min",		tSEC_UNIT,	60 },
    { "second",		tSEC_UNIT,	 1 },
    { "sec",		tSEC_UNIT,	 1 },
    { NULL, 0, 0 }
    { NULL }
};

/*
 * Assorted relative-time words.
 */

static const TABLE OtherTable[] = {
2361
2362
2363
2364
2365
2366
2367
2368

2369
2370
2371
2372
2373
2374
2375
2364
2365
2366
2367
2368
2369
2370

2371
2372
2373
2374
2375
2376
2377
2378







-
+







    { "tenth",		tUNUMBER,	10 },
    { "eleventh",	tUNUMBER,	11 },
    { "twelfth",	tUNUMBER,	12 },
#endif
    { "ago",		tAGO,		1 },
    { "epoch",		tEPOCH,		0 },
    { "stardate",	tSTARDATE,	0 },
    { NULL, 0, 0 }
    { NULL }
};

/*
 * The timezone table. (Note: This table was modified to not use any floating
 * point constants to work around an SGI compiler bug).
 */

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
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







-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
+




-
+







    { "nzt",	tZONE,	  -HOUR(12) },	    /* New Zealand */
    { "nzst",	tZONE,	  -HOUR(12) },	    /* New Zealand Standard */
    { "nzdt",	tDAYZONE, -HOUR(12) },	    /* New Zealand Daylight */
    { "idle",	tZONE,	  -HOUR(12) },	    /* International Date Line East */
    /* ADDED BY Marco Nijdam */
    { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
    /* End ADDED */
    { NULL, 0, 0 }
    {  NULL  }
};

/*
 * Military timezone table.
 */

static const TABLE MilitaryTable[] = {
    { "a",	tZONE,	-HOUR( 1) + HOUR(100) },
    { "b",	tZONE,	-HOUR( 2) + HOUR(100) },
    { "c",	tZONE,	-HOUR( 3) + HOUR(100) },
    { "d",	tZONE,	-HOUR( 4) + HOUR(100) },
    { "e",	tZONE,	-HOUR( 5) + HOUR(100) },
    { "f",	tZONE,	-HOUR( 6) + HOUR(100) },
    { "g",	tZONE,	-HOUR( 7) + HOUR(100) },
    { "h",	tZONE,	-HOUR( 8) + HOUR(100) },
    { "i",	tZONE,	-HOUR( 9) + HOUR(100) },
    { "k",	tZONE,	-HOUR(10) + HOUR(100) },
    { "l",	tZONE,	-HOUR(11) + HOUR(100) },
    { "m",	tZONE,	-HOUR(12) + HOUR(100) },
    { "n",	tZONE,	HOUR(  1) + HOUR(100) },
    { "o",	tZONE,	HOUR(  2) + HOUR(100) },
    { "p",	tZONE,	HOUR(  3) + HOUR(100) },
    { "q",	tZONE,	HOUR(  4) + HOUR(100) },
    { "r",	tZONE,	HOUR(  5) + HOUR(100) },
    { "s",	tZONE,	HOUR(  6) + HOUR(100) },
    { "t",	tZONE,	HOUR(  7) + HOUR(100) },
    { "u",	tZONE,	HOUR(  8) + HOUR(100) },
    { "v",	tZONE,	HOUR(  9) + HOUR(100) },
    { "w",	tZONE,	HOUR( 10) + HOUR(100) },
    { "x",	tZONE,	HOUR( 11) + HOUR(100) },
    { "y",	tZONE,	HOUR( 12) + HOUR(100) },
    { "z",	tZONE,	HOUR( 0)  + HOUR(100) },
    { NULL, 0, 0 }
    { "a",	tZONE,	-HOUR( 1) },
    { "b",	tZONE,	-HOUR( 2) },
    { "c",	tZONE,	-HOUR( 3) },
    { "d",	tZONE,	-HOUR( 4) },
    { "e",	tZONE,	-HOUR( 5) },
    { "f",	tZONE,	-HOUR( 6) },
    { "g",	tZONE,	-HOUR( 7) },
    { "h",	tZONE,	-HOUR( 8) },
    { "i",	tZONE,	-HOUR( 9) },
    { "k",	tZONE,	-HOUR(10) },
    { "l",	tZONE,	-HOUR(11) },
    { "m",	tZONE,	-HOUR(12) },
    { "n",	tZONE,	HOUR(  1) },
    { "o",	tZONE,	HOUR(  2) },
    { "p",	tZONE,	HOUR(  3) },
    { "q",	tZONE,	HOUR(  4) },
    { "r",	tZONE,	HOUR(  5) },
    { "s",	tZONE,	HOUR(  6) },
    { "t",	tZONE,	HOUR(  7) },
    { "u",	tZONE,	HOUR(  8) },
    { "v",	tZONE,	HOUR(  9) },
    { "w",	tZONE,	HOUR( 10) },
    { "x",	tZONE,	HOUR( 11) },
    { "y",	tZONE,	HOUR( 12) },
    { "z",	tZONE,	HOUR( 0) },
    { NULL }
};

/*
 * Dump error messages in the bit bucket.
 */

static void
TclDateerror(
    YYLTYPE* location,
    DateInfo* infoPtr,
    const char *s)
{
    Tcl_Obj* t;
    Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
    Tcl_AppendToObj(infoPtr->messages, s, -1);
    Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
    TclNewIntObj(t, location->first_column);
    t = Tcl_NewIntObj(location->first_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, "-", -1);
    TclNewIntObj(t, location->last_column);
    t = Tcl_NewIntObj(location->last_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, ")", -1);
    infoPtr->separatrix = "\n";
}

2545
2546
2547
2548
2549
2550
2551
2552
2553
2554



2555
2556
2557
2558
2559
2560
2561
2548
2549
2550
2551
2552
2553
2554



2555
2556
2557
2558
2559
2560
2561
2562
2563
2564







-
-
-
+
+
+







}

static int
LookupWord(
    YYSTYPE* yylvalPtr,
    char *buff)
{
    char *p;
    char *q;
    const TABLE *tp;
    register char *p;
    register char *q;
    register const TABLE *tp;
    int i, abbrev;

    /*
     * Make it lowercase.
     */

    Tcl_UtfToLower(buff);
2670
2671
2672
2673
2674
2675
2676
2677
2678


2679
2680
2681
2682
2683
2684
2685
2673
2674
2675
2676
2677
2678
2679


2680
2681
2682
2683
2684
2685
2686
2687
2688







-
-
+
+








static int
TclDatelex(
    YYSTYPE* yylvalPtr,
    YYLTYPE* location,
    DateInfo *info)
{
    char c;
    char *p;
    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProcM(*yyInput)) {
	    yyInput++;
2740
2741
2742
2743
2744
2745
2746
2747

2748
2749
2750


2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764

2765
2766
2767
2768
2769
2770
2771
2743
2744
2745
2746
2747
2748
2749

2750
2751


2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766

2767
2768
2769
2770
2771
2772
2773
2774







-
+

-
-
+
+













-
+







	    }
	} while (Count > 0);
    }
}

int
TclClockOldscanObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Count of paraneters */
    Tcl_Obj *const *objv)	/* Parameters */
    int objc,			/* Count of parameters */
    Tcl_Obj *CONST *objv)	/* Parameters */
{
    Tcl_Obj *result, *resultElement;
    int yr, mo, da;
    DateInfo dateInfo;
    DateInfo* info = &dateInfo;
    int status;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    yyInput = TclGetString(objv[1]);
    yyInput = Tcl_GetString( objv[1] );
    dateInfo.dateStart = yyInput;

    yyHaveDate = 0;
    if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
	    || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
	    || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
	return TCL_ERROR;
2783
2784
2785
2786
2787
2788
2789
2790

2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848


2849
2850
2851

2852
2853

2854
2855

2856
2857
2858
2859
2860
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

2786
2787
2788
2789
2790
2791
2792

2793
2794
2795
2796
2797
2798
2799
2800

2801
2802
2803
2804

2805
2806
2807
2808
2809
2810
2811

2812
2813
2814
2815
2816
2817
2818

2819
2820
2821
2822
2823

2824
2825
2826
2827
2828

2829
2830
2831
2832
2833

2834
2835
2836
2837
2838

2839
2840
2841


2842
2843
2844
2845

2846
2847

2848
2849

2850
2851
2852
2853
2854


2855
2856
2857
2858
2859
2860

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







-
+







-




-







-







-





-





-





-





-



-
-
+
+


-
+

-
+

-
+




-
-
+
+




-
+


-
+





-
+


-
+

-
+

-
+



-
+


-
+

-
+



-
+


-
+

-
+














+

    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

    TclNewObj(dateInfo.messages);
    dateInfo.messages = Tcl_NewObj();
    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
	return TCL_ERROR;
    } else if (status == 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    } else if (status != 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
						  "from date parser. Please "
						  "report this error as a "
						  "bug in Tcl.", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(dateInfo.messages);

    if (yyHaveDate > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one date in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveTime > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time of day in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveZone > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time zone in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveDay > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one weekday in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveOrdinalMonth > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one ordinal month in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }

    TclNewObj(result);
    TclNewObj(resultElement);
    result = Tcl_NewObj();
    resultElement = Tcl_NewObj();
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyYear));
		Tcl_NewIntObj((int) yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
		Tcl_NewIntObj((int) yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDay));
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    TclNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(-yyTimezone));
		Tcl_NewIntObj((int) -yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelMonth));
		Tcl_NewIntObj((int) yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelDay));
		Tcl_NewIntObj((int) yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelSeconds));
		Tcl_NewIntObj((int) yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayOrdinal));
		Tcl_NewIntObj((int) yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayNumber));
		Tcl_NewIntObj((int) yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonthOrdinal));
		Tcl_NewIntObj((int) yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
		Tcl_NewIntObj((int) yyMonth));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclDecls.h.

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
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
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
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
611
612




613
614
615




616
617
618





619
620
621






622
623




624
625



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
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
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
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




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
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






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
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
1439



1440
1441
1442

1443



1444
1445
1446



1447
1448
1449



1450
1451
1452



1453
1454
1455



1456
1457
1458



1459
1460
1461



1462
1463
1464



1465
1466
1467



1468
1469
1470



1471
1472
1473
1474



1475
1476
1477
1478




1479
1480
1481
1482




1483
1484
1485




1486
1487




1488
1489

1490



1491
1492




1493
1494
1495




1496
1497
1498




1499
1500
1501



1502
1503
1504




1505
1506
1507



1508
1509
1510



1511
1512



1513
1514



1515
1516
1517




1518
1519
1520



1521
1522
1523



1524
1525
1526



1527
1528



1529
1530



1531
1532

1533



1534
1535
1536
1537






1538
1539
1540



1541
1542
1543
1544





1545
1546
1547





1548
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

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
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

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
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
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
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


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
2658


2659
2660


2661
2662


2663
2664


2665
2666


2667
2668


2669
2670


2671
2672


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
2709



2710



2711
2712


2713
2714


2715
2716


2717
2718


2719
2720


2721
2722


2723
2724


2725
2726


2727
2728


2729
2730


2731
2732


2733
2734



2735



2736
2737


2738
2739



2740



2741
2742


2743
2744


2745
2746


2747
2748


2749
2750


2751
2752


2753
2754


2755
2756


2757
2758


2759
2760


2761
2762


2763
2764


2765
2766


2767
2768


2769
2770


2771
2772


2773
2774




2775
2776


2777
2778

2779


2780
2781

2782
2783

2784
2785

2786

2787
2788


2789
2790


2791
2792


2793
2794


2795
2796




2797
2798



2799
2800







2801
2802



2803
2804







2805
2806


2807
2808


2809
2810


2811
2812


2813
2814


2815
2816


2817
2818


2819
2820


2821
2822

2823

2824
2825


2826
2827


2828
2829


2830
2831


2832
2833


2834
2835


2836
2837


2838
2839


2840
2841


2842
2843


2844
2845


2846
2847


2848
2849


2850
2851


2852
2853


2854
2855


2856
2857


2858
2859


2860
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


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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803

3804


3805
3806





3807


3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822

3823
3824

3825
3826
3827
3828
3829
3830

3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842

3843
3844

3845
3846
3847
3848
3849
3850
3851

3852
3853
3854

3855
3856
3857

3858
3859

3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885

3886
3887
3888




3889
3890

3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
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
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
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
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
611
612
613
614
615
616


617
618
619
620
621
622
623

624
625
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
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
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
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
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

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
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
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
1439
1440
1441
1442

1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453


1454
1455
1456
1457
1458
1459






1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490



1491
1492
1493
1494
1495
1496
1497
1498
1499

1500
1501
1502
1503
1504


1505
1506
1507
1508
1509
1510
1511

1512
1513
1514
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528



1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543

1544
1545

1546
1547
1548
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
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
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
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


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
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

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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742

2743
2744
2745
2746
2747


2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764

2765


2766
2767
2768
2769
2770

2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790


2791
2792
2793
2794
2795
2796

2797
2798
2799
2800
2801

2802
2803
2804
2805
2806

2807
2808
2809
2810
2811
2812

2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827

2828
2829
2830
2831
2832
2833

2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845

2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858

2859
2860
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
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
3775
3776
3777
3778
3779



3780
3781
3782
3783
3784

3785
3786


3787
3788
3789
3790


3791
3792
3793

3794
3795
3796
3797
3798




3799
3800
3801
3802
3803










3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814







3815
3816
3817
3818
3819
3820
3821
3822








3823
3824
3825
3826
3827
3828
3829
3830
3831







3832
3833
3834
3835
3836
3837
3838
3839

3840
3841
3842

3843
3844
3845
3846

3847
3848






3849
3850
3851
3852
3853
3854
3855



3856
3857
3858
3859

3860
3861
3862


3863
3864
3865




3866
3867
3868
3869
3870
3871
3872







3873
3874
3875
3876
3877
3878
3879
3880
3881




3882
3883
3884
3885
3886









3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897

3898
3899


3900
3901
3902



3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913




3914
3915
3916
3917
3918

3919
3920






3921
3922
3923
3924
3925
3926
3927






3928
3929
3930
3931
3932
3933
3934
3935
3936
3937

3938
3939







3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950


3951
3952
3953
3954



3955
3956
3957
3958
3959














3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979






3980
3981
3982
3983
3984
3985
3986








3987
3988
3989
3990
3991
3992
3993
3994
3995
3996


3997
3998
3999
4000
4001
4002
4003
4004
4005


4006
4007
4008
4009
4010
4011
4012
4013
4014

4015
4016
4017

4018
4019
4020
4021
4022
4023
4024
4025


4026
4027
4028
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366

4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382

4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422

4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474

4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489

4490
4491
4492
4493
4494
4495
4496
4497

4498
4499
4500
4501
4502
4503
4504
4505
4506

4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525

4526
4527
4528
4529
4530
4531
4532
4533

4534
4535
4536
4537
4538
4539
4540
4541
4542


4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589

4590

4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603

4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
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
4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166

5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206

5207
5208
5209
5210
5211
5212
5213
5214

5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234

5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262




5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298

5299
5300
5301
5302
5303
5304
5305
5306

5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318

5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330

5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354


5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368

5369
5370
5371
5372
5373
5374
5375
5376
5377
5378




5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398

5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443

5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539


5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626


5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647


5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691






5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711

5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811

5812
5813
5814
5815
5816
5817
5818
5819

5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887

5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903

5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959




5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023


6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
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
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
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600




























6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628




































6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
































6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683








6684
6685



























6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712







6713

6714
6715
6716
6717



6718













6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737

6738
6739
6740

6741
6742
6743

6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765




































6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803

6804


6805






6806












6807


6808







6809



6810



6811


6812




















6813
6814
6815
6816
6817
6818
6819



6820
6821
6822
6823


6824



































6825













6826







-
-
-
-
-
-
-
-
-

















+
+


-
-
+
+
+
+
+

-
-
-
+
+
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+

+
+
+

-
+
+
+
+

-
-
-
+
+
+
+
+
+


-
+
+


+
+


-
+
+

-
+
+
+


+


+
+


+

+
+

-
+
+
+
+


+
+
+

-
+
+
+
+



+
+
+


+
+
+

-
-
+
+
+
+
+

-
+
+
+
+


-
+
+
+
+

-
+

+
+
+

-
+

+
+
+

-
+

+
+
+
-
+
+
+
+
+
+

-
-
+
+
+
+
+


-
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+
+


+
+
+


+
+
+

-
-
+
+
+
+
+


-
+
+
+
+



+
+
+

-
+

+
+
+



+
+
+
-
+
+
+
+
+
+
+

-
+

+
+
+



+
+
+



+
+
+

-
+
+
+
+


+
+
+


+
+
+



+
+
+



+
+
+




+
+
+




+
+
+



+
+
+



-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+


+
+
+
-
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+


+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+


-
+
+
+
+


+
+
+
-
+
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+


-
+
+
+
+


+
+
+


-
+
+
+
+


+
+
+


+
+
+


+
+
+


+
+
+
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+


-
+
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+

+
+
+

-
-
+
+
+
+
+


-
-
-
+
+
+
+
+
+


-
-
-
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
-
+
+

+
+
+



-
+
+
+
+


-
+
+
+
+


+
+
+
-
+
+
+
+
+
+
+
+


-
-
+
+

+
+
+

-
+

+
+
+


-
+
+
+
+


-
+
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+



+
+
+


-
+
+
+
+



-
+
+
+
+


-
+
+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


-
+
+
+
+
+


+
+
+

-
+
+
+
+
+


-
+
+
+
+


-
+
+
+
+


+
+
+


+
+
+



+
+
+


+
+
+



+
+
+

-
-
+
+
+
+


+
+
+


+
+
+

-
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+

-
+

+
+
+

-
+
+
+
+


-
-
+
+
+
+
+

-
+

+
+
+



+
+
+

-
+

+
+
+



+
+
+

-
+

+
+
+



+
+
+



+
+
+

-
+
+
+
+


+
+
+
-
+
+
+
+
+



+
+
+


+
+
+
-
+
+
+
+
+


-
+

-
-
+
+
+
+
+


-
+

-
+

+
+
+

-
-
+
+

+
+
+


-
+
+
+
+


+
+
+


-
+
+
+
+

-
+
+
+
+


+
+
+

-
+
+
+
+


-
+

+
+
+

-
+
+
+
+


-
+
+
+
+

-
+

+
+
+


+
+
+

-
+
+
+
+



+
+
+

-
+
+
+
+

-
+
+
+
+


+
-
+
+
+


-
-
+
+
+


+
+


-
-
+
+
+

+
+

-
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
-
-
+

-
+
+
+
+
+


+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+


+
+
+



+
+
+


+
+
+


+
+
+


+
+
+


+
+
+

-
+

+
+
+

-
-
+
+
+

+
+

-
+
+
+
+


+
+
+

-
+
+
+
+

-
+
+
+
+


+
+
+


+
+
+



+
+
+




+
+
+


-
+
+
+
+


-
+

+
+
+


-
-
+
+
+
+
+


-
+

-
+
+
+
+

-
+
+
+
+



+
+
+

-
+
+
+
+

-
+
+
+
+



+
+
+

-
-
+
+
+
+


+
+
+


-
+
+
+
+



+
+
+



+
+
+

-
+
+
+
+


-
+
+
+
+


-
+
+
+
+

-
-
+
+
+
+
+

-
-
+
+
+
+
+
+

-
+
+
+
+


+
+
+

-
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+


+
+
+


+
+
+


-
-
+
+
+
+
+


+
+
+


-
-
+
+
+
+
+


-
-
+
+
+
+
+


+
+
+


+
+
+

-
-
+
+
+
+
+
+
+
+
+


+
+
+
-
+
+
+
+
+
+


+
+
+



+
+
+



+
+
+


+
+
+
-
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+

-
+
+
+
+

-
+
+
+
+


+
+
+


-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+


-
+
+
+
+

-
-
+
+
+
+
+


-
+
+
+
+



+
+
+
-
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+


+
+
+
-
+
+
+
+
+
+
+
+

-
-
+
+

-
+
+
+
+

-
-
+
+
+
+


-
+
+
+
+

-
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+
+
+
+
+



+
+
+


+
+
+


-
-
+
+

+
+
+



+
+
+


+
+
+


+

+
+



+
+
+

-
+
+
+
+


-
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+


-
+
+
+
+



+
+
+

-
+
+
+
+


-
-
+
+

-
+

+
+
+


-
+

+
+
+


+
+
+

-
+
+
+
+


+
+
+


+
+
+

-
+
+
+
+

-
+
+
+
+


+
+
+


-
-
+
+

+
+
+

-
-
+
+
+
+
+

-
-
+
+
+
+
+

-
+
+
+
+


+
+
+


+
+
+


+
+
+


-
+
+
+
+

-
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
+
+
+

-
-
+
+

+
+
+


+
+
+



+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+


+
+
+

-
+
+
+
+

-
+
+
+
+

-
+

+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+


-
-
+
+

-
+

+
+
+


-
+

+
+
+


+
+
+


+
+
+

-
+
-
+
+
+


+
+
+

-
-
+
+
+
+
+

-
+
+
+
+


+
+
+
-
-
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+

-
-
+
+
+
+
+



+
+
+
-
+
+
+
+
+
+


+
+
+


-
-
+
+
+
+
+


-
+

-
+
+
+
+


-
-
+
+
+
+
+

-
-
+
+
+
+
+


-
+

-
+
+
+
+


-
+

+
+
+


+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+
+

-
-
+
+
+
+
+

-
-
+
+
+
+
+


+
+
+


+
+
+


+
+
+


+
+
+



-
+
+
+
+



+
+
+

-
-
+
+
+
+
+


-
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+



+
+
+


+
+
+


+
+
+


+
+
+


-
+
+
+
+

-
-
+
+
+
+
+
+


+
+
+


+
+
+


-
-
+
+
+
+
+
+

-
-
+
+
+
+
+

-
-
+
+
+
+
+


+
+
+


+
+
+

+
-
+
+
+
+


-
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


+
+
+


+
+
+



+
+
+


+
+
+


+
+
+


+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
+
+
+


+
+
+

-
-
+
+

-
+
+
+
+


-
-
+
+
+
+
+
+


-
-
+
+
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+
+

-
-
+
+
+
+


+
+
+



+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+
+
+



+
+
+


+
+
+



+
+
+



+
+
+


+
+
+


+
+
+


-
+




+
+
+



-
+
+
+
+



+
+
+



+
+
+



+
+
+


+
+
+


+
+
+



+
+
+



+
+
+

-
+

+
+
+


+
+
+


+
+
+


-
+

+
+
+


+
+
+


+
+
+



+
+
+


+
+
+


+
+
+



+
+
+



+
+
+


-
+
+
+
+

-
-
+
+
+
+
+



+
+
+


+
+
+

-
+
-
-
+
+
+
+

-
+
+
+
+


+
+
+


+
+
+


+
+
+

-
-
+
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+

+
+
+

-
+
+
+
+


+
+
+


+
+
+

-
+
+
+
+


-
+
+
+
+


+
+
+



-
+

+
+
+



+
+
+


-
+
+
+
+


-
+
+
+
+



+
+
+


+
+
+



+
+
+


+
+
+



+
+
+


+
+
+


-
+
+
+
+



+
+
+



+
+
+



+
+
+



+
+
+





+
+
+




+
+
+


+
+
+



-
+
+
+
+



-
+
+
+
+


+
+
+

-
+
+
+
+


-
-
-
+
+
+
+
+
+


-
+

+
+
+


+
+
+



+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


+
+
+


+
+
+


-
+

+
+
+

-
+

+
+
+



+
+
+



+
+
+


-
-
+
+
+
+
+
+
+
+
+



-
+

+
+
+



-
+
+
+
+


+
+
+


+
+
+


+
+
+



+
+
+



+
+
+



+
+
+


+
+
+


+
+
+


+
+
+


+
+
+


+
+
+



+
+
+


+
+
+


+
+
+



+
+
+


+
+
+



+
+
+


+
+
+


+
+
+


-
+

+
+
+



+
+
+



+
+
+



+
+
+



+
+
+



+
+
+



+
+
+



+
+
+



+
+
+



+
+
+




+
+
+



-
+
+
+
+



-
+
+
+
+


-
+
+
+
+

-
+
+
+
+

-
+

+
+
+

-
+
+
+
+


-
+
+
+
+


-
+
+
+
+



+
+
+


-
+
+
+
+



+
+
+



+
+
+


+
+
+


+
+
+


-
+
+
+
+



+
+
+



+
+
+



+
+
+


+
+
+


+
+
+

-
+

+
+
+


-
-
+
+
+
+
+
+



+
+
+


-
-
+
+
+
+
+

-
-
+
+
+
+
+


-
-
+
+
+
+
+

-
+
+
+
+


-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
+
-
-
+
-
-
+
-
-
-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
+
+
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-

-
-
-
-
+
+
+
+




-
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+


-
+

-
+


-
-
+
+




-
+

-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+

-
+

-
-
+
+


-
+







-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+

-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+






-
+

-
-
-
+
+
+





-
+


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+

-
+


-
+

-
+


-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+


-
+

-
-
-
+
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+






-
-
-
-
+
+
+
+

-
-
+
+




-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
+

-
+


-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+


-
+

-
-
+
+


-
-
+
+

-
+




-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+


-
+



-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
+


-
-
+
+

-
-
-
-
+
+
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-
+

-
-
+
+

-
-
-
+
+
+








-
-
-
-
+
+
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+




-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+




-
-
+
+


-
-
-
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
+
+







-
-
+
+







-
+


-
+







-
-
+
+


-
-
+
+



-
-
-
-
-
+
+
+
+
+


-
-
+
+

-
+

-
-
+
+






-
+







-
-
+
+

-
-
-
+
+
+


-
-
-
+
+
+


-
-
+
+


-
-
-
-
+
+
+
+



















-
+










-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+




-
+





-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+





-
+





+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
-
+
+


+


+


+

-
+
+


+


+


+

+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
+
+
+
+
+
+


+
+


+
+


-
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
+
+
+
+
+
+


+
+


+
+
+
-
+
+
+


+
+
+
-
+
+
+


+
+


-
+
+
+
+
+
+


+
+


+
+


+
+
+
-
+
+
+


+
+
+
-
+
+
+


+
+


-
-
+
+
+
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
+
+
+
+
-
+
-
+
+


+
+


+
+


+
-
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
+
+
+
+
+
+


+
+
-
-
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
-
-
+
+
+
+


+
+


+
-
+
+


+


+


+

+


+
+


+
+


+
+


+
+
-
-
+
+
+
+


+
+
+
-
-
+
+
+
+
+
+
+


+
+
+
-
-
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+

+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+
+
-
+
+
+


+
+


+
+
+
-
+
+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+
+
-
-
+
+
+
+
+
+
+


+
+


+
-
+
+
+
+
+


+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+

+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
-
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
-
-
+
+
+
+


+
+


+
+


+
+


+
+
+
-
-
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
-
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-

-
+



-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-




+


+


+


+



+

-
+
+

-
+
+

-
+
+


+


+


+


+


+


+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










+

+
+


+
+
+
+
+

+
+














-
+
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






+
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-

#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

#if !defined(BUILD_tcl)
# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
#elif defined(TCL_NO_DEPRECATED)
# define TCL_DEPRECATED(msg) MODULE_SCOPE
#else
# define TCL_DEPRECATED(msg) EXTERN
#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/tcl.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
 */

#ifndef Tcl_PkgProvideEx_TCL_DECLARED
#define Tcl_PkgProvideEx_TCL_DECLARED
/* 0 */
EXTERN int		Tcl_PkgProvideEx(Tcl_Interp *interp,
				const char *name, const char *version,
				const void *clientData);
				CONST char *name, CONST char *version,
				ClientData clientData);
#endif
#ifndef Tcl_PkgRequireEx_TCL_DECLARED
#define Tcl_PkgRequireEx_TCL_DECLARED
/* 1 */
EXTERN const char *	Tcl_PkgRequireEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
				CONST char *name, CONST char *version,
				int exact, ClientData *clientDataPtr);
#endif
#ifndef Tcl_Panic_TCL_DECLARED
#define Tcl_Panic_TCL_DECLARED
/* 2 */
EXTERN TCL_NORETURN void Tcl_Panic(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
EXTERN void		Tcl_Panic(CONST char *format, ...);
#endif
#ifndef Tcl_Alloc_TCL_DECLARED
#define Tcl_Alloc_TCL_DECLARED
/* 3 */
EXTERN void *		Tcl_Alloc(size_t size);
EXTERN char *		Tcl_Alloc(unsigned int size);
#endif
#ifndef Tcl_Free_TCL_DECLARED
#define Tcl_Free_TCL_DECLARED
/* 4 */
EXTERN void		Tcl_Free(void *ptr);
EXTERN void		Tcl_Free(char *ptr);
#endif
#ifndef Tcl_Realloc_TCL_DECLARED
#define Tcl_Realloc_TCL_DECLARED
/* 5 */
EXTERN void *		Tcl_Realloc(void *ptr, size_t size);
EXTERN char *		Tcl_Realloc(char *ptr, unsigned int size);
#endif
#ifndef Tcl_DbCkalloc_TCL_DECLARED
#define Tcl_DbCkalloc_TCL_DECLARED
/* 6 */
EXTERN void *		Tcl_DbCkalloc(size_t size, const char *file,
EXTERN char *		Tcl_DbCkalloc(unsigned int size, CONST char *file,
				int line);
#endif
#ifndef Tcl_DbCkfree_TCL_DECLARED
#define Tcl_DbCkfree_TCL_DECLARED
/* 7 */
EXTERN void		Tcl_DbCkfree(void *ptr, const char *file, int line);
EXTERN void		Tcl_DbCkfree(char *ptr, CONST char *file, int line);
#endif
#ifndef Tcl_DbCkrealloc_TCL_DECLARED
#define Tcl_DbCkrealloc_TCL_DECLARED
/* 8 */
EXTERN void *		Tcl_DbCkrealloc(void *ptr, size_t size,
				const char *file, int line);
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
EXTERN char *		Tcl_DbCkrealloc(char *ptr, unsigned int size,
				CONST char *file, int line);
#endif
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_CreateFileHandler_TCL_DECLARED
#define Tcl_CreateFileHandler_TCL_DECLARED
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
				Tcl_FileProc *proc, ClientData clientData);
#endif
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef Tcl_CreateFileHandler_TCL_DECLARED
#define Tcl_CreateFileHandler_TCL_DECLARED
/* 9 */
EXTERN void		Tcl_CreateFileHandler(int fd, int mask,
				Tcl_FileProc *proc, void *clientData);
				Tcl_FileProc *proc, ClientData clientData);
#endif
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
#define Tcl_DeleteFileHandler_TCL_DECLARED
/* 10 */
EXTERN void		Tcl_DeleteFileHandler(int fd);
#endif
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef Tcl_DeleteFileHandler_TCL_DECLARED
#define Tcl_DeleteFileHandler_TCL_DECLARED
/* 10 */
EXTERN void		Tcl_DeleteFileHandler(int fd);
#endif
#endif /* MACOSX */
#ifndef Tcl_SetTimer_TCL_DECLARED
#define Tcl_SetTimer_TCL_DECLARED
/* 11 */
EXTERN void		Tcl_SetTimer(const Tcl_Time *timePtr);
EXTERN void		Tcl_SetTimer(Tcl_Time *timePtr);
#endif
#ifndef Tcl_Sleep_TCL_DECLARED
#define Tcl_Sleep_TCL_DECLARED
/* 12 */
EXTERN void		Tcl_Sleep(int ms);
#endif
#ifndef Tcl_WaitForEvent_TCL_DECLARED
#define Tcl_WaitForEvent_TCL_DECLARED
/* 13 */
EXTERN int		Tcl_WaitForEvent(const Tcl_Time *timePtr);
EXTERN int		Tcl_WaitForEvent(Tcl_Time *timePtr);
#endif
#ifndef Tcl_AppendAllObjTypes_TCL_DECLARED
#define Tcl_AppendAllObjTypes_TCL_DECLARED
/* 14 */
EXTERN int		Tcl_AppendAllObjTypes(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
#endif
#ifndef Tcl_AppendStringsToObj_TCL_DECLARED
#define Tcl_AppendStringsToObj_TCL_DECLARED
/* 15 */
EXTERN void		Tcl_AppendStringsToObj(Tcl_Obj *objPtr, ...);
#endif
#ifndef Tcl_AppendToObj_TCL_DECLARED
#define Tcl_AppendToObj_TCL_DECLARED
/* 16 */
EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, const char *bytes,
				size_t length);
EXTERN void		Tcl_AppendToObj(Tcl_Obj *objPtr, CONST char *bytes,
				int length);
#endif
#ifndef Tcl_ConcatObj_TCL_DECLARED
#define Tcl_ConcatObj_TCL_DECLARED
/* 17 */
EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *const objv[]);
EXTERN Tcl_Obj *	Tcl_ConcatObj(int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_ConvertToType_TCL_DECLARED
#define Tcl_ConvertToType_TCL_DECLARED
/* 18 */
EXTERN int		Tcl_ConvertToType(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const Tcl_ObjType *typePtr);
				Tcl_Obj *objPtr, Tcl_ObjType *typePtr);
#endif
#ifndef Tcl_DbDecrRefCount_TCL_DECLARED
#define Tcl_DbDecrRefCount_TCL_DECLARED
/* 19 */
EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, const char *file,
EXTERN void		Tcl_DbDecrRefCount(Tcl_Obj *objPtr, CONST char *file,
				int line);
#endif
#ifndef Tcl_DbIncrRefCount_TCL_DECLARED
#define Tcl_DbIncrRefCount_TCL_DECLARED
/* 20 */
EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, CONST char *file,
				int line);
#endif
#ifndef Tcl_DbIsShared_TCL_DECLARED
#define Tcl_DbIsShared_TCL_DECLARED
/* 21 */
EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, CONST char *file,
				int line);
#endif
#ifndef Tcl_DbNewBooleanObj_TCL_DECLARED
#define Tcl_DbNewBooleanObj_TCL_DECLARED
/* Slot 22 is reserved */
/* 22 */
EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj(int boolValue, CONST char *file,
				int line);
#endif
#ifndef Tcl_DbNewByteArrayObj_TCL_DECLARED
#define Tcl_DbNewByteArrayObj_TCL_DECLARED
/* 23 */
EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
				size_t length, const char *file, int line);
EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(CONST unsigned char *bytes,
				int length, CONST char *file, int line);
#endif
#ifndef Tcl_DbNewDoubleObj_TCL_DECLARED
#define Tcl_DbNewDoubleObj_TCL_DECLARED
/* 24 */
EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
				const char *file, int line);
				CONST char *file, int line);
#endif
#ifndef Tcl_DbNewListObj_TCL_DECLARED
#define Tcl_DbNewListObj_TCL_DECLARED
/* 25 */
EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
				const char *file, int line);
/* Slot 26 is reserved */
EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *CONST *objv,
				CONST char *file, int line);
#endif
#ifndef Tcl_DbNewLongObj_TCL_DECLARED
#define Tcl_DbNewLongObj_TCL_DECLARED
/* 26 */
EXTERN Tcl_Obj *	Tcl_DbNewLongObj(long longValue, CONST char *file,
				int line);
#endif
#ifndef Tcl_DbNewObj_TCL_DECLARED
#define Tcl_DbNewObj_TCL_DECLARED
/* 27 */
EXTERN Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
EXTERN Tcl_Obj *	Tcl_DbNewObj(CONST char *file, int line);
#endif
#ifndef Tcl_DbNewStringObj_TCL_DECLARED
#define Tcl_DbNewStringObj_TCL_DECLARED
/* 28 */
EXTERN Tcl_Obj *	Tcl_DbNewStringObj(const char *bytes, size_t length,
				const char *file, int line);
EXTERN Tcl_Obj *	Tcl_DbNewStringObj(CONST char *bytes, int length,
				CONST char *file, int line);
#endif
#ifndef Tcl_DuplicateObj_TCL_DECLARED
#define Tcl_DuplicateObj_TCL_DECLARED
/* 29 */
EXTERN Tcl_Obj *	Tcl_DuplicateObj(Tcl_Obj *objPtr);
#endif
#ifndef TclFreeObj_TCL_DECLARED
#define TclFreeObj_TCL_DECLARED
/* 30 */
EXTERN void		TclFreeObj(Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetBoolean_TCL_DECLARED
#define Tcl_GetBoolean_TCL_DECLARED
/* 31 */
EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
				int *boolPtr);
EXTERN int		Tcl_GetBoolean(Tcl_Interp *interp, CONST char *src,
				int *intPtr);
#endif
#ifndef Tcl_GetBooleanFromObj_TCL_DECLARED
#define Tcl_GetBooleanFromObj_TCL_DECLARED
/* 32 */
EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *boolPtr);
				Tcl_Obj *objPtr, int *intPtr);
#endif
#ifndef Tcl_GetByteArrayFromObj_TCL_DECLARED
#define Tcl_GetByteArrayFromObj_TCL_DECLARED
/* 33 */
EXTERN unsigned char *	Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
#endif
#ifndef Tcl_GetDouble_TCL_DECLARED
#define Tcl_GetDouble_TCL_DECLARED
/* 34 */
EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, CONST char *src,
				double *doublePtr);
#endif
#ifndef Tcl_GetDoubleFromObj_TCL_DECLARED
#define Tcl_GetDoubleFromObj_TCL_DECLARED
/* 35 */
EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, double *doublePtr);
#endif
#ifndef Tcl_GetIndexFromObj_TCL_DECLARED
#define Tcl_GetIndexFromObj_TCL_DECLARED
/* Slot 36 is reserved */
/* 36 */
EXTERN int		Tcl_GetIndexFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CONST84 char **tablePtr,
				CONST char *msg, int flags, int *indexPtr);
#endif
#ifndef Tcl_GetInt_TCL_DECLARED
#define Tcl_GetInt_TCL_DECLARED
/* 37 */
EXTERN int		Tcl_GetInt(Tcl_Interp *interp, const char *src,
EXTERN int		Tcl_GetInt(Tcl_Interp *interp, CONST char *src,
				int *intPtr);
#endif
#ifndef Tcl_GetIntFromObj_TCL_DECLARED
#define Tcl_GetIntFromObj_TCL_DECLARED
/* 38 */
EXTERN int		Tcl_GetIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *intPtr);
#endif
#ifndef Tcl_GetLongFromObj_TCL_DECLARED
#define Tcl_GetLongFromObj_TCL_DECLARED
/* 39 */
EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, long *longPtr);
#endif
#ifndef Tcl_GetObjType_TCL_DECLARED
#define Tcl_GetObjType_TCL_DECLARED
/* 40 */
EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
EXTERN Tcl_ObjType *	Tcl_GetObjType(CONST char *typeName);
#endif
#ifndef Tcl_GetStringFromObj_TCL_DECLARED
#define Tcl_GetStringFromObj_TCL_DECLARED
/* 41 */
EXTERN char *		Tcl_GetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
#endif
#ifndef Tcl_InvalidateStringRep_TCL_DECLARED
#define Tcl_InvalidateStringRep_TCL_DECLARED
/* 42 */
EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
#endif
#ifndef Tcl_ListObjAppendList_TCL_DECLARED
#define Tcl_ListObjAppendList_TCL_DECLARED
/* 43 */
EXTERN int		Tcl_ListObjAppendList(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
#endif
#ifndef Tcl_ListObjAppendElement_TCL_DECLARED
#define Tcl_ListObjAppendElement_TCL_DECLARED
/* 44 */
EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_ListObjGetElements_TCL_DECLARED
#define Tcl_ListObjGetElements_TCL_DECLARED
/* 45 */
EXTERN int		Tcl_ListObjGetElements(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int *objcPtr,
				Tcl_Obj ***objvPtr);
#endif
#ifndef Tcl_ListObjIndex_TCL_DECLARED
#define Tcl_ListObjIndex_TCL_DECLARED
/* 46 */
EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int index,
				Tcl_Obj **objPtrPtr);
#endif
#ifndef Tcl_ListObjLength_TCL_DECLARED
#define Tcl_ListObjLength_TCL_DECLARED
/* 47 */
EXTERN int		Tcl_ListObjLength(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int *lengthPtr);
#endif
#ifndef Tcl_ListObjReplace_TCL_DECLARED
#define Tcl_ListObjReplace_TCL_DECLARED
/* 48 */
EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int first, int count,
				int objc, Tcl_Obj *const objv[]);
/* Slot 49 is reserved */
				int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_NewBooleanObj_TCL_DECLARED
#define Tcl_NewBooleanObj_TCL_DECLARED
/* 49 */
EXTERN Tcl_Obj *	Tcl_NewBooleanObj(int intValue);
#endif
#ifndef Tcl_NewByteArrayObj_TCL_DECLARED
#define Tcl_NewByteArrayObj_TCL_DECLARED
/* 50 */
EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
				size_t length);
EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(CONST unsigned char *bytes,
				int length);
#endif
#ifndef Tcl_NewDoubleObj_TCL_DECLARED
#define Tcl_NewDoubleObj_TCL_DECLARED
/* 51 */
EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
#endif
#ifndef Tcl_NewIntObj_TCL_DECLARED
#define Tcl_NewIntObj_TCL_DECLARED
/* Slot 52 is reserved */
/* 52 */
EXTERN Tcl_Obj *	Tcl_NewIntObj(int intValue);
#endif
#ifndef Tcl_NewListObj_TCL_DECLARED
#define Tcl_NewListObj_TCL_DECLARED
/* 53 */
EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* Slot 54 is reserved */
EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_NewLongObj_TCL_DECLARED
#define Tcl_NewLongObj_TCL_DECLARED
/* 54 */
EXTERN Tcl_Obj *	Tcl_NewLongObj(long longValue);
#endif
#ifndef Tcl_NewObj_TCL_DECLARED
#define Tcl_NewObj_TCL_DECLARED
/* 55 */
EXTERN Tcl_Obj *	Tcl_NewObj(void);
#endif
#ifndef Tcl_NewStringObj_TCL_DECLARED
#define Tcl_NewStringObj_TCL_DECLARED
/* 56 */
EXTERN Tcl_Obj *	Tcl_NewStringObj(const char *bytes, size_t length);
/* Slot 57 is reserved */
EXTERN Tcl_Obj *	Tcl_NewStringObj(CONST char *bytes, int length);
#endif
#ifndef Tcl_SetBooleanObj_TCL_DECLARED
#define Tcl_SetBooleanObj_TCL_DECLARED
/* 57 */
EXTERN void		Tcl_SetBooleanObj(Tcl_Obj *objPtr, int intValue);
#endif
#ifndef Tcl_SetByteArrayLength_TCL_DECLARED
#define Tcl_SetByteArrayLength_TCL_DECLARED
/* 58 */
EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr,
				size_t length);
EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int numBytes);
#endif
#ifndef Tcl_SetByteArrayObj_TCL_DECLARED
#define Tcl_SetByteArrayObj_TCL_DECLARED
/* 59 */
EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
				const unsigned char *bytes, size_t length);
				CONST unsigned char *bytes, int numBytes);
#endif
#ifndef Tcl_SetDoubleObj_TCL_DECLARED
#define Tcl_SetDoubleObj_TCL_DECLARED
/* 60 */
EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
#endif
#ifndef Tcl_SetIntObj_TCL_DECLARED
#define Tcl_SetIntObj_TCL_DECLARED
/* Slot 61 is reserved */
/* 61 */
EXTERN void		Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
#endif
#ifndef Tcl_SetListObj_TCL_DECLARED
#define Tcl_SetListObj_TCL_DECLARED
/* 62 */
EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
				Tcl_Obj *const objv[]);
/* Slot 63 is reserved */
				Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_SetLongObj_TCL_DECLARED
#define Tcl_SetLongObj_TCL_DECLARED
/* 63 */
EXTERN void		Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
#endif
#ifndef Tcl_SetObjLength_TCL_DECLARED
#define Tcl_SetObjLength_TCL_DECLARED
/* 64 */
EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, size_t length);
EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
#endif
#ifndef Tcl_SetStringObj_TCL_DECLARED
#define Tcl_SetStringObj_TCL_DECLARED
/* 65 */
EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
				size_t length);
/* Slot 66 is reserved */
/* Slot 67 is reserved */
EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, CONST char *bytes,
				int length);
#endif
#ifndef Tcl_AddErrorInfo_TCL_DECLARED
#define Tcl_AddErrorInfo_TCL_DECLARED
/* 66 */
EXTERN void		Tcl_AddErrorInfo(Tcl_Interp *interp,
				CONST char *message);
#endif
#ifndef Tcl_AddObjErrorInfo_TCL_DECLARED
#define Tcl_AddObjErrorInfo_TCL_DECLARED
/* 67 */
EXTERN void		Tcl_AddObjErrorInfo(Tcl_Interp *interp,
				CONST char *message, int length);
#endif
#ifndef Tcl_AllowExceptions_TCL_DECLARED
#define Tcl_AllowExceptions_TCL_DECLARED
/* 68 */
EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
#endif
#ifndef Tcl_AppendElement_TCL_DECLARED
#define Tcl_AppendElement_TCL_DECLARED
/* 69 */
EXTERN void		Tcl_AppendElement(Tcl_Interp *interp,
				const char *element);
				CONST char *element);
#endif
#ifndef Tcl_AppendResult_TCL_DECLARED
#define Tcl_AppendResult_TCL_DECLARED
/* 70 */
EXTERN void		Tcl_AppendResult(Tcl_Interp *interp, ...);
#endif
#ifndef Tcl_AsyncCreate_TCL_DECLARED
#define Tcl_AsyncCreate_TCL_DECLARED
/* 71 */
EXTERN Tcl_AsyncHandler	 Tcl_AsyncCreate(Tcl_AsyncProc *proc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_AsyncDelete_TCL_DECLARED
#define Tcl_AsyncDelete_TCL_DECLARED
/* 72 */
EXTERN void		Tcl_AsyncDelete(Tcl_AsyncHandler async);
#endif
#ifndef Tcl_AsyncInvoke_TCL_DECLARED
#define Tcl_AsyncInvoke_TCL_DECLARED
/* 73 */
EXTERN int		Tcl_AsyncInvoke(Tcl_Interp *interp, int code);
#endif
#ifndef Tcl_AsyncMark_TCL_DECLARED
#define Tcl_AsyncMark_TCL_DECLARED
/* 74 */
EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
#endif
#ifndef Tcl_AsyncReady_TCL_DECLARED
#define Tcl_AsyncReady_TCL_DECLARED
/* 75 */
EXTERN int		Tcl_AsyncReady(void);
#endif
#ifndef Tcl_BackgroundError_TCL_DECLARED
#define Tcl_BackgroundError_TCL_DECLARED
/* Slot 76 is reserved */
/* Slot 77 is reserved */
/* 76 */
EXTERN void		Tcl_BackgroundError(Tcl_Interp *interp);
#endif
#ifndef Tcl_Backslash_TCL_DECLARED
#define Tcl_Backslash_TCL_DECLARED
/* 77 */
EXTERN char		Tcl_Backslash(CONST char *src, int *readPtr);
#endif
#ifndef Tcl_BadChannelOption_TCL_DECLARED
#define Tcl_BadChannelOption_TCL_DECLARED
/* 78 */
EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
				CONST char *optionName,
				CONST char *optionList);
#endif
#ifndef Tcl_CallWhenDeleted_TCL_DECLARED
#define Tcl_CallWhenDeleted_TCL_DECLARED
/* 79 */
EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc, void *clientData);
				Tcl_InterpDeleteProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_CancelIdleCall_TCL_DECLARED
#define Tcl_CancelIdleCall_TCL_DECLARED
/* 80 */
EXTERN void		Tcl_CancelIdleCall(Tcl_IdleProc *idleProc,
				void *clientData);
/* Slot 81 is reserved */
				ClientData clientData);
#endif
#ifndef Tcl_Close_TCL_DECLARED
#define Tcl_Close_TCL_DECLARED
/* 81 */
EXTERN int		Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
#endif
#ifndef Tcl_CommandComplete_TCL_DECLARED
#define Tcl_CommandComplete_TCL_DECLARED
/* 82 */
EXTERN int		Tcl_CommandComplete(const char *cmd);
EXTERN int		Tcl_CommandComplete(CONST char *cmd);
#endif
#ifndef Tcl_Concat_TCL_DECLARED
#define Tcl_Concat_TCL_DECLARED
/* 83 */
EXTERN char *		Tcl_Concat(int argc, const char *const *argv);
EXTERN char *		Tcl_Concat(int argc, CONST84 char *CONST *argv);
#endif
#ifndef Tcl_ConvertElement_TCL_DECLARED
#define Tcl_ConvertElement_TCL_DECLARED
/* 84 */
EXTERN size_t		Tcl_ConvertElement(const char *src, char *dst,
EXTERN int		Tcl_ConvertElement(CONST char *src, char *dst,
				int flags);
#endif
#ifndef Tcl_ConvertCountedElement_TCL_DECLARED
#define Tcl_ConvertCountedElement_TCL_DECLARED
/* 85 */
EXTERN size_t		Tcl_ConvertCountedElement(const char *src,
				size_t length, char *dst, int flags);
EXTERN int		Tcl_ConvertCountedElement(CONST char *src,
				int length, char *dst, int flags);
#endif
#ifndef Tcl_CreateAlias_TCL_DECLARED
#define Tcl_CreateAlias_TCL_DECLARED
/* 86 */
EXTERN int		Tcl_CreateAlias(Tcl_Interp *childInterp,
				const char *childCmd, Tcl_Interp *target,
				const char *targetCmd, int argc,
				const char *const *argv);
				CONST char *childCmd, Tcl_Interp *target,
				CONST char *targetCmd, int argc,
				CONST84 char *CONST *argv);
#endif
#ifndef Tcl_CreateAliasObj_TCL_DECLARED
#define Tcl_CreateAliasObj_TCL_DECLARED
/* 87 */
EXTERN int		Tcl_CreateAliasObj(Tcl_Interp *childInterp,
				const char *childCmd, Tcl_Interp *target,
				const char *targetCmd, int objc,
				Tcl_Obj *const objv[]);
				CONST char *childCmd, Tcl_Interp *target,
				CONST char *targetCmd, int objc,
				Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_CreateChannel_TCL_DECLARED
#define Tcl_CreateChannel_TCL_DECLARED
/* 88 */
EXTERN Tcl_Channel	Tcl_CreateChannel(const Tcl_ChannelType *typePtr,
				const char *chanName, void *instanceData,
				int mask);
EXTERN Tcl_Channel	Tcl_CreateChannel(Tcl_ChannelType *typePtr,
				CONST char *chanName,
				ClientData instanceData, int mask);
#endif
#ifndef Tcl_CreateChannelHandler_TCL_DECLARED
#define Tcl_CreateChannelHandler_TCL_DECLARED
/* 89 */
EXTERN void		Tcl_CreateChannelHandler(Tcl_Channel chan, int mask,
				Tcl_ChannelProc *proc, void *clientData);
				Tcl_ChannelProc *proc, ClientData clientData);
#endif
#ifndef Tcl_CreateCloseHandler_TCL_DECLARED
#define Tcl_CreateCloseHandler_TCL_DECLARED
/* 90 */
EXTERN void		Tcl_CreateCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, void *clientData);
				Tcl_CloseProc *proc, ClientData clientData);
#endif
#ifndef Tcl_CreateCommand_TCL_DECLARED
#define Tcl_CreateCommand_TCL_DECLARED
/* 91 */
EXTERN Tcl_Command	Tcl_CreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdProc *proc,
				void *clientData,
				CONST char *cmdName, Tcl_CmdProc *proc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
#endif
#ifndef Tcl_CreateEventSource_TCL_DECLARED
#define Tcl_CreateEventSource_TCL_DECLARED
/* 92 */
EXTERN void		Tcl_CreateEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_CreateExitHandler_TCL_DECLARED
#define Tcl_CreateExitHandler_TCL_DECLARED
/* 93 */
EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_CreateInterp_TCL_DECLARED
#define Tcl_CreateInterp_TCL_DECLARED
/* 94 */
EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
#endif
#ifndef Tcl_CreateMathFunc_TCL_DECLARED
#define Tcl_CreateMathFunc_TCL_DECLARED
/* Slot 95 is reserved */
/* 95 */
EXTERN void		Tcl_CreateMathFunc(Tcl_Interp *interp,
				CONST char *name, int numArgs,
				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_CreateObjCommand_TCL_DECLARED
#define Tcl_CreateObjCommand_TCL_DECLARED
/* 96 */
EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				void *clientData,
				CONST char *cmdName, Tcl_ObjCmdProc *proc,
				ClientData clientData,
				Tcl_CmdDeleteProc *deleteProc);
#endif
#ifndef Tcl_CreateSlave_TCL_DECLARED
#define Tcl_CreateSlave_TCL_DECLARED
/* 97 */
EXTERN Tcl_Interp *	Tcl_CreateChild(Tcl_Interp *interp, const char *name,
EXTERN Tcl_Interp *	Tcl_CreateSlave(Tcl_Interp *interp, CONST char *name,
				int isSafe);
#endif
#ifndef Tcl_CreateTimerHandler_TCL_DECLARED
#define Tcl_CreateTimerHandler_TCL_DECLARED
/* 98 */
EXTERN Tcl_TimerToken	Tcl_CreateTimerHandler(int milliseconds,
				Tcl_TimerProc *proc, void *clientData);
				Tcl_TimerProc *proc, ClientData clientData);
#endif
#ifndef Tcl_CreateTrace_TCL_DECLARED
#define Tcl_CreateTrace_TCL_DECLARED
/* 99 */
EXTERN Tcl_Trace	Tcl_CreateTrace(Tcl_Interp *interp, int level,
				Tcl_CmdTraceProc *proc, void *clientData);
				Tcl_CmdTraceProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_DeleteAssocData_TCL_DECLARED
#define Tcl_DeleteAssocData_TCL_DECLARED
/* 100 */
EXTERN void		Tcl_DeleteAssocData(Tcl_Interp *interp,
				const char *name);
				CONST char *name);
#endif
#ifndef Tcl_DeleteChannelHandler_TCL_DECLARED
#define Tcl_DeleteChannelHandler_TCL_DECLARED
/* 101 */
EXTERN void		Tcl_DeleteChannelHandler(Tcl_Channel chan,
				Tcl_ChannelProc *proc, void *clientData);
				Tcl_ChannelProc *proc, ClientData clientData);
#endif
#ifndef Tcl_DeleteCloseHandler_TCL_DECLARED
#define Tcl_DeleteCloseHandler_TCL_DECLARED
/* 102 */
EXTERN void		Tcl_DeleteCloseHandler(Tcl_Channel chan,
				Tcl_CloseProc *proc, void *clientData);
				Tcl_CloseProc *proc, ClientData clientData);
#endif
#ifndef Tcl_DeleteCommand_TCL_DECLARED
#define Tcl_DeleteCommand_TCL_DECLARED
/* 103 */
EXTERN int		Tcl_DeleteCommand(Tcl_Interp *interp,
				const char *cmdName);
				CONST char *cmdName);
#endif
#ifndef Tcl_DeleteCommandFromToken_TCL_DECLARED
#define Tcl_DeleteCommandFromToken_TCL_DECLARED
/* 104 */
EXTERN int		Tcl_DeleteCommandFromToken(Tcl_Interp *interp,
				Tcl_Command command);
#endif
#ifndef Tcl_DeleteEvents_TCL_DECLARED
#define Tcl_DeleteEvents_TCL_DECLARED
/* 105 */
EXTERN void		Tcl_DeleteEvents(Tcl_EventDeleteProc *proc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_DeleteEventSource_TCL_DECLARED
#define Tcl_DeleteEventSource_TCL_DECLARED
/* 106 */
EXTERN void		Tcl_DeleteEventSource(Tcl_EventSetupProc *setupProc,
				Tcl_EventCheckProc *checkProc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_DeleteExitHandler_TCL_DECLARED
#define Tcl_DeleteExitHandler_TCL_DECLARED
/* 107 */
EXTERN void		Tcl_DeleteExitHandler(Tcl_ExitProc *proc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_DeleteHashEntry_TCL_DECLARED
#define Tcl_DeleteHashEntry_TCL_DECLARED
/* 108 */
EXTERN void		Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr);
#endif
#ifndef Tcl_DeleteHashTable_TCL_DECLARED
#define Tcl_DeleteHashTable_TCL_DECLARED
/* 109 */
EXTERN void		Tcl_DeleteHashTable(Tcl_HashTable *tablePtr);
#endif
#ifndef Tcl_DeleteInterp_TCL_DECLARED
#define Tcl_DeleteInterp_TCL_DECLARED
/* 110 */
EXTERN void		Tcl_DeleteInterp(Tcl_Interp *interp);
#endif
#ifndef Tcl_DetachPids_TCL_DECLARED
#define Tcl_DetachPids_TCL_DECLARED
/* 111 */
EXTERN void		Tcl_DetachPids(int numPids, Tcl_Pid *pidPtr);
#endif
#ifndef Tcl_DeleteTimerHandler_TCL_DECLARED
#define Tcl_DeleteTimerHandler_TCL_DECLARED
/* 112 */
EXTERN void		Tcl_DeleteTimerHandler(Tcl_TimerToken token);
#endif
#ifndef Tcl_DeleteTrace_TCL_DECLARED
#define Tcl_DeleteTrace_TCL_DECLARED
/* 113 */
EXTERN void		Tcl_DeleteTrace(Tcl_Interp *interp, Tcl_Trace trace);
#endif
#ifndef Tcl_DontCallWhenDeleted_TCL_DECLARED
#define Tcl_DontCallWhenDeleted_TCL_DECLARED
/* 114 */
EXTERN void		Tcl_DontCallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc, void *clientData);
				Tcl_InterpDeleteProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_DoOneEvent_TCL_DECLARED
#define Tcl_DoOneEvent_TCL_DECLARED
/* 115 */
EXTERN int		Tcl_DoOneEvent(int flags);
#endif
#ifndef Tcl_DoWhenIdle_TCL_DECLARED
#define Tcl_DoWhenIdle_TCL_DECLARED
/* 116 */
EXTERN void		Tcl_DoWhenIdle(Tcl_IdleProc *proc, void *clientData);
EXTERN void		Tcl_DoWhenIdle(Tcl_IdleProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_DStringAppend_TCL_DECLARED
#define Tcl_DStringAppend_TCL_DECLARED
/* 117 */
EXTERN char *		Tcl_DStringAppend(Tcl_DString *dsPtr,
				const char *bytes, size_t length);
				CONST char *bytes, int length);
#endif
#ifndef Tcl_DStringAppendElement_TCL_DECLARED
#define Tcl_DStringAppendElement_TCL_DECLARED
/* 118 */
EXTERN char *		Tcl_DStringAppendElement(Tcl_DString *dsPtr,
				const char *element);
				CONST char *element);
#endif
#ifndef Tcl_DStringEndSublist_TCL_DECLARED
#define Tcl_DStringEndSublist_TCL_DECLARED
/* 119 */
EXTERN void		Tcl_DStringEndSublist(Tcl_DString *dsPtr);
#endif
#ifndef Tcl_DStringFree_TCL_DECLARED
#define Tcl_DStringFree_TCL_DECLARED
/* 120 */
EXTERN void		Tcl_DStringFree(Tcl_DString *dsPtr);
#endif
#ifndef Tcl_DStringGetResult_TCL_DECLARED
#define Tcl_DStringGetResult_TCL_DECLARED
/* 121 */
EXTERN void		Tcl_DStringGetResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
#endif
#ifndef Tcl_DStringInit_TCL_DECLARED
#define Tcl_DStringInit_TCL_DECLARED
/* 122 */
EXTERN void		Tcl_DStringInit(Tcl_DString *dsPtr);
#endif
#ifndef Tcl_DStringResult_TCL_DECLARED
#define Tcl_DStringResult_TCL_DECLARED
/* 123 */
EXTERN void		Tcl_DStringResult(Tcl_Interp *interp,
				Tcl_DString *dsPtr);
#endif
#ifndef Tcl_DStringSetLength_TCL_DECLARED
#define Tcl_DStringSetLength_TCL_DECLARED
/* 124 */
EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr,
				size_t length);
EXTERN void		Tcl_DStringSetLength(Tcl_DString *dsPtr, int length);
#endif
#ifndef Tcl_DStringStartSublist_TCL_DECLARED
#define Tcl_DStringStartSublist_TCL_DECLARED
/* 125 */
EXTERN void		Tcl_DStringStartSublist(Tcl_DString *dsPtr);
#endif
#ifndef Tcl_Eof_TCL_DECLARED
#define Tcl_Eof_TCL_DECLARED
/* 126 */
EXTERN int		Tcl_Eof(Tcl_Channel chan);
#endif
#ifndef Tcl_ErrnoId_TCL_DECLARED
#define Tcl_ErrnoId_TCL_DECLARED
/* 127 */
EXTERN const char *	Tcl_ErrnoId(void);
EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
#endif
#ifndef Tcl_ErrnoMsg_TCL_DECLARED
#define Tcl_ErrnoMsg_TCL_DECLARED
/* 128 */
EXTERN const char *	Tcl_ErrnoMsg(int err);
/* Slot 129 is reserved */
EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
#endif
#ifndef Tcl_Eval_TCL_DECLARED
#define Tcl_Eval_TCL_DECLARED
/* 129 */
EXTERN int		Tcl_Eval(Tcl_Interp *interp, CONST char *script);
#endif
#ifndef Tcl_EvalFile_TCL_DECLARED
#define Tcl_EvalFile_TCL_DECLARED
/* 130 */
EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* Slot 131 is reserved */
				CONST char *fileName);
#endif
#ifndef Tcl_EvalObj_TCL_DECLARED
#define Tcl_EvalObj_TCL_DECLARED
/* 131 */
EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_EventuallyFree_TCL_DECLARED
#define Tcl_EventuallyFree_TCL_DECLARED
/* 132 */
EXTERN void		Tcl_EventuallyFree(void *clientData,
EXTERN void		Tcl_EventuallyFree(ClientData clientData,
				Tcl_FreeProc *freeProc);
#endif
#ifndef Tcl_Exit_TCL_DECLARED
#define Tcl_Exit_TCL_DECLARED
/* 133 */
EXTERN TCL_NORETURN void Tcl_Exit(int status);
EXTERN void		Tcl_Exit(int status);
#endif
#ifndef Tcl_ExposeCommand_TCL_DECLARED
#define Tcl_ExposeCommand_TCL_DECLARED
/* 134 */
EXTERN int		Tcl_ExposeCommand(Tcl_Interp *interp,
				const char *hiddenCmdToken,
				const char *cmdName);
				CONST char *hiddenCmdToken,
				CONST char *cmdName);
#endif
#ifndef Tcl_ExprBoolean_TCL_DECLARED
#define Tcl_ExprBoolean_TCL_DECLARED
/* 135 */
EXTERN int		Tcl_ExprBoolean(Tcl_Interp *interp, const char *expr,
EXTERN int		Tcl_ExprBoolean(Tcl_Interp *interp, CONST char *expr,
				int *ptr);
#endif
#ifndef Tcl_ExprBooleanObj_TCL_DECLARED
#define Tcl_ExprBooleanObj_TCL_DECLARED
/* 136 */
EXTERN int		Tcl_ExprBooleanObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int *ptr);
#endif
#ifndef Tcl_ExprDouble_TCL_DECLARED
#define Tcl_ExprDouble_TCL_DECLARED
/* 137 */
EXTERN int		Tcl_ExprDouble(Tcl_Interp *interp, const char *expr,
EXTERN int		Tcl_ExprDouble(Tcl_Interp *interp, CONST char *expr,
				double *ptr);
#endif
#ifndef Tcl_ExprDoubleObj_TCL_DECLARED
#define Tcl_ExprDoubleObj_TCL_DECLARED
/* 138 */
EXTERN int		Tcl_ExprDoubleObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, double *ptr);
#endif
#ifndef Tcl_ExprLong_TCL_DECLARED
#define Tcl_ExprLong_TCL_DECLARED
/* 139 */
EXTERN int		Tcl_ExprLong(Tcl_Interp *interp, const char *expr,
EXTERN int		Tcl_ExprLong(Tcl_Interp *interp, CONST char *expr,
				long *ptr);
#endif
#ifndef Tcl_ExprLongObj_TCL_DECLARED
#define Tcl_ExprLongObj_TCL_DECLARED
/* 140 */
EXTERN int		Tcl_ExprLongObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				long *ptr);
#endif
#ifndef Tcl_ExprObj_TCL_DECLARED
#define Tcl_ExprObj_TCL_DECLARED
/* 141 */
EXTERN int		Tcl_ExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				Tcl_Obj **resultPtrPtr);
#endif
#ifndef Tcl_ExprString_TCL_DECLARED
#define Tcl_ExprString_TCL_DECLARED
/* 142 */
EXTERN int		Tcl_ExprString(Tcl_Interp *interp, const char *expr);
EXTERN int		Tcl_ExprString(Tcl_Interp *interp, CONST char *expr);
#endif
#ifndef Tcl_Finalize_TCL_DECLARED
#define Tcl_Finalize_TCL_DECLARED
/* 143 */
EXTERN void		Tcl_Finalize(void);
#endif
#ifndef Tcl_FindExecutable_TCL_DECLARED
#define Tcl_FindExecutable_TCL_DECLARED
/* Slot 144 is reserved */
/* 144 */
EXTERN void		Tcl_FindExecutable(CONST char *argv0);
#endif
#ifndef Tcl_FirstHashEntry_TCL_DECLARED
#define Tcl_FirstHashEntry_TCL_DECLARED
/* 145 */
EXTERN Tcl_HashEntry *	Tcl_FirstHashEntry(Tcl_HashTable *tablePtr,
				Tcl_HashSearch *searchPtr);
#endif
#ifndef Tcl_Flush_TCL_DECLARED
#define Tcl_Flush_TCL_DECLARED
/* 146 */
EXTERN int		Tcl_Flush(Tcl_Channel chan);
#endif
#ifndef Tcl_FreeResult_TCL_DECLARED
#define Tcl_FreeResult_TCL_DECLARED
/* Slot 147 is reserved */
/* 147 */
EXTERN void		Tcl_FreeResult(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetAlias_TCL_DECLARED
#define Tcl_GetAlias_TCL_DECLARED
/* 148 */
EXTERN int		Tcl_GetAlias(Tcl_Interp *interp,
				const char *childCmd,
				CONST char *slaveCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *argcPtr,
				const char ***argvPtr);
				CONST84 char **targetCmdPtr, int *argcPtr,
				CONST84 char ***argvPtr);
#endif
#ifndef Tcl_GetAliasObj_TCL_DECLARED
#define Tcl_GetAliasObj_TCL_DECLARED
/* 149 */
EXTERN int		Tcl_GetAliasObj(Tcl_Interp *interp,
				const char *childCmd,
				CONST char *slaveCmd,
				Tcl_Interp **targetInterpPtr,
				const char **targetCmdPtr, int *objcPtr,
				CONST84 char **targetCmdPtr, int *objcPtr,
				Tcl_Obj ***objv);
#endif
#ifndef Tcl_GetAssocData_TCL_DECLARED
#define Tcl_GetAssocData_TCL_DECLARED
/* 150 */
EXTERN void *		Tcl_GetAssocData(Tcl_Interp *interp,
				const char *name,
EXTERN ClientData	Tcl_GetAssocData(Tcl_Interp *interp,
				CONST char *name,
				Tcl_InterpDeleteProc **procPtr);
#endif
#ifndef Tcl_GetChannel_TCL_DECLARED
#define Tcl_GetChannel_TCL_DECLARED
/* 151 */
EXTERN Tcl_Channel	Tcl_GetChannel(Tcl_Interp *interp,
				const char *chanName, int *modePtr);
				CONST char *chanName, int *modePtr);
#endif
#ifndef Tcl_GetChannelBufferSize_TCL_DECLARED
#define Tcl_GetChannelBufferSize_TCL_DECLARED
/* 152 */
EXTERN int		Tcl_GetChannelBufferSize(Tcl_Channel chan);
#endif
#ifndef Tcl_GetChannelHandle_TCL_DECLARED
#define Tcl_GetChannelHandle_TCL_DECLARED
/* 153 */
EXTERN int		Tcl_GetChannelHandle(Tcl_Channel chan, int direction,
				void **handlePtr);
				ClientData *handlePtr);
#endif
#ifndef Tcl_GetChannelInstanceData_TCL_DECLARED
#define Tcl_GetChannelInstanceData_TCL_DECLARED
/* 154 */
EXTERN void *		Tcl_GetChannelInstanceData(Tcl_Channel chan);
EXTERN ClientData	Tcl_GetChannelInstanceData(Tcl_Channel chan);
#endif
#ifndef Tcl_GetChannelMode_TCL_DECLARED
#define Tcl_GetChannelMode_TCL_DECLARED
/* 155 */
EXTERN int		Tcl_GetChannelMode(Tcl_Channel chan);
#endif
#ifndef Tcl_GetChannelName_TCL_DECLARED
#define Tcl_GetChannelName_TCL_DECLARED
/* 156 */
EXTERN const char *	Tcl_GetChannelName(Tcl_Channel chan);
EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
#endif
#ifndef Tcl_GetChannelOption_TCL_DECLARED
#define Tcl_GetChannelOption_TCL_DECLARED
/* 157 */
EXTERN int		Tcl_GetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				Tcl_Channel chan, CONST char *optionName,
				Tcl_DString *dsPtr);
#endif
#ifndef Tcl_GetChannelType_TCL_DECLARED
#define Tcl_GetChannelType_TCL_DECLARED
/* 158 */
EXTERN const Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
EXTERN Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
#endif
#ifndef Tcl_GetCommandInfo_TCL_DECLARED
#define Tcl_GetCommandInfo_TCL_DECLARED
/* 159 */
EXTERN int		Tcl_GetCommandInfo(Tcl_Interp *interp,
				const char *cmdName, Tcl_CmdInfo *infoPtr);
				CONST char *cmdName, Tcl_CmdInfo *infoPtr);
#endif
#ifndef Tcl_GetCommandName_TCL_DECLARED
#define Tcl_GetCommandName_TCL_DECLARED
/* 160 */
EXTERN const char *	Tcl_GetCommandName(Tcl_Interp *interp,
EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
				Tcl_Command command);
#endif
#ifndef Tcl_GetErrno_TCL_DECLARED
#define Tcl_GetErrno_TCL_DECLARED
/* 161 */
EXTERN int		Tcl_GetErrno(void);
#endif
#ifndef Tcl_GetHostName_TCL_DECLARED
#define Tcl_GetHostName_TCL_DECLARED
/* 162 */
EXTERN const char *	Tcl_GetHostName(void);
EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
#endif
#ifndef Tcl_GetInterpPath_TCL_DECLARED
#define Tcl_GetInterpPath_TCL_DECLARED
/* 163 */
EXTERN int		Tcl_GetInterpPath(Tcl_Interp *interp,
				Tcl_Interp *childInterp);
#endif
#ifndef Tcl_GetMaster_TCL_DECLARED
#define Tcl_GetMaster_TCL_DECLARED
/* 164 */
EXTERN Tcl_Interp *	Tcl_GetParent(Tcl_Interp *interp);
EXTERN Tcl_Interp *	Tcl_GetMaster(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetNameOfExecutable_TCL_DECLARED
#define Tcl_GetNameOfExecutable_TCL_DECLARED
/* 165 */
EXTERN const char *	Tcl_GetNameOfExecutable(void);
EXTERN CONST char *	Tcl_GetNameOfExecutable(void);
#endif
#ifndef Tcl_GetObjResult_TCL_DECLARED
#define Tcl_GetObjResult_TCL_DECLARED
/* 166 */
EXTERN Tcl_Obj *	Tcl_GetObjResult(Tcl_Interp *interp);
#endif
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_GetOpenFile_TCL_DECLARED
#define Tcl_GetOpenFile_TCL_DECLARED
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
				CONST char *chanID, int forWriting,
				int checkUsage, ClientData *filePtr);
#endif
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef Tcl_GetOpenFile_TCL_DECLARED
#define Tcl_GetOpenFile_TCL_DECLARED
/* 167 */
EXTERN int		Tcl_GetOpenFile(Tcl_Interp *interp,
				const char *chanID, int forWriting,
				int checkUsage, void **filePtr);
				CONST char *chanID, int forWriting,
				int checkUsage, ClientData *filePtr);
#endif
#endif /* MACOSX */
#ifndef Tcl_GetPathType_TCL_DECLARED
#define Tcl_GetPathType_TCL_DECLARED
/* 168 */
EXTERN Tcl_PathType	Tcl_GetPathType(const char *path);
EXTERN Tcl_PathType	Tcl_GetPathType(CONST char *path);
#endif
#ifndef Tcl_Gets_TCL_DECLARED
#define Tcl_Gets_TCL_DECLARED
/* 169 */
EXTERN int		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
#endif
#ifndef Tcl_GetsObj_TCL_DECLARED
#define Tcl_GetsObj_TCL_DECLARED
/* 170 */
EXTERN int		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetServiceMode_TCL_DECLARED
#define Tcl_GetServiceMode_TCL_DECLARED
/* 171 */
EXTERN int		Tcl_GetServiceMode(void);
#endif
EXTERN size_t		Tcl_Gets(Tcl_Channel chan, Tcl_DString *dsPtr);
#ifndef Tcl_GetSlave_TCL_DECLARED
/* 170 */
EXTERN size_t		Tcl_GetsObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 171 */
EXTERN int		Tcl_GetServiceMode(void);
#define Tcl_GetSlave_TCL_DECLARED
/* 172 */
EXTERN Tcl_Interp *	Tcl_GetChild(Tcl_Interp *interp, const char *name);
EXTERN Tcl_Interp *	Tcl_GetSlave(Tcl_Interp *interp,
				CONST char *slaveName);
#endif
#ifndef Tcl_GetStdChannel_TCL_DECLARED
#define Tcl_GetStdChannel_TCL_DECLARED
/* 173 */
EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
#endif
#ifndef Tcl_GetStringResult_TCL_DECLARED
#define Tcl_GetStringResult_TCL_DECLARED
/* Slot 174 is reserved */
/* Slot 175 is reserved */
/* 174 */
EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetVar_TCL_DECLARED
#define Tcl_GetVar_TCL_DECLARED
/* 175 */
EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
				CONST char *varName, int flags);
#endif
#ifndef Tcl_GetVar2_TCL_DECLARED
#define Tcl_GetVar2_TCL_DECLARED
/* 176 */
EXTERN const char *	Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* Slot 177 is reserved */
/* Slot 178 is reserved */
EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
				CONST char *part1, CONST char *part2,
				int flags);
#endif
#ifndef Tcl_GlobalEval_TCL_DECLARED
#define Tcl_GlobalEval_TCL_DECLARED
/* 177 */
EXTERN int		Tcl_GlobalEval(Tcl_Interp *interp,
				CONST char *command);
#endif
#ifndef Tcl_GlobalEvalObj_TCL_DECLARED
#define Tcl_GlobalEvalObj_TCL_DECLARED
/* 178 */
EXTERN int		Tcl_GlobalEvalObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
#endif
#ifndef Tcl_HideCommand_TCL_DECLARED
#define Tcl_HideCommand_TCL_DECLARED
/* 179 */
EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
				const char *cmdName,
				const char *hiddenCmdToken);
				CONST char *cmdName,
				CONST char *hiddenCmdToken);
#endif
#ifndef Tcl_Init_TCL_DECLARED
#define Tcl_Init_TCL_DECLARED
/* 180 */
EXTERN int		Tcl_Init(Tcl_Interp *interp);
#endif
#ifndef Tcl_InitHashTable_TCL_DECLARED
#define Tcl_InitHashTable_TCL_DECLARED
/* 181 */
EXTERN void		Tcl_InitHashTable(Tcl_HashTable *tablePtr,
				int keyType);
#endif
#ifndef Tcl_InputBlocked_TCL_DECLARED
#define Tcl_InputBlocked_TCL_DECLARED
/* 182 */
EXTERN int		Tcl_InputBlocked(Tcl_Channel chan);
#endif
#ifndef Tcl_InputBuffered_TCL_DECLARED
#define Tcl_InputBuffered_TCL_DECLARED
/* 183 */
EXTERN int		Tcl_InputBuffered(Tcl_Channel chan);
#endif
#ifndef Tcl_InterpDeleted_TCL_DECLARED
#define Tcl_InterpDeleted_TCL_DECLARED
/* 184 */
EXTERN int		Tcl_InterpDeleted(Tcl_Interp *interp);
#endif
#ifndef Tcl_IsSafe_TCL_DECLARED
#define Tcl_IsSafe_TCL_DECLARED
/* 185 */
EXTERN int		Tcl_IsSafe(Tcl_Interp *interp);
#endif
#ifndef Tcl_JoinPath_TCL_DECLARED
#define Tcl_JoinPath_TCL_DECLARED
/* 186 */
EXTERN char *		Tcl_JoinPath(int argc, const char *const *argv,
EXTERN char *		Tcl_JoinPath(int argc, CONST84 char *CONST *argv,
				Tcl_DString *resultPtr);
#endif
#ifndef Tcl_LinkVar_TCL_DECLARED
#define Tcl_LinkVar_TCL_DECLARED
/* 187 */
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
				void *addr, int type);
EXTERN int		Tcl_LinkVar(Tcl_Interp *interp, CONST char *varName,
				char *addr, int type);
#endif
/* Slot 188 is reserved */
#ifndef Tcl_MakeFileChannel_TCL_DECLARED
#define Tcl_MakeFileChannel_TCL_DECLARED
/* 189 */
EXTERN Tcl_Channel	Tcl_MakeFileChannel(void *handle, int mode);
EXTERN Tcl_Channel	Tcl_MakeFileChannel(ClientData handle, int mode);
#endif
#ifndef Tcl_MakeSafe_TCL_DECLARED
#define Tcl_MakeSafe_TCL_DECLARED
/* 190 */
EXTERN int		Tcl_MakeSafe(Tcl_Interp *interp);
#endif
#ifndef Tcl_MakeTcpClientChannel_TCL_DECLARED
#define Tcl_MakeTcpClientChannel_TCL_DECLARED
/* 191 */
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(void *tcpSocket);
EXTERN Tcl_Channel	Tcl_MakeTcpClientChannel(ClientData tcpSocket);
#endif
#ifndef Tcl_Merge_TCL_DECLARED
#define Tcl_Merge_TCL_DECLARED
/* 192 */
EXTERN char *		Tcl_Merge(int argc, const char *const *argv);
EXTERN char *		Tcl_Merge(int argc, CONST84 char *CONST *argv);
#endif
#ifndef Tcl_NextHashEntry_TCL_DECLARED
#define Tcl_NextHashEntry_TCL_DECLARED
/* 193 */
EXTERN Tcl_HashEntry *	Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
#endif
#ifndef Tcl_NotifyChannel_TCL_DECLARED
#define Tcl_NotifyChannel_TCL_DECLARED
/* 194 */
EXTERN void		Tcl_NotifyChannel(Tcl_Channel channel, int mask);
#endif
#ifndef Tcl_ObjGetVar2_TCL_DECLARED
#define Tcl_ObjGetVar2_TCL_DECLARED
/* 195 */
EXTERN Tcl_Obj *	Tcl_ObjGetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, int flags);
#endif
#ifndef Tcl_ObjSetVar2_TCL_DECLARED
#define Tcl_ObjSetVar2_TCL_DECLARED
/* 196 */
EXTERN Tcl_Obj *	Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
				int flags);
#endif
#ifndef Tcl_OpenCommandChannel_TCL_DECLARED
#define Tcl_OpenCommandChannel_TCL_DECLARED
/* 197 */
EXTERN Tcl_Channel	Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
				const char **argv, int flags);
				CONST84 char **argv, int flags);
#endif
#ifndef Tcl_OpenFileChannel_TCL_DECLARED
#define Tcl_OpenFileChannel_TCL_DECLARED
/* 198 */
EXTERN Tcl_Channel	Tcl_OpenFileChannel(Tcl_Interp *interp,
				const char *fileName, const char *modeString,
				CONST char *fileName, CONST char *modeString,
				int permissions);
#endif
#ifndef Tcl_OpenTcpClient_TCL_DECLARED
#define Tcl_OpenTcpClient_TCL_DECLARED
/* 199 */
EXTERN Tcl_Channel	Tcl_OpenTcpClient(Tcl_Interp *interp, int port,
				const char *address, const char *myaddr,
				int myport, int async);
				CONST char *address, CONST char *myaddr,
				int myport, int flags);
#endif
#ifndef Tcl_OpenTcpServer_TCL_DECLARED
#define Tcl_OpenTcpServer_TCL_DECLARED
/* 200 */
EXTERN Tcl_Channel	Tcl_OpenTcpServer(Tcl_Interp *interp, int port,
				const char *host,
				CONST char *host,
				Tcl_TcpAcceptProc *acceptProc,
				void *callbackData);
				ClientData callbackData);
#endif
#ifndef Tcl_Preserve_TCL_DECLARED
#define Tcl_Preserve_TCL_DECLARED
/* 201 */
EXTERN void		Tcl_Preserve(void *data);
EXTERN void		Tcl_Preserve(ClientData data);
#endif
#ifndef Tcl_PrintDouble_TCL_DECLARED
#define Tcl_PrintDouble_TCL_DECLARED
/* 202 */
EXTERN void		Tcl_PrintDouble(Tcl_Interp *interp, double value,
				char *dst);
#endif
#ifndef Tcl_PutEnv_TCL_DECLARED
#define Tcl_PutEnv_TCL_DECLARED
/* 203 */
EXTERN int		Tcl_PutEnv(const char *assignment);
EXTERN int		Tcl_PutEnv(CONST char *assignment);
#endif
#ifndef Tcl_PosixError_TCL_DECLARED
#define Tcl_PosixError_TCL_DECLARED
/* 204 */
EXTERN const char *	Tcl_PosixError(Tcl_Interp *interp);
EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
#endif
#ifndef Tcl_QueueEvent_TCL_DECLARED
#define Tcl_QueueEvent_TCL_DECLARED
/* 205 */
EXTERN void		Tcl_QueueEvent(Tcl_Event *evPtr,
				Tcl_QueuePosition position);
#endif
#ifndef Tcl_Read_TCL_DECLARED
#define Tcl_Read_TCL_DECLARED
/* 206 */
EXTERN size_t		Tcl_Read(Tcl_Channel chan, char *bufPtr,
				size_t toRead);
EXTERN int		Tcl_Read(Tcl_Channel chan, char *bufPtr, int toRead);
#endif
#ifndef Tcl_ReapDetachedProcs_TCL_DECLARED
#define Tcl_ReapDetachedProcs_TCL_DECLARED
/* 207 */
EXTERN void		Tcl_ReapDetachedProcs(void);
#endif
#ifndef Tcl_RecordAndEval_TCL_DECLARED
#define Tcl_RecordAndEval_TCL_DECLARED
/* 208 */
EXTERN int		Tcl_RecordAndEval(Tcl_Interp *interp,
				const char *cmd, int flags);
				CONST char *cmd, int flags);
#endif
#ifndef Tcl_RecordAndEvalObj_TCL_DECLARED
#define Tcl_RecordAndEvalObj_TCL_DECLARED
/* 209 */
EXTERN int		Tcl_RecordAndEvalObj(Tcl_Interp *interp,
				Tcl_Obj *cmdPtr, int flags);
#endif
#ifndef Tcl_RegisterChannel_TCL_DECLARED
#define Tcl_RegisterChannel_TCL_DECLARED
/* 210 */
EXTERN void		Tcl_RegisterChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
#endif
#ifndef Tcl_RegisterObjType_TCL_DECLARED
#define Tcl_RegisterObjType_TCL_DECLARED
/* 211 */
EXTERN void		Tcl_RegisterObjType(const Tcl_ObjType *typePtr);
EXTERN void		Tcl_RegisterObjType(Tcl_ObjType *typePtr);
#endif
#ifndef Tcl_RegExpCompile_TCL_DECLARED
#define Tcl_RegExpCompile_TCL_DECLARED
/* 212 */
EXTERN Tcl_RegExp	Tcl_RegExpCompile(Tcl_Interp *interp,
				const char *pattern);
				CONST char *pattern);
#endif
#ifndef Tcl_RegExpExec_TCL_DECLARED
#define Tcl_RegExpExec_TCL_DECLARED
/* 213 */
EXTERN int		Tcl_RegExpExec(Tcl_Interp *interp, Tcl_RegExp regexp,
				const char *text, const char *start);
				CONST char *text, CONST char *start);
#endif
#ifndef Tcl_RegExpMatch_TCL_DECLARED
#define Tcl_RegExpMatch_TCL_DECLARED
/* 214 */
EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
				const char *pattern);
EXTERN int		Tcl_RegExpMatch(Tcl_Interp *interp, CONST char *text,
				CONST char *pattern);
#endif
#ifndef Tcl_RegExpRange_TCL_DECLARED
#define Tcl_RegExpRange_TCL_DECLARED
/* 215 */
EXTERN void		Tcl_RegExpRange(Tcl_RegExp regexp, size_t index,
				const char **startPtr, const char **endPtr);
EXTERN void		Tcl_RegExpRange(Tcl_RegExp regexp, int index,
				CONST84 char **startPtr,
				CONST84 char **endPtr);
#endif
#ifndef Tcl_Release_TCL_DECLARED
#define Tcl_Release_TCL_DECLARED
/* 216 */
EXTERN void		Tcl_Release(void *clientData);
EXTERN void		Tcl_Release(ClientData clientData);
#endif
#ifndef Tcl_ResetResult_TCL_DECLARED
#define Tcl_ResetResult_TCL_DECLARED
/* 217 */
EXTERN void		Tcl_ResetResult(Tcl_Interp *interp);
#endif
#ifndef Tcl_ScanElement_TCL_DECLARED
#define Tcl_ScanElement_TCL_DECLARED
/* 218 */
EXTERN size_t		Tcl_ScanElement(const char *src, int *flagPtr);
EXTERN int		Tcl_ScanElement(CONST char *src, int *flagPtr);
#endif
#ifndef Tcl_ScanCountedElement_TCL_DECLARED
#define Tcl_ScanCountedElement_TCL_DECLARED
/* 219 */
EXTERN size_t		Tcl_ScanCountedElement(const char *src,
				size_t length, int *flagPtr);
/* Slot 220 is reserved */
EXTERN int		Tcl_ScanCountedElement(CONST char *src, int length,
				int *flagPtr);
#endif
#ifndef Tcl_SeekOld_TCL_DECLARED
#define Tcl_SeekOld_TCL_DECLARED
/* 220 */
EXTERN int		Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
#endif
#ifndef Tcl_ServiceAll_TCL_DECLARED
#define Tcl_ServiceAll_TCL_DECLARED
/* 221 */
EXTERN int		Tcl_ServiceAll(void);
#endif
#ifndef Tcl_ServiceEvent_TCL_DECLARED
#define Tcl_ServiceEvent_TCL_DECLARED
/* 222 */
EXTERN int		Tcl_ServiceEvent(int flags);
#endif
#ifndef Tcl_SetAssocData_TCL_DECLARED
#define Tcl_SetAssocData_TCL_DECLARED
/* 223 */
EXTERN void		Tcl_SetAssocData(Tcl_Interp *interp,
				const char *name, Tcl_InterpDeleteProc *proc,
				void *clientData);
				CONST char *name, Tcl_InterpDeleteProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_SetChannelBufferSize_TCL_DECLARED
#define Tcl_SetChannelBufferSize_TCL_DECLARED
/* 224 */
EXTERN void		Tcl_SetChannelBufferSize(Tcl_Channel chan, int sz);
#endif
#ifndef Tcl_SetChannelOption_TCL_DECLARED
#define Tcl_SetChannelOption_TCL_DECLARED
/* 225 */
EXTERN int		Tcl_SetChannelOption(Tcl_Interp *interp,
				Tcl_Channel chan, const char *optionName,
				const char *newValue);
				Tcl_Channel chan, CONST char *optionName,
				CONST char *newValue);
#endif
#ifndef Tcl_SetCommandInfo_TCL_DECLARED
#define Tcl_SetCommandInfo_TCL_DECLARED
/* 226 */
EXTERN int		Tcl_SetCommandInfo(Tcl_Interp *interp,
				const char *cmdName,
				const Tcl_CmdInfo *infoPtr);
				CONST char *cmdName,
				CONST Tcl_CmdInfo *infoPtr);
#endif
#ifndef Tcl_SetErrno_TCL_DECLARED
#define Tcl_SetErrno_TCL_DECLARED
/* 227 */
EXTERN void		Tcl_SetErrno(int err);
#endif
#ifndef Tcl_SetErrorCode_TCL_DECLARED
#define Tcl_SetErrorCode_TCL_DECLARED
/* 228 */
EXTERN void		Tcl_SetErrorCode(Tcl_Interp *interp, ...);
#endif
#ifndef Tcl_SetMaxBlockTime_TCL_DECLARED
#define Tcl_SetMaxBlockTime_TCL_DECLARED
/* 229 */
EXTERN void		Tcl_SetMaxBlockTime(const Tcl_Time *timePtr);
/* Slot 230 is reserved */
EXTERN void		Tcl_SetMaxBlockTime(Tcl_Time *timePtr);
#endif
#ifndef Tcl_SetPanicProc_TCL_DECLARED
#define Tcl_SetPanicProc_TCL_DECLARED
/* 230 */
EXTERN void		Tcl_SetPanicProc(Tcl_PanicProc *panicProc);
#endif
#ifndef Tcl_SetRecursionLimit_TCL_DECLARED
#define Tcl_SetRecursionLimit_TCL_DECLARED
/* 231 */
EXTERN int		Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth);
#endif
#ifndef Tcl_SetResult_TCL_DECLARED
#define Tcl_SetResult_TCL_DECLARED
/* Slot 232 is reserved */
/* 232 */
EXTERN void		Tcl_SetResult(Tcl_Interp *interp, char *result,
				Tcl_FreeProc *freeProc);
#endif
#ifndef Tcl_SetServiceMode_TCL_DECLARED
#define Tcl_SetServiceMode_TCL_DECLARED
/* 233 */
EXTERN int		Tcl_SetServiceMode(int mode);
#endif
#ifndef Tcl_SetObjErrorCode_TCL_DECLARED
#define Tcl_SetObjErrorCode_TCL_DECLARED
/* 234 */
EXTERN void		Tcl_SetObjErrorCode(Tcl_Interp *interp,
				Tcl_Obj *errorObjPtr);
#endif
#ifndef Tcl_SetObjResult_TCL_DECLARED
#define Tcl_SetObjResult_TCL_DECLARED
/* 235 */
EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr);
#endif
#ifndef Tcl_SetStdChannel_TCL_DECLARED
#define Tcl_SetStdChannel_TCL_DECLARED
/* 236 */
EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
#endif
#ifndef Tcl_SetVar_TCL_DECLARED
#define Tcl_SetVar_TCL_DECLARED
/* Slot 237 is reserved */
/* 237 */
EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
				CONST char *varName, CONST char *newValue,
				int flags);
#endif
#ifndef Tcl_SetVar2_TCL_DECLARED
#define Tcl_SetVar2_TCL_DECLARED
/* 238 */
EXTERN const char *	Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, const char *newValue,
				int flags);
EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
				CONST char *part1, CONST char *part2,
				CONST char *newValue, int flags);
#endif
#ifndef Tcl_SignalId_TCL_DECLARED
#define Tcl_SignalId_TCL_DECLARED
/* 239 */
EXTERN const char *	Tcl_SignalId(int sig);
EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
#endif
#ifndef Tcl_SignalMsg_TCL_DECLARED
#define Tcl_SignalMsg_TCL_DECLARED
/* 240 */
EXTERN const char *	Tcl_SignalMsg(int sig);
EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
#endif
#ifndef Tcl_SourceRCFile_TCL_DECLARED
#define Tcl_SourceRCFile_TCL_DECLARED
/* 241 */
EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
#endif
#ifndef Tcl_SplitList_TCL_DECLARED
#define Tcl_SplitList_TCL_DECLARED
/* 242 */
EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
				const char *listStr, int *argcPtr,
				const char ***argvPtr);
				CONST char *listStr, int *argcPtr,
				CONST84 char ***argvPtr);
#endif
#ifndef Tcl_SplitPath_TCL_DECLARED
#define Tcl_SplitPath_TCL_DECLARED
/* 243 */
EXTERN void		Tcl_SplitPath(const char *path, int *argcPtr,
				const char ***argvPtr);
/* Slot 244 is reserved */
/* Slot 245 is reserved */
/* Slot 246 is reserved */
/* Slot 247 is reserved */
EXTERN void		Tcl_SplitPath(CONST char *path, int *argcPtr,
				CONST84 char ***argvPtr);
#endif
#ifndef Tcl_StaticPackage_TCL_DECLARED
#define Tcl_StaticPackage_TCL_DECLARED
/* 244 */
EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
				CONST char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
#endif
#ifndef Tcl_StringMatch_TCL_DECLARED
#define Tcl_StringMatch_TCL_DECLARED
/* 245 */
EXTERN int		Tcl_StringMatch(CONST char *str, CONST char *pattern);
#endif
#ifndef Tcl_TellOld_TCL_DECLARED
#define Tcl_TellOld_TCL_DECLARED
/* 246 */
EXTERN int		Tcl_TellOld(Tcl_Channel chan);
#endif
#ifndef Tcl_TraceVar_TCL_DECLARED
#define Tcl_TraceVar_TCL_DECLARED
/* 247 */
EXTERN int		Tcl_TraceVar(Tcl_Interp *interp, CONST char *varName,
				int flags, Tcl_VarTraceProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_TraceVar2_TCL_DECLARED
#define Tcl_TraceVar2_TCL_DECLARED
/* 248 */
EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				Tcl_VarTraceProc *proc, void *clientData);
EXTERN int		Tcl_TraceVar2(Tcl_Interp *interp, CONST char *part1,
				CONST char *part2, int flags,
				Tcl_VarTraceProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_TranslateFileName_TCL_DECLARED
#define Tcl_TranslateFileName_TCL_DECLARED
/* 249 */
EXTERN char *		Tcl_TranslateFileName(Tcl_Interp *interp,
				const char *name, Tcl_DString *bufferPtr);
				CONST char *name, Tcl_DString *bufferPtr);
#endif
#ifndef Tcl_Ungets_TCL_DECLARED
#define Tcl_Ungets_TCL_DECLARED
/* 250 */
EXTERN size_t		Tcl_Ungets(Tcl_Channel chan, const char *str,
				size_t len, int atHead);
EXTERN int		Tcl_Ungets(Tcl_Channel chan, CONST char *str,
				int len, int atHead);
#endif
#ifndef Tcl_UnlinkVar_TCL_DECLARED
#define Tcl_UnlinkVar_TCL_DECLARED
/* 251 */
EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
				const char *varName);
				CONST char *varName);
#endif
#ifndef Tcl_UnregisterChannel_TCL_DECLARED
#define Tcl_UnregisterChannel_TCL_DECLARED
/* 252 */
EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
#endif
#ifndef Tcl_UnsetVar_TCL_DECLARED
#define Tcl_UnsetVar_TCL_DECLARED
/* Slot 253 is reserved */
/* 253 */
EXTERN int		Tcl_UnsetVar(Tcl_Interp *interp, CONST char *varName,
				int flags);
#endif
#ifndef Tcl_UnsetVar2_TCL_DECLARED
#define Tcl_UnsetVar2_TCL_DECLARED
/* 254 */
EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
/* Slot 255 is reserved */
EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, CONST char *part1,
				CONST char *part2, int flags);
#endif
#ifndef Tcl_UntraceVar_TCL_DECLARED
#define Tcl_UntraceVar_TCL_DECLARED
/* 255 */
EXTERN void		Tcl_UntraceVar(Tcl_Interp *interp,
				CONST char *varName, int flags,
				Tcl_VarTraceProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_UntraceVar2_TCL_DECLARED
#define Tcl_UntraceVar2_TCL_DECLARED
/* 256 */
EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
				const char *part1, const char *part2,
				CONST char *part1, CONST char *part2,
				int flags, Tcl_VarTraceProc *proc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_UpdateLinkedVar_TCL_DECLARED
#define Tcl_UpdateLinkedVar_TCL_DECLARED
/* 257 */
EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
				const char *varName);
/* Slot 258 is reserved */
				CONST char *varName);
#endif
#ifndef Tcl_UpVar_TCL_DECLARED
#define Tcl_UpVar_TCL_DECLARED
/* 258 */
EXTERN int		Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName,
				CONST char *varName, CONST char *localName,
				int flags);
#endif
#ifndef Tcl_UpVar2_TCL_DECLARED
#define Tcl_UpVar2_TCL_DECLARED
/* 259 */
EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
				const char *part1, const char *part2,
				const char *localName, int flags);
EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName,
				CONST char *part1, CONST char *part2,
				CONST char *localName, int flags);
#endif
#ifndef Tcl_VarEval_TCL_DECLARED
#define Tcl_VarEval_TCL_DECLARED
/* 260 */
EXTERN int		Tcl_VarEval(Tcl_Interp *interp, ...);
#endif
#ifndef Tcl_VarTraceInfo_TCL_DECLARED
#define Tcl_VarTraceInfo_TCL_DECLARED
/* Slot 261 is reserved */
/* 261 */
EXTERN ClientData	Tcl_VarTraceInfo(Tcl_Interp *interp,
				CONST char *varName, int flags,
				Tcl_VarTraceProc *procPtr,
				ClientData prevClientData);
#endif
#ifndef Tcl_VarTraceInfo2_TCL_DECLARED
#define Tcl_VarTraceInfo2_TCL_DECLARED
/* 262 */
EXTERN void *		Tcl_VarTraceInfo2(Tcl_Interp *interp,
				const char *part1, const char *part2,
EXTERN ClientData	Tcl_VarTraceInfo2(Tcl_Interp *interp,
				CONST char *part1, CONST char *part2,
				int flags, Tcl_VarTraceProc *procPtr,
				void *prevClientData);
				ClientData prevClientData);
#endif
#ifndef Tcl_Write_TCL_DECLARED
#define Tcl_Write_TCL_DECLARED
/* 263 */
EXTERN size_t		Tcl_Write(Tcl_Channel chan, const char *s,
				size_t slen);
EXTERN int		Tcl_Write(Tcl_Channel chan, CONST char *s, int slen);
#endif
#ifndef Tcl_WrongNumArgs_TCL_DECLARED
#define Tcl_WrongNumArgs_TCL_DECLARED
/* 264 */
EXTERN void		Tcl_WrongNumArgs(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], const char *message);
				Tcl_Obj *CONST objv[], CONST char *message);
#endif
#ifndef Tcl_DumpActiveMemory_TCL_DECLARED
#define Tcl_DumpActiveMemory_TCL_DECLARED
/* 265 */
EXTERN int		Tcl_DumpActiveMemory(const char *fileName);
EXTERN int		Tcl_DumpActiveMemory(CONST char *fileName);
#endif
#ifndef Tcl_ValidateAllMemory_TCL_DECLARED
#define Tcl_ValidateAllMemory_TCL_DECLARED
/* 266 */
EXTERN void		Tcl_ValidateAllMemory(const char *file, int line);
/* Slot 267 is reserved */
/* Slot 268 is reserved */
EXTERN void		Tcl_ValidateAllMemory(CONST char *file, int line);
#endif
#ifndef Tcl_AppendResultVA_TCL_DECLARED
#define Tcl_AppendResultVA_TCL_DECLARED
/* 267 */
EXTERN void		Tcl_AppendResultVA(Tcl_Interp *interp,
				va_list argList);
#endif
#ifndef Tcl_AppendStringsToObjVA_TCL_DECLARED
#define Tcl_AppendStringsToObjVA_TCL_DECLARED
/* 268 */
EXTERN void		Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
				va_list argList);
#endif
#ifndef Tcl_HashStats_TCL_DECLARED
#define Tcl_HashStats_TCL_DECLARED
/* 269 */
EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
#endif
#ifndef Tcl_ParseVar_TCL_DECLARED
#define Tcl_ParseVar_TCL_DECLARED
/* 270 */
EXTERN const char *	Tcl_ParseVar(Tcl_Interp *interp, const char *start,
				const char **termPtr);
/* Slot 271 is reserved */
EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
				CONST char *start, CONST84 char **termPtr);
#endif
#ifndef Tcl_PkgPresent_TCL_DECLARED
#define Tcl_PkgPresent_TCL_DECLARED
/* 271 */
EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
				CONST char *name, CONST char *version,
				int exact);
#endif
#ifndef Tcl_PkgPresentEx_TCL_DECLARED
#define Tcl_PkgPresentEx_TCL_DECLARED
/* 272 */
EXTERN const char *	Tcl_PkgPresentEx(Tcl_Interp *interp,
				const char *name, const char *version,
				int exact, void *clientDataPtr);
/* Slot 273 is reserved */
/* Slot 274 is reserved */
/* Slot 275 is reserved */
/* Slot 276 is reserved */
EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
				CONST char *name, CONST char *version,
				int exact, ClientData *clientDataPtr);
#endif
#ifndef Tcl_PkgProvide_TCL_DECLARED
#define Tcl_PkgProvide_TCL_DECLARED
/* 273 */
EXTERN int		Tcl_PkgProvide(Tcl_Interp *interp, CONST char *name,
				CONST char *version);
#endif
#ifndef Tcl_PkgRequire_TCL_DECLARED
#define Tcl_PkgRequire_TCL_DECLARED
/* 274 */
EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
				CONST char *name, CONST char *version,
				int exact);
#endif
#ifndef Tcl_SetErrorCodeVA_TCL_DECLARED
#define Tcl_SetErrorCodeVA_TCL_DECLARED
/* 275 */
EXTERN void		Tcl_SetErrorCodeVA(Tcl_Interp *interp,
				va_list argList);
#endif
#ifndef Tcl_VarEvalVA_TCL_DECLARED
#define Tcl_VarEvalVA_TCL_DECLARED
/* 276 */
EXTERN int		Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
#endif
#ifndef Tcl_WaitPid_TCL_DECLARED
#define Tcl_WaitPid_TCL_DECLARED
/* 277 */
EXTERN Tcl_Pid		Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
#endif
#ifndef Tcl_PanicVA_TCL_DECLARED
#define Tcl_PanicVA_TCL_DECLARED
/* Slot 278 is reserved */
/* 278 */
EXTERN void		Tcl_PanicVA(CONST char *format, va_list argList);
#endif
#ifndef Tcl_GetVersion_TCL_DECLARED
#define Tcl_GetVersion_TCL_DECLARED
/* 279 */
EXTERN void		Tcl_GetVersion(int *major, int *minor,
				int *patchLevel, int *type);
#endif
#ifndef Tcl_InitMemory_TCL_DECLARED
#define Tcl_InitMemory_TCL_DECLARED
/* 280 */
EXTERN void		Tcl_InitMemory(Tcl_Interp *interp);
#endif
#ifndef Tcl_StackChannel_TCL_DECLARED
#define Tcl_StackChannel_TCL_DECLARED
/* 281 */
EXTERN Tcl_Channel	Tcl_StackChannel(Tcl_Interp *interp,
				const Tcl_ChannelType *typePtr,
				void *instanceData, int mask,
				Tcl_ChannelType *typePtr,
				ClientData instanceData, int mask,
				Tcl_Channel prevChan);
#endif
#ifndef Tcl_UnstackChannel_TCL_DECLARED
#define Tcl_UnstackChannel_TCL_DECLARED
/* 282 */
EXTERN int		Tcl_UnstackChannel(Tcl_Interp *interp,
				Tcl_Channel chan);
#endif
#ifndef Tcl_GetStackedChannel_TCL_DECLARED
#define Tcl_GetStackedChannel_TCL_DECLARED
/* 283 */
EXTERN Tcl_Channel	Tcl_GetStackedChannel(Tcl_Channel chan);
#endif
#ifndef Tcl_SetMainLoop_TCL_DECLARED
#define Tcl_SetMainLoop_TCL_DECLARED
/* 284 */
EXTERN void		Tcl_SetMainLoop(Tcl_MainLoopProc *proc);
#endif
/* Slot 285 is reserved */
#ifndef Tcl_AppendObjToObj_TCL_DECLARED
#define Tcl_AppendObjToObj_TCL_DECLARED
/* 286 */
EXTERN void		Tcl_AppendObjToObj(Tcl_Obj *objPtr,
				Tcl_Obj *appendObjPtr);
#endif
#ifndef Tcl_CreateEncoding_TCL_DECLARED
#define Tcl_CreateEncoding_TCL_DECLARED
/* 287 */
EXTERN Tcl_Encoding	Tcl_CreateEncoding(const Tcl_EncodingType *typePtr);
EXTERN Tcl_Encoding	Tcl_CreateEncoding(CONST Tcl_EncodingType *typePtr);
#endif
#ifndef Tcl_CreateThreadExitHandler_TCL_DECLARED
#define Tcl_CreateThreadExitHandler_TCL_DECLARED
/* 288 */
EXTERN void		Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_DeleteThreadExitHandler_TCL_DECLARED
#define Tcl_DeleteThreadExitHandler_TCL_DECLARED
/* 289 */
EXTERN void		Tcl_DeleteThreadExitHandler(Tcl_ExitProc *proc,
				void *clientData);
/* Slot 290 is reserved */
				ClientData clientData);
#endif
#ifndef Tcl_DiscardResult_TCL_DECLARED
#define Tcl_DiscardResult_TCL_DECLARED
/* 290 */
EXTERN void		Tcl_DiscardResult(Tcl_SavedResult *statePtr);
#endif
#ifndef Tcl_EvalEx_TCL_DECLARED
#define Tcl_EvalEx_TCL_DECLARED
/* 291 */
EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, const char *script,
				size_t numBytes, int flags);
EXTERN int		Tcl_EvalEx(Tcl_Interp *interp, CONST char *script,
				int numBytes, int flags);
#endif
#ifndef Tcl_EvalObjv_TCL_DECLARED
#define Tcl_EvalObjv_TCL_DECLARED
/* 292 */
EXTERN int		Tcl_EvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
				Tcl_Obj *CONST objv[], int flags);
#endif
#ifndef Tcl_EvalObjEx_TCL_DECLARED
#define Tcl_EvalObjEx_TCL_DECLARED
/* 293 */
EXTERN int		Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
#endif
#ifndef Tcl_ExitThread_TCL_DECLARED
#define Tcl_ExitThread_TCL_DECLARED
/* 294 */
EXTERN TCL_NORETURN void Tcl_ExitThread(int status);
EXTERN void		Tcl_ExitThread(int status);
#endif
#ifndef Tcl_ExternalToUtf_TCL_DECLARED
#define Tcl_ExternalToUtf_TCL_DECLARED
/* 295 */
EXTERN int		Tcl_ExternalToUtf(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				size_t srcLen, int flags,
				Tcl_Encoding encoding, CONST char *src,
				int srcLen, int flags,
				Tcl_EncodingState *statePtr, char *dst,
				size_t dstLen, int *srcReadPtr,
				int dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
#endif
#ifndef Tcl_ExternalToUtfDString_TCL_DECLARED
#define Tcl_ExternalToUtfDString_TCL_DECLARED
/* 296 */
EXTERN char *		Tcl_ExternalToUtfDString(Tcl_Encoding encoding,
				const char *src, size_t srcLen,
				CONST char *src, int srcLen,
				Tcl_DString *dsPtr);
#endif
#ifndef Tcl_FinalizeThread_TCL_DECLARED
#define Tcl_FinalizeThread_TCL_DECLARED
/* 297 */
EXTERN void		Tcl_FinalizeThread(void);
#endif
#ifndef Tcl_FinalizeNotifier_TCL_DECLARED
#define Tcl_FinalizeNotifier_TCL_DECLARED
/* 298 */
EXTERN void		Tcl_FinalizeNotifier(void *clientData);
EXTERN void		Tcl_FinalizeNotifier(ClientData clientData);
#endif
#ifndef Tcl_FreeEncoding_TCL_DECLARED
#define Tcl_FreeEncoding_TCL_DECLARED
/* 299 */
EXTERN void		Tcl_FreeEncoding(Tcl_Encoding encoding);
#endif
#ifndef Tcl_GetCurrentThread_TCL_DECLARED
#define Tcl_GetCurrentThread_TCL_DECLARED
/* 300 */
EXTERN Tcl_ThreadId	Tcl_GetCurrentThread(void);
#endif
#ifndef Tcl_GetEncoding_TCL_DECLARED
#define Tcl_GetEncoding_TCL_DECLARED
/* 301 */
EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
EXTERN Tcl_Encoding	Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name);
#endif
#ifndef Tcl_GetEncodingName_TCL_DECLARED
#define Tcl_GetEncodingName_TCL_DECLARED
/* 302 */
EXTERN const char *	Tcl_GetEncodingName(Tcl_Encoding encoding);
EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
#endif
#ifndef Tcl_GetEncodingNames_TCL_DECLARED
#define Tcl_GetEncodingNames_TCL_DECLARED
/* 303 */
EXTERN void		Tcl_GetEncodingNames(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetIndexFromObjStruct_TCL_DECLARED
#define Tcl_GetIndexFromObjStruct_TCL_DECLARED
/* 304 */
EXTERN int		Tcl_GetIndexFromObjStruct(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const void *tablePtr,
				size_t offset, const char *msg, int flags,
				Tcl_Obj *objPtr, CONST VOID *tablePtr,
				int offset, CONST char *msg, int flags,
				int *indexPtr);
#endif
#ifndef Tcl_GetThreadData_TCL_DECLARED
#define Tcl_GetThreadData_TCL_DECLARED
/* 305 */
EXTERN void *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
				size_t size);
EXTERN VOID *		Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr,
				int size);
#endif
#ifndef Tcl_GetVar2Ex_TCL_DECLARED
#define Tcl_GetVar2Ex_TCL_DECLARED
/* 306 */
EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags);
EXTERN Tcl_Obj *	Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1,
				CONST char *part2, int flags);
#endif
#ifndef Tcl_InitNotifier_TCL_DECLARED
#define Tcl_InitNotifier_TCL_DECLARED
/* 307 */
EXTERN void *		Tcl_InitNotifier(void);
EXTERN ClientData	Tcl_InitNotifier(void);
#endif
#ifndef Tcl_MutexLock_TCL_DECLARED
#define Tcl_MutexLock_TCL_DECLARED
/* 308 */
EXTERN void		Tcl_MutexLock(Tcl_Mutex *mutexPtr);
#endif
#ifndef Tcl_MutexUnlock_TCL_DECLARED
#define Tcl_MutexUnlock_TCL_DECLARED
/* 309 */
EXTERN void		Tcl_MutexUnlock(Tcl_Mutex *mutexPtr);
#endif
#ifndef Tcl_ConditionNotify_TCL_DECLARED
#define Tcl_ConditionNotify_TCL_DECLARED
/* 310 */
EXTERN void		Tcl_ConditionNotify(Tcl_Condition *condPtr);
#endif
#ifndef Tcl_ConditionWait_TCL_DECLARED
#define Tcl_ConditionWait_TCL_DECLARED
/* 311 */
EXTERN void		Tcl_ConditionWait(Tcl_Condition *condPtr,
				Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr);
				Tcl_Mutex *mutexPtr, Tcl_Time *timePtr);
#endif
#ifndef Tcl_NumUtfChars_TCL_DECLARED
#define Tcl_NumUtfChars_TCL_DECLARED
/* 312 */
EXTERN size_t		Tcl_NumUtfChars(const char *src, size_t length);
EXTERN int		Tcl_NumUtfChars(CONST char *src, int length);
#endif
#ifndef Tcl_ReadChars_TCL_DECLARED
#define Tcl_ReadChars_TCL_DECLARED
/* 313 */
EXTERN size_t		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
				size_t charsToRead, int appendFlag);
/* Slot 314 is reserved */
/* Slot 315 is reserved */
EXTERN int		Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
				int charsToRead, int appendFlag);
#endif
#ifndef Tcl_RestoreResult_TCL_DECLARED
#define Tcl_RestoreResult_TCL_DECLARED
/* 314 */
EXTERN void		Tcl_RestoreResult(Tcl_Interp *interp,
				Tcl_SavedResult *statePtr);
#endif
#ifndef Tcl_SaveResult_TCL_DECLARED
#define Tcl_SaveResult_TCL_DECLARED
/* 315 */
EXTERN void		Tcl_SaveResult(Tcl_Interp *interp,
				Tcl_SavedResult *statePtr);
#endif
#ifndef Tcl_SetSystemEncoding_TCL_DECLARED
#define Tcl_SetSystemEncoding_TCL_DECLARED
/* 316 */
EXTERN int		Tcl_SetSystemEncoding(Tcl_Interp *interp,
				const char *name);
				CONST char *name);
#endif
#ifndef Tcl_SetVar2Ex_TCL_DECLARED
#define Tcl_SetVar2Ex_TCL_DECLARED
/* 317 */
EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, const char *part1,
				const char *part2, Tcl_Obj *newValuePtr,
EXTERN Tcl_Obj *	Tcl_SetVar2Ex(Tcl_Interp *interp, CONST char *part1,
				CONST char *part2, Tcl_Obj *newValuePtr,
				int flags);
#endif
#ifndef Tcl_ThreadAlert_TCL_DECLARED
#define Tcl_ThreadAlert_TCL_DECLARED
/* 318 */
EXTERN void		Tcl_ThreadAlert(Tcl_ThreadId threadId);
#endif
#ifndef Tcl_ThreadQueueEvent_TCL_DECLARED
#define Tcl_ThreadQueueEvent_TCL_DECLARED
/* 319 */
EXTERN void		Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
				Tcl_Event *evPtr, Tcl_QueuePosition position);
#endif
#ifndef Tcl_UniCharAtIndex_TCL_DECLARED
#define Tcl_UniCharAtIndex_TCL_DECLARED
/* 320 */
EXTERN int		Tcl_UniCharAtIndex(const char *src, size_t index);
EXTERN Tcl_UniChar	Tcl_UniCharAtIndex(CONST char *src, int index);
#endif
#ifndef Tcl_UniCharToLower_TCL_DECLARED
#define Tcl_UniCharToLower_TCL_DECLARED
/* 321 */
EXTERN int		Tcl_UniCharToLower(int ch);
EXTERN Tcl_UniChar	Tcl_UniCharToLower(int ch);
#endif
#ifndef Tcl_UniCharToTitle_TCL_DECLARED
#define Tcl_UniCharToTitle_TCL_DECLARED
/* 322 */
EXTERN int		Tcl_UniCharToTitle(int ch);
EXTERN Tcl_UniChar	Tcl_UniCharToTitle(int ch);
#endif
#ifndef Tcl_UniCharToUpper_TCL_DECLARED
#define Tcl_UniCharToUpper_TCL_DECLARED
/* 323 */
EXTERN int		Tcl_UniCharToUpper(int ch);
EXTERN Tcl_UniChar	Tcl_UniCharToUpper(int ch);
#endif
#ifndef Tcl_UniCharToUtf_TCL_DECLARED
#define Tcl_UniCharToUtf_TCL_DECLARED
/* 324 */
EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
#endif
#ifndef Tcl_UtfAtIndex_TCL_DECLARED
#define Tcl_UtfAtIndex_TCL_DECLARED
/* 325 */
EXTERN const char *	Tcl_UtfAtIndex(const char *src, size_t index);
EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index);
#endif
#ifndef Tcl_UtfCharComplete_TCL_DECLARED
#define Tcl_UtfCharComplete_TCL_DECLARED
/* 326 */
EXTERN int		Tcl_UtfCharComplete(const char *src, size_t length);
EXTERN int		Tcl_UtfCharComplete(CONST char *src, int length);
#endif
#ifndef Tcl_UtfBackslash_TCL_DECLARED
#define Tcl_UtfBackslash_TCL_DECLARED
/* 327 */
EXTERN size_t		Tcl_UtfBackslash(const char *src, int *readPtr,
EXTERN int		Tcl_UtfBackslash(CONST char *src, int *readPtr,
				char *dst);
#endif
#ifndef Tcl_UtfFindFirst_TCL_DECLARED
#define Tcl_UtfFindFirst_TCL_DECLARED
/* 328 */
EXTERN const char *	Tcl_UtfFindFirst(const char *src, int ch);
EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(CONST char *src, int ch);
#endif
#ifndef Tcl_UtfFindLast_TCL_DECLARED
#define Tcl_UtfFindLast_TCL_DECLARED
/* 329 */
EXTERN const char *	Tcl_UtfFindLast(const char *src, int ch);
EXTERN CONST84_RETURN char * Tcl_UtfFindLast(CONST char *src, int ch);
#endif
#ifndef Tcl_UtfNext_TCL_DECLARED
#define Tcl_UtfNext_TCL_DECLARED
/* 330 */
EXTERN const char *	Tcl_UtfNext(const char *src);
EXTERN CONST84_RETURN char * Tcl_UtfNext(CONST char *src);
#endif
#ifndef Tcl_UtfPrev_TCL_DECLARED
#define Tcl_UtfPrev_TCL_DECLARED
/* 331 */
EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
EXTERN CONST84_RETURN char * Tcl_UtfPrev(CONST char *src, CONST char *start);
#endif
#ifndef Tcl_UtfToExternal_TCL_DECLARED
#define Tcl_UtfToExternal_TCL_DECLARED
/* 332 */
EXTERN int		Tcl_UtfToExternal(Tcl_Interp *interp,
				Tcl_Encoding encoding, const char *src,
				size_t srcLen, int flags,
				Tcl_Encoding encoding, CONST char *src,
				int srcLen, int flags,
				Tcl_EncodingState *statePtr, char *dst,
				size_t dstLen, int *srcReadPtr,
				int dstLen, int *srcReadPtr,
				int *dstWrotePtr, int *dstCharsPtr);
#endif
#ifndef Tcl_UtfToExternalDString_TCL_DECLARED
#define Tcl_UtfToExternalDString_TCL_DECLARED
/* 333 */
EXTERN char *		Tcl_UtfToExternalDString(Tcl_Encoding encoding,
				const char *src, size_t srcLen,
				CONST char *src, int srcLen,
				Tcl_DString *dsPtr);
#endif
#ifndef Tcl_UtfToLower_TCL_DECLARED
#define Tcl_UtfToLower_TCL_DECLARED
/* 334 */
EXTERN int		Tcl_UtfToLower(char *src);
#endif
#ifndef Tcl_UtfToTitle_TCL_DECLARED
#define Tcl_UtfToTitle_TCL_DECLARED
/* 335 */
EXTERN int		Tcl_UtfToTitle(char *src);
#endif
#ifndef Tcl_UtfToUniChar_TCL_DECLARED
#define Tcl_UtfToUniChar_TCL_DECLARED
/* 336 */
EXTERN int		Tcl_UtfToChar16(const char *src,
EXTERN int		Tcl_UtfToUniChar(CONST char *src, Tcl_UniChar *chPtr);
				unsigned short *chPtr);
#endif
#ifndef Tcl_UtfToUpper_TCL_DECLARED
#define Tcl_UtfToUpper_TCL_DECLARED
/* 337 */
EXTERN int		Tcl_UtfToUpper(char *src);
#endif
#ifndef Tcl_WriteChars_TCL_DECLARED
#define Tcl_WriteChars_TCL_DECLARED
/* 338 */
EXTERN size_t		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				size_t srcLen);
EXTERN int		Tcl_WriteChars(Tcl_Channel chan, CONST char *src,
				int srcLen);
#endif
#ifndef Tcl_WriteObj_TCL_DECLARED
#define Tcl_WriteObj_TCL_DECLARED
/* 339 */
EXTERN size_t		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetString_TCL_DECLARED
#define Tcl_GetString_TCL_DECLARED
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetDefaultEncodingDir_TCL_DECLARED
#define Tcl_GetDefaultEncodingDir_TCL_DECLARED
/* Slot 341 is reserved */
/* Slot 342 is reserved */
/* 341 */
EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
#endif
#ifndef Tcl_SetDefaultEncodingDir_TCL_DECLARED
#define Tcl_SetDefaultEncodingDir_TCL_DECLARED
/* 342 */
EXTERN void		Tcl_SetDefaultEncodingDir(CONST char *path);
#endif
#ifndef Tcl_AlertNotifier_TCL_DECLARED
#define Tcl_AlertNotifier_TCL_DECLARED
/* 343 */
EXTERN void		Tcl_AlertNotifier(void *clientData);
EXTERN void		Tcl_AlertNotifier(ClientData clientData);
#endif
#ifndef Tcl_ServiceModeHook_TCL_DECLARED
#define Tcl_ServiceModeHook_TCL_DECLARED
/* 344 */
EXTERN void		Tcl_ServiceModeHook(int mode);
#endif
#ifndef Tcl_UniCharIsAlnum_TCL_DECLARED
#define Tcl_UniCharIsAlnum_TCL_DECLARED
/* 345 */
EXTERN int		Tcl_UniCharIsAlnum(int ch);
#endif
#ifndef Tcl_UniCharIsAlpha_TCL_DECLARED
#define Tcl_UniCharIsAlpha_TCL_DECLARED
/* 346 */
EXTERN int		Tcl_UniCharIsAlpha(int ch);
#endif
#ifndef Tcl_UniCharIsDigit_TCL_DECLARED
#define Tcl_UniCharIsDigit_TCL_DECLARED
/* 347 */
EXTERN int		Tcl_UniCharIsDigit(int ch);
#endif
#ifndef Tcl_UniCharIsLower_TCL_DECLARED
#define Tcl_UniCharIsLower_TCL_DECLARED
/* 348 */
EXTERN int		Tcl_UniCharIsLower(int ch);
#endif
#ifndef Tcl_UniCharIsSpace_TCL_DECLARED
#define Tcl_UniCharIsSpace_TCL_DECLARED
/* 349 */
EXTERN int		Tcl_UniCharIsSpace(int ch);
#endif
#ifndef Tcl_UniCharIsUpper_TCL_DECLARED
#define Tcl_UniCharIsUpper_TCL_DECLARED
/* 350 */
EXTERN int		Tcl_UniCharIsUpper(int ch);
#endif
#ifndef Tcl_UniCharIsWordChar_TCL_DECLARED
#define Tcl_UniCharIsWordChar_TCL_DECLARED
/* 351 */
EXTERN int		Tcl_UniCharIsWordChar(int ch);
#endif
#ifndef Tcl_UniCharLen_TCL_DECLARED
#define Tcl_UniCharLen_TCL_DECLARED
/* Slot 352 is reserved */
/* Slot 353 is reserved */
/* 352 */
EXTERN int		Tcl_UniCharLen(CONST Tcl_UniChar *uniStr);
#endif
#ifndef Tcl_UniCharNcmp_TCL_DECLARED
#define Tcl_UniCharNcmp_TCL_DECLARED
/* 353 */
EXTERN int		Tcl_UniCharNcmp(CONST Tcl_UniChar *ucs,
				CONST Tcl_UniChar *uct,
				unsigned long numChars);
#endif
#ifndef Tcl_UniCharToUtfDString_TCL_DECLARED
#define Tcl_UniCharToUtfDString_TCL_DECLARED
/* 354 */
EXTERN char *		Tcl_Char16ToUtfDString(const unsigned short *uniStr,
				size_t uniLength, Tcl_DString *dsPtr);
EXTERN char *		Tcl_UniCharToUtfDString(CONST Tcl_UniChar *uniStr,
				int uniLength, Tcl_DString *dsPtr);
#endif
#ifndef Tcl_UtfToUniCharDString_TCL_DECLARED
#define Tcl_UtfToUniCharDString_TCL_DECLARED
/* 355 */
EXTERN unsigned short *	 Tcl_UtfToChar16DString(const char *src,
				size_t length, Tcl_DString *dsPtr);
EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(CONST char *src, int length,
				Tcl_DString *dsPtr);
#endif
#ifndef Tcl_GetRegExpFromObj_TCL_DECLARED
#define Tcl_GetRegExpFromObj_TCL_DECLARED
/* 356 */
EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
#endif
#ifndef Tcl_EvalTokens_TCL_DECLARED
#define Tcl_EvalTokens_TCL_DECLARED
/* Slot 357 is reserved */
/* 357 */
EXTERN Tcl_Obj *	Tcl_EvalTokens(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, int count);
#endif
#ifndef Tcl_FreeParse_TCL_DECLARED
#define Tcl_FreeParse_TCL_DECLARED
/* 358 */
EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
#endif
#ifndef Tcl_LogCommandInfo_TCL_DECLARED
#define Tcl_LogCommandInfo_TCL_DECLARED
/* 359 */
EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				size_t length);
				CONST char *script, CONST char *command,
				int length);
#endif
#ifndef Tcl_ParseBraces_TCL_DECLARED
#define Tcl_ParseBraces_TCL_DECLARED
/* 360 */
EXTERN int		Tcl_ParseBraces(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				CONST char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
				CONST84 char **termPtr);
#endif
#ifndef Tcl_ParseCommand_TCL_DECLARED
#define Tcl_ParseCommand_TCL_DECLARED
/* 361 */
EXTERN int		Tcl_ParseCommand(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				int nested, Tcl_Parse *parsePtr);
				CONST char *start, int numBytes, int nested,
				Tcl_Parse *parsePtr);
#endif
#ifndef Tcl_ParseExpr_TCL_DECLARED
#define Tcl_ParseExpr_TCL_DECLARED
/* 362 */
EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
				size_t numBytes, Tcl_Parse *parsePtr);
EXTERN int		Tcl_ParseExpr(Tcl_Interp *interp, CONST char *start,
				int numBytes, Tcl_Parse *parsePtr);
#endif
#ifndef Tcl_ParseQuotedString_TCL_DECLARED
#define Tcl_ParseQuotedString_TCL_DECLARED
/* 363 */
EXTERN int		Tcl_ParseQuotedString(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				CONST char *start, int numBytes,
				Tcl_Parse *parsePtr, int append,
				const char **termPtr);
				CONST84 char **termPtr);
#endif
#ifndef Tcl_ParseVarName_TCL_DECLARED
#define Tcl_ParseVarName_TCL_DECLARED
/* 364 */
EXTERN int		Tcl_ParseVarName(Tcl_Interp *interp,
				const char *start, size_t numBytes,
				CONST char *start, int numBytes,
				Tcl_Parse *parsePtr, int append);
#endif
#ifndef Tcl_GetCwd_TCL_DECLARED
#define Tcl_GetCwd_TCL_DECLARED
/* 365 */
EXTERN char *		Tcl_GetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
#endif
#ifndef Tcl_Chdir_TCL_DECLARED
#define Tcl_Chdir_TCL_DECLARED
/* 366 */
EXTERN int		Tcl_Chdir(const char *dirName);
EXTERN int		Tcl_Chdir(CONST char *dirName);
#endif
#ifndef Tcl_Access_TCL_DECLARED
#define Tcl_Access_TCL_DECLARED
/* 367 */
EXTERN int		Tcl_Access(const char *path, int mode);
EXTERN int		Tcl_Access(CONST char *path, int mode);
#endif
#ifndef Tcl_Stat_TCL_DECLARED
#define Tcl_Stat_TCL_DECLARED
/* 368 */
EXTERN int		Tcl_Stat(const char *path, struct stat *bufPtr);
EXTERN int		Tcl_Stat(CONST char *path, struct stat *bufPtr);
#endif
#ifndef Tcl_UtfNcmp_TCL_DECLARED
#define Tcl_UtfNcmp_TCL_DECLARED
/* 369 */
EXTERN int		Tcl_UtfNcmp(const char *s1, const char *s2, size_t n);
EXTERN int		Tcl_UtfNcmp(CONST char *s1, CONST char *s2,
				unsigned long n);
#endif
#ifndef Tcl_UtfNcasecmp_TCL_DECLARED
#define Tcl_UtfNcasecmp_TCL_DECLARED
/* 370 */
EXTERN int		Tcl_UtfNcasecmp(const char *s1, const char *s2,
				size_t n);
EXTERN int		Tcl_UtfNcasecmp(CONST char *s1, CONST char *s2,
				unsigned long n);
#endif
#ifndef Tcl_StringCaseMatch_TCL_DECLARED
#define Tcl_StringCaseMatch_TCL_DECLARED
/* 371 */
EXTERN int		Tcl_StringCaseMatch(const char *str,
				const char *pattern, int nocase);
EXTERN int		Tcl_StringCaseMatch(CONST char *str,
				CONST char *pattern, int nocase);
#endif
#ifndef Tcl_UniCharIsControl_TCL_DECLARED
#define Tcl_UniCharIsControl_TCL_DECLARED
/* 372 */
EXTERN int		Tcl_UniCharIsControl(int ch);
#endif
#ifndef Tcl_UniCharIsGraph_TCL_DECLARED
#define Tcl_UniCharIsGraph_TCL_DECLARED
/* 373 */
EXTERN int		Tcl_UniCharIsGraph(int ch);
#endif
#ifndef Tcl_UniCharIsPrint_TCL_DECLARED
#define Tcl_UniCharIsPrint_TCL_DECLARED
/* 374 */
EXTERN int		Tcl_UniCharIsPrint(int ch);
#endif
#ifndef Tcl_UniCharIsPunct_TCL_DECLARED
#define Tcl_UniCharIsPunct_TCL_DECLARED
/* 375 */
EXTERN int		Tcl_UniCharIsPunct(int ch);
#endif
#ifndef Tcl_RegExpExecObj_TCL_DECLARED
#define Tcl_RegExpExecObj_TCL_DECLARED
/* 376 */
EXTERN int		Tcl_RegExpExecObj(Tcl_Interp *interp,
				Tcl_RegExp regexp, Tcl_Obj *textObj,
				size_t offset, size_t nmatches, int flags);
				int offset, int nmatches, int flags);
#endif
#ifndef Tcl_RegExpGetInfo_TCL_DECLARED
#define Tcl_RegExpGetInfo_TCL_DECLARED
/* 377 */
EXTERN void		Tcl_RegExpGetInfo(Tcl_RegExp regexp,
				Tcl_RegExpInfo *infoPtr);
#endif
#ifndef Tcl_NewUnicodeObj_TCL_DECLARED
#define Tcl_NewUnicodeObj_TCL_DECLARED
/* 378 */
EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(const Tcl_UniChar *unicode,
				size_t numChars);
EXTERN Tcl_Obj *	Tcl_NewUnicodeObj(CONST Tcl_UniChar *unicode,
				int numChars);
#endif
#ifndef Tcl_SetUnicodeObj_TCL_DECLARED
#define Tcl_SetUnicodeObj_TCL_DECLARED
/* 379 */
EXTERN void		Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, size_t numChars);
				CONST Tcl_UniChar *unicode, int numChars);
#endif
#ifndef Tcl_GetCharLength_TCL_DECLARED
#define Tcl_GetCharLength_TCL_DECLARED
/* 380 */
EXTERN size_t		Tcl_GetCharLength(Tcl_Obj *objPtr);
EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetUniChar_TCL_DECLARED
#define Tcl_GetUniChar_TCL_DECLARED
/* 381 */
EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index);
/* Slot 382 is reserved */
EXTERN Tcl_UniChar	Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
#endif
#ifndef Tcl_GetUnicode_TCL_DECLARED
#define Tcl_GetUnicode_TCL_DECLARED
/* 382 */
EXTERN Tcl_UniChar *	Tcl_GetUnicode(Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetRange_TCL_DECLARED
#define Tcl_GetRange_TCL_DECLARED
/* 383 */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, size_t first,
				size_t last);
/* Slot 384 is reserved */
EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
#endif
#ifndef Tcl_AppendUnicodeToObj_TCL_DECLARED
#define Tcl_AppendUnicodeToObj_TCL_DECLARED
/* 384 */
EXTERN void		Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
				CONST Tcl_UniChar *unicode, int length);
#endif
#ifndef Tcl_RegExpMatchObj_TCL_DECLARED
#define Tcl_RegExpMatchObj_TCL_DECLARED
/* 385 */
EXTERN int		Tcl_RegExpMatchObj(Tcl_Interp *interp,
				Tcl_Obj *textObj, Tcl_Obj *patternObj);
#endif
#ifndef Tcl_SetNotifier_TCL_DECLARED
#define Tcl_SetNotifier_TCL_DECLARED
/* 386 */
EXTERN void		Tcl_SetNotifier(Tcl_NotifierProcs *notifierProcPtr);
#endif
#ifndef Tcl_GetAllocMutex_TCL_DECLARED
#define Tcl_GetAllocMutex_TCL_DECLARED
/* 387 */
EXTERN Tcl_Mutex *	Tcl_GetAllocMutex(void);
#endif
#ifndef Tcl_GetChannelNames_TCL_DECLARED
#define Tcl_GetChannelNames_TCL_DECLARED
/* 388 */
EXTERN int		Tcl_GetChannelNames(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetChannelNamesEx_TCL_DECLARED
#define Tcl_GetChannelNamesEx_TCL_DECLARED
/* 389 */
EXTERN int		Tcl_GetChannelNamesEx(Tcl_Interp *interp,
				const char *pattern);
				CONST char *pattern);
#endif
#ifndef Tcl_ProcObjCmd_TCL_DECLARED
#define Tcl_ProcObjCmd_TCL_DECLARED
/* 390 */
EXTERN int		Tcl_ProcObjCmd(void *clientData, Tcl_Interp *interp,
				int objc, Tcl_Obj *const objv[]);
EXTERN int		Tcl_ProcObjCmd(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_ConditionFinalize_TCL_DECLARED
#define Tcl_ConditionFinalize_TCL_DECLARED
/* 391 */
EXTERN void		Tcl_ConditionFinalize(Tcl_Condition *condPtr);
#endif
#ifndef Tcl_MutexFinalize_TCL_DECLARED
#define Tcl_MutexFinalize_TCL_DECLARED
/* 392 */
EXTERN void		Tcl_MutexFinalize(Tcl_Mutex *mutex);
#endif
#ifndef Tcl_CreateThread_TCL_DECLARED
#define Tcl_CreateThread_TCL_DECLARED
/* 393 */
EXTERN int		Tcl_CreateThread(Tcl_ThreadId *idPtr,
				Tcl_ThreadCreateProc *proc, void *clientData,
				size_t stackSize, int flags);
				Tcl_ThreadCreateProc proc,
				ClientData clientData, int stackSize,
				int flags);
#endif
#ifndef Tcl_ReadRaw_TCL_DECLARED
#define Tcl_ReadRaw_TCL_DECLARED
/* 394 */
EXTERN size_t		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				size_t bytesToRead);
EXTERN int		Tcl_ReadRaw(Tcl_Channel chan, char *dst,
				int bytesToRead);
#endif
#ifndef Tcl_WriteRaw_TCL_DECLARED
#define Tcl_WriteRaw_TCL_DECLARED
/* 395 */
EXTERN size_t		Tcl_WriteRaw(Tcl_Channel chan, const char *src,
				size_t srcLen);
EXTERN int		Tcl_WriteRaw(Tcl_Channel chan, CONST char *src,
				int srcLen);
#endif
#ifndef Tcl_GetTopChannel_TCL_DECLARED
#define Tcl_GetTopChannel_TCL_DECLARED
/* 396 */
EXTERN Tcl_Channel	Tcl_GetTopChannel(Tcl_Channel chan);
#endif
#ifndef Tcl_ChannelBuffered_TCL_DECLARED
#define Tcl_ChannelBuffered_TCL_DECLARED
/* 397 */
EXTERN int		Tcl_ChannelBuffered(Tcl_Channel chan);
#endif
#ifndef Tcl_ChannelName_TCL_DECLARED
#define Tcl_ChannelName_TCL_DECLARED
/* 398 */
EXTERN CONST84_RETURN char * Tcl_ChannelName(
EXTERN const char *	Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelVersion_TCL_DECLARED
#define Tcl_ChannelVersion_TCL_DECLARED
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelBlockModeProc_TCL_DECLARED
#define Tcl_ChannelBlockModeProc_TCL_DECLARED
/* 400 */
EXTERN Tcl_DriverBlockModeProc * Tcl_ChannelBlockModeProc(
				const Tcl_ChannelType *chanTypePtr);
/* Slot 401 is reserved */
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelCloseProc_TCL_DECLARED
#define Tcl_ChannelCloseProc_TCL_DECLARED
/* 401 */
EXTERN Tcl_DriverCloseProc * Tcl_ChannelCloseProc(
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelClose2Proc_TCL_DECLARED
#define Tcl_ChannelClose2Proc_TCL_DECLARED
/* 402 */
EXTERN Tcl_DriverClose2Proc * Tcl_ChannelClose2Proc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelInputProc_TCL_DECLARED
#define Tcl_ChannelInputProc_TCL_DECLARED
/* 403 */
EXTERN Tcl_DriverInputProc * Tcl_ChannelInputProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelOutputProc_TCL_DECLARED
#define Tcl_ChannelOutputProc_TCL_DECLARED
/* 404 */
EXTERN Tcl_DriverOutputProc * Tcl_ChannelOutputProc(
				const Tcl_ChannelType *chanTypePtr);
/* Slot 405 is reserved */
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelSeekProc_TCL_DECLARED
#define Tcl_ChannelSeekProc_TCL_DECLARED
/* 405 */
EXTERN Tcl_DriverSeekProc * Tcl_ChannelSeekProc(
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelSetOptionProc_TCL_DECLARED
#define Tcl_ChannelSetOptionProc_TCL_DECLARED
/* 406 */
EXTERN Tcl_DriverSetOptionProc * Tcl_ChannelSetOptionProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelGetOptionProc_TCL_DECLARED
#define Tcl_ChannelGetOptionProc_TCL_DECLARED
/* 407 */
EXTERN Tcl_DriverGetOptionProc * Tcl_ChannelGetOptionProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelWatchProc_TCL_DECLARED
#define Tcl_ChannelWatchProc_TCL_DECLARED
/* 408 */
EXTERN Tcl_DriverWatchProc * Tcl_ChannelWatchProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelGetHandleProc_TCL_DECLARED
#define Tcl_ChannelGetHandleProc_TCL_DECLARED
/* 409 */
EXTERN Tcl_DriverGetHandleProc * Tcl_ChannelGetHandleProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelFlushProc_TCL_DECLARED
#define Tcl_ChannelFlushProc_TCL_DECLARED
/* 410 */
EXTERN Tcl_DriverFlushProc * Tcl_ChannelFlushProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_ChannelHandlerProc_TCL_DECLARED
#define Tcl_ChannelHandlerProc_TCL_DECLARED
/* 411 */
EXTERN Tcl_DriverHandlerProc * Tcl_ChannelHandlerProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_JoinThread_TCL_DECLARED
#define Tcl_JoinThread_TCL_DECLARED
/* 412 */
EXTERN int		Tcl_JoinThread(Tcl_ThreadId threadId, int *result);
#endif
#ifndef Tcl_IsChannelShared_TCL_DECLARED
#define Tcl_IsChannelShared_TCL_DECLARED
/* 413 */
EXTERN int		Tcl_IsChannelShared(Tcl_Channel channel);
#endif
#ifndef Tcl_IsChannelRegistered_TCL_DECLARED
#define Tcl_IsChannelRegistered_TCL_DECLARED
/* 414 */
EXTERN int		Tcl_IsChannelRegistered(Tcl_Interp *interp,
				Tcl_Channel channel);
#endif
#ifndef Tcl_CutChannel_TCL_DECLARED
#define Tcl_CutChannel_TCL_DECLARED
/* 415 */
EXTERN void		Tcl_CutChannel(Tcl_Channel channel);
#endif
#ifndef Tcl_SpliceChannel_TCL_DECLARED
#define Tcl_SpliceChannel_TCL_DECLARED
/* 416 */
EXTERN void		Tcl_SpliceChannel(Tcl_Channel channel);
#endif
#ifndef Tcl_ClearChannelHandlers_TCL_DECLARED
#define Tcl_ClearChannelHandlers_TCL_DECLARED
/* 417 */
EXTERN void		Tcl_ClearChannelHandlers(Tcl_Channel channel);
#endif
#ifndef Tcl_IsChannelExisting_TCL_DECLARED
#define Tcl_IsChannelExisting_TCL_DECLARED
/* 418 */
EXTERN int		Tcl_IsChannelExisting(const char *channelName);
/* Slot 419 is reserved */
/* Slot 420 is reserved */
/* Slot 421 is reserved */
/* Slot 422 is reserved */
EXTERN int		Tcl_IsChannelExisting(CONST char *channelName);
#endif
#ifndef Tcl_UniCharNcasecmp_TCL_DECLARED
#define Tcl_UniCharNcasecmp_TCL_DECLARED
/* 419 */
EXTERN int		Tcl_UniCharNcasecmp(CONST Tcl_UniChar *ucs,
				CONST Tcl_UniChar *uct,
				unsigned long numChars);
#endif
#ifndef Tcl_UniCharCaseMatch_TCL_DECLARED
#define Tcl_UniCharCaseMatch_TCL_DECLARED
/* 420 */
EXTERN int		Tcl_UniCharCaseMatch(CONST Tcl_UniChar *uniStr,
				CONST Tcl_UniChar *uniPattern, int nocase);
#endif
#ifndef Tcl_FindHashEntry_TCL_DECLARED
#define Tcl_FindHashEntry_TCL_DECLARED
/* 421 */
EXTERN Tcl_HashEntry *	Tcl_FindHashEntry(Tcl_HashTable *tablePtr,
				CONST char *key);
#endif
#ifndef Tcl_CreateHashEntry_TCL_DECLARED
#define Tcl_CreateHashEntry_TCL_DECLARED
/* 422 */
EXTERN Tcl_HashEntry *	Tcl_CreateHashEntry(Tcl_HashTable *tablePtr,
				CONST char *key, int *newPtr);
#endif
#ifndef Tcl_InitCustomHashTable_TCL_DECLARED
#define Tcl_InitCustomHashTable_TCL_DECLARED
/* 423 */
EXTERN void		Tcl_InitCustomHashTable(Tcl_HashTable *tablePtr,
				int keyType, const Tcl_HashKeyType *typePtr);
				int keyType, Tcl_HashKeyType *typePtr);
#endif
#ifndef Tcl_InitObjHashTable_TCL_DECLARED
#define Tcl_InitObjHashTable_TCL_DECLARED
/* 424 */
EXTERN void		Tcl_InitObjHashTable(Tcl_HashTable *tablePtr);
#endif
#ifndef Tcl_CommandTraceInfo_TCL_DECLARED
#define Tcl_CommandTraceInfo_TCL_DECLARED
/* 425 */
EXTERN void *		Tcl_CommandTraceInfo(Tcl_Interp *interp,
				const char *varName, int flags,
EXTERN ClientData	Tcl_CommandTraceInfo(Tcl_Interp *interp,
				CONST char *varName, int flags,
				Tcl_CommandTraceProc *procPtr,
				void *prevClientData);
				ClientData prevClientData);
#endif
#ifndef Tcl_TraceCommand_TCL_DECLARED
#define Tcl_TraceCommand_TCL_DECLARED
/* 426 */
EXTERN int		Tcl_TraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc, void *clientData);
				CONST char *varName, int flags,
				Tcl_CommandTraceProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_UntraceCommand_TCL_DECLARED
#define Tcl_UntraceCommand_TCL_DECLARED
/* 427 */
EXTERN void		Tcl_UntraceCommand(Tcl_Interp *interp,
				const char *varName, int flags,
				Tcl_CommandTraceProc *proc, void *clientData);
				CONST char *varName, int flags,
				Tcl_CommandTraceProc *proc,
				ClientData clientData);
#endif
#ifndef Tcl_AttemptAlloc_TCL_DECLARED
#define Tcl_AttemptAlloc_TCL_DECLARED
/* 428 */
EXTERN void *		Tcl_AttemptAlloc(size_t size);
EXTERN char *		Tcl_AttemptAlloc(unsigned int size);
#endif
#ifndef Tcl_AttemptDbCkalloc_TCL_DECLARED
#define Tcl_AttemptDbCkalloc_TCL_DECLARED
/* 429 */
EXTERN void *		Tcl_AttemptDbCkalloc(size_t size, const char *file,
				int line);
EXTERN char *		Tcl_AttemptDbCkalloc(unsigned int size,
				CONST char *file, int line);
#endif
#ifndef Tcl_AttemptRealloc_TCL_DECLARED
#define Tcl_AttemptRealloc_TCL_DECLARED
/* 430 */
EXTERN void *		Tcl_AttemptRealloc(void *ptr, size_t size);
EXTERN char *		Tcl_AttemptRealloc(char *ptr, unsigned int size);
#endif
#ifndef Tcl_AttemptDbCkrealloc_TCL_DECLARED
#define Tcl_AttemptDbCkrealloc_TCL_DECLARED
/* 431 */
EXTERN void *		Tcl_AttemptDbCkrealloc(void *ptr, size_t size,
				const char *file, int line);
EXTERN char *		Tcl_AttemptDbCkrealloc(char *ptr, unsigned int size,
				CONST char *file, int line);
#endif
#ifndef Tcl_AttemptSetObjLength_TCL_DECLARED
#define Tcl_AttemptSetObjLength_TCL_DECLARED
/* 432 */
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
				size_t length);
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
#endif
#ifndef Tcl_GetChannelThread_TCL_DECLARED
#define Tcl_GetChannelThread_TCL_DECLARED
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
#endif
#ifndef Tcl_GetUnicodeFromObj_TCL_DECLARED
#define Tcl_GetUnicodeFromObj_TCL_DECLARED
/* 434 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
#endif
#ifndef Tcl_GetMathFuncInfo_TCL_DECLARED
#define Tcl_GetMathFuncInfo_TCL_DECLARED
/* Slot 435 is reserved */
/* Slot 436 is reserved */
/* 435 */
EXTERN int		Tcl_GetMathFuncInfo(Tcl_Interp *interp,
				CONST char *name, int *numArgsPtr,
				Tcl_ValueType **argTypesPtr,
				Tcl_MathProc **procPtr,
				ClientData *clientDataPtr);
#endif
#ifndef Tcl_ListMathFuncs_TCL_DECLARED
#define Tcl_ListMathFuncs_TCL_DECLARED
/* 436 */
EXTERN Tcl_Obj *	Tcl_ListMathFuncs(Tcl_Interp *interp,
				CONST char *pattern);
#endif
#ifndef Tcl_SubstObj_TCL_DECLARED
#define Tcl_SubstObj_TCL_DECLARED
/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
#endif
#ifndef Tcl_DetachChannel_TCL_DECLARED
#define Tcl_DetachChannel_TCL_DECLARED
/* 438 */
EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
				Tcl_Channel channel);
#endif
#ifndef Tcl_IsStandardChannel_TCL_DECLARED
#define Tcl_IsStandardChannel_TCL_DECLARED
/* 439 */
EXTERN int		Tcl_IsStandardChannel(Tcl_Channel channel);
#endif
#ifndef Tcl_FSCopyFile_TCL_DECLARED
#define Tcl_FSCopyFile_TCL_DECLARED
/* 440 */
EXTERN int		Tcl_FSCopyFile(Tcl_Obj *srcPathPtr,
				Tcl_Obj *destPathPtr);
#endif
#ifndef Tcl_FSCopyDirectory_TCL_DECLARED
#define Tcl_FSCopyDirectory_TCL_DECLARED
/* 441 */
EXTERN int		Tcl_FSCopyDirectory(Tcl_Obj *srcPathPtr,
				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
#endif
#ifndef Tcl_FSCreateDirectory_TCL_DECLARED
#define Tcl_FSCreateDirectory_TCL_DECLARED
/* 442 */
EXTERN int		Tcl_FSCreateDirectory(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSDeleteFile_TCL_DECLARED
#define Tcl_FSDeleteFile_TCL_DECLARED
/* 443 */
EXTERN int		Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSLoadFile_TCL_DECLARED
#define Tcl_FSLoadFile_TCL_DECLARED
/* 444 */
EXTERN int		Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
				const char *sym1, const char *sym2,
				CONST char *sym1, CONST char *sym2,
				Tcl_PackageInitProc **proc1Ptr,
				Tcl_PackageInitProc **proc2Ptr,
				Tcl_LoadHandle *handlePtr,
				Tcl_FSUnloadFileProc **unloadProcPtr);
#endif
#ifndef Tcl_FSMatchInDirectory_TCL_DECLARED
#define Tcl_FSMatchInDirectory_TCL_DECLARED
/* 445 */
EXTERN int		Tcl_FSMatchInDirectory(Tcl_Interp *interp,
				Tcl_Obj *result, Tcl_Obj *pathPtr,
				const char *pattern, Tcl_GlobTypeData *types);
				CONST char *pattern, Tcl_GlobTypeData *types);
#endif
#ifndef Tcl_FSLink_TCL_DECLARED
#define Tcl_FSLink_TCL_DECLARED
/* 446 */
EXTERN Tcl_Obj *	Tcl_FSLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
				int linkAction);
#endif
#ifndef Tcl_FSRemoveDirectory_TCL_DECLARED
#define Tcl_FSRemoveDirectory_TCL_DECLARED
/* 447 */
EXTERN int		Tcl_FSRemoveDirectory(Tcl_Obj *pathPtr,
				int recursive, Tcl_Obj **errorPtr);
#endif
#ifndef Tcl_FSRenameFile_TCL_DECLARED
#define Tcl_FSRenameFile_TCL_DECLARED
/* 448 */
EXTERN int		Tcl_FSRenameFile(Tcl_Obj *srcPathPtr,
				Tcl_Obj *destPathPtr);
#endif
#ifndef Tcl_FSLstat_TCL_DECLARED
#define Tcl_FSLstat_TCL_DECLARED
/* 449 */
EXTERN int		Tcl_FSLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
#endif
#ifndef Tcl_FSUtime_TCL_DECLARED
#define Tcl_FSUtime_TCL_DECLARED
/* 450 */
EXTERN int		Tcl_FSUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#endif
#ifndef Tcl_FSFileAttrsGet_TCL_DECLARED
#define Tcl_FSFileAttrsGet_TCL_DECLARED
/* 451 */
EXTERN int		Tcl_FSFileAttrsGet(Tcl_Interp *interp, int index,
				Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
#endif
#ifndef Tcl_FSFileAttrsSet_TCL_DECLARED
#define Tcl_FSFileAttrsSet_TCL_DECLARED
/* 452 */
EXTERN int		Tcl_FSFileAttrsSet(Tcl_Interp *interp, int index,
				Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_FSFileAttrStrings_TCL_DECLARED
#define Tcl_FSFileAttrStrings_TCL_DECLARED
/* 453 */
EXTERN const char *const * Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
EXTERN CONST char **	Tcl_FSFileAttrStrings(Tcl_Obj *pathPtr,
				Tcl_Obj **objPtrRef);
#endif
#ifndef Tcl_FSStat_TCL_DECLARED
#define Tcl_FSStat_TCL_DECLARED
/* 454 */
EXTERN int		Tcl_FSStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
#endif
#ifndef Tcl_FSAccess_TCL_DECLARED
#define Tcl_FSAccess_TCL_DECLARED
/* 455 */
EXTERN int		Tcl_FSAccess(Tcl_Obj *pathPtr, int mode);
#endif
#ifndef Tcl_FSOpenFileChannel_TCL_DECLARED
#define Tcl_FSOpenFileChannel_TCL_DECLARED
/* 456 */
EXTERN Tcl_Channel	Tcl_FSOpenFileChannel(Tcl_Interp *interp,
				Tcl_Obj *pathPtr, const char *modeString,
				Tcl_Obj *pathPtr, CONST char *modeString,
				int permissions);
#endif
#ifndef Tcl_FSGetCwd_TCL_DECLARED
#define Tcl_FSGetCwd_TCL_DECLARED
/* 457 */
EXTERN Tcl_Obj *	Tcl_FSGetCwd(Tcl_Interp *interp);
#endif
#ifndef Tcl_FSChdir_TCL_DECLARED
#define Tcl_FSChdir_TCL_DECLARED
/* 458 */
EXTERN int		Tcl_FSChdir(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSConvertToPathType_TCL_DECLARED
#define Tcl_FSConvertToPathType_TCL_DECLARED
/* 459 */
EXTERN int		Tcl_FSConvertToPathType(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSJoinPath_TCL_DECLARED
#define Tcl_FSJoinPath_TCL_DECLARED
/* 460 */
EXTERN Tcl_Obj *	Tcl_FSJoinPath(Tcl_Obj *listObj, int elements);
#endif
#ifndef Tcl_FSSplitPath_TCL_DECLARED
#define Tcl_FSSplitPath_TCL_DECLARED
/* 461 */
EXTERN Tcl_Obj *	Tcl_FSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
#endif
#ifndef Tcl_FSEqualPaths_TCL_DECLARED
#define Tcl_FSEqualPaths_TCL_DECLARED
/* 462 */
EXTERN int		Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
				Tcl_Obj *secondPtr);
#endif
#ifndef Tcl_FSGetNormalizedPath_TCL_DECLARED
#define Tcl_FSGetNormalizedPath_TCL_DECLARED
/* 463 */
EXTERN Tcl_Obj *	Tcl_FSGetNormalizedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSJoinToPath_TCL_DECLARED
#define Tcl_FSJoinToPath_TCL_DECLARED
/* 464 */
EXTERN Tcl_Obj *	Tcl_FSJoinToPath(Tcl_Obj *pathPtr, int objc,
				Tcl_Obj *const objv[]);
				Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_FSGetInternalRep_TCL_DECLARED
#define Tcl_FSGetInternalRep_TCL_DECLARED
/* 465 */
EXTERN void *		Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
				const Tcl_Filesystem *fsPtr);
EXTERN ClientData	Tcl_FSGetInternalRep(Tcl_Obj *pathPtr,
				Tcl_Filesystem *fsPtr);
#endif
#ifndef Tcl_FSGetTranslatedPath_TCL_DECLARED
#define Tcl_FSGetTranslatedPath_TCL_DECLARED
/* 466 */
EXTERN Tcl_Obj *	Tcl_FSGetTranslatedPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSEvalFile_TCL_DECLARED
#define Tcl_FSEvalFile_TCL_DECLARED
/* 467 */
EXTERN int		Tcl_FSEvalFile(Tcl_Interp *interp, Tcl_Obj *fileName);
#endif
#ifndef Tcl_FSNewNativePath_TCL_DECLARED
#define Tcl_FSNewNativePath_TCL_DECLARED
/* 468 */
EXTERN Tcl_Obj *	Tcl_FSNewNativePath(
EXTERN Tcl_Obj *	Tcl_FSNewNativePath(Tcl_Filesystem *fromFilesystem,
				const Tcl_Filesystem *fromFilesystem,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_FSGetNativePath_TCL_DECLARED
#define Tcl_FSGetNativePath_TCL_DECLARED
/* 469 */
EXTERN const void *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
EXTERN CONST char *	Tcl_FSGetNativePath(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSFileSystemInfo_TCL_DECLARED
#define Tcl_FSFileSystemInfo_TCL_DECLARED
/* 470 */
EXTERN Tcl_Obj *	Tcl_FSFileSystemInfo(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSPathSeparator_TCL_DECLARED
#define Tcl_FSPathSeparator_TCL_DECLARED
/* 471 */
EXTERN Tcl_Obj *	Tcl_FSPathSeparator(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSListVolumes_TCL_DECLARED
#define Tcl_FSListVolumes_TCL_DECLARED
/* 472 */
EXTERN Tcl_Obj *	Tcl_FSListVolumes(void);
#endif
#ifndef Tcl_FSRegister_TCL_DECLARED
#define Tcl_FSRegister_TCL_DECLARED
/* 473 */
EXTERN int		Tcl_FSRegister(void *clientData,
				const Tcl_Filesystem *fsPtr);
EXTERN int		Tcl_FSRegister(ClientData clientData,
				Tcl_Filesystem *fsPtr);
#endif
#ifndef Tcl_FSUnregister_TCL_DECLARED
#define Tcl_FSUnregister_TCL_DECLARED
/* 474 */
EXTERN int		Tcl_FSUnregister(const Tcl_Filesystem *fsPtr);
EXTERN int		Tcl_FSUnregister(Tcl_Filesystem *fsPtr);
#endif
#ifndef Tcl_FSData_TCL_DECLARED
#define Tcl_FSData_TCL_DECLARED
/* 475 */
EXTERN void *		Tcl_FSData(const Tcl_Filesystem *fsPtr);
EXTERN ClientData	Tcl_FSData(Tcl_Filesystem *fsPtr);
#endif
#ifndef Tcl_FSGetTranslatedStringPath_TCL_DECLARED
#define Tcl_FSGetTranslatedStringPath_TCL_DECLARED
/* 476 */
EXTERN const char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
EXTERN CONST char *	Tcl_FSGetTranslatedStringPath(Tcl_Interp *interp,
				Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSGetFileSystemForPath_TCL_DECLARED
#define Tcl_FSGetFileSystemForPath_TCL_DECLARED
/* 477 */
EXTERN const Tcl_Filesystem * Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
EXTERN Tcl_Filesystem *	 Tcl_FSGetFileSystemForPath(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_FSGetPathType_TCL_DECLARED
#define Tcl_FSGetPathType_TCL_DECLARED
/* 478 */
EXTERN Tcl_PathType	Tcl_FSGetPathType(Tcl_Obj *pathPtr);
#endif
#ifndef Tcl_OutputBuffered_TCL_DECLARED
#define Tcl_OutputBuffered_TCL_DECLARED
/* 479 */
EXTERN int		Tcl_OutputBuffered(Tcl_Channel chan);
#endif
#ifndef Tcl_FSMountsChanged_TCL_DECLARED
#define Tcl_FSMountsChanged_TCL_DECLARED
/* 480 */
EXTERN void		Tcl_FSMountsChanged(const Tcl_Filesystem *fsPtr);
EXTERN void		Tcl_FSMountsChanged(Tcl_Filesystem *fsPtr);
#endif
#ifndef Tcl_EvalTokensStandard_TCL_DECLARED
#define Tcl_EvalTokensStandard_TCL_DECLARED
/* 481 */
EXTERN int		Tcl_EvalTokensStandard(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, size_t count);
				Tcl_Token *tokenPtr, int count);
#endif
#ifndef Tcl_GetTime_TCL_DECLARED
#define Tcl_GetTime_TCL_DECLARED
/* 482 */
EXTERN void		Tcl_GetTime(Tcl_Time *timeBuf);
#endif
#ifndef Tcl_CreateObjTrace_TCL_DECLARED
#define Tcl_CreateObjTrace_TCL_DECLARED
/* 483 */
EXTERN Tcl_Trace	Tcl_CreateObjTrace(Tcl_Interp *interp, int level,
				int flags, Tcl_CmdObjTraceProc *objProc,
				void *clientData,
				ClientData clientData,
				Tcl_CmdObjTraceDeleteProc *delProc);
#endif
#ifndef Tcl_GetCommandInfoFromToken_TCL_DECLARED
#define Tcl_GetCommandInfoFromToken_TCL_DECLARED
/* 484 */
EXTERN int		Tcl_GetCommandInfoFromToken(Tcl_Command token,
				Tcl_CmdInfo *infoPtr);
#endif
#ifndef Tcl_SetCommandInfoFromToken_TCL_DECLARED
#define Tcl_SetCommandInfoFromToken_TCL_DECLARED
/* 485 */
EXTERN int		Tcl_SetCommandInfoFromToken(Tcl_Command token,
				const Tcl_CmdInfo *infoPtr);
				CONST Tcl_CmdInfo *infoPtr);
#endif
#ifndef Tcl_DbNewWideIntObj_TCL_DECLARED
#define Tcl_DbNewWideIntObj_TCL_DECLARED
/* 486 */
EXTERN Tcl_Obj *	Tcl_DbNewWideIntObj(Tcl_WideInt wideValue,
				const char *file, int line);
				CONST char *file, int line);
#endif
#ifndef Tcl_GetWideIntFromObj_TCL_DECLARED
#define Tcl_GetWideIntFromObj_TCL_DECLARED
/* 487 */
EXTERN int		Tcl_GetWideIntFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
#endif
#ifndef Tcl_NewWideIntObj_TCL_DECLARED
#define Tcl_NewWideIntObj_TCL_DECLARED
/* 488 */
EXTERN Tcl_Obj *	Tcl_NewWideIntObj(Tcl_WideInt wideValue);
#endif
#ifndef Tcl_SetWideIntObj_TCL_DECLARED
#define Tcl_SetWideIntObj_TCL_DECLARED
/* 489 */
EXTERN void		Tcl_SetWideIntObj(Tcl_Obj *objPtr,
				Tcl_WideInt wideValue);
#endif
#ifndef Tcl_AllocStatBuf_TCL_DECLARED
#define Tcl_AllocStatBuf_TCL_DECLARED
/* 490 */
EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf(void);
#endif
#ifndef Tcl_Seek_TCL_DECLARED
#define Tcl_Seek_TCL_DECLARED
/* 491 */
EXTERN Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
				int mode);
#endif
#ifndef Tcl_Tell_TCL_DECLARED
#define Tcl_Tell_TCL_DECLARED
/* 492 */
EXTERN Tcl_WideInt	Tcl_Tell(Tcl_Channel chan);
#endif
#ifndef Tcl_ChannelWideSeekProc_TCL_DECLARED
#define Tcl_ChannelWideSeekProc_TCL_DECLARED
/* 493 */
EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_DictObjPut_TCL_DECLARED
#define Tcl_DictObjPut_TCL_DECLARED
/* 494 */
EXTERN int		Tcl_DictObjPut(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				Tcl_Obj *keyPtr, Tcl_Obj *valuePtr);
#endif
#ifndef Tcl_DictObjGet_TCL_DECLARED
#define Tcl_DictObjGet_TCL_DECLARED
/* 495 */
EXTERN int		Tcl_DictObjGet(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr);
#endif
#ifndef Tcl_DictObjRemove_TCL_DECLARED
#define Tcl_DictObjRemove_TCL_DECLARED
/* 496 */
EXTERN int		Tcl_DictObjRemove(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
#endif
#ifndef Tcl_DictObjSize_TCL_DECLARED
#define Tcl_DictObjSize_TCL_DECLARED
/* 497 */
EXTERN int		Tcl_DictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
				int *sizePtr);
#endif
#ifndef Tcl_DictObjFirst_TCL_DECLARED
#define Tcl_DictObjFirst_TCL_DECLARED
/* 498 */
EXTERN int		Tcl_DictObjFirst(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
				int *donePtr);
#endif
#ifndef Tcl_DictObjNext_TCL_DECLARED
#define Tcl_DictObjNext_TCL_DECLARED
/* 499 */
EXTERN void		Tcl_DictObjNext(Tcl_DictSearch *searchPtr,
				Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr,
				int *donePtr);
#endif
#ifndef Tcl_DictObjDone_TCL_DECLARED
#define Tcl_DictObjDone_TCL_DECLARED
/* 500 */
EXTERN void		Tcl_DictObjDone(Tcl_DictSearch *searchPtr);
#endif
#ifndef Tcl_DictObjPutKeyList_TCL_DECLARED
#define Tcl_DictObjPutKeyList_TCL_DECLARED
/* 501 */
EXTERN int		Tcl_DictObjPutKeyList(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, int keyc,
				Tcl_Obj *const *keyv, Tcl_Obj *valuePtr);
				Tcl_Obj *CONST *keyv, Tcl_Obj *valuePtr);
#endif
#ifndef Tcl_DictObjRemoveKeyList_TCL_DECLARED
#define Tcl_DictObjRemoveKeyList_TCL_DECLARED
/* 502 */
EXTERN int		Tcl_DictObjRemoveKeyList(Tcl_Interp *interp,
				Tcl_Obj *dictPtr, int keyc,
				Tcl_Obj *const *keyv);
				Tcl_Obj *CONST *keyv);
#endif
#ifndef Tcl_NewDictObj_TCL_DECLARED
#define Tcl_NewDictObj_TCL_DECLARED
/* 503 */
EXTERN Tcl_Obj *	Tcl_NewDictObj(void);
#endif
#ifndef Tcl_DbNewDictObj_TCL_DECLARED
#define Tcl_DbNewDictObj_TCL_DECLARED
/* 504 */
EXTERN Tcl_Obj *	Tcl_DbNewDictObj(const char *file, int line);
EXTERN Tcl_Obj *	Tcl_DbNewDictObj(CONST char *file, int line);
#endif
#ifndef Tcl_RegisterConfig_TCL_DECLARED
#define Tcl_RegisterConfig_TCL_DECLARED
/* 505 */
EXTERN void		Tcl_RegisterConfig(Tcl_Interp *interp,
				const char *pkgName,
				const Tcl_Config *configuration,
				const char *valEncoding);
				CONST char *pkgName,
				Tcl_Config *configuration,
				CONST char *valEncoding);
#endif
#ifndef Tcl_CreateNamespace_TCL_DECLARED
#define Tcl_CreateNamespace_TCL_DECLARED
/* 506 */
EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
				const char *name, void *clientData,
				CONST char *name, ClientData clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
#endif
#ifndef Tcl_DeleteNamespace_TCL_DECLARED
#define Tcl_DeleteNamespace_TCL_DECLARED
/* 507 */
EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
#endif
#ifndef Tcl_AppendExportList_TCL_DECLARED
#define Tcl_AppendExportList_TCL_DECLARED
/* 508 */
EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_Export_TCL_DECLARED
#define Tcl_Export_TCL_DECLARED
/* 509 */
EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				const char *pattern, int resetListFirst);
				CONST char *pattern, int resetListFirst);
#endif
#ifndef Tcl_Import_TCL_DECLARED
#define Tcl_Import_TCL_DECLARED
/* 510 */
EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				const char *pattern, int allowOverwrite);
				CONST char *pattern, int allowOverwrite);
#endif
#ifndef Tcl_ForgetImport_TCL_DECLARED
#define Tcl_ForgetImport_TCL_DECLARED
/* 511 */
EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, const char *pattern);
				Tcl_Namespace *nsPtr, CONST char *pattern);
#endif
#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
#define Tcl_GetCurrentNamespace_TCL_DECLARED
/* 512 */
EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
#define Tcl_GetGlobalNamespace_TCL_DECLARED
/* 513 */
EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
#endif
#ifndef Tcl_FindNamespace_TCL_DECLARED
#define Tcl_FindNamespace_TCL_DECLARED
/* 514 */
EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
				const char *name,
				CONST char *name,
				Tcl_Namespace *contextNsPtr, int flags);
#endif
#ifndef Tcl_FindCommand_TCL_DECLARED
#define Tcl_FindCommand_TCL_DECLARED
/* 515 */
EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, const char *name,
EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
				Tcl_Namespace *contextNsPtr, int flags);
#endif
#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
#define Tcl_GetCommandFromObj_TCL_DECLARED
/* 516 */
EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetCommandFullName_TCL_DECLARED
#define Tcl_GetCommandFullName_TCL_DECLARED
/* 517 */
EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
				Tcl_Command command, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_FSEvalFileEx_TCL_DECLARED
#define Tcl_FSEvalFileEx_TCL_DECLARED
/* 518 */
EXTERN int		Tcl_FSEvalFileEx(Tcl_Interp *interp,
				Tcl_Obj *fileName, const char *encodingName);
/* Slot 519 is reserved */
				Tcl_Obj *fileName, CONST char *encodingName);
#endif
#ifndef Tcl_SetExitProc_TCL_DECLARED
#define Tcl_SetExitProc_TCL_DECLARED
/* 519 */
EXTERN Tcl_ExitProc *	Tcl_SetExitProc(Tcl_ExitProc *proc);
#endif
#ifndef Tcl_LimitAddHandler_TCL_DECLARED
#define Tcl_LimitAddHandler_TCL_DECLARED
/* 520 */
EXTERN void		Tcl_LimitAddHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				void *clientData,
				ClientData clientData,
				Tcl_LimitHandlerDeleteProc *deleteProc);
#endif
#ifndef Tcl_LimitRemoveHandler_TCL_DECLARED
#define Tcl_LimitRemoveHandler_TCL_DECLARED
/* 521 */
EXTERN void		Tcl_LimitRemoveHandler(Tcl_Interp *interp, int type,
				Tcl_LimitHandlerProc *handlerProc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_LimitReady_TCL_DECLARED
#define Tcl_LimitReady_TCL_DECLARED
/* 522 */
EXTERN int		Tcl_LimitReady(Tcl_Interp *interp);
#endif
#ifndef Tcl_LimitCheck_TCL_DECLARED
#define Tcl_LimitCheck_TCL_DECLARED
/* 523 */
EXTERN int		Tcl_LimitCheck(Tcl_Interp *interp);
#endif
#ifndef Tcl_LimitExceeded_TCL_DECLARED
#define Tcl_LimitExceeded_TCL_DECLARED
/* 524 */
EXTERN int		Tcl_LimitExceeded(Tcl_Interp *interp);
#endif
#ifndef Tcl_LimitSetCommands_TCL_DECLARED
#define Tcl_LimitSetCommands_TCL_DECLARED
/* 525 */
EXTERN void		Tcl_LimitSetCommands(Tcl_Interp *interp,
				int commandLimit);
#endif
#ifndef Tcl_LimitSetTime_TCL_DECLARED
#define Tcl_LimitSetTime_TCL_DECLARED
/* 526 */
EXTERN void		Tcl_LimitSetTime(Tcl_Interp *interp,
				Tcl_Time *timeLimitPtr);
#endif
#ifndef Tcl_LimitSetGranularity_TCL_DECLARED
#define Tcl_LimitSetGranularity_TCL_DECLARED
/* 527 */
EXTERN void		Tcl_LimitSetGranularity(Tcl_Interp *interp, int type,
				int granularity);
#endif
#ifndef Tcl_LimitTypeEnabled_TCL_DECLARED
#define Tcl_LimitTypeEnabled_TCL_DECLARED
/* 528 */
EXTERN int		Tcl_LimitTypeEnabled(Tcl_Interp *interp, int type);
#endif
#ifndef Tcl_LimitTypeExceeded_TCL_DECLARED
#define Tcl_LimitTypeExceeded_TCL_DECLARED
/* 529 */
EXTERN int		Tcl_LimitTypeExceeded(Tcl_Interp *interp, int type);
#endif
#ifndef Tcl_LimitTypeSet_TCL_DECLARED
#define Tcl_LimitTypeSet_TCL_DECLARED
/* 530 */
EXTERN void		Tcl_LimitTypeSet(Tcl_Interp *interp, int type);
#endif
#ifndef Tcl_LimitTypeReset_TCL_DECLARED
#define Tcl_LimitTypeReset_TCL_DECLARED
/* 531 */
EXTERN void		Tcl_LimitTypeReset(Tcl_Interp *interp, int type);
#endif
#ifndef Tcl_LimitGetCommands_TCL_DECLARED
#define Tcl_LimitGetCommands_TCL_DECLARED
/* 532 */
EXTERN int		Tcl_LimitGetCommands(Tcl_Interp *interp);
#endif
#ifndef Tcl_LimitGetTime_TCL_DECLARED
#define Tcl_LimitGetTime_TCL_DECLARED
/* 533 */
EXTERN void		Tcl_LimitGetTime(Tcl_Interp *interp,
				Tcl_Time *timeLimitPtr);
#endif
#ifndef Tcl_LimitGetGranularity_TCL_DECLARED
#define Tcl_LimitGetGranularity_TCL_DECLARED
/* 534 */
EXTERN int		Tcl_LimitGetGranularity(Tcl_Interp *interp, int type);
#endif
#ifndef Tcl_SaveInterpState_TCL_DECLARED
#define Tcl_SaveInterpState_TCL_DECLARED
/* 535 */
EXTERN Tcl_InterpState	Tcl_SaveInterpState(Tcl_Interp *interp, int status);
#endif
#ifndef Tcl_RestoreInterpState_TCL_DECLARED
#define Tcl_RestoreInterpState_TCL_DECLARED
/* 536 */
EXTERN int		Tcl_RestoreInterpState(Tcl_Interp *interp,
				Tcl_InterpState state);
#endif
#ifndef Tcl_DiscardInterpState_TCL_DECLARED
#define Tcl_DiscardInterpState_TCL_DECLARED
/* 537 */
EXTERN void		Tcl_DiscardInterpState(Tcl_InterpState state);
#endif
#ifndef Tcl_SetReturnOptions_TCL_DECLARED
#define Tcl_SetReturnOptions_TCL_DECLARED
/* 538 */
EXTERN int		Tcl_SetReturnOptions(Tcl_Interp *interp,
				Tcl_Obj *options);
#endif
#ifndef Tcl_GetReturnOptions_TCL_DECLARED
#define Tcl_GetReturnOptions_TCL_DECLARED
/* 539 */
EXTERN Tcl_Obj *	Tcl_GetReturnOptions(Tcl_Interp *interp, int result);
#endif
#ifndef Tcl_IsEnsemble_TCL_DECLARED
#define Tcl_IsEnsemble_TCL_DECLARED
/* 540 */
EXTERN int		Tcl_IsEnsemble(Tcl_Command token);
#endif
#ifndef Tcl_CreateEnsemble_TCL_DECLARED
#define Tcl_CreateEnsemble_TCL_DECLARED
/* 541 */
EXTERN Tcl_Command	Tcl_CreateEnsemble(Tcl_Interp *interp,
				const char *name,
				CONST char *name,
				Tcl_Namespace *namespacePtr, int flags);
#endif
#ifndef Tcl_FindEnsemble_TCL_DECLARED
#define Tcl_FindEnsemble_TCL_DECLARED
/* 542 */
EXTERN Tcl_Command	Tcl_FindEnsemble(Tcl_Interp *interp,
				Tcl_Obj *cmdNameObj, int flags);
#endif
#ifndef Tcl_SetEnsembleSubcommandList_TCL_DECLARED
#define Tcl_SetEnsembleSubcommandList_TCL_DECLARED
/* 543 */
EXTERN int		Tcl_SetEnsembleSubcommandList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *subcmdList);
#endif
#ifndef Tcl_SetEnsembleMappingDict_TCL_DECLARED
#define Tcl_SetEnsembleMappingDict_TCL_DECLARED
/* 544 */
EXTERN int		Tcl_SetEnsembleMappingDict(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *mapDict);
#endif
#ifndef Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
#define Tcl_SetEnsembleUnknownHandler_TCL_DECLARED
/* 545 */
EXTERN int		Tcl_SetEnsembleUnknownHandler(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *unknownList);
#endif
#ifndef Tcl_SetEnsembleFlags_TCL_DECLARED
#define Tcl_SetEnsembleFlags_TCL_DECLARED
/* 546 */
EXTERN int		Tcl_SetEnsembleFlags(Tcl_Interp *interp,
				Tcl_Command token, int flags);
#endif
#ifndef Tcl_GetEnsembleSubcommandList_TCL_DECLARED
#define Tcl_GetEnsembleSubcommandList_TCL_DECLARED
/* 547 */
EXTERN int		Tcl_GetEnsembleSubcommandList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj **subcmdListPtr);
#endif
#ifndef Tcl_GetEnsembleMappingDict_TCL_DECLARED
#define Tcl_GetEnsembleMappingDict_TCL_DECLARED
/* 548 */
EXTERN int		Tcl_GetEnsembleMappingDict(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj **mapDictPtr);
#endif
#ifndef Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
#define Tcl_GetEnsembleUnknownHandler_TCL_DECLARED
/* 549 */
EXTERN int		Tcl_GetEnsembleUnknownHandler(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj **unknownListPtr);
#endif
#ifndef Tcl_GetEnsembleFlags_TCL_DECLARED
#define Tcl_GetEnsembleFlags_TCL_DECLARED
/* 550 */
EXTERN int		Tcl_GetEnsembleFlags(Tcl_Interp *interp,
				Tcl_Command token, int *flagsPtr);
#endif
#ifndef Tcl_GetEnsembleNamespace_TCL_DECLARED
#define Tcl_GetEnsembleNamespace_TCL_DECLARED
/* 551 */
EXTERN int		Tcl_GetEnsembleNamespace(Tcl_Interp *interp,
				Tcl_Command token,
				Tcl_Namespace **namespacePtrPtr);
#endif
#ifndef Tcl_SetTimeProc_TCL_DECLARED
#define Tcl_SetTimeProc_TCL_DECLARED
/* 552 */
EXTERN void		Tcl_SetTimeProc(Tcl_GetTimeProc *getProc,
				Tcl_ScaleTimeProc *scaleProc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef Tcl_QueryTimeProc_TCL_DECLARED
#define Tcl_QueryTimeProc_TCL_DECLARED
/* 553 */
EXTERN void		Tcl_QueryTimeProc(Tcl_GetTimeProc **getProc,
				Tcl_ScaleTimeProc **scaleProc,
				void **clientData);
				ClientData *clientData);
#endif
#ifndef Tcl_ChannelThreadActionProc_TCL_DECLARED
#define Tcl_ChannelThreadActionProc_TCL_DECLARED
/* 554 */
EXTERN Tcl_DriverThreadActionProc * Tcl_ChannelThreadActionProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_NewBignumObj_TCL_DECLARED
#define Tcl_NewBignumObj_TCL_DECLARED
/* 555 */
EXTERN Tcl_Obj *	Tcl_NewBignumObj(void *value);
EXTERN Tcl_Obj *	Tcl_NewBignumObj(mp_int *value);
#endif
#ifndef Tcl_DbNewBignumObj_TCL_DECLARED
#define Tcl_DbNewBignumObj_TCL_DECLARED
/* 556 */
EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(void *value, const char *file,
EXTERN Tcl_Obj *	Tcl_DbNewBignumObj(mp_int *value, CONST char *file,
				int line);
#endif
#ifndef Tcl_SetBignumObj_TCL_DECLARED
#define Tcl_SetBignumObj_TCL_DECLARED
/* 557 */
EXTERN void		Tcl_SetBignumObj(Tcl_Obj *obj, void *value);
EXTERN void		Tcl_SetBignumObj(Tcl_Obj *obj, mp_int *value);
#endif
#ifndef Tcl_GetBignumFromObj_TCL_DECLARED
#define Tcl_GetBignumFromObj_TCL_DECLARED
/* 558 */
EXTERN int		Tcl_GetBignumFromObj(Tcl_Interp *interp,
				Tcl_Obj *obj, void *value);
				Tcl_Obj *obj, mp_int *value);
#endif
#ifndef Tcl_TakeBignumFromObj_TCL_DECLARED
#define Tcl_TakeBignumFromObj_TCL_DECLARED
/* 559 */
EXTERN int		Tcl_TakeBignumFromObj(Tcl_Interp *interp,
				Tcl_Obj *obj, void *value);
				Tcl_Obj *obj, mp_int *value);
#endif
#ifndef Tcl_TruncateChannel_TCL_DECLARED
#define Tcl_TruncateChannel_TCL_DECLARED
/* 560 */
EXTERN int		Tcl_TruncateChannel(Tcl_Channel chan,
				Tcl_WideInt length);
#endif
#ifndef Tcl_ChannelTruncateProc_TCL_DECLARED
#define Tcl_ChannelTruncateProc_TCL_DECLARED
/* 561 */
EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
				const Tcl_ChannelType *chanTypePtr);
				CONST Tcl_ChannelType *chanTypePtr);
#endif
#ifndef Tcl_SetChannelErrorInterp_TCL_DECLARED
#define Tcl_SetChannelErrorInterp_TCL_DECLARED
/* 562 */
EXTERN void		Tcl_SetChannelErrorInterp(Tcl_Interp *interp,
				Tcl_Obj *msg);
#endif
#ifndef Tcl_GetChannelErrorInterp_TCL_DECLARED
#define Tcl_GetChannelErrorInterp_TCL_DECLARED
/* 563 */
EXTERN void		Tcl_GetChannelErrorInterp(Tcl_Interp *interp,
				Tcl_Obj **msg);
#endif
#ifndef Tcl_SetChannelError_TCL_DECLARED
#define Tcl_SetChannelError_TCL_DECLARED
/* 564 */
EXTERN void		Tcl_SetChannelError(Tcl_Channel chan, Tcl_Obj *msg);
#endif
#ifndef Tcl_GetChannelError_TCL_DECLARED
#define Tcl_GetChannelError_TCL_DECLARED
/* 565 */
EXTERN void		Tcl_GetChannelError(Tcl_Channel chan, Tcl_Obj **msg);
#endif
#ifndef Tcl_InitBignumFromDouble_TCL_DECLARED
#define Tcl_InitBignumFromDouble_TCL_DECLARED
/* 566 */
EXTERN int		Tcl_InitBignumFromDouble(Tcl_Interp *interp,
				double initval, void *toInit);
				double initval, mp_int *toInit);
#endif
#ifndef Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
#define Tcl_GetNamespaceUnknownHandler_TCL_DECLARED
/* 567 */
EXTERN Tcl_Obj *	Tcl_GetNamespaceUnknownHandler(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr);
#endif
#ifndef Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
#define Tcl_SetNamespaceUnknownHandler_TCL_DECLARED
/* 568 */
EXTERN int		Tcl_SetNamespaceUnknownHandler(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr);
#endif
#ifndef Tcl_GetEncodingFromObj_TCL_DECLARED
#define Tcl_GetEncodingFromObj_TCL_DECLARED
/* 569 */
EXTERN int		Tcl_GetEncodingFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr);
#endif
#ifndef Tcl_GetEncodingSearchPath_TCL_DECLARED
#define Tcl_GetEncodingSearchPath_TCL_DECLARED
/* 570 */
EXTERN Tcl_Obj *	Tcl_GetEncodingSearchPath(void);
#endif
#ifndef Tcl_SetEncodingSearchPath_TCL_DECLARED
#define Tcl_SetEncodingSearchPath_TCL_DECLARED
/* 571 */
EXTERN int		Tcl_SetEncodingSearchPath(Tcl_Obj *searchPath);
#endif
#ifndef Tcl_GetEncodingNameFromEnvironment_TCL_DECLARED
#define Tcl_GetEncodingNameFromEnvironment_TCL_DECLARED
/* 572 */
EXTERN const char *	Tcl_GetEncodingNameFromEnvironment(
EXTERN CONST char *	Tcl_GetEncodingNameFromEnvironment(
				Tcl_DString *bufPtr);
#endif
#ifndef Tcl_PkgRequireProc_TCL_DECLARED
#define Tcl_PkgRequireProc_TCL_DECLARED
/* 573 */
EXTERN int		Tcl_PkgRequireProc(Tcl_Interp *interp,
				const char *name, int objc,
				Tcl_Obj *const objv[], void *clientDataPtr);
				CONST char *name, int objc,
				Tcl_Obj *CONST objv[],
				ClientData *clientDataPtr);
#endif
#ifndef Tcl_AppendObjToErrorInfo_TCL_DECLARED
#define Tcl_AppendObjToErrorInfo_TCL_DECLARED
/* 574 */
EXTERN void		Tcl_AppendObjToErrorInfo(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
#endif
#ifndef Tcl_AppendLimitedToObj_TCL_DECLARED
#define Tcl_AppendLimitedToObj_TCL_DECLARED
/* 575 */
EXTERN void		Tcl_AppendLimitedToObj(Tcl_Obj *objPtr,
				const char *bytes, size_t length,
				size_t limit, const char *ellipsis);
				CONST char *bytes, int length, int limit,
				CONST char *ellipsis);
#endif
#ifndef Tcl_Format_TCL_DECLARED
#define Tcl_Format_TCL_DECLARED
/* 576 */
EXTERN Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, const char *format,
				int objc, Tcl_Obj *const objv[]);
EXTERN Tcl_Obj *	Tcl_Format(Tcl_Interp *interp, CONST char *format,
				int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_AppendFormatToObj_TCL_DECLARED
#define Tcl_AppendFormatToObj_TCL_DECLARED
/* 577 */
EXTERN int		Tcl_AppendFormatToObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, const char *format,
				int objc, Tcl_Obj *const objv[]);
				Tcl_Obj *objPtr, CONST char *format,
				int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef Tcl_ObjPrintf_TCL_DECLARED
#define Tcl_ObjPrintf_TCL_DECLARED
/* 578 */
EXTERN Tcl_Obj *	Tcl_ObjPrintf(const char *format, ...) TCL_FORMAT_PRINTF(1, 2);
EXTERN Tcl_Obj *	Tcl_ObjPrintf(CONST char *format, ...);
#endif
#ifndef Tcl_AppendPrintfToObj_TCL_DECLARED
#define Tcl_AppendPrintfToObj_TCL_DECLARED
/* 579 */
EXTERN void		Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
				const char *format, ...) TCL_FORMAT_PRINTF(2, 3);
/* 580 */
				CONST char *format, ...);
#endif
/* Slot 580 is reserved */
EXTERN int		Tcl_CancelEval(Tcl_Interp *interp,
				Tcl_Obj *resultObjPtr, void *clientData,
				int flags);
/* 581 */
EXTERN int		Tcl_Canceled(Tcl_Interp *interp, int flags);
/* 582 */
/* Slot 581 is reserved */
/* Slot 582 is reserved */
/* Slot 583 is reserved */
/* Slot 584 is reserved */
/* Slot 585 is reserved */
EXTERN int		Tcl_CreatePipe(Tcl_Interp *interp,
				Tcl_Channel *rchan, Tcl_Channel *wchan,
				int flags);
/* 583 */
/* Slot 586 is reserved */
/* Slot 587 is reserved */
EXTERN Tcl_Command	Tcl_NRCreateCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				Tcl_ObjCmdProc *nreProc, void *clientData,
				Tcl_CmdDeleteProc *deleteProc);
/* 584 */
/* Slot 588 is reserved */
EXTERN int		Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 585 */
/* Slot 589 is reserved */
/* Slot 590 is reserved */
EXTERN int		Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
/* 586 */
/* Slot 591 is reserved */
EXTERN int		Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd,
				int objc, Tcl_Obj *const objv[], int flags);
/* 587 */
EXTERN void		Tcl_NRAddCallback(Tcl_Interp *interp,
				Tcl_NRPostProc *postProcPtr, void *data0,
				void *data1, void *data2, void *data3);
/* 588 */
EXTERN int		Tcl_NRCallObjProc(Tcl_Interp *interp,
/* Slot 592 is reserved */
/* Slot 593 is reserved */
/* Slot 594 is reserved */
/* Slot 595 is reserved */
/* Slot 596 is reserved */
/* Slot 597 is reserved */
				Tcl_ObjCmdProc *objProc, void *clientData,
				int objc, Tcl_Obj *const objv[]);
/* 589 */
/* Slot 598 is reserved */
EXTERN unsigned		Tcl_GetFSDeviceFromStat(const Tcl_StatBuf *statPtr);
/* 590 */
/* Slot 599 is reserved */
EXTERN unsigned		Tcl_GetFSInodeFromStat(const Tcl_StatBuf *statPtr);
/* 591 */
/* Slot 600 is reserved */
EXTERN unsigned		Tcl_GetModeFromStat(const Tcl_StatBuf *statPtr);
/* 592 */
/* Slot 601 is reserved */
EXTERN int		Tcl_GetLinkCountFromStat(const Tcl_StatBuf *statPtr);
/* 593 */
/* Slot 602 is reserved */
EXTERN int		Tcl_GetUserIdFromStat(const Tcl_StatBuf *statPtr);
/* 594 */
/* Slot 603 is reserved */
EXTERN int		Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr);
/* 595 */
/* Slot 604 is reserved */
EXTERN int		Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr);
/* 596 */
/* Slot 605 is reserved */
EXTERN Tcl_WideInt	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
/* 597 */
EXTERN Tcl_WideInt	Tcl_GetModificationTimeFromStat(
				const Tcl_StatBuf *statPtr);
/* 598 */
EXTERN Tcl_WideInt	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
/* 599 */
EXTERN Tcl_WideUInt	Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
/* 600 */
EXTERN Tcl_WideUInt	Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
/* 601 */
/* Slot 606 is reserved */
/* Slot 607 is reserved */
/* Slot 608 is reserved */
/* Slot 609 is reserved */
/* Slot 610 is reserved */
/* Slot 611 is reserved */
/* Slot 612 is reserved */
/* Slot 613 is reserved */
/* Slot 614 is reserved */
/* Slot 615 is reserved */
EXTERN unsigned		Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr);
/* 602 */
/* Slot 616 is reserved */
EXTERN int		Tcl_SetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj *paramList);
/* 603 */
/* Slot 617 is reserved */
EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
				Tcl_Command token, Tcl_Obj **paramListPtr);
/* 604 */
/* Slot 618 is reserved */
EXTERN int		Tcl_ParseArgsObjv(Tcl_Interp *interp,
				const Tcl_ArgvInfo *argTable, int *objcPtr,
				Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
/* 605 */
/* Slot 619 is reserved */
EXTERN int		Tcl_GetErrorLine(Tcl_Interp *interp);
/* 606 */
/* Slot 620 is reserved */
EXTERN void		Tcl_SetErrorLine(Tcl_Interp *interp, int lineNum);
/* 607 */
EXTERN void		Tcl_TransferResult(Tcl_Interp *sourceInterp,
				int code, Tcl_Interp *targetInterp);
/* 608 */
EXTERN int		Tcl_InterpActive(Tcl_Interp *interp);
/* 609 */
EXTERN void		Tcl_BackgroundException(Tcl_Interp *interp, int code);
/* 610 */
EXTERN int		Tcl_ZlibDeflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, int level,
				Tcl_Obj *gzipHeaderDictObj);
/* 611 */
/* Slot 621 is reserved */
/* Slot 622 is reserved */
/* Slot 623 is reserved */
/* Slot 624 is reserved */
/* Slot 625 is reserved */
/* Slot 626 is reserved */
/* Slot 627 is reserved */
/* Slot 628 is reserved */
/* Slot 629 is reserved */
/* Slot 630 is reserved */
/* Slot 631 is reserved */
/* Slot 632 is reserved */
EXTERN int		Tcl_ZlibInflate(Tcl_Interp *interp, int format,
				Tcl_Obj *data, size_t buffersize,
				Tcl_Obj *gzipHeaderDictObj);
/* 612 */
/* Slot 633 is reserved */
EXTERN unsigned int	Tcl_ZlibCRC32(unsigned int crc,
				const unsigned char *buf, size_t len);
/* 613 */
/* Slot 634 is reserved */
EXTERN unsigned int	Tcl_ZlibAdler32(unsigned int adler,
				const unsigned char *buf, size_t len);
/* 614 */
/* Slot 635 is reserved */
EXTERN int		Tcl_ZlibStreamInit(Tcl_Interp *interp, int mode,
				int format, int level, Tcl_Obj *dictObj,
				Tcl_ZlibStream *zshandle);
/* 615 */
/* Slot 636 is reserved */
EXTERN Tcl_Obj *	Tcl_ZlibStreamGetCommandName(Tcl_ZlibStream zshandle);
/* 616 */
EXTERN int		Tcl_ZlibStreamEof(Tcl_ZlibStream zshandle);
/* 617 */
EXTERN int		Tcl_ZlibStreamChecksum(Tcl_ZlibStream zshandle);
/* 618 */
EXTERN int		Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle,
/* Slot 637 is reserved */
/* Slot 638 is reserved */
/* Slot 639 is reserved */
/* Slot 640 is reserved */
/* Slot 641 is reserved */
/* Slot 642 is reserved */
				Tcl_Obj *data, int flush);
/* 619 */
/* Slot 643 is reserved */
EXTERN int		Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle,
				Tcl_Obj *data, size_t count);
/* 620 */
/* Slot 644 is reserved */
EXTERN int		Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle);
/* 621 */
/* Slot 645 is reserved */
EXTERN int		Tcl_ZlibStreamReset(Tcl_ZlibStream zshandle);
/* 622 */
/* Slot 646 is reserved */
EXTERN void		Tcl_SetStartupScript(Tcl_Obj *path,
				const char *encoding);
/* 623 */
/* Slot 647 is reserved */
EXTERN Tcl_Obj *	Tcl_GetStartupScript(const char **encodingPtr);
/* 624 */
/* Slot 648 is reserved */
EXTERN int		Tcl_CloseEx(Tcl_Interp *interp, Tcl_Channel chan,
				int flags);
/* 625 */
/* Slot 649 is reserved */
/* Slot 650 is reserved */
EXTERN int		Tcl_NRExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				Tcl_Obj *resultPtr);
/* 626 */
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,
/* Slot 651 is reserved */
/* Slot 652 is reserved */
/* Slot 653 is reserved */
/* Slot 654 is reserved */
/* Slot 655 is reserved */
/* Slot 656 is reserved */
/* Slot 657 is reserved */
				void *procPtrs, Tcl_LoadHandle *handlePtr);
/* 628 */
/* Slot 658 is reserved */
EXTERN void *		Tcl_FindSymbol(Tcl_Interp *interp,
				Tcl_LoadHandle handle, const char *symbol);
/* 629 */
/* Slot 659 is reserved */
EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
				Tcl_LoadHandle handlePtr);
/* 630 */
/* Slot 660 is reserved */
EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
				Tcl_ZlibStream zhandle,
				Tcl_Obj *compressionDictionaryObj);
/* 631 */
EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
/* Slot 661 is reserved */
/* Slot 662 is reserved */
/* Slot 663 is reserved */
				const char *service, const char *host,
				unsigned int flags,
/* Slot 664 is reserved */
				Tcl_TcpAcceptProc *acceptProc,
				void *callbackData);
/* 632 */
/* Slot 665 is reserved */
/* Slot 666 is reserved */
EXTERN int		TclZipfs_Mount(Tcl_Interp *interp,
				const char *mountPoint, const char *zipname,
				const char *passwd);
/* 633 */
EXTERN int		TclZipfs_Unmount(Tcl_Interp *interp,
				const char *mountPoint);
/* 634 */
EXTERN Tcl_Obj *	TclZipfs_TclLibrary(void);
/* 635 */
EXTERN int		TclZipfs_MountBuffer(Tcl_Interp *interp,
				const char *mountPoint, unsigned char *data,
				size_t datalen, int copy);
/* 636 */
EXTERN void		Tcl_FreeIntRep(Tcl_Obj *objPtr);
/* 637 */
EXTERN char *		Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
				size_t numBytes);
/* 638 */
EXTERN Tcl_ObjIntRep *	Tcl_FetchIntRep(Tcl_Obj *objPtr,
				const Tcl_ObjType *typePtr);
/* 639 */
EXTERN void		Tcl_StoreIntRep(Tcl_Obj *objPtr,
				const Tcl_ObjType *typePtr,
				const Tcl_ObjIntRep *irPtr);
/* 640 */
/* Slot 667 is reserved */
/* Slot 668 is reserved */
/* Slot 669 is reserved */
/* Slot 670 is reserved */
/* Slot 671 is reserved */
/* Slot 672 is reserved */
/* Slot 673 is reserved */
/* Slot 674 is reserved */
/* Slot 675 is reserved */
/* Slot 676 is reserved */
/* Slot 677 is reserved */
/* Slot 678 is reserved */
/* Slot 679 is reserved */
/* Slot 680 is reserved */
/* Slot 681 is reserved */
/* Slot 682 is reserved */
/* Slot 683 is reserved */
/* Slot 684 is reserved */
/* Slot 685 is reserved */
/* Slot 686 is reserved */
#ifndef TclUnusedStubEntry_TCL_DECLARED
#define TclUnusedStubEntry_TCL_DECLARED
/* 687 */
EXTERN int		Tcl_HasStringRep(Tcl_Obj *objPtr);
/* 641 */
EXTERN void		Tcl_IncrRefCount(Tcl_Obj *objPtr);
EXTERN void		TclUnusedStubEntry(void);
/* 642 */
EXTERN void		Tcl_DecrRefCount(Tcl_Obj *objPtr);
/* 643 */
EXTERN int		Tcl_IsShared(Tcl_Obj *objPtr);
/* 644 */
EXTERN int		Tcl_LinkArray(Tcl_Interp *interp,
				const char *varName, void *addr, int type,
				size_t size);
/* 645 */
EXTERN int		Tcl_GetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, size_t endValue,
				size_t *indexPtr);
#endif
/* 646 */
EXTERN int		Tcl_UtfToUniChar(const char *src, int *chPtr);
/* 647 */
EXTERN char *		Tcl_UniCharToUtfDString(const int *uniStr,
				size_t uniLength, Tcl_DString *dsPtr);
/* 648 */
EXTERN int *		Tcl_UtfToUniCharDString(const char *src,
				size_t length, Tcl_DString *dsPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
typedef struct TclStubHooks {
    struct TclPlatStubs *tclPlatStubs;
    struct TclIntStubs *tclIntStubs;
    struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

typedef struct TclStubs {
    int magic;
    const TclStubHooks *hooks;
    struct TclStubHooks *hooks;

    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
    const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
    TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
    void * (*tcl_Alloc) (size_t size); /* 3 */
    void (*tcl_Free) (void *ptr); /* 4 */
    void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */
    void * (*tcl_DbCkalloc) (size_t size, const char *file, int line); /* 6 */
    void (*tcl_DbCkfree) (void *ptr, const char *file, int line); /* 7 */
    void * (*tcl_DbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 8 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
    int (*tcl_PkgProvideEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, ClientData clientData); /* 0 */
    CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr); /* 1 */
    void (*tcl_Panic) (CONST char *format, ...); /* 2 */
    char * (*tcl_Alloc) (unsigned int size); /* 3 */
    void (*tcl_Free) (char *ptr); /* 4 */
    char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */
    char * (*tcl_DbCkalloc) (unsigned int size, CONST char *file, int line); /* 6 */
    void (*tcl_DbCkfree) (char *ptr, CONST char *file, int line); /* 7 */
    char * (*tcl_DbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 8 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved9)(void);
#if defined(__WIN32__) /* WIN */
    VOID *reserved9;
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, void *clientData); /* 9 */
    void (*tcl_CreateFileHandler) (int fd, int mask, Tcl_FileProc *proc, ClientData clientData); /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved10)(void);
#if defined(__WIN32__) /* WIN */
    VOID *reserved10;
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tcl_DeleteFileHandler) (int fd); /* 10 */
#endif /* MACOSX */
    void (*tcl_SetTimer) (const Tcl_Time *timePtr); /* 11 */
    void (*tcl_SetTimer) (Tcl_Time *timePtr); /* 11 */
    void (*tcl_Sleep) (int ms); /* 12 */
    int (*tcl_WaitForEvent) (const Tcl_Time *timePtr); /* 13 */
    int (*tcl_WaitForEvent) (Tcl_Time *timePtr); /* 13 */
    int (*tcl_AppendAllObjTypes) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 14 */
    void (*tcl_AppendStringsToObj) (Tcl_Obj *objPtr, ...); /* 15 */
    void (*tcl_AppendToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 16 */
    Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *const objv[]); /* 17 */
    int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 18 */
    void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
    void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
    int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
    void (*reserved22)(void);
    Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, size_t length, const char *file, int line); /* 23 */
    Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
    Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
    void (*reserved26)(void);
    Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
    Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, size_t length, const char *file, int line); /* 28 */
    void (*tcl_AppendToObj) (Tcl_Obj *objPtr, CONST char *bytes, int length); /* 16 */
    Tcl_Obj * (*tcl_ConcatObj) (int objc, Tcl_Obj *CONST objv[]); /* 17 */
    int (*tcl_ConvertToType) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_ObjType *typePtr); /* 18 */
    void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, CONST char *file, int line); /* 19 */
    void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, CONST char *file, int line); /* 20 */
    int (*tcl_DbIsShared) (Tcl_Obj *objPtr, CONST char *file, int line); /* 21 */
    Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, CONST char *file, int line); /* 22 */
    Tcl_Obj * (*tcl_DbNewByteArrayObj) (CONST unsigned char *bytes, int length, CONST char *file, int line); /* 23 */
    Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, CONST char *file, int line); /* 24 */
    Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *CONST *objv, CONST char *file, int line); /* 25 */
    Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, CONST char *file, int line); /* 26 */
    Tcl_Obj * (*tcl_DbNewObj) (CONST char *file, int line); /* 27 */
    Tcl_Obj * (*tcl_DbNewStringObj) (CONST char *bytes, int length, CONST char *file, int line); /* 28 */
    Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
    void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
    int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
    int (*tcl_GetBoolean) (Tcl_Interp *interp, CONST char *src, int *intPtr); /* 31 */
    int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */
    unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDouble) (Tcl_Interp *interp, CONST char *src, double *doublePtr); /* 34 */
    int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
    void (*reserved36)(void);
    int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
    int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char **tablePtr, CONST char *msg, int flags, int *indexPtr); /* 36 */
    int (*tcl_GetInt) (Tcl_Interp *interp, CONST char *src, int *intPtr); /* 37 */
    int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
    int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
    const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
    Tcl_ObjType * (*tcl_GetObjType) (CONST char *typeName); /* 40 */
    char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
    void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
    int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
    int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
    int (*tcl_ListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
    int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
    int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
    void (*reserved49)(void);
    Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, size_t length); /* 50 */
    int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[]); /* 48 */
    Tcl_Obj * (*tcl_NewBooleanObj) (int intValue); /* 49 */
    Tcl_Obj * (*tcl_NewByteArrayObj) (CONST unsigned char *bytes, int length); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
    void (*reserved52)(void);
    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
    void (*reserved54)(void);
    Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
    Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *CONST objv[]); /* 53 */
    Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
    Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
    Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, size_t length); /* 56 */
    void (*reserved57)(void);
    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, size_t length); /* 58 */
    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, size_t length); /* 59 */
    Tcl_Obj * (*tcl_NewStringObj) (CONST char *bytes, int length); /* 56 */
    void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int intValue); /* 57 */
    unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int numBytes); /* 58 */
    void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, CONST unsigned char *bytes, int numBytes); /* 59 */
    void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
    void (*reserved61)(void);
    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
    void (*reserved63)(void);
    void (*tcl_SetObjLength) (Tcl_Obj *objPtr, size_t length); /* 64 */
    void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, size_t length); /* 65 */
    void (*reserved66)(void);
    void (*reserved67)(void);
    void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
    void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *CONST objv[]); /* 62 */
    void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
    void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
    void (*tcl_SetStringObj) (Tcl_Obj *objPtr, CONST char *bytes, int length); /* 65 */
    void (*tcl_AddErrorInfo) (Tcl_Interp *interp, CONST char *message); /* 66 */
    void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, CONST char *message, int length); /* 67 */
    void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
    void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
    void (*tcl_AppendElement) (Tcl_Interp *interp, CONST char *element); /* 69 */
    void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, void *clientData); /* 71 */
    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
    void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
    int (*tcl_AsyncReady) (void); /* 75 */
    void (*reserved76)(void);
    void (*reserved77)(void);
    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 79 */
    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, void *clientData); /* 80 */
    void (*reserved81)(void);
    int (*tcl_CommandComplete) (const char *cmd); /* 82 */
    char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
    size_t (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
    size_t (*tcl_ConvertCountedElement) (const char *src, size_t length, char *dst, int flags); /* 85 */
    int (*tcl_CreateAlias) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
    int (*tcl_CreateAliasObj) (Tcl_Interp *childInterp, const char *childCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
    Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, void *instanceData, int mask); /* 88 */
    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, void *clientData); /* 89 */
    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 90 */
    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 93 */
    void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
    char (*tcl_Backslash) (CONST char *src, int *readPtr); /* 77 */
    int (*tcl_BadChannelOption) (Tcl_Interp *interp, CONST char *optionName, CONST char *optionList); /* 78 */
    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
    int (*tcl_CommandComplete) (CONST char *cmd); /* 82 */
    char * (*tcl_Concat) (int argc, CONST84 char *CONST *argv); /* 83 */
    int (*tcl_ConvertElement) (CONST char *src, char *dst, int flags); /* 84 */
    int (*tcl_ConvertCountedElement) (CONST char *src, int length, char *dst, int flags); /* 85 */
    int (*tcl_CreateAlias) (Tcl_Interp *childInterp, CONST char *childCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, CONST84 char *CONST *argv); /* 86 */
    int (*tcl_CreateAliasObj) (Tcl_Interp *childInterp, CONST char *childCmd, Tcl_Interp *target, CONST char *targetCmd, int objc, Tcl_Obj *CONST objv[]); /* 87 */
    Tcl_Channel (*tcl_CreateChannel) (Tcl_ChannelType *typePtr, CONST char *chanName, ClientData instanceData, int mask); /* 88 */
    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    void (*reserved95)(void);
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateChild) (Tcl_Interp *interp, const char *name, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, void *clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, void *clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, void *clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, void *clientData); /* 102 */
    int (*tcl_DeleteCommand) (Tcl_Interp *interp, const char *cmdName); /* 103 */
    void (*tcl_CreateMathFunc) (Tcl_Interp *interp, CONST char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, CONST char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, CONST char *name, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, CONST char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
    int (*tcl_DeleteCommand) (Tcl_Interp *interp, CONST char *cmdName); /* 103 */
    int (*tcl_DeleteCommandFromToken) (Tcl_Interp *interp, Tcl_Command command); /* 104 */
    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, void *clientData); /* 105 */
    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, void *clientData); /* 106 */
    void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 107 */
    void (*tcl_DeleteEvents) (Tcl_EventDeleteProc *proc, ClientData clientData); /* 105 */
    void (*tcl_DeleteEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 106 */
    void (*tcl_DeleteExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 107 */
    void (*tcl_DeleteHashEntry) (Tcl_HashEntry *entryPtr); /* 108 */
    void (*tcl_DeleteHashTable) (Tcl_HashTable *tablePtr); /* 109 */
    void (*tcl_DeleteInterp) (Tcl_Interp *interp); /* 110 */
    void (*tcl_DetachPids) (int numPids, Tcl_Pid *pidPtr); /* 111 */
    void (*tcl_DeleteTimerHandler) (Tcl_TimerToken token); /* 112 */
    void (*tcl_DeleteTrace) (Tcl_Interp *interp, Tcl_Trace trace); /* 113 */
    void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, void *clientData); /* 114 */
    void (*tcl_DontCallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 114 */
    int (*tcl_DoOneEvent) (int flags); /* 115 */
    void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, void *clientData); /* 116 */
    char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, const char *bytes, size_t length); /* 117 */
    char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, const char *element); /* 118 */
    void (*tcl_DoWhenIdle) (Tcl_IdleProc *proc, ClientData clientData); /* 116 */
    char * (*tcl_DStringAppend) (Tcl_DString *dsPtr, CONST char *bytes, int length); /* 117 */
    char * (*tcl_DStringAppendElement) (Tcl_DString *dsPtr, CONST char *element); /* 118 */
    void (*tcl_DStringEndSublist) (Tcl_DString *dsPtr); /* 119 */
    void (*tcl_DStringFree) (Tcl_DString *dsPtr); /* 120 */
    void (*tcl_DStringGetResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 121 */
    void (*tcl_DStringInit) (Tcl_DString *dsPtr); /* 122 */
    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, size_t length); /* 124 */
    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
    int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
    const char * (*tcl_ErrnoId) (void); /* 127 */
    const char * (*tcl_ErrnoMsg) (int err); /* 128 */
    void (*reserved129)(void);
    int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
    void (*reserved131)(void);
    void (*tcl_EventuallyFree) (void *clientData, Tcl_FreeProc *freeProc); /* 132 */
    TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
    int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
    int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
    CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
    CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
    int (*tcl_Eval) (Tcl_Interp *interp, CONST char *script); /* 129 */
    int (*tcl_EvalFile) (Tcl_Interp *interp, CONST char *fileName); /* 130 */
    int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
    void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
    void (*tcl_Exit) (int status); /* 133 */
    int (*tcl_ExposeCommand) (Tcl_Interp *interp, CONST char *hiddenCmdToken, CONST char *cmdName); /* 134 */
    int (*tcl_ExprBoolean) (Tcl_Interp *interp, CONST char *expr, int *ptr); /* 135 */
    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
    int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
    int (*tcl_ExprDouble) (Tcl_Interp *interp, CONST char *expr, double *ptr); /* 137 */
    int (*tcl_ExprDoubleObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *ptr); /* 138 */
    int (*tcl_ExprLong) (Tcl_Interp *interp, const char *expr, long *ptr); /* 139 */
    int (*tcl_ExprLong) (Tcl_Interp *interp, CONST char *expr, long *ptr); /* 139 */
    int (*tcl_ExprLongObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *ptr); /* 140 */
    int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
    int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
    int (*tcl_ExprString) (Tcl_Interp *interp, CONST char *expr); /* 142 */
    void (*tcl_Finalize) (void); /* 143 */
    void (*reserved144)(void);
    void (*tcl_FindExecutable) (CONST char *argv0); /* 144 */
    Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
    int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
    void (*reserved147)(void);
    int (*tcl_GetAlias) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
    int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
    void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
    void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
    int (*tcl_GetAlias) (Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
    int (*tcl_GetAliasObj) (Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
    ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
    Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, CONST char *chanName, int *modePtr); /* 151 */
    int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
    int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */
    void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
    int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
    ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
    int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
    const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
    const Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
    const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
    CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
    int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, Tcl_DString *dsPtr); /* 157 */
    Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
    int (*tcl_GetCommandInfo) (Tcl_Interp *interp, CONST char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
    CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
    int (*tcl_GetErrno) (void); /* 161 */
    const char * (*tcl_GetHostName) (void); /* 162 */
    CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
    int (*tcl_GetInterpPath) (Tcl_Interp *interp, Tcl_Interp *childInterp); /* 163 */
    Tcl_Interp * (*tcl_GetParent) (Tcl_Interp *interp); /* 164 */
    const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
    Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
    CONST char * (*tcl_GetNameOfExecutable) (void); /* 165 */
    Tcl_Obj * (*tcl_GetObjResult) (Tcl_Interp *interp); /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    void (*reserved167)(void);
#if defined(__WIN32__) /* WIN */
    VOID *reserved167;
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, const char *chanID, int forWriting, int checkUsage, void **filePtr); /* 167 */
    int (*tcl_GetOpenFile) (Tcl_Interp *interp, CONST char *chanID, int forWriting, int checkUsage, ClientData *filePtr); /* 167 */
#endif /* MACOSX */
    Tcl_PathType (*tcl_GetPathType) (const char *path); /* 168 */
    size_t (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
    size_t (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
    Tcl_PathType (*tcl_GetPathType) (CONST char *path); /* 168 */
    int (*tcl_Gets) (Tcl_Channel chan, Tcl_DString *dsPtr); /* 169 */
    int (*tcl_GetsObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 170 */
    int (*tcl_GetServiceMode) (void); /* 171 */
    Tcl_Interp * (*tcl_GetChild) (Tcl_Interp *interp, const char *name); /* 172 */
    Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, CONST char *slaveName); /* 172 */
    Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
    void (*reserved174)(void);
    void (*reserved175)(void);
    const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
    void (*reserved177)(void);
    void (*reserved178)(void);
    int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
    CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
    CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, CONST char *varName, int flags); /* 175 */
    CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags); /* 176 */
    int (*tcl_GlobalEval) (Tcl_Interp *interp, CONST char *command); /* 177 */
    int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
    int (*tcl_HideCommand) (Tcl_Interp *interp, CONST char *cmdName, CONST char *hiddenCmdToken); /* 179 */
    int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
    void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
    int (*tcl_InputBlocked) (Tcl_Channel chan); /* 182 */
    int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
    int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
    int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
    char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */
    void (*reserved188)(void);
    Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */
    char * (*tcl_JoinPath) (int argc, CONST84 char *CONST *argv, Tcl_DString *resultPtr); /* 186 */
    int (*tcl_LinkVar) (Tcl_Interp *interp, CONST char *varName, char *addr, int type); /* 187 */
    VOID *reserved188;
    Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
    int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
    Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
    char * (*tcl_Merge) (int argc, CONST84 char *CONST *argv); /* 192 */
    Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
    void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
    Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
    Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 200 */
    void (*tcl_Preserve) (void *data); /* 201 */
    Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
    Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions); /* 198 */
    Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, CONST char *address, CONST char *myaddr, int myport, int flags); /* 199 */
    Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, CONST char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
    void (*tcl_Preserve) (ClientData data); /* 201 */
    void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
    int (*tcl_PutEnv) (const char *assignment); /* 203 */
    const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
    int (*tcl_PutEnv) (CONST char *assignment); /* 203 */
    CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
    void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
    size_t (*tcl_Read) (Tcl_Channel chan, char *bufPtr, size_t toRead); /* 206 */
    int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
    void (*tcl_ReapDetachedProcs) (void); /* 207 */
    int (*tcl_RecordAndEval) (Tcl_Interp *interp, const char *cmd, int flags); /* 208 */
    int (*tcl_RecordAndEval) (Tcl_Interp *interp, CONST char *cmd, int flags); /* 208 */
    int (*tcl_RecordAndEvalObj) (Tcl_Interp *interp, Tcl_Obj *cmdPtr, int flags); /* 209 */
    void (*tcl_RegisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 210 */
    void (*tcl_RegisterObjType) (const Tcl_ObjType *typePtr); /* 211 */
    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
    int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
    void (*tcl_RegExpRange) (Tcl_RegExp regexp, size_t index, const char **startPtr, const char **endPtr); /* 215 */
    void (*tcl_Release) (void *clientData); /* 216 */
    void (*tcl_RegisterObjType) (Tcl_ObjType *typePtr); /* 211 */
    Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, CONST char *pattern); /* 212 */
    int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, CONST char *text, CONST char *start); /* 213 */
    int (*tcl_RegExpMatch) (Tcl_Interp *interp, CONST char *text, CONST char *pattern); /* 214 */
    void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
    void (*tcl_Release) (ClientData clientData); /* 216 */
    void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
    size_t (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
    size_t (*tcl_ScanCountedElement) (const char *src, size_t length, int *flagPtr); /* 219 */
    void (*reserved220)(void);
    int (*tcl_ScanElement) (CONST char *src, int *flagPtr); /* 218 */
    int (*tcl_ScanCountedElement) (CONST char *src, int length, int *flagPtr); /* 219 */
    int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
    int (*tcl_ServiceAll) (void); /* 221 */
    int (*tcl_ServiceEvent) (int flags); /* 222 */
    void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, void *clientData); /* 223 */
    void (*tcl_SetAssocData) (Tcl_Interp *interp, CONST char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
    void (*tcl_SetChannelBufferSize) (Tcl_Channel chan, int sz); /* 224 */
    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, const char *newValue); /* 225 */
    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, const char *cmdName, const Tcl_CmdInfo *infoPtr); /* 226 */
    int (*tcl_SetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, CONST char *optionName, CONST char *newValue); /* 225 */
    int (*tcl_SetCommandInfo) (Tcl_Interp *interp, CONST char *cmdName, CONST Tcl_CmdInfo *infoPtr); /* 226 */
    void (*tcl_SetErrno) (int err); /* 227 */
    void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
    void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
    void (*reserved230)(void);
    void (*tcl_SetMaxBlockTime) (Tcl_Time *timePtr); /* 229 */
    void (*tcl_SetPanicProc) (Tcl_PanicProc *panicProc); /* 230 */
    int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
    void (*reserved232)(void);
    void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
    int (*tcl_SetServiceMode) (int mode); /* 233 */
    void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
    void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
    void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
    void (*reserved237)(void);
    const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
    const char * (*tcl_SignalId) (int sig); /* 239 */
    const char * (*tcl_SignalMsg) (int sig); /* 240 */
    CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags); /* 237 */
    CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *newValue, int flags); /* 238 */
    CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
    CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
    void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
    int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
    void (*reserved244)(void);
    void (*reserved245)(void);
    void (*reserved246)(void);
    void (*reserved247)(void);
    int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
    size_t (*tcl_Ungets) (Tcl_Channel chan, const char *str, size_t len, int atHead); /* 250 */
    void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
    int (*tcl_SplitList) (Tcl_Interp *interp, CONST char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
    void (*tcl_SplitPath) (CONST char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
    void (*tcl_StaticPackage) (Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
    int (*tcl_StringMatch) (CONST char *str, CONST char *pattern); /* 245 */
    int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
    int (*tcl_TraceVar) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
    int (*tcl_TraceVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
    char * (*tcl_TranslateFileName) (Tcl_Interp *interp, CONST char *name, Tcl_DString *bufferPtr); /* 249 */
    int (*tcl_Ungets) (Tcl_Channel chan, CONST char *str, int len, int atHead); /* 250 */
    void (*tcl_UnlinkVar) (Tcl_Interp *interp, CONST char *varName); /* 251 */
    int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
    void (*reserved253)(void);
    int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
    void (*reserved255)(void);
    void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, void *clientData); /* 256 */
    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
    void (*reserved258)(void);
    int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
    int (*tcl_UnsetVar) (Tcl_Interp *interp, CONST char *varName, int flags); /* 253 */
    int (*tcl_UnsetVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags); /* 254 */
    void (*tcl_UntraceVar) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
    void (*tcl_UntraceVar2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
    void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, CONST char *varName); /* 257 */
    int (*tcl_UpVar) (Tcl_Interp *interp, CONST char *frameName, CONST char *varName, CONST char *localName, int flags); /* 258 */
    int (*tcl_UpVar2) (Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags); /* 259 */
    int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
    void (*reserved261)(void);
    void * (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, void *prevClientData); /* 262 */
    size_t (*tcl_Write) (Tcl_Channel chan, const char *s, size_t slen); /* 263 */
    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
    int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
    void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
    void (*reserved267)(void);
    void (*reserved268)(void);
    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
    ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
    int (*tcl_Write) (Tcl_Channel chan, CONST char *s, int slen); /* 263 */
    void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], CONST char *message); /* 264 */
    int (*tcl_DumpActiveMemory) (CONST char *fileName); /* 265 */
    void (*tcl_ValidateAllMemory) (CONST char *file, int line); /* 266 */
    void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
    void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
    char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
    const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
    void (*reserved271)(void);
    const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
    void (*reserved273)(void);
    void (*reserved274)(void);
    void (*reserved275)(void);
    void (*reserved276)(void);
    CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, CONST char *start, CONST84 char **termPtr); /* 270 */
    CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact); /* 271 */
    CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr); /* 272 */
    int (*tcl_PkgProvide) (Tcl_Interp *interp, CONST char *name, CONST char *version); /* 273 */
    CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, CONST char *name, CONST char *version, int exact); /* 274 */
    void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
    int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
    Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
    void (*reserved278)(void);
    void (*tcl_PanicVA) (CONST char *format, va_list argList); /* 278 */
    void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
    void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */
    Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
    int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */
    Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */
    void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */
    void (*reserved285)(void);
    VOID *reserved285;
    void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */
    Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */
    void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */
    void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */
    void (*reserved290)(void);
    int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, size_t numBytes, int flags); /* 291 */
    int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
    Tcl_Encoding (*tcl_CreateEncoding) (CONST Tcl_EncodingType *typePtr); /* 287 */
    void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 288 */
    void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 289 */
    void (*tcl_DiscardResult) (Tcl_SavedResult *statePtr); /* 290 */
    int (*tcl_EvalEx) (Tcl_Interp *interp, CONST char *script, int numBytes, int flags); /* 291 */
    int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags); /* 292 */
    int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
    TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */
    int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
    char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 296 */
    void (*tcl_ExitThread) (int status); /* 294 */
    int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
    char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
    void (*tcl_FinalizeThread) (void); /* 297 */
    void (*tcl_FinalizeNotifier) (void *clientData); /* 298 */
    void (*tcl_FinalizeNotifier) (ClientData clientData); /* 298 */
    void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
    Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
    Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
    const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
    Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, CONST char *name); /* 301 */
    CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
    void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, size_t offset, const char *msg, int flags, int *indexPtr); /* 304 */
    void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, size_t size); /* 305 */
    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 306 */
    void * (*tcl_InitNotifier) (void); /* 307 */
    int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST VOID *tablePtr, int offset, CONST char *msg, int flags, int *indexPtr); /* 304 */
    VOID * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
    Tcl_Obj * (*tcl_GetVar2Ex) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags); /* 306 */
    ClientData (*tcl_InitNotifier) (void); /* 307 */
    void (*tcl_MutexLock) (Tcl_Mutex *mutexPtr); /* 308 */
    void (*tcl_MutexUnlock) (Tcl_Mutex *mutexPtr); /* 309 */
    void (*tcl_ConditionNotify) (Tcl_Condition *condPtr); /* 310 */
    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, const Tcl_Time *timePtr); /* 311 */
    size_t (*tcl_NumUtfChars) (const char *src, size_t length); /* 312 */
    size_t (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, size_t charsToRead, int appendFlag); /* 313 */
    void (*reserved314)(void);
    void (*reserved315)(void);
    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, const char *name); /* 316 */
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ConditionWait) (Tcl_Condition *condPtr, Tcl_Mutex *mutexPtr, Tcl_Time *timePtr); /* 311 */
    int (*tcl_NumUtfChars) (CONST char *src, int length); /* 312 */
    int (*tcl_ReadChars) (Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead, int appendFlag); /* 313 */
    void (*tcl_RestoreResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 314 */
    void (*tcl_SaveResult) (Tcl_Interp *interp, Tcl_SavedResult *statePtr); /* 315 */
    int (*tcl_SetSystemEncoding) (Tcl_Interp *interp, CONST char *name); /* 316 */
    Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
    void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
    void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
    int (*tcl_UniCharAtIndex) (const char *src, size_t index); /* 320 */
    int (*tcl_UniCharToLower) (int ch); /* 321 */
    int (*tcl_UniCharToTitle) (int ch); /* 322 */
    int (*tcl_UniCharToUpper) (int ch); /* 323 */
    Tcl_UniChar (*tcl_UniCharAtIndex) (CONST char *src, int index); /* 320 */
    Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */
    Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
    Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
    int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
    const char * (*tcl_UtfAtIndex) (const char *src, size_t index); /* 325 */
    int (*tcl_UtfCharComplete) (const char *src, size_t length); /* 326 */
    size_t (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
    const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
    const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
    const char * (*tcl_UtfNext) (const char *src); /* 330 */
    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, size_t srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, size_t dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, size_t srcLen, Tcl_DString *dsPtr); /* 333 */
    CONST84_RETURN char * (*tcl_UtfAtIndex) (CONST char *src, int index); /* 325 */
    int (*tcl_UtfCharComplete) (CONST char *src, int length); /* 326 */
    int (*tcl_UtfBackslash) (CONST char *src, int *readPtr, char *dst); /* 327 */
    CONST84_RETURN char * (*tcl_UtfFindFirst) (CONST char *src, int ch); /* 328 */
    CONST84_RETURN char * (*tcl_UtfFindLast) (CONST char *src, int ch); /* 329 */
    CONST84_RETURN char * (*tcl_UtfNext) (CONST char *src); /* 330 */
    CONST84_RETURN char * (*tcl_UtfPrev) (CONST char *src, CONST char *start); /* 331 */
    int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, CONST char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
    char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, CONST char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
    int (*tcl_UtfToLower) (char *src); /* 334 */
    int (*tcl_UtfToTitle) (char *src); /* 335 */
    int (*tcl_UtfToChar16) (const char *src, unsigned short *chPtr); /* 336 */
    int (*tcl_UtfToUniChar) (CONST char *src, Tcl_UniChar *chPtr); /* 336 */
    int (*tcl_UtfToUpper) (char *src); /* 337 */
    size_t (*tcl_WriteChars) (Tcl_Channel chan, const char *src, size_t srcLen); /* 338 */
    size_t (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    int (*tcl_WriteChars) (Tcl_Channel chan, CONST char *src, int srcLen); /* 338 */
    int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    void (*reserved341)(void);
    void (*reserved342)(void);
    void (*tcl_AlertNotifier) (void *clientData); /* 343 */
    CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
    void (*tcl_SetDefaultEncodingDir) (CONST char *path); /* 342 */
    void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */
    int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
    int (*tcl_UniCharIsLower) (int ch); /* 348 */
    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
    void (*reserved352)(void);
    void (*reserved353)(void);
    char * (*tcl_Char16ToUtfDString) (const unsigned short *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 354 */
    unsigned short * (*tcl_UtfToChar16DString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 355 */
    int (*tcl_UniCharLen) (CONST Tcl_UniChar *uniStr); /* 352 */
    int (*tcl_UniCharNcmp) (CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, unsigned long numChars); /* 353 */
    char * (*tcl_UniCharToUtfDString) (CONST Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) (CONST char *src, int length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    void (*reserved357)(void);
    Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, size_t length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
    int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, size_t numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
    int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr); /* 362 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
    int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, size_t numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, CONST char *script, CONST char *command, int length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
    int (*tcl_ParseCommand) (Tcl_Interp *interp, CONST char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
    int (*tcl_ParseExpr) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
    int (*tcl_ParseVarName) (Tcl_Interp *interp, CONST char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
    char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
    int (*tcl_Chdir) (const char *dirName); /* 366 */
    int (*tcl_Access) (const char *path, int mode); /* 367 */
    int (*tcl_Stat) (const char *path, struct stat *bufPtr); /* 368 */
    int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 369 */
    int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 370 */
    int (*tcl_StringCaseMatch) (const char *str, const char *pattern, int nocase); /* 371 */
    int (*tcl_Chdir) (CONST char *dirName); /* 366 */
    int (*tcl_Access) (CONST char *path, int mode); /* 367 */
    int (*tcl_Stat) (CONST char *path, struct stat *bufPtr); /* 368 */
    int (*tcl_UtfNcmp) (CONST char *s1, CONST char *s2, unsigned long n); /* 369 */
    int (*tcl_UtfNcasecmp) (CONST char *s1, CONST char *s2, unsigned long n); /* 370 */
    int (*tcl_StringCaseMatch) (CONST char *str, CONST char *pattern, int nocase); /* 371 */
    int (*tcl_UniCharIsControl) (int ch); /* 372 */
    int (*tcl_UniCharIsGraph) (int ch); /* 373 */
    int (*tcl_UniCharIsPrint) (int ch); /* 374 */
    int (*tcl_UniCharIsPunct) (int ch); /* 375 */
    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, size_t offset, size_t nmatches, int flags); /* 376 */
    int (*tcl_RegExpExecObj) (Tcl_Interp *interp, Tcl_RegExp regexp, Tcl_Obj *textObj, int offset, int nmatches, int flags); /* 376 */
    void (*tcl_RegExpGetInfo) (Tcl_RegExp regexp, Tcl_RegExpInfo *infoPtr); /* 377 */
    Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, size_t numChars); /* 378 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t numChars); /* 379 */
    size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
    int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */
    void (*reserved382)(void);
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */
    void (*reserved384)(void);
    Tcl_Obj * (*tcl_NewUnicodeObj) (CONST Tcl_UniChar *unicode, int numChars); /* 378 */
    void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int numChars); /* 379 */
    int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
    Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
    Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
    Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
    void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, CONST Tcl_UniChar *unicode, int length); /* 384 */
    int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
    void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
    Tcl_Mutex * (*tcl_GetAllocMutex) (void); /* 387 */
    int (*tcl_GetChannelNames) (Tcl_Interp *interp); /* 388 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, const char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 390 */
    int (*tcl_GetChannelNamesEx) (Tcl_Interp *interp, CONST char *pattern); /* 389 */
    int (*tcl_ProcObjCmd) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* 390 */
    void (*tcl_ConditionFinalize) (Tcl_Condition *condPtr); /* 391 */
    void (*tcl_MutexFinalize) (Tcl_Mutex *mutex); /* 392 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc *proc, void *clientData, size_t stackSize, int flags); /* 393 */
    size_t (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, size_t bytesToRead); /* 394 */
    size_t (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, size_t srcLen); /* 395 */
    int (*tcl_CreateThread) (Tcl_ThreadId *idPtr, Tcl_ThreadCreateProc proc, ClientData clientData, int stackSize, int flags); /* 393 */
    int (*tcl_ReadRaw) (Tcl_Channel chan, char *dst, int bytesToRead); /* 394 */
    int (*tcl_WriteRaw) (Tcl_Channel chan, CONST char *src, int srcLen); /* 395 */
    Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
    int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
    const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
    void (*reserved401)(void);
    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (const Tcl_ChannelType *chanTypePtr); /* 402 */
    Tcl_DriverInputProc * (*tcl_ChannelInputProc) (const Tcl_ChannelType *chanTypePtr); /* 403 */
    Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (const Tcl_ChannelType *chanTypePtr); /* 404 */
    void (*reserved405)(void);
    Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 406 */
    Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (const Tcl_ChannelType *chanTypePtr); /* 407 */
    Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (const Tcl_ChannelType *chanTypePtr); /* 408 */
    Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (const Tcl_ChannelType *chanTypePtr); /* 409 */
    Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (const Tcl_ChannelType *chanTypePtr); /* 410 */
    Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (const Tcl_ChannelType *chanTypePtr); /* 411 */
    CONST84_RETURN char * (*tcl_ChannelName) (CONST Tcl_ChannelType *chanTypePtr); /* 398 */
    Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (CONST Tcl_ChannelType *chanTypePtr); /* 399 */
    Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (CONST Tcl_ChannelType *chanTypePtr); /* 400 */
    Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (CONST Tcl_ChannelType *chanTypePtr); /* 401 */
    Tcl_DriverClose2Proc * (*tcl_ChannelClose2Proc) (CONST Tcl_ChannelType *chanTypePtr); /* 402 */
    Tcl_DriverInputProc * (*tcl_ChannelInputProc) (CONST Tcl_ChannelType *chanTypePtr); /* 403 */
    Tcl_DriverOutputProc * (*tcl_ChannelOutputProc) (CONST Tcl_ChannelType *chanTypePtr); /* 404 */
    Tcl_DriverSeekProc * (*tcl_ChannelSeekProc) (CONST Tcl_ChannelType *chanTypePtr); /* 405 */
    Tcl_DriverSetOptionProc * (*tcl_ChannelSetOptionProc) (CONST Tcl_ChannelType *chanTypePtr); /* 406 */
    Tcl_DriverGetOptionProc * (*tcl_ChannelGetOptionProc) (CONST Tcl_ChannelType *chanTypePtr); /* 407 */
    Tcl_DriverWatchProc * (*tcl_ChannelWatchProc) (CONST Tcl_ChannelType *chanTypePtr); /* 408 */
    Tcl_DriverGetHandleProc * (*tcl_ChannelGetHandleProc) (CONST Tcl_ChannelType *chanTypePtr); /* 409 */
    Tcl_DriverFlushProc * (*tcl_ChannelFlushProc) (CONST Tcl_ChannelType *chanTypePtr); /* 410 */
    Tcl_DriverHandlerProc * (*tcl_ChannelHandlerProc) (CONST Tcl_ChannelType *chanTypePtr); /* 411 */
    int (*tcl_JoinThread) (Tcl_ThreadId threadId, int *result); /* 412 */
    int (*tcl_IsChannelShared) (Tcl_Channel channel); /* 413 */
    int (*tcl_IsChannelRegistered) (Tcl_Interp *interp, Tcl_Channel channel); /* 414 */
    void (*tcl_CutChannel) (Tcl_Channel channel); /* 415 */
    void (*tcl_SpliceChannel) (Tcl_Channel channel); /* 416 */
    void (*tcl_ClearChannelHandlers) (Tcl_Channel channel); /* 417 */
    int (*tcl_IsChannelExisting) (const char *channelName); /* 418 */
    void (*reserved419)(void);
    void (*reserved420)(void);
    void (*reserved421)(void);
    void (*reserved422)(void);
    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, const Tcl_HashKeyType *typePtr); /* 423 */
    int (*tcl_IsChannelExisting) (CONST char *channelName); /* 418 */
    int (*tcl_UniCharNcasecmp) (CONST Tcl_UniChar *ucs, CONST Tcl_UniChar *uct, unsigned long numChars); /* 419 */
    int (*tcl_UniCharCaseMatch) (CONST Tcl_UniChar *uniStr, CONST Tcl_UniChar *uniPattern, int nocase); /* 420 */
    Tcl_HashEntry * (*tcl_FindHashEntry) (Tcl_HashTable *tablePtr, CONST char *key); /* 421 */
    Tcl_HashEntry * (*tcl_CreateHashEntry) (Tcl_HashTable *tablePtr, CONST char *key, int *newPtr); /* 422 */
    void (*tcl_InitCustomHashTable) (Tcl_HashTable *tablePtr, int keyType, Tcl_HashKeyType *typePtr); /* 423 */
    void (*tcl_InitObjHashTable) (Tcl_HashTable *tablePtr); /* 424 */
    void * (*tcl_CommandTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *procPtr, void *prevClientData); /* 425 */
    int (*tcl_TraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 426 */
    void (*tcl_UntraceCommand) (Tcl_Interp *interp, const char *varName, int flags, Tcl_CommandTraceProc *proc, void *clientData); /* 427 */
    void * (*tcl_AttemptAlloc) (size_t size); /* 428 */
    void * (*tcl_AttemptDbCkalloc) (size_t size, const char *file, int line); /* 429 */
    void * (*tcl_AttemptRealloc) (void *ptr, size_t size); /* 430 */
    void * (*tcl_AttemptDbCkrealloc) (void *ptr, size_t size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, size_t length); /* 432 */
    ClientData (*tcl_CommandTraceInfo) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *procPtr, ClientData prevClientData); /* 425 */
    int (*tcl_TraceCommand) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 426 */
    void (*tcl_UntraceCommand) (Tcl_Interp *interp, CONST char *varName, int flags, Tcl_CommandTraceProc *proc, ClientData clientData); /* 427 */
    char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
    char * (*tcl_AttemptDbCkalloc) (unsigned int size, CONST char *file, int line); /* 429 */
    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, CONST char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    void (*reserved435)(void);
    void (*reserved436)(void);
    int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, CONST char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
    Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, CONST char *pattern); /* 436 */
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
    int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
    int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
    int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
    int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 445 */
    int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *sym1, CONST char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
    int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData *types); /* 445 */
    Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */
    int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */
    int (*tcl_FSRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 448 */
    int (*tcl_FSLstat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 449 */
    int (*tcl_FSUtime) (Tcl_Obj *pathPtr, struct utimbuf *tval); /* 450 */
    int (*tcl_FSFileAttrsGet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 451 */
    int (*tcl_FSFileAttrsSet) (Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr); /* 452 */
    const char *const * (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
    CONST char ** (*tcl_FSFileAttrStrings) (Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef); /* 453 */
    int (*tcl_FSStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 454 */
    int (*tcl_FSAccess) (Tcl_Obj *pathPtr, int mode); /* 455 */
    Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *modeString, int permissions); /* 456 */
    Tcl_Channel (*tcl_FSOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, CONST char *modeString, int permissions); /* 456 */
    Tcl_Obj * (*tcl_FSGetCwd) (Tcl_Interp *interp); /* 457 */
    int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
    int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
    Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, int elements); /* 460 */
    Tcl_Obj * (*tcl_FSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
    int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
    Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *const objv[]); /* 464 */
    void * (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, const Tcl_Filesystem *fsPtr); /* 465 */
    Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, int objc, Tcl_Obj *CONST objv[]); /* 464 */
    ClientData (*tcl_FSGetInternalRep) (Tcl_Obj *pathPtr, Tcl_Filesystem *fsPtr); /* 465 */
    Tcl_Obj * (*tcl_FSGetTranslatedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 466 */
    int (*tcl_FSEvalFile) (Tcl_Interp *interp, Tcl_Obj *fileName); /* 467 */
    Tcl_Obj * (*tcl_FSNewNativePath) (const Tcl_Filesystem *fromFilesystem, void *clientData); /* 468 */
    const void * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
    Tcl_Obj * (*tcl_FSNewNativePath) (Tcl_Filesystem *fromFilesystem, ClientData clientData); /* 468 */
    CONST char * (*tcl_FSGetNativePath) (Tcl_Obj *pathPtr); /* 469 */
    Tcl_Obj * (*tcl_FSFileSystemInfo) (Tcl_Obj *pathPtr); /* 470 */
    Tcl_Obj * (*tcl_FSPathSeparator) (Tcl_Obj *pathPtr); /* 471 */
    Tcl_Obj * (*tcl_FSListVolumes) (void); /* 472 */
    int (*tcl_FSRegister) (void *clientData, const Tcl_Filesystem *fsPtr); /* 473 */
    int (*tcl_FSUnregister) (const Tcl_Filesystem *fsPtr); /* 474 */
    void * (*tcl_FSData) (const Tcl_Filesystem *fsPtr); /* 475 */
    const char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
    const Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
    int (*tcl_FSRegister) (ClientData clientData, Tcl_Filesystem *fsPtr); /* 473 */
    int (*tcl_FSUnregister) (Tcl_Filesystem *fsPtr); /* 474 */
    ClientData (*tcl_FSData) (Tcl_Filesystem *fsPtr); /* 475 */
    CONST char * (*tcl_FSGetTranslatedStringPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 476 */
    Tcl_Filesystem * (*tcl_FSGetFileSystemForPath) (Tcl_Obj *pathPtr); /* 477 */
    Tcl_PathType (*tcl_FSGetPathType) (Tcl_Obj *pathPtr); /* 478 */
    int (*tcl_OutputBuffered) (Tcl_Channel chan); /* 479 */
    void (*tcl_FSMountsChanged) (const Tcl_Filesystem *fsPtr); /* 480 */
    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, size_t count); /* 481 */
    void (*tcl_FSMountsChanged) (Tcl_Filesystem *fsPtr); /* 480 */
    int (*tcl_EvalTokensStandard) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 481 */
    void (*tcl_GetTime) (Tcl_Time *timeBuf); /* 482 */
    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
    Tcl_Trace (*tcl_CreateObjTrace) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc *objProc, ClientData clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 483 */
    int (*tcl_GetCommandInfoFromToken) (Tcl_Command token, Tcl_CmdInfo *infoPtr); /* 484 */
    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, const Tcl_CmdInfo *infoPtr); /* 485 */
    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, const char *file, int line); /* 486 */
    int (*tcl_SetCommandInfoFromToken) (Tcl_Command token, CONST Tcl_CmdInfo *infoPtr); /* 485 */
    Tcl_Obj * (*tcl_DbNewWideIntObj) (Tcl_WideInt wideValue, CONST char *file, int line); /* 486 */
    int (*tcl_GetWideIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideInt *widePtr); /* 487 */
    Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
    void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
    Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */
    Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */
    Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan); /* 492 */
    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */
    Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (CONST Tcl_ChannelType *chanTypePtr); /* 493 */
    int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
    int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
    int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
    int (*tcl_DictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */
    int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */
    void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */
    void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv, Tcl_Obj *valuePtr); /* 501 */
    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *const *keyv); /* 502 */
    int (*tcl_DictObjPutKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *CONST *keyv, Tcl_Obj *valuePtr); /* 501 */
    int (*tcl_DictObjRemoveKeyList) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int keyc, Tcl_Obj *CONST *keyv); /* 502 */
    Tcl_Obj * (*tcl_NewDictObj) (void); /* 503 */
    Tcl_Obj * (*tcl_DbNewDictObj) (const char *file, int line); /* 504 */
    void (*tcl_RegisterConfig) (Tcl_Interp *interp, const char *pkgName, const Tcl_Config *configuration, const char *valEncoding); /* 505 */
    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, void *clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */
    Tcl_Obj * (*tcl_DbNewDictObj) (CONST char *file, int line); /* 504 */
    void (*tcl_RegisterConfig) (Tcl_Interp *interp, CONST char *pkgName, Tcl_Config *configuration, CONST char *valEncoding); /* 505 */
    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, CONST char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 506 */
    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 507 */
    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 508 */
    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 509 */
    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 510 */
    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 511 */
    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int resetListFirst); /* 509 */
    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite); /* 510 */
    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern); /* 511 */
    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 512 */
    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 513 */
    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */
    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */
    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 514 */
    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 515 */
    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
    int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
    void (*reserved519)(void);
    void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
    void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, void *clientData); /* 521 */
    int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, CONST char *encodingName); /* 518 */
    Tcl_ExitProc * (*tcl_SetExitProc) (Tcl_ExitProc *proc); /* 519 */
    void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
    void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */
    int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
    int (*tcl_LimitCheck) (Tcl_Interp *interp); /* 523 */
    int (*tcl_LimitExceeded) (Tcl_Interp *interp); /* 524 */
    void (*tcl_LimitSetCommands) (Tcl_Interp *interp, int commandLimit); /* 525 */
    void (*tcl_LimitSetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 526 */
    void (*tcl_LimitSetGranularity) (Tcl_Interp *interp, int type, int granularity); /* 527 */
    int (*tcl_LimitTypeEnabled) (Tcl_Interp *interp, int type); /* 528 */
    int (*tcl_LimitTypeExceeded) (Tcl_Interp *interp, int type); /* 529 */
    void (*tcl_LimitTypeSet) (Tcl_Interp *interp, int type); /* 530 */
    void (*tcl_LimitTypeReset) (Tcl_Interp *interp, int type); /* 531 */
    int (*tcl_LimitGetCommands) (Tcl_Interp *interp); /* 532 */
    void (*tcl_LimitGetTime) (Tcl_Interp *interp, Tcl_Time *timeLimitPtr); /* 533 */
    int (*tcl_LimitGetGranularity) (Tcl_Interp *interp, int type); /* 534 */
    Tcl_InterpState (*tcl_SaveInterpState) (Tcl_Interp *interp, int status); /* 535 */
    int (*tcl_RestoreInterpState) (Tcl_Interp *interp, Tcl_InterpState state); /* 536 */
    void (*tcl_DiscardInterpState) (Tcl_InterpState state); /* 537 */
    int (*tcl_SetReturnOptions) (Tcl_Interp *interp, Tcl_Obj *options); /* 538 */
    Tcl_Obj * (*tcl_GetReturnOptions) (Tcl_Interp *interp, int result); /* 539 */
    int (*tcl_IsEnsemble) (Tcl_Command token); /* 540 */
    Tcl_Command (*tcl_CreateEnsemble) (Tcl_Interp *interp, const char *name, Tcl_Namespace *namespacePtr, int flags); /* 541 */
    Tcl_Command (*tcl_CreateEnsemble) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *namespacePtr, int flags); /* 541 */
    Tcl_Command (*tcl_FindEnsemble) (Tcl_Interp *interp, Tcl_Obj *cmdNameObj, int flags); /* 542 */
    int (*tcl_SetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *subcmdList); /* 543 */
    int (*tcl_SetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *mapDict); /* 544 */
    int (*tcl_SetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *unknownList); /* 545 */
    int (*tcl_SetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int flags); /* 546 */
    int (*tcl_GetEnsembleSubcommandList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **subcmdListPtr); /* 547 */
    int (*tcl_GetEnsembleMappingDict) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **mapDictPtr); /* 548 */
    int (*tcl_GetEnsembleUnknownHandler) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **unknownListPtr); /* 549 */
    int (*tcl_GetEnsembleFlags) (Tcl_Interp *interp, Tcl_Command token, int *flagsPtr); /* 550 */
    int (*tcl_GetEnsembleNamespace) (Tcl_Interp *interp, Tcl_Command token, Tcl_Namespace **namespacePtrPtr); /* 551 */
    void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, void *clientData); /* 552 */
    void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, void **clientData); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (const Tcl_ChannelType *chanTypePtr); /* 554 */
    Tcl_Obj * (*tcl_NewBignumObj) (void *value); /* 555 */
    Tcl_Obj * (*tcl_DbNewBignumObj) (void *value, const char *file, int line); /* 556 */
    void (*tcl_SetBignumObj) (Tcl_Obj *obj, void *value); /* 557 */
    int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 558 */
    int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */
    void (*tcl_SetTimeProc) (Tcl_GetTimeProc *getProc, Tcl_ScaleTimeProc *scaleProc, ClientData clientData); /* 552 */
    void (*tcl_QueryTimeProc) (Tcl_GetTimeProc **getProc, Tcl_ScaleTimeProc **scaleProc, ClientData *clientData); /* 553 */
    Tcl_DriverThreadActionProc * (*tcl_ChannelThreadActionProc) (CONST Tcl_ChannelType *chanTypePtr); /* 554 */
    Tcl_Obj * (*tcl_NewBignumObj) (mp_int *value); /* 555 */
    Tcl_Obj * (*tcl_DbNewBignumObj) (mp_int *value, CONST char *file, int line); /* 556 */
    void (*tcl_SetBignumObj) (Tcl_Obj *obj, mp_int *value); /* 557 */
    int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 558 */
    int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, mp_int *value); /* 559 */
    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */
    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */
    Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (CONST Tcl_ChannelType *chanTypePtr); /* 561 */
    void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */
    void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */
    void (*tcl_SetChannelError) (Tcl_Channel chan, Tcl_Obj *msg); /* 564 */
    void (*tcl_GetChannelError) (Tcl_Channel chan, Tcl_Obj **msg); /* 565 */
    int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, void *toInit); /* 566 */
    int (*tcl_InitBignumFromDouble) (Tcl_Interp *interp, double initval, mp_int *toInit); /* 566 */
    Tcl_Obj * (*tcl_GetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr); /* 567 */
    int (*tcl_SetNamespaceUnknownHandler) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *handlerPtr); /* 568 */
    int (*tcl_GetEncodingFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Encoding *encodingPtr); /* 569 */
    Tcl_Obj * (*tcl_GetEncodingSearchPath) (void); /* 570 */
    int (*tcl_SetEncodingSearchPath) (Tcl_Obj *searchPath); /* 571 */
    const char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
    int (*tcl_PkgRequireProc) (Tcl_Interp *interp, const char *name, int objc, Tcl_Obj *const objv[], void *clientDataPtr); /* 573 */
    CONST char * (*tcl_GetEncodingNameFromEnvironment) (Tcl_DString *bufPtr); /* 572 */
    int (*tcl_PkgRequireProc) (Tcl_Interp *interp, CONST char *name, int objc, Tcl_Obj *CONST objv[], ClientData *clientDataPtr); /* 573 */
    void (*tcl_AppendObjToErrorInfo) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 574 */
    void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, const char *bytes, size_t length, size_t limit, const char *ellipsis); /* 575 */
    Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, const char *format, int objc, Tcl_Obj *const objv[]); /* 576 */
    int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *format, int objc, Tcl_Obj *const objv[]); /* 577 */
    Tcl_Obj * (*tcl_ObjPrintf) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 578 */
    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, const char *format, ...) TCL_FORMAT_PRINTF(2, 3); /* 579 */
    int (*tcl_CancelEval) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr, void *clientData, int flags); /* 580 */
    int (*tcl_Canceled) (Tcl_Interp *interp, int flags); /* 581 */
    int (*tcl_CreatePipe) (Tcl_Interp *interp, Tcl_Channel *rchan, Tcl_Channel *wchan, int flags); /* 582 */
    Tcl_Command (*tcl_NRCreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 583 */
    int (*tcl_NREvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 584 */
    int (*tcl_NREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 585 */
    int (*tcl_NRCmdSwap) (Tcl_Interp *interp, Tcl_Command cmd, int objc, Tcl_Obj *const objv[], int flags); /* 586 */
    void (*tcl_NRAddCallback) (Tcl_Interp *interp, Tcl_NRPostProc *postProcPtr, void *data0, void *data1, void *data2, void *data3); /* 587 */
    int (*tcl_NRCallObjProc) (Tcl_Interp *interp, Tcl_ObjCmdProc *objProc, void *clientData, int objc, Tcl_Obj *const objv[]); /* 588 */
    unsigned (*tcl_GetFSDeviceFromStat) (const Tcl_StatBuf *statPtr); /* 589 */
    unsigned (*tcl_GetFSInodeFromStat) (const Tcl_StatBuf *statPtr); /* 590 */
    unsigned (*tcl_GetModeFromStat) (const Tcl_StatBuf *statPtr); /* 591 */
    int (*tcl_GetLinkCountFromStat) (const Tcl_StatBuf *statPtr); /* 592 */
    int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */
    int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */
    int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */
    Tcl_WideInt (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
    Tcl_WideInt (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
    Tcl_WideInt (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
    Tcl_WideUInt (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
    Tcl_WideUInt (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */
    unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
    int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
    int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
    int (*tcl_ParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
    int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
    void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
    void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */
    int (*tcl_InterpActive) (Tcl_Interp *interp); /* 608 */
    void (*tcl_BackgroundException) (Tcl_Interp *interp, int code); /* 609 */
    int (*tcl_ZlibDeflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, int level, Tcl_Obj *gzipHeaderDictObj); /* 610 */
    int (*tcl_ZlibInflate) (Tcl_Interp *interp, int format, Tcl_Obj *data, size_t buffersize, Tcl_Obj *gzipHeaderDictObj); /* 611 */
    unsigned int (*tcl_ZlibCRC32) (unsigned int crc, const unsigned char *buf, size_t len); /* 612 */
    unsigned int (*tcl_ZlibAdler32) (unsigned int adler, const unsigned char *buf, size_t len); /* 613 */
    int (*tcl_ZlibStreamInit) (Tcl_Interp *interp, int mode, int format, int level, Tcl_Obj *dictObj, Tcl_ZlibStream *zshandle); /* 614 */
    Tcl_Obj * (*tcl_ZlibStreamGetCommandName) (Tcl_ZlibStream zshandle); /* 615 */
    int (*tcl_ZlibStreamEof) (Tcl_ZlibStream zshandle); /* 616 */
    int (*tcl_ZlibStreamChecksum) (Tcl_ZlibStream zshandle); /* 617 */
    int (*tcl_ZlibStreamPut) (Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush); /* 618 */
    int (*tcl_ZlibStreamGet) (Tcl_ZlibStream zshandle, Tcl_Obj *data, size_t count); /* 619 */
    int (*tcl_ZlibStreamClose) (Tcl_ZlibStream zshandle); /* 620 */
    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 */
    void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
    Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, void *callbackData); /* 631 */
    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
    Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
    int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
    void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 636 */
    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, size_t numBytes); /* 637 */
    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
    void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
    void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
    int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
    int (*tcl_LinkArray) (Tcl_Interp *interp, const char *varName, void *addr, int type, size_t size); /* 644 */
    int (*tcl_GetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t endValue, size_t *indexPtr); /* 645 */
    int (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
    char * (*tcl_UniCharToUtfDString) (const int *uniStr, size_t uniLength, Tcl_DString *dsPtr); /* 647 */
    int * (*tcl_UtfToUniCharDString) (const char *src, size_t length, Tcl_DString *dsPtr); /* 648 */
    void (*tcl_AppendLimitedToObj) (Tcl_Obj *objPtr, CONST char *bytes, int length, int limit, CONST char *ellipsis); /* 575 */
    Tcl_Obj * (*tcl_Format) (Tcl_Interp *interp, CONST char *format, int objc, Tcl_Obj *CONST objv[]); /* 576 */
    int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, int objc, Tcl_Obj *CONST objv[]); /* 577 */
    Tcl_Obj * (*tcl_ObjPrintf) (CONST char *format, ...); /* 578 */
    void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, CONST char *format, ...); /* 579 */
    VOID *reserved580;
    VOID *reserved581;
    VOID *reserved582;
    VOID *reserved583;
    VOID *reserved584;
    VOID *reserved585;
    VOID *reserved586;
    VOID *reserved587;
    VOID *reserved588;
    VOID *reserved589;
    VOID *reserved590;
    VOID *reserved591;
    VOID *reserved592;
    VOID *reserved593;
    VOID *reserved594;
    VOID *reserved595;
    VOID *reserved596;
    VOID *reserved597;
    VOID *reserved598;
    VOID *reserved599;
    VOID *reserved600;
    VOID *reserved601;
    VOID *reserved602;
    VOID *reserved603;
    VOID *reserved604;
    VOID *reserved605;
    VOID *reserved606;
    VOID *reserved607;
    VOID *reserved608;
    VOID *reserved609;
    VOID *reserved610;
    VOID *reserved611;
    VOID *reserved612;
    VOID *reserved613;
    VOID *reserved614;
    VOID *reserved615;
    VOID *reserved616;
    VOID *reserved617;
    VOID *reserved618;
    VOID *reserved619;
    VOID *reserved620;
    VOID *reserved621;
    VOID *reserved622;
    VOID *reserved623;
    VOID *reserved624;
    VOID *reserved625;
    VOID *reserved626;
    VOID *reserved627;
    VOID *reserved628;
    VOID *reserved629;
    VOID *reserved630;
    VOID *reserved631;
    VOID *reserved632;
    VOID *reserved633;
    VOID *reserved634;
    VOID *reserved635;
    VOID *reserved636;
    VOID *reserved637;
    VOID *reserved638;
    VOID *reserved639;
    VOID *reserved640;
    VOID *reserved641;
    VOID *reserved642;
    VOID *reserved643;
    VOID *reserved644;
    VOID *reserved645;
    VOID *reserved646;
    VOID *reserved647;
    VOID *reserved648;
    VOID *reserved649;
    VOID *reserved650;
    VOID *reserved651;
    VOID *reserved652;
    VOID *reserved653;
    VOID *reserved654;
    VOID *reserved655;
    VOID *reserved656;
    VOID *reserved657;
    VOID *reserved658;
    VOID *reserved659;
    VOID *reserved660;
    VOID *reserved661;
    VOID *reserved662;
    VOID *reserved663;
    VOID *reserved664;
    VOID *reserved665;
    VOID *reserved666;
    VOID *reserved667;
    VOID *reserved668;
    VOID *reserved669;
    VOID *reserved670;
    VOID *reserved671;
    VOID *reserved672;
    VOID *reserved673;
    VOID *reserved674;
    VOID *reserved675;
    VOID *reserved676;
    VOID *reserved677;
    VOID *reserved678;
    VOID *reserved679;
    VOID *reserved680;
    VOID *reserved681;
    VOID *reserved682;
    VOID *reserved683;
    VOID *reserved684;
    VOID *reserved685;
    VOID *reserved686;
    void (*tclUnusedStubEntry) (void); /* 687 */
} TclStubs;

extern const TclStubs *tclStubsPtr;
extern TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
 * Inline function declarations:
 */

#ifndef Tcl_PkgProvideEx
#define Tcl_PkgProvideEx \
	(tclStubsPtr->tcl_PkgProvideEx) /* 0 */
#endif
#ifndef Tcl_PkgRequireEx
#define Tcl_PkgRequireEx \
	(tclStubsPtr->tcl_PkgRequireEx) /* 1 */
#endif
#ifndef Tcl_Panic
#define Tcl_Panic \
	(tclStubsPtr->tcl_Panic) /* 2 */
#endif
#ifndef Tcl_Alloc
#define Tcl_Alloc \
	(tclStubsPtr->tcl_Alloc) /* 3 */
#endif
#ifndef Tcl_Free
#define Tcl_Free \
	(tclStubsPtr->tcl_Free) /* 4 */
#endif
#ifndef Tcl_Realloc
#define Tcl_Realloc \
	(tclStubsPtr->tcl_Realloc) /* 5 */
#endif
#ifndef Tcl_DbCkalloc
#define Tcl_DbCkalloc \
	(tclStubsPtr->tcl_DbCkalloc) /* 6 */
#endif
#ifndef Tcl_DbCkfree
#define Tcl_DbCkfree \
	(tclStubsPtr->tcl_DbCkfree) /* 7 */
#endif
#ifndef Tcl_DbCkrealloc
#define Tcl_DbCkrealloc \
	(tclStubsPtr->tcl_DbCkrealloc) /* 8 */
#endif
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_CreateFileHandler
#define Tcl_CreateFileHandler \
	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef Tcl_CreateFileHandler
#define Tcl_CreateFileHandler \
	(tclStubsPtr->tcl_CreateFileHandler) /* 9 */
#endif
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_DeleteFileHandler
#define Tcl_DeleteFileHandler \
	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef Tcl_DeleteFileHandler
#define Tcl_DeleteFileHandler \
	(tclStubsPtr->tcl_DeleteFileHandler) /* 10 */
#endif
#endif /* MACOSX */
#ifndef Tcl_SetTimer
#define Tcl_SetTimer \
	(tclStubsPtr->tcl_SetTimer) /* 11 */
#endif
#ifndef Tcl_Sleep
#define Tcl_Sleep \
	(tclStubsPtr->tcl_Sleep) /* 12 */
#endif
#ifndef Tcl_WaitForEvent
#define Tcl_WaitForEvent \
	(tclStubsPtr->tcl_WaitForEvent) /* 13 */
#endif
#ifndef Tcl_AppendAllObjTypes
#define Tcl_AppendAllObjTypes \
	(tclStubsPtr->tcl_AppendAllObjTypes) /* 14 */
#endif
#ifndef Tcl_AppendStringsToObj
#define Tcl_AppendStringsToObj \
	(tclStubsPtr->tcl_AppendStringsToObj) /* 15 */
#endif
#ifndef Tcl_AppendToObj
#define Tcl_AppendToObj \
	(tclStubsPtr->tcl_AppendToObj) /* 16 */
#endif
#ifndef Tcl_ConcatObj
#define Tcl_ConcatObj \
	(tclStubsPtr->tcl_ConcatObj) /* 17 */
#endif
#ifndef Tcl_ConvertToType
#define Tcl_ConvertToType \
	(tclStubsPtr->tcl_ConvertToType) /* 18 */
#endif
#ifndef Tcl_DbDecrRefCount
#define Tcl_DbDecrRefCount \
	(tclStubsPtr->tcl_DbDecrRefCount) /* 19 */
#endif
#ifndef Tcl_DbIncrRefCount
#define Tcl_DbIncrRefCount \
	(tclStubsPtr->tcl_DbIncrRefCount) /* 20 */
#endif
#ifndef Tcl_DbIsShared
#define Tcl_DbIsShared \
	(tclStubsPtr->tcl_DbIsShared) /* 21 */
/* Slot 22 is reserved */
#endif
#ifndef Tcl_DbNewBooleanObj
#define Tcl_DbNewBooleanObj \
	(tclStubsPtr->tcl_DbNewBooleanObj) /* 22 */
#endif
#ifndef Tcl_DbNewByteArrayObj
#define Tcl_DbNewByteArrayObj \
	(tclStubsPtr->tcl_DbNewByteArrayObj) /* 23 */
#endif
#ifndef Tcl_DbNewDoubleObj
#define Tcl_DbNewDoubleObj \
	(tclStubsPtr->tcl_DbNewDoubleObj) /* 24 */
#endif
#ifndef Tcl_DbNewListObj
#define Tcl_DbNewListObj \
	(tclStubsPtr->tcl_DbNewListObj) /* 25 */
/* Slot 26 is reserved */
#endif
#ifndef Tcl_DbNewLongObj
#define Tcl_DbNewLongObj \
	(tclStubsPtr->tcl_DbNewLongObj) /* 26 */
#endif
#ifndef Tcl_DbNewObj
#define Tcl_DbNewObj \
	(tclStubsPtr->tcl_DbNewObj) /* 27 */
#endif
#ifndef Tcl_DbNewStringObj
#define Tcl_DbNewStringObj \
	(tclStubsPtr->tcl_DbNewStringObj) /* 28 */
#endif
#ifndef Tcl_DuplicateObj
#define Tcl_DuplicateObj \
	(tclStubsPtr->tcl_DuplicateObj) /* 29 */
#endif
#ifndef TclFreeObj
#define TclFreeObj \
	(tclStubsPtr->tclFreeObj) /* 30 */
#endif
#ifndef Tcl_GetBoolean
#define Tcl_GetBoolean \
	(tclStubsPtr->tcl_GetBoolean) /* 31 */
#endif
#ifndef Tcl_GetBooleanFromObj
#define Tcl_GetBooleanFromObj \
	(tclStubsPtr->tcl_GetBooleanFromObj) /* 32 */
#endif
#ifndef Tcl_GetByteArrayFromObj
#define Tcl_GetByteArrayFromObj \
	(tclStubsPtr->tcl_GetByteArrayFromObj) /* 33 */
#endif
#ifndef Tcl_GetDouble
#define Tcl_GetDouble \
	(tclStubsPtr->tcl_GetDouble) /* 34 */
#endif
#ifndef Tcl_GetDoubleFromObj
#define Tcl_GetDoubleFromObj \
	(tclStubsPtr->tcl_GetDoubleFromObj) /* 35 */
/* Slot 36 is reserved */
#endif
#ifndef Tcl_GetIndexFromObj
#define Tcl_GetIndexFromObj \
	(tclStubsPtr->tcl_GetIndexFromObj) /* 36 */
#endif
#ifndef Tcl_GetInt
#define Tcl_GetInt \
	(tclStubsPtr->tcl_GetInt) /* 37 */
#endif
#ifndef Tcl_GetIntFromObj
#define Tcl_GetIntFromObj \
	(tclStubsPtr->tcl_GetIntFromObj) /* 38 */
#endif
#ifndef Tcl_GetLongFromObj
#define Tcl_GetLongFromObj \
	(tclStubsPtr->tcl_GetLongFromObj) /* 39 */
#endif
#ifndef Tcl_GetObjType
#define Tcl_GetObjType \
	(tclStubsPtr->tcl_GetObjType) /* 40 */
#endif
#ifndef Tcl_GetStringFromObj
#define Tcl_GetStringFromObj \
	(tclStubsPtr->tcl_GetStringFromObj) /* 41 */
#endif
#ifndef Tcl_InvalidateStringRep
#define Tcl_InvalidateStringRep \
	(tclStubsPtr->tcl_InvalidateStringRep) /* 42 */
#endif
#ifndef Tcl_ListObjAppendList
#define Tcl_ListObjAppendList \
	(tclStubsPtr->tcl_ListObjAppendList) /* 43 */
#endif
#ifndef Tcl_ListObjAppendElement
#define Tcl_ListObjAppendElement \
	(tclStubsPtr->tcl_ListObjAppendElement) /* 44 */
#endif
#ifndef Tcl_ListObjGetElements
#define Tcl_ListObjGetElements \
	(tclStubsPtr->tcl_ListObjGetElements) /* 45 */
#endif
#ifndef Tcl_ListObjIndex
#define Tcl_ListObjIndex \
	(tclStubsPtr->tcl_ListObjIndex) /* 46 */
#endif
#ifndef Tcl_ListObjLength
#define Tcl_ListObjLength \
	(tclStubsPtr->tcl_ListObjLength) /* 47 */
#endif
#ifndef Tcl_ListObjReplace
#define Tcl_ListObjReplace \
	(tclStubsPtr->tcl_ListObjReplace) /* 48 */
/* Slot 49 is reserved */
#endif
#ifndef Tcl_NewBooleanObj
#define Tcl_NewBooleanObj \
	(tclStubsPtr->tcl_NewBooleanObj) /* 49 */
#endif
#ifndef Tcl_NewByteArrayObj
#define Tcl_NewByteArrayObj \
	(tclStubsPtr->tcl_NewByteArrayObj) /* 50 */
#endif
#ifndef Tcl_NewDoubleObj
#define Tcl_NewDoubleObj \
	(tclStubsPtr->tcl_NewDoubleObj) /* 51 */
#endif
#ifndef Tcl_NewIntObj
#define Tcl_NewIntObj \
/* Slot 52 is reserved */
	(tclStubsPtr->tcl_NewIntObj) /* 52 */
#endif
#ifndef Tcl_NewListObj
#define Tcl_NewListObj \
	(tclStubsPtr->tcl_NewListObj) /* 53 */
#endif
#ifndef Tcl_NewLongObj
#define Tcl_NewLongObj \
/* Slot 54 is reserved */
	(tclStubsPtr->tcl_NewLongObj) /* 54 */
#endif
#ifndef Tcl_NewObj
#define Tcl_NewObj \
	(tclStubsPtr->tcl_NewObj) /* 55 */
#endif
#ifndef Tcl_NewStringObj
#define Tcl_NewStringObj \
	(tclStubsPtr->tcl_NewStringObj) /* 56 */
/* Slot 57 is reserved */
#endif
#ifndef Tcl_SetBooleanObj
#define Tcl_SetBooleanObj \
	(tclStubsPtr->tcl_SetBooleanObj) /* 57 */
#endif
#ifndef Tcl_SetByteArrayLength
#define Tcl_SetByteArrayLength \
	(tclStubsPtr->tcl_SetByteArrayLength) /* 58 */
#endif
#ifndef Tcl_SetByteArrayObj
#define Tcl_SetByteArrayObj \
	(tclStubsPtr->tcl_SetByteArrayObj) /* 59 */
#endif
#ifndef Tcl_SetDoubleObj
#define Tcl_SetDoubleObj \
	(tclStubsPtr->tcl_SetDoubleObj) /* 60 */
#endif
#ifndef Tcl_SetIntObj
#define Tcl_SetIntObj \
/* Slot 61 is reserved */
	(tclStubsPtr->tcl_SetIntObj) /* 61 */
#endif
#ifndef Tcl_SetListObj
#define Tcl_SetListObj \
	(tclStubsPtr->tcl_SetListObj) /* 62 */
#endif
#ifndef Tcl_SetLongObj
#define Tcl_SetLongObj \
/* Slot 63 is reserved */
	(tclStubsPtr->tcl_SetLongObj) /* 63 */
#endif
#ifndef Tcl_SetObjLength
#define Tcl_SetObjLength \
	(tclStubsPtr->tcl_SetObjLength) /* 64 */
#endif
#ifndef Tcl_SetStringObj
#define Tcl_SetStringObj \
	(tclStubsPtr->tcl_SetStringObj) /* 65 */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
#endif
#ifndef Tcl_AddErrorInfo
#define Tcl_AddErrorInfo \
	(tclStubsPtr->tcl_AddErrorInfo) /* 66 */
#endif
#ifndef Tcl_AddObjErrorInfo
#define Tcl_AddObjErrorInfo \
	(tclStubsPtr->tcl_AddObjErrorInfo) /* 67 */
#endif
#ifndef Tcl_AllowExceptions
#define Tcl_AllowExceptions \
	(tclStubsPtr->tcl_AllowExceptions) /* 68 */
#endif
#ifndef Tcl_AppendElement
#define Tcl_AppendElement \
	(tclStubsPtr->tcl_AppendElement) /* 69 */
#endif
#ifndef Tcl_AppendResult
#define Tcl_AppendResult \
	(tclStubsPtr->tcl_AppendResult) /* 70 */
#endif
#ifndef Tcl_AsyncCreate
#define Tcl_AsyncCreate \
	(tclStubsPtr->tcl_AsyncCreate) /* 71 */
#endif
#ifndef Tcl_AsyncDelete
#define Tcl_AsyncDelete \
	(tclStubsPtr->tcl_AsyncDelete) /* 72 */
#endif
#ifndef Tcl_AsyncInvoke
#define Tcl_AsyncInvoke \
	(tclStubsPtr->tcl_AsyncInvoke) /* 73 */
#endif
#ifndef Tcl_AsyncMark
#define Tcl_AsyncMark \
	(tclStubsPtr->tcl_AsyncMark) /* 74 */
#endif
#ifndef Tcl_AsyncReady
#define Tcl_AsyncReady \
	(tclStubsPtr->tcl_AsyncReady) /* 75 */
#endif
#ifndef Tcl_BackgroundError
#define Tcl_BackgroundError \
	(tclStubsPtr->tcl_BackgroundError) /* 76 */
#endif
#ifndef Tcl_Backslash
#define Tcl_Backslash \
/* Slot 76 is reserved */
	(tclStubsPtr->tcl_Backslash) /* 77 */
/* Slot 77 is reserved */
#endif
#ifndef Tcl_BadChannelOption
#define Tcl_BadChannelOption \
	(tclStubsPtr->tcl_BadChannelOption) /* 78 */
#endif
#ifndef Tcl_CallWhenDeleted
#define Tcl_CallWhenDeleted \
	(tclStubsPtr->tcl_CallWhenDeleted) /* 79 */
#endif
#ifndef Tcl_CancelIdleCall
#define Tcl_CancelIdleCall \
	(tclStubsPtr->tcl_CancelIdleCall) /* 80 */
#endif
/* Slot 81 is reserved */
#ifndef Tcl_Close
#define Tcl_Close \
	(tclStubsPtr->tcl_Close) /* 81 */
#endif
#ifndef Tcl_CommandComplete
#define Tcl_CommandComplete \
	(tclStubsPtr->tcl_CommandComplete) /* 82 */
#endif
#ifndef Tcl_Concat
#define Tcl_Concat \
	(tclStubsPtr->tcl_Concat) /* 83 */
#endif
#ifndef Tcl_ConvertElement
#define Tcl_ConvertElement \
	(tclStubsPtr->tcl_ConvertElement) /* 84 */
#endif
#ifndef Tcl_ConvertCountedElement
#define Tcl_ConvertCountedElement \
	(tclStubsPtr->tcl_ConvertCountedElement) /* 85 */
#endif
#ifndef Tcl_CreateAlias
#define Tcl_CreateAlias \
	(tclStubsPtr->tcl_CreateAlias) /* 86 */
#endif
#ifndef Tcl_CreateAliasObj
#define Tcl_CreateAliasObj \
	(tclStubsPtr->tcl_CreateAliasObj) /* 87 */
#endif
#ifndef Tcl_CreateChannel
#define Tcl_CreateChannel \
	(tclStubsPtr->tcl_CreateChannel) /* 88 */
#endif
#ifndef Tcl_CreateChannelHandler
#define Tcl_CreateChannelHandler \
	(tclStubsPtr->tcl_CreateChannelHandler) /* 89 */
#endif
#ifndef Tcl_CreateCloseHandler
#define Tcl_CreateCloseHandler \
	(tclStubsPtr->tcl_CreateCloseHandler) /* 90 */
#endif
#ifndef Tcl_CreateCommand
#define Tcl_CreateCommand \
	(tclStubsPtr->tcl_CreateCommand) /* 91 */
#endif
#ifndef Tcl_CreateEventSource
#define Tcl_CreateEventSource \
	(tclStubsPtr->tcl_CreateEventSource) /* 92 */
#endif
#ifndef Tcl_CreateExitHandler
#define Tcl_CreateExitHandler \
	(tclStubsPtr->tcl_CreateExitHandler) /* 93 */
#endif
#ifndef Tcl_CreateInterp
#define Tcl_CreateInterp \
	(tclStubsPtr->tcl_CreateInterp) /* 94 */
/* Slot 95 is reserved */
#endif
#ifndef Tcl_CreateMathFunc
#define Tcl_CreateMathFunc \
	(tclStubsPtr->tcl_CreateMathFunc) /* 95 */
#endif
#ifndef Tcl_CreateObjCommand
#define Tcl_CreateObjCommand \
	(tclStubsPtr->tcl_CreateObjCommand) /* 96 */
#endif
#ifndef Tcl_CreateSlave
#define Tcl_CreateChild \
	(tclStubsPtr->tcl_CreateChild) /* 97 */
#define Tcl_CreateSlave \
	(tclStubsPtr->tcl_CreateSlave) /* 97 */
#endif
#ifndef Tcl_CreateTimerHandler
#define Tcl_CreateTimerHandler \
	(tclStubsPtr->tcl_CreateTimerHandler) /* 98 */
#endif
#ifndef Tcl_CreateTrace
#define Tcl_CreateTrace \
	(tclStubsPtr->tcl_CreateTrace) /* 99 */
#endif
#ifndef Tcl_DeleteAssocData
#define Tcl_DeleteAssocData \
	(tclStubsPtr->tcl_DeleteAssocData) /* 100 */
#endif
#ifndef Tcl_DeleteChannelHandler
#define Tcl_DeleteChannelHandler \
	(tclStubsPtr->tcl_DeleteChannelHandler) /* 101 */
#endif
#ifndef Tcl_DeleteCloseHandler
#define Tcl_DeleteCloseHandler \
	(tclStubsPtr->tcl_DeleteCloseHandler) /* 102 */
#endif
#ifndef Tcl_DeleteCommand
#define Tcl_DeleteCommand \
	(tclStubsPtr->tcl_DeleteCommand) /* 103 */
#endif
#ifndef Tcl_DeleteCommandFromToken
#define Tcl_DeleteCommandFromToken \
	(tclStubsPtr->tcl_DeleteCommandFromToken) /* 104 */
#endif
#ifndef Tcl_DeleteEvents
#define Tcl_DeleteEvents \
	(tclStubsPtr->tcl_DeleteEvents) /* 105 */
#endif
#ifndef Tcl_DeleteEventSource
#define Tcl_DeleteEventSource \
	(tclStubsPtr->tcl_DeleteEventSource) /* 106 */
#endif
#ifndef Tcl_DeleteExitHandler
#define Tcl_DeleteExitHandler \
	(tclStubsPtr->tcl_DeleteExitHandler) /* 107 */
#endif
#ifndef Tcl_DeleteHashEntry
#define Tcl_DeleteHashEntry \
	(tclStubsPtr->tcl_DeleteHashEntry) /* 108 */
#endif
#ifndef Tcl_DeleteHashTable
#define Tcl_DeleteHashTable \
	(tclStubsPtr->tcl_DeleteHashTable) /* 109 */
#endif
#ifndef Tcl_DeleteInterp
#define Tcl_DeleteInterp \
	(tclStubsPtr->tcl_DeleteInterp) /* 110 */
#endif
#ifndef Tcl_DetachPids
#define Tcl_DetachPids \
	(tclStubsPtr->tcl_DetachPids) /* 111 */
#endif
#ifndef Tcl_DeleteTimerHandler
#define Tcl_DeleteTimerHandler \
	(tclStubsPtr->tcl_DeleteTimerHandler) /* 112 */
#endif
#ifndef Tcl_DeleteTrace
#define Tcl_DeleteTrace \
	(tclStubsPtr->tcl_DeleteTrace) /* 113 */
#endif
#ifndef Tcl_DontCallWhenDeleted
#define Tcl_DontCallWhenDeleted \
	(tclStubsPtr->tcl_DontCallWhenDeleted) /* 114 */
#endif
#ifndef Tcl_DoOneEvent
#define Tcl_DoOneEvent \
	(tclStubsPtr->tcl_DoOneEvent) /* 115 */
#endif
#ifndef Tcl_DoWhenIdle
#define Tcl_DoWhenIdle \
	(tclStubsPtr->tcl_DoWhenIdle) /* 116 */
#endif
#ifndef Tcl_DStringAppend
#define Tcl_DStringAppend \
	(tclStubsPtr->tcl_DStringAppend) /* 117 */
#endif
#ifndef Tcl_DStringAppendElement
#define Tcl_DStringAppendElement \
	(tclStubsPtr->tcl_DStringAppendElement) /* 118 */
#endif
#ifndef Tcl_DStringEndSublist
#define Tcl_DStringEndSublist \
	(tclStubsPtr->tcl_DStringEndSublist) /* 119 */
#endif
#ifndef Tcl_DStringFree
#define Tcl_DStringFree \
	(tclStubsPtr->tcl_DStringFree) /* 120 */
#endif
#ifndef Tcl_DStringGetResult
#define Tcl_DStringGetResult \
	(tclStubsPtr->tcl_DStringGetResult) /* 121 */
#endif
#ifndef Tcl_DStringInit
#define Tcl_DStringInit \
	(tclStubsPtr->tcl_DStringInit) /* 122 */
#endif
#ifndef Tcl_DStringResult
#define Tcl_DStringResult \
	(tclStubsPtr->tcl_DStringResult) /* 123 */
#endif
#ifndef Tcl_DStringSetLength
#define Tcl_DStringSetLength \
	(tclStubsPtr->tcl_DStringSetLength) /* 124 */
#endif
#ifndef Tcl_DStringStartSublist
#define Tcl_DStringStartSublist \
	(tclStubsPtr->tcl_DStringStartSublist) /* 125 */
#endif
#ifndef Tcl_Eof
#define Tcl_Eof \
	(tclStubsPtr->tcl_Eof) /* 126 */
#endif
#ifndef Tcl_ErrnoId
#define Tcl_ErrnoId \
	(tclStubsPtr->tcl_ErrnoId) /* 127 */
#endif
#ifndef Tcl_ErrnoMsg
#define Tcl_ErrnoMsg \
	(tclStubsPtr->tcl_ErrnoMsg) /* 128 */
#endif
#ifndef Tcl_Eval
#define Tcl_Eval \
/* Slot 129 is reserved */
	(tclStubsPtr->tcl_Eval) /* 129 */
#endif
#ifndef Tcl_EvalFile
#define Tcl_EvalFile \
	(tclStubsPtr->tcl_EvalFile) /* 130 */
#endif
#ifndef Tcl_EvalObj
#define Tcl_EvalObj \
/* Slot 131 is reserved */
	(tclStubsPtr->tcl_EvalObj) /* 131 */
#endif
#ifndef Tcl_EventuallyFree
#define Tcl_EventuallyFree \
	(tclStubsPtr->tcl_EventuallyFree) /* 132 */
#endif
#ifndef Tcl_Exit
#define Tcl_Exit \
	(tclStubsPtr->tcl_Exit) /* 133 */
#endif
#ifndef Tcl_ExposeCommand
#define Tcl_ExposeCommand \
	(tclStubsPtr->tcl_ExposeCommand) /* 134 */
#endif
#ifndef Tcl_ExprBoolean
#define Tcl_ExprBoolean \
	(tclStubsPtr->tcl_ExprBoolean) /* 135 */
#endif
#ifndef Tcl_ExprBooleanObj
#define Tcl_ExprBooleanObj \
	(tclStubsPtr->tcl_ExprBooleanObj) /* 136 */
#endif
#ifndef Tcl_ExprDouble
#define Tcl_ExprDouble \
	(tclStubsPtr->tcl_ExprDouble) /* 137 */
#endif
#ifndef Tcl_ExprDoubleObj
#define Tcl_ExprDoubleObj \
	(tclStubsPtr->tcl_ExprDoubleObj) /* 138 */
#endif
#ifndef Tcl_ExprLong
#define Tcl_ExprLong \
	(tclStubsPtr->tcl_ExprLong) /* 139 */
#endif
#ifndef Tcl_ExprLongObj
#define Tcl_ExprLongObj \
	(tclStubsPtr->tcl_ExprLongObj) /* 140 */
#endif
#ifndef Tcl_ExprObj
#define Tcl_ExprObj \
	(tclStubsPtr->tcl_ExprObj) /* 141 */
#endif
#ifndef Tcl_ExprString
#define Tcl_ExprString \
	(tclStubsPtr->tcl_ExprString) /* 142 */
#endif
#ifndef Tcl_Finalize
#define Tcl_Finalize \
	(tclStubsPtr->tcl_Finalize) /* 143 */
#endif
#ifndef Tcl_FindExecutable
#define Tcl_FindExecutable \
/* Slot 144 is reserved */
	(tclStubsPtr->tcl_FindExecutable) /* 144 */
#endif
#ifndef Tcl_FirstHashEntry
#define Tcl_FirstHashEntry \
	(tclStubsPtr->tcl_FirstHashEntry) /* 145 */
#endif
#ifndef Tcl_Flush
#define Tcl_Flush \
	(tclStubsPtr->tcl_Flush) /* 146 */
#endif
#ifndef Tcl_FreeResult
#define Tcl_FreeResult \
/* Slot 147 is reserved */
	(tclStubsPtr->tcl_FreeResult) /* 147 */
#endif
#ifndef Tcl_GetAlias
#define Tcl_GetAlias \
	(tclStubsPtr->tcl_GetAlias) /* 148 */
#endif
#ifndef Tcl_GetAliasObj
#define Tcl_GetAliasObj \
	(tclStubsPtr->tcl_GetAliasObj) /* 149 */
#endif
#ifndef Tcl_GetAssocData
#define Tcl_GetAssocData \
	(tclStubsPtr->tcl_GetAssocData) /* 150 */
#endif
#ifndef Tcl_GetChannel
#define Tcl_GetChannel \
	(tclStubsPtr->tcl_GetChannel) /* 151 */
#endif
#ifndef Tcl_GetChannelBufferSize
#define Tcl_GetChannelBufferSize \
	(tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */
#endif
#ifndef Tcl_GetChannelHandle
#define Tcl_GetChannelHandle \
	(tclStubsPtr->tcl_GetChannelHandle) /* 153 */
#endif
#ifndef Tcl_GetChannelInstanceData
#define Tcl_GetChannelInstanceData \
	(tclStubsPtr->tcl_GetChannelInstanceData) /* 154 */
#endif
#ifndef Tcl_GetChannelMode
#define Tcl_GetChannelMode \
	(tclStubsPtr->tcl_GetChannelMode) /* 155 */
#endif
#ifndef Tcl_GetChannelName
#define Tcl_GetChannelName \
	(tclStubsPtr->tcl_GetChannelName) /* 156 */
#endif
#ifndef Tcl_GetChannelOption
#define Tcl_GetChannelOption \
	(tclStubsPtr->tcl_GetChannelOption) /* 157 */
#endif
#ifndef Tcl_GetChannelType
#define Tcl_GetChannelType \
	(tclStubsPtr->tcl_GetChannelType) /* 158 */
#endif
#ifndef Tcl_GetCommandInfo
#define Tcl_GetCommandInfo \
	(tclStubsPtr->tcl_GetCommandInfo) /* 159 */
#endif
#ifndef Tcl_GetCommandName
#define Tcl_GetCommandName \
	(tclStubsPtr->tcl_GetCommandName) /* 160 */
#endif
#ifndef Tcl_GetErrno
#define Tcl_GetErrno \
	(tclStubsPtr->tcl_GetErrno) /* 161 */
#endif
#ifndef Tcl_GetHostName
#define Tcl_GetHostName \
	(tclStubsPtr->tcl_GetHostName) /* 162 */
#endif
#ifndef Tcl_GetInterpPath
#define Tcl_GetInterpPath \
	(tclStubsPtr->tcl_GetInterpPath) /* 163 */
#endif
#ifndef Tcl_GetMaster
#define Tcl_GetParent \
	(tclStubsPtr->tcl_GetParent) /* 164 */
#define Tcl_GetMaster \
	(tclStubsPtr->tcl_GetMaster) /* 164 */
#endif
#ifndef Tcl_GetNameOfExecutable
#define Tcl_GetNameOfExecutable \
	(tclStubsPtr->tcl_GetNameOfExecutable) /* 165 */
#endif
#ifndef Tcl_GetObjResult
#define Tcl_GetObjResult \
	(tclStubsPtr->tcl_GetObjResult) /* 166 */
#endif
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef Tcl_GetOpenFile
#define Tcl_GetOpenFile \
	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif
#endif /* UNIX */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef Tcl_GetOpenFile
#define Tcl_GetOpenFile \
	(tclStubsPtr->tcl_GetOpenFile) /* 167 */
#endif
#endif /* MACOSX */
#ifndef Tcl_GetPathType
#define Tcl_GetPathType \
	(tclStubsPtr->tcl_GetPathType) /* 168 */
#endif
#ifndef Tcl_Gets
#define Tcl_Gets \
	(tclStubsPtr->tcl_Gets) /* 169 */
#endif
#ifndef Tcl_GetsObj
#define Tcl_GetsObj \
	(tclStubsPtr->tcl_GetsObj) /* 170 */
#endif
#ifndef Tcl_GetServiceMode
#define Tcl_GetServiceMode \
	(tclStubsPtr->tcl_GetServiceMode) /* 171 */
#endif
#ifndef Tcl_GetSlave
#define Tcl_GetChild \
	(tclStubsPtr->tcl_GetChild) /* 172 */
#define Tcl_GetSlave \
	(tclStubsPtr->tcl_GetSlave) /* 172 */
#endif
#ifndef Tcl_GetStdChannel
#define Tcl_GetStdChannel \
	(tclStubsPtr->tcl_GetStdChannel) /* 173 */
#endif
#ifndef Tcl_GetStringResult
#define Tcl_GetStringResult \
/* Slot 174 is reserved */
/* Slot 175 is reserved */
	(tclStubsPtr->tcl_GetStringResult) /* 174 */
#endif
#ifndef Tcl_GetVar
#define Tcl_GetVar \
	(tclStubsPtr->tcl_GetVar) /* 175 */
#endif
#ifndef Tcl_GetVar2
#define Tcl_GetVar2 \
	(tclStubsPtr->tcl_GetVar2) /* 176 */
#endif
#ifndef Tcl_GlobalEval
#define Tcl_GlobalEval \
/* Slot 177 is reserved */
/* Slot 178 is reserved */
	(tclStubsPtr->tcl_GlobalEval) /* 177 */
#endif
#ifndef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj \
	(tclStubsPtr->tcl_GlobalEvalObj) /* 178 */
#endif
#ifndef Tcl_HideCommand
#define Tcl_HideCommand \
	(tclStubsPtr->tcl_HideCommand) /* 179 */
#endif
#ifndef Tcl_Init
#define Tcl_Init \
	(tclStubsPtr->tcl_Init) /* 180 */
#endif
#ifndef Tcl_InitHashTable
#define Tcl_InitHashTable \
	(tclStubsPtr->tcl_InitHashTable) /* 181 */
#endif
#ifndef Tcl_InputBlocked
#define Tcl_InputBlocked \
	(tclStubsPtr->tcl_InputBlocked) /* 182 */
#endif
#ifndef Tcl_InputBuffered
#define Tcl_InputBuffered \
	(tclStubsPtr->tcl_InputBuffered) /* 183 */
#endif
#ifndef Tcl_InterpDeleted
#define Tcl_InterpDeleted \
	(tclStubsPtr->tcl_InterpDeleted) /* 184 */
#endif
#ifndef Tcl_IsSafe
#define Tcl_IsSafe \
	(tclStubsPtr->tcl_IsSafe) /* 185 */
#endif
#ifndef Tcl_JoinPath
#define Tcl_JoinPath \
	(tclStubsPtr->tcl_JoinPath) /* 186 */
#endif
#ifndef Tcl_LinkVar
#define Tcl_LinkVar \
	(tclStubsPtr->tcl_LinkVar) /* 187 */
#endif
/* Slot 188 is reserved */
#ifndef Tcl_MakeFileChannel
#define Tcl_MakeFileChannel \
	(tclStubsPtr->tcl_MakeFileChannel) /* 189 */
#endif
#ifndef Tcl_MakeSafe
#define Tcl_MakeSafe \
	(tclStubsPtr->tcl_MakeSafe) /* 190 */
#endif
#ifndef Tcl_MakeTcpClientChannel
#define Tcl_MakeTcpClientChannel \
	(tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */
#endif
#ifndef Tcl_Merge
#define Tcl_Merge \
	(tclStubsPtr->tcl_Merge) /* 192 */
#endif
#ifndef Tcl_NextHashEntry
#define Tcl_NextHashEntry \
	(tclStubsPtr->tcl_NextHashEntry) /* 193 */
#endif
#ifndef Tcl_NotifyChannel
#define Tcl_NotifyChannel \
	(tclStubsPtr->tcl_NotifyChannel) /* 194 */
#endif
#ifndef Tcl_ObjGetVar2
#define Tcl_ObjGetVar2 \
	(tclStubsPtr->tcl_ObjGetVar2) /* 195 */
#endif
#ifndef Tcl_ObjSetVar2
#define Tcl_ObjSetVar2 \
	(tclStubsPtr->tcl_ObjSetVar2) /* 196 */
#endif
#ifndef Tcl_OpenCommandChannel
#define Tcl_OpenCommandChannel \
	(tclStubsPtr->tcl_OpenCommandChannel) /* 197 */
#endif
#ifndef Tcl_OpenFileChannel
#define Tcl_OpenFileChannel \
	(tclStubsPtr->tcl_OpenFileChannel) /* 198 */
#endif
#ifndef Tcl_OpenTcpClient
#define Tcl_OpenTcpClient \
	(tclStubsPtr->tcl_OpenTcpClient) /* 199 */
#endif
#ifndef Tcl_OpenTcpServer
#define Tcl_OpenTcpServer \
	(tclStubsPtr->tcl_OpenTcpServer) /* 200 */
#endif
#ifndef Tcl_Preserve
#define Tcl_Preserve \
	(tclStubsPtr->tcl_Preserve) /* 201 */
#endif
#ifndef Tcl_PrintDouble
#define Tcl_PrintDouble \
	(tclStubsPtr->tcl_PrintDouble) /* 202 */
#endif
#ifndef Tcl_PutEnv
#define Tcl_PutEnv \
	(tclStubsPtr->tcl_PutEnv) /* 203 */
#endif
#ifndef Tcl_PosixError
#define Tcl_PosixError \
	(tclStubsPtr->tcl_PosixError) /* 204 */
#endif
#ifndef Tcl_QueueEvent
#define Tcl_QueueEvent \
	(tclStubsPtr->tcl_QueueEvent) /* 205 */
#endif
#ifndef Tcl_Read
#define Tcl_Read \
	(tclStubsPtr->tcl_Read) /* 206 */
#endif
#ifndef Tcl_ReapDetachedProcs
#define Tcl_ReapDetachedProcs \
	(tclStubsPtr->tcl_ReapDetachedProcs) /* 207 */
#endif
#ifndef Tcl_RecordAndEval
#define Tcl_RecordAndEval \
	(tclStubsPtr->tcl_RecordAndEval) /* 208 */
#endif
#ifndef Tcl_RecordAndEvalObj
#define Tcl_RecordAndEvalObj \
	(tclStubsPtr->tcl_RecordAndEvalObj) /* 209 */
#endif
#ifndef Tcl_RegisterChannel
#define Tcl_RegisterChannel \
	(tclStubsPtr->tcl_RegisterChannel) /* 210 */
#endif
#ifndef Tcl_RegisterObjType
#define Tcl_RegisterObjType \
	(tclStubsPtr->tcl_RegisterObjType) /* 211 */
#endif
#ifndef Tcl_RegExpCompile
#define Tcl_RegExpCompile \
	(tclStubsPtr->tcl_RegExpCompile) /* 212 */
#endif
#ifndef Tcl_RegExpExec
#define Tcl_RegExpExec \
	(tclStubsPtr->tcl_RegExpExec) /* 213 */
#endif
#ifndef Tcl_RegExpMatch
#define Tcl_RegExpMatch \
	(tclStubsPtr->tcl_RegExpMatch) /* 214 */
#endif
#ifndef Tcl_RegExpRange
#define Tcl_RegExpRange \
	(tclStubsPtr->tcl_RegExpRange) /* 215 */
#endif
#ifndef Tcl_Release
#define Tcl_Release \
	(tclStubsPtr->tcl_Release) /* 216 */
#endif
#ifndef Tcl_ResetResult
#define Tcl_ResetResult \
	(tclStubsPtr->tcl_ResetResult) /* 217 */
#endif
#ifndef Tcl_ScanElement
#define Tcl_ScanElement \
	(tclStubsPtr->tcl_ScanElement) /* 218 */
#endif
#ifndef Tcl_ScanCountedElement
#define Tcl_ScanCountedElement \
	(tclStubsPtr->tcl_ScanCountedElement) /* 219 */
#endif
#ifndef Tcl_SeekOld
#define Tcl_SeekOld \
/* Slot 220 is reserved */
	(tclStubsPtr->tcl_SeekOld) /* 220 */
#endif
#ifndef Tcl_ServiceAll
#define Tcl_ServiceAll \
	(tclStubsPtr->tcl_ServiceAll) /* 221 */
#endif
#ifndef Tcl_ServiceEvent
#define Tcl_ServiceEvent \
	(tclStubsPtr->tcl_ServiceEvent) /* 222 */
#endif
#ifndef Tcl_SetAssocData
#define Tcl_SetAssocData \
	(tclStubsPtr->tcl_SetAssocData) /* 223 */
#endif
#ifndef Tcl_SetChannelBufferSize
#define Tcl_SetChannelBufferSize \
	(tclStubsPtr->tcl_SetChannelBufferSize) /* 224 */
#endif
#ifndef Tcl_SetChannelOption
#define Tcl_SetChannelOption \
	(tclStubsPtr->tcl_SetChannelOption) /* 225 */
#endif
#ifndef Tcl_SetCommandInfo
#define Tcl_SetCommandInfo \
	(tclStubsPtr->tcl_SetCommandInfo) /* 226 */
#endif
#ifndef Tcl_SetErrno
#define Tcl_SetErrno \
	(tclStubsPtr->tcl_SetErrno) /* 227 */
#endif
#ifndef Tcl_SetErrorCode
#define Tcl_SetErrorCode \
	(tclStubsPtr->tcl_SetErrorCode) /* 228 */
#endif
#ifndef Tcl_SetMaxBlockTime
#define Tcl_SetMaxBlockTime \
	(tclStubsPtr->tcl_SetMaxBlockTime) /* 229 */
#endif
#ifndef Tcl_SetPanicProc
#define Tcl_SetPanicProc \
/* Slot 230 is reserved */
	(tclStubsPtr->tcl_SetPanicProc) /* 230 */
#endif
#ifndef Tcl_SetRecursionLimit
#define Tcl_SetRecursionLimit \
	(tclStubsPtr->tcl_SetRecursionLimit) /* 231 */
#endif
#ifndef Tcl_SetResult
#define Tcl_SetResult \
/* Slot 232 is reserved */
	(tclStubsPtr->tcl_SetResult) /* 232 */
#endif
#ifndef Tcl_SetServiceMode
#define Tcl_SetServiceMode \
	(tclStubsPtr->tcl_SetServiceMode) /* 233 */
#endif
#ifndef Tcl_SetObjErrorCode
#define Tcl_SetObjErrorCode \
	(tclStubsPtr->tcl_SetObjErrorCode) /* 234 */
#endif
#ifndef Tcl_SetObjResult
#define Tcl_SetObjResult \
	(tclStubsPtr->tcl_SetObjResult) /* 235 */
#endif
#ifndef Tcl_SetStdChannel
#define Tcl_SetStdChannel \
	(tclStubsPtr->tcl_SetStdChannel) /* 236 */
#endif
#ifndef Tcl_SetVar
#define Tcl_SetVar \
/* Slot 237 is reserved */
	(tclStubsPtr->tcl_SetVar) /* 237 */
#endif
#ifndef Tcl_SetVar2
#define Tcl_SetVar2 \
	(tclStubsPtr->tcl_SetVar2) /* 238 */
#endif
#ifndef Tcl_SignalId
#define Tcl_SignalId \
	(tclStubsPtr->tcl_SignalId) /* 239 */
#endif
#ifndef Tcl_SignalMsg
#define Tcl_SignalMsg \
	(tclStubsPtr->tcl_SignalMsg) /* 240 */
#endif
#ifndef Tcl_SourceRCFile
#define Tcl_SourceRCFile \
	(tclStubsPtr->tcl_SourceRCFile) /* 241 */
#endif
#ifndef Tcl_SplitList
#define Tcl_SplitList \
	(tclStubsPtr->tcl_SplitList) /* 242 */
#endif
#ifndef Tcl_SplitPath
#define Tcl_SplitPath \
	(tclStubsPtr->tcl_SplitPath) /* 243 */
#endif
#ifndef Tcl_StaticPackage
#define Tcl_StaticPackage \
/* Slot 244 is reserved */
/* Slot 245 is reserved */
/* Slot 246 is reserved */
/* Slot 247 is reserved */
	(tclStubsPtr->tcl_StaticPackage) /* 244 */
#endif
#ifndef Tcl_StringMatch
#define Tcl_StringMatch \
	(tclStubsPtr->tcl_StringMatch) /* 245 */
#endif
#ifndef Tcl_TellOld
#define Tcl_TellOld \
	(tclStubsPtr->tcl_TellOld) /* 246 */
#endif
#ifndef Tcl_TraceVar
#define Tcl_TraceVar \
	(tclStubsPtr->tcl_TraceVar) /* 247 */
#endif
#ifndef Tcl_TraceVar2
#define Tcl_TraceVar2 \
	(tclStubsPtr->tcl_TraceVar2) /* 248 */
#endif
#ifndef Tcl_TranslateFileName
#define Tcl_TranslateFileName \
	(tclStubsPtr->tcl_TranslateFileName) /* 249 */
#endif
#ifndef Tcl_Ungets
#define Tcl_Ungets \
	(tclStubsPtr->tcl_Ungets) /* 250 */
#endif
#ifndef Tcl_UnlinkVar
#define Tcl_UnlinkVar \
	(tclStubsPtr->tcl_UnlinkVar) /* 251 */
#endif
#ifndef Tcl_UnregisterChannel
#define Tcl_UnregisterChannel \
	(tclStubsPtr->tcl_UnregisterChannel) /* 252 */
#endif
#ifndef Tcl_UnsetVar
#define Tcl_UnsetVar \
/* Slot 253 is reserved */
	(tclStubsPtr->tcl_UnsetVar) /* 253 */
#endif
#ifndef Tcl_UnsetVar2
#define Tcl_UnsetVar2 \
	(tclStubsPtr->tcl_UnsetVar2) /* 254 */
#endif
#ifndef Tcl_UntraceVar
#define Tcl_UntraceVar \
/* Slot 255 is reserved */
	(tclStubsPtr->tcl_UntraceVar) /* 255 */
#endif
#ifndef Tcl_UntraceVar2
#define Tcl_UntraceVar2 \
	(tclStubsPtr->tcl_UntraceVar2) /* 256 */
#endif
#ifndef Tcl_UpdateLinkedVar
#define Tcl_UpdateLinkedVar \
	(tclStubsPtr->tcl_UpdateLinkedVar) /* 257 */
#endif
#ifndef Tcl_UpVar
#define Tcl_UpVar \
/* Slot 258 is reserved */
	(tclStubsPtr->tcl_UpVar) /* 258 */
#endif
#ifndef Tcl_UpVar2
#define Tcl_UpVar2 \
	(tclStubsPtr->tcl_UpVar2) /* 259 */
#endif
#ifndef Tcl_VarEval
#define Tcl_VarEval \
	(tclStubsPtr->tcl_VarEval) /* 260 */
#endif
#ifndef Tcl_VarTraceInfo
#define Tcl_VarTraceInfo \
/* Slot 261 is reserved */
	(tclStubsPtr->tcl_VarTraceInfo) /* 261 */
#endif
#ifndef Tcl_VarTraceInfo2
#define Tcl_VarTraceInfo2 \
	(tclStubsPtr->tcl_VarTraceInfo2) /* 262 */
#endif
#ifndef Tcl_Write
#define Tcl_Write \
	(tclStubsPtr->tcl_Write) /* 263 */
#endif
#ifndef Tcl_WrongNumArgs
#define Tcl_WrongNumArgs \
	(tclStubsPtr->tcl_WrongNumArgs) /* 264 */
#endif
#ifndef Tcl_DumpActiveMemory
#define Tcl_DumpActiveMemory \
	(tclStubsPtr->tcl_DumpActiveMemory) /* 265 */
#endif
#ifndef Tcl_ValidateAllMemory
#define Tcl_ValidateAllMemory \
	(tclStubsPtr->tcl_ValidateAllMemory) /* 266 */
#endif
#ifndef Tcl_AppendResultVA
#define Tcl_AppendResultVA \
/* Slot 267 is reserved */
/* Slot 268 is reserved */
	(tclStubsPtr->tcl_AppendResultVA) /* 267 */
#endif
#ifndef Tcl_AppendStringsToObjVA
#define Tcl_AppendStringsToObjVA \
	(tclStubsPtr->tcl_AppendStringsToObjVA) /* 268 */
#endif
#ifndef Tcl_HashStats
#define Tcl_HashStats \
	(tclStubsPtr->tcl_HashStats) /* 269 */
#endif
#ifndef Tcl_ParseVar
#define Tcl_ParseVar \
	(tclStubsPtr->tcl_ParseVar) /* 270 */
#endif
/* Slot 271 is reserved */
#ifndef Tcl_PkgPresent
#define Tcl_PkgPresent \
	(tclStubsPtr->tcl_PkgPresent) /* 271 */
#endif
#ifndef Tcl_PkgPresentEx
#define Tcl_PkgPresentEx \
	(tclStubsPtr->tcl_PkgPresentEx) /* 272 */
#endif
#ifndef Tcl_PkgProvide
#define Tcl_PkgProvide \
/* Slot 273 is reserved */
/* Slot 274 is reserved */
/* Slot 275 is reserved */
/* Slot 276 is reserved */
	(tclStubsPtr->tcl_PkgProvide) /* 273 */
#endif
#ifndef Tcl_PkgRequire
#define Tcl_PkgRequire \
	(tclStubsPtr->tcl_PkgRequire) /* 274 */
#endif
#ifndef Tcl_SetErrorCodeVA
#define Tcl_SetErrorCodeVA \
	(tclStubsPtr->tcl_SetErrorCodeVA) /* 275 */
#endif
#ifndef Tcl_VarEvalVA
#define Tcl_VarEvalVA \
	(tclStubsPtr->tcl_VarEvalVA) /* 276 */
#endif
#ifndef Tcl_WaitPid
#define Tcl_WaitPid \
	(tclStubsPtr->tcl_WaitPid) /* 277 */
#endif
#ifndef Tcl_PanicVA
#define Tcl_PanicVA \
/* Slot 278 is reserved */
	(tclStubsPtr->tcl_PanicVA) /* 278 */
#endif
#ifndef Tcl_GetVersion
#define Tcl_GetVersion \
	(tclStubsPtr->tcl_GetVersion) /* 279 */
#endif
#ifndef Tcl_InitMemory
#define Tcl_InitMemory \
	(tclStubsPtr->tcl_InitMemory) /* 280 */
#endif
#ifndef Tcl_StackChannel
#define Tcl_StackChannel \
	(tclStubsPtr->tcl_StackChannel) /* 281 */
#endif
#ifndef Tcl_UnstackChannel
#define Tcl_UnstackChannel \
	(tclStubsPtr->tcl_UnstackChannel) /* 282 */
#endif
#ifndef Tcl_GetStackedChannel
#define Tcl_GetStackedChannel \
	(tclStubsPtr->tcl_GetStackedChannel) /* 283 */
#endif
#ifndef Tcl_SetMainLoop
#define Tcl_SetMainLoop \
	(tclStubsPtr->tcl_SetMainLoop) /* 284 */
#endif
/* Slot 285 is reserved */
#ifndef Tcl_AppendObjToObj
#define Tcl_AppendObjToObj \
	(tclStubsPtr->tcl_AppendObjToObj) /* 286 */
#endif
#ifndef Tcl_CreateEncoding
#define Tcl_CreateEncoding \
	(tclStubsPtr->tcl_CreateEncoding) /* 287 */
#endif
#ifndef Tcl_CreateThreadExitHandler
#define Tcl_CreateThreadExitHandler \
	(tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */
#endif
#ifndef Tcl_DeleteThreadExitHandler
#define Tcl_DeleteThreadExitHandler \
	(tclStubsPtr->tcl_DeleteThreadExitHandler) /* 289 */
#endif
#ifndef Tcl_DiscardResult
#define Tcl_DiscardResult \
/* Slot 290 is reserved */
	(tclStubsPtr->tcl_DiscardResult) /* 290 */
#endif
#ifndef Tcl_EvalEx
#define Tcl_EvalEx \
	(tclStubsPtr->tcl_EvalEx) /* 291 */
#endif
#ifndef Tcl_EvalObjv
#define Tcl_EvalObjv \
	(tclStubsPtr->tcl_EvalObjv) /* 292 */
#endif
#ifndef Tcl_EvalObjEx
#define Tcl_EvalObjEx \
	(tclStubsPtr->tcl_EvalObjEx) /* 293 */
#endif
#ifndef Tcl_ExitThread
#define Tcl_ExitThread \
	(tclStubsPtr->tcl_ExitThread) /* 294 */
#endif
#ifndef Tcl_ExternalToUtf
#define Tcl_ExternalToUtf \
	(tclStubsPtr->tcl_ExternalToUtf) /* 295 */
#endif
#ifndef Tcl_ExternalToUtfDString
#define Tcl_ExternalToUtfDString \
	(tclStubsPtr->tcl_ExternalToUtfDString) /* 296 */
#endif
#ifndef Tcl_FinalizeThread
#define Tcl_FinalizeThread \
	(tclStubsPtr->tcl_FinalizeThread) /* 297 */
#endif
#ifndef Tcl_FinalizeNotifier
#define Tcl_FinalizeNotifier \
	(tclStubsPtr->tcl_FinalizeNotifier) /* 298 */
#endif
#ifndef Tcl_FreeEncoding
#define Tcl_FreeEncoding \
	(tclStubsPtr->tcl_FreeEncoding) /* 299 */
#endif
#ifndef Tcl_GetCurrentThread
#define Tcl_GetCurrentThread \
	(tclStubsPtr->tcl_GetCurrentThread) /* 300 */
#endif
#ifndef Tcl_GetEncoding
#define Tcl_GetEncoding \
	(tclStubsPtr->tcl_GetEncoding) /* 301 */
#endif
#ifndef Tcl_GetEncodingName
#define Tcl_GetEncodingName \
	(tclStubsPtr->tcl_GetEncodingName) /* 302 */
#endif
#ifndef Tcl_GetEncodingNames
#define Tcl_GetEncodingNames \
	(tclStubsPtr->tcl_GetEncodingNames) /* 303 */
#endif
#ifndef Tcl_GetIndexFromObjStruct
#define Tcl_GetIndexFromObjStruct \
	(tclStubsPtr->tcl_GetIndexFromObjStruct) /* 304 */
#endif
#ifndef Tcl_GetThreadData
#define Tcl_GetThreadData \
	(tclStubsPtr->tcl_GetThreadData) /* 305 */
#endif
#ifndef Tcl_GetVar2Ex
#define Tcl_GetVar2Ex \
	(tclStubsPtr->tcl_GetVar2Ex) /* 306 */
#endif
#ifndef Tcl_InitNotifier
#define Tcl_InitNotifier \
	(tclStubsPtr->tcl_InitNotifier) /* 307 */
#endif
#ifndef Tcl_MutexLock
#define Tcl_MutexLock \
	(tclStubsPtr->tcl_MutexLock) /* 308 */
#endif
#ifndef Tcl_MutexUnlock
#define Tcl_MutexUnlock \
	(tclStubsPtr->tcl_MutexUnlock) /* 309 */
#endif
#ifndef Tcl_ConditionNotify
#define Tcl_ConditionNotify \
	(tclStubsPtr->tcl_ConditionNotify) /* 310 */
#endif
#ifndef Tcl_ConditionWait
#define Tcl_ConditionWait \
	(tclStubsPtr->tcl_ConditionWait) /* 311 */
#endif
#ifndef Tcl_NumUtfChars
#define Tcl_NumUtfChars \
	(tclStubsPtr->tcl_NumUtfChars) /* 312 */
#endif
#ifndef Tcl_ReadChars
#define Tcl_ReadChars \
	(tclStubsPtr->tcl_ReadChars) /* 313 */
#endif
#ifndef Tcl_RestoreResult
#define Tcl_RestoreResult \
/* Slot 314 is reserved */
/* Slot 315 is reserved */
	(tclStubsPtr->tcl_RestoreResult) /* 314 */
#endif
#ifndef Tcl_SaveResult
#define Tcl_SaveResult \
	(tclStubsPtr->tcl_SaveResult) /* 315 */
#endif
#ifndef Tcl_SetSystemEncoding
#define Tcl_SetSystemEncoding \
	(tclStubsPtr->tcl_SetSystemEncoding) /* 316 */
#endif
#ifndef Tcl_SetVar2Ex
#define Tcl_SetVar2Ex \
	(tclStubsPtr->tcl_SetVar2Ex) /* 317 */
#endif
#ifndef Tcl_ThreadAlert
#define Tcl_ThreadAlert \
	(tclStubsPtr->tcl_ThreadAlert) /* 318 */
#endif
#ifndef Tcl_ThreadQueueEvent
#define Tcl_ThreadQueueEvent \
	(tclStubsPtr->tcl_ThreadQueueEvent) /* 319 */
#endif
#ifndef Tcl_UniCharAtIndex
#define Tcl_UniCharAtIndex \
	(tclStubsPtr->tcl_UniCharAtIndex) /* 320 */
#endif
#ifndef Tcl_UniCharToLower
#define Tcl_UniCharToLower \
	(tclStubsPtr->tcl_UniCharToLower) /* 321 */
#endif
#ifndef Tcl_UniCharToTitle
#define Tcl_UniCharToTitle \
	(tclStubsPtr->tcl_UniCharToTitle) /* 322 */
#endif
#ifndef Tcl_UniCharToUpper
#define Tcl_UniCharToUpper \
	(tclStubsPtr->tcl_UniCharToUpper) /* 323 */
#endif
#ifndef Tcl_UniCharToUtf
#define Tcl_UniCharToUtf \
	(tclStubsPtr->tcl_UniCharToUtf) /* 324 */
#endif
#ifndef Tcl_UtfAtIndex
#define Tcl_UtfAtIndex \
	(tclStubsPtr->tcl_UtfAtIndex) /* 325 */
#endif
#ifndef Tcl_UtfCharComplete
#define Tcl_UtfCharComplete \
	(tclStubsPtr->tcl_UtfCharComplete) /* 326 */
#endif
#ifndef Tcl_UtfBackslash
#define Tcl_UtfBackslash \
	(tclStubsPtr->tcl_UtfBackslash) /* 327 */
#endif
#ifndef Tcl_UtfFindFirst
#define Tcl_UtfFindFirst \
	(tclStubsPtr->tcl_UtfFindFirst) /* 328 */
#endif
#ifndef Tcl_UtfFindLast
#define Tcl_UtfFindLast \
	(tclStubsPtr->tcl_UtfFindLast) /* 329 */
#endif
#ifndef Tcl_UtfNext
#define Tcl_UtfNext \
	(tclStubsPtr->tcl_UtfNext) /* 330 */
#endif
#ifndef Tcl_UtfPrev
#define Tcl_UtfPrev \
	(tclStubsPtr->tcl_UtfPrev) /* 331 */
#endif
#ifndef Tcl_UtfToExternal
#define Tcl_UtfToExternal \
	(tclStubsPtr->tcl_UtfToExternal) /* 332 */
#endif
#ifndef Tcl_UtfToExternalDString
#define Tcl_UtfToExternalDString \
	(tclStubsPtr->tcl_UtfToExternalDString) /* 333 */
#endif
#ifndef Tcl_UtfToLower
#define Tcl_UtfToLower \
	(tclStubsPtr->tcl_UtfToLower) /* 334 */
#endif
#ifndef Tcl_UtfToTitle
#define Tcl_UtfToTitle \
	(tclStubsPtr->tcl_UtfToTitle) /* 335 */
#endif
#ifndef Tcl_UtfToUniChar
#define Tcl_UtfToChar16 \
	(tclStubsPtr->tcl_UtfToChar16) /* 336 */
#define Tcl_UtfToUniChar \
	(tclStubsPtr->tcl_UtfToUniChar) /* 336 */
#endif
#ifndef Tcl_UtfToUpper
#define Tcl_UtfToUpper \
	(tclStubsPtr->tcl_UtfToUpper) /* 337 */
#endif
#ifndef Tcl_WriteChars
#define Tcl_WriteChars \
	(tclStubsPtr->tcl_WriteChars) /* 338 */
#endif
#ifndef Tcl_WriteObj
#define Tcl_WriteObj \
	(tclStubsPtr->tcl_WriteObj) /* 339 */
#endif
#ifndef Tcl_GetString
#define Tcl_GetString \
	(tclStubsPtr->tcl_GetString) /* 340 */
#endif
#ifndef Tcl_GetDefaultEncodingDir
#define Tcl_GetDefaultEncodingDir \
/* Slot 341 is reserved */
/* Slot 342 is reserved */
	(tclStubsPtr->tcl_GetDefaultEncodingDir) /* 341 */
#endif
#ifndef Tcl_SetDefaultEncodingDir
#define Tcl_SetDefaultEncodingDir \
	(tclStubsPtr->tcl_SetDefaultEncodingDir) /* 342 */
#endif
#ifndef Tcl_AlertNotifier
#define Tcl_AlertNotifier \
	(tclStubsPtr->tcl_AlertNotifier) /* 343 */
#endif
#ifndef Tcl_ServiceModeHook
#define Tcl_ServiceModeHook \
	(tclStubsPtr->tcl_ServiceModeHook) /* 344 */
#endif
#ifndef Tcl_UniCharIsAlnum
#define Tcl_UniCharIsAlnum \
	(tclStubsPtr->tcl_UniCharIsAlnum) /* 345 */
#endif
#ifndef Tcl_UniCharIsAlpha
#define Tcl_UniCharIsAlpha \
	(tclStubsPtr->tcl_UniCharIsAlpha) /* 346 */
#endif
#ifndef Tcl_UniCharIsDigit
#define Tcl_UniCharIsDigit \
	(tclStubsPtr->tcl_UniCharIsDigit) /* 347 */
#endif
#ifndef Tcl_UniCharIsLower
#define Tcl_UniCharIsLower \
	(tclStubsPtr->tcl_UniCharIsLower) /* 348 */
#endif
#ifndef Tcl_UniCharIsSpace
#define Tcl_UniCharIsSpace \
	(tclStubsPtr->tcl_UniCharIsSpace) /* 349 */
#endif
#ifndef Tcl_UniCharIsUpper
#define Tcl_UniCharIsUpper \
	(tclStubsPtr->tcl_UniCharIsUpper) /* 350 */
#endif
#ifndef Tcl_UniCharIsWordChar
#define Tcl_UniCharIsWordChar \
	(tclStubsPtr->tcl_UniCharIsWordChar) /* 351 */
#endif
#ifndef Tcl_UniCharLen
#define Tcl_UniCharLen \
/* Slot 352 is reserved */
/* Slot 353 is reserved */
#define Tcl_Char16ToUtfDString \
	(tclStubsPtr->tcl_Char16ToUtfDString) /* 354 */
#define Tcl_UtfToChar16DString \
	(tclStubsPtr->tcl_UtfToChar16DString) /* 355 */
	(tclStubsPtr->tcl_UniCharLen) /* 352 */
#endif
#ifndef Tcl_UniCharNcmp
#define Tcl_UniCharNcmp \
	(tclStubsPtr->tcl_UniCharNcmp) /* 353 */
#endif
#ifndef Tcl_UniCharToUtfDString
#define Tcl_UniCharToUtfDString \
	(tclStubsPtr->tcl_UniCharToUtfDString) /* 354 */
#endif
#ifndef Tcl_UtfToUniCharDString
#define Tcl_UtfToUniCharDString \
	(tclStubsPtr->tcl_UtfToUniCharDString) /* 355 */
#endif
#ifndef Tcl_GetRegExpFromObj
#define Tcl_GetRegExpFromObj \
	(tclStubsPtr->tcl_GetRegExpFromObj) /* 356 */
#endif
#ifndef Tcl_EvalTokens
#define Tcl_EvalTokens \
/* Slot 357 is reserved */
	(tclStubsPtr->tcl_EvalTokens) /* 357 */
#endif
#ifndef Tcl_FreeParse
#define Tcl_FreeParse \
	(tclStubsPtr->tcl_FreeParse) /* 358 */
#endif
#ifndef Tcl_LogCommandInfo
#define Tcl_LogCommandInfo \
	(tclStubsPtr->tcl_LogCommandInfo) /* 359 */
#endif
#ifndef Tcl_ParseBraces
#define Tcl_ParseBraces \
	(tclStubsPtr->tcl_ParseBraces) /* 360 */
#endif
#ifndef Tcl_ParseCommand
#define Tcl_ParseCommand \
	(tclStubsPtr->tcl_ParseCommand) /* 361 */
#endif
#ifndef Tcl_ParseExpr
#define Tcl_ParseExpr \
	(tclStubsPtr->tcl_ParseExpr) /* 362 */
#endif
#ifndef Tcl_ParseQuotedString
#define Tcl_ParseQuotedString \
	(tclStubsPtr->tcl_ParseQuotedString) /* 363 */
#endif
#ifndef Tcl_ParseVarName
#define Tcl_ParseVarName \
	(tclStubsPtr->tcl_ParseVarName) /* 364 */
#endif
#ifndef Tcl_GetCwd
#define Tcl_GetCwd \
	(tclStubsPtr->tcl_GetCwd) /* 365 */
#endif
#ifndef Tcl_Chdir
#define Tcl_Chdir \
	(tclStubsPtr->tcl_Chdir) /* 366 */
#endif
#ifndef Tcl_Access
#define Tcl_Access \
	(tclStubsPtr->tcl_Access) /* 367 */
#endif
#ifndef Tcl_Stat
#define Tcl_Stat \
	(tclStubsPtr->tcl_Stat) /* 368 */
#endif
#ifndef Tcl_UtfNcmp
#define Tcl_UtfNcmp \
	(tclStubsPtr->tcl_UtfNcmp) /* 369 */
#endif
#ifndef Tcl_UtfNcasecmp
#define Tcl_UtfNcasecmp \
	(tclStubsPtr->tcl_UtfNcasecmp) /* 370 */
#endif
#ifndef Tcl_StringCaseMatch
#define Tcl_StringCaseMatch \
	(tclStubsPtr->tcl_StringCaseMatch) /* 371 */
#endif
#ifndef Tcl_UniCharIsControl
#define Tcl_UniCharIsControl \
	(tclStubsPtr->tcl_UniCharIsControl) /* 372 */
#endif
#ifndef Tcl_UniCharIsGraph
#define Tcl_UniCharIsGraph \
	(tclStubsPtr->tcl_UniCharIsGraph) /* 373 */
#endif
#ifndef Tcl_UniCharIsPrint
#define Tcl_UniCharIsPrint \
	(tclStubsPtr->tcl_UniCharIsPrint) /* 374 */
#endif
#ifndef Tcl_UniCharIsPunct
#define Tcl_UniCharIsPunct \
	(tclStubsPtr->tcl_UniCharIsPunct) /* 375 */
#endif
#ifndef Tcl_RegExpExecObj
#define Tcl_RegExpExecObj \
	(tclStubsPtr->tcl_RegExpExecObj) /* 376 */
#endif
#ifndef Tcl_RegExpGetInfo
#define Tcl_RegExpGetInfo \
	(tclStubsPtr->tcl_RegExpGetInfo) /* 377 */
#endif
#ifndef Tcl_NewUnicodeObj
#define Tcl_NewUnicodeObj \
	(tclStubsPtr->tcl_NewUnicodeObj) /* 378 */
#endif
#ifndef Tcl_SetUnicodeObj
#define Tcl_SetUnicodeObj \
	(tclStubsPtr->tcl_SetUnicodeObj) /* 379 */
#endif
#ifndef Tcl_GetCharLength
#define Tcl_GetCharLength \
	(tclStubsPtr->tcl_GetCharLength) /* 380 */
#endif
#ifndef Tcl_GetUniChar
#define Tcl_GetUniChar \
	(tclStubsPtr->tcl_GetUniChar) /* 381 */
#endif
#ifndef Tcl_GetUnicode
#define Tcl_GetUnicode \
/* Slot 382 is reserved */
	(tclStubsPtr->tcl_GetUnicode) /* 382 */
#endif
#ifndef Tcl_GetRange
#define Tcl_GetRange \
	(tclStubsPtr->tcl_GetRange) /* 383 */
#endif
#ifndef Tcl_AppendUnicodeToObj
#define Tcl_AppendUnicodeToObj \
/* Slot 384 is reserved */
	(tclStubsPtr->tcl_AppendUnicodeToObj) /* 384 */
#endif
#ifndef Tcl_RegExpMatchObj
#define Tcl_RegExpMatchObj \
	(tclStubsPtr->tcl_RegExpMatchObj) /* 385 */
#endif
#ifndef Tcl_SetNotifier
#define Tcl_SetNotifier \
	(tclStubsPtr->tcl_SetNotifier) /* 386 */
#endif
#ifndef Tcl_GetAllocMutex
#define Tcl_GetAllocMutex \
	(tclStubsPtr->tcl_GetAllocMutex) /* 387 */
#endif
#ifndef Tcl_GetChannelNames
#define Tcl_GetChannelNames \
	(tclStubsPtr->tcl_GetChannelNames) /* 388 */
#endif
#ifndef Tcl_GetChannelNamesEx
#define Tcl_GetChannelNamesEx \
	(tclStubsPtr->tcl_GetChannelNamesEx) /* 389 */
#endif
#ifndef Tcl_ProcObjCmd
#define Tcl_ProcObjCmd \
	(tclStubsPtr->tcl_ProcObjCmd) /* 390 */
#endif
#ifndef Tcl_ConditionFinalize
#define Tcl_ConditionFinalize \
	(tclStubsPtr->tcl_ConditionFinalize) /* 391 */
#endif
#ifndef Tcl_MutexFinalize
#define Tcl_MutexFinalize \
	(tclStubsPtr->tcl_MutexFinalize) /* 392 */
#endif
#ifndef Tcl_CreateThread
#define Tcl_CreateThread \
	(tclStubsPtr->tcl_CreateThread) /* 393 */
#endif
#ifndef Tcl_ReadRaw
#define Tcl_ReadRaw \
	(tclStubsPtr->tcl_ReadRaw) /* 394 */
#endif
#ifndef Tcl_WriteRaw
#define Tcl_WriteRaw \
	(tclStubsPtr->tcl_WriteRaw) /* 395 */
#endif
#ifndef Tcl_GetTopChannel
#define Tcl_GetTopChannel \
	(tclStubsPtr->tcl_GetTopChannel) /* 396 */
#endif
#ifndef Tcl_ChannelBuffered
#define Tcl_ChannelBuffered \
	(tclStubsPtr->tcl_ChannelBuffered) /* 397 */
#endif
#ifndef Tcl_ChannelName
#define Tcl_ChannelName \
	(tclStubsPtr->tcl_ChannelName) /* 398 */
#endif
#ifndef Tcl_ChannelVersion
#define Tcl_ChannelVersion \
	(tclStubsPtr->tcl_ChannelVersion) /* 399 */
#endif
#ifndef Tcl_ChannelBlockModeProc
#define Tcl_ChannelBlockModeProc \
	(tclStubsPtr->tcl_ChannelBlockModeProc) /* 400 */
#endif
#ifndef Tcl_ChannelCloseProc
#define Tcl_ChannelCloseProc \
/* Slot 401 is reserved */
	(tclStubsPtr->tcl_ChannelCloseProc) /* 401 */
#endif
#ifndef Tcl_ChannelClose2Proc
#define Tcl_ChannelClose2Proc \
	(tclStubsPtr->tcl_ChannelClose2Proc) /* 402 */
#endif
#ifndef Tcl_ChannelInputProc
#define Tcl_ChannelInputProc \
	(tclStubsPtr->tcl_ChannelInputProc) /* 403 */
#endif
#ifndef Tcl_ChannelOutputProc
#define Tcl_ChannelOutputProc \
	(tclStubsPtr->tcl_ChannelOutputProc) /* 404 */
#endif
#ifndef Tcl_ChannelSeekProc
#define Tcl_ChannelSeekProc \
/* Slot 405 is reserved */
	(tclStubsPtr->tcl_ChannelSeekProc) /* 405 */
#endif
#ifndef Tcl_ChannelSetOptionProc
#define Tcl_ChannelSetOptionProc \
	(tclStubsPtr->tcl_ChannelSetOptionProc) /* 406 */
#endif
#ifndef Tcl_ChannelGetOptionProc
#define Tcl_ChannelGetOptionProc \
	(tclStubsPtr->tcl_ChannelGetOptionProc) /* 407 */
#endif
#ifndef Tcl_ChannelWatchProc
#define Tcl_ChannelWatchProc \
	(tclStubsPtr->tcl_ChannelWatchProc) /* 408 */
#endif
#ifndef Tcl_ChannelGetHandleProc
#define Tcl_ChannelGetHandleProc \
	(tclStubsPtr->tcl_ChannelGetHandleProc) /* 409 */
#endif
#ifndef Tcl_ChannelFlushProc
#define Tcl_ChannelFlushProc \
	(tclStubsPtr->tcl_ChannelFlushProc) /* 410 */
#endif
#ifndef Tcl_ChannelHandlerProc
#define Tcl_ChannelHandlerProc \
	(tclStubsPtr->tcl_ChannelHandlerProc) /* 411 */
#endif
#ifndef Tcl_JoinThread
#define Tcl_JoinThread \
	(tclStubsPtr->tcl_JoinThread) /* 412 */
#endif
#ifndef Tcl_IsChannelShared
#define Tcl_IsChannelShared \
	(tclStubsPtr->tcl_IsChannelShared) /* 413 */
#endif
#ifndef Tcl_IsChannelRegistered
#define Tcl_IsChannelRegistered \
	(tclStubsPtr->tcl_IsChannelRegistered) /* 414 */
#endif
#ifndef Tcl_CutChannel
#define Tcl_CutChannel \
	(tclStubsPtr->tcl_CutChannel) /* 415 */
#endif
#ifndef Tcl_SpliceChannel
#define Tcl_SpliceChannel \
	(tclStubsPtr->tcl_SpliceChannel) /* 416 */
#endif
#ifndef Tcl_ClearChannelHandlers
#define Tcl_ClearChannelHandlers \
	(tclStubsPtr->tcl_ClearChannelHandlers) /* 417 */
#endif
#ifndef Tcl_IsChannelExisting
#define Tcl_IsChannelExisting \
	(tclStubsPtr->tcl_IsChannelExisting) /* 418 */
#endif
#ifndef Tcl_UniCharNcasecmp
#define Tcl_UniCharNcasecmp \
/* Slot 419 is reserved */
/* Slot 420 is reserved */
/* Slot 421 is reserved */
/* Slot 422 is reserved */
	(tclStubsPtr->tcl_UniCharNcasecmp) /* 419 */
#endif
#ifndef Tcl_UniCharCaseMatch
#define Tcl_UniCharCaseMatch \
	(tclStubsPtr->tcl_UniCharCaseMatch) /* 420 */
#endif
#ifndef Tcl_FindHashEntry
#define Tcl_FindHashEntry \
	(tclStubsPtr->tcl_FindHashEntry) /* 421 */
#endif
#ifndef Tcl_CreateHashEntry
#define Tcl_CreateHashEntry \
	(tclStubsPtr->tcl_CreateHashEntry) /* 422 */
#endif
#ifndef Tcl_InitCustomHashTable
#define Tcl_InitCustomHashTable \
	(tclStubsPtr->tcl_InitCustomHashTable) /* 423 */
#endif
#ifndef Tcl_InitObjHashTable
#define Tcl_InitObjHashTable \
	(tclStubsPtr->tcl_InitObjHashTable) /* 424 */
#endif
#ifndef Tcl_CommandTraceInfo
#define Tcl_CommandTraceInfo \
	(tclStubsPtr->tcl_CommandTraceInfo) /* 425 */
#endif
#ifndef Tcl_TraceCommand
#define Tcl_TraceCommand \
	(tclStubsPtr->tcl_TraceCommand) /* 426 */
#endif
#ifndef Tcl_UntraceCommand
#define Tcl_UntraceCommand \
	(tclStubsPtr->tcl_UntraceCommand) /* 427 */
#endif
#ifndef Tcl_AttemptAlloc
#define Tcl_AttemptAlloc \
	(tclStubsPtr->tcl_AttemptAlloc) /* 428 */
#endif
#ifndef Tcl_AttemptDbCkalloc
#define Tcl_AttemptDbCkalloc \
	(tclStubsPtr->tcl_AttemptDbCkalloc) /* 429 */
#endif
#ifndef Tcl_AttemptRealloc
#define Tcl_AttemptRealloc \
	(tclStubsPtr->tcl_AttemptRealloc) /* 430 */
#endif
#ifndef Tcl_AttemptDbCkrealloc
#define Tcl_AttemptDbCkrealloc \
	(tclStubsPtr->tcl_AttemptDbCkrealloc) /* 431 */
#endif
#ifndef Tcl_AttemptSetObjLength
#define Tcl_AttemptSetObjLength \
	(tclStubsPtr->tcl_AttemptSetObjLength) /* 432 */
#endif
#ifndef Tcl_GetChannelThread
#define Tcl_GetChannelThread \
	(tclStubsPtr->tcl_GetChannelThread) /* 433 */
#endif
#ifndef Tcl_GetUnicodeFromObj
#define Tcl_GetUnicodeFromObj \
	(tclStubsPtr->tcl_GetUnicodeFromObj) /* 434 */
#endif
#ifndef Tcl_GetMathFuncInfo
#define Tcl_GetMathFuncInfo \
/* Slot 435 is reserved */
/* Slot 436 is reserved */
	(tclStubsPtr->tcl_GetMathFuncInfo) /* 435 */
#endif
#ifndef Tcl_ListMathFuncs
#define Tcl_ListMathFuncs \
	(tclStubsPtr->tcl_ListMathFuncs) /* 436 */
#endif
#ifndef Tcl_SubstObj
#define Tcl_SubstObj \
	(tclStubsPtr->tcl_SubstObj) /* 437 */
#endif
#ifndef Tcl_DetachChannel
#define Tcl_DetachChannel \
	(tclStubsPtr->tcl_DetachChannel) /* 438 */
#endif
#ifndef Tcl_IsStandardChannel
#define Tcl_IsStandardChannel \
	(tclStubsPtr->tcl_IsStandardChannel) /* 439 */
#endif
#ifndef Tcl_FSCopyFile
#define Tcl_FSCopyFile \
	(tclStubsPtr->tcl_FSCopyFile) /* 440 */
#endif
#ifndef Tcl_FSCopyDirectory
#define Tcl_FSCopyDirectory \
	(tclStubsPtr->tcl_FSCopyDirectory) /* 441 */
#endif
#ifndef Tcl_FSCreateDirectory
#define Tcl_FSCreateDirectory \
	(tclStubsPtr->tcl_FSCreateDirectory) /* 442 */
#endif
#ifndef Tcl_FSDeleteFile
#define Tcl_FSDeleteFile \
	(tclStubsPtr->tcl_FSDeleteFile) /* 443 */
#endif
#ifndef Tcl_FSLoadFile
#define Tcl_FSLoadFile \
	(tclStubsPtr->tcl_FSLoadFile) /* 444 */
#endif
#ifndef Tcl_FSMatchInDirectory
#define Tcl_FSMatchInDirectory \
	(tclStubsPtr->tcl_FSMatchInDirectory) /* 445 */
#endif
#ifndef Tcl_FSLink
#define Tcl_FSLink \
	(tclStubsPtr->tcl_FSLink) /* 446 */
#endif
#ifndef Tcl_FSRemoveDirectory
#define Tcl_FSRemoveDirectory \
	(tclStubsPtr->tcl_FSRemoveDirectory) /* 447 */
#endif
#ifndef Tcl_FSRenameFile
#define Tcl_FSRenameFile \
	(tclStubsPtr->tcl_FSRenameFile) /* 448 */
#endif
#ifndef Tcl_FSLstat
#define Tcl_FSLstat \
	(tclStubsPtr->tcl_FSLstat) /* 449 */
#endif
#ifndef Tcl_FSUtime
#define Tcl_FSUtime \
	(tclStubsPtr->tcl_FSUtime) /* 450 */
#endif
#ifndef Tcl_FSFileAttrsGet
#define Tcl_FSFileAttrsGet \
	(tclStubsPtr->tcl_FSFileAttrsGet) /* 451 */
#endif
#ifndef Tcl_FSFileAttrsSet
#define Tcl_FSFileAttrsSet \
	(tclStubsPtr->tcl_FSFileAttrsSet) /* 452 */
#endif
#ifndef Tcl_FSFileAttrStrings
#define Tcl_FSFileAttrStrings \
	(tclStubsPtr->tcl_FSFileAttrStrings) /* 453 */
#endif
#ifndef Tcl_FSStat
#define Tcl_FSStat \
	(tclStubsPtr->tcl_FSStat) /* 454 */
#endif
#ifndef Tcl_FSAccess
#define Tcl_FSAccess \
	(tclStubsPtr->tcl_FSAccess) /* 455 */
#endif
#ifndef Tcl_FSOpenFileChannel
#define Tcl_FSOpenFileChannel \
	(tclStubsPtr->tcl_FSOpenFileChannel) /* 456 */
#endif
#ifndef Tcl_FSGetCwd
#define Tcl_FSGetCwd \
	(tclStubsPtr->tcl_FSGetCwd) /* 457 */
#endif
#ifndef Tcl_FSChdir
#define Tcl_FSChdir \
	(tclStubsPtr->tcl_FSChdir) /* 458 */
#endif
#ifndef Tcl_FSConvertToPathType
#define Tcl_FSConvertToPathType \
	(tclStubsPtr->tcl_FSConvertToPathType) /* 459 */
#endif
#ifndef Tcl_FSJoinPath
#define Tcl_FSJoinPath \
	(tclStubsPtr->tcl_FSJoinPath) /* 460 */
#endif
#ifndef Tcl_FSSplitPath
#define Tcl_FSSplitPath \
	(tclStubsPtr->tcl_FSSplitPath) /* 461 */
#endif
#ifndef Tcl_FSEqualPaths
#define Tcl_FSEqualPaths \
	(tclStubsPtr->tcl_FSEqualPaths) /* 462 */
#endif
#ifndef Tcl_FSGetNormalizedPath
#define Tcl_FSGetNormalizedPath \
	(tclStubsPtr->tcl_FSGetNormalizedPath) /* 463 */
#endif
#ifndef Tcl_FSJoinToPath
#define Tcl_FSJoinToPath \
	(tclStubsPtr->tcl_FSJoinToPath) /* 464 */
#endif
#ifndef Tcl_FSGetInternalRep
#define Tcl_FSGetInternalRep \
	(tclStubsPtr->tcl_FSGetInternalRep) /* 465 */
#endif
#ifndef Tcl_FSGetTranslatedPath
#define Tcl_FSGetTranslatedPath \
	(tclStubsPtr->tcl_FSGetTranslatedPath) /* 466 */
#endif
#ifndef Tcl_FSEvalFile
#define Tcl_FSEvalFile \
	(tclStubsPtr->tcl_FSEvalFile) /* 467 */
#endif
#ifndef Tcl_FSNewNativePath
#define Tcl_FSNewNativePath \
	(tclStubsPtr->tcl_FSNewNativePath) /* 468 */
#endif
#ifndef Tcl_FSGetNativePath
#define Tcl_FSGetNativePath \
	(tclStubsPtr->tcl_FSGetNativePath) /* 469 */
#endif
#ifndef Tcl_FSFileSystemInfo
#define Tcl_FSFileSystemInfo \
	(tclStubsPtr->tcl_FSFileSystemInfo) /* 470 */
#endif
#ifndef Tcl_FSPathSeparator
#define Tcl_FSPathSeparator \
	(tclStubsPtr->tcl_FSPathSeparator) /* 471 */
#endif
#ifndef Tcl_FSListVolumes
#define Tcl_FSListVolumes \
	(tclStubsPtr->tcl_FSListVolumes) /* 472 */
#endif
#ifndef Tcl_FSRegister
#define Tcl_FSRegister \
	(tclStubsPtr->tcl_FSRegister) /* 473 */
#endif
#ifndef Tcl_FSUnregister
#define Tcl_FSUnregister \
	(tclStubsPtr->tcl_FSUnregister) /* 474 */
#endif
#ifndef Tcl_FSData
#define Tcl_FSData \
	(tclStubsPtr->tcl_FSData) /* 475 */
#endif
#ifndef Tcl_FSGetTranslatedStringPath
#define Tcl_FSGetTranslatedStringPath \
	(tclStubsPtr->tcl_FSGetTranslatedStringPath) /* 476 */
#endif
#ifndef Tcl_FSGetFileSystemForPath
#define Tcl_FSGetFileSystemForPath \
	(tclStubsPtr->tcl_FSGetFileSystemForPath) /* 477 */
#endif
#ifndef Tcl_FSGetPathType
#define Tcl_FSGetPathType \
	(tclStubsPtr->tcl_FSGetPathType) /* 478 */
#endif
#ifndef Tcl_OutputBuffered
#define Tcl_OutputBuffered \
	(tclStubsPtr->tcl_OutputBuffered) /* 479 */
#endif
#ifndef Tcl_FSMountsChanged
#define Tcl_FSMountsChanged \
	(tclStubsPtr->tcl_FSMountsChanged) /* 480 */
#endif
#ifndef Tcl_EvalTokensStandard
#define Tcl_EvalTokensStandard \
	(tclStubsPtr->tcl_EvalTokensStandard) /* 481 */
#endif
#ifndef Tcl_GetTime
#define Tcl_GetTime \
	(tclStubsPtr->tcl_GetTime) /* 482 */
#endif
#ifndef Tcl_CreateObjTrace
#define Tcl_CreateObjTrace \
	(tclStubsPtr->tcl_CreateObjTrace) /* 483 */
#endif
#ifndef Tcl_GetCommandInfoFromToken
#define Tcl_GetCommandInfoFromToken \
	(tclStubsPtr->tcl_GetCommandInfoFromToken) /* 484 */
#endif
#ifndef Tcl_SetCommandInfoFromToken
#define Tcl_SetCommandInfoFromToken \
	(tclStubsPtr->tcl_SetCommandInfoFromToken) /* 485 */
#endif
#ifndef Tcl_DbNewWideIntObj
#define Tcl_DbNewWideIntObj \
	(tclStubsPtr->tcl_DbNewWideIntObj) /* 486 */
#endif
#ifndef Tcl_GetWideIntFromObj
#define Tcl_GetWideIntFromObj \
	(tclStubsPtr->tcl_GetWideIntFromObj) /* 487 */
#endif
#ifndef Tcl_NewWideIntObj
#define Tcl_NewWideIntObj \
	(tclStubsPtr->tcl_NewWideIntObj) /* 488 */
#endif
#ifndef Tcl_SetWideIntObj
#define Tcl_SetWideIntObj \
	(tclStubsPtr->tcl_SetWideIntObj) /* 489 */
#endif
#ifndef Tcl_AllocStatBuf
#define Tcl_AllocStatBuf \
	(tclStubsPtr->tcl_AllocStatBuf) /* 490 */
#endif
#ifndef Tcl_Seek
#define Tcl_Seek \
	(tclStubsPtr->tcl_Seek) /* 491 */
#endif
#ifndef Tcl_Tell
#define Tcl_Tell \
	(tclStubsPtr->tcl_Tell) /* 492 */
#endif
#ifndef Tcl_ChannelWideSeekProc
#define Tcl_ChannelWideSeekProc \
	(tclStubsPtr->tcl_ChannelWideSeekProc) /* 493 */
#endif
#ifndef Tcl_DictObjPut
#define Tcl_DictObjPut \
	(tclStubsPtr->tcl_DictObjPut) /* 494 */
#endif
#ifndef Tcl_DictObjGet
#define Tcl_DictObjGet \
	(tclStubsPtr->tcl_DictObjGet) /* 495 */
#endif
#ifndef Tcl_DictObjRemove
#define Tcl_DictObjRemove \
	(tclStubsPtr->tcl_DictObjRemove) /* 496 */
#endif
#ifndef Tcl_DictObjSize
#define Tcl_DictObjSize \
	(tclStubsPtr->tcl_DictObjSize) /* 497 */
#endif
#ifndef Tcl_DictObjFirst
#define Tcl_DictObjFirst \
	(tclStubsPtr->tcl_DictObjFirst) /* 498 */
#endif
#ifndef Tcl_DictObjNext
#define Tcl_DictObjNext \
	(tclStubsPtr->tcl_DictObjNext) /* 499 */
#endif
#ifndef Tcl_DictObjDone
#define Tcl_DictObjDone \
	(tclStubsPtr->tcl_DictObjDone) /* 500 */
#endif
#ifndef Tcl_DictObjPutKeyList
#define Tcl_DictObjPutKeyList \
	(tclStubsPtr->tcl_DictObjPutKeyList) /* 501 */
#endif
#ifndef Tcl_DictObjRemoveKeyList
#define Tcl_DictObjRemoveKeyList \
	(tclStubsPtr->tcl_DictObjRemoveKeyList) /* 502 */
#endif
#ifndef Tcl_NewDictObj
#define Tcl_NewDictObj \
	(tclStubsPtr->tcl_NewDictObj) /* 503 */
#endif
#ifndef Tcl_DbNewDictObj
#define Tcl_DbNewDictObj \
	(tclStubsPtr->tcl_DbNewDictObj) /* 504 */
#endif
#ifndef Tcl_RegisterConfig
#define Tcl_RegisterConfig \
	(tclStubsPtr->tcl_RegisterConfig) /* 505 */
#endif
#ifndef Tcl_CreateNamespace
#define Tcl_CreateNamespace \
	(tclStubsPtr->tcl_CreateNamespace) /* 506 */
#endif
#ifndef Tcl_DeleteNamespace
#define Tcl_DeleteNamespace \
	(tclStubsPtr->tcl_DeleteNamespace) /* 507 */
#endif
#ifndef Tcl_AppendExportList
#define Tcl_AppendExportList \
	(tclStubsPtr->tcl_AppendExportList) /* 508 */
#endif
#ifndef Tcl_Export
#define Tcl_Export \
	(tclStubsPtr->tcl_Export) /* 509 */
#endif
#ifndef Tcl_Import
#define Tcl_Import \
	(tclStubsPtr->tcl_Import) /* 510 */
#endif
#ifndef Tcl_ForgetImport
#define Tcl_ForgetImport \
	(tclStubsPtr->tcl_ForgetImport) /* 511 */
#endif
#ifndef Tcl_GetCurrentNamespace
#define Tcl_GetCurrentNamespace \
	(tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
#endif
#ifndef Tcl_GetGlobalNamespace
#define Tcl_GetGlobalNamespace \
	(tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
#endif
#ifndef Tcl_FindNamespace
#define Tcl_FindNamespace \
	(tclStubsPtr->tcl_FindNamespace) /* 514 */
#endif
#ifndef Tcl_FindCommand
#define Tcl_FindCommand \
	(tclStubsPtr->tcl_FindCommand) /* 515 */
#endif
#ifndef Tcl_GetCommandFromObj
#define Tcl_GetCommandFromObj \
	(tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
#endif
#ifndef Tcl_GetCommandFullName
#define Tcl_GetCommandFullName \
	(tclStubsPtr->tcl_GetCommandFullName) /* 517 */
#endif
#ifndef Tcl_FSEvalFileEx
#define Tcl_FSEvalFileEx \
	(tclStubsPtr->tcl_FSEvalFileEx) /* 518 */
#endif
#ifndef Tcl_SetExitProc
#define Tcl_SetExitProc \
/* Slot 519 is reserved */
	(tclStubsPtr->tcl_SetExitProc) /* 519 */
#endif
#ifndef Tcl_LimitAddHandler
#define Tcl_LimitAddHandler \
	(tclStubsPtr->tcl_LimitAddHandler) /* 520 */
#endif
#ifndef Tcl_LimitRemoveHandler
#define Tcl_LimitRemoveHandler \
	(tclStubsPtr->tcl_LimitRemoveHandler) /* 521 */
#endif
#ifndef Tcl_LimitReady
#define Tcl_LimitReady \
	(tclStubsPtr->tcl_LimitReady) /* 522 */
#endif
#ifndef Tcl_LimitCheck
#define Tcl_LimitCheck \
	(tclStubsPtr->tcl_LimitCheck) /* 523 */
#endif
#ifndef Tcl_LimitExceeded
#define Tcl_LimitExceeded \
	(tclStubsPtr->tcl_LimitExceeded) /* 524 */
#endif
#ifndef Tcl_LimitSetCommands
#define Tcl_LimitSetCommands \
	(tclStubsPtr->tcl_LimitSetCommands) /* 525 */
#endif
#ifndef Tcl_LimitSetTime
#define Tcl_LimitSetTime \
	(tclStubsPtr->tcl_LimitSetTime) /* 526 */
#endif
#ifndef Tcl_LimitSetGranularity
#define Tcl_LimitSetGranularity \
	(tclStubsPtr->tcl_LimitSetGranularity) /* 527 */
#endif
#ifndef Tcl_LimitTypeEnabled
#define Tcl_LimitTypeEnabled \
	(tclStubsPtr->tcl_LimitTypeEnabled) /* 528 */
#endif
#ifndef Tcl_LimitTypeExceeded
#define Tcl_LimitTypeExceeded \
	(tclStubsPtr->tcl_LimitTypeExceeded) /* 529 */
#endif
#ifndef Tcl_LimitTypeSet
#define Tcl_LimitTypeSet \
	(tclStubsPtr->tcl_LimitTypeSet) /* 530 */
#endif
#ifndef Tcl_LimitTypeReset
#define Tcl_LimitTypeReset \
	(tclStubsPtr->tcl_LimitTypeReset) /* 531 */
#endif
#ifndef Tcl_LimitGetCommands
#define Tcl_LimitGetCommands \
	(tclStubsPtr->tcl_LimitGetCommands) /* 532 */
#endif
#ifndef Tcl_LimitGetTime
#define Tcl_LimitGetTime \
	(tclStubsPtr->tcl_LimitGetTime) /* 533 */
#endif
#ifndef Tcl_LimitGetGranularity
#define Tcl_LimitGetGranularity \
	(tclStubsPtr->tcl_LimitGetGranularity) /* 534 */
#endif
#ifndef Tcl_SaveInterpState
#define Tcl_SaveInterpState \
	(tclStubsPtr->tcl_SaveInterpState) /* 535 */
#endif
#ifndef Tcl_RestoreInterpState
#define Tcl_RestoreInterpState \
	(tclStubsPtr->tcl_RestoreInterpState) /* 536 */
#endif
#ifndef Tcl_DiscardInterpState
#define Tcl_DiscardInterpState \
	(tclStubsPtr->tcl_DiscardInterpState) /* 537 */
#endif
#ifndef Tcl_SetReturnOptions
#define Tcl_SetReturnOptions \
	(tclStubsPtr->tcl_SetReturnOptions) /* 538 */
#endif
#ifndef Tcl_GetReturnOptions
#define Tcl_GetReturnOptions \
	(tclStubsPtr->tcl_GetReturnOptions) /* 539 */
#endif
#ifndef Tcl_IsEnsemble
#define Tcl_IsEnsemble \
	(tclStubsPtr->tcl_IsEnsemble) /* 540 */
#endif
#ifndef Tcl_CreateEnsemble
#define Tcl_CreateEnsemble \
	(tclStubsPtr->tcl_CreateEnsemble) /* 541 */
#endif
#ifndef Tcl_FindEnsemble
#define Tcl_FindEnsemble \
	(tclStubsPtr->tcl_FindEnsemble) /* 542 */
#endif
#ifndef Tcl_SetEnsembleSubcommandList
#define Tcl_SetEnsembleSubcommandList \
	(tclStubsPtr->tcl_SetEnsembleSubcommandList) /* 543 */
#endif
#ifndef Tcl_SetEnsembleMappingDict
#define Tcl_SetEnsembleMappingDict \
	(tclStubsPtr->tcl_SetEnsembleMappingDict) /* 544 */
#endif
#ifndef Tcl_SetEnsembleUnknownHandler
#define Tcl_SetEnsembleUnknownHandler \
	(tclStubsPtr->tcl_SetEnsembleUnknownHandler) /* 545 */
#endif
#ifndef Tcl_SetEnsembleFlags
#define Tcl_SetEnsembleFlags \
	(tclStubsPtr->tcl_SetEnsembleFlags) /* 546 */
#endif
#ifndef Tcl_GetEnsembleSubcommandList
#define Tcl_GetEnsembleSubcommandList \
	(tclStubsPtr->tcl_GetEnsembleSubcommandList) /* 547 */
#endif
#ifndef Tcl_GetEnsembleMappingDict
#define Tcl_GetEnsembleMappingDict \
	(tclStubsPtr->tcl_GetEnsembleMappingDict) /* 548 */
#endif
#ifndef Tcl_GetEnsembleUnknownHandler
#define Tcl_GetEnsembleUnknownHandler \
	(tclStubsPtr->tcl_GetEnsembleUnknownHandler) /* 549 */
#endif
#ifndef Tcl_GetEnsembleFlags
#define Tcl_GetEnsembleFlags \
	(tclStubsPtr->tcl_GetEnsembleFlags) /* 550 */
#endif
#ifndef Tcl_GetEnsembleNamespace
#define Tcl_GetEnsembleNamespace \
	(tclStubsPtr->tcl_GetEnsembleNamespace) /* 551 */
#endif
#ifndef Tcl_SetTimeProc
#define Tcl_SetTimeProc \
	(tclStubsPtr->tcl_SetTimeProc) /* 552 */
#endif
#ifndef Tcl_QueryTimeProc
#define Tcl_QueryTimeProc \
	(tclStubsPtr->tcl_QueryTimeProc) /* 553 */
#endif
#ifndef Tcl_ChannelThreadActionProc
#define Tcl_ChannelThreadActionProc \
	(tclStubsPtr->tcl_ChannelThreadActionProc) /* 554 */
#endif
#ifndef Tcl_NewBignumObj
#define Tcl_NewBignumObj \
	(tclStubsPtr->tcl_NewBignumObj) /* 555 */
#endif
#ifndef Tcl_DbNewBignumObj
#define Tcl_DbNewBignumObj \
	(tclStubsPtr->tcl_DbNewBignumObj) /* 556 */
#endif
#ifndef Tcl_SetBignumObj
#define Tcl_SetBignumObj \
	(tclStubsPtr->tcl_SetBignumObj) /* 557 */
#endif
#ifndef Tcl_GetBignumFromObj
#define Tcl_GetBignumFromObj \
	(tclStubsPtr->tcl_GetBignumFromObj) /* 558 */
#endif
#ifndef Tcl_TakeBignumFromObj
#define Tcl_TakeBignumFromObj \
	(tclStubsPtr->tcl_TakeBignumFromObj) /* 559 */
#endif
#ifndef Tcl_TruncateChannel
#define Tcl_TruncateChannel \
	(tclStubsPtr->tcl_TruncateChannel) /* 560 */
#endif
#ifndef Tcl_ChannelTruncateProc
#define Tcl_ChannelTruncateProc \
	(tclStubsPtr->tcl_ChannelTruncateProc) /* 561 */
#endif
#ifndef Tcl_SetChannelErrorInterp
#define Tcl_SetChannelErrorInterp \
	(tclStubsPtr->tcl_SetChannelErrorInterp) /* 562 */
#endif
#ifndef Tcl_GetChannelErrorInterp
#define Tcl_GetChannelErrorInterp \
	(tclStubsPtr->tcl_GetChannelErrorInterp) /* 563 */
#endif
#ifndef Tcl_SetChannelError
#define Tcl_SetChannelError \
	(tclStubsPtr->tcl_SetChannelError) /* 564 */
#endif
#ifndef Tcl_GetChannelError
#define Tcl_GetChannelError \
	(tclStubsPtr->tcl_GetChannelError) /* 565 */
#endif
#ifndef Tcl_InitBignumFromDouble
#define Tcl_InitBignumFromDouble \
	(tclStubsPtr->tcl_InitBignumFromDouble) /* 566 */
#endif
#ifndef Tcl_GetNamespaceUnknownHandler
#define Tcl_GetNamespaceUnknownHandler \
	(tclStubsPtr->tcl_GetNamespaceUnknownHandler) /* 567 */
#endif
#ifndef Tcl_SetNamespaceUnknownHandler
#define Tcl_SetNamespaceUnknownHandler \
	(tclStubsPtr->tcl_SetNamespaceUnknownHandler) /* 568 */
#endif
#ifndef Tcl_GetEncodingFromObj
#define Tcl_GetEncodingFromObj \
	(tclStubsPtr->tcl_GetEncodingFromObj) /* 569 */
#endif
#ifndef Tcl_GetEncodingSearchPath
#define Tcl_GetEncodingSearchPath \
	(tclStubsPtr->tcl_GetEncodingSearchPath) /* 570 */
#endif
#ifndef Tcl_SetEncodingSearchPath
#define Tcl_SetEncodingSearchPath \
	(tclStubsPtr->tcl_SetEncodingSearchPath) /* 571 */
#endif
#ifndef Tcl_GetEncodingNameFromEnvironment
#define Tcl_GetEncodingNameFromEnvironment \
	(tclStubsPtr->tcl_GetEncodingNameFromEnvironment) /* 572 */
#endif
#ifndef Tcl_PkgRequireProc
#define Tcl_PkgRequireProc \
	(tclStubsPtr->tcl_PkgRequireProc) /* 573 */
#endif
#ifndef Tcl_AppendObjToErrorInfo
#define Tcl_AppendObjToErrorInfo \
	(tclStubsPtr->tcl_AppendObjToErrorInfo) /* 574 */
#endif
#ifndef Tcl_AppendLimitedToObj
#define Tcl_AppendLimitedToObj \
	(tclStubsPtr->tcl_AppendLimitedToObj) /* 575 */
#endif
#ifndef Tcl_Format
#define Tcl_Format \
	(tclStubsPtr->tcl_Format) /* 576 */
#endif
#ifndef Tcl_AppendFormatToObj
#define Tcl_AppendFormatToObj \
	(tclStubsPtr->tcl_AppendFormatToObj) /* 577 */
#endif
#ifndef Tcl_ObjPrintf
#define Tcl_ObjPrintf \
	(tclStubsPtr->tcl_ObjPrintf) /* 578 */
#endif
#ifndef Tcl_AppendPrintfToObj
#define Tcl_AppendPrintfToObj \
	(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
#define Tcl_CancelEval \
	(tclStubsPtr->tcl_CancelEval) /* 580 */
#define Tcl_Canceled \
	(tclStubsPtr->tcl_Canceled) /* 581 */
#define Tcl_CreatePipe \
	(tclStubsPtr->tcl_CreatePipe) /* 582 */
#define Tcl_NRCreateCommand \
	(tclStubsPtr->tcl_NRCreateCommand) /* 583 */
#define Tcl_NREvalObj \
	(tclStubsPtr->tcl_NREvalObj) /* 584 */
#define Tcl_NREvalObjv \
	(tclStubsPtr->tcl_NREvalObjv) /* 585 */
#define Tcl_NRCmdSwap \
	(tclStubsPtr->tcl_NRCmdSwap) /* 586 */
#define Tcl_NRAddCallback \
	(tclStubsPtr->tcl_NRAddCallback) /* 587 */
#define Tcl_NRCallObjProc \
	(tclStubsPtr->tcl_NRCallObjProc) /* 588 */
#define Tcl_GetFSDeviceFromStat \
	(tclStubsPtr->tcl_GetFSDeviceFromStat) /* 589 */
#define Tcl_GetFSInodeFromStat \
	(tclStubsPtr->tcl_GetFSInodeFromStat) /* 590 */
#define Tcl_GetModeFromStat \
	(tclStubsPtr->tcl_GetModeFromStat) /* 591 */
#define Tcl_GetLinkCountFromStat \
	(tclStubsPtr->tcl_GetLinkCountFromStat) /* 592 */
#define Tcl_GetUserIdFromStat \
	(tclStubsPtr->tcl_GetUserIdFromStat) /* 593 */
#endif
/* Slot 580 is reserved */
/* Slot 581 is reserved */
/* Slot 582 is reserved */
/* Slot 583 is reserved */
/* Slot 584 is reserved */
/* Slot 585 is reserved */
/* Slot 586 is reserved */
/* Slot 587 is reserved */
/* Slot 588 is reserved */
/* Slot 589 is reserved */
/* Slot 590 is reserved */
/* Slot 591 is reserved */
/* Slot 592 is reserved */
/* Slot 593 is reserved */
/* Slot 594 is reserved */
/* Slot 595 is reserved */
/* Slot 596 is reserved */
/* Slot 597 is reserved */
/* Slot 598 is reserved */
/* Slot 599 is reserved */
/* Slot 600 is reserved */
/* Slot 601 is reserved */
/* Slot 602 is reserved */
/* Slot 603 is reserved */
/* Slot 604 is reserved */
/* Slot 605 is reserved */
/* Slot 606 is reserved */
#define Tcl_GetGroupIdFromStat \
	(tclStubsPtr->tcl_GetGroupIdFromStat) /* 594 */
#define Tcl_GetDeviceTypeFromStat \
	(tclStubsPtr->tcl_GetDeviceTypeFromStat) /* 595 */
#define Tcl_GetAccessTimeFromStat \
	(tclStubsPtr->tcl_GetAccessTimeFromStat) /* 596 */
#define Tcl_GetModificationTimeFromStat \
	(tclStubsPtr->tcl_GetModificationTimeFromStat) /* 597 */
#define Tcl_GetChangeTimeFromStat \
	(tclStubsPtr->tcl_GetChangeTimeFromStat) /* 598 */
#define Tcl_GetSizeFromStat \
	(tclStubsPtr->tcl_GetSizeFromStat) /* 599 */
#define Tcl_GetBlocksFromStat \
	(tclStubsPtr->tcl_GetBlocksFromStat) /* 600 */
#define Tcl_GetBlockSizeFromStat \
	(tclStubsPtr->tcl_GetBlockSizeFromStat) /* 601 */
#define Tcl_SetEnsembleParameterList \
	(tclStubsPtr->tcl_SetEnsembleParameterList) /* 602 */
#define Tcl_GetEnsembleParameterList \
	(tclStubsPtr->tcl_GetEnsembleParameterList) /* 603 */
#define Tcl_ParseArgsObjv \
	(tclStubsPtr->tcl_ParseArgsObjv) /* 604 */
#define Tcl_GetErrorLine \
	(tclStubsPtr->tcl_GetErrorLine) /* 605 */
#define Tcl_SetErrorLine \
	(tclStubsPtr->tcl_SetErrorLine) /* 606 */
#define Tcl_TransferResult \
	(tclStubsPtr->tcl_TransferResult) /* 607 */
#define Tcl_InterpActive \
	(tclStubsPtr->tcl_InterpActive) /* 608 */
#define Tcl_BackgroundException \
	(tclStubsPtr->tcl_BackgroundException) /* 609 */
#define Tcl_ZlibDeflate \
	(tclStubsPtr->tcl_ZlibDeflate) /* 610 */
#define Tcl_ZlibInflate \
	(tclStubsPtr->tcl_ZlibInflate) /* 611 */
/* Slot 607 is reserved */
/* Slot 608 is reserved */
/* Slot 609 is reserved */
/* Slot 610 is reserved */
/* Slot 611 is reserved */
/* Slot 612 is reserved */
/* Slot 613 is reserved */
/* Slot 614 is reserved */
/* Slot 615 is reserved */
/* Slot 616 is reserved */
/* Slot 617 is reserved */
/* Slot 618 is reserved */
/* Slot 619 is reserved */
/* Slot 620 is reserved */
/* Slot 621 is reserved */
/* Slot 622 is reserved */
/* Slot 623 is reserved */
/* Slot 624 is reserved */
/* Slot 625 is reserved */
/* Slot 626 is reserved */
/* Slot 627 is reserved */
/* Slot 628 is reserved */
/* Slot 629 is reserved */
/* Slot 630 is reserved */
/* Slot 631 is reserved */
/* Slot 632 is reserved */
/* Slot 633 is reserved */
/* Slot 634 is reserved */
/* Slot 635 is reserved */
#define Tcl_ZlibCRC32 \
	(tclStubsPtr->tcl_ZlibCRC32) /* 612 */
#define Tcl_ZlibAdler32 \
	(tclStubsPtr->tcl_ZlibAdler32) /* 613 */
#define Tcl_ZlibStreamInit \
	(tclStubsPtr->tcl_ZlibStreamInit) /* 614 */
#define Tcl_ZlibStreamGetCommandName \
	(tclStubsPtr->tcl_ZlibStreamGetCommandName) /* 615 */
#define Tcl_ZlibStreamEof \
	(tclStubsPtr->tcl_ZlibStreamEof) /* 616 */
#define Tcl_ZlibStreamChecksum \
	(tclStubsPtr->tcl_ZlibStreamChecksum) /* 617 */
#define Tcl_ZlibStreamPut \
	(tclStubsPtr->tcl_ZlibStreamPut) /* 618 */
#define Tcl_ZlibStreamGet \
	(tclStubsPtr->tcl_ZlibStreamGet) /* 619 */
#define Tcl_ZlibStreamClose \
	(tclStubsPtr->tcl_ZlibStreamClose) /* 620 */
#define Tcl_ZlibStreamReset \
	(tclStubsPtr->tcl_ZlibStreamReset) /* 621 */
#define Tcl_SetStartupScript \
	(tclStubsPtr->tcl_SetStartupScript) /* 622 */
#define Tcl_GetStartupScript \
	(tclStubsPtr->tcl_GetStartupScript) /* 623 */
#define Tcl_CloseEx \
	(tclStubsPtr->tcl_CloseEx) /* 624 */
#define Tcl_NRExprObj \
	(tclStubsPtr->tcl_NRExprObj) /* 625 */
#define Tcl_NRSubstObj \
	(tclStubsPtr->tcl_NRSubstObj) /* 626 */
#define Tcl_LoadFile \
	(tclStubsPtr->tcl_LoadFile) /* 627 */
/* Slot 636 is reserved */
/* Slot 637 is reserved */
/* Slot 638 is reserved */
/* Slot 639 is reserved */
/* Slot 640 is reserved */
/* Slot 641 is reserved */
/* Slot 642 is reserved */
/* Slot 643 is reserved */
/* Slot 644 is reserved */
/* Slot 645 is reserved */
/* Slot 646 is reserved */
/* Slot 647 is reserved */
/* Slot 648 is reserved */
/* Slot 649 is reserved */
/* Slot 650 is reserved */
/* Slot 651 is reserved */
/* Slot 652 is reserved */
/* Slot 653 is reserved */
/* Slot 654 is reserved */
/* Slot 655 is reserved */
/* Slot 656 is reserved */
/* Slot 657 is reserved */
/* Slot 658 is reserved */
/* Slot 659 is reserved */
/* Slot 660 is reserved */
/* Slot 661 is reserved */
#define Tcl_FindSymbol \
	(tclStubsPtr->tcl_FindSymbol) /* 628 */
#define Tcl_FSUnloadFile \
	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
#define Tcl_OpenTcpServerEx \
	(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
/* Slot 662 is reserved */
/* Slot 663 is reserved */
#define TclZipfs_Mount \
	(tclStubsPtr->tclZipfs_Mount) /* 632 */
#define TclZipfs_Unmount \
	(tclStubsPtr->tclZipfs_Unmount) /* 633 */
#define TclZipfs_TclLibrary \
	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
#define TclZipfs_MountBuffer \
	(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */
#define Tcl_FreeIntRep \
	(tclStubsPtr->tcl_FreeIntRep) /* 636 */
#define Tcl_InitStringRep \
	(tclStubsPtr->tcl_InitStringRep) /* 637 */
#define Tcl_FetchIntRep \
	(tclStubsPtr->tcl_FetchIntRep) /* 638 */
#define Tcl_StoreIntRep \
	(tclStubsPtr->tcl_StoreIntRep) /* 639 */
#define Tcl_HasStringRep \
	(tclStubsPtr->tcl_HasStringRep) /* 640 */
#define Tcl_IncrRefCount \
	(tclStubsPtr->tcl_IncrRefCount) /* 641 */
#define Tcl_DecrRefCount \
	(tclStubsPtr->tcl_DecrRefCount) /* 642 */
#define Tcl_IsShared \
	(tclStubsPtr->tcl_IsShared) /* 643 */
#define Tcl_LinkArray \
	(tclStubsPtr->tcl_LinkArray) /* 644 */
#define Tcl_GetIntForIndex \
/* Slot 664 is reserved */
/* Slot 665 is reserved */
/* Slot 666 is reserved */
/* Slot 667 is reserved */
/* Slot 668 is reserved */
/* Slot 669 is reserved */
/* Slot 670 is reserved */
/* Slot 671 is reserved */
/* Slot 672 is reserved */
/* Slot 673 is reserved */
/* Slot 674 is reserved */
/* Slot 675 is reserved */
/* Slot 676 is reserved */
/* Slot 677 is reserved */
/* Slot 678 is reserved */
/* Slot 679 is reserved */
/* Slot 680 is reserved */
/* Slot 681 is reserved */
/* Slot 682 is reserved */
/* Slot 683 is reserved */
/* Slot 684 is reserved */
/* Slot 685 is reserved */
/* Slot 686 is reserved */
#ifndef TclUnusedStubEntry
#define TclUnusedStubEntry \
	(tclStubsPtr->tclUnusedStubEntry) /* 687 */
#endif
	(tclStubsPtr->tcl_GetIntForIndex) /* 645 */
#define Tcl_UtfToUniChar \
	(tclStubsPtr->tcl_UtfToUniChar) /* 646 */
#define Tcl_UniCharToUtfDString \
	(tclStubsPtr->tcl_UniCharToUtfDString) /* 647 */
#define Tcl_UtfToUniCharDString \
	(tclStubsPtr->tcl_UtfToUniCharDString) /* 648 */

#endif /* defined(USE_TCL_STUBS) */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#   undef Tcl_CreateInterp
#   undef Tcl_Init
#undef TclUnusedStubEntry
#   undef Tcl_ObjSetVar2
#   define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
#   define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
#   define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
	    (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif

#if defined(_WIN32) && defined(UNICODE)
#   define Tcl_FindExecutable(arg) ((Tcl_FindExecutable)((const char *)(arg)))
#   define Tcl_MainEx Tcl_MainExW
    EXTERN TCL_NORETURN void Tcl_MainExW(int argc, wchar_t **argv,
	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#undef Tcl_PkgPresent
#define Tcl_PkgPresent(interp, name, version, exact) \
	Tcl_PkgPresentEx(interp, name, version, exact, NULL)
#undef Tcl_PkgProvide
#define Tcl_PkgProvide(interp, name, version) \
	Tcl_PkgProvideEx(interp, name, version, NULL)
#undef Tcl_PkgRequire
#define Tcl_PkgRequire(interp, name, version, exact) \
	Tcl_PkgRequireEx(interp, name, version, exact, NULL)
#undef Tcl_GetIndexFromObj
#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
	Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \
	sizeof(char *), msg, flags, indexPtr)
#undef Tcl_NewBooleanObj
#define Tcl_NewBooleanObj(boolValue) \
	Tcl_NewWideIntObj((boolValue)!=0)
	Tcl_NewIntObj((boolValue)!=0)
#undef Tcl_DbNewBooleanObj
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
	Tcl_DbNewWideIntObj((boolValue)!=0, file, line)
	Tcl_DbNewLongObj((boolValue)!=0, file, line)
#undef Tcl_SetBooleanObj
#define Tcl_SetBooleanObj(objPtr, boolValue) \
	Tcl_SetWideIntObj(objPtr, (boolValue)!=0)
	Tcl_SetIntObj((objPtr), (boolValue)!=0)
#undef Tcl_SetVar
#define Tcl_SetVar(interp, varName, newValue, flags) \
	Tcl_SetVar2(interp, varName, NULL, newValue, flags)
#undef Tcl_UnsetVar
#define Tcl_UnsetVar(interp, varName, flags) \
	Tcl_UnsetVar2(interp, varName, NULL, flags)
#undef Tcl_GetVar
#define Tcl_GetVar(interp, varName, flags) \
	Tcl_GetVar2(interp, varName, NULL, flags)
#undef Tcl_TraceVar
#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
	Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)
#undef Tcl_UntraceVar
#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
	Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
#undef Tcl_VarTraceInfo
#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
	Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)
#undef Tcl_UpVar
#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
	Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
#define Tcl_AddErrorInfo(interp, message) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
#define Tcl_AddObjErrorInfo(interp, message, length) \
	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
#define Tcl_Eval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, 0)
#define Tcl_GlobalEval(interp, objPtr) \
	Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
#define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp))
#define Tcl_SaveResult(interp, statePtr) \
	do { \
	    *(statePtr) = Tcl_GetObjResult(interp); \
	    Tcl_IncrRefCount(*(statePtr)); \
	    Tcl_SetObjResult(interp, Tcl_NewObj()); \
	} while(0)
#define Tcl_RestoreResult(interp, statePtr) \
	do { \
	    Tcl_ResetResult(interp); \
   	    Tcl_SetObjResult(interp, *(statePtr)); \
   	    Tcl_DecrRefCount(*(statePtr)); \
	} while(0)
#define Tcl_DiscardResult(statePtr) \
	Tcl_DecrRefCount(*(statePtr))
#define Tcl_SetResult(interp, result, freeProc) \
	do { \
	    const char *__result = result; \
	    Tcl_FreeProc *__freeProc = freeProc; \
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
		if (__freeProc == TCL_DYNAMIC) { \
		    Tcl_Free((char *)__result); \
		} else { \
		    (*__freeProc)((char *)__result); \
		} \
	    } \
	} while(0)

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
#   if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the
 * Win64 signature. Cygwin64 stubbed extensions cannot use those stub
 * entries any more, they should use the 64-bit alternatives where
 * possible. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
#	undef Tcl_DbNewLongObj
#	undef Tcl_GetLongFromObj
#	undef Tcl_NewLongObj
#	undef Tcl_SetLongObj
#	undef Tcl_ExprLong
#	undef Tcl_ExprLongObj
#	undef Tcl_UniCharNcmp
#	undef Tcl_UtfNcmp
#	undef Tcl_UtfNcasecmp
#	undef Tcl_UniCharNcasecmp
#	define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
#	define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
#	define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
#	define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
#	define Tcl_ExprLong TclExprLong
	static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
	    int intValue;
	    int result = tclStubsPtr->tcl_ExprLong(interp, string, (long *)&intValue);
	    if (result == TCL_OK) *ptr = (long)intValue;
	    return result;
	}
#	define Tcl_ExprLongObj TclExprLongObj
	static inline int TclExprLongObj(Tcl_Interp *interp, Tcl_Obj *obj, long *ptr){
	    int intValue;
	    int result = tclStubsPtr->tcl_ExprLongObj(interp, obj, (long *)&intValue);
	    if (result == TCL_OK) *ptr = (long)intValue;
	    return result;
	}
#   endif
#	define Tcl_UniCharNcmp(ucs,uct,n) \
#endif

		((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcmp)(ucs,uct,(unsigned int)(n))
#ifdef TCL_MEM_DEBUG
#   undef Tcl_Alloc
#   define Tcl_Alloc(x) \
    (Tcl_DbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_Free
#   define Tcl_Free(x) \
#	define Tcl_UtfNcmp(s1,s2,n) \
    Tcl_DbCkfree((x), __FILE__, __LINE__)
#   undef Tcl_Realloc
#   define Tcl_Realloc(x,y) \
    (Tcl_DbCkrealloc((x), (y), __FILE__, __LINE__))
#   undef Tcl_AttemptAlloc
#   define Tcl_AttemptAlloc(x) \
    (Tcl_AttemptDbCkalloc((x), __FILE__, __LINE__))
#   undef Tcl_AttemptRealloc
#   define Tcl_AttemptRealloc(x,y) \
    (Tcl_AttemptDbCkrealloc((x), (y), __FILE__, __LINE__))
#endif /* !TCL_MEM_DEBUG */

		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcmp)(s1,s2,(unsigned int)(n))
#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
#	define Tcl_UtfNcasecmp(s1,s2,n) \
#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)
#define Tcl_BackgroundError(interp)	Tcl_BackgroundException((interp), TCL_ERROR)
#define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)

		((int(*)(const char*,const char*,unsigned int))tclStubsPtr->tcl_UtfNcasecmp)(s1,s2,(unsigned int)(n))
#if TCL_UTF_MAX <= 3
#   undef Tcl_UniCharToUtfDString
#   define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
#	define Tcl_UniCharNcasecmp(ucs,uct,n) \
#   undef Tcl_UtfToUniCharDString
#   define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
#   undef Tcl_UtfToUniChar
		((int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned int))tclStubsPtr->tcl_UniCharNcasecmp)(ucs,uct,(unsigned int)(n))
#   define Tcl_UtfToUniChar Tcl_UtfToChar16
#endif
#   endif
#if defined(USE_TCL_STUBS)
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, size_t, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, size_t, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, size_t, Tcl_DString *))tclStubsPtr->tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, size_t, Tcl_DString *))Tcl_UtfToChar16DString)
#   define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
		? (int (*)(const char *, wchar_t *))tclStubsPtr->tcl_UtfToChar16 \
		: (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar)
#else
#   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
		? (char *(*)(const wchar_t *, size_t, Tcl_DString *))Tcl_UniCharToUtfDString \
		: (char *(*)(const wchar_t *, size_t, Tcl_DString *))Tcl_Char16ToUtfDString)
#   define Tcl_UtfToWCharDString (sizeof(wchar_t) != sizeof(short) \
		? (wchar_t *(*)(const char *, size_t, Tcl_DString *))Tcl_UtfToUniCharDString \
		: (wchar_t *(*)(const char *, size_t, Tcl_DString *))Tcl_UtfToChar16DString)
#   define Tcl_UtfToWChar (sizeof(wchar_t) != sizeof(short) \
		? (int (*)(const char *, wchar_t *))Tcl_UtfToChar16 \
		: (int (*)(const char *, wchar_t *))Tcl_UtfToUniChar)
#endif

/*
 * Deprecated Tcl procedures:
 */

#undef Tcl_EvalObj
#define Tcl_EvalObj(interp, objPtr) \
    Tcl_EvalObjEx(interp, objPtr, 0)
#define Tcl_GlobalEvalObj(interp, objPtr) \
#define Tcl_EvalObj(interp,objPtr) \
    Tcl_EvalObjEx((interp),(objPtr),0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp,objPtr) \
    Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)

    Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#if defined(TCL_8_COMPAT) && !defined(BUILD_tcl)
#   ifdef USE_TCL_STUBS
#	undef Tcl_Gets
#	undef Tcl_GetsObj
#	undef Tcl_Read
#	undef Tcl_Ungets
#	undef Tcl_Write
#	undef Tcl_ReadChars
#	undef Tcl_WriteChars
#	undef Tcl_WriteObj
#	undef Tcl_ReadRaw
#	undef Tcl_WriteRaw
#	define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_Gets)(chan, dsPtr)+1))-1)
#	define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_GetsObj)(chan, objPtr)+1))-1)
#	define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((tclStubsPtr->tcl_Read)(chan, bufPtr, toRead)+1))-1)
#	define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((tclStubsPtr->tcl_Ungets)(chan, str, len, atHead)+1))-1)
#	define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((tclStubsPtr->tcl_Write)(chan, s, slen)+1))-1)
#	define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1)
#	define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteChars)(chan, src, srcLen)+1))-1)
#	define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteObj)(chan, objPtr)+1))-1)
#	define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((tclStubsPtr->tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1)
#	define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((tclStubsPtr->tcl_WriteRaw()(chan, src, srcLen)+1))-1)
#   else
#	define Tcl_Gets(chan, dsPtr) (((Tcl_WideInt)((Tcl_Gets)(chan, dsPtr)+1))-1)
#	define Tcl_GetsObj(chan, objPtr) (((Tcl_WideInt)((Tcl_GetsObj)(chan, objPtr)+1))-1)
#	define Tcl_Read(chan, bufPtr, toRead) (((Tcl_WideInt)((Tcl_Read)(chan, bufPtr, toRead)+1))-1)
#	define Tcl_Ungets(chan, str, len, atHead) (((Tcl_WideInt)((Tcl_Ungets)(chan, str, len, atHead)+1))-1)
#	define Tcl_Write(chan, s, slen) (((Tcl_WideInt)((Tcl_Write)(chan, s, slen)+1))-1)
#	define Tcl_ReadChars(channel, objPtr, charsToRead, appendFlag) (((Tcl_WideInt)((Tcl_ReadChars)(channel, objPtr, charsToRead, appendFlag)+1))-1)
#	define Tcl_WriteChars(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteChars)(chan, src, srcLen)+1))-1)
#	define Tcl_WriteObj(chan, objPtr) (((Tcl_WideInt)((Tcl_WriteObj)(chan, objPtr)+1))-1)
#	define Tcl_ReadRaw(chan, dst, bytesToRead) (((Tcl_WideInt)((Tcl_ReadRaw)(chan, dst, bytesToRead)+1))-1)
#	define Tcl_WriteRaw(chan, src, srcLen) (((Tcl_WideInt)((Tcl_WriteRaw()(chan, src, srcLen)+1))-1)
#   endif
#endif

#define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)

#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX <= 3)
#   undef Tcl_UtfCharComplete
#   define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= TCL_UTF_MAX) : tclStubsPtr->tcl_UtfCharComplete((src), (length)))
#endif
#ifndef TCL_NO_DEPRECATED
#   define Tcl_CreateSlave Tcl_CreateChild
#   define Tcl_GetSlave Tcl_GetChild
#   define Tcl_GetMaster Tcl_GetParent
#endif

#endif /* _TCLDECLS */

Changes to generic/tclDictObj.c.

1
2
3
4
5
6
7

8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56


















































57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75






76
77
78
79
80
81
82




83
84
85
86
87
88
89
90
91
92
93










94
95
96
97
98
99
100
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






-
+






-
+
-










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-






-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







/*
 * tclDictObj.c --
 *
 *	This file contains functions that implement the Tcl dict object type
 *	and its accessor command.
 *
 * Copyright (c) 2002-2010 by Donal K. Fellows.
 * Copyright (c) 2002 by Donal K. Fellows.
 *
 * 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 "tclTomMath.h"
#include "tommath.h"
#include <assert.h>

/*
 * Forward declaration.
 */
struct Dict;

/*
 * Prototypes for functions defined later in this file:
 */

static void			DeleteDict(struct Dict *dict);
static Tcl_ObjCmdProc		DictAppendCmd;
static Tcl_ObjCmdProc		DictCreateCmd;
static Tcl_ObjCmdProc		DictExistsCmd;
static Tcl_ObjCmdProc		DictFilterCmd;
static Tcl_ObjCmdProc		DictGetCmd;
static Tcl_ObjCmdProc		DictGetDefCmd;
static Tcl_ObjCmdProc		DictIncrCmd;
static Tcl_ObjCmdProc		DictInfoCmd;
static Tcl_ObjCmdProc		DictKeysCmd;
static Tcl_ObjCmdProc		DictLappendCmd;
static Tcl_ObjCmdProc		DictMergeCmd;
static Tcl_ObjCmdProc		DictRemoveCmd;
static Tcl_ObjCmdProc		DictReplaceCmd;
static Tcl_ObjCmdProc		DictSetCmd;
static Tcl_ObjCmdProc		DictSizeCmd;
static Tcl_ObjCmdProc		DictUnsetCmd;
static Tcl_ObjCmdProc		DictUpdateCmd;
static Tcl_ObjCmdProc		DictValuesCmd;
static Tcl_ObjCmdProc		DictWithCmd;
static Tcl_DupInternalRepProc	DupDictInternalRep;
static Tcl_FreeInternalRepProc	FreeDictInternalRep;
static void			InvalidateDictChain(Tcl_Obj *dictObj);
static Tcl_SetFromAnyProc	SetDictFromAny;
static Tcl_UpdateStringProc	UpdateStringOfDict;
static Tcl_AllocHashEntryProc	AllocChainEntry;
static inline void		InitChainTable(struct Dict *dict);
static inline void		DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *	CreateChainEntry(struct Dict *dict,
					Tcl_Obj *keyPtr, int *newPtr);
static inline int		DeleteChainEntry(struct Dict *dict,
static void		DeleteDict(struct Dict *dict);
static int		DictAppendCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictCreateCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictExistsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictFilterCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictForCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictGetCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictIncrCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictInfoCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictKeysCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictLappendCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictMergeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictRemoveCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictReplaceCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictSetCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictSizeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictUnsetCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictUpdateCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictValuesCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static int		DictWithCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const *objv);
static void		DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeDictInternalRep(Tcl_Obj *dictPtr);
static void		InvalidateDictChain(Tcl_Obj *dictObj);
static int		SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfDict(Tcl_Obj *dictPtr);
static Tcl_HashEntry *	AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr);
static inline void	InitChainTable(struct Dict *dict);
static inline void	DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
			    Tcl_Obj *keyPtr, int *newPtr);
static inline int	DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
					Tcl_Obj *keyPtr);
static Tcl_NRPostProc		FinalizeDictUpdate;
static Tcl_NRPostProc		FinalizeDictWith;
static Tcl_ObjCmdProc		DictForNRCmd;
static Tcl_ObjCmdProc		DictMapNRCmd;
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;

/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, NULL, NULL, 0 },
    {"filter",	DictFilterCmd,	NULL, NULL, NULL, 0 },
    {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
    {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd },
    {"create",	DictCreateCmd,	NULL },
    {"exists",	DictExistsCmd,	NULL },
    {"filter",	DictFilterCmd,	NULL },
    {"for",	DictForCmd,	TclCompileDictForCmd },
    {"get",	DictGetCmd,	TclCompileDictGetCmd },
    {"getdef",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd, NULL,NULL,0},
    {"getwithdefault",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd,
	NULL, NULL, 0 },
    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd, NULL, NULL, 0 },
    {"info",	DictInfoCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    {"keys",	DictKeysCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd, NULL, NULL, 0 },
    {"incr",	DictIncrCmd,	TclCompileDictIncrCmd },
    {"info",	DictInfoCmd,	NULL },
    {"keys",	DictKeysCmd,	NULL },
    {"lappend",	DictLappendCmd,	TclCompileDictLappendCmd },
    {"map", 	NULL,       	TclCompileDictMapCmd, DictMapNRCmd, NULL, 0 },
    {"merge",	DictMergeCmd,	TclCompileDictMergeCmd, NULL, NULL, 0 },
    {"remove",	DictRemoveCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
    {"replace",	DictReplaceCmd, NULL, NULL, NULL, 0 },
    {"set",	DictSetCmd,	TclCompileDictSetCmd, NULL, NULL, 0 },
    {"size",	DictSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    {"unset",	DictUnsetCmd,	TclCompileDictUnsetCmd, NULL, NULL, 0 },
    {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd, NULL, NULL, 0 },
    {"values",	DictValuesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    {"with",	DictWithCmd,	TclCompileDictWithCmd, NULL, NULL, 0 },
    {NULL, NULL, NULL, NULL, NULL, 0}
    {"merge",	DictMergeCmd,	NULL },
    {"remove",	DictRemoveCmd,	NULL },
    {"replace",	DictReplaceCmd,	NULL },
    {"set",	DictSetCmd,	TclCompileDictSetCmd },
    {"size",	DictSizeCmd,	NULL },
    {"unset",	DictUnsetCmd,	NULL },
    {"update",	DictUpdateCmd,	TclCompileDictUpdateCmd },
    {"values",	DictValuesCmd,	NULL },
    {"with",	DictWithCmd,	NULL },
    {NULL, NULL, NULL}
};

/*
 * Internal representation of the entries in the hash table that backs a
 * dictionary.
 */

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
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







-
-
+
+










-
+


-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
+

-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







				 * dictionary. Used for doing traversal of the
				 * entries in the order that they are
				 * created. */
    ChainEntry *entryChainTail;	/* Other end of linked list of all entries in
				 * the dictionary. Used for doing traversal of
				 * the entries in the order that they are
				 * created. */
    size_t epoch;		/* Epoch counter */
    size_t refCount;		/* Reference counter (see above) */
    int epoch;			/* Epoch counter */
    int refcount;		/* Reference counter (see above) */
    Tcl_Obj *chain;		/* Linked list used for invalidating the
				 * string representations of updated nested
				 * dictionaries. */
} Dict;

/*
 * The structure below defines the dictionary object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclDictType = {
Tcl_ObjType tclDictType = {
    "dict",
    FreeDictInternalRep,		/* freeIntRepProc */
    DupDictInternalRep,			/* dupIntRepProc */
    DupDictInternalRep,		        /* dupIntRepProc */
    UpdateStringOfDict,			/* updateStringProc */
    SetDictFromAny			/* setFromAnyProc */
};

#define DictSetIntRep(objPtr, dictRepPtr)				\
    do {                                                                \
        Tcl_ObjIntRep ir;                                               \
        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
        ir.twoPtrValue.ptr2 = NULL;                                     \
        Tcl_StoreIntRep((objPtr), &tclDictType, &ir);                   \
    } while (0)

#define DictGetIntRep(objPtr, dictRepPtr)				\
    do {                                                                \
        const Tcl_ObjIntRep *irPtr;                                     \
        irPtr = TclFetchIntRep((objPtr), &tclDictType);                \
        (dictRepPtr) = irPtr ? (Dict *)irPtr->twoPtrValue.ptr1 : NULL;          \
    } while (0)

/*
 * The type of the specially adapted version of the Tcl_Obj*-containing hash
 * table defined in the tclObj.c code. This version differs in that it
 * allocates a bit more space in each hash entry in order to hold the pointers
 * used to keep the hash entries in a linked list.
 *
 * Note that this type of hash table is *only* suitable for direct use in
 * *this* file. Everything else should use the dict iterator API.
 */

static const Tcl_HashKeyType chainHashType = {
static Tcl_HashKeyType chainHashType = {
    TCL_HASH_KEY_TYPE_VERSION,
    0,
    TCL_HASH_KEY_DIRECT_COMPARE,        /* allows compare keys by pointers */
    TclHashObjKey,
    TclCompareObjKeys,
    AllocChainEntry,
    TclFreeObjEntry
};

/*
 * Structure used in implementation of 'dict map' to hold the state that gets
 * passed between parts of the implementation.
 */

typedef struct {
    Tcl_Obj *keyVarObj;		/* The name of the variable that will have
				 * keys assigned to it. */
    Tcl_Obj *valueVarObj;	/* The name of the variable that will have
				 * values assigned to it. */
    Tcl_DictSearch search;	/* The dictionary search structure. */
    Tcl_Obj *scriptObj;		/* The script to evaluate each time through
				 * the loop. */
    Tcl_Obj *accumulatorObj;	/* The dictionary used to accumulate the
				 * results. */
} DictMapStorage;

/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/

/*
 *----------------------------------------------------------------------
 *
 * AllocChainEntry --
218
219
220
221
222
223
224
225

226
227
228

229
230
231
232


233
234

235
236
237
238
239
240
241
193
194
195
196
197
198
199

200
201
202

203
204
205


206
207
208

209
210
211
212
213
214
215
216







-
+


-
+


-
-
+
+

-
+







 *	Increments the reference count on the object.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocChainEntry(
    TCL_UNUSED(Tcl_HashTable *),
    Tcl_HashTable *tablePtr,
    void *keyPtr)
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr = keyPtr;
    ChainEntry *cPtr;

    cPtr = (ChainEntry *)Tcl_Alloc(sizeof(ChainEntry));
    cPtr->entry.key.objPtr = objPtr;
    cPtr = (ChainEntry *) ckalloc(sizeof(ChainEntry));
    cPtr->entry.key.oneWordValue = (char *) objPtr;
    Tcl_IncrRefCount(objPtr);
    Tcl_SetHashValue(&cPtr->entry, NULL);
    cPtr->entry.clientData = NULL;
    cPtr->prevPtr = cPtr->nextPtr = NULL;

    return &cPtr->entry;
}

/*
 * Helper functions that disguise most of the details relating to how the
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
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







-
+













-
+







static inline void
DeleteChainTable(
    Dict *dict)
{
    ChainEntry *cPtr;

    for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);

	TclDecrRefCount(valuePtr);
    }
    Tcl_DeleteHashTable(&dict->table);
}

static inline Tcl_HashEntry *
CreateChainEntry(
    Dict *dict,
    Tcl_Obj *keyPtr,
    int *newPtr)
{
    ChainEntry *cPtr = (ChainEntry *)
	    Tcl_CreateHashEntry(&dict->table, keyPtr, newPtr);
	    Tcl_CreateHashEntry(&dict->table, (char *) keyPtr, newPtr);

    /*
     * If this is a new entry in the hash table, stitch it into the chain.
     */

    if (*newPtr) {
	cPtr->nextPtr = NULL;
299
300
301
302
303
304
305
306

307
308
309
310
311

312
313
314
315
316
317
318
319
274
275
276
277
278
279
280

281
282
283
284
285

286

287
288
289
290
291
292
293







-
+




-
+
-








static inline int
DeleteChainEntry(
    Dict *dict,
    Tcl_Obj *keyPtr)
{
    ChainEntry *cPtr = (ChainEntry *)
	    Tcl_FindHashEntry(&dict->table, keyPtr);
	    Tcl_FindHashEntry(&dict->table, (char *) keyPtr);

    if (cPtr == NULL) {
	return 0;
    } else {
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);

	TclDecrRefCount(valuePtr);
    }

    /*
     * Unstitch from the chain.
     */

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
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







+
-
+


-
-






-
-
+
+







-
+







-
+

-
+





+
-
+







 */

static void
DupDictInternalRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    Dict *oldDict = srcPtr->internalRep.twoPtrValue.ptr1;
    Dict *oldDict, *newDict = (Dict *)Tcl_Alloc(sizeof(Dict));
    Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
    ChainEntry *cPtr;

    DictGetIntRep(srcPtr, oldDict);

    /*
     * Copy values across from the old hash table.
     */

    InitChainTable(newDict);
    for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
	Tcl_Obj *key = (Tcl_Obj *)Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
	Tcl_Obj *valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	void *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
	Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
	int n;
	Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);

	/*
	 * Fill in the contents.
	 */

	Tcl_SetHashValue(hPtr, valuePtr);
	Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
	Tcl_IncrRefCount(valuePtr);
    }

    /*
     * Initialise other fields.
     */

    newDict->epoch = 1;
    newDict->epoch = 0;
    newDict->chain = NULL;
    newDict->refCount = 1;
    newDict->refcount = 1;

    /*
     * Store in the object.
     */

    copyPtr->internalRep.twoPtrValue.ptr1 = newDict;
    DictSetIntRep(copyPtr, newDict);
    copyPtr->typePtr = &tclDictType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeDictInternalRep --
 *
416
417
418
419
420
421
422
423

424
425
426
427


428
429

430
431
432
433
434
435
436
390
391
392
393
394
395
396

397
398



399
400
401
402
403
404
405
406
407
408
409
410







-
+

-
-
-
+
+


+







 *----------------------------------------------------------------------
 */

static void
FreeDictInternalRep(
    Tcl_Obj *dictPtr)
{
    Dict *dict;
    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;

    DictGetIntRep(dictPtr, dict);

    if (dict->refCount-- <= 1) {
    --dict->refcount;
    if (dict->refcount <= 0) {
	DeleteDict(dict);
    }
    dictPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteDict --
 *
450
451
452
453
454
455
456
457

458
459
460
461
462
463
464
424
425
426
427
428
429
430

431
432
433
434
435
436
437
438







-
+







 */

static void
DeleteDict(
    Dict *dict)
{
    DeleteChainTable(dict);
    Tcl_Free(dict);
    ckfree((char *) dict);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDict --
 *
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
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
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







-
-
-
+
+
+


-
+
-
-
+
+






-
-
-
-
-
-
-
+



-
+
+









+
+

-
+








-
+


+
+
+
+

-
+


+
+
+
+
+
+







-
-
+
+
+


-
+





-
+




-
+


-
+







 *----------------------------------------------------------------------
 */

static void
UpdateStringOfDict(
    Tcl_Obj *dictPtr)
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict;
#define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
    Dict *dict = dictPtr->internalRep.twoPtrValue.ptr1;
    ChainEntry *cPtr;
    Tcl_Obj *keyPtr, *valuePtr;
    size_t i, length, bytesNeeded = 0;
    int i, length, bytesNeeded = 0;
    const char *elem;
    char *dst;
    char *elem, *dst;
    const int maxFlags = UINT_MAX / sizeof(int);

    /*
     * This field is the most useful one in the whole hash structure, and it
     * is not exposed by any API function...
     */

    size_t numElems;

    DictGetIntRep(dictPtr, dict);

    assert (dict != NULL);

    numElems = dict->table.numEntries * 2;
    int numElems = dict->table.numEntries * 2;

    /* Handle empty list case first, simplifies what follows */
    if (numElems == 0) {
	Tcl_InitStringRep(dictPtr, NULL, 0);
	dictPtr->bytes = tclEmptyStringRep;
	dictPtr->length = 0;
	return;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else if (numElems > maxFlags) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    } else {
	flagPtr = (char *)Tcl_Alloc(numElems);
	flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
    }
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	/*
	 * Assume that cPtr is never NULL since we know the number of array
	 * elements already.
	 */

	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}

	flagPtr[i+1] = TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i+1);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    TclOOM(dst, bytesNeeded);
    dictPtr->length = bytesNeeded - 1;
    dictPtr->bytes = ckalloc((unsigned) bytesNeeded);
    dst = dictPtr->bytes;
    for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	keyPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
	elem = TclGetStringFromObj(keyPtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';

	flagPtr[i+1] |= TCL_DONT_QUOTE_HASH;
	valuePtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	valuePtr = Tcl_GetHashValue(&cPtr->entry);
	elem = TclGetStringFromObj(valuePtr, &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
	*dst++ = ' ';
    }
    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
    dictPtr->bytes[dictPtr->length] = '\0';

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
	ckfree((char *) flagPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SetDictFromAny --
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
618

619
620
621
622
623
624
625
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
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
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
618
619
620
621
622

623

624



625
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


686
687
688
689
690
691
692


693

694






695
696
697







698
699




700




701
702
703
704
705
706
707







-
-
+
+









-
+














-
+







-
+







-
+






-
+
-

-
-
-
+
+
+
+












-
-

-
-
-
+
-
-
+
+


-
-
+
+
+

-
+






-
-

-
+
-
-
-
-
+
+





-
+















+
-
+

-
-
+
+
+




-
-
+
-

-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
-
-
-
-
+
-
-
-
-








static int
SetDictFromAny(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Dict *dict = (Dict *)Tcl_Alloc(sizeof(Dict));
    int isNew, result;
    Dict *dict = (Dict *) ckalloc(sizeof(Dict));

    InitChainTable(dict);

    /*
     * Since lists and dictionaries have very closely-related string
     * representations (i.e. the same parsing code) we can safely special-case
     * the conversion from lists to dictionaries.
     */

    if (TclHasIntRep(objPtr, &tclListType)) {
    if (objPtr->typePtr == &tclListType) {
	int objc, i;
	Tcl_Obj **objv;

	/* Cannot fail, we already know the Tcl_ObjType is "list". */
	TclListObjGetElements(NULL, objPtr, &objc, &objv);
	if (objc & 1) {
	    goto missingValue;
	}

	for (i=0 ; i<objc ; i+=2) {

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, objv[i], &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);

		/*
		 * Not really a well-formed dictionary as there are duplicate
		 * keys, so better get the string rep here so that we can
		 * convert back.
		 */

		(void) TclGetString(objPtr);
		(void) Tcl_GetString(objPtr);

		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, objv[i+1]);
	    Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
	}
    } else {
	size_t length;
	int length;
	const char *nextElem = TclGetStringFromObj(objPtr, &length);
	const char *limit = (nextElem + length);

	while (nextElem < limit) {
	    Tcl_Obj *keyPtr, *valuePtr;
	    const char *elemStart;
	    size_t elemSize;
	    int elemSize, literal;
	    int literal;

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
		goto errorInFindDictElement;
	    result = TclFindElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal);
	    if (result != TCL_OK) {
		goto errorExit;
	    }
	    if (elemStart == limit) {
		break;
	    }
	    if (nextElem == limit) {
		goto missingValue;
	    }

	    if (literal) {
		TclNewStringObj(keyPtr, elemStart, elemSize);
	    } else {
		/* Avoid double copy */
		char *dst;

		TclNewObj(keyPtr);
		Tcl_InvalidateStringRep(keyPtr);
		dst = Tcl_InitStringRep(keyPtr, NULL, elemSize);
		TclOOM(dst, elemSize); /* Consider error */
		keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
		(void)Tcl_InitStringRep(keyPtr, NULL,
			TclCopyAndCollapse(elemSize, elemStart, dst));
		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
			keyPtr->bytes);
	    }

	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal) != TCL_OK) {
	    result = TclFindElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal);
	    if (result != TCL_OK) {
		TclDecrRefCount(keyPtr);
		goto errorInFindDictElement;
		goto errorExit;
	    }

	    if (literal) {
		TclNewStringObj(valuePtr, elemStart, elemSize);
	    } else {
		/* Avoid double copy */
		char *dst;

		TclNewObj(valuePtr);
		Tcl_InvalidateStringRep(valuePtr);
		valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
		dst = Tcl_InitStringRep(valuePtr, NULL, elemSize);
		TclOOM(dst, elemSize); /* Consider error */
		(void)Tcl_InitStringRep(valuePtr, NULL,
			TclCopyAndCollapse(elemSize, elemStart, dst));
		valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
			valuePtr->bytes);
	    }

	    /* Store key and value in the hash table we're building. */
	    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
	    if (!isNew) {
		Tcl_Obj *discardedValue = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);

		TclDecrRefCount(keyPtr);
		TclDecrRefCount(discardedValue);
	    }
	    Tcl_SetHashValue(hPtr, valuePtr);
	    Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
	}
    }

    /*
     * Free the old internalRep before setting the new one. We do this as late
     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use that old internalRep.
     */

    TclFreeIntRep(objPtr);
    dict->epoch = 1;
    dict->epoch = 0;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(objPtr, dict);
    dict->refcount = 1;
    objPtr->internalRep.twoPtrValue.ptr1 = dict;
    objPtr->typePtr = &tclDictType;
    return TCL_OK;

  missingValue:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing value to go with key", -1));
	Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
    }
  errorInFindDictElement:
    DeleteChainTable(dict);
    Tcl_Free(dict);
    return TCL_ERROR;
}

    result = TCL_ERROR;

  errorExit:
static Dict *
GetDictFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr)
{
    Dict *dict;

    DeleteChainTable(dict);
    ckfree((char *) dict);
    DictGetIntRep(dictPtr, dict);
    if (dict == NULL) {
	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
	    return NULL;
    return result;
	}
	DictGetIntRep(dictPtr, dict);
    }
    return dict;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTraceDictPath --
 *
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
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







-
-
+



-

+





-
+










-
-
+
+
+
-















-
-
+
+
-
-
-






-
+





-
+

-
+







    int keyc,
    Tcl_Obj *const keyv[],
    int flags)
{
    Dict *dict, *newDict;
    int i;

    DictGetIntRep(dictPtr, dict);
    if (dict == NULL) {
    if (dictPtr->typePtr != &tclDictType) {
	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
	    return NULL;
	}
	DictGetIntRep(dictPtr, dict);
    }
    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    if (flags & DICT_PATH_UPDATE) {
	dict->chain = NULL;
    }

    for (i=0 ; i<keyc ; i++) {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, keyv[i]);
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[i]);
	Tcl_Obj *tmpObj;

	if (hPtr == NULL) {
	    int isNew;			/* Dummy */

	    if (flags & DICT_PATH_EXISTS) {
		return DICT_PATH_NON_EXISTENT;
	    }
	    if ((flags & DICT_PATH_CREATE) != DICT_PATH_CREATE) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "key \"%s\" not known in dictionary",
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "key \"", TclGetString(keyv[i]),
			    "\" not known in dictionary", NULL);
			    TclGetString(keyv[i])));
		    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
			    TclGetString(keyv[i]), NULL);
		}
		return NULL;
	    }

	    /*
	     * The next line should always set isNew to 1.
	     */

	    hPtr = CreateChainEntry(dict, keyv[i], &isNew);
	    tmpObj = Tcl_NewDictObj();
	    Tcl_IncrRefCount(tmpObj);
	    Tcl_SetHashValue(hPtr, tmpObj);
	} else {
	    tmpObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	    tmpObj = Tcl_GetHashValue(hPtr);
	    if (tmpObj->typePtr != &tclDictType) {
	    DictGetIntRep(tmpObj, newDict);

	    if (newDict == NULL) {
		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
		    return NULL;
		}
	    }
	}

	DictGetIntRep(tmpObj, newDict);
	newDict = tmpObj->internalRep.twoPtrValue.ptr1;
	if (flags & DICT_PATH_UPDATE) {
	    if (Tcl_IsShared(tmpObj)) {
		TclDecrRefCount(tmpObj);
		tmpObj = Tcl_DuplicateObj(tmpObj);
		Tcl_IncrRefCount(tmpObj);
		Tcl_SetHashValue(hPtr, tmpObj);
		Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
		dict->epoch++;
		DictGetIntRep(tmpObj, newDict);
		newDict = tmpObj->internalRep.twoPtrValue.ptr1;
	    }

	    newDict->chain = dictPtr;
	}
	dict = newDict;
	dictPtr = tmpObj;
    }
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
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







-
+

-
-
-

-

-
-
-






-
+







 *----------------------------------------------------------------------
 */

static void
InvalidateDictChain(
    Tcl_Obj *dictObj)
{
    Dict *dict;
    Dict *dict = dictObj->internalRep.twoPtrValue.ptr1;

    DictGetIntRep(dictObj, dict);
    assert( dict != NULL);

    do {
	dict->refCount++;
	TclInvalidateStringRep(dictObj);
	TclFreeIntRep(dictObj);
	DictSetIntRep(dictObj, dict);

	dict->epoch++;
	dictObj = dict->chain;
	if (dictObj == NULL) {
	    break;
	}
	dict->chain = NULL;
	DictGetIntRep(dictObj, dict);
	dict = dictObj->internalRep.twoPtrValue.ptr1;
    } while (dict != NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictObjPut --
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
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







+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-


-
+







    Tcl_HashEntry *hPtr;
    int isNew;

    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
    }

    if (dictPtr->typePtr != &tclDictType) {
    dict = GetDictFromObj(interp, dictPtr);
    if (dict == NULL) {
	return TCL_ERROR;
    }

    TclInvalidateStringRep(dictPtr);
	int result = SetDictFromAny(interp, dictPtr);

	if (result != TCL_OK) {
	    return result;
	}
    }

    if (dictPtr->bytes != NULL) {
	TclInvalidateStringRep(dictPtr);
    }
    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    hPtr = CreateChainEntry(dict, keyPtr, &isNew);
    dict->refCount++;
    TclFreeIntRep(dictPtr)
    DictSetIntRep(dictPtr, dict);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);

	TclDecrRefCount(oldValuePtr);
    }
    Tcl_SetHashValue(hPtr, valuePtr);
    dict->epoch++;
    return TCL_OK;
}
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
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







+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+



-
+







    Tcl_Obj *dictPtr,
    Tcl_Obj *keyPtr,
    Tcl_Obj **valuePtrPtr)
{
    Dict *dict;
    Tcl_HashEntry *hPtr;

    if (dictPtr->typePtr != &tclDictType) {
    dict = GetDictFromObj(interp, dictPtr);
    if (dict == NULL) {
	*valuePtrPtr = NULL;
	return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
	int result = SetDictFromAny(interp, dictPtr);
	if (result != TCL_OK) {
	    *valuePtrPtr = NULL;
	    return result;
	}
    }

    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
    if (hPtr == NULL) {
	*valuePtrPtr = NULL;
    } else {
	*valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	*valuePtrPtr = Tcl_GetHashValue(hPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038







1039



1040
1041
1042
1043
1044
1045
1046
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







+
-
-
-
-
-
-
+
+
+
+
+
+
+

+
+
+







{
    Dict *dict;

    if (Tcl_IsShared(dictPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
    }

    if (dictPtr->typePtr != &tclDictType) {
    dict = GetDictFromObj(interp, dictPtr);
    if (dict == NULL) {
	return TCL_ERROR;
    }

    if (DeleteChainEntry(dict, keyPtr)) {
	int result = SetDictFromAny(interp, dictPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    if (dictPtr->bytes != NULL) {
	TclInvalidateStringRep(dictPtr);
    }
    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    if (DeleteChainEntry(dict, keyPtr)) {
	dict->epoch++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075







1076
1077
1078
1079
1080
1081
1082
1024
1025
1026
1027
1028
1029
1030
1031





1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045







+
-
-
-
-
-
+
+
+
+
+
+
+







Tcl_DictObjSize(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    int *sizePtr)
{
    Dict *dict;

    if (dictPtr->typePtr != &tclDictType) {
    dict = GetDictFromObj(interp, dictPtr);
    if (dict == NULL) {
	return TCL_ERROR;
    }

	int result = SetDictFromAny(interp, dictPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    *sizePtr = dict->table.numEntries;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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







+
-
-
-
-
-
+
+
+
+
+
+
+
+


-
+






-
+

-
+
+


-
+







				 * written into when there are no further
				 * values in the dictionary, or a 0
				 * otherwise. */
{
    Dict *dict;
    ChainEntry *cPtr;

    if (dictPtr->typePtr != &tclDictType) {
    dict = GetDictFromObj(interp, dictPtr);
    if (dict == NULL) {
	return TCL_ERROR;
    }

	int result = SetDictFromAny(interp, dictPtr);

	if (result != TCL_OK) {
	    return result;
	}
    }

    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    cPtr = dict->entryChainHead;
    if (cPtr == NULL) {
	searchPtr->epoch = 0;
	searchPtr->epoch = -1;
	*donePtr = 1;
    } else {
	*donePtr = 0;
	searchPtr->dictionaryPtr = (Tcl_Dict) dict;
	searchPtr->epoch = dict->epoch;
	searchPtr->next = cPtr->nextPtr;
	dict->refCount++;
	dict->refcount++;
	if (keyPtrPtr != NULL) {
	    *keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(&dict->table, &cPtr->entry);
	    *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table,
		    &cPtr->entry);
	}
	if (valuePtrPtr != NULL) {
	    *valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	    *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
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







-
+













-
+









-
+



-
+







{
    ChainEntry *cPtr;

    /*
     * If the searh is done; we do no work.
     */

    if (!searchPtr->epoch) {
    if (searchPtr->epoch == -1) {
	*donePtr = 1;
	return;
    }

    /*
     * Bail out if the dictionary has had any elements added, modified or
     * removed. This *shouldn't* happen, but...
     */

    if (((Dict *)searchPtr->dictionaryPtr)->epoch != searchPtr->epoch) {
	Tcl_Panic("concurrent dictionary modification and search");
    }

    cPtr = (ChainEntry *)searchPtr->next;
    cPtr = searchPtr->next;
    if (cPtr == NULL) {
	Tcl_DictObjDone(searchPtr);
	*donePtr = 1;
	return;
    }

    searchPtr->next = cPtr->nextPtr;
    *donePtr = 0;
    if (keyPtrPtr != NULL) {
	*keyPtrPtr = (Tcl_Obj *)Tcl_GetHashKey(
	*keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
		&((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
    }
    if (valuePtrPtr != NULL) {
	*valuePtrPtr = (Tcl_Obj *)Tcl_GetHashValue(&cPtr->entry);
	*valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DictObjDone --
1240
1241
1242
1243
1244
1245
1246
1247
1248


1249

1250

1251
1252
1253
1254
1255
1256
1257
1208
1209
1210
1211
1212
1213
1214


1215
1216
1217
1218

1219
1220
1221
1222
1223
1224
1225
1226







-
-
+
+

+
-
+








void
Tcl_DictObjDone(
    Tcl_DictSearch *searchPtr)		/* Pointer to a hash search context. */
{
    Dict *dict;

    if (searchPtr->epoch) {
	searchPtr->epoch = 0;
    if (searchPtr->epoch != -1) {
	searchPtr->epoch = -1;
	dict = (Dict *) searchPtr->dictionaryPtr;
	dict->refcount--;
	if (dict->refCount-- <= 1) {
	if (dict->refcount <= 0) {
	    DeleteDict(dict);
	}
    }
}

/*
 *----------------------------------------------------------------------
1293
1294
1295
1296
1297
1298
1299
1300

1301
1302
1303
1304
1305

1306
1307
1308
1309
1310
1311
1312
1313
1262
1263
1264
1265
1266
1267
1268

1269

1270
1271
1272

1273

1274
1275
1276
1277
1278
1279
1280







-
+
-



-
+
-







    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_CREATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }

    DictGetIntRep(dictPtr, dict);
    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    assert(dict != NULL);
    hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
    Tcl_IncrRefCount(valuePtr);
    if (!isNew) {
	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);

	TclDecrRefCount(oldValuePtr);
    }
    Tcl_SetHashValue(hPtr, valuePtr);
    InvalidateDictChain(dictPtr);

    return TCL_OK;
}
1351
1352
1353
1354
1355
1356
1357
1358

1359
1360
1361
1362
1363
1364
1365
1366
1318
1319
1320
1321
1322
1323
1324

1325

1326
1327
1328
1329
1330
1331
1332







-
+
-







    }

    dictPtr = TclTraceDictPath(interp, dictPtr, keyc-1,keyv, DICT_PATH_UPDATE);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }

    DictGetIntRep(dictPtr, dict);
    dict = dictPtr->internalRep.twoPtrValue.ptr1;
    assert(dict != NULL);
    DeleteChainEntry(dict, keyv[keyc-1]);
    InvalidateDictChain(dictPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1393
1394
1395
1396
1397
1398
1399
1400

1401
1402

1403
1404
1405



1406
1407
1408
1409
1410
1411
1412
1359
1360
1361
1362
1363
1364
1365

1366
1367

1368
1369


1370
1371
1372
1373
1374
1375
1376
1377
1378
1379







-
+

-
+

-
-
+
+
+







#else /* !TCL_MEM_DEBUG */

    Tcl_Obj *dictPtr;
    Dict *dict;

    TclNewObj(dictPtr);
    TclInvalidateStringRep(dictPtr);
    dict = (Dict *)Tcl_Alloc(sizeof(Dict));
    dict = (Dict *) ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->epoch = 0;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    dict->refcount = 1;
    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
    dictPtr->typePtr = &tclDictType;
    return dictPtr;
#endif
}

/*
 *----------------------------------------------------------------------
 *
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
1458
1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470
1471
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







-





+





-
+

-
+

-
-
+
+
+

-

-
-
-
-
-

-

+







 *
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewDictObj(
    const char *file,
    int line)
{
#ifdef TCL_MEM_DEBUG
    Tcl_Obj *dictPtr;
    Dict *dict;

    TclDbNewObj(dictPtr, file, line);
    TclInvalidateStringRep(dictPtr);
    dict = (Dict *)Tcl_Alloc(sizeof(Dict));
    dict = (Dict *) ckalloc(sizeof(Dict));
    InitChainTable(dict);
    dict->epoch = 1;
    dict->epoch = 0;
    dict->chain = NULL;
    dict->refCount = 1;
    DictSetIntRep(dictPtr, dict);
    dict->refcount = 1;
    dictPtr->internalRep.twoPtrValue.ptr1 = dict;
    dictPtr->typePtr = &tclDictType;
    return dictPtr;
}
#else /* !TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewDictObj(
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    return Tcl_NewDictObj();
}
#endif
}

/***** START OF FUNCTIONS IMPLEMENTING TCL COMMANDS *****/

/*
 *----------------------------------------------------------------------
 *
 * DictCreateCmd --
1481
1482
1483
1484
1485
1486
1487
1488

1489
1490
1491
1492
1493
1494
1495
1443
1444
1445
1446
1447
1448
1449

1450
1451
1452
1453
1454
1455
1456
1457







-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictCreateCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictObj;
    int i;

1505
1506
1507
1508
1509
1510
1511
1512

1513
1514
1515
1516
1517
1518
1519
1467
1468
1469
1470
1471
1472
1473

1474
1475
1476
1477
1478
1479
1480
1481







-
+







    }

    dictObj = Tcl_NewDictObj();
    for (i=1 ; i<objc ; i+=2) {
	/*
	 * The next command is assumed to never fail...
	 */
	Tcl_DictObjPut(NULL, dictObj, objv[i], objv[i+1]);
	Tcl_DictObjPut(interp, dictObj, objv[i], objv[i+1]);
    }
    Tcl_SetObjResult(interp, dictObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1531
1532
1533
1534
1535
1536
1537
1538

1539
1540
1541
1542
1543
1544
1545
1546
1547

1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558

1559
1560
1561
1562
1563
1564
1565
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







-
+








-
+










-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr = NULL;
    int result;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key key ...?");
	return TCL_ERROR;
    }

    /*
     * Test for the special case of no keys, which returns a *list* of all
     * key,value pairs. We produce a copy here because that makes subsequent
     * list handling more efficient.
     */

    if (objc == 2) {
	Tcl_Obj *keyPtr = NULL, *listPtr;
	Tcl_Obj *keyPtr, *listPtr;
	Tcl_DictSearch search;
	int done;

	result = Tcl_DictObjFirst(interp, objv[1], &search,
		&keyPtr, &valuePtr, &done);
	if (result != TCL_OK) {
	    return result;
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
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
1668
1669
1670
1671

1672
1673
1674
1675
1676
1677
1678
1679
1555
1556
1557
1558
1559
1560
1561

1562


1563








1564































1565
1566




























1567

1568
1569
1570
1571
1572
1573
1574







-
+
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-







	return TCL_ERROR;
    }
    result = Tcl_DictObjGet(interp, dictPtr, objv[objc-1], &valuePtr);
    if (result != TCL_OK) {
	return result;
    }
    if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_ResetResult(interp);
		"key \"%s\" not known in dictionary",
		TclGetString(objv[objc-1])));
	Tcl_AppendResult(interp, "key \"", TclGetString(objv[objc-1]),
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "DICT",
		TclGetString(objv[objc-1]), NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, valuePtr);
    return TCL_OK;
}

		"\" not known in dictionary", NULL);
/*
 *----------------------------------------------------------------------
 *
 * DictGetDefCmd --
 *
 *	This function implements the "dict getdef" and "dict getwithdefault"
 *	Tcl commands. See the user documentation for details on what it does,
 *	and TIP#342 for the formal specification.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictGetDefCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *keyPtr, *valuePtr, *defaultPtr;
    Tcl_Obj *const *keyPath;
    int numKeys;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...? key default");
	return TCL_ERROR;
    }

    /*
     * Give the bits of arguments names for clarity.
     */

    dictPtr = objv[1];
    keyPath = &objv[2];
    numKeys = objc - 4;		/* Number of keys in keyPath; there's always
				 * one extra key afterwards too. */
    keyPtr = objv[objc - 2];
    defaultPtr = objv[objc - 1];

    /*
     * Implement the getting-with-default operation.
     */

    dictPtr = TclTraceDictPath(interp, dictPtr, numKeys, keyPath,
	    DICT_PATH_EXISTS);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    } else if (dictPtr == DICT_PATH_NON_EXISTENT) {
	Tcl_SetObjResult(interp, defaultPtr);
    } else if (Tcl_DictObjGet(interp, dictPtr, keyPtr, &valuePtr) != TCL_OK) {
	return TCL_ERROR;
    } else if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, defaultPtr);
    } else {
	Tcl_SetObjResult(interp, valuePtr);
    Tcl_SetObjResult(interp, valuePtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictReplaceCmd --
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
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







-
+





-
+
+







-
-
-


+

-

-
+
+
+
+
+
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictReplaceCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    int i;
    int i, result;
    int allocatedDict = 0;

    if ((objc < 2) || (objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key value ...?");
	return TCL_ERROR;
    }

    dictPtr = objv[1];
    if (GetDictFromObj(interp, dictPtr) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_IsShared(dictPtr)) {
	dictPtr = Tcl_DuplicateObj(dictPtr);
	allocatedDict = 1;
    }
    TclInvalidateStringRep(dictPtr);
    for (i=2 ; i<objc ; i+=2) {
	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
	result = Tcl_DictObjPut(interp, dictPtr, objv[i], objv[i+1]);
	if (result != TCL_OK) {
	    if (allocatedDict) {
		TclDecrRefCount(dictPtr);
	    }
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, dictPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
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
1668
1669
1670
1671
1672
1673
1674
1675
1676







-
+





-
+
+







-
-
-


+

-

-
+
+
+
+
+
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictRemoveCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    int i;
    int i, result;
    int allocatedDict = 0;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = objv[1];
    if (GetDictFromObj(interp, dictPtr) == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_IsShared(dictPtr)) {
	dictPtr = Tcl_DuplicateObj(dictPtr);
	allocatedDict = 1;
    }
    TclInvalidateStringRep(dictPtr);
    for (i=2 ; i<objc ; i++) {
	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
	result = Tcl_DictObjRemove(interp, dictPtr, objv[i]);
	if (result != TCL_OK) {
	    if (allocatedDict) {
		TclDecrRefCount(dictPtr);
	    }
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, dictPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
1820
1821
1822
1823
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







-
+




-
+

















+
-
-
+
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictMergeCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *targetObj, *keyObj = NULL, *valueObj = NULL;
    Tcl_Obj *targetObj, *keyObj, *valueObj;
    int allocatedDict = 0;
    int i, done;
    Tcl_DictSearch search;

    if (objc == 1) {
	/*
	 * No dictionary arguments; return default (empty value).
	 */

	return TCL_OK;
    }

    /*
     * Make sure first argument is a dictionary.
     */

    targetObj = objv[1];
    if (targetObj->typePtr != &tclDictType) {
    if (GetDictFromObj(interp, targetObj) == NULL) {
	return TCL_ERROR;
	if (SetDictFromAny(interp, targetObj) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    if (objc == 2) {
	/*
	 * Single argument, return it.
	 */

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
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
1820
1821
1822
1823


1824
1825
1826
1827
1828
1829
1830
1831
1832







-
+





-
+












+
-
-
+
+
+
+
+















-
-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictKeysCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *listPtr;
    const char *pattern = NULL;
    char *pattern = NULL;

    if (objc!=2 && objc!=3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
	return TCL_ERROR;
    }

    /*
     * A direct check that we have a dictionary. We don't start the iteration
     * yet because that might allocate memory or set locks that we do not
     * need. [Bug 1705778, leak K04]
     */

    if (objv[1]->typePtr != &tclDictType) {
    if (GetDictFromObj(interp, objv[1]) == NULL) {
	return TCL_ERROR;
	int result = SetDictFromAny(interp, objv[1]);

	if (result != TCL_OK) {
	    return result;
	}
    }

    if (objc == 3) {
	pattern = TclGetString(objv[2]);
    }
    listPtr = Tcl_NewListObj(0, NULL);
    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	Tcl_Obj *valuePtr = NULL;

	Tcl_DictObjGet(interp, objv[1], objv[2], &valuePtr);
	if (valuePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, listPtr, objv[2]);
	}
    } else {
	Tcl_DictSearch search;
	Tcl_Obj *keyPtr = NULL;
	int done = 0;
	Tcl_Obj *keyPtr;
	int done;

	/*
	 * At this point, we know we have a dictionary (or at least something
	 * that can be represented; it could theoretically have shimmered away
	 * when the pattern was fetched, but that shouldn't be damaging) so we
	 * can start the iteration process without checking for failures.
	 */
1951
1952
1953
1954
1955
1956
1957
1958

1959
1960
1961
1962
1963

1964
1965
1966

1967
1968
1969
1970
1971
1972
1973
1860
1861
1862
1863
1864
1865
1866

1867
1868
1869
1870
1871

1872
1873
1874

1875
1876
1877
1878
1879
1880
1881
1882







-
+




-
+


-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictValuesCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *valuePtr = NULL, *listPtr;
    Tcl_Obj *valuePtr, *listPtr;
    Tcl_DictSearch search;
    int done;
    const char *pattern;
    char *pattern;

    if (objc!=2 && objc!=3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary ?pattern?");
	return TCL_ERROR;
    }

    if (Tcl_DictObjFirst(interp, objv[1], &search, NULL, &valuePtr,
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
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







-
+












-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictSizeCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int result, size;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }
    result = Tcl_DictObjSize(interp, objv[1], &size);
    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(size));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+











-
-
-
+
+
+
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictExistsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary key ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = TclTraceDictPath(NULL, objv[1], objc-3, objv+2,DICT_PATH_EXISTS);
    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT ||
	    Tcl_DictObjGet(NULL, dictPtr, objv[objc-1], &valuePtr) != TCL_OK) {
    dictPtr = TclTraceDictPath(interp, objv[1], objc-3, objv+2,
	    DICT_PATH_EXISTS);
    if (dictPtr == NULL || dictPtr == DICT_PATH_NON_EXISTENT
	    || Tcl_DictObjGet(interp, dictPtr, objv[objc-1],
		    &valuePtr) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
    } else {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(valuePtr != NULL));
    }
    return TCL_OK;
}

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
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







-
+




+

-






-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictInfoCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr;
    Dict *dict;
    char *statsStr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary");
	return TCL_ERROR;
    }

    dict = GetDictFromObj(interp, objv[1]);
    if (dict == NULL) {
	return TCL_ERROR;
    }

    statsStr = Tcl_HashStats(&dict->table);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
    Tcl_Free(statsStr);
    dictPtr = objv[1];
    if (dictPtr->typePtr != &tclDictType) {
	int result = SetDictFromAny(interp, dictPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }
    dict = dictPtr->internalRep.twoPtrValue.ptr1;

    /*
     * This next cast is actually OK.
     */

    Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictIncrCmd --
2135
2136
2137
2138
2139
2140
2141
2142

2143
2144
2145
2146
2147
2148
2149
2150
2151

2152
2153
2154
2155
2156
2157
2158
2052
2053
2054
2055
2056
2057
2058

2059
2060
2061
2062
2063
2064
2065
2066
2067

2068
2069
2070
2071
2072
2073
2074
2075







-
+








-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictIncrCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int code = TCL_OK;
    Tcl_Obj *dictPtr, *valuePtr = NULL;

    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?increment?");
	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?increment?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
    if (dictPtr == NULL) {
	/*
	 * Variable didn't yet exist. Create new dictionary value.
2168
2169
2170
2171
2172
2173
2174

2175
2176
2177
2178
2179



2180
2181
2182
2183
2184
2185
2186
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094



2095
2096
2097
2098
2099
2100
2101
2102
2103
2104







+


-
-
-
+
+
+







    }
    if (Tcl_IsShared(dictPtr)) {
	/*
	 * A little internals surgery to avoid copying a string rep that will
	 * soon be no good.
	 */

	char *saved = dictPtr->bytes;
	Tcl_Obj *oldPtr = dictPtr;

	TclNewObj(dictPtr);
	TclInvalidateStringRep(dictPtr);
	DupDictInternalRep(oldPtr, dictPtr);
	dictPtr->bytes = NULL;
	dictPtr = Tcl_DuplicateObj(dictPtr);
	oldPtr->bytes = saved;
    }
    if (valuePtr == NULL) {
	/*
	 * Key not in dictionary. Create new key with increment as value.
	 */

	if (objc == 4) {
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
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







-
+


-
+








-
+




-
+

-


-
+












-
+







	    } else {
		/*
		 * Remember to dispose with the bignum as we're not actually
		 * using it directly. [Bug 2874678]
		 */

		mp_clear(&increment);
		Tcl_DictObjPut(NULL, dictPtr, objv[2], objv[3]);
		Tcl_DictObjPut(interp, dictPtr, objv[2], objv[3]);
	    }
	} else {
	    Tcl_DictObjPut(NULL, dictPtr, objv[2], Tcl_NewWideIntObj(1));
	    Tcl_DictObjPut(interp, dictPtr, objv[2], Tcl_NewIntObj(1));
	}
    } else {
	/*
	 * Key in dictionary. Increment its value with minimum dup.
	 */

	if (Tcl_IsShared(valuePtr)) {
	    valuePtr = Tcl_DuplicateObj(valuePtr);
	    Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
	    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
	}
	if (objc == 4) {
	    code = TclIncrObj(interp, valuePtr, objv[3]);
	} else {
	    Tcl_Obj *incrPtr;
	    Tcl_Obj *incrPtr = Tcl_NewIntObj(1);

	    TclNewIntObj(incrPtr, 1);
	    Tcl_IncrRefCount(incrPtr);
	    code = TclIncrObj(interp, valuePtr, incrPtr);
	    TclDecrRefCount(incrPtr);
	    Tcl_DecrRefCount(incrPtr);
	}
    }
    if (code == TCL_OK) {
	TclInvalidateStringRep(dictPtr);
	valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
		dictPtr, TCL_LEAVE_ERR_MSG);
	if (valuePtr == NULL) {
	    code = TCL_ERROR;
	} else {
	    Tcl_SetObjResult(interp, valuePtr);
	}
    } else if (dictPtr->refCount == 0) {
	TclDecrRefCount(dictPtr);
	Tcl_DecrRefCount(dictPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
2256
2257
2258
2259
2260
2261
2262
2263

2264
2265
2266
2267
2268
2269
2270
2271
2272

2273
2274
2275
2276
2277
2278
2279
2173
2174
2175
2176
2177
2178
2179

2180
2181
2182
2183
2184
2185
2186
2187
2188

2189
2190
2191
2192
2193
2194
2195
2196







-
+








-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictLappendCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int i, allocatedDict = 0, allocatedValue = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
    if (dictPtr == NULL) {
	allocatedDict = 1;
	dictPtr = Tcl_NewDictObj();
2309
2310
2311
2312
2313
2314
2315
2316
2317


2318
2319
2320
2321
2322
2323
2324
2226
2227
2228
2229
2230
2231
2232


2233
2234
2235
2236
2237
2238
2239
2240
2241







-
-
+
+







		}
		return TCL_ERROR;
	    }
	}
    }

    if (allocatedValue) {
	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
    } else {
	Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
    } else if (dictPtr->bytes != NULL) {
	TclInvalidateStringRep(dictPtr);
    }

    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    if (resultPtr == NULL) {
	return TCL_ERROR;
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
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
2658
2659
2660

2661
2662

2663
2664
2665
2666

2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717




2718
2719
2720
2721


2722
2723
2724


2725
2726
2727

2728
2729
2730

2731
2732
2733
2734
2735
2736
2737

2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748


2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767




2768
2769
2770
2771
2772
2773
2774








2775
2776
2777
2778
2779
2780
2781
2782

2783
2784
2785
2786
2787
2788
2789
2790
2791

2792
2793
2794
2795
2796
2797
2798

2799
2800
2801
2802
2803
2804
2805

2806
2807
2808
2809
2810
2811

2812
2813
2814
2815

2816
2817
2818
2819
2820

2821
2822
2823
2824

2825
2826
2827
2828


2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
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







-
+





-
+


-
+



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+

-
+
-
-
-
-
-
-













-
+

-
+













-
-
+
+







-
-
+
+



-
+



-
-
-
-




-
-
+
-
+


+
+
+
-
-
+
+

-


-
-
-
-
-
-
-
-











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
-
-
-
+
+
-

-
+
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-



-
+
-


-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
+

-
-
-
-
+
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictAppendCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
    int allocatedDict = 0;
    int i, allocatedDict = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?value ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
    if (dictPtr == NULL) {
	allocatedDict = 1;
	dictPtr = Tcl_NewDictObj();
    } else if (Tcl_IsShared(dictPtr)) {
	allocatedDict = 1;
	dictPtr = Tcl_DuplicateObj(dictPtr);
    }

    if (Tcl_DictObjGet(interp, dictPtr, objv[2], &valuePtr) != TCL_OK) {
	if (allocatedDict) {
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }

    if ((objc > 3) || (valuePtr == NULL)) {
	/* Only go through append activites when something will change. */
	Tcl_Obj *appendObjPtr = NULL;

	if (objc > 3) {
	    /* Something to append */

	    if (objc == 4) {
		appendObjPtr = objv[3];
	    } else {
		appendObjPtr = TclStringCat(interp, objc-3, objv+3,
			TCL_STRING_IN_PLACE);
		if (appendObjPtr == NULL) {
		    return TCL_ERROR;
		}
	    }
	}

	if (appendObjPtr == NULL) {
	    /* => (objc == 3) => (valuePtr == NULL) */
	    TclNewObj(valuePtr);
	} else if (valuePtr == NULL) {
    if (valuePtr == NULL) {
	TclNewObj(valuePtr);
    } else {
	    valuePtr = appendObjPtr;
	    appendObjPtr = NULL;
	}

	if (appendObjPtr) {
	    if (Tcl_IsShared(valuePtr)) {
		valuePtr = Tcl_DuplicateObj(valuePtr);
	    }

	    Tcl_IncrRefCount(appendObjPtr);
	    Tcl_AppendObjToObj(valuePtr, appendObjPtr);
	if (Tcl_IsShared(valuePtr)) {
	    valuePtr = Tcl_DuplicateObj(valuePtr);
	}
    }

    for (i=3 ; i<objc ; i++) {
	Tcl_AppendObjToObj(valuePtr, objv[i]);
	    Tcl_DecrRefCount(appendObjPtr);
	}
    }

	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
    Tcl_DictObjPut(interp, dictPtr, objv[2], valuePtr);
    }

    /*
     * Even if nothing changed, we still overwrite so that variable
     * trace expectations are met.
     */

    resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG);
    if (resultPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * DictForNRCmd --
 * DictForCmd --
 *
 *	These functions implement the "dict for" Tcl command.  See the user
 *	This function implements the "dict for" Tcl command. See the user
 *	documentation for details on what it does, and TIP#111 for the formal
 *	specification.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictForNRCmd(
    TCL_UNUSED(ClientData),
DictForCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj, *valueObj;
    Tcl_DictSearch *searchPtr;
    int varc, done;
    Tcl_DictSearch search;
    int varc, done, result;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
		"{keyVar valueVar} dictionary script");
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */

    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have exactly two variable names", -1));
	Tcl_SetResult(interp, "must have exactly two variable names",
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "for", NULL);
		TCL_STATIC);
	return TCL_ERROR;
    }
    keyVarObj = varv[0];
    valueVarObj = varv[1];
    scriptObj = objv[3];
    searchPtr = (Tcl_DictSearch *)TclStackAlloc(interp, sizeof(Tcl_DictSearch));
    if (Tcl_DictObjFirst(interp, objv[2], searchPtr, &keyObj, &valueObj,

    if (Tcl_DictObjFirst(interp, objv[2], &search, &keyObj, &valueObj,
	    &done) != TCL_OK) {
	TclStackFree(interp, searchPtr);
	return TCL_ERROR;
    }
    if (done) {
	TclStackFree(interp, searchPtr);
	return TCL_OK;
    }
    TclListObjGetElements(NULL, objv[1], &varc, &varv);
    keyVarObj = varv[0];
    valueVarObj = varv[1];
    scriptObj = objv[3];

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish. Note that the dictionary internal rep is locked
     * internally so that updates, shimmering, etc are not a problem.
     */

    Tcl_IncrRefCount(keyVarObj);
    Tcl_IncrRefCount(valueVarObj);
    Tcl_IncrRefCount(scriptObj);

    /*
     * Stop the value from getting hit in any way by any traces on the key
     * variable.
     */

    Tcl_IncrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	TclDecrRefCount(valueObj);
	goto error;
    }
    TclDecrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	goto error;
    }

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
	    valueVarObj, scriptObj);
    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything on error.
     */

  error:
    TclDecrRefCount(keyVarObj);
    TclDecrRefCount(valueVarObj);
    TclDecrRefCount(scriptObj);
    Tcl_DictObjDone(searchPtr);
    TclStackFree(interp, searchPtr);
    return TCL_ERROR;
}

static int
DictForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_DictSearch *searchPtr = (Tcl_DictSearch *)data[0];
    Tcl_Obj *keyVarObj = (Tcl_Obj *)data[1];
    Tcl_Obj *valueVarObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    Tcl_Obj *keyObj, *valueObj;
    int done;

    /*
     * Process the result from the previous execution of the script body.
     */

    if (result == TCL_CONTINUE) {
	result = TCL_OK;
    result = TCL_OK;
    } else if (result != TCL_OK) {
	if (result == TCL_BREAK) {
	    Tcl_ResetResult(interp);
	    result = TCL_OK;
	} else if (result == TCL_ERROR) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (\"dict for\" body line %d)",
		    Tcl_GetErrorLine(interp)));
	}
	goto done;
    }

    /*
     * Get the next mapping from the dictionary.
     */

    Tcl_DictObjNext(searchPtr, &keyObj, &valueObj, &done);
    if (done) {
    while (!done) {
	Tcl_ResetResult(interp);
	goto done;
    }

    /*
     * Stop the value from getting hit in any way by any traces on the key
     * variable.
     */
	/*
	 * Stop the value from getting hit in any way by any traces on the key
	 * variable.
	 */

    Tcl_IncrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
	Tcl_IncrRefCount(valueObj);
	if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj, 0) == NULL) {
	    TCL_LEAVE_ERR_MSG) == NULL) {
	TclDecrRefCount(valueObj);
	result = TCL_ERROR;
	goto done;
    }
    TclDecrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	result = TCL_ERROR;
	goto done;
    }

	    Tcl_ResetResult(interp);
    /*
     * Run the script.
     */

	    Tcl_AppendResult(interp, "couldn't set key variable: \"",
    TclNRAddCallback(interp, DictForLoopCallback, searchPtr, keyVarObj,
	    valueVarObj, scriptObj);
    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything once the iterating is done.
     */

  done:
    TclDecrRefCount(keyVarObj);
    TclDecrRefCount(valueVarObj);
		    TclGetString(keyVarObj), "\"", NULL);
	    TclDecrRefCount(valueObj);
    TclDecrRefCount(scriptObj);
    Tcl_DictObjDone(searchPtr);
    TclStackFree(interp, searchPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DictMapNRCmd --
 *
 *	These functions implement the "dict map" Tcl command.  See the user
 *	documentation for details on what it does, and TIP#405 for the formal
 *	specification.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictMapNRCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj **varv, *keyObj, *valueObj;
    DictMapStorage *storagePtr;
    int varc, done;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"{keyVarName valueVarName} dictionary script");
	return TCL_ERROR;
	    result = TCL_ERROR;
    }

	    break;
    /*
     * Parse arguments.
     */

	}
    if (TclListObjGetElements(interp, objv[1], &varc, &varv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (varc != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have exactly two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "map", NULL);
	return TCL_ERROR;
    }
    storagePtr = (DictMapStorage *)TclStackAlloc(interp, sizeof(DictMapStorage));
    if (Tcl_DictObjFirst(interp, objv[2], &storagePtr->search, &keyObj,
	    &valueObj, &done) != TCL_OK) {
	TclStackFree(interp, storagePtr);
	return TCL_ERROR;
    }
    if (done) {
	/*
	 * Note that this exit leaves an empty value in the result (due to
	 * command calling conventions) but that is OK since an empty value is
	 * an empty dictionary.
	 */

	TclStackFree(interp, storagePtr);
	return TCL_OK;
    }
    TclNewObj(storagePtr->accumulatorObj);
    TclListObjGetElements(NULL, objv[1], &varc, &varv);
    storagePtr->keyVarObj = varv[0];
    storagePtr->valueVarObj = varv[1];
    storagePtr->scriptObj = objv[3];

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish. Note that the dictionary internal rep is locked
     * internally so that updates, shimmering, etc are not a problem.
     */

    Tcl_IncrRefCount(storagePtr->accumulatorObj);
    Tcl_IncrRefCount(storagePtr->keyVarObj);
    Tcl_IncrRefCount(storagePtr->valueVarObj);
    Tcl_IncrRefCount(storagePtr->scriptObj);

    /*
     * Stop the value from getting hit in any way by any traces on the key
     * variable.
     */

    Tcl_IncrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	TclDecrRefCount(valueObj);
	TclDecrRefCount(valueObj);
	if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj, 0) == NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "couldn't set value variable: \"",
	goto error;
    }
    if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
		    TclGetString(valueVarObj), "\"", NULL);
	    result = TCL_ERROR;
	TclDecrRefCount(valueObj);
	goto error;
    }
	    break;
	}
    TclDecrRefCount(valueObj);

    /*
	/*
     * Run the script.
     */

	 * TIP #280. Make invoking context available to loop body.
    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
	    iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything on error.
     */
	 */

  error:
    TclDecrRefCount(storagePtr->keyVarObj);
    TclDecrRefCount(storagePtr->valueVarObj);
    TclDecrRefCount(storagePtr->scriptObj);
    TclDecrRefCount(storagePtr->accumulatorObj);
    Tcl_DictObjDone(&storagePtr->search);
    TclStackFree(interp, storagePtr);
    return TCL_ERROR;
}


	result = TclEvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
static int
DictMapLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    DictMapStorage *storagePtr = (DictMapStorage *)data[0];
    Tcl_Obj *keyObj, *valueObj;
    int done;

    /*
     * Process the result from the previous execution of the script body.
     */

    if (result == TCL_CONTINUE) {
	result = TCL_OK;
    } else if (result != TCL_OK) {
	if (result == TCL_BREAK) {
	if (result == TCL_CONTINUE) {
	    result = TCL_OK;
	} else if (result != TCL_OK) {
	    if (result == TCL_BREAK) {
	    Tcl_ResetResult(interp);
	    result = TCL_OK;
	} else if (result == TCL_ERROR) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (\"dict map\" body line %d)",
		    Tcl_GetErrorLine(interp)));
	}
		result = TCL_OK;
	    } else if (result == TCL_ERROR) {
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (\"dict for\" body line %d)",
			interp->errorLine));
	    }
	    break;
	}
	goto done;
    } else {
	keyObj = Tcl_ObjGetVar2(interp, storagePtr->keyVarObj, NULL,
		TCL_LEAVE_ERR_MSG);
	if (keyObj == NULL) {
	    result = TCL_ERROR;
	    goto done;
	}

	Tcl_DictObjPut(NULL, storagePtr->accumulatorObj, keyObj,
		Tcl_GetObjResult(interp));
    }

    /*
     * Get the next mapping from the dictionary.
     */

    Tcl_DictObjNext(&storagePtr->search, &keyObj, &valueObj, &done);
	Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
    if (done) {
	Tcl_SetObjResult(interp, storagePtr->accumulatorObj);
	goto done;
    }

    /*
     * Stop the value from getting hit in any way by any traces on the key
     * Stop holding a reference to these objects.
     * variable.
     */

    Tcl_IncrRefCount(valueObj);
    if (Tcl_ObjSetVar2(interp, storagePtr->keyVarObj, NULL, keyObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	TclDecrRefCount(valueObj);
    TclDecrRefCount(keyVarObj);
	result = TCL_ERROR;
	goto done;
    }
    if (Tcl_ObjSetVar2(interp, storagePtr->valueVarObj, NULL, valueObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	TclDecrRefCount(valueObj);
    TclDecrRefCount(valueVarObj);
	result = TCL_ERROR;
	goto done;
    }
    TclDecrRefCount(valueObj);
    TclDecrRefCount(scriptObj);

    /*
     * Run the script.
     */

    Tcl_DictObjDone(&search);
    TclNRAddCallback(interp, DictMapLoopCallback, storagePtr, NULL,NULL,NULL);
    return TclNREvalObjEx(interp, storagePtr->scriptObj, 0,
	    iPtr->cmdFramePtr, 3);

    if (result == TCL_OK) {
    /*
     * For unwinding everything once the iterating is done.
     */

	Tcl_ResetResult(interp);
    }
  done:
    TclDecrRefCount(storagePtr->keyVarObj);
    TclDecrRefCount(storagePtr->valueVarObj);
    TclDecrRefCount(storagePtr->scriptObj);
    TclDecrRefCount(storagePtr->accumulatorObj);
    Tcl_DictObjDone(&storagePtr->search);
    TclStackFree(interp, storagePtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DictSetCmd --
2852
2853
2854
2855
2856
2857
2858
2859

2860
2861
2862
2863
2864
2865
2866
2867
2868

2869
2870
2871
2872
2873
2874
2875
2457
2458
2459
2460
2461
2462
2463

2464
2465
2466
2467
2468
2469
2470
2471
2472

2473
2474
2475
2476
2477
2478
2479
2480







-
+








-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictSetCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *resultPtr;
    int result, allocatedDict = 0;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...? value");
	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...? value");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
    if (dictPtr == NULL) {
	allocatedDict = 1;
	dictPtr = Tcl_NewDictObj();
2912
2913
2914
2915
2916
2917
2918
2919

2920
2921
2922
2923
2924
2925
2926
2927
2928

2929
2930
2931
2932
2933
2934
2935
2517
2518
2519
2520
2521
2522
2523

2524
2525
2526
2527
2528
2529
2530
2531
2532

2533
2534
2535
2536
2537
2538
2539
2540







-
+








-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictUnsetCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *dictPtr, *resultPtr;
    int result, allocatedDict = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?key ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "varName key ?key ...?");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
    if (dictPtr == NULL) {
	allocatedDict = 1;
	dictPtr = Tcl_NewDictObj();
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
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
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


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
2658
2659
2660
2661
2662
2663
2664
2665






2666
2667


2668
2669
2670
2671
2672
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







-
+





-
+






-
+


-
+


-
+









+
+
+
+
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








+
+
+
+
+








+


-
-
-
-
-
-
+
+
-
-









-
+













-
-
+
-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictFilterCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    static const char *const filters[] = {
    static const char *filters[] = {
	"key", "script", "value", NULL
    };
    enum FilterTypes {
	FILTER_KEYS, FILTER_SCRIPT, FILTER_VALUES
    };
    Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
    Tcl_Obj **varv, *keyObj = NULL, *valueObj = NULL, *resultObj, *boolObj;
    Tcl_Obj **varv, *keyObj, *valueObj, *resultObj, *boolObj;
    Tcl_DictSearch search;
    int index, varc, done, result, satisfied;
    const char *pattern;
    char *pattern;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "dictionary filterType ...");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], filters, "filterType",
	     0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum FilterTypes) index) {
    case FILTER_KEYS:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 1, objv, "dictionary key globPattern");
	    return TCL_ERROR;
	}

	/*
	 * Create a dictionary whose keys all match a certain pattern.
	 */

	if (Tcl_DictObjFirst(interp, objv[1], &search,
		&keyObj, &valueObj, &done) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    /*
	     * Nothing to match, so return nothing (== empty dictionary).
	     */

	    Tcl_DictObjDone(&search);
	    return TCL_OK;
	} else if (objc == 4) {
	    pattern = TclGetString(objv[3]);
	    resultObj = Tcl_NewDictObj();
	    if (TclMatchIsTrivial(pattern)) {
		/*
		 * Must release the search lock here to prevent a memory leak
		 * since we are not exhausing the search. [Bug 1705778, leak
	pattern = TclGetString(objv[3]);
	resultObj = Tcl_NewDictObj();
	if (TclMatchIsTrivial(pattern)) {
	    /*
	     * Must release the search lock here to prevent a memory leak
	     * since we are not exhausing the search. [Bug 1705778, leak K05]
		 * K05]
		 */
	     */

		Tcl_DictObjDone(&search);
		Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
		if (valueObj != NULL) {
		    Tcl_DictObjPut(NULL, resultObj, objv[3], valueObj);
		}
	    } else {
		while (!done) {
		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
			Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
	    Tcl_DictObjDone(&search);
	    Tcl_DictObjGet(interp, objv[1], objv[3], &valueObj);
	    if (valueObj != NULL) {
		Tcl_DictObjPut(interp, resultObj, objv[3], valueObj);
	    }
	} else {
	    while (!done) {
		if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
		    }
		    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
		}
	    }
	} else {
	    /*
	     * Can't optimize this match for trivial globbing: would disturb
	     * order.
	     */

	    resultObj = Tcl_NewDictObj();
	    while (!done) {
		int i;

		for (i=3 ; i<objc ; i++) {
		    pattern = TclGetString(objv[i]);
		    if (Tcl_StringMatch(TclGetString(keyObj), pattern)) {
			Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
			break;		/* stop inner loop */
		    }
		}
		Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
	    }
	}
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;

    case FILTER_VALUES:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 1, objv, "dictionary value globPattern");
	    return TCL_ERROR;
	}

	/*
	 * Create a dictionary whose values all match a certain pattern.
	 */

	if (Tcl_DictObjFirst(interp, objv[1], &search,
		&keyObj, &valueObj, &done) != TCL_OK) {
	    return TCL_ERROR;
	}
	pattern = TclGetString(objv[3]);
	resultObj = Tcl_NewDictObj();
	while (!done) {
	    int i;

	    for (i=3 ; i<objc ; i++) {
		pattern = TclGetString(objv[i]);
		if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
	    if (Tcl_StringMatch(TclGetString(valueObj), pattern)) {
		Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
		    break;		/* stop inner loop */
		}
	    }
	    Tcl_DictObjNext(&search, &keyObj, &valueObj, &done);
	}
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;

    case FILTER_SCRIPT:
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 1, objv,
		    "dictionary script {keyVarName valueVarName} filterScript");
		    "dictionary script {keyVar valueVar} filterScript");
	    return TCL_ERROR;
	}

	/*
	 * Create a dictionary whose key,value pairs all satisfy a script
	 * (i.e. get a true boolean result from its evaluation). Massive
	 * copying from the "dict for" implementation has occurred!
	 */

	if (TclListObjGetElements(interp, objv[3], &varc, &varv) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (varc != 2) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "must have exactly two variable names", -1));
	    Tcl_SetResult(interp, "must have exactly two variable names",
	    Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "dict", "filter", NULL);
		    TCL_STATIC);
	    return TCL_ERROR;
	}
	keyVarObj = varv[0];
	valueVarObj = varv[1];
	scriptObj = objv[4];

	/*
3144
3145
3146
3147
3148
3149
3150
3151
3152



3153
3154
3155
3156
3157
3158
3159
3160



3161
3162
3163
3164
3165
3166
3167
2724
2725
2726
2727
2728
2729
2730


2731
2732
2733
2734
2735
2736
2737
2738



2739
2740
2741
2742
2743
2744
2745
2746
2747
2748







-
-
+
+
+





-
-
-
+
+
+







	     * key variable.
	     */

	    Tcl_IncrRefCount(keyObj);
	    Tcl_IncrRefCount(valueObj);
	    if (Tcl_ObjSetVar2(interp, keyVarObj, NULL, keyObj,
		    TCL_LEAVE_ERR_MSG) == NULL) {
		Tcl_AddErrorInfo(interp,
			"\n    (\"dict filter\" filter script key variable)");
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't set key variable: \"",
			TclGetString(keyVarObj), "\"", NULL);
		result = TCL_ERROR;
		goto abnormalResult;
	    }
	    if (Tcl_ObjSetVar2(interp, valueVarObj, NULL, valueObj,
		    TCL_LEAVE_ERR_MSG) == NULL) {
		Tcl_AddErrorInfo(interp,
			"\n    (\"dict filter\" filter script value variable)");
		result = TCL_ERROR;
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't set value variable: \"",
			TclGetString(valueVarObj), "\"", NULL);
		goto abnormalResult;
	    }

	    /*
	     * TIP #280. Make invoking context available to loop body.
	     */

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
2756
2757
2758
2759
2760
2761
2762

2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781

2782
2783
2784
2785
2786
2787
2788
2789







-
+


















-
+







			&satisfied) != TCL_OK) {
		    TclDecrRefCount(boolObj);
		    result = TCL_ERROR;
		    goto abnormalResult;
		}
		TclDecrRefCount(boolObj);
		if (satisfied) {
		    Tcl_DictObjPut(NULL, resultObj, keyObj, valueObj);
		    Tcl_DictObjPut(interp, resultObj, keyObj, valueObj);
		}
		break;
	    case TCL_BREAK:
		/*
		 * Force loop termination by calling Tcl_DictObjDone; this
		 * makes the next Tcl_DictObjNext say there is nothing more to
		 * do.
		 */

		Tcl_ResetResult(interp);
		Tcl_DictObjDone(&search);
	    /* FALLTHRU */
	    case TCL_CONTINUE:
		result = TCL_OK;
		break;
	    case TCL_ERROR:
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			"\n    (\"dict filter\" script line %d)",
			Tcl_GetErrorLine(interp)));
			interp->errorLine));
	    default:
		goto abnormalResult;
	    }

	    TclDecrRefCount(keyObj);
	    TclDecrRefCount(valueObj);

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
2837
2838
2839
2840
2841
2842
2843

2844
2845
2846
2847
2848
2849
2850

2851
2852
2853
2854
2855

2856
2857
2858
2859
2860
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







-
+






-
+
+



-
+


















-
+









-
+
-


-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+

-
-








-
+

-
-












-
-
+


-
+






+
-
+


-
+


-





-
+


-



-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictUpdateCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *objPtr;
    int i, dummy;
    int i, result, dummy;
    Tcl_InterpState state;

    if (objc < 5 || !(objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"dictVarName key varName ?key varName ...? script");
		"varName key varName ?key varName ...? script");
	return TCL_ERROR;
    }

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }
    if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(dictPtr);
    for (i=2 ; i+2<objc ; i+=2) {
	if (Tcl_DictObjGet(interp, dictPtr, objv[i], &objPtr) != TCL_OK) {
	    TclDecrRefCount(dictPtr);
	    return TCL_ERROR;
	}
	if (objPtr == NULL) {
	    /* ??? */
	    Tcl_UnsetVar2(interp, TclGetString(objv[i+1]), NULL, 0);
	    Tcl_UnsetVar(interp, Tcl_GetString(objv[i+1]), 0);
	} else if (Tcl_ObjSetVar2(interp, objv[i+1], NULL, objPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    TclDecrRefCount(dictPtr);
	    return TCL_ERROR;
	}
    }
    TclDecrRefCount(dictPtr);

    /*
     * Execute the body after setting up the NRE handler to process the
     * Execute the body.
     * results.
     */

    objPtr = Tcl_NewListObj(objc-3, objv+2);
    Tcl_IncrRefCount(objPtr);
    Tcl_IncrRefCount(objv[1]);
    TclNRAddCallback(interp, FinalizeDictUpdate, objv[1], objPtr, NULL,NULL);

    return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
    result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
}

static int
FinalizeDictUpdate(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj *dictPtr, *objPtr, **objv;
    Tcl_InterpState state;
    int i, objc;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *argsObj = (Tcl_Obj *)data[1];

    /*
     * ErrorInfo handling.
     */

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (body of \"dict update\")");
    }

    /*
     * If the dictionary variable doesn't exist, drop everything silently.
     */

    dictPtr = Tcl_ObjGetVar2(interp, varName, NULL, 0);
    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
    if (dictPtr == NULL) {
	TclDecrRefCount(varName);
	TclDecrRefCount(argsObj);
	return result;
    }

    /*
     * Double-check that it is still a dictionary.
     */

    state = Tcl_SaveInterpState(interp, result);
    if (Tcl_DictObjSize(interp, dictPtr, &objc) != TCL_OK) {
    if (Tcl_DictObjSize(interp, dictPtr, &dummy) != TCL_OK) {
	Tcl_DiscardInterpState(state);
	TclDecrRefCount(varName);
	TclDecrRefCount(argsObj);
	return TCL_ERROR;
    }

    if (Tcl_IsShared(dictPtr)) {
	dictPtr = Tcl_DuplicateObj(dictPtr);
    }

    /*
     * Write back the values from the variables, treating failure to read as
     * an instruction to remove the key.
     */

    Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv);
    for (i=0 ; i<objc ; i+=2) {
    for (i=2 ; i+2<objc ; i+=2) {
	objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0);
	if (objPtr == NULL) {
	    Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
	    Tcl_DictObjRemove(interp, dictPtr, objv[i]);
	} else if (objPtr == dictPtr) {
	    /*
	     * Someone is messing us around, trying to build a recursive
	     * structure. [Bug 1786481]
	     */

	    Tcl_DictObjPut(interp, dictPtr, objv[i],
	    Tcl_DictObjPut(NULL, dictPtr, objv[i], Tcl_DuplicateObj(objPtr));
		    Tcl_DuplicateObj(objPtr));
	} else {
	    /* Shouldn't fail */
	    Tcl_DictObjPut(NULL, dictPtr, objv[i], objPtr);
	    Tcl_DictObjPut(interp, dictPtr, objv[i], objPtr);
	}
    }
    TclDecrRefCount(argsObj);

    /*
     * Write the dictionary back to its variable.
     */

    if (Tcl_ObjSetVar2(interp, varName, NULL, dictPtr,
    if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DiscardInterpState(state);
	TclDecrRefCount(varName);
	return TCL_ERROR;
    }

    TclDecrRefCount(varName);
    return Tcl_RestoreInterpState(interp, state);
}

/*
 *----------------------------------------------------------------------
 *
 * DictWithCmd --
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
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
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







-
+





-
+
+
+
+


-
+











-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


-
+












-
+



+







-
+



-
-
-
-
+
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-




-
+
-

+
-
+






+

+
+






-
-


-
+









-
+


+



+



+



-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
DictWithCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *dictPtr, *keysPtr, *pathPtr;
    Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
    Tcl_DictSearch s;
    Tcl_InterpState state;
    int done, result, keyc, i, allocdict = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "dictVarName ?key ...? script");
	Tcl_WrongNumArgs(interp, 1, objv, "dictVar ?key ...? script");
	return TCL_ERROR;
    }

    /*
     * Get the dictionary to open out.
     */

    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
    if (dictPtr == NULL) {
	return TCL_ERROR;
    }

    keysPtr = TclDictWithInit(interp, dictPtr, objc-3, objv+2);
    if (keysPtr == NULL) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(keysPtr);

    /*
     * Execute the body, while making the invoking context available to the
     * loop body (TIP#280) and postponing the cleanup until later (NRE).
     */

    pathPtr = NULL;
    if (objc > 3) {
	pathPtr = Tcl_NewListObj(objc-3, objv+2);
	Tcl_IncrRefCount(pathPtr);
    }
    Tcl_IncrRefCount(objv[1]);
    TclNRAddCallback(interp, FinalizeDictWith, objv[1], keysPtr, pathPtr,
	    NULL);

    return TclNREvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
}

static int
FinalizeDictWith(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **pathv;
    int pathc;
    Tcl_InterpState state;
    Tcl_Obj *varName = (Tcl_Obj *)data[0];
    Tcl_Obj *keysPtr = (Tcl_Obj *)data[1];
    Tcl_Obj *pathPtr = (Tcl_Obj *)data[2];
    Var *varPtr, *arrayPtr;

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
    }

    /*
     * Save the result state; TDWF doesn't guarantee to not modify that on
     * TCL_OK result.
     */

    state = Tcl_SaveInterpState(interp, result);
    if (pathPtr != NULL) {
	Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv);
    } else {
	pathc = 0;
	pathv = NULL;
    }

    /*
     * Pack from local variables back into the dictionary.
     */

    varPtr = TclObjLookupVarEx(interp, varName, NULL, TCL_LEAVE_ERR_MSG, "set",
	    /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	result = TCL_ERROR;
    } else {
	result = TclDictWithFinish(interp, varPtr, arrayPtr, varName, NULL, -1,
		pathc, pathv, keysPtr);
    }

    /*
     * Tidy up and return the real result (unless we had an error).
     */

    TclDecrRefCount(varName);
    TclDecrRefCount(keysPtr);
    if (pathPtr != NULL) {
	TclDecrRefCount(pathPtr);
    }
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);
	return TCL_ERROR;
    }
    return Tcl_RestoreInterpState(interp, state);
}

/*
 *----------------------------------------------------------------------
 *
 * TclDictWithInit --
 *
 *	Part of the core of [dict with]. Pokes into a dictionary and converts
 *	the mappings there into assignments to (presumably) local variables.
 *	Returns a list of all the names that were mapped so that removal of
 *	either the variable or the dictionary entry won't surprise us when we
 *	come to stuffing everything back.
 *
 * Result:
 *	List of mapped names, or NULL if there was an error.
 *
 * Side effects:
 *	Assigns to variables, so potentially legion due to traces.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDictWithInit(
    Tcl_Interp *interp,
    Tcl_Obj *dictPtr,
    int pathc,
    Tcl_Obj *const pathv[])
{
    Tcl_DictSearch s;
    Tcl_Obj *keyPtr, *valPtr, *keysPtr;
    int done;

    if (pathc > 0) {
	dictPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
	dictPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
		DICT_PATH_READ);
	if (dictPtr == NULL) {
	    return NULL;
	    return TCL_ERROR;
	}
    }

    /*
     * Go over the list of keys and write each corresponding value to a
     * variable in the current context with the same name. Also keep a copy of
     * the keys so we can write back properly later on even if the dictionary
     * has been structurally modified.
     */

    if (Tcl_DictObjFirst(interp, dictPtr, &s, &keyPtr, &valPtr,
	    &done) != TCL_OK) {
	return NULL;
	return TCL_ERROR;
    }

    TclNewObj(keysPtr);
    Tcl_IncrRefCount(keysPtr);

    for (; !done ; Tcl_DictObjNext(&s, &keyPtr, &valPtr, &done)) {
	Tcl_ListObjAppendElement(NULL, keysPtr, keyPtr);
	if (Tcl_ObjSetVar2(interp, keyPtr, NULL, valPtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    TclDecrRefCount(keysPtr);
	    Tcl_DictObjDone(&s);
	    return NULL;
	    return TCL_ERROR;
	}
    }

    return keysPtr;
}

/*
    /*
 *----------------------------------------------------------------------
 *
     * Execute the body, while making the invoking context available to the
     * loop body (TIP#280).
     */
 * TclDictWithFinish --
 *

 *	Part of the core of [dict with]. Reassembles the piece of the dict (in
 *	varName, location given by pathc/pathv) from the variables named in
 *	the keysPtr argument. NB, does not try to preserve errors or manage
 *	argument lifetimes.
 *
 * Result:
 *	TCL_OK if we succeeded, or TCL_ERROR if we failed.
    result = TclEvalObjEx(interp, objv[objc-1], 0, iPtr->cmdFramePtr, objc-1);
    if (result == TCL_ERROR) {
 *
 * Side effects:
 *	Assigns to a variable, so potentially legion due to traces. Updates
 *	the dictionary in the named variable.
 *
 *----------------------------------------------------------------------
 */

	Tcl_AddErrorInfo(interp, "\n    (body of \"dict with\")");
    }
int
TclDictWithFinish(
    Tcl_Interp *interp,		/* Command interpreter in which variable
				 * exists. Used for state management, traces
				 * and error reporting. */
    Var *varPtr,		/* Reference to the variable holding the
				 * dictionary. */
    Var *arrayPtr,		/* Reference to the array containing the
				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. NULL if the 'index'
				 * parameter is >= 0 */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int index,			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
    int pathc,			/* The number of elements in the path into the
				 * dictionary. */
    Tcl_Obj *const pathv[],	/* The elements of the path to the subdict. */
    Tcl_Obj *keysPtr)		/* List of keys to be synchronized. This is
				 * the result value from TclDictWithInit. */
{

    Tcl_Obj *dictPtr, *leafPtr, *valPtr;
    int i, allocdict, keyc;
    Tcl_Obj **keyv;

    /*
     * If the dictionary variable doesn't exist, drop everything silently.
     */

    dictPtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
    dictPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
	    TCL_LEAVE_ERR_MSG, index);
    if (dictPtr == NULL) {
	TclDecrRefCount(keysPtr);
	return TCL_OK;
	return result;
    }

    /*
     * Double-check that it is still a dictionary.
     */

    state = Tcl_SaveInterpState(interp, result);
    if (Tcl_DictObjSize(interp, dictPtr, &i) != TCL_OK) {
	TclDecrRefCount(keysPtr);
	Tcl_DiscardInterpState(state);
	return TCL_ERROR;
    }

    if (Tcl_IsShared(dictPtr)) {
	dictPtr = Tcl_DuplicateObj(dictPtr);
	allocdict = 1;
    } else {
	allocdict = 0;
    }

    if (pathc > 0) {
    if (objc > 3) {
	/*
	 * Want to get to the dictionary which we will update; need to do
	 * prepare-for-update de-sharing along the path *but* avoid generating
	 * an error on a non-existant path (we'll treat that the same as a
	 * non-existant variable. Luckily, the de-sharing operation isn't
	 * deeply damaging if we don't go on to update; it's just less than
	 * perfectly efficient (but no memory should be leaked).
	 */

	leafPtr = TclTraceDictPath(interp, dictPtr, pathc, pathv,
	leafPtr = TclTraceDictPath(interp, dictPtr, objc-3, objv+2,
		DICT_PATH_EXISTS | DICT_PATH_UPDATE);
	if (leafPtr == NULL) {
	    TclDecrRefCount(keysPtr);
	    if (allocdict) {
		TclDecrRefCount(dictPtr);
	    }
	    Tcl_DiscardInterpState(state);
	    return TCL_ERROR;
	}
	if (leafPtr == DICT_PATH_NON_EXISTENT) {
	    TclDecrRefCount(keysPtr);
	    if (allocdict) {
		TclDecrRefCount(dictPtr);
	    }
	    return TCL_OK;
	    return Tcl_RestoreInterpState(interp, state);
	}
    } else {
	leafPtr = dictPtr;
    }

    /*
     * Now process our updates on the leaf dictionary.
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
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







+






-
+







-
-
+
+
-
-
+
-


-
+







	     */

	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], Tcl_DuplicateObj(valPtr));
	} else {
	    Tcl_DictObjPut(NULL, leafPtr, keyv[i], valPtr);
	}
    }
    TclDecrRefCount(keysPtr);

    /*
     * Ensure that none of the dictionaries in the chain still have a string
     * rep.
     */

    if (pathc > 0) {
    if (objc > 3) {
	InvalidateDictChain(leafPtr);
    }

    /*
     * Write back the outermost dictionary to the variable.
     */

    if (TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    dictPtr, TCL_LEAVE_ERR_MSG, index) == NULL) {
    if (Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	if (allocdict) {
	    TclDecrRefCount(dictPtr);
	Tcl_DiscardInterpState(state);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
    return Tcl_RestoreInterpState(interp, state);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitDictCmd --
 *

Deleted generic/tclDisassemble.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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

























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclDisassemble.c --
 *
 *	This file contains procedures that disassemble bytecode into either
 *	human-readable or Tcl-processable forms.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 * Copyright (c) 2013-2016 Donal K. Fellows.
 *
 * 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 "tclCompile.h"
#include "tclOOInt.h"
#include <assert.h>

/*
 * Prototypes for procedures defined later in this file:
 */

static Tcl_Obj *	DisassembleByteCodeAsDicts(Tcl_Obj *objPtr);
static Tcl_Obj *	DisassembleByteCodeObj(Tcl_Obj *objPtr);
static int		FormatInstruction(ByteCode *codePtr,
			    const unsigned char *pc, Tcl_Obj *bufferObj);
static void		GetLocationInformation(Proc *procPtr,
			    Tcl_Obj **fileObjPtr, int *linePtr);
static void		PrintSourceToObj(Tcl_Obj *appendObj,
			    const char *stringPtr, int maxChars);
static void		UpdateStringOfInstName(Tcl_Obj *objPtr);

/*
 * The structure below defines an instruction name Tcl object to allow
 * reporting of inner contexts in errorstack without string allocation.
 */

static const Tcl_ObjType instNameType = {
    "instname",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInstName,	/* updateStringProc */
    NULL,			/* setFromAnyProc */
};

#define InstNameSetIntRep(objPtr, inst)				\
    do {							\
	Tcl_ObjIntRep ir;					\
	ir.wideValue = (inst);					\
	Tcl_StoreIntRep((objPtr), &instNameType, &ir);		\
    } while (0)

#define InstNameGetIntRep(objPtr, inst)				\
    do {							\
	const Tcl_ObjIntRep *irPtr;				\
	irPtr = TclFetchIntRep((objPtr), &instNameType);	\
	assert(irPtr != NULL);					\
	(inst) = (size_t)irPtr->wideValue;			\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * GetLocationInformation --
 *
 *	This procedure looks up the information about where a procedure was
 *	originally declared.
 *
 * Results:
 *	Writes to the variables pointed at by fileObjPtr and linePtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
GetLocationInformation(
    Proc *procPtr,		/* What to look up the information for. */
    Tcl_Obj **fileObjPtr,	/* Where to write the information about what
				 * file the code came from. Will be written
				 * to, either with the object (assume shared!)
				 * that describes what the file was, or with
				 * NULL if the information is not
				 * available. */
    int *linePtr)		/* Where to write the information about what
				 * line number represented the start of the
				 * code in question. Will be written to,
				 * either with the line number or with -1 if
				 * the information is not available. */
{
    CmdFrame *cfPtr = TclGetCmdFrameForProcedure(procPtr);

    *fileObjPtr = NULL;
    *linePtr = -1;
    if (cfPtr == NULL) {
	return;
    }

    /*
     * Get the source location data out of the CmdFrame.
     */

    *linePtr = cfPtr->line[0];
    if (cfPtr->type == TCL_LOCATION_SOURCE) {
	*fileObjPtr = cfPtr->data.eval.path;
    }
}

#ifdef TCL_COMPILE_DEBUG
/*
 *----------------------------------------------------------------------
 *
 * TclPrintByteCodeObj --
 *
 *	This procedure prints ("disassembles") the instructions of a bytecode
 *	object to stdout.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintByteCodeObj(
    TCL_UNUSED(Tcl_Interp *),	/* Stuck with this in internal stubs */
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    Tcl_Obj *bufPtr = DisassembleByteCodeObj(objPtr);

    fprintf(stdout, "\n%s", TclGetString(bufPtr));
    Tcl_DecrRefCount(bufPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintInstruction --
 *
 *	This procedure prints ("disassembles") one instruction from a bytecode
 *	object to stdout.
 *
 * Results:
 *	Returns the length in bytes of the current instruiction.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclPrintInstruction(
    ByteCode *codePtr,		/* Bytecode containing the instruction. */
    const unsigned char *pc)	/* Points to first byte of instruction. */
{
    Tcl_Obj *bufferObj;
    int numBytes;

    TclNewObj(bufferObj);
    numBytes = FormatInstruction(codePtr, pc, bufferObj);
    fprintf(stdout, "%s", TclGetString(bufferObj));
    Tcl_DecrRefCount(bufferObj);
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintObject --
 *
 *	This procedure prints up to a specified number of characters from the
 *	argument Tcl object's string representation to a specified file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Outputs characters to the specified file.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintObject(
    FILE *outFile,		/* The file to print the source to. */
    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
				 * representation should be printed. */
    size_t maxChars)		/* Maximum number of chars to print. */
{
    char *bytes;
    size_t length;

    bytes = TclGetStringFromObj(objPtr, &length);
    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrintSource --
 *
 *	This procedure prints up to a specified number of characters from the
 *	argument string to a specified file. It tries to produce legible
 *	output by adding backslashes as necessary.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Outputs characters to the specified file.
 *
 *----------------------------------------------------------------------
 */

void
TclPrintSource(
    FILE *outFile,		/* The file to print the source to. */
    const char *stringPtr,	/* The string to print. */
    size_t maxChars)		/* Maximum number of chars to print. */
{
    Tcl_Obj *bufferObj;

    TclNewObj(bufferObj);
    PrintSourceToObj(bufferObj, stringPtr, maxChars);
    fprintf(outFile, "%s", TclGetString(bufferObj));
    Tcl_DecrRefCount(bufferObj);
}
#endif /* TCL_COMPILE_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * DisassembleByteCodeObj --
 *
 *	Given an object which is of bytecode type, return a disassembled
 *	version of the bytecode (in a new refcount 0 object). No guarantees
 *	are made about the details of the contents of the result.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
DisassembleByteCodeObj(
    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
{
    ByteCode *codePtr;
    unsigned char *codeStart, *codeLimit, *pc;
    unsigned char *codeDeltaNext, *codeLengthNext;
    unsigned char *srcDeltaNext, *srcLengthNext;
    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
    Interp *iPtr;
    Tcl_Obj *bufferObj, *fileObj;

    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);

    iPtr = (Interp *) *codePtr->interpHandle;

    TclNewObj(bufferObj);
    if (!codePtr->refCount) {
	return bufferObj;	/* Already freed. */
    }

    codeStart = codePtr->codeStart;
    codeLimit = codeStart + codePtr->numCodeBytes;
    numCmds = codePtr->numCommands;

    /*
     * Print header lines describing the ByteCode.
     */

    Tcl_AppendPrintfToObj(bufferObj,
	    "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
    Tcl_AppendToObj(bufferObj, "  Source ", -1);
    PrintSourceToObj(bufferObj, codePtr->source,
	    TclMin(codePtr->numSrcBytes, 55));
    GetLocationInformation(codePtr->procPtr, &fileObj, &line);
    if (line >= 0 && fileObj != NULL) {
	Tcl_AppendPrintfToObj(bufferObj, "\n  File \"%s\" Line %d",
		TclGetString(fileObj), line);
    }
    Tcl_AppendPrintfToObj(bufferObj,
	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
	    codePtr->numLitObjects, codePtr->numAuxDataItems,
	    codePtr->maxStackDepth,
#ifdef TCL_COMPILE_STATS
	    codePtr->numSrcBytes?
		    codePtr->structureSize/(float)codePtr->numSrcBytes :
#endif
	    0.0);

#ifdef TCL_COMPILE_STATS
    Tcl_AppendPrintfToObj(bufferObj,
	    "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
	    (unsigned long) codePtr->structureSize,
	    (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
	    codePtr->numCodeBytes,
	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
	    codePtr->numCmdLocBytes);
#endif /* TCL_COMPILE_STATS */

    /*
     * If the ByteCode is the compiled body of a Tcl procedure, print
     * information about that procedure. Note that we don't know the
     * procedure's name since ByteCode's can be shared among procedures.
     */

    if (codePtr->procPtr != NULL) {
	Proc *procPtr = codePtr->procPtr;
	int numCompiledLocals = procPtr->numCompiledLocals;

	Tcl_AppendPrintfToObj(bufferObj,
		"  Proc %p, refCt %" TCL_Z_MODIFIER "u, args %d, compiled locals %d\n",
		procPtr, procPtr->refCount, procPtr->numArgs,
		numCompiledLocals);
	if (numCompiledLocals > 0) {
	    CompiledLocal *localPtr = procPtr->firstLocalPtr;

	    for (i = 0;  i < numCompiledLocals;  i++) {
		Tcl_AppendPrintfToObj(bufferObj,
			"      slot %d%s%s%s%s%s%s", i,
			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
			(localPtr->flags & VAR_LINK) ? ", link" : "",
			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
		if (TclIsVarTemporary(localPtr)) {
		    Tcl_AppendToObj(bufferObj, "\n", -1);
		} else {
		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
			    localPtr->name);
		}
		localPtr = localPtr->nextPtr;
	    }
	}
    }

    /*
     * Print the ExceptionRange array.
     */

    if (codePtr->numExceptRanges > 0) {
	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
		codePtr->numExceptRanges, codePtr->maxExceptDepth);
	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	    Tcl_AppendPrintfToObj(bufferObj,
		    "      %d: level %d, %s, pc %d-%d, ",
		    i, rangePtr->nestingLevel,
		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
		    rangePtr->codeOffset,
		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
	    switch (rangePtr->type) {
	    case LOOP_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
			rangePtr->continueOffset, rangePtr->breakOffset);
		break;
	    case CATCH_EXCEPTION_RANGE:
		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
			rangePtr->catchOffset);
		break;
	    default:
		Tcl_Panic("DisassembleByteCodeObj: bad ExceptionRange type %d",
			rangePtr->type);
	    }
	}
    }

    /*
     * If there were no commands (e.g., an expression or an empty string was
     * compiled), just print all instructions and return.
     */

    if (numCmds == 0) {
	pc = codeStart;
	while (pc < codeLimit) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}
	return bufferObj;
    }

    /*
     * Print table showing the code offset, source offset, and source length
     * for each command. These are encoded as a sequence of bytes.
     */

    Tcl_AppendPrintfToObj(bufferObj, "  Commands %d:", numCmds);
    codeDeltaNext = codePtr->codeDeltaStart;
    codeLengthNext = codePtr->codeLengthStart;
    srcDeltaNext = codePtr->srcDeltaStart;
    srcLengthNext = codePtr->srcLengthStart;
    codeOffset = srcOffset = 0;
    for (i = 0;  i < numCmds;  i++) {
	if (*codeDeltaNext == 0xFF) {
	    codeDeltaNext++;
	    delta = TclGetInt4AtPtr(codeDeltaNext);
	    codeDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(codeDeltaNext);
	    codeDeltaNext++;
	}
	codeOffset += delta;

	if (*codeLengthNext == 0xFF) {
	    codeLengthNext++;
	    codeLen = TclGetInt4AtPtr(codeLengthNext);
	    codeLengthNext += 4;
	} else {
	    codeLen = TclGetInt1AtPtr(codeLengthNext);
	    codeLengthNext++;
	}

	if (*srcDeltaNext == 0xFF) {
	    srcDeltaNext++;
	    delta = TclGetInt4AtPtr(srcDeltaNext);
	    srcDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(srcDeltaNext);
	    srcDeltaNext++;
	}
	srcOffset += delta;

	if (*srcLengthNext == 0xFF) {
	    srcLengthNext++;
	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}

	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
		((i % 2)? "     " : "\n   "),
		(i+1), codeOffset, (codeOffset + codeLen - 1),
		srcOffset, (srcOffset + srcLen - 1));
    }
    if (numCmds > 0) {
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }

    /*
     * Print each instruction. If the instruction corresponds to the start of
     * a command, print the command's source. Note that we don't need the code
     * length here.
     */

    codeDeltaNext = codePtr->codeDeltaStart;
    srcDeltaNext = codePtr->srcDeltaStart;
    srcLengthNext = codePtr->srcLengthStart;
    codeOffset = srcOffset = 0;
    pc = codeStart;
    for (i = 0;  i < numCmds;  i++) {
	if (*codeDeltaNext == 0xFF) {
	    codeDeltaNext++;
	    delta = TclGetInt4AtPtr(codeDeltaNext);
	    codeDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(codeDeltaNext);
	    codeDeltaNext++;
	}
	codeOffset += delta;

	if (*srcDeltaNext == 0xFF) {
	    srcDeltaNext++;
	    delta = TclGetInt4AtPtr(srcDeltaNext);
	    srcDeltaNext += 4;
	} else {
	    delta = TclGetInt1AtPtr(srcDeltaNext);
	    srcDeltaNext++;
	}
	srcOffset += delta;

	if (*srcLengthNext == 0xFF) {
	    srcLengthNext++;
	    srcLen = TclGetInt4AtPtr(srcLengthNext);
	    srcLengthNext += 4;
	} else {
	    srcLen = TclGetInt1AtPtr(srcLengthNext);
	    srcLengthNext++;
	}

	/*
	 * Print instructions before command i.
	 */

	while ((pc-codeStart) < codeOffset) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}

	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
		TclMin(srcLen, 55));
	Tcl_AppendToObj(bufferObj, "\n", -1);
    }
    if (pc < codeLimit) {
	/*
	 * Print instructions after the last command.
	 */

	while (pc < codeLimit) {
	    Tcl_AppendToObj(bufferObj, "    ", -1);
	    pc += FormatInstruction(codePtr, pc, bufferObj);
	}
    }
    return bufferObj;
}

/*
 *----------------------------------------------------------------------
 *
 * FormatInstruction --
 *
 *	Appends a representation of a bytecode instruction to a Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

static int
FormatInstruction(
    ByteCode *codePtr,		/* Bytecode containing the instruction. */
    const unsigned char *pc,	/* Points to first byte of instruction. */
    Tcl_Obj *bufferObj)		/* Object to append instruction info to. */
{
    Proc *procPtr = codePtr->procPtr;
    unsigned char opCode = *pc;
    const InstructionDesc *instDesc = &tclInstructionTable[opCode];
    unsigned char *codeStart = codePtr->codeStart;
    unsigned pcOffset = pc - codeStart;
    int opnd = 0, i, j, numBytes = 1;
    int localCt = procPtr ? procPtr->numCompiledLocals : 0;
    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
    char suffixBuffer[128];	/* Additional info to print after main opcode
				 * and immediates. */
    char *suffixSrc = NULL;
    Tcl_Obj *suffixObj = NULL;
    AuxData *auxPtr = NULL;

    suffixBuffer[0] = '\0';
    Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
    for (i = 0;  i < instDesc->numOperands;  i++) {
	switch (instDesc->opTypes[i]) {
	case OPERAND_INT1:
	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_INT4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_UINT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_UINT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_START_CMD) {
		sprintf(suffixBuffer+strlen(suffixBuffer),
			", %u cmds start here", opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_OFFSET1:
	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
	    sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_OFFSET4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opCode == INST_START_CMD) {
		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
	    } else {
		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
	    break;
	case OPERAND_LIT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_LIT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    suffixObj = codePtr->objArrayPtr[opnd];
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    break;
	case OPERAND_AUX4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
	    Tcl_AppendPrintfToObj(bufferObj, "%u ", opnd);
	    auxPtr = &codePtr->auxDataArrayPtr[opnd];
	    break;
	case OPERAND_IDX4:
	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
	    if (opnd >= -1) {
		Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
	    } else if (opnd == -2) {
		Tcl_AppendPrintfToObj(bufferObj, "end ");
	    } else {
		Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
	    }
	    break;
	case OPERAND_LVT1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes);
	    numBytes++;
	    goto printLVTindex;
	case OPERAND_LVT4:
	    opnd = TclGetUInt4AtPtr(pc+numBytes);
	    numBytes += 4;
	printLVTindex:
	    if (localPtr != NULL) {
		if (opnd >= localCt) {
		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
			    opnd, localCt);
		}
		for (j = 0;  j < opnd;  j++) {
		    localPtr = localPtr->nextPtr;
		}
		if (TclIsVarTemporary(localPtr)) {
		    sprintf(suffixBuffer, "temp var %u", opnd);
		} else {
		    sprintf(suffixBuffer, "var ");
		    suffixSrc = localPtr->name;
		}
	    }
	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", opnd);
	    break;
	case OPERAND_SCLS1:
	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
	    Tcl_AppendPrintfToObj(bufferObj, "%s ",
		    tclStringClassTable[opnd].name);
	    break;
	case OPERAND_NONE:
	default:
	    break;
	}
    }
    if (suffixObj) {
	const char *bytes;
	size_t length;

	Tcl_AppendToObj(bufferObj, "\t# ", -1);
	bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length);
	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
    } else if (suffixBuffer[0]) {
	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
	if (suffixSrc) {
	    PrintSourceToObj(bufferObj, suffixSrc, 40);
	}
    }
    Tcl_AppendToObj(bufferObj, "\n", -1);
    if (auxPtr && auxPtr->type->printProc) {
	Tcl_AppendToObj(bufferObj, "\t\t[", -1);
	auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
		pcOffset);
	Tcl_AppendToObj(bufferObj, "]\n", -1);
    }
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetInnerContext --
 *
 *	If possible, returns a list capturing the inner context. Otherwise
 *	return NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclGetInnerContext(
    Tcl_Interp *interp,
    const unsigned char *pc,
    Tcl_Obj **tosPtr)
{
    int objc = 0, off = 0;
    Tcl_Obj *result;
    Interp *iPtr = (Interp *) interp;

    switch (*pc) {
    case INST_STR_LEN:
    case INST_LNOT:
    case INST_BITNOT:
    case INST_UMINUS:
    case INST_UPLUS:
    case INST_TRY_CVT_TO_NUMERIC:
    case INST_EXPAND_STKTOP:
    case INST_EXPR_STK:
        objc = 1;
        break;

    case INST_LIST_IN:
    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
    case INST_STR_EQ:
    case INST_STR_NEQ:		/* String (in)equality check */
    case INST_STR_CMP:		/* String compare. */
    case INST_STR_INDEX:
    case INST_STR_MATCH:
    case INST_REGEXP:
    case INST_EQ:
    case INST_NEQ:
    case INST_LT:
    case INST_GT:
    case INST_LE:
    case INST_GE:
    case INST_MOD:
    case INST_LSHIFT:
    case INST_RSHIFT:
    case INST_BITOR:
    case INST_BITXOR:
    case INST_BITAND:
    case INST_EXPON:
    case INST_ADD:
    case INST_SUB:
    case INST_DIV:
    case INST_MULT:
        objc = 2;
        break;

    case INST_RETURN_STK:
        /* early pop. TODO: dig out opt dict too :/ */
        objc = 1;
        break;

    case INST_SYNTAX:
    case INST_RETURN_IMM:
        objc = 2;
        break;

    case INST_INVOKE_STK4:
	objc = TclGetUInt4AtPtr(pc+1);
        break;

    case INST_INVOKE_STK1:
	objc = TclGetUInt1AtPtr(pc+1);
	break;
    }

    result = iPtr->innerContext;
    if (Tcl_IsShared(result)) {
        Tcl_DecrRefCount(result);
        iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
        Tcl_IncrRefCount(result);
    } else {
        int len;

        /*
         * Reset while keeping the list intrep as much as possible.
         */

	Tcl_ListObjLength(interp, result, &len);
        Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
    }
    Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));

    for (; objc>0 ; objc--) {
        Tcl_Obj *objPtr;

        objPtr = tosPtr[1 - objc + off];
        if (!objPtr) {
            Tcl_Panic("InnerContext: bad tos -- appending null object");
        }
        if ((objPtr->refCount<=0)
#ifdef TCL_MEM_DEBUG
                || (objPtr->refCount==0x61616161)
#endif
        ) {
            Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
                    objPtr);
        }
        Tcl_ListObjAppendElement(NULL, result, objPtr);
    }

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNewInstNameObj --
 *
 *	Creates a new InstName Tcl_Obj based on the given instruction
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclNewInstNameObj(
    unsigned char inst)
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclInvalidateStringRep(objPtr);
    InstNameSetIntRep(objPtr, (long) inst);

    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfInstName --
 *
 *	Update the string representation for an instruction name object.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfInstName(
    Tcl_Obj *objPtr)
{
    size_t inst;	/* NOTE: We know this is really an unsigned char */
    char *dst;

    InstNameGetIntRep(objPtr, inst);

    if (inst > LAST_INST_OPCODE) {
	dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
	TclOOM(dst, (size_t)TCL_INTEGER_SPACE + 5);
        sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst);
	(void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
    } else {
	const char *s = tclInstructionTable[inst].name;
	size_t len = strlen(s);
	dst = Tcl_InitStringRep(objPtr, s, len);
	TclOOM(dst, len);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PrintSourceToObj --
 *
 *	Appends a quoted representation of a string to a Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

static void
PrintSourceToObj(
    Tcl_Obj *appendObj,		/* The object to print the source to. */
    const char *stringPtr,	/* The string to print. */
    int maxChars)		/* Maximum number of chars to print. */
{
    const char *p;
    int i = 0, len;

    if (stringPtr == NULL) {
	Tcl_AppendToObj(appendObj, "\"\"", -1);
	return;
    }

    Tcl_AppendToObj(appendObj, "\"", -1);
    p = stringPtr;
    for (;  (*p != '\0') && (i < maxChars);  p+=len) {
	int ucs4;

	len = TclUtfToUCS4(p, &ucs4);
	switch (ucs4) {
	case '"':
	    Tcl_AppendToObj(appendObj, "\\\"", -1);
	    i += 2;
	    continue;
	case '\f':
	    Tcl_AppendToObj(appendObj, "\\f", -1);
	    i += 2;
	    continue;
	case '\n':
	    Tcl_AppendToObj(appendObj, "\\n", -1);
	    i += 2;
	    continue;
	case '\r':
	    Tcl_AppendToObj(appendObj, "\\r", -1);
	    i += 2;
	    continue;
	case '\t':
	    Tcl_AppendToObj(appendObj, "\\t", -1);
	    i += 2;
	    continue;
	case '\v':
	    Tcl_AppendToObj(appendObj, "\\v", -1);
	    i += 2;
	    continue;
	default:
	    if (ucs4 > 0xFFFF) {
		Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ucs4);
		i += 10;
	    } else if (ucs4 < 0x20 || ucs4 >= 0x7F) {
		Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ucs4);
		i += 6;
	    } else {
		Tcl_AppendPrintfToObj(appendObj, "%c", ucs4);
		i++;
	    }
	    continue;
	}
    }
    if (*p != '\0') {
	Tcl_AppendToObj(appendObj, "...", -1);
    }
    Tcl_AppendToObj(appendObj, "\"", -1);
}

/*
 *----------------------------------------------------------------------
 *
 * DisassembleByteCodeAsDicts --
 *
 *	Given an object which is of bytecode type, return a disassembled
 *	version of the bytecode (in a new refcount 0 object) in a dictionary.
 *	No guarantees are made about the details of the contents of the
 *	result, but it is intended to be more readable than the old output
 *	format.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
DisassembleByteCodeAsDicts(
    Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
{
    ByteCode *codePtr;
    Tcl_Obj *description, *literals, *variables, *instructions, *inst;
    Tcl_Obj *aux, *exn, *commands, *file;
    unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
    int codeOffset, codeLength, sourceOffset, sourceLength;
    int i, val, line;

    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);

    /*
     * Get the literals from the bytecode.
     */

    TclNewObj(literals);
    for (i=0 ; i<codePtr->numLitObjects ; i++) {
	Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
    }

    /*
     * Get the variables from the bytecode.
     */

    TclNewObj(variables);
    if (codePtr->procPtr) {
	int localCount = codePtr->procPtr->numCompiledLocals;
	CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;

	for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
	    Tcl_Obj *descriptor[2];

	    TclNewObj(descriptor[0]);
	    if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("scalar", -1));
	    }
	    if (localPtr->flags & VAR_ARRAY) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("array", -1));
	    }
	    if (localPtr->flags & VAR_LINK) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("link", -1));
	    }
	    if (localPtr->flags & VAR_ARGUMENT) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("arg", -1));
	    }
	    if (localPtr->flags & VAR_TEMPORARY) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("temp", -1));
	    }
	    if (localPtr->flags & VAR_RESOLVED) {
		Tcl_ListObjAppendElement(NULL, descriptor[0],
			Tcl_NewStringObj("resolved", -1));
	    }
	    if (localPtr->flags & VAR_TEMPORARY) {
		Tcl_ListObjAppendElement(NULL, variables,
			Tcl_NewListObj(1, descriptor));
	    } else {
		descriptor[1] = Tcl_NewStringObj(localPtr->name, -1);
		Tcl_ListObjAppendElement(NULL, variables,
			Tcl_NewListObj(2, descriptor));
	    }
	}
    }

    /*
     * Get the instructions from the bytecode.
     */

    TclNewObj(instructions);
    for (pc=codePtr->codeStart; pc<codePtr->codeStart+codePtr->numCodeBytes;){
	const InstructionDesc *instDesc = &tclInstructionTable[*pc];
	int address = pc - codePtr->codeStart;

	TclNewObj(inst);
	Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
		instDesc->name, -1));
	opnd = pc + 1;
	for (i=0 ; i<instDesc->numOperands ; i++) {
	    switch (instDesc->opTypes[i]) {
	    case OPERAND_INT1:
		val = TclGetInt1AtPtr(opnd);
		opnd += 1;
		goto formatNumber;
	    case OPERAND_UINT1:
		val = TclGetUInt1AtPtr(opnd);
		opnd += 1;
		goto formatNumber;
	    case OPERAND_INT4:
		val = TclGetInt4AtPtr(opnd);
		opnd += 4;
		goto formatNumber;
	    case OPERAND_UINT4:
		val = TclGetUInt4AtPtr(opnd);
		opnd += 4;
	    formatNumber:
		Tcl_ListObjAppendElement(NULL, inst, Tcl_NewWideIntObj(val));
		break;

	    case OPERAND_OFFSET1:
		val = TclGetInt1AtPtr(opnd);
		opnd += 1;
		goto formatAddress;
	    case OPERAND_OFFSET4:
		val = TclGetInt4AtPtr(opnd);
		opnd += 4;
	    formatAddress:
		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			"pc %d", address + val));
		break;

	    case OPERAND_LIT1:
		val = TclGetUInt1AtPtr(opnd);
		opnd += 1;
		goto formatLiteral;
	    case OPERAND_LIT4:
		val = TclGetUInt4AtPtr(opnd);
		opnd += 4;
	    formatLiteral:
		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			"@%d", val));
		break;

	    case OPERAND_LVT1:
		val = TclGetUInt1AtPtr(opnd);
		opnd += 1;
		goto formatVariable;
	    case OPERAND_LVT4:
		val = TclGetUInt4AtPtr(opnd);
		opnd += 4;
	    formatVariable:
		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			"%%%d", val));
		break;
	    case OPERAND_IDX4:
		val = TclGetInt4AtPtr(opnd);
		opnd += 4;
		if (val >= -1) {
		    Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			    ".%d", val));
		} else if (val == -2) {
		    Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj(
			    ".end", -1));
		} else {
		    Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			    ".end-%d", -2-val));
		}
		break;
	    case OPERAND_AUX4:
		val = TclGetInt4AtPtr(opnd);
		opnd += 4;
		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			"?%d", val));
		break;
	    case OPERAND_SCLS1:
		val = TclGetUInt1AtPtr(opnd);
		opnd++;
		Tcl_ListObjAppendElement(NULL, inst, Tcl_ObjPrintf(
			"=%s", tclStringClassTable[val].name));
		break;
	    case OPERAND_NONE:
		Tcl_Panic("opcode %d with more than zero 'no' operands", *pc);
	    }
	}
	Tcl_DictObjPut(NULL, instructions, Tcl_NewWideIntObj(address), inst);
	pc += instDesc->numBytes;
    }

    /*
     * Get the auxiliary data from the bytecode.
     */

    TclNewObj(aux);
    for (i=0 ; i<codePtr->numAuxDataItems ; i++) {
	AuxData *auxData = &codePtr->auxDataArrayPtr[i];
	Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1);

	if (auxData->type->disassembleProc) {
	    Tcl_Obj *desc;

	    TclNewObj(desc);
	    Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc);
	    auxDesc = desc;
	    auxData->type->disassembleProc(auxData->clientData, auxDesc,
		    codePtr, 0);
	} else if (auxData->type->printProc) {
	    Tcl_Obj *desc;

	    TclNewObj(desc);
	    auxData->type->printProc(auxData->clientData, desc, codePtr, 0);
	    Tcl_ListObjAppendElement(NULL, auxDesc, desc);
	}
	Tcl_ListObjAppendElement(NULL, aux, auxDesc);
    }

    /*
     * Get the exception ranges from the bytecode.
     */

    TclNewObj(exn);
    for (i=0 ; i<codePtr->numExceptRanges ; i++) {
	ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];

	switch (rangePtr->type) {
	case LOOP_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %d from %d to %d break %d continue %d",
		    "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->breakOffset, rangePtr->continueOffset));
	    break;
	case CATCH_EXCEPTION_RANGE:
	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
		    "type %s level %d from %d to %d catch %d",
		    "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
		    rangePtr->catchOffset));
	    break;
	}
    }

    /*
     * Get the command information from the bytecode.
     *
     * The way these are encoded in the bytecode is non-trivial; the Decode
     * macro (which updates its argument and returns the next decoded value)
     * handles this so that the rest of the code does not.
     */

#define Decode(ptr) \
    ((TclGetUInt1AtPtr(ptr) == 0xFF)			\
	? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4))		\
	: ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1)))

    TclNewObj(commands);
    codeOffPtr = codePtr->codeDeltaStart;
    codeLenPtr = codePtr->codeLengthStart;
    srcOffPtr = codePtr->srcDeltaStart;
    srcLenPtr = codePtr->srcLengthStart;
    codeOffset = sourceOffset = 0;
    for (i=0 ; i<codePtr->numCommands ; i++) {
	Tcl_Obj *cmd;

	codeOffset += Decode(codeOffPtr);
	codeLength = Decode(codeLenPtr);
	sourceOffset += Decode(srcOffPtr);
	sourceLength = Decode(srcLenPtr);
	TclNewObj(cmd);
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1),
		Tcl_NewWideIntObj(codeOffset));
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1),
		Tcl_NewWideIntObj(codeOffset + codeLength - 1));

	/*
	 * Convert byte offsets to character offsets; important if multibyte
	 * characters are present in the source!
	 */

	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptfrom", -1),
		Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source,
			sourceOffset)));
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("scriptto", -1),
		Tcl_NewWideIntObj(Tcl_NumUtfChars(codePtr->source,
			sourceOffset + sourceLength - 1)));
	Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("script", -1),
		Tcl_NewStringObj(codePtr->source+sourceOffset, sourceLength));
	Tcl_ListObjAppendElement(NULL, commands, cmd);
    }

#undef Decode

    /*
     * Get the source file and line number information from the CmdFrame
     * system if it is available.
     */

    GetLocationInformation(codePtr->procPtr, &file, &line);

    /*
     * Build the overall result.
     */

    TclNewObj(description);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1),
	    literals);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1),
	    variables);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exception", -1), exn);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("instructions", -1),
	    instructions);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("auxiliary", -1), aux);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("commands", -1),
	    commands);
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("script", -1),
	    Tcl_NewStringObj(codePtr->source, codePtr->numSrcBytes));
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("namespace", -1),
	    Tcl_NewStringObj(codePtr->nsPtr->fullName, -1));
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("stackdepth", -1),
	    Tcl_NewWideIntObj(codePtr->maxStackDepth));
    Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("exceptdepth", -1),
	    Tcl_NewWideIntObj(codePtr->maxExceptDepth));
    if (line >= 0) {
	Tcl_DictObjPut(NULL, description,
		Tcl_NewStringObj("initiallinenumber", -1),
		Tcl_NewWideIntObj(line));
    }
    if (file) {
	Tcl_DictObjPut(NULL, description,
		Tcl_NewStringObj("sourcefile", -1), file);
    }
    return description;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DisassembleObjCmd --
 *
 *	Implementation of the "::tcl::unsupported::disassemble" command. This
 *	command is not documented, but will disassemble procedures, lambda
 *	terms and general scripts. Note that will compile terms if necessary
 *	in order to disassemble them.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DisassembleObjCmd(
    ClientData clientData,	/* What type of operation. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const types[] = {
	"constructor", "destructor",
	"lambda", "method", "objmethod", "proc", "script", NULL
    };
    enum Types {
	DISAS_CLASS_CONSTRUCTOR, DISAS_CLASS_DESTRUCTOR,
	DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
	DISAS_SCRIPT
    };
    int idx, result;
    Tcl_Obj *codeObjPtr = NULL;
    Proc *procPtr = NULL;
    Tcl_HashEntry *hPtr;
    Object *oPtr;
    ByteCode *codePtr;
    Method *methodPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "type ...");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
	return TCL_ERROR;
    }

    switch ((enum Types) idx) {
    case DISAS_LAMBDA: {
	Command cmd;
	Tcl_Obj *nsObjPtr;
	Tcl_Namespace *nsPtr;

	/*
	 * Compile (if uncompiled) and disassemble a lambda term.
	 */

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
	    return TCL_ERROR;
	}

	procPtr = TclGetLambdaFromObj(interp, objv[2], &nsObjPtr);
	if (procPtr == NULL) {
	    return TCL_ERROR;
	}

	memset(&cmd, 0, sizeof(Command));
	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
	if (result != TCL_OK) {
	    return result;
	}
	cmd.nsPtr = (Namespace *) nsPtr;
	procPtr->cmdPtr = &cmd;
	result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
	if (result != TCL_OK) {
	    return result;
	}
	TclPopStackFrame(interp);
	codeObjPtr = procPtr->bodyPtr;
	break;
    }
    case DISAS_PROC:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "procName");
	    return TCL_ERROR;
	}

	procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" isn't a procedure", TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile (if uncompiled) and disassemble a procedure.
	 */

	result = TclPushProcCallFrame(procPtr, interp, 2, objv+1, 1);
	if (result != TCL_OK) {
	    return result;
	}
	TclPopStackFrame(interp);
	codeObjPtr = procPtr->bodyPtr;
	break;
    case DISAS_SCRIPT:
	/*
	 * Compile and disassemble a script.
	 */

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script");
	    return TCL_ERROR;
	}

	if (!TclHasIntRep(objv[2], &tclByteCodeType) && (TCL_OK
		!= TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) {
	    return TCL_ERROR;
	}
	codeObjPtr = objv[2];
	break;

    case DISAS_CLASS_CONSTRUCTOR:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "className");
	    return TCL_ERROR;
	}

	/*
	 * Look up the body of a constructor.
	 */

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
	if (oPtr == NULL) {
	    return TCL_ERROR;
	}
	if (oPtr->classPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" is not a class", TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	methodPtr = oPtr->classPtr->constructorPtr;
	if (methodPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" has no defined constructor",
		    TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "CONSRUCTOR", NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of constructor", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.
	 */

	if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

	    cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
	    procPtr->cmdPtr = &cmd;
	    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
		    (Namespace *) oPtr->namespacePtr, "body of constructor",
		    TclGetString(objv[2]));
	    procPtr->cmdPtr = NULL;
	    if (result != TCL_OK) {
		return result;
	    }
	}
	codeObjPtr = procPtr->bodyPtr;
	break;

    case DISAS_CLASS_DESTRUCTOR:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "className");
	    return TCL_ERROR;
	}

	/*
	 * Look up the body of a destructor.
	 */

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
	if (oPtr == NULL) {
	    return TCL_ERROR;
	}
	if (oPtr->classPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" is not a class", TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	methodPtr = oPtr->classPtr->destructorPtr;
	if (methodPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" has no defined destructor",
		    TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "DESRUCTOR", NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod(methodPtr);
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of destructor", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile if necessary.
	 */

	if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

	    cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
	    procPtr->cmdPtr = &cmd;
	    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
		    (Namespace *) oPtr->namespacePtr, "body of destructor",
		    TclGetString(objv[2]));
	    procPtr->cmdPtr = NULL;
	    if (result != TCL_OK) {
		return result;
	    }
	}
	codeObjPtr = procPtr->bodyPtr;
	break;

    case DISAS_CLASS_METHOD:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
	    return TCL_ERROR;
	}

	/*
	 * Look up the body of a class method.
	 */

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
	if (oPtr == NULL) {
	    return TCL_ERROR;
	}
	if (oPtr->classPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "\"%s\" is not a class", TclGetString(objv[2])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		    TclGetString(objv[2]), NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
		(char *) objv[3]);
	goto methodBody;
    case DISAS_OBJECT_METHOD:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
	    return TCL_ERROR;
	}

	/*
	 * Look up the body of an instance method.
	 */

	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
	if (oPtr == NULL) {
	    return TCL_ERROR;
	}
	if (oPtr->methodsPtr == NULL) {
	    goto unknownMethod;
	}
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);

	/*
	 * Compile (if necessary) and disassemble a method body.
	 */

    methodBody:
	if (hPtr == NULL) {
	unknownMethod:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown method \"%s\"", TclGetString(objv[3])));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(objv[3]), NULL);
	    return TCL_ERROR;
	}
	procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
	if (procPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "body not available for this kind of method", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		    "METHODTYPE", NULL);
	    return TCL_ERROR;
	}
	if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
	    Command cmd;

	    /*
	     * Yes, this is ugly, but we need to pass the namespace in to the
	     * compiler in two places.
	     */

	    cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
	    procPtr->cmdPtr = &cmd;
	    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
		    (Namespace *) oPtr->namespacePtr, "body of method",
		    TclGetString(objv[3]));
	    procPtr->cmdPtr = NULL;
	    if (result != TCL_OK) {
		return result;
	    }
	}
	codeObjPtr = procPtr->bodyPtr;
	break;
    default:
	CLANG_ASSERT(0);
    }

    /*
     * Do the actual disassembly.
     */

    ByteCodeGetIntRep(codeObjPtr, &tclByteCodeType, codePtr);

    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not disassemble prebuilt bytecode", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
		"BYTECODE", NULL);
	return TCL_ERROR;
    }
    if (clientData) {
	Tcl_SetObjResult(interp,
		DisassembleByteCodeAsDicts(codeObjPtr));
    } else {
	Tcl_SetObjResult(interp,
		DisassembleByteCodeObj(codeObjPtr));
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to generic/tclEncoding.c.

14
15
16
17
18
19
20
21

22
23
24
25
26
27
28
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28







-
+







typedef size_t (LengthProc)(const char *src);

/*
 * The following data structure represents an encoding, which describes how to
 * convert between various character sets and UTF-8.
 */

typedef struct {
typedef struct Encoding {
    char *name;			/* Name of encoding. Malloced because (1) hash
				 * table entry that owns this encoding may be
				 * freed prior to this encoding being freed,
				 * (2) string passed in the Tcl_EncodingType
				 * structure may not be persistent. */
    Tcl_EncodingConvertProc *toUtfProc;
				/* Function to convert from external encoding
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
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







-
+










-
+







				 * type. Passed to conversion functions. */
    LengthProc *lengthProc;	/* Function to compute length of
				 * null-terminated strings in this encoding.
				 * If nullSize is 1, this is strlen; if
				 * nullSize is 2, this is a function that
				 * returns the number of bytes in a 0x0000
				 * terminated string. */
    size_t refCount;		/* Number of uses of this structure. */
    int refCount;		/* Number of uses of this structure. */
    Tcl_HashEntry *hPtr;	/* Hash table entry that owns this encoding. */
} Encoding;

/*
 * The following structure is the clientData for a dynamically-loaded,
 * table-driven encoding created by LoadTableEncoding(). It maps between
 * Unicode and a single-byte, double-byte, or multibyte (1 or 2 bytes only)
 * encoding.
 */

typedef struct {
typedef struct TableEncodingData {
    int fallback;		/* Character (in this encoding) to substitute
				 * when this encoding cannot represent a UTF-8
				 * character. */
    char prefixBytes[256];	/* If a byte in the input stream is a lead
				 * byte for a 2-byte sequence, the
				 * corresponding entry in this array is 1,
				 * otherwise it is 0. */
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
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







-
+







-
-
+
+







-
+



-
+


-
+








-
-
-
+
+
+




-
+







				 * points to an array of 256 shorts. If there
				 * is no corresponding character the encoding,
				 * the value in the matrix is 0x0000.
				 * malloc'd. */
} TableEncodingData;

/*
 * Each of the following structures is the clientData for a dynamically-loaded
 * The following structures is the clientData for a dynamically-loaded,
 * escape-driven encoding that is itself comprised of other simpler encodings.
 * An example is "iso-2022-jp", which uses escape sequences to switch between
 * ascii, jis0208, jis0212, gb2312, and ksc5601. Note that "escape-driven"
 * does not necessarily mean that the ESCAPE character is the character used
 * for switching character sets.
 */

typedef struct {
    unsigned sequenceLen;	/* Length of following string. */
typedef struct EscapeSubTable {
    unsigned int sequenceLen;	/* Length of following string. */
    char sequence[16];		/* Escape code that marks this encoding. */
    char name[32];		/* Name for encoding. */
    Encoding *encodingPtr;	/* Encoding loaded using above name, or NULL
				 * if this sub-encoding has not been needed
				 * yet. */
} EscapeSubTable;

typedef struct {
typedef struct EscapeEncodingData {
    int fallback;		/* Character (in this encoding) to substitute
				 * when this encoding cannot represent a UTF-8
				 * character. */
    unsigned initLen;		/* Length of following string. */
    unsigned int initLen;	/* Length of following string. */
    char init[16];		/* String to emit or expect before first char
				 * in conversion. */
    unsigned finalLen;		/* Length of following string. */
    unsigned int finalLen;	/* Length of following string. */
    char final[16];		/* String to emit or expect after last char in
				 * conversion. */
    char prefixBytes[256];	/* If a byte in the input stream is the first
				 * character of one of the escape sequences in
				 * the following array, the corresponding
				 * entry in this array is 1, otherwise it is
				 * 0. */
    int numSubTables;		/* Length of following array. */
    EscapeSubTable subTables[TCLFLEXARRAY];/* Information about each EscapeSubTable used
				 * by this encoding type. The actual size is
				 * as large as necessary to hold all
    EscapeSubTable subTables[1];/* Information about each EscapeSubTable used
				 * by this encoding type. The actual size will
				 * be as large as necessary to hold all
				 * EscapeSubTables. */
} EscapeEncodingData;

/*
 * Constants used when loading an encoding file to identify the type of the
 * constants used when loading an encoding file to identify the type of the
 * file.
 */

#define ENCODING_SINGLEBYTE	0
#define ENCODING_DOUBLEBYTE	1
#define ENCODING_MULTIBYTE	2
#define ENCODING_ESCAPE		3
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
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
363
364







-
+




















-
+


-
-
-
+
+
+












+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
+










-
-
-
+
+
-
-
-
+
+



-
+
+
+



















-
-
+
+
-
-

















+
-
+
-







    0, 0, NULL, NULL, NULL, NULL, NULL
};

/*
 * A list of directories making up the "library path". Historically this
 * search path has served many uses, but the only one remaining is a base for
 * the encodingSearchPath above. If the application does not explicitly set
 * the encodingSearchPath, then it is initialized by appending /encoding
 * the encodingSearchPath, then it will be initialized by appending /encoding
 * to each directory in this "libraryPath".
 */

static ProcessGlobalValue libraryPath = {
    0, 0, NULL, NULL, TclpInitLibraryPath, NULL, NULL
};

static int encodingsInitialized = 0;

/*
 * Hash table that keeps track of all loaded Encodings. Keys are the string
 * names that represent the encoding, values are (Encoding *).
 */

static Tcl_HashTable encodingTable;
TCL_DECLARE_MUTEX(encodingMutex)

/*
 * The following are used to hold the default and current system encodings.
 * If NULL is passed to one of the conversion routines, the current setting of
 * the system encoding is used to perform the conversion.
 * the system encoding will be used to perform the conversion.
 */

static Tcl_Encoding defaultEncoding = NULL;
static Tcl_Encoding systemEncoding = NULL;
Tcl_Encoding tclIdentityEncoding = NULL;
static Tcl_Encoding defaultEncoding;
static Tcl_Encoding systemEncoding;
Tcl_Encoding tclIdentityEncoding;

/*
 * The following variable is used in the sparse matrix code for a
 * TableEncoding to represent a page in the table that has no entries.
 */

static unsigned short emptyPage[256];

/*
 * Functions used only in this module.
 */

static int		BinaryProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
static Tcl_EncodingConvertProc	BinaryProc;
static Tcl_DupInternalRepProc	DupEncodingIntRep;
static Tcl_EncodingFreeProc	EscapeFreeProc;
static Tcl_EncodingConvertProc	EscapeFromUtfProc;
static Tcl_EncodingConvertProc	EscapeToUtfProc;
static void			FillEncodingFileMap(void);
static void			FreeEncoding(Tcl_Encoding encoding);
static Tcl_FreeInternalRepProc	FreeEncodingIntRep;
static Encoding *		GetTableEncoding(EscapeEncodingData *dataPtr,
				    int state);
static Tcl_Encoding		LoadEncodingFile(Tcl_Interp *interp,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static void		DupEncodingIntRep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void		EscapeFreeProc(ClientData clientData);
static int		EscapeFromUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		EscapeToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static void		FillEncodingFileMap(void);
static void		FreeEncoding(Tcl_Encoding encoding);
static void		FreeEncodingIntRep(Tcl_Obj *objPtr);
static Encoding *	GetTableEncoding(EscapeEncodingData *dataPtr,
			    int state);
static Tcl_Encoding	LoadEncodingFile(Tcl_Interp *interp, const char *name);
				    const char *name);
static Tcl_Encoding		LoadTableEncoding(const char *name, int type,
				    Tcl_Channel chan);
static Tcl_Encoding		LoadEscapeEncoding(const char *name,
static Tcl_Encoding	LoadTableEncoding(const char *name, int type,
			    Tcl_Channel chan);
static Tcl_Encoding	LoadEscapeEncoding(const char *name, Tcl_Channel chan);
				    Tcl_Channel chan);
static Tcl_Channel		OpenEncodingFileChannel(Tcl_Interp *interp,
				    const char *name);
static Tcl_EncodingFreeProc	TableFreeProc;
static Tcl_Channel	OpenEncodingFileChannel(Tcl_Interp *interp,
			    const char *name);
static void		TableFreeProc(ClientData clientData);
static Tcl_EncodingConvertProc	TableFromUtfProc;
static Tcl_EncodingConvertProc	TableToUtfProc;
static size_t			unilen(const char *src);
static Tcl_EncodingConvertProc	Utf16ToUtfProc;
static Tcl_EncodingConvertProc	UtfToUtf16Proc;
static Tcl_EncodingConvertProc	UtfToUcs2Proc;
static int              	UtfToUtfProc(ClientData clientData,
	                            const char *src, int srcLen, int flags,
       		                    Tcl_EncodingState *statePtr, char *dst,
				    int dstLen, int *srcReadPtr,
				    int *dstWrotePtr, int *dstCharsPtr,
				    int pureNullMode);
static Tcl_EncodingConvertProc	UtfIntToUtfExtProc;
static Tcl_EncodingConvertProc	UtfExtToUtfIntProc;
static Tcl_EncodingConvertProc	Iso88591FromUtfProc;
static Tcl_EncodingConvertProc	Iso88591ToUtfProc;
static int		TableFromUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		TableToUtfProc(ClientData clientData, const char *src,
			    int srcLen, int flags, Tcl_EncodingState *statePtr,
			    char *dst, int dstLen, int *srcReadPtr,
			    int *dstWrotePtr, int *dstCharsPtr);
static size_t		unilen(const char *src);
static int		UnicodeToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		UtfToUnicodeProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		UtfToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr, int pureNullMode);
static int		UtfIntToUtfExtProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		UtfExtToUtfIntProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		Iso88591FromUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst, int dstLen,
			    int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		Iso88591ToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst,
			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);

/*
 * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field
 * of the intrep. This should help the lifetime of encodings be more useful.
 * See concerns raised in [Bug 1077262].
 */

static const Tcl_ObjType encodingType = {
static Tcl_ObjType encodingType = {
    "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
};
#define EncodingSetIntRep(objPtr, encoding)				\
    do {								\
	Tcl_ObjIntRep ir;						\
	ir.twoPtrValue.ptr1 = (encoding);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), &encodingType, &ir);			\
    } while (0)

#define EncodingGetIntRep(objPtr, encoding)				\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep ((objPtr), &encodingType);		\
	(encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEncodingFromObj --
 *
 *	Writes to (*encodingPtr) the Tcl_Encoding value of (*objPtr), if
 *	possible, and returns TCL_OK. If no such encoding exists, TCL_ERROR is
 *	returned, and if interp is non-NULL, an error message is written
 *	there.
 *
 * Results:
 *	Standard Tcl return code.
 *
 * Side effects:
 *	Caches the Tcl_Encoding value as the internal rep of (*objPtr).
 * 	Caches the Tcl_Encoding value as the internal rep of (*objPtr).
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEncodingFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Encoding *encodingPtr)
{
    Tcl_Encoding encoding;
    const char *name = TclGetString(objPtr);

    const char *name = Tcl_GetString(objPtr);
    if (objPtr->typePtr != &encodingType) {
    EncodingGetIntRep(objPtr, encoding);
    if (encoding == NULL) {
	encoding = Tcl_GetEncoding(interp, name);
	Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);

	if (encoding == NULL) {
	    return TCL_ERROR;
	}
	EncodingSetIntRep(objPtr, encoding);
	TclFreeIntRep(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) encoding;
	objPtr->typePtr = &encodingType;
    }
    *encodingPtr = Tcl_GetEncoding(NULL, name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeEncodingIntRep --
 *
 *	The Tcl_FreeInternalRepProc for the "encoding" Tcl_ObjType.
 *
 *----------------------------------------------------------------------
 */

static void
FreeEncodingIntRep(
    Tcl_Obj *objPtr)
{
    Tcl_Encoding encoding;

    Tcl_FreeEncoding((Tcl_Encoding) objPtr->internalRep.twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
    EncodingGetIntRep(objPtr, encoding);
    Tcl_FreeEncoding(encoding);
}

/*
 *----------------------------------------------------------------------
 *
 * DupEncodingIntRep --
 *
 *	The Tcl_DupInternalRepProc for the "encoding" Tcl_ObjType.
 *
 *----------------------------------------------------------------------
 */

static void
DupEncodingIntRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    dupPtr->internalRep.twoPtrValue.ptr1 = (VOID *)
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, TclGetString(srcPtr));
	    Tcl_GetEncoding(NULL, srcPtr->bytes);
    EncodingSetIntRep(dupPtr, encoding);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEncodingSearchPath --
 *
403
404
405
406
407
408
409

410
411


412
413
414
415
416
417
418
425
426
427
428
429
430
431
432


433
434
435
436
437
438
439
440
441







+
-
-
+
+







 *----------------------------------------------------------------------
 *
 * TclSetLibraryPath --
 *
 *	Keeps the per-thread copy of the library path current with changes to
 *	the global copy.
 *
 *	NOTE: this routine returns void, so there's no way to report the error
 *	Since the result of this routine is void, if searchPath is not a valid
 *	list this routine silently does nothing.
 *	that searchPath is not a valid list. In that case, this routine will
 *	silently do nothing.
 *
 *----------------------------------------------------------------------
 */

void
TclSetLibraryPath(
    Tcl_Obj *path)
426
427
428
429
430
431
432
433
434


435
436
437



438
439
440
441




442
443
444
445
446
447
448
449
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







-
-
+
+

-
-
+
+
+

-
-
-
+
+
+
+
-







}

/*
 *---------------------------------------------------------------------------
 *
 * FillEncodingFileMap --
 *
 *	Called to update the encoding file map with the current value
 *	of the encoding search path.
 * 	Called to bring the encoding file map in sync with the current value
 * 	of the encoding search path.
 *
 *	Finds *.end files in the directories on the encoding search path and
 *	stores the found pathnames in a map associated with the encoding name.
 *	Scan the directories on the encoding search path, find the *.enc
 *	files, and store the found pathnames in a map associated with the
 *	encoding name.
 *
 *	If $dir is on the encoding search path and the file $dir/foo.enc is
 *	found, stores a "foo" -> $dir entry in the map.  if the "foo" encoding
 *	is needed later, the $dir/foo.enc name can be quickly constructed in
 *	In particular, if $dir is on the encoding search path, and the file
 *	$dir/foo.enc is found, then store a "foo" -> $dir entry in the map.
 *	Later, any need for the "foo" encoding will quickly * be able to
 *	construct the $dir/foo.enc pathname for reading the encoding data.
 *	order to read the encoding data.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Entries are added to the encoding file map.
 *
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
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







-
+





-








-
+

-
-
+
+

-
+







    for (i = numDirs-1; i >= 0; i--) {
	/*
	 * Iterate backwards through the search path so as we overwrite
	 * entries found, we favor files earlier on the search path.
	 */

	int j, numFiles;
	Tcl_Obj *directory, *matchFileList;
	Tcl_Obj *directory, *matchFileList = Tcl_NewObj();
	Tcl_Obj **filev;
	Tcl_GlobTypeData readableFiles = {
	    TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL
	};

	TclNewObj(matchFileList);
	Tcl_ListObjIndex(NULL, searchPath, i, &directory);
	Tcl_IncrRefCount(directory);
	Tcl_IncrRefCount(matchFileList);
	Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc",
		&readableFiles);

	Tcl_ListObjGetElements(NULL, matchFileList, &numFiles, &filev);
	for (j=0; j<numFiles; j++) {
	    Tcl_Obj *encodingName, *fileObj;
	    Tcl_Obj *encodingName, *file;

	    fileObj = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
	    encodingName = TclPathPart(NULL, fileObj, TCL_PATH_ROOT);
	    file = TclPathPart(NULL, filev[j], TCL_PATH_TAIL);
	    encodingName = TclPathPart(NULL, file, TCL_PATH_ROOT);
	    Tcl_DictObjPut(NULL, map, encodingName, directory);
	    Tcl_DecrRefCount(fileObj);
	    Tcl_DecrRefCount(file);
	    Tcl_DecrRefCount(encodingName);
	}
	Tcl_DecrRefCount(matchFileList);
	Tcl_DecrRefCount(directory);
    }
    Tcl_DecrRefCount(searchPath);
    TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
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
611





612
613
614
615
616
617
618







619
620
621
622
623




624
625
626
627
628
629
630
631







632

633
634
635
636
637
638
639
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






611
612
613
614
615
616
617
618




619
620
621
622
623







624
625
626
627
628
629
630

631
632
633
634
635
636
637
638







-
-
-
-
-
-
-





-





-
-
-
+
+
+


-
+





+
+
-
+
+









-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+


-
-
-
-
-
-
-
-
+

-
-
-
-
-








+
+
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
+







 *---------------------------------------------------------------------------
 */

void
TclInitEncodingSubsystem(void)
{
    Tcl_EncodingType type;
    TableEncodingData *dataPtr;
    unsigned size;
    unsigned short i;
    union {
        char c;
        short s;
    } isLe;

    if (encodingsInitialized) {
	return;
    }

    isLe.s = 1;
    Tcl_MutexLock(&encodingMutex);
    Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
    Tcl_MutexUnlock(&encodingMutex);

    /*
     * Create a few initial encodings.  UTF-8 to UTF-8 translation is not a
     * no-op because it turns a stream of improperly formed UTF-8 into a
     * properly formed stream.
     * Create a few initial encodings. Note that the UTF-8 to UTF-8
     * translation is not a no-op, because it will turn a stream of improperly
     * formed UTF-8 into a properly formed stream.
     */

    type.encodingName	= NULL;
    type.encodingName	= "identity";
    type.toUtfProc	= BinaryProc;
    type.fromUtfProc	= BinaryProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= NULL;

    defaultEncoding	= Tcl_CreateEncoding(&type);
    tclIdentityEncoding = Tcl_CreateEncoding(&type);
    tclIdentityEncoding = Tcl_GetEncoding(NULL, type.encodingName);
    systemEncoding	= Tcl_GetEncoding(NULL, type.encodingName);

    type.encodingName	= "utf-8";
    type.toUtfProc	= UtfExtToUtfIntProc;
    type.fromUtfProc	= UtfIntToUtfExtProc;
    type.freeProc	= NULL;
    type.nullSize	= 1;
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf16ToUtfProc;
    type.fromUtfProc    = UtfToUcs2Proc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.encodingName   = "ucs-2le";
    type.encodingName   = "unicode";
    type.clientData	= INT2PTR(1);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "ucs-2be";
    type.clientData	= INT2PTR(0);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "ucs-2";
    type.clientData	= INT2PTR(isLe.c);
    Tcl_CreateEncoding(&type);

    type.toUtfProc	= Utf16ToUtfProc;
    type.fromUtfProc    = UtfToUtf16Proc;
    type.toUtfProc	= UnicodeToUtfProc;
    type.fromUtfProc    = UtfToUnicodeProc;
    type.freeProc	= NULL;
    type.nullSize	= 2;
    type.encodingName   = "utf-16le";
    type.clientData	= INT2PTR(1);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-16be";
    type.clientData	= INT2PTR(0);
    Tcl_CreateEncoding(&type);
    type.encodingName   = "utf-16";
    type.clientData	= INT2PTR(isLe.c);
    type.clientData	= NULL;
    Tcl_CreateEncoding(&type);

#ifndef TCL_NO_DEPRECATED
    type.encodingName   = "unicode";
    Tcl_CreateEncoding(&type);
#endif

    /*
     * Need the iso8859-1 encoding in order to process binary data, so force
     * it to always be embedded. Note that this encoding *must* be a proper
     * table encoding or some of the escape encodings crash! Hence the ugly
     * code to duplicate the structure of a table encoding here.
     */

    {
	TableEncodingData *dataPtr = (TableEncodingData *)
    dataPtr = (TableEncodingData *)Tcl_Alloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));
    dataPtr->fallback = '?';
		ckalloc(sizeof(TableEncodingData));
	unsigned size;
	unsigned short i;

	memset(dataPtr, 0, sizeof(TableEncodingData));
	dataPtr->fallback = '?';

    size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
    dataPtr->toUnicode = (unsigned short **)Tcl_Alloc(size);
    memset(dataPtr->toUnicode, 0, size);
    dataPtr->fromUnicode = (unsigned short **)Tcl_Alloc(size);
    memset(dataPtr->fromUnicode, 0, size);
	size = 256*(sizeof(unsigned short *) + sizeof(unsigned short));
	dataPtr->toUnicode = (unsigned short **) ckalloc(size);
	memset(dataPtr->toUnicode, 0, size);
	dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
	memset(dataPtr->fromUnicode, 0, size);

    dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
    dataPtr->fromUnicode[0] = (unsigned short *) (dataPtr->fromUnicode + 256);
    for (i=1 ; i<256 ; i++) {
	dataPtr->toUnicode[i] = emptyPage;
	dataPtr->fromUnicode[i] = emptyPage;
    }
	dataPtr->toUnicode[0] = (unsigned short *) (dataPtr->toUnicode + 256);
	dataPtr->fromUnicode[0] = (unsigned short *)
		(dataPtr->fromUnicode + 256);
	for (i=1 ; i<256 ; i++) {
	    dataPtr->toUnicode[i] = emptyPage;
	    dataPtr->fromUnicode[i] = emptyPage;
	}

    for (i=0 ; i<256 ; i++) {
	dataPtr->toUnicode[0][i] = i;
	dataPtr->fromUnicode[0][i] = i;
    }
	for (i=0 ; i<256 ; i++) {
	    dataPtr->toUnicode[0][i] = i;
	    dataPtr->fromUnicode[0][i] = i;
	}

    type.encodingName	= "iso8859-1";
    type.toUtfProc	= Iso88591ToUtfProc;
    type.fromUtfProc	= Iso88591FromUtfProc;
    type.freeProc	= TableFreeProc;
    type.nullSize	= 1;
    type.clientData	= dataPtr;
    defaultEncoding	= Tcl_CreateEncoding(&type);
	type.encodingName	= "iso8859-1";
	type.toUtfProc		= Iso88591ToUtfProc;
	type.fromUtfProc	= Iso88591FromUtfProc;
	type.freeProc		= TableFreeProc;
	type.nullSize		= 1;
	type.clientData		= dataPtr;
	Tcl_CreateEncoding(&type);
    systemEncoding	= Tcl_GetEncoding(NULL, type.encodingName);
    }

    encodingsInitialized = 1;
}

/*
 *----------------------------------------------------------------------
 *
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
686
687
688
689
690
691
692
693
694
695
696
697
698
699


700



701
702
703
704
705
706
707
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
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
756
757
758
759

760
761
762
763
764
765
766
767
768
769







-
-

-










-
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















+
+
-
+
+
+







{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;

    Tcl_MutexLock(&encodingMutex);
    encodingsInitialized = 0;
    FreeEncoding(systemEncoding);
    systemEncoding = NULL;
    defaultEncoding = NULL;
    FreeEncoding(tclIdentityEncoding);
    tclIdentityEncoding = NULL;

    hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
    while (hPtr != NULL) {
	/*
	 * Call FreeEncoding instead of doing it directly to handle refcounts
	 * like escape encodings use. [Bug 524674] Make sure to call
	 * Tcl_FirstHashEntry repeatedly so that all encodings are eventually
	 * cleaned up.
	 */

	FreeEncoding((Tcl_Encoding)Tcl_GetHashValue(hPtr));
	FreeEncoding((Tcl_Encoding) Tcl_GetHashValue(hPtr));
	hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
    }

    Tcl_DeleteHashTable(&encodingTable);
    Tcl_MutexUnlock(&encodingMutex);
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetDefaultEncodingDir --
 *
 * 	Legacy public interface to retrieve first directory in the encoding
 * 	searchPath.
 *
 * Results:
 *	The directory pathname, as a string, or NULL for an empty encoding
 *	search path.
 *
 * Side effects:
 * 	None.
 *
 *-------------------------------------------------------------------------
 */

const char *
Tcl_GetDefaultEncodingDir(void)
{
    int numDirs;
    Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath();

    Tcl_ListObjLength(NULL, searchPath, &numDirs);
    if (numDirs == 0) {
	return NULL;
    }
    Tcl_ListObjIndex(NULL, searchPath, 0, &first);

    return Tcl_GetString(first);
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_SetDefaultEncodingDir --
 *
 * 	Legacy public interface to set the first directory in the encoding
 * 	search path.
 *
 * Results:
 * 	None.
 *
 * Side effects:
 * 	Modifies the encoding search path.
 *
 *-------------------------------------------------------------------------
 */

void
Tcl_SetDefaultEncodingDir(
    const char *path)
{
    Tcl_Obj *searchPath = Tcl_GetEncodingSearchPath();
    Tcl_Obj *directory = Tcl_NewStringObj(path, -1);

    searchPath = Tcl_DuplicateObj(searchPath);
    Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
    Tcl_SetEncodingSearchPath(searchPath);
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncoding --
 *
 *	Given the name of a encoding, find the corresponding Tcl_Encoding
 *	token. If the encoding did not already exist, Tcl attempts to
 *	dynamically load an encoding by that name.
 *
 * Results:
 *	Returns a token that represents the encoding. If the name didn't refer
 *	to any known or loadable encoding, NULL is returned. If NULL was
 *	returned, an error message is left in interp's result object, unless
 *	interp was NULL.
 *
 * Side effects:
 *	The new encoding type is entered into a table visible to all
 *	interpreters, keyed off the encoding's name. For each call to this
 *	LoadEncodingFile is called if necessary.
 *	function, there should eventually be a call to Tcl_FreeEncoding, so
 *	that the database can be cleaned up when encodings aren't needed
 *	anymore.
 *
 *-------------------------------------------------------------------------
 */

Tcl_Encoding
Tcl_GetEncoding(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
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
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







-
+














-
-
+
+






-
+


















-
-
+
+





-










-
+

+



-
+
+
+
+
+

-
+




-
+
-
-
-
+







	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
	return systemEncoding;
    }

    hPtr = Tcl_FindHashEntry(&encodingTable, name);
    if (hPtr != NULL) {
	encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);
	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
	return (Tcl_Encoding) encodingPtr;
    }
    Tcl_MutexUnlock(&encodingMutex);

    return LoadEncodingFile(interp, name);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FreeEncoding --
 *
 *	Releases an encoding allocated by Tcl_CreateEncoding() or
 *	Tcl_GetEncoding().
 *	This function is called to release an encoding allocated by
 *	Tcl_CreateEncoding() or Tcl_GetEncoding().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference count associated with the encoding is decremented and
 *	the encoding is deleted if nothing is using it anymore.
 *	the encoding may be deleted if nothing is using it anymore.
 *
 *---------------------------------------------------------------------------
 */

void
Tcl_FreeEncoding(
    Tcl_Encoding encoding)
{
    Tcl_MutexLock(&encodingMutex);
    FreeEncoding(encoding);
    Tcl_MutexUnlock(&encodingMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeEncoding --
 *
 *	Decrements the reference count of an encoding.  The caller must hold
 *	encodingMutes.
 *	This function is called to release an encoding by functions that
 *	already have the encodingMutex.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Releases the resource for an encoding if it is now unused.
 *	The reference count associated with the encoding is decremented and
 *	the encoding may be deleted if nothing is using it anymore.
 *
 *----------------------------------------------------------------------
 */

static void
FreeEncoding(
    Tcl_Encoding encoding)
{
    Encoding *encodingPtr = (Encoding *) encoding;
    Encoding *encodingPtr;

    encodingPtr = (Encoding *) encoding;
    if (encodingPtr == NULL) {
	return;
    }
    if (encodingPtr->refCount-- <= 1) {
    if (encodingPtr->refCount<=0) {
	Tcl_Panic("FreeEncoding: refcount problem !!!");
    }
    encodingPtr->refCount--;
    if (encodingPtr->refCount == 0) {
	if (encodingPtr->freeProc != NULL) {
	    encodingPtr->freeProc(encodingPtr->clientData);
	    (*encodingPtr->freeProc)(encodingPtr->clientData);
	}
	if (encodingPtr->hPtr != NULL) {
	    Tcl_DeleteHashEntry(encodingPtr->hPtr);
	}
	if (encodingPtr->name) {
	ckfree((char *) encodingPtr->name);
	    Tcl_Free(encodingPtr->name);
	}
	Tcl_Free(encodingPtr);
	ckfree((char *) encodingPtr);
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_GetEncodingName --
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
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







-
+



-









-
+
-

-
+












-
+







void
Tcl_GetEncodingNames(
    Tcl_Interp *interp)		/* Interp to hold result. */
{
    Tcl_HashTable table;
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *map, *name, *result;
    Tcl_Obj *map, *name, *result = Tcl_NewObj();
    Tcl_DictSearch mapSearch;
    int dummy, done = 0;

    TclNewObj(result);
    Tcl_InitObjHashTable(&table);

    /*
     * Copy encoding names from loaded encoding table to table.
     */

    Tcl_MutexLock(&encodingMutex);
    for (hPtr = Tcl_FirstHashEntry(&encodingTable, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Encoding *encodingPtr = (Encoding *)Tcl_GetHashValue(hPtr);
	Encoding *encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);

	Tcl_CreateHashEntry(&table,
		Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
		(char *) Tcl_NewStringObj(encodingPtr->name, -1), &dummy);
    }
    Tcl_MutexUnlock(&encodingMutex);

    FillEncodingFileMap();
    map = TclGetProcessGlobalValue(&encodingFileMap);

    /*
     * Copy encoding names from encoding file map to table.
     */

    Tcl_DictObjFirst(NULL, map, &mapSearch, &name, NULL, &done);
    for (; !done; Tcl_DictObjNext(&mapSearch, &name, NULL, &done)) {
	Tcl_CreateHashEntry(&table, name, &dummy);
	Tcl_CreateHashEntry(&table, (char *) name, &dummy);
    }

    /*
     * Pull all encoding names from table into the result list.
     */

    for (hPtr = Tcl_FirstHashEntry(&table, &search); hPtr != NULL;
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
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







-
-
+
+




-
-
-
-
+
+
+
+


-
-
-
-
+
+
+
+
+









+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+







}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_CreateEncoding --
 *
 *	Defines a new encoding, along with the functions that are used to
 *	convert to and from Unicode.
 *	This function is called to define a new encoding and the functions
 *	that are used to convert between the specified encoding and Unicode.
 *
 * Results:
 *	Returns a token that represents the encoding. If an encoding with the
 *	same name already existed, the old encoding token remains valid and
 *	continues to behave as it used to, and is eventually garbage collected
 *	when the last reference to it goes away. Any subsequent calls to
 *	Tcl_GetEncoding with the specified name retrieve the most recent
 *	encoding token.
 *	continues to behave as it used to, and will eventually be garbage
 *	collected when the last reference to it goes away. Any subsequent
 *	calls to Tcl_GetEncoding with the specified name will retrieve the
 *	most recent encoding token.
 *
 * Side effects:
 *	A new record having the name of the encoding is entered into a table of
 *	encodings visible to all interpreters.  For each call to this function,
 *	there should eventually be a call to Tcl_FreeEncoding, which cleans
 *	deletes the record in the table when an encoding is no longer needed.
 *	The new encoding type is entered into a table visible to all
 *	interpreters, keyed off the encoding's name. For each call to this
 *	function, there should eventually be a call to Tcl_FreeEncoding, so
 *	that the database can be cleaned up when encodings aren't needed
 *	anymore.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Encoding
Tcl_CreateEncoding(
    const Tcl_EncodingType *typePtr)
				/* The encoding type. */
{
    Tcl_HashEntry *hPtr;
    int isNew;
    Encoding *encodingPtr = (Encoding *)Tcl_Alloc(sizeof(Encoding));
    encodingPtr->name		= NULL;
    Encoding *encodingPtr;
    char *name;

    Tcl_MutexLock(&encodingMutex);
    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
    if (isNew == 0) {
	/*
	 * Remove old encoding from hash table, but don't delete it until last
	 * reference goes away.
	 */

	encodingPtr = (Encoding *) Tcl_GetHashValue(hPtr);
	encodingPtr->hPtr = NULL;
    }

    name = ckalloc((unsigned) strlen(typePtr->encodingName) + 1);

    encodingPtr = (Encoding *) ckalloc(sizeof(Encoding));
    encodingPtr->name		= strcpy(name, typePtr->encodingName);
    encodingPtr->toUtfProc	= typePtr->toUtfProc;
    encodingPtr->fromUtfProc	= typePtr->fromUtfProc;
    encodingPtr->freeProc	= typePtr->freeProc;
    encodingPtr->nullSize	= typePtr->nullSize;
    encodingPtr->clientData	= typePtr->clientData;
    if (typePtr->nullSize == 1) {
	encodingPtr->lengthProc = (LengthProc *) strlen;
    } else {
	encodingPtr->lengthProc = (LengthProc *) unilen;
    }
    encodingPtr->refCount	= 1;
    encodingPtr->hPtr		= NULL;

  if (typePtr->encodingName) {
    Tcl_HashEntry *hPtr;
    int isNew;
    char *name;

    Tcl_MutexLock(&encodingMutex);
    hPtr = Tcl_CreateHashEntry(&encodingTable, typePtr->encodingName, &isNew);
    if (isNew == 0) {
	/*
	 * Remove old encoding from hash table, but don't delete it until last
	 * reference goes away.
	 */

	Encoding *replaceMe = (Encoding *)Tcl_GetHashValue(hPtr);
	replaceMe->hPtr = NULL;
    }

    name = (char *)Tcl_Alloc(strlen(typePtr->encodingName) + 1);
    encodingPtr->name		= strcpy(name, typePtr->encodingName);
    encodingPtr->hPtr		= hPtr;
    Tcl_SetHashValue(hPtr, encodingPtr);

    Tcl_MutexUnlock(&encodingMutex);
  }

    return (Tcl_Encoding) encodingPtr;
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_ExternalToUtfDString --
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
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
1140
1141
1142


1143
1144
1145
1146
1147
1148
1149
1150
1151
1152







-
+






-
-
+
+
-












-
-
+
+





-
-
+
+
+







 */

char *
Tcl_ExternalToUtfDString(
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    size_t srcLen,		/* Source string length in bytes, or -1 for
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int flags, result, soFar, srcRead, dstWrote, dstChars;
    Encoding *encodingPtr;
    int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
    size_t dstLen;

    Tcl_DStringInit(dstPtr);
    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = encodingPtr->lengthProc(src);
    } else if (srcLen < 0) {
	srcLen = (*encodingPtr->lengthProc)(src);
    }

    flags = TCL_ENCODING_START | TCL_ENCODING_END;

    while (1) {
	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);
	result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
		&dstChars);
	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);

	if (result != TCL_CONVERT_NOSPACE) {
	    Tcl_DStringSetLength(dstPtr, soFar);
	    return Tcl_DStringValue(dstPtr);
	}

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
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
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







-
+



-
-
+
+








-
+













-
-
+
+
-
-
-









-
-
+
+













-
-
-


-
-
-
-
-
+
+
+
+
-
-
+

-
+
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-









-
+

-
+
+

















-
+






-
-
+
+
-












-
+




-
+







 *	The converted bytes are stored in the output buffer.
 *
 *-------------------------------------------------------------------------
 */

int
Tcl_ExternalToUtf(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the source string, or NULL
				 * for the default system encoding. */
    const char *src,		/* Source string in specified encoding. */
    size_t srcLen,		/* Source string length in bytes, or -1
				 * for encoding-specific string length. */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * encoding-specific string length. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    size_t dstLen,		/* The maximum length of output buffer in
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const Encoding *encodingPtr;
    int result, srcRead, dstWrote, dstChars = 0;
    Encoding *encodingPtr;
    int result, srcRead, dstWrote, dstChars;
    int noTerminate = flags & TCL_ENCODING_NO_TERMINATE;
    int charLimited = (flags & TCL_ENCODING_CHAR_LIMIT) && dstCharsPtr;
    int maxChars = INT_MAX;
    Tcl_EncodingState state;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
	srcLen = encodingPtr->lengthProc(src);
    } else if (srcLen < 0) {
	srcLen = (*encodingPtr->lengthProc)(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {
	srcReadPtr = &srcRead;
    }
    if (dstWrotePtr == NULL) {
	dstWrotePtr = &dstWrote;
    }
    if (dstCharsPtr == NULL) {
	dstCharsPtr = &dstChars;
	flags &= ~TCL_ENCODING_CHAR_LIMIT;
    } else if (charLimited) {
	maxChars = *dstCharsPtr;
    }

    if (!noTerminate) {
	/*
	 * If there are any null characters in the middle of the buffer,
	 * they will converted to the UTF-8 null character (\xC080). To get
	 * the actual \0 at the end of the destination buffer, we need to
    /*
     * If there are any null characters in the middle of the buffer, they will
     * converted to the UTF-8 null character (\xC080). To get the actual \0 at
     * the end of the destination buffer, we need to append it manually.
	 * append it manually.  First make room for it...
	 */
     */

	dstLen--;
    dstLen--;
    }
    do {
	int savedFlags = flags;
	Tcl_EncodingState savedState = *statePtr;

    result = (*encodingPtr->toUtfProc)(encodingPtr->clientData, src, srcLen,
	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
		flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
		dstCharsPtr);
	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
	    dstCharsPtr);
	if (*dstCharsPtr <= maxChars) {
	    break;
	}
	dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1);
	flags = savedFlags;
	*statePtr = savedState;
    } while (1);
    if (!noTerminate) {
	/* ...and then append it */

	dst[*dstWrotePtr] = '\0';
    dst[*dstWrotePtr] = '\0';
    }

    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_UtfToExternalDString --
 *
 *	Convert a source buffer from UTF-8 to the specified encoding. If any
 *	Convert a source buffer from UTF-8 into the specified encoding. If any
 *	of the bytes in the source buffer are invalid or cannot be represented
 *	in the target encoding, a default fallback character is substituted.
 *	in the target encoding, a default fallback character will be
 *	substituted.
 *
 * Results:
 *	The converted bytes are stored in the DString, which is then NULL
 *	terminated in an encoding-specific manner. The return value is a
 *	pointer to the value stored in the DString.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

char *
Tcl_UtfToExternalDString(
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    size_t srcLen,		/* Source string length in bytes, or -1 for
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * strlen(). */
    Tcl_DString *dstPtr)	/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    char *dst;
    Tcl_EncodingState state;
    const Encoding *encodingPtr;
    int flags, result, soFar, srcRead, dstWrote, dstChars;
    Encoding *encodingPtr;
    int flags, dstLen, result, soFar, srcRead, dstWrote, dstChars;
    size_t dstLen;

    Tcl_DStringInit(dstPtr);
    dst = Tcl_DStringValue(dstPtr);
    dstLen = dstPtr->spaceAvl - 1;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
    } else if (srcLen < 0) {
	srcLen = strlen(src);
    }
    flags = TCL_ENCODING_START | TCL_ENCODING_END;
    while (1) {
	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
	result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src,
		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
		&dstChars);
	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);

	if (result != TCL_CONVERT_NOSPACE) {
	    if (encodingPtr->nullSize == 2) {
		Tcl_DStringSetLength(dstPtr, soFar + 1);
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
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
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
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







-
+



-
-
+
+








-
+













-
+










-
+

















-
+







 *	The converted bytes are stored in the output buffer.
 *
 *-------------------------------------------------------------------------
 */

int
Tcl_UtfToExternal(
    TCL_UNUSED(Tcl_Interp *),	/* TODO: Re-examine this. */
    Tcl_Interp *interp,		/* Interp for error return, if not NULL. */
    Tcl_Encoding encoding,	/* The encoding for the converted string, or
				 * NULL for the default system encoding. */
    const char *src,		/* Source string in UTF-8. */
    size_t srcLen,		/* Source string length in bytes, or -1
				 * for strlen(). */
    int srcLen,			/* Source string length in bytes, or < 0 for
				 * strlen(). */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string
				 * is stored. */
    size_t dstLen,		/* The maximum length of output buffer in
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const Encoding *encodingPtr;
    Encoding *encodingPtr;
    int result, srcRead, dstWrote, dstChars;
    Tcl_EncodingState state;

    if (encoding == NULL) {
	encoding = systemEncoding;
    }
    encodingPtr = (Encoding *) encoding;

    if (src == NULL) {
	srcLen = 0;
    } else if (srcLen == TCL_INDEX_NONE) {
    } else if (srcLen < 0) {
	srcLen = strlen(src);
    }
    if (statePtr == NULL) {
	flags |= TCL_ENCODING_START | TCL_ENCODING_END;
	statePtr = &state;
    }
    if (srcReadPtr == NULL) {
	srcReadPtr = &srcRead;
    }
    if (dstWrotePtr == NULL) {
	dstWrotePtr = &dstWrote;
    }
    if (dstCharsPtr == NULL) {
	dstCharsPtr = &dstChars;
    }

    dstLen -= encodingPtr->nullSize;
    result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
    result = (*encodingPtr->fromUtfProc)(encodingPtr->clientData, src, srcLen,
	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
	    dstCharsPtr);
    if (encodingPtr->nullSize == 2) {
	dst[*dstWrotePtr + 1] = '\0';
    }
    dst[*dstWrotePtr] = '\0';

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
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
1458
1459
1460
1461
1462
1463
1464
1465
1466







-
+



-
+





-
+












-
-
-
+
+
+







 *	application, given its argv[0] value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The absolute pathname for the application is computed and stored to be
 *	returned later by [info nameofexecutable].
 *	returned later be [info nameofexecutable].
 *
 *---------------------------------------------------------------------------
 */
#undef Tcl_FindExecutable

void
Tcl_FindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_InitSubsystems();
    TclInitSubsystems();
    TclpSetInitialEncodings();
    TclpFindExecutable(argv0);
}

/*
 *---------------------------------------------------------------------------
 *
 * OpenEncodingFileChannel --
 *
 *	Open the file believed to hold data for the encoding, "name".
 *
 * Results:
 *	Returns the readable Tcl_Channel from opening the file, or NULL if the
 *	file could not be successfully opened. If NULL was returned, an error
 *	message is left in interp's result object, unless interp was NULL.
 * 	Returns the readable Tcl_Channel from opening the file, or NULL if the
 * 	file could not be successfully opened. If NULL was returned, an error
 * 	message is left in interp's result object, unless interp was NULL.
 *
 * Side effects:
 *	Channel may be opened. Information about the filesystem may be cached
 *	to speed later calls.
 *
 *---------------------------------------------------------------------------
 */
1457
1458
1459
1460
1461
1462
1463
1464

1465
1466
1467

1468
1469
1470
1471
1472
1473
1474
1494
1495
1496
1497
1498
1499
1500

1501

1502

1503
1504
1505
1506
1507
1508
1509
1510







-
+
-

-
+








	for (i=0; i<numDirs && !verified; i++) {
	    if (dir[i] == directory) {
		verified = 1;
	    }
	}
	if (!verified) {
	    const char *dirString = TclGetString(directory);
	    const char *dirString = Tcl_GetString(directory);

	    for (i=0; i<numDirs && !verified; i++) {
		if (strcmp(dirString, TclGetString(dir[i])) == 0) {
		if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
		    verified = 1;
		}
	    }
	}
	if (!verified) {
	    /*
	     * Directory no longer on the search path. Remove from cache.
1511
1512
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540




1541
1542
1543

1544
1545
1546
1547
1548
1549
1550
1551
1552
1553


1554
1555
1556
1557
1558
1559
1560
1547
1548
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







-
-
+


















-
-
-
+
+
+
+


-
+
-







-
-
+
+







	    map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap));
	    Tcl_DictObjPut(NULL, map, nameObj, dir[i]);
	    TclSetProcessGlobalValue(&encodingFileMap, map, NULL);
	}
    }

    if ((NULL == chan) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown encoding \"%s\"", name));
	Tcl_AppendResult(interp, "unknown encoding \"", name, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
    }
    Tcl_DecrRefCount(fileNameObj);
    Tcl_DecrRefCount(nameObj);
    Tcl_DecrRefCount(searchPath);

    return chan;
}

/*
 *---------------------------------------------------------------------------
 *
 * LoadEncodingFile --
 *
 *	Read a file that describes an encoding and create a new Encoding from
 *	the data.
 *
 * Results:
 *	The return value is the newly loaded Tcl_Encoding or NULL if the file
 *	didn't exist or could not be processed. If NULL is returned and interp
 *	is not NULL, an error message is left in interp's result object.
 *	The return value is the newly loaded Encoding, or NULL if the file
 *	didn't exist of was in the incorrect format. If NULL was returned, an
 *	error message is left in interp's result object, unless interp was
 *	NULL.
 *
 * Side effects:
 *	A corresponding encoding file might be read from persistent storage, in
 *	File read from disk.
 *	which case LoadTableEncoding is called.
 *
 *---------------------------------------------------------------------------
 */

static Tcl_Encoding
LoadEncodingFile(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
    const char *name)		/* The name of both the encoding file
				 * and the new encoding. */
    const char *name)		/* The name of the encoding file on disk and
				 * also the name for new encoding. */
{
    Tcl_Channel chan = NULL;
    Tcl_Encoding encoding = NULL;
    int ch;

    chan = OpenEncodingFileChannel(interp, name);
    if (chan == NULL) {
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
1631
1632
1633
1634

1635
1636

1637
1638

1639
1640
1641
1642
1643
1644
1645
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
1668

1669
1670

1671
1672
1673
1674
1675
1676
1677
1678







-
-
+
-

-
+









-
-
-
+
+
+

-
-
-
+
+
+


-
-
+
+


-
+






-
+






-
+

-
+

-
+







	encoding = LoadTableEncoding(name, ENCODING_MULTIBYTE, chan);
	break;
    case 'E':
	encoding = LoadEscapeEncoding(name, chan);
	break;
    }
    if ((encoding == NULL) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid encoding file \"%s\"", name));
	Tcl_AppendResult(interp, "invalid encoding file \"", name, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENCODING", name, NULL);
    }
    Tcl_CloseEx(NULL, chan, 0);
    Tcl_Close(NULL, chan);

    return encoding;
}

/*
 *-------------------------------------------------------------------------
 *
 * LoadTableEncoding --
 *
 *	Helper function for LoadEncodingFile().  Creates a Tcl_EncodingType
 *	structure along with its corresponding TableEncodingData structure, and
 *	passes it to Tcl_Createncoding.
 *	Helper function for LoadEncodingTable(). Loads a table to that
 *	converts between Unicode and some other encoding and creates an
 *	encoding (using a TableEncoding structure) from that information.
 *
 *	The file contains binary data but begins with a marker to indicate
 *	byte-ordering so a single binary file can be read on big or
 *	little-endian systems.
 *	File contains binary data, but begins with a marker to indicate
 *	byte-ordering, so that same binary file can be read on either endian
 *	platforms.
 *
 * Results:
 *	Returns the new Tcl_Encoding,  or NULL if it could could
 *	not be created because the file contained invalid data.
 *	The return value is the new encoding, or NULL if the encoding could
 *	not be created (because the file contained invalid data).
 *
 * Side effects:
 *	See Tcl_CreateEncoding().
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Encoding
LoadTableEncoding(
    const char *name,		/* Name of the new encoding. */
    const char *name,		/* Name for new encoding. */
    int type,			/* Type of encoding (ENCODING_?????). */
    Tcl_Channel chan)		/* File containing new encoding. */
{
    Tcl_DString lineString;
    Tcl_Obj *objPtr;
    char *line;
    int i, hi, lo, numPages, symbol, fallback, len;
    int i, hi, lo, numPages, symbol, fallback;
    unsigned char used[256];
    unsigned size;
    unsigned int size;
    TableEncodingData *dataPtr;
    unsigned short *pageMemPtr, *page;
    unsigned short *pageMemPtr;
    Tcl_EncodingType encType;

    /*
     * Speed over memory. Use a full 256 character table to decode hex
     * sequences in the encoding files.
     */

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
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







-
+
-
-


















-
+











-
+







-
+
-

-
+
-
-
-
+




-
+







      0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 192 ... 207 */
      0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 208 ... 223 */
      0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 224 ... 239 */
      0,  0,  0,  0,  0,  0,  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 240 ... 255 */
    };

    Tcl_DStringInit(&lineString);
    if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) {
    Tcl_Gets(chan, &lineString);
	return NULL;
    }
    line = Tcl_DStringValue(&lineString);

    fallback = (int) strtol(line, &line, 16);
    symbol = (int) strtol(line, &line, 10);
    numPages = (int) strtol(line, &line, 10);
    Tcl_DStringFree(&lineString);

    if (numPages < 0) {
	numPages = 0;
    } else if (numPages > 256) {
	numPages = 256;
    }

    memset(used, 0, sizeof(used));

#undef PAGESIZE
#define PAGESIZE    (256 * sizeof(unsigned short))

    dataPtr = (TableEncodingData *)Tcl_Alloc(sizeof(TableEncodingData));
    dataPtr = (TableEncodingData *) ckalloc(sizeof(TableEncodingData));
    memset(dataPtr, 0, sizeof(TableEncodingData));

    dataPtr->fallback = fallback;

    /*
     * Read the table that maps characters to Unicode. Performs a single
     * malloc to get the memory for the array and all the pages needed by the
     * array.
     */

    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->toUnicode = (unsigned short **)Tcl_Alloc(size);
    dataPtr->toUnicode = (unsigned short **) ckalloc(size);
    memset(dataPtr->toUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->toUnicode + 256);

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    for (i = 0; i < numPages; i++) {
	int ch;
	const char *p;
	char *p;
	size_t expected = 3 + 16 * (16 * 4 + 1);

	if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) {
	Tcl_ReadChars(chan, objPtr, 3 + 16 * (16 * 4 + 1), 0);
	    return NULL;
	}
	p = TclGetString(objPtr);
	p = Tcl_GetString(objPtr);
	hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
	dataPtr->toUnicode[hi] = pageMemPtr;
	p += 2;
	for (lo = 0; lo < 256; lo++) {
	    if ((lo & 0x0F) == 0) {
	    if ((lo & 0x0f) == 0) {
		p++;
	    }
	    ch = (staticHex[UCHAR(p[0])] << 12) + (staticHex[UCHAR(p[1])] << 8)
		    + (staticHex[UCHAR(p[2])] << 4) + staticHex[UCHAR(p[3])];
	    if (ch != 0) {
		used[ch >> 8] = 1;
	    }
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
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
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
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







-
+

-
-
+
+












-
+






-
-
-
-
+
+
+

+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+






-
-
+
+




-
-
+
+




+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
-







	    if (dataPtr->toUnicode[hi] != NULL) {
		dataPtr->prefixBytes[hi] = 1;
	    }
	}
    }

    /*
     * Invert the toUnicode array to produce the fromUnicode array. Performs a
     * Invert toUnicode array to produce the fromUnicode array. Performs a
     * single malloc to get the memory for the array and all the pages needed
     * by the array. While reading in the toUnicode array remember what
     * pages are needed for the fromUnicode array.
     * by the array. While reading in the toUnicode array, we remembered what
     * pages that would be needed for the fromUnicode array.
     */

    if (symbol) {
	used[0] = 1;
    }
    numPages = 0;
    for (hi = 0; hi < 256; hi++) {
	if (used[hi]) {
	    numPages++;
	}
    }
    size = 256 * sizeof(unsigned short *) + numPages * PAGESIZE;
    dataPtr->fromUnicode = (unsigned short **)Tcl_Alloc(size);
    dataPtr->fromUnicode = (unsigned short **) ckalloc(size);
    memset(dataPtr->fromUnicode, 0, size);
    pageMemPtr = (unsigned short *) (dataPtr->fromUnicode + 256);

    for (hi = 0; hi < 256; hi++) {
	if (dataPtr->toUnicode[hi] == NULL) {
	    dataPtr->toUnicode[hi] = emptyPage;
	    continue;
	}
	for (lo = 0; lo < 256; lo++) {
	    int ch = dataPtr->toUnicode[hi][lo];
	} else {
	    for (lo = 0; lo < 256; lo++) {
		int ch;

		ch = dataPtr->toUnicode[hi][lo];
	    if (ch != 0) {
		page = dataPtr->fromUnicode[ch >> 8];
		if (page == NULL) {
		    page = pageMemPtr;
		    pageMemPtr += 256;
		    dataPtr->fromUnicode[ch >> 8] = page;
		}
		page[ch & 0xFF] = (unsigned short) ((hi << 8) + lo);
		if (ch != 0) {
		    unsigned short *page;

		    page = dataPtr->fromUnicode[ch >> 8];
		    if (page == NULL) {
			page = pageMemPtr;
			pageMemPtr += 256;
			dataPtr->fromUnicode[ch >> 8] = page;
		    }
		    page[ch & 0xff] = (unsigned short) ((hi << 8) + lo);
		}
	    }
	}
    }
    if (type == ENCODING_MULTIBYTE) {
	/*
	 * If multibyte encodings don't have a backslash character, define
	 * one. Otherwise, on Windows, native file names don't work because
	 * the backslash in the file name maps to the unknown character
	 * one. Otherwise, on Windows, native file names won't work because
	 * the backslash in the file name will map to the unknown character
	 * (question mark) when converting from UTF-8 to external encoding.
	 */

	if (dataPtr->fromUnicode[0] != NULL) {
	    if (dataPtr->fromUnicode[0][(int)'\\'] == '\0') {
		dataPtr->fromUnicode[0][(int)'\\'] = '\\';
	    if (dataPtr->fromUnicode[0]['\\'] == '\0') {
		dataPtr->fromUnicode[0]['\\'] = '\\';
	    }
	}
    }
    if (symbol) {
	unsigned short *page;

	/*
	 * Make a special symbol encoding that maps each symbol character from
	 * its Unicode code point down into page 0, and also ensure that each
	 * characters on page 0 maps to itself so that a symbol font can be
	 * used to display a simple string like "abcd" and have alpha, beta,
	 * chi, delta show up, rather than have "unknown" chars show up because
	 * strictly speaking the symbol font doesn't have glyphs for those low
	 * Make a special symbol encoding that not only maps the symbol
	 * characters from their Unicode code points down into page 0, but
	 * also ensure that the characters on page 0 map to themselves. This
	 * is so that a symbol font can be used to display a simple string
	 * like "abcd" and have alpha, beta, chi, delta show up, rather than
	 * have "unknown" chars show up because strictly speaking the symbol
	 * font doesn't have glyphs for those low ascii chars.
	 * ASCII chars.
	 */

	page = dataPtr->fromUnicode[0];
	if (page == NULL) {
	    page = pageMemPtr;
	    dataPtr->fromUnicode[0] = page;
	}
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
1893
1894
1895
1896
1897
1898
1899
1900

1901
1902
1903
1904
1905
1906
1907
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







+
+

-
-
-
+
+
+

-
-
-
+
+
+
-
-
-
-
+
+
-
-
+
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-






-
+







    }

    /*
     * For trailing 'R'everse encoding, see [Patch 689341]
     */

    Tcl_DStringInit(&lineString);
    do {
	int len;

    /*
     * Skip leading empty lines.
     */
	/*
	 * Skip leading empty lines.
	 */

    while ((len = Tcl_Gets(chan, &lineString)) == 0) {
	/* empty body */
    }
	while ((len = Tcl_Gets(chan, &lineString)) == 0) {
	    /* empty body */
	}
    if (len < 0) {
	goto doneParse;
    }


	if (len < 0) {
    /*
     * Require that it starts with an 'R'.
	    break;
     */

    line = Tcl_DStringValue(&lineString);
    if (line[0] != 'R') {
	}
	line = Tcl_DStringValue(&lineString);
	if (line[0] != 'R') {
	goto doneParse;
    }

	    break;
    /*
     * Read lines until EOF.
     */

    for (TclDStringClear(&lineString);
	    (len = Tcl_Gets(chan, &lineString)) != -1;
	    TclDStringClear(&lineString)) {
	const unsigned char *p;
	int to, from;
	}
	for (Tcl_DStringSetLength(&lineString, 0);
		(len = Tcl_Gets(chan, &lineString)) >= 0;
		Tcl_DStringSetLength(&lineString, 0)) {
	    unsigned char* p;
	    int to, from;

	/*
	 * Skip short lines.
	 */

	if (len < 5) {
	    continue;
	}
	    if (len < 5) {
		continue;
	    }

	/*
	 * Parse the line as a sequence of hex digits.
	 */

	p = (const unsigned char *) Tcl_DStringValue(&lineString);
	to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
		+ (staticHex[p[2]] << 4) + staticHex[p[3]];
	if (to == 0) {
	    continue;
	}
	for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
	    from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
		    + (staticHex[p[2]] << 4) + staticHex[p[3]];
	    if (from == 0) {
		continue;
	    }
	    dataPtr->fromUnicode[from >> 8][from & 0xFF] = to;
	}
    }
  doneParse:
	    p = (unsigned char*) Tcl_DStringValue(&lineString);
	    to = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
		    + (staticHex[p[2]] << 4) + staticHex[p[3]];
	    if (to == 0) {
	    	continue;
	    }
	    for (p += 5, len -= 5; len >= 0 && *p; p += 5, len -= 5) {
		from = (staticHex[p[0]] << 12) + (staticHex[p[1]] << 8)
			+ (staticHex[p[2]] << 4) + staticHex[p[3]];
	    	if (from == 0) {
		    continue;
		}
		dataPtr->fromUnicode[from >> 8][from & 0xff] = to;
	    }
	}
    } while (0);
    Tcl_DStringFree(&lineString);

    /*
     * Package everything into an encoding structure.
     */

    encType.encodingName    = name;
    encType.toUtfProc	    = TableToUtfProc;
    encType.fromUtfProc	    = TableFromUtfProc;
    encType.freeProc	    = TableFreeProc;
    encType.nullSize	    = (type == ENCODING_DOUBLEBYTE) ? 2 : 1;
    encType.clientData	    = dataPtr;
    encType.clientData	    = (ClientData) dataPtr;

    return Tcl_CreateEncoding(&encType);
}

/*
 *-------------------------------------------------------------------------
 *
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
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







-
+



-
+
















-
+




-







 *	None.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Encoding
LoadEscapeEncoding(
    const char *name,		/* Name of the new encoding. */
    const char *name,		/* Name for new encoding. */
    Tcl_Channel chan)		/* File containing new encoding. */
{
    int i;
    unsigned size;
    unsigned int size;
    Tcl_DString escapeData;
    char init[16], final[16];
    EscapeEncodingData *dataPtr;
    Tcl_EncodingType type;

    init[0] = '\0';
    final[0] = '\0';
    Tcl_DStringInit(&escapeData);

    while (1) {
	int argc;
	const char **argv;
	char *line;
	Tcl_DString lineString;

	Tcl_DStringInit(&lineString);
	if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) {
	if (Tcl_Gets(chan, &lineString) < 0) {
	    break;
	}
	line = Tcl_DStringValue(&lineString);
	if (Tcl_SplitList(NULL, line, &argc, &argv) != TCL_OK) {
	    Tcl_DStringFree(&lineString);
	    continue;
	}
	if (argc >= 2) {
	    if (strcmp(argv[0], "name") == 0) {
		/* do nothing */
	    } else if (strcmp(argv[0], "init") == 0) {
		strncpy(init, argv[1], sizeof(init));
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
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







-
-
+
+







-
+



-
+

-
+

-
+

-
+



-
+













-
-
-
-





-
+







		est.name[sizeof(est.name) - 1] = '\0';

		/*
		 * To avoid infinite recursion in [encoding system iso2022-*]
		 */

		e = (Encoding *) Tcl_GetEncoding(NULL, est.name);
		if ((e != NULL) && (e->toUtfProc != TableToUtfProc)
			&& (e->toUtfProc != Iso88591ToUtfProc)) {
		if (e && e->toUtfProc != TableToUtfProc &&
			e->toUtfProc != Iso88591ToUtfProc) {
		   Tcl_FreeEncoding((Tcl_Encoding) e);
		   e = NULL;
		}
		est.encodingPtr = e;
		Tcl_DStringAppend(&escapeData, (char *) &est, sizeof(est));
	    }
	}
	Tcl_Free((void *)argv);
	ckfree((char *) argv);
	Tcl_DStringFree(&lineString);
    }

    size = offsetof(EscapeEncodingData, subTables)
    size = sizeof(EscapeEncodingData) - sizeof(EscapeSubTable)
	    + Tcl_DStringLength(&escapeData);
    dataPtr = (EscapeEncodingData *)Tcl_Alloc(size);
    dataPtr = (EscapeEncodingData *) ckalloc(size);
    dataPtr->initLen = strlen(init);
    memcpy(dataPtr->init, init, dataPtr->initLen + 1);
    strcpy(dataPtr->init, init);
    dataPtr->finalLen = strlen(final);
    memcpy(dataPtr->final, final, dataPtr->finalLen + 1);
    strcpy(dataPtr->final, final);
    dataPtr->numSubTables =
	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
    memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
	    Tcl_DStringLength(&escapeData));
	    (size_t) Tcl_DStringLength(&escapeData));
    Tcl_DStringFree(&escapeData);

    memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
    for (i = 0; i < dataPtr->numSubTables; i++) {
	dataPtr->prefixBytes[UCHAR(dataPtr->subTables[i].sequence[0])] = 1;
    }
    if (dataPtr->init[0] != '\0') {
	dataPtr->prefixBytes[UCHAR(dataPtr->init[0])] = 1;
    }
    if (dataPtr->final[0] != '\0') {
	dataPtr->prefixBytes[UCHAR(dataPtr->final[0])] = 1;
    }

    /*
     * Package everything into an encoding structure.
     */

    type.encodingName	= name;
    type.toUtfProc	= EscapeToUtfProc;
    type.fromUtfProc    = EscapeFromUtfProc;
    type.freeProc	= EscapeFreeProc;
    type.nullSize	= 1;
    type.clientData	= dataPtr;
    type.clientData	= (ClientData) dataPtr;

    return Tcl_CreateEncoding(&type);
}

/*
 *-------------------------------------------------------------------------
 *
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
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







-
+



-
+
+
+
+
+




















-
-
-








-
+






-
+


-
+













-
+







 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
BinaryProc(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    const char *src,		/* Source string (unknown encoding). */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    int result;

    result = TCL_OK;
    dstLen -= TCL_UTF_MAX - 1;
    if (dstLen < 0) {
	dstLen = 0;
    }
    if ((flags & TCL_ENCODING_CHAR_LIMIT) && srcLen > *dstCharsPtr) {
	srcLen = *dstCharsPtr;
    }
    if (srcLen > dstLen) {
	srcLen = dstLen;
	result = TCL_CONVERT_NOSPACE;
    }

    *srcReadPtr = srcLen;
    *dstWrotePtr = srcLen;
    *dstCharsPtr = srcLen;
    memcpy(dst, src, srcLen);
    memcpy(dst, src, (size_t) srcLen);
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * UtfIntToUtfExtProc --
 * UtfExtToUtfIntProc --
 *
 *	Convert from UTF-8 to UTF-8. While converting null-bytes from the
 *	Tcl's internal representation (0xC0, 0x80) to the official
 *	Tcl's internal representation (0xc0, 0x80) to the official
 *	representation (0x00). See UtfToUtfProc for details.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfIntToUtfExtProc(
    ClientData clientData,
    ClientData clientData,	/* Not used. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
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
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







-
+










-


-
+








/*
 *-------------------------------------------------------------------------
 *
 * UtfExtToUtfIntProc --
 *
 *	Convert from UTF-8 to UTF-8 while converting null-bytes from the
 *	official representation (0x00) to Tcl's internal representation (0xC0,
 *	official representation (0x00) to Tcl's internal representation (0xc0,
 *	0x80). See UtfToUtfProc for details.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfExtToUtfIntProc(
    ClientData clientData,
    ClientData clientData,	/* Not used. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
2205
2206
2207
2208
2209
2210
2211
2212

2213
2214
2215
2216
2217
2218
2219
2213
2214
2215
2216
2217
2218
2219

2220
2221
2222
2223
2224
2225
2226
2227







-
+







 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfToUtfProc(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
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
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







-
+


-
-
+
+
-
-
+
-
-
-
+






-
+
-
-
-





-
-
+
+














-
-
+
+



-
+


-
+




-
+

-
-
-
+
+
+


-
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-












-
+

-
+











-
-
+
+



-
+
+
+
+
+

















-
-
+
+


-
-
-

-
-
-
+



-
-
-
-
-







-
+




-
-
-
-
-
-

-
-
+
+

+

















-
+

-
+











-
-
+
+
+







				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr,		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
    int pureNullMode)		/* Convert embedded nulls from internal
				 * representation to real null-bytes or vice
				 * versa. Also combine or separate surrogate pairs */
				 * versa. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int result, numChars, charLimit = INT_MAX;
    char *dstStart, *dstEnd;
    int result, numChars;
    int *chPtr = (int *) statePtr;

    Tcl_UniChar ch;
    if (flags & TCL_ENCODING_START) {
    	*statePtr = 0;
    }

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= 6;
	srcClose -= TCL_UTF_MAX;
    }
    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if ((src > srcClose) && (!TclUCS4Complete(src, srcEnd - src))) {
    for (numChars = 0; src < srcEnd; numChars++) {
	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
	    /*
	     * Copy 7bit characters, but skip null-bytes when we are in input
	     * mode, so that they get converted to 0xC080.
	     * Copy 7bit chatacters, but skip null-bytes when we are in input
	     * mode, so that they get converted to 0xc080.
	     */

	    *dst++ = *src++;
	} else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
	} else if (pureNullMode == 1 && UCHAR(*src) == 0xc0 &&
		(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
	    /*
	     * Convert 0xC080 to real nulls when we are in output mode.
	     * Convert 0xc080 to real nulls when we are in output mode.
	     */

	    *dst++ = 0;
	    src += 2;
	} else if (!TclUCS4Complete(src, srcEnd - src)) {
	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
	    /*
	     * Always check before using TclUtfToUCS4. Not doing can so
	     * cause it run beyond the end of the buffer! If we happen such an
	     * incomplete char its bytes are made to represent themselves.
	     * Always check before using Tcl_UtfToUniChar. Not doing can so
	     * cause it run beyond the endof the buffer! If we happen such an
	     * incomplete char its byts are made to represent themselves.
	     */

	    *chPtr = UCHAR(*src);
	    ch = (unsigned char) *src;
	    src += 1;
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	    dst += Tcl_UniCharToUtf(ch, dst);
	} else {
	    src += TclUtfToUCS4(src, chPtr);
	    if ((*chPtr | 0x7FF) == 0xDFFF) {
		/* A surrogate character is detected, handle especially */
		int low = *chPtr;
		size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
		if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) {
			*dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
			*dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
			*dst++ = (char) ((*chPtr | 0x80) & 0xBF);
			continue;
		}
		src += len;
		dst += Tcl_UniCharToUtf(*chPtr, dst);
	    src += Tcl_UtfToUniChar(src, &ch);
	    dst += Tcl_UniCharToUtf(ch, dst);
		*chPtr = low;
	    }
	    dst += Tcl_UniCharToUtf(*chPtr, dst);
	}
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * Utf16ToUtfProc --
 * UnicodeToUtfProc --
 *
 *	Convert from UTF-16 to UTF-8.
 *	Convert from Unicode to UTF-8.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
Utf16ToUtfProc(
    ClientData clientData,	/* != NULL means LE, == NUL means BE */
UnicodeToUtfProc(
    ClientData clientData,	/* Not used. */
    const char *src,		/* Source string in Unicode. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    char *dstEnd, *dstStart;
    int result, numChars;
    unsigned short ch;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;

    /* check alignment with utf-16 (2 == sizeof(UTF-16)) */
    if ((srcLen % 2) != 0) {
    if ((srcLen & 1) != 0) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen--;
    }
    /* If last code point is a high surrogate, we cannot handle that yet */
    if ((srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen-= 2;
    }

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
    for (numChars = 0; src < srcEnd; numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}

	if (clientData) {
	    ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
	} else {
	    ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);
	}
	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * unsigned short-size data.
	 * Special case for 1-byte utf chars for speed.  Make sure we
	 * work with Tcl_UniChar-size data.
	 */
	ch = *(unsigned short *)src;
	if (ch && ch < 0x80) {
	    *dst++ = (ch & 0xFF);
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src += sizeof(unsigned short);
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * UtfToUtf16Proc --
 * UtfToUnicodeProc --
 *
 *	Convert from UTF-8 to UTF-16.
 *	Convert from UTF-8 to Unicode.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfToUtf16Proc(
    ClientData clientData,	/* != NULL means LE, == NUL means BE */
UtfToUnicodeProc(
    ClientData clientData,	/* TableEncodingData that specifies
				 * encoding. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
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
2439
2440
2441
2442
2443
2444
2445



















































































































2446
2447
2448
2449
2450
2451
2452
2453







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+







				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
    Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;

    if (flags & TCL_ENCODING_START) {
    	*statePtr = 0;
    }
    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);

    result = TCL_OK;
    for (numChars = 0; src < srcEnd; numChars++) {
	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	src += TclUtfToUniChar(src, chPtr);

	if (clientData) {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (*chPtr >> 8);
	    } else {
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
	    }
#else
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (*chPtr >> 8);
#endif
	} else {
#if TCL_UTF_MAX > 3
	    if (*chPtr <= 0xFFFF) {
		*dst++ = (*chPtr >> 8);
		*dst++ = (*chPtr & 0xFF);
	    } else {
		*dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
		*dst++ = (*chPtr & 0xFF);
		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
	    }
#else
	    *dst++ = (*chPtr >> 8);
	    *dst++ = (*chPtr & 0xFF);
#endif
	}
    }
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * UtfToUcs2Proc --
 *
 *	Convert from UTF-8 to UCS-2.
 *
 * Results:
 *	Returns TCL_OK if conversion was successful.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
UtfToUcs2Proc(
    ClientData clientData,	/* != NULL means LE, == NUL means BE */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
    int result, numChars;
#if TCL_UTF_MAX <= 3
    int len;
#endif
    Tcl_UniChar ch = 0;
    Tcl_UniChar ch;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }
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
2631
2632





2633

2634
2635
2636
2637
2638
2639
2640

2641
2642
2643
2644
2645
2646
2647
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







-
+
-
-
-
-
+
-
-
-
-
-
+
+



-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
+






-
+








	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
        }
#if TCL_UTF_MAX <= 3
	src += (len = TclUtfToUniChar(src, &ch));
	if ((ch >= 0xD800) && (len < 3)) {
	    src += TclUtfToUniChar(src, &ch);
	src += TclUtfToUniChar(src, &ch);
	    ch = 0xFFFD;
	}
#else
	src += TclUtfToUniChar(src, &ch);
	if (ch > 0xFFFF) {
#if TCL_UTF_MAX > 3
	if (ch & ~0xFFFF) {
	    ch = 0xFFFD;
	}
#endif

#ifdef WORDS_BIGENDIAN
	/*
	 * Need to handle this in a way that won't cause misalignment by
	 * casting dst to a Tcl_UniChar. [Bug 1122671]
	 */

	if (clientData) {
	    *dst++ = (ch & 0xFF);
	    *dst++ = (ch >> 8);
	} else {
	    *dst++ = (ch >> 8);
	    *dst++ = (ch & 0xFF);
	*dst++ = (ch >> 8);
	*dst++ = (ch & 0xFF);
#else
	*dst++ = (ch & 0xFF);
	*dst++ = (ch >> 8);
	}
#endif
    }
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}


/*
 *-------------------------------------------------------------------------
 *
 * TableToUtfProc --
 *
 *	Convert from the encoding specified by the TableEncodingData into
 *	UTF-8.
2658
2659
2660
2661
2662
2663
2664
2665





2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
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







-
+
+
+
+
+

















-
-
-
-
-
-
+
+
+
+
+
+

-
-
-






+
-
+




-
+







static int
TableToUtfProc(
    ClientData clientData,	/* TableEncodingData that specifies
				 * encoding. */
    const char *src,		/* Source string in specified encoding. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart, *prefixBytes;
    int result, byte, numChars, charLimit = INT_MAX;
    Tcl_UniChar ch = 0;
    const unsigned short *const *toUnicode;
    const unsigned short *pageZero;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;
    char *dstEnd, *dstStart, *prefixBytes;
    int result, byte, numChars;
    Tcl_UniChar ch;
    unsigned short **toUnicode;
    unsigned short *pageZero;
    TableEncodingData *dataPtr;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    dataPtr = (TableEncodingData *) clientData;
    toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
    toUnicode = dataPtr->toUnicode;
    prefixBytes = dataPtr->prefixBytes;
    pageZero = toUnicode[0];

    result = TCL_OK;
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
    for (numChars = 0; src < srcEnd; numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	byte = *((unsigned char *) src);
	if (prefixBytes[byte]) {
	    src++;
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2578
2579
2580
2581
2582
2583
2584

2585
2586
2587

2588
2589
2590
2591
2592
2593
2594







-



-







		break;
	    }
	    if (prefixBytes[byte]) {
		src--;
	    }
	    ch = (Tcl_UniChar) byte;
	}

	/*
	 * Special case for 1-byte utf chars for speed.
	 */

	if (ch && ch < 0x80) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src++;
    }
2767
2768
2769
2770
2771
2772
2773
2774





2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793


2794
2795
2796


2797
2798
2799

2800
2801

2802
2803
2804
2805
2806
2807
2808
2619
2620
2621
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

2658
2659
2660
2661
2662
2663
2664
2665







-
+
+
+
+
+

















-
-
+
+

-
-
+
+



+

-
+







static int
TableFromUtfProc(
    ClientData clientData,	/* TableEncodingData that specifies
				 * encoding. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd, *prefixBytes;
    Tcl_UniChar ch = 0;
    char *dstStart, *dstEnd, *prefixBytes;
    Tcl_UniChar ch;
    int result, len, word, numChars;
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;
    const unsigned short *const *fromUnicode;
    TableEncodingData *dataPtr;
    unsigned short **fromUnicode;

    result = TCL_OK;

    dataPtr = (TableEncodingData *) clientData;
    prefixBytes = dataPtr->prefixBytes;
    fromUnicode = (const unsigned short *const *) dataPtr->fromUnicode;
    fromUnicode = dataPtr->fromUnicode;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831


2832
2833
2834
2835
2836
2837
2838
2839

2840
2841
2842
2843
2844
2845
2846
2676
2677
2678
2679
2680
2681
2682






2683
2684




2685
2686
2687

2688
2689
2690
2691
2692
2693
2694
2695







-
-
-
-
-
-
+
+
-
-
-
-



-
+








	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	len = TclUtfToUniChar(src, &ch);

#if TCL_UTF_MAX > 3
	/*
	 * This prevents a crash condition. More evaluation is required for
	 * full support of int Tcl_UniChar. [Bug 1004065]
	 */

	if (ch & 0xFFFF0000) {
	/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
	if (ch & ~0xFFFF) {
	    word = 0;
	} else
#else
	if (!len) {
	    word = 0;
	} else
#endif
	    word = fromUnicode[(ch >> 8)][ch & 0xFF];
	    word = fromUnicode[(ch >> 8)][ch & 0xff];

	if ((word == 0) && (ch != 0)) {
	    if (flags & TCL_ENCODING_STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
	    word = dataPtr->fallback;
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
2733
2734
2735
2736
2737
2738
2739

2740
2741
2742
2743

2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765


2766
2767
2768



2769
2770
2771
2772
2773
2774
2775


2776
2777
2778
2779
2780
2781
2782
2783

2784
2785
2786

2787
2788
2789
2790
2791
2792
2793







-
+



-
+
+
+
+
+

















-
-
+
+

-
-
-







-
-
+
+






-



-







 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
Iso88591ToUtfProc(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Ignored. */
    const char *src,		/* Source string in specified encoding. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;
    char *dstEnd, *dstStart;
    int result, numChars;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    result = TCL_OK;
    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	Tcl_UniChar ch = 0;
    for (numChars = 0; src < srcEnd; numChars++) {
	Tcl_UniChar ch;

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	ch = (Tcl_UniChar) *((unsigned char *) src);

	/*
	 * Special case for 1-byte utf chars for speed.
	 */

	if (ch && ch < 0x80) {
	    *dst++ = (char) ch;
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src++;
    }
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
3042
3043
2812
2813
2814
2815
2816
2817
2818

2819
2820
2821
2822

2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844



2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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







-
+



-
+
+
+
+
+

















-
-
-
+
+
+
+












+

















-
+
-
-
-
-




-
+
-
-







 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
Iso88591FromUtfProc(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Ignored. */
    const char *src,		/* Source string in UTF-8. */
    int srcLen,			/* Source string length in bytes. */
    int flags,			/* Conversion control flags. */
    TCL_UNUSED(Tcl_EncodingState *),
    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
				 * information used during a piecewise
				 * conversion. Contents of statePtr are
				 * initialized and/or reset by conversion
				 * routine under control of flags argument. */
    char *dst,			/* Output buffer in which converted string is
				 * stored. */
    int dstLen,			/* The maximum length of output buffer in
				 * bytes. */
    int *srcReadPtr,		/* Filled with the number of bytes from the
				 * source string that were converted. This may
				 * be less than the original source length if
				 * there was a problem converting some source
				 * characters. */
    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    int result = TCL_OK, numChars;
    Tcl_UniChar ch = 0;
    char *dstStart, *dstEnd;
    int result, numChars;

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

    for (numChars = 0; src < srcEnd; numChars++) {
	Tcl_UniChar ch;
	int len;

	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	len = TclUtfToUniChar(src, &ch);

	/*
	 * Check for illegal characters.
	 */

	if (ch > 0xFF
	if (ch > 0xff) {
#if TCL_UTF_MAX <= 3
		|| ((ch >= 0xD800) && (len < 3))
#endif
		) {
	    if (flags & TCL_ENCODING_STOPONERROR) {
		result = TCL_CONVERT_UNKNOWN;
		break;
	    }
#if TCL_UTF_MAX <= 3

	    if ((ch >= 0xD800) && (len < 3)) len = 4;
#endif
	    /*
	     * Plunge on, using '?' as a fallback character.
	     */

	    ch = (Tcl_UniChar) '?';
	}

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
2921
2922
2923
2924
2925
2926
2927

2928
2929
2930
2931
2932
2933



2934
2935
2936


2937
2938
2939
2940
2941
2942
2943
2944







-
+





-
-
-
+
+
+
-
-
+







 */

static void
TableFreeProc(
    ClientData clientData)	/* TableEncodingData that specifies
				 * encoding. */
{
    TableEncodingData *dataPtr = (TableEncodingData *)clientData;
    TableEncodingData *dataPtr;

    /*
     * Make sure we aren't freeing twice on shutdown. [Bug 219314]
     */

    Tcl_Free(dataPtr->toUnicode);
    dataPtr->toUnicode = NULL;
    Tcl_Free(dataPtr->fromUnicode);
    dataPtr = (TableEncodingData *) clientData;
    ckfree((char *) dataPtr->toUnicode);
    ckfree((char *) dataPtr->fromUnicode);
    dataPtr->fromUnicode = NULL;
    Tcl_Free(dataPtr);
    ckfree((char *) dataPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * EscapeToUtfProc --
 *
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
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







-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
-
-
-
+
+
+
+














-
+








-
+

-
+







    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
    const unsigned short *const *tableToUnicode;
    const Encoding *encodingPtr;
    int state, result, numChars, charLimit = INT_MAX;
    const char *dstStart, *dstEnd;
    EscapeEncodingData *dataPtr;
    char *prefixBytes, *tablePrefixBytes;
    unsigned short **tableToUnicode;
    Encoding *encodingPtr;
    int state, result, numChars;
    const char *srcStart, *srcEnd;
    char *dstStart, *dstEnd;

    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;

    result = TCL_OK;
    tablePrefixBytes = NULL;
    tableToUnicode = NULL;
    tablePrefixBytes = NULL;	/* lint. */
    tableToUnicode = NULL;	/* lint. */

    dataPtr = (EscapeEncodingData *) clientData;
    prefixBytes = dataPtr->prefixBytes;
    encodingPtr = NULL;

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    state = PTR2INT(*statePtr);
    if (flags & TCL_ENCODING_START) {
	state = 0;
    }

    for (numChars = 0; src < srcEnd && numChars <= charLimit; ) {
    for (numChars = 0; src < srcEnd; ) {
	int byte, hi, lo, ch;

	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	byte = *((unsigned char *) src);
	if (prefixBytes[byte]) {
	    unsigned left, len, longest;
	    unsigned int left, len, longest;
	    int checked, i;
	    const EscapeSubTable *subTablePtr;
	    EscapeSubTable *subTablePtr;

	    /*
	     * Saw the beginning of an escape sequence.
	     */

	    left = srcEnd - src;
	    len = dataPtr->initLen;
3267
3268
3269
3270
3271
3272
3273
3274

3275
3276
3277

3278
3279
3280
3281
3282
3283
3284
3115
3116
3117
3118
3119
3120
3121

3122
3123


3124
3125
3126
3127
3128
3129
3130
3131







-
+

-
-
+







	    break;
	}

	if (encodingPtr == NULL) {
	    TableEncodingData *tableDataPtr;

	    encodingPtr = GetTableEncoding(dataPtr, state);
	    tableDataPtr = (TableEncodingData *)encodingPtr->clientData;
	    tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
	    tablePrefixBytes = tableDataPtr->prefixBytes;
	    tableToUnicode = (const unsigned short *const*)
		    tableDataPtr->toUnicode;
	    tableToUnicode = tableDataPtr->toUnicode;
	}

	if (tablePrefixBytes[byte]) {
	    src++;
	    if (src >= srcEnd) {
		src--;
		result = TCL_CONVERT_MULTIBYTE;
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
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







-
-
+
+

-
+

-
-
-
+
+
+
-


+
+












-
+










-
+






-
+

-
-
+


-
+

+











-
+



-
+




-
-
+
+












-
+



-
+
-
-
+



-
+

















-
+
+







    int *dstWrotePtr,		/* Filled with the number of bytes that were
				 * stored in the output buffer as a result of
				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    const Encoding *encodingPtr;
    EscapeEncodingData *dataPtr;
    Encoding *encodingPtr;
    const char *srcStart, *srcEnd, *srcClose;
    const char *dstStart, *dstEnd;
    char *dstStart, *dstEnd;
    int state, result, numChars;
    const TableEncodingData *tableDataPtr;
    const char *tablePrefixBytes;
    const unsigned short *const *tableFromUnicode;
    TableEncodingData *tableDataPtr;
    char *tablePrefixBytes;
    unsigned short **tableFromUnicode;
    Tcl_UniChar ch = 0;

    result = TCL_OK;

    dataPtr = (EscapeEncodingData *) clientData;

    srcStart = src;
    srcEnd = src + srcLen;
    srcClose = srcEnd;
    if ((flags & TCL_ENCODING_END) == 0) {
	srcClose -= TCL_UTF_MAX;
    }

    dstStart = dst;
    dstEnd = dst + dstLen - 1;

    /*
     * RFC 1468 states that the text starts in ASCII, and switches to Japanese
     * RFC1468 states that the text starts in ASCII, and switches to Japanese
     * characters, and that the text must end in ASCII. [Patch 474358]
     */

    if (flags & TCL_ENCODING_START) {
	state = 0;
	if ((dst + dataPtr->initLen) > dstEnd) {
	    *srcReadPtr = 0;
	    *dstWrotePtr = 0;
	    return TCL_CONVERT_NOSPACE;
	}
	memcpy(dst, dataPtr->init, dataPtr->initLen);
	memcpy(dst, dataPtr->init, (size_t)dataPtr->initLen);
	dst += dataPtr->initLen;
    } else {
	state = PTR2INT(*statePtr);
    }

    encodingPtr = GetTableEncoding(dataPtr, state);
    tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
    tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
    tablePrefixBytes = tableDataPtr->prefixBytes;
    tableFromUnicode = (const unsigned short *const *)
	    tableDataPtr->fromUnicode;
    tableFromUnicode = tableDataPtr->fromUnicode;

    for (numChars = 0; src < srcEnd; numChars++) {
	unsigned len;
	unsigned int len;
	int word;
	Tcl_UniChar ch;

	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
	    /*
	     * If there is more string to follow, this will ensure that the
	     * last UTF-8 character in the source buffer hasn't been cut off.
	     */

	    result = TCL_CONVERT_MULTIBYTE;
	    break;
	}
	len = TclUtfToUniChar(src, &ch);
	word = tableFromUnicode[(ch >> 8)][ch & 0xFF];
	word = tableFromUnicode[(ch >> 8)][ch & 0xff];

	if ((word == 0) && (ch != 0)) {
	    int oldState;
	    const EscapeSubTable *subTablePtr;
	    EscapeSubTable *subTablePtr;

	    oldState = state;
	    for (state = 0; state < dataPtr->numSubTables; state++) {
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xFF];
		tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
	    	word = tableDataPtr->fromUnicode[(ch >> 8)][ch & 0xff];
		if (word != 0) {
		    break;
		}
	    }

	    if (word == 0) {
		state = oldState;
		if (flags & TCL_ENCODING_STOPONERROR) {
		    result = TCL_CONVERT_UNKNOWN;
		    break;
		}
		encodingPtr = GetTableEncoding(dataPtr, state);
		tableDataPtr = (const TableEncodingData *)encodingPtr->clientData;
		tableDataPtr = (TableEncodingData *) encodingPtr->clientData;
		word = tableDataPtr->fallback;
	    }

	    tablePrefixBytes = (const char *) tableDataPtr->prefixBytes;
	    tablePrefixBytes = tableDataPtr->prefixBytes;
	    tableFromUnicode = (const unsigned short *const *)
		    tableDataPtr->fromUnicode;
	    tableFromUnicode = tableDataPtr->fromUnicode;

	    /*
	     * The state variable has the value of oldState when word is 0.
	     * In this case, the escape sequence should not be copied to dst
	     * In this case, the escape sequense should not be copied to dst
	     * because the current character set is not changed.
	     */

	    if (state != oldState) {
		subTablePtr = &dataPtr->subTables[state];
		if ((dst + subTablePtr->sequenceLen) > dstEnd) {
		    /*
		     * If there is no space to write the escape sequence, the
		     * state variable must be changed to the value of oldState
		     * variable because this escape sequence must be written
		     * in the next conversion.
		     */

		    state = oldState;
		    result = TCL_CONVERT_NOSPACE;
		    break;
		}
		memcpy(dst, subTablePtr->sequence, subTablePtr->sequenceLen);
		memcpy(dst, subTablePtr->sequence,
			(size_t) subTablePtr->sequenceLen);
		dst += subTablePtr->sequenceLen;
	    }
	}

	if (tablePrefixBytes[(word >> 8)] != 0) {
	    if (dst + 1 > dstEnd) {
		result = TCL_CONVERT_NOSPACE;
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
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







-
+
-

-
-
-
-
-
-
+
+
+
+
+
+
+
+

-




-
+


-
+

















+
-
+





-
+









-
+



+



-

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

+
-
+
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+







	    dst[0] = (char) word;
	    dst++;
	}
	src += len;
    }

    if ((result == TCL_OK) && (flags & TCL_ENCODING_END)) {
	unsigned len = dataPtr->subTables[0].sequenceLen;
	unsigned int len = dataPtr->subTables[0].sequenceLen;

	/*
	 * Certain encodings like iso2022-jp need to write an escape sequence
	 * after all characters have been converted. This logic checks that
	 * enough room is available in the buffer for the escape bytes. The
	 * TCL_ENCODING_END flag is cleared after a final escape sequence has
	 * been added to the buffer so that another call to this method does
	 * not attempt to append escape bytes a second time.
	 * Certain encodings like iso2022-jp need to write
	 * an escape sequence after all characters have
	 * been converted. This logic checks that enough
	 * room is available in the buffer for the escape bytes.
	 * The TCL_ENCODING_END flag is cleared after a final
	 * escape sequence has been added to the buffer so
	 * that another call to this method does not attempt
	 * to append escape bytes a second time.
	 */

	if ((dst + dataPtr->finalLen + (state?len:0)) > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	} else {
	    if (state) {
		memcpy(dst, dataPtr->subTables[0].sequence, len);
		memcpy(dst, dataPtr->subTables[0].sequence, (size_t) len);
		dst += len;
	    }
	    memcpy(dst, dataPtr->final, dataPtr->finalLen);
	    memcpy(dst, dataPtr->final, (size_t) dataPtr->finalLen);
	    dst += dataPtr->finalLen;
	    state &= ~TCL_ENCODING_END;
	}
    }

    *statePtr = (Tcl_EncodingState) INT2PTR(state);
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * EscapeFreeProc --
 *
 *	This function is invoked when an EscapeEncodingData encoding is
 *	Frees resources used by the encoding.
 *	deleted. It deletes the memory used by the encoding.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *	Memory freed.
 *
 *---------------------------------------------------------------------------
 */

static void
EscapeFreeProc(
    ClientData clientData)	/* EscapeEncodingData that specifies
				 * encoding. */
{
    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
    EscapeEncodingData *dataPtr;
    EscapeSubTable *subTablePtr;
    int i;

    dataPtr = (EscapeEncodingData *) clientData;
    if (dataPtr == NULL) {
	return;
    }

    /*
     * The subTables should be freed recursively in normal operation but not
     * during TclFinalizeEncodingSubsystem because they are also present as a
     * weak reference in the toplevel encodingTable (i.e., they don't have a
     * +1 refcount for this), and unpredictable nuking order could remove them
     * from under the following loop's feet. [Bug 2891556]
     *
     * The encodingsInitialized flag, being reset on entry to TFES, can serve
     * as a "not in finalization" test.
     *  The subTables should be freed recursively in normal operation but not
     *  during TclFinalizeEncodingSubsystem because they are also present as a
     *  weak reference in the toplevel encodingTable (ie they don't have a +1
     *  refcount for this), and unpredictable nuking order could remove them
     *  from under the following loop's feet [Bug 2891556].
     *  
     *  The encodingsInitialized flag, being reset on entry to TFES, can serve
     *  as a "not in finalization" test.
     */
    if (encodingsInitialized)

	{
    if (encodingsInitialized) {
	subTablePtr = dataPtr->subTables;
	for (i = 0; i < dataPtr->numSubTables; i++) {
	    FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
	    subTablePtr = dataPtr->subTables;
	    for (i = 0; i < dataPtr->numSubTables; i++) {
		FreeEncoding((Tcl_Encoding) subTablePtr->encodingPtr);
	    subTablePtr->encodingPtr = NULL;
	    subTablePtr++;
	}
    }
    Tcl_Free(dataPtr);
		subTablePtr++;
	    }
	}
    ckfree((char *) dataPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * GetTableEncoding --
 *
3588
3589
3590
3591
3592
3593
3594
3595
3596





3597
3598
3599
3600
3601
3602
3603
3436
3437
3438
3439
3440
3441
3442


3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454







-
-
+
+
+
+
+







 */

static Encoding *
GetTableEncoding(
    EscapeEncodingData *dataPtr,/* Contains names of encodings. */
    int state)			/* Index in dataPtr of desired Encoding. */
{
    EscapeSubTable *subTablePtr = &dataPtr->subTables[state];
    Encoding *encodingPtr = subTablePtr->encodingPtr;
    EscapeSubTable *subTablePtr;
    Encoding *encodingPtr;

    subTablePtr = &dataPtr->subTables[state];
    encodingPtr = subTablePtr->encodingPtr;

    if (encodingPtr == NULL) {
	encodingPtr = (Encoding *) Tcl_GetEncoding(NULL, subTablePtr->name);
	if ((encodingPtr == NULL)
		|| (encodingPtr->toUtfProc != TableToUtfProc
		&& encodingPtr->toUtfProc != Iso88591ToUtfProc)) {
	    Tcl_Panic("EscapeToUtfProc: invalid sub table");
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

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







-
+


-
-
-
+
+
+


-
+

-
-
-
-
+
+
+
+


-
+


-
-
-
-
-
+
+
+
+
+

-
+


-
+





-
-
-
-
+
+
+
+
+
+









+
 *
 *-------------------------------------------------------------------------
 */

static void
InitializeEncodingSearchPath(
    char **valuePtr,
    size_t *lengthPtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *bytes;
    int i, numDirs;
    Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
    char *bytes;
    int i, numDirs, numBytes;
    Tcl_Obj *libPath, *encodingObj, *searchPath;

    TclNewLiteralStringObj(encodingObj, "encoding");
    TclNewObj(searchPathObj);
    TclNewObj(searchPath);
    Tcl_IncrRefCount(encodingObj);
    Tcl_IncrRefCount(searchPathObj);
    libPathObj = TclGetLibraryPath();
    Tcl_IncrRefCount(libPathObj);
    Tcl_ListObjLength(NULL, libPathObj, &numDirs);
    Tcl_IncrRefCount(searchPath);
    libPath = TclGetLibraryPath();
    Tcl_IncrRefCount(libPath);
    Tcl_ListObjLength(NULL, libPath, &numDirs);

    for (i = 0; i < numDirs; i++) {
	Tcl_Obj *directoryObj, *pathObj;
	Tcl_Obj *directory, *path;
	Tcl_StatBuf stat;

	Tcl_ListObjIndex(NULL, libPathObj, i, &directoryObj);
	pathObj = Tcl_FSJoinToPath(directoryObj, 1, &encodingObj);
	Tcl_IncrRefCount(pathObj);
	if ((0 == Tcl_FSStat(pathObj, &stat)) && S_ISDIR(stat.st_mode)) {
	    Tcl_ListObjAppendElement(NULL, searchPathObj, pathObj);
	Tcl_ListObjIndex(NULL, libPath, i, &directory);
	path = Tcl_FSJoinToPath(directory, 1, &encodingObj);
	Tcl_IncrRefCount(path);
	if ((0 == Tcl_FSStat(path, &stat)) && S_ISDIR(stat.st_mode)) {
	    Tcl_ListObjAppendElement(NULL, searchPath, path);
	}
	Tcl_DecrRefCount(pathObj);
	Tcl_DecrRefCount(path);
    }

    Tcl_DecrRefCount(libPathObj);
    Tcl_DecrRefCount(libPath);
    Tcl_DecrRefCount(encodingObj);
    *encodingPtr = libraryPath.encoding;
    if (*encodingPtr) {
	((Encoding *)(*encodingPtr))->refCount++;
    }
    bytes = TclGetStringFromObj(searchPathObj, lengthPtr);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, bytes, *lengthPtr + 1);
    Tcl_DecrRefCount(searchPathObj);
    bytes = Tcl_GetStringFromObj(searchPath, &numBytes);

    *lengthPtr = numBytes;
    *valuePtr = ckalloc((unsigned int) numBytes + 1);
    memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
    Tcl_DecrRefCount(searchPath);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclEnsemble.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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


































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclEnsemble.c --
 *
 *	Contains support for ensembles (see TIP#112), which provide simple
 *	mechanism for creating composite commands on top of namespaces.
 *
 * Copyright (c) 2005-2013 Donal K. Fellows.
 *
 * 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 "tclCompile.h"

/*
 * Declarations for functions local to this file:
 */

static inline Tcl_Obj *	NewNsObj(Tcl_Namespace *namespacePtr);
static inline int	EnsembleUnknownCallback(Tcl_Interp *interp,
			    EnsembleConfig *ensemblePtr, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
static int		NsEnsembleImplementationCmdNR(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
static int		NsEnsembleStringOrder(const void *strPtr1,
			    const void *strPtr2);
static void		DeleteEnsembleConfig(ClientData clientData);
static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
			    EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr,
			    Tcl_Obj *fix);
static void		FreeEnsembleCmdRep(Tcl_Obj *objPtr);
static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		CompileToInvokedCommand(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Tcl_Obj *replacements,
			    Command *cmdPtr, CompileEnv *envPtr);
static int		CompileBasicNArgCommand(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    CompileEnv *envPtr);

static Tcl_NRPostProc	FreeER;

/*
 * The lists of subcommands and options for the [namespace ensemble] command.
 */

static const char *const ensembleSubcommands[] = {
    "configure", "create", "exists", NULL
};
enum EnsSubcmds {
    ENS_CONFIG, ENS_CREATE, ENS_EXISTS
};

static const char *const ensembleCreateOptions[] = {
    "-command", "-map", "-parameters", "-prefixes", "-subcommands",
    "-unknown", NULL
};
enum EnsCreateOpts {
    CRT_CMD, CRT_MAP, CRT_PARAM, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
};

static const char *const ensembleConfigOptions[] = {
    "-map", "-namespace", "-parameters", "-prefixes", "-subcommands",
    "-unknown", NULL
};
enum EnsConfigOpts {
    CONF_MAP, CONF_NAMESPACE, CONF_PARAM, CONF_PREFIX, CONF_SUBCMDS,
    CONF_UNKNOWN
};

/*
 * This structure defines a Tcl object type that contains a reference to an
 * ensemble subcommand (e.g. the "length" in [string length ab]). It is used
 * to cache the mapping between the subcommand itself and the real command
 * that implements it.
 */

static const Tcl_ObjType ensembleCmdType = {
    "ensembleCommand",		/* the type's name */
    FreeEnsembleCmdRep,		/* freeIntRepProc */
    DupEnsembleCmdRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

#define ECRSetIntRep(objPtr, ecRepPtr)					\
    do {								\
	Tcl_ObjIntRep ir;						\
	ir.twoPtrValue.ptr1 = (ecRepPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir);		\
    } while (0)

#define ECRGetIntRep(objPtr, ecRepPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &ensembleCmdType);		\
	(ecRepPtr) = irPtr ? (EnsembleCmdRep *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * The internal rep for caching ensemble subcommand lookups and spelling
 * corrections.
 */

typedef struct {
    size_t epoch;               /* Used to confirm when the data in this
                                 * really structure matches up with the
                                 * ensemble. */
    Command *token;             /* Reference to the command for which this
                                 * structure is a cache of the resolution. */
    Tcl_Obj *fix;               /* Corrected spelling, if needed. */
    Tcl_HashEntry *hPtr;        /* Direct link to entry in the subcommand hash
                                 * table. */
} EnsembleCmdRep;

static inline Tcl_Obj *
NewNsObj(
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;

    if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
	return Tcl_NewStringObj("::", 2);
    }
    return Tcl_NewStringObj(nsPtr->fullName, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNamespaceEnsembleCmd --
 *
 *	Invoked to implement the "namespace ensemble" command that creates and
 *	manipulates ensembles built on top of namespaces. Handles the
 *	following syntax:
 *
 *	    namespace ensemble name ?dictionary?
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	Creates the ensemble for the namespace if one did not previously
 *	exist. Alternatively, alters the way that the ensemble's subcommand =>
 *	implementation prefix is configured.
 *
 *----------------------------------------------------------------------
 */

int
TclNamespaceEnsembleCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Namespace *namespacePtr;
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
	    *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
    Tcl_Command token;
    Tcl_DictSearch search;
    Tcl_Obj *listObj;
    const char *simpleName;
    int index, done;

    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "tried to manipulate ensemble of deleted namespace",
		    -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
	}
	return TCL_ERROR;
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], ensembleSubcommands,
	    "subcommand", 0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum EnsSubcmds) index) {
    case ENS_CREATE: {
	const char *name;
	int len, allocatedMapFlag = 0;
	/*
	 * Defaults
	 */
	Tcl_Obj *subcmdObj = NULL;
	Tcl_Obj *mapObj = NULL;
	int permitPrefix = 1;
	Tcl_Obj *unknownObj = NULL;
	Tcl_Obj *paramObj = NULL;

	/*
	 * Check that we've got option-value pairs... [Bug 1558654]
	 */

	if (objc & 1) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?option value ...?");
	    return TCL_ERROR;
	}
	objv += 2;
	objc -= 2;

	name = nsPtr->name;
	cxtPtr = (Namespace *) nsPtr->parentPtr;

	/*
	 * Parse the option list, applying type checks as we go. Note that we
	 * are not incrementing any reference counts in the objects at this
	 * stage, so the presence of an option multiple times won't cause any
	 * memory leaks.
	 */

	for (; objc>1 ; objc-=2,objv+=2) {
	    if (Tcl_GetIndexFromObj(interp, objv[0], ensembleCreateOptions,
		    "option", 0, &index) != TCL_OK) {
		if (allocatedMapFlag) {
		    Tcl_DecrRefCount(mapObj);
		}
		return TCL_ERROR;
	    }
	    switch ((enum EnsCreateOpts) index) {
	    case CRT_CMD:
		name = TclGetString(objv[1]);
		cxtPtr = nsPtr;
		continue;
	    case CRT_SUBCMDS:
		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		subcmdObj = (len > 0 ? objv[1] : NULL);
		continue;
	    case CRT_PARAM:
		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		paramObj = (len > 0 ? objv[1] : NULL);
		continue;
	    case CRT_MAP: {
		Tcl_Obj *patchedDict = NULL, *subcmdWordsObj;

		/*
		 * Verify that the map is sensible.
		 */

		if (Tcl_DictObjFirst(interp, objv[1], &search,
			&subcmdWordsObj, &listObj, &done) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		if (done) {
		    mapObj = NULL;
		    continue;
		}
		do {
		    Tcl_Obj **listv;
		    const char *cmd;

		    if (TclListObjGetElements(interp, listObj, &len,
			    &listv) != TCL_OK) {
			Tcl_DictObjDone(&search);
			if (patchedDict) {
			    Tcl_DecrRefCount(patchedDict);
			}
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    if (len < 1) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"ensemble subcommand implementations "
				"must be non-empty lists", -1));
			Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				"EMPTY_TARGET", NULL);
			Tcl_DictObjDone(&search);
			if (patchedDict) {
			    Tcl_DecrRefCount(patchedDict);
			}
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    cmd = TclGetString(listv[0]);
		    if (!(cmd[0] == ':' && cmd[1] == ':')) {
			Tcl_Obj *newList = Tcl_NewListObj(len, listv);
			Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace *) nsPtr);

			if (nsPtr->parentPtr) {
			    Tcl_AppendStringsToObj(newCmd, "::", NULL);
			}
			Tcl_AppendObjToObj(newCmd, listv[0]);
			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
			if (patchedDict == NULL) {
			    patchedDict = Tcl_DuplicateObj(objv[1]);
			}
			Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				newList);
		    }
		    Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
			    &done);
		} while (!done);

		if (allocatedMapFlag) {
		    Tcl_DecrRefCount(mapObj);
		}
		mapObj = (patchedDict ? patchedDict : objv[1]);
		if (patchedDict) {
		    allocatedMapFlag = 1;
		}
		continue;
	    }
	    case CRT_PREFIX:
		if (Tcl_GetBooleanFromObj(interp, objv[1],
			&permitPrefix) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		continue;
	    case CRT_UNKNOWN:
		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		unknownObj = (len > 0 ? objv[1] : NULL);
		continue;
	    }
	}

	TclGetNamespaceForQualName(interp, name, cxtPtr,
		TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr,
		&actualCxtPtr, &simpleName);

	/*
	 * Create the ensemble. Note that this might delete another ensemble
	 * linked to the same namespace, so we must be careful. However, we
	 * should be OK because we only link the namespace into the list once
	 * we've created it (and after any deletions have occurred.)
	 */

	token = TclCreateEnsembleInNs(interp, simpleName,
		(Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
		(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
	Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
	Tcl_SetEnsembleMappingDict(interp, token, mapObj);
	Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
	Tcl_SetEnsembleParameterList(interp, token, paramObj);

	/*
	 * Tricky! Must ensure that the result is not shared (command delete
	 * traces could have corrupted the pristine object that we started
	 * with). [Snit test rename-1.5]
	 */

	Tcl_ResetResult(interp);
	Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp));
	return TCL_OK;
    }

    case ENS_EXISTS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "cmdname");
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		Tcl_FindEnsemble(interp, objv[2], 0) != NULL));
	return TCL_OK;

    case ENS_CONFIG:
	if (objc < 3 || (objc != 4 && !(objc & 1))) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "cmdname ?-option value ...? ?arg ...?");
	    return TCL_ERROR;
	}
	token = Tcl_FindEnsemble(interp, objv[2], TCL_LEAVE_ERR_MSG);
	if (token == NULL) {
	    return TCL_ERROR;
	}

	if (objc == 4) {
	    Tcl_Obj *resultObj = NULL;		/* silence gcc 4 warning */

	    if (Tcl_GetIndexFromObj(interp, objv[3], ensembleConfigOptions,
		    "option", 0, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum EnsConfigOpts) index) {
	    case CONF_SUBCMDS:
		Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    case CONF_PARAM:
		Tcl_GetEnsembleParameterList(NULL, token, &resultObj);
		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    case CONF_MAP:
		Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    case CONF_NAMESPACE:
		namespacePtr = NULL;		/* silence gcc 4 warning */
		Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
		Tcl_SetObjResult(interp, NewNsObj(namespacePtr));
		break;
	    case CONF_PREFIX: {
		int flags = 0;			/* silence gcc 4 warning */

		Tcl_GetEnsembleFlags(NULL, token, &flags);
		Tcl_SetObjResult(interp,
			Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
		break;
	    }
	    case CONF_UNKNOWN:
		Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj);
		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    }
	} else if (objc == 3) {
	    /*
	     * Produce list of all information.
	     */

	    Tcl_Obj *resultObj, *tmpObj = NULL;	/* silence gcc 4 warning */
	    int flags = 0;			/* silence gcc 4 warning */

	    TclNewObj(resultObj);

	    /* -map option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_MAP], -1));
	    Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    /* -namespace option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_NAMESPACE],
			    -1));
	    namespacePtr = NULL;		/* silence gcc 4 warning */
	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
	    Tcl_ListObjAppendElement(NULL, resultObj, NewNsObj(namespacePtr));

	    /* -parameters option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PARAM], -1));
	    Tcl_GetEnsembleParameterList(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    /* -prefix option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_PREFIX], -1));
	    Tcl_GetEnsembleFlags(NULL, token, &flags);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));

	    /* -subcommands option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_SUBCMDS],-1));
	    Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    /* -unknown option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(ensembleConfigOptions[CONF_UNKNOWN],-1));
	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    Tcl_SetObjResult(interp, resultObj);
	} else {
	    int len, allocatedMapFlag = 0;
	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL, *paramObj = NULL,
		    *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
	    int permitPrefix, flags = 0;	/* silence gcc 4 warning */

	    Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
	    Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
	    Tcl_GetEnsembleParameterList(NULL, token, &paramObj);
	    Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
	    Tcl_GetEnsembleFlags(NULL, token, &flags);
	    permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;

	    objv += 3;
	    objc -= 3;

	    /*
	     * Parse the option list, applying type checks as we go. Note that
	     * we are not incrementing any reference counts in the objects at
	     * this stage, so the presence of an option multiple times won't
	     * cause any memory leaks.
	     */

	    for (; objc>0 ; objc-=2,objv+=2) {
		if (Tcl_GetIndexFromObj(interp, objv[0],ensembleConfigOptions,
			"option", 0, &index) != TCL_OK) {
		freeMapAndError:
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		switch ((enum EnsConfigOpts) index) {
		case CONF_SUBCMDS:
		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
			goto freeMapAndError;
		    }
		    subcmdObj = (len > 0 ? objv[1] : NULL);
		    continue;
		case CONF_PARAM:
		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
			goto freeMapAndError;
		    }
		    paramObj = (len > 0 ? objv[1] : NULL);
		    continue;
		case CONF_MAP: {
		    Tcl_Obj *patchedDict = NULL, *subcmdWordsObj, **listv;
		    const char *cmd;

		    /*
		     * Verify that the map is sensible.
		     */

		    if (Tcl_DictObjFirst(interp, objv[1], &search,
			    &subcmdWordsObj, &listObj, &done) != TCL_OK) {
			goto freeMapAndError;
		    }
		    if (done) {
			mapObj = NULL;
			continue;
		    }
		    do {
			if (TclListObjGetElements(interp, listObj, &len,
				&listv) != TCL_OK) {
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			if (len < 1) {
			    Tcl_SetObjResult(interp, Tcl_NewStringObj(
				    "ensemble subcommand implementations "
				    "must be non-empty lists", -1));
			    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
				    "EMPTY_TARGET", NULL);
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    goto freeMapAndError;
			}
			cmd = TclGetString(listv[0]);
			if (!(cmd[0] == ':' && cmd[1] == ':')) {
			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);

			    if (nsPtr->parentPtr) {
				Tcl_AppendStringsToObj(newCmd, "::", NULL);
			    }
			    Tcl_AppendObjToObj(newCmd, listv[0]);
			    Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
				    &newCmd);
			    if (patchedDict == NULL) {
				patchedDict = Tcl_DuplicateObj(objv[1]);
			    }
			    Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
				    newList);
			}
			Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
				&done);
		    } while (!done);
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    mapObj = (patchedDict ? patchedDict : objv[1]);
		    if (patchedDict) {
			allocatedMapFlag = 1;
		    }
		    continue;
		}
		case CONF_NAMESPACE:
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "option -namespace is read-only", -1));
		    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "READ_ONLY",
			    NULL);
		    goto freeMapAndError;
		case CONF_PREFIX:
		    if (Tcl_GetBooleanFromObj(interp, objv[1],
			    &permitPrefix) != TCL_OK) {
			goto freeMapAndError;
		    }
		    continue;
		case CONF_UNKNOWN:
		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
			goto freeMapAndError;
		    }
		    unknownObj = (len > 0 ? objv[1] : NULL);
		    continue;
		}
	    }

	    /*
	     * Update the namespace now that we've finished the parsing stage.
	     */

	    flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX
		    : flags&~TCL_ENSEMBLE_PREFIX);
	    Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
	    Tcl_SetEnsembleMappingDict(interp, token, mapObj);
	    Tcl_SetEnsembleParameterList(interp, token, paramObj);
	    Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
	    Tcl_SetEnsembleFlags(interp, token, flags);
	}
	return TCL_OK;

    default:
	Tcl_Panic("unexpected ensemble command");
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateEnsembleInNs --
 *
 *	Like Tcl_CreateEnsemble, but additionally accepts as an argument the
 *	name of the namespace to create the command in.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclCreateEnsembleInNs(
    Tcl_Interp *interp,
    const char *name,		/* Simple name of command to create (no
				 * namespace components). */
    Tcl_Namespace *nameNsPtr,	/* Name of namespace to create the command
				 * in. */
    Tcl_Namespace *ensembleNsPtr,
				/* Name of the namespace for the ensemble. */
    int flags)
{
    Namespace *nsPtr = (Namespace *) ensembleNsPtr;
    EnsembleConfig *ensemblePtr;
    Tcl_Command token;

    ensemblePtr = (EnsembleConfig *)Tcl_Alloc(sizeof(EnsembleConfig));
    token = TclNRCreateCommandInNs(interp, name,
	    (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
    if (token == NULL) {
	Tcl_Free(ensemblePtr);
	return NULL;
    }

    ensemblePtr->nsPtr = nsPtr;
    ensemblePtr->epoch = 0;
    Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
    ensemblePtr->subcommandArrayPtr = NULL;
    ensemblePtr->subcmdList = NULL;
    ensemblePtr->subcommandDict = NULL;
    ensemblePtr->flags = flags;
    ensemblePtr->numParameters = 0;
    ensemblePtr->parameterList = NULL;
    ensemblePtr->unknownHandler = NULL;
    ensemblePtr->token = token;
    ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    nsPtr->exportLookupEpoch++;

    if (flags & ENSEMBLE_COMPILE) {
	((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
    }

    return ensemblePtr->token;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateEnsemble
 *
 *	Create a simple ensemble attached to the given namespace. Deprecated
 *	(internally) by TclCreateEnsembleInNs.
 *
 * Value
 *
 *	The token for the command created.
 *
 * Effect
 *	The ensemble is created and marked for compilation.
 *
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_CreateEnsemble(
    Tcl_Interp *interp,
    const char *name,
    Tcl_Namespace *namespacePtr,
    int flags)
{
    Namespace *nsPtr = (Namespace *) namespacePtr, *foundNsPtr, *altNsPtr,
	    *actualNsPtr;
    const char * simpleName;

    if (nsPtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
	    &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
    return TclCreateEnsembleInNs(interp, simpleName,
	    (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleSubcommandList --
 *
 *	Set the subcommand list for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an ensemble
 *	or the subcommand list - if non-NULL - is not a list).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleSubcommandList(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *subcmdList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	int length;

	if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    subcmdList = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->subcmdList;
    ensemblePtr->subcmdList = subcmdList;
    if (subcmdList != NULL) {
	Tcl_IncrRefCount(subcmdList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
    }

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    /*
     * Special hack to make compiling of [info exists] work when the
     * dictionary is modified.
     */

    if (cmdPtr->compileProc != NULL) {
	((Interp *) interp)->compileEpoch++;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleParameterList --
 *
 *	Set the parameter list for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an ensemble
 *	or the parameter list - if non-NULL - is not a list).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleParameterList(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *paramList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;
    int length;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (paramList == NULL) {
	length = 0;
    } else {
	if (TclListObjLength(interp, paramList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    paramList = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->parameterList;
    ensemblePtr->parameterList = paramList;
    if (paramList != NULL) {
	Tcl_IncrRefCount(paramList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
    }
    ensemblePtr->numParameters = length;

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    /*
     * Special hack to make compiling of [info exists] work when the
     * dictionary is modified.
     */

    if (cmdPtr->compileProc != NULL) {
	((Interp *) interp)->compileEpoch++;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleMappingDict --
 *
 *	Set the mapping dictionary for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an ensemble
 *	or the mapping - if non-NULL - is not a dict).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleMappingDict(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *mapDict)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldDict;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	int size, done;
	Tcl_DictSearch search;
	Tcl_Obj *valuePtr;

	if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
	    return TCL_ERROR;
	}

	for (Tcl_DictObjFirst(NULL, mapDict, &search, NULL, &valuePtr, &done);
		!done; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {
	    Tcl_Obj *cmdObjPtr;
	    const char *bytes;

	    if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdObjPtr) != TCL_OK) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	    bytes = TclGetString(cmdObjPtr);
	    if (bytes[0] != ':' || bytes[1] != ':') {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"ensemble target is not a fully-qualified command",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE",
			"UNQUALIFIED_TARGET", NULL);
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}

	if (size < 1) {
	    mapDict = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldDict = ensemblePtr->subcommandDict;
    ensemblePtr->subcommandDict = mapDict;
    if (mapDict != NULL) {
	Tcl_IncrRefCount(mapDict);
    }
    if (oldDict != NULL) {
	TclDecrRefCount(oldDict);
    }

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    /*
     * Special hack to make compiling of [info exists] work when the
     * dictionary is modified.
     */

    if (cmdPtr->compileProc != NULL) {
	((Interp *) interp)->compileEpoch++;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleUnknownHandler --
 *
 *	Set the unknown handler for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an ensemble
 *	or the unknown handler - if non-NULL - is not a list).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleUnknownHandler(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *unknownList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	int length;

	if (TclListObjLength(interp, unknownList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    unknownList = NULL;
	}
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    oldList = ensemblePtr->unknownHandler;
    ensemblePtr->unknownHandler = unknownList;
    if (unknownList != NULL) {
	Tcl_IncrRefCount(unknownList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
    }

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleFlags --
 *
 *	Set the flags for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleFlags(
    Tcl_Interp *interp,
    Tcl_Command token,
    int flags)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    int wasCompiled;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"command is not an ensemble", -1));
	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;

    /*
     * This API refuses to set the ENSEMBLE_DEAD flag...
     */

    ensemblePtr->flags &= ENSEMBLE_DEAD;
    ensemblePtr->flags |= flags & ~ENSEMBLE_DEAD;

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    /*
     * If the ENSEMBLE_COMPILE flag status was changed, install or remove the
     * compiler function and bump the interpreter's compilation epoch so that
     * bytecode gets regenerated.
     */

    if (flags & ENSEMBLE_COMPILE) {
	if (!wasCompiled) {
	    ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble;
	    ((Interp *) interp)->compileEpoch++;
	}
    } else {
	if (wasCompiled) {
	    ((Command *) ensemblePtr->token)->compileProc = NULL;
	    ((Interp *) interp)->compileEpoch++;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleSubcommandList --
 *
 *	Get the list of subcommands associated with a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The list of subcommands is returned by updating the
 *	variable pointed to by the last parameter (NULL if this is to be
 *	derived from the mapping dictionary or the associated namespace's
 *	exported commands).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleSubcommandList(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **subcmdListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *subcmdListPtr = ensemblePtr->subcmdList;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleParameterList --
 *
 *	Get the list of parameters associated with a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The list of parameters is returned by updating the
 *	variable pointed to by the last parameter (NULL if there are
 *	no parameters).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleParameterList(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **paramListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *paramListPtr = ensemblePtr->parameterList;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleMappingDict --
 *
 *	Get the command mapping dictionary associated with a particular
 *	ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The mapping dict is returned by updating the variable
 *	pointed to by the last parameter (NULL if none is installed).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleMappingDict(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **mapDictPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *mapDictPtr = ensemblePtr->subcommandDict;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleUnknownHandler --
 *
 *	Get the unknown handler associated with a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The unknown handler is returned by updating the variable
 *	pointed to by the last parameter (NULL if no handler is installed).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleUnknownHandler(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **unknownListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *unknownListPtr = ensemblePtr->unknownHandler;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleFlags --
 *
 *	Get the flags for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The flags are returned by updating the variable pointed to
 *	by the last parameter.
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleFlags(
    Tcl_Interp *interp,
    Tcl_Command token,
    int *flagsPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *flagsPtr = ensemblePtr->flags;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleNamespace --
 *
 *	Get the namespace associated with a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). Namespace is returned by updating the variable pointed to
 *	by the last parameter.
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleNamespace(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Namespace **namespacePtrPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command is not an ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = (EnsembleConfig *)cmdPtr->objClientData;
    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindEnsemble --
 *
 *	Given a command name, get the ensemble token for it, allowing for
 *	[namespace import]s. [Bug 1017022]
 *
 * Results:
 *	The token for the ensemble command with the given name, or NULL if the
 *	command either does not exist or is not an ensemble (when an error
 *	message will be written into the interp if thats non-NULL).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_FindEnsemble(
    Tcl_Interp *interp,		/* Where to do the lookup, and where to write
				 * the errors if TCL_LEAVE_ERR_MSG is set in
				 * the flags. */
    Tcl_Obj *cmdNameObj,	/* Name of command to look up. */
    int flags)			/* Either 0 or TCL_LEAVE_ERR_MSG; other flags
				 * are probably not useful. */
{
    Command *cmdPtr;

    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
    if (cmdPtr == NULL) {
	return NULL;
    }

    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
	/*
	 * Reuse existing infrastructure for following import link chains
	 * rather than duplicating it.
	 */

	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);

	if (cmdPtr == NULL
		|| cmdPtr->objProc != TclEnsembleImplementationCmd) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"\"%s\" is not an ensemble command",
			TclGetString(cmdNameObj)));
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), NULL);
	    }
	    return NULL;
	}
    }

    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsEnsemble --
 *
 *	Simple test for ensemble-hood that takes into account imported
 *	ensemble commands as well.
 *
 * Results:
 *	Boolean value
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_IsEnsemble(
    Tcl_Command token)
{
    Command *cmdPtr = (Command *) token;

    if (cmdPtr->objProc == TclEnsembleImplementationCmd) {
	return 1;
    }
    cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
    if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) {
	return 0;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMakeEnsemble --
 *
 *	Create an ensemble from a table of implementation commands. The
 *	ensemble will be subject to (limited) compilation if any of the
 *	implementation commands are compilable.
 *
 *	The 'name' parameter may be a single command name or a list if
 *	creating an ensemble subcommand (see the binary implementation).
 *
 *	Currently, the TCL_ENSEMBLE_PREFIX ensemble flag is only used on
 *	top-level ensemble commands.
 *
 * Results:
 *	Handle for the new ensemble, or NULL on failure.
 *
 * Side effects:
 *	May advance the bytecode compilation epoch.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclMakeEnsemble(
    Tcl_Interp *interp,
    const char *name,		 /* The ensemble name (as explained above) */
    const EnsembleImplMap map[]) /* The subcommands to create */
{
    Tcl_Command ensemble;
    Tcl_Namespace *ns;
    Tcl_DString buf, hiddenBuf;
    const char **nameParts = NULL;
    const char *cmdName = NULL;
    int i, nameCount = 0, ensembleFlags = 0, hiddenLen;

    /*
     * Construct the path for the ensemble namespace and create it.
     */

    Tcl_DStringInit(&buf);
    Tcl_DStringInit(&hiddenBuf);
    TclDStringAppendLiteral(&hiddenBuf, "tcl:");
    Tcl_DStringAppend(&hiddenBuf, name, -1);
    TclDStringAppendLiteral(&hiddenBuf, ":");
    hiddenLen = Tcl_DStringLength(&hiddenBuf);
    if (name[0] == ':' && name[1] == ':') {
	/*
	 * An absolute name, so use it directly.
	 */

	cmdName = name;
	Tcl_DStringAppend(&buf, name, -1);
	ensembleFlags = TCL_ENSEMBLE_PREFIX;
    } else {
	/*
	 * Not an absolute name, so do munging of it. Note that this treats a
	 * multi-word list differently to a single word.
	 */

	TclDStringAppendLiteral(&buf, "::tcl");

	if (Tcl_SplitList(NULL, name, &nameCount, &nameParts) != TCL_OK) {
	    Tcl_Panic("invalid ensemble name '%s'", name);
	}

	for (i = 0; i < nameCount; ++i) {
	    TclDStringAppendLiteral(&buf, "::");
	    Tcl_DStringAppend(&buf, nameParts[i], -1);
	}
    }

    ns = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
	    TCL_CREATE_NS_IF_UNKNOWN);
    if (!ns) {
	Tcl_Panic("unable to find or create %s namespace!",
		Tcl_DStringValue(&buf));
    }

    /*
     * Create the named ensemble in the correct namespace
     */

    if (cmdName == NULL) {
	if (nameCount == 1) {
	    ensembleFlags = TCL_ENSEMBLE_PREFIX;
	    cmdName = Tcl_DStringValue(&buf) + 5;
	} else {
	    ns = ns->parentPtr;
	    cmdName = nameParts[nameCount - 1];
	}
    }

    /*
     * Switch on compilation always for core ensembles now that we can do
     * nice bytecode things with them.  Do it now.  Waiting until later will
     * just cause pointless epoch bumps.
     */

    ensembleFlags |= ENSEMBLE_COMPILE;
    ensemble = Tcl_CreateEnsemble(interp, cmdName, ns, ensembleFlags);

    /*
     * Create the ensemble mapping dictionary and the ensemble command procs.
     */

    if (ensemble != NULL) {
	Tcl_Obj *mapDict, *fromObj, *toObj;
	Command *cmdPtr;

	TclDStringAppendLiteral(&buf, "::");
	TclNewObj(mapDict);
	for (i=0 ; map[i].name != NULL ; i++) {
	    fromObj = Tcl_NewStringObj(map[i].name, -1);
	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
		    Tcl_DStringLength(&buf));
	    Tcl_AppendToObj(toObj, map[i].name, -1);
	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);

	    if (map[i].proc || map[i].nreProc) {
		/*
		 * If the command is unsafe, hide it when we're in a safe
		 * interpreter. The code to do this is really hokey! It also
		 * doesn't work properly yet; this function is always
		 * currently called before the safe-interp flag is set so the
		 * Tcl_IsSafe check fails.
		 */

		if (map[i].unsafe && Tcl_IsSafe(interp)) {
		    cmdPtr = (Command *)
			    Tcl_NRCreateCommand(interp, "___tmp", map[i].proc,
			    map[i].nreProc, map[i].clientData, NULL);
		    Tcl_DStringSetLength(&hiddenBuf, hiddenLen);
		    if (Tcl_HideCommand(interp, "___tmp",
			    Tcl_DStringAppend(&hiddenBuf, map[i].name, -1))) {
			Tcl_Panic("%s", Tcl_GetStringResult(interp));
		    }
		} else {
		    /*
		     * Not hidden, so just create it. Yay!
		     */

		    cmdPtr = (Command *)
			    Tcl_NRCreateCommand(interp, TclGetString(toObj),
			    map[i].proc, map[i].nreProc, map[i].clientData,
			    NULL);
		}
		cmdPtr->compileProc = map[i].compileProc;
	    }
	}
	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
    }

    Tcl_DStringFree(&buf);
    Tcl_DStringFree(&hiddenBuf);
    if (nameParts != NULL) {
	Tcl_Free((void *)nameParts);
    }
    return ensemble;
}

/*
 *----------------------------------------------------------------------
 *
 * TclEnsembleImplementationCmd --
 *
 *	Implements an ensemble of commands (being those exported by a
 *	namespace other than the global namespace) as a command with the same
 *	(short) name as the namespace in the parent namespace.
 *
 * Results:
 *	A standard Tcl result code. Will be TCL_ERROR if the command is not an
 *	unambiguous prefix of any command exported by the ensemble's
 *	namespace.
 *
 * Side effects:
 *	Depends on the command within the namespace that gets executed. If the
 *	ensemble itself returns TCL_ERROR, a descriptive error message will be
 *	placed in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */

int
TclEnsembleImplementationCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    return Tcl_NRCallObjProc(interp, NsEnsembleImplementationCmdNR,
	    clientData, objc, objv);
}

static int
NsEnsembleImplementationCmdNR(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData;
				/* The ensemble itself. */
    Tcl_Obj *prefixObj;		/* An object containing the prefix words of
				 * the command that implements the
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    int reparseCount = 0;	/* Number of reparses. */
    Tcl_Obj *errorObj;		/* Used for building error messages. */
    Tcl_Obj *subObj;
    size_t subIdx;

    /*
     * Must recheck objc, since numParameters might have changed. Cf. test
     * namespace-53.9.
     */

  restartEnsembleParse:
    subIdx = 1 + ensemblePtr->numParameters;
    if ((size_t)objc < subIdx + 1) {
	/*
	 * We don't have a subcommand argument. Make error message.
	 */

	Tcl_DString buf;	/* Message being built */

	Tcl_DStringInit(&buf);
	if (ensemblePtr->parameterList) {
	    Tcl_DStringAppend(&buf,
		    TclGetString(ensemblePtr->parameterList), -1);
	    TclDStringAppendLiteral(&buf, " ");
	}
	TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, Tcl_DStringValue(&buf));
	Tcl_DStringFree(&buf);

	return TCL_ERROR;
    }

    if (ensemblePtr->nsPtr->flags & NS_DYING) {
	/*
	 * Don't know how we got here, but make things give up quickly.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "ensemble activated for deleted namespace", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "DEAD", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Determine if the table of subcommands is right. If so, we can just look
     * up in there and go straight to dispatch.
     */

    subObj = objv[subIdx];

    if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
	/*
	 * Table of subcommands is still valid; therefore there might be a
	 * valid cache of discovered information which we can reuse. Do the
	 * check here, and if we're still valid, we can jump straight to the
	 * part where we do the invocation of the subcommand.
	 */
	EnsembleCmdRep *ensembleCmd;

	ECRGetIntRep(subObj, ensembleCmd);
	if (ensembleCmd) {
	    if (ensembleCmd->epoch == ensemblePtr->epoch &&
		    ensembleCmd->token == (Command *)ensemblePtr->token) {
		prefixObj = (Tcl_Obj *)Tcl_GetHashValue(ensembleCmd->hPtr);
		Tcl_IncrRefCount(prefixObj);
		if (ensembleCmd->fix) {
		    TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
		}
		goto runResultingSubcommand;
	    }
	}
    } else {
	BuildEnsembleConfig(ensemblePtr);
	ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch;
    }

    /*
     * Look in the hashtable for the subcommand name; this is the fastest way
     * of all if there is no cache in operation.
     */

    hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
	    TclGetString(subObj));
    if (hPtr != NULL) {

	/*
	 * Cache for later in the subcommand object.
	 */

	MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL);
    } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
	/*
	 * Could not map, no prefixing, go to unknown/error handling.
	 */

	goto unknownOrAmbiguousSubcommand;
    } else {
	/*
	 * If we've not already confirmed the command with the hash as part of
	 * building our export table, we need to scan the sorted array for
	 * matches.
	 */

	const char *subcmdName; /* Name of the subcommand, or unique prefix of
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	size_t stringLength, i;
	size_t tableLength = ensemblePtr->subcommandTable.numEntries;
	Tcl_Obj *fix;

	subcmdName = TclGetStringFromObj(subObj, &stringLength);
	for (i=0 ; i<tableLength ; i++) {
	    int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two
		     * exported subcommands, which is an error case.
		     */

		    goto unknownOrAmbiguousSubcommand;
		}
		fullName = ensemblePtr->subcommandArrayPtr[i];
	    } else if (cmp < 0) {
		/*
		 * Because we are searching a sorted table, we can now stop
		 * searching because we have gone past anything that could
		 * possibly match.
		 */

		break;
	    }
	}
	if (fullName == NULL) {
	    /*
	     * The subcommand is not a prefix of anything, so bail out!
	     */

	    goto unknownOrAmbiguousSubcommand;
	}
	hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName);
	if (hPtr == NULL) {
	    Tcl_Panic("full name %s not found in supposedly synchronized hash",
		    fullName);
	}

	/*
	 * Record the spelling correction for usage message.
	 */

	fix = Tcl_NewStringObj(fullName, -1);

	/*
	 * Cache for later in the subcommand object.
	 */

	MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix);
	TclSpellFix(interp, objv, objc, subIdx, subObj, fix);
    }

    prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
    Tcl_IncrRefCount(prefixObj);
  runResultingSubcommand:

    /*
     * Do the real work of execution of the subcommand by building an array of
     * objects (note that this is potentially not the same length as the
     * number of arguments to this ensemble command), populating it and then
     * feeding it back through the main command-lookup engine. In theory, we
     * could look up the command in the namespace ourselves, as we already
     * have the namespace in which it is guaranteed to exist,
     *
     *   ((Q: That's not true if the -map option is used, is it?))
     *
     * but we don't do that (the cacheing of the command object used should
     * help with that.)
     */

    {
	Tcl_Obj *copyPtr;	/* The actual list of words to dispatch to.
				 * Will be freed by the dispatch engine. */
	Tcl_Obj **copyObjv;
	int copyObjc, prefixObjc;

	Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);

	if (objc == 2) {
	    copyPtr = TclListObjCopy(NULL, prefixObj);
	} else {
	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    ensemblePtr->numParameters, objv + 1);
	    Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
		    objc - 2 - ensemblePtr->numParameters,
		    objv + 2 + ensemblePtr->numParameters);
	}
	Tcl_IncrRefCount(copyPtr);
	TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL);
	TclDecrRefCount(prefixObj);

	/*
	 * 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 (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters,
		prefixObjc + ensemblePtr->numParameters, objv)) {
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
		    NULL);
	}

	/*
	 * Hand off to the target command.
	 */

	TclSkipTailcall(interp);
	Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
	((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr;
	return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
    }

  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
     * particular ensemble invocation.
     */

    if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
	switch (EnsembleUnknownCallback(interp, ensemblePtr, objc, objv,
		&prefixObj)) {
	case TCL_OK:
	    goto runResultingSubcommand;
	case TCL_ERROR:
	    return TCL_ERROR;
	case TCL_CONTINUE:
	    goto restartEnsembleParse;
	}
    }

    /*
     * We cannot determine what subcommand to hand off to, so generate a
     * (standard) failure message. Note the one odd case compared with
     * standard ensemble-like command, which is where a namespace has no
     * exported commands at all...
     */

    Tcl_ResetResult(interp);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
	    TclGetString(subObj), NULL);
    if (ensemblePtr->subcommandTable.numEntries == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown subcommand \"%s\": namespace %s does not"
		" export any commands", TclGetString(subObj),
		ensemblePtr->nsPtr->fullName));
	return TCL_ERROR;
    }
    errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
	    TclGetString(subObj));
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
    } else {
	size_t i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[i], -1);
	    Tcl_AppendToObj(errorObj, ", ", 2);
	}
	Tcl_AppendPrintfToObj(errorObj, "or %s",
		ensemblePtr->subcommandArrayPtr[i]);
    }
    Tcl_SetObjResult(interp, errorObj);
    return TCL_ERROR;
}

int
TclClearRootEnsemble(
    TCL_UNUSED(ClientData *),
    Tcl_Interp *interp,
    int result)
{
    TclResetRewriteEnsemble(interp, 1);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitRewriteEnsemble --
 *
 *	Applies a rewrite of arguments so that an ensemble subcommand will
 *	report error messages correctly for the overall command.
 *
 * Results:
 *	Whether this is the first rewrite applied, a value which must be
 *	passed to TclResetRewriteEnsemble when undoing this command's
 *	behaviour.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclInitRewriteEnsemble(
    Tcl_Interp *interp,
    size_t numRemoved,
    size_t numInserted,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;

    int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = numRemoved;
	iPtr->ensembleRewrite.numInsertedObjs = numInserted;
    } else {
	size_t numIns = iPtr->ensembleRewrite.numInsertedObjs;

	if (numIns < numRemoved) {
	    iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
	    iPtr->ensembleRewrite.numInsertedObjs = numInserted;
	} else {
	    iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
	}
    }
    return isRootEnsemble;
}

/*
 *----------------------------------------------------------------------
 *
 * TclResetRewriteEnsemble --
 *
 *	Removes any rewrites applied to support proper reporting of error
 *	messages used in ensembles. Should be paired with
 *	TclInitRewriteEnsemble.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclResetRewriteEnsemble(
    Tcl_Interp *interp,
    int isRootEnsemble)
{
    Interp *iPtr = (Interp *) interp;

    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = NULL;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclSpellFix --
 *
 *	Record a spelling correction that needs making in the generation of
 *	the WrongNumArgs usage message.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Can create an alternative ensemble rewrite structure.
 *
 *----------------------------------------------------------------------
 */

static int
FreeER(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    Tcl_Obj **tmp = (Tcl_Obj **) data[0];
    Tcl_Obj **store = (Tcl_Obj **) data[1];

    Tcl_Free(store);
    Tcl_Free(tmp);
    return result;
}

void
TclSpellFix(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    size_t badIdx,
    Tcl_Obj *bad,
    Tcl_Obj *fix)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *const *search;
    Tcl_Obj **store;
    size_t idx;
    size_t size;

    if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }

    /*
     * Compute the valid length of the ensemble root.
     */

    size = iPtr->ensembleRewrite.numRemovedObjs + objc
	    - iPtr->ensembleRewrite.numInsertedObjs;

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	/*
	 * Awful casting abuse here!
	 */

	search = (Tcl_Obj *const *) search[1];
    }

    if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
	/*
	 * Misspelled value was inserted. We cannot directly jump to the bad
	 * value, but have to search.
	 */

	idx = 1;
	while (idx < size) {
	    if (search[idx] == bad) {
		break;
	    }
	    idx++;
	}
	if (idx == size) {
	    return;
	}
    } else {
	/*
	 * Jump to the misspelled value.
	 */

	idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx
		- iPtr->ensembleRewrite.numInsertedObjs;

	/* Verify */
	if (search[idx] != bad) {
	    Tcl_Panic("SpellFix: programming error");
	}
    }

    search = iPtr->ensembleRewrite.sourceObjs;
    if (search[0] == NULL) {
	store = (Tcl_Obj **) search[2];
    }  else {
	Tcl_Obj **tmp = (Tcl_Obj **)Tcl_Alloc(3 * sizeof(Tcl_Obj *));

	store = (Tcl_Obj **)Tcl_Alloc(size * sizeof(Tcl_Obj *));
	memcpy(store, iPtr->ensembleRewrite.sourceObjs,
		size * sizeof(Tcl_Obj *));

	/*
	 * Awful casting abuse here! Note that the NULL in the first element
	 * indicates that the initial objects are a raw array in the second
	 * element and the rewritten ones are a raw array in the third.
	 */

	tmp[0] = NULL;
	tmp[1] = (Tcl_Obj *) iPtr->ensembleRewrite.sourceObjs;
	tmp[2] = (Tcl_Obj *) store;
	iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;

	TclNRAddCallback(interp, FreeER, tmp, store, NULL, NULL);
    }

    store[idx] = fix;
    Tcl_IncrRefCount(fix);
    TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFetchEnsembleRoot --
 *
 *	Returns the root of ensemble rewriting, if any.
 *	If no root exists, returns objv instead.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *const *
TclFetchEnsembleRoot(
    Tcl_Interp *interp,
    Tcl_Obj *const *objv,
    int objc,
    int *objcPtr)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->ensembleRewrite.sourceObjs) {
	*objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
		- iPtr->ensembleRewrite.numInsertedObjs;
	return iPtr->ensembleRewrite.sourceObjs;
    }
    *objcPtr = objc;
    return objv;
}

/*
 * ----------------------------------------------------------------------
 *
 * EnsmebleUnknownCallback --
 *
 *	Helper for the ensemble engine that handles the procesing of unknown
 *	callbacks. See the user documentation of the ensemble unknown handler
 *	for details; this function is only ever called when such a function is
 *	defined, and is only ever called once per ensemble dispatch (i.e. if a
 *	reparse still fails, this isn't called again).
 *
 * Results:
 *	TCL_OK -	*prefixObjPtr contains the command words to dispatch
 *			to.
 *	TCL_CONTINUE -	Need to reparse (*prefixObjPtr is invalid).
 *	TCL_ERROR -	Something went wrong! Error message in interpreter.
 *
 * Side effects:
 *	Calls the Tcl interpreter, so arbitrary.
 *
 * ----------------------------------------------------------------------
 */

static inline int
EnsembleUnknownCallback(
    Tcl_Interp *interp,
    EnsembleConfig *ensemblePtr,
    int objc,
    Tcl_Obj *const objv[],
    Tcl_Obj **prefixObjPtr)
{
    int paramc, i, result, prefixObjc;
    Tcl_Obj **paramv, *unknownCmd, *ensObj;

    /*
     * Create the unknown command callback to determine what to do.
     */

    unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
    TclNewObj(ensObj);
    Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
    Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
    for (i=1 ; i<objc ; i++) {
	Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
    }
    TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
    Tcl_IncrRefCount(unknownCmd);

    /*
     * Now call the unknown handler. (We don't bother NRE-enabling this; deep
     * recursing through unknown handlers is horribly perverse.) Note that it
     * is always an error for an unknown handler to delete its ensemble; don't
     * do that!
     */

    Tcl_Preserve(ensemblePtr);
    TclSkipTailcall(interp);
    result = Tcl_EvalObjv(interp, paramc, paramv, 0);
    if ((result == TCL_OK) && (ensemblePtr->flags & ENSEMBLE_DEAD)) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unknown subcommand handler deleted its ensemble", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_DELETED",
		    NULL);
	}
	result = TCL_ERROR;
    }
    Tcl_Release(ensemblePtr);

    /*
     * If we succeeded, we should either have a list of words that form the
     * command to be executed, or an empty list. In the empty-list case, the
     * ensemble is believed to be updated so we should ask the ensemble engine
     * to reparse the original command.
     */

    if (result == TCL_OK) {
	*prefixObjPtr = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(*prefixObjPtr);
	TclDecrRefCount(unknownCmd);
	Tcl_ResetResult(interp);

	/*
	 * Namespace is still there. Check if the result is a valid list. If
	 * it is, and it is non-empty, that list is what we are using as our
	 * replacement.
	 */

	if (TclListObjLength(interp, *prefixObjPtr, &prefixObjc) != TCL_OK) {
	    TclDecrRefCount(*prefixObjPtr);
	    Tcl_AddErrorInfo(interp, "\n    while parsing result of "
		    "ensemble unknown subcommand handler");
	    return TCL_ERROR;
	}
	if (prefixObjc > 0) {
	    return TCL_OK;
	}

	/*
	 * Namespace alive & empty result => reparse.
	 */

	TclDecrRefCount(*prefixObjPtr);
	return TCL_CONTINUE;
    }

    /*
     * Oh no! An exceptional result. Convert to an error.
     */

    if (!Tcl_InterpDeleted(interp)) {
	if (result != TCL_ERROR) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unknown subcommand handler returned bad code: ", -1));
	    switch (result) {
	    case TCL_RETURN:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "return", -1);
		break;
	    case TCL_BREAK:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "break", -1);
		break;
	    case TCL_CONTINUE:
		Tcl_AppendToObj(Tcl_GetObjResult(interp), "continue", -1);
		break;
	    default:
		Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp), "%d", result);
	    }
	    Tcl_AddErrorInfo(interp, "\n    result of "
		    "ensemble unknown subcommand handler: ");
	    Tcl_AppendObjToErrorInfo(interp, unknownCmd);
	    Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT",
		    NULL);
	} else {
	    Tcl_AddErrorInfo(interp,
		    "\n    (ensemble unknown subcommand handler)");
	}
    }
    TclDecrRefCount(unknownCmd);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * MakeCachedEnsembleCommand --
 *
 *	Cache what we've computed so far; it's not nice to repeatedly copy
 *	strings about. Note that to do this, we start by deleting any old
 *	representation that there was (though if it was an out of date
 *	ensemble rep, we can skip some of the deallocation process.)
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Alters the internal representation of the first object parameter.
 *
 *----------------------------------------------------------------------
 */

static void
MakeCachedEnsembleCommand(
    Tcl_Obj *objPtr,
    EnsembleConfig *ensemblePtr,
    Tcl_HashEntry *hPtr,
    Tcl_Obj *fix)
{
    EnsembleCmdRep *ensembleCmd;

    ECRGetIntRep(objPtr, ensembleCmd);
    if (ensembleCmd) {
	TclCleanupCommandMacro(ensembleCmd->token);
	if (ensembleCmd->fix) {
	    Tcl_DecrRefCount(ensembleCmd->fix);
	}
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
	 */

	ensembleCmd = (EnsembleCmdRep *)Tcl_Alloc(sizeof(EnsembleCmdRep));
	ECRSetIntRep(objPtr, ensembleCmd);
    }

    /*
     * Populate the internal rep.
     */

    ensembleCmd->epoch = ensemblePtr->epoch;
    ensembleCmd->token = (Command *) ensemblePtr->token;
    ensembleCmd->token->refCount++;
    if (fix) {
	Tcl_IncrRefCount(fix);
    }
    ensembleCmd->fix = fix;
    ensembleCmd->hPtr = hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteEnsembleConfig --
 *
 *	Destroys the data structure used to represent an ensemble. This is
 *	called when the ensemble's command is deleted (which happens
 *	automatically if the ensemble's namespace is deleted.) Maintainers
 *	should note that ensembles should be deleted by deleting their
 *	commands.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is (eventually) deallocated.
 *
 *----------------------------------------------------------------------
 */

static void
ClearTable(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;

    if (hash->numEntries != 0) {
        Tcl_HashSearch search;
        Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);

        while (hPtr != NULL) {
            Tcl_Obj *prefixObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
            Tcl_DecrRefCount(prefixObj);
            hPtr = Tcl_NextHashEntry(&search);
        }
        Tcl_Free(ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)
{
    EnsembleConfig *ensemblePtr = (EnsembleConfig *)clientData;
    Namespace *nsPtr = ensemblePtr->nsPtr;

    /*
     * Unlink from the ensemble chain if it has not been marked as having been
     * done already.
     */

    if (ensemblePtr->next != ensemblePtr) {
	EnsembleConfig *ensPtr = (EnsembleConfig *) nsPtr->ensembles;

	if (ensPtr == ensemblePtr) {
	    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
	} else {
	    while (ensPtr != NULL) {
		if (ensPtr->next == ensemblePtr) {
		    ensPtr->next = ensemblePtr->next;
		    break;
		}
		ensPtr = ensPtr->next;
	    }
	}
    }

    /*
     * Mark the namespace as dead so code that uses Tcl_Preserve() can tell
     * whether disaster happened anyway.
     */

    ensemblePtr->flags |= ENSEMBLE_DEAD;

    /*
     * Kill the pointer-containing fields.
     */

    ClearTable(ensemblePtr);
    if (ensemblePtr->subcmdList != NULL) {
	Tcl_DecrRefCount(ensemblePtr->subcmdList);
    }
    if (ensemblePtr->parameterList != NULL) {
	Tcl_DecrRefCount(ensemblePtr->parameterList);
    }
    if (ensemblePtr->subcommandDict != NULL) {
	Tcl_DecrRefCount(ensemblePtr->subcommandDict);
    }
    if (ensemblePtr->unknownHandler != NULL) {
	Tcl_DecrRefCount(ensemblePtr->unknownHandler);
    }

    /*
     * Arrange for the structure to be reclaimed. Note that this is complex
     * because we have to make sure that we can react sensibly when an
     * ensemble is deleted during the process of initialising the ensemble
     * (especially the unknown callback.)
     */

    Tcl_EventuallyFree(ensemblePtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * BuildEnsembleConfig --
 *
 *	Create the internal data structures that describe how an ensemble
 *	looks, being a hash mapping from the full command name to the Tcl list
 *	that describes the implementation prefix words, and a sorted array of
 *	all the full command names to allow for reasonably efficient
 *	unambiguous prefix handling.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Reallocates and rebuilds the hash table and array stored at the
 *	ensemblePtr argument. For large ensembles or large namespaces, this is
 *	a potentially expensive operation.
 *
 *----------------------------------------------------------------------
 */

static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the set of commands in
				 * the namespace that backs up this
				 * ensemble. */
    size_t i, j;
    int isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
    Tcl_Obj *subList = ensemblePtr->subcmdList;

    ClearTable(ensemblePtr);
    Tcl_InitHashTable(hash, TCL_STRING_KEYS);

    if (subList) {
        int subc;
        Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
        const char *name;

        /*
         * There is a list of exactly what subcommands go in the table.
         * Must determine the target for each.
         */

        Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
        if (subList == mapDict) {
            /*
             * Strange case where explicit list of subcommands is same value
             * as the dict mapping to targets.
             */

            for (i = 0; i < (size_t)subc; i += 2) {
                name = TclGetString(subv[i]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (!isNew) {
                    cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
                    Tcl_DecrRefCount(cmdObj);
                }
                Tcl_SetHashValue(hPtr, subv[i+1]);
                Tcl_IncrRefCount(subv[i+1]);

                name = TclGetString(subv[i+1]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (isNew) {
                    cmdObj = Tcl_NewStringObj(name, -1);
                    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
                    Tcl_SetHashValue(hPtr, cmdPrefixObj);
                    Tcl_IncrRefCount(cmdPrefixObj);
                }
            }
        } else {
            /*
	     * Usual case where we can freely act on the list and dict.
	     */

            for (i = 0; i < (size_t)subc; i++) {
                name = TclGetString(subv[i]);
                hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
                if (!isNew) {
                    continue;
                }

                /*
		 * Lookup target in the dictionary.
		 */

                if (mapDict) {
                    Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
                    if (target) {
                        Tcl_SetHashValue(hPtr, target);
                        Tcl_IncrRefCount(target);
                        continue;
                    }
                }

                /*
                 * target was not in the dictionary so map onto the namespace.
                 * Note in this case that we do not guarantee that the command
                 * is actually there; that is the programmer's responsibility
                 * (or [::unknown] of course).
                 */

                cmdObj = Tcl_NewStringObj(name, -1);
                cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
                Tcl_SetHashValue(hPtr, cmdPrefixObj);
                Tcl_IncrRefCount(cmdPrefixObj);
            }
        }
    } else if (mapDict) {
        /*
         * No subcmd list, but we do have a mapping dictionary so we should
         * use the keys of that. Convert the dictionary's contents into the
         * form required for the ensemble's internal hashtable.
         */

        Tcl_DictSearch dictSearch;
        Tcl_Obj *keyObj, *valueObj;
        int done;

        Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
                &keyObj, &valueObj, &done);
        while (!done) {
            const char *name = TclGetString(keyObj);

            hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
            Tcl_SetHashValue(hPtr, valueObj);
            Tcl_IncrRefCount(valueObj);
            Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
        }
    } else {
	/*
	 * Discover what commands are actually exported by the namespace.
	 * What we have is an array of patterns and a hash table whose keys
	 * are the command names exported by the namespace (the contents do
	 * not matter here.) We must find out what commands are actually
	 * exported by filtering each command in the namespace against each of
	 * the patterns in the export list. Note that we use an intermediate
	 * hash table to make memory management easier, and because that makes
	 * exact matching far easier too.
	 *
	 * Suggestion for future enhancement: compute the unique prefixes and
	 * place them in the hash too, which should make for even faster
	 * matching.
	 */

	hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
	for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
	    char *nsCmdName =		/* Name of command in namespace. */
		    (char *)Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);

	    for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
		if (Tcl_StringMatch(nsCmdName,
			ensemblePtr->nsPtr->exportArrayPtr[i])) {
		    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);

		    /*
		     * Remember, hash entries have a full reference to the
		     * substituted part of the command (as a list) as their
		     * content!
		     */

		    if (isNew) {
			Tcl_Obj *cmdObj, *cmdPrefixObj;

			TclNewObj(cmdObj);
			Tcl_AppendStringsToObj(cmdObj,
				ensemblePtr->nsPtr->fullName,
				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
				nsCmdName, NULL);
			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
			Tcl_SetHashValue(hPtr, cmdPrefixObj);
			Tcl_IncrRefCount(cmdPrefixObj);
		    }
		    break;
		}
	    }
	}
    }

    if (hash->numEntries == 0) {
	ensemblePtr->subcommandArrayPtr = NULL;
	return;
    }

    /*
     * Create a sorted array of all subcommands in the ensemble; hash tables
     * are all very well for a quick look for an exact match, but they can't
     * determine things like whether a string is a prefix of another (not
     * without lots of preparation anyway) and they're no good for when we're
     * generating the error message either.
     *
     * We do this by filling an array with the names (we use the hash keys
     * directly to save a copy, since any time we change the array we change
     * the hash too, and vice versa) and running quicksort over the array.
     */

    ensemblePtr->subcommandArrayPtr =
	    (char **)Tcl_Alloc(sizeof(char *) * hash->numEntries);

    /*
     * Fill array from both ends as this makes us less likely to end up with
     * performance problems in qsort(), which is good. Note that doing this
     * makes this code much more opaque, but the naive alternatve:
     *
     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
     *	       hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) {
     *     ensemblePtr->subcommandArrayPtr[i] = Tcl_GetHashKey(hash, &hPtr);
     * }
     *
     * can produce long runs of precisely ordered table entries when the
     * commands in the namespace are declared in a sorted fashion (an ordering
     * some people like) and the hashing functions (or the command names
     * themselves) are fairly unfortunate. By filling from both ends, it
     * requires active malice (and probably a debugger) to get qsort() to have
     * awful runtime behaviour.
     */

    i = 0;
    j = hash->numEntries;
    hPtr = Tcl_FirstHashEntry(hash, &search);
    while (hPtr != NULL) {
	ensemblePtr->subcommandArrayPtr[i++] = (char *)Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = (char *)Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NsEnsembleStringOrder --
 *
 *	Helper function to compare two pointers to two strings for use with
 *	qsort().
 *
 * Results:
 *	-1 if the first string is smaller, 1 if the second string is smaller,
 *	and 0 if they are equal.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NsEnsembleStringOrder(
    const void *strPtr1,
    const void *strPtr2)
{
    return strcmp(*(const char **)strPtr1, *(const char **)strPtr2);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeEnsembleCmdRep --
 *
 *	Destroys the internal representation of a Tcl_Obj that has been
 *	holding information about a command in an ensemble.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is deallocated. If this held the last reference to a
 *	namespace's main structure, that main structure will also be
 *	destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
FreeEnsembleCmdRep(
    Tcl_Obj *objPtr)
{
    EnsembleCmdRep *ensembleCmd;

    ECRGetIntRep(objPtr, ensembleCmd);
    TclCleanupCommandMacro(ensembleCmd->token);
    if (ensembleCmd->fix) {
	Tcl_DecrRefCount(ensembleCmd->fix);
    }
    Tcl_Free(ensembleCmd);
}

/*
 *----------------------------------------------------------------------
 *
 * DupEnsembleCmdRep --
 *
 *	Makes one Tcl_Obj into a copy of another that is a subcommand of an
 *	ensemble.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is allocated, and the namespace that the ensemble is built on
 *	top of gains another reference.
 *
 *----------------------------------------------------------------------
 */

static void
DupEnsembleCmdRep(
    Tcl_Obj *objPtr,
    Tcl_Obj *copyPtr)
{
    EnsembleCmdRep *ensembleCmd;
    EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)Tcl_Alloc(sizeof(EnsembleCmdRep));

    ECRGetIntRep(objPtr, ensembleCmd);
    ECRSetIntRep(copyPtr, ensembleCopy);

    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->token->refCount++;
    ensembleCopy->fix = ensembleCmd->fix;
    if (ensembleCopy->fix) {
	Tcl_IncrRefCount(ensembleCopy->fix);
    }
    ensembleCopy->hPtr = ensembleCmd->hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileEnsemble --
 *
 *	Procedure called to compile an ensemble command. Note that most
 *	ensembles are not compiled, since modifying a compiled ensemble causes
 *	a invalidation of all existing bytecode (expensive!) which is not
 *	normally warranted.
 *
 * Results:
 *	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
 *	evaluation to runtime.
 *
 * Side effects:
 *	Instructions are added to envPtr to execute the subcommands of the
 *	ensemble at runtime if a compile-time mapping is possible.
 *
 *----------------------------------------------------------------------
 */

int
TclCompileEnsemble(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
    Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems;
    Tcl_Obj *replaced, *replacement;
    Tcl_Command ensemble = (Tcl_Command) cmdPtr;
    Command *oldCmdPtr = cmdPtr, *newCmdPtr;
    int len, result, flags = 0, i, depth = 1, invokeAnyway = 0;
    int ourResult = TCL_ERROR;
    size_t numBytes;
    const char *word;

    TclNewObj(replaced);
    Tcl_IncrRefCount(replaced);
    if (parsePtr->numWords < depth + 1) {
	goto failed;
    }
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	/*
	 * Too hard.
	 */

	goto failed;
    }

    /*
     * This is where we return to if we are parsing multiple nested compiled
     * ensembles. [info object] is such a beast.
     */

  checkNextWord:
    word = tokenPtr[1].start;
    numBytes = tokenPtr[1].size;

    /*
     * There's a sporting chance we'll be able to compile this. But now we
     * must check properly. To do that, check that we're compiling an ensemble
     * that has a compilable command as its appropriate subcommand.
     */

    if (Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj) != TCL_OK
	    || mapObj == NULL) {
	/*
	 * Either not an ensemble or a mapping isn't installed. Crud. Too hard
	 * to proceed.
	 */

	goto failed;
    }

    /*
     * Also refuse to compile anything that uses a formal parameter list for
     * now, on the grounds that it is too complex.
     */

    if (Tcl_GetEnsembleParameterList(NULL, ensemble, &listObj) != TCL_OK
	    || listObj != NULL) {
	/*
	 * Figuring out how to compile this has become too much. Bail out.
	 */

	goto failed;
    }

    /*
     * Next, get the flags. We need them on several code paths so that we can
     * know whether we're to do prefix matching.
     */

    (void) Tcl_GetEnsembleFlags(NULL, ensemble, &flags);

    /*
     * Check to see if there's also a subcommand list; must check to see if
     * the subcommand we are calling is in that list if it exists, since that
     * list filters the entries in the map.
     */

    (void) Tcl_GetEnsembleSubcommandList(NULL, ensemble, &listObj);
    if (listObj != NULL) {
	size_t sclen;
	const char *str;
	Tcl_Obj *matchObj = NULL;

	if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) {
	    goto failed;
	}
	for (i=0 ; i<len ; i++) {
	    str = TclGetStringFromObj(elems[i], &sclen);
	    if ((sclen == numBytes) && !memcmp(word, str, numBytes)) {
		/*
		 * Exact match! Excellent!
		 */

		result = Tcl_DictObjGet(NULL, mapObj,elems[i], &targetCmdObj);
		if (result != TCL_OK || targetCmdObj == NULL) {
		    goto failed;
		}
		replacement = elems[i];
		goto doneMapLookup;
	    }

	    /*
	     * Check to see if we've got a prefix match. A single prefix match
	     * is fine, and allows us to refine our dictionary lookup, but
	     * multiple prefix matches is a Bad Thing and will prevent us from
	     * making progress. Note that we cannot do the lookup immediately
	     * in the prefix case; might be another entry later in the list
	     * that causes things to fail.
	     */

	    if ((flags & TCL_ENSEMBLE_PREFIX)
		    && strncmp(word, str, numBytes) == 0) {
		if (matchObj != NULL) {
		    goto failed;
		}
		matchObj = elems[i];
	    }
	}
	if (matchObj == NULL) {
	    goto failed;
	}
	result = Tcl_DictObjGet(NULL, mapObj, matchObj, &targetCmdObj);
	if (result != TCL_OK || targetCmdObj == NULL) {
	    goto failed;
	}
	replacement = matchObj;
    } else {
	Tcl_DictSearch s;
	int done, matched;
	Tcl_Obj *tmpObj;

	/*
	 * No map, so check the dictionary directly.
	 */

	TclNewStringObj(subcmdObj, word, numBytes);
	result = Tcl_DictObjGet(NULL, mapObj, subcmdObj, &targetCmdObj);
	if (result == TCL_OK && targetCmdObj != NULL) {
	    /*
	     * Got it. Skip the fiddling around with prefixes.
	     */

	    replacement = subcmdObj;
	    goto doneMapLookup;
	}
	TclDecrRefCount(subcmdObj);

	/*
	 * We've not literally got a valid subcommand. But maybe we have a
	 * prefix. Check if prefix matches are allowed.
	 */

	if (!(flags & TCL_ENSEMBLE_PREFIX)) {
	    goto failed;
	}

	/*
	 * Iterate over the keys in the dictionary, checking to see if we're a
	 * prefix.
	 */

	Tcl_DictObjFirst(NULL, mapObj, &s, &subcmdObj, &tmpObj, &done);
	matched = 0;
	replacement = NULL;		/* Silence, fool compiler! */
	while (!done) {
	    if (strncmp(TclGetString(subcmdObj), word, numBytes) == 0) {
		if (matched++) {
		    /*
		     * Must have matched twice! Not unique, so no point
		     * looking further.
		     */

		    break;
		}
		replacement = subcmdObj;
		targetCmdObj = tmpObj;
	    }
	    Tcl_DictObjNext(&s, &subcmdObj, &tmpObj, &done);
	}
	Tcl_DictObjDone(&s);

	/*
	 * If we have anything other than a single match, we've failed the
	 * unique prefix check.
	 */

	if (matched != 1) {
	    invokeAnyway = 1;
	    goto failed;
	}
    }

    /*
     * OK, we definitely map to something. But what?
     *
     * The command we map to is the first word out of the map element. Note
     * that we also reject dealing with multi-element rewrites if we are in a
     * safe interpreter, as there is otherwise a (highly gnarly!) way to make
     * Tcl crash open to exploit.
     */

  doneMapLookup:
    Tcl_ListObjAppendElement(NULL, replaced, replacement);
    if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) {
	goto failed;
    } else if (len != 1) {
	/*
	 * Note that at this point we know we can't issue any special
	 * instruction sequence as the mapping isn't one that we support at
	 * the compiled level.
	 */

	goto cleanup;
    }
    targetCmdObj = elems[0];

    oldCmdPtr = cmdPtr;
    Tcl_IncrRefCount(targetCmdObj);
    newCmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
    TclDecrRefCount(targetCmdObj);
    if (newCmdPtr == NULL || Tcl_IsSafe(interp)
	    || newCmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
	    || newCmdPtr->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.
	 */

	goto cleanup;
    }
    cmdPtr = newCmdPtr;
    depth++;

    /*
     * See whether we have a nested ensemble. If we do, we can go round the
     * mulberry bush again, consuming the next word.
     */

    if (cmdPtr->compileProc == TclCompileEnsemble) {
	tokenPtr = TokenAfter(tokenPtr);
	if (parsePtr->numWords < depth + 1
		|| tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	    /*
	     * Too hard because the user has done something unpleasant like
	     * omitting the sub-ensemble's command name or used a non-constant
	     * name for a sub-ensemble's command name; we respond by bailing
	     * out completely (this is a rare case). [Bug 6d2f249a01]
	     */

	    goto cleanup;
	}
	ensemble = (Tcl_Command) cmdPtr;
	goto checkNextWord;
    }

    /*
     * Now that the mapping process is done we actually try to compile.
     * If there is a subcommand compiler and that successfully produces code,
     * we'll use that. Otherwise, we fall back to generating opcodes to do the
     * invoke at runtime.
     */

    invokeAnyway = 1;
    if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, depth, cmdPtr,
	    envPtr)) {
	ourResult = TCL_OK;
	goto cleanup;
    }

    /*
     * Throw out any line information generated by the failed compile attempt.
     */

    while (mapPtr->nuloc - 1 > eclIndex) {
        mapPtr->nuloc--;
        Tcl_Free(mapPtr->loc[mapPtr->nuloc].line);
        mapPtr->loc[mapPtr->nuloc].line = NULL;
    }

    /*
     * Reset the index of next command.  Toss out any from failed nested
     * partial compiles.
     */

    envPtr->numCommands = mapPtr->nuloc;

    /*
     * Failed to do a full compile for some reason. Try to do a direct invoke
     * instead of going through the ensemble lookup process again.
     */

  failed:
    if (depth < 250) {
	if (depth > 1) {
	    if (!invokeAnyway) {
		cmdPtr = oldCmdPtr;
		depth--;
	    }
	}
	/*
	 * The length of the "replaced" list must be depth-1.  Trim back
	 * any extra elements that might have been appended by failing
	 * pathways above.
	 */
	(void) Tcl_ListObjReplace(NULL, replaced, depth-1, LIST_MAX, 0, NULL);

	/*
	 * TODO: Reconsider whether we ought to call CompileToInvokedCommand()
	 * when depth==1.  In that case we are choosing to emit the
	 * INST_INVOKE_REPLACE bytecode when there is in fact no replacing
	 * to be done.  It would be equally functional and presumably more
	 * performant to fall through to cleanup below, return TCL_ERROR,
	 * and let the compiler harness emit the INST_INVOKE_STK
	 * implementation for us.
	 */

	CompileToInvokedCommand(interp, parsePtr, replaced, cmdPtr, envPtr);
	ourResult = TCL_OK;
    }

    /*
     * Release the memory we allocated. If we've got here, we've either done
     * something useful or we're in a case that we can't compile at all and
     * we're just giving up.
     */

  cleanup:
    Tcl_DecrRefCount(replaced);
    return ourResult;
}

int
TclAttemptCompileProc(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    int depth,
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    int result, i;
    Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
    int savedStackDepth = envPtr->currStackDepth;
    unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
    int savedAuxDataArrayNext = envPtr->auxDataArrayNext;
    int savedExceptArrayNext = envPtr->exceptArrayNext;
#ifdef TCL_COMPILE_DEBUG
    int savedExceptDepth = envPtr->exceptDepth;
#endif

    if (cmdPtr->compileProc == NULL) {
	return TCL_ERROR;
    }

    /*
     * Advance parsePtr->tokenPtr so that it points at the last subcommand.
     * This will be wrong but it will not matter, and it will put the
     * tokens for the arguments in the right place without the need to
     * allocate a synthetic Tcl_Parse struct or copy tokens around.
     */

    for (i = 0; i < depth - 1; i++) {
	parsePtr->tokenPtr = TokenAfter(parsePtr->tokenPtr);
    }
    parsePtr->numWords -= (depth - 1);

    /*
     * Shift the line information arrays to account for different word
     * index values.
     */

    mapPtr->loc[eclIndex].line += (depth - 1);
    mapPtr->loc[eclIndex].next += (depth - 1);

    /*
     * Hand off compilation to the subcommand compiler. At last!
     */

    result = cmdPtr->compileProc(interp, parsePtr, cmdPtr, envPtr);

    /*
     * Undo the shift.
     */

    mapPtr->loc[eclIndex].line -= (depth - 1);
    mapPtr->loc[eclIndex].next -= (depth - 1);

    parsePtr->numWords += (depth - 1);
    parsePtr->tokenPtr = saveTokenPtr;

    /*
     * If our target failed to compile, revert any data from failed partial
     * compiles.  Note that envPtr->numCommands need not be checked because
     * we avoid compiling subcommands that recursively call TclCompileScript().
     */

#ifdef TCL_COMPILE_DEBUG
    if (envPtr->exceptDepth != savedExceptDepth) {
	Tcl_Panic("ExceptionRange Starts and Ends do not balance");
    }
#endif

    if (result != TCL_OK) {
	ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;

	for (i = 0; i < savedExceptArrayNext; i++) {
	    while (auxPtr->numBreakTargets > 0
		    && auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
		    >= savedCodeNext) {
		auxPtr->numBreakTargets--;
	    }
	    while (auxPtr->numContinueTargets > 0
		    && auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
		    >= savedCodeNext) {
		auxPtr->numContinueTargets--;
	    }
	    auxPtr++;
	}
	envPtr->exceptArrayNext = savedExceptArrayNext;

	if (savedAuxDataArrayNext != envPtr->auxDataArrayNext) {
	    AuxData *auxDataPtr = envPtr->auxDataArrayPtr;
	    AuxData *auxDataEnd = auxDataPtr;

	    auxDataPtr += savedAuxDataArrayNext;
	    auxDataEnd += envPtr->auxDataArrayNext;

	    while (auxDataPtr < auxDataEnd) {
		if (auxDataPtr->type->freeProc != NULL) {
		    auxDataPtr->type->freeProc(auxDataPtr->clientData);
		}
		auxDataPtr++;
	    }
	    envPtr->auxDataArrayNext = savedAuxDataArrayNext;
	}
	envPtr->currStackDepth = savedStackDepth;
	envPtr->codeNext = envPtr->codeStart + savedCodeNext;
#ifdef TCL_COMPILE_DEBUG
    } else {
	/*
	 * Confirm that the command compiler generated a single value on
	 * the stack as its result. This is only done in debugging mode,
	 * as it *should* be correct and normal users have no reasonable
	 * way to fix it anyway.
	 */

	int diff = envPtr->currStackDepth - savedStackDepth;

	if (diff != 1) {
	    Tcl_Panic("bad stack adjustment when compiling"
		    " %.*s (was %d instead of 1)", (int)parsePtr->tokenPtr->size,
		    parsePtr->tokenPtr->start, diff);
	}
#endif
    }

    return result;
}

/*
 * How to compile a subcommand to a _replacing_ invoke of its implementation
 * command.
 */

static void
CompileToInvokedCommand(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Tcl_Obj *replacements,
    Command *cmdPtr,
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;
    Tcl_Token *tokPtr;
    Tcl_Obj *objPtr, **words;
    const char *bytes;
    int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
    size_t length;

    /*
     * Push the words of the command. Take care; the command words may be
     * scripts that have backslashes in them, and [info frame 0] can see the
     * difference. Hence the call to TclContinuationsEnterDerived...
     */

    Tcl_ListObjGetElements(NULL, replacements, &numWords, &words);
    for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
	    i++, tokPtr = TokenAfter(tokPtr)) {
	if (i > 0 && i < numWords+1) {
	    bytes = TclGetStringFromObj(words[i-1], &length);
	    PushLiteral(envPtr, bytes, length);
	    continue;
	}

	SetLineInformation(i);
	if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	    int literal = TclRegisterLiteral(envPtr,
		    tokPtr[1].start, tokPtr[1].size, 0);

	    if (envPtr->clNext) {
		TclContinuationsEnterDerived(
			TclFetchLiteral(envPtr, literal),
			tokPtr[1].start - envPtr->source,
			envPtr->clNext);
	    }
	    TclEmitPush(literal, envPtr);
	} else {
	    CompileTokens(envPtr, tokPtr, interp);
	}
    }

    /*
     * Push the name of the command we're actually dispatching to as part of
     * the implementation.
     */

    TclNewObj(objPtr);
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    bytes = TclGetStringFromObj(objPtr, &length);
    if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
	extraLiteralFlags |= LITERAL_UNSHARED;
    }
    cmdLit = TclRegisterLiteral(envPtr, bytes, length, extraLiteralFlags);
    TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
    TclEmitPush(cmdLit, envPtr);
    TclDecrRefCount(objPtr);

    /*
     * Do the replacing dispatch.
     */

    TclEmitInvoke(envPtr, INST_INVOKE_REPLACE, parsePtr->numWords,numWords+1);
}

/*
 * Helpers that do issuing of instructions for commands that "don't have
 * compilers" (well, they do; these). They all work by just generating base
 * code to invoke the command; they're intended for ensemble subcommands so
 * that the costs of INST_INVOKE_REPLACE can be avoided where we can work out
 * that they're not needed.
 *
 * Note that these are NOT suitable for commands where there's an argument
 * that is a script, as an [info level] or [info frame] in the inner context
 * can see the difference.
 */

static int
CompileBasicNArgCommand(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
    TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr,
	    parsePtr->numWords, envPtr);
    Tcl_DecrRefCount(objPtr);
    return TCL_OK;
}

int
TclCompileBasic0ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords != 1) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic1ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic2ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic3ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic0Or1ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords != 1 && parsePtr->numWords != 2) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic1Or2ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords != 2 && parsePtr->numWords != 3) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic2Or3ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords != 3 && parsePtr->numWords != 4) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic0To2ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords < 1 || parsePtr->numWords > 3) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasic1To3ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords < 2 || parsePtr->numWords > 4) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasicMin0ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords < 1) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasicMin1ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords < 2) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

int
TclCompileBasicMin2ArgCmd(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
				 * created by Tcl_ParseCommand. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    /*
     * Verify that the number of arguments is correct; that's the only case
     * that we know will avoid the call to Tcl_WrongNumArgs() at invoke time,
     * which is the only code that sees the shenanigans of ensemble dispatch.
     */

    if (parsePtr->numWords < 3) {
	return TCL_ERROR;
    }

    return CompileBasicNArgCommand(interp, parsePtr, cmdPtr, envPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclEnv.c.

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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+



-
+



-
+







-
-







 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */

#if defined(_WIN32)
#  define tenviron _wenviron
#  define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
#  define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
		(const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
#  define techar WCHAR
#  ifdef USE_PUTENV
#    define putenv(env) _wputenv((const wchar_t *)env)
#  endif
#else
#  define tenviron environ
#  define tenviron2utfdstr(tenvstr, len, dstr) \
		Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
#  define utf2tenvirondstr(str, len, dstr) \
		Tcl_UtfToExternalDString(NULL, str, len, dstr)
#  define techar char
#endif

static struct {
    size_t cacheSize;		/* Number of env strings in cache. */
    int cacheSize;		/* Number of env strings in cache. */
    char **cache;		/* Array containing all of the environment
				 * strings that Tcl has allocated. */
#ifndef USE_PUTENV
    techar **ourEnviron;		/* Cache of the array that we allocate. We
    char **ourEnviron;		/* Cache of the array that we allocate. We
				 * need to track this in case another
				 * subsystem swaps around the environ array
				 * like we do. */
    size_t ourEnvironSize;		/* Non-zero means that the environ array was
    int ourEnvironSize;		/* Non-zero means that the environ array was
				 * malloced and has this many total entries
				 * allocated to it (not all may be in use at
				 * once). Zero means that the environment
				 * array is in its original static state. */
#endif
} env;

#define tNTL sizeof(techar)

/*
 * Declarations for local functions defined in this file:
 */

static char *		EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		ReplaceString(const char *oldStr, char *newStr);
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
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







-
-

-
-
+
+
-




-
-
-
+
+
+
-
-
-
-
-
+
+






+
-
+
-
-
+
+

-
-
+
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-
-
-
-
-
+
+







-




-
-
-
-
-
-
+
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 */

void
TclSetupEnv(
    Tcl_Interp *interp)		/* Interpreter whose "env" array is to be
				 * managed. */
{
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varNamePtr;
    Tcl_DString envString;
    Tcl_HashTable namesHash;
    Tcl_HashEntry *hPtr;
    char *p1, *p2;
    int i;
    Tcl_HashSearch search;

    /*
     * Synchronize the values in the environ array with the contents of the
     * Tcl "env" variable. To do this:
     *    1) Remove the trace that fires when the "env" var is updated.
     *    2) Find the existing contents of the "env", storing in a hash table.
     *    3) Create/update elements for each environ variable, removing
     *    1) Remove the trace that fires when the "env" var is unset.
     *    2) Unset the "env" variable.
     *    3) If there are no environ variables, create an empty "env" array.
     *	     elements from the hash table as we go.
     *    4) Remove the elements for each remaining entry in the hash table,
     *	     which must have existed before yet have no analog in the environ
     *	     variable.
     *    5) Add a trace that synchronizes the "env" array.
     *	     Otherwise populate the array with current values.
     *    4) Add a trace that synchronizes the "env" array.
     */

    Tcl_UntraceVar2(interp, "env", NULL,
	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);

    Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
    /*

     * Find out what elements are currently in the global env array.
     */
    if (environ[0] == NULL) {
	Tcl_Obj *varNamePtr;

    TclNewLiteralStringObj(varNamePtr, "env");
    Tcl_IncrRefCount(varNamePtr);
	TclNewLiteralStringObj(varNamePtr, "env");
	Tcl_IncrRefCount(varNamePtr);
    Tcl_InitObjHashTable(&namesHash);
    varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, TCL_GLOBAL_ONLY,
	TclArraySet(interp, varNamePtr, NULL);
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    TclFindArrayPtrElements(varPtr, &namesHash);

	Tcl_DecrRefCount(varNamePtr);
#if defined(_WIN32)
    if (tenviron == NULL) {
	/*
	 * When we are started from main(), the _wenviron array could
	 * be NULL and will be initialized by the first _wgetenv() call.
	 */

    } else {
	(void) _wgetenv(L"WINDIR");
    }
#endif

    /*
     * Go through the environment array and transfer its values into Tcl. At
     * the same time, remove those elements we add/update from the hash table
     * of existing elements, so that after this part processes, that table
     * will hold just the parts to remove.
     */

    if (tenviron[0] != NULL) {
	int i;

	Tcl_MutexLock(&envMutex);
	for (i = 0; tenviron[i] != NULL; i++) {
	for (i = 0; environ[i] != NULL; i++) {
	    Tcl_Obj *obj1, *obj2;
	    const char *p1;
	    char *p2;

	    p1 = tenviron2utfdstr(tenviron[i], -1, &envString);
	    p2 = (char *)strchr(p1, '=');
	    p1 = Tcl_ExternalToUtfDString(NULL, environ[i], -1, &envString);
	    p2 = strchr(p1, '=');
	    if (p2 == NULL) {
		/*
		 * This condition seem to happen occasionally under some
		 * versions of Solaris, or when encoding accidents swallow the
		 * '='; ignore the entry.
		 */

		Tcl_DStringFree(&envString);
		continue;
	    }
	    p2++;
	    p2[-1] = '\0';
#if defined(_WIN32)
	    /*
	     * Enforce PATH and COMSPEC to be all uppercase. This eliminates
	     * additional trace logic otherwise required in init.tcl.
	     */

	    Tcl_SetVar2(interp, "env", p1, p2, TCL_GLOBAL_ONLY);
	    if (strcasecmp(p1, "PATH") == 0) {
		p1 = "PATH";
	    } else if (strcasecmp(p1, "COMSPEC") == 0) {
		p1 = "COMSPEC";
	    }
#endif
	    obj1 = Tcl_NewStringObj(p1, -1);
	    obj2 = Tcl_NewStringObj(p2, -1);
	    Tcl_DStringFree(&envString);

	    Tcl_IncrRefCount(obj1);
	    Tcl_IncrRefCount(obj2);
	    Tcl_ObjSetVar2(interp, varNamePtr, obj1, obj2, TCL_GLOBAL_ONLY);
	    hPtr = Tcl_FindHashEntry(&namesHash, obj1);
	    if (hPtr != NULL) {
		Tcl_DeleteHashEntry(hPtr);
	    }
	    Tcl_DecrRefCount(obj1);
	    Tcl_DecrRefCount(obj2);
	}
	Tcl_MutexUnlock(&envMutex);
    }

    /*
     * Delete those elements that existed in the array but which had no
     * counterparts in the environment array.
     */

    for (hPtr=Tcl_FirstHashEntry(&namesHash, &search); hPtr!=NULL;
	    hPtr=Tcl_NextHashEntry(&search)) {
	Tcl_Obj *elemName = (Tcl_Obj *)Tcl_GetHashValue(hPtr);

	TclObjUnsetVar2(interp, varNamePtr, elemName, TCL_GLOBAL_ONLY);
    }
    Tcl_DeleteHashTable(&namesHash);
    Tcl_DecrRefCount(varNamePtr);

    /*
     * Re-establish the trace.
     */

    Tcl_TraceVar2(interp, "env", NULL,
	    TCL_GLOBAL_ONLY | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	    TCL_TRACE_READS | TCL_TRACE_ARRAY, EnvTraceProc, NULL);
}

/*
 *----------------------------------------------------------------------
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
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







-
-
+

-
+










-
+







-
-
+
+
+

-
+

-
+

-
+



-
+




-
+









-
-
+
+






-
+









-
+
-
-
+

-
-
+
+





-
-
+
+










-
+








-
+







-
+







void
TclSetEnv(
    const char *name,		/* Name of variable whose value is to be set
				 * (UTF-8). */
    const char *value)		/* New value for variable (UTF-8). */
{
    Tcl_DString envString;
    size_t nameLength, valueLength;
    size_t index, length;
    int index, length, nameLength;
    char *p, *oldValue;
    const techar *p2;
    const char *p2;

    /*
     * Figure out where the entry is going to go. If the name doesn't already
     * exist, enlarge the array if necessary to make room. If the name exists,
     * free its old entry.
     */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    if (index == TCL_INDEX_NONE) {
    if (index == -1) {
#ifndef USE_PUTENV
	/*
	 * We need to handle the case where the environment may be changed
	 * outside our control. ourEnvironSize is only valid if the current
	 * environment is the one we allocated. [Bug 979640]
	 */

	if ((env.ourEnviron != tenviron) || (length+2 > env.ourEnvironSize)) {
	    techar **newEnviron = (techar **)Tcl_Alloc((length + 5) * sizeof(techar *));
	if ((env.ourEnviron != environ) || (length+2 > env.ourEnvironSize)) {
	    char **newEnviron = (char **)
		    ckalloc(((unsigned) length + 5) * sizeof(char *));

	    memcpy(newEnviron, tenviron, length * sizeof(techar *));
	    memcpy(newEnviron, environ, length * sizeof(char *));
	    if ((env.ourEnvironSize != 0) && (env.ourEnviron != NULL)) {
		Tcl_Free(env.ourEnviron);
		ckfree((char *) env.ourEnviron);
	    }
	    tenviron = (env.ourEnviron = newEnviron);
	    environ = env.ourEnviron = newEnviron;
	    env.ourEnvironSize = length + 5;
	}
	index = length;
	tenviron[index + 1] = NULL;
	environ[index + 1] = NULL;
#endif /* USE_PUTENV */
	oldValue = NULL;
	nameLength = strlen(name);
    } else {
	const char *oldEnv;
	const char *env;

	/*
	 * Compare the new value to the existing value. If they're the same
	 * then quit immediately (e.g. don't rewrite the value or propagate it
	 * to other interpreters). Otherwise, when there are N interpreters
	 * there will be N! propagations of the same value among the
	 * interpreters.
	 */

	oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString);
	if (strcmp(value, oldEnv + (length + 1)) == 0) {
	env = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envString);
	if (strcmp(value, env + (length + 1)) == 0) {
	    Tcl_DStringFree(&envString);
	    Tcl_MutexUnlock(&envMutex);
	    return;
	}
	Tcl_DStringFree(&envString);

	oldValue = (char *)tenviron[index];
	oldValue = environ[index];
	nameLength = length;
    }

    /*
     * Create a new entry. Build a complete UTF string that contains a
     * "name=value" pattern. Then convert the string to the native encoding,
     * and set the environ array value.
     */

    valueLength = strlen(value);
    p = ckalloc((unsigned) nameLength + strlen(value) + 2);
    p = (char *)Tcl_Alloc(nameLength + valueLength + 2);
    memcpy(p, name, nameLength);
    strcpy(p, name);
    p[nameLength] = '=';
    memcpy(p+nameLength+1, value, valueLength+1);
    p2 = utf2tenvirondstr(p, -1, &envString);
    strcpy(p+nameLength+1, value);
    p2 = Tcl_UtfToExternalDString(NULL, p, -1, &envString);

    /*
     * Copy the native string to heap memory.
     */

    p = (char *)Tcl_Realloc(p, Tcl_DStringLength(&envString) + tNTL);
    memcpy(p, p2, Tcl_DStringLength(&envString) + tNTL);
    p = ckrealloc(p, strlen(p2) + 1);
    strcpy(p, p2);
    Tcl_DStringFree(&envString);

#ifdef USE_PUTENV
    /*
     * Update the system environment.
     */

    putenv(p);
    index = TclpFindVariable(name, &length);
#else
    tenviron[index] = (techar *)p;
    environ[index] = p;
#endif /* USE_PUTENV */

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if ((index != TCL_INDEX_NONE) && (tenviron[index] == (techar *)p)) {
    if ((index != -1) && (environ[index] == p)) {
	ReplaceString(oldValue, p);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	Tcl_Free(p);
	ckfree(p);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }

    Tcl_MutexUnlock(&envMutex);

    if (!strcmp(name, "HOME")) {
	/*
407
408
409
410
411
412
413
414

415
416
417
418
419
420
421
311
312
313
314
315
316
317

318
319
320
321
322
323
324
325







-
+








    /*
     * First convert the native string to UTF. Then separate the string into
     * name and value parts, and call TclSetEnv to do all of the real work.
     */

    name = Tcl_ExternalToUtfDString(NULL, assignment, -1, &nameString);
    value = (char *)strchr(name, '=');
    value = strchr(name, '=');

    if ((value != NULL) && (value != name)) {
	value[0] = '\0';
	TclSetEnv(name, value+1);
    }

    Tcl_DStringFree(&nameString);
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
524

525
526
527
528
529
530
531
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







-
+
+















-
+








-
+












-
-
-
+
+
+



-
-
+
+

-
+

-
-
-
+
+
+
-










-
+







-
+



-
+







 */

void
TclUnsetEnv(
    const char *name)		/* Name of variable to remove (UTF-8). */
{
    char *oldValue;
    size_t length, index;
    int length;
    int index;
#ifdef USE_PUTENV_FOR_UNSET
    Tcl_DString envString;
    char *string;
#else
    char **envPtr;
#endif /* USE_PUTENV_FOR_UNSET */

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);

    /*
     * First make sure that the environment variable exists to avoid doing
     * needless work and to avoid recursion on the unset.
     */

    if (index == TCL_INDEX_NONE) {
    if (index == -1) {
	Tcl_MutexUnlock(&envMutex);
	return;
    }

    /*
     * Remember the old value so we can free it if Tcl created the string.
     */

    oldValue = (char *)tenviron[index];
    oldValue = environ[index];

    /*
     * Update the system environment. This must be done before we update the
     * interpreters or we will recurse.
     */

#ifdef USE_PUTENV_FOR_UNSET
    /*
     * For those platforms that support putenv to unset, Linux indicates
     * that no = should be included, and Windows requires it.
     */

#if defined(_WIN32)
    string = (char *)Tcl_Alloc(length + 2);
    memcpy(string, name, length);
#if defined(__WIN32__)
    string = ckalloc((unsigned) length+2);
    memcpy(string, name, (size_t) length);
    string[length] = '=';
    string[length+1] = '\0';
#else
    string = (char *)Tcl_Alloc(length + 1);
    memcpy(string, name, length);
    string = ckalloc((unsigned) length+1);
    memcpy(string, name, (size_t) length);
    string[length] = '\0';
#endif /* _WIN32 */
#endif /* WIN32 */

    utf2tenvirondstr(string, -1, &envString);
    string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL);
    memcpy(string, Tcl_DStringValue(&envString),
    Tcl_UtfToExternalDString(NULL, string, -1, &envString);
    string = ckrealloc(string, (unsigned) Tcl_DStringLength(&envString)+1);
    strcpy(string, Tcl_DStringValue(&envString));
	    Tcl_DStringLength(&envString) + tNTL);
    Tcl_DStringFree(&envString);

    putenv(string);

    /*
     * Watch out for versions of putenv that copy the string (e.g. VC++). In
     * this case we need to free the string immediately. Otherwise update the
     * string in the cache.
     */

    if (tenviron[index] == (techar *)string) {
    if (environ[index] == string) {
	ReplaceString(oldValue, string);
#ifdef HAVE_PUTENV_THAT_COPIES
    } else {
	/*
	 * This putenv() copies instead of taking ownership.
	 */

	Tcl_Free(string);
	ckfree(string);
#endif /* HAVE_PUTENV_THAT_COPIES */
    }
#else /* !USE_PUTENV_FOR_UNSET */
    for (envPtr = (char **)(tenviron+index+1); ; envPtr++) {
    for (envPtr = environ+index+1; ; envPtr++) {
	envPtr[-1] = *envPtr;
	if (*envPtr == NULL) {
	    break;
	}
    }
    ReplaceString(oldValue, NULL);
#endif /* USE_PUTENV_FOR_UNSET */
557
558
559
560
561
562
563
564

565
566
567
568
569
570

571
572
573

574
575
576
577
578
579
580
461
462
463
464
465
466
467

468
469
470
471
472
473

474
475
476

477
478
479
480
481
482
483
484







-
+





-
+


-
+







TclGetEnv(
    const char *name,		/* Name of environment variable to find
				 * (UTF-8). */
    Tcl_DString *valuePtr)	/* Uninitialized or free DString in which the
				 * value of the environment variable is
				 * stored. */
{
    size_t length, index;
    int length, index;
    const char *result;

    Tcl_MutexLock(&envMutex);
    index = TclpFindVariable(name, &length);
    result = NULL;
    if (index != TCL_INDEX_NONE) {
    if (index != -1) {
	Tcl_DString envStr;

	result = tenviron2utfdstr(tenviron[index], -1, &envStr);
	result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
	result += length;
	if (*result == '=') {
	    result++;
	    Tcl_DStringInit(valuePtr);
	    Tcl_DStringAppend(valuePtr, result, -1);
	    result = Tcl_DStringValue(valuePtr);
	} else {
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
618
619
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







-
+
-









+


-
+







 * EnvTraceProc --
 *
 *	This function is invoked whenever an environment variable is read,
 *	modified or deleted. It propagates the change to the global "environ"
 *	array.
 *
 * Results:
 *	Returns NULL to indicate success, or an error-message if the array
 *	Always returns NULL to indicate success.
 *	element being handled doesn't exist.
 *
 * Side effects:
 *	Environment variable changes get propagated. If the whole "env" array
 *	is deleted, then we stop managing things for this interpreter (usually
 *	this happens because the whole interpreter is being deleted).
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static char *
EnvTraceProc(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter whose "env" variable is being
				 * modified. */
    const char *name1,		/* Better be "env". */
    const char *name2,		/* Name of variable being modified, or NULL if
				 * whole array is being deleted (UTF-8). */
    int flags)			/* Indicates what's happening. */
{
650
651
652
653
654
655
656
657

658
659
660
661
662
663
664
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568







-
+







     */

    if (flags & TCL_TRACE_READS) {
	Tcl_DString valueString;
	const char *value = TclGetEnv(name2, &valueString);

	if (value == NULL) {
	    return (char *) "no such variable";
	    return "no such variable";
	}
	Tcl_SetVar2(interp, name1, name2, value, 0);
	Tcl_DStringFree(&valueString);
    }

    /*
     * For unset traces, let TclUnsetEnv do all the work.
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
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
618
619

620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637

638
639
640


641
642
643
644
645
646
647
648
649







-
+



















-
+

















-
+


-
-
+
+







 */

static void
ReplaceString(
    const char *oldStr,		/* Old environment string. */
    char *newStr)		/* New environment string. */
{
    size_t i;
    int i;

    /*
     * Check to see if the old value was allocated by Tcl. If so, it needs to
     * be deallocated to avoid memory leaks. Note that this algorithm is O(n),
     * not O(1). This will result in n-squared behavior if lots of environment
     * changes are being made.
     */

    for (i = 0; i < env.cacheSize; i++) {
	if (env.cache[i]==oldStr || env.cache[i]==NULL) {
	    break;
	}
    }
    if (i < env.cacheSize) {
	/*
	 * Replace or delete the old value.
	 */

	if (env.cache[i]) {
	    Tcl_Free(env.cache[i]);
	    ckfree(env.cache[i]);
	}

	if (newStr) {
	    env.cache[i] = newStr;
	} else {
	    for (; i < env.cacheSize-1; i++) {
		env.cache[i] = env.cache[i+1];
	    }
	    env.cache[env.cacheSize-1] = NULL;
	}
    } else {
	/*
	 * We need to grow the cache in order to hold the new string.
	 */

	const int growth = 5;

	env.cache = (char **)Tcl_Realloc(env.cache,
	env.cache = (char **) ckrealloc((char *) env.cache,
		(env.cacheSize + growth) * sizeof(char *));
	env.cache[env.cacheSize] = newStr;
	(void) memset(env.cache+env.cacheSize+1, 0,
		(growth-1) * sizeof(char *));
	(void) memset(env.cache+env.cacheSize+1, (int) 0,
		(size_t) (growth-1) * sizeof(char*));
	env.cacheSize += growth;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+
-



-
-
-
-
-
-
-
+



-
-
-
-












TclFinalizeEnvironment(void)
{
    /*
     * For now we just deallocate the cache array and none of the environment
     * strings. This may leak more memory that strictly necessary, since some
     * of the strings may no longer be in the environment. However,
     * determining which ones are ok to delete is n-squared, and is pretty
     * unlikely, so we don't bother.  However, in the case of DPURIFY, just
     * unlikely, so we don't bother.
     * free all strings in the cache.
     */

    if (env.cache) {
#ifdef PURIFY
	size_t i;
	for (i = 0; i < env.cacheSize; i++) {
	    Tcl_Free(env.cache[i]);
	}
#endif
	Tcl_Free(env.cache);
	ckfree((char *) env.cache);
	env.cache = NULL;
	env.cacheSize = 0;
#ifndef USE_PUTENV
	if ((env.ourEnviron != NULL)) {
	    Tcl_Free(env.ourEnviron);
	    env.ourEnviron = NULL;
	}
	env.ourEnvironSize = 0;
#endif
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclEvent.c.

33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
48
49
50
51
52
53


54
55
56
57
58

59
60
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
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







-
+











-
-
+
+




-
+


















-
-
-
+
+
+
+


-
+
-



-
-
-
+
+
+


-
+










-
+


-
+

-
+






-
+

-
-
+
+
-
-
+
-
-




-
+















-
+
+
+
+
+
+
+
+











-
+







-
+


-
+








/*
 * One of the structures below is associated with the "tclBgError" assoc data
 * for each interpreter. It keeps track of the head and tail of the list of
 * pending background errors for the interpreter.
 */

typedef struct {
typedef struct ErrAssocData {
    Tcl_Interp *interp;		/* Interpreter in which error occurred. */
    Tcl_Obj *cmdPrefix;		/* First word(s) of the handler command */
    BgError *firstBgPtr;	/* First in list of all background errors
				 * waiting to be processed for this
				 * interpreter (NULL if none). */
    BgError *lastBgPtr;		/* Last in list of all background errors
				 * waiting to be processed for this
				 * interpreter (NULL if none). */
} ErrAssocData;

/*
 * For each exit handler created with a call to Tcl_Create(Late)ExitHandler
 * there is a structure of the following type:
 * For each exit handler created with a call to Tcl_Create(Late)ExitHandler there is
 * a structure of the following type:
 */

typedef struct ExitHandler {
    Tcl_ExitProc *proc;		/* Function to call when process exits. */
    void *clientData;	/* One word of information to pass to proc. */
    ClientData clientData;	/* One word of information to pass to proc. */
    struct ExitHandler *nextPtr;/* Next in list of all exit handlers for this
				 * application, or NULL for end of list. */
} ExitHandler;

/*
 * There is both per-process and per-thread exit handlers. The first list is
 * controlled by a mutex. The other is in thread local storage.
 */

static ExitHandler *firstExitPtr = NULL;
				/* First in list of all exit handlers for
				 * application. */
static ExitHandler *firstLateExitPtr = NULL;
				/* First in list of all late exit handlers for
				 * application. */
TCL_DECLARE_MUTEX(exitMutex)

/*
 * This variable is set to 1 when Tcl_Exit is called. The variable is checked
 * by TclInExit() to allow different behavior for exit-time processing, e.g.,
 * in closing of files and pipes.
 * This variable is set to 1 when Tcl_Finalize is called, and at the end of
 * its work, it is reset to 0. The variable is checked by TclInExit() to allow
 * different behavior for exit-time processing, e.g. in closing of files and
 * pipes.
 */

static int inExit = 0;
static int inFinalize = 0;

static int subsystemsInitialized = 0;

/*
 * This variable contains the application wide exit handler. It will be called
 * by Tcl_Exit instead of the C-runtime exit if this variable is set to a
 * non-NULL value.
 * This variable contains the application wide exit handler. It will be
 * called by Tcl_Exit instead of the C-runtime exit if this variable is set
 * to a non-NULL value.
 */

static TCL_NORETURN1 Tcl_ExitProc *appExitPtr = NULL;
static Tcl_ExitProc *appExitPtr = NULL;

typedef struct ThreadSpecificData {
    ExitHandler *firstExitPtr;	/* First in list of all exit handlers for this
				 * thread. */
    int inExit;			/* True when this thread is exiting. This is
				 * used as a hack to decide to close the
				 * standard channels. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#if TCL_THREADS
#ifdef TCL_THREADS
typedef struct {
    Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
    void *clientData;	/* The one argument to Main() */
    ClientData clientData;	/* The one argument to Main() */
} ThreadClientData;
static Tcl_ThreadCreateType NewThreadProc(void *clientData);
static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
#endif /* TCL_THREADS */

/*
 * Prototypes for functions referenced only in this file:
 */

static void		BgErrorDeleteProc(void *clientData,
static void		BgErrorDeleteProc(ClientData clientData,
			    Tcl_Interp *interp);
static void		HandleBgErrors(void *clientData);
static char *		VwaitVarProc(void *clientData,
static void		HandleBgErrors(ClientData clientData);
static char *		VwaitVarProc(ClientData clientData, Tcl_Interp *interp,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
			    CONST char *name1, CONST char *name2, int flags);
static void		InvokeExitHandlers(void);
static void		FinalizeThread(int quick);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BackgroundException --
 * Tcl_BackgroundError --
 *
 *	This function is invoked to handle errors that occur in Tcl commands
 *	that are invoked in "background" (e.g. from event or timer bindings).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A handler command is invoked later as an idle handler to process the
 *	error, passing it the interp result and return options.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_BackgroundException(
Tcl_BackgroundError(
    Tcl_Interp *interp)		/* Interpreter in which an error has
				 * occurred. */
{
    TclBackgroundException(interp, TCL_ERROR);
}
void
TclBackgroundException(
    Tcl_Interp *interp,		/* Interpreter in which an exception has
				 * occurred. */
    int code)			/* The exception code value */
{
    BgError *errPtr;
    ErrAssocData *assocPtr;

    if (code == TCL_OK) {
	return;
    }

    errPtr = (BgError*)Tcl_Alloc(sizeof(BgError));
    errPtr = (BgError *) ckalloc(sizeof(BgError));
    errPtr->errorMsg = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(errPtr->errorMsg);
    errPtr->returnOpts = Tcl_GetReturnOptions(interp, code);
    Tcl_IncrRefCount(errPtr->returnOpts);
    errPtr->nextPtr = NULL;

    (void) TclGetBgErrorHandler(interp);
    assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
    assocPtr = (ErrAssocData *) Tcl_GetAssocData(interp, "tclBgError", NULL);
    if (assocPtr->firstBgPtr == NULL) {
	assocPtr->firstBgPtr = errPtr;
	Tcl_DoWhenIdle(HandleBgErrors, assocPtr);
	Tcl_DoWhenIdle(HandleBgErrors, (ClientData) assocPtr);
    } else {
	assocPtr->lastBgPtr->nextPtr = errPtr;
    }
    assocPtr->lastBgPtr = errPtr;
    Tcl_ResetResult(interp);
}

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
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







-
+

-
+










-
-
+
+





-
-
+
+







-
+














-
-
+
+












-
+




-
+







 *	Depends on what actions the handler command takes for the errors.
 *
 *----------------------------------------------------------------------
 */

static void
HandleBgErrors(
    void *clientData)	/* Pointer to ErrAssocData structure. */
    ClientData clientData)	/* Pointer to ErrAssocData structure. */
{
    ErrAssocData *assocPtr = (ErrAssocData *)clientData;
    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
    Tcl_Interp *interp = assocPtr->interp;
    BgError *errPtr;

    /*
     * Not bothering to save/restore the interp state. Assume that any code
     * that has interp state it needs to keep will make its own
     * Tcl_SaveInterpState call before calling something like Tcl_DoOneEvent()
     * that could lead us here.
     */

    Tcl_Preserve(assocPtr);
    Tcl_Preserve(interp);
    Tcl_Preserve((ClientData) assocPtr);
    Tcl_Preserve((ClientData) interp);
    while (assocPtr->firstBgPtr != NULL) {
	int code, prefixObjc;
	Tcl_Obj **prefixObjv, **tempObjv;

	/*
	 * Note we copy the handler command prefix each pass through, so we do
	 * support one handler setting another handler.
	 * Note we copy the handler command prefix each pass through, so
	 * we do support one handler setting another handler.
	 */

	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);

	errPtr = assocPtr->firstBgPtr;

	Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);
	tempObjv = (Tcl_Obj**)Tcl_Alloc((prefixObjc+2) * sizeof(Tcl_Obj *));
	tempObjv = (Tcl_Obj **) ckalloc((prefixObjc+2)*sizeof(Tcl_Obj *));
	memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *));
	tempObjv[prefixObjc] = errPtr->errorMsg;
	tempObjv[prefixObjc+1] = errPtr->returnOpts;
	Tcl_AllowExceptions(interp);
	code = Tcl_EvalObjv(interp, prefixObjc+2, tempObjv, TCL_EVAL_GLOBAL);

	/*
	 * Discard the command and the information about the error report.
	 */

	Tcl_DecrRefCount(copyObj);
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_Free(errPtr);
	Tcl_Free(tempObjv);
	ckfree((char *) errPtr);
	ckfree((char *) tempObjv);

	if (code == TCL_BREAK) {
	    /*
	     * Break means cancel any remaining error reports for this
	     * interpreter.
	     */

	    while (assocPtr->firstBgPtr != NULL) {
		errPtr = assocPtr->firstBgPtr;
		assocPtr->firstBgPtr = errPtr->nextPtr;
		Tcl_DecrRefCount(errPtr->errorMsg);
		Tcl_DecrRefCount(errPtr->returnOpts);
		Tcl_Free(errPtr);
		ckfree((char *) errPtr);
	    }
	} else if ((code == TCL_ERROR) && !Tcl_IsSafe(interp)) {
	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    if (errChannel != NULL) {
	    if (errChannel != (Tcl_Channel) NULL) {
		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
		Tcl_Obj *keyPtr, *valuePtr = NULL;

		TclNewLiteralStringObj(keyPtr, "-errorinfo");
		Tcl_IncrRefCount(keyPtr);
		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
		Tcl_DecrRefCount(keyPtr);
272
273
274
275
276
277
278
279
280


281
282
283
284
285
286
287
276
277
278
279
280
281
282


283
284
285
286
287
288
289
290
291







-
-
+
+







		Tcl_WriteChars(errChannel, "\n", 1);
		Tcl_Flush(errChannel);
		Tcl_DecrRefCount(options);
	    }
	}
    }
    assocPtr->lastBgPtr = NULL;
    Tcl_Release(interp);
    Tcl_Release(assocPtr);
    Tcl_Release((ClientData) interp);
    Tcl_Release((ClientData) assocPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclDefaultBgErrorHandlerObjCmd --
 *
296
297
298
299
300
301
302
303

304
305
306

307
308
309
310
311
312
313
300
301
302
303
304
305
306

307
308
309

310
311
312
313
314
315
316
317







-
+


-
+







 *	Depends on what actions the "bgerror" command takes for the errors.
 *
 *----------------------------------------------------------------------
 */

int
TclDefaultBgErrorHandlerObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    Tcl_Obj *keyPtr, *valuePtr;
    Tcl_Obj *tempObjv[2];
    int result, code, level;
    Tcl_InterpState saved;

    if (objc != 3) {
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
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







-












-







-
-
+
-
-




-
-
-
+
+
+

-



-
-
+
-
-







    TclNewLiteralStringObj(keyPtr, "-level");
    Tcl_IncrRefCount(keyPtr);
    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (result != TCL_OK || valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-level\"", -1));
	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
	return TCL_ERROR;
    }
    TclNewLiteralStringObj(keyPtr, "-code");
    Tcl_IncrRefCount(keyPtr);
    result = Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (result != TCL_OK || valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-code\"", -1));
	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
	return TCL_ERROR;
    }

    if (level != 0) {
	/*
	 * We're handling a TCL_RETURN exception.
	/* We're handling a TCL_RETURN exception */
	 */

	code = TCL_RETURN;
    }
    if (code == TCL_OK) {
	/*
	 * Somehow we got to exception handling with no exception. (Pass
	 * TCL_OK to Tcl_BackgroundException()?) Just return without doing
	 * anything.
	 * Somehow we got to exception handling with no exception.
	 * (Pass TCL_OK to TclBackgroundException()?)
	 * Just return without doing anything.
	 */

	return TCL_OK;
    }

    /*
     * Construct the bgerror command.
    /* Construct the bgerror command */
     */

    TclNewLiteralStringObj(tempObjv[0], "bgerror");
    Tcl_IncrRefCount(tempObjv[0]);

    /*
     * Determine error message argument.  Check the return options in case
     * a non-error exception brought us here.
     */
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
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







-
-
+
-
-


















-
-
+







    /*
     * Save interpreter state so we can restore it if multiple handler
     * attempts are needed.
     */

    saved = Tcl_SaveInterpState(interp, code);

    /*
     * Invoke the bgerror command.
    /* Invoke the bgerror command. */
     */

    Tcl_AllowExceptions(interp);
    code = Tcl_EvalObjv(interp, 2, tempObjv, TCL_EVAL_GLOBAL);
    if (code == TCL_ERROR) {
	/*
	 * If the interpreter is safe, we look for a hidden command named
	 * "bgerror" and call that with the error information. Otherwise,
	 * simply ignore the error. The rationale is that this could be an
	 * error caused by a malicious applet trying to cause an infinite
	 * barrage of error messages. The hidden "bgerror" command can be used
	 * by a security policy to interpose on such attacks and e.g. kill the
	 * applet after a few attempts.
	 */

	if (Tcl_IsSafe(interp)) {
	    Tcl_RestoreInterpState(interp, saved);
	    TclObjInvoke(interp, 2, tempObjv, TCL_INVOKE_HIDDEN);
	} else {
	    Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);

	    if (errChannel != NULL) {
	    if (errChannel != (Tcl_Channel) NULL) {
		Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);

		Tcl_IncrRefCount(resultPtr);
		if (Tcl_FindCommand(interp, "bgerror", NULL,
			TCL_GLOBAL_ONLY) == NULL) {
		    Tcl_RestoreInterpState(interp, saved);
		    Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp,
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
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







-
+
+









-
+




-
+
+







 */

void
TclSetBgErrorHandler(
    Tcl_Interp *interp,
    Tcl_Obj *cmdPrefix)
{
    ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
    ErrAssocData *assocPtr = (ErrAssocData *)
	    Tcl_GetAssocData(interp, "tclBgError", NULL);

    if (cmdPrefix == NULL) {
	Tcl_Panic("TclSetBgErrorHandler: NULL cmdPrefix argument");
    }
    if (assocPtr == NULL) {
	/*
	 * First access: initialize.
	 */

	assocPtr = (ErrAssocData*)Tcl_Alloc(sizeof(ErrAssocData));
	assocPtr = (ErrAssocData *) ckalloc(sizeof(ErrAssocData));
	assocPtr->interp = interp;
	assocPtr->cmdPrefix = NULL;
	assocPtr->firstBgPtr = NULL;
	assocPtr->lastBgPtr = NULL;
	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc, assocPtr);
	Tcl_SetAssocData(interp, "tclBgError", BgErrorDeleteProc,
		(ClientData) assocPtr);
    }
    if (assocPtr->cmdPrefix) {
	Tcl_DecrRefCount(assocPtr->cmdPrefix);
    }
    assocPtr->cmdPrefix = cmdPrefix;
    Tcl_IncrRefCount(assocPtr->cmdPrefix);
}
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
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







-
+
+






-
+
+


















-
+






-
-
+
+

-
+







-
+

-
+

-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclGetBgErrorHandler(
    Tcl_Interp *interp)
{
    ErrAssocData *assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
    ErrAssocData *assocPtr = (ErrAssocData *)
	    Tcl_GetAssocData(interp, "tclBgError", NULL);

    if (assocPtr == NULL) {
	Tcl_Obj *bgerrorObj;

	TclNewLiteralStringObj(bgerrorObj, "::tcl::Bgerror");
	TclSetBgErrorHandler(interp, bgerrorObj);
	assocPtr = (ErrAssocData *)Tcl_GetAssocData(interp, "tclBgError", NULL);
	assocPtr = (ErrAssocData *)
		Tcl_GetAssocData(interp, "tclBgError", NULL);
    }
    return assocPtr->cmdPrefix;
}

/*
 *----------------------------------------------------------------------
 *
 * BgErrorDeleteProc --
 *
 *	This function is associated with the "tclBgError" assoc data for an
 *	interpreter; it is invoked when the interpreter is deleted in order to
 *	free the information assoicated with any pending error reports.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Background error information is freed: if there were any pending error
 *	reports, they are canceled.
 *	reports, they are cancelled.
 *
 *----------------------------------------------------------------------
 */

static void
BgErrorDeleteProc(
    void *clientData,	/* Pointer to ErrAssocData structure. */
    TCL_UNUSED(Tcl_Interp *))
    ClientData clientData,	/* Pointer to ErrAssocData structure. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
{
    ErrAssocData *assocPtr = (ErrAssocData *)clientData;
    ErrAssocData *assocPtr = (ErrAssocData *) clientData;
    BgError *errPtr;

    while (assocPtr->firstBgPtr != NULL) {
	errPtr = assocPtr->firstBgPtr;
	assocPtr->firstBgPtr = errPtr->nextPtr;
	Tcl_DecrRefCount(errPtr->errorMsg);
	Tcl_DecrRefCount(errPtr->returnOpts);
	Tcl_Free(errPtr);
	ckfree((char *) errPtr);
    }
    Tcl_CancelIdleCall(HandleBgErrors, assocPtr);
    Tcl_CancelIdleCall(HandleBgErrors, (ClientData) assocPtr);
    Tcl_DecrRefCount(assocPtr->cmdPrefix);
    Tcl_EventuallyFree(assocPtr, TCL_DYNAMIC);
    Tcl_EventuallyFree((ClientData) assocPtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateExitHandler --
 *
620
621
622
623
624
625
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
615
616
617
618
619
620
621

622
623

624
625
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







-
+

-
+

+













-
+
-














-
+

-
+

+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));
    ExitHandler *exitPtr;

    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstExitPtr;
    firstExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateLateExitHandler --
 *
 *	Arrange for a given function to be invoked after all pre-thread
 *	Arrange for a given function to be invoked after all pre-thread cleanups
 *	cleanups.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Proc will be invoked with clientData as argument when the application
 *	exits.
 *
 *----------------------------------------------------------------------
 */

void
TclCreateLateExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));
    ExitHandler *exitPtr;

    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    Tcl_MutexLock(&exitMutex);
    exitPtr->nextPtr = firstLateExitPtr;
    firstLateExitPtr = exitPtr;
    Tcl_MutexUnlock(&exitMutex);
}
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
756
757
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







-
+







-
+













-
+



















-
-
+
+







-
+













-
+







 *	clientData, if such a handler exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there is an exit handler corresponding to proc and clientData then
 *	it is canceled; if no such handler exists then nothing happens.
 *	it is cancelled; if no such handler exists then nothing happens.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;

    Tcl_MutexLock(&exitMutex);
    for (prevPtr = NULL, exitPtr = firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    ckfree((char *) exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * TclDeleteLateExitHandler --
 *
 *	This function cancels an existing late exit handler matching proc and
 *	clientData, if such a handler exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there is a late exit handler corresponding to proc and clientData
 *	then it is canceled; if no such handler exists then nothing happens.
 *	If there is a late exit handler corresponding to proc and clientData then
 *	it is canceled; if no such handler exists then nothing happens.
 *
 *----------------------------------------------------------------------
 */

void
TclDeleteLateExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;

    Tcl_MutexLock(&exitMutex);
    for (prevPtr = NULL, exitPtr = firstLateExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		firstLateExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    ckfree((char *) exitPtr);
	    break;
	}
    }
    Tcl_MutexUnlock(&exitMutex);
    return;
}

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
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







-
+




-
+



















-
+







-
+













-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function to invoke. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exitPtr = (ExitHandler*)Tcl_Alloc(sizeof(ExitHandler));
    exitPtr = (ExitHandler *) ckalloc(sizeof(ExitHandler));
    exitPtr->proc = proc;
    exitPtr->clientData = clientData;
    exitPtr->nextPtr = tsdPtr->firstExitPtr;
    tsdPtr->firstExitPtr = exitPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteThreadExitHandler --
 *
 *	This function cancels an existing exit handler matching proc and
 *	clientData, if such a handler exits.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there is an exit handler corresponding to proc and clientData then
 *	it is canceled; if no such handler exists then nothing happens.
 *	it is cancelled; if no such handler exists then nothing happens.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteThreadExitHandler(
    Tcl_ExitProc *proc,		/* Function that was previously registered. */
    void *clientData)	/* Arbitrary value to pass to proc. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    ExitHandler *exitPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (prevPtr = NULL, exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
	    prevPtr = exitPtr, exitPtr = exitPtr->nextPtr) {
	if ((exitPtr->proc == proc)
		&& (exitPtr->clientData == clientData)) {
	    if (prevPtr == NULL) {
		tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = exitPtr->nextPtr;
	    }
	    Tcl_Free(exitPtr);
	    ckfree((char *) exitPtr);
	    return;
	}
    }
}

/*
 *----------------------------------------------------------------------
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
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







-
+















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

















-
+




-
+





+
-
-
-
-
+
+
+
+
-
-
-
-
+

-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+

-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+





-
+







 *	Sets the application wide exit handler to the specified value.
 *
 *----------------------------------------------------------------------
 */

Tcl_ExitProc *
Tcl_SetExitProc(
    TCL_NORETURN1 Tcl_ExitProc *proc)		/* New exit handler for app or NULL */
    Tcl_ExitProc *proc)		/* New exit handler for app or NULL */
{
    Tcl_ExitProc *prevExitProc;

    /*
     * Swap the old exit proc for the new one, saving the old one for our
     * return value.
     */

    Tcl_MutexLock(&exitMutex);
    prevExitProc = appExitPtr;
    appExitPtr = proc;
    Tcl_MutexUnlock(&exitMutex);

    return prevExitProc;
}


/*
 *----------------------------------------------------------------------
 *
 * InvokeExitHandlers --
 *
 *      Call the registered exit handlers.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The exit handlers are invoked, and the ExitHandler struct is
 *      freed.
 *
 *----------------------------------------------------------------------
 */
static void
InvokeExitHandlers(void)
{
    ExitHandler *exitPtr;

    Tcl_MutexLock(&exitMutex);
    inExit = 1;

    for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
	/*
	 * Be careful to remove the handler from the list before invoking its
	 * callback. This protects us against double-freeing if the callback
	 * should call Tcl_DeleteExitHandler on itself.
	 */

	firstExitPtr = exitPtr->nextPtr;
	Tcl_MutexUnlock(&exitMutex);
	exitPtr->proc(exitPtr->clientData);
	Tcl_Free(exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_Exit --
 *
 *	This function is called to terminate the application.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	All existing exit handlers are invoked, then the application ends.
 *
 *----------------------------------------------------------------------
 */

TCL_NORETURN void
void
Tcl_Exit(
    int status)			/* Exit status for application; typically 0
				 * for normal return, 1 for error return. */
{
    TCL_NORETURN1 Tcl_ExitProc *currentAppExitPtr;
    Tcl_ExitProc *currentAppExitPtr;

    Tcl_MutexLock(&exitMutex);
    currentAppExitPtr = appExitPtr;
    Tcl_MutexUnlock(&exitMutex);

    if (currentAppExitPtr) {
    /*
     * Warning: this function SHOULD NOT return, as there is code that depends
     * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
     * returns, so critical is this dependcy.
	/*
	 * Warning: this code SHOULD NOT return, as there is code that depends
	 * on Tcl_Exit never returning. In fact, we will Tcl_Panic if anyone
	 * returns, so critical is this dependcy.
     *
     * If subsystems are not (yet) initialized, proper Tcl-finalization is
     * impossible, so fallback to system exit, see bug-[f8a33ce3db5d8cc2].
     */
	 */

    if (currentAppExitPtr) {

	currentAppExitPtr(INT2PTR(status));

	currentAppExitPtr((ClientData) INT2PTR(status));
	Tcl_Panic("AppExitProc returned unexpectedly");
    } else if (subsystemsInitialized) {

	if (TclFullFinalizationRequested()) {

	    /*
	     * Thorough finalization for Valgrind et al.
	     */

	    Tcl_Finalize();

	} else {
    } else {

	    /*
	     * Fast and deterministic exit (default behavior)
	     */
	/*
	 * Use default handling.
	 */

	    InvokeExitHandlers();

	    /*
	     * Ensure the thread-specific data is initialised as it is used in
	     * Tcl_FinalizeThread()
	Tcl_Finalize();
	     */

	    (void) TCL_TSD_INIT(&dataKey);

	    /*
	     * Now finalize the calling thread only (others are not safely
	     * reachable).  Among other things, this triggers a flush of the
	     * Tcl_Channels that may have data enqueued.
	     */

	    FinalizeThread(/* quick */ 1);
	}
    }

    TclpExit(status);
    Tcl_Panic("OS exit failed!");
	TclpExit(status);
	Tcl_Panic("OS exit failed!");
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_InitSubsystems --
 * TclInitSubsystems --
 *
 *	Initialize various subsytems in Tcl. This should be called the first
 *	time an interp is created, or before any of the subsystems are used.
 *	This function ensures an order for the initialization of subsystems:
 *
 *	1. that cannot be initialized in lazy order because they are mutually
 *	dependent.
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
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







-
+

-
-
+
+

















-
+

-
+


-
-
-











+














-
-
+
+



















+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+







 * Side effects:
 *	Varied, see the respective initialization routines.
 *
 *-------------------------------------------------------------------------
 */

void
Tcl_InitSubsystems(void)
TclInitSubsystems(void)
{
    if (inExit != 0) {
	Tcl_Panic("Tcl_InitSubsystems called while exiting");
    if (inFinalize != 0) {
	Tcl_Panic("TclInitSubsystems called while finalizing");
    }

    if (subsystemsInitialized == 0) {
	/*
	 * Double check inside the mutex. There are definitly calls back into
	 * this routine from some of the functions below.
	 */

	TclpInitLock();
	if (subsystemsInitialized == 0) {

		/*
	     * Initialize locks used by the memory allocators before anything
	     * interesting happens so we can use the allocators in the
	     * implementation of self-initializing locks.
	     */

	    TclInitThreadStorage();     /* Creates hash table for
	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */
#if defined(USE_TCLALLOC) && USE_TCLALLOC
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
	    TclInitThreadAlloc();	/* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
	    TclInitDoubleConversion();	/* Initializes constants for
					 * converting to/from double. */
	    TclInitObjSubsystem();	/* Register obj types, create
					 * mutexes. */
	    TclInitIOSubsystem();	/* Inits a tsd key (noop). */
	    TclInitEncodingSubsystem();	/* Process wide encoding init. */
	    TclpSetInterfaces();
	    TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
	    subsystemsInitialized = 1;
	}
	TclpInitUnlock();
    }
    TclInitNotifier();
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Finalize --
 *
 *	Shut down Tcl. First calls registered exit handlers, then carefully
 *	shuts down various subsystems.  Should be invoked by user before the
 *	Tcl shared library is being unloaded in an embedded context.
 *	shuts down various subsystems. Called by Tcl_Exit or when the Tcl
 *	shared library is being unloaded.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Varied, see the respective finalization routines.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Finalize(void)
{
    ExitHandler *exitPtr;

    /*
     * Invoke exit handlers first.
     */

    Tcl_MutexLock(&exitMutex);
    inFinalize = 1;
    for (exitPtr = firstExitPtr; exitPtr != NULL; exitPtr = firstExitPtr) {
	/*
	 * Be careful to remove the handler from the list before invoking its
	 * callback. This protects us against double-freeing if the callback
    InvokeExitHandlers();
	 * should call Tcl_DeleteExitHandler on itself.
	 */

	firstExitPtr = exitPtr->nextPtr;
	Tcl_MutexUnlock(&exitMutex);
	(*exitPtr->proc)(exitPtr->clientData);
	ckfree((char *) exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);

    TclpInitLock();
    if (subsystemsInitialized == 0) {
	goto alreadyFinalized;
    }
    subsystemsInitialized = 0;

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
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
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
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154

1155
1156
1157
1158
1159
1160
1161
1162







-
+
-









-
+










-











-
+


















+
+












-
+










-
-
-
-
+
+
+
+



















-
+







    Tcl_FinalizeThread();

    /*
     * Now invoke late (process-wide) exit handlers.
     */

    Tcl_MutexLock(&exitMutex);
    for (exitPtr = firstLateExitPtr; exitPtr != NULL;
    for (exitPtr = firstLateExitPtr; exitPtr != NULL; exitPtr = firstLateExitPtr) {
	    exitPtr = firstLateExitPtr) {
	/*
	 * Be careful to remove the handler from the list before invoking its
	 * callback. This protects us against double-freeing if the callback
	 * should call Tcl_DeleteLateExitHandler on itself.
	 */

	firstLateExitPtr = exitPtr->nextPtr;
	Tcl_MutexUnlock(&exitMutex);
	exitPtr->proc(exitPtr->clientData);
	Tcl_Free(exitPtr);
	ckfree((char *) exitPtr);
	Tcl_MutexLock(&exitMutex);
    }
    firstLateExitPtr = NULL;
    Tcl_MutexUnlock(&exitMutex);

    /*
     * Now finalize the Tcl execution environment. Note that this must be done
     * after the exit handlers, because there are order dependencies.
     */

    TclFinalizeEvaluation();
    TclFinalizeExecution();
    TclFinalizeEnvironment();

    /*
     * Finalizing the filesystem must come after anything which might
     * conceivably interact with the 'Tcl_FS' API.
     */

    TclFinalizeFilesystem();

    /*
     * Undo all Tcl_ObjType registrations, and reset the global list of free
     * Undo all Tcl_ObjType registrations, and reset the master list of free
     * Tcl_Obj's. After this returns, no more Tcl_Obj's should be allocated or
     * freed.
     *
     * Note in particular that TclFinalizeObjects() must follow
     * TclFinalizeFilesystem() because TclFinalizeFilesystem free's the
     * Tcl_Obj that holds the path of the current working directory.
     */

    TclFinalizeObjects();

    /*
     * We must be sure the encoding finalization doesn't need to examine the
     * filesystem in any way. Since it only needs to clean up internal data
     * structures, this is fine.
     */

    TclFinalizeEncodingSubsystem();

    Tcl_SetPanicProc(NULL);

    /*
     * Repeat finalization of the thread local storage once more. Although
     * this step is already done by the Tcl_FinalizeThread call above, series
     * of events happening afterwards may re-initialize TSD slots. Those need
     * to be finalized again, otherwise we're leaking memory chunks. Very
     * important to note is that things happening afterwards should not
     * reference anything which may re-initialize TSD's. This includes freeing
     * Tcl_Objs's, among other things.
     *
     * This fixes the Tcl Bug #990552.
     */

    TclFinalizeThreadData(/* quick */ 0);
    TclFinalizeThreadData();

    /*
     * Now we can free constants for conversions to/from double.
     */

    TclFinalizeDoubleConversion();

    /*
     * There have been several bugs in the past that cause exit handlers to be
     * established during Tcl_Finalize processing. Such exit handlers leave
     * malloc'ed memory, and Tcl_FinalizeMemorySubsystem or
     * Tcl_FinalizeThreadAlloc will result in a corrupted heap. The result can
     * be a mysterious crash on process exit. Check here that nobody's done
     * this.
     * malloc'ed memory, and Tcl_FinalizeThreadAlloc or
     * Tcl_FinalizeMemorySubsystem will result in a corrupted heap. The result
     * can be a mysterious crash on process exit. Check here that nobody's
     * done this.
     */

    if (firstExitPtr != NULL) {
	Tcl_Panic("exit handlers were created during Tcl_Finalize");
    }

    TclFinalizePreserve();

    /*
     * Free synchronization objects. There really should only be one thread
     * alive at this moment.
     */

    TclFinalizeSynchronization();

    /*
     * Close down the thread-specific object allocator.
     */

#if TCL_THREADS && defined(USE_THREAD_ALLOC)
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
    TclFinalizeThreadAlloc();
#endif

    /*
     * We defer unloading of packages until very late to avoid memory access
     * issues. Both exit callbacks and synchronization variables may be stored
     * in packages.
1236
1237
1238
1239
1240
1241
1242
1243

1244
1245
1246

1247
1248
1249
1250
1251
1252
1253
1171
1172
1173
1174
1175
1176
1177

1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189







-
+



+







     * original state.
     */

    TclFinalizeLoad();
    TclResetFilesystem();

    /*
     * At this point, there should no longer be any Tcl_Alloc'ed memory.
     * At this point, there should no longer be any ckalloc'ed memory.
     */

    TclFinalizeMemorySubsystem();
    inFinalize = 0;

  alreadyFinalized:
    TclFinalizeLock();
}

/*
 *----------------------------------------------------------------------
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
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







-
-
-
-
-
-
-









-
+












-
-
+
+
















+
-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeThread(void)
{
    FinalizeThread(/* quick */ 0);
}

void
FinalizeThread(
    int quick)
{
    ExitHandler *exitPtr;
    ThreadSpecificData *tsdPtr;

    /*
     * We use TclThreadDataKeyGet here, rather than Tcl_GetThreadData, because
     * we don't want to initialize the data block if it hasn't been
     * initialized already.
     */

    tsdPtr = (ThreadSpecificData*)TclThreadDataKeyGet(&dataKey);
    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    if (tsdPtr != NULL) {
	tsdPtr->inExit = 1;

	for (exitPtr = tsdPtr->firstExitPtr; exitPtr != NULL;
		exitPtr = tsdPtr->firstExitPtr) {
	    /*
	     * Be careful to remove the handler from the list before invoking
	     * its callback. This protects us against double-freeing if the
	     * callback should call Tcl_DeleteThreadExitHandler on itself.
	     */

	    tsdPtr->firstExitPtr = exitPtr->nextPtr;
	    exitPtr->proc(exitPtr->clientData);
	    Tcl_Free(exitPtr);
	    (*exitPtr->proc)(exitPtr->clientData);
	    ckfree((char *) exitPtr);
	}
	TclFinalizeIOSubsystem();
	TclFinalizeNotifier();
	TclFinalizeAsync();
	TclFinalizeThreadObjects();
    }

    /*
     * Blow away all thread local storage blocks.
     *
     * Note that Tcl API allows creation of threads which do not use any Tcl
     * interp or other Tcl subsytems. Those threads might, however, use thread
     * local storage, so we must unconditionally finalize it.
     *
     * Fix [Bug #571002]
     */

    TclFinalizeThreadData(quick);
    TclFinalizeThreadData();
}

/*
 *----------------------------------------------------------------------
 *
 * TclInExit --
 *
1334
1335
1336
1337
1338
1339
1340
1341

1342
1343
1344
1345
1346
1347
1348
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276
1277
1278







-
+







 *
 *----------------------------------------------------------------------
 */

int
TclInExit(void)
{
    return inExit;
    return inFinalize;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInThreadExit --
 *
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447









1448
1449
1450

1451
1452
1453

1454
1455
1456
1457



1458
1459

1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
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

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
1385
1386
1387
1388
1389







-
-
+
+


-
-
+
+
+



















+


-
+


-
+


-
+





-
-
+
+

-
+






-
-
-

-
-



-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







+
+
+
+
+
+
+
+
+



+


-
+

-
-
-
+
+
+

-
+


-
+







 *
 *----------------------------------------------------------------------
 */

int
TclInThreadExit(void)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);
    if (tsdPtr == NULL) {
	return 0;
    }
    return tsdPtr->inExit;
    } else {
	return tsdPtr->inExit;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VwaitObjCmd --
 *
 *	This function is invoked to process the "vwait" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_VwaitObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    int done, foundEvent;
    const char *nameString;
    char *nameString;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    nameString = TclGetString(objv[1]);
    if (Tcl_TraceVar2(interp, nameString, NULL,
    nameString = Tcl_GetString(objv[1]);
    if (Tcl_TraceVar(interp, nameString,
	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, &done) != TCL_OK) {
	    VwaitVarProc, (ClientData) &done) != TCL_OK) {
	return TCL_ERROR;
    };
    done = 0;
    foundEvent = 1;
    while (!done && foundEvent) {
	foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS);
	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    break;
	}
	if (Tcl_LimitExceeded(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
	    break;
	}
    }
    Tcl_UntraceVar2(interp, nameString, NULL,
    Tcl_UntraceVar(interp, nameString,
	    TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, &done);
	    VwaitVarProc, (ClientData) &done);

    if (!foundEvent) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't wait for variable \"%s\": would wait forever",
		nameString));
	Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL);
	return TCL_ERROR;
    }
    if (!done) {
	/*
	 * The interpreter's result was already set to the right error message
	 * prior to exiting the loop above.
	 */

	return TCL_ERROR;
    }

    /*
     * Clear out the interpreter's result, since it may have been set by event
     * handlers.
     */

    Tcl_ResetResult(interp);
    if (!foundEvent) {
	Tcl_AppendResult(interp, "can't wait for variable \"", nameString,
		"\": would wait forever", NULL);
	return TCL_ERROR;
    }
    if (!done) {
	Tcl_AppendResult(interp, "limit exceeded", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

	/* ARGSUSED */
static char *
VwaitVarProc(
    void *clientData,		/* Pointer to integer to set to 1. */
    ClientData clientData,	/* Pointer to integer to set to 1. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    TCL_UNUSED(int) /*flags*/)	/* Information about what happened. */
    CONST char *name1,		/* Name of variable. */
    CONST char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    int *donePtr = (int *)clientData;
    int *donePtr = (int *) clientData;

    *donePtr = 1;
    Tcl_UntraceVar2(interp, name1, name2, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
    Tcl_UntraceVar(interp, name1, TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    VwaitVarProc, clientData);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
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
1531
1532
1533
1534
1535

1536
1537

1538
1539
1540
1541

1542
1543
1544
1545
1546
1547
1548
1549

1550
1551
1552
1553
1554

1555
1556
1557


1558
1559

1560
1561
1562

1563
1564

1565
1566
1567
1568
1569
1570
1571
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

1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452

1453
1454

1455
1456
1457
1458

1459
1460
1461
1462
1463
1464
1465
1466

1467
1468
1469
1470
1471

1472
1473


1474
1475
1476
1477
1478
1479
1480

1481
1482

1483
1484
1485
1486
1487
1488
1489
1490







+


-
+


-
+



-
-
+
+








-
-
+
+











-
-
-


-
+













-
+

-
+



-
+







-
+




-
+

-
-
+
+


+


-
+

-
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_UpdateObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    int optionIndex;
    int flags = 0;		/* Initialized to avoid compiler warning. */
    static const char *const updateOptions[] = {"idletasks", NULL};
    enum updateOptionsEnum {OPT_IDLETASKS};
    static CONST char *updateOptions[] = {"idletasks", NULL};
    enum updateOptions {REGEXP_IDLETASKS};

    if (objc == 1) {
	flags = TCL_ALL_EVENTS|TCL_DONT_WAIT;
    } else if (objc == 2) {
	if (Tcl_GetIndexFromObj(interp, objv[1], updateOptions,
		"option", 0, &optionIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum updateOptionsEnum) optionIndex) {
	case OPT_IDLETASKS:
	switch ((enum updateOptions) optionIndex) {
	case REGEXP_IDLETASKS:
	    flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
	    break;
	default:
	    Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");
	}
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?idletasks?");
	return TCL_ERROR;
    }

    while (Tcl_DoOneEvent(flags) != 0) {
	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (Tcl_LimitExceeded(interp)) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1));
	    Tcl_AppendResult(interp, "limit exceeded", NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Must clear the interpreter's result because event handlers could have
     * executed commands.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}

#if TCL_THREADS
#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *-----------------------------------------------------------------------------
 *
 * NewThreadProc --
 *
 *	Bootstrap function of a new Tcl thread.
 * 	Bootstrap function of a new Tcl thread.
 *
 * Results:
 *	None.
 *
 * Side Effects:
 *	Initializes Tcl notifier for the current thread.
 *
 *----------------------------------------------------------------------
 *-----------------------------------------------------------------------------
 */

static Tcl_ThreadCreateType
NewThreadProc(
    void *clientData)
    ClientData clientData)
{
    ThreadClientData *cdPtr = (ThreadClientData *)clientData;
    void *threadClientData;
    ThreadClientData *cdPtr;
    ClientData threadClientData;
    Tcl_ThreadCreateProc *threadProc;

    cdPtr = (ThreadClientData *) clientData;
    threadProc = cdPtr->proc;
    threadClientData = cdPtr->clientData;
    Tcl_Free(clientData);		/* Allocated in Tcl_CreateThread() */
    ckfree((char *) clientData);	/* Allocated in Tcl_CreateThread() */

    threadProc(threadClientData);
    (*threadProc)(threadClientData);

    TCL_THREAD_CREATE_RETURN;
}
#endif

/*
 *----------------------------------------------------------------------
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
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
1531
1532
1533
1534
1535
1536
1537







-
-
-
+
+
+



-
-
+
+
-

+


-
-
-
-
-
+
+
+












 *
 *----------------------------------------------------------------------
 */

int
Tcl_CreateThread(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    void *clientData,	/* The one argument to Main() */
    size_t stackSize,		/* Size of stack for the new thread */
    Tcl_ThreadCreateProc proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = (ThreadClientData *)Tcl_Alloc(sizeof(ThreadClientData));
#ifdef TCL_THREADS
    ThreadClientData *cdPtr;
    int result;

    cdPtr = (ThreadClientData *) ckalloc(sizeof(ThreadClientData));
    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {
	Tcl_Free(cdPtr);
    }
    return result;

    return TclpThreadCreate(idPtr, NewThreadProc, (ClientData) cdPtr,
	    stackSize, flags);
#else
    return TCL_ERROR;
#endif /* TCL_THREADS */
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclExecute.c.

more than 10,000 changes

Changes to generic/tclFCmd.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

26
27

28
29
30
31
32
33
34
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













-










-
+

-
+







/*
 * tclFCmd.c
 *
 *	This file implements the generic portion of file manipulation
 *	subcommands of the "file" command.
 *
 * Copyright (c) 1996-1998 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"
#include "tclFileSystem.h"

/*
 * Declarations for local functions defined in this file:
 */

static int		CopyRenameOneFile(Tcl_Interp *interp,
			    Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr,
			    int copyFlag, int force);
static Tcl_Obj *	FileBasename(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static int		FileCopyRename(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[], int copyFlag);
			    int objc, Tcl_Obj *CONST objv[], int copyFlag);
static int		FileForceOption(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[], int *forcePtr);
			    int objc, Tcl_Obj *CONST objv[], int *forcePtr);

/*
 *---------------------------------------------------------------------------
 *
 * TclFileRenameCmd
 *
 *	This function implements the "rename" subcommand of the "file"
43
44
45
46
47
48
49
50
51
52
53
54

55
56
57
58
59
60
61
42
43
44
45
46
47
48

49
50
51

52
53
54
55
56
57
58
59







-



-
+







 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileRenameCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interp for error reporting or recursive
				 * calls in the case of a tricky rename. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, objc, objv, 0);
}

/*
 *---------------------------------------------------------------------------
 *
72
73
74
75
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
70
71
72
73
74
75
76

77
78
79

80
81
82
83
84
85
86
87







-



-
+







 *	See the user documentation.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileCopyCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Used for error reporting or recursive calls
				 * in the case of a tricky copy. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    return FileCopyRename(interp, objc, objv, 1);
}

/*
 *---------------------------------------------------------------------------
 *
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
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







-
+







-
+



-
+

-
-
+
+
+




-
-
+
+
+



















-
-
-
+
+
+







 *---------------------------------------------------------------------------
 */

static int
FileCopyRename(
    Tcl_Interp *interp,		/* Used for error reporting. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument strings passed to Tcl_FileCmd. */
    Tcl_Obj *CONST objv[],	/* Argument strings passed to Tcl_FileCmd. */
    int copyFlag)		/* If non-zero, copy source(s). Otherwise,
				 * rename them. */
{
    int i, result, force;
    Tcl_StatBuf statBuf;
    Tcl_Obj *target;

    i = FileForceOption(interp, objc - 1, objv + 1, &force);
    i = FileForceOption(interp, objc - 2, objv + 2, &force);
    if (i < 0) {
	return TCL_ERROR;
    }
    i++;
    i += 2;
    if ((objc - i) < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-option value ...? source ?source ...? target");
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		TclGetString(objv[0]), " ", TclGetString(objv[1]),
		" ?options? source ?source ...? target\"", NULL);
	return TCL_ERROR;
    }

    /*
     * If target doesn't exist or isn't a directory, try the copy/rename. More
     * than 2 arguments is only valid if the target is an existing directory.
     * If target doesn't exist or isn't a directory, try the copy/rename.
     * More than 2 arguments is only valid if the target is an existing
     * directory.
     */

    target = objv[objc - 1];
    if (Tcl_FSConvertToPathType(interp, target) != TCL_OK) {
	return TCL_ERROR;
    }

    result = TCL_OK;

    /*
     * Call Tcl_FSStat() so that if target is a symlink that points to a
     * directory we will put the sources in that directory instead of
     * overwriting the symlink.
     */

    if ((Tcl_FSStat(target, &statBuf) != 0) || !S_ISDIR(statBuf.st_mode)) {
	if ((objc - i) > 2) {
	    errno = ENOTDIR;
	    Tcl_PosixError(interp);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error %s: target \"%s\" is not a directory",
		    (copyFlag?"copying":"renaming"), TclGetString(target)));
	    Tcl_AppendResult(interp, "error ",
		    (copyFlag ? "copying" : "renaming"), ": target \"",
		    TclGetString(target), "\" is not a directory", NULL);
	    result = TCL_ERROR;
	} else {
	    /*
	     * Even though already have target == translated(objv[i+1]), pass
	     * the original argument down, so if there's an error, the error
	     * message will reflect the original arguments.
	     */
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
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







+








+
-
+




+







     * Move each source file into target directory. Extract the basename from
     * each source, and append it to the end of the target path.
     */

    for ( ; i<objc-1 ; i++) {
	Tcl_Obj *jargv[2];
	Tcl_Obj *source, *newFileName;
	Tcl_Obj *temp;

	source = FileBasename(interp, objv[i]);
	if (source == NULL) {
	    result = TCL_ERROR;
	    break;
	}
	jargv[0] = objv[objc - 1];
	jargv[1] = source;
	temp = Tcl_NewListObj(2, jargv);
	newFileName = TclJoinPath(2, jargv, 1);
	newFileName = Tcl_FSJoinPath(temp, -1);
	Tcl_IncrRefCount(newFileName);
	result = CopyRenameOneFile(interp, objv[i], newFileName, copyFlag,
		force);
	Tcl_DecrRefCount(newFileName);
	Tcl_DecrRefCount(temp);
	Tcl_DecrRefCount(source);

	if (result == TCL_ERROR) {
	    break;
	}
    }
    return result;
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
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







-


-
+

-
+





+
+

-
+





-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclFileMakeDirsCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Used for error reporting. */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    Tcl_Obj *errfile = NULL;
    Tcl_Obj *errfile;
    int result, i, j, pobjc;
    Tcl_Obj *split = NULL;
    Tcl_Obj *target = NULL;
    Tcl_StatBuf statBuf;

    errfile = NULL;

    result = TCL_OK;
    for (i = 1; i < objc; i++) {
    for (i = 2; i < objc; i++) {
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    break;
	}

	split = Tcl_FSSplitPath(objv[i], &pobjc);
	split = Tcl_FSSplitPath(objv[i],&pobjc);
	Tcl_IncrRefCount(split);
	if (pobjc == 0) {
	    errno = ENOENT;
	    errfile = objv[i];
	    break;
	}
	for (j = 0; j < pobjc; j++) {
301
302
303
304
305
306
307
308
309
310


311
312
313
314
315
316
317
304
305
306
307
308
309
310



311
312
313
314
315
316
317
318
319







-
-
-
+
+







	}
	Tcl_DecrRefCount(split);
	split = NULL;
    }

  done:
    if (errfile != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create directory \"%s\": %s",
		TclGetString(errfile), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "can't create directory \"",
		TclGetString(errfile), "\": ", Tcl_PosixError(interp), NULL);
	result = TCL_ERROR;
    }
    if (split != NULL) {
	Tcl_DecrRefCount(split);
    }
    if (target != NULL) {
	Tcl_DecrRefCount(target);
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
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







-


-
+





-
+



+
+
+
+
+
+
+




-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclFileDeleteCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Used for error reporting */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument strings passed to Tcl_FileCmd. */
    Tcl_Obj *CONST objv[])	/* Argument strings passed to Tcl_FileCmd. */
{
    int i, force, result;
    Tcl_Obj *errfile;
    Tcl_Obj *errorBuffer = NULL;

    i = FileForceOption(interp, objc - 1, objv + 1, &force);
    i = FileForceOption(interp, objc - 2, objv + 2, &force);
    if (i < 0) {
	return TCL_ERROR;
    }
    i += 2;
    if ((objc - i) < 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		TclGetString(objv[0]), " ", TclGetString(objv[1]),
		" ?options? file ?file ...?\"", NULL);
	return TCL_ERROR;
    }

    errfile = NULL;
    result = TCL_OK;

    for (i++ ; i < objc; i++) {
    for ( ; i < objc; i++) {
	Tcl_StatBuf statBuf;

	errfile = objv[i];
	if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	    result = TCL_ERROR;
	    goto done;
	}
375
376
377
378
379
380
381
382
383
384



385
386
387
388
389
390
391
383
384
385
386
387
388
389



390
391
392
393
394
395
396
397
398
399







-
-
-
+
+
+







	     * We own a reference count on errorBuffer, if it was set as a
	     * result of this call.
	     */

	    result = Tcl_FSRemoveDirectory(objv[i], force, &errorBuffer);
	    if (result != TCL_OK) {
		if ((force == 0) && (errno == EEXIST)) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error deleting \"%s\": directory not empty",
			    TclGetString(objv[i])));
		    Tcl_AppendResult(interp, "error deleting \"",
			    TclGetString(objv[i]), "\": directory not empty",
			    NULL);
		    Tcl_PosixError(interp);
		    goto done;
		}

		/*
		 * If possible, use the untranslated name for the file.
		 */
424
425
426
427
428
429
430
431
432
433


434
435
436
437



438
439
440
441
442
443
444
432
433
434
435
436
437
438



439
440
441



442
443
444
445
446
447
448
449
450
451







-
-
-
+
+

-
-
-
+
+
+







    }
    if (result != TCL_OK) {
	if (errfile == NULL) {
	    /*
	     * We try to accomodate poor error results from our Tcl_FS calls.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting unknown file: %s",
		    Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "error deleting unknown file: ",
		    Tcl_PosixError(interp), NULL);
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error deleting \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "error deleting \"",
		    TclGetString(errfile), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
    }

  done:
    if (errorBuffer != NULL) {
	Tcl_DecrRefCount(errorBuffer);
    }
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
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







-
+



















-
-
-
+
+
+





-
-
-
+
+
+







	/*
	 * 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 !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;
	    }
	}
#endif

	/*
	 * Prevent copying/renaming a file onto a directory and vice-versa.
	 * This is a policy decision based on the fact that existing
	 * implementations of copy and rename on all platforms also prevent
	 * this.
	 */

	if (S_ISDIR(sourceStatBuf.st_mode)
		&& !S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't overwrite file \"%s\" with directory \"%s\"",
		    TclGetString(target), TclGetString(source)));
	    Tcl_AppendResult(interp, "can't overwrite file \"",
		    TclGetString(target), "\" with directory \"",
		    TclGetString(source), "\"", NULL);
	    goto done;
	}
	if (!S_ISDIR(sourceStatBuf.st_mode)
		&& S_ISDIR(targetStatBuf.st_mode)) {
	    errno = EISDIR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't overwrite directory \"%s\" with file \"%s\"",
		    TclGetString(target), TclGetString(source)));
	    Tcl_AppendResult(interp, "can't overwrite directory \"",
		    TclGetString(target), "\" with file \"",
		    TclGetString(source), "\"", NULL);
	    goto done;
	}

	/*
	 * The destination exists, but appears to be ok to over-write, and
	 * -force is given. We now try to adjust permissions to ensure the
	 * operation succeeds. If we can't adjust permissions, we'll let the
580
581
582
583
584
585
586
587
588
589




590
591
592
593
594
595
596
597
587
588
589
590
591
592
593



594
595
596
597

598
599
600
601
602
603
604







-
-
-
+
+
+
+
-







    if (copyFlag == 0) {
	result = Tcl_FSRenameFile(source, target);
	if (result == TCL_OK) {
	    goto done;
	}

	if (errno == EINVAL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error renaming \"%s\" to \"%s\": trying to rename a"
		    " volume or move a directory into itself",
	    Tcl_AppendResult(interp, "error renaming \"",
		    TclGetString(source), "\" to \"", TclGetString(target),
		    "\": trying to rename a volume or "
		    "move a directory into itself", NULL);
		    TclGetString(source), TclGetString(target)));
	    goto done;
	} else if (errno != EXDEV) {
	    errfile = target;
	    goto done;
	}

	/*
627
628
629
630
631
632
633
634
635


636
637
638
639
640
641
642
643
634
635
636
637
638
639
640


641
642

643
644
645
646
647
648
649







-
-
+
+
-







	 */

	if (Tcl_FSStat(source, &sourceStatBuf) != 0) {
	    /*
	     * Actual file doesn't exist.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error copying \"%s\": the target of this link doesn't"
	    Tcl_AppendResult(interp, "error copying \"", TclGetString(source),
		    "\": the target of this link doesn't exist", NULL);
		    " exist", TclGetString(source)));
	    goto done;
	} else {
	    int counter = 0;

	    while (1) {
		Tcl_Obj *path = Tcl_FSLink(actualSource, NULL, 0);
		if (path == NULL) {
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
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







-











-
-
+
+






-
-
-
+
+

-
-
+

-
-
+


-
-
+







	 */
	Tcl_ResetResult(interp);
    }
    if ((copyFlag == 0) && (result == TCL_OK)) {
	if (S_ISDIR(sourceStatBuf.st_mode)) {
	    result = Tcl_FSRemoveDirectory(source, 1, &errorBuffer);
	    if (result != TCL_OK) {
		errfile = errorBuffer;
		if (Tcl_FSEqualPaths(errfile, source) == 0) {
		    errfile = source;
		}
	    }
	} else {
	    result = Tcl_FSDeleteFile(source);
	    if (result != TCL_OK) {
		errfile = source;
	    }
	}
	if (result != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't unlink \"%s\": %s",
		    TclGetString(errfile), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "can't unlink \"", TclGetString(errfile),
		    "\": ", Tcl_PosixError(interp), NULL);
	    errfile = NULL;
	}
    }

  done:
    if (errfile != NULL) {
	Tcl_Obj *errorMsg = Tcl_ObjPrintf("error %s \"%s\"",
		(copyFlag ? "copying" : "renaming"), TclGetString(source));

	Tcl_AppendResult(interp, "error ", (copyFlag ? "copying" : "renaming"),
		 " \"", TclGetString(source), NULL);
	if (errfile != source) {
	    Tcl_AppendPrintfToObj(errorMsg, " to \"%s\"",
		    TclGetString(target));
	    Tcl_AppendResult(interp, "\" to \"", TclGetString(target), NULL);
	    if (errfile != target) {
		Tcl_AppendPrintfToObj(errorMsg, ": \"%s\"",
			TclGetString(errfile));
		Tcl_AppendResult(interp, "\": \"", TclGetString(errfile),NULL);
	    }
	}
	Tcl_AppendPrintfToObj(errorMsg, ": %s", Tcl_PosixError(interp));
	Tcl_SetObjResult(interp, errorMsg);
	Tcl_AppendResult(interp, "\": ", Tcl_PosixError(interp), NULL);
    }
    if (errorBuffer != NULL) {
	Tcl_DecrRefCount(errorBuffer);
    }
    if (actualSource != NULL) {
	Tcl_DecrRefCount(actualSource);
    }
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
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







-
+




-
+
-
-
-






-
-
-
-
-
+

-
+


+
+
+
+







 *---------------------------------------------------------------------------
 */

static int
FileForceOption(
    Tcl_Interp *interp,		/* Interp, for error return. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument strings.  First command line
    Tcl_Obj *CONST objv[],	/* Argument strings.  First command line
				 * option, if it exists, begins at 0. */
    int *forcePtr)		/* If the "-force" was specified, *forcePtr is
				 * filled with 1, otherwise with 0. */
{
    int force, i, idx;
    int force, i;
    static const char *const options[] = {
	"-force", "--", NULL
    };

    force = 0;
    for (i = 0; i < objc; i++) {
	if (TclGetString(objv[i])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", TCL_EXACT,
		&idx) != TCL_OK) {
	    return -1;
	}
	if (idx == 0 /* -force */) {
	if (strcmp(TclGetString(objv[i]), "-force") == 0) {
	    force = 1;
	} else { /* -- */
	} else if (strcmp(TclGetString(objv[i]), "--") == 0) {
	    i++;
	    break;
	} else {
	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[i]),
		    "\": should be -force or --", NULL);
	    return -1;
	}
    }
    *forcePtr = force;
    return i;
}
/*
 *---------------------------------------------------------------------------
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
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







-
+


















-
+





-
+
















-


-
+


-
+
-
-
-
+
+


-
-
+
+
+



-
+

-
+


-
-
+
+


-
-
-
-












-
-
-
-
+
+
+

















-
-
+
+
+


-
+

-
+
-




-
-
-
-
-
-







	    if ((objc == 1) &&
		    (Tcl_FSGetPathType(resultPtr) != TCL_PATH_RELATIVE)) {
		resultPtr = NULL;
	    }
	}
    }
    if (resultPtr == NULL) {
	TclNewObj(resultPtr);
	resultPtr = Tcl_NewObj();
    }
    Tcl_IncrRefCount(resultPtr);
    Tcl_DecrRefCount(splitPtr);
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFileAttrsCmd --
 *
 *	Sets or gets the platform-specific attributes of a file. The objc-objv
 *	points to the file name with the rest of the command line following.
 *	This routine uses platform-specific tables of option strings and
 *	callbacks. The callback to get the attributes take three parameters:
 *	    Tcl_Interp *interp;	    The interp to report errors with. Since
 *				    this is an object-based API, the object
 *				    form of the result should be used.
 *	    const char *fileName;   This is extracted using
 *	    CONST char *fileName;   This is extracted using
 *				    Tcl_TranslateFileName.
 *	    TclObj **attrObjPtrPtr; A new object to hold the attribute is
 *				    allocated and put here.
 *	The first two parameters of the callback used to write out the
 *	attributes are the same. The third parameter is:
 *	    const *attrObjPtr;	    A pointer to the object that has the new
 *	    CONST *attrObjPtr;	    A pointer to the object that has the new
 *				    attribute.
 *	They both return standard TCL errors; if the routine to get an
 *	attribute fails, no object is allocated and *attrObjPtrPtr is
 *	unchanged.
 *
 * Results:
 *	Standard TCL error.
 *
 * Side effects:
 *	May set file attributes for the file name.
 *
 *----------------------------------------------------------------------
 */

int
TclFileAttrsCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int objc,			/* Number of command line arguments. */
    Tcl_Obj *const objv[])	/* The command line objects. */
    Tcl_Obj *CONST objv[])	/* The command line objects. */
{
    int result;
    const char *const *attributeStrings;
    CONST char ** attributeStrings;
    const char **attributeStringsAllocated = NULL;
    Tcl_Obj *objStrings = NULL;
    int numObjStrings = -1;
    Tcl_Obj* objStrings = NULL;
    int numObjStrings = -1, didAlloc = 0;
    Tcl_Obj *filePtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?-option value ...?");
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 2, objv,
		"name ?option? ?value? ?option value ...?");
	return TCL_ERROR;
    }

    filePtr = objv[1];
    filePtr = objv[2];
    if (Tcl_FSConvertToPathType(interp, filePtr) != TCL_OK) {
	return TCL_ERROR;
    	return TCL_ERROR;
    }

    objc -= 2;
    objv += 2;
    objc -= 3;
    objv += 3;
    result = TCL_ERROR;
    Tcl_SetErrno(0);

    /*
     * Get the set of attribute names from the filesystem.
     */

    attributeStrings = Tcl_FSFileAttrStrings(filePtr, &objStrings);
    if (attributeStrings == NULL) {
	int index;
	Tcl_Obj *objPtr;

	if (objStrings == NULL) {
	    if (Tcl_GetErrno() != 0) {
		/*
		 * There was an error, probably that the filePtr is not
		 * accepted by any filesystem
		 */

		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not read \"%s\": %s",
			TclGetString(filePtr), Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "could not read \"",
			TclGetString(filePtr), "\": ", Tcl_PosixError(interp),
			NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * We own the object now.
	 */

	Tcl_IncrRefCount(objStrings);

	/*
	 * Use objStrings as a list object.
	 */

	if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) {
	    goto end;
	}
	attributeStringsAllocated = (const char **)
		TclStackAlloc(interp, (1+numObjStrings) * sizeof(char *));
	attributeStrings = (CONST char **) TclStackAlloc(interp,
		(1+numObjStrings) * sizeof(char*));
	didAlloc = 1;
	for (index = 0; index < numObjStrings; index++) {
	    Tcl_ListObjIndex(interp, objStrings, index, &objPtr);
	    attributeStringsAllocated[index] = TclGetString(objPtr);
	    attributeStrings[index] = TclGetString(objPtr);
	}
	attributeStringsAllocated[index] = NULL;
	attributeStrings[index] = NULL;
	attributeStrings = attributeStringsAllocated;
    } else if (objStrings != NULL) {
	Tcl_Panic("must not update objPtrRef's variable and return non-NULL");
    }

    /*
     * Process the attributes to produce a list of all of them, the value of a
     * particular attribute, or to set one or more attributes (depending on
     * the number of arguments).
     */

    if (objc == 0) {
	/*
	 * Get all attributes.
	 */

	int index, res = TCL_OK, nbAtts = 0;
	Tcl_Obj *listPtr;
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

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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
1140
1141
1142
1143
1144
1145
1146







-
+









-
-
+
+
-
-
+




-
+


+
+
+
+













-
-
+
+
-
-
+



-
-
-
+
+
+

-
+
+
+
+
+

-
-
+
+
-
-


-
-
+
+

-
-
+
+



+
+
-
-
+
+
-
-
+

-
-
-
+

+

+
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	     * Error: no valid attributes found.
	     */

	    Tcl_DecrRefCount(listPtr);
	    goto end;
	}

	Tcl_SetObjResult(interp, listPtr);
    	Tcl_SetObjResult(interp, listPtr);
    } else if (objc == 1) {
	/*
	 * Get one attribute.
	 */

	int index;
	Tcl_Obj *objPtr = NULL;

	if (numObjStrings == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\", there are no file attributes in this"
	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
		    "\", there are no file attributes in this filesystem.",
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
		    NULL);
	    goto end;
	}

	if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
		"option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
		"option", 0, &index) != TCL_OK) {
	    goto end;
	}
	if (didAlloc) {
	    TclFreeIntRep(objv[0]);
	    objv[0]->typePtr = NULL;
	}
	if (Tcl_FSFileAttrsGet(interp, index, filePtr,
		&objPtr) != TCL_OK) {
	    goto end;
	}
	Tcl_SetObjResult(interp, objPtr);
    } else {
	/*
	 * Set option/value pairs.
	 */

	int i, index;

	if (numObjStrings == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad option \"%s\", there are no file attributes in this"
	    Tcl_AppendResult(interp, "bad option \"", TclGetString(objv[0]),
		    "\", there are no file attributes in this filesystem.",
		    " filesystem", TclGetString(objv[0])));
	    Tcl_SetErrorCode(interp, "TCL","OPERATION","FATTR","NONE", NULL);
		    NULL);
	    goto end;
	}

	for (i = 0; i < objc ; i += 2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
		    "option", TCL_INDEX_TEMP_TABLE, &index) != TCL_OK) {
    	for (i = 0; i < objc ; i += 2) {
    	    if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
		    "option", 0, &index) != TCL_OK) {
		goto end;
	    }
    	    }
	    if (didAlloc) {
		TclFreeIntRep(objv[i]);
		objv[i]->typePtr = NULL;
	    }
	    if (i + 1 == objc) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"value for \"%s\" missing", TclGetString(objv[i])));
		Tcl_AppendResult(interp, "value for \"",
			TclGetString(objv[i]), "\" missing", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FATTR",
			"NOVALUE", NULL);
		goto end;
	    }
	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
		    objv[i + 1]) != TCL_OK) {
    	    if (Tcl_FSFileAttrsSet(interp, index, filePtr,
    	    	    objv[i + 1]) != TCL_OK) {
		goto end;
	    }
	}
    	    }
    	}
    }
    result = TCL_OK;

  end:
    if (didAlloc) {
    /*
     * Free up the array we allocated and drop our reference to any list of
	/*
	 * Free up the array we allocated.
     * attribute names issued by the filesystem.
     */
	 */

  end:
    if (attributeStringsAllocated != NULL) {
	TclStackFree(interp, (void *) attributeStringsAllocated);
	TclStackFree(interp, (void *)attributeStrings);
    }

    if (objStrings != NULL) {
	/*
	 * We don't need this object that was passed to us any more.
	 */

	Tcl_DecrRefCount(objStrings);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFileLinkCmd --
 *
 *	This function is invoked to process the "file link" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May create a new link.
 *
 *----------------------------------------------------------------------
 */

int
TclFileLinkCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *contents;
    int index;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-linktype? linkname ?target?");
	return TCL_ERROR;
    }

    /*
     * Index of the 'source' argument.
     */

    if (objc == 4) {
	index = 2;
    } else {
	index = 1;
    }

    if (objc > 2) {
	int linkAction;

	if (objc == 4) {
	    /*
	     * We have a '-linktype' argument.
	     */

	    static const char *const linkTypes[] = {
		"-symbolic", "-hard", NULL
	    };
	    if (Tcl_GetIndexFromObj(interp, objv[1], linkTypes, "option", 0,
		    &linkAction) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (linkAction == 0) {
		linkAction = TCL_CREATE_SYMBOLIC_LINK;
	    } else {
		linkAction = TCL_CREATE_HARD_LINK;
	    }
	} else {
	    linkAction = TCL_CREATE_SYMBOLIC_LINK | TCL_CREATE_HARD_LINK;
	}
	if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Create link from source to target.
	 */

	contents = Tcl_FSLink(objv[index], objv[index+1], linkAction);
	if (contents == NULL) {
	    /*
	     * We handle three common error cases specially, and for all other
	     * errors, we use the standard posix error message.
	     */

	    if (errno == EEXIST) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\": that path already"
			" exists", TclGetString(objv[index])));
		Tcl_PosixError(interp);
	    } else if (errno == ENOENT) {
		/*
		 * There are two cases here: either the target doesn't exist,
		 * or the directory of the src doesn't exist.
		 */

		int access;
		Tcl_Obj *dirPtr = TclPathPart(interp, objv[index],
			TCL_PATH_DIRNAME);

		if (dirPtr == NULL) {
		    return TCL_ERROR;
		}
		access = Tcl_FSAccess(dirPtr, F_OK);
		Tcl_DecrRefCount(dirPtr);
		if (access != 0) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not create new link \"%s\": no such file"
			    " or directory", TclGetString(objv[index])));
		    Tcl_PosixError(interp);
		} else {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "could not create new link \"%s\": target \"%s\" "
			    "doesn't exist", TclGetString(objv[index]),
			    TclGetString(objv[index+1])));
		    errno = ENOENT;
		    Tcl_PosixError(interp);
		}
	    } else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not create new link \"%s\" pointing to \"%s\": %s",
			TclGetString(objv[index]),
			TclGetString(objv[index+1]), Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
    } else {
	if (Tcl_FSConvertToPathType(interp, objv[index]) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * Read link
	 */

	contents = Tcl_FSLink(objv[index], NULL, 0);
	if (contents == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read link \"%s\": %s",
		    TclGetString(objv[index]), Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, contents);
    if (objc == 2) {
	/*
	 * If we are reading a link, we need to free this result refCount. If
	 * we are creating a link, this will just be objv[index+1], and so we
	 * don't own it.
	 */

	Tcl_DecrRefCount(contents);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFileReadLinkCmd --
 *
 *	This function is invoked to process the "file readlink" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclFileReadLinkCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *contents;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }

    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }

    contents = Tcl_FSLink(objv[1], NULL, 0);

    if (contents == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read link \"%s\": %s",
		TclGetString(objv[1]), Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, contents);
    Tcl_DecrRefCount(contents);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFileTemporaryCmd --
 *
 *	This function implements the "tempfile" subcommand of the "file"
 *	command.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Creates a temporary file. Opens a channel to that file and puts the
 *	name of that channel in the result. *Might* register suitable exit
 *	handlers to ensure that the temporary file gets deleted. Might write
 *	to a variable, so reentrancy is a potential issue.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileTemporaryCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *nameVarObj = NULL;	/* Variable to store the name of the temporary
				 * file in. */
    Tcl_Obj *nameObj = NULL;	/* Object that will contain the filename. */
    Tcl_Channel chan;		/* The channel opened (RDWR) on the temporary
				 * file, or NULL if there's an error. */
    Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
				/* Pieces of template. Each piece is NULL if
				 * it is omitted. The platform temporary file
				 * engine might ignore some pieces. */

    if (objc < 1 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
	return TCL_ERROR;
    }

    if (objc > 1) {
	nameVarObj = objv[1];
	TclNewObj(nameObj);
    }
    if (objc > 2) {
	size_t length;
	Tcl_Obj *templateObj = objv[2];
	const char *string = TclGetStringFromObj(templateObj, &length);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
	    goto makeTemporary;
	}

	/*
	 * The template only gives a directory if there is a directory
	 * separator in it.
	 */

	if (strchr(string, '/') != NULL
		|| (tclPlatform == TCL_PLATFORM_WINDOWS
		    && strchr(string, '\\') != NULL)) {
	    tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);

	    /*
	     * Only allow creation of temporary files in the native filesystem
	     * since they are frequently used for integration with external
	     * tools or system libraries. [Bug 2388866]
	     */

	    if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
		    != &tclNativeFilesystem) {
		TclDecrRefCount(tempDirObj);
		tempDirObj = NULL;
	    }
	}

	/*
	 * The template only gives the filename if the last character isn't a
	 * directory separator.
	 */

	if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
		|| string[length-1] != '\\')) {
	    Tcl_Obj *tailObj = TclPathPart(interp, templateObj,
		    TCL_PATH_TAIL);

	    if (tailObj != NULL) {
		tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
		tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
		TclDecrRefCount(tailObj);
	    }
	}
    }

    /*
     * Convert empty parts of the template into unspecified parts.
     */

    if (tempDirObj && !TclGetString(tempDirObj)[0]) {
	TclDecrRefCount(tempDirObj);
	tempDirObj = NULL;
    }
    if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
	TclDecrRefCount(tempBaseObj);
	tempBaseObj = NULL;
    }
    if (tempExtObj && !TclGetString(tempExtObj)[0]) {
	TclDecrRefCount(tempExtObj);
	tempExtObj = NULL;
    }

    /*
     * Create and open the temporary file.
     */

  makeTemporary:
    chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);

    /*
     * If we created pieces of template, get rid of them now.
     */

    if (tempDirObj) {
	TclDecrRefCount(tempDirObj);
    }
    if (tempBaseObj) {
	TclDecrRefCount(tempBaseObj);
    }
    if (tempExtObj) {
	TclDecrRefCount(tempExtObj);
    }

    /*
     * Deal with results.
     */

    if (chan == NULL) {
	if (nameVarObj) {
	    TclDecrRefCount(nameObj);
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create temporary file: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    if (nameVarObj != NULL) {
	if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    Tcl_UnregisterChannel(interp, chan);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFileTempDirCmd --
 *
 *	This function implements the "tempdir" subcommand of the "file"
 *	command.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Creates a temporary directory.
 *
 *---------------------------------------------------------------------------
 */

int
TclFileTempDirCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *dirNameObj;	/* Object that will contain the directory
				 * name. */
    Tcl_Obj *baseDirObj = NULL, *nameBaseObj = NULL;
				/* Pieces of template. Each piece is NULL if
				 * it is omitted. The platform temporary file
				 * engine might ignore some pieces. */

    if (objc < 1 || objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?template?");
	return TCL_ERROR;
    }

    if (objc > 1) {
	int length;
	Tcl_Obj *templateObj = objv[1];
	const char *string = TclGetStringFromObj(templateObj, &length);
	const int onWindows = (tclPlatform == TCL_PLATFORM_WINDOWS);

	/*
	 * Treat an empty string as if it wasn't there.
	 */

	if (length == 0) {
	    goto makeTemporary;
	}

	/*
	 * The template only gives a directory if there is a directory
	 * separator in it, and only gives a base name if there's at least one
	 * character after the last directory separator.
	 */

	if (strchr(string, '/') == NULL
		&& (!onWindows || strchr(string, '\\') == NULL)) {
	    /*
	     * No directory separator, so just assume we have a file name.
	     * This is a bit wrong on Windows where we could have problems
	     * with disk name prefixes... but those are much less common in
	     * naked form so we just pass through and let the OS figure it out
	     * instead.
	     */

	    nameBaseObj = templateObj;
	    Tcl_IncrRefCount(nameBaseObj);
	} else if (string[length-1] != '/'
		&& (!onWindows || string[length-1] != '\\')) {
	    /*
	     * If the template has a non-terminal directory separator, split
	     * into dirname and tail.
	     */

	    baseDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
	    nameBaseObj = TclPathPart(interp, templateObj, TCL_PATH_TAIL);
	} else {
	    /*
	     * Otherwise, there must be a terminal directory separator, so
	     * just the directory is given.
	     */

	    baseDirObj = templateObj;
	    Tcl_IncrRefCount(baseDirObj);
	}

	/*
	 * Only allow creation of temporary directories in the native
	 * filesystem since they are frequently used for integration with
	 * external tools or system libraries.
	 */

	if (baseDirObj != NULL && Tcl_FSGetFileSystemForPath(baseDirObj)
		!= &tclNativeFilesystem) {
	    TclDecrRefCount(baseDirObj);
	    baseDirObj = NULL;
	}
    }

    /*
     * Convert empty parts of the template into unspecified parts.
     */

    if (baseDirObj && !TclGetString(baseDirObj)[0]) {
	TclDecrRefCount(baseDirObj);
	baseDirObj = NULL;
    }
    if (nameBaseObj && !TclGetString(nameBaseObj)[0]) {
	TclDecrRefCount(nameBaseObj);
	nameBaseObj = NULL;
    }

    /*
     * Create and open the temporary file.
     */

  makeTemporary:
    dirNameObj = TclpCreateTemporaryDirectory(baseDirObj, nameBaseObj);

    /*
     * If we created pieces of template, get rid of them now.
     */

    if (baseDirObj) {
	TclDecrRefCount(baseDirObj);
    }
    if (nameBaseObj) {
	TclDecrRefCount(nameBaseObj);
    }

    /*
     * Deal with results.
     */

    if (dirNameObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create temporary directory: %s",
		Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, dirNameObj);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclFileName.c.

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
33
34
35
36
37
38
39










40
41
42
43
44
45
46







-
-
-
-
-
-
-
-
-
-







			    Tcl_PathType *typePtr);
static int		SkipToChar(char **stringPtr, int match);
static Tcl_Obj *	SplitWinPath(const char *path);
static Tcl_Obj *	SplitUnixPath(const char *path);
static int		DoGlob(Tcl_Interp *interp, Tcl_Obj *resultPtr,
			    const char *separators, Tcl_Obj *pathPtr, int flags,
			    char *pattern, Tcl_GlobTypeData *types);

/*
 * When there is no support for getting the block size of a file in a stat()
 * call, use this as a guess. Allow it to be overridden in the platform-
 * specific files.
 */

#if (!defined(HAVE_STRUCT_STAT_ST_BLKSIZE) && !defined(GUESSED_BLOCK_SIZE))
#define GUESSED_BLOCK_SIZE	1024
#endif

/*
 *----------------------------------------------------------------------
 *
 * SetResultLength --
 *
 *	Resets the result DString for ExtractWinRoot to accommodate
68
69
70
71
72
73
74
75

76
77

78
79
80
81
82
83
84
58
59
60
61
62
63
64

65
66

67
68
69
70
71
72
73
74







-
+

-
+







SetResultLength(
    Tcl_DString *resultPtr,
    int offset,
    int extended)
{
    Tcl_DStringSetLength(resultPtr, offset);
    if (extended == 2) {
	TclDStringAppendLiteral(resultPtr, "//?/UNC/");
	Tcl_DStringAppend(resultPtr, "//?/UNC/", 8);
    } else if (extended == 1) {
	TclDStringAppendLiteral(resultPtr, "//?/");
	Tcl_DStringAppend(resultPtr, "//?/", 4);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ExtractWinRoot --
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131







-
+








	const char *host, *share, *tail;
	int hlen, slen;

	if (path[1] != '/' && path[1] != '\\') {
	    SetResultLength(resultPtr, offset, extended);
	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    TclDStringAppendLiteral(resultPtr, "/");
	    Tcl_DStringAppend(resultPtr, "/", 1);
	    return &path[1];
	}
	host = &path[2];

	/*
	 * Skip separators.
	 */
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
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







-
+


















-
+

-
+







	     * page). If there are more than one, we are simply assuming they
	     * are superfluous and we trim them away. (An alternative
	     * interpretation would be that it is a host name, but we have
	     * been documented that that is not the case).
	     */

	    *typePtr = TCL_PATH_VOLUME_RELATIVE;
	    TclDStringAppendLiteral(resultPtr, "/");
	    Tcl_DStringAppend(resultPtr, "/", 1);
	    return &path[2];
	}
	SetResultLength(resultPtr, offset, extended);
	share = &host[hlen];

	/*
	 * Skip separators.
	 */

	while (share[0] == '/' || share[0] == '\\') {
	    share++;
	}

	for (slen=0; share[slen]; slen++) {
	    if (share[slen] == '/' || share[slen] == '\\') {
		break;
	    }
	}
	TclDStringAppendLiteral(resultPtr, "//");
	Tcl_DStringAppend(resultPtr, "//", 2);
	Tcl_DStringAppend(resultPtr, host, hlen);
	TclDStringAppendLiteral(resultPtr, "/");
	Tcl_DStringAppend(resultPtr, "/", 1);
	Tcl_DStringAppend(resultPtr, share, slen);

	tail = &share[slen];

	/*
	 * Skip separators.
	 */
217
218
219
220
221
222
223
224

225
226
227
228
229
230
231
207
208
209
210
211
212
213

214
215
216
217
218
219
220
221







-
+








	    while (*tail && (tail[0] == '/' || tail[0] == '\\')) {
		tail++;
	    }

	    *typePtr = TCL_PATH_ABSOLUTE;
	    Tcl_DStringAppend(resultPtr, path, 2);
	    TclDStringAppendLiteral(resultPtr, "/");
	    Tcl_DStringAppend(resultPtr, "/", 1);

	    return tail;
	}
    } else {
	int abs = 0;

	/*
382
383
384
385
386
387
388

389

390
391
392
393
394
395
396
372
373
374
375
376
377
378
379

380
381
382
383
384
385
386
387







+
-
+







TclpGetNativePathType(
    Tcl_Obj *pathPtr,		/* Native path of interest */
    int *driveNameLengthPtr,	/* Returns length of drive, if non-NULL and
				 * path was absolute */
    Tcl_Obj **driveNameRef)
{
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    int pathLen;
    const char *path = TclGetString(pathPtr);
    const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);

    if (path[0] == '~') {
	/*
	 * This case is common to all platforms. Paths that begin with ~ are
	 * absolute.
	 */

451
452
453
454
455
456
457
458


459
460
461
462
463
464
465
442
443
444
445
446
447
448

449
450
451
452
453
454
455
456
457







-
+
+







	    const char *rootEnd;

	    Tcl_DStringInit(&ds);
	    rootEnd = ExtractWinRoot(path, &ds, 0, &type);
	    if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
		*driveNameLengthPtr = rootEnd - path;
		if (driveNameRef != NULL) {
		    *driveNameRef = TclDStringToObj(&ds);
		    *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
			    Tcl_DStringLength(&ds));
		    Tcl_IncrRefCount(*driveNameRef);
		}
	    }
	    Tcl_DStringFree(&ds);
	    break;
	}
	}
499
500
501
502
503
504
505
506

507
508
509
510

511
512
513
514
515
516
517
491
492
493
494
495
496
497

498
499
500
501

502
503
504
505
506
507
508
509







-
+



-
+








    /*
     * Perform platform specific splitting.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	resultPtr = SplitUnixPath(TclGetString(pathPtr));
	resultPtr = SplitUnixPath(Tcl_GetString(pathPtr));
	break;

    case TCL_PLATFORM_WINDOWS:
	resultPtr = SplitWinPath(TclGetString(pathPtr));
	resultPtr = SplitWinPath(Tcl_GetString(pathPtr));
	break;
    }

    /*
     * Compute the number of elements in the result.
     */

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
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







-
+



















-
-
+




















-
+








-
+










-
+







 * Results:
 *	Returns a standard Tcl result. The interpreter result contains a list
 *	of path components. *argvPtr will be filled in with the address of an
 *	array whose elements point to the elements of path, in order.
 *	*argcPtr will get filled in with the number of valid elements in the
 *	array. A single block of memory is dynamically allocated to hold both
 *	the argv array and a copy of the path elements. The caller must
 *	eventually free this memory by calling Tcl_Free() on *argvPtr. Note:
 *	eventually free this memory by calling ckfree() on *argvPtr. Note:
 *	*argvPtr and *argcPtr are only modified if the procedure returns
 *	normally.
 *
 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SplitPath(
    const char *path,		/* Pointer to string containing a path. */
    int *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the path. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to path elements. */
{
    Tcl_Obj *resultPtr = NULL;	/* Needed only to prevent gcc warnings. */
    Tcl_Obj *tmpPtr, *eltPtr;
    int i;
    size_t size, len;
    int i, size, len;
    char *p;
    const char *str;

    /*
     * Perform the splitting, using objectified, vfs-aware code.
     */

    tmpPtr = Tcl_NewStringObj(path, -1);
    Tcl_IncrRefCount(tmpPtr);
    resultPtr = Tcl_FSSplitPath(tmpPtr, argcPtr);
    Tcl_IncrRefCount(resultPtr);
    Tcl_DecrRefCount(tmpPtr);

    /*
     * Calculate space required for the result.
     */

    size = 1;
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	(void)TclGetStringFromObj(eltPtr, &len);
	Tcl_GetStringFromObj(eltPtr, &len);
	size += len + 1;
    }

    /*
     * Allocate a buffer large enough to hold the contents of all of the list
     * plus the argv pointers and the terminating NULL pointer.
     */

    *argvPtr = (const char **)Tcl_Alloc(
    *argvPtr = (const char **) ckalloc(
	    ((((*argcPtr) + 1) * sizeof(char *)) + size));

    /*
     * Position p after the last argv pointer and copy the contents of the
     * list in, piece by piece.
     */

    p = (char *) &(*argvPtr)[(*argcPtr) + 1];
    for (i = 0; i < *argcPtr; i++) {
	Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
	str = TclGetStringFromObj(eltPtr, &len);
	str = Tcl_GetStringFromObj(eltPtr, &len);
	memcpy(p, str, len + 1);
	p += len+1;
    }

    /*
     * Now set up the argv pointers.
     */
639
640
641
642
643
644
645
646

647
648
649
650
651
652
653
630
631
632
633
634
635
636

637
638
639
640
641
642
643
644







-
+







 *----------------------------------------------------------------------
 */

static Tcl_Obj *
SplitUnixPath(
    const char *path)		/* Pointer to string containing a path. */
{
    size_t length;
    int length;
    const char *origPath = path, *elementStart;
    Tcl_Obj *result;

    /*
     * Deal with the root directory as a special case.
     */

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
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







-
+














-
+
+







 *----------------------------------------------------------------------
 */

static Tcl_Obj *
SplitWinPath(
    const char *path)		/* Pointer to string containing a path. */
{
    size_t length;
    int length;
    const char *p, *elementStart;
    Tcl_PathType type = TCL_PATH_ABSOLUTE;
    Tcl_DString buf;
    Tcl_Obj *result;
    Tcl_DStringInit(&buf);

    TclNewObj(result);
    p = ExtractWinRoot(path, &buf, 0, &type);

    /*
     * Terminate the root portion, if we matched something.
     */

    if (p != path) {
	Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf));
	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
		Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)));
    }
    Tcl_DStringFree(&buf);

    /*
     * Split on slashes. Embedded elements that start with tilde or a drive
     * letter will be prefixed with "./" so they are not affected by tilde
     * substitution.
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
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







+
+
+

-
+
+
+

-
-
-
-
-
-
+
+
+
+
-
-
-
+
-
-
-

+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-








Tcl_Obj *
Tcl_FSJoinToPath(
    Tcl_Obj *pathPtr,		/* Valid path or NULL. */
    int objc,			/* Number of array elements to join */
    Tcl_Obj *const objv[])	/* Path elements to join. */
{
    int i;
    Tcl_Obj *lobj, *ret;

    if (pathPtr == NULL) {
	return TclJoinPath(objc, objv, 0);
	lobj = Tcl_NewListObj(0, NULL);
    } else {
	lobj = Tcl_NewListObj(1, &pathPtr);
    }
    if (objc == 0) {
	return TclJoinPath(1, &pathPtr, 0);
    }
    if (objc == 1) {
	Tcl_Obj *pair[2];


    for (i = 0; i<objc;i++) {
	Tcl_ListObjAppendElement(NULL, lobj, objv[i]);
    }
	pair[0] = pathPtr;
	pair[1] = objv[0];
	return TclJoinPath(2, pair, 0);
    ret = Tcl_FSJoinPath(lobj, -1);
    } else {
	int elemc = objc + 1;
	Tcl_Obj *ret, **elemv = (Tcl_Obj**)Tcl_Alloc(elemc*sizeof(Tcl_Obj *));

    /*
     * It is possible that 'ret' is just a member of the list and is therefore
	elemv[0] = pathPtr;
	memcpy(elemv+1, objv, objc*sizeof(Tcl_Obj *));
	ret = TclJoinPath(elemc, elemv, 0);
	Tcl_Free(elemv);
	return ret;
     * going to be freed here. Therefore we must adjust the refCount manually.
     * (It would be better if we changed the documentation of this function
     * and Tcl_FSJoinPath so that the returned object already has a refCount
     * for the caller, hence avoiding these subtleties (and code ugliness)).
     */

    Tcl_IncrRefCount(ret);
    Tcl_DecrRefCount(lobj);
    ret->refCount--;
    return ret;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpNativeJoinPath --
 *
851
852
853
854
855
856
857
858
859

860
861
862
863
864

865
866
867
868
869
870
871
847
848
849
850
851
852
853


854
855
856
857
858

859
860
861
862
863
864
865
866







-
-
+




-
+







 */

void
TclpNativeJoinPath(
    Tcl_Obj *prefix,
    const char *joining)
{
    int needsSep;
    size_t length;
    int length, needsSep;
    char *dest;
    const char *p;
    const char *start;

    start = TclGetStringFromObj(prefix, &length);
    start = Tcl_GetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

    p = joining;
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
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







-
+









-
+













-
+











-
+








-
+













-
+







    case TCL_PLATFORM_UNIX:
	/*
	 * Append a separator if needed.
	 */

	if (length > 0 && (start[length-1] != '/')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)TclGetStringFromObj(prefix, &length);
	    Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

	Tcl_SetObjLength(prefix, length + (int) strlen(p));

	dest = TclGetString(prefix) + length;
	dest = Tcl_GetString(prefix) + length;
	for (; *p != '\0'; p++) {
	    if (*p == '/') {
		while (p[1] == '/') {
		    p++;
		}
		if (p[1] != '\0' && needsSep) {
		    *dest++ = '/';
		}
	    } else {
		*dest++ = *p;
		needsSep = 1;
	    }
	}
	length = dest - TclGetString(prefix);
	length = dest - Tcl_GetString(prefix);
	Tcl_SetObjLength(prefix, length);
	break;

    case TCL_PLATFORM_WINDOWS:
	/*
	 * Check to see if we need to append a separator.
	 */

	if ((length > 0) &&
		(start[length-1] != '/') && (start[length-1] != ':')) {
	    Tcl_AppendToObj(prefix, "/", 1);
	    (void)TclGetStringFromObj(prefix, &length);
	    Tcl_GetStringFromObj(prefix, &length);
	}
	needsSep = 0;

	/*
	 * Append the element, eliminating duplicate and trailing slashes.
	 */

	Tcl_SetObjLength(prefix, length + (int) strlen(p));
	dest = TclGetString(prefix) + length;
	dest = Tcl_GetString(prefix) + length;
	for (; *p != '\0'; p++) {
	    if ((*p == '/') || (*p == '\\')) {
		while ((p[1] == '/') || (p[1] == '\\')) {
		    p++;
		}
		if ((p[1] != '\0') && needsSep) {
		    *dest++ = '/';
		}
	    } else {
		*dest++ = *p;
		needsSep = 1;
	    }
	}
	length = dest - TclGetString(prefix);
	length = dest - Tcl_GetString(prefix);
	Tcl_SetObjLength(prefix, length);
	break;
    }
    return;
}

/*
976
977
978
979
980
981
982
983

984
985
986
987
988
989
990
991
971
972
973
974
975
976
977

978

979
980
981
982
983
984
985







-
+
-








char *
Tcl_JoinPath(
    int argc,
    const char *const *argv,
    Tcl_DString *resultPtr)	/* Pointer to previously initialized DString */
{
    int i;
    int i, len;
    size_t len;
    Tcl_Obj *listObj;
    Tcl_Obj *resultObj;
    const char *resultStr;

    /*
     * Build the list of paths.
     */
1005
1006
1007
1008
1009
1010
1011
1012

1013
1014
1015
1016
1017
1018
1019
999
1000
1001
1002
1003
1004
1005

1006
1007
1008
1009
1010
1011
1012
1013







-
+







    Tcl_IncrRefCount(resultObj);
    Tcl_DecrRefCount(listObj);

    /*
     * Store the result.
     */

    resultStr = TclGetStringFromObj(resultObj, &len);
    resultStr = Tcl_GetStringFromObj(resultObj, &len);
    Tcl_DStringAppend(resultPtr, resultStr, len);
    Tcl_DecrRefCount(resultObj);

    /*
     * Return a pointer to the result.
     */

1064
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
1058
1059
1060
1061
1062
1063
1064

1065
1066
1067
1068
1069
1070
1071
1072







-
+







    transPtr = Tcl_FSGetTranslatedPath(interp, path);
    if (transPtr == NULL) {
	Tcl_DecrRefCount(path);
	return NULL;
    }

    Tcl_DStringInit(bufferPtr);
    TclDStringAppendObj(bufferPtr, transPtr);
    Tcl_DStringAppend(bufferPtr, Tcl_GetString(transPtr), -1);
    Tcl_DecrRefCount(path);
    Tcl_DecrRefCount(transPtr);

    /*
     * Convert forward slashes to backslashes in Windows paths because some
     * system interfaces don't accept forward slashes.
     */
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
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







-
-
-
+
+
+
-








-
+
-
-
+








    if (*user == '\0') {
	Tcl_DString dirString;

	dir = TclGetEnv("HOME", &dirString);
	if (dir == NULL) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"couldn't find HOME environment "
			"variable to expand path", -1));
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't find HOME environment "
			"variable to expand path", NULL);
		Tcl_SetErrorCode(interp, "TCL", "FILENAME", "NO_HOME", NULL);
	    }
	    return NULL;
	}
	Tcl_JoinPath(1, &dir, resultPtr);
	Tcl_DStringFree(&dirString);
    } else if (TclpGetUserHome(user, resultPtr) == NULL) {
	if (interp) {
	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    Tcl_AppendResult(interp, "user \"", user, "\" doesn't exist",
		    "user \"%s\" doesn't exist", user));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "USER", user, NULL);
		    NULL);
	}
	return NULL;
    }
    return Tcl_DStringValue(resultPtr);
}

/*
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
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







-
+







-
+


-
+









+








-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GlobObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index, i, globFlags, length, join, dir, result;
    char *string;
    const char *separators;
    Tcl_Obj *typePtr, *look;
    Tcl_Obj *typePtr, *resultPtr, *look;
    Tcl_Obj *pathOrDir = NULL;
    Tcl_DString prefix;
    static const char *const options[] = {
    static const char *options[] = {
	"-directory", "-join", "-nocomplain", "-path", "-tails",
	"-types", "--", NULL
    };
    enum globOptionsEnum {
	GLOB_DIR, GLOB_JOIN, GLOB_NOCOMPLAIN, GLOB_PATH, GLOB_TAILS,
	GLOB_TYPE, GLOB_LAST
    };
    enum pathDirOptions {PATH_NONE = -1 , PATH_GENERAL = 0, PATH_DIR = 1};
    Tcl_GlobTypeData *globTypes = NULL;
    (void)dummy;

    globFlags = 0;
    join = 0;
    dir = PATH_NONE;
    typePtr = NULL;
    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		&index) != TCL_OK) {
	    string = TclGetString(objv[i]);
	    string = Tcl_GetStringFromObj(objv[i], &length);
	    if (string[0] == '-') {
		/*
		 * It looks like the command contains an option so signal an
		 * error.
		 */

		return TCL_ERROR;
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
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
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
1348
1349
1350
1351
1352
1353
1354
1355
1356

1357
1358

1359
1360
1361
1362
1363
1364
1365
1366







-








-
-

















-








-
-










-















+
+
+
+

-
+

-
+
-
-














-
+

-
+







	case GLOB_NOCOMPLAIN:			/* -nocomplain */
	    globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
	    break;
	case GLOB_DIR:				/* -dir */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-directory\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			dir == PATH_DIR
			    ? "\"-directory\" may only be used once"
			    : "\"-directory\" cannot be used with \"-path\"",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
			"BADOPTIONCOMBINATION", NULL);
		return TCL_ERROR;
	    }
	    dir = PATH_DIR;
	    globFlags |= TCL_GLOBMODE_DIR;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_JOIN:				/* -join */
	    join = 1;
	    break;
	case GLOB_TAILS:				/* -tails */
	    globFlags |= TCL_GLOBMODE_TAILS;
	    break;
	case GLOB_PATH:				/* -path */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-path\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			dir == PATH_GENERAL
			    ? "\"-path\" may only be used once"
			    : "\"-path\" cannot be used with \"-dictionary\"",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
			"BADOPTIONCOMBINATION", NULL);
		return TCL_ERROR;
	    }
	    dir = PATH_GENERAL;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_TYPE:				/* -types */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-types\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    typePtr = objv[i+1];
	    if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    i++;
	    break;
	case GLOB_LAST:				/* -- */
	    i++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if (objc - i < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?switches? name ?name ...?");
	return TCL_ERROR;
    }
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	Tcl_AppendResult(interp,
		"\"-tails\" must be used with either "
		"\"-directory\" or \"-path\"", -1));
		"\"-directory\" or \"-path\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
		"BADOPTIONCOMBINATION", NULL);
	return TCL_ERROR;
    }

    separators = NULL;
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	separators = "/";
	break;
    case TCL_PLATFORM_WINDOWS:
	separators = "/\\:";
	break;
    }

    if (dir == PATH_GENERAL) {
	size_t pathlength;
	int pathlength;
	const char *last;
	const char *first = TclGetStringFromObj(pathOrDir,&pathlength);
	const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);

	/*
	 * Find the last path separator in the path
	 */

	last = first + pathlength;
	for (; last != first; last--) {
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
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







-
+












-
+







		/*
		 * We must ensure that we haven't cut off too much, and turned
		 * a valid path like '/' or 'C:/' into an incorrect path like
		 * '' or 'C:'. The way we do this is to add a separator if
		 * there are none presently in the prefix.
		 */

		if (strpbrk(TclGetString(pathOrDir), "\\/") == NULL) {
		if (strpbrk(Tcl_GetString(pathOrDir), "\\/") == NULL) {
		    Tcl_AppendToObj(pathOrDir, last-1, 1);
		}
	    }

	    /*
	     * Need to quote 'prefix'.
	     */

	    Tcl_DStringInit(&prefix);
	    search = Tcl_DStringValue(&pref);
	    while ((find = (strpbrk(search, "\\[]*?{}"))) != NULL) {
		Tcl_DStringAppend(&prefix, search, find-search);
		TclDStringAppendLiteral(&prefix, "\\");
		Tcl_DStringAppend(&prefix, "\\", 1);
		Tcl_DStringAppend(&prefix, find, 1);
		search = find+1;
		if (*search == '\0') {
		    break;
		}
	    }
	    if (*search != '\0') {
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
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







-
+
+






-
+



-
+







	 * platform.
	 */

	Tcl_ListObjLength(interp, typePtr, &length);
	if (length <= 0) {
	    goto skipTypes;
	}
	globTypes = (Tcl_GlobTypeData *)TclStackAlloc(interp, sizeof(Tcl_GlobTypeData));
	globTypes = (Tcl_GlobTypeData *)
		TclStackAlloc(interp,sizeof(Tcl_GlobTypeData));
	globTypes->type = 0;
	globTypes->perm = 0;
	globTypes->macType = NULL;
	globTypes->macCreator = NULL;

	while (--length >= 0) {
	    size_t len;
	    int len;
	    const char *str;

	    Tcl_ListObjIndex(interp, typePtr, length, &look);
	    str = TclGetStringFromObj(look, &len);
	    str = Tcl_GetStringFromObj(look, &len);
	    if (strcmp("readonly", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_RONLY;
	    } else if (strcmp("hidden", str) == 0) {
		globTypes->perm |= TCL_GLOB_PERM_HIDDEN;
	    } else if (len == 1) {
		switch (str[0]) {
		case 'r':
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531


1532
1533

1534
1535

1536
1537
1538
1539
1540
1541
1542
1543

1544
1545
1546
1547
1548
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
1510
1511
1512
1513
1514
1515
1516

1517


1518
1519
1520

1521
1522

1523
1524
1525
1526
1527
1528
1529
1530

1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548




1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561

1562
1563
1564
1565
1566
1567
1568







-

-
-
+
+

-
+

-
+







-
+

















-
-
-
-
+
+
+
+









-







		    goto badMacTypesArg;
		}
		globTypes->macType = look;
		Tcl_IncrRefCount(look);

	    } else {
		Tcl_Obj *item;
		int llen;

		if ((Tcl_ListObjLength(NULL, look, &llen) == TCL_OK)
			&& (llen == 3)) {
		if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
			&& (len == 3)) {
		    Tcl_ListObjIndex(interp, look, 0, &item);
		    if (!strcmp("macintosh", TclGetString(item))) {
		    if (!strcmp("macintosh", Tcl_GetString(item))) {
			Tcl_ListObjIndex(interp, look, 1, &item);
			if (!strcmp("type", TclGetString(item))) {
			if (!strcmp("type", Tcl_GetString(item))) {
			    Tcl_ListObjIndex(interp, look, 2, &item);
			    if (globTypes->macType != NULL) {
				goto badMacTypesArg;
			    }
			    globTypes->macType = item;
			    Tcl_IncrRefCount(item);
			    continue;
			} else if (!strcmp("creator", TclGetString(item))) {
			} else if (!strcmp("creator", Tcl_GetString(item))) {
			    Tcl_ListObjIndex(interp, look, 2, &item);
			    if (globTypes->macCreator != NULL) {
				goto badMacTypesArg;
			    }
			    globTypes->macCreator = item;
			    Tcl_IncrRefCount(item);
			    continue;
			}
		    }
		}

		/*
		 * Error cases. We reset the 'join' flag to zero, since we
		 * haven't yet made use of it.
		 */

	    badTypesArg:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad argument to \"-types\": %s",
			TclGetString(look)));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
		TclNewObj(resultPtr);
		Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
		Tcl_AppendObjToObj(resultPtr, look);
		Tcl_SetObjResult(interp, resultPtr);
		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"only one MacOS type or creator argument"
			" to \"-types\" allowed", -1));
		result = TCL_ERROR;
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
		join = 0;
		goto endOfGlob;
	    }
	}
    }

  skipTypes:
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
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
1668
1669
1670
1671
1672
1673
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
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







+
-
+












-

-
+

-
+
+

+
-
+










-
+




















-
-
-
+
+
-

-
+


-

-
-
+
+



-
-
+
-
-







    result = TCL_OK;

    if (join) {
	if (dir != PATH_GENERAL) {
	    Tcl_DStringInit(&prefix);
	}
	for (i = 0; i < objc; i++) {
	    string = Tcl_GetStringFromObj(objv[i], &length);
	    TclDStringAppendObj(&prefix, objv[i]);
	    Tcl_DStringAppend(&prefix, string, length);
	    if (i != objc -1) {
		Tcl_DStringAppend(&prefix, separators, 1);
	    }
	}
	if (TclGlob(interp, Tcl_DStringValue(&prefix), pathOrDir, globFlags,
		globTypes) != TCL_OK) {
	    result = TCL_ERROR;
	    goto endOfGlob;
	}
    } else if (dir == PATH_GENERAL) {
	Tcl_DString str;

	Tcl_DStringInit(&str);
	for (i = 0; i < objc; i++) {
	    Tcl_DStringSetLength(&str, 0);
	    Tcl_DStringInit(&str);
	    if (dir == PATH_GENERAL) {
		TclDStringAppendDString(&str, &prefix);
		Tcl_DStringAppend(&str, Tcl_DStringValue(&prefix),
			Tcl_DStringLength(&prefix));
	    }
	    string = Tcl_GetStringFromObj(objv[i], &length);
	    TclDStringAppendObj(&str, objv[i]);
	    Tcl_DStringAppend(&str, string, length);
	    if (TclGlob(interp, Tcl_DStringValue(&str), pathOrDir, globFlags,
		    globTypes) != TCL_OK) {
		result = TCL_ERROR;
		Tcl_DStringFree(&str);
		goto endOfGlob;
	    }
	}
	Tcl_DStringFree(&str);
    } else {
	for (i = 0; i < objc; i++) {
	    string = TclGetString(objv[i]);
	    string = Tcl_GetString(objv[i]);
	    if (TclGlob(interp, string, pathOrDir, globFlags,
		    globTypes) != TCL_OK) {
		result = TCL_ERROR;
		goto endOfGlob;
	    }
	}
    }

    if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) {
	if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp),
		&length) != TCL_OK) {
	    /*
	     * This should never happen. Maybe we should be more dramatic.
	     */

	    result = TCL_ERROR;
	    goto endOfGlob;
	}

	if (length == 0) {
	    Tcl_Obj *errorMsg =
		    Tcl_ObjPrintf("no files matched glob pattern%s \"",
			    (join || (objc == 1)) ? "" : "s");
	    Tcl_AppendResult(interp, "no files matched glob pattern",
		    (join || (objc == 1)) ? " \"" : "s \"", NULL);

	    if (join) {
		Tcl_AppendToObj(errorMsg, Tcl_DStringValue(&prefix), -1);
		Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
	    } else {
		const char *sep = "";

		for (i = 0; i < objc; i++) {
		    Tcl_AppendPrintfToObj(errorMsg, "%s%s",
			    sep, TclGetString(objv[i]));
		    string = Tcl_GetString(objv[i]);
		    Tcl_AppendResult(interp, sep, string, NULL);
		    sep = " ";
		}
	    }
	    Tcl_AppendToObj(errorMsg, "\"", -1);
	    Tcl_SetObjResult(interp, errorMsg);
	    Tcl_AppendResult(interp, "\"", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
		    NULL);
	    result = TCL_ERROR;
	}
    }

  endOfGlob:
    if (join || (dir == PATH_GENERAL)) {
	Tcl_DStringFree(&prefix);
1780
1781
1782
1783
1784
1785
1786
1787


1788
1789
1790
1791
1792
1793
1794
1763
1764
1765
1766
1767
1768
1769

1770
1771
1772
1773
1774
1775
1776
1777
1778







-
+
+







	    *tail = c;
	    if (head == NULL) {
		return TCL_ERROR;
	    }
	    if (head != Tcl_DStringValue(&buffer)) {
		Tcl_DStringAppend(&buffer, head, -1);
	    }
	    pathPrefix = TclDStringToObj(&buffer);
	    pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
		    Tcl_DStringLength(&buffer));
	    Tcl_IncrRefCount(pathPrefix);
	    globFlags |= TCL_GLOBMODE_DIR;
	    if (c != '\0') {
		tail++;
	    }
	    Tcl_DStringFree(&buffer);
	} else {
1853
1854
1855
1856
1857
1858
1859
1860

1861
1862
1863
1864
1865
1866
1867
1837
1838
1839
1840
1841
1842
1843

1844
1845
1846
1847
1848
1849
1850
1851







-
+








		Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

		if (cwd == NULL) {
		    Tcl_DecrRefCount(temp);
		    return TCL_ERROR;
		}
		pathPrefix = Tcl_NewStringObj(TclGetString(cwd), 3);
		pathPrefix = Tcl_NewStringObj(Tcl_GetString(cwd), 3);
		Tcl_DecrRefCount(cwd);
		if (tail[0] == '/') {
		    tail++;
		} else {
		    tail += 2;
		}
		Tcl_IncrRefCount(pathPrefix);
1887
1888
1889
1890
1891
1892
1893
1894

1895
1896
1897
1898
1899
1900
1901
1871
1872
1873
1874
1875
1876
1877

1878
1879
1880
1881
1882
1883
1884
1885







-
+







	 * ':' no longer needed as a separator. It is only relevant to the
	 * beginning of the path.
	 */

	separators = "/\\";

    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
	if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
	if (pathPrefix == NULL && tail[0] == '/') {
	    pathPrefix = Tcl_NewStringObj(tail, 1);
	    tail++;
	    Tcl_IncrRefCount(pathPrefix);
	}
    }

    /*
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
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







-
+










-
+
















-
-
+
+







     *
     * We do it by rewriting the result list in-place.
     */

    if (globFlags & TCL_GLOBMODE_TAILS) {
	int objc, i;
	Tcl_Obj **objv;
	size_t prefixLen;
	int prefixLen;
	const char *pre;

	/*
	 * If this length has never been set, set it here.
	 */

	if (pathPrefix == NULL) {
	    Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
	}

	pre = TclGetStringFromObj(pathPrefix, &prefixLen);
	pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
	if (prefixLen > 0
		&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
	    /*
	     * If we're on Windows and the prefix is a volume relative one
	     * like 'C:', then there won't be a path separator in between, so
	     * no need to skip it here.
	     */

	    if ((tclPlatform != TCL_PLATFORM_WINDOWS) || (prefixLen != 2)
		    || (pre[1] != ':')) {
		prefixLen++;
	    }
	}

	Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
	for (i = 0; i< objc; i++) {
	    size_t len;
	    const char *oldStr = TclGetStringFromObj(objv[i], &len);
	    int len;
	    const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
	    Tcl_Obj *elem;

	    if (len == prefixLen) {
		if ((pattern[0] == '\0')
			|| (strchr(separators, pattern[0]) == NULL)) {
		    TclNewLiteralStringObj(elem, ".");
		} else {
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
2208
2209
2210
2211
2212
2213
2214


2215


2216
2217
2218
2219


2220


2221
2222
2223
2224
2225
2226
2227
2228







-
-
+
-
-
+



-
-
+
-
-
+







		/*
		 * Balanced braces.
		 */

		closeBrace = p;
		break;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched open-brace in file name", -1));
	    Tcl_SetResult(interp, "unmatched open-brace in file name",
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
		    TCL_STATIC);
	    return TCL_ERROR;

	} else if (*p == '}') {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched close-brace in file name", -1));
	    Tcl_SetResult(interp, "unmatched close-brace in file name",
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
		    TCL_STATIC);
	    return TCL_ERROR;
	}
    }

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */
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
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







-
+
















-
+



-
+


















-
+


















-
+









-
+

-
+








-
+

-
+










-
+
+










-
-
+
+







	    Tcl_Obj **subdirv;

	    result = Tcl_ListObjGetElements(interp, subdirsPtr,
		    &subdirc, &subdirv);
	    for (i=0; result==TCL_OK && i<subdirc; i++) {
		Tcl_Obj *copy = NULL;

		if (pathPtr == NULL && TclGetString(subdirv[i])[0] == '~') {
		if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') {
		    Tcl_ListObjLength(NULL, matchesObj, &repair);
		    copy = subdirv[i];
		    subdirv[i] = Tcl_NewStringObj("./", 2);
		    Tcl_AppendObjToObj(subdirv[i], copy);
		    Tcl_IncrRefCount(subdirv[i]);
		}
		result = DoGlob(interp, matchesObj, separators, subdirv[i],
			1, p+1, types);
		if (copy) {
		    int end;

		    Tcl_DecrRefCount(subdirv[i]);
		    subdirv[i] = copy;
		    Tcl_ListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			const char *bytes;
			size_t numBytes;
			int numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = TclGetStringFromObj(fixme, &numBytes);
			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') {
	size_t length;
	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) TclGetStringFromObj(pathPtr, &length);
	    (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 == '/')) {
		    TclDStringAppendLiteral(&append, "/");
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    TclDStringAppendLiteral(&append, ".");
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }

	    break;

	case TCL_PLATFORM_UNIX:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    TclDStringAppendLiteral(&append, "/");
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    TclDStringAppendLiteral(&append, ".");
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }
	    break;
	}

	/*
	 * Common for all platforms.
	 */

	if (pathPtr == NULL) {
	    joinedPtr = TclDStringToObj(&append);
	    joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else if (flags) {
	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else {
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*
		 * The current prefix must end in a separator.
		 */

		size_t len;
		const char *joined = TclGetStringFromObj(joinedPtr,&len);
		int len;
		const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);

		if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	    Tcl_AppendToObj(joinedPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
2488
2489
2490
2491
2492
2493
2494
2495
2496


2497
2498
2499
2500
2501
2502
2503
2469
2470
2471
2472
2473
2474
2475


2476
2477
2478
2479
2480
2481
2482
2483
2484







-
-
+
+







	     * The current prefix must end in a separator, unless this is a
	     * volume-relative path. In particular globbing in Windows shares,
	     * when not using -dir or -path, e.g. 'glob [file join
	     * //machine/share/subdir *]' requires adding a separator here.
	     * This behaviour is not currently tested for in the test suite.
	     */

	    size_t len;
	    const char *joined = TclGetStringFromObj(joinedPtr,&len);
	    int len;
	    const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);

	    if ((len > 0) && (strchr(separators, joined[len-1]) == NULL)) {
		if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
		    Tcl_AppendToObj(joinedPtr, "/", 1);
		}
	    }
	}
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
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







-
+










-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








 *
 *	This procedure allocates a Tcl_StatBuf on the heap. It exists so that
 *	extensions may be used unchanged on systems where largefile support is
 *	optional.
 *
 * Results:
 *	A pointer to a Tcl_StatBuf which may be deallocated by being passed to
 *	Tcl_Free().
 *	ckfree().
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_StatBuf *
Tcl_AllocStatBuf(void)
{
    return (Tcl_StatBuf *)Tcl_Alloc(sizeof(Tcl_StatBuf));
    return (Tcl_StatBuf *)ckalloc(sizeof(Tcl_StatBuf));
}

/*
 *---------------------------------------------------------------------------
 *
 * Access functions for Tcl_StatBuf --
 *
 *	These functions provide portable read-only access to the portable
 *	fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
 *	stat64' or something else related). [TIP #316]
 *
 * Results:
 *	The value from the field being retrieved.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

unsigned
Tcl_GetFSDeviceFromStat(
    const Tcl_StatBuf *statPtr)
{
    return statPtr->st_dev;
}

unsigned
Tcl_GetFSInodeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return statPtr->st_ino;
}

unsigned
Tcl_GetModeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return statPtr->st_mode;
}

int
Tcl_GetLinkCountFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int)statPtr->st_nlink;
}

int
Tcl_GetUserIdFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int) statPtr->st_uid;
}

int
Tcl_GetGroupIdFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int) statPtr->st_gid;
}

int
Tcl_GetDeviceTypeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (int) statPtr->st_rdev;
}

Tcl_WideInt
Tcl_GetAccessTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_atime;
}

Tcl_WideInt
Tcl_GetModificationTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_mtime;
}

Tcl_WideInt
Tcl_GetChangeTimeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideInt) statPtr->st_ctime;
}

Tcl_WideUInt
Tcl_GetSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return (Tcl_WideUInt) statPtr->st_size;
}

Tcl_WideUInt
Tcl_GetBlocksFromStat(
    const Tcl_StatBuf *statPtr)
{
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
    return (Tcl_WideUInt) statPtr->st_blocks;
#else
    unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);

    return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
#endif
}

#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
unsigned
Tcl_GetBlockSizeFromStat(
    const Tcl_StatBuf *statPtr)
{
    return statPtr->st_blksize;
}
#else
unsigned
Tcl_GetBlockSizeFromStat(
    TCL_UNUSED(const Tcl_StatBuf *))
{
    /*
     * Not a great guess, but will do...
     */

    return GUESSED_BLOCK_SIZE;
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclFileSystem.h.

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
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







-
+

-
+


-
+





-
+







-
+

-
-
+
+


-
+

-
+


-
+





-
+








MODULE_SCOPE int	TclFSCwdPointerEquals(Tcl_Obj **pathPtrPtr);
MODULE_SCOPE int	TclFSNormalizeToUniquePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int startAt);
MODULE_SCOPE Tcl_Obj *	TclFSMakePathRelative(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, Tcl_Obj *cwdPtr);
MODULE_SCOPE int	TclFSEnsureEpochOk(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **fsPtrPtr);
			    Tcl_Filesystem **fsPtrPtr);
MODULE_SCOPE void	TclFSSetPathDetails(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem *fsPtr, void *clientData);
			    Tcl_Filesystem *fsPtr, ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclFSNormalizeAbsolutePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
MODULE_SCOPE size_t	TclFSEpoch(void);
MODULE_SCOPE int	TclFSEpoch(void);

/*
 * Private shared variables for use by tclIOUtil.c and tclPathObj.c
 */

MODULE_SCOPE const Tcl_Filesystem tclNativeFilesystem;
MODULE_SCOPE Tcl_Filesystem tclNativeFilesystem;

/*
 * Private shared functions for use by tclIOUtil.c, tclPathObj.c and
 * tclFileName.c, and any platform-specific filesystem code.
 */

MODULE_SCOPE Tcl_PathType TclFSGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    Tcl_Filesystem **filesystemPtrPtr,
			    int *driveNameLengthPtr);
MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(const char *pathPtr,
			    int pathLen, const Tcl_Filesystem **filesystemPtrPtr,
MODULE_SCOPE Tcl_PathType TclFSNonnativePathType(CONST char *pathPtr,
			    int pathLen, Tcl_Filesystem **filesystemPtrPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE Tcl_PathType TclGetPathType(Tcl_Obj *pathPtr,
			    const Tcl_Filesystem **filesystemPtrPtr,
			    Tcl_Filesystem **filesystemPtrPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclFSEpochOk(size_t filesystemEpoch);
MODULE_SCOPE int	TclFSEpochOk(int filesystemEpoch);
MODULE_SCOPE int	TclFSCwdIsNative(void);
MODULE_SCOPE Tcl_Obj *	TclWinVolumeRelativeNormalize(Tcl_Interp *interp,
			    const char *path, Tcl_Obj **useThisCwdPtr);
			    CONST char *path, Tcl_Obj **useThisCwdPtr);

MODULE_SCOPE Tcl_FSPathInFilesystemProc TclNativePathInFilesystem;
MODULE_SCOPE Tcl_FSCreateInternalRepProc TclNativeCreateNativeRep;

#endif /* _TCLFILESYSTEM */


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclGet.c.

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
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







-
+
















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetInt(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    const char *src,		/* String containing a (possibly signed)
    CONST char *src,		/* String containing a (possibly signed)
				 * integer in a form acceptable to
				 * Tcl_GetIntFromObj(). */
    int *intPtr)		/* Place to store converted result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
    obj.length = strlen(src);
    obj.typePtr = NULL;

    code = Tcl_GetIntFromObj(interp, &obj, intPtr);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    TclFreeIntRep(&obj);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetLong --
 *
 *	Given a string, produce the corresponding long integer value. This
 *	routine is a version of Tcl_GetInt but returns a "long" instead of an
 *	"int" (a difference that matters on 64-bit architectures).
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *longPtr will be set
 *	to the long integer value equivalent to src. If src is improperly
 *	formed then TCL_ERROR is returned and an error message will be left in
 *	the interp's result if interp is non-NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetLong(
    Tcl_Interp *interp,		/* Interpreter used for error reporting if not
				 * NULL. */
    CONST char *src,		/* String containing a (possibly signed) long
				 * integer in a form acceptable to
				 * Tcl_GetLongFromObj(). */
    long *longPtr)		/* Place to store converted long result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
    obj.length = strlen(src);
    obj.typePtr = NULL;

    code = Tcl_GetLongFromObj(interp, &obj, longPtr);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    TclFreeIntRep(&obj);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
76
77
78
79
80
81
82
83
84


85
86
87
88
89
90
91
122
123
124
125
126
127
128


129
130
131
132
133
134
135
136
137







-
-
+
+







 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetDouble(
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    const char *src,		/* String containing a floating-point number
				 * in a form acceptable to
    CONST char *src,		/* String containing a floating-point number
				 * in a form acceptable to 
				 * Tcl_GetDoubleFromObj(). */
    double *doublePtr)		/* Place to store converted result. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
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
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







-
-
+
+











-
+




-
+











 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBoolean(
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    const char *src,		/* String containing one of the boolean values
				 * 1, 0, true, false, yes, no, on, off. */
    CONST char *src,		/* String containing one of the boolean values
				 * 1, 0, true, false, yes, no, on off. */
    int *boolPtr)		/* Place to store converted result, which will
				 * be 0 or 1. */
{
    Tcl_Obj obj;
    int code;

    obj.refCount = 1;
    obj.bytes = (char *) src;
    obj.length = strlen(src);
    obj.typePtr = NULL;

    code = TclSetBooleanFromAny(interp, &obj);
    code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
    if (obj.refCount > 1) {
	Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
    }
    if (code == TCL_OK) {
	*boolPtr = obj.internalRep.wideValue != 0;
	*boolPtr = obj.internalRep.longValue;
    }
    return code;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclGetDate.y.

12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
12
13
14
15
16
17
18

19
20
21
22
23
24
25
26







-
+







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

%parse-param {DateInfo* info}
%lex-param {DateInfo* info}
%define api.pure
%pure-parser
 /* %error-verbose would be nice, but our token names are meaningless */
%locations

%{
/*
 * tclDate.c --
 *
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
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







-
-
-
-
-
-
-
-


















-
+







 * doesn't like that, and complains. Tell it to shut up.
 */

#ifdef _MSC_VER
#pragma warning( disable : 4102 )
#endif /* _MSC_VER */

/*
 * Meridian: am, pm, or 24-hour style.
 */

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;

/*
 * yyparse will accept a 'struct DateInfo' as its parameter; that's where the
 * parsed fields will be returned.
 */

typedef struct DateInfo {

    Tcl_Obj* messages;		/* Error messages */
    const char* separatrix;	/* String separating messages */

    time_t dateYear;
    time_t dateMonth;
    time_t dateDay;
    int dateHaveDate;

    time_t dateHour;
    time_t dateMinutes;
    time_t dateSeconds;
    MERIDIAN dateMeridian;
    int dateMeridian;
    int dateHaveTime;

    time_t dateTimezone;
    int dateDSTmode;
    int dateHaveZone;

    time_t dateRelMonth;
93
94
95
96
97
98
99
100
101


102
103
104
105
106
107
108
85
86
87
88
89
90
91


92
93
94
95
96
97
98
99
100







-
-
+
+







    const char *dateStart;
    const char *dateInput;
    time_t *dateRelPointer;

    int dateDigitCount;
} DateInfo;

#define YYMALLOC	Tcl_Alloc
#define YYFREE(x)	(Tcl_Free((void*) (x)))
#define YYMALLOC	ckalloc
#define YYFREE(x)	(ckfree((void*) (x)))

#define yyDSTmode	(info->dateDSTmode)
#define yyDayOrdinal	(info->dateDayOrdinal)
#define yyDayNumber	(info->dateDayNumber)
#define yyMonthOrdinal	(info->dateMonthOrdinal)
#define yyHaveDate	(info->dateHaveDate)
#define yyHaveDay	(info->dateHaveDay)
154
155
156
157
158
159
160








161
162
163
164
165
166
167
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167







+
+
+
+
+
+
+
+







 * Daylight-savings mode: on, off, or not yet known.
 */

typedef enum _DSTMODE {
    DSTon, DSToff, DSTmaybe
} DSTMODE;

/*
 * Meridian: am, pm, or 24-hour style.
 */

typedef enum _MERIDIAN {
    MERam, MERpm, MER24
} MERIDIAN;

%}

%union {
    time_t Number;
    enum _MERIDIAN Meridian;
}

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
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







+
+
+
+
+
+
+
+







+
+
+
+
+
+
+
+
+




-




-






-
-
-
-







	    yyMeridian = $2;
	}
	| tUNUMBER ':' tUNUMBER o_merid {
	    yyHour = $1;
	    yyMinutes = $3;
	    yySeconds = 0;
	    yyMeridian = $4;
	}
	| tUNUMBER ':' tUNUMBER '-' tUNUMBER {
	    yyHour = $1;
	    yyMinutes = $3;
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ($5 % 100 + ($5 / 100) * 60);
	    ++yyHaveZone;
	}
	| tUNUMBER ':' tUNUMBER ':' tUNUMBER o_merid {
	    yyHour = $1;
	    yyMinutes = $3;
	    yySeconds = $5;
	    yyMeridian = $6;
	}
	| tUNUMBER ':' tUNUMBER ':' tUNUMBER '-' tUNUMBER {
	    yyHour = $1;
	    yyMinutes = $3;
	    yySeconds = $5;
	    yyMeridian = MER24;
	    yyDSTmode = DSToff;
	    yyTimezone = ($7 % 100 + ($7 / 100) * 60);
	    ++yyHaveZone;
	}
	;

zone	: tZONE tDST {
	    yyTimezone = $1;
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyDSTmode = DSTon;
	}
	| tZONE {
	    yyTimezone = $1;
	    if (yyTimezone > HOUR( 12)) yyTimezone -= HOUR(100);
	    yyDSTmode = DSToff;
	}
	| tDAYZONE {
	    yyTimezone = $1;
	    yyDSTmode = DSTon;
	}
	| sign tUNUMBER {
	    yyTimezone = -$1*($2 % 100 + ($2 / 100) * 60);
	    yyDSTmode = DSToff;
	}
	;

day	: tDAY {
	    yyDayOrdinal = 1;
	    yyDayNumber = $1;
	}
	| tDAY ',' {
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
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







-
-
-
-
-
-
-
-
-
-
-
-
+
+








-
+







	}
	| tNEXT tUNUMBER tMONTH {
	    yyMonthOrdinal = $2;
	    yyMonth = $3;
	}
	;

iso	: tUNUMBER '-' tUNUMBER '-' tUNUMBER tZONE
		tUNUMBER ':' tUNUMBER ':' tUNUMBER {
	    if ($6 != HOUR( 7) + HOUR(100)) YYABORT;
	    yyYear = $1;
	    yyMonth = $3;
	    yyDay = $5;
	    yyHour = $7;
	    yyMinutes = $9;
	    yySeconds = $11;
	}
	| tISOBASE tZONE tISOBASE {
	    if ($2 != HOUR( 7) + HOUR(100)) YYABORT;
iso	: tISOBASE tZONE tISOBASE {
	    if ($2 != HOUR( 7)) YYABORT;
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $3 / 10000;
	    yyMinutes = ($3 % 10000)/100;
	    yySeconds = $3 % 100;
	}
	| tISOBASE tZONE tUNUMBER ':' tUNUMBER ':' tUNUMBER {
	    if ($2 != HOUR( 7) + HOUR(100)) YYABORT;
	    if ($2 != HOUR( 7)) YYABORT;
	    yyYear = $1 / 10000;
	    yyMonth = ($1 % 10000)/100;
	    yyDay = $1 % 100;
	    yyHour = $3;
	    yyMinutes = $5;
	    yySeconds = $7;
	}
497
498
499
500
501
502
503




504
505
506
507
508
509
510
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515







+
+
+
+







	}
	| tMERIDIAN {
	    $$ = $1;
	}
	;

%%
MODULE_SCOPE int yychar;
MODULE_SCOPE YYSTYPE yylval;
MODULE_SCOPE int yynerrs;

/*
 * Month and day table.
 */

static const TABLE MonthDayTable[] = {
    { "january",	tMONTH,	 1 },
    { "february",	tMONTH,	 2 },
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
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







-
+

















-
+







    { "wednesday",	tDAY, 3 },
    { "wednes",		tDAY, 3 },
    { "thursday",	tDAY, 4 },
    { "thur",		tDAY, 4 },
    { "thurs",		tDAY, 4 },
    { "friday",		tDAY, 5 },
    { "saturday",	tDAY, 6 },
    { NULL, 0, 0 }
    { NULL }
};

/*
 * Time units table.
 */

static const TABLE UnitsTable[] = {
    { "year",		tMONTH_UNIT,	12 },
    { "month",		tMONTH_UNIT,	 1 },
    { "fortnight",	tDAY_UNIT,	14 },
    { "week",		tDAY_UNIT,	 7 },
    { "day",		tDAY_UNIT,	 1 },
    { "hour",		tSEC_UNIT, 60 * 60 },
    { "minute",		tSEC_UNIT,	60 },
    { "min",		tSEC_UNIT,	60 },
    { "second",		tSEC_UNIT,	 1 },
    { "sec",		tSEC_UNIT,	 1 },
    { NULL, 0, 0 }
    { NULL }
};

/*
 * Assorted relative-time words.
 */

static const TABLE OtherTable[] = {
576
577
578
579
580
581
582
583

584
585
586
587
588
589
590
581
582
583
584
585
586
587

588
589
590
591
592
593
594
595







-
+







    { "tenth",		tUNUMBER,	10 },
    { "eleventh",	tUNUMBER,	11 },
    { "twelfth",	tUNUMBER,	12 },
#endif
    { "ago",		tAGO,		1 },
    { "epoch",		tEPOCH,		0 },
    { "stardate",	tSTARDATE,	0 },
    { NULL, 0, 0 }
    { NULL }
};

/*
 * The timezone table. (Note: This table was modified to not use any floating
 * point constants to work around an SGI compiler bug).
 */

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
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







-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
+




-
+







    { "nzt",	tZONE,	  -HOUR(12) },	    /* New Zealand */
    { "nzst",	tZONE,	  -HOUR(12) },	    /* New Zealand Standard */
    { "nzdt",	tDAYZONE, -HOUR(12) },	    /* New Zealand Daylight */
    { "idle",	tZONE,	  -HOUR(12) },	    /* International Date Line East */
    /* ADDED BY Marco Nijdam */
    { "dst",	tDST,	  HOUR( 0) },	    /* DST on (hour is ignored) */
    /* End ADDED */
    { NULL, 0, 0 }
    {  NULL  }
};

/*
 * Military timezone table.
 */

static const TABLE MilitaryTable[] = {
    { "a",	tZONE,	-HOUR( 1) + HOUR(100) },
    { "b",	tZONE,	-HOUR( 2) + HOUR(100) },
    { "c",	tZONE,	-HOUR( 3) + HOUR(100) },
    { "d",	tZONE,	-HOUR( 4) + HOUR(100) },
    { "e",	tZONE,	-HOUR( 5) + HOUR(100) },
    { "f",	tZONE,	-HOUR( 6) + HOUR(100) },
    { "g",	tZONE,	-HOUR( 7) + HOUR(100) },
    { "h",	tZONE,	-HOUR( 8) + HOUR(100) },
    { "i",	tZONE,	-HOUR( 9) + HOUR(100) },
    { "k",	tZONE,	-HOUR(10) + HOUR(100) },
    { "l",	tZONE,	-HOUR(11) + HOUR(100) },
    { "m",	tZONE,	-HOUR(12) + HOUR(100) },
    { "n",	tZONE,	HOUR(  1) + HOUR(100) },
    { "o",	tZONE,	HOUR(  2) + HOUR(100) },
    { "p",	tZONE,	HOUR(  3) + HOUR(100) },
    { "q",	tZONE,	HOUR(  4) + HOUR(100) },
    { "r",	tZONE,	HOUR(  5) + HOUR(100) },
    { "s",	tZONE,	HOUR(  6) + HOUR(100) },
    { "t",	tZONE,	HOUR(  7) + HOUR(100) },
    { "u",	tZONE,	HOUR(  8) + HOUR(100) },
    { "v",	tZONE,	HOUR(  9) + HOUR(100) },
    { "w",	tZONE,	HOUR( 10) + HOUR(100) },
    { "x",	tZONE,	HOUR( 11) + HOUR(100) },
    { "y",	tZONE,	HOUR( 12) + HOUR(100) },
    { "z",	tZONE,	HOUR( 0)  + HOUR(100) },
    { NULL, 0, 0 }
    { "a",	tZONE,	-HOUR( 1) },
    { "b",	tZONE,	-HOUR( 2) },
    { "c",	tZONE,	-HOUR( 3) },
    { "d",	tZONE,	-HOUR( 4) },
    { "e",	tZONE,	-HOUR( 5) },
    { "f",	tZONE,	-HOUR( 6) },
    { "g",	tZONE,	-HOUR( 7) },
    { "h",	tZONE,	-HOUR( 8) },
    { "i",	tZONE,	-HOUR( 9) },
    { "k",	tZONE,	-HOUR(10) },
    { "l",	tZONE,	-HOUR(11) },
    { "m",	tZONE,	-HOUR(12) },
    { "n",	tZONE,	HOUR(  1) },
    { "o",	tZONE,	HOUR(  2) },
    { "p",	tZONE,	HOUR(  3) },
    { "q",	tZONE,	HOUR(  4) },
    { "r",	tZONE,	HOUR(  5) },
    { "s",	tZONE,	HOUR(  6) },
    { "t",	tZONE,	HOUR(  7) },
    { "u",	tZONE,	HOUR(  8) },
    { "v",	tZONE,	HOUR(  9) },
    { "w",	tZONE,	HOUR( 10) },
    { "x",	tZONE,	HOUR( 11) },
    { "y",	tZONE,	HOUR( 12) },
    { "z",	tZONE,	HOUR( 0) },
    { NULL }
};

/*
 * Dump error messages in the bit bucket.
 */

static void
TclDateerror(
    YYLTYPE* location,
    DateInfo* infoPtr,
    const char *s)
{
    Tcl_Obj* t;
    Tcl_AppendToObj(infoPtr->messages, infoPtr->separatrix, -1);
    Tcl_AppendToObj(infoPtr->messages, s, -1);
    Tcl_AppendToObj(infoPtr->messages, " (characters ", -1);
    TclNewIntObj(t, location->first_column);
    t = Tcl_NewIntObj(location->first_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, "-", -1);
    TclNewIntObj(t, location->last_column);
    t = Tcl_NewIntObj(location->last_column);
    Tcl_IncrRefCount(t);
    Tcl_AppendObjToObj(infoPtr->messages, t);
    Tcl_DecrRefCount(t);
    Tcl_AppendToObj(infoPtr->messages, ")", -1);
    infoPtr->separatrix = "\n";
}

760
761
762
763
764
765
766
767
768
769



770
771
772
773
774
775
776
765
766
767
768
769
770
771



772
773
774
775
776
777
778
779
780
781







-
-
-
+
+
+







}

static int
LookupWord(
    YYSTYPE* yylvalPtr,
    char *buff)
{
    char *p;
    char *q;
    const TABLE *tp;
    register char *p;
    register char *q;
    register const TABLE *tp;
    int i, abbrev;

    /*
     * Make it lowercase.
     */

    Tcl_UtfToLower(buff);
885
886
887
888
889
890
891
892
893


894
895
896
897
898
899

900
901
902
903
904
905
906
890
891
892
893
894
895
896


897
898
899
900
901
902
903

904
905
906
907
908
909
910
911







-
-
+
+





-
+








static int
TclDatelex(
    YYSTYPE* yylvalPtr,
    YYLTYPE* location,
    DateInfo *info)
{
    char c;
    char *p;
    register char c;
    register char *p;
    char buff[20];
    int Count;

    location->first_column = yyInput - info->dateStart;
    for ( ; ; ) {
	while (TclIsSpaceProcM(*yyInput)) {
	while (isspace(UCHAR(*yyInput))) {
	    yyInput++;
	}

	if (isdigit(UCHAR(c = *yyInput))) { /* INTL: digit */
	    /*
	     * Convert the string into a number; count the number of digits.
	     */
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
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







-
+

-
-
+
+













-
+







	    }
	} while (Count > 0);
    }
}

int
TclClockOldscanObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Count of paraneters */
    Tcl_Obj *const *objv)	/* Parameters */
    int objc,			/* Count of parameters */
    Tcl_Obj *CONST *objv)	/* Parameters */
{
    Tcl_Obj *result, *resultElement;
    int yr, mo, da;
    DateInfo dateInfo;
    DateInfo* info = &dateInfo;
    int status;

    if (objc != 5) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"stringToParse baseYear baseMonth baseDay" );
	return TCL_ERROR;
    }

    yyInput = TclGetString(objv[1]);
    yyInput = Tcl_GetString( objv[1] );
    dateInfo.dateStart = yyInput;

    yyHaveDate = 0;
    if (Tcl_GetIntFromObj(interp, objv[2], &yr) != TCL_OK
	    || Tcl_GetIntFromObj(interp, objv[3], &mo) != TCL_OK
	    || Tcl_GetIntFromObj(interp, objv[4], &da) != TCL_OK) {
	return TCL_ERROR;
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
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
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

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







-
+







-




-







-







-





-





-





-





-



-
-
+
+


-
+

-
+

-
+




-
-
+
+




-
+


-
+





-
+


-
+

-
+

-
+



-
+


-
+

-
+



-
+


-
+

-
+








    yyHaveDay = 0;
    yyDayOrdinal = 0; yyDayNumber = 0;

    yyHaveRel = 0;
    yyRelMonth = 0; yyRelDay = 0; yyRelSeconds = 0; yyRelPointer = NULL;

    TclNewObj(dateInfo.messages);
    dateInfo.messages = Tcl_NewObj();
    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
	return TCL_ERROR;
    } else if (status == 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    } else if (status != 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
						  "from date parser. Please "
						  "report this error as a "
						  "bug in Tcl.", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(dateInfo.messages);

    if (yyHaveDate > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one date in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveTime > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time of day in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveZone > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time zone in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveDay > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one weekday in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveOrdinalMonth > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one ordinal month in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }

    TclNewObj(result);
    TclNewObj(resultElement);
    result = Tcl_NewObj();
    resultElement = Tcl_NewObj();
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyYear));
		Tcl_NewIntObj((int) yyYear));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
		Tcl_NewIntObj((int) yyMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDay));
		Tcl_NewIntObj((int) yyDay));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    if (yyHaveTime) {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(
		ToSeconds(yyHour, yyMinutes, yySeconds, (MERIDIAN)yyMeridian)));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj((int)
		ToSeconds(yyHour, yyMinutes, yySeconds, yyMeridian)));
    } else {
	Tcl_ListObjAppendElement(interp, result, Tcl_NewObj());
    }

    TclNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveZone) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(-yyTimezone));
		Tcl_NewIntObj((int) -yyTimezone));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(1 - yyDSTmode));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveRel) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelMonth));
		Tcl_NewIntObj((int) yyRelMonth));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelDay));
		Tcl_NewIntObj((int) yyRelDay));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyRelSeconds));
		Tcl_NewIntObj((int) yyRelSeconds));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TcNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveDay && !yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayOrdinal));
		Tcl_NewIntObj((int) yyDayOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyDayNumber));
		Tcl_NewIntObj((int) yyDayNumber));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    TclNewObj(resultElement);
    resultElement = Tcl_NewObj();
    if (yyHaveOrdinalMonth) {
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonthOrdinal));
		Tcl_NewIntObj((int) yyMonthOrdinal));
	Tcl_ListObjAppendElement(interp, resultElement,
		Tcl_NewIntObj(yyMonth));
		Tcl_NewIntObj((int) yyMonth));
    }
    Tcl_ListObjAppendElement(interp, result, resultElement);

    Tcl_SetObjResult(interp, result);
    return TCL_OK;
}


Changes to generic/tclHash.c.

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
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







+
+
+
+
+
+
+















-
+





-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
+
+
+













-
+








-
+








-
+







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * Prevent macros from clashing with function definitions.
 */

#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry

/*
 * When there are this many entries per bucket, on average, rebuild the hash
 * table to make it larger.
 */

#define REBUILD_MULTIPLIER	3

/*
 * The following macro takes a preliminary integer hash value and produces an
 * index into a hash tables bucket list. The idea is to make it so that
 * preliminary values that are arbitrarily similar will end up in different
 * buckets. The hash function was taken from a random-number generator.
 */

#define RANDOM_INDEX(tablePtr, i) \
    ((((i)*(size_t)1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)

/*
 * Prototypes for the array hash key methods.
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static TCL_HASH_TYPE	HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
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);
#endif

/*
 * Prototypes for the string hash key methods.
 */

static Tcl_HashEntry *	AllocStringEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static int		CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static TCL_HASH_TYPE	HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
			    VOID *keyPtr);
static int		CompareStringKeys(VOID *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashStringKey(Tcl_HashTable *tablePtr, VOID *keyPtr);

/*
 * Function prototypes for static functions in this file:
 */

static Tcl_HashEntry *	BogusFind(Tcl_HashTable *tablePtr, const char *key);
static Tcl_HashEntry *	BogusCreate(Tcl_HashTable *tablePtr, const char *key,
			    int *newPtr);
static Tcl_HashEntry *	CreateHashEntry(Tcl_HashTable *tablePtr, const char *key,
			    int *newPtr);
static Tcl_HashEntry *	FindHashEntry(Tcl_HashTable *tablePtr, const char *key);
static void		RebuildTable(Tcl_HashTable *tablePtr);

const Tcl_HashKeyType tclArrayHashKeyType = {
Tcl_HashKeyType tclArrayHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
    TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
    HashArrayKey,			/* hashKeyProc */
    CompareArrayKeys,			/* compareKeysProc */
    AllocArrayEntry,			/* allocEntryProc */
    NULL				/* freeEntryProc */
};

const Tcl_HashKeyType tclOneWordHashKeyType = {
Tcl_HashKeyType tclOneWordHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
    0,					/* flags */
    NULL, /* HashOneWordKey, */		/* hashProc */
    NULL, /* CompareOneWordKey, */	/* compareProc */
    NULL, /* AllocOneWordKey, */	/* allocEntryProc */
    NULL  /* FreeOneWordKey, */		/* freeEntryProc */
};

const Tcl_HashKeyType tclStringHashKeyType = {
Tcl_HashKeyType tclStringHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
    0,					/* flags */
    HashStringKey,			/* hashKeyProc */
    CompareStringKeys,			/* compareKeysProc */
    AllocStringEntry,			/* allocEntryProc */
    NULL				/* freeEntryProc */
};
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
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







+


-
+













-
+







 * Side effects:
 *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
 *	Tcl_CreateHashEntry.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_InitHashTable
void
Tcl_InitHashTable(
    Tcl_HashTable *tablePtr,
    register Tcl_HashTable *tablePtr,
				/* Pointer to table record, which is supplied
				 * by the caller. */
    int keyType)		/* Type of keys to use in table:
				 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an
				 * integer >= 2. */
{
    /*
     * Use a special value to inform the extended version that it must not
     * access any of the new fields in the Tcl_HashTable. If an extension is
     * rebuilt then any calls to this function will be redirected to the
     * extended version by a macro.
     */

    Tcl_InitCustomHashTable(tablePtr, keyType, (const Tcl_HashKeyType *) -1);
    Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitCustomHashTable --
 *
140
141
142
143
144
145
146
147

148
149
150
151
152
153
154

155
156
157
158
159
160
161
159
160
161
162
163
164
165

166
167
168
169
170
171
172

173
174
175
176
177
178
179
180







-
+






-
+







 *	Tcl_CreateHashEntry.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InitCustomHashTable(
    Tcl_HashTable *tablePtr,
    register Tcl_HashTable *tablePtr,
				/* Pointer to table record, which is supplied
				 * by the caller. */
    int keyType,		/* Type of keys to use in table:
				 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
				 * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS,
				 * or an integer >= 2. */
    const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
    Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
				 * behaviour of this table. */
{
#if (TCL_SMALL_HASH_TABLE != 4)
    Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4",
	    TCL_SMALL_HASH_TABLE);
#endif

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
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
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







-
+












+
+
+
+
+
+
+
+













-
+
















+
+
+
+
+
+
+
+
+
+
+









-
+

+
-
+













-
+

-
+




-
-
+
+









+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















-
+

-
+

-
+



+
-
+


+
+
+
+
+







	 */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * FindHashEntry --
 * Tcl_FindHashEntry --
 *
 *	Given a hash table find the entry with a matching key.
 *
 * Results:
 *	The return value is a token for the matching entry in the hash table,
 *	or NULL if there was no matching entry.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashEntry *
Tcl_FindHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key)		/* Key to use to find matching entry. */
{
    return (*((tablePtr)->findProc))(tablePtr, key);
}

static Tcl_HashEntry *
FindHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key)		/* Key to use to find matching entry. */
{
    return CreateHashEntry(tablePtr, key, NULL);
}


/*
 *----------------------------------------------------------------------
 *
 * CreateHashEntry --
 * Tcl_CreateHashEntry --
 *
 *	Given a hash table with string keys, and a string key, find the entry
 *	with a matching key. If there is no matching entry, then create a new
 *	entry that does match.
 *
 * Results:
 *	The return value is a pointer to the matching entry. If this is a
 *	newly-created entry, then *newPtr will be set to a non-zero value;
 *	otherwise *newPtr will be set to 0. If this is a new entry the value
 *	stored in the entry will initially be 0.
 *
 * Side effects:
 *	A new entry may be added to the hash table.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashEntry *
Tcl_CreateHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
}

static Tcl_HashEntry *
CreateHashEntry(
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    Tcl_HashEntry *hPtr;
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;
    unsigned int hash;
    size_t hash, index;
    int index;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    if (typePtr->hashKeyProc) {
	hash = typePtr->hashKeyProc(tablePtr, (void *) key);
	hash = typePtr->hashKeyProc(tablePtr, (VOID *) key);
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	    index = RANDOM_INDEX(tablePtr, hash);
	    index = RANDOM_INDEX (tablePtr, hash);
	} else {
	    index = hash & tablePtr->mask;
	}
    } else {
	hash = (size_t) key;
	index = RANDOM_INDEX(tablePtr, hash);
	hash = PTR2UINT(key);
	index = RANDOM_INDEX (tablePtr, hash);
    }

    /*
     * Search all of the entries in the appropriate bucket.
     */

    if (typePtr->compareKeysProc) {
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	if (typePtr->flags & TCL_HASH_KEY_DIRECT_COMPARE) {
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != hPtr->hash) {
		continue;
	    }
	    /* if keys pointers or values are equal */
	    if ((key == hPtr->key.oneWordValue)
		|| compareKeysProc((void *) key, hPtr)
	    ) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    } else {
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
	    if (hash != hPtr->hash) {
		continue;
	    }
	    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		    hPtr = hPtr->nextPtr) {
#if TCL_HASH_KEY_STORE_HASH
		if (hash != PTR2UINT(hPtr->hash)) {
		    continue;
		}
#endif
		/* if keys pointers or values are equal */
		if ((key == hPtr->key.oneWordValue)
		    || compareKeysProc((VOID *) key, hPtr)
		) {
		    if (newPtr) {
			*newPtr = 0;
		    }
		    return hPtr;
		}
	    }
	} else {
	    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		    hPtr = hPtr->nextPtr) {
#if TCL_HASH_KEY_STORE_HASH
		if (hash != PTR2UINT(hPtr->hash)) {
		    continue;
		}
#endif
		/* if needle pointer equals content pointer or values equal */
		if ((key == hPtr->key.string)
		    || compareKeysProc((VOID *) key, hPtr)
		) {
		    if (newPtr) {
			*newPtr = 0;
		    }
		    return hPtr;
		}
	    }
	}
    } else {
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
		hPtr = hPtr->nextPtr) {
#if TCL_HASH_KEY_STORE_HASH
	    if (hash != PTR2UINT(hPtr->hash)) {
		continue;
	    }
#endif
	    if (key == hPtr->key.oneWordValue) {
		if (newPtr) {
		    *newPtr = 0;
		}
		return hPtr;
	    }
	}
    }

    if (!newPtr) {
	return NULL;
    }

    /*
     * Entry not found. Add a new one to the bucket.
     */

    *newPtr = 1;
    if (typePtr->allocEntryProc) {
	hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
	hPtr = typePtr->allocEntryProc(tablePtr, (VOID *) key);
    } else {
	hPtr = (Tcl_HashEntry *)Tcl_Alloc(sizeof(Tcl_HashEntry));
	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
	hPtr->key.oneWordValue = (char *) key;
	Tcl_SetHashValue(hPtr, NULL);
	hPtr->clientData = 0;
    }

    hPtr->tablePtr = tablePtr;
#if TCL_HASH_KEY_STORE_HASH
    hPtr->hash = hash;
    hPtr->hash = UINT2PTR(hash);
    hPtr->nextPtr = tablePtr->buckets[index];
    tablePtr->buckets[index] = hPtr;
#else
    hPtr->bucketPtr = &(tablePtr->buckets[index]);
    hPtr->nextPtr = *hPtr->bucketPtr;
    *hPtr->bucketPtr = hPtr;
#endif
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many more
     * buckets.
     */

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
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

489
490
491
492
493
494
495
496







-
+



+
-
+
+














+


-
+

-
+


-
+
+
+
+

















-
+

-
+







 *----------------------------------------------------------------------
 */

void
Tcl_DeleteHashEntry(
    Tcl_HashEntry *entryPtr)
{
    Tcl_HashEntry *prevPtr;
    register Tcl_HashEntry *prevPtr;
    const Tcl_HashKeyType *typePtr;
    Tcl_HashTable *tablePtr;
    Tcl_HashEntry **bucketPtr;
#if TCL_HASH_KEY_STORE_HASH
    size_t index;
    int index;
#endif

    tablePtr = entryPtr->tablePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

#if TCL_HASH_KEY_STORE_HASH
    if (typePtr->hashKeyProc == NULL
	    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
	index = RANDOM_INDEX(tablePtr, entryPtr->hash);
	index = RANDOM_INDEX(tablePtr, PTR2UINT(entryPtr->hash));
    } else {
	index = entryPtr->hash & tablePtr->mask;
	index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
    }

    bucketPtr = &tablePtr->buckets[index];
    bucketPtr = &(tablePtr->buckets[index]);
#else
    bucketPtr = entryPtr->bucketPtr;
#endif

    if (*bucketPtr == entryPtr) {
	*bucketPtr = entryPtr->nextPtr;
    } else {
	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry");
	    }
	    if (prevPtr->nextPtr == entryPtr) {
		prevPtr->nextPtr = entryPtr->nextPtr;
		break;
	    }
	}
    }

    tablePtr->numEntries--;
    if (typePtr->freeEntryProc) {
	typePtr->freeEntryProc(entryPtr);
	typePtr->freeEntryProc (entryPtr);
    } else {
	Tcl_Free(entryPtr);
	ckfree((char *) entryPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteHashTable --
430
431
432
433
434
435
436
437

438
439

440
441

442
443
444
445
446
447
448
505
506
507
508
509
510
511

512
513

514
515

516
517
518
519
520
521
522
523







-
+

-
+

-
+







 *	The hash table is no longer useable.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteHashTable(
    Tcl_HashTable *tablePtr)	/* Table to delete. */
    register Tcl_HashTable *tablePtr)	/* Table to delete. */
{
    Tcl_HashEntry *hPtr, *nextPtr;
    register Tcl_HashEntry *hPtr, *nextPtr;
    const Tcl_HashKeyType *typePtr;
    size_t i;
    int i;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
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
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







-
+

-
+













-
+







     */

    for (i = 0; i < tablePtr->numBuckets; i++) {
	hPtr = tablePtr->buckets[i];
	while (hPtr != NULL) {
	    nextPtr = hPtr->nextPtr;
	    if (typePtr->freeEntryProc) {
		typePtr->freeEntryProc(hPtr);
		typePtr->freeEntryProc (hPtr);
	    } else {
		Tcl_Free(hPtr);
		ckfree((char *) hPtr);
	    }
	    hPtr = nextPtr;
	}
    }

    /*
     * Free up the bucket array, if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	    TclpSysFree((char *) tablePtr->buckets);
	} else {
	    Tcl_Free(tablePtr->buckets);
	    ckfree((char *) tablePtr->buckets);
	}
    }

    /*
     * Arrange for panics if the table is used again without
     * re-initialization.
     */
538
539
540
541
542
543
544
545

546
547
548
549
550
551
552
613
614
615
616
617
618
619

620
621
622
623
624
625
626
627







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashEntry *
Tcl_NextHashEntry(
    Tcl_HashSearch *searchPtr)
    register Tcl_HashSearch *searchPtr)
				/* Place to store information about progress
				 * through the table. Must have been
				 * initialized by calling
				 * Tcl_FirstHashEntry. */
{
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr = searchPtr->tablePtr;
583
584
585
586
587
588
589
590

591
592

593












594
595
596
597
598
599
600
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
686
687







-
+

-
+

+
+
+
+
+
+
+
+
+
+
+
+







 */

char *
Tcl_HashStats(
    Tcl_HashTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t count[NUM_COUNTERS], overflow, i, j;
    int count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    Tcl_HashEntry *hPtr;
    register Tcl_HashEntry *hPtr;
    char *result, *p;
    const Tcl_HashKeyType *typePtr;

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
	typePtr = &tclOneWordHashKeyType;
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
	    || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
	typePtr = tablePtr->typePtr;
    } else {
	typePtr = &tclArrayHashKeyType;
    }

    /*
     * Compute a histogram of bucket usage.
     */

    for (i = 0; i < NUM_COUNTERS; i++) {
	count[i] = 0;
617
618
619
620
621
622
623



624
625



626
627
628
629

630
631
632
633

634
635
636
637
638
639
640
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







+
+
+
-
-
+
+
+



-
+



-
+







	}
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	result = (char *) TclpSysAlloc((unsigned) (NUM_COUNTERS*60) + 300, 0);
    } else {
    result = (char *)Tcl_Alloc((NUM_COUNTERS * 60) + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
	result = (char *) ckalloc((unsigned) (NUM_COUNTERS*60) + 300);
    }
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
    sprintf(p, "number of buckets with %d or more entries: %d\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}

/*
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
686
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







-
+


-
+


-
+







-
+





-
+







 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocArrayEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)			/* Key to store in the hash table entry. */
    VOID *keyPtr)		/* Key to store in the hash table entry. */
{
    int *array = (int *) keyPtr;
    int *iPtr1, *iPtr2;
    register int *iPtr1, *iPtr2;
    Tcl_HashEntry *hPtr;
    int count;
    size_t size;
    unsigned int size;

    count = tablePtr->keyType;

    size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
    if (size < sizeof(Tcl_HashEntry)) {
	size = sizeof(Tcl_HashEntry);
    }
    hPtr = (Tcl_HashEntry *)Tcl_Alloc(size);
    hPtr = (Tcl_HashEntry *) ckalloc(size);

    for (iPtr1 = array, iPtr2 = hPtr->key.words;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    Tcl_SetHashValue(hPtr, NULL);
    hPtr->clientData = 0;

    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
696
697
698
699
700
701
702
703

704
705
706
707


708
709
710
711
712
713
714
787
788
789
790
791
792
793

794
795
796


797
798
799
800
801
802
803
804
805







-
+


-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareArrayKeys(
    void *keyPtr,			/* New key to compare. */
    VOID *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    const int *iPtr1 = (const int *)keyPtr;
    const int *iPtr2 = hPtr->key.words;
    register const int *iPtr1 = (const int *) keyPtr;
    register const int *iPtr2 = (const int *) hPtr->key.words;
    Tcl_HashTable *tablePtr = hPtr->tablePtr;
    int count;

    for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
	if (count == 0) {
	    return 1;
	}
733
734
735
736
737
738
739
740

741
742
743

744
745
746


747
748
749
750
751
752
753
824
825
826
827
828
829
830

831
832
833

834
835


836
837
838
839
840
841
842
843
844







-
+


-
+

-
-
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
static unsigned int
HashArrayKey(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)				/* Key from which to compute hash value. */
    VOID *keyPtr)		/* Key from which to compute hash value. */
{
    const int *array = (const int *) keyPtr;
    TCL_HASH_TYPE result;
    register const int *array = (const int *) keyPtr;
    register unsigned int result;
    int count;

    for (result = 0, count = tablePtr->keyType; count > 0;
	    count--, array++) {
	result += *array;
    }
    return result;
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
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







-
-
+
+



-
+





-
+


-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocStringEntry(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)			/* Key to store in the hash table entry. */
    Tcl_HashTable *tablePtr,	/* Hash table. */
    VOID *keyPtr)		/* Key to store in the hash table entry. */
{
    const char *string = (const char *) keyPtr;
    Tcl_HashEntry *hPtr;
    size_t size, allocsize;
    unsigned int size, allocsize;

    allocsize = size = strlen(string) + 1;
    if (size < sizeof(hPtr->key)) {
	allocsize = sizeof(hPtr->key);
    }
    hPtr = (Tcl_HashEntry *)Tcl_Alloc(offsetof(Tcl_HashEntry, key) + allocsize);
    hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
    memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
    memcpy(hPtr->key.string, string, size);
    Tcl_SetHashValue(hPtr, NULL);
    hPtr->clientData = 0;
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareStringKeys --
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
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
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







-
+


+
+
+
-
+



















-
+

-
-
+
+

-
-
-
+
+
+









-
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
+
-
-
-
+
-









-
+











+


-
-
+
+










-
+











+


-
-
-
+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
CompareStringKeys(
    void *keyPtr,			/* New key to compare. */
    VOID *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    register const char *p1 = (const char *) keyPtr;
    register const char *p2 = (const char *) hPtr->key.string;

    return !strcmp((char *)keyPtr, hPtr->key.string);
    return !strcmp(p1, p2);
}

/*
 *----------------------------------------------------------------------
 *
 * HashStringKey --
 *
 *	Compute a one-word summary of a text string, which can be used to
 *	generate a hash index.
 *
 * Results:
 *	The return value is a one-word summary of the information in string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static TCL_HASH_TYPE
static unsigned int
HashStringKey(
    TCL_UNUSED(Tcl_HashTable *),
    void *keyPtr)			/* Key from which to compute hash value. */
    Tcl_HashTable *tablePtr,	/* Hash table. */
    VOID *keyPtr)		/* Key from which to compute hash value. */
{
    const char *string = (const char *)keyPtr;
    TCL_HASH_TYPE result;
    char c;
    register const char *string = (const char *) keyPtr;
    register unsigned int result;
    register int c;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
     *
     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
     *    multiplying by 9 is just about as good.
     *	  multiplying by 9 is just about as good.
     * 2. Times-9 is (shift-left-3) plus (old). This means that each
     *    character's bits hang around in the low-order bits of the hash value
     *    for ever, plus they spread fairly rapidly up to the high-order bits
     *    to fill out the hash value. This seems works well both for decimal
     *    and non-decimal strings, but isn't strong against maliciously-chosen
     *    keys.
     *
     *	  character's bits hang around in the low-order bits of the hash value
     *	  for ever, plus they spread fairly rapidly up to the high-order bits
     *	  to fill out the hash value. This seems works well both for decimal
     *	  and non-decimal strings, but isn't strong against maliciously-chosen
     *	  keys.
     */
     * Note that this function is very weak against malicious strings; it's
     * very easy to generate multiple keys that have the same hashcode. On the
     * other hand, that hardly ever actually occurs and this function *is*
     * very cheap, even by comparison with industry-standard hashes like FNV.
     * If real strength of hash is required though, use a custom hash based on
     * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
     * Since Tcl command and namespace names are usually reasonably-named (the
     * main use for string hashes in modern Tcl) speed is far more important
     * than strength.
     *

     * See also HashString in tclLiteral.c.
     * See also TclObjHashKey in tclObj.c.
     *
    result = 0;

     * See [tcl-Feature Request #2958832]
     */

    for (c=*string++ ; c ; c=*string++) {
    if ((result = UCHAR(*string)) != 0) {
	while ((c = *++string) != 0) {
	    result += (result << 3) + UCHAR(c);
	result += (result<<3) + c;
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * BogusFind --
 *
 *	This function is invoked when Tcl_FindHashEntry is called on a
 *	This function is invoked when an Tcl_FindHashEntry is called on a
 *	table that has been deleted.
 *
 * Results:
 *	If Tcl_Panic returns (which it shouldn't) this function returns NULL.
 *
 * Side effects:
 *	Generates a panic.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static Tcl_HashEntry *
BogusFind(
    TCL_UNUSED(Tcl_HashTable *),
    TCL_UNUSED(const char *))
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key)		/* Key to use to find matching entry. */
{
    Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry");
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * BogusCreate --
 *
 *	This function is invoked when Tcl_CreateHashEntry is called on a
 *	This function is invoked when an Tcl_CreateHashEntry is called on a
 *	table that has been deleted.
 *
 * Results:
 *	If panic returns (which it shouldn't) this function returns NULL.
 *
 * Side effects:
 *	Generates a panic.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static Tcl_HashEntry *
BogusCreate(
    TCL_UNUSED(Tcl_HashTable *),
    TCL_UNUSED(const char *),
    TCL_UNUSED(int *))
    Tcl_HashTable *tablePtr,	/* Table in which to lookup entry. */
    const char *key,		/* Key to use to find or create matching
				 * entry. */
    int *newPtr)		/* Store info here telling whether a new entry
				 * was created. */
{
    Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry");
    return NULL;
}

/*
 *----------------------------------------------------------------------
949
950
951
952
953
954
955
956

957
958

959
960
961


962
963
964
965

966
967
968
969
970
971
972
1032
1033
1034
1035
1036
1037
1038

1039
1040

1041
1042


1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1055







-
+

-
+

-
-
+
+



-
+







 *	Memory gets reallocated and entries get re-hashed to new buckets.
 *
 *----------------------------------------------------------------------
 */

static void
RebuildTable(
    Tcl_HashTable *tablePtr)	/* Table to enlarge. */
    register Tcl_HashTable *tablePtr)	/* Table to enlarge. */
{
    size_t count, index, oldSize = tablePtr->numBuckets;
    int count, index, oldSize = tablePtr->numBuckets;
    Tcl_HashEntry **oldBuckets = tablePtr->buckets;
    Tcl_HashEntry **oldChainPtr, **newChainPtr;
    Tcl_HashEntry *hPtr;
    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
    register Tcl_HashEntry *hPtr;
    const Tcl_HashKeyType *typePtr;

    /* Avoid outgrowing capability of the memory allocators */
    if (oldSize > UINT_MAX / (4 * sizeof(Tcl_HashEntry *))) {
    if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) {
	tablePtr->rebuildSize = INT_MAX;
	return;
    }

    if (tablePtr->keyType == TCL_STRING_KEYS) {
	typePtr = &tclStringHashKeyType;
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
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
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
1140
1141
1142
1143







-
-
+
+

-
-
+
+






-
-
+
-









+


-
+

-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+











    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	tablePtr->buckets = (Tcl_HashEntry **)TclpSysAlloc(
		tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
	tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
    } else {
	tablePtr->buckets =
		(Tcl_HashEntry **)Tcl_Alloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
	tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
		(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
    }
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    if (tablePtr->downShift > 1) {
	tablePtr->downShift -= 2;
    tablePtr->downShift -= 2;
    }
    tablePtr->mask = (tablePtr->mask << 2) + 3;

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
	    *oldChainPtr = hPtr->nextPtr;
#if TCL_HASH_KEY_STORE_HASH
	    if (typePtr->hashKeyProc == NULL
		    || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		index = RANDOM_INDEX(tablePtr, hPtr->hash);
		index = RANDOM_INDEX (tablePtr, PTR2UINT(hPtr->hash));
	    } else {
		index = hPtr->hash & tablePtr->mask;
		index = PTR2UINT(hPtr->hash) & tablePtr->mask;
	    }
	    hPtr->nextPtr = tablePtr->buckets[index];
	    tablePtr->buckets[index] = hPtr;
#else
	    VOID *key = (VOID *) Tcl_GetHashKey(tablePtr, hPtr);

	    if (typePtr->hashKeyProc) {
		unsigned int hash;

		hash = typePtr->hashKeyProc(tablePtr, key);
		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
		    index = RANDOM_INDEX (tablePtr, hash);
		} else {
		    index = hash & tablePtr->mask;
		}
	    } else {
		index = RANDOM_INDEX (tablePtr, key);
	    }

	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
	    hPtr->nextPtr = *hPtr->bucketPtr;
	    *hPtr->bucketPtr = hPtr;
#endif
	}
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
	    TclpSysFree((char *) oldBuckets);
	} else {
	    Tcl_Free(oldBuckets);
	    ckfree((char *) oldBuckets);
	}
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclHistory.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
10
11
12
13
14
15
16


















17
18
19
20
21
22
23







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * Type of the assocData structure used to hold the reference to the [history
 * add] subcommand, used in Tcl_RecordAndEvalObj.
 */

typedef struct {
    Tcl_Obj *historyObj;	/* == "::history" */
    Tcl_Obj *addObj;		/* == "add" */
} HistoryObjs;

#define HISTORY_OBJS_KEY	"::tcl::HistoryObjs"

/*
 * Static functions in this file.
 */

static Tcl_InterpDeleteProc DeleteHistoryObjs;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RecordAndEval --
 *
 *	This procedure adds its command argument to the current list of
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
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







-
+





-
+
+


-
+




-
+



+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

int
Tcl_RecordAndEval(
    Tcl_Interp *interp,		/* Token for interpreter in which command will
				 * be executed. */
    const char *cmd,		/* Command to record. */
    CONST char *cmd,		/* Command to record. */
    int flags)			/* Additional flags. TCL_NO_EVAL means only
				 * record: don't execute command.
				 * TCL_EVAL_GLOBAL means use Tcl_GlobalEval
				 * instead of Tcl_Eval. */
{
    Tcl_Obj *cmdPtr;
    register Tcl_Obj *cmdPtr;
    int length = strlen(cmd);
    int result;

    if (cmd[0]) {
    if (length > 0) {
	/*
	 * Call Tcl_RecordAndEvalObj to do the actual work.
	 */

	cmdPtr = Tcl_NewStringObj(cmd, -1);
	cmdPtr = Tcl_NewStringObj(cmd, length);
	Tcl_IncrRefCount(cmdPtr);
	result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);

	/*
	 * Move the interpreter's object result to the string result, then
	 * reset the object result.
	 */

	(void) Tcl_GetStringResult(interp);

	/*
	 * Discard the Tcl object created to hold the command.
	 */

	Tcl_DecrRefCount(cmdPtr);
    } else {
	/*
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
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







+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
+
+
+
+




-





-
-
+
+


+
-
-
-
+
+
+




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








    int flags)			/* Additional flags. TCL_NO_EVAL means record
				 * only: don't execute the command.
				 * TCL_EVAL_GLOBAL means evaluate the script
				 * in global variable context instead of the
				 * current procedure. */
{
    int result, call = 1;
    Tcl_Obj *list[3];
    register Tcl_Obj *objPtr;
    Tcl_CmdInfo info;
    HistoryObjs *histObjsPtr =
	    (HistoryObjs *)Tcl_GetAssocData(interp, HISTORY_OBJS_KEY, NULL);

    /*
     * Create the references to the [::history add] command if necessary.
     */

    if (histObjsPtr == NULL) {
	histObjsPtr = (HistoryObjs *)Tcl_Alloc(sizeof(HistoryObjs));
	TclNewLiteralStringObj(histObjsPtr->historyObj, "::history");
	TclNewLiteralStringObj(histObjsPtr->addObj, "add");
	Tcl_IncrRefCount(histObjsPtr->historyObj);
	Tcl_IncrRefCount(histObjsPtr->addObj);
	Tcl_SetAssocData(interp, HISTORY_OBJS_KEY, DeleteHistoryObjs,
		histObjsPtr);
    }

    /*
     * Do not call [history] if it has been replaced by an empty proc
     */

    result = Tcl_GetCommandInfo(interp, "::history", &info);
    if (result && (info.deleteProc == TclProcDeleteProc)) {
	Proc *procPtr = (Proc *) info.objClientData;
    result = Tcl_GetCommandInfo(interp, "history", &info);

    if (result && (info.objProc == TclObjInterpProc)) {
	Proc *procPtr = (Proc *)(info.objClientData);
	call = (procPtr->cmdPtr->compileProc != TclCompileNoOp);
    }

    if (call) {
	Tcl_Obj *list[3];

	/*
	 * Do recording by eval'ing a tcl history command: history add $cmd.
	 */

	list[0] = histObjsPtr->historyObj;
	list[1] = histObjsPtr->addObj;
	TclNewLiteralStringObj(list[0], "history");
	TclNewLiteralStringObj(list[1], "add");
	list[2] = cmdPtr;

	objPtr = Tcl_NewListObj(3, list);
	Tcl_IncrRefCount(cmdPtr);
	(void) Tcl_EvalObjv(interp, 3, list, TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(cmdPtr);
	Tcl_IncrRefCount(objPtr);
	(void) Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(objPtr);

	/*
	 * One possible failure mode above: exceeding a resource limit.
	 */

	if (Tcl_LimitExceeded(interp)) {
	    return TCL_ERROR;
	}
    }

    /*
     * Execute the command.
     */

    result = TCL_OK;
    if (!(flags & TCL_NO_EVAL)) {
	result = Tcl_EvalObjEx(interp, cmdPtr, flags & TCL_EVAL_GLOBAL);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteHistoryObjs --
 *
 *	Called to delete the references to the constant words used when adding
 *	to the history.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The constant words may be deleted.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteHistoryObjs(
    ClientData clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    HistoryObjs *histObjsPtr = (HistoryObjs *)clientData;

    TclDecrRefCount(histObjsPtr->historyObj);
    TclDecrRefCount(histObjsPtr->addObj);
    Tcl_Free(histObjsPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclIO.c.

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
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







-
+

-
+



-
-
-
+
+
+










-
+


+
+
+
+
+
+
+
+
+
+
+







    ClientData clientData;	/* Argument to pass to procedure. */
    struct ChannelHandler *nextPtr;
				/* Next one in list of registered handlers. */
} ChannelHandler;

/*
 * This structure keeps track of the current ChannelHandler being invoked in
 * the current invocation of Tcl_NotifyChannel. There is a potential
 * the current invocation of ChannelHandlerEventProc. There is a potential
 * problem if a ChannelHandler is deleted while it is the current one, since
 * Tcl_NotifyChannel needs to look at the nextPtr field. To handle this
 * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
 * problem, structures of the type below indicate the next handler to be
 * processed for any (recursively nested) dispatches in progress. The
 * nextHandlerPtr field is updated if the handler being pointed to is deleted.
 * The nestedHandlerPtr field is used to chain together all recursive
 * invocations, so that Tcl_DeleteChannelHandler can find all the recursively
 * nested invocations of Tcl_NotifyChannel and compare the handler being
 * The nextPtr field is used to chain together all recursive invocations, so
 * that Tcl_DeleteChannelHandler can find all the recursively nested
 * invocations of ChannelHandlerEventProc and compare the handler being
 * deleted against the NEXT handler to be invoked in that invocation; when it
 * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
 * field of the structure to the next handler.
 */

typedef struct NextChannelHandler {
    ChannelHandler *nextHandlerPtr;	/* The next handler to be invoked in
					 * this invocation. */
    struct NextChannelHandler *nestedHandlerPtr;
					/* Next nested invocation of
					 * Tcl_NotifyChannel. */
					 * ChannelHandlerEventProc. */
} NextChannelHandler;

/*
 * The following structure describes the event that is added to the Tcl
 * event queue by the channel handler check procedure.
 */

typedef struct ChannelHandlerEvent {
    Tcl_Event header;		/* Standard header for all events. */
    Channel *chanPtr;		/* The channel that is ready. */
    int readyMask;		/* Events that have occurred. */
} ChannelHandlerEvent;

/*
 * The following structure is used by Tcl_GetsObj() to encapsulates the
 * state for a "gets" operation.
 */

typedef struct GetsState {
    Tcl_Obj *objPtr;		/* The object to which UTF-8 characters
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
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







-
+

















-
+


-
+







 */

typedef struct CopyState {
    struct Channel *readPtr;	/* Pointer to input channel. */
    struct Channel *writePtr;	/* Pointer to output channel. */
    int readFlags;		/* Original read channel flags. */
    int writeFlags;		/* Original write channel flags. */
    Tcl_WideInt toRead;		/* Number of bytes to copy, or -1. */
    int toRead;			/* Number of bytes to copy, or -1. */
    Tcl_WideInt total;		/* Total bytes transferred (written). */
    Tcl_Interp *interp;		/* Interp that started the copy. */
    Tcl_Obj *cmdPtr;		/* Command to be invoked at completion. */
    int bufSize;		/* Size of appended buffer. */
    char buffer[1];		/* Copy buffer, this must be the last
                                 * field. */
} CopyState;

/*
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *
 * Notice that different structures with the same name appear in other files.
 * The structure defined below is used in this file only.
 */

typedef struct {
typedef struct ThreadSpecificData {
    NextChannelHandler *nestedHandlerPtr;
				/* This variable holds the list of nested
				 * Tcl_NotifyChannel invocations. */
				 * ChannelHandlerEventProc invocations. */
    ChannelState *firstCSPtr;	/* List of all channels currently open,
				 * indexed by ChannelState, as only one
				 * ChannelState exists per set of stacked
				 * channels. */
    Tcl_Channel stdinChannel;	/* Static variable for the stdin channel. */
    int stdinInitialized;
    Tcl_Channel stdoutChannel;	/* Static variable for the stdout channel. */
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
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







-
-
-


-
-
-
-
-
-
-
-











-
+
-
-
+






-
-
+
+


+
+




















-
+












-
+







static int		CheckForDeadChannel(Tcl_Interp *interp,
			    ChannelState *statePtr);
static void		CheckForStdChannelsBeingClosed(Tcl_Channel chan);
static void		CleanupChannelHandlers(Tcl_Interp *interp,
			    Channel *chanPtr);
static int		CloseChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode);
static int		CloseChannelPart(Tcl_Interp *interp, Channel *chanPtr,
			    int errorCode, int flags);
static int		CloseWrite(Tcl_Interp *interp, Channel *chanPtr);
static void		CommonGetsCleanup(Channel *chanPtr);
static int		CopyData(CopyState *csPtr, int mask);
static int		MoveBytes(CopyState *csPtr);

static void		MBCallback(CopyState *csPtr, Tcl_Obj *errObj);
static void		MBError(CopyState *csPtr, int mask, int errorCode);
static int		MBRead(CopyState *csPtr);
static int		MBWrite(CopyState *csPtr);
static void		MBEvent(ClientData clientData, int mask);

static void		CopyEventProc(ClientData clientData, int mask);
static void		CreateScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask, Tcl_Obj *scriptPtr);
static void		DeleteChannelTable(ClientData clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptRecord(Tcl_Interp *interp,
			    Channel *chanPtr, int mask);
static int		DetachChannel(Tcl_Interp *interp, Tcl_Channel chan);
static void		DiscardInputQueued(ChannelState *statePtr,
			    int discardSavedBuffers);
static void		DiscardOutputQueued(ChannelState *chanPtr);
static int		DoRead(Channel *chanPtr, char *dst, size_t bytesToRead,
static int		DoRead(Channel *chanPtr, char *dst, int bytesToRead);
			    int allowShortReads);
static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, size_t toRead,
static int		DoReadChars(Channel *chan, Tcl_Obj *objPtr, int toRead,
			    int appendFlag);
static int		FilterInputBytes(Channel *chanPtr,
			    GetsState *statePtr);
static int		FlushChannel(Tcl_Interp *interp, Channel *chanPtr,
			    int calledFromAsyncFlush);
static int		TclGetsObjBinary(Tcl_Channel chan, Tcl_Obj *objPtr);
static Tcl_Encoding	GetBinaryEncoding(void);
static Tcl_ExitProc	FreeBinaryEncoding;
static Tcl_Encoding	GetBinaryEncoding();
static void		FreeBinaryEncoding(ClientData clientData);
static Tcl_HashTable *	GetChannelTable(Tcl_Interp *interp);
static int		GetInput(Channel *chanPtr);
static int		HaveVersion(const Tcl_ChannelType *typePtr,
			    Tcl_ChannelTypeVersion minimumVersion);
static void		PeekAhead(Channel *chanPtr, char **dstEndPtr,
			    GetsState *gsPtr);
static int		ReadBytes(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft);
static int		ReadChars(ChannelState *statePtr, Tcl_Obj *objPtr,
			    int charsLeft, int *factorPtr);
static void		RecycleBuffer(ChannelState *statePtr,
			    ChannelBuffer *bufPtr, int mustDiscard);
static int		StackSetBlockMode(Channel *chanPtr, int mode);
static int		SetBlockMode(Tcl_Interp *interp, Channel *chanPtr,
			    int mode);
static void		StopCopy(CopyState *csPtr);
static void		TranslateInputEOL(ChannelState *statePtr, char *dst,
			    const char *src, int *dstLenPtr, int *srcLenPtr);
static void		UpdateInterest(Channel *chanPtr);
static int		Write(Channel *chanPtr, const char *src,
			    int srcLen, Tcl_Encoding encoding);
static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
static void		SpliceChannel(Tcl_Channel chan);
static void		CutChannel(Tcl_Channel chan);
static int              WillRead(Channel *chanPtr);
static int WillRead(Channel *chanPtr);

#define WriteChars(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, chanPtr->state->encoding)
#define WriteBytes(chanPtr, src, srcLen) \
			Write(chanPtr, src, srcLen, tclIdentityEncoding)

/*
 * Simplifying helper macros. All may use their argument(s) multiple times.
 * The ANSI C "prototypes" for the macros are listed below, together with a
 * short description of what the macro does.
 *
 * --------------------------------------------------------------------------
 * size_t BytesLeft(ChannelBuffer *bufPtr)
 * int BytesLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of data remaining in the buffer.
 *
 * int SpaceLeft(ChannelBuffer *bufPtr)
 *
 *	Returns the number of bytes of space remaining at the end of the
 *	buffer.
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
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







-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+







 * char *RemovePoint(ChannelBuffer *bufPtr)
 *
 *	Returns a pointer to where characters should be removed from the
 *	buffer.
 * --------------------------------------------------------------------------
 */

#define BytesLeft(bufPtr)	((size_t)((bufPtr)->nextAdded - (bufPtr)->nextRemoved))
#define BytesLeft(bufPtr) ((bufPtr)->nextAdded - (bufPtr)->nextRemoved)

#define SpaceLeft(bufPtr)	((size_t)((bufPtr)->bufLength - (bufPtr)->nextAdded))
#define SpaceLeft(bufPtr) ((bufPtr)->bufLength - (bufPtr)->nextAdded)

#define IsBufferReady(bufPtr)	((bufPtr)->nextAdded > (bufPtr)->nextRemoved)
#define IsBufferReady(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->nextRemoved)

#define IsBufferEmpty(bufPtr)	((bufPtr)->nextAdded == (bufPtr)->nextRemoved)
#define IsBufferEmpty(bufPtr) ((bufPtr)->nextAdded == (bufPtr)->nextRemoved)

#define IsBufferFull(bufPtr)	((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)
#define IsBufferFull(bufPtr) ((bufPtr) && (bufPtr)->nextAdded >= (bufPtr)->bufLength)

#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded>(bufPtr)->bufLength)
#define IsBufferOverflowing(bufPtr) ((bufPtr)->nextAdded > (bufPtr)->bufLength)

#define InsertPoint(bufPtr)	(&(bufPtr)->buf[(bufPtr)->nextAdded])
#define InsertPoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextAdded)

#define RemovePoint(bufPtr)	(&(bufPtr)->buf[(bufPtr)->nextRemoved])
#define RemovePoint(bufPtr) ((bufPtr)->buf + (bufPtr)->nextRemoved)

/*
 * For working with channel state flag bits.
 */

#define SetFlag(statePtr, flag)		((statePtr)->flags |= (flag))
#define ResetFlag(statePtr, flag)	((statePtr)->flags &= ~(flag))
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
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
524
525
526
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


450
451



452



453
454










455
456
457
458
459
460
461







-
+

-
+





-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
+
+




-
-
+
+


-
-
-
+
+
+
+
-













-
-
+
+

-






-





-
+






-
-
+
-
-





-
+
-
-
-
-
-
-
-
-
-

-
-
-
-
+
+
+
+





+
+
+
+
+
+
+
+
+
















-
+
-
-
-
-
-
+
+

-
+

-
-
-
+
+
-
-
-
-
-
+
-
-

-
-
+
+
-
-
-
+
-
-
-


-
-
-
-
-
-
-
-
-
-







 * a channel name in the context of an interp.  Saves the lookup
 * result and values needed to check its continued validity.
 */

typedef struct ResolvedChanName {
    ChannelState *statePtr;	/* The saved lookup result */
    Tcl_Interp *interp;		/* The interp in which the lookup was done. */
    size_t epoch;		/* The epoch of the channel when the lookup
    int epoch;			/* The epoch of the channel when the lookup
				 * was done. Use to verify validity. */
    size_t refCount;		/* Share this struct among many Tcl_Obj. */
    int refCount;		/* Share this struct among many Tcl_Obj. */
} ResolvedChanName;

static void		DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		FreeChannelIntRep(Tcl_Obj *objPtr);

static const Tcl_ObjType chanObjType = {
static Tcl_ObjType chanObjType = {
    "channel",			/* name for this type */
    FreeChannelIntRep,		/* freeIntRepProc */
    DupChannelIntRep,		/* dupIntRepProc */
    NULL,			/* updateStringProc */
    NULL			/* setFromAnyProc */
};

#define ChanSetIntRep(objPtr, resPtr)					\
    do {								\
	Tcl_ObjIntRep ir;						\
	(resPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (resPtr);					\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), &chanObjType, &ir);			\
    } while (0)

#define ChanGetIntRep(objPtr, resPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &chanObjType);		\
	(resPtr) = irPtr ? (ResolvedChanName *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

#define BUSY_STATE(st, fl) \
#define BUSY_STATE(st,fl) \
     ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
      (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))

#define MAX_CHANNEL_BUFFER_SIZE (1024*1024)

/*
 *---------------------------------------------------------------------------
 *
 * ChanClose, ChanRead, ChanSeek, ChanThreadAction, ChanWatch, ChanWrite --
 *
 *	Simplify the access to selected channel driver "methods" that are used
 *	in multiple places in a stereotypical fashion. These are just thin
 *	wrappers around the driver functions.
 *
 *---------------------------------------------------------------------------
 */

static inline int
ChanClose(
    Channel *chanPtr,
    Tcl_Interp *interp)
{
    return chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, 0);
}

/*
 *---------------------------------------------------------------------------
 *
 * ChanRead --
 *
 *	Read up to dstSize bytes using the inputProc of chanPtr, store them at
 *	dst, and return the number of bytes stored.
 *	Read up to dstSize bytes using the inputProc of chanPtr, store
 *	them at dst, and return the number of bytes stored.
 *
 * Results:
 *	The return value of the driver inputProc,
 *	  - number of bytes stored at dst, ot
 *	  - -1 on error, with a Posix error code available to the caller by
 *	    calling Tcl_GetErrno().
 *	  - -1 on error, with a Posix error code available to the
 *	    caller by calling Tcl_GetErrno().
 *
 * Side effects:
 *	The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are set
 *	as appropriate.  On EOF, the inputEncodingFlags are set to perform
 *	ending operations on decoding.
 *	The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are
 *	set as appropriate.
 *	On EOF, the inputEncodingFlags are set to perform ending operations
 *	on decoding.
 *
 *	TODO - Is this really the right place for that?
 *
 *---------------------------------------------------------------------------
 */
static int
ChanRead(
    Channel *chanPtr,
    char *dst,
    int dstSize)
{
    int bytesRead, result;

    /*
     * If the caller asked for zero bytes, we'd force the inputProc to return
     * zero bytes, and then misinterpret that as EOF.
     * If the caller asked for zero bytes, we'd force the inputProc
     * to return zero bytes, and then misinterpret that as EOF.
     */

    assert(dstSize > 0);

    /*
     * Each read op must set the blocked and eof states anew, not let
     * the effect of prior reads leak through.
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (WillRead(chanPtr) == -1) {
    if (WillRead(chanPtr) < 0) {
        return -1;
    }

    bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
	    dst, dstSize, &result);

    /*
     * Stop any flag leakage through stacked channel levels.
    /* Stop any flag leakage through stacked channel levels */
     */

    if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
        chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF);
    chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
    if (bytesRead == -1) {
    if (bytesRead > 0) {
	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	    result = EAGAIN;
	}
	Tcl_SetErrno(result);
    } else if (bytesRead == 0) {
	SetFlag(chanPtr->state, CHANNEL_EOF);
	chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
    } else {
	/*
	 * If we get a short read, signal up that we may be BLOCKED. We should
	 * avoid calling the driver because on some platforms we will block in
	 * the low level reading code even though the channel is set into
	 * nonblocking mode.
	 * If we get a short read, signal up that we may be BLOCKED.
	 * We should avoid calling the driver because on some
	 * platforms we will block in the low level reading code even
	 * though the channel is set into nonblocking mode.
	 */

	if (bytesRead < dstSize) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	}
    } else if (bytesRead == 0) {
	SetFlag(chanPtr->state, CHANNEL_EOF);
	chanPtr->state->inputEncodingFlags |= TCL_ENCODING_END;
    } else if (bytesRead < 0) {
	if ((result == EWOULDBLOCK) || (result == EAGAIN)) {
	    SetFlag(chanPtr->state, CHANNEL_BLOCKED);
	    result = EAGAIN;
	}
	Tcl_SetErrno(result);
    }
    return bytesRead;
}

static inline Tcl_WideInt
ChanSeek(
    Channel *chanPtr,
    Tcl_WideInt offset,
    int mode,
    int *errnoPtr)
{
    /*
     * Note that we prefer the wideSeekProc if that field is available in the
     * type and non-NULL.
     */

    if (Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL) {
    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
	*errnoPtr = EINVAL;
	return -1;
    }

	return Tcl_ChannelWideSeekProc(chanPtr->typePtr)(chanPtr->instanceData,
	    chanPtr->typePtr->wideSeekProc != NULL) {
	return chanPtr->typePtr->wideSeekProc(chanPtr->instanceData,
		offset, mode, errnoPtr);
}
    }

static inline void
ChanThreadAction(
    Channel *chanPtr,
    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
	*errnoPtr = EOVERFLOW;
    int action)
{
    Tcl_DriverThreadActionProc *threadActionProc =
	    Tcl_ChannelThreadActionProc(chanPtr->typePtr);

	return Tcl_LongAsWide(-1);
    if (threadActionProc != NULL) {
	threadActionProc(chanPtr->instanceData, action);
    }
}


    return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
static inline void
ChanWatch(
    Channel *chanPtr,
	    Tcl_WideAsLong(offset), mode, errnoPtr));
    int mask)
{
    chanPtr->typePtr->watchProc(chanPtr->instanceData, mask);
}

static inline int
ChanWrite(
    Channel *chanPtr,
    const char *src,
    int srcLen,
    int *errnoPtr)
{
    return chanPtr->typePtr->outputProc(chanPtr->instanceData, src, srcLen,
	    errnoPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclInitIOSubsystem --
 *
 *	Initialize all resources used by this subsystem on a per-process
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
618
619
620

621
622
623
624
625
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
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







+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















-
-
-
-
+
-
-






-
+



-
-

-
-
-
-
-
-
-
-
-
-
-
+
+
+

+
+
-
-
+
+
-












-
+






-
+












-
+
+
+
+
+
+







 *
 * Side effects:
 *	Depends on encoding and memory subsystems.
 *
 *-------------------------------------------------------------------------
 */

	/* ARGSUSED */
void
TclFinalizeIOSubsystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Channel *chanPtr = NULL;	/* Iterates over open channels. */
    ChannelState *statePtr;	/* State of channel stack */
    int active = 1;		/* Flag == 1 while there's still work to do */
    int doflushnb;

    /*
     * Fetch the pre-TIP#398 compatibility flag.
     */

    {
        const char *s;
        Tcl_DString ds;

        s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds);
        doflushnb = ((s != NULL) && strcmp(s, "0"));
        if (s != NULL) {
            Tcl_DStringFree(&ds);
        }
    }

    /*
     * Walk all channel state structures known to this thread and close
     * corresponding channels.
     */

    while (active) {
	/*
	 * Iterate through the open channel list, and find the first channel
	 * that isn't dead. We start from the head of the list each time,
	 * because the close action on one channel can close others.
	 */

	active = 0;
	for (statePtr = tsdPtr->firstCSPtr;
		statePtr != NULL;
		statePtr = statePtr->nextCSPtr) {
	    chanPtr = statePtr->topChanPtr;
            if (GotFlag(statePtr, CHANNEL_DEAD)) {
                continue;
            }
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED )
	    if (!GotFlag(statePtr, CHANNEL_INCLOSE|CHANNEL_CLOSED|CHANNEL_DEAD)) {
                || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
                ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
		active = 1;
		break;
	    }
	}

	/*
	 * We've found a live (or bg-closing) channel. Close it.
	 * We've found a live channel. Close it.
	 */

	if (active) {
	    TclChannelPreserve((Tcl_Channel)chanPtr);

	    /*
	     * TIP #398: by default, we no longer set the channel back into
             * blocking mode.  To restore the old blocking behavior, the
             * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
             * and not be "0".
	     */

            if (doflushnb) {
                /*
                 * Set the channel back into blocking mode to ensure that we
                 * wait for all data to flush out.
                 */
	     * Set the channel back into blocking mode to ensure that we wait
	     * for all data to flush out.
	     */

	    TclChannelPreserve((Tcl_Channel)chanPtr);

                (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
                                            "-blocking", "on");
	    (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
		    "-blocking", "on");
            }

	    if ((chanPtr == (Channel *) tsdPtr->stdinChannel) ||
		    (chanPtr == (Channel *) tsdPtr->stdoutChannel) ||
		    (chanPtr == (Channel *) tsdPtr->stderrChannel)) {
		/*
		 * Decrement the refcount which was earlier artificially
		 * bumped up to keep the channel from being closed.
		 */

		statePtr->refCount--;
	    }

	    if (statePtr->refCount + 1 <= 1) {
	    if (statePtr->refCount <= 0) {
		/*
		 * Close it only if the refcount indicates that the channel is
		 * not referenced from any interpreter. If it is, that
		 * interpreter will close the channel when it gets destroyed.
		 */

		(void) Tcl_CloseEx(NULL, (Tcl_Channel) chanPtr, 0);
		(void) Tcl_Close(NULL, (Tcl_Channel) chanPtr);
	    } else {
		/*
		 * The refcount is greater than zero, so flush the channel.
		 */

		Tcl_Flush((Tcl_Channel) chanPtr);

		/*
		 * Call the device driver to actually close the underlying
		 * device for this channel.
		 */

		(void) ChanClose(chanPtr, NULL);
		if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
		    (chanPtr->typePtr->closeProc)(chanPtr->instanceData, NULL);
		} else {
		    (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
			    NULL, 0);
		}

		/*
		 * Finally, we clean up the fields in the channel data
		 * structure since all of them have been deleted already. We
		 * mark the channel with CHANNEL_DEAD to prevent any further
		 * IO operations on it.
		 */
834
835
836
837
838
839
840
841

842
843
844
845
846
847
848
745
746
747
748
749
750
751

752
753
754
755
756
757
758
759







-
+







				 * channel will be closed. */
    ClientData clientData)	/* Arbitrary data to pass to the close
				 * callback. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
    CloseCallback *cbPtr;

    cbPtr = (CloseCallback *)Tcl_Alloc(sizeof(CloseCallback));
    cbPtr = (CloseCallback *) ckalloc(sizeof(CloseCallback));
    cbPtr->proc = proc;
    cbPtr->clientData = clientData;

    cbPtr->nextPtr = statePtr->closeCbPtr;
    statePtr->closeCbPtr = cbPtr;
}

880
881
882
883
884
885
886
887

888
889
890



891
892
893
894
895
896
897
791
792
793
794
795
796
797

798
799


800
801
802
803
804
805
806
807
808
809







-
+

-
-
+
+
+







	    cbPtr != NULL; cbPtr = cbPtr->nextPtr) {
	if ((cbPtr->proc == proc) && (cbPtr->clientData == clientData)) {
	    if (cbPrevPtr == NULL) {
		statePtr->closeCbPtr = cbPtr->nextPtr;
	    } else {
		cbPrevPtr->nextPtr = cbPtr->nextPtr;
	    }
	    Tcl_Free(cbPtr);
	    ckfree((char *) cbPtr);
	    break;
	}
	cbPrevPtr = cbPtr;
	} else {
	    cbPrevPtr = cbPtr;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetChannelTable --
913
914
915
916
917
918
919
920

921
922

923
924
925
926
927
928
929
825
826
827
828
829
830
831

832
833

834
835
836
837
838
839
840
841







-
+

-
+







static Tcl_HashTable *
GetChannelTable(
    Tcl_Interp *interp)
{
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_Channel stdinChan, stdoutChan, stderrChan;

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	hTblPtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclIO",
		(Tcl_InterpDeleteProc *) DeleteChannelTable, hTblPtr);

	/*
	 * If the interpreter is trusted (not "safe"), insert channels for
	 * stdin, stdout and stderr (possibly creating them in the process).
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
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







-
+


-
+

















-
+


-
+














+
-
+

-
+





-
+







				 * to the interpreter being deleted. */

    /*
     * Delete all the registered channels - this will close channels whose
     * refcount reaches zero.
     */

    hTblPtr = (Tcl_HashTable *)clientData;
    hTblPtr = clientData;
    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
	chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
	chanPtr = Tcl_GetHashValue(hPtr);
	statePtr = chanPtr->state;

	/*
	 * Remove any fileevents registered in this interpreter.
	 */

	for (sPtr = statePtr->scriptRecordPtr, prevPtr = NULL;
		sPtr != NULL; sPtr = nextPtr) {
	    nextPtr = sPtr->nextPtr;
	    if (sPtr->interp == interp) {
		if (prevPtr == NULL) {
		    statePtr->scriptRecordPtr = nextPtr;
		} else {
		    prevPtr->nextPtr = nextPtr;
		}

		Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
			TclChannelEventScriptInvoker, sPtr);
			TclChannelEventScriptInvoker, (ClientData) sPtr);

		TclDecrRefCount(sPtr->scriptPtr);
		Tcl_Free(sPtr);
		ckfree((char *) sPtr);
	    } else {
		prevPtr = sPtr;
	    }
	}

	/*
	 * Cannot call Tcl_UnregisterChannel because that procedure calls
	 * Tcl_GetAssocData to get the channel table, which might already be
	 * inaccessible from the interpreter structure. Instead, we emulate
	 * the behavior of Tcl_UnregisterChannel directly here.
	 */

	Tcl_DeleteHashEntry(hPtr);
	statePtr->epoch++;
	statePtr->refCount--;
	if (statePtr->refCount-- <= 1) {
	if (statePtr->refCount <= 0) {
	    if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		(void) Tcl_CloseEx(interp, (Tcl_Channel) chanPtr, 0);
		(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
	    }
	}

    }
    Tcl_DeleteHashTable(hTblPtr);
    Tcl_Free(hTblPtr);
    ckfree((char *) hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CheckForStdChannelsBeingClosed --
 *
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
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







-
+







-
+







-
+







{
    ChannelState *statePtr = ((Channel *) chan)->state;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->stdinInitialized == 1
	    && tsdPtr->stdinChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdinChannel)->state) {
	if (statePtr->refCount + 1 < 3) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdinChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stdoutInitialized == 1
	    && tsdPtr->stdoutChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stdoutChannel)->state) {
	if (statePtr->refCount + 1 < 3) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stdoutChannel = NULL;
	    return;
	}
    } else if (tsdPtr->stderrInitialized == 1
	    && tsdPtr->stderrChannel != NULL
	    && statePtr == ((Channel *)tsdPtr->stderrChannel)->state) {
	if (statePtr->refCount + 1 < 3) {
	if (statePtr->refCount < 2) {
	    statePtr->refCount = 0;
	    tsdPtr->stderrChannel = NULL;
	    return;
	}
    }
}

1216
1217
1218
1219
1220
1221
1222
1223
1224
1225


1226
1227
1228
1229
1230
1231
1232
1129
1130
1131
1132
1133
1134
1135



1136
1137
1138
1139
1140
1141
1142
1143
1144







-
-
-
+
+







{
    ChannelState *statePtr;	/* State of the real channel. */

    statePtr = ((Channel *) chan)->state->bottomChanPtr->state;

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	    Tcl_AppendResult(interp, "Illegal recursive call to close "
		    "through close-handler of channel", NULL);
	}
	return TCL_ERROR;
    }

    if (DetachChannel(interp, chan) != TCL_OK) {
	return TCL_OK;
    }
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
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







-
-
+
+


-
+



-
+

-
+





-
+








    CheckForStdChannelsBeingClosed(chan);

    /*
     * If the refCount reached zero, close the actual channel.
     */

    if (statePtr->refCount + 1 <= 1) {
	Tcl_Preserve(statePtr);
    if (statePtr->refCount <= 0) {
	Tcl_Preserve((ClientData)statePtr);
	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * We don't want to re-enter Tcl_CloseEx().
	     * We don't want to re-enter Tcl_Close().
	     */

	    if (!GotFlag(statePtr, CHANNEL_CLOSED)) {
		if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
		if (Tcl_Close(interp, chan) != TCL_OK) {
		    SetFlag(statePtr, CHANNEL_CLOSED);
		    Tcl_Release(statePtr);
		    Tcl_Release((ClientData)statePtr);
		    return TCL_ERROR;
		}
	    }
	}
	SetFlag(statePtr, CHANNEL_CLOSED);
	Tcl_Release(statePtr);
	Tcl_Release((ClientData)statePtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1353
1354
1355
1356
1357
1358
1359
1360

1361
1362
1363
1364
1365
1366
1367
1265
1266
1267
1268
1269
1270
1271

1272
1273
1274
1275
1276
1277
1278
1279







-
+







     * necessary during (un)stack operation.
     */

    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    statePtr = chanPtr->state;

    if (interp != NULL) {
	hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
	hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
	if (hTblPtr == NULL) {
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
	if (hPtr == NULL) {
	    return TCL_ERROR;
	}
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
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
1385







-
-
+
+










-
+


-
+







	    name = chanPtr->state->channelName;
	}
    }

    hTblPtr = GetChannelTable(interp);
    hPtr = Tcl_FindHashEntry(hTblPtr, name);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can not find channel named \"%s\"", chanName));
	Tcl_AppendResult(interp, "can not find channel named \"", chanName,
		"\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, NULL);
	return NULL;
    }

    /*
     * Always return bottom-most channel in the stack. This one lives the
     * longest - other channels may go away unnoticed. The other APIs
     * compensate where necessary to retrieve the topmost channel again.
     */

    chanPtr = (Channel *)Tcl_GetHashValue(hPtr);
    chanPtr = Tcl_GetHashValue(hPtr);
    chanPtr = chanPtr->state->bottomChanPtr;
    if (modePtr != NULL) {
	*modePtr = chanPtr->state->flags & (TCL_READABLE|TCL_WRITABLE);
	*modePtr = GotFlag(chanPtr->state, TCL_READABLE|TCL_WRITABLE);
    }

    return (Tcl_Channel) chanPtr;
}

/*
 *---------------------------------------------------------------------------
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
1531
1532
1533
1534

1535
1536
1537
1538
1539
1540
1541

1542

1543
1544
1545


1546
1547
1548




1549
1550
1551
1552

1553
1554
1555
1556
1557

1558
1559
1560

1561
1562
1563
1564
1565
1566
1567
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
1439
1440
1441
1442
1443

1444
1445
1446
1447
1448
1449


1450

1451
1452

1453
1454
1455



1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467

1468
1469
1470

1471
1472
1473
1474
1475
1476
1477
1478







-
+









-
+
-




+




-
-
+
+
-
-








-
+





-
-
+
-
+

-

+
+
-
-
-
+
+
+
+



-
+




-
+


-
+







				 * channel. */
    Tcl_Obj *objPtr,
    Tcl_Channel *channelPtr,
    int *modePtr,		/* Where to store the mode in which the
				 * channel was opened? Will contain an ORed
				 * combination of TCL_READABLE and
				 * TCL_WRITABLE, if non-NULL. */
    TCL_UNUSED(int) /*flags*/)
    int flags)
{
    ChannelState *statePtr;
    ResolvedChanName *resPtr = NULL;
    Tcl_Channel chan;

    if (interp == NULL) {
	return TCL_ERROR;
    }

    ChanGetIntRep(objPtr, resPtr);
    if (objPtr->typePtr == &chanObjType) {
    if (resPtr) {
	/*
 	 * Confirm validity of saved lookup results.
 	 */

	resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
	statePtr = resPtr->statePtr;
	if ((resPtr->interp == interp)		/* Same interp context */
			/* No epoch change in channel since lookup */
		&& (resPtr->epoch == statePtr->epoch)) {
	    /*
	     * Have a valid saved lookup. Jump to end to return it.

	    /* Have a valid saved lookup. Jump to end to return it. */
	     */

	    goto valid;
	}
    }

    chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);

    if (chan == NULL) {
	if (resPtr) {
	    Tcl_StoreIntRep(objPtr, &chanObjType, NULL);
	    FreeChannelIntRep(objPtr);
	}
	return TCL_ERROR;
    }

    if (resPtr && resPtr->refCount == 1) {
	/*
         * Re-use the ResolvedCmdName struct.
	/* Re-use the ResolvedCmdName struct */
         */
	Tcl_Release((ClientData) resPtr->statePtr);

	Tcl_Release(resPtr->statePtr);
    } else {
	TclFreeIntRep(objPtr);

	resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName));
	resPtr->refCount = 0;
	ChanSetIntRep(objPtr, resPtr);		/* Overwrites, if needed */
	resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
	resPtr->refCount = 1;
	objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
	objPtr->typePtr = &chanObjType;
    }
    statePtr = ((Channel *)chan)->state;
    resPtr->statePtr = statePtr;
    Tcl_Preserve(statePtr);
    Tcl_Preserve((ClientData) statePtr);
    resPtr->interp = interp;
    resPtr->epoch = statePtr->epoch;

  valid:
    *channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;
    *channelPtr = (Tcl_Channel) (statePtr->bottomChanPtr);

    if (modePtr != NULL) {
	*modePtr = statePtr->flags & (TCL_READABLE|TCL_WRITABLE);
	*modePtr = GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
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
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
1531
1532
1533
1534
1535
1536

1537
1538





1539

1540
1541

1542

1543

1544
1545
1546
1547
1548
1549
1550
1551







-
+









-












-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
+
+











-
+

-
-
-
-
-
+
-


-
+
-

-
+







 *	Creates a new Tcl_Channel instance and inserts it into the hash table.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_CreateChannel(
    const Tcl_ChannelType *typePtr, /* The channel type record. */
    Tcl_ChannelType *typePtr, /* The channel type record. */
    const char *chanName,	/* Name of channel to record. */
    ClientData instanceData,	/* Instance specific data. */
    int mask)			/* TCL_READABLE & TCL_WRITABLE to indicate if
				 * the channel is readable, writable. */
{
    Channel *chanPtr;		/* The channel structure newly created. */
    ChannelState *statePtr;	/* The stack-level independent state info for
				 * the channel. */
    const char *name;
    char *tmp;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * With the change of the Tcl_ChannelType structure to use a version in
     * 8.3.2+, we have to make sure that our assumption that the structure
     * remains a binary compatible size is true.
     *
     * If this assertion fails on some system, then it can be removed only if
     * the user recompiles code with older channel drivers in the new system
     * as well.
     */

    assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc *));
    assert(sizeof(Tcl_ChannelTypeVersion) == sizeof(Tcl_DriverBlockModeProc*));
    assert(typePtr->typeName != NULL);
    if (Tcl_ChannelVersion(typePtr) != TCL_CHANNEL_VERSION_5) {
	Tcl_Panic("channel type %s must be version TCL_CHANNEL_VERSION_5", typePtr->typeName);
    }
    if (typePtr->close2Proc == NULL) {
	Tcl_Panic("channel type %s must define close2Proc", typePtr->typeName);
    }
    if ((TCL_READABLE & mask) && (NULL == typePtr->inputProc)) {
	Tcl_Panic("channel type %s must define inputProc when used for reader channel", typePtr->typeName);
    }
    if ((TCL_WRITABLE & mask) &&  (NULL == typePtr->outputProc)) {
	Tcl_Panic("channel type %s must define outputProc when used for writer channel", typePtr->typeName);
    }
    if (NULL == typePtr->watchProc) {
	Tcl_Panic("channel type %s must define watchProc", typePtr->typeName);
    }

    /*
     * JH: We could subsequently memset these to 0 to avoid the numerous
     * assignments to 0/NULL below.
     */

    chanPtr = (Channel *)Tcl_Alloc(sizeof(Channel));
    statePtr = (ChannelState *)Tcl_Alloc(sizeof(ChannelState));
    chanPtr = (Channel *) ckalloc(sizeof(Channel));
    statePtr = (ChannelState *) ckalloc(sizeof(ChannelState));
    chanPtr->state = statePtr;

    chanPtr->instanceData = instanceData;
    chanPtr->typePtr = typePtr;

    /*
     * Set all the bits that are part of the stack-independent state
     * information for the channel.
     */

    if (chanName != NULL) {
	unsigned len = strlen(chanName) + 1;
	char *tmp = ckalloc((unsigned) (strlen(chanName) + 1));

	/*
         * Make sure we allocate at least 7 bytes, so it fits for "stdout"
         * later.
         */

	statePtr->channelName = tmp;
	tmp = (char *)Tcl_Alloc((len < 7) ? 7 : len);
	strcpy(tmp, chanName);
    } else {
	tmp = (char *)Tcl_Alloc(7);
	Tcl_Panic("Tcl_CreateChannel: NULL channel name");
	tmp[0] = '\0';
    }
    statePtr->channelName = tmp;

    statePtr->flags = mask;

    /*
     * Set the channel to system default encoding.
     *
     * Note the strange bit of protection taking place here. If the system
     * encoding name is reported back as "binary", something weird is
1676
1677
1678
1679
1680
1681
1682
1683

1684
1685
1686
1687
1688
1689
1690
1564
1565
1566
1567
1568
1569
1570

1571
1572
1573
1574
1575
1576
1577
1578







-
+







    statePtr->outputEncodingState = NULL;
    statePtr->outputEncodingFlags = TCL_ENCODING_START;

    /*
     * Set the channel up initially in AUTO input translation mode to accept
     * "\n", "\r" and "\r\n". Output translation mode is set to a platform
     * specific default value. The eofChar is set to 0 for both input and
     * output, so that Tcl does not look for an in-file EOF indicator (e.g.,
     * output, so that Tcl does not look for an in-file EOF indicator (e.g.
     * ^Z) and does not append an EOF indicator to files.
     */

    statePtr->inputTranslation	= TCL_TRANSLATE_AUTO;
    statePtr->outputTranslation	= TCL_PLATFORM_TRANSLATION;
    statePtr->inEofChar		= 0;
    statePtr->outEofChar	= 0;
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
1638
1639
1640
1641
1642
1643
1644

1645
1646
1647
1648

1649
1650
1651
1652

1653
1654
1655
1656
1657
1658
1659







-




-




-








    /*
     * Install this channel in the first empty standard channel slot, if the
     * channel was previously closed explicitly.
     */

    if ((tsdPtr->stdinChannel == NULL) && (tsdPtr->stdinInitialized == 1)) {
	strcpy(tmp, "stdin");
	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDIN);
	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
    } else if ((tsdPtr->stdoutChannel == NULL) &&
	    (tsdPtr->stdoutInitialized == 1)) {
	strcpy(tmp, "stdout");
	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDOUT);
	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
    } else if ((tsdPtr->stderrChannel == NULL) &&
	    (tsdPtr->stderrInitialized == 1)) {
	strcpy(tmp, "stderr");
	Tcl_SetStdChannel((Tcl_Channel) chanPtr, TCL_STDERR);
	Tcl_RegisterChannel(NULL, (Tcl_Channel) chanPtr);
    }
    return (Tcl_Channel) chanPtr;
}

/*
1797
1798
1799
1800
1801
1802
1803
1804
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
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







-
-
+










+

















-
-
-
+
+

















-
+

-
-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_StackChannel(
    Tcl_Interp *interp,		/* The interpreter we are working in */
    const Tcl_ChannelType *typePtr,
				/* The channel type record for the new
    Tcl_ChannelType *typePtr,	/* The channel type record for the new
				 * channel. */
    ClientData instanceData,	/* Instance specific data for the new
				 * channel. */
    int mask,			/* TCL_READABLE & TCL_WRITABLE to indicate if
				 * the channel is readable, writable. */
    Tcl_Channel prevChan)	/* The channel structure to replace */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Channel *chanPtr, *prevChanPtr;
    ChannelState *statePtr;
    Tcl_DriverThreadActionProc *threadActionProc;

    /*
     * Find the given channel (prevChan) in the list of all channels. If we do
     * not find it, then it was never registered correctly.
     *
     * This operation should occur at the top of a channel stack.
     */

    statePtr = (ChannelState *) tsdPtr->firstCSPtr;
    prevChanPtr = ((Channel *) prevChan)->state->topChanPtr;

    while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) {
	statePtr = statePtr->nextCSPtr;
    }

    if (statePtr == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't find state for channel \"%s\"",
		    Tcl_GetChannelName(prevChan)));
	    Tcl_AppendResult(interp, "couldn't find state for channel \"",
		    Tcl_GetChannelName(prevChan), "\"", NULL);
	}
	return NULL;
    }

    /*
     * Here we check if the given "mask" matches the "flags" of the already
     * existing channel.
     *
     *	  | - | R | W | RW |
     *	--+---+---+---+----+	<=>  0 != (chan->mask & prevChan->mask)
     *	- |   |   |   |    |
     *	R |   | + |   | +  |	The superceding channel is allowed to restrict
     *	W |   |   | + | +  |	the capabilities of the superceded one!
     *	RW|   | + | + | +  |
     *	--+---+---+---+----+
     */

    if ((mask & (statePtr->flags & (TCL_READABLE | TCL_WRITABLE))) == 0) {
    if ((mask & (GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE))) == 0) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "reading and writing both disallowed for channel \"%s\"",
		    Tcl_GetChannelName(prevChan)));
	    Tcl_AppendResult(interp,
		    "reading and writing both disallowed for channel \"",
		    Tcl_GetChannelName(prevChan), "\"", NULL);
	}
	return NULL;
    }

    /*
     * Flush the buffers. This ensures that any data still in them at this
     * time is not handled by the new transformation. Restrict this to
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886


1887
1888
1889
1890
1891
1892
1893
1761
1762
1763
1764
1765
1766
1767



1768
1769
1770
1771
1772
1773
1774
1775
1776







-
-
-
+
+







	 * TODO: Examine what can go wrong if Tcl_Flush() call disturbs
	 * the stacking state of this channel during its operations.
	 */
	if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) {
	    statePtr->csPtrR = csPtrR;
	    statePtr->csPtrW = csPtrW;
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "could not flush channel \"%s\"",
			Tcl_GetChannelName(prevChan)));
		Tcl_AppendResult(interp, "could not flush channel \"",
			Tcl_GetChannelName(prevChan), "\"", NULL);
	    }
	    return NULL;
	}

	statePtr->csPtrR = csPtrR;
	statePtr->csPtrW = csPtrW;
    }
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
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







+















-
+







     * the channel itself. We use the buffers in the channel below the new
     * transformation to hold the data. In the future this allows us to write
     * transformations which pre-read data and push the unused part back when
     * they are going away.
     */

    if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {

	/*
	 * When statePtr->inQueueHead is not NULL, we know
	 * prevChanPtr->inQueueHead must be NULL.
	 */

	assert(prevChanPtr->inQueueHead == NULL);
	assert(prevChanPtr->inQueueTail == NULL);

	prevChanPtr->inQueueHead = statePtr->inQueueHead;
	prevChanPtr->inQueueTail = statePtr->inQueueTail;

	statePtr->inQueueHead = NULL;
	statePtr->inQueueTail = NULL;
    }

    chanPtr = (Channel *)Tcl_Alloc(sizeof(Channel));
    chanPtr = (Channel *) ckalloc(sizeof(Channel));

    /*
     * Save some of the current state into the new structure, reinitialize the
     * parts which will stay with the transformation.
     *
     * Remarks:
     */
1956
1957
1958
1959
1960
1961
1962


1963


1964
1965
1966
1967
1968
1969
1970
1840
1841
1842
1843
1844
1845
1846
1847
1848

1849
1850
1851
1852
1853
1854
1855
1856
1857







+
+
-
+
+







     * use SpliceChannel, because the (thread-)global list of all channels
     * always contains the _ChannelState_ for a stack of channels, not the
     * individual channels. And SpliceChannel would not only call the thread
     * actions, but also add the shared ChannelState to this list a second
     * time, mangling it.
     */

    threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
    if (threadActionProc != NULL) {
    ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
	(*threadActionProc)(chanPtr->instanceData, TCL_CHANNEL_THREAD_INSERT);
    }

    return (Tcl_Channel) chanPtr;
}

void
TclChannelPreserve(
    Tcl_Channel chan)
1981
1982
1983
1984
1985
1986
1987
1988

1989
1990
1991
1992
1993
1994
1995
1996
1997


1998
1999
2000
2001
2002
2003
2004
1868
1869
1870
1871
1872
1873
1874

1875
1876
1877
1878
1879
1880
1881
1882


1883
1884
1885
1886
1887
1888
1889
1890
1891







-
+







-
-
+
+







    if (chanPtr->refCount == 0) {
	Tcl_Panic("Channel released more than preserved");
    }
    if (--chanPtr->refCount) {
	return;
    }
    if (chanPtr->typePtr == NULL) {
	Tcl_Free(chanPtr);
	ckfree((char *)chanPtr);
    }
}

static void
ChannelFree(
    Channel *chanPtr)
{
    if (!chanPtr->refCount) {
	Tcl_Free(chanPtr);
    if (chanPtr->refCount == 0) {
	ckfree((char *)chanPtr);
	return;
    }
    chanPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
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
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







+










-
-
-
-
+
+
+
+
+
+







Tcl_UnstackChannel(
    Tcl_Interp *interp,		/* The interpreter we are working in */
    Tcl_Channel chan)		/* The channel to unstack */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
    int result = 0;
    Tcl_DriverThreadActionProc *threadActionProc;

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (chanPtr->downChanPtr != NULL) {
	/*
	 * Instead of manipulating the per-thread / per-interp list/hashtable
	 * of registered channels we wind down the state of the
	 * transformation, and then restore the state of underlying channel
	 * into the old structure.
	 *
	 * of registered channels we wind down the state of the transformation,
	 * and then restore the state of underlying channel into the old
	 * structure.
	 */

	/*
	 * TODO: Figure out how to handle the situation where the chan
	 * operations called below by this unstacking operation cause
	 * another unstacking recursively.  In that case the downChanPtr
	 * value we're holding on to will not be the right thing.
	 */

	Channel *downChanPtr = chanPtr->downChanPtr;
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081



2082
2083
2084
2085
2086
2087
2088
1962
1963
1964
1965
1966
1967
1968



1969
1970
1971
1972
1973
1974
1975
1976
1977
1978







-
-
-
+
+
+







		 * Move error messages put by the driver into the chan/ip
		 * bypass area into the regular interpreter result. Fall back
		 * to the regular message if nothing was found in the
		 * bypasses.
		 */

		if (!TclChanCaughtErrorBypass(interp, chan) && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "could not flush channel \"%s\"",
			    Tcl_GetChannelName((Tcl_Channel) chanPtr)));
		    Tcl_AppendResult(interp, "could not flush channel \"",
			    Tcl_GetChannelName((Tcl_Channel) chanPtr), "\"",
			    NULL);
		}
		return TCL_ERROR;
	    }

	    statePtr->csPtrR  = csPtrR;
	    statePtr->csPtrW = csPtrW;
	}
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
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







+
+
+
-
+
+













+
+
-
+
+
+
+
+
+







	 * channels always contains the _ChannelState_ for a stack of
	 * channels, not the individual channels. And SpliceChannel would not
	 * only call the thread actions, but also remove the shared
	 * ChannelState from this list despite there being more channels for
	 * the state which are still active.
	 */

	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
	if (threadActionProc != NULL) {
	    (*threadActionProc)(chanPtr->instanceData,
	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
		    TCL_CHANNEL_THREAD_REMOVE);
	}

	statePtr->topChanPtr = downChanPtr;
	downChanPtr->upChanPtr = NULL;

	/*
	 * Leave this link intact for closeproc
	 *  chanPtr->downChanPtr = NULL;
	 */

	/*
	 * Close and free the channel driver state.
	 */

	if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
	    result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData,
	result = ChanClose(chanPtr, interp);
		    interp);
	} else {
	    result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
		    interp, 0);
	}

	ChannelFree(chanPtr);

	UpdateInterest(statePtr->topChanPtr);

	if (result != 0) {
	    Tcl_SetErrno(result);

2161
2162
2163
2164
2165
2166
2167
2168
2169


2170
2171
2172
2173
2174
2175
2176
2062
2063
2064
2065
2066
2067
2068


2069
2070
2071
2072
2073
2074
2075
2076
2077







-
-
+
+







	}
    } else {
	/*
	 * This channel does not cover another one. Simply do a close, if
	 * necessary.
	 */

	if (statePtr->refCount + 1 <= 1) {
	    if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
	if (statePtr->refCount <= 0) {
	    if (Tcl_Close(interp, chan) != TCL_OK) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * "TclChanCaughtErrorBypass" is not required here, it was
		 * done already by "Tcl_Close".
		 */

		return TCL_ERROR;
2309
2310
2311
2312
2313
2314
2315
2316

2317
2318
2319
2320
2321
2322
2323
2210
2211
2212
2213
2214
2215
2216

2217
2218
2219
2220
2221
2222
2223
2224







-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const Tcl_ChannelType *
Tcl_ChannelType *
Tcl_GetChannelType(
    Tcl_Channel chan)		/* The channel to return type for. */
{
    Channel *chanPtr = (Channel *) chan;
				/* The actual channel. */

    return chanPtr->typePtr;
2344
2345
2346
2347
2348
2349
2350
2351

2352
2353
2354
2355
2356
2357
2358
2245
2246
2247
2248
2249
2250
2251

2252
2253
2254
2255
2256
2257
2258
2259







-
+







Tcl_GetChannelMode(
    Tcl_Channel chan)		/* The channel for which the mode is being
				 * computed. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of actual channel. */

    return (statePtr->flags & (TCL_READABLE | TCL_WRITABLE));
    return GotFlag(statePtr, TCL_READABLE | TCL_WRITABLE);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChannelName --
 *
2368
2369
2370
2371
2372
2373
2374
2375
2376

2377

2378
2379
2380
2381
2382
2383
2384
2269
2270
2271
2272
2273
2274
2275


2276
2277
2278
2279
2280
2281
2282
2283
2284
2285







-
-
+

+







 *----------------------------------------------------------------------
 */

const char *
Tcl_GetChannelName(
    Tcl_Channel chan)		/* The channel for which to return the name. */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of actual channel. */
    ChannelState *statePtr;	/* State of actual channel. */

    statePtr = ((Channel *) chan)->state;
    return statePtr->channelName;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChannelHandle --
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412





2413
2414
2415
2416


2417
2418
2419
2420
2421
2422
2423
2304
2305
2306
2307
2308
2309
2310



2311
2312
2313
2314
2315
2316
2317


2318
2319
2320
2321
2322
2323
2324
2325
2326







-
-
-
+
+
+
+
+


-
-
+
+







{
    Channel *chanPtr;		/* The actual channel. */
    ClientData handle;
    int result;

    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    if (!chanPtr->typePtr->getHandleProc) {
        Tcl_SetChannelError(chan, Tcl_ObjPrintf(
                "channel \"%s\" does not support OS handles",
                Tcl_GetChannelName(chan)));
	Tcl_Obj* err;
	TclNewLiteralStringObj(err, "channel \"");
	Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1);
	Tcl_AppendToObj(err, "\" does not support OS handles", -1);
	Tcl_SetChannelError (chan,err);
	return TCL_ERROR;
    }
    result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction,
	    &handle);
    result = (chanPtr->typePtr->getHandleProc)(chanPtr->instanceData,
	    direction, &handle);
    if (handlePtr) {
	*handlePtr = handle;
    }
    return result;
}

/*
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
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







-
+












-
-
-










-
+






-
+







AllocChannelBuffer(
    int length)			/* Desired length of channel buffer. */
{
    ChannelBuffer *bufPtr;
    int n;

    n = length + CHANNELBUFFER_HEADER_SIZE + BUFFER_PADDING + BUFFER_PADDING;
    bufPtr = (ChannelBuffer *)Tcl_Alloc(n);
    bufPtr = (ChannelBuffer *) ckalloc((unsigned) n);
    bufPtr->nextAdded	= BUFFER_PADDING;
    bufPtr->nextRemoved	= BUFFER_PADDING;
    bufPtr->bufLength	= length + BUFFER_PADDING;
    bufPtr->nextPtr	= NULL;
    bufPtr->refCount	= 1;
    return bufPtr;
}

static void
PreserveChannelBuffer(
    ChannelBuffer *bufPtr)
{
    if (!bufPtr->refCount) {
	Tcl_Panic("Reuse of ChannelBuffer! %p", bufPtr);
    }
    bufPtr->refCount++;
}

static void
ReleaseChannelBuffer(
    ChannelBuffer *bufPtr)
{
    if (--bufPtr->refCount) {
	return;
    }
    Tcl_Free(bufPtr);
    ckfree((char *) bufPtr);
}

static int
IsShared(
    ChannelBuffer *bufPtr)
{
    return bufPtr->refCount + 1 > 2;
    return bufPtr->refCount > 1;
}

/*
 *----------------------------------------------------------------------
 *
 * RecycleBuffer --
 *
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
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







-










-
-
+
+
+







    ChannelBuffer *bufPtr,	/* The buffer to recycle. */
    int mustDiscard)		/* If nonzero, free the buffer to the OS,
				 * always. */
{
    /*
     * Do we have to free the buffer to the OS?
     */

    if (IsShared(bufPtr)) {
	mustDiscard = 1;
    }

    if (mustDiscard) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

    /*
     * Only save buffers which have the requested buffersize for the channel.
     * This is to honor dynamic changes of the buffersize made by the user.
     * Only save buffers which have the requested buffersize for the
     * channel. This is to honor dynamic changes of the buffersize
     * made by the user.
     */

    if ((bufPtr->bufLength - BUFFER_PADDING) != statePtr->bufSize) {
	ReleaseChannelBuffer(bufPtr);
	return;
    }

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



2658
2659
2660
2661
2662
2663
2664
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







-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







-
-
-
+
+
+







 */

static int
CheckForDeadChannel(
    Tcl_Interp *interp,		/* For error reporting (can be NULL) */
    ChannelState *statePtr)	/* The channel state to check. */
{
    if (!GotFlag(statePtr, CHANNEL_DEAD)) {
    if (GotFlag(statePtr, CHANNEL_DEAD)) {
	return 0;
    }

    Tcl_SetErrno(EINVAL);
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
                "unable to access channel: invalid channel", -1));
    }
    return 1;
	Tcl_SetErrno(EINVAL);
	if (interp) {
	    Tcl_AppendResult(interp,
		    "unable to access channel: invalid channel", NULL);
	}
	return 1;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * FlushChannel --
 *
 *	This function flushes as much of the queued output as is possible now.
 *	If calledFromAsyncFlush is nonzero, it is being called in an event
 *	handler to flush channel output asynchronously.
 *	This function flushes as much of the queued output as is possible
 *	now. If calledFromAsyncFlush is nonzero, it is being called in an
 *	event handler to flush channel output asynchronously.
 *
 * Results:
 *	0 if successful, else the error code that was returned by the channel
 *	type operation. May leave a message in the interp result.
 *
 * Side effects:
 *	May produce output on a channel. May block indefinitely if the channel
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704


2705
2706
2707
2708
2709




2710
2711
2712


2713
2714
2715
2716
2717
2718
2719
2720
2594
2595
2596
2597
2598
2599
2600



2601
2602





2603
2604
2605
2606



2607
2608

2609
2610
2611
2612
2613
2614
2615







-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
+
+
-







    if (CheckForDeadChannel(interp, statePtr)) {
	return -1;
    }

    /*
     * Should we shift the current output buffer over to the output queue?
     * First check that there are bytes in it.  If so then...
     *
     * If the output queue is empty, then yes, trusting the caller called us
     * only when written bytes ought to be flushed.
     * If the output queue is empty, then yes, trusting the caller called
     * us only when written bytes ought to be flushed.
     *
     * If the current output buffer is full, then yes, so we can meet the
     * post-condition that on a successful return to caller we've left space
     * in the current output buffer for more writing (the flush call was to
     * make new room).
     * If the current output buffer is full, then yes, so we can meet
     * the post-condition that on a successful return to caller we've
     * left space in the current output buffer for more writing (the flush
     * call was to make new room).
     *
     * If the channel is blocking, then yes, so we guarantee that blocking
     * flushes actually flush all pending data.
     * If the channel is blocking, then yes, so we guarantee that 
     * blocking flushes actually flush all pending data.
     *
     * Otherwise, no.  Keep the current output buffer where it is so more
     * can be written to it, possibly filling it, to promote more efficient
     * buffer usage.
     */

    bufPtr = statePtr->curOutPtr;
    if (bufPtr && BytesLeft(bufPtr) && /* Keep empties off queue */
2750
2751
2752
2753
2754
2755
2756

2757

2758
2759
2760
2761
2762
2763
2764
2765
2645
2646
2647
2648
2649
2650
2651
2652

2653

2654
2655
2656
2657
2658
2659
2660







+
-
+
-







	bufPtr = statePtr->outQueueHead;

	/*
	 * Produce the output on the channel.
	 */

	PreserveChannelBuffer(bufPtr);
	written = (chanPtr->typePtr->outputProc)(chanPtr->instanceData,
	written = ChanWrite(chanPtr, RemovePoint(bufPtr), BytesLeft(bufPtr),
		RemovePoint(bufPtr), BytesLeft(bufPtr), &errorCode);
		&errorCode);

	/*
	 * If the write failed completely attempt to start the asynchronous
	 * flush mechanism and break out of this loop - do not attempt to
	 * write any more output at this time.
	 */

2783
2784
2785
2786
2787
2788
2789
2790

2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808


2809
2810
2811
2812
2813
2814
2815
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
2709
2710







-
+
















-
-
+
+







		/*
		 * This used to check for CHANNEL_NONBLOCKING, and panic if
		 * the channel was blocking. However, it appears that setting
		 * stdin to -blocking 0 has some effect on the stdout when
		 * it's a tty channel (dup'ed underneath)
		 */

		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED) && !TclInExit()) {
		if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
		    SetFlag(statePtr, BG_FLUSH_SCHEDULED);
		    UpdateInterest(chanPtr);
		}
		errorCode = 0;
		ReleaseChannelBuffer(bufPtr);
		break;
	    }

	    /*
	     * Decide whether to report the error upwards or defer it.
	     */

	    if (calledFromAsyncFlush) {
		/*
		 * TIP #219, Tcl Channel Reflection API.
		 * When defering the error copy a message from the bypass into
		 * the unreported area. Or discard it if the new error is to
		 * be ignored in favor of an earlier defered error.
		 * the unreported area. Or discard it if the new error is to be
		 * ignored in favor of an earlier defered error.
		 */

		Tcl_Obj *msg = statePtr->chanMsg;

		if (statePtr->unreportedError == 0) {
		    statePtr->unreportedError = errorCode;
		    statePtr->unreportedMsg = msg;
2834
2835
2836
2837
2838
2839
2840





2841
2842



2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862


2863
2864
2865
2866
2867
2868
2869
2870
2871
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740


2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760



2761
2762


2763
2764
2765
2766
2767
2768
2769







+
+
+
+
+
-
-
+
+
+

















-
-
-
+
+
-
-







		 * area into the regular interpreter result. Fall back to the
		 * regular message if nothing was found in the bypasses.
		 */

		Tcl_SetErrno(errorCode);
		if (interp != NULL && !TclChanCaughtErrorBypass(interp,
			(Tcl_Channel) chanPtr)) {
		    /*
		     * Casting away const here is safe because the
		     * TCL_VOLATILE flag guarantees const treatment of the
		     * Posix error string.
		     */
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(Tcl_PosixError(interp), -1));

		    Tcl_SetResult(interp, (char *) Tcl_PosixError(interp),
			    TCL_VOLATILE);
		}

		/*
		 * An unreportable bypassed message is kept, for the caller of
		 * Tcl_Seek, Tcl_Write, etc.
		 */
	    }

	    /*
	     * When we get an error we throw away all the output currently
	     * queued.
	     */

	    DiscardOutputQueued(statePtr);
	    ReleaseChannelBuffer(bufPtr);
	    break;
	} else {
	    /*
	     * TODO: Consider detecting and reacting to short writes on
	     * blocking channels.  Ought not happen.  See iocmd-24.2.
	    /* TODO: Consider detecting and reacting to short writes
	     * on blocking channels.  Ought not happen.  See iocmd-24.2. */
	     */

	    wroteSome = 1;
	}

	bufPtr->nextRemoved += written;

	/*
	 * If this buffer is now empty, recycle it.
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
2787
2788
2789
2790
2791
2792
2793
2794

2795
2796





2797
2798
2799
2800










2801


2802
2803
2804
2805
2806
2807
2808
2809
2810

2811
2812
2813
2814
2815

2816
















2817
2818
2819
2820
2821
2822
2823







+
-
+

-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-









-
+




-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







     */

    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	if (wroteSome) {
	    goto done;
	} else if (statePtr->outQueueHead == NULL) {
	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
	    (chanPtr->typePtr->watchProc)(chanPtr->instanceData,
	    ChanWatch(chanPtr, statePtr->interestMask);
		    statePtr->interestMask);
	} else {
	    /*
	     * When we are calledFromAsyncFlush, that means a writable
	     * state on the channel triggered the call, so we should be
	     * able to write something.  Either we did write something
	     * and wroteSome should be set, or there was nothing left to
	    /* TODO: If code reaches this point, it means a writable
	     * event is being handled on the channel, but the channel
	     * could not in fact be written to.  This ought not happen,
	     * but Unix pipes appear to act this way (see io-53.4).
	     * write in this call, and we've completed the BG flush.
	     * These are the two cases above.  If we get here, that means
	     * there is some kind failure in the writable event machinery.
	     *
	     * The tls extension indeed suffers from flaws in its channel
	     * event mgmt.  See https://core.tcl-lang.org/tcl/info/c31ca233ca.
	     * Until that patch is broadly distributed, disable the
	     * assertion checking here, so that programs using Tcl and
	     * tls can be debugged.

	     * Also can imagine broken reflected channels. */
	    assert(!calledFromAsyncFlush);
	     */
	}
    }

    /*
     * If the channel is flagged as closed, delete it when the refCount drops
     * to zero, the output queue is empty and there is no output in the
     * current output buffer.
     */

    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount + 1 <= 1) &&
    if (GotFlag(statePtr, CHANNEL_CLOSED) && (statePtr->refCount <= 0) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannel(interp, chanPtr, errorCode);
	goto done;
    }

    /*
     * If the write-side of the channel is flagged as closed, delete it when
     * the output queue is empty and there is no output in the current output
     * buffer.
     */

    if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) &&
	    (statePtr->outQueueHead == NULL) &&
	    ((statePtr->curOutPtr == NULL) ||
	    IsBufferEmpty(statePtr->curOutPtr))) {
	errorCode = CloseChannelPart(interp, chanPtr, errorCode,
                TCL_CLOSE_WRITE);
	goto done;
    }

  done:
    TclChannelRelease((Tcl_Channel)chanPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
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
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
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







-
+










-
+
















+
+
+
+
-
+
+








-
+







     * device.
     */

    if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
	int dummy;
	char c = (char) statePtr->outEofChar;

	(void) ChanWrite(chanPtr, &c, 1, &dummy);
	(chanPtr->typePtr->outputProc)(chanPtr->instanceData, &c, 1, &dummy);
    }

    /*
     * TIP #219, Tcl Channel Reflection API.
     * Move a leftover error message in the channel bypass into the
     * interpreter bypass. Just clear it if there is no interpreter.
     */

    if (statePtr->chanMsg != NULL) {
	if (interp != NULL) {
	    Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
	    Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
	}
	TclDecrRefCount(statePtr->chanMsg);
	statePtr->chanMsg = NULL;
    }

    /*
     * Remove this channel from of the list of all channels.
     */

    CutChannel((Tcl_Channel) chanPtr);

    /*
     * Close and free the channel driver state.
     * This may leave a TIP #219 error message in the interp.
     */

    if (chanPtr->typePtr->closeProc != TCL_CLOSE2PROC) {
	result = (chanPtr->typePtr->closeProc)(chanPtr->instanceData, interp);
    } else {
	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData,
    result = ChanClose(chanPtr, interp);
		interp, 0);
    }

    /*
     * Some resources can be cleared only if the bottom channel in a stack is
     * closed. All the other channels in the stack are not allowed to remove.
     */

    if (chanPtr == statePtr->bottomChanPtr) {
	if (statePtr->channelName != NULL) {
	    Tcl_Free(statePtr->channelName);
	    ckfree((char *) statePtr->channelName);
	    statePtr->channelName = NULL;
	}

	Tcl_FreeEncoding(statePtr->encoding);
    }

    /*
3079
3080
3081
3082
3083
3084
3085
3086

3087
3088
3089
3090
3091
3092
3093
2954
2955
2956
2957
2958
2959
2960

2961
2962
2963
2964
2965
2966
2967
2968







-
+







	 */

	if (statePtr->chanMsg != NULL) {
	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
	if (interp) {
	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
	    Tcl_SetChannelErrorInterp(interp,statePtr->unreportedMsg);
	}
    }
    if (errorCode == 0) {
	errorCode = result;
	if (errorCode != 0) {
	    Tcl_SetErrno(errorCode);
	}
3110
3111
3112
3113
3114
3115
3116
3117

3118
3119
3120
3121
3122
3123
3124
2985
2986
2987
2988
2989
2990
2991

2992
2993
2994
2995
2996
2997
2998
2999







-
+







	tsdPtr->firstCSPtr = statePtr;

	statePtr->topChanPtr = downChanPtr;
	downChanPtr->upChanPtr = NULL;

	ChannelFree(chanPtr);

	return Tcl_CloseEx(interp, (Tcl_Channel) downChanPtr, 0);
	return Tcl_Close(interp, (Tcl_Channel) downChanPtr);
    }

    /*
     * There is only the TOP Channel, so we free the remaining pointers we
     * have and then ourselves. Since this is the last of the channels in the
     * stack, make sure to free the ChannelState structure associated with it.
     */
3162
3163
3164
3165
3166
3167
3168

3169
3170
3171
3172
3173
3174
3175
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051







+







{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ChannelState *prevCSPtr;	/* Preceding channel state in list of all
				 * states - used to splice a channel out of
				 * the list on close. */
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of the channel stack. */
    Tcl_DriverThreadActionProc *threadActionProc;

    /*
     * Remove this channel from of the list of all channels (in the current
     * thread).
     */

    if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
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
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







+
+
+
-
-
+
+
-
-














+








    statePtr->nextCSPtr = NULL;

    /*
     * TIP #218, Channel Thread Actions
     */

    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
    if (threadActionProc != NULL) {
	(*threadActionProc)(Tcl_GetChannelInstanceData(chan),
    ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_REMOVE);

		TCL_CHANNEL_THREAD_REMOVE);
    }
    /* Channel is not managed by any thread */
    statePtr->managingThread = NULL;
}

void
Tcl_CutChannel(
    Tcl_Channel chan)		/* The channel being added. Must not be
				 * referenced in any interpreter. */
{
    Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ChannelState *prevCSPtr;	/* Preceding channel state in list of all
				 * states - used to splice a channel out of
				 * the list on close. */
    ChannelState *statePtr = chanPtr->state;
				/* State of the channel stack. */
    Tcl_DriverThreadActionProc *threadActionProc;

    /*
     * Remove this channel from of the list of all channels (in the current
     * thread).
     */

    if (tsdPtr->firstCSPtr && (statePtr == tsdPtr->firstCSPtr)) {
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243








3244
3245
3246
3247
3248
3249
3250
3251
3252
3111
3112
3113
3114
3115
3116
3117




3118
3119
3120
3121
3122
3123
3124
3125


3126
3127
3128
3129
3130
3131
3132







-
-
-
-
+
+
+
+
+
+
+
+
-
-







    statePtr->nextCSPtr = NULL;

    /*
     * TIP #218, Channel Thread Actions
     * For all transformations and the base channel.
     */

    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_REMOVE);
    }

    while (chanPtr) {
	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
	if (threadActionProc != NULL) {
	    (*threadActionProc)(chanPtr->instanceData,
		    TCL_CHANNEL_THREAD_REMOVE);
	}
	chanPtr= chanPtr->upChanPtr;
    }
    /* Channel is not managed by any thread */
    statePtr->managingThread = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SpliceChannel --
 * SpliceChannel --
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
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







+




















+
+
+
-
+
+










+







static void
SpliceChannel(
    Tcl_Channel chan)		/* The channel being added. Must not be
				 * referenced in any interpreter. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ChannelState *statePtr = ((Channel *) chan)->state;
    Tcl_DriverThreadActionProc *threadActionProc;

    if (statePtr->nextCSPtr != NULL) {
	Tcl_Panic("SpliceChannel: trying to add channel used in different list");
    }

    statePtr->nextCSPtr = tsdPtr->firstCSPtr;
    tsdPtr->firstCSPtr = statePtr;

    /*
     * TIP #10. Mark the current thread as the new one managing this channel.
     *		Note: 'Tcl_GetCurrentThread' returns sensible values even for
     *		a non-threaded core.
     */

    statePtr->managingThread = Tcl_GetCurrentThread();

    /*
     * TIP #218, Channel Thread Actions
     */

    threadActionProc = Tcl_ChannelThreadActionProc(Tcl_GetChannelType(chan));
    if (threadActionProc != NULL) {
	(*threadActionProc) (Tcl_GetChannelInstanceData(chan),
    ChanThreadAction((Channel *) chan, TCL_CHANNEL_THREAD_INSERT);
		TCL_CHANNEL_THREAD_INSERT);
    }
}

void
Tcl_SpliceChannel(
    Tcl_Channel chan)		/* The channel being added. Must not be
				 * referenced in any interpreter. */
{
    Channel *chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ChannelState *statePtr = chanPtr->state;
    Tcl_DriverThreadActionProc *threadActionProc;

    if (statePtr->nextCSPtr != NULL) {
	Tcl_Panic("SpliceChannel: trying to add channel used in different list");
    }

    statePtr->nextCSPtr = tsdPtr->firstCSPtr;
    tsdPtr->firstCSPtr = statePtr;
3326
3327
3328
3329
3330
3331
3332
3333
3334







3335
3336
3337
3338
3339
3340
3341
3212
3213
3214
3215
3216
3217
3218


3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232







-
-
+
+
+
+
+
+
+







    statePtr->managingThread = Tcl_GetCurrentThread();

    /*
     * TIP #218, Channel Thread Actions
     * For all transformations and the base channel.
     */

    for (; chanPtr != NULL ; chanPtr = chanPtr->upChanPtr) {
	ChanThreadAction(chanPtr, TCL_CHANNEL_THREAD_INSERT);
    while (chanPtr) {
	threadActionProc = Tcl_ChannelThreadActionProc(chanPtr->typePtr);
	if (threadActionProc != NULL) {
	    (*threadActionProc)(chanPtr->instanceData,
		    TCL_CHANNEL_THREAD_INSERT);
	}
	chanPtr= chanPtr->upChanPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Close --
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
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







+

-
+








-
+







 *	However, it may continue to exist for a while longer if it has a
 *	background flush scheduled. The device itself is eventually closed and
 *	the channel record removed, in CloseChannel, above.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
TclClose(
Tcl_Close(
    Tcl_Interp *interp,		/* Interpreter for errors. */
    Tcl_Channel chan)		/* The channel being closed. Must not be
				 * referenced in any interpreter. */
{
    CloseCallback *cbPtr;	/* Iterate over close callbacks for this
				 * channel. */
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of real IO channel. */
    int result = 0;			/* Of calling FlushChannel. */
    int result;			/* Of calling FlushChannel. */
    int flushcode;
    int stickyError;

    if (chan == NULL) {
	return TCL_OK;
    }

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
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







-
+





-
-
-
+
+














+




















-
+








-
-
-
-
-







-
-
+
+









-
-
+
+
+
+







     * This operation should occur at the top of a channel stack.
     */

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    chanPtr = statePtr->topChanPtr;

    if (statePtr->refCount + 1 > 1) {
    if (statePtr->refCount > 0) {
	Tcl_Panic("called Tcl_Close on channel with refCount > 0");
    }

    if (GotFlag(statePtr, CHANNEL_INCLOSE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	    Tcl_AppendResult(interp, "Illegal recursive call to close "
		    "through close-handler of channel", NULL);
	}
	return TCL_ERROR;
    }
    SetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * When the channel has an escape sequence driven encoding such as
     * iso2022, the terminated escape sequence must write to the buffer.
     */

    stickyError = 0;

    if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL)
	    && !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) {

	int code = CheckChannelErrors(statePtr, TCL_WRITABLE);

	if (code == 0) {
	    statePtr->outputEncodingFlags |= TCL_ENCODING_END;
	    code = WriteChars(chanPtr, "", 0);
	    statePtr->outputEncodingFlags &= ~TCL_ENCODING_END;
	    statePtr->outputEncodingFlags |= TCL_ENCODING_START;
	}
	if (code < 0) {
	    stickyError = Tcl_GetErrno();
	}

	/*
	 * TIP #219, Tcl Channel Reflection API.
	 * Move an error message found in the channel bypass into the
	 * interpreter bypass. Just clear it if there is no interpreter.
	 */

	if (statePtr->chanMsg != NULL) {
	    if (interp != NULL) {
		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
		Tcl_SetChannelErrorInterp(interp,statePtr->chanMsg);
	    }
	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
    }

    Tcl_ClearChannelHandlers(chan);

    /*
     * Cancel any outstanding timer.
     */
    Tcl_DeleteTimerHandler(statePtr->timer);

    /*
     * Invoke the registered close callbacks and delete their records.
     */

    while (statePtr->closeCbPtr != NULL) {
	cbPtr = statePtr->closeCbPtr;
	statePtr->closeCbPtr = cbPtr->nextPtr;
	cbPtr->proc(cbPtr->clientData);
	Tcl_Free(cbPtr);
	(cbPtr->proc)(cbPtr->clientData);
	ckfree((char *) cbPtr);
    }

    ResetFlag(statePtr, CHANNEL_INCLOSE);

    /*
     * If this channel supports it, close the read side, since we don't need
     * it anymore and this will help avoid deadlocks on some channel types.
     */

    result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, interp, TCL_CLOSE_READ);
    if ((result == EINVAL) || result == ENOTCONN) {
    if (chanPtr->typePtr->closeProc == TCL_CLOSE2PROC) {
	result = (chanPtr->typePtr->close2Proc)(chanPtr->instanceData, interp,
		TCL_CLOSE_READ);
    } else {
	result = 0;
    }

    /*
     * The call to FlushChannel will flush any queued output and invoke the
     * close function of the channel driver, or it will set up the channel to
     * be flushed and closed asynchronously.
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
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







-




-
-
+
-
-
-
-
-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	Tcl_SetErrno(stickyError);
	if (interp != NULL) {
	    Tcl_SetObjResult(interp,
			     Tcl_NewStringObj(Tcl_PosixError(interp), -1));
	}
	return TCL_ERROR;
    }

    /*
     * Bug 97069ea11a: set error message if a flush code is set and no error
     * message set up to now.
     */

    if (flushcode != 0) {
    if (flushcode != 0 && interp != NULL
	/* flushcode has precedence, if available */
	result = flushcode;
    }
    if ((result != 0) && (result != TCL_ERROR) && (interp != NULL)
	    && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) {
	Tcl_SetErrno(result);
	    && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
	Tcl_SetErrno(flushcode);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(Tcl_PosixError(interp), -1));
    }
    if (result != 0) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CloseEx --
 *
 *	Closes one side of a channel, read or write, close all.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Closes one direction of the channel, or do a full close.
 *
 * NOTE:
 *	Tcl_CloseEx closes the specified direction of the channel as far as
 *	the user is concerned. If flags = 0, this is equivalent to Tcl_Close.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CloseEx(
    Tcl_Interp *interp,		/* Interpreter for errors. */
    Tcl_Channel chan,		/* The channel being closed. May still be used
				 * by some interpreter. */
    int flags)			/* Flags telling us which side to close. */
{
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of real IO channel. */

    if (chan == NULL) {
	return TCL_OK;
    }

    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;

    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == 0) {
	return TclClose(interp, chan);
    }
    if ((flags & (TCL_READABLE | TCL_WRITABLE)) == (TCL_READABLE | TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"double-close of channels not supported by %ss",
		chanPtr->typePtr->typeName));
	return TCL_ERROR;
    }

    /*
     * Does the channel support half-close anyway? Error if not.
     */

    if (!chanPtr->typePtr->close2Proc) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"half-close of channels not supported by %ss",
		chanPtr->typePtr->typeName));
	return TCL_ERROR;
    }

    /*
     * Is the channel unstacked ? If not we fail.
     */

    if (chanPtr != statePtr->topChanPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"half-close not applicable to stack of transformations", -1));
	return TCL_ERROR;
    }

    /*
     * Check direction against channel mode. It is an error if we try to close
     * a direction not supported by the channel (already closed, or never
     * opened for that direction).
     */

    if (!(statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & flags)) {
	const char *msg;

	if (flags & TCL_CLOSE_READ) {
	    msg = "read";
	} else {
	    msg = "write";
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "Half-close of %s-side not possible, side not opened or"
                " already closed", msg));
	return TCL_ERROR;
    }

    /*
     * A user may try to call half-close from within a channel close handler.
     * That won't do.
     */

    if (statePtr->flags & CHANNEL_INCLOSE) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "illegal recursive call to close through close-handler"
                    " of channel", -1));
	}
	return TCL_ERROR;
    }

    if (flags & TCL_CLOSE_READ) {
	/*
	 * Call the finalization code directly. There are no events to handle,
	 * there cannot be for the read-side.
	 */

	return CloseChannelPart(interp, chanPtr, 0, flags);
    } else if (flags & TCL_CLOSE_WRITE) {
	Tcl_Preserve(statePtr);
	if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    /*
	     * We don't want to re-enter CloseWrite().
	     */

	    if (!GotFlag(statePtr, CHANNEL_CLOSEDWRITE)) {
		if (CloseWrite(interp, chanPtr) != TCL_OK) {
		    SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
		    Tcl_Release(statePtr);
		    return TCL_ERROR;
		}
	    }
	}
	SetFlag(statePtr, CHANNEL_CLOSEDWRITE);
	Tcl_Release(statePtr);
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CloseWrite --
 *
 *	Closes the write side a channel.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Closes the write side of the channel.
 *
 * NOTE:
 *	CloseWrite removes the channel as far as the user is concerned.
 *	However, the ooutput data structures may continue to exist for a while
 *	longer if it has a background flush scheduled. The device itself is
 *	eventually closed and the channel structures modified, in
 *	CloseChannelPart, below.
 *
 *----------------------------------------------------------------------
 */

static int
CloseWrite(
    Tcl_Interp *interp,		/* Interpreter for errors. */
    Channel *chanPtr)		/* The channel whose write side is being
                                 * closed. May still be used by some
                                 * interpreter */
{
    /*
     * Notes: clear-channel-handlers - write side only ? or keep around, just
     * not called.
     *
     * No close callbacks are run - channel is still open (read side)
     */

    ChannelState *statePtr = chanPtr->state;
                                /* State of real IO channel. */
    int flushcode;
    int result = 0;

    /*
     * The call to FlushChannel will flush any queued output and invoke the
     * close function of the channel driver, or it will set up the channel to
     * be flushed and closed asynchronously.
     */

    SetFlag(statePtr, CHANNEL_CLOSEDWRITE);

    flushcode = FlushChannel(interp, chanPtr, 0);

    /*
     * TIP #219.
     * Capture error messages put by the driver into the bypass area and put
     * them into the regular interpreter result.
     *
     * Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags
     * FlushChannel() has called CloseChannelPart(). While we can still access
     * "chan" (no structures were freed), the only place which may still
     * contain a message is the interpreter itself, and "CloseChannelPart"
     * made sure to lift any channel message it generated into it. Hence the
     * NULL argument in the call below.
     */

    if (TclChanCaughtErrorBypass(interp, NULL)) {
	result = EINVAL;
    }

    if ((flushcode != 0) || (result != 0)) {
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CloseChannelPart --
 *
 *	Utility procedure to close a channel partially and free associated
 *	resources. If the channel was stacked it will never be run (The higher
 *	level forbid this). If the channel was not stacked, then we will free
 *	all the bits of the chosen side (read, or write) for the TOP channel.
 *
 * Results:
 *	Error code from an unreported error or the driver close2 operation.
 *
 * Side effects:
 *	May free memory, may change the value of errno.
 *
 *----------------------------------------------------------------------
 */

static int
CloseChannelPart(
    Tcl_Interp *interp,		/* Interpreter for errors. */
    Channel *chanPtr,		/* The channel being closed. May still be used
				 * by some interpreter. */
    int errorCode,		/* Status of operation so far. */
    int flags)			/* Flags telling us which side to close. */
{
    ChannelState *statePtr;	/* State of real IO channel. */
    int result;			/* Of calling the close2proc. */

    statePtr = chanPtr->state;

    if (flags & TCL_CLOSE_READ) {
	/*
	 * No more input can be consumed so discard any leftover input.
	 */

	DiscardInputQueued(statePtr, 1);
    } else if (flags & TCL_CLOSE_WRITE) {
	/*
	 * The caller guarantees that there are no more buffers queued for
	 * output.
	 */

	if (statePtr->outQueueHead != NULL) {
	    Tcl_Panic("ClosechanHalf, closed write-side of channel: "
		    "queued output left");
	}

	/*
	 * If the EOF character is set in the channel, append that to the
	 * output device.
	 */

	if ((statePtr->outEofChar != 0) && GotFlag(statePtr, TCL_WRITABLE)) {
	    int dummy;
	    char c = (char) statePtr->outEofChar;

	    (void) ChanWrite(chanPtr, &c, 1, &dummy);
	}

	/*
	 * TIP #219, Tcl Channel Reflection API.
	 * Move a leftover error message in the channel bypass into the
	 * interpreter bypass. Just clear it if there is no interpreter.
	 */

	if (statePtr->chanMsg != NULL) {
	    if (interp != NULL) {
		Tcl_SetChannelErrorInterp(interp, statePtr->chanMsg);
	    }
	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
    }

    /*
     * Finally do what is asked of us. Close and free the channel driver state
     * for the chosen side of the channel. This may leave a TIP #219 error
     * message in the interp.
     */

    result = chanPtr->typePtr->close2Proc(chanPtr->instanceData, NULL, flags);

    /*
     * If we are being called synchronously, report either any latent error on
     * the channel or the current error.
     */

    if (statePtr->unreportedError != 0) {
	errorCode = statePtr->unreportedError;

	/*
	 * TIP #219, Tcl Channel Reflection API.
	 * Move an error message found in the unreported area into the regular
	 * bypass (interp). This kills any message in the channel bypass area.
	 */

	if (statePtr->chanMsg != NULL) {
	    TclDecrRefCount(statePtr->chanMsg);
	    statePtr->chanMsg = NULL;
	}
	if (interp) {
	    Tcl_SetChannelErrorInterp(interp, statePtr->unreportedMsg);
	}
    }
    if (errorCode == 0) {
	errorCode = result;
	if (errorCode != 0) {
	    Tcl_SetErrno(errorCode);
	}
    }

    /*
     * TIP #219.
     * Capture error messages put by the driver into the bypass area and put
     * them into the regular interpreter result. See also the bottom of
     * CloseWrite().
     */

    if (TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
	result = EINVAL;
    }

    if (result != 0) {
	return TCL_ERROR;
    }

    /*
     * Remove the closed side from the channel mode/flags.
     */

    ResetFlag(statePtr, flags & (TCL_READABLE | TCL_WRITABLE));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ClearChannelHandlers --
3931
3932
3933
3934
3935
3936
3937
3938

3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953




3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965

3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985


3986
3987
3988
3989
3990
3991
3992
3993
3994

3995
3996
3997
3998

3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012

4013
4014
4015

4016
4017
4018
4019


4020
4021
4022
4023
4024
4025
4026
4027
4028
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
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







-
+











-
-
-
-
+
+
+
+











-
+


















-
-
+
+








-
+



-
+













-
+


-
+


-
-
+
+


















-
-
+
+








-
+



-
+





-
+
-


-
+


-
+








+
-
-
+
+
+



















-
-
+
+








-
+




-
+








-
+




-
+


















-
+








    /*
     * Remove all the channel handler records attached to the channel itself.
     */

    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chNext) {
	chNext = chPtr->nextPtr;
	Tcl_Free(chPtr);
	ckfree((char *) chPtr);
    }
    statePtr->chPtr = NULL;

    /*
     * Cancel any pending copy operation.
     */

    StopCopy(statePtr->csPtrR);
    StopCopy(statePtr->csPtrW);

    /*
     * Must set the interest mask now to 0, otherwise infinite loops will
     * occur if Tcl_DoOneEvent is called before the channel is finally deleted
     * in FlushChannel. This can happen if the channel has a background flush
     * active.
     * Must set the interest mask now to 0, otherwise infinite loops
     * will occur if Tcl_DoOneEvent is called before the channel is
     * finally deleted in FlushChannel. This can happen if the channel
     * has a background flush active.
     */

    statePtr->interestMask = 0;

    /*
     * Remove any EventScript records for this channel.
     */

    for (ePtr = statePtr->scriptRecordPtr; ePtr != NULL; ePtr = eNextPtr) {
	eNextPtr = ePtr->nextPtr;
	TclDecrRefCount(ePtr->scriptPtr);
	Tcl_Free(ePtr);
	ckfree((char *) ePtr);
    }
    statePtr->scriptRecordPtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Write --
 *
 *	Puts a sequence of bytes into an output buffer, may queue the buffer
 *	for output if it gets full, and also remembers whether the current
 *	buffer is ready e.g. if it contains a newline and we are in line
 *	buffering mode. Compensates stacking, i.e. will redirect the data from
 *	the specified channel to the topmost channel in a stack.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes written or TCL_IO_FAILURE in case of error. If
 *	TCL_IO_FAILURE, Tcl_GetErrno will return the error code.
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_Write(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    size_t srcLen)			/* Length of data in bytes, or -1 for
    int srcLen)			/* Length of data in bytes, or < 0 for
				 * strlen(). */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
	return -1;
    }

    if (srcLen == TCL_INDEX_NONE) {
    if (srcLen < 0) {
	srcLen = strlen(src);
    }
    if (WriteBytes(chanPtr, src, srcLen) == -1) {
	return TCL_IO_FAILURE;
    if (WriteBytes(chanPtr, src, srcLen) < 0) {
	return -1;
    }
    return srcLen;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WriteRaw --
 *
 *	Puts a sequence of bytes into an output buffer, may queue the buffer
 *	for output if it gets full, and also remembers whether the current
 *	buffer is ready e.g. if it contains a newline and we are in line
 *	buffering mode. Writes directly to the driver of the channel, does not
 *	compensate for stacking.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes written or TCL_IO_FAILURE in case of error. If
 *	TCL_IO_FAILURE, Tcl_GetErrno will return the error code.
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_WriteRaw(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* Data to queue in output buffer. */
    size_t srcLen)		/* Length of data in bytes, or -1 for
    int srcLen)			/* Length of data in bytes, or < 0 for
				 * strlen(). */
{
    Channel *chanPtr = ((Channel *) chan);
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int errorCode;
    int errorCode, written;
    size_t written;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | CHANNEL_RAW_MODE) != 0) {
	return TCL_IO_FAILURE;
	return -1;
    }

    if (srcLen == TCL_INDEX_NONE) {
    if (srcLen < 0) {
	srcLen = strlen(src);
    }

    /*
     * Go immediately to the driver, do all the error handling by ourselves.
     * The code was stolen from 'FlushChannel'.
     */

    written = (chanPtr->typePtr->outputProc) (chanPtr->instanceData,
    written = ChanWrite(chanPtr, src, srcLen, &errorCode);
    if (written == TCL_IO_FAILURE) {
	    src, srcLen, &errorCode);

    if (written < 0) {
	Tcl_SetErrno(errorCode);
    }

    return written;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WriteChars --
 *
 *	Takes a sequence of UTF-8 characters and converts them for output
 *	using the channel's current encoding, may queue the buffer for output
 *	if it gets full, and also remembers whether the current buffer is
 *	ready e.g. if it contains a newline and we are in line buffering
 *	mode. Compensates stacking, i.e. will redirect the data from the
 *	specified channel to the topmost channel in a stack.
 *
 * Results:
 *	The number of bytes written or TCL_IO_FAILURE in case of error. If
 *	TCL_IO_FAILURE, Tcl_GetErrno will return the error code.
 *	The number of bytes written or -1 in case of error. If -1,
 *	Tcl_GetErrno will return the error code.
 *
 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_WriteChars(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    const char *src,		/* UTF-8 characters to queue in output
				 * buffer. */
    size_t len)			/* Length of string in bytes, or -1 for
    int len)			/* Length of string in bytes, or < 0 for
				 * strlen(). */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;	/* State info for channel */
    int result;
    Tcl_Obj *objPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
	return -1;
    }

    chanPtr = statePtr->topChanPtr;

    if (len == TCL_INDEX_NONE) {
    if (len < 0) {
	len = strlen(src);
    }
    if (statePtr->encoding) {
	return WriteChars(chanPtr, src, len);
    }

    /*
     * Inefficient way to convert UTF-8 to byte-array, but the code
     * parallels the way it is done for objects.  Special case for 1-byte
     * (used by eg [puts] for the \n) could be extended to more efficient
     * translation of the src string.
     */

    if ((len == 1) && (UCHAR(*src) < 0xC0)) {
	return WriteBytes(chanPtr, src, len);
    }

    objPtr = Tcl_NewStringObj(src, len);
    src = (char *) TclGetByteArrayFromObj(objPtr, &len);
    src = (char *) Tcl_GetByteArrayFromObj(objPtr, &len);
    result = WriteBytes(chanPtr, src, len);
    TclDecrRefCount(objPtr);
    return result;
}

/*
 *---------------------------------------------------------------------------
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
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

3775
3776



3777
3778
3779
3780
3781
3782
3783
3784
3785
3786







-
+










-
-
+
+





-
+


-
+







-
+
-
-



-
-
-
+
+
+
-
-
-
+
+



-
+
-
-


-
-
+
-
-
-
+



-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
-


-
-
-
+
+
+







 * Side effects:
 *	May buffer up output and may cause output to be produced on the
 *	channel.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_WriteObj(
    Tcl_Channel chan,		/* The channel to buffer output for. */
    Tcl_Obj *objPtr)		/* The object to write. */
{
    /*
     * Always use the topmost channel of the stack
     */

    Channel *chanPtr;
    ChannelState *statePtr;	/* State info for channel */
    const char *src;
    size_t srcLen = 0;
    char *src;
    int srcLen;

    statePtr = ((Channel *) chan)->state;
    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_IO_FAILURE;
	return -1;
    }
    if (statePtr->encoding == NULL) {
	src = (char *) TclGetByteArrayFromObj(objPtr, &srcLen);
	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
	return WriteBytes(chanPtr, src, srcLen);
    } else {
	src = TclGetStringFromObj(objPtr, &srcLen);
	return WriteChars(chanPtr, src, srcLen);
    }
}

static void
static void WillWrite(Channel *chanPtr)
WillWrite(
    Channel *chanPtr)
{
    int inputBuffered;

    if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL)
	    ) && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)){
	int ignore;
    if ((chanPtr->typePtr->seekProc != NULL)
        && ((inputBuffered = Tcl_InputBuffered((Tcl_Channel) chanPtr)) > 0)) {
        int ignore;

	DiscardInputQueued(chanPtr->state, 0);
	ChanSeek(chanPtr, -inputBuffered, SEEK_CUR, &ignore);
        DiscardInputQueued(chanPtr->state, 0);
        ChanSeek(chanPtr, - inputBuffered, SEEK_CUR, &ignore);
    }
}

static int
static int WillRead(Channel *chanPtr)
WillRead(
    Channel *chanPtr)
{
    if (chanPtr->typePtr == NULL) {
	/*
	 * Prevent read attempts on a closed channel.
	/* Prevent read attempts on a closed channel */
	 */

	DiscardInputQueued(chanPtr->state, 0);
        DiscardInputQueued(chanPtr->state, 0);
	Tcl_SetErrno(EINVAL);
	return -1;
    }
    if (((Tcl_ChannelWideSeekProc(chanPtr->typePtr) != NULL)
	    ) && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
    if ((chanPtr->typePtr->seekProc != NULL)
        && (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {

	/*
	 * CAVEAT - The assumption here is that FlushChannel() will push out
	 * the bytes of any writes that are in progress.  Since this is a
	 * seekable channel, we assume it is not one that can block and force
	 * bg flushing.  Channels we know that can do that - sockets, pipes -
	 * are not seekable. If the assumption is wrong, more drastic measures
	 * may be required here like temporarily setting the channel into
	 * CAVEAT - The assumption here is that FlushChannel() will
	 * push out the bytes of any writes that are in progress.
	 * Since this is a seekable channel, we assume it is not one
	 * that can block and force bg flushing.  Channels we know that
	 * can do that -- sockets, pipes -- are not seekable.  If the
	 * assumption is wrong, more drastic measures may be required here
	 * like temporarily setting the channel into blocking mode.
	 * blocking mode.
	 */

	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	return -1;
	}
        if (FlushChannel(NULL, chanPtr, 0) != 0) {
            return -1;
        }
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
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
4328
4329
4330
4331
4332
4333

4334
4335
4336
4337

4338
4339
4340

4341
4342
4343
4344
4345
4346
4347
4348
4349
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829

3830
3831
3832
3833
3834

3835
3836
3837
3838
3839
3840

3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853

3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866


3867


3868

3869
3870


3871


3872
3873
3874
3875
3876
3877
3878







+













-
+




-
+





-
+












-
+












-
-
+
-
-

-
+

-
-
+
-
-







    int srcLen,			/* Length of UTF-8 string in bytes. */
    Tcl_Encoding encoding)
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    char *nextNewLine = NULL;
    int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
    char safe[BUFFER_PADDING];

    if (srcLen) {
        WillWrite(chanPtr);
    }

    /*
     * Write the terminated escape sequence even if srcLen is 0.
     */

    endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);

    if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
	nextNewLine = (char *)memchr(src, '\n', srcLen);
	nextNewLine = memchr(src, '\n', srcLen);
    }

    while (srcLen + saved + endEncoding > 0) {
	ChannelBuffer *bufPtr;
	char *dst, safe[BUFFER_PADDING];
	char *dst;
	int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;

	if (nextNewLine) {
	    srcLimit = nextNewLine - src;
	}

	
	/* Get space to write into */
	bufPtr = statePtr->curOutPtr;
	if (bufPtr == NULL) {
	    bufPtr = AllocChannelBuffer(statePtr->bufSize);
	    statePtr->curOutPtr = bufPtr;
	}
	if (saved) {
	    /*
	     * Here's some translated bytes left over from the last buffer
	     * that we need to stick at the beginning of this buffer.
	     */

	    memcpy(InsertPoint(bufPtr), safe, saved);
	    memcpy(InsertPoint(bufPtr), safe, (size_t) saved);
	    bufPtr->nextAdded += saved;
	    saved = 0;
	}
	PreserveChannelBuffer(bufPtr);
	dst = InsertPoint(bufPtr);
	dstLen = SpaceLeft(bufPtr);

	result = Tcl_UtfToExternal(NULL, encoding, src, srcLimit,
		statePtr->outputEncodingFlags,
		&statePtr->outputEncodingState, dst,
		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);

	/*
	 * See chan-io-1.[89]. Tcl Bug 506297.
	/* See chan-io-1.[89]. Tcl Bug 506297. */
	 */

	statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;

	
	if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
	    /*
	     * We're reading from invalid/incomplete UTF-8.
	    /* We're reading from invalid/incomplete UTF-8 */
	     */

	    ReleaseChannelBuffer(bufPtr);
	    if (total == 0) {
		Tcl_SetErrno(EINVAL);
		return -1;
	    }
	    break;
	}
4373
4374
4375
4376
4377
4378
4379
4380

4381
4382
4383
4384
4385





4386
4387
4388
4389
4390
4391
4392
4393

4394
4395
4396
4397
4398
4399
4400
4401
4402
4403





4404
4405
4406
4407


4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430








4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
3902
3903
3904
3905
3906
3907
3908

3909
3910




3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922

3923
3924
3925
3926
3927
3928





3929
3930
3931
3932
3933
3934
3935


3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952








3953
3954
3955
3956
3957
3958
3959
3960
3961

3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974


3975
3976
3977
3978
3979
3980
3981







-
+

-
-
-
-
+
+
+
+
+







-
+





-
-
-
-
-
+
+
+
+
+


-
-
+
+















-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-













-
-







		nl = crln;
		nlLen = 2;
		break;
	    default:
		Tcl_Panic("unknown output translation requested");
		break;
	    }

	
	    result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
		    statePtr->outputEncodingFlags,
		    &statePtr->outputEncodingState, dst,
		    dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
	    assert(srcRead == nlLen);
		statePtr->outputEncodingFlags,
		&statePtr->outputEncodingState, dst,
		dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);

	    assert (srcRead == nlLen);

	    bufPtr->nextAdded += dstWrote;
	    src++;
	    srcLen--;
	    total += dstWrote;
	    dst += dstWrote;
	    dstLen -= dstWrote;
	    nextNewLine = (char *)memchr(src, '\n', srcLen);
	    nextNewLine = memchr(src, '\n', srcLen);
	    needNlFlush = 1;
	}

	if (IsBufferOverflowing(bufPtr)) {
	    /*
	     * When translating from UTF-8 to external encoding, we allowed
	     * the translation to produce a character that crossed the end of
	     * the output buffer, so that we would get a completely full
	     * buffer before flushing it. The extra bytes will be moved to the
	     * beginning of the next buffer.
	     * When translating from UTF-8 to external encoding, we
	     * allowed the translation to produce a character that crossed
	     * the end of the output buffer, so that we would get a
	     * completely full buffer before flushing it. The extra bytes
	     * will be moved to the beginning of the next buffer.
	     */

	    saved = 1 + ~SpaceLeft(bufPtr);
	    memcpy(safe, dst + dstLen, saved);
	    saved = -SpaceLeft(bufPtr);
	    memcpy(safe, dst + dstLen, (size_t) saved);
	    bufPtr->nextAdded = bufPtr->bufLength;
	}

	if ((srcLen + saved == 0) && (result == TCL_OK)) {
	    endEncoding = 0;
	}

	if (IsBufferFull(bufPtr)) {
	    if (FlushChannel(NULL, chanPtr, 0) != 0) {
		ReleaseChannelBuffer(bufPtr);
		return -1;
	    }
	    flushed += statePtr->bufSize;

	    /*
 	     * We just flushed.  So if we have needNlFlush set to record that
 	     * we need to flush because theres a (translated) newline in the
 	     * buffer, that's likely not true any more.  But there is a tricky
 	     * exception.  If we have saved bytes that did not really get
 	     * flushed and those bytes came from a translation of a newline as
 	     * the last thing taken from the src array, then needNlFlush needs
 	     * to remain set to flag that the next buffer still needs a
 	     * newline flush.
 	     * We just flushed.  So if we have needNlFlush set to record
 	     * that we need to flush because theres a (translated) newline
 	     * in the buffer, that's likely not true any more.  But there
 	     * is a tricky exception.  If we have saved bytes that did not
 	     * really get flushed and those bytes came from a translation
 	     * of a newline as the last thing taken from the src array,
 	     * then needNlFlush needs to remain set to flag that the
 	     * next buffer still needs a newline flush.
 	     */

	    if (needNlFlush && (saved == 0 || src[-1] != '\n')) {
		needNlFlush = 0;
	    }
	}
	ReleaseChannelBuffer(bufPtr);
    }
    if ((flushed < total) && (GotFlag(statePtr, CHANNEL_UNBUFFERED) ||
	    (needNlFlush && GotFlag(statePtr, CHANNEL_LINEBUFFERED)))) {
	if (FlushChannel(NULL, chanPtr, 0) != 0) {
	    return -1;
	}
    }

    UpdateInterest(chanPtr);

    return total;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_Gets --
4463
4464
4465
4466
4467
4468
4469
4470

4471
4472
4473
4474
4475
4476
4477
4478
4479


4480
4481
4482
4483
4484



4485
4486
4487
4488
4489
4490
4491
3990
3991
3992
3993
3994
3995
3996

3997
3998
3999
4000
4001
4002
4003
4004
4005

4006
4007
4008
4009
4010


4011
4012
4013
4014
4015
4016
4017
4018
4019
4020







-
+








-
+
+



-
-
+
+
+







 * Side effects:
 *	May flush output on the channel. May cause input to be consumed from
 *	the channel.
 *
 *---------------------------------------------------------------------------
 */

size_t
int
Tcl_Gets(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_DString *lineRead)	/* The line read will be appended to this
				 * DString as UTF-8 characters. The caller
				 * must have initialized it and is responsible
				 * for managing the storage. */
{
    Tcl_Obj *objPtr;
    size_t charsStored;
    int charsStored, length;
    char *string;

    TclNewObj(objPtr);
    charsStored = Tcl_GetsObj(chan, objPtr);
    if (charsStored + 1 > 1) {
	TclDStringAppendObj(lineRead, objPtr);
    if (charsStored > 0) {
	string = TclGetStringFromObj(objPtr, &length);
	Tcl_DStringAppend(lineRead, string, length);
    }
    TclDecrRefCount(objPtr);
    return charsStored;
}

/*
 *---------------------------------------------------------------------------
4506
4507
4508
4509
4510
4511
4512
4513

4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524

4525
4526
4527
4528
4529
4530
4531

4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542


4543
4544
4545
4546

4547
4548
4549
4550
4551
4552
4553
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







-
+










-
+
-





-
+









-
-
+
+



-
+







 *
 *	On reading EOF, leave channel pointing at EOF char. On reading EOL,
 *	leave channel pointing after EOL, but don't return EOL in dst buffer.
 *
 *---------------------------------------------------------------------------
 */

size_t
int
Tcl_GetsObj(
    Tcl_Channel chan,		/* Channel from which to read. */
    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    GetsState gs;
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldFlags, oldRemoved;
    int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
    size_t oldLength;
    Tcl_Encoding encoding;
    char *dst, *dstEnd, *eol, *eof;
    Tcl_EncodingState oldState;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_IO_FAILURE;
	return -1;
    }

    /*
     * If we're sitting ready to read the eofchar, there's no need to
     * do it.
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
	assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
	assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );

	/* TODO: Do we need this? */
	UpdateInterest(chanPtr);
	return TCL_IO_FAILURE;
	return -1;
    }

    /*
     * A binary version of Tcl_GetsObj. This could also handle encodings that
     * are ascii-7 pure (iso8859, utf-8, ...) with a final encoding conversion
     * done on objPtr.
     */
4569
4570
4571
4572
4573
4574
4575
4576

4577
4578
4579
4580
4581
4582
4583
4097
4098
4099
4100
4101
4102
4103

4104
4105
4106
4107
4108
4109
4110
4111







-
+







    encoding = statePtr->encoding;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    (void)TclGetStringFromObj(objPtr, &oldLength);
    TclGetStringFromObj(objPtr, &oldLength);
    oldFlags = statePtr->inputEncodingFlags;
    oldState = statePtr->inputEncodingState;
    oldRemoved = BUFFER_PADDING;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

4666
4667
4668
4669
4670
4671
4672
4673

4674
4675
4676
4677
4678
4679
4680
4194
4195
4196
4197
4198
4199
4200

4201
4202
4203
4204
4205
4206
4207
4208







-
+







		    /*
		     * If a CR is at the end of the buffer, then check for a
		     * LF at the begining of the next buffer, unless EOF char
		     * was found already.
		     */

		    if (eol >= dstEnd) {
			size_t offset;
			int offset;

			if (eol != eof) {
			    offset = eol - objPtr->bytes;
			    dst = dstEnd;
			    if (FilterInputBytes(chanPtr, &gs) != 0) {
				goto restore;
			    }
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
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







+

-



-
-
-
+
+
+




-
+







	    if (GotFlag(statePtr, INPUT_SAW_CR)) {
		ResetFlag(statePtr, INPUT_SAW_CR);
		if ((eol < dstEnd) && (*eol == '\n')) {
		    /*
		     * Skip the raw bytes that make up the '\n'.
		     */

		    char tmp[1 + TCL_UTF_MAX];
		    int rawRead;
		    char tmp[TCL_UTF_MAX];

		    bufPtr = gs.bufPtr;
		    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr),
			    gs.rawRead, statePtr->inputEncodingFlags
				| TCL_ENCODING_NO_TERMINATE, &gs.state, tmp,
			    sizeof(tmp), &rawRead, NULL, NULL);
			    gs.rawRead, statePtr->inputEncodingFlags,
			    &gs.state, tmp, 1 + TCL_UTF_MAX, &rawRead, NULL,
			    NULL);
		    bufPtr->nextRemoved += rawRead;
		    gs.rawRead -= rawRead;
		    gs.bytesWrote--;
		    gs.charsWrote--;
		    memmove(dst, dst + 1, dstEnd - dst);
		    memmove(dst, dst + 1, (size_t) (dstEnd - dst));
		    dstEnd--;
		}
	    }
	    for (eol = dst; eol < dstEnd; eol++) {
		if (*eol == '\r') {
		    eol++;
		    if (eol == dstEnd) {
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817


4818
4819
4820
4821
4822
4823
4824
4336
4337
4338
4339
4340
4341
4342



4343
4344
4345
4346
4347
4348
4349
4350
4351







-
-
-
+
+








    bufPtr = gs.bufPtr;
    if (bufPtr == NULL) {
	Tcl_Panic("Tcl_GetsObj: gotEOL reached with bufPtr==NULL");
    }
    statePtr->inputEncodingState = gs.state;
    Tcl_ExternalToUtf(NULL, gs.encoding, RemovePoint(bufPtr), gs.rawRead,
	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
	    &statePtr->inputEncodingState, dst,
	    eol - dst + skip + TCL_UTF_MAX - 1, &gs.rawRead, NULL,
	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState, dst,
	    eol - dst + skip + TCL_UTF_MAX, &gs.rawRead, NULL,
	    &gs.charsWrote);
    bufPtr->nextRemoved += gs.rawRead;

    /*
     * Recycle all the emptied buffers.
     */

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
4402
4403
4404
4405
4406
4407
4408





4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419

4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438



4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449







-
-
-
-
-
+
+
+
+
+
+





-



















-
-
-
+
+
+
+








    /*
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

  done:
    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
	    == (CHANNEL_EOF|CHANNEL_BLOCKED)));
	assert(!GotFlag(statePtr, CHANNEL_EOF)
		|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
		|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);

	assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
		== (CHANNEL_EOF|CHANNEL_BLOCKED)) );

    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	TclChannelRelease((Tcl_Channel)chanPtr);
	chanPtr = statePtr->topChanPtr;
	TclChannelPreserve((Tcl_Channel)chanPtr);
    }
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return copiedTotal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetsObjBinary --
 *
 *	A variation of Tcl_GetsObj that works directly on the buffers until
 *	end-of-line or end-of-file has been seen. Bytes read from the input
 *	channel return as a ByteArray obj.
 *
 *	WARNING!  The notion of "binary" used here is different from notions
 *	of "binary" used in other places. In particular, this "binary" routine
 *	may be called when an -eofchar is set on the channel.
 *	WARNING!  The notion of "binary" used here is different from
 *	notions of "binary" used in other places.  In particular, this
 *	"binary" routine may be called when an -eofchar is set on the
 * 	channel.
 *
 * Results:
 *	Number of characters accumulated in the object or -1 if error,
 *	blocked, or EOF. If -1, use Tcl_GetErrno() to retrieve the POSIX error
 *	code for the error or condition that occurred.
 *
 * Side effects:
4933
4934
4935
4936
4937
4938
4939
4940
4941


4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959

4960
4961
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
5016


5017
5018
5019
5020
5021
5022
5023
4461
4462
4463
4464
4465
4466
4467


4468
4469

4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485

4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497



4498


4499
4500
4501
4502
4503


4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516



4517
4518
4519
4520

4521
4522
4523
4524
4525
4526
4527
4528
4529






4530
4531
4532
4533
4534
4535
4536


4537
4538
4539
4540
4541
4542
4543
4544
4545







-
-
+
+
-
















-
+











-
-
-
+
-
-





-
-
+
+











-
-
-
+
+
+

-









-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+







    Tcl_Obj *objPtr)		/* The line read will be appended to this
				 * object as UTF-8 characters. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int inEofChar, skip, copiedTotal, oldFlags, oldRemoved;
    size_t rawLen, byteLen = 0, oldLength;
    int inEofChar, skip, copiedTotal, oldLength, oldFlags, oldRemoved;
    int rawLen, byteLen, eolChar;
    int eolChar;
    unsigned char *dst, *dstEnd, *eol, *eof, *byteArray;

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

    bufPtr = statePtr->inQueueHead;

    /*
     * Preserved so we can restore the channel's state in case we don't find a
     * newline in the available input.
     */

    byteArray = TclGetByteArrayFromObj(objPtr, &byteLen);
    byteArray = Tcl_GetByteArrayFromObj(objPtr, &byteLen);
    oldFlags = statePtr->inputEncodingFlags;
    oldRemoved = BUFFER_PADDING;
    oldLength = byteLen;
    if (bufPtr != NULL) {
	oldRemoved = bufPtr->nextRemoved;
    }

    rawLen = 0;
    skip = 0;
    eof = NULL;
    inEofChar = statePtr->inEofChar;

    /*
     * Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR.
    /* Only handle TCL_TRANSLATE_LF and TCL_TRANSLATE_CR */
     */

    eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';

    ResetFlag(statePtr, CHANNEL_BLOCKED);
    while (1) {
	/*
	 * Subtract the number of bytes that were removed from channel buffer
	 * during last call.
	 * Subtract the number of bytes that were removed from channel
	 * buffer during last call.
	 */

	if (bufPtr != NULL) {
	    bufPtr->nextRemoved += rawLen;
	    if (!IsBufferReady(bufPtr)) {
		bufPtr = bufPtr->nextPtr;
	    }
	}

	if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
	    /*
	     * All channel buffers were exhausted and the caller still hasn't
	     * seen EOL. Need to read more bytes from the channel device. Side
	     * effect is to allocate another channel buffer.
	     * All channel buffers were exhausted and the caller still
	     * hasn't seen EOL. Need to read more bytes from the channel
	     * device. Side effect is to allocate another channel buffer.
	     */

	    if (GetInput(chanPtr) != 0) {
		goto restore;
	    }
	    bufPtr = statePtr->inQueueTail;
	    if (bufPtr == NULL) {
		goto restore;
	    }
	} else {
	    /*
	     * Incoming CHANNEL_STICKY_EOF is filtered out on entry.  A new
	     * CHANNEL_STICKY_EOF set in this routine leads to return before
	     * coming back here.  When we are not dealing with
	     * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer.
	     * Here the buffer is non-empty so we know we're a non-EOF.
             */
	     * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
	     * A new CHANNEL_STICKY_EOF set in this routine leads to
	     * return before coming back here.  When we are not dealing
	     * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
	     * empty buffer.  Here the buffer is non-empty so we know
	     * we're a non-EOF */

	    assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
	    assert(!GotFlag(statePtr, CHANNEL_EOF));
	    assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
	    assert ( !GotFlag(statePtr, CHANNEL_EOF) );
	}

	dst = (unsigned char *) RemovePoint(bufPtr);
	dstEnd = dst + BytesLeft(bufPtr);

	/*
	 * Remember if EOF char is seen, then look for EOL anyhow, because the
5076
5077
5078
5079
5080
5081
5082
5083
5084


5085
5086
5087
5088
5089

5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106

5107
5108
5109
5110
5111
5112
5113
4598
4599
4600
4601
4602
4603
4604


4605
4606
4607
4608
4609
4610

4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627

4628
4629
4630
4631
4632
4633
4634
4635







-
-
+
+




-
+
















-
+







	}
	if (GotFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)
		== (CHANNEL_BLOCKED|CHANNEL_NONBLOCKING)) {
	    goto restore;
	}

	/*
	 * Copy bytes from the channel buffer to the ByteArray. This may
	 * realloc space, so keep track of result.
	 * Copy bytes from the channel buffer to the ByteArray.
	 * This may realloc space, so keep track of result.
	 */

	rawLen = dstEnd - dst;
	byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
	memcpy(byteArray + byteLen, dst, rawLen);
	memcpy(byteArray + byteLen, dst, (size_t) rawLen);
	byteLen += rawLen;
    }

    /*
     * Found EOL or EOF, but the output buffer may now contain too many bytes.
     * We need to know how many bytes correspond to the number we want, so we
     * can remove the correct number of bytes from the channel buffer.
     */

  gotEOL:
    if (bufPtr == NULL) {
	Tcl_Panic("TclGetsObjBinary: gotEOL reached with bufPtr==NULL");
    }

    rawLen = eol - dst;
    byteArray = Tcl_SetByteArrayLength(objPtr, byteLen + rawLen);
    memcpy(byteArray + byteLen, dst, rawLen);
    memcpy(byteArray + byteLen, dst, (size_t) rawLen);
    byteLen += rawLen;
    bufPtr->nextRemoved += rawLen + skip;

    /*
     * Convert the buffer if there was an encoding.
     * XXX - unimplemented.
     */
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172





5173
5174
5175
5176
5177
5178
5179
4683
4684
4685
4686
4687
4688
4689





4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701







-
-
-
-
-
+
+
+
+
+








    /*
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

  done:
    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
	    == (CHANNEL_EOF|CHANNEL_BLOCKED)));
	assert(!GotFlag(statePtr, CHANNEL_EOF)
		|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
		|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
	assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
		== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return copiedTotal;
}

/*
 *---------------------------------------------------------------------------
5187
5188
5189
5190
5191
5192
5193
5194

5195
5196
5197
5198
5199
5200
5201
4709
4710
4711
4712
4713
4714
4715

4716
4717
4718
4719
4720
4721
4722
4723







-
+







 *	None.
 *
 *---------------------------------------------------------------------------
 */

static void
FreeBinaryEncoding(
    TCL_UNUSED(ClientData))
    ClientData dummy)	/* Not used */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->binaryEncoding != NULL) {
	Tcl_FreeEncoding(tsdPtr->binaryEncoding);
	tsdPtr->binaryEncoding = NULL;
    }
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309






5310
5311
5312
5313


5314
5315
5316
5317
5318
5319
5320
4820
4821
4822
4823
4824
4825
4826





4827
4828
4829
4830
4831
4832

4833


4834
4835
4836
4837
4838
4839
4840
4841
4842







-
-
-
-
-
+
+
+
+
+
+
-

-
-
+
+







	if (bufPtr == NULL) {
	    gsPtr->charsWrote = 0;
	    gsPtr->rawRead = 0;
	    return -1;
	}
    } else {
	/*
	 * Incoming CHANNEL_STICKY_EOF is filtered out on entry.  A new
	 * CHANNEL_STICKY_EOF set in this routine leads to return before
	 * coming back here.  When we are not dealing with CHANNEL_STICKY_EOF,
	 * a CHANNEL_EOF implies an empty buffer.  Here the buffer is
	 * non-empty so we know we're a non-EOF.
	 * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
	 * A new CHANNEL_STICKY_EOF set in this routine leads to
	 * return before coming back here.  When we are not dealing
	 * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
	 * empty buffer.  Here the buffer is non-empty so we know
	 * we're a non-EOF */
         */

	assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
	assert(!GotFlag(statePtr, CHANNEL_EOF));
	assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
	assert ( !GotFlag(statePtr, CHANNEL_EOF) );
    }

    /*
     * Convert some of the bytes from the channel buffer to UTF-8. Space in
     * objPtr's string rep is used to hold the UTF-8 characters. Grow the
     * string rep if we need more space.
     */
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352



5353
5354
5355
5356
5357
5358
5359
4865
4866
4867
4868
4869
4870
4871



4872
4873
4874
4875
4876
4877
4878
4879
4880
4881







-
-
-
+
+
+







	}
	spaceLeft = length - offset;
	dst = objPtr->bytes + offset;
	*gsPtr->dstPtr = dst;
    }
    gsPtr->state = statePtr->inputEncodingState;
    result = Tcl_ExternalToUtf(NULL, gsPtr->encoding, raw, rawLen,
	    statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE,
	    &statePtr->inputEncodingState, dst, spaceLeft, &gsPtr->rawRead,
	    &gsPtr->bytesWrote, &gsPtr->charsWrote);
	    statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
	    dst, spaceLeft+1, &gsPtr->rawRead, &gsPtr->bytesWrote,
	    &gsPtr->charsWrote);

    /*
     * Make sure that if we go through 'gets', that we reset the
     * TCL_ENCODING_START flag still. [Bug #523988]
     */

    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;
5395
5396
5397
5398
5399
5400
5401
5402

5403
5404
5405
5406
5407
5408
5409
4917
4918
4919
4920
4921
4922
4923

4924
4925
4926
4927
4928
4929
4930
4931







-
+







	    if (nextPtr == NULL) {
		nextPtr = AllocChannelBuffer(statePtr->bufSize);
		bufPtr->nextPtr = nextPtr;
		statePtr->inQueueTail = nextPtr;
	    }
	    extra = rawLen - gsPtr->rawRead;
	    memcpy(nextPtr->buf + (BUFFER_PADDING - extra),
		    raw + gsPtr->rawRead, extra);
		    raw + gsPtr->rawRead, (size_t) extra);
	    nextPtr->nextRemoved -= extra;
	    bufPtr->nextAdded -= extra;
	}
    }

    gsPtr->bufPtr = bufPtr;
    return 0;
5543
5544
5545
5546
5547
5548
5549
5550

5551
5552
5553
5554
5555
5556
5557
5065
5066
5067
5068
5069
5070
5071

5072
5073
5074
5075
5076
5077
5078
5079







-
+







	nextPtr = bufPtr->nextPtr;
	for ( ; nextPtr != NULL; nextPtr = bufPtr->nextPtr) {
	    int extra;

	    extra = SpaceLeft(bufPtr);
	    if (extra > 0) {
		memcpy(InsertPoint(bufPtr),
			nextPtr->buf + (BUFFER_PADDING - extra),
			nextPtr->buf + BUFFER_PADDING - extra,
			(size_t) extra);
		bufPtr->nextAdded += extra;
		nextPtr->nextRemoved = BUFFER_PADDING;
	    }
	    bufPtr = nextPtr;
	}
    }
5575
5576
5577
5578
5579
5580
5581
5582

5583
5584
5585
5586

5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599

5600
5601
5602

5603
5604
5605
5606
5607
5608
5609
5097
5098
5099
5100
5101
5102
5103

5104
5105
5106
5107

5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120

5121
5122
5123

5124
5125
5126
5127
5128
5129
5130
5131







-
+



-
+












-
+


-
+







 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_Read(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    size_t bytesToRead)		/* Maximum number of bytes to read. */
    int bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	return TCL_IO_FAILURE;
	return -1;
    }

    return DoRead(chanPtr, dst, bytesToRead, 0);
    return DoRead(chanPtr, dst, bytesToRead);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ReadRaw --
 *
5620
5621
5622
5623
5624
5625
5626
5627

5628
5629
5630
5631

5632
5633
5634
5635
5636
5637
5638
5639
5640

5641
5642
5643
5644

5645
5646
5647
5648
5649
5650
5651


5652
5653
5654

5655
5656
5657

5658
5659
5660
5661
5662
5663
5664

5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680





5681
5682
5683
5684
5685
5686
5687
5688

5689
5690
5691

5692
5693
5694




5695
5696
5697
5698
5699
5700
5701
5702









5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5142
5143
5144
5145
5146
5147
5148

5149
5150
5151
5152

5153
5154
5155
5156
5157
5158
5159
5160
5161

5162
5163
5164


5165

5166
5167
5168
5169


5170
5171
5172


5173

5174

5175
5176
5177
5178
5179
5180


5181

5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192




5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203


5204


5205
5206
5207
5208

5209
5210
5211
5212
5213







5214
5215
5216
5217
5218
5219
5220
5221
5222
5223

5224
5225
5226






5227
5228
5229
5230
5231
5232
5233







-
+



-
+








-
+


-
-
+
-




-
-
+
+

-
-
+
-

-
+





-
-
+
-











-
-
-
-
+
+
+
+
+






-
-
+
-
-

+


-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-



-
-
-
-
-
-







 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_ReadRaw(
    Tcl_Channel chan,		/* The channel from which to read. */
    char *readBuf,		/* Where to store input read. */
    size_t bytesToRead)		/* Maximum number of bytes to read. */
    int bytesToRead)		/* Maximum number of bytes to read. */
{
    Channel *chanPtr = (Channel *) chan;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    int copied = 0;

    assert(bytesToRead > 0);
    if (CheckChannelErrors(statePtr, TCL_READABLE | CHANNEL_RAW_MODE) != 0) {
	return TCL_IO_FAILURE;
	return -1;
    }

    /*
     * First read bytes from the push-back buffers.
    /* First read bytes from the push-back buffers. */
     */

    while (chanPtr->inQueueHead && bytesToRead > 0) {
	ChannelBuffer *bufPtr = chanPtr->inQueueHead;
	int bytesInBuffer = BytesLeft(bufPtr);
	int toCopy = (bytesInBuffer < (int)bytesToRead) ? bytesInBuffer
		: (int)bytesToRead;
	int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
		: bytesToRead;

	/*
	 * Copy the current chunk into the read buffer.
	/* Copy the current chunk into the read buffer. */
	 */

	memcpy(readBuf, RemovePoint(bufPtr), toCopy);
	memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
	bufPtr->nextRemoved += toCopy;
	copied += toCopy;
	readBuf += toCopy;
	bytesToRead -= toCopy;

	/*
         * If the current buffer is empty recycle it.
	/* If the current buffer is empty recycle it. */
         */

	if (IsBufferEmpty(bufPtr)) {
	    chanPtr->inQueueHead = bufPtr->nextPtr;
	    if (chanPtr->inQueueHead == NULL) {
		chanPtr->inQueueTail = NULL;
	    }
	    RecycleBuffer(chanPtr->state, bufPtr, 0);
	}
    }

    /*
     * Go to the driver only if we got nothing from pushback.  Have to do it
     * this way to avoid EOF mis-timings when we consider the ability that EOF
     * may not be a permanent condition in the driver, and in that case we
     * have to synchronize.
     * Go to the driver only if we got nothing from pushback.
     * Have to do it this way to avoid EOF mis-timings when we
     * consider the ability that EOF may not be a permanent
     * condition in the driver, and in that case we have to
     * synchronize.
     */

    if (copied) {
	return copied;
    }

    /*
     * This test not needed.
    /* This test not needed. */
     */

    if (bytesToRead > 0) {

	int nread = ChanRead(chanPtr, readBuf, bytesToRead);

	if (nread == -1) {
	if (nread > 0) {
	    /* Successful read (short is OK) - add to bytes copied */
	    copied += nread;
	} else if (nread < 0) {
	    /*
	     * An error signaled.  If CHANNEL_BLOCKED, then the error is not
	     * real, but an indication of blocked state.  In that case, retain
	     * the flag and let caller receive the short read of copied bytes
	     * from the pushback.  HOWEVER, if copied==0 bytes from pushback
	     * then repeat signalling the blocked state as an error to caller
	     * so there is no false report of an EOF.  When !CHANNEL_BLOCKED,
	     * the error is real and passes on to caller.
	     * An error signaled.  If CHANNEL_BLOCKED, then the error
	     * is not real, but an indication of blocked state.  In
	     * that case, retain the flag and let caller receive the
	     * short read of copied bytes from the pushback.
	     * HOWEVER, if copied==0 bytes from pushback then repeat
	     * signalling the blocked state as an error to caller so
	     * there is no false report of an EOF.
	     * When !CHANNEL_BLOCKED, the error is real and passes on
	     * to caller.
	     */

	    if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
		copied = -1;
	    }
	} else if (nread > 0) {
	    /*
             * Successful read (short is OK) - add to bytes copied.
             */

	    copied += nread;
	} else {
	    /*
	     * nread == 0.  Driver is at EOF. Let that state filter up.
	     */
	}
    }
    return copied;
5738
5739
5740
5741
5742
5743
5744
5745

5746
5747
5748
5749

5750
5751
5752
5753
5754
5755
5756
5251
5252
5253
5254
5255
5256
5257

5258
5259
5260
5261

5262
5263
5264
5265
5266
5267
5268
5269







-
+



-
+







 *
 * Side effects:
 *	May cause input to be buffered.
 *
 *---------------------------------------------------------------------------
 */

size_t
int
Tcl_ReadChars(
    Tcl_Channel chan,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,		/* Maximum number of characters to store, or
    int toRead,			/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
5798
5799
5800
5801
5802
5803
5804
5805

5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823

5824
5825
5826

5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852


5853
5854
5855
5856
5857
5858


5859
5860
5861
5862
5863
5864
5865
5866

5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887

5888
5889
5890
5891
5892
5893
5894
5895

5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910

5911

5912
5913
5914
5915
5916
5917
5918
5311
5312
5313
5314
5315
5316
5317

5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335

5336
5337
5338

5339




5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359


5360
5361
5362
5363
5364
5365


5366
5367
5368
5369
5370
5371
5372
5373


5374

5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392


5393


5394
5395
5396
5397
5398

5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413

5414
5415
5416
5417
5418
5419
5420
5421
5422
5423







-
+

















-
+


-
+
-
-
-
-




















-
-
+
+




-
-
+
+






-
-
+
-


















-
-
+
-
-





-
+














-
+

+







 *---------------------------------------------------------------------------
 */

static int
DoReadChars(
    Channel *chanPtr,		/* The channel to read. */
    Tcl_Obj *objPtr,		/* Input data is stored in this object. */
    size_t toRead,			/* Maximum number of characters to store, or
    int toRead,			/* Maximum number of characters to store, or
				 * -1 to read all available data (up to EOF or
				 * when channel blocks). */
    int appendFlag)		/* If non-zero, data read from the channel
				 * will be appended to the object. Otherwise,
				 * the data will replace the existing contents
				 * of the object. */
{
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */
    ChannelBuffer *bufPtr;
    int copied, copiedNow, result;
    Tcl_Encoding encoding = statePtr->encoding;
    int binaryMode;
#define UTF_EXPANSION_FACTOR	1024
    int factor = UTF_EXPANSION_FACTOR;

    binaryMode = (encoding == NULL)
	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF)
	    && (statePtr->inputTranslation == TCL_TRANSLATE_LF) 
	    && (statePtr->inEofChar == '\0');

    if (appendFlag) {
    if (appendFlag == 0) {
	if (binaryMode && (NULL == TclGetBytesFromObj(NULL, objPtr, NULL))) {
	    binaryMode = 0;
	}
    } else {
	if (binaryMode) {
	    Tcl_SetByteArrayLength(objPtr, 0);
	} else {
	    Tcl_SetObjLength(objPtr, 0);

	    /*
	     * We're going to access objPtr->bytes directly, so we must ensure
	     * that this is actually a string object (otherwise it might have
	     * been pure Unicode).
	     *
	     * Probably not needed anymore.
	     */

	    TclGetString(objPtr);
	}
    }

    /*
     * Early out when next read will see eofchar.
     *
     * NOTE: See DoRead for argument that it's a bug (one we're keeping) to
     * have this escape before the one for zero-char read request.
     * NOTE: See DoRead for argument that it's a bug (one we're keeping)
     * to have this escape before the one for zero-char read request.
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
	assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
	assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );

	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * Special handling for zero-char read request.
    /* Special handling for zero-char read request. */
     */
    if (toRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	/* TODO: We don't need this call? */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;
    TclChannelPreserve((Tcl_Channel)chanPtr);

    /*
     * Must clear the BLOCKED|EOF flags here since we check before reading.
    /* Must clear the BLOCKED flag here since we check before reading */
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
    for (copied = 0; toRead > 0; ) {
    for (copied = 0; (unsigned) toRead > 0; ) {
	copiedNow = -1;
	if (statePtr->inQueueHead != NULL) {
	    if (binaryMode) {
		copiedNow = ReadBytes(statePtr, objPtr, toRead);
	    } else {
		copiedNow = ReadChars(statePtr, objPtr, toRead, &factor);
	    }

	    /*
	     * If the current buffer is empty recycle it.
	     */

	    bufPtr = statePtr->inQueueHead;
	    if (IsBufferEmpty(bufPtr)) {
		ChannelBuffer *nextPtr = bufPtr->nextPtr;
		ChannelBuffer *nextPtr;

		nextPtr = bufPtr->nextPtr;
		RecycleBuffer(statePtr, bufPtr, 0);
		statePtr->inQueueHead = nextPtr;
		if (nextPtr == NULL) {
		    statePtr->inQueueTail = NULL;
		}
	    }
	}
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949



5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976





5977
5978
5979
5980
5981
5982
5983
5445
5446
5447
5448
5449
5450
5451



5452
5453
5454
5455

5456
5457
5458
5459
5460
5461
5462
5463

5464
5465
5466
5467
5468
5469
5470
5471
5472
5473






5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485







-
-
-
+
+
+

-








-










-
-
-
-
-
-
+
+
+
+
+







	} else {
	    copied += copiedNow;
	    toRead -= copiedNow;
	}
    }

    /*
     * Failure to fill a channel buffer may have left channel reporting a
     * "blocked" state, but so long as we fulfilled the request here, the
     * caller does not consider us blocked.
     * Failure to fill a channel buffer may have left channel reporting
     * a "blocked" state, but so long as we fulfilled the request here,
     * the caller does not consider us blocked.
     */

    if (toRead == 0) {
	ResetFlag(statePtr, CHANNEL_BLOCKED);
    }

    /*
     * Regenerate the top channel, in case it was changed due to
     * self-modifying reflected transforms.
     */

    if (chanPtr != statePtr->topChanPtr) {
	TclChannelRelease((Tcl_Channel)chanPtr);
	chanPtr = statePtr->topChanPtr;
	TclChannelPreserve((Tcl_Channel)chanPtr);
    }

    /*
     * Update the notifier state so we don't block while there is still data
     * in the buffers.
     */

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
            == (CHANNEL_EOF|CHANNEL_BLOCKED)));
	assert(!GotFlag(statePtr, CHANNEL_EOF)
		|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
		|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
	assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
		== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return copied;
}

/*
 *---------------------------------------------------------------------------
6006
6007
6008
6009
6010
6011
6012
6013

6014
6015
6016
6017
6018
6019
6020
5508
5509
5510
5511
5512
5513
5514

5515
5516
5517
5518
5519
5520
5521
5522







-
+







ReadBytes(
    ChannelState *statePtr,	/* State of the channel to read. */
    Tcl_Obj *objPtr,		/* Input data is appended to this ByteArray
				 * object. Its length is how much space has
				 * been allocated to hold data, not how many
				 * bytes of data have been stored in the
				 * object. */
    int bytesToRead)		/* Maximum number of bytes to store, or -1 to
    int bytesToRead)		/* Maximum number of bytes to store, or < 0 to
				 * get all available bytes. Bytes are obtained
				 * from the first buffer in the queue - even
				 * if this number is larger than the number of
				 * bytes available in the first buffer, only
				 * the bytes from the first buffer are
				 * returned. */
{
6083
6084
6085
6086
6087
6088
6089
6090
6091

6092
6093
6094
6095
6096
6097





6098
6099
6100

6101
6102
6103
6104
6105
6106
6107

6108
6109

6110
6111
6112

6113
6114

6115
6116
6117

6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129








6130
6131
6132
6133
6134




6135
6136

6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148


6149
6150
6151
6152
6153
6154
6155
6156
6157









6158
6159
6160
6161
6162
6163
6164

6165
6166
6167
6168
6169
6170
6171




6172
6173
6174
6175
6176
6177
6178

6179
6180
6181



6182
6183
6184
6185
6186
6187
6188
6189
6190
6191



6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202











6203
6204
6205
6206
6207
6208
6209
6210




6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221




6222
6223
6224

6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235




6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246




6247
6248
6249

6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262



6263
6264
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
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
6390
6391
6392
6393
6394
6395
6396
6397




6398
6399
6400
6401
6402




6403
6404
6405
6406
6407
6408
6409
6410

6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424


6425
6426
6427
6428
6429
6430
6431
6432
6433
5585
5586
5587
5588
5589
5590
5591


5592
5593
5594




5595
5596
5597
5598
5599
5600
5601

5602
5603
5604
5605
5606
5607
5608

5609
5610

5611
5612
5613

5614
5615

5616

5617

5618
5619
5620
5621
5622
5623







5624
5625
5626
5627
5628
5629
5630
5631
5632




5633
5634
5635
5636
5637
5638
5639
5640
5641

5642





5643


5644
5645
5646








5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661

5662
5663
5664
5665




5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678


5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689


5690
5691
5692
5693










5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708




5709
5710
5711
5712
5713

5714
5715
5716
5717
5718
5719



5720
5721
5722
5723
5724
5725

5726
5727
5728
5729
5730
5731
5732
5733
5734



5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745




5746
5747
5748
5749
5750
5751

5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762



5763
5764
5765
5766
5767
5768
5769
5770

5771

5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784



5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805

5806
5807


5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818


5819
5820
5821
5822
5823
5824
5825
5826
5827




5828
5829
5830
5831
5832
5833
5834
5835
5836
5837

5838





5839
5840
5841
5842
5843
5844

5845
5846
5847
5848
5849
5850
5851
5852
5853
5854


5855

5856

5857
5858







5859
5860
5861
5862
5863
5864
5865
5866
5867
5868

5869
5870
5871
5872
5873
5874
5875






5876
5877
5878
5879
5880
5881

5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895




5896
5897
5898
5899
5900




5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911

5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922

5923


5924
5925
5926

5927
5928
5929
5930
5931
5932
5933







-
-
+


-
-
-
-
+
+
+
+
+


-
+






-
+

-
+


-
+

-
+
-

-
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+


+


-

-
-
-
-
-

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+






-
+



-
-
-
-
+
+
+
+







+

-
-
+
+
+








-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+




-
-
-
-
+
+
+
+

-






-
-
-
+
+
+
+


-
+








-
-
-
+
+
+
+







-
-
-
-
+
+
+
+


-
+










-
-
-
+
+
+



+

-

-
+












-
-
-
+
+











+






+
-
+

-
-
+
+









-
-
+
+







-
-
-
-
+
+
+
+






-
+
-
-
-
-
-
+
+
+
+


-
+









-
-
+
-

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
+

+




-
-
-
-
-
-
+
+
+
+
+
+
-














-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+







-
+










-

-
-
+
+

-







    Tcl_Encoding encoding = statePtr->encoding? statePtr->encoding
	    : GetBinaryEncoding();
    Tcl_EncodingState savedState = statePtr->inputEncodingState;
    ChannelBuffer *bufPtr = statePtr->inQueueHead;
    int savedIEFlags = statePtr->inputEncodingFlags;
    int savedFlags = statePtr->flags;
    char *dst, *src = RemovePoint(bufPtr);
    size_t numBytes;
    int srcLen = BytesLeft(bufPtr);
    int dstLimit, numBytes, srcLen = BytesLeft(bufPtr);

    /*
     * One src byte can yield at most one character.  So when the number of
     * src bytes we plan to read is less than the limit on character count to
     * be read, clearly we will remain within that limit, and we can use the
     * value of "srcLen" as a tighter limit for sizing receiving buffers.
     * One src byte can yield at most one character.  So when the
     * number of src bytes we plan to read is less than the limit on
     * character count to be read, clearly we will remain within that
     * limit, and we can use the value of "srcLen" as a tighter limit
     * for sizing receiving buffers.
     */

    int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead;
    int toRead = ((unsigned) charsToRead > (unsigned) srcLen) ? srcLen : charsToRead;

    /*
     * 'factor' is how much we guess that the bytes in the source buffer will
     * expand when converted to UTF-8 chars. This guess comes from analyzing
     * how many characters were produced by the previous pass.
     */

    
    int factor = *factorPtr;
    int dstLimit = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;
    int dstNeeded = TCL_UTF_MAX - 1 + toRead * factor / UTF_EXPANSION_FACTOR;

    (void) TclGetStringFromObj(objPtr, &numBytes);
    Tcl_AppendToObj(objPtr, NULL, dstLimit);
    Tcl_AppendToObj(objPtr, NULL, dstNeeded);
    if (toRead == srcLen) {
	size_t size;
	unsigned int size;

	dst = TclGetStringStorage(objPtr, &size) + numBytes;
	dstLimit = size - numBytes;
	dstNeeded = size - numBytes;
    } else {
	dst = TclGetString(objPtr) + numBytes;
    }

    /*
     * This routine is burdened with satisfying several constraints. It cannot
     * append more than 'charsToRead` chars onto objPtr. This is measured
     * after encoding and translation transformations are completed. There is
     * no precise number of src bytes that can be associated with the limit.
     * Yet, when we are done, we must know precisely the number of src bytes
     * that were consumed to produce the appended chars, so that all
     * subsequent bytes are left in the buffers for future read operations.
     * This routine is burdened with satisfying several constraints.
     * It cannot append more than 'charsToRead` chars onto objPtr.
     * This is measured after encoding and translation transformations
     * are completed.  There is no precise number of src bytes that can
     * be associated with the limit.  Yet, when we are done, we must know
     * precisely the number of src bytes that were consumed to produce
     * the appended chars, so that all subsequent bytes are left in
     * the buffers for future read operations.
     *
     * The consequence is that we have no choice but to implement a "trial and
     * error" approach, where in general we may need to perform
     * transformations and copies multiple times to achieve a consistent set
     * of results.  This takes the shape of a loop.
     * The consequence is that we have no choice but to implement a
     * "trial and error" approach, where in general we may need to
     * perform transformations and copies multiple times to achieve
     * a consistent set of results.  This takes the shape of a loop.
     */

    dstLimit = dstNeeded + 1;
    while (1) {
	int dstDecoded, dstRead, dstWrote, srcRead, numChars, code;
	int flags = statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE;

	if (charsToRead > 0) {
	    flags |= TCL_ENCODING_CHAR_LIMIT;
	    numChars = charsToRead;
	}

	/*
	 * Perform the encoding transformation.  Read no more than srcLen
	 * bytes, write no more than dstLimit bytes.
	 * Perform the encoding transformation.  Read no more than
	 * srcLen bytes, write no more than dstLimit bytes.
	 *
	 * Some trickiness with encoding flags here.  We do not want the end
	 * of a buffer to be treated as the end of all input when the presence
	 * of bytes in a next buffer are already known to exist.  This is
	 * checked with an assert() because so far no test case causing the
	 * assertion to be false has been created.  The normal operations of
	 * channel reading appear to cause EOF and TCL_ENCODING_END setting to
	 * appear only in situations where there are no further bytes in any
	 * buffers.
	 * Some trickiness with encoding flags here.  We do not want
	 * the end of a buffer to be treated as the end of all input
	 * when the presence of bytes in a next buffer are already
	 * known to exist.  This is checked with an assert() because
	 * so far no test case causing the assertion to be false has
	 * been created.  The normal operations of channel reading
	 * appear to cause EOF and TCL_ENCODING_END setting to appear
	 * only in situations where there are no further bytes in
	 * any buffers.
	 */

	assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
		|| (statePtr->inputEncodingFlags & TCL_ENCODING_END) == 0);

	code = Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
		flags, &statePtr->inputEncodingState,
		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
		dst, dstLimit, &srcRead, &dstDecoded, &numChars);

	/*
	 * Perform the translation transformation in place.  Read no more than
	 * the dstDecoded bytes the encoding transformation actually produced.
	 * Capture the number of bytes written in dstWrote. Capture the number
	 * of bytes actually consumed in dstRead.
	 * Perform the translation transformation in place.  Read no more
	 * than the dstDecoded bytes the encoding transformation actually
	 * produced.  Capture the number of bytes written in dstWrote.
	 * Capture the number of bytes actually consumed in dstRead.
	 */

	dstWrote = dstLimit;
	dstRead = dstDecoded;
	TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);

	if (dstRead < dstDecoded) {

	    /*
	     * The encoding transformation produced bytes that the translation
	     * transformation did not consume.  Why did this happen?
	     * The encoding transformation produced bytes that the
	     * translation transformation did not consume.  Why did
	     * this happen?
	     */

	    if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) {
		/*
		 * 1) There's an eof char set on the channel, and
		 *    we saw it and stopped translating at that point.
		 *
		 * NOTE the bizarre spec of TranslateInputEOL in this case.
		 * Clearly the eof char had to be read in order to account for
		 * the stopping, but the value of dstRead does not include it.
		 * Clearly the eof char had to be read in order to account
		 * for the stopping, but the value of dstRead does not
		 * include it.
		 *
		 * Also rather bizarre, our caller can only notice an EOF
		 * condition if we return the value -1 as the number of chars
		 * read.  This forces us to perform a 2-call dance where the
		 * first call can read all the chars up to the eof char, and
		 * the second call is solely for consuming the encoded eof
		 * char then pointed at by src so that we can return that
		 * magic -1 value.  This seems really wasteful, especially
		 * since the first decoding pass of each call is likely to
		 * decode many bytes beyond that eof char that's all we care
		 * about.
		 * Also rather bizarre, our caller can only notice an
		 * EOF condition if we return the value -1 as the number
		 * of chars read.  This forces us to perform a 2-call
		 * dance where the first call can read all the chars
		 * up to the eof char, and the second call is solely
		 * for consuming the encoded eof char then pointed at
		 * by src so that we can return that magic -1 value.
		 * This seems really wasteful, especially since
		 * the first decoding pass of each call is likely to
		 * decode many bytes beyond that eof char that's all we
		 * care about.
		 */

		if (dstRead == 0) {
		    /*
		     * Curious choice in the eof char handling.  We leave the
		     * eof char in the buffer. So, no need to compute a proper
		     * srcRead value. At this point, there are no chars before
		     * the eof char in the buffer.
		     * Curious choice in the eof char handling.  We leave
		     * the eof char in the buffer.  So, no need to compute
		     * a proper srcRead value.  At this point, there
		     * are no chars before the eof char in the buffer.
		     */

		    Tcl_SetObjLength(objPtr, numBytes);
		    return -1;
		}

		{
		    /*
		     * There are chars leading the buffer before the eof char.
		     * Adjust the dstLimit so we go back and read only those
		     * and do not encounter the eof char this time.
		     * There are chars leading the buffer before the eof
		     * char.  Adjust the dstLimit so we go back and read
		     * only those and do not encounter the eof char this
		     * time.
		     */

		    dstLimit = dstRead + (TCL_UTF_MAX - 1);
		    dstLimit = dstRead + TCL_UTF_MAX;
		    statePtr->flags = savedFlags;
		    statePtr->inputEncodingFlags = savedIEFlags;
		    statePtr->inputEncodingState = savedState;
		    continue;
		}
	    }

	    /*
	     * 2) The other way to read fewer bytes than are decoded is when
	     *    the final byte is \r and we're in a CRLF translation mode so
	     *    we cannot decide whether to record \r or \n yet.
	     * 2) The other way to read fewer bytes than are decoded
	     *    is when the final byte is \r and we're in a CRLF
	     *    translation mode so we cannot decide whether to
	     *	  record \r or \n yet.
	     */

	    assert(dst[dstRead] == '\r');
	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);

	    if (dstWrote > 0) {
		/*
		 * There are chars we can read before we hit the bare CR.  Go
		 * back with a smaller dstLimit so we get them in the next
		 * pass, compute a matching srcRead, and don't end up back
		 * here in this call.
		 * There are chars we can read before we hit the bare cr.
		 * Go back with a smaller dstLimit so we get them in the
		 * next pass, compute a matching srcRead, and don't end
		 * up back here in this call.
		 */

		dstLimit = dstRead + (TCL_UTF_MAX - 1);
		dstLimit = dstRead + TCL_UTF_MAX;
		statePtr->flags = savedFlags;
		statePtr->inputEncodingFlags = savedIEFlags;
		statePtr->inputEncodingState = savedState;
		continue;
	    }

	    assert(dstWrote == 0);
	    assert(dstRead == 0);

	    /*
	     * We decoded only the bare CR, and we cannot read a translated
	     * char from that alone. We have to know what's next.  So why do
	     * we only have the one decoded char?
	     * We decoded only the bare cr, and we cannot read a
	     * translated char from that alone.  We have to know what's
	     * next.  So why do we only have the one decoded char?
	     */

	    if (code != TCL_OK) {
		char buffer[TCL_UTF_MAX + 2];
		int read, decoded, count;
		char buffer[TCL_UTF_MAX + 1];

		/*
		/* 
		 * Didn't get everything the buffer could offer
		 */

		statePtr->flags = savedFlags;
		statePtr->inputEncodingFlags = savedIEFlags;
		statePtr->inputEncodingState = savedState;

		assert(bufPtr->nextPtr == NULL
			|| BytesLeft(bufPtr->nextPtr) == 0 || 0 ==
			(statePtr->inputEncodingFlags & TCL_ENCODING_END));

		Tcl_ExternalToUtf(NULL, encoding, src, srcLen,
		(statePtr->inputEncodingFlags | TCL_ENCODING_NO_TERMINATE),
		&statePtr->inputEncodingState, buffer, sizeof(buffer),
		&read, &decoded, &count);
		statePtr->inputEncodingFlags, &statePtr->inputEncodingState,
		buffer, TCL_UTF_MAX + 2, &read, &decoded, &count);

		if (count == 2) {
		    if (buffer[1] == '\n') {
			/* \r\n translate to \n */
			dst[0] = '\n';
			bufPtr->nextRemoved += read;
		    } else {
			dst[0] = '\r';
			bufPtr->nextRemoved += srcRead;
		    }

		    dst[1] = '\0';
		    statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;

		    Tcl_SetObjLength(objPtr, numBytes + 1);
		    return 1;
		}

	    } else if (GotFlag(statePtr, CHANNEL_EOF)) {
	    } else if (statePtr->flags & CHANNEL_EOF) {

		/*
		 * The bare \r is the only char and we will never read a
		 * subsequent char to make the determination.
		 * The bare \r is the only char and we will never read
		 * a subsequent char to make the determination.
		 */

		dst[0] = '\r';
		bufPtr->nextRemoved = bufPtr->nextAdded;
		Tcl_SetObjLength(objPtr, numBytes + 1);
		return 1;
	    }

	    /*
	     * Revise the dstRead value so that the numChars calc below
	     * correctly computes zero characters read.
	     * Revise the dstRead value so that the numChars calc
	     * below correctly computes zero characters read.
	     */

	    dstRead = numChars;

	    /* FALL THROUGH - get more data (dstWrote == 0) */
	}

	/*
	 * The translation transformation can only reduce the number of chars
	 * when it converts \r\n into \n. The reduction in the number of chars
	 * is the difference in bytes read and written.
	/* 
	 * The translation transformation can only reduce the number
	 * of chars when it converts \r\n into \n.  The reduction in
	 * the number of chars is the difference in bytes read and written.
	 */

	numChars -= (dstRead - dstWrote);

	if (charsToRead > 0 && numChars > charsToRead) {

	    /*
	    /* 
	     * TODO: This cannot happen anymore.
	     *
	     * We read more chars than allowed.  Reset limits to prevent that
	     * and try again.  Don't forget the extra padding of TCL_UTF_MAX
	     * bytes demanded by the Tcl_ExternalToUtf() call!
	     * We read more chars than allowed.  Reset limits to
	     * prevent that and try again.  Don't forget the extra
	     * padding of TCL_UTF_MAX bytes demanded by the
	     * Tcl_ExternalToUtf() call!
	     */

	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - dst + (TCL_UTF_MAX - 1);
	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) + TCL_UTF_MAX - dst;
	    statePtr->flags = savedFlags;
	    statePtr->inputEncodingFlags = savedIEFlags;
	    statePtr->inputEncodingState = savedState;
	    continue;
	}

	if (dstWrote == 0) {
	    ChannelBuffer *nextPtr;

	    /*
	     * We were not able to read any chars.
	    /* We were not able to read any chars. */
	     */

	    assert(numChars == 0);
	    assert (numChars == 0);

	    /*
	     * There is one situation where this is the correct final result.
	     * If the src buffer contains only a single \n byte, and we are in
	     * TCL_TRANSLATE_AUTO mode, and when the translation pass was made
	     * the INPUT_SAW_CR flag was set on the channel. In that case, the
	     * correct behavior is to consume that \n and produce the empty
	     * string.
	    /* 
	     * There is one situation where this is the correct final
	     * result.  If the src buffer contains only a single \n
	     * byte, and we are in TCL_TRANSLATE_AUTO mode, and
	     * when the translation pass was made the INPUT_SAW_CR
	     * flag was set on the channel.  In that case, the
	     * correct behavior is to consume that \n and produce the
	     * empty string.
	     */

	    if (dstRead == 1 && dst[0] == '\n') {
	    if (dst[0] == '\n') {
		assert(statePtr->inputTranslation == TCL_TRANSLATE_AUTO);
		assert(dstRead == 1);

		goto consume;
	    }

	    /*
	     * Otherwise, reading zero characters indicates there's something
	     * incomplete at the end of the src buffer.  Maybe there were not
	     * enough src bytes to decode into a char.  Maybe a lone \r could
	     * not be translated (crlf mode).  Need to combine any unused src
	     * bytes we have in the first buffer with subsequent bytes to try
	    /* Otherwise, reading zero characters indicates there's
	     * something incomplete at the end of the src buffer.
	     * Maybe there were not enough src bytes to decode into
	     * a char.  Maybe a lone \r could not be translated (crlf
	     * mode).  Need to combine any unused src bytes we have
	     * in the first buffer with subsequent bytes to try again.
	     * again.
	     */

	    nextPtr = bufPtr->nextPtr;

	    if (nextPtr == NULL) {
		if (srcLen > 0) {
		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
		}
		Tcl_SetObjLength(objPtr, numBytes);
		return -1;
	    }

	    /*
	     * Space is made at the beginning of the buffer to copy the
	     * previous unused bytes there. Check first if the buffer we are
	     * using actually has enough space at its beginning for the data
	     * we are copying.  Because if not we will write over the buffer
	     * management information, especially the 'nextPtr'.
	     * previous unused bytes there. Check first if the buffer we
	     * are using actually has enough space at its beginning for
	     * the data we are copying.  Because if not we will write over
	     * the buffer management information, especially the 'nextPtr'.
	     *
	     * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used
	     * to prevent exactly this situation. I.e. it should never happen.
	     * Therefore it is ok to panic should it happen despite the
	     * precautions.
	     * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
	     * used to prevent exactly this situation. I.e. it should never
	     * happen.  Therefore it is ok to panic should it happen despite
	     * the precautions.
	     */

	    if (nextPtr->nextRemoved - srcLen < 0) {
		Tcl_Panic("Buffer Underflow, BUFFER_PADDING not enough");
	    }

	    nextPtr->nextRemoved -= srcLen;
	    memcpy(RemovePoint(nextPtr), src, srcLen);
	    memcpy(RemovePoint(nextPtr), src, (size_t) srcLen);
	    RecycleBuffer(statePtr, bufPtr, 0);
	    statePtr->inQueueHead = nextPtr;
	    Tcl_SetObjLength(objPtr, numBytes);
	    return ReadChars(statePtr, objPtr, charsToRead, factorPtr);
	}

	statePtr->inputEncodingFlags &= ~TCL_ENCODING_START;

    consume:
	bufPtr->nextRemoved += srcRead;

	/*
	 * If this read contained multibyte characters, revise factorPtr so
	 * the next read will allocate bigger buffers.
	 * If this read contained multibyte characters, revise factorPtr
	 * so the next read will allocate bigger buffers.
	 */

	if (numChars && numChars < srcRead) {
	    *factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars;
	}
	Tcl_SetObjLength(objPtr, numBytes + dstWrote);
	return numChars;
    }
}
6446
6447
6448
6449
6450
6451
6452
6453

6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476




6477
6478
6479
6480
6481
6482
6483
6484

6485
6486
6487
6488
6489
6490
6491
6492

6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507

6508
6509
6510
6511
6512
6513
6514
6515
6516

6517
6518
6519
6520
6521
6522

6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533

6534
6535
6536
6537
6538
6539
6540
5946
5947
5948
5949
5950
5951
5952

5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973



5974
5975
5976
5977
5978
5979
5980
5981
5982
5983


5984


5985
5986
5987
5988


5989


5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001

6002
6003
6004
6005
6006
6007
6008
6009
6010

6011
6012
6013
6014
6015
6016

6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027

6028
6029
6030
6031
6032
6033
6034
6035







-
+




















-
-
-
+
+
+
+






-
-
+
-
-




-
-
+
-
-












-
+








-
+





-
+










-
+







 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static void
static void 
TranslateInputEOL(
    ChannelState *statePtr,	/* Channel being read, for EOL translation and
				 * EOF character. */
    char *dstStart,		/* Output buffer filled with chars by applying
				 * appropriate EOL translation to source
				 * characters. */
    const char *srcStart,	/* Source characters. */
    int *dstLenPtr,		/* On entry, the maximum length of output
				 * buffer in bytes. On exit, the number of
				 * bytes actually used in output buffer. */
    int *srcLenPtr)		/* On entry, the length of source buffer. On
				 * exit, the number of bytes read from the
				 * source buffer. */
{
    const char *eof = NULL;
    int dstLen = *dstLenPtr;
    int srcLen = *srcLenPtr;
    int inEofChar = statePtr->inEofChar;

    /*
     * Depending on the translation mode in use, there's no need to scan more
     * srcLen bytes at srcStart than can possibly transform to dstLen bytes.
     * This keeps the scan for eof char below from being pointlessly long.
     * Depending on the translation mode in use, there's no need
     * to scan more srcLen bytes at srcStart than can possibly transform
     * to dstLen bytes.  This keeps the scan for eof char below from
     * being pointlessly long.
     */

    switch (statePtr->inputTranslation) {
    case TCL_TRANSLATE_LF:
    case TCL_TRANSLATE_CR:
	if (srcLen > dstLen) {
	    /*
	     * In these modes, each src byte become a dst byte.
	/* In these modes, each src byte become a dst byte. */
	     */

	    srcLen = dstLen;
	}
	break;
    default:
	/*
	 * In other modes, at most 2 src bytes become a dst byte.
	/* In other modes, at most 2 src bytes become a dst byte. */
	 */

	if (srcLen/2 > dstLen) {
	    srcLen = 2 * dstLen;
	}
	break;
    }

    if (inEofChar != '\0') {
	/*
	 * Make sure we do not read past any logical end of channel input
	 * created by the presence of the input eof char.
	 */

	if ((eof = (const char *)memchr(srcStart, inEofChar, srcLen))) {
	if ((eof = memchr(srcStart, inEofChar, srcLen))) {
	    srcLen = eof - srcStart;
	}
    }

    switch (statePtr->inputTranslation) {
    case TCL_TRANSLATE_LF:
    case TCL_TRANSLATE_CR:
	if (dstStart != srcStart) {
	    memcpy(dstStart, srcStart, srcLen);
	    memcpy(dstStart, srcStart, (size_t) srcLen);
	}
	if (statePtr->inputTranslation == TCL_TRANSLATE_CR) {
	    char *dst = dstStart;
	    char *dstEnd = dstStart + srcLen;

	    while ((dst = (char *)memchr(dst, '\r', dstEnd - dst))) {
	    while ((dst = memchr(dst, '\r', dstEnd - dst))) {
		*dst++ = '\n';
	    }
	}
	dstLen = srcLen;
	break;
    case TCL_TRANSLATE_CRLF: {
	const char *crFound, *src = srcStart;
	char *dst = dstStart;
	int lesser = (dstLen < srcLen) ? dstLen : srcLen;

	while ((crFound = (const char *)memchr(src, '\r', lesser))) {
	while ((crFound = memchr(src, '\r', lesser))) {
	    int numBytes = crFound - src;
	    memmove(dst, src, numBytes);

	    dst += numBytes; dstLen -= numBytes;
	    src += numBytes; srcLen -= numBytes;
	    if (srcLen == 1) {
		/* valid src bytes end in \r */
6561
6562
6563
6564
6565
6566
6567
6568

6569
6570
6571
6572
6573

6574
6575
6576
6577
6578
6579
6580
6056
6057
6058
6059
6060
6061
6062

6063
6064
6065
6066
6067

6068
6069
6070
6071
6072
6073
6074
6075







-
+




-
+







	break;
    }
    case TCL_TRANSLATE_AUTO: {
	const char *crFound, *src = srcStart;
	char *dst = dstStart;
	int lesser;

	if ((statePtr->flags & INPUT_SAW_CR) && srcLen) {
	if (GotFlag(statePtr, INPUT_SAW_CR) && srcLen) {
	    if (*src == '\n') { src++; srcLen--; }
	    ResetFlag(statePtr, INPUT_SAW_CR);
	}
	lesser = (dstLen < srcLen) ? dstLen : srcLen;
	while ((crFound = (const char *)memchr(src, '\r', lesser))) {
	while ((crFound = memchr(src, '\r', lesser))) {
	    int numBytes = crFound - src;
	    memmove(dst, src, numBytes);

	    dst[numBytes] = '\n';
	    dst += numBytes + 1; dstLen -= numBytes + 1;
	    src += numBytes + 1; srcLen -= numBytes + 1;
	    if (srcLen == 0) {
6613
6614
6615
6616
6617
6618
6619
6620

6621
6622
6623
6624
6625
6626
6627
6628

6629
6630
6631
6632

6633
6634
6635
6636
6637
6638
6639
6108
6109
6110
6111
6112
6113
6114

6115
6116
6117
6118
6119
6120
6121
6122

6123
6124
6125
6126

6127
6128
6129
6130
6131
6132
6133
6134







-
+







-
+



-
+







 *
 * Tcl_Ungets --
 *
 *	Causes the supplied string to be added to the input queue of the
 *	channel, at either the head or tail of the queue.
 *
 * Results:
 *	The number of bytes stored in the channel, or TCL_IO_FAILURE on error.
 *	The number of bytes stored in the channel, or -1 on error.
 *
 * Side effects:
 *	Adds input to the input queue of a channel.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_Ungets(
    Tcl_Channel chan,		/* The channel for which to add the input. */
    const char *str,		/* The input itself. */
    size_t len,			/* The length of the input. */
    int len,			/* The length of the input. */
    int atEnd)			/* If non-zero, add at end of queue; otherwise
				 * add at head of queue. */
{
    Channel *chanPtr;		/* The real IO channel. */
    ChannelState *statePtr;	/* State of actual channel. */
    ChannelBuffer *bufPtr;	/* Buffer to contain the data. */
    int flags;
6649
6650
6651
6652
6653
6654
6655
6656

6657
6658
6659
6660
6661
6662
6663
6664

6665
6666
6667
6668
6669
6670
6671
6672
6673

6674
6675
6676
6677
6678
6679
6680
6144
6145
6146
6147
6148
6149
6150

6151
6152
6153
6154
6155
6156
6157
6158

6159
6160
6161
6162
6163
6164
6165
6166
6167

6168
6169
6170
6171
6172
6173
6174
6175







-
+







-
+








-
+








    /*
     * CheckChannelErrors clears too many flag bits in this one case.
     */

    flags = statePtr->flags;
    if (CheckChannelErrors(statePtr, TCL_READABLE) != 0) {
	len = TCL_IO_FAILURE;
	len = -1;
	goto done;
    }
    statePtr->flags = flags;

    /*
     * Clear the EOF flags, and clear the BLOCKED bit.
     */

 
    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    ResetFlag(statePtr,
	    CHANNEL_BLOCKED | CHANNEL_STICKY_EOF | CHANNEL_EOF | INPUT_SAW_CR);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

    bufPtr = AllocChannelBuffer(len);
    memcpy(InsertPoint(bufPtr), str, len);
    memcpy(InsertPoint(bufPtr), str, (size_t) len);
    bufPtr->nextAdded += len;

    if (statePtr->inQueueHead == NULL) {
	bufPtr->nextPtr = NULL;
	statePtr->inQueueHead = bufPtr;
	statePtr->inQueueTail = bufPtr;
    } else if (atEnd) {
6725
6726
6727
6728
6729
6730
6731
6732

6733
6734
6735
6736
6737
6738
6739
6220
6221
6222
6223
6224
6225
6226

6227
6228
6229
6230
6231
6232
6233
6234







-
+







    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
	return TCL_ERROR;
	return -1;
    }

    result = FlushChannel(NULL, chanPtr, 0);
    if (result != 0) {
	return TCL_ERROR;
    }

6814
6815
6816
6817
6818
6819
6820
6821

6822
6823
6824
6825
6826
6827

6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846






6847
6848
6849
6850
6851
6852
6853
6854
6855











6856
6857
6858
6859
6860
6861
6862

6863
6864
6865
6866
6867
6868
6869
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







-
+





-
+













-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







+







    int toRead;			/* How much to read? */
    int result;			/* Of calling driver. */
    int nread;			/* How much was read from channel? */
    ChannelBuffer *bufPtr;	/* New buffer to add to input queue. */
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    /*
    /* 
     * Verify that all callers know better than to call us when
     * it's recorded that the next char waiting to be read is the
     * eofchar.
     */

    assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
    assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );

    /*
     * Prevent reading from a dead channel -- a channel that has been closed
     * but not yet deallocated, which can happen if the exit handler for
     * channel cleanup has run but the channel is still registered in some
     * interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return EINVAL;
    }

    /*
     * WARNING: There was once a comment here claiming that it was a bad idea
     * to make another call to the inputproc of a channel driver when EOF has
     * already been detected on the channel.  Through much of Tcl's history,
     * this warning was then completely negated by having all (most?) read
     * paths clear the EOF setting before reaching here.  So we had a guard
     * that was never triggered.
     * WARNING: There was once a comment here claiming that it was
     * a bad idea to make another call to the inputproc of a channel
     * driver when EOF has already been detected on the channel.  Through
     * much of Tcl's history, this warning was then completely negated
     * by having all (most?) read paths clear the EOF setting before
     * reaching here.  So we had a guard that was never triggered.
     *
     * Don't be tempted to restore the guard.  Even if EOF is set on the
     * channel, continue through and call the inputproc again.  This is the
     * way to enable the ability to [read] again beyond the EOF, which seems a
     * strange thing to do, but for which use cases exist [Tcl Bug 5adc350683]
     * and which may even be essential for channels representing things like
     * ttys or other devices where the stream might take the logical form of a
     * series of 'files' separated by an EOF condition.
     *
     * Don't be tempted to restore the guard.  Even if EOF is set on
     * the channel, continue through and call the inputproc again.  This
     * is the way to enable the ability to [read] again beyond the EOF,
     * which seems a strange thing to do, but for which use cases exist
     * [Tcl Bug 5adc350683] and which may even be essential for channels
     * representing things like ttys or other devices where the stream
     * might take the logical form of a series of 'files' separated by
     * an EOF condition.
     */

    /*
     * First check for more buffers in the pushback area of the topmost
     * channel in the stack and use them. They can be the result of a
     * transformation which went away without reading all the information
     * placed in the area when it was stacked.
     */

    if (chanPtr->inQueueHead != NULL) {

	/* TODO: Tests to cover this. */
	assert(statePtr->inQueueHead == NULL);

	statePtr->inQueueHead = chanPtr->inQueueHead;
	statePtr->inQueueTail = chanPtr->inQueueTail;
	chanPtr->inQueueHead = NULL;
	chanPtr->inQueueTail = NULL;
6885
6886
6887
6888
6889
6890
6891
6892
6893


6894
6895
6896
6897
6898
6899
6900
6901
6384
6385
6386
6387
6388
6389
6390


6391
6392

6393
6394
6395
6396
6397
6398
6399







-
-
+
+
-








    if ((bufPtr == NULL) || IsBufferFull(bufPtr)) {
	bufPtr = statePtr->saveInBufPtr;
	statePtr->saveInBufPtr = NULL;

	/*
	 * Check the actual buffersize against the requested buffersize.
	 * Saved buffers of the wrong size are squashed. This is done to honor
	 * dynamic changes of the buffersize made by the user.
	 * Saved buffers of the wrong size are squashed. This is done
	 * to honor dynamic changes of the buffersize made by the user.
         *
	 * TODO: Tests to cover this.
	 */

	if ((bufPtr != NULL)
		&& (bufPtr->bufLength - BUFFER_PADDING != statePtr->bufSize)) {
	    ReleaseChannelBuffer(bufPtr);
	    bufPtr = NULL;
6966
6967
6968
6969
6970
6971
6972
6973

6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984

6985
6986
6987
6988
6989
6990
6991
6992
6993
6994
6995
6996
6997
6998

6999
7000
7001

7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012
7013
7014

7015
7016
7017
7018
7019
7020
7021
6464
6465
6466
6467
6468
6469
6470

6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481

6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495

6496

6497

6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510

6511
6512
6513
6514
6515
6516
6517
6518







-
+










-
+













-
+
-

-
+












-
+







    int result;			/* Of device driver operations. */
    Tcl_WideInt curPos;		/* Position on the device. */
    int wasAsync;		/* Was the channel nonblocking before the seek
				 * operation? If so, must restore to
				 * non-blocking mode after the seek. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
	return Tcl_LongAsWide(-1);
    }

    /*
     * Disallow seek on dead channels - channels that have been closed but not
     * yet been deallocated. Such channels can be found if the exit handler
     * for channel cleanup has run but the channel is still registered in an
     * interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return -1;
	return Tcl_LongAsWide(-1);
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow seek on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL)
    if (chanPtr->typePtr->seekProc == NULL) {
    ) {
	Tcl_SetErrno(EINVAL);
	return -1;
	return Tcl_LongAsWide(-1);
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    if ((inputBuffered != 0) && (outputBuffered != 0)) {
	Tcl_SetErrno(EFAULT);
	return -1;
	return Tcl_LongAsWide(-1);
    }

    /*
     * If we are seeking relative to the current position, compute the
     * corrected offset taking into account the amount of unread input.
     */

7034
7035
7036
7037
7038
7039
7040

7041

7042
7043
7044
7045
7046
7047
7048
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
6531
6532
6533
6534
6535
6536
6537
6538

6539

6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553

6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574

6575
6576
6577
6578
6579
6580
6581


6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607

6608
6609
6610
6611
6612
6613
6614
6615







+
-
+
-














-
+




















-
+
+


+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+















-
+







     * Reset EOF and BLOCKED flags. We invalidate them by moving the access
     * point. Also clear CR related flags.
     */

    if (GotFlag(statePtr, CHANNEL_EOF)) {
	statePtr->inputEncodingFlags |= TCL_ENCODING_START;
    }
    statePtr->flags &=
    ResetFlag(statePtr, CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED |
	~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED | INPUT_SAW_CR);
	    INPUT_SAW_CR);
    statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

    /*
     * If the channel is in asynchronous output mode, switch it back to
     * synchronous mode and cancel any async flush that may be scheduled.
     * After the flush, the channel will be put back into asynchronous output
     * mode.
     */

    wasAsync = 0;
    if (GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
	wasAsync = 1;
	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
	if (result != 0) {
	    return -1;
	    return Tcl_LongAsWide(-1);
	}
	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
	    ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
	}
    }

    /*
     * If the flush fails we cannot recover the original position. In that
     * case the seek is not attempted because we do not know where the access
     * position is - instead we return the error. FlushChannel has already
     * called Tcl_SetErrno() to report the error upwards. If the flush
     * succeeds we do the seek also.
     */

    if (FlushChannel(NULL, chanPtr, 0) != 0) {
	curPos = -1;
    } else {
	/*
	 * Now seek to the new position in the channel as requested by the
	 * caller.
	 * caller. Note that we prefer the wideSeekProc if that is available
	 * and non-NULL...
	 */

	if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
		chanPtr->typePtr->wideSeekProc != NULL) {
	    curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
	curPos = ChanSeek(chanPtr, offset, mode, &result);
	if (curPos == -1) {
		    offset, mode, &result);
	} else if (offset < Tcl_LongAsWide(LONG_MIN) ||
		offset > Tcl_LongAsWide(LONG_MAX)) {
	    result = EOVERFLOW;
	    curPos = Tcl_LongAsWide(-1);
	} else {
	    curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
		    chanPtr->instanceData, Tcl_WideAsLong(offset), mode,
		    &result));
	}
	if (curPos == Tcl_LongAsWide(-1)) {
	    Tcl_SetErrno(result);
	}
    }

    /*
     * Restore to nonblocking mode if that was the previous behavior.
     *
     * NOTE: Even if there was an async flush active we do not restore it now
     * because we already flushed all the queued output, above.
     */

    if (wasAsync) {
	SetFlag(statePtr, CHANNEL_NONBLOCKING);
	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
	if (result != 0) {
	    return -1;
	    return Tcl_LongAsWide(-1);
	}
    }

    return curPos;
}

/*
7131
7132
7133
7134
7135
7136
7137
7138

7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149

7150
7151
7152
7153
7154
7155
7156
7157
7158
7159
7160
7161
7162
7163

7164
7165
7166

7167
7168
7169
7170
7171
7172
7173
7174
7175





7176
7177
7178
7179
7180
7181
7182



7183
7184






7185
7186

7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197










































7198
7199
7200
7201
7202
7203

7204
7205
7206
7207
7208
7209
7210
6641
6642
6643
6644
6645
6646
6647

6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658

6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672

6673

6674

6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699


6700
6701
6702
6703
6704
6705
6706

6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765

6766
6767
6768
6769
6770
6771
6772
6773







-
+










-
+













-
+
-

-
+









+
+
+
+
+







+
+
+
-
-
+
+
+
+
+
+

-
+











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+







				/* State info for channel */
    int inputBuffered, outputBuffered;
				/* # bytes held in buffers. */
    int result;			/* Of calling device driver. */
    Tcl_WideInt curPos;		/* Position on device. */

    if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
	return -1;
	return Tcl_LongAsWide(-1);
    }

    /*
     * Disallow tell on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit
     * handler for channel cleanup has run but the channel is still registered
     * in an interpreter.
     */

    if (CheckForDeadChannel(NULL, statePtr)) {
	return -1;
	return Tcl_LongAsWide(-1);
    }

    /*
     * This operation should occur at the top of a channel stack.
     */

    chanPtr = statePtr->topChanPtr;

    /*
     * Disallow tell on channels whose type does not have a seek procedure
     * defined. This means that the channel does not support seeking.
     */

    if ((Tcl_ChannelWideSeekProc(chanPtr->typePtr) == NULL)
    if (chanPtr->typePtr->seekProc == NULL) {
    ) {
	Tcl_SetErrno(EINVAL);
	return -1;
	return Tcl_LongAsWide(-1);
    }

    /*
     * Compute how much input and output is buffered. If both input and output
     * is buffered, cannot compute the current position.
     */

    inputBuffered = Tcl_InputBuffered(chan);
    outputBuffered = Tcl_OutputBuffered(chan);

    if ((inputBuffered != 0) && (outputBuffered != 0)) {
	/*Tcl_SetErrno(EFAULT);*/
	/*return Tcl_LongAsWide(-1);*/
    }

    /*
     * Get the current position in the device and compute the position where
     * the next character will be read or written. Note that we prefer the
     * wideSeekProc if that is available and non-NULL...
     */

    if (HaveVersion(chanPtr->typePtr, TCL_CHANNEL_VERSION_3) &&
	    chanPtr->typePtr->wideSeekProc != NULL) {
	curPos = (chanPtr->typePtr->wideSeekProc) (chanPtr->instanceData,
    curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result);
    if (curPos == -1) {
		Tcl_LongAsWide(0), SEEK_CUR, &result);
    } else {
	curPos = Tcl_LongAsWide((chanPtr->typePtr->seekProc) (
		chanPtr->instanceData, 0, SEEK_CUR, &result));
    }
    if (curPos == Tcl_LongAsWide(-1)) {
	Tcl_SetErrno(result);
	return -1;
	return Tcl_LongAsWide(-1);
    }

    if (inputBuffered != 0) {
	return curPos - inputBuffered;
    }
    return curPos + outputBuffered;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_SeekOld, Tcl_TellOld --
 *
 *	Backward-compatibility versions of the seek/tell interface that do not
 *	support 64-bit offsets. This interface is not documented or expected
 *	to be supported indefinitely.
 *
 * Results:
 *	As for Tcl_Seek and Tcl_Tell respectively, except truncated to
 *	whatever value will fit in an 'int'.
 *
 * Side effects:
 *	As for Tcl_Seek and Tcl_Tell respectively.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_SeekOld(
    Tcl_Channel chan,		/* The channel on which to seek. */
    int offset,			/* Offset to seek to. */
    int mode)			/* Relative to which location to seek? */
{
    Tcl_WideInt wOffset, wResult;

    wOffset = Tcl_LongAsWide((long)offset);
    wResult = Tcl_Seek(chan, wOffset, mode);
    return (int)Tcl_WideAsLong(wResult);
}

int
Tcl_TellOld(
    Tcl_Channel chan)		/* The channel to return pos for. */
{
    Tcl_WideInt wResult;

    wResult = Tcl_Tell(chan);
    return (int)Tcl_WideAsLong(wResult);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_TruncateChannel --
 *
 *	Truncate a channel to the given length.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR if the operation failed (e.g., is not
 *	TCL_OK on success, TCL_ERROR if the operation failed (e.g. is not
 *	supported by the type of channel, or the underlying OS operation
 *	failed in some way).
 *
 * Side effects:
 *	Seeks the channel to the current location. Sets errno on OS error.
 *
 *---------------------------------------------------------------------------
7226
7227
7228
7229
7230
7231
7232
7233

7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250

7251
7252
7253
7254
7255
7256
7257
6789
6790
6791
6792
6793
6794
6795

6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812

6813
6814
6815
6816
6817
6818
6819
6820







-
+
















-
+







	 * returned an EINVAL, a very generic error!
	 */

	Tcl_SetErrno(EINVAL);
	return TCL_ERROR;
    }

    if (!GotFlag(chanPtr->state, TCL_WRITABLE)) {
    if (!(chanPtr->state->flags & TCL_WRITABLE)) {
	/*
	 * We require that the file was opened of writing. Do that check now
	 * so that we only flush if we think we're going to succeed.
	 */

	Tcl_SetErrno(EINVAL);
	return TCL_ERROR;
    }

    /*
     * Seek first to force a total flush of all pending buffers and ditch any
     * pre-read input data.
     */

    WillWrite(chanPtr);

    if (WillRead(chanPtr) == -1) {
    if (WillRead(chanPtr) < 0) {
        return TCL_ERROR;
    }

    /*
     * We're all flushed to disk now and we also don't have any unfortunate
     * input baggage around either; can truncate with impunity.
     */
7323
7324
7325
7326
7327
7328
7329
7330

7331
7332
7333
7334
7335
7336
7337
6886
6887
6888
6889
6890
6891
6892

6893
6894
6895
6896
6897
6898
6899
6900







-
+







	return -1;
    }

    /*
     * Fail if the channel is not opened for desired operation.
     */

    if ((statePtr->flags & direction) == 0) {
    if (GotFlag(statePtr, direction) == 0) {
	Tcl_SetErrno(EACCES);
	return -1;
    }

    /*
     * Fail if the channel is in the middle of a background copy.
     *
7476
7477
7478
7479
7480
7481
7482
7483

7484
7485
7486
7487
7488
7489
7490
7039
7040
7041
7042
7043
7044
7045

7046
7047
7048
7049
7050
7051
7052
7053







-
+







    int bytesBuffered;

    for (bytesBuffered = 0, bufPtr = statePtr->outQueueHead; bufPtr != NULL;
	    bufPtr = bufPtr->nextPtr) {
	bytesBuffered += BytesLeft(bufPtr);
    }
    if (statePtr->curOutPtr != NULL) {
	ChannelBuffer *curOutPtr = statePtr->curOutPtr;
	register ChannelBuffer *curOutPtr = statePtr->curOutPtr;

	if (IsBufferReady(curOutPtr)) {
	    bytesBuffered += BytesLeft(curOutPtr);
	}
    }

    return bytesBuffered;
7550
7551
7552
7553
7554
7555
7556
7557

7558
7559

7560
7561
7562
7563
7564
7565
7566
7113
7114
7115
7116
7117
7118
7119

7120
7121

7122
7123
7124
7125
7126
7127
7128
7129







-
+

-
+







    ChannelState *statePtr;	/* State of real channel structure. */

    /*
     * Clip the buffer size to force it into the [1,1M] range
     */

    if (sz < 1) {
	sz = 1;
      sz = 1;
    } else if (sz > MAX_CHANNEL_BUFFER_SIZE) {
	sz = MAX_CHANNEL_BUFFER_SIZE;
      sz = MAX_CHANNEL_BUFFER_SIZE;
    }

    statePtr = ((Channel *) chan)->state;

    if (statePtr->bufSize == sz) {
	return;
    }
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661

7662
7663
7664
7665
7666
7667
7668

7669

7670
7671
7672
7673

7674
7675
7676

7677
7678

7679
7680
7681
7682
7683
7684
7685
7212
7213
7214
7215
7216
7217
7218

7219
7220
7221
7222

7223
7224
7225
7226
7227
7228
7229
7230
7231

7232

7233
7234

7235
7236


7237
7238

7239
7240
7241
7242
7243
7244
7245
7246







-




-
+







+
-
+
-


-
+

-
-
+

-
+







{
    if (interp != NULL) {
	const char *genericopt =
		"blocking buffering buffersize encoding eofchar translation";
	const char **argv;
	int argc, i;
	Tcl_DString ds;
        Tcl_Obj *errObj;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, genericopt, -1);
	if (optionList && (*optionList)) {
	    TclDStringAppendLiteral(&ds, " ");
	    Tcl_DStringAppend(&ds, " ", 1);
	    Tcl_DStringAppend(&ds, optionList, -1);
	}
	if (Tcl_SplitList(interp, Tcl_DStringValue(&ds),
		&argc, &argv) != TCL_OK) {
	    Tcl_Panic("malformed option list in channel driver");
	}
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "bad option \"", optionName,
	errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ",
		"\": should be one of ", NULL);
                optionName ? optionName : "");
	argc--;
	for (i = 0; i < argc; i++) {
	    Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]);
	    Tcl_AppendResult(interp, "-", argv[i], ", ", NULL);
	}
	Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]);
        Tcl_SetObjResult(interp, errObj);
	Tcl_AppendResult(interp, "or -", argv[i], NULL);
	Tcl_DStringFree(&ds);
	Tcl_Free((void *)argv);
	ckfree((char *) argv);
    }
    Tcl_SetErrno(EINVAL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
7733
7734
7735
7736
7737
7738
7739
7740

7741
7742

7743
7744
7745
7746
7747
7748
7749
7294
7295
7296
7297
7298
7299
7300

7301
7302

7303
7304
7305
7306
7307
7308
7309
7310







-
+

-
+







    chanPtr = statePtr->topChanPtr;

    /*
     * If we are in the middle of a background copy, use the saved flags.
     */

    if (statePtr->csPtrR) {
	flags = statePtr->csPtrR->readFlags;
      flags = statePtr->csPtrR->readFlags;
    } else if (statePtr->csPtrW) {
	flags = statePtr->csPtrW->writeFlags;
      flags = statePtr->csPtrW->writeFlags;
    } else {
	flags = statePtr->flags;
    }

    /*
     * If the optionName is NULL it means that we want a list of all options
     * and values.
7895
7896
7897
7898
7899
7900
7901
7902
7903


7904
7905
7906
7907
7908
7909
7910
7456
7457
7458
7459
7460
7461
7462


7463
7464
7465
7466
7467
7468
7469
7470
7471







-
-
+
+








    if (chanPtr->typePtr->getOptionProc != NULL) {
	/*
	 * Let the driver specific handle additional options and result code
	 * and message.
	 */

	return chanPtr->typePtr->getOptionProc(chanPtr->instanceData, interp,
		optionName, dsPtr);
	return (chanPtr->typePtr->getOptionProc) (chanPtr->instanceData,
		interp, optionName, dsPtr);
    } else {
	/*
	 * No driver specific options case.
	 */

	if (len == 0) {
	    return TCL_OK;
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956


7957
7958
7959
7960
7961
7962
7963
7508
7509
7510
7511
7512
7513
7514



7515
7516
7517
7518
7519
7520
7521
7522
7523







-
-
-
+
+








    /*
     * If the channel is in the middle of a background copy, fail.
     */

    if (statePtr->csPtrR || statePtr->csPtrW) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "unable to set channel options: background copy in"
                    " progress", -1));
	    Tcl_AppendResult(interp, "unable to set channel options: "
		    "background copy in progress", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Disallow options on dead channels -- channels that have been closed but
     * not yet been deallocated. Such channels can be found if the exit
7988
7989
7990
7991
7992
7993
7994

7995

7996
7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
8008






8009
8010
8011
8012
8013
8014
8015
7548
7549
7550
7551
7552
7553
7554
7555

7556
7557
7558
7559
7560
7561
7562
7563
7564





7565
7566
7567
7568
7569
7570
7571
7572
7573
7574
7575
7576
7577







+
-
+








-
-
-
-
-
+
+
+
+
+
+







	} else {
	    newMode = TCL_MODE_NONBLOCKING;
	}
	return SetBlockMode(interp, chanPtr, newMode);
    } else if (HaveOpt(7, "-buffering")) {
	len = strlen(newValue);
	if ((newValue[0] == 'f') && (strncmp(newValue, "full", len) == 0)) {
	    statePtr->flags &=
	    ResetFlag(statePtr, CHANNEL_UNBUFFERED | CHANNEL_LINEBUFFERED);
		    ~(CHANNEL_UNBUFFERED|CHANNEL_LINEBUFFERED);
	} else if ((newValue[0] == 'l') &&
		(strncmp(newValue, "line", len) == 0)) {
	    ResetFlag(statePtr, CHANNEL_UNBUFFERED);
	    SetFlag(statePtr, CHANNEL_LINEBUFFERED);
	} else if ((newValue[0] == 'n') &&
		(strncmp(newValue, "none", len) == 0)) {
	    ResetFlag(statePtr, CHANNEL_LINEBUFFERED);
	    SetFlag(statePtr, CHANNEL_UNBUFFERED);
	} else if (interp) {
            Tcl_SetObjResult(interp, Tcl_NewStringObj(
                    "bad value for -buffering: must be one of"
                    " full, line, or none", -1));
            return TCL_ERROR;
	} else {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -buffering: "
			"must be one of full, line, or none", NULL);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else if (HaveOpt(7, "-buffersize")) {
	int newBufferSize;

	if (Tcl_GetInt(interp, newValue, &newBufferSize) == TCL_ERROR) {
	    return TCL_ERROR;
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067


8068
8069

8070
8071
8072
8073
8074
8075
8076
8077
8078
8079
8080

8081
8082

8083
8084

8085
8086
8087
8088

8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100


8101

8102
8103
8104
8105
8106
8107
8108
8109
8110
8111
8112
8113
8114
8115
8116
8117
8118

8119
8120

8121
8122

8123
8124
8125
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
8141
8142
8143
8144
8145
8146
8147
8148
8149
8150




8151
8152

8153
8154
8155
8156
8157
8158
8159
7617
7618
7619
7620
7621
7622
7623

7624
7625



7626
7627
7628

7629
7630
7631
7632
7633
7634
7635
7636
7637
7638
7639

7640
7641

7642
7643

7644
7645
7646
7647

7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659

7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679

7680
7681

7682
7683

7684
7685
7686
7687
7688
7689

7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708



7709
7710
7711
7712
7713

7714
7715
7716
7717
7718
7719
7720
7721







-


-
-
-
+
+

-
+










-
+

-
+

-
+



-
+











-
+
+

+
















-
+

-
+

-
+





-



















-
-
-
+
+
+
+

-
+







	if (argc == 0) {
	    statePtr->inEofChar = 0;
	    statePtr->outEofChar = 0;
	} else if (argc == 1 || argc == 2) {
	    int outIndex = (argc - 1);
	    int inValue = (int) argv[0][0];
	    int outValue = (int) argv[outIndex][0];

	    if (inValue & 0x80 || outValue & 0x80) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
                            "bad value for -eofchar: must be non-NUL ASCII"
                            " character", -1));
		    Tcl_AppendResult(interp, "bad value for -eofchar: ",
			    "must be non-NUL ASCII character", NULL);
		}
		Tcl_Free((void *)argv);
		ckfree((char *) argv);
		return TCL_ERROR;
	    }
	    if (GotFlag(statePtr, TCL_READABLE)) {
		statePtr->inEofChar = inValue;
	    }
	    if (GotFlag(statePtr, TCL_WRITABLE)) {
		statePtr->outEofChar = outValue;
	    }
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
		Tcl_AppendResult(interp,
			"bad value for -eofchar: should be a list of zero,"
			" one, or two elements", -1));
			" one, or two elements", NULL);
	    }
	    Tcl_Free((void *)argv);
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}
	if (argv != NULL) {
	    Tcl_Free((void *)argv);
	    ckfree((char *) argv);
	}

	/*
	 * [Bug 930851] Reset EOF and BLOCKED flags. Changing the character
	 * which signals eof can transform a current eof condition into a 'go
	 * ahead'. Ditto for blocked.
	 */

	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_STICKY_EOF|CHANNEL_BLOCKED);
	statePtr->flags &=
		~(CHANNEL_EOF | CHANNEL_STICKY_EOF | CHANNEL_BLOCKED);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;

	return TCL_OK;
    } else if (HaveOpt(1, "-translation")) {
	const char *readMode, *writeMode;

	if (Tcl_SplitList(interp, newValue, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}

	if (argc == 1) {
	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[0] : NULL;
	} else if (argc == 2) {
	    readMode = GotFlag(statePtr, TCL_READABLE) ? argv[0] : NULL;
	    writeMode = GotFlag(statePtr, TCL_WRITABLE) ? argv[1] : NULL;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
		Tcl_AppendResult(interp,
			"bad value for -translation: must be a one or two"
			" element list", -1));
			" element list", NULL);
	    }
	    Tcl_Free((void *)argv);
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	if (readMode) {
	    TclEolTranslation translation;

	    if (*readMode == '\0') {
		translation = statePtr->inputTranslation;
	    } else if (strcmp(readMode, "auto") == 0) {
		translation = TCL_TRANSLATE_AUTO;
	    } else if (strcmp(readMode, "binary") == 0) {
		translation = TCL_TRANSLATE_LF;
		statePtr->inEofChar = 0;
		Tcl_FreeEncoding(statePtr->encoding);
		statePtr->encoding = NULL;
	    } else if (strcmp(readMode, "lf") == 0) {
		translation = TCL_TRANSLATE_LF;
	    } else if (strcmp(readMode, "cr") == 0) {
		translation = TCL_TRANSLATE_CR;
	    } else if (strcmp(readMode, "crlf") == 0) {
		translation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(readMode, "platform") == 0) {
		translation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		    Tcl_AppendResult(interp,
			    "bad value for -translation: "
			    "must be one of auto, binary, cr, lf, crlf,"
			    " or platform", NULL);
		}
		Tcl_Free((void *)argv);
		ckfree((char *) argv);
		return TCL_ERROR;
	    }

	    /*
	     * Reset the EOL flags since we need to look at any buffered data
	     * to see if the new translation mode allows us to complete the
	     * line.
8191
8192
8193
8194
8195
8196
8197
8198
8199
8200




8201
8202

8203
8204
8205
8206

8207
8208
8209
8210


8211
8212
8213
8214
8215
8216
8217
7753
7754
7755
7756
7757
7758
7759



7760
7761
7762
7763
7764

7765
7766
7767
7768

7769
7770
7771


7772
7773
7774
7775
7776
7777
7778
7779
7780







-
-
-
+
+
+
+

-
+



-
+


-
-
+
+







		statePtr->outputTranslation = TCL_TRANSLATE_CR;
	    } else if (strcmp(writeMode, "crlf") == 0) {
		statePtr->outputTranslation = TCL_TRANSLATE_CRLF;
	    } else if (strcmp(writeMode, "platform") == 0) {
		statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION;
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "bad value for -translation: must be one of "
                            "auto, binary, cr, lf, crlf, or platform", -1));
		    Tcl_AppendResult(interp,
			    "bad value for -translation: "
			    "must be one of auto, binary, cr, lf, crlf,"
			    " or platform", NULL);
		}
		Tcl_Free((void *)argv);
		ckfree((char *) argv);
		return TCL_ERROR;
	    }
	}
	Tcl_Free((void *)argv);
	ckfree((char *) argv);
	return TCL_OK;
    } else if (chanPtr->typePtr->setOptionProc != NULL) {
	return chanPtr->typePtr->setOptionProc(chanPtr->instanceData, interp,
		optionName, newValue);
	return (*chanPtr->typePtr->setOptionProc)(chanPtr->instanceData,
		interp, optionName, newValue);
    } else {
	return Tcl_BadChannelOption(interp, optionName, NULL);
    }

    return TCL_OK;
}

8258
8259
8260
8261
8262
8263
8264
8265

8266
8267
8268
8269
8270
8271
8272
7821
7822
7823
7824
7825
7826
7827

7828
7829
7830
7831
7832
7833
7834
7835







-
+







		prevPtr->nextPtr = nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, sPtr);

	    TclDecrRefCount(sPtr->scriptPtr);
	    Tcl_Free(sPtr);
	    ckfree((char *) sPtr);
	} else {
	    prevPtr = sPtr;
	}
    }
}

/*
8311
8312
8313
8314
8315
8316
8317
8318

8319
8320
8321
8322
8323
8324
8325

8326
8327
8328
8329
8330
8331
8332
7874
7875
7876
7877
7878
7879
7880

7881
7882
7883
7884
7885
7886
7887

7888
7889
7890
7891
7892
7893
7894
7895







-
+






-
+







     * and thus does not take part in handling it. IOW, its HandlerProc is not
     * called, instead we begin with the channel above it.
     *
     * This behaviour also allows the transformation channels to generate
     * their own events and pass them upward.
     */

    while (mask && (chanPtr->upChanPtr != NULL)) {
    while (mask && (chanPtr->upChanPtr != (NULL))) {
	Tcl_DriverHandlerProc *upHandlerProc;

	upChanPtr = chanPtr->upChanPtr;
	upTypePtr = upChanPtr->typePtr;
	upHandlerProc = Tcl_ChannelHandlerProc(upTypePtr);
	if (upHandlerProc != NULL) {
	    mask = upHandlerProc(upChanPtr->instanceData, mask);
	    mask = (*upHandlerProc) (upChanPtr->instanceData, mask);
	}

	/*
	 * ELSE: Ignore transformations which are unable to handle the event
	 * coming from below. Assume that they don't change the mask and pass
	 * it on.
	 */
8351
8352
8353
8354
8355
8356
8357
8358
8359
8360
8361
8362
8363
8364
8365
8366
8367
8368
8369
8370
8371
8372
8373
8374
8375
8376
8377
8378
8379

8380
8381
8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394

8395
8396
8397
8398
8399
8400
8401
8402
8403
8404
8405
8406
8407
8408
8409
8410
8411
8412
8413
8414
8415
8416
8417
8418
8419
8420
8421
8422
8423
8424
8425
8426
8427
8428
8429
8430
7914
7915
7916
7917
7918
7919
7920







7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934

7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949

7950
7951
7952
7953
7954







7955
7956
7957
7958
7959
7960
7961
7962
7963
7964
7965
7966
7967
7968
7969
7970
7971

7972
7973
7974
7975
7976
7977
7978







-
-
-
-
-
-
-














-
+














-
+




-
-
-
-
-
-
-

















-







     *
     * Preserve the channel struct in case the script closes it.
     */

    TclChannelPreserve((Tcl_Channel)channel);
    Tcl_Preserve(statePtr);

    /*
     * Avoid processing if the channel owner has been changed.
     */
    if (statePtr->managingThread != Tcl_GetCurrentThread()) {
	goto done;
    }

    /*
     * If we are flushing in the background, be sure to call FlushChannel for
     * writable events. Note that we have to discard the writable event so we
     * don't call any write handlers before the flush is complete.
     */

    if (GotFlag(statePtr, BG_FLUSH_SCHEDULED) && (mask & TCL_WRITABLE)) {
	if (0 == FlushChannel(NULL, chanPtr, 1)) {
	    mask &= ~TCL_WRITABLE;
	}
    }

    /*
     * Add this invocation to the list of recursive invocations of
     * Tcl_NotifyChannel.
     * ChannelHandlerEventProc.
     */

    nh.nextHandlerPtr = NULL;
    nh.nestedHandlerPtr = tsdPtr->nestedHandlerPtr;
    tsdPtr->nestedHandlerPtr = &nh;

    for (chPtr = statePtr->chPtr; chPtr != NULL; ) {
	/*
	 * If this channel handler is interested in any of the events that
	 * have occurred on the channel, invoke its procedure.
	 */

	if ((chPtr->mask & mask) != 0) {
	    nh.nextHandlerPtr = chPtr->nextPtr;
	    chPtr->proc(chPtr->clientData, chPtr->mask & mask);
	    (*(chPtr->proc))(chPtr->clientData, chPtr->mask & mask);
	    chPtr = nh.nextHandlerPtr;
	} else {
	    chPtr = chPtr->nextPtr;
	}

	/*
	 * Stop if the channel owner has been changed in-between.
	 */
	if (chanPtr->state->managingThread != Tcl_GetCurrentThread()) {
	    goto done;
	}
    }

    /*
     * Update the notifier interest, since it may have changed after invoking
     * event handlers. Skip that if the channel was deleted in the call to the
     * channel handler.
     */

    if (chanPtr->typePtr != NULL) {
	/*
	 * TODO: This call may not be needed.  If a handler induced a
	 * change in interest, that handler should have made its own
	 * UpdateInterest() call, one would think.
	 */
	UpdateInterest(chanPtr);
    }

done:
    Tcl_Release(statePtr);
    TclChannelRelease(channel);

    tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}

/*
8493
8494
8495
8496
8497
8498
8499
8500

8501
8502

8503
8504
8505
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
8041
8042
8043
8044
8045
8046
8047

8048
8049

8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070


8071
8072
8073
8074
8075

8076










8077
8078
8079
8080
8081
8082
8083







-
+

-
+




















-
-
+
+



-
+
-
-
-
-
-
-
-
-
-
-







	     * - It does not process all events in the event queue, but only
	     *	 one, at least in some situations.
	     *
	     * In that case we can get into a situation where
	     *
	     * - Tcl drops READABLE here, because it has data in its own
	     *	 buffers waiting to be read by the extension.
	     * - A READABLE event is synthesized via timer.
	     * - A READABLE event is syntesized via timer.
	     * - The OS still reports the EXCEPTION condition on the file.
	     * - And the extension gets the EXCEPTION event first, and handles
	     * - And the extension gets the EXCPTION event first, and handles
	     *	 this as EOF.
	     *
	     * End result ==> Premature end of reading from a file.
	     *
	     * The concrete example is 'Expect', and its [expect] command
	     * (and at the C-level, deep in the bowels of Expect,
	     * 'exp_get_next_event'. See marker 'SunOS' for commentary in
	     * that function too).
	     *
	     * [*] As the Tcl notifier does. See also for marker 'SunOS' in
	     * file 'exp_event.c' of Expect.
	     *
	     * Our solution here is to drop the interest in the EXCEPTION
	     * events too. This compiles on all platforms, and also passes the
	     * testsuite on all of them.
	     */

	    mask &= ~TCL_EXCEPTION;

	    if (!statePtr->timer) {
		statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                        ChannelTimerProc, chanPtr);
		statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,
			chanPtr);
	    }
	}
    }

    (chanPtr->typePtr->watchProc)(chanPtr->instanceData, mask);
    if (!statePtr->timer
	&& mask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)) {

	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
	    ChannelTimerProc,chanPtr);
    }


    ChanWatch(chanPtr, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * ChannelTimerProc --
 *
8555
8556
8557
8558
8559
8560
8561
8562

8563
8564
8565
8566
8567
8568
8569
8570
8571
8572
8573
8574
8575
8576
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
8591


8592

8593

8594
8595
8596
8597
8598
8599
8600
8601
8602
8603
8093
8094
8095
8096
8097
8098
8099

8100
8101
8102
8103















8104
8105
8106
8107
8108
8109
8110
8111
8112


8113
8114
8115
8116
8117
8118
8119
8120

8121
8122
8123
8124
8125
8126
8127







-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
+
+

+

+


-







 *----------------------------------------------------------------------
 */

static void
ChannelTimerProc(
    ClientData clientData)
{
    Channel *chanPtr = (Channel *)clientData;
    Channel *chanPtr = clientData;
    ChannelState *statePtr = chanPtr->state;
				/* State info for channel */

    Tcl_Preserve(statePtr);
    statePtr->timer = NULL;
    if (statePtr->interestMask & TCL_WRITABLE
	&& GotFlag(statePtr, CHANNEL_NONBLOCKING)
	&& !GotFlag(statePtr, BG_FLUSH_SCHEDULED)
	) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */
	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);
	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_WRITABLE);
    }

    if (!GotFlag(statePtr, CHANNEL_NEED_MORE_DATA)
	    && (statePtr->interestMask & TCL_READABLE)
	    && (statePtr->inQueueHead != NULL)
	    && IsBufferReady(statePtr->inQueueHead)) {
	/*
	 * Restart the timer in case a channel handler reenters the event loop
	 * before UpdateInterest gets called by Tcl_NotifyChannel.
	 */

	statePtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
                ChannelTimerProc,chanPtr);
	statePtr->timer = Tcl_CreateTimerHandler(0, ChannelTimerProc,chanPtr);
	Tcl_Preserve(statePtr);
	Tcl_NotifyChannel((Tcl_Channel) chanPtr, TCL_READABLE);
	Tcl_Release(statePtr);
    } else {
	statePtr->timer = NULL;
	UpdateInterest(chanPtr);
    }
    Tcl_Release(statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChannelHandler --
 *
8643
8644
8645
8646
8647
8648
8649
8650

8651
8652
8653
8654
8655
8656
8657
8167
8168
8169
8170
8171
8172
8173

8174
8175
8176
8177
8178
8179
8180
8181







-
+







    for (chPtr = statePtr->chPtr; chPtr != NULL; chPtr = chPtr->nextPtr) {
	if ((chPtr->chanPtr == chanPtr) && (chPtr->proc == proc) &&
		(chPtr->clientData == clientData)) {
	    break;
	}
    }
    if (chPtr == NULL) {
	chPtr = (ChannelHandler *)Tcl_Alloc(sizeof(ChannelHandler));
	chPtr = (ChannelHandler *) ckalloc(sizeof(ChannelHandler));
	chPtr->mask = 0;
	chPtr->proc = proc;
	chPtr->clientData = clientData;
	chPtr->chanPtr = chanPtr;
	chPtr->nextPtr = statePtr->chPtr;
	statePtr->chPtr = chPtr;
    }
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
8251
8252
8253
8254
8255
8256
8257

8258
8259
8260
8261
8262
8263
8264
8265
8266
8267
8268
8269
8270
8271
8272
8273
8274
8275
8276
8277

8278
8279
8280
8281
8282
8283
8284
8285







-
+



















-
+







     */

    if (chPtr == NULL) {
	return;
    }

    /*
     * If Tcl_NotifyChannel is about to process this handler, tell it to
     * If ChannelHandlerEventProc is about to process this handler, tell it to
     * process the next one instead - we are going to delete *this* one.
     */

    for (nhPtr = tsdPtr->nestedHandlerPtr; nhPtr != NULL;
	    nhPtr = nhPtr->nestedHandlerPtr) {
	if (nhPtr->nextHandlerPtr == chPtr) {
	    nhPtr->nextHandlerPtr = chPtr->nextPtr;
	}
    }

    /*
     * Splice it out of the list of channel handlers.
     */

    if (prevChPtr == NULL) {
	statePtr->chPtr = chPtr->nextPtr;
    } else {
	prevChPtr->nextPtr = chPtr->nextPtr;
    }
    Tcl_Free(chPtr);
    ckfree((char *) chPtr);

    /*
     * Recompute the interest list for the channel, so that infinite loops
     * will not result if Tcl_DeleteChannelHandler is called inside an event.
     */

    statePtr->interestMask = 0;
8798
8799
8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
8813

8814
8815
8816
8817
8818
8819
8820
8322
8323
8324
8325
8326
8327
8328

8329
8330
8331
8332
8333
8334
8335

8336
8337
8338
8339
8340
8341
8342
8343







-







-
+








    for (esPtr = statePtr->scriptRecordPtr, prevEsPtr = NULL; esPtr != NULL;
	    prevEsPtr = esPtr, esPtr = esPtr->nextPtr) {
	if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
	    if (esPtr == statePtr->scriptRecordPtr) {
		statePtr->scriptRecordPtr = esPtr->nextPtr;
	    } else {
		CLANG_ASSERT(prevEsPtr);
		prevEsPtr->nextPtr = esPtr->nextPtr;
	    }

	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);

	    TclDecrRefCount(esPtr->scriptPtr);
	    Tcl_Free(esPtr);
	    ckfree((char *) esPtr);

	    break;
	}
    }
}

/*
8855
8856
8857
8858
8859
8860
8861
8862

8863
8864
8865
8866
8867

8868
8869
8870
8871
8872
8873
8874
8378
8379
8380
8381
8382
8383
8384

8385
8386
8387
8388
8389

8390
8391
8392
8393
8394
8395
8396
8397







-
+




-
+







	    break;
	}
    }

    makeCH = (esPtr == NULL);

    if (makeCH) {
	esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord));
	esPtr = (EventScriptRecord *) ckalloc(sizeof(EventScriptRecord));
    }

    /*
     * Initialize the structure before calling Tcl_CreateChannelHandler,
     * because a reflected channel calling 'chan postevent' aka
     * because a reflected channel caling 'chan postevent' aka
     * 'Tcl_NotifyChannel' in its 'watch'Proc will invoke
     * 'TclChannelEventScriptInvoker' immediately, and we do not wish it to
     * see uninitialized memory and crash. See [Bug 2918110].
     */

    esPtr->chanPtr = chanPtr;
    esPtr->interp = interp;
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
8425
8426
8427
8428
8429
8430
8431

8432
8433


8434



8435
8436

8437


8438
8439
8440




8441
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451







-
+

-
-
+
-
-
-
+

-
+
-
-
+


-
-
-
-
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

void
TclChannelEventScriptInvoker(
    ClientData clientData,	/* The script+interp record. */
    TCL_UNUSED(int) /*mask*/)
    int mask)			/* Not used. */
{
    EventScriptRecord *esPtr = (EventScriptRecord *)clientData;
				/* The event script + interpreter to eval it
    Tcl_Interp *interp;		/* Interpreter in which to eval the script. */
				 * in. */
    Channel *chanPtr = esPtr->chanPtr;
				/* The channel for which this handler is
    Channel *chanPtr;		/* The channel for which this handler is
				 * registered. */
    Tcl_Interp *interp = esPtr->interp;
    EventScriptRecord *esPtr;	/* The event script + interpreter to eval it
				/* Interpreter in which to eval the script. */
    int mask = esPtr->mask;
				 * in. */
    int result;			/* Result of call to eval script. */

    /*
     * Be sure event executed in managed channel (covering bugs similar [f583715154]).
     */
    assert(chanPtr->state->managingThread == Tcl_GetCurrentThread());
    esPtr = clientData;
    chanPtr = esPtr->chanPtr;
    mask = esPtr->mask;
    interp = esPtr->interp;

    /*
     * We must preserve the interpreter so we can report errors on it later.
     * Note that we do not need to preserve the channel because that is done
     * by Tcl_NotifyChannel before calling channel handlers.
     */

8942
8943
8944
8945
8946
8947
8948
8949

8950
8951
8952
8953
8954
8955
8956
8461
8462
8463
8464
8465
8466
8467

8468
8469
8470
8471
8472
8473
8474
8475







-
+







     * because the background error may want to reinstall the handler.
     */

    if (result != TCL_OK) {
	if (chanPtr->typePtr != NULL) {
	    DeleteScriptRecord(interp, chanPtr, mask);
	}
	Tcl_BackgroundException(interp, result);
	TclBackgroundException(interp, result);
    }
    TclChannelRelease((Tcl_Channel)chanPtr);
    Tcl_Release(interp);
}

/*
 *----------------------------------------------------------------------
8967
8968
8969
8970
8971
8972
8973

8974
8975
8976

8977
8978
8979
8980
8981
8982
8983
8984
8985

8986
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
9026
9027
8486
8487
8488
8489
8490
8491
8492
8493
8494
8495

8496
8497
8498
8499
8500
8501
8502
8503
8504

8505
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







+


-
+








-
+


-
-
+
+


















-
-
-
+
+
+









-







 *
 * Side effects:
 *	May create a channel handler for the specified channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FileEventObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter in which the channel for which
				 * to create the handler is found. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Channel *chanPtr;		/* The channel to create the handler for. */
    ChannelState *statePtr;	/* State info for channel */
    Tcl_Channel chan;		/* The opaque type for the channel. */
    const char *chanName;
    char *chanName;
    int modeIndex;		/* Index of mode argument. */
    int mask;
    static const char *const modeOptions[] = {"readable", "writable", NULL};
    static const int maskArray[] = {TCL_READABLE, TCL_WRITABLE};
    static const char *modeOptions[] = {"readable", "writable", NULL};
    static CONST int maskArray[] = {TCL_READABLE, TCL_WRITABLE};

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId event ?script?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], modeOptions, "event name", 0,
	    &modeIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    mask = maskArray[modeIndex];

    chanName = TclGetString(objv[1]);
    chan = Tcl_GetChannel(interp, chanName, NULL);
    if (chan == NULL) {
	return TCL_ERROR;
    }
    chanPtr = (Channel *) chan;
    statePtr = chanPtr->state;
    if ((statePtr->flags & mask) == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("channel is not %s",
		(mask == TCL_READABLE) ? "readable" : "writable"));
    if (GotFlag(statePtr, mask) == 0) {
	Tcl_AppendResult(interp, "channel is not ",
		(mask == TCL_READABLE) ? "readable" : "writable", NULL);
	return TCL_ERROR;
    }

    /*
     * If we are supposed to return the script, do so.
     */

    if (objc == 3) {
	EventScriptRecord *esPtr;

	for (esPtr = statePtr->scriptRecordPtr; esPtr != NULL;
		esPtr = esPtr->nextPtr) {
	    if ((esPtr->interp == interp) && (esPtr->mask == mask)) {
		Tcl_SetObjResult(interp, esPtr->scriptPtr);
		break;
	    }
	}
9068
9069
9070
9071
9072
9073
9074
9075

9076
9077
9078
9079
9080
9081
9082
8587
8588
8589
8590
8591
8592
8593

8594
8595
8596
8597
8598
8599
8600
8601







-
+







static void
ZeroTransferTimerProc(
    ClientData clientData)
{
    /* calling CopyData with mask==0 still implies immediate invocation of the
     *  -command callback, and completion of the fcopy.
     */
    CopyData((CopyState *)clientData, 0);
    CopyData(clientData, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCopyChannel --
 *
9097
9098
9099
9100
9101
9102
9103
9104

9105
9106
9107
9108
9109
9110
9111
9112
9113
9114
9115
9116
9117
9118

9119
9120
9121


9122
9123
9124
9125

9126
9127
9128


9129
9130
9131
9132
9133
9134
9135
8616
8617
8618
8619
8620
8621
8622

8623
8624
8625
8626
8627
8628
8629
8630
8631

8632
8633
8634
8635

8636
8637


8638
8639
8640
8641
8642

8643
8644


8645
8646
8647
8648
8649
8650
8651
8652
8653







-
+








-




-
+

-
-
+
+



-
+

-
-
+
+







 */

int
TclCopyChannel(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Channel inChan,		/* Channel to read from. */
    Tcl_Channel outChan,	/* Channel to write to. */
    Tcl_WideInt toRead,		/* Amount of data to copy, or -1 for all. */
    int toRead,			/* Amount of data to copy, or -1 for all. */
    Tcl_Obj *cmdPtr)		/* Pointer to script to execute or NULL. */
{
    Channel *inPtr = (Channel *) inChan;
    Channel *outPtr = (Channel *) outChan;
    ChannelState *inStatePtr, *outStatePtr;
    int readFlags, writeFlags;
    CopyState *csPtr;
    int nonBlocking = (cmdPtr) ? CHANNEL_NONBLOCKING : 0;
    int moveBytes;

    inStatePtr = inPtr->state;
    outStatePtr = outPtr->state;

    if (BUSY_STATE(inStatePtr, TCL_READABLE)) {
    if (BUSY_STATE(inStatePtr,TCL_READABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "channel \"%s\" is busy", Tcl_GetChannelName(inChan)));
	    Tcl_AppendResult(interp, "channel \"",
		    Tcl_GetChannelName(inChan), "\" is busy", NULL);
	}
	return TCL_ERROR;
    }
    if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) {
    if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "channel \"%s\" is busy", Tcl_GetChannelName(outChan)));
	    Tcl_AppendResult(interp, "channel \"",
		    Tcl_GetChannelName(outChan), "\" is busy", NULL);
	}
	return TCL_ERROR;
    }

    readFlags = inStatePtr->flags;
    writeFlags = outStatePtr->flags;

9154
9155
9156
9157
9158
9159
9160
9161
9162


9163
9164
9165
9166
9167
9168
9169
9170
9171
9172
9173
9174
9175
9176
9177
9178
9179
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
8672
8673
8674
8675
8676
8677
8678


8679
8680











8681
8682
8683
8684
8685
8686
8687


8688
8689
8690
8691
8692
8693
8694

8695
8696
8697
8698
8699
8700
8701
8702
8703
8704




8705
8706
8707
8708
8709
8710
8711







-
-
+
+
-
-
-
-
-
-
-
-
-
-
-







-
-
+
+





-
+









-
-
-
-







	return TCL_ERROR;
    }

    /*
     * Make sure the output side is unbuffered.
     */

    outStatePtr->flags = (outStatePtr->flags & ~CHANNEL_LINEBUFFERED)
	    | CHANNEL_UNBUFFERED;
    outStatePtr->flags = (outStatePtr->flags & ~(CHANNEL_LINEBUFFERED))
	| CHANNEL_UNBUFFERED;

    /*
     * Test for conditions where we know we can just move bytes from input
     * channel to output channel with no transformation or even examination
     * of the bytes themselves.
     */

    moveBytes = inStatePtr->inEofChar == '\0'	/* No eofChar to stop input */
	    && inStatePtr->inputTranslation == TCL_TRANSLATE_LF
	    && outStatePtr->outputTranslation == TCL_TRANSLATE_LF
	    && inStatePtr->encoding == outStatePtr->encoding;

    /*
     * Allocate a new CopyState to maintain info about the current copy in
     * progress. This structure will be deallocated when the copy is
     * completed.
     */

    csPtr = (CopyState *)Tcl_Alloc(sizeof(CopyState) + !moveBytes * inStatePtr->bufSize);
    csPtr->bufSize = !moveBytes * inStatePtr->bufSize;
    csPtr = (CopyState *) ckalloc(sizeof(CopyState) + inStatePtr->bufSize);
    csPtr->bufSize = inStatePtr->bufSize;
    csPtr->readPtr = inPtr;
    csPtr->writePtr = outPtr;
    csPtr->readFlags = readFlags;
    csPtr->writeFlags = writeFlags;
    csPtr->toRead = toRead;
    csPtr->total = (Tcl_WideInt) 0;
    csPtr->total = 0;
    csPtr->interp = interp;
    if (cmdPtr) {
	Tcl_IncrRefCount(cmdPtr);
    }
    csPtr->cmdPtr = cmdPtr;

    inStatePtr->csPtrR  = csPtr;
    outStatePtr->csPtrW = csPtr;

    if (moveBytes) {
	return MoveBytes(csPtr);
    }

    /*
     * Special handling of -size 0 async transfers, so that the -command is
     * still called asynchronously.
     */

    if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) {
        Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr);
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
9272
9273
9274
9275
9276
9277
9278
9279
9280
9281
9282
9283
9284
9285
9286
9287
9288
9289
9290
9291
9292
9293
9294
9295
9296
9297
9298
9299
9300
9301
9302
9303
9304
9305
9306
9307
9308
9309
9310
9311
9312
9313
9314
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
9351
9352
9353
9354
9355
9356
9357
9358
9359
9360
9361
9362
9363
9364
9365
9366
9367
9368
9369
9370
9371
9372
9373
9374
9375
9376
9377
9378
9379
9380
9381
9382
9383
9384
9385
9386
9387
9388
9389
9390
9391
9392
9393
9394
9395
9396
9397
9398
9399
9400
9401
9402
9403
9404
9405
9406
9407
9408
9409
9410
9411
9412
9413
9414
9415
9416
9417
9418
9419
9420
9421
9422
9423
9424
9425
9426
9427
9428
9429
9430
9431
9432
9433
9434
9435
9436
9437
9438
9439
9440
9441
9442
9443
9444
9445
9446
9447
9448
9449
9450
9451
9452
9453
9454
9455
9456
9457
9458
9459
9460
9461
9462
9463
9464
9465
9466
9467
9468
9469
9470
9471
9472
9473
9474
9475

9476
9477
9478

9479
9480
9481
9482
9483
9484
9485
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
+
-

-
+







 *
 * Side effects:
 *	Moves data between channels, may create channel handlers.
 *
 *----------------------------------------------------------------------
 */

static void
MBCallback(
    CopyState *csPtr,
    Tcl_Obj *errObj)
{
    Tcl_Obj *cmdPtr = Tcl_DuplicateObj(csPtr->cmdPtr);
    Tcl_WideInt total = csPtr->total;
    Tcl_Interp *interp = csPtr->interp;
    int code;

    Tcl_IncrRefCount(cmdPtr);
    StopCopy(csPtr);

    /* TODO: What if cmdPtr is not a list?! */

    Tcl_ListObjAppendElement(NULL, cmdPtr, Tcl_NewWideIntObj(total));
    if (errObj) {
	Tcl_ListObjAppendElement(NULL, cmdPtr, errObj);
    }

    Tcl_Preserve(interp);
    code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
    if (code != TCL_OK) {
	Tcl_BackgroundException(interp, code);
    }
    Tcl_Release(interp);
    TclDecrRefCount(cmdPtr);
}

static void
MBError(
    CopyState *csPtr,
    int mask,
    int errorCode)
{
    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
    Tcl_Obj *errObj;

    Tcl_SetErrno(errorCode);

    errObj = Tcl_ObjPrintf( "error %sing \"%s\": %s",
	    (mask & TCL_READABLE) ? "read" : "writ",
	    Tcl_GetChannelName((mask & TCL_READABLE) ? inChan : outChan),
	    Tcl_PosixError(csPtr->interp));

    if (csPtr->cmdPtr) {
	MBCallback(csPtr, errObj);
    } else {
	Tcl_SetObjResult(csPtr->interp, errObj);
	StopCopy(csPtr);
    }
}

static void
MBEvent(
    ClientData clientData,
    int mask)
{
    CopyState *csPtr = (CopyState *) clientData;
    Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
    Tcl_Channel outChan = (Tcl_Channel) csPtr->writePtr;
    ChannelState *inStatePtr = csPtr->readPtr->state;

    if (mask & TCL_WRITABLE) {
	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
	switch (MBWrite(csPtr)) {
	case TCL_OK:
	    MBCallback(csPtr, NULL);
	    break;
	case TCL_CONTINUE:
	    Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
	    break;
	}
    } else if (mask & TCL_READABLE) {
	if (TCL_OK == MBRead(csPtr)) {
	    /* When at least one full buffer is present, stop reading. */
	    if (IsBufferFull(inStatePtr->inQueueHead)
		    || !Tcl_InputBlocked(inChan)) {
		Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	    }

	    /* Successful read -- set up to write the bytes we read */
	    Tcl_CreateChannelHandler(outChan, TCL_WRITABLE, MBEvent, csPtr);
	}
    }
}

static int
MBRead(
    CopyState *csPtr)
{
    ChannelState *inStatePtr = csPtr->readPtr->state;
    ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
    int code;

    if (bufPtr && BytesLeft(bufPtr) > 0) {
	return TCL_OK;
    }

    code = GetInput(inStatePtr->topChanPtr);
    if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
	return TCL_OK;
    } else {
	MBError(csPtr, TCL_READABLE, code);
	return TCL_ERROR;
    }
}

static int
MBWrite(
    CopyState *csPtr)
{
    ChannelState *inStatePtr = csPtr->readPtr->state;
    ChannelState *outStatePtr = csPtr->writePtr->state;
    ChannelBuffer *bufPtr = inStatePtr->inQueueHead;
    ChannelBuffer *tail = NULL;
    int code;
    Tcl_WideInt inBytes = 0;

    /* Count up number of bytes waiting in the input queue */
    while (bufPtr) {
	inBytes += BytesLeft(bufPtr);
	tail = bufPtr;
	if (csPtr->toRead != -1 && csPtr->toRead < inBytes) {
	    /* Queue has enough bytes to complete the copy */
	    break;
	}
	bufPtr = bufPtr->nextPtr;
    }

    if (bufPtr) {
	/* Split the overflowing buffer in two */
	int extra = (int) (inBytes - csPtr->toRead);
        /* Note that going with int for extra assumes that inBytes is not too
         * much over toRead to require a wide itself. If that gets violated
         * then the calculations involving extra must be made wide too.
         *
         * Noted with Win32/MSVC debug build treating the warning (possible of
         * data in __int64 to int conversion) as error.
         */

	bufPtr = AllocChannelBuffer(extra);

	tail->nextAdded -= extra;
	memcpy(InsertPoint(bufPtr), InsertPoint(tail), extra);
	bufPtr->nextAdded += extra;
	bufPtr->nextPtr = tail->nextPtr;
	tail->nextPtr = NULL;
	inBytes = csPtr->toRead;
    }

    /* Update the byte counts */
    if (csPtr->toRead != -1) {
	csPtr->toRead -= inBytes;
    }
    csPtr->total += inBytes;

    /* Move buffers from input to output channels */
    if (outStatePtr->outQueueTail) {
	outStatePtr->outQueueTail->nextPtr = inStatePtr->inQueueHead;
    } else {
	outStatePtr->outQueueHead = inStatePtr->inQueueHead;
    }
    outStatePtr->outQueueTail = tail;
    inStatePtr->inQueueHead = bufPtr;
    if (inStatePtr->inQueueTail == tail) {
	inStatePtr->inQueueTail = bufPtr;
    }
    if (bufPtr == NULL) {
	inStatePtr->inQueueTail = NULL;
    }

    code = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
    if (code) {
	MBError(csPtr, TCL_WRITABLE, code);
	return TCL_ERROR;
    }
    if (csPtr->toRead == 0 || GotFlag(inStatePtr, CHANNEL_EOF)) {
	return TCL_OK;
    }
    return TCL_CONTINUE;
}

static int
MoveBytes(
    CopyState *csPtr)		/* State of copy operation. */
{
    ChannelState *outStatePtr = csPtr->writePtr->state;
    ChannelBuffer *bufPtr = outStatePtr->curOutPtr;
    int errorCode;

    if (bufPtr && BytesLeft(bufPtr)) {
	/* If we start with unflushed bytes in the destination
	 * channel, flush them out of the way first. */

	errorCode = FlushChannel(csPtr->interp, outStatePtr->topChanPtr, 0);
	if (errorCode != 0) {
	    MBError(csPtr, TCL_WRITABLE, errorCode);
	    return TCL_ERROR;
	}
    }

    if (csPtr->cmdPtr) {
	Tcl_Channel inChan = (Tcl_Channel) csPtr->readPtr;
	Tcl_CreateChannelHandler(inChan, TCL_READABLE, MBEvent, csPtr);
	return TCL_OK;
    }

    while (1) {
	int code;

	if (TCL_ERROR == MBRead(csPtr)) {
	    return TCL_ERROR;
	}
	code = MBWrite(csPtr);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(csPtr->interp, Tcl_NewWideIntObj(csPtr->total));
	    StopCopy(csPtr);
	    return TCL_OK;
	}
	if (code == TCL_ERROR) {
	    return TCL_ERROR;
	}
	/* code == TCL_CONTINUE --> continue the loop */
    }
    return TCL_OK;	/* Silence compiler warnings */
}

static int
CopyData(
    CopyState *csPtr,		/* State of copy operation. */
    int mask)			/* Current channel event flags. */
{
    Tcl_Interp *interp;
    Tcl_Obj *cmdPtr, *errObj = NULL, *bufObj = NULL, *msg = NULL;
    Tcl_Channel inChan, outChan;
    ChannelState *inStatePtr, *outStatePtr;
    int result = TCL_OK, size;
    int result = TCL_OK, size, sizeb;
    size_t sizeb;
    Tcl_WideInt total;
    const char *buffer;
    char *buffer;
    int inBinary, outBinary, sameEncoding;
				/* Encoding control */
    int underflow;		/* Input underflow */

    inChan	= (Tcl_Channel) csPtr->readPtr;
    outChan	= (Tcl_Channel) csPtr->writePtr;
    inStatePtr	= csPtr->readPtr->state;
9500
9501
9502
9503
9504
9505
9506
9507

9508
9509
9510
9511
9512
9513
9514
8772
8773
8774
8775
8776
8777
8778

8779
8780
8781
8782
8783
8784
8785
8786







-
+







    sameEncoding = (inStatePtr->encoding == outStatePtr->encoding);

    if (!(inBinary || sameEncoding)) {
	TclNewObj(bufObj);
	Tcl_IncrRefCount(bufObj);
    }

    while (csPtr->toRead != (Tcl_WideInt) 0) {
    while (csPtr->toRead != 0) {
	/*
	 * Check for unreported background errors.
	 */

	Tcl_GetChannelError(inChan, &msg);
	if ((inStatePtr->unreportedError != 0) || (msg != NULL)) {
	    Tcl_SetErrno(inStatePtr->unreportedError);
9524
9525
9526
9527
9528
9529
9530
9531

9532
9533
9534
9535
9536
9537
9538

9539
9540
9541
9542
9543
9544
9545
9546

9547
9548
9549
9550

9551
9552

9553
9554
9555
9556
9557
9558
9559
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







-
+






-
+
-






-
+
-


-
+

-
+








	if (cmdPtr && (mask == 0)) {
	    /*
	     * In async mode, we skip reading synchronously and fake an
	     * underflow instead to prime the readable fileevent.
	     */

	    size = 0;
	    size      = 0;
	    underflow = 1;
	} else {
	    /*
	     * Read up to bufSize bytes.
	     */

	    if ((csPtr->toRead == (Tcl_WideInt) -1)
	    if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) {
                    || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) {
		sizeb = csPtr->bufSize;
	    } else {
		sizeb = csPtr->toRead;
	    }

	    if (inBinary || sameEncoding) {
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb,
		size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb);
                              !GotFlag(inStatePtr, CHANNEL_NONBLOCKING));
	    } else {
		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
			0 /* No append */);
				   0 /* No append */);
	    }
	    underflow = (size >= 0) && ((size_t)size < sizeb);	/* Input underflow */
	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
	}

	if (size < 0) {
	readError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error reading \"",
9576
9577
9578
9579
9580
9581
9582
9583
9584


9585
9586
9587
9588
9589
9590
9591
9592
9593
9594
9595
9596
9597
9598
9599
9600
9601
9602
9603
9604
9605
8846
8847
8848
8849
8850
8851
8852


8853
8854
8855
8856
8857
8858
8859
8860
8861







8862
8863
8864
8865
8866
8867
8868







-
-
+
+







-
-
-
-
-
-
-







	     * copying is done, otherwise set up a channel handler to detect
	     * when the channel becomes readable again.
	     */

	    if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) {
		break;
	    }
	    if (cmdPtr && (!Tcl_Eof(inChan) || (mask == 0)) &&
                !(mask & TCL_READABLE)) {
	    if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) &&
		!(mask & TCL_READABLE)) {
		if (mask & TCL_WRITABLE) {
		    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
		}
		Tcl_CreateChannelHandler(inChan, TCL_READABLE, CopyEventProc,
			csPtr);
	    }
	    if (size == 0) {
		if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
		    /*
		     * We allowed a short read.  Keep trying.
		     */

		    continue;
		}
		if (bufObj != NULL) {
		    TclDecrRefCount(bufObj);
		    bufObj = NULL;
		}
		return TCL_OK;
	    }
	}
9629
9630
9631
9632
9633
9634
9635
9636

9637
9638
9639
9640
9641
9642
9643
9644
9645
9646
9647
9648
9649
9650
9651
9652
9653
9654
9655
9656

9657
9658
9659
9660
9661
9662
9663
8892
8893
8894
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







-
+



















-
+







	 * bytes or characters, and both EOL translation and encoding
	 * conversion may have changed this number unpredictably in relation
	 * to 'size' (It can be smaller or larger, in the latter case able to
	 * drive toRead below -1, causing infinite looping). Completely
	 * unsuitable for updating totals and toRead.
	 */

	if (sizeb == TCL_INDEX_NONE) {
	if (sizeb < 0) {
	writeError:
	    if (interp) {
		TclNewObj(errObj);
		Tcl_AppendStringsToObj(errObj, "error writing \"",
			Tcl_GetChannelName(outChan), "\": ", NULL);
		if (msg != NULL) {
		    Tcl_AppendObjToObj(errObj, msg);
		} else {
		    Tcl_AppendStringsToObj(errObj, Tcl_PosixError(interp),
			    NULL);
		}
	    }
	    if (msg != NULL) {
		Tcl_DecrRefCount(msg);
	    }
	    break;
	}

	/*
	 * Update the current byte count. Do it now so the count is valid
	 * (UP) Update the current byte count. Do it now so the count is valid
	 * before a return or break takes us out of the loop. The invariant at
	 * the top of the loop should be that csPtr->toRead holds the number
	 * of bytes left to copy.
	 */

	if (csPtr->toRead != -1) {
	    csPtr->toRead -= size;
9675
9676
9677
9678
9679
9680
9681
9682

9683
9684
9685
9686
9687
9688
9689
8938
8939
8940
8941
8942
8943
8944

8945
8946
8947
8948
8949
8950
8951
8952







-
+







	/*
	 * Check to see if the write is happening in the background. If so,
	 * stop copying and wait for the channel to become writable again.
	 * After input underflow we already installed a readable handler
	 * therefore we don't need a writable handler.
	 */

	if (!underflow && GotFlag(outStatePtr, BG_FLUSH_SCHEDULED)) {
	if (!underflow && (outStatePtr->flags & BG_FLUSH_SCHEDULED)) {
	    if (!(mask & TCL_WRITABLE)) {
		if (mask & TCL_READABLE) {
		    Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
		}
		Tcl_CreateChannelHandler(outChan, TCL_WRITABLE,
			CopyEventProc, csPtr);
	    }
9726
9727
9728
9729
9730
9731
9732
9733
9734
9735
9736
9737
9738
9739
9740
9741
9742
9743
9744
9745
9746
9747
9748
9749
9750
9751

9752
9753
9754
9755
9756
9757
9758
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







-

















-
+







     * Make the callback or return the number of bytes transferred. The local
     * total is used because StopCopy frees csPtr.
     */

    total = csPtr->total;
    if (cmdPtr && interp) {
	int code;

	/*
	 * Get a private copy of the command so we can mutate it by adding
	 * arguments. Note that StopCopy frees our saved reference to the
	 * original command obj.
	 */

	cmdPtr = Tcl_DuplicateObj(cmdPtr);
	Tcl_IncrRefCount(cmdPtr);
	StopCopy(csPtr);
	Tcl_Preserve(interp);

	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewWideIntObj(total));
	if (errObj) {
	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
	}
	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
	if (code != TCL_OK) {
	    Tcl_BackgroundException(interp, code);
	    TclBackgroundException(interp, code);
	    result = TCL_ERROR;
	}
	TclDecrRefCount(cmdPtr);
	Tcl_Release(interp);
    } else {
	StopCopy(csPtr);
	if (interp) {
9770
9771
9772
9773
9774
9775
9776
9777
9778
9779




9780
9781
9782
9783
9784
9785
9786
9032
9033
9034
9035
9036
9037
9038



9039
9040
9041
9042
9043
9044
9045
9046
9047
9048
9049







-
-
-
+
+
+
+








/*
 *----------------------------------------------------------------------
 *
 * DoRead --
 *
 *	Stores up to "bytesToRead" bytes in memory pointed to by "dst".
 *	These bytes come from reading the channel "chanPtr" and
 *	performing the configured translations.  No encoding conversions
 *	are applied to the bytes being read.
 *	These bytes come from reading the channel "chanPtr" and 
 *	performing the configured translations.
 *
 *	No encoding conversions are applied to the bytes being read.
 *
 * Results:
 *	The number of bytes actually stored (<= bytesToRead),
 * 	or -1 if there is an error in reading the channel.  Use
 * 	Tcl_GetErrno() to retrieve the error code for the error
 *	that occurred.
 *
9796
9797
9798
9799
9800
9801
9802
9803
9804


9805
9806
9807
9808


9809
9810
9811
9812
9813
9814
9815
9816
9817
9818
9819
9820
9821
9822
9823
9824
9825


9826
9827
9828
9829
9830
9831
9832
9833

9834
9835
9836
9837
9838
9839
9840
9841
9842
9843
9844
9845
9846
9847
9848
9849
9850
9851


9852
9853
9854
9855
9856
9857
9858

9859
9860
9861
9862
9863
9864
9865



9866
9867
9868
9869
9870
9871
9872

9873
9874
9875
9876

9877
9878
9879
9880
9881
9882
9883
9884

9885
9886
9887
9888
9889
9890
9891
9892

9893
9894
9895

9896
9897
9898
9899
9900
9901
9902
9903
9904
9905
9906
9907
9908
9909
9910
9911


9912
9913
9914
9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928


9929
9930
9931
9932
9933
9934
9935
9936
9937

9938
9939
9940

9941
9942

9943
9944
9945
9946
9947
9948

9949
9950

9951
9952
9953
9954
9955
9956
9957

9958
9959
9960
9961
9962
9963
9964
9965
9966

9967
9968
9969
9970
9971
9972
9973
9974
9975
9976
9977
9978
9979
9980
9981
9982
9983
9984
9985
9986
9987


9988
9989
9990
9991
9992
9993


9994
9995
9996
9997
9998
9999
10000
10001
10002
10003
10004
10005
10006
10007
10008
10009





10010
10011
10012
10013
10014
10015
10016
9059
9060
9061
9062
9063
9064
9065


9066
9067

9068
9069
9070
9071
9072
9073
9074
9075
9076
9077
9078
9079
9080
9081
9082
9083
9084
9085
9086
9087


9088
9089
9090
9091
9092
9093
9094
9095


9096


9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
9107
9108
9109
9110


9111
9112
9113
9114
9115
9116
9117
9118

9119
9120
9121
9122
9123



9124
9125
9126
9127
9128
9129
9130
9131
9132

9133
9134
9135


9136


9137
9138
9139
9140


9141


9142
9143
9144
9145
9146

9147
9148
9149

9150
9151
9152
9153
9154
9155
9156
9157
9158
9159
9160
9161
9162
9163
9164


9165
9166
9167
9168
9169
9170
9171
9172
9173
9174
9175
9176
9177
9178
9179
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
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







-
-
+
+
-



+
+















-
-
+
+






-
-
+
-
-














-
-
+
+






-
+




-
-
-
+
+
+






-
+


-
-
+
-
-




-
-
+
-
-





-
+


-
+














-
-
+
+















-
-
+
+







-
-
+
-

-
+
-
-
+
-




-
+
-
-
+
-
-



-
-
+
-
-





-
-
+
-


















-
-
+
+




-
-
+
+











-
-
-
-
-
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
DoRead(
    Channel *chanPtr,		/* The channel from which to read. */
    char *dst,			/* Where to store input read. */
    size_t bytesToRead,		/* Maximum number of bytes to read. */
    char *dst,		/* Where to store input read. */
    int bytesToRead)		/* Maximum number of bytes to read. */
    int allowShortReads)	/* Allow half-blocking (pipes,sockets) */
{
    ChannelState *statePtr = chanPtr->state;
    char *p = dst;

    assert (bytesToRead >= 0);

    /*
     * Early out when we know a read will get the eofchar.
     *
     * NOTE: This seems to be a bug.  The special handling for
     * a zero-char read request ought to come first.  As coded
     * the EOF due to eofchar has distinguishing behavior from
     * the EOF due to reported EOF on the underlying device, and
     * that seems undesirable.  However recent history indicates
     * that new inconsistent behavior in a patchlevel has problems
     * too.  Keep on keeping on for now.
     */

    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
	SetFlag(statePtr, CHANNEL_EOF);
	assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
	assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
	assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
	assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );

	/* TODO: Don't need this call */
	UpdateInterest(chanPtr);
	return 0;
    }

    /*
     * Special handling for zero-char read request.
    /* Special handling for zero-char read request. */
     */

    if (bytesToRead == 0) {
	if (GotFlag(statePtr, CHANNEL_EOF)) {
	    statePtr->inputEncodingFlags |= TCL_ENCODING_START;
	}
	ResetFlag(statePtr, CHANNEL_BLOCKED|CHANNEL_EOF);
	statePtr->inputEncodingFlags &= ~TCL_ENCODING_END;
	/* TODO: Don't need this call */
	UpdateInterest(chanPtr);
	return 0;
    }

    TclChannelPreserve((Tcl_Channel)chanPtr);
    while (bytesToRead) {
	/*
	 * Each pass through the loop is intended to process up to one channel
	 * buffer.
	 * Each pass through the loop is intended to process up to 
	 * one channel buffer.
	 */

	int bytesRead, bytesWritten;
	ChannelBuffer *bufPtr = statePtr->inQueueHead;

	/*
	 * Don't read more data if we have what we need.
	 * Don't read more data if we have what we need. 
	 */

	while (!bufPtr ||			/* We got no buffer!   OR */
		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
		((size_t)BytesLeft(bufPtr) < bytesToRead))) {
						/* Not enough bytes in it yet
						 * to fill the dst */
		(BytesLeft(bufPtr) < bytesToRead) ) ) {
						/* Not enough bytes in it 
						 * yet to fill the dst */
	    int code;

	moreData:
	    code = GetInput(chanPtr);
	    bufPtr = statePtr->inQueueHead;

	    assert(bufPtr != NULL);
	    assert (bufPtr != NULL);

	    if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
		/*
		 * Further reads cannot do any more.
		/* Further reads cannot do any more */
		 */

		break;
	    }

	    if (code) {
		/*
	     * Read error
		/* Read error */
	     */

		UpdateInterest(chanPtr);
		TclChannelRelease((Tcl_Channel)chanPtr);
		return -1;
	    }

	    assert(IsBufferFull(bufPtr));
	    assert (IsBufferFull(bufPtr));
	}

	assert(bufPtr != NULL);
	assert (bufPtr != NULL);

	bytesRead = BytesLeft(bufPtr);
	bytesWritten = bytesToRead;

	TranslateInputEOL(statePtr, p, RemovePoint(bufPtr),
		&bytesWritten, &bytesRead);
	bufPtr->nextRemoved += bytesRead;
	p += bytesWritten;
	bytesToRead -= bytesWritten;

	if (!IsBufferEmpty(bufPtr)) {
	    /*
	     * Buffer is not empty.  How can that be?
	     *
	     * 0) We stopped early because we got all the bytes we were
	     *    seeking. That's fine.
	     * 0) We stopped early because we got all the bytes
	     *    we were seeking.  That's fine.
	     */

	    if (bytesToRead == 0) {
		break;
	    }

	    /*
	     * 1) We're @EOF because we saw eof char.
	     */

	    if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
		break;
	    }

	    /*
	     * 2) The buffer holds a \r while in CRLF translation, followed by
	     *    the end of the buffer.
	     * 2) The buffer holds a \r while in CRLF translation,
	     *    followed by the end of the buffer.
	     */

	    assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
	    assert(RemovePoint(bufPtr)[0] == '\r');
	    assert(BytesLeft(bufPtr) == 1);

	    if (bufPtr->nextPtr == NULL) {
		/*
		 * There's no more buffered data...
		/* There's no more buffered data.... */
		 */

		if (statePtr->flags & CHANNEL_EOF) {
		if (GotFlag(statePtr, CHANNEL_EOF)) {
		    /*
		     * ...and there never will be.
		    /* ...and there never will be. */
		     */

		    *p++ = '\r';
		    bytesToRead--;
		    bufPtr->nextRemoved++;
		} else if (statePtr->flags & CHANNEL_BLOCKED) {
		} else if (GotFlag(statePtr, CHANNEL_BLOCKED)) {
		    /*
		     * ...and we cannot get more now.
		    /* ...and we cannot get more now. */
		     */

		    SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
		    break;
		} else {
		    /*
		     * ...so we need to get some.
		    /* ... so we need to get some. */
		     */

		    goto moreData;
		}
	    }

	    if (bufPtr->nextPtr) {
		/*
		 * There's a next buffer.  Shift orphan \r to it.
		/* There's a next buffer.  Shift orphan \r to it. */
		 */

		ChannelBuffer *nextPtr = bufPtr->nextPtr;

		nextPtr->nextRemoved -= 1;
		RemovePoint(nextPtr)[0] = '\r';
		bufPtr->nextRemoved++;
	    }
	}

	if (IsBufferEmpty(bufPtr)) {
	    statePtr->inQueueHead = bufPtr->nextPtr;
	    if (statePtr->inQueueHead == NULL) {
		statePtr->inQueueTail = NULL;
	    }
	    RecycleBuffer(statePtr, bufPtr, 0);
	    bufPtr = statePtr->inQueueHead;
	}

	if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
		&& GotFlag(statePtr, CHANNEL_BLOCKED)) {
	if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)
		== (CHANNEL_NONBLOCKING|CHANNEL_BLOCKED)) {
	    break;
	}

	/*
	 * When there's no buffered data to read, and we're at EOF, escape to
	 * the caller.
	 * When there's no buffered data to read, and we're at EOF,
	 * escape to the caller.
	 */

	if (GotFlag(statePtr, CHANNEL_EOF)
		&& (bufPtr == NULL || IsBufferEmpty(bufPtr))) {
	    break;
	}
    }
    if (bytesToRead == 0) {
	ResetFlag(statePtr, CHANNEL_BLOCKED);
    }

    assert(!GotFlag(statePtr, CHANNEL_EOF)
	    || GotFlag(statePtr, CHANNEL_STICKY_EOF)
	    || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
    assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
	    == (CHANNEL_EOF|CHANNEL_BLOCKED)));
	assert(!GotFlag(statePtr, CHANNEL_EOF)
		|| GotFlag(statePtr, CHANNEL_STICKY_EOF)
		|| Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
	assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
		== (CHANNEL_EOF|CHANNEL_BLOCKED)) );
    UpdateInterest(chanPtr);
    TclChannelRelease((Tcl_Channel)chanPtr);
    return (int)(p - dst);
}

/*
 *----------------------------------------------------------------------
10031
10032
10033
10034
10035
10036
10037
10038

10039
10040
10041
10042
10043
10044
10045
9274
9275
9276
9277
9278
9279
9280

9281
9282
9283
9284
9285
9286
9287
9288







-
+







 */

static void
CopyEventProc(
    ClientData clientData,
    int mask)
{
    (void) CopyData((CopyState *)clientData, mask);
    (void) CopyData((CopyState *) clientData, mask);
}

/*
 *----------------------------------------------------------------------
 *
 * StopCopy --
 *
10056
10057
10058
10059
10060
10061
10062
10063
10064
10065
10066
10067
10068
10069
10070
10071
10072
10073
10074
10075
10076
10077
10078
10079
10080

10081
10082
10083
10084
10085
10086

10087
10088
10089
10090
10091
10092

10093
10094
10095
10096
10097
10098
10099





10100
10101
10102
10103
10104
10105
10106
10107

10108
10109
10110
10111
10112
10113
10114
9299
9300
9301
9302
9303
9304
9305


9306
9307
9308
9309
9310
9311


9312
9313
9314
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
9351
9352
9353







-
-






-
-







-
+





-
+





-
+




-
-
-
+
+
+
+
+

-
-




-
+







 */

static void
StopCopy(
    CopyState *csPtr)		/* State for bg copy to stop . */
{
    ChannelState *inStatePtr, *outStatePtr;
    Tcl_Channel inChan, outChan;

    int nonBlocking;

    if (!csPtr) {
	return;
    }

    inChan = (Tcl_Channel) csPtr->readPtr;
    outChan = (Tcl_Channel) csPtr->writePtr;
    inStatePtr = csPtr->readPtr->state;
    outStatePtr = csPtr->writePtr->state;

    /*
     * Restore the old blocking mode and output buffering mode.
     */

    nonBlocking = csPtr->readFlags & CHANNEL_NONBLOCKING;
    nonBlocking = (csPtr->readFlags & CHANNEL_NONBLOCKING);
    if (nonBlocking != (inStatePtr->flags & CHANNEL_NONBLOCKING)) {
	SetBlockMode(NULL, csPtr->readPtr,
		nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
    }
    if (csPtr->readPtr != csPtr->writePtr) {
	nonBlocking = csPtr->writeFlags & CHANNEL_NONBLOCKING;
	nonBlocking = (csPtr->writeFlags & CHANNEL_NONBLOCKING);
	if (nonBlocking != (outStatePtr->flags & CHANNEL_NONBLOCKING)) {
	    SetBlockMode(NULL, csPtr->writePtr,
		    nonBlocking ? TCL_MODE_NONBLOCKING : TCL_MODE_BLOCKING);
	}
    }
    ResetFlag(outStatePtr, CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
    outStatePtr->flags &= ~(CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);
    outStatePtr->flags |=
	    csPtr->writeFlags & (CHANNEL_LINEBUFFERED | CHANNEL_UNBUFFERED);

    if (csPtr->cmdPtr) {
	Tcl_DeleteChannelHandler(inChan, CopyEventProc, csPtr);
	if (inChan != outChan) {
	    Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr);
	Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->readPtr, CopyEventProc,
		csPtr);
	if (csPtr->readPtr != csPtr->writePtr) {
	    Tcl_DeleteChannelHandler((Tcl_Channel) csPtr->writePtr,
		    CopyEventProc, csPtr);
	}
	Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr);
	Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr);
	TclDecrRefCount(csPtr->cmdPtr);
    }
    inStatePtr->csPtrR = NULL;
    outStatePtr->csPtrW = NULL;
    Tcl_Free(csPtr);
    ckfree((char *) csPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * StackSetBlockMode --
 *
10141
10142
10143
10144
10145
10146
10147
10148

10149
10150
10151
10152
10153
10154
10155
9380
9381
9382
9383
9384
9385
9386

9387
9388
9389
9390
9391
9392
9393
9394







-
+







     * disturb the stacking state of the channel.
     */

    chanPtr = statePtr->topChanPtr;
    while (chanPtr != NULL) {
	blockModeProc = Tcl_ChannelBlockModeProc(chanPtr->typePtr);
	if (blockModeProc != NULL) {
	    result = blockModeProc(chanPtr->instanceData, mode);
	    result = (*blockModeProc) (chanPtr->instanceData, mode);
	    if (result != 0) {
		Tcl_SetErrno(result);
		return result;
	    }
	}
	chanPtr = chanPtr->downChanPtr;
    }
10196
10197
10198
10199
10200
10201
10202
10203
10204
10205


10206
10207
10208
10209
10210
10211
10212
9435
9436
9437
9438
9439
9440
9441



9442
9443
9444
9445
9446
9447
9448
9449
9450







-
-
-
+
+







	     *
	     * Note that we cannot have a message in the interpreter bypass
	     * area, StackSetBlockMode is restricted to the channel bypass.
	     * We still need the interp as the destination of the move.
	     */

	    if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "error setting blocking mode: %s",
			Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "error setting blocking mode: ",
			Tcl_PosixError(interp), NULL);
	    }
	} else {
	    /*
	     * TIP #219.
	     * If we have no interpreter to put a bypass message into we have
	     * to clear it, to prevent its propagation and use in other places
	     * unrelated to the actual occurence of the problem.
10295
10296
10297
10298
10299
10300
10301
10302
10303
10304
10305
10306

10307
10308
10309
10310
10311
10312
10313
9533
9534
9535
9536
9537
9538
9539

9540
9541

9542
9543
9544
9545
9546
9547
9548
9549
9550







-


-

+







	if ((Tcl_FindHashEntry(hTblPtr, pattern) != NULL)
		&& (Tcl_ListObjAppendElement(interp, resultPtr,
		Tcl_NewStringObj(pattern, -1)) != TCL_OK)) {
	    goto error;
	}
	goto done;
    }

    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;

	statePtr = ((Channel *) Tcl_GetHashValue(hPtr))->state;
	if (statePtr->topChanPtr == (Channel *) tsdPtr->stdinChannel) {
	    name = "stdin";
	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stdoutChannel) {
	    name = "stdout";
	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
	    name = "stderr";
	} else {
10364
10365
10366
10367
10368
10369
10370
10371

10372
10373
10374
10375
10376
10377
10378
9601
9602
9603
9604
9605
9606
9607

9608
9609
9610
9611
9612
9613
9614
9615







-
+







     * Always check bottom-most channel in the stack. This is the one that
     * gets registered.
     */

    chanPtr = ((Channel *) chan)->state->bottomChanPtr;
    statePtr = chanPtr->state;

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclIO", NULL);
    hTblPtr = Tcl_GetAssocData(interp, "tclIO", NULL);
    if (hTblPtr == NULL) {
	return 0;
    }
    hPtr = Tcl_FindHashEntry(hTblPtr, statePtr->channelName);
    if (hPtr == NULL) {
	return 0;
    }
10402
10403
10404
10405
10406
10407
10408
10409

10410
10411
10412
10413
10414
10415
10416
9639
9640
9641
9642
9643
9644
9645

9646
9647
9648
9649
9650
9651
9652
9653







-
+







int
Tcl_IsChannelShared(
    Tcl_Channel chan)		/* The channel to query */
{
    ChannelState *statePtr = ((Channel *) chan)->state;
				/* State of real channel structure. */

    return ((statePtr->refCount + 1 > 2) ? 1 : 0);
    return ((statePtr->refCount > 1) ? 1 : 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsChannelExisting --
 *
10445
10446
10447
10448
10449
10450
10451



10452
10453

10454
10455
10456
10457
10458
10459
10460
9682
9683
9684
9685
9686
9687
9688
9689
9690
9691
9692

9693
9694
9695
9696
9697
9698
9699
9700







+
+
+

-
+







	    name = "stdout";
	} else if (statePtr->topChanPtr == (Channel *) tsdPtr->stderrChannel) {
	    name = "stderr";
	} else {
	    name = statePtr->channelName;
	}

	/* Bug 2333466. Include \0 in the compare to prevent partial matching
	 * on prefixes.
	 */
	if ((*chanName == *name) &&
		(memcmp(name, chanName, chanNameLen + 1) == 0)) {
		(memcmp(name, chanName, (size_t) chanNameLen+1) == 0)) {
	    return 1;
	}
    }

    return 0;
}

10498
10499
10500
10501
10502
10503
10504
10505











































10506
10507
10508
10509
10510
10511
10512
9738
9739
9740
9741
9742
9743
9744

9745
9746
9747
9748
9749
9750
9751
9752
9753
9754
9755
9756
9757
9758
9759
9760
9761
9762
9763
9764
9765
9766
9767
9768
9769
9770
9771
9772
9773
9774
9775
9776
9777
9778
9779
9780
9781
9782
9783
9784
9785
9786
9787
9788
9789
9790
9791
9792
9793
9794







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 */

Tcl_ChannelTypeVersion
Tcl_ChannelVersion(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    return chanTypePtr->version;
    if (chanTypePtr->version == TCL_CHANNEL_VERSION_2) {
	return TCL_CHANNEL_VERSION_2;
    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_3) {
	return TCL_CHANNEL_VERSION_3;
    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_4) {
	return TCL_CHANNEL_VERSION_4;
    } else if (chanTypePtr->version == TCL_CHANNEL_VERSION_5) {
	return TCL_CHANNEL_VERSION_5;
    } else {
	/*
	 * In <v2 channel versions, the version field is occupied by the
	 * Tcl_DriverBlockModeProc
	 */

	return TCL_CHANNEL_VERSION_1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * HaveVersion --
 *
 *	Return whether a channel type is (at least) of a given version.
 *
 * Results:
 *	True if the minimum version is exceeded by the version actually
 *	present.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
HaveVersion(
    const Tcl_ChannelType *chanTypePtr,
    Tcl_ChannelTypeVersion minimumVersion)
{
    Tcl_ChannelTypeVersion actualVersion = Tcl_ChannelVersion(chanTypePtr);

    return (PTR2INT(actualVersion)) >= (PTR2INT(minimumVersion));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelBlockModeProc --
 *
10521
10522
10523
10524
10525
10526
10527

10528
































10529
10530
10531
10532
10533
10534
10535
9803
9804
9805
9806
9807
9808
9809
9810

9811
9812
9813
9814
9815
9816
9817
9818
9819
9820
9821
9822
9823
9824
9825
9826
9827
9828
9829
9830
9831
9832
9833
9834
9835
9836
9837
9838
9839
9840
9841
9842
9843
9844
9845
9846
9847
9848
9849







+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *---------------------------------------------------------------------- */

Tcl_DriverBlockModeProc *
Tcl_ChannelBlockModeProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
    return chanTypePtr->blockModeProc;
	return chanTypePtr->blockModeProc;
    } else {
	/*
	 * The v1 structure had the blockModeProc in a different place.
	 */

	return (Tcl_DriverBlockModeProc *) (chanTypePtr->version);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelCloseProc --
 *
 *	Return the Tcl_DriverCloseProc of the channel type.
 *
 * Results:
 *	A pointer to the proc.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_DriverCloseProc *
Tcl_ChannelCloseProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    return chanTypePtr->closeProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelClose2Proc --
 *
10595
10596
10597
10598
10599
10600
10601
























10602
10603
10604
10605
10606
10607
10608
9909
9910
9911
9912
9913
9914
9915
9916
9917
9918
9919
9920
9921
9922
9923
9924
9925
9926
9927
9928
9929
9930
9931
9932
9933
9934
9935
9936
9937
9938
9939
9940
9941
9942
9943
9944
9945
9946







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







Tcl_DriverOutputProc *
Tcl_ChannelOutputProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    return chanTypePtr->outputProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelSeekProc --
 *
 *	Return the Tcl_DriverSeekProc of the channel type.
 *
 * Results:
 *	A pointer to the proc.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_DriverSeekProc *
Tcl_ChannelSeekProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    return chanTypePtr->seekProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelSetOptionProc --
 *
 *	Return the Tcl_DriverSetOptionProc of the channel type.
10713
10714
10715
10716
10717
10718
10719

10720




10721
10722
10723
10724
10725
10726
10727
10051
10052
10053
10054
10055
10056
10057
10058

10059
10060
10061
10062
10063
10064
10065
10066
10067
10068
10069







+
-
+
+
+
+







 */

Tcl_DriverFlushProc *
Tcl_ChannelFlushProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
    return chanTypePtr->flushProc;
	return chanTypePtr->flushProc;
    } else {
	return NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelHandlerProc --
 *
10737
10738
10739
10740
10741
10742
10743

10744




10745
10746
10747
10748
10749
10750
10751
10079
10080
10081
10082
10083
10084
10085
10086

10087
10088
10089
10090
10091
10092
10093
10094
10095
10096
10097







+
-
+
+
+
+







 */

Tcl_DriverHandlerProc *
Tcl_ChannelHandlerProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_2)) {
    return chanTypePtr->handlerProc;
	return chanTypePtr->handlerProc;
    } else {
	return NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelWideSeekProc --
 *
10761
10762
10763
10764
10765
10766
10767

10768




10769
10770
10771
10772
10773
10774
10775
10107
10108
10109
10110
10111
10112
10113
10114

10115
10116
10117
10118
10119
10120
10121
10122
10123
10124
10125







+
-
+
+
+
+







 */

Tcl_DriverWideSeekProc *
Tcl_ChannelWideSeekProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_3)) {
    return chanTypePtr->wideSeekProc;
	return chanTypePtr->wideSeekProc;
    } else {
	return NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ChannelThreadActionProc --
 *
10786
10787
10788
10789
10790
10791
10792

10793




10794
10795
10796
10797
10798
10799
10800
10136
10137
10138
10139
10140
10141
10142
10143

10144
10145
10146
10147
10148
10149
10150
10151
10152
10153
10154







+
-
+
+
+
+







 */

Tcl_DriverThreadActionProc *
Tcl_ChannelThreadActionProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_4)) {
    return chanTypePtr->threadActionProc;
	return chanTypePtr->threadActionProc;
    } else {
	return NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetChannelErrorInterp --
 *
10903
10904
10905
10906
10907
10908
10909
10910

10911
10912
10913
10914
10915
10916
10917
10257
10258
10259
10260
10261
10262
10263

10264
10265
10266
10267
10268
10269
10270
10271







-
+







     * Bad message syntax causes a panic, because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshall the
     * information. Hence an error means that we've got serious breakage.
     */

    res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv);
    if (res != TCL_OK) {
	Tcl_Panic("Tcl_SetChannelError: bad syntax of message");
	Tcl_Panic("Tcl_SetChannelError(Interp): Bad syntax of message");
    }

    explicitResult = (1 == (lc % 2));
    numOptions = lc - explicitResult;

    /*
     * No options, nothing to do.
10963
10964
10965
10966
10967
10968
10969
10970

10971
10972
10973
10974
10975
10976
10977
10978
10979
10980
10981
10982
10983
10984

10985
10986
10987
10988
10989
10990
10991
10992
10993
10994

10995
10996
10997
10998
10999
11000
11001
10317
10318
10319
10320
10321
10322
10323

10324
10325
10326
10327
10328
10329
10330
10331
10332
10333
10334
10335
10336
10337

10338
10339
10340
10341
10342
10343
10344
10345
10346
10347

10348
10349
10350
10351
10352
10353
10354
10355







-
+













-
+









-
+







    if (newlevel >= 0) {
	lcn += 2;
    }
    if (newcode >= 0) {
	lcn += 2;
    }

    lvn = (Tcl_Obj **)Tcl_Alloc(lcn * sizeof(Tcl_Obj *));
    lvn = (Tcl_Obj **) ckalloc(lcn * sizeof(Tcl_Obj *));

    /*
     * New level/code information is spliced into the first occurence of
     * -level, -code, further occurences are ignored. The options cannot be
     * not present, we would not come here. Options which are ok are simply
     * copied over.
     */

    lignore = cignore = 0;
    for (i=0, j=0; i<numOptions; i+=2) {
	if (0 == strcmp(TclGetString(lv[i]), "-level")) {
	    if (newlevel >= 0) {
		lvn[j++] = lv[i];
		lvn[j++] = Tcl_NewWideIntObj(newlevel);
		lvn[j++] = Tcl_NewIntObj(newlevel);
		newlevel = -1;
		lignore = 1;
		continue;
	    } else if (lignore) {
		continue;
	    }
	} else if (0 == strcmp(TclGetString(lv[i]), "-code")) {
	    if (newcode >= 0) {
		lvn[j++] = lv[i];
		lvn[j++] = Tcl_NewWideIntObj(newcode);
		lvn[j++] = Tcl_NewIntObj(newcode);
		newcode = -1;
		cignore = 1;
		continue;
	    } else if (cignore) {
		continue;
	    }
	}
11016
11017
11018
11019
11020
11021
11022
11023

11024
11025
11026
11027
11028
11029
11030
10370
10371
10372
10373
10374
10375
10376

10377
10378
10379
10380
10381
10382
10383
10384







-
+








    if (explicitResult) {
	lvn[j++] = lv[i];
    }

    msg = Tcl_NewListObj(j, lvn);

    Tcl_Free(lvn);
    ckfree((char *) lvn);
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChannelErrorInterp --
11098
11099
11100
11101
11102
11103
11104

11105




11106
11107
11108
11109
11110
11111
11112
10452
10453
10454
10455
10456
10457
10458
10459

10460
10461
10462
10463
10464
10465
10466
10467
10468
10469
10470







+
-
+
+
+
+







 */

Tcl_DriverTruncateProc *
Tcl_ChannelTruncateProc(
    const Tcl_ChannelType *chanTypePtr)
				/* Pointer to channel type. */
{
    if (HaveVersion(chanTypePtr, TCL_CHANNEL_VERSION_5)) {
    return chanTypePtr->truncateProc;
	return chanTypePtr->truncateProc;
    } else {
	return NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * DupChannelIntRep --
 *
11121
11122
11123
11124
11125
11126
11127
11128

11129
11130

11131
11132
11133


11134
11135
11136
11137



11138
11139
11140
11141
11142
11143
11144
10479
10480
10481
10482
10483
10484
10485

10486
10487

10488
10489
10490

10491
10492
10493



10494
10495
10496
10497
10498
10499
10500
10501
10502
10503







-
+

-
+


-
+
+

-
-
-
+
+
+







 *	representation.
 *
 *----------------------------------------------------------------------
 */

static void
DupChannelIntRep(
    Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
				 * an internal rep of type "Channel". */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    ResolvedChanName *resPtr;
    ResolvedChanName *resPtr
	    = (ResolvedChanName *) srcPtr->internalRep.twoPtrValue.ptr1;

    ChanGetIntRep(srcPtr, resPtr);
    assert(resPtr);
    ChanSetIntRep(copyPtr, resPtr);
    resPtr->refCount++;
    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
    copyPtr->typePtr = srcPtr->typePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeChannelIntRep --
 *
11153
11154
11155
11156
11157
11158
11159
11160


11161
11162

11163
11164

11165
11166
11167
11168


11169
11170
11171
11172
11173
11174
11175
11176
11177
11178
11179
11180
11181
11182
11183
11184
11185

11186
11187
11188
11189
11190
11191
11192
10512
10513
10514
10515
10516
10517
10518

10519
10520
10521

10522


10523
10524
10525


10526
10527
10528
10529
10530
10531
10532
10533
10534
10535
10536
10537
10538
10539
10540
10541
10542
10543

10544
10545
10546
10547
10548
10549
10550
10551







-
+
+

-
+
-
-
+


-
-
+
+
















-
+







 *----------------------------------------------------------------------
 */

static void
FreeChannelIntRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    ResolvedChanName *resPtr;
    ResolvedChanName *resPtr
	    = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;

    ChanGetIntRep(objPtr, resPtr);
    objPtr->typePtr = NULL;
    assert(resPtr);
    if (resPtr->refCount-- > 1) {
    if (--resPtr->refCount) {
	return;
    }
    Tcl_Release(resPtr->statePtr);
    Tcl_Free(resPtr);
    Tcl_Release((ClientData) resPtr->statePtr);
    ckfree((char *)resPtr);
}

#if 0
/*
 * For future debugging work, a simple function to print the flags of a
 * channel in semi-readable form.
 */

static int
DumpFlags(
    char *str,
    int flags)
{
    char buf[20];
    int i = 0;

#define ChanFlag(chr, bit)      (buf[i++] = ((flags & (bit)) ? (chr) : '_'))
#define ChanFlag(chr,bit) (buf[i++] = ((flags & (bit)) ? (chr) : '_'))

    ChanFlag('r', TCL_READABLE);
    ChanFlag('w', TCL_WRITABLE);
    ChanFlag('n', CHANNEL_NONBLOCKING);
    ChanFlag('l', CHANNEL_LINEBUFFERED);
    ChanFlag('u', CHANNEL_UNBUFFERED);
    ChanFlag('F', BG_FLUSH_SCHEDULED);

Changes to generic/tclIO.h.

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
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







-
+







-
-
+
+




-
+







/*
 * struct ChannelBuffer:
 *
 * Buffers data being sent to or from a channel.
 */

typedef struct ChannelBuffer {
    size_t refCount;		/* Current uses count */
    int refCount;		/* Current uses count */
    int nextAdded;		/* The next position into which a character
				 * will be put in the buffer. */
    int nextRemoved;		/* Position of next byte to be removed from
				 * the buffer. */
    int bufLength;		/* How big is the buffer? */
    struct ChannelBuffer *nextPtr;
    				/* Next buffer in chain. */
    char buf[TCLFLEXARRAY];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-1
    char buf[4];		/* Placeholder for real buffer. The real
				 * buffer occuppies this space + bufSize-4
				 * bytes. This must be the last field in the
				 * structure. */
} ChannelBuffer;

#define CHANNELBUFFER_HEADER_SIZE	offsetof(ChannelBuffer, buf)
#define CHANNELBUFFER_HEADER_SIZE	(sizeof(ChannelBuffer) - 4)

/*
 * How much extra space to allocate in buffer to hold bytes from previous
 * buffer (when converting to UTF-8) or to hold bytes that will go to next
 * buffer (when converting from UTF-8).
 */

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
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







-
+

-
+














-
+







 * data specific to the channel but which belongs to the generic part of the
 * Tcl channel mechanism, and it points at an instance specific (and type
 * specific) instance data, and at a channel type structure.
 */

typedef struct Channel {
    struct ChannelState *state; /* Split out state information */
    void *instanceData;	/* Instance-specific data provided by creator
    ClientData instanceData;	/* Instance-specific data provided by creator
				 * of channel. */
    const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
    Tcl_ChannelType *typePtr;	/* Pointer to channel type structure. */
    struct Channel *downChanPtr;/* Refers to channel this one was stacked
				 * upon. This reference is NULL for normal
				 * channels. See Tcl_StackChannel. */
    struct Channel *upChanPtr;	/* Refers to the channel above stacked this
				 * one. NULL for the top most channel. */

    /*
     * Intermediate buffers to hold pre-read data for consumption by a newly
     * stacked transformation. See 'Tcl_StackChannel'.
     */

    ChannelBuffer *inQueueHead;	/* Points at first buffer in input queue. */
    ChannelBuffer *inQueueTail;	/* Points at last buffer in input queue. */

    size_t refCount;
    int refCount;
} Channel;

/*
 * struct ChannelState:
 *
 * One of these structures is allocated for each open channel. It contains
 * data specific to the channel but which belongs to the generic part of the
159
160
161
162
163
164
165
166

167
168
169
170
171
172
173
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173







-
+







    int inEofChar;		/* If nonzero, use this as a signal of EOF on
				 * input. */
    int outEofChar;		/* If nonzero, append this to the channel when
				 * it is closed if it is open for writing. */
    int unreportedError;	/* Non-zero if an error report was deferred
				 * because it happened in the background. The
				 * value is the POSIX error code. */
    size_t refCount;		/* How many interpreters hold references to
    int refCount;		/* How many interpreters hold references to
				 * this IO channel? */
    struct CloseCallback *closeCbPtr;
				/* Callbacks registered to be called when the
				 * channel is closed. */
    char *outputStage;		/* Temporary staging buffer used when
				 * translating EOL before converting from
				 * UTF-8 to external form. */
210
211
212
213
214
215
216
217

218
219
220
221
222
223
224
210
211
212
213
214
215
216

217
218
219
220
221
222
223
224







-
+







     */

    Tcl_Obj* chanMsg;
    Tcl_Obj* unreportedMsg;     /* Non-NULL if an error report was deferred
				 * because it happened in the background. The
				 * value is the chanMg, if any. #219's
				 * companion to 'unreportedError'. */
    size_t epoch;		/* Used to test validity of stored channelname
    int epoch;			/* Used to test validity of stored channelname
				 * lookup results. */
} ChannelState;

/*
 * Values for the flags field in Channel. Any ORed combination of the
 * following flags can be stored in the field. These flags record various
 * options and state bits about the channel. In addition to the flags below,
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
273
274
275
276
277
278
279










280
281
282
283
284
285
286
287







-
-
-
-
-
-
-
-
-
-








					 * being used. */

#define CHANNEL_INCLOSE		(1<<19)	/* Channel is currently being closed.
					 * Its structures are still live and
					 * usable, but it may not be closed
					 * again from within the close
					 * handler. */
#define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
					 * No further Tcl-level write IO on
					 * the channel is allowed. */

/*
 * The length of time to wait between synthetic timer events. Must be zero or
 * bad things tend to happen.
 */

#define SYNTHETIC_EVENT_TIME	0

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclIOCmd.c.

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
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







-
-
-
+
+
+







-
+










-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+








#include "tclInt.h"

/*
 * Callback structure for accept callback in a TCP server.
 */

typedef struct {
    Tcl_Obj *script;		/* Script to invoke. */
    Tcl_Interp *interp;		/* Interpreter in which to run it. */
typedef struct AcceptCallback {
    char *script;			/* Script to invoke. */
    Tcl_Interp *interp;			/* Interpreter in which to run it. */
} AcceptCallback;

/*
 * Thread local storage used to maintain a per-thread stdout channel obj.
 * It must be per-thread because of std channel limitations.
 */

typedef struct {
typedef struct ThreadSpecificData {
    int initialized;		/* Set to 1 when the module is initialized. */
    Tcl_Obj *stdoutObjPtr;	/* Cached stdout channel Tcl_Obj */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Static functions for this file:
 */

static Tcl_ExitProc		FinalizeIOCmdTSD;
static Tcl_TcpAcceptProc 	AcceptCallbackProc;
static Tcl_ObjCmdProc		ChanPendingObjCmd;
static Tcl_ObjCmdProc		ChanTruncateObjCmd;
static void		FinalizeIOCmdTSD(ClientData clientData);
static void		AcceptCallbackProc(ClientData callbackData,
			    Tcl_Channel chan, char *address, int port);
static int		ChanPendingObjCmd(ClientData unused,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ChanTruncateObjCmd(ClientData dummy,
static void			RegisterTcpServerInterpCleanup(
				    Tcl_Interp *interp,
				    AcceptCallback *acceptCallbackPtr);
static Tcl_InterpDeleteProc	TcpAcceptCallbacksDeleteProc;
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		RegisterTcpServerInterpCleanup(Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);
static void		TcpAcceptCallbacksDeleteProc(ClientData clientData,
			    Tcl_Interp *interp);
static void		TcpServerCloseProc(ClientData callbackData);
static void		UnregisterTcpServerInterpCleanupProc(
			    Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);

/*
 *----------------------------------------------------------------------
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FinalizeIOCmdTSD(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Not used. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->stdoutObjPtr != NULL) {
	Tcl_DecrRefCount(tsdPtr->stdoutObjPtr);
	tsdPtr->stdoutObjPtr = NULL;
    }
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
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







+


-
+










+


-
+




-
+









-
+
-





+
+
+
+
+
+
+
-
+
+
+
+
+

-
-
+
+





-
+












-
-
-
+
+
+
-





-
+




-
+















-
-
+
+
+







 *
 * Side effects:
 *	Produces output on a channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_PutsObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to puts on. */
    Tcl_Obj *string;		/* String to write. */
    Tcl_Obj *chanObjPtr = NULL;	/* channel object. */
    int newline;		/* Add a newline at end? */
    int result;			/* Result of puts operation. */
    int mode;			/* Mode in which channel is opened. */
    ThreadSpecificData *tsdPtr;

    switch (objc) {
    case 2:			/* [puts $x] */
    case 2: /* [puts $x] */
	string = objv[1];
	newline = 1;
	break;

    case 3:			/* [puts -nonewline $x] or [puts $chan $x] */
    case 3: /* [puts -nonewline $x] or [puts $chan $x] */
	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	    newline = 0;
	} else {
	    newline = 1;
	    chanObjPtr = objv[1];
	}
	string = objv[2];
	break;

    case 4:			/* [puts -nonewline $chan $x] or
    case 4: /* [puts -nonewline $chan $x] or [puts $chan $x nonewline] */
				 * [puts $chan $x nonewline] */
	newline = 0;
	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	    chanObjPtr = objv[2];
	    string = objv[3];
	    break;
	} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */
	}

	    chanObjPtr = objv[1];
	    string = objv[2];
	    break;
	}
	/* Fall through */
    default:			/* [puts] or
				 * [puts some bad number of arguments...] */
    default:
	/* [puts] or [puts some bad number of arguments...] */
	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? ?channelId? string");
	return TCL_ERROR;
    }

    if (chanObjPtr == NULL) {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr = TCL_TSD_INIT(&dataKey);

	if (!tsdPtr->initialized) {
	    tsdPtr->initialized = 1;
	    TclNewLiteralStringObj(tsdPtr->stdoutObjPtr, "stdout");
	    Tcl_IncrRefCount(tsdPtr->stdoutObjPtr);
	    Tcl_CreateThreadExitHandler(FinalizeIOCmdTSD, NULL);
	}
	chanObjPtr = tsdPtr->stdoutObjPtr;
    }
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for writing",
    if ((mode & TCL_WRITABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
		"\" wasn't opened for writing", NULL);
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    result = Tcl_WriteObj(chan, string);
    if (result == -1) {
    if (result < 0) {
	goto error;
    }
    if (newline != 0) {
	result = Tcl_WriteChars(chan, "\n", 1);
	if (result == -1) {
	if (result < 0) {
	    goto error;
	}
    }
    TclChannelRelease(chan);
    return TCL_OK;

    /*
     * TIP #219.
     * Capture error messages put by the driver into the bypass area and put
     * them into the regular interpreter result. Fall back to the regular
     * message if nothing was found in the bypass.
     */

  error:
    if (!TclChanCaughtErrorBypass(interp, chan)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("error writing \"%s\": %s",
		TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "error writing \"",
		TclGetString(chanObjPtr), "\": ",
		Tcl_PosixError(interp), NULL);
    }
    TclChannelRelease(chan);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
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
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







+


-
+
















-
-
-
+
+
+
-













-
-
-
+
+
+







 *
 * Side effects:
 *	May cause output to appear on the specified channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FlushObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *chanObjPtr;
    Tcl_Channel chan;		/* The channel to flush on. */
    int mode;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for writing",
    if ((mode & TCL_WRITABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
		"\" wasn't opened for writing", NULL);
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    if (Tcl_Flush(chan) != TCL_OK) {
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error flushing \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "error flushing \"",
		    TclGetString(chanObjPtr), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	TclChannelRelease(chan);
	return TCL_ERROR;
    }
    TclChannelRelease(chan);
    return TCL_OK;
}
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
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







+


-
+


















-
-
-
+
+
+
-




-
+






-
-
-
-
+
+
+
+



-
-
-
+
+
+
+












-
+







 *
 * Side effects:
 *	May consume input from channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_GetsObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int lineLen;		/* Length of line just read. */
    int mode;			/* Mode in which channel is opened. */
    Tcl_Obj *linePtr, *chanObjPtr;
    int code = TCL_OK;

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?varName?");
	return TCL_ERROR;
    }
    chanObjPtr = objv[1];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for reading",
    if ((mode & TCL_READABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
		"\" wasn't opened for reading", NULL);
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }

    TclChannelPreserve(chan);
    TclNewObj(linePtr);
    linePtr = Tcl_NewObj();
    lineLen = Tcl_GetsObj(chan, linePtr);
    if (lineLen < 0) {
	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
	    Tcl_DecrRefCount(linePtr);

	    /*
	     * TIP #219.
	     * Capture error messages put by the driver into the bypass area
	     * and put them into the regular interpreter result. Fall back to
	     * the regular message if nothing was found in the bypass.
	     * TIP #219. Capture error messages put by the driver into the
	     * bypass area and put them into the regular interpreter result.
	     * Fall back to the regular message if nothing was found in the
	     * bypass.
	     */

	    if (!TclChanCaughtErrorBypass(interp, chan)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading \"%s\": %s",
			TclGetString(chanObjPtr), Tcl_PosixError(interp)));
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "error reading \"",
			TclGetString(chanObjPtr), "\": ",
			Tcl_PosixError(interp), NULL);
	    }
	    code = TCL_ERROR;
	    goto done;
	}
	lineLen = -1;
    }
    if (objc == 3) {
	if (Tcl_ObjSetVar2(interp, objv[2], NULL, linePtr,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(lineLen));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(lineLen));
    } else {
	Tcl_SetObjResult(interp, linePtr);
    }
  done:
    TclChannelRelease(chan);
    return code;
}
352
353
354
355
356
357
358

359
360
361

362
363
364
365
366
367
368
370
371
372
373
374
375
376
377
378
379

380
381
382
383
384
385
386
387







+


-
+







 *
 * Side effects:
 *	May consume input from channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ReadObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to read from. */
    int newline, i;		/* Discard newline at end? */
    int toRead;			/* How many bytes to read? */
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
450
451
452
453
454
455
456
457


458
459
460
461
462
463
464
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
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







+


















-
-
-
+
+
+
-


-
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+












-
-
-
+
+
+
+











-
-
+
+







	/*
	 * Do not append directly; that makes ensembles using this command as
	 * a subcommand produce the wrong message.
	 */

	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_WrongNumArgs(interp, 1, objv, "?-nonewline? channelId");
	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
	return TCL_ERROR;
    }

    i = 1;
    newline = 0;
    if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	newline = 1;
	i++;
    }

    if (i == objc) {
	goto argerror;
    }

    chanObjPtr = objv[i];
    if (TclGetChannelFromObj(interp, chanObjPtr, &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for reading",
    if ((mode & TCL_READABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(chanObjPtr),
		"\" wasn't opened for reading", NULL);
		TclGetString(chanObjPtr)));
	return TCL_ERROR;
    }
    i++;			/* Consumed channel name. */
    i++;	/* Consumed channel name. */

    /*
     * Compute how many bytes to read.
     */

    toRead = -1;
    if (i < objc) {
	if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
		|| (toRead < 0)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected non-negative integer but got \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
		return TCL_ERROR;
	if (TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) {
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */

	    if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
	    return TCL_ERROR;
	    }
	    newline = 1;
	} else if (toRead < 0) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "expected non-negative integer but got \"",
		    TclGetString(objv[i]), "\"", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
	    return TCL_ERROR;
	}
    }

    TclNewObj(resultPtr);
    resultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(resultPtr);
    TclChannelPreserve(chan);
    charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
    if (charactersRead < 0) {
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error reading \"%s\": %s",
		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "error reading \"",
		    TclGetString(chanObjPtr), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	TclChannelRelease(chan);
	Tcl_DecrRefCount(resultPtr);
	return TCL_ERROR;
    }

    /*
     * If requested, remove the last newline in the channel if at EOF.
     */

    if ((charactersRead > 0) && (newline != 0)) {
	const char *result;
	size_t length;
	char *result;
	int length;

	result = TclGetStringFromObj(resultPtr, &length);
	if (result[length - 1] == '\n') {
	    Tcl_SetObjLength(resultPtr, length - 1);
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
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
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







+


-
+









-
+


-
+







 * Side effects:
 *	Moves the position of the access point on the specified channel.  May
 *	flush queued output.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_SeekObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to tell on. */
    Tcl_WideInt offset;		/* Where to seek? */
    int mode;			/* How to seek? */
    Tcl_WideInt result;		/* Of calling Tcl_Seek. */
    int optionIndex;
    static const char *const originOptions[] = {
    static const char *originOptions[] = {
	"start", "current", "end", NULL
    };
    static const int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};
    static CONST int modeArray[] = {SEEK_SET, SEEK_CUR, SEEK_END};

    if ((objc != 3) && (objc != 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId offset ?origin?");
	return TCL_ERROR;
    }
    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;
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
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







-
+






-

-
-
-
+
+
+







	    return TCL_ERROR;
	}
	mode = modeArray[optionIndex];
    }

    TclChannelPreserve(chan);
    result = Tcl_Seek(chan, offset, mode);
    if (result == -1) {
    if (result == Tcl_LongAsWide(-1)) {
	/*
	 * TIP #219.
	 * Capture error messages put by the driver into the bypass area and
	 * put them into the regular interpreter result. Fall back to the
	 * regular message if nothing was found in the bypass.
	 */

	if (!TclChanCaughtErrorBypass(interp, chan)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error during seek on \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "error during seek on \"",
		    TclGetString(objv[1]), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	TclChannelRelease(chan);
	return TCL_ERROR;
    }
    TclChannelRelease(chan);
    return TCL_OK;
}
556
557
558
559
560
561
562

563
564
565

566
567
568
569
570
571
572
587
588
589
590
591
592
593
594
595
596

597
598
599
600
601
602
603
604







+


-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_TellObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to tell on. */
    Tcl_WideInt newLoc;
    int code;
618
619
620
621
622
623
624

625
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
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700


701
702
703
704
705
706
707
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
686
687
688


689
690
691
692
693
694
695
696
697







+


-
+





-
-
-
-

-
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
-
+
+







 *
 * Side effects:
 *	May discard queued input; may flush queued output.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_CloseObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;		/* The channel to close. */
    static const char *const dirOptions[] = {
	"read", "write", NULL
    };
    static const int dirArray[] = {TCL_CLOSE_READ, TCL_CLOSE_WRITE};

    if ((objc != 2) && (objc != 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?direction?");
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }

    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    if (objc == 3) {
	int index, dir;

	/*
	 * Get direction requested to close, and check syntax.
	 */

	if (Tcl_GetIndexFromObj(interp, objv[2], dirOptions, "direction", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	dir = dirArray[index];

	/*
	 * Check direction against channel mode. It is an error if we try to
	 * close a direction not supported by the channel (already closed, or
	 * never opened for that direction).
	 */

	if (!(dir & Tcl_GetChannelMode(chan))) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Half-close of %s-side not possible, side not opened"
		    " or already closed", dirOptions[index]));
	    return TCL_ERROR;
	}

	/*
	 * Special handling is needed if and only if the channel mode supports
	 * more than the direction to close. Because if the close the last
	 * direction supported we can and will go through the regular
	 * process.
	 */

	if ((Tcl_GetChannelMode(chan) &
		(TCL_CLOSE_READ|TCL_CLOSE_WRITE)) != dir) {
	    return Tcl_CloseEx(interp, chan, dir);
	}
    }

    if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
	/*
	 * If there is an error message and it ends with a newline, remove the
	 * newline. This is done for command pipeline channels where the error
	 * output from the subprocesses is stored in interp's result.
	 *
	 * NOTE: This is likely to not have any effect on regular error
	 * messages produced by drivers during the closing of a channel,
	 * because the Tcl convention is that such error messages do not have
	 * a terminating newline.
	 */

	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	const char *string;
	size_t len;
	char *string;
	int len;

	if (Tcl_IsShared(resultPtr)) {
	    resultPtr = Tcl_DuplicateObj(resultPtr);
	    Tcl_SetObjResult(interp, resultPtr);
	}
	string = TclGetStringFromObj(resultPtr, &len);
	if ((len > 0) && (string[len - 1] == '\n')) {
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
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







+


-
+




-
+




-
+
+







 *
 * Side effects:
 *	May modify the behavior of an IO channel.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FconfigureObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *optionName, *valueName;
    char *optionName, *valueName;
    Tcl_Channel chan;		/* The channel to set a mode on. */
    int i;			/* Iterate over arg-value pairs. */

    if ((objc < 2) || (((objc % 2) == 1) && (objc != 3))) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId ?-option value ...?");
	Tcl_WrongNumArgs(interp, 1, objv,
		"channelId ?optionName? ?value? ?optionName value?...");
	return TCL_ERROR;
    }

    if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
	return TCL_ERROR;
    }

801
802
803
804
805
806
807

808
809
810

811
812
813
814
815
816
817
793
794
795
796
797
798
799
800
801
802

803
804
805
806
807
808
809
810







+


-
+







 * Side effects:
 *	Sets interp's result to boolean true or false depending on whether the
 *	specified channel has an EOF condition.
 *
 *---------------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_EofObjCmd(
    TCL_UNUSED(ClientData),
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;

    if (objc != 2) {
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
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







+


-
+




+
+
+
+
+
+

-
+
-
-
+

-
-
-
+
+
+


-
+














-
+













-
+




















-
+
+











-
+





-
+












-
+





-
+

-
+








-
-
-
+
+
+












-
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ExecObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    /*
     * This function generates an argv array for the string arguments. It
     * starts out with stack-allocated space but uses dynamically-allocated
     * storage if needed.
     */

    Tcl_Obj *resultPtr;
    const char **argv;		/* An array for the string arguments. Stored
    const char **argv;
				 * on the _Tcl_ stack. */
    const char *string;
    char *string;
    Tcl_Channel chan;
    int argc, background, i, index, keepNewline, result, skip, ignoreStderr;
    size_t length;
    static const char *const options[] = {
    int argc, background, i, index, keepNewline, result, skip, length;
    int ignoreStderr;
    static const char *options[] = {
	"-ignorestderr", "-keepnewline", "--", NULL
    };
    enum execOptionsEnum {
    enum options {
	EXEC_IGNORESTDERR, EXEC_KEEPNEWLINE, EXEC_LAST
    };

    /*
     * Check for any leading option arguments.
     */

    keepNewline = 0;
    ignoreStderr = 0;
    for (skip = 1; skip < objc; skip++) {
	string = TclGetString(objv[skip]);
	if (string[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[skip], options, "option",
	if (Tcl_GetIndexFromObj(interp, objv[skip], options, "switch",
		TCL_EXACT, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (index == EXEC_KEEPNEWLINE) {
	    keepNewline = 1;
	} else if (index == EXEC_IGNORESTDERR) {
	    ignoreStderr = 1;
	} else {
	    skip++;
	    break;
	}
    }
    if (objc <= skip) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-option ...? arg ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "?switches? arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * See if the command is to be run in background.
     */

    background = 0;
    string = TclGetString(objv[objc - 1]);
    if ((string[0] == '&') && (string[1] == '\0')) {
	objc--;
	background = 1;
    }

    /*
     * Create the string argument array "argv". Make sure argv is large enough
     * to hold the argc arguments plus 1 extra for the zero end-of-argv word.
     */

    argc = objc - skip;
    argv = (const char **)TclStackAlloc(interp, (argc + 1) * sizeof(char *));
    argv = (const char **)
	    TclStackAlloc(interp, (unsigned)(argc + 1) * sizeof(char *));

    /*
     * Copy the string conversions of each (post option) object into the
     * argument vector.
     */

    for (i = 0; i < argc; i++) {
	argv[i] = TclGetString(objv[i + skip]);
    }
    argv[argc] = NULL;
    chan = Tcl_OpenCommandChannel(interp, argc, argv, (background ? 0 :
	    ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR));
	    (ignoreStderr ? TCL_STDOUT : TCL_STDOUT|TCL_STDERR)));

    /*
     * Free the argv array.
     */

    TclStackFree(interp, (void *) argv);
    TclStackFree(interp, (void *)argv);

    if (chan == NULL) {
	return TCL_ERROR;
    }

    if (background) {
	/*
	 * Store the list of PIDs from the pipeline in interp's result and
	 * detach the PIDs (instead of waiting for them).
	 */

	TclGetAndDetachPids(interp, chan);
	if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
	if (Tcl_Close(interp, chan) != TCL_OK) {
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    TclNewObj(resultPtr);
    resultPtr = Tcl_NewObj();
    if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
	if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
	if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
	    /*
	     * TIP #219.
	     * Capture error messages put by the driver into the bypass area
	     * and put them into the regular interpreter result. Fall back to
	     * the regular message if nothing was found in the bypass.
	     */

	    if (!TclChanCaughtErrorBypass(interp, chan)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading output from command: %s",
			Tcl_PosixError(interp)));
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "error reading output from command: ",
			Tcl_PosixError(interp), NULL);
		Tcl_DecrRefCount(resultPtr);
	    }
	    return TCL_ERROR;
	}
    }

    /*
     * If the process produced anything on stderr, it will have been returned
     * in the interpreter result. It needs to be appended to the result
     * string.
     */

    result = Tcl_CloseEx(interp, chan, 0);
    result = Tcl_Close(interp, chan);
    Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));

    /*
     * If the last character of the result is a newline, then remove the
     * newline character.
     */

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
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







+


-
+















-
-
-
+
+
+
-







 * Side effects:
 *	Sets interp's result to boolean true or false depending on whether the
 *	preceeding input operation on the channel would have blocked.
 *
 *---------------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_FblockedObjCmd(
    TCL_UNUSED(ClientData),
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    int mode;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
	return TCL_ERROR;
    }

    if (TclGetChannelFromObj(interp, objv[1], &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for reading",
    if ((mode & TCL_READABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
		"\" wasn't opened for reading", NULL);
		TclGetString(objv[1])));
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_InputBlocked(chan)));
    return TCL_OK;
}

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
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







+


-
+


















-
+



-
-
+
-
-



+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_OpenObjCmd(
    TCL_UNUSED(ClientData),
    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int pipeline, prot;
    const char *modeString, *what;
    Tcl_Channel chan;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "fileName ?access? ?permissions?");
	return TCL_ERROR;
    }
    prot = 0666;
    if (objc == 2) {
	modeString = "r";
    } else {
	modeString = TclGetString(objv[2]);
	if (objc == 4) {
	    const char *permString = TclGetString(objv[3]);
	    char *permString = TclGetString(objv[3]);
	    int code = TCL_ERROR;
	    int scanned = TclParseAllWhiteSpace(permString, -1);

	    /*
	     * Support legacy octal numbers.
	    /* Support legacy octal numbers */
	     */

	    if ((permString[scanned] == '0')
		    && (permString[scanned+1] >= '0')
		    && (permString[scanned+1] <= '7')) {

		Tcl_Obj *permObj;

		TclNewLiteralStringObj(permObj, "0o");
		Tcl_AppendToObj(permObj, permString+scanned+1, -1);
		code = TclGetIntFromObj(NULL, permObj, &prot);
		Tcl_DecrRefCount(permObj);
	    }
1145
1146
1147
1148
1149
1150
1151
1152

1153
1154
1155
1156
1157
1158

1159
1160
1161
1162
1163
1164
1165
1144
1145
1146
1147
1148
1149
1150

1151
1152
1153
1154
1155
1156

1157
1158
1159
1160
1161
1162
1163
1164







-
+





-
+







		break;
	    }
	    chan = Tcl_OpenCommandChannel(interp, cmdObjc, cmdArgv, flags);
	    if (binary && chan) {
		Tcl_SetChannelOption(interp, chan, "-translation", "binary");
	    }
	}
	Tcl_Free((void *)cmdArgv);
	ckfree((char *) cmdArgv);
    }
    if (chan == NULL) {
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp, chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpAcceptCallbacksDeleteProc --
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
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







+




-
+

-
+





-
+




-
+







 *	Deallocates memory and sets the interp field of all the accept
 *	callback records to NULL to prevent this interpreter from being used
 *	subsequently to eval accept scripts.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static void
TcpAcceptCallbacksDeleteProc(
    ClientData clientData,	/* Data which was passed when the assocdata
				 * was registered. */
    TCL_UNUSED(Tcl_Interp *))
    Tcl_Interp *interp)		/* Interpreter being deleted - not used. */
{
    Tcl_HashTable *hTblPtr = (Tcl_HashTable *)clientData;
    Tcl_HashTable *hTblPtr = clientData;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr);
	AcceptCallback *acceptCallbackPtr = Tcl_GetHashValue(hPtr);

	acceptCallbackPtr->interp = NULL;
    }
    Tcl_DeleteHashTable(hTblPtr);
    Tcl_Free(hTblPtr);
    ckfree((char *) hTblPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * RegisterTcpServerInterpCleanup --
 *
1230
1231
1232
1233
1234
1235
1236

1237

1238
1239
1240

1241
1242

1243
1244
1245
1246

1247
1248
1249
1250
1251
1252
1253
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







+
-
+


-
+

-
+



-
+







{
    Tcl_HashTable *hTblPtr;	/* Hash table for accept callback records to
				 * smash when the interpreter will be
				 * deleted. */
    Tcl_HashEntry *hPtr;	/* Entry for this record. */
    int isNew;			/* Is the entry new? */

    hTblPtr = (Tcl_HashTable *)
    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
	    Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);

    if (hTblPtr == NULL) {
	hTblPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
	Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
	Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
	(void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
		TcpAcceptCallbacksDeleteProc, hTblPtr);
    }

    hPtr = Tcl_CreateHashEntry(hTblPtr, acceptCallbackPtr, &isNew);
    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &isNew);
    if (!isNew) {
	Tcl_Panic("RegisterTcpServerCleanup: damaged accept record table");
    }
    Tcl_SetHashValue(hPtr, acceptCallbackPtr);
}

/*
1276
1277
1278
1279
1280
1281
1282
1283


1284
1285
1286
1287
1288
1289
1290
1277
1278
1279
1280
1281
1282
1283

1284
1285
1286
1287
1288
1289
1290
1291
1292







-
+
+







    AcceptCallback *acceptCallbackPtr)
				/* The record for which to delete the
				 * registration. */
{
    Tcl_HashTable *hTblPtr;
    Tcl_HashEntry *hPtr;

    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
	    "tclTCPAcceptCallbacks", NULL);
    if (hTblPtr == NULL) {
	return;
    }

    hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
    if (hPtr != NULL) {
	Tcl_DeleteHashEntry(hPtr);
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
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
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
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367


1368
1369
1370
1371

1372
1373
1374
1375
1376
1377
1378
1379







-
+








+
+

-
-
+

-
-
-
-
-
-
-
-
-
-
+
+

-
+









-
+
-
-
+

-
+











+


-
-
+
+


-
+







				 * created in the call to
				 * Tcl_OpenTcpServer. */
    Tcl_Channel chan,		/* Channel for the newly accepted
				 * connection. */
    char *address,		/* Address of client that was accepted. */
    int port)			/* Port of client that was accepted. */
{
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;

    /*
     * Check if the callback is still valid; the interpreter may have gone
     * away, this is signalled by setting the interp field of the callback
     * data to NULL.
     */

    if (acceptCallbackPtr->interp != NULL) {
	char portBuf[TCL_INTEGER_SPACE];
	char *script = acceptCallbackPtr->script;
	Tcl_Interp *interp = acceptCallbackPtr->interp;
	Tcl_Obj *script, *objv[2];
	int result = TCL_OK;
	int result;

	objv[0] = acceptCallbackPtr->script;
	objv[1] = Tcl_NewListObj(3, NULL);
	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(
		Tcl_GetChannelName(chan), -1));
	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(address, -1));
	Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewWideIntObj(port));

	script = Tcl_ConcatObj(2, objv);
	Tcl_IncrRefCount(script);
	Tcl_DecrRefCount(objv[1]);
	Tcl_Preserve(script);
	Tcl_Preserve(interp);

	Tcl_Preserve(interp);
	TclFormatInt(portBuf, port);
	Tcl_RegisterChannel(interp, chan);

	/*
	 * Artificially bump the refcount to protect the channel from being
	 * deleted while the script is being evaluated.
	 */

	Tcl_RegisterChannel(NULL, chan);

	result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
	Tcl_DecrRefCount(script);

		" ", address, " ", portBuf, NULL);
	if (result != TCL_OK) {
	    Tcl_BackgroundException(interp, result);
	    TclBackgroundException(interp, result);
	    Tcl_UnregisterChannel(interp, chan);
	}

	/*
	 * Decrement the artificially bumped refcount. After this it is not
	 * safe anymore to use "chan", because it may now be deleted.
	 */

	Tcl_UnregisterChannel(NULL, chan);

	Tcl_Release(interp);
	Tcl_Release(script);
    } else {
	/*
	 * The interpreter has been deleted, so there is no useful way to use
	 * the client socket - just close it.
	 * The interpreter has been deleted, so there is no useful way to
	 * utilize the client socket - just close it.
	 */

	Tcl_CloseEx(NULL, chan, 0);
	Tcl_Close(NULL, chan);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TcpServerCloseProc --
1400
1401
1402
1403
1404
1405
1406
1407

1408
1409
1410
1411
1412
1413
1414
1415


1416
1417
1418
1419
1420
1421
1422
1395
1396
1397
1398
1399
1400
1401

1402
1403
1404
1405
1406
1407
1408


1409
1410
1411
1412
1413
1414
1415
1416
1417







-
+






-
-
+
+







 */

static void
TcpServerCloseProc(
    ClientData callbackData)	/* The data passed in the call to
				 * Tcl_CreateCloseHandler. */
{
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *)callbackData;
    AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
				/* The actual data. */

    if (acceptCallbackPtr->interp != NULL) {
	UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
		acceptCallbackPtr);
    }
    Tcl_DecrRefCount(acceptCallbackPtr->script);
    Tcl_Free(acceptCallbackPtr);
    Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
    ckfree((char *) acceptCallbackPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SocketObjCmd --
 *
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
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1470
1471

1472
1473
1474
1475


1476
1477
1478
1479
1480
1481
1482
1483
1484


1485
1486
1487
1488
1489
1490

1491
1492
1493
1494
1495


1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507


1508
1509
1510
1511
1512
1513
1514


1515
1516
1517

1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
1458
1459
1460

1461
1462
1463


1464
1465
1466
1467
1468
1469
1470
1471
1472


1473
1474
1475
1476
1477
1478
1479

1480
1481
1482
1483


1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495


1496
1497
1498
1499
1500
1501
1502


1503
1504
1505
1506

1507






















1508
1509
1510
1511
1512
1513
1514
1515


1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531


1532



1533




1534
1535
1536





1537







1538




1539



1540
1541




1542






1543
1544
1545


1546

1547
1548
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







-
+




-
-
+
+
-

-
-
+
+
-

-
+
-
-
-
-
+







-
+








-
+


-
-
+
+







-
-
+
+





-
+



-
-
+
+










-
-
+
+





-
-
+
+


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
+
+














-
-
+
-
-
-
+
-
-
-
-



-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
+
+
-
-
-
-
+
-
-
-
-
-
-



-
-

-
+
+
+
+

-
-
+
+

-
-
-
+
+

-
-
+
+




















-
-
-
-
-
-
-
+




-

-
+
+







 *	Creates a socket based channel.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SocketObjCmd(
    TCL_UNUSED(ClientData),
    ClientData notUsed,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const socketOptions[] = {
	"-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
    static const char *socketOptions[] = {
	"-async", "-myaddr", "-myport","-server", NULL
	NULL
    };
    enum socketOptionsEnum {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
    enum socketOptions {
	SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
	SKT_SERVER
    };
    int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
    int optionIndex, a, server = 0, port, myport = 0, async = 0;
	reusea = -1;
    unsigned int flags = 0;
    const char *host, *port, *myaddr = NULL;
    Tcl_Obj *script = NULL;
    char *host, *script = NULL, *myaddr = NULL;
    Tcl_Channel chan;

    if (TclpHasSockets(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    for (a = 1; a < objc; a++) {
	const char *arg = TclGetString(objv[a]);
	const char *arg = Tcl_GetString(objv[a]);

	if (arg[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[a], socketOptions, "option",
		TCL_EXACT, &optionIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum socketOptionsEnum) optionIndex) {
	switch ((enum socketOptions) optionIndex) {
	case SKT_ASYNC:
	    if (server == 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot set -async option for server sockets", -1));
		Tcl_AppendResult(interp,
			"cannot set -async option for server sockets", NULL);
		return TCL_ERROR;
	    }
	    async = 1;
	    break;
	case SKT_MYADDR:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -myaddr option", -1));
		Tcl_AppendResult(interp,
			"no argument given for -myaddr option", NULL);
		return TCL_ERROR;
	    }
	    myaddr = TclGetString(objv[a]);
	    break;
	case SKT_MYPORT: {
	    const char *myPortName;
	    char *myPortName;

	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -myport option", -1));
		Tcl_AppendResult(interp,
			"no argument given for -myport option", NULL);
		return TCL_ERROR;
	    }
	    myPortName = TclGetString(objv[a]);
	    if (TclSockGetPort(interp, myPortName, "tcp", &myport) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	}
	case SKT_SERVER:
	    if (async == 1) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot set -async option for server sockets", -1));
		Tcl_AppendResult(interp,
			"cannot set -async option for server sockets", NULL);
		return TCL_ERROR;
	    }
	    server = 1;
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -server option", -1));
		Tcl_AppendResult(interp,
			"no argument given for -server option", NULL);
		return TCL_ERROR;
	    }
	    script = objv[a];
	    script = TclGetString(objv[a]);
	    break;
	case SKT_REUSEADDR:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -reuseaddr option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetBooleanFromObj(interp, objv[a], &reusea) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	case SKT_REUSEPORT:
	    a++;
	    if (a >= objc) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"no argument given for -reuseport option", -1));
		return TCL_ERROR;
	    }
	    if (Tcl_GetBooleanFromObj(interp, objv[a], &reusep) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	default:
	    Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
	}
    }
    if (server) {
	host = myaddr;		/* NULL implies INADDR_ANY */
	if (myport != 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "option -myport is not valid for servers", -1));
	    Tcl_AppendResult(interp, "option -myport is not valid for servers",
		    NULL);
	    return TCL_ERROR;
	}
    } else if (a < objc) {
	host = TclGetString(objv[a]);
	a++;
    } else {
	Interp *iPtr;

    wrongNumArgs:
	iPtr = (Interp *) interp;
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-myaddr addr? ?-myport myport? ?-async? host port");
	iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_WrongNumArgs(interp, 1, objv,
		"-server command ?-reuseaddr boolean? ?-reuseport boolean? "
		"?-myaddr addr? port");
		"-server command ?-myaddr addr? port");
	return TCL_ERROR;
    }

	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
    if (!server && (reusea != -1 || reusep != -1)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"options -reuseaddr and -reuseport are only valid for servers",
		-1));
	return TCL_ERROR;
    }

    /*
     * Set the options to their default value if the user didn't override
     * their value.
     */

    if (a == objc-1) {
    if (reusep == -1) {
	reusep = 0;
    }
    if (reusea == -1) {
	reusea = 1;
    }

	if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
    /*
     * Build the bitset with the flags values.
     */

		&port) != TCL_OK) {
    if (reusea) {
	flags |= TCL_TCPSERVER_REUSEADDR;
    }
	    return TCL_ERROR;
	}
    if (reusep) {
	flags |= TCL_TCPSERVER_REUSEPORT;
    }

    } else {
    /*
     * All the arguments should have been parsed by now, 'a' points to the
     * last one, the port number.
     */

    if (a != objc-1) {
	goto wrongNumArgs;
    }

    port = TclGetString(objv[a]);

    if (server) {
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_Alloc(sizeof(AcceptCallback));
	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
		ckalloc((unsigned) sizeof(AcceptCallback));
	unsigned len = strlen(script) + 1;
	char *copyScript = ckalloc(len);

	Tcl_IncrRefCount(script);
	acceptCallbackPtr->script = script;
	memcpy(copyScript, script, len);
	acceptCallbackPtr->script = copyScript;
	acceptCallbackPtr->interp = interp;

	chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
		AcceptCallbackProc, acceptCallbackPtr);
	chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
		acceptCallbackPtr);
	if (chan == NULL) {
	    Tcl_DecrRefCount(script);
	    Tcl_Free(acceptCallbackPtr);
	    ckfree(copyScript);
	    ckfree((char *) acceptCallbackPtr);
	    return TCL_ERROR;
	}

	/*
	 * Register with the interpreter to let us know when the interpreter
	 * is deleted (by having the callback set the interp field of the
	 * acceptCallbackPtr's structure to NULL). This is to avoid trying to
	 * eval the script in a deleted interpreter.
	 */

	RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);

	/*
	 * Register a close callback. This callback will inform the
	 * interpreter (if it still exists) that this channel does not need to
	 * be informed when the interpreter is deleted.
	 */

	Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
    } else {
	int portNum;

	if (TclSockGetPort(interp, port, "tcp", &portNum) != TCL_OK) {
	    return TCL_ERROR;
	}

	chan = Tcl_OpenTcpClient(interp, portNum, host, myaddr, myport, async);
	chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
	if (chan == NULL) {
	    return TCL_ERROR;
	}
    }

    Tcl_RegisterChannel(interp, chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), NULL);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FcopyObjCmd --
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
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
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
1668

1669
1670
1671
1672
1673
1674
1675







-
+





-
+
-

-
+
















-
-
-
+
+
+
-





-
-
-
+
+
+
-






-
+





-
+


-
+






-







 *	handler.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FcopyObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel inChan, outChan;
    int mode, i, index;
    int mode, i, toRead, index;
    Tcl_WideInt toRead;
    Tcl_Obj *cmdPtr;
    static const char *const switches[] = { "-size", "-command", NULL };
    static const char* switches[] = { "-size", "-command", NULL };
    enum { FcopySize, FcopyCommand };

    if ((objc < 3) || (objc > 7) || (objc == 4) || (objc == 6)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"input output ?-size size? ?-command callback?");
	return TCL_ERROR;
    }

    /*
     * Parse the channel arguments and verify that they are readable or
     * writable, as appropriate.
     */

    if (TclGetChannelFromObj(interp, objv[1], &inChan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for reading",
    if ((mode & TCL_READABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[1]),
		"\" wasn't opened for reading", NULL);
		TclGetString(objv[1])));
	return TCL_ERROR;
    }
    if (TclGetChannelFromObj(interp, objv[2], &outChan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"channel \"%s\" wasn't opened for writing",
    if ((mode & TCL_WRITABLE) == 0) {
	Tcl_AppendResult(interp, "channel \"", TclGetString(objv[2]),
		"\" wasn't opened for writing", NULL);
		TclGetString(objv[2])));
	return TCL_ERROR;
    }

    toRead = -1;
    cmdPtr = NULL;
    for (i = 3; i < objc; i += 2) {
	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0,
	if (Tcl_GetIndexFromObj(interp, objv[i], switches, "switch", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (index) {
	case FcopySize:
	    if (Tcl_GetWideIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
	    if (TclGetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (toRead < 0) {
	    if (toRead<0) {
		/*
		 * Handle all negative sizes like -1, meaning 'copy all'. By
		 * resetting toRead we avoid changes in the core copying
		 * functions (which explicitly check for -1 and crash on any
		 * other negative value).
		 */

		toRead = -1;
	    }
	    break;
	case FcopyCommand:
	    cmdPtr = objv[i+1];
	    break;
	}
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
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







+


-
+






-
-
+
+















-
+

-
-
+
+

-
+



-
-
+
+

-
+







 *	Sets interp's result to the number of bytes of buffered input or
 *	output (depending on whether the first argument is "input" or
 *	"output"), or -1 if the channel wasn't opened for that mode.
 *
 *---------------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ChanPendingObjCmd(
    TCL_UNUSED(ClientData),
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    int index, mode;
    static const char *const options[] = {"input", "output", NULL};
    enum pendingOptionsEnum {PENDING_INPUT, PENDING_OUTPUT};
    static const char *options[] = {"input", "output", NULL};
    enum options {PENDING_INPUT, PENDING_OUTPUT};

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    if (TclGetChannelFromObj(interp, objv[2], &chan, &mode, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum pendingOptionsEnum) index) {
    switch ((enum options) index) {
    case PENDING_INPUT:
	if (!(mode & TCL_READABLE)) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1));
	if ((mode & TCL_READABLE) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_InputBuffered(chan)));
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
	}
	break;
    case PENDING_OUTPUT:
	if (!(mode & TCL_WRITABLE)) {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1));
	if ((mode & TCL_WRITABLE) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_OutputBuffered(chan)));
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
	}
	break;
    }
    return TCL_OK;
}

/*
1829
1830
1831
1832
1833
1834
1835
1836

1837
1838
1839
1840
1841
1842
1843
1758
1759
1760
1761
1762
1763
1764

1765
1766
1767
1768
1769
1770
1771
1772







-
+







 *	Truncates a channel (or rather a file underlying a channel).
 *
 *----------------------------------------------------------------------
 */

static int
ChanTruncateObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel chan;
    Tcl_WideInt length;

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
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
1820
1821
1822
1823







-
-
+
+








-
-
-
-
+
+
+
+
+





-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	 * User is supplying an explicit length.
	 */

	if (Tcl_GetWideIntFromObj(interp, objv[2], &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot truncate to negative length of file", -1));
	    Tcl_AppendResult(interp,
		    "cannot truncate to negative length of file", NULL);
	    return TCL_ERROR;
	}
    } else {
	/*
	 * User wants to truncate to the current file position.
	 */

	length = Tcl_Tell(chan);
	if (length == -1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not determine current location in \"%s\": %s",
		    TclGetString(objv[1]), Tcl_PosixError(interp)));
	if (length == Tcl_WideAsLong(-1)) {
	    Tcl_AppendResult(interp,
		    "could not determine current location in \"",
		    TclGetString(objv[1]), "\": ",
		    Tcl_PosixError(interp), NULL);
	    return TCL_ERROR;
	}
    }

    if (Tcl_TruncateChannel(chan, length) != TCL_OK) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"error during truncate on \"%s\": %s",
		TclGetString(objv[1]), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "error during truncate on \"",
		TclGetString(objv[1]), "\": ",
	return TCL_ERROR;
    }

		Tcl_PosixError(interp), NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ChanPipeObjCmd --
 *
 *	This function is invoked to process the "chan pipe" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates a pair of Tcl channels wrapping both ends of a new
 *	anonymous pipe.
 *
 *----------------------------------------------------------------------
 */

static int
ChanPipeObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel rchan, wchan;
    const char *channelNames[2];
    Tcl_Obj *resultPtr;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    if (Tcl_CreatePipe(interp, &rchan, &wchan, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    channelNames[0] = Tcl_GetChannelName(rchan);
    channelNames[1] = Tcl_GetChannelName(wchan);

    TclNewObj(resultPtr);
    Tcl_ListObjAppendElement(NULL, resultPtr,
	    Tcl_NewStringObj(channelNames[0], -1));
    Tcl_ListObjAppendElement(NULL, resultPtr,
	    Tcl_NewStringObj(channelNames[1], -1));
    Tcl_SetObjResult(interp, resultPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclChannelNamesCmd --
 *
 *	This function is invoked to process the "chan names" and "file
 *	channels" Tcl commands.  See the user documentation for details on
 *	what they do.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclChannelNamesCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc < 1 || objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
    }
    return Tcl_GetChannelNamesEx(interp,
	    ((objc == 1) ? NULL : TclGetString(objv[1])));
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitChanCmd --
 *
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
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







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+



+







     * Most commands are plugged directly together, but some are done via
     * alias-like rewriting; [chan configure] is this way for security reasons
     * (want overwriting of [fconfigure] to control that nicely), and [chan
     * names] because the functionality isn't available as a separate command
     * function at the moment.
     */
    static const EnsembleImplMap initMap[] = {
	{"blocked",	Tcl_FblockedObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"close",	Tcl_CloseObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"copy",	Tcl_FcopyObjCmd,	NULL, NULL, NULL, 0},
	{"create",	TclChanCreateObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #219 */
	{"eof",		Tcl_EofObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"event",	Tcl_FileEventObjCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"flush",	Tcl_FlushObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"gets",	Tcl_GetsObjCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"blocked",	Tcl_FblockedObjCmd, NULL},
	{"close",	Tcl_CloseObjCmd, NULL},
	{"copy",	Tcl_FcopyObjCmd, NULL},
	{"create",	TclChanCreateObjCmd, NULL},		/* TIP #219 */
	{"eof",		Tcl_EofObjCmd, NULL},
	{"event",	Tcl_FileEventObjCmd, NULL},
	{"flush",	Tcl_FlushObjCmd, NULL},
	{"gets",	Tcl_GetsObjCmd, NULL},
	{"names",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"pending",	ChanPendingObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #287 */
	{"pending",	ChanPendingObjCmd, NULL},		/* TIP #287 */
	{"pipe",	ChanPipeObjCmd,		TclCompileBasic0ArgCmd, NULL, NULL, 0},		/* TIP #304 */
	{"pop",		TclChanPopObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},		/* TIP #230 */
	{"postevent",	TclChanPostEventObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	/* TIP #219 */
	{"postevent",	TclChanPostEventObjCmd, NULL},	/* TIP #219 */
	{"push",	TclChanPushObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #230 */
	{"puts",	Tcl_PutsObjCmd,		NULL, NULL, NULL, 0},
	{"read",	Tcl_ReadObjCmd,		NULL, NULL, NULL, 0},
	{"seek",	Tcl_SeekObjCmd,		TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"tell",	Tcl_TellObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"truncate",	ChanTruncateObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},		/* TIP #208 */
	{NULL, NULL, NULL, NULL, NULL, 0}
	{"puts",	Tcl_PutsObjCmd, NULL},
	{"read",	Tcl_ReadObjCmd, NULL},
	{"seek",	Tcl_SeekObjCmd, NULL},
	{"tell",	Tcl_TellObjCmd, NULL},
	{"truncate",	ChanTruncateObjCmd, NULL},		/* TIP #208 */
	{NULL,NULL, NULL}
    };
    static const char *const extras[] = {
	"configure",	"::fconfigure",
	"names",	"::file channels",
	NULL
    };
    Tcl_Command ensemble;
    Tcl_Obj *mapObj;
    int i;

    ensemble = TclMakeEnsemble(interp, "chan", initMap);

Changes to generic/tclIOGT.c.

18
19
20
21
22
23
24
25

26
27
28
29


30
31
32
33
34
35
36
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
38







-
+




+
+







 * Forward declarations of internal procedures. First the driver procedures of
 * the transformation.
 */

static int		TransformBlockModeProc(ClientData instanceData,
			    int mode);
static int		TransformCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
			    Tcl_Interp *interp);
static int		TransformInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCodePtr);
static int		TransformOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCodePtr);
static int		TransformSeekProc(ClientData instanceData, long offset,
			    int mode, int *errorCodePtr);
static int		TransformSetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static int		TransformGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static void		TransformWatchProc(ClientData instanceData, int mask);
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
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







-
+


-
+


-
+




-
+







			    size_t toWrite);

/*
 * This structure describes the channel type structure for Tcl-based
 * transformations.
 */

static const Tcl_ChannelType transformChannelType = {
static Tcl_ChannelType transformChannelType = {
    "transform",		/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    TransformCloseProc,		/* Close proc. */
    TransformInputProc,		/* Input proc. */
    TransformOutputProc,	/* Output proc. */
    NULL,			/* Seek proc. */
    TransformSeekProc,		/* Seek proc. */
    TransformSetOptionProc,	/* Set option proc. */
    TransformGetOptionProc,	/* Get option proc. */
    TransformWatchProc,		/* Initialize notifier. */
    TransformGetFileHandleProc,	/* Get OS handles out of channel. */
    TransformCloseProc,		/* close2proc */
    NULL,			/* close2proc */
    TransformBlockModeProc,	/* Set blocking/nonblocking mode.*/
    NULL,			/* Flush proc. */
    TransformNotifyProc,	/* Handling of events bubbling up. */
    TransformWideSeekProc,	/* Wide seek proc. */
    NULL,			/* Thread action. */
    NULL			/* Truncate. */
};
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
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







-
+













-
+




-
+




















+







				 * the transformation. Used to execute the
				 * code below. */
    Tcl_Obj *command;		/* Tcl code to execute for a buffer */
    ResultBuffer result;	/* Internal buffer used to store the result of
				 * a transformation of incoming data. Also
				 * serves as buffer of all data not yet
				 * consumed by the reader. */
    size_t refCount;
    int refCount;
};

static void
PreserveData(
    TransformChannelData *dataPtr)
{
    dataPtr->refCount++;
}

static void
ReleaseData(
    TransformChannelData *dataPtr)
{
    if (dataPtr->refCount-- > 1) {
    if (--dataPtr->refCount) {
	return;
    }
    ResultClear(&dataPtr->result);
    Tcl_DecrRefCount(dataPtr->command);
    Tcl_Free(dataPtr);
    ckfree((char *) dataPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclChannelTransform --
 *
 *	Implements the Tcl "testchannel transform" debugging command. This is
 *	part of the testing environment. This sets up a tcl script (cmdObjPtr)
 *	to be used as a transform on the channel.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
TclChannelTransform(
    Tcl_Interp *interp,		/* Interpreter for result. */
    Tcl_Channel chan,		/* Channel to transform. */
    Tcl_Obj *cmdObjPtr)		/* Script to use for transform. */
{
    Channel *chanPtr;		/* The actual channel. */
280
281
282
283
284
285
286
287

288
289
290
291
292
293
294
283
284
285
286
287
288
289

290
291
292
293
294
295
296
297







-
+








    /*
     * Now initialize the transformation state and stack it upon the specified
     * channel. One of the necessary things to do is to retrieve the blocking
     * regime of the underlying channel and to use the same for us too.
     */

    dataPtr = (TransformChannelData *)Tcl_Alloc(sizeof(TransformChannelData));
    dataPtr = (TransformChannelData *) ckalloc(sizeof(TransformChannelData));

    dataPtr->refCount = 1;
    Tcl_DStringInit(&ds);
    Tcl_GetChannelOption(interp, chan, "-blocking", &ds);
    dataPtr->readIsFlushed = 0;
    dataPtr->eofPending = 0;
    dataPtr->flags = 0;
306
307
308
309
310
311
312
313
314


315
316
317
318
319
320
321
309
310
311
312
313
314
315


316
317
318
319
320
321
322
323
324







-
-
+
+







    Tcl_IncrRefCount(dataPtr->command);

    ResultInit(&dataPtr->result);

    dataPtr->self = Tcl_StackChannel(interp, &transformChannelType, dataPtr,
	    mode, chan);
    if (dataPtr->self == NULL) {
	Tcl_AppendPrintfToObj(Tcl_GetObjResult(interp),
		"\nfailed to stack channel \"%s\"", Tcl_GetChannelName(chan));
	Tcl_AppendResult(interp, "\nfailed to stack channel \"",
		Tcl_GetChannelName(chan), "\"", NULL);
	ReleaseData(dataPtr);
	return TCL_ERROR;
    }
    Tcl_Preserve(dataPtr->self);

    /*
     * At last initialize the transformation at the script level.
371
372
373
374
375
376
377
378

379
380
381
382
383
384
385
374
375
376
377
378
379
380

381
382
383
384
385
386
387
388







-
+







				 * callback is sent to the underlying channel
				 * or not. */
    int preserve)		/* Flag. If true the procedure will preserve
				 * the result state of all accessed
				 * interpreters. */
{
    Tcl_Obj *resObj;		/* See below, switch (transmit). */
    size_t resLen = 0;
    int resLen;
    unsigned char *resBuf;
    Tcl_InterpState state = NULL;
    int res = TCL_OK;
    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
    Tcl_Interp *eval = dataPtr->interp;

    Tcl_Preserve(eval);
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
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







-
+









-
+





-
+







	break;

    case TRANSMIT_DOWN:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(Tcl_GetStackedChannel(dataPtr->self), (char *) resBuf,
		resLen);
	break;

    case TRANSMIT_SELF:
	if (dataPtr->self == NULL) {
	    break;
	}
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	Tcl_WriteRaw(dataPtr->self, (char *) resBuf, resLen);
	break;

    case TRANSMIT_IBUF:
	resObj = Tcl_GetObjResult(eval);
	resBuf = TclGetByteArrayFromObj(resObj, &resLen);
	resBuf = Tcl_GetByteArrayFromObj(resObj, &resLen);
	ResultAdd(&dataPtr->result, resBuf, resLen);
	break;

    case TRANSMIT_NUM:
	/*
	 * Interpret result as integer number.
	 */
496
497
498
499
500
501
502
503

504
505
506
507
508
509
510
499
500
501
502
503
504
505

506
507
508
509
510
511
512
513







-
+







 */

static int
TransformBlockModeProc(
    ClientData instanceData,	/* State of transformation. */
    int mode)			/* New blocking mode. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	dataPtr->flags |= CHANNEL_ASYNC;
    } else {
	dataPtr->flags &= ~CHANNEL_ASYNC;
    }
    return 0;
526
527
528
529
530
531
532
533

534
535
536

537
538
539
540
541
542
543
544
545
546
547
529
530
531
532
533
534
535

536

537

538




539
540
541
542
543
544
545







-
+
-

-
+
-
-
-
-







 *
 *----------------------------------------------------------------------
 */

static int
TransformCloseProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    Tcl_Interp *interp)
	int flags)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    /*
     * Important: In this procedure 'dataPtr->self' already points to the
     * underlying channel.
     *
     * There is no need to cancel an existing channel handler, this is already
     * done. Either by 'Tcl_UnstackChannel' or by the general cleanup in
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
612
613
614
615
616
617
618

619
620
621
622
623
624
625
626







-
+







static int
TransformInputProc(
    ClientData instanceData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;
    int gotBytes, read, copied;
    Tcl_Channel downChan;

    /*
     * Should assert(dataPtr->mode & TCL_READABLE);
     */

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
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







-
+












+







	    break;
	}
	if (dataPtr->eofPending) {
	    /*
	     * Already saw EOF from downChan; don't ask again.
	     * NOTE: Could move this up to avoid the last maxRead
	     * execution.  Believe this would still be correct behavior,
	     * but the test suite tests the whole command callback
	     * but the test suite tests the whole command callback 
	     * sequence, so leave it unchanged for now.
	     */

	    break;
	}

	/*
	 * Get bytes from the underlying channel.
	 */

	read = Tcl_ReadRaw(downChan, buf, toRead);
	if (read < 0) {

	    if (Tcl_InputBlocked(downChan) && (gotBytes > 0)) {
		/*
		 * Zero bytes available from downChan because blocked.
		 * But nonzero bytes already copied, so total is a
		 * valid blocked short read. Return to caller.
		 */

781
782
783
784
785
786
787
788

789
790
791
792
793
794
795
780
781
782
783
784
785
786

787
788
789
790
791
792
793
794







-
+







static int
TransformOutputProc(
    ClientData instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;

    /*
     * Should assert(dataPtr->mode & TCL_WRITABLE);
     */

    if (toWrite == 0) {
	/*
805
806
807
808
809
810
811



































































812
813
814
815
816
817
818
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	*errorCodePtr = EINVAL;
	toWrite = -1;
    }
    ReleaseData(dataPtr);

    return toWrite;
}

/*
 *----------------------------------------------------------------------
 *
 * TransformSeekProc --
 *
 *	This procedure is called by the generic IO level to move the access
 *	point in a channel.
 *
 * Side effects:
 *	Moves the location at which the channel will be accessed in future
 *	operations. Flushes all transformation buffers, then forwards it to
 *	the underlying channel.
 *
 * Result:
 *	-1 if failed, the new position if successful. An output argument
 *	contains the POSIX error code if an error occurred, or zero.
 *
 *----------------------------------------------------------------------
 */

static int
TransformSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    long offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_ChannelType *parentType = Tcl_GetChannelType(parent);
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);

    if ((offset == 0) && (mode == SEEK_CUR)) {
	/*
	 * This is no seek but a request to tell the caller the current
	 * location. Simply pass the request down.
	 */

	return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset,
		mode, errorCodePtr);
    }

    /*
     * It is a real request to change the position. Flush all data waiting for
     * output and discard everything in the input buffers. Then pass the
     * request down, unchanged.
     */

    PreserveData(dataPtr);
    if (dataPtr->mode & TCL_WRITABLE) {
	ExecuteCallback(dataPtr, NULL, A_FLUSH_WRITE, NULL, 0, TRANSMIT_DOWN,
		P_NO_PRESERVE);
    }

    if (dataPtr->mode & TCL_READABLE) {
	ExecuteCallback(dataPtr, NULL, A_CLEAR_READ, NULL, 0, TRANSMIT_DONT,
		P_NO_PRESERVE);
	ResultClear(&dataPtr->result);
	dataPtr->readIsFlushed = 0;
	dataPtr->eofPending = 0;
    }
    ReleaseData(dataPtr);

    return parentSeekProc(Tcl_GetChannelInstanceData(parent), offset, mode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TransformWideSeekProc --
 *
 *	This procedure is called by the generic IO level to move the access
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
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







-
+

-
+
+




-
+







-
-
-

+
+
+







static Tcl_WideInt
TransformWideSeekProc(
    ClientData instanceData,	/* The channel to manipulate. */
    Tcl_WideInt offset,		/* Size of movement. */
    int mode,			/* How to move. */
    int *errorCodePtr)		/* Location of error flag. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;
    Tcl_Channel parent = Tcl_GetStackedChannel(dataPtr->self);
    const Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
    Tcl_ChannelType *parentType	= Tcl_GetChannelType(parent);
    Tcl_DriverSeekProc *parentSeekProc = Tcl_ChannelSeekProc(parentType);
    Tcl_DriverWideSeekProc *parentWideSeekProc =
	    Tcl_ChannelWideSeekProc(parentType);
    ClientData parentData = Tcl_GetChannelInstanceData(parent);

    if ((offset == 0) && (mode == SEEK_CUR)) {
    if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
	/*
	 * This is no seek but a request to tell the caller the current
	 * location. Simply pass the request down.
	 */

	if (parentWideSeekProc != NULL) {
	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
	} else {
	    *errorCodePtr = EINVAL;
	    return -1;
	}

	return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
		errorCodePtr));
    }

    /*
     * It is a real request to change the position. Flush all data waiting for
     * output and discard everything in the input buffers. Then pass the
     * request down, unchanged.
     */
879
880
881
882
883
884
885
886
887
888















889


890

891
892
893
894
895
896
897
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







-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
+







    }
    ReleaseData(dataPtr);

    /*
     * If we have a wide seek capability, we should stick with that.
     */

    if (parentWideSeekProc == NULL) {
	*errorCodePtr = EINVAL;
	return -1;
    if (parentWideSeekProc != NULL) {
	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
    }

    /*
     * We're transferring to narrow seeks at this point; this is a bit complex
     * because we have to check whether the seek is possible first (i.e.
     * whether we are losing information in truncating the bits of the
     * offset). Luckily, there's a defined error for what happens when trying
     * to go out of the representable range.
     */

    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
	*errorCodePtr = EOVERFLOW;
	return Tcl_LongAsWide(-1);
    }

    return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
	return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
	    mode, errorCodePtr));
}

/*
 *----------------------------------------------------------------------
 *
 * TransformSetOptionProc --
 *
911
912
913
914
915
916
917
918

919
920
921
922
923
924
925
992
993
994
995
996
997
998

999
1000
1001
1002
1003
1004
1005
1006







-
+







static int
TransformSetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverSetOptionProc *setOptionProc;

    setOptionProc = Tcl_ChannelSetOptionProc(Tcl_GetChannelType(downChan));
    if (setOptionProc == NULL) {
	return TCL_ERROR;
    }
949
950
951
952
953
954
955
956

957
958
959
960
961
962
963
1030
1031
1032
1033
1034
1035
1036

1037
1038
1039
1040
1041
1042
1043
1044







-
+







static int
TransformGetOptionProc(
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;
    Tcl_Channel downChan = Tcl_GetStackedChannel(dataPtr->self);
    Tcl_DriverGetOptionProc *getOptionProc;

    getOptionProc = Tcl_ChannelGetOptionProc(Tcl_GetChannelType(downChan));
    if (getOptionProc != NULL) {
	return getOptionProc(Tcl_GetChannelInstanceData(downChan), interp,
		optionName, dsPtr);
989
990
991
992
993
994
995

996
997
998
999
1000
1001

1002
1003
1004
1005
1006
1007
1008
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1090







+





-
+







 *
 * Result:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static void
TransformWatchProc(
    ClientData instanceData,	/* Channel to watch. */
    int mask)			/* Events of interest. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;
    Tcl_Channel downChan;

    /*
     * The caller expressed interest in events occuring for this channel. We
     * are forwarding the call to the underlying channel now.
     */

1073
1074
1075
1076
1077
1078
1079
1080

1081
1082
1083
1084
1085
1086
1087
1155
1156
1157
1158
1159
1160
1161

1162
1163
1164
1165
1166
1167
1168
1169







-
+








static int
TransformGetFileHandleProc(
    ClientData instanceData,	/* Channel to query. */
    int direction,		/* Direction of interest. */
    ClientData *handlePtr)	/* Place to store the handle into. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)instanceData;
    TransformChannelData *dataPtr = instanceData;

    /*
     * Return the handle belonging to parent channel. IOW, pass the request
     * down and the result up.
     */

    return Tcl_GetChannelHandle(Tcl_GetStackedChannel(dataPtr->self),
1107
1108
1109
1110
1111
1112
1113
1114

1115
1116
1117
1118
1119
1120
1121
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203







-
+








static int
TransformNotifyProc(
    ClientData clientData,	/* The state of the notified
				 * transformation. */
    int mask)			/* The mask of occuring events. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;
    TransformChannelData *dataPtr = clientData;

    /*
     * An event occured in the underlying channel. This transformation doesn't
     * process such events thus returns the incoming mask unchanged.
     */

    if (dataPtr->timer != NULL) {
1150
1151
1152
1153
1154
1155
1156
1157

1158
1159
1160
1161
1162
1163
1164
1232
1233
1234
1235
1236
1237
1238

1239
1240
1241
1242
1243
1244
1245
1246







-
+







 *----------------------------------------------------------------------
 */

static void
TransformChannelHandlerTimer(
    ClientData clientData)	/* Transformation to query. */
{
    TransformChannelData *dataPtr = (TransformChannelData *)clientData;
    TransformChannelData *dataPtr = clientData;

    dataPtr->timer = NULL;
    if (!(dataPtr->watchMask&TCL_READABLE) || ResultEmpty(&dataPtr->result)) {
	/*
	 * The timer fired, but either is there no (more) interest in the
	 * events it generates or nothing is available for reading, so ignore
	 * it and don't recreate it.
1188
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1270
1271
1272
1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283
1284







-
+







static inline void
ResultClear(
    ResultBuffer *r)		/* Reference to the buffer to clear out. */
{
    r->used = 0;

    if (r->allocated) {
	Tcl_Free(r->buf);
	ckfree((char *) r->buf);
	r->buf = NULL;
	r->allocated = 0;
    }
}

/*
 *----------------------------------------------------------------------
1332
1333
1334
1335
1336
1337
1338
1339

1340
1341
1342

1343
1344
1345
1346
1347
1348
1349
1414
1415
1416
1417
1418
1419
1420

1421
1422
1423

1424
1425
1426
1427
1428
1429
1430
1431







-
+


-
+







    if (r->used + toWrite > r->allocated) {
	/*
	 * Extension of the internal buffer is required.
	 */

	if (r->allocated == 0) {
	    r->allocated = toWrite + INCREMENT;
	    r->buf = (unsigned char *)Tcl_Alloc(r->allocated);
	    r->buf = UCHARP(ckalloc(r->allocated));
	} else {
	    r->allocated += toWrite + INCREMENT;
	    r->buf = (unsigned char *)Tcl_Realloc(r->buf, r->allocated);
	    r->buf = UCHARP(ckrealloc((char *) r->buf, r->allocated));
	}
    }

    /*
     * Now we may copy the data.
     */

Changes to generic/tclIORChan.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
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
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







-
-
+
+














-
+






-
-
-
-
-


+
+






-
-






-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
+















-
-
+
+
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-









+
+
-
-
+
+
+
-







 *
 * Copyright (c) 2004-2005 ActiveState, a divison of Sophos
 *
 * 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 "tclIO.h"
#include <tclInt.h>
#include <tclIO.h>
#include <assert.h>

#ifndef EINVAL
#define EINVAL	9
#endif
#ifndef EOK
#define EOK	0
#endif

/*
 * Signatures of all functions used in the C layer of the reflection.
 */

static int		ReflectClose(ClientData clientData,
			    Tcl_Interp *interp, int flags);
			    Tcl_Interp *interp);
static int		ReflectInput(ClientData clientData, char *buf,
			    int toRead, int *errorCodePtr);
static int		ReflectOutput(ClientData clientData, const char *buf,
			    int toWrite, int *errorCodePtr);
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
#if TCL_THREADS
static void		ReflectThread(ClientData clientData, int action);
static int		ReflectEventRun(Tcl_Event *ev, int flags);
static int		ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
static int		ReflectSeek(ClientData clientData, long offset,
			    int mode, int *errorCodePtr);
static int		ReflectGetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static void     TimerRunRead(ClientData clientData);
static void     TimerRunWrite(ClientData clientData);

/*
 * The C layer channel type/driver definition used by the reflection. This is
 * a version 3 structure.
 */

static const Tcl_ChannelType tclRChannelType = {
    "tclrchannel",	   /* Type name.				  */
static Tcl_ChannelType tclRChannelType = {
    "tclrchannel",         /* Type name.                                  */
    TCL_CHANNEL_VERSION_5, /* v5 channel */
    NULL,	   /* Close channel, clean instance data	  */
    ReflectInput,	   /* Handle read request			  */
    ReflectOutput,	   /* Handle write request			  */
    NULL,
    ReflectSetOption,	   /* Set options.			NULL'able */
    ReflectGetOption,	   /* Get options.			NULL'able */
    ReflectWatch,	   /* Initialize notifier			  */
    NULL,		   /* Get OS handle from the channel.	NULL'able */
	ReflectClose,	   /* No close2 support.		NULL'able */
    ReflectBlock,	   /* Set blocking/nonblocking.		NULL'able */
    NULL,		   /* Flush channel. Not used by core.	NULL'able */
    NULL,		   /* Handle events.			NULL'able */
    ReflectSeekWide,	   /* Move access point (64 bit).	NULL'able */
    ReflectClose,          /* Close channel, clean instance data          */
    ReflectInput,          /* Handle read request                         */
    ReflectOutput,         /* Handle write request                        */
    ReflectSeek,           /* Move location of access point.   NULL'able  */
    ReflectSetOption,      /* Set options.                     NULL'able  */
    ReflectGetOption,      /* Get options.                     NULL'able  */
    ReflectWatch,          /* Initialize notifier                         */
    NULL,                  /* Get OS handle from the channel.  NULL'able  */
    NULL,                  /* No close2 support.               NULL'able  */
    ReflectBlock,          /* Set blocking/nonblocking.        NULL'able  */
    NULL,                  /* Flush channel. Not used by core. NULL'able  */
    NULL,                  /* Handle events.                   NULL'able  */
    ReflectSeekWide,       /* Move access point (64 bit).      NULL'able  */
#if TCL_THREADS
    ReflectThread,         /* thread action, tracking owner */
#else
	NULL,		   /* thread action */
    NULL,                  /* thread action */
#endif
    NULL		   /* truncate */
    NULL,                  /* truncate */
};

/*
 * Instance data for a reflected channel. ===========================
 */

typedef struct {
    Tcl_Channel chan;		/* Back reference to generic channel
				 * structure. */
    Tcl_Interp *interp;		/* Reference to the interpreter containing the
				 * Tcl level part of the channel. NULL here
				 * signals the channel is dead because the
				 * interpreter/thread containing its Tcl
				 * command is gone.
				 */
#if TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler thread */
#ifdef TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
    Tcl_ThreadId owner;         /* Thread owning the structure.    == Channel thread */
#endif
    Tcl_Obj *cmd;		/* Callback command prefix */
    Tcl_Obj *methods;		/* Methods to append to command prefix */
    Tcl_Obj *name;		/* Name of the channel as created */

    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */

    Tcl_TimerToken readTimer;   /*
				   A token for the timer that is scheduled in
				   order to call Tcl_NotifyChannel when the
				   channel is readable
			        */
    Tcl_TimerToken writeTimer;  /*
				   A token for the timer that is scheduled in
				   order to call Tcl_NotifyChannel when the
				   channel is writable
			        */

    /*
     * Note regarding the usage of timers.
     *
     * Most channel implementations need a timer in the C level to ensure that
     * data in buffers is flushed out through the generation of fake file
     * events.
     *
     * See 'rechan', 'memchan', etc.
     *
     * Here this is _not_ required. Interest in events is posted to the Tcl
     * level via 'watch'. And posting of events is possible from the Tcl level
     * A timer is used here as well in order to ensure at least on pass through
     * the event loop when a channel becomes ready. See issues 67a5eabbd3d1 and
     * as well, via 'chan postevent'. This means that the generation of all
     * events, fake or not, timer based or not, is completely in the hands of
     * the Tcl level. Therefore no timer here.
     * ef28eb1f1516.
     */
} ReflectedChannel;

/*
 * Structure of the table maping from channel handles to reflected
 * channels. Each interpreter which has the handler command for one or more
 * reflected channels records them in such a table, so that 'chan postevent'
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
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







-
+










-
+








#define RCMKEY "ReflectedChannelMap"

/*
 * Event literals. ==================================================
 */

static const char *const eventOptions[] = {
static const char *eventOptions[] = {
    "read", "write", NULL
};
typedef enum {
    EVENT_READ, EVENT_WRITE
} EventOption;

/*
 * Method literals. ==================================================
 */

static const char *const methodNames[] = {
static const char *methodNames[] = {
    "blocking",		/* OPT */
    "cget",		/* OPT \/ Together or none */
    "cgetall",		/* OPT /\ of these two     */
    "configure",	/* OPT */
    "finalize",		/*     */
    "initialize",	/*     */
    "read",		/* OPT */
206
207
208
209
210
211
212
213

214
215
216
217
218
219
220
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198







-
+







#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))

#if TCL_THREADS
#ifdef TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

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
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







-
+















-
+







 * command handler thread (CT), and the thread managing the channel (MT),
 * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
 * forward an operation code, the argument details, and reference to results.
 * The command is assembled in the CT and belongs fully to that thread. No
 * sharing problems.
 */

typedef struct {
typedef struct ForwardParamBase {
    int code;			/* O: Ok/Fail of the cmd handler */
    char *msgStr;		/* O: Error message for handler failure */
    int mustFree;		/* O: True if msgStr is allocated, false if
				 * otherwise (static). */
} ForwardParamBase;

/*
 * Operation specific parameter/result structures. (These are "subtypes" of
 * ForwardParamBase. Where an operation does not need any special types, it
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamInput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* O: Where to store the read bytes */
    size_t toRead;			/* I: #bytes to read,
    int toRead;			/* I: #bytes to read,
				 * O: #bytes actually read */
};
struct ForwardParamOutput {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    const char *buf;		/* I: Where the bytes to write come from */
    int toWrite;		/* I: #bytes to write,
				 * O: #bytes actually written */
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
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







-
+



















-
+
-















-
+





-
+








typedef struct ForwardingResult ForwardingResult;

/*
 * General event structure, with reference to operation specific data.
 */

typedef struct {
typedef struct ForwardingEvent {
    Tcl_Event event;		/* Basic event data, has to be first item */
    ForwardingResult *resultPtr;
    ForwardedOperation op;	/* Forwarded driver operation */
    ReflectedChannel *rcPtr;	/* Channel instance */
    ForwardParam *param;	/* Packaged arguments and return values, a
				 * ForwardParam pointer. */
} ForwardingEvent;

/*
 * Structure to manage the result of the forwarding. This is not the result of
 * the operation itself, but about the success of the forward event itself.
 * The event can be successful, even if the operation which was forwarded
 * failed. It is also there to manage the synchronization between the involved
 * threads.
 */

struct ForwardingResult {
    Tcl_ThreadId src;		/* Originating thread. */
    Tcl_ThreadId dst;		/* Thread the op was forwarded to. */
    Tcl_Interp *dsti;		/* Interpreter in the thread the op was
    Tcl_Interp*  dsti;          /* Interpreter in the thread the op was forwarded to. */
				 * forwarded to. */
    /*
     * Note regarding 'dsti' above: Its information is also available via the
     * chain evPtr->rcPtr->interp, however, as can be seen, two more
     * indirections are needed to retrieve it. And the evPtr may be gone,
     * breaking the chain.
     */
    Tcl_Condition done;		/* Condition variable the forwarder blocks
				 * on. */
    int result;			/* TCL_OK or TCL_ERROR */
    ForwardingEvent *evPtr;	/* Event the result belongs to. */
    ForwardingResult *prevPtr, *nextPtr;
				/* Links into the list of pending forwarded
				 * results. */
};

typedef struct {
typedef struct ThreadSpecificData {
    /*
     * Table of all reflected channels owned by this thread. This is the
     * per-thread version of the per-interpreter map.
     */

    ReflectedChannelMap *rcmPtr;
    ReflectedChannelMap* rcmPtr;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * List of forwarded operations which have not completed yet, plus the mutex
 * to protect the access to this process global list.
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
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







-
-
+
+




-
-
+
+


-
-
-
-
+
+
+
+





-
-
+
+


-
-
+
+





-
+







 * (which executes the appropriate function and collects the result, if any).
 *
 * The ExitProc ensures that things do not deadlock when the sending thread
 * involved in the forwarding exits. It also clean things up so that we don't
 * leak resources when threads go away.
 */

static void		ForwardOpToHandlerThread(ReflectedChannel *rcPtr,
			    ForwardedOperation op, const void *param);
static void		ForwardOpToOwnerThread(ReflectedChannel *rcPtr,
			    ForwardedOperation op, const VOID *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(ClientData clientData);

#define FreeReceivedError(p) \
	if ((p)->base.mustFree) {                               \
	    Tcl_Free((p)->base.msgStr);                           \
	if ((p)->base.mustFree) { \
	    ckfree((p)->base.msgStr); \
	}
#define PassReceivedErrorInterp(i,p) \
	if ((i) != NULL) {                                      \
	    Tcl_SetChannelErrorInterp((i),                      \
		    Tcl_NewStringObj((p)->base.msgStr, -1));    \
	}                                                       \
	if ((i) != NULL) { \
	    Tcl_SetChannelErrorInterp((i), \
		    Tcl_NewStringObj((p)->base.msgStr, -1)); \
	} \
	FreeReceivedError(p)
#define PassReceivedError(c,p) \
	Tcl_SetChannelError((c), Tcl_NewStringObj((p)->base.msgStr, -1)); \
	FreeReceivedError(p)
#define ForwardSetStaticError(p,emsg) \
	(p)->base.code = TCL_ERROR;                             \
	(p)->base.mustFree = 0;                                 \
	(p)->base.code = TCL_ERROR; \
	(p)->base.mustFree = 0; \
	(p)->base.msgStr = (char *) (emsg)
#define ForwardSetDynamicError(p,emsg) \
	(p)->base.code = TCL_ERROR;                             \
	(p)->base.mustFree = 1;                                 \
	(p)->base.code = TCL_ERROR; \
	(p)->base.mustFree = 1; \
	(p)->base.msgStr = (char *) (emsg)

static void		ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr);

static ReflectedChannelMap *	GetThreadReflectedChannelMap(void);
static Tcl_ExitProc	DeleteThreadReflectedChannelMap;
static void		DeleteThreadReflectedChannelMap(ClientData clientData);

#endif /* TCL_THREADS */

#define SetChannelErrorStr(c,msgStr) \
	Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))

static Tcl_Obj *	MarshallError(Tcl_Interp *interp);
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
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







-
-
+
+
+
-












-
+







static Tcl_Obj *	NextHandle(void);
static void		FreeReflectedChannel(ReflectedChannel *rcPtr);
static int		InvokeTclMethod(ReflectedChannel *rcPtr,
			    MethodName method, Tcl_Obj *argOneObj,
			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);

static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
static Tcl_InterpDeleteProc	DeleteReflectedChannelMap;
static int		ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj *resObj);
static void		DeleteReflectedChannelMap(ClientData clientData,
			    Tcl_Interp *interp);
static int              ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);
static void		MarkDead(ReflectedChannel *rcPtr);

/*
 * Global constant strings (messages). ==================
 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#if TCL_THREADS
#ifdef TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost    = "{Owner lost}";
static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";

/*
 * Main methods to plug into the 'chan' ensemble'. ==================
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
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







-
+




















-
-
+
-
-
-
+
+







 *	Creates a new channel.
 *
 *----------------------------------------------------------------------
 */

int
TclChanCreateObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    ReflectedChannel *rcPtr;	/* Instance data of the new channel */
    Tcl_Obj *rcId;		/* Handle of the new channel */
    int mode;			/* R/W mode of new channel. Has to match
				 * abilities of handler commands */
    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
    Tcl_Obj *cmdNameObj;	/* Command name */
    Tcl_Channel chan;		/* Token for the new channel */
    Tcl_Obj *modeObj;		/* mode in obj form for method call */
    int listc;			/* Result of 'initialize', and of */
    Tcl_Obj **listv;		/* its sublist in the 2nd element */
    int methIndex;		/* Encoded method name */
    int result;			/* Result code for 'initialize' */
    Tcl_Obj *resObj;		/* Result data for 'initialize' */
    int methods;		/* Bitmask for supported methods. */
    Channel *chanPtr;		/* 'chan' resolved to internal struct. */
    Tcl_Obj *err;		/* Error message */
    ReflectedChannelMap *rcmPtr;
				/* Map of reflected channels with handlers in
    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
				 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    int isNew;			/* Placeholder. */
    Tcl_HashEntry* hPtr;         /* Entry in the above map */
    int isNew;                   /* Placeholder. */

    /*
     * Syntax:   chan create MODE CMDPREFIX
     *           [0]  [1]    [2]  [3]
     *
     * Actually: rCreate MODE CMDPREFIX
     *           [0]     [1]  [2]
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
512
513
514
515
516
517
518

519
520
521
522
523
524
525







-







    }

    /*
     * First argument is a list of modes. Allowed entries are "read", "write".
     * Expect at least one list element. Abbreviations are ok.
     */

    modeObj = objv[MODE];
    if (EncodeEventMask(interp, "mode", objv[MODE], &mode) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Second argument is command prefix, i.e. list of words, first word is
     * name of handler command, other words are fixed arguments. Run the
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
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







-














+
+
+
+
-
+
-
-







     * handler, and the handler is not specified to handle such.
     */

    modeObj = DecodeEventMask(mode);
    /* assert modeObj.refCount == 1 */
    result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
    Tcl_DecrRefCount(modeObj);

    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	goto error;
    }

    /*
     * Verify the result.
     * - List, of method names. Convert to mask.
     *   Check for non-optionals through the mask.
     *   Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
	TclNewLiteralStringObj(err, "chan handler \"");
	Tcl_AppendObjToObj(err, cmdObj);
	Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
	Tcl_AppendObjToObj(err, resObj);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, err);
                "chan handler \"%s initialize\" returned non-list: %s",
                TclGetString(cmdObj), TclGetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
621
622
623
624
625
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
596
597
598
599
600
601
602
603
604
605

606


607
608
609
610
611
612
613

614


615
616
617
618
619
620
621

622


623
624
625
626
627
628
629

630


631
632
633
634
635
636
637

638


639
640
641
642
643
644
645







+
+
+
-
+
-
-




+
+
+
-
+
-
-




+
+
+
-
+
-
-




+
+
+
-
+
-
-




+
+
+
-
+
-
-








	methods |= FLAG(methIndex);
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
	TclNewLiteralStringObj(err, "chan handler \"");
	Tcl_AppendObjToObj(err, cmdObj);
	Tcl_AppendToObj(err, "\" does not support all required methods", -1);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, err);
                "chan handler \"%s\" does not support all required methods",
                TclGetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
	TclNewLiteralStringObj(err, "chan handler \"");
	Tcl_AppendObjToObj(err, cmdObj);
	Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, err);
                "chan handler \"%s\" lacks a \"read\" method",
                TclGetString(cmdObj)));
	goto error;
    }

    if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
	TclNewLiteralStringObj(err, "chan handler \"");
	Tcl_AppendObjToObj(err, cmdObj);
	Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, err);
                "chan handler \"%s\" lacks a \"write\" method",
                TclGetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
	TclNewLiteralStringObj(err, "chan handler \"");
	Tcl_AppendObjToObj(err, cmdObj);
	Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, err);
                "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
                TclGetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
	TclNewLiteralStringObj(err, "chan handler \"");
	Tcl_AppendObjToObj(err, cmdObj);
	Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, err);
                "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
                TclGetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
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
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
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







-
+
+














+













-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

-
-
+
+







-
+
-


-
+



-
+







    if ((methods & NULLABLE_METHODS) != NULLABLE_METHODS) {
	/*
	 * Some of the nullable methods are not supported. We clone the
	 * channel type, null the associated C functions, and use the result
	 * as the actual channel type.
	 */

	Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)Tcl_Alloc(sizeof(Tcl_ChannelType));
	Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)
		ckalloc(sizeof(Tcl_ChannelType));

	memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));

	if (!(methods & FLAG(METH_CONFIGURE))) {
	    clonePtr->setOptionProc = NULL;
	}

	if (!(methods & FLAG(METH_CGET)) && !(methods & FLAG(METH_CGETALL))) {
	    clonePtr->getOptionProc = NULL;
	}
	if (!(methods & FLAG(METH_BLOCKING))) {
	    clonePtr->blockModeProc = NULL;
	}
	if (!(methods & FLAG(METH_SEEK))) {
	    clonePtr->seekProc = NULL;
	    clonePtr->wideSeekProc = NULL;
	}

	chanPtr->typePtr = clonePtr;
    }

    /*
     * Register the channel in the I/O system, and in our our map for 'chan
     * postevent'.
     */

    Tcl_RegisterChannel(interp, chan);

    rcmPtr = GetReflectedChannelMap(interp);
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
    }
    rcmPtr = GetReflectedChannelMap (interp);
    hPtr   = Tcl_CreateHashEntry(&rcmPtr->map,
				 chanPtr->state->channelName, &isNew);
    if (!isNew) {
	if (chanPtr != Tcl_GetHashValue(hPtr)) {
	    Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
	}
    }
    Tcl_SetHashValue(hPtr, chan);
#if TCL_THREADS
#ifdef TCL_THREADS
    rcmPtr = GetThreadReflectedChannelMap();
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    hPtr   = Tcl_CreateHashEntry(&rcmPtr->map,
				 chanPtr->state->channelName, &isNew);
    Tcl_SetHashValue(hPtr, chan);
#endif

    /*
     * Return handle as result of command.
     */

    Tcl_SetObjResult(interp,
    Tcl_SetObjResult(interp, rcId);
            Tcl_NewStringObj(chanPtr->state->channelName, -1));
    return TCL_OK;

  error:
 error:
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    Tcl_Free(rcPtr);
    ckfree((char*) rcPtr);
    return TCL_ERROR;

#undef MODE
#undef CMD
}

/*
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
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+





-
-


















-
+
-
-
+

















-
-
+
+


-
-
+
+





-
+
-

-
+

-
+










-
+












-
+


-
+


-
+
















-
-
+
+
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+







 * Side effects:
 *	Posts events to a reflected channel, invokes event handlers. The
 *	latter implies that arbitrary side effects are possible.
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
typedef struct {
    Tcl_Event header;
    ReflectedChannel *rcPtr;
    int events;
} ReflectEvent;

static int
ReflectEventRun(
    Tcl_Event *ev,
    TCL_UNUSED(int) /*flags*/)
{
    /* OWNER thread
     *
     * Note: When the channel is closed any pending events of this type are
     * deleted. See ReflectClose() for the Tcl_DeleteEvents() calls
     * accomplishing that.
     */

    ReflectEvent *e = (ReflectEvent *) ev;

    Tcl_NotifyChannel(e->rcPtr->chan, e->events);
    return 1;
}

static int
ReflectEventDelete(
    Tcl_Event *ev,
    ClientData cd)
{
    /* OWNER thread
     *
     * Invoked by DeleteThreadReflectedChannelMap() and ReflectClose(). The
     * latter ensures that no pending events of this type are run on an
     * invalid channel.
     */

    ReflectEvent *e = (ReflectEvent *) ev;

    if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) {
        return 0;
    }
    return 1;
}
#endif

int
TclChanPostEventObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    /*
     * Ensure -> HANDLER thread
     *
     * Syntax:   chan postevent CHANNEL EVENTSPEC
     *           [0]  [1]       [2]     [3]
     *
     * Actually: rPostevent CHANNEL EVENTSPEC
     *           [0]        [1]     [2]
     *
     * where EVENTSPEC = {read write ...} (Abbreviations allowed as well).
     */

#define CHAN	(1)
#define EVENT	(2)

    const char *chanId;		/* Tcl level channel handle */
    Tcl_Channel chan;		/* Channel associated to the handle */
    const Tcl_ChannelType *chanTypePtr;
				/* Its associated driver structure */
    ReflectedChannel *rcPtr;	/* Associated instance data */
    int events;			/* Mask of events to post */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
				 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    Tcl_HashEntry* hPtr;         /* Entry in the above map */

    /*
     * Number of arguments...
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel eventspec");
	return TCL_ERROR;
    }

    /*
     * First argument is a channel, a reflected channel, and the call of this
     * command is done from the interp defining the channel handler cmd.
     */

    chanId = TclGetString(objv[CHAN]);

    rcmPtr = GetReflectedChannelMap(interp);
    hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId);
    rcmPtr = GetReflectedChannelMap (interp);
    hPtr = Tcl_FindHashEntry (&rcmPtr->map, chanId);

    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can not find reflected channel named \"%s\"", chanId));
	Tcl_AppendResult(interp, "can not find reflected channel named \"", chanId,
		"\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, NULL);
	return TCL_ERROR;
    }

    /*
     * Note that the search above subsumes several of the older checks,
     * Note that the search above subsumes several of the older checks, namely:
     * namely:
     *
     * (1) Does the channel handle refer to a reflected channel?
     * (1) Does the channel handle refer to a reflected channel ?
     * (2) Is the post event issued from the interpreter holding the handler
     *     of the reflected channel?
     *     of the reflected channel ?
     *
     * A successful search answers yes to both. Because the map holds only
     * handles of reflected channels, and only of such whose handler is
     * defined in this interpreter.
     *
     * We keep the old checks for both, for paranioa, but abort now instead of
     * throwing errors, as failure now means that our internal datastructures
     * have gone seriously haywire.
     */

    chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
    chan        = Tcl_GetHashValue(hPtr);
    chanTypePtr = Tcl_GetChannelType(chan);

    /*
     * We use a function referenced by the channel type as our cookie to
     * detect calls to non-reflecting channels. The channel type itself is not
     * suitable, as it might not be the static definition in this file, but a
     * clone thereof. And while we have reserved the name of the type nothing
     * in the core checks against violation, so someone else might have
     * created a channel type using our name, clashing with ourselves.
     */

    if (chanTypePtr->watchProc != &ReflectWatch) {
	Tcl_Panic("TclChanPostEventObjCmd: channel is not a reflected channel");
	Tcl_Panic ("TclChanPostEventObjCmd: channel is not a reflected channel");
    }

    rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
    rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);

    if (rcPtr->interp != interp) {
	Tcl_Panic("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
	Tcl_Panic ("TclChanPostEventObjCmd: postevent accepted for call from outside interpreter");
    }

    /*
     * Second argument is a list of events. Allowed entries are "read",
     * "write". Expect at least one list element. Abbreviations are ok.
     */

    if (EncodeEventMask(interp, "event", objv[EVENT], &events) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Check that the channel is actually interested in the provided events.
     */

    if (events & ~rcPtr->interest) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "tried to post events channel \"%s\" is not interested in",
	Tcl_AppendResult(interp, "tried to post events channel \"", chanId,
		"\" is not interested in", NULL);
                chanId));
	return TCL_ERROR;
    }

    /*
     * We have the channel and the events to post.
     */

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
	if (events & TCL_READABLE) {
	    if (rcPtr->readTimer == NULL) {
		rcPtr->readTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunRead, rcPtr);
	    }
	}
	if (events & TCL_WRITABLE) {
	    if (rcPtr->writeTimer == NULL) {
		rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
			TimerRunWrite, rcPtr);
	    }
	}
#if TCL_THREADS
    } else {
        ReflectEvent *ev = (ReflectEvent *)Tcl_Alloc(sizeof(ReflectEvent));

    Tcl_NotifyChannel(chan, events);
        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

        /*
         * We are not preserving the structure here. When the channel is
         * closed any pending events are deleted, see ReflectClose(), and
         * ReflectEventDelete(). Trying to preserve and later release when the
         * event is run may generate a situation where the channel structure
         * is deleted but not our structure, crashing in
         * FreeReflectedChannel().
         *
         * Force creation of the RCM, for proper cleanup on thread teardown.
         * The teardown of unprocessed events is currently coupled to the
         * thread reflected channel map
         */

        (void) GetThreadReflectedChannelMap();

        /*
         * XXX Race condition !!
         * XXX The destination thread may not exist anymore already.
         * XXX (Delayed postevent executed after channel got removed).
         * XXX Can we detect this ? (check the validity of the owner threadid ?)
         * XXX Actually, in that case the channel should be dead also !
         */

        Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL);
        Tcl_ThreadAlert(rcPtr->owner);
    }
#endif

    /*
     * Squash interp results left by the event script.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;

#undef CHAN
#undef EVENT
}

static void
TimerRunRead(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    rcPtr->readTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_READABLE);
}

static void
TimerRunWrite(
    ClientData clientData)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    rcPtr->writeTimer = NULL;
    Tcl_NotifyChannel(rcPtr->chan, TCL_WRITABLE);
}

/*
 * Channel error message marshalling utilities.
 */

static Tcl_Obj *
static Tcl_Obj*
MarshallError(
    Tcl_Interp *interp)
{
    /*
     * Capture the result status of the interpreter into a string. => List of
     * options and values, followed by the error message. The result has
     * refCount 0.
1059
1060
1061
1062
1063
1064
1065
1066

1067
1068
1069
1070
1071
1072
1073
924
925
926
927
928
929
930

931
932
933
934
935
936
937
938







-
+







    numOptions = lc - explicitResult;

    if (explicitResult) {
	Tcl_SetObjResult(interp, lv[lc-1]);
    }

    (void) Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
    ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED;
    ((Interp *)interp)->flags &= ~ERR_ALREADY_LOGGED;
}

int
TclChanCaughtErrorBypass(
    Tcl_Interp *interp,
    Tcl_Channel chan)
{
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
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
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074

1075
1076
1077



1078
1079
1080
1081


1082
1083
1084
1085
1086
1087
1088







-
+
-

-
+


-
+
-
-
-
+
+
-
-
-
-













-
-
+
+
-


-
+



-
+


-
-
-
+
+
+
+
-
-




+





-
+


-
-
-
-
-
-
-
+







-
+



-
+


-
-
-
+
+
+
+
-
-







 *
 *----------------------------------------------------------------------
 */

static int
ReflectClose(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_Interp *interp)
	int flags)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
    int result;			/* Result code for 'close' */
    Tcl_Obj *resObj;		/* Result data for 'close' */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
				 * this interp */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    const Tcl_ChannelType *tctPtr;
    Tcl_HashEntry* hPtr;         /* Entry in the above map */
    Tcl_ChannelType *tctPtr;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    if (TclInThreadExit()) {
	/*
	 * This call comes from TclFinalizeIOSystem. There are no
	 * interpreters, and therefore we cannot call upon the handler command
	 * anymore. Threading is irrelevant as well. We simply clean up all
	 * our C level data structures and leave the Tcl level to the other
	 * finalization functions.
	 */

	/*
	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedChannelMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * Note: DeleteThreadReflectedChannelMap() is the thread exit handler for the origin
	 * thread. Use this to clean up the structure? Except if lost?
	 * if lost?
	 */

#if TCL_THREADS
#ifdef TCL_THREADS
	if (rcPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	    ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
	    result = p.base.code;

            /*
             * Now squash the pending reflection events for this channel.
             */
	    /*
	     * FreeReflectedChannel is done in the forwarded operation!, in
	     * the other thread. rcPtr here is gone!
	     */

            Tcl_DeleteEvents(ReflectEventDelete, rcPtr);

	    if (result != TCL_OK) {
		FreeReceivedError(&p);
	    }
	    return EOK;
	}
#endif

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    Tcl_Free((void *)tctPtr);
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
	if (rcPtr->readTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->readTimer);
	}
	if (rcPtr->writeTimer != NULL) {
	    Tcl_DeleteTimerHandler(rcPtr->writeTimer);
	}
        Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	ForwardOpToOwnerThread(rcPtr, ForwardedClose, &p);
	result = p.base.code;

        /*
         * Now squash the pending reflection events for this channel.
         */
	/*
	 * FreeReflectedChannel is done in the forwarded operation!, in the
	 * other thread. rcPtr here is gone!
	 */

        Tcl_DeleteEvents(ReflectEventDelete, rcPtr);

	if (result != TCL_OK) {
	    PassReceivedErrorInterp(interp, &p);
	}
    } else {
#endif
	result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
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
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
1140
1141







-
-
-
-
+
+
+
+

-
+


-
-
-
-
+
+
+
+

-
+

-

+
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+
-
-
-







	 * when the channel was created in a different interpreter and/or
	 * thread and then was moved here.
	 *
	 * NOTE: The channel may have been removed from the map already via
	 * the per-interp DeleteReflectedChannelMap exit-handler.
	 */

	if (!rcPtr->dead) {
	    rcmPtr = GetReflectedChannelMap(rcPtr->interp);
	    hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		    Tcl_GetChannelName(rcPtr->chan));
	if (rcPtr->interp) {
	    rcmPtr = GetReflectedChannelMap (rcPtr->interp);
	    hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				      Tcl_GetChannelName (rcPtr->chan));
	    if (hPtr) {
		Tcl_DeleteHashEntry(hPtr);
		Tcl_DeleteHashEntry (hPtr);
	    }
	}
#if TCL_THREADS
	rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		Tcl_GetChannelName(rcPtr->chan));
#ifdef TCL_THREADS
        rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				  Tcl_GetChannelName (rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	    Tcl_DeleteHashEntry (hPtr);
	}
    }
#endif

    tctPtr = ((Channel *)rcPtr->chan)->typePtr;
    if (tctPtr && tctPtr != &tclRChannelType) {
	Tcl_Free((void *)tctPtr);
	((Channel *)rcPtr->chan)->typePtr = NULL;
    }
    if (rcPtr->readTimer != NULL) {
	Tcl_DeleteTimerHandler(rcPtr->readTimer);
	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
#ifdef TCL_THREADS
    }
    if (rcPtr->writeTimer != NULL) {
#endif
	Tcl_DeleteTimerHandler(rcPtr->writeTimer);
    }
    Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
    return (result == TCL_OK) ? EOK : EINVAL;
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectInput --
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
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
1385
1386
1387
1388
1389
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







-
+

-
+







-
+






-
+



-
-
+
-
-





-
+













-
+



-
+










-
+

-
+

-
+




-
-
+
+







static int
ReflectInput(
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
    Tcl_Obj *toReadObj;
    size_t bytec = 0;		/* Number of returned bytes */
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.input.buf = buf;
	p.input.toRead = toRead;

	ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
	ForwardOpToOwnerThread(rcPtr, ForwardedInput, &p);

	if (p.base.code != TCL_OK) {
	    if (p.base.code < 0) {
		/*
		 * No error message, this is an errno signal.
		/* No error message, this is an errno signal. */
		 */

		*errorCodePtr = -p.base.code;
	    } else {
		PassReceivedError(rcPtr->chan, &p);
		*errorCodePtr = EINVAL;
	    }
	    p.input.toRead = TCL_INDEX_NONE;
	    p.input.toRead = -1;
	} else {
	    *errorCodePtr = EOK;
	}

	return p.input.toRead;
    }
#endif

    /* ASSERT: rcPtr->method & FLAG(METH_READ) */
    /* ASSERT: rcPtr->mode & TCL_READABLE */

    Tcl_Preserve(rcPtr);

    TclNewIntObj(toReadObj, toRead);
    toReadObj = Tcl_NewIntObj(toRead);
    Tcl_IncrRefCount(toReadObj);

    if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
	int code = ErrnoReturn(rcPtr, resObj);
	int code = ErrnoReturn (rcPtr, resObj);

	if (code < 0) {
	    *errorCodePtr = -code;
            goto error;
	}

	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    bytev = TclGetByteArrayFromObj(resObj, &bytec);
    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

    if ((size_t)toRead < bytec) {
    if (toRead < bytec) {
	SetChannelErrorStr(rcPtr->chan, msg_read_toomuch);
	goto invalid;
        goto invalid;
    }

    *errorCodePtr = EOK;

    if (bytec + 1 > 1) {
	memcpy(buf, bytev, bytec);
    if (bytec > 0) {
	memcpy(buf, bytev, (size_t)bytec);
    }

 stop:
    Tcl_DecrRefCount(toReadObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
    return bytec;
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
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







-
+








-
+






-
+



-
-
+
-
-







static int
ReflectOutput(
    ClientData clientData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;		/* Result data for 'write' */
    int written;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.output.buf = buf;
	p.output.toWrite = toWrite;

	ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
	ForwardOpToOwnerThread(rcPtr, ForwardedOutput, &p);

	if (p.base.code != TCL_OK) {
	    if (p.base.code < 0) {
		/*
		 * No error message, this is an errno signal.
		/* No error message, this is an errno signal. */
		 */

		*errorCodePtr = -p.base.code;
	    } else {
                PassReceivedError(rcPtr->chan, &p);
                *errorCodePtr = EINVAL;
            }
	    p.output.toWrite = -1;
	} else {
1487
1488
1489
1490
1491
1492
1493
1494
1495


1496
1497
1498
1499
1500
1501
1502
1329
1330
1331
1332
1333
1334
1335


1336
1337
1338
1339
1340
1341
1342
1343
1344







-
-
+
+







    if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;
    }

    if ((written == 0) && (toWrite > 0)) {
	/*
	 * The handler claims to have written nothing of what it was given.
	 * That is bad.
	 * The handler claims to have written nothing of what it was
	 * given. That is bad.
	 */

	SetChannelErrorStr(rcPtr->chan, msg_write_nothing);
        goto invalid;
    }
    if (toWrite < written) {
	/*
1542
1543
1544
1545
1546
1547
1548
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
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
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
1439
1440

1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482







-
+








-
+






-
+

















-
-
+
+
-
-
+













-
+
















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







static Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
    Tcl_Obj *offObj, *baseObj;
    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.seek.seekMode = seekMode;
	p.seek.offset = offset;

	ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
	ForwardOpToOwnerThread(rcPtr, ForwardedSeek, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rcPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    p.seek.offset = -1;
	} else {
	    *errorCodePtr = EOK;
	}

	return p.seek.offset;
    }
#endif

    /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */

    Tcl_Preserve(rcPtr);

    TclNewIntObj(offObj, offset);
    baseObj = Tcl_NewStringObj(
    offObj = Tcl_NewWideIntObj(offset);
    baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
            (seekMode == SEEK_SET) ? "start" :
            (seekMode == SEEK_CUR) ? "current" : "end", -1);
	    ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
    Tcl_IncrRefCount(offObj);
    Tcl_IncrRefCount(baseObj);

    if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;
    }

    if (newLoc < 0) {
    if (newLoc < Tcl_LongAsWide(0)) {
	SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
        goto invalid;
    }

    *errorCodePtr = EOK;
 stop:
    Tcl_DecrRefCount(offObj);
    Tcl_DecrRefCount(baseObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_Release(rcPtr);
    return newLoc;
 invalid:
    *errorCodePtr = EINVAL;
    newLoc = -1;
    goto stop;
}

static int
ReflectSeek(
    ClientData clientData,
    long offset,
    int seekMode,
    int *errorCodePtr)
{
    /*
     * This function can be invoked from a transformation which is based on
     * standard seeking, i.e. non-wide. Because of this we have to implement
     * it, a dummy is not enough. We simply delegate the call to the wide
     * routine.
     */

    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
	    errorCodePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
 *
 *	This function is invoked to tell the channel what events the I/O
1633
1634
1635
1636
1637
1638
1639
1640

1641
1642
1643
1644
1645
1646
1647
1492
1493
1494
1495
1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1506







-
+







 */

static void
ReflectWatch(
    ClientData clientData,
    int mask)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
    Tcl_Obj *maskObj;

    /*
     * We restrict the interest to what the channel can support. IOW there
     * will never be write events for a channel which is not writable.
     * Analoguously for read events and non-readable channels.
     */
1656
1657
1658
1659
1660
1661
1662
1663

1664
1665
1666
1667
1668

1669
1670
1671
1672
1673
1674
1675
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526

1527
1528
1529
1530
1531
1532
1533
1534







-
+




-
+







	return;
    }

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.watch.mask = mask;
	ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);
	ForwardOpToOwnerThread(rcPtr, ForwardedWatch, &p);

	/*
	 * Any failure from the forward is ignored. We have no place to put
	 * this.
	 */

	return;
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
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
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







-
+








-
+





-
+















-
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 */

static int
ReflectBlock(
    ClientData clientData,
    int nonblocking)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
    Tcl_Obj *blockObj;
    int errorNum;		/* EINVAL or EOK (success). */
    Tcl_Obj *resObj;		/* Result data for 'blocking' */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.block.nonblocking = nonblocking;

	ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);
	ForwardOpToOwnerThread(rcPtr, ForwardedBlock, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rcPtr->chan, &p);
	    return EINVAL;
	}

	return EOK;
    }
#endif

    blockObj = Tcl_NewBooleanObj(!nonblocking);
    Tcl_IncrRefCount(blockObj);

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr,METH_BLOCKING,blockObj,NULL,&resObj)!=TCL_OK) {
    if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
	errorNum = EINVAL;
    } else {
	errorNum = EOK;
    }

    Tcl_DecrRefCount(blockObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */

    Tcl_Release(rcPtr);
    return errorNum;
}

#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * ReflectThread --
 *
 *	This function is invoked to tell the channel about thread movements.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static void
ReflectThread(
    ClientData clientData,
    int action)
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;

    switch (action) {
    case TCL_CHANNEL_THREAD_INSERT:
        rcPtr->owner = Tcl_GetCurrentThread();
        break;
    case TCL_CHANNEL_THREAD_REMOVE:
        rcPtr->owner = NULL;
        break;
    default:
        Tcl_Panic("Unknown thread action code.");
        break;
    }
}

#endif
/*
 *----------------------------------------------------------------------
 *
 * ReflectSetOption --
 *
 *	This function is invoked to configure a channel option.
 *
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
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







-
+








-
+






-
+







static int
ReflectSetOption(
    ClientData clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of requested option */
    const char *newValue)	/* The new value */
{
    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel *) clientData;
    Tcl_Obj *optionObj, *valueObj;
    int result;			/* Result code for 'configure' */
    Tcl_Obj *resObj;		/* Result data for 'configure' */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.setOpt.name = optionName;
	p.setOpt.value = newValue;

	ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
	ForwardOpToOwnerThread(rcPtr, ForwardedSetOpt, &p);

	if (p.base.code != TCL_OK) {
	    Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);

	    UnmarshallErrorResult(interp, err);
	    Tcl_DecrRefCount(err);
	    FreeReceivedError(&p);
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
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







-
+










-
+

-
+











-
+







    Tcl_DString *dsPtr)		/* String to place the result into */
{
    /*
     * This code is special. It has regular passing of Tcl result, and errors.
     * The bypass functions are not required.
     */

    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
    ReflectedChannel *rcPtr = (ReflectedChannel*) clientData;
    Tcl_Obj *optionObj;
    Tcl_Obj *resObj;		/* Result data for 'configure' */
    int listc, result = TCL_OK;
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardedOperation opcode;
	int opcode;
	ForwardParam p;

	p.getOpt.name = optionName;
	p.getOpt.value = dsPtr;

	if (optionName == NULL) {
	    opcode = ForwardedGetOptAll;
	} else {
	    opcode = ForwardedGetOpt;
	}

	ForwardOpToHandlerThread(rcPtr, opcode, &p);
	ForwardOpToOwnerThread(rcPtr, opcode, &p);

	if (p.base.code != TCL_OK) {
	    Tcl_Obj *err = Tcl_NewStringObj(p.base.msgStr, -1);

	    UnmarshallErrorResult(interp, err);
	    Tcl_DecrRefCount(err);
	    FreeReceivedError(&p);
1957
1958
1959
1960
1961
1962
1963
1964

1965
1966
1967
1968
1969
1970
1971
1778
1779
1780
1781
1782
1783
1784

1785
1786
1787
1788
1789
1790
1791
1792







-
+








    /*
     * The result has to go into the 'dsPtr' for propagation to the caller of
     * the driver.
     */

    if (optionObj != NULL) {
	TclDStringAppendObj(dsPtr, resObj);
	Tcl_DStringAppend(dsPtr, TclGetString(resObj), -1);
        goto ok;
    }

    /*
     * Extract the list and append each item as element.
     */

1988
1989
1990
1991
1992
1993
1994
1995
1996


1997
1998
1999

2000
2001
2002
2003
2004
2005
2006
1809
1810
1811
1812
1813
1814
1815


1816
1817
1818
1819

1820
1821
1822
1823
1824
1825
1826
1827







-
-
+
+


-
+







	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Expected list with even number of "
		"elements, got %d element%s instead", listc,
		(listc == 1 ? "" : "s")));
        goto error;
    } else {
	size_t len;
	const char *str = TclGetStringFromObj(resObj, &len);
	int len;
	char *str = Tcl_GetStringFromObj(resObj, &len);

	if (len) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    Tcl_DStringAppend(dsPtr, " ", 1);
	    Tcl_DStringAppend(dsPtr, str, len);
	}
        goto ok;
    }

 ok:
    result = TCL_OK;
2056
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
2071
1877
1878
1879
1880
1881
1882
1883

1884

1885
1886
1887
1888
1889
1890
1891







-
+
-







				 * list. */

    if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) {
	return TCL_ERROR;
    }

    if (listc < 1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_AppendResult(interp, "bad ", objName, " list: is empty", NULL);
                "bad %s list: is empty", objName));
	return TCL_ERROR;
    }

    events = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], eventOptions,
		objName, 0, &evIndex) != TCL_OK) {
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
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







-
+













-
+



















-







 *----------------------------------------------------------------------
 *
 * DecodeEventMask --
 *
 *	This function takes an internal bitmask of events and constructs the
 *	equivalent list of event items.
 *
 * Results, Contract:
 * Results:
 *	A Tcl_Obj reference. The object will have a refCount of one. The user
 *	has to decrement it to release the object.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
DecodeEventMask(
    int mask)
{
    const char *eventStr;
    register const char *eventStr;
    Tcl_Obj *evObj;

    switch (mask & RANDW) {
    case RANDW:
	eventStr = "read write";
	break;
    case TCL_READABLE:
	eventStr = "read";
	break;
    case TCL_WRITABLE:
	eventStr = "write";
	break;
    default:
	eventStr = "";
	break;
    }

    evObj = Tcl_NewStringObj(eventStr, -1);
    Tcl_IncrRefCount(evObj);
    /* assert evObj.refCount == 1 */
    return evObj;
}

/*
 *----------------------------------------------------------------------
 *
 * NewReflectedChannel --
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
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







-
+

-
+





-
-
-
-
+









-
+







NewReflectedChannel(
    Tcl_Interp *interp,
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;
    int mn = 0;
    MethodName mn = METH_BLOCKING;

    rcPtr = (ReflectedChannel *)Tcl_Alloc(sizeof(ReflectedChannel));
    rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
    rcPtr->readTimer = 0;
    rcPtr->writeTimer = 0;
#if TCL_THREADS
#ifdef TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= (int)METH_WRITE) {
    while (mn <= METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
		Tcl_NewStringObj(methodNames[mn++], -1));
    }
    Tcl_IncrRefCount(rcPtr->methods);
    rcPtr->name = handleObj;
    Tcl_IncrRefCount(rcPtr->name);
    return rcPtr;
2233
2234
2235
2236
2237
2238
2239
2240
2241

2242
2243
2244

2245
2246
2247

2248
2249

2250
2251
2252
2253
2254
2255
2256
2049
2050
2051
2052
2053
2054
2055


2056



2057



2058


2059
2060
2061
2062
2063
2064
2065
2066







-
-
+
-
-
-
+
-
-
-
+
-
-
+







static void
FreeReflectedChannel(
    ReflectedChannel *rcPtr)
{
    Channel *chanPtr = (Channel *) rcPtr->chan;

    TclChannelRelease((Tcl_Channel)chanPtr);
    if (rcPtr->name) {
	Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->name);
    }
    if (rcPtr->methods) {
	Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->methods);
    }
    if (rcPtr->cmd) {
	Tcl_DecrRefCount(rcPtr->cmd);
    Tcl_DecrRefCount(rcPtr->cmd);
    }
    Tcl_Free(rcPtr);
    ckfree((char*) rcPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
2283
2284
2285
2286
2287
2288
2289
2290

2291
2292
2293
2294
2295
2296
2297
2093
2094
2095
2096
2097
2098
2099

2100
2101
2102
2103
2104
2105
2106
2107







-
+







{
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
    Tcl_Obj *cmd;

    if (rcPtr->dead) {
    if (!rcPtr->interp) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

	if (resultObjPtr != NULL) {
	    resObj = Tcl_NewStringObj(msg_dstlost,-1);
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
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







-
-
-

















-
+







    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
    Tcl_ListObjAppendElement(NULL, cmd, methObj);
    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.
     *
     * Because of the contract there is no need to increment the refcounts.
     * The objects will survive the Tcl_EvalObjv without change.
     */

    if (argOneObj) {
	Tcl_ListObjAppendElement(NULL, cmd, argOneObj);
	if (argTwoObj) {
	    Tcl_ListObjAppendElement(NULL, cmd, argTwoObj);
	}
    }

    /*
     * And run the handler... This is done in auch a manner which leaves any
     * existing state intact.
     */

    Tcl_IncrRefCount(cmd);
    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
    Tcl_Preserve(rcPtr->interp);
    result = Tcl_EvalObjEx(rcPtr->interp, cmd, TCL_EVAL_GLOBAL);
    result = Tcl_GlobalEvalObj(rcPtr->interp, cmd);

    /*
     * We do not try to extract the result information if the caller has no
     * interest in it. I.e. there is no need to put effort into creating
     * something which is discarded immediately after.
     */

2363
2364
2365
2366
2367
2368
2369
2370
2371


2372
2373
2374
2375
2376
2377
2378
2170
2171
2172
2173
2174
2175
2176


2177
2178
2179
2180
2181
2182
2183
2184
2185







-
-
+
+







	     * the full state of the result, including additional options.
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */

	    if (result != TCL_ERROR) {
		size_t cmdLen;
		const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);
		int cmdLen;
		const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rcPtr->interp);
		Tcl_SetObjResult(rcPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
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
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







-
-
+
+





-
-
+
-




-
+








-
+
-
-
-
+
+







 * Results:
 *	The negative errno found in the error result, or 0.
 *
 * Side effects:
 *	None.
 *
 * Users:
 *	ReflectInput/Output(), to enable the signaling of EAGAIN on 0-sized
 *	short reads/writes.
 *	ReflectInput/Output(), to enable the signaling of EAGAIN
 *	on 0-sized short reads/writes.
 *
 *----------------------------------------------------------------------
 */

static int
ErrnoReturn(
    ReflectedChannel *rcPtr,
ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj)
    Tcl_Obj *resObj)
{
    int code;
    Tcl_InterpState sr;		/* State of handler interp */

    if (rcPtr->dead) {
    if (!rcPtr->interp) {
	return 0;
    }

    sr = Tcl_SaveInterpState(rcPtr->interp, 0 /* Dummy */);
    UnmarshallErrorResult(rcPtr->interp, resObj);

    resObj = Tcl_GetObjResult(rcPtr->interp);

    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
    if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK) || (code >= 0))) {
	    || (code >= 0))) {
	if (strcmp("EAGAIN", TclGetString(resObj)) == 0) {
	    code = -EAGAIN;
	if (strcmp ("EAGAIN",Tcl_GetString(resObj)) == 0) {
	    code = - EAGAIN;
	} else {
	    code = 0;
	}
    }

    Tcl_RestoreInterpState(rcPtr->interp, sr);
    return code;
2475
2476
2477
2478
2479
2480
2481
2482

2483
2484
2485

2486
2487


2488
2489
2490
2491
2492
2493
2494
2279
2280
2281
2282
2283
2284
2285

2286
2287
2288

2289
2290

2291
2292
2293
2294
2295
2296
2297
2298
2299







-
+


-
+

-
+
+







 *----------------------------------------------------------------------
 */

static ReflectedChannelMap *
GetReflectedChannelMap(
    Tcl_Interp *interp)
{
    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL);
    ReflectedChannelMap* rcmPtr = Tcl_GetAssocData(interp, RCMKEY, NULL);

    if (rcmPtr == NULL) {
	rcmPtr = (ReflectedChannelMap *)Tcl_Alloc(sizeof(ReflectedChannelMap));
	rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&rcmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RCMKEY, DeleteReflectedChannelMap, rcmPtr);
	Tcl_SetAssocData(interp, RCMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedChannelMap, rcmPtr);
    }
    return rcmPtr;
}

/*
 *----------------------------------------------------------------------
 *
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
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


2658
2659
2660
2661

2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713

2714
2715
2716
2717



2718

2719


2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730


2731
2732
2733
2734
2735
2736
2737


2738
2739
2740
2741
2742
2743

2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803





2804

2805

2806
2807
2808


2809
2810
2811
2812

2813
2814
2815

2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833

2834
2835
2836
2837
2838
2839

2840
2841
2842
2843
2844
2845
2846
2847
2848
2849


2850
2851
2852
2853
2854
2855
2856
2857
2858


2859
2860
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
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

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
2658


2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
+


-
+

+
-
+








-
+








+

-
-
-
-
+
+
+
+
+

+
-
+



-
+

-
+













-
-
+
+

-
-
+
-
-














-
-
-
-
-
-
-
-













-










-
-
-
-
+
+
+
+
+


-
-
+
-
-



-


+
+



-
+


















-
+




-
+














-
+












-
+




+
+
+
-
+

+
+









-
-
+
+





-
-
+
+
-
-
-

-
-
+
-
-














-
-
-
-
-
-
-
-













-
-
-
-
-
-
-
-
-
-









-
-
-
-
+
+
+
+
+

+
-
+


-
+
+



-
+


-
+

-
-
-
-
-











-
+





-
+








-
-
+
+







-
-
+
+










-
-
-
+
-



-
-
-
+
+
+



-
+





-
+



-
+

















-
-
+
+

















-
+

-
+





-
+


-
-
-
-
-



-
+














-
+
-
-
+







 *	Deletes the hash table of channels. May close channels. May flush
 *	output on closed channels. Removes any channeEvent handlers that were
 *	registered in this interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
MarkDead(
    ReflectedChannel *rcPtr)
{
    if (rcPtr->dead) {
	return;
    }
    if (rcPtr->name) {
	Tcl_DecrRefCount(rcPtr->name);
	rcPtr->name = NULL;
    }
    if (rcPtr->methods) {
	Tcl_DecrRefCount(rcPtr->methods);
	rcPtr->methods = NULL;
    }
    if (rcPtr->cmd) {
	Tcl_DecrRefCount(rcPtr->cmd);
	rcPtr->cmd = NULL;
    }
    rcPtr->dead = 1;
}

static void
DeleteReflectedChannelMap(
    ClientData clientData,	/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */
{
    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)clientData;
				/* The map */
    ReflectedChannelMap* rcmPtr; /* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedChannel *rcPtr;
    ReflectedChannel* rcPtr;
    Tcl_Channel chan;

#if TCL_THREADS
#ifdef TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif

    /*
     * Delete all entries. The channels may have been closed already, or will
     * be closed later, by the standard IO finalization of an interpreter
     * under destruction. Except for the channels which were moved to a
     * under destruction.  Except for the channels which were moved to a
     * different interpreter and/or thread. They do not exist from the IO
     * systems point of view and will not get closed. Therefore mark all as
     * dead so that any future access will cause a proper error. For channels
     * in a different thread we actually do the same as
     * DeleteThreadReflectedChannelMap(), just restricted to the channels of
     * this interp.
     */

    rcmPtr = clientData;
    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
	 hPtr != NULL;
	 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {

	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);

	rcPtr->interp = NULL;
	MarkDead(rcPtr);

	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rcmPtr->map);
    Tcl_Free(&rcmPtr->map);
    ckfree((char *) &rcmPtr->map);

#if TCL_THREADS
#ifdef TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this interpreter. While this is in progress we block any
     * other access to the list of pending results.
     */

    Tcl_MutexLock(&rcForwardMutex);

    for (resultPtr = forwardList;
	    resultPtr != NULL;
	    resultPtr = resultPtr->nextPtr) {
	 resultPtr != NULL;
	 resultPtr = resultPtr->nextPtr) {
	if (resultPtr->dsti != interp) {
	    /*
	     * Ignore results/events for other interpreters.
	    /* Ignore results/events for other interpreters. */
	     */

	    continue;
	}

	/*
	 * The receiver for the event exited, before processing the event. We
	 * detach the result now, wake the originator up and signal failure.
         *
         * Attention: Results may have been detached already, by either the
         * receiver, or this thread, as part of other parts in the thread
         * teardown. Such results are ignored. See ticket [b47b176adf] for the
         * identical race condition in Tcl 8.6 IORTrans.
	 */

	evPtr = resultPtr->evPtr;

	/*
	 * Basic crash safety until this routine can get revised [3411310]
	 */

	if (evPtr == NULL) {
	    continue;
	}
	paramPtr = evPtr->param;
	if (!evPtr) {
	    continue;
	}

	evPtr->resultPtr = NULL;
	resultPtr->evPtr = NULL;
	resultPtr->result = TCL_ERROR;

	ForwardSetStaticError(paramPtr, msg_send_dstlost);

	Tcl_ConditionNotify(&resultPtr->done);
    }
    Tcl_MutexUnlock(&rcForwardMutex);

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
     * through the channels and remove all which were handled by this
     * interpreter. They have already been marked as dead.
     */

    rcmPtr = GetThreadReflectedChannelMap();
    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
	 hPtr != NULL;
	 hPtr = Tcl_NextHashEntry(&hSearch)) {

	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);

	if (rcPtr->interp != interp) {
	    /*
	     * Ignore entries for other interpreters.
	    /* Ignore entries for other interpreters */
	     */

	    continue;
	}

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }

    Tcl_MutexUnlock(&rcForwardMutex);
#endif
}

#if TCL_THREADS
#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedChannelMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.
 *
 * Results:
 *	A pointer to the map created, for use by the caller.
 *
 * Side effects:
 *	Initializes the reflected channel map for a thread.
 *
 *----------------------------------------------------------------------
 */

static ReflectedChannelMap *
GetThreadReflectedChannelMap(void)
GetThreadReflectedChannelMap()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rcmPtr) {
	tsdPtr->rcmPtr = (ReflectedChannelMap *)Tcl_Alloc(sizeof(ReflectedChannelMap));
	tsdPtr->rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap));
	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
    }

    return tsdPtr->rcmPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteThreadReflectedChannelMap --
 *
 *	Deletes the channel table for a thread. This procedure is invoked when
 *	a thread is deleted. The channels have already been marked as dead, in
 *	DeleteReflectedChannelMap().
 *      DeleteReflectedChannelMap().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the hash table of channels.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteThreadReflectedChannelMap(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* The per-thread data structure. */
{
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    Tcl_ThreadId self = Tcl_GetCurrentThread();

    ReflectedChannelMap* rcmPtr; /* The map */
    Tcl_Channel chan;
    ReflectedChannelMap *rcmPtr; /* The map */
    ReflectedChannel* rcPtr;
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;

    /*
     * The origin thread for one or more reflected channels is gone.
     * NOTE: If this function is called due to a thread getting killed the
     *       per-interp DeleteReflectedChannelMap is apparently not called.
     */

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this thread. While this is in progress we block any other
     * access to the list of pending results.
     * destined for this thread. While this is in progress we block any
     * other access to the list of pending results.
     */

    Tcl_MutexLock(&rcForwardMutex);

    for (resultPtr = forwardList;
	    resultPtr != NULL;
	    resultPtr = resultPtr->nextPtr) {
	 resultPtr != NULL;
	 resultPtr = resultPtr->nextPtr) {
	ForwardingEvent *evPtr;
	ForwardParam *paramPtr;

	if (resultPtr->dst != self) {
	    /*
	     * Ignore results/events for other threads.
	    /* Ignore results/events for other threads. */
	     */

	    continue;
	}

	/*
	 * The receiver for the event exited, before processing the event. We
	 * detach the result now, wake the originator up and signal failure.
         *
         * Attention: Results may have been detached already, by either the
         * receiver, or this thread, as part of other parts in the thread
         * teardown. Such results are ignored. See ticket [b47b176adf] for the
         * identical race condition in Tcl 8.6 IORTrans.
	 */

	evPtr = resultPtr->evPtr;

	/*
	 * Basic crash safety until this routine can get revised [3411310]
	 */

	if (evPtr == NULL ) {
	    continue;
	}
	paramPtr = evPtr->param;
	if (!evPtr) {
	    continue;
	}

	evPtr->resultPtr = NULL;
	resultPtr->evPtr = NULL;
	resultPtr->result = TCL_ERROR;

	ForwardSetStaticError(paramPtr, msg_send_dstlost);

	Tcl_ConditionNotify(&resultPtr->done);
    }
    Tcl_MutexUnlock(&rcForwardMutex);

    /*
     * Run over the event queue of this thread and remove all ReflectEvent's
     * still pending. These are inbound events for reflected channels this
     * thread owns but doesn't handle. The inverse of the channel map
     * actually.
     */

    Tcl_DeleteEvents(ReflectEventDelete, NULL);

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go
     * through the channels, remove all, mark them as dead.
     */

    rcmPtr = GetThreadReflectedChannelMap();
    for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
	Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
	ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
	 hPtr != NULL;
	 hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {

	chan  = (Tcl_Channel) Tcl_GetHashValue (hPtr);
	rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan);

	rcPtr->interp = NULL;
	MarkDead(rcPtr);

	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_Free(rcmPtr);

    Tcl_MutexUnlock(&rcForwardMutex);
}

static void
ForwardOpToHandlerThread(
ForwardOpToOwnerThread(
    ReflectedChannel *rcPtr,	/* Channel instance */
    ForwardedOperation op,	/* Forwarded driver operation */
    const void *param)		/* Arguments */
    const VOID *param)		/* Arguments */
{
    /*
     * Core of the communication from OWNER to HANDLER thread. The receiver is
     * ForwardProc() below.
     */

    Tcl_ThreadId dst = rcPtr->thread;
    ForwardingEvent *evPtr;
    ForwardingResult *resultPtr;

    /*
     * We gather the lock early. This allows us to check the liveness of the
     * channel without interference from DeleteThreadReflectedChannelMap().
     */

    Tcl_MutexLock(&rcForwardMutex);

    if (rcPtr->dead) {
    if (rcPtr->interp == NULL) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error. Do not forget to unlock the mutex on this path.
	 */

	ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost);
	ForwardSetStaticError((ForwardParam *)param, msg_send_dstlost);
	Tcl_MutexUnlock(&rcForwardMutex);
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = (ForwardingEvent *)Tcl_Alloc(sizeof(ForwardingEvent));
    resultPtr = (ForwardingResult *)Tcl_Alloc(sizeof(ForwardingResult));
    evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
    resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rcPtr = rcPtr;
    evPtr->param = (ForwardParam *) param;

    resultPtr->src = Tcl_GetCurrentThread();
    resultPtr->dst = dst;
    resultPtr->src  = Tcl_GetCurrentThread();
    resultPtr->dst  = dst;
    resultPtr->dsti = rcPtr->interp;
    resultPtr->done = NULL;
    resultPtr->result = -1;
    resultPtr->evPtr = evPtr;

    /*
     * Now execute the forward.
     */

    TclSpliceIn(resultPtr, forwardList);

    /*
     * Do not unlock here. That is done by the ConditionWait.
    /* Do not unlock here. That is done by the ConditionWait */
     */

    /*
     * Ensure cleanup of the event if the origin thread exits while this event
     * is pending or in progress. Exit of the destination thread is handled by
     * DeleteThreadReflectedChannelMap(), this is set up by
     * GetThreadReflectedChannelMap(). This is what we use the 'forwardList'
     * is pending or in progress. Exitus of the destination thread is handled
     * by DeleteThreadReflectionChannelMap(), this is set up by
     * GetThreadReflectedChannelMap().  This is what we use the 'forwardList'
     * (see above) for.
     */

    Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);
    Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr);

    /*
     * Queue the event and poke the other thread's notifier.
     */

    Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
    Tcl_ThreadQueueEvent(dst, (Tcl_Event *)evPtr, TCL_QUEUE_TAIL);
    Tcl_ThreadAlert(dst);

    /*
     * (*) Block until the handler thread has either processed the transfer or
     * (*) Block until the other thread has either processed the transfer or
     * rejected it.
     */

    while (resultPtr->result < 0) {
	/*
	 * NOTE (1): Is it possible that the current thread goes away while
	 * waiting here? IOW Is it possible that "SrcExitProc" is called while
	 * we are here? See complementary note (2) in "SrcExitProc"
	 *
	 * The ConditionWait unlocks the mutex during the wait and relocks it
	 * immediately after.
	 */

	Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL);
    }

    /*
     * Unlink result from the forwarder list. No need to lock. Either still
     * locked, or locked by the ConditionWait
     * Unlink result from the forwarder list.
     * No need to lock. Either still locked, or locked by the ConditionWait
     */

    TclSpliceOut(resultPtr, forwardList);

    resultPtr->nextPtr = NULL;
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&rcForwardMutex);
    Tcl_ConditionFinalize(&resultPtr->done);

    /*
     * Kill the cleanup handler now, and the result structure as well, before
     * returning the success code.
     *
     * Note: The event structure has already been deleted.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);
    Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr);

    Tcl_Free(resultPtr);
    ckfree((char*) resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    TCL_UNUSED(int) /* mask */)
    int mask)
{
    /*
     * HANDLER thread.

     * The receiver part for the operations coming from the OWNER thread.
     * See ForwardOpToHandlerThread() for the transmitter.
     *
     * Notes regarding access to the referenced data.
     *
     * In principle the data belongs to the originating thread (see
     * evPtr->src), however this thread is currently blocked at (*), i.e.,
     * evPtr->src), however this thread is currently blocked at (*), i.e.
     * quiescent. Because of this we can treat the data as belonging to us,
     * without fear of race conditions. I.e. we can read and write as we like.
     *
     * The only thing we cannot be sure of is the resultPtr. This can be be
     * NULLed if the originating thread went away while the event is handled
     * here now.
     */

    ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
    ForwardingResult *resultPtr = evPtr->resultPtr;
    ReflectedChannel *rcPtr = evPtr->rcPtr;
    Tcl_Interp *interp = rcPtr->interp;
    ForwardParam *paramPtr = evPtr->param;
    Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
    ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in
    ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */
                                 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    Tcl_HashEntry* hPtr;         /* Entry in the above map */

    /*
     * Ignore the event if no one is waiting for its result anymore.
     */

    if (!resultPtr) {
	return 1;
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
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
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749




2750
2751
2752
2753
2754





2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769

2770



2771
2772

2773
2774

2775
2776
2777
2778
2779
2780
2781

2782
2783
2784
2785
2786
2787

2788
2789
2790

2791
2792
2793
2794

2795
2796


2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809

2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830



2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845


2846
2847



2848
2849
2850


2851
2852
2853

2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866

2867
2868
2869
2870
2871
2872
2873



2874
2875
2876
2877
2878
2879
2880
2881







+
+















-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+




-
+
-
-
-
+

-
+

-
+






-
+





-
+


-
+



-
+

-
-
+
+











-
+




















-
-
-
+














-
-
+
+
-
-
-



-
-
+
+

-
+












-
+






-
-
-
+







	 * call upon for the driver.
	 */

    case ForwardedClose: {
	/*
	 * No parameters/results.
	 */

	Tcl_ChannelType *tctPtr;

	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}

	/*
	 * Freeing is done here, in the origin thread, callback command
	 * objects belong to this thread. Deallocating them in a different
	 * thread is not allowed
	 *
	 * We remove the channel from both interpreter and thread maps before
	 * releasing the memory, to prevent future accesses (like by
	 * 'postevent') from finding and dereferencing a dangling pointer.
	 */

	rcmPtr = GetReflectedChannelMap(interp);
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
                Tcl_GetChannelName(rcPtr->chan));
	Tcl_DeleteHashEntry(hPtr);
	rcmPtr = GetReflectedChannelMap (interp);
	hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				  Tcl_GetChannelName (rcPtr->chan));
	Tcl_DeleteHashEntry (hPtr);

	rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
                Tcl_GetChannelName(rcPtr->chan));
	Tcl_DeleteHashEntry(hPtr);
	MarkDead(rcPtr);
        rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry (&rcmPtr->map,
				  Tcl_GetChannelName (rcPtr->chan));
	Tcl_DeleteHashEntry (hPtr);

	tctPtr = ((Channel *)rcPtr->chan)->typePtr;
	if (tctPtr && tctPtr != &tclRChannelType) {
	    ckfree((char *)tctPtr);
	    ((Channel *)rcPtr->chan)->typePtr = NULL;
	}
        Tcl_EventuallyFree (rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
	break;
    }

    case ForwardedInput: {
	Tcl_Obj *toReadObj;
	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);

	TclNewIntObj(toReadObj, paramPtr->input.toRead);
	Tcl_IncrRefCount(toReadObj);
        Tcl_IncrRefCount(toReadObj);

	Tcl_Preserve(rcPtr);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
	    int code = ErrnoReturn(rcPtr, resObj);
	    int code = ErrnoReturn (rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
	    paramPtr->input.toRead = TCL_IO_FAILURE;
	    paramPtr->input.toRead = -1;
	} else {
	    /*
	     * Process a regular result.
	     */

	    size_t bytec = 0;		/* Number of returned bytes */
	    int bytec;			/* Number of returned bytes */
	    unsigned char *bytev;	/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);
	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);

	    if (paramPtr->input.toRead < bytec) {
		ForwardSetStaticError(paramPtr, msg_read_toomuch);
		paramPtr->input.toRead = TCL_IO_FAILURE;
		paramPtr->input.toRead = -1;
	    } else {
		if (bytec + 1 > 1) {
		    memcpy(paramPtr->input.buf, bytev, bytec);
		if (bytec > 0) {
		    memcpy(paramPtr->input.buf, bytev, (size_t)bytec);
		}
		paramPtr->input.toRead = bytec;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(toReadObj);
	break;
    }

    case ForwardedOutput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
                paramPtr->output.buf, paramPtr->output.toWrite);
		paramPtr->output.buf, paramPtr->output.toWrite);
        Tcl_IncrRefCount(bufObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }
	    paramPtr->output.toWrite = -1;
	} else {
	    /*
	     * Process a regular result.
	     */

	    int written;

	    if (Tcl_GetIntFromObj(interp, resObj, &written) != TCL_OK) {
		Tcl_DecrRefCount(resObj);
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
		ForwardSetObjError(paramPtr, MarshallError(interp));
		paramPtr->output.toWrite = -1;
	    } else if (written==0 || paramPtr->output.toWrite<written) {
		ForwardSetStaticError(paramPtr, msg_write_toomuch);
		paramPtr->output.toWrite = -1;
	    } else {
		paramPtr->output.toWrite = written;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(bufObj);
	break;
    }

    case ForwardedSeek: {
	Tcl_Obj *offObj;
	Tcl_Obj *baseObj;
	Tcl_Obj *offObj = Tcl_NewWideIntObj(paramPtr->seek.offset);
	Tcl_Obj *baseObj = Tcl_NewStringObj(

	TclNewIntObj(offObj, paramPtr->seek.offset);
	baseObj = Tcl_NewStringObj(
		(paramPtr->seek.seekMode==SEEK_SET) ? "start" :
		(paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);

	Tcl_IncrRefCount(offObj);
	Tcl_IncrRefCount(baseObj);
        Tcl_IncrRefCount(offObj);
        Tcl_IncrRefCount(baseObj);

	Tcl_Preserve(rcPtr);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->seek.offset = -1;
	} else {
	    /*
	     * Process a regular result. If the type is wrong this may change
	     * into an error.
	     */

	    Tcl_WideInt newLoc;

	    if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
		if (newLoc < 0) {
		if (newLoc < Tcl_LongAsWide(0)) {
		    ForwardSetStaticError(paramPtr, msg_seek_beforestart);
		    paramPtr->seek.offset = -1;
		} else {
		    paramPtr->seek.offset = newLoc;
		}
	    } else {
		Tcl_DecrRefCount(resObj);
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
		ForwardSetObjError(paramPtr, MarshallError(interp));
		paramPtr->seek.offset = -1;
	    }
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(offObj);
        Tcl_DecrRefCount(baseObj);
	break;
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
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







-

+


-
+









-
+





-
+














-

+




-
+
+







	Tcl_DecrRefCount(maskObj);
        Tcl_Release(rcPtr);
	break;
    }

    case ForwardedBlock: {
	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);

        Tcl_IncrRefCount(blockObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
                &resObj) != TCL_OK) {
		&resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(blockObj);
	break;
    }

    case ForwardedSetOpt: {
	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
	Tcl_Obj *valueObj  = Tcl_NewStringObj(paramPtr->setOpt.value, -1);
	Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);

        Tcl_IncrRefCount(optionObj);
        Tcl_IncrRefCount(valueObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
                &resObj) != TCL_OK) {
		&resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
        Tcl_DecrRefCount(valueObj);
	break;
    }

    case ForwardedGetOpt: {
	/*
	 * Retrieve the value of one option.
	 */

	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);

        Tcl_IncrRefCount(optionObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    TclDStringAppendObj(paramPtr->getOpt.value, resObj);
	    Tcl_DStringAppend(paramPtr->getOpt.value,
		    TclGetString(resObj), -1);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
	break;
    }

    case ForwardedGetOptAll:
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
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







-
+
-
-
-
+





-
+






-
-
+
+


-
+







	     * NOTE (4) as well.
	     */

	    int listc;
	    Tcl_Obj **listv;

	    if (Tcl_ListObjGetElements(interp, resObj, &listc,
                    &listv) != TCL_OK) {
		    &listv) != TCL_OK) {
		Tcl_DecrRefCount(resObj);
		resObj = MarshallError(interp);
		ForwardSetObjError(paramPtr, resObj);
		ForwardSetObjError(paramPtr, MarshallError(interp));
	    } else if ((listc % 2) == 1) {
		/*
		 * Odd number of elements is wrong. [x].
		 */

		char *buf = (char *)Tcl_Alloc(200);
		char *buf = ckalloc(200);
		sprintf(buf,
			"{Expected list with even number of elements, got %d %s instead}",
			listc, (listc == 1 ? "element" : "elements"));

		ForwardSetDynamicError(paramPtr, buf);
	    } else {
		size_t len;
		const char *str = TclGetStringFromObj(resObj, &len);
		int len;
		const char *str = Tcl_GetStringFromObj(resObj, &len);

		if (len) {
		    TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
		    Tcl_DStringAppend(paramPtr->getOpt.value, " ", 1);
		    Tcl_DStringAppend(paramPtr->getOpt.value, str, len);
		}
	    }
	}
        Tcl_Release(rcPtr);
	break;

3281
3282
3283
3284
3285
3286
3287
3288

3289
3290
3291
3292
3293
3294
3295
3022
3023
3024
3025
3026
3027
3028

3029
3030
3031
3032
3033
3034
3035
3036







-
+







    return 1;
}

static void
SrcExitProc(
    ClientData clientData)
{
    ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
    ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
    ForwardingResult *resultPtr;
    ForwardParam *paramPtr;

    /*
     * NOTE (2): Can this handler be called with the originator blocked?
     */

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
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







-
-
+
+


-
-
+
+












}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = TclGetStringFromObj(obj, &len);
    int len;
    const char *msgStr = Tcl_GetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
    ForwardSetDynamicError(paramPtr, ckalloc((unsigned) len));
    memcpy(paramPtr->base.msgStr, msgStr, (unsigned) len);
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Deleted generic/tclIORTrans.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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



































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclIORTrans.c --
 *
 *	This file contains the implementation of Tcl's generic transformation
 *	reflection code, which allows the implementation of Tcl channel
 *	transformations in Tcl code.
 *
 *	Parts of this file are based on code contributed by Jean-Claude
 *	Wippler.
 *
 *	See TIP #230 for the specification of this functionality.
 *
 * Copyright (c) 2007-2008 ActiveState.
 *
 * 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 "tclIO.h"
#include <assert.h>

#ifndef EINVAL
#define EINVAL	9
#endif
#ifndef EOK
#define EOK	0
#endif

/*
 * Signatures of all functions used in the C layer of the reflection.
 */

static int		ReflectClose(ClientData clientData,
			    Tcl_Interp *interp, int flags);
static int		ReflectInput(ClientData clientData, char *buf,
			    int toRead, int *errorCodePtr);
static int		ReflectOutput(ClientData clientData, const char *buf,
			    int toWrite, int *errorCodePtr);
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
static int		ReflectGetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		ReflectSetOption(ClientData clientData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *newValue);
static int		ReflectHandle(ClientData clientData, int direction,
			    ClientData *handle);
static int		ReflectNotify(ClientData clientData, int mask);

/*
 * The C layer channel type/driver definition used by the reflection.
 */

static const Tcl_ChannelType tclRTransformType = {
    "tclrtransform",		/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel. */
    NULL,		/* Close channel, clean instance data. */
    ReflectInput,		/* Handle read request. */
    ReflectOutput,		/* Handle write request. */
	NULL,			/* Move location of access point. */
    ReflectSetOption,		/* Set options. */
    ReflectGetOption,		/* Get options. */
    ReflectWatch,		/* Initialize notifier. */
    ReflectHandle,		/* Get OS handle from the channel. */
	ReflectClose,		/* No close2 support. NULL'able. */
    ReflectBlock,		/* Set blocking/nonblocking. */
    NULL,			/* Flush channel. Not used by core.
				 * NULL'able. */
    ReflectNotify,		/* Handle events. */
    ReflectSeekWide,		/* Move access point (64 bit). */
    NULL,			/* thread action */
    NULL			/* truncate */
};

/*
 * Structure of the buffer to hold transform results to be consumed by higher
 * layers upon reading from the channel, plus the functions to manage such.
 */

typedef struct {
    unsigned char *buf;		/* Reference to the buffer area. */
    size_t allocated;		/* Allocated size of the buffer area. */
    size_t used;			/* Number of bytes in the buffer,
				 * <= allocated. */
} ResultBuffer;

#define ResultLength(r) ((r)->used)
/* static int		ResultLength(ResultBuffer *r); */

static void		ResultClear(ResultBuffer *r);
static void		ResultInit(ResultBuffer *r);
static void		ResultAdd(ResultBuffer *r, unsigned char *buf,
			    int toWrite);
static int		ResultCopy(ResultBuffer *r, unsigned char *buf,
			    int toRead);

#define RB_INCREMENT (512)

/*
 * Convenience macro to make some casts easier to use.
 */

#define UCHARP(x)	((unsigned char *) (x))

/*
 * Instance data for a reflected transformation. ===========================
 */

typedef struct {
    Tcl_Channel chan;		/* Back reference to the channel of the
				 * transformation itself. */
    Tcl_Channel parent;		/* Reference to the channel the transformation
				 * was pushed on. */
    Tcl_Interp *interp;		/* Reference to the interpreter containing the
				 * Tcl level part of the channel. */
    Tcl_Obj *handle;		/* Reference to transform handle. Also stored
				 * in the argv, see below. The separate field
				 * gives us direct access, needed when working
				 * with the reflection maps. */
#if TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
#endif

    Tcl_TimerToken timer;

    /* See [==] as well.
     * Storage for the command prefix and the additional words required for
     * the invocation of methods in the command handler.
     *
     * argv [0] ... [.] | [argc-2] [argc-1] | [argc]  [argc+2]
     *      cmd ... pfx | method   chan     | detail1 detail2
     *      ~~~~ CT ~~~            ~~ CT ~~
     *
     * CT = Belongs to the 'Command handler Thread'.
     */

    int argc;			/* Number of preallocated words - 2. */
    Tcl_Obj **argv;		/* Preallocated array for calling the handler.
				 * args[0] is placeholder for cmd word.
				 * Followed by the arguments in the prefix,
				 * plus 4 placeholders for method, channel,
				 * and at most two varying (method specific)
				 * words. */
    int methods;		/* Bitmask of supported methods. */

    /*
     * NOTE (9): Should we have predefined shared literals for the method
     * names?
     */

    int mode;			/* Mask of R/W mode */
    int nonblocking;		/* Flag: Channel is blocking or not. */
    int readIsDrained;		/* Flag: Read buffers are flushed. */
    int eofPending;		/* Flag: EOF seen down, but not raised up */
    int dead;			/* Boolean signal that some operations
				 * should no longer be attempted. */
    ResultBuffer result;
} ReflectedTransform;

/*
 * Structure of the table mapping from transform handles to reflected
 * transform (channels). Each interpreter which has the handler command for
 * one or more reflected transforms records them in such a table, so that we
 * are able to find them during interpreter/thread cleanup even if the actual
 * channel they belong to was moved to a different interpreter and/or thread.
 *
 * The table is reachable via the standard interpreter AssocData, the key is
 * defined below.
 */

typedef struct {
    Tcl_HashTable map;
} ReflectedTransformMap;

#define RTMKEY "ReflectedTransformMap"

/*
 * Method literals. ==================================================
 */

static const char *const methodNames[] = {
    "clear",		/* OPT */
    "drain",		/* OPT, drain => read */
    "finalize",		/*     */
    "flush",		/* OPT, flush => write */
    "initialize",	/*     */
    "limit?",		/* OPT */
    "read",		/* OPT */
    "write",		/* OPT */
    NULL
};
typedef enum {
    METH_CLEAR,
    METH_DRAIN,
    METH_FINAL,
    METH_FLUSH,
    METH_INIT,
    METH_LIMIT,
    METH_READ,
    METH_WRITE
} MethodName;

#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
	(FLAG(METH_INIT) | FLAG(METH_FINAL))
#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))

#if TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

/*
 * Enumeration of all operations which can be forwarded.
 */

typedef enum {
    ForwardedClear,
    ForwardedClose,
    ForwardedDrain,
    ForwardedFlush,
    ForwardedInput,
    ForwardedLimit,
    ForwardedOutput
} ForwardedOperation;

/*
 * Event used to forward driver invocations to the thread actually managing
 * the channel. We cannot construct the command to execute and forward that.
 * Because then it will contain a mixture of Tcl_Obj's belonging to both the
 * command handler thread (CT), and the thread managing the channel (MT),
 * executed in CT. Tcl_Obj's are not allowed to cross thread boundaries. So we
 * forward an operation code, the argument details, and reference to results.
 * The command is assembled in the CT and belongs fully to that thread. No
 * sharing problems.
 */

typedef struct {
    int code;			/* O: Ok/Fail of the cmd handler */
    char *msgStr;		/* O: Error message for handler failure */
    int mustFree;		/* O: True if msgStr is allocated, false if
				 * otherwise (static). */
} ForwardParamBase;

/*
 * Operation specific parameter/result structures. (These are "subtypes" of
 * ForwardParamBase. Where an operation does not need any special types, it
 * has no "subtype" and just uses ForwardParamBase, as listed above.)
 */

struct ForwardParamTransform {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    char *buf;			/* I: Bytes to transform,
				 * O: Bytes in transform result */
    size_t size;		/* I: #bytes to transform,
				 * O: #bytes in the transform result */
};
struct ForwardParamLimit {
    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
    int max;			/* O: Character read limit */
};

/*
 * Now join all these together in a single union for convenience.
 */

typedef union ForwardParam {
    ForwardParamBase base;
    struct ForwardParamTransform transform;
    struct ForwardParamLimit limit;
} ForwardParam;

/*
 * Forward declaration.
 */

typedef struct ForwardingResult ForwardingResult;

/*
 * General event structure, with reference to operation specific data.
 */

typedef struct {
    Tcl_Event event;		/* Basic event data, has to be first item */
    ForwardingResult *resultPtr;
    ForwardedOperation op;	/* Forwarded driver operation */
    ReflectedTransform *rtPtr;	/* Channel instance */
    ForwardParam *param;	/* Packaged arguments and return values, a
				 * ForwardParam pointer. */
} ForwardingEvent;

/*
 * Structure to manage the result of the forwarding. This is not the result of
 * the operation itself, but about the success of the forward event itself.
 * The event can be successful, even if the operation which was forwarded
 * failed. It is also there to manage the synchronization between the involved
 * threads.
 */

struct ForwardingResult {
    Tcl_ThreadId src;		/* Originating thread. */
    Tcl_ThreadId dst;		/* Thread the op was forwarded to. */
    Tcl_Interp *dsti;		/* Interpreter in the thread the op was
				 * forwarded to. */
    Tcl_Condition done;		/* Condition variable the forwarder blocks
				 * on. */
    int result;			/* TCL_OK or TCL_ERROR */
    ForwardingEvent *evPtr;	/* Event the result belongs to. */
    ForwardingResult *prevPtr, *nextPtr;
				/* Links into the list of pending forwarded
				 * results. */
};

typedef struct {
    /*
     * Table of all reflected transformations owned by this thread.
     */

    ReflectedTransformMap *rtmPtr;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * List of forwarded operations which have not completed yet, plus the mutex
 * to protect the access to this process global list.
 */

static ForwardingResult *forwardList = NULL;
TCL_DECLARE_MUTEX(rtForwardMutex)

/*
 * Function containing the generic code executing a forward, and wrapper
 * macros for the actual operations we wish to forward. Uses ForwardProc as
 * the event function executed by the thread receiving a forwarding event
 * (which executes the appropriate function and collects the result, if any).
 *
 * The two ExitProcs are handlers so that things do not deadlock when either
 * thread involved in the forwarding exits. They also clean things up so that
 * we don't leak resources when threads go away.
 */

static void		ForwardOpToOwnerThread(ReflectedTransform *rtPtr,
			    ForwardedOperation op, const void *param);
static int		ForwardProc(Tcl_Event *evPtr, int mask);
static void		SrcExitProc(ClientData clientData);

#define FreeReceivedError(p) \
	do {								\
	    if ((p)->base.mustFree) {					\
		Tcl_Free((p)->base.msgStr);				\
	    }								\
	} while (0)
#define PassReceivedErrorInterp(i,p) \
	do {								\
	    if ((i) != NULL) {						\
		Tcl_SetChannelErrorInterp((i),				\
			Tcl_NewStringObj((p)->base.msgStr, -1));	\
	    }								\
	    FreeReceivedError(p);					\
	} while (0)
#define PassReceivedError(c,p) \
	do {								\
	    Tcl_SetChannelError((c),					\
		    Tcl_NewStringObj((p)->base.msgStr, -1));		\
	    FreeReceivedError(p);					\
	} while (0)
#define ForwardSetStaticError(p,emsg) \
	do {								\
	    (p)->base.code = TCL_ERROR;					\
	    (p)->base.mustFree = 0;					\
	    (p)->base.msgStr = (char *) (emsg);				\
	} while (0)
#define ForwardSetDynamicError(p,emsg) \
	do {								\
	    (p)->base.code = TCL_ERROR;					\
	    (p)->base.mustFree = 1;					\
	    (p)->base.msgStr = (char *) (emsg);				\
	} while (0)

static void		ForwardSetObjError(ForwardParam *p,
			    Tcl_Obj *objPtr);
static ReflectedTransformMap *	GetThreadReflectedTransformMap(void);
static void		DeleteThreadReflectedTransformMap(
			    ClientData clientData);
#endif /* TCL_THREADS */

#define SetChannelErrorStr(c,msgStr) \
	Tcl_SetChannelError((c), Tcl_NewStringObj((msgStr), -1))

static Tcl_Obj *	MarshallError(Tcl_Interp *interp);
static void		UnmarshallErrorResult(Tcl_Interp *interp,
			    Tcl_Obj *msgObj);

/*
 * Static functions for this file:
 */

static Tcl_Obj *	DecodeEventMask(int mask);
static ReflectedTransform * NewReflectedTransform(Tcl_Interp *interp,
			    Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj,
			    Tcl_Channel parentChan);
static Tcl_Obj *	NextHandle(void);
static void		FreeReflectedTransform(ReflectedTransform *rtPtr);
static void		FreeReflectedTransformArgs(ReflectedTransform *rtPtr);
static int		InvokeTclMethod(ReflectedTransform *rtPtr,
			    const char *method, Tcl_Obj *argOneObj,
			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);

static ReflectedTransformMap *	GetReflectedTransformMap(Tcl_Interp *interp);
static void		DeleteReflectedTransformMap(ClientData clientData,
			    Tcl_Interp *interp);

/*
 * Global constant strings (messages). ==================
 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
static const char *msg_dstlost =
    "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";

/*
 * Timer management (flushing out buffered data via artificial events).
 */

/*
 * Helper functions encapsulating some of the thread forwarding to make the
 * control flow in callers easier.
 */

static void		TimerKill(ReflectedTransform *rtPtr);
static void		TimerSetup(ReflectedTransform *rtPtr);
static void		TimerRun(ClientData clientData);
static int		TransformRead(ReflectedTransform *rtPtr,
			    int *errorCodePtr, Tcl_Obj *bufObj);
static int		TransformWrite(ReflectedTransform *rtPtr,
			    int *errorCodePtr, unsigned char *buf,
			    int toWrite);
static int		TransformDrain(ReflectedTransform *rtPtr,
			    int *errorCodePtr);
static int		TransformFlush(ReflectedTransform *rtPtr,
			    int *errorCodePtr, int op);
static void		TransformClear(ReflectedTransform *rtPtr);
static int		TransformLimit(ReflectedTransform *rtPtr,
			    int *errorCodePtr, int *maxPtr);

/*
 * Operation codes for TransformFlush().
 */

#define FLUSH_WRITE	1
#define FLUSH_DISCARD	0

/*
 * Main methods to plug into the 'chan' ensemble'. ==================
 */

/*
 *----------------------------------------------------------------------
 *
 * TclChanPushObjCmd --
 *
 *	This function is invoked to process the "chan push" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result. The handle of the new channel is placed in the
 *	interp result.
 *
 * Side effects:
 *	Creates a new channel.
 *
 *----------------------------------------------------------------------
 */

int
TclChanPushObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    ReflectedTransform *rtPtr;	/* Instance data of the new (transform)
				 * channel. */
    Tcl_Obj *chanObj;		/* Handle of parent channel */
    Tcl_Channel parentChan;	/* Token of parent channel */
    int mode;			/* R/W mode of parent, later the new channel.
				 * Has to match the abilities of the handler
				 * commands */
    Tcl_Obj *cmdObj;		/* Command prefix, list of words */
    Tcl_Obj *cmdNameObj;	/* Command name */
    Tcl_Obj *rtId;		/* Handle of the new transform (channel) */
    Tcl_Obj *modeObj;		/* mode in obj form for method call */
    int listc;			/* Result of 'initialize', and of */
    Tcl_Obj **listv;		/* its sublist in the 2nd element */
    int methIndex;		/* Encoded method name */
    int result;			/* Result code for 'initialize' */
    Tcl_Obj *resObj;		/* Result data for 'initialize' */
    int methods;		/* Bitmask for supported methods. */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected transforms with handlers
				 * in this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */
    int isNew;			/* Placeholder. */

    /*
     * Syntax:   chan push CHANNEL CMDPREFIX
     *           [0]  [1]  [2]     [3]
     *
     * Actually: rPush CHANNEL CMDPREFIX
     *           [0]   [1]     [2]
     */

#define CHAN	(1)
#define CMD	(2)

    /*
     * Number of arguments...
     */

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel cmdprefix");
	return TCL_ERROR;
    }

    /*
     * First argument is a channel handle.
     */

    chanObj = objv[CHAN];
    parentChan = Tcl_GetChannel(interp, TclGetString(chanObj), &mode);
    if (parentChan == NULL) {
	return TCL_ERROR;
    }
    parentChan = Tcl_GetTopChannel(parentChan);

    /*
     * Second argument is command prefix, i.e. list of words, first word is
     * name of handler command, other words are fixed arguments. Run the
     * 'initialize' method to get the list of supported methods. Validate
     * this.
     */

    cmdObj = objv[CMD];

    /*
     * Basic check that the command prefix truly is a list.
     */

    if (Tcl_ListObjIndex(interp, cmdObj, 0, &cmdNameObj) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Now create the transformation (channel).
     */

    rtId = NextHandle();
    rtPtr = NewReflectedTransform(interp, cmdObj, mode, rtId, parentChan);

    /*
     * Invoke 'initialize' and validate that the handler is present and ok.
     * Squash the transformation if not.
     */

    modeObj = DecodeEventMask(mode);
    /* assert modeObj.refCount == 1 */
    result = InvokeTclMethod(rtPtr, "initialize", modeObj, NULL, &resObj);
    Tcl_DecrRefCount(modeObj);
    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	goto error;
    }

    /*
     * Verify the result.
     * - List, of method names. Convert to mask. Check for non-optionals
     *   through the mask. Compare open mode against optional r/w.
     */

    if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s initialize\" returned non-list: %s",
                TclGetString(cmdObj), TclGetString(resObj)));
	Tcl_DecrRefCount(resObj);
	goto error;
    }

    methods = 0;
    while (listc > 0) {
	if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames,
		"method", TCL_EXACT, &methIndex) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "chan handler \"%s initialize\" returned %s",
		    TclGetString(cmdObj),
		    Tcl_GetStringResult(interp)));
	    Tcl_DecrRefCount(resObj);
	    goto error;
	}

	methods |= FLAG(methIndex);
	listc--;
    }
    Tcl_DecrRefCount(resObj);

    if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" does not support all required methods",
                TclGetString(cmdObj)));
	goto error;
    }

    /*
     * Mode tell us what the parent channel supports. The methods tell us what
     * the handler supports. We remove the non-supported bits from the mode
     * and check that the channel is not completely inacessible. Afterward the
     * mode tells us which methods are still required, and these methods will
     * also be supported by the handler, by design of the check.
     */

    if (!HAS(methods, METH_READ)) {
	mode &= ~TCL_READABLE;
    }
    if (!HAS(methods, METH_WRITE)) {
	mode &= ~TCL_WRITABLE;
    }

    if (!mode) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" makes the channel inaccessible",
                TclGetString(cmdObj)));
	goto error;
    }

    /*
     * The mode and support for it is ok, now check the internal constraints.
     */

    if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"drain\" but not \"read\"",
                TclGetString(cmdObj)));
	goto error;
    }

    if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "chan handler \"%s\" supports \"flush\" but not \"write\"",
                TclGetString(cmdObj)));
	goto error;
    }

    Tcl_ResetResult(interp);

    /*
     * Everything is fine now.
     */

    rtPtr->methods = methods;
    rtPtr->mode = mode;
    rtPtr->chan = Tcl_StackChannel(interp, &tclRTransformType, rtPtr, mode,
	    rtPtr->parent);

    /*
     * Register the transform in our our map for proper handling of deleted
     * interpreters and/or threads.
     */

    rtmPtr = GetReflectedTransformMap(interp);
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
    }
    Tcl_SetHashValue(hPtr, rtPtr);
#if TCL_THREADS
    rtmPtr = GetThreadReflectedTransformMap();
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */

    /*
     * Return the channel as the result of the command.
     */

    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    Tcl_GetChannelName(rtPtr->chan), -1));
    return TCL_OK;

  error:
    /*
     * We are not going through ReflectClose as we never had a channel
     * structure.
     */

    Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
    return TCL_ERROR;

#undef CHAN
#undef CMD
}

/*
 *----------------------------------------------------------------------
 *
 * TclChanPopObjCmd --
 *
 *	This function is invoked to process the "chan pop" Tcl command. See
 *	the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Posts events to a reflected channel, invokes event handlers. The
 *	latter implies that arbitrary side effects are possible.
 *
 *----------------------------------------------------------------------
 */

int
TclChanPopObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    /*
     * Syntax:   chan pop CHANNEL
     *           [0]  [1] [2]
     *
     * Actually: rPop CHANNEL
     *           [0]  [1]
     */

#define CHAN	(1)

    const char *chanId;		/* Tcl level channel handle */
    Tcl_Channel chan;		/* Channel associated to the handle */
    int mode;			/* Channel r/w mode */

    /*
     * Number of arguments...
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "channel");
	return TCL_ERROR;
    }

    /*
     * First argument is a channel, which may have a (reflected)
     * transformation.
     */

    chanId = TclGetString(objv[CHAN]);
    chan = Tcl_GetChannel(interp, chanId, &mode);

    if (chan == NULL) {
	return TCL_ERROR;
    }

    /*
     * Removing transformations is generic, and not restricted to reflected
     * transformations.
     */

    Tcl_UnstackChannel(interp, chan);
    return TCL_OK;

#undef CHAN
}

/*
 * Channel error message marshalling utilities.
 */

static Tcl_Obj *
MarshallError(
    Tcl_Interp *interp)
{
    /*
     * Capture the result status of the interpreter into a string. => List of
     * options and values, followed by the error message. The result has
     * refCount 0.
     */

    Tcl_Obj *returnOpt = Tcl_GetReturnOptions(interp, TCL_ERROR);

    /*
     * => returnOpt.refCount == 0. We can append directly.
     */

    Tcl_ListObjAppendElement(NULL, returnOpt, Tcl_GetObjResult(interp));
    return returnOpt;
}

static void
UnmarshallErrorResult(
    Tcl_Interp *interp,
    Tcl_Obj *msgObj)
{
    int lc;
    Tcl_Obj **lv;
    int explicitResult;
    int numOptions;

    /*
     * Process the caught message.
     *
     * Syntax = (option value)... ?message?
     *
     * Bad syntax causes a panic. This is OK because the other side uses
     * Tcl_GetReturnOptions and list construction functions to marshall the
     * information; if we panic here, something has gone badly wrong already.
     */

    if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) {
	Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result");
    }
    if (interp == NULL) {
	return;
    }

    explicitResult = lc & 1;		/* Odd number of values? */
    numOptions = lc - explicitResult;

    if (explicitResult) {
	Tcl_SetObjResult(interp, lv[lc-1]);
    }

    Tcl_SetReturnOptions(interp, Tcl_NewListObj(numOptions, lv));
    ((Interp *) interp)->flags &= ~ERR_ALREADY_LOGGED;
}

/*
 * Driver functions. ================================================
 */

/*
 *----------------------------------------------------------------------
 *
 * ReflectClose --
 *
 *	This function is invoked when the channel is closed, to delete the
 *	driver specific instance data.
 *
 * Results:
 *	A posix error.
 *
 * Side effects:
 *	Releases memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectClose(
    ClientData clientData,
    Tcl_Interp *interp,
    int flags)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    int errorCode, errorCodeSet = 0;
    int result = TCL_OK;	/* Result code for 'close' */
    Tcl_Obj *resObj;		/* Result data for 'close' */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected transforms with handlers
				 * in this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    if (TclInThreadExit()) {
	/*
	 * This call comes from TclFinalizeIOSystem. There are no
	 * interpreters, and therefore we cannot call upon the handler command
	 * anymore. Threading is irrelevant as well. We simply clean up all
	 * our C level data structures and leave the Tcl level to the other
	 * finalization functions.
	 */

	/*
	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedTransformMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * if lost?
	 */

#if TCL_THREADS
	if (rtPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	    result = p.base.code;

	    if (result != TCL_OK) {
		FreeReceivedError(&p);
	    }
	}
#endif /* TCL_THREADS */

	Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
	return EOK;
    }

    /*
     * In the reflected channel implementation a cleaned method mask here
     * implies that the channel creation was aborted, and "finalize" must not
     * be called. for transformations however we are not going through here on
     * such an abort, but directly through FreeReflectedTransform. So for us
     * that check is not necessary. We always go through 'finalize'.
     */

    if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
	if (!TransformDrain(rtPtr, &errorCode)) {
#if TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
	    goto cleanup;
	}
    }

    if (HAS(rtPtr->methods, METH_FLUSH)) {
	if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
#if TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
	    goto cleanup;
	}
    }

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	result = p.base.code;

	Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);

	if (result != TCL_OK) {
	    PassReceivedErrorInterp(interp, &p);
	    return EINVAL;
	}
	return EOK;
    }
#endif /* TCL_THREADS */

    /*
     * Do the actual invokation of "finalize" now; we're in the right thread.
     */

    result = InvokeTclMethod(rtPtr, "finalize", NULL, NULL, &resObj);
    if ((result != TCL_OK) && (interp != NULL)) {
	Tcl_SetChannelErrorInterp(interp, resObj);
    }

    Tcl_DecrRefCount(resObj);	/* Remove reference we held from the
				 * invoke. */

  cleanup:

    /*
     * Remove the transform from the map before releasing the memory, to
     * prevent future accesses from finding and dereferencing a dangling
     * pointer.
     *
     * NOTE: The transform may not be in the map. This is ok, that happens
     * when the transform was created in a different interpreter and/or thread
     * and then was moved here.
     *
     * NOTE: The channel may have been removed from the map already via
     * the per-interp DeleteReflectedTransformMap exit-handler.
     */

    if (!rtPtr->dead) {
	rtmPtr = GetReflectedTransformMap(rtPtr->interp);
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}

	/*
	 * In a threaded interpreter we manage a per-thread map as well,
	 * to allow us to survive if the script level pulls the rug out
	 * under a channel by deleting the owning thread.
	 */

#if TCL_THREADS
	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif /* TCL_THREADS */
    }

    Tcl_EventuallyFree (rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
    return errorCodeSet ? errorCode : ((result == TCL_OK) ? EOK : EINVAL);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectInput --
 *
 *	This function is invoked when more data is requested from the channel.
 *
 * Results:
 *	The number of bytes read.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectInput(
    ClientData clientData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    int gotBytes, copied, readBytes;
    Tcl_Obj *bufObj;

    /*
     * The following check can be done before thread redirection, because we
     * are reading from an item which is readonly, i.e. will never change
     * during the lifetime of the channel.
     */

    if (!(rtPtr->methods & FLAG(METH_READ))) {
	SetChannelErrorStr(rtPtr->chan, msg_read_unsup);
	*errorCodePtr = EINVAL;
	return -1;
    }

    Tcl_Preserve(rtPtr);

    /* TODO: Consider a more appropriate buffer size. */
    bufObj = Tcl_NewByteArrayObj(NULL, toRead);
    Tcl_IncrRefCount(bufObj);
    gotBytes = 0;
    if (rtPtr->eofPending) {
	goto stop;
    }
    rtPtr->readIsDrained = 0;
    while (toRead > 0) {
	/*
	 * Loop until the request is satisfied (or no data available from
	 * below, possibly EOF).
	 */

	copied = ResultCopy(&rtPtr->result, UCHARP(buf), toRead);
	toRead -= copied;
	buf += copied;
	gotBytes += copied;

	if (toRead == 0) {
	    goto stop;
	}

	if (rtPtr->eofPending) {
	    goto stop;
	}


	/*
	 * The buffer is exhausted, but the caller wants even more. We now
	 * have to go to the underlying channel, get more bytes and then
	 * transform them for delivery. We may not get what we want (full EOF
	 * or temporarily out of data).
	 *
	 * Length (rtPtr->result) == 0, toRead > 0 here. Use 'buf'! as target
	 * to store the intermediary information read from the parent channel.
	 *
	 * Ask the transform how much data it allows us to read from the
	 * underlying channel. This feature allows the transform to signal EOF
	 * upstream although there is none downstream. Useful to control an
	 * unbounded 'fcopy' for example, either through counting bytes, or by
	 * pattern matching.
	 */

	if ((rtPtr->methods & FLAG(METH_LIMIT))) {
	    int maxRead = -1;

	    if (!TransformLimit(rtPtr, errorCodePtr, &maxRead)) {
		goto error;
	    }
	    if (maxRead == 0) {
		goto stop;
	    } else if (maxRead > 0) {
		if (maxRead < toRead) {
		    toRead = maxRead;
		}
	    } /* else: 'maxRead < 0' == Accept the current value of toRead */
	}

	if (toRead <= 0) {
	    goto stop;
	}


	readBytes = Tcl_ReadRaw(rtPtr->parent,
		(char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
	if (readBytes < 0) {
	    if (Tcl_InputBlocked(rtPtr->parent) && (gotBytes > 0)) {

		/*
		 * Down channel is blocked and offers zero additional bytes.
		 * The nonzero gotBytes already returned makes the total
		 * operation a valid short read.  Return to caller.
		 */

		goto stop;
	    }

	    /*
	     * Either the down channel is not blocked (a real error)
	     * or it is and there are gotBytes==0 byte copied so far.
	     * In either case, pass up the error, so we either report
	     * any real error, or do not mistakenly signal EOF by
	     * returning 0 to the caller.
	     */

	    *errorCodePtr = Tcl_GetErrno();
	    goto error;
	}

	if (readBytes == 0) {

	    /*
	     * Zero returned from Tcl_ReadRaw() always indicates EOF
	     * on the down channel.
	     */

	    rtPtr->eofPending = 1;

		/*
		 * Now this is a bit different. The partial data waiting is
		 * converted and returned.
		 */

		if (HAS(rtPtr->methods, METH_DRAIN)) {
		    if (!TransformDrain(rtPtr, errorCodePtr)) {
			goto error;
		    }
		}

		if (ResultLength(&rtPtr->result) == 0) {
		    /*
		     * The drain delivered nothing.
		     */

		    goto stop;
		}

		continue; /* at: while (toRead > 0) */
	} /* readBytes == 0 */

	/*
	 * Transform the read chunk, which was not empty. Anything we got back
	 * is a transformation result is put into our buffers, and the next
	 * iteration will put it into the result.
	 */

	Tcl_SetByteArrayLength(bufObj, readBytes);
	if (!TransformRead(rtPtr, errorCodePtr, bufObj)) {
	    goto error;
	}
	if (Tcl_IsShared(bufObj)) {
	    Tcl_DecrRefCount(bufObj);
	    TclNewObj(bufObj);
	    Tcl_IncrRefCount(bufObj);
	}
	Tcl_SetByteArrayLength(bufObj, 0);
    } /* while toRead > 0 */

 stop:
    if (gotBytes == 0) {
	rtPtr->eofPending = 0;
    }
    Tcl_DecrRefCount(bufObj);
    Tcl_Release(rtPtr);
    return gotBytes;

 error:
    gotBytes = -1;
    goto stop;
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectOutput --
 *
 *	This function is invoked when data is written to the channel.
 *
 * Results:
 *	The number of bytes actually written.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectOutput(
    ClientData clientData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * The following check can be done before thread redirection, because we
     * are reading from an item which is readonly, i.e. will never change
     * during the lifetime of the channel.
     */

    if (!(rtPtr->methods & FLAG(METH_WRITE))) {
	SetChannelErrorStr(rtPtr->chan, msg_write_unsup);
	*errorCodePtr = EINVAL;
	return -1;
    }

    if (toWrite == 0) {
	/*
	 * Nothing came in to write, ignore the call
	 */

	return 0;
    }

    /*
     * Discard partial data in the input buffers, i.e. on the read side. Like
     * we do when explicitly seeking as well.
     */

    Tcl_Preserve(rtPtr);

    if ((rtPtr->methods & FLAG(METH_CLEAR))) {
	TransformClear(rtPtr);
    }

    /*
     * Hand the data to the transformation itself. Anything it deigned to
     * return to us is a (partial) transformation result and written to the
     * parent channel for further processing.
     */

    if (!TransformWrite(rtPtr, errorCodePtr, UCHARP(buf), toWrite)) {
	Tcl_Release(rtPtr);
	return -1;
    }

    *errorCodePtr = EOK;
    Tcl_Release(rtPtr);
    return toWrite;
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectSeekWide / ReflectSeek --
 *
 *	This function is invoked when the user wishes to seek on the channel.
 *
 * Results:
 *	The new location of the access point.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, per the parent channel, and the called
 *	scripts.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
ReflectSeekWide(
    ClientData clientData,
    Tcl_WideInt offset,
    int seekMode,
    int *errorCodePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    Channel *parent = (Channel *) rtPtr->parent;
    Tcl_WideInt curPos;		/* Position on the device. */

    /*
     * Check if we can leave out involving the Tcl level, i.e. transformation
     * handler. This is true for tell requests, and transformations which
     * support neither flush, nor drain. For these cases we can pass the
     * request down and the result back up unchanged.
     */

    Tcl_Preserve(rtPtr);

    if (((seekMode != SEEK_CUR) || (offset != 0))
	    && (HAS(rtPtr->methods, METH_CLEAR)
	    || HAS(rtPtr->methods, METH_FLUSH))) {
	/*
	 * Neither a tell request, nor clear/flush both not supported. We have
	 * to go through the Tcl level to clear and/or flush the
	 * transformation.
	 */

	if (rtPtr->methods & FLAG(METH_CLEAR)) {
	    TransformClear(rtPtr);
	}

	/*
	 * When flushing the transform for seeking the generated results are
	 * irrelevant. We cannot put them into the channel, this would move
	 * the location, throwing it off with regard to where we are and are
	 * seeking to.
	 */

	if (HAS(rtPtr->methods, METH_FLUSH)) {
	    if (!TransformFlush(rtPtr, errorCodePtr, FLUSH_DISCARD)) {
		Tcl_Release(rtPtr);
		return -1;
	    }
	}
    }

    /*
     * Now seek to the new position in the channel as requested by the
     * caller. Note that we prefer the wideSeekProc if that is available and
     * non-NULL...
     */

    if (Tcl_ChannelWideSeekProc(parent->typePtr) == NULL) {
	*errorCodePtr = EINVAL;
	curPos = -1;
    } else {
    	curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
    		seekMode, errorCodePtr);
    }
    if (curPos == -1) {
	Tcl_SetErrno(*errorCodePtr);
    }

    *errorCodePtr = EOK;
    Tcl_Release(rtPtr);
    return curPos;
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectWatch --
 *
 *	This function is invoked to tell the channel what events the I/O
 *	system is interested in.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static void
ReflectWatch(
    ClientData clientData,
    int mask)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
    Tcl_DriverWatchProc *watchProc;

    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(rtPtr->parent));
    watchProc(Tcl_GetChannelInstanceData(rtPtr->parent), mask);

    /*
     * Management of the internal timer.
     */

    if (!(mask & TCL_READABLE) || (ResultLength(&rtPtr->result) == 0)) {
	/*
	 * A pending timer may exist, but either is there no (more) interest
	 * in the events it generates or nothing is available for reading.
	 * Remove it, if existing.
	 */

	TimerKill(rtPtr);
    } else {
	/*
	 * There might be no pending timer, but there is interest in readable
	 * events and we actually have data waiting, so generate a timer to
	 * flush that if it does not exist.
	 */

	TimerSetup(rtPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectBlock --
 *
 *	This function is invoked to tell the channel which blocking behaviour
 *	is required of it.
 *
 * Results:
 *	A posix error number.
 *
 * Side effects:
 *	Allocates memory. Arbitrary, as it calls upon a script.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectBlock(
    ClientData clientData,
    int nonblocking)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations simply record the blocking mode in their C level
     * structure for use by --> ReflectInput. The Tcl level doesn't see this
     * information or change. As such thread forwarding is not required.
     */

    rtPtr->nonblocking = nonblocking;
    return EOK;
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectSetOption --
 *
 *	This function is invoked to configure a channel option.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	Arbitrary, per the parent channel.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectSetOption(
    ClientData clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of requested option */
    const char *newValue)	/* The new value */
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no options. Thus the call is passed down unchanged
     * to the parent channel for processing. Its results are passed back
     * unchanged as well. This all happens in the thread we are in. As the Tcl
     * level is not involved there is no need for thread forwarding.
     */

    Tcl_DriverSetOptionProc *setOptionProc =
	    Tcl_ChannelSetOptionProc(Tcl_GetChannelType(rtPtr->parent));

    if (setOptionProc == NULL) {
	return TCL_ERROR;
    }
    return setOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent), interp,
	    optionName, newValue);
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectGetOption --
 *
 *	This function is invoked to retrieve all or a channel options.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	Arbitrary, per the parent channel.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectGetOption(
    ClientData clientData,	/* Channel to query */
    Tcl_Interp *interp,		/* Interpreter to leave error messages in */
    const char *optionName,	/* Name of reuqested option */
    Tcl_DString *dsPtr)		/* String to place the result into */
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no options. Thus the call is passed down unchanged
     * to the parent channel for processing. Its results are passed back
     * unchanged as well. This all happens in the thread we are in. As the Tcl
     * level is not involved there is no need for thread forwarding.
     *
     * Note that the parent not having a driver for option retrieval is not an
     * immediate error. A query for all options is ok. Only a request for a
     * specific option has to fail.
     */

    Tcl_DriverGetOptionProc *getOptionProc =
	    Tcl_ChannelGetOptionProc(Tcl_GetChannelType(rtPtr->parent));

    if (getOptionProc != NULL) {
	return getOptionProc(Tcl_GetChannelInstanceData(rtPtr->parent),
		interp, optionName, dsPtr);
    } else if (optionName == NULL) {
	return TCL_OK;
    } else {
	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ReflectHandle --
 *
 *	This function is invoked to retrieve the associated file handle.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	Arbitrary, per the parent channel.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectHandle(
    ClientData clientData,
    int direction,
    ClientData *handlePtr)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * Transformations have no handle of their own. As such we simply query
     * the parent channel for it. This way the qery will ripple down through
     * all transformations until reaches the base channel. Which then returns
     * its handle, or fails. The former will then ripple up the stack.
     *
     * This all happens in the thread we are in. As the Tcl level is not
     * involved no forwarding is required.
     */

    return Tcl_GetChannelHandle(rtPtr->parent, direction, handlePtr);
}
/*
 *----------------------------------------------------------------------
 *
 * ReflectNotify --
 *
 *	This function is invoked to reported incoming events.
 *
 * Results:
 *	A standard Tcl result code.
 *
 * Side effects:
 *	Arbitrary, per the parent channel.
 *
 *----------------------------------------------------------------------
 */

static int
ReflectNotify(
    ClientData clientData,
    int mask)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    /*
     * An event occured in the underlying channel.
     *
     * We delete our timer. It was not fired, yet we are here, so the channel
     * below generated such an event and we don't have to. The renewal of the
     * interest after the execution of channel handlers will eventually cause
     * us to recreate the timer (in ReflectWatch).
     */

    TimerKill(rtPtr);

    /*
     * Pass to higher layers.
     */

    return mask;
}

/*
 * Helpers. =========================================================
 */


/*
 *----------------------------------------------------------------------
 *
 * DecodeEventMask --
 *
 *	This function takes an internal bitmask of events and constructs the
 *	equivalent list of event items.
 *
 * Results:
 *	A Tcl_Obj reference. The object will have a refCount of one. The user
 *	has to decrement it to release the object.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 * DUPLICATE of 'DecodeEventMask' in tclIORChan.c
 */

static Tcl_Obj *
DecodeEventMask(
    int mask)
{
    const char *eventStr;
    Tcl_Obj *evObj;

    switch (mask & RANDW) {
    case RANDW:
	eventStr = "read write";
	break;
    case TCL_READABLE:
	eventStr = "read";
	break;
    case TCL_WRITABLE:
	eventStr = "write";
	break;
    default:
	eventStr = "";
	break;
    }

    evObj = Tcl_NewStringObj(eventStr, -1);
    Tcl_IncrRefCount(evObj);
    return evObj;
}

/*
 *----------------------------------------------------------------------
 *
 * NewReflectedTransform --
 *
 *	This function is invoked to allocate and initialize the instance data
 *	of a new reflected channel.
 *
 * Results:
 *	A heap-allocated channel instance.
 *
 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------
 */

static ReflectedTransform *
NewReflectedTransform(
    Tcl_Interp *interp,
    Tcl_Obj *cmdpfxObj,
    TCL_UNUSED(int) /*mode*/,
    Tcl_Obj *handleObj,
    Tcl_Channel parentChan)
{
    ReflectedTransform *rtPtr;
    int listc;
    Tcl_Obj **listv;
    int i;

    rtPtr = (ReflectedTransform *)Tcl_Alloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#if TCL_THREADS
    rtPtr->thread = Tcl_GetCurrentThread();
#endif
    rtPtr->parent = parentChan;
    rtPtr->interp = interp;
    rtPtr->handle = handleObj;
    Tcl_IncrRefCount(handleObj);
    rtPtr->timer = NULL;
    rtPtr->mode = 0;
    rtPtr->readIsDrained = 0;
    rtPtr->eofPending = 0;
    rtPtr->nonblocking =
	    (((Channel *) parentChan)->state->flags & CHANNEL_NONBLOCKING);
    rtPtr->dead = 0;

    /*
     * Query parent for current blocking mode.
     */

    ResultInit(&rtPtr->result);

    /*
     * Method placeholder.
     */

    /* ASSERT: cmdpfxObj is a Tcl List */

    Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv);

    /*
     * See [==] as well.
     * Storage for the command prefix and the additional words required for
     * the invocation of methods in the command handler.
     *
     * listv [0] [listc-1] | [listc]  [listc+1] |
     * argv  [0]   ... [.] | [argc-2] [argc-1]  | [argc]  [argc+2]
     *       cmd   ... pfx | method   chan      | detail1 detail2
     */

    rtPtr->argc = listc + 2;
    rtPtr->argv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * (listc+4));

    /*
     * Duplicate object references.
     */

    for (i=0; i<listc ; i++) {
	Tcl_Obj *word = rtPtr->argv[i] = listv[i];

	Tcl_IncrRefCount(word);
    }

    i++;				/* Skip placeholder for method */

    /*
     * See [x] in FreeReflectedTransform for release
     */
    rtPtr->argv[i] = handleObj;
    Tcl_IncrRefCount(handleObj);

    /*
     * The next two objects are kept empty, varying arguments.
     */

    /*
     * Initialization complete.
     */

    return rtPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * NextHandle --
 *
 *	This function is invoked to generate a channel handle for a new
 *	reflected channel.
 *
 * Results:
 *	A Tcl_Obj containing the string of the new channel handle. The
 *	refcount of the returned object is -- zero --.
 *
 * Side effects:
 *	May allocate memory. Mutex protected critical section locks out other
 *	threads for a short time.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
NextHandle(void)
{
    /*
     * Count number of generated reflected channels. Used for id generation.
     * Ids are never reclaimed and there is no dealing with wrap around. On
     * the other hand, "unsigned long" should be big enough except for
     * absolute longrunners (generate a 100 ids per second => overflow will
     * occur in 1 1/3 years).
     */

    TCL_DECLARE_MUTEX(rtCounterMutex)
    static unsigned long rtCounter = 0;
    Tcl_Obj *resObj;

    Tcl_MutexLock(&rtCounterMutex);
    resObj = Tcl_ObjPrintf("rt%lu", rtCounter);
    rtCounter++;
    Tcl_MutexUnlock(&rtCounterMutex);

    return resObj;
}

static void
FreeReflectedTransformArgs(
    ReflectedTransform *rtPtr)
{
    int i, n = rtPtr->argc - 2;

    if (n < 0) {
	return;
    }

    Tcl_DecrRefCount(rtPtr->handle);
    rtPtr->handle = NULL;

    for (i=0; i<n; i++) {
	Tcl_DecrRefCount(rtPtr->argv[i]);
    }

    /*
     * See [x] in NewReflectedTransform for lock
     * n+1 = argc-1.
     */
    Tcl_DecrRefCount(rtPtr->argv[n+1]);

    rtPtr->argc = 1;
}

static void
FreeReflectedTransform(
    ReflectedTransform *rtPtr)
{
    TimerKill(rtPtr);
    ResultClear(&rtPtr->result);

    FreeReflectedTransformArgs(rtPtr);

    Tcl_Free(rtPtr->argv);
    Tcl_Free(rtPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InvokeTclMethod --
 *
 *	This function is used to invoke the Tcl level of a reflected channel.
 *	It handles all the command assembly, invokation, and generic state and
 *	result mgmt. It does *not* handle thread redirection; that is the
 *	responsibility of clients of this function.
 *
 * Results:
 *	Result code and data as returned by the method.
 *
 * Side effects:
 *	Arbitrary, as it calls upon a Tcl script.
 *
 * Contract:
 *	argOneObj.refCount >= 1 on entry and exit, if argOneObj != NULL
 *	argTwoObj.refCount >= 1 on entry and exit, if argTwoObj != NULL
 *	resObj.refCount in {0, 1, ...}
 *
 *----------------------------------------------------------------------
 * Semi-DUPLICATE of 'InvokeTclMethod' in tclIORChan.c
 * - Semi because different structures are used.
 * - Still possible to factor out the commonalities into a separate structure.
 */

static int
InvokeTclMethod(
    ReflectedTransform *rtPtr,
    const char *method,
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    int cmdc;			/* #words in constructed command */
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */

    if (rtPtr->dead) {
	/*
	 * The transform is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

	if (resultObjPtr != NULL) {
	    resObj = Tcl_NewStringObj(msg_dstlost,-1);
	    *resultObjPtr = resObj;
	    Tcl_IncrRefCount(resObj);
	}
	return TCL_ERROR;
    }

    /*
     * NOTE (5): Decide impl. issue: Cache objects with method names?
     * Requires TSD data as reflections can be created in many different
     * threads.
     * NO: Caching of command resolutions means storage per channel.
     */

    /*
     * Insert method into the pre-allocated area, after the command prefix,
     * before the channel id.
     */

    methObj = Tcl_NewStringObj(method, -1);
    Tcl_IncrRefCount(methObj);
    rtPtr->argv[rtPtr->argc - 2] = methObj;

    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.
     *
     * Because of the contract there is no need to increment the refcounts.
     * The objects will survive the Tcl_EvalObjv without change.
     */

    cmdc = rtPtr->argc;
    if (argOneObj) {
	rtPtr->argv[cmdc] = argOneObj;
	cmdc++;
	if (argTwoObj) {
	    rtPtr->argv[cmdc] = argTwoObj;
	    cmdc++;
	}
    }

    /*
     * And run the handler... This is done in auch a manner which leaves any
     * existing state intact.
     */

    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);
    Tcl_Preserve(rtPtr);
    Tcl_Preserve(rtPtr->interp);
    result = Tcl_EvalObjv(rtPtr->interp, cmdc, rtPtr->argv, TCL_EVAL_GLOBAL);

    /*
     * We do not try to extract the result information if the caller has no
     * interest in it. I.e. there is no need to put effort into creating
     * something which is discarded immediately after.
     */

    if (resultObjPtr) {
	if (result == TCL_OK) {
	    /*
	     * Ok result taken as is, also if the caller requests that there
	     * is no capture.
	     */

	    resObj = Tcl_GetObjResult(rtPtr->interp);
	} else {
	    /*
	     * Non-ok result is always treated as an error. We have to capture
	     * the full state of the result, including additional options.
	     *
	     * This is complex and ugly, and would be completely unnecessary
	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
	     */
	    if (result != TCL_ERROR) {
		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
		size_t cmdLen;
		const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);

		Tcl_IncrRefCount(cmd);
		Tcl_ResetResult(rtPtr->interp);
		Tcl_SetObjResult(rtPtr->interp, Tcl_ObjPrintf(
			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rtPtr->interp, cmdString, cmdString, cmdLen);
		Tcl_DecrRefCount(cmd);
		result = TCL_ERROR;
	    }
	    Tcl_AppendObjToErrorInfo(rtPtr->interp, Tcl_ObjPrintf(
		    "\n    (chan handler subcommand \"%s\")", method));
	    resObj = MarshallError(rtPtr->interp);
	}
	Tcl_IncrRefCount(resObj);
    }
    Tcl_RestoreInterpState(rtPtr->interp, sr);
    Tcl_Release(rtPtr->interp);
    Tcl_Release(rtPtr);

    /*
     * Cleanup of the dynamic parts of the command.
     *
     * The detail objects survived the Tcl_EvalObjv without change because of
     * the contract. Therefore there is no need to decrement the refcounts. Only
     * the internal method object has to be disposed of.
     */

    Tcl_DecrRefCount(methObj);

    /*
     * The resObj has a ref count of 1 at this location. This means that the
     * caller of InvokeTclMethod has to dispose of it (but only if it was
     * returned to it).
     */

    if (resultObjPtr != NULL) {
	*resultObjPtr = resObj;
    }

    /*
     * There no need to handle the case where nothing is returned, because for
     * that case resObj was not set anyway.
     */

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * GetReflectedTransformMap --
 *
 *	Gets and potentially initializes the reflected channel map for an
 *	interpreter.
 *
 * Results:
 *	A pointer to the map created, for use by the caller.
 *
 * Side effects:
 *	Initializes the reflected channel map for an interpreter.
 *
 *----------------------------------------------------------------------
 */

static ReflectedTransformMap *
GetReflectedTransformMap(
    Tcl_Interp *interp)
{
    ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL);

    if (rtmPtr == NULL) {
	rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, RTMKEY,
		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
    }
    return rtmPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteReflectedTransformMap --
 *
 *	Deletes the channel table for an interpreter, closing any open
 *	channels whose refcount reaches zero. This procedure is invoked when
 *	an interpreter is deleted, via the AssocData cleanup mechanism.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the hash table of channels. May close channels. May flush
 *	output on closed channels. Removes any channeEvent handlers that were
 *	registered in this interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteReflectedTransformMap(
    ClientData clientData,	/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */
{
    ReflectedTransformMap *rtmPtr; /* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedTransform *rtPtr;
#if TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif /* TCL_THREADS */

    /*
     * Delete all entries. The channels may have been closed already, or will
     * be closed later, by the standard IO finalization of an interpreter
     * under destruction. Except for the channels which were moved to a
     * different interpreter and/or thread. They do not exist from the IO
     * systems point of view and will not get closed. Therefore mark all as
     * dead so that any future access will cause a proper error. For channels
     * in a different thread we actually do the same as
     * DeleteThreadReflectedTransformMap(), just restricted to the channels of
     * this interp.
     */

    rtmPtr = (ReflectedTransformMap *)clientData;
    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rtmPtr->map);
    Tcl_Free(&rtmPtr->map);

#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
     * through the channels and remove all which were handled by this
     * interpreter. They have already been marked as dead.
     */

    rtmPtr = GetThreadReflectedTransformMap();
    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&hSearch)) {
	rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

	if (rtPtr->interp != interp) {
	    /*
	     * Ignore entries for other interpreters.
	     */

	    continue;
	}

	rtPtr->dead = 1;
	FreeReflectedTransformArgs(rtPtr);
	Tcl_DeleteHashEntry(hPtr);
    }

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this interpreter. While this is in progress we block any
     * other access to the list of pending results.
     */

    Tcl_MutexLock(&rtForwardMutex);

    for (resultPtr = forwardList; resultPtr != NULL;
	    resultPtr = resultPtr->nextPtr) {
	if (resultPtr->dsti != interp) {
	    /*
	     * Ignore results/events for other interpreters.
	     */

	    continue;
	}

	/*
	 * The receiver for the event exited, before processing the event. We
	 * detach the result now, wake the originator up and signal failure.
	 */

	evPtr = resultPtr->evPtr;
	if (evPtr == NULL) {
	    continue;
	}
	paramPtr = evPtr->param;

	evPtr->resultPtr = NULL;
	resultPtr->evPtr = NULL;
	resultPtr->result = TCL_ERROR;

	ForwardSetStaticError(paramPtr, msg_send_dstlost);

	Tcl_ConditionNotify(&resultPtr->done);
    }
    Tcl_MutexUnlock(&rtForwardMutex);
#endif /* TCL_THREADS */
}

#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedTransformMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.
 *
 * Results:
 *	A pointer to the map created, for use by the caller.
 *
 * Side effects:
 *	Initializes the reflected channel map for a thread.
 *
 *----------------------------------------------------------------------
 */

static ReflectedTransformMap *
GetThreadReflectedTransformMap(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->rtmPtr) {
	tsdPtr->rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap));
	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
    }

    return tsdPtr->rtmPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteThreadReflectedTransformMap --
 *
 *	Deletes the channel table for a thread. This procedure is invoked when
 *	a thread is deleted. The channels have already been marked as dead, in
 *	DeleteReflectedTransformMap().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the hash table of channels.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteThreadReflectedTransformMap(
    TCL_UNUSED(ClientData))
{
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    Tcl_ThreadId self = Tcl_GetCurrentThread();
    ReflectedTransformMap *rtmPtr; /* The map */
    ForwardingResult *resultPtr;

    /*
     * The origin thread for one or more reflected channels is gone.
     * NOTE: If this function is called due to a thread getting killed the
     *       per-interp DeleteReflectedTransformMap is apparently not called.
     */

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
     * through the channels, remove all, mark them as dead.
     */

    rtmPtr = GetThreadReflectedTransformMap();
    for (hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch);
	    hPtr != NULL;
	    hPtr = Tcl_FirstHashEntry(&rtmPtr->map, &hSearch)) {
	ReflectedTransform *rtPtr = (ReflectedTransform *)Tcl_GetHashValue(hPtr);

	rtPtr->dead = 1;
	FreeReflectedTransformArgs(rtPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_Free(rtmPtr);

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this thread. While this is in progress we block any
     * other access to the list of pending results.
     */

    Tcl_MutexLock(&rtForwardMutex);

    for (resultPtr = forwardList; resultPtr != NULL;
	    resultPtr = resultPtr->nextPtr) {
	ForwardingEvent *evPtr;
	ForwardParam *paramPtr;

	if (resultPtr->dst != self) {
	    /*
	     * Ignore results/events for other threads.
	     */

	    continue;
	}

	/*
	 * The receiver for the event exited, before processing the event. We
	 * detach the result now, wake the originator up and signal failure.
	 */

	evPtr = resultPtr->evPtr;
	if (evPtr == NULL) {
	    continue;
	}
	paramPtr = evPtr->param;

	evPtr->resultPtr = NULL;
	resultPtr->evPtr = NULL;
	resultPtr->result = TCL_ERROR;

	ForwardSetStaticError(paramPtr, msg_send_dstlost);

	Tcl_ConditionNotify(&resultPtr->done);
    }
    Tcl_MutexUnlock(&rtForwardMutex);
}

static void
ForwardOpToOwnerThread(
    ReflectedTransform *rtPtr,	/* Channel instance */
    ForwardedOperation op,	/* Forwarded driver operation */
    const void *param)		/* Arguments */
{
    Tcl_ThreadId dst = rtPtr->thread;
    ForwardingEvent *evPtr;
    ForwardingResult *resultPtr;

    /*
     * We gather the lock early. This allows us to check the liveness of the
     * channel without interference from DeleteThreadReflectedTransformMap().
     */

    Tcl_MutexLock(&rtForwardMutex);

    if (rtPtr->dead) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error. Do not forget to unlock the mutex on this path.
	 */

	ForwardSetStaticError((ForwardParam *) param, msg_send_dstlost);
	Tcl_MutexUnlock(&rtForwardMutex);
	return;
    }

    /*
     * Create and initialize the event and data structures.
     */

    evPtr = (ForwardingEvent *)Tcl_Alloc(sizeof(ForwardingEvent));
    resultPtr = (ForwardingResult *)Tcl_Alloc(sizeof(ForwardingResult));

    evPtr->event.proc = ForwardProc;
    evPtr->resultPtr = resultPtr;
    evPtr->op = op;
    evPtr->rtPtr = rtPtr;
    evPtr->param = (ForwardParam *) param;

    resultPtr->src = Tcl_GetCurrentThread();
    resultPtr->dst = dst;
    resultPtr->dsti = rtPtr->interp;
    resultPtr->done = NULL;
    resultPtr->result = -1;
    resultPtr->evPtr = evPtr;

    /*
     * Now execute the forward.
     */

    TclSpliceIn(resultPtr, forwardList);
    /* Do not unlock here. That is done by the ConditionWait */

    /*
     * Ensure cleanup of the event if the origin thread exits while this event
     * is pending or in progress. Exit of the destination thread is handled by
     * DeleteThreadReflectionChannelMap(), this is set up by
     * GetThreadReflectedTransformMap(). This is what we use the 'forwardList'
     * (see above) for.
     */

    Tcl_CreateThreadExitHandler(SrcExitProc, evPtr);

    /*
     * Queue the event and poke the other thread's notifier.
     */

    Tcl_ThreadQueueEvent(dst, (Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
    Tcl_ThreadAlert(dst);

    /*
     * (*) Block until the other thread has either processed the transfer or
     * rejected it.
     */

    while (resultPtr->result < 0) {
	/*
	 * NOTE (1): Is it possible that the current thread goes away while
	 * waiting here? IOW Is it possible that "SrcExitProc" is called
	 * while we are here? See complementary note (2) in "SrcExitProc"
	 *
	 * The ConditionWait unlocks the mutex during the wait and relocks it
	 * immediately after.
	 */

	Tcl_ConditionWait(&resultPtr->done, &rtForwardMutex, NULL);
    }

    /*
     * Unlink result from the forwarder list. No need to lock. Either still
     * locked, or locked by the ConditionWait
     */

    TclSpliceOut(resultPtr, forwardList);

    resultPtr->nextPtr = NULL;
    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&rtForwardMutex);
    Tcl_ConditionFinalize(&resultPtr->done);

    /*
     * Kill the cleanup handler now, and the result structure as well, before
     * returning the success code.
     *
     * Note: The event structure has already been deleted by the destination
     * notifier, after it serviced the event.
     */

    Tcl_DeleteThreadExitHandler(SrcExitProc, evPtr);

    Tcl_Free(resultPtr);
}

static int
ForwardProc(
    Tcl_Event *evGPtr,
    TCL_UNUSED(int) /*mask*/)
{
    /*
     * Notes regarding access to the referenced data.
     *
     * In principle the data belongs to the originating thread (see
     * evPtr->src), however this thread is currently blocked at (*), i.e.
     * quiescent. Because of this we can treat the data as belonging to us,
     * without fear of race conditions. I.e. we can read and write as we like.
     *
     * The only thing we cannot be sure of is the resultPtr. This can be be
     * NULLed if the originating thread went away while the event is handled
     * here now.
     */

    ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr;
    ForwardingResult *resultPtr = evPtr->resultPtr;
    ReflectedTransform *rtPtr = evPtr->rtPtr;
    Tcl_Interp *interp = rtPtr->interp;
    ForwardParam *paramPtr = evPtr->param;
    Tcl_Obj *resObj = NULL;	/* Interp result of InvokeTclMethod */
    ReflectedTransformMap *rtmPtr;
				/* Map of reflected channels with handlers in
				 * this interp. */
    Tcl_HashEntry *hPtr;	/* Entry in the above map */

    /*
     * Ignore the event if no one is waiting for its result anymore.
     */

    if (!resultPtr) {
	return 1;
    }

    paramPtr->base.code = TCL_OK;
    paramPtr->base.msgStr = NULL;
    paramPtr->base.mustFree = 0;

    switch (evPtr->op) {
	/*
	 * The destination thread for the following operations is
	 * rtPtr->thread, which contains rtPtr->interp, the interp we have to
	 * call upon for the driver.
	 */

    case ForwardedClose:
	/*
	 * No parameters/results.
	 */

	if (InvokeTclMethod(rtPtr, "finalize", NULL, NULL,
		&resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}

	/*
	 * Freeing is done here, in the origin thread, because the argv[]
	 * objects belong to this thread. Deallocating them in a different
	 * thread is not allowed
	 */

	/*
	 * Remove the channel from the map before releasing the memory, to
	 * prevent future accesses (like by 'postevent') from finding and
	 * dereferencing a dangling pointer.
	 */

	rtmPtr = GetReflectedTransformMap(interp);
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	/*
	 * In a threaded interpreter we manage a per-thread map as well, to
	 * allow us to survive if the script level pulls the rug out under a
	 * channel by deleting the owning thread.
	 */

	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	Tcl_DeleteHashEntry(hPtr);

	FreeReflectedTransformArgs(rtPtr);
	break;

    case ForwardedInput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
		paramPtr->transform.buf, paramPtr->transform.size);
	Tcl_IncrRefCount(bufObj);

	if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec = 0;	/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
    }

    case ForwardedOutput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
		paramPtr->transform.buf, paramPtr->transform.size);
	Tcl_IncrRefCount(bufObj);

	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec = 0;	/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}

	Tcl_DecrRefCount(bufObj);
	break;
    }

    case ForwardedDrain:
	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec = 0;	/* Number of returned bytes */
	    unsigned char *bytev; /* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedFlush:
	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->transform.size = TCL_INDEX_NONE;
	} else {
	    /*
	     * Process a regular return. Contains the transformation result.
	     * Sent it back to the request originator.
	     */

	    size_t bytec = 0;	/* Number of returned bytes */
	    unsigned char *bytev;
				/* Array of returned bytes */

	    bytev = TclGetByteArrayFromObj(resObj, &bytec);

	    paramPtr->transform.size = bytec;

	    if (bytec > 0) {
		paramPtr->transform.buf = (char *)Tcl_Alloc(bytec);
		memcpy(paramPtr->transform.buf, bytev, bytec);
	    } else {
		paramPtr->transform.buf = NULL;
	    }
	}
	break;

    case ForwardedClear:
	(void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);
	break;

    case ForwardedLimit:
	if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->limit.max = -1;
	} else if (Tcl_GetIntFromObj(interp, resObj,
		&paramPtr->limit.max) != TCL_OK) {
	    ForwardSetObjError(paramPtr, MarshallError(interp));
	    paramPtr->limit.max = -1;
	}
	break;

    default:
	/*
	 * Bad operation code.
	 */
	Tcl_Panic("Bad operation code in ForwardProc");
	break;
    }

    /*
     * Remove the reference we held on the result of the invoke, if we had
     * such.
     */

    if (resObj != NULL) {
	Tcl_DecrRefCount(resObj);
    }

    if (resultPtr) {
	/*
	 * Report the forwarding result synchronously to the waiting caller.
	 * This unblocks (*) as well. This is wrapped into a conditional
	 * because the caller may have exited in the mean time.
	 */

	Tcl_MutexLock(&rtForwardMutex);
	resultPtr->result = TCL_OK;
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&rtForwardMutex);
    }

    return 1;
}

static void
SrcExitProc(
    ClientData clientData)
{
    ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
    ForwardingResult *resultPtr;
    ForwardParam *paramPtr;

    /*
     * NOTE (2): Can this handler be called with the originator blocked?
     */

    /*
     * The originator for the event exited. It is not sure if this can happen,
     * as the originator should be blocked at (*) while the event is in
     * transit/pending.
     *
     * We make sure that the event cannot refer to the result anymore, remove
     * it from the list of pending results and free the structure. Locking the
     * access ensures that we cannot get in conflict with "ForwardProc",
     * should it already execute the event.
     */

    Tcl_MutexLock(&rtForwardMutex);

    resultPtr = evPtr->resultPtr;
    paramPtr = evPtr->param;

    evPtr->resultPtr = NULL;
    resultPtr->evPtr = NULL;
    resultPtr->result = TCL_ERROR;

    ForwardSetStaticError(paramPtr, msg_send_originlost);

    /*
     * See below: TclSpliceOut(resultPtr, forwardList);
     */

    Tcl_MutexUnlock(&rtForwardMutex);

    /*
     * This unlocks (*). The structure will be spliced out and freed by
     * "ForwardProc". Maybe.
     */

    Tcl_ConditionNotify(&resultPtr->done);
}

static void
ForwardSetObjError(
    ForwardParam *paramPtr,
    Tcl_Obj *obj)
{
    size_t len;
    const char *msgStr = TclGetStringFromObj(obj, &len);

    len++;
    ForwardSetDynamicError(paramPtr, Tcl_Alloc(len));
    memcpy(paramPtr->base.msgStr, msgStr, len);
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TimerKill --
 *
 *	Timer management. Removes the internal timer if it exists.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TimerKill(
    ReflectedTransform *rtPtr)
{
    if (rtPtr->timer == NULL) {
	return;
    }

    /*
     * Delete an existing flush-out timer, prevent it from firing on a
     * removed/dead channel.
     */

    Tcl_DeleteTimerHandler(rtPtr->timer);
    rtPtr->timer = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TimerSetup --
 *
 *	Timer management. Creates the internal timer if it does not exist.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TimerSetup(
    ReflectedTransform *rtPtr)
{
    if (rtPtr->timer != NULL) {
	return;
    }

    rtPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
	    TimerRun, rtPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TimerRun --
 *
 *	Called by the notifier (-> timer) to flush out information waiting in
 *	channel buffers.
 *
 * Side effects:
 *	As of 'Tcl_NotifyChannel'.
 *
 * Result:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TimerRun(
    ClientData clientData)
{
    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;

    rtPtr->timer = NULL;
    Tcl_NotifyChannel(rtPtr->chan, TCL_READABLE);
}

/*
 *----------------------------------------------------------------------
 *
 * ResultInit --
 *
 *	Initializes the specified buffer structure. The structure will contain
 *	valid information for an emtpy buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
ResultInit(
    ResultBuffer *rPtr)		/* Reference to the structure to
				 * initialize. */
{
    rPtr->used = 0;
    rPtr->allocated = 0;
    rPtr->buf = NULL;
}
/*
 *----------------------------------------------------------------------
 *
 * ResultClear --
 *
 *	Deallocates any memory allocated by 'ResultAdd'.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
ResultClear(
    ResultBuffer *rPtr)		/* Reference to the buffer to clear out */
{
    rPtr->used = 0;

    if (!rPtr->allocated) {
	return;
    }

    Tcl_Free(rPtr->buf);
    rPtr->buf = NULL;
    rPtr->allocated = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ResultAdd --
 *
 *	Adds the bytes in the specified array to the buffer, by appending it.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
ResultAdd(
    ResultBuffer *rPtr,		/* The buffer to extend */
    unsigned char *buf,		/* The buffer to read from */
    int toWrite)		/* The number of bytes in 'buf' */
{
    if ((rPtr->used + toWrite + 1) > rPtr->allocated) {
	/*
	 * Extension of the internal buffer is required.
	 * NOTE: Currently linear. Should be doubling to amortize.
	 */

	if (rPtr->allocated == 0) {
	    rPtr->allocated = toWrite + RB_INCREMENT;
	    rPtr->buf = UCHARP(Tcl_Alloc(rPtr->allocated));
	} else {
	    rPtr->allocated += toWrite + RB_INCREMENT;
	    rPtr->buf = UCHARP(Tcl_Realloc((char *) rPtr->buf,
		    rPtr->allocated));
	}
    }

    /*
     * Now copy data.
     */

    memcpy(rPtr->buf + rPtr->used, buf, toWrite);
    rPtr->used += toWrite;
}

/*
 *----------------------------------------------------------------------
 *
 * ResultCopy --
 *
 *	Copies the requested number of bytes from the buffer into the
 *	specified array and removes them from the buffer afterward. Copies
 *	less if there is not enough data in the buffer.
 *
 * Side effects:
 *	See above.
 *
 * Result:
 *	The number of actually copied bytes, possibly less than 'toRead'.
 *
 *----------------------------------------------------------------------
 */

static int
ResultCopy(
    ResultBuffer *rPtr,		/* The buffer to read from */
    unsigned char *buf,		/* The buffer to copy into */
    int toRead)			/* Number of requested bytes */
{
    int copied;

    if (rPtr->used == 0) {
	/*
	 * Nothing to copy in the case of an empty buffer.
	 */

	copied = 0;
    } else if (rPtr->used == (size_t)toRead) {
	/*
	 * We have just enough. Copy everything to the caller.
	 */

	memcpy(buf, rPtr->buf, toRead);
	rPtr->used = 0;
	copied = toRead;
    } else if (rPtr->used > (size_t)toRead) {
	/*
	 * The internal buffer contains more than requested. Copy the
	 * requested subset to the caller, and shift the remaining bytes down.
	 */

	memcpy(buf, rPtr->buf, toRead);
	memmove(rPtr->buf, rPtr->buf + toRead, rPtr->used - toRead);

	rPtr->used -= toRead;
	copied = toRead;
    } else {
	/*
	 * There is not enough in the buffer to satisfy the caller, so take
	 * everything.
	 */

	memcpy(buf, rPtr->buf, rPtr->used);
	toRead = rPtr->used;
	rPtr->used = 0;
	copied = toRead;
    }

    /* -- common postwork code ------- */

    return copied;
}

static int
TransformRead(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    Tcl_Obj *bufObj)
{
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) TclGetByteArrayFromObj(bufObj,
		&(p.transform.size));

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
	Tcl_Free(p.transform.buf);
	return 1;
    }
#endif /* TCL_THREADS */

    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
    /* ASSERT: rtPtr->mode & TCL_READABLE */

    if (InvokeTclMethod(rtPtr, "read", bufObj, NULL, &resObj) != TCL_OK) {
	Tcl_SetChannelError(rtPtr->chan, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	*errorCodePtr = EINVAL;
	return 0;
    }

    bytev = TclGetByteArrayFromObj(resObj, &bytec);
    ResultAdd(&rtPtr->result, bytev, bytec);

    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    return 1;
}

static int
TransformWrite(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    unsigned char *buf,
    int toWrite)
{
    Tcl_Obj *bufObj;
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) buf;
	p.transform.size = toWrite;

	ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		p.transform.size);
	Tcl_Free(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	/* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
	/* ASSERT: rtPtr->mode & TCL_WRITABLE */

	bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
	Tcl_IncrRefCount(bufObj);
	if (InvokeTclMethod(rtPtr, "write", bufObj, NULL, &resObj) != TCL_OK) {
	    *errorCodePtr = EINVAL;
	    Tcl_SetChannelError(rtPtr->chan, resObj);

	    Tcl_DecrRefCount(bufObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    return 0;
	}

	*errorCodePtr = EOK;

	bytev = TclGetByteArrayFromObj(resObj, &bytec);
	res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);

	Tcl_DecrRefCount(bufObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    if (res < 0) {
	*errorCodePtr = Tcl_GetErrno();
	return 0;
    }

    return 1;
}

static int
TransformDrain(
    ReflectedTransform *rtPtr,
    int *errorCodePtr)
{
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	ResultAdd(&rtPtr->result, UCHARP(p.transform.buf), p.transform.size);
	Tcl_Free(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
	    Tcl_SetChannelError(rtPtr->chan, resObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	bytev = TclGetByteArrayFromObj(resObj, &bytec);
	ResultAdd(&rtPtr->result, bytev, bytec);

	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    rtPtr->readIsDrained = 1;
    return 1;
}

static int
TransformFlush(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    int op)
{
    Tcl_Obj *resObj;
    size_t bytec = 0;		/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	if (op == FLUSH_WRITE) {
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) p.transform.buf,
		    p.transform.size);
	} else {
	    res = 0;
	}
	Tcl_Free(p.transform.buf);
    } else
#endif /* TCL_THREADS */
    {
	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
	    Tcl_SetChannelError(rtPtr->chan, resObj);
	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	if (op == FLUSH_WRITE) {
	    bytev = TclGetByteArrayFromObj(resObj, &bytec);
	    res = Tcl_WriteRaw(rtPtr->parent, (char *) bytev, bytec);
	} else {
	    res = 0;
	}
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
    }

    if (res < 0) {
	*errorCodePtr = Tcl_GetErrno();
	return 0;
    }

    return 1;
}

static void
TransformClear(
    ReflectedTransform *rtPtr)
{
    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
	return;
    }
#endif /* TCL_THREADS */

    /* ASSERT: rtPtr->method & FLAG(METH_READ) */
    /* ASSERT: rtPtr->mode & TCL_READABLE */

    (void) InvokeTclMethod(rtPtr, "clear", NULL, NULL, NULL);

    rtPtr->readIsDrained = 0;
    rtPtr->eofPending = 0;
    ResultClear(&rtPtr->result);
}

static int
TransformLimit(
    ReflectedTransform *rtPtr,
    int *errorCodePtr,
    int *maxPtr)
{
    Tcl_Obj *resObj;
    Tcl_InterpState sr;		/* State of handler interp */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
	    *errorCodePtr = EINVAL;
	    return 0;
	}

	*errorCodePtr = EOK;
	*maxPtr = p.limit.max;
	return 1;
    }
#endif

    /* ASSERT: rtPtr->method & FLAG(METH_WRITE) */
    /* ASSERT: rtPtr->mode & TCL_WRITABLE */

    if (InvokeTclMethod(rtPtr, "limit?", NULL, NULL, &resObj) != TCL_OK) {
	Tcl_SetChannelError(rtPtr->chan, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	*errorCodePtr = EINVAL;
	return 0;
    }

    sr = Tcl_SaveInterpState(rtPtr->interp, 0 /* Dummy */);

    if (Tcl_GetIntFromObj(rtPtr->interp, resObj, maxPtr) != TCL_OK) {
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	Tcl_SetChannelError(rtPtr->chan, MarshallError(rtPtr->interp));
	*errorCodePtr = EINVAL;

	Tcl_RestoreInterpState(rtPtr->interp, sr);
	return 0;
    }

    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
    Tcl_RestoreInterpState(rtPtr->interp, sr);
    return 1;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclIOSock.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
1
2
3
4
5
6
7
8
9
10
11
12





























13
14
15
16
17
18
19












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







/*
 * tclIOSock.c --
 *
 *	Common routines used by all socket based channel types.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if defined(_WIN32)
/*
 * On Windows, we need to do proper Unicode->UTF-8 conversion.
 */

typedef struct {
    int initialized;
    Tcl_DString errorMsg; /* UTF-8 encoded error-message */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#undef gai_strerror
static const char *
gai_strerror(
    int code)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->initialized) {
	Tcl_DStringSetLength(&tsdPtr->errorMsg, 0);
    } else {
	Tcl_DStringInit(&tsdPtr->errorMsg);
	tsdPtr->initialized = 1;
    }
    Tcl_WCharToUtfDString(gai_strerrorW(code), -1, &tsdPtr->errorMsg);
    return Tcl_DStringValue(&tsdPtr->errorMsg);
}
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclSockGetPort --
 *
 *	Maps from a string, which could be a service name, to a port. Used by
58
59
60
61
62
63
64
65
66


67
68
69
70
71
72
73
29
30
31
32
33
34
35


36
37
38
39
40
41
42
43
44







-
-
+
+







 *
 *---------------------------------------------------------------------------
 */

int
TclSockGetPort(
    Tcl_Interp *interp,
    const char *string,		/* Integer or service name */
    const char *proto,		/* "tcp" or "udp", typically */
    const char *string, /* Integer or service name */
    const char *proto, /* "tcp" or "udp", typically */
    int *portPtr)		/* Return port number */
{
    struct servent *sp;		/* Protocol info for named services */
    Tcl_DString ds;
    const char *native;

    if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
83
84
85
86
87
88
89
90
91


92
93
94
95
96
97
98
54
55
56
57
58
59
60


61
62
63
64
65
66
67
68
69







-
-
+
+







	    return TCL_OK;
	}
    }
    if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
	return TCL_ERROR;
    }
    if (*portPtr > 0xFFFF) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"couldn't open socket: port number too high", -1));
	Tcl_AppendResult(interp, "couldn't open socket: port number too high",
		NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
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







+













-
+
-


-
+
-


-
+
-


-
+
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








 *
 * Side effects:
 *	Sets SO_SNDBUF and SO_RCVBUF sizes.
 *
 *----------------------------------------------------------------------
 */

#undef TclSockMinimumBuffers
#if !defined(_WIN32) && !defined(__CYGWIN__)
#   define SOCKET int
#endif

int
TclSockMinimumBuffers(
    void *sock,			/* Socket file descriptor */
    int size)			/* Minimum buffer size */
{
    int current;
    socklen_t len;

    len = sizeof(int);
    getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
    getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
	    (char *) &current, &len);
    if (current < size) {
	len = sizeof(int);
	setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_SNDBUF,
	setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
		(char *) &size, len);
    }
    len = sizeof(int);
    getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
    getsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
	    (char *) &current, &len);
    if (current < size) {
	len = sizeof(int);
	setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
	setsockopt((SOCKET)(size_t)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
		(char *) &size, len);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateSocketAddress --
 *
 *	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.
 *
 *----------------------------------------------------------------------
 */

int
TclCreateSocketAddress(
    Tcl_Interp *interp,		/* Interpreter for querying the desired socket
				 * family */
    struct addrinfo **addrlist,	/* Socket address list */
    const char *host,		/* Host. NULL implies INADDR_ANY */
    int port,			/* Port number */
    int willBind,		/* Is this an address to bind() to or to
				 * connect() to? */
    const char **errorMsgPtr)	/* Place to store the error message detail, if
				 * available. */
{
    struct addrinfo hints;
    struct addrinfo *p;
    struct addrinfo *v4head = NULL, *v4ptr = NULL;
    struct addrinfo *v6head = NULL, *v6ptr = NULL;
    char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring;
    const char *family = NULL;
    Tcl_DString ds;
    int result;

    if (host != NULL) {
	native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
    }

    /*
     * Workaround for OSX's apparent inability to resolve "localhost", "0"
     * when the loopback device is the only available network interface.
     */

    if (host != NULL && port == 0) {
	portstring = NULL;
    } else {
	TclFormatInt(portbuf, port);
	portstring = portbuf;
    }

    (void) memset(&hints, 0, sizeof(hints));
    hints.ai_family = AF_UNSPEC;

    /*
     * Magic variable to enforce a certain address family; to be superseded
     * by a TIP that adds explicit switches to [socket].
     */

    if (interp != NULL) {
	family = Tcl_GetVar2(interp, "::tcl::unsupported::socketAF", NULL, 0);
	if (family != NULL) {
	    if (strcmp(family, "inet") == 0) {
		hints.ai_family = AF_INET;
	    } 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 is probably low even in situations where it works,
     * we'll leave it out for now. After all, it is just an optimisation.
     *
     * Missing on 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) {
	Tcl_DStringFree(&ds);
    }

    if (result != 0) {
	*errorMsgPtr =
#ifdef EAI_SYSTEM	/* Doesn't exist on Windows */
		(result == EAI_SYSTEM) ? Tcl_PosixError(interp) :
#endif /* EAI_SYSTEM */
		gai_strerror(result);
        return 0;
    }

    /*
     * Put IPv4 addresses before IPv6 addresses to maximize backwards
     * compatibility of [fconfigure -sockname] output.
     *
     * There might be more elegant/efficient ways to do this.
     */

    if (willBind) {
	for (p = *addrlist; p != NULL; p = p->ai_next) {
	    if (p->ai_family == AF_INET) {
		if (v4head == NULL) {
		    v4head = p;
		} else {
		    v4ptr->ai_next = p;
		}
		v4ptr = p;
	    } else {
		if (v6head == NULL) {
		    v6head = p;
		} else {
		    v6ptr->ai_next = p;
		}
		v6ptr = p;
	    }
	}
	*addrlist = NULL;
	if (v6head != NULL) {
	    *addrlist = v6head;
	    v6ptr->ai_next = NULL;
	}
	if (v4head != NULL) {
	    v4ptr->ai_next = *addrlist;
	    *addrlist = v4head;
	}
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpServer --
 *
 *	Opens a TCP server socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. If an error occurred, an error message
 *	is left in the interp's result if interp is not NULL.
 *
 * Side effects:
 *	Opens a server socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpServer(
    Tcl_Interp *interp,
    int port,
    const char *host,
    Tcl_TcpAcceptProc *acceptProc,
    ClientData callbackData)
{
    char portbuf[TCL_INTEGER_SPACE];

    TclFormatInt(portbuf, port);
    return Tcl_OpenTcpServerEx(interp, portbuf, host, TCL_TCPSERVER_REUSEADDR,
	    acceptProc, callbackData);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclIOUtil.c.

1
2
3
4
5
6
7
8








9
10
11
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30
31
32

33

34
35
36
37

38
39

40
41
42


43
44
45


46
47
48





49
50
51

52
53

54
55
56
57


58
59
60
61
62
63

64
65
66
67

68
69
70
71
72
73
74
75
76
77

78
79
80
81
82
83
84
85

86
87

88
89

90
91
92

93
94
95
96
97
98

99
100
101
102
103
104
105

106
107
108
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177

178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244

245
246
247
248
249

250
251
252
253
254
255
256
257
258
259
260


261
262
263
264
265
266
267
268
269
270
271
272
273
274
275


276
277

278
279
280
281
282
283
284
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



-
-
-
-
-
+
+
+
+
+
+
+
+










-
+













+
-
+



-
+

-
+

-
-
+
+

-
-
+
+



+
+
+
+
+


-
+

-
+
-
-
-
-
+
+
-
-
-


-
+



-
+


-







+




-
-
-
-
+

-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-


-
+


-

-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+




-
+







-

-
-
+
+













-
-
+
+

-
+







/*
 * tclIOUtil.c --
 *
 *	Provides an interface for managing filesystems in Tcl, and also for
 *	creating a filesystem interface in Tcl arbitrary facilities.  All
 *	filesystem operations are performed via this interface.  Vince Darley
 *	is the primary author.  Other signifiant contributors are Karl
 *	Lehenbauer, Mark Diekhans and Peter da Silva.
 *	This file contains the implementation of Tcl's generic filesystem
 *	code, which supports a pluggable filesystem architecture allowing both
 *	platform specific filesystems and 'virtual filesystems'. All
 *	filesystem access should go through the functions defined in this
 *	file. Most of this code was contributed by Vince Darley.
 *
 *	Parts of this file are based on code contributed by Karl Lehenbauer,
 *	Mark Diekhans and Peter da Silva.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * 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
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

#ifdef TCL_TEMPLOAD_NO_UNLINK
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
#endif

/*
 * struct FilesystemRecord --
 *
 * A filesystem record is used to keep track of each filesystem currently
 * An item in a linked list of registered filesystems
 * registered with the core, in a linked list.
 */

typedef struct FilesystemRecord {
    ClientData clientData;	/* Client-specific data for the filesystem
    ClientData clientData;	/* Client specific data for the new filesystem
				 * (can be NULL) */
    const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */
    Tcl_Filesystem *fsPtr;	/* Pointer to filesystem dispatch table. */
    struct FilesystemRecord *nextPtr;
				/* The next registered filesystem, or NULL to
				 * indicate the end of the list. */
				/* The next filesystem registered to Tcl, or
				 * NULL if no more. */
    struct FilesystemRecord *prevPtr;
				/* The previous filesystem, or NULL to indicate
				 * the ned of the list */
				/* The previous filesystem registered to Tcl,
				 * or NULL if no more. */
} FilesystemRecord;

/*
 * This structure holds per-thread private copy of the current directory
 * maintained by the global cwdPathPtr. This structure holds per-thread
 * private copies of some global data. This way we avoid most of the
 * synchronization calls which boosts performance, at cost of having to update
 * this information each time the corresponding epoch counter changes.
 */

typedef struct {
typedef struct ThreadSpecificData {
    int initialized;
    size_t cwdPathEpoch;	/* Compared with the global cwdPathEpoch to
    int cwdPathEpoch;
				 * determine whether cwdPathPtr is stale.
				 */
    size_t filesystemEpoch;
    Tcl_Obj *cwdPathPtr;	/* A private copy of cwdPathPtr. Updated when
    int filesystemEpoch;
    Tcl_Obj *cwdPathPtr;
				 * the value is accessed  and cwdPathEpoch has
				 * changed.
				 */
    ClientData cwdClientData;
    FilesystemRecord *filesystemList;
    size_t claims;
    int claims;
} ThreadSpecificData;

/*
 * Forward declarations.
 * Prototypes for functions defined later in this file.
 */

static Tcl_NRPostProc	EvalFileCallback;
static FilesystemRecord*FsGetFirstFilesystem(void);
static void		FsThrExitProc(ClientData cd);
static Tcl_Obj *	FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
			    Tcl_Obj *pathPtr, const char *pattern,
			    Tcl_GlobTypeData *types);
static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);

static void		FsRecacheFilesystemList(void);
static void		Claim(void);
static void		Disclaim(void);

static void *		DivertFindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		DivertUnloadFile(Tcl_LoadHandle loadHandle);


/*
 * Functions that provide native filesystem support. They are private and
 * These form part of the native filesystem support. They are needed here
 * should be used only here.  They should be called instead of calling Tclp...
 * native filesystem functions.  Others should use the Tcl_FS... functions
 * because we have a few native filesystem functions (which are the same for
 * which ensure correct and complete virtual filesystem support.
 */

 * win/unix) in this file. There is no need to place them in tclInt.h, because
static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
static Tcl_FSFileAttrsGetProc	NativeFileAttrsGet;
static Tcl_FSFileAttrsSetProc	NativeFileAttrsSet;

 * they are not (and should not be) used anywhere else.
/*
 * Functions that support the native filesystem functions listed above.  They
 * are the same for win/unix, and not in tclInt.h because they are and should
 * be used only here.
 */

MODULE_SCOPE const char *const		tclpFileAttrStrings[];
MODULE_SCOPE const char *		tclpFileAttrStrings[];
MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];


/*
 * These these functions are not static either because routines in the native
 * (win/unix) directories call them or they are actually implemented in those
 * directories. They should be called from outside Tcl's native filesystem
 * routines. If we ever built the native filesystem support into a separate
 * code library, this could actually be enforced.
 */

 * The following functions are obsolete string based APIs, and should be
Tcl_FSFilesystemPathTypeProc	TclpFilesystemPathType;
Tcl_FSInternalToNormalizedProc	TclpNativeToNormalized;
Tcl_FSStatProc			TclpObjStat;
Tcl_FSAccessProc		TclpObjAccess;
Tcl_FSMatchInDirectoryProc	TclpMatchInDirectory;
Tcl_FSChdirProc			TclpObjChdir;
Tcl_FSLstatProc			TclpObjLstat;
Tcl_FSCopyFileProc		TclpObjCopyFile;
Tcl_FSDeleteFileProc		TclpObjDeleteFile;
Tcl_FSRenameFileProc		TclpObjRenameFile;
Tcl_FSCreateDirectoryProc	TclpObjCreateDirectory;
Tcl_FSCopyDirectoryProc		TclpObjCopyDirectory;
Tcl_FSRemoveDirectoryProc	TclpObjRemoveDirectory;
Tcl_FSLinkProc			TclpObjLink;
Tcl_FSListVolumesProc		TclpObjListVolumes;

 * removed in a future release (Tcl 9 would be a good time).
/*
 * The native filesystem dispatch table.  This could me made public but it
 * should only be accessed by the functions it points to, or perhaps
 * subordinate helper functions.
 */

const Tcl_Filesystem tclNativeFilesystem = {
    "native",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    TclNativePathInFilesystem,
    TclNativeDupInternalRep,
    NativeFreeInternalRep,
    TclpNativeToNormalized,
    TclNativeCreateNativeRep,
    TclpObjNormalizePath,
    TclpFilesystemPathType,
    NativeFilesystemSeparator,
    TclpObjStat,
    TclpObjAccess,
    TclpOpenFileChannel,
    TclpMatchInDirectory,
    TclpUtime,
#ifndef S_IFLNK
    NULL,
#else
    TclpObjLink,
#endif /* S_IFLNK */
    TclpObjListVolumes,
    NativeFileAttrStrings,
    NativeFileAttrsGet,
    NativeFileAttrsSet,
    TclpObjCreateDirectory,
    TclpObjRemoveDirectory,
    TclpObjDeleteFile,
    TclpObjCopyFile,
    TclpObjRenameFile,
    TclpObjCopyDirectory,
    TclpObjLstat,
    /* Needs casts since we're using version_2. */
    (Tcl_FSLoadFileProc *)(void *) TclpDlopen,
    (Tcl_FSGetCwdProc *) TclpGetNativeCwd,
    TclpObjChdir
};


/*
 * An initial record in the linked list for the native filesystem.  Remains at
 * the tail of the list and is never freed.  Currently the native filesystem is
 * hard-coded.  It may make sense to modify this to accomodate unconventional
 * uses of Tcl that provide no native filesystem.
 */

static FilesystemRecord nativeFilesystemRecord = {
    NULL,
    &tclNativeFilesystem,
    NULL,
    NULL
};

/*
 * Incremented each time the linked list of filesystems is modified.  For
 * multithreaded builds, invalidates all cached filesystem internal
 * representations.
 */

static size_t theFilesystemEpoch = 1;

/*
 * The linked list of filesystems.  To minimize locking each thread maintains a
 * local copy of this list.
 *
 */

static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
TCL_DECLARE_MUTEX(filesystemMutex)

/*
 * A files-system indepent sense of the current directory.
 */

static Tcl_Obj *cwdPathPtr = NULL;
static size_t cwdPathEpoch = 0;	    /* The pathname of the current directory */
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

static Tcl_ThreadDataKey fsDataKey;

/*
 * When a temporary copy of a file is created on the native filesystem in order
 * to load the file, an FsDivertLoad structure is created to track both the
 * actual unloadProc/clientData combination which was used, and the original and
 * modified filenames.  This makes it possible to correctly undo the entire
 * operation in order to unload the library.
 */

typedef struct {
    Tcl_LoadHandle loadHandle;
    Tcl_FSUnloadFileProc *unloadProcPtr;
    Tcl_Obj *divertedFile;
    const Tcl_Filesystem *divertedFilesystem;
    ClientData divertedFileNativeRep;
} FsDivertLoad;

/*
 * Obsolete string-based APIs that should be removed in a future release,
 * perhaps in Tcl 9.
 */

/* Obsolete */
int
Tcl_Stat(
    const char *path,		/* Pathname of file to stat (in current CP). */
    const char *path,		/* Path of file to stat (in current CP). */
    struct stat *oldStyleBuf)	/* Filled with results of stat call. */
{
    int ret;
    Tcl_StatBuf buf;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSStat(pathPtr, &buf);
    Tcl_DecrRefCount(pathPtr);
    if (ret != -1) {
#ifndef TCL_WIDE_INT_IS_LONG
	Tcl_WideInt tmp1, tmp2, tmp3 = 0;

# define OUT_OF_RANGE(x) \
	(((Tcl_WideInt)(x)) < LONG_MIN || \
	 ((Tcl_WideInt)(x)) > LONG_MAX)
	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
# define OUT_OF_URANGE(x) \
	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))

	/*
	 * Perform the result-buffer overflow check manually.
	 *
	 * Note that ino_t/ino64_t is unsigned...
	 *
	 * Workaround gcc warning of "comparison is always false due to
	 * limited range of data type" by assigning to tmp var of type
	 * Tcl_WideInt.
	 */

	tmp1 = (Tcl_WideInt) buf.st_ino;
	tmp2 = (Tcl_WideInt) buf.st_size;
        tmp1 = (Tcl_WideInt) buf.st_ino;
        tmp2 = (Tcl_WideInt) buf.st_size;
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
	tmp3 = (Tcl_WideInt) buf.st_blocks;
        tmp3 = (Tcl_WideInt) buf.st_blocks;
#endif

	if (OUT_OF_URANGE(tmp1) || OUT_OF_RANGE(tmp2) || OUT_OF_RANGE(tmp3)) {
#if defined(EFBIG)
	    errno = EFBIG;
#elif defined(EOVERFLOW)
	    errno = EOVERFLOW;
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
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







-
-
-
+
+
+

















-
+
-















-
+

-
+


-
+
+







	oldStyleBuf->st_ino	= (ino_t) buf.st_ino;
	oldStyleBuf->st_dev	= buf.st_dev;
	oldStyleBuf->st_rdev	= buf.st_rdev;
	oldStyleBuf->st_nlink	= buf.st_nlink;
	oldStyleBuf->st_uid	= buf.st_uid;
	oldStyleBuf->st_gid	= buf.st_gid;
	oldStyleBuf->st_size	= (off_t) buf.st_size;
	oldStyleBuf->st_atime	= Tcl_GetAccessTimeFromStat(&buf);
	oldStyleBuf->st_mtime	= Tcl_GetModificationTimeFromStat(&buf);
	oldStyleBuf->st_ctime	= Tcl_GetChangeTimeFromStat(&buf);
	oldStyleBuf->st_atime	= buf.st_atime;
	oldStyleBuf->st_mtime	= buf.st_mtime;
	oldStyleBuf->st_ctime	= buf.st_ctime;
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
	oldStyleBuf->st_blksize	= buf.st_blksize;
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
#ifdef HAVE_BLKCNT_T
	oldStyleBuf->st_blocks	= (blkcnt_t) buf.st_blocks;
#else
	oldStyleBuf->st_blocks	= (unsigned long) buf.st_blocks;
#endif
#endif
    }
    return ret;
}

/* Obsolete */
int
Tcl_Access(
    const char *path,		/* Pathname of file to access (in current CP).
    const char *path,		/* Path of file to access (in current CP). */
				*/
    int mode)			/* Permission setting. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSAccess(pathPtr,mode);
    Tcl_DecrRefCount(pathPtr);

    return ret;
}

/* Obsolete */
Tcl_Channel
Tcl_OpenFileChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting. May be
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    const char *path,		/* Pathname of file to open. */
    const char *path,		/* Name of file to open. */
    const char *modeString,	/* A list of POSIX open modes or a string such
				 * as "rw". */
    int permissions)		/* The modes to use if creating a new file. */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    Tcl_Channel ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSOpenFileChannel(interp, pathPtr, modeString, permissions);
    Tcl_DecrRefCount(pathPtr);
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
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
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
524
525
526
527
528
529







-
-
+
+


-
-
-
-
-
+
+
+
+
+
+




-
-
+
+
-
-
+



-







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+






-
+



-
+











-
+






-
+








/* Obsolete */
char *
Tcl_GetCwd(
    Tcl_Interp *interp,
    Tcl_DString *cwdPtr)
{
    Tcl_Obj *cwd = Tcl_FSGetCwd(interp);

    Tcl_Obj *cwd;
    cwd = Tcl_FSGetCwd(interp);
    if (cwd == NULL) {
	return NULL;
    }
    Tcl_DStringInit(cwdPtr);
    TclDStringAppendObj(cwdPtr, cwd);
    Tcl_DecrRefCount(cwd);
    return Tcl_DStringValue(cwdPtr);
    } else {
	Tcl_DStringInit(cwdPtr);
	Tcl_DStringAppend(cwdPtr, Tcl_GetString(cwd), -1);
	Tcl_DecrRefCount(cwd);
	return Tcl_DStringValue(cwdPtr);
    }
}

int
Tcl_EvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the script. */
    const char *fileName)	/* Pathname of the file containing the script.
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    const char *fileName)	/* Name of file to process. Tilde-substitution
				 * Performs Tilde-substitution on this
				 * pathaname. */
				 * will be performed on this name. */
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1);

    Tcl_IncrRefCount(pathPtr);
    ret = Tcl_FSEvalFile(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

/*
 * The 3 hooks for Stat, Access and OpenFileChannel are obsolete. The
 * complete, general hooked filesystem APIs should be used instead. This
 * define decides whether to include the obsolete hooks and related code. If
 * these are removed, we'll also want to remove them from stubs/tclInt. The
 * only known users of these APIs are prowrap and mktclapp. New
 * code/extensions should not use them, since they do not provide as full
 * support as the full filesystem API.
 *
 * As soon as prowrap and mktclapp are updated to use the full filesystem
 * support, I suggest all these hooks are removed.
 */

#undef USE_OBSOLETE_FS_HOOKS

#ifdef USE_OBSOLETE_FS_HOOKS

/*
 * The following typedef declarations allow for hooking into the chain of
 * functions maintained for 'Tcl_Stat(...)', 'Tcl_Access(...)' &
 * 'Tcl_OpenFileChannel(...)'. Basically for each hookable function a linked
 * list is defined.
 */

typedef struct StatProc {
    TclStatProc_ *proc;		/* Function to process a 'stat()' call */
    struct StatProc *nextPtr;	/* The next 'stat()' function to call */
} StatProc;

typedef struct AccessProc {
    TclAccessProc_ *proc;	/* Function to process a 'access()' call */
    struct AccessProc *nextPtr;	/* The next 'access()' function to call */
} AccessProc;

typedef struct OpenFileChannelProc {
    TclOpenFileChannelProc_ *proc;
				/* Function to process a
				 * 'Tcl_OpenFileChannel()' call */
    struct OpenFileChannelProc *nextPtr;
				/* The next 'Tcl_OpenFileChannel()' function
				 * to call */
} OpenFileChannelProc;

/*
 * For each type of (obsolete) hookable function, a static node is declared to
 * hold the function pointer for the "built-in" routine (e.g. 'TclpStat(...)')
 * and the respective list is initialized as a pointer to that node.
 *
 * The "delete" functions (e.g. 'TclStatDeleteProc(...)') ensure that these
 * statically declared list entry cannot be inadvertently removed.
 *
 * This method avoids the need to call any sort of "initialization" function.
 *
 * All three lists are protected by a global obsoleteFsHookMutex.
 */

static StatProc *statProcList = NULL;
static AccessProc *accessProcList = NULL;
static OpenFileChannelProc *openFileChannelProcList = NULL;

TCL_DECLARE_MUTEX(obsoleteFsHookMutex)

#endif /* USE_OBSOLETE_FS_HOOKS */

/*
 * Declare the native filesystem support. These functions should be considered
 * private to Tcl, and should really not be called directly by any code other
 * than this file (i.e. neither by Tcl's core nor by extensions). Similarly,
 * the old string-based Tclp... native filesystem functions should not be
 * called.
 *
 * The correct API to use now is the Tcl_FS... set of functions, which ensure
 * correct and complete virtual filesystem support.
 *
 * We cannot make all of these static, since some of them are implemented in
 * the platform-specific directories.
 */

static Tcl_FSFilesystemSeparatorProc NativeFilesystemSeparator;
static Tcl_FSFreeInternalRepProc NativeFreeInternalRep;
static Tcl_FSFileAttrStringsProc NativeFileAttrStrings;
static Tcl_FSFileAttrsGetProc	NativeFileAttrsGet;
static Tcl_FSFileAttrsSetProc	NativeFileAttrsSet;

/*
 * The only reason these functions are not static is that they are either
 * called by code in the native (win/unix) directories or they are actually
 * implemented in those directories. They should simply not be called by code
 * outside Tcl's native filesystem core i.e. they should be considered
 * 'static' to Tcl's filesystem code (if we ever built the native filesystem
 * support into a separate code library, this could actually be enforced).
 */

Tcl_FSFilesystemPathTypeProc	TclpFilesystemPathType;
Tcl_FSInternalToNormalizedProc	TclpNativeToNormalized;
Tcl_FSStatProc			TclpObjStat;
Tcl_FSAccessProc		TclpObjAccess;
Tcl_FSMatchInDirectoryProc	TclpMatchInDirectory;
Tcl_FSChdirProc			TclpObjChdir;
Tcl_FSLstatProc			TclpObjLstat;
Tcl_FSCopyFileProc		TclpObjCopyFile;
Tcl_FSDeleteFileProc		TclpObjDeleteFile;
Tcl_FSRenameFileProc		TclpObjRenameFile;
Tcl_FSCreateDirectoryProc	TclpObjCreateDirectory;
Tcl_FSCopyDirectoryProc		TclpObjCopyDirectory;
Tcl_FSRemoveDirectoryProc	TclpObjRemoveDirectory;
Tcl_FSUnloadFileProc		TclpUnloadFile;
Tcl_FSLinkProc			TclpObjLink;
Tcl_FSListVolumesProc		TclpObjListVolumes;

/*
 * Define the native filesystem dispatch table. If necessary, it is ok to make
 * this non-static, but it should only be accessed by the functions actually
 * listed within it (or perhaps other helper functions of them). Anything
 * which is not part of this 'native filesystem implementation' should not be
 * delving inside here!
 */

Tcl_Filesystem tclNativeFilesystem = {
    "native",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    &TclNativePathInFilesystem,
    &TclNativeDupInternalRep,
    &NativeFreeInternalRep,
    &TclpNativeToNormalized,
    &TclNativeCreateNativeRep,
    &TclpObjNormalizePath,
    &TclpFilesystemPathType,
    &NativeFilesystemSeparator,
    &TclpObjStat,
    &TclpObjAccess,
    &TclpOpenFileChannel,
    &TclpMatchInDirectory,
    &TclpUtime,
#ifndef S_IFLNK
    NULL,
#else
    &TclpObjLink,
#endif /* S_IFLNK */
    &TclpObjListVolumes,
    &NativeFileAttrStrings,
    &NativeFileAttrsGet,
    &NativeFileAttrsSet,
    &TclpObjCreateDirectory,
    &TclpObjRemoveDirectory,
    &TclpObjDeleteFile,
    &TclpObjCopyFile,
    &TclpObjRenameFile,
    &TclpObjCopyDirectory,
    &TclpObjLstat,
    &TclpDlopen,
    /* Needs a cast since we're using version_2 */
    (Tcl_FSGetCwdProc *) &TclpGetNativeCwd,
    &TclpObjChdir
};

/*
 * Define the tail of the linked list. Note that for unconventional uses of
 * Tcl without a native filesystem, we may in the future wish to modify the
 * current approach of hard-coding the native filesystem in the lookup list
 * 'filesystemList' below.
 *
 * We initialize the record so that it thinks one file uses it. This means it
 * will never be freed.
 */

static FilesystemRecord nativeFilesystemRecord = {
    NULL,
    &tclNativeFilesystem,
    NULL,
    NULL
};

/*
 * This is incremented each time we modify the linked list of filesystems. Any
 * time it changes, all cached filesystem representations are suspect and must
 * be freed. For multithreading builds, change of the filesystem epoch will
 * trigger cache cleanup in all threads.
 */

static int theFilesystemEpoch = 1;

/*
 * Stores the linked list of filesystems. A 1:1 copy of this list is also
 * maintained in the TSD for each thread. This is to avoid synchronization
 * issues.
 */

static FilesystemRecord *filesystemList = &nativeFilesystemRecord;
TCL_DECLARE_MUTEX(filesystemMutex)

/*
 * Used to implement Tcl_FSGetCwd in a file-system independent way.
 */

static Tcl_Obj* cwdPathPtr = NULL;
static int cwdPathEpoch = 0;
static ClientData cwdClientData = NULL;
TCL_DECLARE_MUTEX(cwdMutex)

static Tcl_ThreadDataKey fsDataKey;

/*
 * One of these structures is used each time we successfully load a file from
 * a file system by way of making a temporary copy of the file on the native
 * filesystem. We need to store both the actual unloadProc/clientData
 * combination which was used, and the original and modified filenames, so
 * that we can correctly undo the entire operation when we want to unload the
 * code.
 */

typedef struct FsDivertLoad {
    Tcl_LoadHandle loadHandle;
    Tcl_FSUnloadFileProc *unloadProcPtr;
    Tcl_Obj *divertedFile;
    const Tcl_Filesystem *divertedFilesystem;
    ClientData divertedFileNativeRep;
} FsDivertLoad;

/*
 * The basic filesystem implementation.
 * Now move on to the basic filesystem implementation
 */

static void
FsThrExitProc(
    ClientData cd)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)cd;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) cd;
    FilesystemRecord *fsRecPtr = NULL, *tmpFsRecPtr = NULL;

    /*
     * Discard the cwd copy.
     * Trash the cwd copy.
     */

    if (tsdPtr->cwdPathPtr != NULL) {
	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
	tsdPtr->cwdPathPtr = NULL;
    }
    if (tsdPtr->cwdClientData != NULL) {
	NativeFreeInternalRep(tsdPtr->cwdClientData);
    }

    /*
     * Discard the filesystems cache.
     * Trash the filesystems cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	fsRecPtr->fsPtr = NULL;
	Tcl_Free(fsRecPtr);
	ckfree((char *)fsRecPtr);
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->filesystemList = NULL;
    tsdPtr->initialized = 0;
}

int
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
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







+
-
-
+
+


-
+


-
-
-
-
+
+
+
+
+

-
-





-
+







    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSCwdPointerEquals --
 *
 *	Determine whether the given pathname is equal to the current working
 *	directory.
 *	Check whether the current working directory is equal to the path
 *	given.
 *
 * Results:
 *	1 if equal, 0 otherwise.
 *	1 (equal) or 0 (un-equal) as appropriate.
 *
 * Side effects:
 *	Updates TSD if needed.
 *
 *	Stores a pointer to the current directory in *pathPtrPtr if it is not
 *	already there and the current directory is not NULL.
 *	If the paths are equal, but are not the same object, this method will
 *	modify the given pathPtrPtr to refer to the same object. In this case
 *	the object pointed to by pathPtrPtr will have its refCount
 *	decremented, and it will be adjusted to point to the cwd (with a new
 *	refCount).
 *
 *	If *pathPtrPtr is not null its reference count is decremented
 *	before it is replaced.
 *----------------------------------------------------------------------
 */

int
TclFSCwdPointerEquals(
    Tcl_Obj **pathPtrPtr)
    Tcl_Obj** pathPtrPtr)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    Tcl_MutexLock(&cwdMutex);
    if (tsdPtr->cwdPathPtr == NULL
	    || tsdPtr->cwdPathEpoch != cwdPathEpoch) {
	if (tsdPtr->cwdPathPtr != NULL) {
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
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
618
619







-
+










-
+


-
-
-
+
+
+

-
-
+
+







	    tsdPtr->cwdClientData = TclNativeDupInternalRep(cwdClientData);
	}
	tsdPtr->cwdPathEpoch = cwdPathEpoch;
    }
    Tcl_MutexUnlock(&cwdMutex);

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
	tsdPtr->initialized = 1;
    }

    if (pathPtrPtr == NULL) {
	return (tsdPtr->cwdPathPtr == NULL);
    }

    if (tsdPtr->cwdPathPtr == *pathPtrPtr) {
	return 1;
    } else {
	size_t len1, len2;
	int len1, len2;
	const char *str1, *str2;

	str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = TclGetStringFromObj(*pathPtrPtr, &len2);
	if ((len1 == len2) && !memcmp(str1, str2, len1)) {
	str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
	if (len1 == len2 && !strcmp(str1,str2)) {
	    /*
	     * The values are equal but the objects are different.  Cache the
	     * current structure in place of the old one.
	     * They are equal, but different objects. Update so they will be
	     * the same object in the future.
	     */

	    Tcl_DecrRefCount(*pathPtrPtr);
	    *pathPtrPtr = tsdPtr->cwdPathPtr;
	    Tcl_IncrRefCount(*pathPtrPtr);
	    return 1;
	} else {
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
618
619
620
621
622
623


624
625
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
686
687

688
689
690
691

692
693
694
695
696

697
698
699
700
701
702
703
704
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
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
756
757
758
759
760
761
762
763

764
765
766
767

768
769
770
771


772

773
774
775
776
777
778
779







-
+





-
+












-

-
+








-
+
















-
-
+
+




-
+





-
+


-




-
+


-



-
-
+
+


-


-
+
+

-
+







-
-
+
+



-
+















-
+



-
+



-
-
+
-







    fsRecPtr = filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr;
	fsRecPtr = fsRecPtr->nextPtr;
    }

    /*
     * Refill the cache, honouring the order.
     * Refill the cache honouring the order.
     */

    list = NULL;
    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = (FilesystemRecord *)Tcl_Alloc(sizeof(FilesystemRecord));
	tmpFsRecPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
	*tmpFsRecPtr = *fsRecPtr;
	tmpFsRecPtr->nextPtr = list;
	tmpFsRecPtr->prevPtr = NULL;
	list = tmpFsRecPtr;
	fsRecPtr = fsRecPtr->prevPtr;
    }
    tsdPtr->filesystemList = list;
    tsdPtr->filesystemEpoch = theFilesystemEpoch;
    Tcl_MutexUnlock(&filesystemMutex);

    while (toFree) {
	FilesystemRecord *next = toFree->nextPtr;

	toFree->fsPtr = NULL;
	Tcl_Free(toFree);
	ckfree((char *)toFree);
	toFree = next;
    }

    /*
     * Make sure the above gets released on thread exit.
     */

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, tsdPtr);
	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
	tsdPtr->initialized = 1;
    }
}

static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
	    && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
	FsRecacheFilesystemList();
    }
    return tsdPtr->filesystemList;
}

/*
 * The epoch can is changed when a filesystems is added or removed, when
 * "system encoding" changes, and when env(HOME) changes.
 * The epoch can be changed by filesystems being added or removed, by changing
 * the "system encoding" and by env(HOME) changing.
 */

int
TclFSEpochOk(
    size_t filesystemEpoch)
    int filesystemEpoch)
{
    return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
}

static void
Claim(void)
Claim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    tsdPtr->claims++;
}

static void
Disclaim(void)
Disclaim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    tsdPtr->claims--;
}

size_t
TclFSEpoch(void)
int
TclFSEpoch()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    return tsdPtr->filesystemEpoch;
}



/*
 * If non-NULL, take posession of clientData and free it later.
 * If non-NULL, clientData is owned by us and must be freed later.
 */

static void
FsUpdateCwd(
    Tcl_Obj *cwdObj,
    ClientData clientData)
{
    size_t len = 0;
    const char *str = NULL;
    int len;
    char *str = NULL;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (cwdObj != NULL) {
	str = TclGetStringFromObj(cwdObj, &len);
	str = Tcl_GetStringFromObj(cwdObj, &len);
    }

    Tcl_MutexLock(&cwdMutex);
    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
    }
    if (cwdClientData != NULL) {
	NativeFreeInternalRep(cwdClientData);
    }

    if (cwdObj == NULL) {
	cwdPathPtr = NULL;
	cwdClientData = NULL;
    } else {
	/*
	 * This must be stored as a string obj!
	 * This must be stored as string obj!
	 */

	cwdPathPtr = Tcl_NewStringObj(str, len);
	Tcl_IncrRefCount(cwdPathPtr);
    	Tcl_IncrRefCount(cwdPathPtr);
	cwdClientData = TclNativeDupInternalRep(clientData);
    }

    if (++cwdPathEpoch == 0) {
	++cwdPathEpoch;
    cwdPathEpoch++;
    }
    tsdPtr->cwdPathEpoch = cwdPathEpoch;
    Tcl_MutexUnlock(&cwdMutex);

    if (tsdPtr->cwdPathPtr) {
	Tcl_DecrRefCount(tsdPtr->cwdPathPtr);
    }
    if (tsdPtr->cwdClientData) {
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
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







-
-
+
+

-
-
+
+





-
+










-
-
+
+
-














-
+






-
-
+
-


-
+



-
-
+
-



-
-
+
+


+
+
+
+
+
-
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeFilesystem --
 *
 *	Clean up the filesystem.  After this, any call to a Tcl_FS... function
 *	fails.
 *	Clean up the filesystem. After this, calls to all Tcl_FS... functions
 *	will fail.
 *
 *	If TclResetFilesystem is called later, it restores the filesystem to a
 *	pristine state.
 *	We will later call TclResetFilesystem to restore the FS to a pristine
 *	state.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees memory allocated for the filesystem.
 *	Frees any memory allocated by the filesystem.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeFilesystem(void)
{
    FilesystemRecord *fsRecPtr;

    /*
     * Assume that only one thread is active. Otherwise mutexes would be needed
     * around this code.
     * Assumption that only one thread is active now. Otherwise we would need
     * to put various mutexes around this code.
     * TO DO:  This assumption is false, isn't it?
     */

    if (cwdPathPtr != NULL) {
	Tcl_DecrRefCount(cwdPathPtr);
	cwdPathPtr = NULL;
	cwdPathEpoch = 0;
    }
    if (cwdClientData != NULL) {
	NativeFreeInternalRep(cwdClientData);
	cwdClientData = NULL;
    }

    /*
     * Remove all filesystems, freeing any allocated memory that is no longer
     * needed.
     * needed
     */

    fsRecPtr = filesystemList;
    while (fsRecPtr != NULL) {
	FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;

	/*
	 * The native filesystem is static, so don't free it.
	/* The native filesystem is static, so we don't free it. */
	 */

	if (fsRecPtr != &nativeFilesystemRecord) {
	    Tcl_Free(fsRecPtr);
	    ckfree((char *)fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    theFilesystemEpoch++;
    }
    filesystemList = NULL;

    /*
     * filesystemList is now NULL. Any attempt to use the filesystem is likely
     * to fail.
     * Now filesystemList is NULL. This means that any attempt to use the
     * filesystem is likely to fail.
     */

#ifdef USE_OBSOLETE_FS_HOOKS
    statProcList = NULL;
    accessProcList = NULL;
    openFileChannelProcList = NULL;
#endif
#ifdef _WIN32
#ifdef __WIN32__
    TclWinEncodingsCleanup();
#endif
}

/*
 *----------------------------------------------------------------------
 *
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
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
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
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
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
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







-
-
-
+
+
+
+
+
+
+
+
+
+







-
-
+
+
+
-
-
+
+

-
-
-
-
+
+
+
+
+
+
+
+
-


-
+



-
+
-






-
-
+
+







-
+




+
+
+
+
+
+
+
+
+
+
+
+
+










-
+



-
-
+
-










-
-
-
-
-
+
+
+
+
+
+


-
+



+
-
+
-
+






-
+







-
-
-
+
+
+















-
-
-
+
+
+
+
+


-
-
-
+
+
-
-
+
















+
-
-
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
-
+



-
+
+
+

+
+
+
+
+
+
+

-
-
+






-
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+





-
+

-
-
-
+
+
+
+
-











-
-
-
-
+
+
+
+

+




-
-
+
+






-
-
-
-
+
+
+
+

+





-
-
-
-
-
+
+
+
+
+
+
+





-
-
+
+
-








-
-
+
+




-
+



















+
+
-
-
-
+
+
+





-
+






-
-
-
-
-
-
-
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
TclResetFilesystem(void)
{
    filesystemList = &nativeFilesystemRecord;
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    }
    theFilesystemEpoch++;

#ifdef __WIN32__
    /*
     * Cleans up the win32 API filesystem proc lookup table. This must happen
     * very late in finalization so that deleting of copied dlls can occur.
     */

    TclWinResetInterfaces();
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSRegister --
 *
 *	Prepends to the list of registered fileystems a new FilesystemRecord
 *	for the given Tcl_Filesystem, which is added even if it is already in
 *	Insert the filesystem function table at the head of the list of
 *	functions which are used during calls to all file-system operations.
 *	The filesystem will be added even if it is already in the list. (You
 *	the list.  To determine whether the filesystem is already in the list,
 *	use Tcl_FSData().
 *	can use Tcl_FSData to check if it is in the list, provided the
 *	ClientData used was not NULL).
 *
 *	Functions that use the list generally process it from head to tail and
 *	use the first filesystem that is suitable.  Therefore, when adding a
 *	diagnostic filsystem (one which simply reports all fs activity), it
 *	must be at the head of the list.  I.e. it must be the last one
 *	Note that the filesystem handling is head-to-tail of the list. Each
 *	filesystem is asked in turn whether it can handle a particular
 *	request, until one of them says 'yes'. At that point no further
 *	filesystems are asked.
 *
 *	In particular this means if you want to add a diagnostic filesystem
 *	(which simply reports all fs activity), it must be at the head of the
 *	list: i.e. it must be the last registered.
 *	registered.
 *
 * Results:
 *	TCL_OK, or TCL_ERROR if memory for a new node in the list could
 *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
 *	not be allocated.
 *
 * Side effects:
 *	Allocates memory for a filesystem record and modifies the list of
 *	Memory allocated and modifies the link list for filesystems.
 *	registered filesystems.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSRegister(
    ClientData clientData,	/* Client-specific data for this filesystem. */
    const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */
    ClientData clientData,	/* Client specific data for this fs */
    Tcl_Filesystem *fsPtr)	/* The filesystem record for the new fs. */
{
    FilesystemRecord *newFilesystemPtr;

    if (fsPtr == NULL) {
	return TCL_ERROR;
    }

    newFilesystemPtr = (FilesystemRecord *)Tcl_Alloc(sizeof(FilesystemRecord));
    newFilesystemPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));

    newFilesystemPtr->clientData = clientData;
    newFilesystemPtr->fsPtr = fsPtr;

    /*
     * Is this lock and wait strictly speaking necessary? Since any iterators
     * out there will have grabbed a copy of the head of the list and be
     * iterating away from that, if we add a new element to the head of the
     * list, it can't possibly have any effect on any of their loops. In fact
     * it could be better not to wait, since we are adjusting the filesystem
     * epoch, any cached representations calculated by existing iterators are
     * going to have to be thrown away anyway.
     *
     * However, since registering and unregistering filesystems is a very rare
     * action, this is not a very important point.
     */

    Tcl_MutexLock(&filesystemMutex);

    newFilesystemPtr->nextPtr = filesystemList;
    newFilesystemPtr->prevPtr = NULL;
    if (filesystemList) {
	filesystemList->prevPtr = newFilesystemPtr;
    }
    filesystemList = newFilesystemPtr;

    /*
     * Increment the filesystem epoch counter since existing pathnames might
     * Increment the filesystem epoch counter, since existing paths might
     * conceivably now belong to different filesystems.
     */

    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    theFilesystemEpoch++;
    }
    Tcl_MutexUnlock(&filesystemMutex);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUnregister --
 *
 *	Removes the record for given filesystem from the list of registered
 *	filesystems. Refuses to remove the built-in (native) filesystem.  This
 *	might be changed in the future to allow a smaller Tcl core in which the
 *	native filesystem is not used at all, e.g. initializing Tcl over a
 *	network connection.
 *	Remove the passed filesystem from the list of filesystem function
 *	tables. It also ensures that the built-in (native) filesystem is not
 *	removable, although we may wish to change that decision in the future
 *	to allow a smaller Tcl core, in which the native filesystem is not
 *	used at all (we could, say, initialise Tcl completely over a network
 *	connection).
 *
 * Results:
 *	TCL_OK if the function pointer was successfully removed, or TCL_ERROR
 *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	Memory may be deallocated (or will be later, once no "path" objects
 *	The list of registered filesystems is updated.  Memory for the
 *	refer to this filesystem), but the list of registered filesystems is
 *	corresponding FilesystemRecord is eventually freed.
 *	updated immediately.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSUnregister(
    const Tcl_Filesystem *fsPtr)/* The filesystem record to remove. */
    Tcl_Filesystem *fsPtr)	/* The filesystem record to remove. */
{
    int retVal = TCL_ERROR;
    FilesystemRecord *fsRecPtr;

    Tcl_MutexLock(&filesystemMutex);

    /*
     * Traverse filesystemList in search of the record whose
     * 'fsPtr' member matches 'fsPtr' and remove that record from the list.
     * Do not revmoe the record for the native filesystem.
     * Traverse the 'filesystemList' looking for the particular node whose
     * 'fsPtr' member matches 'fsPtr' and remove that one from the list.
     * Ensure that the "default" node cannot be removed.
     */

    fsRecPtr = filesystemList;
    while ((retVal == TCL_ERROR) && (fsRecPtr != &nativeFilesystemRecord)) {
	if (fsRecPtr->fsPtr == fsPtr) {
	    if (fsRecPtr->prevPtr) {
		fsRecPtr->prevPtr->nextPtr = fsRecPtr->nextPtr;
	    } else {
		filesystemList = fsRecPtr->nextPtr;
	    }
	    if (fsRecPtr->nextPtr) {
		fsRecPtr->nextPtr->prevPtr = fsRecPtr->prevPtr;
	    }

	    /*
	     * Each cached pathname could now belong to a different filesystem,
	     * so increment the filesystem epoch counter to ensure that cached
	     * information about the removed filesystem is not used.
	     * Increment the filesystem epoch counter, since existing paths
	     * might conceivably now belong to different filesystems. This
	     * should also ensure that paths which have cached the filesystem
	     * which is about to be deleted do not reference that filesystem
	     * (which would of course lead to memory exceptions).
	     */

	    if (++theFilesystemEpoch == 0) {
		++theFilesystemEpoch;
	    }
	    theFilesystemEpoch++;


	    Tcl_Free(fsRecPtr);
	    ckfree((char *)fsRecPtr);

	    retVal = TCL_OK;
	} else {
	    fsRecPtr = fsRecPtr->nextPtr;
	}
    }

    Tcl_MutexUnlock(&filesystemMutex);
    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSMatchInDirectory --
 *
 *	This routine is used by the globbing code to search a directory for
 *	Search in the given pathname for files matching the given pattern.
 *	Used by [glob].  Processes just one pattern for one directory.  Callers
 *	all files which match a given pattern. The appropriate function for
 *	the filesystem to which pathPtr belongs will be called. If pathPtr
 *	does not belong to any filesystem and if it is NULL or the empty
 *	string, then we assume the pattern is to be matched in the current
 *	working directory. To avoid have the Tcl_FSMatchInDirectoryProc for
 *	such as TclGlob and DoGlob implement manage the searching of multiple
 *	directories in cases such as
 *	each filesystem from having to deal with this issue, we create a
 *	pathPtr on the fly (equal to the cwd), and then remove it from the
 *	results returned. This makes filesystems easy to write, since they can
 *	assume the pathPtr passed to them is an ordinary path. In fact this
 *	means we could remove such special case handling from Tcl's native
 *	filesystems.
 *
 *	If 'pattern' is NULL, then pathPtr is assumed to be a fully specified
 *	path of a single file/directory which must be checked for existence
 *		glob -dir $dir -join * pkgIndex.tcl
 *	and correct type.
 *
 * Results:
 *
 *	TCL_OK, or TCL_ERROR
 *	The return value is a standard Tcl result indicating whether an error
 *	occurred in globbing. Error messages are placed in interp, but good
 *	results are placed in the resultPtr given.
 *
 *	Recursive searches, e.g.
 *		glob -dir $dir -join * pkgIndex.tcl
 *	which must recurse through each directory matching '*' are handled
 *	internally by Tcl, by passing specific flags in a modified 'types'
 *	parameter. This means the actual filesystem only ever sees patterns
 *	which match in a single directory.
 *
 * Side effects:
 *	resultPtr is populated, or in the case of an TCL_ERROR, an error message is
 *	set in the interpreter.
 *	The interpreter may have an error message inserted into it.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSMatchInDirectory(
    Tcl_Interp *interp,		/* Interpreter to receive error messages, or
				 * NULL */
    Tcl_Obj *resultPtr,		/* List that results are added to. */
    Tcl_Obj *pathPtr,		/* Pathname of directory to search. If NULL,
    Tcl_Interp *interp,		/* Interpreter to receive error messages, but
                       		 * may be NULL. */
    Tcl_Obj *resultPtr,		/* List object to receive results. */
    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
				 * the current working directory is used. */
    const char *pattern,	/* Pattern to match.  If NULL, pathPtr must be
    const char *pattern,	/* Pattern to match against. */
				 * a fully-specified pathname of a single
				 * file/directory which already exists and is
				 * of the correct type. */
    Tcl_GlobTypeData *types)	/* Specifies acceptable types.
				 * May be NULL. The directory flag is
				 * particularly significant. */
    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    const Tcl_Filesystem *fsPtr;
    Tcl_Obj *cwd, *tmpResultPtr, **elemsPtr;
    int resLength, i, ret = -1;

    if (types != NULL && (types->type & TCL_GLOB_TYPE_MOUNT)) {
    if (types != NULL && types->type & TCL_GLOB_TYPE_MOUNT) {
	/*
	 * Currently external callers may not query mounts, which would be a
	 * valuable future step. This is the only routine that knows about
	 * mounts, so we're being called recursively by ourself. Return no
	 * We don't currently allow querying of mounts by external code (a
	 * valuable future step), so since we're the only function that
	 * actually knows about mounts, this means we're being called
	 * recursively by ourself. Return no matches.
	 * matches.
	 */

	return TCL_OK;
    }

    if (pathPtr != NULL) {
	fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    } else {
	fsPtr = NULL;
    }

    if (fsPtr != NULL) {
	/*
	 * A corresponding filesystem was found. Search within it.
	 */
    /*
     * Check if we've successfully mapped the path to a filesystem within
     * which to search.
     */

    if (fsPtr != NULL) {
	if (fsPtr->matchInDirectoryProc == NULL) {
	    Tcl_SetErrno(ENOENT);
	    return -1;
	}
	ret = fsPtr->matchInDirectoryProc(interp, resultPtr, pathPtr, pattern,
		types);
	ret = (*fsPtr->matchInDirectoryProc)(interp, resultPtr, pathPtr,
		pattern, types);
	if (ret == TCL_OK && pattern != NULL) {
	    FsAddMountsToGlobResult(resultPtr, pathPtr, pattern, types);
	}
	return ret;
    }

    if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') {
	/*
	 * There is a pathname but it belongs to no known filesystem. Mayday!
	 */
    /*
     * If the path isn't empty, we have no idea how to match files in a
     * directory which belongs to no known filesystem
     */

    if (pathPtr != NULL && TclGetString(pathPtr)[0] != '\0') {
	Tcl_SetErrno(ENOENT);
	return -1;
    }

    /*
     * The pathname is empty or NULL so search in the current working
     * directory.  matchInDirectoryProc prefixes each result with this
     * directory, so trim it from each result.  Deal with this here in the
     * generic code because otherwise every filesystem implementation of
     * Tcl_FSMatchInDirectory has to do it.
     * We have an empty or NULL path. This is defined to mean we must search
     * for files within the current 'cwd'. We therefore use that, but then
     * since the proc we call will return results which include the cwd we
     * must then trim it off the front of each path in the result. We choose
     * to deal with this here (in the generic code), since if we don't, every
     * single filesystem's implementation of Tcl_FSMatchInDirectory will have
     * to deal with it for us.
     */

    cwd = Tcl_FSGetCwd(NULL);
    if (cwd == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "glob couldn't determine the current working directory",
	    Tcl_SetResult(interp, "glob couldn't determine "
		    "the current working directory", TCL_STATIC);
		    -1));
	}
	return TCL_ERROR;
    }

    fsPtr = Tcl_FSGetFileSystemForPath(cwd);
    if (fsPtr != NULL && fsPtr->matchInDirectoryProc != NULL) {
	TclNewObj(tmpResultPtr);
	Tcl_IncrRefCount(tmpResultPtr);
	ret = fsPtr->matchInDirectoryProc(interp, tmpResultPtr, cwd, pattern,
		types);
	ret = (*fsPtr->matchInDirectoryProc)(interp, tmpResultPtr, cwd,
		pattern, types);
	if (ret == TCL_OK) {
	    FsAddMountsToGlobResult(tmpResultPtr, cwd, pattern, types);

	    /*
	     * resultPtr and tmpResultPtr are guaranteed to be distinct.
	     * Note that we know resultPtr and tmpResultPtr are distinct.
	     */

	    ret = Tcl_ListObjGetElements(interp, tmpResultPtr,
		    &resLength, &elemsPtr);
	    for (i=0 ; ret==TCL_OK && i<resLength ; i++) {
		ret = Tcl_ListObjAppendElement(interp, resultPtr,
			TclFSMakePathRelative(interp, elemsPtr[i], cwd));
	    }
	}
	TclDecrRefCount(tmpResultPtr);
    }
    Tcl_DecrRefCount(cwd);
    return ret;
}

/*
 *----------------------------------------------------------------------
 *
 * FsAddMountsToGlobResult --
 *
 *	This routine is used by the globbing code to take the results of a
 *	Adds any mounted pathnames to a set of results so that simple things
 *	like 'glob *' merge mounts and listings correctly.  Used by the
 *	Tcl_FSMatchInDirectory.
 *	directory listing and add any mounted paths to that listing. This is
 *	required so that simple things like 'glob *' merge mounts and listings
 *	correctly.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores a result in resultPtr.
 *	Modifies the resultPtr.
 *
 *----------------------------------------------------------------------
 */

static void
FsAddMountsToGlobResult(
    Tcl_Obj *resultPtr,		/* The current list of matching pathnames. Must
				 * not be shared. */
    Tcl_Obj *pathPtr,		/* The directory that was searched. */
    const char *pattern,	/* Pattern to match mounts against. */
    Tcl_GlobTypeData *types)	/* Acceptable types.  May be NULL. The
				 * directory flag is particularly significant.
				 */
    Tcl_Obj *resultPtr,		/* The current list of matching paths; must
				 * not be shared! */
    Tcl_Obj *pathPtr,		/* The directory in question */
    const char *pattern,	/* Pattern to match against. */
    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    int mLength, gLength, i;
    int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR));
    Tcl_Obj *mounts = FsListMounts(pathPtr, pattern);

    if (mounts == NULL) {
	return;
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446




1447
1448
1449



1450
1451
1452
1453


1454
1455
1456


1457
1458
1459
1460
1461
1462


1463
1464
1465
1466
1467
1468
1469
1470


1471
1472
1473
1474
1475
1476





1477
1478
1479
1480
1481
1482
1483

1484
1485
1486
1487
1488
1489
1490
1491
1492
1493


1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507

1508
1509
1510
1511
1512
1513
1514
1515
1516
1517

1518
1519
1520
1521
1522
1523
1524
1525
1526


1527
1528
1529
1530
1531
1532
1533
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
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
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
1439
1440
1441
1442
1443
1444
1445

1446


1447




1448
1449
1450




1451






1452
1453
1454
1455

1456

1457













1458
1459
1460

1461


1462








1463



1464






1465


1466
1467
1468
1469
1470
1471
1472





1473
1474
1475
1476
1477







1478
1479
1480
1481
1482
1483
1484





1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502



1503
1504
1505
1506
1507

1508
1509
1510

1511
1512
1513
1514
1515
1516
1517





1518
1519
1520
1521
1522

1523
1524
1525
1526
1527
1528
1529
1530
1531
1532

1533
1534
1535
1536
1537
1538

1539
1540
1541
1542
1543


1544
1545



1546
1547
1548



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
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







-
+




-
+


-
-
-
+
+
+






-
-
+
+







-
+
-
-




-
+
+













-
-
+
+
+





-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-
+

-
-
+
+

+
-
+
-

-
-
+
+
-
-
+
+
+

-
+
-
+

-
-
+
+
-
+






-
+
+

+
-
-
+
+

-
+
+
+

-
+
-
+



-
-
+
-








-
+
+


-
-
+
+
+









-
+
-





+
-
+
+

















-
-
-
-
-
+
+
+
+
+


-
-
+
+






-
-
+
+

+
+
+







-
+
-
-
+
-
-
-
-



-
-
-
-

-
-
-
-
-
-
+
+
+
+
-

-

-
-
-
-
-
-
-
-
-
-
-
-
-



-
+
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
+



+


-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+











-
-
-
+
+
+


-
+


-
+






-
-
-
-
-
+
+
+
+
+
-










-
+
+
+
+


-
+
+
+


-
-
+
+
-
-
-
+
+

-
-
-

-
+
+






-
-
+
+

-
-
-
-
-
+
+
+
+
+






-
+









-
+
+













-
+









-
+







-
-
+
+







		    /*
		     * We don't want to list this.
		     */

		    Tcl_ListObjReplace(NULL, resultPtr, j, 1, 0, NULL);
		    gLength--;
		}
		break;		/* Break out of for loop. */
		break;		/* Break out of for loop */
	    }
	}
	if (!found && dir) {
	    Tcl_Obj *norm;
	    size_t len, mlen;
	    int len, mlen;

	    /*
	     * mElt is normalized and lies inside pathPtr so
	     * add to the result the right representation of mElt,
	     * i.e. the representation relative to pathPtr.
	     * We know mElt is absolute normalized and lies inside pathPtr, so
	     * now we must add to the result the right representation of mElt,
	     * i.e. the representation which is relative to pathPtr.
	     */

	    norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    if (norm != NULL) {
		const char *path, *mount;

		mount = TclGetStringFromObj(mElt, &mlen);
		path = TclGetStringFromObj(norm, &len);
		mount = Tcl_GetStringFromObj(mElt, &mlen);
		path = Tcl_GetStringFromObj(norm, &len);
		if (path[len-1] == '/') {
		    /*
		     * Deal with the root of the volume.
		     */

		    len--;
		}
		len++;		/* account for '/' in the mElt [Bug 1602539] */
		len++; /* account for '/' in the mElt [Bug 1602539] */


		mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len);
		Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
	    }
	    /*
	     * Not comparing mounts to mounts, so no need to increment gLength
	     * No need to increment gLength, since we don't want to compare
	     * mounts against mounts.
	     */
	}
    }

  endOfMounts:
    Tcl_DecrRefCount(mounts);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSMountsChanged --
 *
 *	Announecs that mount points have changed or that the system encoding
 *	has changed.
 *	Notify the filesystem that the available mounted filesystems (or
 *	within any one filesystem type, the number or location of mount
 *	points) have changed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The shared 'theFilesystemEpoch' is incremented, invalidating every
 *	exising cached internal representation of a pathname.  Avoid calling
 *	Tcl_FSMountsChanged whenever possible.  It must be called when:
 *	The global filesystem variable 'theFilesystemEpoch' is incremented.
 *	The effect of this is to make all cached path representations invalid.
 *	Clearly it should only therefore be called when it is really required!
 *	There are a few circumstances when it should be called:
 *
 *	(1) A filesystem is registered or unregistered. This is only necessary
 *	if the new filesystem accepts file pathnames as-is.  Normally the
 *	filesystem is really a shell which doesn't yet have any mount points
 *	established and so its 'pathInFilesystem' routine always fails.
 *	However, for safety, Tcl calls 'Tcl_FSMountsChanged' each time a
 *	(1) when a new filesystem is registered or unregistered. Strictly
 *	speaking this is only necessary if the new filesystem accepts file
 *	paths as is (normally the filesystem itself is really a shell which
 *	hasn't yet had any mount points established and so its
 *	'pathInFilesystem' proc will always fail). However, for safety, Tcl
 *	filesystem is registered or unregistered.
 *	always calls this for you in these circumstances.
 *
 *	(2) An additional mount point is established inside an existing
 *	filesystem (except for the native file system; see note below).
 *	(2) when additional mount points are established inside any existing
 *	filesystem (except the native fs)
 *
 *	(3) when any filesystem (except the native fs) changes the list of
 *	(3) A filesystem changes the list of available volumes (except for the
 *	available volumes.
 *	native file system; see note below).
 *
 *	(4) The mapping from a string representation of a file to a full,
 *	normalized pathname changes. For example, if 'env(HOME)' is modified,
 *	(4) when the mapping from a string representation of a file to a full,
 *	normalized path changes. For example, if 'env(HOME)' is modified, then
 *	then any pathname containing '~' maps to a different item, possibly in
 *	a different filesystem.
 *	any path containing '~' will map to a different filesystem location.
 *	Therefore all such paths need to have their internal representation
 *	invalidated.
 *
 *	Tcl has no control over (2) and (3), so each registered filesystem must
 *	Tcl has no control over (2) and (3), so any registered filesystem must
 *	call Tcl_FSMountsChnaged in each of those circumstances.
 *	make sure it calls this function when those situations occur.
 *
 *	The reason for the exception in 2,3 for the native filesystem is that
 *	the native filesystem claims every file without determining whether
 *	(Note: the reason for the exception in 2,3 for the native filesystem
 *	is that the native filesystem by default claims all unknown files even
 *	whether the file exists, or even whether the pathname makes sense.
 *	if it really doesn't understand them or if they don't exist).
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FSMountsChanged(
    TCL_UNUSED(const Tcl_Filesystem *) /*fsPtr*/)
    Tcl_Filesystem *fsPtr)
{
    /*
     * We currently don't do anything with this parameter. We could in the
     * fsPtr is currently unused.  In the future it might invalidate files for
     * a particular filesystem, or take some other more advanced action.
     * future only invalidate files for this filesystem or otherwise take more
     * advanced action.
     */
{

    (void)fsPtr;

    /*
     * Increment the filesystem epoch to invalidate every existing cached
     * Increment the filesystem epoch counter, since existing paths might now
     * internal representation.
     * belong to different filesystems.
     */

    Tcl_MutexLock(&filesystemMutex);
    if (++theFilesystemEpoch == 0) {
	++theFilesystemEpoch;
    theFilesystemEpoch++;
    }
    Tcl_MutexUnlock(&filesystemMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSData --
 *
 *	Retrieves the clientData member of the given filesystem.
 *	Retrieve the clientData field for the filesystem given, or NULL if
 *	that filesystem is not registered.
 *
 * Results:
 *	A clientData value, or NULL if the given filesystem is not registered.
 *	The clientData value itself may also be NULL.
 *	A clientData value, or NULL. Note that if the filesystem was
 *	registered with a NULL clientData field, this function will return
 *	that NULL value.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_FSData(
    const Tcl_Filesystem *fsPtr) /* The filesystem to find in the list of
    Tcl_Filesystem *fsPtr) /* The filesystem record to query. */
				  *  registered filesystems. */
{
    ClientData retVal = NULL;
    FilesystemRecord *fsRecPtr = FsGetFirstFilesystem();

    /*
     * Traverse the list of filesystems look for a particular one. If found,
     * Find the filesystem in and retrieve its clientData.
     * return that filesystem's clientData (originally provided when calling
     * Tcl_FSRegister).
     */

    while ((retVal == NULL) && (fsRecPtr != NULL)) {
	if (fsRecPtr->fsPtr == fsPtr) {
	    retVal = fsRecPtr->clientData;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSNormalizeToUniquePath --
 *
 *	Converts the given pathname, containing no ../, ./ components, into a
 *	unique pathname for the given platform. On Unix the resulting pathname
 *	is free of symbolic links/aliases, and on Windows it is the long
 *	case-preserving form.
 *
 *	Takes a path specification containing no ../, ./ sequences, and
 *	converts it into a unique path for the given platform. On Unix, this
 *	means the path must be free of symbolic links/aliases, and on Windows
 *	it means we want the long form, with that long form's case-dependence
 *	(which gives us a unique, case-dependent path).
 *
 * Results:
 *	Stores the resulting pathname in pathPtr and returns the offset of the
 *	last byte processed in pathPtr.
 *	The pathPtr is modified in place. The return value is the last byte
 *	offset which was recognised in the path string.
 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special notes:
 *	If the filesystem-specific normalizePathProcs can re-introduce ../, ./
 *	components into the pathname, this function does not return the correct
 *	result. This may be possible with symbolic links on unix.
 *	sequences into the path, then this function will not return the
 *	correct result. This may be possible with symbolic links on unix.
 *
 *	Important assumption: if startAt is non-zero, it must point to a
 *	directory separator that we know exists and is already normalized (so
 *	it is important not to point to the char just after the separator).
 *
 *---------------------------------------------------------------------------
 */

int
TclFSNormalizeToUniquePath(
    Tcl_Interp *interp,		/* Used for error messages. */
    Tcl_Obj *pathPtr,		/* An Pathname to normalize in-place.  Must be
    Tcl_Obj *pathPtr,		/* The path to normalize in place */
				 * unshared. */
    int startAt)		/* Offset the string of pathPtr to start at.
    int startAt)		/* Start at this char-offset */
				 * Must either be 0 or offset of a directory
				 * separator at the end of a pathname part that
				 * is already normalized, I.e. not the index of
				 * the byte just after the separator.  */
{
    FilesystemRecord *fsRecPtr, *firstFsRecPtr;

    size_t i;
    int isVfsPath = 0;
    const char *path;

    /*
     * Pathnames starting with a UNC prefix and ending with a colon character
     * are reserved for VFS use.  These names can not conflict with real UNC
     * pathnames per https://msdn.microsoft.com/en-us/library/gg465305.aspx and
     * rfc3986's definition of reg-name.
     *
     * We check these first to avoid useless calls to the native filesystem's
     * Call each of the "normalise path" functions in succession. This is a
     * special case, in which if we have a native filesystem handler, we call
     * it first. This is because the root of Tcl's filesystem is always a
     * native filesystem (i.e. '/' on unix is native).
     * normalizePathProc.
     */
    path = TclGetStringFromObj(pathPtr, &i);

    if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/')
		    || (path[0] == '\\' && path[1] == '\\') ) ) {
	for ( i = 2; ; i++) {
	    if (path[i] == '\0') break;
	    if (path[i] == path[0]) break;
	}
	--i;
	if (path[i] == ':') isVfsPath = 1;
    }

    /*
     * Call the the normalizePathProc routine of each registered filesystem.
     */
    firstFsRecPtr = FsGetFirstFilesystem();

    Claim();

    fsRecPtr = firstFsRecPtr;
    if (!isVfsPath) {

    while (fsRecPtr != NULL) {
	/*
	 * Find and call the native filesystem handler first if there is one
	 * because the root of Tcl's filesystem is always a native filesystem
	 * (i.e., '/' on unix is native).
	 */

	for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
		continue;
	    }

	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    /*
	     * TODO: Always call the normalizePathProc here because it should
	     * always exist.
	     */

	    if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
	    if (proc != NULL) {
		startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
			startAt);
		startAt = (*proc)(interp, pathPtr, startAt);
	    }
	    break;
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
	    /*
	     * Skip the native system this time through.
	     */
    fsRecPtr = firstFsRecPtr;
    while (fsRecPtr != NULL) {
	/*
	 * Skip the native system next time through.
	 */
	    continue;
	}

	if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
	    startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
		    startAt);
	}

	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    if (proc != NULL) {
		startAt = (*proc)(interp, pathPtr, startAt);
	    }

	/*
	 * This efficiency check could be added:
	 *		if (retVal == length-of(pathPtr)) {break;}
	 * but there's not much benefit.
	 */
	    /*
	     * We could add an efficiency check like this:
	     *		if (retVal == length-of(pathPtr)) {break;}
	     * but there's not much benefit.
	     */
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return startAt;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenMode --
 *
 *	Obsolete.  A limited version of TclGetOpenModeEx() which exists only to
 *	satisfy any extensions imprudently using it via Tcl's internal stubs
 *	table.
 *	This routine is an obsolete, limited version of TclGetOpenModeEx()
 *	below. It exists only to satisfy any extensions imprudently using it
 *	via Tcl's internal stubs table.
 *
 * Results:
 *	See TclGetOpenModeEx().
 *	Same as TclGetOpenModeEx().
 *
 * Side effects:
 *	See TclGetOpenModeEx().
 *	Same as TclGetOpenModeEx().
 *
 *---------------------------------------------------------------------------
 */

int
TclGetOpenMode(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting.  May
				 *  be NULL. */
    const char *modeString,	/* e.g. "r+" or "RDONLY CREAT". */
    int *seekFlagPtr)		/* Sets this to 1 to tell the caller to seek to
				   EOF after opening the file, and
    Tcl_Interp *interp,		/* Interpreter to use for error reporting -
				 * may be NULL. */
    const char *modeString,	/* Mode string, e.g. "r+" or "RDONLY CREAT" */
    int *seekFlagPtr)		/* Set this to 1 if the caller should seek to
				 * EOF during the opening of the file. */
				 * 0 otherwise. */
{
    int binary = 0;
    return TclGetOpenModeEx(interp, modeString, seekFlagPtr, &binary);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclGetOpenModeEx --
 *
 *	Computes a POSIX mode mask for opening a file.
 *	Computes a POSIX mode mask for opening a file, from a given string,
 *	and also sets flags to indicate whether the caller should seek to EOF
 *	after opening the file, and whether the caller should configure the
 *	channel for binary data.
 *
 * Results:
 *	The mode to pass to "open", or -1 if an error occurs.
 *	On success, returns mode to pass to "open". If an error occurs, the
 *	return value is -1 and if interp is not NULL, sets interp's result
 *	object to an error message.
 *
 * Side effects:
 *	Sets *seekFlagPtr to 1 to tell the caller to
 *	seek to EOF after opening the file, or to 0 otherwise.
 *	Sets the integer referenced by seekFlagPtr to 1 to tell the caller to
 *	seek to EOF after opening the file, or to 0 otherwise. Sets the
 *
 *	Sets *binaryPtr to 1 to tell the caller to configure the channel as a
 *	binary channel, or to 0 otherwise.
 *	integer referenced by binaryPtr to 1 to tell the caller to seek to
 *	configure the channel for binary data, or to 0 otherwise.
 *
 *	If there is an error and interp is not NULL, sets interpreter result to
 *	an error message.
 *
 * Special note:
 *	Based on a prototype implementation contributed by Mark Diekhans.
 *	This code is based on a prototype implementation contributed by Mark
 *	Diekhans.
 *
 *---------------------------------------------------------------------------
 */

int
TclGetOpenModeEx(
    Tcl_Interp *interp,		/* Interpreter, possibly NULL, to use for
				 * error reporting. */
    Tcl_Interp *interp,		/* Interpreter to use for error reporting -
				 * may be NULL. */
    const char *modeString,	/* Mode string, e.g. "r+" or "RDONLY CREAT" */
    int *seekFlagPtr,		/* Sets this to 1 to tell the the caller to seek to
				 * EOF after opening the file, and 0 otherwise. */
    int *binaryPtr)		/* Sets this to 1 to tell the caller to
				 * configure the channel for binary
				 * operations after opening the file. */
    int *seekFlagPtr,		/* Set this to 1 if the caller should seek to
				 * EOF during the opening of the file. */
    int *binaryPtr)		/* Set this to 1 if the caller should
				 * configure the opened channel for binary
				 * operations */
{
    int mode, modeArgc, c, i, gotRW;
    const char **modeArgv, *flag;
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)

    /*
     * Check for the simpler fopen-like access modes like "r" which are
     * Check for the simpler fopen-like access modes (e.g. "r"). They are
     * distinguished from the POSIX access modes by the presence of a
     * lower-case first letter.
     */

    *seekFlagPtr = 0;
    *binaryPtr = 0;
    mode = 0;

    /*
     * Guard against wide characters before using byte-oriented routines.
     * Guard against international characters before using byte oriented
     * routines.
     */

    if (!(modeString[0] & 0x80)
	    && islower(UCHAR(modeString[0]))) { /* INTL: ISO only. */
	switch (modeString[0]) {
	case 'r':
	    mode = O_RDONLY;
	    break;
	case 'w':
	    mode = O_WRONLY|O_CREAT|O_TRUNC;
	    break;
	case 'a':
	    /*
	     * Add O_APPEND for proper automatic seek-to-end-on-write by the
	     * Added O_APPEND for proper automatic seek-to-end-on-write by the
	     * OS. [Bug 680143]
	     */

	    mode = O_WRONLY|O_CREAT|O_APPEND;
	    *seekFlagPtr = 1;
	    break;
	default:
	    goto error;
	}
	i = 1;
	i=1;
	while (i<3 && modeString[i]) {
	    if (modeString[i] == modeString[i-1]) {
		goto error;
	    }
	    switch (modeString[i++]) {
	    case '+':
		/*
		 * Remove O_APPEND so that the seek command works. [Bug
		 * 1773127]
		 * Must remove the O_APPEND flag so that the seek command
		 * works. [Bug 1773127]
		 */

		mode &= ~(O_RDONLY|O_WRONLY|O_APPEND);
		mode |= O_RDWR;
		break;
	    case 'b':
		*binaryPtr = 1;
1541
1542
1543
1544
1545
1546
1547
1548
1549


1550
1551
1552
1553
1554
1555


1556
1557


1558
1559
1560
1561
1562
1563
1564
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







-
-
+
+





-
+
+

-
+
+







	}
	return mode;

    error:
	*seekFlagPtr = 0;
	*binaryPtr = 0;
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "illegal access mode \"%s\"", modeString));
	    Tcl_AppendResult(interp, "illegal access mode \"", modeString,
		    "\"", NULL);
	}
	return -1;
    }

    /*
     * The access modes are specified as a list of POSIX modes like O_CREAT.
     * The access modes are specified using a list of POSIX modes such as
     * O_CREAT.
     *
     * Tcl_SplitList must work correctly when interp is NULL.
     * IMPORTANT NOTE: We rely on Tcl_SplitList working correctly when a NULL
     * interpreter is passed in.
     */

    if (Tcl_SplitList(interp, modeString, &modeArgc, &modeArgv) != TCL_OK) {
	if (interp != NULL) {
	    Tcl_AddErrorInfo(interp,
		    "\n    while processing open access modes \"");
	    Tcl_AddErrorInfo(interp, modeString);
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
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
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
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
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
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
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
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
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
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







-
-
+
+
-

-
+








-
-
+
+
-

-
+










-
-
-
+
+
+
-

-
+




-
+



-
-
+
+
-





+
+
+
+
+
+
+
+
+
+
+
+
+




-
+

-
-
+
+
-
-
-






-
-
-
+
+
+





-
-
-
-
-
-
-
-
-
-

-
-
-
+
+
+
-
-
-
+
+

-
-
+



-
+









-
-
-
+
+



-
-
-
-
+
+
+
+




-
-
+
+





-
-
+
+


-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-
-
+

-
-
-
+
+
-
-
-
+
+


-
+
-

-
-
+
+

-

-
-
+
+
-
-
-
+
+



-
+







-
-
+
+
-
-
-
-
+

-
+


+
-
+
-
-
+











-
+


-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
+
+


+









+
-
+



-
+


-
-
+
+







-
-
-
-
-








-
+
-
-





-
+








-
-
-
-
-








-
-
+
+
+
+


-
+


-
+






-
+
+















-

-
+

+
+












-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+









-

-
-
-
+
+
+
+












-
+
-
-
+


-

+
-
-
-
-
-
+
+
+
+
+
+
+











-
-
-
+
+












-
+


-
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+









-
-
+
+


-
+


-
-
+
+






-
-
+
+
+


-
-
+
+




+
+
+
+
+

+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
+
-
-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
+
+









-
-
-
-
+
+












-
-
+
+



-
-
-
-
+
+
+
+
+
-
+








-
-
-
-
+
+
+
+
+










-
+

-
-
+
+









-
-
-
-
+
+
+
+


-
+
-
-
-
-
+
+
-
+











-
-
+
+

-
+
+







-
-
-
-
+
+
+
+


-
+











-
-
+
+

-
+







-
-
+
+
-
-
-
+


-
-
+
+
+
+
+
+
-
+







-
+






-
-
+
+
+
+
+










-
+



-
+
-
-









-
-
-
+
+
+
+


-
+







	    mode |= O_EXCL;

	} else if ((c == 'N') && (strcmp(flag, "NOCTTY") == 0)) {
#ifdef O_NOCTTY
	    mode |= O_NOCTTY;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
		Tcl_AppendResult(interp, "access mode \"", flag,
			"\" not supported by this system", NULL);
			flag));
	    }
	    Tcl_Free((void *)modeArgv);
	    ckfree((char *) modeArgv);
	    return -1;
#endif

	} else if ((c == 'N') && (strcmp(flag, "NONBLOCK") == 0)) {
#ifdef O_NONBLOCK
	    mode |= O_NONBLOCK;
#else
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"access mode \"%s\" not supported by this system",
		Tcl_AppendResult(interp, "access mode \"", flag,
			"\" not supported by this system", NULL);
			flag));
	    }
	    Tcl_Free((void *)modeArgv);
	    ckfree((char *) modeArgv);
	    return -1;
#endif

	} else if ((c == 'T') && (strcmp(flag, "TRUNC") == 0)) {
	    mode |= O_TRUNC;
	} else if ((c == 'B') && (strcmp(flag, "BINARY") == 0)) {
	    *binaryPtr = 1;
	} else {

	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"invalid access mode \"%s\": must be RDONLY, WRONLY, "
			"RDWR, APPEND, BINARY, CREAT, EXCL, NOCTTY, NONBLOCK,"
		Tcl_AppendResult(interp, "invalid access mode \"", flag,
			"\": must be RDONLY, WRONLY, RDWR, APPEND, BINARY, "
			"CREAT, EXCL, NOCTTY, NONBLOCK, or TRUNC", NULL);
			" or TRUNC", flag));
	    }
	    Tcl_Free((void *)modeArgv);
	    ckfree((char *) modeArgv);
	    return -1;
	}
    }

    Tcl_Free((void *)modeArgv);
    ckfree((char *) modeArgv);

    if (!gotRW) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "access mode must include either RDONLY, WRONLY, or RDWR",
	    Tcl_AppendResult(interp, "access mode must include either"
		    " RDONLY, WRONLY, or RDWR", NULL);
		    -1));
	}
	return -1;
    }
    return mode;
}

/*
 * Tcl_FSEvalFile is Tcl_FSEvalFileEx without encoding argument.
 */

int
Tcl_FSEvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    Tcl_Obj *pathPtr)		/* Path of file to process. Tilde-substitution
				 * will be performed on this name. */
{
    return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSEvalFile, Tcl_FSEvalFileEx, TclNREvalFile --
 * Tcl_FSEvalFileEx --
 *
 *	Reads a file and evaluates it as a script.
 *
 *	Read in a file and process the entire file as one gigantic Tcl
 *	command.
 *	Tcl_FSEvalFile is Tcl_FSEvalFileEx without the encoding argument.
 *
 *	TclNREvalFile is an NRE-enabled version of Tcl_FSEvalFileEx.
 *
 * Results:
 *	A standard Tcl result, which is either the result of executing the
 *	file or an error indicating why the file couldn't be read.
 *
 * Side effects:
 *	Arbitrary, depending on the contents of the script.  While the script
 *	is evaluated iPtr->scriptFile is a reference to pathPtr, and after the
 *	evaluation completes, has its original value restored again.
 *	Depends on the commands in the file. During the evaluation of the
 *	contents of the file, iPtr->scriptFile is made to point to pathPtr
 *	(the old value is cached and replaced when this function returns).
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSEvalFile(
    Tcl_Interp *interp,		/* Interpreter that evaluates the script. */
    Tcl_Obj *pathPtr)		/* Pathname of file containing the script.
				 * Tilde-substitution is performed on this
				 * pathname. */
{
    return Tcl_FSEvalFileEx(interp, pathPtr, NULL);
}

int
Tcl_FSEvalFileEx(
    Tcl_Interp *interp,		/* Interpreter that evaluates the script. */
    Tcl_Obj *pathPtr,		/* Pathname of the file to process.
				 * Tilde-substitution is performed on this
    Tcl_Interp *interp,		/* Interpreter in which to process file. */
    Tcl_Obj *pathPtr,		/* Path of file to process. Tilde-substitution
				 * will be performed on this name. */
				 * pathname. */
    const char *encodingName)	/* Either the name of an encoding or NULL to
				   use the utf-8 encoding. */
    const char *encodingName)	/* If non-NULL, then use this encoding for the
				 * file. NULL means use the system encoding. */
{
    size_t length;
	int result = TCL_ERROR;
    int length, result = TCL_ERROR;
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile;
    Interp *iPtr;
    const char *string;
    char *string;
    Tcl_Channel chan;
    Tcl_Obj *objPtr;

    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	return result;
    }

    if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
	Tcl_SetErrno(errno);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	return result;
    }
    chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
    if (chan == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
    if (chan == (Tcl_Channel) NULL) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	return result;
    }

    /*
     * The eof character is \32 (^Z). This is standard on Windows, and Tcl
     * uses it on every platform to allow for scripted documents. [Bug: 2040]
     * The eofchar is \32 (^Z). This is the usual on Windows, but we effect
     * this cross-platform to allow for scripted documents. [Bug: 2040]
     */

    Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");

    /*
     * If the encoding is specified, set the channel to that encoding.
     * Otherwise use utf-8.  If the encoding is unknown report an error.
     * If the encoding is specified, set it for the channel. Else don't touch
     * it (and use the system encoding) Report error on unknown encoding.
     */

    if (encodingName == NULL) {
    if (encodingName != NULL) {
	encodingName = "utf-8";
    }
    if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
	    != TCL_OK) {
	Tcl_CloseEx(interp,chan,0);
	return result;
    }

    TclNewObj(objPtr);
	if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
		!= TCL_OK) {
	    Tcl_Close(interp,chan);
	    return result;
	}
    }

    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);

    /* Try to read first character of stream, so we can
    /*
     * Read first character of stream to check for utf-8 BOM
     * check for utf-8 BOM to be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	goto end;
    }
    string = TclGetString(objPtr);
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters.
     * Otherwise, replace them. [Bug 3466099]
     * 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)) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	Tcl_Close(interp, chan);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	goto end;
    }

    if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
    if (Tcl_Close(interp, chan) != TCL_OK) {
	goto end;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);
    string = TclGetStringFromObj(objPtr, &length);

    string = Tcl_GetStringFromObj(objPtr, &length);
    /* TIP #280 Force the evaluator to open a frame for a sourced
    /*
     * TIP #280:  Open a frame for the evaluated script.
     */

     * file. */
    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);
    result = Tcl_EvalEx(interp, string, length, 0);

    /*
     * Now we have to be careful; the script may have changed the
     * Restore the original iPtr->scriptFile value, but because the value may
     * iPtr->scriptFile value, so we must reset it without assuming it still
     * have hanged during evaluation, don't assume it currently points to
     * pathPtr.
     * points to 'pathPtr'.
     */

    if (iPtr->scriptFile != NULL) {
	Tcl_DecrRefCount(iPtr->scriptFile);
    }
    iPtr->scriptFile = oldScriptFile;

    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 * Record information telling where the error occurred.
	 */

	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	unsigned limit = 150;
	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
	int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
    }

  end:
    Tcl_DecrRefCount(objPtr);
    return result;
}

int
TclNREvalFile(
    Tcl_Interp *interp,		/* Interpreter in which to evaluate the script. */
    Tcl_Obj *pathPtr,		/* Pathname of a file containing the script to
				 * evaluate. Tilde-substitution is performed on
				 * this pathname. */
    const char *encodingName)	/* The name of an encoding to use, or NULL to
				 *  use the utf-8 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);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644);
    if (chan == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    TclPkgFileSeen(interp, TclGetString(pathPtr));

    /*
     * The eof character is \32 (^Z). This is standard on Windows, and Tcl
     * uses it on every platform to allow for scripted documents. [Bug: 2040]
     */

    Tcl_SetChannelOption(interp, chan, "-eofchar", "\32 {}");

    /*
     * If the encoding is specified, set the channel to that encoding.
     * Otherwise use utf-8.  If the encoding is unknown report an error.
     */

    if (encodingName == NULL) {
	encodingName = "utf-8";
    }
    if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName)
	    != TCL_OK) {
	Tcl_CloseEx(interp, chan, 0);
	return TCL_ERROR;
    }

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);

    /*
     * Read first character of stream to check for utf-8 BOM
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
    string = TclGetString(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)) == TCL_IO_FAILURE) {
	Tcl_CloseEx(interp, chan, 0);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read file \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    if (Tcl_CloseEx(interp, chan, 0) != TCL_OK) {
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

    iPtr = (Interp *) interp;
    oldScriptFile = iPtr->scriptFile;
    iPtr->scriptFile = pathPtr;
    Tcl_IncrRefCount(iPtr->scriptFile);

    /*
     * TIP #280:  Open a frame for the evaluated script.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    TclNRAddCallback(interp, EvalFileCallback, oldScriptFile, pathPtr, objPtr,
	    NULL);
    return TclNREvalObjEx(interp, objPtr, 0, NULL, INT_MIN);
}

static int
EvalFileCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldScriptFile = (Tcl_Obj *)data[0];
    Tcl_Obj *pathPtr = (Tcl_Obj *)data[1];
    Tcl_Obj *objPtr = (Tcl_Obj *)data[2];

    /*
     * Restore the original iPtr->scriptFile value, but because the value may
     * have hanged during evaluation, don't assume it currently points to
     * pathPtr.
     */

    if (iPtr->scriptFile != NULL) {
	Tcl_DecrRefCount(iPtr->scriptFile);
    }
    iPtr->scriptFile = oldScriptFile;

    if (result == TCL_RETURN) {
	result = TclUpdateReturnInfo(iPtr);
    } else if (result == TCL_ERROR) {
	/*
	 * Record information about where the error occurred.
	 */

	size_t length;
	const char *pathString = TclGetStringFromObj(pathPtr, &length);
	const unsigned int limit = 150;
	int overflow = (length > limit);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (file \"%.*s%s\" line %d)",
		(overflow ? limit : (unsigned int)length), pathString,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
		(overflow ? limit : length), pathString,
		(overflow ? "..." : ""), interp->errorLine));
    }

  end:
    Tcl_DecrRefCount(objPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetErrno --
 *
 *	Gets the current value of the Tcl error code variable. This is
 *	Currently the global variable "errno", but could in the future change
 *	currently the global variable "errno" but could in the future change
 *	to something else.
 *
 * Results:
 *	The current Tcl error number.
 *	The value of the Tcl error code variable.
 *
 * Side effects:
 *	None. The value of the Tcl error code variable is only defined if it
 *	was set by a previous call to Tcl_SetErrno.
 *	None. Note that the value of the Tcl error code variable is UNDEFINED
 *	if a call to Tcl_SetErrno did not precede this call.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetErrno(void)
{
    /*
     * On some platforms errno is thread-local, as implemented by the C
     * library.
     */

    return errno;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrno --
 *
 *	Sets the Tcl error code to the given value. On some saner platforms
 *	Sets the Tcl error code variable to the supplied value.
 *	this is implemented in the C library as a thread-local value , but this
 *	is *really* unsafe to assume!
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Modifies the the Tcl error code value.
 *	Modifies the value of the Tcl error code variable.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetErrno(
    int err)			/* The new value. */
{
    /*
     * On some platforms, errno is implemented by the C library as a thread
     * local value
     */

    errno = err;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PosixError --
 *
 *	Typically called after a UNIX kernel call returns an error.  Sets the
 *	interpreter errorCode to machine-parsable information about the error.
 *	This function is typically called after UNIX kernel calls return
 *	errors. It stores machine-readable information about the error in
 *	errorCode field of interp and returns an information string for the
 *	caller's use.
 *
 * Results:
 *	A human-readable sring describing the error.
 *	The return value is a human-readable string describing the error.
 *
 * Side effects:
 *	Sets the errorCode value of the interpreter.
 *	The errorCode field of the interp is set.
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_PosixError(
    Tcl_Interp *interp)		/* Interpreter to set the errorCode of */
    Tcl_Interp *interp)		/* Interpreter whose errorCode field is to be
				 * set. */
{
    const char *id, *msg;

    msg = Tcl_ErrnoMsg(errno);
    id = Tcl_ErrnoId();
    if (interp) {
	Tcl_SetErrorCode(interp, "POSIX", id, msg, NULL);
    }
    return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSStat --
 *	Calls 'statProc' of the filesystem corresponding to pathPtr.
 *
 *	Replaces the standard library routines stat.
 *	This function replaces the library version of stat and lsat.
 *
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSStat(
    Tcl_Obj *pathPtr,		/* Pathname of the file to call stat on (in
				 *  current CP). */
    Tcl_StatBuf *buf)		/* A buffer to hold the results of the call to
				 *  stat. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
{
    const Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
    struct stat oldStyleStatBuffer;
    int retVal = -1;

    /*
     * Call each of the "stat" function in succession. A non-return value of
     * -1 indicates the particular function has succeeded.
     */

    Tcl_MutexLock(&obsoleteFsHookMutex);

    if (statProcList != NULL) {
	StatProc *statProcPtr;
	char *path;
	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (transPtr == NULL) {
	    path = NULL;
	} else {
	    path = Tcl_GetString(transPtr);
	}

	statProcPtr = statProcList;
	while ((retVal == -1) && (statProcPtr != NULL)) {
	    retVal = (*statProcPtr->proc)(path, &oldStyleStatBuffer);
	    statProcPtr = statProcPtr->nextPtr;
	}
	if (transPtr != NULL) {
	    Tcl_DecrRefCount(transPtr);
	}
    }

    Tcl_MutexUnlock(&obsoleteFsHookMutex);
    if (retVal != -1) {
	/*
	 * Note that EOVERFLOW is not a problem here, and these assignments
	 * should all be widening (if not identity.)
	 */

	buf->st_mode = oldStyleStatBuffer.st_mode;
	buf->st_ino = oldStyleStatBuffer.st_ino;
	buf->st_dev = oldStyleStatBuffer.st_dev;
	buf->st_rdev = oldStyleStatBuffer.st_rdev;
	buf->st_nlink = oldStyleStatBuffer.st_nlink;
	buf->st_uid = oldStyleStatBuffer.st_uid;
	buf->st_gid = oldStyleStatBuffer.st_gid;
	buf->st_size = Tcl_LongAsWide(oldStyleStatBuffer.st_size);
	buf->st_atime = oldStyleStatBuffer.st_atime;
	buf->st_mtime = oldStyleStatBuffer.st_mtime;
	buf->st_ctime = oldStyleStatBuffer.st_ctime;
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
	buf->st_blksize = oldStyleStatBuffer.st_blksize;
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
	buf->st_blocks = Tcl_LongAsWide(oldStyleStatBuffer.st_blocks);
#endif
	return retVal;
    }
#endif /* USE_OBSOLETE_FS_HOOKS */

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL && fsPtr->statProc != NULL) {
	return fsPtr->statProc(pathPtr, buf);
    if (fsPtr != NULL) {
	Tcl_FSStatProc *proc = fsPtr->statProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, buf);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLstat --
 *	Calls the 'lstatProc' of the filesystem corresponding to pathPtr.
 *
 *	Replaces the library version of lstat.  If the filesystem doesn't
 *	provide lstatProc but does provide statProc, Tcl falls back to
 *	statProc.
 *	This function replaces the library version of lstat. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.
 *	If no 'lstat' function is listed, but a 'stat' function is, then Tcl
 *	will fall back on the stat function.
 *
 * Results:
 *	See lstat documentation.
 *
 * Side effects:
 *	See lstat documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSLstat(
    Tcl_Obj *pathPtr,		/* Pathname of the file to call stat on (in
    Tcl_Obj *pathPtr,		/* Path of file to stat (in current CP). */
				   current CP). */
    Tcl_StatBuf *buf)		/* Filled with results of that call to stat. */
    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL) {
	Tcl_FSLstatProc *proc = fsPtr->lstatProc;
	if (fsPtr->lstatProc != NULL) {
	    return fsPtr->lstatProc(pathPtr, buf);
	}
	if (fsPtr->statProc != NULL) {
	    return fsPtr->statProc(pathPtr, buf);
	if (proc != NULL) {
	    return (*proc)(pathPtr, buf);
	} else {
	    Tcl_FSStatProc *sproc = fsPtr->statProc;
	    if (sproc != NULL) {
		return (*sproc)(pathPtr, buf);
	    }
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSAccess --
 *
 *	Calls 'accessProc' of the filesystem corresponding to pathPtr.
 *
 *	Replaces the library version of access.
 *	This function replaces the library version of access. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSAccess(
    Tcl_Obj *pathPtr,		/* Pathname of file to access (in current CP). */
    Tcl_Obj *pathPtr,		/* Path of file to access (in current CP). */
    int mode)			/* Permission setting. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    const Tcl_Filesystem *fsPtr;
#ifdef USE_OBSOLETE_FS_HOOKS
    int retVal = -1;

    /*
     * Call each of the "access" function in succession. A non-return value of
     * -1 indicates the particular function has succeeded.
     */

    Tcl_MutexLock(&obsoleteFsHookMutex);

    if (accessProcList != NULL) {
	AccessProc *accessProcPtr;
	char *path;
	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (transPtr == NULL) {
	    path = NULL;
	} else {
	    path = Tcl_GetString(transPtr);
	}

	accessProcPtr = accessProcList;
	while ((retVal == -1) && (accessProcPtr != NULL)) {
	    retVal = (*accessProcPtr->proc)(path, mode);
	    accessProcPtr = accessProcPtr->nextPtr;
	}
	if (transPtr != NULL) {
	    Tcl_DecrRefCount(transPtr);
	}
    }

    Tcl_MutexUnlock(&obsoleteFsHookMutex);
    if (retVal != -1) {
	return retVal;
    }
#endif /* USE_OBSOLETE_FS_HOOKS */

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL && fsPtr->accessProc != NULL) {
	return fsPtr->accessProc(pathPtr, mode);
    }
    if (fsPtr != NULL) {
	Tcl_FSAccessProc *proc = fsPtr->accessProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, mode);
	}
    }

    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSOpenFileChannel --
 *
 *	Calls 'openfileChannelProc' of the filesystem corresponding to
 *	pathPtr.
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.
 *
 * Results:
 *	The new channel, or NULL if the named file could not be opened.
 *	The new channel or NULL, if the named file could not be opened.
 *
 * Side effects:
 *	Opens a channel, possibly creating the corresponding the file on the
 *	filesystem.
 *	May open the channel and may cause creation of a file on the file
 *	system.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_FSOpenFileChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting, or NULL */
    Tcl_Obj *pathPtr,		/* Pathname of file to open. */
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    Tcl_Obj *pathPtr,		/* Name of file to open. */
    const char *modeString,	/* A list of POSIX open modes or a string such
				 * as "rw". */
    int permissions)		/* What modes to use if opening the file
				   involves creating it. */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    const Tcl_Filesystem *fsPtr;
    Tcl_Channel retVal = NULL;

#ifdef USE_OBSOLETE_FS_HOOKS
    /*
     * Call each of the "Tcl_OpenFileChannel" functions in succession. A
     * non-NULL return value indicates the particular function has succeeded.
     */

    Tcl_MutexLock(&obsoleteFsHookMutex);
    if (openFileChannelProcList != NULL) {
	OpenFileChannelProc *openFileChannelProcPtr;
	char *path;
    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	/*
	 * Return the correct error message.
	 */
	Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

	if (transPtr == NULL) {
	    path = NULL;
	} else {
	    path = Tcl_GetString(transPtr);
	}

	openFileChannelProcPtr = openFileChannelProcList;

	while ((retVal == NULL) && (openFileChannelProcPtr != NULL)) {
	    retVal = (*openFileChannelProcPtr->proc)(interp, path,
		    modeString, permissions);
	    openFileChannelProcPtr = openFileChannelProcPtr->nextPtr;
	}
	if (transPtr != NULL) {
	    Tcl_DecrRefCount(transPtr);
	}
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);
    if (retVal != NULL) {
	return retVal;
    }
#endif /* USE_OBSOLETE_FS_HOOKS */

    /*
     * We need this just to ensure we return the correct error messages under
     * some circumstances.
     */

    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	return NULL;
    }

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL && fsPtr->openFileChannelProc != NULL) {
	int mode, seekFlag, binary;
    if (fsPtr != NULL) {
	Tcl_FSOpenFileChannelProc *proc = fsPtr->openFileChannelProc;
	if (proc != NULL) {
	    int mode, seekFlag, binary;

	/*
	 * Parse the mode to determine whether to seek at the outset
	 * and/or set the channel into binary mode.
	 */
	    /*
	     * Parse the mode, picking up whether we want to seek to start
	     * with and/or set the channel automatically into binary mode.
	     */

	mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
	if (mode == -1) {
	    return NULL;
	}
	    mode = TclGetOpenModeEx(interp, modeString, &seekFlag, &binary);
	    if (mode == -1) {
		return NULL;
	    }

	/*
	 * Open the file.
	 */
	    /*
	     * Do the actual open() call.
	     */

	retVal = fsPtr->openFileChannelProc(interp, pathPtr, mode,
	    retVal = (*proc)(interp, pathPtr, mode, permissions);
		permissions);
	if (retVal == NULL) {
	    return NULL;
	}
	    if (retVal == NULL) {
		return NULL;
	    }

	/*
	 * Seek and/or set binary mode as determined above.
	 */
	    /*
	     * Apply appropriate flags parsed out above.
	     */

	if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt) 0, SEEK_END)
		< (Tcl_WideInt) 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not seek to end of file while opening \"%s\": %s",
			TclGetString(pathPtr), Tcl_PosixError(interp)));
	    }
	    Tcl_CloseEx(NULL, retVal, 0);
	    return NULL;
	}
	if (binary) {
	    Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
	}
	return retVal;
	    if (seekFlag && Tcl_Seek(retVal, (Tcl_WideInt)0,
		    SEEK_END) < (Tcl_WideInt)0) {
		if (interp != NULL) {
		    Tcl_AppendResult(interp, "could not seek to end "
			    "of file while opening \"", Tcl_GetString(pathPtr),
			    "\": ", Tcl_PosixError(interp), NULL);
		}
		Tcl_Close(NULL, retVal);
		return NULL;
	    }
	    if (binary) {
		Tcl_SetChannelOption(interp, retVal, "-translation", "binary");
	    }
	    return retVal;
	}
    }

    /*
     * File doesn't belong to any filesystem that can open it.
     */

    Tcl_SetErrno(ENOENT);
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't open \"%s\": %s",
		TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't open \"", Tcl_GetString(pathPtr),
		"\": ", Tcl_PosixError(interp), NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUtime --
 *
 *	Calls 'uTimeProc' of the filesystem corresponding to the given
 *	pathname.
 *
 *	Replaces the library version of utime.
 *	This function replaces the library version of utime. The appropriate
 *	function for the filesystem to which pathPtr belongs will be called.
 *
 * Results:
 *	See utime documentation.
 *
 * Side effects:
 *	See utime documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSUtime(
    Tcl_Obj *pathPtr,		/* Pathaname of file to call uTimeProc on */
    struct utimbuf *tval)	/* Specifies the access/modification
    Tcl_Obj *pathPtr,		/* File to change access/modification times */
    struct utimbuf *tval)	/* Structure containing access/modification
				 * times to use. Should not be modified. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->utimeProc != NULL) {
	return fsPtr->utimeProc(pathPtr, tval);
    }
    if (fsPtr != NULL) {
	Tcl_FSUtimeProc *proc = fsPtr->utimeProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, tval);
	}
    /* TODO: set errno here? Tcl_SetErrno(ENOENT); */
    }
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrStrings --
 *
 *	Implements the platform-dependent 'file attributes' subcommand for the
 *	native filesystem, for listing the set of possible attribute strings.
 *	Part of Tcl's native filesystem support. Placed here because it is used
 *	under both Unix and Windows.
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for listing the set of possible
 *	attribute strings. This function is part of Tcl's native filesystem
 *	support, and is placed here because it is shared by Unix and Windows
 *	code.
 *
 * Results:
 *	An array of strings
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static const char *const *
static const char **
NativeFileAttrStrings(
    TCL_UNUSED(Tcl_Obj *),
    TCL_UNUSED(Tcl_Obj **))
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    return tclpFileAttrStrings;
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsGet --
 *
 *	Implements the platform-dependent 'file attributes' subcommand for the
 *	native filesystem for 'get' operations.  Part of Tcl's native
 *	filesystem support.  Defined here because it is used under both Unix
 *	and Windows.
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for 'get' operations. This
 *	function is part of Tcl's native filesystem support, and is placed
 *	here because it is shared by Unix and Windows code.
 *
 * Results:
 *	Standard Tcl return code.
 *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
 *
 *	If there was no error, stores in objPtrRef a pointer to a new object
 *	having a refCount of zero and  holding the result.  The caller should
 *	store it somewhere, e.g. as the Tcl result, or decrement its refCount
 *	was returned) is likely to have a refCount of zero. Either way we must
 *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
 *	to free it.
 *	refCount to ensure it is properly freed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NativeFileAttrsGet(
    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* Pathname of the file */
    Tcl_Obj **objPtrRef)	/* Where to store the a pointer to the result. */
    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
    Tcl_Obj **objPtrRef)	/* for output. */
{
    return tclpFileAttrProcs[index].getProc(interp, index, pathPtr,objPtrRef);
    return (*tclpFileAttrProcs[index].getProc)(interp, index, pathPtr,
	    objPtrRef);
}

/*
 *----------------------------------------------------------------------
 *
 * NativeFileAttrsSet --
 *
 *	Implements the platform-dependent 'file attributes' subcommand for the
 *	native filesystem for 'set' operations.  A part of Tcl's native
 *	filesystem support, it is defined here because it is used under both
 *	Unix and Windows.
 *	This function implements the platform dependent 'file attributes'
 *	subcommand, for the native filesystem, for 'set' operations. This
 *	function is part of Tcl's native filesystem support, and is placed
 *	here because it is shared by Unix and Windows code.
 *
 * Results:
 *	A standard Tcl return code.
 *	Standard Tcl return code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NativeFileAttrsSet(
    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* Pathname of the file */
    Tcl_Obj *objPtr)		/* The value to set. */
    Tcl_Obj *pathPtr,		/* path of file we are operating on. */
    Tcl_Obj *objPtr)		/* set to this value. */
{
    return tclpFileAttrProcs[index].setProc(interp, index, pathPtr, objPtr);
    return (*tclpFileAttrProcs[index].setProc)(interp, index, pathPtr, objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrStrings --
 *
 *	Implements part of the hookable 'file attributes'
 *	subcommand.
 *	This function implements part of the hookable 'file attributes'
 *	subcommand. The appropriate function for the filesystem to which
 *
 *	Calls 'fileAttrStringsProc' of the filesystem corresponding to the
 *	given pathname.
 *	pathPtr belongs will be called.
 *
 * Results:
 *	Returns an array of strings, or returns NULL and stores in objPtrRef
 *	a pointer to a new Tcl list having a refCount of zero, and containing
 *	The called function may either return an array of strings, or may
 *	instead return NULL and place a Tcl list into the given objPtrRef.
 *	Tcl will take that list and first increment its refCount before using
 *	it. On completion of that use, Tcl will decrement its refCount. Hence
 *	if the list should be disposed of by Tcl when done, it should have a
 *	refCount of zero, and if the list should not be disposed of, the
 *	the file attribute strings.
 *	filesystem should ensure it retains a refCount on the object.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *const *
const char **
Tcl_FSFileAttrStrings(
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->fileAttrStringsProc != NULL) {
	return fsPtr->fileAttrStringsProc(pathPtr, objPtrRef);
    if (fsPtr != NULL) {
	Tcl_FSFileAttrStringsProc *proc = fsPtr->fileAttrStringsProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr, objPtrRef);
	}
    }
    Tcl_SetErrno(ENOENT);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSFileAttrIndex --
 *
 *	Given an attribute name, determines the index of the attribute in the
 *	Helper function for converting an attribute name to an index into the
 *	attribute table.
 *
 * Results:
 *	A standard Tcl result code.
 *	Tcl result code, index written to *indexPtr on result==TCL_OK
 *
 *	If there is no error, stores the index in *indexPtr.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclFSFileAttrIndex(
    Tcl_Obj *pathPtr,		/* Pathname of the file. */
    const char *attributeName,	/* The name of the attribute. */
    int *indexPtr)		/* A place to store the result. */
    Tcl_Obj *pathPtr,		/* File whose attributes are to be indexed
				 * into. */
    const char *attributeName,	/* The attribute being looked for. */
    int *indexPtr)		/* Where to write the found index. */
{
    Tcl_Obj *listObj = NULL;
    const char *const *attrTable;
    const char **attrTable;

    /*
     * Get the attribute table for the file.
     */

    attrTable = Tcl_FSFileAttrStrings(pathPtr, &listObj);
    if (listObj != NULL) {
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
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

















2658
2659

2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718




2719
2720
2721
2722

2723
2724
2725
2726
2727
2728
2729
2730
2731








2732
2733
2734


2735
2736

2737
2738
2739
2740
2741
2742





2743
2744
2745
2746
2747
2748
2749






2750
2751
2752
2753



2754
2755
2756
2757



2758
2759
2760


2761
2762
2763


2764
2765
2766
2767
2768
2769
2770

2771
2772
2773
2774
2775


2776
2777
2778
2779
2780





2781

2782
2783
2784
2785
2786
2787
2788
2789








2790
2791
2792
2793
2794
2795






2796
2797
2798


2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813

















2814
2815
2816
2817
2818
2819
2820
2821
2822














2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838

2839
2840
2841


2842
2843
2844


2845
2846
2847

2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859

2860
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
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




3775
3776
3777
3778
3779
3780
3781
3782



3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805


3806
3807
3808
3809


3810
3811
3812

3813
3814
3815
3816
3817
3818
3819

3820
3821
3822
3823
3824
3825
3826
3827
3828




3829
3830
3831
3832
3833
3834
3835
3836
3837
3838







3839
3840


3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854



3855
3856
3857



3858
3859
3860

3861
3862
3863
3864
3865
3866
3867

3868
3869

3870
3871
3872


3873
3874
3875

3876
3877
3878

3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889

3890


3891
3892
3893

3894
3895
3896
3897

3898
3899
3900
3901
3902
3903
3904
3905



3906
3907
3908
3909


3910
3911
3912
3913
3914
3915

3916
3917
3918
3919

3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941




3942
3943
3944
3945
3946

3947
3948
3949
3950
3951
3952

3953
3954
3955
3956




3957
3958
3959

3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973









3974
3975
3976




3977
3978
3979


3980


3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004





4005
4006
4007

4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028










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
4328
4329
4330
4331
4332
4333
4334
4335
4336





4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348



4349
4350
4351

4352
4353
4354

4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366




4367
4368
4369
4370


4371
4372
4373
4374
4375
4376
4377
4378
4379





4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393


4394
4395
4396

4397
4398
4399

4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412






4413
4414
4415


4416
4417
4418
4419
4420


4421
4422
4423






4424
4425
4426
4427
4428
4429
4430






4431
4432
4433
4434
4435
4436
4437
4438
4439
4440









4441
4442
4443


4444
4445
4446
4447
4448
4449
4450
4451
4452











4453
4454
4455
4456
4457
4458
4459

4460



4461
4462
4463

4464
4465
4466

4467
4468
4469
4470
4471
4472

4473
4474

4475
4476
4477

4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488







4489
4490
4491
4492



4493




4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513

4514

4515
4516
4517
4518


4519

4520
4521
4522
4523
4524
4525
4526
4527








4528
4529

4530
4531
4532
4533





4534
4535
4536

4537
4538
4539
4540
4541
4542
4543



















4544

4545
4546
4547
4548
4549

4550
4551
4552
4553

4554
4555
4556
4557
4558
4559
4560
4561

4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576

4577
4578
4579
4580
4581
4582
4583
4584



4585
4586
4587

4588
4589
4590
4591
4592

4593
4594
4595
4596
4597
4598
4599
4600
4601
4602

4603
4604
4605
4606
4607
4608
4609
4610

4611
4612
4613
4614



4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629


4630
4631
4632



4633
4634
4635

4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
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
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


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


2658
2659
2660
2661


2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716


2717
2718















2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740


2741





2742
2743
2744
2745
2746
2747
2748
2749
2750
2751

2752
2753


2754
2755

2756





2757
2758
2759
2760
2761
2762
2763
2764

2765

2766
2767
2768
2769





2770
2771
2772




2773
2774
2775
2776

2777
2778

2779



2780





2781
2782
2783
2784
2785
2786
2787
2788



2789
2790


2791






2792
2793
2794
2795
2796
2797






2798
2799
2800
2801
2802
2803
2804



2805
2806
2807
2808



2809
2810
2811
2812


2813
2814



2815
2816







2817





2818
2819
2820




2821
2822
2823
2824
2825
2826
2827








2828
2829
2830
2831
2832
2833
2834
2835






2836
2837
2838
2839
2840
2841
2842


2843
2844
2845














2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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



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
3775
3776
3777





3778
3779
3780
3781
3782
3783
3784


3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799

3800
3801
3802
3803
3804

3805
3806
3807
3808
3809

3810
3811
3812
3813
3814
3815
3816

3817


3818
3819


3820
3821
3822
3823

3824
3825
3826

3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839

3840
3841
3842
3843

3844

3845
3846

3847
3848
3849
3850
3851
3852



3853
3854
3855
3856
3857


3858
3859
3860
3861
3862
3863
3864

3865
3866
3867
3868

3869
3870

3871
3872
3873
3874
3875
3876

3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904

3905
3906
3907


3908
3909
3910
3911
3912
3913

3914
3915
3916
3917
3918
3919
3920








3921
3922
3923
3924
3925
3926
3927
3928
3929



3930
3931
3932
3933
3934


3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958





3959
3960
3961
3962
3963
3964
3965

3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977










3978
3979
3980
3981
3982
3983
3984
3985
3986
3987



3988
3989
3990
3991
3992
3993
3994
3995
3996
3997


3998
3999
4000
4001
4002
4003
4004
4005
4006
4007



4008
4009
4010
4011




4012
4013
4014
4015
4016
4017





4018
4019
4020
4021
4022
4023
4024
4025

4026

4027

4028
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
4328
4329
4330
4331
4332





4333
4334
4335
4336




4337
4338
4339
4340
4341

4342
4343
4344


4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361


4362
4363
4364
4365

4366
4367
4368

4369

4370
4371
4372
4373
4374
4375






4376
4377
4378
4379
4380
4381



4382
4383

4384
4385


4386
4387



4388
4389
4390
4391
4392
4393







4394
4395
4396
4397
4398
4399
4400









4401
4402
4403
4404
4405
4406
4407
4408
4409
4410


4411
4412
4413








4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432

4433
4434
4435
4436
4437

4438
4439
4440

4441

4442
4443
4444
4445

4446
4447

4448
4449
4450

4451
4452
4453
4454
4455
4456
4457





4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471

4472
4473
4474
4475
4476
4477
4478



4479

4480
4481






4482
4483
4484

4485

4486
4487


4488
4489
4490

4491








4492
4493
4494
4495
4496
4497
4498
4499
4500

4501




4502
4503
4504
4505
4506
4507
4508

4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535

4536
4537
4538
4539
4540

4541
4542
4543
4544

4545
4546
4547
4548
4549
4550
4551
4552

4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567

4568
4569
4570
4571
4572
4573
4574

4575
4576
4577
4578
4579
4580

4581


4582
4583

4584

4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601

4602

4603


4604
4605
4606

4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619

4620
4621
4622
4623

4624
4625
4626
4627
4628

4629
4630
4631
4632
4633
4634
4635
4636
4637
4638

4639
4640
4641
4642

4643


4644
4645
4646
4647

4648



4649
4650
4651
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
4955
4956
4957
4958
4959
4960
4961
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







-
+
-
-
-
+
+


-
-
+
+
+
-
-
+










-
-
-
+
+
+



-
-
+
+
+
+
+










-
-
+
+
-
-
-
+


-
+










-
-
-
+
+
+



-
-
+
+
+
+
+










-
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+
+
-
-
+
+
+
+
+
+
+
+


-
-
+
+
+

-
-
+
+


















-
-
-
+
+
+
-




-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
-
-
-
-
-
+
+
+
+
+
+
+

+

-


-
-
+
+
-

-
-
-
-
-
+
+
+
+
+
+


-
+
-




-
-
-
-
-



-
-
-
-
+
+
+
+
-


-
+
-
-
-

-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+

-
-
-
-
+
+
+
+
+

+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+















-
+

-
-
+
+


-
+
+


-
+
-
-
-








-
+
-


-
-
-







+
-
+

+
-
+


-
+


-
+




+
+
+
+
+
+
+



-
-
+



-
-
-
-






-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
+


-
-
+
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
+
+
+
+

+
+
+
+
+
+
+

-
-
+
+


-
-
+
+







-
-
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
+
+
+
+

-
-
+
+
+


+
+
+
+


+
+
-
+
+
+
+

-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+

-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
+
-
+


-
-
+
+




+
+
+

-
-
-
-
+
+
+
+
+
-





+
+
+
+
+
+
+
+
+


-
-
+
+
-

-
+
-
-
-
+

+
-
+
-
+

-
-
+
+
+
+
+

-


-


-
+

+




-
+
-
-
-
-
-



-
-
+



-
+


-
-
-


-
-
+
+






-
-
-
+
+
-





-
+

-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-

+
-
+
-


-
+



-






-
-
-
+
+
+
+
-




-
+
-
-
+
+
+
+
+
+








-
-
-
-
+
+
+
+
-



-
-
-
-
+
+
-





-
-
-
+
+
+















-
+











-
+


-
-
+
+

-
+

+





-
-
+
-
-
+


-
+
+


-
+

+
+







-
-
+
+
-
-
-
-
-
-
+
+



-
-
-
+
-




+
+
+
+





-
+

-
-
-
+
+
+
+
















+
-
+
-


-
-
-
+
+
-
-
-
+
+

+
+
+
+






-
-
+
+


+
-
-
+
+



+
-
-
-
+
+
+


-
+
-
-
+
+
+
-




+
-
+


-
+


-
-
+
+
+






+
-
+
+
+



-
-
-
+
+
+






-
+






-
+
+








-
+
-
-
-
+
+
-
-

-
-
+
-



-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-







-
+

-
+

-
-
+
+
+
+
+
+
+
+
+
+

-
+


-
-
+
+
-
-
+
-
+
+

-
+
-

-
-
-
-
+
-
-
-
-
-
+
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-

-
-
-
-


-


-
-
-
+
+
+
+


-
-
+
+
+
-
-
-



-
-
+
+
+




+


-
-
+
+





-
-
-
+
+
+

-
-
-
-
+
+
+
+
+
+

-
-
+
+




+
-
-
+
+
-





-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
+
+
+


-
-
-
+
+
+
+

+
-
-
-
+
+
+




-
-
+
+
-
-
+


-
-
-
+






-
-
+
+
-
-
-
+



-
-
+
+
+
+
+
+



-
-
-
-
+
+
+
+
+



-
+











-
-
-
+
+
+
+
+
+
+
+
+
+










-
+



-
+


-
-
-
+
+
+
+


-



-
-
+
+
+
-


-
-
-
-















-
+
+


-
-
+
+


-
+






-
+







-
-
+
+
+
+





-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
+













-
+
+
+


-
+
+
+


-
+






-
+
-
-
+

-
-
+
+


-
+


-
+











+
-
+
+


-
+
-


-
+





-
-
-
+
+
+


-
-
+
+





-
+



-
+

-






-













+
+
+
+





+





-
+


-
-
+
+
+
+


-
+






-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+

-
-
+
+

+
+



















-
-
-
-
-
+
+
+
+
+


-
+











-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+





+
-
-
+
+





+
+

-
-
-
+
+
+
+
-
-
-
-
+
+
+
+

+
-
-
-
-
-
+
+
+
+
+
+


-
+
-

-
+





-
-
-
+
+
+
+

-
-
+
+






-
-
+
+



-
-
+
+


-
+

















-
+

-















-
-
-
+
+
+


-
+
-









-
-
-
+
+
+
+



-



-
-
-
+
+
+
+
+












-
-
+
+
+

-
-
+
+
+


-
+
-


-
+
-






-
-
+
+



-



-
-
+
+
+
+
+












-
-
+
+
+


-
+


-
+



-


-
-
-
+
+
+










-
+







-
+


-
+




-
-
+
+







-
+


-
-
+
+






-
-
+
+












-
-
+
+


-
+












-
-
-
+
+
+
+
+










-
-
+
+


-
+


-
+
-









-
-
-
+
+
+
+
+










-
-
+
+
+


-
+


-
+
-






-
-
-
-
-
+
+
+
+
-
-
-
-
+
+



-



-
-
+
+
+
+
+












-
-
+
+


-
+


-
+
-






-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-


-
-
+
+
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







+
-
+
+
+


-
+


-
+
-




-
+

-
+


-
+






-
-
-
-
-
+
+
+
+
+
+
+




+
+
+
-
+
+
+
+



-
-
-

-


-
-
-
-
-
-



-
+
-
+

-
-

+
+
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-
-
-
-
+
+
+
+
+


-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+




-
+



-
+







-
+














-
+






-

+
+
+


-
+
-
-


-
+
-









+







-
+
-

-
-
+
+
+
-













-
+
+


-
+
+
+


-
+









-




-

-
-
+
+
+

-
+
-
-
-
+
+
+

-
-
+
+
+







-
-
+
+


-
+









-
+

-
+
-










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsGet --
 *
 *	Implements read access for the hookable 'file attributes' subcommand.
 *	This function implements read access for the hookable 'file
 *
 *	Calls 'fileAttrsGetProc' of the filesystem corresponding to the given
 *	pathname.
 *	attributes' subcommand. The appropriate function for the filesystem to
 *	which pathPtr belongs will be called.
 *
 * Results:
 *	A standard Tcl return code.
 *
 *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
 *	was returned) is likely to have a refCount of zero. Either way we must
 *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
 *	On success, stores in objPtrRef a pointer to a new Tcl_Obj having a
 *	refCount of zero, and containing the result.
 *	refCount to ensure it is properly freed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSFileAttrsGet(
    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* The index of the attribute command. */
    Tcl_Obj *pathPtr,		/* The pathname of the file. */
    Tcl_Obj **objPtrRef)	/* A place to store the result. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* filename we are operating on. */
    Tcl_Obj **objPtrRef)	/* for output. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->fileAttrsGetProc != NULL) {
	return fsPtr->fileAttrsGetProc(interp, index, pathPtr, objPtrRef);
    if (fsPtr != NULL) {
	Tcl_FSFileAttrsGetProc *proc = fsPtr->fileAttrsGetProc;
	if (proc != NULL) {
	    return (*proc)(interp, index, pathPtr, objPtrRef);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSFileAttrsSet --
 *
 *	Implements write access for the hookable 'file
 *	attributes' subcommand.
 *	This function implements write access for the hookable 'file
 *	attributes' subcommand. The appropriate function for the filesystem to
 *
 *	Calls 'fileAttrsSetProc' for the filesystem corresponding to the given
 *	pathname.
 *	which pathPtr belongs will be called.
 *
 * Results:
 *	A standard Tcl return code.
 *	Standard Tcl return code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSFileAttrsSet(
    Tcl_Interp *interp,		/* The interpreter for error reporting. */
    int index,			/* The index of the attribute command. */
    Tcl_Obj *pathPtr,		/* The pathname of the file. */
    Tcl_Obj *objPtr)		/* A place to store the result. */
    int index,			/* index of the attribute command. */
    Tcl_Obj *pathPtr,		/* filename we are operating on. */
    Tcl_Obj *objPtr)		/* Input value. */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->fileAttrsSetProc != NULL) {
	return fsPtr->fileAttrsSetProc(interp, index, pathPtr, objPtr);
    if (fsPtr != NULL) {
	Tcl_FSFileAttrsSetProc *proc = fsPtr->fileAttrsSetProc;
	if (proc != NULL) {
	    return (*proc)(interp, index, pathPtr, objPtr);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSGetCwd --
 *
 *	Replaces the library version of getcwd().
 *	This function replaces the library version of getcwd().
 *
 *	Most virtual filesystems do not implement cwdProc. Tcl maintains its
 *	own record of the current directory which it keeps synchronized with
 *	the filesystem corresponding to the pathname of the current directory
 *	if the filesystem provides a cwdProc (the native filesystem does).
 *	Most VFS's will *not* implement a 'cwdProc'. Tcl now maintains its own
 *	record (in a Tcl_Obj) of the cwd, and an attempt is made to synch this
 *	with the cwd's containing filesystem, if that filesystem provides a
 *	cwdProc (e.g. the native filesystem).
 *
 *	If Tcl's current directory is not in the native filesystem, Tcl's
 *	current directory and the current directory of the process are
 *	different.  To avoid confusion, extensions should call Tcl_FSGetCwd to
 *	Note that if Tcl's cwd is not in the native filesystem, then of course
 *	Tcl's cwd and the native cwd are different: extensions should
 *	therefore ensure they only access the cwd through this function to
 *	avoid confusion.
 *	obtain the current directory from Tcl rather than from the operating
 *	system.
 *
 *	If a global cwdPathPtr already exists, it is cached in the thread's
 *	private data structures and reference to the cached copy is returned,
 *	subject to a synchronisation attempt in that cwdPathPtr's fs.
 *
 *	Otherwise, the chain of functions that have been "inserted" into the
 *	filesystem will be called in succession until either a value other
 *	than NULL is returned, or the entire list is visited.
 *
 * Results:
 *	Returns a pointer to a Tcl_Obj having a refCount of 1 and containing
 *	the current thread's local copy of the global cwdPathPtr value.
 *	The result is a pointer to a Tcl_Obj specifying the current directory,
 *	or NULL if the current directory could not be determined. If NULL is
 *	returned, an error message is left in the interp's result.
 *
 *	Returns NULL if the current directory could not be determined, and
 *	leaves an error message in the interpreter's result.
 *	The result already has its refCount incremented for the caller. When
 *	it is no longer needed, that refCount should be decremented.
 *
 * Side effects:
 *	Various objects may be freed and allocated.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSGetCwd(
    Tcl_Interp *interp)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);

    if (TclFSCwdPointerEquals(NULL)) {
	FilesystemRecord *fsRecPtr;
	Tcl_Obj *retVal = NULL;

	/*
	 * This is the first time this routine has been called. Call
	 * 'getCwdProc' for each registered filsystems until one returns
	 * something other than NULL, which is a pointer to the pathname of the
	 * We've never been called before, try to find a cwd. Call each of the
	 * "Tcl_GetCwd" function in succession. A non-NULL return value
	 * indicates the particular function has succeeded.
	 * current directory.
	 */

	fsRecPtr = FsGetFirstFilesystem();
	Claim();
	for (; (retVal == NULL) && (fsRecPtr != NULL);
		fsRecPtr = fsRecPtr->nextPtr) {
	    ClientData retCd;
	    TclFSGetCwdProc2 *proc2;
	while ((retVal == NULL) && (fsRecPtr != NULL)) {
	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
	    if (proc != NULL) {
		if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    ClientData retCd;
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;

	    if (fsRecPtr->fsPtr->getCwdProc == NULL) {
		continue;
	    }

	    if (fsRecPtr->fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
		retVal = fsRecPtr->fsPtr->getCwdProc(interp);
		continue;
	    }

	    proc2 = (TclFSGetCwdProc2 *) fsRecPtr->fsPtr->getCwdProc;
	    retCd = proc2(NULL);
	    if (retCd != NULL) {
		Tcl_Obj *norm;
		    retCd = (*proc2)(NULL);
		    if (retCd != NULL) {
			Tcl_Obj *norm;

		/*
		 * Found the pathname of the current directory.
			/* Looks like a new current directory */
		 */

		retVal = fsRecPtr->fsPtr->internalToNormalizedProc(retCd);
		Tcl_IncrRefCount(retVal);
		norm = TclFSNormalizeAbsolutePath(interp,retVal);
		if (norm != NULL) {
		    /*
		     * Assign to global storage the pathname of the current directory
		     * and copy it into thread-local storage as well.
		     *
		     * At system startup multiple threads could in principle
		     * call this function simultaneously, which is a little
		     * peculiar, but should be fine given the mutex locks in
		     * FSUPdateCWD.  Once some value is assigned to the global
		     * variable the 'else' branch below is always taken, which
			retVal = (*fsRecPtr->fsPtr->internalToNormalizedProc)(
				retCd);
			Tcl_IncrRefCount(retVal);
			norm = TclFSNormalizeAbsolutePath(interp,retVal);
			if (norm != NULL) {
			    /*
			     * We found a cwd, which is now in our global
			     * storage. We must make a copy. Norm already has
			     * a refCount of 1.
			     *
			     * Threading issue: note that multiple threads at
			     * system startup could in principle call this
			     * function simultaneously. They will therefore
			     * each set the cwdPathPtr independently. That
			     * behaviour is a bit peculiar, but should be
			     * fine. Once we have a cwd, we'll always be in
			     * the 'else' branch below which is simpler.
		     * is simpler.
		     */
			     */

		    FsUpdateCwd(norm, retCd);
		    Tcl_DecrRefCount(norm);
		} else {
		    fsRecPtr->fsPtr->freeInternalRepProc(retCd);
		}
		Tcl_DecrRefCount(retVal);
		retVal = NULL;
		Disclaim();
		goto cdDidNotChange;
	    } else if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error getting working directory name: %s",
			Tcl_PosixError(interp)));
	    }
	}
			    FsUpdateCwd(norm, retCd);
			    Tcl_DecrRefCount(norm);
			} else {
			    (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
			}
			Tcl_DecrRefCount(retVal);
			retVal = NULL;
			Disclaim();
			goto cdDidNotChange;
		    } else if (interp != NULL) {
			Tcl_AppendResult(interp,
				"error getting working directory name: ",
				Tcl_PosixError(interp), NULL);
		    }
		} else {
		    retVal = (*proc)(interp);
		}
	    }
	    fsRecPtr = fsRecPtr->nextPtr;
	}
	Disclaim();

	if (retVal != NULL) {
	    /*
	/*
	     * On some platforms the pathname of the current directory might
	     * not be normalized.  For efficiency, ensure that it is
	     * normalized.  For the sake of efficiency, we want a completely
	     * normalized current working directory at all times.
	     */
	 * Now the 'cwd' may NOT be normalized, at least on some platforms.
	 * For the sake of efficiency, we want a completely normalized cwd at
	 * all times.
	 *
	 * Finally, if retVal is NULL, we do not have a cwd, which could be
	 * problematic.
	 */

	if (retVal != NULL) {
	    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);

	    if (norm != NULL) {
		/*
		 * We found a current working directory, which is now in our
		 * global storage. We must make a copy. Norm already has a
		 * We found a cwd, which is now in our global storage. We must
		 * make a copy. Norm already has a refCount of 1.
		 * refCount of 1.
		 *
		 * Threading issue: Multiple threads at system startup could in
		 * principle call this function simultaneously. They will
		 * therefore each set the cwdPathPtr independently, which is a
		 * bit peculiar, but should be fine. Once we have a cwd, we'll
		 * always be in the 'else' branch below which is simpler.
		 * Threading issue: note that multiple threads at system
		 * startup could in principle call this function
		 * simultaneously. They will therefore each set the cwdPathPtr
		 * independently. That behaviour is a bit peculiar, but should
		 * be fine. Once we have a cwd, we'll always be in the 'else'
		 * branch below which is simpler.
		 */

		void *cd = (void *) Tcl_FSGetNativePath(norm);
		ClientData cd = (ClientData) Tcl_FSGetNativePath(norm);

		FsUpdateCwd(norm, TclNativeDupInternalRep(cd));
		Tcl_DecrRefCount(norm);
	    }
	    Tcl_DecrRefCount(retVal);
	} else {
	    /*
	     * retVal is NULL.  There is no current directory, which could be
	     * problematic.
	    */
	}
    } else {
	/*
	 * There is a thread-local value for the pathname of the current
	 * directory.  Give corresponding filesystem a chance update the value
	 * if it is out-of-date. This allows an error to be thrown if, for
	 * example, the permissions on the current working directory have
	 * We already have a cwd cached, but we want to give the filesystem it
	 * is in a chance to check whether that cwd has changed, or is perhaps
	 * no longer accessible. This allows an error to be thrown if, say,
	 * the permissions on that directory have changed.
	 * changed.
	 */

	const Tcl_Filesystem *fsPtr =
	const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
		Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
	ClientData retCd = NULL;
	Tcl_Obj *retVal, *norm;

	if (fsPtr == NULL || fsPtr->getCwdProc == NULL) {
	    /*
	     * There is no corresponding filesystem or the filesystem does not
	     * have a getCwd routine. Just assume current local value is ok.
	     */
	/*
	 * If the filesystem couldn't be found, or if no cwd function exists
	 * for this filesystem, then we simply assume the cached cwd is ok.
	 * If we do call a cwd, we must watch for errors (if the cwd returns
	 * NULL). This ensures that, say, on Unix if the permissions of the
	 * cwd change, 'pwd' does actually throw the correct error in Tcl.
	 * (This is tested for in the test suite on unix).
	 */
	    goto cdDidNotChange;
	}


	if (fsPtr != NULL) {
	if (fsPtr->version == TCL_FILESYSTEM_VERSION_1) {
	    retVal = fsPtr->getCwdProc(interp);
	    Tcl_FSGetCwdProc *proc = fsPtr->getCwdProc;
	} else {
	    /*
	     * New API.
	     */

	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;
	    ClientData retCd = NULL;
	    if (proc != NULL) {
		Tcl_Obj *retVal;
		if (fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;

	    retCd = proc2(tsdPtr->cwdClientData);
	    if (retCd == NULL && interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error getting working directory name: %s",
			Tcl_PosixError(interp)));
	    }
		    retCd = (*proc2)(tsdPtr->cwdClientData);
		    if (retCd == NULL && interp != NULL) {
			Tcl_AppendResult(interp,
				"error getting working directory name: ",
				Tcl_PosixError(interp), NULL);
		    }

	    if (retCd == tsdPtr->cwdClientData) {
		goto cdDidNotChange;
	    }
		    if (retCd == tsdPtr->cwdClientData) {
			goto cdDidNotChange;
		    }

	    /*
	     * Looks like a new current directory.
	     */
		    /*
		     * Looks like a new current directory.
		     */

	    retVal = fsPtr->internalToNormalizedProc(retCd);
	    Tcl_IncrRefCount(retVal);
		    retVal = (*fsPtr->internalToNormalizedProc)(retCd);
		    Tcl_IncrRefCount(retVal);
	}

	if (retVal == NULL) {
		} else {
		    retVal = (*proc)(interp);
	    /*
	     * The current directory could not not determined.  Reset the
	     * current direcory to ensure, for example, that 'pwd' does actually
	     * throw the correct error in Tcl.  This is tested for in the test
	     * suite on unix.
	     */

		}
	    FsUpdateCwd(NULL, NULL);
	    goto cdDidNotChange;
	}

	norm = TclFSNormalizeAbsolutePath(interp, retVal);
		if (retVal != NULL) {
		    Tcl_Obj *norm = TclFSNormalizeAbsolutePath(interp, retVal);

	if (norm == NULL) {
	     /*
	     * 'norm' shouldn't ever be NULL, but we are careful.
	     */
		    /*
		     * Check whether cwd has changed from the value previously
		     * stored in cwdPathPtr. Really 'norm' shouldn't be NULL,
		     * but we are careful.
		     */

		    if (norm == NULL) {
	    /* Do nothing */
	    if (retCd != NULL) {
		fsPtr->freeInternalRepProc(retCd);
	    }
	} else if (norm == tsdPtr->cwdPathPtr) {
	    goto cdEqual;
	} else {
	     /*
			/* Do nothing */
			if (retCd != NULL) {
			    (*fsPtr->freeInternalRepProc)(retCd);
			}
		    } else if (norm == tsdPtr->cwdPathPtr) {
			goto cdEqual;
		    } else {
			/*
	     * Determine whether the filesystem's answer is the same as the
	     * cached local value.  Since both 'norm' and 'tsdPtr->cwdPathPtr'
	     * are normalized pathnames, do something more efficient than
	     * calling 'Tcl_FSEqualPaths', and in addition avoid a nasty
	     * infinite loop bug when trying to normalize tsdPtr->cwdPathPtr.
	     */
			 * Note that both 'norm' and 'tsdPtr->cwdPathPtr' are
			 * normalized paths. Therefore we can be more
			 * efficient than calling 'Tcl_FSEqualPaths', and in
			 * addition avoid a nasty infinite loop bug when
			 * trying to normalize tsdPtr->cwdPathPtr.
			 */

	    size_t len1, len2;
	    const char *str1, *str2;
			int len1, len2;
			char *str1, *str2;

	    str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
	    str2 = TclGetStringFromObj(norm, &len2);
	    if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
		/*
		 * The pathname values are equal so retain the old pathname
		 * object which is probably already shared and free the
		 * normalized pathname that was just produced.
		 */
	    cdEqual:
		Tcl_DecrRefCount(norm);
		if (retCd != NULL) {
		    fsPtr->freeInternalRepProc(retCd);
		}
	    } else {
			str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
			str2 = Tcl_GetStringFromObj(norm, &len2);
			if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
			    /*
			     * If the paths were equal, we can be more
			     * efficient and retain the old path object which
			     * will probably already be shared. In this case
			     * we can simply free the normalized path we just
			     * calculated.
			     */

			cdEqual:
			    Tcl_DecrRefCount(norm);
			    if (retCd != NULL) {
				(*fsPtr->freeInternalRepProc)(retCd);
			    }
			} else {
		/*
		 * The pathname of the current directory is not the same as
		 * this thread's local cached value.  Replace the local value.
		 */
		FsUpdateCwd(norm, retCd);
		Tcl_DecrRefCount(norm);
	    }
	}
	Tcl_DecrRefCount(retVal);
			    FsUpdateCwd(norm, retCd);
			    Tcl_DecrRefCount(norm);
			}
		    }
		    Tcl_DecrRefCount(retVal);
		} else {
		    /*
		     * The 'cwd' function returned an error; reset the cwd.
		     */

		    FsUpdateCwd(NULL, NULL);
		}
	    }
	}
    }

  cdDidNotChange:
    if (tsdPtr->cwdPathPtr != NULL) {
	Tcl_IncrRefCount(tsdPtr->cwdPathPtr);
    }

    return tsdPtr->cwdPathPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSChdir --
 *
 *	Replaces the library version of chdir().
 *	This function replaces the library version of chdir().
 *
 *	Calls 'chdirProc' of the filesystem that corresponds to the given
 *	pathname.
 *	The path is normalized and then passed to the filesystem which claims
 *	it.
 *
 * Results:
 *	See chdir() documentation.
 *	See chdir() documentation. If successful, we keep a record of the
 *	successful path in cwdPathPtr for subsequent calls to getcwd.
 *
 * Side effects:
 *	See chdir() documentation.
 *	See chdir() documentation. The global cwdPathPtr may change value.
 *
 *	On success stores in cwdPathPtr the pathname of the new current
 *	directory.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSChdir(
    Tcl_Obj *pathPtr)
{
    const Tcl_Filesystem *fsPtr, *oldFsPtr = NULL;
    const Tcl_Filesystem *fsPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
    int retVal = -1;

    if (tsdPtr->cwdPathPtr != NULL) {
	oldFsPtr = Tcl_FSGetFileSystemForPath(tsdPtr->cwdPathPtr);
    }
    if (Tcl_FSGetNormalizedPath(NULL, pathPtr) == NULL) {
	Tcl_SetErrno(ENOENT);
	return retVal;
    }

    fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSChdirProc *proc = fsPtr->chdirProc;
	if (fsPtr->chdirProc != NULL) {
	if (proc != NULL) {
	    /*
	     * If this fails, an appropriate errno will have been stored using
	     * If this fails Tcl_SetErrno() has already been called.
	     * 'Tcl_SetErrno()'.
	     */

	    retVal = fsPtr->chdirProc(pathPtr);
	    retVal = (*proc)(pathPtr);
	} else {
	    /*
	     * Fallback to stat-based implementation.
	     * Fallback on stat-based implementation.
	     */

	    Tcl_StatBuf buf;

	    /*
	     * If the file can be stat'ed and is a directory and is readable,
	     * then we can chdir. If any of these actions fail, then
	     * 'Tcl_SetErrno()' should automatically have been called to set
	     * an appropriate error code
	     */

	    if ((Tcl_FSStat(pathPtr, &buf) == 0) && (S_ISDIR(buf.st_mode))
		    && (Tcl_FSAccess(pathPtr, R_OK) == 0)) {
		/*
		 * stat was successful, and the file is a directory and is
		 * readable.  Can proceed to change the current directory.
		 * We allow the chdir.
		 */

		retVal = 0;
	    } else {
		 /*
		 * 'Tcl_SetErrno()' has already been called.
		 */
	    }
	}
    } else {
	Tcl_SetErrno(ENOENT);
    }

    if (retVal == 0) {

	 /* Assume that the cwd was actually changed to the normalized value
	  * just calculated, and cache that information.  */
    /*
     * The cwd changed, or an error was thrown. If an error was thrown, we can
     * just continue (and that will report the error to the user). If there
     * was no error we must assume that the cwd was actually changed to the
     * normalized value we calculated above, and we must therefore cache that
     * information.
     */

	/*
	 * If the filesystem epoch changed recently, the normalized pathname or
	 * its internal handle may be different from what was found above.
	 * This can easily be the case with scripted documents . Therefore get
	 * the normalized pathname again. The correct value will have been
	 * cached as a result of the Tcl_FSGetFileSystemForPath call, above.
    /*
     * If the filesystem in question has a getCwdProc, then the correct logic
     * which performs the part below is already part of the Tcl_FSGetCwd()
     * call, so no need to replicate it again. This will have a side effect
     * though. The private authoritative representation of the current working
     * directory stored in cwdPathPtr in static memory will be out-of-sync
     * with the real OS-maintained value. The first call to Tcl_FSGetCwd will
     * however recalculate the private copy to match the OS-value so
     * everything will work right.
     *
     * However, if there is no getCwdProc, then we _must_ update our private
     * storage of the cwd, since this is the only opportunity to do that!
     *
     * Note: We currently call this block of code irrespective of whether
     * there was a getCwdProc or not, but the code should all in principle
     * work if we only call this block if fsPtr->getCwdProc == NULL.
     */

    if (retVal == 0) {
	/*
	 * Note that this normalized path may be different to what we found
	 * above (or at least a different object), if the filesystem epoch
	 * changed recently. This can actually happen with scripted documents
	 * very easily. Therefore we ask for the normalized path again (the
	 * correct value will have been cached as a result of the
	 * Tcl_FSGetFileSystemForPath call above anyway).
	 */

	Tcl_Obj *normDirName = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	if (normDirName == NULL) {
	    /* Not really true, but what else to do? */
	    Tcl_SetErrno(ENOENT);
	    return -1;
	}

	if (fsPtr == &tclNativeFilesystem) {
	    /*
	     * For the native filesystem, we keep a cache of the native
	     * representation of the cwd. But, we want to do that for the
	     * exact format that is returned by 'getcwd' (so that we can later
	     * compare the two representations for equality), which might not
	     * be exactly the same char-string as the native representation of
	     * the fully normalized path (e.g. on Windows there's a
	     * forward-slash vs backslash difference). Hence we ask for this
	     * again here. On Unix it might actually be true that we always
	     * have the correct form in the native rep in which case we could
	     * simply use:
	     *		cd = Tcl_FSGetNativePath(pathPtr);
	     * instead. This should be examined by someone on Unix.
	     */

	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
	    ClientData cd;
	    ClientData oldcd = tsdPtr->cwdClientData;

	    /*
	     * Assume that the native filesystem has a getCwdProc and that it
	     * is at version 2.
	     * Assumption we are using a filesystem version 2.
	     */

	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2 *) fsPtr->getCwdProc;

	    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)fsPtr->getCwdProc;
	    cd = (*proc2)(oldcd);
	    cd = proc2(oldcd);
	    if (cd != oldcd) {
		/*
		 * Call getCwdProc() and store the resulting internal handle to
		 * compare things with it later.  This might might not be
		 * exactly the same string as that of the fully normalized
		 * pathname.  For example, for the Windows internal handle the
		 * separator is the backslash character.  On Unix it might well
		 * be true that the internal handle is the fully normalized
		 * pathname and one could simply use:
		 *	cd = Tcl_FSGetNativePath(pathPtr);
		 * but this can't be guaranteed in the general case.  In fact,
		 * the internal handle could be any value the filesystem
		 * decides to use to identify a node.
		 */

		FsUpdateCwd(normDirName, cd);
	    }
	} else {
	    /*
	     * Tcl_FSGetCwd() synchronizes the file-global cwdPathPtr if
	     * needed.  However, if there is no 'getCwdProc', cwdPathPtr must be
	     * updated right now because there won't be another chance.  This
	     * block of code is currently executed whether or not the
	     * filesystem provides a getCwdProc, but it should in principle
	     * work to only call this block if fsPtr->getCwdProc == NULL.
	     */

	    FsUpdateCwd(normDirName, NULL);
	}

	if (oldFsPtr != NULL && fsPtr != oldFsPtr) {
	    /*
	     * The filesystem of the current directory is not the same as the
	     * filesystem of the previous current directory.  Invalidate All
	     * FsPath objects.
	     */
	    Tcl_FSMountsChanged(NULL);
	}
    } else {
	/*
	 * The current directory is now changed or an error occurred and an
	 * error message is now set. Just continue.
	 */
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSLoadFile --
 *
 *	Loads a dynamic shared object by passing the given pathname unmodified
 *	to Tcl_LoadFile, and provides pointers to the functions named by 'sym1'
 *	and 'sym2', and another pointer to a function that unloads the object.
 *	Dynamically loads a binary code file into memory and returns the
 *	addresses of two functions within that file, if they are defined. The
 *	appropriate function for the filesystem to which pathPtr belongs will
 *	be called.
 *
 *	Note that the native filesystem doesn't actually assume 'pathPtr' is a
 *	path. Rather it assumes pathPtr is either a path or just the name
 *	(tail) of a file which can be found somewhere in the environment's
 *	loadable path. This behaviour is not very compatible with virtual
 *	filesystems (and has other problems documented in the load man-page),
 *	so it is advised that full paths are always used.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs, sets the
 *	interpreter's result to an error message.
 *	A standard Tcl completion code. If an error occurs, an error message
 *	is left in the interp's result.
 *
 * Side effects:
 *	A dynamic shared object is loaded into memory.  This may later be
 *	unloaded by passing the handlePtr to *unloadProcPtr.
 *	New code suddenly appears in memory. This may later be unloaded by
 *	passing the clientData to the unloadProc.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSLoadFile(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Pathname of the file containing the dynamic shared object.
				 */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code. */
    const char *sym1, const char *sym2,
				/* Names of two functions to find in the
				 * dynamic shared object. */
				/* Names of two functions to look up in the
				 * file's symbol table. */
    Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
				/* Places to store pointers to the functions
				 * named by sym1 and sym2. */
    Tcl_LoadHandle *handlePtr,	/* A place to store the token for the loaded
				 * object.  Can be passed to
				/* Where to return the addresses corresponding
				 * to sym1 and sym2. */
    Tcl_LoadHandle *handlePtr,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    TCL_UNUSED(Tcl_FSUnloadFileProc **))
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
{
    const char *symbols[3];
    void *procPtrs[2];
    const char *symbols[2];
    Tcl_PackageInitProc **procPtrs[2];
    ClientData clientData;
    int res;

    /*
     * Initialize the arrays.
     */

    symbols[0] = sym1;
    symbols[1] = sym2;
    procPtrs[0] = proc1Ptr;
    procPtrs[1] = proc2Ptr;
    symbols[2] = NULL;

    /*
     * Perform the load.
     */

    res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
    res = TclLoadFile(interp, pathPtr, 2, symbols, procPtrs, handlePtr,
    if (res == TCL_OK) {
	*proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0];
	    &clientData, unloadProcPtr);
	*proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1];
    } else {
	*proc1Ptr = *proc2Ptr = NULL;
    }


    /*
     * Due to an unfortunate mis-design in Tcl 8.4 fs, when loading a shared
     * library, we don't keep the loadHandle (for TclpFindSymbol) and the
     * clientData (for the unloadProc) separately. In fact we effectively
     * throw away the loadHandle and only use the clientData. It just so
     * happens, for the native filesystem only, that these two are identical.
     *
     * This also means that the signatures Tcl_FSUnloadFileProc and
     * Tcl_FSLoadFileProc are both misleading.
     */

    *handlePtr = (Tcl_LoadHandle) clientData;
    return res;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LoadFile --
 * TclLoadFile --
 *
 *	Load a dynamic shared object by calling 'loadFileProc' of the
 *	filesystem corresponding to the given pathname, and then finds within
 *	the loaded object the functions named in symbols[].
 *	Dynamically loads a binary code file into memory and returns the
 *	addresses of a number of given functions within that file, if they are
 *	defined. The appropriate function for the filesystem to which pathPtr
 *	belongs will be called.
 *
 *	The given pathname is passed unmodified to `loadFileProc`, which
 *	decides how to resolve it.  On POSIX systems the native filesystem
 *	passes the given pathname to dlopen(), which resolves the filename
 *	according to its own set of rules.  This behaviour is not very
 *	compatible with virtual filesystems, and has other problems as
 *	documented for [load], so it is recommended to use an absolute
 *	pathname.
 *	Note that the native filesystem doesn't actually assume 'pathPtr' is a
 *	path. Rather it assumes pathPtr is either a path or just the name
 *	(tail) of a file which can be found somewhere in the environment's
 *	loadable path. This behaviour is not very compatible with virtual
 *	filesystems (and has other problems documented in the load man-page),
 *	so it is advised that full paths are always used.
 *
 *	This function is currently private to Tcl. It may be exported in the
 *	future and its interface fixed (but we should clean up the
 *	loadHandle/clientData confusion at that time -- see the above comments
 *	in Tcl_FSLoadFile for details). For a public function, see
 *	Tcl_FSLoadFile.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs, sets the
 *	A standard Tcl completion code. If an error occurs, an error message
 *	interpreter result to an error message.
 *	is left in the interp's result.
 *
 * Side effects:
 *	Memory is allocated for the new object. May be freed by calling
 *	TclFS_UnloadFile.
 *	New code suddenly appears in memory. This may later be unloaded by
 *	passing the clientData to the unloadProc.
 *
 *----------------------------------------------------------------------
 */

typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);

/*
 * Modern HPUX allows the unlink (no ETXTBSY error) yet somehow trashes some
 * internal data structures, preventing any additional dynamic shared objects
 * from getting properly loaded. Only the first is ok.  Work around the issue
 * by not unlinking, i.e., emulating the behaviour of the older HPUX which
 * Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
 * error) yet somehow trash some internal data structures which prevents the
 * second and further shared libraries from getting properly loaded. Only the
 * first is ok. We try to get around the issue by not unlinking,
 * i.e. emulating the behaviour of the older HPUX which denied removal.
 * denied removal.
 *
 * Doing the unlink is also an issue within docker containers, whose AUFS
 * bungles this as well, see
 *     https://github.com/dotcloud/docker/issues/1911
 *
 * For these situations the change below makes the execution of the unlink
 * semi-controllable at runtime.
 *
 *     An AUFS filesystem (if it can be detected) will force avoidance of
 *     unlink. The env variable TCL_TEMPLOAD_NO_UNLINK allows detection of a
 *     users general request (unlink and not.
 *
 * By default the unlink is done (if not in AUFS). However if the variable is
 * present and set to true (any integer > 0) then the unlink is skipped.
 */

static int
skipUnlink(
int
TclSkipUnlink (Tcl_Obj* shlibFile)
    Tcl_Obj *shlibFile)
{
    /*
    /* Order of testing:
     * Unlinking is not performed in the following cases:
     *
     * 1. The operating system is HPUX.
     * 1. On hpux we generally want to skip unlink in general
     *
     * Outside of hpux then:
     * 2.   If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and
     * 2. For a general user request   (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int)
     * set to true (an integer > 0)
     * 3. For general AUFS environment (statfs, if available).
     *
     * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS filesystem can be detected (using statfs, if available).
     *
     * Ad 2: This variable can disable/override the AUFS detection, i.e. for
     * testing if a newer AUFS does not have the bug any more.
     * 
     * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
     *       This part needs proper tests in the configure(.in).
     */


#ifdef hpux
    (void)shlibFile;
    return 1;
#else
    char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
    char* skipstr;

    skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
    if (skipstr && (skipstr[0] != '\0')) {
	return atoi(skipstr);
    }

#ifndef TCL_TEMPLOAD_NO_UNLINK
#ifdef TCL_TEMPLOAD_NO_UNLINK
    (void)shlibFile;
#else
/* At built time TCL_TEMPLOAD_NO_UNLINK can be set manually to control whether
 * this automatic overriding of unlink is included.
 */
#ifndef NO_FSTATFS
    {
	struct statfs fs;
	/*
	 * Have fstatfs. May not have the AUFS super magic ... Indeed our build
	/* Have fstatfs. May not have the AUFS super magic ... Indeed our build
	 * box is too old to have it directly in the headers. Define taken from
	 *     http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
	 *     http://aufs.sourceforge.net/
	 * Better reference will be gladly accepted.
	 * Better reference will be gladly taken.
	 */
#ifndef AUFS_SUPER_MAGIC
/* AUFS_SUPER_MAGIC can disable/override the AUFS detection, i.e. for
 * testing if a newer AUFS does not have the bug any more.
*/
#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
#endif /* AUFS_SUPER_MAGIC */
	if ((statfs(TclGetString(shlibFile), &fs) == 0)
		&& (fs.f_type == AUFS_SUPER_MAGIC)) {
	if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
	    (fs.f_type == AUFS_SUPER_MAGIC)) {
	    return 1;
	}
    }
#endif /* ... NO_FSTATFS */
#endif /* ... TCL_TEMPLOAD_NO_UNLINK */

    /*
     * No HPUX, environment variable override, or AUFS detected.  Perform
     * unlink.
    /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
     * Don't skip */
     */
    return 0;
#endif /* hpux */
}

int
Tcl_LoadFile(
TclLoadFile(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Pathname of the file containing the dynamic
				 * shared object. */
    const char *const symbols[],/* A null-terminated array of names of
				 * functions to find in the loaded object. */
    int flags,			/* Flags */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code. */
    int symc,			/* Number of symbols/procPtrs in the next two
				 * arrays. */
    const char *symbols[],	/* Names of functions to look up in the file's
				 * symbol table. */
    void *procVPtrs,		/* A place to store pointers to the functions
				 *  named by symbols[]. */
    Tcl_LoadHandle *handlePtr)	/* A place to hold a token for the loaded object.
				 * Can be used by TclpFindSymbol. */
    Tcl_PackageInitProc **procPtrs[],
				/* Where to return the addresses corresponding
				 * to symbols[]. */
    Tcl_LoadHandle *handlePtr,	/* Filled with token for shared library
				 * information which can be used in
				 * TclpFindSymbol. */
    ClientData *clientDataPtr,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
{
    void **procPtrs = (void **) procVPtrs;
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    Tcl_FSLoadFileProc *proc;
    const Tcl_Filesystem *copyFsPtr;
    Tcl_Filesystem *copyFsPtr;
    Tcl_FSUnloadFileProc *unloadProcPtr;
    Tcl_Obj *copyToPtr;
    Tcl_LoadHandle newLoadHandle = NULL;
    Tcl_LoadHandle divertedLoadHandle = NULL;
    ClientData newClientData = NULL;
    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
    FsDivertLoad *tvdlPtr;
    int retVal;
    int i;

    if (fsPtr == NULL) {
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }

    if (fsPtr->loadFileProc != NULL) {
	retVal = ((Tcl_FSLoadFileProc2 *)(void *)(fsPtr->loadFileProc))
		(interp, pathPtr, handlePtr, &unloadProcPtr, flags);
    proc = fsPtr->loadFileProc;
    if (proc != NULL) {
	int retVal = ((Tcl_FSLoadFileProc2 *)proc)
		(interp, pathPtr, handlePtr, unloadProcPtr, 0);

	if (retVal == TCL_OK) {
	    if (*handlePtr == NULL) {
		return TCL_ERROR;
	    }
	    if (interp) {

		Tcl_ResetResult(interp);
	    }
	    /*
	     * Copy this across, since both are equal for the native fs.
	     */

	    *clientDataPtr = (ClientData)*handlePtr;
	    Tcl_ResetResult(interp);
	    goto resolveSymbols;
	}
	if (Tcl_GetErrno() != EXDEV) {
	    return retVal;
	}
    }

    /*
     * The filesystem doesn't support 'load'. Fall to the following:
     */

    /*
     * The filesystem doesn't support 'load', so we fall back on the following
     * technique:
     *
     * First check if it is readable -- and exists!
     * Make sure the file is accessible.
     */

    if (Tcl_FSAccess(pathPtr, R_OK) != 0) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't load library \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't load library \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

#ifdef TCL_LOAD_FROM_MEMORY
    /*
     * The platform supports loading a dynamic shared object from memory.
     * Create a sufficiently large buffer, read the file into it, and then load
     * the dynamic shared object from the buffer:
     * The platform supports loading code from memory, so ask for a buffer of
     * the appropriate size, read the file into it and load the code from the
     * buffer:
     */

    {
	int ret, size;
	void *buffer;
	Tcl_StatBuf statBuf;
	Tcl_Channel data;

	ret = Tcl_FSStat(pathPtr, &statBuf);
	if (ret < 0) {
	    goto mustCopyToTempAnyway;
	}
	size = (int) statBuf.st_size;

	/*
	 * Tcl_Read takes an int:  Determine whether the file size is wide.
	 * Tcl_Read takes an int: check that file size isn't wide.
	 */

	if (size != (Tcl_WideInt) statBuf.st_size) {
	    goto mustCopyToTempAnyway;
	}
	data = Tcl_FSOpenFileChannel(interp, pathPtr, "rb", 0666);
	if (!data) {
	    goto mustCopyToTempAnyway;
	}
	buffer = TclpLoadMemoryGetBuffer(interp, size);
	if (!buffer) {
	    Tcl_CloseEx(interp, data, 0);
	    Tcl_Close(interp, data);
	    goto mustCopyToTempAnyway;
	}
	ret = Tcl_Read(data, (char *)buffer, size);
	Tcl_CloseEx(interp, data, 0);
	ret = Tcl_Read(data, buffer, size);
	Tcl_Close(interp, data);
	ret = TclpLoadMemory(interp, buffer, size, ret, handlePtr,
		&unloadProcPtr, flags);
		unloadProcPtr);
	if (ret == TCL_OK && *handlePtr != NULL) {
	    *clientDataPtr = (ClientData) *handlePtr;
	    goto resolveSymbols;
	}
    }

  mustCopyToTempAnyway:
    if (interp) {
	Tcl_ResetResult(interp);
    Tcl_ResetResult(interp);
    }
#endif /* TCL_LOAD_FROM_MEMORY */
#endif

    /*
     * Get a temporary filename, first to copy the file into, and then to load.
     * Get a temporary filename to use, first to copy the file into, and then
     * to load.
     */

    copyToPtr = TclpTempFileNameForLibrary(interp, pathPtr);
    copyToPtr = TclpTempFileName();
    if (copyToPtr == NULL) {
	Tcl_AppendResult(interp, "couldn't create temporary file: ",
		Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(copyToPtr);

    copyFsPtr = Tcl_FSGetFileSystemForPath(copyToPtr);
    if ((copyFsPtr == NULL) || (copyFsPtr == fsPtr)) {
	/*
	 * Tcl_FSLoadFile isn't available for the filesystem of the temporary
	 * file.  In order to avoid a possible infinite loop, do not attempt to
	 * We already know we can't use Tcl_FSLoadFile from this filesystem,
	 * and we must avoid a possible infinite loop. Try to delete the file
	 * load further.
	 */

	 /*
	  * Try to delete the file we probably created and then exit.
	  */
	 * we probably created, and then exit.
	 */

	Tcl_FSDeleteFile(copyToPtr);
	Tcl_DecrRefCount(copyToPtr);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "couldn't load from current filesystem", -1));
	Tcl_AppendResult(interp, "couldn't load from current filesystem",NULL);
	}
	return TCL_ERROR;
    }

    if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) != TCL_OK) {
	/*
	 * Cross-platform copy failed.
	 */

	Tcl_FSDeleteFile(copyToPtr);
	Tcl_DecrRefCount(copyToPtr);
	return TCL_ERROR;
    }

#ifndef _WIN32
#if !defined(__WIN32__)
    /*
     * It might be necessary on some systems to set the appropriate permissions
     * on the file.  On Unix we could loop over the file attributes and set any
     * that are called "-permissions" to 0700, but just do it directly instead:
     * Do we need to set appropriate permissions on the file? This may be
     * required on some systems. On Unix we could loop over the file
     * attributes, and set any that are called "-permissions" to 0700. However
     * we just do this directly, like this:
     */

    {
	int index;
	Tcl_Obj *perm;

	TclNewLiteralStringObj(perm, "0700");
	Tcl_IncrRefCount(perm);
	if (TclFSFileAttrIndex(copyToPtr, "-permissions", &index) == TCL_OK) {
	    Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
	}
	Tcl_DecrRefCount(perm);
    }
#endif

    /*
     * We need to reset the result now, because the cross-filesystem copy may
     * The cross-filesystem copy may have stored the number of bytes in the
     * have stored the number of bytes in the result.
     * result, so reset the result now.
     */

    if (interp) {
	Tcl_ResetResult(interp);
    }
    Tcl_ResetResult(interp);


    retVal = Tcl_LoadFile(interp, copyToPtr, symbols, flags, procPtrs,
	    &newLoadHandle);
    retVal = TclLoadFile(interp, copyToPtr, symc, symbols, procPtrs,
	    &newLoadHandle, &newClientData, &newUnloadProcPtr);
    if (retVal != TCL_OK) {
	/*
	 * The file didn't load successfully.
	 */

	Tcl_FSDeleteFile(copyToPtr);
	Tcl_DecrRefCount(copyToPtr);
	return retVal;
    }

    /*
     * Try to delete the file immediately.  Some operatings systems allow this,
     * and it avoids leaving the copy laying around after exit.
     * Try to delete the file immediately - this is possible in some OSes, and
     * avoids any worries about leaving the copy laying around on exit.
     */

    if (
    if (!skipUnlink(copyToPtr) &&
	    (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
	!TclSkipUnlink (copyToPtr) &&
	(Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
	Tcl_DecrRefCount(copyToPtr);

	/*
	 * We tell our caller about the real shared library which was loaded.
	 * Tell the caller all the details:  The package list maintained by
	 * 'load' stores the original (vfs) pathname, the handle of object
	 * loaded from the temporary file, and the unloadProcPtr.
	 * Note that this does mean that the package list maintained by 'load'
	 * will store the original (vfs) path alongside the temporary load
	 * handle and unload proc ptr.
	 */

	*handlePtr = newLoadHandle;
	(*handlePtr) = newLoadHandle;
	if (interp) {
	    Tcl_ResetResult(interp);
	(*clientDataPtr) = newClientData;
	(*unloadProcPtr) = newUnloadProcPtr;
	Tcl_ResetResult(interp);
	}
	return TCL_OK;
    }

    /*
     * When we unload this file, we need to divert the unloading so we can
     * Divert the unloading in order to unload and cleanup the temporary file.
     * unload and cleanup the temporary file correctly.
     */

    tvdlPtr = (FsDivertLoad *)Tcl_Alloc(sizeof(FsDivertLoad));
    tvdlPtr = (FsDivertLoad *) ckalloc(sizeof(FsDivertLoad));

    /*
     * Remember three pieces of information in order to clean up the diverted
     * load completely on platforms which allow proper unloading of code.
     * Remember three pieces of information. This allows us to cleanup the
     * diverted load completely, on platforms which allow proper unloading of
     * code.
     */

    tvdlPtr->loadHandle = newLoadHandle;
    tvdlPtr->unloadProcPtr = newUnloadProcPtr;

    if (copyFsPtr != &tclNativeFilesystem) {
	/*
	/* refCount of copyToPtr is already incremented.  */
	 * copyToPtr is already incremented for this reference.
	 */

	tvdlPtr->divertedFile = copyToPtr;

	/*
	 * This is the filesystem for the temporary file the object was loaded
	 * from.  A reference to copyToPtr is already stored in
	 * tvdlPtr->divertedFile, so need need to increment the refCount again.
	 * This is the filesystem we loaded it into. Since we have a reference
	 * to 'copyToPtr', we already have a refCount on this filesystem, so
	 * we don't need to worry about it disappearing on us.
	 */

	tvdlPtr->divertedFilesystem = copyFsPtr;
	tvdlPtr->divertedFileNativeRep = NULL;
    } else {
	/*
	 * Grab the native representation.
	 * We need the native rep.
	 */

	tvdlPtr->divertedFileNativeRep = TclNativeDupInternalRep(
		Tcl_FSGetInternalRep(copyToPtr, copyFsPtr));

	/*
	 * Don't keeep a reference to the Tcl_Obj or the native filesystem.
	 * We don't need or want references to the copied Tcl_Obj or the
	 * filesystem if it is the native one.
	 */

	tvdlPtr->divertedFile = NULL;
	tvdlPtr->divertedFilesystem = NULL;
	Tcl_DecrRefCount(copyToPtr);
    }

    copyToPtr = NULL;

    (*handlePtr) = newLoadHandle;
    divertedLoadHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
    divertedLoadHandle->clientData = tvdlPtr;
    divertedLoadHandle->findSymbolProcPtr = DivertFindSymbol;
    (*clientDataPtr) = (ClientData) tvdlPtr;
    (*unloadProcPtr) = TclFSUnloadTempFile;
    divertedLoadHandle->unloadFileProcPtr = DivertUnloadFile;
    *handlePtr = divertedLoadHandle;

    if (interp) {
	Tcl_ResetResult(interp);
    Tcl_ResetResult(interp);
    }
    return retVal;

  resolveSymbols:
    /*
     * handlePtr now contains a token for the loaded object.
     * Resolve the symbols.
     */

    if (symbols != NULL) {
	for (i=0 ; symbols[i] != NULL; i++) {
	    procPtrs[i] = Tcl_FindSymbol(interp, *handlePtr, symbols[i]);
    {
	int i;

	for (i=0 ; i<symc ; i++) {
	    if (symbols[i] != NULL) {
		*procPtrs[i] = TclpFindSymbol(interp, *handlePtr, symbols[i]);
	    if (procPtrs[i] == NULL) {
		/*
		 * At least one symbol in the list was not found.  Unload the
		 * file and return an error code.  Tcl_FindSymbol should have
		 * already left an appropriate error message.
		 */

		(*handlePtr)->unloadFileProcPtr(*handlePtr);
		*handlePtr = NULL;
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *---------------------------------------------------------------------------
 *
 * DivertFindSymbol --
 * TclFSUnloadTempFile --
 *
 *	Find a symbol in a shared library loaded by making a copying a file
 *	from the virtual filesystem to a native filesystem.
 *	This function is called when we loaded a library of code via an
 *	intermediate temporary file. This function ensures the library is
 *	correctly unloaded and the temporary file is correctly deleted.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The effects of the 'unload' function called, and of course the
 *	temporary file will be deleted.
 *
 *----------------------------------------------------------------------
 *---------------------------------------------------------------------------
 */

static void *
DivertFindSymbol(
void
TclFSUnloadTempFile(
    Tcl_Interp *interp, 	/* The relevant interpreter. */
    Tcl_LoadHandle loadHandle,	/* A handle to the diverted module. */
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
    const char *symbol)		/* The name of symbol to resolve. */
				 * Tcl_FSLoadFile(). The loadHandle is a token
				 * that represents the loaded file. */
{
    FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData;
    FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle;
    Tcl_LoadHandle originalHandle = tvdlPtr->loadHandle;

    return originalHandle->findSymbolProcPtr(interp, originalHandle, symbol);
}

/*
    /*
 *----------------------------------------------------------------------
 *
 * DivertUnloadFile --
 *
 *	Unloads an object that was loaded from a temporary file copied from the
     * This test should never trigger, since we give the client data in the
 *	virtual filesystem the native filesystem.
 *
     * function above.
 *----------------------------------------------------------------------
 */
     */

static void
DivertUnloadFile(
    Tcl_LoadHandle loadHandle)	/* A handle for the loaded object. */
{

    FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle->clientData;
    Tcl_LoadHandle originalHandle;

    if (tvdlPtr == NULL) {
	/*
	 * tvdlPtr was provided by Tcl_LoadFile so it should not be NULL here.
	 */

	return;
    }
    originalHandle = tvdlPtr->loadHandle;

    /*
     * Call the real 'unloadfile' proc.  This must be called first so that the
     * shared library is actually unloaded by the OS. Otherwise, the following
     * 'delete' may fail because the shared library is still in use.
     * Call the real 'unloadfile' proc we actually used. It is very important
     * that we call this first, so that the shared library is actually
     * unloaded by the OS. Otherwise, the following 'delete' may well fail
     * because the shared library is still in use.
     */

    originalHandle->unloadFileProcPtr(originalHandle);

    if (tvdlPtr->unloadProcPtr != NULL) {
	(*tvdlPtr->unloadProcPtr)(tvdlPtr->loadHandle);
    }
    /*
     * Determine which filesystem contains the temporary copy of the file.
     */

    if (tvdlPtr->divertedFilesystem == NULL) {
	/*
	 * Use the function for the native filsystem, which works works even at
	 * this late stage.
	 * It was the native filesystem, and we have a special function
	 * available just for this purpose, which we know works even at this
	 * late stage.
	 */

	TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
	NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);

    } else {
	/*
	 * Remove the temporary file.  If encodings have been cleaned up
	 * already, this may crash.
	 * Remove the temporary file we created. Note, we may crash here
	 * because encodings have been taken down already.
	 */

	if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
		!= TCL_OK) {
	    /*
	     * This may have happened because Tcl is exiting, and encodings may
	     * have already been deleted or something else the filesystem
	     * depends on may be gone.
	     * The above may have failed because the filesystem, or something
	     * it depends upon (e.g. encodings) have been taken down because
	     * Tcl is exiting.
	     *
	     * TO DO:  Figure out how to delete this file more robustly, or
	     * give the filesystem the information it needs to delete the file
	     * more robustly.  One problem might be that the filesystem cannot
	     * extract the information it needs from the above pathname object
	     * We may need to work out how to delete this file more robustly
	     * (or give the filesystem the information it needs to delete the
	     * file more robustly).
	     *
	     * In particular, one problem might be that the filesystem cannot
	     * extract the information it needs from the above path object
	     * because Tcl's entire filesystem apparatus (the code in this
	     * file) has been finalized and there is no way to get the native
	     * handle of the file.
	     * file) has been finalized, and it refuses to pass the internal
	     * representation to the filesystem.
	     */
	}

	/*
	 * And free up the allocations. This will also of course remove a
	 * This also decrements the refCount of the Tcl_Filesystem
	 * corresponding to this file. which might cause the filesystem to be
	 * refCount from the Tcl_Filesystem to which this file belongs, which
	 * could then free up the filesystem if we are exiting.
	 * deallocated if Tcl is exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    Tcl_Free(tvdlPtr);
    ckfree((char*)tvdlPtr);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindSymbol --
 *
 *	Find a symbol in a loaded object.
 *
 *	Previously filesystem-specific, but has been made portable by having
 *	TclpDlopen return a structure that includes procedure pointers.
 *
 * Results:
 *	Returns a pointer to the symbol if found.  Otherwise, sets
 *	an error message in the interpreter result and returns NULL.
 *
 *----------------------------------------------------------------------
 */

void *
Tcl_FindSymbol(
    Tcl_Interp *interp,		/* The relevant interpreter. */
    Tcl_LoadHandle loadHandle,	/* A handle for the loaded object. */
    const char *symbol)		/* The name name of the symbol to resolve. */
{
    return loadHandle->findSymbolProcPtr(interp, loadHandle, symbol);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FSUnloadFile --
 *
 *	Unloads a loaded  object if unloading is supported for the object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FSUnloadFile(
    Tcl_Interp *interp,		/* The relevant interpreter. */
    Tcl_LoadHandle handle)	/* A handle for the object to unload. */
{
    if (handle->unloadFileProcPtr == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cannot unload: filesystem does not support unloading",
		    -1));
	}
	return TCL_ERROR;
    }
    if (handle->unloadFileProcPtr != NULL) {
	handle->unloadFileProcPtr(handle);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSUnloadTempFile --
 *
 *	Unloads an object loaded via temporary file from a virtual filesystem
 *	to a native filesystem.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees resources for the loaded object and deletes the temporary file.
 *
 *----------------------------------------------------------------------
 */

void
TclFSUnloadTempFile(
    Tcl_LoadHandle loadHandle)	/* A handle for the object, as provided by a
				 *  previous call to Tcl_FSLoadFile(). */
{
    FsDivertLoad *tvdlPtr = (FsDivertLoad *) loadHandle;

    if (tvdlPtr == NULL) {
	/*
	 * tvdlPtr was provided by Tcl_LoadFile so it should not be NULL here.
	 */
	return;
    }

    if (tvdlPtr->unloadProcPtr != NULL) {
	/*
	 * 'unloadProcPtr' must be called first so that the shared library is
	 * actually unloaded by the OS. Otherwise, the following 'delete' may
	 * well fail because the shared library is still in use.
	 */

	tvdlPtr->unloadProcPtr(tvdlPtr->loadHandle);
    }

    if (tvdlPtr->divertedFilesystem == NULL) {
	/*
	 * Call the function for the native fileystem, which works even at this
	 * late stage.
	 */

	TclpDeleteFile(tvdlPtr->divertedFileNativeRep);
	NativeFreeInternalRep(tvdlPtr->divertedFileNativeRep);
    } else {
	/*
	 * Remove the temporary file that was created.  If encodings have
	 * already been freed because the interpreter is exiting this may
	 * crash.
	 */

	if (tvdlPtr->divertedFilesystem->deleteFileProc(tvdlPtr->divertedFile)
		!= TCL_OK) {
	    /*
	     * This may have happened because Tcl is exiting and encodings may
	     * have already been deleted, or something else the filesystem
	     * depends on may be gone.
	     *
	     * TO DO:  Figure out how to delete this file more robustly, or
	     * give the filesystem the information it needs to delete the file
	     * more robustly.  One problem might be that the filesystem cannot
	     * extract the information it needs from the above pathname object
	     * because Tcl's entire filesystem apparatus (the code in this
	     * file) has been finalized and there is no way to get the native
	     * handle of the file.
	     */
	}

	/*
	 * This also decrements the refCount of the Tcl_Filesystem
	 * corresponding to this file. which might case filesystem to be freed
	 * if Tcl is exiting.
	 */

	Tcl_DecrRefCount(tvdlPtr->divertedFile);
    }

    Tcl_Free(tvdlPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSLink --
 *
 *	Creates or inspects a link by calling 'linkProc' of the filesystem
 *	corresponding to the given pathname.  Replaces the library version of
 *	readlink().
 *	This function replaces the library version of readlink() and can also
 *	be used to make links. The appropriate function for the filesystem to
 *	which pathPtr belongs will be called.
 *
 * Results:
 *	If toPtr is NULL, a Tcl_Obj containing the value the symbolic link for
 *	'pathPtr', or NULL if a symbolic link was not accessible.  The caller
 *	should Tcl_DecrRefCount on the result to release it.  Otherwise NULL.
 *	If toPtr is NULL, then the result is a Tcl_Obj specifying the contents
 *	of the symbolic link given by 'pathPtr', or NULL if the symbolic link
 *	could not be read. The result is owned by the caller, which should
 *	call Tcl_DecrRefCount when the result is no longer needed.
 *
 *	If toPtr is non-NULL, then the result is toPtr if the link action was
 *	In this case the result has no additional reference count and need not
 *	be freed. The actual action to perform is given by the 'linkAction'
 *	flags, which is a combination of:
 *	successful, or NULL if not. In this case the result has no additional
 *	reference count, and need not be freed. The actual action to perform
 *	is given by the 'linkAction' flags, which is an or'd combination of:
 *
 *		TCL_CREATE_SYMBOLIC_LINK
 *		TCL_CREATE_HARD_LINK
 *
 *	Most filesystems do not support linking across to different
 *	filesystems, so this function usually fails if the filesystem
 *	Note that most filesystems will not support linking across to
 *	different filesystems, so this function will usually fail unless toPtr
 *	corresponding to toPtr is not the same as the filesystem corresponding
 *	to pathPtr.
 *	is in the same FS as pathPtr.
 *
 * Side effects:
 *	Creates or sets a link if toPtr is not NULL.
 *
 *	See readlink().
 *	See readlink() documentation. A new filesystem link object may appear.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSLink(
    Tcl_Obj *pathPtr,		/* Pathaname of file. */
    Tcl_Obj *toPtr,		/*
    Tcl_Obj *pathPtr,		/* Path of file to readlink or link */
    Tcl_Obj *toPtr,		/* NULL or path to be linked to */
				 * NULL or the pathname of a file to link to.
				 */
    int linkAction)		/* Action to perform. */
    int linkAction)		/* Action to perform */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->linkProc != NULL) {
	return fsPtr->linkProc(pathPtr, toPtr, linkAction);
    if (fsPtr != NULL) {
	Tcl_FSLinkProc *proc = fsPtr->linkProc;

	if (proc != NULL) {
	    return (*proc)(pathPtr, toPtr, linkAction);
	}
    }

    /*
     * If S_IFLNK isn't defined the machine doesn't support symbolic links, so
     * the file can't possibly be a symbolic link. Generate an EINVAL error,
     * which is what happens on machines that do support symbolic links when
     * readlink is called for a file that isn't a symbolic link.
     * If S_IFLNK isn't defined it means that the machine doesn't support
     * symbolic links, so the file can't possibly be a symbolic link. Generate
     * an EINVAL error, which is what happens on machines that do support
     * symbolic links when you invoke readlink on a file that isn't a symbolic
     * link.
     */

#ifndef S_IFLNK
    errno = EINVAL; /* TODO: Change to Tcl_SetErrno()? */
    errno = EINVAL;
#else
    Tcl_SetErrno(ENOENT);
#endif /* S_IFLNK */
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSListVolumes --
 *
 *	Lists the currently mounted volumes by calling `listVolumesProc` of
 *	each registered filesystem, and combining the results to form a list of
 *	volumes.
 *	Lists the currently mounted volumes. The chain of functions that have
 *	been "inserted" into the filesystem will be called in succession; each
 *	may return a list of volumes, all of which are added to the result
 *	until all mounted file systems are listed.
 *
 *	Notice that we assume the lists returned by each filesystem (if non
 *	NULL) have been given a refCount for us already. However, we are NOT
 *	allowed to hang on to the list itself (it belongs to the filesystem we
 *	called). Therefore we quite naturally add its contents to the result
 *	we are building, and then decrement the refCount.
 *
 * Results:
 *	The list of volumes, in an object which has refCount 0.
 *
 * Side effects:
 *	None
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_Obj*
Tcl_FSListVolumes(void)
{
    FilesystemRecord *fsRecPtr;
    Tcl_Obj *resultPtr;
    Tcl_Obj *resultPtr = Tcl_NewObj();

    /*
     * Call each "listVolumes" function of each registered filesystem in
     * succession. A non-NULL return value indicates the particular function
     * has succeeded.
     * Call each of the "listVolumes" function in succession. A non-NULL
     * return value indicates the particular function has succeeded. We call
     * all the functions registered, since we want a list of all drives from
     * all filesystems.
     */

    TclNewObj(resultPtr);
    fsRecPtr = FsGetFirstFilesystem();
    Claim();
    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr->listVolumesProc != NULL) {
	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
	if (proc != NULL) {
	    Tcl_Obj *thisFsVolumes = (*proc)();

	    if (thisFsVolumes != NULL) {
		Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
		/* The refCount of each list returned by a `listVolumesProc` is
		 * already incremented.  Do not hang onto the list, though.  It
		 * belongs to the filesystem.  Add its contents to * the result
		 * we are building, and then decrement the refCount.  */
		Tcl_DecrRefCount(thisFsVolumes);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * FsListMounts --
 *
 *	Lists the mounts mathing the given pattern in the given directory.
 *	List all mounts within the given directory, which match the given
 *	pattern.
 *
 * Results:
 *	A list, having a refCount of 0, of the matching mounts, or NULL if no
 *	search was performed because no filesystem provided a search routine.
 *	The list of mounts, in a list object which has refCount 0, or NULL if
 *	we didn't even find any filesystems to try to list mounts.
 *
 * Side effects:
 *	None.
 *	None
 *
 *---------------------------------------------------------------------------
 */

static Tcl_Obj *
FsListMounts(
    Tcl_Obj *pathPtr,		/* Pathname of directory to search. */
    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
    const char *pattern)	/* Pattern to match against. */
{
    FilesystemRecord *fsRecPtr;
    Tcl_GlobTypeData mountsOnly = { TCL_GLOB_TYPE_MOUNT, 0, NULL, NULL };
    Tcl_Obj *resultPtr = NULL;

    /*
     * Call the matchInDirectory function of each registered filesystem,
     * passing it 'mountsOnly'.  Results accumulate in resultPtr.
     * Call each of the "matchInDirectory" functions in succession, with the
     * specific type information 'mountsOnly'. A non-NULL return value
     * indicates the particular function has succeeded. We call all the
     * functions registered, since we want a list from each filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();
    Claim();
    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr != &tclNativeFilesystem &&
		fsRecPtr->fsPtr->matchInDirectoryProc != NULL) {
	    if (resultPtr == NULL) {
		TclNewObj(resultPtr);
	    }
	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	    Tcl_FSMatchInDirectoryProc *proc =
		    fsRecPtr->fsPtr->matchInDirectoryProc;
	    if (proc != NULL) {
		if (resultPtr == NULL) {
		    resultPtr = Tcl_NewObj();
		}
	    fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr,
		    pattern, &mountsOnly);
		(*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSSplitPath --
 *
 *	Splits a pathname into its components.
 *	This function takes the given Tcl_Obj, which should be a valid path,
 *	and returns a Tcl List object containing each segment of that path as
 *	an element.
 *
 * Results:
 *	A list with refCount of zero.
 *	Returns list object with refCount of zero. If the passed in lenPtr is
 *	non-NULL, we use it to return the number of elements in the returned
 *	list.
 *
 * Side effects:
 *	If lenPtr is not null, sets it to the number of elements in the result.
 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSSplitPath(
    Tcl_Obj *pathPtr,		/* The pathname to split. */
    Tcl_Obj *pathPtr,		/* Path to split. */
    int *lenPtr)		/* A place to hold the number of pathname
				 * elements. */
    int *lenPtr)		/* int to store number of path elements. */
{
    Tcl_Obj *result = NULL;	/* Just to squelch gcc warnings. */
    const Tcl_Filesystem *fsPtr;
    Tcl_Obj *result = NULL;	/* Needed only to prevent gcc warnings. */
    Tcl_Filesystem *fsPtr;
    char separator = '/';
    int driveNameLength;
    const char *p;
    char *p;

    /*
     * Perform platform-specific splitting.
     * Perform platform specific splitting.
     */

    if (TclFSGetPathType(pathPtr, &fsPtr,
	    &driveNameLength) == TCL_PATH_ABSOLUTE) {
	if (fsPtr == &tclNativeFilesystem) {
	    return TclpNativeSplitPath(pathPtr, lenPtr);
	}
    } else {
	return TclpNativeSplitPath(pathPtr, lenPtr);
    }

    /*
    /* Assume each separator is a single character. */
     * We assume separators are single characters.
     */

    if (fsPtr->filesystemSeparatorProc != NULL) {
	Tcl_Obj *sep = fsPtr->filesystemSeparatorProc(pathPtr);
	Tcl_Obj *sep = (*fsPtr->filesystemSeparatorProc)(pathPtr);

	if (sep != NULL) {
	    Tcl_IncrRefCount(sep);
	    separator = TclGetString(sep)[0];
	    separator = Tcl_GetString(sep)[0];
	    Tcl_DecrRefCount(sep);
	}
    }

    /*
     * Add the drive name as first element of the result. The drive name may
     * contain strange characters like colons and sequences of forward slashes
     * For example, 'ftp://' is a valid drive name.
     * Place the drive name as first element of the result list. The drive
     * name may contain strange characters, like colons and multiple forward
     * slashes (for example 'ftp://' is a valid vfs drive name)
     */

    TclNewObj(result);
    p = TclGetString(pathPtr);
    result = Tcl_NewObj();
    p = Tcl_GetString(pathPtr);
    Tcl_ListObjAppendElement(NULL, result,
	    Tcl_NewStringObj(p, driveNameLength));
    p += driveNameLength;

    /*
     * Add the remaining pathname elements to the list.
     * Add the remaining path elements to the list.
     */

    for (;;) {
	const char *elementStart = p;
	char *elementStart = p;
	int length;

	while ((*p != '\0') && (*p != separator)) {
	    p++;
	}
	length = p - elementStart;
	if (length > 0) {
	    Tcl_Obj *nextElt;

	    if (elementStart[0] == '~') {
		TclNewLiteralStringObj(nextElt, "./");
		Tcl_AppendToObj(nextElt, elementStart, length);
	    } else {
		nextElt = Tcl_NewStringObj(elementStart, length);
	    }
	    Tcl_ListObjAppendElement(NULL, result, nextElt);
	}
	if (*p++ == '\0') {
	    break;
	}
    }

    /*
     * Compute the number of elements in the result.
     */

    if (lenPtr != NULL) {
	TclListObjLength(NULL, result, lenPtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetPathType --
 *
 *	Helper function used by TclFSGetPathType and TclJoinPath.
 *	Helper function used by FSGetPathType.
 *
 * Results:
 *	One of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *	TCL_PATH_VOLUME_RELATIVE.
 *	Returns one of TCL_PATH_ABSOLUTE, TCL_PATH_RELATIVE, or
 *	TCL_PATH_VOLUME_RELATIVE. The filesystem reference will be set if and
 *	only if it is non-NULL and the function's return value is
 *	TCL_PATH_ABSOLUTE.
 *
 * Side effects:
 *	See **filesystemPtrptr, *driveNameLengthPtr and **driveNameRef,
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclGetPathType(
    Tcl_Obj *pathPtr,		/* Pathname to determine type of. */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If not NULL, a place in which to store a
				 * pointer to the filesystem for this pathname
				 * if it is absolute. */
    int *driveNameLengthPtr,	/* If not NULL, a place in which to store the
				 * length of the volume name. */
    Tcl_Obj **driveNameRef)	/* If not NULL, for an absolute pathname, a
    Tcl_Obj *pathPtr,		/* Path to determine type for */
    Tcl_Filesystem **filesystemPtrPtr,
				/* If absolute path and this is not NULL, then
				 * set to the filesystem which claims this
				 * path. */
    int *driveNameLengthPtr,	/* If the path is absolute, and this is
				 * non-NULL, then set to the length of the
				 * driveName. */
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is
				 * place to store a pointer to an object with a
				 * refCount of 1, and whose value is the name
				 * of the volume. */
				 * non-NULL, then set to the name of the
				 * drive, network-volume which contains the
				 * path, already with a refCount for the
				 * caller. */
{
    size_t pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    int pathLen;
    char *path;
    Tcl_PathType type;

    path = Tcl_GetStringFromObj(pathPtr, &pathLen);

    type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
	    driveNameLengthPtr, driveNameRef);

    if (type != TCL_PATH_ABSOLUTE) {
	type = TclpGetNativePathType(pathPtr, driveNameLengthPtr,
		driveNameRef);
	if ((type == TCL_PATH_ABSOLUTE) && (filesystemPtrPtr != NULL)) {
	    *filesystemPtrPtr = &tclNativeFilesystem;
	}
    }
    return type;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFSNonnativePathType --
 *
 *	Helper function used by TclGetPathType. Checks whether the given
 *	pathname starts with a string which corresponds to a file volume in
 *	some registered filesystem other than the native one.  For speed and
 *	historical reasons the native filesystem has special hard-coded checks
 *	dotted here and there in the filesystem code.
 *	Helper function used by TclGetPathType. Its purpose is to check
 *	whether the given path starts with a string which corresponds to a
 *	file volume in any registered filesystem except the native one. For
 *	speed and historical reasons the native filesystem has special
 *	hard-coded checks dotted here and there in the filesystem code.
 *
 * Results:
 *	One of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE.  The filesystem
 *	Returns one of TCL_PATH_ABSOLUTE or TCL_PATH_RELATIVE. The filesystem
 *	reference will be set if and only if it is non-NULL and the function's
 *	return value is TCL_PATH_ABSOLUTE.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSNonnativePathType(
    const char *path,		/* Pathname to determine the type of. */
    int pathLen,		/* Length of the pathname. */
    const Tcl_Filesystem **filesystemPtrPtr,
				/* If not NULL, a  place to store a pointer to
				 * the filesystem for this pathname when it is
				 * an absolute pathname. */
    int *driveNameLengthPtr,	/* If not NULL, a place to store the length of
				 * the volume name if the pathname is absolute.
				 */
    Tcl_Obj **driveNameRef)	/* If not NULL, a place to store a pointer to
    const char *path,		/* Path to determine type for */
    int pathLen,		/* Length of the path */
    Tcl_Filesystem **filesystemPtrPtr,
				/* If absolute path and this is not NULL, then
				 * set to the filesystem which claims this
				 * path. */
    int *driveNameLengthPtr,	/* If the path is absolute, and this is
				 * non-NULL, then set to the length of the
				 * driveName. */
    Tcl_Obj **driveNameRef)	/* If the path is absolute, and this is
				 * an object having its its refCount already
				 * incremented, and contining the name of the
				 * volume if the pathname is absolute. */
				 * non-NULL, then set to the name of the
				 * drive, network-volume which contains the
				 * path, already with a refCount for the
				 * caller. */
{
    FilesystemRecord *fsRecPtr;
    Tcl_PathType type = TCL_PATH_RELATIVE;

    /*
     * Call each of the "listVolumes" function in succession, checking whether
     * Determine whether the given pathname is an absolute pathname on some
     * filesystem other than the native filesystem.
     * the given path is an absolute path on any of the volumes returned (this
     * is done by checking whether the path's prefix matches).
     */

    fsRecPtr = FsGetFirstFilesystem();
    Claim();
    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;

	/*
	 * Skip the the native filesystem because otherwise some of the tests
	 * in the Tcl testsuite might fail because some of the tests
	 * artificially change the current platform (between win, unix) but the
	 * We want to skip the native filesystem in this loop because
	 * otherwise we won't necessarily pass all the Tcl testsuite -- this
	 * is because some of the tests artificially change the current
	 * platform (between win, unix) but the list of volumes we get by
	 * list of volumes obtained by calling fsRecPtr->fsPtr->listVolumesProc
	 * reflects the current (real) platform only. In particular, on Unix
	 * '/' matchs the beginning of certain absolute Windows pathnames
	 * starting '//' and those tests go wrong.
	 * calling (*proc) will reflect the current (real) platform only and
	 * this may cause some tests to fail. In particular, on unix '/' will
	 * match the beginning of certain absolute Windows paths starting '//'
	 * and those tests will go wrong.
	 *
	 * Besides these test-suite issues, there is one other reason to skip
	 * There is another reason to skip the native filesystem:  Since the
	 * tclFilename.c code has nice fast 'absolute path' checkers, there is
	 * no reason to waste time doing that in this frequently-called
	 * function.  It is better to save the overhead of the native
	 * filesystem continuously returning a list of volumes.
	 * the native filesystem --- since the tclFilename.c code has nice
	 * fast 'absolute path' checkers, we don't want to waste time
	 * repeating that effort here, and this function is actually called
	 * quite often, so if we can save the overhead of the native
	 * filesystem returning us a list of volumes all the time, it is
	 * better.
	 */

	if ((fsRecPtr->fsPtr != &tclNativeFilesystem)
	if ((fsRecPtr->fsPtr != &tclNativeFilesystem) && (proc != NULL)) {
		&& (fsRecPtr->fsPtr->listVolumesProc != NULL)) {
	    int numVolumes;
	    Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc();
	    Tcl_Obj *thisFsVolumes = (*proc)();

	    if (thisFsVolumes != NULL) {
		if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes)
			!= TCL_OK) {
		    /*
		     * This is VERY bad; the listVolumesProc didn't return a
		     * valid list. Set numVolumes to -1 to skip the loop below
		     * and just return with the current value of 'type'.
		     * This is VERY bad; the Tcl_FSListVolumesProc didn't
		     * return a valid list. Set numVolumes to -1 so that we
		     * skip the while loop below and just return with the
		     * current value of 'type'.
		     *
		     * It would be better to signal an error here, but
		     * Tcl_Panic seems a bit excessive.
		     * It would be better if we could signal an error here
		     * (but Tcl_Panic seems a bit excessive).
		     */

		    numVolumes = -1;
		}
		while (numVolumes > 0) {
		    Tcl_Obj *vol;
		    size_t len;
		    const char *strVol;
		    int len;
		    char *strVol;

		    numVolumes--;
		    Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
		    strVol = TclGetStringFromObj(vol,&len);
		    if ((size_t) pathLen < len) {
		    strVol = Tcl_GetStringFromObj(vol,&len);
		    if (pathLen < len) {
			continue;
		    }
		    if (strncmp(strVol, path, len) == 0) {
		    if (strncmp(strVol, path, (size_t) len) == 0) {
			type = TCL_PATH_ABSOLUTE;
			if (filesystemPtrPtr != NULL) {
			    *filesystemPtrPtr = fsRecPtr->fsPtr;
			}
			if (driveNameLengthPtr != NULL) {
			    *driveNameLengthPtr = len;
			}
			if (driveNameRef != NULL) {
			    *driveNameRef = vol;
			    Tcl_IncrRefCount(vol);
			}
			break;
		    }
		}
		Tcl_DecrRefCount(thisFsVolumes);
		if (type == TCL_PATH_ABSOLUTE) {
		    /*
		     * No need to to examine additional filesystems.
		     * We don't need to examine any more filesystems.
		     */

		    break;
		}
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();
    return type;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --
 *
 *	If the two pathnames correspond to the same filesystem, call
 *	'renameFileProc' of that filesystem.  Otherwise return the POSIX error
 *	'EXDEV', and -1.
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystems rename function. Otherwise we simply return the POSIX
 *	error 'EXDEV', and -1.
 *
 * Results:
 *	A standard Tcl error code if a rename function was called, or -1
 *	Standard Tcl error code if a function was called.
 *	otherwise.
 *
 * Side effects:
 *	A file may be renamed.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSRenameFile(
    Tcl_Obj *srcPathPtr,	/* The pathname of a file or directory to be
				   renamed. */
    Tcl_Obj *destPathPtr)	/* The new pathname for the file. */
    Tcl_Obj* srcPathPtr,	/* Pathname of file or dir to be renamed
				 * (UTF-8). */
    Tcl_Obj *destPathPtr)	/* New pathname of file or directory
				 * (UTF-8). */
{
    int retVal = -1;
    const Tcl_Filesystem *fsPtr, *fsPtr2;

    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if ((fsPtr == fsPtr2) && (fsPtr != NULL)
	    && (fsPtr->renameFileProc != NULL)) {
	retVal = fsPtr->renameFileProc(srcPathPtr, destPathPtr);
    if ((fsPtr == fsPtr2) && (fsPtr != NULL)) {
	Tcl_FSRenameFileProc *proc = fsPtr->renameFileProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyFile --
 *
 *	If both pathnames correspond to the same filesystem, calls
 *	'copyFileProc' of that filesystem.
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystem's copy function. Otherwise we simply return the POSIX error
 *	'EXDEV', and -1.
 *
 *	In the native filesystems, 'copyFileProc' copies a link itself, not the
 *	thing the link points to.
 *	Note that in the native filesystems, 'copyFileProc' is defined to copy
 *	soft links (i.e. it copies the links themselves, not the things they
 *	point to).
 *
 * Results:
 *	A standard Tcl return code if a copyFileProc was called, or -1
 *	Standard Tcl error code if a function was called.
 *	otherwise.
 *
 * Side effects:
 *	A file might be copied.  The POSIX error 'EXDEV' is set if a copy
 *	A file may be copied.
 *	function was not called.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCopyFile(
    Tcl_Obj *srcPathPtr,	/* The pathname of file to be copied. */
    Tcl_Obj *destPathPtr)	/* The new pathname to copy the file to. */
    Tcl_Obj *srcPathPtr,	/* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *destPathPtr)	/* Pathname of file to copy to (UTF-8). */
{
    int retVal = -1;
    const Tcl_Filesystem *fsPtr, *fsPtr2;

    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyFileProc != NULL) {
	retVal = fsPtr->copyFileProc(srcPathPtr, destPathPtr);
    if (fsPtr == fsPtr2 && fsPtr != NULL) {
	Tcl_FSCopyFileProc *proc = fsPtr->copyFileProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclCrossFilesystemCopy --
 *
 *	Helper for Tcl_FSCopyFile and Tcl_FSLoadFile.  Copies a file from one
 *	filesystem to another, overwiting any file that already exists.
 *	Helper for above function, and for Tcl_FSLoadFile, to copy files from
 *	one filesystem to another. This function will overwrite the target
 *	file if it already exists.
 *
 * Results:
 *	A standard Tcl return code.
 *	Standard Tcl error code.
 *
 * Side effects:
 *	A file may be copied.
 *	A file may be created.
 *
 *---------------------------------------------------------------------------
 */

int
TclCrossFilesystemCopy(
    Tcl_Interp *interp,		/* For error messages. */
    Tcl_Obj *source,		/* Pathname of file to be copied. */
    Tcl_Obj *target)		/* Pathname to copy the file to. */
    Tcl_Interp *interp,		/* For error messages */
    Tcl_Obj *source,		/* Pathname of file to be copied (UTF-8). */
    Tcl_Obj *target)		/* Pathname of file to copy to (UTF-8). */
{
    int result = TCL_ERROR;
    int prot = 0666;
    Tcl_Channel in, out;
    Tcl_StatBuf sourceStatBuf;
    struct utimbuf tval;

    out = Tcl_FSOpenFileChannel(interp, target, "wb", prot);
    if (out == NULL) {
	/*
	 * Failed to open an output channel.  Bail out.
	 * It looks like we cannot copy it over. Bail out...
	 */
	goto done;
    }

    in = Tcl_FSOpenFileChannel(interp, source, "rb", prot);
    if (in == NULL) {
	/*
	 * Could not open an input channel.  Why didn't the caller check this?
	 * This is very strange, caller should have checked this...
	 */

	Tcl_CloseEx(interp, out, 0);
	Tcl_Close(interp, out);
	goto done;
    }

    /*
     * Copy the file synchronously.  TO DO:  Maybe add an asynchronous option
     * to support virtual filesystems that are slow (e.g. network sockets).
     * Copy it synchronously. We might wish to add an asynchronous option to
     * support vfs's which are slow (e.g. network sockets).
     */

    if (TclCopyChannel(interp, in, out, -1, NULL) == TCL_OK) {
	result = TCL_OK;
    }

    /*
     * If the copy failed, assume that copy channel left an error message.
     * If the copy failed, assume that copy channel left a good error message.
     */

    Tcl_CloseEx(interp, in, 0);
    Tcl_CloseEx(interp, out, 0);
    Tcl_Close(interp, in);
    Tcl_Close(interp, out);

    /*
     * Set modification date of copied file.
     */

    if (Tcl_FSLstat(source, &sourceStatBuf) == 0) {
	tval.actime = Tcl_GetAccessTimeFromStat(&sourceStatBuf);
	tval.modtime = Tcl_GetModificationTimeFromStat(&sourceStatBuf);
	tval.actime = sourceStatBuf.st_atime;
	tval.modtime = sourceStatBuf.st_mtime;
	Tcl_FSUtime(target, &tval);
    }

  done:
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSDeleteFile --
 *
 *	Calls 'deleteFileProc' of the filesystem corresponding to the given
 *	pathname.
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.
 *
 * Results:
 *	A standard Tcl return code.
 *	Standard Tcl error code.
 *
 * Side effects:
 *	A file may be deleted.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSDeleteFile(
    Tcl_Obj *pathPtr)		/* Pathname of file to be removed (UTF-8). */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->deleteFileProc != NULL) {
	return fsPtr->deleteFileProc(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSDeleteFileProc *proc = fsPtr->deleteFileProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCreateDirectory --
 *
 *	Calls 'createDirectoryProc' of the filesystem corresponding to the
 *	given pathname.
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.
 *
 * Results:
 *	A standard Tcl return code, or -1 if no createDirectoryProc is found.
 *	Standard Tcl error code.
 *
 * Side effects:
 *	A directory may be created.  POSIX error 'ENOENT' is set if no
 *	A directory may be created.
 *	createDirectoryProc is found.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCreateDirectory(
    Tcl_Obj *pathPtr)		/* Pathname of directory to create (UTF-8). */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr != NULL && fsPtr->createDirectoryProc != NULL) {
	return fsPtr->createDirectoryProc(pathPtr);
    if (fsPtr != NULL) {
	Tcl_FSCreateDirectoryProc *proc = fsPtr->createDirectoryProc;
	if (proc != NULL) {
	    return (*proc)(pathPtr);
	}
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSCopyDirectory --
 *
 *	If both pathnames correspond to the the same filesystem, calls
 *	'copyDirectoryProc' of that filesystem.
 *	If the two paths given belong to the same filesystem, we call that
 *	filesystems copy-directory function. Otherwise we simply return the
 *	POSIX error 'EXDEV', and -1.
 *
 * Results:
 *	A standard Tcl return code, or -1 if no 'copyDirectoryProc' is found.
 *	Standard Tcl error code if a function was called.
 *
 * Side effects:
 *	A directory may be copied. POSIX error 'EXDEV' is set if no
 *	A directory may be copied.
 *	copyDirectoryProc is found.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSCopyDirectory(
    Tcl_Obj *srcPathPtr,	/*
				 * The pathname of the directory to be copied.
				 */
    Tcl_Obj *destPathPtr,	/* The pathname of the target directory. */
    Tcl_Obj **errorPtr)		/* If not NULL, and there is an error, a place
    Tcl_Obj* srcPathPtr,	/* Pathname of directory to be copied
				 * (UTF-8). */
    Tcl_Obj *destPathPtr,	/* Pathname of target directory (UTF-8). */
    Tcl_Obj **errorPtr)		/* If non-NULL, then will be set to a new
				 *  to store a pointer to a new object, with
				 *  its refCount already incremented, and
				 *  containing the pathname name of file
				 *  causing the error. */
				 * object containing name of file causing
				 * error, with refCount 1. */
{
    int retVal = -1;
    const Tcl_Filesystem *fsPtr, *fsPtr2;

    fsPtr = Tcl_FSGetFileSystemForPath(srcPathPtr);
    fsPtr2 = Tcl_FSGetFileSystemForPath(destPathPtr);

    if (fsPtr == fsPtr2 && fsPtr != NULL && fsPtr->copyDirectoryProc != NULL){
	retVal = fsPtr->copyDirectoryProc(srcPathPtr, destPathPtr, errorPtr);
    if (fsPtr == fsPtr2 && fsPtr != NULL) {
	Tcl_FSCopyDirectoryProc *proc = fsPtr->copyDirectoryProc;
	if (proc != NULL) {
	    retVal = (*proc)(srcPathPtr, destPathPtr, errorPtr);
	}
    }
    if (retVal == -1) {
	Tcl_SetErrno(EXDEV);
    }
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRemoveDirectory --
 *
 *	Calls 'removeDirectoryProc' of the filesystem corresponding to remove
 *	pathPtr.
 *	The appropriate function for the filesystem to which pathPtr belongs
 *	will be called.
 *
 * Results:
 *	A standard Tcl return code, or -1 if no removeDirectoryProc is found.
 *	Standard Tcl error code.
 *
 * Side effects:
 *	A directory may be removed.  POSIX error 'ENOENT' is set if no
 *	A directory may be deleted.
 *	removeDirectoryProc is found.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_FSRemoveDirectory(
    Tcl_Obj *pathPtr,		/* The pathname of the directory to be removed.
                                 */
    int recursive,		/* If zero, removes only an empty directory.
				 * Otherwise, removes the directory and all its
				 * contents.  */
    Tcl_Obj **errorPtr)		/* If not NULL and an error occurs, stores a
    Tcl_Obj *pathPtr,		/* Pathname of directory to be removed
				 * (UTF-8). */
    int recursive,		/* If non-zero, removes directories that are
				 * nonempty. Otherwise, will only remove empty
				 * directories. */
    Tcl_Obj **errorPtr)		/* If non-NULL, then will be set to a new
				 * place to store a a pointer to a new
				 * object having a refCount of 1 and containing
				 * the name of the file that produced an error.
				 * object containing name of file causing
				 * error, with refCount 1. */
				 * */
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr == NULL || fsPtr->removeDirectoryProc == NULL) {
    if (fsPtr != NULL && fsPtr->removeDirectoryProc != NULL) {
	Tcl_FSRemoveDirectoryProc *proc = fsPtr->removeDirectoryProc;
	Tcl_SetErrno(ENOENT);
	return -1;
    }
	if (recursive) {
	    /*
	     * We check whether the cwd lies inside this directory and move it
	     * if it does.
	     */


    if (recursive) {
	Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);
	if (cwdPtr != NULL) {
	    const char *cwdStr, *normPathStr;
	    size_t cwdLen, normLen;
	    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	    Tcl_Obj *cwdPtr = Tcl_FSGetCwd(NULL);

	    if (cwdPtr != NULL) {
		char *cwdStr, *normPathStr;
		int cwdLen, normLen;
		Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	    if (normPath != NULL) {
		normPathStr = TclGetStringFromObj(normPath, &normLen);
		cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen);
		if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			normLen) == 0)) {
		    /*
		     * The cwd is inside the directory to be removed.  Change
		     * the cwd to [file dirname $path].
		     */
		if (normPath != NULL) {
		    normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
		    cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
		    if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
			    (size_t) normLen) == 0)) {
			/*
			 * The cwd is inside the directory, so we perform a
			 * 'cd [file dirname $path]'.
			 */

		    Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
			    TCL_PATH_DIRNAME);
			Tcl_Obj *dirPtr = TclPathPart(NULL, pathPtr,
				TCL_PATH_DIRNAME);

		    Tcl_FSChdir(dirPtr);
		    Tcl_DecrRefCount(dirPtr);
		}
	    }
	    Tcl_DecrRefCount(cwdPtr);
	}
    }
    return fsPtr->removeDirectoryProc(pathPtr, recursive, errorPtr);
			Tcl_FSChdir(dirPtr);
			Tcl_DecrRefCount(dirPtr);
		    }
		}
		Tcl_DecrRefCount(cwdPtr);
	    }
	}
	return (*proc)(pathPtr, recursive, errorPtr);
    }
    Tcl_SetErrno(ENOENT);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetFileSystemForPath --
 *
 *	This function determines which filesystem to use for a particular path
 *	Produces the filesystem that corresponds to the given pathname.
 *	object, and returns the filesystem which accepts this file. If no
 *	filesystem will accept this object as a valid file path, then NULL is
 *	returned.
 *
 * Results:
 *	The corresponding Tcl_Filesystem, or NULL if the pathname is invalid.
 *	NULL or a filesystem which will accept this path.
 *
 * Side effects:
 *	The internal representation of fsPtrPtr is converted to fsPathType if
 *	The object may be converted to a path type.
 *	needed, and that internal representation is updated as needed.
 *
 *---------------------------------------------------------------------------
 */

const Tcl_Filesystem *
Tcl_Filesystem *
Tcl_FSGetFileSystemForPath(
    Tcl_Obj *pathPtr)
    Tcl_Obj* pathPtr)
{
    FilesystemRecord *fsRecPtr;
    const Tcl_Filesystem *retVal = NULL;
    Tcl_Filesystem* retVal = NULL;

    if (pathPtr == NULL) {
	Tcl_Panic("Tcl_FSGetFileSystemForPath called with NULL object");
	return NULL;
    }

    if (pathPtr->refCount == 0) {
	/*
	 * Avoid possible segfaults or nondeterministic memory leaks where the
	 * reference count has been incorreclty managed.
	 */
    /*
     * If the object has a refCount of zero, we reject it. This is to avoid
     * possible segfaults or nondeterministic memory leaks (i.e. the user
     * doesn't know if they should decrement the ref count on return or not).
     */

    if (pathPtr->refCount == 0) {
	Tcl_Panic("Tcl_FSGetFileSystemForPath called with object with refCount == 0");
	return NULL;
    }

    /*
     * Check if the filesystem has changed in some way since this object's
     * internal representation was calculated. Before doing that, assure we
    /* Start with an up-to-date copy of the filesystem. */
     * have the most up-to-date copy of the master filesystem. This is
     * accomplished by the FsGetFirstFilesystem() call.
     */

    fsRecPtr = FsGetFirstFilesystem();
    Claim();

    /*
     * Ensure that pathPtr is a valid pathname.
     */
    if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
	/* not a valid pathname */
	Disclaim();
	return NULL;
    } else if (retVal != NULL) {
	/*
	 * Found the filesystem in the internal representation of pathPtr.
	*/
	Disclaim();
	return retVal;
    }

    /*
     * Call each of the "pathInFilesystem" functions in succession until the
     * Call each of the "pathInFilesystem" functions in succession. A
     * corresponding filesystem is found.
     * non-return value of -1 indicates the particular function has succeeded.
     */
    for (; fsRecPtr!=NULL ; fsRecPtr=fsRecPtr->nextPtr) {
	ClientData clientData = NULL;

    while ((retVal == NULL) && (fsRecPtr != NULL)) {
	Tcl_FSPathInFilesystemProc *proc =
	if (fsRecPtr->fsPtr->pathInFilesystemProc == NULL) {
		fsRecPtr->fsPtr->pathInFilesystemProc;
	    continue;
	}

	if (fsRecPtr->fsPtr->pathInFilesystemProc(pathPtr, &clientData)!=-1) {
	    /* This is the filesystem for pathPtr.  Assume the type of pathPtr
	     * hasn't been changed by the above call to the
	     * pathInFilesystemProc, and cache this result in the internal
	     * representation of pathPtr.  */

	if (proc != NULL) {
	    ClientData clientData = NULL;
	    if ((*proc)(pathPtr, &clientData) != -1) {
		/*
		 * We assume the type of pathPtr hasn't been changed by the
		 * above call to the pathInFilesystemProc.
		 */

	    TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
		TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
	    Disclaim();
	    return fsRecPtr->fsPtr;
	}
    }
		retVal = fsRecPtr->fsPtr;
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return NULL;
    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetNativePath --
 *
 *	This function is for use by the Win/Unix native filesystems, so that
 *	they can easily retrieve the native (char* or TCHAR*) representation
 *	of a path. Other filesystems will probably want to implement similar
 *	functions. They basically act as a safety net around
 *	Tcl_FSGetInternalRep. Normally your file-system functions will always
 *	be called with path objects already converted to the correct
 *	filesystem, but if for some reason they are called directly (i.e. by
 *	functions not in this file), then one cannot necessarily guarantee
 *	that the path object pointer is from the correct filesystem.
 *
 *	Note: in the future it might be desireable to have separate versions
 *	of this function with different signatures, for example
 *	Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
 *	native paths are all string based, we use just one function.
 *
 * Results:
 *	NULL or a valid native path.
 *
 * Side effects:
 *  See Tcl_FSGetInternalRep.
 *	See Tcl_FSGetInternalRep.
 *
 *---------------------------------------------------------------------------
 */

const void *
const char *
Tcl_FSGetNativePath(
    Tcl_Obj *pathPtr)
{
    return Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
    return (const char *) Tcl_FSGetInternalRep(pathPtr, &tclNativeFilesystem);
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFreeInternalRep --
 *
 *	Free a native internal representation.
 *	Free a native internal representation, which will be non-NULL.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is released.
 *
 *---------------------------------------------------------------------------
 */

static void
NativeFreeInternalRep(
    ClientData clientData)
{
    Tcl_Free(clientData);
    ckfree((char *) clientData);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSFileSystemInfo --
 *	Produce the type of a pathname and the type of its filesystem.
 *
 *	This function returns a list of two elements. The first element is the
 *	name of the filesystem (e.g. "native" or "vfs"), and the second is the
 *	particular type of the given path within that filesystem.
 *
 * Results:
 *	A list where the first item is the name of the filesystem (e.g.
 *	A list of two elements.
 *	"native" or "vfs"), and the second item is the type of the given
 *	pathname within that filesystem.
 *
 * Side effects:
 *	The internal representation of pathPtr may be converted to a
 *	The object may be converted to a path type.
 *	fsPathType.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSFileSystemInfo(
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *resPtr;
    Tcl_FSFilesystemPathTypeProc *proc;
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);

    if (fsPtr == NULL) {
	return NULL;
    }

    resPtr = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(NULL, resPtr,
    Tcl_ListObjAppendElement(NULL,resPtr,Tcl_NewStringObj(fsPtr->typeName,-1));
	    Tcl_NewStringObj(fsPtr->typeName, -1));

    if (fsPtr->filesystemPathTypeProc != NULL) {
	Tcl_Obj *typePtr = fsPtr->filesystemPathTypeProc(pathPtr);
    proc = fsPtr->filesystemPathTypeProc;
    if (proc != NULL) {
	Tcl_Obj *typePtr = (*proc)(pathPtr);

	if (typePtr != NULL) {
	    Tcl_ListObjAppendElement(NULL, resPtr, typePtr);
	}
    }

    return resPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSPathSeparator --
 *
 *	Produces the separator for given pathname.
 *	This function returns the separator to be used for a given path. The
 *	object returned should have a refCount of zero
 *
 * Results:
 *	A Tcl object having a refCount of zero.
 *	A Tcl object, with a refCount of zero. If the caller needs to retain a
 *	reference to the object, it should call Tcl_IncrRefCount, and should
 *	otherwise free the object.
 *
 * Side effects:
 *	The internal representation of pathPtr may be converted to a fsPathType
 *	The path object may be converted to a path type.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSPathSeparator(
    Tcl_Obj *pathPtr)
{
    const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr);
    Tcl_Obj *resultObj;

    if (fsPtr == NULL) {
	return NULL;
    }

    if (fsPtr->filesystemSeparatorProc != NULL) {
	return fsPtr->filesystemSeparatorProc(pathPtr);
    }
	return (*fsPtr->filesystemSeparatorProc)(pathPtr);
    } else {
	Tcl_Obj *resultObj;

    /*
	/*
     * Use the standard forward slash character if filesystem does not to
     * provide a filesystemSeparatorProc.
     */
	 * Allow filesystems not to provide a filesystemSeparatorProc if they
	 * wish to use the standard forward slash.
	 */

    TclNewLiteralStringObj(resultObj, "/");
    return resultObj;
	TclNewLiteralStringObj(resultObj, "/");
	return resultObj;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * NativeFilesystemSeparator --
 *
 *	This function, part of the native filesystem support, returns the
 *	separator for the given pathname.
 *	This function is part of the native filesystem support, and returns
 *	the separator for the given path.
 *
 * Results:
 *	The separator character.
 *	String object containing the separator character.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static Tcl_Obj *
NativeFilesystemSeparator(
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/)
    Tcl_Obj *pathPtr)
{
    const char *separator = NULL;
    const char *separator = NULL; /* lint */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	separator = "/";
	break;
    case TCL_PLATFORM_WINDOWS:
	separator = "\\";
	break;
    }
    return Tcl_NewStringObj(separator,1);
}

/* Everything from here on is contained in this obsolete ifdef */
#ifdef USE_OBSOLETE_FS_HOOKS

/*
 *----------------------------------------------------------------------
 *
 * TclStatInsertProc --
 *
 *	Insert the passed function pointer at the head of the list of
 *	functions which are used during a call to 'TclStat(...)'. The passed
 *	function should behave exactly like 'TclStat' when called during that
 *	time (see 'TclStat(...)' for more information). The function will be
 *	added even if it already in the list.
 *
 * Results:
 *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
 *	not be allocated.
 *
 * Side effects:
 *	Memory allocated and modifies the link list for 'TclStat' functions.
 *
 *----------------------------------------------------------------------
 */

int
TclStatInsertProc(
    TclStatProc_ *proc)
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {
	StatProc *newStatProcPtr;

	newStatProcPtr = (StatProc *)ckalloc(sizeof(StatProc));

	if (newStatProcPtr != NULL) {
	    newStatProcPtr->proc = proc;
	    Tcl_MutexLock(&obsoleteFsHookMutex);
	    newStatProcPtr->nextPtr = statProcList;
	    statProcList = newStatProcPtr;
	    Tcl_MutexUnlock(&obsoleteFsHookMutex);

	    retVal = TCL_OK;
	}
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclStatDeleteProc --
 *
 *	Removed the passed function pointer from the list of 'TclStat'
 *	functions. Ensures that the built-in stat function is not removable.
 *
 * Results:
 *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

int
TclStatDeleteProc(
    TclStatProc_ *proc)
{
    int retVal = TCL_ERROR;
    StatProc *tmpStatProcPtr;
    StatProc *prevStatProcPtr = NULL;

    Tcl_MutexLock(&obsoleteFsHookMutex);
    tmpStatProcPtr = statProcList;

    /*
     * Traverse the 'statProcList' looking for the particular node whose
     * 'proc' member matches 'proc' and remove that one from the list. Ensure
     * that the "default" node cannot be removed.
     */

    while ((retVal == TCL_ERROR) && (tmpStatProcPtr != NULL)) {
	if (tmpStatProcPtr->proc == proc) {
	    if (prevStatProcPtr == NULL) {
		statProcList = tmpStatProcPtr->nextPtr;
	    } else {
		prevStatProcPtr->nextPtr = tmpStatProcPtr->nextPtr;
	    }

	    ckfree((char *)tmpStatProcPtr);

	    retVal = TCL_OK;
	} else {
	    prevStatProcPtr = tmpStatProcPtr;
	    tmpStatProcPtr = tmpStatProcPtr->nextPtr;
	}
    }

    Tcl_MutexUnlock(&obsoleteFsHookMutex);

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAccessInsertProc --
 *
 *	Insert the passed function pointer at the head of the list of
 *	functions which are used during a call to 'TclAccess(...)'. The passed
 *	function should behave exactly like 'TclAccess' when called during
 *	that time (see 'TclAccess(...)' for more information). The function
 *	will be added even if it already in the list.
 *
 * Results:
 *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
 *	not be allocated.
 *
 * Side effects:
 *	Memory allocated and modifies the link list for 'TclAccess' functions.
 *
 *----------------------------------------------------------------------
 */

int
TclAccessInsertProc(
    TclAccessProc_ *proc)
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {
	AccessProc *newAccessProcPtr;

	newAccessProcPtr = (AccessProc *)ckalloc(sizeof(AccessProc));

	if (newAccessProcPtr != NULL) {
	    newAccessProcPtr->proc = proc;
	    Tcl_MutexLock(&obsoleteFsHookMutex);
	    newAccessProcPtr->nextPtr = accessProcList;
	    accessProcList = newAccessProcPtr;
	    Tcl_MutexUnlock(&obsoleteFsHookMutex);

	    retVal = TCL_OK;
	}
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAccessDeleteProc --
 *
 *	Removed the passed function pointer from the list of 'TclAccess'
 *	functions. Ensures that the built-in access function is not removable.
 *
 * Results:
 *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

int
TclAccessDeleteProc(
    TclAccessProc_ *proc)
{
    int retVal = TCL_ERROR;
    AccessProc *tmpAccessProcPtr;
    AccessProc *prevAccessProcPtr = NULL;

    /*
     * Traverse the 'accessProcList' looking for the particular node whose
     * 'proc' member matches 'proc' and remove that one from the list. Ensure
     * that the "default" node cannot be removed.
     */

    Tcl_MutexLock(&obsoleteFsHookMutex);
    tmpAccessProcPtr = accessProcList;
    while ((retVal == TCL_ERROR) && (tmpAccessProcPtr != NULL)) {
	if (tmpAccessProcPtr->proc == proc) {
	    if (prevAccessProcPtr == NULL) {
		accessProcList = tmpAccessProcPtr->nextPtr;
	    } else {
		prevAccessProcPtr->nextPtr = tmpAccessProcPtr->nextPtr;
	    }

	    ckfree((char *)tmpAccessProcPtr);

	    retVal = TCL_OK;
	} else {
	    prevAccessProcPtr = tmpAccessProcPtr;
	    tmpAccessProcPtr = tmpAccessProcPtr->nextPtr;
	}
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclOpenFileChannelInsertProc --
 *
 *	Insert the passed function pointer at the head of the list of
 *	functions which are used during a call to 'Tcl_OpenFileChannel(...)'.
 *	The passed function should behave exactly like 'Tcl_OpenFileChannel'
 *	when called during that time (see 'Tcl_OpenFileChannel(...)' for more
 *	information). The function will be added even if it already in the
 *	list.
 *
 * Results:
 *	Normally TCL_OK; TCL_ERROR if memory for a new node in the list could
 *	not be allocated.
 *
 * Side effects:
 *	Memory allocated and modifies the link list for 'Tcl_OpenFileChannel'
 *	functions.
 *
 *----------------------------------------------------------------------
 */

int
TclOpenFileChannelInsertProc(
    TclOpenFileChannelProc_ *proc)
{
    int retVal = TCL_ERROR;

    if (proc != NULL) {
	OpenFileChannelProc *newOpenFileChannelProcPtr;

	newOpenFileChannelProcPtr = (OpenFileChannelProc *)
		ckalloc(sizeof(OpenFileChannelProc));

	newOpenFileChannelProcPtr->proc = proc;
	Tcl_MutexLock(&obsoleteFsHookMutex);
	newOpenFileChannelProcPtr->nextPtr = openFileChannelProcList;
	openFileChannelProcList = newOpenFileChannelProcPtr;
	Tcl_MutexUnlock(&obsoleteFsHookMutex);

	retVal = TCL_OK;
    }

    return retVal;
}

/*
 *----------------------------------------------------------------------
 *
 * TclOpenFileChannelDeleteProc --
 *
 *	Removed the passed function pointer from the list of
 *	'Tcl_OpenFileChannel' functions. Ensures that the built-in open file
 *	channel function is not removable.
 *
 * Results:
 *	TCL_OK if the function pointer was successfully removed, TCL_ERROR
 *	otherwise.
 *
 * Side effects:
 *	Memory is deallocated and the respective list updated.
 *
 *----------------------------------------------------------------------
 */

int
TclOpenFileChannelDeleteProc(
    TclOpenFileChannelProc_ *proc)
{
    int retVal = TCL_ERROR;
    OpenFileChannelProc *tmpOpenFileChannelProcPtr = openFileChannelProcList;
    OpenFileChannelProc *prevOpenFileChannelProcPtr = NULL;

    /*
     * Traverse the 'openFileChannelProcList' looking for the particular node
     * whose 'proc' member matches 'proc' and remove that one from the list.
     */

    Tcl_MutexLock(&obsoleteFsHookMutex);
    tmpOpenFileChannelProcPtr = openFileChannelProcList;
    while ((retVal == TCL_ERROR) &&
	    (tmpOpenFileChannelProcPtr != NULL)) {
	if (tmpOpenFileChannelProcPtr->proc == proc) {
	    if (prevOpenFileChannelProcPtr == NULL) {
		openFileChannelProcList = tmpOpenFileChannelProcPtr->nextPtr;
	    } else {
		prevOpenFileChannelProcPtr->nextPtr =
			tmpOpenFileChannelProcPtr->nextPtr;
	    }

	    ckfree((char *) tmpOpenFileChannelProcPtr);

	    retVal = TCL_OK;
	} else {
	    prevOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr;
	    tmpOpenFileChannelProcPtr = tmpOpenFileChannelProcPtr->nextPtr;
	}
    }
    Tcl_MutexUnlock(&obsoleteFsHookMutex);

    return retVal;
}
#endif /* USE_OBSOLETE_FS_HOOKS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclIndexObj.c.

1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50






51
52
53
54
55
56
57
58
59
60
61
62
63
64



65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

82
83

84
85
86
87
88
89
90
91
92
93
94







95
96
97
98


99
100
101
102

103
104
105


106
107
108



109
110
111
112
113
114
115
116
117
118
119

120
121


122
123
124
125

126
127
128

129
130
131
132
133
134
135
136

137
138



139
140
141



142
143
144

145
146
147
148
149

150
151

152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174







175
176
177
178
179
180
181
182
183
184
185

186
187
188
189
190
191
192

193
194
195
196
197
198
199

200
201
202
203
204
205
206
207
208


209
210
211
212
213
214
215

216
217

218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241

242
243
244
245
246
247
248
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





-
+

-

-











-
+
-
-



-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
+
+
+
+
+
+











-
-
-
+
+
+
















-
+

-
+




-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
+
+




+

-
-
+
+

-
-
+
+
+






-
-
-
-

+
-
-
+
+


-
-
+
-
-
-
+
-
-
-

-
-
-
-
+
-
-
+
+
+

-
-
+
+
+


-
+
-
-
-
-
-
+
-
-
+
-
-
-













-
-
-
-
-
-
-
+
+
+
+
+
+
+










-
+






-
+






-
+




-


-
-
+
+





-
-
+
-
-
+




-


















-
+







/*
 * tclIndexObj.c --
 *
 *	This file implements objects of type "index". This object type is used
 *	to lookup a keyword in a table of valid values and cache the index of
 *	the matching entry. Also provides table-based argv/argc processing.
 *	the matching entry.
 *
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 2006 Sam Bromley.
 *
 * 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 functions defined later in this file:
 */

static int		GetIndexFromObjList(Tcl_Interp *interp,
static int		SetIndexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
			    Tcl_Obj *objPtr, Tcl_Obj *tableObjPtr,
			    const char *msg, int flags, int *indexPtr);
static void		UpdateStringOfIndex(Tcl_Obj *objPtr);
static void		DupIndex(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void		FreeIndex(Tcl_Obj *objPtr);
static int		PrefixAllObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		PrefixLongestObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		PrefixMatchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static void		PrintUsage(Tcl_Interp *interp,
			    const Tcl_ArgvInfo *argTable);

/*
 * The structure below defines the index Tcl object type by means of functions
 * that can be invoked by generic object code.
 */

static const Tcl_ObjType indexType = {
    "index",			/* name */
    FreeIndex,			/* freeIntRepProc */
    DupIndex,			/* dupIntRepProc */
    UpdateStringOfIndex,	/* updateStringProc */
    NULL			/* setFromAnyProc */
static Tcl_ObjType indexType = {
    "index",				/* name */
    FreeIndex,				/* freeIntRepProc */
    DupIndex,				/* dupIntRepProc */
    UpdateStringOfIndex,		/* updateStringProc */
    SetIndexFromAny			/* setFromAnyProc */
};

/*
 * The definition of the internal representation of the "index" object; The
 * internalRep.twoPtrValue.ptr1 field of an object of "index" type will be a
 * pointer to one of these structures.
 *
 * Keep this structure declaration in sync with tclTestObj.c
 */

typedef struct {
    void *tablePtr;		/* Pointer to the table of strings */
    size_t offset;			/* Offset between table entries */
    size_t index;			/* Selected index into table. */
    void *tablePtr;			/* Pointer to the table of strings */
    int offset;				/* Offset between table entries */
    int index;				/* Selected index into table. */
} IndexRep;

/*
 * The following macros greatly simplify moving through a table...
 */

#define STRING_AT(table, offset) \
	(*((const char *const *)(((char *)(table)) + (offset))))
#define NEXT_ENTRY(table, offset) \
	(&(STRING_AT(table, offset)))
#define EXPAND_OF(indexRep) \
	STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index)

/*
 *----------------------------------------------------------------------
 *
 * GetIndexFromObjList --
 * Tcl_GetIndexFromObj --
 *
 *	This procedure looks up an object's value in a table of strings and
 *	This function looks up an object's value in a table of strings and
 *	returns the index of the matching string, if any.
 *
 * Results:
 *	If the value of objPtr is identical to or a unique abbreviation for
 *	one of the entries in tableObjPtr, then the return value is TCL_OK and
 *	the index of the matching entry is stored at *indexPtr. If there isn't
 *	a proper match, then TCL_ERROR is returned and an error message is
 *	left in interp's result (unless interp is NULL). The msg argument is
 *	used in the error message; for example, if msg has the value "option"
 *	then the error message will say something flag 'bad option "foo": must
 *	be ...'
 *	one of the entries in objPtr, then the return value is TCL_OK and the
 *	index of the matching entry is stored at *indexPtr. If there isn't a
 *	proper match, then TCL_ERROR is returned and an error message is left
 *	in interp's result (unless interp is NULL). The msg argument is used
 *	in the error message; for example, if msg has the value "option" then
 *	the error message will say something flag 'bad option "foo": must be
 *	...'
 *
 * Side effects:
 *	Removes any internal representation that the object might have. (TODO:
 *	find a way to cache the lookup.)
 *	The result of the lookup is cached as the internal rep of objPtr, so
 *	that repeated lookups can be done quickly.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetIndexFromObj
int
GetIndexFromObjList(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
Tcl_GetIndexFromObj(
    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
    Tcl_Obj *tableObjPtr,	/* List of strings to compare against the
				 * value of objPtr. */
    const char **tablePtr,	/* Array of strings to compare against the
				 * value of objPtr; last entry must be NULL
				 * and there must not be duplicate entries. */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0 or TCL_EXACT */
    int *indexPtr)		/* Place to store resulting integer index. */
{

    int objc, result, t;
    Tcl_Obj **objv;
    const char **tablePtr;

    /*
     * See if there is a valid cached result from a previous lookup (doing the
     * Use Tcl_GetIndexFromObjStruct to do the work to avoid duplicating most
     * of the code there. This is a bit ineffiecient but simpler.
     * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
     * the common case where the result is cached).
     */

    result = Tcl_ListObjGetElements(interp, tableObjPtr, &objc, &objv);
    if (result != TCL_OK) {
    if (objPtr->typePtr == &indexType) {
	return result;
    }

	IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
    /*
     * Build a string table from the list.
     */

    tablePtr = (const char **)Tcl_Alloc((objc + 1) * sizeof(char *));
    for (t = 0; t < objc; t++) {
	if (objv[t] == objPtr) {
	    /*
	/*
	     * An exact match is always chosen, so we can stop here.
	     */
	 * Here's hoping we don't get hit by unfortunate packing constraints
	 * on odd platforms like a Cray PVP...
	 */

	    Tcl_Free((void *)tablePtr);
	    *indexPtr = t;
	if (indexRep->tablePtr == (void *) tablePtr
		&& indexRep->offset == sizeof(char *)) {
	    *indexPtr = indexRep->index;
	    return TCL_OK;
	}

    }
	tablePtr[t] = TclGetString(objv[t]);
    }
    tablePtr[objc] = NULL;

    result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
    return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
	    sizeof(char *), msg, flags | TCL_INDEX_TEMP_TABLE, indexPtr);

	    msg, flags, indexPtr);
    Tcl_Free((void *)tablePtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIndexFromObjStruct --
 *
 *	This function looks up an object's value given a starting string and
 *	an offset for the amount of space between strings. This is useful when
 *	the strings are embedded in some other kind of array.
 *
 * Results:
 *	If the value of objPtr is identical to or a unique abbreviation for
 *	one of the entries in tablePtr, then the return value is TCL_OK and
 *	the index of the matching entry is stored at *indexPtr. If there isn't
 *	a proper match, then TCL_ERROR is returned and an error message is
 *	left in interp's result (unless interp is NULL). The msg argument is
 *	used in the error message; for example, if msg has the value "option"
 *	then the error message will say something like 'bad option "foo": must
 *	be ...'
 *	one of the entries in objPtr, then the return value is TCL_OK and the
 *	index of the matching entry is stored at *indexPtr. If there isn't a
 *	proper match, then TCL_ERROR is returned and an error message is left
 *	in interp's result (unless interp is NULL). The msg argument is used
 *	in the error message; for example, if msg has the value "option" then
 *	the error message will say something like 'bad option "foo": must be
 *	...'
 *
 * Side effects:
 *	The result of the lookup is cached as the internal rep of objPtr, so
 *	that repeated lookups can be done quickly.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIndexFromObjStruct(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* Object containing the string to lookup. */
    const void *tablePtr,	/* The first string in the table. The second
				 * string will be at this address plus the
				 * offset, the third plus the offset again,
				 * etc. The last entry must be NULL and there
				 * must not be duplicate entries. */
    size_t offset,			/* The number of bytes between entries */
    int offset,			/* The number of bytes between entries */
    const char *msg,		/* Identifying word to use in error
				 * messages. */
    int flags,			/* 0 or TCL_EXACT */
    int *indexPtr)		/* Place to store resulting integer index. */
{
    int index, idx, numAbbrev;
    const char *key, *p1;
    char *key, *p1;
    const char *p2;
    const char *const *entryPtr;
    Tcl_Obj *resultPtr;
    IndexRep *indexRep;
    const Tcl_ObjIntRep *irPtr;

    /* Protect against invalid values, like -1 or 0. */
    if (offset+1 <= sizeof(char *)) {
	offset = sizeof(char *);
    if (offset < (int)sizeof(char *)) {
	offset = (int)sizeof(char *);
    }
    /*
     * See if there is a valid cached result from a previous lookup.
     */

    if (!(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchIntRep(objPtr, &indexType);
    if (objPtr->typePtr == &indexType) {
    if (irPtr) {
	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
	    *indexPtr = indexRep->index;
	    return TCL_OK;
	}
    }
    }

    /*
     * Lookup the value of the object in the table. Accept unique
     * abbreviations unless TCL_EXACT is set in flags.
     */

    key = TclGetString(objPtr);
    index = -1;
    numAbbrev = 0;

    /*
     * Scan the table looking for one of:
     *  - An exact match (always preferred)
     *  - A single abbreviation (allowed depending on flags)
     *  - Several abbreviations (never allowed, but overridden by exact match)
     */

    for (entryPtr = (const char* const*)tablePtr, idx = 0; *entryPtr != NULL;
    for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL;
	    entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) {
	for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) {
	    if (*p1 == '\0') {
		index = idx;
		goto done;
	    }
	}
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
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







-
-
+
-
-
+

-
-
-
-
-
+
+
+
+




-













+
-
+



-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+







  done:
    /*
     * Cache the found representation. Note that we want to avoid allocating a
     * new internal-rep if at all possible since that is potentially a slow
     * operation.
     */

    if (!(flags & TCL_INDEX_TEMP_TABLE)) {
    irPtr = TclFetchIntRep(objPtr, &indexType);
    if (objPtr->typePtr == &indexType) {
    if (irPtr) {
	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
 	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
    } else {
	Tcl_ObjIntRep ir;

	indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
	ir.twoPtrValue.ptr1 = indexRep;
	Tcl_StoreIntRep(objPtr, &indexType, &ir);
	TclFreeIntRep(objPtr);
 	indexRep = (IndexRep *) ckalloc(sizeof(IndexRep));
 	objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
 	objPtr->typePtr = &indexType;
    }
    indexRep->tablePtr = (void *) tablePtr;
    indexRep->offset = offset;
    indexRep->index = index;
    }

    *indexPtr = index;
    return TCL_OK;

  error:
    if (interp != NULL) {
	/*
	 * Produce a fancy error message.
	 */

	int count = 0;

	TclNewObj(resultPtr);
	Tcl_SetObjResult(interp, resultPtr);
	entryPtr = (const char* const *)tablePtr;
	entryPtr = tablePtr;
	while ((*entryPtr != NULL) && !**entryPtr) {
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	}
	Tcl_AppendStringsToObj(resultPtr,
		(numAbbrev>1 && !(flags & TCL_EXACT) ? "ambiguous " : "bad "),
	Tcl_AppendStringsToObj(resultPtr, (numAbbrev > 1) &&
		!(flags & TCL_EXACT) ? "ambiguous " : "bad ", msg, " \"", key,
		msg, " \"", key, NULL);
	if (*entryPtr == NULL) {
	    Tcl_AppendStringsToObj(resultPtr, "\": no valid options", NULL);
	} else {
	    Tcl_AppendStringsToObj(resultPtr, "\": must be ",
		    *entryPtr, NULL);
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	    while (*entryPtr != NULL) {
		if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
		    Tcl_AppendStringsToObj(resultPtr, (count > 0 ? "," : ""),
			    " or ", *entryPtr, NULL);
		} else if (**entryPtr) {
		    Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
		    count++;
		}
		entryPtr = NEXT_ENTRY(entryPtr, offset);
	    }
	}
	Tcl_SetObjResult(interp, resultPtr);
		"\": must be ", *entryPtr, NULL);
	entryPtr = NEXT_ENTRY(entryPtr, offset);
	while (*entryPtr != NULL) {
	    if (*NEXT_ENTRY(entryPtr, offset) == NULL) {
		Tcl_AppendStringsToObj(resultPtr, ((count > 0) ? "," : ""),
			" or ", *entryPtr, NULL);
	    } else if (**entryPtr) {
		Tcl_AppendStringsToObj(resultPtr, ", ", *entryPtr, NULL);
		count++;
	    }
	    entryPtr = NEXT_ENTRY(entryPtr, offset);
	}
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * SetIndexFromAny --
 *
 *	This function is called to convert a Tcl object to index internal
 *	form. However, this doesn't make sense (need to have a table of
 *	keywords in order to do the conversion) so the function always
 *	generates an error.
 *
 * Results:
 *	The return value is always TCL_ERROR, and an error message is left in
 *	interp's result if interp isn't NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SetIndexFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    if (interp) {
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", msg, key, NULL);
	    "can't convert value to index except via Tcl_GetIndexFromObj API",
	    -1));
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
350
351
352
353
354
355
356
357
358




359
360





361
362
363
364
365
366
367
338
339
340
341
342
343
344


345
346
347
348
349

350
351
352
353
354
355
356
357
358
359
360
361







-
-
+
+
+
+

-
+
+
+
+
+







 *----------------------------------------------------------------------
 */

static void
UpdateStringOfIndex(
    Tcl_Obj *objPtr)
{
    IndexRep *indexRep = (IndexRep *)TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1;
    const char *indexStr = EXPAND_OF(indexRep);
    IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
    register char *buf;
    register unsigned len;
    register const char *indexStr = EXPAND_OF(indexRep);

    Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
    len = strlen(indexStr);
    buf = (char *) ckalloc(len + 1);
    memcpy(buf, indexStr, len+1);
    objPtr->bytes = buf;
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *
 * DupIndex --
 *
379
380
381
382
383
384
385
386
387


388
389
390

391
392
393


394
395
396
397
398
399
400
373
374
375
376
377
378
379


380
381
382


383



384
385
386
387
388
389
390
391
392







-
-
+
+

-
-
+
-
-
-
+
+







 */

static void
DupIndex(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    Tcl_ObjIntRep ir;
    IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
    IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
    IndexRep *dupIndexRep = (IndexRep *) ckalloc(sizeof(IndexRep));

    memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
	    sizeof(IndexRep));
    memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));

    ir.twoPtrValue.ptr1 = dupIndexRep;
    Tcl_StoreIntRep(dupPtr, &indexType, &ir);
    dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
    dupPtr->typePtr = &indexType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeIndex --
 *
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
402
403
404
405
406
407
408

409
410
411


























































































































































































































































































































412
413
414
415
416
417
418







-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *----------------------------------------------------------------------
 */

static void
FreeIndex(
    Tcl_Obj *objPtr)
{
    Tcl_Free(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1);
    ckfree((char *) objPtr->internalRep.twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitPrefixCmd --
 *
 *	This procedure creates the "prefix" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitPrefixCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap prefixImplMap[] = {
	{"all",	    PrefixAllObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"longest", PrefixLongestObjCmd,TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"match",   PrefixMatchObjCmd,	TclCompileBasicMin2ArgCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    Tcl_Command prefixCmd;

    prefixCmd = TclMakeEnsemble(interp, "::tcl::prefix", prefixImplMap);
    Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
	    "prefix", 0);
    return prefixCmd;
}

/*----------------------------------------------------------------------
 *
 * PrefixMatchObjCmd --
 *
 *	This function implements the 'prefix match' Tcl command. Refer to the
 *	user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PrefixMatchObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int flags = 0, result, index;
    int dummyLength, i, errorLength;
    Tcl_Obj *errorPtr = NULL;
    const char *message = "option";
    Tcl_Obj *tablePtr, *objPtr, *resultPtr;
    static const char *const matchOptions[] = {
	"-error", "-exact", "-message", NULL
    };
    enum matchOptionsEnum {
	PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE
    };

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?options? table string");
	return TCL_ERROR;
    }

    for (i = 1; i < (objc - 2); i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], matchOptions, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum matchOptionsEnum) index) {
	case PRFMATCH_EXACT:
	    flags |= TCL_EXACT;
	    break;
	case PRFMATCH_MESSAGE:
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing value for -message", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
		return TCL_ERROR;
	    }
	    i++;
	    message = TclGetString(objv[i]);
	    break;
	case PRFMATCH_ERROR:
	    if (i > objc-4) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing value for -error", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NOARG", NULL);
		return TCL_ERROR;
	    }
	    i++;
	    result = Tcl_ListObjLength(interp, objv[i], &errorLength);
	    if (result != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((errorLength % 2) != 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"error options must have an even number of elements",
			-1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "DICTIONARY", NULL);
		return TCL_ERROR;
	    }
	    errorPtr = objv[i];
	    break;
	}
    }

    tablePtr = objv[objc - 2];
    objPtr = objv[objc - 1];

    /*
     * Check that table is a valid list first, since we want to handle that
     * error case regardless of level.
     */

    result = Tcl_ListObjLength(interp, tablePtr, &dummyLength);
    if (result != TCL_OK) {
	return result;
    }

    result = GetIndexFromObjList(interp, objPtr, tablePtr, message, flags,
	    &index);
    if (result != TCL_OK) {
	if (errorPtr != NULL && errorLength == 0) {
	    Tcl_ResetResult(interp);
	    return TCL_OK;
	} else if (errorPtr == NULL) {
	    return TCL_ERROR;
	}

	if (Tcl_IsShared(errorPtr)) {
	    errorPtr = Tcl_DuplicateObj(errorPtr);
	}
	Tcl_ListObjAppendElement(interp, errorPtr,
		Tcl_NewStringObj("-code", 5));
	Tcl_ListObjAppendElement(interp, errorPtr, Tcl_NewWideIntObj(result));

	return Tcl_SetReturnOptions(interp, errorPtr);
    }

    result = Tcl_ListObjIndex(interp, tablePtr, index, &resultPtr);
    if (result != TCL_OK) {
	return result;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * PrefixAllObjCmd --
 *
 *	This function implements the 'prefix all' Tcl command. Refer to the
 *	user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PrefixAllObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int tableObjc, result, t;
    size_t length, elemLength;
    const char *string, *elemString;
    Tcl_Obj **tableObjv, *resultPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "table string");
	return TCL_ERROR;
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    resultPtr = Tcl_NewListObj(0, NULL);
    string = TclGetStringFromObj(objv[2], &length);

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * A prefix cannot match if it is longest.
	 */

	if (length <= elemLength) {
	    if (TclpUtfNcmp2(elemString, string, length) == 0) {
		Tcl_ListObjAppendElement(interp, resultPtr, tableObjv[t]);
	    }
	}
    }

    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * PrefixLongestObjCmd --
 *
 *	This function implements the 'prefix longest' Tcl command. Refer to
 *	the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PrefixLongestObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int tableObjc, result, t;
    size_t i, length, elemLength, resultLength;
    const char *string, *elemString, *resultString;
    Tcl_Obj **tableObjv;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "table string");
	return TCL_ERROR;
    }

    result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv);
    if (result != TCL_OK) {
	return result;
    }
    string = TclGetStringFromObj(objv[2], &length);

    resultString = NULL;
    resultLength = 0;

    for (t = 0; t < tableObjc; t++) {
	elemString = TclGetStringFromObj(tableObjv[t], &elemLength);

	/*
	 * First check if the prefix string matches the element. A prefix
	 * cannot match if it is longest.
	 */

	if ((length > elemLength) ||
		TclpUtfNcmp2(elemString, string, length) != 0) {
	    continue;
	}

	if (resultString == NULL) {
	    /*
	     * If this is the first match, the longest common substring this
	     * far is the complete string. The result is part of this string
	     * so we only need to adjust the length later.
	     */

	    resultString = elemString;
	    resultLength = elemLength;
	} else {
	    /*
	     * Longest common substring cannot be longer than shortest string.
	     */

	    if (elemLength < resultLength) {
		resultLength = elemLength;
	    }

	    /*
	     * Compare strings.
	     */

	    for (i = 0; i < resultLength; i++) {
		if (resultString[i] != elemString[i]) {
		    /*
		     * Adjust in case we stopped in the middle of a UTF char.
		     */

		    resultLength = TclUtfPrev(&resultString[i+1],
			    resultString) - resultString;
		    break;
		}
	    }
	}
    }
    if (resultLength > 0) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj(resultString, resultLength));
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WrongNumArgs --
 *
 *	This function generates a "wrong # args" error message in an
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
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







-
-
+
-



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
















-
-
-
-
-
-
-
-







    Tcl_Obj *const objv[],	/* Initial argument objects, which should be
				 * included in the error message. */
    const char *message)	/* Error message to print after the leading
				 * objects in objv. The message may be
				 * NULL. */
{
    Tcl_Obj *objPtr;
    int i;
    size_t len, elemLen;
    int i, len, elemLen, flags;
    char flags;
    Interp *iPtr = (Interp *) interp;
    const char *elementStr;

    /*
     * [incr Tcl] does something fairly horrific when generating error
     * messages for its ensembles; it passes the whole set of ensemble
     * arguments as a list in the first argument. This means that this code
     * causes a problem in iTcl if it attempts to correctly quote all
     * arguments, which would be the correct thing to do. We work around this
     * nasty behaviour for now, and hope that we can remove it all in the
     * future...
     */

#ifndef AVOID_HACKS_FOR_ITCL
    int isFirst = 1;		/* Special flag used to inhibit the treating
				 * of the first word as a list element so the
				 * hacky way Itcl generates error messages for
				 * its ensembles will still work. [Bug
				 * 1066837] */
#   define MAY_QUOTE_WORD	(!isFirst)
#   define AFTER_FIRST_WORD	(isFirst = 0)
#else /* !AVOID_HACKS_FOR_ITCL */
#   define MAY_QUOTE_WORD	1
#   define AFTER_FIRST_WORD	(void) 0
#endif /* AVOID_HACKS_FOR_ITCL */

    TclNewObj(objPtr);
    if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) {
	iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS;
	Tcl_AppendObjToObj(objPtr, Tcl_GetObjResult(interp));
	Tcl_AppendToObj(objPtr, " or \"", -1);
    } else {
	Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
    }

    /*
     * Check to see if we are processing an ensemble implementation, and if so
     * rewrite the results in terms of how the ensemble was invoked.
     */

    if (iPtr->ensembleRewrite.sourceObjs != NULL) {
	int toSkip = iPtr->ensembleRewrite.numInsertedObjs;
	int toPrint = iPtr->ensembleRewrite.numRemovedObjs;
	Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;

	/*
	 * Check for spelling fixes, and substitute the fixed values.
	 */

	if (origObjv[0] == NULL) {
	    origObjv = (Tcl_Obj *const *)origObjv[2];
	}

	/*
	 * We only know how to do rewriting if all the replaced objects are
	 * actually arguments (in objv) to this function. Otherwise it just
	 * gets too complicated and we'd be better off just giving a slightly
	 * confusing error message...
	 */

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
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







-

-
-
+
+
+


+
+
+
+
+
+







-
-
+
+
+








+
+







	 * We assume no object is of index type.
	 */

	for (i=0 ; i<toPrint ; i++) {
	    /*
	     * Add the element, quoting it if necessary.
	     */
	    const Tcl_ObjIntRep *irPtr;

	    if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) {
		IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
	    if (origObjv[i]->typePtr == &indexType) {
		register IndexRep *indexRep =
			origObjv[i]->internalRep.twoPtrValue.ptr1;

		elementStr = EXPAND_OF(indexRep);
		elemLen = strlen(elementStr);
	    } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
		register EnsembleCmdRep *ecrPtr =
			origObjv[i]->internalRep.twoPtrValue.ptr1;

		elementStr = ecrPtr->fullSubcmdName;
		elemLen = strlen(elementStr);
	    } else {
		elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
	    }
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);
	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			(unsigned)len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }

	    AFTER_FIRST_WORD;

	    /*
	     * Add a space if the word is not the last one (which has a
	     * moderately complex condition here).
	     */

	    if (i<toPrint-1 || objc!=0 || message!=NULL) {
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
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
618
619
620
621
622
623
624
625
626
627
628
629







-

-
-
+
+


+
+
+
+
+









-
-
+
+
+









+
+







  addNormalArgumentsToMessage:
    for (i = 0; i < objc; i++) {
	/*
	 * If the object is an index type use the index table which allows for
	 * the correct error message even if the subcommand was abbreviated.
	 * Otherwise, just use the string rep.
	 */
	const Tcl_ObjIntRep *irPtr;

	if ((irPtr = TclFetchIntRep(objv[i], &indexType))) {
	    IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
	if (objv[i]->typePtr == &indexType) {
	    register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;

	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
	} else if (objv[i]->typePtr == &tclEnsembleCmdType) {
	    register EnsembleCmdRep *ecrPtr =
		    objv[i]->internalRep.twoPtrValue.ptr1;

	    Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
	} else {
	    /*
	     * Quote the argument if it contains spaces (Bug 942757).
	     */

	    elementStr = TclGetStringFromObj(objv[i], &elemLen);
	    flags = 0;
	    len = TclScanElement(elementStr, elemLen, &flags);

	    if (len != elemLen) {
		char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1);
	    if (MAY_QUOTE_WORD && len != elemLen) {
		char *quotedElementStr = TclStackAlloc(interp,
			(unsigned) len + 1);

		len = TclConvertElement(elementStr, elemLen,
			quotedElementStr, flags);
		Tcl_AppendToObj(objPtr, quotedElementStr, len);
		TclStackFree(interp, quotedElementStr);
	    } else {
		Tcl_AppendToObj(objPtr, elementStr, elemLen);
	    }
	}

	AFTER_FIRST_WORD;

	/*
	 * Append a space character (" ") if there is more text to follow
	 * (either another element from objv, or the message string).
	 */

	if (i<objc-1 || message!=NULL) {
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
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
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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
637
638
639
640
641
642
643

644


645























646








































































































































































































































































































































































































647
648
649
650
651
652
653
654
655







-

-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









     * actual error.
     */

    if (message != NULL) {
	Tcl_AppendStringsToObj(objPtr, message, NULL);
    }
    Tcl_AppendStringsToObj(objPtr, "\"", NULL);
    Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL);
    Tcl_SetObjResult(interp, objPtr);
}

#undef MAY_QUOTE_WORD
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ParseArgsObjv --
 *
 *	Process an objv array according to a table of expected command-line
 *	options. See the manual page for more details.
 *
 * Results:
 *	The return value is a standard Tcl return value. If an error occurs
 *	then an error message is left in the interp's result. Under normal
 *	conditions, both *objcPtr and *objv are modified to return the
 *	arguments that couldn't be processed here (they didn't match the
 *	option table, or followed an TCL_ARGV_REST argument).
 *
 * Side effects:
 *	Variables may be modified, or procedures may be called. It all depends
 *	on the arguments and their entries in argTable. See the user
 *	documentation for details.
 *
 *----------------------------------------------------------------------
 */

#undef AFTER_FIRST_WORD
int
Tcl_ParseArgsObjv(
    Tcl_Interp *interp,		/* Place to store error message. */
    const Tcl_ArgvInfo *argTable,
				/* Array of option descriptions. */
    int *objcPtr,		/* Number of arguments in objv. Modified to
				 * hold # args left in objv at end. */
    Tcl_Obj *const *objv,	/* Array of arguments to be parsed. */
    Tcl_Obj ***remObjv)		/* Pointer to array of arguments that were not
				 * processed here. Should be NULL if no return
				 * of arguments is desired. */
{
    Tcl_Obj **leftovers;	/* Array to write back to remObjv on
				 * successful exit. Will include the name of
				 * the command. */
    int nrem;			/* Size of leftovers.*/
    const Tcl_ArgvInfo *infoPtr;
				/* Pointer to the current entry in the table
				 * of argument descriptions. */
    const Tcl_ArgvInfo *matchPtr;
				/* Descriptor that matches current argument */
    Tcl_Obj *curArg;		/* Current argument */
    const char *str = NULL;
    char c;		/* Second character of current arg (used for
				 * quick check for matching; use 2nd char.
				 * because first char. will almost always be
				 * '-'). */
    int srcIndex;		/* Location from which to read next argument
				 * from objv. */
    int dstIndex;		/* Used to keep track of current arguments
				 * being processed, primarily for error
				 * reporting. */
    int objc;			/* # arguments in objv still to process. */
    size_t length;			/* Number of characters in current argument */

    if (remObjv != NULL) {
	/*
	 * Then we should copy the name of the command (0th argument). The
	 * upper bound on the number of elements is known, and (undocumented,
	 * but historically true) there should be a NULL argument after the
	 * last result. [Bug 3413857]
	 */

	nrem = 1;
	leftovers = (Tcl_Obj **)Tcl_Alloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
	leftovers[0] = objv[0];
    } else {
	nrem = 0;
	leftovers = NULL;
    }

    /*
     * OK, now start processing from the second element (1st argument).
     */

    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = TclGetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*
	 * Loop throught the argument descriptors searching for one with the
	 * matching key string. If found, leave a pointer to it in matchPtr.
	 */

	matchPtr = NULL;
	infoPtr = argTable;
	for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) {
	    if (infoPtr->keyStr == NULL) {
		continue;
	    }
	    if ((infoPtr->keyStr[1] != c)
		    || (strncmp(infoPtr->keyStr, str, length) != 0)) {
		continue;
	    }
	    if (infoPtr->keyStr[length] == 0) {
		matchPtr = infoPtr;
		goto gotMatch;
	    }
	    if (matchPtr != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"ambiguous option \"%s\"", str));
		goto error;
	    }
	    matchPtr = infoPtr;
	}
	if (matchPtr == NULL) {
	    /*
	     * Unrecognized argument. Just copy it down, unless the caller
	     * prefers an error to be registered.
	     */

	    if (remObjv == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"unrecognized argument \"%s\"", str));
		goto error;
	    }

	    dstIndex++;		/* This argument is now handled */
	    leftovers[nrem++] = curArg;
	    continue;
	}

	/*
	 * Take the appropriate action based on the option type
	 */

    gotMatch:
	infoPtr = matchPtr;
	switch (infoPtr->type) {
	case TCL_ARGV_CONSTANT:
	    *((int *) infoPtr->dstPtr) = PTR2INT(infoPtr->srcPtr);
	    break;
	case TCL_ARGV_INT:
	    if (objc == 0) {
		goto missingArg;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[srcIndex],
		    (int *) infoPtr->dstPtr) == TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected integer argument for \"%s\" but got \"%s\"",
			infoPtr->keyStr, TclGetString(objv[srcIndex])));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_STRING:
	    if (objc == 0) {
		goto missingArg;
	    }
	    *((const char **) infoPtr->dstPtr) =
		    TclGetString(objv[srcIndex]);
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_REST:
	    /*
	     * Only store the point where we got to if it's not to be written
	     * to NULL, so that TCL_ARGV_AUTO_REST works.
	     */

	    if (infoPtr->dstPtr != NULL) {
		*((int *) infoPtr->dstPtr) = dstIndex;
	    }
	    goto argsDone;
	case TCL_ARGV_FLOAT:
	    if (objc == 0) {
		goto missingArg;
	    }
	    if (Tcl_GetDoubleFromObj(interp, objv[srcIndex],
		    (double *) infoPtr->dstPtr) == TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected floating-point argument for \"%s\" but got \"%s\"",
			infoPtr->keyStr, TclGetString(objv[srcIndex])));
		goto error;
	    }
	    srcIndex++;
	    objc--;
	    break;
	case TCL_ARGV_FUNC: {
	    Tcl_ArgvFuncProc *handlerProc = (Tcl_ArgvFuncProc *)
		    infoPtr->srcPtr;
	    Tcl_Obj *argObj;

	    if (objc == 0) {
		argObj = NULL;
	    } else {
		argObj = objv[srcIndex];
	    }
	    if (handlerProc(infoPtr->clientData, argObj, infoPtr->dstPtr)) {
		srcIndex++;
		objc--;
	    }
	    break;
	}
	case TCL_ARGV_GENFUNC: {
	    Tcl_ArgvGenFuncProc *handlerProc = (Tcl_ArgvGenFuncProc *)
		    infoPtr->srcPtr;

	    objc = handlerProc(infoPtr->clientData, interp, objc,
		    &objv[srcIndex], infoPtr->dstPtr);
	    if (objc < 0) {
		goto error;
	    }
	    break;
	}
	case TCL_ARGV_HELP:
	    PrintUsage(interp, argTable);
	    goto error;
	default:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "bad argument type %d in Tcl_ArgvInfo", infoPtr->type));
	    goto error;
	}
    }

    /*
     * If we broke out of the loop because of an OPT_REST argument, copy the
     * remaining arguments down. Note that there is always at least one
     * argument left over - the command name - so we always have a result if
     * our caller is willing to receive it. [Bug 3413857]
     */

  argsDone:
    if (remObjv == NULL) {
	/*
	 * Nothing to do.
	 */

	return TCL_OK;
    }

    if (objc > 0) {
	memcpy(leftovers+nrem, objv+srcIndex, objc*sizeof(Tcl_Obj *));
	nrem += objc;
    }
    leftovers[nrem] = NULL;
    *objcPtr = nrem++;
    *remObjv = (Tcl_Obj **)Tcl_Realloc(leftovers, nrem * sizeof(Tcl_Obj *));
    return TCL_OK;

    /*
     * Make sure to handle freeing any temporary space we've allocated on the
     * way to an error.
     */

  missingArg:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "\"%s\" option requires an additional argument", str));
  error:
    if (leftovers != NULL) {
	Tcl_Free(leftovers);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * PrintUsage --
 *
 *	Generate a help string describing command-line options.
 *
 * Results:
 *	The interp's result will be modified to hold a help string describing
 *	all the options in argTable.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
PrintUsage(
    Tcl_Interp *interp,		/* Place information in this interp's result
				 * area. */
    const Tcl_ArgvInfo *argTable)
				/* Array of command-specific argument
				 * descriptions. */
{
    const Tcl_ArgvInfo *infoPtr;
    int width, numSpaces;
#define NUM_SPACES 20
    static const char spaces[] = "                    ";
    char tmp[TCL_DOUBLE_SPACE];
    Tcl_Obj *msg;

    /*
     * First, compute the width of the widest option key, so that we can make
     * everything line up.
     */

    width = 4;
    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
	size_t length;

	if (infoPtr->keyStr == NULL) {
	    continue;
	}
	length = strlen(infoPtr->keyStr);
	if (length > (size_t)width) {
	    width = length;
	}
    }

    /*
     * Now add the option information, with pretty-printing.
     */

    msg = Tcl_NewStringObj("Command-specific options:", -1);
    for (infoPtr = argTable; infoPtr->type != TCL_ARGV_END; infoPtr++) {
	if ((infoPtr->type == TCL_ARGV_HELP) && (infoPtr->keyStr == NULL)) {
	    Tcl_AppendPrintfToObj(msg, "\n%s", infoPtr->helpStr);
	    continue;
	}
	Tcl_AppendPrintfToObj(msg, "\n %s:", infoPtr->keyStr);
	numSpaces = width + 1 - strlen(infoPtr->keyStr);
	while (numSpaces > 0) {
	    if (numSpaces >= NUM_SPACES) {
		Tcl_AppendToObj(msg, spaces, NUM_SPACES);
	    } else {
		Tcl_AppendToObj(msg, spaces, numSpaces);
	    }
	    numSpaces -= NUM_SPACES;
	}
	Tcl_AppendToObj(msg, infoPtr->helpStr, -1);
	switch (infoPtr->type) {
	case TCL_ARGV_INT:
	    Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %d",
		    *((int *) infoPtr->dstPtr));
	    break;
	case TCL_ARGV_FLOAT:
	    Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
		    *((double *) infoPtr->dstPtr));
	    sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
	    break;
	case TCL_ARGV_STRING: {
	    char *string = *((char **) infoPtr->dstPtr);

	    if (string != NULL) {
		Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: \"%s\"",
			string);
	    }
	    break;
	}
	default:
	    break;
	}
    }
    Tcl_SetObjResult(interp, msg);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetCompletionCodeFromObj --
 *
 *	Parses Completion code Code
 *
 * Results:
 *	Returns TCL_ERROR if the value is an invalid completion code.
 *	Otherwise, returns TCL_OK, and writes the completion code to the
 *	pointer provided.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetCompletionCodeFromObj(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *value,
    int *codePtr)		/* Argument objects. */
{
    static const char *const returnCodes[] = {
	"ok", "error", "return", "break", "continue", NULL
    };

    if (!TclHasIntRep(value, &indexType)
	    && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
	return TCL_OK;
    }
    if (Tcl_GetIndexFromObj(NULL, value, returnCodes, NULL, TCL_EXACT,
	    codePtr) == TCL_OK) {
	return TCL_OK;
    }

    /*
     * Value is not a legal completion code.
     */

    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad completion code \"%s\": must be"
		" ok, error, return, break, continue, or an integer",
		TclGetString(value)));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_CODE", NULL);
    }
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclInt.decls.

13
14
15
16
17
18
19

20
21
22
23
24
25
26
13
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
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:
44
45
46
47
48
49
50
51

52
53
54
55
56



57

58
59
60
61
62
63
64
45
46
47
48
49
50
51

52
53




54
55
56

57
58
59
60
61
62
63
64







-
+

-
-
-
-
+
+
+
-
+







    int TclCleanupChildren(Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr,
	    Tcl_Channel errorChan)
}
declare 6 {
    void TclCleanupCommand(Command *cmdPtr)
}
declare 7 {
    size_t TclCopyAndCollapse(size_t count, const char *src, char *dst)
    int TclCopyAndCollapse(int count, const char *src, char *dst)
}
# Removed in 9.0:
#declare 8 {
#    int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
#	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
declare 8 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
	    Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
#}
}

# TclCreatePipeline unofficially exported for use by BLT.

declare 9 {
    int TclCreatePipeline(Tcl_Interp *interp, int argc, const char **argv,
	    Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr,
	    TclFile *errFilePtr)
76
77
78
79
80
81
82
83

84
85
86
87
88
89
90
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90







-
+







}
# Removed in 8.5:
#declare 13 {
#    int TclDoGlob(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
#}
declare 14 {
    int TclDumpMemoryInfo(void *clientData, int flags)
    int TclDumpMemoryInfo(ClientData clientData, int flags)
}
# Removed in 8.1:
#  declare 15 {
#      void TclExpandParseValue(ParseValue *pvPtr, int needed)
#  }
declare 16 {
    void TclExprFloatError(Tcl_Interp *interp, double value)
104
105
106
107
108
109
110
111

112
113
114
115
116
117
118

119
120
121
122
123
124
125
104
105
106
107
108
109
110

111
112
113
114
115
116
117

118
119
120
121
122
123
124
125







-
+






-
+







#}
#declare 21 {
#    int TclFileRenameCmd(Tcl_Interp *interp, int argc, char **argv)
#}
declare 22 {
    int TclFindElement(Tcl_Interp *interp, const char *listStr,
	    int listLength, const char **elementPtr, const char **nextPtr,
	    size_t *sizePtr, int *bracePtr)
	    int *sizePtr, int *bracePtr)
}
declare 23 {
    Proc *TclFindProc(Interp *iPtr, const char *procName)
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
    size_t TclFormatInt(char *buffer, Tcl_WideInt n)
    int TclFormatInt(char *buffer, long n)
}
declare 25 {
    void TclFreePackageInfo(Interp *iPtr)
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)
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
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







-
-
-
-
+
+
+
-
+





-
-
-
+
+
-
+

-
+

















-
+







    int TclGetFrame(Tcl_Interp *interp, const char *str,
	    CallFrame **framePtrPtr)
}
# Removed in 8.5:
#declare 33 {
#    TclCmdProcType TclGetInterpProc(void)
#}
# Removed in 9.0:
#declare 34 {deprecated {Use Tcl_GetIntForIndex}} {
#    int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
#	    int endValue, int *indexPtr)
declare 34 {
    int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    int endValue, int *indexPtr)
#}
}
# Removed in 8.4b2:
#declare 35 {
#    Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    int flags)
#}
# Removed in 8.6a2:
#declare 36 {
#    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
declare 36 {
    int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
}
declare 37 {
    int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName)
    int TclGetLoadedPackages(Tcl_Interp *interp, char *targetName)
}
declare 38 {
    int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName,
	    Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr,
	    Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr,
	    const char **simpleNamePtr)
}
declare 39 {
    TclObjCmdProcType TclGetObjInterpProc(void)
}
declare 40 {
    int TclGetOpenMode(Tcl_Interp *interp, const char *str, int *seekFlagPtr)
}
declare 41 {
    Tcl_Command TclGetOriginalCommand(Tcl_Command command)
}
declare 42 {
    const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
    char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
# Removed in 8.5a2:
#declare 43 {
#    int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 44 {
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
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







-
-
-
-
+
+
+
-
+









-
-
+
+


-
+







#    Tcl_Obj *TclIncrIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    long incrAmount)
#}
#declare 49 {
#    Tcl_Obj *TclIncrVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
#	    Tcl_Obj *part2Ptr, long incrAmount, int part1NotParsed)
#}
# Removed in 9.0:
#declare 50 {
#    void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr,
#	    Namespace *nsPtr)
declare 50 {
    void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr,
	    Namespace *nsPtr)
#}
}
declare 51 {
    int TclInterpInit(Tcl_Interp *interp)
}
# Removed in 8.5a2:
#declare 52 {
#    int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
#	    int flags)
#}
declare 53 {
    int TclInvokeObjectCommand(void *clientData, Tcl_Interp *interp,
	    int argc, const char **argv)
    int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
	    int argc, CONST84 char **argv)
}
declare 54 {
    int TclInvokeStringCommand(void *clientData, Tcl_Interp *interp,
    int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 55 {
    Proc *TclIsProc(Command *cmdPtr)
}
# Replaced with TclpLoadFile in 8.1:
#  declare 56 {
265
266
267
268
269
270
271
272

273
274
275
276
277
278
279
262
263
264
265
266
267
268

269
270
271
272
273
274
275
276







-
+







declare 61 {
    Tcl_Obj *TclNewProcBodyObj(Proc *procPtr)
}
declare 62 {
    int TclObjCommandComplete(Tcl_Obj *cmdPtr)
}
declare 63 {
    int TclObjInterpProc(void *clientData, Tcl_Interp *interp,
    int TclObjInterpProc(ClientData clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 64 {
    int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
	    int flags)
}
# Removed in 8.5a2:
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
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







-
+















-
+


-
+


-
+


-
-
-
+
+
+
-
-
-
-
+
+
+
-
+










-
+







#    int TclOpenFileChannelInsertProc(TclOpenFileChannelProc_ *proc)
#}
# Replaced by Tcl_FSAccess in 8.4:
#declare 68 {
#    int TclpAccess(const char *path, int mode)
#}
declare 69 {
    void *TclpAlloc(size_t size)
    char *TclpAlloc(unsigned int size)
}
#declare 70 {
#    int TclpCopyFile(const char *source, const char *dest)
#}
#declare 71 {
#    int TclpCopyDirectory(const char *source, const char *dest,
#	    Tcl_DString *errorPtr)
#}
#declare 72 {
#    int TclpCreateDirectory(const char *path)
#}
#declare 73 {
#    int TclpDeleteFile(const char *path)
#}
declare 74 {
    void TclpFree(void *ptr)
    void TclpFree(char *ptr)
}
declare 75 {
    Tcl_WideUInt TclpGetClicks(void)
    unsigned long TclpGetClicks(void)
}
declare 76 {
    Tcl_WideUInt TclpGetSeconds(void)
    unsigned long TclpGetSeconds(void)
}

# Removed in 9.0:
#declare 77 {
#    void TclpGetTime(Tcl_Time *time)
# deprecated
declare 77 {
    void TclpGetTime(Tcl_Time *time)
#}
# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long 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,
#	    char *modeString, int permissions)
#}
declare 81 {
    void *TclpRealloc(void *ptr, size_t size)
    char *TclpRealloc(char *ptr, unsigned int size)
}
#declare 82 {
#    int TclpRemoveDirectory(const char *path, int recursive,
#	    Tcl_DString *errorPtr)
#}
#declare 83 {
#    int TclpRenameFile(const char *source, const char *dest)
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
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







-
-
-
-
+
+
+
-
+

















-
+







#  declare 86 {
#      int TclParseQuotes(Tcl_Interp *interp, char *str, int termChar,
#  	    int flags, char **termPtr, ParseValue *pvPtr)
#  }
#  declare 87 {
#      void TclPlatformInit(Tcl_Interp *interp)
#  }
# Removed in 9.0:
#declare 88 {
#    char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp,
#	    const char *name1, const char *name2, int flags)
declare 88 {
    char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
	    const char *name1, const char *name2, int flags)
#}
}
declare 89 {
    int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp,
	    Tcl_Command cmd)
}
# Removed in 8.1 (only available if compiled with TCL_COMPILE_DEBUG):
#  declare 90 {
#      void TclPrintByteCodeObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#  }
declare 91 {
    void TclProcCleanupProc(Proc *procPtr)
}
declare 92 {
    int TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
	    Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description,
	    const char *procName)
}
declare 93 {
    void TclProcDeleteProc(void *clientData)
    void TclProcDeleteProc(ClientData clientData)
}
# Removed in 8.5:
#declare 94 {
#    int TclProcInterpProc(void *clientData, Tcl_Interp *interp,
#	    int argc, const char **argv)
#}
# Replaced by Tcl_FSStat in 8.4:
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
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







-
+








-
-
-
+
+
-
+







#}
# Removed in 8.4b2:
#declare 100 {
#    Tcl_Obj *TclSetIndexedScalar(Tcl_Interp *interp, int localIndex,
#	    Tcl_Obj *objPtr, int flags)
#}
declare 101 {
    const char *TclSetPreInitScript(const char *string)
    char *TclSetPreInitScript(char *string)
}
declare 102 {
    void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
	    int *portPtr)
}
# Removed in 9.0:
#declare 104 {
#    int TclSockMinimumBuffersOld(int sock, int size)
declare 104 {
    int TclSockMinimumBuffersOld(int 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)
#}
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



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
611
612
613
614
615
616
617
618
619
620


621
622
623
624
625
626
627
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
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







-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
+












-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
+




-
-
-
-
+
+
+
-
+


















-
-
-
+
+
-
+















-
+











-
+



-
+










-
+




















-
-
+
+







# defined here instead of in tcl.decls since they are not stable yet.

declare 111 {
    void Tcl_AddInterpResolvers(Tcl_Interp *interp, const char *name,
	    Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
	    Tcl_ResolveCompiledVarProc *compiledVarProc)
}
# Removed in 9.0:
#declare 112 {
#    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    Tcl_Obj *objPtr)
declare 112 {
    int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 113 {
#    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
#	    void *clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 113 {
    Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
	    ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
#}
# Removed in 9.0:
#declare 114 {
#    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 114 {
    void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
#}
# Removed in 9.0:
#declare 115 {
#    int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern, int resetListFirst)
}
declare 115 {
    int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern, int resetListFirst)
#}
# Removed in 9.0:
#declare 116 {
#    Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
#	    Tcl_Namespace *contextNsPtr, int flags)
}
declare 116 {
    Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)
#}
# Removed in 9.0:
#declare 117 {
#    Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
#	    Tcl_Namespace *contextNsPtr, int flags)
}
declare 117 {
    Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)
#}
}
declare 118 {
    int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name,
	    Tcl_ResolverInfo *resInfo)
}
declare 119 {
    int Tcl_GetNamespaceResolvers(Tcl_Namespace *namespacePtr,
	    Tcl_ResolverInfo *resInfo)
}
declare 120 {
    Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name,
	    Tcl_Namespace *contextNsPtr, int flags)
}
# Removed in 9.0:
#declare 121 {
#    int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern)
declare 121 {
    int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern)
#}
# Removed in 9.0:
#declare 122 {
#    Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 122 {
    Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 123 {
#    void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
#	    Tcl_Obj *objPtr)
}
declare 123 {
    void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
	    Tcl_Obj *objPtr)
#}
# Removed in 9.0:
#declare 124 {
#    Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
}
declare 124 {
    Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
#}
# Removed in 9.0:
#declare 125 {
#    Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
}
declare 125 {
    Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
#}
}
declare 126 {
    void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
	    Tcl_Obj *objPtr)
}
# Removed in 9.0:
#declare 127 {
#    int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
#	    const char *pattern, int allowOverwrite)
declare 127 {
    int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	    const char *pattern, int allowOverwrite)
#}
}
declare 128 {
    void Tcl_PopCallFrame(Tcl_Interp *interp)
}
declare 129 {
    int Tcl_PushCallFrame(Tcl_Interp *interp, Tcl_CallFrame *framePtr,
	    Tcl_Namespace *nsPtr, int isProcCallFrame)
}
declare 130 {
    int Tcl_RemoveInterpResolvers(Tcl_Interp *interp, const char *name)
}
declare 131 {
    void Tcl_SetNamespaceResolvers(Tcl_Namespace *namespacePtr,
	    Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc,
	    Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 132 {
    int TclpHasSockets(Tcl_Interp *interp)
}
# Removed in 9.0
#declare 133 {
#    struct tm *TclpGetDate(const time_t *time, int useGMT)
declare 133 {
    struct tm *TclpGetDate(const time_t *time, int useGMT)
#}
}
# Removed in 8.5
#declare 134 {
#    size_t TclpStrftime(char *s, size_t maxsize, const char *format,
#	    const struct tm *t, int useGMT)
#}
#declare 135 {
#    int TclpCheckStackSpace(void)
#}

# Added in 8.1:

#declare 137 {
#   int TclpChdir(const char *dirName)
#}
declare 138 {
    const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
    CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
#    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
#	    Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr)
#}
#declare 140 {
#    int TclLooksLikeInt(const char *bytes, int length)
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
    const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
    CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
    int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    CompileHookProc *hookProc, void *clientData)
	    CompileHookProc *hookProc, ClientData clientData)
}
declare 143 {
    int TclAddLiteralObj(struct CompileEnv *envPtr, Tcl_Obj *objPtr,
	    LiteralEntry **litPtrPtr)
}
declare 144 {
    void TclHideLiteral(Tcl_Interp *interp, struct CompileEnv *envPtr,
	    int index)
}
declare 145 {
    const struct AuxDataType *TclGetAuxDataType(const char *typeName)
    struct AuxDataType *TclGetAuxDataType(char *typeName)
}
declare 146 {
    TclHandle TclHandleCreate(void *ptr)
}
declare 147 {
    void TclHandleFree(TclHandle handle)
}
declare 148 {
    TclHandle TclHandlePreserve(TclHandle handle)
}
declare 149 {
    void TclHandleRelease(TclHandle handle)
}

# Added for Tcl 8.2

declare 150 {
    int TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re)
}
declare 151 {
    void TclRegExpRangeUniChar(Tcl_RegExp re, size_t index, size_t *startPtr,
	    size_t *endPtr)
    void TclRegExpRangeUniChar(Tcl_RegExp re, int index, int *startPtr,
	    int *endPtr)
}
declare 152 {
    void TclSetLibraryPath(Tcl_Obj *pathPtr)
}
declare 153 {
    Tcl_Obj *TclGetLibraryPath(void)
}
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
620
621
622
623
624
625
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







-
-
-
+
+
-
-
-
-
+
+
+
-
+












-
+








-
+







declare 156 {
    void TclRegError(Tcl_Interp *interp, const char *msg,
	    int status)
}
declare 157 {
    Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
# REMOVED - use public Tcl_SetStartupScript()
#declare 158 {
#    void TclSetStartupScriptFileName(const char *filename)
declare 158 {
    void TclSetStartupScriptFileName(const char *filename)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 159 {
#    const char *TclGetStartupScriptFileName(void)
}
declare 159 {
    CONST84_RETURN char *TclGetStartupScriptFileName(void)
#}
}
#declare 160 {
#    int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators,
#	    Tcl_DString *dirPtr, char *pattern, char *tail,
#	    GlobTypeData *types)
#}

# new in 8.3.2/8.4a2
declare 161 {
    int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan,
	    Tcl_Obj *cmdObjPtr)
}
declare 162 {
    void TclChannelEventScriptInvoker(void *clientData, int flags)
    void TclChannelEventScriptInvoker(ClientData clientData, int flags)
}

# ALERT: The result of 'TclGetInstructionTable' is actually a
# "const InstructionDesc*" but we do not want to describe this structure in
# "tclInt.h". It is described in "tclCompile.h". Use a cast to the
# correct type when calling this procedure.

declare 163 {
    const void *TclGetInstructionTable(void)
    void *TclGetInstructionTable(void)
}

# ALERT: The argument of 'TclExpandCodeArray' is actually a
# "CompileEnv*" but we do not want to describe this structure in
# "tclInt.h". It is described in "tclCompile.h".

declare 164 {
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
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







-
-
-
+
+
-
-
-
-
+
+
+
-
+


-
+



-
+




-
+









-
-
+
+







# New function due to TIP #33
declare 166 {
    int TclListObjSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr,
	    int index, Tcl_Obj *valuePtr)
}

# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
# REMOVED - use public Tcl_SetStartupScript()
#declare 167 {
#    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
declare 167 {
    void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
#}
# REMOVED - use public Tcl_GetStartupScript()
#declare 168 {
#    Tcl_Obj *TclGetStartupScriptPath(void)
}
declare 168 {
    Tcl_Obj *TclGetStartupScriptPath(void)
#}
}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
    int TclpUtfNcmp2(const char *s1, const char *s2, size_t n)
    int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
	    size_t numChars, Command *cmdPtr, int result, int traceFlags,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 171 {
    int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command,
	    size_t numChars, Command *cmdPtr, int result, int traceFlags,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 172 {
    int TclInThreadExit(void)
}

# added for 8.4.2

declare 173 {
    int TclUniCharMatch(const Tcl_UniChar *string, size_t strLen,
	    const Tcl_UniChar *pattern, size_t ptnLen, int flags)
    int TclUniCharMatch(const Tcl_UniChar *string, int strLen,
	    const Tcl_UniChar *pattern, int ptnLen, int flags)
}

# added for 8.4.3

#declare 174 {
#    Tcl_Obj *TclIncrWideVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
#	    Tcl_Obj *part2Ptr, Tcl_WideInt wideIncrAmount, int part1NotParsed)
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
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







-
-
-
+
+
-
-
-
+
+
+
-
+











+
-
-
-
+
+
+
-
-
-
-
+
+
+
-
+







declare 176 {
    void TclCleanupVar(Var *varPtr, Var *arrayPtr)
}
declare 177 {
    void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
	    const char *operation, const char *reason)
}
# TIP 338 made these public - now declared in tcl.h
#declare 178 {
#    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
declare 178 {
    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
#    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
}
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 generic interface from unix
# Removed in 9.0
#declare 182 {
#     struct tm *TclpLocaltime(const time_t *clock)

declare 182 {
     struct tm *TclpLocaltime(const time_t *clock)
#}
# Removed in 9.0
#declare 183 {
#     struct tm *TclpGmtime(const time_t *clock)
}
declare 183 {
     struct tm *TclpGmtime(const time_t *clock)
#}
}

# For the new "Thread Storage" subsystem.

### REMOVED on grounds it should never have been exposed. All these
### functions are now either static in tclThreadStorage.c or
### MODULE_SCOPE.
# declare 184 {
884
885
886
887
888
889
890
891

892
893
894
895
896
897
898
860
861
862
863
864
865
866

867
868
869
870
871
872
873
874







-
+







declare 213 {
    Tcl_Obj *TclGetObjNameOfExecutable(void)
}
declare 214 {
    void TclSetObjNameOfExecutable(Tcl_Obj *name, Tcl_Encoding encoding)
}
declare 215 {
    void *TclStackAlloc(Tcl_Interp *interp, size_t numBytes)
    void *TclStackAlloc(Tcl_Interp *interp, int numBytes)
}
declare 216 {
    void TclStackFree(Tcl_Interp *interp, void *freePtr)
}
declare 217 {
    int TclPushStackFrame(Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr,
            Tcl_Namespace *namespacePtr, int isProcCallFrame)
911
912
913
914
915
916
917
918

919
920
921
922
923
924
925



926

927
928
929
930
931
932
933
887
888
889
890
891
892
893

894
895
896





897
898
899

900
901
902
903
904
905
906
907







-
+


-
-
-
-
-
+
+
+
-
+







    Tcl_Obj *TclTraceDictPath(Tcl_Interp *interp, Tcl_Obj *rootPtr,
	    int keyc, Tcl_Obj *const keyv[], int flags)
}
declare 226 {
    int TclObjBeingDeleted(Tcl_Obj *objPtr)
}
declare 227 {
    void TclSetNsPath(Namespace *nsPtr, size_t pathLength,
    void TclSetNsPath(Namespace *nsPtr, int pathLength,
            Tcl_Namespace *pathAry[])
}
#  Used to be needed for TclOO-extension; unneeded now that TclOO is in the
#  core and NRE-enabled
#  declare 228 {
#      int TclObjInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
#             int skip, ProcErrorProc *errorProc)
declare 228 {
    int TclObjInterpProcCore(register Tcl_Interp *interp, Tcl_Obj *procNameObj,
             int skip, ProcErrorProc errorProc)
#  }
}
declare 229 {
    int	TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
	    const char *myName, int myFlags, int index)
}
declare 230 {
    Var *TclObjLookupVar(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
	    const char *part2, int flags, const char *msg,
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

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
1140
1141
1142
1143
1144
1145
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







-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
+
-



-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-

-












-
+

-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
+

-
+









-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
+

-
+

-
-
-
+
+
-
-
-
-
+
+
+
+
-
-
+
+







}
declare 235 {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}


# TIP 337 made this one public
#declare 236 {
#    void TclBackgroundException(Tcl_Interp *interp, int code)
declare 236 {
    void TclBackgroundException(Tcl_Interp *interp, int code)
#}

# TIP #285: Script cancellation support.
declare 237 {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}

# NRE functions for "rogue" extensions to exploit NRE; they will need to
# include NRE.h too.
declare 238 {
    int TclNRInterpProc(void *clientData, Tcl_Interp *interp,
	    int objc, Tcl_Obj *const objv[])
}
declare 239 {
    int TclNRInterpProcCore(Tcl_Interp *interp, Tcl_Obj *procNameObj,
			    int skip, ProcErrorProc *errorProc)
}
declare 240 {
    int TclNRRunCallbacks(Tcl_Interp *interp, int result,
	      struct NRE_callback *rootPtr)
}
declare 241 {
    int TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags,
	    const CmdFrame *invoker, int word)
}
declare 242 {
    int TclNREvalObjv(Tcl_Interp *interp, int objc,
	      Tcl_Obj *const objv[], int flags, Command *cmdPtr)
}

# Tcl_Obj leak detection support.
declare 243 {
    void TclDbDumpActiveObjects(FILE *outFile)
}

# Functions to make things better for itcl
declare 244 {
    Tcl_HashTable *TclGetNamespaceChildTable(Tcl_Namespace *nsPtr)
}
declare 245 {
    Tcl_HashTable *TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr)
}
declare 246 {
    int TclInitRewriteEnsemble(Tcl_Interp *interp, size_t numRemoved,
	    size_t numInserted, Tcl_Obj *const *objv)
}
declare 247 {
    void TclResetRewriteEnsemble(Tcl_Interp *interp, int isRootEnsemble)
}

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 TclSetChildCancelFlags(Tcl_Interp *interp, int flags, int force)
}


# Allow extensions for optimization
declare 251 {
    int TclRegisterLiteral(void *envPtr,
	    const char *bytes, size_t length, int flags)
	    char *bytes, int length, int flags)
}

# Exporting of the internal API to variables.

declare 252 {
    Tcl_Obj *TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
	    Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
	    const int flags)
}
declare 253 {
    Tcl_Obj *TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
	    Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
	    Tcl_Obj *newValuePtr, const int flags)
}
declare 254 {
    Tcl_Obj *TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr,
	    Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
	    Tcl_Obj *incrPtr, const int flags)
}
declare 255 {
    int	TclPtrObjMakeUpvar(Tcl_Interp *interp, Tcl_Var otherPtr,
	    Tcl_Obj *myNamePtr, int myFlags)
}
declare 256 {
    int	TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
	    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
declare 257 {
    void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}

# TIP 431: temporary directory creation function
declare 258 {
declare 261 {
    Tcl_Obj *TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
	    Tcl_Obj *basenameObj)
}
# TIP 542
declare 259 {
    void TclAppendUnicodeToObj(Tcl_Obj *objPtr,
	    const Tcl_UniChar *unicode, size_t length)
}

    void TclUnusedStubEntry(void)
declare 260 {
    unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
	    size_t *lengthPtr)
}


##############################################################################

# 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(int errCode)
    void TclWinConvertError(DWORD errCode)
}
# Removed in 9.0:
#declare 1 win {
#    void TclWinConvertWSAError(int errCode)
declare 1 win {
    void TclWinConvertWSAError(DWORD errCode)
#}
# Removed in 9.0:
#declare 2 win {
#    struct servent *TclWinGetServByName(const char *nm,
#	    const char *proto)
}
declare 2 win {
    struct servent *TclWinGetServByName(const char *nm,
	    const char *proto)
#}
# Removed in 9.0:
#declare 3 win {
#    int TclWinGetSockOpt(SOCKET s, int level, int optname,
#	    char *optval, int *optlen)
}
declare 3 win {
    int TclWinGetSockOpt(SOCKET s, int level, int optname,
	    char *optval, int *optlen)
#}
}
declare 4 win {
    void *TclWinGetTclInstance(void)
    HINSTANCE TclWinGetTclInstance(void)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 5 win {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}
# Removed in 8.1:
#  declare 5 win {
#      HINSTANCE TclWinLoadLibrary(char *name)
#  }
# Removed in 9.0:
#declare 6 win {
#    unsigned short TclWinNToHS(unsigned short ns)
declare 6 win {
    unsigned short TclWinNToHS(unsigned short ns)
#}
# Removed in 9.0:
#declare 7 win {
#    int TclWinSetSockOpt(SOCKET s, int level, int optname,
#	    const char *optval, int optlen)
}
declare 7 win {
    int TclWinSetSockOpt(SOCKET s, int level, int optname,
	    const char *optval, int optlen)
#}
}
declare 8 win {
    size_t TclpGetPid(Tcl_Pid pid)
    int TclpGetPid(Tcl_Pid pid)
}
# Removed in 9.0:
#declare 9 win {
#    int TclWinGetPlatformId(void)
declare 9 win {
    int TclWinGetPlatformId(void)
#}
# Removed in 9.0:
#declare 10 win {
#    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# new for 8.4.20+/8.5.12+ Cygwin only
declare 10 win {
    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
#}
# Removed in 8.3.1 (for Win32s only):
}
# Removed in 8.3.1 (for Win32s only)
#declare 10 win {
#    int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}

# Pipe channel functions

declare 11 win {
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
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







-
+

-
-
-
+
+
+
-
+









-
-
-
+
+
-
+







-
-
-
+
+
-
+









-
-
-
+
+
-
+
+
+
+







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, size_t id)
    void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
# Removed in 9.0:
#declare 21 win {
#    char *TclpInetNtoa(struct in_addr addr)
# new for 8.4.20+/8.5.12+
declare 21 win {
    char *TclpInetNtoa(struct in_addr addr)
#}
}
# 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 23 win {
    char *TclpGetTZName(int isdst)
#}
}
declare 24 win {
    char *TclWinNoBackslash(char *path)
}
# replaced by generic TclGetPlatform
#declare 25 win {
#    TclPlatformType *TclWinGetPlatform(void)
#}
# Removed in 9.0:
#declare 26 win {
#    void TclWinSetInterfaces(int wide)
declare 26 win {
    void TclWinSetInterfaces(int wide)
#}
}

# Added in Tcl 8.3.3 / 8.4

declare 27 win {
    void TclWinFlushDirtyChannels(void)
}

# Added in 8.4.2

# Removed in 9.0:
#declare 28 win {
#    void TclWinResetInterfaces(void)
declare 28 win {
    void TclWinResetInterfaces(void)
#}
}
declare 29 win {
    int TclWinCPUID(unsigned int index, unsigned int *regs)
}

################################
# Unix specific functions

# Pipe channel functions

declare 0 unix {
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
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







+
-
+
-
-
+
+


















-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
+











-
+



-
+



-
+



-
+




-
+


-
-
-
-
-
-
+
+
-
-
-
-
-





    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 {
#  declare 5 unix {
    int TclUnixWaitForFile_(int fd, int mask, int timeout)
}
#      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:

# Removed in 9.0:
#declare 10 unix {
#    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
#}
# Removed in 9.0:
#declare 11 unix {
#    struct tm *TclpLocaltime_unix(const time_t *clock)
declare 10 unix {
    Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
declare 11 unix {
    struct tm *TclpLocaltime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 12 unix {
#    struct tm *TclpGmtime_unix(const time_t *clock)
}
declare 12 unix {
    struct tm *TclpGmtime_unix(const time_t *clock)
#}
# Removed in 9.0:
#declare 13 unix {
#    char *TclpInetNtoa(struct in_addr addr)
}
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 {unix macosx} {
declare 15 macosx {
    int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
}
declare 16 {unix macosx} {
declare 16 macosx {
    int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj *attributePtr)
}
declare 17 {unix macosx} {
declare 17 macosx {
    int TclMacOSXCopyFileAttributes(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr)
}
declare 18 {unix macosx} {
declare 18 macosx {
    int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
	    const char *fileName, Tcl_StatBuf *statBufPtr,
	    Tcl_GlobTypeData *types)
}
declare 19 {unix macosx} {
declare 19 macosx {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}
declare 22 {unix macosx} {
    TclFile TclpCreateTempFile_(const char *contents)
}

declare 29 {win unix} {
    int TclWinCPUID(int index, int *regs)
declare 29 unix {
    int TclWinCPUID(unsigned int index, unsigned int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
    int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj, Tcl_Obj *basenameObj,
	    Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj)
}

# Local Variables:
# mode: tcl
# End:

Changes to generic/tclInt.h.

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
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











-
-












+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+
+







-










-
-
+
+
+
+


-
-







/*
 * tclInt.h --
 *
 *	Declarations of things used internally by the Tcl interpreter.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 by Miguel Sofer. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLINT
#define _TCLINT

/*
 * Some numerics configuration options.
 */

#undef NO_WIDE_TYPE
#undef ACCEPT_NAN

/*
 * Used to tag functions that are only to be visible within the module being
 * built and not outside it (where this is supported by the linker).
 * Also used in the platform-specific *Port.h files.
 */

#ifndef MODULE_SCOPE
#   ifdef __cplusplus
#	define MODULE_SCOPE extern "C"
#   else
#	define MODULE_SCOPE extern
#   endif
#endif

#ifndef JOIN
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
#endif

#if defined(__cplusplus)
#   define TCL_UNUSED(T) T
#elif defined(__GNUC__) && (__GNUC__ > 2)
#   define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
#else
#   define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
#endif

/*
 * Common include files needed by most of the Tcl source files are included
 * here, so that system-dependent personalizations for the include files only
 * have to be made in once place. This results in a few extra includes, but
 * greater modularity. The order of the three groups of #includes is
 * important. For example, stdio.h is needed by tcl.h.
 * important. For example, stdio.h is needed by tcl.h, and the _ANSI_ARGS_
 * declaration in tcl.h is needed by stdlib.h in some configurations.
 */

#include "tclPort.h"

#include <stdio.h>

#include <ctype.h>
#include <stdarg.h>
#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif
#ifdef NO_STRING_H
#include "../compat/string.h"
#else
#include <string.h>
#endif
#if !defined(STDC_HEADERS) && !defined(__STDC__) && !defined(__C99__FUNC__) \
     && !defined(__cplusplus) && !defined(_MSC_VER) && !defined(__ICC)
#if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \
     || defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC)
#include <stddef.h>
#else
typedef int ptrdiff_t;
#endif
#include <stddef.h>
#include <locale.h>

/*
 * Ensure WORDS_BIGENDIAN is defined correctly:
 * Needs to happen here in addition to configure to work with fat compiles on
 * Darwin (where configure runs only once for multiple architectures).
 */

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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+


-
+





-
+


-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#    ifdef LITTLE_ENDIAN
#	 if BYTE_ORDER == LITTLE_ENDIAN
#	     undef WORDS_BIGENDIAN
#	 endif
#    endif
#endif

/*
 * Used to tag functions that are only to be visible within the module being
 * built and not outside it (where this is supported by the linker).
 */

#ifndef MODULE_SCOPE
#   ifdef __cplusplus
#	define MODULE_SCOPE extern "C"
#   else
#	define MODULE_SCOPE extern
#   endif
#endif

/*
 * When Tcl_WideInt and long are the same type, there's no value in
 * having a tclWideIntType separate from the tclIntType.
 */
#ifdef TCL_WIDE_INT_IS_LONG
#define NO_WIDE_TYPE
#endif

/*
 * Macros used to cast between pointers and integers (e.g. when storing an int
 * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
 * to/from pointer from/to integer of different size".
 */

#if !defined(INT2PTR) && !defined(PTR2INT)
#   if defined(HAVE_INTPTR_T) || defined(intptr_t)
#	define INT2PTR(p) ((void *)(intptr_t)(p))
#	define PTR2INT(p) ((intptr_t)(p))
#	define PTR2INT(p) ((int)(intptr_t)(p))
#   else
#	define INT2PTR(p) ((void *)(p))
#	define PTR2INT(p) ((long)(p))
#	define PTR2INT(p) ((int)(p))
#   endif
#endif
#if !defined(UINT2PTR) && !defined(PTR2UINT)
#   if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
#	define UINT2PTR(p) ((void *)(uintptr_t)(p))
#	define PTR2UINT(p) ((uintptr_t)(p))
#	define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
#   else
#	define UINT2PTR(p) ((void *)(p))
#	define PTR2UINT(p) ((unsigned long)(p))
#	define PTR2UINT(p) ((unsigned int)(p))
#   endif
#endif

#if defined(_WIN32) && defined(_MSC_VER)
#   define vsnprintf _vsnprintf
#endif

#if !defined(TCL_THREADS)
#   define TCL_THREADS 1
#endif
#if !TCL_THREADS
#   undef TCL_DECLARE_MUTEX
#   define TCL_DECLARE_MUTEX(name)
#   undef  Tcl_MutexLock
#   define Tcl_MutexLock(mutexPtr)
#   undef  Tcl_MutexUnlock
#   define Tcl_MutexUnlock(mutexPtr)
#   undef  Tcl_MutexFinalize
#   define Tcl_MutexFinalize(mutexPtr)
#   undef  Tcl_ConditionNotify
#   define Tcl_ConditionNotify(condPtr)
#   undef  Tcl_ConditionWait
#   define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#   undef  Tcl_ConditionFinalize
#   define Tcl_ConditionFinalize(condPtr)
#endif

/*
 * The following procedures allow namespaces to be customized to support
 * special name resolution rules for commands/variables.
 */

struct Tcl_ResolvedVarInfo;

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
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







-
+


-
+


-
+















-
-
-
-
-
-
-
-
-
-
-
-








typedef struct Tcl_ResolvedVarInfo {
    Tcl_ResolveRuntimeVarProc *fetchProc;
    Tcl_ResolveVarDeleteProc *deleteProc;
} Tcl_ResolvedVarInfo;

typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
	const char *name, int length, Tcl_Namespace *context,
	CONST84 char *name, int length, Tcl_Namespace *context,
	Tcl_ResolvedVarInfo **rPtr);

typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
	Tcl_Namespace *context, int flags, Tcl_Var *rPtr);

typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
	Tcl_Namespace *context, int flags, Tcl_Command *rPtr);

typedef struct Tcl_ResolverInfo {
    Tcl_ResolveCmdProc *cmdResProc;
				/* Procedure handling command name
				 * resolution. */
    Tcl_ResolveVarProc *varResProc;
				/* Procedure handling variable name resolution
				 * for variables that can only be handled at
				 * runtime. */
    Tcl_ResolveCompiledVarProc *compiledVarResProc;
				/* Procedure handling variable name resolution
				 * at compile time. */
} Tcl_ResolverInfo;

/*
 * This flag bit should not interfere with TCL_GLOBAL_ONLY,
 * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
 * lookup is performed for upvar (or similar) purposes, with slightly
 * different rules:
 *    - Bug #696893 - variable is either proc-local or in the current
 *	namespace; never follow the second (global) resolution path
 *    - Bug #631741 - do not use special namespace or interp resolvers
 */

#define TCL_AVOID_RESOLVERS 0x40000

/*
 *----------------------------------------------------------------
 * Data structures related to namespaces.
 *----------------------------------------------------------------
 */

typedef struct Tcl_Ensemble Tcl_Ensemble;
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
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







-
-
-
-
-
-
-
-















-
+







-


-
-
-
-
-
-
-
-
+
+



-
+



-
+




















-
+

-
+

-
+




-
+







/*
 * This is for itcl - it likes to search our varTables directly :(
 */

#define TclVarHashFindVar(tablePtr, key) \
    TclVarHashCreateVar((tablePtr), (key), NULL)

/*
 * Define this to reduce the amount of space that the average namespace
 * consumes by only allocating the table of child namespaces when necessary.
 * Defining it breaks compatibility for Tcl extensions (e.g., itcl) which
 * reach directly into the Namespace structure.
 */

#undef BREAK_NAMESPACE_COMPAT

/*
 * The structure below defines a namespace.
 * Note: the first five fields must match exactly the fields in a
 * Tcl_Namespace structure (see tcl.h). If you change one, be sure to change
 * the other.
 */

typedef struct Namespace {
    char *name;			/* The namespace's simple (unqualified) name.
				 * This contains no ::'s. The name of the
				 * global namespace is "" although "::" is an
				 * synonym. */
    char *fullName;		/* The namespace's fully qualified name. This
				 * starts with ::. */
    void *clientData;	/* An arbitrary value associated with this
    ClientData clientData;	/* An arbitrary value associated with this
				 * namespace. */
    Tcl_NamespaceDeleteProc *deleteProc;
				/* Procedure invoked when deleting the
				 * namespace to, e.g., free clientData. */
    struct Namespace *parentPtr;/* Points to the namespace that contains this
				 * one. NULL if this is the global
				 * namespace. */
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_HashTable childTable;	/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). */
#else
    Tcl_HashTable *childTablePtr;
				/* Contains any child namespaces. Indexed by
				 * strings; values have type (Namespace *). If
				 * NULL, there are no children. */
#endif
    size_t nsId;		/* Unique id for the namespace. */
    Tcl_Interp *interp;	/* The interpreter containing this
    long nsId;			/* Unique id for the namespace. */
    Tcl_Interp *interp;		/* The interpreter containing this
				 * namespace. */
    int flags;			/* OR-ed combination of the namespace status
				 * flags NS_DYING and NS_DEAD listed below. */
    size_t activationCount;	/* Number of "activations" or active call
    int activationCount;	/* Number of "activations" or active call
				 * frames for this namespace that are on the
				 * Tcl call stack. The namespace won't be
				 * freed until activationCount becomes zero. */
    size_t refCount;		/* Count of references by namespaceName
    int refCount;		/* Count of references by namespaceName
				 * objects. The namespace can't be freed until
				 * refCount becomes zero. */
    Tcl_HashTable cmdTable;	/* Contains all the commands currently
				 * registered in the namespace. Indexed by
				 * strings; values have type (Command *).
				 * Commands imported by Tcl_Import have
				 * Command structures that point (via an
				 * ImportedCmdRef structure) to the Command
				 * structure in the source namespace's command
				 * table. */
    TclVarHashTable varTable;	/* Contains all the (global) variables
				 * currently in this namespace. Indexed by
				 * strings; values have type (Var *). */
    char **exportArrayPtr;	/* Points to an array of string patterns
				 * specifying which commands are exported. A
				 * pattern may include "string match" style
				 * wildcard characters to specify multiple
				 * commands; however, no namespace qualifiers
				 * are allowed. NULL if no export patterns are
				 * registered. */
    size_t numExportPatterns;	/* Number of export patterns currently
    int numExportPatterns;	/* Number of export patterns currently
				 * registered using "namespace export". */
    size_t maxExportPatterns;	/* Number of export patterns for which space
    int maxExportPatterns;	/* Mumber of export patterns for which space
				 * is currently allocated. */
    size_t cmdRefEpoch;		/* Incremented if a newly added command
    int cmdRefEpoch;		/* Incremented if a newly added command
				 * shadows a command for which this namespace
				 * has already cached a Command* pointer; this
				 * causes all its cached Command* pointers to
				 * be invalidated. */
    size_t resolverEpoch;	/* Incremented whenever (a) the name
    int resolverEpoch;		/* Incremented whenever (a) the name
				 * resolution rules change for this namespace
				 * or (b) a newly added command shadows a
				 * command that is compiled to bytecodes. This
				 * invalidates all byte codes compiled in the
				 * namespace, causing the code to be
				 * recompiled under the new rules.*/
    Tcl_ResolveCmdProc *cmdResProc;
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
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







-
+










-
+






-
-
-
-
-
-







    Tcl_ResolveCompiledVarProc *compiledVarResProc;
				/* If non-null, this procedure overrides the
				 * usual variable resolution mechanism in Tcl.
				 * This procedure is invoked within
				 * LookupCompiledLocal to resolve variable
				 * references within the namespace at compile
				 * time. */
    size_t exportLookupEpoch;	/* Incremented whenever a command is added to
    int exportLookupEpoch;	/* Incremented whenever a command is added to
				 * a namespace, removed from a namespace or
				 * the exports of a namespace are changed.
				 * Allows TIP#112-driven command lists to be
				 * validated efficiently. */
    Tcl_Ensemble *ensembles;	/* List of structures that contain the details
				 * of the ensembles that are implemented on
				 * top of this namespace. */
    Tcl_Obj *unknownHandlerPtr;	/* A script fragment to be used when command
				 * resolution in this namespace fails. TIP
				 * 181. */
    size_t commandPathLength;	/* The length of the explicit path. */
    int commandPathLength;	/* The length of the explicit path. */
    NamespacePathEntry *commandPathArray;
				/* The explicit path of the namespace as an
				 * array. */
    NamespacePathEntry *commandPathSourceList;
				/* Linked list of path entries that point to
				 * this namespace. */
    Tcl_NamespaceDeleteProc *earlyDeleteProc;
				/* Just like the deleteProc field (and called
				 * with the same clientData) but called at the
				 * start of the deletion process, so there is
				 * a chance for code to do stuff inside the
				 * namespace before deletion completes. */
} Namespace;

/*
 * An entry on a namespace's command resolution path.
 */

struct NamespacePathEntry {
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
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
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
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







-
-
+
+
-
-
-





-














-
-
+
+
-
-
-
+


-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
+


















-
+






-
+







 *		namespace and no call frames still refer to it. Its variables
 *		and command have already been destroyed. This bit allows the
 *		namespace resolution code to recognize that the namespace is
 *		"deleted". When the last namespaceName object in any byte code
 *		unit that refers to the namespace has been freed (i.e., when
 *		the namespace's refCount is 0), the namespace's storage will
 *		be freed.
 * NS_KILLED -	1 means that TclTeardownNamespace has already been called on
 *		this namespace and it should not be called again [Bug 1355942]
 * NS_KILLED    1 means that TclTeardownNamespace has already been called on
 *              this namespace and it should not be called again [Bug 1355942]
 * NS_SUPPRESS_COMPILATION -
 *		Marks the commands in this namespace for not being compiled,
 *		forcing them to be looked up every time.
 */

#define NS_DYING	0x01
#define NS_DEAD		0x02
#define NS_KILLED	0x04
#define NS_SUPPRESS_COMPILATION	0x08

/*
 * Flags passed to TclGetNamespaceForQualName:
 *
 * TCL_GLOBAL_ONLY		- (see tcl.h) Look only in the global ns.
 * TCL_NAMESPACE_ONLY		- (see tcl.h) Look only in the context ns.
 * TCL_CREATE_NS_IF_UNKNOWN	- Create unknown namespaces.
 * TCL_FIND_ONLY_NS		- The name sought is a namespace name.
 */

#define TCL_CREATE_NS_IF_UNKNOWN	0x800
#define TCL_FIND_ONLY_NS		0x1000

/*
 * The client data for an ensemble command. This consists of the table of
 * commands that are actually exported by the namespace, and an epoch counter
 * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
 * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
 * that, combined with the exportLookupEpoch field of the namespace structure,
 * defines whether the table contains valid data or will need to be recomputed
 * next time the ensemble command is called.
 * referring to the same subcommand, even where one is a duplicate of another.
 */

typedef struct EnsembleConfig {
    Namespace *nsPtr;		/* The namespace backing this ensemble up. */
typedef struct {
    Namespace *nsPtr;		/* The namespace backing the ensemble which
    Tcl_Command token;		/* The token for the command that provides
				 * ensemble support for the namespace, or NULL
				 * if the command has been deleted (or never
				 * existed; the global namespace never has an
				 * ensemble command.) */
    size_t epoch;		/* The epoch at which this ensemble's table of
				 * exported commands is valid. */
    char **subcommandArrayPtr;	/* Array of ensemble subcommand names. At all
				 * consistent points, this will have the same
				 * number of entries as there are entries in
				 * the subcommandTable hash. */
    Tcl_HashTable subcommandTable;
				 * this is a subcommand of. */
				/* Hash table of ensemble subcommand names,
				 * which are its keys so this also provides
				 * the storage management for those subcommand
				 * names. The contents of the entry values are
				 * object version the prefix lists to use when
				 * substituting for the command/subcommand to
				 * build the ensemble implementation command.
				 * Has to be stored here as well as in
				 * subcommandDict because that field is NULL
				 * when we are deriving the ensemble from the
				 * namespace exports list. FUTURE WORK: use
				 * object hash table here. */
    struct EnsembleConfig *next;/* The next ensemble in the linked list of
				 * ensembles associated with a namespace. If
				 * this field points to this ensemble, the
				 * structure has already been unlinked from
				 * all lists, and cannot be found by scanning
				 * the list from the namespace's ensemble
				 * field. */
    int flags;			/* ORed combo of TCL_ENSEMBLE_PREFIX,
				 * ENSEMBLE_DEAD and ENSEMBLE_COMPILE. */

    int epoch;			/* Used to confirm when the data in this
    /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */

				 * really structure matches up with the
    Tcl_Obj *subcommandDict;	/* Dictionary providing mapping from
				 * subcommands to their implementing command
				 * prefixes, or NULL if we are to build the
				 * map automatically from the namespace
				 * exports. */
    Tcl_Obj *subcmdList;	/* List of commands that this ensemble
				 * actually provides, and whose implementation
				 * will be built using the subcommandDict (if
				 * present and defined) and by simple mapping
				 * to the namespace otherwise. If NULL,
				 * indicates that we are using the (dynamic)
				 * list of currently exported commands. */
    Tcl_Obj *unknownHandler;	/* Script prefix used to handle the case when
				 * no match is found (according to the rule
				 * defined by flag bit TCL_ENSEMBLE_PREFIX) or
				 * NULL to use the default error-generating
				 * behaviour. The script execution gets all
				 * the arguments to the ensemble command
				 * (including objv[0]) and will have the
				 * results passed directly back to the caller
				 * (including the error code) unless the code
				 * is TCL_CONTINUE in which case the
				 * subcommand will be reparsed by the ensemble
				 * core, presumably because the ensemble
				 * itself has been updated. */
    Tcl_Obj *parameterList;	/* List of ensemble parameter names. */
    int numParameters;		/* Cached number of parameters. This is either
				 * 0 (if the parameterList field is NULL) or
				 * the length of the list in the parameterList
				 * field. */
} EnsembleConfig;

/*
 * Various bits for the EnsembleConfig.flags field.
 */

#define ENSEMBLE_DEAD	0x1	/* Flag value to say that the ensemble is dead
				 * and on its way out. */
#define ENSEMBLE_COMPILE 0x4	/* Flag to enable bytecode compilation of an
				 * ensemble. */
    Tcl_Command token;		/* Reference to the comamnd for which this
				 * structure is a cache of the resolution. */
    char *fullSubcmdName;	/* The full (local) name of the subcommand,
				 * allocated with ckalloc(). */
    Tcl_Obj *realPrefixObj;	/* Object containing the prefix words of the
				 * command that implements this ensemble
				 * subcommand. */
} EnsembleCmdRep;

/*
 * Flag to enable bytecode compilation of an ensemble.
 */

#define ENSEMBLE_COMPILE 0x4

/*
 *----------------------------------------------------------------
 * Data structures related to variables. These are used primarily in tclVar.c
 *----------------------------------------------------------------
 */

/*
 * The following structure defines a variable trace, which is used to invoke a
 * specific C procedure whenever certain operations are performed on a
 * variable.
 */

typedef struct VarTrace {
    Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by
				 * flags are performed on variable. */
    void *clientData;	/* Argument to pass to proc. */
    ClientData clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS and TCL_TRACE_ARRAY. */
    struct VarTrace *nextPtr;	/* Next in list of traces associated with a
				 * particular variable. */
} VarTrace;

/*
 * The following structure defines a command trace, which is used to invoke a
 * specific C procedure whenever certain operations are performed on a
 * command.
 */

typedef struct CommandTrace {
    Tcl_CommandTraceProc *traceProc;
				/* Procedure to call when operations given by
				 * flags are performed on command. */
    void *clientData;	/* Argument to pass to proc. */
    ClientData clientData;	/* Argument to pass to proc. */
    int flags;			/* What events the trace procedure is
				 * interested in: OR-ed combination of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */
    struct CommandTrace *nextPtr;
				/* Next in list of traces associated with a
				 * particular command. */
    size_t refCount;	/* Used to ensure this structure is not
    int refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
} CommandTrace;

/*
 * When a command trace is active (i.e. its associated procedure is executing)
623
624
625
626
627
628
629
630

631
632
633
634
635
636
637
638
639
640

641
642
643
644
645
646
647
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







-
+









-
+







				 * variable. See below for definitions. */
    union {
	Tcl_Obj *objPtr;	/* The variable's object value. Used for
				 * scalar variables and array elements. */
	TclVarHashTable *tablePtr;/* For array variables, this points to
				 * information about the hash table used to
				 * implement the associative array. Points to
				 * Tcl_Alloc-ed data. */
				 * ckalloc-ed data. */
	struct Var *linkPtr;	/* If this is a global variable being referred
				 * to in a procedure, or a variable created by
				 * "upvar", this field points to the
				 * referenced variable's Var struct. */
    } value;
} Var;

typedef struct VarInHash {
    Var var;
    size_t refCount;		/* Counts number of active uses of this
    int refCount;		/* Counts number of active uses of this
				 * variable: 1 for the entry in the hash
				 * table, 1 for each additional variable whose
				 * linkPtr points here, 1 for each nested
				 * trace active on variable, and 1 if the
				 * variable is a namespace variable. This
				 * record can't be deleted until refCount
				 * becomes 0. */
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
751
752
753
754
755
756
757



758
759
760
761
762
763
764







-
-
-







#define TclIsVarDirectReadable(varPtr) \
    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ)) \
    &&  (varPtr)->value.objPtr)

#define TclIsVarDirectWritable(varPtr) \
    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_WRITE|VAR_DEAD_HASH))

#define TclIsVarDirectUnsettable(varPtr) \
    !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_TRACED_UNSET|VAR_DEAD_HASH))

#define TclIsVarDirectModifyable(varPtr) \
    (   !((varPtr)->flags & (VAR_ARRAY|VAR_LINK|VAR_TRACED_READ|VAR_TRACED_WRITE)) \
    &&  (varPtr)->value.objPtr)

#define TclIsVarDirectReadable2(varPtr, arrayPtr) \
    (TclIsVarDirectReadable(varPtr) &&\
	(!(arrayPtr) || !((arrayPtr)->flags & VAR_TRACED_READ)))
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
774
775
776
777
778
779
780






781
782
783
784
785
786
787







-
-
-
-
-
-







/*
 *----------------------------------------------------------------
 * Data structures related to procedures. These are used primarily in
 * tclProc.c, tclCompile.c, and tclExecute.c.
 *----------------------------------------------------------------
 */

#if defined(__GNUC__) && (__GNUC__ > 2)
#   define TCLFLEXARRAY 0
#else
#   define TCLFLEXARRAY 1
#endif

/*
 * Forward declaration to prevent an error when the forward reference to
 * Command is encountered in the Proc and ImportRef types declared below.
 */

struct Command;

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
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







-
-
+
+
+













-
+


-
+















-
+







 */

typedef struct CompiledLocal {
    struct CompiledLocal *nextPtr;
				/* Next compiler-recognized local variable for
				 * this procedure, or NULL if this is the last
				 * local. */
    size_t nameLength;		/* The number of bytes in local variable's name.
				 * Among others used to speed up var lookups. */
    int nameLength;		/* The number of characters in local
				 * variable's name. Used to speed up variable
				 * lookups. */
    int frameIndex;		/* Index in the array of compiler-assigned
				 * variables in the procedure call frame. */
    int flags;			/* Flag bits for the local variable. Same as
				 * the flags for the Var structure above,
				 * although only VAR_ARGUMENT, VAR_TEMPORARY,
				 * and VAR_RESOLVED make sense. */
    Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
				 * argument, if any. NULL if not an argument
				 * or, if an argument, no default value. */
    Tcl_ResolvedVarInfo *resolveInfo;
				/* Customized variable resolution info
				 * supplied by the Tcl_ResolveCompiledVarProc
				 * associated with a namespace. Each variable
				 * is marked by a unique tag during
				 * is marked by a unique ClientData tag during
				 * compilation, and that same tag is used to
				 * find the variable at runtime. */
    char name[TCLFLEXARRAY];		/* Name of the local variable starts here. If
    char name[4];		/* Name of the local variable starts here. If
				 * the name is NULL, this will just be '\0'.
				 * The actual size of this field will be large
				 * enough to hold the name. MUST BE THE LAST
				 * FIELD IN THE STRUCTURE! */
} CompiledLocal;

/*
 * The structure below defines a command procedure, which consists of a
 * collection of Tcl commands plus information about arguments and other local
 * variables recognized at compile time.
 */

typedef struct Proc {
    struct Interp *iPtr;	/* Interpreter for which this command is
				 * defined. */
    size_t refCount;		/* Reference count: 1 if still present in
    int refCount;		/* Reference count: 1 if still present in
				 * command table plus 1 for each call to the
				 * procedure that is currently active. This
				 * structure can be freed when refCount
				 * becomes zero. */
    struct Command *cmdPtr;	/* Points to the Command structure for this
				 * procedure. This is used to get the
				 * namespace in which to execute the
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
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







-
+










-
+







} Proc;

/*
 * The type of functions called to process errors found during the execution
 * of a procedure (or lambda term or ...).
 */

typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
typedef void (*ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);

/*
 * The structure below defines a command trace. This is used to allow Tcl
 * clients to find out whenever a command is about to be executed.
 */

typedef struct Trace {
    int level;			/* Only trace commands at nesting level less
				 * than or equal to this. */
    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
    void *clientData;	/* Arbitrary value to pass to proc. */
    ClientData clientData;	/* Arbitrary value to pass to proc. */
    struct Trace *nextPtr;	/* Next in list of traces for this interp. */
    int flags;			/* Flags governing the trace - see
				 * Tcl_CreateObjTrace for details. */
    Tcl_CmdObjTraceDeleteProc *delProc;
				/* Procedure to call when trace is deleted. */
} Trace;

1064
1065
1066
1067
1068
1069
1070
1071

1072
1073
1074
1075
1076
1077
1078
928
929
930
931
932
933
934

935
936
937
938
939
940
941
942







-
+







 * associated with an interpreter. The entry contains a pointer to a function
 * to call when the interpreter is deleted, and a pointer to a user-defined
 * piece of data.
 */

typedef struct AssocData {
    Tcl_InterpDeleteProc *proc;	/* Proc to call when deleting. */
    void *clientData;	/* Value to pass to proc. */
    ClientData clientData;	/* Value to pass to proc. */
} AssocData;

/*
 * The structure below defines a call frame. A call frame defines a naming
 * context for a procedure call: its local naming scope (for local variables)
 * and its global naming scope (a namespace, perhaps the global :: namespace).
 * A call frame can also define the naming context for a namespace eval or
1087
1088
1089
1090
1091
1092
1093
1094

1095
1096
1097
1098
1099
1100
1101
951
952
953
954
955
956
957

958
959
960
961
962
963
964
965







-
+








/*
 * Will be grown to contain: pointers to the varnames (allocated at the end),
 * plus the init values for each variable (suitable to be memcopied on init)
 */

typedef struct LocalCache {
    size_t refCount;
    int refCount;
    int numVars;
    Tcl_Obj *varName0;
} LocalCache;

#define localName(framePtr, i) \
    ((&((framePtr)->localCachePtr->varName0))[(i)])

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
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







-
+









-
-




-
-
-
-
-
-
-
-
-
-
-
-







				 * Initially NULL and created if needed. */
    int numCompiledLocals;	/* Count of local variables recognized by the
				 * compiler including arguments. */
    Var *compiledLocals;	/* Points to the array of local variables
				 * recognized by the compiler. The compiler
				 * emits code that refers to these variables
				 * using an index into this array. */
    void *clientData;	/* Pointer to some context that is used by
    ClientData clientData;	/* Pointer to some context that is used by
				 * object systems. The meaning of the contents
				 * of this field is defined by the code that
				 * sets it, and it should only ever be set by
				 * the code that is pushing the frame. In that
				 * case, the code that sets it should also
				 * have some means of discovering what the
				 * meaning of the value is, which we do not
				 * specify. */
    LocalCache *localCachePtr;
    Tcl_Obj    *tailcallPtr;
				/* NULL if no tailcall is scheduled */
} CallFrame;

#define FRAME_IS_PROC	0x1
#define FRAME_IS_LAMBDA 0x2
#define FRAME_IS_METHOD	0x4	/* The frame is a method body, and the frame's
				 * clientData field contains a CallContext
				 * reference. Part of TIP#257. */
#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. Part of
				 * TIP#257. */
#define FRAME_IS_PRIVATE_DEFINE 0x10
				/* Marks this frame as being used for private
				 * declarations with [oo::define]. Usually
				 * OR'd with FRAME_IS_OO_DEFINE. TIP#500. */

/*
 * TIP #280
 * The structure below defines a command frame. A command frame provides
 * location information for all commands executing a tcl script (source, eval,
 * uplevel, procedure bodies, ...). The runtime structure essentially contains
 * the stack trace as it would be if the currently executing command were to
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
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







-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+












-
-
-
-
+
+
+
+
+
-
-
-
+
-
+





-
+





-
+




-
-
-







				 * NULL. */
    struct CmdFrame *nextPtr;	/* Link to calling frame. */
    /*
     * Data needed for Eval vs TEBC
     *
     * EXECUTION CONTEXTS and usage of CmdFrame
     *
     * Field	  TEBC		  EvalEx
     * =======	  ====		  ======
     * level	  yes		  yes
     * type	  BC/PREBC	  SRC/EVAL
     * line0	  yes		  yes
     * framePtr	  yes		  yes
     * =======	  ====		  ======
     * Field	  TEBC		  EvalEx	  EvalObjEx
     * =======	  ====		  ======	  =========
     * level	  yes		  yes		  yes
     * type	  BC/PREBC	  SRC/EVAL	  EVAL_LIST
     * line0	  yes		  yes		  yes
     * framePtr	  yes		  yes		  yes
     * =======	  ====		  ======	  =========
     *
     * =======	  ====		  ========= union data
     * line1	  -		  yes
     * line3	  -		  yes
     * path	  -		  yes
     * -------	  ----		  ------
     * codePtr	  yes		  -
     * pc	  yes		  -
     * =======	  ====		  ======
     * =======	  ====		  ======	  ========= union data
     * line1	  -		  yes		  -
     * line3	  -		  yes		  -
     * path	  -		  yes		  -
     * -------	  ----		  ------	  ---------
     * codePtr	  yes		  -		  -
     * pc	  yes		  -		  -
     * =======	  ====		  ======	  =========
     *
     * =======	  ====		  ========= union cmd
     * str.cmd	  yes		  yes
     * str.len	  yes		  yes
     * -------	  ----		  ------
     * =======	  ====		  ======	  ========= | union cmd
     * listPtr	  -		  -		  yes	    |
     * -------	  ----		  ------	  --------- |
     * cmd	  yes		  yes		  -	    |
     * cmdlen	  yes		  yes		  -	    |
     * -------	  ----		  ------	  --------- |
     */

    union {
	struct {
	    Tcl_Obj *path;	/* Path of the sourced file the command is
				 * in. */
	} eval;
	struct {
	    const void *codePtr;/* Byte code currently executed... */
	    const char *pc;	/* ... and instruction pointer. */
	} tebc;
    } data;
    Tcl_Obj *cmdObj;
    const char *cmd;		/* The executed command, if possible... */
    size_t len;			/* ... and its length. */
    const struct CFWordBC *litarg;
    union {
	struct {
	    const char *cmd;	/* The executed command, if possible... */
	    int len;		/* ... and its length. */
	} str;
				/* Link to set of literal arguments which have
				 * ben pushed on the lineLABCPtr stack by
				 * TclArgumentBCEnter(). These will be removed
	Tcl_Obj *listPtr;	/* Tcl_EvalObjEx, cmd list. */
				 * by TclArgumentBCRelease. */
    } cmd;
} CmdFrame;

typedef struct CFWord {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    int word;			/* Index of the word in the command. */
    size_t refCount;		/* Number of times the word is on the
    int refCount;		/* Number of times the word is on the
				 * stack. */
} CFWord;

typedef struct CFWordBC {
    CmdFrame *framePtr;		/* CmdFrame to access. */
    size_t pc;			/* Instruction pointer of a command in
    int pc;			/* Instruction pointer of a command in
				 * ExtCmdLoc.loc[.] */
    int word;			/* Index of word in
				 * ExtCmdLoc.loc[cmd]->line[.] */
    struct CFWordBC *prevPtr;	/* Previous entry in stack for same Tcl_Obj. */
    struct CFWordBC *nextPtr;	/* Next entry for same command call. See
				 * CmdFrame litarg field for the list start. */
    Tcl_Obj *obj;		/* Back reference to hashtable key */
} CFWordBC;

/*
 * Structure to record the locations of invisible continuation lines in
 * literal scripts, as character offset from the beginning of the script. Both
 * compiler and direct evaluator use this information to adjust their line
 * counters when tracking through the script, because when it is invoked the
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

1348
1349
1350
1351
1352
1353
1354
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







-
+













+
+











+
+













-
+


-
+


-
+



-
+







 */

#define CLL_END		(-1)

typedef struct ContLineLoc {
    int num;			/* Number of entries in loc, not counting the
				 * final -1 marker entry. */
    int loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
    int loc[1];			/* Table of locations, as character offsets.
				 * The table is allocated as part of the
				 * structure, extending behind the nominal end
				 * of the structure. An entry containing the
				 * value -1 is put after the last location, as
				 * end-marker/sentinel. */
} ContLineLoc;

/*
 * The following macros define the allowed values for the type field of the
 * CmdFrame structure above. Some of the values occur only in the extended
 * location data referenced via the 'baseLocPtr'.
 *
 * TCL_LOCATION_EVAL	  : Frame is for a script evaluated by EvalEx.
 * TCL_LOCATION_EVAL_LIST : Frame is for a script evaluated by the list
 *			    optimization path of EvalObjEx.
 * TCL_LOCATION_BC	  : Frame is for bytecode.
 * TCL_LOCATION_PREBC	  : Frame is for precompiled bytecode.
 * TCL_LOCATION_SOURCE	  : Frame is for a script evaluated by EvalEx, from a
 *			    sourced file.
 * TCL_LOCATION_PROC	  : Frame is for bytecode of a procedure.
 *
 * A TCL_LOCATION_BC type in a frame can be overridden by _SOURCE and _PROC
 * types, per the context of the byte code in execution.
 */

#define TCL_LOCATION_EVAL	(0) /* Location in a dynamic eval script. */
#define TCL_LOCATION_EVAL_LIST	(1) /* Location in a dynamic eval script,
				     * list-path. */
#define TCL_LOCATION_BC		(2) /* Location in byte code. */
#define TCL_LOCATION_PREBC	(3) /* Location in precompiled byte code, no
				     * location. */
#define TCL_LOCATION_SOURCE	(4) /* Location in a file. */
#define TCL_LOCATION_PROC	(5) /* Location in a dynamic proc. */
#define TCL_LOCATION_LAST	(6) /* Number of values in the enum. */

/*
 * Structure passed to describe procedure-like "procedures" that are not
 * procedures (e.g. a lambda) so that their details can be reported correctly
 * by [info frame]. Contains a sub-structure for each extra field.
 */

typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData);
typedef Tcl_Obj *(*GetFrameInfoValueProc)(ClientData clientData);
typedef struct {
    const char *name;		/* Name of this field. */
    GetFrameInfoValueProc *proc;	/* Function to generate a Tcl_Obj* from the
    GetFrameInfoValueProc proc;	/* Function to generate a Tcl_Obj* from the
				 * clientData, or just use the clientData
				 * directly (after casting) if NULL. */
    void *clientData;	/* Context for above function, or Tcl_Obj* if
    ClientData clientData;	/* Context for above function, or Tcl_Obj* if
				 * proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
    size_t length;			/* Length of array. */
    int length;			/* Length of array. */
    ExtraFrameInfoField fields[2];
				/* Really as long as necessary, but this is
				 * long enough for nearly anything. */
} ExtraFrameInfo;

/*
 *----------------------------------------------------------------
1381
1382
1383
1384
1385
1386
1387
1388

1389
1390
1391
1392
1393
1394
1395
1233
1234
1235
1236
1237
1238
1239

1240
1241
1242
1243
1244
1245
1246
1247







-
+







			    void *data);

/*
 * This is a convenience macro used to initialize a thread local storage ptr.
 */

#define TCL_TSD_INIT(keyPtr) \
	(ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
  (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))

/*
 *----------------------------------------------------------------
 * Data structures related to bytecode compilation and execution. These are
 * used primarily in tclCompile.c, tclExecute.c, and tclBasic.c.
 *----------------------------------------------------------------
 */
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
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
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







-
+











-
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
-


-
-
-








/*
 * The type of procedure called from the compilation hook point in
 * SetByteCodeFromAny.
 */

typedef int (CompileHookProc)(Tcl_Interp *interp,
	struct CompileEnv *compEnvPtr, void *clientData);
	struct CompileEnv *compEnvPtr, ClientData clientData);

/*
 * The data structure for a (linked list of) execution stacks.
 */

typedef struct ExecStack {
    struct ExecStack *prevPtr;
    struct ExecStack *nextPtr;
    Tcl_Obj **markerPtr;
    Tcl_Obj **endPtr;
    Tcl_Obj **tosPtr;
    Tcl_Obj *stackWords[TCLFLEXARRAY];
    Tcl_Obj *stackWords[1];
} ExecStack;

/*
 * The data structure defining the execution environment for ByteCode's.
 * There is one ExecEnv structure per Tcl interpreter. It holds the evaluation
 * stack that holds command operands and results. The stack grows towards
 * increasing addresses. The member stackPtr points to the stackItems of the
 * currently active execution stack.
 */

typedef struct CorContext {
    struct CallFrame *framePtr;
    struct CallFrame *varFramePtr;
    struct CmdFrame *cmdFramePtr;  /* See Interp.cmdFramePtr */
    Tcl_HashTable *lineLABCPtr;    /* See Interp.lineLABCPtr */
} CorContext;

typedef struct CoroutineData {
    struct Command *cmdPtr;	/* The command handle for the coroutine. */
    struct ExecEnv *eePtr;	/* The special execution environment (stacks,
				 * etc.) for the coroutine. */
    struct ExecEnv *callerEEPtr;/* The execution environment for the caller of
				 * the coroutine, which might be the
				 * interpreter global environment or another
				 * coroutine. */
    CorContext caller;
    CorContext running;
    Tcl_HashTable *lineLABCPtr;    /* See Interp.lineLABCPtr */
    void *stackLevel;
    int auxNumLevels;		/* While the coroutine is running the
				 * numLevels of the create/resume command is
				 * stored here; for suspended coroutines it
				 * holds the nesting numLevels at yield. */
    int nargs;                  /* Number of args required for resuming this
				 * coroutine; -2 means "0 or 1" (default), -1
				 * means "any" */
} CoroutineData;

typedef struct ExecEnv {
    ExecStack *execStackPtr;	/* Points to the first item in the evaluation
				 * stack on the heap. */
    Tcl_Obj *constants[2];	/* Pointers to constant "0" and "1" objs. */
    struct Tcl_Interp *interp;
    struct NRE_callback *callbackPtr;
				/* Top callback in NRE's stack. */
    struct CoroutineData *corPtr;
    int rewind;
} ExecEnv;

#define COR_IS_SUSPENDED(corPtr) \
    ((corPtr)->stackLevel == NULL)

/*
 * The definitions for the LiteralTable and LiteralEntry structures. Each
 * interpreter contains a LiteralTable. It is used to reduce the storage
 * needed for all the Tcl objects that hold the literals of scripts compiled
 * by the interpreter. A literal's object is shared by all the ByteCodes that
 * refer to the literal. Each distinct literal has one LiteralEntry entry in
 * the LiteralTable. A literal table is a specialized hash table that is
1516
1517
1518
1519
1520
1521
1522
1523

1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541

1542
1543

1544
1545

1546
1547

1548
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
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1332
1333
1334
1335
1336
1337
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

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







-
+



-
+













-
+

-
+

-
+

-
+










-
-
-
-
+
+
+
+







-
+

-
-
+
+







-
+



-
+













-
-
-
-








typedef struct LiteralEntry {
    struct LiteralEntry *nextPtr;
				/* Points to next entry in this hash bucket or
				 * NULL if end of chain. */
    Tcl_Obj *objPtr;		/* Points to Tcl object that holds the
				 * literal's bytes and length. */
    size_t refCount;		/* If in an interpreter's global literal
    int refCount;		/* If in an interpreter's global literal
				 * table, the number of ByteCode structures
				 * that share the literal object; the literal
				 * entry can be freed when refCount drops to
				 * 0. If in a local literal table, TCL_INDEX_NONE. */
				 * 0. If in a local literal table, -1. */
    Namespace *nsPtr;		/* Namespace in which this literal is used. We
				 * try to avoid sharing literal non-FQ command
				 * names among different namespaces to reduce
				 * shimmering. */
} LiteralEntry;

typedef struct LiteralTable {
    LiteralEntry **buckets;	/* Pointer to bucket array. Each element
				 * points to first entry in bucket's hash
				 * chain, or NULL. */
    LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
				/* Bucket array used for small tables to avoid
				 * mallocs and frees. */
    size_t numBuckets;		/* Total number of buckets allocated at
    int numBuckets;		/* Total number of buckets allocated at
				 * **buckets. */
    size_t numEntries;		/* Total number of entries present in
    int numEntries;		/* Total number of entries present in
				 * table. */
    size_t rebuildSize;		/* Enlarge table when numEntries gets to be
    int rebuildSize;		/* Enlarge table when numEntries gets to be
				 * this large. */
    size_t mask;		/* Mask value used in hashing function. */
    int mask;			/* Mask value used in hashing function. */
} LiteralTable;

/*
 * The following structure defines for each Tcl interpreter various
 * statistics-related information about the bytecode compiler and
 * interpreter's operation in that interpreter.
 */

#ifdef TCL_COMPILE_STATS
typedef struct ByteCodeStats {
    size_t numExecutions;		/* Number of ByteCodes executed. */
    size_t numCompilations;	/* Number of ByteCodes created. */
    size_t numByteCodesFreed;	/* Number of ByteCodes destroyed. */
    size_t instructionCount[256];	/* Number of times each instruction was
    long numExecutions;		/* Number of ByteCodes executed. */
    long numCompilations;	/* Number of ByteCodes created. */
    long numByteCodesFreed;	/* Number of ByteCodes destroyed. */
    long instructionCount[256];	/* Number of times each instruction was
				 * executed. */

    double totalSrcBytes;	/* Total source bytes ever compiled. */
    double totalByteCodeBytes;	/* Total bytes for all ByteCodes. */
    double currentSrcBytes;	/* Src bytes for all current ByteCodes. */
    double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */

    size_t srcCount[32];		/* Source size distribution: # of srcs of
    long srcCount[32];		/* Source size distribution: # of srcs of
				 * size [2**(n-1)..2**n), n in [0..32). */
    size_t byteCodeCount[32];	/* ByteCode size distribution. */
    size_t lifetimeCount[32];	/* ByteCode lifetime distribution (ms). */
    long byteCodeCount[32];	/* ByteCode size distribution. */
    long lifetimeCount[32];	/* ByteCode lifetime distribution (ms). */

    double currentInstBytes;	/* Instruction bytes-current ByteCodes. */
    double currentLitBytes;	/* Current literal bytes. */
    double currentExceptBytes;	/* Current exception table bytes. */
    double currentAuxBytes;	/* Current auxiliary information bytes. */
    double currentCmdMapBytes;	/* Current src<->code map bytes. */

    size_t numLiteralsCreated;	/* Total literal objects ever compiled. */
    long numLiteralsCreated;	/* Total literal objects ever compiled. */
    double totalLitStringBytes;	/* Total string bytes in all literals. */
    double currentLitStringBytes;
				/* String bytes in current literals. */
    size_t literalCount[32];	/* Distribution of literal string sizes. */
    long literalCount[32];	/* Distribution of literal string sizes. */
} ByteCodeStats;
#endif /* TCL_COMPILE_STATS */

/*
 * Structure used in implementation of those core ensembles which are
 * partially compiled. Used as an array of these, with a terminating field
 * whose 'name' is NULL.
 */

typedef struct {
    const char *name;		/* The name of the subcommand. */
    Tcl_ObjCmdProc *proc;	/* The implementation of the subcommand. */
    CompileProc *compileProc;	/* The compiler for the subcommand. */
    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
    void *clientData;	/* Any clientData to give the command. */
    int unsafe;			/* Whether this command is to be hidden by
				 * default in a safe interpreter. */
} EnsembleImplMap;

/*
 *----------------------------------------------------------------
 * Data structures related to commands.
 *----------------------------------------------------------------
 */
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
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
1531

1532



1533
1534
1535
1536
1537
1538
1539







-
+




-
+





-
+

-
+



-
+











-





-
+



-
+



-
+


-
-
-







-
-
-
+
+
+
-

-
-
-







				 * from its Tcl_Command handle. NULL means
				 * that the hash table entry has been removed
				 * already (this can happen if deleteProc
				 * causes the command to be deleted or
				 * recreated). */
    Namespace *nsPtr;		/* Points to the namespace containing this
				 * command. */
    size_t refCount;		/* 1 if in command hashtable plus 1 for each
    int refCount;		/* 1 if in command hashtable plus 1 for each
				 * reference from a CmdName Tcl object
				 * representing a command's name in a ByteCode
				 * instruction sequence. This structure can be
				 * freed when refCount becomes zero. */
    size_t cmdEpoch;		/* Incremented to invalidate any references
    int cmdEpoch;		/* Incremented to invalidate any references
				 * that point to this command when it is
				 * renamed, deleted, hidden, or exposed. */
    CompileProc *compileProc;	/* Procedure called to compile command. NULL
				 * if no compile proc exists for command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based command procedure. */
    void *objClientData;	/* Arbitrary value passed to object proc. */
    ClientData objClientData;	/* Arbitrary value passed to object proc. */
    Tcl_CmdProc *proc;		/* String-based command procedure. */
    void *clientData;	/* Arbitrary value passed to string proc. */
    ClientData clientData;	/* Arbitrary value passed to string proc. */
    Tcl_CmdDeleteProc *deleteProc;
				/* Procedure invoked when deleting command to,
				 * e.g., free all client data. */
    void *deleteData;	/* Arbitrary value passed to deleteProc. */
    ClientData deleteData;	/* Arbitrary value passed to deleteProc. */
    int flags;			/* Miscellaneous bits of information about
				 * command. See below for definitions. */
    ImportRef *importRefPtr;	/* List of each imported Command created in
				 * another namespace when this command is
				 * imported. These imported commands redirect
				 * invocations back to this command. The list
				 * is used to remove all those imported
				 * commands when deleting this "real"
				 * command. */
    CommandTrace *tracePtr;	/* First in list of all traces set for this
				 * command. */
    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
} Command;

/*
 * Flag bits for commands.
 *
 * CMD_DYING -			If 1 the command is in the process of
 * CMD_IS_DELETED -		Means that the command is in the process of
 *				being deleted (its deleteProc is currently
 *				executing). Other attempts to delete the
 *				command should be ignored.
 * CMD_TRACE_ACTIVE -		If 1 the trace processing is currently
 * CMD_TRACE_ACTIVE -		1 means that trace processing is currently
 *				underway for a rename/delete change. See the
 *				two flags below for which is currently being
 *				processed.
 * CMD_HAS_EXEC_TRACES -	If 1 means that this command has at least one
 * CMD_HAS_EXEC_TRACES -	1 means that this command has at least one
 *				execution trace (as opposed to simple
 *				delete/rename traces) in its tracePtr list.
 * CMD_COMPILES_EXPANDED -	If 1 this command has a compiler that
 *				can handle expansion (provided it is not the
 *				first word).
 * TCL_TRACE_RENAME -		A rename trace is in progress. Further
 *				recursive renames will not be traced.
 * TCL_TRACE_DELETE -		A delete trace is in progress. Further
 *				recursive deletes will not be traced.
 * (these last two flags are defined in tcl.h)
 */

#define CMD_DYING		    0x01
#define CMD_TRACE_ACTIVE	    0x02
#define CMD_HAS_EXEC_TRACES	    0x04
#define CMD_IS_DELETED		    0x1
#define CMD_TRACE_ACTIVE	    0x2
#define CMD_HAS_EXEC_TRACES	    0x4
#define CMD_COMPILES_EXPANDED	    0x08
#define CMD_REDEF_IN_PROGRESS	    0x10
#define CMD_VIA_RESOLVER	    0x20
#define CMD_DEAD                    0x40


/*
 *----------------------------------------------------------------
 * Data structures related to name resolution procedures.
 *----------------------------------------------------------------
 */

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
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
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
1631
1632
1633
1634


1635
1636
1637
1638

1639
1640
1641
1642
1643
1644
1645
1646







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
+
-









-
-
+
+

+
-
+







 * Values for the selection mode, i.e the package require preferences.
 */

enum PkgPreferOptions {
    PKG_PREFER_LATEST, PKG_PREFER_STABLE
};

/*
 *----------------------------------------------------------------
 * This structure shadows the first few fields of the memory cache for the
 * allocator defined in tclThreadAlloc.c; it has to be kept in sync with the
 * definition there.
 * Some macros require knowledge of some fields in the struct in order to
 * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
 * to the relevant fields is kept in the allocCache field in struct Interp.
 *----------------------------------------------------------------
 */

typedef struct AllocCache {
    struct Cache *nextPtr;	/* Linked list of cache entries. */
    Tcl_ThreadId owner;		/* Which thread's cache is this? */
    Tcl_Obj *firstObjPtr;	/* List of free objects for thread. */
    size_t numObjects;		/* Number of objects for thread. */
} AllocCache;

/*
 *----------------------------------------------------------------
 * This structure defines an interpreter, which is a collection of commands
 * plus other state information related to interpreting commands, such as
 * variable storage. Primary responsibility for this data structure is in
 * tclBasic.c, but almost every Tcl source file uses something in here.
 *----------------------------------------------------------------
 */

typedef struct Interp {
    /*
     * The first two fields were named "result" and "freeProc" in earlier
     * versions of Tcl.  They are no longer used within Tcl, and are no
     * longer available to be accessed by extensions.  However, they cannot
     * Note: the first three fields must match exactly the fields in a
     * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the
     * other.
     * be removed.  Why?  There is a deployed base of stub-enabled extensions
     * that query the value of iPtr->stubTable.  For them to continue to work,
     * the location of the field "stubTable" within the Interp struct cannot
     * change.  The most robust way to assure that is to leave all fields up to
     * that one undisturbed.
     *
     * The interpreter's result is held in both the string and the
     * objResultPtr fields. These fields hold, respectively, the result's
     * string or object value. The interpreter's result is always in the
     * result field if that is non-empty, otherwise it is in objResultPtr.
     * The two fields are kept consistent unless some C code sets
     * interp->result directly. Programs should not access result and
     * objResultPtr directly; instead, they should always get and set the
     * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
     * Tcl_GetStringResult. See the SetResult man page for details.
     */

    const char *legacyResult;
    void (*legacyFreeProc) (void);
    char *result;		/* If the last command returned a string
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_FreeProc *freeProc;	/* Zero means a string result is statically
				 * allocated. TCL_DYNAMIC means string result
				 * was allocated with ckalloc and should be
				 * freed with ckfree. Other values give
				 * address of procedure to invoke to free the
				 * string result. Tcl_Eval must free it before
				 * executing next command. */
    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number in the command where the error
				 * occurred (1 means first line). */
    const struct TclStubs *stubTable;
				/* Pointer to the exported Tcl stub table.  In
				 * ancient pre-8.1 versions of Tcl this was a
				 * pointer to the objResultPtr or a pointer to a
				 * buckets array in a hash table. Deployed stubs
    struct TclStubs *stubTable;
				/* Pointer to the exported Tcl stub table. On
				 * previous versions of Tcl this is a pointer
				 * to the objResultPtr or a pointer to a
				 * buckets array in a hash table. We therefore
				 * enabled extensions check for a NULL pointer value
				 * and for a TCL_STUBS_MAGIC value to verify they
				 * have to do some careful checking before we
				 * are not [load]ing into one of those pre-stubs
				 * interps.
				 * can use this. */
				 */

    TclHandle handle;		/* Handle used to keep track of when this
				 * interp is deleted. */

    Namespace *globalNsPtr;	/* The interpreter's global namespace. */
    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    void *interpInfo;	/* Information used by tclInterp.c to keep
				 * track of parent/child interps on a
    ClientData interpInfo;	/* Information used by tclInterp.c to keep
				 * track of master/slave interps on a
				 * per-interp basis. */
    Tcl_HashTable unused2;	/* No longer used (was mathFuncTable) */
    void (*optimizer)(void *envPtr);

    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */

    int numLevels;		/* Keeps track of how many nested calls to
				 * Tcl_Eval are in progress for this
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
















-
+





+





-
+







				 * or NULL if no active traces. */
    int returnCode;		/* [return -code] parameter. */
    CallFrame *rootFramePtr;	/* Global frame pointer for this
				 * interpreter. */
    Namespace *lookupNsPtr;	/* Namespace to use ONLY on the next
				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */

    /*
     * Information used by Tcl_AppendResult to keep track of partial results.
     * See Tcl_AppendResult code for details.
     */

    char *appendResult;		/* Storage space for results generated by
				 * Tcl_AppendResult. Ckalloc-ed. NULL means
				 * not yet allocated. */
    int appendAvl;		/* Total amount of space available at
				 * partialResult. */
    int appendUsed;		/* Number of non-null bytes currently stored
				 * at partialResult. */

    /*
     * Information about packages. Used only in tclPkg.c.
     */

    Tcl_HashTable packageTable;	/* Describes all of the packages loaded in or
				 * available to this interpreter. Keys are
				 * package names, values are (Package *)
				 * pointers. */
    char *packageUnknown;	/* Command to invoke during "package require"
				 * commands for packages that aren't described
				 * in packageTable. Ckalloc'ed, may be
				 * NULL. */
    /*
     * Miscellaneous information:
     */

    size_t cmdCount;		/* Total number of times a command procedure
    int cmdCount;		/* Total number of times a command procedure
				 * has been called for this interpreter. */
    int evalFlags;		/* Flags to control next call to Tcl_Eval.
				 * Normally zero, but may be set before
				 * calling Tcl_Eval. See below for valid
				 * values. */
    int unused1;		/* No longer used (was termOffset) */
    LiteralTable literalTable;	/* Contains LiteralEntry's describing all Tcl
				 * objects holding literals of scripts
				 * compiled by the interpreter. Indexed by the
				 * string representations of literals. Used to
				 * avoid creating duplicate objects. */
    size_t compileEpoch;	/* Holds the current "compilation epoch" for
    int compileEpoch;		/* Holds the current "compilation epoch" for
				 * this interpreter. This is incremented to
				 * invalidate existing ByteCodes when, e.g., a
				 * command with a compile procedure is
				 * redefined. */
    Proc *compiledProcPtr;	/* If a procedure is being compiled, a pointer
				 * to its Proc structure; otherwise, this is
				 * NULL. Set by ObjInterpProc in tclProc.c and
1923
1924
1925
1926
1927
1928
1929


1930
1931
1932
1933
1934
1935
1936
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749







+
+







    struct ExecEnv *execEnvPtr;	/* Execution environment for Tcl bytecode
				 * execution. Contains a pointer to the Tcl
				 * evaluation stack. */
    Tcl_Obj *emptyObjPtr;	/* Points to an object holding an empty
				 * string. Returned by Tcl_ObjSetVar2 when
				 * variable traces change a variable in a
				 * gross way. */
    char resultSpace[TCL_RESULT_SIZE+1];
				/* Static space holding small results. */
    Tcl_Obj *objResultPtr;	/* If the last command returned an object
				 * result, this points to it. Should not be
				 * accessed directly; see comment above. */
    Tcl_ThreadId threadId;	/* ID of thread that owns the interpreter. */

    ActiveCommandTrace *activeCmdTracePtr;
				/* First in list of active command traces for
1965
1966
1967
1968
1969
1970
1971
1972

1973
1974
1975
1976
1977
1978
1979
1778
1779
1780
1781
1782
1783
1784

1785
1786
1787
1788
1789
1790
1791
1792







-
+







				 * set. */
	int granularityTicker;	/* Counter used to determine how often to
				 * check the limits. */
	int exceeded;		/* Which limits have been exceeded, described
				 * as flag values the same as the 'active'
				 * field. */

	size_t cmdCount;		/* Limit for how many commands to execute in
	int cmdCount;		/* Limit for how many commands to execute in
				 * the interpreter. */
	LimitHandler *cmdHandlers;
				/* Handlers to execute when the limit is
				 * reached. */
	int cmdGranularity;	/* Mod factor used to determine how often to
				 * evaluate the limit check. */

2001
2002
2003
2004
2005
2006
2007
2008

2009
2010

2011
2012
2013
2014
2015
2016
2017
1814
1815
1816
1817
1818
1819
1820

1821
1822

1823
1824
1825
1826
1827
1828
1829
1830







-
+

-
+








    struct {
	Tcl_Obj *const *sourceObjs;
				/* What arguments were actually input into the
				 * *root* ensemble command? (Nested ensembles
				 * don't rewrite this.) NULL if we're not
				 * processing an ensemble. */
	size_t numRemovedObjs;	/* How many arguments have been stripped off
	int numRemovedObjs;	/* How many arguments have been stripped off
				 * because of ensemble processing. */
	size_t numInsertedObjs;	/* How many of the current arguments were
	int numInsertedObjs;	/* How many of the current arguments were
				 * inserted by an ensemble. */
    } ensembleRewrite;

    /*
     * TIP #219: Global info for the I/O system.
     */

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
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







-
+





-
+





-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-




-
+














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    /*
     * The thread-specific data ekeko: cache pointers or values that
     *  (a) do not change during the thread's lifetime
     *  (b) require access to TSD to determine at runtime
     *  (c) are accessed very often (e.g., at each command call)
     *
     * Note that these are the same for all interps in the same thread. They
     * just have to be initialised for the thread's parent interp, children
     * just have to be initialised for the thread's master interp, slaves
     * inherit the value.
     *
     * They are used by the macros defined below.
     */

    AllocCache *allocCache;
    void *allocCache;
    void *pendingObjDataPtr;	/* Pointer to the Cache and PendingObjData
				 * structs for this interp's thread; see
				 * tclObj.c and tclThreadAlloc.c */
    int *asyncReadyPtr;		/* Pointer to the asyncReady indicator for
				 * this interp's thread; see tclAsync.c */
    /*
     * The pointer to the object system root ekeko. c.f. TIP #257.
     */
    void *objectFoundation;	/* Pointer to the Foundation structure of the
    int *stackBound;		/* Pointer to the limit stack address
				 * object system, which contains things like
				 * references to key namespaces. See
				 * tclOOInt.h and tclOO.c for real definition
				 * and setup. */

				 * allowable for invoking a new command
    struct NRE_callback *deferredCallbacks;
				/* Callbacks that are set previous to a call
				 * to some Eval function but that actually
				 * belong to the command that is about to be
				 * called - i.e., they should be run *before*
				 * any tailcall is invoked. */

				 * without "risking" a C-stack overflow; see
    /*
     * TIP #285, Script cancellation support.
     */

				 * TclpCheckStackSpace in the platform's
    Tcl_AsyncHandler asyncCancel;
				/* Async handler token for Tcl_CancelEval. */
    Tcl_Obj *asyncCancelMsg;	/* Error message set by async cancel handler
				 * for the propagation of arbitrary Tcl
				 * errors. This information, if present
				 * (asyncCancelMsg not NULL), takes precedence
				 * over the default error messages returned by
				 * a script cancellation operation. */
				 * directory. */

	/*
	 * TIP #348 IMPLEMENTATION  -  Substituted error stack
	 */
    Tcl_Obj *errorStack;	/* [info errorstack] value (as a Tcl_Obj). */
    Tcl_Obj *upLiteral;		/* "UP" literal for [info errorstack] */
    Tcl_Obj *callLiteral;	/* "CALL" literal for [info errorstack] */
    Tcl_Obj *innerLiteral;	/* "INNER" literal for [info errorstack] */
    Tcl_Obj *innerContext;	/* cached list for fast reallocation */
    int resetErrorStack;        /* controls cleaning up of ::errorStack */

#ifdef TCL_COMPILE_STATS
    /*
     * Statistical information about the bytecode compiler and interpreter's
     * operation. This should be the last field of Interp.
     * operation.
     */

    ByteCodeStats stats;	/* Holds compilation and execution statistics
				 * for this interpreter. */
#endif /* TCL_COMPILE_STATS */
} Interp;

/*
 * Macros that use the TSD-ekeko.
 */

#define TclAsyncReady(iPtr) \
    *((iPtr)->asyncReadyPtr)

/*
 * Macros for script cancellation support (TIP #285).
 */

#define TclCanceled(iPtr) \
    (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND))

#define TclSetCancelFlags(iPtr, cancelFlags)   \
    (iPtr)->flags |= CANCELED;                 \
    if ((cancelFlags) & TCL_CANCEL_UNWIND) {   \
        (iPtr)->flags |= TCL_CANCEL_UNWIND;    \
    }

#define TclUnsetCancelFlags(iPtr) \
    (iPtr)->flags &= (~(CANCELED | TCL_CANCEL_UNWIND))

/*
 * Macros for splicing into and out of doubly linked lists. They assume
 * existence of struct items 'prevPtr' and 'nextPtr'.
 *
 * a = element to add or remove.
 * b = list head.
 *
2209
2210
2211
2212
2213
2214
2215
2216
2217

2218
2219
2220
2221
2222
2223
2224
1974
1975
1976
1977
1978
1979
1980


1981
1982
1983
1984
1985
1986
1987
1988







-
-
+







 * TCL_ALLOW_EXCEPTIONS	1 means it's OK for the script to terminate with a
 *			code other than TCL_OK or TCL_ERROR; 0 means codes
 *			other than these should be turned into errors.
 */

#define TCL_ALLOW_EXCEPTIONS		0x04
#define TCL_EVAL_FILE			0x02
#define TCL_EVAL_SOURCE_IN_FRAME	0x10
#define TCL_EVAL_NORESOLVE		0x20
#define TCL_EVAL_CTX			0x08
#define TCL_EVAL_DISCARD_RESULT		0x40

/*
 * Flag bits for Interp structures:
 *
 * DELETED:		Non-zero means the interpreter has been deleted:
 *			don't process any more commands for it, and destroy
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
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







-
+










-
-
-
-
-
-
-
-
-
-















-







 *			instructions. This is set 1, for example, when command
 *			traces are requested.
 * RAND_SEED_INITIALIZED: Non-zero means that the randSeed value of the interp
 *			has not be initialized. This is set 1 when we first
 *			use the rand() or srand() functions.
 * SAFE_INTERP:		Non zero means that the current interp is a safe
 *			interp (i.e. it has only the safe commands installed,
 *			less privilege than a regular interp).
 *			less priviledge than a regular interp).
 * INTERP_DEBUG_FRAME:	Used for switching on various extra interpreter
 *			debug/info mechanisms (e.g. info frame eval/uplevel
 *			tracing) which are performance intensive.
 * INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
 *			active; so no further trace callbacks should be
 *			invoked.
 * INTERP_ALTERNATE_WRONG_ARGS: Used for listing second and subsequent forms
 *			of the wrong-num-args string in Tcl_WrongNumArgs.
 *			Makes it append instead of replacing and uses
 *			different intermediate text.
 * CANCELED:		Non-zero means that the script in progress should be
 *			canceled as soon as possible. This can be checked by
 *			extensions (and the core itself) by calling
 *			Tcl_Canceled and checking if TCL_ERROR is returned.
 *			This is a one-shot flag that is reset immediately upon
 *			being detected; however, if the TCL_CANCEL_UNWIND flag
 *			is set Tcl_Canceled will continue to report that the
 *			script in progress has been canceled thereby allowing
 *			the evaluation stack for the interp to be fully
 *			unwound.
 *
 * WARNING: For the sake of some extensions that have made use of former
 * internal values, do not re-use the flag values 2 (formerly ERR_IN_PROGRESS)
 * or 8 (formerly ERROR_CODE_SET).
 */

#define DELETED				     1
#define ERR_ALREADY_LOGGED		     4
#define INTERP_DEBUG_FRAME		  0x10
#define DONT_COMPILE_CMDS_INLINE	  0x20
#define RAND_SEED_INITIALIZED		  0x40
#define SAFE_INTERP			  0x80
#define INTERP_TRACE_IN_PROGRESS	 0x200
#define INTERP_ALTERNATE_WRONG_ARGS	 0x400
#define ERR_LEGACY_COPY			 0x800
#define CANCELED			0x1000

/*
 * Maximum number of levels of nesting permitted in Tcl commands (used to
 * catch infinite recursion).
 */

#define MAX_NESTING_DEPTH	1000
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2068
2069
2070
2071
2072
2073
2074







2075
2076
2077
2078
2079
2080
2081







-
-
-
-
-
-
-







 * This macro is only used by tclCompile.c in the core (Bug 926445). It
 * however not be made file static, as extensions that touch bytecodes
 * (notably tbcload) require it.
 */

#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)

/*
 * A common panic alert when memory allocation fails.
 */

#define TclOOM(ptr, size) \
	((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1)))

/*
 * The following enum values are used to specify the runtime platform setting
 * of the tclPlatform variable.
 */

typedef enum {
    TCL_PLATFORM_UNIX = 0,	/* Any Unix-like OS. */
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
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







-
+







-
+




-
-







+
+
+
+
+
+







 * struct is grown (reallocated and copied) as necessary to hold all the
 * list's element pointers. The struct might contain more slots than currently
 * used to hold all element pointers. This is done to make append operations
 * faster.
 */

typedef struct List {
    size_t refCount;
    int refCount;
    int maxElemCount;		/* Total number of element array slots. */
    int elemCount;		/* Current number of list elements. */
    int canonicalFlag;		/* Set if the string representation was
				 * derived from the list representation. May
				 * be ignored if there is no string rep at
				 * all.*/
    Tcl_Obj *elements;		/* First list element; the struct is grown to
				 * accommodate all elements. */
				 * accomodate all elements. */
} List;

#define LIST_MAX \
	(1 + (int)(((size_t)UINT_MAX - sizeof(List))/sizeof(Tcl_Obj *)))
#define LIST_SIZE(numElems) \
	(sizeof(List) + (((numElems) - 1) * sizeof(Tcl_Obj *)))

/*
 * Macro used to get the elements of a list object.
 */

#define ListRepPtr(listPtr) \
    ((List *) (listPtr)->internalRep.twoPtrValue.ptr1)

#define ListSetIntRep(objPtr, listRepPtr) \
    (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \
    (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \
    (listRepPtr)->refCount++, \
    (objPtr)->typePtr = &tclListType

#define ListObjGetElements(listPtr, objc, objv) \
    ((objv) = &(ListRepPtr(listPtr)->elements), \
     (objc) = ListRepPtr(listPtr)->elemCount)

#define ListObjLength(listPtr, len) \
    ((len) = ListRepPtr(listPtr)->elemCount)
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
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







-
-
-
-
-
-
-
-
-
-
+
+
-




-
-
-
-
-
-
-


-
+

-
-
-
-
-
-
-
-

+

-
-
+
+
-
-


-
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
+











-
+





-
+







	    ? ((ListObjLength((listPtr), *(lenPtr))), TCL_OK)\
	    : Tcl_ListObjLength((interp), (listPtr), (lenPtr)))

#define TclListObjIsCanonical(listPtr) \
    (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0)

/*
 * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
 * TclNRLmapCmd and their compilations.
 */

#define TCL_EACH_KEEP_NONE  0	/* Discard iteration result like [foreach] */
#define TCL_EACH_COLLECT    1	/* Collect iteration result like [lmap] */

/*
 * Macros providing a faster path to booleans and integers:
 * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
 * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere,
 * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints.
 * and Tcl_GetIntForIndex.
 *
 * WARNING: these macros eval their args more than once.
 */

#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    || (objPtr)->typePtr == &tclBooleanType) \
	? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
	: Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))

#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
	    ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#else
#define TclGetLongFromObj(interp, objPtr, longPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
#endif

#if (LONG_MAX == INT_MAX)
#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType \
	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
    (((objPtr)->typePtr == &tclIntType)	\
	    ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
    ((((objPtr)->typePtr == &tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
    (((objPtr)->typePtr == &tclIntType)	\
	    && ((Tcl_WideUInt)(objPtr)->internalRep.wideValue <= (size_t)(endValue) + 1)) \
	    ? ((*(idxPtr) = (size_t)(objPtr)->internalRep.wideValue), TCL_OK) \
	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))

	    ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
	    : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#else
/*
 * Macro used to save a function call for common uses of
 * Tcl_GetWideIntFromObj(). The ANSI C "prototype" is:
 *
 * MODULE_SCOPE int TclGetWideIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 *			Tcl_WideInt *wideIntPtr);
 */

#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
#define TclGetIntFromObj(interp, objPtr, intPtr) \
    (((objPtr)->typePtr == &tclIntType)					\
	? (*(wideIntPtr) =						\
		((objPtr)->internalRep.wideValue), TCL_OK) :		\
	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
    Tcl_GetIntFromObj((interp), (objPtr), (intPtr))
#define TclGetIntForIndexM(interp, objPtr, ignore, idxPtr)	\
    TclGetIntForIndex(interp, objPtr, ignore, idxPtr)
#endif

/*
 * Flag values for TclTraceDictPath().
 *
 * DICT_PATH_READ indicates that all entries on the path must exist but no
 * updates will be needed.
 *
 * DICT_PATH_UPDATE indicates that we are going to be doing an update at the
 * tip of the path, so duplication of shared objects should be done along the
 * way.
 *
 * DICT_PATH_EXISTS indicates that we are performing an existence test and a
 * DICT_PATH_EXISTS indicates that we are performing an existance test and a
 * lookup failure should therefore not be an error. If (and only if) this flag
 * is set, TclTraceDictPath() will return the special value
 * DICT_PATH_NON_EXISTENT if the path is not traceable.
 *
 * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set)
 * indicates that we are to create non-existent dictionaries on the path.
 * indicates that we are to create non-existant dictionaries on the path.
 */

#define DICT_PATH_READ		0
#define DICT_PATH_UPDATE	1
#define DICT_PATH_EXISTS	2
#define DICT_PATH_CREATE	5

2522
2523
2524
2525
2526
2527
2528
2529

2530
2531
2532
2533
2534
2535
2536
2537
2538
2238
2239
2240
2241
2242
2243
2244

2245


2246
2247
2248
2249
2250
2251
2252







-
+
-
-







 * been thoroughly tested and investigated a new public filesystem interface
 * will be released. The aim is more versatile virtual filesystem interfaces,
 * more efficiency in 'path' manipulation and usage, and cleaner filesystem
 * code internally.
 */

#define TCL_FILESYSTEM_VERSION_2	((Tcl_FSVersion) 0x2)
typedef void *(TclFSGetCwdProc2)(void *clientData);
typedef ClientData (TclFSGetCwdProc2)(ClientData clientData);
typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr,
	Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags);

/*
 * The following types are used for getting and storing platform-specific file
 * attributes in tclFCmd.c and the various platform-versions of that file.
 * This is done to have as much common code as possible in the file attributes
 * code. For more information about the callbacks, see TclFileAttrsCmd in
 * tclFCmd.c.
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
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







-
-
+
+

-
+
















-
+





-
-
-
+
+
+



-
-
-
-
-
+
+
+
+
+


-
+








/*
 *----------------------------------------------------------------
 * Data structures related to obsolete filesystem hooks
 *----------------------------------------------------------------
 */

typedef int (TclStatProc_)(const char *path, struct stat *buf);
typedef int (TclAccessProc_)(const char *path, int mode);
typedef int (TclStatProc_)(CONST char *path, struct stat *buf);
typedef int (TclAccessProc_)(CONST char *path, int mode);
typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp,
	const char *fileName, const char *modeString, int permissions);
	CONST char *fileName, CONST char *modeString, int permissions);

/*
 *----------------------------------------------------------------
 * Data structures related to procedures
 *----------------------------------------------------------------
 */

typedef Tcl_CmdProc *TclCmdProcType;
typedef Tcl_ObjCmdProc *TclObjCmdProcType;

/*
 *----------------------------------------------------------------
 * Data structures for process-global values.
 *----------------------------------------------------------------
 */

typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
	Tcl_Encoding *encodingPtr);

/*
 * A ProcessGlobalValue struct exists for each internal value in Tcl that is
 * to be shared among several threads. Each thread sees a (Tcl_Obj) copy of
 * the value, and the gobal value is kept as a counted string, with epoch and
 * mutex control. Each ProcessGlobalValue struct should be a static variable in
 * some file.
 * the value, and the master is kept as a counted string, with epoch and mutex
 * control. Each ProcessGlobalValue struct should be a static variable in some
 * file.
 */

typedef struct ProcessGlobalValue {
    size_t epoch;		/* Epoch counter to detect changes in the
				 * global value. */
    size_t numBytes;		/* Length of the global string. */
    char *value;		/* The global string value. */
    Tcl_Encoding encoding;	/* system encoding when global string was
    int epoch;			/* Epoch counter to detect changes in the
				 * master value. */
    int numBytes;		/* Length of the master string. */
    char *value;		/* The master string value. */
    Tcl_Encoding encoding;	/* system encoding when master string was
				 * initialized. */
    TclInitProcessGlobalValueProc *proc;
    				/* A procedure to initialize the global string
    				/* A procedure to initialize the master string
				 * copy when a "get" request comes in before
				 * any "set" request has been received. */
    Tcl_Mutex mutex;		/* Enforce orderly access from multiple
				 * threads. */
    Tcl_ThreadDataKey key;	/* Key for per-thread data holding the
				 * (Tcl_Obj) copy for each thread. */
} ProcessGlobalValue;
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660


2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713




2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724


2725
2726

2727
2728
2729
2730
2731
2732
2733
2734
2735

2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772

2773
2774
2775
2776
2777

2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791

2792
2793
2794
2795
2796
2797
2798
2799

2800
2801
2802
2803

2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818

2819
2820
2821
2822
2823
2824
2825
2826

2827
2828



2829
2830
2831
2832
2833




2834
2835
2836
2837
2838
2839
2840
2841
2842

2843
2844
2845

2846
2847

2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860















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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872

3873
3874
3875
3876
3877
3878

3879
3880
3881
3882
3883
3884

3885
3886
3887
3888
3889
3890

3891
3892
3893
3894
3895
3896

3897
3898
3899
3900
3901
3902

3903
3904
3905
3906
3907
3908

3909
3910
3911
3912
3913
3914

3915
3916
3917
3918
3919
3920

3921
3922
3923
3924
3925
3926

3927
3928
3929
3930
3931
3932

3933
3934
3935
3936
3937
3938

3939
3940
3941
3942
3943
3944

3945
3946
3947
3948
3949
3950

3951
3952
3953
3954
3955
3956

3957
3958
3959
3960
3961
3962

3963
3964
3965
3966
3967
3968

3969
3970
3971
3972
3973
3974
3975
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


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
2658
2659
2660
2661
2662
2663
2664
2665

2666


2667
2668
2669
2670
2671
2672




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
2709
2710
2711
2712
2713
2714
2715


2716
2717
2718

2719
2720
2721
2722
2723
2724
2725

2726



2727
2728
2729
2730
2731

2732


2733
2734

2735
2736
2737



2738

2739







2740
2741
2742
2743




2744




2745
2746







2747
2748
2749
2750
2751
2752
2753
2754
2755





















2756
2757
2758
2759
2760
2761

2762
2763
2764
2765
2766
2767

2768
2769
2770

2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795


2796








2797
2798
2799
2800
2801
2802
2803
2804

2805
2806
2807
2808
2809
2810
2811
2812
2813
2814

2815
2816
2817

2818
2819
2820

2821
2822
2823
2824



2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835

2836
2837
2838

2839
2840
2841
2842

2843
2844
2845

2846
2847
2848




2849
2850

2851
2852

2853
2854
2855

2856
2857
2858

2859
2860
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

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







-
-
-
-







-
+
+














-
+










-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
+
+
+
+









-
-
+
+

-
+








-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-

-
-
-
+
-
-
-

-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-






+
-
-
+
+
+





+
+
+
+








-
+
-
-
-
+
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+


-
-
-
+


-
-
-
-
-
+



-
+


-
+

-
-
-
-
-
-
-

-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-

-
+

-
+
-
-
-
-
-
-
-
-
-





-











-


-
+

-
+



-
-
-
-
-
-
-






-
-
-
-
-

-
+





-
+
-

-
+
-
-
-
-
-







-
+

-
-

-
+

-
+

-
+












+

-
-
+
-
-










-
-
+
+
+
+
+
+







-
-
+
+



-












-
+
-
-


-
+

-
-
+
+


+
+
+


-

-
-
+
+




-
-
-
-

-
-
-
+
+
+

-
+




-
-
+
+













-
+




-
-
-
-
-


+
+
+


+
+
+
+

+
-
-
+
+

-
+
+





-
+
-
-
-
+
+



-
+
-
-


-



-
-
-

-
+
-
-
-
-
-
-
-
+



-
-
-
-
+
-
-
-
-


-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

+
+


-
+





-
+


-
+


+
+
+
+
+
+
+















-
-
+
-
-
-
-
-
-
-
-
+







-
+









-
+


-
+


-
+


+
-
-
-
+
+
+
+
+
+


+
+
+
-
+


-
+



-
+


-
+


-
-
-
-


-
+

-
+


-
+


-
+




-
+

-
+


-
-
-
-
-
-
-
+


-
-
-
+


-
-
-
-
-
+


-
+


-
+


-
+


-
+


-
+


-
+



-
+

-
+


+
-
-
+
+
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+



-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
-
-
-
+


-
-
-
-
+


-
-
-
-
+


-
+


-
+


-
+


-
+


-
+


+
-
-


-
+


-
+


-
+


-
-
+


-
+


-
+


-
+


-
+


-
+


-
-
-
-
+


-
+


-
+


-
+


-
+


-
+


-
+



-
+


-
+


-
+


-
-
-
+


-
+


-
+


-
+


-
-
-
-
+


-
+


-
+


-
+


-
+


-
+


-
+












-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-
-
-






-
-
-
-
-
-






-
-
-






-
-
-
-
-
-



-
-
-



-
-
-



-
-
-









-
-
-






-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-












-
-
-






-
-
-
-
-
-
-
-
-



-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-



-
-
-






-
-
-






-
-
-



-
-
-
-
-
-
-
-
-



-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+





-
+







#define TCL_PARSE_INTEGER_ONLY		8
				/* Disable floating point parsing. */
#define TCL_PARSE_SCAN_PREFIXES		16
				/* Use [scan] rules dealing with 0?
				 * prefixes. */
#define TCL_PARSE_NO_WHITESPACE		32
				/* Reject leading/trailing whitespace. */
#define TCL_PARSE_BINARY_ONLY	64
				/* Parse binary even without prefix. */
#define TCL_PARSE_NO_UNDERSCORE	128
				/* Reject underscore digit separator */

/*
 *----------------------------------------------------------------------
 * Type values TclGetNumberFromObj
 *----------------------------------------------------------------------
 */

#define TCL_NUMBER_INT		2
#define TCL_NUMBER_LONG		1
#define TCL_NUMBER_WIDE		2
#define TCL_NUMBER_BIG		3
#define TCL_NUMBER_DOUBLE	4
#define TCL_NUMBER_NAN		5

/*
 *----------------------------------------------------------------
 * Variables shared among Tcl modules but not used by the outside world.
 *----------------------------------------------------------------
 */

MODULE_SCOPE char *tclNativeExecutableName;
MODULE_SCOPE int tclFindExecutableSearchDone;
MODULE_SCOPE char *tclMemDumpFileName;
MODULE_SCOPE TclPlatformType tclPlatform;
MODULE_SCOPE Tcl_NotifierProcs tclNotifierHooks;
MODULE_SCOPE Tcl_NotifierProcs tclOriginalNotifier;

MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;

/*
 * TIP #233 (Virtualized Time)
 * Data for the time hooks, if any.
 */

MODULE_SCOPE Tcl_GetTimeProc *tclGetTimeProcPtr;
MODULE_SCOPE Tcl_ScaleTimeProc *tclScaleTimeProcPtr;
MODULE_SCOPE void *tclTimeClientData;
MODULE_SCOPE ClientData tclTimeClientData;

/*
 * Variables denoting the Tcl object types defined in the core.
 */

MODULE_SCOPE const Tcl_ObjType tclBignumType;
MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;
MODULE_SCOPE Tcl_ObjType tclBignumType;
MODULE_SCOPE Tcl_ObjType tclBooleanType;
MODULE_SCOPE Tcl_ObjType tclByteArrayType;
MODULE_SCOPE Tcl_ObjType tclByteCodeType;
MODULE_SCOPE Tcl_ObjType tclDoubleType;
MODULE_SCOPE Tcl_ObjType tclEndOffsetType;
MODULE_SCOPE Tcl_ObjType tclIntType;
MODULE_SCOPE Tcl_ObjType tclListType;
MODULE_SCOPE Tcl_ObjType tclDictType;
MODULE_SCOPE Tcl_ObjType tclProcBodyType;
MODULE_SCOPE Tcl_ObjType tclStringType;
MODULE_SCOPE Tcl_ObjType tclArraySearchType;
MODULE_SCOPE Tcl_ObjType tclEnsembleCmdType;
#ifndef NO_WIDE_TYPE
MODULE_SCOPE Tcl_ObjType tclWideIntType;
#endif
MODULE_SCOPE Tcl_ObjType tclRegexpType;

/*
 * Variables denoting the hash key types defined in the core.
 */

MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType;
MODULE_SCOPE Tcl_HashKeyType tclArrayHashKeyType;
MODULE_SCOPE Tcl_HashKeyType tclOneWordHashKeyType;
MODULE_SCOPE Tcl_HashKeyType tclStringHashKeyType;
MODULE_SCOPE Tcl_HashKeyType tclObjHashKeyType;

/*
 * The head of the list of free Tcl objects, and the total number of Tcl
 * objects ever allocated and freed.
 */

MODULE_SCOPE Tcl_Obj *	tclFreeObjList;

#ifdef TCL_COMPILE_STATS
MODULE_SCOPE size_t	tclObjsAlloced;
MODULE_SCOPE size_t	tclObjsFreed;
MODULE_SCOPE long	tclObjsAlloced;
MODULE_SCOPE long	tclObjsFreed;
#define TCL_MAX_SHARED_OBJ_STATS 5
MODULE_SCOPE size_t	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
MODULE_SCOPE long	tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
#endif /* TCL_COMPILE_STATS */

/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

MODULE_SCOPE char	tclEmptyString;
MODULE_SCOPE char *	tclEmptyStringRep;

enum CheckEmptyStringResult {
	TCL_EMPTYSTRING_UNKNOWN = -1, TCL_EMPTYSTRING_NO, TCL_EMPTYSTRING_YES
};

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world,
 * introduced by/for NRE.
 *----------------------------------------------------------------
 */

MODULE_SCOPE Tcl_ObjCmdProc TclNRApplyObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNREvalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCatchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRExprObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRForeachCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRIfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRLmapCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRPackageObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSourceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRSwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTryObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRUplevelObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRWhileObjCmd;

MODULE_SCOPE Tcl_NRPostProc TclNRForIterCallback;
MODULE_SCOPE Tcl_NRPostProc TclNRCoroutineActivateCallback;
MODULE_SCOPE Tcl_ObjCmdProc TclNRTailcallObjCmd;
MODULE_SCOPE Tcl_NRPostProc TclNRTailcallEval;
MODULE_SCOPE Tcl_ObjCmdProc TclNRCoroutineObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
MODULE_SCOPE char	tclEmptyString;
MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;

MODULE_SCOPE void  TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void  TclPushTailcallPoint(Tcl_Interp *interp);

/* Flags for conversion of doubles to digit strings */
/* These two can be considered for the public api */
MODULE_SCOPE void  TclMarkTailcall(Tcl_Interp *interp);
MODULE_SCOPE void  TclSkipTailcall(Tcl_Interp *interp);

/*
 * This structure holds the data for the various iteration callbacks used to
 * NRE the 'for' and 'while' commands. We need a separate structure because we
 * have more than the 4 client data entries we can provide directly thorugh
 * the callback API. It is the 'word' information which puts us over the
 * limit. It is needed because the loop body is argument 4 of 'for' and
 * argument 2 of 'while'. Not providing the correct index confuses the #280
 * code. We TclSmallAlloc/Free this.
 */

#define TCL_DD_SHORTEST 		0x4
typedef struct ForIterData {
    Tcl_Obj *cond;		/* Loop condition expression. */
    Tcl_Obj *body;		/* Loop body. */
    Tcl_Obj *next;		/* Loop step script, NULL for 'while'. */
    const char *msg;		/* Error message part. */
    int word;			/* Index of the body script in the command */
} ForIterData;

				/* Use the shortest possible string */
/* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile
 *            and Tcl_FindSymbol. This structure corresponds to an opaque
 *            typedef in tcl.h */

#define TCL_DD_STEELE   		0x5
typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
				const char* symbol);
struct Tcl_LoadHandle_ {
    void *clientData;	/* Client data is the load handle in the
				 * native filesystem if a module was loaded
				 * there, or an opaque pointer to a structure
				 * for further bookkeeping on load-from-VFS
				 * and load-from-memory */
    TclFindSymbolProc* findSymbolProcPtr;
				/* Procedure that resolves symbols in a
				 * loaded module */
    Tcl_FSUnloadFileProc* unloadFileProcPtr;
				/* Procedure that unloads a loaded module */
};

				/* Use the original Steele&White algorithm */
/* Flags for conversion of doubles to digit strings */

#define TCL_DD_E_FORMAT 		0x2
				/* Use a fixed-length string of digits,
				 * suitable for E format*/
#define TCL_DD_F_FORMAT 		0x3
				/* Use a fixed number of digits after the
				 * decimal point, suitable for F format */

#define TCL_DD_SHORTEST 		0x4
				/* Use the shortest possible string */
#define TCL_DD_SHORTEN_FLAG 		0x4
				/* Allow return of a shorter digit string
				 * if it converts losslessly */
#define TCL_DD_NO_QUICK 		0x8
				/* Debug flag: forbid quick FP conversion */

#define TCL_DD_CONVERSION_TYPE_MASK	0x3
				/* Mask to isolate the conversion type */
#define TCL_DD_STEELE0 			0x1
				/* 'Steele&White' after masking */
#define TCL_DD_SHORTEST0		0x0
				/* 'Shortest possible' after masking */

/*
 *----------------------------------------------------------------
 * Procedures shared among Tcl modules but not used by the outside world:
 *----------------------------------------------------------------
 */

MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
			    const unsigned char *bytes, size_t len);
			    const unsigned char *bytes, int len);
MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int flags);
MODULE_SCOPE void	TclAdvanceContinuations(int *line, int **next,
MODULE_SCOPE void       TclAdvanceContinuations(int* line, int** next, int loc);
			    int loc);
MODULE_SCOPE void	TclAdvanceLines(int *line, const char *start,
MODULE_SCOPE void       TclAdvanceLines(int *line, const char *start,
			    const char *end);
MODULE_SCOPE void	TclArgumentEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc, CmdFrame *cf);
MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc);
MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc,
			    void *codePtr, CmdFrame *cfPtr, int cmd, size_t pc);
MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
			    CmdFrame *cfPtr);
MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE double	TclBignumToDouble(const void *bignum);
MODULE_SCOPE void       TclArgumentEnter(Tcl_Interp* interp,
			    Tcl_Obj* objv[], int objc, CmdFrame* cf);
MODULE_SCOPE void       TclArgumentRelease(Tcl_Interp* interp,
			    Tcl_Obj* objv[], int objc);
MODULE_SCOPE void       TclArgumentGet(Tcl_Interp* interp, Tcl_Obj* obj,
			    CmdFrame **cfPtrPtr, int *wordPtr);
MODULE_SCOPE void       TclArgumentBCEnter(Tcl_Interp *interp,
			    Tcl_Obj* objv[], int objc,
			    void *codePtr, CmdFrame *cfPtr, int pc);
MODULE_SCOPE void       TclArgumentBCRelease(Tcl_Interp *interp,
			    Tcl_Obj *objv[], int objc,
			    void *codePtr, int pc);
MODULE_SCOPE int	TclArraySet(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj);
MODULE_SCOPE double	TclBignumToDouble(mp_int *bignum);
MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
			    size_t strLen, const unsigned char *pattern,
			    size_t ptnLen, int flags);
MODULE_SCOPE double	TclCeil(const void *a);
			    int strLen, const unsigned char *pattern,
			    int ptnLen, int flags);
MODULE_SCOPE double	TclCeil(mp_int *a);
MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *name, int index);
MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
MODULE_SCOPE int	TclCheckBadOctal(Tcl_Interp *interp, const char *value);
MODULE_SCOPE int	TclChanCaughtErrorBypass(Tcl_Interp *interp,
			    Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
			    Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
MODULE_SCOPE ContLineLoc* TclContinuationsEnter(Tcl_Obj *objPtr, int num,
			    int *loc);
MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
			    int start, int *clNext);
MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE ContLineLoc* TclContinuationsGet(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
			    Tcl_Obj *originObjPtr);
MODULE_SCOPE size_t	TclConvertElement(const char *src, size_t length,
MODULE_SCOPE int	TclConvertElement(CONST char *src, int length,
			    char *dst, int flags);
MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
			    const char *name, Tcl_Namespace *nameNamespacePtr,
			    Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
			    const char *dict, int dictLength,
			    const char **elementPtr, const char **nextPtr,
			    size_t *sizePtr, int *literalPtr);
/* TIP #280 - Modified token based evaluation, with line information. */
/* TIP #280 - Modified token based evulation, with line information. */
MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
			    size_t numBytes, int flags, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileMakeDirsCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTempDirCmd;
			    int numBytes, int flags, int line,
			    int *clNextOuter, CONST char *outerScript);
MODULE_SCOPE int	TclFileAttrsCmd(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclFileCopyCmd(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclFileDeleteCmd(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclFileMakeDirsCmd(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclFileRenameCmd(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
			    ClientData clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int *objcPtr);
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);
MODULE_SCOPE void	TclFinalizeExecution(void);
MODULE_SCOPE void	TclFinalizeIOSubsystem(void);
MODULE_SCOPE void	TclFinalizeFilesystem(void);
MODULE_SCOPE void	TclResetFilesystem(void);
MODULE_SCOPE void	TclFinalizeLoad(void);
MODULE_SCOPE void	TclFinalizeLock(void);
MODULE_SCOPE void	TclFinalizeMemorySubsystem(void);
MODULE_SCOPE void	TclFinalizeNotifier(void);
MODULE_SCOPE void	TclFinalizeObjects(void);
MODULE_SCOPE void	TclFinalizePreserve(void);
MODULE_SCOPE void	TclFinalizeSynchronization(void);
MODULE_SCOPE void	TclInitThreadAlloc(void);
MODULE_SCOPE void	TclFinalizeThreadAlloc(void);
MODULE_SCOPE void	TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void	TclFinalizeThreadData(int quick);
MODULE_SCOPE void	TclFinalizeThreadData(void);
MODULE_SCOPE void	TclFinalizeThreadObjects(void);
MODULE_SCOPE double	TclFloor(const void *a);
MODULE_SCOPE double	TclFloor(mp_int *a);
MODULE_SCOPE void	TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int	TclFSFileAttrIndex(Tcl_Obj *pathPtr,
			    const char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
			    const char *cmdName, Tcl_Namespace *nsPtr,
			    Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
			    void *clientData,
			    Tcl_CmdDeleteProc *deleteProc);
MODULE_SCOPE int	TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    const char *encodingName);
MODULE_SCOPE void	TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE int *	TclGetAsyncReadyPtr(void);
MODULE_SCOPE Tcl_Obj *	TclGetBgErrorHandler(Tcl_Interp *interp);
MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Channel *chanPtr,
			    int *modePtr, int flags);
MODULE_SCOPE CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,
			    Tcl_Obj *value, int *code);
MODULE_SCOPE Proc *	TclGetLambdaFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr);
MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, void **clientDataPtr,
			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
			    int *typePtr);
MODULE_SCOPE int	TclGetOpenModeEx(Tcl_Interp *interp,
			    const char *modeString, int *seekFlagPtr,
			    int *binaryPtr);
MODULE_SCOPE Tcl_Obj *	TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr);
MODULE_SCOPE Tcl_Obj *	TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
MODULE_SCOPE const char *TclGetSrcInfoForCmd(Interp *iPtr, int *lenPtr);
			    Tcl_Obj *const objv[]);
MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
			    size_t *sizePtr);
			    unsigned int *sizePtr);
MODULE_SCOPE int	TclGetLoadedPackagesEx(Tcl_Interp *interp,
				const char *targetName,
				const char *packageName);
MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
				Tcl_WideInt *);
MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
			    Tcl_Obj *unquotedPrefix, int globFlags,
			    Tcl_GlobTypeData *types);
MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
			    Tcl_Obj *incrPtr);
MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, int flags);
MODULE_SCOPE int	TclInfoExistsCmd(void *dummy, Tcl_Interp *interp,
MODULE_SCOPE int	TclInfoExistsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoCoroutineCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Obj *	TclInfoFrame(Tcl_Interp *interp, CmdFrame *framePtr);
MODULE_SCOPE int	TclInfoGlobalsCmd(void *dummy, Tcl_Interp *interp,
MODULE_SCOPE int	TclInfoGlobalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoLocalsCmd(void *dummy, Tcl_Interp *interp,
MODULE_SCOPE int	TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclInfoVarsCmd(void *dummy, Tcl_Interp *interp,
MODULE_SCOPE int	TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclInitAlloc(void);
MODULE_SCOPE void	TclInitDbCkalloc(void);
MODULE_SCOPE void	TclInitDoubleConversion(void);
MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation(
			    Tcl_Interp *interp);
MODULE_SCOPE void	TclInitEncodingSubsystem(void);
MODULE_SCOPE void	TclInitIOSubsystem(void);
MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
MODULE_SCOPE void	TclInitNotifier(void);
MODULE_SCOPE void	TclInitObjSubsystem(void);
MODULE_SCOPE void	TclInitSubsystems(void);
MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
MODULE_SCOPE int	TclIsDigitProc(int byte);
MODULE_SCOPE int	TclIsBareword(int byte);
MODULE_SCOPE int	TclIsBareword(char byte);
MODULE_SCOPE Tcl_Obj *	TclJoinPath(int elements, Tcl_Obj * const objv[],
			    int forceRelative);
MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    int indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, int line, int n,
			    int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Obj *listPtr, size_t fromIdx,
			    size_t toIdx);
MODULE_SCOPE int	TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int symc, const char *symbols[],
			    Tcl_PackageInitProc **procPtrs[],
			    Tcl_LoadHandle *handlePtr,
			    ClientData *clientDataPtr,
			    Tcl_FSUnloadFileProc **unloadProcPtr);
MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    int indexCount, Tcl_Obj *const indexArray[],
			    Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
			    const EnsembleImplMap map[]);
MODULE_SCOPE int	TclMaxListLength(const char *bytes, size_t numBytes,
			    const char **endPtr);
MODULE_SCOPE int	TclMaxListLength(CONST char *bytes, int numBytes,
			    CONST char **endPtr);
MODULE_SCOPE int	TclMergeReturnOptions(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr,
			    int *codePtr, int *levelPtr);
MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
MODULE_SCOPE int	TclNokia770Doubles(void);
MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const char *operation,
			    const char *reason, int index);
MODULE_SCOPE int	TclObjInvokeNamespace(Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[],
			    Tcl_Namespace *nsPtr, int flags);
MODULE_SCOPE int	TclObjUnsetVar2(Tcl_Interp *interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags);
MODULE_SCOPE int	TclParseBackslash(const char *src,
			    size_t numBytes, size_t *readPtr, char *dst);
			    int numBytes, int *readPtr, char *dst);
MODULE_SCOPE int	TclParseHex(const char *src, size_t numBytes,
			    int *resultPtr);
MODULE_SCOPE int	TclParseNumber(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    const char *expected, const char *bytes,
			    size_t numBytes, const char **endPtrPtr, int flags);
			    int numBytes, const char **endPtrPtr, int flags);
MODULE_SCOPE void	TclParseInit(Tcl_Interp *interp, const char *string,
			    size_t numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE size_t	TclParseAllWhiteSpace(const char *src, size_t numBytes);
			    int numBytes, Tcl_Parse *parsePtr);
MODULE_SCOPE int	TclParseAllWhiteSpace(const char *src, int numBytes);
MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
			    int code, int level, Tcl_Obj *returnOpts);
#ifndef TCL_NO_STACK_CHECK
MODULE_SCOPE int        TclpGetCStackParams(int **stackBoundPtr);
#endif
MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
			    size_t len);
MODULE_SCOPE int	TclpDeleteFile(const void *path);
			    int len);
MODULE_SCOPE int	TclpDeleteFile(const char *path);
MODULE_SCOPE void	TclpFinalizeCondition(Tcl_Condition *condPtr);
MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
MODULE_SCOPE void	TclpFinalizePipes(void);
MODULE_SCOPE void	TclpFinalizeSockets(void);
MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
			    struct addrinfo **addrlist,
			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
			    Tcl_ThreadCreateProc *proc, void *clientData,
			    size_t stackSize, int flags);
MODULE_SCOPE size_t	TclpFindVariable(const char *name, size_t *lengthPtr);
			    Tcl_ThreadCreateProc proc, ClientData clientData,
			    int stackSize, int flags);
MODULE_SCOPE int	TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void	TclpInitLibraryPath(char **valuePtr,
			    size_t *lengthPtr, Tcl_Encoding *encodingPtr);
			    int *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void	TclpInitLock(void);
MODULE_SCOPE void	TclpInitPlatform(void);
MODULE_SCOPE void	TclpInitUnlock(void);
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpGlobalLock(void);
MODULE_SCOPE void	TclpGlobalUnlock(void);
MODULE_SCOPE void	TclpMasterLock(void);
MODULE_SCOPE void	TclpMasterUnlock(void);
MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
			    Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int nextCheckpoint);
MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
MODULE_SCOPE void	*TclpGetNativeCwd(void *clientData);
MODULE_SCOPE ClientData	TclpGetNativeCwd(ClientData clientData);
MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
MODULE_SCOPE Tcl_Obj *	TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
			    int linkType);
MODULE_SCOPE int	TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
			    Tcl_Obj *resultingNameObj);
MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName);
MODULE_SCOPE void *TclInitPkgFiles(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_PathPart portion);
#ifndef TclpPanic
MODULE_SCOPE void	TclpPanic(const char *format, ...);
#endif
MODULE_SCOPE char *	TclpReadlink(const char *fileName,
			    Tcl_DString *linkPtr);
#ifndef TclpReleaseFile
MODULE_SCOPE void	TclpReleaseFile(TclFile file);
#endif
MODULE_SCOPE void	TclpSetInterfaces(void);
MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
MODULE_SCOPE void	TclpUnloadFile(Tcl_LoadHandle loadHandle);
MODULE_SCOPE void *	TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void	TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
MODULE_SCOPE void *	TclpThreadDataKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void	TclpThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
			    void *data);
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void	TclpThreadExit(int status);
MODULE_SCOPE size_t	TclpThreadGetStackSize(void);
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    size_t reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
			    int *quantifiersFoundPtr);
MODULE_SCOPE size_t	TclScanElement(const char *string, size_t length,
			    char *flagPtr);
MODULE_SCOPE int	TclScanElement(CONST char *string, int length,
			    int *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumIntRep(Tcl_Obj *objPtr,
			    void *bignumValue);
			    mp_int *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, size_t subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    size_t numBytes);
			    int numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
			    int checkEq, int nocase, size_t reqlength);
MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    int *reqlength);
MODULE_SCOPE int	TclStringMatch(const char *str, size_t strLen,
MODULE_SCOPE int	TclStringMatch(const char *str, int strLen,
			    const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
			    Tcl_Obj *patternObj, int flags);
MODULE_SCOPE void	TclSubstCompile(Tcl_Interp *interp, const char *bytes,
			    size_t numBytes, int flags, int line,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclSubstOptions(Tcl_Interp *interp, int numOpts,
MODULE_SCOPE Tcl_Obj *	TclStringObjReverse(Tcl_Obj *objPtr);
			    Tcl_Obj *const opts[], int *flagPtr);
MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
			    size_t numBytes, int flags, Tcl_Parse *parsePtr,
			    Tcl_InterpState *statePtr);
MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
			    int count, int *tokensLeftPtr, int line,
			    int *clNextOuter, const char *outerScript);
MODULE_SCOPE size_t	TclTrim(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim, size_t *trimRight);
MODULE_SCOPE size_t	TclTrimLeft(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim);
MODULE_SCOPE size_t	TclTrimRight(const char *bytes, size_t numBytes,
			    const char *trim, size_t numTrim);
			    int *clNextOuter, CONST char *outerScript);
MODULE_SCOPE void	TclTransferResult(Tcl_Interp *sourceInterp, int result,
			    Tcl_Interp *targetInterp);
MODULE_SCOPE int	TclTrim(const char *bytes, int numBytes,
			    const char *trim, int numTrim, int *trimRight);
MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
			    const char *trim, int numTrim);
MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
MODULE_SCOPE void	TclRegisterCommandTypeName(
			    Tcl_ObjCmdProc *implementationProc,
			    const char *nameStr);
MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE size_t	TclUtfCount(int ch);
#if TCL_UTF_MAX > 3
#   define TclUtfToUCS4 Tcl_UtfToUniChar
#   define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
#   define TclUCS4Complete Tcl_UtfCharComplete
#   define TclChar16Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= 3) : Tcl_UtfCharComplete((src), (length)))
#else
    MODULE_SCOPE int	TclUtfToUCS4(const char *src, int *ucs4Ptr);
    MODULE_SCOPE int	TclUniCharToUCS4(const Tcl_UniChar *src, int *ucs4Ptr);
#   define TclUCS4Complete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
	    ? ((length) >= 4) : Tcl_UtfCharComplete((src), (length)))
#   define TclChar16Complete Tcl_UtfCharComplete
#endif
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(void *clientData);
MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_PackageInitProc *TclpFindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
			    Tcl_FSUnloadFileProc **unloadProcPtr);
MODULE_SCOPE int	TclpUtime(Tcl_Obj *pathPtr, struct utimbuf *tval);
#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void *	TclpLoadMemoryGetBuffer(Tcl_Interp *interp, int size);
MODULE_SCOPE int	TclpLoadMemory(Tcl_Interp *interp, void *buffer,
			    int size, int codeSize, Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
			    Tcl_FSUnloadFileProc **unloadProcPtr);
#endif
MODULE_SCOPE void	TclInitThreadStorage(void);
MODULE_SCOPE void	TclFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclpFinalizeThreadDataThread(void);
MODULE_SCOPE void	TclFinalizeThreadStorage(void);

/* TclWideMUInt -- wide integer used for measurement calculations: */
#if (!defined(_WIN32) || !defined(_MSC_VER) || (_MSC_VER >= 1400))
#   define TclWideMUInt Tcl_WideUInt
#else
/* older MSVS may not allow conversions between unsigned __int64 and double) */
#   define TclWideMUInt Tcl_WideInt
#endif
#ifdef TCL_WIDE_CLICKS
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#else
#   ifdef _WIN32
#	define TCL_WIDE_CLICKS 1
MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
MODULE_SCOPE double	TclpWideClickInMicrosec(void);
#	define		TclpWideClicksToNanoseconds(clicks) \
				((double)(clicks) * TclpWideClickInMicrosec() * 1000)
#   endif
#endif
MODULE_SCOPE Tcl_WideInt TclpGetMicroseconds(void);

MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
MODULE_SCOPE void *	TclpThreadCreateKey(void);
MODULE_SCOPE Tcl_Obj *	TclDisassembleByteCodeObj(Tcl_Obj *objPtr);
MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void	TclpThreadSetGlobalTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void *	TclpThreadGetGlobalTSD(void *tsdKeyPtr);
MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
			    const char *msg, size_t length);
/* Tip 430 */
MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);

MODULE_SCOPE int TclUtfCasecmp(CONST char *cs, CONST char *ct);

/*
 * Many parsing tasks need a common definition of whitespace.
 * Use this routine and macro to achieve that and place
 * optimization (fragile on changes) in one place.
 */

MODULE_SCOPE int	TclIsSpaceProc(int byte);
MODULE_SCOPE int	TclIsSpaceProc(char byte);
#	define TclIsSpaceProcM(byte) \
		(((byte) > 0x20) ? 0 : TclIsSpaceProc(byte))

/*
 *----------------------------------------------------------------
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	Tcl_AfterObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_AfterObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_AppendObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_AppendObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ApplyObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ApplyObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ArrayObjCmd(ClientData clientData,
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_BreakObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_BinaryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CatchObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CdObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_CdObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclChanCreateObjCmd(void *clientData,
MODULE_SCOPE int	TclChanCreateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPostEventObjCmd(void *clientData,
MODULE_SCOPE int	TclChanPostEventObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPopObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclChanPushObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclClockOldscanObjCmd(
			    void *clientData, Tcl_Interp *interp,
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_CloseObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_CloseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ConcatObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ConcatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ContinueObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ContinueObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
			    ClientData clientData);
MODULE_SCOPE int	TclDefaultBgErrorHandlerObjCmd(
			    void *clientData, Tcl_Interp *interp,
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int index, int pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    int pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE int	Tcl_DisassembleObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_DisassembleObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/* Assemble command function */
MODULE_SCOPE int	Tcl_AssembleObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_EncodingObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRAssembleObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_EofObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ErrorObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ErrorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_EvalObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_EvalObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExecObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ExecObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExitObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ExitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ExprObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ExprObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FblockedObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_FblockedObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FconfigureObjCmd(
			    void *clientData, Tcl_Interp *interp,
			    ClientData clientData, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FcopyObjCmd(void *dummy,
MODULE_SCOPE int	Tcl_FcopyObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FileObjCmd(ClientData dummy,
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_FileEventObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FileEventObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FlushObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_FlushObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ForObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ForeachObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ForeachObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_FormatObjCmd(void *dummy,
MODULE_SCOPE int	Tcl_FormatObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GetsObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_GetsObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobalObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_GlobalObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_GlobObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_GlobObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IfObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_IfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_IncrObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_IncrObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_InterpObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_InterpObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int argc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_JoinObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_JoinObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LappendObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LappendObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LassignObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LassignObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LindexObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LindexObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LinsertObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LinsertObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LlengthObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LlengthObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ListObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ListObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LmapObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LoadObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LoadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LpopObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrangeObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LrangeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LremoveObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LrepeatObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LrepeatObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreplaceObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LreplaceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LreverseObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LreverseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsearchObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LsearchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsetObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_LsortObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_LsortObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_NamespaceObjCmd(ClientData clientData,
MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclNamespaceEnsembleCmd(void *dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_OpenObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_OpenObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PackageObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_PackageObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PidObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_PidObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_PutsObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_PutsObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_PwdObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_PwdObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReadObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ReadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegexpObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_RegexpObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RegsubObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_RegsubObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RenameObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_RenameObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_RepresentationCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ReturnObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ReturnObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ScanObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_ScanObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SeekObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_SeekObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SetObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_SetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SplitObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_SplitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SocketObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_SocketObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SourceObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_SourceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_SubstObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_SubstObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_SwitchObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_SwitchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TellObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_TellObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_ThrowObjCmd(void *dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_TimeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TimeRateObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_TimeRateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TraceObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_TraceObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_TryObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_UnloadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnloadObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UnsetObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_UnsetObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpdateObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_UpdateObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UplevelObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_UplevelObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_UpvarObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_UpvarObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VariableObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_VariableObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_VwaitObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_VwaitObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	Tcl_WhileObjCmd(void *clientData,
MODULE_SCOPE int	Tcl_WhileObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------
 * Compilation procedures for commands in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclCompileAppendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileArrayExistsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileArraySetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileArrayUnsetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBreakCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileCatchCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileClockClicksCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileClockReadingCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileConcatCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileContinueCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictAppendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictCreateCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictExistsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictForCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictGetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictGetWithDefaultCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictIncrCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictLappendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictMapCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictMergeCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictSetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictUnsetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictUpdateCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileDictWithCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileEnsemble(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileErrorCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileExprCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileForCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileForeachCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileFormatCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileGlobalCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileIfCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileInfoCommandsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileInfoCoroutineCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileInfoExistsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileInfoLevelCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileInfoObjectClassCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileInfoObjectIsACmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileInfoObjectNamespaceCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileIncrCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLappendCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLassignCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLindexCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLinsertCmd(Tcl_Interp *interp,
			    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	TclCompileLmapCmd(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	TclCompileNamespaceCodeCmd(Tcl_Interp *interp,
MODULE_SCOPE int	TclCompileNamespaceCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileNamespaceCurrentCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileNamespaceOriginCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileNamespaceQualifiersCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileNamespaceTailCmd(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);
MODULE_SCOPE int	TclCompileNamespaceWhichCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileObjectNextCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileObjectNextToCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileObjectSelfCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileRegexpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileRegsubCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileReturnCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileSetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringCatCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringCmpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringEqualCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringFirstCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIndexCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringInsertCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringIsCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringLastCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringLenCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringMapCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringMatchCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringRangeCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringReplaceCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringToLowerCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringToTitleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringToUpperCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringTrimCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringTrimLCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStringTrimRCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileSubstCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileSwitchCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileTailcallCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileThrowCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileTryCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileUnsetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileUpvarCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileVariableCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileWhileCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileYieldCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileYieldToCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic0ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic1ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic2ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic3ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic0Or1ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic1Or2ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic2Or3ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic0To2ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasic1To3ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasicMin0ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasicMin1ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileBasicMin2ArgCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclInvertOpCmd(void *clientData,
MODULE_SCOPE int	TclInvertOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileInvertOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNotOpCmd(void *clientData,
MODULE_SCOPE int	TclNotOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNotOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclAddOpCmd(void *clientData,
MODULE_SCOPE int	TclAddOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileAddOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclMulOpCmd(void *clientData,
MODULE_SCOPE int	TclMulOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileMulOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclAndOpCmd(void *clientData,
MODULE_SCOPE int	TclAndOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileAndOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclOrOpCmd(void *clientData,
MODULE_SCOPE int	TclOrOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileOrOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclXorOpCmd(void *clientData,
MODULE_SCOPE int	TclXorOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileXorOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclPowOpCmd(void *clientData,
MODULE_SCOPE int	TclPowOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompilePowOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclLshiftOpCmd(void *clientData,
MODULE_SCOPE int	TclLshiftOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileLshiftOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclRshiftOpCmd(void *clientData,
MODULE_SCOPE int	TclRshiftOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileRshiftOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclModOpCmd(void *clientData,
MODULE_SCOPE int	TclModOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileModOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNeqOpCmd(void *clientData,
MODULE_SCOPE int	TclNeqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNeqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclStrneqOpCmd(void *clientData,
MODULE_SCOPE int	TclStrneqOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileStrneqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclInOpCmd(void *clientData,
MODULE_SCOPE int	TclInOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileInOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclNiOpCmd(void *clientData,
MODULE_SCOPE int	TclNiOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileNiOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclMinusOpCmd(void *clientData,
MODULE_SCOPE int	TclMinusOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileMinusOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclDivOpCmd(void *clientData,
MODULE_SCOPE int	TclDivOpCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclCompileDivOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLessOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
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







-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+













-
+


-
+



-
+



-
-
+
+
-
-
-
-
-

-
-















-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileEqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStreqOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStrLtOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStrLeOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStrGtOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileStrGeOpCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

/*
 * Routines that provide the [string] ensemble functionality. Possible
 * candidates for public interface.
 */

MODULE_SCOPE Tcl_Obj *	TclStringCat(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int flags);
MODULE_SCOPE Tcl_Obj *	TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
			    size_t start);
MODULE_SCOPE Tcl_Obj *	TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
			    size_t last);
MODULE_SCOPE Tcl_Obj *	TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t count, int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t first, size_t count, Tcl_Obj *insertPtr,
			    int flags);
MODULE_SCOPE Tcl_Obj *	TclStringReverse(Tcl_Obj *objPtr, int flags);

/* Flag values for the [string] ensemble functions. */

#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
#define TCL_STRING_IN_PLACE (1<<1)

/*
 * Functions defined in generic/tclVar.c and currently exported only for use
 * Functions defined in generic/tclVar.c and currenttly exported only for use
 * by the bytecode compiler and engine. Some of these could later be placed in
 * the public interface.
 */

MODULE_SCOPE Var *	TclObjLookupVarEx(Tcl_Interp * interp,
			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags,
			    const char *msg, const int createPart1,
			    const int createPart2, Var **arrayPtrPtr);
MODULE_SCOPE Var *	TclLookupArrayElement(Tcl_Interp *interp,
			    Tcl_Obj *arrayNamePtr, Tcl_Obj *elNamePtr,
			    const int flags, const char *msg,
			    const int createPart1, const int createPart2,
			    Var *arrayPtr, int index);
MODULE_SCOPE Tcl_Obj *	TclPtrGetVarIdx(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp,
			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const int flags, int index);
MODULE_SCOPE Tcl_Obj *	TclPtrSetVarIdx(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp,
			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
			    const int flags, int index);
MODULE_SCOPE Tcl_Obj *	TclPtrIncrObjVarIdx(Tcl_Interp *interp,
MODULE_SCOPE Tcl_Obj *	TclPtrIncrObjVar(Tcl_Interp *interp,
			    Var *varPtr, Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
			    const int flags, int index);
MODULE_SCOPE int	TclPtrObjMakeUpvarIdx(Tcl_Interp *interp,
			    Var *otherPtr, Tcl_Obj *myNamePtr, int myFlags,
MODULE_SCOPE int	TclPtrObjMakeUpvar(Tcl_Interp *interp, Var *otherPtr,
			    Tcl_Obj *myNamePtr, int myFlags, int index);
			    int index);
MODULE_SCOPE int	TclPtrUnsetVarIdx(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, const int flags,
			    int index);
MODULE_SCOPE void	TclInvalidateNsPath(Namespace *nsPtr);
MODULE_SCOPE void	TclFindArrayPtrElements(Var *arrayPtr,
			    Tcl_HashTable *tablePtr);

/*
 * The new extended interface to the variable traces.
 */

MODULE_SCOPE int	TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
			    Var *varPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
			    int flags, int leaveErrMsg, int index);

/*
 * So tclObj.c and tclDictObj.c can share these implementations.
 */

MODULE_SCOPE int	TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
MODULE_SCOPE void	TclFreeObjEntry(Tcl_HashEntry *hPtr);
MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
MODULE_SCOPE unsigned	TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);

MODULE_SCOPE int	TclFullFinalizationRequested(void);

/*
 * TIP #542
 */

MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr);
MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct, size_t numChars);
MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs,
				const Tcl_UniChar *uct, size_t numChars);
MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr,
				const Tcl_UniChar *uniPattern, int nocase);


/*
 * Just for the purposes of command-type registration.
 */

MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChildObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclOOMyClassObjCmd;

/*
 * TIP #462.
 */

/*
 * The following enum values give the status of a spawned process.
 */

typedef enum TclProcessWaitStatus {
    TCL_PROCESS_ERROR = -1,	/* Error waiting for process to exit */
    TCL_PROCESS_UNCHANGED = 0,	/* No change since the last call. */
    TCL_PROCESS_EXITED = 1,	/* Process has exited. */
    TCL_PROCESS_SIGNALED = 2,	/* Child killed because of a signal. */
    TCL_PROCESS_STOPPED = 3,	/* Child suspended because of a signal. */
    TCL_PROCESS_UNKNOWN_STATUS = 4
				/* Child wait status didn't make sense. */
} TclProcessWaitStatus;

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);
MODULE_SCOPE int TclClose(Tcl_Interp *,	Tcl_Channel chan);
/*
 * TIP #508: [array default]
 */

MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);

/*
 * Utility routines for encoding index values as integers. Used by both
 * some of the command compilers and by [lsort] and [lsearch].
 */

MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t before, size_t after, int *indexPtr);
MODULE_SCOPE size_t	TclIndexDecode(int encoded, size_t endValue);

/* Constants used in index value encoding routines. */
#define TCL_INDEX_END           ((size_t)-2)
#define TCL_INDEX_START         ((size_t)0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and release Tcl objects.
 * TclNewObj(objPtr) creates a new object denoting an empty string.
 * TclDecrRefCount(objPtr) decrements the object's reference count, and frees
 * the object if its reference count is zero. These macros are inline versions
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
4328

4329
4330
4331
4332
4333

4334
4335
4336
4337
4338
4339
4340
4341
4342








4343
4344
4345

4346
4347

4348
4349
4350


4351
4352
4353
4354
4355

4356
4357
4358
4359
4360

4361
4362
4363
4364



4365
4366
4367
4368
4369
4370
4371
4372
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







-

-

















-
-
-
-
-
-





-
+







-
+




-
+



-
-
+
+

-
+







-
-
-
-









-
+


-
-
+
+


-
-
+













-


-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-

-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-










-
+




-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-

-
+
-
-
+

-
-
+
+
-



-
+



-
-
+
-
-
-
-
+
+
+
-







 */

/*
 * DTrace object allocation probe macros.
 */

#ifdef USE_DTRACE
#ifndef _TCLDTRACE_H
#include "tclDTrace.h"
#endif
#define	TCL_DTRACE_OBJ_CREATE(objPtr)	TCL_OBJ_CREATE(objPtr)
#define	TCL_DTRACE_OBJ_FREE(objPtr)	TCL_OBJ_FREE(objPtr)
#else /* USE_DTRACE */
#define	TCL_DTRACE_OBJ_CREATE(objPtr)	{}
#define	TCL_DTRACE_OBJ_FREE(objPtr)	{}
#endif /* USE_DTRACE */

#ifdef TCL_COMPILE_STATS
#  define TclIncrObjsAllocated() \
    tclObjsAlloced++
#  define TclIncrObjsFreed() \
    tclObjsFreed++
#else
#  define TclIncrObjsAllocated()
#  define TclIncrObjsFreed()
#endif /* TCL_COMPILE_STATS */

#  define TclAllocObjStorage(objPtr)		\
	TclAllocObjStorageEx(NULL, (objPtr))

#  define TclFreeObjStorage(objPtr)		\
	TclFreeObjStorageEx(NULL, (objPtr))

#ifndef TCL_MEM_DEBUG
# define TclNewObj(objPtr) \
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes    = &tclEmptyString; \
    (objPtr)->bytes    = tclEmptyStringRep; \
    (objPtr)->length   = 0; \
    (objPtr)->typePtr  = NULL; \
    TCL_DTRACE_OBJ_CREATE(objPtr)

/*
 * Invalidate the string rep first so we can use the bytes value for our
 * pointer chain, and signal an obj deletion (as opposed to shimmering) with
 * 'length == TCL_INDEX_NONE'.
 * 'length == -1'.
 * Use empty 'if ; else' to handle use in unbraced outer if/else conditions.
 */

# define TclDecrRefCount(objPtr) \
    if ((objPtr)->refCount-- > 1) ; else { \
    if (--(objPtr)->refCount > 0) ; else { \
	if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
	    TCL_DTRACE_OBJ_FREE(objPtr); \
	    if ((objPtr)->bytes \
		    && ((objPtr)->bytes != &tclEmptyString)) { \
		Tcl_Free((objPtr)->bytes); \
		    && ((objPtr)->bytes != tclEmptyStringRep)) { \
		ckfree((char *) (objPtr)->bytes); \
	    } \
	    (objPtr)->length = TCL_INDEX_NONE; \
	    (objPtr)->length = -1; \
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }

#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
#   define USE_THREAD_ALLOC 1
#endif

#if defined(PURIFY)

/*
 * The PURIFY mode is like the regular mode, but instead of doing block
 * Tcl_Obj allocation and keeping a freed list for efficiency, it always
 * allocates and frees a single Tcl_Obj so that tools like Purify can better
 * track memory leaks.
 */

#  define TclAllocObjStorageEx(interp, objPtr) \
#  define TclAllocObjStorage(objPtr) \
	(objPtr) = (Tcl_Obj *) Tcl_Alloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	Tcl_Free(objPtr)
#  define TclFreeObjStorage(objPtr) \
	ckfree((char *) (objPtr))

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)
#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
 * per-thread caches.
 */

MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
MODULE_SCOPE void	TclThreadFreeObj(Tcl_Obj *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
MODULE_SCOPE void	TclpFreeAllocMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclpInitAllocCache(void);
MODULE_SCOPE void	TclpFreeAllocCache(void *);

/*
 * These macros need to be kept in sync with the code of TclThreadAllocObj()
 * and TclThreadFreeObj().
 *
 * Note that the optimiser should resolve the case (interp==NULL) at compile
 * time.
 */

#  define ALLOC_NOBJHIGH 1200

#  define TclAllocObjStorageEx(interp, objPtr)				\
#  define TclAllocObjStorage(objPtr) \
    do {								\
	AllocCache *cachePtr;						\
	if (((interp) == NULL) ||					\
		((cachePtr = ((Interp *)(interp))->allocCache),		\
			(cachePtr->numObjects == 0))) {			\
	    (objPtr) = TclThreadAllocObj();				\
	(objPtr) = TclThreadAllocObj()
	} else {							\
	    (objPtr) = cachePtr->firstObjPtr;				\
	    cachePtr->firstObjPtr = (Tcl_Obj *)(objPtr)->internalRep.twoPtrValue.ptr1; \
	    --cachePtr->numObjects;					\
	}								\
    } while (0)

#  define TclFreeObjStorageEx(interp, objPtr)				\
#  define TclFreeObjStorage(objPtr) \
    do {								\
	AllocCache *cachePtr;						\
	if (((interp) == NULL) ||					\
		((cachePtr = ((Interp *)(interp))->allocCache),		\
			((cachePtr->numObjects == 0) ||			\
			(cachePtr->numObjects >= ALLOC_NOBJHIGH)))) {	\
	    TclThreadFreeObj(objPtr);					\
	TclThreadFreeObj((objPtr))
	} else {							\
	    (objPtr)->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; \
	    cachePtr->firstObjPtr = objPtr;				\
	    ++cachePtr->numObjects;					\
	}								\
    } while (0)

#else /* not PURIFY or USE_THREAD_ALLOC */

#if defined(USE_TCLALLOC) && USE_TCLALLOC
    MODULE_SCOPE void TclFinalizeAllocSubsystem();
    MODULE_SCOPE void TclInitAlloc();
#else
#   define USE_TCLALLOC 0
#endif

#if TCL_THREADS
#ifdef TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex	tclObjMutex;
#endif

#  define TclAllocObjStorageEx(interp, objPtr) \
#  define TclAllocObjStorage(objPtr) \
    do {								\
	Tcl_MutexLock(&tclObjMutex);					\
	if (tclFreeObjList == NULL) {					\
	    TclAllocateFreeObjects();					\
	}								\
	(objPtr) = tclFreeObjList;					\
	tclFreeObjList = (Tcl_Obj *)					\
		tclFreeObjList->internalRep.twoPtrValue.ptr1;		\
	Tcl_MutexUnlock(&tclObjMutex);					\
	Tcl_MutexLock(&tclObjMutex); \
	if (tclFreeObjList == NULL) { \
	    TclAllocateFreeObjects(); \
	} \
	(objPtr) = tclFreeObjList; \
	tclFreeObjList = (Tcl_Obj *) \
		tclFreeObjList->internalRep.twoPtrValue.ptr1; \
	Tcl_MutexUnlock(&tclObjMutex)
    } while (0)

#  define TclFreeObjStorageEx(interp, objPtr) \
#  define TclFreeObjStorage(objPtr) \
    do {							       \
	Tcl_MutexLock(&tclObjMutex);				       \
	Tcl_MutexLock(&tclObjMutex); \
	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \
	tclFreeObjList = (objPtr);				       \
	Tcl_MutexUnlock(&tclObjMutex);				       \
	tclFreeObjList = (objPtr); \
	Tcl_MutexUnlock(&tclObjMutex)
    } while (0)
#endif

#else /* TCL_MEM_DEBUG */
MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, CONST char *file,
			    int line);

# define TclDbNewObj(objPtr, file, line) \
    do { \
	TclIncrObjsAllocated();						\
    TclIncrObjsAllocated(); \
	(objPtr) = (Tcl_Obj *)						\
		Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line));		\
	TclDbInitNewObj((objPtr), (file), (line));			\
	TCL_DTRACE_OBJ_CREATE(objPtr);					\
    (objPtr) = (Tcl_Obj *) Tcl_DbCkalloc(sizeof(Tcl_Obj), (file), (line)); \
    TclDbInitNewObj((objPtr), (file), (line)); \
    TCL_DTRACE_OBJ_CREATE(objPtr)
    } while (0)

# define TclNewObj(objPtr) \
    TclDbNewObj(objPtr, __FILE__, __LINE__);

# define TclDecrRefCount(objPtr) \
    Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)

4380
4381
4382
4383
4384
4385
4386
4387

4388
4389
4390
4391
4392
4393
4394
4395
4396

4397
4398
4399
4400



4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418

4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440

4441
4442

4443
4444
4445
4446

4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466



4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487





4488
4489
4490

4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567

4568
4569
4570

4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587




















4588
4589
4590
4591
4592


4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607








4608

4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
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
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
3775
3776

3777

3778
3779
3780
3781
3782
3783
3784
3785

3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798






3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821





3822
3823

3824
3825
3826
3827
3828
3829
3830
3831
3832

3833
3834
3835
3836
3837


3838
3839
3840
3841
3842
3843
3844

3845








3846
3847
3848
3849
3850
3851
3852

3853

3854






3855
3856



3857
3858
3859
3860
3861
3862

3863
3864








3865
3866
3867
3868
3869
3870
3871

3872
3873







3874
3875
3876
3877
3878
3879

3880
3881


3882
3883
3884


3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902

3903















3904
3905
3906
3907
3908
3909
3910







-
+








-
+


-
-
+
+
+

















-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-
+
-
-
-
-
+
-
-
-
-
-












-
-
-
+
+
+
-
-












-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
+


















-




-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+


+
+
+















-
-
+
-
-
-
+
-
-
-















+
+




-
+

















-
+




-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-










-
+
-








-
+
+
+
+





+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
+
+
-
+
+







-
+
+
+
+

-
-
+
+





-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-

-
+
-
-
-
-
-
-
+
+
-
-
-
+
+
+
+
+
+
-


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-


-
-
-
-
-
-
-
+
+
+
+
+
+
-


-
-
+
+

-
-
+
+
+
+
+













-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *----------------------------------------------------------------
 * Macro used by the Tcl core to set a Tcl_Obj's string representation to a
 * copy of the "len" bytes starting at "bytePtr". This code works even if the
 * byte array contains NULLs as long as the length is correct. Because "len"
 * is referenced multiple times, it should be as simple an expression as
 * possible. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, size_t len);
 * MODULE_SCOPE void TclInitStringRep(Tcl_Obj *objPtr, char *bytePtr, int len);
 *
 * This macro should only be called on an unshared objPtr where
 *  objPtr->typePtr->freeIntRepProc == NULL
 *----------------------------------------------------------------
 */

#define TclInitStringRep(objPtr, bytePtr, len) \
    if ((len) == 0) { \
	(objPtr)->bytes	 = &tclEmptyString; \
	(objPtr)->bytes	 = tclEmptyStringRep; \
	(objPtr)->length = 0; \
    } else { \
	(objPtr)->bytes = (char *)Tcl_Alloc((len) + 1); \
	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \
	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
	memcpy((void *) (objPtr)->bytes, (void *) (bytePtr), \
		(unsigned) (len)); \
	(objPtr)->bytes[len] = '\0'; \
	(objPtr)->length = (len); \
    }

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the string representation's byte array
 * pointer from a Tcl_Obj. This is an inline version of Tcl_GetString(). The
 * macro's expression result is the string rep's byte pointer which might be
 * NULL. The bytes referenced by this pointer must not be modified by the
 * caller. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE char *	TclGetString(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclGetString(objPtr) \
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))
    ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))

#if 0
   static inline char *TclGetStringFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      char *response = Tcl_GetString(objPtr);
      *(lenPtr) = objPtr->length;
      return response;
   }
   static inline Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      Tcl_UniChar *response = Tcl_GetUnicodeFromObj(objPtr, NULL);
      *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1);
      return response;
   }
   static inline unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lenPtr) {
      unsigned char *response = Tcl_GetByteArrayFromObj(objPtr, NULL);
      if (response) {
          *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1 + 1);
      }
      return response;
   }
#else
#define TclGetStringFromObj(objPtr, lenPtr) \
    (((objPtr)->bytes \
    ((objPtr)->bytes \
	    ? NULL : Tcl_GetString((objPtr)), \
	    *(lenPtr) = (objPtr)->length, (objPtr)->bytes))
	    ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes)	\
#define TclGetUnicodeFromObj(objPtr, lenPtr) \
    (Tcl_GetUnicodeFromObj((objPtr), NULL), \
	    *(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1), \
	    Tcl_GetUnicodeFromObj((objPtr), NULL))
	    : Tcl_GetStringFromObj((objPtr), (lenPtr)))
#define TclGetByteArrayFromObj(objPtr, lenPtr) \
    (Tcl_GetByteArrayFromObj((objPtr), NULL) ? \
	(*(lenPtr) = *((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1 + 1), \
	(unsigned char *)(((size_t *) (objPtr)->internalRep.twoPtrValue.ptr1) + 3)) : NULL)
#endif

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to clean out an object's internal
 * representation. Does not actually reset the rep's bytes. The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclFreeIntRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclFreeIntRep(objPtr) \
    if ((objPtr)->typePtr != NULL) { \
	if ((objPtr)->typePtr->freeIntRepProc != NULL) { \
	    (objPtr)->typePtr->freeIntRepProc(objPtr); \
    if ((objPtr)->typePtr != NULL && \
	    (objPtr)->typePtr->freeIntRepProc != NULL) { \
	(objPtr)->typePtr->freeIntRepProc(objPtr); \
	} \
	(objPtr)->typePtr = NULL; \
    }

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to clean out an object's string representation.
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateStringRep(objPtr) \
    do { \
	Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \
	if (_isobjPtr->bytes != NULL) { \
	    if (_isobjPtr->bytes != &tclEmptyString) { \
		Tcl_Free((char *)_isobjPtr->bytes); \
	    } \
	    _isobjPtr->bytes = NULL; \
    if (objPtr->bytes != NULL) { \
	if (objPtr->bytes != tclEmptyStringRep) { \
	    ckfree((char *) objPtr->bytes); \
	} \
	objPtr->bytes = NULL; \
	} \
    } while (0)

    }
/*
 * These form part of the native filesystem support. They are needed here
 * because we have a few native filesystem functions (which are the same for
 * win/unix) in this file.
 */

#ifdef __cplusplus
extern "C" {
#endif
MODULE_SCOPE const char *const		tclpFileAttrStrings[];
MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];
#ifdef __cplusplus
}
#endif

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to test whether an object has a
 * string representation (or is a 'pure' internal value).
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclHasStringRep(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

#define TclHasStringRep(objPtr) \
    ((objPtr)->bytes != NULL)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to get the bignum out of the bignum
 * representation of a Tcl_Obj.
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclUnpackBignum(Tcl_Obj *objPtr, mp_int bignum);
 *----------------------------------------------------------------
 */

#define TclUnpackBignum(objPtr, bignum) \
    do {								\
	Tcl_Obj *bignumObj = (objPtr);				\
	int bignumPayload =					\
		PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2);	\
	if (bignumPayload == -1) {					\
	    (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \
	} else {							\
	    (bignum).dp = (mp_digit *)bignumObj->internalRep.twoPtrValue.ptr1;	\
	    (bignum).sign = bignumPayload >> 30;			\
	    (bignum).alloc = (bignumPayload >> 15) & 0x7FFF;		\
	    (bignum).used = bignumPayload & 0x7FFF;			\
	}								\
    } while (0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
 * growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclGrowTokenArray(Tcl_Token *tokenPtr, int used,
 *				int available, int append,
 *				Tcl_Token *staticPtr);
 * MODULE_SCOPE void	TclGrowParseTokenArray(Tcl_Parse *parsePtr,
 *				int append);
 *----------------------------------------------------------------
 */

/* General tuning for minimum growth in Tcl growth algorithms */
#ifndef TCL_MIN_GROWTH
#  ifdef TCL_GROWTH_MIN_ALLOC
     /* Support for any legacy tuners */
#    define TCL_MIN_GROWTH TCL_GROWTH_MIN_ALLOC
#  else
#    define TCL_MIN_GROWTH 1024
#  endif
#endif

#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
/* Token growth tuning, default to the general value. */
#ifndef TCL_MIN_TOKEN_GROWTH
#define TCL_MIN_TOKEN_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Token)
#define TCL_MIN_TOKEN_GROWTH 50
#endif

#define TCL_MAX_TOKENS (int)(UINT_MAX / sizeof(Tcl_Token))
#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr)	\
    do {								\
	int _needed = (used) + (append);					\
	if (_needed > TCL_MAX_TOKENS) {					\
	    Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded",	\
		    TCL_MAX_TOKENS);					\
	}								\
	if (_needed > (available)) {					\
	    int allocated = 2 * _needed;					\
	    Tcl_Token *oldPtr = (tokenPtr);				\
	    Tcl_Token *newPtr;						\
	    if (oldPtr == (staticPtr)) {				\
		oldPtr = NULL;						\
	    }								\
{									\
    int needed = (used) + (append);					\
    if (needed > TCL_MAX_TOKENS) {					\
	Tcl_Panic("max # of tokens for a Tcl parse (%d) exceeded",	\
		TCL_MAX_TOKENS);					\
    }									\
    if (needed > (available)) {						\
	int allocated = 2 * needed;					\
	Tcl_Token *oldPtr = (tokenPtr);					\
	Tcl_Token *newPtr;						\
	if (oldPtr == (staticPtr)) {					\
	    oldPtr = NULL;						\
	}								\
	if (allocated > TCL_MAX_TOKENS) {				\
	    allocated = TCL_MAX_TOKENS;					\
	}								\
	newPtr = (Tcl_Token *) attemptckrealloc((char *) oldPtr,	\
		(unsigned int) (allocated * sizeof(Tcl_Token)));	\
	if (newPtr == NULL) {						\
	    allocated = needed + (append) + TCL_MIN_TOKEN_GROWTH;	\
	    if (allocated > TCL_MAX_TOKENS) {				\
		allocated = TCL_MAX_TOKENS;				\
	    }								\
	    newPtr = (Tcl_Token *) Tcl_AttemptRealloc((char *) oldPtr,	\
		    (allocated * sizeof(Tcl_Token)));	\
	    newPtr = (Tcl_Token *) ckrealloc((char *) oldPtr,		\
		    (unsigned int) (allocated * sizeof(Tcl_Token)));	\
	    if (newPtr == NULL) {					\
		allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH;	\
		if (allocated > TCL_MAX_TOKENS) {			\
		    allocated = TCL_MAX_TOKENS;				\
		}							\
		newPtr = (Tcl_Token *) Tcl_Realloc((char *) oldPtr,	\
			(allocated * sizeof(Tcl_Token))); \
	    }								\
	    (available) = allocated;					\
	    if (oldPtr == NULL) {					\
		memcpy(newPtr, staticPtr,				\
			((used) * sizeof(Tcl_Token)));		\
	    }								\
	    (tokenPtr) = newPtr;					\
	}								\
	}								\
	(available) = allocated;					\
	if (oldPtr == NULL) {						\
	    memcpy((VOID *) newPtr, (VOID *) staticPtr,			\
		    (size_t) ((used) * sizeof(Tcl_Token)));		\
	}								\
	(tokenPtr) = newPtr;						\
    }									\
    } while (0)
}

#define TclGrowParseTokenArray(parsePtr, append)			\
    TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens,	\
	    (parsePtr)->tokensAvailable, (append),			\
	    (parsePtr)->staticTokens)

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core get a unicode char from a utf string. It checks
 * to see if we have a one-byte utf char before calling the real
 * Tcl_UtfToUniChar, as this will save a lot of time for primarily ASCII
 * string handling. The macro's expression result is 1 for the 1-byte case or
 * the result of Tcl_UtfToUniChar. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclUtfToUniChar(const char *string, Tcl_UniChar *ch);
 *----------------------------------------------------------------
 */

#if TCL_UTF_MAX > 3
#define TclUtfToUniChar(str, chPtr) \
	(((UCHAR(*(str))) < 0x80) ?		\
	    ((*(chPtr) = UCHAR(*(str))), 1)	\
	    : Tcl_UtfToUniChar(str, chPtr))
#else
#define TclUtfToUniChar(str, chPtr) \
	((((unsigned char) *(str)) < 0x80) ?		\
	    ((*(chPtr) = (unsigned char) *(str)), 1)	\
	    : Tcl_UtfToChar16(str, chPtr))
#endif

/*
 *----------------------------------------------------------------
 * Macro counterpart of the Tcl_NumUtfChars() function. To be used in speed-
 * -sensitive points where it pays to avoid a function call in the common case
 * of counting along a string of all one-byte characters.  The ANSI C
 * "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclNumUtfChars(int numChars, const char *bytes,
 *				size_t numBytes);
 *----------------------------------------------------------------
 */

#define TclNumUtfChars(numChars, bytes, numBytes) \
    do { \
	size_t _count, _i = (numBytes); \
	unsigned char *_str = (unsigned char *) (bytes); \
	while (_i && (*_str < 0xC0)) { _i--; _str++; } \
	_count = (numBytes) - _i; \
	if (_i) { \
	    _count += Tcl_NumUtfChars((bytes) + _count, _i); \
	} \
	(numChars) = _count; \
    } while (0);

#define TclUtfPrev(src, start) \
	(((src) < (start) + 2) ? (start) : \
	((unsigned char) *((src) - 1)) < 0x80 ? (src) - 1 : \
	(((src) < (start)+2) ? (start) : \
	(UCHAR(*((src) - 1))) < 0x80 ? (src)-1 : \
	Tcl_UtfPrev(src, start))

#define TclUtfNext(src)	\
	(((UCHAR(*(src))) < 0x80) ? src + 1 : Tcl_UtfNext(src))

/*
 *----------------------------------------------------------------
 * Macro that encapsulates the logic that determines when it is safe to
 * interpret a string as a byte array directly. In summary, the object must be
 * a byte array and must not have a string representation (as the operations
 * that it is used in are defined on strings, not byte arrays). Theoretically
 * it is possible to also be efficient in the case where the object's bytes
 * field is filled by generation from the byte array (c.f. list canonicality)
 * but we don't do that at the moment since this is purely about efficiency.
 * The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
#define TclIsPureByteArray(objPtr) \
	(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
#define TclHasIntRep(objPtr, type) \
	((objPtr)->typePtr == (type))
	(((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
#define TclFetchIntRep(objPtr, type) \
	(TclHasIntRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to compare Unicode strings. On big-endian
 * systems we can use the more efficient memcmp, but this would not be
 * lexically correct on little-endian systems. The ANSI C "prototype" for
 * this macro is:
 *
 * MODULE_SCOPE int	TclUniCharNcmp(const Tcl_UniChar *cs,
 *			    const Tcl_UniChar *ct, unsigned long n);
 *----------------------------------------------------------------
 */

#ifdef WORDS_BIGENDIAN
#   define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
#else /* !WORDS_BIGENDIAN */
#   define TclUniCharNcmp Tcl_UniCharNcmp
#endif /* WORDS_BIGENDIAN */

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to increment a namespace's export epoch
 * Macro used by the Tcl core to increment a namespace's export export epoch
 * counter. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE void	TclInvalidateNsCmdLookup(Namespace *nsPtr);
 *----------------------------------------------------------------
 */

#define TclInvalidateNsCmdLookup(nsPtr) \
    if ((nsPtr)->numExportPatterns) {		\
	(nsPtr)->exportLookupEpoch++;		\
    }						\
    if ((nsPtr)->commandPathLength) {		\
	(nsPtr)->cmdRefEpoch++;			\
    }

/*
 *----------------------------------------------------------------------
 *
 * Core procedure added to libtommath for bignum manipulation.
 * Core procedures added to libtommath for bignum manipulation.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_PackageInitProc TclTommath_Init;

MODULE_SCOPE int	TclTommath_Init(Tcl_Interp *interp);
MODULE_SCOPE void	TclBNInitBignumFromLong(mp_int *bignum, long initVal);
/*
 *----------------------------------------------------------------------
 *
 * External (platform specific) initialization routine, these declarations
 * explicitly don't use EXTERN since this code does not get compiled into the
 * library:
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_PackageInitProc TclThread_Init;
MODULE_SCOPE void	TclBNInitBignumFromWideInt(mp_int *bignum,
			    Tcl_WideInt initVal);
MODULE_SCOPE void	TclBNInitBignumFromWideUInt(mp_int *bignum,
			    Tcl_WideUInt initVal);
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);
 *----------------------------------------------------------------
 */

#define TclMatchIsTrivial(pattern) \
#define TclMatchIsTrivial(pattern)	strpbrk((pattern), "*[?\\") == NULL
    (strpbrk((pattern), "*[?\\") == NULL)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to set a Tcl_Obj's numeric representation
 * avoiding the corresponding function calls in time critical parts of the
 * core. They should only be called on unshared objects. The ANSI C
 * "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclSetIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclSetIntObj(Tcl_Obj *objPtr, int intValue);
 * MODULE_SCOPE void	TclSetLongObj(Tcl_Obj *objPtr, long longValue);
 * MODULE_SCOPE void	TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue);
 * MODULE_SCOPE void	TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclSetDoubleObj(Tcl_Obj *objPtr, double d);
 *----------------------------------------------------------------
 */

#define TclSetIntObj(objPtr, i) \
    TclInvalidateStringRep(objPtr);\
    TclFreeIntRep(objPtr); \
    (objPtr)->internalRep.longValue = (long)(i); \
    (objPtr)->typePtr = &tclIntType
    do {						\
	Tcl_ObjIntRep ir;				\
	ir.wideValue = (Tcl_WideInt) i;			\
	TclInvalidateStringRep(objPtr);			\
	Tcl_StoreIntRep(objPtr, &tclIntType, &ir);	\
    } while (0)

#define TclSetLongObj(objPtr, l) \
    TclSetIntObj((objPtr), (l))

/*
 * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
 * programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1.
 * The only "boolean" Tcl_Obj's shall be those holding the cached boolean
 * value of strings like: "yes", "no", "true", "false", "on", "off".
 */

#define TclSetBooleanObj(objPtr, b) \
    TclSetIntObj((objPtr), ((b)? 1 : 0));

#ifndef NO_WIDE_TYPE
#define TclSetWideIntObj(objPtr, w) \
    TclInvalidateStringRep(objPtr);\
    TclFreeIntRep(objPtr); \
    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
    (objPtr)->typePtr = &tclWideIntType
#endif

#define TclSetDoubleObj(objPtr, d) \
    do {						\
	Tcl_ObjIntRep ir;				\
	ir.doubleValue = (double) d;			\
	TclInvalidateStringRep(objPtr);			\
	Tcl_StoreIntRep(objPtr, &tclDoubleType, &ir);	\
    TclInvalidateStringRep(objPtr);\
    TclFreeIntRep(objPtr); \
    } while (0)
    (objPtr)->internalRep.doubleValue = (double)(d); \
    (objPtr)->typePtr = &tclDoubleType

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to create and initialise objects of standard
 * types, avoiding the corresponding function calls in time critical parts of
 * the core. The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, int i);
 * MODULE_SCOPE void	TclNewLongObj(Tcl_Obj *objPtr, long l);
 * MODULE_SCOPE void	TclNewBooleanObj(Tcl_Obj *objPtr, int b);
 * MODULE_SCOPE void	TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
 * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
 * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
 * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral);
 *
 *----------------------------------------------------------------
 */

#ifndef TCL_MEM_DEBUG
#define TclNewIntObj(objPtr, w) \
#define TclNewIntObj(objPtr, i) \
    do {						\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes = NULL; \
    (objPtr)->internalRep.longValue = (long)(i); \
    (objPtr)->typePtr = &tclIntType; \
    TCL_DTRACE_OBJ_CREATE(objPtr)
    } while (0)

#define TclNewIndexObj(objPtr, w) \
#define TclNewLongObj(objPtr, l) \
    do {						\
	size_t _w = (w);		\
	TclIncrObjsAllocated();				\
	TclAllocObjStorage(objPtr);			\
	(objPtr)->refCount = 0;				\
	(objPtr)->bytes = NULL;				\
    TclNewIntObj((objPtr), (l))

	(objPtr)->internalRep.wideValue = ((_w) == TCL_INDEX_NONE) ? -1 : (Tcl_WideInt)(_w); \
	(objPtr)->typePtr = &tclIntType;		\
	TCL_DTRACE_OBJ_CREATE(objPtr);			\
/*
 * NOTE: There is to be no such thing as a "pure" boolean.
 * See comment above TclSetBooleanObj macro above.
 */
#define TclNewBooleanObj(objPtr, b) \
    TclNewIntObj((objPtr), ((b)? 1 : 0))
    } while (0)

#define TclNewDoubleObj(objPtr, d) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	(objPtr)->bytes = NULL;					\
	(objPtr)->internalRep.doubleValue = (double)(d);	\
	(objPtr)->typePtr = &tclDoubleType;			\
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    (objPtr)->bytes = NULL; \
    (objPtr)->internalRep.doubleValue = (double)(d); \
    (objPtr)->typePtr = &tclDoubleType; \
    TCL_DTRACE_OBJ_CREATE(objPtr)
    } while (0)

#define TclNewStringObj(objPtr, s, len) \
    do {							\
	TclIncrObjsAllocated();					\
	TclAllocObjStorage(objPtr);				\
	(objPtr)->refCount = 0;					\
	TclInitStringRep((objPtr), (s), (len));			\
	(objPtr)->typePtr = NULL;				\
	TCL_DTRACE_OBJ_CREATE(objPtr);				\
    TclIncrObjsAllocated(); \
    TclAllocObjStorage(objPtr); \
    (objPtr)->refCount = 0; \
    TclInitStringRep((objPtr), (s), (len));\
    (objPtr)->typePtr = NULL; \
    TCL_DTRACE_OBJ_CREATE(objPtr)
    } while (0)

#else /* TCL_MEM_DEBUG */
#define TclNewIntObj(objPtr, w) \
    (objPtr) = Tcl_NewWideIntObj(w)
#define TclNewIntObj(objPtr, i) \
    (objPtr) = Tcl_NewIntObj(i)

#define TclNewIndexObj(objPtr, w) \
    (objPtr) = ((w) == TCL_INDEX_NONE) ? Tcl_NewWideIntObj(-1) : Tcl_NewWideIntObj(w)
#define TclNewLongObj(objPtr, l) \
    (objPtr) = Tcl_NewLongObj(l)

#define TclNewBooleanObj(objPtr, b) \
    (objPtr) = Tcl_NewBooleanObj(b)

#define TclNewDoubleObj(objPtr, d) \
    (objPtr) = Tcl_NewDoubleObj(d)

#define TclNewStringObj(objPtr, s, len) \
    (objPtr) = Tcl_NewStringObj((s), (len))
#endif /* TCL_MEM_DEBUG */

/*
 * The sLiteral argument *must* be a string literal; the incantation with
 * sizeof(sLiteral "") will fail to compile otherwise.
 */
#define TclNewLiteralStringObj(objPtr, sLiteral) \
    TclNewStringObj((objPtr), (sLiteral), sizeof(sLiteral "") - 1)
    TclNewStringObj((objPtr), (sLiteral), (int) (sizeof(sLiteral "") - 1))

/*
 *----------------------------------------------------------------
 * Convenience macros for DStrings.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE char * TclDStringAppendLiteral(Tcl_DString *dsPtr,
 *			const char *sLiteral);
 * MODULE_SCOPE void   TclDStringClear(Tcl_DString *dsPtr);
 */

#define TclDStringAppendLiteral(dsPtr, sLiteral) \
    Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1)
#define TclDStringClear(dsPtr) \
    Tcl_DStringSetLength((dsPtr), 0)

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to test for some special double values.
 * The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsInfinite(double d);
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
4955
4956
4957
4958
4959
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930



3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954

3955













3956








3957
3958


3959
3960
3961
3962
3963
3964
3965







+
+
+
+
+
-
-
-
+
+
+
+
+



















-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
-
-







#    ifdef NO_ISNAN
#	 define TclIsNaN(d)	((d) != (d))
#    else
#	 define TclIsNaN(d)	(isnan(d))
#    endif
#endif

/*
 * ----------------------------------------------------------------------
 * Macro to use to find the offset of a field in a structure. Computes number
 * of bytes from beginning of structure to a given field.
 */
/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */
#ifndef offsetof
#   define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field))

#ifdef offsetof
#define TclOffset(type, field) ((int) offsetof(type, field))
#else
#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field))
#endif

/*
 *----------------------------------------------------------------
 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace.
 */

#define TclGetCurrentNamespace(interp) \
    (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr

#define TclGetGlobalNamespace(interp) \
    (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr

/*
 *----------------------------------------------------------------
 * Inline version of TclCleanupCommand; still need the function as it is in
 * the internal stubs, but the core can use the macro instead.
 */

#define TclCleanupCommandMacro(cmdPtr)		\
#define TclCleanupCommandMacro(cmdPtr) \
    do {					\
	if ((cmdPtr)->refCount-- <= 1) {	\
	    Tcl_Free(cmdPtr);			\
	}					\
    } while (0)


/*
 * inside this routine crement refCount first incase cmdPtr is replacing itself
 */
#define TclRoutineAssign(location, cmdPtr)	    \
    do {					    \
	(cmdPtr)->refCount++;			    \
    if (--(cmdPtr)->refCount <= 0) { \
	if ((location) != NULL			    \
	    && (location--) <= 1) {		    \
	    Tcl_Free(((location)));		    \
	}					    \
	(location) = (cmdPtr);			    \
    } while (0)


	ckfree((char *) (cmdPtr));\
    }
#define TclRoutineHasName(cmdPtr) \
    ((cmdPtr)->hPtr != NULL)

/*
 *----------------------------------------------------------------
 * Inline versions of Tcl_LimitReady() and Tcl_LimitExceeded to limit number
 * of calls out of the critical path. Note that this code isn't particularly
 * readable; the non-inline version (in tclInterp.c) is much easier to
 * understand. Note also that these macros takes different args (iPtr->limit)
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120

5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
3976
3977
3978
3979
3980
3981
3982







3983






































































































































3984
3985

3986





3987
3988
3989
3990
3991
3992
3993
3994
3995
3996







-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+
-
-
-
-
-










	    ((limit).granularityTicker % (limit).cmdGranularity == 0)))	\
	    ? 1 :							\
    (((limit).active & TCL_LIMIT_TIME) &&				\
	    (((limit).timeGranularity == 1) ||				\
	    ((limit).granularityTicker % (limit).timeGranularity == 0)))\
	    ? 1 : 0)))

/*
 * Compile-time assertions: these produce a compile time error if the
 * expression is not known to be true at compile time. If the assertion is
 * known to be false, the compiler (or optimizer?) will error out with
 * "division by zero". If the assertion cannot be evaluated at compile time,
 * the compiler will error out with "non-static initializer".
 *

 * Adapted with permission from
 * http://www.pixelbeat.org/programming/gcc/static_assert.html
 */

#define TCL_CT_ASSERT(e) \
    {enum { ct_assert_value = 1/(!!(e)) };}

/*
 *----------------------------------------------------------------
 * Allocator for small structs (<=sizeof(Tcl_Obj)) using the Tcl_Obj pool.
 * Only checked at compile time.
 *
 * ONLY USE FOR CONSTANT nBytes.
 *
 * DO NOT LET THEM CROSS THREAD BOUNDARIES
 *----------------------------------------------------------------
 */

#define TclSmallAlloc(nbytes, memPtr) \
    TclSmallAllocEx(NULL, (nbytes), (memPtr))

#define TclSmallFree(memPtr) \
    TclSmallFreeEx(NULL, (memPtr))

#ifndef TCL_MEM_DEBUG
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclIncrObjsAllocated();						\
	TclAllocObjStorageEx((interp), (_objPtr));			\
	*(void **)&memPtr = (void *) (_objPtr);					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	TclFreeObjStorageEx((interp), (Tcl_Obj *)memPtr);		\
	TclIncrObjsFreed();						\
    } while (0)

#else    /* TCL_MEM_DEBUG */
#define TclSmallAllocEx(interp, nbytes, memPtr) \
    do {								\
	Tcl_Obj *_objPtr;						\
	TCL_CT_ASSERT((nbytes)<=sizeof(Tcl_Obj));			\
	TclNewObj(_objPtr);						\
	*(void **)&memPtr = (void *) _objPtr;					\
    } while (0)

#define TclSmallFreeEx(interp, memPtr) \
    do {								\
	Tcl_Obj *_objPtr = (Tcl_Obj *) memPtr;				\
	_objPtr->bytes = NULL;						\
	_objPtr->typePtr = NULL;					\
	_objPtr->refCount = 1;						\
	TclDecrRefCount(_objPtr);					\
    } while (0)
#endif   /* TCL_MEM_DEBUG */

/*
 * Support for Clang Static Analyzer <http://clang-analyzer.llvm.org>
 */

#if defined(PURIFY) && defined(__clang__)
#if __has_feature(attribute_analyzer_noreturn) && \
	!defined(Tcl_Panic) && defined(Tcl_Panic_TCL_DECLARED)
void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn));
#endif
#if !defined(CLANG_ASSERT)
#include <assert.h>
#define CLANG_ASSERT(x) assert(x)
#endif
#elif !defined(CLANG_ASSERT)
#define CLANG_ASSERT(x)
#endif /* PURIFY && __clang__ */

/*
 *----------------------------------------------------------------
 * Parameters, structs and macros for the non-recursive engine (NRE)
 *----------------------------------------------------------------
 */

#define NRE_USE_SMALL_ALLOC	1  /* Only turn off for debugging purposes. */
#ifndef NRE_ENABLE_ASSERTS
#define NRE_ENABLE_ASSERTS	0
#endif

/*
 * This is the main data struct for representing NR commands. It is designed
 * to fit in sizeof(Tcl_Obj) in order to exploit the fastest memory allocator
 * available.
 */

typedef struct NRE_callback {
    Tcl_NRPostProc *procPtr;
    void *data[4];
    struct NRE_callback *nextPtr;
} NRE_callback;

#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr)

/*
 * Inline version of Tcl_NRAddCallback.
 */

#define TclNRAddCallback(interp,postProcPtr,data0,data1,data2,data3) \
    do {								\
	NRE_callback *_callbackPtr;					\
	TCLNR_ALLOC((interp), (_callbackPtr));				\
	_callbackPtr->procPtr = (postProcPtr);				\
	_callbackPtr->data[0] = (void *)(data0);			\
	_callbackPtr->data[1] = (void *)(data1);			\
	_callbackPtr->data[2] = (void *)(data2);			\
	_callbackPtr->data[3] = (void *)(data3);			\
	_callbackPtr->nextPtr = TOP_CB(interp);				\
	TOP_CB(interp) = _callbackPtr;					\
    } while (0)

#if NRE_USE_SMALL_ALLOC
#define TCLNR_ALLOC(interp, ptr) \
    TclSmallAllocEx(interp, sizeof(NRE_callback), (ptr))
#define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
#else
#define TCLNR_ALLOC(interp, ptr) \
    (ptr = (Tcl_Alloc(sizeof(NRE_callback))))
#define TCLNR_FREE(interp, ptr)  Tcl_Free(ptr)
#endif

#if NRE_ENABLE_ASSERTS
#define NRE_ASSERT(expr) assert((expr))
#else
#define NRE_ASSERT(expr)
#endif

#include "tclIntDecls.h"
#include "tclIntPlatDecls.h"

#include "tclTomMathDecls.h"
#if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG)
#define Tcl_AttemptAlloc        TclpAlloc
#define Tcl_AttemptRealloc      TclpRealloc
#define Tcl_Free                TclpFree
#endif

#endif /* _TCLINT */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclIntDecls.h.

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



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


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
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



611
612
613
614
615
616
617
618
619








620
621
622


623
624
625
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

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







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

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


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


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
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
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
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
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
611
612
613
614
615
616
617

618
619
620
621
622
623
624
625

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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455

1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504

1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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







+











+
+
+
+
+
+
+
+
+
+
+
+
+
+




















+
+


+

+
+



+
+
+


+
+
+

-
+

+
+
+
-
+
+
+
+
+
+
+


-
+


+
+
+


-
+

+
+
+



+
+
+



+

+
+

-
+
+

+
+


+





+
+


-
-
-
+
+
+

+
+
+

-
+
+
+
+

-
+
+
+
+


+


+
+


+


+
+

-
+
+
+
+

-
+

+

+
+
-
+
+
+
+

+
+
-
+
+
+
+
+
+


-
+
+
+
+


-
+



-
+
+
+
+


+
+
+

-
+

+
+
+


+
+
+

-
+

+

+
+

-
+

+
+
+


+
+
+


+



+
+
-
+
+
+
+
+
+


+

+
+

-
+

-
+
+
+
+

-
+

-
+
+
+
+


+


+
+

-
-
-
+
+
+

+

+
+

-
+
+
+
+


+
+
+


+
+
+

-
+

-
+
+
+
+


-
+
+




+
+

-
+
+




+
+

-
+
+
+
+

-
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


+
+

-
+
+






+
+
-
+
+
+
+
+
+
+



+

+
+


+
+
+



-
-
+
+
+
+
+

-
+
+


+
+


-
+
+
+
+



+
+
+


+


+
+

-
+
+
+
+


+
+
+

-
-
-
+
+
+
+
+
+
+
+



+
+


+
+
+


+
+
+

-
+
+
+
+


-
+



+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
+
+
+




+
+
+


-
+

+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+
+
+
-
+
+
+
+
+
+


+
+
+




+
+
+


-
+
+
+
+






+
+
+


+
+
+
-
+
+
+




+
+

+
-
+
+


+
+

+
-
+
+
+
+



-
+
+
+
+



+
+
+



+
+
+

-
+
+
+
+

-
+
+
+
+


+
+
+


+
+
+


+
+
+


+
+
+

-
-
+
+
+
+
+


+
+
+


+


+
+

-
+

+
+
+


-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

+
+



+
+
+

-
+

+
+
+

-
+
+
+
+

-
+
+
+
+


+
+
+




+
+
+
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+


-
+

-
+
+
+
+


-
+

-
+
+
+
+


+
+
+

-
-
-
+
+
+
+

+
+


-
-
+
+

+
+
+


+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
-
-
+
+
+
+
+
+
+
+














+
+



+

+
+



+
+
+



+
+
+


+
+
+


+
+
+



+
+
+



+
+
+


+
+
+


+
+
+



+



+
+

-
+
+
+
+


+
+
+



+
+
+

-
+
+
+
+

-
+
+
+
+





+
+
+


+





+
+


+
+
+



-
+
+
+
+


+
+
+

-
+

+
+
+
-
+
+
+
+
+
+
+


-
+
+
+
+


-
-
-
+
+
+

+
+
+



+
+
+


-
+
+
+
+


+
+
+


-
+
+
+
+



-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
+


+
-
+
-
-
+
-
-
+
-
-
-
-
+
-
-
-
+
-
-
-
+
+



+
-
+
-
-
+
+

-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
+
-
-
+
-
+


-
+


+
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+



-
+

-
-
-
+
+
+

-
+


-
-
-
-
+
+
+
+


-
-
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
+
+
+


-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+


-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
+


-
+


-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+




-
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+


-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+









-
-
-
-
+
+
+
+


-
-
+
+


-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
+
+
+
+

-
+

-
+

+
-
+
-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-


-
+





-
+








+


+

+


+
+


+
+


-
+
+
+
+
+
+


+
+


+
+


+
+


+

+


+

+


+





+


+
+


+
+


+
+


+


+


+


+


+
+


+

-
+
+
+
+

+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+

+


+
+


+
+


+



-
+
+
+
+
+


+

+


+
+


+
+


+


+


+

+


+
+


+
+


+
+


+
+


+




+


+




+


+
+


+
+


+
+
+
-
+
-
+
+
+
+
+


+


+






-
+
+
+
+
+


+

+


+
+


+
+


+


+


+
+


+
+


+


+


+
+


+
+


+
+
+
-
+
+



+


+
+


+
+


+
+


+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+


+
+


+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+
+
-
+
+




+


+


+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+


+


+
+


+
+
+
-
-
+
+
+
+
+
+

+


+
+


+
+


+
+


+
+


+
+


+
+
+
-
-
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+

+


+
+


+
+


+
+
+
-
-
+
+
+
+
+
+


+
+
-
-
+
+
+
+
+
+














+


+

+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+



+


+
+


+
+


+
+


+
+


+
+


+
+


+





+


+
+


+
+


+
+


+
+
+
-
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-


-
-
-
-
+
+
+
-
-
-
+
+
-
-
+
+
-


+
+
-
+
-


-
-
+
+
-
-
+
-
-
+
-
-
-
+
+
+
-


-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+



-
-
-
+
+
+
+
-
-
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

#include "tclPort.h"

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
#undef Tcl_CreateNamespace
#undef Tcl_DeleteNamespace
#undef Tcl_AppendExportList
#undef Tcl_Export
#undef Tcl_Import
#undef Tcl_ForgetImport
#undef Tcl_GetCurrentNamespace
#undef Tcl_GetGlobalNamespace
#undef Tcl_FindNamespace
#undef Tcl_FindCommand
#undef Tcl_GetCommandFromObj
#undef Tcl_GetCommandFullName

/*
 * 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. */

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
 */

/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
#ifndef TclAllocateFreeObjects_TCL_DECLARED
#define TclAllocateFreeObjects_TCL_DECLARED
/* 3 */
EXTERN void		TclAllocateFreeObjects(void);
#endif
/* Slot 4 is reserved */
#ifndef TclCleanupChildren_TCL_DECLARED
#define TclCleanupChildren_TCL_DECLARED
/* 5 */
EXTERN int		TclCleanupChildren(Tcl_Interp *interp, int numPids,
				Tcl_Pid *pidPtr, Tcl_Channel errorChan);
#endif
#ifndef TclCleanupCommand_TCL_DECLARED
#define TclCleanupCommand_TCL_DECLARED
/* 6 */
EXTERN void		TclCleanupCommand(Command *cmdPtr);
#endif
#ifndef TclCopyAndCollapse_TCL_DECLARED
#define TclCopyAndCollapse_TCL_DECLARED
/* 7 */
EXTERN size_t		TclCopyAndCollapse(size_t count, const char *src,
EXTERN int		TclCopyAndCollapse(int count, CONST char *src,
				char *dst);
#endif
#ifndef TclCopyChannel_TCL_DECLARED
#define TclCopyChannel_TCL_DECLARED
/* Slot 8 is reserved */
/* 8 */
EXTERN int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				int toRead, Tcl_Obj *cmdPtr);
#endif
#ifndef TclCreatePipeline_TCL_DECLARED
#define TclCreatePipeline_TCL_DECLARED
/* 9 */
EXTERN int		TclCreatePipeline(Tcl_Interp *interp, int argc,
				const char **argv, Tcl_Pid **pidArrayPtr,
				CONST char **argv, Tcl_Pid **pidArrayPtr,
				TclFile *inPipePtr, TclFile *outPipePtr,
				TclFile *errFilePtr);
#endif
#ifndef TclCreateProc_TCL_DECLARED
#define TclCreateProc_TCL_DECLARED
/* 10 */
EXTERN int		TclCreateProc(Tcl_Interp *interp, Namespace *nsPtr,
				const char *procName, Tcl_Obj *argsPtr,
				CONST char *procName, Tcl_Obj *argsPtr,
				Tcl_Obj *bodyPtr, Proc **procPtrPtr);
#endif
#ifndef TclDeleteCompiledLocalVars_TCL_DECLARED
#define TclDeleteCompiledLocalVars_TCL_DECLARED
/* 11 */
EXTERN void		TclDeleteCompiledLocalVars(Interp *iPtr,
				CallFrame *framePtr);
#endif
#ifndef TclDeleteVars_TCL_DECLARED
#define TclDeleteVars_TCL_DECLARED
/* 12 */
EXTERN void		TclDeleteVars(Interp *iPtr,
				TclVarHashTable *tablePtr);
#endif
/* Slot 13 is reserved */
#ifndef TclDumpMemoryInfo_TCL_DECLARED
#define TclDumpMemoryInfo_TCL_DECLARED
/* 14 */
EXTERN int		TclDumpMemoryInfo(void *clientData, int flags);
EXTERN int		TclDumpMemoryInfo(ClientData clientData, int flags);
#endif
/* Slot 15 is reserved */
#ifndef TclExprFloatError_TCL_DECLARED
#define TclExprFloatError_TCL_DECLARED
/* 16 */
EXTERN void		TclExprFloatError(Tcl_Interp *interp, double value);
#endif
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#ifndef TclFindElement_TCL_DECLARED
#define TclFindElement_TCL_DECLARED
/* 22 */
EXTERN int		TclFindElement(Tcl_Interp *interp,
				const char *listStr, int listLength,
				const char **elementPtr,
				const char **nextPtr, size_t *sizePtr,
				CONST char *listStr, int listLength,
				CONST char **elementPtr,
				CONST char **nextPtr, int *sizePtr,
				int *bracePtr);
#endif
#ifndef TclFindProc_TCL_DECLARED
#define TclFindProc_TCL_DECLARED
/* 23 */
EXTERN Proc *		TclFindProc(Interp *iPtr, const char *procName);
EXTERN Proc *		TclFindProc(Interp *iPtr, CONST char *procName);
#endif
#ifndef TclFormatInt_TCL_DECLARED
#define TclFormatInt_TCL_DECLARED
/* 24 */
EXTERN size_t		TclFormatInt(char *buffer, Tcl_WideInt n);
EXTERN int		TclFormatInt(char *buffer, long n);
#endif
#ifndef TclFreePackageInfo_TCL_DECLARED
#define TclFreePackageInfo_TCL_DECLARED
/* 25 */
EXTERN void		TclFreePackageInfo(Interp *iPtr);
#endif
/* Slot 26 is reserved */
/* Slot 27 is reserved */
#ifndef TclpGetDefaultStdChannel_TCL_DECLARED
#define TclpGetDefaultStdChannel_TCL_DECLARED
/* 28 */
EXTERN Tcl_Channel	TclpGetDefaultStdChannel(int type);
#endif
/* Slot 29 is reserved */
/* Slot 30 is reserved */
#ifndef TclGetExtension_TCL_DECLARED
#define TclGetExtension_TCL_DECLARED
/* 31 */
EXTERN const char *	TclGetExtension(const char *name);
EXTERN CONST char *	TclGetExtension(CONST char *name);
#endif
#ifndef TclGetFrame_TCL_DECLARED
#define TclGetFrame_TCL_DECLARED
/* 32 */
EXTERN int		TclGetFrame(Tcl_Interp *interp, const char *str,
EXTERN int		TclGetFrame(Tcl_Interp *interp, CONST char *str,
				CallFrame **framePtrPtr);
#endif
/* Slot 33 is reserved */
#ifndef TclGetIntForIndex_TCL_DECLARED
#define TclGetIntForIndex_TCL_DECLARED
/* Slot 34 is reserved */
/* 34 */
EXTERN int		TclGetIntForIndex(Tcl_Interp *interp,
				Tcl_Obj *objPtr, int endValue, int *indexPtr);
#endif
/* Slot 35 is reserved */
#ifndef TclGetLong_TCL_DECLARED
#define TclGetLong_TCL_DECLARED
/* Slot 36 is reserved */
/* 36 */
EXTERN int		TclGetLong(Tcl_Interp *interp, CONST char *str,
				long *longPtr);
#endif
#ifndef TclGetLoadedPackages_TCL_DECLARED
#define TclGetLoadedPackages_TCL_DECLARED
/* 37 */
EXTERN int		TclGetLoadedPackages(Tcl_Interp *interp,
				const char *targetName);
				char *targetName);
#endif
#ifndef TclGetNamespaceForQualName_TCL_DECLARED
#define TclGetNamespaceForQualName_TCL_DECLARED
/* 38 */
EXTERN int		TclGetNamespaceForQualName(Tcl_Interp *interp,
				const char *qualName, Namespace *cxtNsPtr,
				CONST char *qualName, Namespace *cxtNsPtr,
				int flags, Namespace **nsPtrPtr,
				Namespace **altNsPtrPtr,
				Namespace **actualCxtPtrPtr,
				const char **simpleNamePtr);
				CONST char **simpleNamePtr);
#endif
#ifndef TclGetObjInterpProc_TCL_DECLARED
#define TclGetObjInterpProc_TCL_DECLARED
/* 39 */
EXTERN TclObjCmdProcType TclGetObjInterpProc(void);
#endif
#ifndef TclGetOpenMode_TCL_DECLARED
#define TclGetOpenMode_TCL_DECLARED
/* 40 */
EXTERN int		TclGetOpenMode(Tcl_Interp *interp, const char *str,
EXTERN int		TclGetOpenMode(Tcl_Interp *interp, CONST char *str,
				int *seekFlagPtr);
#endif
#ifndef TclGetOriginalCommand_TCL_DECLARED
#define TclGetOriginalCommand_TCL_DECLARED
/* 41 */
EXTERN Tcl_Command	TclGetOriginalCommand(Tcl_Command command);
#endif
#ifndef TclpGetUserHome_TCL_DECLARED
#define TclpGetUserHome_TCL_DECLARED
/* 42 */
EXTERN const char *	TclpGetUserHome(const char *name,
EXTERN char *		TclpGetUserHome(CONST char *name,
				Tcl_DString *bufferPtr);
#endif
/* Slot 43 is reserved */
#ifndef TclGuessPackageName_TCL_DECLARED
#define TclGuessPackageName_TCL_DECLARED
/* 44 */
EXTERN int		TclGuessPackageName(const char *fileName,
EXTERN int		TclGuessPackageName(CONST char *fileName,
				Tcl_DString *bufPtr);
#endif
#ifndef TclHideUnsafeCommands_TCL_DECLARED
#define TclHideUnsafeCommands_TCL_DECLARED
/* 45 */
EXTERN int		TclHideUnsafeCommands(Tcl_Interp *interp);
#endif
#ifndef TclInExit_TCL_DECLARED
#define TclInExit_TCL_DECLARED
/* 46 */
EXTERN int		TclInExit(void);
#endif
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
#ifndef TclInitCompiledLocals_TCL_DECLARED
#define TclInitCompiledLocals_TCL_DECLARED
/* Slot 50 is reserved */
/* 50 */
EXTERN void		TclInitCompiledLocals(Tcl_Interp *interp,
				CallFrame *framePtr, Namespace *nsPtr);
#endif
#ifndef TclInterpInit_TCL_DECLARED
#define TclInterpInit_TCL_DECLARED
/* 51 */
EXTERN int		TclInterpInit(Tcl_Interp *interp);
#endif
/* Slot 52 is reserved */
#ifndef TclInvokeObjectCommand_TCL_DECLARED
#define TclInvokeObjectCommand_TCL_DECLARED
/* 53 */
EXTERN int		TclInvokeObjectCommand(void *clientData,
EXTERN int		TclInvokeObjectCommand(ClientData clientData,
				Tcl_Interp *interp, int argc,
				const char **argv);
				CONST84 char **argv);
#endif
#ifndef TclInvokeStringCommand_TCL_DECLARED
#define TclInvokeStringCommand_TCL_DECLARED
/* 54 */
EXTERN int		TclInvokeStringCommand(void *clientData,
EXTERN int		TclInvokeStringCommand(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
				Tcl_Obj *CONST objv[]);
#endif
#ifndef TclIsProc_TCL_DECLARED
#define TclIsProc_TCL_DECLARED
/* 55 */
EXTERN Proc *		TclIsProc(Command *cmdPtr);
#endif
/* Slot 56 is reserved */
/* Slot 57 is reserved */
#ifndef TclLookupVar_TCL_DECLARED
#define TclLookupVar_TCL_DECLARED
/* 58 */
EXTERN Var *		TclLookupVar(Tcl_Interp *interp, const char *part1,
				const char *part2, int flags,
				const char *msg, int createPart1,
EXTERN Var *		TclLookupVar(Tcl_Interp *interp, CONST char *part1,
				CONST char *part2, int flags,
				CONST char *msg, int createPart1,
				int createPart2, Var **arrayPtrPtr);
#endif
/* Slot 59 is reserved */
#ifndef TclNeedSpace_TCL_DECLARED
#define TclNeedSpace_TCL_DECLARED
/* 60 */
EXTERN int		TclNeedSpace(const char *start, const char *end);
EXTERN int		TclNeedSpace(CONST char *start, CONST char *end);
#endif
#ifndef TclNewProcBodyObj_TCL_DECLARED
#define TclNewProcBodyObj_TCL_DECLARED
/* 61 */
EXTERN Tcl_Obj *	TclNewProcBodyObj(Proc *procPtr);
#endif
#ifndef TclObjCommandComplete_TCL_DECLARED
#define TclObjCommandComplete_TCL_DECLARED
/* 62 */
EXTERN int		TclObjCommandComplete(Tcl_Obj *cmdPtr);
#endif
#ifndef TclObjInterpProc_TCL_DECLARED
#define TclObjInterpProc_TCL_DECLARED
/* 63 */
EXTERN int		TclObjInterpProc(void *clientData,
EXTERN int		TclObjInterpProc(ClientData clientData,
				Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[]);
				Tcl_Obj *CONST objv[]);
#endif
#ifndef TclObjInvoke_TCL_DECLARED
#define TclObjInvoke_TCL_DECLARED
/* 64 */
EXTERN int		TclObjInvoke(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags);
				Tcl_Obj *CONST objv[], int flags);
#endif
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* Slot 68 is reserved */
#ifndef TclpAlloc_TCL_DECLARED
#define TclpAlloc_TCL_DECLARED
/* 69 */
EXTERN void *		TclpAlloc(size_t size);
EXTERN char *		TclpAlloc(unsigned int size);
#endif
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
#ifndef TclpFree_TCL_DECLARED
#define TclpFree_TCL_DECLARED
/* 74 */
EXTERN void		TclpFree(void *ptr);
EXTERN void		TclpFree(char *ptr);
#endif
#ifndef TclpGetClicks_TCL_DECLARED
#define TclpGetClicks_TCL_DECLARED
/* 75 */
EXTERN Tcl_WideUInt	TclpGetClicks(void);
EXTERN unsigned long	TclpGetClicks(void);
#endif
#ifndef TclpGetSeconds_TCL_DECLARED
#define TclpGetSeconds_TCL_DECLARED
/* 76 */
EXTERN Tcl_WideUInt	TclpGetSeconds(void);
/* Slot 77 is reserved */
/* Slot 78 is reserved */
EXTERN unsigned long	TclpGetSeconds(void);
#endif
#ifndef TclpGetTime_TCL_DECLARED
#define TclpGetTime_TCL_DECLARED
/* 77 */
EXTERN void		TclpGetTime(Tcl_Time *time);
#endif
#ifndef TclpGetTimeZone_TCL_DECLARED
#define TclpGetTimeZone_TCL_DECLARED
/* 78 */
EXTERN int		TclpGetTimeZone(unsigned long time);
#endif
/* Slot 79 is reserved */
/* Slot 80 is reserved */
#ifndef TclpRealloc_TCL_DECLARED
#define TclpRealloc_TCL_DECLARED
/* 81 */
EXTERN void *		TclpRealloc(void *ptr, size_t size);
EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
#endif
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
#ifndef TclPrecTraceProc_TCL_DECLARED
#define TclPrecTraceProc_TCL_DECLARED
/* Slot 88 is reserved */
/* 88 */
EXTERN char *		TclPrecTraceProc(ClientData clientData,
				Tcl_Interp *interp, CONST char *name1,
				CONST char *name2, int flags);
#endif
#ifndef TclPreventAliasLoop_TCL_DECLARED
#define TclPreventAliasLoop_TCL_DECLARED
/* 89 */
EXTERN int		TclPreventAliasLoop(Tcl_Interp *interp,
				Tcl_Interp *cmdInterp, Tcl_Command cmd);
#endif
/* Slot 90 is reserved */
#ifndef TclProcCleanupProc_TCL_DECLARED
#define TclProcCleanupProc_TCL_DECLARED
/* 91 */
EXTERN void		TclProcCleanupProc(Proc *procPtr);
#endif
#ifndef TclProcCompileProc_TCL_DECLARED
#define TclProcCompileProc_TCL_DECLARED
/* 92 */
EXTERN int		TclProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
				Tcl_Obj *bodyPtr, Namespace *nsPtr,
				const char *description,
				const char *procName);
				CONST char *description,
				CONST char *procName);
#endif
#ifndef TclProcDeleteProc_TCL_DECLARED
#define TclProcDeleteProc_TCL_DECLARED
/* 93 */
EXTERN void		TclProcDeleteProc(void *clientData);
EXTERN void		TclProcDeleteProc(ClientData clientData);
#endif
/* Slot 94 is reserved */
/* Slot 95 is reserved */
#ifndef TclRenameCommand_TCL_DECLARED
#define TclRenameCommand_TCL_DECLARED
/* 96 */
EXTERN int		TclRenameCommand(Tcl_Interp *interp,
				const char *oldName, const char *newName);
				CONST char *oldName, CONST char *newName);
#endif
#ifndef TclResetShadowedCmdRefs_TCL_DECLARED
#define TclResetShadowedCmdRefs_TCL_DECLARED
/* 97 */
EXTERN void		TclResetShadowedCmdRefs(Tcl_Interp *interp,
				Command *newCmdPtr);
#endif
#ifndef TclServiceIdle_TCL_DECLARED
#define TclServiceIdle_TCL_DECLARED
/* 98 */
EXTERN int		TclServiceIdle(void);
#endif
/* Slot 99 is reserved */
/* Slot 100 is reserved */
#ifndef TclSetPreInitScript_TCL_DECLARED
#define TclSetPreInitScript_TCL_DECLARED
/* 101 */
EXTERN const char *	TclSetPreInitScript(const char *string);
EXTERN char *		TclSetPreInitScript(char *string);
#endif
#ifndef TclSetupEnv_TCL_DECLARED
#define TclSetupEnv_TCL_DECLARED
/* 102 */
EXTERN void		TclSetupEnv(Tcl_Interp *interp);
#endif
#ifndef TclSockGetPort_TCL_DECLARED
#define TclSockGetPort_TCL_DECLARED
/* 103 */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
				const char *proto, int *portPtr);
/* Slot 104 is reserved */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, CONST char *str,
				CONST char *proto, int *portPtr);
#endif
#ifndef TclSockMinimumBuffersOld_TCL_DECLARED
#define TclSockMinimumBuffersOld_TCL_DECLARED
/* 104 */
EXTERN int		TclSockMinimumBuffersOld(int sock, int size);
#endif
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
#ifndef TclTeardownNamespace_TCL_DECLARED
#define TclTeardownNamespace_TCL_DECLARED
/* 108 */
EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
#endif
#ifndef TclUpdateReturnInfo_TCL_DECLARED
#define TclUpdateReturnInfo_TCL_DECLARED
/* 109 */
EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
#endif
#ifndef TclSockMinimumBuffers_TCL_DECLARED
#define TclSockMinimumBuffers_TCL_DECLARED
/* 110 */
EXTERN int		TclSockMinimumBuffers(void *sock, int size);
EXTERN int		TclSockMinimumBuffers(VOID *sock, int size);
#endif
#ifndef Tcl_AddInterpResolvers_TCL_DECLARED
#define Tcl_AddInterpResolvers_TCL_DECLARED
/* 111 */
EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
				const char *name,
				CONST char *name,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
#endif
#ifndef Tcl_AppendExportList_TCL_DECLARED
#define Tcl_AppendExportList_TCL_DECLARED
/* Slot 112 is reserved */
/* Slot 113 is reserved */
/* Slot 114 is reserved */
/* Slot 115 is reserved */
/* Slot 116 is reserved */
/* Slot 117 is reserved */
/* 112 */
EXTERN int		Tcl_AppendExportList(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_CreateNamespace_TCL_DECLARED
#define Tcl_CreateNamespace_TCL_DECLARED
/* 113 */
EXTERN Tcl_Namespace *	Tcl_CreateNamespace(Tcl_Interp *interp,
				CONST char *name, ClientData clientData,
				Tcl_NamespaceDeleteProc *deleteProc);
#endif
#ifndef Tcl_DeleteNamespace_TCL_DECLARED
#define Tcl_DeleteNamespace_TCL_DECLARED
/* 114 */
EXTERN void		Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
#endif
#ifndef Tcl_Export_TCL_DECLARED
#define Tcl_Export_TCL_DECLARED
/* 115 */
EXTERN int		Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				CONST char *pattern, int resetListFirst);
#endif
#ifndef Tcl_FindCommand_TCL_DECLARED
#define Tcl_FindCommand_TCL_DECLARED
/* 116 */
EXTERN Tcl_Command	Tcl_FindCommand(Tcl_Interp *interp, CONST char *name,
				Tcl_Namespace *contextNsPtr, int flags);
#endif
#ifndef Tcl_FindNamespace_TCL_DECLARED
#define Tcl_FindNamespace_TCL_DECLARED
/* 117 */
EXTERN Tcl_Namespace *	Tcl_FindNamespace(Tcl_Interp *interp,
				CONST char *name,
				Tcl_Namespace *contextNsPtr, int flags);
#endif
#ifndef Tcl_GetInterpResolvers_TCL_DECLARED
#define Tcl_GetInterpResolvers_TCL_DECLARED
/* 118 */
EXTERN int		Tcl_GetInterpResolvers(Tcl_Interp *interp,
				const char *name, Tcl_ResolverInfo *resInfo);
				CONST char *name, Tcl_ResolverInfo *resInfo);
#endif
#ifndef Tcl_GetNamespaceResolvers_TCL_DECLARED
#define Tcl_GetNamespaceResolvers_TCL_DECLARED
/* 119 */
EXTERN int		Tcl_GetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolverInfo *resInfo);
#endif
#ifndef Tcl_FindNamespaceVar_TCL_DECLARED
#define Tcl_FindNamespaceVar_TCL_DECLARED
/* 120 */
EXTERN Tcl_Var		Tcl_FindNamespaceVar(Tcl_Interp *interp,
				const char *name,
				CONST char *name,
				Tcl_Namespace *contextNsPtr, int flags);
#endif
#ifndef Tcl_ForgetImport_TCL_DECLARED
#define Tcl_ForgetImport_TCL_DECLARED
/* Slot 121 is reserved */
/* Slot 122 is reserved */
/* Slot 123 is reserved */
/* Slot 124 is reserved */
/* Slot 125 is reserved */
/* 121 */
EXTERN int		Tcl_ForgetImport(Tcl_Interp *interp,
				Tcl_Namespace *nsPtr, CONST char *pattern);
#endif
#ifndef Tcl_GetCommandFromObj_TCL_DECLARED
#define Tcl_GetCommandFromObj_TCL_DECLARED
/* 122 */
EXTERN Tcl_Command	Tcl_GetCommandFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetCommandFullName_TCL_DECLARED
#define Tcl_GetCommandFullName_TCL_DECLARED
/* 123 */
EXTERN void		Tcl_GetCommandFullName(Tcl_Interp *interp,
				Tcl_Command command, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_GetCurrentNamespace_TCL_DECLARED
#define Tcl_GetCurrentNamespace_TCL_DECLARED
/* 124 */
EXTERN Tcl_Namespace *	Tcl_GetCurrentNamespace(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetGlobalNamespace_TCL_DECLARED
#define Tcl_GetGlobalNamespace_TCL_DECLARED
/* 125 */
EXTERN Tcl_Namespace *	Tcl_GetGlobalNamespace(Tcl_Interp *interp);
#endif
#ifndef Tcl_GetVariableFullName_TCL_DECLARED
#define Tcl_GetVariableFullName_TCL_DECLARED
/* 126 */
EXTERN void		Tcl_GetVariableFullName(Tcl_Interp *interp,
				Tcl_Var variable, Tcl_Obj *objPtr);
#endif
#ifndef Tcl_Import_TCL_DECLARED
#define Tcl_Import_TCL_DECLARED
/* Slot 127 is reserved */
/* 127 */
EXTERN int		Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
				CONST char *pattern, int allowOverwrite);
#endif
#ifndef Tcl_PopCallFrame_TCL_DECLARED
#define Tcl_PopCallFrame_TCL_DECLARED
/* 128 */
EXTERN void		Tcl_PopCallFrame(Tcl_Interp *interp);
#endif
#ifndef Tcl_PushCallFrame_TCL_DECLARED
#define Tcl_PushCallFrame_TCL_DECLARED
/* 129 */
EXTERN int		Tcl_PushCallFrame(Tcl_Interp *interp,
				Tcl_CallFrame *framePtr,
				Tcl_Namespace *nsPtr, int isProcCallFrame);
#endif
#ifndef Tcl_RemoveInterpResolvers_TCL_DECLARED
#define Tcl_RemoveInterpResolvers_TCL_DECLARED
/* 130 */
EXTERN int		Tcl_RemoveInterpResolvers(Tcl_Interp *interp,
				const char *name);
				CONST char *name);
#endif
#ifndef Tcl_SetNamespaceResolvers_TCL_DECLARED
#define Tcl_SetNamespaceResolvers_TCL_DECLARED
/* 131 */
EXTERN void		Tcl_SetNamespaceResolvers(
				Tcl_Namespace *namespacePtr,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
#endif
#ifndef TclpHasSockets_TCL_DECLARED
#define TclpHasSockets_TCL_DECLARED
/* 132 */
EXTERN int		TclpHasSockets(Tcl_Interp *interp);
#endif
#ifndef TclpGetDate_TCL_DECLARED
#define TclpGetDate_TCL_DECLARED
/* Slot 133 is reserved */
/* 133 */
EXTERN struct tm *	TclpGetDate(CONST time_t *time, int useGMT);
#endif
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
#ifndef TclGetEnv_TCL_DECLARED
#define TclGetEnv_TCL_DECLARED
/* 138 */
EXTERN CONST84_RETURN char * TclGetEnv(CONST char *name,
EXTERN const char *	TclGetEnv(const char *name, Tcl_DString *valuePtr);
				Tcl_DString *valuePtr);
#endif
/* Slot 139 is reserved */
/* Slot 140 is reserved */
#ifndef TclpGetCwd_TCL_DECLARED
#define TclpGetCwd_TCL_DECLARED
/* 141 */
EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
EXTERN const char *	TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
				Tcl_DString *cwdPtr);
#endif
#ifndef TclSetByteCodeFromAny_TCL_DECLARED
#define TclSetByteCodeFromAny_TCL_DECLARED
/* 142 */
EXTERN int		TclSetByteCodeFromAny(Tcl_Interp *interp,
				Tcl_Obj *objPtr, CompileHookProc *hookProc,
				void *clientData);
				ClientData clientData);
#endif
#ifndef TclAddLiteralObj_TCL_DECLARED
#define TclAddLiteralObj_TCL_DECLARED
/* 143 */
EXTERN int		TclAddLiteralObj(struct CompileEnv *envPtr,
				Tcl_Obj *objPtr, LiteralEntry **litPtrPtr);
#endif
#ifndef TclHideLiteral_TCL_DECLARED
#define TclHideLiteral_TCL_DECLARED
/* 144 */
EXTERN void		TclHideLiteral(Tcl_Interp *interp,
				struct CompileEnv *envPtr, int index);
#endif
#ifndef TclGetAuxDataType_TCL_DECLARED
#define TclGetAuxDataType_TCL_DECLARED
/* 145 */
EXTERN const struct AuxDataType * TclGetAuxDataType(const char *typeName);
EXTERN struct AuxDataType * TclGetAuxDataType(char *typeName);
#endif
#ifndef TclHandleCreate_TCL_DECLARED
#define TclHandleCreate_TCL_DECLARED
/* 146 */
EXTERN TclHandle	TclHandleCreate(void *ptr);
EXTERN TclHandle	TclHandleCreate(VOID *ptr);
#endif
#ifndef TclHandleFree_TCL_DECLARED
#define TclHandleFree_TCL_DECLARED
/* 147 */
EXTERN void		TclHandleFree(TclHandle handle);
#endif
#ifndef TclHandlePreserve_TCL_DECLARED
#define TclHandlePreserve_TCL_DECLARED
/* 148 */
EXTERN TclHandle	TclHandlePreserve(TclHandle handle);
#endif
#ifndef TclHandleRelease_TCL_DECLARED
#define TclHandleRelease_TCL_DECLARED
/* 149 */
EXTERN void		TclHandleRelease(TclHandle handle);
#endif
#ifndef TclRegAbout_TCL_DECLARED
#define TclRegAbout_TCL_DECLARED
/* 150 */
EXTERN int		TclRegAbout(Tcl_Interp *interp, Tcl_RegExp re);
#endif
#ifndef TclRegExpRangeUniChar_TCL_DECLARED
#define TclRegExpRangeUniChar_TCL_DECLARED
/* 151 */
EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, size_t index,
				size_t *startPtr, size_t *endPtr);
EXTERN void		TclRegExpRangeUniChar(Tcl_RegExp re, int index,
				int *startPtr, int *endPtr);
#endif
#ifndef TclSetLibraryPath_TCL_DECLARED
#define TclSetLibraryPath_TCL_DECLARED
/* 152 */
EXTERN void		TclSetLibraryPath(Tcl_Obj *pathPtr);
#endif
#ifndef TclGetLibraryPath_TCL_DECLARED
#define TclGetLibraryPath_TCL_DECLARED
/* 153 */
EXTERN Tcl_Obj *	TclGetLibraryPath(void);
#endif
/* Slot 154 is reserved */
/* Slot 155 is reserved */
#ifndef TclRegError_TCL_DECLARED
#define TclRegError_TCL_DECLARED
/* 156 */
EXTERN void		TclRegError(Tcl_Interp *interp, const char *msg,
EXTERN void		TclRegError(Tcl_Interp *interp, CONST char *msg,
				int status);
#endif
#ifndef TclVarTraceExists_TCL_DECLARED
#define TclVarTraceExists_TCL_DECLARED
/* 157 */
EXTERN Var *		TclVarTraceExists(Tcl_Interp *interp,
				const char *varName);
/* Slot 158 is reserved */
/* Slot 159 is reserved */
				CONST char *varName);
#endif
#ifndef TclSetStartupScriptFileName_TCL_DECLARED
#define TclSetStartupScriptFileName_TCL_DECLARED
/* 158 */
EXTERN void		TclSetStartupScriptFileName(CONST char *filename);
#endif
#ifndef TclGetStartupScriptFileName_TCL_DECLARED
#define TclGetStartupScriptFileName_TCL_DECLARED
/* 159 */
EXTERN CONST84_RETURN char * TclGetStartupScriptFileName(void);
#endif
/* Slot 160 is reserved */
#ifndef TclChannelTransform_TCL_DECLARED
#define TclChannelTransform_TCL_DECLARED
/* 161 */
EXTERN int		TclChannelTransform(Tcl_Interp *interp,
				Tcl_Channel chan, Tcl_Obj *cmdObjPtr);
#endif
#ifndef TclChannelEventScriptInvoker_TCL_DECLARED
#define TclChannelEventScriptInvoker_TCL_DECLARED
/* 162 */
EXTERN void		TclChannelEventScriptInvoker(void *clientData,
EXTERN void		TclChannelEventScriptInvoker(ClientData clientData,
				int flags);
#endif
#ifndef TclGetInstructionTable_TCL_DECLARED
#define TclGetInstructionTable_TCL_DECLARED
/* 163 */
EXTERN const void *	TclGetInstructionTable(void);
EXTERN VOID *		TclGetInstructionTable(void);
#endif
#ifndef TclExpandCodeArray_TCL_DECLARED
#define TclExpandCodeArray_TCL_DECLARED
/* 164 */
EXTERN void		TclExpandCodeArray(void *envPtr);
EXTERN void		TclExpandCodeArray(VOID *envPtr);
#endif
#ifndef TclpSetInitialEncodings_TCL_DECLARED
#define TclpSetInitialEncodings_TCL_DECLARED
/* 165 */
EXTERN void		TclpSetInitialEncodings(void);
#endif
#ifndef TclListObjSetElement_TCL_DECLARED
#define TclListObjSetElement_TCL_DECLARED
/* 166 */
EXTERN int		TclListObjSetElement(Tcl_Interp *interp,
				Tcl_Obj *listPtr, int index,
				Tcl_Obj *valuePtr);
#endif
#ifndef TclSetStartupScriptPath_TCL_DECLARED
#define TclSetStartupScriptPath_TCL_DECLARED
/* Slot 167 is reserved */
/* Slot 168 is reserved */
/* 167 */
EXTERN void		TclSetStartupScriptPath(Tcl_Obj *pathPtr);
#endif
#ifndef TclGetStartupScriptPath_TCL_DECLARED
#define TclGetStartupScriptPath_TCL_DECLARED
/* 168 */
EXTERN Tcl_Obj *	TclGetStartupScriptPath(void);
#endif
#ifndef TclpUtfNcmp2_TCL_DECLARED
#define TclpUtfNcmp2_TCL_DECLARED
/* 169 */
EXTERN int		TclpUtfNcmp2(const char *s1, const char *s2,
				size_t n);
EXTERN int		TclpUtfNcmp2(CONST char *s1, CONST char *s2,
				unsigned long n);
#endif
#ifndef TclCheckInterpTraces_TCL_DECLARED
#define TclCheckInterpTraces_TCL_DECLARED
/* 170 */
EXTERN int		TclCheckInterpTraces(Tcl_Interp *interp,
				const char *command, size_t numChars,
				CONST char *command, int numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
				int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef TclCheckExecutionTraces_TCL_DECLARED
#define TclCheckExecutionTraces_TCL_DECLARED
/* 171 */
EXTERN int		TclCheckExecutionTraces(Tcl_Interp *interp,
				const char *command, size_t numChars,
				CONST char *command, int numChars,
				Command *cmdPtr, int result, int traceFlags,
				int objc, Tcl_Obj *const objv[]);
				int objc, Tcl_Obj *CONST objv[]);
#endif
#ifndef TclInThreadExit_TCL_DECLARED
#define TclInThreadExit_TCL_DECLARED
/* 172 */
EXTERN int		TclInThreadExit(void);
#endif
#ifndef TclUniCharMatch_TCL_DECLARED
#define TclUniCharMatch_TCL_DECLARED
/* 173 */
EXTERN int		TclUniCharMatch(const Tcl_UniChar *string,
				size_t strLen, const Tcl_UniChar *pattern,
				size_t ptnLen, int flags);
EXTERN int		TclUniCharMatch(CONST Tcl_UniChar *string,
				int strLen, CONST Tcl_UniChar *pattern,
				int ptnLen, int flags);
#endif
/* Slot 174 is reserved */
#ifndef TclCallVarTraces_TCL_DECLARED
#define TclCallVarTraces_TCL_DECLARED
/* 175 */
EXTERN int		TclCallVarTraces(Interp *iPtr, Var *arrayPtr,
				Var *varPtr, const char *part1,
				const char *part2, int flags,
				Var *varPtr, CONST char *part1,
				CONST char *part2, int flags,
				int leaveErrMsg);
#endif
#ifndef TclCleanupVar_TCL_DECLARED
#define TclCleanupVar_TCL_DECLARED
/* 176 */
EXTERN void		TclCleanupVar(Var *varPtr, Var *arrayPtr);
#endif
#ifndef TclVarErrMsg_TCL_DECLARED
#define TclVarErrMsg_TCL_DECLARED
/* 177 */
EXTERN void		TclVarErrMsg(Tcl_Interp *interp, const char *part1,
				const char *part2, const char *operation,
				const char *reason);
/* Slot 178 is reserved */
/* Slot 179 is reserved */
EXTERN void		TclVarErrMsg(Tcl_Interp *interp, CONST char *part1,
				CONST char *part2, CONST char *operation,
				CONST char *reason);
#endif
#ifndef Tcl_SetStartupScript_TCL_DECLARED
#define Tcl_SetStartupScript_TCL_DECLARED
/* 178 */
EXTERN void		Tcl_SetStartupScript(Tcl_Obj *pathPtr,
				CONST char *encodingName);
#endif
#ifndef Tcl_GetStartupScript_TCL_DECLARED
#define Tcl_GetStartupScript_TCL_DECLARED
/* 179 */
EXTERN Tcl_Obj *	Tcl_GetStartupScript(CONST char **encodingNamePtr);
#endif
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#ifndef TclpLocaltime_TCL_DECLARED
#define TclpLocaltime_TCL_DECLARED
/* Slot 182 is reserved */
/* Slot 183 is reserved */
/* 182 */
EXTERN struct tm *	TclpLocaltime(CONST time_t *clock);
#endif
#ifndef TclpGmtime_TCL_DECLARED
#define TclpGmtime_TCL_DECLARED
/* 183 */
EXTERN struct tm *	TclpGmtime(CONST time_t *clock);
#endif
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
/* Slot 187 is reserved */
/* Slot 188 is reserved */
/* Slot 189 is reserved */
/* Slot 190 is reserved */
/* Slot 191 is reserved */
/* Slot 192 is reserved */
/* Slot 193 is reserved */
/* Slot 194 is reserved */
/* Slot 195 is reserved */
/* Slot 196 is reserved */
/* Slot 197 is reserved */
#ifndef TclObjGetFrame_TCL_DECLARED
#define TclObjGetFrame_TCL_DECLARED
/* 198 */
EXTERN int		TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr,
				CallFrame **framePtrPtr);
#endif
/* Slot 199 is reserved */
#ifndef TclpObjRemoveDirectory_TCL_DECLARED
#define TclpObjRemoveDirectory_TCL_DECLARED
/* 200 */
EXTERN int		TclpObjRemoveDirectory(Tcl_Obj *pathPtr,
				int recursive, Tcl_Obj **errorPtr);
#endif
#ifndef TclpObjCopyDirectory_TCL_DECLARED
#define TclpObjCopyDirectory_TCL_DECLARED
/* 201 */
EXTERN int		TclpObjCopyDirectory(Tcl_Obj *srcPathPtr,
				Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr);
#endif
#ifndef TclpObjCreateDirectory_TCL_DECLARED
#define TclpObjCreateDirectory_TCL_DECLARED
/* 202 */
EXTERN int		TclpObjCreateDirectory(Tcl_Obj *pathPtr);
#endif
#ifndef TclpObjDeleteFile_TCL_DECLARED
#define TclpObjDeleteFile_TCL_DECLARED
/* 203 */
EXTERN int		TclpObjDeleteFile(Tcl_Obj *pathPtr);
#endif
#ifndef TclpObjCopyFile_TCL_DECLARED
#define TclpObjCopyFile_TCL_DECLARED
/* 204 */
EXTERN int		TclpObjCopyFile(Tcl_Obj *srcPathPtr,
				Tcl_Obj *destPathPtr);
#endif
#ifndef TclpObjRenameFile_TCL_DECLARED
#define TclpObjRenameFile_TCL_DECLARED
/* 205 */
EXTERN int		TclpObjRenameFile(Tcl_Obj *srcPathPtr,
				Tcl_Obj *destPathPtr);
#endif
#ifndef TclpObjStat_TCL_DECLARED
#define TclpObjStat_TCL_DECLARED
/* 206 */
EXTERN int		TclpObjStat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
#endif
#ifndef TclpObjAccess_TCL_DECLARED
#define TclpObjAccess_TCL_DECLARED
/* 207 */
EXTERN int		TclpObjAccess(Tcl_Obj *pathPtr, int mode);
#endif
#ifndef TclpOpenFileChannel_TCL_DECLARED
#define TclpOpenFileChannel_TCL_DECLARED
/* 208 */
EXTERN Tcl_Channel	TclpOpenFileChannel(Tcl_Interp *interp,
				Tcl_Obj *pathPtr, int mode, int permissions);
#endif
/* Slot 209 is reserved */
/* Slot 210 is reserved */
/* Slot 211 is reserved */
#ifndef TclpFindExecutable_TCL_DECLARED
#define TclpFindExecutable_TCL_DECLARED
/* 212 */
EXTERN void		TclpFindExecutable(const char *argv0);
EXTERN void		TclpFindExecutable(CONST char *argv0);
#endif
#ifndef TclGetObjNameOfExecutable_TCL_DECLARED
#define TclGetObjNameOfExecutable_TCL_DECLARED
/* 213 */
EXTERN Tcl_Obj *	TclGetObjNameOfExecutable(void);
#endif
#ifndef TclSetObjNameOfExecutable_TCL_DECLARED
#define TclSetObjNameOfExecutable_TCL_DECLARED
/* 214 */
EXTERN void		TclSetObjNameOfExecutable(Tcl_Obj *name,
				Tcl_Encoding encoding);
#endif
#ifndef TclStackAlloc_TCL_DECLARED
#define TclStackAlloc_TCL_DECLARED
/* 215 */
EXTERN void *		TclStackAlloc(Tcl_Interp *interp, size_t numBytes);
EXTERN VOID *		TclStackAlloc(Tcl_Interp *interp, int numBytes);
#endif
#ifndef TclStackFree_TCL_DECLARED
#define TclStackFree_TCL_DECLARED
/* 216 */
EXTERN void		TclStackFree(Tcl_Interp *interp, void *freePtr);
EXTERN void		TclStackFree(Tcl_Interp *interp, VOID *freePtr);
#endif
#ifndef TclPushStackFrame_TCL_DECLARED
#define TclPushStackFrame_TCL_DECLARED
/* 217 */
EXTERN int		TclPushStackFrame(Tcl_Interp *interp,
				Tcl_CallFrame **framePtrPtr,
				Tcl_Namespace *namespacePtr,
				int isProcCallFrame);
#endif
#ifndef TclPopStackFrame_TCL_DECLARED
#define TclPopStackFrame_TCL_DECLARED
/* 218 */
EXTERN void		TclPopStackFrame(Tcl_Interp *interp);
#endif
/* Slot 219 is reserved */
/* Slot 220 is reserved */
/* Slot 221 is reserved */
/* Slot 222 is reserved */
/* Slot 223 is reserved */
#ifndef TclGetPlatform_TCL_DECLARED
#define TclGetPlatform_TCL_DECLARED
/* 224 */
EXTERN TclPlatformType * TclGetPlatform(void);
#endif
#ifndef TclTraceDictPath_TCL_DECLARED
#define TclTraceDictPath_TCL_DECLARED
/* 225 */
EXTERN Tcl_Obj *	TclTraceDictPath(Tcl_Interp *interp,
				Tcl_Obj *rootPtr, int keyc,
				Tcl_Obj *const keyv[], int flags);
				Tcl_Obj *CONST keyv[], int flags);
#endif
#ifndef TclObjBeingDeleted_TCL_DECLARED
#define TclObjBeingDeleted_TCL_DECLARED
/* 226 */
EXTERN int		TclObjBeingDeleted(Tcl_Obj *objPtr);
#endif
#ifndef TclSetNsPath_TCL_DECLARED
#define TclSetNsPath_TCL_DECLARED
/* 227 */
EXTERN void		TclSetNsPath(Namespace *nsPtr, size_t pathLength,
EXTERN void		TclSetNsPath(Namespace *nsPtr, int pathLength,
				Tcl_Namespace *pathAry[]);
#endif
#ifndef TclObjInterpProcCore_TCL_DECLARED
#define TclObjInterpProcCore_TCL_DECLARED
/* Slot 228 is reserved */
/* 228 */
EXTERN int		TclObjInterpProcCore(register Tcl_Interp *interp,
				Tcl_Obj *procNameObj, int skip,
				ProcErrorProc errorProc);
#endif
#ifndef TclPtrMakeUpvar_TCL_DECLARED
#define TclPtrMakeUpvar_TCL_DECLARED
/* 229 */
EXTERN int		TclPtrMakeUpvar(Tcl_Interp *interp, Var *otherP1Ptr,
				const char *myName, int myFlags, int index);
				CONST char *myName, int myFlags, int index);
#endif
#ifndef TclObjLookupVar_TCL_DECLARED
#define TclObjLookupVar_TCL_DECLARED
/* 230 */
EXTERN Var *		TclObjLookupVar(Tcl_Interp *interp,
				Tcl_Obj *part1Ptr, const char *part2,
				int flags, const char *msg,
				const int createPart1, const int createPart2,
				Tcl_Obj *part1Ptr, CONST char *part2,
				int flags, CONST char *msg,
				CONST int createPart1, CONST int createPart2,
				Var **arrayPtrPtr);
#endif
#ifndef TclGetNamespaceFromObj_TCL_DECLARED
#define TclGetNamespaceFromObj_TCL_DECLARED
/* 231 */
EXTERN int		TclGetNamespaceFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
#endif
#ifndef TclEvalObjEx_TCL_DECLARED
#define TclEvalObjEx_TCL_DECLARED
/* 232 */
EXTERN int		TclEvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags, const CmdFrame *invoker, int word);
				int flags, CONST CmdFrame *invoker, int word);
#endif
#ifndef TclGetSrcInfoForPc_TCL_DECLARED
#define TclGetSrcInfoForPc_TCL_DECLARED
/* 233 */
EXTERN void		TclGetSrcInfoForPc(CmdFrame *contextPtr);
#endif
#ifndef TclVarHashCreateVar_TCL_DECLARED
#define TclVarHashCreateVar_TCL_DECLARED
/* 234 */
EXTERN Var *		TclVarHashCreateVar(TclVarHashTable *tablePtr,
				const char *key, int *newPtr);
				CONST char *key, int *newPtr);
#endif
#ifndef TclInitVarHashTable_TCL_DECLARED
#define TclInitVarHashTable_TCL_DECLARED
/* 235 */
EXTERN void		TclInitVarHashTable(TclVarHashTable *tablePtr,
				Namespace *nsPtr);
/* Slot 236 is reserved */
/* 237 */
EXTERN int		TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
#endif
#ifndef TclBackgroundException_TCL_DECLARED
#define TclBackgroundException_TCL_DECLARED
/* 236 */
EXTERN void		TclBackgroundException(Tcl_Interp *interp, int code);
#endif
/* Slot 237 is reserved */
/* Slot 238 is reserved */
EXTERN int		TclNRInterpProc(void *clientData, Tcl_Interp *interp,
				int objc, Tcl_Obj *const objv[]);
/* 239 */
/* Slot 239 is reserved */
EXTERN int		TclNRInterpProcCore(Tcl_Interp *interp,
				Tcl_Obj *procNameObj, int skip,
				ProcErrorProc *errorProc);
/* 240 */
/* Slot 240 is reserved */
EXTERN int		TclNRRunCallbacks(Tcl_Interp *interp, int result,
				struct NRE_callback *rootPtr);
/* 241 */
/* Slot 241 is reserved */
EXTERN int		TclNREvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags, const CmdFrame *invoker, int word);
/* 242 */
/* Slot 242 is reserved */
EXTERN int		TclNREvalObjv(Tcl_Interp *interp, int objc,
				Tcl_Obj *const objv[], int flags,
				Command *cmdPtr);
#ifndef TclDbDumpActiveObjects_TCL_DECLARED
#define TclDbDumpActiveObjects_TCL_DECLARED
/* 243 */
EXTERN void		TclDbDumpActiveObjects(FILE *outFile);
#endif
/* 244 */
/* Slot 244 is reserved */
EXTERN Tcl_HashTable *	TclGetNamespaceChildTable(Tcl_Namespace *nsPtr);
/* 245 */
/* Slot 245 is reserved */
EXTERN Tcl_HashTable *	TclGetNamespaceCommandTable(Tcl_Namespace *nsPtr);
/* 246 */
/* Slot 246 is reserved */
EXTERN int		TclInitRewriteEnsemble(Tcl_Interp *interp,
				size_t numRemoved, size_t numInserted,
				Tcl_Obj *const *objv);
/* 247 */
/* Slot 247 is reserved */
EXTERN void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
/* Slot 248 is reserved */
EXTERN int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
#ifndef TclDoubleDigits_TCL_DECLARED
#define TclDoubleDigits_TCL_DECLARED
/* 249 */
EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
#endif
/* 250 */
/* Slot 250 is reserved */
EXTERN void		TclSetChildCancelFlags(Tcl_Interp *interp, int flags,
				int force);
#ifndef TclRegisterLiteral_TCL_DECLARED
#define TclRegisterLiteral_TCL_DECLARED
/* 251 */
EXTERN int		TclRegisterLiteral(void *envPtr, const char *bytes,
				size_t length, int flags);
/* 252 */
EXTERN int		TclRegisterLiteral(VOID *envPtr, char *bytes,
				int length, int flags);
#endif
/* Slot 252 is reserved */
EXTERN Tcl_Obj *	TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, const int flags);
/* 253 */
/* Slot 253 is reserved */
EXTERN Tcl_Obj *	TclPtrSetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr,
				const int flags);
/* 254 */
/* Slot 254 is reserved */
EXTERN Tcl_Obj *	TclPtrIncrObjVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
				Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr,
				const int flags);
/* 255 */
/* Slot 255 is reserved */
EXTERN int		TclPtrObjMakeUpvar(Tcl_Interp *interp,
				Tcl_Var otherPtr, Tcl_Obj *myNamePtr,
				int myFlags);
/* 256 */
/* Slot 256 is reserved */
EXTERN int		TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
#ifndef TclStaticPackage_TCL_DECLARED
				Tcl_Obj *part2Ptr, const int flags);
#define TclStaticPackage_TCL_DECLARED
/* 257 */
EXTERN void		TclStaticPackage(Tcl_Interp *interp,
				const char *pkgName,
				CONST char *pkgName,
				Tcl_PackageInitProc *initProc,
				Tcl_PackageInitProc *safeInitProc);
#endif
/* 258 */
/* Slot 258 is reserved */
EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj);
/* 259 */
EXTERN void		TclAppendUnicodeToObj(Tcl_Obj *objPtr,
				const Tcl_UniChar *unicode, size_t length);
/* 260 */
EXTERN unsigned char *	TclGetBytesFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr, size_t *lengthPtr);
/* Slot 259 is reserved */
/* Slot 260 is reserved */
#ifndef TclUnusedStubEntry_TCL_DECLARED
#define TclUnusedStubEntry_TCL_DECLARED
/* 261 */
EXTERN void		TclUnusedStubEntry(void);
#endif

typedef struct TclIntStubs {
    int magic;
    void *hooks;
    struct TclIntStubHooks *hooks;

    void (*reserved0)(void);
    void (*reserved1)(void);
    void (*reserved2)(void);
    VOID *reserved0;
    VOID *reserved1;
    VOID *reserved2;
    void (*tclAllocateFreeObjects) (void); /* 3 */
    void (*reserved4)(void);
    VOID *reserved4;
    int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
    void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
    size_t (*tclCopyAndCollapse) (size_t count, const char *src, char *dst); /* 7 */
    void (*reserved8)(void);
    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
    int (*tclCopyAndCollapse) (int count, CONST char *src, char *dst); /* 7 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
    int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, CONST char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
    int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, CONST char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
    void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
    void (*tclDeleteVars) (Interp *iPtr, TclVarHashTable *tablePtr); /* 12 */
    void (*reserved13)(void);
    int (*tclDumpMemoryInfo) (void *clientData, int flags); /* 14 */
    void (*reserved15)(void);
    VOID *reserved13;
    int (*tclDumpMemoryInfo) (ClientData clientData, int flags); /* 14 */
    VOID *reserved15;
    void (*tclExprFloatError) (Tcl_Interp *interp, double value); /* 16 */
    void (*reserved17)(void);
    void (*reserved18)(void);
    void (*reserved19)(void);
    void (*reserved20)(void);
    void (*reserved21)(void);
    int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, size_t *sizePtr, int *bracePtr); /* 22 */
    Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
    size_t (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
    VOID *reserved17;
    VOID *reserved18;
    VOID *reserved19;
    VOID *reserved20;
    VOID *reserved21;
    int (*tclFindElement) (Tcl_Interp *interp, CONST char *listStr, int listLength, CONST char **elementPtr, CONST char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
    Proc * (*tclFindProc) (Interp *iPtr, CONST char *procName); /* 23 */
    int (*tclFormatInt) (char *buffer, long n); /* 24 */
    void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
    void (*reserved26)(void);
    void (*reserved27)(void);
    VOID *reserved26;
    VOID *reserved27;
    Tcl_Channel (*tclpGetDefaultStdChannel) (int type); /* 28 */
    void (*reserved29)(void);
    void (*reserved30)(void);
    const char * (*tclGetExtension) (const char *name); /* 31 */
    int (*tclGetFrame) (Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr); /* 32 */
    void (*reserved33)(void);
    void (*reserved34)(void);
    void (*reserved35)(void);
    void (*reserved36)(void);
    int (*tclGetLoadedPackages) (Tcl_Interp *interp, const char *targetName); /* 37 */
    int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, const char **simpleNamePtr); /* 38 */
    VOID *reserved29;
    VOID *reserved30;
    CONST char * (*tclGetExtension) (CONST char *name); /* 31 */
    int (*tclGetFrame) (Tcl_Interp *interp, CONST char *str, CallFrame **framePtrPtr); /* 32 */
    VOID *reserved33;
    int (*tclGetIntForIndex) (Tcl_Interp *interp, Tcl_Obj *objPtr, int endValue, int *indexPtr); /* 34 */
    VOID *reserved35;
    int (*tclGetLong) (Tcl_Interp *interp, CONST char *str, long *longPtr); /* 36 */
    int (*tclGetLoadedPackages) (Tcl_Interp *interp, char *targetName); /* 37 */
    int (*tclGetNamespaceForQualName) (Tcl_Interp *interp, CONST char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, Namespace **altNsPtrPtr, Namespace **actualCxtPtrPtr, CONST char **simpleNamePtr); /* 38 */
    TclObjCmdProcType (*tclGetObjInterpProc) (void); /* 39 */
    int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */
    int (*tclGetOpenMode) (Tcl_Interp *interp, CONST char *str, int *seekFlagPtr); /* 40 */
    Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */
    const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */
    void (*reserved43)(void);
    int (*tclGuessPackageName) (const char *fileName, Tcl_DString *bufPtr); /* 44 */
    char * (*tclpGetUserHome) (CONST char *name, Tcl_DString *bufferPtr); /* 42 */
    VOID *reserved43;
    int (*tclGuessPackageName) (CONST char *fileName, Tcl_DString *bufPtr); /* 44 */
    int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */
    int (*tclInExit) (void); /* 46 */
    void (*reserved47)(void);
    void (*reserved48)(void);
    void (*reserved49)(void);
    void (*reserved50)(void);
    VOID *reserved47;
    VOID *reserved48;
    VOID *reserved49;
    void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
    int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
    void (*reserved52)(void);
    int (*tclInvokeObjectCommand) (void *clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
    int (*tclInvokeStringCommand) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
    VOID *reserved52;
    int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
    int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* 54 */
    Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
    void (*reserved56)(void);
    void (*reserved57)(void);
    Var * (*tclLookupVar) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, const char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
    void (*reserved59)(void);
    int (*tclNeedSpace) (const char *start, const char *end); /* 60 */
    VOID *reserved56;
    VOID *reserved57;
    Var * (*tclLookupVar) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr); /* 58 */
    VOID *reserved59;
    int (*tclNeedSpace) (CONST char *start, CONST char *end); /* 60 */
    Tcl_Obj * (*tclNewProcBodyObj) (Proc *procPtr); /* 61 */
    int (*tclObjCommandComplete) (Tcl_Obj *cmdPtr); /* 62 */
    int (*tclObjInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 63 */
    int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 64 */
    void (*reserved65)(void);
    void (*reserved66)(void);
    void (*reserved67)(void);
    void (*reserved68)(void);
    void * (*tclpAlloc) (size_t size); /* 69 */
    void (*reserved70)(void);
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (void *ptr); /* 74 */
    Tcl_WideUInt (*tclpGetClicks) (void); /* 75 */
    Tcl_WideUInt (*tclpGetSeconds) (void); /* 76 */
    void (*reserved77)(void);
    void (*reserved78)(void);
    void (*reserved79)(void);
    void (*reserved80)(void);
    void * (*tclpRealloc) (void *ptr, size_t size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);
    void (*reserved86)(void);
    void (*reserved87)(void);
    void (*reserved88)(void);
    int (*tclObjInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]); /* 63 */
    int (*tclObjInvoke) (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], int flags); /* 64 */
    VOID *reserved65;
    VOID *reserved66;
    VOID *reserved67;
    VOID *reserved68;
    char * (*tclpAlloc) (unsigned int size); /* 69 */
    VOID *reserved70;
    VOID *reserved71;
    VOID *reserved72;
    VOID *reserved73;
    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 *reserved80;
    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
    VOID *reserved82;
    VOID *reserved83;
    VOID *reserved84;
    VOID *reserved85;
    VOID *reserved86;
    VOID *reserved87;
    char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, CONST char *name1, CONST char *name2, int flags); /* 88 */
    int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
    void (*reserved90)(void);
    VOID *reserved90;
    void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
    int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, const char *description, const char *procName); /* 92 */
    void (*tclProcDeleteProc) (void *clientData); /* 93 */
    void (*reserved94)(void);
    void (*reserved95)(void);
    int (*tclRenameCommand) (Tcl_Interp *interp, const char *oldName, const char *newName); /* 96 */
    int (*tclProcCompileProc) (Tcl_Interp *interp, Proc *procPtr, Tcl_Obj *bodyPtr, Namespace *nsPtr, CONST char *description, CONST char *procName); /* 92 */
    void (*tclProcDeleteProc) (ClientData clientData); /* 93 */
    VOID *reserved94;
    VOID *reserved95;
    int (*tclRenameCommand) (Tcl_Interp *interp, CONST char *oldName, CONST char *newName); /* 96 */
    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
    int (*tclServiceIdle) (void); /* 98 */
    void (*reserved99)(void);
    void (*reserved100)(void);
    const char * (*tclSetPreInitScript) (const char *string); /* 101 */
    VOID *reserved99;
    VOID *reserved100;
    char * (*tclSetPreInitScript) (char *string); /* 101 */
    void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
    int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
    void (*reserved104)(void);
    void (*reserved105)(void);
    void (*reserved106)(void);
    void (*reserved107)(void);
    int (*tclSockGetPort) (Tcl_Interp *interp, CONST char *str, CONST char *proto, int *portPtr); /* 103 */
    int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
    VOID *reserved105;
    VOID *reserved106;
    VOID *reserved107;
    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 */
    void (*reserved112)(void);
    void (*reserved113)(void);
    void (*reserved114)(void);
    void (*reserved115)(void);
    void (*reserved116)(void);
    void (*reserved117)(void);
    int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
    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 */
    int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, CONST char *name, Tcl_ResolverInfo *resInfo); /* 118 */
    int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
    Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
    void (*reserved121)(void);
    void (*reserved122)(void);
    void (*reserved123)(void);
    void (*reserved124)(void);
    void (*reserved125)(void);
    Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, CONST char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
    int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern); /* 121 */
    Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
    void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
    Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
    Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
    void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
    void (*reserved127)(void);
    int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, CONST char *pattern, int allowOverwrite); /* 127 */
    void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
    int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
    int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
    int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, CONST char *name); /* 130 */
    void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
    int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
    void (*reserved133)(void);
    void (*reserved134)(void);
    void (*reserved135)(void);
    void (*reserved136)(void);
    void (*reserved137)(void);
    const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
    void (*reserved139)(void);
    void (*reserved140)(void);
    const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, void *clientData); /* 142 */
    struct tm * (*tclpGetDate) (CONST time_t *time, int useGMT); /* 133 */
    VOID *reserved134;
    VOID *reserved135;
    VOID *reserved136;
    VOID *reserved137;
    CONST84_RETURN char * (*tclGetEnv) (CONST char *name, Tcl_DString *valuePtr); /* 138 */
    VOID *reserved139;
    VOID *reserved140;
    CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
    int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
    int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
    void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
    const struct AuxDataType * (*tclGetAuxDataType) (const char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (void *ptr); /* 146 */
    struct AuxDataType * (*tclGetAuxDataType) (char *typeName); /* 145 */
    TclHandle (*tclHandleCreate) (VOID *ptr); /* 146 */
    void (*tclHandleFree) (TclHandle handle); /* 147 */
    TclHandle (*tclHandlePreserve) (TclHandle handle); /* 148 */
    void (*tclHandleRelease) (TclHandle handle); /* 149 */
    int (*tclRegAbout) (Tcl_Interp *interp, Tcl_RegExp re); /* 150 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, size_t index, size_t *startPtr, size_t *endPtr); /* 151 */
    void (*tclRegExpRangeUniChar) (Tcl_RegExp re, int index, int *startPtr, int *endPtr); /* 151 */
    void (*tclSetLibraryPath) (Tcl_Obj *pathPtr); /* 152 */
    Tcl_Obj * (*tclGetLibraryPath) (void); /* 153 */
    void (*reserved154)(void);
    void (*reserved155)(void);
    void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
    void (*reserved158)(void);
    void (*reserved159)(void);
    void (*reserved160)(void);
    VOID *reserved154;
    VOID *reserved155;
    void (*tclRegError) (Tcl_Interp *interp, CONST char *msg, int status); /* 156 */
    Var * (*tclVarTraceExists) (Tcl_Interp *interp, CONST char *varName); /* 157 */
    void (*tclSetStartupScriptFileName) (CONST char *filename); /* 158 */
    CONST84_RETURN char * (*tclGetStartupScriptFileName) (void); /* 159 */
    VOID *reserved160;
    int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
    void (*tclChannelEventScriptInvoker) (void *clientData, int flags); /* 162 */
    const void * (*tclGetInstructionTable) (void); /* 163 */
    void (*tclExpandCodeArray) (void *envPtr); /* 164 */
    void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
    VOID * (*tclGetInstructionTable) (void); /* 163 */
    void (*tclExpandCodeArray) (VOID *envPtr); /* 164 */
    void (*tclpSetInitialEncodings) (void); /* 165 */
    int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
    void (*reserved167)(void);
    void (*reserved168)(void);
    int (*tclpUtfNcmp2) (const char *s1, const char *s2, size_t n); /* 169 */
    int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
    int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, size_t numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
    void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
    Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
    int (*tclpUtfNcmp2) (CONST char *s1, CONST char *s2, unsigned long n); /* 169 */
    int (*tclCheckInterpTraces) (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 170 */
    int (*tclCheckExecutionTraces) (Tcl_Interp *interp, CONST char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[]); /* 171 */
    int (*tclInThreadExit) (void); /* 172 */
    int (*tclUniCharMatch) (const Tcl_UniChar *string, size_t strLen, const Tcl_UniChar *pattern, size_t ptnLen, int flags); /* 173 */
    void (*reserved174)(void);
    int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
    int (*tclUniCharMatch) (CONST Tcl_UniChar *string, int strLen, CONST Tcl_UniChar *pattern, int ptnLen, int flags); /* 173 */
    VOID *reserved174;
    int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, CONST char *part1, CONST char *part2, int flags, int leaveErrMsg); /* 175 */
    void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
    void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
    void (*reserved178)(void);
    void (*reserved179)(void);
    void (*reserved180)(void);
    void (*reserved181)(void);
    void (*reserved182)(void);
    void (*reserved183)(void);
    void (*reserved184)(void);
    void (*reserved185)(void);
    void (*reserved186)(void);
    void (*reserved187)(void);
    void (*reserved188)(void);
    void (*reserved189)(void);
    void (*reserved190)(void);
    void (*reserved191)(void);
    void (*reserved192)(void);
    void (*reserved193)(void);
    void (*reserved194)(void);
    void (*reserved195)(void);
    void (*reserved196)(void);
    void (*reserved197)(void);
    void (*tclVarErrMsg) (Tcl_Interp *interp, CONST char *part1, CONST char *part2, CONST char *operation, CONST char *reason); /* 177 */
    void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, CONST char *encodingName); /* 178 */
    Tcl_Obj * (*tcl_GetStartupScript) (CONST char **encodingNamePtr); /* 179 */
    VOID *reserved180;
    VOID *reserved181;
    struct tm * (*tclpLocaltime) (CONST time_t *clock); /* 182 */
    struct tm * (*tclpGmtime) (CONST time_t *clock); /* 183 */
    VOID *reserved184;
    VOID *reserved185;
    VOID *reserved186;
    VOID *reserved187;
    VOID *reserved188;
    VOID *reserved189;
    VOID *reserved190;
    VOID *reserved191;
    VOID *reserved192;
    VOID *reserved193;
    VOID *reserved194;
    VOID *reserved195;
    VOID *reserved196;
    VOID *reserved197;
    int (*tclObjGetFrame) (Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr); /* 198 */
    void (*reserved199)(void);
    VOID *reserved199;
    int (*tclpObjRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 200 */
    int (*tclpObjCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 201 */
    int (*tclpObjCreateDirectory) (Tcl_Obj *pathPtr); /* 202 */
    int (*tclpObjDeleteFile) (Tcl_Obj *pathPtr); /* 203 */
    int (*tclpObjCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 204 */
    int (*tclpObjRenameFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 205 */
    int (*tclpObjStat) (Tcl_Obj *pathPtr, Tcl_StatBuf *buf); /* 206 */
    int (*tclpObjAccess) (Tcl_Obj *pathPtr, int mode); /* 207 */
    Tcl_Channel (*tclpOpenFileChannel) (Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions); /* 208 */
    void (*reserved209)(void);
    void (*reserved210)(void);
    void (*reserved211)(void);
    void (*tclpFindExecutable) (const char *argv0); /* 212 */
    VOID *reserved209;
    VOID *reserved210;
    VOID *reserved211;
    void (*tclpFindExecutable) (CONST char *argv0); /* 212 */
    Tcl_Obj * (*tclGetObjNameOfExecutable) (void); /* 213 */
    void (*tclSetObjNameOfExecutable) (Tcl_Obj *name, Tcl_Encoding encoding); /* 214 */
    void * (*tclStackAlloc) (Tcl_Interp *interp, size_t numBytes); /* 215 */
    void (*tclStackFree) (Tcl_Interp *interp, void *freePtr); /* 216 */
    VOID * (*tclStackAlloc) (Tcl_Interp *interp, int numBytes); /* 215 */
    void (*tclStackFree) (Tcl_Interp *interp, VOID *freePtr); /* 216 */
    int (*tclPushStackFrame) (Tcl_Interp *interp, Tcl_CallFrame **framePtrPtr, Tcl_Namespace *namespacePtr, int isProcCallFrame); /* 217 */
    void (*tclPopStackFrame) (Tcl_Interp *interp); /* 218 */
    void (*reserved219)(void);
    void (*reserved220)(void);
    void (*reserved221)(void);
    void (*reserved222)(void);
    void (*reserved223)(void);
    VOID *reserved219;
    VOID *reserved220;
    VOID *reserved221;
    VOID *reserved222;
    VOID *reserved223;
    TclPlatformType * (*tclGetPlatform) (void); /* 224 */
    Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *const keyv[], int flags); /* 225 */
    Tcl_Obj * (*tclTraceDictPath) (Tcl_Interp *interp, Tcl_Obj *rootPtr, int keyc, Tcl_Obj *CONST keyv[], int flags); /* 225 */
    int (*tclObjBeingDeleted) (Tcl_Obj *objPtr); /* 226 */
    void (*tclSetNsPath) (Namespace *nsPtr, size_t pathLength, Tcl_Namespace *pathAry[]); /* 227 */
    void (*reserved228)(void);
    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, const char *myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, const char *part2, int flags, const char *msg, const int createPart1, const int createPart2, Var **arrayPtrPtr); /* 230 */
    void (*tclSetNsPath) (Namespace *nsPtr, int pathLength, Tcl_Namespace *pathAry[]); /* 227 */
    int (*tclObjInterpProcCore) (register Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc errorProc); /* 228 */
    int (*tclPtrMakeUpvar) (Tcl_Interp *interp, Var *otherP1Ptr, CONST char *myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, CONST char *part2, int flags, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr); /* 230 */
    int (*tclGetNamespaceFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr); /* 231 */
    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 232 */
    int (*tclEvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, CONST CmdFrame *invoker, int word); /* 232 */
    void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, CONST char *key, int *newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
    void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
    void (*reserved236)(void);
    VOID *reserved237;
    int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
    int (*tclNRInterpProc) (void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
    int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp *interp, int result, struct NRE_callback *rootPtr); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags, const CmdFrame *invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    VOID *reserved238;
    VOID *reserved239;
    VOID *reserved240;
    VOID *reserved241;
    VOID *reserved242;
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, size_t numRemoved, size_t 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 */
    VOID *reserved244;
    VOID *reserved245;
    VOID *reserved246;
    VOID *reserved247;
    VOID *reserved248;
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
    int (*tclRegisterLiteral) (void *envPtr, const char *bytes, size_t length, int flags); /* 251 */
    Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
    Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
    Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
    int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
    int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
    void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
    Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
    void (*tclAppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 259 */
    VOID *reserved250;
    int (*tclRegisterLiteral) (VOID *envPtr, char *bytes, int length, int flags); /* 251 */
    VOID *reserved252;
    VOID *reserved253;
    VOID *reserved254;
    VOID *reserved255;
    VOID *reserved256;
    void (*tclStaticPackage) (Tcl_Interp *interp, CONST char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
    VOID *reserved258;
    VOID *reserved259;
    VOID *reserved260;
    void (*tclUnusedStubEntry) (void); /* 261 */
    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, size_t *lengthPtr); /* 260 */
} TclIntStubs;

extern const TclIntStubs *tclIntStubsPtr;
extern TclIntStubs *tclIntStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
 * Inline function declarations:
 */

/* Slot 0 is reserved */
/* Slot 1 is reserved */
/* Slot 2 is reserved */
#ifndef TclAllocateFreeObjects
#define TclAllocateFreeObjects \
	(tclIntStubsPtr->tclAllocateFreeObjects) /* 3 */
#endif
/* Slot 4 is reserved */
#ifndef TclCleanupChildren
#define TclCleanupChildren \
	(tclIntStubsPtr->tclCleanupChildren) /* 5 */
#endif
#ifndef TclCleanupCommand
#define TclCleanupCommand \
	(tclIntStubsPtr->tclCleanupCommand) /* 6 */
#endif
#ifndef TclCopyAndCollapse
#define TclCopyAndCollapse \
	(tclIntStubsPtr->tclCopyAndCollapse) /* 7 */
/* Slot 8 is reserved */
#endif
#ifndef TclCopyChannel
#define TclCopyChannel \
	(tclIntStubsPtr->tclCopyChannel) /* 8 */
#endif
#ifndef TclCreatePipeline
#define TclCreatePipeline \
	(tclIntStubsPtr->tclCreatePipeline) /* 9 */
#endif
#ifndef TclCreateProc
#define TclCreateProc \
	(tclIntStubsPtr->tclCreateProc) /* 10 */
#endif
#ifndef TclDeleteCompiledLocalVars
#define TclDeleteCompiledLocalVars \
	(tclIntStubsPtr->tclDeleteCompiledLocalVars) /* 11 */
#endif
#ifndef TclDeleteVars
#define TclDeleteVars \
	(tclIntStubsPtr->tclDeleteVars) /* 12 */
#endif
/* Slot 13 is reserved */
#ifndef TclDumpMemoryInfo
#define TclDumpMemoryInfo \
	(tclIntStubsPtr->tclDumpMemoryInfo) /* 14 */
#endif
/* Slot 15 is reserved */
#ifndef TclExprFloatError
#define TclExprFloatError \
	(tclIntStubsPtr->tclExprFloatError) /* 16 */
#endif
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#ifndef TclFindElement
#define TclFindElement \
	(tclIntStubsPtr->tclFindElement) /* 22 */
#endif
#ifndef TclFindProc
#define TclFindProc \
	(tclIntStubsPtr->tclFindProc) /* 23 */
#endif
#ifndef TclFormatInt
#define TclFormatInt \
	(tclIntStubsPtr->tclFormatInt) /* 24 */
#endif
#ifndef TclFreePackageInfo
#define TclFreePackageInfo \
	(tclIntStubsPtr->tclFreePackageInfo) /* 25 */
#endif
/* Slot 26 is reserved */
/* Slot 27 is reserved */
#ifndef TclpGetDefaultStdChannel
#define TclpGetDefaultStdChannel \
	(tclIntStubsPtr->tclpGetDefaultStdChannel) /* 28 */
#endif
/* Slot 29 is reserved */
/* Slot 30 is reserved */
#ifndef TclGetExtension
#define TclGetExtension \
	(tclIntStubsPtr->tclGetExtension) /* 31 */
#endif
#ifndef TclGetFrame
#define TclGetFrame \
	(tclIntStubsPtr->tclGetFrame) /* 32 */
#endif
/* Slot 33 is reserved */
/* Slot 34 is reserved */
#ifndef TclGetIntForIndex
#define TclGetIntForIndex \
	(tclIntStubsPtr->tclGetIntForIndex) /* 34 */
#endif
/* Slot 35 is reserved */
#ifndef TclGetLong
#define TclGetLong \
/* Slot 36 is reserved */
	(tclIntStubsPtr->tclGetLong) /* 36 */
#endif
#ifndef TclGetLoadedPackages
#define TclGetLoadedPackages \
	(tclIntStubsPtr->tclGetLoadedPackages) /* 37 */
#endif
#ifndef TclGetNamespaceForQualName
#define TclGetNamespaceForQualName \
	(tclIntStubsPtr->tclGetNamespaceForQualName) /* 38 */
#endif
#ifndef TclGetObjInterpProc
#define TclGetObjInterpProc \
	(tclIntStubsPtr->tclGetObjInterpProc) /* 39 */
#endif
#ifndef TclGetOpenMode
#define TclGetOpenMode \
	(tclIntStubsPtr->tclGetOpenMode) /* 40 */
#endif
#ifndef TclGetOriginalCommand
#define TclGetOriginalCommand \
	(tclIntStubsPtr->tclGetOriginalCommand) /* 41 */
#endif
#ifndef TclpGetUserHome
#define TclpGetUserHome \
	(tclIntStubsPtr->tclpGetUserHome) /* 42 */
#endif
/* Slot 43 is reserved */
#ifndef TclGuessPackageName
#define TclGuessPackageName \
	(tclIntStubsPtr->tclGuessPackageName) /* 44 */
#endif
#ifndef TclHideUnsafeCommands
#define TclHideUnsafeCommands \
	(tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */
#endif
#ifndef TclInExit
#define TclInExit \
	(tclIntStubsPtr->tclInExit) /* 46 */
#endif
/* Slot 47 is reserved */
/* Slot 48 is reserved */
/* Slot 49 is reserved */
/* Slot 50 is reserved */
#ifndef TclInitCompiledLocals
#define TclInitCompiledLocals \
	(tclIntStubsPtr->tclInitCompiledLocals) /* 50 */
#endif
#ifndef TclInterpInit
#define TclInterpInit \
	(tclIntStubsPtr->tclInterpInit) /* 51 */
#endif
/* Slot 52 is reserved */
#ifndef TclInvokeObjectCommand
#define TclInvokeObjectCommand \
	(tclIntStubsPtr->tclInvokeObjectCommand) /* 53 */
#endif
#ifndef TclInvokeStringCommand
#define TclInvokeStringCommand \
	(tclIntStubsPtr->tclInvokeStringCommand) /* 54 */
#endif
#ifndef TclIsProc
#define TclIsProc \
	(tclIntStubsPtr->tclIsProc) /* 55 */
#endif
/* Slot 56 is reserved */
/* Slot 57 is reserved */
#ifndef TclLookupVar
#define TclLookupVar \
	(tclIntStubsPtr->tclLookupVar) /* 58 */
#endif
/* Slot 59 is reserved */
#ifndef TclNeedSpace
#define TclNeedSpace \
	(tclIntStubsPtr->tclNeedSpace) /* 60 */
#endif
#ifndef TclNewProcBodyObj
#define TclNewProcBodyObj \
	(tclIntStubsPtr->tclNewProcBodyObj) /* 61 */
#endif
#ifndef TclObjCommandComplete
#define TclObjCommandComplete \
	(tclIntStubsPtr->tclObjCommandComplete) /* 62 */
#endif
#ifndef TclObjInterpProc
#define TclObjInterpProc \
	(tclIntStubsPtr->tclObjInterpProc) /* 63 */
#endif
#ifndef TclObjInvoke
#define TclObjInvoke \
	(tclIntStubsPtr->tclObjInvoke) /* 64 */
#endif
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
/* Slot 68 is reserved */
#ifndef TclpAlloc
#define TclpAlloc \
	(tclIntStubsPtr->tclpAlloc) /* 69 */
#endif
/* Slot 70 is reserved */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
#ifndef TclpFree
#define TclpFree \
	(tclIntStubsPtr->tclpFree) /* 74 */
#endif
#ifndef TclpGetClicks
#define TclpGetClicks \
	(tclIntStubsPtr->tclpGetClicks) /* 75 */
#endif
#ifndef TclpGetSeconds
#define TclpGetSeconds \
	(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#endif
#ifndef TclpGetTime
#define TclpGetTime \
/* Slot 77 is reserved */
	(tclIntStubsPtr->tclpGetTime) /* 77 */
/* Slot 78 is reserved */
#endif
#ifndef TclpGetTimeZone
#define TclpGetTimeZone \
	(tclIntStubsPtr->tclpGetTimeZone) /* 78 */
#endif
/* Slot 79 is reserved */
/* Slot 80 is reserved */
#ifndef TclpRealloc
#define TclpRealloc \
	(tclIntStubsPtr->tclpRealloc) /* 81 */
#endif
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
/* Slot 85 is reserved */
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* Slot 88 is reserved */
#ifndef TclPrecTraceProc
#define TclPrecTraceProc \
	(tclIntStubsPtr->tclPrecTraceProc) /* 88 */
#endif
#ifndef TclPreventAliasLoop
#define TclPreventAliasLoop \
	(tclIntStubsPtr->tclPreventAliasLoop) /* 89 */
#endif
/* Slot 90 is reserved */
#ifndef TclProcCleanupProc
#define TclProcCleanupProc \
	(tclIntStubsPtr->tclProcCleanupProc) /* 91 */
#endif
#ifndef TclProcCompileProc
#define TclProcCompileProc \
	(tclIntStubsPtr->tclProcCompileProc) /* 92 */
#endif
#ifndef TclProcDeleteProc
#define TclProcDeleteProc \
	(tclIntStubsPtr->tclProcDeleteProc) /* 93 */
#endif
/* Slot 94 is reserved */
/* Slot 95 is reserved */
#ifndef TclRenameCommand
#define TclRenameCommand \
	(tclIntStubsPtr->tclRenameCommand) /* 96 */
#endif
#ifndef TclResetShadowedCmdRefs
#define TclResetShadowedCmdRefs \
	(tclIntStubsPtr->tclResetShadowedCmdRefs) /* 97 */
#endif
#ifndef TclServiceIdle
#define TclServiceIdle \
	(tclIntStubsPtr->tclServiceIdle) /* 98 */
#endif
/* Slot 99 is reserved */
/* Slot 100 is reserved */
#ifndef TclSetPreInitScript
#define TclSetPreInitScript \
	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
#endif
#ifndef TclSetupEnv
#define TclSetupEnv \
	(tclIntStubsPtr->tclSetupEnv) /* 102 */
#endif
#ifndef TclSockGetPort
#define TclSockGetPort \
	(tclIntStubsPtr->tclSockGetPort) /* 103 */
#endif
#ifndef TclSockMinimumBuffersOld
#define TclSockMinimumBuffersOld \
/* Slot 104 is reserved */
	(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
#endif
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
#ifndef TclTeardownNamespace
#define TclTeardownNamespace \
	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#endif
#ifndef TclUpdateReturnInfo
#define TclUpdateReturnInfo \
	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
#endif
#ifndef TclSockMinimumBuffers
#define TclSockMinimumBuffers \
	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#endif
#ifndef Tcl_AddInterpResolvers
#define Tcl_AddInterpResolvers \
	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#endif
#ifndef Tcl_AppendExportList
#define Tcl_AppendExportList \
/* Slot 112 is reserved */
/* Slot 113 is reserved */
/* Slot 114 is reserved */
/* Slot 115 is reserved */
/* Slot 116 is reserved */
/* Slot 117 is reserved */
	(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
#endif
#ifndef Tcl_CreateNamespace
#define Tcl_CreateNamespace \
	(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
#endif
#ifndef Tcl_DeleteNamespace
#define Tcl_DeleteNamespace \
	(tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
#endif
#ifndef Tcl_Export
#define Tcl_Export \
	(tclIntStubsPtr->tcl_Export) /* 115 */
#endif
#ifndef Tcl_FindCommand
#define Tcl_FindCommand \
	(tclIntStubsPtr->tcl_FindCommand) /* 116 */
#endif
#ifndef Tcl_FindNamespace
#define Tcl_FindNamespace \
	(tclIntStubsPtr->tcl_FindNamespace) /* 117 */
#endif
#ifndef Tcl_GetInterpResolvers
#define Tcl_GetInterpResolvers \
	(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#endif
#ifndef Tcl_GetNamespaceResolvers
#define Tcl_GetNamespaceResolvers \
	(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#endif
#ifndef Tcl_FindNamespaceVar
#define Tcl_FindNamespaceVar \
	(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
#endif
#ifndef Tcl_ForgetImport
#define Tcl_ForgetImport \
/* Slot 121 is reserved */
/* Slot 122 is reserved */
/* Slot 123 is reserved */
/* Slot 124 is reserved */
/* Slot 125 is reserved */
	(tclIntStubsPtr->tcl_ForgetImport) /* 121 */
#endif
#ifndef Tcl_GetCommandFromObj
#define Tcl_GetCommandFromObj \
	(tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
#endif
#ifndef Tcl_GetCommandFullName
#define Tcl_GetCommandFullName \
	(tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
#endif
#ifndef Tcl_GetCurrentNamespace
#define Tcl_GetCurrentNamespace \
	(tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
#endif
#ifndef Tcl_GetGlobalNamespace
#define Tcl_GetGlobalNamespace \
	(tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
#endif
#ifndef Tcl_GetVariableFullName
#define Tcl_GetVariableFullName \
	(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
#endif
#ifndef Tcl_Import
#define Tcl_Import \
/* Slot 127 is reserved */
	(tclIntStubsPtr->tcl_Import) /* 127 */
#endif
#ifndef Tcl_PopCallFrame
#define Tcl_PopCallFrame \
	(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#endif
#ifndef Tcl_PushCallFrame
#define Tcl_PushCallFrame \
	(tclIntStubsPtr->tcl_PushCallFrame) /* 129 */
#endif
#ifndef Tcl_RemoveInterpResolvers
#define Tcl_RemoveInterpResolvers \
	(tclIntStubsPtr->tcl_RemoveInterpResolvers) /* 130 */
#endif
#ifndef Tcl_SetNamespaceResolvers
#define Tcl_SetNamespaceResolvers \
	(tclIntStubsPtr->tcl_SetNamespaceResolvers) /* 131 */
#endif
#ifndef TclpHasSockets
#define TclpHasSockets \
	(tclIntStubsPtr->tclpHasSockets) /* 132 */
#endif
#ifndef TclpGetDate
#define TclpGetDate \
/* Slot 133 is reserved */
	(tclIntStubsPtr->tclpGetDate) /* 133 */
#endif
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
#ifndef TclGetEnv
#define TclGetEnv \
	(tclIntStubsPtr->tclGetEnv) /* 138 */
#endif
/* Slot 139 is reserved */
/* Slot 140 is reserved */
#ifndef TclpGetCwd
#define TclpGetCwd \
	(tclIntStubsPtr->tclpGetCwd) /* 141 */
#endif
#ifndef TclSetByteCodeFromAny
#define TclSetByteCodeFromAny \
	(tclIntStubsPtr->tclSetByteCodeFromAny) /* 142 */
#endif
#ifndef TclAddLiteralObj
#define TclAddLiteralObj \
	(tclIntStubsPtr->tclAddLiteralObj) /* 143 */
#endif
#ifndef TclHideLiteral
#define TclHideLiteral \
	(tclIntStubsPtr->tclHideLiteral) /* 144 */
#endif
#ifndef TclGetAuxDataType
#define TclGetAuxDataType \
	(tclIntStubsPtr->tclGetAuxDataType) /* 145 */
#endif
#ifndef TclHandleCreate
#define TclHandleCreate \
	(tclIntStubsPtr->tclHandleCreate) /* 146 */
#endif
#ifndef TclHandleFree
#define TclHandleFree \
	(tclIntStubsPtr->tclHandleFree) /* 147 */
#endif
#ifndef TclHandlePreserve
#define TclHandlePreserve \
	(tclIntStubsPtr->tclHandlePreserve) /* 148 */
#endif
#ifndef TclHandleRelease
#define TclHandleRelease \
	(tclIntStubsPtr->tclHandleRelease) /* 149 */
#endif
#ifndef TclRegAbout
#define TclRegAbout \
	(tclIntStubsPtr->tclRegAbout) /* 150 */
#endif
#ifndef TclRegExpRangeUniChar
#define TclRegExpRangeUniChar \
	(tclIntStubsPtr->tclRegExpRangeUniChar) /* 151 */
#endif
#ifndef TclSetLibraryPath
#define TclSetLibraryPath \
	(tclIntStubsPtr->tclSetLibraryPath) /* 152 */
#endif
#ifndef TclGetLibraryPath
#define TclGetLibraryPath \
	(tclIntStubsPtr->tclGetLibraryPath) /* 153 */
#endif
/* Slot 154 is reserved */
/* Slot 155 is reserved */
#ifndef TclRegError
#define TclRegError \
	(tclIntStubsPtr->tclRegError) /* 156 */
#endif
#ifndef TclVarTraceExists
#define TclVarTraceExists \
	(tclIntStubsPtr->tclVarTraceExists) /* 157 */
#endif
#ifndef TclSetStartupScriptFileName
#define TclSetStartupScriptFileName \
/* Slot 158 is reserved */
/* Slot 159 is reserved */
	(tclIntStubsPtr->tclSetStartupScriptFileName) /* 158 */
#endif
#ifndef TclGetStartupScriptFileName
#define TclGetStartupScriptFileName \
	(tclIntStubsPtr->tclGetStartupScriptFileName) /* 159 */
#endif
/* Slot 160 is reserved */
#ifndef TclChannelTransform
#define TclChannelTransform \
	(tclIntStubsPtr->tclChannelTransform) /* 161 */
#endif
#ifndef TclChannelEventScriptInvoker
#define TclChannelEventScriptInvoker \
	(tclIntStubsPtr->tclChannelEventScriptInvoker) /* 162 */
#endif
#ifndef TclGetInstructionTable
#define TclGetInstructionTable \
	(tclIntStubsPtr->tclGetInstructionTable) /* 163 */
#endif
#ifndef TclExpandCodeArray
#define TclExpandCodeArray \
	(tclIntStubsPtr->tclExpandCodeArray) /* 164 */
#endif
#ifndef TclpSetInitialEncodings
#define TclpSetInitialEncodings \
	(tclIntStubsPtr->tclpSetInitialEncodings) /* 165 */
#endif
#ifndef TclListObjSetElement
#define TclListObjSetElement \
	(tclIntStubsPtr->tclListObjSetElement) /* 166 */
#endif
#ifndef TclSetStartupScriptPath
#define TclSetStartupScriptPath \
/* Slot 167 is reserved */
/* Slot 168 is reserved */
	(tclIntStubsPtr->tclSetStartupScriptPath) /* 167 */
#endif
#ifndef TclGetStartupScriptPath
#define TclGetStartupScriptPath \
	(tclIntStubsPtr->tclGetStartupScriptPath) /* 168 */
#endif
#ifndef TclpUtfNcmp2
#define TclpUtfNcmp2 \
	(tclIntStubsPtr->tclpUtfNcmp2) /* 169 */
#endif
#ifndef TclCheckInterpTraces
#define TclCheckInterpTraces \
	(tclIntStubsPtr->tclCheckInterpTraces) /* 170 */
#endif
#ifndef TclCheckExecutionTraces
#define TclCheckExecutionTraces \
	(tclIntStubsPtr->tclCheckExecutionTraces) /* 171 */
#endif
#ifndef TclInThreadExit
#define TclInThreadExit \
	(tclIntStubsPtr->tclInThreadExit) /* 172 */
#endif
#ifndef TclUniCharMatch
#define TclUniCharMatch \
	(tclIntStubsPtr->tclUniCharMatch) /* 173 */
#endif
/* Slot 174 is reserved */
#ifndef TclCallVarTraces
#define TclCallVarTraces \
	(tclIntStubsPtr->tclCallVarTraces) /* 175 */
#endif
#ifndef TclCleanupVar
#define TclCleanupVar \
	(tclIntStubsPtr->tclCleanupVar) /* 176 */
#endif
#ifndef TclVarErrMsg
#define TclVarErrMsg \
	(tclIntStubsPtr->tclVarErrMsg) /* 177 */
#endif
#ifndef Tcl_SetStartupScript
#define Tcl_SetStartupScript \
/* Slot 178 is reserved */
/* Slot 179 is reserved */
	(tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
#endif
#ifndef Tcl_GetStartupScript
#define Tcl_GetStartupScript \
	(tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
#endif
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#ifndef TclpLocaltime
#define TclpLocaltime \
/* Slot 182 is reserved */
/* Slot 183 is reserved */
	(tclIntStubsPtr->tclpLocaltime) /* 182 */
#endif
#ifndef TclpGmtime
#define TclpGmtime \
	(tclIntStubsPtr->tclpGmtime) /* 183 */
#endif
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
/* Slot 187 is reserved */
/* Slot 188 is reserved */
/* Slot 189 is reserved */
/* Slot 190 is reserved */
/* Slot 191 is reserved */
/* Slot 192 is reserved */
/* Slot 193 is reserved */
/* Slot 194 is reserved */
/* Slot 195 is reserved */
/* Slot 196 is reserved */
/* Slot 197 is reserved */
#ifndef TclObjGetFrame
#define TclObjGetFrame \
	(tclIntStubsPtr->tclObjGetFrame) /* 198 */
#endif
/* Slot 199 is reserved */
#ifndef TclpObjRemoveDirectory
#define TclpObjRemoveDirectory \
	(tclIntStubsPtr->tclpObjRemoveDirectory) /* 200 */
#endif
#ifndef TclpObjCopyDirectory
#define TclpObjCopyDirectory \
	(tclIntStubsPtr->tclpObjCopyDirectory) /* 201 */
#endif
#ifndef TclpObjCreateDirectory
#define TclpObjCreateDirectory \
	(tclIntStubsPtr->tclpObjCreateDirectory) /* 202 */
#endif
#ifndef TclpObjDeleteFile
#define TclpObjDeleteFile \
	(tclIntStubsPtr->tclpObjDeleteFile) /* 203 */
#endif
#ifndef TclpObjCopyFile
#define TclpObjCopyFile \
	(tclIntStubsPtr->tclpObjCopyFile) /* 204 */
#endif
#ifndef TclpObjRenameFile
#define TclpObjRenameFile \
	(tclIntStubsPtr->tclpObjRenameFile) /* 205 */
#endif
#ifndef TclpObjStat
#define TclpObjStat \
	(tclIntStubsPtr->tclpObjStat) /* 206 */
#endif
#ifndef TclpObjAccess
#define TclpObjAccess \
	(tclIntStubsPtr->tclpObjAccess) /* 207 */
#endif
#ifndef TclpOpenFileChannel
#define TclpOpenFileChannel \
	(tclIntStubsPtr->tclpOpenFileChannel) /* 208 */
#endif
/* Slot 209 is reserved */
/* Slot 210 is reserved */
/* Slot 211 is reserved */
#ifndef TclpFindExecutable
#define TclpFindExecutable \
	(tclIntStubsPtr->tclpFindExecutable) /* 212 */
#endif
#ifndef TclGetObjNameOfExecutable
#define TclGetObjNameOfExecutable \
	(tclIntStubsPtr->tclGetObjNameOfExecutable) /* 213 */
#endif
#ifndef TclSetObjNameOfExecutable
#define TclSetObjNameOfExecutable \
	(tclIntStubsPtr->tclSetObjNameOfExecutable) /* 214 */
#endif
#ifndef TclStackAlloc
#define TclStackAlloc \
	(tclIntStubsPtr->tclStackAlloc) /* 215 */
#endif
#ifndef TclStackFree
#define TclStackFree \
	(tclIntStubsPtr->tclStackFree) /* 216 */
#endif
#ifndef TclPushStackFrame
#define TclPushStackFrame \
	(tclIntStubsPtr->tclPushStackFrame) /* 217 */
#endif
#ifndef TclPopStackFrame
#define TclPopStackFrame \
	(tclIntStubsPtr->tclPopStackFrame) /* 218 */
#endif
/* Slot 219 is reserved */
/* Slot 220 is reserved */
/* Slot 221 is reserved */
/* Slot 222 is reserved */
/* Slot 223 is reserved */
#ifndef TclGetPlatform
#define TclGetPlatform \
	(tclIntStubsPtr->tclGetPlatform) /* 224 */
#endif
#ifndef TclTraceDictPath
#define TclTraceDictPath \
	(tclIntStubsPtr->tclTraceDictPath) /* 225 */
#endif
#ifndef TclObjBeingDeleted
#define TclObjBeingDeleted \
	(tclIntStubsPtr->tclObjBeingDeleted) /* 226 */
#endif
#ifndef TclSetNsPath
#define TclSetNsPath \
	(tclIntStubsPtr->tclSetNsPath) /* 227 */
#endif
#ifndef TclObjInterpProcCore
#define TclObjInterpProcCore \
/* Slot 228 is reserved */
	(tclIntStubsPtr->tclObjInterpProcCore) /* 228 */
#endif
#ifndef TclPtrMakeUpvar
#define TclPtrMakeUpvar \
	(tclIntStubsPtr->tclPtrMakeUpvar) /* 229 */
#endif
#ifndef TclObjLookupVar
#define TclObjLookupVar \
	(tclIntStubsPtr->tclObjLookupVar) /* 230 */
#endif
#ifndef TclGetNamespaceFromObj
#define TclGetNamespaceFromObj \
	(tclIntStubsPtr->tclGetNamespaceFromObj) /* 231 */
#endif
#ifndef TclEvalObjEx
#define TclEvalObjEx \
	(tclIntStubsPtr->tclEvalObjEx) /* 232 */
#endif
#ifndef TclGetSrcInfoForPc
#define TclGetSrcInfoForPc \
	(tclIntStubsPtr->tclGetSrcInfoForPc) /* 233 */
#endif
#ifndef TclVarHashCreateVar
#define TclVarHashCreateVar \
	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#endif
#ifndef TclInitVarHashTable
#define TclInitVarHashTable \
	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
/* Slot 236 is reserved */
#define TclResetCancellation \
#endif
#ifndef TclBackgroundException
	(tclIntStubsPtr->tclResetCancellation) /* 237 */
#define TclNRInterpProc \
	(tclIntStubsPtr->tclNRInterpProc) /* 238 */
#define TclNRInterpProcCore \
	(tclIntStubsPtr->tclNRInterpProcCore) /* 239 */
#define TclNRRunCallbacks \
	(tclIntStubsPtr->tclNRRunCallbacks) /* 240 */
#define TclNREvalObjEx \
	(tclIntStubsPtr->tclNREvalObjEx) /* 241 */
#define TclNREvalObjv \
#define TclBackgroundException \
	(tclIntStubsPtr->tclBackgroundException) /* 236 */
#endif
/* Slot 237 is reserved */
/* Slot 238 is reserved */
/* Slot 239 is reserved */
/* Slot 240 is reserved */
/* Slot 241 is reserved */
/* Slot 242 is reserved */
#ifndef TclDbDumpActiveObjects
	(tclIntStubsPtr->tclNREvalObjv) /* 242 */
#define TclDbDumpActiveObjects \
	(tclIntStubsPtr->tclDbDumpActiveObjects) /* 243 */
#define TclGetNamespaceChildTable \
	(tclIntStubsPtr->tclGetNamespaceChildTable) /* 244 */
#define TclGetNamespaceCommandTable \
	(tclIntStubsPtr->tclGetNamespaceCommandTable) /* 245 */
#endif
/* Slot 244 is reserved */
/* Slot 245 is reserved */
#define TclInitRewriteEnsemble \
	(tclIntStubsPtr->tclInitRewriteEnsemble) /* 246 */
#define TclResetRewriteEnsemble \
/* Slot 246 is reserved */
/* Slot 247 is reserved */
	(tclIntStubsPtr->tclResetRewriteEnsemble) /* 247 */
#define TclCopyChannel \
/* Slot 248 is reserved */
#ifndef TclDoubleDigits
	(tclIntStubsPtr->tclCopyChannel) /* 248 */
#define TclDoubleDigits \
	(tclIntStubsPtr->tclDoubleDigits) /* 249 */
#endif
/* Slot 250 is reserved */
#define TclSetChildCancelFlags \
#ifndef TclRegisterLiteral
	(tclIntStubsPtr->tclSetChildCancelFlags) /* 250 */
#define TclRegisterLiteral \
	(tclIntStubsPtr->tclRegisterLiteral) /* 251 */
#define TclPtrGetVar \
	(tclIntStubsPtr->tclPtrGetVar) /* 252 */
#endif
/* Slot 252 is reserved */
#define TclPtrSetVar \
	(tclIntStubsPtr->tclPtrSetVar) /* 253 */
/* Slot 253 is reserved */
#define TclPtrIncrObjVar \
	(tclIntStubsPtr->tclPtrIncrObjVar) /* 254 */
/* Slot 254 is reserved */
#define TclPtrObjMakeUpvar \
	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
/* Slot 255 is reserved */
/* Slot 256 is reserved */
#ifndef TclStaticPackage
	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
#define TclStaticPackage \
	(tclIntStubsPtr->tclStaticPackage) /* 257 */
#define TclpCreateTemporaryDirectory \
	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
#define TclAppendUnicodeToObj \
	(tclIntStubsPtr->tclAppendUnicodeToObj) /* 259 */
#define TclGetBytesFromObj \
	(tclIntStubsPtr->tclGetBytesFromObj) /* 260 */
#endif
/* Slot 258 is reserved */
/* Slot 259 is reserved */
/* Slot 260 is reserved */
#ifndef TclUnusedStubEntry
#define TclUnusedStubEntry \
	(tclIntStubsPtr->tclUnusedStubEntry) /* 261 */
#endif

#endif /* defined(USE_TCL_STUBS) */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#if defined(USE_TCL_STUBS)
#undef Tcl_StaticPackage
#define Tcl_StaticPackage \
#if !defined(_WIN64)
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#   undef TclSockMinimumBuffers
#   define TclSockMinimumBuffers(a,b) TclSockMinimumBuffersOld(PTR2INT(a),b)
	(tclIntStubsPtr->tclStaticPackage)
#endif /* defined(USE_TCL_STUBS) */
#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
#   undef Tcl_CreateNamespace
#   define Tcl_CreateNamespace \
	   (tclStubsPtr->tcl_CreateNamespace) /* 506 */
#   undef Tcl_DeleteNamespace
#   define Tcl_DeleteNamespace \
	   (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
#   undef Tcl_AppendExportList
#   define Tcl_AppendExportList \
	   (tclStubsPtr->tcl_AppendExportList) /* 508 */
#   undef Tcl_Export
#   define Tcl_Export \
	   (tclStubsPtr->tcl_Export) /* 509 */
#   undef Tcl_Import
#   define Tcl_Import \
	   (tclStubsPtr->tcl_Import) /* 510 */
#   undef Tcl_ForgetImport
#   define Tcl_ForgetImport \
	   (tclStubsPtr->tcl_ForgetImport) /* 511 */
#   undef Tcl_GetCurrentNamespace
#   define Tcl_GetCurrentNamespace \
	   (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
#   undef Tcl_GetGlobalNamespace
#   define Tcl_GetGlobalNamespace \
	   (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
#   undef Tcl_FindNamespace
#   define Tcl_FindNamespace \
	   (tclStubsPtr->tcl_FindNamespace) /* 514 */
#   undef Tcl_FindCommand
#   define Tcl_FindCommand \
	   (tclStubsPtr->tcl_FindCommand) /* 515 */
#   undef Tcl_GetCommandFromObj
#   define Tcl_GetCommandFromObj \
	   (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
#   undef Tcl_GetCommandFullName
#   define Tcl_GetCommandFullName \
	   (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
#endif

#endif /* _TCLINTDECLS */

Changes to generic/tclIntPlatDecls.h.

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
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
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
524

525
526
527
528
529
530


531
532
533


534
535
536
537
538
539





540
541
542



543
544

545
546
547
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
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
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
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
611


612
613
614
615
616
617
618
619
620
621

622

623

624
625
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
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
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







-
+
+
+



+
+
+


+
+
+




+
+
+


+
+
+


-
+


+
-
-
+
+
+


+
+
+

-
+
+
+
+


+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
+
-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
+
-
-
+


-
+
-






+
+

-
+
-
-
-
+
-

-
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+


+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+
+
+


+
+
+




+
+
+


+
+
+


-
+


+
+
+


+
+
+

-
-
+
+

+
+
+


+
+
+

-
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+


+

+
+
-
+
+
+
+
+


+
+
+
-
+
+
+
+
+

-
+
-
-
-
-
+


+
+



+
+
+


+
+
+




+
+
+


+
+
+


-
+


+
-
-
+
+
+


+
+
+

-
+
+
+
+


+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

+
+
+




+
+
+




+
+
+

-
-
-
+
+
+
+
+
+


-
+


+
+
+


-
+
+


-
+
-






+
+

-
+
-
-
-
+
-




-
+

-
+




-
-
+
+

-
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-

-
-
-
-
+
+
+
+
+
-
-
+

-
-
-
-
-
+
+
+
+
+




-
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+
-






-
-
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-



-
+





-
+





-
+
+


+
+


+
+


+
+


+
+


+
+
-
+
-


+
+


+
+


+
+


-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+






+


-
+
-

-
+
+


+
+
+
+
+
-
-
+
+
-
+
+
+
+
+
+
+


+
+


-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
+
+
+
+
+
+


-
+
+
+
+
+
+


+

-
+
+
+
+
+


+
-
-
-
-
-
+
+
+
+
+
+
+
+


+


+
+


+
+


+
+


+
+


+
+
-
+
-


+
+


+
+


+
+


-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+


-
+
-






+


-
+
-


-
+





-
+
+

-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+

-
+



extern "C" {
#endif

/*
 * Exported function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef TclGetAndDetachPids_TCL_DECLARED
#define TclGetAndDetachPids_TCL_DECLARED
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
#endif
#ifndef TclpCloseFile_TCL_DECLARED
#define TclpCloseFile_TCL_DECLARED
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
#endif
#ifndef TclpCreateCommandChannel_TCL_DECLARED
#define TclpCreateCommandChannel_TCL_DECLARED
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
#endif
#ifndef TclpCreatePipe_TCL_DECLARED
#define TclpCreatePipe_TCL_DECLARED
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
#endif
#ifndef TclpCreateProcess_TCL_DECLARED
#define TclpCreateProcess_TCL_DECLARED
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				CONST char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
#endif
/* 5 */
EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
/* Slot 5 is reserved */
#ifndef TclpMakeFile_TCL_DECLARED
#define TclpMakeFile_TCL_DECLARED
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
#endif
#ifndef TclpOpenFile_TCL_DECLARED
#define TclpOpenFile_TCL_DECLARED
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
#endif
#ifndef TclUnixWaitForFile_TCL_DECLARED
#define TclUnixWaitForFile_TCL_DECLARED
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
#endif
#ifndef TclpCreateTempFile_TCL_DECLARED
#define TclpCreateTempFile_TCL_DECLARED
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
#endif
#ifndef TclpReaddir_TCL_DECLARED
#define TclpReaddir_TCL_DECLARED
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
#endif
#ifndef TclpLocaltime_unix_TCL_DECLARED
#define TclpLocaltime_unix_TCL_DECLARED
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(CONST time_t *clock);
#endif
#ifndef TclpGmtime_unix_TCL_DECLARED
#define TclpGmtime_unix_TCL_DECLARED
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(CONST time_t *clock);
#endif
#ifndef TclpInetNtoa_TCL_DECLARED
#define TclpInetNtoa_TCL_DECLARED
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
#endif
#ifndef TclUnixCopyFile_TCL_DECLARED
#define TclUnixCopyFile_TCL_DECLARED
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
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,
#endif
				Tcl_Obj **attributePtrPtr);
/* 16 */
/* Slot 15 is reserved */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
/* 17 */
/* Slot 16 is reserved */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);
/* 18 */
/* Slot 17 is reserved */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
/* Slot 18 is reserved */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
/* Slot 22 is reserved */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#ifndef TclWinCPUID_TCL_DECLARED
#define TclWinCPUID_TCL_DECLARED
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
#endif
				Tcl_Obj *resultingNameObj);
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#ifndef TclWinConvertError_TCL_DECLARED
#define TclWinConvertError_TCL_DECLARED
/* 0 */
EXTERN void		TclWinConvertError(int errCode);
/* Slot 1 is reserved */
/* Slot 2 is reserved */
/* Slot 3 is reserved */
EXTERN void		TclWinConvertError(DWORD errCode);
#endif
#ifndef TclWinConvertWSAError_TCL_DECLARED
#define TclWinConvertWSAError_TCL_DECLARED
/* 1 */
EXTERN void		TclWinConvertWSAError(DWORD errCode);
#endif
#ifndef TclWinGetServByName_TCL_DECLARED
#define TclWinGetServByName_TCL_DECLARED
/* 2 */
EXTERN struct servent *	 TclWinGetServByName(CONST char *nm,
				CONST char *proto);
#endif
#ifndef TclWinGetSockOpt_TCL_DECLARED
#define TclWinGetSockOpt_TCL_DECLARED
/* 3 */
EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
				char *optval, int *optlen);
#endif
#ifndef TclWinGetTclInstance_TCL_DECLARED
#define TclWinGetTclInstance_TCL_DECLARED
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);
EXTERN HINSTANCE	TclWinGetTclInstance(void);
#endif
#ifndef TclUnixWaitForFile_TCL_DECLARED
#define TclUnixWaitForFile_TCL_DECLARED
/* 5 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
#endif
#ifndef TclWinNToHS_TCL_DECLARED
#define TclWinNToHS_TCL_DECLARED
/* Slot 6 is reserved */
/* Slot 7 is reserved */
/* 6 */
EXTERN unsigned short	TclWinNToHS(unsigned short ns);
#endif
#ifndef TclWinSetSockOpt_TCL_DECLARED
#define TclWinSetSockOpt_TCL_DECLARED
/* 7 */
EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				CONST char *optval, int optlen);
#endif
#ifndef TclpGetPid_TCL_DECLARED
#define TclpGetPid_TCL_DECLARED
/* 8 */
EXTERN size_t		TclpGetPid(Tcl_Pid pid);
/* Slot 9 is reserved */
/* Slot 10 is reserved */
EXTERN int		TclpGetPid(Tcl_Pid pid);
#endif
#ifndef TclWinGetPlatformId_TCL_DECLARED
#define TclWinGetPlatformId_TCL_DECLARED
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
#endif
#ifndef TclpReaddir_TCL_DECLARED
#define TclpReaddir_TCL_DECLARED
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
#endif
#ifndef TclGetAndDetachPids_TCL_DECLARED
#define TclGetAndDetachPids_TCL_DECLARED
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
#endif
#ifndef TclpCloseFile_TCL_DECLARED
#define TclpCloseFile_TCL_DECLARED
/* 12 */
EXTERN int		TclpCloseFile(TclFile file);
#endif
#ifndef TclpCreateCommandChannel_TCL_DECLARED
#define TclpCreateCommandChannel_TCL_DECLARED
/* 13 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
#endif
#ifndef TclpCreatePipe_TCL_DECLARED
#define TclpCreatePipe_TCL_DECLARED
/* 14 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
#endif
#ifndef TclpCreateProcess_TCL_DECLARED
#define TclpCreateProcess_TCL_DECLARED
/* 15 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				CONST char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
#endif
#ifndef TclpIsAtty_TCL_DECLARED
#define TclpIsAtty_TCL_DECLARED
/* 16 */
EXTERN int		TclpIsAtty(int fd);
#endif
#ifndef TclUnixCopyFile_TCL_DECLARED
#define TclUnixCopyFile_TCL_DECLARED
/* 17 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
				CONST Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
#endif
#ifndef TclpMakeFile_TCL_DECLARED
#define TclpMakeFile_TCL_DECLARED
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
#endif
#ifndef TclpOpenFile_TCL_DECLARED
#define TclpOpenFile_TCL_DECLARED
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
#endif
#ifndef TclWinAddProcess_TCL_DECLARED
#define TclWinAddProcess_TCL_DECLARED
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, size_t id);
/* Slot 21 is reserved */
EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
#endif
#ifndef TclpInetNtoa_TCL_DECLARED
#define TclpInetNtoa_TCL_DECLARED
/* 21 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
#endif
#ifndef TclpCreateTempFile_TCL_DECLARED
#define TclpCreateTempFile_TCL_DECLARED
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
#endif
#ifndef TclpGetTZName_TCL_DECLARED
#define TclpGetTZName_TCL_DECLARED
/* 23 */
EXTERN char *		TclpGetTZName(int isdst);
#endif
#ifndef TclWinNoBackslash_TCL_DECLARED
#define TclWinNoBackslash_TCL_DECLARED
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
#endif
/* Slot 25 is reserved */
#ifndef TclWinSetInterfaces_TCL_DECLARED
#define TclWinSetInterfaces_TCL_DECLARED
/* Slot 26 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
#endif
#ifndef TclWinFlushDirtyChannels_TCL_DECLARED
#define TclWinFlushDirtyChannels_TCL_DECLARED
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
#endif
#ifndef TclWinResetInterfaces_TCL_DECLARED
#define TclWinResetInterfaces_TCL_DECLARED
/* Slot 28 is reserved */
/* 28 */
EXTERN void		TclWinResetInterfaces(void);
#endif
#ifndef TclWinCPUID_TCL_DECLARED
#define TclWinCPUID_TCL_DECLARED
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
				Tcl_Obj *resultingNameObj);
#endif
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef TclGetAndDetachPids_TCL_DECLARED
#define TclGetAndDetachPids_TCL_DECLARED
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
#endif
#ifndef TclpCloseFile_TCL_DECLARED
#define TclpCloseFile_TCL_DECLARED
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
#endif
#ifndef TclpCreateCommandChannel_TCL_DECLARED
#define TclpCreateCommandChannel_TCL_DECLARED
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
#endif
#ifndef TclpCreatePipe_TCL_DECLARED
#define TclpCreatePipe_TCL_DECLARED
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
#endif
#ifndef TclpCreateProcess_TCL_DECLARED
#define TclpCreateProcess_TCL_DECLARED
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				CONST char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
#endif
/* 5 */
EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
/* Slot 5 is reserved */
#ifndef TclpMakeFile_TCL_DECLARED
#define TclpMakeFile_TCL_DECLARED
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
#endif
#ifndef TclpOpenFile_TCL_DECLARED
#define TclpOpenFile_TCL_DECLARED
/* 7 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
EXTERN TclFile		TclpOpenFile(CONST char *fname, int mode);
#endif
#ifndef TclUnixWaitForFile_TCL_DECLARED
#define TclUnixWaitForFile_TCL_DECLARED
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
#endif
#ifndef TclpCreateTempFile_TCL_DECLARED
#define TclpCreateTempFile_TCL_DECLARED
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
EXTERN TclFile		TclpCreateTempFile(CONST char *contents);
#endif
#ifndef TclpReaddir_TCL_DECLARED
#define TclpReaddir_TCL_DECLARED
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
#endif
#ifndef TclpLocaltime_unix_TCL_DECLARED
#define TclpLocaltime_unix_TCL_DECLARED
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(CONST time_t *clock);
#endif
#ifndef TclpGmtime_unix_TCL_DECLARED
#define TclpGmtime_unix_TCL_DECLARED
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(CONST time_t *clock);
#endif
#ifndef TclpInetNtoa_TCL_DECLARED
#define TclpInetNtoa_TCL_DECLARED
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
#endif
#ifndef TclUnixCopyFile_TCL_DECLARED
#define TclUnixCopyFile_TCL_DECLARED
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
EXTERN int		TclUnixCopyFile(CONST char *src, CONST char *dst,
				CONST Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
#endif
#ifndef TclMacOSXGetFileAttribute_TCL_DECLARED
#define TclMacOSXGetFileAttribute_TCL_DECLARED
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj **attributePtrPtr);
#endif
#ifndef TclMacOSXSetFileAttribute_TCL_DECLARED
#define TclMacOSXSetFileAttribute_TCL_DECLARED
/* 16 */
EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj *attributePtr);
#endif
#ifndef TclMacOSXCopyFileAttributes_TCL_DECLARED
#define TclMacOSXCopyFileAttributes_TCL_DECLARED
/* 17 */
EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
				const char *dst,
				const Tcl_StatBuf *statBufPtr);
EXTERN int		TclMacOSXCopyFileAttributes(CONST char *src,
				CONST char *dst,
				CONST Tcl_StatBuf *statBufPtr);
#endif
#ifndef TclMacOSXMatchType_TCL_DECLARED
#define TclMacOSXMatchType_TCL_DECLARED
/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				CONST char *pathName, CONST char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
#endif
#ifndef TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED
#define TclMacOSXNotifierAddRunLoopMode_TCL_DECLARED
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
				CONST VOID *runLoopMode);
#endif
/* Slot 20 is reserved */
/* Slot 21 is reserved */
/* 22 */
/* Slot 22 is reserved */
EXTERN TclFile		TclpCreateTempFile_(const char *contents);
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#ifndef TclWinCPUID_TCL_DECLARED
#define TclWinCPUID_TCL_DECLARED
/* 29 */
EXTERN int		TclWinCPUID(int index, int *regs);
EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
#endif
				Tcl_Obj *resultingNameObj);
#endif /* MACOSX */

typedef struct TclIntPlatStubs {
    int magic;
    void *hooks;
    struct TclIntPlatStubHooks *hooks;

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !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 */
    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    VOID *reserved5;
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*reserved11)(void);
    void (*reserved12)(void);
    void (*reserved13)(void);
    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *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 */
    VOID *reserved15;
    VOID *reserved16;
    VOID *reserved17;
    VOID *reserved18;
    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 (*reserved20)(void);
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    VOID *reserved19;
    VOID *reserved20;
    VOID *reserved21;
    VOID *reserved22;
    VOID *reserved23;
    VOID *reserved24;
    VOID *reserved25;
    VOID *reserved26;
    VOID *reserved27;
    VOID *reserved28;
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
    void (*tclWinConvertError) (int errCode); /* 0 */
    void (*reserved1)(void);
    void (*reserved2)(void);
#if defined(__WIN32__) || defined(__CYGWIN__) /* 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 */
    void (*reserved3)(void);
    void * (*tclWinGetTclInstance) (void); /* 4 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
    void (*reserved6)(void);
    void (*reserved7)(void);
    size_t (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    void (*reserved9)(void);
    void (*reserved10)(void);
    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, CONST char *optval, int optlen); /* 7 */
    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
    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 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    int (*tclpIsAtty) (int fd); /* 16 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
    int (*tclUnixCopyFile) (CONST char *src, CONST char *dst, CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (void *hProcess, size_t id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 22 */
    char * (*tclpGetTZName) (int isdst); /* 23 */
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*reserved26)(void);
    VOID *reserved25;
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#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 */
    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, CONST char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    VOID *reserved5;
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    TclFile (*tclpOpenFile) (CONST char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    void (*reserved10)(void);
    void (*reserved11)(void);
    void (*reserved12)(void);
    void (*reserved13)(void);
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    TclFile (*tclpCreateTempFile) (CONST char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (TclDIR *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 (*reserved20)(void);
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
    void (*reserved23)(void);
    void (*reserved24)(void);
    void (*reserved25)(void);
    void (*reserved26)(void);
    void (*reserved27)(void);
    void (*reserved28)(void);
    int (*tclWinCPUID) (int index, int *regs); /* 29 */
    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 *reserved20;
    VOID *reserved21;
    VOID *reserved22;
    VOID *reserved23;
    VOID *reserved24;
    VOID *reserved25;
    VOID *reserved26;
    VOID *reserved27;
    VOID *reserved28;
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;

extern const TclIntPlatStubs *tclIntPlatStubsPtr;
extern TclIntPlatStubs *tclIntPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
 * Inline function declarations:
 */

#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
#ifndef TclGetAndDetachPids
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#endif
#ifndef TclpCloseFile
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#endif
#ifndef TclpCreateCommandChannel
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#endif
#ifndef TclpCreatePipe
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#endif
#ifndef TclpCreateProcess
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#endif
/* Slot 5 is reserved */
#define TclUnixWaitForFile_ \
#ifndef TclpMakeFile
	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#endif
#ifndef TclpOpenFile
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#endif
#ifndef TclUnixWaitForFile
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#endif
#ifndef TclpCreateTempFile
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
#endif
#ifndef TclpReaddir
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#endif
#ifndef TclpLocaltime_unix
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#endif
#ifndef TclpGmtime_unix
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#endif
#ifndef TclpInetNtoa
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#endif
#ifndef TclUnixCopyFile
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#endif
/* Slot 15 is reserved */
/* Slot 16 is reserved */
/* Slot 17 is reserved */
/* Slot 18 is reserved */
/* Slot 19 is reserved */
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 22 is reserved */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#ifndef TclWinCPUID
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
#endif
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#ifndef TclWinConvertError
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#endif
#ifndef TclWinConvertWSAError
#define TclWinConvertWSAError \
	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#endif
/* Slot 1 is reserved */
/* Slot 2 is reserved */
#ifndef TclWinGetServByName
#define TclWinGetServByName \
/* Slot 3 is reserved */
	(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
#endif
#ifndef TclWinGetSockOpt
#define TclWinGetSockOpt \
	(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
#endif
#ifndef TclWinGetTclInstance
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
#endif
#ifndef TclUnixWaitForFile
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
/* Slot 6 is reserved */
/* Slot 7 is reserved */
#endif
#ifndef TclWinNToHS
#define TclWinNToHS \
	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#endif
#ifndef TclWinSetSockOpt
#define TclWinSetSockOpt \
	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#endif
#ifndef TclpGetPid
#define TclpGetPid \
	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
/* Slot 9 is reserved */
/* Slot 10 is reserved */
#endif
#ifndef TclWinGetPlatformId
#define TclWinGetPlatformId \
	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#endif
#ifndef TclpReaddir
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#endif
#ifndef TclGetAndDetachPids
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
#endif
#ifndef TclpCloseFile
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
#endif
#ifndef TclpCreateCommandChannel
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
#endif
#ifndef TclpCreatePipe
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
#endif
#ifndef TclpCreateProcess
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
#endif
#ifndef TclpIsAtty
#define TclpIsAtty \
	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
#endif
#ifndef TclUnixCopyFile
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
#endif
#ifndef TclpMakeFile
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
#endif
#ifndef TclpOpenFile
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#endif
#ifndef TclWinAddProcess
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#endif
#ifndef TclpInetNtoa
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
#endif
#ifndef TclpCreateTempFile
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#endif
#ifndef TclpGetTZName
#define TclpGetTZName \
	(tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
#endif
#ifndef TclWinNoBackslash
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
#endif
/* Slot 25 is reserved */
/* Slot 26 is reserved */
#ifndef TclWinSetInterfaces
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#endif
#ifndef TclWinFlushDirtyChannels
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#endif
/* Slot 28 is reserved */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#ifndef TclWinResetInterfaces
#define TclWinResetInterfaces \
	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#endif
#ifndef TclWinCPUID
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#endif
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef TclGetAndDetachPids
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#endif
#ifndef TclpCloseFile
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#endif
#ifndef TclpCreateCommandChannel
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#endif
#ifndef TclpCreatePipe
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#endif
#ifndef TclpCreateProcess
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
#endif
/* Slot 5 is reserved */
#define TclUnixWaitForFile_ \
#ifndef TclpMakeFile
	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#endif
#ifndef TclpOpenFile
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#endif
#ifndef TclUnixWaitForFile
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#endif
#ifndef TclpCreateTempFile
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
/* Slot 10 is reserved */
/* Slot 11 is reserved */
/* Slot 12 is reserved */
/* Slot 13 is reserved */
#endif
#ifndef TclpReaddir
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#endif
#ifndef TclpLocaltime_unix
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#endif
#ifndef TclpGmtime_unix
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#endif
#ifndef TclpInetNtoa
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#endif
#ifndef TclUnixCopyFile
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#endif
#ifndef TclMacOSXGetFileAttribute
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#endif
#ifndef TclMacOSXSetFileAttribute
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#endif
#ifndef TclMacOSXCopyFileAttributes
#define TclMacOSXCopyFileAttributes \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#endif
#ifndef TclMacOSXMatchType
#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#endif
#ifndef TclMacOSXNotifierAddRunLoopMode
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#endif
/* Slot 20 is reserved */
/* Slot 21 is reserved */
#define TclpCreateTempFile_ \
/* Slot 22 is reserved */
	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
/* Slot 23 is reserved */
/* Slot 24 is reserved */
/* Slot 25 is reserved */
/* Slot 26 is reserved */
/* Slot 27 is reserved */
/* Slot 28 is reserved */
#ifndef TclWinCPUID
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclUnixOpenTemporaryFile \
#endif
	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#define TclWinConvertWSAError TclWinConvertError
#undef TclpLocaltime_unix
#undef TclpGmtime_unix

#undef TclpCreateTempFile_
#undef TclUnixWaitForFile_
#if defined(__WIN32__)
#   undef TclWinNToHS
#ifndef MAC_OSX_TCL /* not accessable on Win32/UNIX */
#undef TclMacOSXGetFileAttribute /* 15 */
#undef TclMacOSXSetFileAttribute /* 16 */
#undef TclMacOSXCopyFileAttributes /* 17 */
#undef TclMacOSXMatchType /* 18 */
#undef TclMacOSXNotifierAddRunLoopMode /* 19 */
#   undef TclWinGetServByName
#   undef TclWinGetSockOpt
#   undef TclWinSetSockOpt
#   define TclWinNToHS ntohs
#   define TclWinGetServByName getservbyname
#endif

#if !defined(_WIN32)
#   define TclWinGetSockOpt getsockopt
#   define TclWinSetSockOpt setsockopt
#else
#   undef TclpGetPid
#   define TclpGetPid(pid) ((size_t)(pid))
#   define TclpGetPid(pid) ((unsigned long) (pid))
#endif

#endif /* _TCLINTPLATDECLS */

Changes to generic/tclInterp.c.

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
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







-
+





-
+

-
-
+
+



-
-
+
+

-
+



-
+



-
+

-
+

-
-
+
+





-
+











-
+

-
-
-
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+


-
+

-
+




-
+



-
-
-
-
-
+
+
+
+
+



-
-
+
+







-
+

-
-
-
-
-
+
+
+
+
+




-
+



-
-
-
+
+
+


-
+


-
+

-
+


-
+



-
-
-
-
-
+
+
+
+
+









-
+












-
+








/*
 * A pointer to a string that holds an initialization script that if non-NULL
 * is evaluated in Tcl_Init() prior to the built-in initialization script
 * above. This variable can be modified by the function below.
 */

static const char *tclPreInitScript = NULL;
static char *tclPreInitScript = NULL;

/* Forward declaration */
struct Target;

/*
 * Alias:
 * struct Alias:
 *
 * Stores information about an alias. Is stored in the child interpreter and
 * used by the source command to find the target command in the parent when
 * Stores information about an alias. Is stored in the slave interpreter and
 * used by the source command to find the target command in the master when
 * the source command is invoked.
 */

typedef struct {
    Tcl_Obj *token;		/* Token for the alias command in the child
typedef struct Alias {
    Tcl_Obj *token;		/* Token for the alias command in the slave
				 * interp. This used to be the command name in
				 * the child when the alias was first
				 * the slave when the alias was first
				 * created. */
    Tcl_Interp *targetInterp;	/* Interp in which target command will be
				 * invoked. */
    Tcl_Command childCmd;	/* Source command in child interpreter, bound
    Tcl_Command slaveCmd;	/* Source command in slave interpreter, bound
				 * to command that invokes the target command
				 * in the target interpreter. */
    Tcl_HashEntry *aliasEntryPtr;
				/* Entry for the alias hash table in child.
				/* Entry for the alias hash table in slave.
				 * This is used by alias deletion to remove
				 * the alias from the child interpreter alias
				 * the alias from the slave interpreter alias
				 * table. */
    struct Target *targetPtr;	/* Entry for target command in parent. This is
				 * used in the parent interpreter to map back
    struct Target *targetPtr;	/* Entry for target command in master. This is
				 * used in the master interpreter to map back
				 * from the target command to aliases
				 * redirecting to it. */
    int objc;			/* Count of Tcl_Obj in the prefix of the
				 * target command to be invoked in the target
				 * interpreter. Additional arguments specified
				 * when calling the alias in the child interp
				 * when calling the alias in the slave interp
				 * will be appended to the prefix before the
				 * command is invoked. */
    Tcl_Obj *objPtr;		/* The first actual prefix object - the target
				 * command name; this has to be at the end of
				 * the structure, which will be extended to
				 * accomodate the remaining objects in the
				 * prefix. */
} Alias;

/*
 *
 * Child:
 * struct Slave:
 *
 * Used by the "interp" command to record and find information about child
 * interpreters. Maps from a command name in the parent to information about a
 * child interpreter, e.g. what aliases are defined in it.
 * Used by the "interp" command to record and find information about slave
 * interpreters. Maps from a command name in the master to information about a
 * slave interpreter, e.g. what aliases are defined in it.
 */

typedef struct {
    Tcl_Interp *parentInterp;	/* Parent interpreter for this child. */
    Tcl_HashEntry *childEntryPtr;
				/* Hash entry in parents child table for this
				 * child interpreter. Used to find this
				 * record, and used when deleting the child
				 * interpreter to delete it from the parent's
typedef struct Slave {
    Tcl_Interp *masterInterp;	/* Master interpreter for this slave. */
    Tcl_HashEntry *slaveEntryPtr;
				/* Hash entry in masters slave table for this
				 * slave interpreter. Used to find this
				 * record, and used when deleting the slave
				 * interpreter to delete it from the master's
				 * table. */
    Tcl_Interp	*childInterp;	/* The child interpreter. */
    Tcl_Interp	*slaveInterp;	/* The slave interpreter. */
    Tcl_Command interpCmd;	/* Interpreter object command. */
    Tcl_HashTable aliasTable;	/* Table which maps from names of commands in
				 * child interpreter to struct Alias defined
				 * slave interpreter to struct Alias defined
				 * below. */
} Child;
} Slave;

/*
 * struct Target:
 *
 * Maps from parent interpreter commands back to the source commands in child
 * Maps from master interpreter commands back to the source commands in slave
 * interpreters. This is needed because aliases can be created between sibling
 * interpreters and must be deleted when the target interpreter is deleted. In
 * case they would not be deleted the source interpreter would be left with a
 * "dangling pointer". One such record is stored in the Parent record of the
 * parent interpreter with the parent for each alias which directs to a
 * command in the parent. These records are used to remove the source command
 * for an from a child if/when the parent is deleted. They are organized in a
 * doubly-linked list attached to the parent interpreter.
 * "dangling pointer". One such record is stored in the Master record of the
 * master interpreter with the master for each alias which directs to a
 * command in the master. These records are used to remove the source command
 * for an from a slave if/when the master is deleted. They are organized in a
 * doubly-linked list attached to the master interpreter.
 */

typedef struct Target {
    Tcl_Command	childCmd;	/* Command for alias in child interp. */
    Tcl_Interp *childInterp;	/* Child Interpreter. */
    Tcl_Command	slaveCmd;	/* Command for alias in slave interp. */
    Tcl_Interp *slaveInterp;	/* Slave Interpreter. */
    struct Target *nextPtr;	/* Next in list of target records, or NULL if
				 * at the end of the list of targets. */
    struct Target *prevPtr;	/* Previous in list of target records, or NULL
				 * if at the start of the list of targets. */
} Target;

/*
 * Parent:
 * struct Master:
 *
 * This record is used for two purposes: First, childTable (a hashtable) maps
 * from names of commands to child interpreters. This hashtable is used to
 * store information about child interpreters of this interpreter, to map over
 * all children, etc. The second purpose is to store information about all
 * aliases in children (or siblings) which direct to target commands in this
 * This record is used for two purposes: First, slaveTable (a hashtable) maps
 * from names of commands to slave interpreters. This hashtable is used to
 * store information about slave interpreters of this interpreter, to map over
 * all slaves, etc. The second purpose is to store information about all
 * aliases in slaves (or siblings) which direct to target commands in this
 * interpreter (using the targetsPtr doubly-linked list).
 *
 * NB: the flags field in the interp structure, used with SAFE_INTERP mask
 * denotes whether the interpreter is safe or not. Safe interpreters have
 * restricted functionality, can only create safe interpreters and can
 * restricted functionality, can only create safe slave interpreters and can
 * only load safe extensions.
 */

typedef struct {
    Tcl_HashTable childTable;	/* Hash table for child interpreters. Maps
				 * from command names to Child records. */
typedef struct Master {
    Tcl_HashTable slaveTable;	/* Hash table for slave interpreters. Maps
				 * from command names to Slave records. */
    Target *targetsPtr;		/* The head of a doubly-linked list of all the
				 * target records which denote aliases from
				 * children or sibling interpreters that direct
				 * slaves or sibling interpreters that direct
				 * to commands in this interpreter. This list
				 * is used to remove dangling pointers from
				 * the child (or sibling) interpreters when
				 * the slave (or sibling) interpreters when
				 * this interpreter is deleted. */
} Parent;
} Master;

/*
 * The following structure keeps track of all the Parent and Child information
 * The following structure keeps track of all the Master and Slave information
 * on a per-interp basis.
 */

typedef struct {
    Parent parent;		/* Keeps track of all interps for which this
				 * interp is the Parent. */
    Child child;		/* Information necessary for this interp to
				 * function as a child. */
typedef struct InterpInfo {
    Master master;		/* Keeps track of all interps for which this
				 * interp is the Master. */
    Slave slave;		/* Information necessary for this interp to
				 * function as a slave. */
} InterpInfo;

/*
 * Limit callbacks handled by scripts are modelled as structures which are
 * stored in hashes indexed by a two-word key. Note that the type of the
 * 'type' field in the key is not int; this is to make sure that things are
 * likely to work properly on 64-bit architectures.
 */

typedef struct {
typedef struct ScriptLimitCallback {
    Tcl_Interp *interp;		/* The interpreter in which to execute the
				 * callback. */
    Tcl_Obj *scriptObj;		/* The script to execute to perform the
				 * user-defined part of the callback. */
    int type;			/* What kind of callback is this. */
    Tcl_HashEntry *entryPtr;	/* The entry in the hash table maintained by
				 * the target interpreter that refers to this
				 * callback record, or NULL if the entry has
				 * already been deleted from that hash
				 * table. */
} ScriptLimitCallback;

typedef struct {
typedef struct ScriptLimitCallbackKey {
    Tcl_Interp *interp;		/* The interpreter that the limit callback was
				 * attached to. This is not the interpreter
				 * that the callback runs in! */
    long type;			/* The type of callback that this is. */
} ScriptLimitCallbackKey;

/*
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
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







-
+



-
+

-
-
-
-
+
+
+
+
+
+



-
-
-
+
+
+
+

-
+

-
-
+
+

-
+

-
-
+
+

-
+

-
-
-
-
+
+
+
+


-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+








-
-
-
-
-
-


















-
+

-
+

-
+









/*
 * Prototypes for local static functions:
 */

static int		AliasCreate(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, Tcl_Interp *parentInterp,
			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,
			    Tcl_Obj *const objv[]);
static int		AliasDelete(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, Tcl_Obj *namePtr);
			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr);
static int		AliasDescribe(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, Tcl_Obj *objPtr);
static int		AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp);
static Tcl_ObjCmdProc		AliasNRCmd;
static Tcl_CmdDeleteProc	AliasObjCmdDeleteProc;
			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
static int		AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
static int		AliasObjCmd(ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
			    Tcl_Obj *const objv[]);
static void		AliasObjCmdDeleteProc(ClientData clientData);
static Tcl_Interp *	GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static Tcl_Interp *	GetInterp2(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static Tcl_InterpDeleteProc	InterpInfoDeleteProc;
static int		ChildBgerror(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int objc,
static void		InterpInfoDeleteProc(ClientData clientData,
			    Tcl_Interp *interp);
static int		SlaveBgerror(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,
			    Tcl_Obj *const objv[]);
static Tcl_Interp *	ChildCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
static Tcl_Interp *	SlaveCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr,
			    int safe);
static int		ChildDebugCmd(Tcl_Interp *interp,
			    Tcl_Interp *childInterp,
static int		SlaveDebugCmd(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp,
			    int objc, Tcl_Obj *const objv[]);
static int		ChildEval(Tcl_Interp *interp, Tcl_Interp *childInterp,
static int		SlaveEval(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
			    int objc, Tcl_Obj *const objv[]);
static int		ChildExpose(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int objc,
static int		SlaveExpose(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,
			    Tcl_Obj *const objv[]);
static int		ChildHide(Tcl_Interp *interp, Tcl_Interp *childInterp,
static int		SlaveHide(Tcl_Interp *interp, Tcl_Interp *slaveInterp,
			    int objc, Tcl_Obj *const objv[]);
static int		ChildHidden(Tcl_Interp *interp,
			    Tcl_Interp *childInterp);
static int		ChildInvokeHidden(Tcl_Interp *interp,
			    Tcl_Interp *childInterp,
static int		SlaveHidden(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp);
static int		SlaveInvokeHidden(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp,
			    const char *namespaceName,
			    int objc, Tcl_Obj *const objv[]);
static int		ChildMarkTrusted(Tcl_Interp *interp,
			    Tcl_Interp *childInterp);
static Tcl_CmdDeleteProc	ChildObjCmdDeleteProc;
static int		ChildRecursionLimit(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int objc,
static int		SlaveMarkTrusted(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp);
static int		SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static void		SlaveObjCmdDeleteProc(ClientData clientData);
static int		SlaveRecursionLimit(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int objc,
			    Tcl_Obj *const objv[]);
static int		ChildCommandLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int consumedObjc,
static int		SlaveCommandLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);
static int		ChildTimeLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *childInterp, int consumedObjc,
static int		SlaveTimeLimitCmd(Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, int consumedObjc,
			    int objc, Tcl_Obj *const objv[]);
static void		InheritLimitsFromParent(Tcl_Interp *childInterp,
			    Tcl_Interp *parentInterp);
static void		InheritLimitsFromMaster(Tcl_Interp *slaveInterp,
			    Tcl_Interp *masterInterp);
static void		SetScriptLimitCallback(Tcl_Interp *interp, int type,
			    Tcl_Interp *targetInterp, Tcl_Obj *scriptObj);
static void		CallScriptLimitCallback(ClientData clientData,
			    Tcl_Interp *interp);
static void		DeleteScriptLimitCallback(ClientData clientData);
static void		RunLimitHandlers(LimitHandler *handlerPtr,
			    Tcl_Interp *interp);
static void		TimeLimitCallback(ClientData clientData);

/* NRE enabling */
static Tcl_NRPostProc	NRPostInvokeHidden;
static Tcl_ObjCmdProc	NRInterpCmd;
static Tcl_ObjCmdProc	NRChildCmd;


/*
 *----------------------------------------------------------------------
 *
 * TclSetPreInitScript --
 *
 *	This routine is used to change the value of the internal variable,
 *	tclPreInitScript.
 *
 * Results:
 *	Returns the current value of tclPreInitScript.
 *
 * Side effects:
 *	Changes the way Tcl_Init() routine behaves.
 *
 *----------------------------------------------------------------------
 */

const char *
char *
TclSetPreInitScript(
    const char *string)		/* Pointer to a script. */
    char *string)		/* Pointer to a script. */
{
    const char *prevString = tclPreInitScript;
    char *prevString = tclPreInitScript;
    tclPreInitScript = string;
    return(prevString);
}

/*
 *----------------------------------------------------------------------
 *
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
318
319
320
321
322
323
324





325
326
327
328






329

330


331
332
333
334
335
336
337
338
339







-
-
-
-
-




-
-
-
-
-
-

-
+
-
-
+
+







 *
 * Side effects:
 *	Depends on what's in the init.tcl script.
 *
 *----------------------------------------------------------------------
 */

typedef struct PkgName {
    struct PkgName *nextPtr;	/* Next in list of package names being initialized. */
    char name[4];
} PkgName;

int
Tcl_Init(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    PkgName pkgName = {NULL, "Tcl"};
    PkgName **names = (PkgName **)TclInitPkgFiles(interp);
    int result = TCL_ERROR;

    pkgName.nextPtr = *names;
    *names = &pkgName;
    if (tclPreInitScript != NULL) {
	if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) {
	if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
	    goto end;
	}
	    return (TCL_ERROR);
	};
    }

    /*
     * In order to find init.tcl during initialization, the following script
     * is invoked by Tcl_Init(). It looks in several different directories:
     *
     *	$tcl_library		- can specify a primary location, if set, no
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
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







-
+




















-







-







     * The first directory on this path that contains a valid init.tcl script
     * will be set as the value of tcl_library.
     *
     * Note that this entire search mechanism can be bypassed by defining an
     * alternate tclInit command before calling Tcl_Init().
     */

    result = Tcl_EvalEx(interp,
    return Tcl_Eval(interp,
"if {[namespace which -command tclInit] eq \"\"} {\n"
"  proc tclInit {} {\n"
"    global tcl_libPath tcl_library env tclDefaultLibrary\n"
"    rename tclInit {}\n"
"    if {[info exists tcl_library]} {\n"
"	set scripts {{set tcl_library}}\n"
"    } else {\n"
"	set scripts {}\n"
"	if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
"	    lappend scripts {set env(TCL_LIBRARY)}\n"
"	    lappend scripts {\n"
"if {[regexp ^tcl(.*)$ [file tail $env(TCL_LIBRARY)] -> tail] == 0} continue\n"
"if {$tail eq [info tclversion]} continue\n"
"file join [file dirname $env(TCL_LIBRARY)] tcl[info tclversion]}\n"
"	}\n"
"	if {[info exists tclDefaultLibrary]} {\n"
"	    lappend scripts {set tclDefaultLibrary}\n"
"	} else {\n"
"	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
"	}\n"
"	lappend scripts {::tcl::zipfs::tcl_library_init}\n"
"	lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
"file join $parentDir lib tcl[info tclversion]} \\\n"
"	{file join $grandParentDir lib tcl[info tclversion]} \\\n"
"	{file join $parentDir library} \\\n"
"	{file join $grandParentDir library} \\\n"
"	{file join $grandParentDir tcl[info tclversion] library} \\\n"
"	{file join $grandParentDir tcl[info patchlevel] library} \\\n"
"	{\n"
"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
"	if {[info exists tcl_libPath]\n"
"		&& [catch {llength $tcl_libPath} len] == 0} {\n"
"	    for {set i 0} {$i < $len} {incr i} {\n"
"		lappend scripts [list lindex \\$tcl_libPath $i]\n"
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
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
611
612
613
614
615
616
617
618
619
620
621
622


623
624
625
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
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
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


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
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
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
595
596
597
598


599
600




601
602
603




604
605
606
607
608
609
610


611
612



613
614

615
616

617
618
619
620
621

622
623
624


625
626
627
628
629

630
631
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
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

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







-
+
-
-
-
-







-
+

















-
-
+
+

-
+


-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
+
-











-
+












-
+

-
+


-
-
+
+








-
-
+
+


-
+







-
+

-
-
+
+



-
-
+
+


-
+




-
-
-
+
+
+






-
+


-
+

-
+


















-
+


-
+




-
-
-
-
-
-
-
-
-
-
-

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+



-
-
+
+
-
-
-
-
+
+
+
-
-
-
-
+






-
-
+
+
-
-
-


-
+

-
+




-
+


-
-
+
+



-
+


-
+


-
-
+
+


+
+
+
-
-
-
+
+
+
+
+



-
-
-
+
+
+
+
+


-
-
+
+
+
+
+




-
-
+
+


-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+

-
+












-
+


-
-
-
+
+
+









-
+




-
+



-
+




-
+










-
+

-
+

-
+



-
+


-
+
+
+
+



-




-
-
+
+


-
+
+



+


-
-
+
+

-
+


-
-


-
-
-
+
+
+



-
+
+
+




-
-
+
+


-
+
+

-
+
+

+
-
-
+
+









-
+
+
+




-
-
+
+


-
-
+
+
+
+
+




-
-
+
+


-
-
-
-
+
+
+
+
+
+
+


-
-
-
-
+
+
+
+
+
+
+


-
+

+

-
+

+
-
+







"    set msg \"Can't find a usable init.tcl in the following directories: \n\"\n"
"    append msg \"    $dirs\n\n\"\n"
"    append msg \"$errors\n\n\"\n"
"    append msg \"This probably means that Tcl wasn't installed properly.\n\"\n"
"    error $msg\n"
"  }\n"
"}\n"
"tclInit", -1, 0);
"tclInit");

end:
    *names = (*names)->nextPtr;
    return result;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclInterpInit --
 *
 *	Initializes the invoking interpreter for using the parent, child and
 *	Initializes the invoking interpreter for using the master, slave and
 *	safe interp facilities. This is called from inside Tcl_CreateInterp().
 *
 * Results:
 *	Always returns TCL_OK for backwards compatibility.
 *
 * Side effects:
 *	Adds the "interp" command to an interpreter and initializes the
 *	interpInfoPtr field of the invoking interpreter.
 *
 *---------------------------------------------------------------------------
 */

int
TclInterpInit(
    Tcl_Interp *interp)		/* Interpreter to initialize. */
{
    InterpInfo *interpInfoPtr;
    Parent *parentPtr;
    Child *childPtr;
    Master *masterPtr;
    Slave *slavePtr;

    interpInfoPtr = (InterpInfo *)Tcl_Alloc(sizeof(InterpInfo));
    interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));
    ((Interp *) interp)->interpInfo = interpInfoPtr;

    parentPtr = &interpInfoPtr->parent;
    Tcl_InitHashTable(&parentPtr->childTable, TCL_STRING_KEYS);
    parentPtr->targetsPtr = NULL;
    masterPtr = &interpInfoPtr->master;
    Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);
    masterPtr->targetsPtr = NULL;

    childPtr = &interpInfoPtr->child;
    childPtr->parentInterp	= NULL;
    childPtr->childEntryPtr	= NULL;
    childPtr->childInterp	= interp;
    childPtr->interpCmd		= NULL;
    Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);
    slavePtr = &interpInfoPtr->slave;
    slavePtr->masterInterp	= NULL;
    slavePtr->slaveEntryPtr	= NULL;
    slavePtr->slaveInterp	= interp;
    slavePtr->interpCmd		= NULL;
    Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);

    Tcl_NRCreateCommand(interp, "interp", Tcl_InterpObjCmd, NRInterpCmd,
    Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);
	    NULL, NULL);

    Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * InterpInfoDeleteProc --
 *
 *	Invoked when an interpreter is being deleted. It releases all storage
 *	used by the parent/child/safe interpreter facilities.
 *	used by the master/slave/safe interpreter facilities.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Cleans up storage. Sets the interpInfoPtr field of the interp to NULL.
 *
 *---------------------------------------------------------------------------
 */

static void
InterpInfoDeleteProc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Ignored. */
    Tcl_Interp *interp)		/* Interp being deleted. All commands for
				 * child interps should already be deleted. */
				 * slave interps should already be deleted. */
{
    InterpInfo *interpInfoPtr;
    Child *childPtr;
    Parent *parentPtr;
    Slave *slavePtr;
    Master *masterPtr;
    Target *targetPtr;

    interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;

    /*
     * There shouldn't be any commands left.
     */

    parentPtr = &interpInfoPtr->parent;
    if (parentPtr->childTable.numEntries != 0) {
    masterPtr = &interpInfoPtr->master;
    if (masterPtr->slaveTable.numEntries != 0) {
	Tcl_Panic("InterpInfoDeleteProc: still exist commands");
    }
    Tcl_DeleteHashTable(&parentPtr->childTable);
    Tcl_DeleteHashTable(&masterPtr->slaveTable);

    /*
     * Tell any interps that have aliases to this interp that they should
     * delete those aliases. If the other interp was already dead, it would
     * have removed the target record already.
     */

    for (targetPtr = parentPtr->targetsPtr; targetPtr != NULL; ) {
    for (targetPtr = masterPtr->targetsPtr; targetPtr != NULL; ) {
	Target *tmpPtr = targetPtr->nextPtr;
	Tcl_DeleteCommandFromToken(targetPtr->childInterp,
		targetPtr->childCmd);
	Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
		targetPtr->slaveCmd);
	targetPtr = tmpPtr;
    }

    childPtr = &interpInfoPtr->child;
    if (childPtr->interpCmd != NULL) {
    slavePtr = &interpInfoPtr->slave;
    if (slavePtr->interpCmd != NULL) {
	/*
	 * Tcl_DeleteInterp() was called on this interpreter, rather "interp
	 * delete" or the equivalent deletion of the command in the parent.
	 * delete" or the equivalent deletion of the command in the master.
	 * First ensure that the cleanup callback doesn't try to delete the
	 * interp again.
	 */

	childPtr->childInterp = NULL;
	Tcl_DeleteCommandFromToken(childPtr->parentInterp,
		childPtr->interpCmd);
	slavePtr->slaveInterp = NULL;
	Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
		slavePtr->interpCmd);
    }

    /*
     * There shouldn't be any aliases left.
     */

    if (childPtr->aliasTable.numEntries != 0) {
    if (slavePtr->aliasTable.numEntries != 0) {
	Tcl_Panic("InterpInfoDeleteProc: still exist aliases");
    }
    Tcl_DeleteHashTable(&childPtr->aliasTable);
    Tcl_DeleteHashTable(&slavePtr->aliasTable);

    Tcl_Free(interpInfoPtr);
    ckfree((char *) interpInfoPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InterpObjCmd --
 *
 *	This function is invoked to process the "interp" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_InterpObjCmd(
    ClientData clientData,
    ClientData clientData,		/* Unused. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,				/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRInterpCmd, clientData, objc, objv);
}

static int
NRInterpCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,				/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    Tcl_Interp *childInterp;
    int index;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
    static const char *options[] = {
	"alias",	"aliases",	"bgerror",	"create",
	"children",	"create",	"debug",	"delete",
	"eval",		"exists",	"expose",	"hide",
	"hidden",	"issafe",	"invokehidden",
	"limit",	"marktrusted",	"recursionlimit",
	"share",
#ifndef TCL_NO_DEPRECATED
	"slaves",
#endif
	"target",	"transfer",	NULL
    };
    static const char *const optionsNoSlaves[] = {
	"alias",	"aliases",	"bgerror",	"cancel",
	"children",	"create",	"debug",	"delete",
	"eval",		"exists",	"expose",
	"hide",		"hidden",	"issafe",
	"invokehidden",	"limit",	"marktrusted",	"recursionlimit",
	"debug",	"delete",	"eval",		"exists",	"expose",
	"hide",		"hidden",	"issafe",	"invokehidden",
	"limit",	"marktrusted",	"recursionlimit","slaves",
	"share",	"target",	"transfer",
	NULL
    };
    enum interpOptionEnum {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CANCEL,
    enum option {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_CREATE,
	OPT_CHILDREN,	OPT_CREATE,	OPT_DEBUG,	OPT_DELETE,
	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,
	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
	OPT_LIMIT,	OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE,
	OPT_DEBUG,	OPT_DELETE,	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,
	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
	OPT_LIMIT,	OPT_MARKTRUSTED,OPT_RECLIMIT,	OPT_SLAVES,
#ifndef TCL_NO_DEPRECATED
	OPT_SLAVES,
#endif
	OPT_TARGET,	OPT_TRANSFER
	OPT_SHARE,	OPT_TARGET,	OPT_TRANSFER
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(NULL, objv[1], options,
	    "option", 0, &index) != TCL_OK) {
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
	    &index) != TCL_OK) {
	/* Don't report the "slaves" option as possibility */
	Tcl_GetIndexFromObj(interp, objv[1], optionsNoSlaves,
		"option", 0, &index);
	return TCL_ERROR;
    }
    switch ((enum interpOptionEnum)index) {
    switch ((enum option) index) {
    case OPT_ALIAS: {
	Tcl_Interp *parentInterp;
	Tcl_Interp *slaveInterp, *masterInterp;

	if (objc < 4) {
	aliasArgs:
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "childPath childCmd ?parentPath parentCmd? ?arg ...?");
		    "slavePath slaveCmd ?masterPath masterCmd? ?args ..?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	if (objc == 4) {
	    return AliasDescribe(interp, childInterp, objv[3]);
	    return AliasDescribe(interp, slaveInterp, objv[3]);
	}
	if ((objc == 5) && (TclGetString(objv[4])[0] == '\0')) {
	    return AliasDelete(interp, childInterp, objv[3]);
	    return AliasDelete(interp, slaveInterp, objv[3]);
	}
	if (objc > 5) {
	    parentInterp = GetInterp(interp, objv[4]);
	    if (parentInterp == NULL) {
	    masterInterp = GetInterp(interp, objv[4]);
	    if (masterInterp == NULL) {
		return TCL_ERROR;
	    }
	    if (TclGetString(objv[5])[0] == '\0') {
		if (objc == 6) {
		    return AliasDelete(interp, slaveInterp, objv[3]);

	    return AliasCreate(interp, childInterp, parentInterp, objv[3],
		    objv[5], objc - 6, objv + 6);
		}
	    } else {
		return AliasCreate(interp, slaveInterp, masterInterp, objv[3],
			objv[5], objc - 6, objv + 6);
	    }
	}
	goto aliasArgs;
    }
    case OPT_ALIASES:
	childInterp = GetInterp2(interp, objc, objv);
	if (childInterp == NULL) {
    case OPT_ALIASES: {
	Tcl_Interp *slaveInterp;

	slaveInterp = GetInterp2(interp, objc, objv);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return AliasList(interp, childInterp);
    case OPT_BGERROR:
	return AliasList(interp, slaveInterp);
    }
    case OPT_BGERROR: {
	Tcl_Interp *slaveInterp;

	if (objc != 3 && objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path ?cmdPrefix?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildBgerror(interp, childInterp, objc - 3, objv + 3);
	return SlaveBgerror(interp, slaveInterp, objc - 3, objv + 3);
    case OPT_CANCEL: {
	int i, flags;
	Tcl_Obj *resultObjPtr;
	static const char *const cancelOptions[] = {
	    "-unwind",	"--",	NULL
	};
	enum optionCancelEnum {
	    OPT_UNWIND,	OPT_LAST
	};

    }
	flags = 0;

	for (i = 2; i < objc; i++) {
	    if (TclGetString(objv[i])[0] != '-') {
		break;
	    }
	    if (Tcl_GetIndexFromObj(interp, objv[i], cancelOptions, "option",
		    0, &index) != TCL_OK) {
		return TCL_ERROR;
	    }

	    switch ((enum optionCancelEnum) index) {
	    case OPT_UNWIND:
		/*
		 * The evaluation stack in the target interp is to be unwound.
		 */

		flags |= TCL_CANCEL_UNWIND;
		break;
	    case OPT_LAST:
		i++;
		goto endOfForLoop;
	    }
	}

    endOfForLoop:
	if (i < objc - 2) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "?-unwind? ?--? ?path? ?result?");
	    return TCL_ERROR;
	}

	/*
	 * Did they specify a child interp to cancel the script in progress
	 * in?  If not, use the current interp.
	 */

	if (i < objc) {
	    childInterp = GetInterp(interp, objv[i]);
	    if (childInterp == NULL) {
		return TCL_ERROR;
	    }
	    i++;
	} else {
	    childInterp = interp;
	}

	if (i < objc) {
	    resultObjPtr = objv[i];

	    /*
	     * Tcl_CancelEval removes this reference.
	     */

	    Tcl_IncrRefCount(resultObjPtr);
	    i++;
	} else {
	    resultObjPtr = NULL;
	}

	return Tcl_CancelEval(childInterp, resultObjPtr, 0, flags);
    }
    case OPT_CREATE: {
	int i, last, safe;
	Tcl_Obj *childPtr;
	Tcl_Obj *slavePtr;
	char buf[16 + TCL_INTEGER_SPACE];
	static const char *const createOptions[] = {
	static const char *options[] = {
	    "-safe",	"--", NULL
	};
	enum option {
	    OPT_SAFE,	OPT_LAST
	};

	safe = Tcl_IsSafe(interp);

	/*
	 * Weird historical rules: "-safe" is accepted at the end, too.
	 */

	childPtr = NULL;
	slavePtr = NULL;
	last = 0;
	for (i = 2; i < objc; i++) {
	    if ((last == 0) && (TclGetString(objv[i])[0] == '-')) {
		if (Tcl_GetIndexFromObj(interp, objv[i], createOptions,
			"option", 0, &index) != TCL_OK) {
	    if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {
		if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
			&index) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (index == OPT_SAFE) {
		    safe = 1;
		    continue;
		}
		i++;
		last = 1;
	    }
	    if (childPtr != NULL) {
	    if (slavePtr != NULL) {
		Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
		return TCL_ERROR;
	    }
	    if (i < objc) {
		childPtr = objv[i];
		slavePtr = objv[i];
	    }
	}
	buf[0] = '\0';
	if (childPtr == NULL) {
	if (slavePtr == NULL) {
	    /*
	     * Create an anonymous interpreter -- we choose its name and the
	     * name of the command. We check that the command name that we use
	     * for the interpreter does not collide with an existing command
	     * in the parent interpreter.
	     * in the master interpreter.
	     */

	    for (i = 0; ; i++) {
		Tcl_CmdInfo cmdInfo;

		sprintf(buf, "interp%d", i);
		if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {
		    break;
		}
	    }
	    childPtr = Tcl_NewStringObj(buf, -1);
	    slavePtr = Tcl_NewStringObj(buf, -1);
	}
	if (ChildCreate(interp, childPtr, safe) == NULL) {
	if (SlaveCreate(interp, slavePtr, safe) == NULL) {
	    if (buf[0] != '\0') {
		Tcl_DecrRefCount(childPtr);
		Tcl_DecrRefCount(slavePtr);
	    }
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, childPtr);
	Tcl_SetObjResult(interp, slavePtr);
	return TCL_OK;
    }
    case OPT_DEBUG:		/* TIP #378 */
    case OPT_DEBUG: {
	/* TIP #378 */
	Tcl_Interp *slaveInterp;

	/*
	 * Currently only -frame supported, otherwise ?-option ?value??
	 */

	if (objc < 3 || objc > 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path ?-frame ?bool??");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildDebugCmd(interp, childInterp, objc - 3, objv + 3);
	return SlaveDebugCmd(interp, slaveInterp, objc - 3, objv + 3);
    }
    case OPT_DELETE: {
	int i;
	InterpInfo *iiPtr;
	Tcl_Interp *slaveInterp;

	for (i = 2; i < objc; i++) {
	    childInterp = GetInterp(interp, objv[i]);
	    if (childInterp == NULL) {
	    slaveInterp = GetInterp(interp, objv[i]);
	    if (slaveInterp == NULL) {
		return TCL_ERROR;
	    } else if (childInterp == interp) {
	    } else if (slaveInterp == interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot delete the current interpreter", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			"DELETESELF", NULL);
		return TCL_ERROR;
	    }
	    iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
	    Tcl_DeleteCommandFromToken(iiPtr->child.parentInterp,
		    iiPtr->child.interpCmd);
	    iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
	    Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,
		    iiPtr->slave.interpCmd);
	}
	return TCL_OK;
    }
    case OPT_EVAL:
    case OPT_EVAL: {
	Tcl_Interp *slaveInterp;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildEval(interp, childInterp, objc - 3, objv + 3);
	return SlaveEval(interp, slaveInterp, objc - 3, objv + 3);
    }
    case OPT_EXISTS: {
	int exists = 1;
	int exists;
	Tcl_Interp *slaveInterp;

	exists = 1;
	childInterp = GetInterp2(interp, objc, objv);
	if (childInterp == NULL) {
	slaveInterp = GetInterp2(interp, objc, objv);
	if (slaveInterp == NULL) {
	    if (objc > 3) {
		return TCL_ERROR;
	    }
	    Tcl_ResetResult(interp);
	    exists = 0;
	}
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
	return TCL_OK;
    }
    case OPT_EXPOSE:
    case OPT_EXPOSE: {
	Tcl_Interp *slaveInterp;

	if ((objc < 4) || (objc > 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path hiddenCmdName ?cmdName?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildExpose(interp, childInterp, objc - 3, objv + 3);
    case OPT_HIDE:
	return SlaveExpose(interp, slaveInterp, objc - 3, objv + 3);
    }
    case OPT_HIDE: {
	Tcl_Interp *slaveInterp;		/* A slave. */

	if ((objc < 4) || (objc > 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path cmdName ?hiddenCmdName?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildHide(interp, childInterp, objc - 3, objv + 3);
    case OPT_HIDDEN:
	childInterp = GetInterp2(interp, objc, objv);
	if (childInterp == NULL) {
	return SlaveHide(interp, slaveInterp, objc - 3, objv + 3);
    }
    case OPT_HIDDEN: {
	Tcl_Interp *slaveInterp;		/* A slave. */

	slaveInterp = GetInterp2(interp, objc, objv);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildHidden(interp, childInterp);
    case OPT_ISSAFE:
	childInterp = GetInterp2(interp, objc, objv);
	if (childInterp == NULL) {
	return SlaveHidden(interp, slaveInterp);
    }
    case OPT_ISSAFE: {
	Tcl_Interp *slaveInterp;

	slaveInterp = GetInterp2(interp, objc, objv);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp)));
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
	return TCL_OK;
    }
    case OPT_INVOKEHID: {
	int i;
	int i, index;
	const char *namespaceName;
	Tcl_Interp *slaveInterp;
	static const char *const hiddenOptions[] = {
	static const char *hiddenOptions[] = {
	    "-global",	"-namespace",	"--", NULL
	};
	enum hiddenOption {
	    OPT_GLOBAL,	OPT_NAMESPACE,	OPT_LAST
	};

	namespaceName = NULL;
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
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
1140
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







-
-
+
+


-
+



+
-
+








-
+
-


-
-
+
+








-
+

-
+



-
+
+
+




-
-
+
+


-
-
+
+
+
+
+




-
-
+
+


-
+
-
-
-
+
+
+
-






-
-
+
+


-
-
-
+
+
+

-
+








-
+
+






-
-
+
+


-
+

-
+


-
-
+
+


-
+






-
-
+
+






+



-
+






-
-
+
+





-
-
+
+

-
+
-
-
+




-
+

-
-
-
+
+
+
-
-
+







	    }
	}
	if (objc - i < 1) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "path ?-namespace ns? ?-global? ?--? cmd ?arg ..?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildInvokeHidden(interp, childInterp, namespaceName, objc - i,
	return SlaveInvokeHidden(interp, slaveInterp, namespaceName, objc - i,
		objv + i);
    }
    case OPT_LIMIT: {
	Tcl_Interp *slaveInterp;
	static const char *const limitTypes[] = {
	static const char *limitTypes[] = {
	    "commands", "time", NULL
	};
	enum LimitTypes {
	    LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME
	};
	int limitType;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv,
	    Tcl_WrongNumArgs(interp, 2, objv, "path limitType ?options?");
		    "path limitType ?-option value ...?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[3], limitTypes, "limit type", 0,
		&limitType) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum LimitTypes) limitType) {
	case LIMIT_TYPE_COMMANDS:
	    return ChildCommandLimitCmd(interp, childInterp, 4, objc,objv);
	    return SlaveCommandLimitCmd(interp, slaveInterp, 4, objc,objv);
	case LIMIT_TYPE_TIME:
	    return ChildTimeLimitCmd(interp, childInterp, 4, objc, objv);
	    return SlaveTimeLimitCmd(interp, slaveInterp, 4, objc, objv);
	}
    }
    break;
    case OPT_MARKTRUSTED:
    case OPT_MARKTRUSTED: {
	Tcl_Interp *slaveInterp;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildMarkTrusted(interp, childInterp);
    case OPT_RECLIMIT:
	return SlaveMarkTrusted(interp, slaveInterp);
    }
    case OPT_RECLIMIT: {
	Tcl_Interp *slaveInterp;

	if (objc != 3 && objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path ?newlimit?");
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
	return SlaveRecursionLimit(interp, slaveInterp, objc - 3, objv + 3);
#ifndef TCL_NO_DEPRECATED
    case OPT_SLAVES:
#endif
    }
    case OPT_SLAVES: {
	Tcl_Interp *slaveInterp;
    case OPT_CHILDREN: {
	InterpInfo *iiPtr;
	Tcl_Obj *resultPtr;
	Tcl_HashEntry *hPtr;
	Tcl_HashSearch hashSearch;
	char *string;

	childInterp = GetInterp2(interp, objc, objv);
	if (childInterp == NULL) {
	slaveInterp = GetInterp2(interp, objc, objv);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
	TclNewObj(resultPtr);
	hPtr = Tcl_FirstHashEntry(&iiPtr->parent.childTable, &hashSearch);
	iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
	resultPtr = Tcl_NewObj();
	hPtr = Tcl_FirstHashEntry(&iiPtr->master.slaveTable, &hashSearch);
	for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
	    string = (char *)Tcl_GetHashKey(&iiPtr->parent.childTable, hPtr);
	    string = Tcl_GetHashKey(&iiPtr->master.slaveTable, hPtr);
	    Tcl_ListObjAppendElement(NULL, resultPtr,
		    Tcl_NewStringObj(string, -1));
	}
	Tcl_SetObjResult(interp, resultPtr);
	return TCL_OK;
    }
    case OPT_TRANSFER:
    case OPT_SHARE: {
	Tcl_Interp *parentInterp;	/* The parent of the child. */
	Tcl_Interp *slaveInterp;		/* A slave. */
	Tcl_Interp *masterInterp;		/* Its master. */
	Tcl_Channel chan;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
	    return TCL_ERROR;
	}
	parentInterp = GetInterp(interp, objv[2]);
	if (parentInterp == NULL) {
	masterInterp = GetInterp(interp, objv[2]);
	if (masterInterp == NULL) {
	    return TCL_ERROR;
	}
	chan = Tcl_GetChannel(parentInterp, TclGetString(objv[3]), NULL);
	chan = Tcl_GetChannel(masterInterp, TclGetString(objv[3]), NULL);
	if (chan == NULL) {
	    Tcl_TransferResult(parentInterp, TCL_OK, interp);
	    TclTransferResult(masterInterp, TCL_OK, interp);
	    return TCL_ERROR;
	}
	childInterp = GetInterp(interp, objv[4]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[4]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}
	Tcl_RegisterChannel(childInterp, chan);
	Tcl_RegisterChannel(slaveInterp, chan);
	if (index == OPT_TRANSFER) {
	    /*
	     * When transferring, as opposed to sharing, we must unhitch the
	     * channel from the interpreter where it started.
	     */

	    if (Tcl_UnregisterChannel(parentInterp, chan) != TCL_OK) {
		Tcl_TransferResult(parentInterp, TCL_OK, interp);
	    if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
		TclTransferResult(masterInterp, TCL_OK, interp);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    }
    case OPT_TARGET: {
	Tcl_Interp *slaveInterp;
	InterpInfo *iiPtr;
	Tcl_HashEntry *hPtr;
	Alias *aliasPtr;
	const char *aliasName;
	char *aliasName;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "path alias");
	    return TCL_ERROR;
	}

	childInterp = GetInterp(interp, objv[2]);
	if (childInterp == NULL) {
	slaveInterp = GetInterp(interp, objv[2]);
	if (slaveInterp == NULL) {
	    return TCL_ERROR;
	}

	aliasName = TclGetString(objv[3]);

	iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo;
	hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
	iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;
	hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
	if (hPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    Tcl_AppendResult(interp, "alias \"", aliasName, "\" in path \"",
		    "alias \"%s\" in path \"%s\" not found",
		    aliasName, TclGetString(objv[2])));
		    Tcl_GetString(objv[2]), "\" not found", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName,
		    NULL);
	    return TCL_ERROR;
	}
	aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
	aliasPtr = Tcl_GetHashValue(hPtr);
	if (Tcl_GetInterpPath(interp, aliasPtr->targetInterp) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "target interpreter for alias \"%s\" in path \"%s\" is "
		    "not my descendant", aliasName, TclGetString(objv[2])));
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "target interpreter for alias \"",
		    aliasName, "\" in path \"", Tcl_GetString(objv[2]),
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "TARGETSHROUDED", NULL);
		    "\" is not my descendant", NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    }
    return TCL_OK;
}
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
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
1140
1141

1142
1143

1144
1145
1146
1147
1148
1149
1150
1151







-
+






-
-
+
+





-
+




-
+
+





-
-
+
+




-
+





-
+

-
+







 *
 *	Creates an alias between two interpreters.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates a new alias, manipulates the result field of childInterp.
 *	Creates a new alias, manipulates the result field of slaveInterp.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CreateAlias(
    Tcl_Interp *childInterp,	/* Interpreter for source command. */
    const char *childCmd,	/* Command to install in child. */
    Tcl_Interp *slaveInterp,	/* Interpreter for source command. */
    const char *slaveCmd,	/* Command to install in slave. */
    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
    const char *targetCmd,	/* Name of target command. */
    int argc,			/* How many additional arguments? */
    const char *const *argv)	/* These are the additional args. */
{
    Tcl_Obj *childObjPtr, *targetObjPtr;
    Tcl_Obj *slaveObjPtr, *targetObjPtr;
    Tcl_Obj **objv;
    int i;
    int result;

    objv = (Tcl_Obj **)TclStackAlloc(childInterp, sizeof(Tcl_Obj *) * argc);
    objv = (Tcl_Obj **)
	    TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
    for (i = 0; i < argc; i++) {
	objv[i] = Tcl_NewStringObj(argv[i], -1);
	Tcl_IncrRefCount(objv[i]);
    }

    childObjPtr = Tcl_NewStringObj(childCmd, -1);
    Tcl_IncrRefCount(childObjPtr);
    slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
    Tcl_IncrRefCount(slaveObjPtr);

    targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
    Tcl_IncrRefCount(targetObjPtr);

    result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
    result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
	    targetObjPtr, argc, objv);

    for (i = 0; i < argc; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    TclStackFree(childInterp, objv);
    TclStackFree(slaveInterp, objv);
    Tcl_DecrRefCount(targetObjPtr);
    Tcl_DecrRefCount(childObjPtr);
    Tcl_DecrRefCount(slaveObjPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
-
+
+





-
+


-
-
+
+




-
+


-
+







 *	Creates a new alias.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CreateAliasObj(
    Tcl_Interp *childInterp,	/* Interpreter for source command. */
    const char *childCmd,	/* Command to install in child. */
    Tcl_Interp *slaveInterp,	/* Interpreter for source command. */
    const char *slaveCmd,	/* Command to install in slave. */
    Tcl_Interp *targetInterp,	/* Interpreter for target command. */
    const char *targetCmd,	/* Name of target command. */
    int objc,			/* How many additional arguments? */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Tcl_Obj *childObjPtr, *targetObjPtr;
    Tcl_Obj *slaveObjPtr, *targetObjPtr;
    int result;

    childObjPtr = Tcl_NewStringObj(childCmd, -1);
    Tcl_IncrRefCount(childObjPtr);
    slaveObjPtr = Tcl_NewStringObj(slaveCmd, -1);
    Tcl_IncrRefCount(slaveObjPtr);

    targetObjPtr = Tcl_NewStringObj(targetCmd, -1);
    Tcl_IncrRefCount(targetObjPtr);

    result = AliasCreate(childInterp, childInterp, targetInterp, childObjPtr,
    result = AliasCreate(slaveInterp, slaveInterp, targetInterp, slaveObjPtr,
	    targetObjPtr, objc, objv);

    Tcl_DecrRefCount(childObjPtr);
    Tcl_DecrRefCount(slaveObjPtr);
    Tcl_DecrRefCount(targetObjPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+

-
+
-



-
+














-
+







{
    InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
    Tcl_HashEntry *hPtr;
    Alias *aliasPtr;
    int i, objc;
    Tcl_Obj **objv;

    hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
    hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
		"alias \"%s\" not found", aliasName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
	return TCL_ERROR;
    }
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    aliasPtr = Tcl_GetHashValue(hPtr);
    objc = aliasPtr->objc;
    objv = &aliasPtr->objPtr;

    if (targetInterpPtr != NULL) {
	*targetInterpPtr = aliasPtr->targetInterp;
    }
    if (targetNamePtr != NULL) {
	*targetNamePtr = TclGetString(objv[0]);
    }
    if (argcPtr != NULL) {
	*argcPtr = objc - 1;
    }
    if (argvPtr != NULL) {
	*argvPtr = (const char **)
		Tcl_Alloc(sizeof(const char *) * (objc - 1));
		ckalloc((unsigned) sizeof(const char *) * (objc - 1));
	for (i = 1; i < objc; i++) {
	    (*argvPtr)[i - 1] = TclGetString(objv[i]);
	}
    }
    return TCL_OK;
}

1364
1365
1366
1367
1368
1369
1370
1371

1372
1373

1374
1375
1376
1377
1378

1379
1380
1381
1382
1383
1384
1385
1277
1278
1279
1280
1281
1282
1283

1284
1285

1286

1287
1288
1289

1290
1291
1292
1293
1294
1295
1296
1297







-
+

-
+
-



-
+







{
    InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;
    Tcl_HashEntry *hPtr;
    Alias *aliasPtr;
    int objc;
    Tcl_Obj **objv;

    hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName);
    hPtr = Tcl_FindHashEntry(&iiPtr->slave.aliasTable, aliasName);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found", NULL);
		"alias \"%s\" not found", aliasName));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, NULL);
	return TCL_ERROR;
    }
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    aliasPtr = Tcl_GetHashValue(hPtr);
    objc = aliasPtr->objc;
    objv = &aliasPtr->objPtr;

    if (targetInterpPtr != NULL) {
	*targetInterpPtr = aliasPtr->targetInterp;
    }
    if (targetNamePtr != NULL) {
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
1458
1459

1460
1461
1462
1463
1464
1465



1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480


1481
1482

1483
1484
1485
1486
1487
1488
1489
1490
1491
1492

1493
1494
1495
1496

1497


1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512

1513
1514
1515
1516
1517
1518
1519
1520

1521
1522

1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533


1534
1535
1536

1537

1538
1539
1540

1541
1542
1543
1544
1545
1546
1547
1548
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


1596
1597
1598
1599
1600
1601
1602
1603

1604
1605
1606

1607
1608
1609

1610
1611
1612
1613
1614
1615
1616
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
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
1439
1440
1441


1442
1443
1444
1445
1446
1447

1448
1449
1450

1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462


1463
1464
1465









1466
1467
1468
1469



1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486

1487
1488
1489
1490

1491
1492

1493
1494
1495
1496
1497
1498


1499
1500
1501
1502
1503
1504
1505
1506
1507

1508
1509
1510

1511
1512
1513

1514
1515
1516
1517
1518
1519
1520
1521







-
+
-









-
+











-
+



-
-
-
+
+
+












-
-
-
+
+
-
-
+









-
+
-


-
+

+
+














-
+







-
+

-
+









-
-
+
+



+
-
+


-
+











-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+
+















-
+



-
+

-
+





-
-
+
+







-
+


-
+


-
+







    Command *aliasCmdPtr;

    /*
     * If we are not creating or renaming an alias, then it is always OK to
     * create or rename the command.
     */

    if (cmdPtr->objProc != TclAliasObjCmd
    if (cmdPtr->objProc != AliasObjCmd) {
	    && cmdPtr->objProc != TclLocalAliasObjCmd) {
	return TCL_OK;
    }

    /*
     * OK, we are dealing with an alias, so traverse the chain of aliases. If
     * we encounter the alias we are defining (or renaming to) any in the
     * chain then we have a loop.
     */

    aliasPtr = (Alias *)cmdPtr->objClientData;
    aliasPtr = (Alias *) cmdPtr->objClientData;
    nextAliasPtr = aliasPtr;
    while (1) {
	Tcl_Obj *cmdNamePtr;

	/*
	 * If the target of the next alias in the chain is the same as the
	 * source alias, we have a loop.
	 */

	if (Tcl_InterpDeleted(nextAliasPtr->targetInterp)) {
	    /*
	     * The child interpreter can be deleted while creating the alias.
	     * The slave interpreter can be deleted while creating the alias.
	     * [Bug #641195]
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot define or rename alias \"%s\": interpreter deleted",
		    Tcl_GetCommandName(cmdInterp, cmd)));
	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
		    Tcl_GetCommandName(cmdInterp, cmd),
		    "\": interpreter deleted", NULL);
	    return TCL_ERROR;
	}
	cmdNamePtr = nextAliasPtr->objPtr;
	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
		TclGetString(cmdNamePtr),
		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
		/*flags*/ 0);
	if (aliasCmd == NULL) {
	    return TCL_OK;
	}
	aliasCmdPtr = (Command *) aliasCmd;
	if (aliasCmdPtr == cmdPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot define or rename alias \"%s\": would create a loop",
		    Tcl_GetCommandName(cmdInterp, cmd)));
	    Tcl_AppendResult(interp, "cannot define or rename alias \"",
		    Tcl_GetCommandName(cmdInterp, cmd),
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "ALIASLOOP", NULL);
		    "\": would create a loop", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Otherwise, follow the chain one step further. See if the target
	 * command is an alias - if so, follow the loop to its target command.
	 * Otherwise we do not have a loop.
	 */

	if (aliasCmdPtr->objProc != TclAliasObjCmd
	if (aliasCmdPtr->objProc != AliasObjCmd) {
		&& aliasCmdPtr->objProc != TclLocalAliasObjCmd) {
	    return TCL_OK;
	}
	nextAliasPtr = (Alias *)aliasCmdPtr->objClientData;
	nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
    }

    /* NOTREACHED */
}

/*
 *----------------------------------------------------------------------
 *
 * AliasCreate --
 *
 *	Helper function to do the work to actually create an alias.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	An alias command is created and entered into the alias table for the
 *	child interpreter.
 *	slave interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
AliasCreate(
    Tcl_Interp *interp,		/* Interp for error reporting. */
    Tcl_Interp *childInterp,	/* Interp where alias cmd will live or from
    Tcl_Interp *slaveInterp,	/* Interp where alias cmd will live or from
				 * which alias will be deleted. */
    Tcl_Interp *parentInterp,	/* Interp in which target command will be
    Tcl_Interp *masterInterp,	/* Interp in which target command will be
				 * invoked. */
    Tcl_Obj *namePtr,		/* Name of alias cmd. */
    Tcl_Obj *targetNamePtr,	/* Name of target cmd. */
    int objc,			/* Additional arguments to store */
    Tcl_Obj *const objv[])	/* with alias. */
{
    Alias *aliasPtr;
    Tcl_HashEntry *hPtr;
    Target *targetPtr;
    Child *childPtr;
    Parent *parentPtr;
    Slave *slavePtr;
    Master *masterPtr;
    Tcl_Obj **prefv;
    int isNew, i;

    aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
    aliasPtr = (Alias *)Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *));
	    + objc * sizeof(Tcl_Obj *)));
    aliasPtr->token = namePtr;
    Tcl_IncrRefCount(aliasPtr->token);
    aliasPtr->targetInterp = parentInterp;
    aliasPtr->targetInterp = masterInterp;

    aliasPtr->objc = objc + 1;
    prefv = &aliasPtr->objPtr;

    *prefv = targetNamePtr;
    Tcl_IncrRefCount(targetNamePtr);
    for (i = 0; i < objc; i++) {
	*(++prefv) = objv[i];
	Tcl_IncrRefCount(objv[i]);
    }

    Tcl_Preserve(childInterp);
    Tcl_Preserve(parentInterp);
    Tcl_Preserve(slaveInterp);
    Tcl_Preserve(masterInterp);

    if (childInterp == parentInterp) {
	aliasPtr->childCmd = Tcl_NRCreateCommand(childInterp,
		TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
		aliasPtr, AliasObjCmdDeleteProc);
    } else {
	aliasPtr->childCmd = Tcl_CreateObjCommand(childInterp,
		TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
		AliasObjCmdDeleteProc);
    }
    aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
	    TclGetString(namePtr), AliasObjCmd, aliasPtr,
	    AliasObjCmdDeleteProc);


    if (TclPreventAliasLoop(interp, childInterp,
	    aliasPtr->childCmd) != TCL_OK) {
    if (TclPreventAliasLoop(interp, slaveInterp,
	    aliasPtr->slaveCmd) != TCL_OK) {
	/*
	 * Found an alias loop! The last call to Tcl_CreateObjCommand made the
	 * alias point to itself. Delete the command and its alias record. Be
	 * careful to wipe out its client data first, so the command doesn't
	 * try to delete itself.
	 */

	Command *cmdPtr;

	Tcl_DecrRefCount(aliasPtr->token);
	Tcl_DecrRefCount(targetNamePtr);
	for (i = 0; i < objc; i++) {
	    Tcl_DecrRefCount(objv[i]);
	}

	cmdPtr = (Command *) aliasPtr->childCmd;
	cmdPtr = (Command *) aliasPtr->slaveCmd;
	cmdPtr->clientData = NULL;
	cmdPtr->deleteProc = NULL;
	cmdPtr->deleteData = NULL;
	Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);
	Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);

	Tcl_Free(aliasPtr);
	ckfree((char *) aliasPtr);

	/*
	 * The result was already set by TclPreventAliasLoop.
	 */

	Tcl_Release(childInterp);
	Tcl_Release(parentInterp);
	Tcl_Release(slaveInterp);
	Tcl_Release(masterInterp);
	return TCL_ERROR;
    }

    /*
     * Make an entry in the alias table. If it already exists, retry.
     */

    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    while (1) {
	Tcl_Obj *newToken;
	const char *string;
	char *string;

	string = TclGetString(aliasPtr->token);
	hPtr = Tcl_CreateHashEntry(&childPtr->aliasTable, string, &isNew);
	hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
	if (isNew != 0) {
	    break;
	}

	/*
	 * The alias name cannot be used as unique token, it is already taken.
	 * We can produce a unique token by prepending "::" repeatedly. This
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
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
1543
1544
1545
1546
1547
1548
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
1596

1597
1598
1599
1600
1601


1602
1603
1604


1605
1606
1607
1608
1609
1610


1611
1612
1613
1614
1615
1616
1617
1618
1619







-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
+




-
-
+
+








-
+





-
+







-
+


-
+




-
+




-
-
+
+

-
-
+
+




-
-
+
+







     * because the alias may be pointing at a renamed alias, as in:
     *
     * interp alias {} foo {} bar		# Create an alias "foo"
     * rename foo zop				# Now rename the alias
     * interp alias {} foo {} zop		# Now recreate "foo"...
     */

    targetPtr = (Target *)Tcl_Alloc(sizeof(Target));
    targetPtr->childCmd = aliasPtr->childCmd;
    targetPtr->childInterp = childInterp;
    targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
    targetPtr->slaveCmd = aliasPtr->slaveCmd;
    targetPtr->slaveInterp = slaveInterp;

    parentPtr = &((InterpInfo*) ((Interp*) parentInterp)->interpInfo)->parent;
    targetPtr->nextPtr = parentPtr->targetsPtr;
    masterPtr = &((InterpInfo *) ((Interp*) masterInterp)->interpInfo)->master;
    targetPtr->nextPtr = masterPtr->targetsPtr;
    targetPtr->prevPtr = NULL;
    if (parentPtr->targetsPtr != NULL) {
	parentPtr->targetsPtr->prevPtr = targetPtr;
    if (masterPtr->targetsPtr != NULL) {
	masterPtr->targetsPtr->prevPtr = targetPtr;
    }
    parentPtr->targetsPtr = targetPtr;
    masterPtr->targetsPtr = targetPtr;
    aliasPtr->targetPtr = targetPtr;

    Tcl_SetObjResult(interp, aliasPtr->token);

    Tcl_Release(childInterp);
    Tcl_Release(parentInterp);
    Tcl_Release(slaveInterp);
    Tcl_Release(masterInterp);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasDelete --
 *
 *	Deletes the given alias from the child interpreter given.
 *	Deletes the given alias from the slave interpreter given.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes the alias from the child interpreter.
 *	Deletes the alias from the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
AliasDelete(
    Tcl_Interp *interp,		/* Interpreter for result & errors. */
    Tcl_Interp *childInterp,	/* Interpreter containing alias. */
    Tcl_Interp *slaveInterp,	/* Interpreter containing alias. */
    Tcl_Obj *namePtr)		/* Name of alias to delete. */
{
    Child *childPtr;
    Slave *slavePtr;
    Alias *aliasPtr;
    Tcl_HashEntry *hPtr;

    /*
     * If the alias has been renamed in the child, the parent can still use
     * If the alias has been renamed in the slave, the master can still use
     * the original name (with which it was created) to find the alias to
     * delete it.
     */

    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
    hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr));
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, TclGetString(namePtr));
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"alias \"%s\" not found", TclGetString(namePtr)));
	Tcl_AppendResult(interp, "alias \"", TclGetString(namePtr),
		"\" not found", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS",
		TclGetString(namePtr), NULL);
	return TCL_ERROR;
    }
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    Tcl_DeleteCommandFromToken(childInterp, aliasPtr->childCmd);
    aliasPtr = Tcl_GetHashValue(hPtr);
    Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasDescribe --
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

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
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
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
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
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
1772
1773
1774
1775
1776
1777
1778
1779







-
+


-
+





-
+




-
-
+
+



-
+










-
+













-
+



-
+

-
+

-
-
+

-
+

-
+









-
+

-
+


-
+


-
-
-
-
-












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+






-
+





-
+












-
+


-
-
+
+












-
+
+
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
AliasDescribe(
    Tcl_Interp *interp,		/* Interpreter for result & errors. */
    Tcl_Interp *childInterp,	/* Interpreter containing alias. */
    Tcl_Interp *slaveInterp,	/* Interpreter containing alias. */
    Tcl_Obj *namePtr)		/* Name of alias to describe. */
{
    Child *childPtr;
    Slave *slavePtr;
    Tcl_HashEntry *hPtr;
    Alias *aliasPtr;
    Tcl_Obj *prefixPtr;

    /*
     * If the alias has been renamed in the child, the parent can still use
     * If the alias has been renamed in the slave, the master can still use
     * the original name (with which it was created) to find the alias to
     * describe it.
     */

    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
    hPtr = Tcl_FindHashEntry(&childPtr->aliasTable, TclGetString(namePtr));
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    hPtr = Tcl_FindHashEntry(&slavePtr->aliasTable, Tcl_GetString(namePtr));
    if (hPtr == NULL) {
	return TCL_OK;
    }
    aliasPtr = (Alias *)Tcl_GetHashValue(hPtr);
    aliasPtr = Tcl_GetHashValue(hPtr);
    prefixPtr = Tcl_NewListObj(aliasPtr->objc, &aliasPtr->objPtr);
    Tcl_SetObjResult(interp, prefixPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AliasList --
 *
 *	Computes a list of aliases defined in a child interpreter.
 *	Computes a list of aliases defined in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
AliasList(
    Tcl_Interp *interp,		/* Interp for data return. */
    Tcl_Interp *childInterp)	/* Interp whose aliases to compute. */
    Tcl_Interp *slaveInterp)	/* Interp whose aliases to compute. */
{
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch hashSearch;
    Tcl_Obj *resultPtr;
    Tcl_Obj *resultPtr = Tcl_NewObj();
    Alias *aliasPtr;
    Child *childPtr;
    Slave *slavePtr;

    TclNewObj(resultPtr);
    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

    entryPtr = Tcl_FirstHashEntry(&childPtr->aliasTable, &hashSearch);
    entryPtr = Tcl_FirstHashEntry(&slavePtr->aliasTable, &hashSearch);
    for ( ; entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&hashSearch)) {
	aliasPtr = (Alias *)Tcl_GetHashValue(entryPtr);
	aliasPtr = Tcl_GetHashValue(entryPtr);
	Tcl_ListObjAppendElement(NULL, resultPtr, aliasPtr->token);
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclAliasObjCmd, TclLocalAliasObjCmd --
 * AliasObjCmd --
 *
 *	This is the function that services invocations of aliases in a child
 *	This is the function that services invocations of aliases in a slave
 *	interpreter. One such command exists for each alias. When invoked,
 *	this function redirects the invocation to the target command in the
 *	parent interpreter as designated by the Alias record associated with
 *	master interpreter as designated by the Alias record associated with
 *	this command.
 *
 *	TclLocalAliasObjCmd is a stripped down version used when the source
 *	and target interpreters of the alias are the same. That lets a number
 *	of safety precautions be avoided: the state is much more precisely
 *	known.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Causes forwarding of the invocation; all possible side effects may
 *	occur as a result of invoking the command to which the invocation is
 *	forwarded.
 *
 *----------------------------------------------------------------------
 */

static int
AliasNRCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
    Alias *aliasPtr = (Alias *)clientData;
    int prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *listPtr;
    List *listRep;
    int flags = TCL_EVAL_INVOKE;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the target interp's global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;

    listPtr = Tcl_NewListObj(cmdc, NULL);
    listRep = ListRepPtr(listPtr);
    listRep->elemCount = cmdc;
    cmdv = &listRep->elements;

    prefv = &aliasPtr->objPtr;
    memcpy(cmdv, prefv, (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, ((objc-1) * sizeof(Tcl_Obj *)));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:
     * only the source command should show, not the full target prefix.
     */

    if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    TclSkipTailcall(interp);
    return Tcl_NREvalObj(interp, listPtr, flags);
}

int
TclAliasObjCmd(
AliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    Alias *aliasPtr = clientData;
    Tcl_Interp *targetInterp = aliasPtr->targetInterp;
    int result, prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
    Interp *tPtr = (Interp *) targetInterp;
    int isRootEnsemble;
    int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the target interp's global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = (Tcl_Obj **)TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
	cmdv = (Tcl_Obj **) TclStackAlloc(interp, cmdc*(int)sizeof(Tcl_Obj*));
    }

    memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
    memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));
    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));

    Tcl_ResetResult(targetInterp);

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:
     * only the source command should show, not the full target prefix.
     */

    isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)tPtr, 1, prefc, objv);
    if (isRootEnsemble) {
	tPtr->ensembleRewrite.sourceObjs = objv;
	tPtr->ensembleRewrite.numRemovedObjs = 1;
	tPtr->ensembleRewrite.numInsertedObjs = prefc;
    } else {
	tPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
    }

    /*
     * Protect the target interpreter if it isn't the same as the source
     * interpreter so that we can continue to work with it after the target
     * command completes.
     */

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
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
2658
2659
2660
2661
2662

2663
2664
2665

2666
2667

2668
2669
2670
2671
2672
2673
2674
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
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
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







-
+
+
+









-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
+
















-
+












-
+






-
-
+
+

-
+





-
-
+
+





-
+

-
-
+
+

-
-
+
+








-
+





-
+

-
-
+
+


-
+

-
-
+
+


-
+





-
+

-
+











-
+

-
+


-
+

-
-
+
+


-
+





-
+

-
+


-
+








-
-
+
+

-
+




-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
+

















-
+




-
+
-






-
+


-
-
-
+
+








-
+


-
+















-
+



-
+







-
-
+
+





-
-
+
+





-
-
+
+









-
+








-
+






-
+

-
+








-
-
+
-
-
+


-
+

-
+






-
+

-
-
+
+







-
+





-
+

-
+


-
-
-
+
+
+

-
+







-
+





-
+

-
+





-
+


-
-
+
+


-
-
+
+
-



-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+





-
-
+
+


-
+



-
+




-
+



-
+






-
+




-
+








-
+







-
+


-
+

-
+







-
+


-
+










-
-
-
-
-
-
-
-
-
-

-
-
+
+




-
+

-
-
-
-
+
+
+
+
-

-
-
-
-
+
+
+
+
-


-
-
+
+











-
+



-
+



-
+


-
+



-
+






-
+





-
+


-
+






-
+





-
+





-
+





-
+





-
+





-
+


-
+

-
+







    result = Tcl_EvalObjv(targetInterp, cmdc, cmdv, TCL_EVAL_INVOKE);

    /*
     * Clean up the ensemble rewrite info if we set it in the first place.
     */

    if (isRootEnsemble) {
	TclResetRewriteEnsemble((Tcl_Interp *)tPtr, 1);
	tPtr->ensembleRewrite.sourceObjs = NULL;
	tPtr->ensembleRewrite.numRemovedObjs = 0;
	tPtr->ensembleRewrite.numInsertedObjs = 0;
    }

    /*
     * If it was a cross-interpreter alias, we need to transfer the result
     * back to the source interpreter and release the lock we previously set
     * on the target interpreter.
     */

    if (targetInterp != interp) {
	Tcl_TransferResult(targetInterp, result, interp);
	TclTransferResult(targetInterp, result, interp);
	Tcl_Release(targetInterp);
    }

    for (i=0; i<cmdc; i++) {
	Tcl_DecrRefCount(cmdv[i]);
    }
    if (cmdv != cmdArr) {
	TclStackFree(interp, cmdv);
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

int
TclLocalAliasObjCmd(
    ClientData clientData,	/* Alias record. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument vector. */
{
#define ALIAS_CMDV_PREALLOC 10
    Alias *aliasPtr = (Alias *)clientData;
    int result, prefc, cmdc, i;
    Tcl_Obj **prefv, **cmdv;
    Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
    Interp *iPtr = (Interp *) interp;
    int isRootEnsemble;

    /*
     * Append the arguments to the command prefix and invoke the command in
     * the global namespace.
     */

    prefc = aliasPtr->objc;
    prefv = &aliasPtr->objPtr;
    cmdc = prefc + objc - 1;
    if (cmdc <= ALIAS_CMDV_PREALLOC) {
	cmdv = cmdArr;
    } else {
	cmdv = (Tcl_Obj **)TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
    }

    memcpy(cmdv, prefv, prefc * sizeof(Tcl_Obj *));
    memcpy(cmdv+prefc, objv+1, (objc-1) * sizeof(Tcl_Obj *));

    for (i=0; i<cmdc; i++) {
	Tcl_IncrRefCount(cmdv[i]);
    }

    /*
     * Use the ensemble rewriting machinery to ensure correct error messages:
     * only the source command should show, not the full target prefix.
     */

    isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)iPtr, 1, prefc, objv);

    /*
     * Execute the target command in the target interpreter.
     */

    result = Tcl_EvalObjv(interp, cmdc, cmdv, TCL_EVAL_INVOKE);

    /*
     * Clean up the ensemble rewrite info if we set it in the first place.
     */

    if (isRootEnsemble) {
	TclResetRewriteEnsemble((Tcl_Interp *)iPtr, 1);
    }

    for (i=0; i<cmdc; i++) {
	Tcl_DecrRefCount(cmdv[i]);
    }
    if (cmdv != cmdArr) {
	TclStackFree(interp, cmdv);
    }
    return result;
#undef ALIAS_CMDV_PREALLOC
}

/*
 *----------------------------------------------------------------------
 *
 * AliasObjCmdDeleteProc --
 *
 *	Is invoked when an alias command is deleted in a child. Cleans up all
 *	Is invoked when an alias command is deleted in a slave. Cleans up all
 *	storage associated with this alias.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the alias record and its entry in the alias table for the
 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
AliasObjCmdDeleteProc(
    ClientData clientData)	/* The alias record for this alias. */
{
    Alias *aliasPtr = (Alias *)clientData;
    Alias *aliasPtr = clientData;
    Target *targetPtr;
    int i;
    Tcl_Obj **objv;

    Tcl_DecrRefCount(aliasPtr->token);
    objv = &aliasPtr->objPtr;
    for (i = 0; i < aliasPtr->objc; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    Tcl_DeleteHashEntry(aliasPtr->aliasEntryPtr);

    /*
     * Splice the target record out of the target interpreter's parent list.
     * Splice the target record out of the target interpreter's master list.
     */

    targetPtr = aliasPtr->targetPtr;
    if (targetPtr->prevPtr != NULL) {
	targetPtr->prevPtr->nextPtr = targetPtr->nextPtr;
    } else {
	Parent *parentPtr = &((InterpInfo *) ((Interp *)
		aliasPtr->targetInterp)->interpInfo)->parent;
	Master *masterPtr = &((InterpInfo *) ((Interp *)
		aliasPtr->targetInterp)->interpInfo)->master;

	parentPtr->targetsPtr = targetPtr->nextPtr;
	masterPtr->targetsPtr = targetPtr->nextPtr;
    }
    if (targetPtr->nextPtr != NULL) {
	targetPtr->nextPtr->prevPtr = targetPtr->prevPtr;
    }

    Tcl_Free(targetPtr);
    Tcl_Free(aliasPtr);
    ckfree((char *) targetPtr);
    ckfree((char *) aliasPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateChild --
 * Tcl_CreateSlave --
 *
 *	Creates a child interpreter. The childPath argument denotes the name
 *	of the new child relative to the current interpreter; the child is a
 *	Creates a slave interpreter. The slavePath argument denotes the name
 *	of the new slave relative to the current interpreter; the slave is a
 *	direct descendant of the one-before-last component of the path,
 *	e.g. it is a descendant of the current interpreter if the childPath
 *	argument contains only one component. Optionally makes the child
 *	e.g. it is a descendant of the current interpreter if the slavePath
 *	argument contains only one component. Optionally makes the slave
 *	interpreter safe.
 *
 * Results:
 *	Returns the interpreter structure created, or NULL if an error
 *	occurred.
 *
 * Side effects:
 *	Creates a new interpreter and a new interpreter object command in the
 *	interpreter indicated by the childPath argument.
 *	interpreter indicated by the slavePath argument.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
Tcl_CreateChild(
Tcl_CreateSlave(
    Tcl_Interp *interp,		/* Interpreter to start search at. */
    const char *childPath,	/* Name of child to create. */
    int isSafe)			/* Should new child be "safe" ? */
    const char *slavePath,	/* Name of slave to create. */
    int isSafe)			/* Should new slave be "safe" ? */
{
    Tcl_Obj *pathPtr;
    Tcl_Interp *childInterp;
    Tcl_Interp *slaveInterp;

    pathPtr = Tcl_NewStringObj(childPath, -1);
    childInterp = ChildCreate(interp, pathPtr, isSafe);
    pathPtr = Tcl_NewStringObj(slavePath, -1);
    slaveInterp = SlaveCreate(interp, pathPtr, isSafe);
    Tcl_DecrRefCount(pathPtr);

    return childInterp;
    return slaveInterp;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetChild --
 * Tcl_GetSlave --
 *
 *	Finds a child interpreter by its path name.
 *	Finds a slave interpreter by its path name.
 *
 * Results:
 *	Returns a Tcl_Interp * for the named interpreter or NULL if not found.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
Tcl_GetChild(
Tcl_GetSlave(
    Tcl_Interp *interp,		/* Interpreter to start search from. */
    const char *childPath)	/* Path of child to find. */
    const char *slavePath)	/* Path of slave to find. */
{
    Tcl_Obj *pathPtr;
    Tcl_Interp *childInterp;
    Tcl_Interp *slaveInterp;

    pathPtr = Tcl_NewStringObj(childPath, -1);
    childInterp = GetInterp(interp, pathPtr);
    pathPtr = Tcl_NewStringObj(slavePath, -1);
    slaveInterp = GetInterp(interp, pathPtr);
    Tcl_DecrRefCount(pathPtr);

    return childInterp;
    return slaveInterp;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetParent --
 * Tcl_GetMaster --
 *
 *	Finds the parent interpreter of a child interpreter.
 *	Finds the master interpreter of a slave interpreter.
 *
 * Results:
 *	Returns a Tcl_Interp * for the parent interpreter or NULL if none.
 *	Returns a Tcl_Interp * for the master interpreter or NULL if none.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Interp *
Tcl_GetParent(
    Tcl_Interp *interp)		/* Get the parent of this interpreter. */
Tcl_GetMaster(
    Tcl_Interp *interp)		/* Get the master of this interpreter. */
{
    Child *childPtr;		/* Child record of this interpreter. */
    Slave *slavePtr;		/* Slave record of this interpreter. */

    if (interp == NULL) {
	return NULL;
    }
    childPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->child;
    slavePtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->slave;
    return childPtr->parentInterp;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetChildCancelFlags --
 *
 *	This function marks all child interpreters belonging to a given
 *	interpreter as being canceled or not canceled, depending on the
 *	provided flags.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclSetChildCancelFlags(
    Tcl_Interp *interp,		/* Set cancel flags of this interpreter. */
    int flags,			/* Collection of OR-ed bits that control
				 * the cancellation of the script. Only
				 * TCL_CANCEL_UNWIND is currently
				 * supported. */
    int force)			/* Non-zero to ignore numLevels for the purpose
				 * of resetting the cancellation flags. */
{
    Parent *parentPtr;		/* Parent record of given interpreter. */
    Tcl_HashEntry *hPtr;	/* Search element. */
    Tcl_HashSearch hashSearch;	/* Search variable. */
    Child *childPtr;		/* Child record of interpreter. */
    Interp *iPtr;

    if (interp == NULL) {
	return;
    return slavePtr->masterInterp;
    }

    flags &= (CANCELED | TCL_CANCEL_UNWIND);

    parentPtr = &((InterpInfo *) ((Interp *) interp)->interpInfo)->parent;

    hPtr = Tcl_FirstHashEntry(&parentPtr->childTable, &hashSearch);
    for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) {
	childPtr = (Child *)Tcl_GetHashValue(hPtr);
	iPtr = (Interp *) childPtr->childInterp;

	if (iPtr == NULL) {
	    continue;
	}

	if (flags == 0) {
	    TclResetCancellation((Tcl_Interp *) iPtr, force);
	} else {
	    TclSetCancelFlags(iPtr, flags);
	}

	/*
	 * Now, recursively handle this for the children of this child
	 * interpreter.
	 */

	TclSetChildCancelFlags((Tcl_Interp *) iPtr, flags, force);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetInterpPath --
 *
 *	Sets the result of the asking interpreter to a proper Tcl list
 *	containing the names of interpreters between the asking and target
 *	interpreters. The target interpreter must be either the same as the
 *	asking interpreter or one of its children (including recursively).
 *	asking interpreter or one of its slaves (including recursively).
 *
 * Results:
 *	TCL_OK if the target interpreter is the same as, or a descendant of,
 *	the asking interpreter; TCL_ERROR else. This way one can distinguish
 *	between the case where the asking and target interps are the same (an
 *	empty list is the result, and TCL_OK is returned) and when the target
 *	is not a descendant of the asking interpreter (in which case the Tcl
 *	result is an error message and the function returns TCL_ERROR).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetInterpPath(
    Tcl_Interp *interp,	/* Interpreter to start search from. */
    Tcl_Interp *askingInterp,	/* Interpreter to start search from. */
    Tcl_Interp *targetInterp)	/* Interpreter to find. */
{
    InterpInfo *iiPtr;

    if (targetInterp == interp) {
    if (targetInterp == askingInterp) {
	Tcl_SetObjResult(interp, Tcl_NewObj());
	return TCL_OK;
    }
    if (targetInterp == NULL) {
	return TCL_ERROR;
    }
    iiPtr = (InterpInfo *) ((Interp *) targetInterp)->interpInfo;
    if (Tcl_GetInterpPath(interp, iiPtr->child.parentInterp) != TCL_OK){
    if (Tcl_GetInterpPath(askingInterp, iiPtr->slave.masterInterp) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
	    Tcl_NewStringObj((const char *)Tcl_GetHashKey(&iiPtr->parent.childTable,
		    iiPtr->child.childEntryPtr), -1));
    Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&iiPtr->master.slaveTable,
	    iiPtr->slave.slaveEntryPtr));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * GetInterp --
 *
 *	Helper function to find a child interpreter given a pathname.
 *	Helper function to find a slave interpreter given a pathname.
 *
 * Results:
 *	Returns the child interpreter known by that name in the calling
 *	Returns the slave interpreter known by that name in the calling
 *	interpreter, or NULL if no interpreter known by that name exists.
 *
 * Side effects:
 *	Assigns to the pointer variable passed in, if not NULL.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Interp *
GetInterp(
    Tcl_Interp *interp,		/* Interp. to start search from. */
    Tcl_Obj *pathPtr)		/* List object containing name of interp. to
				 * be found. */
{
    Tcl_HashEntry *hPtr;	/* Search element. */
    Child *childPtr;		/* Interim child record. */
    Slave *slavePtr;		/* Interim slave record. */
    Tcl_Obj **objv;
    int objc, i;
    Tcl_Interp *searchInterp;	/* Interim storage for interp. to find. */
    InterpInfo *parentInfoPtr;
    InterpInfo *masterInfoPtr;

    if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
	return NULL;
    }

    searchInterp = interp;
    for (i = 0; i < objc; i++) {
	parentInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
	hPtr = Tcl_FindHashEntry(&parentInfoPtr->parent.childTable,
	masterInfoPtr = (InterpInfo *) ((Interp *) searchInterp)->interpInfo;
	hPtr = Tcl_FindHashEntry(&masterInfoPtr->master.slaveTable,
		TclGetString(objv[i]));
	if (hPtr == NULL) {
	    searchInterp = NULL;
	    break;
	}
	childPtr = (Child *)Tcl_GetHashValue(hPtr);
	searchInterp = childPtr->childInterp;
	slavePtr = Tcl_GetHashValue(hPtr);
	searchInterp = slavePtr->slaveInterp;
	if (searchInterp == NULL) {
	    break;
	}
    }
    if (searchInterp == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not find interpreter \"%s\"", TclGetString(pathPtr)));
	Tcl_AppendResult(interp, "could not find interpreter \"",
		TclGetString(pathPtr), "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INTERP",
		TclGetString(pathPtr), NULL);
    }
    return searchInterp;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildBgerror --
 * SlaveBgerror --
 *
 *	Helper function to set/query the background error handling command
 *	prefix of an interp
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	When (objc == 1), childInterp will be set to a new background handler
 *	When (objc == 1), slaveInterp will be set to a new background handler
 *	of objv[0].
 *
 *----------------------------------------------------------------------
 */

static int
ChildBgerror(
SlaveBgerror(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* Interp in which limit is set/queried. */
    Tcl_Interp *slaveInterp,	/* Interp in which limit is set/queried. */
    int objc,			/* Set or Query. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc) {
	int length;

	if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length)
		|| (length < 1)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "cmdPrefix must be list of length >= 1", -1));
	    Tcl_AppendResult(interp, "cmdPrefix must be list of length >= 1",
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
		    "BGERRORFORMAT", NULL);
		    NULL);
	    return TCL_ERROR;
	}
	TclSetBgErrorHandler(childInterp, objv[0]);
	TclSetBgErrorHandler(slaveInterp, objv[0]);
    }
    Tcl_SetObjResult(interp, TclGetBgErrorHandler(childInterp));
    Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildCreate --
 * SlaveCreate --
 *
 *	Helper function to do the actual work of creating a child interp and
 *	new object command. Also optionally makes the new child interpreter
 *	Helper function to do the actual work of creating a slave interp and
 *	new object command. Also optionally makes the new slave interpreter
 *	"safe".
 *
 * Results:
 *	Returns the new Tcl_Interp * if successful or NULL if not. If failed,
 *	the result of the invoking interpreter contains an error message.
 *
 * Side effects:
 *	Creates a new child interpreter and a new object command.
 *	Creates a new slave interpreter and a new object command.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Interp *
ChildCreate(
SlaveCreate(
    Tcl_Interp *interp,		/* Interp. to start search from. */
    Tcl_Obj *pathPtr,		/* Path (name) of child to create. */
    Tcl_Obj *pathPtr,		/* Path (name) of slave to create. */
    int safe)			/* Should we make it "safe"? */
{
    Tcl_Interp *parentInterp, *childInterp;
    Child *childPtr;
    InterpInfo *parentInfoPtr;
    Tcl_Interp *masterInterp, *slaveInterp;
    Slave *slavePtr;
    InterpInfo *masterInfoPtr;
    Tcl_HashEntry *hPtr;
    const char *path;
    char *path;
    int isNew, objc;
    Tcl_Obj **objv;

    if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
	return NULL;
    }
    if (objc < 2) {
	parentInterp = interp;
	masterInterp = interp;
	path = TclGetString(pathPtr);
    } else {
	Tcl_Obj *objPtr;

	objPtr = Tcl_NewListObj(objc - 1, objv);
	parentInterp = GetInterp(interp, objPtr);
	masterInterp = GetInterp(interp, objPtr);
	Tcl_DecrRefCount(objPtr);
	if (parentInterp == NULL) {
	if (masterInterp == NULL) {
	    return NULL;
	}
	path = TclGetString(objv[objc - 1]);
    }
    if (safe == 0) {
	safe = Tcl_IsSafe(parentInterp);
	safe = Tcl_IsSafe(masterInterp);
    }

    parentInfoPtr = (InterpInfo *) ((Interp *) parentInterp)->interpInfo;
    hPtr = Tcl_CreateHashEntry(&parentInfoPtr->parent.childTable, path,
    masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
    hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path,
	    &isNew);
    if (isNew == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"interpreter named \"%s\" already exists, cannot create",
	Tcl_AppendResult(interp, "interpreter named \"", path,
		"\" already exists, cannot create", NULL);
		path));
	return NULL;
    }

    childInterp = Tcl_CreateInterp();
    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
    childPtr->parentInterp = parentInterp;
    childPtr->childEntryPtr = hPtr;
    childPtr->childInterp = childInterp;
    childPtr->interpCmd = Tcl_NRCreateCommand(parentInterp, path,
	    TclChildObjCmd, NRChildCmd, childInterp, ChildObjCmdDeleteProc);
    Tcl_InitHashTable(&childPtr->aliasTable, TCL_STRING_KEYS);
    Tcl_SetHashValue(hPtr, childPtr);
    Tcl_SetVar2(childInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
    slaveInterp = Tcl_CreateInterp();
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;
    slavePtr->masterInterp = masterInterp;
    slavePtr->slaveEntryPtr = hPtr;
    slavePtr->slaveInterp = slaveInterp;
    slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, path,
	    SlaveObjCmd, slaveInterp, SlaveObjCmdDeleteProc);
    Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
    Tcl_SetHashValue(hPtr, slavePtr);
    Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);

    /*
     * Inherit the recursion limit.
     */

    ((Interp *) childInterp)->maxNestingDepth =
	    ((Interp *) parentInterp)->maxNestingDepth;
    ((Interp *) slaveInterp)->maxNestingDepth =
	    ((Interp *) masterInterp)->maxNestingDepth;

    if (safe) {
	if (Tcl_MakeSafe(childInterp) == TCL_ERROR) {
	if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
	    goto error;
	}
    } else {
	if (Tcl_Init(childInterp) == TCL_ERROR) {
	if (Tcl_Init(slaveInterp) == TCL_ERROR) {
	    goto error;
	}

	/*
	 * This will create the "memory" command in child interpreters if we
	 * This will create the "memory" command in slave interpreters if we
	 * compiled with TCL_MEM_DEBUG, otherwise it does nothing.
	 */

	Tcl_InitMemory(childInterp);
	Tcl_InitMemory(slaveInterp);
    }

    /*
     * Inherit the TIP#143 limits.
     */

    InheritLimitsFromParent(childInterp, parentInterp);
    InheritLimitsFromMaster(slaveInterp, masterInterp);

    /*
     * The [clock] command presents a safe API, but uses unsafe features in
     * its implementation. This means it has to be implemented in safe interps
     * as an alias to a version in the (trusted) parent.
     * as an alias to a version in the (trusted) master.
     */

    if (safe) {
	Tcl_Obj *clockObj;
	int status;

	TclNewLiteralStringObj(clockObj, "clock");
	Tcl_IncrRefCount(clockObj);
	status = AliasCreate(interp, childInterp, parentInterp, clockObj,
	status = AliasCreate(interp, slaveInterp, masterInterp, clockObj,
		clockObj, 0, NULL);
	Tcl_DecrRefCount(clockObj);
	if (status != TCL_OK) {
	    goto error2;
	}
    }

    return childInterp;
    return slaveInterp;

  error:
    Tcl_TransferResult(childInterp, TCL_ERROR, interp);
    TclTransferResult(slaveInterp, TCL_ERROR, interp);
  error2:
    Tcl_DeleteInterp(childInterp);
    Tcl_DeleteInterp(slaveInterp);

    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclChildObjCmd --
 * SlaveObjCmd --
 *
 *	Command to manipulate an interpreter, e.g. to send commands to it to
 *	be evaluated. One such command exists for each child interpreter.
 *	be evaluated. One such command exists for each slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See user documentation for details.
 *
 *----------------------------------------------------------------------
 */

int
TclChildObjCmd(
    ClientData clientData,	/* Child interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRChildCmd, clientData, objc, objv);
}

static int
NRChildCmd(
    ClientData clientData,	/* Child interpreter. */
SlaveObjCmd(
    ClientData clientData,	/* Slave interpreter. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
    Tcl_Interp *slaveInterp = clientData;
    int index;
    static const char *const options[] = {
	"alias",	"aliases",	"bgerror",	"debug",
	"eval",		"expose",	"hide",		"hidden",
	"issafe",	"invokehidden",	"limit",	"marktrusted",
    static const char *options[] = {
	"alias",	"aliases",	"bgerror",	"debug",	"eval",
	"expose",	"hide",		"hidden",	"issafe",
	"invokehidden",	"limit",	"marktrusted",	"recursionlimit", NULL
	"recursionlimit", NULL
    };
    enum childCmdOptionsEnum {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,
	OPT_EVAL,	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,
	OPT_ISSAFE,	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED,
    enum options {
	OPT_ALIAS,	OPT_ALIASES,	OPT_BGERROR,	OPT_DEBUG,	OPT_EVAL,
	OPT_EXPOSE,	OPT_HIDE,	OPT_HIDDEN,	OPT_ISSAFE,
	OPT_INVOKEHIDDEN, OPT_LIMIT,	OPT_MARKTRUSTED, OPT_RECLIMIT
	OPT_RECLIMIT
    };

    if (childInterp == NULL) {
	Tcl_Panic("TclChildObjCmd: interpreter has been deleted");
    if (slaveInterp == NULL) {
	Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum childCmdOptionsEnum) index) {
    switch ((enum options) index) {
    case OPT_ALIAS:
	if (objc > 2) {
	    if (objc == 3) {
		return AliasDescribe(interp, childInterp, objv[2]);
		return AliasDescribe(interp, slaveInterp, objv[2]);
	    }
	    if (TclGetString(objv[3])[0] == '\0') {
		if (objc == 4) {
		    return AliasDelete(interp, childInterp, objv[2]);
		    return AliasDelete(interp, slaveInterp, objv[2]);
		}
	    } else {
		return AliasCreate(interp, childInterp, interp, objv[2],
		return AliasCreate(interp, slaveInterp, interp, objv[2],
			objv[3], objc - 4, objv + 4);
	    }
	}
	Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?arg ...?");
	Tcl_WrongNumArgs(interp, 2, objv, "aliasName ?targetName? ?args..?");
	return TCL_ERROR;
    case OPT_ALIASES:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	return AliasList(interp, childInterp);
	return AliasList(interp, slaveInterp);
    case OPT_BGERROR:
	if (objc != 2 && objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?cmdPrefix?");
	    return TCL_ERROR;
	}
	return ChildBgerror(interp, childInterp, objc - 2, objv + 2);
	return SlaveBgerror(interp, slaveInterp, objc - 2, objv + 2);
    case OPT_DEBUG:
	/*
	 * TIP #378
	 * TIP #378 *
	 * Currently only -frame supported, otherwise ?-option ?value? ...?
	 */
	if (objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-frame ?bool??");
	    return TCL_ERROR;
	}
	return ChildDebugCmd(interp, childInterp, objc - 2, objv + 2);
	return SlaveDebugCmd(interp, slaveInterp, objc - 2, objv + 2);
    case OPT_EVAL:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
	    return TCL_ERROR;
	}
	return ChildEval(interp, childInterp, objc - 2, objv + 2);
	return SlaveEval(interp, slaveInterp, objc - 2, objv + 2);
    case OPT_EXPOSE:
	if ((objc < 3) || (objc > 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
	    return TCL_ERROR;
	}
	return ChildExpose(interp, childInterp, objc - 2, objv + 2);
	return SlaveExpose(interp, slaveInterp, objc - 2, objv + 2);
    case OPT_HIDE:
	if ((objc < 3) || (objc > 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
	    return TCL_ERROR;
	}
	return ChildHide(interp, childInterp, objc - 2, objv + 2);
	return SlaveHide(interp, slaveInterp, objc - 2, objv + 2);
    case OPT_HIDDEN:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	return ChildHidden(interp, childInterp);
	return SlaveHidden(interp, slaveInterp);
    case OPT_ISSAFE:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp)));
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(slaveInterp)));
	return TCL_OK;
    case OPT_INVOKEHIDDEN: {
	int i;
	int i, index;
	const char *namespaceName;
	static const char *const hiddenOptions[] = {
	static const char *hiddenOptions[] = {
	    "-global",	"-namespace",	"--", NULL
	};
	enum hiddenOption {
	    OPT_GLOBAL,	OPT_NAMESPACE,	OPT_LAST
	};

	namespaceName = NULL;
2694
2695
2696
2697
2698
2699
2700
2701

2702
2703
2704
2705

2706
2707
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2722
2723

2724
2725

2726
2727
2728
2729
2730
2731
2732
2733
2734

2735
2736
2737
2738
2739
2740

2741
2742
2743
2744
2745
2746
2747
2748
2749

2750
2751
2752
2753



2754
2755
2756
2757
2758
2759
2760


2761
2762
2763
2764
2765
2766
2767


2768
2769
2770
2771



2772
2773

2774
2775
2776

2777
2778
2779

2780
2781
2782

2783
2784

2785
2786
2787

2788
2789
2790


2791
2792
2793
2794
2795
2796
2797

2798
2799

2800
2801
2802
2803
2804
2805

2806
2807
2808
2809
2810
2811

2812
2813

2814
2815
2816
2817
2818

2819
2820
2821
2822
2823
2824
2825
2826
2827
2828

2829
2830

2831
2832
2833
2834
2835
2836
2837
2838


2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851



2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
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
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
2658

2659
2660

2661
2662
2663
2664
2665
2666
2667
2668
2669

2670
2671
2672
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
2709
2710
2711
2712

2713
2714
2715
2716
2717


2718
2719
2720
2721
2722
2723
2724
2725
2726

2727
2728

2729
2730
2731
2732
2733
2734

2735
2736
2737
2738
2739
2740
2741

2742
2743

2744
2745
2746
2747

2748
2749
2750
2751
2752
2753


2754
2755
2756
2757


2758
2759
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769

2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782

2783
2784

2785
2786

2787
2788
2789
2790
2791


2792
2793
2794
2795
2796
2797

2798
2799
2800
2801
2802
2803
2804
2805
2806
2807

2808
2809

2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821

2822
2823

2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835


2836
2837
2838


2839
2840
2841
2842


2843



2844
2845
2846
2847

2848
2849
2850
2851


2852
2853
2854
2855
2856

2857
2858

2859

















2860
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







-
+



-
+








-
+








-
+

-
+








-
+





-
+








-
+

-
-
-
+
+
+





-
-
+
+





-
-
+
+

-
-
-
+
+
+

-
+


-
+


-
+


-
+

-
+


-
+

-
-
+
+






-
+

-
+





-
+





-
+

-
+




-
+









-
+

-
+






-
-
+
+








-

-
-
-
+
+
+

-














-
+

-
+











-
+

-
+





-
+
-
-
-
-
-
-
-

-
-
-
-
+
+






-
-
-
+
+
+

-
+
-
-
+

-
+

-
+


-
+

-
+






-
+

-
+





-
+






-
+

-
+



-
+





-
-




-
+

-
+








-
+







-
+






-
+

-
+








-
-
+
+
-
-








-
-


-
-
-
+
+
+


-





-
-
+
+







-
+

-
+





-
+






-
+

-
+



-
+





-
-




-
-
+
+








-
+

-
+












-
+

-
+

-
+




-
-
+





-
+









-
+

-
+











-
+

-
+











-
-



-
-
+
+


-
-
+
-
-
-




-
+



-
-
+
+



-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+

-
+






-
+





-
+

-
+






-
-


-
+







	    }
	}
	if (objc - i < 1) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "?-namespace ns? ?-global? ?--? cmd ?arg ..?");
	    return TCL_ERROR;
	}
	return ChildInvokeHidden(interp, childInterp, namespaceName,
	return SlaveInvokeHidden(interp, slaveInterp, namespaceName,
		objc - i, objv + i);
    }
    case OPT_LIMIT: {
	static const char *const limitTypes[] = {
	static const char *limitTypes[] = {
	    "commands", "time", NULL
	};
	enum LimitTypes {
	    LIMIT_TYPE_COMMANDS, LIMIT_TYPE_TIME
	};
	int limitType;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "limitType ?-option value ...?");
	    Tcl_WrongNumArgs(interp, 2, objv, "limitType ?options?");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[2], limitTypes, "limit type", 0,
		&limitType) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum LimitTypes) limitType) {
	case LIMIT_TYPE_COMMANDS:
	    return ChildCommandLimitCmd(interp, childInterp, 3, objc,objv);
	    return SlaveCommandLimitCmd(interp, slaveInterp, 3, objc,objv);
	case LIMIT_TYPE_TIME:
	    return ChildTimeLimitCmd(interp, childInterp, 3, objc, objv);
	    return SlaveTimeLimitCmd(interp, slaveInterp, 3, objc, objv);
	}
    }
    break;
    case OPT_MARKTRUSTED:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	return ChildMarkTrusted(interp, childInterp);
	return SlaveMarkTrusted(interp, slaveInterp);
    case OPT_RECLIMIT:
	if (objc != 2 && objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?newlimit?");
	    return TCL_ERROR;
	}
	return ChildRecursionLimit(interp, childInterp, objc - 2, objv + 2);
	return SlaveRecursionLimit(interp, slaveInterp, objc - 2, objv + 2);
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildObjCmdDeleteProc --
 * SlaveObjCmdDeleteProc --
 *
 *	Invoked when an object command for a child interpreter is deleted;
 *	cleans up all state associated with the child interpreter and destroys
 *	the child interpreter.
 *	Invoked when an object command for a slave interpreter is deleted;
 *	cleans up all state associated with the slave interpreter and destroys
 *	the slave interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Cleans up all state associated with the child interpreter and destroys
 *	the child interpreter.
 *	Cleans up all state associated with the slave interpreter and destroys
 *	the slave interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
ChildObjCmdDeleteProc(
    ClientData clientData)	/* The ChildRecord for the command. */
SlaveObjCmdDeleteProc(
    ClientData clientData)	/* The SlaveRecord for the command. */
{
    Child *childPtr;		/* Interim storage for Child record. */
    Tcl_Interp *childInterp = (Tcl_Interp *)clientData;
				/* And for a child interp. */
    Slave *slavePtr;		/* Interim storage for Slave record. */
    Tcl_Interp *slaveInterp = clientData;
				/* And for a slave interp. */

    childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child;
    slavePtr = &((InterpInfo *) ((Interp *) slaveInterp)->interpInfo)->slave;

    /*
     * Unlink the child from its parent interpreter.
     * Unlink the slave from its master interpreter.
     */

    Tcl_DeleteHashEntry(childPtr->childEntryPtr);
    Tcl_DeleteHashEntry(slavePtr->slaveEntryPtr);

    /*
     * Set to NULL so that when the InterpInfo is cleaned up in the child it
     * Set to NULL so that when the InterpInfo is cleaned up in the slave it
     * does not try to delete the command causing all sorts of grief. See
     * ChildRecordDeleteProc().
     * SlaveRecordDeleteProc().
     */

    childPtr->interpCmd = NULL;
    slavePtr->interpCmd = NULL;

    if (childPtr->childInterp != NULL) {
	Tcl_DeleteInterp(childPtr->childInterp);
    if (slavePtr->slaveInterp != NULL) {
	Tcl_DeleteInterp(slavePtr->slaveInterp);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ChildDebugCmd -- TIP #378
 * SlaveDebugCmd -- TIP #378
 *
 *	Helper function to handle 'debug' command in a child interpreter.
 *	Helper function to handle 'debug' command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May modify INTERP_DEBUG_FRAME flag in the child.
 *	May modify INTERP_DEBUG flag in the slave.
 *
 *----------------------------------------------------------------------
 */

static int
ChildDebugCmd(
SlaveDebugCmd(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* The child interpreter in which command
    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command
				 * will be evaluated. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const debugTypes[] = {
    static const char *debugTypes[] = {
	"-frame", NULL
    };
    enum DebugTypes {
	DEBUG_TYPE_FRAME
    };
    int debugType;
    Interp *iPtr;
    Tcl_Obj *resultPtr;

    iPtr = (Interp *) childInterp;
    iPtr = (Interp *) slaveInterp;
    if (objc == 0) {
	TclNewObj(resultPtr);
	resultPtr = Tcl_NewObj();
	Tcl_ListObjAppendElement(NULL, resultPtr,
		Tcl_NewStringObj("-frame", -1));
	Tcl_ListObjAppendElement(NULL, resultPtr,
		Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes, "debug option",
		0, &debugType) != TCL_OK) {
	if (Tcl_GetIndexFromObj(interp, objv[0], debugTypes,
			"debug option", 0, &debugType) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (debugType == DEBUG_TYPE_FRAME) {
	    if (objc == 2) { /* set */
		if (Tcl_GetBooleanFromObj(interp, objv[1], &debugType)
			!= TCL_OK) {
		    return TCL_ERROR;
		}

		/*
		 * Quietly ignore attempts to disable interp debugging.  This
		 * is a one-way switch as frame debug info is maintained in a
		 * stack that must be consistent once turned on.
		 * Quietly ignore attempts to disable interp debugging.
		 * This is a one-way switch as frame debug info is maintained
		 * in a stack that must be consistent once turned on.
		 */

		if (debugType) {
		    iPtr->flags |= INTERP_DEBUG_FRAME;
		}
	    }
	    Tcl_SetObjResult(interp,
		    Tcl_NewBooleanObj(iPtr->flags & INTERP_DEBUG_FRAME));
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildEval --
 * SlaveEval --
 *
 *	Helper function to evaluate a command in a child interpreter.
 *	Helper function to evaluate a command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the command does.
 *
 *----------------------------------------------------------------------
 */

static int
ChildEval(
SlaveEval(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* The child interpreter in which command
    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command
				 * will be evaluated. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;

    Tcl_Obj *objPtr;
    /*
     * TIP #285: If necessary, reset the cancellation flags for the child
     * interpreter now; otherwise, canceling a script in a parent interpreter
     * can result in a situation where a child interpreter can no longer
     * evaluate any scripts unless somebody calls the TclResetCancellation
     * function for that particular Tcl_Interp.
     */

    TclSetChildCancelFlags(childInterp, 0, 0);

    Tcl_Preserve(childInterp);
    Tcl_AllowExceptions(childInterp);
    Tcl_Preserve(slaveInterp);
    Tcl_AllowExceptions(slaveInterp);

    if (objc == 1) {
	/*
	 * TIP #280: Make actual argument location available to eval'd script.
	 */

	Interp *iPtr = (Interp *) interp;
	CmdFrame *invoker = iPtr->cmdFramePtr;
	int word = 0;
        Interp *iPtr = (Interp *) interp;
	CmdFrame* invoker = iPtr->cmdFramePtr;
	int word          = 0;

	TclArgumentGet(interp, objv[0], &invoker, &word);
	TclArgumentGet (interp, objv[0], &invoker, &word);

	result = TclEvalObjEx(childInterp, objv[0], 0, invoker, word);
	result = TclEvalObjEx(slaveInterp, objv[0], 0, invoker, word);
    } else {
	Tcl_Obj *objPtr = Tcl_ConcatObj(objc, objv);
	objPtr = Tcl_ConcatObj(objc, objv);
	Tcl_IncrRefCount(objPtr);
	result = Tcl_EvalObjEx(childInterp, objPtr, 0);
	result = Tcl_EvalObjEx(slaveInterp, objPtr, 0);
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_TransferResult(childInterp, result, interp);
    TclTransferResult(slaveInterp, result, interp);

    Tcl_Release(childInterp);
    Tcl_Release(slaveInterp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildExpose --
 * SlaveExpose --
 *
 *	Helper function to expose a command in a child interpreter.
 *	Helper function to expose a command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this call scripts in the child will be able to invoke the newly
 *	After this call scripts in the slave will be able to invoke the newly
 *	exposed command.
 *
 *----------------------------------------------------------------------
 */

static int
ChildExpose(
SlaveExpose(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* Interp in which command will be exposed. */
    Tcl_Interp *slaveInterp,	/* Interp in which command will be exposed. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    const char *name;
    char *name;

    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"permission denied: safe interpreter cannot expose commands",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		NULL);
	return TCL_ERROR;
    }

    name = TclGetString(objv[(objc == 1) ? 0 : 1]);
    if (Tcl_ExposeCommand(childInterp, TclGetString(objv[0]),
    if (Tcl_ExposeCommand(slaveInterp, TclGetString(objv[0]),
	    name) != TCL_OK) {
	Tcl_TransferResult(childInterp, TCL_ERROR, interp);
	TclTransferResult(slaveInterp, TCL_ERROR, interp);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildRecursionLimit --
 * SlaveRecursionLimit --
 *
 *	Helper function to set/query the Recursion limit of an interp
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	When (objc == 1), childInterp will be set to a new recursion limit of
 *	When (objc == 1), slaveInterp will be set to a new recursion limit of
 *	objv[0].
 *
 *----------------------------------------------------------------------
 */

static int
ChildRecursionLimit(
SlaveRecursionLimit(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* Interp in which limit is set/queried. */
    Tcl_Interp *slaveInterp,	/* Interp in which limit is set/queried. */
    int objc,			/* Set or Query. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    Interp *iPtr;
    int limit;

    if (objc) {
	if (Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("permission denied: "
		    "safe interpreters cannot change recursion limit", -1));
	    Tcl_AppendResult(interp, "permission denied: "
		    "safe interpreters cannot change recursion limit", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		    NULL);
	    return TCL_ERROR;
	}
	if (TclGetIntFromObj(interp, objv[0], &limit) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (limit <= 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "recursion limit must be > 0", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "BADLIMIT",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetRecursionLimit(childInterp, limit);
	iPtr = (Interp *) childInterp;
	if (interp == childInterp && iPtr->numLevels > limit) {
	Tcl_SetRecursionLimit(slaveInterp, limit);
	iPtr = (Interp *) slaveInterp;
	if (interp == slaveInterp && iPtr->numLevels > limit) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "falling back due to new recursion limit", -1));
	    Tcl_SetErrorCode(interp, "TCL", "RECURSION", NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, objv[0]);
	return TCL_OK;
    } else {
	limit = Tcl_SetRecursionLimit(childInterp, 0);
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limit));
	limit = Tcl_SetRecursionLimit(slaveInterp, 0);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ChildHide --
 * SlaveHide --
 *
 *	Helper function to hide a command in a child interpreter.
 *	Helper function to hide a command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this call scripts in the child will no longer be able to invoke
 *	After this call scripts in the slave will no longer be able to invoke
 *	the named command.
 *
 *----------------------------------------------------------------------
 */

static int
ChildHide(
SlaveHide(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* Interp in which command will be exposed. */
    Tcl_Interp *slaveInterp,	/* Interp in which command will be exposed. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    const char *name;
    char *name;

    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"permission denied: safe interpreter cannot hide commands",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		NULL);
	return TCL_ERROR;
    }

    name = TclGetString(objv[(objc == 1) ? 0 : 1]);
    if (Tcl_HideCommand(childInterp, TclGetString(objv[0]), name) != TCL_OK) {
	Tcl_TransferResult(childInterp, TCL_ERROR, interp);
    if (Tcl_HideCommand(slaveInterp, TclGetString(objv[0]), name) != TCL_OK) {
	TclTransferResult(slaveInterp, TCL_ERROR, interp);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildHidden --
 * SlaveHidden --
 *
 *	Helper function to compute list of hidden commands in a child
 *	Helper function to compute list of hidden commands in a slave
 *	interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ChildHidden(
SlaveHidden(
    Tcl_Interp *interp,		/* Interp for data return. */
    Tcl_Interp *childInterp)	/* Interp whose hidden commands to query. */
    Tcl_Interp *slaveInterp)	/* Interp whose hidden commands to query. */
{
    Tcl_Obj *listObjPtr;		/* Local object pointer. */
    Tcl_Obj *listObjPtr = Tcl_NewObj();	/* Local object pointer. */
    Tcl_HashTable *hTblPtr;		/* For local searches. */
    Tcl_HashEntry *hPtr;		/* For local searches. */
    Tcl_HashSearch hSearch;		/* For local searches. */

    TclNewObj(listObjPtr);
    hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr;
    hTblPtr = ((Interp *) slaveInterp)->hiddenCmdTablePtr;
    if (hTblPtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
		hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    Tcl_ListObjAppendElement(NULL, listObjPtr,
		    Tcl_NewStringObj((const char *)Tcl_GetHashKey(hTblPtr, hPtr), -1));
		    Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
	}
    }
    Tcl_SetObjResult(interp, listObjPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildInvokeHidden --
 * SlaveInvokeHidden --
 *
 *	Helper function to invoke a hidden command in a child interpreter.
 *	Helper function to invoke a hidden command in a slave interpreter.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Whatever the hidden command does.
 *
 *----------------------------------------------------------------------
 */

static int
ChildInvokeHidden(
SlaveInvokeHidden(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp,	/* The child interpreter in which command will
    Tcl_Interp *slaveInterp,	/* The slave interpreter in which command will
				 * be invoked. */
    const char *namespaceName,	/* The namespace to use, if any. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;

    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"not allowed to invoke hidden commands from safe interpreter",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		NULL);
	return TCL_ERROR;
    }

    Tcl_Preserve(childInterp);
    Tcl_AllowExceptions(childInterp);
    Tcl_Preserve(slaveInterp);
    Tcl_AllowExceptions(slaveInterp);

    if (namespaceName == NULL) {
	NRE_callback *rootPtr = TOP_CB(childInterp);

	result = TclObjInvoke(slaveInterp, objc, objv, TCL_INVOKE_HIDDEN);
	Tcl_NRAddCallback(interp, NRPostInvokeHidden, childInterp,
		rootPtr, NULL, NULL);
	return TclNRInvoke(NULL, childInterp, objc, objv);
    } else {
	Namespace *nsPtr, *dummy1, *dummy2;
	const char *tail;

	result = TclGetNamespaceForQualName(childInterp, namespaceName, NULL,
	result = TclGetNamespaceForQualName(slaveInterp, namespaceName, NULL,
		TCL_FIND_ONLY_NS | TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG
		| TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail);
	if (result == TCL_OK) {
	    result = TclObjInvokeNamespace(childInterp, objc, objv,
		    (Tcl_Namespace *) nsPtr, TCL_INVOKE_HIDDEN);
	    result = TclObjInvokeNamespace(slaveInterp, objc, objv,
		    (Tcl_Namespace *)nsPtr, TCL_INVOKE_HIDDEN);
	}
    }

    Tcl_TransferResult(childInterp, result, interp);
    TclTransferResult(slaveInterp, result, interp);

    Tcl_Release(childInterp);
    Tcl_Release(slaveInterp);
    return result;
}

static int
NRPostInvokeHidden(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Interp *childInterp = (Tcl_Interp *)data[0];
    NRE_callback *rootPtr = (NRE_callback *)data[1];

    if (interp != childInterp) {
	result = TclNRRunCallbacks(childInterp, result, rootPtr);
	Tcl_TransferResult(childInterp, result, interp);
    }
    Tcl_Release(childInterp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ChildMarkTrusted --
 * SlaveMarkTrusted --
 *
 *	Helper function to mark a child interpreter as trusted (unsafe).
 *	Helper function to mark a slave interpreter as trusted (unsafe).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	After this call the hard-wired security checks in the core no longer
 *	prevent the child from performing certain operations.
 *	prevent the slave from performing certain operations.
 *
 *----------------------------------------------------------------------
 */

static int
ChildMarkTrusted(
SlaveMarkTrusted(
    Tcl_Interp *interp,		/* Interp for error return. */
    Tcl_Interp *childInterp)	/* The child interpreter which will be marked
    Tcl_Interp *slaveInterp)	/* The slave interpreter which will be marked
				 * trusted. */
{
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"permission denied: safe interpreter cannot mark trusted",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "UNSAFE",
		NULL);
	return TCL_ERROR;
    }
    ((Interp *) childInterp)->flags &= ~SAFE_INTERP;
    ((Interp *) slaveInterp)->flags &= ~SAFE_INTERP;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsSafe --
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
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







-
+



-
+

-
-
+
+




-
-
+
+
+
+
+
+










-
+


-
+















-
-
-
+
+
+








int
Tcl_MakeSafe(
    Tcl_Interp *interp)		/* Interpreter to be made safe. */
{
    Tcl_Channel chan;		/* Channel to remove from safe interpreter. */
    Interp *iPtr = (Interp *) interp;
    Tcl_Interp *parent = ((InterpInfo*) iPtr->interpInfo)->child.parentInterp;
    Tcl_Interp *master = ((InterpInfo*) iPtr->interpInfo)->slave.masterInterp;

    TclHideUnsafeCommands(interp);

    if (parent != NULL) {
    if (master != NULL) {
	/*
	 * Alias these function implementations in the child to those in the
	 * parent; the overall implementations are safe, but they're normally
	 * Alias these function implementations in the slave to those in the
	 * master; the overall implementations are safe, but they're normally
	 * defined by init.tcl which is not sourced by safe interpreters.
	 * Assume these functions all work. [Bug 2895741]
	 */

	(void) Tcl_EvalEx(interp,
		"namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
	(void) Tcl_Eval(interp,
		"namespace eval ::tcl {namespace eval mathfunc {}}");
	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
		"::tcl::mathfunc::min", 0, NULL);
	(void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
		"::tcl::mathfunc::max", 0, NULL);
    }

    iPtr->flags |= SAFE_INTERP;

    /*
     * Unsetting variables : (which should not have been set in the first
     * place, but...)
     */

    /*
     * No env array in a safe interpreter.
     * No env array in a safe slave.
     */

    Tcl_UnsetVar2(interp, "env", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);

    /*
     * Remove unsafe parts of tcl_platform
     */

    Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_platform", "user", TCL_GLOBAL_ONLY);

    /*
     * Unset path informations variables (the only one remaining is [info
     * nameofexecutable])
     */

    Tcl_UnsetVar2(interp, "tclDefaultLibrary", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar2(interp, "tcl_pkgPath", NULL, TCL_GLOBAL_ONLY);
    Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
    Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);

    /*
     * Remove the standard channels from the interpreter; safe interpreters do
     * not ordinarily have access to stdin, stdout and stderr.
     *
     * NOTE: These channels are not added to the interpreter by the
     * Tcl_CreateInterp call, but may be added later, by another I/O
3378
3379
3380
3381
3382
3383
3384
3385

3386
3387
3388
3389
3390
3391
3392
3044
3045
3046
3047
3048
3049
3050

3051
3052
3053
3054
3055
3056
3057
3058







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_LimitExceeded(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;

    return iPtr->limit.exceeded != 0;
}

/*
 *----------------------------------------------------------------------
 *
3409
3410
3411
3412
3413
3414
3415
3416

3417
3418
3419

3420
3421
3422
3423
3424
3425
3426
3075
3076
3077
3078
3079
3080
3081

3082
3083
3084

3085
3086
3087
3088
3089
3090
3091
3092







-
+


-
+







 *----------------------------------------------------------------------
 */

int
Tcl_LimitReady(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;

    if (iPtr->limit.active != 0) {
	int ticker = ++iPtr->limit.granularityTicker;
	register int ticker = ++iPtr->limit.granularityTicker;

	if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) &&
		((iPtr->limit.cmdGranularity == 1) ||
		    (ticker % iPtr->limit.cmdGranularity == 0))) {
	    return 1;
	}
	if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
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
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







-
+















-
-
+
+
-







 */

int
Tcl_LimitCheck(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    int ticker = iPtr->limit.granularityTicker;
    register int ticker = iPtr->limit.granularityTicker;

    if (Tcl_InterpDeleted(interp)) {
	return TCL_OK;
    }

    if ((iPtr->limit.active & TCL_LIMIT_COMMANDS) &&
	    ((iPtr->limit.cmdGranularity == 1) ||
		    (ticker % iPtr->limit.cmdGranularity == 0)) &&
	    (iPtr->limit.cmdCount < iPtr->cmdCount)) {
	iPtr->limit.exceeded |= TCL_LIMIT_COMMANDS;
	Tcl_Preserve(interp);
	RunLimitHandlers(iPtr->limit.cmdHandlers, interp);
	if (iPtr->limit.cmdCount >= iPtr->cmdCount) {
	    iPtr->limit.exceeded &= ~TCL_LIMIT_COMMANDS;
	} else if (iPtr->limit.exceeded & TCL_LIMIT_COMMANDS) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "command count limit exceeded", -1));
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "command count limit exceeded", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "COMMANDS", NULL);
	    Tcl_Release(interp);
	    return TCL_ERROR;
	}
	Tcl_Release(interp);
    }

    if ((iPtr->limit.active & TCL_LIMIT_TIME) &&
3498
3499
3500
3501
3502
3503
3504
3505
3506


3507
3508
3509
3510
3511
3512
3513
3514
3163
3164
3165
3166
3167
3168
3169


3170
3171

3172
3173
3174
3175
3176
3177
3178







-
-
+
+
-







	    Tcl_Preserve(interp);
	    RunLimitHandlers(iPtr->limit.timeHandlers, interp);
	    if (iPtr->limit.time.sec > now.sec ||
		    (iPtr->limit.time.sec == now.sec &&
		    iPtr->limit.time.usec >= now.usec)) {
		iPtr->limit.exceeded &= ~TCL_LIMIT_TIME;
	    } else if (iPtr->limit.exceeded & TCL_LIMIT_TIME) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"time limit exceeded", -1));
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "time limit exceeded", NULL);
		Tcl_SetErrorCode(interp, "TCL", "LIMIT", "TIME", NULL);
		Tcl_Release(interp);
		return TCL_ERROR;
	    }
	    Tcl_Release(interp);
	}
    }

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
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







-
+




















-
+

-
+







	/*
	 * Set the ACTIVE flag while running the limit handler itself so we
	 * cannot reentrantly call this handler and know to use the alternate
	 * method of deletion if necessary.
	 */

	handlerPtr->flags |= LIMIT_HANDLER_ACTIVE;
	handlerPtr->handlerProc(handlerPtr->clientData, interp);
	(handlerPtr->handlerProc)(handlerPtr->clientData, interp);
	handlerPtr->flags &= ~LIMIT_HANDLER_ACTIVE;

	/*
	 * Rediscover this value; it might have changed during the processing
	 * of a limit handler. We have to record it here because we might
	 * delete the structure below, and reading a value out of a deleted
	 * structure is unsafe (even if actually legal with some
	 * malloc()/free() implementations.)
	 */

	nextPtr = handlerPtr->nextPtr;

	/*
	 * If we deleted the current handler while we were executing it, we
	 * will have spliced it out of the list and set the
	 * LIMIT_HANDLER_DELETED flag.
	 */

	if (handlerPtr->flags & LIMIT_HANDLER_DELETED) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
		(handlerPtr->deleteProc)(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	    ckfree((char *) handlerPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
3613
3614
3615
3616
3617
3618
3619
3620




3621
3622
3623
3624
3625
3626
3627

3628
3629
3630
3631
3632
3633
3634
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







-
+
+
+
+






-
+







    LimitHandler *handlerPtr;

    /*
     * Convert everything into a real deletion callback.
     */

    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
	deleteProc = (Tcl_LimitHandlerDeleteProc *) TclpFree;
	deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
    }
    if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) {
	deleteProc = NULL;
    }

    /*
     * Allocate a handler record.
     */

    handlerPtr = (LimitHandler *)Tcl_Alloc(sizeof(LimitHandler));
    handlerPtr = (LimitHandler *) ckalloc(sizeof(LimitHandler));
    handlerPtr->flags = 0;
    handlerPtr->handlerProc = handlerProc;
    handlerPtr->clientData = clientData;
    handlerPtr->deleteProc = deleteProc;
    handlerPtr->prevPtr = NULL;

    /*
3737
3738
3739
3740
3741
3742
3743
3744

3745
3746

3747
3748
3749
3750
3751
3752
3753
3404
3405
3406
3407
3408
3409
3410

3411
3412

3413
3414
3415
3416
3417
3418
3419
3420







-
+

-
+







	 * If nothing is currently executing the handler, delete its client
	 * data and the overall handler structure now. Otherwise it will all
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
		(handlerPtr->deleteProc)(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	    ckfree((char *) handlerPtr);
	}
	return;
    }
}

/*
 *----------------------------------------------------------------------
3797
3798
3799
3800
3801
3802
3803
3804

3805
3806

3807
3808
3809
3810
3811
3812
3813
3464
3465
3466
3467
3468
3469
3470

3471
3472

3473
3474
3475
3476
3477
3478
3479
3480







-
+

-
+







	 * If nothing is currently executing the handler, delete its client
	 * data and the overall handler structure now. Otherwise it will all
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
		(handlerPtr->deleteProc)(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	    ckfree((char *) handlerPtr);
	}
    }

    /*
     * Delete all time-limit handlers.
     */

3830
3831
3832
3833
3834
3835
3836
3837

3838
3839

3840
3841
3842
3843
3844
3845
3846
3497
3498
3499
3500
3501
3502
3503

3504
3505

3506
3507
3508
3509
3510
3511
3512
3513







-
+

-
+







	 * If nothing is currently executing the handler, delete its client
	 * data and the overall handler structure now. Otherwise it will all
	 * go away when the handler returns.
	 */

	if (!(handlerPtr->flags & LIMIT_HANDLER_ACTIVE)) {
	    if (handlerPtr->deleteProc != NULL) {
		handlerPtr->deleteProc(handlerPtr->clientData);
		(handlerPtr->deleteProc)(handlerPtr->clientData);
	    }
	    Tcl_Free(handlerPtr);
	    ckfree((char *) handlerPtr);
	}
    }

    /*
     * Delete the timer callback that is used to trap limits that occur in
     * [vwait]s...
     */
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
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
3775
3776







-
-
+
+
















-
+







 *----------------------------------------------------------------------
 */

static void
TimeLimitCallback(
    ClientData clientData)
{
    Tcl_Interp *interp = (Tcl_Interp *)clientData;
    Interp *iPtr = (Interp *)clientData;
    Tcl_Interp *interp = clientData;
    Interp *iPtr = clientData;
    int code;

    Tcl_Preserve(interp);
    iPtr->limit.timeEvent = NULL;

    /*
     * Must reset the granularity ticker here to force an immediate full
     * check. This is OK because we're swallowing the cost in the overall cost
     * of the event loop. [Bug 2891362]
     */

    iPtr->limit.granularityTicker = 0;

    code = Tcl_LimitCheck(interp);
    if (code != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (while waiting for event)");
	Tcl_BackgroundException(interp, code);
	TclBackgroundException(interp, code);
    }
    Tcl_Release(interp);
}

/*
 *----------------------------------------------------------------------
 *
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
3872
3873
3874
3875
3876
3877
3878

3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894

3895
3896
3897
3898
3899
3900

3901
3902
3903
3904
3905
3906
3907
3908







-
+















-
+





-
+








/*
 *----------------------------------------------------------------------
 *
 * DeleteScriptLimitCallback --
 *
 *	Callback for when a script limit (a limit callback implemented as a
 *	Tcl script in a parent interpreter, as set up from Tcl) is deleted.
 *	Tcl script in a master interpreter, as set up from Tcl) is deleted.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The reference to the script callback from the controlling interpreter
 *	is removed.
 *
 *----------------------------------------------------------------------
 */

static void
DeleteScriptLimitCallback(
    ClientData clientData)
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;
    ScriptLimitCallback *limitCBPtr = clientData;

    Tcl_DecrRefCount(limitCBPtr->scriptObj);
    if (limitCBPtr->entryPtr != NULL) {
	Tcl_DeleteHashEntry(limitCBPtr->entryPtr);
    }
    Tcl_Free(limitCBPtr);
    ckfree((char *) limitCBPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * CallScriptLimitCallback --
 *
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
3918
3919
3920
3921
3922
3923
3924

3925
3926

3927
3928
3929
3930
3931
3932
3933
3934
3935
3936

3937
3938
3939
3940
3941
3942
3943
3944







-
+

-
+









-
+







 *
 *----------------------------------------------------------------------
 */

static void
CallScriptLimitCallback(
    ClientData clientData,
    TCL_UNUSED(Tcl_Interp *))
    Tcl_Interp *interp)		/* Interpreter which failed the limit */
{
    ScriptLimitCallback *limitCBPtr = (ScriptLimitCallback *)clientData;
    ScriptLimitCallback *limitCBPtr = clientData;
    int code;

    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
	return;
    }
    Tcl_Preserve(limitCBPtr->interp);
    code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
	    TCL_EVAL_GLOBAL);
    if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
	Tcl_BackgroundException(limitCBPtr->interp, code);
	TclBackgroundException(limitCBPtr->interp, code);
    }
    Tcl_Release(limitCBPtr->interp);
}

/*
 *----------------------------------------------------------------------
 *
4318
4319
4320
4321
4322
4323
4324
4325

4326
4327
4328

4329
4330
4331
4332
4333
4334

4335
4336
4337
4338
4339
4340
4341
3985
3986
3987
3988
3989
3990
3991

3992
3993
3994

3995
3996
3997
3998
3999
4000

4001
4002
4003
4004
4005
4006
4007
4008







-
+


-
+





-
+







	if (hashPtr != NULL) {
	    Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
		    Tcl_GetHashValue(hashPtr));
	}
	return;
    }

    hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, &key,
    hashPtr = Tcl_CreateHashEntry(&iPtr->limit.callbacks, (char *) &key,
	    &isNew);
    if (!isNew) {
	limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hashPtr);
	limitCBPtr = Tcl_GetHashValue(hashPtr);
	limitCBPtr->entryPtr = NULL;
	Tcl_LimitRemoveHandler(targetInterp, type, CallScriptLimitCallback,
		limitCBPtr);
    }

    limitCBPtr = (ScriptLimitCallback *)Tcl_Alloc(sizeof(ScriptLimitCallback));
    limitCBPtr = (ScriptLimitCallback *) ckalloc(sizeof(ScriptLimitCallback));
    limitCBPtr->interp = interp;
    limitCBPtr->scriptObj = scriptObj;
    limitCBPtr->entryPtr = hashPtr;
    limitCBPtr->type = type;
    Tcl_IncrRefCount(scriptObj);

    Tcl_LimitAddHandler(targetInterp, type, CallScriptLimitCallback,
4418
4419
4420
4421
4422
4423
4424
4425

4426
4427
4428


4429
4430
4431
4432
4433
4434
4435
4436
4437




4438
4439
4440
4441
4442
4443
4444
4445



4446
4447
4448


4449
4450
4451
4452
4453




4454
4455
4456
4457



4458
4459

4460
4461
4462
4463
4464
4465
4466

4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482

4483
4484

4485
4486
4487
4488
4489

4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510



4511
4512
4513
4514
4515
4516
4517
4518
4519

4520
4521
4522
4523

4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539

4540
4541
4542

4543
4544

4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561

4562
4563
4564
4565

4566
4567
4568
4569
4570
4571
4572
4573


4574
4575
4576

4577
4578

4579
4580
4581
4582
4583
4584


4585
4586
4587
4588

4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600

4601
4602
4603
4604
4605
4606
4607
4608
4609

4610
4611

4612
4613
4614
4615
4616
4617

4618
4619
4620
4621
4622
4623
4624
4625
4626

4627
4628

4629
4630
4631
4632
4633
4634
4635

4636
4637
4638
4639

4640
4641
4642
4643
4644


4645
4646

4647
4648
4649
4650
4651
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
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
4328
4329
4330
4331
4332

4333
4334

4335
4336
4337
4338
4339

4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358



4359
4360
4361

4362
4363
4364
4365
4366
4367
4368

4369
4370
4371
4372

4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387

4388
4389
4390

4391
4392
4393

4394
4395

4396
4397

4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416

4417
4418
4419
4420

4421
4422
4423
4424
4425
4426
4427


4428
4429
4430
4431

4432
4433
4434

4435
4436

4437
4438
4439
4440

4441
4442
4443


4444
4445
4446
4447
4448
4449
4450

4451
4452
4453
4454


4455
4456
4457
4458
4459
4460
4461

4462
4463
4464
4465
4466
4467
4468
4469
4470

4471
4472
4473
4474
4475
4476
4477
4478


4479


4480
4481
4482
4483
4484
4485

4486
4487
4488
4489
4490
4491
4492
4493


4494


4495
4496
4497

4498
4499
4500
4501

4502
4503
4504
4505
4506
4507
4508
4509


4510


4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525



4526
4527


4528
4529
4530



4531
4532


4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546


4547
4548
4549

4550
4551
4552
4553

4554
4555
4556
4557

4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570







-
+

-
-
+
+





-
-
-
-
+
+
+
+





-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
+






-
+















-
+

-
+




-
+


















-
-
-
+
+
+
-







-
+



-
+















-
+


-
+

-
+
















-
+



-
+






-
-
+
+


-
+

-
+





-
+
+


-
-
+











-
+







-
-
+
-
-
+





-
+







-
-
+
-
-
+






-
+



-
+



-
-
+
+

-
+









-
+














-
+

-
+




-
+


















-
-
-
+
+
+
-







-
+



-
+














-
+


-
+


-
+

-
+

-
+


















-
+



-
+






-
-
+
+


-
+


-
+

-
+



-
+


-
-
+
+





-
+
+


-
-
+






-
+








-
+







-
-
+
-
-
+





-
+







-
-
+
-
-
+


-
+



-
+







-
-
+
-
-
+














-
-
-
+
+
-
-



-
-
-
+
+
-
-














-
-
+
+

-
+



-
+



-
+












    Tcl_InitHashTable(&iPtr->limit.callbacks,
	    sizeof(ScriptLimitCallbackKey)/sizeof(int));
}

/*
 *----------------------------------------------------------------------
 *
 * InheritLimitsFromParent --
 * InheritLimitsFromMaster --
 *
 *	Derive the interpreter limit configuration for a child interpreter
 *	from the limit config for the parent.
 *	Derive the interpreter limit configuration for a slave interpreter
 *	from the limit config for the master.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The child interpreter limits are set so that if the parent has a
 *	limit, it may not exceed it by handing off work to child interpreters.
 *	Note that this does not transfer limit callbacks from the parent to
 *	the child.
 *	The slave interpreter limits are set so that if the master has a
 *	limit, it may not exceed it by handing off work to slave interpreters.
 *	Note that this does not transfer limit callbacks from the master to
 *	the slave.
 *
 *----------------------------------------------------------------------
 */

static void
InheritLimitsFromParent(
    Tcl_Interp *childInterp,
    Tcl_Interp *parentInterp)
InheritLimitsFromMaster(
    Tcl_Interp *slaveInterp,
    Tcl_Interp *masterInterp)
{
    Interp *childPtr = (Interp *) childInterp;
    Interp *parentPtr = (Interp *) parentInterp;
    Interp *slavePtr = (Interp *) slaveInterp;
    Interp *masterPtr = (Interp *) masterInterp;

    if (parentPtr->limit.active & TCL_LIMIT_COMMANDS) {
	childPtr->limit.active |= TCL_LIMIT_COMMANDS;
	childPtr->limit.cmdCount = 0;
	childPtr->limit.cmdGranularity = parentPtr->limit.cmdGranularity;
    if (masterPtr->limit.active & TCL_LIMIT_COMMANDS) {
	slavePtr->limit.active |= TCL_LIMIT_COMMANDS;
	slavePtr->limit.cmdCount = 0;
	slavePtr->limit.cmdGranularity = masterPtr->limit.cmdGranularity;
    }
    if (parentPtr->limit.active & TCL_LIMIT_TIME) {
	childPtr->limit.active |= TCL_LIMIT_TIME;
	memcpy(&childPtr->limit.time, &parentPtr->limit.time,
    if (masterPtr->limit.active & TCL_LIMIT_TIME) {
	slavePtr->limit.active |= TCL_LIMIT_TIME;
	memcpy(&slavePtr->limit.time, &masterPtr->limit.time,
		sizeof(Tcl_Time));
	childPtr->limit.timeGranularity = parentPtr->limit.timeGranularity;
	slavePtr->limit.timeGranularity = masterPtr->limit.timeGranularity;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ChildCommandLimitCmd --
 * SlaveCommandLimitCmd --
 *
 *	Implementation of the [interp limit $i commands] and [$i limit
 *	commands] subcommands. See the interp manual page for a full
 *	description.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Depends on the arguments.
 *
 *----------------------------------------------------------------------
 */

static int
ChildCommandLimitCmd(
SlaveCommandLimitCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Interp *childInterp,	/* Interpreter being adjusted. */
    Tcl_Interp *slaveInterp,	/* Interpreter being adjusted. */
    int consumedObjc,		/* Number of args already parsed. */
    int objc,			/* Total number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
    static const char *options[] = {
	"-command", "-granularity", "-value", NULL
    };
    enum Options {
	OPT_CMD, OPT_GRAN, OPT_VAL
    };
    Interp *iPtr = (Interp *) interp;
    int index;
    ScriptLimitCallbackKey key;
    ScriptLimitCallback *limitCBPtr;
    Tcl_HashEntry *hPtr;

    /*
     * First, ensure that we are not reading or writing the calling
     * interpreter's limits; it may only manipulate its children. Note that
     * the low level API enforces this with Tcl_Panic, which we want to
     * avoid. [Bug 3398794]
     */

    if (interp == childInterp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"limits on current interpreter inaccessible", -1));
    if (interp == slaveInterp) {
	Tcl_AppendResult(interp,
		"limits on current interpreter inaccessible", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
	return TCL_ERROR;
    }

    if (objc == consumedObjc) {
	Tcl_Obj *dictPtr;

	TclNewObj(dictPtr);
	key.interp = childInterp;
	key.interp = slaveInterp;
	key.type = TCL_LIMIT_COMMANDS;
	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	if (hPtr != NULL) {
	    limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
	    limitCBPtr = Tcl_GetHashValue(hPtr);
	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
			limitCBPtr->scriptObj);
	    } else {
		goto putEmptyCommandInDict;
	    }
	} else {
	    Tcl_Obj *empty;

	putEmptyCommandInDict:
	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[0], -1), empty);
	}
	Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
		Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp,
		Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp,
		TCL_LIMIT_COMMANDS)));

	if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) {
	if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
		    Tcl_NewWideIntObj(Tcl_LimitGetCommands(childInterp)));
		    Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
	} else {
	    Tcl_Obj *empty;

	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[2], -1), empty);
	}
	Tcl_SetObjResult(interp, dictPtr);
	return TCL_OK;
    } else if (objc == consumedObjc+1) {
	if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option",
		0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum Options) index) {
	case OPT_CMD:
	    key.interp = childInterp;
	    key.interp = slaveInterp;
	    key.type = TCL_LIMIT_COMMANDS;
	    hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	    if (hPtr != NULL) {
		limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
		limitCBPtr = Tcl_GetHashValue(hPtr);
		if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		    Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
		}
	    }
	    break;
	case OPT_GRAN:
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
		    Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_COMMANDS)));
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(
		    Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_COMMANDS)));
	    break;
	case OPT_VAL:
	    if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_COMMANDS)) {
	    if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
		Tcl_SetObjResult(interp,
			Tcl_NewWideIntObj(Tcl_LimitGetCommands(childInterp)));
			Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
	    }
	    break;
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	Tcl_WrongNumArgs(interp, consumedObjc, objv,
		"?-option? ?value? ?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	size_t scriptLen = 0, limitLen = 0;
	int i, scriptLen = 0, limitLen = 0;
	Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL;
	int gran = 0, limit = 0;

	for (i=consumedObjc ; i<objc ; i+=2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(scriptObj, &scriptLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_AppendResult(interp, "granularity must be at "
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
			    "least 1", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_VAL:
		limitObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &limitLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
		if (limitLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &limit) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (limit < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "command limit value must be at least 0", -1));
		    Tcl_AppendResult(interp, "command limit value must be at "
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
			    "least 0", NULL);
		    return TCL_ERROR;
		}
		break;
	    }
	}
	if (scriptObj != NULL) {
	    SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, childInterp,
	    SetScriptLimitCallback(interp, TCL_LIMIT_COMMANDS, slaveInterp,
		    (scriptLen > 0 ? scriptObj : NULL));
	}
	if (granObj != NULL) {
	    Tcl_LimitSetGranularity(childInterp, TCL_LIMIT_COMMANDS, gran);
	    Tcl_LimitSetGranularity(slaveInterp, TCL_LIMIT_COMMANDS, gran);
	}
	if (limitObj != NULL) {
	    if (limitLen > 0) {
		Tcl_LimitSetCommands(childInterp, limit);
		Tcl_LimitTypeSet(childInterp, TCL_LIMIT_COMMANDS);
		Tcl_LimitSetCommands(slaveInterp, limit);
		Tcl_LimitTypeSet(slaveInterp, TCL_LIMIT_COMMANDS);
	    } else {
		Tcl_LimitTypeReset(childInterp, TCL_LIMIT_COMMANDS);
		Tcl_LimitTypeReset(slaveInterp, TCL_LIMIT_COMMANDS);
	    }
	}
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ChildTimeLimitCmd --
 * SlaveTimeLimitCmd --
 *
 *	Implementation of the [interp limit $i time] and [$i limit time]
 *	subcommands. See the interp manual page for a full description.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Depends on the arguments.
 *
 *----------------------------------------------------------------------
 */

static int
ChildTimeLimitCmd(
SlaveTimeLimitCmd(
    Tcl_Interp *interp,			/* Current interpreter. */
    Tcl_Interp *childInterp,		/* Interpreter being adjusted. */
    Tcl_Interp *slaveInterp,		/* Interpreter being adjusted. */
    int consumedObjc,			/* Number of args already parsed. */
    int objc,				/* Total number of arguments. */
    Tcl_Obj *const objv[])		/* Argument objects. */
{
    static const char *const options[] = {
    static const char *options[] = {
	"-command", "-granularity", "-milliseconds", "-seconds", NULL
    };
    enum Options {
	OPT_CMD, OPT_GRAN, OPT_MILLI, OPT_SEC
    };
    Interp *iPtr = (Interp *) interp;
    int index;
    ScriptLimitCallbackKey key;
    ScriptLimitCallback *limitCBPtr;
    Tcl_HashEntry *hPtr;

    /*
     * First, ensure that we are not reading or writing the calling
     * interpreter's limits; it may only manipulate its children. Note that
     * the low level API enforces this with Tcl_Panic, which we want to
     * avoid. [Bug 3398794]
     */

    if (interp == childInterp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"limits on current interpreter inaccessible", -1));
    if (interp == slaveInterp) {
	Tcl_AppendResult(interp,
		"limits on current interpreter inaccessible", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP", "SELF", NULL);
	return TCL_ERROR;
    }

    if (objc == consumedObjc) {
	Tcl_Obj *dictPtr;

	TclNewObj(dictPtr);
	key.interp = childInterp;
	key.interp = slaveInterp;
	key.type = TCL_LIMIT_TIME;
	hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	if (hPtr != NULL) {
	    limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
	    limitCBPtr = Tcl_GetHashValue(hPtr);
	    if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[0], -1),
			limitCBPtr->scriptObj);
	    } else {
		goto putEmptyCommandInDict;
	    }
	} else {
	    Tcl_Obj *empty;
	putEmptyCommandInDict:
	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[0], -1), empty);
	}
	Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
		Tcl_NewWideIntObj(Tcl_LimitGetGranularity(childInterp,
		Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp,
		TCL_LIMIT_TIME)));

	if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
	if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
	    Tcl_Time limitMoment;

	    Tcl_LimitGetTime(childInterp, &limitMoment);
	    Tcl_LimitGetTime(slaveInterp, &limitMoment);
	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
		    Tcl_NewWideIntObj(limitMoment.usec/1000));
		    Tcl_NewLongObj(limitMoment.usec/1000));
	    Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1),
		    Tcl_NewWideIntObj(limitMoment.sec));
		    Tcl_NewLongObj(limitMoment.sec));
	} else {
	    Tcl_Obj *empty;

	    TclNewObj(empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[2], -1), empty);
	    Tcl_DictObjPut(NULL, dictPtr,
		    Tcl_NewStringObj(options[3], -1), empty);
	}
	Tcl_SetObjResult(interp, dictPtr);
	return TCL_OK;
    } else if (objc == consumedObjc+1) {
	if (Tcl_GetIndexFromObj(interp, objv[consumedObjc], options, "option",
		0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum Options) index) {
	case OPT_CMD:
	    key.interp = childInterp;
	    key.interp = slaveInterp;
	    key.type = TCL_LIMIT_TIME;
	    hPtr = Tcl_FindHashEntry(&iPtr->limit.callbacks, (char *) &key);
	    if (hPtr != NULL) {
		limitCBPtr = (ScriptLimitCallback *)Tcl_GetHashValue(hPtr);
		limitCBPtr = Tcl_GetHashValue(hPtr);
		if (limitCBPtr != NULL && limitCBPtr->scriptObj != NULL) {
		    Tcl_SetObjResult(interp, limitCBPtr->scriptObj);
		}
	    }
	    break;
	case OPT_GRAN:
	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
		    Tcl_LimitGetGranularity(childInterp, TCL_LIMIT_TIME)));
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(
		    Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_TIME)));
	    break;
	case OPT_MILLI:
	    if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
	    if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
		Tcl_Time limitMoment;

		Tcl_LimitGetTime(childInterp, &limitMoment);
		Tcl_LimitGetTime(slaveInterp, &limitMoment);
		Tcl_SetObjResult(interp,
			Tcl_NewWideIntObj(limitMoment.usec/1000));
			Tcl_NewLongObj(limitMoment.usec/1000));
	    }
	    break;
	case OPT_SEC:
	    if (Tcl_LimitTypeEnabled(childInterp, TCL_LIMIT_TIME)) {
	    if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
		Tcl_Time limitMoment;

		Tcl_LimitGetTime(childInterp, &limitMoment);
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limitMoment.sec));
		Tcl_LimitGetTime(slaveInterp, &limitMoment);
		Tcl_SetObjResult(interp, Tcl_NewLongObj(limitMoment.sec));
	    }
	    break;
	}
	return TCL_OK;
    } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) {
	Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?");
	Tcl_WrongNumArgs(interp, consumedObjc, objv,
		"?-option? ?value? ?-option value ...?");
	return TCL_ERROR;
    } else {
	int i;
	size_t scriptLen = 0, milliLen = 0, secLen = 0;
	int i, scriptLen = 0, milliLen = 0, secLen = 0;
	Tcl_Obj *scriptObj = NULL, *granObj = NULL;
	Tcl_Obj *milliObj = NULL, *secObj = NULL;
	int gran = 0;
	Tcl_Time limitMoment;
	int tmp;

	Tcl_LimitGetTime(childInterp, &limitMoment);
	Tcl_LimitGetTime(slaveInterp, &limitMoment);
	for (i=consumedObjc ; i<objc ; i+=2) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) index) {
	    case OPT_CMD:
		scriptObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &scriptLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
		break;
	    case OPT_GRAN:
		granObj = objv[i+1];
		if (TclGetIntFromObj(interp, objv[i+1], &gran) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (gran < 1) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "granularity must be at least 1", -1));
		    Tcl_AppendResult(interp, "granularity must be at "
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
			    "least 1", NULL);
		    return TCL_ERROR;
		}
		break;
	    case OPT_MILLI:
		milliObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &milliLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
		if (milliLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "milliseconds must be at least 0", -1));
		    Tcl_AppendResult(interp, "milliseconds must be at least 0",
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
			    NULL);
		    return TCL_ERROR;
		}
		limitMoment.usec = ((long) tmp)*1000;
		limitMoment.usec = ((long)tmp)*1000;
		break;
	    case OPT_SEC:
		secObj = objv[i+1];
		(void) TclGetStringFromObj(objv[i+1], &secLen);
		(void) Tcl_GetStringFromObj(objv[i+1], &secLen);
		if (secLen == 0) {
		    break;
		}
		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (tmp < 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "seconds must be at least 0", -1));
		    Tcl_AppendResult(interp, "seconds must be at least 0",
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADVALUE", NULL);
			    NULL);
		    return TCL_ERROR;
		}
		limitMoment.sec = tmp;
		break;
	    }
	}
	if (milliObj != NULL || secObj != NULL) {
	    if (milliObj != NULL) {
		/*
		 * Setting -milliseconds but clearing -seconds, or resetting
		 * -milliseconds but not resetting -seconds? Bad voodoo!
		 */

		if (secObj != NULL && secLen == 0 && milliLen > 0) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "may only set -milliseconds if -seconds is not "
			    "also being reset", -1));
		    Tcl_AppendResult(interp, "may only set -milliseconds "
			    "if -seconds is not also being reset", NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADUSAGE", NULL);
		    return TCL_ERROR;
		}
		if (milliLen == 0 && (secObj == NULL || secLen > 0)) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "may only reset -milliseconds if -seconds is "
			    "also being reset", -1));
		    Tcl_AppendResult(interp, "may only reset -milliseconds "
			    "if -seconds is also being reset", NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
			    "BADUSAGE", NULL);
		    return TCL_ERROR;
		}
	    }

	    if (milliLen > 0 || secLen > 0) {
		/*
		 * Force usec to be in range [0..1000000), possibly
		 * incrementing sec in the process. This makes it much easier
		 * for people to write scripts that do small time increments.
		 */

		limitMoment.sec += limitMoment.usec / 1000000;
		limitMoment.usec %= 1000000;

		Tcl_LimitSetTime(childInterp, &limitMoment);
		Tcl_LimitTypeSet(childInterp, TCL_LIMIT_TIME);
		Tcl_LimitSetTime(slaveInterp, &limitMoment);
		Tcl_LimitTypeSet(slaveInterp, TCL_LIMIT_TIME);
	    } else {
		Tcl_LimitTypeReset(childInterp, TCL_LIMIT_TIME);
		Tcl_LimitTypeReset(slaveInterp, TCL_LIMIT_TIME);
	    }
	}
	if (scriptObj != NULL) {
	    SetScriptLimitCallback(interp, TCL_LIMIT_TIME, childInterp,
	    SetScriptLimitCallback(interp, TCL_LIMIT_TIME, slaveInterp,
		    (scriptLen > 0 ? scriptObj : NULL));
	}
	if (granObj != NULL) {
	    Tcl_LimitSetGranularity(childInterp, TCL_LIMIT_TIME, gran);
	    Tcl_LimitSetGranularity(slaveInterp, TCL_LIMIT_TIME, gran);
	}
	return TCL_OK;
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclLink.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102


103
104

105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
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










-
-






-
-







-
+






-
+
-
-
-
-
-








-


-




-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-




-
-






-
+

-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-







/*
 * tclLink.c --
 *
 *	This file implements linked variables (a C variable that is tied to a
 *	Tcl variable). The idea of linked variables was first suggested by
 *	Andreas Stolcke and this implementation is based heavily on a
 *	prototype implementation provided by him.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2008 Rene Zaumseil
 * Copyright (c) 2019 Donal K. Fellows
 *
 * 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 "tclTomMath.h"
#include <math.h>

/*
 * For each linked variable there is a data structure of the following type,
 * which describes the link and is the clientData for the trace set on the Tcl
 * variable.
 */

typedef struct {
typedef struct Link {
    Tcl_Interp *interp;		/* Interpreter containing Tcl variable. */
    Namespace *nsPtr;		/* Namespace containing Tcl variable */
    Tcl_Obj *varName;		/* Name of variable (must be global). This is
				 * needed during trace callbacks, since the
				 * actual variable may be aliased at that time
				 * via upvar. */
    void *addr;			/* Location of C variable. */
    char *addr;			/* Location of C variable. */
    size_t bytes;		/* Size of C variable array. This is 0 when
				 * single variables, and >0 used for array
				 * variables. */
    size_t numElems;	/* Number of elements in C variable array.
				 * Zero for single variables. */
    int type;			/* Type of link (TCL_LINK_INT, etc.). */
    union {
	char c;
	unsigned char uc;
	int i;
	unsigned int ui;
	short s;
	unsigned short us;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
	long l;
	unsigned long ul;
#endif
	Tcl_WideInt w;
	Tcl_WideUInt uw;
	float f;
	double d;
	void *aryPtr;		/* Generic array. */
	char *cPtr;		/* char array */
	unsigned char *ucPtr;	/* unsigned char array */
	short *sPtr;		/* short array */
	unsigned short *usPtr;	/* unsigned short array */
	int *iPtr;		/* int array */
	unsigned int *uiPtr;	/* unsigned int array */
	long *lPtr;		/* long array */
	unsigned long *ulPtr;	/* unsigned long array */
	Tcl_WideInt *wPtr;	/* wide (long long) array */
	Tcl_WideUInt *uwPtr;	/* unsigned wide (long long) array */
	float *fPtr;		/* float array */
	double *dPtr;		/* double array */
    } lastValue;		/* Last known value of C variable; used to
				 * avoid string conversions. */
    int flags;			/* Miscellaneous one-bit values; see below for
				 * definitions. */
} Link;

/*
 * Definitions for flag bits:
 * LINK_READ_ONLY -		1 means errors should be generated if Tcl
 *				script attempts to write variable.
 * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
 *				in progress for this variable, so trace
 *				callbacks on the variable should be ignored.
 * LINK_ALLOC_ADDR -		1 means linkPtr->addr was allocated on the
 *				heap.
 * LINK_ALLOC_LAST -		1 means linkPtr->valueLast.p was allocated on
 *				the heap.
 */

#define LINK_READ_ONLY		1
#define LINK_BEING_UPDATED	2
#define LINK_ALLOC_ADDR		4
#define LINK_ALLOC_LAST		8

/*
 * Forward references to functions defined later in this file:
 */

static char *		LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
			    CONST char *name1, CONST char *name2, int flags);
static Tcl_Obj *	ObjValue(Link *linkPtr);
static void		LinkFree(Link *linkPtr);
static int		GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
static int		GetInvalidIntFromObj(Tcl_Obj *objPtr,
				int *intPtr);
static int		GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
			    double *doublePtr);
				double *doublePtr);
static int		SetInvalidRealFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);

/*
 * A marker type used to flag weirdnesses so we can pass them around right.
 */

static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */
};

/*
 * Convenience macro for accessing the value of the C variable pointed to by a
 * link. Note that this macro produces something that may be regarded as an
 * lvalue or rvalue; it may be assigned to as well as read. Also note that
 * this macro assumes the name of the variable being accessed (linkPtr); this
 * is not strictly a good thing, but it keeps the code much shorter and
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
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
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







-
-
+
+










-
-
+
+






-
+






-
-
-
-
-
-
-
-





-
-




-
+







-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


+
-
+







 *
 *----------------------------------------------------------------------
 */

int
Tcl_LinkVar(
    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
    CONST char *varName,	/* Name of a global variable in interp. */
    char *addr,			/* Address of a C variable to be linked to
				 * varName. */
    int type)			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

    linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
	    LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"variable '%s' is already linked", varName));
	return TCL_ERROR;
    }

    linkPtr = (Link *)Tcl_Alloc(sizeof(Link));
    linkPtr = (Link *) ckalloc(sizeof(Link));
    linkPtr->interp = interp;
    linkPtr->nsPtr = NULL;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);
    linkPtr->addr = addr;
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
	|| defined(_WIN32) || defined(__CYGWIN__))
    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
	linkPtr->type = TCL_LINK_LONG;
    } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
	linkPtr->type = TCL_LINK_ULONG;
    }
#endif
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }
    linkPtr->bytes = 0;
    linkPtr->numElems = 0;
    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
	ckfree((char *) linkPtr);
	return TCL_ERROR;
    }

    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
    linkPtr->nsPtr->refCount++;

    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    code = Tcl_TraceVar(interp, varName, TCL_GLOBAL_ONLY|TCL_TRACE_READS
	    |TCL_TRACE_WRITES|TCL_TRACE_UNSETS, LinkTraceProc,
	    (ClientData) linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LinkArray --
 *
 *	Link a C variable array to a Tcl variable so that changes to either
 *	one causes the other to change.
 *
 * Results:
 *	The return value is TCL_OK if everything went well or TCL_ERROR if an
 *	error occurred (the interp's result is also set after errors).
 *
 * Side effects:
 *	The value at *addr is linked to the Tcl variable "varName", using
 *	"type" to convert between string values for Tcl and binary values for
 *	*addr.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LinkArray(
    Tcl_Interp *interp,		/* Interpreter in which varName exists. */
    const char *varName,	/* Name of a global variable in interp. */
    void *addr,			/* Address of a C variable to be linked to
				 * varName. If NULL then the necessary space
				 * will be allocated and returned as the
				 * interpreter result. */
    int type,			/* Type of C variable: TCL_LINK_INT, etc. Also
				 * may have TCL_LINK_READ_ONLY OR'ed in. */
    size_t size)			/* Size of C variable array, >1 if array */
{
    Tcl_Obj *objPtr;
    Link *linkPtr;
    Namespace *dummy;
    const char *name;
    int code;

    if (size < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"wrong array size given", -1));
	return TCL_ERROR;
    }

    linkPtr = (Link *)Tcl_Alloc(sizeof(Link));
    linkPtr->type = type & ~TCL_LINK_READ_ONLY;
#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
	|| defined(_WIN32) || defined(__CYGWIN__))
    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
	linkPtr->type = TCL_LINK_LONG;
    } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
	linkPtr->type = TCL_LINK_ULONG;
    }
#endif
    linkPtr->numElems = size;
    if (type & TCL_LINK_READ_ONLY) {
	linkPtr->flags = LINK_READ_ONLY;
    } else {
	linkPtr->flags = 0;
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
    case TCL_LINK_BOOLEAN:
	linkPtr->bytes = size * sizeof(int);
	break;
    case TCL_LINK_DOUBLE:
	linkPtr->bytes = size * sizeof(double);
	break;
    case TCL_LINK_WIDE_INT:
	linkPtr->bytes = size * sizeof(Tcl_WideInt);
	break;
    case TCL_LINK_WIDE_UINT:
	linkPtr->bytes = size * sizeof(Tcl_WideUInt);
	break;
    case TCL_LINK_CHAR:
	linkPtr->bytes = size * sizeof(char);
	break;
    case TCL_LINK_UCHAR:
	linkPtr->bytes = size * sizeof(unsigned char);
	break;
    case TCL_LINK_SHORT:
	linkPtr->bytes = size * sizeof(short);
	break;
    case TCL_LINK_USHORT:
	linkPtr->bytes = size * sizeof(unsigned short);
	break;
    case TCL_LINK_UINT:
	linkPtr->bytes = size * sizeof(unsigned int);
	break;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	linkPtr->bytes = size * sizeof(long);
	break;
    case TCL_LINK_ULONG:
	linkPtr->bytes = size * sizeof(unsigned long);
	break;
#endif
    case TCL_LINK_FLOAT:
	linkPtr->bytes = size * sizeof(float);
	break;
    case TCL_LINK_STRING:
	linkPtr->bytes = size * sizeof(char);
	size = 1;		/* This is a variable length string, no need
				 * to check last value. */

	/*
	 * If no address is given create one and use as address the
         * not needed linkPtr->lastValue
	 */

	if (addr == NULL) {
	    linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes);
	    linkPtr->flags |= LINK_ALLOC_LAST;
	    addr = (char *) &linkPtr->lastValue.cPtr;
	}
	break;
    case TCL_LINK_CHARS:
    case TCL_LINK_BINARY:
	linkPtr->bytes = size * sizeof(char);
	break;
    default:
	LinkFree(linkPtr);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad linked array variable type", -1));
	return TCL_ERROR;
    }

    /*
     * Allocate C variable space in case no address is given
     */

    if (addr == NULL) {
	linkPtr->addr = Tcl_Alloc(linkPtr->bytes);
	linkPtr->flags |= LINK_ALLOC_ADDR;
    } else {
	linkPtr->addr = addr;
    }

    /*
     * If necessary create space for last used value.
     */

    if (size > 1) {
	linkPtr->lastValue.aryPtr = Tcl_Alloc(linkPtr->bytes);
	linkPtr->flags |= LINK_ALLOC_LAST;
    }

    /*
     * Initialize allocated space.
     */

    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	memset(linkPtr->addr, 0, linkPtr->bytes);
    }
    if (linkPtr->flags & LINK_ALLOC_LAST) {
	memset(linkPtr->lastValue.aryPtr, 0, linkPtr->bytes);
    }

    /*
     * Set common structure values.
     */

    linkPtr->interp = interp;
    linkPtr->varName = Tcl_NewStringObj(varName, -1);
    Tcl_IncrRefCount(linkPtr->varName);

    TclGetNamespaceForQualName(interp, varName, NULL, TCL_GLOBAL_ONLY,
	    &(linkPtr->nsPtr), &dummy, &dummy, &name);
    linkPtr->nsPtr->refCount++;

    objPtr = ObjValue(linkPtr);
    if (Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, objPtr,
	    TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
	Tcl_DecrRefCount(linkPtr->varName);
	LinkFree(linkPtr);
	return TCL_ERROR;
    }

    code = Tcl_TraceVar2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
    if (code != TCL_OK) {
	Tcl_DecrRefCount(linkPtr->varName);
	TclNsDecrRefCount(linkPtr->nsPtr);
	LinkFree(linkPtr);
	ckfree((char *) linkPtr);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+

-
+
-

+
+



-
+

-
+

+
+
+
-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_UnlinkVar(
    Tcl_Interp *interp,		/* Interpreter containing variable to unlink */
    const char *varName)	/* Global variable in interp to unlink. */
    CONST char *varName)	/* Global variable in interp to unlink. */
{
    Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
    Link *linkPtr;
	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);

    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
	    LinkTraceProc, (ClientData) NULL);
    if (linkPtr == NULL) {
	return;
    }
    Tcl_UntraceVar2(interp, varName, NULL,
    Tcl_UntraceVar(interp, varName,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    LinkTraceProc, linkPtr);
	    LinkTraceProc, (ClientData) linkPtr);
    Tcl_DecrRefCount(linkPtr->varName);
    if (linkPtr->nsPtr) {
	TclNsDecrRefCount(linkPtr->nsPtr);
    }
    LinkFree(linkPtr);
    ckfree((char *) linkPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpdateLinkedVar --
 *
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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







-
+

-
+
-


+
+










-
-
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *
 *----------------------------------------------------------------------
 */

void
Tcl_UpdateLinkedVar(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *varName)	/* Name of global variable that is linked. */
    CONST char *varName)	/* Name of global variable that is linked. */
{
    Link *linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
    Link *linkPtr;
	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
    int savedFlag;

    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
	    LinkTraceProc, (ClientData) NULL);
    if (linkPtr == NULL) {
	return;
    }
    savedFlag = linkPtr->flags & LINK_BEING_UPDATED;
    linkPtr->flags |= LINK_BEING_UPDATED;
    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
	    TCL_GLOBAL_ONLY);
    /*
     * Callback may have unlinked the variable. [Bug 1740631]
     */
    linkPtr = (Link *) Tcl_VarTraceInfo2(interp, varName, NULL,
	    TCL_GLOBAL_ONLY, LinkTraceProc, NULL);
    linkPtr = (Link *) Tcl_VarTraceInfo(interp, varName, TCL_GLOBAL_ONLY,
	    LinkTraceProc, (ClientData) NULL);
    if (linkPtr != NULL) {
	linkPtr->flags = (linkPtr->flags & ~LINK_BEING_UPDATED) | savedFlag;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GetInt, GetWide, GetUWide, GetDouble, EqualDouble, IsSpecial --
 *
 *	Helper functions for LinkTraceProc and ObjValue. These are all
 *	factored out here to make those functions simpler.
 *
 *----------------------------------------------------------------------
 */

static inline int
GetInt(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    return (Tcl_GetIntFromObj(NULL, objPtr, intPtr) != TCL_OK
	    && GetInvalidIntFromObj(objPtr, intPtr) != TCL_OK);
}

static inline int
GetWide(
    Tcl_Obj *objPtr,
    Tcl_WideInt *widePtr)
{
    if (Tcl_GetWideIntFromObj(NULL, objPtr, widePtr) != TCL_OK) {
	int intValue;

	if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	    return 1;
	}
	*widePtr = intValue;
    }
    return 0;
}

static inline int
GetUWide(
    Tcl_Obj *objPtr,
    Tcl_WideUInt *uwidePtr)
{
    Tcl_WideInt *widePtr = (Tcl_WideInt *) uwidePtr;
    ClientData clientData;
    int type, intValue;

    if (TclGetNumberFromObj(NULL, objPtr, &clientData, &type) == TCL_OK) {
	if (type == TCL_NUMBER_INT) {
	    *widePtr = *((const Tcl_WideInt *) clientData);
	    return (*widePtr < 0);
	} else if (type == TCL_NUMBER_BIG) {
	    mp_int *numPtr = (mp_int *)clientData;
	    Tcl_WideUInt value = 0;
	    union {
		Tcl_WideUInt value;
		unsigned char bytes[sizeof(Tcl_WideUInt)];
	    } scratch;
	    size_t numBytes;
	    unsigned char *bytes = scratch.bytes;

	    if (numPtr->sign || (MP_OKAY != mp_to_ubin(numPtr,
		    bytes, sizeof(Tcl_WideUInt), &numBytes))) {
		/*
		 * If the sign bit is set (a negative value) or if the value
		 * can't possibly fit in the bits of an unsigned wide, there's
		 * no point in doing further conversion.
		 */
		return 1;
	    }
#ifdef WORDS_BIGENDIAN
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
#else /* !WORDS_BIGENDIAN */
	    /*
	     * Little-endian can read the value directly.
	     */
	    value = scratch.value;
#endif /* WORDS_BIGENDIAN */
	    *uwidePtr = value;
	    return 0;
	}
    }

    /*
     * Evil edge case fallback.
     */

    if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
	return 1;
    }
    *uwidePtr = intValue;
    return 0;
}

static inline int
GetDouble(
    Tcl_Obj *objPtr,
    double *dblPtr)
{
    if (Tcl_GetDoubleFromObj(NULL, objPtr, dblPtr) == TCL_OK) {
	return 0;
    } else {
#ifdef ACCEPT_NAN
	Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &tclDoubleType);

	if (irPtr != NULL) {
	    *dblPtr = irPtr->doubleValue;
	    return 0;
	}
#endif /* ACCEPT_NAN */
	return GetInvalidDoubleFromObj(objPtr, dblPtr) != TCL_OK;
    }
}

static inline int
EqualDouble(
    double a,
    double b)
{
    return (a == b)
#ifdef ACCEPT_NAN
	|| (TclIsNaN(a) && TclIsNaN(b))
#endif /* ACCEPT_NAN */
	;
}

static inline int
IsSpecial(
    double a)
{
    return TclIsInfinite(a)
#ifdef ACCEPT_NAN
	|| TclIsNaN(a)
#endif /* ACCEPT_NAN */
	;
}

/*
 * Mark an object as holding a weird double.
 */

static int
SetInvalidRealFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)
{
    size_t length;
    const char *str, *endPtr;

    str = TclGetStringFromObj(objPtr, &length);
    if ((length == 1) && (str[0] == '.')) {
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
    if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr,
	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
	/*
	 * If number is followed by [eE][+-]?, then it is an invalid double,
	 * but it could be the start of a valid double.
	 */

	if (*endPtr == 'e' || *endPtr == 'E') {
	    ++endPtr;
	    if (*endPtr == '+' || *endPtr == '-') {
		++endPtr;
	    }
	    if (*endPtr == 0) {
		double doubleValue = 0.0;

		Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &invalidRealType;
		objPtr->internalRep.doubleValue = doubleValue;
		return TCL_OK;
	    }
	}
    }
    return TCL_ERROR;
}

/*
 * This function checks for integer representations, which are valid when
 * linking with C variables, but which are invalid in other contexts in Tcl.
 * Handled are "+", "-", "", "0x", "0b", "0d" and "0o" (upper- and
 * lower-case).  See bug [39f6304c2e].
 */

static int
GetInvalidIntFromObj(
    Tcl_Obj *objPtr,
    int *intPtr)
{
    size_t length;
    const char *str = TclGetStringFromObj(objPtr, &length);

    if ((length == 0) ||
	    ((length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
	*intPtr = 0;
	return TCL_OK;
    } else if ((length == 1) && strchr("+-", str[0])) {
	*intPtr = (str[0] == '+');
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 * This function checks for double representations, which are valid when
 * linking with C variables, but which are invalid in other contexts in Tcl.
 * Handled are "+", "-", "", ".", "0x", "0b" and "0o" (upper- and lower-case)
 * and sequences like "1e-". See bug [39f6304c2e].
 */

static int
GetInvalidDoubleFromObj(
    Tcl_Obj *objPtr,
    double *doublePtr)
{
    int intValue;

    if (TclHasIntRep(objPtr, &invalidRealType)) {
	goto gotdouble;
    }
    if (GetInvalidIntFromObj(objPtr, &intValue) == TCL_OK) {
	*doublePtr = (double) intValue;
	return TCL_OK;
    }
    if (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK) {
    gotdouble:
	*doublePtr = objPtr->internalRep.doubleValue;
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * LinkTraceProc --
 *
 *	This function is invoked when a linked Tcl variable is read, written,
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
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
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
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
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





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
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
611
612







-
+
-
-
+
-
-


-
-
+
+
-
-
+




-

-
-
-









+
+
+
-
+



-
+

-
+




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
-
-
+
-




















-
+







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
+
+
+

-

+



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
+
-



-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

+

-
-
-
+
+
-
-
-
-
-
-
+
+
-



-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
-



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
+
-
-
-
-
-
-
+
-



-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
+
-
-
+
-
-
-
-
-
-
+
-
-



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
+
-
-
-
-
-
-
+
-



-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
+
-
-
+
-
-
-
-
-
-
+
-
-



-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
-

-
+
-
-
-
-
-
-
+
+
-
-


-

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-

-
+
-
-
-
-
-
-
+
+
-



-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
-

-
-
-
+
-
-
-
-
+
+
-
-

-


+
+
+
+
-
-
+
+
-
-
-
+
+
-
-
-
-
+
+
+
-

-
-
+
-
-
-
-
+
+
-



-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+



-
+
-
-
-
-







 *----------------------------------------------------------------------
 */

static char *
LinkTraceProc(
    ClientData clientData,	/* Contains information about the link. */
    Tcl_Interp *interp,		/* Interpreter containing Tcl variable. */
    TCL_UNUSED(const char *) /*name1*/,
    CONST char *name1,		/* First part of variable name. */
    TCL_UNUSED(const char *) /*name2*/,
				/* Links can only be made to global variables,
    CONST char *name2,		/* Second part of variable name. */
				 * so we can find them with need to resolve
				 * caller-supplied name in caller context. */
    int flags)			/* Miscellaneous additional information. */
{
    Link *linkPtr = (Link *)clientData;
    int changed;
    Link *linkPtr = (Link *) clientData;
    int changed, valueLength;
    size_t valueLength = 0;
    const char *value;
    CONST char *value;
    char **pp;
    Tcl_Obj *valueObj;
    int valueInt;
    Tcl_WideInt valueWide;
    Tcl_WideUInt valueUWide;
    double valueDouble;
    int objc;
    Tcl_Obj **objv;
    int i;

    /*
     * If the variable is being unset, then just re-create it (with a trace)
     * unless the whole interpreter is going away.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if (Tcl_InterpDeleted(interp) || TclNamespaceDeleted(linkPtr->nsPtr)) {
	    Tcl_DecrRefCount(linkPtr->varName);
	    if (linkPtr->nsPtr) {
		TclNsDecrRefCount(linkPtr->nsPtr);
	    }
	    LinkFree(linkPtr);
	    ckfree((char *) linkPtr);
	} else if (flags & TCL_TRACE_DESTROYED) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    Tcl_TraceVar2(interp, TclGetString(linkPtr->varName), NULL,
	    Tcl_TraceVar(interp, Tcl_GetString(linkPtr->varName),
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, LinkTraceProc, linkPtr);
		    |TCL_TRACE_UNSETS, LinkTraceProc, (ClientData) linkPtr);
	}
	return NULL;
    }

    /*
     * If we were invoked because of a call to Tcl_UpdateLinkedVar, then don't
     * do anything at all. In particular, we don't want to get upset that the
     * variable is being modified, even if it is supposed to be read-only.
     */

    if (linkPtr->flags & LINK_BEING_UPDATED) {
	return NULL;
    }

    /*
     * For read accesses, update the Tcl variable if the C variable has
     * changed since the last time we updated the Tcl variable.
     */

    if (flags & TCL_TRACE_READS) {
	/*
	 * Variable arrays
	 */

	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    changed = memcmp(linkPtr->addr, linkPtr->lastValue.aryPtr,
		    linkPtr->bytes);
	} else {
	    /* single variables */
	    switch (linkPtr->type) {
	    case TCL_LINK_INT:
	    case TCL_LINK_BOOLEAN:
		changed = (LinkedVar(int) != linkPtr->lastValue.i);
		break;
	    case TCL_LINK_DOUBLE:
		changed = !EqualDouble(LinkedVar(double), linkPtr->lastValue.d);
		break;
	    case TCL_LINK_WIDE_INT:
		changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
		break;
	    case TCL_LINK_WIDE_UINT:
		changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
		break;
	    case TCL_LINK_CHAR:
		changed = (LinkedVar(char) != linkPtr->lastValue.c);
		break;
	    case TCL_LINK_UCHAR:
		changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
		break;
	    case TCL_LINK_SHORT:
		changed = (LinkedVar(short) != linkPtr->lastValue.s);
		break;
	    case TCL_LINK_USHORT:
		changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
		break;
	    case TCL_LINK_UINT:
		changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
		break;
	switch (linkPtr->type) {
	case TCL_LINK_INT:
	case TCL_LINK_BOOLEAN:
	    changed = (LinkedVar(int) != linkPtr->lastValue.i);
	    break;
	case TCL_LINK_DOUBLE:
	    changed = (LinkedVar(double) != linkPtr->lastValue.d);
	    break;
	case TCL_LINK_WIDE_INT:
	    changed = (LinkedVar(Tcl_WideInt) != linkPtr->lastValue.w);
	    break;
	case TCL_LINK_WIDE_UINT:
	    changed = (LinkedVar(Tcl_WideUInt) != linkPtr->lastValue.uw);
	    break;
	case TCL_LINK_CHAR:
	    changed = (LinkedVar(char) != linkPtr->lastValue.c);
	    break;
	case TCL_LINK_UCHAR:
	    changed = (LinkedVar(unsigned char) != linkPtr->lastValue.uc);
	    break;
	case TCL_LINK_SHORT:
	    changed = (LinkedVar(short) != linkPtr->lastValue.s);
	    break;
	case TCL_LINK_USHORT:
	    changed = (LinkedVar(unsigned short) != linkPtr->lastValue.us);
	    break;
	case TCL_LINK_UINT:
	    changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
	    break;
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
	    case TCL_LINK_LONG:
		changed = (LinkedVar(long) != linkPtr->lastValue.l);
		break;
	    case TCL_LINK_ULONG:
		changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
		break;
	case TCL_LINK_LONG:
	    changed = (LinkedVar(long) != linkPtr->lastValue.l);
	    break;
	case TCL_LINK_ULONG:
	    changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
	    break;
#endif
	    case TCL_LINK_FLOAT:
		changed = !EqualDouble(LinkedVar(float), linkPtr->lastValue.f);
		break;
	    case TCL_LINK_STRING:
	case TCL_LINK_FLOAT:
	    changed = (LinkedVar(float) != linkPtr->lastValue.f);
	    break;
	case TCL_LINK_STRING:
	    case TCL_LINK_CHARS:
	    case TCL_LINK_BINARY:
		changed = 1;
		break;
	    default:
	    changed = 1;
	    break;
	default:
		changed = 0;
		/* return (char *) "internal error: bad linked variable type"; */
	    return "internal error: bad linked variable type";
	    }
	}
	if (changed) {
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	}
	return NULL;
    }

    /*
     * For writes, first make sure that the variable is writable. Then convert
     * the Tcl value to C if possible. If the variable isn't writable or can't
     * be converted, then restore the varaible's old value and return an
     * error. Another tricky thing: we have to save and restore the interp's
     * result, since the variable access could occur when the result has been
     * partially set.
     */

    if (linkPtr->flags & LINK_READ_ONLY) {
	Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		TCL_GLOBAL_ONLY);
	return (char *) "linked variable is read-only";
	return "linked variable is read-only";
    }
    valueObj = Tcl_ObjGetVar2(interp, linkPtr->varName,NULL, TCL_GLOBAL_ONLY);
    if (valueObj == NULL) {
	/*
	 * This shouldn't ever happen.
	 */

	return (char *) "internal error: linked variable couldn't be read";
	return "internal error: linked variable couldn't be read";
    }

    /*
     * Special cases.
     */

    switch (linkPtr->type) {
    case TCL_LINK_STRING:
	value = TclGetStringFromObj(valueObj, &valueLength);
	pp = (char **) linkPtr->addr;

	*pp = (char *)Tcl_Realloc(*pp, ++valueLength);
	memcpy(*pp, value, valueLength);
	return NULL;

    case TCL_LINK_CHARS:
	value = (char *) TclGetStringFromObj(valueObj, &valueLength);
	valueLength++;		/* include end of string char */
	if (valueLength > linkPtr->bytes) {
	    return (char *) "wrong size of char* value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, valueLength);
	    memcpy(linkPtr->addr, value, valueLength);
	} else {
	    linkPtr->lastValue.c = '\0';
	    LinkedVar(char) = linkPtr->lastValue.c;
	}
	return NULL;

    case TCL_LINK_BINARY:
	value = (char *) TclGetByteArrayFromObj(valueObj, &valueLength);
	if (valueLength != linkPtr->bytes) {
	    return (char *) "wrong size of binary value";
	}
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, value, valueLength);
	    memcpy(linkPtr->addr, value, valueLength);
	} else {
	    linkPtr->lastValue.uc = (unsigned char) *value;
	    LinkedVar(unsigned char) = linkPtr->lastValue.uc;
	}
	return NULL;
    }

    /*
     * A helper macro. Writing this as a function is messy because of type
     * variance.
     */

#define InRange(lowerLimit, value, upperLimit)			\
    ((value) >= (lowerLimit) && (value) <= (upperLimit))

    /*
     * If we're working with an array of numbers, extract the Tcl list.
     */

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	if (Tcl_ListObjGetElements(NULL, (valueObj), &objc, &objv) == TCL_ERROR
		|| (size_t)objc != linkPtr->numElems) {
	    return (char *) "wrong dimension";
	}
    }

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

	if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
		!= TCL_OK) {
		if (GetInt(objv[i], varPtr)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have integer values";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

	    if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i)
		    != TCL_OK) {
	    if (GetInt(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have integer value";
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
		return "variable must have integer value";
	    }
	    LinkedVar(int) = *varPtr;
	}
	LinkedVar(int) = linkPtr->lastValue.i;
	break;

    case TCL_LINK_WIDE_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		Tcl_WideInt *varPtr = &linkPtr->lastValue.wPtr[i];

		if (GetWide(objv[i], varPtr)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *)
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
		!= TCL_OK) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
		return "variable must have integer value";
			    "variable array must have wide integer value";
		}
	    }
	    }
	} else {
	    Tcl_WideInt *varPtr = &linkPtr->lastValue.w;

	    linkPtr->lastValue.w = (Tcl_WideInt) valueInt;
	}
	    if (GetWide(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have wide integer value";
	    }
	    LinkedVar(Tcl_WideInt) = *varPtr;
	LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
	}
	break;

    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetDouble(objv[i], &linkPtr->lastValue.dPtr[i])) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		    return (char *) "variable array must have real value";
	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
		!= TCL_OK) {
#ifdef ACCEPT_NAN
	    if (valueObj->typePtr != &tclDoubleType) {
#endif
		if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d)
			!= TCL_OK) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
		    return "variable must have real value";
		}
#ifdef ACCEPT_NAN
	    }
	} else {
	    double *varPtr = &linkPtr->lastValue.d;

	    linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
#endif
	    if (GetDouble(valueObj, varPtr)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have real value";
	    }
	    LinkedVar(double) = *varPtr;
	}
	LinkedVar(double) = linkPtr->lastValue.d;
	}
	break;

    case TCL_LINK_BOOLEAN:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		int *varPtr = &linkPtr->lastValue.iPtr[i];

		if (Tcl_GetBooleanFromObj(NULL, objv[i], varPtr) != TCL_OK) {
	if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have boolean value";
		}
	    }
	} else {
	    int *varPtr = &linkPtr->lastValue.i;

		!= TCL_OK) {
	    if (Tcl_GetBooleanFromObj(NULL, valueObj, varPtr) != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have boolean value";
	    }
	    LinkedVar(int) = *varPtr;
	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
		    TCL_GLOBAL_ONLY);
	    return "variable must have boolean value";
	}
	LinkedVar(int) = linkPtr->lastValue.i;
	}
	break;

    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have char value";
		}
	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
		|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
		return "variable must have char value";
	    }
		linkPtr->lastValue.cPtr[i] = (char) valueInt;
	    }
	}
	} else {
	    if (GetInt(valueObj, &valueInt)
	linkPtr->lastValue.c = (char)valueInt;
		    || !InRange(SCHAR_MIN, valueInt, SCHAR_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have char value";
	    }
	    LinkedVar(char) = linkPtr->lastValue.c = (char) valueInt;
	LinkedVar(char) = linkPtr->lastValue.c;
	}
	break;

    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, UCHAR_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
		|| valueInt < 0 || valueInt > UCHAR_MAX) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
		    return (char *)
			    "variable array must have unsigned char value";
		}
		return "variable must have unsigned char value";
	    }
		linkPtr->lastValue.ucPtr[i] = (unsigned char) valueInt;
	    }
	}
	} else {
	    if (GetInt(valueObj, &valueInt)
	linkPtr->lastValue.uc = (unsigned char) valueInt;
		    || !InRange(0, valueInt, UCHAR_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned char value";
	    }
	    LinkedVar(unsigned char) = linkPtr->lastValue.uc =
	LinkedVar(unsigned char) = linkPtr->lastValue.uc;
		    (unsigned char) valueInt;
	}
	break;

    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
			|| !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have short value";
		}
	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
		|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
		return "variable must have short value";
	    }
		linkPtr->lastValue.sPtr[i] = (short) valueInt;
	    }
	}
	} else {
	    if (GetInt(valueObj, &valueInt)
	linkPtr->lastValue.s = (short)valueInt;
		    || !InRange(SHRT_MIN, valueInt, SHRT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have short value";
	    }
	    LinkedVar(short) = linkPtr->lastValue.s = (short) valueInt;
	LinkedVar(short) = linkPtr->lastValue.s;
	}
	break;

    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetInt(objv[i], &valueInt)
		        || !InRange(0, valueInt, USHRT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
		|| valueInt < 0 || valueInt > USHRT_MAX) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
	            return (char *)
			"variable array must have unsigned short value";
		}
		return "variable must have unsigned short value";
	    }
		linkPtr->lastValue.usPtr[i] = (unsigned short) valueInt;
	    }
	}
	} else {
	    if (GetInt(valueObj, &valueInt)
	linkPtr->lastValue.us = (unsigned short)valueInt;
		    || !InRange(0, valueInt, USHRT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned short value";
	    }
	    LinkedVar(unsigned short) = linkPtr->lastValue.us =
	LinkedVar(unsigned short) = linkPtr->lastValue.us;
		    (unsigned short) valueInt;
	}
	break;

    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetWide(objv[i], &valueWide)
			|| !InRange(0, valueWide, UINT_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
		|| valueWide < 0 || valueWide > UINT_MAX) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned int value";
		}
		linkPtr->lastValue.uiPtr[i] = (unsigned int) valueWide;
		return "variable must have unsigned int value";
	    }
	    linkPtr->lastValue.ui = (unsigned int)valueInt;
	    }
	} else {
	    if (GetWide(valueObj, &valueWide)
	    linkPtr->lastValue.ui = (unsigned int)valueWide;
		    || !InRange(0, valueWide, UINT_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned int value";
	    }
	    LinkedVar(unsigned int) = linkPtr->lastValue.ui =
	}
	LinkedVar(unsigned int) = linkPtr->lastValue.ui;
		    (unsigned int) valueWide;
	}
	break;

#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetWide(objv[i], &valueWide)
			|| !InRange(LONG_MIN, valueWide, LONG_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have long value";
		}
		linkPtr->lastValue.lPtr[i] = (long) valueWide;
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
		|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
		return "variable must have long value";
	    }
	    linkPtr->lastValue.l = (long)valueInt;
	    }
	} else {
	    if (GetWide(valueObj, &valueWide)
	    linkPtr->lastValue.l = (long)valueWide;
		    || !InRange(LONG_MIN, valueWide, LONG_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have long value";
	    }
	    LinkedVar(long) = linkPtr->lastValue.l = (long) valueWide;
	}
	LinkedVar(long) = linkPtr->lastValue.l;
	}
	break;

    case TCL_LINK_ULONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetUWide(objv[i], &valueUWide)
			|| (valueUWide > ULONG_MAX)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
		|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned long value";
		}
		linkPtr->lastValue.ulPtr[i] = (unsigned long) valueUWide;
		return "variable must have unsigned long value";
	    }
	    linkPtr->lastValue.ul = (unsigned long)valueInt;
	    }
	} else {
	    if (GetUWide(valueObj, &valueUWide)
		    || (valueUWide > ULONG_MAX)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
	    linkPtr->lastValue.ul = (unsigned long)valueWide;
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned long value";
	    }
	    LinkedVar(unsigned long) = linkPtr->lastValue.ul =
	}
	LinkedVar(unsigned long) = linkPtr->lastValue.ul;
		    (unsigned long) valueUWide;
	}
	break;
#endif

    case TCL_LINK_WIDE_UINT:
	/*
	 * FIXME: represent as a bignum.
	 */
	if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) {
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
	    if (GetInvalidIntFromObj(valueObj, &valueInt)
		    != TCL_OK) {
		if (GetUWide(objv[i], &valueUWide)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
	            return (char *)
			    "variable array must have unsigned wide int value";
		}
		linkPtr->lastValue.uwPtr[i] = valueUWide;
		return "variable must have unsigned wide int value";
	    }
	    linkPtr->lastValue.uw = (Tcl_WideUInt)valueInt;
	    }
	} else {
	    if (GetUWide(valueObj, &valueUWide)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
	    linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have unsigned wide int value";
	    }
	    LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = valueUWide;
	}
	LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
	}
	break;

    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    for (i=0; i < objc; i++) {
		if (GetDouble(objv[i], &valueDouble)
			&& !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		        && !IsSpecial(valueDouble)) {
		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
			    ObjValue(linkPtr), TCL_GLOBAL_ONLY);
	            return (char *) "variable array must have float value";
		}
	if (Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
		|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
	    if (GetInvalidDoubleFromObj(valueObj, &valueDouble)
		    != TCL_OK) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
			TCL_GLOBAL_ONLY);
		return "variable must have float value";
	    }
		linkPtr->lastValue.fPtr[i] = (float) valueDouble;
	    }
	}
	} else {
	    if (GetDouble(valueObj, &valueDouble)
		    && !InRange(FLT_MIN, fabs(valueDouble), FLT_MAX)
		    && !IsSpecial(valueDouble)) {
		Tcl_ObjSetVar2(interp, linkPtr->varName, NULL,
	linkPtr->lastValue.f = (float)valueDouble;
	LinkedVar(float) = linkPtr->lastValue.f;
			ObjValue(linkPtr), TCL_GLOBAL_ONLY);
		return (char *) "variable must have float value";
	    }
	    LinkedVar(float) = linkPtr->lastValue.f = (float) valueDouble;
	}
	break;

    case TCL_LINK_STRING:
	value = Tcl_GetStringFromObj(valueObj, &valueLength);
	valueLength++;
	pp = (char **) linkPtr->addr;

	*pp = ckrealloc(*pp, valueLength);
	memcpy(*pp, value, (unsigned) valueLength);
	break;

    default:
	return (char *) "internal error: bad linked variable type";
	return "internal error: bad linked variable type";
    }

    if (linkPtr->flags & LINK_ALLOC_LAST) {
	memcpy(linkPtr->addr, linkPtr->lastValue.aryPtr, linkPtr->bytes);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
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
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

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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464



1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511


















































1512
1513
1514
1515
1516
1517


















1518





1519
1520
1521


1522
1523

1524
1525

1526
1527
1528
1529





1530

1531
1532


1533
1534

1535
1536
1537
1538
1539
1540
1541
1542
1543
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



















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
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







-
+
-



-
-
-
-
-
-
-
-
-
-

-
+

-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-

-
+

-
-
-
-
-
-
-
-
-
-

-
+

-
-
-
-
-
-
-
-
-
-

-
+

-
-
-
-
-
-
-
-
-
-

-
+

-
-
-
-
-
-
-
-
-
-

-
+

-
-
-
-
-
-
-
-
-
-


-

-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-


-

-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-

+
+
+

-








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+

-
-
+
+
-
-
+

-
+
-
-
-
-
+
+
+
+
+

+
-
-
+
+

-
+









 */

static Tcl_Obj *
ObjValue(
    Link *linkPtr)		/* Structure describing linked variable. */
{
    char *p;
    Tcl_Obj *resultObj, **objv;
    Tcl_Obj *resultObj;
    size_t i;

    switch (linkPtr->type) {
    case TCL_LINK_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.iPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewWideIntObj(linkPtr->lastValue.i);
	return Tcl_NewIntObj(linkPtr->lastValue.i);
    case TCL_LINK_WIDE_INT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.wPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.w = LinkedVar(Tcl_WideInt);
	return Tcl_NewWideIntObj(linkPtr->lastValue.w);
    case TCL_LINK_DOUBLE:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.dPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.d = LinkedVar(double);
	return Tcl_NewDoubleObj(linkPtr->lastValue.d);
    case TCL_LINK_BOOLEAN:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewBooleanObj(linkPtr->lastValue.iPtr[i] != 0);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.i = LinkedVar(int);
	return Tcl_NewBooleanObj(linkPtr->lastValue.i);
	return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
    case TCL_LINK_CHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.cPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.c = LinkedVar(char);
	return Tcl_NewWideIntObj(linkPtr->lastValue.c);
	return Tcl_NewIntObj(linkPtr->lastValue.c);
    case TCL_LINK_UCHAR:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.ucPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewWideIntObj(linkPtr->lastValue.uc);
	return Tcl_NewIntObj(linkPtr->lastValue.uc);
    case TCL_LINK_SHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.sPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.s = LinkedVar(short);
	return Tcl_NewWideIntObj(linkPtr->lastValue.s);
	return Tcl_NewIntObj(linkPtr->lastValue.s);
    case TCL_LINK_USHORT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.usPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.us = LinkedVar(unsigned short);
	return Tcl_NewWideIntObj(linkPtr->lastValue.us);
	return Tcl_NewIntObj(linkPtr->lastValue.us);
    case TCL_LINK_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.uiPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ui = LinkedVar(unsigned int);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
    case TCL_LINK_LONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.lPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.l = LinkedVar(long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
    case TCL_LINK_ULONG:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], linkPtr->lastValue.ulPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.ul = LinkedVar(unsigned long);
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
#endif
    case TCL_LINK_FLOAT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		objv[i] = Tcl_NewDoubleObj(linkPtr->lastValue.fPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.f = LinkedVar(float);
	return Tcl_NewDoubleObj(linkPtr->lastValue.f);
    case TCL_LINK_WIDE_UINT:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    objv = (Tcl_Obj **)Tcl_Alloc(linkPtr->numElems * sizeof(Tcl_Obj *));
	    for (i=0; i < linkPtr->numElems; i++) {
		TclNewIntObj(objv[i], (Tcl_WideInt)
			linkPtr->lastValue.uwPtr[i]);
	    }
	    resultObj = Tcl_NewListObj(linkPtr->numElems, objv);
	    Tcl_Free(objv);
	    return resultObj;
	}
	linkPtr->lastValue.uw = LinkedVar(Tcl_WideUInt);
	/*
	 * FIXME: represent as a bignum.
	 */
	return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.uw);

    case TCL_LINK_STRING:
	p = LinkedVar(char *);
	if (p == NULL) {
	    TclNewLiteralStringObj(resultObj, "NULL");
	    return resultObj;
	}
	return Tcl_NewStringObj(p, -1);

    case TCL_LINK_CHARS:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    linkPtr->lastValue.cPtr[linkPtr->bytes-1] = '\0';
	    /* take care of proper string end */
	    return Tcl_NewStringObj(linkPtr->lastValue.cPtr, linkPtr->bytes);
	}
	linkPtr->lastValue.c = '\0';
	return Tcl_NewStringObj(&linkPtr->lastValue.c, 1);

    case TCL_LINK_BINARY:
	if (linkPtr->flags & LINK_ALLOC_LAST) {
	    memcpy(linkPtr->lastValue.aryPtr, linkPtr->addr, linkPtr->bytes);
	    return Tcl_NewByteArrayObj((unsigned char *) linkPtr->addr,
		    linkPtr->bytes);
	}
	linkPtr->lastValue.uc = LinkedVar(unsigned char);
	return Tcl_NewByteArrayObj(&linkPtr->lastValue.uc, 1);

    /*
     * This code only gets executed if the link type is unknown (shouldn't
     * ever happen).
     */

    default:
	TclNewLiteralStringObj(resultObj, "??");
	return resultObj;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * LinkFree --
 *
 *	Free's allocated space of given link and link structure.
 *

static int SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

static Tcl_ObjType invalidRealType = {
    "invalidReal",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetInvalidRealFromAny		/* setFromAnyProc */
};

static int
SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
    int length;
    const char *str;
    const char *endPtr;

    str = TclGetStringFromObj(objPtr, &length);
    if ((length == 1) && (str[0] == '.')){
	objPtr->typePtr = &invalidRealType;
	objPtr->internalRep.doubleValue = 0.0;
	return TCL_OK;
    }
    if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr,
	    TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
	/* If number is followed by [eE][+-]?, then it is an invalid
	 * double, but it could be the start of a valid double. */
	if (*endPtr == 'e' || *endPtr == 'E') {
	    ++endPtr;
	    if (*endPtr == '+' || *endPtr == '-') ++endPtr;
	    if (*endPtr == 0) {
		double doubleValue = 0.0;
		Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
		if (objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr);
		objPtr->typePtr = &invalidRealType;
		objPtr->internalRep.doubleValue = doubleValue;
		return TCL_OK;
	    }
	}
    }
    return TCL_ERROR;
}


/*
 * This function checks for integer representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are "", "+", "-", "0x", "0b" and "0o"
 * (upperand lowercase). See bug [39f6304c2e].
 */
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
int
GetInvalidIntFromObj(Tcl_Obj *objPtr,
				int *intPtr)
{
    int length;
    const char *str = TclGetStringFromObj(objPtr, &length);

    if ((length == 1) && strchr("+-", str[0])) {
	*intPtr = (str[0] == '+');
	return TCL_OK;
    } else if ((length == 0) ||
	    ((length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
	*intPtr = 0;
	return TCL_OK;
    }
    return TCL_ERROR;
}

 *----------------------------------------------------------------------
/*
 * This function checks for double representations, which are valid
 * when linking with C variables, but which are invalid in other
 * contexts in Tcl. Handled are ".", "+", "-", "0x", "0b" and "0o"
 * (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
 */

static void
int
GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
LinkFree(
    Link *linkPtr)		/* Structure describing linked variable. */
				double *doublePtr)
{
    if (linkPtr->nsPtr) {
    int intValue, result;
	TclNsDecrRefCount(linkPtr->nsPtr);
    }
    if (linkPtr->flags & LINK_ALLOC_ADDR) {
	Tcl_Free(linkPtr->addr);

    if ((objPtr->typePtr == &invalidRealType) ||
	    (SetInvalidRealFromAny(NULL, objPtr) == TCL_OK)) {
	*doublePtr = objPtr->internalRep.doubleValue;
	return TCL_OK;
    }
    result = GetInvalidIntFromObj(objPtr, &intValue);
    if (linkPtr->flags & LINK_ALLOC_LAST) {
	Tcl_Free(linkPtr->lastValue.aryPtr);
    if (result == TCL_OK) {
	*doublePtr = (double) intValue;
    }
    Tcl_Free(linkPtr);
    return result;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclListObj.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23


24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

43
44
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
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







-






-
-
+
+


















-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
+
+
+
+


-
+
-
-
-
-
+
+
+

-
+
-
-
-
+
+







-
+







 * 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 <assert.h>

/*
 * Prototypes for functions defined later in this file:
 */

static List *		AttemptNewList(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static List *		NewListIntRep(int objc, Tcl_Obj *const objv[], int p);
			    Tcl_Obj *CONST objv[]);
static List *		NewListIntRep(int objc, Tcl_Obj *CONST objv[], int p);
static void		DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void		FreeListInternalRep(Tcl_Obj *listPtr);
static int		SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfList(Tcl_Obj *listPtr);

/*
 * The structure below defines the list Tcl object type by means of functions
 * that can be invoked by generic object code.
 *
 * The internal representation of a list object is a two-pointer
 * representation. The first pointer designates a List structure that contains
 * an array of pointers to the element objects, together with integers that
 * represent the current element count and the allocated size of the array.
 * The second pointer is normally NULL; during execution of functions in this
 * file that operate on nested sublists, it is occasionally used as working
 * storage to avoid an auxiliary stack.
 */

const Tcl_ObjType tclListType = {
Tcl_ObjType tclListType = {
    "list",			/* name */
    FreeListInternalRep,	/* freeIntRepProc */
    DupListInternalRep,		/* dupIntRepProc */
    UpdateStringOfList,		/* updateStringProc */
    SetListFromAny		/* setFromAnyProc */
};

/* Macros to manipulate the List internal rep */

#define ListSetIntRep(objPtr, listRepPtr)				\
    do {								\
	Tcl_ObjIntRep ir;						\
	ir.twoPtrValue.ptr1 = (listRepPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	(listRepPtr)->refCount++;					\
	Tcl_StoreIntRep((objPtr), &tclListType, &ir);			\
    } while (0)

#define ListGetIntRep(objPtr, listRepPtr)				\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &tclListType);		\
	(listRepPtr) = irPtr ? (List *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

#define ListResetIntRep(objPtr, listRepPtr) \
    TclFetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)

#ifndef TCL_MIN_ELEMENT_GROWTH
#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
#endif

/*
 *----------------------------------------------------------------------
 *
 * NewListIntRep --
 *
 *	Creates a 'List' structure with space for 'objc' elements.  'objc' must
 *	be > 0.  If 'objv' is not NULL, The list is initialized with first
 *	'objc' values in that array.  Otherwise the list is initialized to have
 *	0 elements, with space to add 'objc' more.  Flag value 'p' indicates
 *	Creates a list internal rep with space for objc elements.  objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values
 *	in that array.  If objv==NULL, initalize list internal rep to have
 *	0 elements, with space to add objc more.  Flag value "p" indicates
 *	how to behave on failure.
 *
 * Value
 * Results:
 *
 *	A new 'List' structure with refCount 0. If some failure
 *	prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
 *	is called if it is not.
 *	A new List struct with refCount 0 is returned. If some failure
 *	prevents this then if p=0, NULL is returned and otherwise the
 *	routine panics.
 *
 * Effect
 * Side effects:
 *
 *	The refCount of each value in 'objv' is incremented as it is added
 *	to the list.
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static List *
NewListIntRep(
    int objc,
    Tcl_Obj *const objv[],
    Tcl_Obj *CONST objv[],
    int p)
{
    List *listRepPtr;

    if (objc <= 0) {
	Tcl_Panic("NewListIntRep: expects postive element count");
    }
120
121
122
123
124
125
126
127


128
129
130
131


132
133
134
135
136
137
138
92
93
94
95
96
97
98

99
100
101
102


103
104
105
106
107
108
109
110
111







-
+
+


-
-
+
+







	if (p) {
	    Tcl_Panic("max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX);
	}
	return NULL;
    }

    listRepPtr = (List *)Tcl_AttemptAlloc(LIST_SIZE(objc));
    listRepPtr = (List *)
	    attemptckalloc(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)));
    if (listRepPtr == NULL) {
	if (p) {
	    Tcl_Panic("list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
		    LIST_SIZE(objc));
	    Tcl_Panic("list creation failed: unable to alloc %u bytes",
		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *))));
	}
	return NULL;
    }

    listRepPtr->canonicalFlag = 0;
    listRepPtr->refCount = 0;
    listRepPtr->maxElemCount = objc;
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
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







-
+

+
+
+
+
+
+
+
-
+
+
+
+
+
+








-
+










-
-
+
+

-









+
-
+
-
+
+

-
+
+

+
-
-
-
-
+
+
+
+

-
+
-
-
-
+
+










-
+









-
+







    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 *  AttemptNewList --
 * AttemptNewList --
 *
 *	Creates a list internal rep with space for objc elements.  objc
 *	must be > 0.  If objv!=NULL, initializes with the first objc values
 *	in that array.  If objv==NULL, initalize list internal rep to have
 *	0 elements, with space to add objc more.  
 *
 * Results:
 *	A new List struct with refCount 0 is returned. If some failure
 *	Like NewListIntRep, but additionally sets an error message on failure.
 *	prevents this then NULL is returned, and an error message is left
 *	in the interp result, unless interp is NULL.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

static List *
AttemptNewList(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
    Tcl_Obj *CONST objv[])
{
    List *listRepPtr = NewListIntRep(objc, objv, 0);

    if (interp != NULL && listRepPtr == NULL) {
	if (objc > LIST_MAX) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "list creation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
		    LIST_SIZE(objc)));
		    "list creation failed: unable to alloc %u bytes",
		    (unsigned)(sizeof(List) + ((objc-1) * sizeof(Tcl_Obj *)))));
	}
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return listRepPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewListObj --
 *
 *	This function is normally called when not debugging: i.e., when
 *	Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
 *	TCL_MEM_DEBUG is not defined. It creates a new list object from an
 *	defined, 'Tcl_DbNewListObj' is called instead.
 *	(objc,objv) array: that is, each of the objc elements of the array
 *	referenced by objv is inserted as an element into a new Tcl object.
 *
 * Value
 *	When TCL_MEM_DEBUG is defined, this function just returns the result
 *	of calling the debugging version Tcl_DbNewListObj.
 *
 * Results:
 *	A new list 'Tcl_Obj' to which is appended values from 'objv', or if
 *	'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
 *	elements.  The string representation of the new 'Tcl_Obj' is set to
 *	NULL.  The refCount of the list is 0.
 *	A new list object is returned that is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The resulting new list object has ref count 0.
 *
 * Effect
 * Side effects:
 *
 *	The refCount of each elements in 'objv' is incremented as it is added
 *	to the list.
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewListObj

Tcl_Obj *
Tcl_NewListObj(
    int objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
    Tcl_Obj *CONST objv[])	/* An array of pointers to Tcl objects. */
{
    return Tcl_DbNewListObj(objc, objv, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewListObj(
    int objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
    Tcl_Obj *CONST objv[])	/* An array of pointers to Tcl objects. */
{
    List *listRepPtr;
    Tcl_Obj *listPtr;

    TclNewObj(listPtr);

    if (objc <= 0) {
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
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







-
+

+
+
+
-
-
-
-
+
+
+
+

-
+
+
+
+
+
+
+
+
+
+
+
+









-
-
+
+







    return listPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 *  Tcl_DbNewListObj --
 * Tcl_DbNewListObj --
 *
 *	This function is normally called when debugging: i.e., when
 *	TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
 *	as the Tcl_NewListObj function above except that it calls
 *	Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
 *	file name and line number from its caller.  This simplifies debugging
 *	since the [memory active] command will report the correct file
 *	name and line number when reporting objects that haven't been freed.
 *	Tcl_DbCkalloc directly with the file name and line number from its
 *	caller. This simplifies debugging since then the [memory active]
 *	command will report the correct file name and line number when
 *	reporting objects that haven't been freed.
 *
 *	When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.
 *	When TCL_MEM_DEBUG is not defined, this function just returns the
 *	result of calling Tcl_NewListObj.
 *
 * Results:
 *	A new list object is returned that is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The new list object has ref count 0.
 *
 * Side effects:
 *	The ref counts of the elements in objv are incremented since the
 *	resulting list now refers to them.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewListObj(
    int objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[],	/* An array of pointers to Tcl objects. */
    const char *file,		/* The name of the source file calling this
    Tcl_Obj *CONST objv[],	/* An array of pointers to Tcl objects. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *listPtr;
    List *listRepPtr;

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
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
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
611
612

613
614
615
616

617
618
619
620
621
622
623
624




625
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
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
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
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
1065
1066
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


































































































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
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
611



612



613
614















615
616


617




618
619






620





621
622
623
624
625
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
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
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







-
-
-
+
+
+
+
+










-
-
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+












+












-
+
+








-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
-

-
-
+
+
-











-

-
+
-














-
+

+
-
+
-


+
-
-
+
+
+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+






-
+

-
-
+
-

-

-
+
-








-

+










+
-
+
-
-
-
+
+
-

-
-
-
+
+
+
-
-
-
+
+

-
+
-
-
-
-
-
-
+
+
+
+
+
-







-
+


-
+






-
-
+
+
-
-
-
-
+
+
+
+
+
+



-
+



-
+







-
+
+
+
+

-
+
-
-
+
-
-
+
-
-
-
-
-
-
+
+
+

-
+
-
-
-
-
-
-
+
+
+
+
+










-
-
+
+
+




-
+
-
-

-

-
+
-







-


+


-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
-
-

-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
+
-
-
+
-
-
+

-
-
-
-
-






-
+
+

















-
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
+

-
+
-
-
+







-
-
+
+


-
+

-
-
+

-

-
+
-







-


+














-
+
+
+

-
+
-
-
+
-
-
-
+
+
+
+
-

-
-
-
+
+
-







-
-
+
+

-
+

-
-
+

-

-
+
-







-


+









-
+
+
+
+

-
-
-
+
+
+
-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+

+
+
-
+
-
-
-
+
+

-
+
-
-
-
+
-
-
+
-
-
-
+
+
+











-
+



-
-
+
+




-
+
-
-
-
-
+
-
-
-
+
+
+


-







-










+













-













-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-







}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewListObj(
    int objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[],	/* An array of pointers to Tcl objects. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    Tcl_Obj *CONST objv[],	/* An array of pointers to Tcl objects. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewListObj(objc, objv);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetListObj --
 *
 *	Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of
 *	creating a new one.
 *	Modify an object to be a list containing each of the objc elements of
 *	the object array referenced by objv.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object is made a list object and is initialized from the object
 *	pointers in objv. If objc is less than or equal to zero, an empty
 *	object is returned. The new object's string representation is left
 *	NULL. The ref counts of the elements in objv are incremented since the
 *	list now refers to them. The object's old string and internal
 *	representations are freed and its type is set NULL.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetListObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    int objc,			/* Count of objects referenced by objv. */
    Tcl_Obj *const objv[])	/* An array of pointers to Tcl objects. */
    Tcl_Obj *CONST objv[])	/* An array of pointers to Tcl objects. */
{
    List *listRepPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetListObj");
    }

    /*
     * Free any old string rep and any internal rep for the old type.
     */

    TclFreeIntRep(objPtr);
    objPtr->typePtr = NULL;
    TclInvalidateStringRep(objPtr);

    /*
     * Set the object's type to "list" and initialize the internal rep.
     * However, if there are no elements to put in the list, just give the
     * object an empty string rep and a NULL type.
     */

    if (objc > 0) {
	listRepPtr = NewListIntRep(objc, objv, 1);
	ListSetIntRep(objPtr, listRepPtr);
    } else {
	Tcl_InitStringRep(objPtr, NULL, 0);
	objPtr->bytes = tclEmptyStringRep;
	objPtr->length = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjCopy --
 *
 *	Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
 *	provides for the C level a counterpart of the [lrange $list 0 end]
 *	command, while using internals details to be as efficient as possible.
 *	Makes a "pure list" copy of a list value. This provides for the C
 *	level a counterpart of the [lrange $list 0 end] command, while using
 *	internals details to be as efficient as possible.
 *
 * Value
 *
 *	The address of the new 'Tcl_Obj' which shares its internal
 *	representation with 'listPtr', and whose refCount is 0.  If 'listPtr'
 *	is not actually a list, the value is NULL, and an error message is left
 * Results:
 *	Normally returns a pointer to a new Tcl_Obj, that contains the same
 *	list value as *listPtr does. The returned Tcl_Obj has a refCount of
 *	zero. If *listPtr does not hold a list, NULL is returned, and if
 *	interp is non-NULL, an error message is recorded there.
 *	in 'interp' if it is not NULL.
 *
 * Effect
 *
 * Side effects:
 *	None.
 *	'listPtr' is converted to a list if it isn't one already.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjCopy(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr)		/* List object for which an element array is
				 * to be returned. */
{
    Tcl_Obj *copyPtr;
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listPtr->typePtr != &tclListType) {
    if (NULL == listRepPtr) {
	if (SetListFromAny(interp, listPtr) != TCL_OK) {
	    return NULL;
	}
    }

    TclNewObj(copyPtr);
    TclInvalidateStringRep(copyPtr);
    DupListInternalRep(listPtr, copyPtr);
    return copyPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjRange --
 * Tcl_ListObjGetElements --
 *
 *	This function returns an (objc,objv) array of the elements in a list
 *	Makes a slice of a list value.
 *	object.
 *      *listPtr must be known to be a valid list.
 *
 * Results:
 *	The return value is normally TCL_OK; in this case *objcPtr is set to
 *	Returns a pointer to the sliced list.
 *      This may be a new object or the same object if not shared.
 *	the count of list elements and *objvPtr is set to a pointer to an
 *	array of (*objcPtr) pointers to each list element. If listPtr does not
 *	refer to a list object and the object can not be converted to one,
 *	TCL_ERROR is returned and an error message will be left in the
 *	interpreter's result if interp is not NULL.
 *
 *	The objects referenced by the returned array should be treated as
 *	readonly and their ref counts are _not_ incremented; the caller must
 *	do that if it holds on to a reference. Furthermore, the pointer and
 *	length returned by this function may change as soon as any function is
 *	called on the list object; be careful about retaining the pointer in a
 *	local data structure.
 *
 * Side effects:
 *	The possible conversion of the object referenced by listPtr
 *	to a list object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclListObjRange(
    Tcl_Obj *listPtr,		/* List object to take a range from. */
    size_t fromIdx,		/* Index of first element to include. */
    size_t toIdx)			/* Index of last element to include. */
{
    Tcl_Obj **elemPtrs;
    int listLen;
    size_t i, newLen;
    List *listRepPtr;

    TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);

    if (fromIdx == TCL_INDEX_NONE) {
	fromIdx = 0;
    }
    if (toIdx + 1 >= (size_t)listLen + 1) {
	toIdx = listLen-1;
    }
    if (fromIdx + 1 > toIdx + 1) {
	Tcl_Obj *obj;
	TclNewObj(obj);
	return obj;
    }

    newLen = toIdx - fromIdx + 1;

    if (Tcl_IsShared(listPtr) ||
	    ((ListRepPtr(listPtr)->refCount > 1))) {
	return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
    }

    /*
     * In-place is possible.
     */

    /*
     * Even if nothing below cause any changes, we still want the
     * string-canonizing effect of [lrange 0 end].
     */

    TclInvalidateStringRep(listPtr);

    /*
     * Delete elements that should not be included.
     */

    for (i = 0; i < fromIdx; i++) {
	TclDecrRefCount(elemPtrs[i]);
    }
    for (i = toIdx + 1; i < (size_t)listLen; i++) {
	TclDecrRefCount(elemPtrs[i]);
    }

    if (fromIdx > 0) {
	memmove(elemPtrs, &elemPtrs[fromIdx],
		(size_t) newLen * sizeof(Tcl_Obj*));
    }

    listRepPtr = ListRepPtr(listPtr);
    listRepPtr->elemCount = newLen;

    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjGetElements --
 *
 *	Retreive the elements in a list 'Tcl_Obj'.
 *
 * Value
 *
 *	TCL_OK
 *
 *	    A count of list elements is stored, 'objcPtr', And a pointer to the
 *	    array of elements in the list is stored in 'objvPtr'.
 *
 *	    The elements accessible via 'objvPtr' should be treated as readonly
 *	    and the refCount for each object is _not_ incremented; the caller
 *	    must do that if it holds on to a reference. Furthermore, the
 *	    pointer and length returned by this function may change as soon as
 *	    any function is called on the list object. Be careful about
 *	    retaining the pointer in a local data structure.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list. An error message is left in the
 *	    interpreter's result if 'interp' is not NULL.
 *
 * Effect
 *
 *	'listPtr' is converted to a list object if it isn't one already.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjGetElements(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object for which an element array is
    register Tcl_Obj *listPtr,	/* List object for which an element array is
				 * to be returned. */
    int *objcPtr,		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
				 * pointers to the list's objects. */
{
    List *listRepPtr;
    register List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);

    if (listPtr->typePtr != &tclListType) {
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (listPtr->bytes == tclEmptyStringRep) {
	if (length == 0) {
	    *objcPtr = 0;
	    *objvPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetIntRep(listPtr, listRepPtr);
    }
    listRepPtr = ListRepPtr(listPtr);
    *objcPtr = listRepPtr->elemCount;
    *objvPtr = &listRepPtr->elements;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendList --
 *
 *	This function appends the objects in the list referenced by
 *	Appends the elements of elemListPtr to those of listPtr.
 *	elemListPtr to the list object referenced by listPtr. If listPtr is
 *
 * Value
 *
 *	not already a list object, an attempt will be made to convert it to
 *	one.
 *	TCL_OK
 *
 *	    Success.
 *
 *	TCL_ERROR
 * Results:
 *	The return value is normally TCL_OK. If listPtr or elemListPtr do not
 *	refer to list objects and they can not be converted to one, TCL_ERROR
 *
 *	    'listPtr' or 'elemListPtr' are not valid lists.  An error
 *	    message is left in the interpreter's result if 'interp' is not NULL.
 *	is returned and an error message is left in the interpreter's result
 *	if interp is not NULL.
 *
 * Effect
 * Side effects:
 *
 *	The reference count of each element of 'elemListPtr' as it is added to
 *	'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'
 *	if they are not already. Appending the new elements may cause the
 *	array of element pointers in 'listObj' to grow.  If any objects are
 *	appended to 'listPtr'. Any preexisting string representation of
 *	The reference counts of the elements in elemListPtr are incremented
 *	since the list now refers to them. listPtr and elemListPtr are
 *	converted, if necessary, to list objects. Also, appending the new
 *	elements may cause listObj's array of element pointers to grow.
 *	listPtr's old string representation, if any, is invalidated.
 *	'listPtr' is invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendList(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object to append elements to. */
    register Tcl_Obj *listPtr,	/* List object to append elements to. */
    Tcl_Obj *elemListPtr)	/* List obj with elements to append. */
{
    int objc;
    int listLen, objc, result;
    Tcl_Obj **objv;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
    }

    /*
     * Pull the elements to append from elemListPtr.
    result = TclListObjLength(interp, listPtr, &listLen);
    if (result != TCL_OK) {
     */

    if (TCL_OK != TclListObjGetElements(interp, elemListPtr, &objc, &objv)) {
	return TCL_ERROR;
	return result;
    }

    result = TclListObjGetElements(interp, elemListPtr, &objc, &objv);
    if (result != TCL_OK) {
	return result;
    }

    /*
     * Insert the new elements starting after the lists's last element.
     * Insert objc new elements starting after the lists's last element.
     * Delete zero existing elements.
     */

    return Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0, objc, objv);
    return Tcl_ListObjReplace(interp, listPtr, listLen, 0, objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjAppendElement --
 *
 *	Like 'Tcl_ListObjAppendList', but Appends a single value to a list.
 *	This function is a special purpose version of Tcl_ListObjAppendList:
 *	it appends a single object referenced by objPtr to the list object
 *	referenced by listPtr. If listPtr is not already a list object, an
 *	attempt will be made to convert it to one.
 *
 * Value
 * Results:
 *
 *	TCL_OK
 *	The return value is normally TCL_OK; in this case objPtr is added to
 *
 *	    'objPtr' is appended to the elements of 'listPtr'.
 *	the end of listPtr's list. If listPtr does not refer to a list object
 *
 *	TCL_ERROR
 *
 *	    listPtr does not refer to a list object and the object can not be
 *	    converted to one. An error message will be left in the
 *	    interpreter's result if interp is not NULL.
 *	and the object can not be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Effect
 * Side effects:
 *
 *	If 'listPtr' is not already of type 'tclListType', it is converted.
 *	The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
 *	Appending the new element may cause the the array of element pointers
 *	in 'listObj' to grow.  Any preexisting string representation of
 *	'listPtr' is invalidated.
 *	The ref count of objPtr is incremented since the list now refers to
 *	it. listPtr will be converted, if necessary, to a list object. Also,
 *	appending the new element may cause listObj's array of element
 *	pointers to grow. listPtr's old string representation, if any, is
 *	invalidated.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjAppendElement(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,		/* List object to append objPtr to. */
    Tcl_Obj *objPtr)		/* Object to append to listPtr's list. */
{
    List *listRepPtr, *newPtr = NULL;
    int numElems, numRequired, needGrow, isShared, attempt;
    register List *listRepPtr;
    register Tcl_Obj **elemPtrs;
    int numElems, numRequired, newMax, newSize, i;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
    }

    if (listPtr->typePtr != &tclListType) {
    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (listPtr->bytes == tclEmptyStringRep) {
	if (length == 0) {
	    Tcl_SetListObj(listPtr, 1, &objPtr);
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetIntRep(listPtr, listRepPtr);
    }

    listRepPtr = ListRepPtr(listPtr);
    numElems = listRepPtr->elemCount;
    numRequired = numElems + 1 ;
    needGrow = (numRequired > listRepPtr->maxElemCount);
    isShared = (listRepPtr->refCount > 1);

    if (numRequired > LIST_MAX) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return TCL_ERROR;
    }

    if (needGrow && !isShared) {
	/*
	 * Need to grow + unshared intrep => try to realloc
	 */
    /*
     * If there is no room in the current array of element pointers, allocate
     * a new, larger array and copy the pointers to it. If the List struct is
     * shared, allocate a new one.
     */

	attempt = 2 * numRequired;
    if (numRequired > listRepPtr->maxElemCount){
	if (attempt <= LIST_MAX) {
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	newMax = 2 * numRequired;
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	newSize = sizeof(List) + ((newMax-1) * sizeof(Tcl_Obj *));
    } else {
	if (newPtr) {
	    listRepPtr = newPtr;
	    listRepPtr->maxElemCount = attempt;
	    needGrow = 0;
	}
    }
	newMax = listRepPtr->maxElemCount;
	newSize = 0;
    }

    if (isShared || needGrow) {
	Tcl_Obj **dst, **src = &listRepPtr->elements;

	/*
    if (listRepPtr->refCount > 1) {
	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldElems;
	 * Either we have a shared intrep and we must copy to write, or we
	 * need to grow and realloc attempts failed.  Attempt intrep copy.
	 */

	attempt = 2 * numRequired;
	newPtr = AttemptNewList(NULL, attempt, NULL);
	if (newPtr == NULL) {
	listRepPtr = AttemptNewList(interp, newMax, NULL);
	if (listRepPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = AttemptNewList(NULL, attempt, NULL);
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = AttemptNewList(interp, attempt, NULL);
	}
	if (newPtr == NULL) {
	    /*
	     * All growth attempts failed; throw the error.
	     */

	    return TCL_ERROR;
	}

	dst = &newPtr->elements;
	oldElems = &oldListRepPtr->elements;
	newPtr->refCount++;
	newPtr->canonicalFlag = listRepPtr->canonicalFlag;
	newPtr->elemCount = listRepPtr->elemCount;

	elemPtrs = &listRepPtr->elements;
	for (i=0; i<numElems; i++) {
	if (isShared) {
	    /*
	     * The original intrep must remain undisturbed.  Copy into the new
	     * one and bump refcounts
	     */
	    while (numElems--) {
	    elemPtrs[i] = oldElems[i];
		*dst = *src++;
		Tcl_IncrRefCount(*dst++);
	    }
	    listRepPtr->refCount--;
	} else {
	    Tcl_IncrRefCount(elemPtrs[i]);
	}
	listRepPtr->elemCount = numElems;
	listRepPtr->refCount++;
	oldListRepPtr->refCount--;
	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
    } else if (newSize) {
	    /*
	     * Old intrep to be freed, re-use refCounts.
	     */

	listRepPtr = (List *) ckrealloc((char *)listRepPtr, (size_t)newSize);
	    memcpy(dst, src, numElems * sizeof(Tcl_Obj *));
	    Tcl_Free(listRepPtr);
	listRepPtr->maxElemCount = newMax;
	}
	listRepPtr = newPtr;
	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
    }
    ListResetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeIntRep(listPtr);
    ListSetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount--;

    /*
     * Add objPtr to the end of listPtr's array of element pointers. Increment
     * the ref count for the (now shared) objPtr.
     */

    *(&listRepPtr->elements + listRepPtr->elemCount) = objPtr;
    elemPtrs = &listRepPtr->elements;
    elemPtrs[numElems] = objPtr;
    Tcl_IncrRefCount(objPtr);
    listRepPtr->elemCount++;

    /*
     * Invalidate any old string representation since the list's internal
     * representation has changed.
     */

    TclInvalidateStringRep(listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjIndex --
 *
 * 	Retrieve a pointer to the element of 'listPtr' at 'index'.  The index
 * 	of the first element is 0.
 *
 * Value
 *	This function returns a pointer to the index'th object from the list
 *	referenced by listPtr. The first element has index 0. If index is
 *	negative or greater than or equal to the number of elements in the
 *	list, a NULL is returned. If listPtr is not a list object, an attempt
 *	will be made to convert it to a list.
 *
 * 	TCL_OK
 * Results:
 *
 *	    A pointer to the element at 'index' is stored in 'objPtrPtr'.  If
 *	    'index' is out of range, NULL is stored in 'objPtrPtr'.  This
 *	    object should be treated as readonly and its 'refCount' is _not_
 *	    incremented. The caller must do that if it holds on to the
 *	    reference.
 *	The return value is normally TCL_OK; in this case objPtrPtr is set to
 *	the Tcl_Obj pointer for the index'th list element or NULL if index is
 *	out of range. This object should be treated as readonly and its ref
 *	count is _not_ incremented; the caller must do that if it holds on to
 *	the reference. If listPtr does not refer to a list and can't be
 *
 * 	TCL_ERROR
 *	converted to one, TCL_ERROR is returned and an error message is left
 *
 * 	    'listPtr' is not a valid list. An an error message is left in the
 * 	    interpreter's result if 'interp' is not NULL.
 *	in the interpreter's result if interp is not NULL.
 *
 *  Effect
 * Side effects:
 *
 * 	If 'listPtr' is not already of type 'tclListType', it is converted.
 *	listPtr will be converted, if necessary, to a list object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjIndex(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object to index into. */
    int index,		/* Index of element to return. */
    register Tcl_Obj *listPtr,	/* List object to index into. */
    register int index,		/* Index of element to return. */
    Tcl_Obj **objPtrPtr)	/* The resulting Tcl_Obj* is stored here. */
{
    List *listRepPtr;
    register List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
    if (listPtr->typePtr != &tclListType) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (listPtr->bytes == tclEmptyStringRep) {
	if (length == 0) {
	    *objPtrPtr = NULL;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetIntRep(listPtr, listRepPtr);
    }

    listRepPtr = ListRepPtr(listPtr);
    if ((index < 0) || (index >= listRepPtr->elemCount)) {
	*objPtrPtr = NULL;
    } else {
	*objPtrPtr = (&listRepPtr->elements)[index];
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjLength --
 *
 * 	Retrieve the number of elements in a list.
 *	This function returns the number of elements in a list object. If the
 *	object is not already a list object, an attempt will be made to
 *	convert it to one.
 *
 * Value
 * Results:
 *
 *	TCL_OK
 *	The return value is normally TCL_OK; in this case *intPtr will be set
 *
 *	    A count of list elements is stored at the address provided by
 *	    'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
 *	to the integer count of list elements. If listPtr does not refer to a
 *	list object and the object can not be converted to one, TCL_ERROR is
 *	returned and an error message will be left in the interpreter's result
 *	if interp is not NULL.
 *	    converted.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' is not a valid list.  An error message will be left in
 * Side effects:
 *	The possible conversion of the argument object to a list object.
 *	    the interpreter's result if 'interp' is not NULL.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjLength(
    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
    Tcl_Obj *listPtr,	/* List object whose #elements to return. */
    int *intPtr)	/* The resulting int is stored here. */
    register Tcl_Obj *listPtr,	/* List object whose #elements to return. */
    register int *intPtr)	/* The resulting int is stored here. */
{
    List *listRepPtr;
    register List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
    if (listPtr->typePtr != &tclListType) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (listPtr->bytes == tclEmptyStringRep) {
	if (length == 0) {
	    *intPtr = 0;
	    return TCL_OK;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetIntRep(listPtr, listRepPtr);
    }

    listRepPtr = ListRepPtr(listPtr);
    *intPtr = listRepPtr->elemCount;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ListObjReplace --
 *
 *	Replace values in a list.
 *	This function replaces zero or more elements of the list referenced by
 *	listPtr with the objects from an (objc,objv) array. The objc elements
 *	of the array referenced by objv replace the count elements in listPtr
 *	starting at first.
 *
 *	If 'first' is zero or negative, it refers to the first element. If
 *	'first' outside the range of elements in the list, no elements are
 *	deleted.
 *	If the argument first is zero or negative, it refers to the first
 *	element. If first is greater than or equal to the number of elements
 *	in the list, then no elements are deleted; the new elements are
 *
 *	If 'count' is zero or negative no elements are deleted, and any new
 *	elements are inserted at the beginning of the list.
 *	appended to the list. Count gives the number of elements to replace.
 *	If count is zero or negative then no elements are deleted; the new
 *	elements are simply inserted before first.
 *
 * Value
 *
 *	TCL_OK
 *
 *	    The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
 *	    starting at 'first'.  If 'objc' 0, no new elements are added.
 *	The argument objv refers to an array of objc pointers to the new
 *	elements to be added to listPtr in place of those that were deleted.
 *	If objv is NULL, no new elements are added. If listPtr is not a list
 *	object, an attempt will be made to convert it to one.
 *
 * Results:
 *	The return value is normally TCL_OK. If listPtr does not refer to a
 *	TCL_ERROR
 *	list object and can not be converted to one, TCL_ERROR is returned and
 *
 *	    'listPtr' is not a valid list.   An error message is left in the
 *	    interpreter's result if 'interp' is not NULL.
 *	an error message will be left in the interpreter's result if interp is
 *	not NULL.
 *
 * Effect
 * Side effects:
 *
 *	If 'listPtr' is not of type 'tclListType', it is converted if possible.
 *
 *	The ref counts of the objc elements in objv are incremented since the
 *	The 'refCount' of each element appended to the list is incremented.
 *	Similarly, the 'refCount' for each replaced element is decremented.
 *	resulting list now refers to them. Similarly, the ref counts for
 *
 *	If 'listPtr' is modified, any previous string representation is
 *	invalidated.
 *	replaced objects are decremented. listPtr is converted, if necessary,
 *	to a list object. listPtr's old string representation, if any, is
 *	freed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ListObjReplace(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *listPtr,		/* List object whose elements to replace. */
    int first,			/* Index of first element to replace. */
    int count,			/* Number of elements to replace. */
    int objc,			/* Number of objects to insert. */
    Tcl_Obj *const objv[])	/* An array of objc pointers to Tcl objects to
    Tcl_Obj *CONST objv[])	/* An array of objc pointers to Tcl objects to
				 * insert. */
{
    List *listRepPtr;
    Tcl_Obj **elemPtrs;
    int needGrow, numElems, numRequired, numAfterLast, start, i, j, isShared;
    register Tcl_Obj **elemPtrs;
    int numElems, numRequired, numAfterLast, start, i, j, isShared;

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
    }

    if (listPtr->typePtr != &tclListType) {
    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	size_t length;

	if (listPtr->bytes == tclEmptyStringRep) {
	(void) TclGetStringFromObj(listPtr, &length);
	if (length == 0) {
	    if (objc == 0) {
	    if (objc) {
		Tcl_SetListObj(listPtr, objc, NULL);
	    } else {
		return TCL_OK;
	    }
	    Tcl_SetListObj(listPtr, objc, NULL);
	} else {
	    int result = SetListFromAny(interp, listPtr);

	    if (result != TCL_OK) {
		return result;
	    }
	}
	ListGetIntRep(listPtr, listRepPtr);
    }

    /*
     * Note that when count == 0 and objc == 0, this routine is logically a
     * no-op, removing and adding no elements to the list. However, by flowing
     * through this routine anyway, we get the important side effect that the
     * resulting listPtr is a list in canoncial form. This is important.
     * Resist any temptation to optimize this case.
     */

    listRepPtr = ListRepPtr(listPtr);
    elemPtrs = &listRepPtr->elements;
    numElems = listRepPtr->elemCount;

    if (first < 0) {
	first = 0;
    }
    if (first >= numElems) {
	first = numElems;	/* So we'll insert after last element. */
    }
    if (count < 0) {
	count = 0;
    } else if (first > INT_MAX - count /* Handle integer overflow */
	    || numElems < first+count) {

	count = numElems - first;
    }

    if (objc > LIST_MAX - (numElems - count)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max length of a Tcl list (%d elements) exceeded",
		    LIST_MAX));
	}
	return TCL_ERROR;
    }
    isShared = (listRepPtr->refCount > 1);
    numRequired = numElems - count + objc; /* Known <= LIST_MAX */
    needGrow = numRequired > listRepPtr->maxElemCount;

    for (i = 0;  i < objc;  i++) {
	Tcl_IncrRefCount(objv[i]);
    }

    if (needGrow && !isShared) {
	/* Try to use realloc */
	List *newPtr = NULL;
	int attempt = 2 * numRequired;
	if (attempt <= LIST_MAX) {
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired + 1 + TCL_MIN_ELEMENT_GROWTH;
	    if (attempt > LIST_MAX) {
		attempt = LIST_MAX;
	    }
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr == NULL) {
	    attempt = numRequired;
	    newPtr = (List *)Tcl_AttemptRealloc(listRepPtr, LIST_SIZE(attempt));
	}
	if (newPtr) {
	    listRepPtr = newPtr;
	    ListResetIntRep(listPtr, listRepPtr);
	    elemPtrs = &listRepPtr->elements;
	    listRepPtr->maxElemCount = attempt;
    if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
	    needGrow = numRequired > listRepPtr->maxElemCount;
	}
    }
    if (!needGrow && !isShared) {
	int shift;

	/*
	 * Can use the current List struct. First "delete" count elements
	 * starting at first.
	 */

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
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







-
+











-
+





-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-








	start = first + count;
	numAfterLast = numElems - start;
	shift = objc - count;	/* numNewElems - numDeleted */
	if ((numAfterLast > 0) && (shift != 0)) {
	    Tcl_Obj **src = elemPtrs + start;

	    memmove(src+shift, src, numAfterLast * sizeof(Tcl_Obj*));
	    memmove(src+shift, src, (size_t) numAfterLast * sizeof(Tcl_Obj*));
	}
    } else {
	/*
	 * Cannot use the current List struct; it is shared, too small, or
	 * both. Allocate a new struct and insert elements into it.
	 */

	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldPtrs = elemPtrs;
	int newMax;

	if (needGrow) {
	if (numRequired > listRepPtr->maxElemCount){
	    newMax = 2 * numRequired;
	} else {
	    newMax = listRepPtr->maxElemCount;
	}

	listRepPtr = AttemptNewList(NULL, newMax, NULL);
	listRepPtr = AttemptNewList(interp, newMax, NULL);
	if (listRepPtr == NULL) {
	    unsigned int limit = LIST_MAX - numRequired;
	    unsigned int extra = numRequired - numElems
		    + TCL_MIN_ELEMENT_GROWTH;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    listRepPtr = AttemptNewList(NULL, numRequired + growth, NULL);
	    if (listRepPtr == NULL) {
		listRepPtr = AttemptNewList(interp, numRequired, NULL);
		if (listRepPtr == NULL) {
		    for (i = 0;  i < objc;  i++) {
			/* See bug 3598580 */
			Tcl_DecrRefCount(objv[i]);
		    }
		    return TCL_ERROR;
		}
	    }
	}

	listRepPtr = AttemptNewList(interp, numRequired, NULL);
	if (listRepPtr == NULL) {
	    for (i = 0;  i < objc;  i++) {
		/* See bug 3598580 */
#if TCL_MAJOR_VERSION > 8
		Tcl_DecrRefCount(objv[i]);
#else
		objv[i]->refCount--;
#endif
	    }
	    return TCL_ERROR;
	}
	}

	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
	ListResetIntRep(listPtr, listRepPtr);
	listRepPtr->refCount++;

	elemPtrs = &listRepPtr->elements;

	if (isShared) {
	    /*
	     * The old struct will remain in place; need new refCounts for the
1144
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154
1155
1156
1157
1158
950
951
952
953
954
955
956

957
958
959
960
961
962
963
964







-
+







	    oldListRepPtr->refCount--;
	} else {
	    /*
	     * The old struct will be removed; use its inherited refCounts.
	     */

	    if (first > 0) {
		memcpy(elemPtrs, oldPtrs, first * sizeof(Tcl_Obj *));
		memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *));
	    }

	    /*
	     * "Delete" count elements starting at first.
	     */

	    for (j = first;  j < first + count;  j++) {
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
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







-
+


















-
-
+
+


-
-
-
-
-









-
+

-
-
-
-
+
+
+
+

-
-
+
+
-
-

-
+
+
+
+
+
+











-
+
+
+

-







-
+
-
-
+







	    start = first + count;
	    numAfterLast = numElems - start;
	    if (numAfterLast > 0) {
		memcpy(elemPtrs + first + objc, oldPtrs + start,
			(size_t) numAfterLast * sizeof(Tcl_Obj *));
	    }

	    Tcl_Free(oldListRepPtr);
	    ckfree((char *) oldListRepPtr);
	}
    }

    /*
     * Insert the new elements into elemPtrs before "first".
     */

    for (i=0,j=first ; i<objc ; i++,j++) {
	elemPtrs[j] = objv[i];
    }

    /*
     * Update the count of elements.
     */

    listRepPtr->elemCount = numRequired;

    /*
     * Invalidate and free any old representations that may not agree
     * with the revised list's internal representation.
     * Invalidate and free any old string representation since it no longer
     * reflects the list's internal representation.
     */

    listRepPtr->refCount++;
    TclFreeIntRep(listPtr);
    ListSetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount--;

    TclInvalidateStringRep(listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLindexList --
 *
 *	Implements the 'lindex' command when objc==3.
 *	This procedure handles the 'lindex' command when objc==3.
 *
 *	Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
 *	the argument format into required form while taking care to manage
 *	shimmering so as to tend to keep the most useful intreps
 *	and/or avoid the most expensive conversions.
 * Results:
 *	Returns a pointer to the object extracted, or NULL if an error
 *	occurred. The returned object already includes one reference count for
 *	the pointer returned.
 *
 * Value
 *
 * Side effects:
 *	None.
 *	A pointer to the specified element, with its 'refCount' incremented, or
 *	NULL if an error occurred.
 *
 * Notes
 * Notes:
 *	This procedure is implemented entirely as a wrapper around
 *	TclLindexFlat. All it does is reconfigure the argument format into the
 *	form required by TclLindexFlat, while taking care to manage shimmering
 *	in such a way that we tend to keep the most useful intreps and/or
 *	avoid the most expensive conversions.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLindexList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* List being unpacked. */
    Tcl_Obj *argPtr)		/* Index or index list. */
{

    size_t index;			/* Index into the list. */
    int index;			/* Index into the list. */
    Tcl_Obj **indices = NULL;	/* Array of list indices. */
    int indexCount = -1;	/* Size of the array of list indices. */
    Tcl_Obj *indexListCopy;
    List *listRepPtr;

    /*
     * Determine whether argPtr designates a list or a single index. We have
     * to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP#22 and TIP#33 for the details.
     */

    ListGetIntRep(argPtr, listRepPtr);
    if (argPtr->typePtr != &tclListType
    if ((listRepPtr == NULL)
	    && TclGetIntForIndexM(NULL , argPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) {
	    && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
	/*
	 * argPtr designates a single index.
	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }

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
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







-
-
+
-
-
-
+
-







-
+

-
-
+
+

-
+
+
+
+

-
-
-
+
+

+
+
+
+
-
-
+
+
-

















-
-
+







	 * argPtr designates something that is neither an index nor a
	 * well-formed list. Report the error via TclLindexFlat.
	 */

	return TclLindexFlat(interp, listPtr, 1, &argPtr);
    }

    ListGetIntRep(indexListCopy, listRepPtr);

    TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
    assert(listRepPtr != NULL);

    listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
    listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
		&listRepPtr->elements);
    Tcl_DecrRefCount(indexListCopy);
    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 *  TclLindexFlat --
 * TclLindexFlat --
 *
 * 	The core of the 'lindex' command, with all index
 * 	arguments presented as a flat list.
 *	This procedure is the core of the 'lindex' command, with all index
 *	arguments presented as a flat list.
 *
 *  Value
 * Results:
 *	Returns a pointer to the object extracted, or NULL if an error
 *	occurred. The returned object already includes one reference count for
 *	the pointer returned.
 *
 *	A pointer to the object extracted, with its 'refCount' incremented,  or
 *	NULL if an error occurred.  Thus, the calling code will usually do
 *	something like:
 * Side effects:
 *	None.
 *
 * Notes:
 *	The reference count of the returned object includes one reference
 *	corresponding to the pointer returned. Thus, the calling code will
 *	usually do something like:
 * 		Tcl_SetObjResult(interp, result);
 * 		Tcl_DecrRefCount(result);
 *		Tcl_SetObjResult(interp, result);
 *		Tcl_DecrRefCount(result);
 *
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLindexFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* Tcl object representing the list. */
    int indexCount,		/* Count of indices. */
    Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that
				 * represent the indices in the list. */
{
    int i;

    Tcl_IncrRefCount(listPtr);

    for (i=0 ; i<indexCount && listPtr ; i++) {
	size_t index;
	int listLen = 0;
	int index, listLen = 0;
	Tcl_Obj **elemPtrs = NULL, *sublistCopy;

	/*
	 * Here we make a private copy of the current sublist, so we avoid any
	 * shimmering issues that might invalidate the elemPtr array below
	 * while we are still using it. See test lindex-8.4.
	 */
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
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
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







-
+






-
+





-
+




















-
+

-

+
-
-
+
+
+

-
+
+

-
-
+
+
+
+
+
+









-
+




-
+

-







-
+
-
-
+








	    break;
	}
	TclListObjGetElements(NULL, sublistCopy, &listLen, &elemPtrs);

	if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
		&index) == TCL_OK) {
	    if (index >= (size_t)listLen) {
	    if (index<0 || index>=listLen) {
		/*
		 * Index is out of range. Break out of loop with empty result.
		 * First check remaining indices for validity
		 */

		while (++i < indexCount) {
		    if (TclGetIntForIndexM(interp, indexArray[i], (size_t)WIDE_MAX - 1, &index)
		    if (TclGetIntForIndexM(interp, indexArray[i], -1, &index)
			!= TCL_OK) {
			Tcl_DecrRefCount(sublistCopy);
			return NULL;
		    }
		}
		TclNewObj(listPtr);
		listPtr = Tcl_NewObj();
	    } else {
		/*
		 * Extract the pointer to the appropriate element.
		 */

		listPtr = elemPtrs[index];
	    }
	    Tcl_IncrRefCount(listPtr);
	}
	Tcl_DecrRefCount(sublistCopy);
    }

    return listPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclLsetList --
 *
 *	The core of [lset] when objc == 4. Objv[2] may be either a
 *	Core of the 'lset' command when objc == 4. Objv[2] may be either a
 *	scalar index or a list of indices.
 *      It also handles 'lpop' when given a NULL value.
 *
 * Results:
 *	Implemented entirely as a wrapper around 'TclLindexFlat', as described
 *	for 'TclLindexList'.
 *	Returns the new value of the list variable, or NULL if there was an
 *	error. The returned object includes one reference count for the
 *	pointer returned.
 *
 * Value
 * Side effects:
 *	None.
 *
 *	The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if
 *	there was an error.
 * Notes:
 *	This procedure is implemented entirely as a wrapper around
 *	TclLsetFlat. All it does is reconfigure the argument format into the
 *	form required by TclLsetFlat, while taking care to manage shimmering
 *	in such a way that we tend to keep the most useful intreps and/or
 *	avoid the most expensive conversions.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLsetList(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
    Tcl_Obj *indexArgPtr,	/* Index or index-list arg to 'lset'. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset' or NULL to 'lpop'. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
{
    int indexCount = 0;		/* Number of indices in the index list. */
    Tcl_Obj **indices = NULL;	/* Vector of indices in the index list. */
    Tcl_Obj *retValuePtr;	/* Pointer to the list to be returned. */
    size_t index;			/* Current index in the list - discarded. */
    int index;			/* Current index in the list - discarded. */
    Tcl_Obj *indexListCopy;
    List *listRepPtr;

    /*
     * Determine whether the index arg designates a list or a single index.
     * We have to be careful about the order of the checks to avoid repeated
     * shimmering; see TIP #22 and #23 for details.
     */

    ListGetIntRep(indexArgPtr, listRepPtr);
    if (indexArgPtr->typePtr != &tclListType
    if (listRepPtr == NULL
	    && TclGetIntForIndexM(NULL, indexArgPtr, (size_t)WIDE_MAX - 1, &index) == TCL_OK) {
	    && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
	/*
	 * indexArgPtr designates a single index.
	 */

	return TclLsetFlat(interp, listPtr, 1, &indexArgPtr, valuePtr);

    }
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459




1460
1461
1462
1463
1464





1465
1466
1467

1468
1469
1470

1471
1472
1473
1474



1475
1476
1477
1478
1479

1480
1481
1482
1483
1484







1485
1486
1487


1488
1489

1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503

1504
1505

1506
1507
1508
1509
1510
1511
1512


1513
1514
1515
1516
1517
1518

1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531








1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547


1548
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
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
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
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
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
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
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
1439









1440
1441
1442
1443


1444
1445
1446
1447


1448



1449




1450
1451
1452
1453
1454
1455
1456



1457
1458
1459
1460

1461
1462
1463
1464
1465
1466


1467













1468
1469

1470
1471
1472
1473
1474
1475
1476
1477
1478

1479
1480




1481


1482







1483
1484








1485
1486
1487
1488
1489

1490



1491
1492



1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505







-

-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
+

-
-
-
+
+
+

-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-
+













-
+

-
+
-

-


-
-
+
+
-



-
-
+
-




-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+











-


-
-
+
+






-
-
+
-
-
+



-







-
+



-





-
+
-


-
-
+
+
-
-

-




-
-
-
-
+
+
+
+


+


-
-
-
-
+
-









-
-
+
+


-
-
-
-
+
-






-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


-
-
+





-
-
-
-
+
+
+
+




-
-
-
-
-
-
-
-
-




-
-
+
+


-
-
+
-
-
-
+
-
-
-
-
+
+
+
+



-
-
-
+
+
+

-






-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-









-
+

-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+

-
+
-
-
-
+
+
-
-
-
+
+
+

+
+








/*
 *----------------------------------------------------------------------
 *
 * TclLsetFlat --
 *
 *	Core engine of the 'lset' command.
 *      It also handles 'lpop' when given a NULL value.
 *
 * Value
 *
 *	The resulting list
 * Results:
 *	Returns the new value of the list variable, or NULL if an error
 *	occurred. The returned object includes one reference count for
 *	the pointer returned.
 *
 *	    The 'refCount' of 'valuePtr' is incremented.  If 'listPtr' was not
 *	    duplicated, its 'refCount' is incremented.  The reference count of
 *	    an unduplicated object is therefore 2 (one for the returned pointer
 *	    and one for the variable that holds it).  The reference count of a
 * Side effects:
 *	On entry, the reference count of the variable value does not reflect
 *	any references held on the stack. The first action of this function is
 *	to determine whether the object is shared, and to duplicate it if it
 *	is. The reference count of the duplicate is incremented. At this
 *	    duplicate object is 1, reflecting that result is the only active
 *	    reference. The caller is expected to store the result in the
 *	    variable and decrement its reference count. (INST_STORE_* does
 *	point, the reference count will be 1 for either case, so that the
 *	    exactly this.)
 *
 *	NULL
 *	object will appear to be unshared.
 *
 *	    An error occurred.  If 'listPtr' was duplicated, the reference
 *	    count on the duplicate is decremented so that it is 0, causing any
 *	    memory allocated by this function to be freed.
 *	If an error occurs, and the object has been duplicated, the reference
 *	count on the duplicate is decremented so that it is now 0: this
 *	dismisses any memory that was allocated by this function.
 *
 *
 * Effect
 *
 *	On entry, the reference count of 'listPtr' does not reflect any
 *	If no error occurs, the reference count of the original object is
 *	references held on the stack. The first action of this function is to
 *	determine whether 'listPtr' is shared and to create a duplicate
 *	unshared copy if it is.  The reference count of the duplicate is
 *	incremented. At this point, the reference count is 1 in either case so
 *	that the object is considered unshared.
 *	incremented if the object has not been duplicated, and nothing is done
 *	to a reference count of the duplicate. Now the reference count of an
 *	unduplicated object is 2 (the returned pointer, plus the one stored in
 *	the variable). The reference count of a duplicate object is 1,
 *	reflecting that the returned pointer is the only active reference. The
 *	caller is expected to store the returned value back in the variable
 *	and decrement its reference count. (INST_STORE_* does exactly this.)
 *
 *	The unshared list is altered directly to produce the result.
 *	'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
 *	Surgery is performed on the unshared list value to produce the result.
 *	TclLsetFlat maintains a linked list of Tcl_Obj's whose string
 *	representations must be spoilt by threading via 'ptr2' of the
 *	two-pointer internal representation. On entry to 'TclLsetFlat', the
 *	two-pointer internal representation. On entry to TclLsetFlat, the
 *	values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
 *	Tcl_Obj that has been modified is set to NULL.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclLsetFlat(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *listPtr,		/* Pointer to the list being modified. */
    int indexCount,		/* Number of index args. */
    Tcl_Obj *const indexArray[],
				/* Index args. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset' or NULL to 'lpop'. */
    Tcl_Obj *valuePtr)		/* Value arg to 'lset'. */
{
    size_t index;
    int index, result;
    int result, len;
    Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
    Tcl_ObjIntRep *irPtr;

    /*
     * If there are no indices, simply return the new value.  (Without
     * indices, [lset] is a synonym for [set].
     * If there are no indices, simply return the new value.
     * (Without indices, [lset] is a synonym for [set].
     * [lpop] does not use this but protect for NULL valuePtr just in case.
     */

    if (indexCount == 0) {
	if (valuePtr != NULL) {
	    Tcl_IncrRefCount(valuePtr);
	Tcl_IncrRefCount(valuePtr);
	}
	return valuePtr;
    }

    /*
     * If the list is shared, make a copy we can modify (copy-on-write).  We
     * use Tcl_DuplicateObj() instead of TclListObjCopy() for a few reasons:
     * 1) we have not yet confirmed listPtr is actually a list; 2) We make a
     * verbatim copy of any existing string rep, and when we combine that with
     * the delayed invalidation of string reps of modified Tcl_Obj's
     * implemented below, the outcome is that any error condition that causes
     * this routine to return NULL, will leave the string rep of listPtr and
     * all elements to be unchanged.
     * If the list is shared, make a copy we can modify (copy-on-write).
     * We use Tcl_DuplicateObj() instead of TclListObjCopy() for a few
     * reasons: 1) we have not yet confirmed listPtr is actually a list;
     * 2) We make a verbatim copy of any existing string rep, and when
     * we combine that with the delayed invalidation of string reps of
     * modified Tcl_Obj's implemented below, the outcome is that any
     * error condition that causes this routine to return NULL, will
     * leave the string rep of listPtr and all elements to be unchanged.
     */

    subListPtr = Tcl_IsShared(listPtr) ? Tcl_DuplicateObj(listPtr) : listPtr;

    /*
     * Anchor the linked list of Tcl_Obj's whose string reps must be
     * invalidated if the operation succeeds.
     */

    retValuePtr = subListPtr;
    chainPtr = NULL;
    result = TCL_OK;

    /*
     * Loop through all the index arguments, and for each one dive into the
     * appropriate sublist.
     * Loop through all the index arguments, and for each one dive
     * into the appropriate sublist.
     */

    do {
	int elemCount;
	Tcl_Obj *parentList, **elemPtrs;

	/*
	 * Check for the possible error conditions...
	/* Check for the possible error conditions... */
	 */

	result = TCL_ERROR;
	if (TclListObjGetElements(interp, subListPtr, &elemCount, &elemPtrs)
		!= TCL_OK) {
	    /* ...the sublist we're indexing into isn't a list at all. */
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * WARNING: the macro TclGetIntForIndexM is not safe for
	 * post-increments, avoid '*indexArray++' here.
	 */

	
	if (TclGetIntForIndexM(interp, *indexArray, elemCount - 1, &index)
		!= TCL_OK)  {
	    /* ...the index we're trying to use isn't an index at all. */
	    result = TCL_ERROR;
	    indexArray++;
	    break;
	}
	indexArray++;

	if (index > (size_t)elemCount
	if (index < 0 || index >= elemCount) {
		|| (valuePtr == NULL && index >= (size_t)elemCount)) {
	    /* ...the index points outside the sublist. */
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%s\" out of range", Tcl_GetString(indexArray[-1])));
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("list index out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX"
			"OUTOFRANGE", NULL);
	    }
	    result = TCL_ERROR;
	    break;
	}

	/*
	 * No error conditions.  As long as we're not yet on the last index,
	 * determine the next sublist for the next pass through the loop, and
	 * take steps to make sure it is an unshared copy, as we intend to
	 * modify it.
	 * No error conditions.  As long as we're not yet on the last
	 * index, determine the next sublist for the next pass through
	 * the loop, and take steps to make sure it is an unshared copy,
	 * as we intend to modify it.
	 */

	result = TCL_OK;
	if (--indexCount) {
	    parentList = subListPtr;
	    if (index == (size_t)elemCount) {
		TclNewObj(subListPtr);
	    } else {
		subListPtr = elemPtrs[index];
	    subListPtr = elemPtrs[index];
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
	    }

	    /*
	     * Replace the original elemPtr[index] in parentList with a copy
	     * we know to be unshared.  This call will also deal with the
	     * situation where parentList shares its intrep with other
	     * Tcl_Obj's.  Dealing with the shared intrep case can cause
	     * subListPtr to become shared again, so detect that case and make
	     * and store another copy.
	     * subListPtr to become shared again, so detect that case and
	     * make and store another copy.
	     */

	    if (index == (size_t)elemCount) {
		Tcl_ListObjAppendElement(NULL, parentList, subListPtr);
	    } else {
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }
	    if (Tcl_IsShared(subListPtr)) {
		subListPtr = Tcl_DuplicateObj(subListPtr);
		TclListObjSetElement(NULL, parentList, index, subListPtr);
	    }

	    /*
	     * The TclListObjSetElement() calls do not spoil the string rep of
	     * parentList, and that's fine for now, since all we've done so
	     * far is replace a list element with an unshared copy.  The list
	     * value remains the same, so the string rep. is still valid, and
	     * unchanged, which is good because if this whole routine returns
	     * NULL, we'd like to leave no change to the value of the lset
	     * variable.  Later on, when we set valuePtr in its proper place,
	     * then all containing lists will have their values changed, and
	     * will need their string reps spoiled.  We maintain a list of all
	     * those Tcl_Obj's (via a little intrep surgery) so we can spoil
	     * them at that time.
	     * The TclListObjSetElement() calls do not spoil the string
	     * rep of parentList, and that's fine for now, since all we've
	     * done so far is replace a list element with an unshared copy.
	     * The list value remains the same, so the string rep. is still
	     * valid, and unchanged, which is good because if this whole
	     * routine returns NULL, we'd like to leave no change to the
	     * value of the lset variable.  Later on, when we set valuePtr
	     * in its proper place, then all containing lists will have
	     * their values changed, and will need their string reps spoiled.
	     * We maintain a list of all those Tcl_Obj's (via a little intrep
	     * surgery) so we can spoil them at that time.
	     */

	    irPtr = TclFetchIntRep(parentList, &tclListType);
	    irPtr->twoPtrValue.ptr2 = chainPtr;
	    parentList->internalRep.twoPtrValue.ptr2 = (void *) chainPtr;
	    chainPtr = parentList;
	}
    } while (indexCount > 0);

    /*
     * Either we've detected and error condition, and exited the loop with
     * result == TCL_ERROR, or we've successfully reached the last index, and
     * we're ready to store valuePtr.  In either case, we need to clean up our
     * string spoiling list of Tcl_Obj's.
     * Either we've detected and error condition, and exited the loop
     * with result == TCL_ERROR, or we've successfully reached the last
     * index, and we're ready to store valuePtr.  In either case, we
     * need to clean up our string spoiling list of Tcl_Obj's.
     */

    while (chainPtr) {
	Tcl_Obj *objPtr = chainPtr;
	List *listRepPtr;

	/*
	 * Clear away our intrep surgery mess.
	 */

	irPtr = TclFetchIntRep(objPtr, &tclListType);
	listRepPtr = (List *)irPtr->twoPtrValue.ptr1;
	chainPtr = (Tcl_Obj *)irPtr->twoPtrValue.ptr2;

	if (result == TCL_OK) {

	    /*
	     * We're going to store valuePtr, so spoil string reps of all
	     * containing lists.
	     * We're going to store valuePtr, so spoil string reps
	     * of all containing lists.
	     */

	    listRepPtr->refCount++;
	    TclFreeIntRep(objPtr);
	    TclInvalidateStringRep(objPtr);
	    ListSetIntRep(objPtr, listRepPtr);
	    listRepPtr->refCount--;

	}
	    TclInvalidateStringRep(objPtr);
	} else {
	    irPtr->twoPtrValue.ptr2 = NULL;
	}

	/* Clear away our intrep surgery mess */
	chainPtr = (Tcl_Obj *) objPtr->internalRep.twoPtrValue.ptr2;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    }

    if (result != TCL_OK) {
	/*
	 * Error return; message is already in interp. Clean up any excess
	 * memory.
	/* 
	 * Error return; message is already in interp. Clean up
	 * any excess memory. 
	 */

	if (retValuePtr != listPtr) {
	    Tcl_DecrRefCount(retValuePtr);
	}
	return NULL;
    }

    /*
     * Store valuePtr in proper sublist and return. The -1 is to avoid a
    /* Store valuePtr in proper sublist and return */
     * compiler warning (not a problem because we checked that we have a
     * proper list - or something convertible to one - above).
     */

    len = -1;
    TclListObjLength(NULL, subListPtr, &len);
    if (valuePtr == NULL) {
	Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);
    } else if (index == (size_t)len) {
	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
    } else {
	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
	TclInvalidateStringRep(subListPtr);
    TclListObjSetElement(NULL, subListPtr, index, valuePtr);
    TclInvalidateStringRep(subListPtr);
    }
    Tcl_IncrRefCount(retValuePtr);
    return retValuePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclListObjSetElement --
 *
 *	Set a single element of a list to a specified value.
 *	Set a single element of a list to a specified value
 *
 *	It is the caller's responsibility to invalidate the string
 *	representation of the 'listPtr'.
 *
 * Value
 * Results:
 *
 * 	TCL_OK
 *	The return value is normally TCL_OK. If listPtr does not refer to a
 *
 *	    Success.
 *
 *	TCL_ERROR
 *
 *	    'listPtr' does not refer to a list object and cannot be converted
 *	    to one.  An error message will be left in the interpreter result if
 *	list object and cannot be converted to one, TCL_ERROR is returned and
 *	an error message will be left in the interpreter result if interp is
 *	    interp is not NULL.
 *
 *	TCL_ERROR
 *
 *	    An index designates an element outside the range [0..listLength-1],
 *	    where 'listLength' is the count of elements in the list object
 *	    designated by 'listPtr'.  An error message is left in the
 *	    interpreter result.
 *	not NULL. Similarly, if index designates an element outside the range
 *	[0..listLength-1], where listLength is the count of elements in the
 *	list object designated by listPtr, TCL_ERROR is returned and an error
 *	message is left in the interpreter result.
 *
 * Effect
 * Side effects:
 *
 *	If 'listPtr' designates a shared object, 'Tcl_Panic' is called.  If
 *	'listPtr' is not already of type 'tclListType', it is converted and the
 *	Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
 *	to convert it to a list with a non-shared internal rep. Decrements the
 *	internal representation is unshared. The 'refCount' of the element at
 *	'index' is decremented and replaced in the list with the 'valuePtr',
 *	whose 'refCount' in turn is incremented.
 *	ref count of the object at the specified index within the list,
 *	replaces with the object designated by valuePtr, and increments the
 *	ref count of the replacement object.
 *
 *	It is the caller's responsibility to invalidate the string
 *	representation of the object.
 *
 *----------------------------------------------------------------------
 */

int
TclListObjSetElement(
    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
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
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


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
1518
1519
1520
1521
1522
1523
1524

1525


1526

1527

1528

1529


1530
1531


1532
1533
1534
1535
1536
1537
1538

1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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







-
+
-
-

-

-
+
-

-
-
+
+
-
-







-


+

+







-
-
+
+
-
-









-
-
+
+
+

-
-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
-

-



















-
-
-
-
-
-
-
-
-
-
-
-








-
-
+
+

-
+
+

+
-
-
+
+
+








-
+

-
-
-
-
+






-
+

+
+







-
+


-
+
+

+
-
+









-
+

-
-








-
+

-
+
-
-
+
-
-
+
-
+

-
+
-
-
+
-
-
+




















-
+







    /*
     * Ensure that the listPtr parameter designates an unshared list.
     */

    if (Tcl_IsShared(listPtr)) {
	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
    }

    if (listPtr->typePtr != &tclListType) {
    ListGetIntRep(listPtr, listRepPtr);
    if (listRepPtr == NULL) {
	int result;
	size_t length;

	(void) TclGetStringFromObj(listPtr, &length);
	if (listPtr->bytes == tclEmptyStringRep) {
	if (length == 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%d\" out of range", index));
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("list index out of range", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
			"OUTOFRANGE", NULL);
	    }
	    return TCL_ERROR;
	}
	result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {
	    return result;
	}
	ListGetIntRep(listPtr, listRepPtr);
    }

    listRepPtr = ListRepPtr(listPtr);
    elemCount = listRepPtr->elemCount;
    elemPtrs = &listRepPtr->elements;

    /*
     * Ensure that the index is in bounds.
     */

    if (index<0 || index>=elemCount) {
	if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"index \"%d\" out of range", index));
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("list index out of range", -1));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX",
		    "OUTOFRANGE", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * If the internal rep is shared, replace it with an unshared copy.
     */

    if (listRepPtr->refCount > 1) {
	Tcl_Obj **dst, **src = &listRepPtr->elements;
	List *newPtr = AttemptNewList(NULL, listRepPtr->maxElemCount, NULL);
	List *oldListRepPtr = listRepPtr;
	Tcl_Obj **oldElemPtrs = elemPtrs;
	int i;

	if (newPtr == NULL) {
	    newPtr = AttemptNewList(interp, elemCount, NULL);
	    if (newPtr == NULL) {
		return TCL_ERROR;
	    }
	listRepPtr = AttemptNewList(interp, listRepPtr->maxElemCount, NULL);
	if (listRepPtr == NULL) {
	    return TCL_ERROR;
	}
	}
	newPtr->refCount++;
	newPtr->elemCount = elemCount;
	newPtr->canonicalFlag = listRepPtr->canonicalFlag;
	listRepPtr->canonicalFlag = oldListRepPtr->canonicalFlag;

	dst = &newPtr->elements;
	while (elemCount--) {
	    *dst = *src++;
	    Tcl_IncrRefCount(*dst++);
	elemPtrs = &listRepPtr->elements;
	for (i=0; i < elemCount; i++) {
	    elemPtrs[i] = oldElemPtrs[i];
	    Tcl_IncrRefCount(elemPtrs[i]);
	}

	listRepPtr->refCount--;

	listRepPtr = newPtr;
	listRepPtr->refCount++;
	listRepPtr->elemCount = elemCount;
	listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr;
	oldListRepPtr->refCount--;
	ListResetIntRep(listPtr, listRepPtr);
    }
    elemPtrs = &listRepPtr->elements;

    /*
     * Add a reference to the new list element.
     */

    Tcl_IncrRefCount(valuePtr);

    /*
     * Remove a reference from the old list element.
     */

    Tcl_DecrRefCount(elemPtrs[index]);

    /*
     * Stash the new object in the list.
     */

    elemPtrs[index] = valuePtr;

    /*
     * Invalidate outdated intreps.
     */

    ListGetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount++;
    TclFreeIntRep(listPtr);
    ListSetIntRep(listPtr, listRepPtr);
    listRepPtr->refCount--;

    TclInvalidateStringRep(listPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeListInternalRep --
 *
 *	Deallocate the storage associated with the internal representation of a
 *	a list object.
 *	Deallocate the storage associated with a list object's internal
 *	representation.
 *
 * Effect
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees listPtr's List* internal representation, if no longer shared.
 *	May decrement the ref counts of element objects, which may free them.
 *	Frees listPtr's List* internal representation and sets listPtr's
 *	internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
 *	element objects, which may free them.
 *
 *----------------------------------------------------------------------
 */

static void
FreeListInternalRep(
    Tcl_Obj *listPtr)		/* List object with internal rep to free. */
{
    List *listRepPtr;
    List *listRepPtr = ListRepPtr(listPtr);

    ListGetIntRep(listPtr, listRepPtr);
    assert(listRepPtr != NULL);

    if (listRepPtr->refCount-- <= 1) {
    if (--listRepPtr->refCount <= 0) {
	Tcl_Obj **elemPtrs = &listRepPtr->elements;
	int i, numElems = listRepPtr->elemCount;

	for (i = 0;  i < numElems;  i++) {
	    Tcl_DecrRefCount(elemPtrs[i]);
	}
	Tcl_Free(listRepPtr);
	ckfree((char *) listRepPtr);
    }

    listPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupListInternalRep --
 *
 *	Initialize the internal representation of a list 'Tcl_Obj' to share the
 *	Initialize the internal representation of a list Tcl_Obj to share the
 *	internal representation of an existing list object.
 *
 * Effect
 * Results:
 *	None.
 *
 * Side effects:
 *	The 'refCount' of the List internal rep is incremented.
 *	The reference count of the List internal rep is incremented.
 *
 *----------------------------------------------------------------------
 */

static void
DupListInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    List *listRepPtr;
    List *listRepPtr = ListRepPtr(srcPtr);

    ListGetIntRep(srcPtr, listRepPtr);
    assert(listRepPtr != NULL);
    ListSetIntRep(copyPtr, listRepPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SetListFromAny --
 *
 *	Convert any object to a list.
 *	Attempt to generate a list internal form for the Tcl object "objPtr".
 *
 * Value
 * Results:
 *
 *    TCL_OK
 *	The return value is TCL_OK or TCL_ERROR. If an error occurs during
 *
 *	Success.  The internal representation of 'objPtr' is set, and the type
 *	conversion, an error message is left in the interpreter's result
 *	of 'objPtr' is 'tclListType'.
 *	unless "interp" is NULL.
 *
 *    TCL_ERROR
 * Side effects:
 *
 *	An error occured during conversion. An error message is left in the
 *	If no error occurs, a list is stored as "objPtr"s internal
 *	interpreter's result if 'interp' is not NULL.
 *
 *	representation.
 *
 *----------------------------------------------------------------------
 */

static int
SetListFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)		/* The object to convert. */
{
    List *listRepPtr;
    Tcl_Obj **elemPtrs;

    /*
     * Dictionaries are a special case; they have a string representation such
     * that *all* valid dictionaries are valid lists. Hence we can convert
     * more directly. Only do this when there's no existing string rep; if
     * there is, it is the string rep that's authoritative (because it could
     * describe duplicate keys).
     */

    if (!TclHasStringRep(objPtr) && TclHasIntRep(objPtr, &tclDictType)) {
    if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done, size;

	/*
	 * Create the new list representation. Note that we do not need to do
	 * anything with the string representation as the transformation (and
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
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
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
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

1893
1894
1895
1896
1897
1898
1899


1900
1901
1902
1903

1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914







-
+
-








-
+
-






-
-
+
-
-


-
-
+
-

-
+

-



-
+






+
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+









-
+

-
+


+









-
+
-
-
-
+
+

-
+
+

-
-
-
+
+
+
+
+








-
-
-
-
+
+
+
+
+
-
-
+

-
-
-
-
-
-
-









-
-
+
-


-
+
+










-
-
+
-
-
+
-



-
+


+
+
-
-
+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+

-
+




+

-
-
+
+


-
+










	    *elemPtrs++ = keyPtr;
	    *elemPtrs++ = valuePtr;
	    Tcl_IncrRefCount(keyPtr);
	    Tcl_IncrRefCount(valuePtr);
	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	}
    } else {
	int estCount;
	int estCount, length;
	size_t length;
	const char *limit, *nextElem = TclGetStringFromObj(objPtr, &length);

	/*
	 * Allocate enough space to hold a (Tcl_Obj *) for each
	 * (possible) list element.
	 */

	estCount = TclMaxListLength(nextElem, length, &limit);
	estCount += (estCount == 0);	/* Smallest list struct holds 1
	estCount += (estCount == 0); /* Smallest List struct holds 1 element. */
					 * element. */
	listRepPtr = AttemptNewList(interp, estCount, NULL);
	if (listRepPtr == NULL) {
	    return TCL_ERROR;
	}
	elemPtrs = &listRepPtr->elements;

	/*
	 * Each iteration, parse and store a list element.
	/* Each iteration, parse and store a list element */
	 */

	while (nextElem < limit) {
	    const char *elemStart;
	    char *check;
	    size_t elemSize;
	    int elemSize, literal;
	    int literal;

	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
	    if (TCL_OK != TclFindElement(interp, nextElem, (limit - nextElem),
		    &elemStart, &nextElem, &elemSize, &literal)) {
	    fail:
		while (--elemPtrs >= &listRepPtr->elements) {
		    Tcl_DecrRefCount(*elemPtrs);
		}
		Tcl_Free(listRepPtr);
		ckfree((char *) listRepPtr);
		return TCL_ERROR;
	    }
	    if (elemStart == limit) {
		break;
	    }

	    /* TODO: replace panic with error on alloc failure? */
	    if (literal) {
		TclNewStringObj(*elemPtrs, elemStart, elemSize);
	    } else {
	    TclNewObj(*elemPtrs);
	    TclInvalidateStringRep(*elemPtrs);
		TclNewObj(*elemPtrs);
		(*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
	    check = Tcl_InitStringRep(*elemPtrs, literal ? elemStart : NULL,
		    elemSize);
	    if (elemSize && check == NULL) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "cannot construct list, out of memory", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		goto fail;
	    }
	    if (!literal) {
		Tcl_InitStringRep(*elemPtrs, NULL,
			TclCopyAndCollapse(elemSize, elemStart, check));
		(*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
			(*elemPtrs)->bytes);
	    }

	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
	}

 	listRepPtr->elemCount = elemPtrs - &listRepPtr->elements;
    }

    /*
     * Store the new internalRep. We do this as late
     * Free the old internalRep before setting the new one. We do this as late
     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use the old internalRep.
     * Tcl_GetStringFromObj, to use that old internalRep.
     */

    TclFreeIntRep(objPtr);
    ListSetIntRep(objPtr, listRepPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfList --
 *
 *	Update the string representation for a list object.
 *	Update the string representation for a list object. Note: This
 *
 *	Any previously-exising string representation is not invalidated, so
 *	storage is lost if this has not been taken care of.
 *	function does not invalidate an existing old string rep so storage
 *	will be lost if this has not already been done.
 *
 * Effect
 * Results:
 *	None.
 *
 *	The string representation of 'listPtr' is set to the resulting string.
 *	This string will be empty if the list has no elements. It is assumed
 *	that the list internal representation is not NULL.
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	list-to-string conversion. This string will be empty if the list has
 *	no elements. The list internal representation should not be NULL and
 *	we assume it is not NULL.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfList(
    Tcl_Obj *listPtr)		/* List object with string rep to update. */
{
#   define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
    int numElems, i;
    size_t length, bytesNeeded = 0;
#   define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
    List *listRepPtr = ListRepPtr(listPtr);
    int numElems = listRepPtr->elemCount;
    int i, length, bytesNeeded = 0;
    const char *elem, *start;
    char *dst;
    char *elem, *dst;
    Tcl_Obj **elemPtrs;
    List *listRepPtr;

    ListGetIntRep(listPtr, listRepPtr);

    assert(listRepPtr != NULL);

    numElems = listRepPtr->elemCount;

    /*
     * Mark the list as being canonical; although it will now have a string
     * rep, it is one we derived through proper "canonical" quoting and so
     * it's known to be free from nasties relating to [concat] and [eval].
     */

    listRepPtr->canonicalFlag = 1;

    /*
     * Handle empty list case first, so rest of the routine is simpler.
    /* Handle empty list case first, so rest of the routine is simpler */
     */

    if (numElems == 0) {
	Tcl_InitStringRep(listPtr, NULL, 0);
	listPtr->bytes = tclEmptyStringRep;
	listPtr->length = 0;
	return;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (numElems <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else {
	/*
	 * We know numElems <= LIST_MAX, so this is safe.
	/* We know numElems <= LIST_MAX, so this is safe. */
	 */

	flagPtr = (int *) ckalloc((unsigned) numElems * sizeof(int));
	flagPtr = (char *)Tcl_Alloc(numElems);
    }
    elemPtrs = &listRepPtr->elements;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	bytesNeeded += TclScanElement(elem, length, flagPtr+i);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems - 1;
	}
    }
    if (bytesNeeded > INT_MAX - numElems + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += numElems;

    /*
     * Pass 2: copy into string rep buffer.
     */

    /*
     * We used to set the string length here, relying on a presumed
     * guarantee that the number of bytes TclScanElement() calls reported
     * to be needed was a precise count and not an over-estimate, so long
     * as the same flag values were passed to TclConvertElement().
     *
     * Then we saw [35a8f1c04a], where a bug in TclScanElement() caused
     * that guarantee to fail. Rather than trust there are no more bugs,
     * we set the length after the loop based on what was actually written,
     * an not on what was predicted.
     *
    listPtr->length = bytesNeeded - 1;
     *
     */
    start = dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
    TclOOM(dst, bytesNeeded);

    listPtr->bytes = ckalloc((unsigned) bytesNeeded);
    dst = listPtr->bytes;
    for (i = 0; i < numElems; i++) {
	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	elem = TclGetStringFromObj(elemPtrs[i], &length);
	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
	*dst++ = ' ';
    }
    dst[-1] = '\0';

    /* Set the string length to what was actually written, the safe choice */
    (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start);
    /* Here is the safe setting of the string length. */
    listPtr->length = dst - 1 - listPtr->bytes;

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
	ckfree((char *) flagPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclLiteral.c.

27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41







-
+







/*
 * Function prototypes for static functions in this file:
 */

static int		AddLocalLiteralEntry(CompileEnv *envPtr,
			    Tcl_Obj *objPtr, int localHash);
static void		ExpandLocalLiteralArray(CompileEnv *envPtr);
static size_t		HashString(const char *string, size_t length);
static unsigned		HashString(const char *string, int length);
#ifdef TCL_COMPILE_DEBUG
static LiteralEntry *	LookupLiteralEntry(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
static void		RebuildLiteralTable(LiteralTable *tablePtr);

/*
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73
59
60
61
62
63
64
65

66
67
68
69
70
71
72
73







-
+







void
TclInitLiteralTable(
    LiteralTable *tablePtr)
				/* Pointer to table structure, which is
				 * supplied by the caller. */
{
#if (TCL_SMALL_HASH_TABLE != 4)
    Tcl_Panic("%s: TCL_SMALL_HASH_TABLE is %d, not 4", "TclInitLiteralTable",
    Tcl_Panic("TclInitLiteralTable: TCL_SMALL_HASH_TABLE is %d, not 4",
	    TCL_SMALL_HASH_TABLE);
#endif

    tablePtr->buckets = tablePtr->staticBuckets;
    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
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
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







-
+









-
-

















-
+









-
+







TclDeleteLiteralTable(
    Tcl_Interp *interp,		/* Interpreter containing shared literals
				 * referenced by the table to delete. */
    LiteralTable *tablePtr)	/* Points to the literal table to delete. */
{
    LiteralEntry *entryPtr, *nextPtr;
    Tcl_Obj *objPtr;
    size_t i;
    int i;

    /*
     * Release remaining literals in the table. Note that releasing a literal
     * might release other literals, modifying the table, so we restart the
     * search from the bucket chain we last found an entry.
     */

#ifdef TCL_COMPILE_DEBUG
    TclVerifyGlobalLiteralTable((Interp *) interp);
#else
    (void)interp;
#endif /*TCL_COMPILE_DEBUG*/

    /*
     * We used to call TclReleaseLiteral for each literal in the table, which
     * is rather inefficient as it causes one lookup-by-hash for each
     * reference to the literal. We now rely at interp-deletion on each
     * bytecode object to release its references to the literal Tcl_Obj
     * without requiring that it updates the global table itself, and deal
     * here only with the table.
     */

    for (i=0 ; i<tablePtr->numBuckets ; i++) {
	entryPtr = tablePtr->buckets[i];
	while (entryPtr != NULL) {
	    objPtr = entryPtr->objPtr;
	    TclDecrRefCount(objPtr);
	    nextPtr = entryPtr->nextPtr;
	    Tcl_Free(entryPtr);
	    ckfree((char *)entryPtr);
	    entryPtr = nextPtr;
	}
    }

    /*
     * Free up the table's bucket array if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	Tcl_Free(tablePtr->buckets);
	ckfree((char *)tablePtr->buckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateLiteral --
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
363
364
365
366
367
368
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







-
+

-
-
+
+








-
+






-
+














-
-
+
+



-
+











-
+

-
-
+
-






-
+





-
+
+



+

-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+



-
+

-



















-
+
-












-
+

















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclCreateLiteral(
    Interp *iPtr,
    const char *bytes,	/* The start of the string. Note that this is
    char *bytes,		/* The start of the string. Note that this is
				 * not a NUL-terminated string. */
    size_t length,		/* Number of bytes in the string. */
    size_t hash,		/* The string's hash. If -1, it will be
    int length,			/* Number of bytes in the string. */
    unsigned hash,		/* The string's hash. If -1, it will be
				 * computed here. */
    int *newPtr,
    Namespace *nsPtr,
    int flags,
    LiteralEntry **globalPtrPtr)
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    size_t globalHash;
    int globalHash;
    Tcl_Obj *objPtr;

    /*
     * Is it in the interpreter's global literal table?
     */

    if (hash == TCL_INDEX_NONE) {
    if (hash == (unsigned) -1) {
	hash = HashString(bytes, length);
    }
    globalHash = (hash & globalTablePtr->mask);
    for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
	    globalPtr = globalPtr->nextPtr) {
	objPtr = globalPtr->objPtr;
	if (globalPtr->nsPtr == nsPtr) {
	    /*
	     * Literals should always have UTF-8 representations... but this
	     * is not guaranteed so we need to be careful anyway.
	     *
	     * https://stackoverflow.com/q/54337750/301832
	     */

	    size_t objLength;
	    const char *objBytes = TclGetStringFromObj(objPtr, &objLength);
	    int objLength;
	    char *objBytes = TclGetStringFromObj(objPtr, &objLength);

	    if ((objLength == length) && ((length == 0)
		    || ((objBytes[0] == bytes[0])
		    && (memcmp(objBytes, bytes, length) == 0)))) {
		    && (memcmp(objBytes, bytes, (unsigned) length) == 0)))) {
		/*
		 * A literal was found: return it
		 */

		if (newPtr) {
		    *newPtr = 0;
		}
		if (globalPtrPtr) {
		    *globalPtrPtr = globalPtr;
		}
		if (flags & LITERAL_ON_HEAP) {
		    Tcl_Free((void *)bytes);
		    ckfree(bytes);
		}
		if (globalPtr->refCount != TCL_INDEX_NONE) {
		    globalPtr->refCount++;
		globalPtr->refCount++;
		}
		return objPtr;
	    }
	}
    }
    if (!newPtr) {
	if ((flags & LITERAL_ON_HEAP)) {
	    Tcl_Free((void *)bytes);
	    ckfree(bytes);
	}
	return NULL;
    }

    /*
     * The literal is new to the interpreter.
     * The literal is new to the interpreter. Add it to the global literal
     * table.
     */

    TclNewObj(objPtr);
    Tcl_IncrRefCount(objPtr);
    if ((flags & LITERAL_ON_HEAP)) {
	objPtr->bytes = (char *) bytes;
	objPtr->bytes = bytes;
	objPtr->length = length;
    } else {
	TclInitStringRep(objPtr, bytes, length);
    }

    /* Should the new literal be shared globally? */

    if ((flags & LITERAL_UNSHARED)) {
	/*
	 * No, do *not* add it the global literal table
	 * Make clear, that no global value is returned
	 */
	if (globalPtrPtr != NULL) {
	    *globalPtrPtr = NULL;
	}
	return objPtr;
    }

    /*
     * Yes, add it to the global literal table.
     */
#ifdef TCL_COMPILE_DEBUG
    if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
	Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
		"TclRegisterLiteral", (length>60? 60 : length), bytes);
    }
#endif

    globalPtr = (LiteralEntry *)Tcl_Alloc(sizeof(LiteralEntry));
    globalPtr = (LiteralEntry *)ckalloc(sizeof(LiteralEntry));
    globalPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    globalPtr->refCount = 1;
    globalPtr->nsPtr = nsPtr;
    globalPtr->nextPtr = globalTablePtr->buckets[globalHash];
    globalTablePtr->buckets[globalHash] = globalPtr;
    globalTablePtr->numEntries++;

    /*
     * If the global literal table has exceeded a decent size, rebuild it with
     * more buckets.
     */

    if (globalTablePtr->numEntries >= globalTablePtr->rebuildSize) {
	RebuildLiteralTable(globalTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyGlobalLiteralTable(iPtr);
    {
	LiteralEntry *entryPtr;
	int found;
	int found, i;
	size_t i;

	found = 0;
	for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	    for (entryPtr=globalTablePtr->buckets[i]; entryPtr!=NULL ;
		    entryPtr=entryPtr->nextPtr) {
		if ((entryPtr == globalPtr) && (entryPtr->objPtr == objPtr)) {
		    found = 1;
		}
	    }
	}
	if (!found) {
	    Tcl_Panic("%s: literal \"%.*s\" wasn't global",
		    "TclRegisterLiteral", (length>60? 60 : (int)length), bytes);
		    "TclRegisterLiteral", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef TCL_COMPILE_STATS
    iPtr->stats.numLiteralsCreated++;
    iPtr->stats.totalLitStringBytes += (double) (length + 1);
    iPtr->stats.currentLitStringBytes += (double) (length + 1);
    iPtr->stats.literalCount[TclLog2(length)]++;
#endif /*TCL_COMPILE_STATS*/

    if (globalPtrPtr) {
	*globalPtrPtr = globalPtr;
    }
    *newPtr = 1;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFetchLiteral --
 *
 *	Fetch from a CompileEnv the literal value identified by an index
 *	value, as returned by a prior call to TclRegisterLiteral().
 *
 * Results:
 *	The literal value, or NULL if the index is out of range.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclFetchLiteral(
    CompileEnv *envPtr,		/* Points to the CompileEnv from which to
				 * fetch the registered literal value. */
    size_t index)		/* Index of the desired literal, as returned
				 * by prior call to TclRegisterLiteral() */
{
    if (index >= (size_t) envPtr->literalArrayNext) {
	return NULL;
    }
    return envPtr->literalArrayPtr[index].objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclRegisterLiteral --
 *
 *	Find, or if necessary create, an object in a CompileEnv literal array
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
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
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







-
+


-
+




-
+



-
+




+
-
+
-


-
+















-
+

-
+











-
+
-
-
-
+
+


-
-
+
+
-
-
-
+
-








-
-
-
+
+



-
-
+
+
-
-
+







 *----------------------------------------------------------------------
 */

int
TclRegisterLiteral(
    void *ePtr,		/* Points to the CompileEnv in whose object
				 * array an object is found or created. */
    const char *bytes,	/* Points to string for which to find or
    char *bytes,	/* Points to string for which to find or
				 * create an object in CompileEnv's object
				 * array. */
    size_t length,			/* Number of bytes in the string. If -1, the
    int length,			/* Number of bytes in the string. If < 0, the
				 * string consists of all bytes up to the
				 * first null character. */
    int flags)			/* If LITERAL_ON_HEAP then the caller already
				 * malloc'd bytes and ownership is passed to
				 * this function. If LITERAL_CMD_NAME then
				 * this function. If LITERAL_NS_SCOPE then
				 * the literal should not be shared accross
				 * namespaces. */
{
    CompileEnv *envPtr = (CompileEnv *)ePtr;
    CompileEnv *envPtr = ePtr;
    Interp *iPtr = envPtr->iPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *globalPtr, *localPtr;
    Tcl_Obj *objPtr;
    unsigned hash;
    size_t hash, localHash, objIndex;
    int localHash, objIndex, new;
    int isNew;
    Namespace *nsPtr;

    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    hash = HashString(bytes, length);

    /*
     * Is the literal already in the CompileEnv's local literal array? If so,
     * just return its index.
     */

    localHash = (hash & localTablePtr->mask);
    for (localPtr=localTablePtr->buckets[localHash] ; localPtr!=NULL;
	    localPtr = localPtr->nextPtr) {
	objPtr = localPtr->objPtr;
	if ((objPtr->length == length) && ((length == 0)
		|| ((objPtr->bytes[0] == bytes[0])
		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
		&& (memcmp(objPtr->bytes, bytes, (unsigned) length) == 0)))) {
	    if ((flags & LITERAL_ON_HEAP)) {
		Tcl_Free((void *)bytes);
		ckfree(bytes);
	    }
	    objIndex = (localPtr - envPtr->literalArrayPtr);
#ifdef TCL_COMPILE_DEBUG
	    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/

	    return objIndex;
	}
    }

    /*
     * The literal is new to this CompileEnv. If it is a command name, avoid
     * The literal is new to this CompileEnv. Should it be shared accross
     * sharing it accross namespaces, and try not to share it with non-cmd
     * literals. Note that FQ command names can be shared, so that we register
     * the namespace as the interp's global NS.
     * namespaces? If it is a fully qualified name, the namespace
     * specification is not needed to avoid sharing.
     */

    if ((flags & LITERAL_CMD_NAME)) {
	if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) {
    if ((flags & LITERAL_NS_SCOPE) && iPtr->varFramePtr
	    && ((length <2) || (bytes[0] != ':') || (bytes[1] != ':'))) {
	    nsPtr = iPtr->globalNsPtr;
	} else {
	    nsPtr = iPtr->varFramePtr->nsPtr;
	nsPtr = iPtr->varFramePtr->nsPtr;
	}
    } else {
	nsPtr = NULL;
    }

    /*
     * Is it in the interpreter's global literal table? If not, create it.
     */

    globalPtr = NULL;
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &isNew, nsPtr, flags,
	    &globalPtr);
    objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr,
	    flags, &globalPtr);
    objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash);

#ifdef TCL_COMPILE_DEBUG
    if (globalPtr != NULL && (globalPtr->refCount + 1 < 2)) {
	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
    if (globalPtr->refCount < 1) {
	Tcl_Panic("TclRegisterLiteral: global literal \"%.*s\" had bad refCount %d",
		"TclRegisterLiteral", (length>60? 60 : (int)length), bytes,
		globalPtr->refCount);
		(length>60? 60 : length), bytes, globalPtr->refCount);
    }
    TclVerifyLocalLiteralTable(envPtr);
#endif /*TCL_COMPILE_DEBUG*/
    return objIndex;
}

#ifdef TCL_COMPILE_DEBUG
504
505
506
507
508
509
510
511

512
513
514
515
516
517
518
451
452
453
454
455
456
457

458
459
460
461
462
463
464
465







-
+







				 * that was previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *entryPtr;
    const char *bytes;
    size_t globalHash, length;
    int length, globalHash;

    bytes = TclGetStringFromObj(objPtr, &length);
    globalHash = (HashString(bytes, length) & globalTablePtr->mask);
    for (entryPtr=globalTablePtr->buckets[globalHash] ; entryPtr!=NULL;
	    entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    return entryPtr;
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
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







-
+


















-
+







    CompileEnv *envPtr,/* Points to CompileEnv whose literal array
				 * contains the entry being hidden. */
    int index)			/* The index of the entry in the literal
				 * array. */
{
    LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t localHash, length;
    int localHash, length;
    const char *bytes;
    Tcl_Obj *newObjPtr;

    lPtr = &envPtr->literalArrayPtr[index];

    /*
     * To avoid unwanted sharing we need to copy the object and remove it from
     * the local and global literal tables. It still has a slot in the literal
     * array so it can be referred to by byte codes, but it will not be
     * matched by literal searches.
     */

    newObjPtr = Tcl_DuplicateObj(lPtr->objPtr);
    Tcl_IncrRefCount(newObjPtr);
    TclReleaseLiteral(interp, lPtr->objPtr);
    lPtr->objPtr = newObjPtr;

    bytes = TclGetStringFromObj(newObjPtr, &length);
    localHash = HashString(bytes, length) & localTablePtr->mask;
    localHash = (HashString(bytes, length) & localTablePtr->mask);
    nextPtrPtr = &localTablePtr->buckets[localHash];

    for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
	if (entryPtr == lPtr) {
	    *nextPtrPtr = lPtr->nextPtr;
	    lPtr->nextPtr = NULL;
	    localTablePtr->numEntries--;
624
625
626
627
628
629
630
631

632
633
634
635
636
637
638
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585







-
+







    }
    objIndex = envPtr->literalArrayNext;
    envPtr->literalArrayNext++;

    lPtr = &envPtr->literalArrayPtr[objIndex];
    lPtr->objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);
    lPtr->refCount = TCL_INDEX_NONE;	/* i.e., unused */
    lPtr->refCount = -1;	/* i.e., unused */
    lPtr->nextPtr = NULL;

    if (litPtrPtr) {
	*litPtrPtr = lPtr;
    }

    return objIndex;
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
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







-
-
+












-
+

-
+







	RebuildLiteralTable(localTablePtr);
    }

#ifdef TCL_COMPILE_DEBUG
    TclVerifyLocalLiteralTable(envPtr);
    {
	char *bytes;
	int found;
	size_t length, i;
	int length, found, i;

	found = 0;
	for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	    for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL ;
		    localPtr=localPtr->nextPtr) {
		if (localPtr->objPtr == objPtr) {
		    found = 1;
		}
	    }
	}

	if (!found) {
	    bytes = TclGetStringFromObj(objPtr, &length);
	    bytes = Tcl_GetStringFromObj(objPtr, &length);
	    Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
		    "AddLocalLiteralEntry", (length>60? 60 : (int)length), bytes);
		    "AddLocalLiteralEntry", (length>60? 60 : length), bytes);
	}
    }
#endif /*TCL_COMPILE_DEBUG*/

    return objIndex;
}

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
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







-
+



-
-
+
+


-
+




-
+
+


-
-
+
+


-
+







{
    /*
     * The current allocated local literal entries are stored between elements
     * 0 and (envPtr->literalArrayNext - 1) [inclusive].
     */

    LiteralTable *localTablePtr = &envPtr->localLitTable;
    size_t currElems = envPtr->literalArrayNext;
    int currElems = envPtr->literalArrayNext;
    size_t currBytes = (currElems * sizeof(LiteralEntry));
    LiteralEntry *currArrayPtr = envPtr->literalArrayPtr;
    LiteralEntry *newArrayPtr;
    size_t i;
    size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;
    int i;
    unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX;

    if (currBytes == newSize) {
	Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded",
	Tcl_Panic("max size of Tcl literal array (%d literals) exceeded",
		currElems);
    }

    if (envPtr->mallocedLiteralArray) {
	newArrayPtr = (LiteralEntry *)Tcl_Realloc(currArrayPtr, newSize);
	newArrayPtr = (LiteralEntry *)ckrealloc(
		(char *)currArrayPtr, newSize);
    } else {
	/*
	 * envPtr->literalArrayPtr isn't a Tcl_Alloc'd pointer, so we must
	 * code a Tcl_Realloc equivalent for ourselves.
	 * envPtr->literalArrayPtr isn't a ckalloc'd pointer, so we must
	 * code a ckrealloc equivalent for ourselves.
	 */

	newArrayPtr = (LiteralEntry *)Tcl_Alloc(newSize);
	newArrayPtr = (LiteralEntry *)ckalloc(newSize);
	memcpy(newArrayPtr, currArrayPtr, currBytes);
	envPtr->mallocedLiteralArray = 1;
    }

    /*
     * Update the local literal table's bucket array.
     */
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
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







-
+







-
+










+
+






-
+





-
+







				 * previously created by a call to
				 * TclRegisterLiteral. */
{
    Interp *iPtr = (Interp *) interp;
    LiteralTable *globalTablePtr;
    LiteralEntry *entryPtr, *prevPtr;
    const char *bytes;
    size_t length, index;
    int length, index;

    if (iPtr == NULL) {
	goto done;
    }

    globalTablePtr = &iPtr->literalTable;
    bytes = TclGetStringFromObj(objPtr, &length);
    index = HashString(bytes, length) & globalTablePtr->mask;
    index = (HashString(bytes, length) & globalTablePtr->mask);

    /*
     * Check to see if the object is in the global literal table and remove
     * this reference. The object may not be in the table if it is a hidden
     * local literal.
     */

    for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
	    entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
	if (entryPtr->objPtr == objPtr) {
	    entryPtr->refCount--;

	    /*
	     * If the literal is no longer being used by any ByteCode, delete
	     * the entry then remove the reference corresponding to the global
	     * literal table entry (decrement the ref count of the object).
	     */

	    if ((entryPtr->refCount != TCL_INDEX_NONE) && (entryPtr->refCount-- <= 1)) {
	    if (entryPtr->refCount == 0) {
		if (prevPtr == NULL) {
		    globalTablePtr->buckets[index] = entryPtr->nextPtr;
		} else {
		    prevPtr->nextPtr = entryPtr->nextPtr;
		}
		Tcl_Free(entryPtr);
		ckfree((char *)entryPtr);
		globalTablePtr->numEntries--;

		TclDecrRefCount(objPtr);

#ifdef TCL_COMPILE_STATS
		iPtr->stats.currentLitStringBytes -= (double) (length + 1);
#endif /*TCL_COMPILE_STATS*/
891
892
893
894
895
896
897
898

899
900
901


902
903


904
905
906
907
908
909
910
840
841
842
843
844
845
846

847
848


849
850
851

852
853
854
855
856
857
858
859
860







-
+

-
-
+
+

-
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
static unsigned int
HashString(
    const char *string,	/* String for which to compute hash value. */
    size_t length)			/* Number of bytes in the string. */
    const char *bytes,	/* String for which to compute hash value. */
    int length)			/* Number of bytes in the string. */
{
    size_t result = 0;
    unsigned int result;
    int i;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
928
929
930
931
932
933
934
935
936
937
938



939
940
941
942
943
944
945
946
878
879
880
881
882
883
884




885
886
887

888
889
890
891
892
893
894







-
-
-
-
+
+
+
-







     *
     * See also HashStringKey in tclHash.c.
     * See also TclObjHashKey in tclObj.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length > 0) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
    result = 0;
    for (i=0 ; i<length ; i++) {
	result += (result<<3) + bytes[i];
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
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
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







+
-
+




















-
-
+
+







				/* Local or global table to enlarge. */
{
    LiteralEntry **oldBuckets;
    LiteralEntry **oldChainPtr, **newChainPtr;
    LiteralEntry *entryPtr;
    LiteralEntry **bucketPtr;
    const char *bytes;
    unsigned int oldSize;
    size_t oldSize, count, index, length;
    int count, index, length;

    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up hashing
     * constants for new array size.
     */

    if (oldSize > UINT_MAX/(4 * sizeof(LiteralEntry *))) {
	/*
	 * Memory allocator limitations will not let us create the
	 * next larger table size.  Best option is to limp along
	 * with what we have.
	 */

	return;
    }

    tablePtr->numBuckets *= 4;
    tablePtr->buckets = (LiteralEntry **)Tcl_Alloc(
	    tablePtr->numBuckets * sizeof(LiteralEntry*));
    tablePtr->buckets = (LiteralEntry **)ckalloc(
	    tablePtr->numBuckets * sizeof(LiteralEntry *));
    for (count=tablePtr->numBuckets, newChainPtr=tablePtr->buckets;
	    count>0 ; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->mask = (tablePtr->mask << 2) + 3;

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
965
966
967
968
969
970
971

972













































973
974
975
976
977
978
979







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	Tcl_Free(oldBuckets);
	ckfree((char *)oldBuckets);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateCmdLiteral --
 *
 *	Invalidate a command literal entry, if present in the literal hash
 *	tables, by resetting its internal representation. This invalidation
 *	leaves it in the literal tables and in existing literal arrays. As a
 *	result, existing references continue to work but we force a fresh
 *	command look-up upon the next use (see, in particular,
 *	TclSetCmdNameObj()).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Resets the internal representation of the CmdName Tcl_Obj
 *	using TclFreeIntRep().
 *
 *----------------------------------------------------------------------
 */

void
TclInvalidateCmdLiteral(
    Tcl_Interp *interp,		/* Interpreter for which to invalidate a
				 * command literal. */
    const char *name,		/* Points to the start of the cmd literal
				 * name. */
    Namespace *nsPtr)		/* The namespace for which to lookup and
				 * invalidate a cmd literal. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
	    strlen(name), -1, NULL, nsPtr, 0, NULL);

    if (literalObjPtr != NULL) {
	if (TclHasIntRep(literalObjPtr, &tclCmdNameType)) {
	    TclFreeIntRep(literalObjPtr);
	}
	/* Balance the refcount effects of TclCreateLiteral() above */
	Tcl_IncrRefCount(literalObjPtr);
	TclReleaseLiteral(interp, literalObjPtr);
    }
}

#ifdef TCL_COMPILE_STATS
/*
 *----------------------------------------------------------------------
 *
1089
1090
1091
1092
1093
1094
1095
1096

1097
1098
1099
1100
1101
1102
1103
993
994
995
996
997
998
999

1000
1001
1002
1003
1004
1005
1006
1007







-
+







 */

char *
TclLiteralStats(
    LiteralTable *tablePtr)	/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    size_t count[NUM_COUNTERS], overflow, i, j;
    int count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    LiteralEntry *entryPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage. For each bucket chain i, j is the
     * number of entries in the chain.
1123
1124
1125
1126
1127
1128
1129
1130
1131


1132
1133
1134
1135

1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1027
1028
1029
1030
1031
1032
1033


1034
1035
1036
1037
1038

1039
1040
1041
1042

1043
1044
1045
1046
1047
1048
1049
1050







-
-
+
+



-
+



-
+







	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = (char *)Tcl_Alloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%" TCL_Z_MODIFIER "u entries in table, %" TCL_Z_MODIFIER "u buckets\n",
    result = (char *)ckalloc(NUM_COUNTERS*60 + 300);
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i=0 ; i<NUM_COUNTERS ; i++) {
	sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n",
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %" TCL_Z_MODIFIER "u\n",
    sprintf(p, "number of buckets with %d or more entries: %d\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}
#endif /*TCL_COMPILE_STATS*/

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
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







+
-
+

+




-
-
-
+
+
+

-
+
+
+
+
+
+
+








-
+







TclVerifyLocalLiteralTable(
    CompileEnv *envPtr)		/* Points to CompileEnv whose literal table is
				 * to be validated. */
{
    LiteralTable *localTablePtr = &envPtr->localLitTable;
    LiteralEntry *localPtr;
    char *bytes;
    int i;
    size_t i, length, count = 0;
    int length, count;

    count = 0;
    for (i=0 ; i<localTablePtr->numBuckets ; i++) {
	for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL;
		localPtr=localPtr->nextPtr) {
	    count++;
	    if (localPtr->refCount != TCL_INDEX_NONE) {
		bytes = TclGetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
	    if (localPtr->refCount != -1) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
			"TclVerifyLocalLiteralTable",
			(length>60? 60 : (int) length), bytes, localPtr->refCount);
			(length>60? 60 : length), bytes, localPtr->refCount);
	    }
	    if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr,
		    localPtr->objPtr) == NULL) {
		bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
		Tcl_Panic("%s: local literal \"%.*s\" is not global",
			"TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes);
	    }
	    if (localPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyLocalLiteralTable");
	    }
	}
    }
    if (count != localTablePtr->numEntries) {
	Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u",
	Tcl_Panic("%s: local literal table had %d entries, should be %d",
		"TclVerifyLocalLiteralTable", count,
		localTablePtr->numEntries);
    }
}

/*
 *----------------------------------------------------------------------
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
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







+
-
+

+




-
-
-
+
+
+

-
+








-
+













TclVerifyGlobalLiteralTable(
    Interp *iPtr)		/* Points to interpreter whose global literal
				 * table is to be validated. */
{
    LiteralTable *globalTablePtr = &iPtr->literalTable;
    LiteralEntry *globalPtr;
    char *bytes;
    int i;
    size_t i, length, count = 0;
    int length, count;

    count = 0;
    for (i=0 ; i<globalTablePtr->numBuckets ; i++) {
	for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL;
		globalPtr=globalPtr->nextPtr) {
	    count++;
	    if (globalPtr->refCount + 1 < 2) {
		bytes = TclGetStringFromObj(globalPtr->objPtr, &length);
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %" TCL_Z_MODIFIER "u",
	    if (globalPtr->refCount < 1) {
		bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
		Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
			"TclVerifyGlobalLiteralTable",
			(length>60? 60 : (int)length), bytes, globalPtr->refCount);
			(length>60? 60 : length), bytes, globalPtr->refCount);
	    }
	    if (globalPtr->objPtr->bytes == NULL) {
		Tcl_Panic("%s: literal has NULL string rep",
			"TclVerifyGlobalLiteralTable");
	    }
	}
    }
    if (count != globalTablePtr->numEntries) {
	Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %" TCL_Z_MODIFIER "u",
	Tcl_Panic("%s: global literal table had %d entries, should be %d",
		"TclVerifyGlobalLiteralTable", count,
		globalTablePtr->numEntries);
    }
}
#endif /*TCL_COMPILE_DEBUG*/

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclLoad.c.

23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37







-
+








typedef struct LoadedPackage {
    char *fileName;		/* Name of the file from which the package was
				 * loaded. An empty string means the package
				 * is loaded statically. Malloc-ed. */
    char *packageName;		/* Name of package prefix for the package,
				 * properly capitalized (first letter UC,
				 * others LC), no "_", as in "Net".
				 * others LC), as in "Net".
				 * Malloc-ed. */
    Tcl_LoadHandle loadHandle;	/* Token for the loaded file which should be
				 * passed to (*unLoadProcPtr)() when the file
				 * is no longer needed. If fileName is NULL,
				 * then this field is irrelevant. */
    Tcl_PackageInitProc *initProc;
				/* Initialization function to call to
51
52
53
54
55
56
57





58
59
60
61
62
63
64
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69







+
+
+
+
+







				/* Finalisation function to unload a package
				 * from a safe interpreter. NULL means that
				 * the package cannot be unloaded. */
    int interpRefCount;		/* How many times the package has been loaded
				 * in trusted interpreters. */
    int safeInterpRefCount;	/* How many times the package has been loaded
				 * in safe interpreters. */
    Tcl_FSUnloadFileProc *unLoadProcPtr;
				/* Function to use to unload this package. If
				 * NULL, then we do not attempt to unload the
				 * package. If fileName is NULL, then this
				 * field is irrelevant. */
    struct LoadedPackage *nextPtr;
				/* Next in list of all packages loaded into
				 * this application process. NULL means end of
				 * list. */
} LoadedPackage;

/*
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
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







-
+








+


-
-
-
+
+
+
+

+
-
+
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+





-
+










-
+





-
-
+
+
-
-
+










-
+

-
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_LoadObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *target;
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp, initName, safeInitName;
    Tcl_DString unloadName, safeUnloadName;
    Tcl_PackageInitProc *initProc, *safeInitProc, *unloadProc, *safeUnloadProc;
    InterpPackage *ipFirstPtr, *ipPtr;
    int code, namesMatch, filesMatch, offset;
    const char *symbols[2];
    Tcl_PackageInitProc *initProc;
    const char *p, *fullFileName, *packageName;
    const char *symbols[4];
    Tcl_PackageInitProc **procPtrs[4];
    ClientData clientData;
    char *p, *fullFileName, *packageName;
    Tcl_LoadHandle loadHandle;
    Tcl_FSUnloadFileProc *unLoadProcPtr = NULL;
    Tcl_UniChar ch = 0;
    Tcl_UniChar ch;
    size_t len;
    int index, flags = 0;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const options[] = {
	"-global",		"-lazy",		"--",	NULL
    };
    enum loadOptionsEnum {
	LOAD_GLOBAL,	LOAD_LAZY,	LOAD_LAST
    };

    while (objc > 2) {
	if (TclGetString(objv[1])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	++objv; --objc;
	if (LOAD_GLOBAL == (enum loadOptionsEnum) index) {
	    flags |= TCL_LOAD_GLOBAL;
	} else if (LOAD_LAZY == (enum loadOptionsEnum) index) {
	    flags |= TCL_LOAD_LAZY;
	} else {
		break;
	}
    }
    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?");
	Tcl_WrongNumArgs(interp, 1, objv, "fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }
    fullFileName = TclGetString(objv[1]);
    fullFileName = Tcl_GetString(objv[1]);

    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&initName);
    Tcl_DStringInit(&safeInitName);
    Tcl_DStringInit(&unloadName);
    Tcl_DStringInit(&safeUnloadName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    if (objc >= 3) {
	packageName = TclGetString(objv[2]);
	packageName = Tcl_GetString(objv[2]);
	if (packageName[0] == '\0') {
	    packageName = NULL;
	}
    }
    if ((fullFileName[0] == 0) && (packageName == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must specify either file name or package name", -1));
	Tcl_SetResult(interp,
		"must specify either file name or package name",
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOLIBRARY",
		NULL);
		TCL_STATIC);
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Figure out which interpreter we're going to load the package into.
     */

    target = interp;
    if (objc == 4) {
	const char *childIntName = TclGetString(objv[3]);
	char *slaveIntName = Tcl_GetString(objv[3]);

	target = Tcl_GetChild(interp, childIntName);
	target = Tcl_GetSlave(interp, slaveIntName);
	if (target == NULL) {
	    code = TCL_ERROR;
	    goto done;
	}
    }

    /*
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
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
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
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
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
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







-
+

-
+










-
+













-
-
-
+
+
+
-
-

















-
+
+















-
-
+
+
-
-



















-
+
+

-
+











-
+











-
+








-
-
-
+
+
+
-
-



-
+


















-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







-
+
+
+
+
+
+
+


-
-
+
+

+



+
+
+
+
+
+
+
+
+
+





-
+
-
-
-
+
+
+
-
-
-
+
+
+

+
-
-
+
+
-
-
-
+
-
-
-
+
-
-







-
-
-
-
-
-
-








-
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
+
+
+
-
-



-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-



-
-


+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







    Tcl_MutexLock(&packageMutex);

    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringSetLength(&pkgName, 0);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringSetLength(&tmp, 0);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);
	Tcl_DStringSetLength(&pkgName, 0);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
	}
	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
	    /*
	     * Can't have two different packages loaded from the same file.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file \"%s\" is already loaded for package \"%s\"",
		    fullFileName, pkgPtr->packageName));
	    Tcl_AppendResult(interp, "file \"", fullFileName,
		    "\" is already loaded for package \"",
		    pkgPtr->packageName, "\"", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
		    "SPLITPERSONALITY", NULL);
	    code = TCL_ERROR;
	    Tcl_MutexUnlock(&packageMutex);
	    goto done;
	}
    }
    Tcl_MutexUnlock(&packageMutex);
    if (pkgPtr == NULL) {
	pkgPtr = defaultPtr;
    }

    /*
     * Scan through the list of packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then
     * there's nothing for us to do.
     */

    if (pkgPtr != NULL) {
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
		"tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		code = TCL_OK;
		goto done;
	    }
	}
    }

    if (pkgPtr == NULL) {
	/*
	 * The desired file isn't currently loaded, so load it. It's an error
	 * if the desired package is a static one.
	 */

	if (fullFileName[0] == 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "package \"%s\" isn't loaded statically", packageName));
	    Tcl_AppendResult(interp, "package \"", packageName,
		    "\" isn't loaded statically", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "NOTSTATIC",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Figure out the module name if it wasn't provided explicitly.
	 */

	if (packageName != NULL) {
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	} else {
	    int retc;

	    /*
	     * Threading note - this call used to be protected by a mutex.
	     */

	    retc = TclGuessPackageName(fullFileName, &pkgName);
	    if (!retc) {
		Tcl_Obj *splitPtr, *pkgGuessPtr;
		Tcl_Obj *splitPtr;
		Tcl_Obj *pkgGuessPtr;
		int pElements;
		const char *pkgGuess;
		char *pkgGuess;

		/*
		 * The platform-specific code couldn't figure out the module
		 * name. Make a guess by taking the last element of the file
		 * name, stripping off any leading "lib", and then using all
		 * of the alphabetic and underline characters that follow
		 * that.
		 */

		splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
		Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
		pkgGuess = TclGetString(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 = TclUtfToUniChar(p, &ch);
		    offset = Tcl_UtfToUniChar(p, &ch);
		    if ((ch > 0x100)
			    || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
				    || (UCHAR(ch) == '_'))) {
			break;
		    }
		}
		if (p == pkgGuess) {
		    Tcl_DecrRefCount(splitPtr);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "couldn't figure out package name for %s",
			    fullFileName));
		    Tcl_AppendResult(interp,
			    "couldn't figure out package name for ",
			    fullFileName, NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
			    "WHATPACKAGE", NULL);
		    code = TCL_ERROR;
		    goto done;
		}
		Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
		Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
		Tcl_DecrRefCount(splitPtr);
	    }
	}

	/*
	 * Fix the capitalization in the package name so that the first
	 * character is in caps (or title case) but the others are all
	 * lower-case.
	 */

	Tcl_DStringSetLength(&pkgName,
		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));

	/*
	 * Compute the names of the two initialization functions, based on the
	 * package name.
	 */

	TclDStringAppendDString(&initName, &pkgName);
	TclDStringAppendLiteral(&initName, "_Init");
	TclDStringAppendDString(&safeInitName, &pkgName);
	TclDStringAppendLiteral(&safeInitName, "_SafeInit");
	TclDStringAppendDString(&unloadName, &pkgName);
	TclDStringAppendLiteral(&unloadName, "_Unload");
	TclDStringAppendDString(&safeUnloadName, &pkgName);
	TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
	Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&initName, "_Init", 5);
	Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
	Tcl_DStringAppend(&unloadName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&unloadName, "_Unload", 7);
	Tcl_DStringAppend(&safeUnloadName, Tcl_DStringValue(&pkgName), -1);
	Tcl_DStringAppend(&safeUnloadName, "_SafeUnload", 11);

	/*
	 * Call platform-specific code to load the package and find the two
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
	symbols[1] = NULL;
	symbols[1] = Tcl_DStringValue(&safeInitName);
	symbols[2] = Tcl_DStringValue(&unloadName);
	symbols[3] = Tcl_DStringValue(&safeUnloadName);
	procPtrs[0] = &initProc;
	procPtrs[1] = &safeInitProc;
	procPtrs[2] = &unloadProc;
	procPtrs[3] = &safeUnloadProc;

	Tcl_MutexLock(&packageMutex);
	code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
		&loadHandle);
	code = TclLoadFile(interp, objv[1], 4, symbols, procPtrs,
		&loadHandle, &clientData, &unLoadProcPtr);
	Tcl_MutexUnlock(&packageMutex);
	loadHandle = (Tcl_LoadHandle) clientData;
	if (code != TCL_OK) {
	    goto done;
	}

	if (*procPtrs[0] /* initProc */ == NULL) {
	    Tcl_AppendResult(interp, "couldn't find procedure ",
		    Tcl_DStringValue(&initName), NULL);
	    if (unLoadProcPtr != NULL) {
		(*unLoadProcPtr)(loadHandle);
	    }
	    code = TCL_ERROR;
	    goto done;
	}

	/*
	 * Create a new record to describe this package.
	 */

	pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
	len = strlen(fullFileName) + 1;
	pkgPtr->fileName	   = (char *)Tcl_Alloc(len);
	memcpy(pkgPtr->fileName, fullFileName, len);
	pkgPtr->fileName	   = (char *) ckalloc((unsigned)
		(strlen(fullFileName) + 1));
	strcpy(pkgPtr->fileName, fullFileName);
	len = Tcl_DStringLength(&pkgName) + 1;
	pkgPtr->packageName	   = (char *)Tcl_Alloc(len);
	memcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName), len);
	pkgPtr->packageName	   = (char *) ckalloc((unsigned)
		(Tcl_DStringLength(&pkgName) + 1));
	strcpy(pkgPtr->packageName, Tcl_DStringValue(&pkgName));
	pkgPtr->loadHandle	   = loadHandle;
	pkgPtr->unLoadProcPtr	   = unLoadProcPtr;
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
	pkgPtr->initProc	   = *procPtrs[0];
	pkgPtr->safeInitProc	   = *procPtrs[1];
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc*) *procPtrs[2];
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&unloadName));
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *)
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc*) *procPtrs[3];
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeUnloadName));
	pkgPtr->interpRefCount	   = 0;
	pkgPtr->safeInterpRefCount = 0;

	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		   = firstPackagePtr;
	firstPackagePtr		   = pkgPtr;
	Tcl_MutexUnlock(&packageMutex);

	/*
	 * The Tcl_FindSymbol calls may have left a spurious error message in
	 * the interpreter result.
	 */

	Tcl_ResetResult(interp);
    }

    /*
     * Invoke the package's initialization function (either the normal one or
     * the safe one, depending on whether or not the interpreter is safe).
     */

    if (Tcl_IsSafe(target)) {
	if (pkgPtr->safeInitProc == NULL) {
	if (pkgPtr->safeInitProc != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't use package in a safe interpreter: no"
		    " %s_SafeInit procedure", pkgPtr->packageName));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = pkgPtr->safeInitProc(target);
    } else {
	    code = (*pkgPtr->safeInitProc)(target);
	} else {
	if (pkgPtr->initProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't attach package to interpreter: no %s_Init procedure",
		    pkgPtr->packageName));
	    Tcl_AppendResult(interp,
		    "can't use package in a safe interpreter: no ",
		    pkgPtr->packageName, "_SafeInit procedure", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = pkgPtr->initProc(target);
    }

    } else {
    /*
     * Test for whether the initialization failed. If so, transfer the error
     * from the target interpreter to the originating one.
     */

	code = (*pkgPtr->initProc)(target);
    if (code != TCL_OK) {
	Interp *iPtr = (Interp *) target;
	if (iPtr->legacyResult && *(iPtr->legacyResult) && !iPtr->legacyFreeProc) {
	    /*
	     * A call to Tcl_InitStubs() determined the caller extension and
	     * this interp are incompatible in their stubs mechanisms, and
	     * recorded the error in the oldest legacy place we have to do so.
	     */
	    Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
	    iPtr->legacyResult = NULL;
	    iPtr->legacyFreeProc = (void (*) (void))-1;
	}
    }
	Tcl_TransferResult(target, code, interp);
	goto done;
    }


    /*
     * Record the fact that the package has been loaded in the target
     * interpreter.
     *
     * Update the proper reference count.
     */

    if (code == TCL_OK) {
	/*
	 * Update the proper reference count.
	 */

    Tcl_MutexLock(&packageMutex);
    if (Tcl_IsSafe(target)) {
	pkgPtr->safeInterpRefCount++;
    } else {
	pkgPtr->interpRefCount++;
    }
    Tcl_MutexUnlock(&packageMutex);
	Tcl_MutexLock(&packageMutex);
	if (Tcl_IsSafe(target)) {
	    ++pkgPtr->safeInterpRefCount;
	} else {
	    ++pkgPtr->interpRefCount;
	}
	Tcl_MutexUnlock(&packageMutex);

    /*
     * Refetch ipFirstPtr: loading the package may have introduced additional
     * static packages at the head of the linked list!
     */
	/*
	 * Refetch ipFirstPtr: loading the package may have introduced
	 * additional static packages at the head of the linked list!
	 */

    ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
    ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
    ipPtr->pkgPtr = pkgPtr;
    ipPtr->nextPtr = ipFirstPtr;
    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipPtr);
	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
		"tclLoad", NULL);
	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
		(ClientData) ipPtr);
    } else {
	TclTransferResult(target, code, interp);
    }

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&initName);
    Tcl_DStringFree(&safeInitName);
    Tcl_DStringFree(&unloadName);
    Tcl_DStringFree(&safeUnloadName);
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
611
612
613

614
615
616
617
618
619
620


621
622

623
624
625
626
627
628
629
630
631
632
633
634
635



636
637
638
639
640
641
642
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
595
596
597
598
599
600







-
+












-
-
+
+


-
+






-
+

















-
+














-
+






-
+





-
+





-
-
+
+
-
-
+










-
-
-
+
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UnloadObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Interp *target;		/* Which interpreter to unload from. */
    LoadedPackage *pkgPtr, *defaultPtr;
    Tcl_DString pkgName, tmp;
    Tcl_PackageUnloadProc *unloadProc;
    InterpPackage *ipFirstPtr, *ipPtr;
    int i, index, code, complain = 1, keepLibrary = 0;
    int trustedRefCount = -1, safeRefCount = -1;
    const char *fullFileName = "";
    const char *packageName;
    static const char *const options[] = {
    char *packageName;
    static const char *options[] = {
	"-nocomplain", "-keeplibrary", "--", NULL
    };
    enum unloadOptionsEnum {
    enum options {
	UNLOAD_NOCOMPLAIN, UNLOAD_KEEPLIB, UNLOAD_LAST
    };

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		&index) != TCL_OK) {
	    fullFileName = TclGetString(objv[i]);
	    fullFileName = Tcl_GetString(objv[i]);
	    if (fullFileName[0] == '-') {
		/*
		 * It looks like the command contains an option so signal an
		 * error
		 */

		return TCL_ERROR;
	    } else {
		/*
		 * This clearly isn't an option; assume it's the filename. We
		 * must clear the error.
		 */

		Tcl_ResetResult(interp);
		break;
	    }
	}
	switch ((enum unloadOptionsEnum)index) {
	switch (index) {
	case UNLOAD_NOCOMPLAIN:		/* -nocomplain */
	    complain = 0;
	    break;
	case UNLOAD_KEEPLIB:		/* -keeplibrary */
	    keepLibrary = 1;
	    break;
	case UNLOAD_LAST:		/* -- */
	    i++;
	    goto endOfForLoop;
	}
    }
  endOfForLoop:
    if ((objc-i < 1) || (objc-i > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-switch ...? fileName ?packageName? ?interp?");
		"?switches? fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[i]) != TCL_OK) {
	return TCL_ERROR;
    }

    fullFileName = TclGetString(objv[i]);
    fullFileName = Tcl_GetString(objv[i]);
    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&tmp);

    packageName = NULL;
    if (objc - i >= 2) {
	packageName = TclGetString(objv[i+1]);
	packageName = Tcl_GetString(objv[i+1]);
	if (packageName[0] == '\0') {
	    packageName = NULL;
	}
    }
    if ((fullFileName[0] == 0) && (packageName == NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must specify either file name or package name", -1));
	Tcl_SetResult(interp,
		"must specify either file name or package name",
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NOLIBRARY",
		NULL);
		TCL_STATIC);
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Figure out which interpreter we're going to load the package into.
     */

    target = interp;
    if (objc - i == 3) {
	const char *childIntName = TclGetString(objv[i + 2]);

	target = Tcl_GetChild(interp, childIntName);
	char *slaveIntName;
	slaveIntName = Tcl_GetString(objv[i+2]);
	target = Tcl_GetSlave(interp, slaveIntName);
	if (target == NULL) {
	    return TCL_ERROR;
	}
    }

    /*
     * Scan through the packages that are currently loaded to see if the
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
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
756
757
758
759
760
761
762
763


764
765
766
767
768
769
770
771
772
773
611
612
613
614
615
616
617

618
619

620
621
622
623
624
625
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
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







-
+

-
+










-
+


















-
-
+
+
-
-
-








-
-
+
+
-
-












-
+
+












-
-
+
+
-
-
-












-
-
+
+
-
-
-






-
-
+
+
-
-
-







    defaultPtr = NULL;
    for (pkgPtr = firstPackagePtr; pkgPtr != NULL; pkgPtr = pkgPtr->nextPtr) {
	int namesMatch, filesMatch;

	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringSetLength(&pkgName, 0);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringSetLength(&tmp, 0);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);
	Tcl_DStringSetLength(&pkgName, 0);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}
	if (namesMatch && (fullFileName[0] == 0)) {
	    defaultPtr = pkgPtr;
	}
	if (filesMatch && !namesMatch && (fullFileName[0] != 0)) {
	    break;
	}
    }
    Tcl_MutexUnlock(&packageMutex);
    if (fullFileName[0] == 0) {
	/*
	 * It's an error to try unload a static package.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"package \"%s\" is loaded statically and cannot be unloaded",
	Tcl_AppendResult(interp, "package \"", packageName,
		"\" is loaded statically and cannot be unloaded", NULL);
		packageName));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "STATIC",
		NULL);
	code = TCL_ERROR;
	goto done;
    }
    if (pkgPtr == NULL) {
	/*
	 * The DLL pointed by the provided filename has never been loaded.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"file \"%s\" has never been loaded", fullFileName));
	Tcl_AppendResult(interp, "file \"", fullFileName,
		"\" has never been loaded", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
		NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Scan through the list of packages already loaded in the target
     * interpreter. If the package we want is already loaded there, then we
     * should proceed with unloading.
     */

    code = TCL_ERROR;
    if (pkgPtr != NULL) {
	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
		"tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
		code = TCL_OK;
		break;
	    }
	}
    }
    if (code != TCL_OK) {
	/*
	 * The package has not been loaded in this interpreter.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"file \"%s\" has never been loaded in this interpreter",
	Tcl_AppendResult(interp, "file \"", fullFileName,
		"\" has never been loaded in this interpreter", NULL);
		fullFileName));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "NEVERLOADED",
		NULL);
	code = TCL_ERROR;
	goto done;
    }

    /*
     * Ensure that the DLL can be unloaded. If it is a trusted interpreter,
     * pkgPtr->unloadProc must not be NULL for the DLL to be unloadable. If
     * the interpreter is a safe one, pkgPtr->safeUnloadProc must be non-NULL.
     */

    if (Tcl_IsSafe(target)) {
	if (pkgPtr->safeUnloadProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file \"%s\" cannot be unloaded under a safe interpreter",
	    Tcl_AppendResult(interp, "file \"", fullFileName,
		    "\" cannot be unloaded under a safe interpreter", NULL);
		    fullFileName));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	unloadProc = pkgPtr->safeUnloadProc;
    } else {
	if (pkgPtr->unloadProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file \"%s\" cannot be unloaded under a trusted interpreter",
	    Tcl_AppendResult(interp, "file \"", fullFileName,
		    "\" cannot be unloaded under a trusted interpreter", NULL);
		    fullFileName));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "CANNOT",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	unloadProc = pkgPtr->unloadProc;
    }

    /*
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
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







-
+

-
+






-
+

-
+










-
+









-
+




















-
+








+
+
+
-
-
+
+
+
+
+







    if (!keepLibrary) {
	Tcl_MutexLock(&packageMutex);
	trustedRefCount = pkgPtr->interpRefCount;
	safeRefCount = pkgPtr->safeInterpRefCount;
	Tcl_MutexUnlock(&packageMutex);

	if (Tcl_IsSafe(target)) {
	    safeRefCount--;
	    --safeRefCount;
	} else {
	    trustedRefCount--;
	    --trustedRefCount;
	}

	if (safeRefCount <= 0 && trustedRefCount <= 0) {
	    code = TCL_UNLOAD_DETACH_FROM_PROCESS;
	}
    }
    code = unloadProc(target, code);
    code = (*unloadProc)(target, code);
    if (code != TCL_OK) {
	Tcl_TransferResult(target, code, interp);
	TclTransferResult(target, code, interp);
	goto done;
    }

    /*
     * The unload function executed fine. Examine the reference count to see
     * if we unload the DLL.
     */

    Tcl_MutexLock(&packageMutex);
    if (Tcl_IsSafe(target)) {
	pkgPtr->safeInterpRefCount--;
	--pkgPtr->safeInterpRefCount;

	/*
	 * Do not let counter get negative.
	 */

	if (pkgPtr->safeInterpRefCount < 0) {
	    pkgPtr->safeInterpRefCount = 0;
	}
    } else {
	pkgPtr->interpRefCount--;
	--pkgPtr->interpRefCount;

	/*
	 * Do not let counter get negative.
	 */

	if (pkgPtr->interpRefCount < 0) {
	    pkgPtr->interpRefCount = 0;
	}
    }
    trustedRefCount = pkgPtr->interpRefCount;
    safeRefCount = pkgPtr->safeInterpRefCount;
    Tcl_MutexUnlock(&packageMutex);

    code = TCL_OK;
    if (pkgPtr->safeInterpRefCount <= 0 && pkgPtr->interpRefCount <= 0
	    && !keepLibrary) {
	/*
	 * Unload the shared library from the application memory...
	 */

#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
	/*
	 * Some Unix dlls are poorly behaved - registering things like atexit
	 * calls that can't be unregistered. If you unload such dlls, you get
	 * a core on exit because it wants to call a function in the dll after
	 * it's been unloaded.
	 */

	if (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;

	    if (unLoadProcPtr != NULL) {
	    Tcl_MutexLock(&packageMutex);
	    if (Tcl_FSUnloadFile(interp, pkgPtr->loadHandle) == TCL_OK) {
		Tcl_MutexLock(&packageMutex);
		if ((pkgPtr->unloadProc != NULL) || (unLoadProcPtr == TclFSUnloadTempFile)) {
		    (*unLoadProcPtr)(pkgPtr->loadHandle);
		}

		/*
		 * Remove this library from the loaded library cache.
		 */

		defaultPtr = pkgPtr;
		if (defaultPtr == firstPackagePtr) {
		    firstPackagePtr = pkgPtr->nextPtr;
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
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







-
+
+















-
-
-
-
-
+
+
+
+
+


+
+
+




-
-
+
+
-
-
-







-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		    }
		}

		/*
		 * Remove this library from the interpreter's library cache.
		 */

		ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);
		ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target,
			"tclLoad", NULL);
		ipPtr = ipFirstPtr;
		if (ipPtr->pkgPtr == defaultPtr) {
		    ipFirstPtr = ipFirstPtr->nextPtr;
		} else {
		    InterpPackage *ipPrevPtr;

		    for (ipPrevPtr = ipPtr; ipPtr != NULL;
			    ipPrevPtr = ipPtr, ipPtr = ipPtr->nextPtr) {
			if (ipPtr->pkgPtr == defaultPtr) {
			    ipPrevPtr->nextPtr = ipPtr->nextPtr;
			    break;
			}
		    }
		}
		Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
			ipFirstPtr);
		Tcl_Free(defaultPtr->fileName);
		Tcl_Free(defaultPtr->packageName);
		Tcl_Free(defaultPtr);
		Tcl_Free(ipPtr);
			(ClientData) ipFirstPtr);
		ckfree(defaultPtr->fileName);
		ckfree(defaultPtr->packageName);
		ckfree((char *) defaultPtr);
		ckfree((char *) ipPtr);
		Tcl_MutexUnlock(&packageMutex);
	    } else {
		Tcl_AppendResult(interp, "file \"", fullFileName,
			"\" cannot be unloaded: filesystem does not support unloading",
			NULL);
		code = TCL_ERROR;
	    }
	}
#else
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"file \"%s\" cannot be unloaded: unloading disabled",
	Tcl_AppendResult(interp, "file \"", fullFileName,
		"\" cannot be unloaded: unloading disabled", NULL);
		fullFileName));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "UNLOAD", "DISABLED",
		NULL);
	code = TCL_ERROR;
#endif
    }

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&tmp);
    if (!complain && (code != TCL_OK)) {
    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.
	 */

	objPtr[0] = Tcl_NewIntObj(trustedRefCount);
	objPtr[1] = Tcl_NewIntObj(safeRefCount);
	if (objPtr[0] == NULL || objPtr[1] == NULL) {
	    if (objPtr[0]) {
		Tcl_DecrRefCount(objPtr[0]);
	    }
	    if (objPtr[1]) {
		Tcl_DecrRefCount(objPtr[1]);
	    }
	} else {
	    resultObjPtr = Tcl_NewListObj(2, objPtr);
	    if (resultObjPtr != NULL) {
		Tcl_SetObjResult(interp, resultObjPtr);
	    }
	}
#endif
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
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
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
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
1065
1066
1067
1068
1069
1070
1071


1072
1073
1074
1075



1076
1077
1078
1079
1080

1081
1082
1083
1084
1085
1086
1087







-
-
-
+
+
+

-
+
+

















-
-
-
+
+
+
+





-
+



-
+


-
+
+






-
+


-
+


















-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+


+
+
+
-
+
+



-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
+
-
-
-
-
+
-
-
+
-
-
-








+
+
+
+
+
-
-
+
+

+
-
-
-
+
+
+
+

-







    Tcl_MutexUnlock(&packageMutex);

    /*
     * If the package is not yet recorded as being loaded statically, add it
     * to the list now.
     */

    if (pkgPtr == NULL) {
	pkgPtr = (LoadedPackage *)Tcl_Alloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= (char *)Tcl_Alloc(1);
    if ( pkgPtr == NULL ) {
	pkgPtr = (LoadedPackage *) ckalloc(sizeof(LoadedPackage));
	pkgPtr->fileName	= (char *) ckalloc((unsigned) 1);
	pkgPtr->fileName[0]	= 0;
	pkgPtr->packageName	= (char *)Tcl_Alloc(strlen(pkgName) + 1);
	pkgPtr->packageName	= (char *)
		ckalloc((unsigned) (strlen(pkgName) + 1));
	strcpy(pkgPtr->packageName, pkgName);
	pkgPtr->loadHandle	= NULL;
	pkgPtr->initProc	= initProc;
	pkgPtr->safeInitProc	= safeInitProc;
	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		= firstPackagePtr;
	firstPackagePtr		= pkgPtr;
	Tcl_MutexUnlock(&packageMutex);
    }

    if (interp != NULL) {

	/*
	 * If we're loading the package into an interpreter, determine whether
	 * it's already loaded.
	 */

	ipFirstPtr = (InterpPackage *)Tcl_GetAssocData(interp, "tclLoad", NULL);
	for (ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    if (ipPtr->pkgPtr == pkgPtr) {
	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(interp,
		"tclLoad", NULL);
	for ( ipPtr = ipFirstPtr; ipPtr != NULL; ipPtr = ipPtr->nextPtr ) {
	    if ( ipPtr->pkgPtr == pkgPtr ) {
		return;
	    }
	}

	/*
	 * Package isn't loaded in the current interp yet. Mark it as now being
	 * Package isn't loade in the current interp yet. Mark it as now being
	 * loaded.
	 */

	ipPtr = (InterpPackage *)Tcl_Alloc(sizeof(InterpPackage));
	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
	ipPtr->pkgPtr = pkgPtr;
	ipPtr->nextPtr = ipFirstPtr;
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc, ipPtr);
	Tcl_SetAssocData(interp, "tclLoad", LoadCleanupProc,
		(ClientData) ipPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetLoadedPackages, TclGetLoadedPackagesEx --
 * TclGetLoadedPackages --
 *
 *	This function returns information about all of the files that are
 *	loaded (either in a particular interpreter, or for all interpreters).
 *	loaded (either in a particular intepreter, or for all interpreters).
 *
 * Results:
 *	The return value is a standard Tcl completion code. If successful, a
 *	list of lists is placed in the interp's result. Each sublist
 *	corresponds to one loaded file; its first element is the name of the
 *	file (or an empty string for something that's statically loaded) and
 *	the second element is the name of the package in that file.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetLoadedPackages(
    Tcl_Interp *interp,		/* Interpreter in which to return information
				 * or error message. */
    const char *targetName)	/* Name of target interpreter or NULL. If
    char *targetName)		/* Name of target interpreter or NULL. If
				 * NULL, return info about all interps;
				 * otherwise, just return info about this
				 * interpreter. */
{
    return TclGetLoadedPackagesEx(interp, targetName, NULL);
}

int
TclGetLoadedPackagesEx(
    Tcl_Interp *interp,		/* Interpreter in which to return information
				 * or error message. */
    const char *targetName,	/* Name of target interpreter or NULL. If
				 * NULL, return info about all interps;
				 * otherwise, just return info about this
				 * interpreter. */
    const char *packageName)	/* Package name or NULL. If NULL, return info
				 * for all packages.
				 */
{
    Tcl_Interp *target;
    LoadedPackage *pkgPtr;
    InterpPackage *ipPtr;
    Tcl_Obj *resultObj, *pkgDesc[2];
    const char *prefix;

    if (targetName == NULL) {
	/*
	 * Return information about all of the available packages.
	 */
	TclNewObj(resultObj);

	prefix = "{";
	Tcl_MutexLock(&packageMutex);
	for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
		pkgPtr = pkgPtr->nextPtr) {
	    pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
	    pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewListObj(2, pkgDesc));
	}
	Tcl_MutexUnlock(&packageMutex);
	Tcl_SetObjResult(interp, resultObj);
	    Tcl_AppendResult(interp, prefix, NULL);
	return TCL_OK;
    }

	    Tcl_AppendElement(interp, pkgPtr->fileName);
    target = Tcl_GetChild(interp, targetName);
    if (target == NULL) {
	return TCL_ERROR;
    }
    ipPtr = (InterpPackage *)Tcl_GetAssocData(target, "tclLoad", NULL);

    /*
     * Return information about all of the available packages.
     */
    if (packageName) {
	    Tcl_AppendElement(interp, pkgPtr->packageName);
	resultObj = NULL;

	    Tcl_AppendResult(interp, "}", NULL);
	for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	    pkgPtr = ipPtr->pkgPtr;

	    prefix = " {";
	    if (!strcmp(packageName, pkgPtr->packageName)) {
		resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1);
		break;
	    }
	}
	}

	Tcl_MutexUnlock(&packageMutex);
	if (resultObj) {
	    Tcl_SetObjResult(interp, resultObj);
	}
	return TCL_OK;
    }

    /*
     * Return information about only the packages that are loaded in a given
     * interpreter.
     */

    target = Tcl_GetSlave(interp, targetName);
    if (target == NULL) {
	return TCL_ERROR;
    }
    ipPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad", NULL);
    TclNewObj(resultObj);
    for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
    prefix = "{";
    for ( ; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
	pkgPtr = ipPtr->pkgPtr;
	Tcl_AppendResult(interp, prefix, NULL);
	pkgDesc[0] = Tcl_NewStringObj(pkgPtr->fileName, -1);
	pkgDesc[1] = Tcl_NewStringObj(pkgPtr->packageName, -1);
	Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewListObj(2, pkgDesc));
	Tcl_AppendElement(interp, pkgPtr->fileName);
	Tcl_AppendElement(interp, pkgPtr->packageName);
	Tcl_AppendResult(interp, "}", NULL);
	prefix = " {";
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * LoadCleanupProc --
1146
1147
1148
1149
1150
1151
1152
1153

1154
1155
1156
1157

1158
1159
1160

1161
1162
1163
1164
1165
1166
1167
1099
1100
1101
1102
1103
1104
1105

1106
1107
1108
1109

1110
1111
1112

1113
1114
1115
1116
1117
1118
1119
1120







-
+



-
+


-
+







 *----------------------------------------------------------------------
 */

static void
LoadCleanupProc(
    ClientData clientData,	/* Pointer to first InterpPackage structure
				 * for interp. */
    TCL_UNUSED(Tcl_Interp *))
    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
{
    InterpPackage *ipPtr, *nextPtr;

    ipPtr = (InterpPackage *)clientData;
    ipPtr = (InterpPackage *) clientData;
    while (ipPtr != NULL) {
	nextPtr = ipPtr->nextPtr;
	Tcl_Free(ipPtr);
	ckfree((char *) ipPtr);
	ipPtr = nextPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
-
+
+






-
+








+
+
+
+
-
+
+



-
-
-
+
+
+










TclFinalizeLoad(void)
{
    LoadedPackage *pkgPtr;

    /*
     * No synchronization here because there should just be one thread alive
     * at this point. Logically, packageMutex should be grabbed at this point,
     * but the Mutexes get finalized before the call to this routine. The only
     * subsystem left alive at this point is the memory allocator.
     * but the Mutexes get finalized before the call to this routine. The
     * only subsystem left alive at this point is the memory allocator.
     */

    while (firstPackagePtr != NULL) {
	pkgPtr = firstPackagePtr;
	firstPackagePtr = pkgPtr->nextPtr;

#if defined(TCL_UNLOAD_DLLS) || defined(_WIN32)
#if defined(TCL_UNLOAD_DLLS) || defined(__WIN32__)
	/*
	 * Some Unix dlls are poorly behaved - registering things like atexit
	 * calls that can't be unregistered. If you unload such dlls, you get
	 * a core on exit because it wants to call a function in the dll after
	 * it has been unloaded.
	 */

	if (pkgPtr->fileName[0] != '\0') {
	    Tcl_FSUnloadFileProc *unLoadProcPtr = pkgPtr->unLoadProcPtr;
	    if ((unLoadProcPtr != NULL)
		    && ((pkgPtr->unloadProc != NULL)
		    || (unLoadProcPtr == TclFSUnloadTempFile))) {
	    Tcl_FSUnloadFile(NULL, pkgPtr->loadHandle);
		(*unLoadProcPtr)(pkgPtr->loadHandle);
	    }
	}
#endif

	Tcl_Free(pkgPtr->fileName);
	Tcl_Free(pkgPtr->packageName);
	Tcl_Free(pkgPtr);
	ckfree(pkgPtr->fileName);
	ckfree(pkgPtr->packageName);
	ckfree((char *) pkgPtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclLoadNone.c.

1
2
3
4

5
6
7
8
9
10
11
1
2
3

4
5
6
7
8
9
10
11



-
+







/*
 * tclLoadNone.c --
 *
 *	This procedure provides a version of the TclpDlopen for use in
 *	This procedure provides a version of the TclLoadFile for use in
 *	systems that don't support dynamic loading; it just returns an error.
 *
 * 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.
 */
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
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







-
+



-

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"dynamic loading is not currently available on this system",
		-1));
    }
    return TCL_ERROR;
    Tcl_SetResult(interp,
	    "dynamic loading is not currently available on this system",
	    TCL_STATIC);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library). This version of this
 *	routine should never be called because the associated TclpDlopen()
 *	function always returns an error.
 *
 * Results:
 *	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.
 *
 *----------------------------------------------------------------------
 */

Tcl_PackageInitProc *
TclpFindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    CONST char *symbol)
{
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
 *	If the "load" command is invoked without providing a package name,
71
72
73
74
75
76
77
78

79
80
81
82
83


























84
85
86
87
88
89
90
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







-
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
    CONST char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpUnloadFile --
 *
 *    This procedure is called to carry out dynamic unloading of binary code;
 *    it is intended for use only on systems that don't support dynamic
 *    loading (it does nothing).
 *
 * Results:
 *    None.
 *
 * Side effects:
 *    None.
 *
 *----------------------------------------------------------------------
 */

void
TclpUnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
}

/*
 * These functions are fallbacks if we somehow determine that the platform can
 * do loading from memory but the user wishes to disable it. They just report
 * (gracefully) that they fail.
 */
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
152
153
154
155
156
157
158

159
160


161



162
163

164
165
166
167
168
169
170
171
172
173
174
175







-
+

-
-

-
-
-
+
+
-












MODULE_SCOPE int
TclpLoadMemory(
    Tcl_Interp *interp,		/* Used for error reporting. */
    void *buffer,		/* Dummy: unused by this implementation */
    int size,			/* Dummy: unused by this implementation */
    int codeSize,		/* Dummy: unused by this implementation */
    Tcl_LoadHandle *loadHandle,	/* Dummy: unused by this implementation */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Dummy: unused by this implementation */
    int flags)
				/* Dummy: unused by this implementation */
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
		"is not available on this system", -1));
    Tcl_SetResult(interp, "dynamic loading from memory is not available "
	    "on this system", TCL_STATIC);
    }
    return TCL_ERROR;
}

#endif /* TCL_LOAD_FROM_MEMORY */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclMain.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

24
25


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

76
77

78
79
80
81
82

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143

144
145
146
147
148
149
150
151
152
153


154
155
156
157



158
159
160
161


162
163
164
165



166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184




185
186
187
188
189
190
191
192


193
194

195
196
197
198
199

200
201
202

203
204




































































































205



206
207
208
209
210
211
212
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




-
-
-
-
-









-
-
-
-
-
+

-
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-













-
+
















-
-
+

-

-
-
-



















-
+

-

-




-
-
+
+

-
-
-
+
+
+


-
-
+
+

-
-
-
+
+
+















-
-
-
-
+
+
+
+






-
-
+
+

-
+

-
-

-
+


-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+







/*
 * tclMain.c --
 *
 *	Main program for Tcl shells and other Tcl-based applications.
 *	This file contains a generic main program for Tcl shells and other
 *	Tcl-based applications. It can be used as-is for many applications,
 *	just by supplying a different appInitProc function for each specific
 *	application. Or, it can be used as a template for creating new main
 *	programs for Tcl applications.
 *
 * Copyright (c) 1988-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2000 Ajuba Solutions.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * On Windows, this file needs to be compiled twice, once with UNICODE and
 * _UNICODE defined. This way both Tcl_Main and Tcl_MainExW can be
 * implemented, sharing the same source code.
 */
#include "tclInt.h"

#include "tclInt.h"
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT

/*
 * The default prompt used when the user has not overridden it.
 */

#define DEFAULT_PRIMARY_PROMPT	"% "

/*
 * This file can be compiled on Windows in UNICODE mode, as well as on all
 * other platforms using the native encoding. This is done by using the normal
 * Windows functions like _tcscmp, but on platforms which don't have <tchar.h>
 * we have to translate that to strcmp here.
 */

#ifndef _WIN32
#   define TCHAR char
#   define TEXT(arg) arg
#   define _tcscmp strcmp
#endif

static Tcl_Obj *
NewNativeObj(
    TCHAR *string)
{
    Tcl_DString ds;

#ifdef UNICODE
    Tcl_DStringInit(&ds);
    Tcl_WCharToUtfDString(string, -1, &ds);
#else
    Tcl_ExternalToUtfDString(NULL, (char *)string, -1, &ds);
#endif
    return TclDStringToObj(&ds);
}

/*
 * Declarations for various library functions and variables (don't want to
 * include tclPort.h here, because people might copy this file out of the Tcl
 * source directory to make their own modified versions).
 */

#if defined _MSC_VER && _MSC_VER < 1900
/* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */
extern CRTIMPORT int	isatty(int fd);
#endif

/*
 * The thread-local variables for this file's functions.
 */

static Tcl_Obj *tclStartupScriptPath = NULL;
typedef struct {
    Tcl_Obj *path;		/* The filename of the script for *_Main()
static Tcl_Obj *tclStartupScriptEncoding = NULL;
				 * routines to [source] as a startup script,
				 * or NULL for none set, meaning enter
				 * interactive mode. */
    Tcl_Obj *encoding;		/* The encoding of the startup script file. */
    Tcl_MainLoopProc *mainLoopProc;
static Tcl_MainLoopProc *mainLoopProc = NULL;
				/* Any installed main loop handler. The main
				 * extension that installs these is Tk. */
} ThreadSpecificData;

/*
 * Structure definition for information used to keep the state of an
 * interactive command processor that reads lines from standard input and
 * writes prompts and results to standard output.
 */

typedef enum {
    PROMPT_NONE,		/* Print no prompt */
    PROMPT_START,		/* Print prompt for command start */
    PROMPT_CONTINUE		/* Print prompt for command continuation */
} PromptType;

typedef struct {
typedef struct InteractiveState {
    Tcl_Channel input;		/* The standard input channel from which lines
				 * are read. */
    int tty;			/* Non-zero means standard input is a
				 * terminal-like device. Zero means it's a
				 * file. */
    Tcl_Obj *commandPtr;	/* Used to assemble lines of input into Tcl
				 * commands. */
    PromptType prompt;		/* Next prompt to print */
    Tcl_Interp *interp;		/* Interpreter that evaluates interactive
				 * commands. */
} InteractiveState;

/*
 * Forward declarations for functions defined later in this file.
 */

MODULE_SCOPE Tcl_MainLoopProc *TclGetMainLoop(void);
static void		Prompt(Tcl_Interp *interp, InteractiveState *isPtr);
static void		Prompt(Tcl_Interp *interp, PromptType *promptPtr);
static void		StdinProc(ClientData clientData, int mask);
static void		FreeMainInterp(ClientData clientData);

#if !defined(_WIN32) || defined(UNICODE) && !defined(TCL_ASCII_MAIN)
static Tcl_ThreadDataKey dataKey;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStartupScript --
 *
 *	Sets the path and encoding of the startup script to be evaluated by
 *	Tcl_Main, used to override the command line processing.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetStartupScript(
    Tcl_Obj *path,		/* Filesystem path of startup script file */
    const char *encoding)	/* Encoding of the data in that file */
    CONST char *encoding)	/* Encoding of the data in that file */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_Obj *newEncoding = NULL;

    if (encoding != NULL) {
	newEncoding = Tcl_NewStringObj(encoding, -1);
    }

    if (tsdPtr->path != NULL) {
	Tcl_DecrRefCount(tsdPtr->path);
    if (tclStartupScriptPath != NULL) {
	Tcl_DecrRefCount(tclStartupScriptPath);
    }
    tsdPtr->path = path;
    if (tsdPtr->path != NULL) {
	Tcl_IncrRefCount(tsdPtr->path);
    tclStartupScriptPath = path;
    if (tclStartupScriptPath != NULL) {
	Tcl_IncrRefCount(tclStartupScriptPath);
    }

    if (tsdPtr->encoding != NULL) {
	Tcl_DecrRefCount(tsdPtr->encoding);
    if (tclStartupScriptEncoding != NULL) {
	Tcl_DecrRefCount(tclStartupScriptEncoding);
    }
    tsdPtr->encoding = newEncoding;
    if (tsdPtr->encoding != NULL) {
	Tcl_IncrRefCount(tsdPtr->encoding);
    tclStartupScriptEncoding = newEncoding;
    if (tclStartupScriptEncoding != NULL) {
	Tcl_IncrRefCount(tclStartupScriptEncoding);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStartupScript --
 *
 *	Gets the path and encoding of the startup script to be evaluated by
 *	Tcl_Main.
 *
 * Results:
 *	The path of the startup script; NULL if none has been set.
 *
 * Side effects:
 *	If encodingPtr is not NULL, stores a (const char *) in it pointing to
 *	the encoding name registered for the startup script. Tcl retains
 *	ownership of the string, and may free it. Caller should make a copy
 *	for long-term use.
 * 	If encodingPtr is not NULL, stores a (CONST char *) in it pointing to
 * 	the encoding name registered for the startup script. Tcl retains
 * 	ownership of the string, and may free it. Caller should make a copy
 * 	for long-term use.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetStartupScript(
    const char **encodingPtr)	/* When not NULL, points to storage for the
				 * (const char *) that points to the
    CONST char **encodingPtr)	/* When not NULL, points to storage for the
				 * (CONST char *) that points to the
				 * registered encoding name for the startup
				 * script. */
				 * script */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (encodingPtr != NULL) {
	if (tsdPtr->encoding == NULL) {
	if (tclStartupScriptEncoding == NULL) {
	    *encodingPtr = NULL;
	} else {
	    *encodingPtr = TclGetString(tsdPtr->encoding);
	    *encodingPtr = Tcl_GetString(tclStartupScriptEncoding);
	}
    }
    return tclStartupScriptPath;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetStartupScriptPath --
 *
 *	Primes the startup script VFS path, used to override the command line
 *	processing.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This function initializes the VFS path of the Tcl script to run at
 *	startup.
 *
 *----------------------------------------------------------------------
 */

void
TclSetStartupScriptPath(
    Tcl_Obj *path)
{
    Tcl_SetStartupScript(path, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetStartupScriptPath --
 *
 *	Gets the startup script VFS path, used to override the command line
 *	processing.
 *
 * Results:
 *	The startup script VFS path, NULL if none has been set.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclGetStartupScriptPath(void)
{
    return Tcl_GetStartupScript(NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetStartupScriptFileName --
 *
 *	Primes the startup script file name, used to override the command line
 *	processing.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This function initializes the file name of the Tcl script to run at
 *	startup.
 *
 *----------------------------------------------------------------------
 */

void
TclSetStartupScriptFileName(
    CONST char *fileName)
{
    Tcl_Obj *path = Tcl_NewStringObj(fileName,-1);
    Tcl_SetStartupScript(path, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetStartupScriptFileName --
 *
 *	Gets the startup script file name, used to override the command line
 *	processing.
 *
 * Results:
 *	The startup script file name, NULL if none has been set.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

CONST char *
TclGetStartupScriptFileName(void)
{
    Tcl_Obj *path = Tcl_GetStartupScript(NULL);

    if (path == NULL) {
    return tsdPtr->path;
	return NULL;
    }
    return Tcl_GetString(path);
}

/*----------------------------------------------------------------------
 *
 * Tcl_SourceRCFile --
 *
 *	This function is typically invoked by Tcl_Main of Tk_Main function to
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
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
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
450
451
452
453
454
455

456
457

458
459
460
461
462
463
464
465







-
-
+
+

-
+


-
+















-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+




-



-
+















-
-
+
+

-
-
+
+



-

-
-
-
+
+
+
+
-
-
-
+
+
+

+

-
+



-
-
-
-







+


-
+

-
+


-
+

-
-
+
-
-



-
+







-
+

+
+
-
+
+

-
+
+



-
+



+
+
-
+
+
+







-
-
-
+
+
+





-
-
-
-
-
+
+
+
+
+

-
-
+
+








-
-
-
-

-
-
-
-

-
-
+
+




-


-
-
+
+









-
+

-
+







 */

void
Tcl_SourceRCFile(
    Tcl_Interp *interp)		/* Interpreter to source rc file into. */
{
    Tcl_DString temp;
    const char *fileName;
    Tcl_Channel chan;
    CONST char *fileName;
    Tcl_Channel errChannel;

    fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY);
    fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
    if (fileName != NULL) {
	Tcl_Channel c;
	const char *fullName;
	CONST char *fullName;

	Tcl_DStringInit(&temp);
	fullName = Tcl_TranslateFileName(interp, fileName, &temp);
	if (fullName == NULL) {
	    /*
	     * Couldn't translate the file name (e.g. it referred to a bogus
	     * user or there was no HOME environment variable). Just do
	     * nothing.
	     */
	} else {
	    /*
	     * Test for the existence of the rc file before trying to read it.
	     */

	    c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
	    if (c != NULL) {
		Tcl_CloseEx(NULL, c, 0);
	    if (c != (Tcl_Channel) NULL) {
		Tcl_Close(NULL, c);
		if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
		    chan = Tcl_GetStdChannel(TCL_STDERR);
		    if (chan) {
			Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
			Tcl_WriteChars(chan, "\n", 1);
		    }
		}
	    }
		    errChannel = Tcl_GetStdChannel(TCL_STDERR);
		    if (errChannel) {
			Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
			Tcl_WriteChars(errChannel, "\n", 1);
 		    }
 		}
 	    }
	}
	Tcl_DStringFree(&temp);
    }
}
#endif /* !UNICODE */

/*----------------------------------------------------------------------
 *
 * Tcl_MainEx --
 * Tcl_Main --
 *
 *	Main program for tclsh and most other Tcl-based applications.
 *
 * Results:
 *	None. This function never returns (it exits the process when it's
 *	done).
 *
 * Side effects:
 *	This function initializes the Tcl world and then starts interpreting
 *	commands; almost anything could happen, depending on the script being
 *	interpreted.
 *
 *----------------------------------------------------------------------
 */

TCL_NORETURN void
Tcl_MainEx(
void
Tcl_Main(
    int argc,			/* Number of arguments. */
    TCHAR **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc,
    char **argv,		/* Array of argument strings. */
    Tcl_AppInitProc *appInitProc)
				/* Application-specific initialization
				 * function to call after most initialization
				 * but before starting to execute commands. */
    Tcl_Interp *interp)
{
    Tcl_Obj *path, *resultPtr, *argvPtr, *appName;
    const char *encodingName = NULL;
    int code, exitCode = 0;
    Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
    CONST char *encodingName = NULL;
    PromptType prompt = PROMPT_START;
    int code, length, tty, exitCode = 0;
    Tcl_MainLoopProc *mainLoopProc;
    Tcl_Channel chan;
    InteractiveState is;
    Tcl_Channel inChannel, outChannel, errChannel;
    Tcl_Interp *interp;
    Tcl_DString appName;

    interp = Tcl_CreateInterp();
    TclpSetInitialEncodings();
    TclpFindExecutable((const char *)argv[0]);
    TclpFindExecutable(argv[0]);

    Tcl_InitMemory(interp);

    is.interp = interp;
    is.prompt = PROMPT_START;
    TclNewObj(is.commandPtr);

    /*
     * If the application has not already set a startup script, parse the
     * first few command line arguments to determine the script path and
     * encoding.
     */

    if (NULL == Tcl_GetStartupScript(NULL)) {

	/*
	 * Check whether first 3 args (argv[1] - argv[3]) look like
	 *  -encoding ENCODING FILENAME
	 * 	-encoding ENCODING FILENAME
	 * or like
	 *  FILENAME
	 * 	FILENAME
	 */

	if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
	if ((argc > 3) && (0 == strcmp("-encoding", argv[1]))
		&& ('-' != argv[3][0])) {
	    Tcl_Obj *value = NewNativeObj(argv[2]);
	    Tcl_SetStartupScript(NewNativeObj(argv[3]),
	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[3], -1), argv[2]);
		    TclGetString(value));
	    Tcl_DecrRefCount(value);
	    argc -= 3;
	    argv += 3;
	} else if ((argc > 1) && ('-' != argv[1][0])) {
	    Tcl_SetStartupScript(NewNativeObj(argv[1]), NULL);
	    Tcl_SetStartupScript(Tcl_NewStringObj(argv[1], -1), NULL);
	    argc--;
	    argv++;
	}
    }

    path = Tcl_GetStartupScript(&encodingName);
    if (path == NULL) {
	appName = NewNativeObj(argv[0]);
	Tcl_ExternalToUtfDString(NULL, argv[0], -1, &appName);
    } else {
	CONST char *pathName = Tcl_GetStringFromObj(path, &length);
	Tcl_ExternalToUtfDString(NULL, pathName, length, &appName);
	appName = path;
	path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
	Tcl_SetStartupScript(path, encodingName);
    }
    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&appName);
    argc--;
    argv++;

    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewWideIntObj(argc), TCL_GLOBAL_ONLY);
    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);

    argvPtr = Tcl_NewListObj(0, NULL);
    while (argc--) {
	Tcl_DString ds;
	Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
	Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++));
	Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
		Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
	Tcl_DStringFree(&ds);
    }
    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);

    /*
     * Set the "tcl_interactive" variable.
     */

    is.tty = isatty(0);
    Tcl_SetVar2Ex(interp, "tcl_interactive", NULL,
	    Tcl_NewWideIntObj(!path && is.tty), TCL_GLOBAL_ONLY);
    tty = isatty(0);
    Tcl_SetVar(interp, "tcl_interactive", ((path == NULL) && tty) ? "1" : "0",
	    TCL_GLOBAL_ONLY);

    /*
     * Invoke application-specific initialization.
     */

    Tcl_Preserve(interp);
    if (appInitProc(interp) != TCL_OK) {
	chan = Tcl_GetStdChannel(TCL_STDERR);
	if (chan) {
	    Tcl_WriteChars(chan,
    Tcl_Preserve((ClientData) interp);
    if ((*appInitProc)(interp) != TCL_OK) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	if (errChannel) {
	    Tcl_WriteChars(errChannel,
		    "application-specific initialization failed: ", -1);
	    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
	    Tcl_WriteChars(chan, "\n", 1);
	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
	    Tcl_WriteChars(errChannel, "\n", 1);
	}
    }
    if (Tcl_InterpDeleted(interp)) {
	goto done;
    }
    if (Tcl_LimitExceeded(interp)) {
	goto done;
    }
    if (TclFullFinalizationRequested()) {
	/*
	 * Arrange for final deletion of the main interp
	 */

	/* ARGH Munchhausen effect */
	Tcl_CreateExitHandler(FreeMainInterp, interp);
    }

    /*
     * Invoke the script specified on the command line, if any. Must fetch it
     * again, as the appInitProc might have reset it.
     * If a script file was specified then just source that file and quit.
     * Must fetch it again, as the appInitProc might have reset it.
     */

    path = Tcl_GetStartupScript(&encodingName);
    if (path != NULL) {
	Tcl_ResetResult(interp);
	code = Tcl_FSEvalFileEx(interp, path, encodingName);
	if (code != TCL_OK) {
	    chan = Tcl_GetStdChannel(TCL_STDERR);
	    if (chan) {
	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
	    if (errChannel) {
		Tcl_Obj *options = Tcl_GetReturnOptions(interp, code);
		Tcl_Obj *keyPtr, *valuePtr;

		TclNewLiteralStringObj(keyPtr, "-errorinfo");
		Tcl_IncrRefCount(keyPtr);
		Tcl_DictObjGet(NULL, options, keyPtr, &valuePtr);
		Tcl_DecrRefCount(keyPtr);

		if (valuePtr) {
		    Tcl_WriteObj(chan, valuePtr);
		    Tcl_WriteObj(errChannel, valuePtr);
		}
		Tcl_WriteChars(chan, "\n", 1);
		Tcl_WriteChars(errChannel, "\n", 1);
		Tcl_DecrRefCount(options);
	    }
	    exitCode = 1;
	}
	goto done;
    }

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
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




611
612
613
614
615
616
617






618












619
620
621
622
623
624
625
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
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
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
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
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




611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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







+
-
+





-
-
-
+
+
+
+
-

-
-
-
-
+
+






-
-
+
+



-
-
-
-
+
+
+
+

-
-
-
+
+
+


-
+

-
-
+
+













-
-
-
+
+
+


-
-
-
-
+
+
+
+

-
-
-
+
+
+



-
+
-

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+

-
+


-
+
-
-
-
-
+
+
+










+
-
-
-
+
+
+
+

+
+
+
+
+
+
+

+
+
+
+
-
-
+
+


-
-
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+






-

-
+


-
+



-
-
+
+






-
-
+
+

-
-
+
+








-
-
+
+
+
-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+



-
-








-
+












-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















+



-
+

-
-
-
+



+







-
+












-
+














-
+









-
+



-
-
+

-
-
+
+
+


-
-
+
+
-
-
-
+
+



-
+
-

-
-
-
-
+
+
+
+









-
-
+
+








    /*
     * Process commands from stdin until there's an end-of-file. Note that we
     * need to fetch the standard channels again after every eval, since they
     * may have been changed.
     */

    commandPtr = Tcl_NewObj();
    Tcl_IncrRefCount(is.commandPtr);
    Tcl_IncrRefCount(commandPtr);

    /*
     * Get a new value for tty if anyone writes to ::tcl_interactive
     */

    Tcl_LinkVar(interp, "tcl_interactive", &is.tty, TCL_LINK_BOOLEAN);
    is.input = Tcl_GetStdChannel(TCL_STDIN);
    while ((is.input != NULL) && !Tcl_InterpDeleted(interp)) {
    Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty, TCL_LINK_BOOLEAN);
    inChannel = Tcl_GetStdChannel(TCL_STDIN);
    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
    while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) {
	mainLoopProc = TclGetMainLoop();
	if (mainLoopProc == NULL) {
	    size_t length;

	    if (is.tty) {
		Prompt(interp, &is);
	    if (tty) {
		Prompt(interp, &prompt);
		if (Tcl_InterpDeleted(interp)) {
		    break;
		}
		if (Tcl_LimitExceeded(interp)) {
		    break;
		}
		is.input = Tcl_GetStdChannel(TCL_STDIN);
		if (is.input == NULL) {
		inChannel = Tcl_GetStdChannel(TCL_STDIN);
		if (inChannel == (Tcl_Channel) NULL) {
		    break;
		}
	    }
	    if (Tcl_IsShared(is.commandPtr)) {
		Tcl_DecrRefCount(is.commandPtr);
		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
		Tcl_IncrRefCount(is.commandPtr);
	    if (Tcl_IsShared(commandPtr)) {
		Tcl_DecrRefCount(commandPtr);
		commandPtr = Tcl_DuplicateObj(commandPtr);
		Tcl_IncrRefCount(commandPtr);
	    }
	    length = Tcl_GetsObj(is.input, is.commandPtr);
	    if (length == TCL_INDEX_NONE) {
		if (Tcl_InputBlocked(is.input)) {
	    length = Tcl_GetsObj(inChannel, commandPtr);
	    if (length < 0) {
		if (Tcl_InputBlocked(inChannel)) {
		    /*
		     * This can only happen if stdin has been set to
		     * non-blocking. In that case cycle back and try again.
		     * non-blocking.  In that case cycle back and try again.
		     * This sets up a tight polling loop (since we have no
		     * event loop running). If this causes bad CPU hogging, we
		     * might try toggling the blocking on stdin instead.
		     * event loop running). If this causes bad CPU hogging,
		     * we might try toggling the blocking on stdin instead.
		     */

		    continue;
		}

		/*
		 * Either EOF, or an error on stdin; we're done
		 */

		break;
	    }

	    /*
	     * Add the newline removed by Tcl_GetsObj back to the string. Have
	     * to add it back before testing completeness, because it can make
	     * a difference. [Bug 1775878]
	     * Add the newline removed by Tcl_GetsObj back to the string.
	     * Have to add it back before testing completeness, because
	     * it can make a difference.  [Bug 1775878].
	     */

	    if (Tcl_IsShared(is.commandPtr)) {
		Tcl_DecrRefCount(is.commandPtr);
		is.commandPtr = Tcl_DuplicateObj(is.commandPtr);
		Tcl_IncrRefCount(is.commandPtr);
	    if (Tcl_IsShared(commandPtr)) {
		Tcl_DecrRefCount(commandPtr);
		commandPtr = Tcl_DuplicateObj(commandPtr);
		Tcl_IncrRefCount(commandPtr);
	    }
	    Tcl_AppendToObj(is.commandPtr, "\n", 1);
	    if (!TclObjCommandComplete(is.commandPtr)) {
		is.prompt = PROMPT_CONTINUE;
	    Tcl_AppendToObj(commandPtr, "\n", 1);
	    if (!TclObjCommandComplete(commandPtr)) {
		prompt = PROMPT_CONTINUE;
		continue;
	    }

	    is.prompt = PROMPT_START;
	    prompt = PROMPT_START;

	    /*
	     * The final newline is syntactically redundant, and causes some
	     * error messages troubles deeper in, so lop it back off.
	     * The final newline is syntactically redundant, and causes
	     * some error messages troubles deeper in, so lop it back off.
	     */

	    (void)TclGetStringFromObj(is.commandPtr, &length);
	    Tcl_SetObjLength(is.commandPtr, --length);
	    code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
		    TCL_EVAL_GLOBAL);
	    is.input = Tcl_GetStdChannel(TCL_STDIN);
	    Tcl_DecrRefCount(is.commandPtr);
	    TclNewObj(is.commandPtr);
	    Tcl_IncrRefCount(is.commandPtr);
	    Tcl_GetStringFromObj(commandPtr, &length);
	    Tcl_SetObjLength(commandPtr, --length);
	    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
	    Tcl_DecrRefCount(commandPtr);
	    commandPtr = Tcl_NewObj();
	    Tcl_IncrRefCount(commandPtr);
	    if (code != TCL_OK) {
		chan = Tcl_GetStdChannel(TCL_STDERR);
		if (chan) {
		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(chan, "\n", 1);
		if (errChannel) {
		    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
		    Tcl_WriteChars(errChannel, "\n", 1);
		}
	    } else if (is.tty) {
 	    } else if (tty) {
		resultPtr = Tcl_GetObjResult(interp);
		Tcl_IncrRefCount(resultPtr);
		(void)TclGetStringFromObj(resultPtr, &length);
		Tcl_GetStringFromObj(resultPtr, &length);
		chan = Tcl_GetStdChannel(TCL_STDOUT);
		if ((length > 0) && chan) {
		    Tcl_WriteObj(chan, resultPtr);
		    Tcl_WriteChars(chan, "\n", 1);
		if ((length > 0) && outChannel) {
		    Tcl_WriteObj(outChannel, resultPtr);
		    Tcl_WriteChars(outChannel, "\n", 1);
		}
		Tcl_DecrRefCount(resultPtr);
	    }
	} else {	/* (mainLoopProc != NULL) */
	    /*
	     * If a main loop has been defined while running interactively, we
	     * want to start a fileevent based prompt by establishing a
	     * channel handler for stdin.
	     */

	    InteractiveState *isPtr = NULL;
	    if (is.input) {
		if (is.tty) {
		    Prompt(interp, &is);

	    if (inChannel) {
		if (tty) {
		    Prompt(interp, &prompt);
		}
		isPtr = (InteractiveState *)
			ckalloc((int) sizeof(InteractiveState));
		isPtr->input = inChannel;
		isPtr->tty = tty;
		isPtr->commandPtr = commandPtr;
		isPtr->prompt = prompt;
		isPtr->interp = interp;

		Tcl_UnlinkVar(interp, "tcl_interactive");
		Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
			TCL_LINK_BOOLEAN);

		Tcl_CreateChannelHandler(is.input, TCL_READABLE,
			StdinProc, &is);
		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
			(ClientData) isPtr);
	    }

	    mainLoopProc();
	    Tcl_SetMainLoop(NULL);
	    (*mainLoopProc)();
	    mainLoopProc = NULL;

	    if (is.input) {
		Tcl_DeleteChannelHandler(is.input, StdinProc, &is);
	    }
	    is.input = Tcl_GetStdChannel(TCL_STDIN);
	    if (inChannel) {
		tty = isPtr->tty;
		Tcl_UnlinkVar(interp, "tcl_interactive");
		Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
			TCL_LINK_BOOLEAN);
		prompt = isPtr->prompt;
		commandPtr = isPtr->commandPtr;
		if (isPtr->input != (Tcl_Channel) NULL) {
		    Tcl_DeleteChannelHandler(isPtr->input, StdinProc,
			    (ClientData) isPtr);
		}
		ckfree((char *)isPtr);
	    }
	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
	}
#ifdef TCL_MEM_DEBUG

	/*
	 * This code here only for the (unsupported and deprecated) [checkmem]
	 * command.
	 */

#ifdef TCL_MEM_DEBUG
	if (tclMemDumpFileName != NULL) {
	    Tcl_SetMainLoop(NULL);
	    mainLoopProc = NULL;
	    Tcl_DeleteInterp(interp);
	}
#endif /* TCL_MEM_DEBUG */
#endif
    }

  done:
    mainLoopProc = TclGetMainLoop();
    if ((exitCode == 0) && mainLoopProc && !Tcl_LimitExceeded(interp)) {
    if ((exitCode == 0) && (mainLoopProc != NULL)
	    && !Tcl_LimitExceeded(interp)) {
	/*
	 * If everything has gone OK so far, call the main loop proc, if it
	 * exists. Packages (like Tk) can set it to start processing events at
	 * this point.
	 */

	mainLoopProc();
	Tcl_SetMainLoop(NULL);
	(*mainLoopProc)();
	mainLoopProc = NULL;
    }
    if (is.commandPtr != NULL) {
	Tcl_DecrRefCount(is.commandPtr);
    if (commandPtr != NULL) {
	Tcl_DecrRefCount(commandPtr);
    }

    /*
     * Rather than calling exit, invoke the "exit" command so that users can
     * replace "exit" with some other command to do additional cleanup on
     * exit. The Tcl_EvalObjEx call should never return.
     */

    if (!Tcl_InterpDeleted(interp) && !Tcl_LimitExceeded(interp)) {
	Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);
    if (!Tcl_InterpDeleted(interp)) {
	if (!Tcl_LimitExceeded(interp)) {
	    Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);

	Tcl_IncrRefCount(cmd);
	Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
	Tcl_DecrRefCount(cmd);
    }
	    Tcl_IncrRefCount(cmd);
	    Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
	    Tcl_DecrRefCount(cmd);
	}

    /*
     * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual is
     * happening. Maybe interp has been deleted; maybe [exit] was redefined,
     * maybe we've blown up because of an exceeded limit. We still want to
     * cleanup and exit.
     */
	/*
	 * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
	 * is happening. Maybe interp has been deleted; maybe [exit] was
	 * redefined, maybe we've blown up because of an exceeded limit. We
	 * still want to cleanup and exit.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_DeleteInterp(interp);
	}
    }
    Tcl_SetStartupScript(NULL, NULL);

    /*
     * If we get here, the master interp has been deleted. Allow its
     * destruction with the last matching Tcl_Release.
     */

    Tcl_Release((ClientData) interp);
    Tcl_Exit(exitCode);
}

#if !defined(_WIN32) || defined(UNICODE)

/*
 *---------------------------------------------------------------
 *
 * Tcl_SetMainLoop --
 *
 *	Sets an alternative main loop function.
 *
 * Results:
 *	None.
 *	Returns the previously defined main loop function.
 *
 * Side effects:
 *	This function will be called before Tcl exits, allowing for the
 *	creation of an event loop.
 *
 *---------------------------------------------------------------
 */

void
Tcl_SetMainLoop(
    Tcl_MainLoopProc *proc)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->mainLoopProc = proc;
    mainLoopProc = proc;
}

/*
 *---------------------------------------------------------------
 *
 * TclGetMainLoop --
 *
 *	Returns the current alternative main loop function.
 *
 * Results:
 *	Returns the previously defined main loop function, or NULL to indicate
 *	that no such function has been installed and standard tclsh behaviour
 *	(i.e., exit once the script is evaluated if not interactive) is
 *	requested..
 *
 * Side effects:
 *	None (other than possible creation of this file's TSD block).
 *
 *---------------------------------------------------------------
 */

Tcl_MainLoopProc *
TclGetMainLoop(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return tsdPtr->mainLoopProc;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFullFinalizationRequested --
 *
 *	This function returns true when either -DPURIFY is specified, or the
 *	environment variable TCL_FINALIZE_ON_EXIT is set and not "0". This
 *	predicate is called at places affecting the exit sequence, so that the
 *	default behavior is a fast and deadlock-free exit, and the modified
 *	behavior is a more thorough finalization for debugging purposes (leak
 *	hunting etc).
 *
 * Results:
 *	A boolean.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE int
TclFullFinalizationRequested(void)
{
#ifdef PURIFY
    return 1;
#else
    const char *fin;
    Tcl_DString ds;
    int finalize = 0;

    fin = TclGetEnv("TCL_FINALIZE_ON_EXIT", &ds);
    finalize = ((fin != NULL) && strcmp(fin, "0"));
    if (fin != NULL) {
	Tcl_DStringFree(&ds);
    }
    return finalize;
#endif /* PURIFY */
}
#endif /* UNICODE */

/*
 *----------------------------------------------------------------------
 *
 * StdinProc --
 *
 *	This function is invoked by the event dispatcher whenever standard
 *	input becomes readable. It grabs the next line of input characters,
 *	adds them to a command being assembled, and executes the command if
 *	it's complete.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Could be almost arbitrary, depending on the command that's typed.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
static void
StdinProc(
    ClientData clientData,	/* The state of interactive cmd line */
    TCL_UNUSED(int) /*mask*/)
    int mask)			/* Not used. */
{
    int code;
    size_t length;
    InteractiveState *isPtr = (InteractiveState *)clientData;
    InteractiveState *isPtr = (InteractiveState *) clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Obj *commandPtr = isPtr->commandPtr;
    Tcl_Interp *interp = isPtr->interp;
    int code, length;

    if (Tcl_IsShared(commandPtr)) {
	Tcl_DecrRefCount(commandPtr);
	commandPtr = Tcl_DuplicateObj(commandPtr);
	Tcl_IncrRefCount(commandPtr);
    }
    length = Tcl_GetsObj(chan, commandPtr);
    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	if (Tcl_InputBlocked(chan)) {
	    return;
	}
	if (isPtr->tty) {
	    /*
	     * Would be better to find a way to exit the mainLoop? Or perhaps
	     * evaluate [exit]? Leaving as is for now due to compatibility
	     * concerns.
	     */

	    Tcl_Exit(0);
	}
	Tcl_DeleteChannelHandler(chan, StdinProc, isPtr);
	Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) isPtr);
	return;
    }

    if (Tcl_IsShared(commandPtr)) {
	Tcl_DecrRefCount(commandPtr);
	commandPtr = Tcl_DuplicateObj(commandPtr);
	Tcl_IncrRefCount(commandPtr);
    }
    Tcl_AppendToObj(commandPtr, "\n", 1);
    if (!TclObjCommandComplete(commandPtr)) {
	isPtr->prompt = PROMPT_CONTINUE;
	goto prompt;
    }
    isPtr->prompt = PROMPT_START;
    (void)TclGetStringFromObj(commandPtr, &length);
    Tcl_GetStringFromObj(commandPtr, &length);
    Tcl_SetObjLength(commandPtr, --length);

    /*
     * Disable the stdin channel handler while evaluating the command;
     * otherwise if the command re-enters the event loop we might process
     * commands from stdin before the current command is finished. Among other
     * things, this will trash the text of the command being evaluated.
     */

    Tcl_CreateChannelHandler(chan, 0, StdinProc, isPtr);
    Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) isPtr);
    code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
    isPtr->input = chan = Tcl_GetStdChannel(TCL_STDIN);
    Tcl_DecrRefCount(commandPtr);
    TclNewObj(commandPtr);
    isPtr->commandPtr = commandPtr;
    isPtr->commandPtr = commandPtr = Tcl_NewObj();
    Tcl_IncrRefCount(commandPtr);
    if (chan != NULL) {
	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc, isPtr);
    if (chan != (Tcl_Channel) NULL) {
	Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
		(ClientData) isPtr);
    }
    if (code != TCL_OK) {
	chan = Tcl_GetStdChannel(TCL_STDERR);

	Tcl_Channel errChannel = Tcl_GetStdChannel(TCL_STDERR);
	if (errChannel != (Tcl_Channel) NULL) {
	if (chan != NULL) {
	    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
	    Tcl_WriteChars(chan, "\n", 1);
	    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
	    Tcl_WriteChars(errChannel, "\n", 1);
	}
    } else if (isPtr->tty) {
	Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
	chan = Tcl_GetStdChannel(TCL_STDOUT);
	Tcl_Channel outChannel = Tcl_GetStdChannel(TCL_STDOUT);

	Tcl_IncrRefCount(resultPtr);
	(void)TclGetStringFromObj(resultPtr, &length);
	if ((length > 0) && (chan != NULL)) {
	    Tcl_WriteObj(chan, resultPtr);
	    Tcl_WriteChars(chan, "\n", 1);
	Tcl_GetStringFromObj(resultPtr, &length);
	if ((length >0) && (outChannel != (Tcl_Channel) NULL)) {
	    Tcl_WriteObj(outChannel, resultPtr);
	    Tcl_WriteChars(outChannel, "\n", 1);
	}
	Tcl_DecrRefCount(resultPtr);
    }

    /*
     * If a tty stdin is still around, output a prompt.
     */

  prompt:
    if (isPtr->tty && (isPtr->input != NULL)) {
	Prompt(interp, isPtr);
    if (isPtr->tty && (isPtr->input != (Tcl_Channel) NULL)) {
	Prompt(interp, &(isPtr->prompt));
	isPtr->input = Tcl_GetStdChannel(TCL_STDIN);
    }
}

/*
 *----------------------------------------------------------------------
 *
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
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







+
-
-
+
+



-
+

-
+




-
+







-
-
-
-
-
+
+
+
+
+
-






-
-
-
-
+
+
+
+





-
-
-
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









 *
 *----------------------------------------------------------------------
 */

static void
Prompt(
    Tcl_Interp *interp,		/* Interpreter to use for prompting. */
    PromptType *promptPtr)	/* Points to type of prompt to print. Filled
    InteractiveState *isPtr)	/* InteractiveState. Filled with PROMPT_NONE
				 * after a prompt is printed. */
				 * with PROMPT_NONE after a prompt is
				 * printed. */
{
    Tcl_Obj *promptCmdPtr;
    int code;
    Tcl_Channel chan;
    Tcl_Channel outChannel, errChannel;

    if (isPtr->prompt == PROMPT_NONE) {
    if (*promptPtr == PROMPT_NONE) {
	return;
    }

    promptCmdPtr = Tcl_GetVar2Ex(interp,
	    (isPtr->prompt==PROMPT_CONTINUE ? "tcl_prompt2" : "tcl_prompt1"),
	    ((*promptPtr == PROMPT_CONTINUE) ? "tcl_prompt2" : "tcl_prompt1"),
	    NULL, TCL_GLOBAL_ONLY);

    if (Tcl_InterpDeleted(interp)) {
	return;
    }
    if (promptCmdPtr == NULL) {
    defaultPrompt:
	if (isPtr->prompt == PROMPT_START) {
	    chan = Tcl_GetStdChannel(TCL_STDOUT);
	    if (chan != NULL) {
		Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT,
			strlen(DEFAULT_PRIMARY_PROMPT));
	outChannel = Tcl_GetStdChannel(TCL_STDOUT);
	if ((*promptPtr == PROMPT_START)
		&& (outChannel != (Tcl_Channel) NULL)) {
	    Tcl_WriteChars(outChannel, DEFAULT_PRIMARY_PROMPT,
		    strlen(DEFAULT_PRIMARY_PROMPT));
	    }
	}
    } else {
	code = Tcl_EvalObjEx(interp, promptCmdPtr, TCL_EVAL_GLOBAL);
	if (code != TCL_OK) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (script that generates prompt)");
	    chan = Tcl_GetStdChannel(TCL_STDERR);
	    if (chan != NULL) {
		Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
		Tcl_WriteChars(chan, "\n", 1);
	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
	    if (errChannel != (Tcl_Channel) NULL) {
		Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
		Tcl_WriteChars(errChannel, "\n", 1);
	    }
	    goto defaultPrompt;
	}
    }

    chan = Tcl_GetStdChannel(TCL_STDOUT);
    if (chan != NULL) {
	Tcl_Flush(chan);
    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
    if (outChannel != (Tcl_Channel) NULL) {
	Tcl_Flush(outChannel);
    }
    isPtr->prompt = PROMPT_NONE;
    *promptPtr = PROMPT_NONE;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeMainInterp --
 *
 *	Exit handler used to cleanup the main interpreter and ancillary
 *	startup script storage at exit.
 *
 *----------------------------------------------------------------------
 */

static void
FreeMainInterp(
    ClientData clientData)
{
    Tcl_Interp *interp = (Tcl_Interp *)clientData;

    /*if (TclInExit()) return;*/

    if (!Tcl_InterpDeleted(interp)) {
	Tcl_DeleteInterp(interp);
    }
    Tcl_SetStartupScript(NULL, NULL);
    Tcl_Release(interp);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclNamesp.c.

1
2
3
4
5
6
7
8


9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36


37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63








64
65
66
67
68
69












































































70
71
72
73
74
75
76
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







-
+
+


















-
-






-
-
+
+



















-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







/*
 * tclNamesp.c --
 *
 *	Contains support for namespaces, which provide a separate context of
 *	commands and global variables. The global :: namespace is the
 *	traditional Tcl "global" scope. Other namespaces are created as
 *	children of the global namespace. These other namespaces contain
 *	special-purpose commands and variables for packages.
 *	special-purpose commands and variables for packages. Also includes the
 *	TIP#112 ensemble machinery.
 *
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2002-2005 Donal K. Fellows.
 * Copyright (c) 2006 Neil Madden.
 * Contributions from Don Porter, NIST, 2007. (not subject to US copyright)
 *
 * Originally implemented by
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   mmclennan@lucent.com
 *
 * 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 "tclCompile.h" /* for TclLogCommandInfo visibility */
#include <assert.h>

/*
 * Thread-local storage used to avoid having a global lock on data that is not
 * limited to a single interpreter.
 */

typedef struct {
    size_t numNsCreated;	/* Count of the number of namespaces created
typedef struct ThreadSpecificData {
    long numNsCreated;		/* Count of the number of namespaces created
				 * within the thread. This value is used as a
				 * unique id for each namespace. Cannot be
				 * per-interp because the nsId is used to
				 * distinguish objects which can be passed
				 * around between interps in the same thread,
				 * but does not need to be global because
				 * object internal reps are always per-thread
				 * anyway. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * This structure contains a cached pointer to a namespace that is the result
 * of resolving the namespace's name in some other namespace. It is the
 * internal representation for a nsName object. It contains the pointer along
 * with some information that is used to check the cached pointer's validity.
 */

typedef struct {
    Namespace *nsPtr;		/* A cached pointer to the Namespace that the
				 * name resolved to. */
    Namespace *refNsPtr;	/* Points to the namespace context in which
				 * the name was resolved. NULL if the name is
				 * fully qualified and thus the resolution
				 * does not depend on the context. */
    size_t refCount;		/* Reference count: 1 for each nsName object
typedef struct ResolvedNsName {
    Namespace *nsPtr;          /* A cached pointer to the Namespace that the
                                * name resolved to. */
    Namespace *refNsPtr;       /* Points to the namespace context in which the
                                * name was resolved. NULL if the name is fully
                                * qualified and thus the resolution does not
                                * depend on the context. */
    int refCount;		/* Reference count: 1 for each nsName object
				 * that has a pointer to this ResolvedNsName
				 * structure as its internal rep. This
				 * structure can be freed when refCount
				 * becomes zero. */
} ResolvedNsName;

/*
 * The client data for an ensemble command. This consists of the table of
 * commands that are actually exported by the namespace, and an epoch counter
 * that, combined with the exportLookupEpoch field of the namespace structure,
 * defines whether the table contains valid data or will need to be recomputed
 * next time the ensemble command is called.
 */

typedef struct EnsembleConfig {
    Namespace *nsPtr;		/* The namspace backing this ensemble up. */
    Tcl_Command token;		/* The token for the command that provides
				 * ensemble support for the namespace, or NULL
				 * if the command has been deleted (or never
				 * existed; the global namespace never has an
				 * ensemble command.) */
    int epoch;			/* The epoch at which this ensemble's table of
				 * exported commands is valid. */
    char **subcommandArrayPtr;	/* Array of ensemble subcommand names. At all
				 * consistent points, this will have the same
				 * number of entries as there are entries in
				 * the subcommandTable hash. */
    Tcl_HashTable subcommandTable;
				/* Hash table of ensemble subcommand names,
				 * which are its keys so this also provides
				 * the storage management for those subcommand
				 * names. The contents of the entry values are
				 * object version the prefix lists to use when
				 * substituting for the command/subcommand to
				 * build the ensemble implementation command.
				 * Has to be stored here as well as in
				 * subcommandDict because that field is NULL
				 * when we are deriving the ensemble from the
				 * namespace exports list. FUTURE WORK: use
				 * object hash table here. */
    struct EnsembleConfig *next;/* The next ensemble in the linked list of
				 * ensembles associated with a namespace. If
				 * this field points to this ensemble, the
				 * structure has already been unlinked from
				 * all lists, and cannot be found by scanning
				 * the list from the namespace's ensemble
				 * field. */
    int flags;			/* ORed combo of TCL_ENSEMBLE_PREFIX, ENS_DEAD
				 * and ENSEMBLE_COMPILE. */

    /* OBJECT FIELDS FOR ENSEMBLE CONFIGURATION */

    Tcl_Obj *subcommandDict;	/* Dictionary providing mapping from
				 * subcommands to their implementing command
				 * prefixes, or NULL if we are to build the
				 * map automatically from the namespace
				 * exports. */
    Tcl_Obj *subcmdList;	/* List of commands that this ensemble
				 * actually provides, and whose implementation
				 * will be built using the subcommandDict (if
				 * present and defined) and by simple mapping
				 * to the namespace otherwise. If NULL,
				 * indicates that we are using the (dynamic)
				 * list of currently exported commands. */
    Tcl_Obj *unknownHandler;	/* Script prefix used to handle the case when
				 * no match is found (according to the rule
				 * defined by flag bit TCL_ENSEMBLE_PREFIX) or
				 * NULL to use the default error-generating
				 * behaviour. The script execution gets all
				 * the arguments to the ensemble command
				 * (including objv[0]) and will have the
				 * results passed directly back to the caller
				 * (including the error code) unless the code
				 * is TCL_CONTINUE in which case the
				 * subcommand will be reparsed by the ensemble
				 * core, presumably because the ensemble
				 * itself has been updated. */
} EnsembleConfig;

#define ENS_DEAD	0x1	/* Flag value to say that the ensemble is dead
				 * and on its way out. */

/*
 * Declarations for functions local to this file:
 */

static void		DeleteImportedCmd(ClientData clientData);
static int		DoImport(Tcl_Interp *interp,
			    Namespace *nsPtr, Tcl_HashEntry *hPtr,
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
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







-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+


-
-







-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

+
+
-
-
+
+


-
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+







			    const char *name2, int flags);
static char *		EstablishErrorInfoTraces(ClientData clientData,
			    Tcl_Interp *interp, const char *name1,
			    const char *name2, int flags);
static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int		GetNamespaceFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
static int		InvokeImportedNRCmd(ClientData clientData,
static int		InvokeImportedCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc	NamespaceChildrenCmd;
static Tcl_ObjCmdProc	NamespaceCodeCmd;
static Tcl_ObjCmdProc	NamespaceCurrentCmd;
static Tcl_ObjCmdProc	NamespaceDeleteCmd;
static Tcl_ObjCmdProc	NamespaceEvalCmd;
static Tcl_ObjCmdProc	NRNamespaceEvalCmd;
static Tcl_ObjCmdProc	NamespaceExistsCmd;
static Tcl_ObjCmdProc	NamespaceExportCmd;
static Tcl_ObjCmdProc	NamespaceForgetCmd;
static int		NamespaceChildrenCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceCodeCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceCurrentCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceDeleteCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceEnsembleCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceEvalCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceExistsCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceExportCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceForgetCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static void		NamespaceFree(Namespace *nsPtr);
static Tcl_ObjCmdProc	NamespaceImportCmd;
static Tcl_ObjCmdProc	NamespaceInscopeCmd;
static Tcl_ObjCmdProc	NRNamespaceInscopeCmd;
static Tcl_ObjCmdProc	NamespaceOriginCmd;
static Tcl_ObjCmdProc	NamespaceParentCmd;
static Tcl_ObjCmdProc	NamespacePathCmd;
static Tcl_ObjCmdProc	NamespaceQualifiersCmd;
static Tcl_ObjCmdProc	NamespaceTailCmd;
static Tcl_ObjCmdProc	NamespaceUpvarCmd;
static Tcl_ObjCmdProc	NamespaceUnknownCmd;
static Tcl_ObjCmdProc	NamespaceWhichCmd;
static int		NamespaceImportCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceInscopeCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceOriginCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceParentCmd(ClientData dummy,Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespacePathCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceQualifiersCmd(ClientData dummy,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int		NamespaceTailCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceUpvarCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		NamespaceUnknownCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		NamespaceWhichCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		SetNsNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		NsEnsembleImplementationCmd(ClientData clientData,
			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
static int		NsEnsembleStringOrder(const void *strPtr1,
			    const void *strPtr2);
static void		DeleteEnsembleConfig(ClientData clientData);
static void		MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
			    EnsembleConfig *ensemblePtr,
			    const char *subcmdName, Tcl_Obj *prefixObjPtr);
static void		FreeEnsembleCmdRep(Tcl_Obj *objPtr);
static void		DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
static void		UnlinkNsPath(Namespace *nsPtr);

static Tcl_NRPostProc NsEval_Callback;

/*
 * This structure defines a Tcl object type that contains a namespace
 * reference. It is used in commands that take the name of a namespace as an
 * argument. The namespace reference is resolved, and the result in cached in
 * the object.
 */

static const Tcl_ObjType nsNameType = {
static Tcl_ObjType nsNameType = {
    "nsName",			/* the type's name */
    FreeNsNameInternalRep,	/* freeIntRepProc */
    DupNsNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetNsNameFromAny		/* setFromAnyProc */
};

#define NsNameSetIntRep(objPtr, nnPtr)					\
    do {								\
	Tcl_ObjIntRep ir;						\
	(nnPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (nnPtr);					\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), &nsNameType, &ir);			\
    } while (0)

#define NsNameGetIntRep(objPtr, nnPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &nsNameType);			\
	(nnPtr) = irPtr ? (ResolvedNsName *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * This structure defines a Tcl object type that contains a reference to an
 * ensemble subcommand (e.g. the "length" in [string length ab]). It is used
 * Array of values describing how to implement each standard subcommand of the
 * "namespace" command.
 * to cache the mapping between the subcommand itself and the real command
 * that implements it.
 */

static const EnsembleImplMap defaultNamespaceMap[] = {
Tcl_ObjType tclEnsembleCmdType = {
    {"children",   NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
    {"code",	   NamespaceCodeCmd,	TclCompileNamespaceCodeCmd, NULL, NULL, 0},
    {"current",	   NamespaceCurrentCmd,	TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
    {"delete",	   NamespaceDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"ensemble",   TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    "ensembleCommand",		/* the type's name */
    FreeEnsembleCmdRep,		/* freeIntRepProc */
    {"eval",	   NamespaceEvalCmd,	NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",	   NamespaceExistsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"export",	   NamespaceExportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"forget",	   NamespaceForgetCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"import",	   NamespaceImportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"inscope",	   NamespaceInscopeCmd,	NULL, NRNamespaceInscopeCmd, NULL, 0},
    {"origin",	   NamespaceOriginCmd,	TclCompileNamespaceOriginCmd, NULL, NULL, 0},
    {"parent",	   NamespaceParentCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"path",	   NamespacePathCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
    {"tail",	   NamespaceTailCmd,	TclCompileNamespaceTailCmd, NULL, NULL, 0},
    {"unknown",	   NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"upvar",	   NamespaceUpvarCmd,	TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
    {"which",	   NamespaceWhichCmd,	TclCompileNamespaceWhichCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
    DupEnsembleCmdRep,		/* dupIntRepProc */
    StringOfEnsembleCmdRep,	/* updateStringProc */
    NULL			/* setFromAnyProc */
};

/*
 *----------------------------------------------------------------------
 *
 * TclInitNamespaceSubsystem --
 *
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
291
292
293
294
295
296
297

298
299
300
301
302
303
304
305







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Namespace *
Tcl_GetCurrentNamespace(
    Tcl_Interp *interp)/* Interpreter whose current namespace is
    register Tcl_Interp *interp)/* Interpreter whose current namespace is
				 * being queried. */
{
    return TclGetCurrentNamespace(interp);
}

/*
 *----------------------------------------------------------------------
240
241
242
243
244
245
246
247

248
249
250
251
252
253
254
315
316
317
318
319
320
321

322
323
324
325
326
327
328
329







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Namespace *
Tcl_GetGlobalNamespace(
    Tcl_Interp *interp)/* Interpreter whose global namespace should
    register Tcl_Interp *interp)/* Interpreter whose global namespace should
				 * be returned. */
{
    return TclGetGlobalNamespace(interp);
}

/*
 *----------------------------------------------------------------------
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
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







-
-
+
+

















+







				 * created in the frame. If 0, the frame is
				 * for a "namespace eval" or "namespace
				 * inscope" command and var references are
				 * treated as references to namespace
				 * variables. */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = (CallFrame *) callFramePtr;
    Namespace *nsPtr;
    register CallFrame *framePtr = (CallFrame *) callFramePtr;
    register Namespace *nsPtr;

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else {
	nsPtr = (Namespace *) namespacePtr;

	/*
	 * TODO: Examine whether it would be better to guard based on NS_DYING
	 * or NS_KILLED. It appears that these are not tested because they can
	 * be set in a global interp that has been [namespace delete]d, but
	 * which never really completely goes away because of lingering global
	 * things like ::errorInfo and [::unknown] and hidden commands.
	 * Review of those designs might permit stricter checking here.
	 */

	if (nsPtr->flags & NS_DEAD) {
	    Tcl_Panic("Trying to push call frame for dead namespace");
	    /*NOTREACHED*/
	}
    }

    nsPtr->activationCount++;
    framePtr->nsPtr = nsPtr;
    framePtr->isProcCallFrame = isProcCallFrame;
    framePtr->objc = 0;
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
408
409
410
411
412
413
414

415
416
417
418
419
420
421
422

423
424
425
426
427
428
429







-








-







    }
    framePtr->procPtr = NULL;		/* no called procedure */
    framePtr->varTablePtr = NULL;	/* and no local variables */
    framePtr->numCompiledLocals = 0;
    framePtr->compiledLocals = NULL;
    framePtr->clientData = NULL;
    framePtr->localCachePtr = NULL;
    framePtr->tailcallPtr = NULL;

    /*
     * Push the new call frame onto the interpreter's stack of procedure call
     * frames making it the current frame.
     */

    iPtr->framePtr = framePtr;
    iPtr->varFramePtr = framePtr;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PopCallFrame --
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
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







-
-
+
+

















-
+




-
+












-
-
+
+
+



-
-
-
-







 *----------------------------------------------------------------------
 */

void
Tcl_PopCallFrame(
    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->framePtr;
    register Interp *iPtr = (Interp *) interp;
    register CallFrame *framePtr = iPtr->framePtr;
    Namespace *nsPtr;

    /*
     * It's important to remove the call frame from the interpreter's stack of
     * call frames before deleting local variables, so that traces invoked by
     * the variable deletion don't see the partially-deleted frame.
     */

    if (framePtr->callerPtr) {
	iPtr->framePtr = framePtr->callerPtr;
	iPtr->varFramePtr = framePtr->callerVarPtr;
    } else {
	/* Tcl_PopCallFrame: trying to pop rootCallFrame! */
    }

    if (framePtr->varTablePtr != NULL) {
	TclDeleteVars(iPtr, framePtr->varTablePtr);
	Tcl_Free(framePtr->varTablePtr);
	ckfree((char *) framePtr->varTablePtr);
	framePtr->varTablePtr = NULL;
    }
    if (framePtr->numCompiledLocals > 0) {
	TclDeleteCompiledLocalVars(iPtr, framePtr);
	if (framePtr->localCachePtr->refCount-- <= 1) {
	if (--framePtr->localCachePtr->refCount == 0) {
	    TclFreeLocalCache(interp, framePtr->localCachePtr);
	}
	framePtr->localCachePtr = NULL;
    }

    /*
     * Decrement the namespace's count of active call frames. If the namespace
     * is "dying" and there are no more active call frames, call
     * Tcl_DeleteNamespace to destroy it.
     */

    nsPtr = framePtr->nsPtr;
    if ((--nsPtr->activationCount <= (unsigned)(nsPtr == iPtr->globalNsPtr))
	    && (nsPtr->flags & NS_DYING)) {
    nsPtr->activationCount--;
    if ((nsPtr->flags & NS_DYING)
	    && (nsPtr->activationCount - (nsPtr == iPtr->globalNsPtr) == 0)) {
	Tcl_DeleteNamespace((Tcl_Namespace *) nsPtr);
    }
    framePtr->nsPtr = NULL;

    if (framePtr->tailcallPtr) {
	TclSetTailcall(interp, framePtr->tailcallPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPushStackFrame --
 *
454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
469
470

471
472
473
474
475
476
477
525
526
527
528
529
530
531

532
533
534
535
536
537
538
539
540

541
542
543
544
545
546
547
548







-
+








-
+







				 * If new variables are created, they will be
				 * created in the frame. If 0, the frame is
				 * for a "namespace eval" or "namespace
				 * inscope" command and var references are
				 * treated as references to namespace
				 * variables. */
{
    *framePtrPtr = (Tcl_CallFrame *)TclStackAlloc(interp, sizeof(CallFrame));
    *framePtrPtr = (Tcl_CallFrame *) TclStackAlloc(interp, sizeof(CallFrame));
    return Tcl_PushCallFrame(interp, *framePtrPtr, namespacePtr,
	    isProcCallFrame);
}

void
TclPopStackFrame(
    Tcl_Interp *interp)		/* Interpreter with call frame to pop. */
{
    CallFrame *freePtr = ((Interp *) interp)->framePtr;
    CallFrame *freePtr = ((Interp *)interp)->framePtr;

    Tcl_PopCallFrame(interp);
    TclStackFree(interp, freePtr);
}

/*
 *----------------------------------------------------------------------
488
489
490
491
492
493
494
495

496
497
498
499



500
501

502
503

504
505
506
507
508
509
510
559
560
561
562
563
564
565

566
567



568
569
570
571

572
573

574
575
576
577
578
579
580
581







-
+

-
-
-
+
+
+

-
+

-
+







 *	Read and unset traces are established on ::errorCode.
 *
 *----------------------------------------------------------------------
 */

static char *
EstablishErrorCodeTraces(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(const char *) /*name1*/,
    TCL_UNUSED(const char *) /*name2*/,
    TCL_UNUSED(int) /*flags*/)
    const char *name1,
    const char *name2,
    int flags)
{
    Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
	    ErrorCodeRead, NULL);
    Tcl_TraceVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
    Tcl_TraceVar(interp, "errorCode", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
	    EstablishErrorCodeTraces, NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
520
521
522
523
524
525
526
527

528
529
530
531



532
533

534
535
536
537
538
539
540
591
592
593
594
595
596
597

598
599



600
601
602
603

604
605
606
607
608
609
610
611







-
+

-
-
-
+
+
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
ErrorCodeRead(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(const char *) /*name1*/,
    TCL_UNUSED(const char *) /*name2*/,
    TCL_UNUSED(int) /*flags*/)
    const char *name1,
    const char *name2,
    int flags)
{
    Interp *iPtr = (Interp *) interp;
    Interp *iPtr = (Interp *)interp;

    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
	return NULL;
    }
    if (iPtr->errorCode) {
	Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
		iPtr->errorCode, TCL_GLOBAL_ONLY);
562
563
564
565
566
567
568
569

570
571
572
573



574
575

576
577

578
579
580
581
582
583
584
633
634
635
636
637
638
639

640
641



642
643
644
645

646
647

648
649
650
651
652
653
654
655







-
+

-
-
-
+
+
+

-
+

-
+







 *	Read and unset traces are established on ::errorInfo.
 *
 *----------------------------------------------------------------------
 */

static char *
EstablishErrorInfoTraces(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(const char *) /*name1*/,
    TCL_UNUSED(const char *) /*name2*/,
    TCL_UNUSED(int) /*flags*/)
    const char *name1,
    const char *name2,
    int flags)
{
    Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_READS,
    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_READS,
	    ErrorInfoRead, NULL);
    Tcl_TraceVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY|TCL_TRACE_UNSETS,
    Tcl_TraceVar(interp, "errorInfo", TCL_GLOBAL_ONLY | TCL_TRACE_UNSETS,
	    EstablishErrorInfoTraces, NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
594
595
596
597
598
599
600
601

602
603
604
605



606
607
608
609
610
611
612
665
666
667
668
669
670
671

672
673



674
675
676
677
678
679
680
681
682
683







-
+

-
-
-
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static char *
ErrorInfoRead(
    TCL_UNUSED(ClientData),
    ClientData clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(const char *) /*name1*/,
    TCL_UNUSED(const char *) /*name2*/,
    TCL_UNUSED(int) /*flags*/)
    const char *name1,
    const char *name2,
    int flags)
{
    Interp *iPtr = (Interp *) interp;

    if (Tcl_InterpDeleted(interp) || !(iPtr->flags & ERR_LEGACY_COPY)) {
	return NULL;
    }
    if (iPtr->errorInfo) {
653
654
655
656
657
658
659
660

661
662
663
664
665
666
667

668
669
670
671
672
673
674
675
724
725
726
727
728
729
730

731
732
733
734
735
736
737

738

739
740
741
742
743
744
745







-
+






-
+
-







    ClientData clientData,	/* One-word value to store with namespace. */
    Tcl_NamespaceDeleteProc *deleteProc)
				/* Function called to delete client data when
				 * the namespace is deleted. NULL if no
				 * function should be called. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *nsPtr, *ancestorPtr;
    register Namespace *nsPtr, *ancestorPtr;
    Namespace *parentPtr, *dummy1Ptr, *dummy2Ptr;
    Namespace *globalNsPtr = iPtr->globalNsPtr;
    const char *simpleName;
    Tcl_HashEntry *entryPtr;
    Tcl_DString buffer1, buffer2;
    Tcl_DString *namePtr, *buffPtr;
    int newEntry;
    int newEntry, nameLen;
    size_t nameLen;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    const char *nameStr;
    Tcl_DString tmpBuffer;

    Tcl_DStringInit(&tmpBuffer);

    /*
707
708
709
710
711
712
713

714
715


716
717
718
719
720
721
722
723
724
777
778
779
780
781
782
783
784


785
786


787
788
789
790
791
792
793







+
-
-
+
+
-
-







    /*
     * If we've ended up with an empty string now, we're attempting to create
     * the global namespace despite the global namespace existing. That's
     * naughty!
     */

    if (*name == '\0') {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace"
                " \"\": only global namespace can have empty name", -1));
	Tcl_AppendResult(interp, "can't create namespace \"\": "
		"only global namespace can have empty name", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
		"CREATEGLOBAL", NULL);
	Tcl_DStringFree(&tmpBuffer);
	return NULL;
    }

    /*
     * Find the parent for the new namespace.
     */
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
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







-
-
-
+
-
-
-
-
-
-
-
+
+
-
-










-
+
-
-
-
+
+




-

-
-
-







    }

    /*
     * Check for a bad namespace name and make sure that the name does not
     * already exist in the parent namespace.
     */

    if (
#ifndef BREAK_NAMESPACE_COMPAT
	Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL
    if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
#else
	parentPtr->childTablePtr != NULL &&
	Tcl_FindHashEntry(parentPtr->childTablePtr, simpleName) != NULL
#endif
    ) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create namespace \"%s\": already exists", name));
	Tcl_AppendResult(interp, "can't create namespace \"", name,
		"\": already exists", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
		"CREATEEXISTING", NULL);
	Tcl_DStringFree(&tmpBuffer);
	return NULL;
    }

    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

  doCreate:
    nsPtr = (Namespace *)Tcl_Alloc(sizeof(Namespace));
    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
    nameLen = strlen(simpleName) + 1;
    nsPtr->name = (char *)Tcl_Alloc(nameLen);
    memcpy(nsPtr->name, simpleName, nameLen);
    nsPtr->name = ckalloc((unsigned) (strlen(simpleName)+1));
    strcpy(nsPtr->name, simpleName);
    nsPtr->fullName = NULL;		/* Set below. */
    nsPtr->clientData = clientData;
    nsPtr->deleteProc = deleteProc;
    nsPtr->parentPtr = parentPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    Tcl_InitHashTable(&nsPtr->childTable, TCL_STRING_KEYS);
#else
    nsPtr->childTablePtr = NULL;
#endif
    nsPtr->nsId = ++(tsdPtr->numNsCreated);
    nsPtr->interp = interp;
    nsPtr->flags = 0;
    nsPtr->activationCount = 0;
    nsPtr->refCount = 0;
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);
794
795
796
797
798
799
800
801
802
803
804

805
806

807
808
809
810
811
812
813
849
850
851
852
853
854
855

856
857

858


859
860
861
862
863
864
865
866







-


-
+
-
-
+







    nsPtr->compiledVarResProc = NULL;
    nsPtr->exportLookupEpoch = 0;
    nsPtr->ensembles = NULL;
    nsPtr->unknownHandlerPtr = NULL;
    nsPtr->commandPathLength = 0;
    nsPtr->commandPathArray = NULL;
    nsPtr->commandPathSourceList = NULL;
    nsPtr->earlyDeleteProc = NULL;

    if (parentPtr != NULL) {
	entryPtr = Tcl_CreateHashEntry(
	entryPtr = Tcl_CreateHashEntry(&parentPtr->childTable, simpleName,
		TclGetNamespaceChildTable((Tcl_Namespace *) parentPtr),
		simpleName, &newEntry);
		&newEntry);
	Tcl_SetHashValue(entryPtr, nsPtr);
    } else {
	/*
	 * In the global namespace create traces to maintain the ::errorInfo
	 * and ::errorCode variables.
	 */

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
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







-
+

-
+

-
+
+







-
+














-
-
+
+





-
-
-
-
-
-
-
-
-
-







    Tcl_DStringInit(&buffer1);
    Tcl_DStringInit(&buffer2);
    namePtr = &buffer1;
    buffPtr = &buffer2;
    for (ancestorPtr = nsPtr; ancestorPtr != NULL;
	    ancestorPtr = ancestorPtr->parentPtr) {
	if (ancestorPtr != globalNsPtr) {
	    Tcl_DString *tempPtr = namePtr;
	    register Tcl_DString *tempPtr = namePtr;

	    TclDStringAppendLiteral(buffPtr, "::");
	    Tcl_DStringAppend(buffPtr, "::", 2);
	    Tcl_DStringAppend(buffPtr, ancestorPtr->name, -1);
	    TclDStringAppendDString(buffPtr, namePtr);
	    Tcl_DStringAppend(buffPtr, Tcl_DStringValue(namePtr),
		    Tcl_DStringLength(namePtr));

	    /*
	     * Clear the unwanted buffer or we end up appending to previous
	     * results, making the namespace fullNames of nested namespaces
	     * very wrong (and strange).
	     */

	    TclDStringClear(namePtr);
	    Tcl_DStringSetLength(namePtr, 0);

	    /*
	     * Now swap the buffer pointers so that we build in the other
	     * buffer. This is faster than repeated copying back and forth
	     * between buffers.
	     */

	    namePtr = buffPtr;
	    buffPtr = tempPtr;
	}
    }

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = (char *)Tcl_Alloc(nameLen + 1);
    memcpy(nsPtr->fullName, name, nameLen + 1);
    nsPtr->fullName = ckalloc((unsigned) (nameLen+1));
    memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*
     * If compilation of commands originating from the parent NS is
     * suppressed, suppress it for commands originating in this one too.
     */

    if (nsPtr->parentPtr != NULL &&
	    nsPtr->parentPtr->flags & NS_SUPPRESS_COMPILATION) {
	nsPtr->flags |= NS_SUPPRESS_COMPILATION;
    }

    /*
     * Return a pointer to the new namespace.
     */

    return (Tcl_Namespace *) nsPtr;
}

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
941
942
943
944
945
946
947

948
949
950
951
952

















































953
954
955
956
957
958
959







-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *----------------------------------------------------------------------
 */

void
Tcl_DeleteNamespace(
    Tcl_Namespace *namespacePtr)/* Points to the namespace to delete. */
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    register Namespace *nsPtr = (Namespace *) namespacePtr;
    Interp *iPtr = (Interp *) nsPtr->interp;
    Namespace *globalNsPtr = (Namespace *)
	    TclGetGlobalNamespace((Tcl_Interp *) iPtr);
    Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Command *cmdPtr;

    /*
     * Ensure that this namespace doesn't get deallocated in the meantime.
     */
    nsPtr->refCount++;

    /*
     * Give anyone interested - notably TclOO - a chance to use this namespace
     * normally despite the fact that the namespace is going to go. Allows the
     * calling of destructors. Will only be called once (unless re-established
     * by the called function). [Bug 2950259]
     *
     * Note that setting this field requires access to the internal definition
     * of namespaces, so it should only be accessed by code that knows about
     * being careful with reentrancy.
     */

    if (nsPtr->earlyDeleteProc != NULL) {
	Tcl_NamespaceDeleteProc *earlyDeleteProc = nsPtr->earlyDeleteProc;

	nsPtr->earlyDeleteProc = NULL;
	nsPtr->activationCount++;
	earlyDeleteProc(nsPtr->clientData);
	nsPtr->activationCount--;
    }

    /*
     * Delete all coroutine commands now: break the circular ref cycle between
     * the namespace and the coroutine command [Bug 2724403]. This code is
     * essentially duplicated in TclTeardownNamespace() for all other
     * commands. Don't optimize to Tcl_NextHashEntry() because of traces.
     *
     * NOTE: we could avoid traversing the ns's command list by keeping a
     * separate list of coros.
     */

    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;) {
	cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
	if (cmdPtr->nreProc == TclNRInterpCoroutine) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
		    (Tcl_Command) cmdPtr);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	} else {
	    entryPtr = Tcl_NextHashEntry(&search);
	}
    }

    /*
     * If the namespace has associated ensemble commands, delete them first.
     * This leaves the actual contents of the namespace alone (unless they are
     * linked ensemble commands, of course). Note that this code is actually
     * reentrant so command delete traces won't purturb things badly.
     */
998
999
1000
1001
1002
1003
1004
1005

1006
1007
1008

1009
1010

1011
1012
1013
1014
1015
1016
1017
993
994
995
996
997
998
999

1000
1001
1002

1003


1004
1005
1006
1007
1008
1009
1010
1011







-
+


-
+
-
-
+







     * namespace's commands and variables are deleted but the structure isn't
     * freed. Instead, NS_DEAD is OR'd into the structure's flags to allow the
     * namespace resolution code to recognize that the namespace is "deleted".
     * The structure's storage is freed by FreeNsNameInternalRep when its
     * refCount reaches 0.
     */

    if (nsPtr->activationCount > (unsigned)(nsPtr == globalNsPtr)) {
    if (nsPtr->activationCount - (nsPtr == globalNsPtr) > 0) {
	nsPtr->flags |= NS_DYING;
	if (nsPtr->parentPtr != NULL) {
	    entryPtr = Tcl_FindHashEntry(
	    entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
		    TclGetNamespaceChildTable((Tcl_Namespace *)
			    nsPtr->parentPtr), nsPtr->name);
		    nsPtr->name);
	    if (entryPtr != NULL) {
		Tcl_DeleteHashEntry(entryPtr);
	    }
	}
	nsPtr->parentPtr = NULL;
    } else if (!(nsPtr->flags & NS_KILLED)) {
	/*
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
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







-

-
-
-
+
-
-
+
-
-
+
+
+
+

+
+
+
-
+
+
















-







	     * "errorInfo" and "errorCode" variables for errors that occurred
	     * while it was being torn down. Try to clear the variable list
	     * one last time.
	     */

	    TclDeleteNamespaceVars(nsPtr);

#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_DeleteHashTable(&nsPtr->childTable);
#else
	    if (nsPtr->childTablePtr != NULL) {
		Tcl_DeleteHashTable(nsPtr->childTablePtr);
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);
		Tcl_Free(nsPtr->childTablePtr);
	    }

#endif
	    Tcl_DeleteHashTable(&nsPtr->cmdTable);
	    /*
	     * If the reference count is 0, then discard the namespace.
	     * Otherwise, mark it as "dead" so that it can't be used.
	     */

	    if (nsPtr->refCount == 0) {
		NamespaceFree(nsPtr);
	    } else {
	    nsPtr ->flags |= NS_DEAD;
		nsPtr->flags |= NS_DEAD;
	    }
	} else {
	    /*
	     * Restore the ::errorInfo and ::errorCode traces.
	     */

	    EstablishErrorInfoTraces(NULL, nsPtr->interp, NULL, NULL, 0);
	    EstablishErrorCodeTraces(NULL, nsPtr->interp, NULL, NULL, 0);

	    /*
	     * We didn't really kill it, so remove the KILLED marks, so it can
	     * get killed later, avoiding mem leaks.
	     */

	    nsPtr->flags &= ~(NS_DYING|NS_KILLED);
	}
    }
    TclNsDecrRefCount(nsPtr);
}

int
TclNamespaceDeleted(
    Namespace *nsPtr)
{
    return (nsPtr->flags & NS_DYING) ? 1 : 0;
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
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
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
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







-
+



-
+

+
+
-
+













-
-
-
-
+
+
+


-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
-
-
-
-









-
+
-
-
+
















-















-
-
+
-
-

-
+


-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
+
-
-
+
-
-
+
-
-
-






-
+

-
+










-
+







 *	Deletes all commands, variables and namespaces in this namespace.
 *
 *----------------------------------------------------------------------
 */

void
TclTeardownNamespace(
    Namespace *nsPtr)	/* Points to the namespace to be dismantled
    register Namespace *nsPtr)	/* Points to the namespace to be dismantled
				 * and unlinked from its parent. */
{
    Interp *iPtr = (Interp *) nsPtr->interp;
    Tcl_HashEntry *entryPtr;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_Namespace *childNsPtr;
    Tcl_Command cmd;
    size_t i;
    int i;

    /*
     * Start by destroying the namespace's variable table, since variables
     * might trigger traces. Variable table should be cleared but not freed!
     * TclDeleteNamespaceVars frees it, so we reinitialize it afterwards.
     */

    TclDeleteNamespaceVars(nsPtr);
    TclInitVarHashTable(&nsPtr->varTable, nsPtr);

    /*
     * Delete all commands in this namespace. Be careful when traversing the
     * hash table: when each command is deleted, it removes itself from the
     * command table. Because of traces (and the desire to avoid the quadratic
     * problems of just using Tcl_FirstHashEntry over and over, [Bug
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * commands.
     * command table.
     *
     * Don't optimize to Tcl_NextHashEntry() because of traces.
     */

    while (nsPtr->cmdTable.numEntries > 0) {
	size_t length = nsPtr->cmdTable.numEntries;
	Command **cmds = (Command **)TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Command *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    cmds[i] = (Command *)Tcl_GetHashValue(entryPtr);
    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
	    entryPtr != NULL;
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
	cmd = Tcl_GetHashValue(entryPtr);
	    cmds[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr,
	Tcl_DeleteCommandFromToken((Tcl_Interp *) iPtr, cmd);
		    (Tcl_Command) cmds[i]);
	    TclCleanupCommandMacro(cmds[i]);
	}
	TclStackFree((Tcl_Interp *) iPtr, cmds);
    }
    Tcl_DeleteHashTable(&nsPtr->cmdTable);
    Tcl_InitHashTable(&nsPtr->cmdTable, TCL_STRING_KEYS);

    /*
     * Remove the namespace from its parent's child hashtable.
     */

    if (nsPtr->parentPtr != NULL) {
	entryPtr = Tcl_FindHashEntry(
	entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
		TclGetNamespaceChildTable((Tcl_Namespace *)
			nsPtr->parentPtr), nsPtr->name);
		nsPtr->name);
	if (entryPtr != NULL) {
	    Tcl_DeleteHashEntry(entryPtr);
	}
    }
    nsPtr->parentPtr = NULL;

    /*
     * Delete the namespace path if one is installed.
     */

    if (nsPtr->commandPathLength != 0) {
	UnlinkNsPath(nsPtr);
	nsPtr->commandPathLength = 0;
    }
    if (nsPtr->commandPathSourceList != NULL) {
	NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;

	do {
	    if (nsPathPtr->nsPtr != NULL && nsPathPtr->creatorNsPtr != NULL) {
		nsPathPtr->creatorNsPtr->cmdRefEpoch++;
	    }
	    nsPathPtr->nsPtr = NULL;
	    nsPathPtr = nsPathPtr->nextPtr;
	} while (nsPathPtr != NULL);
	nsPtr->commandPathSourceList = NULL;
    }

    /*
     * Delete all the child namespaces.
     *
     * BE CAREFUL: When each child is deleted, it will divorce itself from its
     * parent. You can't traverse a hash table properly if its elements are
     * being deleted.  Because of traces (and the desire to avoid the
     * quadratic problems of just using Tcl_FirstHashEntry over and over, [Bug
     * being deleted. We use only the Tcl_FirstHashEntry function to be safe.
     * f97d4ee020]) we copy to a temporary array and then delete all those
     * namespaces.
     *
     * Important: leave the hash table itself still live.
     * Don't optimize to Tcl_NextHashEntry() because of traces.
     */

#ifndef BREAK_NAMESPACE_COMPAT
    while (nsPtr->childTable.numEntries > 0) {
	size_t length = nsPtr->childTable.numEntries;
	Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
		sizeof(Namespace *) * length);

	i = 0;
	for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
		entryPtr != NULL;
    for (entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
	    entryPtr != NULL;
		entryPtr = Tcl_NextHashEntry(&search)) {
	    children[i] = (Namespace *)Tcl_GetHashValue(entryPtr);
	    children[i]->refCount++;
	    i++;
	}
	for (i = 0 ; i < length ; i++) {
	    Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
	    TclNsDecrRefCount(children[i]);
	}
	TclStackFree((Tcl_Interp *) iPtr, children);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	while (nsPtr->childTablePtr->numEntries > 0) {
	    size_t length = nsPtr->childTablePtr->numEntries;
	    Namespace **children = (Namespace **)TclStackAlloc((Tcl_Interp *) iPtr,
		    sizeof(Namespace *) * length);

	    i = 0;
	    for (entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
	    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
		    entryPtr != NULL;
		    entryPtr = Tcl_NextHashEntry(&search)) {
		children[i] = Tcl_GetHashValue(entryPtr);
	childNsPtr = Tcl_GetHashValue(entryPtr);
		children[i]->refCount++;
		i++;
	    }
	    for (i = 0 ; i < length ; i++) {
		Tcl_DeleteNamespace((Tcl_Namespace *) children[i]);
	Tcl_DeleteNamespace(childNsPtr);
		TclNsDecrRefCount(children[i]);
	    }
    }
	    TclStackFree((Tcl_Interp *) iPtr, children);
	}

    }
#endif

    /*
     * Free the namespace's export pattern array.
     */

    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    Tcl_Free(nsPtr->exportArrayPtr[i]);
	    ckfree(nsPtr->exportArrayPtr[i]);
	}
	Tcl_Free(nsPtr->exportArrayPtr);
	ckfree((char *) nsPtr->exportArrayPtr);
	nsPtr->exportArrayPtr = NULL;
	nsPtr->numExportPatterns = 0;
	nsPtr->maxExportPatterns = 0;
    }

    /*
     * Free any client data associated with the namespace.
     */

    if (nsPtr->deleteProc != NULL) {
	nsPtr->deleteProc(nsPtr->clientData);
	(*nsPtr->deleteProc)(nsPtr->clientData);
    }
    nsPtr->deleteProc = NULL;
    nsPtr->clientData = NULL;

    /*
     * Reset the namespace's id field to ensure that this namespace won't be
     * interpreted as valid by, e.g., the cache validation code for cached
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
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







-
+







-
-
-
+
+
+
+







-
-
+
+


-
+


-
+








+
-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
NamespaceFree(
    Namespace *nsPtr)	/* Points to the namespace to free. */
    register Namespace *nsPtr)	/* Points to the namespace to free. */
{
    /*
     * Most of the namespace's contents are freed when the namespace is
     * deleted by Tcl_DeleteNamespace. All that remains is to free its names
     * (for error messages), and the structure itself.
     */

    Tcl_Free(nsPtr->name);
    Tcl_Free(nsPtr->fullName);
    Tcl_Free(nsPtr);
    ckfree(nsPtr->name);
    ckfree(nsPtr->fullName);

    ckfree((char *) nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNsDecrRefCount --
 *
 *	Drops a reference to a namespace and frees it if the namespace has
 *	been deleted and the last reference has just been dropped.
 *      Drops a reference to a namespace and frees it if the namespace has
 *      been deleted and the last reference has just been dropped.
 *
 * Results:
 *	None.
 *      None.
 *
 * Side effects:
 *	None.
 *      None.
 *
 *----------------------------------------------------------------------
 */

void
TclNsDecrRefCount(
    Namespace *nsPtr)
{
    nsPtr->refCount--;
    if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
	NamespaceFree(nsPtr);
    if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
        NamespaceFree(nsPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Export --
1365
1366
1367
1368
1369
1370
1371
1372

1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392

1393
1394

1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411


1412
1413
1414
1415
1416
1417
1418
1419
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
1348
1349
1350
1351


1352
1353

1354
1355
1356
1357
1358
1359
1360







-
+



















-
+

-
+















-
-
+
+
-







				 * list before appending. */
{
#define INIT_EXPORT_PATTERNS 5
    Namespace *nsPtr, *exportNsPtr, *dummyPtr;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    const char *simplePattern;
    char *patternCpy;
    size_t neededElems, len, i;
    int neededElems, len, i;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) currNsPtr;
    } else {
	nsPtr = (Namespace *) namespacePtr;
    }

    /*
     * If resetListFirst is true (nonzero), clear the namespace's export
     * pattern list.
     */

    if (resetListFirst) {
	if (nsPtr->exportArrayPtr != NULL) {
	    for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
		Tcl_Free(nsPtr->exportArrayPtr[i]);
		ckfree(nsPtr->exportArrayPtr[i]);
	    }
	    Tcl_Free(nsPtr->exportArrayPtr);
	    ckfree((char *) nsPtr->exportArrayPtr);
	    nsPtr->exportArrayPtr = NULL;
	    TclInvalidateNsCmdLookup(nsPtr);
	    nsPtr->numExportPatterns = 0;
	    nsPtr->maxExportPatterns = 0;
	}
    }

    /*
     * Check that the pattern doesn't have namespace qualifiers.
     */

    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
	    &exportNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
                " \"%s\": pattern can't specify a namespace", pattern));
	Tcl_AppendResult(interp, "invalid export pattern \"", pattern,
		"\": pattern can't specify a namespace", NULL);
	Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", NULL);
	return TCL_ERROR;
    }

    /*
     * Make sure that we don't already have the pattern in the array
     */

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
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







-
+
+








-
-
+
+







     * pattern.
     */

    neededElems = nsPtr->numExportPatterns + 1;
    if (neededElems > nsPtr->maxExportPatterns) {
	nsPtr->maxExportPatterns = nsPtr->maxExportPatterns ?
		2 * nsPtr->maxExportPatterns : INIT_EXPORT_PATTERNS;
	nsPtr->exportArrayPtr = (char **)Tcl_Realloc(nsPtr->exportArrayPtr,
	nsPtr->exportArrayPtr = (char **)
		ckrealloc((char *) nsPtr->exportArrayPtr,
		sizeof(char *) * nsPtr->maxExportPatterns);
    }

    /*
     * Add the pattern to the namespace's array of export patterns.
     */

    len = strlen(pattern);
    patternCpy = (char *)Tcl_Alloc(len + 1);
    memcpy(patternCpy, pattern, len + 1);
    patternCpy = ckalloc((unsigned) (len + 1));
    memcpy(patternCpy, pattern, (unsigned) len + 1);

    nsPtr->exportArrayPtr[nsPtr->numExportPatterns] = patternCpy;
    nsPtr->numExportPatterns++;

    /*
     * The list of commands actually exported from the namespace might have
     * changed (probably will have!) However, we do not need to recompute this
1492
1493
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504
1505
1506
1507
1434
1435
1436
1437
1438
1439
1440


1441
1442
1443
1444
1445
1446
1447
1448







-
-
+







    Tcl_Namespace *namespacePtr,/* Points to the namespace whose export
				 * pattern list is appended onto objPtr. NULL
				 * for the current namespace. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * export pattern list is appended. */
{
    Namespace *nsPtr;
    size_t i;
    int result;
    int i, result;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
1562
1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576
1503
1504
1505
1506
1507
1508
1509

1510
1511
1512
1513
1514
1515
1516
1517







-
+







    int allowOverwrite)		/* If nonzero, allow existing commands to be
				 * overwritten by imported commands. If 0,
				 * return an error if an imported cmd
				 * conflicts with an existing one. */
{
    Namespace *nsPtr, *importNsPtr, *dummyPtr;
    const char *simplePattern;
    Tcl_HashEntry *hPtr;
    register Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
1610
1611
1612
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
1641
1642
1643
1644
1645
1646
1647
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







-
+
-






-
-
+
+





-
-
+
+
-
-
+

-
-
-
+
+
+
-








    /*
     * From the pattern, find the namespace from which we are importing and
     * get the simple pattern (no namespace qualifiers or ::'s) at the end.
     */

    if (strlen(pattern) == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern", -1));
	Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", NULL);
	return TCL_ERROR;
    }
    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
	    &importNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if (importNsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown namespace in import pattern \"%s\"", pattern));
	Tcl_AppendResult(interp, "unknown namespace in import pattern \"",
		pattern, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
	return TCL_ERROR;
    }
    if (importNsPtr == nsPtr) {
	if (pattern == simplePattern) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "no namespace specified in import pattern \"%s\"",
	    Tcl_AppendResult(interp,
		    "no namespace specified in import pattern \"", pattern,
                    pattern));
	    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", NULL);
		    "\"", NULL);
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "import pattern \"%s\" tries to import from namespace"
                    " \"%s\" into itself", pattern, importNsPtr->name));
	    Tcl_AppendResult(interp, "import pattern \"", pattern,
		    "\" tries to import from namespace \"",
		    importNsPtr->name, "\" into itself", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Scan through the command table in the source namespace and look for
     * exported commands that match the string pattern. Create an "imported
1655
1656
1657
1658
1659
1660
1661
1662

1663
1664
1665
1666
1667
1668
1669
1670
1593
1594
1595
1596
1597
1598
1599

1600

1601
1602
1603
1604
1605
1606
1607







-
+
-







	    return TCL_OK;
	}
	return DoImport(interp, nsPtr, hPtr, simplePattern, pattern,
		importNsPtr, allowOverwrite);
    }
    for (hPtr = Tcl_FirstHashEntry(&importNsPtr->cmdTable, &search);
	    (hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
	char *cmdName = (char *)Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);
	char *cmdName = Tcl_GetHashKey(&importNsPtr->cmdTable, hPtr);

	if (Tcl_StringMatch(cmdName, simplePattern) &&
		DoImport(interp, nsPtr, hPtr, cmdName, pattern, importNsPtr,
		allowOverwrite) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
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
1632
1633
1634
1635
1636
1637
1638

1639
1640
1641
1642
1643
1644
1645
1646
1647

1648

1649
1650
1651
1652
1653
1654
1655







-
+








-
+
-







    Namespace *nsPtr,
    Tcl_HashEntry *hPtr,
    const char *cmdName,
    const char *pattern,
    Namespace *importNsPtr,
    int allowOverwrite)
{
    size_t i = 0, exported = 0;
    int i = 0, exported = 0;
    Tcl_HashEntry *found;

    /*
     * The command cmdName in the source namespace matches the pattern. Check
     * whether it was exported. If it wasn't, we ignore it.
     */

    while (!exported && (i < importNsPtr->numExportPatterns)) {
	exported |= Tcl_StringMatch(cmdName,
	exported |= Tcl_StringMatch(cmdName, importNsPtr->exportArrayPtr[i++]);
		importNsPtr->exportArrayPtr[i++]);
    }
    if (!exported) {
	return TCL_OK;
    }

    /*
     * Unless there is a name clash, create an imported command in the current
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

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
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







-
+








-
+

-
-
+
+

-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+

-





-
-
+
+
-
-
+

-
-









-
+




-
+


-
+









-
-
+
+
-







	ImportedCmdData *dataPtr;
	Command *cmdPtr;
	ImportRef *refPtr;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	if (nsPtr != ((Interp *) interp)->globalNsPtr) {
	    TclDStringAppendLiteral(&ds, "::");
	    Tcl_DStringAppend(&ds, "::", 2);
	}
	Tcl_DStringAppend(&ds, cmdName, -1);

	/*
	 * Check whether creating the new imported command in the current
	 * namespace would create a cycle of imported command references.
	 */

	cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
	cmdPtr = Tcl_GetHashValue(hPtr);
	if (found != NULL && cmdPtr->deleteProc == DeleteImportedCmd) {
	    Command *overwrite = (Command *)Tcl_GetHashValue(found);
	    Command *linkCmd = cmdPtr;
	    Command *overwrite = Tcl_GetHashValue(found);
	    Command *link = cmdPtr;

	    while (linkCmd->deleteProc == DeleteImportedCmd) {
		dataPtr = (ImportedCmdData *)linkCmd->objClientData;
		linkCmd = dataPtr->realCmdPtr;
		if (overwrite == linkCmd) {
	    while (link->deleteProc == DeleteImportedCmd) {
		ImportedCmdData *dataPtr = link->objClientData;

		link = dataPtr->realCmdPtr;
		if (overwrite == link) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "import pattern \"%s\" would create a loop"
                            " containing command \"%s\"",
                            pattern, Tcl_DStringValue(&ds)));
		    Tcl_AppendResult(interp, "import pattern \"", pattern,
			    "\" would create a loop containing command \"",
			    Tcl_DStringValue(&ds), "\"", NULL);
		    Tcl_DStringFree(&ds);
		    Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", NULL);
		    return TCL_ERROR;
		}
	    }
	}

	dataPtr = (ImportedCmdData *)Tcl_Alloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
	dataPtr = (ImportedCmdData *) ckalloc(sizeof(ImportedCmdData));
	importedCmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
		TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
		DeleteImportedCmd);
		InvokeImportedCmd, dataPtr, DeleteImportedCmd);
	dataPtr->realCmdPtr = cmdPtr;
	/* corresponding decrement is in DeleteImportedCmd */
	cmdPtr->refCount++;
	dataPtr->selfPtr = (Command *) importedCmd;
	dataPtr->selfPtr->compileProc = cmdPtr->compileProc;
	Tcl_DStringFree(&ds);

	/*
	 * Create an ImportRef structure describing this new import command
	 * and add it to the import ref list in the "real" command.
	 */

	refPtr = (ImportRef *)Tcl_Alloc(sizeof(ImportRef));
	refPtr = (ImportRef *) ckalloc(sizeof(ImportRef));
	refPtr->importedCmdPtr = (Command *) importedCmd;
	refPtr->nextPtr = cmdPtr->importRefPtr;
	cmdPtr->importRefPtr = refPtr;
    } else {
	Command *overwrite = (Command *)Tcl_GetHashValue(found);
	Command *overwrite = Tcl_GetHashValue(found);

	if (overwrite->deleteProc == DeleteImportedCmd) {
	    ImportedCmdData *dataPtr = (ImportedCmdData *)overwrite->objClientData;
	    ImportedCmdData *dataPtr = overwrite->objClientData;

	    if (dataPtr->realCmdPtr == Tcl_GetHashValue(hPtr)) {
		/*
		 * Repeated import of same command is acceptable.
		 */

		return TCL_OK;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "can't import command \"%s\": already exists", cmdName));
	Tcl_AppendResult(interp, "can't import command \"", cmdName,
		"\": already exists", NULL);
	Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
1843
1844
1845
1846
1847
1848
1849
1850

1851
1852
1853
1854
1855
1856
1857
1774
1775
1776
1777
1778
1779
1780

1781
1782
1783
1784
1785
1786
1787
1788







-
+







				 * removed. NULL for current namespace. */
    const char *pattern)	/* String pattern indicating which imported
				 * commands to remove. */
{
    Namespace *nsPtr, *sourceNsPtr, *dummyPtr;
    const char *simplePattern;
    char *cmdName;
    Tcl_HashEntry *hPtr;
    register Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    /*
     * If the specified namespace is NULL, use the current namespace.
     */

    if (namespacePtr == NULL) {
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
1796
1797
1798
1799
1800
1801
1802



1803
1804
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







-
-
-
+
+
+










+
+

-
-
+
+
-
-
-
+
+
-





-
+




-
+














-
+












-
+











-
+







     * simple pattern.
     */

    TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
	    &sourceNsPtr, &dummyPtr, &dummyPtr, &simplePattern);

    if (sourceNsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown namespace in namespace forget pattern \"%s\"",
		pattern));
	Tcl_AppendResult(interp,
		"unknown namespace in namespace forget pattern \"",
		pattern, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, NULL);
	return TCL_ERROR;
    }

    if (strcmp(pattern, simplePattern) == 0) {
	/*
	 * The pattern is simple. Delete any imported commands that match it.
	 */

	if (TclMatchIsTrivial(simplePattern)) {
	    Command *cmdPtr;

	    hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simplePattern);
	    if (hPtr != NULL) {
		Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
	    if ((hPtr != NULL)
		    && (cmdPtr = Tcl_GetHashValue(hPtr))

		if (cmdPtr && (cmdPtr->deleteProc == DeleteImportedCmd)) {
		    Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
		    && (cmdPtr->deleteProc == DeleteImportedCmd)) {
		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
		}
	    }
	    return TCL_OK;
	}
	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		(hPtr != NULL); hPtr = Tcl_NextHashEntry(&search)) {
	    Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
	    Command *cmdPtr = Tcl_GetHashValue(hPtr);

	    if (cmdPtr->deleteProc != DeleteImportedCmd) {
		continue;
	    }
	    cmdName = (char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
	    cmdName = Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);
	    if (Tcl_StringMatch(cmdName, simplePattern)) {
		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
	    }
	}
	return TCL_OK;
    }

    /*
     * The pattern was namespace-qualified.
     */

    for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search); (hPtr != NULL);
	    hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_CmdInfo info;
	Tcl_Command token = (Tcl_Command)Tcl_GetHashValue(hPtr);
	Tcl_Command token = Tcl_GetHashValue(hPtr);
	Tcl_Command origin = TclGetOriginalCommand(token);

	if (Tcl_GetCommandInfoFromToken(origin, &info) == 0) {
	    continue;			/* Not an imported command. */
	}
	if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
	    /*
	     * Original not in namespace we're matching. Check the first link
	     * in the import chain.
	     */

	    Command *cmdPtr = (Command *) token;
	    ImportedCmdData *dataPtr = (ImportedCmdData *)cmdPtr->objClientData;
	    ImportedCmdData *dataPtr = cmdPtr->objClientData;
	    Tcl_Command firstToken = (Tcl_Command) dataPtr->realCmdPtr;

	    if (firstToken == origin) {
		continue;
	    }
	    Tcl_GetCommandInfoFromToken(firstToken, &info);
	    if (info.namespacePtr != (Tcl_Namespace *) sourceNsPtr) {
		continue;
	    }
	    origin = firstToken;
	}
	if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)){
	if (Tcl_StringMatch(Tcl_GetCommandName(NULL, origin), simplePattern)) {
	    Tcl_DeleteCommandFromToken(interp, token);
	}
    }
    return TCL_OK;
}

/*
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
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







-
+







-
+








-
+
















-
+






-
-
+
+

-
-
-
-
+
-
-
-
-
-
-
-
-
-







 */

Tcl_Command
TclGetOriginalCommand(
    Tcl_Command command)	/* The imported command for which the original
				 * command should be returned. */
{
    Command *cmdPtr = (Command *) command;
    register Command *cmdPtr = (Command *) command;
    ImportedCmdData *dataPtr;

    if (cmdPtr->deleteProc != DeleteImportedCmd) {
	return NULL;
    }

    while (cmdPtr->deleteProc == DeleteImportedCmd) {
	dataPtr = (ImportedCmdData *)cmdPtr->objClientData;
	dataPtr = cmdPtr->objClientData;
	cmdPtr = dataPtr->realCmdPtr;
    }
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvokeImportedCmd --
 * InvokeImportedCmd --
 *
 *	Invoked by Tcl whenever the user calls an imported command that was
 *	created by Tcl_Import. Finds the "real" command (in another
 *	namespace), and passes control to it.
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	Returns a result in the interpreter's result object. If anything goes
 *	wrong, the result object is set to an error message.
 *
 *----------------------------------------------------------------------
 */

static int
InvokeImportedNRCmd(
InvokeImportedCmd(
    ClientData clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;
    register ImportedCmdData *dataPtr = clientData;
    register Command *realCmdPtr = dataPtr->realCmdPtr;

    TclSkipTailcall(interp);
    return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}

    return (*realCmdPtr->objProc)(realCmdPtr->objClientData, interp,
int
TclInvokeImportedCmd(
    ClientData clientData,	/* Points to the imported command's
				 * ImportedCmdData structure. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return Tcl_NRCallObjProc(interp, InvokeImportedNRCmd, clientData,
	    objc, objv);
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteImportedCmd --
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
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







-
+


-
+















-
+
-
-
+







 */

static void
DeleteImportedCmd(
    ClientData clientData)	/* Points to the imported command's
				 * ImportedCmdData structure. */
{
    ImportedCmdData *dataPtr = (ImportedCmdData *)clientData;
    ImportedCmdData *dataPtr = clientData;
    Command *realCmdPtr = dataPtr->realCmdPtr;
    Command *selfPtr = dataPtr->selfPtr;
    ImportRef *refPtr, *prevPtr;
    register ImportRef *refPtr, *prevPtr;

    prevPtr = NULL;
    for (refPtr = realCmdPtr->importRefPtr; refPtr != NULL;
	    refPtr = refPtr->nextPtr) {
	if (refPtr->importedCmdPtr == selfPtr) {
	    /*
	     * Remove *refPtr from real command's list of imported commands
	     * that refer to it.
	     */

	    if (prevPtr == NULL) { /* refPtr is first in list. */
		realCmdPtr->importRefPtr = refPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = refPtr->nextPtr;
	    }
	    Tcl_Free(refPtr);
	    ckfree((char *) refPtr);
	    TclCleanupCommandMacro(realCmdPtr);
	    Tcl_Free(dataPtr);
	    ckfree((char *) dataPtr);
	    return;
	}
	prevPtr = refPtr;
    }

    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
}
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
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







-
+












-

-
-
-
-
-
-
-

-
+






-
-
+
+
















-

-
-
-
-
-
-
-

-
+







	     * start points to the beginning of a namespace qualifier ending
	     * in "::". end points to the start of a name in that namespace
	     * that might be empty. Copy the namespace qualifier to a buffer
	     * so it can be null terminated. We can't modify the incoming
	     * qualName since it may be a string constant.
	     */

	    TclDStringClear(&buffer);
	    Tcl_DStringSetLength(&buffer, 0);
	    Tcl_DStringAppend(&buffer, start, len);
	    nsName = Tcl_DStringValue(&buffer);
	}

	/*
	 * Look up the namespace qualifier nsName in the current namespace
	 * context. If it isn't found but TCL_CREATE_NS_IF_UNKNOWN is set,
	 * create that qualifying namespace. This is needed for functions like
	 * Tcl_CreateCommand that cannot fail.
	 */

	if (nsPtr != NULL) {
#ifndef BREAK_NAMESPACE_COMPAT
	    entryPtr = Tcl_FindHashEntry(&nsPtr->childTable, nsName);
#else
	    if (nsPtr->childTablePtr == NULL) {
		entryPtr = NULL;
	    } else {
		entryPtr = Tcl_FindHashEntry(nsPtr->childTablePtr, nsName);
	    }
#endif
	    if (entryPtr != NULL) {
		nsPtr = (Namespace *)Tcl_GetHashValue(entryPtr);
		nsPtr = Tcl_GetHashValue(entryPtr);
	    } else if (flags & TCL_CREATE_NS_IF_UNKNOWN) {
		Tcl_CallFrame *framePtr;

		(void) TclPushStackFrame(interp, &framePtr,
			(Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 0);

		nsPtr = (Namespace *)
			Tcl_CreateNamespace(interp, nsName, NULL, NULL);
		nsPtr = (Namespace *) Tcl_CreateNamespace(interp, nsName,
			NULL, NULL);
		TclPopStackFrame(interp);

		if (nsPtr == NULL) {
		    Tcl_Panic("Could not create namespace '%s'", nsName);
		}
	    } else {			/* Namespace not found and was not
					 * created. */
		nsPtr = NULL;
	    }
	}

	/*
	 * Look up the namespace qualifier in the alternate search path too.
	 */

	if (altNsPtr != NULL) {
#ifndef BREAK_NAMESPACE_COMPAT
	    entryPtr = Tcl_FindHashEntry(&altNsPtr->childTable, nsName);
#else
	    if (altNsPtr->childTablePtr != NULL) {
		entryPtr = Tcl_FindHashEntry(altNsPtr->childTablePtr, nsName);
	    } else {
		entryPtr = NULL;
	    }
#endif
	    if (entryPtr != NULL) {
		altNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr);
		altNsPtr = Tcl_GetHashValue(entryPtr);
	    } else {
		altNsPtr = NULL;
	    }
	}

	/*
	 * If both search paths have failed, return NULL results.
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
2324
2325
2326
2327
2328
2329
2330





























2331
2332
2333
2334
2335
2336
2337







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    Tcl_DStringFree(&buffer);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclEnsureNamespace --
 *
 *	Provide a namespace that is not deleted.
 *
 * Value
 *
 *	namespacePtr, if it is not scheduled for deletion, or a pointer to a
 *	new namespace with the same name otherwise.
 *
 * Effect
 *	None.
 *
 *----------------------------------------------------------------------
 */
Tcl_Namespace *
TclEnsureNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    if (!(nsPtr->flags & NS_DYING)) {
	    return namespacePtr;
    }
    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindNamespace --
 *
 *	Searches for a namespace.
 *
 * Results:
 *	Returns a pointer to the namespace if it is found. Otherwise, returns
 *	NULL and leaves an error message in the interpreter's result object if
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
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







-
+

















-
-
-
-
-
+
+
+







				 * (current namespace if contextNsPtr is
				 * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag is set or
				 * if the name starts with "::". Otherwise,
				 * points to namespace in which to resolve
				 * name; if NULL, look up name in the current
				 * namespace. */
    int flags)		/* Flags controlling namespace lookup: an OR'd
    register int flags)		/* Flags controlling namespace lookup: an OR'd
				 * combination of TCL_GLOBAL_ONLY and
				 * TCL_LEAVE_ERR_MSG flags. */
{
    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
    const char *dummy;

    /*
     * Find the namespace(s) that contain the specified namespace name. Add
     * the TCL_FIND_ONLY_NS flag to resolve the name all the way down to its
     * last component, a namespace.
     */

    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
	    flags|TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

    if (nsPtr != NULL) {
	return (Tcl_Namespace *) nsPtr;
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown namespace \"%s\"", name));
    } else if (flags & TCL_LEAVE_ERR_MSG) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "unknown namespace \"", name, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
2551
2552
2553
2554
2555
2556
2557
2558
2559


2560
2561
2562
2563
2564
2565
2566
2422
2423
2424
2425
2426
2427
2428


2429
2430
2431
2432
2433
2434
2435
2436
2437







-
-
+
+







				 * namespace if contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Interp *iPtr = (Interp *) interp;
    Namespace *cxtNsPtr;
    Tcl_HashEntry *entryPtr;
    Command *cmdPtr;
    register Tcl_HashEntry *entryPtr;
    register Command *cmdPtr;
    const char *simpleName;
    int result;

    /*
     * If this namespace has a command resolver, then give it first crack at
     * the command resolution. If the interpreter has any command resolvers,
     * consult them next. The command resolver functions may return a
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
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
2658
2659
2660
2661
2662
2663
2664

2665
2666
2667
2668
2669
2670

2671
2672

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
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







-
+







-
+






-

-












-
+










-
+




















-
+

















-
+





-
+

-
+













-
+






-




-
-
+
+







    }

    if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) {
	ResolverScheme *resPtr = iPtr->resolverPtr;
	Tcl_Command cmd;

	if (cxtNsPtr->cmdResProc) {
	    result = cxtNsPtr->cmdResProc(interp, name,
	    result = (*cxtNsPtr->cmdResProc)(interp, name,
		    (Tcl_Namespace *) cxtNsPtr, flags, &cmd);
	} else {
	    result = TCL_CONTINUE;
	}

	while (result == TCL_CONTINUE && resPtr) {
	    if (resPtr->cmdResProc) {
		result = resPtr->cmdResProc(interp, name,
		result = (*resPtr->cmdResProc)(interp, name,
			(Tcl_Namespace *) cxtNsPtr, flags, &cmd);
	    }
	    resPtr = resPtr->nextPtr;
	}

	if (result == TCL_OK) {
	    ((Command *)cmd)->flags |= CMD_VIA_RESOLVER;
	    return cmd;

	} else if (result != TCL_CONTINUE) {
	    return NULL;
	}
    }

    /*
     * Find the namespace(s) that contain the command.
     */

    cmdPtr = NULL;
    if (cxtNsPtr->commandPathLength!=0 && strncmp(name, "::", 2)
	    && !(flags & TCL_NAMESPACE_ONLY)) {
	size_t i;
	int i;
	Namespace *pathNsPtr, *realNsPtr, *dummyNsPtr;

	(void) TclGetNamespaceForQualName(interp, name, cxtNsPtr,
		TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		&simpleName);
	if ((realNsPtr != NULL) && (simpleName != NULL)) {
	    if ((cxtNsPtr == realNsPtr)
		    || !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * Next, check along the path.
	 */

	for (i=0 ; i<cxtNsPtr->commandPathLength && cmdPtr==NULL ; i++) {
	    pathNsPtr = cxtNsPtr->commandPathArray[i].nsPtr;
	    if (pathNsPtr == NULL) {
		continue;
	    }
	    (void) TclGetNamespaceForQualName(interp, name, pathNsPtr,
		    TCL_NAMESPACE_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}

	/*
	 * If we've still not found the command, look in the global namespace
	 * as a last resort.
	 */

	if (cmdPtr == NULL) {
	    (void) TclGetNamespaceForQualName(interp, name, NULL,
		    TCL_GLOBAL_ONLY, &realNsPtr, &dummyNsPtr, &dummyNsPtr,
		    &simpleName);
	    if ((realNsPtr != NULL) && (simpleName != NULL)
		    && !(realNsPtr->flags & NS_DYING)) {
		entryPtr = Tcl_FindHashEntry(&realNsPtr->cmdTable, simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    } else {
	Namespace *nsPtr[2];
	int search;
	register int search;

	TclGetNamespaceForQualName(interp, name, cxtNsPtr,
	TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
		flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);

	/*
	 * Look for the command in the command table of its namespace. Be sure
	 * to check both possible search paths: from the specified namespace
	 * context and from the global namespace.
	 */

	for (search = 0;  (search < 2) && (cmdPtr == NULL);  search++) {
	    if ((nsPtr[search] != NULL) && (simpleName != NULL)) {
		entryPtr = Tcl_FindHashEntry(&nsPtr[search]->cmdTable,
			simpleName);
		if (entryPtr != NULL) {
		    cmdPtr = (Command *)Tcl_GetHashValue(entryPtr);
		    cmdPtr = Tcl_GetHashValue(entryPtr);
		}
	    }
	}
    }

    if (cmdPtr != NULL) {
	cmdPtr->flags  &= ~CMD_VIA_RESOLVER;
	return (Tcl_Command) cmdPtr;
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "unknown command \"%s\"", name));
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "unknown command \"", name, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, NULL);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
2737
2738
2739
2740
2741
2742
2743
2744

2745
2746
2747
2748
2749
2750
2751


2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770

2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799

2800
2801
2802
2803
2804
2805
2806
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
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

2658
2659
2660
2661
2662
2663
2664
2665







-
+





-
-
+
+


















-
+
















-


-
-
-
-
-
-
-
-

-
+







void
TclResetShadowedCmdRefs(
    Tcl_Interp *interp,		/* Interpreter containing the new command. */
    Command *newCmdPtr)		/* Points to the new command. */
{
    char *cmdName;
    Tcl_HashEntry *hPtr;
    Namespace *nsPtr;
    register Namespace *nsPtr;
    Namespace *trailNsPtr, *shadowNsPtr;
    Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    int found, i;
    int trailFront = -1;
    int trailSize = 5;		/* Formerly NUM_TRAIL_ELEMS. */
    Namespace **trailPtr = (Namespace **)TclStackAlloc(interp,
	    trailSize * sizeof(Namespace *));
    Namespace **trailPtr = (Namespace **)
	    TclStackAlloc(interp, trailSize * sizeof(Namespace *));

    /*
     * Start at the namespace containing the new command, and work up through
     * the list of parents. Stop just before the global namespace, since the
     * global namespace can't "shadow" its own entries.
     *
     * The namespace "trail" list we build consists of the names of each
     * namespace that encloses the new command, in order from outermost to
     * innermost: for example, "a" then "b". Each iteration of this loop
     * eventually extends the trail upwards by one namespace, nsPtr. We use
     * this trail list to see if nsPtr (e.g. "a" in 2. above) could have
     * now-invalid cached command references. This will happen if nsPtr
     * (e.g. "a") contains a sequence of child namespaces (e.g. "b") such that
     * there is a identically-named sequence of child namespaces starting from
     * :: (e.g. "::b") whose tail namespace contains a command also named
     * cmdName.
     */

    cmdName = (char *)Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
    cmdName = Tcl_GetHashKey(newCmdPtr->hPtr->tablePtr, newCmdPtr->hPtr);
    for (nsPtr=newCmdPtr->nsPtr ; (nsPtr!=NULL) && (nsPtr!=globalNsPtr) ;
	    nsPtr=nsPtr->parentPtr) {
	/*
	 * Find the maximal sequence of child namespaces contained in nsPtr
	 * such that there is a identically-named sequence of child namespaces
	 * starting from ::. shadowNsPtr will be the tail of this sequence, or
	 * the deepest namespace under :: that might contain a command now
	 * shadowed by cmdName. We check below if shadowNsPtr actually
	 * contains a command cmdName.
	 */

	found = 1;
	shadowNsPtr = globalNsPtr;

	for (i = trailFront;  i >= 0;  i--) {
	    trailNsPtr = trailPtr[i];
#ifndef BREAK_NAMESPACE_COMPAT
	    hPtr = Tcl_FindHashEntry(&shadowNsPtr->childTable,
		    trailNsPtr->name);
#else
	    if (shadowNsPtr->childTablePtr != NULL) {
		hPtr = Tcl_FindHashEntry(shadowNsPtr->childTablePtr,
			trailNsPtr->name);
	    } else {
		hPtr = NULL;
	    }
#endif
	    if (hPtr != NULL) {
		shadowNsPtr = (Namespace *)Tcl_GetHashValue(hPtr);
		shadowNsPtr = Tcl_GetHashValue(hPtr);
	    } else {
		found = 0;
		break;
	    }
	}

	/*
2818
2819
2820
2821
2822
2823
2824
2825

2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841


2842
2843
2844
2845
2846
2847
2848
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







-
+













-
-
-
+
+







		/*
		 * If the shadowed command was compiled to bytecodes, we
		 * invalidate all the bytecodes in nsPtr, to force a new
		 * compilation. We use the resolverEpoch to signal the need
		 * for a fresh compilation of every bytecode.
		 */

		if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL){
		if (((Command *)Tcl_GetHashValue(hPtr))->compileProc != NULL) {
		    nsPtr->resolverEpoch++;
		}
	    }
	}

	/*
	 * Insert nsPtr at the front of the trail list: i.e., at the end of
	 * the trailPtr array.
	 */

	trailFront++;
	if (trailFront == trailSize) {
	    int newSize = 2 * trailSize;

	    trailPtr = (Namespace **)TclStackRealloc(interp, trailPtr,
		    newSize * sizeof(Namespace *));
	    trailPtr = (Namespace **) TclStackRealloc(interp,
		    trailPtr, newSize * sizeof(Namespace *));
	    trailSize = newSize;
	}
	trailPtr[trailFront] = nsPtr;
    }
    TclStackFree(interp, trailPtr);
}

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
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765




2766
2767
2768
2769

2770
2771
2772
2773
2774
2775
2776



2777
2778
2779
2780
2781
2782

2783
2784


2785
2786
2787
2788
2789
2790
2791
2792
2793
2794

2795
2796


2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817

2818
2819
2820
2821

2822
2823
2824
2825
2826
2827
2828
2829
2830
2831



2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851

2852
2853
2854
2855
2856
2857
2858
2859
2860
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







-
+


















-
-
-
-
+

+

-
+



+


-
-
-
+
+
+



-


-
-
+









-
+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
+


-
+
+
+
+
+
+




-
-
-
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "namespace \"%s\" not found", name));
	} else {
	    /*
	     * Get the current namespace name.
	     */

	    NamespaceCurrentCmd(NULL, interp, 1, NULL);
	    NamespaceCurrentCmd(NULL, interp, 2, NULL);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "namespace \"%s\" not found in \"%s\"", name,
		    Tcl_GetStringResult(interp)));
	}
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static int
GetNamespaceFromObj(
    Tcl_Interp *interp,		/* The current interpreter. */
    Tcl_Obj *objPtr,		/* The object to be resolved as the name of a
				 * namespace. */
    Tcl_Namespace **nsPtrPtr)	/* Result namespace pointer goes here. */
{
    ResolvedNsName *resNamePtr;

    NsNameGetIntRep(objPtr, resNamePtr);
    if (resNamePtr) {
	Namespace *nsPtr, *refNsPtr;
    Namespace *nsPtr, *refNsPtr;

    if (objPtr->typePtr == &nsNameType) {
	/*
	 * Check that the ResolvedNsName is still valid; avoid letting the ref
	 * Check that the ResolvedNsName is still valid; avoid letting the ref 
	 * cross interps.
	 */

	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	nsPtr = resNamePtr->nsPtr;
	refNsPtr = resNamePtr->refNsPtr;
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
		&& (!refNsPtr || (refNsPtr ==
		(Namespace *) TclGetCurrentNamespace(interp)))) {
	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
		(!refNsPtr || ((interp == refNsPtr->interp) &&
		 (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))) {
	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
	    return TCL_OK;
	}
	Tcl_StoreIntRep(objPtr, &nsNameType, NULL);
    }
    if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
	NsNameGetIntRep(objPtr, resNamePtr);
	assert(resNamePtr != NULL);
	resNamePtr = (ResolvedNsName *) objPtr->internalRep.twoPtrValue.ptr1;
	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitNamespaceCmd --
 * Tcl_NamespaceObjCmd --
 *
 *	This function is called to create the "namespace" Tcl command. See the
 *	user documentation for details on what it does.
 *	Invoked to implement the "namespace" command that creates, deletes, or
 *	manipulates Tcl namespaces. Handles the following syntax:
 *
 *	    namespace children ?name? ?pattern?
 *	    namespace code arg
 *	    namespace current
 *	    namespace delete ?name name...?
 *	    namespace ensemble subcommand ?arg...?
 *	    namespace eval name arg ?arg...?
 *	    namespace exists name
 *	    namespace export ?-clear? ?pattern pattern...?
 *	    namespace forget ?pattern pattern...?
 *	    namespace import ?-force? ?pattern pattern...?
 *	    namespace inscope name arg ?arg...?
 *	    namespace origin name
 *	    namespace parent ?name?
 *	    namespace qualifiers string
 *	    namespace tail string
 *	    namespace which ?-command? ?-variable? name
 *
 * Results:
 *	Handle for the namespace command, or NULL on failure.
 *	Returns TCL_OK if the command is successful. Returns TCL_ERROR if
 *	anything goes wrong.
 *
 * Side effects:
 *	none
 *	Based on the subcommand name (e.g., "import"), this function
 *	dispatches to a corresponding function NamespaceXXXCmd defined
 *	statically in this file. This function's side effects depend on
 *	whatever that subcommand function does. If there is an error, this
 *	function returns an error message in the interpreter's result object.
 *	Otherwise it may return a result in the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitNamespaceCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
int
Tcl_NamespaceObjCmd(
    ClientData clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *subCmds[] = {
	"children", "code", "current", "delete", "ensemble",
	"eval", "exists", "export", "forget", "import",
	"inscope", "origin", "parent", "path", "qualifiers",
	"tail", "unknown", "upvar", "which", NULL
    };
    enum NSSubCmdIdx {
	NSChildrenIdx, NSCodeIdx, NSCurrentIdx, NSDeleteIdx, NSEnsembleIdx,
	NSEvalIdx, NSExistsIdx, NSExportIdx, NSForgetIdx, NSImportIdx,
	NSInscopeIdx, NSOriginIdx, NSParentIdx, NSPathIdx, NSQualifiersIdx,
	NSTailIdx, NSUnknownIdx, NSUpvarIdx, NSWhichIdx
    };
    int index, result;
    return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap);

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Return an index reflecting the particular subcommand.
     */

    result = Tcl_GetIndexFromObj((Tcl_Interp *) interp, objv[1], subCmds,
	    "option", /*flags*/ 0, (int *) &index);
    if (result != TCL_OK) {
	return result;
    }

    switch (index) {
    case NSChildrenIdx:
	result = NamespaceChildrenCmd(clientData, interp, objc, objv);
	break;
    case NSCodeIdx:
	result = NamespaceCodeCmd(clientData, interp, objc, objv);
	break;
    case NSCurrentIdx:
	result = NamespaceCurrentCmd(clientData, interp, objc, objv);
	break;
    case NSDeleteIdx:
	result = NamespaceDeleteCmd(clientData, interp, objc, objv);
	break;
    case NSEnsembleIdx:
	result = NamespaceEnsembleCmd(clientData, interp, objc, objv);
	break;
    case NSEvalIdx:
	result = NamespaceEvalCmd(clientData, interp, objc, objv);
	break;
    case NSExistsIdx:
	result = NamespaceExistsCmd(clientData, interp, objc, objv);
	break;
    case NSExportIdx:
	result = NamespaceExportCmd(clientData, interp, objc, objv);
	break;
    case NSForgetIdx:
	result = NamespaceForgetCmd(clientData, interp, objc, objv);
	break;
    case NSImportIdx:
	result = NamespaceImportCmd(clientData, interp, objc, objv);
	break;
    case NSInscopeIdx:
	result = NamespaceInscopeCmd(clientData, interp, objc, objv);
	break;
    case NSOriginIdx:
	result = NamespaceOriginCmd(clientData, interp, objc, objv);
	break;
    case NSParentIdx:
	result = NamespaceParentCmd(clientData, interp, objc, objv);
	break;
    case NSPathIdx:
	result = NamespacePathCmd(clientData, interp, objc, objv);
	break;
    case NSQualifiersIdx:
	result = NamespaceQualifiersCmd(clientData, interp, objc, objv);
	break;
    case NSTailIdx:
	result = NamespaceTailCmd(clientData, interp, objc, objv);
	break;
    case NSUpvarIdx:
	result = NamespaceUpvarCmd(clientData, interp, objc, objv);
	break;
    case NSUnknownIdx:
	result = NamespaceUnknownCmd(clientData, interp, objc, objv);
	break;
    case NSWhichIdx:
	result = NamespaceWhichCmd(clientData, interp, objc, objv);
	break;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceChildrenCmd --
 *
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

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
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







-
+







-
+

-
+







-
+

-
-
+
+




-
+








-
-
+
+






-
+













-
+




-
-
-
+
-
-
-
-
-





-

-
-
-
-
-
-

-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceChildrenCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *namespacePtr;
    Namespace *nsPtr, *childNsPtr;
    Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    const char *pattern = NULL;
    char *pattern = NULL;
    Tcl_DString buffer;
    Tcl_HashEntry *entryPtr;
    register Tcl_HashEntry *entryPtr;
    Tcl_HashSearch search;
    Tcl_Obj *listPtr, *elemPtr;

    /*
     * Get a pointer to the specified namespace, or the current namespace.
     */

    if (objc == 1) {
    if (objc == 2) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    } else if ((objc == 2) || (objc == 3)) {
	if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK){
    } else if ((objc == 3) || (objc == 4)) {
	if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	nsPtr = (Namespace *) namespacePtr;
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name? ?pattern?");
	Tcl_WrongNumArgs(interp, 2, objv, "?name? ?pattern?");
	return TCL_ERROR;
    }

    /*
     * Get the glob-style pattern, if any, used to narrow the search.
     */

    Tcl_DStringInit(&buffer);
    if (objc == 3) {
	const char *name = TclGetString(objv[2]);
    if (objc == 4) {
	char *name = TclGetString(objv[3]);

	if ((*name == ':') && (*(name+1) == ':')) {
	    pattern = name;
	} else {
	    Tcl_DStringAppend(&buffer, nsPtr->fullName, -1);
	    if (nsPtr != globalNsPtr) {
		TclDStringAppendLiteral(&buffer, "::");
		Tcl_DStringAppend(&buffer, "::", 2);
	    }
	    Tcl_DStringAppend(&buffer, name, -1);
	    pattern = Tcl_DStringValue(&buffer);
	}
    }

    /*
     * Create a list containing the full names of all child namespaces whose
     * names match the specified pattern, if any.
     */

    listPtr = Tcl_NewListObj(0, NULL);
    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	size_t length = strlen(nsPtr->fullName);
	unsigned int length = strlen(nsPtr->fullName);

	if (strncmp(pattern, nsPtr->fullName, length) != 0) {
	    goto searchDone;
	}
	if (
#ifndef BREAK_NAMESPACE_COMPAT
	    Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL
	if (Tcl_FindHashEntry(&nsPtr->childTable, pattern+length) != NULL) {
#else
	    nsPtr->childTablePtr != NULL &&
	    Tcl_FindHashEntry(nsPtr->childTablePtr, pattern+length) != NULL
#endif
	) {
	    Tcl_ListObjAppendElement(interp, listPtr,
		    Tcl_NewStringObj(pattern, -1));
	}
	goto searchDone;
    }
#ifndef BREAK_NAMESPACE_COMPAT
    entryPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
#else
    if (nsPtr->childTablePtr == NULL) {
	goto searchDone;
    }
    entryPtr = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
#endif
    while (entryPtr != NULL) {
	childNsPtr = (Namespace *)Tcl_GetHashValue(entryPtr);
	childNsPtr = Tcl_GetHashValue(entryPtr);
	if ((pattern == NULL)
		|| Tcl_StringMatch(childNsPtr->fullName, pattern)) {
	    elemPtr = Tcl_NewStringObj(childNsPtr->fullName, -1);
	    Tcl_ListObjAppendElement(interp, listPtr, elemPtr);
	}
	entryPtr = Tcl_NextHashEntry(&search);
    }
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
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







-
+






-
-
+
+

-
-
+
+











-
-
+
+

-
+







 *	result in the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceCodeCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *currNsPtr;
    Tcl_Obj *listPtr, *objPtr;
    const char *arg;
    size_t length;
    register char *arg;
    int length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg");
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "arg");
	return TCL_ERROR;
    }

    /*
     * If "arg" is already a scoped value, then return it directly.
     * Take care to only check for scoping in precisely the style that
     * [::namespace code] generates it.  Anything more forgiving can have
     * the effect of failing in namespaces that contain their own custom
     " "namespace" command.  [Bug 3202171].
     */

    arg = TclGetStringFromObj(objv[1], &length);
    if (*arg==':' && length > 20
    arg = TclGetStringFromObj(objv[2], &length);
    if (*arg==':' && length > 20 
	    && strncmp(arg, "::namespace inscope ", 20) == 0) {
	Tcl_SetObjResult(interp, objv[1]);
	Tcl_SetObjResult(interp, objv[2]);
	return TCL_OK;
    }

    /*
     * Otherwise, construct a scoped command by building a list with
     * "namespace inscope", the full name of the current namespace, and the
     * argument "arg". By constructing a list, we ensure that scoped commands
3158
3159
3160
3161
3162
3163
3164
3165

3166
3167
3168
3169
3170
3171
3172
3113
3114
3115
3116
3117
3118
3119

3120
3121
3122
3123
3124
3125
3126
3127







-
+







    if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) {
	TclNewLiteralStringObj(objPtr, "::");
    } else {
	objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1);
    }
    Tcl_ListObjAppendElement(interp, listPtr, objPtr);

    Tcl_ListObjAppendElement(interp, listPtr, objv[1]);
    Tcl_ListObjAppendElement(interp, listPtr, objv[2]);

    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
3187
3188
3189
3190
3191
3192
3193
3194

3195
3196
3197
3198
3199

3200
3201
3202


3203
3204
3205
3206
3207
3208
3209
3142
3143
3144
3145
3146
3147
3148

3149
3150
3151
3152
3153

3154
3155


3156
3157
3158
3159
3160
3161
3162
3163
3164







-
+




-
+

-
-
+
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceCurrentCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *currNsPtr;
    register Namespace *currNsPtr;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 2, objv, NULL);
	return TCL_ERROR;
    }

    /*
     * The "real" name of the global namespace ("::") is the null string, but
     * we return "::" for it as a convenience to programmers. Note that "" and
     * "::" are treated as synonyms by the namespace code so that it is still
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
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







-
+





-
-
+
+

-
-
+
+









-
+



-
+
-
-
-
+
+
+










-
+







 *	function returns an error message in the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceDeleteCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *namespacePtr;
    const char *name;
    int i;
    char *name;
    register int i;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name name...?");
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 2, objv, "?name name...?");
	return TCL_ERROR;
    }

    /*
     * Destroying one namespace may cause another to be destroyed. Break this
     * into two passes: first check to make sure that all namespaces on the
     * command line are valid, and report any errors.
     */

    for (i = 1;  i < objc;  i++) {
    for (i = 2;  i < objc;  i++) {
	name = TclGetString(objv[i]);
	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /*flags*/ 0);
	if ((namespacePtr == NULL)
		|| (((Namespace *) namespacePtr)->flags & NS_KILLED)) {
		|| (((Namespace *)namespacePtr)->flags & NS_KILLED)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "unknown namespace \"%s\" in namespace delete command",
		    TclGetString(objv[i])));
	    Tcl_AppendResult(interp, "unknown namespace \"",
		    TclGetString(objv[i]),
		    "\" in namespace delete command", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
		    TclGetString(objv[i]), NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Okay, now delete each namespace.
     */

    for (i = 1;  i < objc;  i++) {
    for (i = 2;  i < objc;  i++) {
	name = TclGetString(objv[i]);
	namespacePtr = Tcl_FindNamespace(interp, name, NULL, /* flags */ 0);
	if (namespacePtr) {
	    Tcl_DeleteNamespace(namespacePtr);
	}
    }
    return TCL_OK;
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
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







-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
+
+








-
+






-
+














-
+

+
+
-
-
+
+
+
+

-
+




-
-
-
-
+
+
+
+
+
+







-
+
-
-
-
+
-
-
-
-
+
+
+

-
-
-
-
+
+

-
-
-
-
-
-
-
-

-
-
+
+

-


-
+
-
-
-
+
+







 *	result.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceEvalCmd(
    ClientData clientData,	/* Arbitrary value passed to cmd. */
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceEvalCmd, clientData, objc,
	    objv);
}

static int
NRNamespaceEvalCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker;
    int word;
    Tcl_Namespace *namespacePtr;
    CallFrame *framePtr, **framePtrPtr;
    Tcl_Obj *objPtr;
    int result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
	return TCL_ERROR;
    }

    /*
     * Try to resolve the namespace reference, caching the result in the
     * namespace object along the way.
     */

    result = GetNamespaceFromObj(interp, objv[1], &namespacePtr);
    result = GetNamespaceFromObj(interp, objv[2], &namespacePtr);

    /*
     * If the namespace wasn't found, try to create it.
     */

    if (result == TCL_ERROR) {
	const char *name = TclGetString(objv[1]);
	char *name = TclGetString(objv[2]);

	namespacePtr = Tcl_CreateNamespace(interp, name, NULL, NULL);
	if (namespacePtr == NULL) {
	    return TCL_ERROR;
	}
    }

    /*
     * Make the specified namespace the current namespace and evaluate the
     * command(s).
     */

    /* This is needed to satisfy GCC 3.3's strict aliasing rules */
    framePtrPtr = &framePtr;
    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    namespacePtr, /*isProcCallFrame*/ 0);
    if (result != TCL_OK) {
	return TCL_ERROR;

    framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
    }

    framePtr->objc = objc;
    framePtr->objv = objv;

    if (objc == 3) {
    if (objc == 4) {
	/*
	 * TIP #280: Make actual argument location available to eval'd script.
	 */

	objPtr = objv[2];
	invoker = iPtr->cmdFramePtr;
	word = 3;
	TclArgumentGet(interp, objPtr, &invoker, &word);
	Interp *iPtr      = (Interp *) interp;
	CmdFrame* invoker = iPtr->cmdFramePtr;
	int word          = 3;

	TclArgumentGet (interp, objv[3], &invoker, &word);
	result = TclEvalObjEx(interp, objv[3], 0, invoker, word);
    } else {
	/*
	 * More than one argument: concatenate them together with spaces
	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
	 * object when it decrements its refcount after eval'ing it.
	 */

	objPtr = Tcl_ConcatObj(objc-2, objv+2);
	objPtr = Tcl_ConcatObj(objc-3, objv+3);
	invoker = NULL;
	word = 0;
    }


    /*
     * TIP #280: Make invoking context available to eval'd script.
     */
	/*
	 * TIP #280: Make invoking context available to eval'd script.
	 */

    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "eval",
	    NULL, NULL);
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
}
	result = TclEvalObjEx(interp, objPtr, TCL_EVAL_DIRECT, NULL, 0);
    }

static int
NsEval_Callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Namespace *namespacePtr = (Tcl_Namespace *)data[0];

    if (result == TCL_ERROR) {
	size_t length = strlen(namespacePtr->fullName);
	unsigned limit = 200;
	int length = strlen(namespacePtr->fullName);
	int limit = 200;
	int overflow = (length > limit);
	char *cmd = (char *)data[1];

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (in namespace %s \"%.*s%s\" script line %d)",
		"\n    (in namespace eval \"%.*s%s\" script line %d)",
		cmd,
		(overflow ? limit : (unsigned)length), namespacePtr->fullName,
		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
		(overflow ? limit : length), namespacePtr->fullName,
		(overflow ? "..." : ""), interp->errorLine));
    }

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
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
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







-
+






-
-
+
+




-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceExistsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *namespacePtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "name");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
	    GetNamespaceFromObj(interp, objv[1], &namespacePtr) == TCL_OK));
	    GetNamespaceFromObj(interp, objv[2], &namespacePtr) == TCL_OK));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceExportCmd --
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
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







-
+






-
-
+
+








-
-
+
+

-
-
+








-
-
+
+










-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceExportCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int firstArg, i;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-clear? ?pattern pattern...?");
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 2, objv, "?-clear? ?pattern pattern...?");
	return TCL_ERROR;
    }

    /*
     * If no pattern arguments are given, and "-clear" isn't specified, return
     * the namespace's current export pattern list.
     */

    if (objc == 1) {
	Tcl_Obj *listPtr;
    if (objc == 2) {
	Tcl_Obj *listPtr = Tcl_NewObj();

	TclNewObj(listPtr);
	(void)Tcl_AppendExportList(interp, NULL, listPtr);
	(void) Tcl_AppendExportList(interp, NULL, listPtr);
	Tcl_SetObjResult(interp, listPtr);
	return TCL_OK;
    }

    /*
     * Process the optional "-clear" argument.
     */

    firstArg = 1;
    if (strcmp("-clear", TclGetString(objv[firstArg])) == 0) {
    firstArg = 2;
    if (strcmp("-clear", Tcl_GetString(objv[firstArg])) == 0) {
	Tcl_Export(interp, NULL, "::", 1);
	Tcl_ResetResult(interp);
	firstArg++;
    }

    /*
     * Add each pattern to the namespace's export pattern list.
     */

    for (i = firstArg;  i < objc;  i++) {
	int result = Tcl_Export(interp, NULL, TclGetString(objv[i]), 0);
	int result = Tcl_Export(interp, NULL, Tcl_GetString(objv[i]), 0);
	if (result != TCL_OK) {
	    return result;
	}
    }
    return TCL_OK;
}

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
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







-
+




-
-
+
+

-
-
+
+



-
+







 *	interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceForgetCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *pattern;
    int i, result;
    char *pattern;
    register int i, result;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern pattern...?");
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 2, objv, "?pattern pattern...?");
	return TCL_ERROR;
    }

    for (i = 1;  i < objc;  i++) {
    for (i = 2;  i < objc;  i++) {
	pattern = TclGetString(objv[i]);
	result = Tcl_ForgetImport(interp, NULL, pattern);
	if (result != TCL_OK) {
	    return result;
	}
    }
    return TCL_OK;
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
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







-
+





-
-
+
+


-
-
+
+







-
+








-
+











-
+



-
+







 *	result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceImportCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int allowOverwrite = 0;
    const char *string, *pattern;
    int i, result;
    char *string, *pattern;
    register int i, result;
    int firstArg;

    if (objc < 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-force? ?pattern pattern...?");
    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 2, objv, "?-force? ?pattern pattern...?");
	return TCL_ERROR;
    }

    /*
     * Skip over the optional "-force" as the first argument.
     */

    firstArg = 1;
    firstArg = 2;
    if (firstArg < objc) {
	string = TclGetString(objv[firstArg]);
	if ((*string == '-') && (strcmp(string, "-force") == 0)) {
	    allowOverwrite = 1;
	    firstArg++;
	}
    } else {
	/*
	 * When objc == 1, command is just [namespace import]. Introspection
	 * When objc == 2, command is just [namespace import]. Introspection
	 * form to return list of imported commands.
	 */

	Tcl_HashEntry *hPtr;
	Tcl_HashSearch search;
	Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
	Tcl_Obj *listPtr;

	TclNewObj(listPtr);
	for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    Command *cmdPtr = (Command *)Tcl_GetHashValue(hPtr);
	    Command *cmdPtr = Tcl_GetHashValue(hPtr);

	    if (cmdPtr->deleteProc == DeleteImportedCmd) {
		Tcl_ListObjAppendElement(NULL, listPtr, Tcl_NewStringObj(
			(char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1));
			Tcl_GetHashKey(&nsPtr->cmdTable, hPtr) ,-1));
	    }
	}
	Tcl_SetObjResult(interp, listPtr);
	return TCL_OK;
    }

    /*
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794

3795
3796
3797
3798
3799
3800
3801

3802
3803
3804
3805


3806
3807
3808
3809
3810
3811
3812
3813

3814
3815
3816
3817
3818
3819
3820
3821
3822
3823

3824


3825
3826




3827
3828
3829
3830
3831
3832
3833
3834
3835
3836


3837
3838
3839

3840
3841
3842
3843


3844
3845
3846
3847
3848
3849

3850
3851

3852
3853
3854




3855
3856
3857













3858
3859
3860
3861
3862
3863
3864
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
3775
3776
3777
3778
3779
3780
3781
3782



3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802







-
-
-
-
-
-
-
-
-
-
-
-
+






-
+
-

-
-
+
+







-
+









-
+

+
+
-
-
+
+
+
+








-
-
+
+


-
+


-
-
+
+





-
+


+



+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	Returns a result in the Tcl interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceInscopeCmd(
    ClientData clientData,	/* Arbitrary value passed to cmd. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, NRNamespaceInscopeCmd, clientData, objc,
	    objv);
}

static int
NRNamespaceInscopeCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *namespacePtr;
    CallFrame *framePtr, **framePtrPtr;
    int i;
    int i, result;
    Tcl_Obj *cmdObjPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name arg ?arg...?");
    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "name arg ?arg...?");
	return TCL_ERROR;
    }

    /*
     * Resolve the namespace reference.
     */

    if (TclGetNamespaceFromObj(interp, objv[1], &namespacePtr) != TCL_OK) {
    if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Make the specified namespace the current namespace.
     */

    framePtrPtr = &framePtr;		/* This is needed to satisfy GCC's
					 * strict aliasing rules. */
    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    namespacePtr, /*isProcCallFrame*/ 0);
    if (result != TCL_OK) {
	return result;

    framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
    }

    framePtr->objc = objc;
    framePtr->objv = objv;

    /*
     * Execute the command. If there is just one argument, just treat it as a
     * script and evaluate it. Otherwise, create a list from the arguments
     * after the first one, then concatenate the first argument and the list
     * of extra arguments to form the command to evaluate.
     */

    if (objc == 3) {
	cmdObjPtr = objv[2];
    if (objc == 4) {
	result = Tcl_EvalObjEx(interp, objv[3], 0);
    } else {
	Tcl_Obj *concatObjv[2];
	Tcl_Obj *listPtr;
	register Tcl_Obj *listPtr, *cmdObjPtr;

	listPtr = Tcl_NewListObj(0, NULL);
	for (i = 3;  i < objc;  i++) {
	    if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK){
	for (i = 4;  i < objc;  i++) {
	    if (Tcl_ListObjAppendElement(interp, listPtr, objv[i]) != TCL_OK) {
		Tcl_DecrRefCount(listPtr);	/* Free unneeded obj. */
		return TCL_ERROR;
	    }
	}

	concatObjv[0] = objv[2];
	concatObjv[0] = objv[3];
	concatObjv[1] = listPtr;
	cmdObjPtr = Tcl_ConcatObj(2, concatObjv);
	result = Tcl_EvalObjEx(interp, cmdObjPtr, TCL_EVAL_DIRECT);
	Tcl_DecrRefCount(listPtr);    /* We're done with the list object. */
    }

    if (result == TCL_ERROR) {
	int length = strlen(namespacePtr->fullName);
	int limit = 200;
	int overflow = (length > limit);
    TclNRAddCallback(interp, NsEval_Callback, namespacePtr, "inscope",
	    NULL, NULL);
    return TclNREvalObjEx(interp, cmdObjPtr, 0, NULL, 0);

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (in namespace inscope \"%.*s%s\" script line %d)",
		(overflow ? limit : length), namespacePtr->fullName,
		(overflow ? "..." : ""), interp->errorLine));
    }

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceOriginCmd --
 *
3884
3885
3886
3887
3888
3889
3890
3891

3892
3893
3894
3895
3896

3897
3898
3899
3900


3901
3902
3903
3904
3905
3906







3907
3908
3909
3910
3911
3912
3913












3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3822
3823
3824
3825
3826
3827
3828

3829
3830
3831
3832
3833

3834
3835
3836


3837
3838
3839
3840
3841



3842
3843
3844
3845
3846
3847
3848
3849






3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861








3862
3863
3864
3865

3866
3867
3868
3869
3870
3871
3872







-
+




-
+


-
-
+
+



-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-




-







 *	interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceOriginCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Command cmd, origCmd;
    Tcl_Command command, origCommand;
    Tcl_Obj *resultPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "name");
	return TCL_ERROR;
    }

    cmd = Tcl_GetCommandFromObj(interp, objv[1]);
    if (cmd == NULL) {
	goto namespaceOriginError;
    command = Tcl_GetCommandFromObj(interp, objv[2]);
    if (command == NULL) {
	Tcl_AppendResult(interp, "invalid command name \"",
		TclGetString(objv[2]), "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    origCmd = TclGetOriginalCommand(cmd);
    if (origCmd == NULL) {
	origCmd = cmd;
    }
    TclNewObj(resultPtr);
    Tcl_GetCommandFullName(interp, origCmd, resultPtr);
    origCommand = TclGetOriginalCommand(command);
    TclNewObj(resultPtr);
    if (origCommand == NULL) {
	/*
	 * The specified command isn't an imported command. Return the
	 * command's name qualified by the full name of the namespace it was
	 * defined in.
	 */

	Tcl_GetCommandFullName(interp, command, resultPtr);
    } else {
	Tcl_GetCommandFullName(interp, origCommand, resultPtr);
    if (TclCheckEmptyString(resultPtr) == TCL_EMPTYSTRING_YES ) {
	Tcl_DecrRefCount(resultPtr);
	namespaceOriginError:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "invalid command name \"%s\"", TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
		TclGetString(objv[1]), NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * NamespaceParentCmd --
 *
 *	Invoked to implement the "namespace parent" command that returns the
3944
3945
3946
3947
3948
3949
3950
3951

3952
3953
3954
3955
3956
3957
3958

3959
3960
3961


3962
3963
3964
3965

3966
3967
3968
3969
3970
3971
3972
3883
3884
3885
3886
3887
3888
3889

3890
3891
3892
3893
3894
3895
3896

3897
3898


3899
3900
3901
3902
3903

3904
3905
3906
3907
3908
3909
3910
3911







-
+






-
+

-
-
+
+



-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceParentCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *nsPtr;

    if (objc == 1) {
    if (objc == 2) {
	nsPtr = TclGetCurrentNamespace(interp);
    } else if (objc == 2) {
	if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
    } else if (objc == 3) {
	if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	Tcl_WrongNumArgs(interp, 2, objv, "?name?");
	return TCL_ERROR;
    }

    /*
     * Report the parent of the specified namespace.
     */

4002
4003
4004
4005
4006
4007
4008
4009

4010
4011
4012
4013
4014
4015
4016

4017
4018
4019
4020
4021


4022
4023
4024
4025
4026
4027
4028
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
3941
3942
3943
3944
3945
3946
3947

3948
3949
3950
3951
3952
3953


3954
3955
3956
3957


3958
3959
3960
3961
3962
3963
3964
3965
3966


3967
3968
3969
3970
3971

3972
3973


3974
3975
3976
3977

3978
3979
3980
3981
3982
3983
3984

3985
3986
3987
3988


3989
3990
3991

3992
3993
3994
3995
3996
3997
3998
3999







-
+





-
-
+



-
-
+
+







-
-
+
+
+
+

-


-
-
+
+


-







-
+



-
-
+
+

-
+







 *	names that depend on the namespace for resolution).
 *
 *----------------------------------------------------------------------
 */

static int
NamespacePathCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    size_t i;
    int nsObjc, result = TCL_ERROR;
    int i, nsObjc, result = TCL_ERROR;
    Tcl_Obj **nsObjv;
    Tcl_Namespace **namespaceList = NULL;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pathList?");
    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "?pathList?");
	return TCL_ERROR;
    }

    /*
     * If no path is given, return the current path.
     */

    if (objc == 1) {
	Tcl_Obj *resultObj;
    if (objc == 2) {
	/*
	 * Not a very fast way to compute this, but easy to get right.
	 */

	TclNewObj(resultObj);
	for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	    if (nsPtr->commandPathArray[i].nsPtr != NULL) {
		Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewStringObj(
			nsPtr->commandPathArray[i].nsPtr->fullName, -1));
		Tcl_AppendElement(interp,
			nsPtr->commandPathArray[i].nsPtr->fullName);
	    }
	}
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;
    }

    /*
     * There is a path given, so parse it into an array of namespace pointers.
     */

    if (TclListObjGetElements(interp, objv[1], &nsObjc, &nsObjv) != TCL_OK) {
    if (TclListObjGetElements(interp, objv[2], &nsObjc, &nsObjv) != TCL_OK) {
	goto badNamespace;
    }
    if (nsObjc != 0) {
	namespaceList = (Tcl_Namespace **)TclStackAlloc(interp,
		sizeof(Tcl_Namespace *) * nsObjc);
	namespaceList = (Tcl_Namespace **)
		TclStackAlloc(interp, sizeof(Tcl_Namespace *) * nsObjc);

	for (i=0 ; i<(size_t)nsObjc ; i++) {
	for (i=0 ; i<nsObjc ; i++) {
	    if (TclGetNamespaceFromObj(interp, nsObjv[i],
		    &namespaceList[i]) != TCL_OK) {
		goto badNamespace;
	    }
	}
    }

4092
4093
4094
4095
4096
4097
4098
4099

4100
4101
4102
4103
4104
4105



4106
4107
4108
4109
4110
4111
4112
4030
4031
4032
4033
4034
4035
4036

4037
4038
4039
4040



4041
4042
4043
4044
4045
4046
4047
4048
4049
4050







-
+



-
-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

void
TclSetNsPath(
    Namespace *nsPtr,		/* Namespace whose path is to be set. */
    size_t pathLength,		/* Length of pathAry. */
    int pathLength,		/* Length of pathAry. */
    Tcl_Namespace *pathAry[])	/* Array of namespaces that are the path. */
{
    if (pathLength != 0) {
	NamespacePathEntry *tmpPathArray =
		(NamespacePathEntry *)Tcl_Alloc(sizeof(NamespacePathEntry) * pathLength);
	size_t i;
	NamespacePathEntry *tmpPathArray = (NamespacePathEntry *)
		ckalloc(sizeof(NamespacePathEntry) * pathLength);
	int i;

	for (i=0 ; i<pathLength ; i++) {
	    tmpPathArray[i].nsPtr = (Namespace *) pathAry[i];
	    tmpPathArray[i].creatorNsPtr = nsPtr;
	    tmpPathArray[i].prevPtr = NULL;
	    tmpPathArray[i].nextPtr =
		    tmpPathArray[i].nsPtr->commandPathSourceList;
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
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







-
+


-












-
+







 *----------------------------------------------------------------------
 */

static void
UnlinkNsPath(
    Namespace *nsPtr)
{
    size_t i;
    int i;
    for (i=0 ; i<nsPtr->commandPathLength ; i++) {
	NamespacePathEntry *nsPathPtr = &nsPtr->commandPathArray[i];

	if (nsPathPtr->prevPtr != NULL) {
	    nsPathPtr->prevPtr->nextPtr = nsPathPtr->nextPtr;
	}
	if (nsPathPtr->nextPtr != NULL) {
	    nsPathPtr->nextPtr->prevPtr = nsPathPtr->prevPtr;
	}
	if (nsPathPtr->nsPtr != NULL) {
	    if (nsPathPtr->nsPtr->commandPathSourceList == nsPathPtr) {
		nsPathPtr->nsPtr->commandPathSourceList = nsPathPtr->nextPtr;
	    }
	}
    }
    Tcl_Free(nsPtr->commandPathArray);
    ckfree((char *) nsPtr->commandPathArray);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInvalidateNsPath --
 *
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4130
4131
4132
4133
4134
4135
4136

4137
4138
4139
4140
4141
4142
4143







-







 */

void
TclInvalidateNsPath(
    Namespace *nsPtr)
{
    NamespacePathEntry *nsPathPtr = nsPtr->commandPathSourceList;

    while (nsPathPtr != NULL) {
	if (nsPathPtr->nsPtr != NULL) {
	    nsPathPtr->creatorNsPtr->cmdRefEpoch++;
	}
	nsPathPtr = nsPathPtr->nextPtr;
    }
}
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
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







-
+




-
-
+
+

-
-
+
+








-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceQualifiersCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *p;
    size_t length;
    register char *name, *p;
    int length;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "string");
	return TCL_ERROR;
    }

    /*
     * Find the end of the string, then work backward and find the start of
     * the last "::" qualifier.
     */

    name = TclGetString(objv[1]);
    name = TclGetString(objv[2]);
    for (p = name;  *p != '\0';  p++) {
	/* empty body */
    }
    while (--p >= name) {
	if ((*p == ':') && (p > name) && (*(p-1) == ':')) {
	    p -= 2;			/* Back up over the :: */
	    while ((p >= name) && (*p == ':')) {
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
4328
4329
4330
4331

4332
4333

4334
4335
4336
4337
4338
4339
4340
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







-
+








-
-
+
+





-
+










-
+

-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceUnknownCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Namespace *currNsPtr;
    Tcl_Obj *resultPtr;
    int rc;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?script?");
    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "?script?");
	return TCL_ERROR;
    }

    currNsPtr = TclGetCurrentNamespace(interp);

    if (objc == 1) {
    if (objc == 2) {
	/*
	 * Introspection - return the current namespace handler.
	 */

	resultPtr = Tcl_GetNamespaceUnknownHandler(interp, currNsPtr);
	if (resultPtr == NULL) {
	    TclNewObj(resultPtr);
	}
	Tcl_SetObjResult(interp, resultPtr);
    } else {
	rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[1]);
	rc = Tcl_SetNamespaceUnknownHandler(interp, currNsPtr, objv[2]);
	if (rc == TCL_OK) {
	    Tcl_SetObjResult(interp, objv[1]);
	    Tcl_SetObjResult(interp, objv[2]);
	}
	return rc;
    }
    return TCL_OK;
}

/*
4357
4358
4359
4360
4361
4362
4363
4364

4365
4366
4367

4368
4369
4370
4371
4372
4373
4374
4293
4294
4295
4296
4297
4298
4299

4300
4301
4302

4303
4304
4305
4306
4307
4308
4309
4310







-
+


-
+








Tcl_Obj *
Tcl_GetNamespaceUnknownHandler(
    Tcl_Interp *interp,		/* The interpreter in which the namespace
				 * exists. */
    Tcl_Namespace *nsPtr)	/* The namespace. */
{
    Namespace *currNsPtr = (Namespace *) nsPtr;
    Namespace *currNsPtr = (Namespace *)nsPtr;

    if (currNsPtr->unknownHandlerPtr == NULL &&
	    currNsPtr == ((Interp *) interp)->globalNsPtr) {
	    currNsPtr == ((Interp *)interp)->globalNsPtr) {
	/*
	 * Default handler for global namespace is "::unknown". For all other
	 * namespaces, it is NULL (which falls back on the global unknown
	 * handler).
	 */

	TclNewLiteralStringObj(currNsPtr->unknownHandlerPtr, "::unknown");
4401
4402
4403
4404
4405
4406
4407
4408

4409
4410
4411
4412
4413
4414
4415
4337
4338
4339
4340
4341
4342
4343

4344
4345
4346
4347
4348
4349
4350
4351







-
+







Tcl_SetNamespaceUnknownHandler(
    Tcl_Interp *interp,		/* Interpreter in which the namespace
				 * exists. */
    Tcl_Namespace *nsPtr,	/* Namespace which is being updated. */
    Tcl_Obj *handlerPtr)	/* The new handler, or NULL to reset. */
{
    int lstlen = 0;
    Namespace *currNsPtr = (Namespace *) nsPtr;
    Namespace *currNsPtr = (Namespace *)nsPtr;

    /*
     * Ensure that we check for errors *first* before we change anything.
     */

    if (handlerPtr != NULL) {
	if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) {
4484
4485
4486
4487
4488
4489
4490
4491

4492
4493
4494
4495
4496

4497
4498
4499


4500
4501
4502
4503
4504
4505
4506
4507
4508

4509
4510
4511
4512
4513
4514
4515
4420
4421
4422
4423
4424
4425
4426

4427
4428
4429
4430
4431

4432
4433


4434
4435
4436
4437
4438
4439
4440
4441
4442
4443

4444
4445
4446
4447
4448
4449
4450
4451







-
+




-
+

-
-
+
+








-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceTailCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *name, *p;
    register char *name, *p;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "string");
    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "string");
	return TCL_ERROR;
    }

    /*
     * Find the end of the string, then work backward and find the last "::"
     * qualifier.
     */

    name = TclGetString(objv[1]);
    name = TclGetString(objv[2]);
    for (p = name;  *p != '\0';  p++) {
	/* empty body */
    }
    while (--p > name) {
	if ((*p == ':') && (*(p-1) == ':')) {
	    p++;			/* Just after the last "::" */
	    break;
4542
4543
4544
4545
4546
4547
4548
4549

4550
4551
4552
4553
4554
4555
4556
4557

4558
4559
4560



4561
4562
4563
4564

4565
4566
4567
4568
4569


4570
4571
4572
4573

4574
4575
4576
4577
4578
4579
4580


4581
4582
4583
4584
4585
4586
4587
4478
4479
4480
4481
4482
4483
4484

4485
4486
4487
4488
4489
4490
4491
4492

4493
4494


4495
4496
4497
4498
4499
4500

4501
4502
4503
4504


4505
4506
4507
4508
4509

4510
4511
4512
4513
4514
4515


4516
4517
4518
4519
4520
4521
4522
4523
4524







-
+







-
+

-
-
+
+
+



-
+



-
-
+
+



-
+





-
-
+
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceUpvarCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Namespace *nsPtr, *savedNsPtr;
    Var *otherPtr, *arrayPtr;
    const char *myName;
    char *myName;

    if (objc < 2 || (objc & 1)) {
	Tcl_WrongNumArgs(interp, 1, objv, "ns ?otherVar myVar ...?");
    if (objc < 5 || !(objc & 1)) {
	Tcl_WrongNumArgs(interp, 2, objv,
		"ns otherVar myVar ?otherVar myVar ...?");
	return TCL_ERROR;
    }

    if (TclGetNamespaceFromObj(interp, objv[1], &nsPtr) != TCL_OK) {
    if (TclGetNamespaceFromObj(interp, objv[2], &nsPtr) != TCL_OK) {
	return TCL_ERROR;
    }

    objc -= 2;
    objv += 2;
    objc -= 3;
    objv += 3;

    for (; objc>0 ; objc-=2, objv+=2) {
	/*
	 * Locate the other variable.
	 * Locate the other variable
	 */

	savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
	otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
		(TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
		"access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
	if (otherPtr == NULL) {
	    return TCL_ERROR;
	}

	/*
	 * Create the new variable and link it to otherPtr.
4616
4617
4618
4619
4620
4621
4622
4623

4624
4625
4626
4627
4628

4629
4630
4631
4632
4633
4634

4635
4636

4637
4638

4639
4640
4641
4642
4643

4644
4645
4646
4647
4648
4649
4650
4553
4554
4555
4556
4557
4558
4559

4560
4561
4562
4563
4564

4565
4566
4567
4568
4569
4570

4571
4572

4573
4574

4575
4576
4577
4578
4579

4580
4581
4582
4583
4584
4585
4586
4587







-
+




-
+





-
+

-
+

-
+




-
+







 *	wrong, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceWhichCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const opts[] = {
    static const char *opts[] = {
	"-command", "-variable", NULL
    };
    int lookupType = 0;
    Tcl_Obj *resultPtr;

    if (objc < 2 || objc > 3) {
    if (objc < 3 || objc > 4) {
    badArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "?-command? ?-variable? name");
	Tcl_WrongNumArgs(interp, 2, objv, "?-command? ?-variable? name");
	return TCL_ERROR;
    } else if (objc == 3) {
    } else if (objc == 4) {
	/*
	 * Look for a flag controlling the lookup.
	 */

	if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
	if (Tcl_GetIndexFromObj(interp, objv[2], opts, "option", 0,
		&lookupType) != TCL_OK) {
	    /*
	     * Preserve old style of error message!
	     */

	    Tcl_ResetResult(interp);
	    goto badArgs;
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
4629
4630
4631
4632
4633
4634
4635

4636
4637
4638


4639
4640


4641
4642
4643
4644
4645
4646
4647
4648

4649
4650
4651
4652
4653
4654
4655
4656


4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671







-
+


-
-
+
+
-
-
+






+
-
+
+






-
-
+
+
+
+
+
+

+







 *	the namespace, it's structure will be freed.
 *
 *----------------------------------------------------------------------
 */

static void
FreeNsNameInternalRep(
    Tcl_Obj *objPtr)	/* nsName object with internal representation
    register Tcl_Obj *objPtr)	/* nsName object with internal representation
				 * to free. */
{
    ResolvedNsName *resNamePtr;

    register ResolvedNsName *resNamePtr = (ResolvedNsName *)
	    objPtr->internalRep.twoPtrValue.ptr1;
    NsNameGetIntRep(objPtr, resNamePtr);
    assert(resNamePtr != NULL);
    Namespace *nsPtr;

    /*
     * Decrement the reference count of the namespace. If there are no more
     * references, free it up.
     */

    resNamePtr->refCount--;
    if (resNamePtr->refCount-- <= 1) {
    if (resNamePtr->refCount == 0) {

	/*
	 * Decrement the reference count for the cached namespace. If the
	 * namespace is dead, and there are no more references to it, free
	 * it.
	 */

	TclNsDecrRefCount(resNamePtr->nsPtr);
	Tcl_Free(resNamePtr);
	nsPtr = resNamePtr->nsPtr;
	nsPtr->refCount--;
	if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
	    NamespaceFree(nsPtr);
	}
	ckfree((char *) resNamePtr);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupNsNameInternalRep --
 *
4739
4740
4741
4742
4743
4744
4745
4746

4747
4748


4749
4750
4751
4752



4753
4754
4755
4756
4757
4758
4759
4682
4683
4684
4685
4686
4687
4688

4689
4690

4691
4692
4693



4694
4695
4696
4697
4698
4699
4700
4701
4702
4703







-
+

-
+
+

-
-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

static void
DupNsNameInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    ResolvedNsName *resNamePtr;
    register ResolvedNsName *resNamePtr = (ResolvedNsName *)
	    srcPtr->internalRep.twoPtrValue.ptr1;

    NsNameGetIntRep(srcPtr, resNamePtr);
    assert(resNamePtr != NULL);
    NsNameSetIntRep(copyPtr, resNamePtr);
    copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
    resNamePtr->refCount++;
    copyPtr->typePtr = &nsNameType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetNsNameFromAny --
 *
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
4955
4956





4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
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
4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865


5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009




6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057











6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
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
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
6390
6391
6392
6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522
6523
6524
6525
6526
6527
6528
6529
6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580
6581
6582
6583
6584
6585
6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616
6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704
6705
6706
6707
6708
6709
6710
6711
6712
6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750
6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798
6799
6800
6801
6802
6803
6804
6805
6806
6807
6808
6809
6810
6811
6812
6813
6814
6815
6816
6817
6818
6819
6820
6821
6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834
6835
6836
6837
6838
6839
6840
6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863

6864
6865
6866
6867
6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
6896
6897
6898
6899
6900
6901
6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929
6930
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943

6944
6945
6946

6947
6948
6949

6950
6951
6952

6953
6954
6955
6956
6957
6958

6959


6960
6961



6962






6963
6964
6965

6966
6967
6968
6969
6970
6971
6972

6973
6974
6975


6976
6977



6978
6979
6980
6981
6982


6983
6984
6985
6986
6987
6988
6989

6990
6991
6992
6993
6994
6995


6996
6997



6998

6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012




7013
7014
7015
7016






7017
7018
7019
7020
7021
7022
7023







7024
7025
7026
7027
7028
7029
7030


7031
7032






7033
7034
7035
7036
7037
7038
7039





7040
7041
7042
7043
7044
7045






7046
7047
7048
7049
7050
7051




7052
7053
7054
7055





7056
7057
7058
7059
7060



















































































































































7061
7062
7063
7064
7065
7066

7067
7068







-
+



-
+










-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+




-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

+
-
+


-
+


-
+




+
-
+
-
-
+

-
-
-
+
-
-
-
-
-
-
+
+
+
-
+
+





-
+


-
-
+
+
-
-
-





-
-
+
+





-
+





-
-
+
+
-
-
-

-
+













-
-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-


 */

static int
SetNsNameFromAny(
    Tcl_Interp *interp,		/* Points to the namespace in which to resolve
				 * name. Also used for error reporting if not
				 * NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    const char *dummy;
    Namespace *nsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolvedNsName *resNamePtr;
    register ResolvedNsName *resNamePtr;
    const char *name;

    if (interp == NULL) {
	return TCL_ERROR;
    }

    name = TclGetString(objPtr);
    TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
	     &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);

    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
	return TCL_ERROR;
    }

    /*
     * If we found a namespace, then create a new ResolvedNsName structure
     * that holds a reference to it.
     */

    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
	/*
	 * Our failed lookup proves any previously cached nsName intrep is no
	 * longer valid. Get rid of it so we no longer waste memory storing
	 * it, nor time determining its invalidity again and again.
	 */

	if (objPtr->typePtr == &nsNameType) {
	    TclFreeIntRep(objPtr);
	    objPtr->typePtr = NULL;
	}
	return TCL_ERROR;
    }

    nsPtr->refCount++;
    resNamePtr = (ResolvedNsName *)Tcl_Alloc(sizeof(ResolvedNsName));
    resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName));
    resNamePtr->nsPtr = nsPtr;
    if ((name[0] == ':') && (name[1] == ':')) {
	resNamePtr->refNsPtr = NULL;
    } else {
	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
	resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    }
    resNamePtr->refCount = 1;
    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
    objPtr->typePtr = &nsNameType;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceEnsembleCmd --
 *
 *	Invoked to implement the "namespace ensemble" command that creates and
 *	manipulates ensembles built on top of namespaces. Handles the
 *	following syntax:
 *
 *	    namespace ensemble name ?dictionary?
 *
 * Results:
 *	Returns TCL_OK if successful, and TCL_ERROR if anything goes wrong.
 *
 * Side effects:
 *	Creates the ensemble for the namespace if one did not previously
 *	exist. Alternatively, alters the way that the ensemble's subcommand =>
 *	implementation prefix is configured.
 *
 *----------------------------------------------------------------------
 */

static int
NamespaceEnsembleCmd(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Namespace *nsPtr;
    Tcl_Command token;
    static const char *subcommands[] = {
	"configure", "create", "exists", NULL
    };
    enum EnsSubcmds {
	ENS_CONFIG, ENS_CREATE, ENS_EXISTS
    };
    static const char *createOptions[] = {
	"-command", "-map", "-prefixes", "-subcommands", "-unknown", NULL
    };
    enum EnsCreateOpts {
	CRT_CMD, CRT_MAP, CRT_PREFIX, CRT_SUBCMDS, CRT_UNKNOWN
    };
    static const char *configOptions[] = {
	"-map", "-namespace", "-prefixes", "-subcommands", "-unknown", NULL
    };
    enum EnsConfigOpts {
	CONF_MAP, CONF_NAMESPACE, CONF_PREFIX, CONF_SUBCMDS, CONF_UNKNOWN
    };
    int index;

    nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    if (nsPtr == NULL || nsPtr->flags & NS_DYING) {
	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_AppendResult(interp,
		    "tried to manipulate ensemble of deleted namespace", NULL);
	}
	return TCL_ERROR;
    }

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 2, objv, "subcommand ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], subcommands, "subcommand", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum EnsSubcmds) index) {
    case ENS_CREATE: {
	char *name;
	Tcl_DictSearch search;
	Tcl_Obj *listObj;
	int done, len, allocatedMapFlag = 0;
	/*
	 * Defaults
	 */
	Tcl_Obj *subcmdObj = NULL;
	Tcl_Obj *mapObj = NULL;
	int permitPrefix = 1;
	Tcl_Obj *unknownObj = NULL;

	objv += 3;
	objc -= 3;

	/*
	 * Work out what name to use for the command to create. If supplied,
	 * it is either fully specified or relative to the current namespace.
	 * If not supplied, it is exactly the name of the current namespace.
	 */

	name = nsPtr->fullName;

	/*
	 * Parse the option list, applying type checks as we go. Note that we
	 * are not incrementing any reference counts in the objects at this
	 * stage, so the presence of an option multiple times won't cause any
	 * memory leaks.
	 */

	for (; objc>1 ; objc-=2,objv+=2 ) {
	    if (Tcl_GetIndexFromObj(interp, objv[0], createOptions, "option",
		    0, &index) != TCL_OK) {
		if (allocatedMapFlag) {
		    Tcl_DecrRefCount(mapObj);
		}
		return TCL_ERROR;
	    }
	    switch ((enum EnsCreateOpts) index) {
	    case CRT_CMD:
		name = TclGetString(objv[1]);
		continue;
	    case CRT_SUBCMDS:
		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		subcmdObj = (len > 0 ? objv[1] : NULL);
		continue;
	    case CRT_MAP: {
		Tcl_Obj *patchedDict = NULL, *subcmdObj;

		/*
		 * Verify that the map is sensible.
		 */

		if (Tcl_DictObjFirst(interp, objv[1], &search,
			&subcmdObj, &listObj, &done) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		if (done) {
		    mapObj = NULL;
		    continue;
		}
		do {
		    Tcl_Obj **listv;
		    char *cmd;

		    if (TclListObjGetElements(interp, listObj, &len,
			    &listv) != TCL_OK) {
			Tcl_DictObjDone(&search);
			if (patchedDict) {
			    Tcl_DecrRefCount(patchedDict);
			}
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    if (len < 1) {
			Tcl_SetResult(interp,
				"ensemble subcommand implementations "
				"must be non-empty lists", TCL_STATIC);
			Tcl_DictObjDone(&search);
			if (patchedDict) {
			    Tcl_DecrRefCount(patchedDict);
			}
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    cmd = TclGetString(listv[0]);
		    if (!(cmd[0] == ':' && cmd[1] == ':')) {
			Tcl_Obj *newList = Tcl_NewListObj(len, listv);
			Tcl_Obj *newCmd = Tcl_NewStringObj(nsPtr->fullName,-1);

			if (nsPtr->parentPtr) {
			    Tcl_AppendStringsToObj(newCmd, "::", NULL);
			}
			Tcl_AppendObjToObj(newCmd, listv[0]);
			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
			if (patchedDict == NULL) {
			    patchedDict = Tcl_DuplicateObj(objv[1]);
			}
			Tcl_DictObjPut(NULL, patchedDict, subcmdObj, newList);
		    }
		    Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
		} while (!done);

		if (allocatedMapFlag) {
		    Tcl_DecrRefCount(mapObj);
		}
		mapObj = (patchedDict ? patchedDict : objv[1]);
		if (patchedDict) {
		    allocatedMapFlag = 1;
		}
		continue;
	    }
	    case CRT_PREFIX:
		if (Tcl_GetBooleanFromObj(interp, objv[1],
			&permitPrefix) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		continue;
	    case CRT_UNKNOWN:
		if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		unknownObj = (len > 0 ? objv[1] : NULL);
		continue;
	    }
	}

	/*
	 * Create the ensemble. Note that this might delete another ensemble
	 * linked to the same namespace, so we must be careful. However, we
	 * should be OK because we only link the namespace into the list once
	 * we've created it (and after any deletions have occurred.)
	 */

	token = Tcl_CreateEnsemble(interp, name, NULL,
		(permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
	Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
	Tcl_SetEnsembleMappingDict(interp, token, mapObj);
	Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);

	/*
	 * Tricky! Must ensure that the result is not shared (command delete
	 * traces could have corrupted the pristine object that we started
	 * with). [Snit test rename-1.5]
	 */

	Tcl_ResetResult(interp);
	Tcl_GetCommandFullName(interp, token, Tcl_GetObjResult(interp));
	return TCL_OK;
    }

    case ENS_EXISTS:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname");
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		Tcl_FindEnsemble(interp, objv[3], 0) != NULL));
	return TCL_OK;

    case ENS_CONFIG:
	if (objc < 4 || (objc != 5 && objc & 1)) {
	    Tcl_WrongNumArgs(interp, 3, objv, "cmdname ?opt? ?value? ...");
	    return TCL_ERROR;
	}
	token = Tcl_FindEnsemble(interp, objv[3], TCL_LEAVE_ERR_MSG);
	if (token == NULL) {
	    return TCL_ERROR;
	}

	if (objc == 5) {
	    Tcl_Obj *resultObj = NULL;		/* silence gcc 4 warning */

	    if (Tcl_GetIndexFromObj(interp, objv[4], configOptions, "option",
		    0, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum EnsConfigOpts) index) {
	    case CONF_SUBCMDS:
		Tcl_GetEnsembleSubcommandList(NULL, token, &resultObj);
		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    case CONF_MAP:
		Tcl_GetEnsembleMappingDict(NULL, token, &resultObj);
		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    case CONF_NAMESPACE: {
		Tcl_Namespace *namespacePtr = NULL; /* silence gcc 4 warning */

		Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
		Tcl_SetResult(interp, ((Namespace *)namespacePtr)->fullName,
			TCL_VOLATILE);
		break;
	    }
	    case CONF_PREFIX: {
		int flags = 0;			/* silence gcc 4 warning */

		Tcl_GetEnsembleFlags(NULL, token, &flags);
		Tcl_SetObjResult(interp,
			Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));
		break;
	    }
	    case CONF_UNKNOWN:
		Tcl_GetEnsembleUnknownHandler(NULL, token, &resultObj);
		if (resultObj != NULL) {
		    Tcl_SetObjResult(interp, resultObj);
		}
		break;
	    }
	    return TCL_OK;

	} else if (objc == 4) {
	    /*
	     * Produce list of all information.
	     */

	    Tcl_Obj *resultObj, *tmpObj = NULL;	/* silence gcc 4 warning */
	    Tcl_Namespace *namespacePtr = NULL;	/* silence gcc 4 warning */
	    int flags = 0;			/* silence gcc 4 warning */

	    TclNewObj(resultObj);

	    /* -map option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(configOptions[CONF_MAP], -1));
	    Tcl_GetEnsembleMappingDict(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    /* -namespace option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(configOptions[CONF_NAMESPACE], -1));
	    Tcl_GetEnsembleNamespace(NULL, token, &namespacePtr);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(((Namespace *)namespacePtr)->fullName,
		    -1));

	    /* -prefix option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(configOptions[CONF_PREFIX], -1));
	    Tcl_GetEnsembleFlags(NULL, token, &flags);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewBooleanObj(flags & TCL_ENSEMBLE_PREFIX));

	    /* -subcommands option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(configOptions[CONF_SUBCMDS], -1));
	    Tcl_GetEnsembleSubcommandList(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    /* -unknown option */
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(configOptions[CONF_UNKNOWN], -1));
	    Tcl_GetEnsembleUnknownHandler(NULL, token, &tmpObj);
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    (tmpObj != NULL) ? tmpObj : Tcl_NewObj());

	    Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;
	} else {
	    Tcl_DictSearch search;
	    Tcl_Obj *listObj;
	    int done, len, allocatedMapFlag = 0;
	    Tcl_Obj *subcmdObj = NULL, *mapObj = NULL,
		    *unknownObj = NULL; /* Defaults, silence gcc 4 warnings */
	    int permitPrefix, flags = 0;	/* silence gcc 4 warning */

	    Tcl_GetEnsembleSubcommandList(NULL, token, &subcmdObj);
	    Tcl_GetEnsembleMappingDict(NULL, token, &mapObj);
	    Tcl_GetEnsembleUnknownHandler(NULL, token, &unknownObj);
	    Tcl_GetEnsembleFlags(NULL, token, &flags);
	    permitPrefix = (flags & TCL_ENSEMBLE_PREFIX) != 0;

	    objv += 4;
	    objc -= 4;

	    /*
	     * Parse the option list, applying type checks as we go. Note that
	     * we are not incrementing any reference counts in the objects at
	     * this stage, so the presence of an option multiple times won't
	     * cause any memory leaks.
	     */

	    for (; objc>0 ; objc-=2,objv+=2 ) {
		if (Tcl_GetIndexFromObj(interp, objv[0], configOptions,
			"option", 0, &index) != TCL_OK) {
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    return TCL_ERROR;
		}
		switch ((enum EnsConfigOpts) index) {
		case CONF_SUBCMDS:
		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    subcmdObj = (len > 0 ? objv[1] : NULL);
		    continue;
		case CONF_MAP: {
		    Tcl_Obj *patchedDict = NULL, *subcmdObj;

		    /*
		     * Verify that the map is sensible.
		     */

		    if (Tcl_DictObjFirst(interp, objv[1], &search,
			    &subcmdObj, &listObj, &done) != TCL_OK) {
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    if (done) {
			mapObj = NULL;
			continue;
		    }
		    do {
			Tcl_Obj **listv;
			char *cmd;

			if (TclListObjGetElements(interp, listObj, &len,
				&listv) != TCL_OK) {
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    if (allocatedMapFlag) {
				Tcl_DecrRefCount(mapObj);
			    }
			    return TCL_ERROR;
			}
			if (len < 1) {
			    Tcl_SetResult(interp,
				    "ensemble subcommand implementations "
				    "must be non-empty lists", TCL_STATIC);
			    Tcl_DictObjDone(&search);
			    if (patchedDict) {
				Tcl_DecrRefCount(patchedDict);
			    }
			    if (allocatedMapFlag) {
				Tcl_DecrRefCount(mapObj);
			    }
			    return TCL_ERROR;
			}
			cmd = TclGetString(listv[0]);
			if (!(cmd[0] == ':' && cmd[1] == ':')) {
			    Tcl_Obj *newList = Tcl_NewListObj(len, listv);
			    Tcl_Obj *newCmd =
				    Tcl_NewStringObj(nsPtr->fullName, -1);
			    if (nsPtr->parentPtr) {
				Tcl_AppendStringsToObj(newCmd, "::", NULL);
			    }
			    Tcl_AppendObjToObj(newCmd, listv[0]);
			    Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
			    if (patchedDict == NULL) {
				patchedDict = Tcl_DuplicateObj(objv[1]);
			    }
			    Tcl_DictObjPut(NULL, patchedDict, subcmdObj,
				    newList);
			}
			Tcl_DictObjNext(&search, &subcmdObj, &listObj, &done);
		    } while (!done);
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    mapObj = (patchedDict ? patchedDict : objv[1]);
		    if (patchedDict) {
			allocatedMapFlag = 1;
		    }
		    continue;
		}
		case CONF_NAMESPACE:
		    if (allocatedMapFlag) {
			Tcl_DecrRefCount(mapObj);
		    }
		    Tcl_AppendResult(interp, "option -namespace is read-only",
			    NULL);
		    return TCL_ERROR;
		case CONF_PREFIX:
		    if (Tcl_GetBooleanFromObj(interp, objv[1],
			    &permitPrefix) != TCL_OK) {
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    continue;
		case CONF_UNKNOWN:
		    if (TclListObjLength(interp, objv[1], &len) != TCL_OK) {
			if (allocatedMapFlag) {
			    Tcl_DecrRefCount(mapObj);
			}
			return TCL_ERROR;
		    }
		    unknownObj = (len > 0 ? objv[1] : NULL);
		    continue;
		}
	    }

	    /*
	     * Update the namespace now that we've finished the parsing stage.
	     */

	    flags = (permitPrefix ? flags|TCL_ENSEMBLE_PREFIX
		    : flags&~TCL_ENSEMBLE_PREFIX);
	    Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
	    Tcl_SetEnsembleMappingDict(interp, token, mapObj);
	    Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
	    Tcl_SetEnsembleFlags(interp, token, flags);
	    return TCL_OK;
	}

    default:
	Tcl_Panic("unexpected ensemble command");
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateEnsemble --
 *
 *	Create a simple ensemble attached to the given namespace.
 *
 * Results:
 *	The token for the command created.
 *
 * Side effects:
 *	The ensemble is created and marked for compilation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_CreateEnsemble(
    Tcl_Interp *interp,
    const char *name,
    Tcl_Namespace *namespacePtr,
    int flags)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    EnsembleConfig *ensemblePtr = (EnsembleConfig *)
	    ckalloc(sizeof(EnsembleConfig));
    Tcl_Obj *nameObj = NULL;

    if (nsPtr == NULL) {
	nsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    /*
     * Make the name of the ensemble into a fully qualified name. This might
     * allocate a temporary object.
     */

    if (!(name[0] == ':' && name[1] == ':')) {
	nameObj = Tcl_NewStringObj(nsPtr->fullName, -1);
	if (nsPtr->parentPtr == NULL) {
	    Tcl_AppendStringsToObj(nameObj, name, NULL);
	} else {
	    Tcl_AppendStringsToObj(nameObj, "::", name, NULL);
	}
	Tcl_IncrRefCount(nameObj);
	name = TclGetString(nameObj);
    }

    ensemblePtr->nsPtr = nsPtr;
    ensemblePtr->epoch = 0;
    Tcl_InitHashTable(&ensemblePtr->subcommandTable, TCL_STRING_KEYS);
    ensemblePtr->subcommandArrayPtr = NULL;
    ensemblePtr->subcmdList = NULL;
    ensemblePtr->subcommandDict = NULL;
    ensemblePtr->flags = flags;
    ensemblePtr->unknownHandler = NULL;
    ensemblePtr->token = Tcl_CreateObjCommand(interp, name,
	    NsEnsembleImplementationCmd, ensemblePtr, DeleteEnsembleConfig);
    ensemblePtr->next = (EnsembleConfig *) nsPtr->ensembles;
    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr;

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    nsPtr->exportLookupEpoch++;

    if (flags & ENSEMBLE_COMPILE) {
	((Command *) ensemblePtr->token)->compileProc = TclCompileEnsemble;
    }

    if (nameObj != NULL) {
	TclDecrRefCount(nameObj);
    }
    return ensemblePtr->token;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleSubcommandList --
 *
 *	Set the subcommand list for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an ensemble
 *	or the subcommand list - if non-NULL - is not a list).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleSubcommandList(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *subcmdList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	return TCL_ERROR;
    }
    if (subcmdList != NULL) {
	int length;

	if (TclListObjLength(interp, subcmdList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    subcmdList = NULL;
	}
    }

    ensemblePtr = cmdPtr->objClientData;
    oldList = ensemblePtr->subcmdList;
    ensemblePtr->subcmdList = subcmdList;
    if (subcmdList != NULL) {
	Tcl_IncrRefCount(subcmdList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
    }

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    /*
     * Special hack to make compiling of [info exists] work when the
     * dictionary is modified.
     */

    if (cmdPtr->compileProc != NULL) {
	((Interp *)interp)->compileEpoch++;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleMappingDict --
 *
 *	Set the mapping dictionary for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an ensemble
 *	or the mapping - if non-NULL - is not a dict).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleMappingDict(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *mapDict)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldDict;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	return TCL_ERROR;
    }
    if (mapDict != NULL) {
	int size, done;
	Tcl_DictSearch search;
	Tcl_Obj *valuePtr;

	if (Tcl_DictObjSize(interp, mapDict, &size) != TCL_OK) {
	    return TCL_ERROR;
	}

	for (Tcl_DictObjFirst(NULL, mapDict, &search, NULL, &valuePtr, &done);
		!done; Tcl_DictObjNext(&search, NULL, &valuePtr, &done)) {
	    Tcl_Obj *cmdPtr;
	    const char *bytes;

	    if (Tcl_ListObjIndex(interp, valuePtr, 0, &cmdPtr) != TCL_OK) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	    bytes = TclGetString(cmdPtr);
	    if (bytes[0] != ':' || bytes[1] != ':') {
		Tcl_AppendResult(interp,
			"ensemble target is not a fully-qualified command",
			NULL);
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}

	if (size < 1) {
	    mapDict = NULL;
	}
    }

    ensemblePtr = cmdPtr->objClientData;
    oldDict = ensemblePtr->subcommandDict;
    ensemblePtr->subcommandDict = mapDict;
    if (mapDict != NULL) {
	Tcl_IncrRefCount(mapDict);
    }
    if (oldDict != NULL) {
	TclDecrRefCount(oldDict);
    }

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    /*
     * Special hack to make compiling of [info exists] work when the
     * dictionary is modified.
     */

    if (cmdPtr->compileProc != NULL) {
	((Interp *)interp)->compileEpoch++;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleUnknownHandler --
 *
 *	Set the unknown handler for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an ensemble
 *	or the unknown handler - if non-NULL - is not a list).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleUnknownHandler(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj *unknownList)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    Tcl_Obj *oldList;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	return TCL_ERROR;
    }
    if (unknownList != NULL) {
	int length;

	if (TclListObjLength(interp, unknownList, &length) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (length < 1) {
	    unknownList = NULL;
	}
    }

    ensemblePtr = cmdPtr->objClientData;
    oldList = ensemblePtr->unknownHandler;
    ensemblePtr->unknownHandler = unknownList;
    if (unknownList != NULL) {
	Tcl_IncrRefCount(unknownList);
    }
    if (oldList != NULL) {
	TclDecrRefCount(oldList);
    }

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetEnsembleFlags --
 *
 *	Set the flags for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble).
 *
 * Side effects:
 *	The ensemble is updated and marked for recompilation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_SetEnsembleFlags(
    Tcl_Interp *interp,
    Tcl_Command token,
    int flags)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;
    int wasCompiled;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    wasCompiled = ensemblePtr->flags & ENSEMBLE_COMPILE;

    /*
     * This API refuses to set the ENS_DEAD flag...
     */

    ensemblePtr->flags &= ENS_DEAD;
    ensemblePtr->flags |= flags & ~ENS_DEAD;

    /*
     * Trigger an eventual recomputation of the ensemble command set. Note
     * that this is slightly tricky, as it means that we are not actually
     * counting the number of namespace export actions, but it is the simplest
     * way to go!
     */

    ensemblePtr->nsPtr->exportLookupEpoch++;

    /*
     * If the ENSEMBLE_COMPILE flag status was changed, install or remove the
     * compiler function and bump the interpreter's compilation epoch so that
     * bytecode gets regenerated.
     */

    if (flags & ENSEMBLE_COMPILE) {
	if (!wasCompiled) {
	    ((Command*) ensemblePtr->token)->compileProc = TclCompileEnsemble;
	    ((Interp *) interp)->compileEpoch++;
	}
    } else {
	if (wasCompiled) {
	    ((Command*) ensemblePtr->token)->compileProc = NULL;
	    ((Interp *) interp)->compileEpoch++;
	}
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleSubcommandList --
 *
 *	Get the list of subcommands associated with a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The list of subcommands is returned by updating the
 *	variable pointed to by the last parameter (NULL if this is to be
 *	derived from the mapping dictionary or the associated namespace's
 *	exported commands).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleSubcommandList(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **subcmdListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *subcmdListPtr = ensemblePtr->subcmdList;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleMappingDict --
 *
 *	Get the command mapping dictionary associated with a particular
 *	ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The mapping dict is returned by updating the variable
 *	pointed to by the last parameter (NULL if none is installed).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleMappingDict(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **mapDictPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *mapDictPtr = ensemblePtr->subcommandDict;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleUnknownHandler --
 *
 *	Get the unknown handler associated with a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The unknown handler is returned by updating the variable
 *	pointed to by the last parameter (NULL if no handler is installed).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleUnknownHandler(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Obj **unknownListPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *unknownListPtr = ensemblePtr->unknownHandler;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleFlags --
 *
 *	Get the flags for a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). The flags are returned by updating the variable pointed to
 *	by the last parameter.
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleFlags(
    Tcl_Interp *interp,
    Tcl_Command token,
    int *flagsPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	}
	return TCL_ERROR;
    }

    ensemblePtr = cmdPtr->objClientData;
    *flagsPtr = ensemblePtr->flags;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetEnsembleNamespace --
 *
 *	Get the namespace associated with a particular ensemble.
 *
 * Results:
 *	Tcl result code (error if command token does not indicate an
 *	ensemble). Namespace is returned by updating the variable pointed to
 *	by the last parameter.
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetEnsembleNamespace(
    Tcl_Interp *interp,
    Tcl_Command token,
    Tcl_Namespace **namespacePtrPtr)
{
    Command *cmdPtr = (Command *) token;
    EnsembleConfig *ensemblePtr;

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "command is not an ensemble", NULL);
	}
	return TCL_ERROR;
    }
    resNamePtr->refCount = 0;
    NsNameSetIntRep(objPtr, resNamePtr);

    ensemblePtr = cmdPtr->objClientData;
    *namespacePtrPtr = (Tcl_Namespace *) ensemblePtr->nsPtr;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindEnsemble --
 *
 *	Given a command name, get the ensemble token for it, allowing for
 *	[namespace import]s. [Bug 1017022]
 *
 * Results:
 *	The token for the ensemble command with the given name, or NULL if the
 *	command either does not exist or is not an ensemble (when an error
 *	message will be written into the interp if thats non-NULL).
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_FindEnsemble(
    Tcl_Interp *interp,		/* Where to do the lookup, and where to write
				 * the errors if TCL_LEAVE_ERR_MSG is set in
				 * the flags. */
    Tcl_Obj *cmdNameObj,	/* Name of command to look up. */
    int flags)			/* Either 0 or TCL_LEAVE_ERR_MSG; other flags
				 * are probably not useful. */
{
    Command *cmdPtr;

    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, TclGetString(cmdNameObj), NULL, flags);
    if (cmdPtr == NULL) {
	return NULL;
    }

    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
	/*
	 * Reuse existing infrastructure for following import link chains
	 * rather than duplicating it.
	 */

	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);

	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		Tcl_AppendResult(interp, "\"", TclGetString(cmdNameObj),
			"\" is not an ensemble command", NULL);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
			TclGetString(cmdNameObj), NULL);
	    }
	    return NULL;
	}
    }

    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsEnsemble --
 *
 *	Simple test for ensemble-hood that takes into account imported
 *	ensemble commands as well.
 *
 * Results:
 *	Boolean value
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
Tcl_IsEnsemble(
    Tcl_Command token)
{
    Command *cmdPtr = (Command *) token;
    if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
	return 1;
    }
    cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
    if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
	return 0;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMakeEnsemble --
 *
 *	Create an ensemble from a table of implementation commands. The
 *	ensemble will be subject to (limited) compilation if any of the
 *	implementation commands are compilable.
 *
 * Results:
 *	Handle for the ensemble, or NULL if creation of it fails.
 *
 * Side effects:
 *	May advance bytecode compilation epoch.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclMakeEnsemble(
    Tcl_Interp *interp,
    const char *name,
    const EnsembleImplMap map[])
{
    Tcl_Command ensemble;	/* The overall ensemble. */
    Tcl_Namespace *tclNsPtr;	/* Reference to the "::tcl" namespace. */
    Tcl_DString buf;

    tclNsPtr = Tcl_FindNamespace(interp, "::tcl", NULL,
	    TCL_CREATE_NS_IF_UNKNOWN);
    if (tclNsPtr == NULL) {
	Tcl_Panic("unable to find or create ::tcl namespace!");
    }
    Tcl_DStringInit(&buf);
    Tcl_DStringAppend(&buf, "::tcl::", -1);
    Tcl_DStringAppend(&buf, name, -1);
    tclNsPtr = Tcl_FindNamespace(interp, Tcl_DStringValue(&buf), NULL,
	    TCL_CREATE_NS_IF_UNKNOWN);
    if (tclNsPtr == NULL) {
	Tcl_Panic("unable to find or create %s namespace!",
		Tcl_DStringValue(&buf));
    }
    ensemble = Tcl_CreateEnsemble(interp, Tcl_DStringValue(&buf)+5, tclNsPtr,
	    TCL_ENSEMBLE_PREFIX);
    Tcl_DStringAppend(&buf, "::", -1);
    if (ensemble != NULL) {
	Tcl_Obj *mapDict;
	int i, compile = 0;
 * TclGetNamespaceCommandTable --
 *
 *	Returns the hash table of commands.
 *

	TclNewObj(mapDict);
	for (i=0 ; map[i].name != NULL ; i++) {
	    Tcl_Obj *fromObj, *toObj;
	    Command *cmdPtr;

	    fromObj = Tcl_NewStringObj(map[i].name, -1);
	    TclNewStringObj(toObj, Tcl_DStringValue(&buf),
		    Tcl_DStringLength(&buf));
	    Tcl_AppendToObj(toObj, map[i].name, -1);
	    Tcl_DictObjPut(NULL, mapDict, fromObj, toObj);
	    cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
		    TclGetString(toObj), map[i].proc, NULL, NULL);
	    cmdPtr->compileProc = map[i].compileProc;
	    compile |= (map[i].compileProc != NULL);
	}
	Tcl_SetEnsembleMappingDict(interp, ensemble, mapDict);
	if (compile) {
	    Tcl_SetEnsembleFlags(interp, ensemble,
		    TCL_ENSEMBLE_PREFIX | ENSEMBLE_COMPILE);
	}
    }
    Tcl_DStringFree(&buf);

    return ensemble;
}

/*
 *----------------------------------------------------------------------
 *
 * NsEnsembleImplementationCmd --
 *
 *	Implements an ensemble of commands (being those exported by a
 *	namespace other than the global namespace) as a command with the same
 *	(short) name as the namespace in the parent namespace.
 *
 * Results:
 *	A standard Tcl result code. Will be TCL_ERROR if the command is not an
 *	unambiguous prefix of any command exported by the ensemble's
 *	namespace.
 *
 * Side effects:
 *	Depends on the command within the namespace that gets executed. If the
 *	ensemble itself returns TCL_ERROR, a descriptive error message will be
 *	placed in the interpreter's result.
 *
 *----------------------------------------------------------------------
 */
 *	Pointer to the hash table.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashTable *
TclGetNamespaceCommandTable(
    Tcl_Namespace *nsPtr)

static int
NsEnsembleImplementationCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    EnsembleConfig *ensemblePtr = clientData;
				/* The ensemble itself. */
    Tcl_Obj **tempObjv;		/* Space used to construct the list of
				 * arguments to pass to the command that
				 * implements the ensemble subcommand. */
    int result;			/* The result of the subcommand execution. */
    Tcl_Obj *prefixObj;		/* An object containing the prefix words of
				 * the command that implements the
				 * subcommand. */
    Tcl_HashEntry *hPtr;	/* Used for efficient lookup of fully
				 * specified but not yet cached command
				 * names. */
    Tcl_Obj **prefixObjv;	/* The list of objects to substitute in as the
				 * target command prefix. */
    int prefixObjc;		/* Size of prefixObjv of course! */
    int reparseCount = 0;	/* Number of reparses. */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?argument ...?");
	return TCL_ERROR;
    }

  restartEnsembleParse:
    if (ensemblePtr->nsPtr->flags & NS_DYING) {
	/*
	 * Don't know how we got here, but make things give up quickly.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_AppendResult(interp,
		    "ensemble activated for deleted namespace", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Determine if the table of subcommands is right. If so, we can just look
     * up in there and go straight to dispatch.
     */

    if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
	/*
	 * Table of subcommands is still valid; therefore there might be a
	 * valid cache of discovered information which we can reuse. Do the
	 * check here, and if we're still valid, we can jump straight to the
	 * part where we do the invocation of the subcommand.
	 */

	if (objv[1]->typePtr == &tclEnsembleCmdType) {
	    EnsembleCmdRep *ensembleCmd = objv[1]->internalRep.twoPtrValue.ptr1;

	    if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
		    ensembleCmd->epoch == ensemblePtr->epoch &&
		    ensembleCmd->token == ensemblePtr->token) {
		prefixObj = ensembleCmd->realPrefixObj;
		Tcl_IncrRefCount(prefixObj);
		goto runResultingSubcommand;
	    }
	}
    } else {
	BuildEnsembleConfig(ensemblePtr);
	ensemblePtr->epoch = ensemblePtr->nsPtr->exportLookupEpoch;
    }

    /*
     * Look in the hashtable for the subcommand name; this is the fastest way
     * of all.
     */

    hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
	    TclGetString(objv[1]));
    if (hPtr != NULL) {
	char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);

	prefixObj = Tcl_GetHashValue(hPtr);

	/*
	 * Cache for later in the subcommand object.
	 */

	MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
    } else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
	/*
	 * Could not map, no prefixing, go to unknown/error handling.
	 */

	goto unknownOrAmbiguousSubcommand;
    } else {
	/*
	 * If we've not already confirmed the command with the hash as part of
	 * building our export table, we need to scan the sorted array for
	 * matches.
	 */

	char *subcmdName;	/* Name of the subcommand, or unique prefix of
				 * it (will be an error for a non-unique
				 * prefix). */
	char *fullName = NULL;	/* Full name of the subcommand. */
	int stringLength, i;
	int tableLength = ensemblePtr->subcommandTable.numEntries;

	subcmdName = TclGetString(objv[1]);
	stringLength = objv[1]->length;
	for (i=0 ; i<tableLength ; i++) {
	    register int cmp = strncmp(subcmdName,
		    ensemblePtr->subcommandArrayPtr[i],
		    (unsigned) stringLength);

	    if (cmp == 0) {
		if (fullName != NULL) {
		    /*
		     * Since there's never the exact-match case to worry about
		     * (hash search filters this), getting here indicates that
		     * our subcommand is an ambiguous prefix of (at least) two
		     * exported subcommands, which is an error case.
		     */

		    goto unknownOrAmbiguousSubcommand;
		}
		fullName = ensemblePtr->subcommandArrayPtr[i];
	    } else if (cmp < 0) {
		/*
		 * Because we are searching a sorted table, we can now stop
		 * searching because we have gone past anything that could
		 * possibly match.
		 */

		break;
	    }
	}
	if (fullName == NULL) {
	    /*
	     * The subcommand is not a prefix of anything, so bail out!
	     */

	    goto unknownOrAmbiguousSubcommand;
	}
	hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable, fullName);
	if (hPtr == NULL) {
	    Tcl_Panic("full name %s not found in supposedly synchronized hash",
		    fullName);
	}
	prefixObj = Tcl_GetHashValue(hPtr);

	/*
	 * Cache for later in the subcommand object.
	 */

	MakeCachedEnsembleCommand(objv[1], ensemblePtr, fullName, prefixObj);
    }

    Tcl_IncrRefCount(prefixObj);
  runResultingSubcommand:

    /*
     * Do the real work of execution of the subcommand by building an array of
     * objects (note that this is potentially not the same length as the
     * number of arguments to this ensemble command), populating it and then
     * feeding it back through the main command-lookup engine. In theory, we
     * could look up the command in the namespace ourselves, as we already
     * have the namespace in which it is guaranteed to exist, but we don't do
     * that (the cacheing of the command object used should help with that.)
     */

    {
	Interp *iPtr = (Interp *) interp;
	int isRootEnsemble;
	Tcl_Obj *copyObj;

	/*
	 * Get the prefix that we're rewriting to. To do this we need to
	 * ensure that the internal representation of the list does not change
	 * so that we can safely keep the internal representations of the
	 * elements in the list.
	 */

	copyObj = TclListObjCopy(NULL, prefixObj);
	TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv);

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message.
	 */

	isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
	if (isRootEnsemble) {
	    iPtr->ensembleRewrite.sourceObjs = objv;
	    iPtr->ensembleRewrite.numRemovedObjs = 2;
	    iPtr->ensembleRewrite.numInsertedObjs = prefixObjc;
	} else {
	    int ni = iPtr->ensembleRewrite.numInsertedObjs;

	    if (ni < 2) {
		iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
	    } else {
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
	    }
	}

	/*
	 * Allocate a workspace and build the list of arguments to pass to the
	 * target command in it.
	 */

	tempObjv = (Tcl_Obj **) TclStackAlloc(interp,
		(int) sizeof(Tcl_Obj *) * (objc - 2 + prefixObjc));
	memcpy(tempObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
	memcpy(tempObjv+prefixObjc, objv+2, sizeof(Tcl_Obj *) * (objc-2));

	/*
	 * Hand off to the target command.
	 */

	result = Tcl_EvalObjv(interp, objc-2+prefixObjc, tempObjv,
		TCL_EVAL_INVOKE);

	/*
	 * Clean up.
	 */

	TclStackFree(interp, tempObjv);
	Tcl_DecrRefCount(copyObj);
	if (isRootEnsemble) {
	    iPtr->ensembleRewrite.sourceObjs = NULL;
	    iPtr->ensembleRewrite.numRemovedObjs = 0;
	    iPtr->ensembleRewrite.numInsertedObjs = 0;
	}
    }
    Tcl_DecrRefCount(prefixObj);
    return result;

  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
     * particular ensemble invocation.
     */

    if (ensemblePtr->unknownHandler != NULL && reparseCount++ < 1) {
	int paramc, i;
	Tcl_Obj **paramv, *unknownCmd, *ensObj;

	unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
	TclNewObj(ensObj);
	Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
	Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
	for (i=1 ; i<objc ; i++) {
	    Tcl_ListObjAppendElement(NULL, unknownCmd, objv[i]);
	}
	TclListObjGetElements(NULL, unknownCmd, &paramc, &paramv);
	Tcl_Preserve(ensemblePtr);
	Tcl_IncrRefCount(unknownCmd);
	result = Tcl_EvalObjv(interp, paramc, paramv, 0);
	if (result == TCL_OK) {
	    prefixObj = Tcl_GetObjResult(interp);
	    Tcl_IncrRefCount(prefixObj);
	    Tcl_DecrRefCount(unknownCmd);
	    Tcl_Release(ensemblePtr);
	    Tcl_ResetResult(interp);
	    if (ensemblePtr->flags & ENS_DEAD) {
		Tcl_DecrRefCount(prefixObj);
		Tcl_SetResult(interp,
			"unknown subcommand handler deleted its ensemble",
			TCL_STATIC);
		return TCL_ERROR;
	    }

	    /*
	     * Namespace is still there. Check if the result is a valid list.
	     * If it is, and it is non-empty, that list is what we are using
	     * as our replacement.
	     */

	    if (TclListObjLength(interp, prefixObj, &prefixObjc) != TCL_OK) {
		Tcl_DecrRefCount(prefixObj);
		Tcl_AddErrorInfo(interp, "\n    while parsing result of "
			"ensemble unknown subcommand handler");
		return TCL_ERROR;
	    }
	    if (prefixObjc > 0) {
		goto runResultingSubcommand;
	    }

	    /*
	     * Namespace alive & empty result => reparse.
	     */

	    Tcl_DecrRefCount(prefixObj);
	    goto restartEnsembleParse;
	}
	if (!Tcl_InterpDeleted(interp)) {
	    if (result != TCL_ERROR) {
		char buf[TCL_INTEGER_SPACE];

		Tcl_ResetResult(interp);
		Tcl_SetResult(interp,
			"unknown subcommand handler returned bad code: ",
			TCL_STATIC);
		switch (result) {
		case TCL_RETURN:
		    Tcl_AppendResult(interp, "return", NULL);
		    break;
		case TCL_BREAK:
		    Tcl_AppendResult(interp, "break", NULL);
		    break;
		case TCL_CONTINUE:
		    Tcl_AppendResult(interp, "continue", NULL);
		    break;
		default:
		    sprintf(buf, "%d", result);
		    Tcl_AppendResult(interp, buf, NULL);
		}
		Tcl_AddErrorInfo(interp, "\n    result of "
			"ensemble unknown subcommand handler: ");
		Tcl_AddErrorInfo(interp, TclGetString(unknownCmd));
	    } else {
		Tcl_AddErrorInfo(interp,
			"\n    (ensemble unknown subcommand handler)");
	    }
	}
	Tcl_DecrRefCount(unknownCmd);
	Tcl_Release(ensemblePtr);
	return TCL_ERROR;
    }

    /*
     * We cannot determine what subcommand to hand off to, so generate a
     * (standard) failure message. Note the one odd case compared with
     * standard ensemble-like command, which is where a namespace has no
     * exported commands at all...
     */

    Tcl_ResetResult(interp);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ENSEMBLE",
	    TclGetString(objv[1]), NULL);
    if (ensemblePtr->subcommandTable.numEntries == 0) {
	Tcl_AppendResult(interp, "unknown subcommand \"",TclGetString(objv[1]),
		"\": namespace ", ensemblePtr->nsPtr->fullName,
		" does not export any commands", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
		TclGetString(objv[1]), NULL);
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "unknown ",
	    (ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? "or ambiguous " : ""),
	    "subcommand \"", TclGetString(objv[1]), "\": must be ", NULL);
    if (ensemblePtr->subcommandTable.numEntries == 1) {
	Tcl_AppendResult(interp, ensemblePtr->subcommandArrayPtr[0], NULL);
    } else {
	int i;

	for (i=0 ; i<ensemblePtr->subcommandTable.numEntries-1 ; i++) {
	    Tcl_AppendResult(interp,
		    ensemblePtr->subcommandArrayPtr[i], ", ", NULL);
	}
	Tcl_AppendResult(interp, "or ",
		ensemblePtr->subcommandArrayPtr[i], NULL);
    }
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
	    TclGetString(objv[1]), NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * MakeCachedEnsembleCommand --
 *
 *	Cache what we've computed so far; it's not nice to repeatedly copy
 *	strings about. Note that to do this, we start by deleting any old
 *	representation that there was (though if it was an out of date
 *	ensemble rep, we can skip some of the deallocation process.)
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Alters the internal representation of the first object parameter.
 *
 *----------------------------------------------------------------------
 */

static void
MakeCachedEnsembleCommand(
    Tcl_Obj *objPtr,
    EnsembleConfig *ensemblePtr,
    const char *subcommandName,
    Tcl_Obj *prefixObjPtr)
{
    register EnsembleCmdRep *ensembleCmd;
    int length;

    if (objPtr->typePtr == &tclEnsembleCmdType) {
	ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
	Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
	ensembleCmd->nsPtr->refCount--;
	if ((ensembleCmd->nsPtr->refCount == 0)
		&& (ensembleCmd->nsPtr->flags & NS_DEAD)) {
	    NamespaceFree(ensembleCmd->nsPtr);
	}
	ckfree(ensembleCmd->fullSubcmdName);
    } else {
	/*
	 * Kill the old internal rep, and replace it with a brand new one of
	 * our own.
	 */

	TclFreeIntRep(objPtr);
	ensembleCmd = (EnsembleCmdRep *) ckalloc(sizeof(EnsembleCmdRep));
	objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
	objPtr->typePtr = &tclEnsembleCmdType;
    }

    /*
     * Populate the internal rep.
     */

    ensembleCmd->nsPtr = ensemblePtr->nsPtr;
    ensembleCmd->epoch = ensemblePtr->epoch;
    ensembleCmd->token = ensemblePtr->token;
    ensemblePtr->nsPtr->refCount++;
    ensembleCmd->realPrefixObj = prefixObjPtr;
    length = strlen(subcommandName)+1;
    ensembleCmd->fullSubcmdName = ckalloc((unsigned) length);
    memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
    Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteEnsembleConfig --
 *
 *	Destroys the data structure used to represent an ensemble. This is
 *	called when the ensemble's command is deleted (which happens
 *	automatically if the ensemble's namespace is deleted.) Maintainers
 *	should note that ensembles should be deleted by deleting their
 *	commands.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is (eventually) deallocated.
 *
 *----------------------------------------------------------------------
 */

static void
ClearTable(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;

    if (hash->numEntries != 0) {
	Tcl_HashSearch search;
	Tcl_HashEntry *hPtr = Tcl_FirstHashEntry(hash, &search);

	while (hPtr != NULL) {
	    Tcl_Obj *prefixObj = Tcl_GetHashValue(hPtr);
	    Tcl_DecrRefCount(prefixObj);
	    hPtr = Tcl_NextHashEntry(&search);
	}
	ckfree((char *) ensemblePtr->subcommandArrayPtr);
    }
    Tcl_DeleteHashTable(hash);
}

static void
DeleteEnsembleConfig(
    ClientData clientData)
{
    EnsembleConfig *ensemblePtr = clientData;
    Namespace *nsPtr = ensemblePtr->nsPtr;

    /*
     * Unlink from the ensemble chain if it has not been marked as having been
     * done already.
     */

    if (ensemblePtr->next != ensemblePtr) {
	EnsembleConfig *ensPtr = (EnsembleConfig *) nsPtr->ensembles;
	if (ensPtr == ensemblePtr) {
	    nsPtr->ensembles = (Tcl_Ensemble *) ensemblePtr->next;
	} else {
	    while (ensPtr != NULL) {
		if (ensPtr->next == ensemblePtr) {
		    ensPtr->next = ensemblePtr->next;
		    break;
		}
		ensPtr = ensPtr->next;
	    }
	}
    }

    /*
     * Mark the namespace as dead so code that uses Tcl_Preserve() can tell
     * whether disaster happened anyway.
     */

    ensemblePtr->flags |= ENS_DEAD;

    /*
     * Kill the pointer-containing fields.
     */

    ClearTable(ensemblePtr);

    if (ensemblePtr->subcmdList != NULL) {
	Tcl_DecrRefCount(ensemblePtr->subcmdList);
    }
    if (ensemblePtr->subcommandDict != NULL) {
	Tcl_DecrRefCount(ensemblePtr->subcommandDict);
    }
    if (ensemblePtr->unknownHandler != NULL) {
	Tcl_DecrRefCount(ensemblePtr->unknownHandler);
    }

    /*
     * Arrange for the structure to be reclaimed. Note that this is complex
     * because we have to make sure that we can react sensibly when an
     * ensemble is deleted during the process of initialising the ensemble
     * (especially the unknown callback.)
     */

    Tcl_EventuallyFree(ensemblePtr, TCL_DYNAMIC);
}

/*
 *----------------------------------------------------------------------
 *
 * BuildEnsembleConfig --
 *
 *	Create the internal data structures that describe how an ensemble
 *	looks, being a hash mapping from the full command name to the Tcl list
 *	that describes the implementation prefix words, and a sorted array of
 *	all the full command names to allow for reasonably efficient
 *	unambiguous prefix handling.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Reallocates and rebuilds the hash table and array stored at the
 *	ensemblePtr argument. For large ensembles or large namespaces, this is
 *	a potentially expensive operation.
 *
 *----------------------------------------------------------------------
 */

static void
BuildEnsembleConfig(
    EnsembleConfig *ensemblePtr)
{
    Tcl_HashSearch search;	/* Used for scanning the set of commands in
				 * the namespace that backs up this
				 * ensemble. */
    int i, j, isNew;
    Tcl_HashTable *hash = &ensemblePtr->subcommandTable;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *mapDict = ensemblePtr->subcommandDict;
    Tcl_Obj *subList = ensemblePtr->subcmdList;

    ClearTable(ensemblePtr);
    Tcl_InitHashTable(hash, TCL_STRING_KEYS);

    if (subList) {
	int subc;
	Tcl_Obj **subv, *target, *cmdObj, *cmdPrefixObj;
	char *name;

	/*
	 * There is a list of exactly what subcommands go in the table.
	 * Must determine the target for each.
	 */

	Tcl_ListObjGetElements(NULL, subList, &subc, &subv);
	if (subList == mapDict) {
	    /*
	     * Strange case where explicit list of subcommands is same value
	     * as the dict mapping to targets.
	     */

	    for (i = 0; i < subc; i += 2) {
		name = TclGetString(subv[i]);
		hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
		if (!isNew) {
		    cmdObj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		    Tcl_DecrRefCount(cmdObj);
		}
		Tcl_SetHashValue(hPtr, subv[i+1]);
		Tcl_IncrRefCount(subv[i+1]);

		name = TclGetString(subv[i+1]);
		hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
		if (isNew) {
		    cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
		    if (ensemblePtr->nsPtr->parentPtr != NULL) {
			Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
		    } else {
			Tcl_AppendStringsToObj(cmdObj, name, NULL);
		    }
		    cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
		    Tcl_SetHashValue(hPtr, cmdPrefixObj);
		    Tcl_IncrRefCount(cmdPrefixObj);
		}
	    }
	} else {
	    /* Usual case where we can freely act on the list and dict. */

	    for (i = 0; i < subc; i++) {
		name = TclGetString(subv[i]);
		hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
		if (!isNew) {
		    continue;
		}

		/* Lookup target in the dictionary */
		if (mapDict) {
		    Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
		    if (target) {
			Tcl_SetHashValue(hPtr, target);
			Tcl_IncrRefCount(target);
			continue;
		    }
		}

		/*
		 * target was not in the dictionary so map onto the namespace.
		 * Note in this case that we do not guarantee that the
		 * command is actually there; that is the programmer's
		 * responsibility (or [::unknown] of course).
		 */
		cmdObj = Tcl_NewStringObj(ensemblePtr->nsPtr->fullName, -1);
		if (ensemblePtr->nsPtr->parentPtr != NULL) {
		    Tcl_AppendStringsToObj(cmdObj, "::", name, NULL);
		} else {
		    Tcl_AppendStringsToObj(cmdObj, name, NULL);
		}
		cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
		Tcl_SetHashValue(hPtr, cmdPrefixObj);
		Tcl_IncrRefCount(cmdPrefixObj);
	    }
	}
    } else if (mapDict) {
        /*
         * No subcmd list, but we do have a mapping dictionary so we should
         * use the keys of that. Convert the dictionary's contents into the
         * form required for the ensemble's internal hashtable.
         */

        Tcl_DictSearch dictSearch;
        Tcl_Obj *keyObj, *valueObj;
        int done;

        Tcl_DictObjFirst(NULL, ensemblePtr->subcommandDict, &dictSearch,
                &keyObj, &valueObj, &done);
        while (!done) {
            char *name = TclGetString(keyObj);

            hPtr = Tcl_CreateHashEntry(hash, name, &isNew);
            Tcl_SetHashValue(hPtr, valueObj);
            Tcl_IncrRefCount(valueObj);
            Tcl_DictObjNext(&dictSearch, &keyObj, &valueObj, &done);
        }
    } else {
	/*
	 * Discover what commands are actually exported by the namespace.
	 * What we have is an array of patterns and a hash table whose keys
	 * are the command names exported by the namespace (the contents do
	 * not matter here.) We must find out what commands are actually
	 * exported by filtering each command in the namespace against each of
	 * the patterns in the export list. Note that we use an intermediate
	 * hash table to make memory management easier, and because that makes
	 * exact matching far easier too.
	 *
	 * Suggestion for future enhancement: compute the unique prefixes and
	 * place them in the hash too, which should make for even faster
	 * matching.
	 */

	hPtr = Tcl_FirstHashEntry(&ensemblePtr->nsPtr->cmdTable, &search);
	for (; hPtr!= NULL ; hPtr=Tcl_NextHashEntry(&search)) {
	    char *nsCmdName =		/* Name of command in namespace. */
		    Tcl_GetHashKey(&ensemblePtr->nsPtr->cmdTable, hPtr);

	    for (i=0 ; i<ensemblePtr->nsPtr->numExportPatterns ; i++) {
		if (Tcl_StringMatch(nsCmdName,
			ensemblePtr->nsPtr->exportArrayPtr[i])) {
		    hPtr = Tcl_CreateHashEntry(hash, nsCmdName, &isNew);

		    /*
		     * Remember, hash entries have a full reference to the
		     * substituted part of the command (as a list) as their
		     * content!
		     */

		    if (isNew) {
			Tcl_Obj *cmdObj, *cmdPrefixObj;

			TclNewObj(cmdObj);
			Tcl_AppendStringsToObj(cmdObj,
				ensemblePtr->nsPtr->fullName,
				(ensemblePtr->nsPtr->parentPtr ? "::" : ""),
				nsCmdName, NULL);
			cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
			Tcl_SetHashValue(hPtr, cmdPrefixObj);
			Tcl_IncrRefCount(cmdPrefixObj);
		    }
		    break;
		}
	    }
	}
    }

    if (hash->numEntries == 0) {
	ensemblePtr->subcommandArrayPtr = NULL;
	return;
    }

    /*
     * Create a sorted array of all subcommands in the ensemble; hash tables
     * are all very well for a quick look for an exact match, but they can't
     * determine things like whether a string is a prefix of another (not
     * without lots of preparation anyway) and they're no good for when we're
     * generating the error message either.
     *
     * We do this by filling an array with the names (we use the hash keys
     * directly to save a copy, since any time we change the array we change
     * the hash too, and vice versa) and running quicksort over the array.
     */

    ensemblePtr->subcommandArrayPtr = (char **)
	    ckalloc(sizeof(char *) * hash->numEntries);

    /*
     * Fill array from both ends as this makes us less likely to end up with
     * performance problems in qsort(), which is good. Note that doing this
     * makes this code much more opaque, but the naive alternatve:
     *
     * for (hPtr=Tcl_FirstHashEntry(hash,&search),i=0 ;
     *	       hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search),i++) {
     *     ensemblePtr->subcommandArrayPtr[i] = Tcl_GetHashKey(hash, &hPtr);
     * }
     *
     * can produce long runs of precisely ordered table entries when the
     * commands in the namespace are declared in a sorted fashion (an ordering
     * some people like) and the hashing functions (or the command names
     * themselves) are fairly unfortunate. By filling from both ends, it
     * requires active malice (and probably a debugger) to get qsort() to have
     * awful runtime behaviour.
     */

    i = 0;
    j = hash->numEntries;
    hPtr = Tcl_FirstHashEntry(hash, &search);
    while (hPtr != NULL) {
	ensemblePtr->subcommandArrayPtr[i++] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
	if (hPtr == NULL) {
	    break;
	}
	ensemblePtr->subcommandArrayPtr[--j] = Tcl_GetHashKey(hash, hPtr);
	hPtr = Tcl_NextHashEntry(&search);
    }
    if (hash->numEntries > 1) {
	qsort(ensemblePtr->subcommandArrayPtr, (unsigned)hash->numEntries,
		sizeof(char *), NsEnsembleStringOrder);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NsEnsembleStringOrder --
 *
 *	Helper function to compare two pointers to two strings for use with
 *	qsort().
 *
 * Results:
 *	-1 if the first string is smaller, 1 if the second string is smaller,
 *	and 0 if they are equal.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NsEnsembleStringOrder(
    const void *strPtr1,
    const void *strPtr2)
{
    return strcmp(*(const char **)strPtr1, *(const char **)strPtr2);
}
    return &((Namespace *) nsPtr)->cmdTable;

/*
 *----------------------------------------------------------------------
 *
 * FreeEnsembleCmdRep --
 *
 *	Destroys the internal representation of a Tcl_Obj that has been
 *	holding information about a command in an ensemble.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is deallocated. If this held the last reference to a
 *	namespace's main structure, that main structure will also be
 *	destroyed.
 *
 *----------------------------------------------------------------------
 */

static void
FreeEnsembleCmdRep(
    Tcl_Obj *objPtr)
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;

    Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
    ckfree(ensembleCmd->fullSubcmdName);
    ensembleCmd->nsPtr->refCount--;
    if ((ensembleCmd->nsPtr->refCount == 0)
	    && (ensembleCmd->nsPtr->flags & NS_DEAD)) {
	NamespaceFree(ensembleCmd->nsPtr);
    }
    ckfree((char *) ensembleCmd);
}

/*
 *----------------------------------------------------------------------
 *
 * DupEnsembleCmdRep --
 *
 *	Makes one Tcl_Obj into a copy of another that is a subcommand of an
 *	ensemble.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is allocated, and the namespace that the ensemble is built on
 *	top of gains another reference.
 *
 *----------------------------------------------------------------------
 */

static void
DupEnsembleCmdRep(
    Tcl_Obj *objPtr,
    Tcl_Obj *copyPtr)
{
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
    EnsembleCmdRep *ensembleCopy = (EnsembleCmdRep *)
	    ckalloc(sizeof(EnsembleCmdRep));
    int length = strlen(ensembleCmd->fullSubcmdName);

    copyPtr->typePtr = &tclEnsembleCmdType;
    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
    ensembleCopy->nsPtr = ensembleCmd->nsPtr;
    ensembleCopy->epoch = ensembleCmd->epoch;
    ensembleCopy->token = ensembleCmd->token;
    ensembleCopy->nsPtr->refCount++;
    ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
    Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
    ensembleCopy->fullSubcmdName = ckalloc((unsigned) length+1);
    memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
	    (unsigned) length+1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetNamespaceChildTable --
 * StringOfEnsembleCmdRep --
 *
 *	Creates a string representation of a Tcl_Obj that holds a subcommand
 *	Returns the hash table of child namespaces.
 *	of an ensemble.
 *
 * Results:
 *	Pointer to the hash table.
 *	None.
 *
 * Side effects:
 *	Might allocate memory.
 *	The object gains a string (UTF-8) representation.
 *
 *----------------------------------------------------------------------
 */

static void
Tcl_HashTable *
StringOfEnsembleCmdRep(
TclGetNamespaceChildTable(
    Tcl_Namespace *nsPtr)
    Tcl_Obj *objPtr)
{
    Namespace *nPtr = (Namespace *) nsPtr;
#ifndef BREAK_NAMESPACE_COMPAT
    return &nPtr->childTable;
    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
#else
    if (nPtr->childTablePtr == NULL) {
	nPtr->childTablePtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(nPtr->childTablePtr, TCL_STRING_KEYS);
    }
    return nPtr->childTablePtr;
    int length = strlen(ensembleCmd->fullSubcmdName);

    objPtr->length = length;
#endif
    objPtr->bytes = ckalloc((unsigned) length+1);
    memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclLogCommandInfo --
 * Tcl_LogCommandInfo --
 *
 *	This function is invoked after an error occurs in an interpreter. It
 *	adds information to iPtr->errorInfo/errorStack fields to describe the
 *	command that was being executed when the error occurred. When pc and
 *	adds information to iPtr->errorInfo field to describe the command that
 *	was being executed when the error occurred.
 *	tosPtr are non-NULL, conveying a bytecode execution "inner context",
 *	and the offending instruction is suitable, that inner context is
 *	recorded in errorStack.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information about the command is added to errorInfo/errorStack and the
 *	line number stored internally in the interpreter is set.
 *	Information about the command is added to errorInfo and the line
 *	number stored internally in the interpreter is set.
 *
 *----------------------------------------------------------------------
 */

void
TclLogCommandInfo(
Tcl_LogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    size_t length,			/* Number of bytes in command (-1 means
				 * use all bytes up to first null byte). */
    int length)			/* Number of bytes in command (-1 means use
				 * all bytes up to first null byte). */
    const unsigned char *pc,    /* Current pc of bytecode execution context */
    Tcl_Obj **tosPtr)		/* Current stack of bytecode execution
				 * context */
{
    const char *p;
    register const char *p;
    Interp *iPtr = (Interp *) interp;
    int overflow, limit = 150;
    Var *varPtr, *arrayPtr;

    if (iPtr->flags & ERR_ALREADY_LOGGED) {
	/*
	 * Someone else has already logged error information for this command;
	 * we shouldn't add anything more.
	 */

	return;
    }

    if (command != NULL) {
	/*
	 * Compute the line number where the error occurred.
	 */
    /*
     * Compute the line number where the error occurred.
     */

	iPtr->errorLine = 1;
	for (p = script; p != command; p++) {
	    if (*p == '\n') {
		iPtr->errorLine++;
	    }
	}
    iPtr->errorLine = 1;
    for (p = script; p != command; p++) {
	if (*p == '\n') {
	    iPtr->errorLine++;
	}
    }

	if (length == TCL_INDEX_NONE) {
	    length = strlen(command);
	}
	overflow = (length > (size_t)limit);
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
		? "while executing" : "invoked from within"),
    if (length < 0) {
	length = strlen(command);
    }
    overflow = (length > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL)
	    ? "while executing" : "invoked from within"),
		(overflow ? limit : (int)length), command,
		(overflow ? "..." : "")));
	    (overflow ? limit : length), command, (overflow ? "..." : "")));

	varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
		NULL, 0, 0, &arrayPtr);
	if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
	    /*
	     * Should not happen.
	     */
    varPtr = TclObjLookupVarEx(interp, iPtr->eiVar, NULL, TCL_GLOBAL_ONLY,
	    NULL, 0, 0, &arrayPtr);
    if ((varPtr == NULL) || !TclIsVarTraced(varPtr)) {
	/*
	 * Should not happen.
	 */

	    return;
	} else {
	    Tcl_HashEntry *hPtr
		    = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
	    VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);
	return;
    } else {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
		(char *) varPtr);
	VarTrace *tracePtr = Tcl_GetHashValue(hPtr);

	    if (tracePtr->traceProc != EstablishErrorInfoTraces) {
		/*
		 * The most recent trace set on ::errorInfo is not the one the
		 * core itself puts on last. This means some other code is
		 * tracing the variable, and the additional trace(s) might be
		 * write traces that expect the timing of writes to
	if (tracePtr->traceProc != EstablishErrorInfoTraces) {
	    /*
	     * The most recent trace set on ::errorInfo is not the one the
	     * core itself puts on last. This means some other code is tracing
	     * the variable, and the additional trace(s) might be write traces
	     * that expect the timing of writes to ::errorInfo that existed
		 * ::errorInfo that existed Tcl releases before 8.5. To
		 * satisfy that compatibility need, we write the current
		 * -errorinfo value to the ::errorInfo variable.
		 */
	     * Tcl releases before 8.5. To satisfy that compatibility need, we
	     * write the current -errorinfo value to the ::errorInfo variable.
	     */

		Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
			TCL_GLOBAL_ONLY);
	    }
	}
    }
	    Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL, iPtr->errorInfo,
		    TCL_GLOBAL_ONLY);
	}
    }
}

    /*
     * TIP #348
     */

    if (Tcl_IsShared(iPtr->errorStack)) {
	Tcl_Obj *newObj;

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
	Tcl_DecrRefCount(iPtr->errorStack);
	Tcl_IncrRefCount(newObj);
	iPtr->errorStack = newObj;
    }
    if (iPtr->resetErrorStack) {
	int len;

	iPtr->resetErrorStack = 0;
	Tcl_ListObjLength(interp, iPtr->errorStack, &len);

	/*
	 * Reset while keeping the list intrep as much as possible.
	 */

	Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
	if (pc != NULL) {
	    Tcl_Obj *innerContext;

	    innerContext = TclGetInnerContext(interp, pc, tosPtr);
	    if (innerContext != NULL) {
		Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
			iPtr->innerLiteral);
		Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext);
	    }
	} else if (command != NULL) {
	    Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
		    iPtr->innerLiteral);
	    Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
		    Tcl_NewStringObj(command, length));
	}
    }

    if (!iPtr->framePtr->objc) {
	/*
	 * Special frame, nothing to report.
	 */
    } else if (iPtr->varFramePtr != iPtr->framePtr) {
	/*
	 * uplevel case, [lappend errorstack UP $relativelevel]
	 */

	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->upLiteral);
	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewWideIntObj(
		iPtr->framePtr->level - iPtr->varFramePtr->level));
    } else if (iPtr->framePtr != iPtr->rootFramePtr) {
	/*
	 * normal case, [lappend errorstack CALL [info level 0]]
	 */

	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->callLiteral);
	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewListObj(
		iPtr->framePtr->objc, iPtr->framePtr->objv));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclErrorStackResetIf --
 *
 *	The TIP 348 reset/no-bc part of TLCI, for specific use by
 *	TclCompileSyntaxError.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Reset errorstack if it needs be, and in that case remember the
 *	passed-in error message as inner context.
 *
 *----------------------------------------------------------------------
 */

void
TclErrorStackResetIf(
    Tcl_Interp *interp,
    const char *msg,
    size_t length)
{
    Interp *iPtr = (Interp *) interp;

    if (Tcl_IsShared(iPtr->errorStack)) {
	Tcl_Obj *newObj;

	newObj = Tcl_DuplicateObj(iPtr->errorStack);
	Tcl_DecrRefCount(iPtr->errorStack);
	Tcl_IncrRefCount(newObj);
	iPtr->errorStack = newObj;
    }
    if (iPtr->resetErrorStack) {
	int len;

	iPtr->resetErrorStack = 0;
	Tcl_ListObjLength(interp, iPtr->errorStack, &len);

	/*
	 * Reset while keeping the list intrep as much as possible.
	 */

	Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
	Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
	Tcl_ListObjAppendElement(NULL, iPtr->errorStack,
		Tcl_NewStringObj(msg, length));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_LogCommandInfo --
 *
 *	This function is invoked after an error occurs in an interpreter. It
 *	adds information to iPtr->errorInfo/errorStack fields to describe the
 *	command that was being executed when the error occurred.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Information about the command is added to errorInfo/errorStack and the
 *	line number stored internally in the interpreter is set.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_LogCommandInfo(
    Tcl_Interp *interp,		/* Interpreter in which to log information. */
    const char *script,		/* First character in script containing
				 * command (must be <= command). */
    const char *command,	/* First character in command that generated
				 * the error. */
    size_t length)		/* Number of bytes in command (-1 means use
				 * all bytes up to first null byte). */
{
    TclLogCommandInfo(interp, script, command, length, NULL, NULL);
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to generic/tclNotify.c.

13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
13
14
15
16
17
18
19





20



21
22
23
24
25
26
27







-
-
-
-
-
+
-
-
-







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * Module-scope struct of notifier hooks that are checked in the default
 * notifier functions (for overriding via Tcl_SetNotifier).
 */

extern TclStubs tclStubs;
Tcl_NotifierProcs tclNotifierHooks = {
    NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL
};

/*
 * For each event source (created with Tcl_CreateEventSource) there is a
 * structure of the following type:
 */

typedef struct EventSource {
91
92
93
94
95
96
97
98

99
100
101
102
103
104
105
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98







-
+







TCL_DECLARE_MUTEX(listLock)

/*
 * Declarations for routines used only in this file.
 */

static void		QueueEvent(ThreadSpecificData *tsdPtr,
			    Tcl_Event *evPtr, Tcl_QueuePosition position);
			    Tcl_Event* evPtr, Tcl_QueuePosition position);

/*
 *----------------------------------------------------------------------
 *
 * TclInitNotifier --
 *
 *	Initialize the thread local data structures for the notifier
129
130
131
132
133
134
135
136

137
138
139
140
141
142
143
122
123
124
125
126
127
128

129
130
131
132
133
134
135
136







-
+







    if (NULL == tsdPtr) {
	/*
	 * Notifier not yet initialized in this thread.
	 */

	tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr->threadId = threadId;
	tsdPtr->clientData = Tcl_InitNotifier();
	tsdPtr->clientData = tclStubs.tcl_InitNotifier();
	tsdPtr->initialized = 1;
	tsdPtr->nextPtr = firstNotifierPtr;
	firstNotifierPtr = tsdPtr;
    }
    Tcl_MutexUnlock(&listLock);
}

177
178
179
180
181
182
183
184

185
186
187
188
189
190
191

192


193
194
195
196
197
198
199
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







-
+







+
-
+
+







	return;		/* Notifier not initialized for the current thread */
    }

    Tcl_MutexLock(&(tsdPtr->queueMutex));
    for (evPtr = tsdPtr->firstEventPtr; evPtr != NULL; ) {
	hold = evPtr;
	evPtr = evPtr->nextPtr;
	Tcl_Free(hold);
	ckfree((char *) hold);
    }
    tsdPtr->firstEventPtr = NULL;
    tsdPtr->lastEventPtr = NULL;
    Tcl_MutexUnlock(&(tsdPtr->queueMutex));

    Tcl_MutexLock(&listLock);

    if (tclStubs.tcl_FinalizeNotifier) {
    Tcl_FinalizeNotifier(tsdPtr->clientData);
	tclStubs.tcl_FinalizeNotifier(tsdPtr->clientData);
    }
    Tcl_MutexFinalize(&(tsdPtr->queueMutex));
    for (prevPtrPtr = &firstNotifierPtr; *prevPtrPtr != NULL;
	    prevPtrPtr = &((*prevPtrPtr)->nextPtr)) {
	if (*prevPtrPtr == tsdPtr) {
	    *prevPtrPtr = tsdPtr->nextPtr;
	    break;
	}
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
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







-
-
+
+
+








+
+
+
+
-
+
+
+
+
+
+







 *	particular, this can be used to install the Xt-based notifier for use
 *	with the Browser plugin.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Set the tclNotifierHooks global, which is checked in the default
 *	notifier functions.
 *	Overstomps part of the stub vector. This relies on hooks added to the
 *	default functions in case those are called directly (i.e., not through
 *	the stub table.)
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetNotifier(
    Tcl_NotifierProcs *notifierProcPtr)
{
#if !defined(__WIN32__) /* UNIX */
    tclStubs.tcl_CreateFileHandler = notifierProcPtr->createFileHandlerProc;
    tclStubs.tcl_DeleteFileHandler = notifierProcPtr->deleteFileHandlerProc;
#endif
    tclNotifierHooks = *notifierProcPtr;
    tclStubs.tcl_SetTimer = notifierProcPtr->setTimerProc;
    tclStubs.tcl_WaitForEvent = notifierProcPtr->waitForEventProc;
    tclStubs.tcl_InitNotifier = notifierProcPtr->initNotifierProc;
    tclStubs.tcl_FinalizeNotifier = notifierProcPtr->finalizeNotifierProc;
    tclStubs.tcl_AlertNotifier = notifierProcPtr->alertNotifierProc;
    tclStubs.tcl_ServiceModeHook = notifierProcPtr->serviceModeHookProc;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateEventSource --
 *
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
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







-
+




















-
+







    Tcl_EventCheckProc *checkProc,
				/* Function to call after waiting to see what
				 * happened. */
    ClientData clientData)	/* One-word argument to pass to setupProc and
				 * checkProc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    EventSource *sourcePtr = (EventSource *)Tcl_Alloc(sizeof(EventSource));
    EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));

    sourcePtr->setupProc = setupProc;
    sourcePtr->checkProc = checkProc;
    sourcePtr->clientData = clientData;
    sourcePtr->nextPtr = tsdPtr->firstEventSourcePtr;
    tsdPtr->firstEventSourcePtr = sourcePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteEventSource --
 *
 *	This function is invoked to delete the source of events given by proc
 *	and clientData.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The given event source is canceled, so its function will never again
 *	The given event source is cancelled, so its function will never again
 *	be called. If no such source exists, nothing happens.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteEventSource(
326
327
328
329
330
331
332
333

334
335
336
337
338
339
340
331
332
333
334
335
336
337

338
339
340
341
342
343
344
345







-
+







	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstEventSourcePtr = sourcePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = sourcePtr->nextPtr;
	}
	Tcl_Free(sourcePtr);
	ckfree((char *) sourcePtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
349
350
351
352
353
354
355
356

357
358

359
360
361
362
363
364
365
366
367
368
369
370
371
372
354
355
356
357
358
359
360

361
362

363
364
365
366
367
368
369

370
371
372
373
374
375
376







-
+

-
+






-







 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_QueueEvent(
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
    Tcl_Event* evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (Tcl_Alloc), and it becomes the
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    QueueEvent(tsdPtr, evPtr, position);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ThreadQueueEvent --
383
384
385
386
387
388
389
390

391
392
393
394
395
396
397
387
388
389
390
391
392
393

394
395
396
397
398
399
400
401







-
+







 */

void
Tcl_ThreadQueueEvent(
    Tcl_ThreadId threadId,	/* Identifier for thread to use. */
    Tcl_Event *evPtr,		/* Event to add to queue. The storage space
				 * must have been allocated the caller with
				 * malloc (Tcl_Alloc), and it becomes the
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    ThreadSpecificData *tsdPtr;

408
409
410
411
412
413
414
415

416
417
418
419
420
421
422
412
413
414
415
416
417
418

419
420
421
422
423
424
425
426







-
+







    /*
     * Queue the event if there was a notifier associated with the thread.
     */

    if (tsdPtr) {
	QueueEvent(tsdPtr, evPtr, position);
    } else {
	Tcl_Free(evPtr);
	ckfree((char *) evPtr);
    }
    Tcl_MutexUnlock(&listLock);
}

/*
 *----------------------------------------------------------------------
 *
440
441
442
443
444
445
446
447

448
449
450
451
452
453
454
444
445
446
447
448
449
450

451
452
453
454
455
456
457
458







-
+








static void
QueueEvent(
    ThreadSpecificData *tsdPtr,	/* Handle to thread local data that indicates
				 * which event queue to use. */
    Tcl_Event *evPtr,		/* Event to add to queue.  The storage space
				 * must have been allocated the caller with
				 * malloc (Tcl_Alloc), and it becomes the
				 * malloc (ckalloc), and it becomes the
				 * property of the event queue. It will be
				 * freed after the event has been handled. */
    Tcl_QueuePosition position)	/* One of TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
				 * TCL_QUEUE_MARK. */
{
    Tcl_MutexLock(&(tsdPtr->queueMutex));
    if (position == TCL_QUEUE_TAIL) {
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
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







-
+





-
+
+












-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteEvents(
    Tcl_EventDeleteProc *proc,	/* The function to call. */
    ClientData clientData)	/* The type-specific data. */
    ClientData clientData)    	/* The type-specific data. */
{
    Tcl_Event *evPtr;		/* Pointer to the event being examined */
    Tcl_Event *prevPtr;		/* Pointer to evPtr's predecessor, or NULL if
				 * evPtr designates the first event in the
				 * queue for the thread. */
    Tcl_Event *hold;
    Tcl_Event* hold;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_MutexLock(&(tsdPtr->queueMutex));

    /*
     * Walk the queue of events for the thread, applying 'proc' to each to
     * decide whether to eliminate the event.
     */

    prevPtr = NULL;
    evPtr = tsdPtr->firstEventPtr;
    while (evPtr != NULL) {
	if (proc(evPtr, clientData) == 1) {
	if ((*proc)(evPtr, clientData) == 1) {
	    /*
	     * This event should be deleted. Unlink it.
	     */

	    if (prevPtr == NULL) {
		tsdPtr->firstEventPtr = evPtr->nextPtr;
	    } else {
559
560
561
562
563
564
565
566

567
568
569
570
571
572
573
564
565
566
567
568
569
570

571
572
573
574
575
576
577
578







-
+








	    /*
	     * Delete the event data structure.
	     */

	    hold = evPtr;
	    evPtr = evPtr->nextPtr;
	    Tcl_Free(hold);
	    ckfree((char *) hold);
	} else {
	    /*
	     * Event is to be retained.
	     */

	    prevPtr = evPtr;
	    evPtr = evPtr->nextPtr;
663
664
665
666
667
668
669
670

671
672
673
674
675
676
677
668
669
670
671
672
673
674

675
676
677
678
679
680
681
682







-
+







	 * Release the lock before calling the event function. This allows
	 * other threads to post events if we enter a recursive event loop in
	 * this thread. Note that we are making the assumption that if the
	 * proc returns 0, the event is still in the list.
	 */

	Tcl_MutexUnlock(&(tsdPtr->queueMutex));
	result = proc(evPtr, flags);
	result = (*proc)(evPtr, flags);
	Tcl_MutexLock(&(tsdPtr->queueMutex));

	if (result) {
	    /*
	     * The event was processed, so remove it from the queue.
	     */

698
699
700
701
702
703
704
705

706
707
708
709
710
711
712
703
704
705
706
707
708
709

710
711
712
713
714
715
716
717







-
+







			tsdPtr->markerEventPtr = prevPtr;
		    }
		} else {
		    evPtr = NULL;
		}
	    }
	    if (evPtr) {
		Tcl_Free(evPtr);
		ckfree((char *) evPtr);
	    }
	    Tcl_MutexUnlock(&(tsdPtr->queueMutex));
	    return 1;
	} else {
	    /*
	     * The event wasn't actually handled, so we have to restore the
	     * proc field to allow the event to be attempted again.
765
766
767
768
769
770
771

772


773
774
775
776
777
778
779
770
771
772
773
774
775
776
777

778
779
780
781
782
783
784
785
786







+
-
+
+







				 * TCL_SERVICE_NONE */
{
    int oldMode;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    oldMode = tsdPtr->serviceMode;
    tsdPtr->serviceMode = mode;
    if (tclStubs.tcl_ServiceModeHook) {
    Tcl_ServiceModeHook(mode);
	tclStubs.tcl_ServiceModeHook(mode);
    }
    return oldMode;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetMaxBlockTime --
790
791
792
793
794
795
796
797

798
799
800
801
802
803
804
797
798
799
800
801
802
803

804
805
806
807
808
809
810
811







-
+







 *	May reduce the length of the next sleep in the tsdPtr->
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetMaxBlockTime(
    const Tcl_Time *timePtr)		/* Specifies a maximum elapsed time for the
    Tcl_Time *timePtr)		/* Specifies a maximum elapsed time for the
				 * next blocking operation in the event
				 * tsdPtr-> */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->blockTimeSet || (timePtr->sec < tsdPtr->blockTime.sec)
	    || ((timePtr->sec == tsdPtr->blockTime.sec)
923
924
925
926
927
928
929
930

931
932
933
934
935
936
937
930
931
932
933
934
935
936

937
938
939
940
941
942
943
944







-
+







	 * block time to be updated if necessary.
	 */

	tsdPtr->inTraversal = 1;
	for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
		sourcePtr = sourcePtr->nextPtr) {
	    if (sourcePtr->setupProc) {
		sourcePtr->setupProc(sourcePtr->clientData, flags);
		(sourcePtr->setupProc)(sourcePtr->clientData, flags);
	    }
	}
	tsdPtr->inTraversal = 0;

	if ((flags & TCL_DONT_WAIT) || tsdPtr->blockTimeSet) {
	    timePtr = &tsdPtr->blockTime;
	} else {
952
953
954
955
956
957
958
959

960
961
962
963
964
965
966
959
960
961
962
963
964
965

966
967
968
969
970
971
972
973







-
+







	/*
	 * Check all the event sources for new events.
	 */

	for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
		sourcePtr = sourcePtr->nextPtr) {
	    if (sourcePtr->checkProc) {
		sourcePtr->checkProc(sourcePtr->clientData, flags);
		(sourcePtr->checkProc)(sourcePtr->clientData, flags);
	    }
	}

	/*
	 * Check for events queued by the notifier or event sources.
	 */

1062
1063
1064
1065
1066
1067
1068
1069

1070
1071
1072
1073
1074
1075

1076
1077
1078
1079
1080
1081
1082
1069
1070
1071
1072
1073
1074
1075

1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086
1087
1088
1089







-
+





-
+








    tsdPtr->inTraversal = 1;
    tsdPtr->blockTimeSet = 0;

    for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
	    sourcePtr = sourcePtr->nextPtr) {
	if (sourcePtr->setupProc) {
	    sourcePtr->setupProc(sourcePtr->clientData, TCL_ALL_EVENTS);
	    (sourcePtr->setupProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
	}
    }
    for (sourcePtr = tsdPtr->firstEventSourcePtr; sourcePtr != NULL;
	    sourcePtr = sourcePtr->nextPtr) {
	if (sourcePtr->checkProc) {
	    sourcePtr->checkProc(sourcePtr->clientData, TCL_ALL_EVENTS);
	    (sourcePtr->checkProc)(sourcePtr->clientData, TCL_ALL_EVENTS);
	}
    }

    while (Tcl_ServiceEvent(0)) {
	result = 1;
    }
    if (TclServiceIdle()) {
1121
1122
1123
1124
1125
1126
1127

1128


1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1128
1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150







+
-
+
+













     * need to hold the listLock while calling Tcl_AlertNotifier to avoid a
     * race condition where the specified thread might destroy its notifier.
     */

    Tcl_MutexLock(&listLock);
    for (tsdPtr = firstNotifierPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	if (tsdPtr->threadId == threadId) {
	    if (tclStubs.tcl_AlertNotifier) {
	    Tcl_AlertNotifier(tsdPtr->clientData);
		tclStubs.tcl_AlertNotifier(tsdPtr->clientData);
	    }
	    break;
	}
    }
    Tcl_MutexUnlock(&listLock);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOO.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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











































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOO.c --
 *
 *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
 *
 * Copyright (c) 2005-2012 by Donal K. Fellows
 * Copyright (c) 2017 by Nathan Coulter
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
 * Commands in oo::define.
 */

static const struct {
    const char *name;
    Tcl_ObjCmdProc *objProc;
    int flag;
} defineCmds[] = {
    {"constructor", TclOODefineConstructorObjCmd, 0},
    {"definitionnamespace", TclOODefineDefnNsObjCmd, 0},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
    {"destructor", TclOODefineDestructorObjCmd, 0},
    {"export", TclOODefineExportObjCmd, 0},
    {"forward", TclOODefineForwardObjCmd, 0},
    {"method", TclOODefineMethodObjCmd, 0},
    {"private", TclOODefinePrivateObjCmd, 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},
    {"private", TclOODefinePrivateObjCmd, 1},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
    {"self", TclOODefineObjSelfObjCmd, 0},
    {"unexport", TclOODefineUnexportObjCmd, 1},
    {NULL, NULL, 0}
};

/*
 * What sort of size of things we like to allocate.
 */

#define ALLOC_CHUNK 8

/*
 * Function declarations for things defined in this file.
 */

static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
			    Namespace *nsPtr, const char *nsNameStr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(ClientData clientData);
static void		DeletedObjdefNamespace(ClientData clientData);
static void		DeletedHelpersNamespace(ClientData clientData);
static Tcl_NRPostProc	FinalizeAlloc;
static Tcl_NRPostProc	FinalizeNext;
static Tcl_NRPostProc	FinalizeObjectCall;
static inline void	InitClassPath(Tcl_Interp * interp, Class *clsPtr);
static void		InitClassSystemRoots(Tcl_Interp *interp,
			    Foundation *fPtr);
static int		InitFoundation(Tcl_Interp *interp);
static Tcl_InterpDeleteProc	KillFoundation;
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static Tcl_CommandTraceProc	ObjectRenamedTrace;
static inline void	RemoveClass(Class **list, int num, int idx);
static inline void	RemoveObject(Object **list, int num, int idx);
static inline void	SquelchCachedName(Object *oPtr);

static int		PublicNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		PrivateNRObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static int		MyClassNRObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
static void		MyClassDeleted(ClientData clientData);

/*
 * Methods in the oo::object and oo::class classes. First, we define a helper
 * macro that makes building the method type declaration structure a lot
 * easier. No point in making life harder than it has to be!
 *
 * Note that the core methods don't need clone or free proc callbacks.
 */

#define DCM(name,visibility,proc) \
    {name,visibility,\
	{TCL_OO_METHOD_VERSION_CURRENT,"core method: "#name,proc,NULL,NULL}}

static const DeclaredClassMethod objMethods[] = {
    DCM("destroy", 1,	TclOO_Object_Destroy),
    DCM("eval", 0,	TclOO_Object_Eval),
    DCM("unknown", 0,	TclOO_Object_Unknown),
    DCM("variable", 0,	TclOO_Object_LinkVar),
    DCM("varname", 0,	TclOO_Object_VarName),
    {NULL, 0, {0, NULL, NULL, NULL, NULL}}
}, 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}}
};

/*
 * And for the oo::class constructor...
 */

static const Tcl_MethodType classConstructor = {
    TCL_OO_METHOD_VERSION_CURRENT,
    "oo::class constructor",
    TclOO_Class_Constructor, NULL, NULL
};

/*
 * Scripted parts of TclOO. First, the main 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 scripted part of the definitions of TclOO.
 */

#include "tclOOScript.h"

/*
 * 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 Destructing(oPtr)	((oPtr)->flags & OBJECT_DESTRUCTING)
#define IsRootObject(ocPtr)	((ocPtr)->flags & ROOT_OBJECT)
#define IsRootClass(ocPtr)	((ocPtr)->flags & ROOT_CLASS)
#define IsRoot(ocPtr)		((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))

#define RemoveItem(type, lst, i) \
    do {						\
	Remove ## type ((lst).list, (lst).num, i);	\
	(lst).num--;					\
    } while (0)

/*
 * ----------------------------------------------------------------------
 *
 * RemoveClass, RemoveObject --
 *
 *	Helpers for the RemoveItem macro for deleting a class or object from a
 *	list. Setting the "empty" location to NULL makes debugging a little
 *	easier.
 *
 * ----------------------------------------------------------------------
 */

static inline void
RemoveClass(
    Class **list,
    int num,
    int idx)
{
    for (; idx < num - 1; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

static inline void
RemoveObject(
    Object **list,
    int num,
    int idx)
{
    for (; idx < num - 1; idx++) {
	list[idx] = list[idx + 1];
    }
    list[idx] = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInit --
 *
 *	Called to initialise the OO system within an interpreter.
 *
 * Result:
 *	TCL_OK if the setup succeeded. Currently assumed to always work.
 *
 * Side effects:
 *	Creates namespaces, commands, several classes and a number of
 *	callbacks. Upon return, the OO system is ready for use.
 *
 * ----------------------------------------------------------------------
 */

int
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_EvalEx(interp, initScript, -1, 0) != TCL_OK) {
	return TCL_ERROR;
    }

    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
	    (void *) &tclOOStubs);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetFoundation --
 *
 *	Get a reference to the OO core class system.
 *
 * ----------------------------------------------------------------------
 */

Foundation *
TclOOGetFoundation(
    Tcl_Interp *interp)
{
    return GetFoundation(interp);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitFoundation --
 *
 *	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 =
	    (ThreadLocalData *)Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = (Foundation *)Tcl_Alloc(sizeof(Foundation));
    Tcl_Obj *namePtr;
    Tcl_DString buffer;
    Command *cmdPtr;
    int i;

    /*
     * Initialize the structure that holds the OO system core. This is
     * attached to the interpreter via an assocData entry; not very efficient,
     * but the best we can do without hacking the core more.
     */

    memset(fPtr, 0, sizeof(Foundation));
    ((Interp *) interp)->objectFoundation = fPtr;
    fPtr->interp = interp;
    fPtr->ooNs = Tcl_CreateNamespace(interp, "::oo", fPtr, NULL);
    Tcl_Export(interp, fPtr->ooNs, "[a-z]*", 1);
    fPtr->defineNs = Tcl_CreateNamespace(interp, "::oo::define", fPtr,
	    DeletedDefineNamespace);
    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
	    DeletedObjdefNamespace);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);
    fPtr->epoch = 1;
    fPtr->tsdPtr = tsdPtr;
    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
    TclNewLiteralStringObj(fPtr->defineName, "::oo::define");
    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
    Tcl_IncrRefCount(fPtr->constructorName);
    Tcl_IncrRefCount(fPtr->destructorName);
    Tcl_IncrRefCount(fPtr->clonedName);
    Tcl_IncrRefCount(fPtr->defineName);
    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.
     */

    Tcl_DStringInit(&buffer);
    for (i = 0 ; defineCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::define::");
	Tcl_DStringAppend(&buffer, defineCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		defineCmds[i].objProc, INT2PTR(defineCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }
    for (i = 0 ; objdefCmds[i].name ; i++) {
	TclDStringAppendLiteral(&buffer, "::oo::objdefine::");
	Tcl_DStringAppend(&buffer, objdefCmds[i].name, -1);
	Tcl_CreateObjCommand(interp, Tcl_DStringValue(&buffer),
		objdefCmds[i].objProc, INT2PTR(objdefCmds[i].flag), NULL);
	Tcl_DStringFree(&buffer);
    }

    Tcl_CallWhenDeleted(interp, KillFoundation, NULL);

    /*
     * Create the special objects at the core of the object system.
     */

    InitClassSystemRoots(interp, fPtr);

    /*
     * 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.
     */

    TclNewLiteralStringObj(namePtr, "new");
    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
	    namePtr /* keeps ref */, 0 /* private */, NULL, NULL);
    fPtr->classCls->constructorPtr = (Method *) Tcl_NewMethod(interp,
	    (Tcl_Class) fPtr->classCls, NULL, 0, &classConstructor, NULL);

    /*
     * Create non-object commands and plug ourselves into the Tcl [info]
     * ensemble.
     */

    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::next",
	    NULL, TclOONextObjCmd, NULL, NULL);
    cmdPtr->compileProc = TclCompileObjectNextCmd;
    cmdPtr = (Command *) Tcl_NRCreateCommand(interp, "::oo::Helpers::nextto",
	    NULL, TclOONextToObjCmd, NULL, NULL);
    cmdPtr->compileProc = TclCompileObjectNextToCmd;
    cmdPtr = (Command *) Tcl_CreateObjCommand(interp, "::oo::Helpers::self",
	    TclOOSelfObjCmd, NULL, NULL);
    cmdPtr->compileProc = TclCompileObjectSelfCmd;
    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;
    }

    /*
     * Evaluate the remaining definitions, which are a compiled-in Tcl script.
     */

    return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0);
}

/*
 * ----------------------------------------------------------------------
 *
 * InitClassSystemRoots --
 *
 *	Creates the objects at the core of the object system. These need to be
 *	spliced manually.
 *
 * ----------------------------------------------------------------------
 */

static void
InitClassSystemRoots(
    Tcl_Interp *interp,
    Foundation *fPtr)
{
    Class fakeCls;
    Object fakeObject;
    Tcl_Obj *defNsName;

    /* Stand up a phony class for bootstrapping. */
    fPtr->objectCls = &fakeCls;
    /* referenced in TclOOAllocClass to increment the refCount. */
    fakeCls.thisPtr = &fakeObject;

    fPtr->objectCls = TclOOAllocClass(interp,
	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->objectCls->thisPtr);

    /*
     * This is why it is unnecessary in this routine to replace the
     * incremented reference count of fPtr->objectCls that was swallowed by
     * fakeObject.
     */

    fPtr->objectCls->superclasses.num = 0;
    Tcl_Free(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;

    /*
     * Special initialization for the primordial objects.
     */

    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;
    TclNewLiteralStringObj(defNsName, "::oo::objdefine");
    fPtr->objectCls->objDefinitionNs = defNsName;
    Tcl_IncrRefCount(defNsName);

    fPtr->classCls = TclOOAllocClass(interp,
	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
    /* Corresponding TclOODecrRefCount in KillFoudation */
    AddRef(fPtr->classCls->thisPtr);

    /*
     * Increment reference counts for each reference because these
     * relationships can be dynamically changed.
     *
     * Corresponding TclOODecrRefCount for all incremented refcounts is in
     * KillFoundation.
     */

    /*
     * Rewire bootstrapped objects.
     */

    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
    AddRef(fPtr->classCls->thisPtr);
    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);

    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
    AddRef(fPtr->classCls->thisPtr);
    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);

    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
    fPtr->classCls->flags |= ROOT_CLASS;
    TclNewLiteralStringObj(defNsName, "::oo::define");
    fPtr->classCls->clsDefinitionNs = defNsName;
    Tcl_IncrRefCount(defNsName);

    /* Standard initialization for new Objects */
    TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);

    /*
     * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING.
     * Everything else is careful to prohibit looping.
     */
}

/*
 * ----------------------------------------------------------------------
 *
 * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
 *
 *	Simple helpers used to clear fields of the foundation when they no
 *	longer hold useful information.
 *
 * ----------------------------------------------------------------------
 */

static void
DeletedDefineNamespace(
    ClientData clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->defineNs = NULL;
}

static void
DeletedObjdefNamespace(
    ClientData clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->objdefNs = NULL;
}

static void
DeletedHelpersNamespace(
    ClientData clientData)
{
    Foundation *fPtr = (Foundation *)clientData;

    fPtr->helpersNs = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * KillFoundation --
 *
 *	Delete those parts of the OO core that are not deleted automatically
 *	when the objects and classes themselves are destroyed.
 *
 * ----------------------------------------------------------------------
 */

static void
KillFoundation(
    TCL_UNUSED(void *),
    Tcl_Interp *interp)	/* The interpreter containing the OO system
			 * foundation. */
{
    Foundation *fPtr = GetFoundation(interp);

    TclDecrRefCount(fPtr->unknownMethodNameObj);
    TclDecrRefCount(fPtr->constructorName);
    TclDecrRefCount(fPtr->destructorName);
    TclDecrRefCount(fPtr->clonedName);
    TclDecrRefCount(fPtr->defineName);
    TclOODecrRefCount(fPtr->objectCls->thisPtr);
    TclOODecrRefCount(fPtr->classCls->thisPtr);

    Tcl_Free(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
 *
 *	Allocate an object of basic type. Does not splice the object into its
 *	class's instance list.  The caller must set the classPtr on the object
 *	to either a class or NULL, call TclOOAddToInstances to add the object
 *	to the class's instance list, and if the object itself is a class, use
 *	call TclOOAddToSubclasses() to add it to the right class's list of
 *	subclasses.
 *
 * ----------------------------------------------------------------------
 */

static Object *
AllocObject(
    Tcl_Interp *interp,		/* Interpreter within which to create the
				 * object. */
    const char *nameStr,	/* The name of the object to create, or NULL
				 * if the OO system should pick the object
				 * name itself (equal to the namespace
				 * name). */
    Namespace *nsPtr,		/* The namespace to create the object in, or
				 * NULL if *nameStr is NULL */
    const char *nsNameStr)	/* The name of the namespace to create, or
				 * NULL if the OO system should pick a unique
				 * name itself. If this is non-NULL but names
				 * a namespace that already exists, the effect
				 * will be the same as if this was NULL. */
{
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    Command *cmdPtr;
    CommandTrace *tracePtr;
    size_t creationEpoch;

    oPtr = (Object *)Tcl_Alloc(sizeof(Object));
    memset(oPtr, 0, sizeof(Object));

    /*
     * Every object has a namespace; make one. Note that this also normally
     * computes the creation epoch value for the object, a sequence number
     * that is unique to the object (and which allows us to manage method
     * caching without comparing pointers).
     *
     * When creating a namespace, we first check to see if the caller
     * specified the name for the namespace. If not, we generate namespace
     * names using the epoch until such time as a new namespace is actually
     * created.
     */

    if (nsNameStr != NULL) {
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, nsNameStr, oPtr, NULL);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = ++fPtr->tsdPtr->nsCount;
	    goto configNamespace;
	}
	Tcl_ResetResult(interp);
    }

    while (1) {
	char objName[10 + TCL_INTEGER_SPACE];

	sprintf(objName, "::oo::Obj%" TCL_Z_MODIFIER "u", ++fPtr->tsdPtr->nsCount);
	oPtr->namespacePtr = Tcl_CreateNamespace(interp, objName, oPtr, NULL);
	if (oPtr->namespacePtr != NULL) {
	    creationEpoch = fPtr->tsdPtr->nsCount;
	    break;
	}

	/*
	 * Could not make that namespace, so we make another. But first we
	 * have to get rid of the error message from Tcl_CreateNamespace,
	 * since that's something that should not be exposed to the user.
	 */

	Tcl_ResetResult(interp);
    }

  configNamespace:
    ((Namespace *) oPtr->namespacePtr)->refCount++;

    /*
     * Make the namespace know about the helper commands. This grants access
     * to the [self] and [next] commands.
     */

    if (fPtr->helpersNs != NULL) {
	TclSetNsPath((Namespace *) oPtr->namespacePtr, 1, &fPtr->helpersNs);
    }
    TclOOSetupVariableResolver(oPtr->namespacePtr);

    /*
     * Suppress use of compiled versions of the commands in this object's
     * namespace and its children; causes wrong behaviour without expensive
     * recompilation. [Bug 2037727]
     */

    ((Namespace *) oPtr->namespacePtr)->flags |= NS_SUPPRESS_COMPILATION;

    /*
     * Set up a callback to get notification of the deletion of a namespace
     * when enough of the namespace still remains to execute commands and
     * access variables in it. [Bug 2950259]
     */

    ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc = ObjectNamespaceDeleted;

    /*
     * Fill in the rest of the non-zero/NULL parts of the structure.
     */

    oPtr->fPtr = fPtr;
    oPtr->creationEpoch = creationEpoch;

    /*
     * An object starts life with a refCount of 2 to mark the two stages of
     * destruction it occur:  A call to ObjectRenamedTrace(), and a call to
     * ObjectNamespaceDeleted().
     */

    oPtr->refCount = 2;
    oPtr->flags = USE_CLASS_CACHE;

    /*
     * Finally, create the object commands and initialize the trace on the
     * public command (so that the object structures are deleted when the
     * command is deleted).
     */

    if (!nameStr) {
	nameStr = oPtr->namespacePtr->name;
	nsPtr = (Namespace *)oPtr->namespacePtr;
	if (nsPtr->parentPtr != NULL) {
	    nsPtr = nsPtr->parentPtr;
	}
    }
    oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
	(Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL);

    /*
     * Add the NRE command and trace directly. While this breaks a number of
     * abstractions, it is faster and we're inside Tcl here so we're allowed.
     */

    cmdPtr = (Command *) oPtr->command;
    cmdPtr->nreProc = PublicNRObjectCmd;
    cmdPtr->tracePtr = tracePtr = (CommandTrace *)Tcl_Alloc(sizeof(CommandTrace));
    tracePtr->traceProc = ObjectRenamedTrace;
    tracePtr->clientData = oPtr;
    tracePtr->flags = TCL_TRACE_RENAME|TCL_TRACE_DELETE;
    tracePtr->nextPtr = NULL;
    tracePtr->refCount = 1;

    oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
	    TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
    oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
	    oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
            MyClassDeleted);
    return oPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * SquelchCachedName --
 *
 *	Encapsulates how to throw away a cached object name. Called from
 *	object rename traces and at object destruction.
 *
 * ----------------------------------------------------------------------
 */

static inline void
SquelchCachedName(
    Object *oPtr)
{
    if (oPtr->cachedNameObj) {
	Tcl_DecrRefCount(oPtr->cachedNameObj);
	oPtr->cachedNameObj = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * MyDeleted, MyClassDeleted --
 *
 *	These callbacks are triggered when the object's [my] or [myclass]
 *	commands are deleted by any mechanism. They just mark the object as
 *	not having a [my] command or [myclass] command, and so prevent cleanup
 *	of those commands when the object itself is deleted.
 *
 * ----------------------------------------------------------------------
 */

static void
MyDeleted(
    ClientData clientData)	/* Reference to the object whose [my] has been
				 * squelched. */
{
    Object *oPtr = (Object *)clientData;

    oPtr->myCommand = NULL;
}

static void
MyClassDeleted(
    ClientData clientData)
{
    Object *oPtr = (Object *)clientData;
    oPtr->myclassCommand = NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectRenamedTrace --
 *
 *	This callback is triggered when the object is deleted by any
 *	mechanism. It runs the destructors and arranges for the actual cleanup
 *	of the object's namespace, which in turn triggers cleansing of the
 *	object data structures.
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectRenamedTrace(
    ClientData clientData,	/* The object being deleted. */
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(const char *) /*oldName*/,
    TCL_UNUSED(const char *) /*newName*/,
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = (Object *)clientData;

    /*
     * 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) {
	SquelchCachedName(oPtr);
	return;
    }

    /*
     * The namespace is only deleted if it hasn't already been deleted. [Bug
     * 2950259].
     */

    if (!Destructing(oPtr)) {
	Tcl_DeleteNamespace(oPtr->namespacePtr);
    }
    oPtr->command = NULL;
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteDescendants --
 *
 *	Delete all descendants of a particular class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteDescendants(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    Class *clsPtr = oPtr->classPtr, *subclassPtr, *mixinSubclassPtr;
    Object *instancePtr;

    /*
     * Squelch classes that this class has been mixed into.
     */

    if (clsPtr->mixinSubs.num > 0) {
	while (clsPtr->mixinSubs.num > 0) {
	    mixinSubclassPtr =
		    clsPtr->mixinSubs.list[clsPtr->mixinSubs.num - 1];

	    /*
	     * This condition also covers the case where mixinSubclassPtr ==
	     * clsPtr
	     */

	    if (!Destructing(mixinSubclassPtr->thisPtr)
		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			mixinSubclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromMixinSubs(mixinSubclassPtr, clsPtr);
	}
    }
    if (clsPtr->mixinSubs.size > 0) {
	Tcl_Free(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.size = 0;
    }

    /*
     * Squelch subclasses of this class.
     */

    if (clsPtr->subclasses.num > 0) {
	while (clsPtr->subclasses.num > 0) {
	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num - 1];
	    if (!Destructing(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp,
			subclassPtr->thisPtr->command);
	    }
	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
	}
    }
    if (clsPtr->subclasses.size > 0) {
	Tcl_Free(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.size = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (clsPtr->instances.num > 0) {
	while (clsPtr->instances.num > 0) {
	    instancePtr = clsPtr->instances.list[clsPtr->instances.num - 1];

	    /*
	     * This condition also covers the case where instancePtr == oPtr
	     */

	    if (!Destructing(instancePtr) && !IsRoot(instancePtr) &&
		    !(instancePtr->flags & DONT_DELETE)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    TclOORemoveFromInstances(instancePtr, clsPtr);
	}
    }
    if (clsPtr->instances.size > 0) {
	Tcl_Free(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.size = 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
    int i;
    Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
    Method *mPtr;
    Foundation *fPtr = oPtr->fPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVariable;

    /*
     * Sanity check!
     */

    if (!Destructing(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");
	}
    }

    /*
     * Stop using the class for definition information.
     */

    if (clsPtr->clsDefinitionNs) {
	Tcl_DecrRefCount(clsPtr->clsDefinitionNs);
	clsPtr->clsDefinitionNs = NULL;
    }
    if (clsPtr->objDefinitionNs) {
	Tcl_DecrRefCount(clsPtr->objDefinitionNs);
	clsPtr->objDefinitionNs = NULL;
    }

    /*
     * 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);
	Tcl_Free(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }

    /*
     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    TclDecrRefCount(filterObj);
	}
	Tcl_Free(clsPtr->filters.list);
	clsPtr->filters.list = NULL;
	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);
	Tcl_Free(clsPtr->metadataPtr);
	clsPtr->metadataPtr = NULL;
    }

    if (clsPtr->mixins.num) {
	FOREACH(tmpClsPtr, clsPtr->mixins) {
	    TclOORemoveFromMixinSubs(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	Tcl_Free(clsPtr->mixins.list);
	clsPtr->mixins.list = NULL;
	clsPtr->mixins.num = 0;
    }

    if (clsPtr->superclasses.num > 0) {
	FOREACH(tmpClsPtr, clsPtr->superclasses) {
	    TclOORemoveFromSubclasses(clsPtr, tmpClsPtr);
	    TclOODecrRefCount(tmpClsPtr->thisPtr);
	}
	Tcl_Free(clsPtr->superclasses.list);
	clsPtr->superclasses.num = 0;
	clsPtr->superclasses.list = NULL;
    }

    FOREACH_HASH_VALUE(mPtr, &clsPtr->classMethods) {
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashTable(&clsPtr->classMethods);
    TclOODelMethodRef(clsPtr->constructorPtr);
    TclOODelMethodRef(clsPtr->destructorPtr);

    FOREACH(variableObj, clsPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	Tcl_Free(clsPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	Tcl_Free(clsPtr->privateVariables.list);
    }

    if (IsRootClass(oPtr) && !Destructing(fPtr->objectCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectNamespaceDeleted --
 *
 *	Callback when the object's namespace is deleted. Used to clean up the
 *	data structures associated with the object. The complicated bit is
 *	that this can sometimes happen before the object's command is deleted
 *	(interpreter teardown is complex!)
 *
 * ----------------------------------------------------------------------
 */

static void
ObjectNamespaceDeleted(
    ClientData clientData)	/* Pointer to the class whose namespace is
				 * being deleted. */
{
    Object *oPtr = (Object *)clientData;
    Foundation *fPtr = oPtr->fPtr;
    FOREACH_HASH_DECLS;
    Class *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj;
    PrivateVariableMapping *privateVariable;
    Tcl_Interp *interp = oPtr->fPtr->interp;
    int i;

    if (Destructing(oPtr)) {
	/*
	 * TODO:  Can ObjectNamespaceDeleted ever be called twice?  If not,
	 * this guard could be removed.
	 */

	return;
    }

    /*
     * One rule for the teardown routines is that if an object is in the
     * process of being deleted, nothing else may modify its bookeeping
     * records.  This is the flag that
     */

    oPtr->flags |= OBJECT_DESTRUCTING;

    /*
     * Let the dominoes fall!
     */

    if (oPtr->classPtr) {
	TclOODeleteDescendants(interp, oPtr);
    }

    /*
     * We 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]
     */

    if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, 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_BackgroundException(interp, result);
	    }
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the command that refers to the object at this point (if it
     * still exists) because otherwise its pointer to the object points into
     * freed memory.
     */

    if (((Command *) oPtr->command)->flags && CMD_DYING) {
	/*
	 * Something has already started the command deletion process. We can
	 * go ahead and clean up the the namespace,
	 */
    } else {
	/*
	 * The namespace must have been deleted directly.  Delete the command
	 * as well.
	 */

	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
    }

    if (oPtr->myclassCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand);
    }
    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.
     */

    /* TODO: Should this be protected with a !IsRoot() condition? */
    TclOORemoveFromInstances(oPtr, oPtr->selfCls);

    if (oPtr->mixins.num > 0) {
	FOREACH(mixinPtr, oPtr->mixins) {
	    TclOORemoveFromInstances(oPtr, mixinPtr);
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	if (oPtr->mixins.list != NULL) {
	    Tcl_Free(oPtr->mixins.list);
	}
    }

    FOREACH(filterObj, oPtr->filters) {
	TclDecrRefCount(filterObj);
    }
    if (i) {
	Tcl_Free(oPtr->filters.list);
    }

    if (oPtr->methodsPtr) {
	FOREACH_HASH_VALUE(mPtr, oPtr->methodsPtr) {
	    TclOODelMethodRef(mPtr);
	}
	Tcl_DeleteHashTable(oPtr->methodsPtr);
	Tcl_Free(oPtr->methodsPtr);
    }

    FOREACH(variableObj, oPtr->variables) {
	TclDecrRefCount(variableObj);
    }
    if (i) {
	Tcl_Free(oPtr->variables.list);
    }

    FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
	TclDecrRefCount(privateVariable->variableObj);
	TclDecrRefCount(privateVariable->fullNameObj);
    }
    if (i) {
	Tcl_Free(oPtr->privateVariables.list);
    }

    if (oPtr->chainCache) {
	TclOODeleteChainCache(oPtr->chainCache);
    }

    SquelchCachedName(oPtr);

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	Tcl_Free(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    /*
     * Because an object can be a class that is an instance of itself, the
     * class object's class structure should only be cleaned after most of
     * the cleanup on the object is done.
     *
     * 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 (IsRootObject(oPtr) && !Destructing(fPtr->classCls->thisPtr)
	    && !Tcl_InterpDeleted(interp)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
    }

    if (oPtr->classPtr != NULL) {
	TclOOReleaseClassContents(interp, oPtr);
    }

    /*
     * Delete the object structure itself.
     */

    TclNsDecrRefCount((Namespace *)oPtr->namespacePtr);
    oPtr->namespacePtr = NULL;
    TclOODecrRefCount(oPtr->selfCls->thisPtr);
    oPtr->selfCls = NULL;
    TclOODecrRefCount(oPtr);
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODecrRefCount --
 *
 *	Decrement the refcount of an object and deallocate storage then object
 *	is no longer referenced.  Returns 1 if storage was deallocated, and 0
 *	otherwise.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODecrRefCount(
    Object *oPtr)
{
    if (oPtr->refCount-- <= 1) {

	if (oPtr->classPtr != NULL) {
	    Tcl_Free(oPtr->classPtr);
	}
	Tcl_Free(oPtr);
	return 1;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectDestroyed --
 *
 *	Returns TCL_OK if an object is entirely deleted, i.e. the destruction
 *	sequence has completed.
 *
 * ----------------------------------------------------------------------
 */
int TclOOObjectDestroyed(Object *oPtr) {
    return (oPtr->namespacePtr == NULL);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromInstances --
 *
 *	Utility function to remove an object from the list of instances within
 *	a class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOORemoveFromInstances(
    Object *oPtr,		/* The instance to remove. */
    Class *clsPtr)		/* The class (possibly) containing the
				 * reference to the instance. */
{
    int i, res = 0;
    Object *instPtr;

    FOREACH(instPtr, clsPtr->instances) {
	if (oPtr == instPtr) {
	    RemoveItem(Object, clsPtr->instances, i);
	    TclOODecrRefCount(oPtr);
	    res++;
	    break;
	}
    }
    return res;
}

/*
 * ----------------------------------------------------------------------
 *
 * 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 = (Object **)Tcl_Alloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = (Object **)Tcl_Realloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);
	}
    }
    clsPtr->instances.list[clsPtr->instances.num++] = oPtr;
    AddRef(oPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromMixins --
 *
 *	Utility function to remove a class from the list of mixins within an
 *	object.
 *
 * ----------------------------------------------------------------------
 */

int
TclOORemoveFromMixins(
    Class *mixinPtr,		/* The mixin to remove. */
    Object *oPtr)		/* The object (possibly) containing the
				 * reference to the mixin. */
{
    int i, res = 0;
    Class *mixPtr;

    FOREACH(mixPtr, oPtr->mixins) {
	if (mixinPtr == mixPtr) {
	    RemoveItem(Class, oPtr->mixins, i);
	    TclOODecrRefCount(mixPtr->thisPtr);
	    res++;
	    break;
	}
    }
    if (oPtr->mixins.num == 0) {
	Tcl_Free(oPtr->mixins.list);
	oPtr->mixins.list = NULL;
    }
    return res;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromSubclasses --
 *
 *	Utility function to remove a class from the list of subclasses within
 *	another class. Returns the number of removals performed.
 *
 * ----------------------------------------------------------------------
 */

int
TclOORemoveFromSubclasses(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i, res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->subclasses) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->subclasses, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	}
    }
    return res;
}

/*
 * ----------------------------------------------------------------------
 *
 * 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 (Destructing(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
	superPtr->subclasses.size += ALLOC_CHUNK;
	if (superPtr->subclasses.size == ALLOC_CHUNK) {
	    superPtr->subclasses.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = (Class **)Tcl_Realloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);
	}
    }
    superPtr->subclasses.list[superPtr->subclasses.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromMixinSubs --
 *
 *	Utility function to remove a class from the list of mixinSubs within
 *	another class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOORemoveFromMixinSubs(
    Class *subPtr,		/* The subclass to remove. */
    Class *superPtr)		/* The superclass to possibly remove the
				 * subclass reference from. */
{
    int i, res = 0;
    Class *subclsPtr;

    FOREACH(subclsPtr, superPtr->mixinSubs) {
	if (subPtr == subclsPtr) {
	    RemoveItem(Class, superPtr->mixinSubs, i);
	    TclOODecrRefCount(subPtr->thisPtr);
	    res++;
	    break;
	}
    }
    return res;
}

/*
 * ----------------------------------------------------------------------
 *
 * 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 (Destructing(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
	superPtr->mixinSubs.size += ALLOC_CHUNK;
	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
	    superPtr->mixinSubs.list = (Class **)Tcl_Alloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = (Class **)Tcl_Realloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);
	}
    }
    superPtr->mixinSubs.list[superPtr->mixinSubs.num++] = subPtr;
    AddRef(subPtr->thisPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAllocClass --
 *
 *	Allocate a basic class. Does not add class to its class's instance
 *	list.
 *
 * ----------------------------------------------------------------------
 */

static inline void
InitClassPath(
    Tcl_Interp *interp,
    Class *clsPtr)
{
    Foundation *fPtr = GetFoundation(interp);

    if (fPtr->helpersNs != NULL) {
	Tcl_Namespace *path[2];

	path[0] = fPtr->helpersNs;
	path[1] = fPtr->ooNs;
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
    } else {
	TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
		&fPtr->ooNs);
    }
}

Class *
TclOOAllocClass(
    Tcl_Interp *interp,		/* Interpreter within which to allocate the
				 * class. */
    Object *useThisObj)		/* Object that is to act as the class
				 * representation. */
{
    Foundation *fPtr = GetFoundation(interp);
    Class *clsPtr = (Class *)Tcl_Alloc(sizeof(Class));

    memset(clsPtr, 0, sizeof(Class));
    clsPtr->thisPtr = useThisObj;

    /*
     * Configure the namespace path for the class's object.
     */

    InitClassPath(interp, clsPtr);

    /*
     * Classes are subclasses of oo::object, i.e. the objects they create are
     * objects.
     */

    clsPtr->superclasses.num = 1;
    clsPtr->superclasses.list = (Class **)Tcl_Alloc(sizeof(Class *));
    clsPtr->superclasses.list[0] = fPtr->objectCls;
    AddRef(fPtr->objectCls->thisPtr);

    /*
     * Finish connecting the class structure to the object structure.
     */

    clsPtr->thisPtr->classPtr = clsPtr;

    /*
     * That's the complicated bit. Now fill in the rest of the non-zero/NULL
     * fields.
     */

    Tcl_InitObjHashTable(&clsPtr->classMethods);
    return clsPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewObjectInstance --
 *
 *	Allocate a new instance of an object.
 *
 * ----------------------------------------------------------------------
 */
Tcl_Object
Tcl_NewObjectInstance(
    Tcl_Interp *interp,		/* Interpreter context. */
    Tcl_Class cls,		/* Class to create an instance of. */
    const char *nameStr,	/* Name of object to create, or NULL to ask
				 * the code to pick its own unique name. */
    const char *nsNameStr,	/* Name of namespace to create inside object,
				 * or NULL to ask the code to pick its own
				 * unique name. */
    int objc,			/* Number of arguments. Negative value means
				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    int skip)			/* Number of arguments to _not_ pass to the
				 * constructor. */
{
    Class *classPtr = (Class *) cls;
    Object *oPtr;
    ClientData clientData[4];

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (oPtr == NULL) {
	return NULL;
    }

    /*
     * Run constructors, except when objc < 0, which is a special flag case
     * used for object cloning only.
     */

    if (objc >= 0) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);

	if (contextPtr != NULL) {
	    int isRoot, result;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;
	    contextPtr->skip = skip;

	    /*
	     * Adjust the ensemble tracking record if necessary. [Bug 3514761]
	     */

	    isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
		    objc, objv);

	    if (isRoot) {
		TclResetRewriteEnsemble(interp, 1);
	    }

	    clientData[0] = contextPtr;
	    clientData[1] = oPtr;
	    clientData[2] = state;
	    clientData[3] = &oPtr;

	    result = FinalizeAlloc(clientData, interp, result);
	    if (result != TCL_OK) {
		return NULL;
	    }
	}
    }

    return (Tcl_Object) oPtr;
}

int
TclNRNewObjectInstance(
    Tcl_Interp *interp,		/* Interpreter context. */
    Tcl_Class cls,		/* Class to create an instance of. */
    const char *nameStr,	/* Name of object to create, or NULL to ask
				 * the code to pick its own unique name. */
    const char *nsNameStr,	/* Name of namespace to create inside object,
				 * or NULL to ask the code to pick its own
				 * unique name. */
    int objc,			/* Number of arguments. Negative value means
				 * do not call constructor. */
    Tcl_Obj *const *objv,	/* Argument list. */
    int skip,			/* Number of arguments to _not_ pass to the
				 * constructor. */
    Tcl_Object *objectPtr)	/* Place to write the object reference upon
				 * successful allocation. */
{
    Class *classPtr = (Class *) cls;
    CallContext *contextPtr;
    Tcl_InterpState state;
    Object *oPtr;

    oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Run constructors, except when objc < 0 (a special flag case used for
     * object cloning only). If there aren't any constructors, we do nothing.
     */

    if (objc < 0) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }
    contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
    if (contextPtr == NULL) {
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }

    state = Tcl_SaveInterpState(interp, TCL_OK);
    contextPtr->callPtr->flags |= CONSTRUCTOR;
    contextPtr->skip = skip;

    /*
     * Adjust the ensemble tracking record if necessary. [Bug 3514761]
     */

    if (TclInitRewriteEnsemble(interp, skip, skip, objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }

    /*
     * Fire off the constructors non-recursively.
     */

    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
	    objectPtr);
    TclPushTailcallPoint(interp);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

Object *
TclNewObjectInstanceCommon(
    Tcl_Interp *interp,
    Class *classPtr,
    const char *nameStr,
    const char *nsNameStr)
{
    Tcl_HashEntry *hPtr;
    Foundation *fPtr = GetFoundation(interp);
    Object *oPtr;
    const char *simpleName = NULL;
    Namespace *nsPtr = NULL, *dummy;
    Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);

    if (nameStr) {
	TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
		TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);

	/*
	 * Disallow creation of an object over an existing command.
	 */

	hPtr = Tcl_FindHashEntry(&nsPtr->cmdTable, simpleName);
	if (hPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't create object \"%s\": command already exists with"
		    " that name", nameStr));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
	    return NULL;
	}
    }

    /*
     * Create the object.
     */

    oPtr = AllocObject(interp, simpleName, nsPtr, nsNameStr);
    oPtr->selfCls = classPtr;
    AddRef(classPtr->thisPtr);
    TclOOAddToInstances(oPtr, classPtr);

    /*
     * Check to see if we're really creating a class. If so, allocate the
     * class structure as well.
     */

    if (TclOOIsReachable(fPtr->classCls, classPtr)) {
	/*
	 * Is a class, so attach a class structure. Note that the
	 * TclOOAllocClass function splices the structure into the object, so
	 * we don't have to. Once that's done, we need to repatch the object
	 * to have the right class since TclOOAllocClass interferes with that.
	 */

	TclOOAllocClass(interp, oPtr);
	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
    } else {
	oPtr->classPtr = NULL;
    }
    return oPtr;
}

static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState state = (Tcl_InterpState)data[2];
    Tcl_Object *objectPtr = (Tcl_Object *)data[3];

    /*
     * Ensure an error if the object was deleted in the constructor. Don't
     * want to lose errors by accident. [Bug 2903011]
     */

    if (result != TCL_ERROR && Destructing(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object deleted in constructor", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
	result = TCL_ERROR;
    }
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);

	/*
	 * Take care to not delete a deleted object; that would be bad. [Bug
	 * 2903011] Also take care to make sure that we have the name of the
	 * command before we delete it. [Bug 9dd1bd7a74]
	 */

	if (!Destructing(oPtr)) {
	    (void) TclOOObjectName(interp, oPtr);
	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
	}

	/*
	 * This decrements the refcount of oPtr.
	 */

	TclOODeleteContext(contextPtr);
	return TCL_ERROR;
    }
    Tcl_RestoreInterpState(interp, state);
    *objectPtr = (Tcl_Object) oPtr;

    /*
     * This decrements the refcount of oPtr.
     */

    TclOODeleteContext(contextPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_CopyObjectInstance --
 *
 *	Creates a copy of an object. Does not copy the backing namespace,
 *	since the correct way to do that (e.g., shallow/deep) depends on the
 *	object/class's own policies.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Object
Tcl_CopyObjectInstance(
    Tcl_Interp *interp,
    Tcl_Object sourceObject,
    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];
    PrivateVariableMapping *privateVariable;
    int i, result;

    /*
     * Sanity check.
     */

    if (IsRootClass(oPtr)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not clone the class of classes", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.
     */

    o2Ptr = (Object *) Tcl_NewObjectInstance(interp,
	    (Tcl_Class) oPtr->selfCls, targetName, targetNamespaceName, -1,
	    NULL, -1);
    if (o2Ptr == NULL) {
	return NULL;
    }

    /*
     * Copy the object-local methods to the new object.
     */

    if (oPtr->methodsPtr) {
	FOREACH_HASH(keyPtr, mPtr, oPtr->methodsPtr) {
	    if (CloneObjectMethod(interp, o2Ptr, mPtr, keyPtr) != TCL_OK) {
		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
		return NULL;
	    }
	}
    }

    /*
     * Copy the object's mixin references to the new object.
     */

    if (o2Ptr->mixins.num != 0) {
	FOREACH(mixinPtr, o2Ptr->mixins) {
	    if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
		TclOORemoveFromInstances(o2Ptr, mixinPtr);
	    }
	    TclOODecrRefCount(mixinPtr->thisPtr);
	}
	Tcl_Free(o2Ptr->mixins.list);
    }
    DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *);
    FOREACH(mixinPtr, o2Ptr->mixins) {
	if (mixinPtr && mixinPtr != o2Ptr->selfCls) {
	    TclOOAddToInstances(o2Ptr, mixinPtr);
	}

	/*
	 * For the reference just created in DUPLICATE.
	 */

	AddRef(mixinPtr->thisPtr);
    }

    /*
     * Copy the object's filter list to the new object.
     */

    DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
    FOREACH(filterObj, o2Ptr->filters) {
	Tcl_IncrRefCount(filterObj);
    }

    /*
     * Copy the object's variable resolution lists to the new object.
     */

    DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
    FOREACH(variableObj, o2Ptr->variables) {
	Tcl_IncrRefCount(variableObj);
    }

    DUPLICATE(o2Ptr->privateVariables, oPtr->privateVariables,
	    PrivateVariableMapping);
    FOREACH_STRUCT(privateVariable, o2Ptr->privateVariables) {
	Tcl_IncrRefCount(privateVariable->variableObj);
	Tcl_IncrRefCount(privateVariable->fullNameObj);
    }

    /*
     * 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_DESTRUCTING | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value, duplicate;

	FOREACH_HASH(metadataTypePtr, value, oPtr->metadataPtr) {
	    if (metadataTypePtr->cloneProc == NULL) {
		duplicate = value;
	    } else {
		if (metadataTypePtr->cloneProc(interp, value,
			&duplicate) != TCL_OK) {
		    Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
		    return NULL;
		}
	    }
	    if (duplicate != NULL) {
		Tcl_ObjectSetMetadata((Tcl_Object) o2Ptr, metadataTypePtr,
			duplicate);
	    }
	}
    }

    /*
     * Copy the class, if present. Note that if there is a class present in
     * the source object, there must also be one in the copy.
     */

    if (oPtr->classPtr != NULL) {
	Class *clsPtr = oPtr->classPtr;
	Class *cls2Ptr = o2Ptr->classPtr;
	Class *superPtr;

	/*
	 * Copy the class flags across.
	 */

	cls2Ptr->flags = clsPtr->flags;

	/*
	 * Ensure that the new class's superclass structure is the same as the
	 * old class's.
	 */

	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOORemoveFromSubclasses(cls2Ptr, superPtr);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	if (cls2Ptr->superclasses.num) {
	    cls2Ptr->superclasses.list = (Class **)Tcl_Realloc(cls2Ptr->superclasses.list,
		    sizeof(Class *) * clsPtr->superclasses.num);
	} else {
	    cls2Ptr->superclasses.list =
		    (Class **)Tcl_Alloc(sizeof(Class *) * clsPtr->superclasses.num);
	}
	memcpy(cls2Ptr->superclasses.list, clsPtr->superclasses.list,
		sizeof(Class *) * clsPtr->superclasses.num);
	cls2Ptr->superclasses.num = clsPtr->superclasses.num;
	FOREACH(superPtr, cls2Ptr->superclasses) {
	    TclOOAddToSubclasses(cls2Ptr, superPtr);

	    /*
	     * For the new item in cls2Ptr->superclasses that memcpy just
	     * created.
	     */

	    AddRef(superPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's filters.
	 */

	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
	FOREACH(filterObj, cls2Ptr->filters) {
	    Tcl_IncrRefCount(filterObj);
	}

	/*
	 * Copy the source class's variable resolution lists.
	 */

	DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
	FOREACH(variableObj, cls2Ptr->variables) {
	    Tcl_IncrRefCount(variableObj);
	}

	DUPLICATE(cls2Ptr->privateVariables, clsPtr->privateVariables,
		PrivateVariableMapping);
	FOREACH_STRUCT(privateVariable, cls2Ptr->privateVariables) {
	    Tcl_IncrRefCount(privateVariable->variableObj);
	    Tcl_IncrRefCount(privateVariable->fullNameObj);
	}

	/*
	 * Duplicate the source class's mixins (which cannot be circular
	 * references to the duplicate).
	 */

	if (cls2Ptr->mixins.num != 0) {
	    FOREACH(mixinPtr, cls2Ptr->mixins) {
		TclOORemoveFromMixinSubs(cls2Ptr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    Tcl_Free(clsPtr->mixins.list);
	}
	DUPLICATE(cls2Ptr->mixins, clsPtr->mixins, Class *);
	FOREACH(mixinPtr, cls2Ptr->mixins) {
	    TclOOAddToMixinSubs(cls2Ptr, mixinPtr);

	    /*
	     * For the copy just created in DUPLICATE.
	     */

	    AddRef(mixinPtr->thisPtr);
	}

	/*
	 * Duplicate the source class's methods, constructor and destructor.
	 */

	FOREACH_HASH(keyPtr, mPtr, &clsPtr->classMethods) {
	    if (CloneClassMethod(interp, cls2Ptr, mPtr, keyPtr,
		    NULL) != TCL_OK) {
		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
		return NULL;
	    }
	}
	if (clsPtr->constructorPtr) {
	    if (CloneClassMethod(interp, cls2Ptr, clsPtr->constructorPtr,
		    NULL, &cls2Ptr->constructorPtr) != TCL_OK) {
		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
		return NULL;
	    }
	}
	if (clsPtr->destructorPtr) {
	    if (CloneClassMethod(interp, cls2Ptr, clsPtr->destructorPtr, NULL,
		    &cls2Ptr->destructorPtr) != TCL_OK) {
		Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
		return NULL;
	    }
	}

	/*
	 * Duplicate the class's metadata.
	 */

	if (clsPtr->metadataPtr != NULL) {
	    Tcl_ObjectMetadataType *metadataTypePtr;
	    ClientData value, duplicate;

	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		if (metadataTypePtr->cloneProc == NULL) {
		    duplicate = value;
		} else {
		    if (metadataTypePtr->cloneProc(interp, value,
			    &duplicate) != TCL_OK) {
			Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
			return NULL;
		    }
		}
		if (duplicate != NULL) {
		    Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr,
			    duplicate);
		}
	    }
	}
    }

    TclResetRewriteEnsemble(interp, 1);
    contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL,
	    NULL, 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;
}

/*
 * ----------------------------------------------------------------------
 *
 * CloneObjectMethod, CloneClassMethod --
 *
 *	Helper functions used for cloning methods. They work identically to
 *	each other, except for the difference between them in how they
 *	register the cloned method on a successful clone.
 *
 * ----------------------------------------------------------------------
 */

static int
CloneObjectMethod(
    Tcl_Interp *interp,
    Object *oPtr,
    Method *mPtr,
    Tcl_Obj *namePtr)
{
    if (mPtr->typePtr == NULL) {
	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	ClientData newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, newClientData);
    } else {
	Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, namePtr,
		mPtr->flags & PUBLIC_METHOD, mPtr->typePtr, mPtr->clientData);
    }
    return TCL_OK;
}

static int
CloneClassMethod(
    Tcl_Interp *interp,
    Class *clsPtr,
    Method *mPtr,
    Tcl_Obj *namePtr,
    Method **m2PtrPtr)
{
    Method *m2Ptr;

    if (mPtr->typePtr == NULL) {
	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, NULL, NULL);
    } else if (mPtr->typePtr->cloneProc) {
	ClientData newClientData;

	if (mPtr->typePtr->cloneProc(interp, mPtr->clientData,
		&newClientData) != TCL_OK) {
	    return TCL_ERROR;
	}
	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
		newClientData);
    } else {
	m2Ptr = (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr,
		namePtr, mPtr->flags & PUBLIC_METHOD, mPtr->typePtr,
		mPtr->clientData);
    }
    if (m2PtrPtr != NULL) {
	*m2PtrPtr = m2Ptr;
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_ClassGetMetadata, Tcl_ClassSetMetadata, Tcl_ObjectGetMetadata,
 * Tcl_ObjectSetMetadata --
 *
 *	Metadata management API. The metadata system allows code in extensions
 *	to attach arbitrary non-NULL pointers to objects and classes without
 *	the different things that might be interested being able to interfere
 *	with each other. Apart from non-NULL-ness, these routines attach no
 *	interpretation to the meaning of the metadata pointers.
 *
 *	The Tcl_*GetMetadata routines get the metadata pointer attached that
 *	has been related with a particular type, or NULL if no metadata
 *	associated with the given type has been attached.
 *
 *	The Tcl_*SetMetadata routines set or delete the metadata pointer that
 *	is related to a particular type. The value associated with the type is
 *	deleted (if present; no-op otherwise) if the value is NULL, and
 *	attached (replacing the previous value, which is deleted if present)
 *	otherwise. This means it is impossible to attach a NULL value for any
 *	metadata type.
 *
 * ----------------------------------------------------------------------
 */

ClientData
Tcl_ClassGetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;

    /*
     * If there's no metadata store attached, the type in question has
     * definitely not been attached either!
     */

    if (clsPtr->metadataPtr == NULL) {
	return NULL;
    }

    /*
     * There is a metadata store, so look in it for the given type.
     */

    hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);

    /*
     * Return the metadata value if we found it, otherwise NULL.
     */

    if (hPtr == NULL) {
	return NULL;
    }
    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ClassSetMetadata(
    Tcl_Class clazz,
    const Tcl_ObjectMetadataType *typePtr,
    ClientData metadata)
{
    Class *clsPtr = (Class *) clazz;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.
     */

    if (clsPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	clsPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(clsPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

    if (metadata == NULL) {
	hPtr = Tcl_FindHashEntry(clsPtr->metadataPtr, (char *) typePtr);
	if (hPtr != NULL) {
	    typePtr->deleteProc(Tcl_GetHashValue(hPtr));
	    Tcl_DeleteHashEntry(hPtr);
	}
	return;
    }

    /*
     * Otherwise we're attaching the metadata. Note that if there was already
     * some metadata attached of this type, we delete that first.
     */

    hPtr = Tcl_CreateHashEntry(clsPtr->metadataPtr, (char *) typePtr, &isNew);
    if (!isNew) {
	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
    }
    Tcl_SetHashValue(hPtr, metadata);
}

ClientData
Tcl_ObjectGetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;

    /*
     * If there's no metadata store attached, the type in question has
     * definitely not been attached either!
     */

    if (oPtr->metadataPtr == NULL) {
	return NULL;
    }

    /*
     * There is a metadata store, so look in it for the given type.
     */

    hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);

    /*
     * Return the metadata value if we found it, otherwise NULL.
     */

    if (hPtr == NULL) {
	return NULL;
    }
    return Tcl_GetHashValue(hPtr);
}

void
Tcl_ObjectSetMetadata(
    Tcl_Object object,
    const Tcl_ObjectMetadataType *typePtr,
    ClientData metadata)
{
    Object *oPtr = (Object *) object;
    Tcl_HashEntry *hPtr;
    int isNew;

    /*
     * Attach the metadata store if not done already.
     */

    if (oPtr->metadataPtr == NULL) {
	if (metadata == NULL) {
	    return;
	}
	oPtr->metadataPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitHashTable(oPtr->metadataPtr, TCL_ONE_WORD_KEYS);
    }

    /*
     * If the metadata is NULL, we're deleting the metadata for the type.
     */

    if (metadata == NULL) {
	hPtr = Tcl_FindHashEntry(oPtr->metadataPtr, (char *) typePtr);
	if (hPtr != NULL) {
	    typePtr->deleteProc(Tcl_GetHashValue(hPtr));
	    Tcl_DeleteHashEntry(hPtr);
	}
	return;
    }

    /*
     * Otherwise we're attaching the metadata. Note that if there was already
     * some metadata attached of this type, we delete that first.
     */

    hPtr = Tcl_CreateHashEntry(oPtr->metadataPtr, (char *) typePtr, &isNew);
    if (!isNew) {
	typePtr->deleteProc(Tcl_GetHashValue(hPtr));
    }
    Tcl_SetHashValue(hPtr, metadata);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOPublicObjectCmd, TclOOPrivateObjectCmd, TclOOInvokeObject --
 *
 *	Main entry point for object invocations. The Public* and Private*
 *	wrapper functions (implementations of both object instance commands
 *	and [my]) are just thin wrappers round the main TclOOObjectCmdCore
 *	function. Note that the core is function is NRE-aware.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOPublicObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PublicNRObjectCmd, clientData,objc,objv);
}

static int
PublicNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, PUBLIC_METHOD,
	    NULL);
}

int
TclOOPrivateObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, PrivateNRObjectCmd,clientData,objc,objv);
}

static int
PrivateNRObjectCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return TclOOObjectCmdCore((Object *)clientData, interp, objc, objv, 0, NULL);
}

int
TclOOInvokeObject(
    Tcl_Interp *interp,		/* Interpreter for commands, variables,
				 * results, error reporting, etc. */
    Tcl_Object object,		/* The object to invoke. */
    Tcl_Class startCls,		/* Where in the class chain to start the
				 * invoke from, or NULL to traverse the whole
				 * chain including filters. */
    int publicPrivate,		/* Whether this is an invoke from a public
				 * context (PUBLIC_METHOD), a private context
				 * (PRIVATE_METHOD), or a *really* private
				 * context (any other value; conventionally
				 * 0). */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Array of argument objects. It is assumed
				 * that the name of the method to invoke will
				 * be at index 1. */
{
    switch (publicPrivate) {
    case PUBLIC_METHOD:
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
		PUBLIC_METHOD, (Class *) startCls);
    case PRIVATE_METHOD:
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv,
		PRIVATE_METHOD, (Class *) startCls);
    default:
	return TclOOObjectCmdCore((Object *) object, interp, objc, objv, 0,
		(Class *) startCls);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOMyClassObjCmd, MyClassNRObjCmd --
 *
 *	Special trap door to allow an object to delegate simply to its class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOMyClassObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
}

static int
MyClassNRObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *)clientData;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
	return TCL_ERROR;
    }
    return TclOOObjectCmdCore(oPtr->selfCls->thisPtr, interp, objc, objv, 0,
	    NULL);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectCmdCore, FinalizeObjectCall --
 *
 *	Main function for object invocations. Does call chain creation,
 *	management and invocation. The function FinalizeObjectCall exists to
 *	clean up after the non-recursive processing of TclOOObjectCmdCore.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOObjectCmdCore(
    Object *oPtr,		/* The object being invoked. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    int objc,			/* How many arguments are being passed in. */
    Tcl_Obj *const *objv,	/* The array of arguments. */
    int flags,			/* Whether this is an invocation through the
				 * public or the private command interface. */
    Class *startCls)		/* Where to start in the call chain, or NULL
				 * if we are to start at the front with
				 * filters and the object's methods (which is
				 * the normal case). */
{
    CallContext *contextPtr;
    Tcl_Obj *methodNamePtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Object *callerObjPtr = NULL;
    Class *callerClsPtr = NULL;
    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;
    }

    /*
     * Determine if we're in a context that can see the extra, private methods
     * in this class.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContextPtr = (CallContext *)framePtr->clientData;
	Method *callerMethodPtr =
		callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;

	if (callerMethodPtr->declaringObjectPtr) {
	    callerObjPtr = callerMethodPtr->declaringObjectPtr;
	}
	if (callerMethodPtr->declaringClassPtr) {
	    callerClsPtr = callerMethodPtr->declaringClassPtr;
	}
    }

    /*
     * Give plugged in code a chance to remap the method name.
     */

    methodNamePtr = objv[1];
    if (oPtr->mapMethodNameProc != NULL) {
	Class **startClsPtr = &startCls;
	Tcl_Obj *mappedMethodName = Tcl_DuplicateObj(methodNamePtr);

	result = oPtr->mapMethodNameProc(interp, (Tcl_Object) oPtr,
		(Tcl_Class *) startClsPtr, mappedMethodName);
	if (result != TCL_OK) {
	    TclDecrRefCount(mappedMethodName);
	    if (result == TCL_BREAK) {
		goto noMapping;
	    } else if (result == TCL_ERROR) {
		Tcl_AddErrorInfo(interp, "\n    (while mapping method name)");
	    }
	    return result;
	}

	/*
	 * Get the call chain for the remapped name.
	 */

	Tcl_IncrRefCount(mappedMethodName);
	contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
		flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
		callerClsPtr, methodNamePtr);
	TclDecrRefCount(mappedMethodName);
	if (contextPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "impossible to invoke method \"%s\": no defined method or"
		    " unknown method", TclGetString(methodNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD_MAPPED",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;
	}
    } else {
	/*
	 * Get the call chain.
	 */

    noMapping:
	contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
		flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
		callerClsPtr, NULL);
	if (contextPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "impossible to invoke method \"%s\": no defined method or"
		    " unknown method", TclGetString(methodNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(methodNamePtr), NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Check to see if we need to apply magical tricks to start part way
     * through the call chain.
     */

    if (startCls != NULL) {
	for (; contextPtr->index < contextPtr->callPtr->numChain;
		contextPtr->index++) {
	    struct MInvoke *miPtr =
		    &contextPtr->callPtr->chain[contextPtr->index];

	    if (miPtr->isFilter) {
		continue;
	    }
	    if (miPtr->mPtr->declaringClassPtr == startCls) {
		break;
	    }
	}
	if (contextPtr->index >= contextPtr->callPtr->numChain) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "no valid method implementation", -1));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(methodNamePtr), NULL);
	    TclOODeleteContext(contextPtr);
	    return TCL_ERROR;
	}
    }

    /*
     * Invoke the call chain, locking the object structure against deletion
     * for the duration.
     */

    TclNRAddCallback(interp, FinalizeObjectCall, contextPtr, NULL,NULL,NULL);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeObjectCall(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    /*
     * Dispose of the call chain, which drops the lock on the object's
     * structure.
     */

    TclOODeleteContext((CallContext *)data[0]);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_ObjectContextInvokeNext, TclNRObjectContextInvokeNext, FinalizeNext --
 *
 *	Invokes the next stage of the call chain described in an object
 *	context. This is the core of the implementation of the [next] command.
 *	Does not do management of the call-frame stack. Available in public
 *	(standard API) and private (NRE-aware) forms. FinalizeNext is a
 *	private function used to clean up in the NRE case.
 *
 * ----------------------------------------------------------------------
 */

int
Tcl_ObjectContextInvokeNext(
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv,
    int skip)
{
    CallContext *contextPtr = (CallContext *) context;
    int savedIndex = contextPtr->index;
    int savedSkip = contextPtr->skip;
    int result;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */

	const char *methodType;

	if (Tcl_InterpDeleted(interp)) {
	    return TCL_OK;
	}

	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
	    methodType = "constructor";
	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
	    methodType = "destructor";
	} else {
	    methodType = "method";
	}

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no next %s implementation", methodType));
	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
	return TCL_ERROR;
    }

    /*
     * Advance to the next method implementation in the chain in the method
     * call context while we process the body. However, need to adjust the
     * argument-skip control because we're guaranteed to have a single prefix
     * arg (i.e., 'next') and not the variable amount that can happen because
     * method invocations (i.e., '$obj meth' and 'my meth'), constructors
     * (i.e., '$cls new' and '$cls create obj') and destructors (no args at
     * all) come through the same code.
     */

    contextPtr->index++;
    contextPtr->skip = skip;

    /*
     * Invoke the (advanced) method call context in the caller context.
     */

    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, objc,
	    objv);

    /*
     * Restore the call chain context index as we've finished the inner invoke
     * and want to operate in the outer context again.
     */

    contextPtr->index = savedIndex;
    contextPtr->skip = savedSkip;

    return result;
}

int
TclNRObjectContextInvokeNext(
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv,
    int skip)
{
    CallContext *contextPtr = (CallContext *) context;

    if (contextPtr->index + 1 >= contextPtr->callPtr->numChain) {
	/*
	 * We're at the end of the chain; generate an error message unless the
	 * interpreter is being torn down, in which case we might be getting
	 * here because of methods/destructors doing a [next] (or equivalent)
	 * unexpectedly.
	 */

	const char *methodType;

	if (Tcl_InterpDeleted(interp)) {
	    return TCL_OK;
	}

	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
	    methodType = "constructor";
	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
	    methodType = "destructor";
	} else {
	    methodType = "method";
	}

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"no next %s implementation", methodType));
	Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", NULL);
	return TCL_ERROR;
    }

    /*
     * Advance to the next method implementation in the chain in the method
     * call context while we process the body. However, need to adjust the
     * argument-skip control because we're guaranteed to have a single prefix
     * arg (i.e., 'next') and not the variable amount that can happen because
     * method invocations (i.e., '$obj meth' and 'my meth'), constructors
     * (i.e., '$cls new' and '$cls create obj') and destructors (no args at
     * all) come through the same code.
     */

    TclNRAddCallback(interp, FinalizeNext, contextPtr,
	    INT2PTR(contextPtr->index), INT2PTR(contextPtr->skip), NULL);
    contextPtr->index++;
    contextPtr->skip = skip;

    /*
     * Invoke the (advanced) method call context in the caller context.
     */

    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeNext(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    /*
     * Restore the call chain context index as we've finished the inner invoke
     * and want to operate in the outer context again.
     */

    contextPtr->index = PTR2INT(data[1]);
    contextPtr->skip = PTR2INT(data[2]);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_GetObjectFromObj --
 *
 *	Utility function to get an object from a Tcl_Obj containing its name.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Object
Tcl_GetObjectFromObj(
    Tcl_Interp *interp,		/* Interpreter in which to locate the object.
				 * Will have an error message placed in it if
				 * the name does not refer to an object. */
    Tcl_Obj *objPtr)		/* The name of the object to look up, which is
				 * exactly the name of its public command. */
{
    Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr);

    if (cmdPtr == NULL) {
	goto notAnObject;
    }
    if (cmdPtr->objProc != TclOOPublicObjectCmd) {
	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
	if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) {
	    goto notAnObject;
	}
    }
    return (Tcl_Object)cmdPtr->objClientData;

  notAnObject:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s does not refer to an object", TclGetString(objPtr)));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "OBJECT", TclGetString(objPtr),
	    NULL);
    return NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOIsReachable --
 *
 *	Utility function that tests whether a class is a subclass (whether
 *	directly or indirectly) of another class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOIsReachable(
    Class *targetPtr,
    Class *startPtr)
{
    int i;
    Class *superPtr;

  tailRecurse:
    if (startPtr == targetPtr) {
	return 1;
    }
    if (startPtr->superclasses.num == 1 && startPtr->mixins.num == 0) {
	startPtr = startPtr->superclasses.list[0];
	goto tailRecurse;
    }
    FOREACH(superPtr, startPtr->superclasses) {
	if (TclOOIsReachable(targetPtr, superPtr)) {
	    return 1;
	}
    }
    FOREACH(superPtr, startPtr->mixins) {
	if (TclOOIsReachable(targetPtr, superPtr)) {
	    return 1;
	}
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectName, Tcl_GetObjectName --
 *
 *	Utility function that returns the name of the object. Note that this
 *	simplifies cache management by keeping the code to do it in one place
 *	and not sprayed all over. The value returned always has a reference
 *	count of at least one.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Obj *
TclOOObjectName(
    Tcl_Interp *interp,
    Object *oPtr)
{
    Tcl_Obj *namePtr;

    if (oPtr->cachedNameObj) {
	return oPtr->cachedNameObj;
    }
    TclNewObj(namePtr);
    Tcl_GetCommandFullName(interp, oPtr->command, namePtr);
    Tcl_IncrRefCount(namePtr);
    oPtr->cachedNameObj = namePtr;
    return namePtr;
}

Tcl_Obj *
Tcl_GetObjectName(
    Tcl_Interp *interp,
    Tcl_Object object)
{
    return TclOOObjectName(interp, (Object *) object);
}

/*
 * ----------------------------------------------------------------------
 *
 * assorted trivial 'getter' functions
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
Tcl_ObjectContextMethod(
    Tcl_ObjectContext context)
{
    CallContext *contextPtr = (CallContext *) context;
    return (Tcl_Method) contextPtr->callPtr->chain[contextPtr->index].mPtr;
}

int
Tcl_ObjectContextIsFiltering(
    Tcl_ObjectContext context)
{
    CallContext *contextPtr = (CallContext *) context;
    return contextPtr->callPtr->chain[contextPtr->index].isFilter;
}

Tcl_Object
Tcl_ObjectContextObject(
    Tcl_ObjectContext context)
{
    return (Tcl_Object) ((CallContext *)context)->oPtr;
}

int
Tcl_ObjectContextSkippedArgs(
    Tcl_ObjectContext context)
{
    return ((CallContext *)context)->skip;
}

Tcl_Namespace *
Tcl_GetObjectNamespace(
    Tcl_Object object)
{
    return ((Object *)object)->namespacePtr;
}

Tcl_Command
Tcl_GetObjectCommand(
    Tcl_Object object)
{
    return ((Object *)object)->command;
}

Tcl_Class
Tcl_GetObjectAsClass(
    Tcl_Object object)
{
    return (Tcl_Class) ((Object *)object)->classPtr;
}

int
Tcl_ObjectDeleted(
    Tcl_Object object)
{
    return ((Object *)object)->command == NULL;
}

Tcl_Object
Tcl_GetClassAsObject(
    Tcl_Class clazz)
{
    return (Tcl_Object) ((Class *)clazz)->thisPtr;
}

Tcl_ObjectMapMethodNameProc *
Tcl_ObjectGetMethodNameMapper(
    Tcl_Object object)
{
    return ((Object *) object)->mapMethodNameProc;
}

void
Tcl_ObjectSetMethodNameMapper(
    Tcl_Object object,
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
{
    ((Object *) object)->mapMethodNameProc = mapMethodNameProc;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOO.decls.

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





























































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# tclOO.decls --
#
#	This file contains the declarations for all supported public functions
#	that are exported by the TclOO package that is embedded within the Tcl
#	library via the stubs table.  This file is used to generate the
#	tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files.
#
# Copyright (c) 2008-2013 by Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tclOO

######################################################################
# Public API, exposed for general users of TclOO.
#

interface tclOO
hooks tclOOInt
scspec TCLAPI

declare 0 {
    Tcl_Object Tcl_CopyObjectInstance(Tcl_Interp *interp,
	    Tcl_Object sourceObject, const char *targetName,
	    const char *targetNamespaceName)
}
declare 1 {
    Tcl_Object Tcl_GetClassAsObject(Tcl_Class clazz)
}
declare 2 {
    Tcl_Class Tcl_GetObjectAsClass(Tcl_Object object)
}
declare 3 {
    Tcl_Command Tcl_GetObjectCommand(Tcl_Object object)
}
declare 4 {
    Tcl_Object Tcl_GetObjectFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 5 {
    Tcl_Namespace *Tcl_GetObjectNamespace(Tcl_Object object)
}
declare 6 {
    Tcl_Class Tcl_MethodDeclarerClass(Tcl_Method method)
}
declare 7 {
    Tcl_Object Tcl_MethodDeclarerObject(Tcl_Method method)
}
declare 8 {
    int Tcl_MethodIsPublic(Tcl_Method method)
}
declare 9 {
    int Tcl_MethodIsType(Tcl_Method method, const Tcl_MethodType *typePtr,
	    void **clientDataPtr)
}
declare 10 {
    Tcl_Obj *Tcl_MethodName(Tcl_Method method)
}
declare 11 {
    Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    void *clientData)
}
declare 12 {
    Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
	    Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
	    void *clientData)
}
declare 13 {
    Tcl_Object Tcl_NewObjectInstance(Tcl_Interp *interp, Tcl_Class cls,
	    const char *nameStr, const char *nsNameStr, int objc,
	    Tcl_Obj *const *objv, int skip)
}
declare 14 {
    int Tcl_ObjectDeleted(Tcl_Object object)
}
declare 15 {
    int Tcl_ObjectContextIsFiltering(Tcl_ObjectContext context)
}
declare 16 {
    Tcl_Method Tcl_ObjectContextMethod(Tcl_ObjectContext context)
}
declare 17 {
    Tcl_Object Tcl_ObjectContextObject(Tcl_ObjectContext context)
}
declare 18 {
    int Tcl_ObjectContextSkippedArgs(Tcl_ObjectContext context)
}
declare 19 {
    void *Tcl_ClassGetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 20 {
    void Tcl_ClassSetMetadata(Tcl_Class clazz,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 21 {
    void *Tcl_ObjectGetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr)
}
declare 22 {
    void Tcl_ObjectSetMetadata(Tcl_Object object,
	    const Tcl_ObjectMetadataType *typePtr, void *metadata)
}
declare 23 {
    int Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
	    Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv,
	    int skip)
}
declare 24 {
    Tcl_ObjectMapMethodNameProc *Tcl_ObjectGetMethodNameMapper(
	    Tcl_Object object)
}
declare 25 {
    void Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
	    Tcl_ObjectMapMethodNameProc *mapMethodNameProc)
}
declare 26 {
    void Tcl_ClassSetConstructor(Tcl_Interp *interp, Tcl_Class clazz,
	    Tcl_Method method)
}
declare 27 {
    void Tcl_ClassSetDestructor(Tcl_Interp *interp, Tcl_Class clazz,
	    Tcl_Method method)
}
declare 28 {
    Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
}
declare 29 {
    int Tcl_MethodIsPrivate(Tcl_Method method)
}

######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
# TclOO; not intended for general use and does not have any commitment to
# long-term support.
#

interface tclOOInt

declare 0 {
    Tcl_Object TclOOGetDefineCmdContext(Tcl_Interp *interp)
}
declare 1 {
    Tcl_Method TclOOMakeProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    const Tcl_MethodType *typePtr, void *clientData,
	    Proc **procPtrPtr)
}
declare 2 {
    Tcl_Method TclOOMakeProcMethod(Tcl_Interp *interp, Class *clsPtr,
	    int flags, Tcl_Obj *nameObj, const char *namePtr,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr,
	    void *clientData, Proc **procPtrPtr)
}
declare 3 {
    Method *TclOONewProcInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    ProcedureMethod **pmPtrPtr)
}
declare 4 {
    Method *TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
	    int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
	    ProcedureMethod **pmPtrPtr)
}
declare 5 {
    int TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp, int objc,
	    Tcl_Obj *const *objv, int publicOnly, Class *startCls)
}
declare 6 {
    int TclOOIsReachable(Class *targetPtr, Class *startPtr)
}
declare 7 {
    Method *TclOONewForwardMethod(Tcl_Interp *interp, Class *clsPtr,
	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
}
declare 8 {
    Method *TclOONewForwardInstanceMethod(Tcl_Interp *interp, Object *oPtr,
	    int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj)
}
declare 9 {
    Tcl_Method TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
	    Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr,
	    TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc,
	    void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj,
	    Tcl_Obj *bodyObj, int flags, void **internalTokenPtr)
}
declare 10 {
    Tcl_Method TclOONewProcMethodEx(Tcl_Interp *interp, Tcl_Class clsPtr,
	    TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr,
	    ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj,
	    Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags,
	    void **internalTokenPtr)
}
declare 11 {
    int TclOOInvokeObject(Tcl_Interp *interp, Tcl_Object object,
	    Tcl_Class startCls, int publicPrivate, int objc,
	    Tcl_Obj *const *objv)
}
declare 12 {
    void TclOOObjectSetFilters(Object *oPtr, int numFilters,
	    Tcl_Obj *const *filters)
}
declare 13 {
    void TclOOClassSetFilters(Tcl_Interp *interp, Class *classPtr,
	    int numFilters, Tcl_Obj *const *filters)
}
declare 14 {
    void TclOOObjectSetMixins(Object *oPtr, int numMixins,
	    Class *const *mixins)
}
declare 15 {
    void TclOOClassSetMixins(Tcl_Interp *interp, Class *classPtr,
	    int numMixins, Class *const *mixins)
}

return

# Local Variables:
# mode: tcl
# End:

Deleted generic/tclOO.h.

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




























































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOO.h --
 *
 *	This file contains the public API definitions and some of the function
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006-2010 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED

/*
 * Be careful when it comes to versioning; need to make sure that the
 * standalone TclOO version matches. Also make sure that this matches the
 * version in the files:
 *
 * tests/oo.test
 * tests/ooNext2.test
 * unix/tclooConfig.sh
 * win/tclooConfig.sh
 */

#define TCLOO_VERSION "1.2.0"
#define TCLOO_PATCHLEVEL TCLOO_VERSION

#include "tcl.h"

/*
 * For C++ compilers, use extern "C"
 */

#ifdef __cplusplus
extern "C" {
#endif

extern const char *TclOOInitializeStubs(
	Tcl_Interp *, const char *version);
#define Tcl_OOInitStubs(interp) \
    TclOOInitializeStubs((interp), TCLOO_VERSION)
#ifndef USE_TCL_STUBS
#   define TclOOInitializeStubs(interp, version) (TCLOO_PATCHLEVEL)
#endif

/*
 * These are opaque types.
 */

typedef struct Tcl_Class_ *Tcl_Class;
typedef struct Tcl_Method_ *Tcl_Method;
typedef struct Tcl_Object_ *Tcl_Object;
typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;

/*
 * Public datatypes for callbacks and structures used in the TIP#257 (OO)
 * implementation. These are used to implement custom types of method calls
 * and to allow the attachment of arbitrary data to objects and classes.
 */

typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
typedef void (Tcl_MethodDeleteProc)(void *clientData);
typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
	void **newClientData);
typedef void (Tcl_ObjectMetadataDeleteProc)(void *clientData);
typedef int (Tcl_ObjectMapMethodNameProc)(Tcl_Interp *interp,
	Tcl_Object object, Tcl_Class *startClsPtr, Tcl_Obj *methodNameObj);

/*
 * The type of a method implementation. This describes how to call the method
 * implementation, how to delete it (when the object or class is deleted) and
 * how to create a clone of it (when the object or class is copied).
 */

typedef struct {
    int version;		/* Structure version field. Always to be equal
				 * to TCL_OO_METHOD_VERSION_CURRENT in
				 * declarations. */
    const char *name;		/* Name of this type of method, mostly for
				 * debugging purposes. */
    Tcl_MethodCallProc *callProc;
				/* How to invoke this method. */
    Tcl_MethodDeleteProc *deleteProc;
				/* How to delete this method's type-specific
				 * data, or NULL if the type-specific data
				 * does not need deleting. */
    Tcl_CloneProc *cloneProc;	/* How to copy this method's type-specific
				 * data, or NULL if the type-specific data can
				 * be copied directly. */
} Tcl_MethodType;

/*
 * The correct value for the version field of the Tcl_MethodType structure.
 * This allows new versions of the structure to be introduced without breaking
 * binary compatibility.
 */

#define TCL_OO_METHOD_VERSION_CURRENT 1

/*
 * Visibility constants for the flags parameter to Tcl_NewMethod and
 * Tcl_NewInstanceMethod.
 */

#define TCL_OO_METHOD_PUBLIC		1
#define TCL_OO_METHOD_UNEXPORTED	0
#define TCL_OO_METHOD_PRIVATE		0x20

/*
 * The type of some object (or class) metadata. This describes how to delete
 * the metadata (when the object or class is deleted) and how to create a
 * clone of it (when the object or class is copied).
 */

typedef struct {
    int version;		/* Structure version field. Always to be equal
				 * to TCL_OO_METADATA_VERSION_CURRENT in
				 * declarations. */
    const char *name;
    Tcl_ObjectMetadataDeleteProc *deleteProc;
				/* How to delete the metadata. This must not
				 * be NULL. */
    Tcl_CloneProc *cloneProc;	/* How to copy the metadata, or NULL if the
				 * type-specific data can be copied
				 * directly. */
} Tcl_ObjectMetadataType;

/*
 * The correct value for the version field of the Tcl_ObjectMetadataType
 * structure. This allows new versions of the structure to be introduced
 * without breaking binary compatibility.
 */

#define TCL_OO_METADATA_VERSION_CURRENT 1

/*
 * Include all the public API, generated from tclOO.decls.
 */

#include "tclOODecls.h"

#ifdef __cplusplus
}
#endif
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOOBasic.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
1348




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOOBasic.c --
 *
 *	This file contains implementations of the "simple" commands and
 *	methods from the object-system core.
 *
 * Copyright (c) 2005-2013 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

static inline Tcl_Object *AddConstructionFinalizer(Tcl_Interp *interp);
static Tcl_NRPostProc	AfterNRDestructor;
static Tcl_NRPostProc	DecrRefsPostClassConstructor;
static Tcl_NRPostProc	FinalizeConstruction;
static Tcl_NRPostProc	FinalizeEval;
static Tcl_NRPostProc	NextRestoreFrame;

/*
 * ----------------------------------------------------------------------
 *
 * AddCreateCallback, FinalizeConstruction --
 *
 *	Special version of TclNRAddCallback that allows the caller to splice
 *	the object created later on. Always calls FinalizeConstruction, which
 *	converts the object into its name and stores that in the interpreter
 *	result. This is shared by all the construction methods (create,
 *	createWithNamespace, new).
 *
 *	Note that this is the only code in this file (or, indeed, the whole of
 *	TclOO) that uses NRE internals; it is the only code that does
 *	non-standard poking in the NRE guts.
 *
 * ----------------------------------------------------------------------
 */

static inline Tcl_Object *
AddConstructionFinalizer(
    Tcl_Interp *interp)
{
    TclNRAddCallback(interp, FinalizeConstruction, NULL, NULL, NULL, NULL);
    return (Tcl_Object *) &(TOP_CB(interp)->data[0]);
}

static int
FinalizeConstruction(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Object *oPtr = (Object *)data[0];

    if (result != TCL_OK) {
	return result;
    }
    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Constructor --
 *
 *	Implementation for oo::class constructor.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_Constructor(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    Tcl_Obj **invoke, *nameObj;

    if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?definitionScript?");
	return TCL_ERROR;
    } else if (objc == Tcl_ObjectContextSkippedArgs(context)) {
	return TCL_OK;
    }

    /*
     * Make the class definition delegate. This is special; it doesn't reenter
     * here (and the class definition delegate doesn't run any constructors).
     */

    nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1);
    Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1);
    Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
	    TclGetString(nameObj), NULL, -1, NULL, -1);
    Tcl_DecrRefCount(nameObj);

    /*
     * Delegate to [oo::define] to do the work.
     */

    invoke = (Tcl_Obj **)Tcl_Alloc(3 * sizeof(Tcl_Obj *));
    invoke[0] = oPtr->fPtr->defineName;
    invoke[1] = TclOOObjectName(interp, oPtr);
    invoke[2] = objv[objc-1];

    /*
     * Must add references or errors in configuration script will cause
     * trouble.
     */

    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    Tcl_IncrRefCount(invoke[2]);
    TclNRAddCallback(interp, DecrRefsPostClassConstructor,
	    invoke, oPtr, NULL, NULL);

    /*
     * Tricky point: do not want the extra reported level in the Tcl stack
     * trace, so use TCL_EVAL_NOERR.
     */

    return TclNREvalObjv(interp, 3, invoke, TCL_EVAL_NOERR, NULL);
}

static int
DecrRefsPostClassConstructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **invoke = (Tcl_Obj **)data[0];
    Object *oPtr = (Object *)data[1];
    Tcl_InterpState saved;
    int code;

    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    TclDecrRefCount(invoke[2]);
    invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1);
    invoke[1] = TclOOObjectName(interp, oPtr);
    Tcl_IncrRefCount(invoke[0]);
    Tcl_IncrRefCount(invoke[1]);
    saved = Tcl_SaveInterpState(interp, result);
    code = Tcl_EvalObjv(interp, 2, invoke, 0);
    TclDecrRefCount(invoke[0]);
    TclDecrRefCount(invoke[1]);
    Tcl_Free(invoke);
    if (code != TCL_OK) {
	Tcl_DiscardInterpState(saved);
	return code;
    }
    return Tcl_RestoreInterpState(interp, saved);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_Create --
 *
 *	Implementation for oo::class->create method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_Create(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName;
    size_t len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 1) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName ?arg ...?");
	return TCL_ERROR;
    }
    objName = TclGetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

    return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
	    objName, NULL, objc, objv,
	    Tcl_ObjectContextSkippedArgs(context)+1,
	    AddConstructionFinalizer(interp));
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_CreateNs --
 *
 *	Implementation for oo::class->createWithNamespace method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_CreateNs(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    const char *objName, *nsName;
    size_t len;

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Check we have the right number of (sensible) arguments.
     */

    if (objc - Tcl_ObjectContextSkippedArgs(context) < 2) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"objectName namespaceName ?arg ...?");
	return TCL_ERROR;
    }
    objName = TclGetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"object name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }
    nsName = TclGetStringFromObj(
	    objv[Tcl_ObjectContextSkippedArgs(context)+1], &len);
    if (len == 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"namespace name must not be empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", NULL);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

    return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
	    objName, nsName, objc, objv,
	    Tcl_ObjectContextSkippedArgs(context)+2,
	    AddConstructionFinalizer(interp));
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Class_New --
 *
 *	Implementation for oo::class->new method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Class_New(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);

    /*
     * Sanity check; should not be possible to invoke this method on a
     * non-class.
     */

    if (oPtr->classPtr == NULL) {
	Tcl_Obj *cmdnameObj = TclOOObjectName(interp, oPtr);

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" is not a class", TclGetString(cmdnameObj)));
	Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", NULL);
	return TCL_ERROR;
    }

    /*
     * Make the object and return its name.
     */

    return TclNRNewObjectInstance(interp, (Tcl_Class) oPtr->classPtr,
	    NULL, NULL, objc, objv, Tcl_ObjectContextSkippedArgs(context),
	    AddConstructionFinalizer(interp));
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Object_Destroy --
 *
 *	Implementation for oo::object->destroy method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_Destroy(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
    CallContext *contextPtr;

    if (objc != Tcl_ObjectContextSkippedArgs(context)) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
	oPtr->flags |= DESTRUCTOR_CALLED;
	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL,
		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;
}

static int
AfterNRDestructor(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    if (contextPtr->oPtr->command) {
	Tcl_DeleteCommandFromToken(interp, contextPtr->oPtr->command);
    }
    TclOODeleteContext(contextPtr);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Object_Eval --
 *
 *	Implementation for oo::object->eval method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_Eval(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    const int skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr, **framePtrPtr = &framePtr;
    Tcl_Obj *scriptPtr;
    CmdFrame *invoker;

    if (objc-1 < skip) {
	Tcl_WrongNumArgs(interp, skip, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Make the object's namespace the current namespace and evaluate the
     * command(s).
     */

    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    Tcl_GetObjectNamespace(object), 0);
    framePtr->objc = objc;
    framePtr->objv = objv;	/* Reference counts do not need to be
				 * incremented here. */

    if (!(contextPtr->callPtr->flags & PUBLIC_METHOD)) {
	object = NULL;		/* Now just for error mesage printing. */
    }

    /*
     * Work out what script we are actually going to evaluate.
     *
     * When there's more than one argument, we concatenate them together with
     * spaces between, then evaluate the result. Tcl_EvalObjEx will delete the
     * object when it decrements its refcount after eval'ing it.
     */

    if (objc != skip+1) {
	scriptPtr = Tcl_ConcatObj(objc-skip, objv+skip);
	invoker = NULL;
    } else {
	scriptPtr = objv[skip];
	invoker = ((Interp *) interp)->cmdFramePtr;
    }

    /*
     * Evaluate the script now, with FinalizeEval to do the processing after
     * the script completes.
     */

    TclNRAddCallback(interp, FinalizeEval, object, NULL, NULL, NULL);
    return TclNREvalObjEx(interp, scriptPtr, 0, invoker, skip);
}

static int
FinalizeEval(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    if (result == TCL_ERROR) {
	Object *oPtr = (Object *)data[0];
	const char *namePtr;

	if (oPtr) {
	    namePtr = TclGetString(TclOOObjectName(interp, oPtr));
	} else {
	    namePtr = "my";
	}

	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (in \"%s eval\" script line %d)",
		namePtr, Tcl_GetErrorLine(interp)));
    }

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Object_Unknown --
 *
 *	Default unknown method handler method (defined in oo::object). This
 *	just creates a suitable error message.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_Unknown(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *callerObj = NULL;
    Class *callerCls = NULL;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;
    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    Tcl_Obj *errorMsg;

    /*
     * 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;
    }

    /*
     * Determine if the calling context should know about extra private
     * methods, and if so, which.
     */

    if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *callerContext = (CallContext *)framePtr->clientData;
	Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;

	if (mPtr->declaringObjectPtr) {
	    if (oPtr == mPtr->declaringObjectPtr) {
		callerObj = mPtr->declaringObjectPtr;
	    }
	} else {
	    if (TclOOIsReachable(mPtr->declaringClassPtr, oPtr->selfCls)) {
		callerCls = mPtr->declaringClassPtr;
	    }
	}
    }

    /*
     * Get the list of methods that we want to know about.
     */

    numMethodNames = TclOOGetSortedMethodList(oPtr, callerObj, callerCls,
	    contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);

    /*
     * Special message when there are no visible methods at all.
     */

    if (numMethodNames == 0) {
	Tcl_Obj *tmpBuf = TclOOObjectName(interp, oPtr);
	const char *piece;

	if (contextPtr->callPtr->flags & PUBLIC_METHOD) {
	    piece = "visible methods";
	} else {
	    piece = "methods";
	}
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"object \"%s\" has no %s", TclGetString(tmpBuf), piece));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[skip]), NULL);
	return TCL_ERROR;
    }

    errorMsg = Tcl_ObjPrintf("unknown method \"%s\": must be ",
	    TclGetString(objv[skip]));
    for (i=0 ; i<numMethodNames-1 ; i++) {
	if (i) {
	    Tcl_AppendToObj(errorMsg, ", ", -1);
	}
	Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    }
    if (i) {
	Tcl_AppendToObj(errorMsg, " or ", -1);
    }
    Tcl_AppendToObj(errorMsg, methodNames[i], -1);
    Tcl_Free((void *)methodNames);
    Tcl_SetObjResult(interp, errorMsg);
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
	    TclGetString(objv[skip]), NULL);
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Object_LinkVar --
 *
 *	Implementation of oo::object->variable method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_LinkVar(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object = Tcl_ObjectContextObject(context);
    Namespace *savedNsPtr;
    int i;

    if (objc-Tcl_ObjectContextSkippedArgs(context) < 0) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"?varName ...?");
	return TCL_ERROR;
    }

    /*
     * A sanity check. Shouldn't ever happen. (This is all that remains of a
     * more complex check inherited from [global] after we have applied the
     * fix for [Bug 2903811]; note that the fix involved *removing* code.)
     */

    if (iPtr->varFramePtr == NULL) {
	return TCL_OK;
    }

    for (i=Tcl_ObjectContextSkippedArgs(context) ; i<objc ; i++) {
	Var *varPtr, *aryPtr;
	const char *varName = TclGetString(objv[i]);

	/*
	 * The variable name must not contain a '::' since that's illegal in
	 * local names.
	 */

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "variable name \"%s\" illegal: must not contain namespace"
		    " separator", varName));
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Switch to the object's namespace for the duration of this call.
	 * Like this, the variable is looked up in the namespace of the
	 * object, and not in the namespace of the caller. Otherwise this
	 * would only work if the caller was a method of the object itself,
	 * which might not be true if the method was exported. This is a bit
	 * of a hack, but the simplest way to do this (pushing a stack frame
	 * would be horribly expensive by comparison).
	 */

	savedNsPtr = iPtr->varFramePtr->nsPtr;
	iPtr->varFramePtr->nsPtr = (Namespace *)
		Tcl_GetObjectNamespace(object);
	varPtr = TclObjLookupVar(interp, objv[i], NULL, TCL_NAMESPACE_ONLY,
		"define", 1, 0, &aryPtr);
	iPtr->varFramePtr->nsPtr = savedNsPtr;

	if (varPtr == NULL || aryPtr != NULL) {
	    /*
	     * Variable cannot be an element in an array. If aryPtr is not
	     * NULL, it is an element, so throw up an error and return.
	     */

	    TclVarErrMsg(interp, varName, NULL, "define",
		    "name refers to an element in an array");
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Arrange for the lifetime of the variable to be correctly managed.
	 * This is copied out of Tcl_VariableObjCmd...
	 */

	if (!TclIsVarNamespaceVar(varPtr)) {
	    TclSetVarNamespaceVar(varPtr);
	}

	if (TclPtrMakeUpvar(interp, varPtr, varName, 0, -1) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOO_Object_VarName --
 *
 *	Implementation of the oo::object->varname method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOO_Object_VarName(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Interpreter in which to create the object;
				 * also used for error reporting. */
    Tcl_ObjectContext context,	/* The object/call context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    Var *varPtr, *aryVar;
    Tcl_Obj *varNamePtr, *argPtr;
    CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
    const char *arg;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"varName");
	return TCL_ERROR;
    }
    argPtr = objv[objc-1];
    arg = TclGetString(argPtr);

    /*
     * Convert the variable name to fully-qualified form if it wasn't already.
     * This has to be done prior to lookup because we can run into problems
     * with resolvers otherwise. [Bug 3603695]
     *
     * We still need to do the lookup; the variable could be linked to another
     * variable and we want the target's name.
     */

    if (arg[0] == ':' && arg[1] == ':') {
	varNamePtr = argPtr;
    } else {
	Tcl_Namespace *namespacePtr =
		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));

	/*
	 * Private method handling. [TIP 500]
	 *
	 * If we're in a context that can see some private methods of an
	 * object, we may need to precede a variable name with its prefix.
	 * This is a little tricky as we need to check through the inheritance
	 * hierarchy when the method was declared by a class to see if the
	 * current object is an instance of that class.
	 */

	if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
	    Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
	    CallContext *callerContext = (CallContext *)framePtr->clientData;
	    Method *mPtr = callerContext->callPtr->chain[
		    callerContext->index].mPtr;
	    PrivateVariableMapping *pvPtr;
	    int i;

	    if (mPtr->declaringObjectPtr == oPtr) {
		FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
		    if (!strcmp(TclGetString(pvPtr->variableObj),
			    TclGetString(argPtr))) {
			argPtr = pvPtr->fullNameObj;
			break;
		    }
		}
	    } else if (mPtr->declaringClassPtr &&
		    mPtr->declaringClassPtr->privateVariables.num) {
		Class *clsPtr = mPtr->declaringClassPtr;
		int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls);
		Class *mixinCls;

		if (!isInstance) {
		    FOREACH(mixinCls, oPtr->mixins) {
			if (TclOOIsReachable(clsPtr, mixinCls)) {
			    isInstance = 1;
			    break;
			}
		    }
		}
		if (isInstance) {
		    FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) {
			if (!strcmp(TclGetString(pvPtr->variableObj),
				TclGetString(argPtr))) {
			    argPtr = pvPtr->fullNameObj;
			    break;
			}
		    }
		}
	    }
	}

	varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
	Tcl_AppendToObj(varNamePtr, "::", 2);
	Tcl_AppendObjToObj(varNamePtr, argPtr);
    }
    Tcl_IncrRefCount(varNamePtr);
    varPtr = TclObjLookupVar(interp, varNamePtr, NULL,
	    TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG, "refer to", 1, 1, &aryVar);
    Tcl_DecrRefCount(varNamePtr);
    if (varPtr == NULL) {
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", arg, NULL);
	return TCL_ERROR;
    }

    /*
     * Now that we've pinned down what variable we're really talking about
     * (including traversing variable links), convert back to a name.
     */

    TclNewObj(varNamePtr);
    if (aryVar != NULL) {
	Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);

	/*
	 * WARNING! This code pokes inside the implementation of hash tables!
	 */

	Tcl_AppendToObj(varNamePtr, "(", -1);
	Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
		varPtr)->entry.key.objPtr);
	Tcl_AppendToObj(varNamePtr, ")", -1);
    } else {
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
    }
    Tcl_SetObjResult(interp, varNamePtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONextObjCmd, TclOONextToObjCmd --
 *
 *	Implementation of the [next] and [nextto] commands. Note that these
 *	commands are only ever to be used inside the body of a procedure-like
 *	method.
 *
 * ----------------------------------------------------------------------
 */

int
TclOONextObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    Tcl_ObjectContext context;

    /*
     * Start with sanity checks on the calling context to make sure that we
     * are invoked from a suitable method context. If so, we can safely
     * retrieve the handle to the object call context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	return TCL_ERROR;
    }
    context = (Tcl_ObjectContext)framePtr->clientData;

    /*
     * Invoke the (advanced) method call context in the caller context. Note
     * that this is like [uplevel 1] and not [eval].
     */

    TclNRAddCallback(interp, NextRestoreFrame, framePtr, NULL,NULL,NULL);
    iPtr->varFramePtr = framePtr->callerVarPtr;
    return TclNRObjectContextInvokeNext(interp, context, objc, objv, 1);
}

int
TclOONextToObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    Class *classPtr;
    CallContext *contextPtr;
    int i;
    Tcl_Object object;
    const char *methodType;

    /*
     * Start with sanity checks on the calling context to make sure that we
     * are invoked from a suitable method context. If so, we can safely
     * retrieve the handle to the object call context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	return TCL_ERROR;
    }
    contextPtr = (CallContext *)framePtr->clientData;

    /*
     * Sanity check the arguments; we need the first one to refer to a class.
     */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "class ?arg...?");
	return TCL_ERROR;
    }
    object = Tcl_GetObjectFromObj(interp, objv[1]);
    if (object == NULL) {
	return TCL_ERROR;
    }
    classPtr = ((Object *)object)->classPtr;
    if (classPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" is not a class", TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", NULL);
	return TCL_ERROR;
    }

    /*
     * Search for an implementation of a method associated with the current
     * call on the call chain past the point where we currently are. Do not
     * allow jumping backwards!
     */

    for (i=contextPtr->index+1 ; i<contextPtr->callPtr->numChain ; i++) {
	struct MInvoke *miPtr = contextPtr->callPtr->chain + i;

	if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
	    /*
	     * Invoke the (advanced) method call context in the caller
	     * context. Note that this is like [uplevel 1] and not [eval].
	     */

	    TclNRAddCallback(interp, NextRestoreFrame, framePtr,
		    contextPtr, INT2PTR(contextPtr->index), NULL);
	    contextPtr->index = i-1;
	    iPtr->varFramePtr = framePtr->callerVarPtr;
	    return TclNRObjectContextInvokeNext(interp,
		    (Tcl_ObjectContext) contextPtr, objc, objv, 2);
	}
    }

    /*
     * Generate an appropriate error message, depending on whether the value
     * is on the chain but unreachable, or not on the chain at all.
     */

    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
	methodType = "constructor";
    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
	methodType = "destructor";
    } else {
	methodType = "method";
    }

    for (i=contextPtr->index ; i>=0 ; i--) {
	struct MInvoke *miPtr = contextPtr->callPtr->chain + i;

	if (!miPtr->isFilter && miPtr->mPtr->declaringClassPtr == classPtr) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s implementation by \"%s\" not reachable from here",
		    methodType, TclGetString(objv[1])));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
		    NULL);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "%s has no non-filter implementation by \"%s\"",
	    methodType, TclGetString(objv[1])));
    Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", NULL);
    return TCL_ERROR;
}

static int
NextRestoreFrame(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    CallContext *contextPtr = (CallContext *)data[1];

    iPtr->varFramePtr = (CallFrame *)data[0];
    if (contextPtr != NULL) {
	contextPtr->index = PTR2INT(data[2]);
    }
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOSelfObjCmd --
 *
 *	Implementation of the [self] command, which provides introspection of
 *	the call context.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOSelfObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    static const char *const subcmds[] = {
	"call", "caller", "class", "filter", "method", "namespace", "next",
	"object", "target", NULL
    };
    enum SelfCmds {
	SELF_CALL, SELF_CALLER, SELF_CLASS, SELF_FILTER, SELF_METHOD, SELF_NS,
	SELF_NEXT, SELF_OBJECT, SELF_TARGET
    };
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *result[3];
    int index;

#define CurrentlyInvoked(contextPtr) \
    ((contextPtr)->callPtr->chain[(contextPtr)->index])

    /*
     * Start with sanity checks on the calling context and the method context.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s may only be called from inside a method",
		TclGetString(objv[0])));
	Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	return TCL_ERROR;
    }

    contextPtr = (CallContext*)framePtr->clientData;

    /*
     * Now we do "conventional" argument parsing for a while. Note that no
     * subcommand takes arguments.
     */

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "subcommand");
	return TCL_ERROR;
    } else if (objc == 1) {
	index = SELF_OBJECT;
    } else if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "subcommand", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum SelfCmds) index) {
    case SELF_OBJECT:
	Tcl_SetObjResult(interp, TclOOObjectName(interp, contextPtr->oPtr));
	return TCL_OK;
    case SELF_NS:
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		contextPtr->oPtr->namespacePtr->fullName,-1));
	return TCL_OK;
    case SELF_CLASS: {
	Class *clsPtr = CurrentlyInvoked(contextPtr).mPtr->declaringClassPtr;

	if (clsPtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "method not defined by a class", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
	return TCL_OK;
    }
    case SELF_METHOD:
	if (contextPtr->callPtr->flags & CONSTRUCTOR) {
	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->constructorName);
	} else if (contextPtr->callPtr->flags & DESTRUCTOR) {
	    Tcl_SetObjResult(interp, contextPtr->oPtr->fPtr->destructorName);
	} else {
	    Tcl_SetObjResult(interp,
		    CurrentlyInvoked(contextPtr).mPtr->namePtr);
	}
	return TCL_OK;
    case SELF_FILTER:
	if (!CurrentlyInvoked(contextPtr).isFilter) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	} else {
	    struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
	    Object *oPtr;
	    const char *type;

	    if (miPtr->filterDeclarer != NULL) {
		oPtr = miPtr->filterDeclarer->thisPtr;
		type = "class";
	    } else {
		oPtr = contextPtr->oPtr;
		type = "object";
	    }

	    result[0] = TclOOObjectName(interp, oPtr);
	    result[1] = Tcl_NewStringObj(type, -1);
	    result[2] = miPtr->mPtr->namePtr;
	    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
	    return TCL_OK;
	}
    case SELF_CALLER:
	if ((framePtr->callerVarPtr == NULL) ||
		!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "caller is not an object", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", NULL);
	    return TCL_ERROR;
	} else {
	    CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData;
	    Method *mPtr = callerPtr->callPtr->chain[callerPtr->index].mPtr;
	    Object *declarerPtr;

	    if (mPtr->declaringClassPtr != NULL) {
		declarerPtr = mPtr->declaringClassPtr->thisPtr;
	    } else if (mPtr->declaringObjectPtr != NULL) {
		declarerPtr = mPtr->declaringObjectPtr;
	    } else {
		/*
		 * This should be unreachable code.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"method without declarer!", -1));
		return TCL_ERROR;
	    }

	    result[0] = TclOOObjectName(interp, declarerPtr);
	    result[1] = TclOOObjectName(interp, callerPtr->oPtr);
	    if (callerPtr->callPtr->flags & CONSTRUCTOR) {
		result[2] = declarerPtr->fPtr->constructorName;
	    } else if (callerPtr->callPtr->flags & DESTRUCTOR) {
		result[2] = declarerPtr->fPtr->destructorName;
	    } else {
		result[2] = mPtr->namePtr;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
	    return TCL_OK;
	}
    case SELF_NEXT:
	if (contextPtr->index < contextPtr->callPtr->numChain-1) {
	    Method *mPtr =
		    contextPtr->callPtr->chain[contextPtr->index+1].mPtr;
	    Object *declarerPtr;

	    if (mPtr->declaringClassPtr != NULL) {
		declarerPtr = mPtr->declaringClassPtr->thisPtr;
	    } else if (mPtr->declaringObjectPtr != NULL) {
		declarerPtr = mPtr->declaringObjectPtr;
	    } else {
		/*
		 * This should be unreachable code.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"method without declarer!", -1));
		return TCL_ERROR;
	    }

	    result[0] = TclOOObjectName(interp, declarerPtr);
	    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
		result[1] = declarerPtr->fPtr->constructorName;
	    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
		result[1] = declarerPtr->fPtr->destructorName;
	    } else {
		result[1] = mPtr->namePtr;
	    }
	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	}
	return TCL_OK;
    case SELF_TARGET:
	if (!CurrentlyInvoked(contextPtr).isFilter) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "not inside a filtering context", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", NULL);
	    return TCL_ERROR;
	} else {
	    Method *mPtr;
	    Object *declarerPtr;
	    int i;

	    for (i=contextPtr->index ; i<contextPtr->callPtr->numChain ; i++){
		if (!contextPtr->callPtr->chain[i].isFilter) {
		    break;
		}
	    }
	    if (i == contextPtr->callPtr->numChain) {
		Tcl_Panic("filtering call chain without terminal non-filter");
	    }
	    mPtr = contextPtr->callPtr->chain[i].mPtr;
	    if (mPtr->declaringClassPtr != NULL) {
		declarerPtr = mPtr->declaringClassPtr->thisPtr;
	    } else if (mPtr->declaringObjectPtr != NULL) {
		declarerPtr = mPtr->declaringObjectPtr;
	    } else {
		/*
		 * This should be unreachable code.
		 */

		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"method without declarer!", -1));
		return TCL_ERROR;
	    }
	    result[0] = TclOOObjectName(interp, declarerPtr);
	    result[1] = mPtr->namePtr;
	    Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	    return TCL_OK;
	}
    case SELF_CALL:
	result[0] = TclOORenderCallChain(interp, contextPtr->callPtr);
	TclNewIntObj(result[1], contextPtr->index);
	Tcl_SetObjResult(interp, Tcl_NewListObj(2, result));
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * CopyObjectCmd --
 *
 *	Implementation of the [oo::copy] command, which clones an object (but
 *	not its namespace). Note that no constructors are called during this
 *	process.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOCopyObjectCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Object oPtr, o2Ptr;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
			 "sourceName ?targetName? ?targetNamespace?");
	return TCL_ERROR;
    }

    oPtr = Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Create a cloned object of the correct class. Note that constructors are
     * not called. Also note that we must resolve the object name ourselves
     * because we do not want to create the object in the current namespace,
     * but rather in the context of the namespace of the caller of the overall
     * [oo::define] command.
     */

    if (objc == 2) {
	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, NULL, NULL);
    } else {
	const char *name, *namespaceName;

	name = TclGetString(objv[2]);
	if (name[0] == '\0') {
	    name = NULL;
	}

	/*
	 * Choose a unique namespace name if the user didn't supply one.
	 */

	namespaceName = NULL;
	if (objc == 4) {
	    namespaceName = TclGetString(objv[3]);

	    if (namespaceName[0] == '\0') {
		namespaceName = NULL;
	    } else if (Tcl_FindNamespace(interp, namespaceName, NULL,
		    0) != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s refers to an existing namespace", namespaceName));
		return TCL_ERROR;
	    }
	}

	o2Ptr = Tcl_CopyObjectInstance(interp, oPtr, name, namespaceName);
    }

    if (o2Ptr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Return the name of the cloned object.
     */

    Tcl_SetObjResult(interp, TclOOObjectName(interp, (Object *) o2Ptr));
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOOCall.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOOCall.c --
 *
 *	This file contains the method call chain management code for the
 *	object-system core.
 *
 * Copyright (c) 2005-2012 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include <assert.h>

/*
 * Structure containing a CallContext and any other values needed only during
 * the construction of the CallContext.
 */

struct ChainBuilder {
    CallChain *callChainPtr;	/* The call chain being built. */
    int filterLength;		/* Number of entries in the call chain that
				 * are due to processing filters and not the
				 * main call chain. */
    Object *oPtr;		/* The object that we are building the chain
				 * for. */
};

/*
 * Structures used for traversing the class hierarchy to find out where
 * definitions are supposed to be done.
 */

typedef struct {
    Class *definerCls;
    Tcl_Obj *namespaceName;
} DefineEntry;

typedef struct {
    DefineEntry *list;
    int num;
    int size;
} DefineChain;

/*
 * 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)
#define BUILDING_MIXINS	   0x400000
#define TRAVERSED_MIXIN	   0x800000
#define OBJECT_MIXIN	   0x1000000
#define MIXIN_CONSISTENT(flags) \
    (((flags) & OBJECT_MIXIN) ||					\
	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))

/*
 * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
 * Itcl's special type of private.
 */

#define IS_PUBLIC(mPtr)				\
    (((mPtr)->flags & PUBLIC_METHOD) != 0)
#define IS_UNEXPORTED(mPtr)			\
    (((mPtr)->flags & SCOPE_FLAGS) == 0)
#define IS_ITCLPRIVATE(mPtr)				\
    (((mPtr)->flags & PRIVATE_METHOD) != 0)
#define IS_PRIVATE(mPtr)			\
    (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
#define WANT_PUBLIC(flags)			\
    (((flags) & PUBLIC_METHOD) != 0)
#define WANT_UNEXPORTED(flags)			\
    (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
#define WANT_ITCLPRIVATE(flags)			\
    (((flags) & PRIVATE_METHOD) != 0)
#define WANT_PRIVATE(flags)			\
    (((flags) & TRUE_PRIVATE_METHOD) != 0)

/*
 * Function declarations for things defined in this file.
 */

static void		AddClassFiltersToCallContext(Object *const oPtr,
			    Class *clsPtr, struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags);
static void		AddClassMethodNames(Class *clsPtr, const int flags,
			    Tcl_HashTable *const namesPtr,
			    Tcl_HashTable *const examinedClassesPtr);
static inline void	AddDefinitionNamespaceToChain(Class *const definerCls,
			    Tcl_Obj *const namespaceName,
			    DefineChain *const definePtr, int flags);
static inline void	AddMethodToCallChain(Method *const mPtr,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters,
			    Class *const filterDecl, int flags);
static inline int	AddInstancePrivateToCallContext(Object *const oPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr, int flags);
static inline void	AddStandardMethodName(int flags, Tcl_Obj *namePtr,
			    Method *mPtr, Tcl_HashTable *namesPtr);
static inline void	AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
			    Tcl_HashTable *namesPtr);
static inline int	AddSimpleChainToCallContext(Object *const oPtr,
			    Class *const contextCls,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		AddPrivatesFromClassChainToCallContext(Class *classPtr,
			    Class *const contextCls,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static int		AddSimpleClassChainToCallContext(Class *classPtr,
			    Tcl_Obj *const methodNameObj,
			    struct ChainBuilder *const cbPtr,
			    Tcl_HashTable *const doneFilters, int flags,
			    Class *const filterDecl);
static void		AddSimpleClassDefineNamespaces(Class *classPtr,
			    DefineChain *const definePtr, int flags);
static inline void	AddSimpleDefineNamespaces(Object *const oPtr,
			    DefineChain *const definePtr, int flags);
static int		CmpStr(const void *ptr1, const void *ptr2);
static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
static Tcl_NRPostProc	FinalizeMethodRefs;
static void		FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
			    int flags, int reuseMask);
static Tcl_NRPostProc	ResetFilterFlags;
static Tcl_NRPostProc	SetFilterFlags;
static int		SortMethodNames(Tcl_HashTable *namesPtr, int flags,
			    const char ***stringsPtr);
static inline void	StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);

/*
 * Object type used to manage type caches attached to method names.
 */

static const Tcl_ObjType methodNameType = {
    "TclOO method name",
    FreeMethodNameRep,
    DupMethodNameRep,
    NULL,
    NULL
};


/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteContext --
 *
 *	Destroys a method call-chain context, which should not be in use.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteContext(
    CallContext *contextPtr)
{
    Object *oPtr = contextPtr->oPtr;

    TclOODeleteChain(contextPtr->callPtr);
    if (oPtr != NULL) {
	TclStackFree(oPtr->fPtr->interp, contextPtr);

	/*
	 * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
	 */

	TclOODecrRefCount(oPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteChainCache --
 *
 *	Destroy the cache of method call-chains.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteChainCache(
    Tcl_HashTable *tablePtr)
{
    FOREACH_HASH_DECLS;
    CallChain *callPtr;

    FOREACH_HASH_VALUE(callPtr, tablePtr) {
	if (callPtr) {
	    TclOODeleteChain(callPtr);
	}
    }
    Tcl_DeleteHashTable(tablePtr);
    Tcl_Free(tablePtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODeleteChain --
 *
 *	Destroys a method call-chain.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODeleteChain(
    CallChain *callPtr)
{
    if (callPtr == NULL || callPtr->refCount-- > 1) {
	return;
    }
    if (callPtr->chain != callPtr->staticChain) {
	Tcl_Free(callPtr->chain);
    }
    Tcl_Free(callPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOStashContext --
 *
 *	Saves a reference to a method call context in a Tcl_Obj's internal
 *	representation.
 *
 * ----------------------------------------------------------------------
 */

static inline void
StashCallChain(
    Tcl_Obj *objPtr,
    CallChain *callPtr)
{
    Tcl_ObjIntRep ir;

    callPtr->refCount++;
    TclGetString(objPtr);
    ir.twoPtrValue.ptr1 = callPtr;
    Tcl_StoreIntRep(objPtr, &methodNameType, &ir);
}

void
TclOOStashContext(
    Tcl_Obj *objPtr,
    CallContext *contextPtr)
{
    StashCallChain(objPtr, contextPtr->callPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * DupMethodNameRep, FreeMethodNameRep --
 *
 *	Functions to implement the required parts of the Tcl_Obj guts needed
 *	for caching of method contexts in Tcl_Objs.
 *
 * ----------------------------------------------------------------------
 */

static void
DupMethodNameRep(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dstPtr)
{
    StashCallChain(dstPtr,
	    (CallChain *)TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
}

static void
FreeMethodNameRep(
    Tcl_Obj *objPtr)
{
    TclOODeleteChain(
	    (CallChain *)TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInvokeContext --
 *
 *	Invokes a single step along a method call-chain context. Note that the
 *	invocation of a step along the chain can cause further steps along the
 *	chain to be invoked. Note that this function is written to be as light
 *	in stack usage as possible.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOInvokeContext(
    ClientData clientData,	/* The method call context. */
    Tcl_Interp *interp,		/* Interpreter for error reporting, and many
				 * other sorts of context handling (e.g.,
				 * commands, variables) depending on method
				 * implementation. */
    int objc,			/* The number of arguments. */
    Tcl_Obj *const objv[])	/* The arguments as actually seen. */
{
    CallContext *const contextPtr = (CallContext *)clientData;
    Method *const mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const int isFilter =
	    contextPtr->callPtr->chain[contextPtr->index].isFilter;

    /*
     * If this is the first step along the chain, we preserve the method
     * entries in the chain so that they do not get deleted out from under our
     * feet.
     */

    if (contextPtr->index == 0) {
	int i;

	for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	    AddRef(contextPtr->callPtr->chain[i].mPtr);
	}

	/*
	 * Ensure that the method name itself is part of the arguments when
	 * we're doing unknown processing.
	 */

	if (contextPtr->callPtr->flags & OO_UNKNOWN_METHOD) {
	    contextPtr->skip--;
	}

	/*
	 * Add a callback to ensure that method references are dropped once
	 * this call is finished.
	 */

	TclNRAddCallback(interp, FinalizeMethodRefs, contextPtr, NULL, NULL,
		NULL);
    }

    /*
     * Save whether we were in a filter and set up whether we are now.
     */

    if (contextPtr->oPtr->flags & FILTER_HANDLING) {
	TclNRAddCallback(interp, SetFilterFlags, contextPtr, NULL,NULL,NULL);
    } else {
	TclNRAddCallback(interp, ResetFilterFlags,contextPtr,NULL,NULL,NULL);
    }
    if (isFilter || contextPtr->callPtr->flags & FILTER_HANDLING) {
	contextPtr->oPtr->flags |= FILTER_HANDLING;
    } else {
	contextPtr->oPtr->flags &= ~FILTER_HANDLING;
    }

    /*
     * Run the method implementation.
     */

    return mPtr->typePtr->callProc(mPtr->clientData, interp,
	    (Tcl_ObjectContext) contextPtr, objc, objv);
}

static int
SetFilterFlags(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    contextPtr->oPtr->flags |= FILTER_HANDLING;
    return result;
}

static int
ResetFilterFlags(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];

    contextPtr->oPtr->flags &= ~FILTER_HANDLING;
    return result;
}

static int
FinalizeMethodRefs(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    CallContext *contextPtr = (CallContext *)data[0];
    int i;

    for (i = 0 ; i < contextPtr->callPtr->numChain ; i++) {
	TclOODelMethodRef(contextPtr->callPtr->chain[i].mPtr);
    }
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetSortedMethodList, TclOOGetSortedClassMethodList --
 *
 *	Discovers the list of method names supported by an object or class.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOGetSortedMethodList(
    Object *oPtr,		/* The object to get the method names for. */
    Object *contextObj,		/* From what context object we are inquiring.
				 * NULL when the context shouldn't see
				 * object-level private methods. Note that
				 * flags can override this. */
    Class *contextCls,		/* From what context class we are inquiring.
				 * NULL when the context shouldn't see
				 * class-level private methods. Note that
				 * flags can override this. */
    int flags,			/* Whether we just want the public method
				 * names. */
    const char ***stringsPtr)	/* Where to write a pointer to the array of
				 * strings to. */
{
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */
    FOREACH_HASH_DECLS;
    int i, numStrings;
    Class *mixinPtr;
    Tcl_Obj *namePtr;
    Method *mPtr;

    Tcl_InitObjHashTable(&names);
    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);

    /*
     * Name the bits used in the names table values.
     */
#define IN_LIST 1
#define NO_IMPLEMENTATION 2

    /*
     * Process method names due to the object.
     */

    if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (IS_PRIVATE(mPtr)) {
		continue;
	    }
	    if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
		continue;
	    }
	    AddStandardMethodName(flags, namePtr, mPtr, &names);
	}
    }

    /*
     * Process method names due to private methods on the object's class.
     */

    if (WANT_UNEXPORTED(flags)) {
	FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
	    if (IS_UNEXPORTED(mPtr)) {
		AddStandardMethodName(flags, namePtr, mPtr, &names);
	    }
	}
    }

    /*
     * Process method names due to private methods on the context's object or
     * class. Which must be correct if either are not NULL.
     */

    if (contextObj && contextObj->methodsPtr) {
	AddPrivateMethodNames(contextObj->methodsPtr, &names);
    }
    if (contextCls) {
	AddPrivateMethodNames(&contextCls->classMethods, &names);
    }

    /*
     * Process (normal) method names from the class hierarchy and the mixin
     * hierarchy.
     */

    AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
    FOREACH(mixinPtr, oPtr->mixins) {
	AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names,
		&examinedClasses);
    }

    /*
     * Tidy up, sort the names and resolve finally whether we really want
     * them (processing export layering).
     */

    Tcl_DeleteHashTable(&examinedClasses);
    numStrings = SortMethodNames(&names, flags, stringsPtr);
    Tcl_DeleteHashTable(&names);
    return numStrings;
}

int
TclOOGetSortedClassMethodList(
    Class *clsPtr,		/* The class to get the method names for. */
    int flags,			/* Whether we just want the public method
				 * names. */
    const char ***stringsPtr)	/* Where to write a pointer to the array of
				 * strings to. */
{
    Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
				 * mapping. */
    Tcl_HashTable examinedClasses;
				/* Used to track what classes have been looked
				 * at. Is set-like in nature and keyed by
				 * pointer to class. */
    int numStrings;

    Tcl_InitObjHashTable(&names);
    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);

    /*
     * Process method names from the class hierarchy and the mixin hierarchy.
     */

    AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
    Tcl_DeleteHashTable(&examinedClasses);

    /*
     * Process private method names if we should. [TIP 500]
     */

    if (WANT_PRIVATE(flags)) {
	AddPrivateMethodNames(&clsPtr->classMethods, &names);
	flags &= ~TRUE_PRIVATE_METHOD;
    }

    /*
     * Tidy up, sort the names and resolve finally whether we really want
     * them (processing export layering).
     */

    numStrings = SortMethodNames(&names, flags, stringsPtr);
    Tcl_DeleteHashTable(&names);
    return numStrings;
}

/*
 * ----------------------------------------------------------------------
 *
 * SortMethodNames --
 *
 *	Shared helper for TclOOGetSortedMethodList etc. that knows the method
 *	sorting rules.
 *
 * Returns:
 *	The length of the sorted list.
 *
 * ----------------------------------------------------------------------
 */

static int
SortMethodNames(
    Tcl_HashTable *namesPtr,	/* The table of names; unsorted, but contains
				 * whether the names are wanted and under what
				 * circumstances. */
    int flags,			/* Whether we are looking for unexported
				 * methods. Full private methods are handled
				 * on insertion to the table. */
    const char ***stringsPtr)	/* Where to store the sorted list of strings
				 * that we produce. Tcl_Alloced() */
{
    const char **strings;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr;
    void *isWanted;
    size_t i = 0;

    /*
     * See how many (visible) method names there are. If none, we do not (and
     * should not) try to sort the list of them.
     */

    if (namesPtr->numEntries == 0) {
	*stringsPtr = NULL;
	return 0;
    }

    /*
     * We need to build the list of methods to sort. We will be using qsort()
     * for this, because it is very unlikely that the list will be heavily
     * sorted when it is long enough to matter.
     */

    strings = (const char **)Tcl_Alloc(sizeof(char *) * namesPtr->numEntries);
    FOREACH_HASH(namePtr, isWanted, namesPtr) {
	if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
	    if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
		continue;
	    }
	    strings[i++] = TclGetString(namePtr);
	}
    }

    /*
     * Note that 'i' may well be less than names.numEntries when we are
     * dealing with public method names. We don't sort unless there's at least
     * two method names.
     */

    if (i > 0) {
	if (i > 1) {
	    qsort((void *) strings, i, sizeof(char *), CmpStr);
	}
	*stringsPtr = strings;
    } else {
	Tcl_Free((void *)strings);
	*stringsPtr = NULL;
    }
    return i;
}

/*
 * Comparator for SortMethodNames
 */

static int
CmpStr(
    const void *ptr1,
    const void *ptr2)
{
    const char **strPtr1 = (const char **) ptr1;
    const char **strPtr2 = (const char **) ptr2;

    return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
}

/*
 * ----------------------------------------------------------------------
 *
 * AddClassMethodNames --
 *
 *	Adds the method names defined by a class (or its superclasses) to the
 *	collection being built. The collection is built in a hash table to
 *	ensure that duplicates are excluded. Helper for GetSortedMethodList().
 *
 * ----------------------------------------------------------------------
 */

static void
AddClassMethodNames(
    Class *clsPtr,		/* Class to get method names from. */
    const int flags,		/* Whether we are interested in just the
				 * public method names. */
    Tcl_HashTable *const namesPtr,
				/* Reference to the hash table to put the
				 * information in. The hash table maps the
				 * Tcl_Obj * method name to an integral value
				 * describing whether the method is wanted.
				 * This ensures that public/private override
				 * semantics are handled correctly. */
    Tcl_HashTable *const examinedClassesPtr)
				/* Hash table that tracks what classes have
				 * already been looked at. The keys are the
				 * pointers to the classes, and the values are
				 * immaterial. */
{
    int i;

    /*
     * If we've already started looking at this class, stop working on it now
     * to prevent repeated work.
     */

    if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
	return;
    }

    /*
     * Scope all declarations so that the compiler can stand a good chance of
     * making the recursive step highly efficient. We also hand-implement the
     * tail-recursive case using a while loop; C compilers typically cannot do
     * tail-recursion optimization usefully.
     */

    while (1) {
	FOREACH_HASH_DECLS;
	Tcl_Obj *namePtr;
	Method *mPtr;
	int isNew;

	(void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr,
		&isNew);
	if (!isNew) {
	    break;
	}

	if (clsPtr->mixins.num != 0) {
	    Class *mixinPtr;

	    FOREACH(mixinPtr, clsPtr->mixins) {
		if (mixinPtr != clsPtr) {
		    AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN,
			    namesPtr, examinedClassesPtr);
		}
	    }
	}

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    AddStandardMethodName(flags, namePtr, mPtr, namesPtr);
	}

	if (clsPtr->superclasses.num != 1) {
	    break;
	}
	clsPtr = clsPtr->superclasses.list[0];
    }
    if (clsPtr->superclasses.num != 0) {
	Class *superPtr;

	FOREACH(superPtr, clsPtr->superclasses) {
	    AddClassMethodNames(superPtr, flags, namesPtr,
		    examinedClassesPtr);
	}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddPrivateMethodNames, AddStandardMethodName --
 *
 *	Factored-out helpers for the sorted name list production functions.
 *
 * ----------------------------------------------------------------------
 */

static inline void
AddPrivateMethodNames(
    Tcl_HashTable *methodsTablePtr,
    Tcl_HashTable *namesPtr)
{
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Tcl_Obj *namePtr;

    FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
	if (IS_PRIVATE(mPtr)) {
	    int isNew;

	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
	    Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
	}
    }
}

static inline void
AddStandardMethodName(
    int flags,
    Tcl_Obj *namePtr,
    Method *mPtr,
    Tcl_HashTable *namesPtr)
{
    if (!IS_PRIVATE(mPtr)) {
	int isNew;
	Tcl_HashEntry *hPtr =
		Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);

	if (isNew) {
	    int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
		    ? IN_LIST : 0;

	    isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
	    Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	} else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
		&& mPtr->typePtr != NULL) {
	    int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));

	    isWanted &= ~NO_IMPLEMENTATION;
	    Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
	}
    }
}

#undef IN_LIST
#undef NO_IMPLEMENTATION

/*
 * ----------------------------------------------------------------------
 *
 * AddInstancePrivateToCallContext --
 *
 *	Add private methods from the instance. Called when the calling Tcl
 *	context is a TclOO method declared by an object that is the same as
 *	the current object. Returns true iff a private method was actually
 *	found and added to the call chain (as this suppresses caching).
 *
 * ----------------------------------------------------------------------
 */

static inline int
AddInstancePrivateToCallContext(
    Object *const oPtr,		/* Object to add call chain entries for. */
    Tcl_Obj *const methodName,	/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    int flags)			/* What sort of call chain are we building. */
{
    Tcl_HashEntry *hPtr;
    Method *mPtr;
    int donePrivate = 0;

    if (oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
	if (hPtr != NULL) {
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
		donePrivate = 1;
	    }
	}
    }
    return donePrivate;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleChainToCallContext --
 *
 *	The core of the call-chain construction engine, this handles calling a
 *	particular method on a particular object. Note that filters and
 *	unknown handling are already handled by the logic that uses this
 *	function. Returns true if a private method was one of those found.
 *
 * ----------------------------------------------------------------------
 */

static inline int
AddSimpleChainToCallContext(
    Object *const oPtr,		/* Object to add call chain entries for. */
    Class *const contextCls,	/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. [TIP 500] */
    Tcl_Obj *const methodNameObj,
				/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    int i, foundPrivate = 0, blockedUnexported = 0;
    Tcl_HashEntry *hPtr;
    Method *mPtr;

    if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);

	if (hPtr != NULL) {
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	    if (!IS_PRIVATE(mPtr)) {
		if (WANT_PUBLIC(flags)) {
		    if (!IS_PUBLIC(mPtr)) {
			blockedUnexported = 1;
		    } else {
			flags |= DEFINITE_PUBLIC;
		    }
		} else {
		    flags |= DEFINITE_PROTECTED;
		}
	    }
	}
    }
    if (!(flags & SPECIAL)) {
	Class *mixinPtr;

	FOREACH(mixinPtr, oPtr->mixins) {
	    if (contextCls) {
		foundPrivate |= AddPrivatesFromClassChainToCallContext(
			mixinPtr, contextCls, methodNameObj, cbPtr,
			doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
	    }
	    foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
		    methodNameObj, cbPtr, doneFilters,
		    flags | TRAVERSED_MIXIN, filterDecl);
	}
	if (oPtr->methodsPtr && !blockedUnexported) {
	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *)methodNameObj);
	    if (hPtr != NULL) {
		mPtr = (Method *)Tcl_GetHashValue(hPtr);
		if (!IS_PRIVATE(mPtr)) {
		    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			    flags);
		}
	    }
	}
    }
    if (contextCls) {
	foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls,
		contextCls, methodNameObj, cbPtr, doneFilters, flags,
		filterDecl);
    }
    if (!blockedUnexported) {
	foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls,
		methodNameObj, cbPtr, doneFilters, flags, filterDecl);
    }
    return foundPrivate;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddMethodToCallChain --
 *
 *	Utility method that manages the adding of a particular method
 *	implementation to a call-chain.
 *
 * ----------------------------------------------------------------------
 */

static inline void
AddMethodToCallChain(
    Method *const mPtr,		/* Actual method implementation to add to call
				 * chain (or NULL, a no-op). */
    struct ChainBuilder *const cbPtr,
				/* The call chain to add the method
				 * implementation to. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what filters have been
				 * processed. If NULL, not processing filters.
				 * Note that this function does not update
				 * this hashtable. */
    Class *const filterDecl,	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
    int flags)			/* Used to check if we're mixin-consistent
				 * only. Mixin-consistent means that either
				 * we're looking to add things from a mixin
				 * and we have passed a mixin, or we're not
				 * looking to add things from a mixin and have
				 * not passed a mixin. */
{
    CallChain *callPtr = cbPtr->callChainPtr;
    int i;

    /*
     * Return if this is just an entry used to record whether this is a public
     * method. If so, there's nothing real to call and so nothing to add to
     * the call chain.
     *
     * This is also where we enforce mixin-consistency.
     */

    if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
	return;
    }

    /*
     * Enforce real private method handling here. We will skip adding this
     * method IF
     *  1) we are not allowing private methods, AND
     *  2) this is a private method, AND
     *  3) this is a class method, AND
     *  4) this method was not declared by the class of the current object.
     *
     * This does mean that only classes really handle private methods. This
     * should be sufficient for [incr Tcl] support though.
     */

    if (!WANT_UNEXPORTED(callPtr->flags)
	    && IS_UNEXPORTED(mPtr)
	    && (mPtr->declaringClassPtr != NULL)
	    && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
	return;
    }

    /*
     * First test whether the method is already in the call chain. Skip over
     * any leading filters.
     */

    for (i = cbPtr->filterLength ; i < callPtr->numChain ; i++) {
	if (callPtr->chain[i].mPtr == mPtr &&
		callPtr->chain[i].isFilter == (doneFilters != NULL)) {
	    /*
	     * Call chain semantics states that methods come as *late* in the
	     * call chain as possible. This is done by copying down the
	     * following methods. Note that this does not change the number of
	     * method invocations in the call chain; it just rearranges them.
	     */

	    Class *declCls = callPtr->chain[i].filterDeclarer;

	    for (; i + 1 < callPtr->numChain ; i++) {
		callPtr->chain[i] = callPtr->chain[i + 1];
	    }
	    callPtr->chain[i].mPtr = mPtr;
	    callPtr->chain[i].isFilter = (doneFilters != NULL);
	    callPtr->chain[i].filterDeclarer = declCls;
	    return;
	}
    }

    /*
     * Need to really add the method. This is made a bit more complex by the
     * fact that we are using some "static" space initially, and only start
     * realloc-ing if the chain gets long.
     */

    if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain =
		(struct MInvoke *)Tcl_Alloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
	memcpy(callPtr->chain, callPtr->staticChain,
		sizeof(struct MInvoke) * callPtr->numChain);
    } else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
	callPtr->chain = (struct MInvoke *)Tcl_Realloc(callPtr->chain,
		sizeof(struct MInvoke) * (callPtr->numChain + 1));
    }
    callPtr->chain[i].mPtr = mPtr;
    callPtr->chain[i].isFilter = (doneFilters != NULL);
    callPtr->chain[i].filterDeclarer = filterDecl;
    callPtr->numChain++;
}

/*
 * ----------------------------------------------------------------------
 *
 * InitCallChain --
 *	Encoding of the policy of how to set up a call chain. Doesn't populate
 *	the chain with the method implementation data.
 *
 * ----------------------------------------------------------------------
 */

static inline void
InitCallChain(
    CallChain *callPtr,
    Object *oPtr,
    int flags)
{
    callPtr->flags = flags &
	    (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING);
    if (oPtr->flags & USE_CLASS_CACHE) {
	oPtr = oPtr->selfCls->thisPtr;
	callPtr->flags |= USE_CLASS_CACHE;
    }
    callPtr->epoch = oPtr->fPtr->epoch;
    callPtr->objectCreationEpoch = oPtr->creationEpoch;
    callPtr->objectEpoch = oPtr->epoch;
    callPtr->refCount = 1;
    callPtr->numChain = 0;
    callPtr->chain = callPtr->staticChain;
}

/*
 * ----------------------------------------------------------------------
 *
 * IsStillValid --
 *
 *	Calculates whether the given call chain can be used for executing a
 *	method for the given object. The condition on a chain from a cached
 *	location being reusable is:
 *	- Refers to the same object (same creation epoch), and
 *	- Still across the same class structure (same global epoch), and
 *	- Still across the same object strucutre (same local epoch), and
 *	- No public/private/filter magic leakage (same flags, modulo the fact
 *	  that a public chain will satisfy a non-public call).
 *
 * ----------------------------------------------------------------------
 */

static inline int
IsStillValid(
    CallChain *callPtr,
    Object *oPtr,
    int flags,
    int mask)
{
    if ((oPtr->flags & USE_CLASS_CACHE)) {
	oPtr = oPtr->selfCls->thisPtr;
	flags |= USE_CLASS_CACHE;
    }
    return ((callPtr->objectCreationEpoch == oPtr->creationEpoch)
	    && (callPtr->epoch == oPtr->fPtr->epoch)
	    && (callPtr->objectEpoch == oPtr->epoch)
	    && ((callPtr->flags & mask) == (flags & mask)));
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetCallContext --
 *
 *	Responsible for constructing the call context, an ordered list of all
 *	method implementations to be called as part of a method invocation.
 *	This method is central to the whole operation of the OO system.
 *
 * ----------------------------------------------------------------------
 */

CallContext *
TclOOGetCallContext(
    Object *oPtr,		/* The object to get the context for. */
    Tcl_Obj *methodNameObj,	/* The name of the method to get the context
				 * for. NULL when getting a constructor or
				 * destructor chain. */
    int flags,			/* What sort of context are we looking for.
				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
				 * PRIVATE_METHOD, DESTRUCTOR and
				 * FILTER_HANDLING are useful. */
    Object *contextObj,		/* Context object; when equal to oPtr, it
				 * means that private methods may also be
				 * added. [TIP 500] */
    Class *contextCls,		/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. [TIP 500] */
    Tcl_Obj *cacheInThisObj)	/* What object to cache in, or NULL if it is
				 * to be in the same object as the
				 * methodNameObj. */
{
    CallContext *contextPtr;
    CallChain *callPtr;
    struct ChainBuilder cb;
    int i, count, doFilters, donePrivate = 0;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;

    if (cacheInThisObj == NULL) {
	cacheInThisObj = methodNameObj;
    }
    if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
	hPtr = NULL;
	doFilters = 0;

	/*
	 * Check if we have a cached valid constructor or destructor.
	 */

	if (flags & CONSTRUCTOR) {
	    callPtr = oPtr->selfCls->constructorChainPtr;
	    if ((callPtr != NULL)
		    && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
		    && (callPtr->epoch == oPtr->fPtr->epoch)) {
		callPtr->refCount++;
		goto returnContext;
	    }
	} else if (flags & DESTRUCTOR) {
	    callPtr = oPtr->selfCls->destructorChainPtr;
	    if ((oPtr->mixins.num == 0) && (callPtr != NULL)
		    && (callPtr->objectEpoch == oPtr->selfCls->thisPtr->epoch)
		    && (callPtr->epoch == oPtr->fPtr->epoch)) {
		callPtr->refCount++;
		goto returnContext;
	    }
	}
    } else {
	/*
	 * Check if we can get the chain out of the Tcl_Obj method name or out
	 * of the cache. This is made a bit more complex by the fact that
	 * there are multiple different layers of cache (in the Tcl_Obj, in
	 * the object, and in the class).
	 */

	const Tcl_ObjIntRep *irPtr;
	const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);

	if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) {
	    callPtr = (CallChain *)irPtr->twoPtrValue.ptr1;
	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
		callPtr->refCount++;
		goto returnContext;
	    }
	    Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL);
	}

	if (oPtr->flags & USE_CLASS_CACHE) {
	    if (oPtr->selfCls->classChainCache != NULL) {
		hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache,
			(char *) methodNameObj);
	    } else {
		hPtr = NULL;
	    }
	} else {
	    if (oPtr->chainCache != NULL) {
		hPtr = Tcl_FindHashEntry(oPtr->chainCache,
			(char *) methodNameObj);
	    } else {
		hPtr = NULL;
	    }
	}

	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
	    callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
		callPtr->refCount++;
		goto returnContext;
	    }
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}

	doFilters = 1;
    }

    callPtr = (CallChain *)Tcl_Alloc(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, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = 0;
	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).
     */

    if (doFilters) {
	Tcl_Obj *filterObj;
	Class *mixinPtr;

	doFilters = 1;
	Tcl_InitObjHashTable(&doneFilters);
	FOREACH(mixinPtr, oPtr->mixins) {
	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
		    TRAVERSED_MIXIN|BUILDING_MIXINS|OBJECT_MIXIN);
	    AddClassFiltersToCallContext(oPtr, mixinPtr, &cb, &doneFilters,
		    OBJECT_MIXIN);
	}
	FOREACH(filterObj, oPtr->filters) {
	    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
		    filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
	    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
		    filterObj, &cb, &doneFilters, 0, NULL);
	}
	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
		BUILDING_MIXINS);
	AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
		0);
	Tcl_DeleteHashTable(&doneFilters);
    }
    count = cb.filterLength = callPtr->numChain;

    /*
     * Add the actual method implementations. We have to do this twice to
     * handle class mixins right.
     */

    if (oPtr == contextObj) {
	donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj,
		&cb, flags);
	donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS);
    }
    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
	    methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL);
    donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
	    methodNameObj, &cb, NULL, flags, NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	/*
	 * Method does not actually exist. If we're dealing with constructors
	 * or destructors, this isn't a problem.
	 */

	if (flags & SPECIAL) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
		NULL);
	AddSimpleChainToCallContext(oPtr, NULL,
		oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = 0;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else if (doFilters && !donePrivate) {
	if (hPtr == NULL) {
	    if (oPtr->flags & USE_CLASS_CACHE) {
		if (oPtr->selfCls->classChainCache == NULL) {
		    oPtr->selfCls->classChainCache =
			    (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->selfCls->classChainCache,
			(char *) methodNameObj, &i);
	    } else {
		if (oPtr->chainCache == NULL) {
		    oPtr->chainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));

		    Tcl_InitObjHashTable(oPtr->chainCache);
		}
		hPtr = Tcl_CreateHashEntry(oPtr->chainCache,
			(char *) methodNameObj, &i);
	    }
	}
	callPtr->refCount++;
	Tcl_SetHashValue(hPtr, callPtr);
	StashCallChain(cacheInThisObj, callPtr);
    } else if (flags & CONSTRUCTOR) {
	if (oPtr->selfCls->constructorChainPtr) {
	    TclOODeleteChain(oPtr->selfCls->constructorChainPtr);
	}
	oPtr->selfCls->constructorChainPtr = callPtr;
	callPtr->refCount++;
    } else if ((flags & DESTRUCTOR) && oPtr->mixins.num == 0) {
	if (oPtr->selfCls->destructorChainPtr) {
	    TclOODeleteChain(oPtr->selfCls->destructorChainPtr);
	}
	oPtr->selfCls->destructorChainPtr = callPtr;
	callPtr->refCount++;
    }

  returnContext:
    contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
    contextPtr->oPtr = oPtr;

    /*
     * Corresponding TclOODecrRefCount() in TclOODeleteContext
     */

    AddRef(oPtr);
    contextPtr->callPtr = callPtr;
    contextPtr->skip = 2;
    contextPtr->index = 0;
    return contextPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetStereotypeCallChain --
 *
 *	Construct a call-chain for a method that would be used by a
 *	stereotypical instance of the given class (i.e., where the object has
 *	no definitions special to itself).
 *
 * ----------------------------------------------------------------------
 */

CallChain *
TclOOGetStereotypeCallChain(
    Class *clsPtr,		/* The object to get the context for. */
    Tcl_Obj *methodNameObj,	/* The name of the method to get the context
				 * for. NULL when getting a constructor or
				 * destructor chain. */
    int flags)			/* What sort of context are we looking for.
				 * Only the bits PUBLIC_METHOD, CONSTRUCTOR,
				 * PRIVATE_METHOD, DESTRUCTOR and
				 * FILTER_HANDLING are useful. */
{
    CallChain *callPtr;
    struct ChainBuilder cb;
    int i, count;
    Foundation *fPtr = clsPtr->thisPtr->fPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable doneFilters;
    Object obj;

    /*
     * Synthesize a temporary stereotypical object so that we can use existing
     * machinery to produce the stereotypical call chain.
     */

    memset(&obj, 0, sizeof(Object));
    obj.fPtr = fPtr;
    obj.selfCls = clsPtr;
    obj.refCount = 1;
    obj.flags = USE_CLASS_CACHE;

    /*
     * Check if we can get the chain out of the Tcl_Obj method name or out of
     * the cache. This is made a bit more complex by the fact that there are
     * multiple different layers of cache (in the Tcl_Obj, in the object, and
     * in the class).
     */

    if (clsPtr->classChainCache != NULL) {
	hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
		(char *) methodNameObj);
	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
	    const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);

	    callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
	    if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
		callPtr->refCount++;
		return callPtr;
	    }
	    Tcl_SetHashValue(hPtr, NULL);
	    TclOODeleteChain(callPtr);
	}
    } else {
	hPtr = NULL;
    }

    callPtr = (CallChain *)Tcl_Alloc(sizeof(CallChain));
    memset(callPtr, 0, sizeof(CallChain));
    callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
    callPtr->epoch = fPtr->epoch;
    callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
    callPtr->objectEpoch = clsPtr->thisPtr->epoch;
    callPtr->refCount = 1;
    callPtr->chain = callPtr->staticChain;

    cb.callChainPtr = callPtr;
    cb.filterLength = 0;
    cb.oPtr = &obj;

    /*
     * 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).
     */

    Tcl_InitObjHashTable(&doneFilters);
    AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters,
	    BUILDING_MIXINS);
    AddClassFiltersToCallContext(&obj, clsPtr, &cb, &doneFilters, 0);
    Tcl_DeleteHashTable(&doneFilters);
    count = cb.filterLength = callPtr->numChain;

    /*
     * Add the actual method implementations.
     */

    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL,
	    flags|BUILDING_MIXINS, NULL);
    AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
	    NULL);

    /*
     * Check to see if the method has no implementation. If so, we probably
     * need to add in a call to the unknown method. Otherwise, set up the
     * cacheing of the method implementation (if relevant).
     */

    if (count == callPtr->numChain) {
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, BUILDING_MIXINS, NULL);
	AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = 0;
	if (count == callPtr->numChain) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
    } else {
	if (hPtr == NULL) {
	    if (clsPtr->classChainCache == NULL) {
		clsPtr->classChainCache = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(clsPtr->classChainCache);
	    }
	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
		    (char *) methodNameObj, &i);
	}
	callPtr->refCount++;
	Tcl_SetHashValue(hPtr, callPtr);
	StashCallChain(methodNameObj, callPtr);
    }
    return callPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddClassFiltersToCallContext --
 *
 *	Logic to make extracting all the filters from the class context much
 *	easier.
 *
 * ----------------------------------------------------------------------
 */

static void
AddClassFiltersToCallContext(
    Object *const oPtr,		/* Object that the filters operate on. */
    Class *clsPtr,		/* Class to get the filters from. */
    struct ChainBuilder *const cbPtr,
				/* Context to fill with call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what filters have been
				 * processed. Keys are objects, values are
				 * ignored. */
    int flags)			/* Whether we've gone along a mixin link
				 * yet. */
{
    int i, clearedFlags =
	    flags & ~(TRAVERSED_MIXIN|OBJECT_MIXIN|BUILDING_MIXINS);
    Class *superPtr, *mixinPtr;
    Tcl_Obj *filterObj;

  tailRecurse:
    if (clsPtr == NULL) {
	return;
    }

    /*
     * Add all the filters defined by classes mixed into the main class
     * hierarchy.
     */

    FOREACH(mixinPtr, clsPtr->mixins) {
	AddClassFiltersToCallContext(oPtr, mixinPtr, cbPtr, doneFilters,
		flags|TRAVERSED_MIXIN);
    }

    /*
     * Add all the class filters from the current class. Note that the filters
     * are added starting at the object root, as this allows the object to
     * override how filters work to extend their behaviour.
     */

    if (MIXIN_CONSISTENT(flags)) {
	FOREACH(filterObj, clsPtr->filters) {
	    int isNew;

	    (void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
		    &isNew);
	    if (isNew) {
		AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
			doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
		AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
			doneFilters, clearedFlags, clsPtr);
	    }
	}
    }

    /*
     * Now process the recursive case. Notice the tail-call optimization.
     */

    switch (clsPtr->superclasses.num) {
    case 1:
	clsPtr = clsPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, clsPtr->superclasses) {
	    AddClassFiltersToCallContext(oPtr, superPtr, cbPtr, doneFilters,
		    flags);
	}
    case 0:
	return;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddPrivatesFromClassChainToCallContext --
 *
 *	Helper for AddSimpleChainToCallContext that is used to find private
 *	methds and add them to the call chain. Returns true when a private
 *	method is found and added. [TIP 500]
 *
 * ----------------------------------------------------------------------
 */

static int
AddPrivatesFromClassChainToCallContext(
    Class *classPtr,		/* Class to add the call chain entries for. */
    Class *const contextCls,	/* Context class; the currently considered
				 * class is equal to this, private methods may
				 * also be added. */
    Tcl_Obj *const methodName,	/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    int i;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
     * Note that mixins must be processed before the main class hierarchy.
     * [Bug 1998221]
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
		methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
		filterDecl)) {
	    return 1;
	}
    }

    if (classPtr == contextCls) {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		methodName);

	if (hPtr != NULL) {
	    Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);

	    if (IS_PRIVATE(mPtr)) {
		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			flags);
		return 1;
	    }
	}
    }

    switch (classPtr->superclasses.num) {
    case 1:
	classPtr = classPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, classPtr->superclasses) {
	    if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
		    methodName, cbPtr, doneFilters, flags, filterDecl)) {
		return 1;
	    }
	}
	/* FALLTHRU */
    case 0:
	return 0;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleClassChainToCallContext --
 *
 *	Construct a call-chain from a class hierarchy.
 *
 * ----------------------------------------------------------------------
 */

static int
AddSimpleClassChainToCallContext(
    Class *classPtr,		/* Class to add the call chain entries for. */
    Tcl_Obj *const methodNameObj,
				/* Name of method to add the call chain
				 * entries for. */
    struct ChainBuilder *const cbPtr,
				/* Where to add the call chain entries. */
    Tcl_HashTable *const doneFilters,
				/* Where to record what call chain entries
				 * have been processed. */
    int flags,			/* What sort of call chain are we building. */
    Class *const filterDecl)	/* The class that declared the filter. If
				 * NULL, either the filter was declared by the
				 * object or this isn't a filter. */
{
    int i, privateDanger = 0;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     *
     * Note that mixins must be processed before the main class hierarchy.
     * [Bug 1998221]
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	privateDanger |= AddSimpleClassChainToCallContext(superPtr,
		methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
		filterDecl);
    }

    if (flags & CONSTRUCTOR) {
	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
		filterDecl, flags);
    } else if (flags & DESTRUCTOR) {
	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
		filterDecl, flags);
    } else {
	Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
		(char *) methodNameObj);

	if (classPtr->flags & HAS_PRIVATE_METHODS) {
	    privateDanger |= 1;
	}
	if (hPtr != NULL) {
	    Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);

	    if (!IS_PRIVATE(mPtr)) {
		if (!(flags & KNOWN_STATE)) {
		    if (flags & PUBLIC_METHOD) {
			if (!IS_PUBLIC(mPtr)) {
			    return privateDanger;
			}
			flags |= DEFINITE_PUBLIC;
		    } else {
			flags |= DEFINITE_PROTECTED;
		    }
		}
		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
			flags);
	    }
	}
    }

    switch (classPtr->superclasses.num) {
    case 1:
	classPtr = classPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, classPtr->superclasses) {
	    privateDanger |= AddSimpleClassChainToCallContext(superPtr,
		    methodNameObj, cbPtr, doneFilters, flags, filterDecl);
	}
	/* FALLTHRU */
    case 0:
	return privateDanger;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORenderCallChain --
 *
 *	Create a description of a call chain. Used in [info object call],
 *	[info class call], and [self call].
 *
 * ----------------------------------------------------------------------
 */

Tcl_Obj *
TclOORenderCallChain(
    Tcl_Interp *interp,
    CallChain *callPtr)
{
    Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
    Tcl_Obj *resultObj, *descObjs[4], **objv;
    Foundation *fPtr = TclOOGetFoundation(interp);
    int i;

    /*
     * Allocate the literals (potentially) used in our description.
     */

    TclNewLiteralStringObj(filterLiteral, "filter");
    Tcl_IncrRefCount(filterLiteral);
    TclNewLiteralStringObj(methodLiteral, "method");
    Tcl_IncrRefCount(methodLiteral);
    TclNewLiteralStringObj(objectLiteral, "object");
    Tcl_IncrRefCount(objectLiteral);
    TclNewLiteralStringObj(privateLiteral, "private");
    Tcl_IncrRefCount(privateLiteral);

    /*
     * Do the actual construction of the descriptions. They consist of a list
     * of triples that describe the details of how a method is understood. For
     * each triple, the first word is the type of invocation ("method" is
     * normal, "unknown" is special because it adds the method name as an
     * extra argument when handled by some method types, and "filter" is
     * special because it's a filter method). The second word is the name of
     * the method in question (which differs for "unknown" and "filter" types)
     * and the third word is the full name of the class that declares the
     * method (or "object" if it is declared on the instance).
     */

    objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
    for (i = 0 ; i < callPtr->numChain ; i++) {
	struct MInvoke *miPtr = &callPtr->chain[i];

	descObjs[0] =
	    miPtr->isFilter ? filterLiteral :
	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
		    methodLiteral;
	descObjs[1] =
	    callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
	    callPtr->flags & DESTRUCTOR ? fPtr->destructorName :
		    miPtr->mPtr->namePtr;
	descObjs[2] = miPtr->mPtr->declaringClassPtr
		? Tcl_GetObjectName(interp,
			(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
		: objectLiteral;
	descObjs[3] = Tcl_NewStringObj(miPtr->mPtr->typePtr->name, -1);

	objv[i] = Tcl_NewListObj(4, descObjs);
    }

    /*
     * Drop the local references to the literals; if they're actually used,
     * they'll live on the description itself.
     */

    Tcl_DecrRefCount(filterLiteral);
    Tcl_DecrRefCount(methodLiteral);
    Tcl_DecrRefCount(objectLiteral);
    Tcl_DecrRefCount(privateLiteral);

    /*
     * Finish building the description and return it.
     */

    resultObj = Tcl_NewListObj(callPtr->numChain, objv);
    TclStackFree(interp, objv);
    return resultObj;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetDefineContextNamespace --
 *
 *	Responsible for determining which namespace to use for definitions.
 *	This is done by building a define chain, which models (strongly!) the
 *	way that a call chain works but with a different internal model.
 *
 *	Then it walks the chain to find the first namespace name that actually
 *	resolves to an existing namespace.
 *
 * Returns:
 *	Name of namespace, or NULL if none can be found. Note that this
 *	function does *not* set an error message in the interpreter on failure.
 *
 * ----------------------------------------------------------------------
 */

#define DEFINE_CHAIN_STATIC_SIZE 4 /* Enough space to store most cases. */

Tcl_Namespace *
TclOOGetDefineContextNamespace(
    Tcl_Interp *interp,		/* In what interpreter should namespace names
				 * actually be resolved. */
    Object *oPtr,		/* The object to get the context for. */
    int forClass)		/* What sort of context are we looking for.
				 * If true, we are going to use this for
				 * [oo::define], otherwise, we are going to
				 * use this for [oo::objdefine]. */
{
    DefineChain define;
    DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
    DefineEntry *entryPtr;
    Tcl_Namespace *nsPtr = NULL;
    int i;

    define.list = staticSpace;
    define.num = 0;
    define.size = DEFINE_CHAIN_STATIC_SIZE;

    /*
     * Add the actual define locations. We have to do this twice to handle
     * class mixins right.
     */

    AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
    AddSimpleDefineNamespaces(oPtr, &define, forClass);

    /*
     * Go through the list until we find a namespace whose name we can
     * resolve.
     */

    FOREACH_STRUCT(entryPtr, define) {
	if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName,
		&nsPtr) == TCL_OK) {
	    break;
	}
	Tcl_ResetResult(interp);
    }
    if (define.list != staticSpace) {
	Tcl_Free(define.list);
    }
    return nsPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleDefineNamespaces --
 *
 *	Adds to the definition chain all the definitions provided by an
 *	object's class and its mixins, taking into account everything they
 *	inherit from.
 *
 * ----------------------------------------------------------------------
 */

static inline void
AddSimpleDefineNamespaces(
    Object *const oPtr,		/* Object to add define chain entries for. */
    DefineChain *const definePtr,
				/* Where to add the define chain entries. */
    int flags)			/* What sort of define chain are we
				 * building. */
{
    Class *mixinPtr;
    int i;

    FOREACH(mixinPtr, oPtr->mixins) {
	AddSimpleClassDefineNamespaces(mixinPtr, definePtr,
		flags | TRAVERSED_MIXIN);
    }

    AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags);
}

/*
 * ----------------------------------------------------------------------
 *
 * AddSimpleClassDefineNamespaces --
 *
 *	Adds to the definition chain all the definitions provided by a class
 *	and its superclasses and its class mixins.
 *
 * ----------------------------------------------------------------------
 */

static void
AddSimpleClassDefineNamespaces(
    Class *classPtr,		/* Class to add the define chain entries for. */
    DefineChain *const definePtr,
				/* Where to add the define chain entries. */
    int flags)			/* What sort of define chain are we
				 * building. */
{
    int i;
    Class *superPtr;

    /*
     * We hard-code the tail-recursive form. It's by far the most common case
     * *and* it is much more gentle on the stack.
     */

  tailRecurse:
    FOREACH(superPtr, classPtr->mixins) {
	AddSimpleClassDefineNamespaces(superPtr, definePtr,
		flags | TRAVERSED_MIXIN);
    }

    if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
	AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
		definePtr, flags);
    } else {
	AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs,
		definePtr, flags);
    }

    switch (classPtr->superclasses.num) {
    case 1:
	classPtr = classPtr->superclasses.list[0];
	goto tailRecurse;
    default:
	FOREACH(superPtr, classPtr->superclasses) {
	    AddSimpleClassDefineNamespaces(superPtr, definePtr, flags);
	}
    case 0:
	return;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * AddDefinitionNamespaceToChain --
 *
 *	Adds a single item to the definition chain (if it is meaningful),
 *	reallocating the space for the chain if necessary.
 *
 * ----------------------------------------------------------------------
 */

static inline void
AddDefinitionNamespaceToChain(
    Class *const definerCls,		/* What class defines this entry. */
    Tcl_Obj *const namespaceName,	/* The name for this entry (or NULL, a
				 * no-op). */
    DefineChain *const definePtr,
				/* The define chain to add the method
				 * implementation to. */
    int flags)			/* Used to check if we're mixin-consistent
				 * only. Mixin-consistent means that either
				 * we're looking to add things from a mixin
				 * and we have passed a mixin, or we're not
				 * looking to add things from a mixin and have
				 * not passed a mixin. */
{
    int i;

    /*
     * Return if this entry is blank. This is also where we enforce
     * mixin-consistency.
     */

    if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) {
	return;
    }

    /*
     * First test whether the method is already in the call chain.
     */

    for (i=0 ; i<definePtr->num ; i++) {
	if (definePtr->list[i].definerCls == definerCls) {
	    /*
	     * Call chain semantics states that methods come as *late* in the
	     * call chain as possible. This is done by copying down the
	     * following methods. Note that this does not change the number of
	     * method invocations in the call chain; it just rearranges them.
	     *
	     * We skip changing anything if the place we found was already at
	     * the end of the list.
	     */

	    if (i < definePtr->num - 1) {
		memmove(&definePtr->list[i], &definePtr->list[i + 1],
			sizeof(DefineEntry) * (definePtr->num - i - 1));
		definePtr->list[i].definerCls = definerCls;
		definePtr->list[i].namespaceName = namespaceName;
	    }
	    return;
	}
    }

    /*
     * Need to really add the define. This is made a bit more complex by the
     * fact that we are using some "static" space initially, and only start
     * realloc-ing if the chain gets long.
     */

    if (definePtr->num == definePtr->size) {
	definePtr->size *= 2;
	if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
	    DefineEntry *staticList = definePtr->list;

	    definePtr->list =
		    (DefineEntry *)Tcl_Alloc(sizeof(DefineEntry) * definePtr->size);
	    memcpy(definePtr->list, staticList,
		    sizeof(DefineEntry) * definePtr->num);
	} else {
	    definePtr->list = (DefineEntry *)Tcl_Realloc(definePtr->list,
		    sizeof(DefineEntry) * definePtr->size);
	}
    }
    definePtr->list[i].definerCls = definerCls;
    definePtr->list[i].namespaceName = namespaceName;
    definePtr->num++;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOODecls.h.

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















































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * This file is (mostly) automatically generated from tclOO.decls.
 */

#ifndef _TCLOODECLS
#define _TCLOODECLS

#ifndef TCLAPI
#   ifdef BUILD_tcl
#	define TCLAPI extern DLLEXPORT
#   else
#	define TCLAPI extern DLLIMPORT
#   endif
#endif

#ifdef USE_TCL_STUBS
#   undef USE_TCLOO_STUBS
#   define USE_TCLOO_STUBS
#endif

/* !BEGIN!: Do not edit below this line. */

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
 */

/* 0 */
TCLAPI Tcl_Object	Tcl_CopyObjectInstance(Tcl_Interp *interp,
				Tcl_Object sourceObject,
				const char *targetName,
				const char *targetNamespaceName);
/* 1 */
TCLAPI Tcl_Object	Tcl_GetClassAsObject(Tcl_Class clazz);
/* 2 */
TCLAPI Tcl_Class	Tcl_GetObjectAsClass(Tcl_Object object);
/* 3 */
TCLAPI Tcl_Command	Tcl_GetObjectCommand(Tcl_Object object);
/* 4 */
TCLAPI Tcl_Object	Tcl_GetObjectFromObj(Tcl_Interp *interp,
				Tcl_Obj *objPtr);
/* 5 */
TCLAPI Tcl_Namespace *	Tcl_GetObjectNamespace(Tcl_Object object);
/* 6 */
TCLAPI Tcl_Class	Tcl_MethodDeclarerClass(Tcl_Method method);
/* 7 */
TCLAPI Tcl_Object	Tcl_MethodDeclarerObject(Tcl_Method method);
/* 8 */
TCLAPI int		Tcl_MethodIsPublic(Tcl_Method method);
/* 9 */
TCLAPI int		Tcl_MethodIsType(Tcl_Method method,
				const Tcl_MethodType *typePtr,
				void **clientDataPtr);
/* 10 */
TCLAPI Tcl_Obj *	Tcl_MethodName(Tcl_Method method);
/* 11 */
TCLAPI Tcl_Method	Tcl_NewInstanceMethod(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Obj *nameObj,
				int flags, const Tcl_MethodType *typePtr,
				void *clientData);
/* 12 */
TCLAPI Tcl_Method	Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
				Tcl_Obj *nameObj, int flags,
				const Tcl_MethodType *typePtr,
				void *clientData);
/* 13 */
TCLAPI Tcl_Object	Tcl_NewObjectInstance(Tcl_Interp *interp,
				Tcl_Class cls, const char *nameStr,
				const char *nsNameStr, int objc,
				Tcl_Obj *const *objv, int skip);
/* 14 */
TCLAPI int		Tcl_ObjectDeleted(Tcl_Object object);
/* 15 */
TCLAPI int		Tcl_ObjectContextIsFiltering(
				Tcl_ObjectContext context);
/* 16 */
TCLAPI Tcl_Method	Tcl_ObjectContextMethod(Tcl_ObjectContext context);
/* 17 */
TCLAPI Tcl_Object	Tcl_ObjectContextObject(Tcl_ObjectContext context);
/* 18 */
TCLAPI int		Tcl_ObjectContextSkippedArgs(
				Tcl_ObjectContext context);
/* 19 */
TCLAPI void *		Tcl_ClassGetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr);
/* 20 */
TCLAPI void		Tcl_ClassSetMetadata(Tcl_Class clazz,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 21 */
TCLAPI void *		Tcl_ObjectGetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr);
/* 22 */
TCLAPI void		Tcl_ObjectSetMetadata(Tcl_Object object,
				const Tcl_ObjectMetadataType *typePtr,
				void *metadata);
/* 23 */
TCLAPI int		Tcl_ObjectContextInvokeNext(Tcl_Interp *interp,
				Tcl_ObjectContext context, int objc,
				Tcl_Obj *const *objv, int skip);
/* 24 */
TCLAPI Tcl_ObjectMapMethodNameProc * Tcl_ObjectGetMethodNameMapper(
				Tcl_Object object);
/* 25 */
TCLAPI void		Tcl_ObjectSetMethodNameMapper(Tcl_Object object,
				Tcl_ObjectMapMethodNameProc *mapMethodNameProc);
/* 26 */
TCLAPI void		Tcl_ClassSetConstructor(Tcl_Interp *interp,
				Tcl_Class clazz, Tcl_Method method);
/* 27 */
TCLAPI void		Tcl_ClassSetDestructor(Tcl_Interp *interp,
				Tcl_Class clazz, Tcl_Method method);
/* 28 */
TCLAPI Tcl_Obj *	Tcl_GetObjectName(Tcl_Interp *interp,
				Tcl_Object object);
/* 29 */
TCLAPI int		Tcl_MethodIsPrivate(Tcl_Method method);

typedef struct {
    const struct TclOOIntStubs *tclOOIntStubs;
} TclOOStubHooks;

typedef struct TclOOStubs {
    int magic;
    const TclOOStubHooks *hooks;

    Tcl_Object (*tcl_CopyObjectInstance) (Tcl_Interp *interp, Tcl_Object sourceObject, const char *targetName, const char *targetNamespaceName); /* 0 */
    Tcl_Object (*tcl_GetClassAsObject) (Tcl_Class clazz); /* 1 */
    Tcl_Class (*tcl_GetObjectAsClass) (Tcl_Object object); /* 2 */
    Tcl_Command (*tcl_GetObjectCommand) (Tcl_Object object); /* 3 */
    Tcl_Object (*tcl_GetObjectFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 4 */
    Tcl_Namespace * (*tcl_GetObjectNamespace) (Tcl_Object object); /* 5 */
    Tcl_Class (*tcl_MethodDeclarerClass) (Tcl_Method method); /* 6 */
    Tcl_Object (*tcl_MethodDeclarerObject) (Tcl_Method method); /* 7 */
    int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
    int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, void **clientDataPtr); /* 9 */
    Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
    Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 11 */
    Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, void *clientData); /* 12 */
    Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
    int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
    int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
    Tcl_Method (*tcl_ObjectContextMethod) (Tcl_ObjectContext context); /* 16 */
    Tcl_Object (*tcl_ObjectContextObject) (Tcl_ObjectContext context); /* 17 */
    int (*tcl_ObjectContextSkippedArgs) (Tcl_ObjectContext context); /* 18 */
    void * (*tcl_ClassGetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr); /* 19 */
    void (*tcl_ClassSetMetadata) (Tcl_Class clazz, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 20 */
    void * (*tcl_ObjectGetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr); /* 21 */
    void (*tcl_ObjectSetMetadata) (Tcl_Object object, const Tcl_ObjectMetadataType *typePtr, void *metadata); /* 22 */
    int (*tcl_ObjectContextInvokeNext) (Tcl_Interp *interp, Tcl_ObjectContext context, int objc, Tcl_Obj *const *objv, int skip); /* 23 */
    Tcl_ObjectMapMethodNameProc * (*tcl_ObjectGetMethodNameMapper) (Tcl_Object object); /* 24 */
    void (*tcl_ObjectSetMethodNameMapper) (Tcl_Object object, Tcl_ObjectMapMethodNameProc *mapMethodNameProc); /* 25 */
    void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
    void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
    Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
    int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
} TclOOStubs;

extern const TclOOStubs *tclOOStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCLOO_STUBS)

/*
 * Inline function declarations:
 */

#define Tcl_CopyObjectInstance \
	(tclOOStubsPtr->tcl_CopyObjectInstance) /* 0 */
#define Tcl_GetClassAsObject \
	(tclOOStubsPtr->tcl_GetClassAsObject) /* 1 */
#define Tcl_GetObjectAsClass \
	(tclOOStubsPtr->tcl_GetObjectAsClass) /* 2 */
#define Tcl_GetObjectCommand \
	(tclOOStubsPtr->tcl_GetObjectCommand) /* 3 */
#define Tcl_GetObjectFromObj \
	(tclOOStubsPtr->tcl_GetObjectFromObj) /* 4 */
#define Tcl_GetObjectNamespace \
	(tclOOStubsPtr->tcl_GetObjectNamespace) /* 5 */
#define Tcl_MethodDeclarerClass \
	(tclOOStubsPtr->tcl_MethodDeclarerClass) /* 6 */
#define Tcl_MethodDeclarerObject \
	(tclOOStubsPtr->tcl_MethodDeclarerObject) /* 7 */
#define Tcl_MethodIsPublic \
	(tclOOStubsPtr->tcl_MethodIsPublic) /* 8 */
#define Tcl_MethodIsType \
	(tclOOStubsPtr->tcl_MethodIsType) /* 9 */
#define Tcl_MethodName \
	(tclOOStubsPtr->tcl_MethodName) /* 10 */
#define Tcl_NewInstanceMethod \
	(tclOOStubsPtr->tcl_NewInstanceMethod) /* 11 */
#define Tcl_NewMethod \
	(tclOOStubsPtr->tcl_NewMethod) /* 12 */
#define Tcl_NewObjectInstance \
	(tclOOStubsPtr->tcl_NewObjectInstance) /* 13 */
#define Tcl_ObjectDeleted \
	(tclOOStubsPtr->tcl_ObjectDeleted) /* 14 */
#define Tcl_ObjectContextIsFiltering \
	(tclOOStubsPtr->tcl_ObjectContextIsFiltering) /* 15 */
#define Tcl_ObjectContextMethod \
	(tclOOStubsPtr->tcl_ObjectContextMethod) /* 16 */
#define Tcl_ObjectContextObject \
	(tclOOStubsPtr->tcl_ObjectContextObject) /* 17 */
#define Tcl_ObjectContextSkippedArgs \
	(tclOOStubsPtr->tcl_ObjectContextSkippedArgs) /* 18 */
#define Tcl_ClassGetMetadata \
	(tclOOStubsPtr->tcl_ClassGetMetadata) /* 19 */
#define Tcl_ClassSetMetadata \
	(tclOOStubsPtr->tcl_ClassSetMetadata) /* 20 */
#define Tcl_ObjectGetMetadata \
	(tclOOStubsPtr->tcl_ObjectGetMetadata) /* 21 */
#define Tcl_ObjectSetMetadata \
	(tclOOStubsPtr->tcl_ObjectSetMetadata) /* 22 */
#define Tcl_ObjectContextInvokeNext \
	(tclOOStubsPtr->tcl_ObjectContextInvokeNext) /* 23 */
#define Tcl_ObjectGetMethodNameMapper \
	(tclOOStubsPtr->tcl_ObjectGetMethodNameMapper) /* 24 */
#define Tcl_ObjectSetMethodNameMapper \
	(tclOOStubsPtr->tcl_ObjectSetMethodNameMapper) /* 25 */
#define Tcl_ClassSetConstructor \
	(tclOOStubsPtr->tcl_ClassSetConstructor) /* 26 */
#define Tcl_ClassSetDestructor \
	(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
#define Tcl_GetObjectName \
	(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
#define Tcl_MethodIsPrivate \
	(tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */

#endif /* defined(USE_TCLOO_STUBS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLOODECLS */

Deleted generic/tclOODefineCmds.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo::define command,
 *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006-2013 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
 * The actual value used to mark private declaration frames.
 */

#define PRIVATE_FRAME (FRAME_IS_OO_DEFINE | FRAME_IS_PRIVATE_DEFINE)

/*
 * The maximum length of fully-qualified object name to use in an errorinfo
 * message. Longer than this will be curtailed.
 */

#define OBJNAME_LENGTH_IN_ERRORINFO_LIMIT 30

/*
 * Some things that make it easier to declare a slot.
 */

struct DeclaredSlot {
    const char *name;
    const Tcl_MethodType getterType;
    const Tcl_MethodType setterType;
    const Tcl_MethodType resolverType;
};

#define SLOT(name,getter,setter,resolver)				\
    {"::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},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
		    resolver, NULL, NULL}}

/*
 * A [string match] pattern used to determine if a method should be exported.
 */

#define PUBLIC_PATTERN		"[a-z]*"

/*
 * 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 void	GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
			    Tcl_Obj *savedNameObj, const char *typeOfSubject);
static inline int	MagicDefinitionInvoke(Tcl_Interp *interp,
			    Tcl_Namespace *nsPtr, int cmdIndex,
			    int objc, Tcl_Obj *const *objv);
static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *className, const char *errMsg);
static inline Tcl_Namespace *GetNamespaceInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *namespaceName);
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);
static int		ResolveClass(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, NULL),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet, ResolveClass),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet, ResolveClass),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet, NULL),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * How to build the in-namespace name of a private variable. This is a pattern
 * used with Tcl_ObjPrintf().
 */

#define PRIVATE_VARIABLE_PATTERN "%d : %s"

/*
 * ----------------------------------------------------------------------
 *
 * IsPrivateDefine --
 *
 *	Extracts whether the current context is handling private definitions.
 *
 * ----------------------------------------------------------------------
 */

static inline int
IsPrivateDefine(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (!iPtr->varFramePtr) {
	return 0;
    }
    return iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME;
}

/*
 * ----------------------------------------------------------------------
 *
 * BumpGlobalEpoch --
 *
 *	Utility that ensures that call chains that are invalid will get thrown
 *	away at an appropriate time. Note that exactly which epoch gets
 *	advanced will depend on exactly what the class is tangled up in; in
 *	the worst case, the simplest option is to advance the global epoch,
 *	causing *everything* to be thrown away on next usage.
 *
 * ----------------------------------------------------------------------
 */

static inline void
BumpGlobalEpoch(
    Tcl_Interp *interp,
    Class *classPtr)
{
    if (classPtr != NULL
	    && classPtr->subclasses.num == 0
	    && classPtr->instances.num == 0
	    && classPtr->mixinSubs.num == 0) {
	/*
	 * If a class has no subclasses or instances, and is not mixed into
	 * anything, a change to its structure does not require us to
	 * invalidate any call chains. Note that we still bump our object's
	 * epoch if it has any mixins; the relation between a class and its
	 * representative object is special. But it won't hurt.
	 */

	if (classPtr->thisPtr->mixins.num > 0) {
	    classPtr->thisPtr->epoch++;
	}
	return;
    }

    /*
     * Either there's no class (?!) or we're reconfiguring something that is
     * in use. Force regeneration of call chains.
     */

    TclOOGetFoundation(interp)->epoch++;
}

/*
 * ----------------------------------------------------------------------
 *
 * RecomputeClassCacheFlag --
 *
 *	Determine whether the object is prototypical of its class, and hence
 *	able to use the class's method chain cache.
 *
 * ----------------------------------------------------------------------
 */

static inline void
RecomputeClassCacheFlag(
    Object *oPtr)
{
    if ((oPtr->methodsPtr == NULL || oPtr->methodsPtr->numEntries == 0)
	    && (oPtr->mixins.num == 0) && (oPtr->filters.num == 0)) {
	oPtr->flags |= USE_CLASS_CACHE;
    } else {
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectSetFilters --
 *
 *	Install a list of filter method names into an object.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOObjectSetFilters(
    Object *oPtr,
    int numFilters,
    Tcl_Obj *const *filters)
{
    int i;

    if (oPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, oPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	Tcl_Free(oPtr->filters.list);
	oPtr->filters.list = NULL;
	oPtr->filters.num = 0;
	RecomputeClassCacheFlag(oPtr);
    } else {
	/*
	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (oPtr->filters.num == 0) {
	    filtersList = (Tcl_Obj **)Tcl_Alloc(size);
	} else {
	    filtersList = (Tcl_Obj **)Tcl_Realloc(oPtr->filters.list, size);
	}
	for (i = 0 ; i < numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	oPtr->filters.list = filtersList;
	oPtr->filters.num = numFilters;
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    oPtr->epoch++;		/* Only this object can be affected. */
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetFilters --
 *
 *	Install a list of filter method names into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetFilters(
    Tcl_Interp *interp,
    Class *classPtr,
    int numFilters,
    Tcl_Obj *const *filters)
{
    int i;

    if (classPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, classPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
    }

    if (numFilters == 0) {
	/*
	 * No list of filters was supplied, so we're deleting filters.
	 */

	Tcl_Free(classPtr->filters.list);
	classPtr->filters.list = NULL;
	classPtr->filters.num = 0;
    } else {
	/*
	 * We've got a list of filters, so we're creating filters.
	 */

	Tcl_Obj **filtersList;
	int size = sizeof(Tcl_Obj *) * numFilters;	/* should be size_t */

	if (classPtr->filters.num == 0) {
	    filtersList = (Tcl_Obj **)Tcl_Alloc(size);
	} else {
	    filtersList = (Tcl_Obj **)Tcl_Realloc(classPtr->filters.list, size);
	}
	for (i = 0 ; i < numFilters ; i++) {
	    filtersList[i] = filters[i];
	    Tcl_IncrRefCount(filters[i]);
	}
	classPtr->filters.list = filtersList;
	classPtr->filters.num = numFilters;
    }

    /*
     * There may be many objects affected, so bump the global epoch.
     */

    BumpGlobalEpoch(interp, classPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjectSetMixins --
 *
 *	Install a list of mixin classes into an object.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOObjectSetMixins(
    Object *oPtr,
    int numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    int i;

    if (numMixins == 0) {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		TclOORemoveFromInstances(oPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    Tcl_Free(oPtr->mixins.list);
	    oPtr->mixins.num = 0;
	}
	RecomputeClassCacheFlag(oPtr);
    } else {
	if (oPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, oPtr->mixins) {
		if (mixinPtr && mixinPtr != oPtr->selfCls) {
		    TclOORemoveFromInstances(oPtr, mixinPtr);
		}
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    oPtr->mixins.list = (Class **)Tcl_Realloc(oPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    oPtr->mixins.list = (Class **)Tcl_Alloc(sizeof(Class *) * numMixins);
	    oPtr->flags &= ~USE_CLASS_CACHE;
	}
	oPtr->mixins.num = numMixins;
	memcpy(oPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, oPtr->mixins) {
	    if (mixinPtr != oPtr->selfCls) {
		TclOOAddToInstances(oPtr, mixinPtr);

		/*
		 * For the new copy created by memcpy().
		 */

		AddRef(mixinPtr->thisPtr);
	    }
	}
    }
    oPtr->epoch++;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOClassSetMixins --
 *
 *	Install a list of mixin classes into a class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOClassSetMixins(
    Tcl_Interp *interp,
    Class *classPtr,
    int numMixins,
    Class *const *mixins)
{
    Class *mixinPtr;
    int i;

    if (numMixins == 0) {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    Tcl_Free(classPtr->mixins.list);
	    classPtr->mixins.num = 0;
	}
    } else {
	if (classPtr->mixins.num != 0) {
	    FOREACH(mixinPtr, classPtr->mixins) {
		TclOORemoveFromMixinSubs(classPtr, mixinPtr);
		TclOODecrRefCount(mixinPtr->thisPtr);
	    }
	    classPtr->mixins.list = (Class **)Tcl_Realloc(classPtr->mixins.list,
		    sizeof(Class *) * numMixins);
	} else {
	    classPtr->mixins.list = (Class **)Tcl_Alloc(sizeof(Class *) * numMixins);
	}
	classPtr->mixins.num = numMixins;
	memcpy(classPtr->mixins.list, mixins, sizeof(Class *) * numMixins);
	FOREACH(mixinPtr, classPtr->mixins) {
	    TclOOAddToMixinSubs(classPtr, mixinPtr);

	    /*
	     * For the new copy created by memcpy.
	     */

	    AddRef(mixinPtr->thisPtr);
	}
    }
    BumpGlobalEpoch(interp, classPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * InstallStandardVariableMapping, InstallPrivateVariableMapping --
 *
 *	Helpers for installing standard and private variable maps.
 *
 * ----------------------------------------------------------------------
 */
static inline void
InstallStandardVariableMapping(
    VariableNameList *vnlPtr,
    int varc,
    Tcl_Obj *const *varv)
{
    Tcl_Obj *variableObj;
    int i, n, created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, *vnlPtr) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    Tcl_Free(vnlPtr->list);
	} else if (i) {
	    vnlPtr->list = (Tcl_Obj **)Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
	} else {
	    vnlPtr->list = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    vnlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		vnlPtr->list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	vnlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    vnlPtr->list = (Tcl_Obj **)Tcl_Realloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

static inline void
InstallPrivateVariableMapping(
    PrivateVariableList *pvlPtr,
    int varc,
    Tcl_Obj *const *varv,
    int creationEpoch)
{
    PrivateVariableMapping *privatePtr;
    int i, n, created;
    Tcl_HashTable uniqueTable;

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH_STRUCT(privatePtr, *pvlPtr) {
	Tcl_DecrRefCount(privatePtr->variableObj);
	Tcl_DecrRefCount(privatePtr->fullNameObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    Tcl_Free(pvlPtr->list);
	} else if (i) {
	    pvlPtr->list = (PrivateVariableMapping *)Tcl_Realloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * varc);
	} else {
	    pvlPtr->list = (PrivateVariableMapping *)Tcl_Alloc(sizeof(PrivateVariableMapping) * varc);
	}
    }

    pvlPtr->num = 0;
    if (varc > 0) {
	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		privatePtr = &(pvlPtr->list[n++]);
		privatePtr->variableObj = varv[i];
		privatePtr->fullNameObj = Tcl_ObjPrintf(
			PRIVATE_VARIABLE_PATTERN,
			creationEpoch, TclGetString(varv[i]));
		Tcl_IncrRefCount(privatePtr->fullNameObj);
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	pvlPtr->num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	if (n != varc) {
	    pvlPtr->list = (PrivateVariableMapping *)Tcl_Realloc(pvlPtr->list,
		    sizeof(PrivateVariableMapping) * n);
	}
	Tcl_DeleteHashTable(&uniqueTable);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * RenameDeleteMethod --
 *
 *	Core of the code to rename and delete methods.
 *
 * ----------------------------------------------------------------------
 */

static int
RenameDeleteMethod(
    Tcl_Interp *interp,
    Object *oPtr,
    int useClass,
    Tcl_Obj *const fromPtr,
    Tcl_Obj *const toPtr)
{
    Tcl_HashEntry *hPtr, *newHPtr = NULL;
    Method *mPtr;
    int isNew;

    if (!useClass) {
	if (!oPtr->methodsPtr) {
	noSuchMethod:
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "method %s does not exist", TclGetString(fromPtr)));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		    TclGetString(fromPtr), NULL);
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) fromPtr);
	if (hPtr == NULL) {
	    goto noSuchMethod;
	}
	if (toPtr) {
	    newHPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) toPtr,
		    &isNew);
	    if (hPtr == newHPtr) {
	    renameToSelf:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"cannot rename method to itself", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_TO_SELF", NULL);
		return TCL_ERROR;
	    } else if (!isNew) {
	    renameToExisting:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"method called %s already exists",
			TclGetString(toPtr)));
		Tcl_SetErrorCode(interp, "TCL", "OO", "RENAME_OVER", NULL);
		return TCL_ERROR;
	    }
	}
    } else {
	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
		(char *) fromPtr);
	if (hPtr == NULL) {
	    goto noSuchMethod;
	}
	if (toPtr) {
	    newHPtr = Tcl_CreateHashEntry(&oPtr->classPtr->classMethods,
		    (char *) toPtr, &isNew);
	    if (hPtr == newHPtr) {
		goto renameToSelf;
	    } else if (!isNew) {
		goto renameToExisting;
	    }
	}
    }

    /*
     * Complete the splicing by changing the method's name.
     */

    mPtr = (Method *)Tcl_GetHashValue(hPtr);
    if (toPtr) {
	Tcl_IncrRefCount(toPtr);
	Tcl_DecrRefCount(mPtr->namePtr);
	mPtr->namePtr = toPtr;
	Tcl_SetHashValue(newHPtr, mPtr);
    } else {
	if (!useClass) {
	    RecomputeClassCacheFlag(oPtr);
	}
	TclOODelMethodRef(mPtr);
    }
    Tcl_DeleteHashEntry(hPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOUnknownDefinition --
 *
 *	Handles what happens when an unknown command is encountered during the
 *	processing of a definition script. Works by finding a command in the
 *	operating definition namespace that the requested command is a unique
 *	prefix of.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOUnknownDefinition(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    size_t soughtLen;
    const char *soughtStr, *matchedStr = NULL;

    if (objc < 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"bad call of unknown handler", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_UNKNOWN", NULL);
	return TCL_ERROR;
    }
    if (TclOOGetDefineCmdContext(interp) == NULL) {
	return TCL_ERROR;
    }

    soughtStr = TclGetStringFromObj(objv[1], &soughtLen);
    if (soughtLen == 0) {
	goto noMatch;
    }
    hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
    while (hPtr != NULL) {
	const char *nameStr = (const char *)Tcl_GetHashKey(&nsPtr->cmdTable, hPtr);

	if (strncmp(soughtStr, nameStr, soughtLen) == 0) {
	    if (matchedStr != NULL) {
		goto noMatch;
	    }
	    matchedStr = nameStr;
	}
	hPtr = Tcl_NextHashEntry(&search);
    }

    if (matchedStr != NULL) {
	/*
	 * Got one match, and only one match!
	 */

	Tcl_Obj **newObjv = (Tcl_Obj **)
		TclStackAlloc(interp, sizeof(Tcl_Obj*) * (objc - 1));
	int result;

	newObjv[0] = Tcl_NewStringObj(matchedStr, -1);
	Tcl_IncrRefCount(newObjv[0]);
	if (objc > 2) {
	    memcpy(newObjv + 1, objv + 2, sizeof(Tcl_Obj *) * (objc - 2));
	}
	result = Tcl_EvalObjv(interp, objc - 1, newObjv, 0);
	Tcl_DecrRefCount(newObjv[0]);
	TclStackFree(interp, newObjv);
	return result;
    }

  noMatch:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "invalid command name \"%s\"", soughtStr));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", soughtStr, NULL);
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * FindCommand --
 *
 *	Specialized version of Tcl_FindCommand that handles command prefixes
 *	and disallows namespace magic.
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Command
FindCommand(
    Tcl_Interp *interp,
    Tcl_Obj *stringObj,
    Tcl_Namespace *const namespacePtr)
{
    size_t length;
    const char *nameStr, *string = TclGetStringFromObj(stringObj, &length);
    Namespace *const nsPtr = (Namespace *) namespacePtr;
    FOREACH_HASH_DECLS;
    Tcl_Command cmd, cmd2;

    /*
     * If someone is playing games, we stop playing right now.
     */

    if (string[0] == '\0' || strstr(string, "::") != NULL) {
	return NULL;
    }

    /*
     * Do the exact lookup first.
     */

    cmd = Tcl_FindCommand(interp, string, namespacePtr, TCL_NAMESPACE_ONLY);
    if (cmd != NULL) {
	return cmd;
    }

    /*
     * Bother, need to perform an approximate match. Iterate across the hash
     * table of commands in the namespace.
     */

    FOREACH_HASH(nameStr, cmd2, &nsPtr->cmdTable) {
	if (strncmp(string, nameStr, length) == 0) {
	    if (cmd != NULL) {
		return NULL;
	    }
	    cmd = cmd2;
	}
    }

    /*
     * Either we found one thing or we found nothing. Either way, return it.
     */

    return cmd;
}

/*
 * ----------------------------------------------------------------------
 *
 * InitDefineContext --
 *
 *	Does the magic incantations necessary to push the special stack frame
 *	used when processing object definitions. It is up to the caller to
 *	dispose of the frame (with TclPopStackFrame) when finished.
 *
 * ----------------------------------------------------------------------
 */

static inline int
InitDefineContext(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr,
    Object *oPtr,
    int objc,
    Tcl_Obj *const objv[])
{
    CallFrame *framePtr, **framePtrPtr = &framePtr;

    if (namespacePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"no definition namespace available", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
     */

    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    namespacePtr, FRAME_IS_OO_DEFINE);
    framePtr->clientData = oPtr;
    framePtr->objc = objc;
    framePtr->objv = objv;	/* Reference counts do not need to be
				 * incremented here. */
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetDefineCmdContext --
 *
 *	Extracts the magic token from the current stack frame, or returns NULL
 *	(and leaves an error message) otherwise.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Object
TclOOGetDefineCmdContext(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Object object;

    if ((iPtr->varFramePtr == NULL)
	    || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE
	    && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"this command may only be called from within the context of"
		" an ::oo::define or ::oo::objdefine command", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
    object = (Tcl_Object)iPtr->varFramePtr->clientData;
    if (Tcl_ObjectDeleted(object)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"this command cannot be called when the object has been"
		" deleted", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return NULL;
    }
    return object;
}

/*
 * ----------------------------------------------------------------------
 *
 * GetClassInOuterContext, GetNamespaceInOuterContext --
 *
 *	Wrappers round Tcl_GetObjectFromObj and TclGetNamespaceFromObj to
 *	perform the lookup in the context that called oo::define (or
 *	equivalent). Note that this may have to go up multiple levels to get
 *	the level that we started doing definitions at.
 *
 * ----------------------------------------------------------------------
 */

static inline Class *
GetClassInOuterContext(
    Tcl_Interp *interp,
    Tcl_Obj *className,
    const char *errMsg)
{
    Interp *iPtr = (Interp *) interp;
    Object *oPtr;
    CallFrame *savedFramePtr = iPtr->varFramePtr;

    while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
	    || iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
	if (iPtr->varFramePtr->callerVarPtr == NULL) {
	    Tcl_Panic("getting outer context when already in global context");
	}
	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, className);
    iPtr->varFramePtr = savedFramePtr;
    if (oPtr == NULL) {
	return NULL;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(className), NULL);
	return NULL;
    }
    return oPtr->classPtr;
}

static inline Tcl_Namespace *
GetNamespaceInOuterContext(
    Tcl_Interp *interp,
    Tcl_Obj *namespaceName)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Namespace *nsPtr;
    int result;
    CallFrame *savedFramePtr = iPtr->varFramePtr;

    while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
	    || iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
	if (iPtr->varFramePtr->callerVarPtr == NULL) {
	    Tcl_Panic("getting outer context when already in global context");
	}
	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
    }
    result = TclGetNamespaceFromObj(interp, namespaceName, &nsPtr);
    iPtr->varFramePtr = savedFramePtr;
    if (result != TCL_OK) {
	return NULL;
    }
    return nsPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * GenerateErrorInfo --
 *
 *	Factored out code to generate part of the error trace messages.
 *
 * ----------------------------------------------------------------------
 */

static inline void
GenerateErrorInfo(
    Tcl_Interp *interp,		/* Where to store the error info trace. */
    Object *oPtr,		/* What object (or class) was being configured
				 * when the error occurred? */
    Tcl_Obj *savedNameObj,	/* Name of object saved from before script was
				 * evaluated, which is needed if the object
				 * goes away part way through execution. OTOH,
				 * if the object isn't deleted then its
				 * current name (post-execution) has to be
				 * used. This matters, because the object
				 * could have been renamed... */
    const char *typeOfSubject)	/* Part of the message, saying whether it was
				 * an object, class or class-as-object that
				 * was being configured. */
{
    size_t length;
    Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
	    ? savedNameObj : TclOOObjectName(interp, oPtr);
    const char *objName = TclGetStringFromObj(realNameObj, &length);
    unsigned limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
    int overflow = (length > limit);

    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (in definition script for %s \"%.*s%s\" line %d)",
	    typeOfSubject, (overflow ? limit : (unsigned)length), objName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}

/*
 * ----------------------------------------------------------------------
 *
 * MagicDefinitionInvoke --
 *
 *	Part of the implementation of the "oo::define" and "oo::objdefine"
 *	commands that is used to implement the more-than-one-argument case,
 *	applying ensemble-like tricks with dispatch so that error messages are
 *	clearer. Doesn't handle the management of the stack frame.
 *
 * ----------------------------------------------------------------------
 */

static inline int
MagicDefinitionInvoke(
    Tcl_Interp *interp,
    Tcl_Namespace *nsPtr,
    int cmdIndex,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *objPtr, *obj2Ptr, **objs;
    Tcl_Command cmd;
    int isRoot, dummy, result, offset = cmdIndex + 1;

    /*
     * More than one argument: fire them through the ensemble processing
     * engine so that everything appears to be good and proper in error
     * messages. Note that we cannot just concatenate and send through
     * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we cannot go
     * through Tcl_EvalObjv without the extra work to pre-find the command, as
     * that finds command names in the wrong namespace at the moment. Ugly!
     */

    isRoot = TclInitRewriteEnsemble(interp, offset, 1, objv);

    /*
     * Build the list of arguments using a Tcl_Obj as a workspace. See
     * comments above for why these contortions are necessary.
     */

    TclNewObj(objPtr);
    TclNewObj(obj2Ptr);
    cmd = FindCommand(interp, objv[cmdIndex], nsPtr);
    if (cmd == NULL) {
	/*
	 * Punt this case!
	 */

	Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
    } else {
	Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
    }
    Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
    /* TODO: overflow? */
    Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset);
    Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);

    result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE);
    if (isRoot) {
	TclResetRewriteEnsemble(interp, 1);
    }
    Tcl_DecrRefCount(objPtr);

    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineObjCmd --
 *
 *	Implementation of the "oo::define" command. Works by effectively doing
 *	the same as 'namespace eval', but with extra magic applied so that the
 *	object to be modified is known to the commands in the target
 *	namespace. Also does ensemble-like tricks with dispatch so that error
 *	messages are clearer.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Namespace *nsPtr;
    Object *oPtr;
    int result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%s does not refer to a class", TclGetString(objv[1])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(objv[1]), NULL);
	return TCL_ERROR;
    }

    /*
     * Make the oo::define namespace the current namespace and evaluate the
     * command(s).
     */

    nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 1);
    if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }

    AddRef(oPtr);
    if (objc == 3) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[2], 0,
		((Interp *)interp)->cmdFramePtr, 2);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj, "class");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, nsPtr, 2, objc, objv);
    }
    TclOODecrRefCount(oPtr);

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOObjDefObjCmd --
 *
 *	Implementation of the "oo::objdefine" command. Works by effectively
 *	doing the same as 'namespace eval', but with extra magic applied so
 *	that the object to be modified is known to the commands in the target
 *	namespace. Also does ensemble-like tricks with dispatch so that error
 *	messages are clearer.
 *
 * ----------------------------------------------------------------------
 */

int
TclOOObjDefObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Namespace *nsPtr;
    Object *oPtr;
    int result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Make the oo::objdefine namespace the current namespace and evaluate the
     * command(s).
     */

    nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
    if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }

    AddRef(oPtr);
    if (objc == 3) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[2], 0,
		((Interp *)interp)->cmdFramePtr, 2);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj, "object");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, nsPtr, 2, objc, objv);
    }
    TclOODecrRefCount(oPtr);

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineSelfObjCmd --
 *
 *	Implementation of the "self" subcommand of the "oo::define" command.
 *	Works by effectively doing the same as 'namespace eval', but with
 *	extra magic applied so that the object to be modified is known to the
 *	commands in the target namespace. Also does ensemble-like tricks with
 *	dispatch so that error messages are clearer.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineSelfObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Namespace *nsPtr;
    Object *oPtr;
    int result, isPrivate;

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (objc < 2) {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
	return TCL_OK;
    }

    isPrivate = IsPrivateDefine(interp);

    /*
     * Make the oo::objdefine namespace the current namespace and evaluate the
     * command(s).
     */

    nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
    if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
	return TCL_ERROR;
    }
    if (isPrivate) {
	((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
    }

    AddRef(oPtr);
    if (objc == 2) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[1], 0,
		((Interp *)interp)->cmdFramePtr, 1);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, nsPtr, 1, objc, objv);
    }
    TclOODecrRefCount(oPtr);

    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineObjSelfObjCmd --
 *
 *	Implementation of the "self" subcommand of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineObjSelfObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefinePrivateObjCmd --
 *
 *	Implementation of the "private" subcommand of the "oo::define"
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefinePrivateObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstancePrivate = (clientData != NULL);
				/* Just so that we can generate the correct
				 * error message depending on the context of
				 * usage of this function. */
    Interp *iPtr = (Interp *) interp;
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int saved;			/* The saved flag. We restore it on exit so
				 * that [private private ...] doesn't make
				 * things go weird. */
    int result;

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(IsPrivateDefine(interp)));
	return TCL_OK;
    }

    /*
     * Change the frame type flag while evaluating the body.
     */

    saved = iPtr->varFramePtr->isProcCallFrame;
    iPtr->varFramePtr->isProcCallFrame = PRIVATE_FRAME;

    /*
     * Evaluate the body; standard pattern.
     */

    AddRef(oPtr);
    if (objc == 2) {
	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);

	Tcl_IncrRefCount(objNameObj);
	result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
	if (result == TCL_ERROR) {
	    GenerateErrorInfo(interp, oPtr, objNameObj,
		    isInstancePrivate ? "object" : "class");
	}
	TclDecrRefCount(objNameObj);
    } else {
	result = MagicDefinitionInvoke(interp, TclGetCurrentNamespace(interp),
		1, objc, objv);
    }
    TclOODecrRefCount(oPtr);

    /*
     * Restore the frame type flag to what it was previously.
     */

    iPtr->varFramePtr->isProcCallFrame = saved;
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineClassObjCmd --
 *
 *	Implementation of the "class" subcommand of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineClassObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Foundation *fPtr = TclOOGetFoundation(interp);
    int wasClass, willBeClass;

    /*
     * Parse the context to get the object to operate on.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_OBJECT) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the class of the root object class", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_CLASS) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the class of the class of classes", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse the argument to get the class to set the object's class to.
     */

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassInOuterContext(interp, objv[1],
	    "the class of an object must be a class");
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr == clsPtr->thisPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not change classes into an instance of themselves", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Set the object's class.
     */

    wasClass = (oPtr->classPtr != NULL);
    willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));

    if (oPtr->selfCls != clsPtr) {
	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
	TclOODecrRefCount(oPtr->selfCls->thisPtr);
	oPtr->selfCls = clsPtr;
	AddRef(oPtr->selfCls->thisPtr);
	TclOOAddToInstances(oPtr, oPtr->selfCls);

	/*
	 * Create or delete the class guts if necessary.
	 */

	if (wasClass && !willBeClass) {
	    /*
	     * This is the most global of all epochs. Bump it! No cache can be
	     * trusted!
	     */

	    TclOORemoveFromMixins(oPtr->classPtr, oPtr);
	    oPtr->fPtr->epoch++;
	    oPtr->flags |= DONT_DELETE;
	    TclOODeleteDescendants(interp, oPtr);
	    oPtr->flags &= ~DONT_DELETE;
	    TclOOReleaseClassContents(interp, oPtr);
	    Tcl_Free(oPtr->classPtr);
	    oPtr->classPtr = NULL;
	} else if (!wasClass && willBeClass) {
	    TclOOAllocClass(interp, oPtr);
	}

	if (oPtr->classPtr != NULL) {
	    BumpGlobalEpoch(interp, oPtr->classPtr);
	} else {
	    oPtr->epoch++;
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineConstructorObjCmd --
 *
 *	Implementation of the "constructor" subcommand of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineConstructorObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    size_t bodyLength;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arguments body");
	return TCL_ERROR;
    }

    /*
     * Extract and validate the context, which is the class that we wish to
     * modify.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    (void)TclGetStringFromObj(objv[2], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, objv[1], objv[2], NULL);
	if (method == NULL) {
	    return TCL_ERROR;
	}
    } else {
	/*
	 * Delete the constructor method record and set the field in the
	 * class record to NULL.
	 */

	method = NULL;
    }

    /*
     * Place the method structure in the class record. Note that we might not
     * immediately delete the constructor as this might be being done during
     * execution of the constructor itself.
     */

    Tcl_ClassSetConstructor(interp, (Tcl_Class) clsPtr, method);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineDefnNsObjCmd --
 *
 *	Implementation of the "definitionnamespace" subcommand of the
 *	"oo::define" command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineDefnNsObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    static const char *kindList[] = {
	"-class",
	"-instance",
	NULL
    };
    int kind = 0;
    Object *oPtr;
    Tcl_Namespace *nsPtr;
    Tcl_Obj *nsNamePtr, **storagePtr;

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    if (oPtr->flags & (ROOT_OBJECT | ROOT_CLASS)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the definition namespace of the root classes",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse the arguments and work out what the user wants to do.
     */

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?kind? namespace");
	return TCL_ERROR;
    }
    if (objc == 3 && Tcl_GetIndexFromObj(interp, objv[1], kindList, "kind", 0,
	    &kind) != TCL_OK) {
	return TCL_ERROR;
    }
    if (!TclGetString(objv[objc - 1])[0]) {
	nsNamePtr = NULL;
    } else {
	nsPtr = GetNamespaceInOuterContext(interp, objv[objc - 1]);
	if (nsPtr == NULL) {
	    return TCL_ERROR;
	}
	nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, -1);
	Tcl_IncrRefCount(nsNamePtr);
    }

    /*
     * Update the correct field of the class definition.
     */

    if (kind) {
	storagePtr = &oPtr->classPtr->objDefinitionNs;
    } else {
	storagePtr = &oPtr->classPtr->clsDefinitionNs;
    }
    if (*storagePtr != NULL) {
	Tcl_DecrRefCount(*storagePtr);
    }
    *storagePtr = nsNamePtr;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineDeleteMethodObjCmd --
 *
 *	Implementation of the "deletemethod" subcommand of the "oo::define"
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineDeleteMethodObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceDeleteMethod = (clientData != NULL);
    Object *oPtr;
    int i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceDeleteMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Delete the method structure from the appropriate hash table.
	 */

	if (RenameDeleteMethod(interp, oPtr, !isInstanceDeleteMethod,
		objv[i], NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    if (isInstanceDeleteMethod) {
	oPtr->epoch++;
    } else {
	BumpGlobalEpoch(interp, oPtr->classPtr);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineDestructorObjCmd --
 *
 *	Implementation of the "destructor" subcommand of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineDestructorObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class *clsPtr;
    Tcl_Method method;
    size_t bodyLength;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "body");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;

    (void)TclGetStringFromObj(objv[1], &bodyLength);
    if (bodyLength > 0) {
	/*
	 * Create the method structure.
	 */

	method = (Tcl_Method) TclOONewProcMethod(interp, clsPtr,
		PUBLIC_METHOD, NULL, NULL, objv[1], NULL);
	if (method == NULL) {
	    return TCL_ERROR;
	}
    } else {
	/*
	 * Delete the destructor method record and set the field in the class
	 * record to NULL.
	 */

	method = NULL;
    }

    /*
     * Place the method structure in the class record. Note that we might not
     * immediately delete the destructor as this might be being done during
     * execution of the destructor itself. Also note that setting a
     * destructor during a destructor is fairly dumb anyway.
     */

    Tcl_ClassSetDestructor(interp, (Tcl_Class) clsPtr, method);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineExportObjCmd --
 *
 *	Implementation of the "export" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineExportObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceExport = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    Class *clsPtr;
    int i, isNew, changed = 0;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;
    if (!isInstanceExport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Exporting is done by adding the PUBLIC_METHOD flag to the method
	 * record. If there is no such method in this object or class (i.e.
	 * the method comes from something inherited from or that we're an
	 * instance of) then we put in a blank record with that flag; such
	 * records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceExport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *)objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = (Method *)Tcl_Alloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	}
	if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
	    mPtr->flags |= PUBLIC_METHOD;
	    mPtr->flags &= ~TRUE_PRIVATE_METHOD;
	    changed = 1;
	}
    }

    /*
     * Bump the right epoch if we actually changed anything.
     */

    if (changed) {
	if (isInstanceExport) {
	    oPtr->epoch++;
	} else {
	    BumpGlobalEpoch(interp, clsPtr);
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineForwardObjCmd --
 *
 *	Implementation of the "forward" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineForwardObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceForward = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;
    int isPublic;
    Tcl_Obj *prefixObj;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmdName ?arg ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceForward && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN)
	    ? PUBLIC_METHOD : 0;
    if (IsPrivateDefine(interp)) {
	isPublic = TRUE_PRIVATE_METHOD;
    }

    /*
     * Create the method structure.
     */

    prefixObj = Tcl_NewListObj(objc - 2, objv + 2);
    if (isInstanceForward) {
	mPtr = TclOONewForwardInstanceMethod(interp, oPtr, isPublic, objv[1],
		prefixObj);
    } else {
	mPtr = TclOONewForwardMethod(interp, oPtr->classPtr, isPublic,
		objv[1], prefixObj);
    }
    if (mPtr == NULL) {
	Tcl_DecrRefCount(prefixObj);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineMethodObjCmd --
 *
 *	Implementation of the "method" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineMethodObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    /*
     * Table of export modes for methods and their corresponding enum.
     */

    static const char *const exportModes[] = {
	"-export",
	"-private",
	"-unexport",
	NULL
    };
    enum ExportMode {
	MODE_EXPORT,
	MODE_PRIVATE,
	MODE_UNEXPORT
    } exportMode;

    int isInstanceMethod = (clientData != NULL);
    Object *oPtr;
    int isPublic = 0;

    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?option? args body");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }
    if (objc == 5) {
	if (Tcl_GetIndexFromObj(interp, objv[2], exportModes, "export flag",
		0, (int *) &exportMode) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch (exportMode) {
	case MODE_EXPORT:
	    isPublic = PUBLIC_METHOD;
	    break;
	case MODE_PRIVATE:
	    isPublic = TRUE_PRIVATE_METHOD;
	    break;
	case MODE_UNEXPORT:
	    isPublic = 0;
	    break;
	}
    } else {
	if (IsPrivateDefine(interp)) {
	    isPublic = TRUE_PRIVATE_METHOD;
	} else {
	    isPublic = Tcl_StringMatch(TclGetString(objv[1]), PUBLIC_PATTERN)
		    ? PUBLIC_METHOD : 0;
	}
    }

    /*
     * Create the method by using the right back-end API.
     */

    if (isInstanceMethod) {
	if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1],
		objv[objc - 2], objv[objc - 1], NULL) == NULL) {
	    return TCL_ERROR;
	}
    } else {
	if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1],
		objv[objc - 2], objv[objc - 1], NULL) == NULL) {
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineRenameMethodObjCmd --
 *
 *	Implementation of the "renamemethod" subcommand of the "oo::define"
 *	and "oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineRenameMethodObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceRenameMethod = (clientData != NULL);
    Object *oPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "oldName newName");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceRenameMethod && !oPtr->classPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Delete the method entry from the appropriate hash table, and transfer
     * the thing it points to to its new entry. To do this, we first need to
     * get the entries from the appropriate hash tables (this can generate a
     * range of errors...)
     */

    if (RenameDeleteMethod(interp, oPtr, !isInstanceRenameMethod,
	    objv[1], objv[2]) != TCL_OK) {
	return TCL_ERROR;
    }

    if (isInstanceRenameMethod) {
	oPtr->epoch++;
    } else {
	BumpGlobalEpoch(interp, oPtr->classPtr);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineUnexportObjCmd --
 *
 *	Implementation of the "unexport" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineUnexportObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceUnexport = (clientData != NULL);
    Object *oPtr;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    Class *clsPtr;
    int i, isNew, changed = 0;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name ?name ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    clsPtr = oPtr->classPtr;
    if (!isInstanceUnexport && !clsPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i = 1; i < objc; i++) {
	/*
	 * Unexporting is done by removing the PUBLIC_METHOD flag from the
	 * method record. If there is no such method in this object or class
	 * (i.e. the method comes from something inherited from or that we're
	 * an instance of) then we put in a blank record without that flag;
	 * such records are skipped over by the call chain engine *except* for
	 * their flags member.
	 */

	if (isInstanceUnexport) {
	    if (!oPtr->methodsPtr) {
		oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
		Tcl_InitObjHashTable(oPtr->methodsPtr);
		oPtr->flags &= ~USE_CLASS_CACHE;
	    }
	    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *)objv[i],
		    &isNew);
	} else {
	    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)objv[i],
		    &isNew);
	}

	if (isNew) {
	    mPtr = (Method *)Tcl_Alloc(sizeof(Method));
	    memset(mPtr, 0, sizeof(Method));
	    mPtr->refCount = 1;
	    mPtr->namePtr = objv[i];
	    Tcl_IncrRefCount(objv[i]);
	    Tcl_SetHashValue(hPtr, mPtr);
	} else {
	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
	}
	if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
	    mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
	    changed = 1;
	}
    }

    /*
     * Bump the right epoch if we actually changed anything.
     */

    if (changed) {
	if (isInstanceUnexport) {
	    oPtr->epoch++;
	} else {
	    BumpGlobalEpoch(interp, clsPtr);
	}
    }
    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;

    if (method != (Tcl_Method) clsPtr->constructorPtr) {
	TclOODelMethodRef(clsPtr->constructorPtr);
	clsPtr->constructorPtr = (Method *) method;

	/*
	 * Remember to invalidate the cached constructor chain for this class.
	 * [Bug 2531577]
	 */

	if (clsPtr->constructorChainPtr) {
	    TclOODeleteChain(clsPtr->constructorChainPtr);
	    clsPtr->constructorChainPtr = NULL;
	}
	BumpGlobalEpoch(interp, clsPtr);
    }
}

void
Tcl_ClassSetDestructor(
    Tcl_Interp *interp,
    Tcl_Class clazz,
    Tcl_Method method)
{
    Class *clsPtr = (Class *) clazz;

    if (method != (Tcl_Method) clsPtr->destructorPtr) {
	TclOODelMethodRef(clsPtr->destructorPtr);
	clsPtr->destructorPtr = (Method *) method;
	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);
    Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -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);
    Tcl_IncrRefCount(resolveName);
    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);
	if (slotInfoPtr->resolverType.callProc) {
	    Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
		    &slotInfoPtr->resolverType, NULL);
	}
    }
    Tcl_DecrRefCount(getName);
    Tcl_DecrRefCount(setName);
    Tcl_DecrRefCount(resolveName);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassFilterGet, ClassFilterSet --
 *
 *	Implementation of the "filter" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassFilterGet(
    TCL_UNUSED(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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(filterObj, oPtr->classPtr->filters) {
	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassFilterSet(
    TCL_UNUSED(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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	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(
    TCL_UNUSED(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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(mixinPtr, oPtr->classPtr->mixins) {
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, mixinPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

}

static int
ClassMixinSet(
    TCL_UNUSED(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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	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 = (Class **)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) {
	    i--;
	    goto freeAndError;
	}
	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "may not mix a class into itself", -1));
	    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(
    TCL_UNUSED(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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, superPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassSuperSet(
    TCL_UNUSED(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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"may not modify the superclass of the root object", -1));
	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 **) Tcl_Alloc(sizeof(Class *) * superc);

    /*
     * Parse the arguments to get the class to use as superclasses.
     *
     * Note that zero classes is special, as it is equivalent to just the
     * class of objects. [Bug 9d61624b3d]
     */

    if (superc == 0) {
	superclasses = (Class **)Tcl_Realloc(superclasses, sizeof(Class *));
	if (TclOOIsReachable(oPtr->fPtr->classCls, oPtr->classPtr)) {
	    superclasses[0] = oPtr->fPtr->classCls;
	} else {
	    superclasses[0] = oPtr->fPtr->objectCls;
	}
	superc = 1;
	AddRef(superclasses[0]->thisPtr);
    } else {
	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_SetObjResult(interp, Tcl_NewStringObj(
			    "class should only be a direct superclass once",
			    -1));
		    Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS",NULL);
		    goto failedAfterAlloc;
		}
	    }
	    if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"attempt to form circular dependency graph", -1));
		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	    failedAfterAlloc:
		for (; i-- > 0 ;) {
		    TclOODecrRefCount(superclasses[i]->thisPtr);
		}
		Tcl_Free(superclasses);
		return TCL_ERROR;
	    }

	    /*
	     * Corresponding TclOODecrRefCount() is near the end of this
	     * function.
	     */

	    AddRef(superclasses[i]->thisPtr);
	}
    }

    /*
     * 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);
	    TclOODecrRefCount(superPtr->thisPtr);
	}
	Tcl_Free(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(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    if (IsPrivateDefine(interp)) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, oPtr->classPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassVarsSet(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc;
    Tcl_Obj **varv;
    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_SetObjResult(interp, Tcl_NewStringObj(
		"attempt to misuse API", -1));
	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 = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }

    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables,
		varc, varv, oPtr->classPtr->thisPtr->creationEpoch);
    } else {
	InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectFilterGet, ObjectFilterSet --
 *
 *	Implementation of the "filter" slot accessors of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjFilterGet(
    TCL_UNUSED(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;
    }

    TclNewObj(resultObj);
    FOREACH(filterObj, oPtr->filters) {
	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjFilterSet(
    TCL_UNUSED(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(
    TCL_UNUSED(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;
    }

    TclNewObj(resultObj);
    FOREACH(mixinPtr, oPtr->mixins) {
	if (mixinPtr) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    TclOOObjectName(interp, mixinPtr->thisPtr));
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjMixinSet(
    TCL_UNUSED(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 = (Class **)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(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    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;
    }

    TclNewObj(resultObj);
    if (IsPrivateDefine(interp)) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, oPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjVarsSet(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc, i;
    Tcl_Obj **varv;

    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 = TclGetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "contain namespace separators"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "invalid declared variable name \"%s\": must not %s",
		    varName, "refer to an array element"));
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }

    if (IsPrivateDefine(interp)) {
	InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
		oPtr->creationEpoch);
    } else {
	InstallStandardVariableMapping(&oPtr->variables, varc, varv);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ResolveClass --
 *
 *	Implementation of the "Resolve" support method for some slots (those
 *	that are slots around a list of classes). This resolves possible class
 *	names to their fully-qualified names if possible.
 *
 * ----------------------------------------------------------------------
 */

static int
ResolveClass(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    int idx = Tcl_ObjectContextSkippedArgs(context);
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Class *clsPtr;

    /*
     * Check if were called wrongly. The definition context isn't used...
     * except that GetClassInOuterContext() assumes that it is there.
     */

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (objc != idx + 1) {
	Tcl_WrongNumArgs(interp, idx, objv, "slotElement");
	return TCL_ERROR;
    }

    /*
     * Resolve the class if possible. If not, remove any resolution error and
     * return what we've got anyway as the failure might not be fatal overall.
     */

    clsPtr = GetClassInOuterContext(interp, objv[idx],
	    "USER SHOULD NOT SEE THIS MESSAGE");
    if (clsPtr == NULL) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, objv[idx]);
    } else {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
    }

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOOInfo.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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


























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOODefineCmds.c --
 *
 *	This file contains the implementation of the ::oo-related [info]
 *	subcommands.
 *
 * Copyright (c) 2006-2011 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc InfoObjectCallCmd;
static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
static Tcl_ObjCmdProc InfoObjectIdCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
static Tcl_ObjCmdProc InfoObjectMixinsCmd;
static Tcl_ObjCmdProc InfoObjectNsCmd;
static Tcl_ObjCmdProc InfoObjectVarsCmd;
static Tcl_ObjCmdProc InfoObjectVariablesCmd;
static Tcl_ObjCmdProc InfoClassCallCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
static Tcl_ObjCmdProc InfoClassDefnCmd;
static Tcl_ObjCmdProc InfoClassDefnNsCmd;
static Tcl_ObjCmdProc InfoClassDestrCmd;
static Tcl_ObjCmdProc InfoClassFiltersCmd;
static Tcl_ObjCmdProc InfoClassForwardCmd;
static Tcl_ObjCmdProc InfoClassInstancesCmd;
static Tcl_ObjCmdProc InfoClassMethodsCmd;
static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
static Tcl_ObjCmdProc InfoClassMixinsCmd;
static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const EnsembleImplMap infoObjectCmds[] = {
    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
    {"creationid", InfoObjectIdCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * List of commands that are used to implement the [info class] subcommands.
 */

static const EnsembleImplMap infoClassCmds[] = {
    {"call",	     InfoClassCallCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"constructor",  InfoClassConstrCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition",   InfoClassDefnCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"definitionnamespace", InfoClassDefnNsCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"destructor",   InfoClassDestrCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"filters",	     InfoClassFiltersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"instances",    InfoClassInstancesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInitInfo --
 *
 *	Adjusts the Tcl core [info] command to contain subcommands ("object"
 *	and "class") for introspection of objects and classes.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOInitInfo(
    Tcl_Interp *interp)
{
    Tcl_Command infoCmd;
    Tcl_Obj *mapDict;

    /*
     * Build the ensembles used to implement [info object] and [info class].
     */

    TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectCmds);
    TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);

    /*
     * Install into the [info] ensemble.
     */

    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
    if (infoCmd) {
	Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
	Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
		Tcl_NewStringObj("::oo::InfoObject", -1));
	Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
		Tcl_NewStringObj("::oo::InfoClass", -1));
	Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * GetClassFromObj --
 *
 *	How to correctly get a class from a Tcl_Obj. Just a wrapper round
 *	Tcl_GetObjectFromObj, but this is an idiom that was used heavily.
 *
 * ----------------------------------------------------------------------
 */

static inline Class *
GetClassFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Object *oPtr = (Object *) Tcl_GetObjectFromObj(interp, objPtr);

    if (oPtr == NULL) {
	return NULL;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" is not a class", TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
		TclGetString(objPtr), NULL);
	return NULL;
    }
    return oPtr->classPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectClassCmd --
 *
 *	Implements [info object class $objName ?$className?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectClassCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?className?");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (objc == 2) {
	Tcl_SetObjResult(interp,
		TclOOObjectName(interp, oPtr->selfCls->thisPtr));
	return TCL_OK;
    } else {
	Class *mixinPtr, *o2clsPtr;
	int i;

	o2clsPtr = GetClassFromObj(interp, objv[2]);
	if (o2clsPtr == NULL) {
	    return TCL_ERROR;
	}

	FOREACH(mixinPtr, oPtr->mixins) {
	    if (!mixinPtr) {
		continue;
	    }
	    if (TclOOIsReachable(o2clsPtr, mixinPtr)) {
		Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
		return TCL_OK;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
		TclOOIsReachable(o2clsPtr, oPtr->selfCls)));
	return TCL_OK;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectDefnCmd --
 *
 *	Implements [info object definition $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectDefnCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_HashEntry *hPtr;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *resultObjs[2];

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (!oPtr->methodsPtr) {
	goto unknownMethod;
    }
    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
    if (hPtr == NULL) {
    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method", -1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObjs[0]);
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {
	    Tcl_Obj *argObj;

	    TclNewObj(argObj);
	    Tcl_ListObjAppendElement(NULL, argObj,
		    Tcl_NewStringObj(localPtr->name, -1));
	    if (localPtr->defValuePtr != NULL) {
		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
	    }
	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
	}
    }
    resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectFiltersCmd --
 *
 *	Implements [info object filters $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectFiltersCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int i;
    Tcl_Obj *filterObj, *resultObj;
    Object *oPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    TclNewObj(resultObj);

    FOREACH(filterObj, oPtr->filters) {
	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectForwardCmd --
 *
 *	Implements [info object forward $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectForwardCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *prefixObj;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (!oPtr->methodsPtr) {
	goto unknownMethod;
    }
    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
    if (hPtr == NULL) {
    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (prefixObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"prefix argument list not available for this kind of method",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, prefixObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectIsACmd --
 *
 *	Implements [info object isa $category $objName ...]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectIsACmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const categories[] = {
	"class", "metaclass", "mixin", "object", "typeof", NULL
    };
    enum IsACats {
	IsClass, IsMetaclass, IsMixin, IsObject, IsType
    };
    Object *oPtr, *o2Ptr;
    int idx, i, result = 0;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "category objName ?arg ...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], categories, "category", 0,
	    &idx) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Now we know what test we are doing, we can check we've got the right
     * number of arguments.
     */

    switch ((enum IsACats) idx) {
    case IsObject:
    case IsClass:
    case IsMetaclass:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "objName");
	    return TCL_ERROR;
	}
	break;
    case IsMixin:
    case IsType:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "objName className");
	    return TCL_ERROR;
	}
	break;
    }

    /*
     * Perform the check. Note that we can guarantee that we will not fail
     * from here on; "failures" result in a false-TCL_OK result.
     */

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
    if (oPtr == NULL) {
	goto failPrecondition;
    }

    switch ((enum IsACats) idx) {
    case IsObject:
	result = 1;
	break;
    case IsClass:
	result = (oPtr->classPtr != NULL);
	break;
    case IsMetaclass:
	if (oPtr->classPtr != NULL) {
	    result = TclOOIsReachable(TclOOGetFoundation(interp)->classCls,
		    oPtr->classPtr);
	}
	break;
    case IsMixin:
	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
	if (o2Ptr == NULL) {
	    goto failPrecondition;
	}
	if (o2Ptr->classPtr != NULL) {
	    Class *mixinPtr;

	    FOREACH(mixinPtr, oPtr->mixins) {
		if (!mixinPtr) {
		    continue;
		}
		if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) {
		    result = 1;
		    break;
		}
	    }
	}
	break;
    case IsType:
	o2Ptr = (Object *) Tcl_GetObjectFromObj(interp, objv[3]);
	if (o2Ptr == NULL) {
	    goto failPrecondition;
	}
	if (o2Ptr->classPtr != NULL) {
	    result = TclOOIsReachable(o2Ptr->classPtr, oPtr->selfCls);
	}
	break;
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result));
    return TCL_OK;

  failPrecondition:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectMethodsCmd --
 *
 *	Implements [info object methods $objName ?$option ...?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectMethodsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    FOREACH_HASH_DECLS;
    Tcl_Obj *namePtr, *resultObj;
    Method *mPtr;
    static const char *const options[] = {
	"-all", "-localprivate", "-private", "-scope", NULL
    };
    enum Options {
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
    };
    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
	SCOPE_LOCALPRIVATE
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-option value ...?");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc != 2) {
	int i, idx;

	for (i=2 ; i<objc ; i++) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &idx) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) idx) {
	    case OPT_ALL:
		recurse = 1;
		break;
	    case OPT_LOCALPRIVATE:
		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
			    NULL);
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    }
	}
    }
    if (scope != -1) {
	recurse = 0;
	switch (scope) {
	case SCOPE_PRIVATE:
	    flag = TRUE_PRIVATE_METHOD;
	    break;
	case SCOPE_PUBLIC:
	    flag = PUBLIC_METHOD;
	    break;
	case SCOPE_LOCALPRIVATE:
	    flag = PRIVATE_METHOD;
	    break;
	case SCOPE_UNEXPORTED:
	    flag = 0;
	    break;
	}
    }

    TclNewObj(resultObj);
    if (recurse) {
	const char **names;
	int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag,
		&names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    Tcl_Free((void *)names);
	}
    } else if (oPtr->methodsPtr) {
	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectMethodTypeCmd --
 *
 *	Implements [info object methodtype $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectMethodTypeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_HashEntry *hPtr;
    Method *mPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
	return TCL_ERROR;
    }

    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (!oPtr->methodsPtr) {
	goto unknownMethod;
    }
    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[2]);
    if (hPtr == NULL) {
    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    mPtr = (Method *)Tcl_GetHashValue(hPtr);
    if (mPtr->typePtr == NULL) {
	/*
	 * Special entry for visibility control: pretend the method doesnt
	 * exist.
	 */

	goto unknownMethod;
    }

    Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectMixinsCmd --
 *
 *	Implements [info object mixins $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectMixinsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *mixinPtr;
    Object *oPtr;
    Tcl_Obj *resultObj;
    int i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(mixinPtr, oPtr->mixins) {
	if (!mixinPtr) {
	    continue;
	}
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, mixinPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectIdCmd --
 *
 *	Implements [info object creationid $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectIdCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(oPtr->creationEpoch));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectNsCmd --
 *
 *	Implements [info object namespace $objName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectNsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectVariablesCmd --
 *
 *	Implements [info object variables $objName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectVariablesCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Tcl_Obj *resultObj;
    int i, isPrivate = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", TclGetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    if (isPrivate) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, oPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectVarsCmd --
 *
 *	Implements [info object vars $objName ?$pattern?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectVarsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    const char *pattern = NULL;
    FOREACH_HASH_DECLS;
    VarInHash *vihPtr;
    Tcl_Obj *nameObj, *resultObj;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName ?pattern?");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc == 3) {
	pattern = TclGetString(objv[2]);
    }
    TclNewObj(resultObj);

    /*
     * Extract the information we need from the object's namespace's table of
     * variables. Note that this involves horrific knowledge of the guts of
     * tclVar.c, so we can't leverage our hash-iteration macros properly.
     */

    FOREACH_HASH_VALUE(vihPtr,
	    &((Namespace *) oPtr->namespacePtr)->varTable.table) {
	nameObj = vihPtr->entry.key.objPtr;

	if (TclIsVarUndefined(&vihPtr->var)
		|| !TclIsVarNamespaceVar(&vihPtr->var)) {
	    continue;
	}
	if (pattern != NULL
		&& !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
	    continue;
	}
	Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
    }

    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassConstrCmd --
 *
 *	Implements [info class constructor $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassConstrCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *resultObjs[2];
    Class *clsPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (clsPtr->constructorPtr == NULL) {
	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->constructorPtr);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObjs[0]);
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {
	    Tcl_Obj *argObj;

	    TclNewObj(argObj);
	    Tcl_ListObjAppendElement(NULL, argObj,
		    Tcl_NewStringObj(localPtr->name, -1));
	    if (localPtr->defValuePtr != NULL) {
		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
	    }
	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
	}
    }
    resultObjs[1] = TclOOGetMethodBody(clsPtr->constructorPtr);
    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassDefnCmd --
 *
 *	Implements [info class definition $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassDefnCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_HashEntry *hPtr;
    Proc *procPtr;
    CompiledLocal *localPtr;
    Tcl_Obj *resultObjs[2];
    Class *clsPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    procPtr = TclOOGetProcFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method", -1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObjs[0]);
    for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {
	    Tcl_Obj *argObj;

	    TclNewObj(argObj);
	    Tcl_ListObjAppendElement(NULL, argObj,
		    Tcl_NewStringObj(localPtr->name, -1));
	    if (localPtr->defValuePtr != NULL) {
		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
	    }
	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
	}
    }
    resultObjs[1] = TclOOGetMethodBody((Method *)Tcl_GetHashValue(hPtr));
    Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassDefnNsCmd --
 *
 *	Implements [info class definitionnamespace $clsName ?$kind?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassDefnNsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *kindList[] = {
	"-class",
	"-instance",
	NULL
    };
    int kind = 0;
    Tcl_Obj *nsNamePtr;
    Class *clsPtr;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?kind?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc == 3 && Tcl_GetIndexFromObj(interp, objv[2], kindList, "kind", 0,
	    &kind) != TCL_OK) {
	return TCL_ERROR;
    }

    if (kind) {
	nsNamePtr = clsPtr->objDefinitionNs;
    } else {
	nsNamePtr = clsPtr->clsDefinitionNs;
    }
    if (nsNamePtr) {
	Tcl_SetObjResult(interp, nsNamePtr);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassDestrCmd --
 *
 *	Implements [info class destructor $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassDestrCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Proc *procPtr;
    Class *clsPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    if (clsPtr->destructorPtr == NULL) {
	return TCL_OK;
    }
    procPtr = TclOOGetProcFromMethod(clsPtr->destructorPtr);
    if (procPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"definition not available for this kind of method", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "METHOD_TYPE", NULL);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOGetMethodBody(clsPtr->destructorPtr));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassFiltersCmd --
 *
 *	Implements [info class filters $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassFiltersCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int i;
    Tcl_Obj *filterObj, *resultObj;
    Class *clsPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(filterObj, clsPtr->filters) {
	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassForwardCmd --
 *
 *	Implements [info class forward $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassForwardCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_HashEntry *hPtr;
    Tcl_Obj *prefixObj;
    Class *clsPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
    if (hPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    prefixObj = TclOOGetFwdFromMethod((Method *)Tcl_GetHashValue(hPtr));
    if (prefixObj == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"prefix argument list not available for this kind of method",
		-1));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, prefixObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassInstancesCmd --
 *
 *	Implements [info class instances $clsName ?$pattern?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassInstancesCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    Class *clsPtr;
    int i;
    const char *pattern = NULL;
    Tcl_Obj *resultObj;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc == 3) {
	pattern = TclGetString(objv[2]);
    }

    TclNewObj(resultObj);
    FOREACH(oPtr, clsPtr->instances) {
	Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr);

	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
	    continue;
	}
	Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassMethodsCmd --
 *
 *	Implements [info class methods $clsName ?options...?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMethodsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
    Tcl_Obj *namePtr, *resultObj;
    Method *mPtr;
    Class *clsPtr;
    static const char *const options[] = {
	"-all", "-localprivate", "-private", "-scope", NULL
    };
    enum Options {
	OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
    };
    static const char *const scopes[] = {
	"private", "public", "unexported"
    };
    enum Scopes {
	SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-option value ...?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc != 2) {
	int i, idx;

	for (i=2 ; i<objc ; i++) {
	    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
		    &idx) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum Options) idx) {
	    case OPT_ALL:
		recurse = 1;
		break;
	    case OPT_LOCALPRIVATE:
		flag = PRIVATE_METHOD;
		break;
	    case OPT_PRIVATE:
		flag = 0;
		break;
	    case OPT_SCOPE:
		if (++i >= objc) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "missing option for -scope"));
		    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
			    NULL);
		    return TCL_ERROR;
		}
		if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
			&scope) != TCL_OK) {
		    return TCL_ERROR;
		}
		break;
	    }
	}
    }
    if (scope != -1) {
	recurse = 0;
	switch (scope) {
	case SCOPE_PRIVATE:
	    flag = TRUE_PRIVATE_METHOD;
	    break;
	case SCOPE_PUBLIC:
	    flag = PUBLIC_METHOD;
	    break;
	case SCOPE_UNEXPORTED:
	    flag = 0;
	    break;
	}
    }

    TclNewObj(resultObj);
    if (recurse) {
	const char **names;
	int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names);

	for (i=0 ; i<numNames ; i++) {
	    Tcl_ListObjAppendElement(NULL, resultObj,
		    Tcl_NewStringObj(names[i], -1));
	}
	if (numNames > 0) {
	    Tcl_Free((void *)names);
	}
    } else {
	FOREACH_HASH_DECLS;

	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
	    if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
		Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
	    }
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassMethodTypeCmd --
 *
 *	Implements [info class methodtype $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMethodTypeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_HashEntry *hPtr;
    Method *mPtr;
    Class *clsPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    hPtr = Tcl_FindHashEntry(&clsPtr->classMethods, (char *) objv[2]);
    if (hPtr == NULL) {
    unknownMethod:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown method \"%s\"", TclGetString(objv[2])));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
		TclGetString(objv[2]), NULL);
	return TCL_ERROR;
    }
    mPtr = (Method *)Tcl_GetHashValue(hPtr);
    if (mPtr->typePtr == NULL) {
	/*
	 * Special entry for visibility control: pretend the method doesnt
	 * exist.
	 */

	goto unknownMethod;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(mPtr->typePtr->name, -1));
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassMixinsCmd --
 *
 *	Implements [info class mixins $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassMixinsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *mixinPtr;
    Tcl_Obj *resultObj;
    int i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(mixinPtr, clsPtr->mixins) {
	if (!mixinPtr) {
	    continue;
	}
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, mixinPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassSubsCmd --
 *
 *	Implements [info class subclasses $clsName ?$pattern?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassSubsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *subclassPtr;
    Tcl_Obj *resultObj;
    int i;
    const char *pattern = NULL;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?pattern?");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }
    if (objc == 3) {
	pattern = TclGetString(objv[2]);
    }

    TclNewObj(resultObj);
    FOREACH(subclassPtr, clsPtr->subclasses) {
	Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);

	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
	    continue;
	}
	Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
    }
    FOREACH(subclassPtr, clsPtr->mixinSubs) {
	Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr);

	if (pattern && !Tcl_StringMatch(TclGetString(tmpObj), pattern)) {
	    continue;
	}
	Tcl_ListObjAppendElement(NULL, resultObj, tmpObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassSupersCmd --
 *
 *	Implements [info class superclasses $clsName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassSupersCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr, *superPtr;
    Tcl_Obj *resultObj;
    int i;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    FOREACH(superPtr, clsPtr->superclasses) {
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, superPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassVariablesCmd --
 *
 *	Implements [info class variables $clsName ?-private?]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassVariablesCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    Tcl_Obj *resultObj;
    int i, isPrivate = 0;

    if (objc != 2 && objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	if (strcmp("-private", TclGetString(objv[2])) != 0) {
	    return TCL_ERROR;
	}
	isPrivate = 1;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    if (isPrivate) {
	PrivateVariableMapping *privatePtr;

	FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
	}
    } else {
	Tcl_Obj *variableObj;

	FOREACH(variableObj, clsPtr->variables) {
	    Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
	}
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoObjectCallCmd --
 *
 *	Implements [info object call $objName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoObjectCallCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Object *oPtr;
    CallContext *contextPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "objName methodName");
	return TCL_ERROR;
    }
    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Get the call context and render its call chain.
     */

    contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
	    NULL);
    if (contextPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp,
	    TclOORenderCallChain(interp, contextPtr->callPtr));
    TclOODeleteContext(contextPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * InfoClassCallCmd --
 *
 *	Implements [info class call $clsName $methodName]
 *
 * ----------------------------------------------------------------------
 */

static int
InfoClassCallCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Class *clsPtr;
    CallChain *callPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "className methodName");
	return TCL_ERROR;
    }
    clsPtr = GetClassFromObj(interp, objv[1]);
    if (clsPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Get an render the stereotypical call chain.
     */

    callPtr = TclOOGetStereotypeCallChain(clsPtr, objv[2], PUBLIC_METHOD);
    if (callPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"cannot construct any call chain", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclOORenderCallChain(interp, callPtr));
    TclOODeleteChain(callPtr);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOOInt.h.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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








































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOOInt.h --
 *
 *	This file contains the structure definitions and some of the function
 *	declarations for the object-system (NB: not Tcl_Obj, but ::oo).
 *
 * Copyright (c) 2006-2012 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef TCL_OO_INTERNAL_H
#define TCL_OO_INTERNAL_H 1

#include "tclInt.h"
#include "tclOO.h"

/*
 * Hack to make things work with Objective C. Note that ObjC isn't really
 * supported, but we don't want to to be actively hostile to it. [Bug 2163447]
 */

#ifdef __OBJC__
#define Class	TclOOClass
#define Object	TclOOObject
#endif /* __OBJC__ */

/*
 * Forward declarations.
 */

struct CallChain;
struct Class;
struct Foundation;
struct Object;

/*
 * The data that needs to be stored per method. This record is used to collect
 * information about all sorts of methods, including forwards, constructors
 * and destructors.
 */

typedef struct Method {
    const Tcl_MethodType *typePtr;
				/* The type of method. If NULL, this is a
				 * special flag record which is just used for
				 * the setting of the flags field. */
    size_t refCount;
    void *clientData;	/* Type-specific data. */
    Tcl_Obj *namePtr;		/* Name of the method. */
    struct Object *declaringObjectPtr;
				/* The object that declares this method, or
				 * NULL if it was declared by a class. */
    struct Class *declaringClassPtr;
				/* The class that declares this method, or
				 * NULL if it was declared directly on an
				 * object. */
    int flags;			/* Assorted flags. Includes whether this
				 * method is public/exported or not. */
} Method;

/*
 * Pre- and post-call callbacks, to allow procedure-like methods to be fine
 * tuned in their behaviour.
 */

typedef int (TclOO_PreCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_CallFrame *framePtr, int *isFinished);
typedef int (TclOO_PostCallProc)(void *clientData, Tcl_Interp *interp,
	Tcl_ObjectContext context, Tcl_Namespace *namespacePtr, int result);
typedef void (TclOO_PmCDDeleteProc)(void *clientData);
typedef void *(TclOO_PmCDCloneProc)(void *clientData);

/*
 * Procedure-like methods have the following extra information.
 */

typedef struct ProcedureMethod {
    int version;		/* Version of this structure. Currently must
				 * be 0. */
    Proc *procPtr;		/* Core of the implementation of the method;
				 * includes the argument definition and the
				 * body bytecodes. */
    int flags;			/* Flags to control features. */
    size_t refCount;
    void *clientData;
    TclOO_PmCDDeleteProc *deleteClientdataProc;
    TclOO_PmCDCloneProc *cloneClientdataProc;
    ProcErrorProc *errProc;	/* Replacement error handler. */
    TclOO_PreCallProc *preCallProc;
				/* Callback to allow for additional setup
				 * before the method executes. */
    TclOO_PostCallProc *postCallProc;
				/* Callback to allow for additional cleanup
				 * after the method executes. */
    GetFrameInfoValueProc *gfivProc;
				/* Callback to allow for fine tuning of how
				 * the method reports itself. */
} ProcedureMethod;

#define TCLOO_PROCEDURE_METHOD_VERSION 0

/*
 * Flags for use in a ProcedureMethod.
 *
 * When the USE_DECLARER_NS flag is set, the method will use the namespace of
 * the object or class that declared it (or the clone of it, if it was from
 * such that the implementation of the method came to the particular use)
 * instead of the namespace of the object on which the method was invoked.
 * This flag must be distinct from all others that are associated with
 * methods.
 */

#define USE_DECLARER_NS		0x80

/*
 * Forwarded methods have the following extra information.
 */

typedef struct ForwardMethod {
    Tcl_Obj *prefixObj;		/* The list of values to use to replace the
				 * object and method name with. Will be a
				 * non-empty list. */
} ForwardMethod;

/*
 * Structure used in private variable mappings. Describes the mapping of a
 * single variable from the user's local name to the system's storage name.
 * [TIP #500]
 */

typedef struct {
    Tcl_Obj *variableObj;	/* Name used within methods. This is the part
				 * that is properly under user control. */
    Tcl_Obj *fullNameObj;	/* Name used at the instance namespace level. */
} PrivateVariableMapping;

/*
 * Helper definitions that declare a "list" array. The two varieties are
 * either optimized for simplicity (in the case that the whole array is
 * typically assigned at once) or efficiency (in the case that the array is
 * expected to be expanded over time). These lists are designed to be iterated
 * over with the help of the FOREACH macro (see later in this file).
 *
 * The "num" field always counts the number of listType_t elements used in the
 * "list" field. When a "size" field exists, it describes how many elements
 * are present in the list; when absent, exactly "num" elements are present.
 */

#define LIST_STATIC(listType_t) \
    struct { int num; listType_t *list; }
#define LIST_DYNAMIC(listType_t) \
    struct { int num, size; listType_t *list; }

/*
 * These types are needed in function arguments.
 */

typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;

/*
 * Now, the definition of what an object actually is.
 */

typedef struct Object {
    struct Foundation *fPtr;	/* The basis for the object system. Putting
				 * this here allows the avoidance of quite a
				 * lot of hash lookups on the critical path
				 * for object invocation and creation. */
    Tcl_Namespace *namespacePtr;/* This object's namespace. */
    Tcl_Command command;	/* Reference to this object's public
				 * command. */
    Tcl_Command myCommand;	/* Reference to this object's internal
				 * command. */
    struct Class *selfCls;	/* This object's class. */
    Tcl_HashTable *methodsPtr;	/* Object-local Tcl_Obj (method name) to
				 * Method* mapping. */
    LIST_STATIC(struct Class *) mixins;
				/* Classes mixed into this object. */
    LIST_STATIC(Tcl_Obj *) filters;
				/* List of filter names. */
    struct Class *classPtr;	/* This is non-NULL for all classes, and NULL
				 *  for everything else. It points to the class
				 *  structure. */
    size_t refCount;		/* Number of strong references to this object.
				 * Note that there may be many more weak
				 * references; this mechanism exists to
				 * avoid Tcl_Preserve. */
    int flags;
    size_t creationEpoch;		/* Unique value to make comparisons of objects
				 * easier. */
    size_t epoch;			/* Per-object epoch, incremented when the way
				 * an object should resolve call chains is
				 * changed. */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the void *values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    Tcl_Obj *cachedNameObj;	/* Cache of the name of the object. */
    Tcl_HashTable *chainCache;	/* Place to keep unused contexts. This table
				 * is indexed by method name as Tcl_Obj. */
    Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
				/* Function to allow remapping of method
				 * names. For itcl-ng. */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
    Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
				 * command. */
} Object;

#define OBJECT_DESTRUCTING	1	/* Indicates that an object is being or has
								 *  been destroyed  */
#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor script for the
							   object has began */
#define OO_UNUSED_4	4	/* No longer used.  */
#define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
				 * the class hierarchy and should be treated
				 * specially during teardown. */
#define FILTER_HANDLING 0x2000	/* Flag set when the object is processing a
				 * filter; when set, filters are *not*
				 * processed on the object, preventing nasty
				 * recursive filtering problems. */
#define USE_CLASS_CACHE 0x4000	/* Flag set to say that the object is a pure
				 * 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. */
#define HAS_PRIVATE_METHODS 0x20000
				/* Object/class has (or had) private methods,
				 * and so shouldn't be cached so
				 * aggressively. */
#define DONT_DELETE 0x40000	/* Inhibit deletion of this object. Used
				 * during fundamental object type mutation to
				 * make sure that the object actually survives
				 * to the end of the operation. */

/*
 * And the definition of a class. Note that every class also has an associated
 * object, through which it is manipulated.
 */

typedef struct Class {
    Object *thisPtr;		/* Reference to the object associated with
				 * this class. */
    int flags;			/* Assorted flags. */
    LIST_STATIC(struct Class *) superclasses;
				/* List of superclasses, used for generation
				 * of method call chains. */
    LIST_DYNAMIC(struct Class *) subclasses;
				/* List of subclasses, used to ensure deletion
				 * of dependent entities happens properly when
				 * the class itself is deleted. */
    LIST_DYNAMIC(Object *) instances;
				/* List of instances, used to ensure deletion
				 * of dependent entities happens properly when
				 * the class itself is deleted. */
    LIST_STATIC(Tcl_Obj *) filters;
				/* List of filter names, used for generation
				 * of method call chains. */
    LIST_STATIC(struct Class *) mixins;
				/* List of mixin classes, used for generation
				 * of method call chains. */
    LIST_DYNAMIC(struct Class *) mixinSubs;
				/* List of classes that this class is mixed
				 * into, used to ensure deletion of dependent
				 * entities happens properly when the class
				 * itself is deleted. */
    Tcl_HashTable classMethods;	/* Hash table of all methods. Hash maps from
				 * the (Tcl_Obj*) method name to the (Method*)
				 * method record. */
    Method *constructorPtr;	/* Method record of the class constructor (if
				 * any). */
    Method *destructorPtr;	/* Method record of the class destructor (if
				 * any). */
    Tcl_HashTable *metadataPtr;	/* Mapping from pointers to metadata type to
				 * the void *values that are the values
				 * of each piece of attached metadata. This
				 * field starts out as NULL and is only
				 * allocated if metadata is attached. */
    struct CallChain *constructorChainPtr;
    struct CallChain *destructorChainPtr;
    Tcl_HashTable *classChainCache;
				/* Places where call chains are stored. For
				 * constructors, the class chain is always
				 * used. For destructors and ordinary methods,
				 * the class chain is only used when the
				 * object doesn't override with its own mixins
				 * (and filters and method implementations for
				 * when getting method chains). */
    VariableNameList variables;
    PrivateVariableList privateVariables;
				/* Configurations for the variable resolver
				 * used inside methods. */
    Tcl_Obj *clsDefinitionNs;	/* Name of the namespace to use for
				 * definitions commands of instances of this
				 * class in when those instances are defined
				 * as classes. If NULL, use the value from the
				 * class hierarchy. It's an error at
				 * [oo::define] call time if this namespace is
				 * defined but doesn't exist; we also check at
				 * setting time but don't check between
				 * times. */
    Tcl_Obj *objDefinitionNs;	/* Name of the namespace to use for
				 * definitions commands of instances of this
				 * class in when those instances are defined
				 * as instances. If NULL, use the value from
				 * the class hierarchy. It's an error at
				 * [oo::objdefine]/[self] call time if this
				 * namespace is defined but doesn't exist; we
				 * also check at setting time but don't check
				 * between times. */
} Class;

/*
 * The foundation of the object system within an interpreter contains
 * references to the key classes and namespaces, together with a few other
 * useful bits and pieces. Probably ought to eventually go in the Interp
 * structure itself.
 */

typedef struct ThreadLocalData {
    size_t nsCount;		/* Epoch counter is used for keeping
				 * the values used in Tcl_Obj internal
				 * representations sane. Must be thread-local
				 * because Tcl_Objs can cross interpreter
				 * boundaries within a thread (objects don't
				 * generally cross threads). */
} ThreadLocalData;

typedef struct Foundation {
    Tcl_Interp *interp;
    Class *objectCls;		/* The root of the object system. */
    Class *classCls;		/* The class of all classes. */
    Tcl_Namespace *ooNs;	/* ::oo namespace. */
    Tcl_Namespace *defineNs;	/* Namespace containing special commands for
				 * manipulating objects and classes. The
				 * "oo::define" command acts as a special kind
				 * of ensemble for this namespace. */
    Tcl_Namespace *objdefNs;	/* Namespace containing special commands for
				 * manipulating objects and classes. The
				 * "oo::objdefine" command acts as a special
				 * kind of ensemble for this namespace. */
    Tcl_Namespace *helpersNs;	/* Namespace containing the commands that are
				 * only valid when executing inside a
				 * procedural method. */
    size_t epoch;			/* Used to invalidate method chains when the
				 * class structure changes. */
    ThreadLocalData *tsdPtr;	/* Counter so we can allocate a unique
				 * namespace to each object. */
    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. */
    Tcl_Obj *defineName;	/* Fully qualified name of oo::define. */
} Foundation;

/*
 * A call context structure is built when a method is called. It contains 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.
 */

#define CALL_CHAIN_STATIC_SIZE 4

struct MInvoke {
    Method *mPtr;		/* Reference to the method implementation
				 * record. */
    int isFilter;		/* Whether this is a filter invocation. */
    Class *filterDeclarer;	/* What class decided to add the filter; if
				 * NULL, it was added by the object. */
};

typedef struct CallChain {
    size_t objectCreationEpoch;	/* The object's creation epoch. Note that the
				 * object reference is not stored in the call
				 * chain; it is in the call context. */
    size_t objectEpoch;		/* Local (object structure) epoch counter
				 * snapshot. */
    size_t epoch;			/* Global (class structure) epoch counter
				 * snapshot. */
    int flags;			/* Assorted flags, see below. */
    size_t refCount;		/* Reference count. */
    int numChain;		/* Size of the call chain. */
    struct MInvoke *chain;	/* Array of call chain entries. May point to
				 * staticChain if the number of entries is
				 * small. */
    struct MInvoke staticChain[CALL_CHAIN_STATIC_SIZE];
} CallChain;

typedef struct CallContext {
    Object *oPtr;		/* The object associated with this call. */
    int index;			/* Index into the call chain of the currently
				 * executing method implementation. */
    int skip;			/* Current number of arguments to skip; can
				 * vary depending on whether it is a direct
				 * method call or a continuation via the
				 * [next] command. */
    CallChain *callPtr;		/* The actual call chain. */
} CallContext;

/*
 * Bits for the 'flags' field of the call chain.
 */

#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
				 * only) method. Supports itcl. */
#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
#define CONSTRUCTOR	  0x08	/* This is a constructor. */
#define DESTRUCTOR	  0x10	/* This is a destructor. */
#define TRUE_PRIVATE_METHOD 0x20
				/* This is a private method only accessible
				 * from other methods defined on this class
				 * or instance. [TIP #500] */
#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)

/*
 * 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. */
    Tcl_MethodType definition;	/* How to call the method. */
} DeclaredClassMethod;

/*
 *----------------------------------------------------------------
 * Commands relating to OO support.
 *----------------------------------------------------------------
 */

MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE int	TclOODefineObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOObjDefObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineConstructorObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDeleteMethodObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDestructorObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineExportObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineForwardObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineMethodObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineUnexportObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextToObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineUnexportObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefinePrivateObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDefnNsObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOONextToObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOSelfObjCmd(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);

/*
 * Method implementations (in tclOOBasic.c).
 */

MODULE_SCOPE int	TclOO_Class_Constructor(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_Create(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_CreateNs(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Class_New(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Destroy(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Eval(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_LinkVar(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_Unknown(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOO_Object_VarName(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Private definitions, some of which perhaps ought to be exposed properly or
 * maybe just put in the internal stubs table.
 */

MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE Class *	TclOOAllocClass(Tcl_Interp *interp,
			    Object *useThisObj);
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 Object *	TclNewObjectInstanceCommon(Tcl_Interp *interp,
			    Class *classPtr,
			    const char *nameStr,
			    const char *nsNameStr);
MODULE_SCOPE int	TclOODecrRefCount(Object *oPtr);
MODULE_SCOPE int	TclOOObjectDestroyed(Object *oPtr);
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	TclOODeleteDescendants(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Object *contextObjPtr, Class *contextClsPtr,
			    Tcl_Obj *cacheInThisObj);
MODULE_SCOPE Tcl_Namespace *TclOOGetDefineContextNamespace(
			    Tcl_Interp *interp, Object *oPtr, int forClass);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
			    Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj *	TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,
			    int flags, const char ***stringsPtr);
MODULE_SCOPE int	TclOOGetSortedMethodList(Object *oPtr,
			    Object *contextObj, Class *contextCls, int flags,
			    const char ***stringsPtr);
MODULE_SCOPE int	TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void	TclOOInitInfo(Tcl_Interp *interp);
MODULE_SCOPE int	TclOOInvokeContext(void *clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
			    Tcl_ObjectContext context, int objc,
			    Tcl_Obj *const *objv, int skip);
MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
			    const DeclaredClassMethod *dcm);
MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
MODULE_SCOPE void	TclOOReleaseClassContents(Tcl_Interp *interp,
			    Object *oPtr);
MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
MODULE_SCOPE int	TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
MODULE_SCOPE int	TclOORemoveFromMixinSubs(Class *subPtr,
			    Class *mixinPtr);
MODULE_SCOPE int	TclOORemoveFromSubclasses(Class *subPtr,
			    Class *superPtr);
MODULE_SCOPE Tcl_Obj *	TclOORenderCallChain(Tcl_Interp *interp,
			    CallChain *callPtr);
MODULE_SCOPE void	TclOOStashContext(Tcl_Obj *objPtr,
			    CallContext *contextPtr);
MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);

/*
 * Include all the private API, generated from tclOO.decls.
 */

#include "tclOOIntDecls.h"

/*
 * Alternatives to Tcl_Preserve/Tcl_EventuallyFree/Tcl_Release.
 */

#define AddRef(ptr) ((ptr)->refCount++)

/*
 * A convenience macro for iterating through the lists used in the internal
 * memory management of objects.
 * REQUIRES DECLARATION: int i;
 */

#define FOREACH(var,ary) \
    for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
	continue; \
    } else if (var = (ary).list[i], 1)

/*
 * A variation where the array is an array of structs. There's no issue with
 * possible NULLs; every element of the array will be iterated over and the
 * varable set to a pointer to each of those elements in turn.
 * REQUIRES DECLARATION: int i;
 */

#define FOREACH_STRUCT(var,ary) \
    for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)

/*
 * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
 * sets up the declarations needed for the main macro, FOREACH_HASH, which
 * does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
 * only iterates over values.
 * REQUIRES DECLARATION: FOREACH_HASH_DECLS;
 */

#define FOREACH_HASH_DECLS \
    Tcl_HashEntry *hPtr;Tcl_HashSearch search
#define FOREACH_HASH(key,val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    (*(void **)&(key)=Tcl_GetHashKey((tablePtr),hPtr),\
	    *(void **)&(val)=Tcl_GetHashValue(hPtr),1):0; hPtr=Tcl_NextHashEntry(&search))
#define FOREACH_HASH_VALUE(val,tablePtr) \
    for(hPtr=Tcl_FirstHashEntry((tablePtr),&search); hPtr!=NULL ? \
	    (*(void **)&(val)=Tcl_GetHashValue(hPtr),1):0;hPtr=Tcl_NextHashEntry(&search))

/*
 * Convenience macro for duplicating a list. Needs no external declaration,
 * but all arguments are used multiple times and so must have no side effects.
 */

#undef DUPLICATE /* prevent possible conflict with definition in WINAPI nb30.h */
#define DUPLICATE(target,source,type) \
    do { \
	size_t len = sizeof(type) * ((target).num=(source).num);\
	if (len != 0) { \
	    memcpy(((target).list=(type*)Tcl_Alloc(len)), (source).list, len); \
	} else { \
	    (target).list = NULL; \
	} \
    } while(0)

#endif /* TCL_OO_INTERNAL_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOOIntDecls.h.

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






































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * This file is (mostly) automatically generated from tclOO.decls.
 */

#ifndef _TCLOOINTDECLS
#define _TCLOOINTDECLS

/* !BEGIN!: Do not edit below this line. */

#ifdef __cplusplus
extern "C" {
#endif

/*
 * Exported function declarations:
 */

/* 0 */
TCLAPI Tcl_Object	TclOOGetDefineCmdContext(Tcl_Interp *interp);
/* 1 */
TCLAPI Tcl_Method	TclOOMakeProcInstanceMethod(Tcl_Interp *interp,
				Object *oPtr, int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				const Tcl_MethodType *typePtr,
				void *clientData, Proc **procPtrPtr);
/* 2 */
TCLAPI Tcl_Method	TclOOMakeProcMethod(Tcl_Interp *interp,
				Class *clsPtr, int flags, Tcl_Obj *nameObj,
				const char *namePtr, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj,
				const Tcl_MethodType *typePtr,
				void *clientData, Proc **procPtrPtr);
/* 3 */
TCLAPI Method *		TclOONewProcInstanceMethod(Tcl_Interp *interp,
				Object *oPtr, int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				ProcedureMethod **pmPtrPtr);
/* 4 */
TCLAPI Method *		TclOONewProcMethod(Tcl_Interp *interp, Class *clsPtr,
				int flags, Tcl_Obj *nameObj,
				Tcl_Obj *argsObj, Tcl_Obj *bodyObj,
				ProcedureMethod **pmPtrPtr);
/* 5 */
TCLAPI int		TclOOObjectCmdCore(Object *oPtr, Tcl_Interp *interp,
				int objc, Tcl_Obj *const *objv,
				int publicOnly, Class *startCls);
/* 6 */
TCLAPI int		TclOOIsReachable(Class *targetPtr, Class *startPtr);
/* 7 */
TCLAPI Method *		TclOONewForwardMethod(Tcl_Interp *interp,
				Class *clsPtr, int isPublic,
				Tcl_Obj *nameObj, Tcl_Obj *prefixObj);
/* 8 */
TCLAPI Method *		TclOONewForwardInstanceMethod(Tcl_Interp *interp,
				Object *oPtr, int isPublic, Tcl_Obj *nameObj,
				Tcl_Obj *prefixObj);
/* 9 */
TCLAPI Tcl_Method	TclOONewProcInstanceMethodEx(Tcl_Interp *interp,
				Tcl_Object oPtr,
				TclOO_PreCallProc *preCallPtr,
				TclOO_PostCallProc *postCallPtr,
				ProcErrorProc *errProc, void *clientData,
				Tcl_Obj *nameObj, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj, int flags,
				void **internalTokenPtr);
/* 10 */
TCLAPI Tcl_Method	TclOONewProcMethodEx(Tcl_Interp *interp,
				Tcl_Class clsPtr,
				TclOO_PreCallProc *preCallPtr,
				TclOO_PostCallProc *postCallPtr,
				ProcErrorProc *errProc, void *clientData,
				Tcl_Obj *nameObj, Tcl_Obj *argsObj,
				Tcl_Obj *bodyObj, int flags,
				void **internalTokenPtr);
/* 11 */
TCLAPI int		TclOOInvokeObject(Tcl_Interp *interp,
				Tcl_Object object, Tcl_Class startCls,
				int publicPrivate, int objc,
				Tcl_Obj *const *objv);
/* 12 */
TCLAPI void		TclOOObjectSetFilters(Object *oPtr, int numFilters,
				Tcl_Obj *const *filters);
/* 13 */
TCLAPI void		TclOOClassSetFilters(Tcl_Interp *interp,
				Class *classPtr, int numFilters,
				Tcl_Obj *const *filters);
/* 14 */
TCLAPI void		TclOOObjectSetMixins(Object *oPtr, int numMixins,
				Class *const *mixins);
/* 15 */
TCLAPI void		TclOOClassSetMixins(Tcl_Interp *interp,
				Class *classPtr, int numMixins,
				Class *const *mixins);

typedef struct TclOOIntStubs {
    int magic;
    void *hooks;

    Tcl_Object (*tclOOGetDefineCmdContext) (Tcl_Interp *interp); /* 0 */
    Tcl_Method (*tclOOMakeProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 1 */
    Tcl_Method (*tclOOMakeProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, const char *namePtr, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, const Tcl_MethodType *typePtr, void *clientData, Proc **procPtrPtr); /* 2 */
    Method * (*tclOONewProcInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 3 */
    Method * (*tclOONewProcMethod) (Tcl_Interp *interp, Class *clsPtr, int flags, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, ProcedureMethod **pmPtrPtr); /* 4 */
    int (*tclOOObjectCmdCore) (Object *oPtr, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv, int publicOnly, Class *startCls); /* 5 */
    int (*tclOOIsReachable) (Class *targetPtr, Class *startPtr); /* 6 */
    Method * (*tclOONewForwardMethod) (Tcl_Interp *interp, Class *clsPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 7 */
    Method * (*tclOONewForwardInstanceMethod) (Tcl_Interp *interp, Object *oPtr, int isPublic, Tcl_Obj *nameObj, Tcl_Obj *prefixObj); /* 8 */
    Tcl_Method (*tclOONewProcInstanceMethodEx) (Tcl_Interp *interp, Tcl_Object oPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 9 */
    Tcl_Method (*tclOONewProcMethodEx) (Tcl_Interp *interp, Tcl_Class clsPtr, TclOO_PreCallProc *preCallPtr, TclOO_PostCallProc *postCallPtr, ProcErrorProc *errProc, void *clientData, Tcl_Obj *nameObj, Tcl_Obj *argsObj, Tcl_Obj *bodyObj, int flags, void **internalTokenPtr); /* 10 */
    int (*tclOOInvokeObject) (Tcl_Interp *interp, Tcl_Object object, Tcl_Class startCls, int publicPrivate, int objc, Tcl_Obj *const *objv); /* 11 */
    void (*tclOOObjectSetFilters) (Object *oPtr, int numFilters, Tcl_Obj *const *filters); /* 12 */
    void (*tclOOClassSetFilters) (Tcl_Interp *interp, Class *classPtr, int numFilters, Tcl_Obj *const *filters); /* 13 */
    void (*tclOOObjectSetMixins) (Object *oPtr, int numMixins, Class *const *mixins); /* 14 */
    void (*tclOOClassSetMixins) (Tcl_Interp *interp, Class *classPtr, int numMixins, Class *const *mixins); /* 15 */
} TclOOIntStubs;

extern const TclOOIntStubs *tclOOIntStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCLOO_STUBS)

/*
 * Inline function declarations:
 */

#define TclOOGetDefineCmdContext \
	(tclOOIntStubsPtr->tclOOGetDefineCmdContext) /* 0 */
#define TclOOMakeProcInstanceMethod \
	(tclOOIntStubsPtr->tclOOMakeProcInstanceMethod) /* 1 */
#define TclOOMakeProcMethod \
	(tclOOIntStubsPtr->tclOOMakeProcMethod) /* 2 */
#define TclOONewProcInstanceMethod \
	(tclOOIntStubsPtr->tclOONewProcInstanceMethod) /* 3 */
#define TclOONewProcMethod \
	(tclOOIntStubsPtr->tclOONewProcMethod) /* 4 */
#define TclOOObjectCmdCore \
	(tclOOIntStubsPtr->tclOOObjectCmdCore) /* 5 */
#define TclOOIsReachable \
	(tclOOIntStubsPtr->tclOOIsReachable) /* 6 */
#define TclOONewForwardMethod \
	(tclOOIntStubsPtr->tclOONewForwardMethod) /* 7 */
#define TclOONewForwardInstanceMethod \
	(tclOOIntStubsPtr->tclOONewForwardInstanceMethod) /* 8 */
#define TclOONewProcInstanceMethodEx \
	(tclOOIntStubsPtr->tclOONewProcInstanceMethodEx) /* 9 */
#define TclOONewProcMethodEx \
	(tclOOIntStubsPtr->tclOONewProcMethodEx) /* 10 */
#define TclOOInvokeObject \
	(tclOOIntStubsPtr->tclOOInvokeObject) /* 11 */
#define TclOOObjectSetFilters \
	(tclOOIntStubsPtr->tclOOObjectSetFilters) /* 12 */
#define TclOOClassSetFilters \
	(tclOOIntStubsPtr->tclOOClassSetFilters) /* 13 */
#define TclOOObjectSetMixins \
	(tclOOIntStubsPtr->tclOOObjectSetMixins) /* 14 */
#define TclOOClassSetMixins \
	(tclOOIntStubsPtr->tclOOClassSetMixins) /* 15 */

#endif /* defined(USE_TCLOO_STUBS) */

/* !END!: Do not edit above this line. */

#endif /* _TCLOOINTDECLS */

Deleted generic/tclOOMethod.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOOMethod.c --
 *
 *	This file contains code to create and manage methods.
 *
 * Copyright (c) 2005-2011 by Donal K. Fellows
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"

/*
 * Structure used to help delay computing names of objects or classes for
 * [info frame] until needed, making invokation faster in the normal case.
 */

struct PNI {
    Tcl_Interp *interp;		/* Interpreter in which to compute the name of
				 * a method. */
    Tcl_Method method;		/* Method to compute the name of. */
};

/*
 * Structure used to contain all the information needed about a call frame
 * used in a procedure-like method.
 */

typedef struct {
    CallFrame *framePtr;	/* Reference to the call frame itself (it's
				 * actually allocated on the Tcl stack). */
    ProcErrorProc *errProc;	/* The error handler for the body. */
    Tcl_Obj *nameObj;		/* The "name" of the command. */
    Command cmd;		/* The command structure. Mostly bogus. */
    ExtraFrameInfo efi;		/* Extra information used for [info frame]. */
    Command *oldCmdPtr;		/* Saved cmdPtr so that we can be safe after a
				 * recursive call returns. */
    struct PNI pni;		/* Specialist information used in the efi
				 * field for this type of call. */
} PMFrameData;

/*
 * Structure used to pass information about variable resolution to the
 * on-the-ground resolvers used when working with resolved compiled variables.
 */

typedef struct {
    Tcl_ResolvedVarInfo info;	/* "Type" information so that the compiled
				 * variable can be linked to the namespace
				 * variable at the right time. */
    Tcl_Obj *variableObj;	/* The name of the variable. */
    Tcl_Var cachedObjectVar;	/* TODO: When to flush this cache? Can class
				 * variables be cached? */
} OOResVarInfo;

/*
 * Function declarations for things defined in this file.
 */

static Tcl_Obj **	InitEnsembleRewrite(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv, int toRewrite,
			    int rewriteLength, Tcl_Obj *const *rewriteObjs,
			    int *lengthPtr);
static int		InvokeProcedureMethod(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static Tcl_NRPostProc	FinalizeForwardCall;
static Tcl_NRPostProc	FinalizePMCall;
static int		PushMethodCallFrame(Tcl_Interp *interp,
			    CallContext *contextPtr, ProcedureMethod *pmPtr,
			    int objc, Tcl_Obj *const *objv,
			    PMFrameData *fdPtr);
static void		DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
static void		DeleteProcedureMethod(void *clientData);
static int		CloneProcedureMethod(Tcl_Interp *interp,
			    void *clientData, void **newClientData);
static ProcErrorProc	MethodErrorHandler;
static ProcErrorProc	ConstructorErrorHandler;
static ProcErrorProc	DestructorErrorHandler;
static Tcl_Obj *	RenderDeclarerName(void *clientData);
static int		InvokeForwardMethod(void *clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static void		DeleteForwardMethod(void *clientData);
static int		CloneForwardMethod(Tcl_Interp *interp,
			    void *clientData, void **newClientData);
static Tcl_ResolveVarProc	ProcedureMethodVarResolver;
static Tcl_ResolveCompiledVarProc	ProcedureMethodCompiledVarResolver;

/*
 * The types of methods defined by the core OO system.
 */

static const Tcl_MethodType procMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT, "method",
    InvokeProcedureMethod, DeleteProcedureMethod, CloneProcedureMethod
};
static const Tcl_MethodType fwdMethodType = {
    TCL_OO_METHOD_VERSION_CURRENT, "forward",
    InvokeForwardMethod, DeleteForwardMethod, CloneForwardMethod
};

/*
 * Helper macros (derived from things private to tclVar.c)
 */

#define TclVarTable(contextNs) \
    ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable))
#define TclVarHashGetValue(hPtr) \
    ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry)))

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewInstanceMethod --
 *
 *	Attach a method to an object instance.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
Tcl_NewInstanceMethod(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Object object,		/* The object that has the method attached to
				 * it. */
    Tcl_Obj *nameObj,		/* The name of the method. May be NULL; if so,
				 * up to caller to manage storage (e.g., when
				 * it is a constructor or destructor). */
    int flags,			/* Whether this is a public method. */
    const Tcl_MethodType *typePtr,
				/* The type of method this is, which defines
				 * how to invoke, delete and clone the
				 * method. */
    void *clientData)		/* Some data associated with the particular
				 * method to be created. */
{
    Object *oPtr = (Object *) object;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = (Method *)Tcl_Alloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    if (!oPtr->methodsPtr) {
	oPtr->methodsPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_InitObjHashTable(oPtr->methodsPtr);
	oPtr->flags &= ~USE_CLASS_CACHE;
    }
    hPtr = Tcl_CreateHashEntry(oPtr->methodsPtr, (char *) nameObj, &isNew);
    if (isNew) {
	mPtr = (Method *)Tcl_Alloc(sizeof(Method));
	mPtr->namePtr = nameObj;
	mPtr->refCount = 1;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = (Method *)Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
    }

  populate:
    mPtr->typePtr = typePtr;
    mPtr->clientData = clientData;
    mPtr->flags = 0;
    mPtr->declaringObjectPtr = oPtr;
    mPtr->declaringClassPtr = NULL;
    if (flags) {
	mPtr->flags |= flags &
		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
	if (flags & TRUE_PRIVATE_METHOD) {
	    oPtr->flags |= HAS_PRIVATE_METHODS;
	}
    }
    oPtr->epoch++;
    return (Tcl_Method) mPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_NewMethod --
 *
 *	Attach a method to a class.
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
Tcl_NewMethod(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Class cls,		/* The class to attach the method to. */
    Tcl_Obj *nameObj,		/* The name of the object. May be NULL (e.g.,
				 * for constructors or destructors); if so, up
				 * to caller to manage storage. */
    int flags,			/* Whether this is a public method. */
    const Tcl_MethodType *typePtr,
				/* The type of method this is, which defines
				 * how to invoke, delete and clone the
				 * method. */
    void *clientData)		/* Some data associated with the particular
				 * method to be created. */
{
    Class *clsPtr = (Class *) cls;
    Method *mPtr;
    Tcl_HashEntry *hPtr;
    int isNew;

    if (nameObj == NULL) {
	mPtr = (Method *)Tcl_Alloc(sizeof(Method));
	mPtr->namePtr = NULL;
	mPtr->refCount = 1;
	goto populate;
    }
    hPtr = Tcl_CreateHashEntry(&clsPtr->classMethods, (char *)nameObj,&isNew);
    if (isNew) {
	mPtr = (Method *)Tcl_Alloc(sizeof(Method));
	mPtr->refCount = 1;
	mPtr->namePtr = nameObj;
	Tcl_IncrRefCount(nameObj);
	Tcl_SetHashValue(hPtr, mPtr);
    } else {
	mPtr = (Method *)Tcl_GetHashValue(hPtr);
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
    }

  populate:
    clsPtr->thisPtr->fPtr->epoch++;
    mPtr->typePtr = typePtr;
    mPtr->clientData = clientData;
    mPtr->flags = 0;
    mPtr->declaringObjectPtr = NULL;
    mPtr->declaringClassPtr = clsPtr;
    if (flags) {
	mPtr->flags |= flags &
		(PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
	if (flags & TRUE_PRIVATE_METHOD) {
	    clsPtr->flags |= HAS_PRIVATE_METHODS;
	}
    }

    return (Tcl_Method) mPtr;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODelMethodRef --
 *
 *	How to delete a method.
 *
 * ----------------------------------------------------------------------
 */

void
TclOODelMethodRef(
    Method *mPtr)
{
    if ((mPtr != NULL) && (mPtr->refCount-- <= 1)) {
	if (mPtr->typePtr != NULL && mPtr->typePtr->deleteProc != NULL) {
	    mPtr->typePtr->deleteProc(mPtr->clientData);
	}
	if (mPtr->namePtr != NULL) {
	    Tcl_DecrRefCount(mPtr->namePtr);
	}

	Tcl_Free(mPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewBasicMethod --
 *
 *	Helper that makes it cleaner to create very simple methods during
 *	basic system initialization. Not suitable for general use.
 *
 * ----------------------------------------------------------------------
 */

void
TclOONewBasicMethod(
    Tcl_Interp *interp,
    Class *clsPtr,		/* Class to attach the method to. */
    const DeclaredClassMethod *dcm)
				/* Name of the method, whether it is public,
				 * and the function to implement it. */
{
    Tcl_Obj *namePtr = Tcl_NewStringObj(dcm->name, -1);

    Tcl_IncrRefCount(namePtr);
    Tcl_NewMethod(interp, (Tcl_Class) clsPtr, namePtr,
	    (dcm->isPublic ? PUBLIC_METHOD : 0), &dcm->definition, NULL);
    Tcl_DecrRefCount(namePtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewProcInstanceMethod --
 *
 *	Create a new procedure-like method for an object.
 *
 * ----------------------------------------------------------------------
 */

Method *
TclOONewProcInstanceMethod(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Object *oPtr,		/* The object to modify. */
    int flags,			/* Whether this is a public method. */
    Tcl_Obj *nameObj,		/* The name of the method, which must not be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which must not be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
				 * structure to allow for deeper tuning of the
				 * structure's contents. NULL if caller is not
				 * interested. */
{
    int argsLen;
    ProcedureMethod *pmPtr;
    Tcl_Method method;

    if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    }
    pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);
    if (method == NULL) {
	Tcl_Free(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }
    return (Method *) method;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewProcMethod --
 *
 *	Create a new procedure-like method for a class.
 *
 * ----------------------------------------------------------------------
 */

Method *
TclOONewProcMethod(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Class *clsPtr,		/* The class to modify. */
    int flags,			/* Whether this is a public method. */
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which may be NULL; if so, it is equivalent
				 * to an empty list. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    ProcedureMethod **pmPtrPtr)	/* Place to write pointer to procedure method
				 * structure to allow for deeper tuning of the
				 * structure's contents. NULL if caller is not
				 * interested. */
{
    int argsLen;		/* -1 => delete argsObj before exit */
    ProcedureMethod *pmPtr;
    const char *procName;
    Tcl_Method method;

    if (argsObj == NULL) {
	argsLen = -1;
	TclNewObj(argsObj);
	Tcl_IncrRefCount(argsObj);
	procName = "<destructor>";
    } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) {
	return NULL;
    } else {
	procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj));
    }

    pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod));
    memset(pmPtr, 0, sizeof(ProcedureMethod));
    pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION;
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->refCount = 1;

    method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName,
	    argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr);

    if (argsLen == -1) {
	Tcl_DecrRefCount(argsObj);
    }
    if (method == NULL) {
	Tcl_Free(pmPtr);
    } else if (pmPtrPtr != NULL) {
	*pmPtrPtr = pmPtr;
    }

    return (Method *) method;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOMakeProcInstanceMethod --
 *
 *	The guts of the code to make a procedure-like method for an object.
 *	Split apart so that it is easier for other extensions to reuse (in
 *	particular, it frees them from having to pry so deeply into Tcl's
 *	guts).
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
TclOOMakeProcInstanceMethod(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Object *oPtr,		/* The object to modify. */
    int flags,			/* Whether this is a public method. */
    Tcl_Obj *nameObj,		/* The name of the method, which _must not_ be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which _must not_ be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
				 * NULL. */
    const Tcl_MethodType *typePtr,
				/* The type of the method to create. */
    void *clientData,	/* The per-method type-specific data. */
    Proc **procPtrPtr)		/* A pointer to the variable in which to write
				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;

    if (TclCreateProc(interp, NULL, TclGetString(nameObj), argsObj, bodyObj,
	    procPtrPtr) != TCL_OK) {
	return NULL;
    }
    procPtr = *procPtrPtr;
    procPtr->cmdPtr = NULL;

    if (iPtr->cmdFramePtr) {
	CmdFrame context = *iPtr->cmdFramePtr;

	if (context.type == TCL_LOCATION_BC) {
	    /*
	     * Retrieve source information from the bytecode, if possible. If
	     * the information is retrieved successfully, context.type will be
	     * TCL_LOCATION_SOURCE and the reference held by
	     * context.data.eval.path will be counted.
	     */

	    TclGetSrcInfoForPc(&context);
	} else if (context.type == TCL_LOCATION_SOURCE) {
	    /*
	     * The copy into 'context' up above has created another reference
	     * to 'context.data.eval.path'; account for it.
	     */

	    Tcl_IncrRefCount(context.data.eval.path);
	}

	if (context.type == TCL_LOCATION_SOURCE) {
	    /*
	     * We can account for source location within a proc only if the
	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd = NULL;
		cfPtr->len = 0;

		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
			(char *) procPtr, &isNew);
		Tcl_SetHashValue(hPtr, cfPtr);
	    }

	    /*
	     * 'context' is going out of scope; account for the reference that
	     * it's holding to the path name.
	     */

	    Tcl_DecrRefCount(context.data.eval.path);
	    context.data.eval.path = NULL;
	}
    }

    return Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr, nameObj, flags,
	    typePtr, clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOMakeProcMethod --
 *
 *	The guts of the code to make a procedure-like method for a class.
 *	Split apart so that it is easier for other extensions to reuse (in
 *	particular, it frees them from having to pry so deeply into Tcl's
 *	guts).
 *
 * ----------------------------------------------------------------------
 */

Tcl_Method
TclOOMakeProcMethod(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Class *clsPtr,		/* The class to modify. */
    int flags,			/* Whether this is a public method. */
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    const char *namePtr,	/* The name of the method as a string, which
				 * _must not_ be NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which _must not_ be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which _must not_ be
				 * NULL. */
    const Tcl_MethodType *typePtr,
				/* The type of the method to create. */
    void *clientData,	/* The per-method type-specific data. */
    Proc **procPtrPtr)		/* A pointer to the variable in which to write
				 * the procedure record reference. Presumably
				 * inside the structure indicated by the
				 * pointer in clientData. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr;

    if (TclCreateProc(interp, NULL, namePtr, argsObj, bodyObj,
	    procPtrPtr) != TCL_OK) {
	return NULL;
    }
    procPtr = *procPtrPtr;
    procPtr->cmdPtr = NULL;

    if (iPtr->cmdFramePtr) {
	CmdFrame context = *iPtr->cmdFramePtr;

	if (context.type == TCL_LOCATION_BC) {
	    /*
	     * Retrieve source information from the bytecode, if possible. If
	     * the information is retrieved successfully, context.type will be
	     * TCL_LOCATION_SOURCE and the reference held by
	     * context.data.eval.path will be counted.
	     */

	    TclGetSrcInfoForPc(&context);
	} else if (context.type == TCL_LOCATION_SOURCE) {
	    /*
	     * The copy into 'context' up above has created another reference
	     * to 'context.data.eval.path'; account for it.
	     */

	    Tcl_IncrRefCount(context.data.eval.path);
	}

	if (context.type == TCL_LOCATION_SOURCE) {
	    /*
	     * We can account for source location within a proc only if the
	     * proc body was not created by substitution.
	     * (FIXME: check that this is sane and correct!)
	     */

	    if (context.line
		    && (context.nline >= 4) && (context.line[3] >= 0)) {
		int isNew;
		CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame));
		Tcl_HashEntry *hPtr;

		cfPtr->level = -1;
		cfPtr->type = context.type;
		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
		cfPtr->line[0] = context.line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = context.data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd = NULL;
		cfPtr->len = 0;

		hPtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
			(char *) procPtr, &isNew);
		Tcl_SetHashValue(hPtr, cfPtr);
	    }

	    /*
	     * 'context' is going out of scope; account for the reference that
	     * it's holding to the path name.
	     */

	    Tcl_DecrRefCount(context.data.eval.path);
	    context.data.eval.path = NULL;
	}
    }

    return Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj, flags, typePtr,
	    clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * InvokeProcedureMethod, PushMethodCallFrame --
 *
 *	How to invoke a procedure-like method.
 *
 * ----------------------------------------------------------------------
 */

static int
InvokeProcedureMethod(
    void *clientData,	/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
    int result;
    PMFrameData *fdPtr;		/* Important data that has to have a lifetime
				 * matched by this function (or rather, by the
				 * call frame's lifetime). */

    /*
     * If the object namespace (or interpreter) were deleted, we just skip to
     * the next thing in the chain.
     */

    if (TclOOObjectDestroyed(((CallContext *)context)->oPtr) ||
	Tcl_InterpDeleted(interp)
    ) {
	return TclNRObjectContextInvokeNext(interp, context, objc, objv,
		Tcl_ObjectContextSkippedArgs(context));
    }

    /*
     * Allocate the special frame data.
     */

    fdPtr = (PMFrameData *)TclStackAlloc(interp, sizeof(PMFrameData));

    /*
     * Create a call frame for this method.
     */

    result = PushMethodCallFrame(interp, (CallContext *) context, pmPtr,
	    objc, objv, fdPtr);
    if (result != TCL_OK) {
	TclStackFree(interp, fdPtr);
	return result;
    }
    pmPtr->refCount++;

    /*
     * Give the pre-call callback a chance to do some setup and, possibly,
     * veto the call.
     */

    if (pmPtr->preCallProc != NULL) {
	int isFinished;

	result = pmPtr->preCallProc(pmPtr->clientData, interp, context,
		(Tcl_CallFrame *) fdPtr->framePtr, &isFinished);
	if (isFinished || result != TCL_OK) {
	    /*
	     * Restore the old cmdPtr so that a subsequent use of [info frame]
	     * won't crash on us. [Bug 3001438]
	     */

	    pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;

	    Tcl_PopCallFrame(interp);
	    TclStackFree(interp, fdPtr->framePtr);
	    if (pmPtr->refCount-- <= 1) {
		DeleteProcedureMethodRecord(pmPtr);
	    }
	    TclStackFree(interp, fdPtr);
	    return result;
	}
    }

    /*
     * Now invoke the body of the method.
     */

    TclNRAddCallback(interp, FinalizePMCall, pmPtr, context, fdPtr, NULL);
    return TclNRInterpProcCore(interp, fdPtr->nameObj,
	    Tcl_ObjectContextSkippedArgs(context), fdPtr->errProc);
}

static int
FinalizePMCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    ProcedureMethod *pmPtr = (ProcedureMethod *)data[0];
    Tcl_ObjectContext context = (Tcl_ObjectContext)data[1];
    PMFrameData *fdPtr = (PMFrameData *)data[2];

    /*
     * Give the post-call callback a chance to do some cleanup. Note that at
     * this point the call frame itself is invalid; it's already been popped.
     */

    if (pmPtr->postCallProc) {
	result = pmPtr->postCallProc(pmPtr->clientData, interp, context,
		Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context)),
		result);
    }

    /*
     * Restore the old cmdPtr so that a subsequent use of [info frame] won't
     * crash on us. [Bug 3001438]
     */

    pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;

    /*
     * Scrap the special frame data now that we're done with it. Note that we
     * are inlining DeleteProcedureMethod() here; this location is highly
     * sensitive when it comes to performance!
     */

    if (pmPtr->refCount-- <= 1) {
	DeleteProcedureMethodRecord(pmPtr);
    }
    TclStackFree(interp, fdPtr);
    return result;
}

static int
PushMethodCallFrame(
    Tcl_Interp *interp,		/* Current interpreter. */
    CallContext *contextPtr,	/* Current method call context. */
    ProcedureMethod *pmPtr,	/* Information about this procedure-like
				 * method. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv,	/* Array of arguments. */
    PMFrameData *fdPtr)		/* Place to store information about the call
				 * frame. */
{
    Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr;
    int result;
    const char *namePtr;
    CallFrame **framePtrPtr = &fdPtr->framePtr;
    ByteCode *codePtr;

    /*
     * Compute basic information on the basis of the type of method it is.
     */

    if (contextPtr->callPtr->flags & CONSTRUCTOR) {
	namePtr = "<constructor>";
	fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName;
	fdPtr->errProc = ConstructorErrorHandler;
    } else if (contextPtr->callPtr->flags & DESTRUCTOR) {
	namePtr = "<destructor>";
	fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName;
	fdPtr->errProc = DestructorErrorHandler;
    } else {
	fdPtr->nameObj = Tcl_MethodName(
		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr));
	namePtr = TclGetString(fdPtr->nameObj);
	fdPtr->errProc = MethodErrorHandler;
    }
    if (pmPtr->errProc != NULL) {
	fdPtr->errProc = pmPtr->errProc;
    }

    /*
     * Magic to enable things like [incr Tcl], which wants methods to run in
     * their class's namespace.
     */

    if (pmPtr->flags & USE_DECLARER_NS) {
	Method *mPtr =
		contextPtr->callPtr->chain[contextPtr->index].mPtr;

	if (mPtr->declaringClassPtr != NULL) {
	    nsPtr = (Namespace *)
		    mPtr->declaringClassPtr->thisPtr->namespacePtr;
	} else {
	    nsPtr = (Namespace *) mPtr->declaringObjectPtr->namespacePtr;
	}
    }

    /*
     * Save the old cmdPtr so that when this recursive call returns, we can
     * restore it. To do otherwise causes crashes in [info frame] after we
     * return from a recursive call. [Bug 3001438]
     */

    fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr;

    /*
     * Compile the body. This operation may fail.
     */

    fdPtr->efi.length = 2;
    memset(&fdPtr->cmd, 0, sizeof(Command));
    fdPtr->cmd.nsPtr = nsPtr;
    fdPtr->cmd.clientData = &fdPtr->efi;
    pmPtr->procPtr->cmdPtr = &fdPtr->cmd;

    /*
     * [Bug 2037727] Always call TclProcCompileProc so that we check not only
     * that we have bytecode, but also that it remains valid. Note that we set
     * the namespace of the code here directly; this is a hack, but the
     * alternative is *so* slow...
     */

    ByteCodeGetIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr);
    if (codePtr) {
	codePtr->nsPtr = nsPtr;
    }
    result = TclProcCompileProc(interp, pmPtr->procPtr,
	    pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr);
    if (result != TCL_OK) {
	goto failureReturn;
    }

    /*
     * Make the stack frame and fill it out with information about this call.
     * This operation may fail.
     */

    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD);

    fdPtr->framePtr->clientData = contextPtr;
    fdPtr->framePtr->objc = objc;
    fdPtr->framePtr->objv = objv;
    fdPtr->framePtr->procPtr = pmPtr->procPtr;

    /*
     * Finish filling out the extra frame info so that [info frame] works.
     */

    fdPtr->efi.fields[0].name = "method";
    fdPtr->efi.fields[0].proc = NULL;
    fdPtr->efi.fields[0].clientData = fdPtr->nameObj;
    if (pmPtr->gfivProc != NULL) {
	fdPtr->efi.fields[1].name = "";
	fdPtr->efi.fields[1].proc = pmPtr->gfivProc;
	fdPtr->efi.fields[1].clientData = pmPtr;
    } else {
	Tcl_Method method =
		Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr);

	if (Tcl_MethodDeclarerObject(method) != NULL) {
	    fdPtr->efi.fields[1].name = "object";
	} else {
	    fdPtr->efi.fields[1].name = "class";
	}
	fdPtr->efi.fields[1].proc = RenderDeclarerName;
	fdPtr->efi.fields[1].clientData = &fdPtr->pni;
	fdPtr->pni.interp = interp;
	fdPtr->pni.method = method;
    }

    return TCL_OK;

    /*
     * Restore the old cmdPtr so that a subsequent use of [info frame] won't
     * crash on us. [Bug 3001438]
     */

  failureReturn:
    pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr;
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOSetupVariableResolver, etc. --
 *
 *	Variable resolution engine used to connect declared variables to local
 *	variables used in methods. The compiled variable resolver is more
 *	important, but both are needed as it is possible to have a variable
 *	that is only referred to in ways that aren't compilable and we can't
 *	force LVT presence. [TIP #320, #500]
 *
 * ----------------------------------------------------------------------
 */

void
TclOOSetupVariableResolver(
    Tcl_Namespace *nsPtr)
{
    Tcl_ResolverInfo info;

    Tcl_GetNamespaceResolvers(nsPtr, &info);
    if (info.compiledVarResProc == NULL) {
	Tcl_SetNamespaceResolvers(nsPtr, NULL, ProcedureMethodVarResolver,
		ProcedureMethodCompiledVarResolver);
    }
}

static int
ProcedureMethodVarResolver(
    Tcl_Interp *interp,
    const char *varName,
    Tcl_Namespace *contextNs,
    TCL_UNUSED(int) /*flags*/,	/* Ignoring variable access flags (???) */
    Tcl_Var *varPtr)
{
    int result;
    Tcl_ResolvedVarInfo *rPtr = NULL;

    result = ProcedureMethodCompiledVarResolver(interp, varName,
	    strlen(varName), contextNs, &rPtr);

    if (result != TCL_OK) {
	return result;
    }

    *varPtr = rPtr->fetchProc(interp, rPtr);

    /*
     * Must not retain reference to resolved information. [Bug 3105999]
     */

    rPtr->deleteProc(rPtr);
    return (*varPtr ? TCL_OK : TCL_CONTINUE);
}

static Tcl_Var
ProcedureMethodCompiledVarConnect(
    Tcl_Interp *interp,
    Tcl_ResolvedVarInfo *rPtr)
{
    OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;
    Interp *iPtr = (Interp *) interp;
    CallFrame *framePtr = iPtr->varFramePtr;
    CallContext *contextPtr;
    Tcl_Obj *variableObj;
    PrivateVariableMapping *privateVar;
    Tcl_HashEntry *hPtr;
    int i, isNew, cacheIt;
    size_t varLen, len;
    const char *match, *varName;

    /*
     * Check that the variable is being requested in a context that is also a
     * method call; if not (i.e. we're evaluating in the object's namespace or
     * in a procedure of that namespace) then we do nothing.
     */

    if (framePtr == NULL || !(framePtr->isProcCallFrame & FRAME_IS_METHOD)) {
	return NULL;
    }
    contextPtr = (CallContext *)framePtr->clientData;

    /*
     * If we've done the work before (in a comparable context) then reuse that
     * rather than performing resolution ourselves.
     */

    if (infoPtr->cachedObjectVar) {
	return infoPtr->cachedObjectVar;
    }

    /*
     * Check if the variable is one we want to resolve at all (i.e. whether it
     * is in the list provided by the user). If not, we mustn't do anything
     * either.
     */

    varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
    if (contextPtr->callPtr->chain[contextPtr->index]
	    .mPtr->declaringClassPtr != NULL) {
	FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->privateVariables) {
	    match = TclGetStringFromObj(privateVar->variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		variableObj = privateVar->fullNameObj;
		cacheIt = 0;
		goto gotMatch;
	    }
	}
	FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
		.mPtr->declaringClassPtr->variables) {
	    match = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 0;
		goto gotMatch;
	    }
	}
    } else {
	FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
	    match = TclGetStringFromObj(privateVar->variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		variableObj = privateVar->fullNameObj;
		cacheIt = 1;
		goto gotMatch;
	    }
	}
	FOREACH(variableObj, contextPtr->oPtr->variables) {
	    match = TclGetStringFromObj(variableObj, &len);
	    if ((len == varLen) && !memcmp(match, varName, len)) {
		cacheIt = 1;
		goto gotMatch;
	    }
	}
    }
    return NULL;

    /*
     * It is a variable we want to resolve, so resolve it.
     */

  gotMatch:
    hPtr = Tcl_CreateHashEntry(TclVarTable(contextPtr->oPtr->namespacePtr),
	    (char *) variableObj, &isNew);
    if (isNew) {
	TclSetVarNamespaceVar((Var *) TclVarHashGetValue(hPtr));
    }
    if (cacheIt) {
	infoPtr->cachedObjectVar = TclVarHashGetValue(hPtr);

	/*
	 * We must keep a reference to the variable so everything will
	 * continue to work correctly even if it is unset; being unset does
	 * not end the life of the variable at this level. [Bug 3185009]
	 */

	VarHashRefCount(infoPtr->cachedObjectVar)++;
    }
    return TclVarHashGetValue(hPtr);
}

static void
ProcedureMethodCompiledVarDelete(
    Tcl_ResolvedVarInfo *rPtr)
{
    OOResVarInfo *infoPtr = (OOResVarInfo *) rPtr;

    /*
     * Release the reference to the variable if we were holding it.
     */

    if (infoPtr->cachedObjectVar) {
	VarHashRefCount(infoPtr->cachedObjectVar)--;
	TclCleanupVar((Var *) infoPtr->cachedObjectVar, NULL);
    }
    Tcl_DecrRefCount(infoPtr->variableObj);
    Tcl_Free(infoPtr);
}

static int
ProcedureMethodCompiledVarResolver(
    TCL_UNUSED(Tcl_Interp *),
    const char *varName,
    int length,
    TCL_UNUSED(Tcl_Namespace *),
    Tcl_ResolvedVarInfo **rPtrPtr)
{
    OOResVarInfo *infoPtr;
    Tcl_Obj *variableObj = Tcl_NewStringObj(varName, length);

    /*
     * Do not create resolvers for cases that contain namespace separators or
     * which look like array accesses. Both will lead us astray.
     */

    if (strstr(TclGetString(variableObj), "::") != NULL ||
	    Tcl_StringMatch(TclGetString(variableObj), "*(*)")) {
	Tcl_DecrRefCount(variableObj);
	return TCL_CONTINUE;
    }

    infoPtr = (OOResVarInfo *)Tcl_Alloc(sizeof(OOResVarInfo));
    infoPtr->info.fetchProc = ProcedureMethodCompiledVarConnect;
    infoPtr->info.deleteProc = ProcedureMethodCompiledVarDelete;
    infoPtr->cachedObjectVar = NULL;
    infoPtr->variableObj = variableObj;
    Tcl_IncrRefCount(variableObj);
    *rPtrPtr = &infoPtr->info;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * RenderDeclarerName --
 *
 *	Returns the name of the entity (object or class) which declared a
 *	method. Used for producing information for [info frame] in such a way
 *	that the expensive part of this (generating the object or class name
 *	itself) isn't done until it is needed.
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Obj *
RenderDeclarerName(
    void *clientData)
{
    struct PNI *pni = (struct PNI *)clientData;
    Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);

    if (object == NULL) {
	object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method));
    }
    return TclOOObjectName(pni->interp, (Object *) object);
}

/*
 * ----------------------------------------------------------------------
 *
 * MethodErrorHandler, ConstructorErrorHandler, DestructorErrorHandler --
 *
 *	How to fill in the stack trace correctly upon error in various forms
 *	of procedure-like methods. LIMIT is how long the inserted strings in
 *	the error traces should get before being converted to have ellipses,
 *	and ELLIPSIFY is a macro to do the conversion (with the help of a
 *	%.*s%s format field). Note that ELLIPSIFY is only safe for use in
 *	suitable formatting contexts.
 *
 * ----------------------------------------------------------------------
 */

/* TODO: Check whether Tcl_AppendLimitedToObj() can work here. */

#define LIMIT 60
#define ELLIPSIFY(str,len) \
	((len) > LIMIT ? LIMIT : (int)(len)), (str), ((len) > LIMIT ? "..." : "")

static void
MethodErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
	/* We pull the method name out of context instead of from argument */
{
    size_t nameLen, objectNameLen;
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    const char *objectName, *kindName, *methodName =
	    TclGetStringFromObj(mPtr->namePtr, &nameLen);
    Object *declarerPtr;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
	    kindName, ELLIPSIFY(objectName, objectNameLen),
	    ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp)));
}

static void
ConstructorErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
		/* Ignore. We know it is the constructor. */
{
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    size_t objectNameLen;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" constructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

static void
DestructorErrorHandler(
    Tcl_Interp *interp,
    TCL_UNUSED(Tcl_Obj *) /*methodNameObj*/)
		/* Ignore. We know it is the destructor. */
{
    CallContext *contextPtr = (CallContext *)((Interp *) interp)->varFramePtr->clientData;
    Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
    Object *declarerPtr;
    const char *objectName, *kindName;
    size_t objectNameLen;

    if (mPtr->declaringObjectPtr != NULL) {
	declarerPtr = mPtr->declaringObjectPtr;
	kindName = "object";
    } else {
	if (mPtr->declaringClassPtr == NULL) {
	    Tcl_Panic("method not declared in class or object");
	}
	declarerPtr = mPtr->declaringClassPtr->thisPtr;
	kindName = "class";
    }

    objectName = TclGetStringFromObj(TclOOObjectName(interp, declarerPtr),
	    &objectNameLen);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (%s \"%.*s%s\" destructor line %d)", kindName,
	    ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}

/*
 * ----------------------------------------------------------------------
 *
 * DeleteProcedureMethod, CloneProcedureMethod --
 *
 *	How to delete and clone procedure-like methods.
 *
 * ----------------------------------------------------------------------
 */

static void
DeleteProcedureMethodRecord(
    ProcedureMethod *pmPtr)
{
    TclProcDeleteProc(pmPtr->procPtr);
    if (pmPtr->deleteClientdataProc) {
	pmPtr->deleteClientdataProc(pmPtr->clientData);
    }
    Tcl_Free(pmPtr);
}

static void
DeleteProcedureMethod(
    void *clientData)
{
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;

    if (pmPtr->refCount-- <= 1) {
	DeleteProcedureMethodRecord(pmPtr);
    }
}

static int
CloneProcedureMethod(
    Tcl_Interp *interp,
    void *clientData,
    void **newClientData)
{
    ProcedureMethod *pmPtr = (ProcedureMethod *)clientData;
    ProcedureMethod *pm2Ptr;
    Tcl_Obj *bodyObj, *argsObj;
    CompiledLocal *localPtr;

    /*
     * Copy the argument list.
     */

    TclNewObj(argsObj);
    for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL;
	    localPtr=localPtr->nextPtr) {
	if (TclIsVarArgument(localPtr)) {
	    Tcl_Obj *argObj;

	    TclNewObj(argObj);
	    Tcl_ListObjAppendElement(NULL, argObj,
		    Tcl_NewStringObj(localPtr->name, -1));
	    if (localPtr->defValuePtr != NULL) {
		Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr);
	    }
	    Tcl_ListObjAppendElement(NULL, argsObj, argObj);
	}
    }

    /*
     * Must strip the internal representation in order to ensure that any
     * bound references to instance variables are removed. [Bug 3609693]
     */

    bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
    TclGetString(bodyObj);
    Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL);

    /*
     * Create the actual copy of the method record, manufacturing a new proc
     * record.
     */

    pm2Ptr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod));
    memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod));
    pm2Ptr->refCount = 1;
    Tcl_IncrRefCount(argsObj);
    Tcl_IncrRefCount(bodyObj);
    if (TclCreateProc(interp, NULL, "", argsObj, bodyObj,
	    &pm2Ptr->procPtr) != TCL_OK) {
	Tcl_DecrRefCount(argsObj);
	Tcl_DecrRefCount(bodyObj);
	Tcl_Free(pm2Ptr);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(argsObj);
    Tcl_DecrRefCount(bodyObj);

    if (pmPtr->cloneClientdataProc) {
	pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData);
    }
    *newClientData = pm2Ptr;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewForwardInstanceMethod --
 *
 *	Create a forwarded method for an object.
 *
 * ----------------------------------------------------------------------
 */

Method *
TclOONewForwardInstanceMethod(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Object *oPtr,		/* The object to attach the method to. */
    int flags,			/* Whether the method is public or not. */
    Tcl_Obj *nameObj,		/* The name of the method. */
    Tcl_Obj *prefixObj)		/* List of arguments that form the command
				 * prefix to forward to. */
{
    int prefixLen;
    ForwardMethod *fmPtr;

    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewInstanceMethod(interp, (Tcl_Object) oPtr,
	    nameObj, flags, &fwdMethodType, fmPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOONewForwardMethod --
 *
 *	Create a new forwarded method for a class.
 *
 * ----------------------------------------------------------------------
 */

Method *
TclOONewForwardMethod(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Class *clsPtr,		/* The class to attach the method to. */
    int flags,			/* Whether the method is public or not. */
    Tcl_Obj *nameObj,		/* The name of the method. */
    Tcl_Obj *prefixObj)		/* List of arguments that form the command
				 * prefix to forward to. */
{
    int prefixLen;
    ForwardMethod *fmPtr;

    if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) {
	return NULL;
    }
    if (prefixLen < 1) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"method forward prefix must be non-empty", -1));
	Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_FORWARD", NULL);
	return NULL;
    }

    fmPtr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod));
    fmPtr->prefixObj = prefixObj;
    Tcl_IncrRefCount(prefixObj);
    return (Method *) Tcl_NewMethod(interp, (Tcl_Class) clsPtr, nameObj,
	    flags, &fwdMethodType, fmPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * InvokeForwardMethod --
 *
 *	How to invoke a forwarded method. Works by doing some ensemble-like
 *	command rearranging and then invokes some other Tcl command.
 *
 * ----------------------------------------------------------------------
 */

static int
InvokeForwardMethod(
    void *clientData,	/* Pointer to some per-method context. */
    Tcl_Interp *interp,
    Tcl_ObjectContext context,	/* The method calling context. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Arguments as actually seen. */
{
    CallContext *contextPtr = (CallContext *) context;
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;
    Tcl_Obj **argObjs, **prefixObjs;
    int numPrefixes, len, skip = contextPtr->skip;

    /*
     * Build the real list of arguments to use. Note that we know that the
     * prefixObj field of the ForwardMethod structure holds a reference to a
     * non-empty list, so there's a whole class of failures ("not a list") we
     * can ignore here.
     */

    Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs);
    argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
	    numPrefixes, prefixObjs, &len);
    Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
    /*
     * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
     * of the TCL_EVAL_NOERR flag results in an evaluation configuration
     * very much like TCL_EVAL_INVOKE.
     */
    ((Interp *)interp)->lookupNsPtr
	    = (Namespace *) contextPtr->oPtr->namespacePtr;
    return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
}

static int
FinalizeForwardCall(
    void *data[],
    Tcl_Interp *interp,
    int result)
{
    Tcl_Obj **argObjs = (Tcl_Obj **)data[0];

    TclStackFree(interp, argObjs);
    return result;
}

/*
 * ----------------------------------------------------------------------
 *
 * DeleteForwardMethod, CloneForwardMethod --
 *
 *	How to delete and clone forwarded methods.
 *
 * ----------------------------------------------------------------------
 */

static void
DeleteForwardMethod(
    void *clientData)
{
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;

    Tcl_DecrRefCount(fmPtr->prefixObj);
    Tcl_Free(fmPtr);
}

static int
CloneForwardMethod(
    TCL_UNUSED(Tcl_Interp *),
    void *clientData,
    void **newClientData)
{
    ForwardMethod *fmPtr = (ForwardMethod *)clientData;
    ForwardMethod *fm2Ptr = (ForwardMethod *)Tcl_Alloc(sizeof(ForwardMethod));

    fm2Ptr->prefixObj = fmPtr->prefixObj;
    Tcl_IncrRefCount(fm2Ptr->prefixObj);
    *newClientData = fm2Ptr;
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetProcFromMethod, TclOOGetFwdFromMethod --
 *
 *	Utility functions used for procedure-like and forwarding method
 *	introspection.
 *
 * ----------------------------------------------------------------------
 */

Proc *
TclOOGetProcFromMethod(
    Method *mPtr)
{
    if (mPtr->typePtr == &procMethodType) {
	ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData;

	return pmPtr->procPtr;
    }
    return NULL;
}

Tcl_Obj *
TclOOGetMethodBody(
    Method *mPtr)
{
    if (mPtr->typePtr == &procMethodType) {
	ProcedureMethod *pmPtr = (ProcedureMethod *)mPtr->clientData;

	(void) TclGetString(pmPtr->procPtr->bodyPtr);
	return pmPtr->procPtr->bodyPtr;
    }
    return NULL;
}

Tcl_Obj *
TclOOGetFwdFromMethod(
    Method *mPtr)
{
    if (mPtr->typePtr == &fwdMethodType) {
	ForwardMethod *fwPtr = (ForwardMethod *)mPtr->clientData;

	return fwPtr->prefixObj;
    }
    return NULL;
}

/*
 * ----------------------------------------------------------------------
 *
 * InitEnsembleRewrite --
 *
 *	Utility function that wraps up a lot of the complexity involved in
 *	doing ensemble-like command forwarding. Here is a picture of memory
 *	management plan:
 *
 *                    <-----------------objc---------------------->
 *      objv:        |=============|===============================|
 *                    <-toRewrite->           |
 *                                             \
 *                    <-rewriteLength->         \
 *      rewriteObjs: |=================|         \
 *                           |                    |
 *                           V                    V
 *      argObjs:     |=================|===============================|
 *                    <------------------*lengthPtr------------------->
 *
 * ----------------------------------------------------------------------
 */

static Tcl_Obj **
InitEnsembleRewrite(
    Tcl_Interp *interp,		/* Place to log the rewrite info. */
    int objc,			/* Number of real arguments. */
    Tcl_Obj *const *objv,	/* The real arguments. */
    int toRewrite,		/* Number of real arguments to replace. */
    int rewriteLength,		/* Number of arguments to insert instead. */
    Tcl_Obj *const *rewriteObjs,/* Arguments to insert instead. */
    int *lengthPtr)		/* Where to write the resulting length of the
				 * array of rewritten arguments. */
{
    unsigned len = rewriteLength + objc - toRewrite;
    Tcl_Obj **argObjs = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);

    memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
    memcpy(argObjs + rewriteLength, objv + toRewrite,
	    sizeof(Tcl_Obj *) * (objc - toRewrite));

    /*
     * Now plumb this into the core ensemble rewrite logging system so that
     * Tcl_WrongNumArgs() can rewrite its result appropriately. The rules for
     * how to store the rewrite rules get complex solely because of the case
     * where an ensemble rewrites itself out of the picture; when that
     * happens, the quality of the error message rewrite falls drastically
     * (and unavoidably).
     */

    if (TclInitRewriteEnsemble(interp, toRewrite, rewriteLength, objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    *lengthPtr = len;
    return argObjs;
}

/*
 * ----------------------------------------------------------------------
 *
 * assorted trivial 'getter' functions
 *
 * ----------------------------------------------------------------------
 */

Tcl_Object
Tcl_MethodDeclarerObject(
    Tcl_Method method)
{
    return (Tcl_Object) ((Method *) method)->declaringObjectPtr;
}

Tcl_Class
Tcl_MethodDeclarerClass(
    Tcl_Method method)
{
    return (Tcl_Class) ((Method *) method)->declaringClassPtr;
}

Tcl_Obj *
Tcl_MethodName(
    Tcl_Method method)
{
    return ((Method *) method)->namePtr;
}

int
Tcl_MethodIsType(
    Tcl_Method method,
    const Tcl_MethodType *typePtr,
    void **clientDataPtr)
{
    Method *mPtr = (Method *) method;

    if (mPtr->typePtr == typePtr) {
	if (clientDataPtr != NULL) {
	    *clientDataPtr = mPtr->clientData;
	}
	return 1;
    }
    return 0;
}

int
Tcl_MethodIsPublic(
    Tcl_Method method)
{
    return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
}

int
Tcl_MethodIsPrivate(
    Tcl_Method method)
{
    return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
}

/*
 * Extended method construction for itcl-ng.
 */

Tcl_Method
TclOONewProcInstanceMethodEx(
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    Tcl_Object oPtr,		/* The object to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    void *clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which must not be
				 * NULL. */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which must not be NULL. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    int flags,			/* Whether this is a public method. */
    void **internalTokenPtr)	/* If non-NULL, points to a variable that gets
				 * the reference to the ProcedureMethod
				 * structure. */
{
    ProcedureMethod *pmPtr;
    Tcl_Method method = (Tcl_Method) TclOONewProcInstanceMethod(interp,
	    (Object *) oPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);

    if (method == NULL) {
	return NULL;
    }
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->preCallProc = preCallPtr;
    pmPtr->postCallProc = postCallPtr;
    pmPtr->errProc = errProc;
    pmPtr->clientData = clientData;
    if (internalTokenPtr != NULL) {
	*internalTokenPtr = pmPtr;
    }
    return method;
}

Tcl_Method
TclOONewProcMethodEx(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Tcl_Class clsPtr,		/* The class to modify. */
    TclOO_PreCallProc *preCallPtr,
    TclOO_PostCallProc *postCallPtr,
    ProcErrorProc *errProc,
    void *clientData,
    Tcl_Obj *nameObj,		/* The name of the method, which may be NULL;
				 * if so, up to caller to manage storage
				 * (e.g., because it is a constructor or
				 * destructor). */
    Tcl_Obj *argsObj,		/* The formal argument list for the method,
				 * which may be NULL; if so, it is equivalent
				 * to an empty list. */
    Tcl_Obj *bodyObj,		/* The body of the method, which must not be
				 * NULL. */
    int flags,			/* Whether this is a public method. */
    void **internalTokenPtr)	/* If non-NULL, points to a variable that gets
				 * the reference to the ProcedureMethod
				 * structure. */
{
    ProcedureMethod *pmPtr;
    Tcl_Method method = (Tcl_Method) TclOONewProcMethod(interp,
	    (Class *) clsPtr, flags, nameObj, argsObj, bodyObj, &pmPtr);

    if (method == NULL) {
	return NULL;
    }
    pmPtr->flags = flags & USE_DECLARER_NS;
    pmPtr->preCallProc = preCallPtr;
    pmPtr->postCallProc = postCallPtr;
    pmPtr->errProc = errProc;
    pmPtr->clientData = clientData;
    if (internalTokenPtr != NULL) {
	*internalTokenPtr = pmPtr;
    }
    return method;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOOScript.h.

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







































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOOScript.h --
 *
 *	This file contains support scripts for TclOO. They are defined here so
 *	that the code can be definitely run even in safe interpreters; TclOO's
 *	core setup is safe.
 *
 * Copyright (c) 2012-2018 Donal K. Fellows
 * Copyright (c) 2013 Andreas Kupries
 * Copyright (c) 2017 Gerald Lester
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef TCL_OO_SCRIPT_H
#define TCL_OO_SCRIPT_H

/*
 * The scripted part of the definitions of TclOO.
 *
 * Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
 * contains the commented version of everything; *this* file is automatically
 * generated.
 */

static const char *tclOOSetupScript =
/* !BEGIN!: Do not edit below this line. */
"::namespace eval ::oo {\n"
"\t::namespace path {}\n"
"\tnamespace eval Helpers {\n"
"\t\t::namespace path {}\n"
"\t\tproc callback {method args} {\n"
"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
"\t\t}\n"
"\t\tnamespace export callback\n"
"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
"\t\tnamespace export -clear\n"
"\t\trename tmp::callback mymethod\n"
"\t\tnamespace delete tmp\n"
"\t\tproc classvariable {name args} {\n"
"\t\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
"\t\t\tforeach v [list $name {*}$args] {\n"
"\t\t\t\tif {[string match *(*) $v]} {\n"
"\t\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
"\t\t\t\t}\n"
"\t\t\t\tif {[string match *::* $v]} {\n"
"\t\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
"\t\t\t\t}\n"
"\t\t\t\tlappend vs $v $v\n"
"\t\t\t}\n"
"\t\t\ttailcall namespace upvar $ns {*}$vs\n"
"\t\t}\n"
"\t\tproc link {args} {\n"
"\t\t\tset ns [uplevel 1 {::namespace current}]\n"
"\t\t\tforeach link $args {\n"
"\t\t\t\tif {[llength $link] == 2} {\n"
"\t\t\t\t\tlassign $link src dst\n"
"\t\t\t\t} elseif {[llength $link] == 1} {\n"
"\t\t\t\t\tlassign $link src\n"
"\t\t\t\t\tset dst $src\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\treturn -code error -errorcode {TCLOO CMDLINK FORMAT} \\\n"
"\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
"\t\t\t\t}\n"
"\t\t\t\tif {![string match ::* $src]} {\n"
"\t\t\t\t\tset src [string cat $ns :: $src]\n"
"\t\t\t\t}\n"
"\t\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
"\t\t\t\ttrace add command ${ns}::my delete [list \\\n"
"\t\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
"\t\t\t}\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t}\n"
"\tproc UnlinkLinkedCommand {cmd args} {\n"
"\t\tif {[namespace which $cmd] ne {}} {\n"
"\t\t\trename $cmd {}\n"
"\t\t}\n"
"\t}\n"
"\tproc DelegateName {class} {\n"
"\t\tstring cat [info object namespace $class] {:: oo ::delegate}\n"
"\t}\n"
"\tproc MixinClassDelegates {class} {\n"
"\t\tif {![info object isa class $class]} {\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t\tset delegate [DelegateName $class]\n"
"\t\tif {![info object isa class $delegate]} {\n"
"\t\t\treturn\n"
"\t\t}\n"
"\t\tforeach c [info class superclass $class] {\n"
"\t\t\tset d [DelegateName $c]\n"
"\t\t\tif {![info object isa class $d]} {\n"
"\t\t\t\tcontinue\n"
"\t\t\t}\n"
"\t\t\tdefine $delegate ::oo::define::superclass -append $d\n"
"\t\t}\n"
"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
"\t}\n"
"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
"\t\tset originDelegate [DelegateName $originObject]\n"
"\t\tset targetDelegate [DelegateName $targetObject]\n"
"\t\tif {\n"
"\t\t\t[info object isa class $originDelegate]\n"
"\t\t\t&& ![info object isa class $targetDelegate]\n"
"\t\t} then {\n"
"\t\t\tcopy $originDelegate $targetDelegate\n"
"\t\t\tobjdefine $targetObject ::oo::objdefine::mixin -set \\\n"
"\t\t\t\t{*}[lmap c [info object mixin $targetObject] {\n"
"\t\t\t\t\tif {$c eq $originDelegate} {set targetDelegate} {set c}\n"
"\t\t\t\t}]\n"
"\t\t}\n"
"\t}\n"
"\tproc define::classmethod {name {args {}} {body {}}} {\n"
"\t\t::set argc [::llength [::info level 0]]\n"
"\t\t::if {$argc == 3} {\n"
"\t\t\t::return -code error -errorcode {TCL WRONGARGS} [::format \\\n"
"\t\t\t\t{wrong # args: should be \"%s name \?args body\?\"} \\\n"
"\t\t\t\t[::lindex [::info level 0] 0]]\n"
"\t\t}\n"
"\t\t::set cls [::uplevel 1 self]\n"
"\t\t::if {$argc == 4} {\n"
"\t\t\t::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
"\t\t}\n"
"\t\t::tailcall forward $name myclass $name\n"
"\t}\n"
"\tproc define::initialise {body} {\n"
"\t\t::set clsns [::info object namespace [::uplevel 1 self]]\n"
"\t\t::tailcall apply [::list {} $body $clsns]\n"
"\t}\n"
"\tnamespace eval define {\n"
"\t\t::namespace export initialise\n"
"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
"\t\t::namespace export -clear\n"
"\t\t::rename tmp::initialise initialize\n"
"\t\t::namespace delete tmp\n"
"\t}\n"
"\tdefine Slot {\n"
"\t\tmethod Get {} {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Set list {\n"
"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
"\t\t}\n"
"\t\tmethod Resolve list {\n"
"\t\t\treturn $list\n"
"\t\t}\n"
"\t\tmethod -set args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\ttailcall my Set $args\n"
"\t\t}\n"
"\t\tmethod -append args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
"\t\t}\n"
"\t\tmethod -clear {} {tailcall my Set {}}\n"
"\t\tmethod -prepend args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
"\t\t}\n"
"\t\tmethod -remove args {\n"
"\t\t\tset my [namespace which my]\n"
"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
"\t\t\tset current [uplevel 1 [list $my Get]]\n"
"\t\t\ttailcall my Set [lmap val $current {\n"
"\t\t\t\tif {$val in $args} continue else {set val}\n"
"\t\t\t}]\n"
"\t\t}\n"
"\t\tforward --default-operation my -append\n"
"\t\tmethod unknown {args} {\n"
"\t\t\tset def --default-operation\n"
"\t\t\tif {[llength $args] == 0} {\n"
"\t\t\t\ttailcall my $def\n"
"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
"\t\t\t\ttailcall my $def {*}$args\n"
"\t\t\t}\n"
"\t\t\tnext {*}$args\n"
"\t\t}\n"
"\t\texport -set -append -clear -prepend -remove\n"
"\t\tunexport unknown destroy\n"
"\t}\n"
"\tobjdefine define::superclass forward --default-operation my -set\n"
"\tobjdefine define::mixin forward --default-operation my -set\n"
"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
"\tdefine object method <cloned> {originObject} {\n"
"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
"\t\t\tset args [info args $p]\n"
"\t\t\tset idx -1\n"
"\t\t\tforeach a $args {\n"
"\t\t\t\tif {[info default $p $a d]} {\n"
"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tlset args [incr idx] [list $a]\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\tset b [info body $p]\n"
"\t\t\tset p [namespace tail $p]\n"
"\t\t\tproc $p $args $b\n"
"\t\t}\n"
"\t\tforeach v [info vars [info object namespace $originObject]::*] {\n"
"\t\t\tupvar 0 $v vOrigin\n"
"\t\t\tnamespace upvar [namespace current] [namespace tail $v] vNew\n"
"\t\t\tif {[info exists vOrigin]} {\n"
"\t\t\t\tif {[array exists vOrigin]} {\n"
"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
"\t\t\t\t} else {\n"
"\t\t\t\t\tset vNew $vOrigin\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t}\n"
"\t}\n"
"\tdefine class method <cloned> {originObject} {\n"
"\t\tnext $originObject\n"
"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
"\t}\n"
"\tclass create singleton {\n"
"\t\tsuperclass class\n"
"\t\tvariable object\n"
"\t\tunexport create createWithNamespace\n"
"\t\tmethod new args {\n"
"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
"\t\t\t\tset object [next {*}$args]\n"
"\t\t\t\t::oo::objdefine $object {\n"
"\t\t\t\t\tmethod destroy {} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t\tmethod <cloned> {originObject} {\n"
"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
"\t\t\t\t\t}\n"
"\t\t\t\t}\n"
"\t\t\t}\n"
"\t\t\treturn $object\n"
"\t\t}\n"
"\t}\n"
"\tclass create abstract {\n"
"\t\tsuperclass class\n"
"\t\tunexport create createWithNamespace new\n"
"\t}\n"
"}\n"
/* !END!: Do not edit above this line. */
;

#endif /* TCL_OO_SCRIPT_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclOOStubInit.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * This file is (mostly) automatically generated from tclOO.decls.
 * It is compiled and linked in with the tclOO package proper.
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclOOInt.h"

MODULE_SCOPE const TclOOStubs tclOOStubs;

#ifdef __GNUC__
#pragma GCC dependency "tclOO.decls"
#endif

/* !BEGIN!: Do not edit below this line. */

static const TclOOIntStubs tclOOIntStubs = {
    TCL_STUB_MAGIC,
    0,
    TclOOGetDefineCmdContext, /* 0 */
    TclOOMakeProcInstanceMethod, /* 1 */
    TclOOMakeProcMethod, /* 2 */
    TclOONewProcInstanceMethod, /* 3 */
    TclOONewProcMethod, /* 4 */
    TclOOObjectCmdCore, /* 5 */
    TclOOIsReachable, /* 6 */
    TclOONewForwardMethod, /* 7 */
    TclOONewForwardInstanceMethod, /* 8 */
    TclOONewProcInstanceMethodEx, /* 9 */
    TclOONewProcMethodEx, /* 10 */
    TclOOInvokeObject, /* 11 */
    TclOOObjectSetFilters, /* 12 */
    TclOOClassSetFilters, /* 13 */
    TclOOObjectSetMixins, /* 14 */
    TclOOClassSetMixins, /* 15 */
};

static const TclOOStubHooks tclOOStubHooks = {
    &tclOOIntStubs
};

const TclOOStubs tclOOStubs = {
    TCL_STUB_MAGIC,
    &tclOOStubHooks,
    Tcl_CopyObjectInstance, /* 0 */
    Tcl_GetClassAsObject, /* 1 */
    Tcl_GetObjectAsClass, /* 2 */
    Tcl_GetObjectCommand, /* 3 */
    Tcl_GetObjectFromObj, /* 4 */
    Tcl_GetObjectNamespace, /* 5 */
    Tcl_MethodDeclarerClass, /* 6 */
    Tcl_MethodDeclarerObject, /* 7 */
    Tcl_MethodIsPublic, /* 8 */
    Tcl_MethodIsType, /* 9 */
    Tcl_MethodName, /* 10 */
    Tcl_NewInstanceMethod, /* 11 */
    Tcl_NewMethod, /* 12 */
    Tcl_NewObjectInstance, /* 13 */
    Tcl_ObjectDeleted, /* 14 */
    Tcl_ObjectContextIsFiltering, /* 15 */
    Tcl_ObjectContextMethod, /* 16 */
    Tcl_ObjectContextObject, /* 17 */
    Tcl_ObjectContextSkippedArgs, /* 18 */
    Tcl_ClassGetMetadata, /* 19 */
    Tcl_ClassSetMetadata, /* 20 */
    Tcl_ObjectGetMetadata, /* 21 */
    Tcl_ObjectSetMetadata, /* 22 */
    Tcl_ObjectContextInvokeNext, /* 23 */
    Tcl_ObjectGetMethodNameMapper, /* 24 */
    Tcl_ObjectSetMethodNameMapper, /* 25 */
    Tcl_ClassSetConstructor, /* 26 */
    Tcl_ClassSetDestructor, /* 27 */
    Tcl_GetObjectName, /* 28 */
    Tcl_MethodIsPrivate, /* 29 */
};

/* !END!: Do not edit above this line. */

Deleted generic/tclOOStubLib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71







































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
 */

#include "tclOOInt.h"

MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr;

const TclOOStubs *tclOOStubsPtr = NULL;
const TclOOIntStubs *tclOOIntStubsPtr = NULL;

/*
 *----------------------------------------------------------------------
 *
 * TclOOInitializeStubs --
 *	Load the tclOO package, initialize stub table pointer. Do not call
 *	this function directly, use Tcl_OOInitStubs() macro instead.
 *
 * Results:
 *	The actual version of the package that satisfies the request, or NULL
 *	to indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */

#undef TclOOInitializeStubs

MODULE_SCOPE const char *
TclOOInitializeStubs(
    Tcl_Interp *interp,
    const char *version)
{
    int exact = 0;
    const char *packageName = "TclOO";
    const char *errMsg = NULL;
    TclOOStubs *stubsPtr = NULL;
    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
	    packageName, version, exact, &stubsPtr);

    if (actualVersion == NULL) {
	return NULL;
    }
    if (stubsPtr == NULL) {
	errMsg = "missing stub table pointer";
    } else {
	tclOOStubsPtr = stubsPtr;
	if (stubsPtr->hooks) {
	    tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;
	} else {
	    tclOOIntStubsPtr = NULL;
	}
	return actualVersion;
    }
    tclStubsPtr->tcl_ResetResult(interp);
    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
	    " (requested version ", version, ", actual version ",
	    actualVersion, "): ", errMsg, NULL);
    return NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclObj.c.

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
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







-
-
-
+
+
+




















-
+











+
-
-
+
+

-
-
-
+
+
+


-
+

-
+















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+
-
-
+
+







 * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * 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 "tclTomMath.h"
#include <math.h>
#include <assert.h>
#include "tommath.h"
#include <float.h>
#include <math.h>

/*
 * Table of all object types.
 */

static Tcl_HashTable typeTable;
static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(tableMutex)

/*
 * Head of the list of free Tcl_Obj structs we maintain.
 */

Tcl_Obj *tclFreeObjList = NULL;

/*
 * The object allocator is single threaded. This mutex is referenced by the
 * TclNewObj macro, however, so must be visible.
 */

#if TCL_THREADS
#ifdef TCL_THREADS
MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif

/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

char tclEmptyString = '\0';
char *tclEmptyStringRep = &tclEmptyString;

#if TCL_THREADS && defined(TCL_MEM_DEBUG)

#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
 * Structure for tracking the source file and line number where a given
 * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
 * for sanity checking purposes.
 * Structure for tracking the source file and line number where a given Tcl_Obj
 * was allocated.  We also track the pointer to the Tcl_Obj itself, for sanity
 * checking purposes.
 */

typedef struct {
typedef struct ObjData {
    Tcl_Obj *objPtr;		/* The pointer to the allocated Tcl_Obj. */
    const char *file;		/* The name of the source file calling this
    CONST char *file;		/* The name of the source file calling this
				 * function; used for debugging. */
    int line;			/* Line number in the source file; used for
				 * debugging. */
} ObjData;
#endif /* TCL_MEM_DEBUG && TCL_THREADS */

/*
 * All static variables used in this file are collected into a single instance
 * of the following structure.  For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *
 * Notice that different structures with the same name appear in other files.
 * The structure defined below is used in this file only.
 */

typedef struct {
    Tcl_HashTable *lineCLPtr;   /* This table remembers for each Tcl_Obj
                                 * generated by a call to the function
                                 * TclSubstTokens() from a literal text
                                 * where bs+nl sequences occured in it, if
                                 * any. I.e. this table keeps track of
                                 * invisible and stripped continuation lines.
                                 * Its keys are Tcl_Obj pointers, the values
                                 * are ContLineLoc pointers. See the file
                                 * tclCompile.h for the definition of this
                                 * structure, and for references to all
                                 * related places in the core. */
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
    Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
                                 * that a Tcl_Obj was not allocated by some
                                 * other thread. */
typedef struct ThreadSpecificData {
    Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj
			       * generated by a call to the function
			       * TclSubstTokens() from a literal text
			       * where bs+nl sequences occured in it, if
			       * any. I.e. this table keeps track of
			       * invisible/stripped continuation lines. Its
			       * keys are Tcl_Obj pointers, the values are
			       * ContLineLoc pointers.  See the file
			       * tclCompile.h for the definition of this
			       * structure, and for references to all related
			       * places in the core.
			       */
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
    /*
     * Thread local table that is used to check that a Tcl_Obj was not
     * allocated by some other thread.
     */

    Tcl_HashTable *objThreadMap;
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

static void ContLineLocFree (char* clientData);
static void             TclThreadFinalizeContLines(ClientData clientData);
static ThreadSpecificData *TclGetContLineTable(void);
static void TclThreadFinalizeContLines (ClientData clientData);
static ThreadSpecificData* TclGetContLineTable (void);

/*
 * Nested Tcl_Obj deletion management support
 *
 * All context references used in the object freeing code are pointers to this
 * structure; every thread will have its own structure instance. The purpose
 * of this structure is to allow deeply nested collections of Tcl_Objs to be
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
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







-
+

-
-
+
+

-
-
+
+





-
+


-
+
-
-
-
-



-
-
+
+







-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







+




+
+
+
+







 * These are separated out so that some semantic content is attached
 * to them.
 */
#define ObjDeletionLock(contextPtr)	((contextPtr)->deletionCount++)
#define ObjDeletionUnlock(contextPtr)	((contextPtr)->deletionCount--)
#define ObjDeletePending(contextPtr)	((contextPtr)->deletionCount > 0)
#define ObjOnStack(contextPtr)		((contextPtr)->deletionStack != NULL)
#define PushObjToDelete(contextPtr,objPtr)                              \
#define PushObjToDelete(contextPtr,objPtr) \
    /* The string rep is already invalidated so we can use the bytes value \
     * for our pointer chain: push onto the head of the stack. */       \
    (objPtr)->bytes = (char *) ((contextPtr)->deletionStack);           \
     * for our pointer chain: push onto the head of the stack. */ \
    (objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
    (contextPtr)->deletionStack = (objPtr)
#define PopObjToDelete(contextPtr,objPtrVar)                            \
    (objPtrVar) = (contextPtr)->deletionStack;                          \
#define PopObjToDelete(contextPtr,objPtrVar) \
    (objPtrVar) = (contextPtr)->deletionStack; \
    (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes

/*
 * Macro to set up the local reference to the deletion context.
 */
#if !TCL_THREADS
#ifndef TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
    PendingObjData *CONST contextPtr = &pendingObjData
#elif defined(HAVE_FAST_TSD)
static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#else
static Tcl_ThreadDataKey pendingObjDataKey;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr =     \
	    (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
    PendingObjData *CONST contextPtr = (PendingObjData *) \
	    Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
#endif

/*
 * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
 */

#define PACK_BIGNUM(bignum, objPtr) \
    if ((bignum).used > 0x7FFF) {                                   \
	mp_int *temp = (mp_int *)Tcl_Alloc(sizeof(mp_int));               \
	*temp = bignum;                                                 \
	(objPtr)->internalRep.twoPtrValue.ptr1 = temp;                  \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1);           \
    } else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \
	(objPtr)->internalRep.twoPtrValue.ptr1 = (bignum).dp;           \
	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR( ((bignum).sign << 30) \
		| ((bignum).alloc << 15) | ((bignum).used));            \
    if ((bignum).used > 0x7fff) { \
	mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
	*temp = bignum; \
	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) temp; \
	(objPtr)->internalRep.ptrAndLongRep.value = (unsigned long)(-1); \
    } else { \
	if ((bignum).alloc > 0x7fff) { \
	    mp_shrink(&(bignum)); \
	} \
	(objPtr)->internalRep.ptrAndLongRep.ptr = (void*) (bignum).dp; \
	(objPtr)->internalRep.ptrAndLongRep.value = ( (mp_isneg(&bignum) << 30) \
		| ((bignum).alloc << 15) | ((bignum).used)); \
    }

#define UNPACK_BIGNUM(objPtr, bignum) \
    if ((objPtr)->internalRep.ptrAndLongRep.value == (unsigned long)(-1)) { \
	(bignum) = *((mp_int *) ((objPtr)->internalRep.ptrAndLongRep.ptr)); \
    } else { \
	(bignum).dp = (mp_digit*) (objPtr)->internalRep.ptrAndLongRep.ptr; \
	(bignum).sign = (objPtr)->internalRep.ptrAndLongRep.value >> 30; \
	(bignum).alloc = \
		((objPtr)->internalRep.ptrAndLongRep.value >> 15) & 0x7fff; \
	(bignum).used = (objPtr)->internalRep.ptrAndLongRep.value & 0x7fff; \
    }

/*
 * Prototypes for functions defined later in this file:
 */

static int		ParseBoolean(Tcl_Obj *objPtr);
static int		SetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int		SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfDouble(Tcl_Obj *objPtr);
static void		UpdateStringOfInt(Tcl_Obj *objPtr);
#ifndef NO_WIDE_TYPE
static void		UpdateStringOfWideInt(Tcl_Obj *objPtr);
static int		SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
static void		FreeBignum(Tcl_Obj *objPtr);
static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    int copy, mp_int *bignumValue);

/*
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
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







+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
-
-
+
+
+
+
+
+






-
+

-
+



















-
-
-
-
-
-
-
-


-
-
-
-
-
-
+
+
+
+
+
+















-
+




-
+




-
+





-
+







/*
 * The structures below defines the Tcl object types defined in this file by
 * means of functions that can be invoked by generic object code. See also
 * tclStringObj.c, tclListObj.c, tclByteCode.c for other type manager
 * implementations.
 */

static Tcl_ObjType oldBooleanType = {
    "boolean",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetBooleanFromAny			/* setFromAnyProc */
};
const Tcl_ObjType tclBooleanType = {
    "boolean",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    NULL,			/* updateStringProc */
    TclSetBooleanFromAny		/* setFromAnyProc */
Tcl_ObjType tclBooleanType = {
    "booleanString",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetBooleanFromAny			/* setFromAnyProc */
};
const Tcl_ObjType tclDoubleType = {
    "double",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfDouble,	/* updateStringProc */
    SetDoubleFromAny		/* setFromAnyProc */
Tcl_ObjType tclDoubleType = {
    "double",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfDouble,		/* updateStringProc */
    SetDoubleFromAny			/* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
    "int",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfInt,		/* updateStringProc */
    SetIntFromAny		/* setFromAnyProc */
Tcl_ObjType tclIntType = {
    "int",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfInt,			/* updateStringProc */
    SetIntFromAny			/* setFromAnyProc */
};
#ifndef NO_WIDE_TYPE
Tcl_ObjType tclWideIntType = {
    "wideInt",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfWideInt,		/* updateStringProc */
    SetWideIntFromAny			/* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
    "bignum",			/* name */
    FreeBignum,			/* freeIntRepProc */
    DupBignum,			/* dupIntRepProc */
    UpdateStringOfBignum,	/* updateStringProc */
    NULL			/* setFromAnyProc */
Tcl_ObjType tclBignumType = {
    "bignum",				/* name */
    FreeBignum,				/* freeIntRepProc */
    DupBignum,				/* dupIntRepProc */
    UpdateStringOfBignum,		/* updateStringProc */
    NULL				/* setFromAnyProc */
};

/*
 * The structure below defines the Tcl obj hash key type.
 */

const Tcl_HashKeyType tclObjHashKeyType = {
Tcl_HashKeyType tclObjHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,	/* version */
    0,				/* flags */
    TCL_HASH_KEY_DIRECT_COMPARE,/* allows compare keys by pointers */
    TclHashObjKey,		/* hashKeyProc */
    TclCompareObjKeys,		/* compareKeysProc */
    AllocObjEntry,		/* allocEntryProc */
    TclFreeObjEntry		/* freeEntryProc */
};

/*
 * The structure below defines the command name Tcl object type by means of
 * functions that can be invoked by generic object code. Objects of this type
 * cache the Command pointer that results from looking up command names in the
 * command hashtable. Such objects appear as the zeroth ("command name")
 * argument in a Tcl command.
 *
 * NOTE: the ResolvedCmdName that gets cached is stored in the
 * twoPtrValue.ptr1 field, and the twoPtrValue.ptr2 field is unused. You might
 * think you could use the simpler otherValuePtr field to store the single
 * ResolvedCmdName pointer, but DO NOT DO THIS. It seems that some extensions
 * use the second internal pointer field of the twoPtrValue field for their
 * own purposes.
 *
 * TRICKY POINT! Some extensions update this structure! (Notably, these
 * include TclBlend and TCom). This is highly ill-advised on their part, but
 * does allow them to delete a command when references to it are gone, which
 * is fragile but useful given their somewhat-OO style. Because of this, this
 * structure MUST NOT be const so that the C compiler puts the data in
 * writable memory. [Bug 2558422] [Bug 07d13d99b0a9]
 * TODO: Provide a better API for those extensions so that they can coexist...
 */

Tcl_ObjType tclCmdNameType = {
    "cmdName",			/* name */
    FreeCmdNameInternalRep,	/* freeIntRepProc */
    DupCmdNameInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetCmdNameFromAny		/* setFromAnyProc */
static Tcl_ObjType tclCmdNameType = {
    "cmdName",				/* name */
    FreeCmdNameInternalRep,		/* freeIntRepProc */
    DupCmdNameInternalRep,		/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetCmdNameFromAny			/* setFromAnyProc */
};

/*
 * Structure containing a cached pointer to a command that is the result of
 * resolving the command's name in some namespace. It is the internal
 * representation for a cmdName object. It contains the pointer along with
 * some information that is used to check the pointer's validity.
 */

typedef struct ResolvedCmdName {
    Command *cmdPtr;		/* A cached Command pointer. */
    Namespace *refNsPtr;	/* Points to the namespace containing the
				 * reference (not the namespace that contains
				 * the referenced command). NULL if the name
				 * is fully qualified.*/
    size_t refNsId;		/* refNsPtr's unique namespace id. Used to
    long refNsId;		/* refNsPtr's unique namespace id. Used to
				 * verify that refNsPtr is still valid (e.g.,
				 * it's possible that the cmd's containing
				 * namespace was deleted and a new one created
				 * at the same address). */
    size_t refNsCmdEpoch;	/* Value of the referencing namespace's
    int refNsCmdEpoch;		/* Value of the referencing namespace's
				 * cmdRefEpoch when the pointer was cached.
				 * Before using the cached pointer, we check
				 * if the namespace's epoch was incremented;
				 * if so, this cached pointer is invalid. */
    size_t cmdEpoch;		/* Value of the command's cmdEpoch when this
    int cmdEpoch;		/* Value of the command's cmdEpoch when this
				 * pointer was cached. Before using the cached
				 * pointer, we check if the cmd's epoch was
				 * incremented; if so, the cmd was renamed,
				 * deleted, hidden, or exposed, and so the
				 * pointer is invalid. */
    size_t refCount;		/* Reference count: 1 for each cmdName object
    int refCount;		/* Reference count: 1 for each cmdName object
				 * that has a pointer to this ResolvedCmdName
				 * structure as its internal rep. This
				 * structure can be freed when refCount
				 * becomes zero. */
} ResolvedCmdName;

/*
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







+
+




+



+
+
+
+
+
+







-







    Tcl_MutexLock(&tableMutex);
    typeTableInitialized = 1;
    Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
    Tcl_MutexUnlock(&tableMutex);

    Tcl_RegisterObjType(&tclByteArrayType);
    Tcl_RegisterObjType(&tclDoubleType);
    Tcl_RegisterObjType(&tclEndOffsetType);
    Tcl_RegisterObjType(&tclIntType);
    Tcl_RegisterObjType(&tclStringType);
    Tcl_RegisterObjType(&tclListType);
    Tcl_RegisterObjType(&tclDictType);
    Tcl_RegisterObjType(&tclByteCodeType);
    Tcl_RegisterObjType(&tclArraySearchType);
    Tcl_RegisterObjType(&tclCmdNameType);
    Tcl_RegisterObjType(&tclRegexpType);
    Tcl_RegisterObjType(&tclProcBodyType);

    /* For backward compatibility only ... */
    Tcl_RegisterObjType(&oldBooleanType);
#ifndef NO_WIDE_TYPE
    Tcl_RegisterObjType(&tclWideIntType);
#endif

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    tclObjsAlloced = 0;
    tclObjsFreed = 0;
    {
	int i;

	for (i=0 ; i<TCL_MAX_SHARED_OBJ_STATS ; i++) {
	    tclObjsShared[i] = 0;
	}
    }
    Tcl_MutexUnlock(&tclObjMutex);
#endif
}
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
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







-
+








-
+


-
+




-
+







 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadObjects(void)
{
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);
	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		Tcl_Free(objData);
		ckfree((char *) objData);
	    }
	}

	Tcl_DeleteHashTable(tablePtr);
	Tcl_Free(tablePtr);
	ckfree((char *) tablePtr);
	tsdPtr->objThreadMap = NULL;
    }
#endif
}

/*
 *----------------------------------------------------------------------
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
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







-
-
+
+










-

-
+

-
+







 * Side effects:
 *	May allocate memory for the thread-data.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

static ThreadSpecificData *
TclGetContLineTable(void)
static ThreadSpecificData*
TclGetContLineTable()
{
    /*
     * Initialize the hashtable tracking invisible continuation lines.  For
     * the release we use a thread exit handler to ensure that this is done
     * before TSD blocks are made invalid. The TclFinalizeObjects() which
     * would be the natural place for this is invoked afterwards, meaning that
     * we try to operate on a data structure already gone.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->lineCLPtr) {
	tsdPtr->lineCLPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	tsdPtr->lineCLPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable));
	Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
	Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
	Tcl_CreateThreadExitHandler (TclThreadFinalizeContLines,NULL);
    }
    return tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
-
+
+
-
-
-
+
+



-
-
-
+
+
+
+
+


















-
-
-
+
+
+


-
+



-
-
-
+
+
+







 * Side effects:
 *	Allocates memory for the table of continuation line locations.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

ContLineLoc *
TclContinuationsEnter(
ContLineLoc*
TclContinuationsEnter(Tcl_Obj* objPtr,
    Tcl_Obj *objPtr,
    int num,
    int *loc)
		      int num,
		      int* loc)
{
    int newEntry;
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
    ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1) *sizeof(int));
    Tcl_HashEntry* hPtr =
	Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry);

    ContLineLoc* clLocPtr =
	(ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int));

    if (!newEntry) {
	/*
	 * We're entering ContLineLoc data for the same value more than one
	 * time. Taking care not to leak the old entry.
	 *
	 * This can happen when literals in a proc body are shared. See for
	 * example test info-30.19 where the action (code) for all branches of
	 * the switch command is identical, mapping them all to the same
	 * literal. An interesting result of this is that the number and
	 * locations (offset) of invisible continuation lines in the literal
	 * are the same for all occurences.
	 *
	 * Note that while reusing the existing entry is possible it requires
	 * the same actions as for a new entry because we have to copy the
	 * incoming num/loc data even so. Because we are called from
	 * TclContinuationsEnterDerived for this case, which modified the
	 * stored locations (Rebased to the proper relative offset). Just
	 * returning the stored entry would rebase them a second time, or
	 * more, hosing the data. It is easier to simply replace, as we are
	 * doing.
	 * returning the stored entry and data would rebase them a second
	 * time, or more, hosing the data. It is easier to simply replace, as
	 * we are doing.
	 */

	Tcl_Free(Tcl_GetHashValue(hPtr));
	ckfree((char *) Tcl_GetHashValue(hPtr));
    }

    clLocPtr->num = num;
    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
    clLocPtr->loc[num] = CLL_END;       /* Sentinel */
    Tcl_SetHashValue(hPtr, clLocPtr);
    memcpy (&clLocPtr->loc, loc, num*sizeof(int));
    clLocPtr->loc[num] = CLL_END; /* Sentinel */
    Tcl_SetHashValue (hPtr, clLocPtr);

    return clLocPtr;
}

/*
 *----------------------------------------------------------------------
 *
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
618
619
620

621
622
623



624
625




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
621
622
623
624
625
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
686
687
688
689
690
691
692







-
+
-
-
-

-
-
-
-




















-
+
-


+
+
+
-
-
+
+
+
+


-
+
+







-
+
+





+
-
+





-
+







 *	Allocates memory for the table of continuation line locations.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclContinuationsEnterDerived(
TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext)
    Tcl_Obj *objPtr,
    int start,
    int *clNext)
{
    size_t length;
    int end, num;
    int *wordCLLast = clNext;

    /*
     * We have to handle invisible continuations lines here as well, despite
     * the code we have in TclSubstTokens (TST) for that. Why ?  Nesting. If
     * our script is the sole argument to an 'eval' command, for example, the
     * scriptCLLocPtr we are using was generated by a previous call to TST,
     * and while the words we have here may contain continuation lines they
     * are invisible already, and the inner call to TST had no bs+nl sequences
     * to trigger its code.
     *
     * Luckily for us, the table we have to create here for the current word
     * has to be a slice of the table currently in use, with the locations
     * suitably modified to be relative to the start of the word instead of
     * relative to the script.
     *
     * That is what we are doing now. Determine the slice we need, and if not
     * empty, wrap it into a new table, and save the result into our
     * thread-global hashtable, as usual.
     */

    /*
     * First compute the range of the word within the script. (Is there a
     * First compute the range of the word within the script.
     * better way which doesn't shimmer?)
     */

    int length, end, num;
    int* wordCLLast = clNext;

    (void)TclGetStringFromObj(objPtr, &length);
    end = start + length;       /* First char after the word */
    Tcl_GetStringFromObj(objPtr, &length);
    /* Is there a better way which doesn't shimmer ? */

    end = start + length; /* first char after the word */

    /*
     * Then compute the table slice covering the range of the word.
     * Then compute the table slice covering the range of
     * the word.
     */

    while (*wordCLLast >= 0 && *wordCLLast < end) {
	wordCLLast++;
    }

    /*
     * And generate the table from the slice, if it was not empty.
     * And generate the table from the slice, if it was
     * not empty.
     */

    num = wordCLLast - clNext;
    if (num) {
	int i;
	ContLineLoc* clLocPtr =
	ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
	    TclContinuationsEnter(objPtr, num, clNext);

	/*
	 * Re-base the locations.
	 */

	for (i=0 ; i<num ; i++) {
	for (i=0;i<num;i++) {
	    clLocPtr->loc[i] -= start;

	    /*
	     * Continuation lines coming before the string and affecting us
	     * should not happen, due to the proper maintenance of clNext
	     * during compilation.
	     */
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
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







-
-
-
+
+
+












-
+
-
-


-
+
-


-
+














-
-
+
+








-
-
+
+
-


-
+
-

-
-
+
+
+
+

-








/*
 *----------------------------------------------------------------------
 *
 * TclContinuationsCopy --
 *
 *	This procedure is a helper which copies the continuation line
 *	information associated with a Tcl_Obj* to another Tcl_Obj*. It is
 *	assumed that both contain the same string/script. Use this when a
 *	script is duplicated because it was shared.
 *	information associated with a Tcl_Obj* to another Tcl_Obj*.
 *	It is assumed that both contain the same string/script. Use
 *	this when a script is duplicated because it was shared.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates memory for the table of continuation line locations.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

void
TclContinuationsCopy(
TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr)
    Tcl_Obj *objPtr,
    Tcl_Obj *originObjPtr)
{
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) originObjPtr);
            Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);

    if (hPtr) {
	ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_GetHashValue(hPtr);
	ContLineLoc* clLocPtr = (ContLineLoc*) Tcl_GetHashValue (hPtr);

	TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclContinuationsGet --
 *
 *	This procedure is a helper which retrieves the continuation line
 *	information associated with a Tcl_Obj*, if it has any.
 *
 * Results:
 *	A reference to the continuation line location table, or NULL if the
 *	Tcl_Obj* has no such information associated with it.
 *	A reference to the continuation line location table, or NULL
 *	if the Tcl_Obj* has no such information associated with it.
 *
 * Side effects:
 *	None.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

ContLineLoc *
TclContinuationsGet(
ContLineLoc*
TclContinuationsGet(Tcl_Obj* objPtr)
    Tcl_Obj *objPtr)
{
    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr =
    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) objPtr);
            Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);

    if (!hPtr) {
        return NULL;
    if (hPtr) {
	return (ContLineLoc*) Tcl_GetHashValue (hPtr);
    } else {
	return NULL;
    }
    return (ContLineLoc *)Tcl_GetHashValue(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclThreadFinalizeContLines --
 *
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
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







-
+
-










+
-
-
-
+
+
+
+
+
+
+
+
+

-
-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	Releases memory.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

static void
TclThreadFinalizeContLines(
TclThreadFinalizeContLines (ClientData clientData)
    TCL_UNUSED(ClientData))
{
    /*
     * Release the hashtable tracking invisible continuation lines.
     */

    ThreadSpecificData *tsdPtr = TclGetContLineTable();
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
	 hPtr != NULL;
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
	Tcl_Free(Tcl_GetHashValue(hPtr));
	Tcl_DeleteHashEntry(hPtr);
	 hPtr = Tcl_NextHashEntry(&hSearch)) {
	/*
	 * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because
	 * here we can be sure that the compiler will not hold references to
	 * the data in the hashtable, and using TEF might bork the
	 * finalization sequence.
	 */
	ContLineLocFree (Tcl_GetHashValue (hPtr));
	Tcl_DeleteHashEntry (hPtr);
    }
    Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
    Tcl_Free(tsdPtr->lineCLPtr);
    Tcl_DeleteHashTable (tsdPtr->lineCLPtr);
    ckfree((char *) tsdPtr->lineCLPtr);
    tsdPtr->lineCLPtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ContLineLocFree --
 *
 *	The freProc for continuation line location tables.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Releases memory.
 *
 * TIP #280
 *----------------------------------------------------------------------
 */

static void
ContLineLocFree (char* clientData)
{
    ckfree (clientData);
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_RegisterObjType --
 *
 *	This function is called to register a new Tcl object type in the table
787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
849
850
851
852
853
854
855

856
857
858
859
860
861
862
863







-
+







 *	type.
 *
 *--------------------------------------------------------------
 */

void
Tcl_RegisterObjType(
    const Tcl_ObjType *typePtr)	/* Information about object type; storage must
    Tcl_ObjType *typePtr)	/* Information about object type; storage must
				 * be statically allocated (must live
				 * forever). */
{
    int isNew;

    Tcl_MutexLock(&tableMutex);
    Tcl_SetHashValue(
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
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







-
+




















-
+







int
Tcl_AppendAllObjTypes(
    Tcl_Interp *interp,		/* Interpreter used for error reporting. */
    Tcl_Obj *objPtr)		/* Points to the Tcl object onto which the
				 * name of each registered type is appended as
				 * a list element. */
{
    Tcl_HashEntry *hPtr;
    register Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int numElems;

    /*
     * Get the test for a valid list out of the way first.
     */

    if (TclListObjLength(interp, objPtr, &numElems) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Type names are NUL-terminated, not counted strings. This code relies on
     * that.
     */

    Tcl_MutexLock(&tableMutex);
    for (hPtr = Tcl_FirstHashEntry(&typeTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_ListObjAppendElement(NULL, objPtr,
		Tcl_NewStringObj((char *)Tcl_GetHashKey(&typeTable, hPtr), -1));
		Tcl_NewStringObj(Tcl_GetHashKey(&typeTable, hPtr), -1));
    }
    Tcl_MutexUnlock(&tableMutex);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
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
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







-
+

-
+

-
-
+
+




-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const Tcl_ObjType *
Tcl_ObjType *
Tcl_GetObjType(
    const char *typeName)	/* Name of Tcl object type to look up. */
    CONST char *typeName)	/* Name of Tcl object type to look up. */
{
    Tcl_HashEntry *hPtr;
    const Tcl_ObjType *typePtr = NULL;
    register Tcl_HashEntry *hPtr;
    Tcl_ObjType *typePtr = NULL;

    Tcl_MutexLock(&tableMutex);
    hPtr = Tcl_FindHashEntry(&typeTable, typeName);
    if (hPtr != NULL) {
	typePtr = (const Tcl_ObjType *)Tcl_GetHashValue(hPtr);
	typePtr = (Tcl_ObjType *) Tcl_GetHashValue(hPtr);
    }
    Tcl_MutexUnlock(&tableMutex);
    return typePtr;
}

/*
 *----------------------------------------------------------------------
914
915
916
917
918
919
920
921

922
923
924
925
926
927
928
976
977
978
979
980
981
982

983
984
985
986
987
988
989
990







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_ConvertToType(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object to convert. */
    const Tcl_ObjType *typePtr)	/* The target type. */
    Tcl_ObjType *typePtr)	/* The target type. */
{
    if (objPtr->typePtr == typePtr) {
	return TCL_OK;
    }

    /*
     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
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
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







-




+








-
+


-
+












-
-
+
-
-
-
-

-







 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------
 */

#if TCL_THREADS && defined(TCL_MEM_DEBUG)
void
TclDbDumpActiveObjects(
    FILE *outFile)
{
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
    Tcl_HashSearch hSearch;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	fprintf(outFile, "total objects: %" TCL_Z_MODIFIER "u\n", tablePtr->numEntries);
	fprintf(outFile, "total objects: %d\n", tablePtr->numEntries);
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&hSearch)) {
	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);
	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		fprintf(outFile,
			"key = 0x%p, objPtr = 0x%p, file = %s, line = %d\n",
			Tcl_GetHashKey(tablePtr, hPtr), objData->objPtr,
			objData->file, objData->line);
	    } else {
		fprintf(outFile, "key = 0x%p\n",
			Tcl_GetHashKey(tablePtr, hPtr));
	    }
	}
    }
}
#else
#endif
void
TclDbDumpActiveObjects(
    TCL_UNUSED(FILE *))
{
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclDbInitNewObj --
 *
 *	Called via the TclNewObj or TclDbNewObj macros when TCL_MEM_DEBUG is
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
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







-
-
+
+

-
+



+
+

-

-
+













-
+
+



-
+








-
+







 *	None.
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
TclDbInitNewObj(
    Tcl_Obj *objPtr,
    const char *file,	/* The name of the source file calling this
    register Tcl_Obj *objPtr,
    register CONST char *file,	/* The name of the source file calling this
				 * function; used for debugging. */
    int line)		/* Line number in the source file; used for
    register int line)		/* Line number in the source file; used for
				 * debugging. */
{
    objPtr->refCount = 0;
    objPtr->bytes = tclEmptyStringRep;
    objPtr->length = 0;
    objPtr->typePtr = NULL;
    TclInitStringRep(objPtr, NULL, 0);

#if TCL_THREADS
#ifdef TCL_THREADS
    /*
     * Add entry to a thread local map used to check if a Tcl_Obj was
     * allocated by the currently executing thread.
     */

    if (!TclInExit()) {
	Tcl_HashEntry *hPtr;
	Tcl_HashTable *tablePtr;
	int isNew;
	ObjData *objData;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	if (tsdPtr->objThreadMap == NULL) {
	    tsdPtr->objThreadMap = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	    tsdPtr->objThreadMap = (Tcl_HashTable *)
		    ckalloc(sizeof(Tcl_HashTable));
	    Tcl_InitHashTable(tsdPtr->objThreadMap, TCL_ONE_WORD_KEYS);
	}
	tablePtr = tsdPtr->objThreadMap;
	hPtr = Tcl_CreateHashEntry(tablePtr, objPtr, &isNew);
	hPtr = Tcl_CreateHashEntry(tablePtr, (char *) objPtr, &isNew);
	if (!isNew) {
	    Tcl_Panic("expected to create new entry for object map");
	}

	/*
	 * Record the debugging information.
	 */

	objData = (ObjData *)Tcl_Alloc(sizeof(ObjData));
	objData = (ObjData *) ckalloc(sizeof(ObjData));
	objData->objPtr = objPtr;
	objData->file = file;
	objData->line = line;
	Tcl_SetHashValue(hPtr, objData);
    }
#endif /* TCL_THREADS */
}
1101
1102
1103
1104
1105
1106
1107
1108

1109
1110
1111
1112
1113
1114
1115
1159
1160
1161
1162
1163
1164
1165

1166
1167
1168
1169
1170
1171
1172
1173







-
+







}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewObj(void)
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    /*
     * Use the macro defined in tclInt.h - it will use the correct allocator.
     */

    TclNewObj(objPtr);
    return objPtr;
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
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







-
+

-
+


-
+












-
-
+
+
+
+











-
+







 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewObj(
    const char *file,	/* The name of the source file calling this
    register CONST char *file,	/* The name of the source file calling this
				 * function; used for debugging. */
    int line)		/* Line number in the source file; used for
    register int line)		/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    /*
     * Use the macro defined in tclInt.h - it will use the correct allocator.
     */

    TclDbNewObj(objPtr, file, line);
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewObj(
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewObj();
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * TclAllocateFreeObjects --
 *
 *	Function to allocate a number of free Tcl_Objs. This is done using a
 *	single Tcl_Alloc to reduce the overhead for Tcl_Obj allocation.
 *	single ckalloc to reduce the overhead for Tcl_Obj allocation.
 *
 *	Assumes mutex is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
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
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







-
-
+
+





-
+




-
+




-
+







#define OBJS_TO_ALLOC_EACH_TIME 100

void
TclAllocateFreeObjects(void)
{
    size_t bytesToAlloc = (OBJS_TO_ALLOC_EACH_TIME * sizeof(Tcl_Obj));
    char *basePtr;
    Tcl_Obj *prevPtr, *objPtr;
    int i;
    register Tcl_Obj *prevPtr, *objPtr;
    register int i;

    /*
     * This has been noted by Purify to be a potential leak. The problem is
     * that Tcl, when not TCL_MEM_DEBUG compiled, keeps around all allocated
     * Tcl_Obj's, pointed to by tclFreeObjList, when freed instead of actually
     * freeing the memory. TclFinalizeObjects() does not Tcl_Free() this memory,
     * freeing the memory. TclFinalizeObjects() does not ckfree() this memory,
     * but leaves it to Tcl's memory subsystem finalization to release it.
     * Purify apparently can't figure that out, and fires a false alarm.
     */

    basePtr = (char *)Tcl_Alloc(bytesToAlloc);
    basePtr = (char *) ckalloc(bytesToAlloc);

    prevPtr = NULL;
    objPtr = (Tcl_Obj *) basePtr;
    for (i = 0; i < OBJS_TO_ALLOC_EACH_TIME; i++) {
	objPtr->internalRep.twoPtrValue.ptr1 = prevPtr;
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) prevPtr;
	prevPtr = objPtr;
	objPtr++;
    }
    tclFreeObjList = prevPtr;
}
#undef OBJS_TO_ALLOC_EACH_TIME

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
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







-
+

-
+







-
+







 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
TclFreeObj(
    Tcl_Obj *objPtr)	/* The object to be freed. */
    register Tcl_Obj *objPtr)	/* The object to be freed. */
{
    const Tcl_ObjType *typePtr = objPtr->typePtr;
    register Tcl_ObjType *typePtr = objPtr->typePtr;

    /*
     * This macro declares a variable, so must come here...
     */

    ObjInitDeletionContext(context);

#if TCL_THREADS
# ifdef TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
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
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
1385



1386
1387
1388
1389

1390
1391
1392
1393
1394
1395
1396
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
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




1439
1440
1441

1442
1443

1444
1445
1446
1447
1448
1449
1450
1451







-
+


-
+













-
-
+
+






-
+

-
-
-
-
+
+
+
-


-
+












-
+






-
+




-
+








-
-
-
-
-
-
+
+
+
+
+
+
+



-
+
-
-

-
+

-
-
+
+








-
+

-
-
-
-
+
+
+
-


-
+







	}
	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
	if (hPtr) {
	    /*
	     * As the Tcl_Obj is going to be deleted we remove the entry.
	     */

	    ObjData *objData = (ObjData *)Tcl_GetHashValue(hPtr);
	    ObjData *objData = Tcl_GetHashValue(hPtr);

	    if (objData != NULL) {
		Tcl_Free(objData);
		ckfree((char *) objData);
	    }

	    Tcl_DeleteHashEntry(hPtr);
	}
    }
# endif

    /*
     * Check for a double free of the same value.  This is slightly tricky
     * because it is customary to free a Tcl_Obj when its refcount falls
     * either from 1 to 0, or from 0 to -1.  Falling from -1 to -2, though,
     * and so on, is always a sign of a botch in the caller.
     */
    if (objPtr->refCount == (size_t)-2) {
	Tcl_Panic("Reference count for %p was negative", objPtr);
    if (objPtr->refCount < -1) {
	Tcl_Panic("Reference count for %lx was negative", objPtr);
    }
    /*
     * Now, in case we just approved drop from 1 to 0 as acceptable, make
     * sure we do not accept a second free when falling from 0 to -1.
     * Skip that possibility so any double free will trigger the panic.
     */
    objPtr->refCount = TCL_INDEX_NONE;
    objPtr->refCount = -1;

    /*
     * Invalidate the string rep first so we can use the bytes value for our
     * pointer chain, and signal an obj deletion (as opposed to shimmering)
     * with 'length == TCL_INDEX_NONE'.
    /* Invalidate the string rep first so we can use the bytes value
     * for our pointer chain, and signal an obj deletion (as opposed
     * to shimmering) with 'length == -1' */
     */

    TclInvalidateStringRep(objPtr);
    objPtr->length = TCL_INDEX_NONE;
    objPtr->length = -1;

    if (ObjDeletePending(context)) {
	PushObjToDelete(context, objPtr);
    } else {
	TCL_DTRACE_OBJ_FREE(objPtr);
	if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
	    ObjDeletionLock(context);
	    typePtr->freeIntRepProc(objPtr);
	    ObjDeletionUnlock(context);
	}

	Tcl_MutexLock(&tclObjMutex);
	Tcl_Free(objPtr);
	ckfree((char *) objPtr);
	Tcl_MutexUnlock(&tclObjMutex);
	TclIncrObjsFreed();
	ObjDeletionLock(context);
	while (ObjOnStack(context)) {
	    Tcl_Obj *objToFree;

	    PopObjToDelete(context, objToFree);
	    PopObjToDelete(context,objToFree);
	    TCL_DTRACE_OBJ_FREE(objToFree);
	    TclFreeIntRep(objToFree);

	    Tcl_MutexLock(&tclObjMutex);
	    Tcl_Free(objToFree);
	    ckfree((char *) objToFree);
	    Tcl_MutexUnlock(&tclObjMutex);
	    TclIncrObjsFreed();
	}
	ObjDeletionUnlock(context);
    }

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     * re-initialize the thread-data for calls coming after the
     * finalization. We have to access it using the low-level call and then
     * check for validity. This function can be called after
     * TclFinalizeThreadData() has already killed the thread-global data
     * structures. Performing TCL_TSD_INIT will leave us with an
     * un-initialized memory block upon which we crash (if we where to access
     * the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
		Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
		Tcl_DeleteHashEntry (hPtr);
	    }
	}
    }
}
#else /* TCL_MEM_DEBUG */

void
TclFreeObj(
    Tcl_Obj *objPtr)	/* The object to be freed. */
    register Tcl_Obj *objPtr)	/* The object to be freed. */
{
    /*
     * Invalidate the string rep first so we can use the bytes value for our
     * pointer chain, and signal an obj deletion (as opposed to shimmering)
     * with 'length == -1'.
    /* Invalidate the string rep first so we can use the bytes value
     * for our pointer chain, and signal an obj deletion (as opposed
     * to shimmering) with 'length == -1' */
     */

    TclInvalidateStringRep(objPtr);
    objPtr->length = TCL_INDEX_NONE;
    objPtr->length = -1;

    if (!objPtr->typePtr || !objPtr->typePtr->freeIntRepProc) {
	/*
	 * objPtr can be freed safely, as it will not attempt to free any
	 * other objects: it will not cause recursive calls to this function.
	 */

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
1458
1459

1460
1461
1462


1463
1464
1465
1466
1467

1468
1469
1470
1471
1472
1473
1474
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







-
-
+














-
-
-
-
-
-
+
+
+
+
+
+
+



-
+
-
-

-
+

-
-
+
+




-
+







	    ObjDeletionUnlock(context);

	    TclFreeObjStorage(objPtr);
	    TclIncrObjsFreed();
	    ObjDeletionLock(context);
	    while (ObjOnStack(context)) {
		Tcl_Obj *objToFree;

		PopObjToDelete(context, objToFree);
		PopObjToDelete(context,objToFree);
		TCL_DTRACE_OBJ_FREE(objToFree);
		if ((objToFree->typePtr != NULL)
			&& (objToFree->typePtr->freeIntRepProc != NULL)) {
		    objToFree->typePtr->freeIntRepProc(objToFree);
		}
		TclFreeObjStorage(objToFree);
		TclIncrObjsFreed();
	    }
	    ObjDeletionUnlock(context);
	}
    }

    /*
     * We cannot use TclGetContinuationTable() here, because that may
     * re-initialize the thread-data for calls coming after the finalization.
     * We have to access it using the low-level call and then check for
     * validity. This function can be called after TclFinalizeThreadData() has
     * already killed the thread-global data structures. Performing
     * TCL_TSD_INIT will leave us with an un-initialized memory block upon
     * which we crash (if we where to access the uninitialized hashtable).
     * re-initialize the thread-data for calls coming after the
     * finalization. We have to access it using the low-level call and then
     * check for validity. This function can be called after
     * TclFinalizeThreadData() has already killed the thread-global data
     * structures. Performing TCL_TSD_INIT will leave us with an
     * un-initialized memory block upon which we crash (if we where to access
     * the uninitialized hashtable).
     */

    {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey);
        Tcl_HashEntry *hPtr;

	if (tsdPtr->lineCLPtr) {
            hPtr = Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
	    Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr);
	    if (hPtr) {
		Tcl_Free(Tcl_GetHashValue(hPtr));
		Tcl_DeleteHashEntry(hPtr);
		Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree);
		Tcl_DeleteHashEntry (hPtr);
	    }
	}
    }
}
#endif /* TCL_MEM_DEBUG */
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclObjBeingDeleted --
 *
 *	This function returns 1 when the Tcl_Obj is being deleted. It is
1484
1485
1486
1487
1488
1489
1490
1491

1492

1493
1494
1495
1496
1497
1498
1499
1537
1538
1539
1540
1541
1542
1543

1544
1545
1546
1547
1548
1549
1550
1551
1552
1553







-
+

+







 *----------------------------------------------------------------------
 */

int
TclObjBeingDeleted(
    Tcl_Obj *objPtr)
{
    return (objPtr->length == TCL_INDEX_NONE);
    return (objPtr->length == -1);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_DuplicateObj --
 *
 *	Create and return a new object that is a duplicate of the argument
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544

1545

1546

1547
1548
1549
1550
1551






1552
1553
1554
1555
1556



1557
1558

1559
1560



1561
1562


1563
1564
1565
1566
1567
1568
1569
1570
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+

+
-
+


-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
-
-
+
-
-
+
+
+
-
-
+
+
-







 *	objects it points to will not actually be copied but will be shared
 *	with the duplicate list. That is, the ref counts of the element
 *	objects will be incremented.
 *
 *----------------------------------------------------------------------
 */

#define SetDuplicateObj(dupPtr, objPtr)					\
    {									\
	const Tcl_ObjType *typePtr = (objPtr)->typePtr;			\
	const char *bytes = (objPtr)->bytes;				\
	if (bytes) {							\
	    TclInitStringRep((dupPtr), bytes, (objPtr)->length);	\
	} else {							\
	    (dupPtr)->bytes = NULL;					\
	}								\
	if (typePtr) {							\
	    if (typePtr->dupIntRepProc) {				\
		typePtr->dupIntRepProc((objPtr), (dupPtr));		\
	    } else {							\
		(dupPtr)->internalRep = (objPtr)->internalRep;		\
		(dupPtr)->typePtr = typePtr;				\
	    }								\
	}								\
    }

Tcl_Obj *
Tcl_DuplicateObj(
    Tcl_Obj *objPtr)		/* The object to duplicate. */
    register Tcl_Obj *objPtr)		/* The object to duplicate. */
{
    register Tcl_ObjType *typePtr = objPtr->typePtr;
    Tcl_Obj *dupPtr;
    register Tcl_Obj *dupPtr;

    TclNewObj(dupPtr);
    SetDuplicateObj(dupPtr, objPtr);
    return dupPtr;
}

    if (objPtr->bytes == NULL) {
	dupPtr->bytes = NULL;
    } else if (objPtr->bytes != tclEmptyStringRep) {
	TclInitStringRep(dupPtr, objPtr->bytes, objPtr->length);
    }

void
TclSetDuplicateObj(
    Tcl_Obj *dupPtr,
    Tcl_Obj *objPtr)
    if (typePtr != NULL) {
	if (typePtr->dupIntRepProc == NULL) {
	    dupPtr->internalRep = objPtr->internalRep;
{
    if (Tcl_IsShared(dupPtr)) {
	    dupPtr->typePtr = typePtr;
	Tcl_Panic("%s called with shared object", "TclSetDuplicateObj");
    }
	} else {
	    (*typePtr->dupIntRepProc)(objPtr, dupPtr);
	}
    TclInvalidateStringRep(dupPtr);
    TclFreeIntRep(dupPtr);
    }
    return dupPtr;
    SetDuplicateObj(dupPtr, objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetString --
 *
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
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







-
+


-
+
-
-
-
-
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-







 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetString(
    Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
				 * be returned. */
{
    if (objPtr->bytes == NULL) {
    if (objPtr->bytes != NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
	return objPtr->bytes;
	 * extensions fail to maintain that invariant, we can crash here.
	 */

	if (objPtr->typePtr->updateStringProc == NULL) {
    }

    if (objPtr->typePtr->updateStringProc == NULL) {
	    /*
	     * Those Tcl_ObjTypes which choose not to define an
	     * updateStringProc must be written in such a way that
	     * (objPtr->bytes) never becomes NULL.
	     */
	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		    objPtr->typePtr->name);
	}
	objPtr->typePtr->updateStringProc(objPtr);
	Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		objPtr->typePtr->name);
    }
    (*objPtr->typePtr->updateStringProc)(objPtr);
	if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringFromObj --
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
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
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







-
+

-
+




-
-
-
-
-
-
-

-
-
-
-
-



-
+
-
-
-
-
-
-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *	representation from the internal representation.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_GetStringFromObj(
    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
    register Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
				 * be returned. */
    int *lengthPtr)	/* If non-NULL, the location where the string
    register int *lengthPtr)	/* If non-NULL, the location where the string
				 * rep's byte array length should * be stored.
				 * If NULL, no length is stored. */
{
    if (objPtr->bytes == NULL) {
	/*
	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
	 * of a properly maintained Tcl_Obj is that at least  one of
	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
	 * extensions fail to maintain that invariant, we can crash here.
	 */

	if (objPtr->typePtr->updateStringProc == NULL) {
	    /*
	     * Those Tcl_ObjTypes which choose not to define an
	     * updateStringProc must be written in such a way that
	     * (objPtr->bytes) never becomes NULL.
	     */
	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
		    objPtr->typePtr->name);
	}
	objPtr->typePtr->updateStringProc(objPtr);
	(*objPtr->typePtr->updateStringProc)(objPtr);
	if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE
		|| objPtr->bytes[objPtr->length] != '\0') {
	    Tcl_Panic("UpdateStringProc for type '%s' "
		    "failed to create a valid string rep",
		    objPtr->typePtr->name);
	}
    }
    }

    if (lengthPtr != NULL) {
	*lengthPtr = (objPtr->length < INT_MAX)? objPtr->length: INT_MAX;
    }
    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitStringRep --
 *
 *	This function is called in several configurations to provide all
 *	the tools needed to set an object's string representation. The
 *	function is determined by the arguments.
 *
 *	(objPtr->bytes != NULL && bytes != NULL) || (numBytes == -1)
 *	    Invalid call -- panic!
 *
 *	objPtr->bytes == NULL && bytes == NULL && numBytes != -1
 *	    Allocation only - allocate space for (numBytes+1) chars.
 *	    store in objPtr->bytes and return. Also sets
 *	    objPtr->length to 0 and objPtr->bytes[0] to NUL.
 *
 *	objPtr->bytes == NULL && bytes != NULL && numBytes != -1
 *	    Allocate and copy. bytes is assumed to point to chars to
 *	    copy into the string rep. objPtr->length = numBytes. Allocate
 *	    array of (numBytes + 1) chars. store in objPtr->bytes. Copy
 *	    numBytes chars from bytes to objPtr->bytes; Set
 *	    objPtr->bytes[numBytes] to NUL and return objPtr->bytes.
 *	    Caller must guarantee there are numBytes chars at bytes to
 *	    be copied.
 *
 *	objPtr->bytes != NULL && bytes == NULL && numBytes != -1
 *	    Truncate.  Set objPtr->length to numBytes and
 *	    objPr->bytes[numBytes] to NUL.  Caller has to guarantee
 *	    that a prior allocating call allocated enough bytes for
 *	    this to be valid. Return objPtr->bytes.
 *
 *	Caller is expected to ascertain that the bytes copied into
 *	the string rep make up complete valid UTF-8 characters.
 *
 * Results:
 *	A pointer to the string rep of objPtr.
 *
 * Side effects:
 *	As described above.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_InitStringRep(
    Tcl_Obj *objPtr,	/* Object whose string rep is to be set */
    const char *bytes,
    size_t numBytes)
{
    assert(objPtr->bytes == NULL || bytes == NULL);

    /* Allocate */
    if (objPtr->bytes == NULL) {
	/* Allocate only as empty - extend later if bytes copied */
	objPtr->length = 0;
	*lengthPtr = objPtr->length;
	if (numBytes) {
	    objPtr->bytes = (char *)Tcl_AttemptAlloc(numBytes + 1);
	    if (objPtr->bytes == NULL) {
		return NULL;
	    }
    }
	    if (bytes) {
		/* Copy */
		memcpy(objPtr->bytes, bytes, numBytes);
		objPtr->length = numBytes;
	    }
	} else {
	    TclInitStringRep(objPtr, NULL, 0);
	}
    } else {
	/* objPtr->bytes != NULL bytes == NULL - Truncate */
	objPtr->bytes = (char *)Tcl_Realloc(objPtr->bytes, numBytes + 1);
	objPtr->length = numBytes;
    }

    /* Terminate */
    objPtr->bytes[objPtr->length] = '\0';

    return objPtr->bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InvalidateStringRep --
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



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

1893
1894
1895



1896



1897


1898
1899
1900
1901
1902
1903
1904
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







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
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







-
+




-
+
+



-
+

-
+
+
+
+

+
+
+

+
+
+
+
-
+
+



-
-
+
-
-
-
+
+
+
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
+
+
+
-
-
+
+
-
-
+
+
-
-
-
+
+

-
-
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+
-
-
+
+

+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+

+




-
+

-
+
+





-
-
+
+




+

-
-
+
+
+

+
+
+
-
+
+







 *	the string representation NULL to mark it invalid.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InvalidateStringRep(
    Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
    register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
				 * be freed. */
{
    TclInvalidateStringRep(objPtr);
}



/*
 *----------------------------------------------------------------------
 *
 * Tcl_HasStringRep --
 * Tcl_NewBooleanObj --
 *
 *	This function reports whether object has a string representation.
 *	This function is normally called when not debugging: i.e., when
 *	TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
 *	initializes it from the argument boolean value. A nonzero "boolValue"
 *	is coerced to 1.
 *
 *	When TCL_MEM_DEBUG is defined, this function just returns the result
 *	of calling the debugging version Tcl_DbNewBooleanObj.
 *
 * Results:
 *	The newly created object is returned. This object will have an invalid
 *	string representation. The returned object has ref count 0.
 *
 * Side effects:
 *	Boolean.
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_HasStringRep(
#undef Tcl_NewBooleanObj
    Tcl_Obj *objPtr)	/* Object to test */
{
    return TclHasStringRep(objPtr);
#ifdef TCL_MEM_DEBUG

Tcl_Obj *
}

Tcl_NewBooleanObj(
    register int boolValue)	/* Boolean used to initialize new object. */
{
/*
 *----------------------------------------------------------------------
 *
 * Tcl_StoreIntRep --
 *
 *	This function is called to set the object's internal
    return Tcl_DbNewLongObj(boolValue!=0, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */
 *	representation to match a particular type.
 *
 *	It is the caller's responsibility to guarantee that
 *	the value of the submitted IntRep is in agreement with

Tcl_Obj *
Tcl_NewBooleanObj(
    register int boolValue)	/* Boolean used to initialize new object. */
 *	the value of any existing string rep.
 *
{
    register Tcl_Obj *objPtr;

 * Results:
 *	None.
    TclNewIntObj(objPtr, boolValue!=0);
    return objPtr;
 *
 * Side effects:
}
#endif /* TCL_MEM_DEBUG */
 *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
 *	Sets the internalRep and typePtr fields to the submitted values.
 *

/*
 *----------------------------------------------------------------------
 */

 *
void
Tcl_StoreIntRep(
    Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
    const Tcl_ObjType *typePtr,	/* New type for the object */
    const Tcl_ObjIntRep *irPtr)	/* New IntRep for the object */
 * Tcl_DbNewBooleanObj --
 *
 *	This function is normally called when debugging: i.e., when
 *	TCL_MEM_DEBUG is defined. It creates new boolean objects. It is the
 *	same as the Tcl_NewBooleanObj function above except that it calls
 *	Tcl_DbCkalloc directly with the file name and line number from its
{
    /* Clear out any existing IntRep ( "shimmer" ) */
    TclFreeIntRep(objPtr);

 *	caller. This simplifies debugging since then the [memory active]
 *	command will report the correct file name and line number when
 *	reporting objects that haven't been freed.
 *
    /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */
    if (irPtr) {
	/* Copy the new IntRep into place */
	objPtr->internalRep = *irPtr;

	/* Set the type to match */
	objPtr->typePtr = typePtr;
 *	When TCL_MEM_DEBUG is not defined, this function just returns the
 *	result of calling Tcl_NewBooleanObj.
 *
 * Results:
 *	The newly created object is returned. This object will have an invalid
    }
}

/*
 *	string representation. The returned object has ref count 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 *
 */
 * Tcl_FetchIntRep --
 *
 *	This function is called to retrieve the object's internal
 *	representation matching a requested type, if any.
 *

#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG

 * Results:
 *	A read-only pointer to the associated Tcl_ObjIntRep, or
 *	NULL if no such internal representation exists.
 *
 * Side effects:
 *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
Tcl_Obj *
Tcl_DbNewBooleanObj(
    register int boolValue,	/* Boolean used to initialize new object. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    register Tcl_Obj *objPtr;
 *	Sets the internalRep and typePtr fields to the submitted values.
 *

 *----------------------------------------------------------------------
 */
    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;

    objPtr->internalRep.longValue = (boolValue? 1 : 0);
    objPtr->typePtr = &tclIntType;
    return objPtr;
}
Tcl_ObjIntRep *
Tcl_FetchIntRep(
    Tcl_Obj *objPtr,		/* Object to fetch from. */
    const Tcl_ObjType *typePtr)	/* Requested type */

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewBooleanObj(
    register int boolValue,	/* Boolean used to initialize new object. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return TclFetchIntRep(objPtr, typePtr);
    return Tcl_NewBooleanObj(boolValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FreeIntRep --
 * Tcl_SetBooleanObj --
 *
 *	This function is called to free an object's internal representation.
 *	Modify an object to be a boolean object and to have the specified
 *	boolean value. A nonzero "boolValue" is coerced to 1.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
 *	Sets typePtr field to NULL.
 *	The object's old string rep, if any, is freed. Also, any old internal
 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_SetBooleanObj
void
Tcl_FreeIntRep(
    Tcl_Obj *objPtr)	/* Object whose internal rep should be freed. */
Tcl_SetBooleanObj(
    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    register int boolValue)	/* Boolean used to set object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
    }
    TclFreeIntRep(objPtr);

    TclSetIntObj(objPtr, boolValue!=0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBooleanFromObj --
 *
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
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







-
-
-
+
+
+


-
-
+
+
+
+
+
+











-
+











+
+
+
+
+
+








-
+











-
+




-
-
+
+

-
+









-
+
+








+
+
+
+
+
+












-
-
+
+






-






-
+

-
-
-
-
+
+


-
-
+
-
-







 *	The intrep of *objPtr may be changed.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBooleanFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get boolean. */
    int *boolPtr)	/* Place to store resulting boolean. */
    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get boolean. */
    register int *boolPtr)	/* Place to store resulting boolean. */
{
    do {
	if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	if (objPtr->typePtr == &tclIntType) {
	    *boolPtr = (objPtr->internalRep.longValue != 0);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBooleanType) {
	    *boolPtr = (int) objPtr->internalRep.longValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    /*
	     * Caution: Don't be tempted to check directly for the "double"
	     * Tcl_ObjType and then compare the intrep to 0.0. This isn't
	     * reliable because a "double" Tcl_ObjType can hold the NaN value.
	     * Use the API Tcl_GetDoubleFromObj, which does the checking and
	     * sets the proper error message for us.
	     */

	    double d;
            double d;

	    if (Tcl_GetDoubleFromObj(interp, objPtr, &d) != TCL_OK) {
		return TCL_ERROR;
	    }
	    *boolPtr = (d != 0.0);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    *boolPtr = 1;
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    *boolPtr = (objPtr->internalRep.wideValue != 0);
	    return TCL_OK;
	}
#endif
    } while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
	    TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetBooleanFromAny --
 * SetBooleanFromAny --
 *
 *	Attempt to generate a boolean internal form for the Tcl object
 *	"objPtr".
 *
 * Results:
 *	The return value is a standard Tcl result. If an error occurs during
 *	conversion, an error message is left in the interpreter's result
 *	unless "interp" is NULL.
 *
 * Side effects:
 *	If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
 *	representation and the type of "objPtr" is set to boolean or int.
 *	representation and the type of "objPtr" is set to boolean.
 *
 *----------------------------------------------------------------------
 */

int
TclSetBooleanFromAny(
static int
SetBooleanFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    /*
     * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
     * whether a boolean conversion is possible without generating the string
     * rep.
     */

    if (objPtr->bytes == NULL) {
	if (objPtr->typePtr == &tclIntType) {
	    if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
	    switch (objPtr->internalRep.longValue) {
	    case 0L: case 1L:
		return TCL_OK;
	    }
	    goto badBoolean;
	}

	if (objPtr->typePtr == &tclBignumType) {
	    goto badBoolean;
	}

#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    goto badBoolean;
	}
#endif

	if (objPtr->typePtr == &tclDoubleType) {
	    goto badBoolean;
	}
    }

    if (ParseBoolean(objPtr) == TCL_OK) {
	return TCL_OK;
    }

  badBoolean:
    if (interp != NULL) {
	size_t length;
	const char *str = TclGetStringFromObj(objPtr, &length);
	int length;
	char *str = Tcl_GetStringFromObj(objPtr, &length);
	Tcl_Obj *msg;

	TclNewLiteralStringObj(msg, "expected boolean value but got \"");
	Tcl_AppendLimitedToObj(msg, str, length, 50, "");
	Tcl_AppendToObj(msg, "\"", -1);
	Tcl_SetObjResult(interp, msg);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "BOOLEAN", NULL);
    }
    return TCL_ERROR;
}

static int
ParseBoolean(
    Tcl_Obj *objPtr)	/* The object to parse/convert. */
    register Tcl_Obj *objPtr)	/* The object to parse/convert. */
{
    int newBool;
    char lowerCase[6];
    size_t i, length;
    const char *str = TclGetStringFromObj(objPtr, &length);
    int i, length, newBool;
    char lowerCase[6], *str = TclGetStringFromObj(objPtr, &length);

    if ((length == 0) || (length > 5)) {
	/*
         * Longest valid boolean string rep. is "false".
	/* longest valid boolean string rep. is "false" */
         */

	return TCL_ERROR;
    }

    switch (str[0]) {
    case '0':
	if (length == 1) {
	    newBool = 0;
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
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







-



















-
+





-
+





-
+





-
+








-
+


-
+
















-
+





-
+







    /*
     * Force to lower case for case-insensitive detection. Filter out known
     * invalid characters at the same time.
     */

    for (i=0; i < length; i++) {
	char c = str[i];

	switch (c) {
	case 'A': case 'E': case 'F': case 'L': case 'N':
	case 'O': case 'R': case 'S': case 'T': case 'U': case 'Y':
	    lowerCase[i] = c + (char) ('a' - 'A');
	    break;
	case 'a': case 'e': case 'f': case 'l': case 'n':
	case 'o': case 'r': case 's': case 't': case 'u': case 'y':
	    lowerCase[i] = c;
	    break;
	default:
	    return TCL_ERROR;
	}
    }
    lowerCase[length] = 0;
    switch (lowerCase[0]) {
    case 'y':
	/*
	 * Checking the 'y' is redundant, but makes the code clearer.
	 */
	if (strncmp(lowerCase, "yes", length) == 0) {
	if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
	    newBool = 1;
	    goto goodBoolean;
	}
	return TCL_ERROR;
    case 'n':
	if (strncmp(lowerCase, "no", length) == 0) {
	if (strncmp(lowerCase, "no", (size_t) length) == 0) {
	    newBool = 0;
	    goto goodBoolean;
	}
	return TCL_ERROR;
    case 't':
	if (strncmp(lowerCase, "true", length) == 0) {
	if (strncmp(lowerCase, "true", (size_t) length) == 0) {
	    newBool = 1;
	    goto goodBoolean;
	}
	return TCL_ERROR;
    case 'f':
	if (strncmp(lowerCase, "false", length) == 0) {
	if (strncmp(lowerCase, "false", (size_t) length) == 0) {
	    newBool = 0;
	    goto goodBoolean;
	}
	return TCL_ERROR;
    case 'o':
	if (length < 2) {
	    return TCL_ERROR;
	}
	if (strncmp(lowerCase, "on", length) == 0) {
	if (strncmp(lowerCase, "on", (size_t) length) == 0) {
	    newBool = 1;
	    goto goodBoolean;
	} else if (strncmp(lowerCase, "off", length) == 0) {
	} else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
	    newBool = 0;
	    goto goodBoolean;
	}
	return TCL_ERROR;
    default:
	return TCL_ERROR;
    }

    /*
     * Free the old internalRep before setting the new one. We do this as late
     * as possible to allow the conversion code, in particular
     * Tcl_GetStringFromObj, to use that old internalRep.
     */

  goodBoolean:
    TclFreeIntRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->internalRep.longValue = newBool;
    objPtr->typePtr = &tclBooleanType;
    return TCL_OK;

  numericBoolean:
    TclFreeIntRep(objPtr);
    objPtr->internalRep.wideValue = newBool;
    objPtr->internalRep.longValue = newBool;
    objPtr->typePtr = &tclIntType;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+








-
+

-
+







 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewDoubleObj

Tcl_Obj *
Tcl_NewDoubleObj(
    double dblValue)	/* Double used to initialize the object. */
    register double dblValue)	/* Double used to initialize the object. */
{
    return Tcl_DbNewDoubleObj(dblValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewDoubleObj(
    double dblValue)	/* Double used to initialize the object. */
    register double dblValue)	/* Double used to initialize the object. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    TclNewDoubleObj(objPtr, dblValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
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
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







-
-
+
+




-
+


-











-
-
-
+
+
+
+
+







 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewDoubleObj(
    double dblValue,	/* Double used to initialize the object. */
    const char *file,		/* The name of the source file calling this
    register double dblValue,	/* Double used to initialize the object. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    /* Optimized TclInvalidateStringRep() */
    objPtr->bytes = NULL;

    objPtr->internalRep.doubleValue = dblValue;
    objPtr->typePtr = &tclDoubleType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewDoubleObj(
    double dblValue,	/* Double used to initialize the object. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    register double dblValue,	/* Double used to initialize the object. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewDoubleObj(dblValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
2257
2258
2259
2260
2261
2262
2263
2264
2265


2266
2267
2268
2269
2270
2271
2272
2219
2220
2221
2222
2223
2224
2225


2226
2227
2228
2229
2230
2231
2232
2233
2234







-
-
+
+







 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetDoubleObj(
    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    double dblValue)	/* Double used to set the object's value. */
    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    register double dblValue)	/* Double used to set the object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
    }

    TclSetDoubleObj(objPtr, dblValue);
}
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
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







-
-
-
+
+
+







-
-







-
+




+
+
+
-
-
-
+
+
+
+


+







 *	old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetDoubleFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a double. */
    double *dblPtr)	/* Place to store resulting double. */
    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a double. */
    register double *dblPtr)	/* Place to store resulting double. */
{
    do {
	if (objPtr->typePtr == &tclDoubleType) {
	    if (TclIsNaN(objPtr->internalRep.doubleValue)) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "floating point value is Not a Number", -1));
                    Tcl_SetErrorCode(interp, "TCL", "VALUE", "DOUBLE", "NAN",
                            NULL);
		}
		return TCL_ERROR;
	    }
	    *dblPtr = (double) objPtr->internalRep.doubleValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    *dblPtr = objPtr->internalRep.longValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;
	    UNPACK_BIGNUM( objPtr, big );
	    *dblPtr = TclBignumToDouble( &big );
	    return TCL_OK;

	    TclUnpackBignum(objPtr, big);
	    *dblPtr = TclBignumToDouble(&big);
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    *dblPtr = (double) objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#endif
    } while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+











+
-
+















-
+

-
+
+

+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+
+

+
+
-
-
+
+
-

-
-
+
-
-
-
+
+
-
-
-
+
+

-
+
-
-
-
-
+
+






-
-
-
+
+
+









-
+

-
+







 *
 *----------------------------------------------------------------------
 */

static int
SetDoubleFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    return TclParseNumber(interp, objPtr, "floating-point number", NULL, -1,
	    NULL, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfDouble --
 *
 *	Update the string representation for a double-precision floating point
 *	object. This must obey the current tcl_precision value for
 *	object. Note: This function does not free an
 *	double-to-string conversions. Note: This function does not free an
 *	existing old string rep so storage will be lost if this has not
 *	already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	double-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfDouble(
    Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
    register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
{
    char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);
    char buffer[TCL_DOUBLE_SPACE];
    register int len;

    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
    len = strlen(buffer);
    TclOOM(dst, (size_t)TCL_DOUBLE_SPACE + 1);

    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst);
    (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));

    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
    strcpy(objPtr->bytes, buffer);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewIntObj --
 *
 *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
 *	Tcl_NewIntObj to create a new integer object end up calling the
 *	debugging function Tcl_DbNewLongObj instead.
 *
 *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
 *	calls to Tcl_NewIntObj result in a call to one of the two
 *	Tcl_NewIntObj implementations below. We provide two implementations so
 *	that the Tcl core can be compiled to do memory debugging of the core
 *	even if a client does not request it for itself.
 *
 *	Integer and long integer objects share the same "integer" type
 *	implementation. We store all integers as longs and Tcl_GetIntFromObj
 *	checks whether the current value of the long can be represented by an
 *	int.
 *
 * Results:
 *	The newly created object is returned. This object will have an invalid
 *	string representation. The returned object has ref count 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewIntObj

Tcl_Obj *
Tcl_NewIntObj(
    register int intValue)	/* Int used to initialize the new object. */
{
    return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewIntObj(
    register int intValue)	/* Int used to initialize the new object. */
{
    register Tcl_Obj *objPtr;

    TclNewIntObj(objPtr, intValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetIntObj --
 *
 *	Modify an object to be an integer and to have the specified integer
 *	value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old string rep, if any, is freed. Also, any old internal
 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetIntObj(
    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    register int intValue)	/* Integer used to set object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
    }

    TclSetIntObj(objPtr, intValue);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntFromObj --
 *
 *	Retrieve the integer value of 'objPtr'.
 *	Attempt to return an int from the Tcl object "objPtr". If the object
 *	is not already an int, an attempt will be made to convert it to one.
 *
 *	Integer and long integer objects share the same "integer" type
 *	implementation. We store all integers as longs and Tcl_GetIntFromObj
 * Value
 *
 *	checks whether the current value of the long can be represented by an
 *	int.
 *	TCL_OK
 *
 *	    Success.
 *
 * Results:
 *	TCL_ERROR
 *
 *	    An error occurred during conversion or the integral value can not
 *	The return value is a standard Tcl object result. If an error occurs
 *	during conversion or if the long integer held by the object can not be
 *	    be represented as an integer (it might be too large). An error
 *	    message is left in the interpreter's result if 'interp' is not
 *	    NULL.
 *	represented by an int, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Effect
 * Side effects:
 *
 *	'objPtr' is converted to an integer if necessary if it is not one
 *	already.  The conversion frees any previously-existing internal
 *	representation.
 *	If the object is not already an int, the conversion will free any old
 *	internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a int. */
    int *intPtr)	/* Place to store resulting int. */
    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a int. */
    register int *intPtr)	/* Place to store resulting int. */
{
#if (LONG_MAX == INT_MAX)
    return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
#else
    long l;

    if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
	return TCL_ERROR;
    }
    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < INT_MIN))) {
    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
	if (interp != NULL) {
	    const char *s =
	    CONST char *s =
		    "integer value too large to represent as non-long integer";
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;
    }
    *intPtr = (int) l;
2461
2462
2463
2464
2465
2466
2467
2468
2469


2470
2471
2472
2473
2474
2475
2476
2510
2511
2512
2513
2514
2515
2516


2517
2518
2519
2520
2521
2522
2523
2524
2525







-
-
+
+







 */

static int
SetIntFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    Tcl_WideInt w;
    return Tcl_GetWideIntFromObj(interp, objPtr, &w);
    long l;
    return TclGetLongFromObj(interp, objPtr, &l);
}

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfInt --
 *
2486
2487
2488
2489
2490
2491
2492
2493

2494
2495


2496

2497
2498
2499






























































































































































2500
2501
2502
2503
2504
2505
2506
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712







-
+

-
+
+

+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	int-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfInt(
    Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
    char buffer[TCL_INTEGER_SPACE];
    register int len;

    len = TclFormatInt(buffer, objPtr->internalRep.longValue);
    TclOOM(dst, (size_t)TCL_INTEGER_SPACE + 1);
    (void) Tcl_InitStringRep(objPtr, NULL,
	    TclFormatInt(dst, objPtr->internalRep.wideValue));

    objPtr->bytes = ckalloc((unsigned) len + 1);
    strcpy(objPtr->bytes, buffer);
    objPtr->length = len;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewLongObj --
 *
 *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
 *	Tcl_NewLongObj to create a new long integer object end up calling the
 *	debugging function Tcl_DbNewLongObj instead.
 *
 *	Otherwise, if the client is compiled without TCL_MEM_DEBUG defined,
 *	calls to Tcl_NewLongObj result in a call to one of the two
 *	Tcl_NewLongObj implementations below. We provide two implementations
 *	so that the Tcl core can be compiled to do memory debugging of the
 *	core even if a client does not request it for itself.
 *
 *	Integer and long integer objects share the same "integer" type
 *	implementation. We store all integers as longs and Tcl_GetIntFromObj
 *	checks whether the current value of the long can be represented by an
 *	int.
 *
 * Results:
 *	The newly created object is returned. This object will have an invalid
 *	string representation. The returned object has ref count 0.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewLongObj

Tcl_Obj *
Tcl_NewLongObj(
    register long longValue)	/* Long integer used to initialize the
				 * new object. */
{
    return Tcl_DbNewLongObj(longValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewLongObj(
    register long longValue)	/* Long integer used to initialize the
				 * new object. */
{
    register Tcl_Obj *objPtr;

    TclNewLongObj(objPtr, longValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbNewLongObj --
 *
 *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
 *	Tcl_NewIntObj and Tcl_NewLongObj to create new integer or long integer
 *	objects end up calling the debugging function Tcl_DbNewLongObj
 *	instead. We provide two implementations of Tcl_DbNewLongObj so that
 *	whether the Tcl core is compiled to do memory debugging of the core is
 *	independent of whether a client requests debugging for itself.
 *
 *	When the core is compiled with TCL_MEM_DEBUG defined, Tcl_DbNewLongObj
 *	calls Tcl_DbCkalloc directly with the file name and line number from
 *	its caller. This simplifies debugging since then the [memory active]
 *	command will report the caller's file name and line number when
 *	reporting objects that haven't been freed.
 *
 *	Otherwise, when the core is compiled without TCL_MEM_DEBUG defined,
 *	this function just returns the result of calling Tcl_NewLongObj.
 *
 * Results:
 *	The newly created long integer object is returned. This object will
 *	have an invalid string representation. The returned object has ref
 *	count 0.
 *
 * Side effects:
 *	Allocates memory.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewLongObj(
    register long longValue,	/* Long integer used to initialize the new
				 * object. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;

    objPtr->internalRep.longValue = longValue;
    objPtr->typePtr = &tclIntType;
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewLongObj(
    register long longValue,	/* Long integer used to initialize the new
				 * object. */
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewLongObj(longValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetLongObj --
 *
 *	Modify an object to be an integer object and to have the specified
 *	long integer value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old string rep, if any, is freed. Also, any old internal
 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetLongObj(
    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    register long longValue)	/* Long integer used to initialize the
				 * object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
    }

    TclSetLongObj(objPtr, longValue);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetLongFromObj --
 *
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
2724
2725
2726
2727
2728
2729
2730



2731
2732
2733
2734
2735

2736

2737
2738
2739


2740
2741
2742

2743
2744
2745
2746
2747
2748
2749
2750


2751
2752

2753
2754
2755
2756
2757
2758






2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769

2770
2771
2772
2773
2774
2775
2776
2777
2778




2779
2780
2781
2782
2783
2784
2785


2786



2787
2788


2789
2790

2791



2792

2793
2794



2795
2796
2797



2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863







-
-
-
+
+
+


-

-
+


-
-
+
+

-
+







-
-
+

-
+





-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
+







+
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
+

-
-
+
+
-

-
-
-
+
-

+
-
-
-
+
+
+
-
-
-
+















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetLongFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* The object from which to get a long. */
    long *longPtr)	/* Place to store resulting long. */
    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* The object from which to get a long. */
    register long *longPtr)	/* Place to store resulting long. */
{
    do {
#ifdef TCL_WIDE_INT_IS_LONG
	if (objPtr->typePtr == &tclIntType) {
	    *longPtr = objPtr->internalRep.wideValue;
	    *longPtr = objPtr->internalRep.longValue;
	    return TCL_OK;
	}
#else
	if (objPtr->typePtr == &tclIntType) {
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    /*
	     * We return any integer in the range LONG_MIN to ULONG_MAX
	     * We return any integer in the range -ULONG_MAX to ULONG_MAX
	     * converted to a long, ignoring overflow. The rule preserves
	     * existing semantics for conversion of integers on input, but
	     * avoids inadvertent demotion of wide integers to 32-bit ones in
	     * the internal rep.
	     */

	    Tcl_WideInt w = objPtr->internalRep.wideValue;

	    if (w >= (Tcl_WideInt)(LONG_MIN)
	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
		*longPtr = (long) w;
		*longPtr = Tcl_WideAsLong(w);
		return TCL_OK;
	    }
	    goto tooLarge;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
        if (objPtr->typePtr == &tclDoubleType) {
            if (interp != NULL) {
		Tcl_Obj *msg;

		TclNewLiteralStringObj(msg, "expected integer but got \"");
		Tcl_AppendObjToObj(msg, objPtr);
		Tcl_AppendToObj(msg, "\"", -1);
		Tcl_SetObjResult(interp, msg);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
        if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a long, even
	     * when auto-narrowing is enabled. Only those values in the signed
	     * long range get auto-narrowed to tclIntType, while all the
	     * values in the unsigned long range will fit in a long.
	     */

	    mp_int big;
		{
	    mp_int big;
	    unsigned long scratch, value = 0;
	    unsigned char *bytes = (unsigned char *) &scratch;

	    UNPACK_BIGNUM(objPtr, big);
	    if ((size_t)(big.used) <= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1)
		    / MP_DIGIT_BIT) {
		unsigned long value = 0, numBytes = sizeof(long);
		long scratch;
		unsigned char *bytes = (unsigned char *)&scratch;
	    size_t numBytes;

		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
	    TclUnpackBignum(objPtr, big);
	    if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		}
		if (big.sign) {
		    }
		    if (mp_isneg(&big)) {
		    if (value <= 1 + (unsigned long)LONG_MAX) {
			*longPtr = - (long) value;
			return TCL_OK;
		    }
		} else {
		    } else {
		    if (value <= (unsigned long)ULONG_MAX) {
			*longPtr = (long) value;
		    }
			return TCL_OK;
		    }
		}
		    return TCL_OK;
		}
	    }
	    }
	    }
#ifndef TCL_WIDE_INT_IS_LONG
#ifndef NO_WIDE_TYPE
	tooLarge:
#endif
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}
#ifndef NO_WIDE_TYPE

/*
 *----------------------------------------------------------------------
 *
 * UpdateStringOfWideInt --
 *
 *	Update the string representation for a wide integer object. Note: this
 *	function does not free an existing old string rep so storage will be
 *	lost if this has not already been done.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's string is set to a valid string that results from the
 *	wideInt-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfWideInt(
    register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
{
    char buffer[TCL_INTEGER_SPACE+2];
    register unsigned len;
    register Tcl_WideInt wideVal = objPtr->internalRep.wideValue;

    /*
     * Note that sprintf will generate a compiler warning under Mingw claiming
     * %I64 is an unknown format specifier. Just ignore this warning. We can't
     * use %L as the format specifier since that gets printed as a 32 bit
     * value.
     */

    sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
    len = strlen(buffer);
    objPtr->bytes = ckalloc((unsigned) len + 1);
    memcpy(objPtr->bytes, buffer, len + 1);
    objPtr->length = len;
}
#endif /* !NO_WIDE_TYPE */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewWideIntObj --
 *
 *	If a client is compiled with TCL_MEM_DEBUG defined, calls to
2636
2637
2638
2639
2640
2641
2642
2643

2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654

2655
2656
2657
2658

2659
2660
2661

2662
2663
2664
2665
2666
2667
2668
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







-
+










-
+



-
+


-
+







 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewWideIntObj

Tcl_Obj *
Tcl_NewWideIntObj(
    Tcl_WideInt wideValue)
    register Tcl_WideInt wideValue)
				/* Wide integer used to initialize the new
				 * object. */
{
    return Tcl_DbNewWideIntObj(wideValue, "unknown", 0);
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_NewWideIntObj(
    Tcl_WideInt wideValue)
    register Tcl_WideInt wideValue)
				/* Wide integer used to initialize the new
				 * object. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclSetIntObj(objPtr, wideValue);
    Tcl_SetWideIntObj(objPtr, wideValue);
    return objPtr;
}
#endif /* if TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
2695
2696
2697
2698
2699
2700
2701
2702

2703
2704
2705

2706
2707
2708
2709
2710

2711
2712
2713

2714
2715
2716
2717
2718
2719
2720
2721

2722
2723
2724
2725




2726
2727
2728
2729
2730
2731
2732
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







-
+


-
+




-
+


-
+







-
+


-
-
+
+
+
+







 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG

Tcl_Obj *
Tcl_DbNewWideIntObj(
    Tcl_WideInt wideValue,
    register Tcl_WideInt wideValue,
				/* Wide integer used to initialize the new
				 * object. */
    const char *file,		/* The name of the source file calling this
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    TclSetIntObj(objPtr, wideValue);
    Tcl_SetWideIntObj(objPtr, wideValue);
    return objPtr;
}

#else /* if not TCL_MEM_DEBUG */

Tcl_Obj *
Tcl_DbNewWideIntObj(
    Tcl_WideInt wideValue,
    register Tcl_WideInt wideValue,
				/* Long integer used to initialize the new
				 * object. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewWideIntObj(wideValue);
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
2744
2745
2746
2747
2748
2749
2750
2751
2752


2753
2754
2755
2756
2757
2758
2759





2760








2761
2762
2763
2764
2765
2766
2767
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







-
-
+
+







+
+
+
+
+
-
+
+
+
+
+
+
+
+







 *	rep is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetWideIntObj(
    Tcl_Obj *objPtr,	/* Object w. internal rep to init. */
    Tcl_WideInt wideValue)
    register Tcl_Obj *objPtr,	/* Object w. internal rep to init. */
    register Tcl_WideInt wideValue)
				/* Wide integer used to initialize the
				 * object's value. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
    }

    if ((wideValue >= (Tcl_WideInt) LONG_MIN)
	    && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
	TclSetLongObj(objPtr, (long) wideValue);
    } else {
#ifndef NO_WIDE_TYPE
    TclSetIntObj(objPtr, wideValue);
	TclSetWideIntObj(objPtr, wideValue);
#else
	mp_int big;

	TclBNInitBignumFromWideInt(&big, wideValue);
	Tcl_SetBignumObj(objPtr, &big);
#endif
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetWideIntFromObj --
 *
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788



2789
2790
2791

2792

2793
2794
2795





2796
2797
2798
2799
2800
2801








2802
2803
2804
2805

2806
2807
2808
2809
2810
2811




2812
2813
2814
2815




2816
2817
2818
2819
2820
2821
2822





2823
2824
2825
2826
2827

2828
2829
2830
2831

2832
2833
2834
2835
2836

2837
2838
2839
2840
2841
2842
2843
2844
2845
2846

2847
2848
2849
2850
2851

2852
2853
2854


2855
2856
2857
2858
2859

2860
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
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







-
-
-
+
+
+



+
-
+



+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
+






+
+
+
+
-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
-

-
-
-
+
-

-

+




-
+










+




-
+

-
-
+
+
-
-


-
+



-
-
-
-



-
-
-
-
+
+
+
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+

-
-
+
+

-







 *	any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetWideIntFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    Tcl_WideInt *wideIntPtr)
    Tcl_Interp *interp, 	/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
    register Tcl_WideInt *wideIntPtr)
				/* Place to store resulting long. */
{
    do {
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclIntType) {
	if (objPtr->typePtr == &tclWideIntType) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
        if (objPtr->typePtr == &tclDoubleType) {
            if (interp != NULL) {
		Tcl_Obj *msg;

		TclNewLiteralStringObj(msg, "expected integer but got \"");
		Tcl_AppendObjToObj(msg, objPtr);
		Tcl_AppendToObj(msg, "\"", -1);
		Tcl_SetObjResult(interp, msg);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
        if (objPtr->typePtr == &tclBignumType) {
	    /*
	     * Must check for those bignum values that can fit in a
	     * Tcl_WideInt, even when auto-narrowing is enabled.
	     */

	    mp_int big;

	    UNPACK_BIGNUM(objPtr, big);
	    if ((size_t)(big.used) <= (CHAR_BIT * sizeof(Tcl_WideInt)
		     + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) {
	    Tcl_WideUInt value = 0;
	    size_t numBytes;
	    Tcl_WideInt scratch;
	    unsigned char *bytes = (unsigned char *) &scratch;
		Tcl_WideUInt value = 0;
		unsigned long numBytes = sizeof(Tcl_WideInt);
		Tcl_WideInt scratch;
		unsigned char *bytes = (unsigned char *) &scratch;

	    TclUnpackBignum(objPtr, big);
	    if (mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes) == MP_OKAY) {
		while (numBytes-- > 0) {
		    value = (value << CHAR_BIT) | *bytes++;
		}
		if (big.sign) {
		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
		    while (numBytes-- > 0) {
			value = (value << CHAR_BIT) | *bytes++;
		    }
		    if (mp_isneg(&big)) {
		    if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
			*wideIntPtr = - (Tcl_WideInt) value;
			return TCL_OK;
		    }
		} else {
		    } else {
		    if (value <= (Tcl_WideUInt)WIDE_MAX) {
			*wideIntPtr = (Tcl_WideInt) value;
			return TCL_OK;
		    }
		    return TCL_OK;
		}
	    }
	    if (interp != NULL) {
		const char *s = "integer value too large to represent";
		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
		Tcl_Obj* msg = Tcl_NewStringObj(s, -1);

		Tcl_SetObjResult(interp, msg);
		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}
#ifndef NO_WIDE_TYPE

/*
 *----------------------------------------------------------------------
 *
 * TclGetWideBitsFromObj --
 * SetWideIntFromAny --
 *
 *	Attempt to return a wide integer from the Tcl object "objPtr". If the
 *	object is not already a int, double or bignum, an attempt will be made
 *	Attempts to force the internal representation for a Tcl object to
 *	tclWideIntType, specifically.
 *	to convert it to one of these. Out-of-range values don't result in an
 *	error, but only the least significant 64 bits will be returned.
 *
 * Results:
 *	The return value is a standard Tcl object result. If an error occurs
 *	The return value is a standard object Tcl result. If an error occurs
 *	during conversion, an error message is left in the interpreter's
 *	result unless "interp" is NULL.
 *
 * Side effects:
 *	If the object is not already an int, double or bignum object, the
 *	conversion will free any old internal representation.
 *
 *----------------------------------------------------------------------
 */

int
TclGetWideBitsFromObj(
    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,            /* Object from which to get a wide int. */
static int
SetWideIntFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
    Tcl_WideInt *wideIntPtr)    /* Place to store resulting wide integer. */
{
    do {
	if (objPtr->typePtr == &tclIntType) {
	    *wideIntPtr = objPtr->internalRep.wideValue;
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
	    }
	    return TCL_ERROR;
	}
	if (objPtr->typePtr == &tclBignumType) {
	    mp_int big;
	    mp_err err;

	    Tcl_WideUInt value = 0, scratch;
    Tcl_WideInt w;
	    size_t numBytes;
	    unsigned char *bytes = (unsigned char *) &scratch;

    return Tcl_GetWideIntFromObj(interp, objPtr, &w);
	    Tcl_GetBignumFromObj(NULL, objPtr, &big);
	    err = mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
	    if (err == MP_OKAY) {
		err = mp_to_ubin(&big, bytes, sizeof(Tcl_WideInt), &numBytes);
	    }
	    if (err != MP_OKAY) {
}
#endif /* !NO_WIDE_TYPE */
		return TCL_ERROR;
	    }
	    while (numBytes-- > 0) {
		value = (value << CHAR_BIT) | *bytes++;
	    }
	    *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
	    mp_clear(&big);
	    return TCL_OK;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeBignum --
 *
 *	This function frees the internal rep of a bignum.
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FreeBignum(
    Tcl_Obj *objPtr)
{
    mp_int toFree;		/* Bignum to free */

    TclUnpackBignum(objPtr, toFree);
    UNPACK_BIGNUM(objPtr, toFree);
    mp_clear(&toFree);
    if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) < 0) {
	Tcl_Free(objPtr->internalRep.twoPtrValue.ptr1);
    if ((long)(objPtr->internalRep.ptrAndLongRep.value) < 0) {
	ckfree((char *)objPtr->internalRep.ptrAndLongRep.ptr);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupBignum --
 *
2963
2964
2965
2966
2967
2968
2969
2970

2971
2972
2973
2974
2975
2976
2977
3185
3186
3187
3188
3189
3190
3191

3192
3193
3194
3195
3196
3197
3198
3199







-
+







    Tcl_Obj *srcPtr,
    Tcl_Obj *copyPtr)
{
    mp_int bignumVal;
    mp_int bignumCopy;

    copyPtr->typePtr = &tclBignumType;
    TclUnpackBignum(srcPtr, bignumVal);
    UNPACK_BIGNUM(srcPtr, bignumVal);
    if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
	Tcl_Panic("initialization failure in DupBignum");
    }
    PACK_BIGNUM(bignumCopy, copyPtr);
}

/*
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
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







+
-
+

-
-
+
+
+














-
+
-
-
+
-
-
+


-
+
+








static void
UpdateStringOfBignum(
    Tcl_Obj *objPtr)
{
    mp_int bignumVal;
    int size;
    int status;
    char *stringVal;
    char* stringVal;

    TclUnpackBignum(objPtr, bignumVal);
    if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
    UNPACK_BIGNUM(objPtr, bignumVal);
    status = mp_radix_size(&bignumVal, 10, &size);
    if (status != MP_OKAY) {
	Tcl_Panic("radix size failure in UpdateStringOfBignum");
    }
    if (size < 2) {
	/*
	 * mp_radix_size() returns < 2 when more than INT_MAX bytes would be
	 * needed to hold the string rep (because mp_radix_size ignores
	 * integer overflow issues).
	 *
	 * Note that so long as we enforce our bignums to the size that fits
	 * in a packed bignum, this branch will never be taken.
	 */

	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
    }

    stringVal = ckalloc((size_t) size);
    stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1);

    status = mp_toradix_n(&bignumVal, stringVal, 10, size);
    TclOOM(stringVal, size);
    if (MP_OKAY != mp_to_radix(&bignumVal, stringVal, size, NULL, 10)) {
    if (status != MP_OKAY) {
	Tcl_Panic("conversion failure in UpdateStringOfBignum");
    }
    (void) Tcl_InitStringRep(objPtr, NULL, size - 1);
    objPtr->bytes = stringVal;
    objPtr->length = size - 1;	/* size includes a trailing null byte */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewBignumObj --
 *
3045
3046
3047
3048
3049
3050
3051
3052

3053
3054
3055
3056
3057
3058
3059

3060
3061

3062
3063
3064
3065
3066
3067
3068
3268
3269
3270
3271
3272
3273
3274

3275
3276
3277
3278
3279
3280
3281

3282
3283

3284
3285
3286
3287
3288
3289
3290
3291







-
+






-
+

-
+







 */

#ifdef TCL_MEM_DEBUG
#undef Tcl_NewBignumObj

Tcl_Obj *
Tcl_NewBignumObj(
    void *bignumValue)
    mp_int *bignumValue)
{
    return Tcl_DbNewBignumObj(bignumValue, "unknown", 0);
}
#else
Tcl_Obj *
Tcl_NewBignumObj(
    void *bignumValue)
    mp_int *bignumValue)
{
    Tcl_Obj *objPtr;
    Tcl_Obj* objPtr;

    TclNewObj(objPtr);
    Tcl_SetBignumObj(objPtr, bignumValue);
    return objPtr;
}
#endif

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
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







-
-
+
+











-
-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewBignumObj(
    void *bignumValue,
    const char *file,
    mp_int *bignumValue,
    CONST char *file,
    int line)
{
    Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    Tcl_SetBignumObj(objPtr, bignumValue);
    return objPtr;
}
#else
Tcl_Obj *
Tcl_DbNewBignumObj(
    void *bignumValue,
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    mp_int *bignumValue,
    CONST char *file,
    int line)
{
    return Tcl_NewBignumObj(bignumValue);
}
#endif

/*
 *----------------------------------------------------------------------
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
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







-
-
-
+
+
-
-

-
+
-
-
-
+
+

-
-
-
-
-

-
+





-
-
-
-
+
+
+
+
+
+
+


+


+
-
-
-
-
+
+
+
+
+







    int copy,			/* Whether to copy the returned bignum value */
    mp_int *bignumValue)	/* Returned bignum value. */
{
    do {
	if (objPtr->typePtr == &tclBignumType) {
	    if (copy || Tcl_IsShared(objPtr)) {
		mp_int temp;

		TclUnpackBignum(objPtr, temp);
		if (mp_init_copy(bignumValue, &temp) != MP_OKAY) {
		UNPACK_BIGNUM(objPtr, temp);
		mp_init_copy(bignumValue, &temp);
		    return TCL_ERROR;
		}
	    } else {
		TclUnpackBignum(objPtr, *bignumValue);
		UNPACK_BIGNUM(objPtr, *bignumValue);
		/* Optimized TclFreeIntRep */
		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
		objPtr->internalRep.ptrAndLongRep.ptr = NULL;
		objPtr->internalRep.ptrAndLongRep.value = 0;
		objPtr->typePtr = NULL;
		/*
		 * TODO: If objPtr has a string rep, this leaves
		 * it undisturbed.  Not clear that's proper. Pure
		 * bignum values are converted to empty string.
		 */
		if (objPtr->bytes == NULL) {
		    TclInitStringRep(objPtr, NULL, 0);
		    TclInitStringRep(objPtr, tclEmptyStringRep, 0);
		}
	    }
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    if (mp_init_i64(bignumValue,
		    objPtr->internalRep.wideValue) != MP_OKAY) {
		return TCL_ERROR;
	    }
	    TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    TclBNInitBignumFromWideInt(bignumValue,
		    objPtr->internalRep.wideValue);
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclDoubleType) {
	    if (interp != NULL) {
		Tcl_Obj *msg;
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "expected integer but got \"%s\"",
                        TclGetString(objPtr)));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);

		TclNewLiteralStringObj(msg, "expected integer but got \"");
		Tcl_AppendObjToObj(msg, objPtr);
		Tcl_AppendToObj(msg, "\"", -1);
		Tcl_SetObjResult(interp, msg);
	    }
	    return TCL_ERROR;
	}
    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
    return TCL_ERROR;
}
3208
3209
3210
3211
3212
3213
3214
3215

3216
3217

3218
3219
3220
3221
3222
3223
3224
3428
3429
3430
3431
3432
3433
3434

3435
3436

3437
3438
3439
3440
3441
3442
3443
3444







-
+

-
+







 *----------------------------------------------------------------------
 */

int
Tcl_GetBignumFromObj(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj *objPtr,		/* Object to read */
    void *bignumValue)	/* Returned bignum value. */
    mp_int *bignumValue)	/* Returned bignum value. */
{
    return GetBignumFromObj(interp, objPtr, 1, (mp_int *)bignumValue);
    return GetBignumFromObj(interp, objPtr, 1, bignumValue);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TakeBignumFromObj --
 *
3243
3244
3245
3246
3247
3248
3249
3250

3251
3252

3253
3254
3255
3256
3257
3258
3259
3463
3464
3465
3466
3467
3468
3469

3470
3471

3472
3473
3474
3475
3476
3477
3478
3479







-
+

-
+







 *----------------------------------------------------------------------
 */

int
Tcl_TakeBignumFromObj(
    Tcl_Interp *interp,		/* Tcl interpreter for error reporting */
    Tcl_Obj *objPtr,		/* Object to read */
    void *bignumValue)	/* Returned bignum value. */
    mp_int *bignumValue)	/* Returned bignum value. */
{
    return GetBignumFromObj(interp, objPtr, 0, (mp_int *)bignumValue);
    return GetBignumFromObj(interp, objPtr, 0, bignumValue);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetBignumObj --
 *
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
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







-
-
-
-
-
-
-
-
+
+



+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+

-





-
-
-
+
+












-
-

-
-
-
-


-
-




-
-
+












-
+



-
-
+
+
+
+
+
+
+
+


+


-
-
+
+
-
-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetBignumObj(
    Tcl_Obj *objPtr,		/* Object to set */
    void *big)	/* Value to store */
{
    Tcl_WideUInt value = 0;
    size_t numBytes;
    Tcl_WideUInt scratch;
    unsigned char *bytes = (unsigned char *) &scratch;
    mp_int *bignumValue = (mp_int *) big;

    mp_int *bignumValue)	/* Value to store */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
    }
    if ((size_t)(bignumValue->used)
	    <= (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) {
	unsigned long value = 0, numBytes = sizeof(long);
	long scratch;
	unsigned char *bytes = (unsigned char *)&scratch;
    if (mp_to_ubin(bignumValue, bytes, sizeof(Tcl_WideUInt), &numBytes) != MP_OKAY) {
	goto tooLargeForWide;
    }
    while (numBytes-- > 0) {
	value = (value << CHAR_BIT) | *bytes++;
    }
    if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
	goto tooLargeForWide;
    }
    if (bignumValue->sign) {
	TclSetIntObj(objPtr, -(Tcl_WideInt)value);
    } else {
	TclSetIntObj(objPtr, (Tcl_WideInt)value);
    }
    mp_clear(bignumValue);
    return;
	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	    goto tooLargeForLong;
	}
	while (numBytes-- > 0) {
	    value = (value << CHAR_BIT) | *bytes++;
	}
	if (value > (((~(unsigned long)0) >> 1) + mp_isneg(bignumValue))) {
	    goto tooLargeForLong;
	}
	if (mp_isneg(bignumValue)) {
	    TclSetLongObj(objPtr, -(long)value);
	} else {
	    TclSetLongObj(objPtr, (long)value);
	}
	mp_clear(bignumValue);
	return;
    }
  tooLargeForLong:
#ifndef NO_WIDE_TYPE
    if ((size_t)(bignumValue->used)
	    <= (CHAR_BIT * sizeof(Tcl_WideInt) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT) {
	Tcl_WideUInt value = 0;
	unsigned long numBytes = sizeof(Tcl_WideInt);
	Tcl_WideInt scratch;
	unsigned char *bytes = (unsigned char *)&scratch;
	if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
	    goto tooLargeForWide;
	}
	while (numBytes-- > 0) {
	    value = (value << CHAR_BIT) | *bytes++;
	}
	if (value > (((~(Tcl_WideUInt)0) >> 1) + mp_isneg(bignumValue))) {
	    goto tooLargeForWide;
	}
	if (mp_isneg(bignumValue)) {
	    TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
	} else {
	    TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
	}
	mp_clear(bignumValue);
	return;
    }
  tooLargeForWide:
#endif
    TclInvalidateStringRep(objPtr);
    TclFreeIntRep(objPtr);
    TclSetBignumIntRep(objPtr, bignumValue);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetBignumIntRep --
 *
 *	Install a bignum into the internal representation of an object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Object internal representation is updated and object type is set. The
 *	bignum value is cleared, since ownership has transferred to the
 *	object.
 *
 *----------------------------------------------------------------------
 */

void
TclSetBignumIntRep(
    Tcl_Obj *objPtr,
    void *big)
    mp_int *bignumValue)
{
    mp_int *bignumValue = (mp_int *)big;
    objPtr->typePtr = &tclBignumType;
    PACK_BIGNUM(*bignumValue, objPtr);

    /*
     * Clear the mp_int value.
     *
     * Don't call mp_clear() because it would free the digit array we just
     * packed into the Tcl_Obj.
     * Don't call mp_clear() because it would free the digit array
     * we just packed into the Tcl_Obj.
     */

    bignumValue->dp = NULL;
    bignumValue->alloc = bignumValue->used = 0;
    bignumValue->sign = MP_NEG;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetNumberFromObj --
 *
 *      Extracts a number (of any possible numeric type) from an object.
 *
 * Results:
 *      Whether the extraction worked. The type is stored in the variable
 *      referred to by the typePtr argument, and a pointer to the
 *      representation is stored in the variable referred to by the
 *      clientDataPtr.
 *
 * Side effects:
 *      Can allocate thread-specific data for handling the copy-out space for
 *      bignums; this space is shared within a thread.
 *
 *----------------------------------------------------------------------
 */

int
TclGetNumberFromObj(
int TclGetNumberFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    ClientData *clientDataPtr,
    int *typePtr)
{
    do {
	if (objPtr->typePtr == &tclDoubleType) {
	    if (TclIsNaN(objPtr->internalRep.doubleValue)) {
		*typePtr = TCL_NUMBER_NAN;
	    } else {
		*typePtr = TCL_NUMBER_DOUBLE;
	    }
	    *clientDataPtr = &objPtr->internalRep.doubleValue;
	    *clientDataPtr = &(objPtr->internalRep.doubleValue);
	    return TCL_OK;
	}
	if (objPtr->typePtr == &tclIntType) {
	    *typePtr = TCL_NUMBER_INT;
	    *clientDataPtr = &objPtr->internalRep.wideValue;
	    *typePtr = TCL_NUMBER_LONG;
	    *clientDataPtr = &(objPtr->internalRep.longValue);
	    return TCL_OK;
	}
#ifndef NO_WIDE_TYPE
	if (objPtr->typePtr == &tclWideIntType) {
	    *typePtr = TCL_NUMBER_WIDE;
	    *clientDataPtr = &(objPtr->internalRep.wideValue);
	    return TCL_OK;
	}
#endif
	if (objPtr->typePtr == &tclBignumType) {
	    static Tcl_ThreadDataKey bignumKey;
	    mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
		    sizeof(mp_int));
	    mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
		    (int) sizeof(mp_int));

	    TclUnpackBignum(objPtr, *bigPtr);
	    UNPACK_BIGNUM( objPtr, *bigPtr );
	    *typePtr = TCL_NUMBER_BIG;
	    *clientDataPtr = bigPtr;
	    return TCL_OK;
	}
    } while (TCL_OK ==
	    TclParseNumber(interp, objPtr, "number", NULL, -1, NULL, 0));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IncrRefCount --
 *
 *	Increments the reference count of the object.
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_IncrRefCount
void
Tcl_IncrRefCount(
    Tcl_Obj *objPtr)	/* The object we are registering a reference to. */
{
    ++(objPtr)->refCount;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DecrRefCount --
 *
 *	Decrements the reference count of the object.
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_DecrRefCount
void
Tcl_DecrRefCount(
    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
{
    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_IsShared --
 *
 *	Tests if the object has a ref count greater than one.
 *
 * Results:
 *	Boolean value that is the result of the test.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_IsShared
int
Tcl_IsShared(
    Tcl_Obj *objPtr)	/* The object to test for being shared. */
{
    return ((objPtr)->refCount + 1 > 2);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbIncrRefCount --
 *
 *	This function is normally called when debugging: i.e., when
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
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







-


-
+

-
+




+






-
+







-
-
+

+

+



-
+

-
-
+
+
+


-
+
-
-
-
-
+
-
-
-
-
-
-


-







 *
 * Side effects:
 *	The object's ref count is incremented.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
Tcl_DbIncrRefCount(
    Tcl_Obj *objPtr,	/* The object we are registering a reference
    register Tcl_Obj *objPtr,	/* The object we are registering a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("incrementing refCount of previously disposed object");
    }

#if TCL_THREADS
# ifdef TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
	Tcl_HashTable *tablePtr;
	Tcl_HashEntry *hPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	tablePtr = tsdPtr->objThreadMap;
	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
                    "incr ref count");
	    Tcl_Panic("%s%s",
		    "Trying to incr ref count of "
		    "Tcl_Obj allocated in another thread");
	}
    }
# endif /* TCL_THREADS */
# endif
    ++(objPtr)->refCount;
}
#else /* !TCL_MEM_DEBUG */
void
#endif
Tcl_DbIncrRefCount(
    Tcl_Obj *objPtr,	/* The object we are registering a reference
				 * to. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    ++(objPtr)->refCount;
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbDecrRefCount --
 *
 *	This function is normally called when debugging: i.e., when
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
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







-


-
+

-
+




+






-
+







-
-
+

+

+



-
+

-
-
+
+
+


-
-
-
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-







 *
 * Side effects:
 *	The object's ref count is incremented.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_MEM_DEBUG
void
Tcl_DbDecrRefCount(
    Tcl_Obj *objPtr,	/* The object we are releasing a reference
    register Tcl_Obj *objPtr,	/* The object we are releasing a reference
				 * to. */
    const char *file,		/* The name of the source file calling this
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("decrementing refCount of previously disposed object");
    }

#if TCL_THREADS
# ifdef TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
	Tcl_HashTable *tablePtr;
	Tcl_HashEntry *hPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	tablePtr = tsdPtr->objThreadMap;
	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
                    "decr ref count");
	    Tcl_Panic("%s%s",
		    "Trying to decr ref count of "
		    "Tcl_Obj allocated in another thread");
	}
    }
# endif /* TCL_THREADS */

    if (objPtr->refCount-- <= 1) {
# endif
#endif
    if (--(objPtr)->refCount <= 0) {
	TclFreeObj(objPtr);
    }
}
#else /* !TCL_MEM_DEBUG */
void
Tcl_DbDecrRefCount(
    Tcl_Obj *objPtr,	/* The object we are releasing a reference
				 * to. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
{
    if (objPtr->refCount-- <= 1) {
	TclFreeObj(objPtr);
    }
}
#endif /* TCL_MEM_DEBUG */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DbIsShared --
 *
 *	This function is normally called when debugging: i.e., when
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
3775
3776
3777
3778
3779
3780
3781

3782


3783
3784
3785
3786




3787
3788
3789
3790
3791
3792
3793
3794

3795
3796
3797
3798
3799
3800
3801
3802


3803
3804

3805
3806
3807
3808
3809

3810
3811


3812
3813
3814
3815
3816


3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829

3830
3831
3832
3833
3834
3835
3836
3837







-
+
-
-
+



-
-
-
-








-
+







-
-
+

-
+
+



-
+

-
-
+
+
+


-
-
+
+











-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DbIsShared(
    Tcl_Obj *objPtr,	/* The object to test for being shared. */
    register Tcl_Obj *objPtr,	/* The object to test for being shared. */
#ifdef TCL_MEM_DEBUG
    const char *file,		/* The name of the source file calling this
    CONST char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
#else
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
#endif
{
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("checking whether previously disposed object is shared");
    }

#if TCL_THREADS
# ifdef TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;
	Tcl_HashTable *tablePtr;
	Tcl_HashEntry *hPtr;

	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	tablePtr = tsdPtr->objThreadMap;
	if (!tablePtr) {
	    Tcl_Panic("object table not initialized");
	}
	hPtr = Tcl_FindHashEntry(tablePtr, objPtr);
	hPtr = Tcl_FindHashEntry(tablePtr, (char *) objPtr);
	if (!hPtr) {
	    Tcl_Panic("Trying to %s of Tcl_Obj allocated in another thread",
                    "check shared status");
	    Tcl_Panic("%s%s",
		    "Trying to check shared status of"
		    "Tcl_Obj allocated in another thread");
	}
    }
# endif /* TCL_THREADS */
#endif /* TCL_MEM_DEBUG */
# endif
#endif

#ifdef TCL_COMPILE_STATS
    Tcl_MutexLock(&tclObjMutex);
    if ((objPtr)->refCount <= 1) {
	tclObjsShared[1]++;
    } else if ((objPtr)->refCount < TCL_MAX_SHARED_OBJ_STATS) {
	tclObjsShared[(objPtr)->refCount]++;
    } else {
	tclObjsShared[0]++;
    }
    Tcl_MutexUnlock(&tclObjMutex);
#endif /* TCL_COMPILE_STATS */
#endif

    return ((objPtr)->refCount > 1);
}

/*
 *----------------------------------------------------------------------
 *
3713
3714
3715
3716
3717
3718
3719
3720

3721
3722
3723
3724
3725
3726
3727
3848
3849
3850
3851
3852
3853
3854

3855
3856
3857
3858
3859
3860
3861
3862







-
+







 *	Tcl_CreateHashEntry.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InitObjHashTable(
    Tcl_HashTable *tablePtr)
    register Tcl_HashTable *tablePtr)
				/* Pointer to table record, which is supplied
				 * by the caller. */
{
    Tcl_InitCustomHashTable(tablePtr, TCL_CUSTOM_PTR_KEYS,
	    &tclObjHashKeyType);
}

3739
3740
3741
3742
3743
3744
3745
3746

3747
3748
3749
3750


3751

3752

3753
3754
3755
3756
3757
3758
3759
3874
3875
3876
3877
3878
3879
3880

3881
3882
3883


3884
3885
3886
3887

3888
3889
3890
3891
3892
3893
3894
3895







-
+


-
-
+
+

+
-
+







 *	Increments the reference count on the object.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
AllocObjEntry(
    TCL_UNUSED(Tcl_HashTable *),
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_HashEntry *hPtr = (Tcl_HashEntry *)Tcl_Alloc(sizeof(Tcl_HashEntry));
    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
    Tcl_HashEntry *hPtr;

    hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)));
    hPtr->key.objPtr = objPtr;
    hPtr->key.oneWordValue = (char *) objPtr;
    Tcl_IncrRefCount(objPtr);
    hPtr->clientData = NULL;

    return hPtr;
}

/*
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784




3785
3786
3787
3788
3789
3790
3791
3910
3911
3912
3913
3914
3915
3916




3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927







-
-
-
-
+
+
+
+







 */

int
TclCompareObjKeys(
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr2 = (Tcl_Obj *)hPtr->key.oneWordValue;
    const char *p1, *p2;
    size_t l1, l2;
    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
    Tcl_Obj *objPtr2 = (Tcl_Obj *) hPtr->key.oneWordValue;
    register CONST char *p1, *p2;
    register int l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller

       if (objPtr1 == objPtr2) return 1;
    */
3837
3838
3839
3840
3841
3842
3843
3844

3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865

3866
3867

3868
3869
3870
3871
3872
3873





3874
3875
3876
3877
3878
3879
3880
3881
3882
3883

3884
3885
3886
3887
3888




3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909

3910
3911
3912

3913
3914
3915
3916
3917
3918
3919
3920
3973
3974
3975
3976
3977
3978
3979

3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000

4001
4002

4003
4004
4005




4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019

4020
4021




4022
4023
4024
4025


















4026
4027

4028



4029

4030
4031
4032
4033
4034
4035
4036







-
+




















-
+

-
+


-
-
-
-
+
+
+
+
+









-
+

-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+
-
-
-
+
-







void
TclFreeObjEntry(
    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;

    Tcl_DecrRefCount(objPtr);
    Tcl_Free(hPtr);
    ckfree((char *) hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclHashObjKey --
 *
 *	Compute a one-word summary of the string representation of the
 *	Tcl_Obj, which can be used to generate a hash index.
 *
 * Results:
 *	The return value is a one-word summary of the information in the
 *	string representation of the Tcl_Obj.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TCL_HASH_TYPE
unsigned int
TclHashObjKey(
    TCL_UNUSED(Tcl_HashTable *),
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    const char *string = TclGetString(objPtr);
    size_t length = objPtr->length;
    TCL_HASH_TYPE result = 0;
    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
    CONST char *string = TclGetString(objPtr);
    int length = objPtr->length;
    unsigned int result = 0;
    int i;

    /*
     * I tried a zillion different hash functions and asked many other people
     * for advice. Many people had their own favorite functions, all
     * different, but no-one had much idea why they were good ones. I chose
     * the one below (multiply by 9 and add new character) because of the
     * following reasons:
     *
     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
     *    multiplying by 9 is just about as good.
     *	  multiplying by 9 is just about as good.
     * 2. Times-9 is (shift-left-3) plus (old). This means that each
     *    character's bits hang around in the low-order bits of the hash value
     *    for ever, plus they spread fairly rapidly up to the high-order bits
     *    to fill out the hash value. This seems works well both for decimal
     *    and non-decimal strings.
     *	  character's bits hang around in the low-order bits of the hash value
     *	  for ever, plus they spread fairly rapidly up to the high-order bits
     *	  to fill out the hash value. This seems works well both for decimal
     *	  and *non-decimal strings.
     *
     * Note that this function is very weak against malicious strings; it's
     * very easy to generate multiple keys that have the same hashcode. On the
     * other hand, that hardly ever actually occurs and this function *is*
     * very cheap, even by comparison with industry-standard hashes like FNV.
     * If real strength of hash is required though, use a custom hash based on
     * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
     * Tcl does not use that level of strength because it typically does not
     * need it (and some of the aspects of that strength are genuinely
     * unnecessary given the rest of Tcl's hash machinery, and the fact that
     * we do not either transfer hashes to another machine, use them as a true
     * substitute for equality, or attempt to minimize work in rebuilding the
     * hash table).
     *
     * See also HashStringKey in tclHash.c.
     * See also HashString in tclLiteral.c.
     *
     * See [tcl-Feature Request #2958832]
     */

    if (length) {
    for (i=0 ; i<length ; i++) {
	result = UCHAR(*string);
	while (--length) {
	    result += (result << 3) + UCHAR(*++string);
	result += (result << 3) + string[i];
	}
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
3934
3935
3936
3937
3938
3939
3940
3941

3942
3943
3944
3945
3946
3947




3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971





3972
3973
3974
3975
3976




3977
3978
3979
3980
3981
3982
3983
3984
3985
3986













3987
3988
3989
3990
3991

3992
3993
3994
3995

3996
3997

3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015

4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
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







-
+





-
+
+
+
+




















-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
-
-
-
-
+
-
-
+

















-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+




+
-
+
+
+


+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
+
+
+
+
+







 *----------------------------------------------------------------------
 */

Tcl_Command
Tcl_GetCommandFromObj(
    Tcl_Interp *interp,		/* The interpreter in which to resolve the
				 * command and to report errors. */
    Tcl_Obj *objPtr)	/* The object containing the command's name.
    register Tcl_Obj *objPtr)	/* The object containing the command's name.
				 * If the name starts with "::", will be
				 * looked up in global namespace. Else, looked
				 * up first in the current namespace, then in
				 * global namespace. */
{
    ResolvedCmdName *resPtr;
    register ResolvedCmdName *resPtr;
    register Command *cmdPtr;
    Namespace *refNsPtr;
    int result;

    /*
     * Get the internal representation, converting to a command type if
     * needed. The internal representation is a ResolvedCmdName that points to
     * the actual command.
     *
     * Check the context namespace and the namespace epoch of the resolved
     * symbol to make sure that it is fresh. Note that we verify that the
     * namespace id of the context namespace is the same as the one we cached;
     * this insures that the namespace wasn't deleted and a new one created at
     * the same address with the same command epoch. Note that fully qualified
     * names have a NULL refNsPtr, these checks needn't be made.
     *
     * Check also that the command's epoch is up to date, and that the command
     * is not deleted.
     *
     * If any check fails, then force another conversion to the command type,
     * to discard the old rep and create a new one.
     */

    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    if (objPtr->typePtr == &tclCmdNameType) {
        Command *cmdPtr = resPtr->cmdPtr;

    resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
    if ((objPtr->typePtr != &tclCmdNameType)
	    || (resPtr == NULL)
	    || (cmdPtr = resPtr->cmdPtr, cmdPtr->cmdEpoch != resPtr->cmdEpoch)
	    || (cmdPtr->flags & CMD_IS_DELETED)
        if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
                && (interp == cmdPtr->nsPtr->interp)
                && !(cmdPtr->nsPtr->flags & NS_DYING)) {
            Namespace *refNsPtr = (Namespace *)
                    TclGetCurrentNamespace(interp);
	    || (interp != cmdPtr->nsPtr->interp)
	    || (cmdPtr->nsPtr->flags & 	NS_DYING)
	    || ((resPtr->refNsPtr != NULL) &&
		     (((refNsPtr = (Namespace *) TclGetCurrentNamespace(interp))

            if ((resPtr->refNsPtr == NULL)
                || ((refNsPtr == resPtr->refNsPtr)
                    && (resPtr->refNsId == refNsPtr->nsId)
                    && (resPtr->refNsCmdEpoch == refNsPtr->cmdRefEpoch))) {
                return (Tcl_Command) cmdPtr;
            }
        }
    }

			     != resPtr->refNsPtr)
		     || (resPtr->refNsId != refNsPtr->nsId)
		     || (resPtr->refNsCmdEpoch != refNsPtr->cmdRefEpoch)))
	) {

	result = tclCmdNameType.setFromAnyProc(interp, objPtr);

	resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
	if ((result == TCL_OK) && resPtr) {
	    cmdPtr = resPtr->cmdPtr;
	} else {
	    cmdPtr = NULL;
	}
    /*
     * OK, must create a new internal representation (or fail) as any cache we
     * had is invalid one way or another.
     */

    }
    /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
    if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
        return NULL;
    }

    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    return (Tcl_Command) (resPtr ? resPtr->cmdPtr : NULL);
    return (Tcl_Command) cmdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetCmdNameObj --
 *
 *	Modify an object to be an CmdName object that refers to the argument
 *	Command structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The object's old internal rep is freed. It's string rep is not
 *	changed. The refcount in the Command structure is incremented to keep
 *	it from being freed if the command is later deleted until
 *	TclNRExecuteByteCode has a chance to recognize that it was deleted.
 *	TclExecuteByteCode has a chance to recognize that it was deleted.
 *
 *----------------------------------------------------------------------
 */

static void
SetCmdNameObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Command *cmdPtr,
    ResolvedCmdName *resPtr)
{
    Interp *iPtr = (Interp *) interp;
    ResolvedCmdName *fillPtr;
    const char *name = TclGetString(objPtr);

    if (resPtr) {
	fillPtr = resPtr;
    } else {
	fillPtr = (ResolvedCmdName *)Tcl_Alloc(sizeof(ResolvedCmdName));
	fillPtr->refCount = 1;
    }

    fillPtr->cmdPtr = cmdPtr;
    cmdPtr->refCount++;
    fillPtr->cmdEpoch = cmdPtr->cmdEpoch;

    /* NOTE: relying on NULL termination here. */
    if ((name[0] == ':') && (name[1] == ':')) {
	/*
	 * Fully qualified names always resolve to same thing. No need
	 * to record resolution context information.
	 */

	fillPtr->refNsPtr = NULL;
	fillPtr->refNsId = 0;		/* Will not be read */
	fillPtr->refNsCmdEpoch = 0;	/* Will not be read */
    } else {
	/*
	 * Record current state of current namespace as the resolution
	 * context of this command name lookup.
	 */
	Namespace *currNsPtr = iPtr->varFramePtr->nsPtr;

	fillPtr->refNsPtr = currNsPtr;
	fillPtr->refNsId = currNsPtr->nsId;
	fillPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
    }

    if (resPtr == NULL) {
	TclFreeIntRep(objPtr);

	objPtr->internalRep.twoPtrValue.ptr1 = fillPtr;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	objPtr->typePtr = &tclCmdNameType;
    }
}

void
TclSetCmdNameObj(
    Tcl_Interp *interp,		/* Points to interpreter containing command
				 * that should be cached in objPtr. */
    Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
    register Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
				 * CmdName object. */
    Command *cmdPtr)		/* Points to Command structure that the
				 * CmdName object should refer to. */
{
    Interp *iPtr = (Interp *) interp;
    ResolvedCmdName *resPtr;
    register ResolvedCmdName *resPtr;
    register Namespace *currNsPtr;
    char *name;

    if (objPtr->typePtr == &tclCmdNameType) {
	return;
    }

    cmdPtr->refCount++;
	resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
	if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) {
	    return;
	}
    }
    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
    resPtr->cmdPtr = cmdPtr;
    resPtr->cmdEpoch = cmdPtr->cmdEpoch;
    resPtr->refCount = 1;

    name = TclGetString(objPtr);
    if ((*name++ == ':') && (*name == ':')) {
	/*
	 * The name is fully qualified: set the referring namespace to
	 * NULL.
	 */

	resPtr->refNsPtr = NULL;
    } else {
	/*
	 * Get the current namespace.
	 */

	currNsPtr = iPtr->varFramePtr->nsPtr;

	resPtr->refNsPtr = currNsPtr;
	resPtr->refNsId = currNsPtr->nsId;
	resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
    }
    SetCmdNameObj(interp, objPtr, cmdPtr, NULL);

    TclFreeIntRep(objPtr);
    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    objPtr->typePtr = &tclCmdNameType;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeCmdNameInternalRep --
 *
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
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







-
+


+
-
+

+





+
-
+







-

-
+

+







 *	ResolvedSymbol, which may free the Command structure.
 *
 *----------------------------------------------------------------------
 */

static void
FreeCmdNameInternalRep(
    Tcl_Obj *objPtr)	/* CmdName object with internal
    register Tcl_Obj *objPtr)	/* CmdName object with internal
				 * representation to free. */
{
    register ResolvedCmdName *resPtr =
    ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
	(ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;

    if (resPtr != NULL) {
	/*
	 * Decrement the reference count of the ResolvedCmdName structure. If
	 * there are no more uses, free the ResolvedCmdName structure.
	 */

	resPtr->refCount--;
	if (resPtr->refCount-- <= 1) {
	if (resPtr->refCount == 0) {
	    /*
	     * Now free the cached command, unless it is still in its hash
	     * table or if there are other references to it from other cmdName
	     * objects.
	     */

	    Command *cmdPtr = resPtr->cmdPtr;

	    TclCleanupCommandMacro(cmdPtr);
	    Tcl_Free(resPtr);
	    ckfree((char *) resPtr);
	}
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupCmdNameInternalRep --
4158
4159
4160
4161
4162
4163
4164
4165

4166
4167


4168
4169

4170

4171

4172
4173
4174
4175
4176
4177
4178
4251
4252
4253
4254
4255
4256
4257

4258
4259

4260
4261
4262

4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274







-
+

-
+
+

-
+

+

+







 *
 *----------------------------------------------------------------------
 */

static void
DupCmdNameInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1;
    register ResolvedCmdName *resPtr = (ResolvedCmdName *)
	    srcPtr->internalRep.twoPtrValue.ptr1;

    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
    copyPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
    if (resPtr != NULL) {
	resPtr->refCount++;
    }
    copyPtr->typePtr = &tclCmdNameType;
}

/*
 *----------------------------------------------------------------------
 *
 * SetCmdNameFromAny --
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
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
4328
4329
4330


4331






4332






4333
4334
4335
4336
4337
4338
4339
4340


4341


4342


4343
















4344
4345
4346
4347
4348
4349
4350
4351



4352


4353






4354
4355




4356
4357






4358
4359
4360
4361
4362
4363
4364








4365
4366
4367
4368



4369







4370


4371
4372
4373
4374
4375
4376
4377
4378


4379
4380







-
+

+
-
-
-
+
+
+
+














-
-
+


+
-
-
+
+


-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-

-
-








-
-


 *
 *----------------------------------------------------------------------
 */

static int
SetCmdNameFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name;
    Command *cmdPtr;
    ResolvedCmdName *resPtr;
    char *name;
    register Command *cmdPtr;
    Namespace *currNsPtr;
    register ResolvedCmdName *resPtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }

    /*
     * Find the Command structure, if any, that describes the command called
     * "name". Build a ResolvedCmdName that holds a cached pointer to this
     * Command, and bump the reference count in the referenced Command
     * structure. A Command structure will not be deleted as long as it is
     * referenced from a CmdName object.
     */

    name = TclGetString(objPtr);
    cmdPtr = (Command *)
	    Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
    cmdPtr = (Command *) Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);

    /*
     * Free the old internalRep before setting the new one. Do this after
     * Stop shimmering and caching nothing when we found nothing.  Just
     * report the failure to find the command as an error.
     * getting the string rep to allow the conversion code (in particular,
     * Tcl_GetStringFromObj) to use that old internalRep.
     */

    if (cmdPtr == NULL || !TclRoutineHasName(cmdPtr)) {
    if (cmdPtr) {
	return TCL_ERROR;
    }

    resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
    if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) {
	/*
	 * Re-use existing ResolvedCmdName struct when possible.
	cmdPtr->refCount++;
	resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1;
	if ((objPtr->typePtr == &tclCmdNameType)
		&& resPtr && (resPtr->refCount == 1)) {
	    /*
	     * Reuse the old ResolvedCmdName struct instead of freeing it
	 * Cleanup the old fields that need it.
	 */
	     */

	Command *oldCmdPtr = resPtr->cmdPtr;

	if (oldCmdPtr->refCount-- <= 1) {
	    TclCleanupCommandMacro(oldCmdPtr);
	}

    } else {
	resPtr = NULL;
    }

    SetCmdNameObj(interp, objPtr, cmdPtr, resPtr);
    return TCL_OK;
	    Command *oldCmdPtr = resPtr->cmdPtr;
	    if (--oldCmdPtr->refCount == 0) {
		TclCleanupCommandMacro(oldCmdPtr);
	    }
	} else {
	    TclFreeIntRep(objPtr);
	    resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
	    resPtr->refCount = 1;
}

	    objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr;
/*
 *----------------------------------------------------------------------
	    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 *
 * Tcl_RepresentationCmd --
	    objPtr->typePtr = &tclCmdNameType;
 *
 *	Implementation of the "tcl::unsupported::representation" command.
 *
 * Results:
 *	Reports the current representation (Tcl_Obj type) of its argument.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_RepresentationCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
	}
	resPtr->cmdPtr = cmdPtr;
	resPtr->cmdEpoch = cmdPtr->cmdEpoch;
	if ((*name++ == ':') && (*name == ':')) {
	    /*
	     * The name is fully qualified: set the referring namespace to
	     * NULL.
	     */
    int objc,
    Tcl_Obj *const objv[])
{

    Tcl_Obj *descObj;

	    resPtr->refNsPtr = NULL;
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }

    /*
	} else {
	    /*
     * Value is a bignum with a refcount of 14, object pointer at 0x12345678,
     * internal representation 0x45671234:0x98765432, string representation
     * "1872361827361287"
     */
	     * Get the current namespace.
	     */

    descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
	    " object pointer at %p",
	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
	    objv[1]->refCount, objv[1]);


	    currNsPtr = iPtr->varFramePtr->nsPtr;

	    resPtr->refNsPtr = currNsPtr;
	    resPtr->refNsId = currNsPtr->nsId;
	    resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
	}
    if (objv[1]->typePtr) {
	if (objv[1]->typePtr == &tclDoubleType) {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
		    objv[1]->internalRep.doubleValue);
	} else {
	    Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
		    (void *) objv[1]->internalRep.twoPtrValue.ptr1,
		    (void *) objv[1]->internalRep.twoPtrValue.ptr2);
    } else {
	TclFreeIntRep(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = NULL;
	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
	}
    }

	objPtr->typePtr = &tclCmdNameType;
    if (objv[1]->bytes) {
        Tcl_AppendToObj(descObj, ", string representation \"", -1);
	Tcl_AppendLimitedToObj(descObj, objv[1]->bytes, objv[1]->length,
                16, "...");
	Tcl_AppendToObj(descObj, "\"", -1);
    } else {
	Tcl_AppendToObj(descObj, ", no string representation", -1);
    }

    Tcl_SetObjResult(interp, descObj);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Deleted generic/tclOptimize.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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


























































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclOptimize.c --
 *
 *	This file contains the bytecode optimizer.
 *
 * Copyright (c) 2013 by Donal Fellows.
 *
 * 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 "tclCompile.h"
#include <assert.h>

/*
 * Forward declarations.
 */

static void		AdvanceJumps(CompileEnv *envPtr);
static void		ConvertZeroEffectToNOP(CompileEnv *envPtr);
static void		LocateTargetAddresses(CompileEnv *envPtr,
			    Tcl_HashTable *tablePtr);
static void		TrimUnreachable(CompileEnv *envPtr);

/*
 * Helper macros.
 */

#define DefineTargetAddress(tablePtr, address) \
    ((void) Tcl_CreateHashEntry((tablePtr), (void *) (address), &isNew))
#define IsTargetAddress(tablePtr, address) \
    (Tcl_FindHashEntry((tablePtr), (void *) (address)) != NULL)
#define AddrLength(address) \
    (tclInstructionTable[*(unsigned char *)(address)].numBytes)
#define InstLength(instruction) \
    (tclInstructionTable[UCHAR(instruction)].numBytes)

/*
 * ----------------------------------------------------------------------
 *
 * LocateTargetAddresses --
 *
 *	Populate a hash table with places that we need to be careful around
 *	because they're the targets of various kinds of jumps and other
 *	non-local behavior.
 *
 * ----------------------------------------------------------------------
 */

static void
LocateTargetAddresses(
    CompileEnv *envPtr,
    Tcl_HashTable *tablePtr)
{
    unsigned char *currentInstPtr, *targetInstPtr;
    int isNew, i;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;

    Tcl_InitHashTable(tablePtr, TCL_ONE_WORD_KEYS);

    /*
     * The starts of commands represent target addresses.
     */

    for (i=0 ; i<envPtr->numCommands ; i++) {
	DefineTargetAddress(tablePtr,
		envPtr->codeStart + envPtr->cmdMapPtr[i].codeOffset);
    }

    /*
     * Find places where we should be careful about replacing instructions
     * because they are the targets of various types of jumps.
     */

    for (currentInstPtr = envPtr->codeStart ;
	    currentInstPtr < envPtr->codeNext ;
	    currentInstPtr += AddrLength(currentInstPtr)) {
	switch (*currentInstPtr) {
	case INST_JUMP1:
	case INST_JUMP_TRUE1:
	case INST_JUMP_FALSE1:
	    targetInstPtr = currentInstPtr+TclGetInt1AtPtr(currentInstPtr+1);
	    goto storeTarget;
	case INST_JUMP4:
	case INST_JUMP_TRUE4:
	case INST_JUMP_FALSE4:
	case INST_START_CMD:
	    targetInstPtr = currentInstPtr+TclGetInt4AtPtr(currentInstPtr+1);
	    goto storeTarget;
	case INST_BEGIN_CATCH4:
	    targetInstPtr = envPtr->codeStart + envPtr->exceptArrayPtr[
		    TclGetUInt4AtPtr(currentInstPtr+1)].codeOffset;
	storeTarget:
	    DefineTargetAddress(tablePtr, targetInstPtr);
	    break;
	case INST_JUMP_TABLE:
	    hPtr = Tcl_FirstHashEntry(
		    &JUMPTABLEINFO(envPtr, currentInstPtr+1)->hashTable,
		    &hSearch);
	    for (; hPtr ; hPtr = Tcl_NextHashEntry(&hSearch)) {
		targetInstPtr = currentInstPtr +
			PTR2INT(Tcl_GetHashValue(hPtr));
		DefineTargetAddress(tablePtr, targetInstPtr);
	    }
	    break;
	case INST_RETURN_CODE_BRANCH:
	    for (i=TCL_ERROR ; i<TCL_CONTINUE+1 ; i++) {
		DefineTargetAddress(tablePtr, currentInstPtr + 2*i - 1);
	    }
	    break;
	}
    }

    /*
     * Add a marker *after* the last bytecode instruction. WARNING: points to
     * one past the end!
     */

    DefineTargetAddress(tablePtr, currentInstPtr);

    /*
     * Enter in the targets of exception ranges.
     */

    for (i=0 ; i<envPtr->exceptArrayNext ; i++) {
	ExceptionRange *rangePtr = &envPtr->exceptArrayPtr[i];

	if (rangePtr->type == CATCH_EXCEPTION_RANGE) {
	    targetInstPtr = envPtr->codeStart + rangePtr->catchOffset;
	    DefineTargetAddress(tablePtr, targetInstPtr);
	} else {
	    targetInstPtr = envPtr->codeStart + rangePtr->breakOffset;
	    DefineTargetAddress(tablePtr, targetInstPtr);
	    if (rangePtr->continueOffset >= 0) {
		targetInstPtr = envPtr->codeStart + rangePtr->continueOffset;
		DefineTargetAddress(tablePtr, targetInstPtr);
	    }
	}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TrimUnreachable --
 *
 *	Converts code that provably can't be executed into NOPs and reduces
 *	the overall reported length of the bytecode where that is possible.
 *
 * ----------------------------------------------------------------------
 */

static void
TrimUnreachable(
    CompileEnv *envPtr)
{
    unsigned char *currentInstPtr;
    Tcl_HashTable targets;

    LocateTargetAddresses(envPtr, &targets);

    for (currentInstPtr = envPtr->codeStart ;
	    currentInstPtr < envPtr->codeNext-1 ;
	    currentInstPtr += AddrLength(currentInstPtr)) {
	int clear = 0;

	if (*currentInstPtr != INST_DONE) {
	    continue;
	}

	while (!IsTargetAddress(&targets, currentInstPtr + 1 + clear)) {
	    clear += AddrLength(currentInstPtr + 1 + clear);
	}
	if (currentInstPtr + 1 + clear == envPtr->codeNext) {
	    envPtr->codeNext -= clear;
	} else {
	    while (clear --> 0) {
		*(currentInstPtr + 1 + clear) = INST_NOP;
	    }
	}
    }

    Tcl_DeleteHashTable(&targets);
}

/*
 * ----------------------------------------------------------------------
 *
 * ConvertZeroEffectToNOP --
 *
 *	Replace PUSH/POP sequences (when non-hazardous) with NOPs. Also
 *	replace PUSH empty/STR_CONCAT and TRY_CVT_NUMERIC (when followed by an
 *	operation that guarantees the check for arithmeticity) and eliminate
 *	LNOT when we can invert the following JUMP condition.
 *
 * ----------------------------------------------------------------------
 */

static void
ConvertZeroEffectToNOP(
    CompileEnv *envPtr)
{
    unsigned char *currentInstPtr;
    int size;
    Tcl_HashTable targets;

    LocateTargetAddresses(envPtr, &targets);
    for (currentInstPtr = envPtr->codeStart ;
	    currentInstPtr < envPtr->codeNext ; currentInstPtr += size) {
	int blank = 0, i, nextInst;

	size = AddrLength(currentInstPtr);
	while ((currentInstPtr + size < envPtr->codeNext)
		&& *(currentInstPtr+size) == INST_NOP) {
	    if (IsTargetAddress(&targets, currentInstPtr + size)) {
		break;
	    }
	    size += InstLength(INST_NOP);
	}
	if (IsTargetAddress(&targets, currentInstPtr + size)) {
	    continue;
	}
	nextInst = *(currentInstPtr + size);
	switch (*currentInstPtr) {
	case INST_PUSH1:
	    if (nextInst == INST_POP) {
		blank = size + InstLength(nextInst);
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt1AtPtr(currentInstPtr + 1));
		size_t numBytes;

		(void) TclGetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;
	case INST_PUSH4:
	    if (nextInst == INST_POP) {
		blank = size + 1;
	    } else if (nextInst == INST_STR_CONCAT1
		    && TclGetUInt1AtPtr(currentInstPtr + size + 1) == 2) {
		Tcl_Obj *litPtr = TclFetchLiteral(envPtr,
			TclGetUInt4AtPtr(currentInstPtr + 1));
		size_t numBytes;

		(void) TclGetStringFromObj(litPtr, &numBytes);
		if (numBytes == 0) {
		    blank = size + InstLength(nextInst);
		}
	    }
	    break;

	case INST_LNOT:
	    switch (nextInst) {
	    case INST_JUMP_TRUE1:
		blank = size;
		*(currentInstPtr + size) = INST_JUMP_FALSE1;
		break;
	    case INST_JUMP_FALSE1:
		blank = size;
		*(currentInstPtr + size) = INST_JUMP_TRUE1;
		break;
	    case INST_JUMP_TRUE4:
		blank = size;
		*(currentInstPtr + size) = INST_JUMP_FALSE4;
		break;
	    case INST_JUMP_FALSE4:
		blank = size;
		*(currentInstPtr + size) = INST_JUMP_TRUE4;
		break;
	    }
	    break;

	case INST_TRY_CVT_TO_NUMERIC:
	    switch (nextInst) {
	    case INST_JUMP_TRUE1:
	    case INST_JUMP_TRUE4:
	    case INST_JUMP_FALSE1:
	    case INST_JUMP_FALSE4:
	    case INST_INCR_SCALAR1:
	    case INST_INCR_ARRAY1:
	    case INST_INCR_ARRAY_STK:
	    case INST_INCR_SCALAR_STK:
	    case INST_INCR_STK:
	    case INST_EQ:
	    case INST_NEQ:
	    case INST_LT:
	    case INST_LE:
	    case INST_GT:
	    case INST_GE:
	    case INST_MOD:
	    case INST_LSHIFT:
	    case INST_RSHIFT:
	    case INST_BITOR:
	    case INST_BITXOR:
	    case INST_BITAND:
	    case INST_EXPON:
	    case INST_ADD:
	    case INST_SUB:
	    case INST_DIV:
	    case INST_MULT:
	    case INST_LNOT:
	    case INST_BITNOT:
	    case INST_UMINUS:
	    case INST_UPLUS:
	    case INST_TRY_CVT_TO_NUMERIC:
		blank = size;
		break;
	    }
	    break;
	}

	if (blank > 0) {
	    for (i=0 ; i<blank ; i++) {
		*(currentInstPtr + i) = INST_NOP;
	    }
	    size = blank;
	}
    }
    Tcl_DeleteHashTable(&targets);
}

/*
 * ----------------------------------------------------------------------
 *
 * AdvanceJumps --
 *
 *	Advance jumps past NOPs and chained JUMPs. After this runs, the only
 *	JUMPs that jump to a NOP or a JUMP will be length-1 ones that run out
 *	of room in their opcode to be targeted to where they really belong.
 *
 * ----------------------------------------------------------------------
 */

static void
AdvanceJumps(
    CompileEnv *envPtr)
{
    unsigned char *currentInstPtr;
    Tcl_HashTable jumps;

    for (currentInstPtr = envPtr->codeStart ;
	    currentInstPtr < envPtr->codeNext-1 ;
	    currentInstPtr += AddrLength(currentInstPtr)) {
	int offset, delta, isNew;

	switch (*currentInstPtr) {
	case INST_JUMP1:
	case INST_JUMP_TRUE1:
	case INST_JUMP_FALSE1:
	    offset = TclGetInt1AtPtr(currentInstPtr + 1);
	    Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
	    for (delta=0 ; offset+delta != 0 ;) {
		if (offset + delta < -128 || offset + delta > 127) {
		    break;
		}
		Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
		if (!isNew) {
		    offset = TclGetInt1AtPtr(currentInstPtr + 1);
		    break;
		}
		offset += delta;
		switch (*(currentInstPtr + offset)) {
		case INST_NOP:
		    delta = InstLength(INST_NOP);
		    continue;
		case INST_JUMP1:
		    delta = TclGetInt1AtPtr(currentInstPtr + offset + 1);
		    continue;
		case INST_JUMP4:
		    delta = TclGetInt4AtPtr(currentInstPtr + offset + 1);
		    continue;
		}
		break;
	    }
	    Tcl_DeleteHashTable(&jumps);
	    TclStoreInt1AtPtr(offset, currentInstPtr + 1);
	    continue;

	case INST_JUMP4:
	case INST_JUMP_TRUE4:
	case INST_JUMP_FALSE4:
	    Tcl_InitHashTable(&jumps, TCL_ONE_WORD_KEYS);
	    Tcl_CreateHashEntry(&jumps, INT2PTR(0), &isNew);
	    for (offset = TclGetInt4AtPtr(currentInstPtr + 1); offset!=0 ;) {
		Tcl_CreateHashEntry(&jumps, INT2PTR(offset), &isNew);
		if (!isNew) {
		    offset = TclGetInt4AtPtr(currentInstPtr + 1);
		    break;
		}
		switch (*(currentInstPtr + offset)) {
		case INST_NOP:
		    offset += InstLength(INST_NOP);
		    continue;
		case INST_JUMP1:
		    offset += TclGetInt1AtPtr(currentInstPtr + offset + 1);
		    continue;
		case INST_JUMP4:
		    offset += TclGetInt4AtPtr(currentInstPtr + offset + 1);
		    continue;
		}
		break;
	    }
	    Tcl_DeleteHashTable(&jumps);
	    TclStoreInt4AtPtr(offset, currentInstPtr + 1);
	    continue;
	}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOptimizeBytecode --
 *
 *	A very simple peephole optimizer for bytecode.
 *
 * ----------------------------------------------------------------------
 */

void
TclOptimizeBytecode(
    void *envPtr)
{
    ConvertZeroEffectToNOP((CompileEnv *)envPtr);
    AdvanceJumps((CompileEnv *)envPtr);
    TrimUnreachable((CompileEnv *)envPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

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
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
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







-
-
-






-
+
+
+
+
+
+
+
+



















-
+


+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
-
-
-
-
+
-


-
+



-
-
-

-

-
+
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









 * 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.
 */

static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
static Tcl_PanicProc *panicProc = NULL;

/*
 * The platformPanicProc variable contains a pointer to a platform specific
 * panic procedure, if any. (TclpPanic may be NULL via a macro.)
 */

static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
    Tcl_PanicProc *proc)
{
    panicProc = proc;
}
    Tcl_InitSubsystems();

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PanicVA --
 *
 *	Print an error message and kill the process.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The process dies, entering the debugger if possible.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_PanicVA(
    CONST char *format,		/* Format string, suitable for passing to
				 * fprintf. */
    va_list argList)		/* Variable argument list. */
{
    char *arg1, *arg2, *arg3, *arg4;	/* Additional arguments (variable in
					 * number) to pass to fprintf. */
    char *arg5, *arg6, *arg7, *arg8;

    arg1 = va_arg(argList, char *);
    arg2 = va_arg(argList, char *);
    arg3 = va_arg(argList, char *);
    arg4 = va_arg(argList, char *);
    arg5 = va_arg(argList, char *);
    arg6 = va_arg(argList, char *);
    arg7 = va_arg(argList, char *);
    arg8 = va_arg(argList, char *);

    if (panicProc != NULL) {
	(void) (*panicProc)(format, arg1, arg2, arg3, arg4,
		arg5, arg6, arg7, arg8);
    } else if (platformPanicProc != NULL) {
	(void) (*platformPanicProc)(format, arg1, arg2, arg3, arg4,
		arg5, arg6, arg7, arg8);
    } else {
	(void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
		arg7, arg8);
	(void) fprintf(stderr, "\n");
	(void) fflush(stderr);
	abort();
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Panic --
 *
 *	Print an error message and kill the process.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The process dies, entering the debugger if possible.
 *
 *----------------------------------------------------------------------
 */

/*
 * The following comment is here so that Coverity's static analizer knows that
 * a Tcl_Panic() call can never return and avoids lots of false positives.
 */

	/* ARGSUSED */
/* coverity[+kill] */
void
Tcl_Panic(
    const char *format,
    CONST char *format,
    ...)
{
    va_list argList;
    char *arg1, *arg2, *arg3;	/* Additional arguments (variable in number)
				 * to pass to fprintf. */
    char *arg4, *arg5, *arg6, *arg7, *arg8;


    va_start(argList, format);
    arg1 = va_arg(argList, char *);
    Tcl_PanicVA(format, argList);
    arg2 = va_arg(argList, char *);
    arg3 = va_arg(argList, char *);
    arg4 = va_arg(argList, char *);
    arg5 = va_arg(argList, char *);
    arg6 = va_arg(argList, char *);
    arg7 = va_arg(argList, char *);
    arg8 = va_arg(argList, char *);
    va_end (argList);

    if (panicProc != NULL) {
	panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
    } else {
#if defined(_WIN32) || defined(__CYGWIN__)
    tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
#else
	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
		arg8);
	fprintf(stderr, "\n");
	fflush(stderr);
#endif
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();
#   elif defined(_MSC_VER) && defined (_M_IX86)
	_asm {int 3}
#   elif defined(_WIN32)
	DebugBreak();
#   endif
#if defined(_WIN32)
	ExitProcess(1);
#else
	abort();
#endif
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclParse.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





































42
43
44
45
46
47
48
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







-
-



-
+
+
+
+
+
+


















+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * 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"
#include <assert.h>

/*
 * The following table provides parsing information about each possible 8-bit
 * character. The table is designed to be referenced with unsigned characters.
 * 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
 * 128. The table is always indexed with a 128-byte offset (the 128th entry
 * corresponds to a character value of 0).
 *
 * The macro CHAR_TYPE is used to index into the table and return information
 * about its character argument. The following return values are defined.
 *
 * TYPE_NORMAL -	All characters that don't have special significance to
 *			the Tcl parser.
 * TYPE_SPACE -		The character is a whitespace character other than
 *			newline.
 * TYPE_COMMAND_END -	Character is newline or semicolon.
 * TYPE_SUBS -		Character begins a substitution or has other special
 *			meaning in ParseTokens: backslash, dollar sign, or
 *			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)]

const char tclCharTypeTable[] = {
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,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,

    /*
     * Positive character values, from 0-127:
     */

    TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
115
116
117
118
119
120
121
122
123


124
125

126
127

128
129
130
131

132
133
134
135
136
137
138
165
166
167
168
169
170
171


172
173
174

175
176

177
178



179
180
181
182
183
184
185
186







-
-
+
+

-
+

-
+

-
-
-
+







    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
};

/*
 * Prototypes for local functions defined in this file:
 */

static int	CommandComplete(const char *script, size_t numBytes);
static size_t		ParseComment(const char *src, size_t numBytes,
static inline int	CommandComplete(const char *script, int numBytes);
static int		ParseComment(const char *src, int numBytes,
			    Tcl_Parse *parsePtr);
static int		ParseTokens(const char *src, size_t numBytes, int mask,
static int		ParseTokens(const char *src, int numBytes, int mask,
			    int flags, Tcl_Parse *parsePtr);
static size_t		ParseWhiteSpace(const char *src, size_t numBytes,
static int		ParseWhiteSpace(const char *src, int numBytes,
			    int *incompletePtr, char *typePtr);
static size_t		ParseAllWhiteSpace(const char *src, size_t numBytes,
			    int *incompletePtr);
static int		ParseHex(const char *src, size_t numBytes,
static int		ParseHex(const char *src, int numBytes,
			    int *resultPtr);

/*
 *----------------------------------------------------------------------
 *
 * TclParseInit --
 *
147
148
149
150
151
152
153
154

155
156
157
158
159
160
161
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209







-
+







 *----------------------------------------------------------------------
 */

void
TclParseInit(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting */
    const char *start,		/* Start of string to be parsed. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
    int numBytes,		/* Total number of bytes in string. If < 0,
				 * the script consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr)	/* Points to struct to initialize */
{
    parsePtr->numWords = 0;
    parsePtr->tokenPtr = parsePtr->staticTokens;
    parsePtr->numTokens = 0;
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
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







-
+






-
+




-
+








-
+

-
+





-
-
+








int
Tcl_ParseCommand(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* First character of string containing one or
				 * more Tcl commands. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the script consists of all bytes up to the
				 * first null character. */
    int nested,			/* Non-zero means this is a nested command:
				 * close bracket should be considered a
				 * command terminator. If zero, then close
				 * bracket has no special meaning. */
    Tcl_Parse *parsePtr)
    register Tcl_Parse *parsePtr)
				/* Structure to fill in with information about
				 * the parsed command; any previous
				 * information in the structure is ignored. */
{
    const char *src;		/* Points to current character in the
    register const char *src;	/* Points to current character in the
				 * command. */
    char type;			/* Result returned by CHAR_TYPE(*src). */
    Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
    int wordIndex;		/* Index of word token for current word. */
    int terminators;		/* CHAR_TYPE bits that indicate the end of a
				 * command. */
    const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
				 * point to char after terminating one. */
    size_t scanned;
    int scanned;

    if (numBytes == TCL_INDEX_NONE && start) {
    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    TclParseInit(interp, start, numBytes, parsePtr);
    if ((start == NULL) && (numBytes != 0)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't parse a NULL pointer", -1));
	    Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC);
	}
	return TCL_ERROR;
    }
    parsePtr->commentStart = NULL;
    parsePtr->commentSize = 0;
    parsePtr->commandStart = NULL;
    parsePtr->commandSize = 0;
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
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







-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    /*
     * The following loop parses the words of the command, one word in each
     * iteration through the loop.
     */

    parsePtr->commandStart = src;
    type = CHAR_TYPE(*src);
    scanned = 1;	/* Can't have missing whitepsace before first word. */
    while (1) {
	int expandWord = 0;

	/* Are we at command termination? */

	if ((numBytes == 0) || (type & terminators) != 0) {
	    parsePtr->term = src;
	    parsePtr->commandSize = src + (numBytes != 0)
		    - parsePtr->commandStart;
	    return TCL_OK;
	}

	/* Are we missing white space after previous word? */

	if (scanned == 0) {
	    if (src[-1] == '"') {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "extra characters after close-quote", -1));
		}
		parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
	    } else {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "extra characters after close-brace", -1));
		}
		parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
	    }
	    parsePtr->term = src;
	error:
	    Tcl_FreeParse(parsePtr);
	    parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
	    return TCL_ERROR;
	}

	/*
	 * Create the token for the word.
	 */

	TclGrowParseTokenArray(parsePtr, 1);
	wordIndex = parsePtr->numTokens;
	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	tokenPtr->type = TCL_TOKEN_WORD;

	/*
	 * Skip white space before the word. Also skip a backslash-newline
	 * sequence: it should be treated just like white space.
	 */

	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
	src += scanned;
	numBytes -= scanned;
	if (numBytes == 0) {
	    parsePtr->term = src;
	    break;
	}
	if ((type & terminators) != 0) {
	    parsePtr->term = src;
	    src++;
	    break;
	}
	tokenPtr->start = src;
	parsePtr->numTokens++;
	parsePtr->numWords++;

	/*
	 * At this point the word can have one of four forms: something
	 * enclosed in quotes, something enclosed in braces, and expanding
342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
372
373
374
375
376
377
378

379
380
381
382
383
384
385
386







-
+







	     */

	    expPtr = &parsePtr->tokenPtr[expIdx];
	    if ((0 == expandWord)
		    /* Haven't seen prefix already */
		    && (1 == parsePtr->numTokens - expIdx)
		    /* Only one token */
		    && (((1 == expPtr->size)
		    && (((1 == (size_t) expPtr->size)
			    /* Same length as prefix */
			    && (expPtr->start[0] == '*')))
			    /* Is the prefix */
		    && (numBytes > 0) && (0 == ParseWhiteSpace(termPtr,
			    numBytes, &parsePtr->incomplete, &type))
		    && (type != TYPE_COMMAND_END)
		    /* Non-whitespace follows */) {
377
378
379
380
381
382
383
384
385

386
387
388
389
390
391
392
407
408
409
410
411
412
413


414
415
416
417
418
419
420
421







-
-
+







	 * case of a word consisting of a single range of literal text.
	 */

	tokenPtr = &parsePtr->tokenPtr[wordIndex];
	tokenPtr->size = src - tokenPtr->start;
	tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
	if (expandWord) {
	    size_t i;
	    int isLiteral = 1;
	    int i, isLiteral = 1;

	    /*
	     * When a command includes a word that is an expanded literal; for
	     * example, {*}{1 2 3}, the parser performs that expansion
	     * immediately, generating several TCL_TOKEN_SIMPLE_WORDs instead
	     * of a single TCL_TOKEN_EXPAND_WORD that the Tcl_ParseCommand()
	     * caller might have to expand. This notably makes it simpler for
424
425
426
427
428
429
430
431

432
433
434
435
436
437
438
453
454
455
456
457
458
459

460
461
462
463
464
465
466
467







-
+








		/*
		 * Step through the literal string, parsing and counting list
		 * elements.
		 */

		while (nextElem < listEnd) {
		    size_t size;
		    int size;

		    code = TclFindElement(NULL, nextElem, listEnd - nextElem,
			    &elemStart, &nextElem, &size, &literal);
		    if ((code != TCL_OK) || !literal) {
			break;
		    }
		    if (elemStart < listEnd) {
523
524
525
526
527
528
529



530


531
532

533
534
535






































536
537
538
539
540
541
542
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







+
+
+
-
+
+


+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		tokenPtr->type = TCL_TOKEN_EXPAND_WORD;
	    }
	} else if ((tokenPtr->numComponents == 1)
		&& (tokenPtr[1].type == TCL_TOKEN_TEXT)) {
	    tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
	}

	/*
	 * Do two additional checks: (a) make sure we're really at the end of
	 * a word (there might have been garbage left after a quoted or braced
	/* Parse the whitespace between words. */
	 * word), and (b) check for the end of the command.
	 */

	scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
	if (scanned) {
	src += scanned;
	numBytes -= scanned;
    }
	    src += scanned;
	    numBytes -= scanned;
	    continue;
	}

	if (numBytes == 0) {
	    parsePtr->term = src;
	    break;
	}
	if ((type & terminators) != 0) {
	    parsePtr->term = src;
	    src++;
	    break;
	}
	if (src[-1] == '"') {
	    if (interp != NULL) {
		Tcl_SetResult(interp, "extra characters after close-quote",
			TCL_STATIC);
	    }
	    parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
	} else {
	    if (interp != NULL) {
		Tcl_SetResult(interp, "extra characters after close-brace",
			TCL_STATIC);
	    }
	    parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
	}
	parsePtr->term = src;
	goto error;
    }

    parsePtr->commandSize = src - parsePtr->commandStart;
    return TCL_OK;

  error:
    Tcl_FreeParse(parsePtr);
    parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIsSpaceProc --
 *
550
551
552
553
554
555
556
557

558
559
560
561
562
563
564
619
620
621
622
623
624
625

626
627
628
629
630
631
632
633







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclIsSpaceProc(
    int byte)
    char byte)
{
    return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
}

/*
 *----------------------------------------------------------------------
 *
579
580
581
582
583
584
585
586

587
588
589
590
591
592
593
648
649
650
651
652
653
654

655
656
657
658
659
660
661
662







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclIsBareword(
    int byte)
    char byte)
{
    if (byte < '0' || byte > 'z') {
	return 0;
    }
    if (byte <= '9' || byte >= 'a') {
	return 1;
    }
616
617
618
619
620
621
622
623

624
625
626

627
628
629
630
631
632
633


634
635
636
637
638
639
640
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







-
+


-
+





-
-
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
static int
ParseWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    register int numBytes,	/* Max number of bytes to scan. */
    int *incompletePtr,		/* Set this boolean memory to true if parsing
				 * indicates an incomplete command. */
    char *typePtr)		/* Points to location to store character type
				 * of character that ends run of whitespace */
{
    char type = TYPE_NORMAL;
    const char *p = src;
    register char type = TYPE_NORMAL;
    register const char *p = src;

    while (1) {
	while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) {
	    numBytes--;
	    p++;
	}
	if (numBytes && (type & TYPE_SUBS)) {
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
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







-
-
+
+

-
+
-

+




-
+






-
-
-
-
-
-
-
-
-







 *
 * Results:
 *	Returns the number of bytes recognized as white space.
 *
 *----------------------------------------------------------------------
 */

static size_t
ParseAllWhiteSpace(
int
TclParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of byes to scan */
    int numBytes)		/* Max number of byes to scan */
    int *incompletePtr)		/* Set true if parse is incomplete. */
{
    int dummy;
    char type;
    const char *p = src;

    do {
	size_t scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);
	int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type);

	p += scanned;
	numBytes -= scanned;
    } while (numBytes && (*p == '\n') && (p++, --numBytes));
    return (p-src);
}

size_t
TclParseAllWhiteSpace(
    const char *src,		/* First character to parse. */
    size_t numBytes)		/* Max number of byes to scan */
{
    int dummy;
    return ParseAllWhiteSpace(src, numBytes, &dummy);
}

/*
 *----------------------------------------------------------------------
 *
 * ParseHex --
 *
 *	Scans a hexadecimal number as a Tcl_UniChar value (e.g., for parsing
722
723
724
725
726
727
728
729
730


731
732
733
734
735

736
737
738
739
740
741
742
782
783
784
785
786
787
788


789
790
791
792
793
794

795
796
797
798
799
800
801
802







-
-
+
+




-
+







 *
 *----------------------------------------------------------------------
 */

int
ParseHex(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of byes to scan */
    int *resultPtr)		/* Points to storage provided by caller where
    int numBytes,		/* Max number of byes to scan */
    int *resultPtr)	/* Points to storage provided by caller where
				 * the character resulting from the
				 * conversion is to be written. */
{
    int result = 0;
    const char *p = src;
    register const char *p = src;

    while (numBytes--) {
	unsigned char digit = UCHAR(*p);

	if (!isxdigit(digit) || (result > 0x10FFF)) {
	    break;
	}
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
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







-
-
+
+



+
-
+

-
+


-
-
+
+







 *----------------------------------------------------------------------
 */

int
TclParseBackslash(
    const char *src,		/* Points to the backslash character of a a
				 * backslash sequence. */
    size_t numBytes,		/* Max number of bytes to scan. */
    size_t *readPtr,		/* NULL, or points to storage where the number
    int numBytes,		/* Max number of bytes to scan. */
    int *readPtr,		/* NULL, or points to storage where the number
				 * of bytes scanned should be written. */
    char *dst)			/* NULL, or points to buffer where the UTF-8
				 * encoding of the backslash sequence is to be
				 * written. At most TCL_UTF_MAX bytes will be
				 * written. At most 4 bytes will be written there. */
				 * written there. */
{
    const char *p = src+1;
    register const char *p = src+1;
    Tcl_UniChar unichar = 0;
    int result;
    size_t count;
    char buf[4] = "";
    int count;
    char buf[TCL_UTF_MAX];

    if (numBytes == 0) {
	if (readPtr != NULL) {
	    *readPtr = 0;
	}
	return 0;
    }
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
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
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







-
+










-
+









+










+


+












+


















-
+






-
+


-
+















-
+

-
+

-
+

-
+









-
+
-
-
-
-
-




















-
+


-
+




-
+
-


+
+
+
+
-
-
-
+
+
+
+
+








-
-

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+


-
+



-
-
-



-







    case 't':
	result = 0x9;
	break;
    case 'v':
	result = 0xB;
	break;
    case 'x':
	count += ParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result);
	count += ParseHex(p+1, numBytes-2, &result);
	if (count == 2) {
	    /*
	     * No hexdigits -> This is just "x".
	     */

	    result = 'x';
	} else {
	    /*
	     * Keep only the last byte (2 hex digits).
	     */
	    result = UCHAR(result);
	    result = (unsigned char) result;
	}
	break;
    case 'u':
	count += ParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
	if (count == 2) {
	    /*
	     * No hexdigits -> This is just "u".
	     */
	    result = 'u';
#if TCL_UTF_MAX > 3
	} else if (((result & 0xFC00) == 0xD800) && (count == 6)
		    && (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) {
	    /* If high surrogate is immediately followed by a low surrogate
	     * escape, combine them into one character. */
	    int low;
	    int count2 = ParseHex(p+7, 4, &low);
	    if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) {
		result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000;
		count += count2 + 2;
	    }
#endif
	}
	break;
#if TCL_UTF_MAX > 3
    case 'U':
	count += ParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result);
	if (count == 2) {
	    /*
	     * No hexdigits -> This is just "U".
	     */
	    result = 'U';
	} else if ((result | 0x7FF) == 0xDFFF) {
	    /* Upper or lower surrogate, not allowed in this syntax. */
	    result = 0xFFFD;
	}
	break;
#endif
    case '\n':
	count--;
	do {
	    p++;
	    count++;
	} while ((count < numBytes) && ((*p == ' ') || (*p == '\t')));
	result = ' ';
	break;
    case 0:
	result = '\\';
	count = 1;
	break;
    default:
	/*
	 * Check for an octal number \oo?o?
	 */

	if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) {	/* INTL: digit */
	    result = *p - '0';
	    result = UCHAR(*p - '0');
	    p++;
	    if ((numBytes == 2) || !isdigit(UCHAR(*p))	/* INTL: digit */
		    || (UCHAR(*p) >= '8')) {
		break;
	    }
	    count = 3;
	    result = (result << 3) + (*p - '0');
	    result = UCHAR((result << 3) + (*p - '0'));
	    p++;
	    if ((numBytes == 3) || !isdigit(UCHAR(*p))	/* INTL: digit */
		    || (UCHAR(*p) >= '8') || (result >= 0x20)) {
		    || (UCHAR(*p) >= '8')) {
		break;
	    }
	    count = 4;
	    result = UCHAR((result << 3) + (*p - '0'));
	    break;
	}

	/*
	 * We have to convert here in case the user has put a backslash in
	 * front of a multi-byte utf-8 character. While this means nothing
	 * special, we shouldn't break up a correct utf-8 character. [Bug
	 * #217987] test subst-3.2
	 */

	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
	    count = TclUtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
	    count = Tcl_UtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
	} else {
	    char utfBytes[4];
	    char utfBytes[TCL_UTF_MAX];

	    memcpy(utfBytes, p, numBytes - 1);
	    memcpy(utfBytes, p, (size_t) (numBytes - 1));
	    utfBytes[numBytes - 1] = '\0';
	    count = TclUtfToUniChar(utfBytes, &unichar) + 1;
	    count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
	}
	result = unichar;
	break;
    }

  done:
    if (readPtr != NULL) {
	*readPtr = count;
    }
    count = Tcl_UniCharToUtf(result, dst);
    return Tcl_UniCharToUtf(result, dst);
    if ((result >= 0xD800) && (count < 3)) {
	/* Special case for handling high surrogates. */
	count += Tcl_UniCharToUtf(-1, dst + count);
    }
    return count;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseComment --
 *
 *	Scans up to numBytes bytes starting at src, consuming a Tcl comment as
 *	defined by Tcl's parsing rules.
 *
 * Results:
 *	Records in parsePtr information about the parse. Returns the number of
 *	bytes consumed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static size_t
static int
ParseComment(
    const char *src,		/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    register int numBytes,	/* Max number of bytes to scan. */
    Tcl_Parse *parsePtr)	/* Information about parse in progress.
				 * Updated if parsing indicates an incomplete
				 * command. */
{
    const char *p = src;
    register const char *p = src;
    int incomplete = parsePtr->incomplete;

    while (numBytes) {
	char type;
	int scanned;

	do {
	size_t scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
	p += scanned;
	numBytes -= scanned;
	    scanned = ParseWhiteSpace(p, numBytes,
		    &parsePtr->incomplete, &type);
	    p += scanned;
	    numBytes -= scanned;
	} while (numBytes && (*p == '\n') && (p++,numBytes--));

	if ((numBytes == 0) || (*p != '#')) {
	    break;
	}
	if (parsePtr->commentStart == NULL) {
	    parsePtr->commentStart = p;
	}

	p++;
	numBytes--;
	while (numBytes) {
	    if (*p == '\n') {
		p++;
		numBytes--;
		break;
	    }
	    if (*p == '\\') {
		scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete,
			&type);
		if (scanned) {
		    p += scanned;
		    numBytes -= scanned;
		} else {
		    /*
		     * General backslash substitution in comments isn't part
		     * of the formal spec, but test parse-15.47 and history
		     * indicate that it has been the de facto rule. Don't
		     * change it now.
		     */

		    TclParseBackslash(p, numBytes, &scanned, NULL);
		    p += scanned;
		    numBytes -= scanned;
		}
	    if (*p == '\\') {
	    } else {
		p++;
		numBytes--;
		if (numBytes == 0) {
		if (p[-1] == '\n') {
		    break;
		}
	    }
	    incomplete = (*p == '\n');
	    p++;
	    numBytes--;
	}
	parsePtr->commentSize = p - parsePtr->commentStart;
    }
    parsePtr->incomplete = incomplete;
    return (p - src);
}

/*
 *----------------------------------------------------------------------
 *
 * ParseTokens --
1050
1051
1052
1053
1054
1055
1056
1057
1058


1059
1060
1061
1062
1063
1064
1065
1122
1123
1124
1125
1126
1127
1128


1129
1130
1131
1132
1133
1134
1135
1136
1137







-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ParseTokens(
    const char *src,	/* First character to parse. */
    size_t numBytes,		/* Max number of bytes to scan. */
    register const char *src,	/* First character to parse. */
    register int numBytes,	/* Max number of bytes to scan. */
    int mask,			/* Specifies when to stop parsing. The parse
				 * stops at the first unquoted character whose
				 * CHAR_TYPE contains any of the bits in
				 * mask. */
    int flags,			/* OR-ed bits indicating what substitutions to
				 * perform: TCL_SUBST_COMMANDS,
				 * TCL_SUBST_VARIABLES, and
1142
1143
1144
1145
1146
1147
1148

1149

1150
1151
1152
1153
1154
1155
1156
1214
1215
1216
1217
1218
1219
1220
1221

1222
1223
1224
1225
1226
1227
1228
1229







+
-
+







	     * Command substitution. Call Tcl_ParseCommand recursively (and
	     * repeatedly) to parse the nested command(s), then throw away the
	     * parse information.
	     */

	    src++;
	    numBytes--;
	    nestedPtr = (Tcl_Parse *)
	    nestedPtr = (Tcl_Parse *)TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
		    TclStackAlloc(parsePtr->interp, sizeof(Tcl_Parse));
	    while (1) {
		const char *curEnd;

		if (Tcl_ParseCommand(parsePtr->interp, src, numBytes, 1,
			nestedPtr) != TCL_OK) {
		    parsePtr->errorType = nestedPtr->errorType;
		    parsePtr->term = nestedPtr->term;
1172
1173
1174
1175
1176
1177
1178
1179
1180


1181
1182
1183
1184
1185
1186
1187
1245
1246
1247
1248
1249
1250
1251


1252
1253
1254
1255
1256
1257
1258
1259
1260







-
-
+
+







		if ((nestedPtr->term < parsePtr->end)
			&& (*(nestedPtr->term) == ']')
			&& !(nestedPtr->incomplete)) {
		    break;
		}
		if (numBytes == 0) {
		    if (parsePtr->interp != NULL) {
			Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
				"missing close-bracket", -1));
			Tcl_SetResult(parsePtr->interp,
				"missing close-bracket", TCL_STATIC);
		    }
		    parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
		    parsePtr->term = tokenPtr->start;
		    parsePtr->incomplete = 1;
		    TclStackFree(parsePtr->interp, nestedPtr);
		    return TCL_ERROR;
		}
1291
1292
1293
1294
1295
1296
1297
1298

1299
1300
1301
1302
1303
1304
1305
1364
1365
1366
1367
1368
1369
1370

1371
1372
1373
1374
1375
1376
1377
1378







-
+








void
Tcl_FreeParse(
    Tcl_Parse *parsePtr)	/* Structure that was filled in by a previous
				 * call to Tcl_ParseCommand. */
{
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	Tcl_Free(parsePtr->tokenPtr);
	ckfree((char *)parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
1356
1357
1358
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







-
+










-
+



-
+








int
Tcl_ParseVarName(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of variable substitution string.
				 * First character must be "$". */
    size_t numBytes,		/* Total number of bytes in string. If -1,
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,	/* Structure to fill in with information about
				 * the variable name. */
    int append)			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
{
    Tcl_Token *tokenPtr;
    const char *src;
    register const char *src;
    int varIndex;
    unsigned array;

    if (numBytes == TCL_INDEX_NONE && start) {
    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
1405
1406
1407
1408
1409
1410
1411
1412
1413


1414
1415
1416
1417
1418
1419
1420
1478
1479
1480
1481
1482
1483
1484


1485
1486
1487
1488
1489
1490
1491
1492
1493







-
-
+
+








	while (numBytes && (*src != '}')) {
	    numBytes--;
	    src++;
	}
	if (numBytes == 0) {
	    if (parsePtr->interp != NULL) {
		Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
			"missing close-brace for variable name", -1));
		Tcl_SetResult(parsePtr->interp,
			"missing close-brace for variable name", TCL_STATIC);
	    }
	    parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE;
	    parsePtr->term = tokenPtr->start-1;
	    parsePtr->incomplete = 1;
	    goto error;
	}
	tokenPtr->size = src - tokenPtr->start;
1463
1464
1465
1466
1467
1468
1469
1470
1471


1472
1473
1474
1475
1476
1477
1478
1536
1537
1538
1539
1540
1541
1542


1543
1544
1545
1546
1547
1548
1549
1550
1551







-
-
+
+








	    if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
		    TCL_SUBST_ALL, parsePtr)) {
		goto error;
	    }
	    if ((parsePtr->term == src+numBytes) || (*parsePtr->term != ')')){
		if (parsePtr->interp != NULL) {
		    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
			    "missing )", -1));
		    Tcl_SetResult(parsePtr->interp, "missing )",
			    TCL_STATIC);
		}
		parsePtr->errorType = TCL_PARSE_MISSING_PAREN;
		parsePtr->term = src;
		parsePtr->incomplete = 1;
		goto error;
	    }
	    src = parsePtr->term + 1;
1521
1522
1523
1524
1525
1526
1527
1528

1529
1530
1531
1532
1533
1534

1535
1536


1537
1538
1539
1540
1541
1542
1543
1594
1595
1596
1597
1598
1599
1600

1601
1602
1603
1604
1605
1606

1607
1608

1609
1610
1611
1612
1613
1614
1615
1616
1617







-
+





-
+

-
+
+







 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_ParseVar(
    Tcl_Interp *interp,		/* Context for looking up variable. */
    const char *start,	/* Start of variable substitution. First
    register const char *start,	/* Start of variable substitution. First
				 * character must be "$". */
    const char **termPtr)	/* If non-NULL, points to word to fill in with
				 * character just after last one in the
				 * variable specifier. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;
    int code;
    Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse));
    Tcl_Parse *parsePtr = (Tcl_Parse *)
	    TclStackAlloc(interp, sizeof(Tcl_Parse));

    if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
	TclStackFree(interp, parsePtr);
	return NULL;
    }

    if (termPtr != NULL) {
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570





1571
1572
1573
1574



1575
1576
1577
1578
1579
1580
1581
1635
1636
1637
1638
1639
1640
1641



1642
1643
1644
1645
1646
1647
1648


1649
1650
1651
1652
1653
1654
1655
1656
1657
1658







-
-
-
+
+
+
+
+


-
-
+
+
+







    }
    objPtr = Tcl_GetObjResult(interp);

    /*
     * At this point we should have an object containing the value of a
     * variable. Just return the string from that object.
     *
     * Since TclSubstTokens above returned TCL_OK, we know that objPtr
     * is shared.  It is in both the interp result and the value of the
     * variable.  Returning the string relies on that to be true.
     * This should have returned the object for the user to manage, but
     * instead we have some weak reference to the string value in the object,
     * which is why we make sure the object exists after resetting the result.
     * This isn't ideal, but it's the best we can do with the current
     * documented interface. -- hobbs
     */

    assert( Tcl_IsShared(objPtr) );

    if (!Tcl_IsShared(objPtr)) {
	Tcl_IncrRefCount(objPtr);
    }
    Tcl_ResetResult(interp);
    return TclGetString(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
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


1631
1632
1633

1634
1635
1636
1637
1638
1639
1640
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







-
+


-
+












-
-
+
+
-

-
+








int
Tcl_ParseBraces(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of string enclosed in braces. The
				 * first character must be {'. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
    register Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the terminating '}' if the parse was
				 * successful. */
{
    Tcl_Token *tokenPtr;
    const char *src;
    int startIndex, level;
    register const char *src;
    int startIndex, level, length;
    size_t length;

    if (numBytes == TCL_INDEX_NONE && start) {
    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
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
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







-
-
+









-
+











-
-
+
+







	 * Skip straight to the exit code since we have no interpreter to put
	 * error message in.
	 */

	goto error;
    }

    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
	    "missing close-brace", -1));
    Tcl_SetResult(parsePtr->interp, "missing close-brace", TCL_STATIC);

    /*
     * Guess if the problem is due to comments by searching the source string
     * for a possible open brace within the context of a comment. Since we
     * aren't performing a full Tcl parse, just look for an open brace
     * preceded by a '<whitespace>#' on the same line.
     */

    {
	int openBrace = 0;
	register int openBrace = 0;

	while (--src > start) {
	    switch (*src) {
	    case '{':
		openBrace = 1;
		break;
	    case '\n':
		openBrace = 0;
		break;
	    case '#' :
		if (openBrace && TclIsSpaceProcM(src[-1])) {
		    Tcl_AppendToObj(Tcl_GetObjResult(parsePtr->interp),
			    ": possible unbalanced brace in comment", -1);
		    Tcl_AppendResult(parsePtr->interp,
			    ": possible unbalanced brace in comment", NULL);
		    goto error;
		}
		break;
	    }
	}
    }

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
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
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







-
+


-
+











-
+















-
+
-



















-
+

-
+
-
-
+
-
-


+
-
+


-
-
-
+

-
-
-
-
-
-



-
-
-
+
+
+
-
-
-
+
+
-
-

-
-
+
+
+
+
+
+











-
-
+
+


-
+
+








int
Tcl_ParseQuotedString(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting; if
				 * NULL, then no error message is provided. */
    const char *start,		/* Start of the quoted string. The first
				 * character must be '"'. */
    size_t numBytes,		/* Total number of bytes in string. If -1,
    register int numBytes,	/* Total number of bytes in string. If < 0,
				 * the string consists of all bytes up to the
				 * first null character. */
    Tcl_Parse *parsePtr,
    register Tcl_Parse *parsePtr,
				/* Structure to fill in with information about
				 * the string. */
    int append,			/* Non-zero means append tokens to existing
				 * information in parsePtr; zero means ignore
				 * existing tokens in parsePtr and
				 * reinitialize it. */
    const char **termPtr)	/* If non-NULL, points to word in which to
				 * store a pointer to the character just after
				 * the quoted string's terminating close-quote
				 * if the parse succeeds. */
{
    if (numBytes == TCL_INDEX_NONE && start) {
    if (numBytes < 0 && start) {
	numBytes = strlen(start);
    }
    if (!append) {
	TclParseInit(interp, start, numBytes, parsePtr);
    }
    if ((numBytes == 0) || (start == NULL)) {
	return TCL_ERROR;
    }

    if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE, TCL_SUBST_ALL,
	    parsePtr)) {
	goto error;
    }
    if (*parsePtr->term != '"') {
	if (parsePtr->interp != NULL) {
	    Tcl_SetObjResult(parsePtr->interp, Tcl_NewStringObj(
	    Tcl_SetResult(parsePtr->interp, "missing \"", TCL_STATIC);
		    "missing \"", -1));
	}
	parsePtr->errorType = TCL_PARSE_MISSING_QUOTE;
	parsePtr->term = start;
	parsePtr->incomplete = 1;
	goto error;
    }
    if (termPtr != NULL) {
	*termPtr = (parsePtr->term + 1);
    }
    return TCL_OK;

  error:
    Tcl_FreeParse(parsePtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSubstParse --
 * Tcl_SubstObj --
 *
 *	Token parser used by the [subst] command. Parses the string made up of
 *	This function performs the substitutions specified on the given string
 *	'numBytes' bytes starting at 'bytes'. Parsing is controlled by the
 *	flags argument to provide support for the -nobackslashes, -nocommands,
 *	as described in the user documentation for the "subst" Tcl command.
 *	and -novariables options, as represented by the flag values
 *	TCL_SUBST_BACKSLASHES, TCL_SUBST_COMMANDS, TCL_SUBST_VARIABLES.
 *
 * Results:
 *	A Tcl_Obj* containing the substituted string, or NULL to indicate that
 *	None.
 *	an error occurred.
 *
 * Side effects:
 *	The Tcl_Parse struct '*parsePtr' is filled with parse results.
 *	The caller is expected to eventually call Tcl_FreeParse() to properly
 *	cleanup the value written there.
 *	See the user documentation.
 *
 *	If a parse error occurs, the Tcl_InterpState value '*statePtr' is
 *	filled with the state created by that error. When *statePtr is written
 *	to, the caller is expected to make the required calls to either
 *	Tcl_RestoreInterpState() or Tcl_DiscardInterpState() to dispose of the
 *	value written there.
 *
 *----------------------------------------------------------------------
 */

void
TclSubstParse(
    Tcl_Interp *interp,
Tcl_Obj *
Tcl_SubstObj(
    Tcl_Interp *interp,		/* Interpreter in which substitution occurs */
    const char *bytes,
    size_t numBytes,
    int flags,
    Tcl_Obj *objPtr,		/* The value to be substituted. */
    int flags)			/* What substitutions to do. */
    Tcl_Parse *parsePtr,
    Tcl_InterpState *statePtr)
{
    size_t length = numBytes;
    const char *p = bytes;
    int length, tokensLeft, code;
    Tcl_Token *endTokenPtr;
    Tcl_Obj *result, *errMsg = NULL;
    const char *p = TclGetStringFromObj(objPtr, &length);
    Tcl_Parse *parsePtr = (Tcl_Parse *)
	    TclStackAlloc(interp, sizeof(Tcl_Parse));

    TclParseInit(interp, p, length, parsePtr);

    /*
     * First parse the string rep of objPtr, as if it were enclosed as a
     * "-quoted word in a normal Tcl command. Honor flags that selectively
     * inhibit types of substitution.
     */

    if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, parsePtr)) {
	/*
	 * There was a parse error. Save the interpreter state for possible
	 * error reporting later.
	 * There was a parse error. Save the error message for possible
	 * reporting later.
	 */

	*statePtr = Tcl_SaveInterpState(interp, TCL_ERROR);
	errMsg = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(errMsg);

	/*
	 * We need to re-parse to get the portion of the string we can [subst]
	 * before the parse error. Sadly, all the Tcl_Token's created by the
	 * first parse attempt are gone, freed according to the public spec
	 * for the Tcl_Parse* routines. The only clue we have is parse.term,
	 * which points to either the unmatched opener, or to characters that
1977
1978
1979
1980
1981
1982
1983
1984

1985
1986
1987

1988
1989
1990
1991
1992
1993
1994
2043
2044
2045
2046
2047
2048
2049

2050
2051
2052

2053
2054
2055
2056
2057
2058
2059
2060







-
+


-
+







		 * two tokens.
		 */

		Tcl_Token *varTokenPtr =
			parsePtr->tokenPtr + parsePtr->numTokens - 2;

		if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
		    Tcl_Panic("TclSubstParse: programming error");
		    Tcl_Panic("Tcl_SubstObj: programming error");
		}
		if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
		    Tcl_Panic("TclSubstParse: programming error");
		    Tcl_Panic("Tcl_SubstObj: programming error");
		}
		parsePtr->numTokens -= 2;
	    }
	    break;
	case '[':
	    /*
	     * Parse error occurred during parsing of a toplevel command
2054
2055
2056
2057
2058
2059
2060
2061

2062
























































2063
2064
2065
2066
2067
2068
2069
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







-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		tokenPtr->type = TCL_TOKEN_COMMAND;
		tokenPtr->size = lastTerm - tokenPtr->start + 1;
		parsePtr->numTokens++;
	    }
	    break;

	default:
	    Tcl_Panic("bad parse in TclSubstParse: %c", p[length]);
	    Tcl_Panic("bad parse in Tcl_SubstObj: %c", p[length]);
	}
    }

    /*
     * Next, substitute the parsed tokens just as in normal Tcl evaluation.
     */

    endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
    tokensLeft = parsePtr->numTokens;
    code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
	    &tokensLeft, 1, NULL, NULL);
    if (code == TCL_OK) {
	Tcl_FreeParse(parsePtr);
	TclStackFree(interp, parsePtr);
	if (errMsg != NULL) {
	    Tcl_SetObjResult(interp, errMsg);
	    Tcl_DecrRefCount(errMsg);
	    return NULL;
	}
	return Tcl_GetObjResult(interp);
    }

    result = Tcl_NewObj();
    while (1) {
	switch (code) {
	case TCL_ERROR:
	    Tcl_FreeParse(parsePtr);
	    TclStackFree(interp, parsePtr);
	    Tcl_DecrRefCount(result);
	    if (errMsg != NULL) {
		Tcl_DecrRefCount(errMsg);
	    }
	    return NULL;
	case TCL_BREAK:
	    tokensLeft = 0;		/* Halt substitution */
	    /* FALLTHRU */
	default:
	    Tcl_AppendObjToObj(result, Tcl_GetObjResult(interp));
	}

	if (tokensLeft == 0) {
	    Tcl_FreeParse(parsePtr);
	    TclStackFree(interp, parsePtr);
	    if (errMsg != NULL) {
		if (code != TCL_BREAK) {
		    Tcl_DecrRefCount(result);
		    Tcl_SetObjResult(interp, errMsg);
		    Tcl_DecrRefCount(errMsg);
		    return NULL;
		}
		Tcl_DecrRefCount(errMsg);
	    }
	    return result;
	}

	code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
		&tokensLeft, 1, NULL, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclSubstTokens --
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
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







-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
+







				 * evaluate and concatenate. */
    int count,			/* Number of tokens to consider at tokenPtr.
				 * Must be at least 1. */
    int *tokensLeftPtr,		/* If not NULL, points to memory where an
				 * integer representing the number of tokens
				 * left to be substituted will be written */
    int line,			/* The line the script starts on. */
    int *clNextOuter,		/* Information about an outer context for */
    const char *outerScript)	/* continuation line data. This is set by
				 * EvalEx() to properly handle [...]-nested
				 * commands. The 'outerScript' refers to the
				 * most-outer script containing the embedded
				 * command, which is refered to by 'script'.
				 * The 'clNextOuter' refers to the current
				 * entry in the table of continuation lines in
				 * this "main script", and the character
				 * offsets are relative to the 'outerScript'
    int*  clNextOuter,       /* Information about an outer context for */
    CONST char* outerScript) /* continuation line data. This is set by
			      * EvalEx() to properly handle [...]-nested
			      * commands. The 'outerScript' refers to the
			      * most-outer script containing the embedded
			      * command, which is refered to by 'script'. The
			      * 'clNextOuter' refers to the current entry in
			      * the table of continuation lines in this
			      * "master script", and the character offsets are
			      * relative to the 'outerScript' as well.
				 * as well.
				 *
				 * If outerScript == script, then this call is
				 * for words in the outer-most script or
				 * command. See Tcl_EvalEx and TclEvalObjEx
				 * for the places generating arguments for
			      *
			      * If outerScript == script, then this call is for
			      * words in the outer-most script/command. See
			      * Tcl_EvalEx() and TclEvalObjEx() for the places
			      * generating arguments for which this is true.
				 * which this is true. */
			      */
{
    Tcl_Obj *result;
    int code = TCL_OK;
#define NUM_STATIC_POS 20
    int isLiteral, maxNumCL, numCL, i, adjust;
    int *clPosition = NULL;
    Interp *iPtr = (Interp *) interp;
2151
2152
2153
2154
2155
2156
2157
2158

2159
2160
2161
2162
2163
2164
2165
2166
2167

2168
2169
2170
2171
2172
2173
2174
2272
2273
2274
2275
2276
2277
2278

2279
2280
2281
2282
2283
2284
2285
2286
2287

2288
2289
2290
2291
2292
2293
2294
2295







-
+








-
+







	    isLiteral = 0;
	    break;
	}
    }

    if (isLiteral) {
	maxNumCL = NUM_STATIC_POS;
	clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
	clPosition = (int *)ckalloc(maxNumCL * sizeof(int));
    }

    adjust = 0;
    result = NULL;
    for (; count>0 && code==TCL_OK ; count--, tokenPtr++) {
	Tcl_Obj *appendObj = NULL;
	const char *append = NULL;
	int appendByteLength = 0;
	char utfCharBytes[4] = "";
	char utfCharBytes[TCL_UTF_MAX];

	switch (tokenPtr->type) {
	case TCL_TOKEN_TEXT:
	    append = tokenPtr->start;
	    appendByteLength = tokenPtr->size;
	    break;

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
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







-
-
+
+

-
+




-
+




-
-
+
+









+
-
+












+


-
-
-
-










-







	     * nested commands. See the branch for TCL_TOKEN_COMMAND below,
	     * where the adjustment we are tracking here is taken into
	     * account. The good thing is that we do not need a table of
	     * everything, just the number of lines we have to add as
	     * correction.
	     */

	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ')
		    && (tokenPtr->start[1] == '\n')) {
	    if ((appendByteLength == 1) && (utfCharBytes[0] == ' ') &&
		(tokenPtr->start[1] == '\n')) {
		if (isLiteral) {
		    size_t clPos;
		    int clPos;

		    if (result == 0) {
			clPos = 0;
		    } else {
			(void)TclGetStringFromObj(result, &clPos);
			Tcl_GetStringFromObj(result, &clPos);
		    }

		    if (numCL >= maxNumCL) {
			maxNumCL *= 2;
			clPosition = (int *)Tcl_Realloc(clPosition,
				maxNumCL * sizeof(int));
			clPosition = (int *)ckrealloc ((char*)clPosition,
						       maxNumCL*sizeof(int));
		    }
		    clPosition[numCL] = clPos;
		    numCL++;
		}
		adjust++;
	    }
	    break;

	case TCL_TOKEN_COMMAND: {
	    Interp *iPtr = (Interp *) interp;
	    /* TIP #280: Transfer line information to nested command */

	    iPtr->numLevels++;
	    code = TclInterpReady(interp);
	    if (code == TCL_OK) {
		/*
		 * Test cases: info-30.{6,8,9}
		 */

		int theline;

		TclAdvanceContinuations(&line, &clNextOuter,
			tokenPtr->start - outerScript);
		theline = line + adjust;
		/* TIP #280: Transfer line information to nested command */
		code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2,
			0, theline, clNextOuter, outerScript);

		TclAdvanceLines(&line, tokenPtr->start+1,
			tokenPtr->start + tokenPtr->size - 1);

		/*
		 * Restore flag reset by nested eval for future bracketed
		 * commands and their cmdframe setup
		 */

		if (inFile) {
		    iPtr->evalFlags |= TCL_EVAL_FILE;
		}
	    }
	    iPtr->numLevels--;
	    TclResetCancellation(interp, 0);
	    appendObj = Tcl_GetObjResult(interp);
	    break;
	}

	case TCL_TOKEN_VARIABLE: {
	    Tcl_Obj *arrayIndex = NULL;
	    Tcl_Obj *varName = NULL;
2359
2360
2361
2362
2363
2364
2365
2366

2367
2368
2369
2370
2371
2372
2373
2477
2478
2479
2480
2481
2482
2483

2484
2485
2486
2487
2488
2489
2490
2491







-
+








	    /*
	     * Release the temp table we used to collect the locations of
	     * continuation lines, if any.
	     */

	    if (maxNumCL) {
		Tcl_Free(clPosition);
		ckfree((char*) clPosition);
	    }
	} else {
	    Tcl_ResetResult(interp);
	}
    }
    if (tokensLeftPtr != NULL) {
	*tokensLeftPtr = count;
2394
2395
2396
2397
2398
2399
2400
2401

2402
2403
2404

2405
2406
2407
2408
2409
2410
2411
2512
2513
2514
2515
2516
2517
2518

2519
2520
2521

2522
2523
2524
2525
2526
2527
2528
2529







-
+


-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
static inline int
CommandComplete(
    const char *script,		/* Script to check. */
    size_t numBytes)		/* Number of bytes in script. */
    int numBytes)		/* Number of bytes in script. */
{
    Tcl_Parse parse;
    const char *p, *end;
    int result;

    p = script;
    end = p + numBytes;
2471
2472
2473
2474
2475
2476
2477
2478
2479


2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2589
2590
2591
2592
2593
2594
2595


2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608







-
-
+
+











 */

int
TclObjCommandComplete(
    Tcl_Obj *objPtr)		/* Points to object holding script to
				 * check. */
{
    size_t length;
    const char *script = TclGetStringFromObj(objPtr, &length);
    int length;
    const char *script = Tcl_GetStringFromObj(objPtr, &length);

    return CommandComplete(script, length);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted 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) tclCharTypeTable[(unsigned char)(c)]

MODULE_SCOPE const char tclCharTypeTable[];

Changes to generic/tclPathObj.c.

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
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







-











-
+




+
+
+






-
+










-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+




-
+



-
+














-
+

-
-
-
+
-
-
-







 *
 * 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 "tclFileSystem.h"
#include <assert.h>

/*
 * Prototypes for functions defined later in this file.
 */

static Tcl_Obj *	AppendPath(Tcl_Obj *head, Tcl_Obj *tail);
static void		DupFsPathInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FreeFsPathInternalRep(Tcl_Obj *pathPtr);
static void		UpdateStringOfFsPath(Tcl_Obj *pathPtr);
static int		SetFsPathFromAny(Tcl_Interp *interp, Tcl_Obj *pathPtr);
static size_t	FindSplitPos(const char *path, int separator);
static int		FindSplitPos(const char *path, int separator);
static int		IsSeparatorOrNull(int ch);
static Tcl_Obj *	GetExtension(Tcl_Obj *pathPtr);
static int		MakePathFromNormalized(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr);
static Tcl_Obj *	TclJoinPath(int elements, Tcl_Obj * const objv[],
			    int forceRelative);


/*
 * Define the 'path' object type, which Tcl uses to represent file paths
 * internally.
 */

static const Tcl_ObjType fsPathType = {
static Tcl_ObjType tclFsPathType = {
    "path",				/* name */
    FreeFsPathInternalRep,		/* freeIntRepProc */
    DupFsPathInternalRep,		/* dupIntRepProc */
    UpdateStringOfFsPath,		/* updateStringProc */
    SetFsPathFromAny			/* setFromAnyProc */
};

/*
 * struct FsPath --
 *
 * Internal representation of a Tcl_Obj of fsPathType
 * Internal representation of a Tcl_Obj of "path" type. This can be used to
 * represent relative or absolute paths, and has certain optimisations when
 * used to represent paths which are already normalized and absolute.
 *
 * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular
 * reference to the container Tcl_Obj of this FsPath.
 *
 * There are two cases, with the first being the most common:
 *
 * (i) flags == 0, => Ordinary path.
 *
 * translatedPathPtr contains the translated path (which may be a circular
 * reference to the object itself). If it is NULL then the path is pure
 * normalized (and the normPathPtr will be a circular reference). cwdPtr is
 * null for an absolute path, and non-null for a relative path (unless the cwd
 * has never been set, in which case the cwdPtr may also be null for a
 * relative path).
 *
 * (ii) flags != 0, => Special path, see TclNewFSPathObj
 *
 * Now, this is a path like 'file join $dir $tail' where, cwdPtr is the $dir
 * and normPathPtr is the $tail.
 *
 */

typedef struct {
    Tcl_Obj *translatedPathPtr; /*  If the path has been normalized (flags ==
				 *  0), this is NULL.  Otherwise it is a path
				 *  in which any ~user sequences have been
				 *  translated away. */
    Tcl_Obj *normPathPtr;	/*  If the path has been normalized (flags ==
typedef struct FsPath {
    Tcl_Obj *translatedPathPtr; /* Name without any ~user sequences. If this
				 * is NULL, then this is a pure normalized,
				 * absolute path object, in which the parent
				 * Tcl_Obj's string rep is already both
				 * translated and normalized. */
    Tcl_Obj *normPathPtr;	/* Normalized absolute path, without ., .. or
				 *  0), this is an absolute path without ., ..
				 *  or ~user components.  Otherwise it is a
				 *  path, possibly absolute, to normalize
				 *  relative to cwdPtr. */
    Tcl_Obj *cwdPtr;		/*  If NULL, either translatedPtr exists or
				 *  normPathPtr exists and is absolute. */
				 * ~user sequences. If the Tcl_Obj containing
				 * this FsPath is already normalized, this may
				 * be a circular reference back to the
				 * container. If that is NOT the case, we have
				 * a refCount on the object. */
    Tcl_Obj *cwdPtr;		/* If null, path is absolute, else this points
				 * to the cwd object used for this path. We
				 * have a refCount on the object. */
    int flags;			/* Flags to describe interpretation - see
				 * below. */
    ClientData nativePathPtr;	/* Native representation of this path, which
				 * is filesystem dependent. */
    size_t filesystemEpoch;	/* Used to ensure the path representation was
    int filesystemEpoch;	/* Used to ensure the path representation was
				 * generated during the correct filesystem
				 * epoch. The epoch changes when
				 * filesystem-mounts are changed. */
    const Tcl_Filesystem *fsPtr;/* The Tcl_Filesystem that claims this path */
    Tcl_Filesystem *fsPtr;	/* The Tcl_Filesystem that claims this path */
} FsPath;

/*
 * Flag values for FsPath->flags.
 */

#define TCLPATH_APPENDED 1
#define TCLPATH_NEEDNORM 4

/*
 * Define some macros to give us convenient access to path-object specific
 * fields.
 */

#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
#define SETPATHOBJ(pathPtr,fsPathPtr) \
	do {							\
		Tcl_ObjIntRep ir;				\
		ir.twoPtrValue.ptr1 = (void *) (fsPathPtr);	\
	((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
		ir.twoPtrValue.ptr2 = NULL;			\
		Tcl_StoreIntRep((pathPtr), &fsPathType, &ir);	\
	} while (0)
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)

/*
 *---------------------------------------------------------------------------
 *
 * TclFSNormalizeAbsolutePath --
 *
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
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







-
-
-
+
+
+
-





-
-
+
+
+







 *
 *	The behaviour of this function if passed a non-absolute path is NOT
 *	defined.
 *
 *	pathPtr may have a refCount of zero, or may be a shared object.
 *
 * Results:
 *	The result is returned in a Tcl_Obj with a refCount already
 *	incremented, which gives the caller ownership of it.  The caller must
 *	arrange for Tcl_DecRefCount to be called when the object is no-longer
 *	The result is returned in a Tcl_Obj with a refCount of 1, which is
 *	therefore owned by the caller. It must be freed (with
 *	Tcl_DecrRefCount) by the caller when no longer needed.
 *	needed.
 *
 * Side effects:
 *	None (beyond the memory allocation for the result).
 *
 * Special note:
 *	Originally based on code from Matt Newman and Jean-Claude Wippler.
 *	Totally rewritten later by Vince Darley to handle symbolic links.
 *	This code was originally based on code from Matt Newman and
 *	Jean-Claude Wippler, but has since been totally rewritten by Vince
 *	Darley to deal with symbolic links.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclFSNormalizeAbsolutePath(
    Tcl_Interp *interp,		/* Interpreter to use */
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
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







-
+






-
+











-
-
+
+












-
+




-
+








-
+






-
+
-
-
+







-
+

-
+










-
-
-
+
+
+






-
-
-
+
+
+

-
+

-
+






-
+









-
+



-
-
+
+


-
+







		oldDirSep = dirSep;
	    }
	again:
	    if (IsSeparatorOrNull(dirSep[2])) {
		/*
		 * Need to skip '.' in the path.
		 */
		size_t curLen;
		int curLen;

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);
		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)TclGetStringFromObj(retVal, &curLen);
		(void) Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		dirSep += 2;
		oldDirSep = dirSep;
		if (dirSep[0] != 0 && dirSep[1] == '.') {
		    goto again;
		}
		continue;
	    }
	    if (dirSep[2] == '.' && IsSeparatorOrNull(dirSep[3])) {
		Tcl_Obj *linkObj;
		size_t curLen;
		Tcl_Obj *link;
		int curLen;
		char *linkStr;

		/*
		 * Have '..' so need to skip previous directory.
		 */

		if (retVal == NULL) {
		    const char *path = TclGetString(pathPtr);

		    retVal = Tcl_NewStringObj(path, dirSep - path);
		    Tcl_IncrRefCount(retVal);
		}
		(void)TclGetStringFromObj(retVal, &curLen);
		(void) Tcl_GetStringFromObj(retVal, &curLen);
		if (curLen == 0) {
		    Tcl_AppendToObj(retVal, dirSep, 1);
		}
		if (!first || (tclPlatform == TCL_PLATFORM_UNIX)) {
		    linkObj = Tcl_FSLink(retVal, NULL, 0);
		    link = Tcl_FSLink(retVal, NULL, 0);

		    /* Safety check in case driver caused sharing */
		    if (Tcl_IsShared(retVal)) {
			TclDecrRefCount(retVal);
			retVal = Tcl_DuplicateObj(retVal);
			Tcl_IncrRefCount(retVal);
		    }

		    if (linkObj != NULL) {
		    if (link != NULL) {
			/*
			 * Got a link. Need to check if the link is relative
			 * or absolute, for those platforms where relative
			 * links exist.
			 */

			if (tclPlatform != TCL_PLATFORM_WINDOWS
			if (tclPlatform != TCL_PLATFORM_WINDOWS &&
				&& Tcl_FSGetPathType(linkObj)
					== TCL_PATH_RELATIVE) {
				Tcl_FSGetPathType(link) == TCL_PATH_RELATIVE) {
			    /*
			     * We need to follow this link which is relative
			     * to retVal's directory. This means concatenating
			     * the link onto the directory of the path so far.
			     */

			    const char *path =
				    TclGetStringFromObj(retVal, &curLen);
				    Tcl_GetStringFromObj(retVal, &curLen);

			    while (curLen-- > 0) {
			    while (--curLen >= 0) {
				if (IsSeparatorOrNull(path[curLen])) {
				    break;
				}
			    }

			    /*
			     * We want the trailing slash.
			     */

			    Tcl_SetObjLength(retVal, curLen+1);
			    Tcl_AppendObjToObj(retVal, linkObj);
			    TclDecrRefCount(linkObj);
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			    Tcl_AppendObjToObj(retVal, link);
			    TclDecrRefCount(link);
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);
			} else {
			    /*
			     * Absolute link.
			     */

			    TclDecrRefCount(retVal);
			    if (Tcl_IsShared(linkObj)) {
				retVal = Tcl_DuplicateObj(linkObj);
				TclDecrRefCount(linkObj);
			    if (Tcl_IsShared(link)) {
				retVal = Tcl_DuplicateObj(link);
				TclDecrRefCount(link);
			    } else {
				retVal = linkObj;
				retVal = link;
			    }
			    linkStr = TclGetStringFromObj(retVal, &curLen);
			    linkStr = Tcl_GetStringFromObj(retVal, &curLen);

			    /*
			     * Convert to forward-slashes on windows.
			     */

			    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
				size_t i;
				int i;

				for (i = 0; i < curLen; i++) {
				    if (linkStr[i] == '\\') {
					linkStr[i] = '/';
				    }
				}
			    }
			}
		    } else {
			linkStr = TclGetStringFromObj(retVal, &curLen);
			linkStr = Tcl_GetStringFromObj(retVal, &curLen);
		    }

		    /*
		     * Either way, we now remove the last path element (but
		     * not the first character of the path).
		     * Either way, we now remove the last path element.
		     * (but not the first character of the path)
		     */

		    while (curLen-- > 0) {
		    while (--curLen >= 0) {
			if (IsSeparatorOrNull(linkStr[curLen])) {
			    if (curLen) {
				Tcl_SetObjLength(retVal, curLen);
			    } else {
				Tcl_SetObjLength(retVal, 1);
			    }
			    break;
376
377
378
379
380
381
382
383

384
385
386
387
388


389
390
391
392
393
394
395
397
398
399
400
401
402
403

404
405
406
407


408
409
410
411
412
413
414
415
416







-
+



-
-
+
+







	    TclDecrRefCount(retVal);
	    retVal = Tcl_DuplicateObj(pathPtr);
	    Tcl_IncrRefCount(retVal);
	}
    }

    /*
     * Ensure a windows drive like C:/ has a trailing separator.
     * Ensure a windows drive like C:/ has a trailing separator
     */

    if (tclPlatform == TCL_PLATFORM_WINDOWS) {
	size_t len;
	const char *path = TclGetStringFromObj(retVal, &len);
	int len;
	const char *path = Tcl_GetStringFromObj(retVal, &len);

	if (len == 2 && path[0] != 0 && path[1] == ':') {
	    if (Tcl_IsShared(retVal)) {
		TclDecrRefCount(retVal);
		retVal = Tcl_DuplicateObj(retVal);
		Tcl_IncrRefCount(retVal);
	    }
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
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







-
+

















-
+







 *
 *----------------------------------------------------------------------
 */

Tcl_PathType
TclFSGetPathType(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **filesystemPtrPtr,
    Tcl_Filesystem **filesystemPtrPtr,
    int *driveNameLengthPtr)
{
    FsPath *fsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
		NULL);
    }

    fsPathPtr = PATHOBJ(pathPtr);
    if (fsPathPtr->cwdPtr == NULL) {
	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
		NULL);
    }

    if (PATHFLAGS(pathPtr) == 0) {
	/* The path is not absolute... */
#ifdef _WIN32
#ifdef __WIN32__
	/* ... on Windows we must make another call to determine whether
	 * it's relative or volumerelative [Bug 2571597]. */
	return TclGetPathType(pathPtr, filesystemPtrPtr, driveNameLengthPtr,
		NULL);
#else
	/* On other systems, quickly deduce !absolute -> relative */
	return TCL_PATH_RELATIVE;
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
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







-
+













-
-
+
+
+








Tcl_Obj *
TclPathPart(
    Tcl_Interp *interp,		/* Used for error reporting */
    Tcl_Obj *pathPtr,		/* Path to take dirname of */
    Tcl_PathPart portion)	/* Requested portion of name */
{
    if (TclHasIntRep(pathPtr, &fsPathType)) {
    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0) {
	    switch (portion) {
	    case TCL_PATH_DIRNAME: {
		/*
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'dirname' would be a joining of the main
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
		 * the standardPath code.
		 */

		size_t numBytes;
		const char *rest = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
		int numBytes;
		const char *rest =
			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file dirname] is
		 * documented to return all but the last non-empty element
591
592
593
594
595
596
597
598
599



600
601
602
603
604
605
606
613
614
615
616
617
618
619


620
621
622
623
624
625
626
627
628
629







-
-
+
+
+







		/*
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'tail' would be only the part following the
		 * last delimiter. We could handle that special case here, but
		 * we don't, and instead just use the standardPath code.
		 */

		size_t numBytes;
		const char *rest = TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
		int numBytes;
		const char *rest =
			Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);

		if (strchr(rest, '/') != NULL) {
		    goto standardPath;
		}
		/*
		 * If the joined-on bit is empty, then [file tail] is
		 * documented to return the last non-empty element
619
620
621
622
623
624
625
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
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







-
+

-
+




















-
+







		Tcl_IncrRefCount(fsPathPtr->normPathPtr);
		return fsPathPtr->normPathPtr;
	    }
	    case TCL_PATH_EXTENSION:
		return GetExtension(fsPathPtr->normPathPtr);
	    case TCL_PATH_ROOT: {
		const char *fileName, *extension;
		size_t length;
		int length;

		fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
		fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
			&length);
		extension = TclGetExtension(fileName);
		if (extension == NULL) {
		    /*
		     * There is no extension so the root is the same as the
		     * path we were given.
		     */

		    Tcl_IncrRefCount(pathPtr);
		    return pathPtr;
		} else {
		    /*
		     * Need to return the whole path with the extension
		     * suffix removed.  Do that by joining our "head" to
		     * our "tail" with the extension suffix removed from
		     * the tail.
		     */

		    Tcl_Obj *resultPtr =
			    TclNewFSPathObj(fsPathPtr->cwdPtr, fileName,
			    length - strlen(extension));
			    (int)(length - strlen(extension)));

		    Tcl_IncrRefCount(resultPtr);
		    return resultPtr;
		}
	    }
	    default:
		/* We should never get here */
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
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







-
+


-
+






-
+







+

-
+







	Tcl_Obj *splitPtr, *resultPtr;

    standardPath:
	resultPtr = NULL;
	if (portion == TCL_PATH_EXTENSION) {
	    return GetExtension(pathPtr);
	} else if (portion == TCL_PATH_ROOT) {
	    size_t length;
	    int length;
	    const char *fileName, *extension;

	    fileName = TclGetStringFromObj(pathPtr, &length);
	    fileName = Tcl_GetStringFromObj(pathPtr, &length);
	    extension = TclGetExtension(fileName);
	    if (extension == NULL) {
		Tcl_IncrRefCount(pathPtr);
		return pathPtr;
	    } else {
		Tcl_Obj *root = Tcl_NewStringObj(fileName,
			length - strlen(extension));
			(int) (length - strlen(extension)));

		Tcl_IncrRefCount(root);
		return root;
	    }
	}

	/*
	 * The behaviour we want here is slightly different to the standard
	 * Tcl_FSSplitPath in the handling of home directories;
	 * Tcl_FSSplitPath preserves the "~",  but this code computes the
	 * Tcl_FSSplitPath preserves the "~" while this code computes the
	 * actual full path name, if we had just a single component.
	 */

	splitPtr = Tcl_FSSplitPath(pathPtr, &splitElements);
	Tcl_IncrRefCount(splitPtr);
	if (splitElements == 1  &&  TclGetString(pathPtr)[0] == '~') {
	    Tcl_Obj *norm;
716
717
718
719
720
721
722
723

724
725
726
727
728
729
730
740
741
742
743
744
745
746

747
748
749
750
751
752
753
754







-
+







	     * it is the root of an absolute path.
	     */

	    if ((splitElements > 0) && ((splitElements > 1) ||
		    (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) {
		Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr);
	    } else {
		TclNewObj(resultPtr);
		resultPtr = Tcl_NewObj();
	    }
	} else {
	    /*
	     * Return all but the last component. If there is only one
	     * component, return it if the path was non-relative, otherwise
	     * return the current directory.
	     */
754
755
756
757
758
759
760
761

762
763
764
765
766
767
768
778
779
780
781
782
783
784

785
786
787
788
789
790
791
792







-
+







{
    const char *tail, *extension;
    Tcl_Obj *ret;

    tail = TclGetString(pathPtr);
    extension = TclGetExtension(tail);
    if (extension == NULL) {
	TclNewObj(ret);
	ret = Tcl_NewObj();
    } else {
	ret = Tcl_NewStringObj(extension, -1);
    }
    Tcl_IncrRefCount(ret);
    return ret;
}

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
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







-
+






-
+
+

-
+

-
-
+
+
-
-
+
-
-
+
-
+

-
-
+
-








-
-
-
+
+
+


-
+
+

-
-
+
+
-
-





-
+

-
+







-
+




















-
-
+
+

-
+
+


-
+
+



-
+
+









-
+
+





-
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
+








    elements = ((elements >= 0) && (elements <= objc)) ? elements : objc;
    Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
    res = TclJoinPath(elements, objv, 0);
    return res;
}

Tcl_Obj *
static Tcl_Obj *
TclJoinPath(
    int elements,		/* Number of elements to use (-1 = all) */
    Tcl_Obj * const objv[],	/* Path elements to join */
    int forceRelative)		/* If non-zero, assume all more paths are
				 * relative (e. g. simple normalization) */
{
    Tcl_Obj *res = NULL;
    Tcl_Obj *res = NULL;	/* Resulting path object (container of join) */
    Tcl_Obj *elt;		/* Path part (result if returns part of path) */
    int i;
    const Tcl_Filesystem *fsPtr = NULL;
    Tcl_Filesystem *fsPtr = NULL;

    assert ( elements >= 0 );

    for (i = 0; i < elements; i++) {
	int driveNameLength, strEltLen, length;
    if (elements == 0) {
	return Tcl_NewObj();
	Tcl_PathType type;
    }

	char *strElt, *ptr;
    assert ( elements > 0 );
	Tcl_Obj *driveName = NULL;

    if (elements == 2) {
	Tcl_Obj *elt = objv[0];
	elt = objv[i];
	Tcl_ObjIntRep *eltIr = TclFetchIntRep(elt, &fsPathType);

	/*
	 * This is a special case where we can be much more efficient, where
	 * we are joining a single relative path onto an object that is
	 * already of path type. The 'TclNewFSPathObj' call below creates an
	 * object which can be normalized more efficiently. Currently we only
	 * use the special case when we have exactly two elements, but we
	 * could expand that in the future.
	 *
	 * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
	 * to be an absolute path. Added a check to ensure that elt is absolute.
         *
         * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
         * to be an absolute path. Added a check for that elt is absolute.
	 */

	if ((eltIr)
	if ((i == 0) && (elements == 2)
                && (elt->typePtr == &tclFsPathType)
		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
		&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
	    Tcl_Obj *tailObj = objv[1];
                && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
            Tcl_Obj *tailObj = objv[i+1];
	    Tcl_PathType type;

	    /* if forceRelative - second path is relative */
	    type = forceRelative ? TCL_PATH_RELATIVE :
		    TclGetPathType(tailObj, NULL, NULL, NULL);
	    if (type == TCL_PATH_RELATIVE) {
		const char *str;
		size_t len;
		int len;

		str = TclGetStringFromObj(tailObj, &len);
		str = Tcl_GetStringFromObj(tailObj, &len);
		if (len == 0) {
		    /*
		     * This happens if we try to handle the root volume '/'.
		     * There's no need to return a special path object, when
		     * the base itself is just fine!
		     */

		    return elt;
		    goto partReturn; /* return elt; */
		}

		/*
		 * If it doesn't begin with '.' and is a unix path or it a
		 * windows path without backslashes, then we can be very
		 * efficient here. (In fact even a windows path with
		 * backslashes can be joined efficiently, but the path object
		 * would not have forward slashes only, and this would
		 * therefore contradict our 'file join' documentation).
		 */

		if (str[0] != '.' && ((tclPlatform != TCL_PLATFORM_WINDOWS)
			|| (strchr(str, '\\') == NULL))) {
		    /*
		     * Finally, on Windows, 'file join' is defined to convert
		     * all backslashes to forward slashes, so the base part
		     * cannot have backslashes either.
		     */

		    if ((tclPlatform != TCL_PLATFORM_WINDOWS)
			    || (strchr(TclGetString(elt), '\\') == NULL)) {

			    || (strchr(Tcl_GetString(elt), '\\') == NULL)
		    ) {
			if (PATHFLAGS(elt)) {
			    return TclNewFSPathObj(elt, str, len);
			    elt = TclNewFSPathObj(elt, str, len);
			    goto partReturn; /* return elt; */
			}
			if (TCL_PATH_ABSOLUTE != Tcl_FSGetPathType(elt)) {
			    return TclNewFSPathObj(elt, str, len);
			    elt = TclNewFSPathObj(elt, str, len);
			    goto partReturn; /* return elt; */
			}
			(void) Tcl_FSGetNormalizedPath(NULL, elt);
			if (elt == PATHOBJ(elt)->normPathPtr) {
			    return TclNewFSPathObj(elt, str, len);
			    elt = TclNewFSPathObj(elt, str, len);
			    goto partReturn; /* return elt; */
			}
		    }
		}

		/*
		 * Otherwise we don't have an easy join, and we must let the
		 * more general code below handle things.
		 */
	    } else if (tclPlatform == TCL_PLATFORM_UNIX) {
		return tailObj;
		elt = tailObj;
		goto partReturn; /* return elt; */
	    } else {
		const char *str = TclGetString(tailObj);

		if (tclPlatform == TCL_PLATFORM_WINDOWS) {
		    if (strchr(str, '\\') == NULL) {
			return tailObj;
			elt = tailObj;
			goto partReturn; /* return elt; */
		    }
		}
	    }
	}
    }

    assert ( res == NULL );

    for (i = 0; i < elements; i++) {
	int driveNameLength;
	size_t strEltLen, length;
	Tcl_PathType type;
	char *strElt, *ptr;
	Tcl_Obj *driveName = NULL;
	Tcl_Obj *elt = objv[i];

	strElt = TclGetStringFromObj(elt, &strEltLen);
	strElt = Tcl_GetStringFromObj(elt, &strEltLen);
	driveNameLength = 0;
	/* if forceRelative - all paths excepting first one are relative */
	type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE :
		TclGetPathType(elt, &fsPtr, &driveNameLength, &driveName);
	if (type != TCL_PATH_RELATIVE) {
	    /*
	     * Zero out the current result.
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
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







-
-
-
-





-
+









-
+

-
+







		     * is not in normalized form
		     */

		    goto noQuickReturn;
		}
		ptr++;
	    }
	    if (res != NULL) {
		TclDecrRefCount(res);
	    }

	    /*
	     * This element is just what we want to return already; no further
	     * manipulation is requred.
	     */

	    return elt;
	    goto partReturn; /* return elt; */
	}

	/*
	 * The path element was not of a suitable form to be returned as is.
	 * We need to perform a more complex operation here.
	 */

    noQuickReturn:
	if (res == NULL) {
	    TclNewObj(res);
	    res = Tcl_NewObj();
	}
	ptr = TclGetStringFromObj(res, &length);
	ptr = Tcl_GetStringFromObj(res, &length);

	/*
	 * Strip off any './' before a tilde, unless this is the beginning of
	 * the path.
	 */

	if (length > 0 && strEltLen > 0 && (strElt[0] == '.') &&
1078
1079
1080
1081
1082
1083
1084
1085

1086
1087

1088
1089
1090
1091
1092
1093
1094
1087
1088
1089
1090
1091
1092
1093

1094
1095

1096
1097
1098
1099
1100
1101
1102
1103







-
+

-
+







		    res = Tcl_DuplicateObj(res);
		    Tcl_IncrRefCount(res);
		}
	    }

	    if (length > 0 && ptr[length -1] != '/') {
		Tcl_AppendToObj(res, &separator, 1);
		(void)TclGetStringFromObj(res, &length);
		Tcl_GetStringFromObj(res, &length);
	    }
	    Tcl_SetObjLength(res, length + strlen(strElt));
	    Tcl_SetObjLength(res, length + (int) strlen(strElt));

	    ptr = TclGetString(res) + length;
	    for (; *strElt != '\0'; strElt++) {
		if (*strElt == separator) {
		    while (strElt[1] == separator) {
			strElt++;
		    }
1102
1103
1104
1105
1106
1107
1108






1109
1110




1111
1112
1113
1114
1115
1116
1117
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123


1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134







+
+
+
+
+
+
-
-
+
+
+
+







		    needsSep = 1;
		}
	    }
	    length = ptr - TclGetString(res);
	    Tcl_SetObjLength(res, length);
	}
    }
    if (res == NULL) {
	res = Tcl_NewObj();
    }
    return res;

partReturn:
    assert ( res != NULL );
    return res;
    if (res != NULL) {
	TclDecrRefCount(res);
    }
    return elt;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSConvertToPathType --
 *
1144
1145
1146
1147
1148
1149
1150
1151

1152
1153
1154
1155

1156
1157



1158
1159
1160






















1161
1162
1163
1164
1165
1166
1167
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







-
+




+
-
-
+
+
+


-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







     * converting this object to FsPath type for the first time, we don't need
     * to worry whether the 'cwd' has changed. On the other hand, if this
     * object is already of FsPath type, and is a relative path, we do have to
     * worry about the cwd. If the cwd has changed, we must recompute the
     * path.
     */

    if (TclHasIntRep(pathPtr, &fsPathType)) {
    if (pathPtr->typePtr == &tclFsPathType) {
	if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
	    return TCL_OK;
	}

	if (pathPtr->bytes == NULL) {
	TclGetString(pathPtr);
	Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
	    UpdateStringOfFsPath(pathPtr);
	}
	FreeFsPathInternalRep(pathPtr);
    }

    return SetFsPathFromAny(interp, pathPtr);
    return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);

    /*
     * We used to have more complex code here:
     *
     * FsPath *fsPathPtr = PATHOBJ(pathPtr);
     * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
     *     return TCL_OK;
     * } else {
     *     if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
     *         return TCL_OK;
     *     } else {
     *         if (pathPtr->bytes == NULL) {
     *             UpdateStringOfFsPath(pathPtr);
     *         }
     *         FreeFsPathInternalRep(pathPtr);
     *         return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
     *     }
     * }
     *
     * But we no longer believe this is necessary.
     */
}

/*
 * Helper function for normalization.
 */

static int
1182
1183
1184
1185
1186
1187
1188
1189

1190
1191
1192
1193
1194
1195
1196
1222
1223
1224
1225
1226
1227
1228

1229
1230
1231
1232
1233
1234
1235
1236







-
+








/*
 * Helper function for SetFsPathFromAny. Returns position of first directory
 * delimiter in the path. If no separator is found, then returns the position
 * of the end of the string.
 */

static size_t
static int
FindSplitPos(
    const char *path,
    int separator)
{
    int count = 0;
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
1236
1237
1238
1239
1240
1241
1242
1243

1244
1245
1246
1247
1248
1249
1250
1276
1277
1278
1279
1280
1281
1282

1283
1284
1285
1286
1287
1288
1289
1290







-
+







 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclNewFSPathObj(
    Tcl_Obj *dirPtr,
    const char *addStrRep,
    size_t len)
    int len)
{
    FsPath *fsPathPtr;
    Tcl_Obj *pathPtr;
    const char *p;
    int state = 0, count = 0;

    /* [Bug 2806250] - this is only a partial solution of the problem.
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
1348
1349
1350
1351
1352

1353
1354
1355


1356
1357
1358
1359
1360
1361
1362
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
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
1385
1386

1387
1388
1389
1390
1391
1392
1393

1394
1395


1396
1397
1398
1399
1400
1401
1402
1403
1404







-
-
+
+
















+
+
-
+



-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+










+


-







-
+

-
-
+
+







	Tcl_Obj *tail = Tcl_NewStringObj(addStrRep, len);

	pathPtr = AppendPath(dirPtr, tail);
	Tcl_DecrRefCount(tail);
	return pathPtr;
    }

    TclNewObj(pathPtr);
    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));
    pathPtr = Tcl_NewObj();
    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

    /*
     * Set up the path.
     */

    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
    fsPathPtr->cwdPtr = dirPtr;
    Tcl_IncrRefCount(dirPtr);
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    fsPathPtr->filesystemEpoch = 0;

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
    pathPtr->typePtr = &tclFsPathType;
    pathPtr->bytes = NULL;
    TclInvalidateStringRep(pathPtr);
    pathPtr->length = 0;

    /*
     * Look for path components made up of only "."
     * This is overly conservative analysis to keep simple. It may mark some
     * things as needing more aggressive normalization that don't actually
     * need it. No harm done.
     * This is overly conservative analysis to keep simple.  It may
     * mark some things as needing more aggressive normalization
     * that don't actually need it.  No harm done.
     */
    for (p = addStrRep; len+1 > 1; p++, len--) {
	switch (state) {
	case 0:		/* So far only "." since last dirsep or start */
	    switch (*p) {
	    case '.':
		count = 1;
		break;
	    case '/':
	    case '\\':
	    case ':':
		if (count) {
		    PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
		    len = 0;
		}
		break;
	    default:
		count = 0;
		state = 1;
	    }
	    break;
	case 1:		/* Scanning for next dirsep */
	    switch (*p) {
	    case '/':
	    case '\\':
	    case ':':
		state = 0;
		break;
	    }
	}
    for (p = addStrRep; len > 0; p++, len--) {
       switch (state) {
       case 0: /* So far only "." since last dirsep or start */
           switch (*p) {
           case '.':
               count++;
               break;
           case '/':
           case '\\':
           case ':':
               if (count) {
                   PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
                   len = 0;
               }
               break;
           default:
               count = 0;
               state = 1;
           }
           break;
       case 1: /* Scanning for next dirsep */
           switch (*p) {
           case '/':
           case '\\':
           case ':':
               state = 0;
               break;
           }
       }
    }
    if (len == 0 && count) {
	PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
       PATHFLAGS(pathPtr) |= TCLPATH_NEEDNORM;
    }

    return pathPtr;
}

static Tcl_Obj *
AppendPath(
    Tcl_Obj *head,
    Tcl_Obj *tail)
{
    int numBytes;
    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);
    size_t length;

    /*
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was
     * chosen so that "JoinPath" operations that pass through either path
     * intrep produce the same results; that is, bugward compatibility.  If
     * we need to fix that bug here, it needs fixing in TclJoinPath() too.
     * we need to fix that bug here, it needs fixing in Tcl_FSJoinPath() too.
     */
    bytes = TclGetStringFromObj(tail, &length);
    if (length == 0) {
    bytes = Tcl_GetStringFromObj(tail, &numBytes);
    if (numBytes == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }
    return copy;
}

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
1439
1440
1441
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
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518

1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538

1539
1540
1541
1542
1543
1544
1545
1546







-
+



-
+

-

-
+


-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














-
+



















-
+







 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclFSMakePathRelative(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    size_t cwdLen, len;
    int cwdLen, len;
    const char *tempStr;
    Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);

    if (irPtr) {
    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
	    return fsPathPtr->normPathPtr;
	if (PATHFLAGS(pathPtr) != 0
		&& fsPathPtr->cwdPtr == cwdPtr) {
	    pathPtr = fsPathPtr->normPathPtr;

	    /* TODO: Determine how much, if any, of this forcing
	     * the relative path tail into the "path" Tcl_ObjType
	     * with a recorded cwdPtr context has any actual value.
	     *
	     * Nothing is getting cached.  Not normPathPtr, not nativePathPtr,
	     * nor fsPtr, so storing the cwdPtr context against which such
	     * cached values might later be validated appears to be of no
	     * value.  Take that away, and all this code is just a mildly
	     * optimized equivalent of a call to SetFsPathFromAny().  That
	     * optimization may have some value, *if* these value in fact
	     * get used as "path" values before used as something else.
	     * If not, though, whatever cost we pay below to convert to
	     * one of the "path" intreps is just a waste, it seems.  The
	     * usual convention in the core is to delay ObjType conversion
	     * until it is needed and demanded, and I don't see why this
	     * section of code should be an exception to that.  Leaving it
	     * in place for the rest of the 8.5.* releases just for sake
	     * of stability.
	     */

	    /*
	     * Free old representation.
	     */

	    if (pathPtr->typePtr != NULL) {
		if (pathPtr->bytes == NULL) {
		    if (pathPtr->typePtr->updateStringProc == NULL) {
			if (interp != NULL) {
			    Tcl_ResetResult(interp);
			    Tcl_AppendResult(interp, "can't find object"
				    "string representation", NULL);
			}
			return NULL;
		    }
		    pathPtr->typePtr->updateStringProc(pathPtr);
		}
		TclFreeIntRep(pathPtr);
	    }

	    /*
	     * Now pathPtr is a string object.
	     */

	    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

	    /*
	     * Circular reference, by design.
	     */

	    fsPathPtr->translatedPathPtr = pathPtr;
	    fsPathPtr->normPathPtr = NULL;
	    fsPathPtr->cwdPtr = cwdPtr;
	    Tcl_IncrRefCount(cwdPtr);
	    fsPathPtr->nativePathPtr = NULL;
	    fsPathPtr->fsPtr = NULL;
	    fsPathPtr->filesystemEpoch = 0;

	    SETPATHOBJ(pathPtr, fsPathPtr);
	    PATHFLAGS(pathPtr) = 0;
	    pathPtr->typePtr = &tclFsPathType;

	    return pathPtr;
	}
    }

    /*
     * We know the cwd is a normalised object which does not end in a
     * directory delimiter, unless the cwd is the name of a volume, in which
     * case it will end in a delimiter! We handle this situation here. A
     * better test than the '!= sep' might be to simply check if 'cwd' is a
     * root volume.
     *
     * Note that if we get this wrong, we will strip off either too much or
     * too little below, leading to wrong answers returned by glob.
     */

    tempStr = TclGetStringFromObj(cwdPtr, &cwdLen);
    tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);

    /*
     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
     * Windows special case? Perhaps we should just check if cwd is a root
     * volume.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	if (tempStr[cwdLen-1] != '/') {
	    cwdLen++;
	}
	break;
    case TCL_PLATFORM_WINDOWS:
	if (tempStr[cwdLen-1] != '/' && tempStr[cwdLen-1] != '\\') {
	    cwdLen++;
	}
	break;
    }
    tempStr = TclGetStringFromObj(pathPtr, &len);
    tempStr = Tcl_GetStringFromObj(pathPtr, &len);

    return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}

/*
 *---------------------------------------------------------------------------
 *
1451
1452
1453
1454
1455
1456
1457
1458

1459
1460
1461
1462
1463

1464
1465
1466



















1467

1468
1469
1470
1471
1472
1473
1474




1475

1476
1477
1478
1479
1480
1481
1482
1483

1484
1485
1486
1487
1488
1489
1490
1491
1492
1493

1494
1495
1496
1497
1498
1499
1500
1501
1502

1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515

1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533







1534
1535




1536
1537
1538




1539

1540
1541
1542
1543
1544
1545
1546

1547
1548
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
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
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
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

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
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







-
+




-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+







+
+
+
+
-
+








+









-
+








-
+












-
+


















+
+
+
+
+
+
+
-
-
+
+
+
+



+
+
+
+
-
+







+









-
+

-
-
+
+


-
+


-
+
-
-

















-
+
-
-
-
-
-









-
-





-
-
+
+
-
-
+





+

+
+
+
+
+
+
+
+







 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
MakePathFromNormalized(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    FsPath *fsPathPtr;

    if (TclHasIntRep(pathPtr, &fsPathType)) {
    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*
     * Free old representation
     */

    if (pathPtr->typePtr != NULL) {
	if (pathPtr->bytes == NULL) {
	    if (pathPtr->typePtr->updateStringProc == NULL) {
		if (interp != NULL) {
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "can't find object"
			    "string representation", NULL);
		}
		return TCL_ERROR;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
	TclFreeIntRep(pathPtr);
    }

    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));
    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

    /*
     * It's a pure normalized absolute path.
     */

    fsPathPtr->translatedPathPtr = NULL;

    /*
     * Circular reference by design.
     */

    Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    /* Remember the epoch under which we decided pathPtr was normalized */
    fsPathPtr->filesystemEpoch = TclFSEpoch();

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSNewNativePath --
 *
 *	Performs the something like the reverse of the usual
 *	This function performs the something like the reverse of the usual
 *	obj->path->nativerep conversions. If some code retrieves a path in
 *	native form (from, e.g. readlink or a native dialog), and that path is
 *	to be used at the Tcl level, then calling this function is an
 *	efficient way of creating the appropriate path object type.
 *
 *	Any memory which is allocated for 'clientData' should be retained
 *	until clientData is passed to the filesystem's freeInternalRepProc
 *	when it can be freed. The built in platform-specific filesystems use
 *	'Tcl_Alloc' to allocate clientData, and Tcl_Free to free it.
 *	'ckalloc' to allocate clientData, and ckfree to free it.
 *
 * Results:
 *	NULL or a valid path object pointer, with refCount zero.
 *
 * Side effects:
 *	New memory may be allocated.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSNewNativePath(
    const Tcl_Filesystem *fromFilesystem,
    Tcl_Filesystem *fromFilesystem,
    ClientData clientData)
{
    Tcl_Obj *pathPtr = NULL;
    FsPath *fsPathPtr;


    if (fromFilesystem->internalToNormalizedProc != NULL) {
	pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData);
    }
    if (pathPtr == NULL) {
	return NULL;
    }

    /*
     * Free old representation; shouldn't normally be any, but best to be
     * safe.
     */

    if (pathPtr->typePtr != NULL) {
	if (pathPtr->bytes == NULL) {
	    if (pathPtr->typePtr->updateStringProc == NULL) {
		return NULL;
	    }
	    pathPtr->typePtr->updateStringProc(pathPtr);
	}
    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));
	TclFreeIntRep(pathPtr);
    }

    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = NULL;

    /*
     * Circular reference, by design.
     */

    Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = clientData;
    fsPathPtr->fsPtr = fromFilesystem;
    fsPathPtr->filesystemEpoch = TclFSEpoch();

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return pathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetTranslatedPath --
 *
 *	Attempts to extract the translated path from the given
 *	This function attempts to extract the translated path from the given
 *	Tcl_Obj. If the translation succeeds (i.e. the object is a valid
 *	path), then it is returned. Otherwise NULL is returned and an
 *	error message may be left in the interpreter if it is not NULL.
 *	path), then it is returned. Otherwise NULL will be returned, and an
 *	error message may be left in the interpreter (if it is non-NULL)
 *
 * Results:
 *	A Tcl_Obj pointer or NULL.
 *	NULL or a valid Tcl_Obj pointer.
 *
 * Side effects:
 *	pathPtr is converted to fsPathType if necessary.
 *	Only those of 'Tcl_FSConvertToPathType'
 *
 *	FsPath members are modified as needed.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_FSGetTranslatedPath(
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *retObj = NULL;
    FsPath *srcFsPathPtr;

    if (Tcl_FSConvertToPathType(interp, pathPtr) != TCL_OK) {
	return NULL;
    }
    srcFsPathPtr = PATHOBJ(pathPtr);
    if (srcFsPathPtr->translatedPathPtr == NULL) {
	if (PATHFLAGS(pathPtr) == 0) {
	if (PATHFLAGS(pathPtr) != 0) {
	    /*
	     * Path is already normalized
	     */
	    retObj = srcFsPathPtr->normPathPtr;
	} else {
	    /*
	     * We lack a translated path result, but we have a directory
	     * (cwdPtr) and a tail (normPathPtr), and if we join the
	     * translated version of cwdPtr to normPathPtr, we'll get the
	     * translated result we need, and can store it for future use.
	     */

	    Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
		    srcFsPathPtr->cwdPtr);
	    Tcl_ObjIntRep *translatedCwdIrPtr;

	    if (translatedCwdPtr == NULL) {
		return NULL;
	    }

	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
		    &srcFsPathPtr->normPathPtr);
	    Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj);
		    &(srcFsPathPtr->normPathPtr));
	    srcFsPathPtr->translatedPathPtr = retObj;
	    translatedCwdIrPtr = TclFetchIntRep(translatedCwdPtr, &fsPathType);
	    if (translatedCwdIrPtr) {
	    if (translatedCwdPtr->typePtr == &tclFsPathType) {
		srcFsPathPtr->filesystemEpoch
			= PATHOBJ(translatedCwdPtr)->filesystemEpoch;
	    } else {
		srcFsPathPtr->filesystemEpoch = 0;
	    }
	    Tcl_IncrRefCount(retObj);
	    Tcl_DecrRefCount(translatedCwdPtr);
	} else {
	    /*
	     * It is a pure absolute, normalized path object. This is
	     * something like being a 'pure list'. The object's string,
	     * translatedPath and normalizedPath are all identical.
	     */

	    retObj = srcFsPathPtr->normPathPtr;
	}
    } else {
	/*
	 * It is an ordinary path object.
	 */

	retObj = srcFsPathPtr->translatedPathPtr;
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661



1662
1663

1664
1665
1666
1667
1668
1669
1670
1794
1795
1796
1797
1798
1799
1800



1801
1802
1803
1804

1805
1806
1807
1808
1809
1810
1811
1812







-
-
-
+
+
+

-
+







Tcl_FSGetTranslatedStringPath(
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr)
{
    Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(interp, pathPtr);

    if (transPtr != NULL) {
	size_t len;
	const char *orig = TclGetStringFromObj(transPtr, &len);
	char *result = (char *)Tcl_Alloc(len+1);
	int len;
	const char *orig = Tcl_GetStringFromObj(transPtr, &len);
	char *result = (char *) ckalloc((unsigned) len+1);

	memcpy(result, orig, len+1);
	memcpy(result, orig, (size_t) len+1);
	TclDecrRefCount(transPtr);
	return result;
    }

    return NULL;
}

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
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
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
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







-
+
-







+
-
-
-
+
+
+
+












-
+





-
-
-
-
+
+
+
+



-




-
-
-
-
-
-
-
+
+
+
+
+
+
+
+












-
+

-
-
-
+
+
+










+
+
+
+








+
+
+
+











+
-
-
-
+
+
+
+




-
+




-
-
+
+













+


-
+

















-
-
-
-
-
+
+
+
+
+







    if (PATHFLAGS(pathPtr) != 0) {
	/*
	 * This is a special path object which is the result of something like
	 * 'file join'
	 */

	Tcl_Obj *dir, *copy;
	size_t tailLen, cwdLen;
	int tailLen, cwdLen, pathType;
	int pathType;

	pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
	dir = Tcl_FSGetNormalizedPath(interp, fsPathPtr->cwdPtr);
	if (dir == NULL) {
	    return NULL;
	}
	/* TODO: Figure out why this is needed. */
	if (pathPtr->bytes == NULL) {
	TclGetString(pathPtr);

	(void)TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	    UpdateStringOfFsPath(pathPtr);
	}

	Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
	if (tailLen) {
	    copy = AppendPath(dir, fsPathPtr->normPathPtr);
	} else {
	    copy = Tcl_DuplicateObj(dir);
	}
	Tcl_IncrRefCount(dir);
	Tcl_IncrRefCount(copy);

	/*
	 * We now own a reference on both 'dir' and 'copy'
	 */

	(void) TclGetStringFromObj(dir, &cwdLen);
	(void) Tcl_GetStringFromObj(dir, &cwdLen);

	/* Normalize the combined string. */

	if (PATHFLAGS(pathPtr) & TCLPATH_NEEDNORM) {
	    /*
	     * If the "tail" part has components (like /../) that cause the
	     * combined path to need more complete normalizing, call on the
	     * more powerful routine to accomplish that so we avoid [Bug
	     * 2385549] ...
	     * If the "tail" part has components (like /../) that cause
	     * the combined path to need more complete normalizing,
	     * call on the more powerful routine to accomplish that so
	     * we avoid [Bug 2385549] ...
	     */

	    Tcl_Obj *newCopy = TclFSNormalizeAbsolutePath(interp, copy);

	    Tcl_DecrRefCount(copy);
	    copy = newCopy;
	} else {
	    /*
	     * ... but in most cases where we join a trouble free tail to a
	     * normalized head, we can more efficiently normalize the combined
	     * path by passing over only the unnormalized tail portion. When
	     * this is sufficient, prior developers claim this should be much
	     * faster. We use 'cwdLen' so that we are already pointing at
	     * the dir-separator that we know about. The normalization code
	     * will actually start off directly after that separator.
	     * ... but in most cases where we join a trouble free tail
	     * to a normalized head, we can more efficiently normalize the
	     * combined path by passing over only the unnormalized tail
	     * portion.  When this is sufficient, prior developers claim
	     * this should be much faster.  We use 'cwdLen' so that we are
	     * already pointing at the dir-separator that we know about.
	     * The normalization code will actually start off directly
	     * after that separator.
	     */

	    TclFSNormalizeToUniquePath(interp, copy, cwdLen);
	}

	/* Now we need to construct the new path object. */

	if (pathType == TCL_PATH_RELATIVE) {
	    Tcl_Obj *origDir = fsPathPtr->cwdPtr;

	    /*
	     * NOTE: here we are (dangerously?) assuming that origDir points
	     * to a Tcl_Obj with Tcl_ObjType == &fsPathType. The
	     * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType .  The
	     *     pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
	     * above that set the pathType value should have established that,
	     * but it's far less clear on what basis we know there's been no
	     * shimmering since then.
	     * above that set the pathType value should have established
	     * that, but it's far less clear on what basis we know there's
	     * been no shimmering since then.
	     */

	    FsPath *origDirFsPathPtr = PATHOBJ(origDir);

	    fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr;
	    Tcl_IncrRefCount(fsPathPtr->cwdPtr);

	    TclDecrRefCount(fsPathPtr->normPathPtr);
	    fsPathPtr->normPathPtr = copy;

	    /*
	     * That's our reference to copy used.
	     */

	    TclDecrRefCount(dir);
	    TclDecrRefCount(origDir);
	} else {
	    TclDecrRefCount(fsPathPtr->cwdPtr);
	    fsPathPtr->cwdPtr = NULL;
	    TclDecrRefCount(fsPathPtr->normPathPtr);
	    fsPathPtr->normPathPtr = copy;

	    /*
	     * That's our reference to copy used.
	     */

	    TclDecrRefCount(dir);
	}
	PATHFLAGS(pathPtr) = 0;
    }

    /*
     * Ensure cwd hasn't changed.
     */

    if (fsPathPtr->cwdPtr != NULL) {
	if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
	    if (pathPtr->bytes == NULL) {
	    TclGetString(pathPtr);
	    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
		UpdateStringOfFsPath(pathPtr);
	    }
	    FreeFsPathInternalRep(pathPtr);
	    if (Tcl_ConvertToType(interp, pathPtr, &tclFsPathType) != TCL_OK) {
		return NULL;
	    }
	    fsPathPtr = PATHOBJ(pathPtr);
	} else if (fsPathPtr->normPathPtr == NULL) {
	    size_t cwdLen;
	    int cwdLen;
	    Tcl_Obj *copy;

	    copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);

	    (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (TclGetString(copy)[cwdLen] == '/');
	    (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
	    cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');

	    /*
	     * Normalize the combined string, but only starting after the end
	     * of the previously normalized 'dir'. This should be much faster!
	     */

	    TclFSNormalizeToUniquePath(interp, copy, cwdLen-1);
	    fsPathPtr->normPathPtr = copy;
	    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
	}
    }
    if (fsPathPtr->normPathPtr == NULL) {
	Tcl_Obj *useThisCwd = NULL;
	int pureNormalized = 1;

	/*
	 * Since normPathPtr is NULL but this is a valid path object, we know
	 * Since normPathPtr is NULL, but this is a valid path object, we know
	 * that the translatedPathPtr cannot be NULL.
	 */

	Tcl_Obj *absolutePath = fsPathPtr->translatedPathPtr;
	const char *path = TclGetString(absolutePath);

	Tcl_IncrRefCount(absolutePath);

	/*
	 * We have to be a little bit careful here to avoid infinite loops
	 * we're asking Tcl_FSGetPathType to return the path's type, but that
	 * call can actually result in a lot of other filesystem action, which
	 * might loop back through here.
	 */

	if (path[0] == '\0') {
	    /*
	     * Special handling for the empty string value. This one is very
	     * weird with [file normalize {}] => {}. (The reasoning supporting
	     * this is unknown to DGP, but he fears changing it.) Attempt here
	     * to keep the expectations of other parts of Tcl_Filesystem code
	     * about state of the FsPath fields satisfied.
	     * Special handling for the empty string value.  This one is
	     * very weird with [file normalize {}] => {}.  (The reasoning
	     * supporting this is unknown to DGP, but he fears changing it.)
	     * Attempt here to keep the expectations of other parts of
	     * Tcl_Filesystem code about state of the FsPath fields satisfied.
	     *
	     * In particular, capture the cwd value and save so it can be
	     * stored in the cwdPtr field below.
	     */

	    useThisCwd = Tcl_FSGetCwd(interp);
	} else {
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
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







+







-
+











+
-
+







+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+




















-
-
+
+
+

+
-
+
-
-
+
-


-
+
-
-


-
-
-
+







-
+









+
+
-
-
-
-
+
+
+
+
-
+



-
+



+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+





+
-
-
-
+
+
+




















-
+


-










+
-
+
-
+


-
+


-
+
-







-
+



-
+





-
-
-
-
-
+
+
+
+
+
+
+
+


+
-
-
+
+
+






-
-
-
-
+
+
+
+
+







	    if (type == TCL_PATH_RELATIVE) {
		useThisCwd = Tcl_FSGetCwd(interp);

		if (useThisCwd == NULL) {
		    return NULL;
		}

		pureNormalized = 0;
		Tcl_DecrRefCount(absolutePath);
		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
		Tcl_IncrRefCount(absolutePath);

		/*
		 * We have a refCount on the cwd.
		 */
#ifdef _WIN32
#ifdef __WIN32__
	    } else if (type == TCL_PATH_VOLUME_RELATIVE) {
		/*
		 * Only Windows has volume-relative paths.
		 */

		Tcl_DecrRefCount(absolutePath);
		absolutePath = TclWinVolumeRelativeNormalize(interp,
			path, &useThisCwd);
		if (absolutePath == NULL) {
		    return NULL;
		}
		pureNormalized = 0;
#endif /* _WIN32 */
#endif /* __WIN32__ */
	    }
	}

	/*
	 * Already has refCount incremented.
	 */

	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
		absolutePath);

	/*
	 * Check if path is pure normalized (this can only be the case if it
	 * is an absolute path).
	 */

	if (pureNormalized) {
	if (fsPathPtr->normPathPtr) {
	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
	}
	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
	    if (!strcmp(TclGetString(fsPathPtr->normPathPtr),
		    TclGetString(pathPtr))) {
		/*
		 * The path was already normalized. Get rid of the duplicate.
		 */

		TclDecrRefCount(fsPathPtr->normPathPtr);

		/*
		 * We do *not* increment the refCount for this circular
		 * reference.
		 */

		fsPathPtr->normPathPtr = pathPtr;
		absolutePath);

	    }
	}
	if (useThisCwd != NULL) {
	    /*
	     * We just need to free an object we allocated above for relative
	     * paths (this was returned by Tcl_FSJoinToPath above), and then
	     * of course store the cwd.
	     */

	    fsPathPtr->cwdPtr = useThisCwd;
	}
	TclDecrRefCount(absolutePath);
    }

    return fsPathPtr->normPathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSGetInternalRep --
 *
 *	Produces a native representation of a given path object in the given
 *	filesystem.
 *	Extract the internal representation of a given path object, in the
 *	given filesystem. If the path object belongs to a different
 *	filesystem, we return NULL.
 *
 *	If the internal representation is currently NULL, we attempt to
 *	In the future it might be desirable to have separate versions
 *	generate it, by calling the filesystem's
 *	of this function with different signatures, for example
 *	Tcl_FSGetNativeWinPath, Tcl_FSGetNativeUnixPath etc. Right now, since
 *	'Tcl_FSCreateInternalRepProc'.
 *	native paths are all string based, we use just one function.
 *
 * Results:
 *
 *	NULL or a valid internal representation.
 *	The native handle for the path, or NULL if the path is not handled by
 *	the given filesystem
 *
 * Side effects:
 *
 *	Tcl_FSCreateInternalRepProc if needed to produce the native
 *	handle, which is then stored in the internal representation of pathPtr.
 *	An attempt may be made to convert the object.
 *
 *---------------------------------------------------------------------------
 */

ClientData
Tcl_FSGetInternalRep(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr)
    Tcl_Filesystem *fsPtr)
{
    FsPath *srcFsPathPtr;

    if (Tcl_FSConvertToPathType(NULL, pathPtr) != TCL_OK) {
	return NULL;
    }
    srcFsPathPtr = PATHOBJ(pathPtr);

    /*
     * We will only return the native representation for the caller's
     * filesystem. Otherwise we will simply return NULL. This means that there
     * Currently there must be a unique bi-directional mapping between a path
     * and a filesystem, and therefore there is no way to "remap" a file, i.e.,
     * to map a file in one filesystem into another. Another way of putting
     * this is that 'stacked' filesystems are not allowed.  It could be useful
     * must be a unique bi-directional mapping between paths and filesystems,
     * and that this mapping will not allow 'remapped' files -- files which
     * are in one filesystem but mapped into another. Another way of putting
     * this is that 'stacked' filesystems are not allowed. We recognise that
     * in the future to redesign the system to allow that.
     * this is a potentially useful feature for the future.
     *
     * Even something simple like a 'pass through' filesystem which logs all
     * activity and passes the calls onto the native system would be nice, but
     * not currently easily achievable.
     * not easily achievable with the current implementation.
     */

    if (srcFsPathPtr->fsPtr == NULL) {
	/*
	 * This only usually happens in wrappers like TclpStat which create a
	 * string object and pass it to TclpObjStat. Code which calls the
	 * Tcl_FS.. functions should always have a filesystem already set.
	 * Whether this code path is legal or not depends on whether we decide
	 * to allow external code to call the native filesystem directly. It
	 * is at least safer to allow this sub-optimal routing.
	 */

	Tcl_FSGetFileSystemForPath(pathPtr);

	srcFsPathPtr = PATHOBJ(pathPtr);
	if (srcFsPathPtr->fsPtr == NULL) {
	    /*
	     * The path is probably not a valid path in the filesystsem, and is
	     * most likely to be a use of the empty path "" via a direct call
	     * to one of the objectified interfaces (e.g. from the Tcl
	     * testsuite).
	     */
	/*
	 * If we fail through here, then the path is probably not a valid path
	 * in the filesystsem, and is most likely to be a use of the empty
	 * path "" via a direct call to one of the objectified interfaces
	 * (e.g. from the Tcl testsuite).
	 */

	srcFsPathPtr = PATHOBJ(pathPtr);
	if (srcFsPathPtr->fsPtr == NULL) {
	    return NULL;
	}
    }

    /*
     * There is still one possibility we should consider; if the file belongs
     * If the file belongs to a different filesystem, perhaps it is actually
     * linked through to a file in the given filesystem. Check this by
     * inspecting the filesystem associated with the given path.
     * to a different filesystem, perhaps it is actually linked through to a
     * file in our own filesystem which we do care about. The way we can check
     * for this is we ask what filesystem this path belongs to.
     */

    if (fsPtr != srcFsPathPtr->fsPtr) {
	const Tcl_Filesystem *actualFs = Tcl_FSGetFileSystemForPath(pathPtr);

	if (actualFs == fsPtr) {
	    return Tcl_FSGetInternalRep(pathPtr, fsPtr);
	}
	return NULL;
    }

    if (srcFsPathPtr->nativePathPtr == NULL) {
	Tcl_FSCreateInternalRepProc *proc;
	char *nativePathPtr;

	proc = srcFsPathPtr->fsPtr->createInternalRepProc;
	if (proc == NULL) {
	    return NULL;
	}

	nativePathPtr = (char *)proc(pathPtr);
	nativePathPtr = (*proc)(pathPtr);
	srcFsPathPtr = PATHOBJ(pathPtr);
	srcFsPathPtr->nativePathPtr = nativePathPtr;
	srcFsPathPtr->filesystemEpoch = TclFSEpoch();
    }

    return srcFsPathPtr->nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSEnsureEpochOk --
 *
 *	This will ensure the pathPtr is up to date and can be converted into a
 *	Ensure that the path is a valid path, and that it has a
 *	"path" type, and that we are able to generate a complete normalized
 *	fsPathType internal representation that is not stale.
 *	path which is used to determine the filesystem match.
 *
 * Results:
 *	A standard Tcl return code.
 *	Standard Tcl return code.
 *
 * Side effects:
 *	The internal representation of fsPtrPtr is converted to fsPathType if
 *	An attempt may be made to convert the object.
 *	possible.
 *
 *---------------------------------------------------------------------------
 */

int
TclFSEnsureEpochOk(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem **fsPtrPtr)
    Tcl_Filesystem **fsPtrPtr)
{
    FsPath *srcFsPathPtr;

    if (!TclHasIntRep(pathPtr, &fsPathType)) {
    if (pathPtr->typePtr != &tclFsPathType) {
	return TCL_OK;
    }

    srcFsPathPtr = PATHOBJ(pathPtr);

    if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) {
	/*
	 * The filesystem has changed in some way since the internal
	 * representation for this object was calculated. Discard the stale
	 * representation and recalculate it.
    /*
     * Check if the filesystem has changed in some way since this object's
     * internal representation was calculated.
     */

    if (!TclFSEpochOk(srcFsPathPtr->filesystemEpoch)) {
	/*
	 * We have to discard the stale representation and recalculate it.
	 */

	if (pathPtr->bytes == NULL) {
	TclGetString(pathPtr);
	Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
	    UpdateStringOfFsPath(pathPtr);
	}
	FreeFsPathInternalRep(pathPtr);
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return TCL_ERROR;
	}
	srcFsPathPtr = PATHOBJ(pathPtr);
    }

    if (srcFsPathPtr->fsPtr != NULL) {
	/*
	 * There is already a filesystem assigned to this path.
	 */
    /*
     * Check whether the object is already assigned to a fs.
     */

    if (srcFsPathPtr->fsPtr != NULL) {
	*fsPtrPtr = srcFsPathPtr->fsPtr;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
2093
2094
2095
2096
2097
2098
2099
2100

2101
2102
2103
2104
2105
2106
2107
2108
2109

2110
2111
2112
2113
2114
2115
2116
2282
2283
2284
2285
2286
2287
2288

2289
2290
2291
2292
2293
2294
2295
2296
2297

2298
2299
2300
2301
2302
2303
2304
2305







-
+








-
+







 *
 *---------------------------------------------------------------------------
 */

void
TclFSSetPathDetails(
    Tcl_Obj *pathPtr,
    const Tcl_Filesystem *fsPtr,
    Tcl_Filesystem *fsPtr,
    ClientData clientData)
{
    FsPath *srcFsPathPtr;

    /*
     * Make sure pathPtr is of the correct type.
     */

    if (!TclHasIntRep(pathPtr, &fsPathType)) {
    if (pathPtr->typePtr != &tclFsPathType) {
	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
	    return;
	}
    }

    srcFsPathPtr = PATHOBJ(pathPtr);
    srcFsPathPtr->fsPtr = fsPtr;
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
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







-
-
+
+
-








-
-
-
+
+
+

















-
-
-
+
+
+







-
-
+
+

-
-
+
+
-















-
+


-
+

-
+

















-
+






+

-
+







 */

int
Tcl_FSEqualPaths(
    Tcl_Obj *firstPtr,
    Tcl_Obj *secondPtr)
{
    const char *firstStr, *secondStr;
    size_t firstLen, secondLen;
    char *firstStr, *secondStr;
    int firstLen, secondLen, tempErrno;
    int tempErrno;

    if (firstPtr == secondPtr) {
	return 1;
    }

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
    }
    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
    if ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen)) {
    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
    if ((firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0)) {
	return 1;
    }

    /*
     * Try the most thorough, correct method of comparing fully normalized
     * paths.
     */

    tempErrno = Tcl_GetErrno();
    firstPtr = Tcl_FSGetNormalizedPath(NULL, firstPtr);
    secondPtr = Tcl_FSGetNormalizedPath(NULL, secondPtr);
    Tcl_SetErrno(tempErrno);

    if (firstPtr == NULL || secondPtr == NULL) {
	return 0;
    }

    firstStr = TclGetStringFromObj(firstPtr, &firstLen);
    secondStr = TclGetStringFromObj(secondPtr, &secondLen);
    return ((firstLen == secondLen) && !memcmp(firstStr, secondStr, firstLen));
    firstStr = Tcl_GetStringFromObj(firstPtr, &firstLen);
    secondStr = Tcl_GetStringFromObj(secondPtr, &secondLen);
    return (firstLen == secondLen) && (strcmp(firstStr, secondStr) == 0);
}

/*
 *---------------------------------------------------------------------------
 *
 * SetFsPathFromAny --
 *
 *	Attempt to convert the internal representation of pathPtr to
 *	fsPathType.
 *	This function tries to convert the given Tcl_Obj to a valid Tcl path
 *	type.
 *
 *	A tilde ("~") character at the beginnig of the filename indicates the
 *	current user's home directory, and "~<user>" indicates a particular
 *	The filename may begin with "~" (to indicate current user's home
 *	directory) or "~<user>" (to indicate any user's home directory).
 *	user's directory.
 *
 * Results:
 *	Standard Tcl error code.
 *
 * Side effects:
 *	The old representation may be freed, and new memory allocated.
 *
 *---------------------------------------------------------------------------
 */

static int
SetFsPathFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    size_t len;
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    const char *name;
    char *name;

    if (TclHasIntRep(pathPtr, &fsPathType)) {
    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*
     * First step is to translate the filename. This is similar to
     * Tcl_TranslateFilename, but shouldn't convert everything to windows
     * backslashes on that platform. The current implementation of this piece
     * is a slightly optimised version of the various Tilde/Split/Join stuff
     * to avoid multiple split/join operations.
     *
     * We remove any trailing directory separator.
     *
     * However, the split/join routines are quite complex, and one has to make
     * sure not to break anything on Unix or Win (fCmd.test, fileName.test and
     * cmdAH.test exercise most of the code).
     */

    name = TclGetStringFromObj(pathPtr, &len);
    name = Tcl_GetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (len && name[0] == '~') {
	char *expandedUser;
	Tcl_DString temp;
	size_t split;
	int split;
	char separator = '/';

	/*
	 * We have multiple cases '~/foo/bar...', '~user/foo/bar...', etc.
	 * split becomes value 1 for '~/...' as well as for '~'.
	 */
	split = FindSplitPos(name, separator);
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
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







-
-
-
+
+
+
-
-








-
+


-









-
-
+
+
-
-
+








+
-
+








	    const char *dir;
	    Tcl_DString dirString;

	    dir = TclGetEnv("HOME", &dirString);
	    if (dir == NULL) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "couldn't find HOME environment variable to"
			    " expand path", -1));
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "couldn't find HOME environment "
			    "variable to expand path", NULL);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH",
			    "HOMELESS", NULL);
		}
		return TCL_ERROR;
	    }
	    Tcl_DStringInit(&temp);
	    Tcl_JoinPath(1, &dir, &temp);
	    Tcl_DStringFree(&dirString);
	} else {
	    /*
	     * There is a '~user'
	     * We have a user name '~user'
	     */

	    const char *expandedUser;
	    Tcl_DString userName;

	    Tcl_DStringInit(&userName);
	    Tcl_DStringAppend(&userName, name+1, split-1);
	    expandedUser = Tcl_DStringValue(&userName);

	    Tcl_DStringInit(&temp);
	    if (TclpGetUserHome(expandedUser, &temp) == NULL) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "user \"%s\" doesn't exist", expandedUser));
		    Tcl_ResetResult(interp);
		    Tcl_AppendResult(interp, "user \"", expandedUser,
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "NOUSER",
			    NULL);
			    "\" doesn't exist", NULL);
		}
		Tcl_DStringFree(&userName);
		Tcl_DStringFree(&temp);
		return TCL_ERROR;
	    }
	    Tcl_DStringFree(&userName);
	}

	expandedUser = Tcl_DStringValue(&temp);
	transPtr = TclDStringToObj(&temp);
	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));

	if (split != len) {
	    /*
	     * Join up the tilde substitution with the rest.
	     */

	    if (name[split+1] == separator) {
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
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







-
+
-









-
+


-
+



+









-
+

+
-
-
-
+
+
+
+

-
+

-
-





+
+
+
+
+


+








		/*
		 * Skip '~'. It's replaced by its expansion.
		 */

		objc--; objv++;
		while (objc--) {
		    TclpNativeJoinPath(transPtr, TclGetString(*objv));
		    TclpNativeJoinPath(transPtr, Tcl_GetString(*objv++));
		    objv++;
		}
		TclDecrRefCount(parts);
	    } else {
		Tcl_Obj *pair[2];

		pair[0] = transPtr;
		pair[1] = Tcl_NewStringObj(name+split+1, -1);
		transPtr = TclJoinPath(2, pair, 1);
		if (transPtr != pair[0]) {
		    Tcl_DecrRefCount(pair[0]);
		    TclDecrRefCount(pair[0]);
		}
		if (transPtr != pair[1]) {
		    Tcl_DecrRefCount(pair[1]);
		    TclDecrRefCount(pair[1]);
		}
	    }
	}
	Tcl_DStringFree(&temp);
    } else {
	transPtr = TclJoinPath(1, &pathPtr, 1);
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));
    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr == pathPtr) {
        transPtr = Tcl_DuplicateObj(pathPtr);
        fsPathPtr->filesystemEpoch = 0;
    if (transPtr != pathPtr) {
	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
	/* Redo translation when $env(HOME) changes */
	fsPathPtr->filesystemEpoch = TclFSEpoch();
    } else {
        fsPathPtr->filesystemEpoch = TclFSEpoch();
	fsPathPtr->filesystemEpoch = 0;
    }
    Tcl_IncrRefCount(transPtr);
    fsPathPtr->translatedPathPtr = transPtr;
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;

    /*
     * 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. */
{
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670

2671
2672
2673

2674
2675
2676
2677
2678
2679
2680
2681



2682




2683
2684

2685
2686
2687
2688
2689
2690
2691
2692
2693







-






-
+




-
+
+








-
+



+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
+








+
+




















-
+


-
+







-
-
-
+
-
-
-
-
+

-
+
+







	if (fsPathPtr->normPathPtr != pathPtr) {
	    TclDecrRefCount(fsPathPtr->normPathPtr);
	}
	fsPathPtr->normPathPtr = NULL;
    }
    if (fsPathPtr->cwdPtr != NULL) {
	TclDecrRefCount(fsPathPtr->cwdPtr);
	fsPathPtr->cwdPtr = NULL;
    }
    if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) {
	Tcl_FSFreeInternalRepProc *freeProc =
		fsPathPtr->fsPtr->freeInternalRepProc;

	if (freeProc != NULL) {
	    freeProc(fsPathPtr->nativePathPtr);
	    (*freeProc)(fsPathPtr->nativePathPtr);
	    fsPathPtr->nativePathPtr = NULL;
	}
    }

    Tcl_Free(fsPathPtr);
    ckfree((char *) fsPathPtr);
    pathPtr->typePtr = NULL;
}

static void
DupFsPathInternalRep(
    Tcl_Obj *srcPtr,		/* Path obj with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
{
    FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
    FsPath *copyFsPathPtr = (FsPath *)Tcl_Alloc(sizeof(FsPath));
    FsPath *copyFsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

    SETPATHOBJ(copyPtr, copyFsPathPtr);

    if (srcFsPathPtr->translatedPathPtr == srcPtr) {
	/* Cycle in src -> make cycle in copy. */
	copyFsPathPtr->translatedPathPtr = copyPtr;
    } else {
    copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
    if (copyFsPathPtr->translatedPathPtr != NULL) {
	Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
    }

    copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
    if (copyFsPathPtr->normPathPtr != NULL) {
	Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
	if (copyFsPathPtr->translatedPathPtr != NULL) {
	    Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
	}
    }

    if (srcFsPathPtr->normPathPtr == srcPtr) {
	/* Cycle in src -> make cycle in copy. */
	copyFsPathPtr->normPathPtr = copyPtr;
    } else {
	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
	if (copyFsPathPtr->normPathPtr != NULL) {
	    Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
	}
    }

    copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
    if (copyFsPathPtr->cwdPtr != NULL) {
	Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
    }

    copyFsPathPtr->flags = srcFsPathPtr->flags;

    if (srcFsPathPtr->fsPtr != NULL
	    && srcFsPathPtr->nativePathPtr != NULL) {
	Tcl_FSDupInternalRepProc *dupProc =
		srcFsPathPtr->fsPtr->dupInternalRepProc;

	if (dupProc != NULL) {
	    copyFsPathPtr->nativePathPtr =
		    dupProc(srcFsPathPtr->nativePathPtr);
		    (*dupProc)(srcFsPathPtr->nativePathPtr);
	} else {
	    copyFsPathPtr->nativePathPtr = NULL;
	}
    } else {
	copyFsPathPtr->nativePathPtr = NULL;
    }
    copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr;
    copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;

    copyPtr->typePtr = &tclFsPathType;
}

/*
 *---------------------------------------------------------------------------
 *
 * UpdateStringOfFsPath --
 *
 *	Gives an object a valid string rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory may be allocated.
 *
 *---------------------------------------------------------------------------
 */

static void
UpdateStringOfFsPath(
    Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
    register Tcl_Obj *pathPtr)	/* path obj with string rep to update. */
{
    FsPath *fsPathPtr = PATHOBJ(pathPtr);
    size_t cwdLen;
    int cwdLen;
    Tcl_Obj *copy;

    if (PATHFLAGS(pathPtr) == 0 || fsPathPtr->cwdPtr == NULL) {
	Tcl_Panic("Called UpdateStringOfFsPath with invalid object");
    }

    copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
    if (Tcl_IsShared(copy)) {
	copy = Tcl_DuplicateObj(copy);
    }


    Tcl_IncrRefCount(copy);
    /* Steal copy's string rep */
    pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
    pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
    pathPtr->length = cwdLen;
    TclInitStringRep(copy, NULL, 0);
    copy->bytes = tclEmptyStringRep;
    copy->length = 0;
    TclDecrRefCount(copy);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativePathInFilesystem --
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
2707
2708
2709
2710
2711
2712
2713

2714
2715
2716
2717
2718
2719
2720
2721
2722

2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737

2738
2739
2740
2741

2742
2743

2744
2745
2746
2747
2748
2749
2750
2751







-
+








-
+














-
+



-
+

-
+







 *
 *---------------------------------------------------------------------------
 */

int
TclNativePathInFilesystem(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(ClientData *))
    ClientData *clientDataPtr)
{
    /*
     * A special case is required to handle the empty path "". This is a valid
     * path (i.e. the user should be able to do 'file exists ""' without
     * throwing an error), but equally the path doesn't exist. Those are the
     * semantics of Tcl (at present anyway), so we have to abide by them here.
     */

    if (TclHasIntRep(pathPtr, &fsPathType)) {
    if (pathPtr->typePtr == &tclFsPathType) {
	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}

	/*
	 * Otherwise there is no way this path can be empty.
	 */
    } else {
	/*
	 * It is somewhat unusual to reach this code path without the object
	 * being of fsPathType. However, we do our best to deal with the
	 * being of tclFsPathType. However, we do our best to deal with the
	 * situation.
	 */

	size_t len;
	int len;

	(void) TclGetStringFromObj(pathPtr, &len);
	(void) Tcl_GetStringFromObj(pathPtr, &len);
	if (len == 0) {
	    /*
	     * We reject the empty path "".
	     */

	    return -1;
	}

Changes to generic/tclPipe.c.

28
29
30
31
32
33
34
35
36


37
38
39
40
41
42
43
28
29
30
31
32
33
34


35
36
37
38
39
40
41
42
43







-
-
+
+







static Detached *detList = NULL;/* List of all detached proceses. */
TCL_DECLARE_MUTEX(pipeMutex)	/* Guard access to detList. */

/*
 * Declarations for local functions defined in this file:
 */

static TclFile		FileForRedirect(Tcl_Interp *interp, const char *spec,
			    int atOk, const char *arg, const char *nextArg,
static TclFile		FileForRedirect(Tcl_Interp *interp, CONST char *spec,
			    int atOk, CONST char *arg, CONST char *nextArg,
			    int flags, int *skipPtr, int *closePtr,
			    int *releasePtr);

/*
 *----------------------------------------------------------------------
 *
 * FileForRedirect --
56
57
58
59
60
61
62
63
64


65
66
67
68
69

70
71

72
73
74
75
76
77
78
56
57
58
59
60
61
62


63
64
65
66
67
68

69
70

71
72
73
74
75
76
77
78







-
-
+
+




-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static TclFile
FileForRedirect(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    const char *spec,		/* Points to character just after redirection
    Tcl_Interp *interp,		/* Intepreter to use for error reporting. */
    CONST char *spec,		/* Points to character just after redirection
				 * character. */
    int atOK,			/* Non-zero means that '@' notation can be
				 * used to specify a channel, zero means that
				 * it isn't. */
    const char *arg,		/* Pointer to entire argument containing spec:
    CONST char *arg,		/* Pointer to entire argument containing spec:
				 * used for error reporting. */
    const char *nextArg,	/* Next argument in argc/argv array, if needed
    CONST char *nextArg,	/* Next argument in argc/argv array, if needed
				 * for file name or channel name. May be
				 * NULL. */
    int flags,			/* Flags to use for opening file or to specify
				 * mode for channel. */
    int *skipPtr,		/* Filled with 1 if redirection target was in
				 * spec, 2 if it was in nextArg. */
    int *closePtr,		/* Filled with one if the caller should close
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
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







-
-
-
-
+
+
+
+

-
-
+
+
-


-
+

-
-
+
+
-
-
+
-
-

-
-
+
+







-
+


-
+
















-
+
-
-
-
+
+


-
+




-
-
+
+
-







	if (*spec == '\0') {
	    spec = nextArg;
	    if (spec == NULL) {
		goto badLastArg;
	    }
	    *skipPtr = 2;
	}
	chan = Tcl_GetChannel(interp, spec, NULL);
	if (chan == (Tcl_Channel) NULL) {
	    return NULL;
	}
        chan = Tcl_GetChannel(interp, spec, NULL);
        if (chan == (Tcl_Channel) NULL) {
            return NULL;
        }
	file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
	if (file == NULL) {
	    Tcl_Obj *msg;
        if (file == NULL) {
	    Tcl_Obj* msg;

	    Tcl_GetChannelError(chan, &msg);
	    if (msg) {
		Tcl_SetObjResult(interp, msg);
		Tcl_SetObjResult (interp, msg);
	    } else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"channel \"%s\" wasn't opened for %s",
		Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
				 "\" wasn't opened for ",
			Tcl_GetChannelName(chan),
			((writing) ? "writing" : "reading")));
				 ((writing) ? "writing" : "reading"), NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
			"BADCHAN", NULL);
	    }
	    return NULL;
	}
            return NULL;
        }
	*releasePtr = 1;
	if (writing) {
	    /*
	     * Be sure to flush output to the file, so that anything written
	     * by the child appears after stuff we've already written.
	     */

	    Tcl_Flush(chan);
            Tcl_Flush(chan);
	}
    } else {
	const char *name;
	CONST char *name;
	Tcl_DString nameString;

	if (*spec == '\0') {
	    spec = nextArg;
	    if (spec == NULL) {
		goto badLastArg;
	    }
	    *skipPtr = 2;
	}
	name = Tcl_TranslateFileName(interp, spec, &nameString);
	if (name == NULL) {
	    return NULL;
	}
	file = TclpOpenFile(name, flags);
	Tcl_DStringFree(&nameString);
	if (file == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    Tcl_AppendResult(interp, "couldn't ",
		    "couldn't %s file \"%s\": %s",
		    (writing ? "write" : "read"), spec,
		    Tcl_PosixError(interp)));
		    ((writing) ? "write" : "read"), " file \"", spec, "\": ",
		    Tcl_PosixError(interp), NULL);
	    return NULL;
	}
	*closePtr = 1;
        *closePtr = 1;
    }
    return file;

  badLastArg:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "can't specify \"%s\" as last word in command", arg));
    Tcl_AppendResult(interp, "can't specify \"", arg,
	    "\" as last word in command", NULL);
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "SYNTAX", NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DetachPids --
179
180
181
182
183
184
185
186

187
188
189
190
191

192
193
194
195
196
197
198
173
174
175
176
177
178
179

180
181
182
183
184

185
186
187
188
189
190
191
192







-
+




-
+








void
Tcl_DetachPids(
    int numPids,		/* Number of pids to detach: gives size of
				 * array pointed to by pidPtr. */
    Tcl_Pid *pidPtr)		/* Array of pids to detach. */
{
    Detached *detPtr;
    register Detached *detPtr;
    int i;

    Tcl_MutexLock(&pipeMutex);
    for (i = 0; i < numPids; i++) {
	detPtr = (Detached *)Tcl_Alloc(sizeof(Detached));
	detPtr = (Detached *) ckalloc(sizeof(Detached));
	detPtr->pid = pidPtr[i];
	detPtr->nextPtr = detList;
	detList = detPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);

}
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
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







-
+

-
+
+



-
+
-
-
+










-
+







 *
 *----------------------------------------------------------------------
 */

void
Tcl_ReapDetachedProcs(void)
{
    Detached *detPtr;
    register Detached *detPtr;
    Detached *nextPtr, *prevPtr;
    int status, code;
    int status;
    Tcl_Pid pid;

    Tcl_MutexLock(&pipeMutex);
    for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
	status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL);
	pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
	if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR
		&& code != ECHILD)) {
	if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
	    prevPtr = detPtr;
	    detPtr = detPtr->nextPtr;
	    continue;
	}
	nextPtr = detPtr->nextPtr;
	if (prevPtr == NULL) {
	    detList = detPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = detPtr->nextPtr;
	}
	Tcl_Free(detPtr);
	ckfree((char *) detPtr);
	detPtr = nextPtr;
    }
    Tcl_MutexUnlock(&pipeMutex);
}

/*
 *----------------------------------------------------------------------
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
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







+
-
+
-
-
+
+



+
+
+
+
+
-
-
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+










+
+
-
+

+
-
-
-
-
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+














-
+



-
-
+
+

-
+



-
-
-
+
+








-
+








-
-
+







    Tcl_Pid *pidPtr,		/* Array of process ids of children. */
    Tcl_Channel errorChan)	/* Channel for file containing stderr output
				 * from pipeline. NULL means there isn't any
				 * stderr output. */
{
    int result = TCL_OK;
    int i, abnormalExit, anyErrorInfo;
    Tcl_Pid pid;
    TclProcessWaitStatus waitStatus;
    WAIT_STATUS_TYPE waitStatus;
    int code;
    Tcl_Obj *msg, *error;
    CONST char *msg;
    unsigned long resolvedPid;

    abnormalExit = 0;
    for (i = 0; i < numPids; i++) {
	/*
	 * We need to get the resolved pid before we wait on it as the windows
	 * implementation of Tcl_WaitPid deletes the information such that any
	 * following calls to TclpGetPid fail.
	 */
	waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
	if (waitStatus == TCL_PROCESS_ERROR) {

	resolvedPid = TclpGetPid(pidPtr[i]);
        pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
	if (pid == (Tcl_Pid) -1) {
	    result = TCL_ERROR;
	    if (interp != NULL) {
		Tcl_SetObjErrorCode(interp, error);
		Tcl_SetObjResult(interp, msg);
	    }
            if (interp != NULL) {
                msg = Tcl_PosixError(interp);
                if (errno == ECHILD) {
		    /*
                     * This changeup in message suggested by Mark Diekhans to
                     * remind people that ECHILD errors can occur on some
                     * systems if SIGCHLD isn't in its default state.
                     */

                    msg =
                        "child process lost (is SIGCHLD ignored or trapped?)";
                }
	    Tcl_DecrRefCount(error);
	    Tcl_DecrRefCount(msg);
                Tcl_AppendResult(interp, "error waiting for process to exit: ",
                        msg, NULL);
            }
	    continue;
	}

	/*
	 * Create error messages for unusual process exits. An extra newline
	 * gets appended to each error message, but it gets removed below (in
	 * the same fashion that an extra newline in the command's output is
	 * removed).
	 */

	if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
	    char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
	if (waitStatus != TCL_PROCESS_EXITED || code != 0) {

	    result = TCL_ERROR;
	    sprintf(msg1, "%lu", resolvedPid);
	    if (waitStatus == TCL_PROCESS_EXITED) {
		if (interp != NULL) {
		    Tcl_SetObjErrorCode(interp, error);
		}
	    if (WIFEXITED(waitStatus)) {
                if (interp != (Tcl_Interp *) NULL) {
		    sprintf(msg2, "%lu",
			    (unsigned long) WEXITSTATUS(waitStatus));
                    Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
                }
		abnormalExit = 1;
	    } else if (interp != NULL) {
		CONST char *p;

		if (WIFSIGNALED(waitStatus)) {
                    p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
                    Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
                            Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
                            NULL);
                    Tcl_AppendResult(interp, "child killed: ", p, "\n", NULL);
		} else if (WIFSTOPPED(waitStatus)) {
                    p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
		Tcl_SetObjErrorCode(interp, error);
		Tcl_SetObjResult(interp, msg);
	    }
                    Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
                            Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p,
			    NULL);
                    Tcl_AppendResult(interp, "child suspended: ", p, "\n",
                            NULL);
		} else {
                    Tcl_AppendResult(interp,
                            "child wait status didn't make sense\n", NULL);
                }
	    Tcl_DecrRefCount(error);
	    Tcl_DecrRefCount(msg);
	    }
	}
    }

    /*
     * Read the standard error file. If there's anything there, then return an
     * error and add the file's contents to the result string.
     */

    anyErrorInfo = 0;
    if (errorChan != NULL) {
	/*
	 * Make sure we start at the beginning of the file.
	 */

	if (interp != NULL) {
        if (interp != NULL) {
	    int count;
	    Tcl_Obj *objPtr;

	    Tcl_Seek(errorChan, 0, SEEK_SET);
	    TclNewObj(objPtr);
	    Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET);
	    objPtr = Tcl_NewObj();
	    count = Tcl_ReadChars(errorChan, objPtr, -1, 0);
	    if (count == -1) {
	    if (count < 0) {
		result = TCL_ERROR;
		Tcl_DecrRefCount(objPtr);
		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading stderr output file: %s",
			Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "error reading stderr output file: ",
			Tcl_PosixError(interp), NULL);
	    } else if (count > 0) {
		anyErrorInfo = 1;
		Tcl_SetObjResult(interp, objPtr);
		result = TCL_ERROR;
	    } else {
		Tcl_DecrRefCount(objPtr);
	    }
	}
	Tcl_CloseEx(NULL, errorChan, 0);
	Tcl_Close(NULL, errorChan);
    }

    /*
     * If a child exited abnormally but didn't output any error information at
     * all, generate an error message here.
     */

    if ((abnormalExit != 0) && (anyErrorInfo == 0) && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"child process exited abnormally", -1));
	Tcl_AppendResult(interp, "child process exited abnormally", NULL);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
395
396
397
398
399
400
401
402

403
404
405
406
407
408
409
424
425
426
427
428
429
430

431
432
433
434
435
436
437
438







-
+







 *----------------------------------------------------------------------
 */

int
TclCreatePipeline(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    int argc,			/* Number of entries in argv. */
    const char **argv,		/* Array of strings describing commands in
    CONST char **argv,		/* Array of strings describing commands in
				 * pipeline plus I/O redirection with <, <<,
				 * >, etc. Argv[argc] must be NULL. */
    Tcl_Pid **pidArrayPtr,	/* Word at *pidArrayPtr gets filled in with
				 * address of array of pids for processes in
				 * pipeline (first pid is first process in
				 * pipeline). */
    TclFile *inPipePtr,		/* If non-NULL, input to the pipeline comes
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
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







-
+








-
+





-
+





-
+

-
-
+
+







{
    Tcl_Pid *pidPtr = NULL;	/* Points to malloc-ed array holding all the
				 * pids of child processes. */
    int numPids;		/* Actual number of processes that exist at
				 * *pidPtr right now. */
    int cmdCount;		/* Count of number of distinct commands found
				 * in argc/argv. */
    const char *inputLiteral = NULL;
    CONST char *inputLiteral = NULL;
				/* If non-null, then this points to a string
				 * containing input data (specified via <<) to
				 * be piped to the first process in the
				 * pipeline. */
    TclFile inputFile = NULL;	/* If != NULL, gives file to use as input for
				 * first process in pipeline (specified via <
				 * or <@). */
    int inputClose = 0;		/* If non-zero, then inputFile should be
				 * closed when cleaning up. */
    				 * closed when cleaning up. */
    int inputRelease = 0;
    TclFile outputFile = NULL;	/* Writable file for output from last command
				 * in pipeline (could be file or pipe). NULL
				 * means use stdout. */
    int outputClose = 0;	/* If non-zero, then outputFile should be
				 * closed when cleaning up. */
    				 * closed when cleaning up. */
    int outputRelease = 0;
    TclFile errorFile = NULL;	/* Writable file for error output from all
				 * commands in pipeline. NULL means use
				 * stderr. */
    int errorClose = 0;		/* If non-zero, then errorFile should be
				 * closed when cleaning up. */
    				 * closed when cleaning up. */
    int errorRelease = 0;
    const char *p;
    const char *nextArg;
    CONST char *p;
    CONST char *nextArg;
    int skip, lastBar, lastArg, i, j, atOK, flags, needCmd, errorToOutput = 0;
    Tcl_DString execBuffer;
    TclFile pipeIn;
    TclFile curInFile, curOutFile, curErrFile;
    Tcl_Channel channel;

    if (inPipePtr != NULL) {
506
507
508
509
510
511
512
513
514

515
516

517
518
519
520
521
522
523
535
536
537
538
539
540
541


542


543
544
545
546
547
548
549
550







-
-
+
-
-
+







	switch (*p++) {
	case '|':
	    if (*p == '&') {
		p++;
	    }
	    if (*p == '\0') {
		if ((i == (lastBar + 1)) || (i == (argc - 1))) {
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
			    "illegal use of | or |& in command", -1));
		    Tcl_SetResult(interp, "illegal use of | or |& in command",
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
			    "PIPESYNTAX", NULL);
			    TCL_STATIC);
		    goto error;
		}
	    }
	    lastBar = i;
	    cmdCount++;
	    needCmd = 1;
	    break;
534
535
536
537
538
539
540
541
542


543
544
545
546
547
548
549
550
551
552
561
562
563
564
565
566
567


568
569



570
571
572
573
574
575
576







-
-
+
+
-
-
-







	    if (*p == '<') {
		inputFile = NULL;
		inputLiteral = p + 1;
		skip = 1;
		if (*inputLiteral == '\0') {
		    inputLiteral = ((i + 1) == argc) ? NULL : argv[i + 1];
		    if (inputLiteral == NULL) {
			Tcl_SetObjResult(interp, Tcl_ObjPrintf(
				"can't specify \"%s\" as last word in command",
			Tcl_AppendResult(interp, "can't specify \"", argv[i],
				"\" as last word in command", NULL);
				argv[i]));
			Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
				"PIPESYNTAX", NULL);
			goto error;
		    }
		    skip = 2;
		}
	    } else {
		nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
		inputLiteral = NULL;
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
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
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
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







-
-
-
-
-
-
-
+

















-
-
+
+
-
-
-
















-
-
+
-
-
-
-
+
+












-
-
+
-

-
-
+
+
-
-
+













-
-
-
+
+
+










-
-
-
+
+
+







	    }
	    p++;
	    atOK = 1;
	    flags = O_WRONLY | O_CREAT | O_TRUNC;
	    if (*p == '>') {
		p++;
		atOK = 0;

		/*
		 * Note that the O_APPEND flag only has an effect on POSIX
		 * platforms. On Windows, we just have to carry on regardless.
		 */

		flags = O_WRONLY | O_CREAT | O_APPEND;
		flags = O_WRONLY | O_CREAT;
	    }
	    if (errorClose != 0) {
		errorClose = 0;
		TclpCloseFile(errorFile);
	    }
	    if (errorRelease != 0) {
		errorRelease = 0;
		TclpReleaseFile(errorFile);
	    }
	    if (atOK && p[0] == '@' && p[1] == '1' && p[2] == '\0') {
		/*
		 * Special case handling of 2>@1 to redirect stderr to the
		 * exec/open output pipe as well. This is meant for the end of
		 * the command string, otherwise use |& between commands.
		 */

		if (i != argc-1) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "must specify \"%s\" as last word in command",
		    Tcl_AppendResult(interp, "must specify \"", argv[i],
			    "\" as last word in command", NULL);
			    argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
			    "PIPESYNTAX", NULL);
		    goto error;
		}
		errorFile = outputFile;
		errorToOutput = 2;
		skip = 1;
	    } else {
		nextArg = ((i + 1) == argc) ? NULL : argv[i + 1];
		errorFile = FileForRedirect(interp, p, atOK, argv[i],
			nextArg, flags, &skip, &errorClose, &errorRelease);
		if (errorFile == NULL) {
		    goto error;
		}
	    }
	    break;

	default:
	    /*
	     * Got a command word, not a redirection.
	  /* Got a command word, not a redirection */
	     */

	    needCmd = 0;
	    break;
	  needCmd = 0;
	  break;
	}

	if (skip != 0) {
	    for (j = i + skip; j < argc; j++) {
		argv[j - skip] = argv[j];
	    }
	    argc -= skip;
	    i -= 1;
	}
    }

    if (needCmd) {
	/*
	 * We had a bar followed only by redirections.
	/* We had a bar followed only by redirections. */
	 */

	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"illegal use of | or |& in command", -1));
        Tcl_SetResult(interp,
		      "illegal use of | or |& in command",
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "PIPESYNTAX",
		NULL);
		      TCL_STATIC);
	goto error;
    }

    if (inputFile == NULL) {
	if (inputLiteral != NULL) {
	    /*
	     * The input for the first process is immediate data coming from
	     * Tcl. Create a temporary file for it and put the data into the
	     * file.
	     */

	    inputFile = TclpCreateTempFile(inputLiteral);
	    if (inputFile == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't create input file for command: %s",
			Tcl_PosixError(interp)));
		Tcl_AppendResult(interp,
			"couldn't create input file for command: ",
			Tcl_PosixError(interp), NULL);
		goto error;
	    }
	    inputClose = 1;
	} else if (inPipePtr != NULL) {
	    /*
	     * The input for the first process in the pipeline is to come from
	     * a pipe that can be written from by the caller.
	     */

	    if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't create input pipe for command: %s",
			Tcl_PosixError(interp)));
		Tcl_AppendResult(interp,
			"couldn't create input pipe for command: ",
			Tcl_PosixError(interp), NULL);
		goto error;
	    }
	    inputClose = 1;
	} else {
	    /*
	     * The input for the first process comes from stdin.
	     */
753
754
755
756
757
758
759
760
761
762



763
764
765
766
767
768
769
762
763
764
765
766
767
768



769
770
771
772
773
774
775
776
777
778







-
-
-
+
+
+







	if (outPipePtr != NULL) {
	    /*
	     * Output from the last process in the pipeline is to go to a pipe
	     * that can be read by the caller.
	     */

	    if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't create output pipe for command: %s",
			Tcl_PosixError(interp)));
		Tcl_AppendResult(interp,
			"couldn't create output pipe for command: ",
			Tcl_PosixError(interp), NULL);
		goto error;
	    }
	    outputClose = 1;
	} else {
	    /*
	     * The output for the last process goes to stdout.
	     */
793
794
795
796
797
798
799
800
801
802



803
804
805
806
807
808
809
802
803
804
805
806
807
808



809
810
811
812
813
814
815
816
817
818







-
-
-
+
+
+







	     * cause the pipeline to deadlock: we'd be waiting for processes
	     * to complete before reading stderr, and processes couldn't
	     * complete because stderr was backed up.
	     */

	    errorFile = TclpCreateTempFile(NULL);
	    if (errorFile == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't create error file for command: %s",
			Tcl_PosixError(interp)));
		Tcl_AppendResult(interp,
			"couldn't create error file for command: ",
			Tcl_PosixError(interp), NULL);
		goto error;
	    }
	    *errFilePtr = errorFile;
	} else {
	    /*
	     * Errors from the pipeline go to stderr.
	     */
820
821
822
823
824
825
826
827

828
829
830
831
832
833
834

835
836
837
838
839
840
841
829
830
831
832
833
834
835

836
837
838
839
840
841
842

843
844
845
846
847
848
849
850







-
+






-
+








    /*
     * Scan through the argc array, creating a process for each group of
     * arguments between the "|" characters.
     */

    Tcl_ReapDetachedProcs();
    pidPtr = (Tcl_Pid *)Tcl_Alloc(cmdCount * sizeof(Tcl_Pid));
    pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));

    curInFile = inputFile;

    for (i = 0; i < argc; i = lastArg + 1) {
	int result, joinThisError;
	Tcl_Pid pid;
	const char *oldName;
	CONST char *oldName;

	/*
	 * Convert the program name into native form.
	 */

	if (Tcl_TranslateFileName(interp, argv[i], &execBuffer) == NULL) {
	    goto error;
866
867
868
869
870
871
872
873
874


875
876
877
878
879
880
881
875
876
877
878
879
880
881


882
883
884
885
886
887
888
889
890







-
-
+
+







	 */

	if (lastArg == argc) {
	    curOutFile = outputFile;
	} else {
	    argv[lastArg] = NULL;
	    if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't create pipe: %s", Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "couldn't create pipe: ",
			Tcl_PosixError(interp), NULL);
		goto error;
	    }
	}

	if (joinThisError != 0) {
	    curErrFile = curOutFile;
	} else {
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
904
905
906
907
908
909
910

911
912
913
914
915
916
917







-







	if (result != TCL_OK) {
	    goto error;
	}
	Tcl_DStringFree(&execBuffer);

	pidPtr[numPids] = pid;
	numPids++;
	TclProcessCreated(pid);

	/*
	 * Close off our copies of file descriptors that were set up for this
	 * child, then set up the input for the next child.
	 */

	if ((curInFile != NULL) && (curInFile != inputFile)) {
974
975
976
977
978
979
980
981

982
983
984
985
986
987
988
982
983
984
985
986
987
988

989
990
991
992
993
994
995
996







-
+







    }
    if (pidPtr != NULL) {
	for (i = 0; i < numPids; i++) {
	    if (pidPtr[i] != (Tcl_Pid) -1) {
		Tcl_DetachPids(1, &pidPtr[i]);
	    }
	}
	Tcl_Free(pidPtr);
	ckfree((char *) pidPtr);
    }
    numPids = -1;
    goto cleanup;
}

/*
 *----------------------------------------------------------------------
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
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







-
+

-
+
















-
+












-
-
-
+
+
-
-



-
-
-
+
+
-
-







-
+
-
-
-
+
+







-
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenCommandChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting. Can NOT be
				 * NULL. */
                                 * NULL. */
    int argc,			/* How many arguments. */
    const char **argv,		/* Array of arguments for command pipe. */
    CONST char **argv,		/* Array of arguments for command pipe. */
    int flags)			/* Or'ed combination of TCL_STDIN, TCL_STDOUT,
				 * TCL_STDERR, and TCL_ENFORCE_MODE. */
{
    TclFile *inPipePtr, *outPipePtr, *errFilePtr;
    TclFile inPipe, outPipe, errFile;
    int numPids;
    Tcl_Pid *pidPtr;
    Tcl_Channel channel;

    inPipe = outPipe = errFile = NULL;

    inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
    outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
    errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;

    numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
	    outPipePtr, errFilePtr);
            outPipePtr, errFilePtr);

    if (numPids < 0) {
	goto error;
    }

    /*
     * Verify that the pipes that were created satisfy the readable/writable
     * constraints.
     */

    if (flags & TCL_ENFORCE_MODE) {
	if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't read output from command:"
		    " standard output was redirected", -1));
	    Tcl_AppendResult(interp, "can't read output from command:"
		    " standard output was redirected", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
		    "BADREDIRECT", NULL);
	    goto error;
	}
	if ((flags & TCL_STDIN) && (inPipe == NULL)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't write input to command:"
		    " standard input was redirected", -1));
	    Tcl_AppendResult(interp, "can't write input to command:"
		    " standard input was redirected", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
		    "BADREDIRECT", NULL);
	    goto error;
	}
    }

    channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
	    numPids, pidPtr);

    if (channel == NULL) {
    if (channel == (Tcl_Channel) NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"pipe for command could not be created", -1));
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "NOPIPE", NULL);
        Tcl_AppendResult(interp, "pipe for command could not be created",
                NULL);
	goto error;
    }
    return channel;

  error:
    if (numPids > 0) {
	Tcl_DetachPids(numPids, pidPtr);
	Tcl_Free(pidPtr);
	ckfree((char *) pidPtr);
    }
    if (inPipe != NULL) {
	TclpCloseFile(inPipe);
    }
    if (outPipe != NULL) {
	TclpCloseFile(outPipe);
    }

Changes to generic/tclPkg.c.

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
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







-
-
-
-











-




-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
+
+
+
+
+


-
+


-
-
-
-
-
-
-
-
-
-
-
-




















-
+
-
-
-
-
-
-
+
+
-
-






-
+


-
+







 * TIP #268.
 * Heavily rewritten to handle the extend version numbers, and extended
 * package requirements.
 */

#include "tclInt.h"

MODULE_SCOPE char *tclEmptyStringRep;

char *tclEmptyStringRep = &tclEmptyString;

/*
 * Each invocation of the "package ifneeded" command creates a structure of
 * the following type, which is used to load the package into the interpreter
 * if it is requested with a "package require" command.
 */

typedef struct PkgAvail {
    char *version;		/* Version string; malloc'ed. */
    char *script;		/* Script to invoke to provide this version of
				 * the package. Malloc'ed and protected by
				 * Tcl_Preserve and Tcl_Release. */
    char *pkgIndex;		/* Full file name of pkgIndex file */
    struct PkgAvail *nextPtr;	/* Next in list of available versions of the
				 * same package. */
} PkgAvail;

typedef struct PkgName {
    struct PkgName *nextPtr;	/* Next in list of package names being
				 * initialized. */
    char name[1];
} PkgName;

typedef struct PkgFiles {
    PkgName *names;		/* Package names being initialized. Must be
				 * first field. */
    Tcl_HashTable table;	/* Table which contains files for each
				 * package. */
} PkgFiles;

/*
 * For each package that is known in any way to an interpreter, there is one
 * record of the following type. These records are stored in the
 * "packageTable" hash table in the interpreter, keyed by package name such as
 * "Tk" (no version number).
 */

typedef struct {
    Tcl_Obj *version;
typedef struct Package {
    char *version;		/* Version that has been supplied in this
				 * interpreter via "package provide"
				 * (malloc'ed). NULL means the package doesn't
				 * exist in this interpreter yet. */
    PkgAvail *availPtr;		/* First in list of all available versions of
				 * this package. */
    const void *clientData;	/* Client data. */
    ClientData clientData;	/* Client data. */
} Package;

typedef struct Require {
    void *clientDataPtr;
    const char *name;
    Package *pkgPtr;
    char *versionToProvide;
} Require;

typedef struct RequireProcArgs {
    const char *name;
    void *clientDataPtr;
} RequireProcArgs;

/*
 * Prototypes for functions defined in this file:
 */

static int		CheckVersionAndConvert(Tcl_Interp *interp,
			    const char *string, char **internal, int *stable);
static int		CompareVersions(char *v1i, char *v2i,
			    int *isMajorPtr);
static int		CheckRequirement(Tcl_Interp *interp,
			    const char *string);
static int		CheckAllRequirements(Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static int		RequirementSatisfied(char *havei, const char *req);
static int		SomeRequirementSatisfied(char *havei, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToResult(Tcl_Interp *interp, int reqc,
			    Tcl_Obj *const reqv[]);
static void		AddRequirementsToDString(Tcl_DString *dstring,
			    int reqc, Tcl_Obj *const reqv[]);
static Package *	FindPackage(Tcl_Interp *interp, const char *name);
static int		PkgRequireCore(ClientData data[], Tcl_Interp *interp, int result);
static const char *	PkgRequireCore(Tcl_Interp *interp, const char *name,
static int		PkgRequireCoreFinal(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result);
static int		PkgRequireCoreStep2(ClientData data[], Tcl_Interp *interp, int result);
static int		TclNRPkgRequireProc(ClientData clientData, Tcl_Interp *interp, int reqc, Tcl_Obj *const reqv[]);
static int		SelectPackage(ClientData data[], Tcl_Interp *interp, int result);
			    int reqc, Tcl_Obj *const reqv[],
			    ClientData *clientDataPtr);
static int		SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result);
static int		TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int result);

/*
 * Helper macros.
 */

#define DupBlock(v,s,len) \
    ((v) = (char *)Tcl_Alloc(len), memcpy((v),(s),(len)))
    ((v) = ckalloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
    do { \
	size_t local__len = strlen(s) + 1; \
	unsigned local__len = (unsigned) (strlen(s) + 1); \
	DupBlock((v),(s),local__len); \
    } while (0)

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgProvide / Tcl_PkgProvideEx --
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
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







-
+








-
-
+




-
+



-
+




-
-
+
+







-
-
-
+
+
-








int
Tcl_PkgProvideEx(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of package. */
    const char *version,	/* Version string for package. */
    const void *clientData)	/* clientdata for this package (normally used
    ClientData clientData)	/* clientdata for this package (normally used
				 * for C callback function table) */
{
    Package *pkgPtr;
    char *pvi, *vi;
    int res;

    pkgPtr = FindPackage(interp, name);
    if (pkgPtr->version == NULL) {
	pkgPtr->version = Tcl_NewStringObj(version, -1);
	Tcl_IncrRefCount(pkgPtr->version);
	DupString(pkgPtr->version, version);
	pkgPtr->clientData = clientData;
	return TCL_OK;
    }

    if (CheckVersionAndConvert(interp, Tcl_GetString(pkgPtr->version), &pvi,
    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
	    NULL) != TCL_OK) {
	return TCL_ERROR;
    } else if (CheckVersionAndConvert(interp, version, &vi, NULL) != TCL_OK) {
	Tcl_Free(pvi);
	ckfree(pvi);
	return TCL_ERROR;
    }

    res = CompareVersions(pvi, vi, NULL);
    Tcl_Free(pvi);
    Tcl_Free(vi);
    ckfree(pvi);
    ckfree(vi);

    if (res == 0) {
	if (clientData != NULL) {
	    pkgPtr->clientData = clientData;
	}
	return TCL_OK;
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "conflicting versions provided for package \"%s\": %s, then %s",
	    name, Tcl_GetString(pkgPtr->version), version));
    Tcl_AppendResult(interp, "conflicting versions provided for package \"",
	    name, "\": ", pkgPtr->version, ", then ", version, NULL);
    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgRequire / Tcl_PkgRequireEx / Tcl_PkgRequireProc --
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
183
184
185
186
187
188
189








































































190
191
192
193
194
195
196







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Side effects:
 *	The script from some previous "package ifneeded" command may be
 *	invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */

static void
PkgFilesCleanupProc(
    ClientData clientData,
    TCL_UNUSED(Tcl_Interp *))
{
    PkgFiles *pkgFiles = (PkgFiles *) clientData;
    Tcl_HashSearch search;
    Tcl_HashEntry *entry;

    while (pkgFiles->names) {
	PkgName *name = pkgFiles->names;

	pkgFiles->names = name->nextPtr;
	Tcl_Free(name);
    }
    entry = Tcl_FirstHashEntry(&pkgFiles->table, &search);
    while (entry) {
	Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry);

	Tcl_DecrRefCount(obj);
	entry = Tcl_NextHashEntry(&search);
    }
    Tcl_DeleteHashTable(&pkgFiles->table);
    Tcl_Free(pkgFiles);
    return;
}

void *
TclInitPkgFiles(
    Tcl_Interp *interp)
{
    /*
     * If assocdata "tclPkgFiles" doesn't exist yet, create it.
     */

    PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

    if (!pkgFiles) {
	pkgFiles = (PkgFiles *)Tcl_Alloc(sizeof(PkgFiles));
	pkgFiles->names = NULL;
	Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
	Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
    }
    return pkgFiles;
}

void
TclPkgFileSeen(
    Tcl_Interp *interp,
    const char *fileName)
{
    PkgFiles *pkgFiles = (PkgFiles *)
	    Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

    if (pkgFiles && pkgFiles->names) {
	const char *name = pkgFiles->names->name;
	Tcl_HashTable *table = &pkgFiles->table;
	int isNew;
	Tcl_HashEntry *entry = (Tcl_HashEntry *)Tcl_CreateHashEntry(table, name, &isNew);
	Tcl_Obj *list;

	if (isNew) {
	    TclNewObj(list);
	    Tcl_SetHashValue(entry, list);
	    Tcl_IncrRefCount(list);
	} else {
	    list = (Tcl_Obj *)Tcl_GetHashValue(entry);
	}
	Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, -1));
    }
}

#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
    const char *version,	/* Version string for desired version; NULL
316
317
318
319
320
321
322
323

324
325
326
327
328
329
330
208
209
210
211
212
213
214

215
216
217
218
219
220
221
222







-
+







				 * available. */
    const char *name,		/* Name of desired package. */
    const char *version,	/* Version string for desired version; NULL
				 * means use the latest version available. */
    int exact,			/* Non-zero means that only the particular
				 * version given is acceptable. Zero means use
				 * the latest compatible version. */
    void *clientDataPtr)	/* Used to return the client data for this
    ClientData *clientDataPtr)	/* Used to return the client data for this
				 * package. If it is NULL then the client data
				 * is not returned. This is unchanged if this
				 * call fails for any reason. */
{
    Tcl_Obj *ov;
    const char *result = NULL;

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

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

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
611
612

613
614

615
616
617

618
619
620
621
622
623


624
625

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
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

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
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
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
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
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
611




612
613

614


615



616



617
618





619
620
621
622
623
624
625
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







-
-
-
-
-
-
+
+
+
+
+
+











-
-
-
+
+
+
+
+
+
+
+
+


+
-
-
-
+
+
+
-








-
+
-
-
-










-
+
-
-
-
+
+
-
-
+












-
+

-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
+
+
-
-
+
-
-
-
-
+
-
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
+
-
-
+

-
-
-
-
-
-
+
+



-
-
-
+
-
-
-
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
-
-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-

-
-
-
+
-
-
-
+
+
+
-
-
+

-
-
-
-
+
+
+
-
-
-
-
+
-
-
+
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
+
-
-
+
-
-
+
-
-
-
+
-
-
+
-
-
-

+
+
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+

-
-
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-

-
-
-
-
+
+
+
+
-
-
+
+
-
-
+
+
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
-
-
-
+
+
-
-
+
-
-
-
+
+
-
-
-
-
+

-
+
-
-
+
-
-
-
+
-
-
-

+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
-
-

-
-
+
+
+
-
-
+
-
-
-
-

-
-
-
-
-
-
+
-
-
-
-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+

-
-
+


-
-
-
+
+
+
+







	 * those unresolved references may cause the loading of the package to
	 * also load a second copy of the Tcl library, leading to all kinds of
	 * trouble. We would like to catch that error and report a useful
	 * message back to the user. That's what we're doing.
	 *
	 * Second, how does this work? If we reach this point, then the global
	 * variable tclEmptyStringRep has the value NULL. Compare that with
	 * the definition of tclEmptyStringRep near the top of this file.  It
	 * clearly should not have the value NULL; it should point to the char
	 * tclEmptyString. If we see it having the value NULL, then somehow we
	 * are seeing a Tcl library that isn't completely initialized, and
	 * that's an indicator for the error condition described above.
	 * (Further explanation is welcome.)
	 * the definition of tclEmptyStringRep near the top of the file
	 * generic/tclObj.c. It clearly should not have the value NULL; it
	 * should point to the char tclEmptyString. If we see it having the
	 * value NULL, then somehow we are seeing a Tcl library that isn't
	 * completely initialized, and that's an indicator for the error
	 * condition described above. (Further explanation is welcome.)
	 *
	 * Third, so what do we do about it? This situation indicates the
	 * package we just loaded wasn't properly compiled to be stub-enabled,
	 * yet it thinks it is stub-enabled (it called Tcl_InitStubs()). We
	 * want to report that the package just loaded is broken, so we want
	 * to place an error message in the interpreter result and return NULL
	 * to indicate failure to Tcl_InitStubs() so that it will also fail.
	 * (Further explanation why we don't want to Tcl_Panic() is welcome.
	 * After all, two Tcl libraries can't be a good thing!)
	 *
	 * Trouble is that's going to be tricky. We're now using a Tcl library
	 * that's not fully initialized. Functions in it may not work
	 * reliably, so be very careful about adding any other calls here
	 * without checking how they behave when initialization is incomplete.
	 * that's not fully initialized. In particular, it doesn't have a
	 * proper value for tclEmptyStringRep. The Tcl_Obj system heavily
	 * depends on the value of tclEmptyStringRep and all of Tcl depends
	 * (increasingly) on the Tcl_Obj system, we need to correct that flaw
	 * before making the calls to set the interpreter result to the error
	 * message. That's the only flaw corrected; other problems with
	 * initialization of the Tcl library are not remedied, so be very
	 * careful about adding any other calls here without checking how they
	 * behave when initialization is incomplete.
	 */

	tclEmptyStringRep = &tclEmptyString;
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"Cannot load package \"%s\" in standalone executable:"
		" This package is not compiled with stub support", name));
	Tcl_AppendResult(interp, "Cannot load package \"", name,
		"\" in standalone executable: This package is not "
		"compiled with stub support", NULL);
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNSTUBBED", NULL);
	return NULL;
    }

    /*
     * Translate between old and new API, and defer to the new function.
     */

    if (version == NULL) {
	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
	result = PkgRequireCore(interp, name, 0, NULL, clientDataPtr);
	    result = Tcl_GetString(Tcl_GetObjResult(interp));
	    Tcl_ResetResult(interp);
	}
    } else {
	if (exact && TCL_OK
		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
	    return NULL;
	}
	ov = Tcl_NewStringObj(version, -1);
	if (exact) {
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	}
	Tcl_IncrRefCount(ov);
	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
	result = PkgRequireCore(interp, name, 1, &ov, clientDataPtr);
	    result = Tcl_GetString(Tcl_GetObjResult(interp));
	    Tcl_ResetResult(interp);
	}
	TclDecrRefCount(ov);
    }
	TclDecrRefCount(ov);
    }

    return result;
}

int
Tcl_PkgRequireProc(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
    int reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
				 * available. */
    void *clientDataPtr)
    ClientData *clientDataPtr)
{
    RequireProcArgs args;

    const char *result =
    args.name = name;
    args.clientDataPtr = clientDataPtr;
    return Tcl_NRCallObjProc(interp,
	    TclNRPkgRequireProc, (void *) &args, reqc, reqv);
}

	    PkgRequireCore(interp, name, reqc, reqv, clientDataPtr);
static int
TclNRPkgRequireProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int reqc,
    Tcl_Obj *const reqv[])
{

    RequireProcArgs *args = (RequireProcArgs *)clientData;

    if (result == NULL) {
    Tcl_NRAddCallback(interp,
	    PkgRequireCore, (void *) args->name, INT2PTR(reqc), (void *) reqv,
	    args->clientDataPtr);
    return TCL_OK;
}

	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
static int
PkgRequireCore(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    const char *name = (const char *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **reqv = (Tcl_Obj **)data[2];
    int code = CheckAllRequirements(interp, reqc, reqv);
    Require *reqPtr;

    if (code != TCL_OK) {
	return code;
    }
    reqPtr = (Require *)Tcl_Alloc(sizeof(Require));
    Tcl_NRAddCallback(interp, PkgRequireCoreCleanup, reqPtr, NULL, NULL, NULL);
    reqPtr->clientDataPtr = data[3];
    reqPtr->name = name;
    reqPtr->pkgPtr = FindPackage(interp, name);
    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_NRAddCallback(interp,
		SelectPackage, reqPtr, INT2PTR(reqc), reqv,
		(void *)PkgRequireCoreStep1);
    } else {
	Tcl_NRAddCallback(interp,
		PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), reqv, NULL);
    }
    return TCL_OK;
}

static int
PkgRequireCoreStep1(
static const char *
PkgRequireCore(
    ClientData data[],
    Tcl_Interp *interp,
    Tcl_Interp *interp,		/* Interpreter in which package is now
    TCL_UNUSED(int))
{
    Tcl_DString command;
    char *script;
				 * available. */
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name /* Name of desired package. */;

    const char *name,		/* Name of desired package. */
    int reqc,			/* Requirements constraining the desired
    /*
     * If we've got the package in the DB already, go on to actually loading
     * it.
     */

				 * version. */
    if (reqPtr->pkgPtr->version != NULL) {
	Tcl_NRAddCallback(interp,
		PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
	return TCL_OK;
    }

    Tcl_Obj *const reqv[],	/* 0 means to use the latest version
    /*
     * The package is not in the database. If there is a "package unknown"
     * command, invoke it.
     */

				 * available. */
    script = ((Interp *) interp)->packageUnknown;
    if (script == NULL) {
	/*
	 * No package unknown script. Move on to finalizing.
	 */

    ClientData *clientDataPtr)
	Tcl_NRAddCallback(interp,
		PkgRequireCoreFinal, reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
	return TCL_OK;
    }

    /*
     * Invoke the "package unknown" script synchronously.
     */

    Tcl_DStringInit(&command);
    Tcl_DStringAppend(&command, script, -1);
    Tcl_DStringAppendElement(&command, name);
    AddRequirementsToDString(&command, reqc, reqv);

    Tcl_NRAddCallback(interp,
	    PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *) reqv, NULL);
    Tcl_NREvalObj(interp,
	    Tcl_NewStringObj(Tcl_DStringValue(&command),
		    Tcl_DStringLength(&command)),
	    TCL_EVAL_GLOBAL);
    Tcl_DStringFree(&command);
    return TCL_OK;
}

{
static int
PkgRequireCoreStep2(
    ClientData data[],
    Tcl_Interp *interp,
    Interp *iPtr = (Interp *) interp;
    int result)
{
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name; /* Name of desired package. */

    Package *pkgPtr;
    if ((result != TCL_OK) && (result != TCL_ERROR)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad return code: %d", result));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
	result = TCL_ERROR;
    }
    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp,
		"\n    (\"package unknown\" script)");
	return result;
    }
    Tcl_ResetResult(interp);

    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    /*
     * pkgPtr may now be invalid, so refresh it.
     */

    char *availVersion, *bestVersion, *bestStableVersion;
    reqPtr->pkgPtr = FindPackage(interp, name);
    Tcl_NRAddCallback(interp,
	    SelectPackage, reqPtr, INT2PTR(reqc), reqv,
	    (void *)PkgRequireCoreFinal);
    return TCL_OK;
}

				/* Internal rep. of versions */
static int
PkgRequireCoreFinal(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]), satisfies;
    int availStable, code, satisfies, pass;
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    char *pkgVersionI;
    char *script, *pkgVersionI;
    void *clientDataPtr = reqPtr->clientDataPtr;
    const char *name = reqPtr->name; /* Name of desired package. */
    Tcl_DString command;

    if (reqPtr->pkgPtr->version == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't find package %s", name));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNFOUND", NULL);
	AddRequirementsToResult(interp, reqc, reqv);
	return TCL_ERROR;
    if (TCL_OK != CheckAllRequirements(interp, reqc, reqv)) {
	return NULL;
    }

    /*
     * Ensure that the provided version meets the current requirements.
     */

     * It can take up to three passes to find the package: one pass to run the
    if (reqc != 0) {
	CheckVersionAndConvert(interp, Tcl_GetString(reqPtr->pkgPtr->version),
		&pkgVersionI, NULL);
	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

     * "package unknown" script, one to run the "package ifneeded" script for
	Tcl_Free(pkgVersionI);

     * a specific version, and a final pass to lookup the package loaded by
	if (!satisfies) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "version conflict for package \"%s\": have %s, need",
     * the "package ifneeded" script.
		    name, Tcl_GetString(reqPtr->pkgPtr->version)));
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "VERSIONCONFLICT",
		    NULL);
	    AddRequirementsToResult(interp, reqc, reqv);
	    return TCL_ERROR;
	}
     */

    }

    for (pass=1 ;; pass++) {
    if (clientDataPtr) {
	const void **ptr = (const void **) clientDataPtr;

	pkgPtr = FindPackage(interp, name);
	*ptr = reqPtr->pkgPtr->clientData;
    }
    Tcl_SetObjResult(interp, reqPtr->pkgPtr->version);
	if (pkgPtr->version != NULL) {
    return TCL_OK;
}

	    break;
static int
PkgRequireCoreCleanup(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    Tcl_Free(data[0]);
    return result;
}
	}

static int
SelectPackage(
    ClientData data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int))
{
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies;
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    Package *pkgPtr = reqPtr->pkgPtr;
    Interp *iPtr = (Interp *) interp;

    /*
     * Check whether we're already attempting to load some version of this
     * package (circular dependency detection).
     */
	/*
	 * Check whether we're already attempting to load some version of this
	 * package (circular dependency detection).
	 */

    if (pkgPtr->clientData != NULL) {
	if (pkgPtr->clientData != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"circular package dependency:"
		" attempt to provide %s %s requires %s",
		name, (char *) pkgPtr->clientData, name));
	AddRequirementsToResult(interp, reqc, reqv);
	    Tcl_AppendResult(interp, "circular package dependency: "
		    "attempt to provide ", name, " ",
		    (char *) pkgPtr->clientData, " requires ", name, NULL);
	    AddRequirementsToResult(interp, reqc, reqv);
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "CIRCULARITY", NULL);
	return TCL_ERROR;
    }
	    return NULL;
	}

    /*
     * The package isn't yet present. Search the list of available versions
     * and invoke the script for the best available version. We are actually
     * locating the best, and the best stable version. One of them is then
     * chosen based on the selection mode.
     */
	/*
	 * The package isn't yet present. Search the list of available
	 * versions and invoke the script for the best available version. We
	 * are actually locating the best, and the best stable version. One of
	 * them is then chosen based on the selection mode.
	 */

    bestPtr = NULL;
    bestStablePtr = NULL;
    bestVersion = NULL;
    bestStableVersion = NULL;
	bestPtr = NULL;
	bestStablePtr = NULL;
	bestVersion = NULL;
	bestStableVersion = NULL;

    for (availPtr = pkgPtr->availPtr; availPtr != NULL;
	    availPtr = availPtr->nextPtr) {
	if (CheckVersionAndConvert(interp, availPtr->version,
		&availVersion, &availStable) != TCL_OK) {
	    /*
	     * The provided version number has invalid syntax. This should not
	     * happen. This should have been caught by the 'package ifneeded'
	     * registering the package.
	     */
	for (availPtr = pkgPtr->availPtr; availPtr != NULL;
		availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version,
		    &availVersion, &availStable) != TCL_OK) {
		/*
		 * The provided version number has invalid syntax. This
		 * should not happen. This should have been caught by the
		 * 'package ifneeded' registering the package.
		 */

	    continue;
	}

	/*
	 * Check satisfaction of requirements before considering the current
	 * version further.
	 */
		continue;
	    }
	    
	    /* Check satisfaction of requirements before considering the current version further. */
	    if (reqc > 0) {
		satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
		if (!satisfies) {
		    ckfree(availVersion);
		    availVersion = NULL;
		    continue;
		}
	    }
	    
	    if (bestPtr != NULL) {
		int res = CompareVersions(availVersion, bestVersion, NULL);

		/*
		 * Note: Used internal reps in the comparison!
		 */

		if (res > 0) {
		    /*
		     * The version of the package sought is better than the
		     * currently selected version.
		     */
		    ckfree(bestVersion);
		    bestVersion = NULL;
		    goto newbest;
		}
	    } else {
	    newbest:
		/* We have found a version which is better than our max. */

		bestPtr = availPtr;
		CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
	    }

	    if (!availStable) {
		ckfree(availVersion);
		availVersion = NULL;
		continue;
	    }

	    if (bestStablePtr != NULL) {
		int res = CompareVersions(availVersion, bestStableVersion, NULL);

		/*
		 * Note: Used internal reps in the comparison!
		 */

	if (reqc > 0) {
	    satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
	    if (!satisfies) {
		Tcl_Free(availVersion);
		availVersion = NULL;
		continue;
	    }
		if (res > 0) {
		    /*
		     * This stable version of the package sought is better
		     * than the currently selected stable version.
		     */
		    ckfree(bestStableVersion);
		    bestStableVersion = NULL;
		    goto newstable;
		}
	    } else {
	    newstable:
		/* We have found a stable version which is better than our max stable. */
		bestStablePtr = availPtr;
		CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
	    }

	    ckfree(availVersion);
	    availVersion = NULL;
	} /* end for */

	/*
	 * Clean up memorized internal reps, if any.
	 */
	
	if (bestVersion != NULL) {
	    ckfree(bestVersion);
	    bestVersion = NULL;
	}

	if (bestStableVersion != NULL) {
	    ckfree(bestStableVersion);
	    bestStableVersion = NULL;
	}

	/*
	 * Now choose a version among the two best. For 'latest' we simply
	 * take (actually keep) the best. For 'stable' we take the best
	 * stable, if there is any, or the best if there is nothing stable.
	 */

	if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
		&& (bestStablePtr != NULL)) {
	    bestPtr = bestStablePtr;
	}

	if (bestPtr != NULL) {
	    int res = CompareVersions(availVersion, bestVersion, NULL);

	    /*
	     * Note: Used internal reps in the comparison!
	     */

	     * We found an ifneeded script for the package. Be careful while
	    if (res > 0) {
		/*
		 * The version of the package sought is better than the
	     * executing it: this could cause reentrancy, so (a) protect the
	     * script itself from deletion and (b) don't assume that bestPtr
	     * will still exist when the script completes.
		 * currently selected version.
		 */
	     */

		Tcl_Free(bestVersion);
		bestVersion = NULL;
		goto newbest;
	    }
	    const char *versionToProvide = bestPtr->version;
	    script = bestPtr->script;

	} else {
	newbest:
	    /*
	     * We have found a version which is better than our max.
	    pkgPtr->clientData = (ClientData) versionToProvide;
	     */

	    Tcl_Preserve((ClientData) script);
	    bestPtr = availPtr;
	    CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
	    Tcl_Preserve((ClientData) versionToProvide);
	    code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
	}

	    Tcl_Release((ClientData) script);
	if (!availStable) {
	    Tcl_Free(availVersion);
	    availVersion = NULL;
	    continue;
	}

	if (bestStablePtr != NULL) {
	    int res = CompareVersions(availVersion, bestStableVersion, NULL);


	    pkgPtr = FindPackage(interp, name);
	    if (code == TCL_OK) {
		Tcl_ResetResult(interp);
		if (pkgPtr->version == NULL) {
		    code = TCL_ERROR;
	    /*
	     * Note: Used internal reps in the comparison!
	     */

		    Tcl_AppendResult(interp, "attempt to provide package ",
	    if (res > 0) {
		/*
		 * This stable version of the package sought is better than
		 * the currently selected stable version.
			    name, " ", versionToProvide,
		 */

			    " failed: no version of package ", name,
		Tcl_Free(bestStableVersion);
		bestStableVersion = NULL;
			    " provided", NULL);
		goto newstable;
	    }
	} else {
		} else {
	newstable:
	    /*
		    char *pvi, *vi;
	     * We have found a stable version which is better than our max
	     * stable.
	     */

		    if (CheckVersionAndConvert(interp, pkgPtr->version, &pvi,
			    NULL) != TCL_OK) {
	    bestStablePtr = availPtr;
	    CheckVersionAndConvert(interp, bestStablePtr->version,
			code = TCL_ERROR;
		    } else if (CheckVersionAndConvert(interp,
			    versionToProvide, &vi, NULL) != TCL_OK) {
			ckfree(pvi);
			code = TCL_ERROR;
		    } else {
			int res = CompareVersions(pvi, vi, NULL);
		    &bestStableVersion, NULL);
	}

	Tcl_Free(availVersion);
	availVersion = NULL;

			ckfree(pvi);
			ckfree(vi);
			if (res != 0) {
    } /* end for */

			    code = TCL_ERROR;
    /*
     * Clean up memorized internal reps, if any.
			    Tcl_AppendResult(interp,
     */

    if (bestVersion != NULL) {
	Tcl_Free(bestVersion);
	bestVersion = NULL;
    }

				    "attempt to provide package ", name, " ",
				    versionToProvide, " failed: package ",
				    name, " ", pkgPtr->version,
				    " provided instead", NULL);
			}
		    }
    if (bestStableVersion != NULL) {
	Tcl_Free(bestStableVersion);
	bestStableVersion = NULL;
    }
		}
	    } else if (code != TCL_ERROR) {
		Tcl_Obj *codePtr = Tcl_NewIntObj(code);

    /*
     * Now choose a version among the two best. For 'latest' we simply take
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "attempt to provide package ", name,
			" ", versionToProvide, " failed: bad return code: ",
     * (actually keep) the best. For 'stable' we take the best stable, if
     * there is any, or the best if there is nothing stable.
     */

			TclGetString(codePtr), NULL);
		TclDecrRefCount(codePtr);
		code = TCL_ERROR;
	    }
    if ((iPtr->packagePrefer == PKG_PREFER_STABLE)
	    && (bestStablePtr != NULL)) {
	bestPtr = bestStablePtr;
    }


	    if (code == TCL_ERROR) {
    if (bestPtr == NULL) {
	Tcl_NRAddCallback(interp,
		Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		(Tcl_NRPostProc *)data[3], reqPtr, INT2PTR(reqc), (void *)reqv, NULL);
    } else {
	/*
	 * We found an ifneeded script for the package. Be careful while
	 * executing it: this could cause reentrancy, so (a) protect the
	 * script itself from deletion and (b) don't assume that bestPtr will
	 * still exist when the script completes.
	 */

	char *versionToProvide = bestPtr->version;
			"\n    (\"package ifneeded %s %s\" script)",
			name, versionToProvide));
	PkgFiles *pkgFiles;
	PkgName *pkgName;

	Tcl_Preserve(versionToProvide);
	    }
	    Tcl_Release((ClientData) versionToProvide);
	pkgPtr->clientData = versionToProvide;

	pkgFiles = (PkgFiles *)TclInitPkgFiles(interp);

	/*
	 * Push "ifneeded" package name in "tclPkgFiles" assocdata.
	    if (code != TCL_OK) {
		/*
		 * Take a non-TCL_OK code from the script as an indication the
		 * package wasn't loaded properly, so the package system
	 */

		 * should not remember an improper load.
		 *
	pkgName = (PkgName *)Tcl_Alloc(sizeof(PkgName) + strlen(name));
	pkgName->nextPtr = pkgFiles->names;
		 * This is consistent with our returning NULL. If we're not
		 * willing to tell our caller we got a particular version, we
		 * shouldn't store that version for telling future callers
		 * either.
		 */
	strcpy(pkgName->name, name);
	pkgFiles->names = pkgName;
	if (bestPtr->pkgIndex) {
	    TclPkgFileSeen(interp, bestPtr->pkgIndex);
	}
	reqPtr->versionToProvide = versionToProvide;

		if (pkgPtr->version != NULL) {
		    ckfree(pkgPtr->version);
	Tcl_NRAddCallback(interp,
		SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv,
		data[3]);
	Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1),
		    pkgPtr->version = NULL;
		TCL_EVAL_GLOBAL);
    }
    return TCL_OK;
}

		}
		pkgPtr->clientData = NULL;
		return NULL;
	    }

static int
SelectPackageFinal(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
	    break;
{
    Require *reqPtr = (Require *)data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = (Tcl_Obj **)data[2];
    const char *name = reqPtr->name;
    char *versionToProvide = reqPtr->versionToProvide;

    /*
     * Pop the "ifneeded" package name from "tclPkgFiles" assocdata
     */
	}

	/*
	 * The package is not in the database. If there is a "package unknown"
	 * command, invoke it (but only on the first pass; after that, we
	 * should not get here in the first place).
	 */

    PkgFiles *pkgFiles = (PkgFiles *)Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
	if (pass > 1) {
    PkgName *pkgName = pkgFiles->names;
    pkgFiles->names = pkgName->nextPtr;
    Tcl_Free(pkgName);

    reqPtr->pkgPtr = FindPackage(interp, name);
	    break;
	}

    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
	if (reqPtr->pkgPtr->version == NULL) {
	script = ((Interp *) interp)->packageUnknown;
	if (script != NULL) {
	    result = TCL_ERROR;
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    Tcl_DStringInit(&command);
		    "attempt to provide package %s %s failed:"
		    " no version of package %s provided",
		    name, versionToProvide, name));
	    Tcl_DStringAppend(&command, script, -1);
	    Tcl_DStringAppendElement(&command, name);
	    Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "UNPROVIDED",
		    NULL);
	} else {
	    char *pvi, *vi;
	    AddRequirementsToDString(&command, reqc, reqv);

	    if (TCL_OK != CheckVersionAndConvert(interp,
	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&command),
		    Tcl_GetString(reqPtr->pkgPtr->version), &pvi, NULL)) {
		result = TCL_ERROR;
		    Tcl_DStringLength(&command), TCL_EVAL_GLOBAL);
	    } else if (CheckVersionAndConvert(interp,
		    versionToProvide, &vi, NULL) != TCL_OK) {
		Tcl_Free(pvi);
	    Tcl_DStringFree(&command);
		result = TCL_ERROR;
	    } else {
		int res = CompareVersions(pvi, vi, NULL);

	    if ((code != TCL_OK) && (code != TCL_ERROR)) {
		Tcl_Free(pvi);
		Tcl_Free(vi);
		if (res != 0) {
		    result = TCL_ERROR;
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		Tcl_Obj *codePtr = Tcl_NewIntObj(code);
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "bad return code: ",
			TclGetString(codePtr), NULL);
		Tcl_DecrRefCount(codePtr);
		code = TCL_ERROR;
	    }
	    if (code == TCL_ERROR) {
		Tcl_AddErrorInfo(interp,
			    "attempt to provide package %s %s failed:"
			    " package %s %s provided instead",
			"\n    (\"package unknown\" script)");
			    name, versionToProvide,
			    name, Tcl_GetString(reqPtr->pkgPtr->version)));
		    Tcl_SetErrorCode(interp, "TCL", "PACKAGE",
			    "WRONGPROVIDE", NULL);
		}
	    }
	}
		return NULL;
	    }
	    Tcl_ResetResult(interp);
	}
    }
    } else if (result != TCL_ERROR) {
	Tcl_Obj *codePtr;

	TclNewIntObj(codePtr, result);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (pkgPtr->version == NULL) {
	Tcl_AppendResult(interp, "can't find package ", name, NULL);
	AddRequirementsToResult(interp, reqc, reqv);
		"attempt to provide package %s %s failed:"
		" bad return code: %s",
	return NULL;
		name, versionToProvide, TclGetString(codePtr)));
	Tcl_SetErrorCode(interp, "TCL", "PACKAGE", "BADRESULT", NULL);
	TclDecrRefCount(codePtr);
	result = TCL_ERROR;
    }

    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"package ifneeded %s %s\" script)",
		name, versionToProvide));
    }

    Tcl_Release(versionToProvide);

    if (result != TCL_OK) {
	/*
    /*
	 * Take a non-TCL_OK code from the script as an indication the package
	 * wasn't loaded properly, so the package system should not remember
     * At this point we know that the package is present. Make sure that the
	 * an improper load.
	 *
	 * This is consistent with our returning NULL. If we're not willing to
	 * tell our caller we got a particular version, we shouldn't store
	 * that version for telling future callers either.
     * provided version meets the current requirements.
     */

    if (reqc == 0) {
	satisfies = 1;
    } else {
	CheckVersionAndConvert(interp, pkgPtr->version, &pkgVersionI, NULL);
	satisfies = SomeRequirementSatisfied(pkgVersionI, reqc, reqv);

	ckfree(pkgVersionI);
	 */

	if (reqPtr->pkgPtr->version != NULL) {
	    Tcl_DecrRefCount(reqPtr->pkgPtr->version);
	    reqPtr->pkgPtr->version = NULL;
    }

    if (satisfies) {
	if (clientDataPtr) {
	    *clientDataPtr = pkgPtr->clientData;
	}
	reqPtr->pkgPtr->clientData = NULL;
	return result;
	return pkgPtr->version;
    }

    Tcl_NRAddCallback(interp,
	    (Tcl_NRPostProc *)data[3], reqPtr, INT2PTR(reqc), (void *) reqv, NULL);
    return TCL_OK;
    Tcl_AppendResult(interp, "version conflict for package \"", name,
	    "\": have ", pkgPtr->version, ", need", NULL);
    AddRequirementsToResult(interp, reqc, reqv);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgPresent / Tcl_PkgPresentEx --
 *
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
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







-
+










-
+



















-
-
+
+

-
+
-







				 * available. */
    const char *name,		/* Name of desired package. */
    const char *version,	/* Version string for desired version; NULL
				 * means use the latest version available. */
    int exact,			/* Non-zero means that only the particular
				 * version given is acceptable. Zero means use
				 * the latest compatible version. */
    void *clientDataPtr)	/* Used to return the client data for this
    ClientData *clientDataPtr)	/* Used to return the client data for this
				 * package. If it is NULL then the client data
				 * is not returned. This is unchanged if this
				 * call fails for any reason. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    Package *pkgPtr;

    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
    if (hPtr) {
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	pkgPtr = Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    /*
	     * At this point we know that the package is present. Make sure
	     * that the provided version meets the current requirement by
	     * calling Tcl_PkgRequireEx() to check for us.
	     */

	    const char *foundVersion = Tcl_PkgRequireEx(interp, name, version,
		    exact, clientDataPtr);

	    if (foundVersion == NULL) {
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name,
			NULL);
	    }
	    return foundVersion;
	}
    }

    if (version != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"package %s %s is not present", name, version));
	Tcl_AppendResult(interp, "package ", name, " ", version,
		" is not present", NULL);
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_AppendResult(interp, "package ", name, " is not present", NULL);
		"package %s is not present", name));
    }
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PACKAGE", name, NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
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
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
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






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







-
-
-
-
-
-
-
+
-
-
-
+

-
-
+
+




-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+


-
+






-
+
-
-


-
+







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-



-
-
-
-
-
-
-
-
-




-
+


-
+




-
-
+
+
-
-
-
-
-
+

-
+




-
+
-














-
+


-
+



-
+





-
+




-
+

-
+

-
+
-
-
+


-
+
-
-
-
-



-
+





-
+
-
-
+









-
-
-
-
-
-
+
+






-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-




-

















-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
Tcl_PackageObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    return Tcl_NRCallObjProc(interp, TclNRPackageObjCmd, clientData, objc, objv);
}

	/* ARGSUSED */
int
TclNRPackageObjCmd(
    TCL_UNUSED(ClientData),
Tcl_PackageObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const pkgOptions[] = {
	"files",  "forget",  "ifneeded", "names",   "prefer",
	"present", "provide", "require",  "unknown", "vcompare",
	"versions", "vsatisfies", NULL
    static const char *pkgOptions[] = {
	"forget",  "ifneeded", "names",   "prefer",   "present",
	"provide", "require",  "unknown", "vcompare", "versions",
	"vsatisfies", NULL
    };
    enum pkgOptionsEnum {
	PKG_FILES,  PKG_FORGET,  PKG_IFNEEDED, PKG_NAMES,   PKG_PREFER,
	PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE,  PKG_UNKNOWN, PKG_VCOMPARE,
	PKG_VERSIONS, PKG_VSATISFIES
    enum pkgOptions {
	PKG_FORGET,  PKG_IFNEEDED, PKG_NAMES,   PKG_PREFER,   PKG_PRESENT,
	PKG_PROVIDE, PKG_REQUIRE,  PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS,
	PKG_VSATISFIES
    };
    Interp *iPtr = (Interp *) interp;
    int optionIndex, exact, i, newobjc, satisfies;
    int optionIndex, exact, i, satisfies;
    PkgAvail *availPtr, *prevPtr;
    Package *pkgPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable *tablePtr;
    const char *version;
    const char *argv2, *argv3, *argv4;
    char *argv2, *argv3, *argv4, *iva = NULL, *ivb = NULL;
    char *iva = NULL, *ivb = NULL;
    Tcl_Obj *objvListPtr, **newObjvPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], pkgOptions, "option", 0,
	    &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum pkgOptionsEnum) optionIndex) {
    switch ((enum pkgOptions) optionIndex) {
    case PKG_FILES: {
	PkgFiles *pkgFiles;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package");
	    return TCL_ERROR;
	}
	pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
	if (pkgFiles) {
	    Tcl_HashEntry *entry = Tcl_FindHashEntry(&pkgFiles->table,
		    TclGetString(objv[2]));

	    if (entry) {
		Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry));
	    }
	}
	break;
    }
    case PKG_FORGET: {
	const char *keyString;
	char *keyString;
	PkgFiles *pkgFiles = (PkgFiles *)
		Tcl_GetAssocData(interp, "tclPkgFiles", NULL);

	for (i = 2; i < objc; i++) {
	    keyString = TclGetString(objv[i]);
	    if (pkgFiles) {
		hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString);
		if (hPtr) {
		    Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
		    Tcl_DeleteHashEntry(hPtr);
		    Tcl_DecrRefCount(obj);
		}
	    }

	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
	    if (hPtr == NULL) {
		continue;
	    }
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    Tcl_DeleteHashEntry(hPtr);
	    if (pkgPtr->version != NULL) {
		Tcl_DecrRefCount(pkgPtr->version);
		ckfree(pkgPtr->version);
	    }
	    while (pkgPtr->availPtr != NULL) {
		availPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr->nextPtr;
		Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		Tcl_Free(availPtr);
		ckfree((char *) availPtr);
	    }
	    Tcl_Free(pkgPtr);
	    ckfree((char *) pkgPtr);
	}
	break;
    }
    case PKG_IFNEEDED: {
	size_t length;
	int length, res;
	int res;
	char *argv3i, *avi;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package version ?script?");
	    return TCL_ERROR;
	}
	argv3 = TclGetString(objv[3]);
	if (CheckVersionAndConvert(interp, argv3, &argv3i, NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
	argv2 = TclGetString(objv[2]);
	if (objc == 4) {
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr == NULL) {
		Tcl_Free(argv3i);
		ckfree(argv3i);
		return TCL_OK;
	    }
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	    pkgPtr = Tcl_GetHashValue(hPtr);
	} else {
	    pkgPtr = FindPackage(interp, argv2);
	}
	argv3 = TclGetStringFromObj(objv[3], &length);
	argv3 = Tcl_GetStringFromObj(objv[3], &length);

	for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
		prevPtr = availPtr, availPtr = availPtr->nextPtr) {
	    if (CheckVersionAndConvert(interp, availPtr->version, &avi,
		    NULL) != TCL_OK) {
		Tcl_Free(argv3i);
		ckfree(argv3i);
		return TCL_ERROR;
	    }

	    res = CompareVersions(avi, argv3i, NULL);
	    Tcl_Free(avi);
	    ckfree(avi);

	    if (res == 0) {
	    if (res == 0){
		if (objc == 4) {
		    Tcl_Free(argv3i);
		    ckfree(argv3i);
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj(availPtr->script, -1));
		    Tcl_SetResult(interp, availPtr->script, TCL_VOLATILE);
		    return TCL_OK;
		}
		Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
		Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
		if (availPtr->pkgIndex) {
		    Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		    availPtr->pkgIndex = NULL;
		}
		break;
	    }
	}
	Tcl_Free(argv3i);
	ckfree(argv3i);

	if (objc == 4) {
	    return TCL_OK;
	}
	if (availPtr == NULL) {
	    availPtr = (PkgAvail *)Tcl_Alloc(sizeof(PkgAvail));
	    availPtr = (PkgAvail *) ckalloc(sizeof(PkgAvail));
	    availPtr->pkgIndex = NULL;
	    DupBlock(availPtr->version, argv3, length + 1);
	    DupBlock(availPtr->version, argv3, (unsigned) length + 1);

	    if (prevPtr == NULL) {
		availPtr->nextPtr = pkgPtr->availPtr;
		pkgPtr->availPtr = availPtr;
	    } else {
		availPtr->nextPtr = prevPtr->nextPtr;
		prevPtr->nextPtr = availPtr;
	    }
	}
	if (iPtr->scriptFile) {
	    argv4 = TclGetStringFromObj(iPtr->scriptFile, &length);
	    DupBlock(availPtr->pkgIndex, argv4, length + 1);
	}
	argv4 = TclGetStringFromObj(objv[4], &length);
	DupBlock(availPtr->script, argv4, length + 1);
	argv4 = Tcl_GetStringFromObj(objv[4], &length);
	DupBlock(availPtr->script, argv4, (unsigned) length + 1);
	break;
    }
    case PKG_NAMES:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj;

	}
	    TclNewObj(resultObj);
	    tablePtr = &iPtr->packageTable;
	    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
		    hPtr = Tcl_NextHashEntry(&search)) {
		pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
		if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
	tablePtr = &iPtr->packageTable;
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
		hPtr = Tcl_NextHashEntry(&search)) {
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    if ((pkgPtr->version != NULL) || (pkgPtr->availPtr != NULL)) {
		    Tcl_ListObjAppendElement(NULL,resultObj, Tcl_NewStringObj(
			    (char *)Tcl_GetHashKey(tablePtr, hPtr), -1));
		}
		Tcl_AppendElement(interp, Tcl_GetHashKey(tablePtr, hPtr));
	    }
	    }
	    Tcl_SetObjResult(interp, resultObj);
	}
	break;
    case PKG_PRESENT: {
	const char *name;

	if (objc < 3) {
	    goto require;
	}
	argv2 = TclGetString(objv[2]);
	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
	    if (objc != 5) {
		goto requireSyntax;
	    }
	    exact = 1;
	    name = TclGetString(objv[3]);
	} else {
	    exact = 0;
	    name = argv2;
	}

	hPtr = Tcl_FindHashEntry(&iPtr->packageTable, name);
	if (hPtr != NULL) {
	    pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    if (pkgPtr->version != NULL) {
		goto require;
	    }
	}

	version = NULL;
	if (exact) {
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
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
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
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







-
+

-
+














-
+








+



















-

-
-
-
+
+
-
-
+
-
-
-
-
-
-
+

-
-
-



-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
+



-
+



-
-
+



-
+

-
+



-
+








-
+







	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
	    return TCL_ERROR;
	}
	argv2 = TclGetString(objv[2]);
	if (objc == 3) {
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr != NULL) {
		pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
		pkgPtr = Tcl_GetHashValue(hPtr);
		if (pkgPtr->version != NULL) {
		    Tcl_SetObjResult(interp, pkgPtr->version);
		    Tcl_SetResult(interp, pkgPtr->version, TCL_VOLATILE);
		}
	    }
	    return TCL_OK;
	}
	argv3 = TclGetString(objv[3]);
	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
	    return TCL_ERROR;
	}
	return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
    case PKG_REQUIRE:
    require:
	if (objc < 3) {
	requireSyntax:
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "?-exact? package ?requirement ...?");
		    "?-exact? package ?requirement...?");
	    return TCL_ERROR;
	}

	version = NULL;

	argv2 = TclGetString(objv[2]);
	if ((argv2[0] == '-') && (strcmp(argv2, "-exact") == 0)) {
	    Tcl_Obj *ov;
	    int res;

	    if (objc != 5) {
		goto requireSyntax;
	    }

	    version = TclGetString(objv[4]);
	    if (CheckVersionAndConvert(interp, version, NULL,
		    NULL) != TCL_OK) {
		return TCL_ERROR;
	    }

	    /*
	     * Create a new-style requirement for the exact version.
	     */

	    ov = Tcl_NewStringObj(version, -1);
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	    version = NULL;
	    argv3 = TclGetString(objv[3]);
	    Tcl_IncrRefCount(objv[3]);

	    objvListPtr = Tcl_NewListObj(0, NULL);
	    Tcl_IncrRefCount(objvListPtr);
	    Tcl_ListObjAppendElement(interp, objvListPtr, ov);
	    Tcl_IncrRefCount(ov);
	    res = Tcl_PkgRequireProc(interp, argv3, 1, &ov, NULL);
	    Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);

	    TclDecrRefCount(ov);
	    Tcl_NRAddCallback(interp,
		    TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL,NULL);
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv3, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	    return res;
	} else {
	    Tcl_Obj *const *newobjv = objv + 3;

	    newobjc = objc - 3;
	    if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
		return TCL_ERROR;
	    }
	    objvListPtr = Tcl_NewListObj(0, NULL);
	    Tcl_IncrRefCount(objvListPtr);
	    Tcl_IncrRefCount(objv[2]);
	    for (i = 0; i < newobjc; i++) {
		/*
		 * Tcl_Obj structures may have come from another interpreter,
		 * so duplicate them.
		 */

		Tcl_ListObjAppendElement(interp, objvListPtr,
			Tcl_DuplicateObj(newobjv[i]));
	    }
	    Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr);
	    Tcl_NRAddCallback(interp,
		    TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL,NULL);
	    Tcl_NRAddCallback(interp,
		    PkgRequireCore, (void *) argv2, INT2PTR(newobjc),
		    newObjvPtr, NULL);
	    return TCL_OK;
	    return Tcl_PkgRequireProc(interp, argv2, objc-3, objv+3, NULL);
	}
	break;
    case PKG_UNKNOWN: {
	size_t length;
	int length;

	if (objc == 2) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj(iPtr->packageUnknown, -1));
		Tcl_SetResult(interp, iPtr->packageUnknown, TCL_VOLATILE);
	    }
	} else if (objc == 3) {
	    if (iPtr->packageUnknown != NULL) {
		Tcl_Free(iPtr->packageUnknown);
		ckfree(iPtr->packageUnknown);
	    }
	    argv2 = TclGetStringFromObj(objv[2], &length);
	    argv2 = Tcl_GetStringFromObj(objv[2], &length);
	    if (argv2[0] == 0) {
		iPtr->packageUnknown = NULL;
	    } else {
		DupBlock(iPtr->packageUnknown, argv2, length+1);
		DupBlock(iPtr->packageUnknown, argv2, (unsigned) length+1);
	    }
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?command?");
	    return TCL_ERROR;
	}
	break;
    }
    case PKG_PREFER: {
	static const char *const pkgPreferOptions[] = {
	static const char *pkgPreferOptions[] = {
	    "latest", "stable", NULL
	};

	/*
	 * See tclInt.h for the enum, just before Interp.
	 */

1464
1465
1466
1467
1468
1469
1470
1471

1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488



1489
1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501
1502
1503






1504
1505
1506


1507
1508
1509
1510
1511
1512
1513
1514
1515


1516
1517
1518
1519
1520
1521
1522
1523

1524
1525
1526
1527
1528

1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
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
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







-
+














-
-
-
+
+
+





-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-






-
+
+







-
+




-
+









-
-
-
-
-
-
-
-
-
-
-







	    return TCL_ERROR;
	}
	argv3 = TclGetString(objv[3]);
	argv2 = TclGetString(objv[2]);
	if (CheckVersionAndConvert(interp, argv2, &iva, NULL) != TCL_OK ||
		CheckVersionAndConvert(interp, argv3, &ivb, NULL) != TCL_OK) {
	    if (iva != NULL) {
		Tcl_Free(iva);
		ckfree(iva);
	    }

	    /*
	     * ivb cannot be set in this branch.
	     */

	    return TCL_ERROR;
	}

	/*
	 * Comparison is done on the internal representation.
	 */

	Tcl_SetObjResult(interp,
		Tcl_NewWideIntObj(CompareVersions(iva, ivb, NULL)));
	Tcl_Free(iva);
	Tcl_Free(ivb);
		Tcl_NewIntObj(CompareVersions(iva, ivb, NULL)));
	ckfree(iva);
	ckfree(ivb);
	break;
    case PKG_VERSIONS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package");
	    return TCL_ERROR;
	} else {
	    Tcl_Obj *resultObj;

	}
	    TclNewObj(resultObj);
	    argv2 = TclGetString(objv[2]);
	    hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	    if (hPtr != NULL) {
		pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
		for (availPtr = pkgPtr->availPtr; availPtr != NULL;
			availPtr = availPtr->nextPtr) {
	argv2 = TclGetString(objv[2]);
	hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2);
	if (hPtr != NULL) {
	    pkgPtr = Tcl_GetHashValue(hPtr);
	    for (availPtr = pkgPtr->availPtr; availPtr != NULL;
		    availPtr = availPtr->nextPtr) {
		    Tcl_ListObjAppendElement(NULL, resultObj,
			    Tcl_NewStringObj(availPtr->version, -1));
		}
		Tcl_AppendElement(interp, availPtr->version);
	    }
	    }
	    Tcl_SetObjResult(interp, resultObj);
	}
	break;
    case PKG_VSATISFIES: {
	char *argv2i = NULL;

	if (objc < 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "version ?requirement ...?");
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "version requirement requirement...");
	    return TCL_ERROR;
	}

	argv2 = TclGetString(objv[2]);
	if (CheckVersionAndConvert(interp, argv2, &argv2i, NULL) != TCL_OK) {
	    return TCL_ERROR;
	} else if (CheckAllRequirements(interp, objc-3, objv+3) != TCL_OK) {
	    Tcl_Free(argv2i);
	    ckfree(argv2i);
	    return TCL_ERROR;
	}

	satisfies = SomeRequirementSatisfied(argv2i, objc-3, objv+3);
	Tcl_Free(argv2i);
	ckfree(argv2i);

	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(satisfies));
	break;
    }
    default:
	Tcl_Panic("Tcl_PackageObjCmd: bad option index to pkgOptions");
    }
    return TCL_OK;
}

static int
TclNRPackageObjCmdCleanup(
    ClientData data[],
    TCL_UNUSED(Tcl_Interp *),
    int result)
{
    TclDecrRefCount((Tcl_Obj *) data[0]);
    TclDecrRefCount((Tcl_Obj *) data[1]);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * FindPackage --
 *
 *	This function finds the Package record for a particular package in a
1573
1574
1575
1576
1577
1578
1579
1580

1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1184
1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196

1197
1198
1199
1200
1201
1202
1203
1204







-
+





-
+







    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    int isNew;
    Package *pkgPtr;

    hPtr = Tcl_CreateHashEntry(&iPtr->packageTable, name, &isNew);
    if (isNew) {
	pkgPtr = (Package *)Tcl_Alloc(sizeof(Package));
	pkgPtr = (Package *) ckalloc(sizeof(Package));
	pkgPtr->version = NULL;
	pkgPtr->availPtr = NULL;
	pkgPtr->clientData = NULL;
	Tcl_SetHashValue(hPtr, pkgPtr);
    } else {
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	pkgPtr = Tcl_GetHashValue(hPtr);
    }
    return pkgPtr;
}

/*
 *----------------------------------------------------------------------
 *
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
1631
1632

1633
1634

1635
1636
1637
1638

1639
1640
1641
1642
1643
1644
1645
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







-
+








-
+

-
+




-
-
+
+
-
-
-
-
-
+

-
+



-
+







 *	Memory is freed.
 *
 *----------------------------------------------------------------------
 */

void
TclFreePackageInfo(
    Interp *iPtr)		/* Interpreter that is being deleted. */
    Interp *iPtr)		/* Interpereter that is being deleted. */
{
    Package *pkgPtr;
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;
    PkgAvail *availPtr;

    for (hPtr = Tcl_FirstHashEntry(&iPtr->packageTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	pkgPtr = (Package *)Tcl_GetHashValue(hPtr);
	pkgPtr = Tcl_GetHashValue(hPtr);
	if (pkgPtr->version != NULL) {
	    Tcl_DecrRefCount(pkgPtr->version);
	    ckfree(pkgPtr->version);
	}
	while (pkgPtr->availPtr != NULL) {
	    availPtr = pkgPtr->availPtr;
	    pkgPtr->availPtr = availPtr->nextPtr;
	    Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
	    Tcl_EventuallyFree((ClientData)availPtr->version, TCL_DYNAMIC);
	    Tcl_EventuallyFree((ClientData)availPtr->script, TCL_DYNAMIC);
	    if (availPtr->pkgIndex) {
		Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
		availPtr->pkgIndex = NULL;
	    }
	    Tcl_Free(availPtr);
	    ckfree((char *) availPtr);
	}
	Tcl_Free(pkgPtr);
	ckfree((char *) pkgPtr);
    }
    Tcl_DeleteHashTable(&iPtr->packageTable);
    if (iPtr->packageUnknown != NULL) {
	Tcl_Free(iPtr->packageUnknown);
	ckfree(iPtr->packageUnknown);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * CheckVersionAndConvert --
1671
1672
1673
1674
1675
1676
1677
1678

1679
1680
1681
1682
1683
1684
1685
1278
1279
1280
1281
1282
1283
1284

1285
1286
1287
1288
1289
1290
1291
1292







-
+







    const char *p = string;
    char prevChar;
    int hasunstable = 0;
    /*
     * 4* assuming that each char is a separator (a,b become ' -x ').
     * 4+ to have spce for an additional -2 at the end
     */
    char *ibuf = (char *)Tcl_Alloc(4 + 4*strlen(string));
    char *ibuf = ckalloc(4 + 4*strlen(string));
    char *ip = ibuf;

    /*
     * Basic rules
     * (1) First character has to be a digit.
     * (2) All other characters have to be a digit or '.'
     * (3) Two '.'s may not follow each other.
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
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







-
+








-
+
-
-
-
+
+







	prevChar = *p;
    }
    if (prevChar!='.' && prevChar!='a' && prevChar!='b') {
	*ip = '\0';
	if (internal != NULL) {
	    *internal = ibuf;
	} else {
	    Tcl_Free(ibuf);
	    ckfree(ibuf);
	}
	if (stable != NULL) {
	    *stable = !hasunstable;
	}
	return TCL_OK;
    }

  error:
    Tcl_Free(ibuf);
    ckfree(ibuf);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected version number but got \"%s\"", string));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSION", NULL);
    Tcl_AppendResult(interp, "expected version number but got \"", string,
	    "\"", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * CompareVersions --
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
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
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







-
+













-
-
-
+
+







-
+










-
+



-
+







     * Syntax of requirement = version
     *			     = version-version
     *			     = version-
     */

    char *dash = NULL, *buf;

    dash = (char *)strchr(string, '-');
    dash = strchr(string, '-');
    if (dash == NULL) {
	/*
	 * No dash found, has to be a simple version.
	 */

	return CheckVersionAndConvert(interp, string, NULL, NULL);
    }

    if (strchr(dash+1, '-') != NULL) {
	/*
	 * More dashes found after the first. This is wrong.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"expected versionMin-versionMax but got \"%s\"", string));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "VERSIONRANGE", NULL);
	Tcl_AppendResult(interp, "expected versionMin-versionMax but got \"",
		string, "\"", NULL);
	return TCL_ERROR;
    }

    /*
     * Exactly one dash is present. Copy the string, split at the location of
     * dash and check that both parts are versions. Note that the max part can
     * be empty. Also note that the string allocated with strdup() must be
     * freed with free() and not Tcl_Free().
     * freed with free() and not ckfree().
     */

    DupString(buf, string);
    dash = buf + (dash - string);
    *dash = '\0';		/* buf now <=> min part */
    dash++;			/* dash now <=> max part */

    if ((CheckVersionAndConvert(interp, buf, NULL, NULL) != TCL_OK) ||
	    ((*dash != '\0') &&
	    (CheckVersionAndConvert(interp, dash, NULL, NULL) != TCL_OK))) {
	Tcl_Free(buf);
	ckfree(buf);
	return TCL_ERROR;
    }

    Tcl_Free(buf);
    ckfree(buf);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AddRequirementsToResult --
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
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







-
-
+
+
-

-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
+







AddRequirementsToResult(
    Tcl_Interp *interp,
    int reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    Tcl_Obj *result = Tcl_GetObjResult(interp);
    int i;
    if (reqc > 0) {
	int i;
    size_t length;

    for (i = 0; i < reqc; i++) {
	const char *v = TclGetStringFromObj(reqv[i], &length);
	for (i = 0; i < reqc; i++) {
	    int length;
	    char *v = Tcl_GetStringFromObj(reqv[i], &length);

	if ((length & 0x1) && (v[length/2] == '-')
		&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
	    Tcl_AppendPrintfToObj(result, " exactly %s", v+((length+1)/2));
	} else {
	    Tcl_AppendPrintfToObj(result, " %s", v);
	    if ((length & 0x1) && (v[length/2] == '-')
		    && (strncmp(v, v+((length+1)/2), length/2) == 0)) {
		Tcl_AppendResult(interp, " exactly ", v+((length+1)/2), NULL);
	    } else {
		Tcl_AppendResult(interp, " ", v, NULL);
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
2105
2106
2107
2108
2109
2110
2111

2112

2113
2114
2115
2116
2117


2118
2119
2120

2121
2122
2123
2124
2125
2126
2127
1711
1712
1713
1714
1715
1716
1717
1718

1719
1720

1721


1722
1723
1724
1725

1726
1727
1728
1729
1730
1731
1732
1733







+
-
+

-

-
-
+
+


-
+







AddRequirementsToDString(
    Tcl_DString *dsPtr,
    int reqc,			/* Requirements constraining the desired
				 * version. */
    Tcl_Obj *const reqv[])	/* 0 means to use the latest version
				 * available. */
{
    if (reqc > 0) {
    int i;
	int i;

    if (reqc > 0) {
	for (i = 0; i < reqc; i++) {
	    TclDStringAppendLiteral(dsPtr, " ");
	    TclDStringAppendObj(dsPtr, reqv[i]);
	    Tcl_DStringAppend(dsPtr, " ", 1);
	    Tcl_DStringAppend(dsPtr, TclGetString(reqv[i]), -1);
	}
    } else {
	TclDStringAppendLiteral(dsPtr, " 0-");
	Tcl_DStringAppend(dsPtr, " 0-", -1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SomeRequirementSatisfied --
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
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
1820
1821
1822
1823







-
+















-
+







    /*
     * The have candidate is already in internal rep.
     */

    int satisfied, res;
    char *dash = NULL, *buf, *min, *max;

    dash = (char *)strchr(req, '-');
    dash = strchr(req, '-');
    if (dash == NULL) {
	/*
	 * No dash found, is a simple version, fallback to regular check. The
	 * 'CheckVersionAndConvert' cannot fail. We pad the requirement with
	 * 'a0', i.e '-2' before doing the comparison to properly accept
	 * unstables as well.
	 */

	char *reqi = NULL;
	int thisIsMajor;

	CheckVersionAndConvert(NULL, req, &reqi, NULL);
	strcat(reqi, " -2");
	res = CompareVersions(havei, reqi, &thisIsMajor);
	satisfied = (res == 0) || ((res == 1) && !thisIsMajor);
	Tcl_Free(reqi);
	ckfree(reqi);
	return satisfied;
    }

    /*
     * Exactly one dash is present (Assumption of valid syntax). Copy the req,
     * split at the location of dash and check that both parts are versions.
     * Note that the max part can be empty.
2227
2228
2229
2230
2231
2232
2233
2234
2235


2236
2237
2238
2239
2240
2241
2242
1833
1834
1835
1836
1837
1838
1839


1840
1841
1842
1843
1844
1845
1846
1847
1848







-
-
+
+







	 * We have a min, but no max. For the comparison we generate the
	 * internal rep, padded with 'a0' i.e. '-2'.
	 */

	CheckVersionAndConvert(NULL, buf, &min, NULL);
	strcat(min, " -2");
	satisfied = (CompareVersions(havei, min, NULL) >= 0);
	Tcl_Free(min);
	Tcl_Free(buf);
	ckfree(min);
	ckfree(buf);
	return satisfied;
    }

    /*
     * We have both min and max, and generate their internal reps. When
     * identical we compare as is, otherwise we pad with 'a0' to ove the range
     * a bit.
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259



2260
2261
2262
2263
2264
2265
2266
1856
1857
1858
1859
1860
1861
1862



1863
1864
1865
1866
1867
1868
1869
1870
1871
1872







-
-
-
+
+
+







    } else {
	strcat(min, " -2");
	strcat(max, " -2");
	satisfied = ((CompareVersions(min, havei, NULL) <= 0) &&
		(CompareVersions(havei, max, NULL) < 0));
    }

    Tcl_Free(min);
    Tcl_Free(max);
    Tcl_Free(buf);
    ckfree(min);
    ckfree(max);
    ckfree(buf);
    return satisfied;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PkgInitStubsCheck --
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
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







-
+

-
+









-
+



-
+












const char *
Tcl_PkgInitStubsCheck(
    Tcl_Interp *interp,
    const char * version,
    int exact)
{
    const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL);
    const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);

    if ((exact&1) && actualVersion) {
    if (exact && actualVersion) {
	const char *p = version;
	int count = 0;

	while (*p) {
	    count += !isdigit(UCHAR(*p++));
	}
	if (count == 1) {
	    if (0 != strncmp(version, actualVersion, strlen(version))) {
		/* Construct error message */
		Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
		Tcl_PkgPresent(interp, "Tcl", version, 1);
		return NULL;
	    }
	} else {
	    return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
	    return Tcl_PkgPresent(interp, "Tcl", version, 1);
	}
    }
    return actualVersion;
}
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclPkgConfig.c.

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

48
49
50
51
52
53
54
31
32
33
34
35
36
37




38
39
40
41
42

43
44
45
46
47
48
49
50







-
-
-
-





-
+







 *
 * - TCL_CFGVAL_ENCODING	string containing the encoding used for the
 *				configuration values.
 */

#include "tclInt.h"

#ifndef TCL_CFGVAL_ENCODING
#   define TCL_CFGVAL_ENCODING "utf-8"
#endif

/*
 * Use C preprocessor statements to define the various values for the embedded
 * configuration information.
 */

#if TCL_THREADS
#ifdef TCL_THREADS
#  define  CFG_THREADED		"1"
#else
#  define  CFG_THREADED		"0"
#endif

#ifdef TCL_MEM_DEBUG
#  define CFG_MEMDEBUG		"1"
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
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







-
+
















-
-















-
+













#ifdef TCL_CFG_PROFILED
#  define CFG_PROFILED		"1"
#else
#  define CFG_PROFILED		"0"
#endif

static Tcl_Config const cfg[] = {
static Tcl_Config cfg[] = {
    {"debug",			CFG_DEBUG},
    {"threaded",		CFG_THREADED},
    {"profiled",		CFG_PROFILED},
    {"64bit",			CFG_64},
    {"optimized",		CFG_OPTIMIZED},
    {"mem_debug",		CFG_MEMDEBUG},
    {"compile_debug",		CFG_COMPILE_DEBUG},
    {"compile_stats",		CFG_COMPILE_STATS},

    /* Runtime paths to various stuff */

    {"libdir,runtime",		CFG_RUNTIME_LIBDIR},
    {"bindir,runtime",		CFG_RUNTIME_BINDIR},
    {"scriptdir,runtime",	CFG_RUNTIME_SCRDIR},
    {"includedir,runtime",	CFG_RUNTIME_INCDIR},
    {"docdir,runtime",		CFG_RUNTIME_DOCDIR},
    {"dllfile,runtime",		CFG_RUNTIME_DLLFILE},
    {"zipfile,runtime",		CFG_RUNTIME_ZIPFILE},

    /* Installation paths to various stuff */

    {"libdir,install",		CFG_INSTALL_LIBDIR},
    {"bindir,install",		CFG_INSTALL_BINDIR},
    {"scriptdir,install",	CFG_INSTALL_SCRDIR},
    {"includedir,install",	CFG_INSTALL_INCDIR},
    {"docdir,install",		CFG_INSTALL_DOCDIR},

    /* Last entry, closes the array */
    {NULL, NULL}
};

void
TclInitEmbeddedConfigurationInformation(
    Tcl_Interp *interp)		/* Interpreter the configuration command is
    Tcl_Interp* interp)		/* Interpreter the configuration command is
				 * registered in. */
{
    Tcl_RegisterConfig(interp, "tcl", cfg, TCL_CFGVAL_ENCODING);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclPlatDecls.h.

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
17
18
19
20
21
22
23






24
25
26
27
28
29
30







-
-
-
-
-
-







#   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/tcl.decls script.
 */

/*
 * TCHAR is needed here for win32, so if it is not defined yet do it here.
 * This way, we don't need to include <tchar.h> just for one define.
 */
#if (defined(_WIN32) || defined(__CYGWIN__)) && !defined(_TCHAR_DEFINED)
#   if defined(_UNICODE)
	typedef wchar_t TCHAR;
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

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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
+
+
+
+
+
+
+


-
-
-
+
+
+

+
+
+
+
+
+




-
+

+
+
+
+
+
+

-
-
+
+
+



-
+





-
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+
+


+
+
+
+
+


-
+



-
-
-
-
-



-
-
-
-
-
-
+

-
+
extern "C" {
#endif

/*
 * Exported function declarations:
 */

#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#ifndef Tcl_WinUtfToTChar_TCL_DECLARED
#define Tcl_WinUtfToTChar_TCL_DECLARED
/* 0 */
EXTERN TCHAR *		Tcl_WinUtfToTChar(CONST char *str, int len,
				Tcl_DString *dsPtr);
#endif
#ifndef Tcl_WinTCharToUtf_TCL_DECLARED
#define Tcl_WinTCharToUtf_TCL_DECLARED
/* 1 */
EXTERN char *		Tcl_WinTCharToUtf(CONST TCHAR *str, int len,
				Tcl_DString *dsPtr);
#endif
/* Slot 2 is reserved */
#ifndef TclUnusedStubEntry_TCL_DECLARED
#define TclUnusedStubEntry_TCL_DECLARED
/* 3 */
EXTERN void		TclUnusedStubEntry(void);
#endif
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#ifndef Tcl_MacOSXOpenBundleResources_TCL_DECLARED
#define Tcl_MacOSXOpenBundleResources_TCL_DECLARED
/* Slot 0 is reserved */
/* 0 */
EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				CONST char *bundleName, int hasResourceFile,
				int maxPathLen, char *libraryPath);
#endif
#ifndef Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
#define Tcl_MacOSXOpenVersionedBundleResources_TCL_DECLARED
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, size_t maxPathLen,
				Tcl_Interp *interp, CONST char *bundleName,
				CONST char *bundleVersion,
				int hasResourceFile, int maxPathLen,
				char *libraryPath);
#endif
#ifndef TclUnusedStubEntry_TCL_DECLARED
#define TclUnusedStubEntry_TCL_DECLARED
/* 2 */
EXTERN void		TclUnusedStubEntry(void);
#endif
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    void *hooks;
    struct TclPlatStubHooks *hooks;

#if defined(__WIN32__) || defined(__CYGWIN__) /* 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 */
    VOID *reserved2;
    void (*tclUnusedStubEntry) (void); /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*reserved0)(void);
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, size_t maxPathLen, char *libraryPath); /* 1 */
    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 */
    void (*tclUnusedStubEntry) (void); /* 2 */
#endif /* MACOSX */
} TclPlatStubs;

extern const TclPlatStubs *tclPlatStubsPtr;
extern TclPlatStubs *tclPlatStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
 * Inline function declarations:
 */

#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
#ifndef Tcl_WinUtfToTChar
#define Tcl_WinUtfToTChar \
	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#endif
#ifndef Tcl_WinTCharToUtf
#define Tcl_WinTCharToUtf \
	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
#endif
/* Slot 2 is reserved */
#ifndef TclUnusedStubEntry
#define TclUnusedStubEntry \
	(tclPlatStubsPtr->tclUnusedStubEntry) /* 3 */
#endif
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* Slot 0 is reserved */
#ifndef Tcl_MacOSXOpenBundleResources
#define Tcl_MacOSXOpenBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#endif
#ifndef Tcl_MacOSXOpenVersionedBundleResources
#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#endif
#ifndef TclUnusedStubEntry
#define TclUnusedStubEntry \
	(tclPlatStubsPtr->tclUnusedStubEntry) /* 2 */
#endif
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#ifdef MAC_OSX_TCL /* MACOSX */
#undef Tcl_MacOSXOpenBundleResources
#define Tcl_MacOSXOpenBundleResources(a,b,c,d,e) Tcl_MacOSXOpenVersionedBundleResources(a,b,NULL,c,d,e)
#endif

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#if defined(USE_TCL_STUBS) && defined(_WIN32) && !defined(TCL_NO_DEPRECATED)
#define Tcl_WinUtfToTChar(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
		(TCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
#define Tcl_WinTCharToUtf(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
#endif
#endif /* _TCLPLATDECLS */

#endif /* _TCLPLATDECLS */

Changes to generic/tclPort.h.

19
20
21
22
23
24
25















26
27
28
29
30
31
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






#endif
#if defined(_WIN32)
#   include "tclWinPort.h"
#else
#   include "tclUnixPort.h"
#endif
#include "tcl.h"

#if !defined(LLONG_MIN)
#   ifdef TCL_WIDE_INT_IS_LONG
#      define LLONG_MIN LONG_MIN
#   else
#      ifdef LLONG_BIT
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
#      else
/* Assume we're on a system with a 64-bit 'long long' type */
#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))
#      endif
#   endif
/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */
#   define LLONG_MAX (~LLONG_MIN)
#endif

#define UWIDE_MAX ((Tcl_WideUInt)-1)
#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))

#endif /* _TCLPORT */

Changes to generic/tclPosixStr.c.

27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41







-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
CONST char *
Tcl_ErrnoId(void)
{
    switch (errno) {
#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
    case E2BIG: return "E2BIG";
#endif
#ifdef EACCES
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
70
71
72
73
74
75
76



77
78
79
80
81
82
83







-
-
-







#endif
#ifdef EBADFD
    case EBADFD: return "EBADFD";
#endif
#ifdef EBADMSG
    case EBADMSG: return "EBADMSG";
#endif
#ifdef ECANCELED
    case ECANCELED: return "ECANCELED";
#endif
#ifdef EBADR
    case EBADR: return "EBADR";
#endif
#ifdef EBADRPC
    case EBADRPC: return "EBADRPC";
#endif
#ifdef EBADRQC
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210







-
+







#endif
#ifdef ELIBBAD
    case ELIBBAD: return "ELIBBAD";
#endif
#ifdef ELIBEXEC
    case ELIBEXEC: return "ELIBEXEC";
#endif
#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
#ifdef ELIBMAX
    case ELIBMAX: return "ELIBMAX";
#endif
#ifdef ELIBSCN
    case ELIBSCN: return "ELIBSCN";
#endif
#ifdef ELNRNG
    case ELNRNG: return "ELNRNG";
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
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







-
+














-
+







#endif
#ifdef ENOEXEC
    case ENOEXEC: return "ENOEXEC";
#endif
#ifdef ENOLCK
    case ENOLCK: return "ENOLCK";
#endif
#ifdef ENOLINK
#if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != ENOLINK))
    case ENOLINK: return "ENOLINK";
#endif
#ifdef ENOMEM
    case ENOMEM: return "ENOMEM";
#endif
#ifdef ENOMSG
    case ENOMSG: return "ENOMSG";
#endif
#ifdef ENONET
    case ENONET: return "ENONET";
#endif
#ifdef ENOPKG
    case ENOPKG: return "ENOPKG";
#endif
#ifdef ENOPROTOOPT
#if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != ENOPROTOOPT))
    case ENOPROTOOPT: return "ENOPROTOOPT";
#endif
#ifdef ENOSPC
    case ENOSPC: return "ENOSPC";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
    case ENOSR: return "ENOSR";
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
304
305
306
307
308
309
310



311
312
313
314
315
316
317







-
-
-







#endif
#ifdef ENOTBLK
    case ENOTBLK: return "ENOTBLK";
#endif
#ifdef ENOTCONN
    case ENOTCONN: return "ENOTCONN";
#endif
#ifdef ENOTRECOVERABLE
    case ENOTRECOVERABLE: return "ENOTRECOVERABLE";
#endif
#ifdef ENOTDIR
    case ENOTDIR: return "ENOTDIR";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
    case ENOTEMPTY: return "ENOTEMPTY";
#endif
#ifdef ENOTNAM
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
331
332
333
334
335
336
337



338
339
340



341
342
343
344
345
346
347







-
-
-



-
-
-







#endif
#ifdef ENXIO
    case ENXIO: return "ENXIO";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
    case EOPNOTSUPP: return "EOPNOTSUPP";
#endif
#ifdef EOTHER
    case EOTHER: return "EOTHER";
#endif
#if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
    case EOVERFLOW: return "EOVERFLOW";
#endif
#ifdef EOWNERDEAD
    case EOWNERDEAD: return "EOWNERDEAD";
#endif
#ifdef EPERM
    case EPERM: return "EPERM";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
    case EPFNOSUPPORT: return "EPFNOSUPPORT";
#endif
#ifdef EPIPE
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
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







-
+














-
+





-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
CONST char *
Tcl_ErrnoMsg(
     int err)			/* Error number (such as in errno variable). */
{
    switch (err) {
#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
    case E2BIG: return "argument list too long";
#endif
#ifdef EACCES
    case EACCES: return "permission denied";
#endif
#ifdef EADDRINUSE
    case EADDRINUSE: return "address already in use";
#endif
#ifdef EADDRNOTAVAIL
    case EADDRNOTAVAIL: return "cannot assign requested address";
    case EADDRNOTAVAIL: return "can't assign requested address";
#endif
#ifdef EADV
    case EADV: return "advertise error";
#endif
#ifdef EAFNOSUPPORT
    case EAFNOSUPPORT: return "address family not supported by protocol";
    case EAFNOSUPPORT: return "address family not supported by protocol family";
#endif
#ifdef EAGAIN
    case EAGAIN: return "resource temporarily unavailable";
#endif
#ifdef EALIGN
    case EALIGN: return "EALIGN";
#endif
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
517
518
519
520
521
522
523



524
525
526
527
528
529
530







-
-
-







#endif
#ifdef EBADFD
    case EBADFD: return "file descriptor in bad state";
#endif
#ifdef EBADMSG
    case EBADMSG: return "not a data message";
#endif
#ifdef ECANCELED
    case ECANCELED: return "operation canceled";
#endif
#ifdef EBADR
    case EBADR: return "bad request descriptor";
#endif
#ifdef EBADRPC
    case EBADRPC: return "RPC structure is bad";
#endif
#ifdef EBADRQC
650
651
652
653
654
655
656
657

658
659
660
661
662
663

664
665

666
667
668
669
670
671
672
635
636
637
638
639
640
641

642
643
644
645
646
647

648
649

650
651
652
653
654
655
656
657







-
+





-
+

-
+







#ifdef EL3HLT
    case EL3HLT: return "level 3 halted";
#endif
#ifdef EL3RST
    case EL3RST: return "level 3 reset";
#endif
#ifdef ELIBACC
    case ELIBACC: return "cannot access a needed shared library";
    case ELIBACC: return "can not access a needed shared library";
#endif
#ifdef ELIBBAD
    case ELIBBAD: return "accessing a corrupted shared library";
#endif
#ifdef ELIBEXEC
    case ELIBEXEC: return "cannot exec a shared library directly";
    case ELIBEXEC: return "can not exec a shared library directly";
#endif
#if defined(ELIBMAX) && (!defined(ECANCELED) || (ELIBMAX != ECANCELED))
#ifdef ELIBMAX
    case ELIBMAX: return
	    "attempting to link in more shared libraries than system limit";
#endif
#ifdef ELIBSCN
    case ELIBSCN: return ".lib section in a.out corrupted";
#endif
#ifdef ELNRNG
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
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







-
+














-
+







#endif
#ifdef ENOEXEC
    case ENOEXEC: return "exec format error";
#endif
#ifdef ENOLCK
    case ENOLCK: return "no locks available";
#endif
#ifdef ENOLINK
#if defined(ENOLINK) && (!defined(ESOCKTNOSUPPORT) || (ESOCKTNOSUPPORT != ENOLINK))
    case ENOLINK: return "link has been severed";
#endif
#ifdef ENOMEM
    case ENOMEM: return "not enough memory";
#endif
#ifdef ENOMSG
    case ENOMSG: return "no message of desired type";
#endif
#ifdef ENONET
    case ENONET: return "machine is not on the network";
#endif
#ifdef ENOPKG
    case ENOPKG: return "package not installed";
#endif
#ifdef ENOPROTOOPT
#if defined(ENOPROTOOPT) && (!defined(EPFNOSUPPORT) || (EPFNOSUPPORT != ENOPROTOOPT))
    case ENOPROTOOPT: return "bad protocol option";
#endif
#ifdef ENOSPC
    case ENOSPC: return "no space left on device";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
    case ENOSR: return "out of stream resources";
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
752
753
754
755
756
757
758



759
760
761
762
763
764
765







-
-
-







#endif
#ifdef ENOTBLK
    case ENOTBLK: return "block device required";
#endif
#ifdef ENOTCONN
    case ENOTCONN: return "socket is not connected";
#endif
#ifdef ENOTRECOVERABLE
    case ENOTRECOVERABLE: return "state not recoverable";
#endif
#ifdef ENOTDIR
    case ENOTDIR: return "not a directory";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
    case ENOTEMPTY: return "directory not empty";
#endif
#ifdef ENOTNAM
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
779
780
781
782
783
784
785



786
787
788



789
790
791
792
793
794
795







-
-
-



-
-
-







#endif
#ifdef ENXIO
    case ENXIO: return "no such device or address";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
    case EOPNOTSUPP: return "operation not supported on socket";
#endif
#ifdef EOTHER
    case EOTHER: return "other error";
#endif
#if defined(EOVERFLOW) && (!defined(EFBIG) || (EOVERFLOW != EFBIG)) && (!defined(EINVAL) || (EOVERFLOW != EINVAL))
    case EOVERFLOW: return "file too big";
#endif
#ifdef EOWNERDEAD
    case EOWNERDEAD: return "owner died";
#endif
#ifdef EPERM
    case EPERM: return "not owner";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
    case EPFNOSUPPORT: return "protocol family not supported";
#endif
#ifdef EPIPE
867
868
869
870
871
872
873
874

875
876
877
878
879
880
881
843
844
845
846
847
848
849

850
851
852
853
854
855
856
857







-
+







#ifdef ERPCMISMATCH
    case ERPCMISMATCH: return "RPC version is wrong";
#endif
#ifdef ERREMOTE
    case ERREMOTE: return "object is remote";
#endif
#ifdef ESHUTDOWN
    case ESHUTDOWN: return "cannot send after socket shutdown";
    case ESHUTDOWN: return "can't send after socket shutdown";
#endif
#ifdef ESOCKTNOSUPPORT
    case ESOCKTNOSUPPORT: return "socket type not supported";
#endif
#ifdef ESPIPE
    case ESPIPE: return "invalid seek";
#endif
894
895
896
897
898
899
900
901

902
903
904
905
906
907
908
870
871
872
873
874
875
876

877
878
879
880
881
882
883
884







-
+







#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
    case ETIME: return "timer expired";
#endif
#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
    case ETIMEDOUT: return "connection timed out";
#endif
#ifdef ETOOMANYREFS
    case ETOOMANYREFS: return "too many references: cannot splice";
    case ETOOMANYREFS: return "too many references: can't splice";
#endif
#ifdef ETXTBSY
    case ETXTBSY: return "text file or pseudo-device busy";
#endif
#ifdef EUCLEAN
    case EUCLEAN: return "structure needs cleaning";
#endif
947
948
949
950
951
952
953
954

955
956
957
958
959
960
961
923
924
925
926
927
928
929

930
931
932
933
934
935
936
937







-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
CONST char *
Tcl_SignalId(
     int sig)			/* Number of signal. */
{
    switch (sig) {
#ifdef SIGABRT
    case SIGABRT: return "SIGABRT";
#endif
1081
1082
1083
1084
1085
1086
1087
1088

1089
1090
1091
1092
1093
1094
1095
1057
1058
1059
1060
1061
1062
1063

1064
1065
1066
1067
1068
1069
1070
1071







-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
CONST char *
Tcl_SignalMsg(
     int sig)			/* Number of signal. */
{
    switch (sig) {
#ifdef SIGABRT
    case SIGABRT: return "SIGABRT";
#endif

Changes to generic/tclPreserve.c.

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
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







-
+














-
+

-
+













-
+









-
+



















+





-
-
-
-
+
+
+
+







 * The following data structure is used to keep track of all the Tcl_Preserve
 * calls that are still in effect. It grows as needed to accommodate any
 * number of calls in effect.
 */

typedef struct {
    ClientData clientData;	/* Address of preserved block. */
    size_t refCount;		/* Number of Tcl_Preserve calls in effect for
    int refCount;		/* Number of Tcl_Preserve calls in effect for
				 * block. */
    int mustFree;		/* Non-zero means Tcl_EventuallyFree was
				 * called while a Tcl_Preserve call was in
				 * effect, so the structure must be freed when
				 * refCount becomes zero. */
    Tcl_FreeProc *freeProc;	/* Function to call to free. */
} Reference;

/*
 * Global data structures used to hold the list of preserved data references.
 * These variables are protected by "preserveMutex".
 */

static Reference *refArray = NULL;	/* First in array of references. */
static size_t spaceAvl = 0;	/* Total number of structures available at
static int spaceAvl = 0;	/* Total number of structures available at
				 * *firstRefPtr. */
static size_t inUse = 0;		/* Count of structures currently in use in
static int inUse = 0;		/* Count of structures currently in use in
				 * refArray. */
TCL_DECLARE_MUTEX(preserveMutex)/* To protect the above statics */

#define INITIAL_SIZE	2	/* Initial number of reference slots to make */

/*
 * The following data structure is used to keep track of whether an arbitrary
 * block of memory has been deleted. This is used by the TclHandle code to
 * avoid the more time-expensive algorithm of Tcl_Preserve(). This mechanism
 * is mainly used when we have lots of references to a few big, expensive
 * objects that we don't want to live any longer than necessary.
 */

typedef struct {
typedef struct HandleStruct {
    void *ptr;			/* Pointer to the memory block being tracked.
				 * This field will become NULL when the memory
				 * block is deleted. This field must be the
				 * first in the structure. */
#ifdef TCL_MEM_DEBUG
    void *ptr2;			/* Backup copy of the above pointer used to
				 * ensure that the contents of the handle are
				 * not changed by anyone else. */
#endif
    size_t refCount;		/* Number of TclHandlePreserve() calls in
    int refCount;		/* Number of TclHandlePreserve() calls in
				 * effect on this handle. */
} HandleStruct;

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizePreserve --
 *
 *	Called during exit processing to clean up the reference array.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees the storage of the reference array.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
void
TclFinalizePreserve(void)
{
    Tcl_MutexLock(&preserveMutex);
    if (spaceAvl != 0) {
	Tcl_Free(refArray);
	refArray = NULL;
	inUse = 0;
	spaceAvl = 0;
        ckfree((char *) refArray);
        refArray = NULL;
        inUse = 0;
        spaceAvl = 0;
    }
    Tcl_MutexUnlock(&preserveMutex);
}

/*
 *----------------------------------------------------------------------
 *
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131







-
+







 */

void
Tcl_Preserve(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;
    int i;

    /*
     * See if there is already a reference for this pointer. If so, just
     * increment its reference count.
     */

    Tcl_MutexLock(&preserveMutex);
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
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







+
-
+










-
+







    /*
     * Make a reference array if it doesn't already exist, or make it bigger
     * if it is full.
     */

    if (inUse == spaceAvl) {
	spaceAvl = spaceAvl ? 2*spaceAvl : INITIAL_SIZE;
	refArray = (Reference *) ckrealloc((char *) refArray,
	refArray = (Reference *)Tcl_Realloc(refArray, spaceAvl * sizeof(Reference));
		spaceAvl * sizeof(Reference));
    }

    /*
     * Make a new entry for the new reference.
     */

    refPtr = &refArray[inUse];
    refPtr->clientData = clientData;
    refPtr->refCount = 1;
    refPtr->mustFree = 0;
    refPtr->freeProc = 0;
    refPtr->freeProc = TCL_STATIC;
    inUse += 1;
    Tcl_MutexUnlock(&preserveMutex);
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+










-
+







 */

void
Tcl_Release(
    ClientData clientData)	/* Pointer to malloc'ed block of memory. */
{
    Reference *refPtr;
    size_t i;
    int i;

    Tcl_MutexLock(&preserveMutex);
    for (i=0, refPtr=refArray ; i<inUse ; i++, refPtr++) {
	int mustFree;
	Tcl_FreeProc *freeProc;

	if (refPtr->clientData != clientData) {
	    continue;
	}

	if (refPtr->refCount-- > 1) {
	if (--refPtr->refCount != 0) {
	    Tcl_MutexUnlock(&preserveMutex);
	    return;
	}

	/*
	 * Must remove information from the slot before calling freeProc to
	 * avoid reentrancy problems if the freeProc calls Tcl_Preserve on the
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
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







-
+

-
+










-
+







	 * Only then should we dabble around with potentially-slow memory
	 * managers...
	 */

	Tcl_MutexUnlock(&preserveMutex);
	if (mustFree) {
	    if (freeProc == TCL_DYNAMIC) {
		Tcl_Free(clientData);
		ckfree((char *) clientData);
	    } else {
		freeProc((char *)clientData);
		(*freeProc)((char *) clientData);
	    }
	}
	return;
    }
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * Reference not found. This is a bug in the caller.
     */

    Tcl_Panic("Tcl_Release couldn't find reference for %p", clientData);
    Tcl_Panic("Tcl_Release couldn't find reference for 0x%x", PTR2UINT(clientData));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_EventuallyFree --
 *
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
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







-
+












-
-
-
+
+
+
+


-
+








-
+

-
+








void
Tcl_EventuallyFree(
    ClientData clientData,	/* Pointer to malloc'ed block of memory. */
    Tcl_FreeProc *freeProc)	/* Function to actually do free. */
{
    Reference *refPtr;
    size_t i;
    int i;

    /*
     * See if there is a reference for this pointer. If so, set its "mustFree"
     * flag (the flag had better not be set already!).
     */

    Tcl_MutexLock(&preserveMutex);
    for (i = 0, refPtr = refArray; i < inUse; i++, refPtr++) {
	if (refPtr->clientData != clientData) {
	    continue;
	}
	if (refPtr->mustFree) {
	    Tcl_Panic("Tcl_EventuallyFree called twice for %p", clientData);
	}
	refPtr->mustFree = 1;
	    Tcl_Panic("Tcl_EventuallyFree called twice for 0x%x",
		    PTR2UINT(clientData));
        }
        refPtr->mustFree = 1;
	refPtr->freeProc = freeProc;
	Tcl_MutexUnlock(&preserveMutex);
	return;
        return;
    }
    Tcl_MutexUnlock(&preserveMutex);

    /*
     * No reference for this block.  Free it now.
     */

    if (freeProc == TCL_DYNAMIC) {
	Tcl_Free(clientData);
	ckfree((char *) clientData);
    } else {
	freeProc((char *)clientData);
	(*freeProc)((char *)clientData);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandleCreate --
322
323
324
325
326
327
328
329

330

331
332
333
334
335
336
337
325
326
327
328
329
330
331

332
333
334
335
336
337
338
339
340
341







-
+

+








TclHandle
TclHandleCreate(
    void *ptr)			/* Pointer to an arbitrary block of memory to
				 * be tracked for deletion. Must not be
				 * NULL. */
{
    HandleStruct *handlePtr = (HandleStruct *)Tcl_Alloc(sizeof(HandleStruct));
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) ckalloc(sizeof(HandleStruct));
    handlePtr->ptr = ptr;
#ifdef TCL_MEM_DEBUG
    handlePtr->ptr2 = ptr;
#endif
    handlePtr->refCount = 0;
    return (TclHandle) handlePtr;
}
363
364
365
366
367
368
369
370

371
372
373

374
375
376
377
378
379

380
381
382
383
384
385
386
367
368
369
370
371
372
373

374
375
376

377
378
379
380
381
382

383
384
385
386
387
388
389
390







-
+


-
+





-
+







				 * dereferencing it will give NULL. */
{
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
    if (handlePtr->refCount == 0x61616161) {
	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
    }
    if (handlePtr->ptr2 != handlePtr->ptr) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->ptr = NULL;
    if (handlePtr->refCount == 0) {
	Tcl_Free(handlePtr);
	ckfree((char *) handlePtr);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclHandlePreserve --
406
407
408
409
410
411
412
413

414
415
416

417
418
419
420
421
422
423
410
411
412
413
414
415
416

417
418
419

420
421
422
423
424
425
426
427







-
+


-
+







				 * referenced by this handle. */
{
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
    if (handlePtr->refCount == 0x61616161) {
	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
    }
    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->refCount++;

    return handle;
}
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
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







-
+


-
+



+
-
-
+
+










				 * referenced by this handle. */
{
    HandleStruct *handlePtr;

    handlePtr = (HandleStruct *) handle;
#ifdef TCL_MEM_DEBUG
    if (handlePtr->refCount == 0x61616161) {
	Tcl_Panic("using previously disposed TclHandle %p", handlePtr);
	Tcl_Panic("using previously disposed TclHandle %x", handlePtr);
    }
    if ((handlePtr->ptr != NULL) && (handlePtr->ptr != handlePtr->ptr2)) {
	Tcl_Panic("someone has changed the block referenced by the handle %p\nfrom %p to %p",
	Tcl_Panic("someone has changed the block referenced by the handle %x\nfrom %x to %x",
		handlePtr, handlePtr->ptr2, handlePtr->ptr);
    }
#endif
    handlePtr->refCount--;
    if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
	Tcl_Free(handlePtr);
    if ((handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
	ckfree((char *) handlePtr);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclProc.c.

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
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







-
-
-
-
-
-
-
-
-
-
-








-
+
+


-
-
+
+
+
+
+


-
+





-
-
-
-
+
+
+
+





-
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
+
+





-
+










-
+


-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















+


-
+


-
+

-
+

-
-
+
+


+












-
-
-
+
+
+


-
-
+
+
-
-


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







-
-
+
+

-
+




+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+


















-
+





-
+

+

+







 *
 * 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 "tclCompile.h"
#include <assert.h>

/*
 * Variables that are part of the [apply] command implementation and which
 * have to be passed to the other side of the NRE call.
 */

typedef struct {
    Command cmd;
    ExtraFrameInfo efi;
} ApplyExtraData;

/*
 * Prototypes for static functions in this file
 */

static void		DupLambdaInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static void		FreeLambdaInternalRep(Tcl_Obj *objPtr);
static int		InitArgsAndLocals(Tcl_Interp *interp, int skip);
static int		InitArgsAndLocals(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj, int skip);
static void		InitResolvedLocals(Tcl_Interp *interp,
			    ByteCode *codePtr, Var *defPtr,
			    Namespace *nsPtr);
static void		InitLocalCache(Proc *procPtr);
	                    Namespace *nsPtr);
static void             InitLocalCache(Proc *procPtr);
static int		PushProcCallFrame(ClientData clientData,
			    register Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[], int isLambda);
static void		ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
static void		ProcBodyFree(Tcl_Obj *objPtr);
static int		ProcWrongNumArgs(Tcl_Interp *interp, int skip);
static int              ProcWrongNumArgs(Tcl_Interp *interp, int skip);
static void		MakeProcError(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static void		MakeLambdaError(Tcl_Interp *interp,
			    Tcl_Obj *procNameObj);
static int		SetLambdaFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

static Tcl_NRPostProc ApplyNR2;
static Tcl_NRPostProc InterpProcNR2;
static Tcl_NRPostProc Uplevel_Callback;
static int		ProcCompileProc(Tcl_Interp *interp, Proc *procPtr,
			    Tcl_Obj *bodyPtr, Namespace *nsPtr,
			    CONST char *description, CONST char *procName,
			    Proc **procPtrPtr);

/*
 * The ProcBodyObjType type
 */

const Tcl_ObjType tclProcBodyType = {
Tcl_ObjType tclProcBodyType = {
    "procbody",			/* name for this type */
    ProcBodyFree,		/* FreeInternalRep function */
    ProcBodyDup,		/* DupInternalRep function */
    NULL,			/* UpdateString function; Tcl_GetString and
				 * Tcl_GetStringFromObj should panic
				 * instead. */
    NULL			/* SetFromAny function; Tcl_ConvertToType
				 * should panic instead. */
};

#define ProcSetIntRep(objPtr, procPtr)					\
    do {								\
	Tcl_ObjIntRep ir;						\
	(procPtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir);		\
    } while (0)

#define ProcGetIntRep(objPtr, procPtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &tclProcBodyType);		\
	(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)

/*
 * The [upvar]/[uplevel] level reference type. Uses the longValue field
 * The [upvar]/[uplevel] level reference type. Uses the twoPtrValue field,
 * to remember the integer value of a parsed #<integer> format.
 * encoding the type of level reference in ptr1 and the actual parsed out
 * offset in ptr2.
 *
 * Uses the default behaviour throughout, and never disposes of the string
 * rep; it's just a cache type.
 */

static const Tcl_ObjType levelReferenceType = {
static Tcl_ObjType levelReferenceType = {
    "levelReference",
    NULL, NULL, NULL, NULL
};

/*
 * The type of lambdas. Note that every lambda will *always* have a string
 * representation.
 *
 * Internally, ptr1 is a pointer to a Proc instance that is not bound to a
 * command name, and ptr2 is a pointer to the namespace that the Proc instance
 * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
 * will execute within.
 */

static const Tcl_ObjType lambdaType = {
static Tcl_ObjType lambdaType = {
    "lambdaExpr",		/* name */
    FreeLambdaInternalRep,	/* freeIntRepProc */
    DupLambdaInternalRep,	/* dupIntRepProc */
    NULL,			/* updateStringProc */
    SetLambdaFromAny		/* setFromAnyProc */
};

#define LambdaSetIntRep(objPtr, procPtr, nsObjPtr)			\
    do {								\
	Tcl_ObjIntRep ir;						\
	ir.twoPtrValue.ptr1 = (procPtr);				\
	ir.twoPtrValue.ptr2 = (nsObjPtr);				\
	Tcl_IncrRefCount((nsObjPtr));					\
	Tcl_StoreIntRep((objPtr), &lambdaType, &ir);			\
    } while (0)

#define LambdaGetIntRep(objPtr, procPtr, nsObjPtr)			\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &lambdaType);			\
	(procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_ProcObjCmd --
 *
 *	This object-based function is invoked to process the "proc" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	A new procedure gets created.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ProcObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;
    Proc *procPtr;
    const char *procName;
    const char *simpleName, *procArgs, *procBody;
    char *fullName;
    CONST char *procName, *procArgs, *procBody;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_Command cmd;
    Tcl_DString ds;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "name args body");
	return TCL_ERROR;
    }

    /*
     * Determine the namespace where the procedure should reside. Unless the
     * command name includes namespace qualifiers, this will be the current
     * namespace.
     */

    procName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, procName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &simpleName);
    fullName = TclGetString(objv[1]);
    TclGetNamespaceForQualName(interp, fullName, NULL, 0,
	    &nsPtr, &altNsPtr, &cxtNsPtr, &procName);

    if (nsPtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": unknown namespace",
	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
		"\": unknown namespace", NULL);
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
	return TCL_ERROR;
    }
    if (simpleName == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't create procedure \"%s\": bad procedure name",
		procName));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", NULL);
    if (procName == NULL) {
	Tcl_AppendResult(interp, "can't create procedure \"", fullName,
		"\": bad procedure name", NULL);
	return TCL_ERROR;
    }
    if ((nsPtr != iPtr->globalNsPtr)
	    && (procName != NULL) && (procName[0] == ':')) {
	Tcl_AppendResult(interp, "can't create procedure \"", procName,
		"\" in non-global namespace with name starting with \":\"",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Create the data structure to represent the procedure.
     */

    if (TclCreateProc(interp, /*ignored nsPtr*/ NULL, simpleName, objv[2],
	    objv[3], &procPtr) != TCL_OK) {
    if (TclCreateProc(interp, nsPtr, procName, objv[2], objv[3],
	    &procPtr) != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (creating proc \"");
	Tcl_AddErrorInfo(interp, simpleName);
	Tcl_AddErrorInfo(interp, procName);
	Tcl_AddErrorInfo(interp, "\")");
	return TCL_ERROR;
    }

    /*
     * Now create a command for the procedure. This will initially be in the
     * current namespace unless the procedure's name included namespace
     * qualifiers. To create the new command in the right namespace, we
     * generate a fully qualified name for it.
     */
    cmd = TclNRCreateCommandInNs(interp, simpleName, (Tcl_Namespace *) nsPtr,
	TclObjInterpProc, TclNRInterpProc, procPtr, TclProcDeleteProc);

    Tcl_DStringInit(&ds);
    if (nsPtr != iPtr->globalNsPtr) {
	Tcl_DStringAppend(&ds, nsPtr->fullName, -1);
	Tcl_DStringAppend(&ds, "::", 2);
    }
    Tcl_DStringAppend(&ds, procName, -1);

    cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&ds),
	    TclObjInterpProc, (ClientData) procPtr, TclProcDeleteProc);

    Tcl_DStringFree(&ds);

    /*
     * Now initialize the new procedure's cmdPtr field. This will be used
     * later when the procedure is called to determine what namespace the
     * procedure will run in. This will be different than the current
     * namespace if the proc was renamed into a different namespace.
     */

    procPtr->cmdPtr = (Command *) cmd;

    /*
     * TIP #280: Remember the line the procedure body is starting on. In a
     * bytecode context we ask the engine to provide us with the necessary
     * information. This is for the initialization of the byte code compiler
     * when the body is used for the first time.
     *
     * This code is nearly identical to the #280 code in SetLambdaFromAny, see
     * this file. The differences are the different index of the body in the
     * line array of the context, and the lambda code requires some special
     * line array of the context, and the lamdba code requires some special
     * processing. Find a way to factor the common elements into a single
     * function.
     */

    if (iPtr->cmdFramePtr) {
	CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame *contextPtr;

	contextPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
	*contextPtr = *iPtr->cmdFramePtr;

	if (contextPtr->type == TCL_LOCATION_BC) {
	    /*
	     * Retrieve source information from the bytecode, if possible. If
	     * the information is retrieved successfully, context.type will be
	     * TCL_LOCATION_SOURCE and the reference held by
	     * context.data.eval.path will be counted.
	     */
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
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







-
-
+
+



-
+








-
-
+
+

-
+
-


-
+





-
+





-
+

-
+





-
-
+
+







	     * We can account for source location within a proc only if the
	     * proc body was not created by substitution.
	     */

	    if (contextPtr->line
		    && (contextPtr->nline >= 4) && (contextPtr->line[3] >= 0)) {
		int isNew;
		Tcl_HashEntry *hePtr;
		CmdFrame *cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame));
		Tcl_HashEntry* hePtr;
		CmdFrame *cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
		cfPtr->line = (int *) ckalloc(sizeof(int));
		cfPtr->line[0] = contextPtr->line[3];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd = NULL;
		cfPtr->len = 0;
		cfPtr->cmd.str.cmd = NULL;
		cfPtr->cmd.str.len = 0;

		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr,
		hePtr = Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr, &isNew);
			procPtr, &isNew);
		if (!isNew) {
		    /*
		     * Get the old command frame and release it. See also
		     * Get the old command frame and release it.  See also
		     * TclProcCleanupProc in this file. Currently it seems as
		     * if only the procbodytest::proc command of the testsuite
		     * is able to trigger this situation.
		     */

		    CmdFrame *cfOldPtr = (CmdFrame *)Tcl_GetHashValue(hePtr);
		    CmdFrame* cfOldPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);

		    if (cfOldPtr->type == TCL_LOCATION_SOURCE) {
			Tcl_DecrRefCount(cfOldPtr->data.eval.path);
			cfOldPtr->data.eval.path = NULL;
		    }
		    Tcl_Free(cfOldPtr->line);
		    ckfree((char *) cfOldPtr->line);
		    cfOldPtr->line = NULL;
		    Tcl_Free(cfOldPtr);
		    ckfree((char *) cfOldPtr);
		}
		Tcl_SetHashValue(hePtr, cfPtr);
	    }

	    /*
	     * 'contextPtr' is going out of scope; account for the reference
	     * that it's holding to the path name.
	     * 'contextPtr' is going out of scope; account for the reference that
	     * it's holding to the path name.
	     */

	    Tcl_DecrRefCount(contextPtr->data.eval.path);
	    contextPtr->data.eval.path = NULL;
	}
	TclStackFree(interp, contextPtr);
    }
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
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







-
+













-
+







    procArgs = TclGetString(objv[2]);

    while (*procArgs == ' ') {
	procArgs++;
    }

    if ((procArgs[0] == 'a') && (strncmp(procArgs, "args", 4) == 0)) {
	size_t numBytes;
	int numBytes;

	procArgs +=4;
	while (*procArgs != '\0') {
	    if (*procArgs != ' ') {
		goto done;
	    }
	    procArgs++;
	}

	/*
	 * The argument list is just "args"; check the body
	 */

	procBody = TclGetStringFromObj(objv[3], &numBytes);
	procBody = Tcl_GetStringFromObj(objv[3], &numBytes);
	if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
	    goto done;
	}

	/*
	 * The body is just spaces: link the compileProc
	 */
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
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

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
611


612
613
614

615
616
617


618
619
620
621
622
623
624
625
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
686
687
688
689
690
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
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
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


611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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







-
-
+
+





+

-
-
-
-
+
+
+
+
+


-
+
-












+




















-
-
-
+










-
+










-
+














+
+


+
-
+










-
-









-
-
+
-
-
+





-
+





+
-
-
-
+
+
+
-
-
-
-


-
+
-
-
+
+
-
-



-
-
+
+
+
+
+
+
+




-
+
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
+
+


-
+
-
-
-
-
+
+
+
-
-
-
+


-
+















-
+







-
+
-








-
-
-
+
+
+

-
-
+
+
-
-
-
+
+
-
-
-
+
-
-
-
+
+

















-
-
+
+
+













-
+
+




-
+



-
+



+
+



+











-
-
+
+
+


-
+

-
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

int
TclCreateProc(
    Tcl_Interp *interp,		/* Interpreter containing proc. */
    TCL_UNUSED(Namespace *) /*nsPtr*/,
    const char *procName,	/* Unqualified name of this proc. */
    Namespace *nsPtr,		/* Namespace containing this proc. */
    CONST char *procName,	/* Unqualified name of this proc. */
    Tcl_Obj *argsPtr,		/* Description of arguments. */
    Tcl_Obj *bodyPtr,		/* Command body. */
    Proc **procPtrPtr)		/* Returns: pointer to proc data. */
{
    Interp *iPtr = (Interp *) interp;
    CONST char **argArray = NULL;

    Proc *procPtr = NULL;
    int i, result, numArgs;
    CompiledLocal *localPtr = NULL;
    Tcl_Obj **argArray;
    register Proc *procPtr;
    int i, length, result, numArgs;
    CONST char *args, *bytes, *p;
    register CompiledLocal *localPtr = NULL;
    Tcl_Obj *defPtr;
    int precompiled = 0;

    ProcGetIntRep(bodyPtr, procPtr);
    if (bodyPtr->typePtr == &tclProcBodyType) {
    if (procPtr != NULL) {
	/*
	 * Because the body is a TclProProcBody, the actual body is already
	 * compiled, and it is not shared with anyone else, so it's OK not to
	 * unshare it (as a matter of fact, it is bad to unshare it, because
	 * there may be no source code).
	 *
	 * We don't create and initialize a Proc structure for the procedure;
	 * rather, we use what is in the body object. We increment the ref
	 * count of the Proc struct since the command (soon to be created)
	 * will be holding a reference to it.
	 */

	procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
	procPtr->iPtr = iPtr;
	procPtr->refCount++;
	precompiled = 1;
    } else {
	/*
	 * If the procedure's body object is shared because its string value
	 * is identical to, e.g., the body of another procedure, we must
	 * create a private copy for this procedure to use. Such sharing of
	 * procedure bodies is rare but can cause problems. A procedure body
	 * is compiled in a context that includes the number of "slots"
	 * allocated by the compiler for local variables. There is a local
	 * variable slot for each formal parameter (the
	 * "procPtr->numCompiledLocals = numArgs" assignment below). This
	 * means that the same code can not be shared by two procedures that
	 * have a different number of arguments, even if their bodies are
	 * identical. Note that we don't use Tcl_DuplicateObj since we would
	 * not want any bytecode internal representation.
	 */

	if (Tcl_IsShared(bodyPtr)) {
	    const char *bytes;
	    size_t length;
	    Tcl_Obj *sharedBodyPtr = bodyPtr;
	    Tcl_Obj* sharedBodyPtr = bodyPtr;

	    bytes = TclGetStringFromObj(bodyPtr, &length);
	    bodyPtr = Tcl_NewStringObj(bytes, length);

	    /*
	     * TIP #280.
	     * Ensure that the continuation line data for the original body is
	     * not lost and applies to the new body as well.
	     */

	    TclContinuationsCopy(bodyPtr, sharedBodyPtr);
	    TclContinuationsCopy (bodyPtr, sharedBodyPtr);
	}

	/*
	 * Create and initialize a Proc structure for the procedure. We
	 * increment the ref count of the procedure's body object since there
	 * will be a reference to it in the Proc structure.
	 */

	Tcl_IncrRefCount(bodyPtr);

	procPtr = (Proc *)Tcl_Alloc(sizeof(Proc));
	procPtr = (Proc *) ckalloc(sizeof(Proc));
	procPtr->iPtr = iPtr;
	procPtr->refCount = 1;
	procPtr->bodyPtr = bodyPtr;
	procPtr->numArgs = 0;	/* Actual argument count is set below. */
	procPtr->numCompiledLocals = 0;
	procPtr->firstLocalPtr = NULL;
	procPtr->lastLocalPtr = NULL;
    }

    /*
     * Break up the argument list into argument specifiers, then process each
     * argument specifier. If the body is precompiled, processing is limited
     * to checking that the parsed argument is consistent with the one stored
     * in the Proc.
     *
     * THIS FAILS IF THE ARG LIST OBJECT'S STRING REP CONTAINS NULS.
     */

    args = TclGetStringFromObj(argsPtr, &length);
    result = Tcl_ListObjGetElements(interp , argsPtr ,&numArgs ,&argArray);
    result = Tcl_SplitList(interp, args, &numArgs, &argArray);
    if (result != TCL_OK) {
	goto procError;
    }

    if (precompiled) {
	if (numArgs > procPtr->numArgs) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "procedure \"%s\": arg list contains %d entries, "
		    "precompiled header expects %d", procName, numArgs,
		    procPtr->numArgs));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "BYTECODELIES", NULL);
	    goto procError;
	}
	localPtr = procPtr->firstLocalPtr;
    } else {
	procPtr->numArgs = numArgs;
	procPtr->numCompiledLocals = numArgs;
    }

    for (i = 0; i < numArgs; i++) {
	const char *argname, *argnamei, *argnamelast;
	int fieldCount;
	int fieldCount, nameLength, valueLength;
	size_t nameLength;
	Tcl_Obj **fieldValues;
	CONST char **fieldValues;

	/*
	 * Now divide the specifier up into name and default.
	 */

	result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount,
	result = Tcl_SplitList(interp, argArray[i], &fieldCount,
		&fieldValues);
	if (result != TCL_OK) {
	    goto procError;
	}
	if (fieldCount > 2) {
	    ckfree((char *) fieldValues);
	    Tcl_Obj *errorObj = Tcl_NewStringObj(
		"too many fields in argument specifier \"", -1);
	    Tcl_AppendObjToObj(errorObj, argArray[i]);
	    Tcl_AppendResult(interp,
		    "too many fields in argument specifier \"",
		    argArray[i], "\"", NULL);
	    Tcl_AppendToObj(errorObj, "\"", -1);
	    Tcl_SetObjResult(interp, errorObj);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}
	if ((fieldCount == 0) || (fieldValues[0]->length == 0)) {
	if ((fieldCount == 0) || (*fieldValues[0] == 0)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "argument with no name", -1));
	    ckfree((char *) fieldValues);
	    Tcl_AppendResult(interp, "argument with no name", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		    "FORMALARGUMENTFORMAT", NULL);
	    goto procError;
	}

	argname = TclGetStringFromObj(fieldValues[0], &nameLength);

	nameLength = strlen(fieldValues[0]);
	if (fieldCount == 2) {
	    valueLength = strlen(fieldValues[1]);
	} else {
	    valueLength = 0;
	}

	/*
	 * Check that the formal parameter name is a scalar.
	 */

	argnamei = argname;
	p = fieldValues[0];
	argnamelast = (nameLength > 0) ? (argname + nameLength - 1) : argname;
	while (argnamei < argnamelast) {
	    if (*argnamei == '(') {
		if (*argnamelast == ')') { /* We have an array element. */
	while (*p != '\0') {
	    if (*p == '(') {
		CONST char *q = p;
		do {
		    q++;
		} while (*q != '\0');
		q--;
		if (*q == ')') {	/* We have an array element. */
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "formal parameter \"%s\" is an array element",
			    TclGetString(fieldValues[0])));
		    Tcl_AppendResult(interp, "formal parameter \"",
			    fieldValues[0],
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "FORMALARGUMENTFORMAT", NULL);
			    "\" is an array element", NULL);
		    ckfree((char *) fieldValues);
		    goto procError;
		}
	    } else if (*argnamei == ':' && *(argnamei+1) == ':') {
	    } else if ((*p == ':') && (*(p+1) == ':')) {
		Tcl_Obj *errorObj = Tcl_NewStringObj(
		    "formal parameter \"", -1);
		Tcl_AppendObjToObj(errorObj, fieldValues[0]);
		Tcl_AppendToObj(errorObj, "\" is not a simple name", -1);
		Tcl_AppendResult(interp, "formal parameter \"",
			fieldValues[0],
			"\" is not a simple name", NULL);
		Tcl_SetObjResult(interp, errorObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"FORMALARGUMENTFORMAT", NULL);
		ckfree((char *) fieldValues);
		goto procError;
	    }
	    argnamei++;
	    p++;
	}

	if (precompiled) {
	    /*
	     * Compare the parsed argument with the stored one. Note that the
	     * only flag value that makes sense at this point is VAR_ARGUMENT
	     * (its value was kept the same as pre VarReform to simplify
	     * tbcload's processing of older byetcodes).
	     *
	     * The only other flag vlaue that is important to retrieve from
	     * precompiled procs is VAR_TEMPORARY (also unchanged). It is
	     * needed later when retrieving the variable names.
	     */

	    if ((localPtr->nameLength != nameLength)
		    || (memcmp(localPtr->name, argname, nameLength) != 0)
		    || (strcmp(localPtr->name, fieldValues[0]))
		    || (localPtr->frameIndex != i)
		    || !(localPtr->flags & VAR_ARGUMENT)
		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"procedure \"%s\": formal parameter %d is "
			"inconsistent with precompiled body", procName, i));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
		ckfree((char *) fieldValues);
			"BYTECODELIES", NULL);
		goto procError;
	    }

	    /*
	     * Compare the default value if any.
	     */

	    if (localPtr->defValuePtr != NULL) {
		size_t tmpLength, valueLength;
		const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr, &tmpLength);
		const char *value = TclGetStringFromObj(fieldValues[1], &valueLength);
		int tmpLength;
		char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
			&tmpLength);

		if ((valueLength != tmpLength)
		     || memcmp(value, tmpPtr, tmpLength) != 0
		if ((valueLength != tmpLength) ||
			strncmp(fieldValues[1], tmpPtr, (size_t) tmpLength)) {
		) {
		    Tcl_Obj *errorObj = Tcl_ObjPrintf(
			    "procedure \"%s\": formal parameter \"", procName);
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "procedure \"%s\": formal parameter \"%s\" has "
		    Tcl_AppendObjToObj(errorObj, fieldValues[0]);
		    Tcl_AppendToObj(errorObj, "\" has "
			"default value inconsistent with precompiled body", -1);
			    "default value inconsistent with precompiled body",
		    Tcl_SetObjResult(interp, errorObj);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			    "BYTECODELIES", NULL);
			    procName, fieldValues[0]));
		    ckfree((char *) fieldValues);
		    goto procError;
		}
	    }
	    if ((i == numArgs - 1)
		    && (localPtr->nameLength == 4)
		    && (localPtr->name[0] == 'a')
		    && (strcmp(localPtr->name, "args") == 0)) {
		localPtr->flags |= VAR_IS_ARGS;
	    }

	    localPtr = localPtr->nextPtr;
	} else {
	    /*
	     * Allocate an entry in the runtime procedure frame's array of
	     * local variables for the argument.
	     */

	    localPtr = (CompiledLocal *)Tcl_Alloc(
		    offsetof(CompiledLocal, name) + fieldValues[0]->length + 1);
	    localPtr = (CompiledLocal *) ckalloc((unsigned)
		    (sizeof(CompiledLocal) - sizeof(localPtr->name)
			    + nameLength + 1));
	    if (procPtr->firstLocalPtr == NULL) {
		procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr;
	    } else {
		procPtr->lastLocalPtr->nextPtr = localPtr;
		procPtr->lastLocalPtr = localPtr;
	    }
	    localPtr->nextPtr = NULL;
	    localPtr->nameLength = nameLength;
	    localPtr->frameIndex = i;
	    localPtr->flags = VAR_ARGUMENT;
	    localPtr->resolveInfo = NULL;

	    if (fieldCount == 2) {
		localPtr->defValuePtr = fieldValues[1];
		localPtr->defValuePtr =
			Tcl_NewStringObj(fieldValues[1], valueLength);
		Tcl_IncrRefCount(localPtr->defValuePtr);
	    } else {
		localPtr->defValuePtr = NULL;
	    }
	    memcpy(localPtr->name, argname, fieldValues[0]->length + 1);
	    memcpy(localPtr->name, fieldValues[0], nameLength + 1);
	    if ((i == numArgs - 1)
		    && (localPtr->nameLength == 4)
		    && (localPtr->name[0] == 'a')
		    && (memcmp(localPtr->name, "args", 4) == 0)) {
		    && (strcmp(localPtr->name, "args") == 0)) {
		localPtr->flags |= VAR_IS_ARGS;
	    }
	}

	ckfree((char *) fieldValues);
    }

    *procPtrPtr = procPtr;
    ckfree((char *) argArray);
    return TCL_OK;

  procError:
    if (precompiled) {
	procPtr->refCount--;
    } else {
	Tcl_DecrRefCount(bodyPtr);
	while (procPtr->firstLocalPtr != NULL) {
	    localPtr = procPtr->firstLocalPtr;
	    procPtr->firstLocalPtr = localPtr->nextPtr;

	    if (localPtr->defValuePtr != NULL) {
		Tcl_DecrRefCount(localPtr->defValuePtr);
	    defPtr = localPtr->defValuePtr;
	    if (defPtr != NULL) {
		Tcl_DecrRefCount(defPtr);
	    }

	    Tcl_Free(localPtr);
	    ckfree((char *) localPtr);
	}
	Tcl_Free(procPtr);
	ckfree((char *) procPtr);
    }
    if (argArray != NULL) {
	ckfree((char *) argArray);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
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
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
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
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
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







-
+



+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














-
+



















-
+

-
-
+
+
-





-
+

+
+
+
+
+
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
-

-
-
+
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
-
-
-
+
-
-
+
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+




















-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+


-
+

-
-
-
-
-
-
-
-
-
-
-
-
+
-
-


-


-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
+



-
+
-
-














-
+


-
-
+
+

+
+







+
+

+

+
+
+
-
-
-
-
+
+
+
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

int
TclGetFrame(
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    const char *name,		/* String describing frame. */
    CONST char *name,		/* String describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    CallFrame *framePtr;

    /*
     * Parse string to figure out which level number to go to.
     */

	int result;
	Tcl_Obj obj;

	obj.bytes = (char *) name;
	obj.length = strlen(name);
	obj.typePtr = NULL;
	result = TclObjGetFrame(interp, &obj, framePtrPtr);
	TclFreeIntRep(&obj);
	return result;
    result = 1;
    curLevel = iPtr->varFramePtr->level;
    if (*name== '#') {
	if (Tcl_GetInt(NULL, name+1, &level) != TCL_OK || level < 0) {
	    goto levelError;
	}
    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
	if (Tcl_GetInt(NULL, name, &level) != TCL_OK) {
	    goto levelError;
	}
	level = curLevel - level;
    } else {
	/*
	 * (historical, TODO) If name does not contain a level (#0 or 1),
	 * TclGetFrame and Tcl_UpVar2 uses current level - 1
	 */
	level = curLevel - 1;
	result = 0;
	name = "1"; /* be more consistent with TclObjGetFrame (error at top - 1) */
    }

    /*
     * Figure out which frame to use, and return it to the caller.
     */

    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
	    framePtr = framePtr->callerVarPtr) {
	if (framePtr->level == level) {
	    break;
	}
    }
    if (framePtr == NULL) {
	goto levelError;
    }

    *framePtrPtr = framePtr;
    return result;

  levelError:
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjGetFrame --
 *
 *	Given a description of a procedure frame, such as the first argument
 *	to an "uplevel" or "upvar" command, locate the call frame for the
 *	appropriate level of procedure.
 *
 * Results:
 *	The return value is -1 if an error occurred in finding the frame (in
 *	this case an error message is left in the interp's result). 1 is
 *	returned if objPtr was either an int or an int preceded by "#" and
 *	returned if objPtr was either a number or a number preceded by "#" and
 *	it specified a valid frame. 0 is returned if objPtr isn't one of the
 *	two things above (in this case, the lookup acts as if objPtr were
 *	"1"). The variable pointed to by framePtrPtr is filled in with the
 *	address of the desired frame (unless an error occurs, in which case it
 *	isn't modified).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclObjGetFrame(
    Tcl_Interp *interp,		/* Interpreter in which to find frame. */
    Tcl_Obj *objPtr,		/* Object describing frame. */
    CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
				 * global frame indicated). */
{
    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;
    int curLevel, level, result;
    const Tcl_ObjIntRep *irPtr;
    const char *name = NULL;
    CallFrame *framePtr;
    CONST char *name = TclGetString(objPtr);
    Tcl_WideInt w;

    /*
     * Parse object to figure out which level number to go to.
     */

    result = 0;
    result = 1;
    curLevel = iPtr->varFramePtr->level;
    if (objPtr->typePtr == &levelReferenceType) {
	if (PTR2INT(objPtr->internalRep.twoPtrValue.ptr1)) {
	    level = curLevel - PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);
	} else {
	    level = PTR2INT(objPtr->internalRep.twoPtrValue.ptr2);

	}
    /*
     * Check for integer first, since that has potential to spare us
     * a generation of a stringrep.
     */

    if (objPtr == NULL) {
	/* Do nothing */
    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
	if (level < 0) {
	    goto levelError;
	}
	/* TODO: Consider skipping the typePtr checks */
    } else if (objPtr->typePtr == &tclIntType
#ifndef NO_WIDE_TYPE
	    || objPtr->typePtr == &tclWideIntType
#endif
	    ) {
	if (TclGetIntFromObj(NULL, objPtr, &level) != TCL_OK || level < 0) {
	Tcl_GetWideIntFromObj(NULL, objPtr, &w);
	if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
	    result = -1;
	} else {
	    level = curLevel - level;
	    goto levelError;
	    result = 1;
	}
    } else if ((irPtr = TclFetchIntRep(objPtr, &levelReferenceType))) {
	level = irPtr->wideValue;
	level = curLevel - level;
	result = 1;
    } else {
    } else if (*name == '#') {
	name = TclGetString(objPtr);
	if (name[0] == '#') {
	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
	if (Tcl_GetInt(NULL, name+1, &level) != TCL_OK || level < 0) {
		if (level < 0 || (level > 0 && name[1] == '-')) {
		    result = -1;
		} else {
	    goto levelError;
		    Tcl_ObjIntRep ir;

		    ir.wideValue = level;
	}

		    Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir);
		    result = 1;
		}
	    } else {
		result = -1;
	    }
	} else if (TclGetWideBitsFromObj(NULL, objPtr, &w) == TCL_OK) {
	    /*
	     * If this were an integer, we'd have succeeded already.
	/*
	 * Cache for future reference.
	 *
	 * TODO: Use the new ptrAndLongRep intrep
	 */

	TclFreeIntRep(objPtr);
	objPtr->typePtr = &levelReferenceType;
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 0;
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
	    return -1;
	}

	/*
	 * Cache for future reference.
	     * Docs say we have to treat this as a 'bad level'  error.
	     */
	 *
	 * TODO: Use the new ptrAndLongRep intrep
	 */
	    result = -1;
	}
    }

	TclFreeIntRep(objPtr);
	objPtr->typePtr = &levelReferenceType;
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) 1;
	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(level);
	level = curLevel - level;
    } else {
	/*
	 * Don't cache as the object *isn't* a level reference.
	 */

    if (result != -1) {
	/* if relative current level */
	if (result == 0) {
	level = curLevel - 1;
	result = 0;
	    if (!curLevel) {
		/* we are in top-level, so simply generate bad level */
		name = "1";
	name = "1";
		goto badLevel;
	    }
    }
	    level = curLevel - 1;
	}
	if (level >= 0) {

    /*
     * Figure out which frame to use, and return it to the caller.
     */

	    CallFrame *framePtr;
	    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
		    framePtr = framePtr->callerVarPtr) {
		if (framePtr->level == level) {
    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
	    framePtr = framePtr->callerVarPtr) {
	if (framePtr->level == level) {
		    *framePtrPtr = framePtr;
		    return result;
		}
	    }
	}
    }
badLevel:
	    break;
	}
    }
    if (framePtr == NULL) {
	goto levelError;
    }
    *framePtrPtr = framePtr;
    return result;

  levelError:
    if (name == NULL) {
	name = objPtr ? TclGetString(objPtr) : "1" ;
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, "bad level \"", name, "\"", NULL);
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UplevelObjCmd --
 *
 *	This object function is invoked to process the "uplevel" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
Uplevel_Callback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallFrame *savedVarFramePtr = (CallFrame *)data[0];

	/* ARGSUSED */
    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp)));
    }

    /*
     * Restore the variable frame, and return.
     */

    ((Interp *)interp)->varFramePtr = savedVarFramePtr;
    return result;
}

int
Tcl_UplevelObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRUplevelObjCmd, clientData, objc, objv);
}

int
TclNRUplevelObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;
    CmdFrame *invoker = NULL;
    int word = 0;
    int result;
    CallFrame *savedVarFramePtr, *framePtr;
    Tcl_Obj *objPtr;

    if (objc < 2) {
    /* to do
    *    simplify things by interpreting the argument as a command when there
    *    is only one argument.  This requires a TIP since currently a single
    *    argument is interpreted as a level indicator if possible.
    */
    uplevelSyntax:
	Tcl_WrongNumArgs(interp, 1, objv, "?level? command ?arg ...?");
	return TCL_ERROR;
    } else if (!TclHasStringRep(objv[1]) && objc == 2) {
	int status ,llength;
	status = Tcl_ListObjLength(interp, objv[1], &llength);
	if (status == TCL_OK && llength > 1) {
	    /* the first argument can't interpreted as a level. Avoid
	     * generating a string representation of the script. */
	    result = TclGetFrame(interp, "1", &framePtr);
	    if (result == -1) {
		return TCL_ERROR;
	    }
	    objc -= 1;
	    objv += 1;
	    goto havelevel;
	}
    }

    /*
     * Find the level to use for executing the command.
     */

    result = TclObjGetFrame(interp, objv[1], &framePtr);
    if (result == -1) {
	return TCL_ERROR;
    }
    objc -= result + 1;
    objc -= (result+1);
    if (objc == 0) {
	goto uplevelSyntax;
    }
    objv += result + 1;
    objv += (result+1);

    havelevel:

    /*
     * Modify the interpreter state to execute in the given frame.
     */

    savedVarFramePtr = iPtr->varFramePtr;
    iPtr->varFramePtr = framePtr;

    /*
     * Execute the residual arguments as a command.
     */

    if (objc == 1) {
	/*
	 * TIP #280. Make actual argument location available to eval'd script
	 * TIP #280. Make argument location available to eval'd script
	 */

	TclArgumentGet(interp, objv[0], &invoker, &word);
	objPtr = objv[0];
	CmdFrame* invoker = NULL;
	int word          = 0;

	TclArgumentGet (interp, objv[0], &invoker, &word);
	result = TclEvalObjEx(interp, objv[0], 0, invoker, word);
    } else {
	/*
	 * More than one argument: concatenate them together with spaces
	 * between, then evaluate the result. Tcl_EvalObjEx will delete the
	 * object when it decrements its refcount after eval'ing it.
	 */

	Tcl_Obj *objPtr;

	objPtr = Tcl_ConcatObj(objc, objv);
	result = Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_DIRECT);
    }
    if (result == TCL_ERROR) {
	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		"\n    (\"uplevel\" body line %d)", interp->errorLine));

    TclNRAddCallback(interp, Uplevel_Callback, savedVarFramePtr, NULL, NULL,
	    NULL);
    return TclNREvalObjEx(interp, objPtr, 0, invoker, word);
    }

    /*
     * Restore the variable frame, and return.
     */

    iPtr->varFramePtr = savedVarFramePtr;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFindProc --
 *
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
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







-
+


+








+
+
+
+
+
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

Proc *
TclFindProc(
    Interp *iPtr,		/* Interpreter in which to look. */
    const char *procName)	/* Name of desired procedure. */
    CONST char *procName)	/* Name of desired procedure. */
{
    Tcl_Command cmd;
    Tcl_Command origCmd;
    Command *cmdPtr;

    cmd = Tcl_FindCommand((Tcl_Interp *) iPtr, procName, NULL, /*flags*/ 0);
    if (cmd == (Tcl_Command) NULL) {
	return NULL;
    }
    cmdPtr = (Command *) cmd;

    origCmd = TclGetOriginalCommand(cmd);
    if (origCmd != NULL) {
	cmdPtr = (Command *) origCmd;
    }
    if (cmdPtr->objProc != TclObjInterpProc) {
    return TclIsProc(cmdPtr);
	return NULL;
    }
    return (Proc *) cmdPtr->objClientData;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIsProc --
 *
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
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
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







-
+

+



-
-
+
+

-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
-


-
+
+









-
-
+
+




+
+
+

+
+
+



-
-
+
-
-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

Proc *
TclIsProc(
    Command *cmdPtr)		/* Command to test. */
{
    Tcl_Command origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
    Tcl_Command origCmd;

    origCmd = TclGetOriginalCommand((Tcl_Command) cmdPtr);
    if (origCmd != NULL) {
	cmdPtr = (Command *) origCmd;
    }
    if (cmdPtr->deleteProc == TclProcDeleteProc) {
	return (Proc *)cmdPtr->objClientData;
    if (cmdPtr->objProc == TclObjInterpProc) {
	return (Proc *) cmdPtr->objClientData;
    }
    return NULL;
    return (Proc *) 0;
}

/*
 *----------------------------------------------------------------------
 *
 * InitArgsAndLocals --
 *
 *	This routine is invoked in order to initialize the arguments and other
 *	compiled locals table for a new call frame.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Allocates memory on the stack for the compiled local variables, the
 *	caller is responsible for freeing them. Initialises all variables. May
 *	invoke various name resolvers in order to determine which variables
 *	are being referenced at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
ProcWrongNumArgs(
    Tcl_Interp *interp,
    Tcl_Interp *interp, int skip)
    int skip)
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    register Proc *procPtr = framePtr->procPtr;
    register Var *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, i;
    Tcl_Obj **desiredObjs;
    const char *final = NULL;

    /*
     * Build up desired argument list for Tcl_WrongNumArgs
     */

    numArgs = framePtr->procPtr->numArgs;
    desiredObjs = (Tcl_Obj **)TclStackAlloc(interp,
	    sizeof(Tcl_Obj *) * (numArgs+1));
    desiredObjs = (Tcl_Obj **) TclStackAlloc(interp,
	    (int) sizeof(Tcl_Obj *) * (numArgs+1));

    if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
    } else {
	((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;

#ifdef AVOID_HACKS_FOR_ITCL
	desiredObjs[0] = framePtr->objv[skip-1];
#else
	desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
#endif /* AVOID_HACKS_FOR_ITCL */
    }
    Tcl_IncrRefCount(desiredObjs[0]);

    if (localCt > 0) {
	Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);

	for (i=1 ; i<=numArgs ; i++, defPtr++) {
	    Tcl_Obj *argObj;
	    Tcl_Obj *namePtr = localName(framePtr, i-1);
    for (i=1 ; i<=numArgs ; i++, defPtr++) {
	Tcl_Obj *argObj;
	Tcl_Obj *namePtr = localName(framePtr, i-1);

	    if (defPtr->value.objPtr != NULL) {
		TclNewObj(argObj);
		Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
	    } else if (defPtr->flags & VAR_IS_ARGS) {
		numArgs--;
		final = "?arg ...?";
		break;
	    } else {
		argObj = namePtr;
		Tcl_IncrRefCount(namePtr);
	    }
	    desiredObjs[i] = argObj;
	if (defPtr->value.objPtr != NULL) {
	    TclNewObj(argObj);
	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
	} else if (defPtr->flags & VAR_IS_ARGS) {
	    numArgs--;
	    final = "...";
	    break;
	} else {
	    argObj = namePtr;
	    Tcl_IncrRefCount(namePtr);
	}
	desiredObjs[i] = argObj;
	}
    }

    Tcl_ResetResult(interp);
    Tcl_WrongNumArgs(interp, numArgs+1, desiredObjs, final);

    for (i=0 ; i<=numArgs ; i++) {
	Tcl_DecrRefCount(desiredObjs[i]);
    }
    TclStackFree(interp, desiredObjs);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitCompiledLocals --
 *
 *	This routine is invoked in order to initialize the compiled locals
 *	table for a new call frame.
 *
 *	DEPRECATED: functionality has been inlined elsewhere; this function
 *	remains to insure binary compatibility with Itcl.
 *

 * Results:
 *	None.
 *
 * Side effects:
 *	May invoke various name resolvers in order to determine which
 *	variables are being referenced at runtime.
 *
 *----------------------------------------------------------------------
 */
void
TclInitCompiledLocals(
    Tcl_Interp *interp,		/* Current interpreter. */
    CallFrame *framePtr,	/* Call frame to initialize. */
    Namespace *nsPtr)		/* Pointer to current namespace. */
{
    Var *varPtr = framePtr->compiledLocals;
    Tcl_Obj *bodyPtr;
    ByteCode *codePtr;

    bodyPtr = framePtr->procPtr->bodyPtr;
    if (bodyPtr->typePtr != &tclByteCodeType) {
	Tcl_Panic("body object for proc attached to frame is not a byte code type");
    }
    codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;

    if (framePtr->numCompiledLocals) {
	if (!codePtr->localCachePtr) {
	    InitLocalCache(framePtr->procPtr) ;
	}
	framePtr->localCachePtr = codePtr->localCachePtr;
	framePtr->localCachePtr->refCount++;
    }

    InitResolvedLocals(interp, codePtr, varPtr, nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * InitResolvedLocals --
 *
 *	This routine is invoked in order to initialize the compiled locals
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



1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
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
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
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







+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
+












-
+








-
+













-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

-
+
-


-
+







-
+
-
-







-
-
-
+
+
+









-
-
+
+










-
+



-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+

+




-
-
-
+
+
+



-
-







    varNum = varPtr - iPtr->framePtr->compiledLocals;
    localPtr = iPtr->framePtr->procPtr->firstLocalPtr;
    while (varNum--) {
	localPtr = localPtr->nextPtr;
    }

    if (!(haveResolvers && (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS))) {
	/*
	 * Initialize the array of local variables stored in the call frame.
	 * Some variables may have special resolution rules. In that case, we
	 * call their "resolver" procs to get our hands on the variable, and
	 * we make the compiled local a link to the real variable.
	 */

	goto doInitResolvedLocals;
    doInitResolvedLocals:
	for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
	    varPtr->flags = 0;
	    varPtr->value.objPtr = NULL;

	    /*
	     * Now invoke the resolvers to determine the exact variables
	     * that should be used.
	     */

	    resVarInfo = localPtr->resolveInfo;
	    if (resVarInfo && resVarInfo->fetchProc) {
		Var *resolvedVarPtr = (Var *)
		    (*resVarInfo->fetchProc)(interp, resVarInfo);
		if (resolvedVarPtr) {
		    if (TclIsVarInHash(resolvedVarPtr)) {
			VarHashRefCount(resolvedVarPtr)++;
		    }
		    varPtr->flags = VAR_LINK;
		    varPtr->value.linkPtr = resolvedVarPtr;
		}
	    }
	}
	return;
    }

    /*
     * This is the first run after a recompile, or else the resolver epoch
     * has changed: update the resolver cache.
     */

    firstLocalPtr = localPtr;
    for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
	if (localPtr->resolveInfo) {
	    if (localPtr->resolveInfo->deleteProc) {
		localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
	    } else {
		Tcl_Free(localPtr->resolveInfo);
		ckfree((char *) localPtr->resolveInfo);
	    }
	    localPtr->resolveInfo = NULL;
	}
	localPtr->flags &= ~VAR_RESOLVED;

	if (haveResolvers &&
		!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
	    ResolverScheme *resPtr = iPtr->resolverPtr;
	    Tcl_ResolvedVarInfo *vinfo;
	    int result;

	    if (nsPtr->compiledVarResProc) {
		result = nsPtr->compiledVarResProc(nsPtr->interp,
		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
			localPtr->name, localPtr->nameLength,
			(Tcl_Namespace *) nsPtr, &vinfo);
	    } else {
		result = TCL_CONTINUE;
	    }

	    while ((result == TCL_CONTINUE) && resPtr) {
		if (resPtr->compiledVarResProc) {
		    result = resPtr->compiledVarResProc(nsPtr->interp,
		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
			    localPtr->name, localPtr->nameLength,
			    (Tcl_Namespace *) nsPtr, &vinfo);
		}
		resPtr = resPtr->nextPtr;
	    }
	    if (result == TCL_OK) {
		localPtr->resolveInfo = vinfo;
		localPtr->flags |= VAR_RESOLVED;
	    }
	}
    }
    localPtr = firstLocalPtr;
    codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;

    /*
     * Initialize the array of local variables stored in the call frame. Some
     * variables may have special resolution rules. In that case, we call
     * their "resolver" procs to get our hands on the variable, and we make
     * the compiled local a link to the real variable.
     */

  doInitResolvedLocals:
    goto doInitResolvedLocals;
    for (; localPtr != NULL; varPtr++, localPtr = localPtr->nextPtr) {
	varPtr->flags = 0;
	varPtr->value.objPtr = NULL;

}
	/*
	 * Now invoke the resolvers to determine the exact variables that
	 * should be used.
	 */

	resVarInfo = localPtr->resolveInfo;
	if (resVarInfo && resVarInfo->fetchProc) {
	    Var *resolvedVarPtr = (Var *)
		    resVarInfo->fetchProc(interp, resVarInfo);

	    if (resolvedVarPtr) {
		if (TclIsVarInHash(resolvedVarPtr)) {
		    VarHashRefCount(resolvedVarPtr)++;
		}
		varPtr->flags = VAR_LINK;
		varPtr->value.linkPtr = resolvedVarPtr;
	    }
	}
    }
}

void
TclFreeLocalCache(
    Tcl_Interp *interp,
    LocalCache *localCachePtr)
{
    int i;
    Tcl_Obj **namePtrPtr = &localCachePtr->varName0;

    for (i = 0; i < localCachePtr->numVars; i++, namePtrPtr++) {
	Tcl_Obj *objPtr = *namePtrPtr;

	/*
	 * Note that this can be called with interp==NULL, on interp
	 * deletion. In that case, the literal table and objects go away
	 * on their own.
	 */
	if (objPtr) {
	    /* TclReleaseLiteral calls Tcl_DecrRefCount for us */
	    TclReleaseLiteral(interp, objPtr);
	}
    }
    Tcl_Free(localCachePtr);
	    if (interp) {
		TclReleaseLiteral(interp, objPtr);
	    } else {
		Tcl_DecrRefCount(objPtr);
	    }
	}
    }
    ckfree((char *) localCachePtr);
}


static void
InitLocalCache(
InitLocalCache(Proc *procPtr)
    Proc *procPtr)
{
    Interp *iPtr = procPtr->iPtr;
    ByteCode *codePtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    int localCt = procPtr->numCompiledLocals;
    int numArgs = procPtr->numArgs, i = 0;

    Tcl_Obj **namePtr;
    Var *varPtr;
    LocalCache *localCachePtr;
    CompiledLocal *localPtr;
    int isNew;
    int new;

    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Cache the names and initial values of local variables; store the
     * cache in both the framePtr for this execution and in the codePtr
     * for future calls.
     */

    localCachePtr = (LocalCache *)Tcl_Alloc(offsetof(LocalCache, varName0)
	    + localCt * sizeof(Tcl_Obj *)
	    + numArgs * sizeof(Var));
    localCachePtr = (LocalCache *) ckalloc(sizeof(LocalCache)
	    + (localCt-1)*sizeof(Tcl_Obj *)
	    + numArgs*sizeof(Var));

    namePtr = &localCachePtr->varName0;
    varPtr = (Var *) (namePtr + localCt);
    localPtr = procPtr->firstLocalPtr;
    while (localPtr) {
	if (TclIsVarTemporary(localPtr)) {
	    *namePtr = NULL;
	} else {
	    *namePtr = TclCreateLiteral(iPtr, localPtr->name,
		    localPtr->nameLength, /* hash */ -1,
		    &isNew, /* nsPtr */ NULL, 0, NULL);
		    localPtr->nameLength, /* hash */ (unsigned int) -1,
		    &new, /* nsPtr */ NULL, 0, NULL);
	    Tcl_IncrRefCount(*namePtr);
	}

	if (i < numArgs) {
	    varPtr->flags = (localPtr->flags & VAR_IS_ARGS);
	    varPtr->value.objPtr = localPtr->defValuePtr;
	    varPtr++;
	    i++;
	}
	namePtr++;
	localPtr = localPtr->nextPtr;
	localPtr=localPtr->nextPtr;
    }
    codePtr->localCachePtr = localCachePtr;
    localCachePtr->refCount = 1;
    localCachePtr->numVars = localCt;
    localCachePtr->numVars  = localCt;
}


/*
 *----------------------------------------------------------------------
 *
 * InitArgsAndLocals --
 *
 *	This routine is invoked in order to initialize the arguments and other
 *	compiled locals table for a new call frame.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Allocates memory on the stack for the compiled local variables, the
 *	caller is responsible for freeing them. Initialises all variables. May
 *	invoke various name resolvers in order to determine which variables
 *	are being referenced at runtime.
 *
 *----------------------------------------------------------------------
 */

static int
InitArgsAndLocals(
    Tcl_Interp *interp,/* Interpreter in which procedure was
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
    int skip)			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
{
    CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
    Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr;
    Var *varPtr, *defPtr;
    register Proc *procPtr = framePtr->procPtr;
    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
    register Var *varPtr, *defPtr;
    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
    Tcl_Obj *const *argObjs;

    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);

    /*
     * Make sure that the local cache of variable names and initial values has
     * been initialised properly .
     */

    if (localCt) {
	if (!codePtr->localCachePtr) {
1368
1369
1370
1371
1372
1373
1374
1375

1376
1377
1378
1379
1380
1381
1382
1420
1421
1422
1423
1424
1425
1426

1427
1428
1429
1430
1431
1432
1433
1434







-
+








    /*
     * Create the "compiledLocals" array. Make sure it is large enough to hold
     * all the procedure's compiled local variables, including its formal
     * parameters.
     */

    varPtr = (Var *)TclStackAlloc(interp, localCt * sizeof(Var));
    varPtr = (Var*) TclStackAlloc(interp, (int)(localCt*sizeof(Var)));
    framePtr->compiledLocals = varPtr;
    framePtr->numCompiledLocals = localCt;

    /*
     * Match and assign the call's actual parameters to the procedure's formal
     * arguments. The formal arguments are described by the first numArgs
     * entries in both the Proc structure's local variable list and the call
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
1439
1440
1441
1442

1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459

1460
1461
1462
1463
1464
1465
1466
1467
1468


1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479

1480
1481
1482
1483
1484
1485
1486

1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503



1504
1505

1506
1507
1508
1509

1510
1511
1512
1513

1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539

1540

1541
1542
1543
1544
1545
1546
1547
1548

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
1443
1444
1445
1446
1447
1448
1449

1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461

1462
1463
1464
1465
1466
1467

1468
1469

1470





1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485

1486
1487
1488
1489
1490
1491
1492
1493
1494
1495

1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512

1513

1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527







1528
1529
1530
1531
1532
1533
1534

1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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







-
+











-
+





-
+

-
+
-
-
-
-
-
+
+
+
+
+
+







+

-
+









-
+
















-
+
-








+
+




-
-
-
-
-
-
-
+






-
+














-
-
-
+
+
+

-
+



-
+



-
+













-
+
-











+
-
+







-
+

-
+














-
+


+
+
+







	if (argCt) {
	    goto incorrectArgs;
	} else {
	    goto correctArgs;
	}
    }
    imax = ((argCt < numArgs-1) ? argCt : numArgs-1);
    for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
    for (i = 0; i < imax; i++, varPtr++, defPtr++) {
	/*
	 * "Normal" arguments; last formal is special, depends on it being
	 * 'args'.
	 */

	Tcl_Obj *objPtr = argObjs[i];

	varPtr->flags = 0;
	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
    }
    for (; i < numArgs-1; i++, varPtr++, defPtr ? defPtr++ : defPtr) {
    for (; i < numArgs-1; i++, varPtr++, defPtr++) {
	/*
	 * This loop is entered if argCt < (numArgs-1). Set default values;
	 * last formal is special.
	 */

	Tcl_Obj *objPtr = defPtr ? defPtr->value.objPtr : NULL;
	Tcl_Obj *objPtr = defPtr->value.objPtr;

	if (!objPtr) {
	if (objPtr) {
	    goto incorrectArgs;
	}
	varPtr->flags = 0;
	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);	/* Local var reference. */
	    varPtr->flags = 0;
	    varPtr->value.objPtr = objPtr;
	    Tcl_IncrRefCount(objPtr);	/* Local var reference. */
	} else {
	    goto incorrectArgs;
	}
    }

    /*
     * When we get here, the last formal argument remains to be defined:
     * defPtr and varPtr point to the last argument to be initialized.
     */


    varPtr->flags = 0;
    if (defPtr && defPtr->flags & VAR_IS_ARGS) {
    if (defPtr->flags & VAR_IS_ARGS) {
	Tcl_Obj *listPtr = Tcl_NewListObj(argCt-i, argObjs+i);

	varPtr->value.objPtr = listPtr;
	Tcl_IncrRefCount(listPtr);	/* Local var is a reference. */
    } else if (argCt == numArgs) {
	Tcl_Obj *objPtr = argObjs[i];

	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
    } else if ((argCt < numArgs) && defPtr && defPtr->value.objPtr) {
    } else if ((argCt < numArgs) && (defPtr->value.objPtr != NULL)) {
	Tcl_Obj *objPtr = defPtr->value.objPtr;

	varPtr->value.objPtr = objPtr;
	Tcl_IncrRefCount(objPtr);	/* Local var is a reference. */
    } else {
	goto incorrectArgs;
    }
    varPtr++;

    /*
     * Initialise and resolve the remaining compiledLocals. In the absence of
     * resolvers, they are undefined local vars: (flags=0, value=NULL).
     */

  correctArgs:
    if (numArgs < localCt) {
	if (!framePtr->nsPtr->compiledVarResProc
	if (!framePtr->nsPtr->compiledVarResProc && !((Interp *)interp)->resolverPtr) {
		&& !((Interp *)interp)->resolverPtr) {
	    memset(varPtr, 0, (localCt - numArgs)*sizeof(Var));
	} else {
	    InitResolvedLocals(interp, codePtr, varPtr, framePtr->nsPtr);
	}
    }

    return TCL_OK;


    incorrectArgs:
    /*
     * Initialise all compiled locals to avoid problems at DeleteLocalVars.
     */

  incorrectArgs:
    if ((skip != 1) &&
	    TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) {
	TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
    }
    memset(varPtr, 0,
	    ((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
    memset(varPtr, 0, ((framePtr->compiledLocals + localCt)-varPtr)*sizeof(Var));
    return ProcWrongNumArgs(interp, skip);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPushProcCallFrame --
 * PushProcCallFrame --
 *
 *	Compiles a proc body if necessary, then pushes a CallFrame suitable
 *	for executing it.
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	The proc's body may be recompiled. A CallFrame is pushed, it will have
 *	to be popped by the caller.
 *
 *----------------------------------------------------------------------
 */

int
TclPushProcCallFrame(
    ClientData clientData,	/* Record describing procedure to be
static int
PushProcCallFrame(
    ClientData clientData, 	/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,/* Interpreter in which procedure was
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[],	/* Argument value objects. */
    Tcl_Obj *CONST objv[],	/* Argument value objects. */
    int isLambda)		/* 1 if this is a call by ApplyObjCmd: it
				 * needs special rules for error msg */
{
    Proc *procPtr = (Proc *)clientData;
    Proc *procPtr = (Proc *) clientData;
    Namespace *nsPtr = procPtr->cmdPtr->nsPtr;
    CallFrame *framePtr, **framePtrPtr;
    int result;
    ByteCode *codePtr;

    /*
     * If necessary (i.e. if we haven't got a suitable compilation already
     * cached) compile the procedure's body. The compiler will allocate frame
     * slots for the procedure's non-argument local variables. Note that
     * compiling the body might increase procPtr->numCompiledLocals if new
     * local variables are found while compiling.
     */

    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
    if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
    if (codePtr != NULL) {
	Interp *iPtr = (Interp *) interp;

	/*
	 * When we've got bytecode, this is the check for validity. That is,
	 * the bytecode must be for the right interpreter (no cross-leaks!),
	 * the code must be from the current epoch (so subcommand compilation
	 * is up-to-date), the namespace must match (so variable handling
	 * is right) and the resolverEpoch must match (so that new shadowed
	 * commands and/or resolver changes are considered).
	 */

	codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
	if (((Interp *) *codePtr->interpHandle != iPtr)
 	if (((Interp *) *codePtr->interpHandle != iPtr)
		|| (codePtr->compileEpoch != iPtr->compileEpoch)
		|| (codePtr->nsPtr != nsPtr)
		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)) {
	    goto doCompilation;
	}
    } else {
    doCompilation:
	result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
	result = ProcCompileProc(interp, procPtr, procPtr->bodyPtr, nsPtr,
		(isLambda ? "body of lambda term" : "body of proc"),
		TclGetString(objv[isLambda]));
		TclGetString(objv[isLambda]), &procPtr);
	if (result != TCL_OK) {
	    return result;
	}
    }

    /*
     * Set up and push a new call frame for the new procedure invocation.
     * This call frame will execute in the proc's namespace, which might be
     * different than the current namespace. The proc's namespace is that of
     * its command, which can change if the command is renamed from one
     * namespace to another.
     */

    framePtrPtr = &framePtr;
    (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
    result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
	    (Tcl_Namespace *) nsPtr,
	    (isLambda? (FRAME_IS_PROC|FRAME_IS_LAMBDA) : FRAME_IS_PROC));
    if (result != TCL_OK) {
	return result;
    }

    framePtr->objc = objc;
    framePtr->objv = objv;
    framePtr->procPtr = procPtr;

    return TCL_OK;
}
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
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
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
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




1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833










































1834
1835
1836
1837
1838
1839
1840
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

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
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



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







-
+

-
+



-
+

-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
+


-





-
+















-
-
+
+




-
+



-
+


-

-
+

-
-
-
-
+
-
-




-
-
+
+

















-
-
-
+
+
+

-
+

-
+
-






-
+


-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+

-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+




-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
















-
-
-
-
+
+
+
+











-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	Depends on the commands in the procedure.
 *
 *----------------------------------------------------------------------
 */

int
TclObjInterpProc(
    ClientData clientData,	/* Record describing procedure to be
    ClientData clientData, 	/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,/* Interpreter in which procedure was
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
    Tcl_Obj *CONST objv[])	/* Argument value objects. */
{
    /*
     * Not used much in the core; external interface for iTcl
     */

    return Tcl_NRCallObjProc(interp, TclNRInterpProc, clientData, objc, objv);
}

int
    int result;
TclNRInterpProc(
    ClientData clientData,	/* Record describing procedure to be
				 * interpreted. */
    Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    int objc,			/* Count of number of arguments to this
				 * procedure. */
    Tcl_Obj *const objv[])	/* Argument value objects. */
{
    int result = TclPushProcCallFrame(clientData, interp, objc, objv,

    result = PushProcCallFrame(clientData, interp, objc, objv, /*isLambda*/ 0);
	    /*isLambda*/ 0);

    if (result != TCL_OK) {
    if (result == TCL_OK) {
	return TclObjInterpProcCore(interp, objv[0], 1, &MakeProcError);
    } else {
	return TCL_ERROR;
    }
    return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError);
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRInterpProcCore --
 * TclObjInterpProcCore --
 *
 *	When a Tcl procedure, lambda term or anything else that works like a
 *	procedure gets invoked during bytecode evaluation, this object-based
 *	routine gets invoked to interpret the body.
 *
 * Results:
 *	A standard Tcl object result value.
 *
 * Side effects:
 *	Nearly anything; depends on the commands in the procedure body.
 *
 *----------------------------------------------------------------------
 */

int
TclNRInterpProcCore(
    Tcl_Interp *interp,/* Interpreter in which procedure was
TclObjInterpProcCore(
    register Tcl_Interp *interp,/* Interpreter in which procedure was
				 * invoked. */
    Tcl_Obj *procNameObj,	/* Procedure name for error reporting. */
    int skip,			/* Number of initial arguments to be skipped,
				 * i.e., words in the "command name". */
    ProcErrorProc *errorProc)	/* How to convert results from the script into
    ProcErrorProc errorProc)	/* How to convert results from the script into
				 * results of the overall procedure. */
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr = iPtr->varFramePtr->procPtr;
    register Proc *procPtr = iPtr->varFramePtr->procPtr;
    int result;
    CallFrame *freePtr;
    ByteCode *codePtr;

    result = InitArgsAndLocals(interp, skip);
    result = InitArgsAndLocals(interp, procNameObj, skip);
    if (result != TCL_OK) {
	freePtr = iPtr->framePtr;
	Tcl_PopCallFrame(interp);	/* Pop but do not free. */
	TclStackFree(interp, freePtr->compiledLocals);
					/* Free compiledLocals. */
	goto procDone;
	TclStackFree(interp, freePtr);	/* Free CallFrame. */
	return TCL_ERROR;
    }

#if defined(TCL_COMPILE_DEBUG)
    if (tclTraceExec >= 1) {
	CallFrame *framePtr = iPtr->varFramePtr;
	int i;
	register CallFrame *framePtr = iPtr->varFramePtr;
	register int i;

	if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
	    fprintf(stdout, "Calling lambda ");
	} else {
	    fprintf(stdout, "Calling proc ");
	}
	for (i = 0; i < framePtr->objc; i++) {
	    TclPrintObject(stdout, framePtr->objv[i], 15);
	    fprintf(stdout, " ");
	}
	fprintf(stdout, "\n");
	fflush(stdout);
    }
#endif /*TCL_COMPILE_DEBUG*/

#ifdef USE_DTRACE
    if (TCL_DTRACE_PROC_ARGS_ENABLED()) {
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
	const char *a[10];
	int i;
	char *a[10];
	int i = 0;
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;

	for (i = 0 ; i < 10 ; i++) {
	while (i < 10) {
	    a[i] = (l < iPtr->varFramePtr->objc ?
		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL);
		    TclGetString(iPtr->varFramePtr->objv[l]) : NULL); i++; l++;
	    l++;
	}
	TCL_DTRACE_PROC_ARGS(a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7],
		a[8], a[9]);
    }
    if (TCL_DTRACE_PROC_INFO_ENABLED() && iPtr->cmdFramePtr) {
	Tcl_Obj *info = TclInfoFrame(interp, iPtr->cmdFramePtr);
	const char *a[6]; int i[2];
	char *a[4]; int i[2];

	TclDTraceInfo(info, a, i);
	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1], a[4], a[5]);
	TCL_DTRACE_PROC_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
	TclDecrRefCount(info);
    }
    if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;

	TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
		TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
		iPtr->varFramePtr->objc - l - 1,
		(Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
    }
    if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;

	TCL_DTRACE_PROC_ENTRY(l < iPtr->varFramePtr->objc ?
		TclGetString(iPtr->varFramePtr->objv[l]) : NULL,
		iPtr->varFramePtr->objc - l - 1,
		(Tcl_Obj **)(iPtr->varFramePtr->objv + l + 1));
    }
#endif /* USE_DTRACE */

    /*
     * Invoke the commands in the procedure's body.
     */

    procPtr->refCount++;
    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
    iPtr->numLevels++;

    TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
	    NULL, NULL);
    return TclNRExecuteByteCode(interp, codePtr);
}

    if (TclInterpReady(interp) == TCL_ERROR) {
	result = TCL_ERROR;
    } else {
	register ByteCode *codePtr =
		procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;

	codePtr->refCount++;
static int
InterpProcNR2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    Proc *procPtr = iPtr->varFramePtr->procPtr;
#ifdef USE_DTRACE
	if (TCL_DTRACE_PROC_ENTRY_ENABLED()) {
	    int l;

	    l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 2 : 1;
	    TCL_DTRACE_PROC_ENTRY(TclGetString(procNameObj),
		    iPtr->varFramePtr->objc - l,
    CallFrame *freePtr;
    Tcl_Obj *procNameObj = (Tcl_Obj *)data[0];
		    (Tcl_Obj **)(iPtr->varFramePtr->objv + l));
    ProcErrorProc *errorProc = (ProcErrorProc *)data[1];

    if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
	}
#endif /* USE_DTRACE */
	result = TclExecuteByteCode(interp, codePtr);
	if (TCL_DTRACE_PROC_RETURN_ENABLED()) {
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;

	TCL_DTRACE_PROC_RETURN(l < iPtr->varFramePtr->objc ?
		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result);
    }
    if (procPtr->refCount-- <= 1) {
	    TCL_DTRACE_PROC_RETURN(TclGetString(procNameObj), result);
	}
	codePtr->refCount--;
	if (codePtr->refCount <= 0) {
	    TclCleanupByteCode(codePtr);
	}
    }

    iPtr->numLevels--;
    procPtr->refCount--;
    if (procPtr->refCount <= 0) {
	TclProcCleanupProc(procPtr);
    }

    /*
     * Free the stack-allocated compiled locals and CallFrame. It is important
     * to pop the call frame without freeing it first: the compiledLocals
     * cannot be freed before the frame is popped, as the local variables must
     * be deleted. But the compiledLocals must be freed first, as they were
     * allocated later on the stack.
     */

     * Process the result code.
    if (result != TCL_OK) {
	goto process;
    }

    done:
    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
	int l = iPtr->varFramePtr->isProcCallFrame & FRAME_IS_LAMBDA ? 1 : 0;
	Tcl_Obj *r = Tcl_GetObjResult(interp);

	TCL_DTRACE_PROC_RESULT(l < iPtr->varFramePtr->objc ?
		TclGetString(iPtr->varFramePtr->objv[l]) : NULL, result,
		TclGetString(r), r);
    }

    freePtr = iPtr->framePtr;
    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
    TclStackFree(interp, freePtr->compiledLocals);
					/* Free compiledLocals. */
    TclStackFree(interp, freePtr);	/* Free CallFrame. */
    return result;

    /*
     * Process any non-TCL_OK result code.
     */

    process:
    switch (result) {
    case TCL_RETURN:
	/*
	 * If it is a 'return', do the TIP#90 processing now.
	 */

	result = TclUpdateReturnInfo((Interp *) interp);
	break;

    case TCL_CONTINUE:
    case TCL_BREAK:
	/*
	 * It's an error to get to this point from a 'break' or 'continue', so
	 * transform to an error now.
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invoked \"%s\" outside of a loop",
		((result == TCL_BREAK) ? "break" : "continue")));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "UNEXPECTED", NULL);
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "invoked \"",
		((result == TCL_BREAK) ? "break" : "continue"),
		"\" outside of a loop", NULL);
	result = TCL_ERROR;

	/* FALLTHRU */

    case TCL_ERROR:
	/*
	 * Now it _must_ be an error, so we need to log it as such. This means
	 * filling out the error trace. Luckily, we just hand this off to the
	 * function handed to us as an argument.
	 */

	errorProc(interp, procNameObj);
    }
    goto done;
	(*errorProc)(interp, procNameObj);

    default:
	/*
	 * Process other results (OK and non-standard) by doing nothing
	 * special, skipping directly to the code afterwards that cleans up
	 * associated memory.
	 *
	 * Non-standard results are processed by passing them through quickly.
	 * This means they all work as exceptions, unwinding the stack quickly
	 * and neatly. Who knows how well they are handled by third-party code
	 * though...
	 */

	(void) 0;		/* do nothing */
    }

#ifdef USE_DTRACE
    if (TCL_DTRACE_PROC_RESULT_ENABLED()) {
	Tcl_Obj *r;

	r = Tcl_GetObjResult(interp);
	TCL_DTRACE_PROC_RESULT(TclGetString(procNameObj), result,
		TclGetString(r), r);
    }
#endif /* USE_DTRACE */

  procDone:
    /*
     * Free the stack-allocated compiled locals and CallFrame. It is important
     * to pop the call frame without freeing it first: the compiledLocals
     * cannot be freed before the frame is popped, as the local variables must
     * be deleted. But the compiledLocals must be freed first, as they were
     * allocated later on the stack.
     */

    freePtr = iPtr->framePtr;
    Tcl_PopCallFrame(interp);		/* Pop but do not free. */
    TclStackFree(interp, freePtr->compiledLocals);
					/* Free compiledLocals. */
    TclStackFree(interp, freePtr);	/* Free CallFrame. */
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcCompileProc --
 *
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
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







-
-
+
+

-
-
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+

-
-
+
+
-















-
-
+
+




-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+







-
+

-
+
-
-
-


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+

-
-
+
+













-
-
+
+
+







 */

int
TclProcCompileProc(
    Tcl_Interp *interp,		/* Interpreter containing procedure. */
    Proc *procPtr,		/* Data associated with procedure. */
    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
				 * but could be any code fragment compiled in
				 * the context of this procedure.) */
 				 * but could be any code fragment compiled in
 				 * the context of this procedure.) */
    Namespace *nsPtr,		/* Namespace containing procedure. */
    const char *description,	/* string describing this body of code. */
    const char *procName)	/* Name of this procedure. */
    CONST char *description,	/* string describing this body of code. */
    CONST char *procName)	/* Name of this procedure. */
{
    return ProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description,
	    procName, NULL);
}

static int
ProcCompileProc(
    Tcl_Interp *interp,		/* Interpreter containing procedure. */
    Proc *procPtr,		/* Data associated with procedure. */
    Tcl_Obj *bodyPtr,		/* Body of proc. (Usually procPtr->bodyPtr,
 				 * but could be any code fragment compiled in
 				 * the context of this procedure.) */
    Namespace *nsPtr,		/* Namespace containing procedure. */
    CONST char *description,	/* string describing this body of code. */
    CONST char *procName,	/* Name of this procedure. */
    Proc **procPtrPtr)		/* Points to storage where a replacement
				 * (Proc *) value may be written. */
{
    Interp *iPtr = (Interp *) interp;
    int i;
    Tcl_CallFrame *framePtr;
    ByteCode *codePtr;

    ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
    CompiledLocal *localPtr;
    ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);

    /*
     * If necessary, compile the procedure's body. The compiler will allocate
     * frame slots for the procedure's non-argument local variables. If the
     * ByteCode already exists, make sure it hasn't been invalidated by
     * someone redefining a core command (this might make the compiled code
     * wrong). Also, if the code was compiled in/for a different interpreter,
     * we recompile it. Note that compiling the body might increase
     * procPtr->numCompiledLocals if new local variables are found while
     * compiling.
     *
     * Precompiled procedure bodies, however, are immutable and therefore they
     * are not recompiled, even if things have changed.
     */

    if (codePtr != NULL) {
	if (((Interp *) *codePtr->interpHandle == iPtr)
    if (bodyPtr->typePtr == &tclByteCodeType) {
 	if (((Interp *) *codePtr->interpHandle == iPtr)
		&& (codePtr->compileEpoch == iPtr->compileEpoch)
		&& (codePtr->nsPtr == nsPtr)
		&& (codePtr->nsEpoch == nsPtr->resolverEpoch)) {
	    return TCL_OK;
	}

	if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	    if ((Interp *) *codePtr->interpHandle != iPtr) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a precompiled script jumped interps", -1));
	} else {
	    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
		if ((Interp *) *codePtr->interpHandle != iPtr) {
		    Tcl_AppendResult(interp,
			    "a precompiled script jumped interps", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
			"CROSSINTERPBYTECODE", NULL);
		return TCL_ERROR;
	    }
	    codePtr->compileEpoch = iPtr->compileEpoch;
	    codePtr->nsPtr = nsPtr;
	} else {
	    Tcl_StoreIntRep(bodyPtr, &tclByteCodeType, NULL);
	    codePtr = NULL;
	}
    }

    if (codePtr == NULL) {
		    return TCL_ERROR;
		}
		codePtr->compileEpoch = iPtr->compileEpoch;
		codePtr->nsPtr = nsPtr;
	    } else {
		bodyPtr->typePtr->freeIntRepProc(bodyPtr);
		bodyPtr->typePtr = NULL;
	    }
 	}
    }
    if (bodyPtr->typePtr != &tclByteCodeType) {
	Tcl_HashEntry *hePtr;

#ifdef TCL_COMPILE_DEBUG
	if (tclTraceCompile >= 1) {
	    /*
	     * Display a line summarizing the top level command we are about
	     * to compile.
	     */
 	if (tclTraceCompile >= 1) {
 	    /*
 	     * Display a line summarizing the top level command we are about
 	     * to compile.
 	     */

	    Tcl_Obj *message;

	    TclNewLiteralStringObj(message, "Compiling ");
	    Tcl_IncrRefCount(message);
	    Tcl_AppendStringsToObj(message, description, " \"", NULL);
	    Tcl_AppendLimitedToObj(message, procName, -1, 50, NULL);
	    fprintf(stdout, "%s\"\n", TclGetString(message));
 	    fprintf(stdout, "%s\"\n", TclGetString(message));
	    Tcl_DecrRefCount(message);
	}
 	}
#else
    (void)description;
    (void)procName;
#endif

	/*
	 * Plug the current procPtr into the interpreter and coerce the code
	 * body to byte codes. The interpreter needs to know which proc it's
	 * compiling so that it can access its list of compiled locals.
	 *
	 * TRICKY NOTE: Be careful to push a call frame with the proper
	 *   namespace context, so that the byte codes are compiled in the
	 *   appropriate class context.
	 */
 	/*
 	 * Plug the current procPtr into the interpreter and coerce the code
 	 * body to byte codes. The interpreter needs to know which proc it's
 	 * compiling so that it can access its list of compiled locals.
 	 *
 	 * TRICKY NOTE: Be careful to push a call frame with the proper
 	 *   namespace context, so that the byte codes are compiled in the
 	 *   appropriate class context.
 	 */

	iPtr->compiledProcPtr = procPtr;
	if (procPtrPtr != NULL && procPtr->refCount > 1) {
	    Tcl_Command token;
	    Tcl_CmdInfo info;
	    Proc *newProc = (Proc *) ckalloc(sizeof(Proc));

	if (procPtr->numCompiledLocals > procPtr->numArgs) {
	    CompiledLocal *clPtr = procPtr->firstLocalPtr;
	    CompiledLocal *lastPtr = NULL;
	    int i, numArgs = procPtr->numArgs;
	    newProc->iPtr = procPtr->iPtr;
	    newProc->refCount = 1;
	    newProc->cmdPtr = procPtr->cmdPtr;
	    token = (Tcl_Command) newProc->cmdPtr;
	    newProc->bodyPtr = Tcl_DuplicateObj(bodyPtr);
	    bodyPtr = newProc->bodyPtr;
	    Tcl_IncrRefCount(bodyPtr);
	    newProc->numArgs = procPtr->numArgs;

	    for (i = 0; i < numArgs; i++) {
		lastPtr = clPtr;
		clPtr = clPtr->nextPtr;
	    }

	    if (lastPtr) {
	    newProc->numCompiledLocals = newProc->numArgs;
	    newProc->firstLocalPtr = NULL;
	    newProc->lastLocalPtr = NULL;
	    localPtr = procPtr->firstLocalPtr;
	    for (i=0; i<newProc->numArgs; i++, localPtr=localPtr->nextPtr) {
		CompiledLocal *copy = (CompiledLocal *) ckalloc((unsigned)
			(sizeof(CompiledLocal) - sizeof(localPtr->name)
			+ localPtr->nameLength + 1));

		if (newProc->firstLocalPtr == NULL) {
		    newProc->firstLocalPtr = newProc->lastLocalPtr = copy;
		lastPtr->nextPtr = NULL;
	    } else {
		procPtr->firstLocalPtr = NULL;
	    }
	    procPtr->lastLocalPtr = lastPtr;
	    while (clPtr) {
		CompiledLocal *toFree = clPtr;

		} else {
		    newProc->lastLocalPtr->nextPtr = copy;
		    newProc->lastLocalPtr = copy;
		}
		copy->nextPtr = NULL;
		copy->nameLength = localPtr->nameLength;
		copy->frameIndex = localPtr->frameIndex;
		copy->flags = localPtr->flags;
		copy->defValuePtr = localPtr->defValuePtr;
		if (copy->defValuePtr) {
		    Tcl_IncrRefCount(copy->defValuePtr);
		}
		clPtr = clPtr->nextPtr;
		if (toFree->resolveInfo) {
		    if (toFree->resolveInfo->deleteProc) {
		copy->resolveInfo = localPtr->resolveInfo;
		memcpy(copy->name, localPtr->name, localPtr->nameLength + 1);
	    }

			toFree->resolveInfo->deleteProc(toFree->resolveInfo);
		    } else {
			Tcl_Free(toFree->resolveInfo);
		    }
		}
		Tcl_Free(toFree);
	    }
	    procPtr->numCompiledLocals = procPtr->numArgs;
	    /*
	     * Reset the ClientData
	     */

	    Tcl_GetCommandInfoFromToken(token, &info);
	    if (info.objClientData == (ClientData) procPtr) {
		info.objClientData = (ClientData) newProc;
	    }
	    if (info.clientData == (ClientData) procPtr) {
		info.clientData = (ClientData) newProc;
	    }
	    if (info.deleteData == (ClientData) procPtr) {
		info.deleteData = (ClientData) newProc;
	    }
	    Tcl_SetCommandInfoFromToken(token, &info);

	    procPtr->refCount--;
	    *procPtrPtr = procPtr = newProc;
	}
 	iPtr->compiledProcPtr = procPtr;

	(void) TclPushStackFrame(interp, &framePtr, (Tcl_Namespace *) nsPtr,
		/* isProcCallFrame */ 0);
 	(void) TclPushStackFrame(interp, &framePtr,
		(Tcl_Namespace *) nsPtr, /* isProcCallFrame */ 0);

	/*
	 * TIP #280: We get the invoking context from the cmdFrame which
	 * was saved by 'Tcl_ProcObjCmd' (using linePBodyPtr).
	 */

	hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);

	/*
	 * Constructed saved frame has body as word 0. See Tcl_ProcObjCmd.
	 */

	iPtr->invokeWord = 0;
	iPtr->invokeCmdFramePtr = hePtr ? (CmdFrame *)Tcl_GetHashValue(hePtr) : NULL;
	TclSetByteCodeFromAny(interp, bodyPtr, NULL, NULL);
	iPtr->invokeCmdFramePtr =
		(hePtr ? (CmdFrame *) Tcl_GetHashValue(hePtr) : NULL);
	(void) tclByteCodeType.setFromAnyProc(interp, bodyPtr);
	iPtr->invokeCmdFramePtr = NULL;
	TclPopStackFrame(interp);
    } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
	/*
	 * The resolver epoch has changed, but we only need to invalidate the
	 * resolver cache.
	 */
2028
2029
2030
2031
2032
2033
2034
2035

2036
2037

2038
2039
2040
2041
2042
2043


2044
2045
2046
2047
2048
2049
2050
2096
2097
2098
2099
2100
2101
2102

2103


2104
2105
2106
2107
2108


2109
2110
2111
2112
2113
2114
2115
2116
2117







-
+
-
-
+




-
-
+
+







static void
MakeProcError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    unsigned int overflow, limit = 60;
    int overflow, limit = 60, nameLen;
    size_t nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (procedure \"%.*s%s\" line %d)",
	    (int)(overflow ? limit :nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), interp->errorLine));
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcDeleteProc --
 *
2063
2064
2065
2066
2067
2068
2069
2070

2071

2072

2073
2074
2075
2076
2077
2078
2079
2130
2131
2132
2133
2134
2135
2136

2137
2138
2139

2140
2141
2142
2143
2144
2145
2146
2147







-
+

+
-
+







 *----------------------------------------------------------------------
 */

void
TclProcDeleteProc(
    ClientData clientData)	/* Procedure to be deleted. */
{
    Proc *procPtr = (Proc *)clientData;
    Proc *procPtr = (Proc *) clientData;

    procPtr->refCount--;
    if (procPtr->refCount-- <= 1) {
    if (procPtr->refCount <= 0) {
	TclProcCleanupProc(procPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+

-
+
















-
+

-
+







-
+


-
+




-
+
+











-
+






-
+

-
+







 *	Memory gets freed.
 *
 *----------------------------------------------------------------------
 */

void
TclProcCleanupProc(
    Proc *procPtr)	/* Procedure to be deleted. */
    register Proc *procPtr)	/* Procedure to be deleted. */
{
    CompiledLocal *localPtr;
    register CompiledLocal *localPtr;
    Tcl_Obj *bodyPtr = procPtr->bodyPtr;
    Tcl_Obj *defPtr;
    Tcl_ResolvedVarInfo *resVarInfo;
    Tcl_HashEntry *hePtr = NULL;
    CmdFrame *cfPtr = NULL;
    Interp *iPtr = procPtr->iPtr;

    if (bodyPtr != NULL) {
	Tcl_DecrRefCount(bodyPtr);
    }
    for (localPtr = procPtr->firstLocalPtr; localPtr != NULL; ) {
	CompiledLocal *nextPtr = localPtr->nextPtr;

	resVarInfo = localPtr->resolveInfo;
	if (resVarInfo) {
	    if (resVarInfo->deleteProc) {
		resVarInfo->deleteProc(resVarInfo);
		(*resVarInfo->deleteProc)(resVarInfo);
	    } else {
		Tcl_Free(resVarInfo);
		ckfree((char *) resVarInfo);
	    }
	}

	if (localPtr->defValuePtr != NULL) {
	    defPtr = localPtr->defValuePtr;
	    Tcl_DecrRefCount(defPtr);
	}
	Tcl_Free(localPtr);
	ckfree((char *) localPtr);
	localPtr = nextPtr;
    }
    Tcl_Free(procPtr);
    ckfree((char *) procPtr);

    /*
     * TIP #280: Release the location data associated with this Proc
     * structure, if any. The interpreter may not exist (For example for
     * procbody structures created by tbcload.
     * procbody structures created by tbcload. See also Tcl_ProcObjCmd(), when
     * the same ProcPtr is overwritten with a new CmdFrame.
     */

    if (iPtr == NULL) {
	return;
    }

    hePtr = Tcl_FindHashEntry(iPtr->linePBodyPtr, (char *) procPtr);
    if (!hePtr) {
	return;
    }

    cfPtr = (CmdFrame *)Tcl_GetHashValue(hePtr);
    cfPtr = (CmdFrame *) Tcl_GetHashValue(hePtr);

    if (cfPtr) {
	if (cfPtr->type == TCL_LOCATION_SOURCE) {
	    Tcl_DecrRefCount(cfPtr->data.eval.path);
	    cfPtr->data.eval.path = NULL;
	}
	Tcl_Free(cfPtr->line);
	ckfree((char *) cfPtr->line);
	cfPtr->line = NULL;
	Tcl_Free(cfPtr);
	ckfree((char *) cfPtr);
    }
    Tcl_DeleteHashEntry(hePtr);
}

/*
 *----------------------------------------------------------------------
 *
2257
2258
2259
2260
2261
2262
2263


2264


2265
2266
2267
2268
2269
2270
2271
2326
2327
2328
2329
2330
2331
2332
2333
2334

2335
2336
2337
2338
2339
2340
2341
2342
2343







+
+
-
+
+








    if (!procPtr) {
	return NULL;
    }

    TclNewObj(objPtr);
    if (objPtr) {
	objPtr->typePtr = &tclProcBodyType;
	objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
	ProcSetIntRep(objPtr, procPtr);

	procPtr->refCount++;
    }

    return objPtr;
}

/*
 *----------------------------------------------------------------------
2285
2286
2287
2288
2289
2290
2291
2292

2293
2294


2295

2296
2297
2298
2299
2300
2301
2302
2357
2358
2359
2360
2361
2362
2363

2364

2365
2366
2367

2368
2369
2370
2371
2372
2373
2374
2375







-
+
-

+
+
-
+







 */

static void
ProcBodyDup(
    Tcl_Obj *srcPtr,		/* Object to copy. */
    Tcl_Obj *dupPtr)		/* Target object for the duplication. */
{
    Proc *procPtr;
    Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    ProcGetIntRep(srcPtr, procPtr);

    dupPtr->typePtr = &tclProcBodyType;
    dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
    ProcSetIntRep(dupPtr, procPtr);
    procPtr->refCount++;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyFree --
 *
2314
2315
2316
2317
2318
2319
2320
2321

2322
2323
2324
2325

2326
2327
2328
2329
2330
2331
2332
2387
2388
2389
2390
2391
2392
2393

2394
2395



2396
2397
2398
2399
2400
2401
2402
2403







-
+

-
-
-
+







 *----------------------------------------------------------------------
 */

static void
ProcBodyFree(
    Tcl_Obj *objPtr)		/* The object to clean up. */
{
    Proc *procPtr;
    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;

    ProcGetIntRep(objPtr, procPtr);

    if (procPtr->refCount-- <= 1) {
    if (procPtr->refCount-- < 2) {
	TclProcCleanupProc(procPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
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







-
+

-
-
+
+

+
-
+
-


-
-
+
+




-
+


-
-
+
+

-
-
-
-
+
+



+





-
+


-
-
+
+















+
+
+
-
+
-
-
-







 *
 *----------------------------------------------------------------------
 */

static void
DupLambdaInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
{
    Proc *procPtr;
    Tcl_Obj *nsObjPtr;
    Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2;

    copyPtr->internalRep.twoPtrValue.ptr1 = procPtr;
    LambdaGetIntRep(srcPtr, procPtr, nsObjPtr);
    copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
    assert(procPtr != NULL);

    procPtr->refCount++;

    LambdaSetIntRep(copyPtr, procPtr, nsObjPtr);
    Tcl_IncrRefCount(nsObjPtr);
    copyPtr->typePtr = &lambdaType;
}

static void
FreeLambdaInternalRep(
    Tcl_Obj *objPtr)	/* CmdName object with internal representation
    register Tcl_Obj *objPtr)	/* CmdName object with internal representation
				 * to free. */
{
    Proc *procPtr;
    Tcl_Obj *nsObjPtr;
    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
    Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;

    LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
    assert(procPtr != NULL);

    if (procPtr->refCount-- <= 1) {
    procPtr->refCount--;
    if (procPtr->refCount == 0) {
	TclProcCleanupProc(procPtr);
    }
    TclDecrRefCount(nsObjPtr);
    objPtr->typePtr = NULL;
}

static int
SetLambdaFromAny(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr)	/* The object to convert. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    Interp *iPtr = (Interp *) interp;
    const char *name;
    Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
    char *name;
    Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
    int isNew, objc, result;
    CmdFrame *cfPtr = NULL;
    Proc *procPtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }

    /*
     * Convert objPtr to list type first; if it cannot be converted, or if its
     * length is not 2, then it cannot be converted to lambdaType.
     */

    result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
    if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
	TclNewLiteralStringObj(errPtr, "can't interpret \"");
	Tcl_AppendObjToObj(errPtr, objPtr);
	Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	Tcl_SetObjResult(interp, errPtr);
		"can't interpret \"%s\" as a lambda expression",
		TclGetString(objPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
	return TCL_ERROR;
    }

    argsPtr = objv[0];
    bodyPtr = objv[1];

    /*
2445
2446
2447
2448
2449
2450
2451
2452

2453

2454

2455
2456
2457
2458
2459
2460
2461
2515
2516
2517
2518
2519
2520
2521

2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533







-
+

+

+







     * this file. The differences are the different index of the body in the
     * line array of the context, and the special processing mentioned in the
     * previous paragraph to track into the list. Find a way to factor the
     * common elements into a single function.
     */

    if (iPtr->cmdFramePtr) {
	CmdFrame *contextPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame));
	CmdFrame *contextPtr;

	contextPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
	*contextPtr = *iPtr->cmdFramePtr;

	if (contextPtr->type == TCL_LOCATION_BC) {
	    /*
	     * Retrieve the source context from the bytecode. This call
	     * accounts for the reference to the source file, if any, held in
	     * 'context.data.eval.path'.
	     */

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
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




2622
2623
2624
2625
2626
2627
2628







-
+




-
+








-
-
+
+











-
+










-
+









+
+






-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-







		int buf[2];

		/*
		 * Move from approximation (line of list cmd word) to actual
		 * location (line of 2nd list element).
		 */

		cfPtr = (CmdFrame *)Tcl_Alloc(sizeof(CmdFrame));
		cfPtr = (CmdFrame *) ckalloc(sizeof(CmdFrame));
		TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL);

		cfPtr->level = -1;
		cfPtr->type = contextPtr->type;
		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
		cfPtr->line = (int *) ckalloc(sizeof(int));
		cfPtr->line[0] = buf[1];
		cfPtr->nline = 1;
		cfPtr->framePtr = NULL;
		cfPtr->nextPtr = NULL;

		cfPtr->data.eval.path = contextPtr->data.eval.path;
		Tcl_IncrRefCount(cfPtr->data.eval.path);

		cfPtr->cmd = NULL;
		cfPtr->len = 0;
		cfPtr->cmd.str.cmd = NULL;
		cfPtr->cmd.str.len = 0;
	    }

	    /*
	     * 'contextPtr' is going out of scope. Release the reference that
	     * it's holding to the source file path
	     */

	    Tcl_DecrRefCount(contextPtr->data.eval.path);
	}
	TclStackFree(interp, contextPtr);
    }
    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, procPtr,
    Tcl_SetHashValue(Tcl_CreateHashEntry(iPtr->linePBodyPtr, (char *) procPtr,
	    &isNew), cfPtr);

    /*
     * Set the namespace for this lambda: given by objv[2] understood as a
     * global reference, or else global per default.
     */

    if (objc == 2) {
	TclNewLiteralStringObj(nsObjPtr, "::");
    } else {
	const char *nsName = TclGetString(objv[2]);
	char *nsName = TclGetString(objv[2]);

	if ((*nsName != ':') || (*(nsName+1) != ':')) {
	    TclNewLiteralStringObj(nsObjPtr, "::");
	    Tcl_AppendObjToObj(nsObjPtr, objv[2]);
	} else {
	    nsObjPtr = objv[2];
	}
    }

    Tcl_IncrRefCount(nsObjPtr);

    /*
     * Free the list internalrep of objPtr - this will free argsPtr, but
     * bodyPtr retains a reference from the Proc structure. Then finish the
     * conversion to lambdaType.
     */

    LambdaSetIntRep(objPtr, procPtr, nsObjPtr);
    return TCL_OK;
}

    objPtr->typePtr->freeIntRepProc(objPtr);
Proc *
TclGetLambdaFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    Tcl_Obj **nsObjPtrPtr)
{

    Proc *procPtr;
    Tcl_Obj *nsObjPtr;

    objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
    LambdaGetIntRep(objPtr, procPtr, nsObjPtr);

    objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
    if (procPtr == NULL) {
	if (SetLambdaFromAny(interp, objPtr) != TCL_OK) {
	    return NULL;
	}
	LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
    }

    objPtr->typePtr = &lambdaType;
    assert(procPtr != NULL);
    if (procPtr->iPtr != (Interp *)interp) {
	return NULL;
    return TCL_OK;
    }

    *nsObjPtrPtr = nsObjPtr;
    return procPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ApplyObjCmd --
 *
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
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
2658
2659





2660






















2661

2662
2663
2664

2665
2666
2667
2668






2669
2670
2671
2672
2673
2674

2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2636
2637
2638
2639
2640
2641
2642

2643
2644
2645

2646
2647



2648







2649
2650

2651
2652
2653

2654
2655
2656

2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670


2671
2672
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
2709
2710





2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738

2739
2740


2741
2742



2743
2744
2745
2746
2747
2748






2749



2750
2751
2752
2753
2754
2755
2756







-
+


-
+

-
-
-
+
-
-
-
-
-
-
-


-
+
+

-
+


-
+


+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
-
-
-
+
+
+

-
+
-
+

+
+
-
-
-
-
+
+
+
+
-
-
-
-
+

+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-




-
-
-
-
-
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

-
-
+

-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
-
-
-







 *	Depends on the content of the lambda term (i.e., objv[1]).
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ApplyObjCmd(
    ClientData clientData,
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, TclNRApplyObjCmd, clientData, objc, objv);
}

    Interp *iPtr = (Interp *) interp;
int
TclNRApplyObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Proc *procPtr = NULL;
    Tcl_Obj *lambdaPtr, *nsObjPtr;
    int result;
    int result, isRootEnsemble;
    Command cmd;
    Tcl_Namespace *nsPtr;
    ApplyExtraData *extraPtr;
    ExtraFrameInfo efi;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "lambdaExpr ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    /*
     * Set lambdaPtr, convert it to lambdaType in the current interp if
     * necessary.
     */

    lambdaPtr = objv[1];
    if (lambdaPtr->typePtr == &lambdaType) {
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }


    /*
#define JOE_EXTENSION 0
#if JOE_EXTENSION
    else {
	/*
     * Set lambdaPtr, convert it to tclLambdaType in the current interp if
     * necessary.
     */
	 * Joe English's suggestion to allow cmdNames to function as lambdas.
	 * Also requires making tclCmdNameType non-static in tclObj.c
	 */

    lambdaPtr = objv[1];
	Tcl_Obj *elemPtr;
    procPtr = TclGetLambdaFromObj(interp, lambdaPtr, &nsObjPtr);
	int numElem;

	if ((lambdaPtr->typePtr == &tclCmdNameType) ||
		(TclListObjGetElements(interp, lambdaPtr, &numElem,
    if (procPtr == NULL) {
	return TCL_ERROR;
    }

		&elemPtr) == TCL_OK && numElem == 1)) {
	    return Tcl_EvalObjv(interp, objc-1, objv+1, 0);
	}
    }
    /*
     * Push a call frame for the lambda namespace.
     * Note that TclObjInterpProc() will pop it.
     */
#endif

    if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
    result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    extraPtr = (ApplyExtraData *)TclStackAlloc(interp, sizeof(ApplyExtraData));
    memset(&extraPtr->cmd, 0, sizeof(Command));
    procPtr->cmdPtr = &extraPtr->cmd;
	result = SetLambdaFromAny(interp, lambdaPtr);
	if (result != TCL_OK) {
	    return result;
	}
	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
    }

    memset(&cmd, 0, sizeof(Command));
    procPtr->cmdPtr = &cmd;
    extraPtr->cmd.nsPtr = (Namespace *) nsPtr;

    /*
     * TIP#280 (semi-)HACK!
     *
     * Using cmd.clientData to tell [info frame] how to render the lambdaPtr.
     * The InfoFrameCmd will detect this case by testing cmd.hPtr for NULL.
     * This condition holds here because of the memset() above, and nowhere
     * else (in the core). Regular commands always have a valid hPtr, and
     * lambda's never.
     * Using cmd.clientData to tell [info frame] how to render the
     * 'lambdaPtr'. The InfoFrameCmd will detect this case by testing cmd.hPtr
     * for NULL. This condition holds here because of the 'memset' above, and
     * nowhere else (in the core). Regular commands always have a valid
     * 'hPtr', and lambda's never.
     */

    extraPtr->efi.length = 1;
    extraPtr->efi.fields[0].name = "lambda";
    extraPtr->efi.fields[0].proc = NULL;
    extraPtr->efi.fields[0].clientData = lambdaPtr;
    extraPtr->cmd.clientData = &extraPtr->efi;
    efi.length = 1;
    efi.fields[0].name = "lambda";
    efi.fields[0].proc = NULL;
    efi.fields[0].clientData = lambdaPtr;
    cmd.clientData = &efi;

    /*
     * Find the namespace where this lambda should run, and push a call frame
     * for that namespace. Note that TclObjInterpProc() will pop it.
     */

    nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
    result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
    if (result != TCL_OK) {
	return result;
    }

    cmd.nsPtr = (Namespace *) nsPtr;

    isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = objv;
	iPtr->ensembleRewrite.numRemovedObjs = 1;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    } else {
	iPtr->ensembleRewrite.numInsertedObjs -= 1;
    }

    result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
    result = PushProcCallFrame((ClientData) procPtr, interp, objc, objv, 1);
    if (result == TCL_OK) {
	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
	result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
	result = TclObjInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
    }
    return result;
}


    if (isRootEnsemble) {
	iPtr->ensembleRewrite.sourceObjs = NULL;
	iPtr->ensembleRewrite.numRemovedObjs = 0;
	iPtr->ensembleRewrite.numInsertedObjs = 0;
    }
static int
ApplyNR2(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{

    ApplyExtraData *extraPtr = (ApplyExtraData *)data[0];

    TclStackFree(interp, extraPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * MakeLambdaError --
2699
2700
2701
2702
2703
2704
2705
2706

2707
2708

2709
2710
2711
2712
2713
2714


2715

2716
2717
2718
2719
2720

2721
2722

2723
2724
2725
2726

2727
2728
2729
2730


2731
2732
2733
2734














2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749






























































































2750
2751
2752
2753
2754
2755
2756
2757
2758
2771
2772
2773
2774
2775
2776
2777

2778


2779
2780
2781
2782
2783


2784
2785
2786
2787
2788
2789
2790
2791

2792
2793

2794




2795




2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815















2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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







-
+
-
-
+




-
-
+
+

+




-
+

-
+
-
-
-
-
+
-
-
-
-
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









static void
MakeLambdaError(
    Tcl_Interp *interp,		/* The interpreter in which the procedure was
				 * called. */
    Tcl_Obj *procNameObj)	/* Name of the procedure. Used for error
				 * messages and trace information. */
{
    unsigned int overflow, limit = 60;
    int overflow, limit = 60, nameLen;
    size_t nameLen;
    const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
    const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);

    overflow = (nameLen > limit);
    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
	    "\n    (lambda term \"%.*s%s\" line %d)",
	    (int)(overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
	    (overflow ? limit : nameLen), procName,
	    (overflow ? "..." : ""), interp->errorLine));
}


/*
 *----------------------------------------------------------------------
 *
 * TclGetCmdFrameForProcedure --
 * Tcl_DisassembleObjCmd --
 *
 *	How to get the CmdFrame information for a procedure.
 *	Implementation of the "::tcl::unsupported::disassemble" command. This
 *
 * Results:
 *	A pointer to the CmdFrame (only guaranteed to be valid until the next
 *	Tcl command is processed or the interpreter's state is otherwise
 *	command is not documented, but will disassemble procedures, lambda
 *	modified) or a NULL if the information is not available.
 *
 * Side effects:
 *	none.
 *	terms and general scripts. Note that will compile terms if necessary
 *	in order to disassemble them.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_DisassembleObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    static const char *types[] = {
	"lambda", "proc", "script", NULL
    };
    enum Types {
	DISAS_LAMBDA, DISAS_PROC, DISAS_SCRIPT
    };
    int idx, result;
CmdFrame *
TclGetCmdFrameForProcedure(
    Proc *procPtr)		/* The procedure whose cmd-frame is to be
				 * looked up. */
{
    Tcl_HashEntry *hePtr;

    if (procPtr == NULL || procPtr->iPtr == NULL) {
	return NULL;
    }
    hePtr = Tcl_FindHashEntry(procPtr->iPtr->linePBodyPtr, procPtr);
    if (hePtr == NULL) {
	return NULL;
    }
    return (CmdFrame *) Tcl_GetHashValue(hePtr);

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "type procName|lambdaTerm|script");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
	return TCL_ERROR;
    }

    switch ((enum Types) idx) {
    case DISAS_LAMBDA: {
	Proc *procPtr = NULL;
	Command cmd;
	Tcl_Obj *nsObjPtr;
	Tcl_Namespace *nsPtr;

	/*
	 * Compile (if uncompiled) and disassemble a lambda term.
	 */

	if (objv[2]->typePtr == &lambdaType) {
	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
	}
	if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
	    result = SetLambdaFromAny(interp, objv[2]);
	    if (result != TCL_OK) {
		return result;
	    }
	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
	}

	memset(&cmd, 0, sizeof(Command));
	nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
	if (result != TCL_OK) {
	    return result;
	}
	cmd.nsPtr = (Namespace *) nsPtr;
	procPtr->cmdPtr = &cmd;
	result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
	if (result != TCL_OK) {
	    return result;
	}
	TclPopStackFrame(interp);
	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
		& TCL_BYTECODE_PRECOMPILED) {
	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
	break;
    }
    case DISAS_PROC: {
	Proc *procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));

	if (procPtr == NULL) {
	    Tcl_AppendResult(interp, "\"", TclGetString(objv[2]),
		    "\" isn't a procedure", NULL);
	    return TCL_ERROR;
	}

	/*
	 * Compile (if uncompiled) and disassemble a procedure.
	 */

	result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
	if (result != TCL_OK) {
	    return result;
	}
	TclPopStackFrame(interp);
	if (((ByteCode *) procPtr->bodyPtr->internalRep.twoPtrValue.ptr1)->flags
		& TCL_BYTECODE_PRECOMPILED) {
	    Tcl_AppendResult(interp, "may not disassemble prebuilt bytecode",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(procPtr->bodyPtr));
	break;
    }
    case DISAS_SCRIPT:
	/*
	 * Compile and disassemble a script.
	 */

	if (objv[2]->typePtr != &tclByteCodeType) {
	    if (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK){
		return TCL_ERROR;
	    }
	}
	Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(objv[2]));
	break;
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclProcess.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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






























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclProcess.c --
 *
 *	This file implements the "tcl::process" ensemble for subprocess
 *	management as defined by TIP #462.
 *
 * Copyright (c) 2017 Frederic Bonnet.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * Autopurge flag. Process-global because of the way Tcl manages child
 * processes (see tclPipe.c).
 */

static int autopurge = 1;	/* Autopurge flag. */

/*
 * Hash tables that keeps track of all child process statuses. Keys are the
 * child process ids and resolved pids, values are (ProcessInfo *).
 */

typedef struct ProcessInfo {
    Tcl_Pid pid;		/* Process id. */
    int resolvedPid;		/* Resolved process id. */
    int purge;			/* Purge eventualy. */
    TclProcessWaitStatus status;/* Process status. */
    int code;			/* Error code, exit status or signal
				   number. */
    Tcl_Obj *msg;		/* Error message. */
    Tcl_Obj *error;		/* Error code. */
} ProcessInfo;
static Tcl_HashTable infoTablePerPid;
static Tcl_HashTable infoTablePerResolvedPid;
static int infoTablesInitialized = 0;	/* 0 means not yet initialized. */
TCL_DECLARE_MUTEX(infoTablesMutex)

 /*
 * Prototypes for functions defined later in this file:
 */

static void		InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
			    int resolvedPid);
static void		FreeProcessInfo(ProcessInfo *info);
static int		RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, size_t resolvedPid,
			    int options, int *codePtr, Tcl_Obj **msgPtr,
			    Tcl_Obj **errorObjPtr);
static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
static int		ProcessListObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessStatusObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessPurgeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ProcessAutopurgeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------------
 *
 * InitProcessInfo --
 *
 *	Initializes the ProcessInfo structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory written.
 *
 *----------------------------------------------------------------------
 */

void
InitProcessInfo(
    ProcessInfo *info,		/* Structure to initialize. */
    Tcl_Pid pid,		/* Process id. */
    int resolvedPid)		/* Resolved process id. */
{
    info->pid = pid;
    info->resolvedPid = resolvedPid;
    info->purge = 0;
    info->status = TCL_PROCESS_UNCHANGED;
    info->code = 0;
    info->msg = NULL;
    info->error = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeProcessInfo --
 *
 *	Free the ProcessInfo structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory deallocated, Tcl_Obj refcount decreased.
 *
 *----------------------------------------------------------------------
 */

void
FreeProcessInfo(
    ProcessInfo *info)		/* Structure to free. */
{
    /*
     * Free stored Tcl_Objs.
     */

    if (info->msg) {
	Tcl_DecrRefCount(info->msg);
    }
    if (info->error) {
	Tcl_DecrRefCount(info->error);
    }

    /*
     * Free allocated structure.
     */

    Tcl_Free(info);
}

/*
 *----------------------------------------------------------------------
 *
 * RefreshProcessInfo --
 *
 *	Refresh process info.
 *
 * Results:
 *	Nonzero if state changed, else zero.
 *
 * Side effects:
 *	May call WaitProcessStatus, which can block if WNOHANG option is set.
 *
 *----------------------------------------------------------------------
 */

int
RefreshProcessInfo(
    ProcessInfo *info,		/* Structure to refresh. */
    int options			/* Options passed to WaitProcessStatus. */
)
{
    if (info->status == TCL_PROCESS_UNCHANGED) {
	/*
	 * Refresh & store status.
	 */

	info->status = WaitProcessStatus(info->pid, info->resolvedPid,
		options, &info->code, &info->msg, &info->error);
	if (info->msg) Tcl_IncrRefCount(info->msg);
	if (info->error) Tcl_IncrRefCount(info->error);
	return (info->status != TCL_PROCESS_UNCHANGED);
    } else {
	/*
	 * No change.
	 */

	return 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * WaitProcessStatus --
 *
 *	Wait for process status to change.
 *
 * Results:
 *	TclProcessWaitStatus enum value.
 *
 * Side effects:
 *	May call WaitProcessStatus, which can block if WNOHANG option is set.
 *
 *----------------------------------------------------------------------
 */

TclProcessWaitStatus
WaitProcessStatus(
    Tcl_Pid pid,		/* Process id. */
    size_t resolvedPid,		/* Resolved process id. */
    int options,		/* Options passed to Tcl_WaitPid. */
    int *codePtr,		/* If non-NULL, will receive either:
				 *  - 0 for normal exit.
				 *  - errno in case of error.
				 *  - non-zero exit code for abormal exit.
				 *  - signal number if killed or suspended.
				 *  - Tcl_WaitPid status in all other cases.
				 */
    Tcl_Obj **msgObjPtr,	/* If non-NULL, will receive error message. */
    Tcl_Obj **errorObjPtr)	/* If non-NULL, will receive error code. */
{
    int waitStatus;
    Tcl_Obj *errorStrings[5];
    const char *msg;

    pid = Tcl_WaitPid(pid, &waitStatus, options);
    if (pid == 0) {
	/*
	 * No change.
	 */

	return TCL_PROCESS_UNCHANGED;
    }

    /*
     * Get process status.
     */

    if (pid == (Tcl_Pid)-1) {
	/*
	 * POSIX errName msg
	 */

	msg = Tcl_ErrnoMsg(errno);
	if (errno == ECHILD) {
	    /*
	     * This changeup in message suggested by Mark Diekhans to
	     * remind people that ECHILD errors can occur on some
	     * systems if SIGCHLD isn't in its default state.
	     */

	    msg = "child process lost (is SIGCHLD ignored or trapped?)";
	}
	if (codePtr) *codePtr = errno;
	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
		"error waiting for process to exit: %s", msg);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("POSIX", -1);
	    errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
	    errorStrings[2] = Tcl_NewStringObj(msg, -1);
	    *errorObjPtr = Tcl_NewListObj(3, errorStrings);
	}
	return TCL_PROCESS_ERROR;
    } else if (WIFEXITED(waitStatus)) {
	if (codePtr) *codePtr = WEXITSTATUS(waitStatus);
	if (!WEXITSTATUS(waitStatus)) {
	    /*
	     * Normal exit.
	     */

	    if (msgObjPtr) *msgObjPtr = NULL;
	    if (errorObjPtr) *errorObjPtr = NULL;
	} else {
	    /*
	     * CHILDSTATUS pid code
	     *
	     * Child exited with a non-zero exit status.
	     */

	    if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
		    "child process exited abnormally", -1);
	    if (errorObjPtr) {
		errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1);
		TclNewIntObj(errorStrings[1], resolvedPid);
		TclNewIntObj(errorStrings[2], WEXITSTATUS(waitStatus));
		*errorObjPtr = Tcl_NewListObj(3, errorStrings);
	    }
	}
	return TCL_PROCESS_EXITED;
    } else if (WIFSIGNALED(waitStatus)) {
	/*
	 * CHILDKILLED pid sigName msg
	 *
	 * Child killed because of a signal.
	 */

	msg = Tcl_SignalMsg(WTERMSIG(waitStatus));
	if (codePtr) *codePtr = WTERMSIG(waitStatus);
	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
		"child killed: %s", msg);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1);
	    TclNewIntObj(errorStrings[1], resolvedPid);
	    errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1);
	    errorStrings[3] = Tcl_NewStringObj(msg, -1);
	    *errorObjPtr = Tcl_NewListObj(4, errorStrings);
	}
	return TCL_PROCESS_SIGNALED;
    } else if (WIFSTOPPED(waitStatus)) {
	/*
	 * CHILDSUSP pid sigName msg
	 *
	 * Child suspended because of a signal.
	 */

	msg = Tcl_SignalMsg(WSTOPSIG(waitStatus));
	if (codePtr) *codePtr = WSTOPSIG(waitStatus);
	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
		"child suspended: %s", msg);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1);
	    TclNewIntObj(errorStrings[1], resolvedPid);
	    errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1);
	    errorStrings[3] = Tcl_NewStringObj(msg, -1);
	    *errorObjPtr = Tcl_NewListObj(4, errorStrings);
	}
	return TCL_PROCESS_STOPPED;
    } else {
	/*
	 * TCL OPERATION EXEC ODDWAITRESULT
	 *
	 * Child wait status didn't make sense.
	 */

	if (codePtr) *codePtr = waitStatus;
	if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
		"child wait status didn't make sense\n", -1);
	if (errorObjPtr) {
	    errorStrings[0] = Tcl_NewStringObj("TCL", -1);
	    errorStrings[1] = Tcl_NewStringObj("OPERATION", -1);
	    errorStrings[2] = Tcl_NewStringObj("EXEC", -1);
	    errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1);
	    TclNewIntObj(errorStrings[4], resolvedPid);
	    *errorObjPtr = Tcl_NewListObj(5, errorStrings);
	}
	return TCL_PROCESS_UNKNOWN_STATUS;
    }
}


/*
 *----------------------------------------------------------------------
 *
 * BuildProcessStatusObj --
 *
 *	Build a list object with process status. The first element is always
 *	a standard Tcl return value, which can be either TCL_OK or TCL_ERROR.
 *	In the latter case, the second element is the error message and the
 *	third element is a Tcl error code (see tclvars).
 *
 * Results:
 *	A list object.
 *
 * Side effects:
 *	Tcl_Objs are created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
BuildProcessStatusObj(
    ProcessInfo *info)
{
    Tcl_Obj *resultObjs[3];

    if (info->status == TCL_PROCESS_UNCHANGED) {
	/*
	 * Process still running, return empty obj.
	 */

	return Tcl_NewObj();
    }
    if (info->status == TCL_PROCESS_EXITED && info->code == 0) {
	/*
	 * Normal exit, return TCL_OK.
	 */

	return Tcl_NewWideIntObj(TCL_OK);
    }

    /*
     * Abnormal exit, return {TCL_ERROR msg error}
     */

    TclNewIntObj(resultObjs[0], TCL_ERROR);
    resultObjs[1] = info->msg;
    resultObjs[2] = info->error;
    return Tcl_NewListObj(3, resultObjs);
}

/*----------------------------------------------------------------------
 *
 * ProcessListObjCmd --
 *
 *	This function implements the 'tcl::process list' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Access to the internal structures is protected by infoTablesMutex.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessListObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *list;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    /*
     * Return the list of all chid process ids.
     */

    list = Tcl_NewListObj(0, NULL);
    Tcl_MutexLock(&infoTablesMutex);
    for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	info = (ProcessInfo *) Tcl_GetHashValue(entry);
	Tcl_ListObjAppendElement(interp, list,
		Tcl_NewWideIntObj(info->resolvedPid));
    }
    Tcl_MutexUnlock(&infoTablesMutex);
    Tcl_SetObjResult(interp, list);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ProcessStatusObjCmd --
 *
 *	This function implements the 'tcl::process status' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Access to the internal structures is protected by infoTablesMutex.
 *	Calls RefreshProcessInfo, which can block if -wait switch is given.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessStatusObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *dict;
    int index, options = WNOHANG;
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    int numPids;
    Tcl_Obj **pidObjs;
    int result;
    int i;
    int pid;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const switches[] = {
	"-wait", "--", NULL
    };
    enum switchesEnum {
	STATUS_WAIT, STATUS_LAST
    };

    while (objc > 1) {
	if (TclGetString(objv[1])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[1], switches, "switches", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	++objv; --objc;
	if (STATUS_WAIT == (enum switchesEnum) index) {
	    options = 0;
	} else {
	    break;
	}
    }

    if (objc != 1 && objc != 2) {
	Tcl_WrongNumArgs(interp, 1, savedobjv, "?switches? ?pids?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	/*
	* Return a dict with all child process statuses.
	*/

	dict = Tcl_NewDictObj();
	Tcl_MutexLock(&infoTablesMutex);
	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    RefreshProcessInfo(info, options);

	    if (info->purge && autopurge) {
		/*
		 * Purge entry.
		 */

		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    } else {
		/*
		 * Add to result.
		 */

		Tcl_DictObjPut(interp, dict, Tcl_NewWideIntObj(info->resolvedPid),
			BuildProcessStatusObj(info));
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    } else {
	/*
	 * Only return statuses of provided processes.
	 */

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	dict = Tcl_NewDictObj();
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		Tcl_DecrRefCount(dict);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {
		/*
		 * Skip unknown process.
		 */

		continue;
	    }

	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    RefreshProcessInfo(info, options);

	    if (info->purge && autopurge) {
		/*
		 * Purge entry.
		 */

		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    } else {
		/*
		 * Add to result.
		 */

		Tcl_DictObjPut(interp, dict, Tcl_NewWideIntObj(info->resolvedPid),
			BuildProcessStatusObj(info));
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }
    Tcl_SetObjResult(interp, dict);
    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ProcessPurgeObjCmd --
 *
 *	This function implements the 'tcl::process purge' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Frees all ProcessInfo structures with their purge flag set.
 *
 *----------------------------------------------------------------------
 */

static int
ProcessPurgeObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;
    ProcessInfo *info;
    int numPids;
    Tcl_Obj **pidObjs;
    int result;
    int i;
    int pid;

    if (objc != 1 && objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?pids?");
	return TCL_ERROR;
    }

    /*
     * First reap detached procs so that their purge flag is up-to-date.
     */

    Tcl_ReapDetachedProcs();

    if (objc == 1) {
	/*
	 * Purge all terminated processes.
	 */

	Tcl_MutexLock(&infoTablesMutex);
	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    if (info->purge) {
		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    } else {
	/*
	 * Purge only provided processes.
	 */

	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
	if (result != TCL_OK) {
	    return result;
	}
	Tcl_MutexLock(&infoTablesMutex);
	for (i = 0; i < numPids; i++) {
	    result = Tcl_GetIntFromObj(interp, pidObjs[i], &pid);
	    if (result != TCL_OK) {
		Tcl_MutexUnlock(&infoTablesMutex);
		return result;
	    }

	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
	    if (!entry) {
		/*
		 * Skip unknown process.
		 */

		continue;
	    }

	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
	    if (info->purge) {
		Tcl_DeleteHashEntry(entry);
		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
		Tcl_DeleteHashEntry(entry);
		FreeProcessInfo(info);
	    }
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }

    return TCL_OK;
}

/*----------------------------------------------------------------------
 *
 * ProcessAutopurgeObjCmd --
 *
 *	This function implements the 'tcl::process autopurge' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	Alters detached process handling by Tcl_ReapDetachedProcs().
 *
 *----------------------------------------------------------------------
 */

static int
ProcessAutopurgeObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    if (objc != 1 && objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?flag?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	/*
	 * Set given value.
	 */

	int flag;
	int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
	if (result != TCL_OK) {
	    return result;
	}

	autopurge = !!flag;
    }

    /*
     * Return current value.
     */

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitProcessCmd --
 *
 *	This procedure creates the "tcl::process" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitProcessCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap processImplMap[] = {
	{"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    Tcl_Command processCmd;

    if (infoTablesInitialized == 0) {
	Tcl_MutexLock(&infoTablesMutex);
	if (infoTablesInitialized == 0) {
	    Tcl_InitHashTable(&infoTablePerPid, TCL_ONE_WORD_KEYS);
	    Tcl_InitHashTable(&infoTablePerResolvedPid, TCL_ONE_WORD_KEYS);
	    infoTablesInitialized = 1;
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }

    processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap);
    Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
	    "process", 0);
    return processCmd;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcessCreated --
 *
 *	Called when a child process has been created by Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Internal structures are updated with a new ProcessInfo.
 *
 *----------------------------------------------------------------------
 */

void
TclProcessCreated(
    Tcl_Pid pid)		/* Process id. */
{
    size_t resolvedPid;
    Tcl_HashEntry *entry, *entry2;
    int isNew;
    ProcessInfo *info;

    /*
     * Get resolved pid first.
     */

    resolvedPid = TclpGetPid(pid);

    Tcl_MutexLock(&infoTablesMutex);

    /*
     * Create entry in pid table.
     */

    entry = Tcl_CreateHashEntry(&infoTablePerPid, pid, &isNew);
    if (!isNew) {
	/*
	 * Pid was reused, free old info and reuse structure.
	 */

	info = (ProcessInfo *) Tcl_GetHashValue(entry);
	entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid,
		INT2PTR(resolvedPid));
	if (entry2) Tcl_DeleteHashEntry(entry2);
	FreeProcessInfo(info);
    }

    /*
     * Allocate and initialize info structure.
     */

    info = (ProcessInfo *)Tcl_Alloc(sizeof(ProcessInfo));
    InitProcessInfo(info, pid, resolvedPid);

    /*
     * Add entry to tables.
     */

    Tcl_SetHashValue(entry, info);
    entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid),
	    &isNew);
    Tcl_SetHashValue(entry, info);

    Tcl_MutexUnlock(&infoTablesMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcessWait --
 *
 *	Wait for process status to change.
 *
 * Results:
 *	TclProcessWaitStatus enum value.
 *
 * Side effects:
 *	Completed process info structures are purged immediately (autopurge on)
 *	or eventually (autopurge off).
 *
 *----------------------------------------------------------------------
 */

TclProcessWaitStatus
TclProcessWait(
    Tcl_Pid pid,		/* Process id. */
    int options,		/* Options passed to WaitProcessStatus. */
    int *codePtr,		/* If non-NULL, will receive either:
				 *  - 0 for normal exit.
				 *  - errno in case of error.
				 *  - non-zero exit code for abormal exit.
				 *  - signal number if killed or suspended.
				 *  - Tcl_WaitPid status in all other cases.
				 */
    Tcl_Obj **msgObjPtr,	/* If non-NULL, will receive error message. */
    Tcl_Obj **errorObjPtr)	/* If non-NULL, will receive error code. */
{
    Tcl_HashEntry *entry;
    ProcessInfo *info;
    TclProcessWaitStatus result;

    /*
     * First search for pid in table.
     */

    Tcl_MutexLock(&infoTablesMutex);
    entry = Tcl_FindHashEntry(&infoTablePerPid, pid);
    if (!entry) {
	/*
	 * Unknown process, just call WaitProcessStatus and return.
	 */

	result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr,
		msgObjPtr, errorObjPtr);
	if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
	if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
    Tcl_MutexUnlock(&infoTablesMutex);
	return result;
    }

    info = (ProcessInfo *) Tcl_GetHashValue(entry);
    if (info->purge) {
	/*
	 * Process has completed but TclProcessWait has already been called,
	 * so report no change.
	 */
    Tcl_MutexUnlock(&infoTablesMutex);

	return TCL_PROCESS_UNCHANGED;
    }

    RefreshProcessInfo(info, options);
    if (info->status == TCL_PROCESS_UNCHANGED) {
	/*
	 * No change, stop there.
	 */
    Tcl_MutexUnlock(&infoTablesMutex);

	return TCL_PROCESS_UNCHANGED;
    }

    /*
     * Set return values.
     */

    result = info->status;
    if (codePtr) *codePtr = info->code;
    if (msgObjPtr) *msgObjPtr = info->msg;
    if (errorObjPtr) *errorObjPtr = info->error;
    if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
    if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);

    if (autopurge) {
	/*
	 * Purge now.
	 */

	Tcl_DeleteHashEntry(entry);
	entry = Tcl_FindHashEntry(&infoTablePerResolvedPid,
		INT2PTR(info->resolvedPid));
	Tcl_DeleteHashEntry(entry);
	FreeProcessInfo(info);
    } else {
	/*
	 * Eventually purge. Subsequent calls will return
	 * TCL_PROCESS_UNCHANGED.
	 */

	info->purge = 1;
    }
    Tcl_MutexUnlock(&infoTablesMutex);
    return result;
}

Changes to generic/tclRegexp.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
9
10
11
12
13
14
15

16
17
18
19
20
21
22







-







 *
 * 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 "tclRegexp.h"
#include <assert.h>

/*
 *----------------------------------------------------------------------
 * The routines in this file use Henry Spencer's regular expression package
 * contained in the following additional source files:
 *
 *	regc_color.c	regc_cvec.c	regc_lex.c
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
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







-
-
+
+









-
+




-
+














-
+






-
-
+
+







-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * *** NOTE: this code has been altered slightly for use in Tcl: ***
 * *** 1. Names have been changed, e.g. from re_comp to		 ***
 * ***    TclRegComp, to avoid clashes with other		 ***
 * ***    regexp implementations used by applications.		 ***
 * ***    TclRegComp, to avoid clashes with other 		 ***
 * ***    regexp implementations used by applications. 		 ***
 */

/*
 * Thread local storage used to maintain a per-thread cache of compiled
 * regular expressions.
 */

#define NUM_REGEXPS 30

typedef struct {
typedef struct ThreadSpecificData {
    int initialized;		/* Set to 1 when the module is initialized. */
    char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
				 * expression patterns. NULL means that this
				 * slot isn't used. Malloc-ed. */
    size_t patLengths[NUM_REGEXPS];/* Number of non-null characters in
    int patLengths[NUM_REGEXPS];/* Number of non-null characters in
				 * corresponding entry in patterns. -1 means
				 * entry isn't used. */
    struct TclRegexp *regexps[NUM_REGEXPS];
				/* Compiled forms of above strings. Also
				 * malloc-ed, or NULL if not in use yet. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Declarations for functions used only in this file.
 */

static TclRegexp *	CompileRegexp(Tcl_Interp *interp, const char *pattern,
			    size_t length, int flags);
			    int length, int flags);
static void		DupRegexpInternalRep(Tcl_Obj *srcPtr,
			    Tcl_Obj *copyPtr);
static void		FinalizeRegexp(ClientData clientData);
static void		FreeRegexp(TclRegexp *regexpPtr);
static void		FreeRegexpInternalRep(Tcl_Obj *objPtr);
static int		RegExpExecUniChar(Tcl_Interp *interp, Tcl_RegExp re,
			    const Tcl_UniChar *uniString, size_t numChars,
			    size_t nmatches, int flags);
			    const Tcl_UniChar *uniString, int numChars,
			    int nmatches, int flags);
static int		SetRegexpFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);

/*
 * The regular expression Tcl object type. This serves as a cache of the
 * compiled form of the regular expression.
 */

const Tcl_ObjType tclRegexpType = {
Tcl_ObjType tclRegexpType = {
    "regexp",				/* name */
    FreeRegexpInternalRep,		/* freeIntRepProc */
    DupRegexpInternalRep,		/* dupIntRepProc */
    NULL,				/* updateStringProc */
    SetRegexpFromAny			/* setFromAnyProc */
};

#define RegexpSetIntRep(objPtr, rePtr)					\
    do {								\
	Tcl_ObjIntRep ir;						\
	(rePtr)->refCount++;						\
	ir.twoPtrValue.ptr1 = (rePtr);					\
	ir.twoPtrValue.ptr2 = NULL;					\
	Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir);			\
    } while (0)

#define RegexpGetIntRep(objPtr, rePtr)					\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &tclRegexpType);		\
	(rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL;		\
    } while (0)


/*
 *----------------------------------------------------------------------
 *
 * Tcl_RegExpCompile --
 *
 *	Compile a regular expression into a form suitable for fast matching.
186
187
188
189
190
191
192
193

194
195

196
197
198
199
200
201
202
168
169
170
171
172
173
174

175


176
177
178
179
180
181
182
183







-
+
-
-
+







				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    const char *text,		/* Text against which to match re. */
    const char *start)		/* If text is part of a larger string, this
				 * identifies beginning of larger string, so
				 * that "^" won't match. */
{
    int flags, result;
    int flags, result, numChars;
    size_t numChars;
    TclRegexp *regexp = (TclRegexp *) re;
    TclRegexp *regexp = (TclRegexp *)re;
    Tcl_DString ds;
    const Tcl_UniChar *ustr;

    /*
     * If the starting point is offset from the beginning of the buffer, then
     * we need to tell the regexp engine not to match "^".
     */
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
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







-
+










-
+

-
+







 *---------------------------------------------------------------------------
 */

void
Tcl_RegExpRange(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
    int index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange. */
    const char **startPtr,	/* Store address of first character in
				 * (sub-)range here. */
    const char **endPtr)	/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    const char *string;

    if (index > regexpPtr->re.re_nsub) {
    if ((size_t) index > regexpPtr->re.re_nsub) {
	*startPtr = *endPtr = NULL;
    } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) {
    } else if (regexpPtr->matches[index].rm_so < 0) {
	*startPtr = *endPtr = NULL;
    } else {
	if (regexpPtr->objPtr) {
	    string = TclGetString(regexpPtr->objPtr);
	} else {
	    string = regexpPtr->string;
	}
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
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







-
-
+
+
+







+

-
-
+
+


-
+








static int
RegExpExecUniChar(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; returned by a
				 * previous call to Tcl_GetRegExpFromObj */
    const Tcl_UniChar *wString,	/* String against which to match re. */
    size_t numChars,		/* Length of Tcl_UniChar string. */
    size_t nm,		/* How many subexpression matches (counting
    int numChars,		/* Length of Tcl_UniChar string (must be
				 * >=0). */
    int nmatches,		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. -1 means "don't know". */
    int flags)			/* Regular expression flags. */
{
    int status;
    TclRegexp *regexpPtr = (TclRegexp *) re;
    size_t last = regexpPtr->re.re_nsub + 1;
    size_t nm = last;

    if (nm >= last) {
	nm = last;
    if (nmatches >= 0 && (size_t) nmatches < nm) {
	nm = (size_t) nmatches;
    }

    status = TclReExec(&regexpPtr->re, wString, numChars,
    status = TclReExec(&regexpPtr->re, wString, (size_t) numChars,
	    &regexpPtr->details, nm, regexpPtr->matches, flags);

    /*
     * Check for errors.
     */

    if (status != REG_OKAY) {
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
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







-
+

-
+

-
+

-
+




-
+


-
-
-
+
+
+







 *---------------------------------------------------------------------------
 */

void
TclRegExpRangeUniChar(
    Tcl_RegExp re,		/* Compiled regular expression that has been
				 * passed to Tcl_RegExpExec. */
    size_t index,			/* 0 means give the range of the entire match,
    int index,			/* 0 means give the range of the entire match,
				 * > 0 means give the range of a matching
				 * subrange, TCL_INDEX_NONE means the range of the
				 * subrange, -1 means the range of the
				 * rm_extend field. */
    size_t *startPtr,		/* Store address of first character in
    int *startPtr,		/* Store address of first character in
				 * (sub-)range here. */
    size_t *endPtr)		/* Store address of character just after last
    int *endPtr)		/* Store address of character just after last
				 * in (sub-)range here. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;

    if ((regexpPtr->flags&REG_EXPECT) && (index == TCL_INDEX_NONE)) {
    if ((regexpPtr->flags&REG_EXPECT) && index == -1) {
	*startPtr = regexpPtr->details.rm_extend.rm_so;
	*endPtr = regexpPtr->details.rm_extend.rm_eo;
    } else if (index + 1 > regexpPtr->re.re_nsub + 1) {
	*startPtr = TCL_INDEX_NONE;
	*endPtr = TCL_INDEX_NONE;
    } else if ((size_t) index > regexpPtr->re.re_nsub) {
	*startPtr = -1;
	*endPtr = -1;
    } else {
	*startPtr = regexpPtr->matches[index].rm_so;
	*endPtr = regexpPtr->matches[index].rm_eo;
    }
}

/*
404
405
406
407
408
409
410
411

412

413
414
415
416
417
418
419
387
388
389
390
391
392
393

394
395
396
397
398
399
400
401
402
403







-
+

+








int
Tcl_RegExpMatch(
    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    const char *text,		/* Text to search for pattern matches. */
    const char *pattern)	/* Regular expression to match against text. */
{
    Tcl_RegExp re = Tcl_RegExpCompile(interp, pattern);
    Tcl_RegExp re;

    re = Tcl_RegExpCompile(interp, pattern);
    if (re == NULL) {
	return -1;
    }
    return Tcl_RegExpExec(interp, re, text, text);
}

/*
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
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







-
+

-
+






-
+

-
+
-







int
Tcl_RegExpExecObj(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. */
    Tcl_RegExp re,		/* Compiled regular expression; must have been
				 * returned by previous call to
				 * Tcl_GetRegExpFromObj. */
    Tcl_Obj *textObj,		/* Text against which to match re. */
    size_t offset,			/* Character index that marks where matching
    int offset,			/* Character index that marks where matching
				 * should begin. */
    size_t nmatches,		/* How many subexpression matches (counting
    int nmatches,		/* How many subexpression matches (counting
				 * the whole match as subexpression 0) are of
				 * interest. -1 means all of them. */
    int flags)			/* Regular expression execution flags. */
{
    TclRegexp *regexpPtr = (TclRegexp *) re;
    Tcl_UniChar *udata;
    size_t length;
    int length;
    int reflags = regexpPtr->flags;
#define TCL_REG_GLOBOK_FLAGS \
#define TCL_REG_GLOBOK_FLAGS (TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)
	(TCL_REG_ADVANCED | TCL_REG_NOSUB | TCL_REG_NOCASE)

    /*
     * Take advantage of the equivalent glob pattern, if one exists.
     * This is possible based only on the right mix of incoming flags (0)
     * and regexp compile flags.
     */
    if ((offset == 0) && (nmatches == 0) && (flags == 0)
477
478
479
480
481
482
483
484

485
486
487
488
489
490
491
460
461
462
463
464
465
466

467
468
469
470
471
472
473
474







-
+







    /*
     * Save the target object so we can extract strings from it later.
     */

    regexpPtr->string = NULL;
    regexpPtr->objPtr = textObj;

    udata = TclGetUnicodeFromObj(textObj, &length);
    udata = Tcl_GetUnicodeFromObj(textObj, &length);

    if (offset > length) {
	offset = length;
    }
    udata += offset;
    length -= offset;

515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531



532
533
534
535
536
537
538
498
499
500
501
502
503
504










505
506
507
508
509
510
511
512
513
514







-
-
-
-
-
-
-
-
-
-
+
+
+







    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    Tcl_Obj *textObj,		/* Object containing the String to search. */
    Tcl_Obj *patternObj)	/* Regular expression to match against
				 * string. */
{
    Tcl_RegExp re;

    /*
     * For performance reasons, first try compiling the RE without support for
     * subexpressions. On failure, try again without TCL_REG_NOSUB in case the
     * RE has backreferences in it. Closely related to [Bug 1366683]. If this
     * still fails, an error message will be left in the interpreter.
     */

    if (!(re = Tcl_GetRegExpFromObj(interp, patternObj,
	    TCL_REG_ADVANCED | TCL_REG_NOSUB))
     && !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) {
    re = Tcl_GetRegExpFromObj(interp, patternObj,
	    TCL_REG_ADVANCED | TCL_REG_NOSUB);
    if (re == NULL) {
	return -1;
    }
    return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
	    0 /* nmatches */, 0 /* flags */);
}

/*
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
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







-
+

-
+

+
+
+
+
-
+
+

-
+







+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+







				 * the interp regexp cache. */
    Tcl_Obj *objPtr,		/* Object whose string rep contains regular
				 * expression pattern. Internal rep will be
				 * changed to compiled form of this regular
				 * expression. */
    int flags)			/* Regular expression compilation flags. */
{
    size_t length;
    int length;
    TclRegexp *regexpPtr;
    const char *pattern;
    char *pattern;

    /*
     * This is OK because we only actually interpret this value properly as a
     * TclRegexp* when the type is tclRegexpType.
     */
    RegexpGetIntRep(objPtr, regexpPtr);

    regexpPtr = (TclRegexp *) objPtr->internalRep.twoPtrValue.ptr1;

    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
    if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
	pattern = TclGetStringFromObj(objPtr, &length);

	regexpPtr = CompileRegexp(interp, pattern, length, flags);
	if (regexpPtr == NULL) {
	    return NULL;
	}

	/*
	 * Add a reference to the regexp so it will persist even if it is
	 * pushed out of the current thread's regexp cache. This reference
	 * will be removed when the object's internal rep is freed.
	 */

	regexpPtr->refCount++;

	/*
	 * Free the old representation and set our type.
	 */

	RegexpSetIntRep(objPtr, regexpPtr);
	TclFreeIntRep(objPtr);
	objPtr->internalRep.twoPtrValue.ptr1 = (void *) regexpPtr;
	objPtr->typePtr = &tclRegexpType;
    }
    return (Tcl_RegExp) regexpPtr;
}

/*
 *----------------------------------------------------------------------
 *
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
686
687
688
689
690
691
692
693

694
695
696
697
698
699
700
701
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
686

687

688
689
690
691
692
693
694







-
+















-
-
-
+
+












-
+
-







	{REG_ULOCALE,		"REG_ULOCALE"},
	{REG_UEMPTYMATCH,	"REG_UEMPTYMATCH"},
	{REG_UIMPOSSIBLE,	"REG_UIMPOSSIBLE"},
	{REG_USHORTEST,		"REG_USHORTEST"},
	{0,			NULL}
    };
    const struct infoname *inf;
    Tcl_Obj *infoObj, *resultObj;
    Tcl_Obj *infoObj;

    /*
     * The reset here guarantees that the interpreter result is empty and
     * unshared. This means that we can use Tcl_ListObjAppendElement on the
     * result object quite safely.
     */

    Tcl_ResetResult(interp);

    /*
     * Assume that there will never be more than INT_MAX subexpressions. This
     * is a pretty reasonable assumption; the RE engine doesn't scale _that_
     * well and Tcl has other limits that constrain things as well...
     */

    TclNewObj(resultObj);
    TclNewIndexObj(infoObj, regexpPtr->re.re_nsub);
    Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp),
	    Tcl_NewIntObj((int) regexpPtr->re.re_nsub));

    /*
     * Now append a list of all the bit-flags set for the RE.
     */

    TclNewObj(infoObj);
    for (inf=infonames ; inf->bit != 0 ; inf++) {
	if (regexpPtr->re.re_info & inf->bit) {
	    Tcl_ListObjAppendElement(NULL, infoObj,
		    Tcl_NewStringObj(inf->text, -1));
	}
    }
    Tcl_ListObjAppendElement(NULL, resultObj, infoObj);
    Tcl_ListObjAppendElement(NULL, Tcl_GetObjResult(interp), infoObj);
    Tcl_SetObjResult(interp, resultObj);

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+




-
+

-
+


-
+







void
TclRegError(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    const char *msg,		/* Message to prepend to error. */
    int status)			/* Status code to report. */
{
    char buf[100];		/* ample in practice */
    char cbuf[TCL_INTEGER_SPACE];
    char cbuf[100];		/* lots in practice */
    size_t n;
    const char *p;

    Tcl_ResetResult(interp);
    n = TclReError(status, buf, sizeof(buf));
    n = TclReError(status, NULL, buf, sizeof(buf));
    p = (n > sizeof(buf)) ? "..." : "";
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s%s%s", msg, buf, p));
    Tcl_AppendResult(interp, msg, buf, p, NULL);

    sprintf(cbuf, "%d", status);
    (void) TclReError(REG_ITOA, cbuf, sizeof(cbuf));
    (void) TclReError(REG_ITOA, NULL, cbuf, sizeof(cbuf));
    Tcl_SetErrorCode(interp, "REGEXP", cbuf, buf, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeRegexpInternalRep --
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
743
744
745
746
747
748
749

750




751
752
753
754
755

756
757
758
759
760
761
762
763
764
765
766







-
+
-
-
-
-





-
+


+







 *----------------------------------------------------------------------
 */

static void
FreeRegexpInternalRep(
    Tcl_Obj *objPtr)		/* Regexp object with internal rep to free. */
{
    TclRegexp *regexpRepPtr;
    TclRegexp *regexpRepPtr = (TclRegexp *) objPtr->internalRep.twoPtrValue.ptr1;

    RegexpGetIntRep(objPtr, regexpRepPtr);

    assert(regexpRepPtr != NULL);

    /*
     * If this is the last reference to the regexp, free it.
     */

    if (regexpRepPtr->refCount-- <= 1) {
    if (--(regexpRepPtr->refCount) <= 0) {
	FreeRegexp(regexpRepPtr);
    }
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DupRegexpInternalRep --
 *
787
788
789
790
791
792
793
794

795
796
797


798
799

800
801
802
803
804
805
806
807
777
778
779
780
781
782
783

784
785


786
787


788

789
790
791
792
793
794
795







-
+

-
-
+
+
-
-
+
-







 */

static void
DupRegexpInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
{
    TclRegexp *regexpPtr;
    TclRegexp *regexpPtr = (TclRegexp *) srcPtr->internalRep.twoPtrValue.ptr1;

    RegexpGetIntRep(srcPtr, regexpPtr);

    regexpPtr->refCount++;
    copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
    assert(regexpPtr != NULL);

    copyPtr->typePtr = &tclRegexpType;
    RegexpSetIntRep(copyPtr, regexpPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * SetRegexpFromAny --
 *
853
854
855
856
857
858
859
860

861
862
863
864
865
866
867
841
842
843
844
845
846
847

848
849
850
851
852
853
854
855







-
+







 *----------------------------------------------------------------------
 */

static TclRegexp *
CompileRegexp(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    const char *string,		/* The regexp to compile (UTF-8). */
    size_t length,			/* The length of the string in bytes. */
    int length,			/* The length of the string in bytes. */
    int flags)			/* Compilation flags. */
{
    TclRegexp *regexpPtr;
    const Tcl_UniChar *uniString;
    int numChars, status, i, exact;
    Tcl_DString stringBuf;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
911
912
913
914
915
916
917
918

919
920
921
922
923
924
925
899
900
901
902
903
904
905

906
907
908
909
910
911
912
913







-
+







	}
    }

    /*
     * This is a new expression, so compile it and add it to the cache.
     */

    regexpPtr = (TclRegexp*)Tcl_Alloc(sizeof(TclRegexp));
    regexpPtr = (TclRegexp *) ckalloc(sizeof(TclRegexp));
    regexpPtr->objPtr = NULL;
    regexpPtr->string = NULL;
    regexpPtr->details.rm_extend.rm_so = -1;
    regexpPtr->details.rm_extend.rm_eo = -1;

    /*
     * Get the up-to-date string representation and map to unicode.
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
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







-
+













-
+
-
-
+
+

+









-
-
+
+














-
-
+


-
+






-
-
+
+







    Tcl_DStringFree(&stringBuf);

    if (status != REG_OKAY) {
	/*
	 * Clean up and report errors in the interpreter, if possible.
	 */

	Tcl_Free(regexpPtr);
	ckfree((char *)regexpPtr);
	if (interp) {
	    TclRegError(interp,
		    "couldn't compile regular expression pattern: ", status);
	}
	return NULL;
    }

    /*
     * Convert RE to a glob pattern equivalent, if any, and cache it.  If this
     * is not possible, then globObjPtr will be NULL.  This is used by
     * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
     */

    if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
    if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
	    NULL) == TCL_OK) {
	regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
	regexpPtr->globObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&stringBuf),
		Tcl_DStringLength(&stringBuf));
	Tcl_IncrRefCount(regexpPtr->globObjPtr);
	Tcl_DStringFree(&stringBuf);
    } else {
	regexpPtr->globObjPtr = NULL;
    }

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for
     * the entire pattern.
     */

    regexpPtr->matches =
	    (regmatch_t*)Tcl_Alloc(sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));
    regexpPtr->matches = (regmatch_t *) ckalloc(
	    sizeof(regmatch_t) * (regexpPtr->re.re_nsub + 1));

    /*
     * Initialize the refcount to one initially, since it is in the cache.
     */

    regexpPtr->refCount = 1;

    /*
     * Free the last regexp, if necessary, and make room at the head of the
     * list for the new regexp.
     */

    if (tsdPtr->patterns[NUM_REGEXPS-1] != NULL) {
	TclRegexp *oldRegexpPtr = tsdPtr->regexps[NUM_REGEXPS-1];

	if (oldRegexpPtr->refCount-- <= 1) {
	if (--(oldRegexpPtr->refCount) <= 0) {
	    FreeRegexp(oldRegexpPtr);
	}
	Tcl_Free(tsdPtr->patterns[NUM_REGEXPS-1]);
	ckfree(tsdPtr->patterns[NUM_REGEXPS-1]);
    }
    for (i = NUM_REGEXPS - 2; i >= 0; i--) {
	tsdPtr->patterns[i+1] = tsdPtr->patterns[i];
	tsdPtr->patLengths[i+1] = tsdPtr->patLengths[i];
	tsdPtr->regexps[i+1] = tsdPtr->regexps[i];
    }
    tsdPtr->patterns[0] = (char *)Tcl_Alloc(length + 1);
    memcpy(tsdPtr->patterns[0], string, length + 1);
    tsdPtr->patterns[0] = (char *) ckalloc((unsigned) (length+1));
    strcpy(tsdPtr->patterns[0], string);
    tsdPtr->patLengths[0] = length;
    tsdPtr->regexps[0] = regexpPtr;

    return regexpPtr;
}

/*
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
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







-
+

-
+




















-
+







-
+


-
+


-




-










    TclRegexp *regexpPtr)	/* Compiled regular expression to free. */
{
    TclReFree(&regexpPtr->re);
    if (regexpPtr->globObjPtr) {
	TclDecrRefCount(regexpPtr->globObjPtr);
    }
    if (regexpPtr->matches) {
	Tcl_Free(regexpPtr->matches);
	ckfree((char *) regexpPtr->matches);
    }
    Tcl_Free(regexpPtr);
    ckfree((char *) regexpPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FinalizeRegexp --
 *
 *	Release the storage associated with the per-thread regexp cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
FinalizeRegexp(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Not used. */
{
    int i;
    TclRegexp *regexpPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    for (i = 0; (i < NUM_REGEXPS) && (tsdPtr->patterns[i] != NULL); i++) {
	regexpPtr = tsdPtr->regexps[i];
	if (regexpPtr->refCount-- <= 1) {
	if (--(regexpPtr->refCount) <= 0) {
	    FreeRegexp(regexpPtr);
	}
	Tcl_Free(tsdPtr->patterns[i]);
	ckfree(tsdPtr->patterns[i]);
	tsdPtr->patterns[i] = NULL;
    }

    /*
     * We may find ourselves reinitialized if another finalization routine
     * invokes regexps.
     */

    tsdPtr->initialized = 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclRegexp.h.

24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
47







-
+








-
+







 * in order to return pointers into the original string.
 */

typedef struct TclRegexp {
    int flags;			/* Regexp compile flags. */
    regex_t re;			/* Compiled re, includes number of
				 * subexpressions. */
    const char *string;		/* Last string passed to Tcl_RegExpExec. */
    CONST char *string;		/* Last string passed to Tcl_RegExpExec. */
    Tcl_Obj *objPtr;		/* Last object passed to Tcl_RegExpExecObj. */
    Tcl_Obj *globObjPtr;	/* Glob pattern rep of RE or NULL if none. */
    regmatch_t *matches;	/* Array of indices into the Tcl_UniChar
				 * representation of the last string matched
				 * with this regexp to indicate the location
				 * of subexpressions. */
    rm_detail_t details;	/* Detailed information on match (currently
				 * used only for REG_EXPECT). */
    size_t refCount;		/* Count of number of references to this
    int refCount;		/* Count of number of references to this
				 * compiled regexp. */
} TclRegexp;

#endif /* _TCLREGEXP */

/*
 * Local Variables:

Changes to generic/tclResolve.c.

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
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65
66
67

68
69
70
71
72
73
74







-
+









-







 *----------------------------------------------------------------------
 */

void
Tcl_AddInterpResolvers(
    Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
				 * being modified. */
    const char *name,		/* Name of this resolution scheme. */
    CONST char *name,		/* Name of this resolution scheme. */
    Tcl_ResolveCmdProc *cmdProc,/* New function for command resolution. */
    Tcl_ResolveVarProc *varProc,/* Function for variable resolution at
				 * runtime. */
    Tcl_ResolveCompiledVarProc *compiledVarProc)
				/* Function for variable resolution at compile
				 * time. */
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;
    unsigned len;

    /*
     * Since we're adding a new name resolution scheme, we must force all code
     * to be recompiled to use the new scheme. If there are new compiled
     * variable resolution rules, bump the compiler epoch to invalidate
     * compiled code. If there are new command resolution rules, bump the
     * cmdRefEpoch in all namespaces.
97
98
99
100
101
102
103
104

105
106
107


108
109
110
111
112
113
114
96
97
98
99
100
101
102

103



104
105
106
107
108
109
110
111
112







-
+
-
-
-
+
+







    }

    /*
     * Otherwise, this is a new scheme. Add it to the FRONT of the linked
     * list, so that it overrides existing schemes.
     */

    resPtr = (ResolverScheme *)Tcl_Alloc(sizeof(ResolverScheme));
    resPtr = (ResolverScheme *) ckalloc(sizeof(ResolverScheme));
    len = strlen(name) + 1;
    resPtr->name = (char *)Tcl_Alloc(len);
    memcpy(resPtr->name, name, len);
    resPtr->name = (char *) ckalloc((unsigned)(strlen(name) + 1));
    strcpy(resPtr->name, name);
    resPtr->cmdResProc = cmdProc;
    resPtr->varResProc = varProc;
    resPtr->compiledVarResProc = compiledVarProc;
    resPtr->nextPtr = iPtr->resolverPtr;
    iPtr->resolverPtr = resPtr;
}

132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
130
131
132
133
134
135
136

137
138
139
140
141
142
143
144







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_GetInterpResolvers(
    Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
				 * being queried. */
    const char *name,		/* Look for a scheme with this name. */
    CONST char *name,		/* Look for a scheme with this name. */
    Tcl_ResolverInfo *resInfoPtr)
				/* Returns pointers to the functions, if
				 * found */
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;

184
185
186
187
188
189
190
191

192
193
194
195
196
197
198
182
183
184
185
186
187
188

189
190
191
192
193
194
195
196







-
+







 *----------------------------------------------------------------------
 */

int
Tcl_RemoveInterpResolvers(
    Tcl_Interp *interp,		/* Interpreter whose name resolution rules are
				 * being modified. */
    const char *name)		/* Name of the scheme to be removed. */
    CONST char *name)		/* Name of the scheme to be removed. */
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme **prevPtrPtr, *resPtr;

    /*
     * Look for an existing scheme with the given name.
     */
221
222
223
224
225
226
227
228
229


230
231
232
233
234
235
236
219
220
221
222
223
224
225


226
227
228
229
230
231
232
233
234







-
-
+
+







	    iPtr->compileEpoch++;
	}
	if (resPtr->cmdResProc) {
	    BumpCmdRefEpochs(iPtr->globalNsPtr);
	}

	*prevPtrPtr = resPtr->nextPtr;
	Tcl_Free(resPtr->name);
	Tcl_Free(resPtr);
	ckfree(resPtr->name);
	ckfree((char *) resPtr);

	return 1;
    }
    return 0;
}

/*
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
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







-


-
+
-


-
-
-
-
-
-
-
-
-
-















-
-
+
+













-
-
+
+














-
-
+
+







    Namespace *nsPtr)		/* Namespace being modified. */
{
    Tcl_HashEntry *entry;
    Tcl_HashSearch search;

    nsPtr->cmdRefEpoch++;

#ifndef BREAK_NAMESPACE_COMPAT
    for (entry = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	Namespace *childNsPtr = (Namespace *)Tcl_GetHashValue(entry);
	Namespace *childNsPtr = (Namespace *) Tcl_GetHashValue(entry);

	BumpCmdRefEpochs(childNsPtr);
    }
#else
    if (nsPtr->childTablePtr != NULL) {
	for (entry = Tcl_FirstHashEntry(nsPtr->childTablePtr, &search);
		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
	    Namespace *childNsPtr = Tcl_GetHashValue(entry);

	    BumpCmdRefEpochs(childNsPtr);
	}
    }
#endif
    TclInvalidateNsPath(nsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetNamespaceResolvers --
 *
 *	Sets the command/variable resolution functions for a namespace,
 *	thereby changing the way that command/variable names are interpreted.
 *	This allows extension writers to support different name resolution
 *	schemes, such as those for object-oriented packages.
 *
 *	Command resolution is handled by a function of the following type:
 *
 *	  typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp,
 *		  const char *name, Tcl_Namespace *context,
 *	  typedef int (*Tcl_ResolveCmdProc)(Tcl_Interp *interp,
 *		  CONST char *name, Tcl_Namespace *context,
 *		  int flags, Tcl_Command *rPtr);
 *
 *	Whenever a command is executed or Tcl_FindCommand is invoked within
 *	the namespace, this function is called to resolve the command name. If
 *	this function is able to resolve the name, it should return the status
 *	code TCL_OK, along with the corresponding Tcl_Command in the rPtr
 *	argument. Otherwise, the function can return TCL_CONTINUE, and the
 *	command will be treated under the usual name resolution rules. Or, it
 *	can return TCL_ERROR, and the command will be considered invalid.
 *
 *	Variable resolution is handled by two functions. The first is called
 *	whenever a variable needs to be resolved at compile time:
 *
 *	  typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
 *		  const char *name, Tcl_Namespace *context,
 *	  typedef int (*Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
 *		  CONST char *name, Tcl_Namespace *context,
 *		  Tcl_ResolvedVarInfo *rPtr);
 *
 *	If this function is able to resolve the name, it should return the
 *	status code TCL_OK, along with variable resolution info in the rPtr
 *	argument; this info will be used to set up compiled locals in the call
 *	frame at runtime. The function may also return TCL_CONTINUE, and the
 *	variable will be treated under the usual name resolution rules. Or, it
 *	can return TCL_ERROR, and the variable will be considered invalid.
 *
 *	Another function is used whenever a variable needs to be resolved at
 *	runtime but it is not recognized as a compiled local. (For example,
 *	the variable may be requested via Tcl_FindNamespaceVar.) This function
 *	has the following type:
 *
 *	  typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp,
 *		  const char *name, Tcl_Namespace *context,
 *	  typedef int (*Tcl_ResolveVarProc)(Tcl_Interp *interp,
 *		  CONST char *name, Tcl_Namespace *context,
 *		  int flags, Tcl_Var *rPtr);
 *
 *	This function is quite similar to the compile-time version. It returns
 *	the same status codes, but if variable resolution succeeds, this
 *	function returns a Tcl_Var directly via the rPtr argument.
 *
 * Results:

Changes to generic/tclResult.c.

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
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







-
+









+







-
+








-
-








/*
 * Indices of the standard return options dictionary keys.
 */

enum returnKeys {
    KEY_CODE,	KEY_ERRORCODE,	KEY_ERRORINFO,	KEY_ERRORLINE,
    KEY_LEVEL,	KEY_OPTIONS,	KEY_ERRORSTACK,	KEY_LAST
    KEY_LEVEL,	KEY_OPTIONS,	KEY_LAST
};

/*
 * Function prototypes for local functions in this file:
 */

static Tcl_Obj **	GetKeys(void);
static void		ReleaseKeys(ClientData clientData);
static void		ResetObjResult(Interp *iPtr);
static void		SetupAppendBuffer(Interp *iPtr, int newSpace);

/*
 * This structure is used to take a snapshot of the interpreter state in
 * Tcl_SaveInterpState. You can snapshot the state, execute a command, and
 * then back up to the result or the error that was previously in progress.
 */

typedef struct {
typedef struct InterpState {
    int status;			/* return code status */
    int flags;			/* Each remaining field saves the */
    int returnLevel;		/* corresponding field of the Interp */
    int returnCode;		/* struct. These fields taken together are */
    Tcl_Obj *errorInfo;		/* the "state" of the interp. */
    Tcl_Obj *errorCode;
    Tcl_Obj *returnOpts;
    Tcl_Obj *objResult;
    Tcl_Obj *errorStack;
    int resetErrorStack;
} InterpState;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SaveInterpState --
 *
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
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







-
-
+
+






-
-











-
-
-







 */

Tcl_InterpState
Tcl_SaveInterpState(
    Tcl_Interp *interp,		/* Interpreter's state to be saved */
    int status)			/* status code for current operation */
{
    Interp *iPtr = (Interp *) interp;
    InterpState *statePtr = (InterpState *)Tcl_Alloc(sizeof(InterpState));
    Interp *iPtr = (Interp *)interp;
    InterpState *statePtr = (InterpState *)ckalloc(sizeof(InterpState));

    statePtr->status = status;
    statePtr->flags = iPtr->flags & ERR_ALREADY_LOGGED;
    statePtr->returnLevel = iPtr->returnLevel;
    statePtr->returnCode = iPtr->returnCode;
    statePtr->errorInfo = iPtr->errorInfo;
    statePtr->errorStack = iPtr->errorStack;
    statePtr->resetErrorStack = iPtr->resetErrorStack;
    if (statePtr->errorInfo) {
	Tcl_IncrRefCount(statePtr->errorInfo);
    }
    statePtr->errorCode = iPtr->errorCode;
    if (statePtr->errorCode) {
	Tcl_IncrRefCount(statePtr->errorCode);
    }
    statePtr->returnOpts = iPtr->returnOpts;
    if (statePtr->returnOpts) {
	Tcl_IncrRefCount(statePtr->returnOpts);
    }
    if (statePtr->errorStack) {
	Tcl_IncrRefCount(statePtr->errorStack);
    }
    statePtr->objResult = Tcl_GetObjResult(interp);
    Tcl_IncrRefCount(statePtr->objResult);
    return (Tcl_InterpState) statePtr;
}

/*
 *----------------------------------------------------------------------
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
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







-
-
+
+







-














-
-
-
-
-
-
-







 */

int
Tcl_RestoreInterpState(
    Tcl_Interp *interp,		/* Interpreter's state to be restored. */
    Tcl_InterpState state)	/* Saved interpreter state. */
{
    Interp *iPtr = (Interp *) interp;
    InterpState *statePtr = (InterpState *) state;
    Interp *iPtr = (Interp *)interp;
    InterpState *statePtr = (InterpState *)state;
    int status = statePtr->status;

    iPtr->flags &= ~ERR_ALREADY_LOGGED;
    iPtr->flags |= (statePtr->flags & ERR_ALREADY_LOGGED);

    iPtr->returnLevel = statePtr->returnLevel;
    iPtr->returnCode = statePtr->returnCode;
    iPtr->resetErrorStack = statePtr->resetErrorStack;
    if (iPtr->errorInfo) {
	Tcl_DecrRefCount(iPtr->errorInfo);
    }
    iPtr->errorInfo = statePtr->errorInfo;
    if (iPtr->errorInfo) {
	Tcl_IncrRefCount(iPtr->errorInfo);
    }
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
    }
    iPtr->errorCode = statePtr->errorCode;
    if (iPtr->errorCode) {
	Tcl_IncrRefCount(iPtr->errorCode);
    }
    if (iPtr->errorStack) {
	Tcl_DecrRefCount(iPtr->errorStack);
    }
    iPtr->errorStack = statePtr->errorStack;
    if (iPtr->errorStack) {
	Tcl_IncrRefCount(iPtr->errorStack);
    }
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
    }
    iPtr->returnOpts = statePtr->returnOpts;
    if (iPtr->returnOpts) {
	Tcl_IncrRefCount(iPtr->returnOpts);
    }
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
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
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
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







-
+










-
-
-

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
Tcl_DiscardInterpState(
    Tcl_InterpState state)	/* saved interpreter state */
{
    InterpState *statePtr = (InterpState *) state;
    InterpState *statePtr = (InterpState *)state;

    if (statePtr->errorInfo) {
	Tcl_DecrRefCount(statePtr->errorInfo);
    }
    if (statePtr->errorCode) {
	Tcl_DecrRefCount(statePtr->errorCode);
    }
    if (statePtr->returnOpts) {
	Tcl_DecrRefCount(statePtr->returnOpts);
    }
    if (statePtr->errorStack) {
	Tcl_DecrRefCount(statePtr->errorStack);
    }
    Tcl_DecrRefCount(statePtr->objResult);
    ckfree((char *) statePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SaveResult --
 *
 *	Takes a snapshot of the current result state of the interpreter. The
 *	snapshot can be restored at any point by Tcl_RestoreResult. Note that
 *	this routine does not preserve the errorCode, errorInfo, or flags
 *	fields so it should not be used if an error is in progress.
 *
 *	Once a snapshot is saved, it must be restored by calling
 *	Tcl_RestoreResult, or discarded by calling Tcl_DiscardResult.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Resets the interpreter result.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SaveResult(
    Tcl_Interp *interp,		/* Interpreter to save. */
    Tcl_SavedResult *statePtr)	/* Pointer to state structure. */
{
    Interp *iPtr = (Interp *) interp;

    /*
     * Move the result object into the save state. Note that we don't need to
     * change its refcount because we're moving it, not adding a new
     * reference. Put an empty object into the interpreter.
     */

    statePtr->objResultPtr = iPtr->objResultPtr;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);

    /*
     * Save the string result.
     */

    statePtr->freeProc = iPtr->freeProc;
    if (iPtr->result == iPtr->resultSpace) {
	/*
	 * Copy the static string data out of the interp buffer.
	 */

	statePtr->result = statePtr->resultSpace;
	strcpy(statePtr->result, iPtr->result);
	statePtr->appendResult = NULL;
    } else if (iPtr->result == iPtr->appendResult) {
	/*
	 * Move the append buffer out of the interp.
	 */

	statePtr->appendResult = iPtr->appendResult;
	statePtr->appendAvl = iPtr->appendAvl;
	statePtr->appendUsed = iPtr->appendUsed;
	statePtr->result = statePtr->appendResult;
	iPtr->appendResult = NULL;
	iPtr->appendAvl = 0;
	iPtr->appendUsed = 0;
    } else {
	/*
	 * Move the dynamic or static string out of the interpreter.
	 */

	statePtr->result = iPtr->result;
	statePtr->appendResult = NULL;
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
    iPtr->freeProc = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_RestoreResult --
 *
 *	Restores the state of the interpreter to a snapshot taken by
 *	Tcl_SaveResult. After this call, the token for the interpreter state
 *	is no longer valid.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Restores the interpreter result.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_RestoreResult(
    Tcl_Interp *interp,		/* Interpreter being restored. */
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    Interp *iPtr = (Interp *) interp;

    Tcl_ResetResult(interp);

    /*
     * Restore the string result.
     */

    iPtr->freeProc = statePtr->freeProc;
    if (statePtr->result == statePtr->resultSpace) {
	/*
	 * Copy the static string data into the interp buffer.
	 */

	iPtr->result = iPtr->resultSpace;
	strcpy(iPtr->result, statePtr->result);
    } else if (statePtr->result == statePtr->appendResult) {
	/*
	 * Move the append buffer back into the interp.
	 */

	if (iPtr->appendResult != NULL) {
	    ckfree((char *) iPtr->appendResult);
	}

	iPtr->appendResult = statePtr->appendResult;
	iPtr->appendAvl = statePtr->appendAvl;
	iPtr->appendUsed = statePtr->appendUsed;
	iPtr->result = iPtr->appendResult;
    } else {
	/*
	 * Move the dynamic or static string back into the interpreter.
	 */

	iPtr->result = statePtr->result;
    }

    /*
     * Restore the object result.
     */

    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = statePtr->objResultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DiscardResult --
 *
 *	Frees the memory associated with an interpreter snapshot taken by
 *	Tcl_SaveResult. If the snapshot is not restored, this function must be
 *	called to discard it, or the memory will be lost.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DiscardResult(
    Tcl_SavedResult *statePtr)	/* State returned by Tcl_SaveResult. */
{
    TclDecrRefCount(statePtr->objResultPtr);

    if (statePtr->result == statePtr->appendResult) {
	ckfree(statePtr->appendResult);
    } else if (statePtr->freeProc) {
	if (statePtr->freeProc == TCL_DYNAMIC) {
    Tcl_Free(statePtr);
	    ckfree(statePtr->result);
	} else {
	    (*statePtr->freeProc)(statePtr->result);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetResult --
 *
 *	Arrange for "result" to be the Tcl return value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	interp->result is left pointing either to "result" or to a copy of it.
 *	Also, the object result is reset.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetResult(
    Tcl_Interp *interp,		/* Interpreter with which to associate the
				 * return value. */
    register char *result,	/* Value to be returned. If NULL, the result
				 * is set to an empty string. */
    Tcl_FreeProc *freeProc)	/* Gives information about the string:
				 * TCL_STATIC, TCL_VOLATILE, or the address of
				 * a Tcl_FreeProc such as free. */
{
    Interp *iPtr = (Interp *) interp;
    int length;
    register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
    char *oldResult = iPtr->result;

    if (result == NULL) {
	iPtr->resultSpace[0] = 0;
	iPtr->result = iPtr->resultSpace;
	iPtr->freeProc = 0;
    } else if (freeProc == TCL_VOLATILE) {
	length = strlen(result);
	if (length > TCL_RESULT_SIZE) {
	    iPtr->result = (char *) ckalloc((unsigned) length+1);
	    iPtr->freeProc = TCL_DYNAMIC;
	} else {
	    iPtr->result = iPtr->resultSpace;
	    iPtr->freeProc = 0;
	}
	strcpy(iPtr->result, result);
    } else {
	iPtr->result = result;
	iPtr->freeProc = freeProc;
    }

    /*
     * If the old result was dynamically-allocated, free it up. Do it here,
     * rather than at the beginning, in case the new result value was part of
     * the old result value.
     */

    if (oldFreeProc != 0) {
	if (oldFreeProc == TCL_DYNAMIC) {
	    ckfree(oldResult);
	} else {
	    (*oldFreeProc)(oldResult);
	}
    }

    /*
     * Reset the object result since we just set the string result.
     */

    ResetObjResult(iPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetStringResult --
 *
 *	Returns an interpreter's result value as a string.
 *
 * Results:
 *	The interpreter's result as a string.
 *
 * Side effects:
 *	If the string result is empty, the object result is moved to the
 *	string result, then the object result is reset.
 *
 *----------------------------------------------------------------------
 */

CONST char *
Tcl_GetStringResult(
    register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    if (*(interp->result) == 0) {
	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
		TCL_VOLATILE);
    }
    return interp->result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *
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
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







-
+


-
-
+
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
Tcl_SetObjResult(
    Tcl_Interp *interp,		/* Interpreter with which to associate the
				 * return object value. */
    Tcl_Obj *objPtr)	/* Tcl object to be returned. If NULL, the obj
    register Tcl_Obj *objPtr)	/* Tcl object to be returned. If NULL, the obj
				 * result is made an empty string object. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldObjResult = iPtr->objResultPtr;
    register Interp *iPtr = (Interp *) interp;
    register Tcl_Obj *oldObjResult = iPtr->objResultPtr;

    iPtr->objResultPtr = objPtr;
    Tcl_IncrRefCount(objPtr);	/* since interp result is a reference */

    /*
     * We wait until the end to release the old object result, in case we are
     * setting the result to itself.
     */

    TclDecrRefCount(oldObjResult);

    /*
     * Reset the string result since we just set the result object.
     */

    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    (*iPtr->freeProc)(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetObjResult --
 *
268
269
270
271
272
273
274
275



276























277
278




















































279
280
281
282
283
284
285
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
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646







-
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetObjResult(
    Tcl_Interp *interp)		/* Interpreter whose result to return. */
{
    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;
    Tcl_Obj *objResultPtr;
    int length;

    /*
     * If the string result is non-empty, move the string result to the object
     * result, then reset the string result.
     */

    if (*(iPtr->result) != 0) {
	ResetObjResult(iPtr);

	objResultPtr = iPtr->objResultPtr;
	length = strlen(iPtr->result);
	TclInitStringRep(objResultPtr, iPtr->result, length);

	if (iPtr->freeProc != NULL) {
	    if (iPtr->freeProc == TCL_DYNAMIC) {
		ckfree(iPtr->result);
	    } else {
		(*iPtr->freeProc)(iPtr->result);
	    }
	    iPtr->freeProc = 0;
	}
	iPtr->result = iPtr->resultSpace;
	iPtr->resultSpace[0] = 0;
    }
    return iPtr->objResultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendResultVA --
 *
 *	Append a variable number of strings onto the interpreter's result.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The result of the interpreter given by the first argument is extended
 *	by the strings in the va_list (up to a terminating NULL argument).
 *
 *	If the string result is non-empty, the object result forced to be a
 *	duplicate of it first. There will be a string result afterwards.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendResultVA(
    Tcl_Interp *interp,		/* Interpreter with which to associate the
				 * return value. */
    va_list argList)		/* Variable argument list. */
{
    Tcl_Obj *objPtr = Tcl_GetObjResult(interp);

    if (Tcl_IsShared(objPtr)) {
	objPtr = Tcl_DuplicateObj(objPtr);
    }
    Tcl_AppendStringsToObjVA(objPtr, argList);
    Tcl_SetObjResult(interp, objPtr);

    /*
     * Strictly we should call Tcl_GetStringResult(interp) here to make sure
     * that interp->result is correct according to the old contract, but that
     * makes the performance of much code (e.g. in Tk) absolutely awful. So we
     * leave it out; code that really wants interp->result can just insert the
     * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion]
     */

#ifdef USE_DIRECT_INTERP_RESULT_ACCESS
    /*
     * Ensure that the interp->result is legal so old Tcl 7.* code still
     * works. There's still embarrasingly much of it about...
     */

    (void) Tcl_GetStringResult(interp);
#endif /* USE_DIRECT_INTERP_RESULT_ACCESS */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendResult --
 *
 *	Append a variable number of strings onto the interpreter's result.
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
660
661
662
663
664
665
666

667
668


669












670
671
672
673
674
675
676







-


-
-
+
-
-
-
-
-
-
-
-
-
-
-
-







 */

void
Tcl_AppendResult(
    Tcl_Interp *interp, ...)
{
    va_list argList;
    Tcl_Obj *objPtr;

    va_start(argList, interp);
    objPtr = Tcl_GetObjResult(interp);

    Tcl_AppendResultVA(interp, argList);
    if (Tcl_IsShared(objPtr)) {
	objPtr = Tcl_DuplicateObj(objPtr);
    }
    while (1) {
	const char *bytes = va_arg(argList, char *);

	if (bytes == NULL) {
	    break;
	}
	Tcl_AppendToObj(objPtr, bytes, -1);
    }
    Tcl_SetObjResult(interp, objPtr);
    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendElement --
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
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
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







-
+



+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
Tcl_AppendElement(
    Tcl_Interp *interp,		/* Interpreter whose result is to be
				 * extended. */
    const char *element)	/* String to convert to list element and add
    CONST char *element)	/* String to convert to list element and add
				 * to result. */
{
    Interp *iPtr = (Interp *) interp;
    char *dst;
    int size;
    int flags;
    int quoteHash = 1;
    Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
    const char *bytes;
    size_t length;

    if (Tcl_IsShared(iPtr->objResultPtr)) {
	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
    }
    bytes = TclGetStringFromObj(iPtr->objResultPtr, &length);
    if (TclNeedSpace(bytes, bytes + length)) {
	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
    }
    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
    Tcl_DecrRefCount(listPtr);

    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    (void) Tcl_GetStringResult(interp);

    /*
     * See how much space is needed, and grow the append buffer if needed to
     * accommodate the list element.
     */

    size = Tcl_ScanElement(element, &flags) + 1;
    if ((iPtr->result != iPtr->appendResult)
	    || (iPtr->appendResult[iPtr->appendUsed] != 0)
	    || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
	SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
    }

    /*
     * Convert the string into a list element and copy it to the buffer that's
     * forming, with a space separator if needed.
     */

    dst = iPtr->appendResult + iPtr->appendUsed;
    if (TclNeedSpace(iPtr->appendResult, dst)) {
	iPtr->appendUsed++;
	*dst = ' ';
	dst++;

	/*
	 * If we need a space to separate this element from preceding stuff,
	 * then this element will not lead a list, and need not have it's
	 * leading '#' quoted.
	 */
	quoteHash = 0;
    } else {
	while ((--dst >= iPtr->appendResult) && TclIsSpaceProcM(*dst)) {
	}
	quoteHash = !TclNeedSpace(iPtr->appendResult, dst+1);
    }
    dst = iPtr->appendResult + iPtr->appendUsed;
    if (!quoteHash) {
	flags |= TCL_DONT_QUOTE_HASH;
    }

    iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * SetupAppendBuffer --
 *
 *	This function makes sure that there is an append buffer properly
 *	initialized, if necessary, from the interpreter's result, and that it
 *	has at least enough room to accommodate newSpace new bytes of
 *	information.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
SetupAppendBuffer(
    Interp *iPtr,		/* Interpreter whose result is being set up. */
    int newSpace)		/* Make sure that at least this many bytes of
				 * new information may be added. */
{
    int totalSpace;

    /*
     * Make the append buffer larger, if that's necessary, then copy the
     * result into the append buffer and make the append buffer the official
     * Tcl result.
     */

    if (iPtr->result != iPtr->appendResult) {
	/*
	 * If an oversized buffer was used recently, then free it up so we go
	 * back to a smaller buffer. This avoids tying up memory forever after
	 * a large operation.
	 */

	if (iPtr->appendAvl > 500) {
	    ckfree(iPtr->appendResult);
	    iPtr->appendResult = NULL;
	    iPtr->appendAvl = 0;
	}
	iPtr->appendUsed = strlen(iPtr->result);
    } else if (iPtr->result[iPtr->appendUsed] != 0) {
	/*
	 * Most likely someone has modified a result created by
	 * Tcl_AppendResult et al. so that it has a different size. Just
	 * recompute the size.
	 */

	iPtr->appendUsed = strlen(iPtr->result);
    }

    totalSpace = newSpace + iPtr->appendUsed;
    if (totalSpace >= iPtr->appendAvl) {
	char *new;

	if (totalSpace < 100) {
	    totalSpace = 200;
	} else {
	    totalSpace *= 2;
	}
	new = (char *) ckalloc((unsigned) totalSpace);
	strcpy(new, iPtr->result);
	if (iPtr->appendResult != NULL) {
	    ckfree(iPtr->appendResult);
	}
	iPtr->appendResult = new;
	iPtr->appendAvl = totalSpace;
    } else if (iPtr->result != iPtr->appendResult) {
	strcpy(iPtr->appendResult, iPtr->result);
    }

    Tcl_FreeResult((Tcl_Interp *) iPtr);
    iPtr->result = iPtr->appendResult;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FreeResult --
 *
 *	This function frees up the memory associated with an interpreter's
 *	string result. It also resets the interpreter's result object.
 *	Tcl_FreeResult is most commonly used when a function is about to
 *	replace one result value with another.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees the memory associated with interp's string result and sets
 *	interp->freeProc to zero, but does not change interp->result or clear
 *	error state. Resets interp's result object to an unshared empty
 *	object.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FreeResult(
    register Tcl_Interp *interp)/* Interpreter for which to free result. */
{
    register Interp *iPtr = (Interp *) interp;

    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    (*iPtr->freeProc)(iPtr->result);
	}
	iPtr->freeProc = 0;
    }

    ResetObjResult(iPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ResetResult --
 *
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
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







-
+

-
+


+
+
+
+
+
+
+
+
+
+


















-







 *	It also clears any error information for the interpreter.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ResetResult(
    Tcl_Interp *interp)/* Interpreter for which to clear result. */
    register Tcl_Interp *interp)/* Interpreter for which to clear result. */
{
    Interp *iPtr = (Interp *) interp;
    register Interp *iPtr = (Interp *) interp;

    ResetObjResult(iPtr);
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    ckfree(iPtr->result);
	} else {
	    (*iPtr->freeProc)(iPtr->result);
	}
	iPtr->freeProc = 0;
    }
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
    if (iPtr->errorCode) {
	/* Legacy support */
	if (iPtr->flags & ERR_LEGACY_COPY) {
	    Tcl_ObjSetVar2(interp, iPtr->ecVar, NULL,
		    iPtr->errorCode, TCL_GLOBAL_ONLY);
	}
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }
    if (iPtr->errorInfo) {
	/* Legacy support */
	if (iPtr->flags & ERR_LEGACY_COPY) {
	    Tcl_ObjSetVar2(interp, iPtr->eiVar, NULL,
		    iPtr->errorInfo, TCL_GLOBAL_ONLY);
	}
	Tcl_DecrRefCount(iPtr->errorInfo);
	iPtr->errorInfo = NULL;
    }
    iPtr->resetErrorStack = 1;
    iPtr->returnLevel = 1;
    iPtr->returnCode = TCL_OK;
    if (iPtr->returnOpts) {
	Tcl_DecrRefCount(iPtr->returnOpts);
	iPtr->returnOpts = NULL;
    }
    iPtr->flags &= ~(ERR_ALREADY_LOGGED | ERR_LEGACY_COPY);
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
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







-
+


-
+







-
+

-
+

-
+



+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
ResetObjResult(
    Interp *iPtr)	/* Points to the interpreter whose result
    register Interp *iPtr)	/* Points to the interpreter whose result
				 * object should be reset. */
{
    Tcl_Obj *objResultPtr = iPtr->objResultPtr;
    register Tcl_Obj *objResultPtr = iPtr->objResultPtr;

    if (Tcl_IsShared(objResultPtr)) {
	TclDecrRefCount(objResultPtr);
	TclNewObj(objResultPtr);
	Tcl_IncrRefCount(objResultPtr);
	iPtr->objResultPtr = objResultPtr;
    } else {
	if (objResultPtr->bytes != &tclEmptyString) {
	if (objResultPtr->bytes != tclEmptyStringRep) {
	    if (objResultPtr->bytes) {
		Tcl_Free(objResultPtr->bytes);
		ckfree((char *) objResultPtr->bytes);
	    }
	    objResultPtr->bytes = &tclEmptyString;
	    objResultPtr->bytes = tclEmptyStringRep;
	    objResultPtr->length = 0;
	}
	TclFreeIntRep(objResultPtr);
	objResultPtr->typePtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrorCodeVA --
 *
 *	This function is called to record machine-readable information about
 *	an error that is about to be returned.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The errorCode field of the interp is modified to hold all of the
 *	arguments to this function, in a list form with each argument becoming
 *	one element of the list.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetErrorCodeVA(
    Tcl_Interp *interp,		/* Interpreter in which to set errorCode */
    va_list argList)		/* Variable argument list. */
{
    Tcl_Obj *errorObj = Tcl_NewObj();

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    while (1) {
	char *elem = va_arg(argList, char *);
	if (elem == NULL) {
	    break;
	}
	Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
    }
    Tcl_SetObjErrorCode(interp, errorObj);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrorCode --
 *
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
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055


1056














1057
1058
1059
1060
1061
1062
1063







-







-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 */

void
Tcl_SetErrorCode(
    Tcl_Interp *interp, ...)
{
    va_list argList;
    Tcl_Obj *errorObj;

    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    va_start(argList, interp);
    errorObj = Tcl_NewObj();

    Tcl_SetErrorCodeVA(interp, argList);
    /*
     * Scan through the arguments one at a time, appending them to the
     * errorCode field as list elements.
     */

    while (1) {
	char *elem = va_arg(argList, char *);

	if (elem == NULL) {
	    break;
	}
	Tcl_ListObjAppendElement(NULL, errorObj, Tcl_NewStringObj(elem, -1));
    }
    Tcl_SetObjErrorCode(interp, errorObj);
    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjErrorCode --
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
611
612
613


614
615
616
617
618
619
620
621
622
623
624
625
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
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
-
+
+








-
-
+
+












-











-
+
















-
+







    iPtr->errorCode = errorObjPtr;
    Tcl_IncrRefCount(iPtr->errorCode);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetErrorLine --
 *
 *      Returns the line number associated with the current error.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetErrorLine(
    Tcl_Interp *interp)
{
    return ((Interp *) interp)->errorLine;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetErrorLine --
 *
 *      Sets the line number associated with the current error.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetErrorLine(
    Tcl_Interp *interp,
    int value)
{
    ((Interp *) interp)->errorLine = value;
}

/*
 *----------------------------------------------------------------------
 *
 * GetKeys --
 *
 *	Returns a Tcl_Obj * array of the standard keys used in the return
 *	options dictionary.
 *
 *	Broadly sharing one copy of these key values helps with both memory
 *	efficiency and dictionary lookup times.
 *
 * Results:
 *	A Tcl_Obj * array.
 *
 * Side effects:
 *	First time called in a thread, creates the keys (allocating memory)
 *	and arranges for their cleanup at thread exit.
 * 	First time called in a thread, creates the keys (allocating memory)
 * 	and arranges for their cleanup at thread exit.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj **
GetKeys(void)
{
    static Tcl_ThreadDataKey returnKeysKey;
    Tcl_Obj **keys = (Tcl_Obj **)Tcl_GetThreadData(&returnKeysKey,
	    KEY_LAST * sizeof(Tcl_Obj *));
    Tcl_Obj **keys = Tcl_GetThreadData(&returnKeysKey,
	    (int) (KEY_LAST * sizeof(Tcl_Obj *)));

    if (keys[0] == NULL) {
	/*
	 * First call in this thread, create the keys...
	 */

	int i;

	TclNewLiteralStringObj(keys[KEY_CODE],	    "-code");
	TclNewLiteralStringObj(keys[KEY_ERRORCODE], "-errorcode");
	TclNewLiteralStringObj(keys[KEY_ERRORINFO], "-errorinfo");
	TclNewLiteralStringObj(keys[KEY_ERRORLINE], "-errorline");
	TclNewLiteralStringObj(keys[KEY_ERRORSTACK],"-errorstack");
	TclNewLiteralStringObj(keys[KEY_LEVEL],	    "-level");
	TclNewLiteralStringObj(keys[KEY_OPTIONS],   "-options");

	for (i = KEY_CODE; i < KEY_LAST; i++) {
	    Tcl_IncrRefCount(keys[i]);
	}

	/*
	 * ... and arrange for their clenaup.
	 */

	Tcl_CreateThreadExitHandler(ReleaseKeys, keys);
	Tcl_CreateThreadExitHandler(ReleaseKeys, (ClientData) keys);
    }
    return keys;
}

/*
 *----------------------------------------------------------------------
 *
 * ReleaseKeys --
 *
 *	Called as a thread exit handler to cleanup return options dictionary
 *	keys.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees memory.
 * 	Frees memory.
 *
 *----------------------------------------------------------------------
 */

static void
ReleaseKeys(
    ClientData clientData)
681
682
683
684
685
686
687
688

689
690
691
692
693
694
695
1185
1186
1187
1188
1189
1190
1191

1192
1193
1194
1195
1196
1197
1198
1199







-
+







 *	-level entry in returnOpts, as is the case for values returned from
 *	TclMergeReturnOptions.
 *
 * Results:
 *	Returns the return code the [return] command should return.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclProcessReturn(
    Tcl_Interp *interp,
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
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







-
+
-

-
+

-
-
+
+





-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+
-







    }

    if (code == TCL_ERROR) {
	if (iPtr->errorInfo) {
	    Tcl_DecrRefCount(iPtr->errorInfo);
	    iPtr->errorInfo = NULL;
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO], &valuePtr);
                &valuePtr);
	if (valuePtr != NULL) {
	    size_t length;
	    int infoLen;

	    (void) TclGetStringFromObj(valuePtr, &length);
	    if (length) {
	    (void) TclGetStringFromObj(valuePtr, &infoLen);
	    if (infoLen) {
		iPtr->errorInfo = valuePtr;
		Tcl_IncrRefCount(iPtr->errorInfo);
		iPtr->flags |= ERR_ALREADY_LOGGED;
	    }
	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORSTACK],
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE], &valuePtr);
                &valuePtr);
	if (valuePtr != NULL) {
            int len, valueObjc;
            Tcl_Obj **valueObjv;

            if (Tcl_IsShared(iPtr->errorStack)) {
                Tcl_Obj *newObj;

                newObj = Tcl_DuplicateObj(iPtr->errorStack);
                Tcl_DecrRefCount(iPtr->errorStack);
                Tcl_IncrRefCount(newObj);
                iPtr->errorStack = newObj;
            }

            /*
             * List extraction done after duplication to avoid moving the rug
             * if someone does [return -errorstack [info errorstack]]
             */

            if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc,
                    &valueObjv) == TCL_ERROR) {
                return TCL_ERROR;
            }
            iPtr->resetErrorStack = 0;
            Tcl_ListObjLength(interp, iPtr->errorStack, &len);

            /*
             * Reset while keeping the list intrep as much as possible.
             */

            Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, valueObjc,
                    valueObjv);
 	}
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORCODE],
                &valuePtr);
	if (valuePtr != NULL) {
	    Tcl_SetObjErrorCode(interp, valuePtr);
	} else {
	    Tcl_SetErrorCode(interp, "NONE", NULL);
	}

	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE],
	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORLINE], &valuePtr);
                &valuePtr);
	if (valuePtr != NULL) {
	    TclGetIntFromObj(NULL, valuePtr, &iPtr->errorLine);
	}
    }
    if (level != 0) {
	iPtr->returnLevel = level;
	iPtr->returnCode = code;
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
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







-
+




-
+








-
+


-
+

-
+

-
+

-
+


-
+


-

+
-
-
+
+
+
+

-
-
+












+
-
-
-
+
+
+
-
-







 *----------------------------------------------------------------------
 *
 * TclMergeReturnOptions --
 *
 *	Parses, checks, and stores the options to the [return] command.
 *
 * Results:
 *	Returns TCL_ERROR if any of the option values are invalid. Otherwise,
 *	Returns TCL_ERROR is any of the option values are invalid. Otherwise,
 *	returns TCL_OK, and writes the returnOpts, code, and level values to
 *	the pointers provided.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMergeReturnOptions(
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[],	/* Argument objects. */
    Tcl_Obj *CONST objv[],	/* Argument objects. */
    Tcl_Obj **optionsPtrPtr,	/* If not NULL, points to space for a (Tcl_Obj
				 * *) where the pointer to the merged return
				 * options dictionary should be written. */
				 * options dictionary should be written */
    int *codePtr,		/* If not NULL, points to space where the
				 * -code value should be written. */
				 * -code value should be written */
    int *levelPtr)		/* If not NULL, points to space where the
				 * -level value should be written. */
				 * -level value should be written */
{
    int code = TCL_OK;
    int code=TCL_OK;
    int level = 1;
    Tcl_Obj *valuePtr;
    Tcl_Obj *returnOpts;
    Tcl_Obj *returnOpts = Tcl_NewObj();
    Tcl_Obj **keys = GetKeys();

    TclNewObj(returnOpts);
    for (;  objc > 1;  objv += 2, objc -= 2) {
	int optLen;
	const char *opt = TclGetString(objv[0]);
	const char *compare = TclGetString(keys[KEY_OPTIONS]);
	CONST char *opt = TclGetStringFromObj(objv[0], &optLen);
	int compareLen;
	CONST char *compare =
		TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);

	if ((objv[0]->length == keys[KEY_OPTIONS]->length)
		&& (memcmp(opt, compare, objv[0]->length) == 0)) {
	if ((optLen == compareLen) && (strcmp(opt, compare) == 0)) {
	    Tcl_DictSearch search;
	    int done = 0;
	    Tcl_Obj *keyPtr;
	    Tcl_Obj *dict = objv[1];

	nestedOptions:
	    if (TCL_ERROR == Tcl_DictObjFirst(NULL, dict, &search,
		    &keyPtr, &valuePtr, &done)) {
		/*
		 * Value is not a legal dictionary.
		 */

		Tcl_ResetResult(interp);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "bad %s value: expected dictionary but got \"%s\"",
                        compare, TclGetString(objv[1])));
		Tcl_AppendResult(interp, "bad ", compare,
			" value: expected dictionary but got \"",
			TclGetString(objv[1]), "\"", NULL);
		Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS",
			NULL);
		goto error;
	    }

	    while (!done) {
		Tcl_DictObjPut(NULL, returnOpts, keyPtr, valuePtr);
		Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
	    }
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
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

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







-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+















+
-
-
-
+
+
+
-

















-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-


-
-
-
-
-
-
-
-
-
-
-
-







    }

    /*
     * Check for bogus -code value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_CODE], &valuePtr);
    if (valuePtr != NULL) {
	if (TclGetCompletionCodeFromObj(interp, valuePtr,
                &code) == TCL_ERROR) {
    if ((valuePtr != NULL)
	    && (TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &code))) {
	static CONST char *returnCodes[] = {
	    "ok", "error", "return", "break", "continue", NULL
	};

	if (TCL_ERROR == Tcl_GetIndexFromObj(NULL, valuePtr, returnCodes,
		NULL, TCL_EXACT, &code)) {
	    /*
	     * Value is not a legal return code.
	     */

	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "bad completion code \"",
		    TclGetString(valuePtr),
		    "\": must be ok, error, return, break, "
		    "continue, or an integer", NULL);
	    goto error;
	}
    }
    if (valuePtr != NULL) {
	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_CODE]);
    }

    /*
     * Check for bogus -level value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_LEVEL], &valuePtr);
    if (valuePtr != NULL) {
	if ((TCL_ERROR == TclGetIntFromObj(NULL, valuePtr, &level))
		|| (level < 0)) {
	    /*
	     * Value is not a legal level.
	     */

	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "bad -level value: expected non-negative integer but got"
                    " \"%s\"", TclGetString(valuePtr)));
	    Tcl_AppendResult(interp, "bad -level value: "
		    "expected non-negative integer but got \"",
		    TclGetString(valuePtr), "\"", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_LEVEL", NULL);
	    goto error;
	}
	Tcl_DictObjRemove(NULL, returnOpts, keys[KEY_LEVEL]);
    }

    /*
     * Check for bogus -errorcode value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORCODE], &valuePtr);
    if (valuePtr != NULL) {
	int length;

	if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
	    /*
	     * Value is not a list, which is illegal for -errorcode.
	     */

	    Tcl_ResetResult(interp);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "bad -errorcode value: expected a list but got \"%s\"",
	    Tcl_AppendResult(interp, "bad -errorcode value: "
                    TclGetString(valuePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_ERRORCODE",
		    NULL);
	    goto error;
	}
    }

    /*
     * Check for bogus -errorstack value.
     */

    Tcl_DictObjGet(NULL, returnOpts, keys[KEY_ERRORSTACK], &valuePtr);
    if (valuePtr != NULL) {
	int length;

	if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) {
	    /*
	     * Value is not a list, which is illegal for -errorstack.
	     */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "bad -errorstack value: expected a list but got \"%s\"",
                    TclGetString(valuePtr)));
			     "expected a list but got \"",
			     TclGetString(valuePtr), "\"", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "RESULT", "NONLIST_ERRORSTACK",
                    NULL);
	    goto error;
	}
        if (length % 2) {
            /*
             * Errorstack must always be an even-sized list
             */

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "forbidden odd-sized list for -errorstack: \"%s\"",
		    TclGetString(valuePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "RESULT",
                    "ODDSIZEDLIST_ERRORSTACK", NULL);
	    goto error;
        }
    }

    /*
     * Convert [return -code return -level X] to [return -code ok -level X+1]
     */

    if (code == TCL_RETURN) {
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
1463
1464
1465
1466
1467
1468
1469

1470
1471
1472
1473
1474

1475
1476

1477
1478
1479

1480
1481

1482
1483
1484
1485

1486

1487
1488
1489
1490
1491
1492
1493

1494
1495

























1496
1497
1498
1499
1500
1501
1502







-
+




-
+

-
+


-
+

-
+



-
+
-







-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *options;
    Tcl_Obj **keys = GetKeys();

    if (iPtr->returnOpts) {
	options = Tcl_DuplicateObj(iPtr->returnOpts);
    } else {
	TclNewObj(options);
	options = Tcl_NewObj();
    }

    if (result == TCL_RETURN) {
	Tcl_DictObjPut(NULL, options, keys[KEY_CODE],
		Tcl_NewWideIntObj(iPtr->returnCode));
		Tcl_NewIntObj(iPtr->returnCode));
	Tcl_DictObjPut(NULL, options, keys[KEY_LEVEL],
		Tcl_NewWideIntObj(iPtr->returnLevel));
		Tcl_NewIntObj(iPtr->returnLevel));
    } else {
	Tcl_DictObjPut(NULL, options, keys[KEY_CODE],
		Tcl_NewWideIntObj(result));
		Tcl_NewIntObj(result));
	Tcl_DictObjPut(NULL, options, keys[KEY_LEVEL],
		Tcl_NewWideIntObj(0));
		Tcl_NewIntObj(0));
    }

    if (result == TCL_ERROR) {
	Tcl_AddErrorInfo(interp, "");
	Tcl_AddObjErrorInfo(interp, "", -1);
        Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack);
    }
    if (iPtr->errorCode) {
	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORCODE], iPtr->errorCode);
    }
    if (iPtr->errorInfo) {
	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORINFO], iPtr->errorInfo);
	Tcl_DictObjPut(NULL, options, keys[KEY_ERRORLINE],
		Tcl_NewWideIntObj(iPtr->errorLine));
		Tcl_NewIntObj(iPtr->errorLine));
    }
    return options;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclNoErrorStack --
 *
 *	Removes the -errorstack entry from an options dict to avoid reference
 *	cycles.
 *
 * Results:
 *	The (unshared) argument options dict, modified in -place.
 *
 *-------------------------------------------------------------------------
 */

Tcl_Obj *
TclNoErrorStack(
    Tcl_Interp *interp,
    Tcl_Obj *options)
{
    Tcl_Obj **keys = GetKeys();

    Tcl_DictObjRemove(interp, options, keys[KEY_ERRORSTACK]);
    return options;
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_SetReturnOptions --
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
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
1523
1524
1525
1526
1527
1528
1529



1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547

1548
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
1596
1597
1598
1599
1600
1601
1602
1603
1604

1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616


1617
1618







-
-
-
+
+
+















-
+

-
+



+
+
+
+
+
+
+

-
-
+
+
+
+
-








-
-
+
+



-
-
+
+
-
-
-
-
+
+










-
+











-
+











-
-


{
    int objc, level, code;
    Tcl_Obj **objv, *mergedOpts;

    Tcl_IncrRefCount(options);
    if (TCL_ERROR == TclListObjGetElements(interp, options, &objc, &objv)
	    || (objc % 2)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "expected dict but got \"%s\"", TclGetString(options)));
	Tcl_SetErrorCode(interp, "TCL", "RESULT", "ILLEGAL_OPTIONS", NULL);
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "expected dict but got \"",
		TclGetString(options), "\"", NULL);
	code = TCL_ERROR;
    } else if (TCL_ERROR == TclMergeReturnOptions(interp, objc, objv,
	    &mergedOpts, &code, &level)) {
	code = TCL_ERROR;
    } else {
	code = TclProcessReturn(interp, code, level, mergedOpts);
    }

    Tcl_DecrRefCount(options);
    return code;
}

/*
 *-------------------------------------------------------------------------
 *
 * Tcl_TransferResult --
 * TclTransferResult --
 *
 *	Transfer the result (and error information) from one interp to another.
 *	Copy the result (and error information) from one interp to another.
 *	Used when one interp has caused another interp to evaluate a script
 *	and then wants to transfer the results back to itself.
 *
 *	This routine copies the string reps of the result and error
 *	information. It does not simply increment the refcounts of the result
 *	and error information objects themselves. It is not legal to exchange
 *	objects between interps, because an object may be kept alive by one
 *	interp, but have an internal rep that is only valid while some other
 *	interp is alive.
 *
 * Results:
 *	The result of targetInterp is set to the result read from sourceInterp.
 *	The return options dictionary of sourceInterp is transferred to
 *	The target interp's result is set to a copy of the source interp's
 *	result. The source's errorInfo field may be transferred to the
 *	target's errorInfo field, and the source's errorCode field may be
 *	transferred to the target's errorCode field.
 *	targetInterp as appropriate for the return code value code.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

void
Tcl_TransferResult(
    Tcl_Interp *sourceInterp,	/* Interp whose result and return options
TclTransferResult(
    Tcl_Interp *sourceInterp,	/* Interp whose result and error information
				 * should be moved to the target interp.
				 * After moving result, this interp's result
				 * is reset. */
    int code,			/* The return code value active in
				 * sourceInterp. Controls how the return options
    int result,			/* TCL_OK if just the result should be copied,
				 * TCL_ERROR if both the result and error
				 * dictionary is retrieved from sourceInterp,
				 * same as in Tcl_GetReturnOptions, to then be
				 * transferred to targetInterp. */
    Tcl_Interp *targetInterp)	/* Interp where result and return options
				 * information should be copied. */
    Tcl_Interp *targetInterp)	/* Interp where result and error information
				 * should be stored. If source and target are
				 * the same, nothing is done. */
{
    Interp *tiPtr = (Interp *) targetInterp;
    Interp *siPtr = (Interp *) sourceInterp;

    if (sourceInterp == targetInterp) {
	return;
    }

    if (code == TCL_OK && siPtr->returnOpts == NULL) {
    if (result == TCL_OK && siPtr->returnOpts == NULL) {
	/*
	 * Special optimization for the common case of normal command return
	 * code and no explicit return options.
	 */

	if (tiPtr->returnOpts) {
	    Tcl_DecrRefCount(tiPtr->returnOpts);
	    tiPtr->returnOpts = NULL;
	}
    } else {
	Tcl_SetReturnOptions(targetInterp,
		Tcl_GetReturnOptions(sourceInterp, code));
		Tcl_GetReturnOptions(sourceInterp, result));
	tiPtr->flags &= ~(ERR_ALREADY_LOGGED);
    }
    Tcl_SetObjResult(targetInterp, Tcl_GetObjResult(sourceInterp));
    Tcl_ResetResult(sourceInterp);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to generic/tclScan.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41



42

43
44
45
46
47
48
49

50
51
52

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

74
75
76

77
78

79
80

81
82
83
84

85
86
87
88

89
90
91
92
93
94
95
96
97

98
99
100
101
102
103
104

105
106
107


108
109

110
111
112
113
114
115
116
117
118
119

120
121
122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140

141
142
143
144

145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

163
164
165
166
167
168
169
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












-


















-
+
-
-
-
-
-




+
+
+
-
+






-
+


-
+




















-
+


-
+

-
+

-
+



-
+



-
+








-
+






-
+


-
+
+

-
+









-
+



-
+
















-
+



-
+

















-
+







/*
 * tclScan.c --
 *
 *	This file contains the implementation of the "scan" command.
 *
 * Copyright (c) 1998 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"
#include "tclTomMath.h"

/*
 * Flag values used by Tcl_ScanObjCmd.
 */

#define SCAN_NOSKIP	0x1		/* Don't skip blanks. */
#define SCAN_SUPPRESS	0x2		/* Suppress assignment. */
#define SCAN_UNSIGNED	0x4		/* Read an unsigned value. */
#define SCAN_WIDTH	0x8		/* A width value was supplied. */

#define SCAN_LONGER	0x400		/* Asked for a wide value. */
#define SCAN_BIG	0x800		/* Asked for a bignum value. */

/*
 * The following structure contains the information associated with a
 * character set.
 */

typedef struct {
typedef struct CharSet {
    Tcl_UniChar start;
    Tcl_UniChar end;
} Range;

typedef struct {
    int exclude;		/* 1 if this is an exclusion set. */
    int nchars;
    Tcl_UniChar *chars;
    int nranges;
    struct Range {
	Tcl_UniChar start;
	Tcl_UniChar end;
    Range *ranges;
    } *ranges;
} CharSet;

/*
 * Declarations for functions used only in this file.
 */

static const char *	BuildCharSet(CharSet *cset, const char *format);
static char *		BuildCharSet(CharSet *cset, char *format);
static int		CharInSet(CharSet *cset, int ch);
static void		ReleaseCharSet(CharSet *cset);
static int		ValidateFormat(Tcl_Interp *interp, const char *format,
static int		ValidateFormat(Tcl_Interp *interp, char *format,
			    int numVars, int *totalVars);

/*
 *----------------------------------------------------------------------
 *
 * BuildCharSet --
 *
 *	This function examines a character set format specification and builds
 *	a CharSet containing the individual characters and character ranges
 *	specified.
 *
 * Results:
 *	Returns the next format position.
 *
 * Side effects:
 *	Initializes the charset.
 *
 *----------------------------------------------------------------------
 */

static const char *
static char *
BuildCharSet(
    CharSet *cset,
    const char *format)		/* Points to first char of set. */
    char *format)		/* Points to first char of set. */
{
    Tcl_UniChar ch = 0, start;
    Tcl_UniChar ch, start;
    int offset, nranges;
    const char *end;
    char *end;

    memset(cset, 0, sizeof(CharSet));

    offset = TclUtfToUniChar(format, &ch);
    offset = Tcl_UtfToUniChar(format, &ch);
    if (ch == '^') {
	cset->exclude = 1;
	format += offset;
	offset = TclUtfToUniChar(format, &ch);
	offset = Tcl_UtfToUniChar(format, &ch);
    }
    end = format + offset;

    /*
     * Find the close bracket so we can overallocate the set.
     */

    if (ch == ']') {
	end += TclUtfToUniChar(end, &ch);
	end += Tcl_UtfToUniChar(end, &ch);
    }
    nranges = 0;
    while (ch != ']') {
	if (ch == '-') {
	    nranges++;
	}
	end += TclUtfToUniChar(end, &ch);
	end += Tcl_UtfToUniChar(end, &ch);
    }

    cset->chars = (Tcl_UniChar *)Tcl_Alloc(sizeof(Tcl_UniChar) * (end - format - 1));
    cset->chars = (Tcl_UniChar *)
	    ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
    if (nranges > 0) {
	cset->ranges = (Range *)Tcl_Alloc(sizeof(Range) * nranges);
	cset->ranges = (struct Range *) ckalloc(sizeof(struct Range)*nranges);
    } else {
	cset->ranges = NULL;
    }

    /*
     * Now build the character set.
     */

    cset->nchars = cset->nranges = 0;
    format += TclUtfToUniChar(format, &ch);
    format += Tcl_UtfToUniChar(format, &ch);
    start = ch;
    if (ch == ']' || ch == '-') {
	cset->chars[cset->nchars++] = ch;
	format += TclUtfToUniChar(format, &ch);
	format += Tcl_UtfToUniChar(format, &ch);
    }
    while (ch != ']') {
	if (*format == '-') {
	    /*
	     * This may be the first character of a range, so don't add it
	     * yet.
	     */

	    start = ch;
	} else if (ch == '-') {
	    /*
	     * Check to see if this is the last character in the set, in which
	     * case it is not a range and we should add the previous character
	     * as well as the dash.
	     */

	    if (*format == ']' || !cset->ranges) {
	    if (*format == ']') {
		cset->chars[cset->nchars++] = start;
		cset->chars[cset->nchars++] = ch;
	    } else {
		format += TclUtfToUniChar(format, &ch);
		format += Tcl_UtfToUniChar(format, &ch);

		/*
		 * Check to see if the range is in reverse order.
		 */

		if (start < ch) {
		    cset->ranges[cset->nranges].start = start;
		    cset->ranges[cset->nranges].end = ch;
		} else {
		    cset->ranges[cset->nranges].start = ch;
		    cset->ranges[cset->nranges].end = start;
		}
		cset->nranges++;
	    }
	} else {
	    cset->chars[cset->nchars++] = ch;
	}
	format += TclUtfToUniChar(format, &ch);
	format += Tcl_UtfToUniChar(format, &ch);
    }
    return format;
}

/*
 *----------------------------------------------------------------------
 *
222
223
224
225
226
227
228
229

230
231

232
233
234
235
236
237
238
220
221
222
223
224
225
226

227
228

229
230
231
232
233
234
235
236







-
+

-
+







 *----------------------------------------------------------------------
 */

static void
ReleaseCharSet(
    CharSet *cset)
{
    Tcl_Free(cset->chars);
    ckfree((char *)cset->chars);
    if (cset->ranges) {
	Tcl_Free(cset->ranges);
	ckfree((char *)cset->ranges);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ValidateFormat --
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
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







-
+







-
+

-
+
-
-
-
-
-
+














-
+






-
+





-
+















-
+







 *
 *----------------------------------------------------------------------
 */

static int
ValidateFormat(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *format,		/* The format string. */
    char *format,		/* The format string. */
    int numVars,		/* The number of variables passed to the scan
				 * command. */
    int *totalSubs)		/* The number of variables that will be
				 * required. */
{
    int gotXpg, gotSequential, value, i, flags;
    char *end;
    Tcl_UniChar ch = 0;
    Tcl_UniChar ch;
    int objIndex, xpgSize, nspace = numVars;
    int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int));
    int *nassign = (int *) TclStackAlloc(interp, nspace * sizeof(int));
    Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
				 * these are messy operations because we do
				 * not want to use the formatting engine;
				 * we're inside there! */
    char buf[5] = "";
    char buf[TCL_UTF_MAX+1];

    /*
     * Initialize an array that records the number of times a variable is
     * assigned to by the format string. We use this to detect if a variable
     * is multiply assigned or left unassigned.
     */

    for (i = 0; i < nspace; i++) {
	nassign[i] = 0;
    }

    xpgSize = objIndex = gotXpg = gotSequential = 0;

    while (*format != '\0') {
	format += TclUtfToUniChar(format, &ch);
	format += Tcl_UtfToUniChar(format, &ch);

	flags = 0;

	if (ch != '%') {
	    continue;
	}
	format += TclUtfToUniChar(format, &ch);
	format += Tcl_UtfToUniChar(format, &ch);
	if (ch == '%') {
	    continue;
	}
	if (ch == '*') {
	    flags |= SCAN_SUPPRESS;
	    format += TclUtfToUniChar(format, &ch);
	    format += Tcl_UtfToUniChar(format, &ch);
	    goto xpgCheckDone;
	}

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    /*
	     * Check for an XPG3-style %n$ specification. Note: there must
	     * not be a mixture of XPG3 specs and non-XPG3 specs in the same
	     * format string.
	     */

	    value = strtoul(format-1, &end, 10);	/* INTL: "C" locale. */
	    if (*end != '$') {
		goto notXpg;
	    }
	    format = end+1;
	    format += TclUtfToUniChar(format, &ch);
	    format += Tcl_UtfToUniChar(format, &ch);
	    gotXpg = 1;
	    if (gotSequential) {
		goto mixedXPG;
	    }
	    objIndex = value - 1;
	    if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
		goto badIndex;
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
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
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
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







-
+

-
+
-









-
+

-
+











-
+







-
+













-
+

-
+
-








-
-
+
+
-
-
+
-
-















-
+

+
+
+
+
+











-
+




-
+





-
+





-
+



-
-
+
-
+


+
+
+
-
+
-
-
+
-
-
+
-
-
-
+
+















-
+







	    goto xpgCheckDone;
	}

    notXpg:
	gotSequential = 1;
	if (gotXpg) {
	mixedXPG:
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    Tcl_SetResult(interp,
		    "cannot mix \"%\" and \"%n$\" conversion specifiers",
		    -1));
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "MIXEDSPECTYPES", NULL);
	    goto error;
	}

    xpgCheckDone:
	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    value = strtoul(format-1, (char **) &format, 10);	/* INTL: "C" locale. */
	    value = strtoul(format-1, &format, 10);	/* INTL: "C" locale. */
	    flags |= SCAN_WIDTH;
	    format += TclUtfToUniChar(format, &ch);
	    format += Tcl_UtfToUniChar(format, &ch);
	}

	/*
	 * Handle any size specifier.
	 */

	switch (ch) {
	case 'l':
	    if (*format == 'l') {
		flags |= SCAN_BIG;
		format += 1;
		format += TclUtfToUniChar(format, &ch);
		format += Tcl_UtfToUniChar(format, &ch);
		break;
	    }
	    /* FALLTHRU */
	case 'L':
	    flags |= SCAN_LONGER;
	    /* FALLTHRU */
	case 'h':
	    format += TclUtfToUniChar(format, &ch);
	    format += Tcl_UtfToUniChar(format, &ch);
	}

	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
	    goto badIndex;
	}

	/*
	 * Handle the various field types.
	 */

	switch (ch) {
	case 'c':
	    if (flags & SCAN_WIDTH) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
		Tcl_SetResult(interp,
			"field width may not be specified in %c conversion",
			-1));
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADWIDTH", NULL);
		goto error;
	    }
	    /* FALLTHRU */
	case 'n':
	case 's':
	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
	    invalidFieldSize:
		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
		errorMsg = Tcl_NewStringObj(
			"field size modifier may not be specified in %", -1);
		Tcl_AppendResult(interp,
			"field size modifier may not be specified in %", buf,
		Tcl_AppendToObj(errorMsg, buf, -1);
		Tcl_AppendToObj(errorMsg, " conversion", -1);
			" conversion", NULL);
		Tcl_SetObjResult(interp, errorMsg);
		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADSIZE", NULL);
		goto error;
	    }
	    /*
	     * Fall through!
	     */
	case 'd':
	case 'e':
	case 'E':
	case 'f':
	case 'g':
	case 'G':
	case 'i':
	case 'o':
	case 'x':
	case 'X':
	case 'b':
	    break;
	case 'u':
	    if (flags & SCAN_BIG) {
		Tcl_SetResult(interp,
			"unsigned bignum scans are invalid", TCL_STATIC);
		goto error;
	    }
	    break;
	    /*
	     * Bracket terms need special checking
	     */
	case '[':
	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
		goto invalidFieldSize;
	    }
	    if (*format == '\0') {
		goto badSet;
	    }
	    format += TclUtfToUniChar(format, &ch);
	    format += Tcl_UtfToUniChar(format, &ch);
	    if (ch == '^') {
		if (*format == '\0') {
		    goto badSet;
		}
		format += TclUtfToUniChar(format, &ch);
		format += Tcl_UtfToUniChar(format, &ch);
	    }
	    if (ch == ']') {
		if (*format == '\0') {
		    goto badSet;
		}
		format += TclUtfToUniChar(format, &ch);
		format += Tcl_UtfToUniChar(format, &ch);
	    }
	    while (ch != ']') {
		if (*format == '\0') {
		    goto badSet;
		}
		format += TclUtfToUniChar(format, &ch);
		format += Tcl_UtfToUniChar(format, &ch);
	    }
	    break;
	badSet:
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "unmatched [ in format string", -1));
	    Tcl_SetResult(interp, "unmatched [ in format string",
	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BRACKET", NULL);
		    TCL_STATIC);
	    goto error;
	default:
	    {
		char buf[TCL_UTF_MAX+1];

	    buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	    errorMsg = Tcl_NewStringObj(
		    "bad scan conversion character \"", -1);
		Tcl_AppendResult(interp, "bad scan conversion character \"",
	    Tcl_AppendToObj(errorMsg, buf, -1);
	    Tcl_AppendToObj(errorMsg, "\"", -1);
			buf, "\"", NULL);
	    Tcl_SetObjResult(interp, errorMsg);
	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
	    goto error;
		goto error;
	    }
	}
	if (!(flags & SCAN_SUPPRESS)) {
	    if (objIndex >= nspace) {
		/*
		 * Expand the nassign buffer. If we are using XPG specifiers,
		 * make sure that we grow to a large enough size. xpgSize is
		 * guaranteed to be at least one larger than objIndex.
		 */

		value = nspace;
		if (xpgSize) {
		    nspace = xpgSize;
		} else {
		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
		}
		nassign = (int *)TclStackRealloc(interp, nassign,
		nassign = (int *) TclStackRealloc(interp, nassign,
			nspace * sizeof(int));
		for (i = value; i < nspace; i++) {
		    nassign[i] = 0;
		}
	    }
	    nassign[objIndex]++;
	    objIndex++;
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
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







-
+

-
+
-







-
+

-
+
-









-
-
+
-
+

-
+

-
+
-







	}
    }
    if (totalSubs) {
	*totalSubs = numVars;
    }
    for (i = 0; i < numVars; i++) {
	if (nassign[i] > 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    Tcl_SetResult(interp,
		    "variable is assigned by multiple \"%n$\" conversion specifiers",
		    -1));
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "POLYASSIGNED", NULL);
	    goto error;
	} else if (!xpgSize && (nassign[i] == 0)) {
	    /*
	     * If the space is empty, and xpgSize is 0 (means XPG wasn't used,
	     * and/or numVars != 0), then too many vars were given
	     */

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    Tcl_SetResult(interp,
		    "variable is not assigned by any conversion specifiers",
		    -1));
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "FORMAT", "UNASSIGNED", NULL);
	    goto error;
	}
    }

    TclStackFree(interp, nassign);
    return TCL_OK;

  badIndex:
    if (gotXpg) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"\"%n$\" argument index out of range", -1));
	Tcl_SetResult(interp, "\"%n$\" argument index out of range",
	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "INDEXRANGE", NULL);
		TCL_STATIC);
    } else {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
	Tcl_SetResult(interp,
		"different numbers of variable names and field specifiers",
		-1));
		TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "FORMAT", "FIELDVARMISMATCH", NULL);
    }

  error:
    TclStackFree(interp, nassign);
    return TCL_ERROR;
}

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
618
619
620
621
622
623
624
625

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
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
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
611
612
613
614
615
616
617

618
619
620
621
622
623
624
625
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
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







+


-
+


-
+

-
+



-
+



-
+


+
+
+



-
+



-
+















-
+





-
+












-
+








-
+





-
+










-
+






-
+











-
+





-
+









-
-
+
+













-
+







-
+









-
+

-







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_ScanObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,    	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    const char *format;
    char *format;
    int numVars, nconversions, totalVars = -1;
    int objIndex, offset, i, result, code;
    long value;
    const char *string, *end, *baseString;
    CONST char *string, *end, *baseString;
    char op = 0;
    int width, underflow = 0;
    Tcl_WideInt wideValue;
    Tcl_UniChar ch = 0, sch = 0;
    Tcl_UniChar ch, sch;
    Tcl_Obj **objs = NULL, *objPtr = NULL;
    int flags;
    char buf[513];		/* Temporary buffer to hold scanned number
				 * strings before they are passed to
				 * strtoul. */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"string format ?varName ...?");
		"string format ?varName varName ...?");
	return TCL_ERROR;
    }

    format = TclGetString(objv[2]);
    format = Tcl_GetStringFromObj(objv[2], NULL);
    numVars = objc-3;

    /*
     * Check for errors in the format string.
     */

    if (ValidateFormat(interp, format, numVars, &totalVars) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Allocate space for the result objects.
     */

    if (totalVars > 0) {
	objs = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj *) * totalVars);
	objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj*) * totalVars);
	for (i = 0; i < totalVars; i++) {
	    objs[i] = NULL;
	}
    }

    string = TclGetString(objv[1]);
    string = Tcl_GetStringFromObj(objv[1], NULL);
    baseString = string;

    /*
     * Iterate over the format string filling in the result objects until we
     * reach the end of input, the end of the format string, or there is a
     * mismatch.
     */

    objIndex = 0;
    nconversions = 0;
    while (*format != '\0') {
	int parseFlag = TCL_PARSE_NO_WHITESPACE;
	format += TclUtfToUniChar(format, &ch);
	format += Tcl_UtfToUniChar(format, &ch);

	flags = 0;

	/*
	 * If we see whitespace in the format, skip whitespace in the string.
	 */

	if (Tcl_UniCharIsSpace(ch)) {
	    offset = TclUtfToUniChar(string, &sch);
	    offset = Tcl_UtfToUniChar(string, &sch);
	    while (Tcl_UniCharIsSpace(sch)) {
		if (*string == '\0') {
		    goto done;
		}
		string += offset;
		offset = TclUtfToUniChar(string, &sch);
		offset = Tcl_UtfToUniChar(string, &sch);
	    }
	    continue;
	}

	if (ch != '%') {
	literal:
	    if (*string == '\0') {
		underflow = 1;
		goto done;
	    }
	    string += TclUtfToUniChar(string, &sch);
	    string += Tcl_UtfToUniChar(string, &sch);
	    if (ch != sch) {
		goto done;
	    }
	    continue;
	}

	format += TclUtfToUniChar(format, &ch);
	format += Tcl_UtfToUniChar(format, &ch);
	if (ch == '%') {
	    goto literal;
	}

	/*
	 * Check for assignment suppression ('*') or an XPG3-style assignment
	 * ('%n$').
	 */

	if (ch == '*') {
	    flags |= SCAN_SUPPRESS;
	    format += TclUtfToUniChar(format, &ch);
	    format += Tcl_UtfToUniChar(format, &ch);
	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    char *formatEnd;
	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
	    if (*formatEnd == '$') {
		format = formatEnd+1;
		format += TclUtfToUniChar(format, &ch);
		format += Tcl_UtfToUniChar(format, &ch);
		objIndex = (int) value - 1;
	    }
	}

	/*
	 * Parse any width specifier.
	 */

	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
	    format += TclUtfToUniChar(format, &ch);
	    width = (int) strtoul(format-1, &format, 10);/* INTL: "C" locale. */
	    format += Tcl_UtfToUniChar(format, &ch);
	} else {
	    width = 0;
	}

	/*
	 * Handle any size specifier.
	 */

	switch (ch) {
	case 'l':
	    if (*format == 'l') {
		flags |= SCAN_BIG;
		format += 1;
		format += TclUtfToUniChar(format, &ch);
		format += Tcl_UtfToUniChar(format, &ch);
		break;
	    }
	    /* FALLTHRU */
	case 'L':
	    flags |= SCAN_LONGER;
	    /* FALLTHRU */
	case 'h':
	    format += TclUtfToUniChar(format, &ch);
	    format += Tcl_UtfToUniChar(format, &ch);
	}

	/*
	 * Handle the various field types.
	 */

	switch (ch) {
	case 'n':
	    if (!(flags & SCAN_SUPPRESS)) {
		TclNewIntObj(objPtr, string - baseString);
		objPtr = Tcl_NewIntObj(string - baseString);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    nconversions++;
	    continue;

	case 'd':
	    op = 'i';
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
729
730
731
732
733
734
735




736
737
738
739
740
741
742







-
-
-
-







	    parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES;
	    break;
	case 'x':
	case 'X':
	    op = 'i';
	    parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY;
	    break;
	case 'b':
	    op = 'i';
	    parseFlag |= TCL_PARSE_BINARY_ONLY;
	    break;
	case 'u':
	    op = 'i';
	    parseFlag |= TCL_PARSE_DECIMAL_ONLY;
	    flags |= SCAN_UNSIGNED;
	    break;

	case 'f':
786
787
788
789
790
791
792
793

794
795
796
797
798
799
800
774
775
776
777
778
779
780

781
782
783
784
785
786
787
788







-
+







	/*
	 * Skip any leading whitespace at the beginning of a field unless the
	 * format suppresses this behavior.
	 */

	if (!(flags & SCAN_NOSKIP)) {
	    while (*string != '\0') {
		offset = TclUtfToUniChar(string, &sch);
		offset = Tcl_UtfToUniChar(string, &sch);
		if (!Tcl_UniCharIsSpace(sch)) {
		    break;
		}
		string += offset;
	    }
	    if (*string == '\0') {
		underflow = 1;
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
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







-
+











-















-
+







	     */

	    if (width == 0) {
		width = ~0;
	    }
	    end = string;
	    while (*end != '\0') {
		offset = TclUtfToUniChar(end, &sch);
		offset = Tcl_UtfToUniChar(end, &sch);
		if (Tcl_UniCharIsSpace(sch)) {
		    break;
		}
		end += offset;
		if (--width == 0) {
		    break;
		}
	    }
	    if (!(flags & SCAN_SUPPRESS)) {
		objPtr = Tcl_NewStringObj(string, end-string);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    string = end;
	    break;

	case '[': {
	    CharSet cset;

	    if (width == 0) {
		width = ~0;
	    }
	    end = string;

	    format = BuildCharSet(&cset, format);
	    while (*end != '\0') {
		offset = TclUtfToUniChar(end, &sch);
		offset = Tcl_UtfToUniChar(end, &sch);
		if (!CharInSet(&cset, (int)sch)) {
		    break;
		}
		end += offset;
		if (--width == 0) {
		    break;
		}
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
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







-
-
+

-
+

-








-
+





-
+



















-
+

-
+



-
-
+
+
-
-
-
-
-
-
+
-

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+








-
-
-
+
-
-
-
-
-
-
+
-
-
-
-

-
+
















-
+


















-
-
+
-
-
+








-







	    break;
	}
	case 'c':
	    /*
	     * Scan a single Unicode character.
	     */

	    offset = TclUtfToUCS4(string, &i);
	    string += offset;
	    string += Tcl_UtfToUniChar(string, &sch);
	    if (!(flags & SCAN_SUPPRESS)) {
		TclNewIntObj(objPtr, i);
		objPtr = Tcl_NewIntObj((int)sch);
		Tcl_IncrRefCount(objPtr);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
	    }
	    break;

	case 'i':
	    /*
	     * Scan an unsigned or signed integer.
	     */
	    TclNewIntObj(objPtr, 0);
	    objPtr = Tcl_NewLongObj(0);
	    Tcl_IncrRefCount(objPtr);
	    if (width == 0) {
		width = ~0;
	    }
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
		&end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) {
		    &end, TCL_PARSE_INTEGER_ONLY | parseFlag)) {
		Tcl_DecrRefCount(objPtr);
		if (width < 0) {
		    if (*end == '\0') {
			underflow = 1;
		    }
		} else {
		    if (end == string + width) {
			underflow = 1;
		    }
		}
		goto done;
	    }
	    string = end;
	    if (flags & SCAN_SUPPRESS) {
		Tcl_DecrRefCount(objPtr);
		break;
	    }
	    if (flags & SCAN_LONGER) {
		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
		    wideValue = WIDE_MAX;
		    wideValue = ~(Tcl_WideUInt)0 >> 1;	/* WIDE_MAX */
		    if (TclGetString(objPtr)[0] == '-') {
			wideValue = WIDE_MIN;
			wideValue++;	/* WIDE_MAX + 1 = WIDE_MIN */
		    }
		}
		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
		    mp_int big;
		    if (mp_init_u64(&big, (Tcl_WideUInt)wideValue) != MP_OKAY) {
		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
			    (Tcl_WideUInt)wideValue);
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"insufficient memory to create bignum", -1));
			Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
			return TCL_ERROR;
		    } else {
			Tcl_SetBignumObj(objPtr, &big);
		    Tcl_SetStringObj(objPtr, buf, -1);
		    }
		} else {
		    TclSetIntObj(objPtr, wideValue);
		    Tcl_SetWideIntObj(objPtr, wideValue);
		}
	    } else if (flags & SCAN_BIG) {
		if (flags & SCAN_UNSIGNED) {
		    mp_int big;
		    int res = Tcl_GetBignumFromObj(interp, objPtr, &big);

		    if (res == TCL_OK) {
			if (mp_isneg(&big)) {
			    res = TCL_ERROR;
			}
			mp_clear(&big);
		    }

		    if (res == TCL_ERROR) {
			if (objs != NULL) {
			    Tcl_Free(objs);
			}
			Tcl_DecrRefCount(objPtr);
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"unsigned bignum scans are invalid", -1));
			Tcl_SetErrorCode(interp, "TCL", "FORMAT",
				"BADUNSIGNED",NULL);
			return TCL_ERROR;
		    }
		}
	    } else {
	    } else if (!(flags & SCAN_BIG)) {
		if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
		    if (TclGetString(objPtr)[0] == '-') {
			value = LONG_MIN;
		    } else {
			value = LONG_MAX;
		    }
		}
		if ((flags & SCAN_UNSIGNED) && (value < 0)) {
#ifdef TCL_WIDE_INT_IS_LONG
		    mp_int big;
		    if (mp_init_u64(&big, (unsigned long)value) != MP_OKAY) {
		    sprintf(buf, "%lu", value);	/* INTL: ISO digit */
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"insufficient memory to create bignum", -1));
			Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
			return TCL_ERROR;
		    } else {
			Tcl_SetBignumObj(objPtr, &big);
		    Tcl_SetStringObj(objPtr, buf, -1);
		    }
#else
		    Tcl_SetWideIntObj(objPtr, (unsigned long)value);
#endif
		} else {
		    TclSetIntObj(objPtr, value);
		    Tcl_SetLongObj(objPtr, value);
		}
	    }
	    objs[objIndex++] = objPtr;
	    break;

	case 'f':
	    /*
	     * Scan a floating point number
	     */

	    objPtr = Tcl_NewDoubleObj(0.0);
	    Tcl_IncrRefCount(objPtr);
	    if (width == 0) {
		width = ~0;
	    }
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) {
		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE)) {
		Tcl_DecrRefCount(objPtr);
		if (width < 0) {
		    if (*end == '\0') {
			underflow = 1;
		    }
		} else {
		    if (end == string + width) {
			underflow = 1;
		    }
		}
		goto done;
	    } else if (flags & SCAN_SUPPRESS) {
		Tcl_DecrRefCount(objPtr);
		string = end;
	    } else {
		double dvalue;
		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
		    const Tcl_ObjIntRep *irPtr
			    = TclFetchIntRep(objPtr, &tclDoubleType);
		    if (objPtr->typePtr == &tclDoubleType) {
		    if (irPtr) {
			dvalue = irPtr->doubleValue;
			dvalue = objPtr->internalRep.doubleValue;
		    } else
#endif
		    {
			Tcl_DecrRefCount(objPtr);
			goto done;
		    }
		}
		Tcl_SetDoubleObj(objPtr, dvalue);
		CLANG_ASSERT(objs);
		objs[objIndex++] = objPtr;
		string = end;
	    }
	}
	nconversions++;
    }

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
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







-
-
-
-
-
-
-
-
+
+
+









-
+















-
+




-
+




-
+



-
+













	 */

	for (i = 0; i < totalVars; i++) {
	    if (objs[i] == NULL) {
		continue;
	    }
	    result++;

	    /*
	     * In case of multiple errors in setting variables, just report
	     * the first one.
	     */

	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i],
		    (code == TCL_OK) ? TCL_LEAVE_ERR_MSG : 0) == NULL) {
	    if (Tcl_ObjSetVar2(interp, objv[i+3], NULL, objs[i], 0) == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			TclGetString(objv[i+3]), "\"", NULL);
		code = TCL_ERROR;
	    }
	    Tcl_DecrRefCount(objs[i]);
	}
    } else {
	/*
	 * Here no vars were specified, we want a list returned (inline scan)
	 */

	TclNewObj(objPtr);
	objPtr = Tcl_NewObj();
	for (i = 0; i < totalVars; i++) {
	    if (objs[i] != NULL) {
		Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
		Tcl_DecrRefCount(objs[i]);
	    } else {
		/*
		 * More %-specifiers than matching chars, so we just spit out
		 * empty strings for these.
		 */

		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
	    }
	}
    }
    if (objs != NULL) {
	Tcl_Free(objs);
	ckfree((char*) objs);
    }
    if (code == TCL_OK) {
	if (underflow && (nconversions == 0)) {
	    if (numVars) {
		TclNewIndexObj(objPtr, TCL_INDEX_NONE);
		objPtr = Tcl_NewIntObj(-1);
	    } else {
		if (objPtr) {
		    Tcl_SetListObj(objPtr, 0, NULL);
		} else {
		    TclNewObj(objPtr);
		    objPtr = Tcl_NewObj();
		}
	    }
	} else if (numVars) {
	    TclNewIntObj(objPtr, result);
	    objPtr = Tcl_NewIntObj(result);
	}
	Tcl_SetObjResult(interp, objPtr);
    }
    return code;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclStrToD.c.

10
11
12
13
14
15
16
17

18
19
20
21
22
23
24







25
26
27
28
29
30
31
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







-
+







+
+
+
+
+
+
+







 * Copyright (c) 2005 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 "tclTomMath.h"
#include "tommath.h"
#include <float.h>
#include <math.h>

#ifdef _WIN32
#define copysign _copysign
#endif

/*
 * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
 * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
 */

#undef	KILL_OCTAL

/*
 * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
 * uniquely determined by radix and by the widths of significand and exponent.
 */

#if (FLT_RADIX == 2) && (DBL_MANT_DIG == 53) && (DBL_MAX_EXP == 1024)
294
295
296
297
298
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
301
302
303
304
305
306
307

308

309
310

311
312
313
314
315
316
317
318







-

-


-
+







static int		AccumulateDecimalDigit(unsigned, int,
			    Tcl_WideUInt *, mp_int *, int);
static double		MakeHighPrecisionDouble(int signum,
			    mp_int *significand, int nSigDigs, long exponent);
static double		MakeLowPrecisionDouble(int signum,
			    Tcl_WideUInt significand, int nSigDigs,
			    long exponent);
#ifdef IEEE_FLOATING_POINT
static double		MakeNaN(int signum, Tcl_WideUInt tag);
#endif
static double		RefineApproximation(double approx,
			    mp_int *exactSignificand, int exponent);
static mp_err	MulPow5(mp_int *, unsigned, mp_int *) MP_WUR;
static void		MulPow5(mp_int *, unsigned, mp_int *);
static int 		NormalizeRightward(Tcl_WideUInt *);
static int		RequiredPrecision(Tcl_WideUInt);
static void		DoubleToExpAndSig(double, Tcl_WideUInt *, int *,
			    int *);
static void		TakeAbsoluteValue(Double *, int *);
static char *		FormatInfAndNaN(Double *, int *, char **);
static char *		FormatZero(int *, char **);
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
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







-
+


-
+




-
+

-
+




-
+






-
-
+
+





-
+




-
+



-

-







static char *		ShorteningQuickFormat(double, int, int, double,
			    char *, int *);
static char *		StrictQuickFormat(double, int, int, double,
			    char *, int *);
static char *		QuickConversion(double, int, int, int, int, int, int,
			    int *, char **);
static void		CastOutPowersOf2(int *, int *, int *);
static char *		ShorteningInt64Conversion(Double *, Tcl_WideUInt,
static char *		ShorteningInt64Conversion(Double *, int, Tcl_WideUInt,
			    int, int, int, int, int, int, int, int, int,
			    int, int, int *, char **);
static char *		StrictInt64Conversion(Tcl_WideUInt,
static char *		StrictInt64Conversion(Double *, int, Tcl_WideUInt,
			    int, int, int, int, int, int,
			    int, int, int *, char **);
static int		ShouldBankerRoundUpPowD(mp_int *, int, int);
static int		ShouldBankerRoundUpToNextPowD(mp_int *, mp_int *,
			    int, int, mp_int *);
			    int, int, int, mp_int *);
static char *		ShorteningBignumConversionPowD(Double *dPtr,
			    Tcl_WideUInt bw, int b2, int b5,
			    int convType, Tcl_WideUInt bw, int b2, int b5,
			    int m2plus, int m2minus, int m5,
			    int sd, int k, int len,
			    int ilim, int ilim1, int *decpt,
			    char **endPtr);
static char *		StrictBignumConversionPowD(
static char *		StrictBignumConversionPowD(Double *dPtr, int convType,
			    Tcl_WideUInt bw, int b2, int b5,
			    int sd, int k, int len,
			    int ilim, int ilim1, int *decpt,
			    char **endPtr);
static int		ShouldBankerRoundUp(mp_int *, mp_int *, int);
static int		ShouldBankerRoundUpToNext(mp_int *, mp_int *,
			    mp_int *, int);
static char *		ShorteningBignumConversion(Double *dPtr,
			    mp_int *, int, int, mp_int *);
static char *		ShorteningBignumConversion(Double *dPtr, int convType,
			    Tcl_WideUInt bw, int b2,
			    int m2plus, int m2minus,
			    int s2, int s5, int k, int len,
			    int ilim, int ilim1, int *decpt,
			    char **endPtr);
static char *		StrictBignumConversion(
static char *		StrictBignumConversion(Double *dPtr, int convType,
			    Tcl_WideUInt bw, int b2,
			    int s2, int s5, int k, int len,
			    int ilim, int ilim1, int *decpt,
			    char **endPtr);
static double		BignumToBiasedFrExp(const mp_int *big, int *machexp);
static double		BignumToBiasedFrExp(mp_int *big, int *machexp);
static double		Pow10TimesFrExp(int exponent, double fraction,
			    int *machexp);
static double		SafeLdExp(double fraction, int exponent);
#ifdef IEEE_FLOATING_POINT
static Tcl_WideUInt	Nokia770Twiddle(Tcl_WideUInt w);
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclParseNumber --
 *
 *	Scans bytes, interpreted as characters in Tcl's internal encoding, and
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
393
394
395
396
397
398
399



400
401
402
403
404
405
406







-
-
-







 *
 *	- TCL_PARSE_INTEGER_ONLY:	accept only integer values; reject
 *		strings that denote floating point values (or accept only the
 *		leading portion of them that are integer values).
 *	- TCL_PARSE_SCAN_PREFIXES:	ignore the prefixes 0b and 0o that are
 *		not part of the [scan] command's vocabulary. Use only in
 *		combination with TCL_PARSE_INTEGER_ONLY.
 *	- TCL_PARSE_BINARY_ONLY:	parse only in the binary format, whether
 *		or not a prefix is present that would lead to binary parsing.
 *		Use only in combination with TCL_PARSE_INTEGER_ONLY.
 *	- TCL_PARSE_OCTAL_ONLY:		parse only in the octal format, whether
 *		or not a prefix is present that would lead to octal parsing.
 *		Use only in combination with TCL_PARSE_INTEGER_ONLY.
 *	- TCL_PARSE_HEXADECIMAL_ONLY:	parse only in the hexadecimal format,
 *		whether or not a prefix is present that would lead to
 *		hexadecimal parsing. Use only in combination with
 *		TCL_PARSE_INTEGER_ONLY.
475
476
477
478
479
480
481
482

483
484
485
486
487
488
489
490
491


492
493
494
495
496
497
498
475
476
477
478
479
480
481

482
483
484
485
486
487
488
489


490
491
492
493
494
495
496
497
498







-
+







-
-
+
+







    Tcl_Interp *interp,		/* Used for error reporting. May be NULL. */
    Tcl_Obj *objPtr,		/* Object to receive the internal rep. */
    const char *expected,	/* Description of the type of number the
				 * caller expects to be able to parse
				 * ("integer", "boolean value", etc.). */
    const char *bytes,		/* Pointer to the start of the string to
				 * scan. */
    size_t numBytes,		/* Maximum number of bytes to scan, see
    int numBytes,		/* Maximum number of bytes to scan, see
				 * above. */
    const char **endPtrPtr,	/* Place to store pointer to the character
				 * that terminated the scan. */
    int flags)			/* Flags governing the parse. */
{
    enum State {
	INITIAL, SIGNUM, ZERO, ZERO_X,
	ZERO_O, ZERO_B, ZERO_D, BINARY,
	HEXADECIMAL, OCTAL, DECIMAL,
	ZERO_O, ZERO_B, BINARY,
	HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
	LEADING_RADIX_POINT, FRACTION,
	EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
	sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
#ifdef IEEE_FLOATING_POINT
	, sN, sNA, sNAN, sNANPAREN, sNANHEX, sNANFINISH
#endif
    } state = INITIAL;
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
529
530
531
532
533
534
535

536


537


538
539
540
541
542
543
544
545














546
547
548
549
550
551
552







-
+
-
-

-
-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-







				 * an acceptable number. */
    size_t acceptLen;		/* Number of characters following that
				 * point. */
    int status = TCL_OK;	/* Status to return to caller. */
    char d = 0;			/* Last hexadecimal digit scanned; initialized
				 * to avoid a compiler warning. */
    int shift = 0;		/* Amount to shift when accumulating binary */
    mp_err err = MP_OKAY;
    int explicitOctal = 0;
    int under = 0;              /* Flag trailing '_' as error if true once
				 * number is accepted. */

#define ALL_BITS	((Tcl_WideUInt)-1)
#define MOST_BITS	(ALL_BITS >> 1)
#define MOST_BITS	(UWIDE_MAX >> 1)

    /*
     * Initialize bytes to start of the object's string rep if the caller
     * didn't pass anything else.
     */

    if (bytes == NULL) {
	if (interp == NULL && endPtrPtr == NULL) {
	    if (TclHasIntRep(objPtr, &tclDictType)) {
		/* A dict can never be a (single) number */
		return TCL_ERROR;
	    }
	    if (TclHasIntRep(objPtr, &tclListType)) {
		int length;
		/* A list can only be a (single) number if its length == 1 */
		TclListObjLength(NULL, objPtr, &length);
		if (length != 1) {
		    return TCL_ERROR;
		}
	    }
	}
	bytes = TclGetString(objPtr);
    }

    p = bytes;
    len = numBytes;
    acceptPoint = p;
    acceptLen = len;
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
586
587
588
589
590
591
592


593
594
595
596
597
598
599







-
-







		    state = DECIMAL;
		} else {
		    state = ZERO;
		}
		break;
	    } else if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
		goto zerox;
	    } else if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    } else if (flags & TCL_PARSE_OCTAL_ONLY) {
		goto zeroo;
	    } else if (isdigit(UCHAR(c))) {
		significandWide = c - '0';
		numSigDigs = 1;
		state = DECIMAL;
		break;
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
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
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
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
621
622
623
624
625
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
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
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

















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







-
+












-
+





-
-
-

-
-
-
+



-
-
+
-
-
-
-
-

+
+
















-



-









-
-
-
+
+
+






-
+

-
+




+
+
+
+
+
+
+
+
-
-
+
+
+

-
-
-
+
+
-
-
-
-
+
+
-
-
-
-










+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+


















-



-


-


-

-
-
-
-







-
-
-
+
+
+




-
+

-
+




+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-









-
+

-


-


-
-
-
-







-
-
-
+
+
+




-
+

-
+




+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
+
+
+
-
-
-
-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






+

+





-











-


-
-
-
-



-



-







	     * OCTAL state differ only in whether they recognize 'X' and 'b'.
	     */

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == 'x' || c == 'X') {
		if (flags & (TCL_PARSE_OCTAL_ONLY|TCL_PARSE_BINARY_ONLY) || under) {
		if (flags & TCL_PARSE_OCTAL_ONLY) {
		    goto endgame;
		}
		state = ZERO_X;
		break;
	    }
	    if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
		goto zerox;
	    }
	    if (flags & TCL_PARSE_SCAN_PREFIXES) {
		goto zeroo;
	    }
	    if (c == 'b' || c == 'B') {
		if ((flags & TCL_PARSE_OCTAL_ONLY) || under) {
		if (flags & TCL_PARSE_OCTAL_ONLY) {
		    goto endgame;
		}
		state = ZERO_B;
		break;
	    }
	    if (flags & TCL_PARSE_BINARY_ONLY) {
		goto zerob;
	    }
	    if (c == 'o' || c == 'O') {
		if (under) {
		    goto endgame;
		}
		explicitOctal = 1;
		state = ZERO_O;
		break;
	    }
	    if (c == 'd' || c == 'D') {
		if (under) {
#ifdef KILL_OCTAL
		    goto endgame;
		}
		state = ZERO_D;
		break;
	    }
	    goto decimal;
#endif
	    /* FALLTHROUGH */

	case OCTAL:
	    /*
	     * Scanned an optional + or -, followed by a string of octal
	     * digits. Acceptable inputs are more digits, period, or E. If 8
	     * or 9 is encountered, commit to floating point.
	     */

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    /* FALLTHROUGH */
	case ZERO_O:
	zeroo:
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = OCTAL;
		break;
	    } else if (c >= '1' && c <= '7') {
		under = 0;
		if (objPtr != NULL) {
		    shift = 3 * (numTrailZeros + 1);
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c-'0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);

		    if (!octalSignificandOverflow) {
			/*
			 * Shifting by more bits than are in the value being
			 * shifted is at least de facto nonportable. Check for
			 * too large shifts first.
			 * Shifting by as many or more bits than are in the
			 * value being shifted is undefined behavior. Check
			 * for too large shifts first.
			 */

			if ((octalSignificandWide != 0)
				&& (((size_t)shift >=
					CHAR_BIT*sizeof(Tcl_WideUInt))
				|| (octalSignificandWide >
					((Tcl_WideUInt)-1 >> shift)))) {
					(UWIDE_MAX >> shift)))) {
			    octalSignificandOverflow = 1;
			    err = mp_init_u64(&octalSignificandBig,
			    TclBNInitBignumFromWideUInt(&octalSignificandBig,
				    octalSignificandWide);
			}
		    }
		    if (!octalSignificandOverflow) {
			/*
			 * When the significand is 0, it is possible for the
			 * amount to be shifted to equal or exceed the width
			 * of the significand. Do not shift when the
			 * significand is 0 to avoid undefined behavior.
			 */

			if (octalSignificandWide != 0) {
			octalSignificandWide =
				(octalSignificandWide << shift) + (c - '0');
			    octalSignificandWide <<= shift;
			}
			octalSignificandWide += c - '0';
		    } else {
			if (err == MP_OKAY) {
			    err = mp_mul_2d(&octalSignificandBig, shift,
				    &octalSignificandBig);
			mp_mul_2d(&octalSignificandBig, shift,
				&octalSignificandBig);
			}
			if (err == MP_OKAY) {
			    err = mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'),
				    &octalSignificandBig);
			mp_add_d(&octalSignificandBig, (mp_digit)(c - '0'),
				&octalSignificandBig);
			}
		    }
		    if (err != MP_OKAY) {
			return TCL_ERROR;
		    }
		}
		if (numSigDigs != 0) {
		    numSigDigs += numTrailZeros+1;
		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		state = OCTAL;
		break;
	    }
	    /* FALLTHROUGH */

	case BAD_OCTAL:
	    if (explicitOctal) {
		/*
		 * No forgiveness for bad digits in explicitly octal numbers.
		 */

		goto endgame;
	    }
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    if (flags & TCL_PARSE_INTEGER_ONLY) {
		/*
		 * No seeking floating point when parsing only integer.
		 */

		goto endgame;
	    }
#ifndef KILL_OCTAL

	    /*
	     * Scanned a number with a leading zero that contains an 8, 9,
	     * radix point or E. This is an invalid octal number, but might
	     * still be floating point.
	     */

	    if (c == '0') {
		numTrailZeros++;
		state = BAD_OCTAL;
		break;
	    } else if (isdigit(UCHAR(c))) {
		if (objPtr != NULL) {
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c-'0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);
		}
		if (numSigDigs != 0) {
		    numSigDigs += (numTrailZeros + 1);
		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		state = BAD_OCTAL;
		break;
	    } else if (c == '.') {
		state = FRACTION;
		break;
	    } else if (c == 'E' || c == 'e') {
		state = EXPONENT_START;
		break;
	    }
#endif
	    goto endgame;

	    /*
	     * Scanned 0x. If state is HEXADECIMAL, scanned at least one
	     * character following the 0x. The only acceptable inputs are
	     * hexadecimal digits.
	     */

	case HEXADECIMAL:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    /* FALLTHROUGH */

	case ZERO_X:
	zerox:
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = HEXADECIMAL;
		break;
	    } else if (isdigit(UCHAR(c))) {
		under = 0;
		d = (c-'0');
	    } else if (c >= 'A' && c <= 'F') {
		under = 0;
		d = (c-'A'+10);
	    } else if (c >= 'a' && c <= 'f') {
		under = 0;
		d = (c-'a'+10);
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    } else {
		goto endgame;
	    }
	    if (objPtr != NULL) {
		shift = 4 * (numTrailZeros + 1);
		if (!significandOverflow) {
		    /*
		     * Shifting by more bits than are in the value being
		     * shifted is at least de facto nonportable. Check for too
		     * large shifts first.
		     * Shifting by as many or more bits than are in the
		     * value being shifted is undefined behavior. Check
		     * for too large shifts first.
		     */

		    if (significandWide != 0 &&
			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
			    significandWide > ((Tcl_WideUInt)-1 >> shift))) {
			    significandWide > (UWIDE_MAX >> shift))) {
			significandOverflow = 1;
			err = mp_init_u64(&significandBig,
			TclBNInitBignumFromWideUInt(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    /*
		     * When the significand is 0, it is possible for the
		     * amount to be shifted to equal or exceed the width
		     * of the significand. Do not shift when the
		     * significand is 0 to avoid undefined behavior.
		     */

		    if (significandWide != 0) {
			significandWide <<= shift;
		    }
		    significandWide = (significandWide << shift) + d;
		} else if (err == MP_OKAY) {
		    err = mp_mul_2d(&significandBig, shift, &significandBig);
		    significandWide += d;
		} else {
		    mp_mul_2d(&significandBig, shift, &significandBig);
		    if (err == MP_OKAY) {
			err = mp_add_d(&significandBig, (mp_digit) d, &significandBig);
		    }
		    mp_add_d(&significandBig, (mp_digit) d, &significandBig);
		}
		}
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    numTrailZeros = 0;
	    state = HEXADECIMAL;
	    break;

	case BINARY:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
		/* FALLTHRU */
	    /* FALLTHRU */
	case ZERO_B:
	zerob:
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = BINARY;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    } else if (c != '1') {
		goto endgame;
	    }
	    if (objPtr != NULL) {
		shift = numTrailZeros + 1;
		if (!significandOverflow) {
		    /*
		     * Shifting by more bits than are in the value being
		     * shifted is at least de facto nonportable. Check for too
		     * large shifts first.
		     * Shifting by as many or more bits than are in the
		     * value being shifted is undefined behavior. Check
		     * for too large shifts first.
		     */

		    if (significandWide != 0 &&
			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
			    significandWide > ((Tcl_WideUInt)-1 >> shift))) {
			    significandWide > (UWIDE_MAX >> shift))) {
			significandOverflow = 1;
			err = mp_init_u64(&significandBig,
			TclBNInitBignumFromWideUInt(&significandBig,
				significandWide);
		    }
		}
		if (!significandOverflow) {
		    /*
		     * When the significand is 0, it is possible for the
		     * amount to be shifted to equal or exceed the width
		     * of the significand. Do not shift when the
		     * significand is 0 to avoid undefined behavior.
		     */

		    if (significandWide != 0) {
			significandWide <<= shift;
		    }
		    significandWide = (significandWide << shift) + 1;
		} else if (err == MP_OKAY) {
		    err = mp_mul_2d(&significandBig, shift, &significandBig);
		    significandWide += 1;
		} else {
		    mp_mul_2d(&significandBig, shift, &significandBig);
		    if (err == MP_OKAY) {
			err = mp_add_d(&significandBig, (mp_digit) 1, &significandBig);
		    }
		}
		    mp_add_d(&significandBig, (mp_digit) 1, &significandBig);
		}
	    }
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    numTrailZeros = 0;
	    state = BINARY;
	    break;

	case ZERO_D:
	    if (c == '0') {
		under = 0;
		numTrailZeros++;
	    } else if ( ! isdigit(UCHAR(c))) {
                if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                    /* Ignore numeric "white space" */
                    under = 1;
                    break;
                }
		goto endgame;
	    }
	    under = 0;
	    state = DECIMAL;
	    flags |= TCL_PARSE_INTEGER_ONLY;
	    /* FALLTHROUGH */

	case DECIMAL:
	    /*
	     * Scanned an optional + or - followed by a string of decimal
	     * digits.
	     */

#ifdef KILL_OCTAL
	decimal:
#endif
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == '0') {
		numTrailZeros++;
		under = 0;
		state = DECIMAL;
		break;
	    } else if (isdigit(UCHAR(c))) {
		if (objPtr != NULL) {
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c - '0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);
		}
		numSigDigs += numTrailZeros+1;
		numTrailZeros = 0;
		under = 0;
		state = DECIMAL;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    } else if (flags & TCL_PARSE_INTEGER_ONLY) {
		goto endgame;
	    } else if (c == '.') {
		under = 0;
		state = FRACTION;
		break;
	    } else if (c == 'E' || c == 'e') {
		under = 0;
		state = EXPONENT_START;
		break;
	    }
	    goto endgame;

	    /*
	     * Found a decimal point. If no digits have yet been scanned, E is
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
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
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
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
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

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







-
















-


-
-
-
-











-




-













-


-
-
-
-


















-


-
-
-
-










-






-








-







-






-






-






-











-






-









-










-






-














-












-


















-
-


-
-
+
+
-











-
+















+



-







	    }
	    /* FALLTHROUGH */

	case LEADING_RADIX_POINT:
	    if (c == '0') {
		numDigitsAfterDp++;
		numTrailZeros++;
		under = 0;
		state = FRACTION;
		break;
	    } else if (isdigit(UCHAR(c))) {
		numDigitsAfterDp++;
		if (objPtr != NULL) {
		    significandOverflow = AccumulateDecimalDigit(
			    (unsigned)(c-'0'), numTrailZeros,
			    &significandWide, &significandBig,
			    significandOverflow);
		}
		if (numSigDigs != 0) {
		    numSigDigs += numTrailZeros+1;
		} else {
		    numSigDigs = 1;
		}
		numTrailZeros = 0;
		under = 0;
		state = FRACTION;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    goto endgame;

	case EXPONENT_START:
	    /*
	     * Scanned the E at the start of an exponent. Make sure a legal
	     * character follows before using the C library strtol routine,
	     * which allows whitespace.
	     */

	    if (c == '+') {
		under = 0;
		state = EXPONENT_SIGNUM;
		break;
	    } else if (c == '-') {
		exponentSignum = 1;
		under = 0;
		state = EXPONENT_SIGNUM;
		break;
	    }
	    /* FALLTHROUGH */

	case EXPONENT_SIGNUM:
	    /*
	     * Found the E at the start of the exponent, followed by a sign
	     * character.
	     */

	    if (isdigit(UCHAR(c))) {
		exponent = c - '0';
		under = 0;
		state = EXPONENT;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    goto endgame;

	case EXPONENT:
	    /*
	     * Found an exponent with at least one digit. Accumulate it,
	     * making sure to hard-pin it to LONG_MAX on overflow.
	     */

	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (isdigit(UCHAR(c))) {
		if (exponent < (LONG_MAX - 9) / 10) {
		    exponent = 10 * exponent + (c - '0');
		} else {
		    exponent = LONG_MAX;
		}
		under = 0;
		state = EXPONENT;
		break;
            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
                /* Ignore numeric "white space" */
                under = 1;
                break;
	    }
	    goto endgame;

	    /*
	     * Parse out INFINITY by simply spelling it out. INF is accepted
	     * as an abbreviation; other prefices are not.
	     */

	case sI:
	    if (c == 'n' || c == 'N') {
		under = 0;
		state = sIN;
		break;
	    }
	    goto endgame;
	case sIN:
	    if (c == 'f' || c == 'F') {
		under = 0;
		state = sINF;
		break;
	    }
	    goto endgame;
	case sINF:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
            under = 0;
	    if (c == 'i' || c == 'I') {
		state = sINFI;
		break;
	    }
	    goto endgame;
	case sINFI:
	    if (c == 'n' || c == 'N') {
		under = 0;
		state = sINFIN;
		break;
	    }
	    goto endgame;
	case sINFIN:
	    if (c == 'i' || c == 'I') {
		under = 0;
		state = sINFINI;
		break;
	    }
	    goto endgame;
	case sINFINI:
	    if (c == 't' || c == 'T') {
		under = 0;
		state = sINFINIT;
		break;
	    }
	    goto endgame;
	case sINFINIT:
	    if (c == 'y' || c == 'Y') {
		under = 0;
		state = sINFINITY;
		break;
	    }
	    goto endgame;

	    /*
	     * Parse NaN's.
	     */
#ifdef IEEE_FLOATING_POINT
	case sN:
	    if (c == 'a' || c == 'A') {
		under = 0;
		state = sNA;
		break;
	    }
	    goto endgame;
	case sNA:
	    if (c == 'n' || c == 'N') {
		under = 0;
		state = sNAN;
		break;
	    }
	    goto endgame;
	case sNAN:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    if (c == '(') {
		under = 0;
		state = sNANPAREN;
		break;
	    }
	    goto endgame;

	    /*
	     * Parse NaN(hexdigits)
	     */
	case sNANHEX:
	    if (c == ')') {
		under = 0;
		state = sNANFINISH;
		break;
	    }
	    /* FALLTHROUGH */
	case sNANPAREN:
	    if (TclIsSpaceProcM(c)) {
		under = 0;
		break;
	    }
	    if (numSigDigs < 13) {
		if (c >= '0' && c <= '9') {
		    d = c - '0';
		} else if (c >= 'a' && c <= 'f') {
		    d = 10 + c - 'a';
		} else if (c >= 'A' && c <= 'F') {
		    d = 10 + c - 'A';
		} else {
		    goto endgame;
		}
		numSigDigs++;
		significandWide = (significandWide << 4) + d;
		under = 0;
		state = sNANHEX;
		break;
	    }
	    goto endgame;
	case sNANFINISH:
#endif

	case sINFINITY:
	    acceptState = state;
	    acceptPoint = p;
	    acceptLen = len;
	    goto endgame;

	}
	p++;
	len--;
    }

  endgame:
    if (acceptState == INITIAL) {
	/*
	 * No numeric string at all found.
	 */

	status = TCL_ERROR;
	if (endPtrPtr != NULL) {
	    *endPtrPtr = p;
	}
    } else {
	/*
	 * Back up to the last accepting state in the lexer.
	 * If the last char seen is the numeric whitespace character '_',
	 * backup to that.
	 */

	p = under ? acceptPoint-1 : acceptPoint;
	len = under ? acceptLen-1 : acceptLen;
	p = acceptPoint;
	len = acceptLen;

	if (!(flags & TCL_PARSE_NO_WHITESPACE)) {
	    /*
	     * Accept trailing whitespace.
	     */

	    while (len != 0 && TclIsSpaceProcM(*p)) {
		p++;
		len--;
	    }
	}
	if (endPtrPtr == NULL) {
	    if ((len != 0) && ((numBytes + 1 > 1) || (*p != '\0'))) {
	    if ((len != 0) && ((numBytes > 0) || (*p != '\0'))) {
		status = TCL_ERROR;
	    }
	} else {
	    *endPtrPtr = p;
	}
    }

    /*
     * Generate and store the appropriate internal rep.
     */

    if (status == TCL_OK && objPtr != NULL) {
	TclFreeIntRep(objPtr);
	switch (acceptState) {
	case SIGNUM:
	case BAD_OCTAL:
	case ZERO_X:
	case ZERO_O:
	case ZERO_B:
	case ZERO_D:
	case LEADING_RADIX_POINT:
	case EXPONENT_START:
	case EXPONENT_SIGNUM:
	case sI:
	case sIN:
	case sINFI:
	case sINFIN:
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
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
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
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







-
+



+
+
+
+
+
+
+
-
-
-
+
+
+
+


-
-
-












-
+



+
+
+
+
+
+
+
-
-
-
+
+
+
+


-
-
-












-
+




+
+
+
+
+
+
+
-
-
-
+
+
+
+




-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
+
+

-
-
+
+



-
+

-
+



-
-
-






-
+

-
+



-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
+
+

-
-
+
+



-
+

-
+



-
-
-







		    acceptState, bytes);
	case BINARY:
	    shift = numTrailZeros;
	    if (!significandOverflow && significandWide != 0 &&
		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
		    significandWide > (MOST_BITS + signum) >> shift)) {
		significandOverflow = 1;
		err = mp_init_u64(&significandBig, significandWide);
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
	    }
	    if (shift) {
		if (!significandOverflow) {
		    /*
		     * When the significand is 0, it is possible for the
		     * amount to be shifted to equal or exceed the width
		     * of the significand. Do not shift when the
		     * significand is 0 to avoid undefined behavior.
		     */
		    if (significandWide != 0) {
		    significandWide <<= shift;
		} else if (err == MP_OKAY) {
		    err = mp_mul_2d(&significandBig, shift, &significandBig);
			significandWide <<= shift;
		    }
		} else {
		    mp_mul_2d(&significandBig, shift, &significandBig);
		}
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    goto returnInteger;

	case HEXADECIMAL:
	    /*
	     * Returning a hex integer. Final scaling step.
	     */

	    shift = 4 * numTrailZeros;
	    if (!significandOverflow && significandWide !=0 &&
		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
		    significandWide > (MOST_BITS + signum) >> shift)) {
		significandOverflow = 1;
		err = mp_init_u64(&significandBig, significandWide);
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
	    }
	    if (shift) {
		if (!significandOverflow) {
		    /*
		     * When the significand is 0, it is possible for the
		     * amount to be shifted to equal or exceed the width
		     * of the significand. Do not shift when the
		     * significand is 0 to avoid undefined behavior.
		     */
		    if (significandWide != 0) {
		    significandWide <<= shift;
		} else if (err == MP_OKAY) {
		    err = mp_mul_2d(&significandBig, shift, &significandBig);
			significandWide <<= shift;
		    }
		} else {
		    mp_mul_2d(&significandBig, shift, &significandBig);
		}
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    goto returnInteger;

	case OCTAL:
	    /*
	     * Returning an octal integer. Final scaling step.
	     */

	    shift = 3 * numTrailZeros;
	    if (!octalSignificandOverflow && octalSignificandWide != 0 &&
		    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
		    octalSignificandWide > (MOST_BITS + signum) >> shift)) {
		octalSignificandOverflow = 1;
		err = mp_init_u64(&octalSignificandBig,
		TclBNInitBignumFromWideUInt(&octalSignificandBig,
			octalSignificandWide);
	    }
	    if (shift) {
		if (!octalSignificandOverflow) {
		    /*
		     * When the significand is 0, it is possible for the
		     * amount to be shifted to equal or exceed the width
		     * of the significand. Do not shift when the
		     * significand is 0 to avoid undefined behavior.
		     */
		    if (octalSignificandWide != 0) {
		    octalSignificandWide <<= shift;
		} else if (err == MP_OKAY) {
		    err = mp_mul_2d(&octalSignificandBig, shift,
			octalSignificandWide <<= shift;
		    }
		} else {
		    mp_mul_2d(&octalSignificandBig, shift,
			    &octalSignificandBig);
		}
	    }
	    if (!octalSignificandOverflow) {
		if ((err == MP_OKAY) && (octalSignificandWide > (MOST_BITS + signum))) {
		    err = mp_init_u64(&octalSignificandBig,
		if (octalSignificandWide >
			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
#ifndef NO_WIDE_TYPE
		    if (octalSignificandWide <= (MOST_BITS + signum)) {
			objPtr->typePtr = &tclWideIntType;
			if (signum) {
			    objPtr->internalRep.wideValue =
				    (Tcl_WideInt) (-octalSignificandWide);
			} else {
			    objPtr->internalRep.wideValue =
				    (Tcl_WideInt) octalSignificandWide;
			}
			break;
		    }
#endif
		    TclBNInitBignumFromWideUInt(&octalSignificandBig,
			    octalSignificandWide);
		    octalSignificandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    if (signum) {
			objPtr->internalRep.wideValue =
				- (Tcl_WideInt) octalSignificandWide;
			objPtr->internalRep.longValue =
				(long) (-octalSignificandWide);
		    } else {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt) octalSignificandWide;
			objPtr->internalRep.longValue =
				(long) octalSignificandWide;
		    }
		}
	    }
	    if ((err == MP_OKAY) && octalSignificandOverflow) {
	    if (octalSignificandOverflow) {
		if (signum) {
		    err = mp_neg(&octalSignificandBig, &octalSignificandBig);
		    (void)mp_neg(&octalSignificandBig, &octalSignificandBig);
		}
		TclSetBignumIntRep(objPtr, &octalSignificandBig);
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    break;

	case ZERO:
	case DECIMAL:
	    significandOverflow = AccumulateDecimalDigit(0, numTrailZeros-1,
		    &significandWide, &significandBig, significandOverflow);
	    if ((err == MP_OKAY) && !significandOverflow && (significandWide > MOST_BITS+signum)) {
	    if (!significandOverflow && (significandWide > MOST_BITS+signum)) {
		significandOverflow = 1;
		err = mp_init_u64(&significandBig, significandWide);
		TclBNInitBignumFromWideUInt(&significandBig, significandWide);
	    }
	returnInteger:
	    if (!significandOverflow) {
		if ((err == MP_OKAY) && (significandWide > MOST_BITS+signum)) {
		    err = mp_init_u64(&significandBig,
		if (significandWide >
			(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
#ifndef NO_WIDE_TYPE
		    if (significandWide <= MOST_BITS+signum) {
			objPtr->typePtr = &tclWideIntType;
			if (signum) {
			    objPtr->internalRep.wideValue =
				    (Tcl_WideInt) (-significandWide);
			} else {
			    objPtr->internalRep.wideValue =
				    (Tcl_WideInt) significandWide;
			}
			break;
		    }
#endif
		    TclBNInitBignumFromWideUInt(&significandBig,
			    significandWide);
		    significandOverflow = 1;
		} else {
		    objPtr->typePtr = &tclIntType;
		    if (signum) {
			objPtr->internalRep.wideValue =
				- (Tcl_WideInt) significandWide;
			objPtr->internalRep.longValue =
				(long) (-significandWide);
		    } else {
			objPtr->internalRep.wideValue =
				(Tcl_WideInt) significandWide;
			objPtr->internalRep.longValue =
				(long) significandWide;
		    }
		}
	    }
	    if ((err == MP_OKAY) && significandOverflow) {
	    if (significandOverflow) {
		if (signum) {
		    err = mp_neg(&significandBig, &significandBig);
		    (void)mp_neg(&significandBig, &significandBig);
		}
		TclSetBignumIntRep(objPtr, &significandBig);
	    }
	    if (err != MP_OKAY) {
		return TCL_ERROR;
	    }
	    break;

	case FRACTION:
	case EXPONENT:

	    /*
	     * Here, we're parsing a floating-point number. 'significandWide'
1457
1458
1459
1460
1461
1462
1463
1464

1465
1466



1467
1468



1469
1470
1471
1472
1473
1474
1475
1455
1456
1457
1458
1459
1460
1461

1462

1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478







-
+
-

+
+
+


+
+
+








    /*
     * Format an error message when an invalid number is encountered.
     */

    if (status != TCL_OK) {
	if (interp != NULL) {
	    Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
	    Tcl_Obj *msg;
		    expected);

	    TclNewLiteralStringObj(msg, "expected ");
	    Tcl_AppendToObj(msg, expected, -1);
	    Tcl_AppendToObj(msg, " but got \"", -1);
	    Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
	    Tcl_AppendToObj(msg, "\"", -1);
	    if (state == BAD_OCTAL) {
		Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
	    }
	    Tcl_SetObjResult(interp, msg);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
	}
    }

    /*
     * Free memory.
1526
1527
1528
1529
1530
1531
1532
1533

1534
1535
1536
1537
1538
1539

1540
1541
1542
1543
1544
1545
1546
1547
1548
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
1596
1597
1598
1529
1530
1531
1532
1533
1534
1535

1536
1537
1538
1539
1540
1541

1542


1543
1544
1545
1546
1547
1548
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







-
+





-
+
-
-



















-
-
-
+
+
+
-

-










-
-
+
+

-
+


-
-
+
+


-
-
-
+
+
-
-







	    /*
	     * There's no need to multiply if the multiplicand is zero.
	     */

	    *wideRepPtr = digit;
	    return 0;
	} else if (numZeros >= maxpow10_wide
		|| w > ((Tcl_WideUInt)-1-digit)/pow10_wide[numZeros+1]) {
		|| w > (UWIDE_MAX-digit)/pow10_wide[numZeros+1]) {
	    /*
	     * Wide multiplication will overflow.  Expand the number to a
	     * bignum and fall through into the bignum case.
	     */

	    if (mp_init_u64(bignumRepPtr, w) != MP_OKAY) {
	    TclBNInitBignumFromWideUInt(bignumRepPtr, w);
		return 0;
	    }
	} else {
	    /*
	     * Wide multiplication.
	     */

	    *wideRepPtr = w * pow10_wide[numZeros+1] + digit;
	    return 0;
	}
    }

    /*
     * Bignum multiplication.
     */

    if (numZeros < log10_DIGIT_MAX) {
	/*
	 * Up to about 8 zeros - single digit multiplication.
	 */

	if ((mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1],
		bignumRepPtr) != MP_OKAY)
		|| (mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr) != MP_OKAY))
	mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[numZeros+1],
		bignumRepPtr);
	mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr);
	return 0;
    } else {
	mp_err err;
	/*
	 * More than single digit multiplication. Multiply by the appropriate
	 * small powers of 5, and then shift. Large strings of zeroes are
	 * eaten 256 at a time; this is less efficient than it could be, but
	 * seems implausible. We presume that MP_DIGIT_BIT is at least 27. The
	 * first multiplication, by up to 10**7, is done with a one-DIGIT
	 * multiply (this presumes that MP_DIGIT_BIT >= 24).
	 */

	n = numZeros + 1;
	err = mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr);
	for (i = 3; (err == MP_OKAY) && (i <= 7); ++i) {
	mp_mul_d(bignumRepPtr, (mp_digit) pow10_wide[n&0x7], bignumRepPtr);
	for (i=3; i<=7; ++i) {
	    if (n & (1 << i)) {
		err = mp_mul(bignumRepPtr, pow5+i, bignumRepPtr);
		mp_mul(bignumRepPtr, pow5+i, bignumRepPtr);
	    }
	}
	while ((err == MP_OKAY) && (n >= 256)) {
	    err = mp_mul(bignumRepPtr, pow5+8, bignumRepPtr);
	while (n >= 256) {
	    mp_mul(bignumRepPtr, pow5+8, bignumRepPtr);
	    n -= 256;
	}
	if ((err != MP_OKAY)
		|| (mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr) != MP_OKAY)
		|| (mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr) != MP_OKAY)) {
	mp_mul_2d(bignumRepPtr, (int)(numZeros+1)&~0x7, bignumRepPtr);
	mp_add_d(bignumRepPtr, (mp_digit) digit, bignumRepPtr);
	    return 0;
	}
    }

    return 1;
}

/*
 *----------------------------------------------------------------------
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
1612
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
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651







-







-
+
+

-
+
-


-
+
+

-



+
+
+
+
+
+
+







static double
MakeLowPrecisionDouble(
    int signum,			/* 1 if the number is negative, 0 otherwise */
    Tcl_WideUInt significand,	/* Significand of the number */
    int numSigDigs,		/* Number of digits in the significand */
    long exponent)		/* Power of ten */
{
    double retval;		/* Value of the number. */
    mp_int significandBig;	/* Significand expressed as a bignum. */

    /*
     * With gcc on x86, the floating point rounding mode is double-extended.
     * This causes the result of double-precision calculations to be rounded
     * twice: once to the precision of double-extended and then again to the
     * precision of double. Double-rounding introduces gratuitous errors of 1
     * ulp, so we need to change rounding mode to 53-bits.
     * ulp, so we need to change rounding mode to 53-bits. We also make
     * 'retval' volatile, so that it doesn't get promoted to a register.
     */

    volatile double retval;		/* Value of the number. */
    TCL_IEEE_DOUBLE_ROUNDING;

    /*
     * Test for the easy cases.
     * Test for zero significand, which requires explicit construction
     * of -0.0. (Unary minus returns a positive zero.)
     */

    if (significand == 0) {
	return copysign(0.0, -signum);
    }

    /*
     * Set the FP control word for 53 bits, WARNING: It must be reset
     * before returning.
     */
    TCL_IEEE_DOUBLE_ROUNDING;

    if (numSigDigs <= QUICK_MAX) {
	if (exponent >= 0) {
	    if (exponent <= mmaxpow) {
		/*
		 * The significand is an exact integer, and so is
		 * 10**exponent. The product will be correct to within 1/2 ulp
		 * without special handling.
1685
1686
1687
1688
1689
1690
1691
1692

1693
1694
1695
1696
1697
1698
1699
1700
1701
1687
1688
1689
1690
1691
1692
1693

1694


1695
1696
1697
1698
1699
1700
1701







-
+
-
-







    }

    /*
     * All the easy cases have failed. Promote ths significand to bignum and
     * call MakeHighPrecisionDouble to do it the hard way.
     */

    if (mp_init_u64(&significandBig, significand) != MP_OKAY) {
    TclBNInitBignumFromWideUInt(&significandBig, significand);
	return 0.0;
    }
    retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
	    exponent);
    mp_clear(&significandBig);

    /*
     * Come here to return the computed value.
     */
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
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







-
-
+






-
+
+
+

+

+
+
+
+
+
+
+
+
+
+
+
+



-
+


-
-
-
-







static double
MakeHighPrecisionDouble(
    int signum,			/* 1=negative, 0=nonnegative */
    mp_int *significand,	/* Exact significand of the number */
    int numSigDigs,		/* Number of significant digits */
    long exponent)		/* Power of 10 by which to multiply */
{
    double retval;
    int machexp = 0;		/* Machine exponent of a power of 10. */
    int machexp;		/* Machine exponent of a power of 10. */

    /*
     * With gcc on x86, the floating point rounding mode is double-extended.
     * This causes the result of double-precision calculations to be rounded
     * twice: once to the precision of double-extended and then again to the
     * precision of double. Double-rounding introduces gratuitous errors of 1
     * ulp, so we need to change rounding mode to 53-bits.
     * ulp, so we need to change rounding mode to 53-bits. We also make
     * 'retval' volatile to make sure that it doesn't get promoted to a
     * register.
     */
    volatile double retval;

    /* 
     * A zero significand requires explicit construction of -0.0.
     * (Unary minus returns positive zero.)
     */
    if (mp_iszero(significand)) {
	return copysign(0.0, -signum);
    }

    /*
     * Set the 53-bit rounding mode. WARNING: It must be reset before
     * returning.
     */
    TCL_IEEE_DOUBLE_ROUNDING;

    /*
     * Quick checks for zero, and over/underflow. Be careful to avoid
     * Make quick checks for over/underflow. Be careful to avoid
     * integer overflow when calculating with 'exponent'.
     */

    if (mp_iszero(significand)) {
	return copysign(0.0, -signum);
    }
    if (exponent >= 0 && exponent-1 > maxDigits-numSigDigs) {
	retval = HUGE_VAL;
	goto returnValue;
    } else if (exponent < 0 && numSigDigs+exponent < minDigits+1) {
	retval = 0.0;
	goto returnValue;
    }
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1911
1912
1913
1914
1915
1916
1917

1918
1919
1920
1921
1922
1923
1924







-







    int rteExponent;		/* Exponent of the round-to-even result */
    int shift;			/* Shift count for converting numerator
				 * and denominator of corrector to floating
				 * point */
    Tcl_WideInt rteSigWide;	/* Wide integer version of the significand
				 * for testing evenness */
    int i;
    mp_err err = MP_OKAY;

    /*
     * The first approximation is always low. If we find that it's HUGE_VAL,
     * we're done.
     */

    if (approxResult == HUGE_VAL) {
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
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







-
+
-
-









-
-
+
+
-









-
+
-
-
-
-
+

-
+


-
-
+
-






-
-
+
-









-
-
+
+

-
+



-
-
-
-
-
-
+
+

-
+
-
-
-
-
-







     * Compute twoMv as 2*M*v, where v is the approximate value.
     * This is done by bit-whacking to calculate 2**(M2+1)*significand,
     * and then multiplying by 5**M5.
     */

    msb = binExponent + M2;	/* 1008 */
    nDigits = msb / MP_DIGIT_BIT + 1;
    if (mp_init_size(&twoMv, nDigits) != MP_OKAY) {
    mp_init_size(&twoMv, nDigits);
	return approxResult;
    }
    i = (msb % MP_DIGIT_BIT + 1);
    twoMv.used = nDigits;
    significand *= SafeLdExp(1.0, i);
    while (--nDigits >= 0) {
	twoMv.dp[nDigits] = (mp_digit) significand;
	significand -= (mp_digit) significand;
	significand = SafeLdExp(significand, MP_DIGIT_BIT);
    }
    for (i = 0; i <= 8; ++i) {
	if (M5 & (1 << i) && (mp_mul(&twoMv, pow5+i, &twoMv) != MP_OKAY)) {
	    mp_clear(&twoMv);
	if (M5 & (1 << i)) {
	    mp_mul(&twoMv, pow5+i, &twoMv);
	    return approxResult;
	}
    }

    /*
     * Compute twoMd as 2*M*d, where d is the exact value.
     * This is done by multiplying by 5**(M5+exponent) and then multiplying
     * by 2**(M5+exponent+1), which is, of couse, a left shift.
     */

    if (mp_init_copy(&twoMd, exactSignificand) != MP_OKAY) {
    mp_init_copy(&twoMd, exactSignificand);
	mp_clear(&twoMv);
	return approxResult;
    }
    for (i = 0; (i <= 8); ++i) {
    for (i=0; i<=8; ++i) {
	if ((M5 + exponent) & (1 << i)) {
	    err = mp_mul(&twoMd, pow5+i, &twoMd);
	    mp_mul(&twoMd, pow5+i, &twoMd);
	}
    }
    if (err == MP_OKAY) {
	err = mp_mul_2d(&twoMd, M2+exponent+1, &twoMd);
    mp_mul_2d(&twoMd, M2+exponent+1, &twoMd);
    }

    /*
     * Now let twoMd = twoMd - twoMv, the difference between the exact and
     * approximate values.
     */

    if (err == MP_OKAY) {
	err = mp_sub(&twoMd, &twoMv, &twoMd);
    mp_sub(&twoMd, &twoMv, &twoMd);
    }

    /*
     * The result, 2Mv-2Md, needs to be divided by 2M to yield a correction
     * term. Because 2M may well overflow a double, we need to scale the
     * denominator by a factor of 2**binExponent-mantBits. Place that factor
     * times 1/2 ULP into twoMd.
     */

    scale = binExponent - mantBits - 1;
    mp_set_u64(&twoMv, 1);
    for (i = 0; (i <= 8) && (err == MP_OKAY); ++i) {
    mp_set(&twoMv, 1);
    for (i=0; i<=8; ++i) {
	if (M5 & (1 << i)) {
	    err = mp_mul(&twoMv, pow5+i, &twoMv);
	    mp_mul(&twoMv, pow5+i, &twoMv);
	}
    }
    multiplier = M2 + scale + 1;
    if (err != MP_OKAY) {
	mp_clear(&twoMd);
	mp_clear(&twoMv);
	return approxResult;
    } else if (multiplier > 0) {
	err = mp_mul_2d(&twoMv, multiplier, &twoMv);
    if (multiplier > 0) {
	mp_mul_2d(&twoMv, multiplier, &twoMv);
    } else if (multiplier < 0) {
	err = mp_div_2d(&twoMv, -multiplier, &twoMv, NULL);
	mp_div_2d(&twoMv, -multiplier, &twoMv, NULL);
    }
    if (err != MP_OKAY) {
	mp_clear(&twoMd);
	mp_clear(&twoMv);
	return approxResult;
    }

    /*
     * Will the eventual correction term be less than, equal to, or
     * greater than 1/2 ULP?
     */

2072
2073
2074
2075
2076
2077
2078
2079

2080
2081

2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2062
2063
2064
2065
2066
2067
2068

2069


2070






2071
2072
2073
2074
2075
2076
2077







-
+
-
-
+
-
-
-
-
-
-








    /*
     * Reduce the numerator and denominator of the corrector term so that
     * they will fit in the floating point precision.
     */
    shift = mp_count_bits(&twoMv) - FP_PRECISION - 1;
    if (shift > 0) {
	err = mp_div_2d(&twoMv, shift, &twoMv, NULL);
	mp_div_2d(&twoMv, shift, &twoMv, NULL);
	if (err == MP_OKAY) {
	    err = mp_div_2d(&twoMd, shift, &twoMd, NULL);
	mp_div_2d(&twoMd, shift, &twoMd, NULL);
	}
    }
    if (err != MP_OKAY) {
	mp_clear(&twoMd);
	mp_clear(&twoMv);
	return approxResult;
    }

    /*
     * Convert the numerator and denominator of the corrector term accurately
     * to floating point numbers.
     */

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
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







-
+








-


-
+



-
+

-
+





-
-
+
+

-







 *
 * Side effects:
 *	Stores base*5**n in result.
 *
 *----------------------------------------------------------------------
 */

static inline mp_err
static inline void
MulPow5(
    mp_int *base, 		/* Number to multiply. */
    unsigned n,			/* Power of 5 to multiply by. */
    mp_int *result)		/* Place to store the result. */
{
    mp_int *p = base;
    int n13 = n / 13;
    int r = n % 13;
    mp_err err = MP_OKAY;

    if (r != 0) {
	err = mp_mul_d(p, dpow5[r], result);
	mp_mul_d(p, dpow5[r], result);
	p = result;
    }
    r = 0;
    while ((err == MP_OKAY) && (n13 != 0)) {
    while (n13 != 0) {
	if (n13 & 1) {
	    err = mp_mul(p, pow5_13+r, result);
	    mp_mul(p, pow5_13+r, result);
	    p = result;
	}
	n13 >>= 1;
	++r;
    }
    if ((err == MP_OKAY) && (p != result)) {
	err = mp_copy(p, result);
    if (p != result) {
	mp_copy(p, result);
    }
    return err;
}

/*
 *----------------------------------------------------------------------
 *
 * NormalizeRightward --
 *
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
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







-
+


















-
+





-
+







 *
 * FormatInfAndNaN --
 *
 *	Bailout for formatting infinities and Not-A-Number.
 *
 * Results:
 *	Returns one of the strings 'Infinity' and 'NaN'.  The string returned
 *	must be freed by the caller using 'Tcl_Free'.
 *	must be freed by the caller using 'ckfree'.
 *
 * Side effects:
 *	Stores 9999 in *decpt, and sets '*endPtr' to designate the terminating
 *	NUL byte of the string if 'endPtr' is not NULL.
 *
 *----------------------------------------------------------------------
 */

static inline char *
FormatInfAndNaN(
    Double *d,			/* Exceptional number to format. */
    int *decpt,			/* Decimal point to set to a bogus value. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval;

    *decpt = 9999;
    if (!(d->w.word1) && !(d->w.word0 & HI_ORDER_SIG_MASK)) {
	retval = (char *)Tcl_Alloc(9);
	retval = ckalloc(9);
	strcpy(retval, "Infinity");
	if (endPtr) {
	    *endPtr = retval + 8;
	}
    } else {
	retval = (char *)Tcl_Alloc(4);
	retval = ckalloc(4);
	strcpy(retval, "NaN");
	if (endPtr) {
	    *endPtr = retval + 3;
	}
    }
    return retval;
}
2383
2384
2385
2386
2387
2388
2389
2390

2391
2392
2393
2394
2395
2396
2397
2364
2365
2366
2367
2368
2369
2370

2371
2372
2373
2374
2375
2376
2377
2378







-
+







 */

static inline char *
FormatZero(
    int *decpt,			/* Location of the decimal point. */
    char **endPtr)		/* Pointer to the end of the formatted data */
{
    char *retval = (char *)Tcl_Alloc(2);
    char *retval = ckalloc(2);

    strcpy(retval, "0");
    if (endPtr) {
	*endPtr = retval+1;
    }
    *decpt = 0;
    return retval;
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
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







-
-
+
+
+









-
+
+
+
+
+
+
+















-
-
-
-
+
+
+
+







 *	one too high.
 *
 *----------------------------------------------------------------------
 */

static inline void
SetPrecisionLimits(
    int flags,		/* Type of conversion: TCL_DD_SHORTEST,
				 * TCL_DD_E_FMT, TCL_DD_F_FMT. */
    int convType,		/* Type of conversion: TCL_DD_SHORTEST,
				 * TCL_DD_STEELE0, TCL_DD_E_FMT,
				 * TCL_DD_F_FMT. */
    int k,			/* Floor(log10(number to convert)) */
    int *ndigitsPtr,		/* IN/OUT: Number of digits requested (will be
				 *         adjusted if needed). */
    int *iPtr,			/* OUT: Maximum number of digits to return. */
    int *iLimPtr,		/* OUT: Number of digits of significance if
				 *      the bignum method is used.*/
    int *iLim1Ptr)		/* OUT: Number of digits of significance if
				 *      the quick method is used. */
{
    switch (flags & TCL_DD_CONVERSION_TYPE_MASK) {
    switch (convType) {
    case TCL_DD_SHORTEST0:
    case TCL_DD_STEELE0:
	*iLimPtr = *iLim1Ptr = -1;
	*iPtr = 18;
	*ndigitsPtr = 0;
	break;
    case TCL_DD_E_FORMAT:
	if (*ndigitsPtr <= 0) {
	    *ndigitsPtr = 1;
	}
	*iLimPtr = *iLim1Ptr = *iPtr = *ndigitsPtr;
	break;
    case TCL_DD_F_FORMAT:
	*iPtr = *ndigitsPtr + k + 1;
	*iLimPtr = *iPtr;
	*iLim1Ptr = *iPtr - 1;
	if (*iPtr <= 0) {
	    *iPtr = 1;
	}
	break;
    default:
	*iLimPtr = *iLim1Ptr = -1;
	*iPtr = 18;
	*ndigitsPtr = 0;
	break;
	*iPtr = -1;
	*iLimPtr = -1;
	*iLim1Ptr = -1;
	Tcl_Panic("impossible conversion type in TclDoubleDigits");
    }
}

/*
 *----------------------------------------------------------------------
 *
 * BumpUp --
2878
2879
2880
2881
2882
2883
2884
2885

2886
2887
2888
2889
2890
2891
2892
2866
2867
2868
2869
2870
2871
2872

2873
2874
2875
2876
2877
2878
2879
2880







-
+








static inline char *
QuickConversion(
    double e,			/* Number to format. */
    int k,			/* floor(log10(d)), approximately. */
    int k_check,		/* 0 if k is exact, 1 if it may be too high */
    int flags,			/* Flags passed to dtoa:
				 *    TCL_DD_SHORTEST */
				 *    TCL_DD_SHORTEN_FLAG */
    int len,			/* Length of the return value. */
    int ilim,			/* Number of digits to store. */
    int ilim1,			/* Number of digits to store if we misguessed
				 * k. */
    int *decpt,			/* OUTPUT: Location of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the terminal null
				 * byte. */
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
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







-
+














-
+

-
+








-
+








-
+





-
+








    if (k_check && d < 1. && ilim > 0) {
	if (ilim1 < 0) {
	    return NULL;
	}
	ilim = ilim1;
	--k;
	d *= 10.0;
	d = d * 10.0;
	++ieps;
    }

    /*
     * Compute estimated roundoff error.
     */

    eps.d = ieps * d + 7.;
    eps.w.word0 -= (FP_PRECISION-1) << EXP_SHIFT;

    /*
     * Handle the peculiar case where the result has no significant digits.
     */

    retval = (char *)Tcl_Alloc(len + 1);
    retval = ckalloc(len + 1);
    if (ilim == 0) {
	d -= 5.;
	d = d - 5.;
	if (d > eps.d) {
	    *retval = '1';
	    *decpt = k;
	    return retval;
	} else if (d < -eps.d) {
	    *decpt = k;
	    return retval;
	} else {
	    Tcl_Free(retval);
	    ckfree(retval);
	    return NULL;
	}
    }

    /*
     * Format the digit string.
     */

    if (flags & TCL_DD_SHORTEST) {
    if (flags & TCL_DD_SHORTEN_FLAG) {
	end = ShorteningQuickFormat(d, k, ilim, eps.d, retval, decpt);
    } else {
	end = StrictQuickFormat(d, k, ilim, eps.d, retval, decpt);
    }
    if (end == NULL) {
	Tcl_Free(retval);
	ckfree(retval);
	return NULL;
    }
    *end = '\0';
    if (endPtr != NULL) {
	*endPtr = end;
    }
    return retval;
3024
3025
3026
3027
3028
3029
3030


3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047

3048
3049
3050
3051
3052
3053
3054
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
3042
3043
3044







+
+
















-
+







 *
 *----------------------------------------------------------------------
 */

static inline char *
ShorteningInt64Conversion(
    Double *dPtr,		/* Original number to convert. */
    int convType,		/* Type of conversion (shortest, Steele,
				 * E format, F format). */
    Tcl_WideUInt bw,		/* Integer significand. */
    int b2, int b5,		/* Scale factor for the significand in the
				 * numerator. */
    int m2plus, int m2minus, int m5,
				/* Scale factors for 1/2 ulp in the numerator
				 * (will be different if bw == 1. */
    int s2, int s5,		/* Scale factors for the denominator. */
    int k,			/* Number of output digits before the decimal
				 * point. */
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = (char *)Tcl_Alloc(len + 1);
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */
3090
3091
3092
3093
3094
3095
3096
3097

3098
3099
3100
3101
3102
3103
3104
3080
3081
3082
3083
3084
3085
3086

3087
3088
3089
3090
3091
3092
3093
3094







-
+








	/*
	 * Does the current digit put us on the low side of the exact value
	 * but within within roundoff of being exact?
	 */

	if (b < mplus || (b == mplus
		&& (dPtr->w.word1 & 1) == 0)) {
		&& convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
	    /*
	     * Make sure we shouldn't be rounding *up* instead, in case the
	     * next number above is closer.
	     */

	    if (2 * b > S || (2 * b == S && (digit & 1) != 0)) {
		++digit;
3119
3120
3121
3122
3123
3124
3125
3126

3127
3128
3129
3130
3131
3132
3133
3109
3110
3111
3112
3113
3114
3115

3116
3117
3118
3119
3120
3121
3122
3123







-
+








	/*
	 * Does one plus the current digit put us within roundoff of the
	 * number?
	 */

	if (b > S - mminus || (b == S - mminus
		&& (dPtr->w.word1 & 1) == 0)) {
		&& convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
	    if (digit == 9) {
		*s++ = '9';
		s = BumpUp(s, retval, &k);
		break;
	    }
	    ++digit;
	    *s++ = '0' + digit;
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
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







+
+
+













-
+







 *	of the terminal null byte in '*endPtr'.
 *
 *----------------------------------------------------------------------
 */

static inline char *
StrictInt64Conversion(
    Double *dPtr,		/* Original number to convert. */
    int convType,		/* Type of conversion (shortest, Steele,
				 * E format, F format). */
    Tcl_WideUInt bw,		/* Integer significand. */
    int b2, int b5,		/* Scale factor for the significand in the
				 * numerator. */
    int s2, int s5,		/* Scale factors for the denominator. */
    int k,			/* Number of output digits before the decimal
				 * point. */
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = (char *)Tcl_Alloc(len + 1);
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    Tcl_WideUInt b = (bw * wuipow5[b5]) << b2;
				/* Numerator of the fraction being
				 * converted. */
    Tcl_WideUInt S = wuipow5[s5] << s2;
				/* Denominator of the fraction being
				 * converted. */
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
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







+
+
+











+
-
+











+
+
+
+







 */

static inline int
ShouldBankerRoundUpToNextPowD(
    mp_int *b,			/* Numerator of the fraction. */
    mp_int *m,			/* Numerator of the rounding tolerance. */
    int sd,			/* Common denominator is 2**(sd*MP_DIGIT_BIT). */
    int convType,		/* Conversion type: STEELE defeats
				 * round-to-even (not sure why one wants to do
				 * this; I copied it from Gay). FIXME */
    int isodd,			/* 1 if the integer significand is odd. */
    mp_int *temp)		/* Work area for the calculation. */
{
    int i;

    /*
     * Compare B and S-m - which is the same as comparing B+m and S - which we
     * do by computing b+m and doing a bitwhack compare against
     * 2**(MP_DIGIT_BIT*sd)
     */

    mp_add(b, m, temp);
    if ((mp_add(b, m, temp) != MP_OKAY) || (temp->used <= sd)) {	/* Too few digits to be > s */
    if (temp->used <= sd) {	/* Too few digits to be > s */
	return 0;
    }
    if (temp->used > sd+1 || temp->dp[sd] > 1) {
				/* >= 2s */
	return 1;
    }
    for (i = sd-1; i >= 0; --i) {
				/* Check for ==s */
	if (temp->dp[i] != 0) {	/* > s */
	    return 1;
	}
    }
    if (convType == TCL_DD_STEELE0) {
				/* Biased rounding. */
	return 0;
    }
    return isodd;
}

/*
 *----------------------------------------------------------------------
 *
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
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







+
+
















-
+









-






-
+
-
-
-
+
-
-
-
-
+
-
-
+
-





-
-
+
+










-
-
+
-
-
-
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
-







 *
 *----------------------------------------------------------------------
 */

static inline char *
ShorteningBignumConversionPowD(
    Double *dPtr,		/* Original number to convert. */
    int convType,		/* Type of conversion (shortest, Steele,
				 * E format, F format). */
    Tcl_WideUInt bw,		/* Integer significand. */
    int b2, int b5,		/* Scale factor for the significand in the
				 * numerator. */
    int m2plus, int m2minus, int m5,
				/* Scale factors for 1/2 ulp in the numerator
				 * (will be different if bw == 1). */
    int sd,			/* Scale factor for the denominator. */
    int k,			/* Number of output digits before the decimal
				 * point. */
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = (char *)Tcl_Alloc(len + 1);
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_int mplus, mminus;	/* Bounds for roundoff. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
    mp_int temp;
    int r1;
    mp_err err = MP_OKAY;

    /*
     * b = bw * 2**b2 * 5**b5
     * mminus = 5**m5
     */

    if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) {
    TclBNInitBignumFromWideUInt(&b, bw);
	return NULL;
    }
    if (mp_init_set(&mminus, 1) != MP_OKAY) {
    mp_init_set(&mminus, 1);
	mp_clear(&b);
	return NULL;
    }
    err = MulPow5(&b, b5, &b);
    MulPow5(&b, b5, &b);
    if (err == MP_OKAY) {
	err = mp_mul_2d(&b, b2, &b);
    mp_mul_2d(&b, b2, &b);
    }

    /*
     * Adjust if the logarithm was guessed wrong.
     */

    if ((err == MP_OKAY) && (b.used <= sd)) {
	err = mp_mul_d(&b, 10, &b);
    if (b.used <= sd) {
	mp_mul_d(&b, 10, &b);
	++m2plus; ++m2minus; ++m5;
	ilim = ilim1;
	--k;
    }

    /*
     * mminus = 5**m5 * 2**m2minus
     * mplus = 5**m5 * 2**m2plus
     */

    if (err == MP_OKAY) {
	err = mp_mul_2d(&mminus, m2minus, &mminus);
    mp_mul_2d(&mminus, m2minus, &mminus);
    }
    if (err == MP_OKAY) {
	err = MulPow5(&mminus, m5, &mminus);
    MulPow5(&mminus, m5, &mminus);
    }
    if ((err == MP_OKAY) && (m2plus > m2minus)) {
	err = mp_init_copy(&mplus, &mminus);
    if (m2plus > m2minus) {
	mp_init_copy(&mplus, &mminus);
	if (err == MP_OKAY) {
	    err = mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
	}
	mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
    }
    }
    if (err == MP_OKAY) {
	err = mp_init(&temp);
    mp_init(&temp);
    }

    /*
     * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT)
     * by mp_digit extraction.
     */

    i = 0;
3488
3489
3490
3491
3492
3493
3494
3495

3496
3497
3498
3499
3500
3501
3502
3475
3476
3477
3478
3479
3480
3481

3482
3483
3484
3485
3486
3487
3488
3489







-
+







	/*
	 * Does the current digit put us on the low side of the exact value
	 * but within within roundoff of being exact?
	 */

	r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
	if (r1 == MP_LT || (r1 == MP_EQ
		&& (dPtr->w.word1 & 1) == 0)) {
		&& convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
	    /*
	     * Make sure we shouldn't be rounding *up* instead, in case the
	     * next number above is closer.
	     */

	    if (ShouldBankerRoundUpPowD(&b, sd, digit&1)) {
		++digit;
3516
3517
3518
3519
3520
3521
3522
3523

3524
3525
3526
3527
3528
3529
3530
3503
3504
3505
3506
3507
3508
3509

3510
3511
3512
3513
3514
3515
3516
3517







-
+







	}

	/*
	 * Does one plus the current digit put us within roundoff of the
	 * number?
	 */

	if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd,
	if (ShouldBankerRoundUpToNextPowD(&b, &mminus, sd, convType,
		dPtr->w.word1 & 1, &temp)) {
	    if (digit == 9) {
		*s++ = '9';
		s = BumpUp(s, retval, &k);
		break;
	    }
	    ++digit;
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
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







-
-
+
-
-
-
+
-
-
-
+
+


















-
+







	    break;
	}

	/*
	 * Advance to the next digit.
	 */

	if (err == MP_OKAY) {
	    err = mp_mul_d(&b, 10, &b);
	mp_mul_d(&b, 10, &b);
	}
	if (err == MP_OKAY) {
	    err = mp_mul_d(&mminus, 10, &mminus);
	mp_mul_d(&mminus, 10, &mminus);
	}
	if ((err == MP_OKAY) && (m2plus > m2minus)) {
	    err = mp_mul_2d(&mminus, m2plus-m2minus, &mplus);
	if (m2plus > m2minus) {
	    mp_mul_2d(&mminus, m2plus-m2minus, &mplus);
	}
	++i;
    }

    /*
     * Endgame - store the location of the decimal point and the end of the
     * string.
     */

    if (m2plus > m2minus) {
	mp_clear(&mplus);
    }
    mp_clear_multi(&b, &mminus, &temp, NULL);
    *s = '\0';
    *decpt = k;
    if (endPtr) {
	*endPtr = s;
    }
    return (err == MP_OKAY) ? retval : NULL;
    return retval;
}

/*
 *----------------------------------------------------------------------
 *
 * StrictBignumConversionPowD --
 *
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
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







+
+
+













-
+






-
+





-
+
-
-
-
+
-
-
+
-





-
-
+
+



+







-
+







 *	of the terminal null byte in '*endPtr'.
 *
 *----------------------------------------------------------------------
 */

static inline char *
StrictBignumConversionPowD(
    Double *dPtr,		/* Original number to convert. */
    int convType,		/* Type of conversion (shortest, Steele,
				 * E format, F format). */
    Tcl_WideUInt bw,		/* Integer significand. */
    int b2, int b5,		/* Scale factor for the significand in the
				 * numerator. */
    int sd,			/* Scale factor for the denominator. */
    int k,			/* Number of output digits before the decimal
				 * point. */
    int len,			/* Number of digits to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Position of the terminal '\0' at
				 *	   the end of the returned string. */
{
    char *retval = (char *)Tcl_Alloc(len + 1);
    char *retval = ckalloc(len + 1);
				/* Output buffer. */
    mp_int b;			/* Numerator of the fraction being
				 * converted. */
    mp_digit digit;		/* Current output digit. */
    char *s = retval;		/* Cursor in the output buffer. */
    int i;			/* Index in the output buffer. */
    mp_err err;
    mp_int temp;

    /*
     * b = bw * 2**b2 * 5**b5
     */

    if (mp_init_u64(&b, bw) != MP_OKAY) {
    TclBNInitBignumFromWideUInt(&b, bw);
	return NULL;
    }
    err = MulPow5(&b, b5, &b);
    MulPow5(&b, b5, &b);
    if (err == MP_OKAY) {
	err = mp_mul_2d(&b, b2, &b);
    mp_mul_2d(&b, b2, &b);
    }

    /*
     * Adjust if the logarithm was guessed wrong.
     */

    if ((err == MP_OKAY) && (b.used <= sd)) {
	err = mp_mul_d(&b, 10, &b);
    if (b.used <= sd) {
	mp_mul_d(&b, 10, &b);
	ilim = ilim1;
	--k;
    }
    mp_init(&temp);

    /*
     * Loop through the digits. Do division and mod by s == 2**(sd*MP_DIGIT_BIT)
     * by mp_digit extraction.
     */

    i = 1;
    while (err == MP_OKAY) {
    for (;;) {
	if (b.used <= sd) {
	    digit = 0;
	} else {
	    digit = b.dp[sd];
	    if (b.used > sd+1 || digit >= 10) {
		Tcl_Panic("wrong digit!");
	    }
3679
3680
3681
3682
3683
3684
3685
3686

3687
3688
3689
3690
3691
3692
3693
3694
3695

3696
3697
3698
3699
3700
3701
3702
3662
3663
3664
3665
3666
3667
3668

3669
3670
3671
3672
3673
3674
3675
3676
3677

3678
3679
3680
3681
3682
3683
3684
3685







-
+








-
+







	    break;
	}

	/*
	 * Advance to the next digit.
	 */

	err = mp_mul_d(&b, 10, &b);
	mp_mul_d(&b, 10, &b);
	++i;
    }

    /*
     * Endgame - store the location of the decimal point and the end of the
     * string.
     */

    mp_clear(&b);
    mp_clear_multi(&b, &temp, NULL);
    *s = '\0';
    *decpt = k;
    if (endPtr) {
	*endPtr = s;
    }
    return retval;
}
3752
3753
3754
3755
3756
3757
3758



3759


3760
3761
3762
3763
3764
3765
3766
3767
3768

3769
3770
3771

3772
3773
3774
3775
3776



3777


3778
3779
3780
3781
3782
3783
3784
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







+
+
+
-
+
+


-





-
+
-
-
-
+
-




+
+
+
-
+
+








static inline int
ShouldBankerRoundUpToNext(
    mp_int *b,			/* Remainder from the division that produced
				 * the last digit. */
    mp_int *m,			/* Numerator of the rounding tolerance. */
    mp_int *S,			/* Denominator. */
    int convType,		/* Conversion type: STEELE0 defeats
				 * round-to-even. (Not sure why one would want
				 * this; I coped it from Gay). FIXME */
    int isodd)			/* 1 if the integer significand is odd. */
    int isodd,			/* 1 if the integer significand is odd. */
    mp_int *temp)		/* Work area needed for the calculation. */
{
    int r;
    mp_int temp;

    /*
     * Compare b and S-m: this is the same as comparing B+m and S.
     */

    if ((mp_init(&temp) != MP_OKAY) || (mp_add(b, m, &temp) != MP_OKAY)) {
    mp_add(b, m, temp);
	return 0;
    }
    r = mp_cmp_mag(&temp, S);
    r = mp_cmp_mag(temp, S);
    mp_clear(&temp);
    switch(r) {
    case MP_LT:
	return 0;
    case MP_EQ:
	if (convType == TCL_DD_STEELE0) {
	    return 0;
	} else {
	return isodd;
	    return isodd;
	}
    case MP_GT:
	return 1;
    }
    Tcl_Panic("in ShouldBankerRoundUpToNext, trichotomy fails!");
    return 0;
}

3799
3800
3801
3802
3803
3804
3805

3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817

3818
3819
3820
3821
3822
3823
3824
3825

3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836

3837
3838
3839

3840
3841

3842
3843
3844
3845
3846
3847

3848
3849
3850
3851
3852
3853
3854
3855


3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866

3867
3868
3869

3870
3871
3872


3873
3874
3875


3876

3877
3878
3879
3880
3881
3882
3883

3884
3885
3886
3887


3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900



3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919


3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936


3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947

3948
3949
3950
3951
3952

3953
3954

3955
3956
3957


3958
3959
3960

3961
3962
3963
3964
3965
3966
3967
3968
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804

3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817

3818
3819
3820
3821
3822
3823

3824



3825


3826






3827

3828
3829
3830
3831
3832


3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843


3844



3845



3846
3847



3848
3849

3850
3851
3852
3853
3854
3855


3856

3857


3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870


3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890


3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907


3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919

3920
3921
3922
3923
3924

3925


3926



3927
3928
3929


3930

3931
3932
3933
3934
3935
3936
3937







+











-
+








+



-






-
+
-
-
-
+
-
-
+
-
-
-
-
-
-
+
-





-
-
+
+









-
-
+
-
-
-
+
-
-
-
+
+
-
-
-
+
+
-
+





-
-
+
-

-
-
+
+











-
-
+
+
+

















-
-
+
+















-
-
+
+










-
+




-
+
-
-
+
-
-
-
+
+

-
-
+
-







 *
 *----------------------------------------------------------------------
 */

static inline char *
ShorteningBignumConversion(
    Double *dPtr,		/* Original number being converted. */
    int convType,		/* Conversion type. */
    Tcl_WideUInt bw,		/* Integer significand and exponent. */
    int b2,			/* Scale factor for the significand. */
    int m2plus, int m2minus,	/* Scale factors for 1/2 ulp in numerator. */
    int s2, int s5,		/* Scale factors for denominator. */
    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = (char *)Tcl_Alloc(len+1);
    char *retval = ckalloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int mminus;		/* 1/2 ulp below the result. */
    mp_int mplus;		/* 1/2 ulp above the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
    int digit;			/* Current digit of the result. */
    mp_int temp;		/* Work area. */
    int minit = 1;		/* Fudge factor for when we misguess k. */
    int i;
    int r1;
    mp_err err;

    /*
     * b = bw * 2**b2 * 5**b5
     * S = 2**s2 * 5*s5
     */

    if ((retval == NULL) || (mp_init_u64(&b, bw) != MP_OKAY)) {
    TclBNInitBignumFromWideUInt(&b, bw);
	return NULL;
    }
    err = mp_mul_2d(&b, b2, &b);
    mp_mul_2d(&b, b2, &b);
    if (err == MP_OKAY) {
	err = mp_init_set(&S, 1);
    mp_init_set(&S, 1);
    }
    if (err == MP_OKAY) {
	err = MulPow5(&S, s5, &S);
    }
    if (err == MP_OKAY) {
	err = mp_mul_2d(&S, s2, &S);
    MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
    }

    /*
     * Handle the case where we guess the position of the decimal point wrong.
     */

    if ((err == MP_OKAY) && (mp_cmp_mag(&b, &S) == MP_LT)) {
	err = mp_mul_d(&b, 10, &b);
    if (mp_cmp_mag(&b, &S) == MP_LT) {
	mp_mul_d(&b, 10, &b);
	minit = 10;
	ilim =ilim1;
	--k;
    }

    /*
     * mminus = 2**m2minus * 5**m5
     */

    if (err == MP_OKAY) {
	err = mp_init_set(&mminus, minit);
    mp_init_set(&mminus, minit);
    }
    if (err == MP_OKAY) {
	err = mp_mul_2d(&mminus, m2minus, &mminus);
    mp_mul_2d(&mminus, m2minus, &mminus);
    }
    if ((err == MP_OKAY) && (m2plus > m2minus)) {
	err = mp_init_copy(&mplus, &mminus);
    if (m2plus > m2minus) {
	mp_init_copy(&mplus, &mminus);
	if (err == MP_OKAY) {
	    err = mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
	}
	mp_mul_2d(&mplus, m2plus-m2minus, &mplus);
    }
    }
    mp_init(&temp);

    /*
     * Loop through the digits.
     */

    if (err == MP_OKAY) {
	err = mp_init(&dig);
    mp_init(&dig);
    }
    i = 1;
    while (err == MP_OKAY) {
	err = mp_div(&b, &S, &dig, &b);
    for (;;) {
	mp_div(&b, &S, &dig, &b);
	if (dig.used > 1 || dig.dp[0] >= 10) {
	    Tcl_Panic("wrong digit!");
	}
	digit = dig.dp[0];

	/*
	 * Does the current digit leave us with a remainder small enough to
	 * round to it?
	 */

	r1 = mp_cmp_mag(&b, (m2plus > m2minus)? &mplus : &mminus);
	if (r1 == MP_LT || (r1 == MP_EQ && (dPtr->w.word1 & 1) == 0)) {
	    err = mp_mul_2d(&b, 1, &b);
	if (r1 == MP_LT || (r1 == MP_EQ
		&& convType != TCL_DD_STEELE0 && (dPtr->w.word1 & 1) == 0)) {
	    mp_mul_2d(&b, 1, &b);
	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
		++digit;
		if (digit == 10) {
		    *s++ = '9';
		    s = BumpUp(s, retval, &k);
		    break;
		}
	    }
	    *s++ = '0' + digit;
	    break;
	}

	/*
	 * Does the current digit leave us with a remainder large enough to
	 * commit to rounding up to the next higher digit?
	 */

	if (ShouldBankerRoundUpToNext(&b, &mminus, &S,
		dPtr->w.word1 & 1)) {
	if (ShouldBankerRoundUpToNext(&b, &mminus, &S, convType,
		dPtr->w.word1 & 1, &temp)) {
	    ++digit;
	    if (digit == 10) {
		*s++ = '9';
		s = BumpUp(s, retval, &k);
		break;
	    }
	    *s++ = '0' + digit;
	    break;
	}

	/*
	 * Have we converted all the requested digits?
	 */

	*s++ = '0' + digit;
	if ((err == MP_OKAY) && (i == ilim)) {
	    err = mp_mul_2d(&b, 1, &b);
	if (i == ilim) {
	    mp_mul_2d(&b, 1, &b);
	    if (ShouldBankerRoundUp(&b, &S, digit&1)) {
		s = BumpUp(s, retval, &k);
	    }
	    break;
	}

	/*
	 * Advance to the next digit.
	 */

	if ((err == MP_OKAY) && (s5 > 0)) {
	if (s5 > 0) {
	    /*
	     * Can possibly shorten the denominator.
	     */

	    err = mp_mul_2d(&b, 1, &b);
	    mp_mul_2d(&b, 1, &b);
	    if (err == MP_OKAY) {
		err = mp_mul_2d(&mminus, 1, &mminus);
	    mp_mul_2d(&mminus, 1, &mminus);
	    }
	    if ((err == MP_OKAY) && (m2plus > m2minus)) {
		err = mp_mul_2d(&mplus, 1, &mplus);
	    if (m2plus > m2minus) {
		mp_mul_2d(&mplus, 1, &mplus);
	    }
	    if (err == MP_OKAY) {
		err = mp_div_d(&S, 5, &S, NULL);
	    mp_div_d(&S, 5, &S, NULL);
	    }
	    --s5;

	    /*
	     * IDEA: It might possibly be a win to fall back to int64_t
	     *       arithmetic here if S < 2**64/10. But it's a win only for
	     *       a fairly narrow range of magnitudes so perhaps not worth
	     *       bothering.  We already know that we shorten the
3984
3985
3986
3987
3988
3989
3990
3991
3992


3993
3994

3995
3996
3997


3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012

4013
4014
4015
4016
4017
4018
4019
3953
3954
3955
3956
3957
3958
3959


3960
3961


3962



3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978

3979
3980
3981
3982
3983
3984
3985
3986







-
-
+
+
-
-
+
-
-
-
+
+














-
+







	     * 10**38  12 trips
	     * 10**39  13 trips
	     * 10**40  14 trips
	     * 10**41  15 trips
	     * 10**42  16 trips
	     * thereafter no gain.
	     */
	} else if (err == MP_OKAY) {
	    err = mp_mul_d(&b, 10, &b);
	} else {
	    mp_mul_d(&b, 10, &b);
	    if (err == MP_OKAY) {
		err = mp_mul_d(&mminus, 10, &mminus);
	    mp_mul_d(&mminus, 10, &mminus);
	    }
	    if ((err == MP_OKAY) && (m2plus > m2minus)) {
		err = mp_mul_2d(&mplus, 10, &mplus);
	    if (m2plus > m2minus) {
		mp_mul_2d(&mplus, 10, &mplus);
	    }
	}

	++i;
    }

    /*
     * Endgame - store the location of the decimal point and the end of the
     * string.
     */

    if (m2plus > m2minus) {
	mp_clear(&mplus);
    }
    mp_clear_multi(&b, &mminus, &dig, &S, NULL);
    mp_clear_multi(&b, &mminus, &temp, &dig, &S, NULL);
    *s = '\0';
    *decpt = k;
    if (endPtr) {
	*endPtr = s;
    }
    return retval;
}
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
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019

4020
4021
4022
4023
4024
4025
4026
4027
4028
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







+
+










-
+






+


-






-
-
+
-
-
+
-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-





-
+
+









-
+











+
-
+



-
+









-
+


-
+
-
-
+
-


-
+

-
-
+
-













-
-
+
+
















+
-
+
















-
+







 *	to the end of the number in *endPtr.
 *
 *----------------------------------------------------------------------
 */

static inline char *
StrictBignumConversion(
    Double *dPtr,		/* Original number being converted. */
    int convType,		/* Conversion type. */
    Tcl_WideUInt bw,		/* Integer significand and exponent. */
    int b2,			/* Scale factor for the significand. */
    int s2, int s5,		/* Scale factors for denominator. */
    int k,			/* Guessed position of the decimal point. */
    int len,			/* Size of the digit buffer to allocate. */
    int ilim,			/* Number of digits to convert if b >= s */
    int ilim1,			/* Number of digits to convert if b < s */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    char **endPtr)		/* OUTPUT: Pointer to the end of the number */
{
    char *retval = (char *)Tcl_Alloc(len+1);
    char *retval = ckalloc(len+1);
				/* Buffer of digits to return. */
    char *s = retval;		/* Cursor in the return value. */
    mp_int b;			/* Numerator of the result. */
    mp_int S;			/* Denominator of the result. */
    mp_int dig;			/* Current digit of the result. */
    int digit;			/* Current digit of the result. */
    mp_int temp;		/* Work area. */
    int g;			/* Size of the current digit ground. */
    int i, j;
    mp_err err;

    /*
     * b = bw * 2**b2 * 5**b5
     * S = 2**s2 * 5*s5
     */

    if (mp_init(&dig) != MP_OKAY) {
	return NULL;
    mp_init_multi(&temp, &dig, NULL);
    }
    if (mp_init_u64(&b, bw) != MP_OKAY) {
    TclBNInitBignumFromWideUInt(&b, bw);
	mp_clear(&dig);
	return NULL;
    }
    err = mp_mul_2d(&b, b2, &b);
    mp_mul_2d(&b, b2, &b);
    if (err == MP_OKAY) {
 	err = mp_init_set(&S, 1);
    mp_init_set(&S, 1);
    }
    if (err == MP_OKAY) {
	err = MulPow5(&S, s5, &S);
	if (err == MP_OKAY) {
	    err = mp_mul_2d(&S, s2, &S);
    MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
	}
    }

    /*
     * Handle the case where we guess the position of the decimal point wrong.
     */

    if ((mp_cmp_mag(&b, &S) == MP_LT) && (mp_mul_d(&b, 10, &b) == MP_OKAY)) {
    if (mp_cmp_mag(&b, &S) == MP_LT) {
	mp_mul_d(&b, 10, &b);
	ilim =ilim1;
	--k;
    }

    /*
     * Convert the leading digit.
     */

    i = 0;
    err = mp_div(&b, &S, &dig, &b);
    mp_div(&b, &S, &dig, &b);
    if (dig.used > 1 || dig.dp[0] >= 10) {
	Tcl_Panic("wrong digit!");
    }
    digit = dig.dp[0];

    /*
     * Is a single digit all that was requested?
     */

    *s++ = '0' + digit;
    if (++i >= ilim) {
	mp_mul_2d(&b, 1, &b);
	if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) {
	if (ShouldBankerRoundUp(&b, &S, digit&1)) {
	    s = BumpUp(s, retval, &k);
	}
    } else {
	while (err == MP_OKAY) {
	for (;;) {
	    /*
	     * Shift by a group of digits.
	     */

	    g = ilim - i;
	    if (g > DIGIT_GROUP) {
		g = DIGIT_GROUP;
	    }
	    if (s5 >= g) {
		err = mp_div_d(&S, dpow5[g], &S, NULL);
		mp_div_d(&S, dpow5[g], &S, NULL);
		s5 -= g;
	    } else if (s5 > 0) {
		err = mp_div_d(&S, dpow5[s5], &S, NULL);
		mp_div_d(&S, dpow5[s5], &S, NULL);
		if (err == MP_OKAY) {
		    err = mp_mul_d(&b, dpow5[g - s5], &b);
		mp_mul_d(&b, dpow5[g - s5], &b);
		}
		s5 = 0;
	    } else {
		err = mp_mul_d(&b, dpow5[g], &b);
		mp_mul_d(&b, dpow5[g], &b);
	    }
	    if (err == MP_OKAY) {
		err = mp_mul_2d(&b, g, &b);
	    mp_mul_2d(&b, g, &b);
	    }

	    /*
	     * As with the shortening bignum conversion, it's possible at this
	     * point that we will have reduced the denominator to less than
	     * 2**64/10, at which point it would be possible to fall back to
	     * to int64_t arithmetic. But the potential payoff is tremendously
	     * less - unless we're working in F format - because we know that
	     * three groups of digits will always suffice for %#.17e, the
	     * longest format that doesn't introduce empty precision.
	     *
	     * Extract the next group of digits.
	     */


	    if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) {
	    mp_div(&b, &S, &dig, &b);
	    if (dig.used > 1) {
		Tcl_Panic("wrong digit!");
	    }
	    digit = dig.dp[0];
	    for (j = g-1; j >= 0; --j) {
		int t = itens[j];

		*s++ = digit / t + '0';
		digit %= t;
	    }
	    i += g;

	    /*
	     * Have we converted all the requested digits?
	     */

	    if (i == ilim) {
		mp_mul_2d(&b, 1, &b);
		if ((mp_mul_2d(&b, 1, &b) == MP_OKAY) && ShouldBankerRoundUp(&b, &S, digit&1)) {
		if (ShouldBankerRoundUp(&b, &S, digit&1)) {
		    s = BumpUp(s, retval, &k);
		}
		break;
	    }
	}
    }
    while (*--s == '0') {
	/* do nothing */
    }
    ++s;

    /*
     * Endgame - store the location of the decimal point and the end of the
     * string.
     */

    mp_clear_multi(&b, &S, &dig, NULL);
    mp_clear_multi(&b, &S, &temp, &dig, NULL);
    *s = '\0';
    *decpt = k;
    if (endPtr) {
	*endPtr = s;
    }
    return retval;
}
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
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







-
-
+
+




+
+
+
+
+
+
+
+
+

+
-
+



-
+










-
+







 *	endPtr to point to the terminating '\0' byte of the string. Sets *sign
 *	to 1 if a minus sign should be printed with the number, or 0 if a plus
 *	sign (or no sign) should appear.
 *
 * This function is a service routine that produces the string of digits for
 * floating-point-to-decimal conversion. It can do a number of things
 * according to the 'flags' argument. Valid values for 'flags' include:
 *	TCL_DD_SHORTEST - This is the default for floating point conversion.
 *		It constructs the shortest string of
 *	TCL_DD_SHORTEST - This is the default for floating point conversion if
 *		::tcl_precision is 0. It constructs the shortest string of
 *		digits that will reconvert to the given number when scanned.
 *		For floating point numbers that are exactly between two
 *		decimal numbers, it resolves using the 'round to even' rule.
 *		With this value, the 'ndigits' parameter is ignored.
 *	TCL_DD_STEELE - This value is not recommended and may be removed in
 *		the future. It follows the conversion algorithm outlined in
 *		"How to Print Floating-Point Numbers Accurately" by Guy
 *		L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90,
 *		pp. 112-126]. This rule has the effect of rendering 1e23 as
 *		9.9999999999999999e22 - which is a 'better' approximation in
 *		the sense that it will reconvert correctly even if a
 *		subsequent input conversion is 'round up' or 'round down'
 *		rather than 'round to nearest', but is surprising otherwise.
 *	TCL_DD_E_FORMAT - This value is used to prepare numbers for %e format
 *		conversion (or for default floating->string if tcl_precision
 *		conversion. It constructs a string of at most 'ndigits' digits,
 *		is not 0). It constructs a string of at most 'ndigits' digits,
 *		choosing the one that is closest to the given number (and
 *		resolving ties with 'round to even').  It is allowed to return
 *		fewer than 'ndigits' if the number converts exactly; if the
 *		TCL_DD_E_FORMAT|TCL_DD_SHORTEST is supplied instead, it
 *		TCL_DD_E_FORMAT|TCL_DD_SHORTEN_FLAG is supplied instead, it
 *		also returns fewer digits if the shorter string will still
 *		reconvert without loss to the given input number. In any case,
 *		strings of trailing zeroes are suppressed.
 *	TCL_DD_F_FORMAT - This value is used to prepare numbers for %f format
 *		conversion. It requests that conversion proceed until
 *		'ndigits' digits after the decimal point have been converted.
 *		It is possible for this format to result in a zero-length
 *		string if the number is sufficiently small. Again, it is
 *		permissible for TCL_DD_F_FORMAT to return fewer digits for a
 *		number that converts exactly, and changing the argument to
 *		TCL_DD_F_FORMAT|TCL_DD_SHORTEST will allow the routine
 *		TCL_DD_F_FORMAT|TCL_DD_SHORTEN_FLAG will allow the routine
 *		also to return fewer digits if the shorter string will still
 *		reconvert without loss to the given input number. Strings of
 *		trailing zeroes are suppressed.
 *
 *	To any of these flags may be OR'ed TCL_DD_NO_QUICK; this flag requires
 *	all calculations to be done in exact arithmetic. Normally, E and F
 *	format with fewer than about 14 digits will be done with a quick
4265
4266
4267
4268
4269
4270
4271




4272
4273
4274
4275
4276
4277
4278
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248







+
+
+
+







    int flags,			/* Conversion flags. */
    int *decpt,			/* OUTPUT: Position of the decimal point. */
    int *sign,			/* OUTPUT: 1 if the result is negative. */
    char **endPtr)		/* OUTPUT: If not NULL, receives a pointer to
				 *	   one character beyond the end of the
				 *	   returned string. */
{
    int convType = (flags & TCL_DD_CONVERSION_TYPE_MASK);
				/* Type of conversion being performed:
				 * TCL_DD_SHORTEST0, TCL_DD_STEELE0,
				 * TCL_DD_E_FORMAT, or TCL_DD_F_FORMAT. */
    Double d;			/* Union for deconstructing doubles. */
    Tcl_WideUInt bw;		/* Integer significand. */
    int be;			/* Power of 2 by which b must be multiplied */
    int bbits;			/* Number of bits needed to represent b. */
    int denorm;			/* Flag == 1 iff the input number was
				 * denormalized. */
    int k;			/* Estimate of floor(log10(d)). */
4332
4333
4334
4335
4336
4337
4338
4339

4340
4341

4342
4343
4344
4345
4346


4347
4348
4349
4350

4351
4352
4353
4354
4355
4356
4357
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







-
+

-
+



-
-
+
+



-
+








    ComputeScale(be, k, &b2, &b5, &s2, &s5);

    /*
     * Correct an incorrect caller-supplied 'ndigits'.  Also determine:
     *	i = The maximum number of decimal digits that will be returned in the
     *      formatted string.  This is k + 1 + ndigits for F format, 18 for
     *      shortest, and ndigits for E format.
     *      shortest and Steele, and ndigits for E format.
     *  ilim = The number of significant digits to convert if k has been
     *         guessed correctly. This is -1 for shortest (which
     *         guessed correctly. This is -1 for shortest and Steele (which
     *         stop when all significance has been lost), 'ndigits' for E
     *         format, and 'k + 1 + ndigits' for F format.
     *  ilim1 = The minimum number of significant digits to convert if k has
     *	        been guessed 1 too high. This, too, is -1 for shortest,
     *	        and 'ndigits' for E format, but it's 'ndigits-1' for F
     *	        been guessed 1 too high. This, too, is -1 for shortest and
     *	        Steele, and 'ndigits' for E format, but it's 'ndigits-1' for F
     *	        format.
     */

    SetPrecisionLimits(flags, k, &ndigits, &i, &ilim, &ilim1);
    SetPrecisionLimits(convType, k, &ndigits, &i, &ilim, &ilim1);

    /*
     * Try to do low-precision conversion in floating point rather than
     * resorting to expensive multiprecision arithmetic.
     */

    if (ilim >= 0 && ilim <= QUICK_MAX && !(flags & TCL_DD_NO_QUICK)) {
4369
4370
4371
4372
4373
4374
4375
4376

4377
4378
4379
4380
4381
4382
4383
4339
4340
4341
4342
4343
4344
4345

4346
4347
4348
4349
4350
4351
4352
4353







-
+







     *        side, and
     *   m- = (2**m2minus * 5**m5) / (2**s2 * 5**s5) is the limit on the low
     *        side.
     * We may need to increase s2 to put m2plus, m2minus, b2 over a common
     * denominator.
     */

    if (flags & TCL_DD_SHORTEST) {
    if (flags & TCL_DD_SHORTEN_FLAG) {
	int m2minus = b2;
	int m2plus;
	int m5 = b5;
	int len = i;

	/*
	 * Find the quantity i so that (2**i*5**b5)/(2**s2*5**s5) is 1/2 unit
4416
4417
4418
4419
4420
4421
4422
4423

4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442

4443
4444
4445
4446
4447
4448
4449
4450
4451

4452
4453
4454
4455
4456
4457
4458
4386
4387
4388
4389
4390
4391
4392

4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411

4412
4413
4414
4415
4416
4417
4418
4419
4420

4421
4422
4423
4424
4425
4426
4427
4428







-
+


















-
+








-
+







	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
	     * then all our intermediate calculations can be done using exact
	     * 64-bit arithmetic with no need for expensive multiprecision
	     * operations. (This will be true for all numbers in the range
	     * [1.0e-3 .. 1.0e+24]).
	     */

	    return ShorteningInt64Conversion(&d, bw, b2, b5, m2plus,
	    return ShorteningInt64Conversion(&d, convType, bw, b2, b5, m2plus,
		    m2minus, m5, s2, s5, k, len, ilim, ilim1, decpt, endPtr);
	} else if (s5 == 0) {
	    /*
	     * The denominator is a power of 2, so we can replace division by
	     * digit shifts. First we round up s2 to a multiple of MP_DIGIT_BIT,
	     * and adjust m2 and b2 accordingly. Then we launch into a version
	     * of the comparison that's specialized for the 'power of mp_digit
	     * in the denominator' case.
	     */

	    if (s2 % MP_DIGIT_BIT != 0) {
		int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT);

		b2 += delta;
		m2plus += delta;
		m2minus += delta;
		s2 += delta;
	    }
	    return ShorteningBignumConversionPowD(&d, bw, b2, b5,
	    return ShorteningBignumConversionPowD(&d, convType, bw, b2, b5,
		    m2plus, m2minus, m5, s2/MP_DIGIT_BIT, k, len, ilim, ilim1,
		    decpt, endPtr);
	} else {
	    /*
	     * Alas, there's no helpful special case; use full-up bignum
	     * arithmetic for the conversion.
	     */

	    return ShorteningBignumConversion(&d, bw, b2, m2plus,
	    return ShorteningBignumConversion(&d, convType, bw, b2, m2plus,
		    m2minus, s2, s5, k, len, ilim, ilim1, decpt, endPtr);
	}
    } else {
	/*
	 * Non-shortening conversion.
	 */

4472
4473
4474
4475
4476
4477
4478
4479

4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496

4497
4498
4499
4500
4501
4502
4503
4504
4505
4506

4507
4508
4509
4510
4511
4512
4513
4442
4443
4444
4445
4446
4447
4448

4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465

4466
4467
4468
4469
4470
4471
4472
4473
4474
4475

4476
4477
4478
4479
4480
4481
4482
4483







-
+
















-
+









-
+







	    /*
	     * If 10*2**s2*5**s5 == 2**(s2+1)+5**(s5+1) fits in a 64-bit word,
	     * then all our intermediate calculations can be done using exact
	     * 64-bit arithmetic with no need for expensive multiprecision
	     * operations.
	     */

	    return StrictInt64Conversion(bw, b2, b5, s2, s5, k,
	    return StrictInt64Conversion(&d, convType, bw, b2, b5, s2, s5, k,
		    len, ilim, ilim1, decpt, endPtr);
	} else if (s5 == 0) {
	    /*
	     * The denominator is a power of 2, so we can replace division by
	     * digit shifts. First we round up s2 to a multiple of MP_DIGIT_BIT,
	     * and adjust m2 and b2 accordingly. Then we launch into a version
	     * of the comparison that's specialized for the 'power of mp_digit
	     * in the denominator' case.
	     */

	    if (s2 % MP_DIGIT_BIT != 0) {
		int delta = MP_DIGIT_BIT - (s2 % MP_DIGIT_BIT);

		b2 += delta;
		s2 += delta;
	    }
	    return StrictBignumConversionPowD(bw, b2, b5,
	    return StrictBignumConversionPowD(&d, convType, bw, b2, b5,
		    s2/MP_DIGIT_BIT, k, len, ilim, ilim1, decpt, endPtr);
	} else {
	    /*
	     * There are no helpful special cases, but at least we know in
	     * advance how many digits we will convert. We can run the
	     * conversion in steps of DIGIT_GROUP digits, so as to have many
	     * fewer mp_int divisions.
	     */

	    return StrictBignumConversion(bw, b2, s2, s5, k,
	    return StrictBignumConversion(&d, convType, bw, b2, s2, s5, k,
		    len, ilim, ilim1, decpt, endPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560

4561
4562
4563
4564
4565
4566
4567
4507
4508
4509
4510
4511
4512
4513

4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528

4529
4530
4531
4532
4533
4534
4535
4536







-















-
+







    double d;
#ifdef IEEE_FLOATING_POINT
    union {
	double dv;
	Tcl_WideUInt iv;
    } bitwhack;
#endif
    mp_err err = MP_OKAY;
#if defined(__sgi) && defined(_COMPILER_VERSION)
    union fpc_csr mipsCR;

    mipsCR.fc_word = get_fpc_csr();
    mipsCR.fc_struct.flush = 0;
    set_fpc_csr(mipsCR.fc_word);
#endif

    /*
     * Initialize table of powers of 10 expressed as wide integers.
     */

    maxpow10_wide = (int)
	    floor(sizeof(Tcl_WideUInt) * CHAR_BIT * log(2.) / log(10.));
    pow10_wide = (Tcl_WideUInt *)
	    Tcl_Alloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
	    ckalloc((maxpow10_wide + 1) * sizeof(Tcl_WideUInt));
    u = 1;
    for (i = 0; i < maxpow10_wide; ++i) {
	pow10_wide[i] = u;
	u *= 10;
    }
    pow10_wide[i] = u;

4594
4595
4596
4597
4598
4599
4600
4601

4602
4603

4604
4605

4606
4607

4608
4609
4610


4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4563
4564
4565
4566
4567
4568
4569

4570
4571

4572
4573

4574
4575

4576
4577


4578
4579



4580
4581
4582
4583
4584
4585
4586







-
+

-
+

-
+

-
+

-
-
+
+
-
-
-







    }

    /*
     * Initialize a table of large powers of five.
     */

    for (i=0; i<9; ++i) {
	err = err || mp_init(pow5 + i);
	mp_init(pow5 + i);
    }
    mp_set_u64(pow5, 5);
    mp_set(pow5, 5);
    for (i=0; i<8; ++i) {
	err = err || mp_sqr(pow5+i, pow5+i+1);
	mp_sqr(pow5+i, pow5+i+1);
    }
    err = err || mp_init_u64(pow5_13, 1220703125);
    mp_init_set_int(pow5_13, 1220703125);
    for (i = 1; i < 5; ++i) {
	err = err || mp_init(pow5_13 + i);
	err = err || mp_sqr(pow5_13 + i - 1, pow5_13 + i);
	mp_init(pow5_13 + i);
	mp_sqr(pow5_13 + i - 1, pow5_13 + i);
    }
    if (err != MP_OKAY) {
	Tcl_Panic("out of memory");
    }

    /*
     * Determine the number of decimal digits to the left and right of the
     * decimal point in the largest and smallest double, the smallest double
     * that differs from zero, and the number of mp_digits needed to represent
     * the significand of a double.
4663
4664
4665
4666
4667
4668
4669
4670

4671
4672
4673
4674
4675
4676
4677
4629
4630
4631
4632
4633
4634
4635

4636
4637
4638
4639
4640
4641
4642
4643







-
+







 */

void
TclFinalizeDoubleConversion(void)
{
    int i;

    Tcl_Free(pow10_wide);
    ckfree((char *) pow10_wide);
    for (i=0; i<9; ++i) {
	mp_clear(pow5 + i);
    }
    for (i=0; i < 5; ++i) {
	mp_clear(pow5_13 + i);
    }
}
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
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







-
+



-
-















-
+

-
+





-
+
-
-
-
-
+
+

-
+


-
-
-




















-
+




-
-







 *----------------------------------------------------------------------
 */

int
Tcl_InitBignumFromDouble(
    Tcl_Interp *interp,		/* For error message. */
    double d,			/* Number to convert. */
    void *big)			/* Place to store the result. */
    mp_int *b)			/* Place to store the result. */
{
    double fract;
    int expt;
    mp_err err;
    mp_int *b = (mp_int *)big;

    /*
     * Infinite values can't convert to bignum.
     */

    if (TclIsInfinite(d)) {
	if (interp != NULL) {
	    const char *s = "integer value too large to represent";

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
	}
	return TCL_ERROR;
    }

    fract = frexp(d, &expt);
    fract = frexp(d,&expt);
    if (expt <= 0) {
	err = mp_init(b);
	mp_init(b);
	mp_zero(b);
    } else {
	Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);
	int shift = expt - mantBits;

	err = mp_init_i64(b, w);
	TclBNInitBignumFromWideInt(b, w);
	if (err != MP_OKAY) {
		/* just skip */
	} else if (shift < 0) {
	    err = mp_div_2d(b, -shift, b, NULL);
	if (shift < 0) {
	    mp_div_2d(b, -shift, b, NULL);
	} else if (shift > 0) {
	    err = mp_mul_2d(b, shift, b);
	    mp_mul_2d(b, shift, b);
	}
    }
    if (err != MP_OKAY) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclBignumToDouble --
 *
 *	Convert an arbitrary-precision integer to a native floating point
 *	number.
 *
 * Results:
 *	Returns the converted number. Sets errno to ERANGE if the number is
 *	too large to convert.
 *
 *----------------------------------------------------------------------
 */

double
TclBignumToDouble(
    const void *big)			/* Integer to convert. */
    mp_int *a)			/* Integer to convert. */
{
    mp_int b;
    int bits, shift, i, lsb;
    double r;
    mp_err err;
    const mp_int *a = (const mp_int *)big;


    /*
     * We need a 'mantBits'-bit significand.  Determine what shift will
     * give us that.
     */

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
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







-
+
-
-
-
-
+
+

-
+








-
-
+
+

-
+

-
+








-
+
-
-
-
-
+
+

-
+

-
+







-
-
-

-
+







     * in length.  If shift < 0, we will need to shift the significand right
     * by the requisite number of bits, and round it. If the '1-shift'
     * least significant bits are 0, but the 'shift'th bit is nonzero,
     * then the significand lies exactly between two values and must be
     * 'rounded to even'.
     */

    err = mp_init(&b);
    mp_init(&b);
    if (err != MP_OKAY) {
	/* just skip */
    } else if (shift == 0) {
	err = mp_copy(a, &b);
    if (shift == 0) {
	mp_copy(a, &b);
    } else if (shift > 0) {
	err = mp_mul_2d(a, shift, &b);
	mp_mul_2d(a, shift, &b);
    } else if (shift < 0) {
	lsb = mp_cnt_lsb(a);
	if (lsb == -1-shift) {

	    /*
	     * Round to even
	     */

	    err = mp_div_2d(a, -shift, &b, NULL);
	    if ((err == MP_OKAY) && mp_isodd(&b)) {
	    mp_div_2d(a, -shift, &b, NULL);
	    if (mp_isodd(&b)) {
		if (mp_isneg(&b)) {
		    err = mp_sub_d(&b, 1, &b);
		    mp_sub_d(&b, 1, &b);
		} else {
		    err = mp_add_d(&b, 1, &b);
		    mp_add_d(&b, 1, &b);
		}
	    }
	} else {

	    /*
	     * Ordinary rounding
	     */

	    err = mp_div_2d(a, -1-shift, &b, NULL);
	    mp_div_2d(a, -1-shift, &b, NULL);
	    if (err != MP_OKAY) {
		/* just skip */
	    } else if (mp_isneg(&b)) {
		err = mp_sub_d(&b, 1, &b);
	    if (mp_isneg(&b)) {
		mp_sub_d(&b, 1, &b);
	    } else {
		err = mp_add_d(&b, 1, &b);
		mp_add_d(&b, 1, &b);
	    }
	    err = mp_div_2d(&b, 1, &b, NULL);
	    mp_div_2d(&b, 1, &b, NULL);
	}
    }

    /*
     * Accumulate the result, one mp_digit at a time.
     */

    if (err != MP_OKAY) {
	return 0.0;
    }
    r = 0.0;
    for (i = b.used-1; i>=0; --i) {
    for (i=b.used-1 ; i>=0 ; --i) {
	r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
    }
    mp_clear(&b);

    /*
     * Scale the result to the correct number of bits.
     */
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
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







-
+



-
-

-
-
-
+
+
+









-
-
-
-
+
+


-
+
-
-
+
-



-
+

-
-
+
+
-
-
-







 *	Returns the floating point number.
 *
 *----------------------------------------------------------------------
 */

double
TclCeil(
    const void *big)			/* Integer to convert. */
    mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;
    mp_err err;
    const mp_int *a = (const mp_int *)big;

    err = mp_init(&b);
    if ((err == MP_OKAY) && mp_isneg(a)) {
	err = mp_neg(a, &b);
    mp_init(&b);
    if (mp_cmp_d(a, 0) == MP_LT) {
	mp_neg(a, &b);
	r = -TclFloor(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = HUGE_VAL;
	} else {
	    int i, exact = 1, shift = mantBits - bits;

	    if (err != MP_OKAY) {
		/* just skip */
	    } else if (shift > 0) {
		err = mp_mul_2d(a, shift, &b);
	    if (shift > 0) {
		mp_mul_2d(a, shift, &b);
	    } else if (shift < 0) {
		mp_int d;
		err = mp_init(&d);
		mp_init(&d);
		if (err == MP_OKAY) {
		    err = mp_div_2d(a, -shift, &b, &d);
		mp_div_2d(a, -shift, &b, &d);
		}
		exact = mp_iszero(&d);
		mp_clear(&d);
	    } else {
		err = mp_copy(a, &b);
		mp_copy(a, &b);
	    }
	    if ((err == MP_OKAY) && !exact) {
		err = mp_add_d(&b, 1, &b);
	    if (!exact) {
		mp_add_d(&b, 1, &b);
	    }
	    if (err != MP_OKAY) {
		return 0.0;
	    }
	    for (i=b.used-1 ; i>=0 ; --i) {
		r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
	    }
	    r = ldexp(r, bits - mantBits);
	}
    }
4943
4944
4945
4946
4947
4948
4949
4950

4951
4952
4953
4954
4955
4956
4957
4958
4959



4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970

4971
4972

4973
4974

4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
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







-
+



-
-

-
-
-
+
+
+










-
+

-
+

-
+
-
-
-







 *	Returns the floating point value.
 *
 *----------------------------------------------------------------------
 */

double
TclFloor(
    const void *big)			/* Integer to convert. */
    mp_int *a)			/* Integer to convert. */
{
    double r = 0.0;
    mp_int b;
    mp_err err;
    const mp_int *a = (const mp_int *)big;

    err = mp_init(&b);
    if ((err == MP_OKAY) && mp_isneg(a)) {
	err = mp_neg(a, &b);
    mp_init(&b);
    if (mp_cmp_d(a, 0) == MP_LT) {
	mp_neg(a, &b);
	r = -TclCeil(&b);
    } else {
	int bits = mp_count_bits(a);

	if (bits > DBL_MAX_EXP*log2FLT_RADIX) {
	    r = DBL_MAX;
	} else {
	    int i, shift = mantBits - bits;

	    if (shift > 0) {
		err = mp_mul_2d(a, shift, &b);
		mp_mul_2d(a, shift, &b);
	    } else if (shift < 0) {
		err = mp_div_2d(a, -shift, &b, NULL);
		mp_div_2d(a, -shift, &b, NULL);
	    } else {
		err = mp_copy(a, &b);
		mp_copy(a, &b);
	    }
	    if (err != MP_OKAY) {
		return 0.0;
	    }
	    for (i=b.used-1 ; i>=0 ; --i) {
		r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
	    }
	    r = ldexp(r, bits - mantBits);
	}
    }
5004
5005
5006
5007
5008
5009
5010
5011

5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028

5029
5030
5031
5032

5033
5034

5035
5036

5037
5038
5039
5040
5041
5042
5043
5044
5045
5046


5047
5048
5049
5050
5051
5052
5053
5054
4940
4941
4942
4943
4944
4945
4946

4947
4948
4949
4950
4951
4952
4953
4954

4955
4956
4957
4958
4959
4960
4961
4962

4963


4964

4965
4966

4967
4968

4969
4970
4971
4972
4973
4974
4975
4976



4977
4978

4979
4980
4981
4982
4983
4984
4985







-
+







-








-
+
-
-

-
+

-
+

-
+







-
-
-
+
+
-







 *	Stores the exponent of two in 'machexp'.
 *
 *----------------------------------------------------------------------
 */

static double
BignumToBiasedFrExp(
    const mp_int *a,		/* Integer to convert. */
    mp_int *a,		/* Integer to convert. */
    int *machexp)		/* Power of two. */
{
    mp_int b;
    int bits;
    int shift;
    int i;
    double r;
    mp_err err = MP_OKAY;

    /*
     * Determine how many bits we need, and extract that many from the input.
     * Round to nearest unit in the last place.
     */

    bits = mp_count_bits(a);
    shift = mantBits - 2 - bits;
    if (mp_init(&b)) {
    mp_init(&b);
	return 0.0;
    }
    if (shift > 0) {
	err = mp_mul_2d(a, shift, &b);
	mp_mul_2d(a, shift, &b);
    } else if (shift < 0) {
	err = mp_div_2d(a, -shift, &b, NULL);
	mp_div_2d(a, -shift, &b, NULL);
    } else {
	err = mp_copy(a, &b);
	mp_copy(a, &b);
    }

    /*
     * Accumulate the result, one mp_digit at a time.
     */

    r = 0.0;
    if (err == MP_OKAY) {
	for (i=b.used-1; i>=0; --i) {
	    r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
    for (i=b.used-1; i>=0; --i) {
	r = ldexp(r, MP_DIGIT_BIT) + b.dp[i];
	}
    }
    mp_clear(&b);

    /*
     * Return the result with the appropriate sign.
     */

5088
5089
5090
5091
5092
5093
5094
5095

5096
5097
5098
5099
5100
5101
5102
5019
5020
5021
5022
5023
5024
5025

5026
5027
5028
5029
5030
5031
5032
5033







-
+







    double retval = fraction;

    if (exponent > 0) {
	/*
	 * Multiply by 10**exponent.
	 */

	retval = frexp(retval * pow10vals[exponent & 0xF], &j);
	retval = frexp(retval * pow10vals[exponent&0xF], &j);
	expt += j;
	for (i=4; i<9; ++i) {
	    if (exponent & (1<<i)) {
		retval = frexp(retval * pow_10_2_n[i], &j);
		expt += j;
	    }
	}
5212
5213
5214
5215
5216
5217
5218
5219

5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5143
5144
5145
5146
5147
5148
5149

5150
5151
5152
5153
5154
5155
5156

5157
5158
5159
5160
5161
5162
5163







-
+






-







 * Nokia770Twiddle --
 *
 *	Transpose the two words of a number for Nokia 770 floating point
 *	handling.
 *
 *----------------------------------------------------------------------
 */
#ifdef IEEE_FLOATING_POINT

static Tcl_WideUInt
Nokia770Twiddle(
    Tcl_WideUInt w)		/* Number to transpose. */
{
    return (((w >> 32) & 0xFFFFFFFF) | (w << 32));
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclNokia770Doubles --
 *
 *	Transpose the two words of a number for Nokia 770 floating point

Changes to generic/tclStringObj.c.

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
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







-
+
-

-







-
+

-
+

-
+

-
+


-
-
-
-
-


-
-
+


-
-
+
+







-
+






-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+
+












-
+


-
+



-
+

-
+


-
-
+
+



-
+

-
+
-

-
-
-
-
+
+
+
-
+

-
-
+
-
-
+

-
-
-
-
+
+

+
-
+
+





-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+




-
-
+
-
-




-
+


+







 * Copyright (c) 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"
#include "tclTomMath.h"
#include "tommath.h"
#include "tclStringRep.h"

#include "assert.h"
/*
 * Prototypes for functions defined later in this file:
 */

static void		AppendPrintfToObjVA(Tcl_Obj *objPtr,
			    const char *format, va_list argList);
static void		AppendUnicodeToUnicodeRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t appendNumChars);
			    const Tcl_UniChar *unicode, int appendNumChars);
static void		AppendUnicodeToUtfRep(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
			    const Tcl_UniChar *unicode, int numChars);
static void		AppendUtfToUnicodeRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes);
			    const char *bytes, int numBytes);
static void		AppendUtfToUtfRep(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes);
			    const char *bytes, int numBytes);
static void		DupStringInternalRep(Tcl_Obj *objPtr,
			    Tcl_Obj *copyPtr);
static size_t		ExtendStringRepWithUnicode(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
			    const char *bytes, size_t numBytes,
			    size_t numAppendChars);
static void		FillUnicodeRep(Tcl_Obj *objPtr);
static void		FreeStringInternalRep(Tcl_Obj *objPtr);
static void		GrowStringBuffer(Tcl_Obj *objPtr, size_t needed, int flag);
static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, size_t needed);
static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, int needed);
static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		SetUnicodeObj(Tcl_Obj *objPtr,
			    const Tcl_UniChar *unicode, size_t numChars);
static size_t		UnicodeLength(const Tcl_UniChar *unicode);
			    const Tcl_UniChar *unicode, int numChars);
static int		UnicodeLength(const Tcl_UniChar *unicode);
static void		UpdateStringOfString(Tcl_Obj *objPtr);

/*
 * The structure below defines the string Tcl object type by means of
 * functions that can be invoked by generic object code.
 */

const Tcl_ObjType tclStringType = {
Tcl_ObjType tclStringType = {
    "string",			/* name */
    FreeStringInternalRep,	/* freeIntRepPro */
    DupStringInternalRep,	/* dupIntRepProc */
    UpdateStringOfString,	/* updateStringProc */
    SetStringFromAny		/* setFromAnyProc */
};


/*
 * The following structure is the internal rep for a String object. It keeps
 * track of how much memory has been used and how much has been allocated for
 * the Unicode and UTF string to enable growing and shrinking of the UTF and
 * Unicode reps of the String object with fewer mallocs. To optimize string
 * length and indexing operations, this structure also stores the number of
 * characters (same of UTF and Unicode!) once that value has been computed.
 *
 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct String {
    int numChars;		/* The number of chars in the string. -1 means
				 * this value has not been calculated. >= 0
				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    size_t allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    size_t uallocated;		/* The amount of space actually allocated for
				 * the Unicode string (minus 2 bytes for the
				 * termination char). */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[2];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'uallocated'
				 * field above. */
} String;

#define STRING_MAXCHARS \
	(1 + (int)(((size_t)UINT_MAX - sizeof(String))/sizeof(Tcl_UniChar)))
#define STRING_UALLOC(numChars)	\
	((numChars) * sizeof(Tcl_UniChar))
#define STRING_SIZE(ualloc) \
    ((unsigned) ((ualloc != 0) \
	? (sizeof(String) - sizeof(Tcl_UniChar) + (ualloc)) \
	: sizeof(String)))
#define stringCheckLimits(numChars) \
    if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
	Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
		STRING_MAXCHARS); \
    }
#define stringRealloc(ptr, numChars) \
	(String *) ckrealloc((char *) ptr, \
		(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
#define stringAttemptRealloc(ptr, numChars) \
	(String *) attemptckrealloc((char *) ptr, \
		(unsigned) STRING_SIZE(STRING_UALLOC(numChars)) )
#define GET_STRING(objPtr) \
	((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
	((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))

/*
 * TCL STRING GROWTH ALGORITHM
 *
 * When growing strings (during an append, for example), the following growth
 * algorithm is used:
 *
 *   Attempt to allocate 2 * (originalLength + appendLength)
 *   On failure:
 *	attempt to allocate originalLength + 2*appendLength + TCL_MIN_GROWTH
 *	attempt to allocate originalLength + 2*appendLength +
 *			TCL_GROWTH_MIN_ALLOC
 *
 * This algorithm allows very good performance, as it rapidly increases the
 * memory allocated for a given string, which minimizes the number of
 * reallocations that must be performed. However, using only the doubling
 * algorithm can lead to a significant waste of memory. In particular, it may
 * fail even when there is sufficient memory available to complete the append
 * request (but there is not 2*totalLength memory available). So when the
 * doubling fails (because there is not enough memory available), the
 * algorithm requests a smaller amount of memory, which is still enough to
 * cover the request, but which hopefully will be less than the total
 * available memory.
 *
 * The addition of TCL_MIN_GROWTH allows for efficient handling of very
 * The addition of TCL_GROWTH_MIN_ALLOC allows for efficient handling of very
 * small appends. Without this extra slush factor, a sequence of several small
 * appends would cause several memory allocations. As long as
 * TCL_MIN_GROWTH is a reasonable size, we can avoid that behavior.
 * TCL_GROWTH_MIN_ALLOC is a reasonable size, we can avoid that behavior.
 *
 * The growth algorithm can be tuned by adjusting the following parameters:
 *
 * TCL_MIN_GROWTH		Additional space, in bytes, to allocate when
 * TCL_GROWTH_MIN_ALLOC		Additional space, in bytes, to allocate when
 *				the double allocation has failed. Default is
 *				1024 (1 kilobyte).  See tclInt.h.
 *				1024 (1 kilobyte).
 */

#ifndef TCL_MIN_UNICHAR_GROWTH
#define TCL_MIN_UNICHAR_GROWTH	TCL_MIN_GROWTH/sizeof(Tcl_UniChar)
#ifndef TCL_GROWTH_MIN_ALLOC
#define TCL_GROWTH_MIN_ALLOC	1024
#endif

static void
GrowStringBuffer(
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    size_t needed,
    int needed)
    int flag)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->allocated
    /* Pre-conditions:
     *  objPtr->typePtr == &tclStringType
     *  STRING_UALLOC(needed) > stringPtr->uallocated
     *	flag || objPtr->bytes != NULL
     *  needed < STRING_MAXCHARS
     */

    String *stringPtr = GET_STRING(objPtr);
    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
    char *ptr = NULL;
    size_t attempt;
    int attempt;

    if (objPtr->bytes == &tclEmptyString) {
	objPtr->bytes = NULL;
    }
    if (flag == 0 || stringPtr->allocated > 0) {
    if (stringPtr->uallocated > 0) {
	/* Subsequent appends - apply the growth algorithm. */
	attempt = 2 * needed;
	if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
	ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1);
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    unsigned int limit = STRING_MAXCHARS - needed;
	    size_t limit = INT_MAX - needed;
	    size_t extra = needed - objPtr->length + TCL_MIN_GROWTH;
	    size_t growth = (extra > limit) ? limit : extra;

	    attempt = needed + growth;
	    ptr = (char *)Tcl_AttemptRealloc(objPtr->bytes, attempt + 1);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	 */

	attempt = needed;
	ptr = (char *)Tcl_Realloc(objPtr->bytes, attempt + 1);
    }
    objPtr->bytes = ptr;
    stringPtr->allocated = attempt;
}

static void
GrowUnicodeBuffer(
    Tcl_Obj *objPtr,
    size_t needed)
{
    /*
     * Pre-conditions:
     *	objPtr->typePtr == &tclStringType
     *	needed > stringPtr->maxChars
     */

    String *ptr = NULL, *stringPtr = GET_STRING(objPtr);
    size_t attempt;

    if (stringPtr->maxChars > 0) {
	/*
	 * Subsequent appends - apply the growth algorithm.
	 */

	attempt = 2 * needed;
	ptr = stringAttemptRealloc(stringPtr, attempt);
	if (ptr == NULL) {
	    /*
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for attempt.
	     */

	    size_t extra = needed - stringPtr->numChars
		    + TCL_MIN_UNICHAR_GROWTH;

	    attempt = needed + extra;
	    unsigned int extra = needed - stringPtr->numChars
		    + TCL_GROWTH_MIN_ALLOC/sizeof(Tcl_UniChar);
	    int growth = (int) ((extra > limit) ? limit : extra);
	    attempt = needed + growth;
	    ptr = stringAttemptRealloc(stringPtr, attempt);
	}
    }
    if (ptr == NULL) {
	/*
	 * First allocation - just big enough; or last chance fallback.
	/* First allocation - just big enough; or last chance fallback. */
	 */

	attempt = needed;
	ptr = stringRealloc(stringPtr, attempt);
    }
    stringPtr = ptr;
    stringPtr->maxChars = attempt;
    stringPtr->uallocated = STRING_UALLOC(attempt);
    SET_STRING(objPtr, stringPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_NewStringObj --
 *
 *	This function is normally called when not debugging: i.e., when
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
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







-
+











-
-
-
+
+
+
+

-
+

-
+








#ifdef TCL_MEM_DEBUG
#undef Tcl_NewStringObj
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length)			/* The number of bytes to copy from "bytes"
    int length)			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
{
    return Tcl_DbNewStringObj(bytes, length, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_NewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length)		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
    int length)			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclNewStringObj(objPtr, bytes, length);
    return objPtr;
}
#endif /* TCL_MEM_DEBUG */

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
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







-
-
-
+
+
+
+





-
+

-
+











-
-
-
-
-
+
+
+
+
+
+
+
+







 */

#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
    int length,			/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    Tcl_Obj *objPtr;
    register Tcl_Obj *objPtr;

    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclDbNewObj(objPtr, file, line);
    TclInitStringRep(objPtr, bytes, length);
    return objPtr;
}
#else /* if not TCL_MEM_DEBUG */
Tcl_Obj *
Tcl_DbNewStringObj(
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the new object. */
    size_t length,		/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If -1,
				 * use bytes up to the first NUL byte. */
    TCL_UNUSED(const char *) /*file*/,
    TCL_UNUSED(int) /*line*/)
    register int length,	/* The number of bytes to copy from "bytes"
				 * when initializing the new object. If
				 * negative, use bytes up to the first NUL
				 * byte. */
    const char *file,		/* The name of the source file calling this
				 * function; used for debugging. */
    int line)			/* Line number in the source file; used for
				 * debugging. */
{
    return Tcl_NewStringObj(bytes, length);
}
#endif /* TCL_MEM_DEBUG */

/*
 *---------------------------------------------------------------------------
358
359
360
361
362
363
364
365

366
367
368
369
370
371
372
360
361
362
363
364
365
366

367
368
369
370
371
372
373
374







-
+







 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_NewUnicodeObj(
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * new object. */
    size_t numChars)		/* Number of characters in the unicode
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
    return objPtr;
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
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
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
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
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
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







-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-


-
+
+


-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
+
+
+
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+
+
+

-
+
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
-
-

-
+







-
-
+
+
-










-
+



-
+

+

-
+
+
+

+
-
+
-
-
-
+
+
+

-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
+
+
+
+

-
-
-
+
+


+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+


-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * Side effects:
 *	Frees old internal rep. Allocates memory for new "String" internal
 *	rep.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_GetCharLength(
    Tcl_Obj *objPtr)		/* The String object to get the num chars
				 * of. */
{
    String *stringPtr;
    size_t numChars = 0;

    /*
     * Quick, no-shimmer return for short string reps.
     */

    if ((objPtr->bytes) && (objPtr->length < 2)) {
	/* 0 bytes -> 0 chars; 1 byte -> 1 char */
	return objPtr->length;
    }

    /*
     * Optimize the case where we're really dealing with a bytearray object;
     * we don't need to convert to a string to perform the get-length operation.
     *
     * Starting in Tcl 8.7, we check for a "pure" bytearray, because the
     * machinery behind that test is using a proper bytearray ObjType.  We
     * could also compute length of an improper bytearray without shimmering
     * but there's no value in that. We *want* to shimmer an improper bytearray
     * because improper bytearrays have worthless internal reps.
     */

    if (TclIsPureByteArray(objPtr)) {
	(void) TclGetByteArrayFromObj(objPtr, &numChars);
	return numChars;
    }

    /*
     * OK, need to work with the object as a string.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);
    numChars = stringPtr->numChars;

    /*
     * If numChars is unknown, compute it.
     * If numChars is unknown, then calculate the number of characaters while
     * populating the Unicode string.
     */

    if (numChars == TCL_INDEX_NONE) {
	TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
	stringPtr->numChars = numChars;
    }
    if (stringPtr->numChars == -1) {
	register int i = objPtr->length;
	register unsigned char *str = (unsigned char *) objPtr->bytes;

    return numChars;
}

/*
	/*
 *----------------------------------------------------------------------
 *
 * TclCheckEmptyString --
	 * This is a speed sensitive function, so run specially over the
	 * string to count continuous ascii characters before resorting to the
	 * Tcl_NumUtfChars call. This is a long form of:
 *
 *	Determine whether the string value of an object is or would be the
 *	empty string, without generating a string representation.
 *
	 stringPtr->numChars = Tcl_NumUtfChars(objPtr->bytes,objPtr->length);
	 *
 * Results:
 *	Returns 1 if empty, 0 if not, and -1 if unknown.
 *
	 * TODO: Consider macro-izing this.
	 */
 * Side effects:
 *	None.
 *

 *----------------------------------------------------------------------
 */
int
TclCheckEmptyString(
    Tcl_Obj *objPtr)
	while (i && (*str < 0xC0)) {
	    i--;
	    str++;
	}
	stringPtr->numChars = objPtr->length - i;
{
    int length = -1;

	if (i) {
	    stringPtr->numChars += Tcl_NumUtfChars(objPtr->bytes
		    + (objPtr->length - i), i);
	}
    if (objPtr->bytes == &tclEmptyString) {
	return TCL_EMPTYSTRING_YES;
    }

	if (stringPtr->numChars == objPtr->length) {
	    /*
	     * Since we've just calculated the number of chars, and all UTF
	     * chars are 1-byte long, we don't need to store the unicode
	     * string.
	     */

    if (TclListObjIsCanonical(objPtr)) {
	    stringPtr->hasUnicode = 0;
	Tcl_ListObjLength(NULL, objPtr, &length);
	return length == 0;
    }
	} else {
	    /*
	     * Since we've just calucalated the number of chars, and not all
	     * UTF chars are 1-byte long, go ahead and populate the unicode
	     * string.
	     */

	    FillUnicodeRep(objPtr);

    if (TclIsPureDict(objPtr)) {
	Tcl_DictObjSize(NULL, objPtr, &length);
	return length == 0;
    }

	    /*
	     * We need to fetch the pointer again because we have just
	     * reallocated the structure to make room for the Unicode data.
	     */

	    stringPtr = GET_STRING(objPtr);
	}
    if (objPtr->bytes == NULL) {
	return TCL_EMPTYSTRING_UNKNOWN;
    }
    return objPtr->length == 0;
    return stringPtr->numChars;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUniChar --
 *
 *	Get the index'th Unicode character from the String object. If index
 *	is out of range or it references a low surrogate preceded by a high
 *	Get the index'th Unicode character from the String object. The index
 *	is assumed to be in the appropriate range.
 *	surrogate, the result = -1;
 *
 * Results:
 *	Returns the index'th Unicode character in the Object.
 *
 * Side effects:
 *	Fills unichar with the index'th Unicode character.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniChar
Tcl_GetUniChar(
    Tcl_Obj *objPtr,		/* The object to get the Unicode charater
				 * from. */
    size_t index)		/* Get the index'th Unicode character. */
    int index)			/* Get the index'th Unicode character. */
{
    Tcl_UniChar unichar;
    String *stringPtr;
    int ch;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->numChars == -1) {
    /*
	/*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the indexing operation.
     */
	 * We haven't yet calculated the length, so we don't have the Unicode
	 * str. We need to know the number of chars before we can do indexing.
	 */

    if (TclIsPureByteArray(objPtr)) {
	size_t length = 0;
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length);
	if (index >= length) {
		return -1;
	}

	Tcl_GetCharLength(objPtr);
	return bytes[index];
    }


    /*
     * OK, need to work with the object as a string.
     */
	/*
	 * We need to fetch the pointer again because we may have just
	 * reallocated the structure.
	 */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

	stringPtr = GET_STRING(objPtr);
    }
    if (stringPtr->hasUnicode == 0) {
	/*
	 * All of the characters in the Utf string are 1 byte chars, so we
	 * don't store the unicode char. We get the Utf string and convert the
	 * index'th byte to a Unicode character.
	 */
	 * If numChars is unknown, compute it.
	 */

	unichar = (Tcl_UniChar) objPtr->bytes[index];
    } else {
	unichar = stringPtr->unicode[index];
    }
    return unichar;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicode --
 *
 *	Get the Unicode form of the String object. If the object is not
 *	already a String object, it will be converted to one. If the String
 *	object does not have a Unicode rep, then one is create from the UTF
 *	string format.
 *
 * Results:
 *	Returns a pointer to the object's internal Unicode string.
 *
 * Side effects:
 *	Converts the object to have the String internal rep.
 *
 *----------------------------------------------------------------------
 */

Tcl_UniChar *
Tcl_GetUnicode(
    Tcl_Obj *objPtr)		/* The object to find the unicode string
				 * for. */
{
	if (stringPtr->numChars == TCL_INDEX_NONE) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
	if (stringPtr->numChars == objPtr->length) {
	    return (Tcl_UniChar) objPtr->bytes[index];
	}
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
	/*
	 * We haven't yet calculated the length, or all of the characters in
	 * the Utf string are 1 byte chars (so we didn't store the unicode
	 * str). Since this function must return a unicode string, and one has
	 * not yet been stored, force the Unicode to be calculated and stored
	 * now.
	 */

	FillUnicodeRep(objPtr);

	/*
	 * We need to fetch the pointer again because we have just reallocated
	 * the structure to make room for the Unicode data.
	 */

	stringPtr = GET_STRING(objPtr);
    }

    if (index >= stringPtr->numChars) {
	return -1;
    }
    ch = stringPtr->unicode[index];
    return stringPtr->unicode;
#if TCL_UTF_MAX <= 3
    /* See: bug [11ae2be95dac9417] */
    if ((ch & 0xF800) == 0xD800) {
	if (ch & 0x400) {
	    if ((index > 0)
		    && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
		ch = -1; /* low surrogate preceded by high surrogate */
	    }
	} else if ((++index < stringPtr->numChars)
		&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
	    /* high surrogate followed by low surrogate */
	    ch = (((ch & 0x3FF) << 10) |
			(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
	}
    }
#endif
    return ch;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetUnicodeFromObj --
 *
598
599
600
601
602
603
604








605

606






607
608
609
610
611
612
613
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
618
619
620
621
622







+
+
+
+
+
+
+
+
-
+

+
+
+
+
+
+







				 * NULL, no length is stored. */
{
    String *stringPtr;

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
	/*
	 * We haven't yet calculated the length, or all of the characters in
	 * the Utf string are 1 byte chars (so we didn't store the unicode
	 * str). Since this function must return a unicode string, and one has
	 * not yet been stored, force the Unicode to be calculated and stored
	 * now.
	 */
    if (stringPtr->hasUnicode == 0) {

	FillUnicodeRep(objPtr);

	/*
	 * We need to fetch the pointer again because we have just reallocated
	 * the structure to make room for the Unicode data.
	 */

	stringPtr = GET_STRING(objPtr);
    }

    if (lengthPtr != NULL) {
	*lengthPtr = stringPtr->numChars;
    }
    return stringPtr->unicode;
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
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
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
686
687



688
689
690


691














692
693
694







695
696
697
698
699
700
701
702







-
-
+
+



-

-
-
-
+
+
+
-
-
-
-
-
+
+
-
-
-
+
+
+

-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+

-
-
-
+
+
-
-
-
-

-
-
-
+
+
+
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+

-
-
-
+
+
+
+

-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

-
-
-
-
-
-
-
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_GetRange(
    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
    size_t first,			/* First index of the range. */
    size_t last)			/* Last index of the range. */
    int first,			/* First index of the range. */
    int last)			/* Last index of the range. */
{
    Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
    String *stringPtr;
    size_t length = 0;

    if (first == TCL_INDEX_NONE) {
	first = TCL_INDEX_START;
    }
    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (last + 2 <= first + 1) {
	return Tcl_NewObj();
    }

    /*
    if (stringPtr->numChars == -1) {
	/*
     * Optimize the case where we're really dealing with a bytearray object
     * we don't need to convert to a string to perform the substring operation.
     */
	 * We haven't yet calculated the length, so we don't have the Unicode
	 * str. We need to know the number of chars before we can do indexing.
	 */

    if (TclIsPureByteArray(objPtr)) {
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &length);

	Tcl_GetCharLength(objPtr);
	if (last >= length) {
	    last = length - 1;
	}

	if (last < first) {
	    return Tcl_NewObj();
	}
	return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
    }

    /*
     * OK, need to work with the object as a string.
     */
	/*
	 * We need to fetch the pointer again because we may have just
	 * reallocated the structure.
	 */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

	stringPtr = GET_STRING(objPtr);
    }
    if (stringPtr->hasUnicode == 0) {
	/*
	 * If numChars is unknown, compute it.
	 */

	if (stringPtr->numChars == TCL_INDEX_NONE) {
	    TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
	}
    if (objPtr->bytes && (stringPtr->numChars == objPtr->length)) {
	char *str = TclGetString(objPtr);

	if (stringPtr->numChars == objPtr->length) {
	    if (last >= stringPtr->numChars) {
		last = stringPtr->numChars - 1;
	    }
	/*
	 * All of the characters in the Utf string are 1 byte chars, so we
	 * don't store the unicode char. Create a new string object containing
	 * the specified range of chars.
	 */

	    if (last < first) {
		return Tcl_NewObj();
	    }
	    newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
	newObjPtr = Tcl_NewStringObj(&str[first], last-first+1);

	    /*
	     * Since we know the char length of the result, store it.
	     */
	/*
	 * Since we know the new string only has 1-byte chars, we can set it's
	 * numChars field.
	 */

	    SetStringFromAny(NULL, newObjPtr);
	    stringPtr = GET_STRING(newObjPtr);
	    stringPtr->numChars = newObjPtr->length;
	SetStringFromAny(NULL, newObjPtr);
	stringPtr = GET_STRING(newObjPtr);
	stringPtr->numChars = last-first+1;
	    return newObjPtr;
	}
    } else {
	FillUnicodeRep(objPtr);
	stringPtr = GET_STRING(objPtr);
    }
    if (last > stringPtr->numChars) {
	last = stringPtr->numChars;
    }
    if (last < first) {
	return Tcl_NewObj();
    }
#if TCL_UTF_MAX <= 3
    /* See: bug [11ae2be95dac9417] */
    if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
	++first;
	newObjPtr = Tcl_NewUnicodeObj(stringPtr->unicode + first,
		last-first+1);
    }
    if ((last + 2 < stringPtr->numChars + 1)
	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
	++last;
    }
#endif
    return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
    return newObjPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetStringObj --
 *
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
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







-
+


-
-
+
+











+







-
+







 *	representations are freed and the object's type is set NULL.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetStringObj(
    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
    register Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
    const char *bytes,		/* Points to the first of the length bytes
				 * used to initialize the object. */
    size_t length)		/* The number of bytes to copy from "bytes"
				 * when initializing the object. If -1,
    register int length)	/* The number of bytes to copy from "bytes"
				 * when initializing the object. If negative,
				 * use bytes up to the first NUL byte.*/
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetStringObj");
    }

    /*
     * Set the type to NULL and free any internal rep for the old type.
     */

    TclFreeIntRep(objPtr);
    objPtr->typePtr = NULL;

    /*
     * Free any old string rep, then set the string rep to a copy of the
     * length bytes starting at "bytes".
     */

    TclInvalidateStringRep(objPtr);
    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	length = (bytes? strlen(bytes) : 0);
    }
    TclInitStringRep(objPtr, bytes, length);
}

/*
 *----------------------------------------------------------------------
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
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







-
+

-
+





+
+
+
+
+
+
+
+



-
+
-
-
-
+
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+

+
+
+
+
+
-
+
+





-
+


+
+
+
+
+
+
+
-
+


-
+

+
+


-
+


-

-
-
+
+
-
-
-
-







 *	representation is changed to "expendable string".
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
    register Tcl_Obj *objPtr,	/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
    register int length)	/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (length < 0) {
	/*
	 * Setting to a negative length is nonsense.  This is probably the
	 * result of overflowing the signed integer range.
	 */
	Tcl_Panic("Tcl_SetObjLength: negative length requested: "
		"%d (integer overflow?)", length);
    }
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetObjLength");
    }

    SetStringFromAny(NULL, objPtr);
    if (objPtr->bytes && objPtr->length == length) {
	return;
    }


    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (objPtr->bytes != NULL) {
	/*
	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*
	     * Need to enlarge the buffer.
	     */
	    if (objPtr->bytes == &tclEmptyString) {
		objPtr->bytes = (char *)Tcl_Alloc(length + 1);
	    } else {
		objPtr->bytes = (char *)Tcl_Realloc(objPtr->bytes, length + 1);
	    }
	    stringPtr->allocated = length;
	}
    /*
     * Check that we're not extending a pure unicode string.
     */

    if ((size_t)length > stringPtr->allocated &&
	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
	/*
	 * Not enough space in current string. Reallocate the string space and
	 * free the old string.
	 */

	if (objPtr->bytes != tclEmptyStringRep) {
	    objPtr->bytes = ckrealloc((char *) objPtr->bytes,
		    (unsigned) (length + 1));
	} else {
	    char *newBytes = ckalloc((unsigned) (length+1));

	    if (objPtr->bytes != NULL && objPtr->length != 0) {
		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
		TclInvalidateStringRep(objPtr);
	    }
	    objPtr->bytes = newBytes;
	}
	stringPtr->allocated = length;

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->hasUnicode = 0;
    }

    if (objPtr->bytes != NULL) {
	objPtr->length = length;
	if (objPtr->bytes != tclEmptyStringRep) {
	    /*
	     * Ensure the string is NUL-terminated.
	     */

	objPtr->bytes[length] = 0;
	    objPtr->bytes[length] = 0;
	}

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	size_t uallocated = STRING_UALLOC(length);

	stringCheckLimits(length);
	if (length > stringPtr->maxChars) {
	if (uallocated > stringPtr->uallocated) {
	    stringPtr = stringRealloc(stringPtr, length);
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	    stringPtr->uallocated = uallocated;
	}
	stringPtr->numChars = length;
	stringPtr->hasUnicode = (length > 0);

	/*
	 * Mark the new end of the unicode string
	 * Ensure the string is NUL-terminated.
	 */

	stringPtr->numChars = length;
	stringPtr->unicode[length] = 0;
	stringPtr->hasUnicode = 1;

	stringPtr->allocated = 0;
	objPtr->length = 0;
	/*
	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
	 * the string rep.
	 */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AttemptSetObjLength --
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
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







-
+

-
+





+
+
+
+
+
+
+



-
+
-
-
+
-
-


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
-
+
+
+
-
-
-
-
+
+
-



+
+
+
+
+
-
-
+
+
-

+
+
+
+
+
+
+
+

+
+
+
+
+
-
+
+





-
+






+
-
+
+
+
+
+





-
+

+
+


-
+



-
-
-
+
+
-
-
-
-







 *	representation is changed to "expendable string".
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AttemptSetObjLength(
    Tcl_Obj *objPtr,		/* Pointer to object. This object must not
    register Tcl_Obj *objPtr,	/* Pointer to object. This object must not
				 * currently be shared. */
    size_t length)		/* Number of bytes desired for string
    register int length)	/* Number of bytes desired for string
				 * representation of object, not including
				 * terminating null byte. */
{
    String *stringPtr;

    if (length < 0) {
	/*
	 * Setting to a negative length is nonsense.  This is probably the
	 * result of overflowing the signed integer range.
	 */
	return 0;
    }
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AttemptSetObjLength");
    }
    if (objPtr->bytes && objPtr->length == length) {
    SetStringFromAny(NULL, objPtr);
	return 1;
    }


    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (objPtr->bytes != NULL) {
	/*
	 * Change length of an existing string rep.
	 */
	if (length > stringPtr->allocated) {
	    /*
	     * Need to enlarge the buffer.
	     */
    /*
     * Check that we're not extending a pure unicode string.
     */

    if (length > (int) stringPtr->allocated &&
	    (objPtr->bytes != NULL || stringPtr->hasUnicode == 0)) {
	char *newBytes;

	/*
	 * Not enough space in current string. Reallocate the string space and
	 * free the old string.
	 */

	if (objPtr->bytes != tclEmptyStringRep) {
	    newBytes = attemptckrealloc(objPtr->bytes,
		    (unsigned)(length + 1));
	    char *newBytes;

	    if (newBytes == NULL) {
		return 0;
	    }
	    if (objPtr->bytes == &tclEmptyString) {
		newBytes = (char *)Tcl_AttemptAlloc(length + 1);
	    } else {
		newBytes = (char *)Tcl_AttemptRealloc(objPtr->bytes, length + 1);
	} else {
	    newBytes = attemptckalloc((unsigned) (length + 1));
	    }
	    if (newBytes == NULL) {
		return 0;
	    }
	    if (objPtr->bytes != NULL && objPtr->length != 0) {
		memcpy(newBytes, objPtr->bytes, (size_t) objPtr->length);
		TclInvalidateStringRep(objPtr);
	    }
	}
	    objPtr->bytes = newBytes;
	    stringPtr->allocated = length;
	objPtr->bytes = newBytes;
	stringPtr->allocated = length;
	}

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->hasUnicode = 0;
    }

    if (objPtr->bytes != NULL) {
	objPtr->length = length;
	if (objPtr->bytes != tclEmptyStringRep) {
	    /*
	     * Ensure the string is NULL-terminated.
	     */

	objPtr->bytes[length] = 0;
	    objPtr->bytes[length] = 0;
	}

	/*
	 * Invalidate the unicode data.
	 */

	stringPtr->numChars = TCL_INDEX_NONE;
	stringPtr->numChars = -1;
	stringPtr->hasUnicode = 0;
    } else {
	/*
	 * Changing length of pure unicode string.
	 */

	size_t uallocated = STRING_UALLOC(length);
	if (length > stringPtr->maxChars) {
	if (length > STRING_MAXCHARS) {
	    return 0;
	}

	if (uallocated > stringPtr->uallocated) {
	    stringPtr = stringAttemptRealloc(stringPtr, length);
	    if (stringPtr == NULL) {
		return 0;
	    }
	    SET_STRING(objPtr, stringPtr);
	    stringPtr->maxChars = length;
	    stringPtr->uallocated = uallocated;
	}
	stringPtr->numChars = length;
	stringPtr->hasUnicode = (length > 0);

	/*
	 * Mark the new end of the unicode string.
	 * Ensure the string is NUL-terminated.
	 */

	stringPtr->unicode[length] = 0;
	stringPtr->numChars = length;
	stringPtr->hasUnicode = 1;

	stringPtr->allocated = 0;
	objPtr->length = 0;
	/*
	 * Can only get here when objPtr->bytes == NULL. No need to invalidate
	 * the string rep.
	 */
    }
    return 1;
}

/*
 *---------------------------------------------------------------------------
 *
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
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







-
+









-
+



-
+


-
+



+








-
+



+

-
+







-
-
-
+
+
+

-
-
+
+
+
+
+

-
-


+
-
+







 */

void
Tcl_SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    size_t numChars)		/* Number of characters in the unicode
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj");
    }
    TclFreeIntRep(objPtr);
    SetUnicodeObj(objPtr, unicode, numChars);
}

static size_t
static int
UnicodeLength(
    const Tcl_UniChar *unicode)
{
    size_t numChars = 0;
    int numChars = 0;

    if (unicode) {
	while ((numChars != TCL_INDEX_NONE) && (unicode[numChars] != 0)) {
	while (numChars >= 0 && unicode[numChars] != 0) {
	    numChars++;
	}
    }
    stringCheckLimits(numChars);
    return numChars;
}

static void
SetUnicodeObj(
    Tcl_Obj *objPtr,		/* The object to set the string of. */
    const Tcl_UniChar *unicode,	/* The unicode string used to initialize the
				 * object. */
    size_t numChars)		/* Number of characters in the unicode
    int numChars)		/* Number of characters in the unicode
				 * string. */
{
    String *stringPtr;
    size_t uallocated;

    if (numChars == TCL_INDEX_NONE) {
    if (numChars < 0) {
	numChars = UnicodeLength(unicode);
    }

    /*
     * Allocate enough space for the String structure + Unicode string.
     */

    stringPtr = stringAlloc(numChars);
    SET_STRING(objPtr, stringPtr);
    objPtr->typePtr = &tclStringType;
    stringCheckLimits(numChars);
    uallocated = STRING_UALLOC(numChars);
    stringPtr = (String *) ckalloc(STRING_SIZE(uallocated));

    stringPtr->maxChars = numChars;
    memcpy(stringPtr->unicode, unicode, numChars * sizeof(Tcl_UniChar));
    stringPtr->numChars = numChars;
    stringPtr->uallocated = uallocated;
    stringPtr->hasUnicode = (numChars > 0);
    stringPtr->allocated = 0;
    memcpy(stringPtr->unicode, unicode, uallocated);
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->hasUnicode = 1;

    TclInvalidateStringRep(objPtr);
    objPtr->typePtr = &tclStringType;
    stringPtr->allocated = 0;
    SET_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendLimitedToObj --
 *
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
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







-
+


-
-
-
-
+
+
+
+






-
-
+
+

-
+







 *	objPtr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendLimitedToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    size_t length,		/* The number of bytes available to be
				 * appended from "bytes". If -1, then
				 * all bytes up to a NUL byte are available. */
    size_t limit,		/* The maximum number of bytes to append to
    register int length,	/* The number of bytes available to be
				 * appended from "bytes". If < 0, then all
				 * bytes up to a NUL byte are available. */
    register int limit,		/* The maximum number of bytes to append to
				 * the object. */
    const char *ellipsis)	/* Ellipsis marker string, appended to the
				 * object to indicate not all available bytes
				 * at "bytes" were appended. */
{
    String *stringPtr;
    size_t toCopy = 0;
    size_t eLen = 0;
    int toCopy = 0;
    int eLen = 0;

    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	length = (bytes ? strlen(bytes) : 0);
    }
    if (length == 0) {
	return;
    }
    if (limit <= 0) {
	return;
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
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







-
-
+










-
+








    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendLimitedToObj");
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) {
    if (stringPtr->hasUnicode != 0) {
	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
    } else {
	AppendUtfToUtfRep(objPtr, bytes, toCopy);
    }

    if (length <= limit) {
	return;
    }

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode && (stringPtr->numChars+1) > 1) {
    if (stringPtr->hasUnicode != 0) {
	AppendUtfToUnicodeRep(objPtr, ellipsis, eLen);
    } else {
	AppendUtfToUtfRep(objPtr, ellipsis, eLen);
    }
}

/*
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
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







-
+


-
-
+
+


-
+





-
+














-
-
+
+


-
+




-
+















-
+







 *	objPtr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
    const char *bytes,		/* Points to the bytes to append to the
				 * object. */
    size_t length)		/* The number of bytes to append from "bytes".
				 * If -1, then append all bytes up to NUL
    register int length)	/* The number of bytes to append from "bytes".
				 * If < 0, then append all bytes up to NUL
				 * byte. */
{
    Tcl_AppendLimitedToObj(objPtr, bytes, length, TCL_INDEX_NONE, NULL);
    Tcl_AppendLimitedToObj(objPtr, bytes, length, INT_MAX, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclAppendUnicodeToObj --
 * Tcl_AppendUnicodeToObj --
 *
 *	This function appends a Unicode string to an object in the most
 *	efficient manner possible. Length must be >= 0.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Invalidates the string rep and creates a new Unicode string.
 *
 *----------------------------------------------------------------------
 */

void
TclAppendUnicodeToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
Tcl_AppendUnicodeToObj(
    register Tcl_Obj *objPtr,	/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* The unicode string to append to the
				 * object. */
    size_t length)		/* Number of chars in "unicode". */
    int length)			/* Number of chars in "unicode". */
{
    String *stringPtr;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "TclAppendUnicodeToObj");
	Tcl_Panic("%s called with shared object", "Tcl_AppendUnicodeToObj");
    }

    if (length == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * If objPtr has a valid Unicode rep, then append the "unicode" to the
     * objPtr's Unicode rep, otherwise the UTF conversion of "unicode" to
     * objPtr's string rep.
     */

    if (stringPtr->hasUnicode) {
    if (stringPtr->hasUnicode != 0) {
	AppendUnicodeToUnicodeRep(objPtr, unicode, length);
    } else {
	AppendUnicodeToUtfRep(objPtr, unicode, length);
    }
}

/*
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
1348
1349
1350
1351

1352
1353
1354
1355






1356
1357
1358
1359
1360
1361
1362



1363
1364
1365
1366
1367
1368
1369
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
1348







-
+
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-






+
-
+




-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+















+

-
-
-
+
+
+
+
+
+
-




-
-
+
+
+








void
Tcl_AppendObjToObj(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    Tcl_Obj *appendObjPtr)	/* Object to append. */
{
    String *stringPtr;
    size_t length = 0, numChars;
    int length, numChars, allOneByteChars;
    size_t appendNumChars = TCL_INDEX_NONE;
    const char *bytes;
    char *bytes;

    /*
     * Special case: second object is standard-empty is fast case. We know
     * that appending nothing to anything leaves that starting anything...
     */

    if (appendObjPtr->bytes == &tclEmptyString) {
	return;
    }

    /*
     * Handle append of one bytearray object to another as a special case.
     * Note that we only do this when the objects are pure so that the
     * bytearray faithfully represent the true value; Otherwise appending the
     * byte arrays together could lose information;
     */

    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
	    && TclIsPureByteArray(appendObjPtr)) {
	/*
	 * You might expect the code here to be
	 *
	 *  bytes = TclGetByteArrayFromObj(appendObjPtr, &length);
	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
	 *
	 * and essentially all of the time that would be fine. However, it
	 * would run into trouble in the case where objPtr and appendObjPtr
	 * point to the same thing. That may never be a good idea. It seems to
	 * violate Copy On Write, and we don't have any tests for the
	 * situation, since making any Tcl commands that call
	 * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
	 * Write!). For the sake of extensions that go off into that realm,
	 * though, here's a more complex approach that can handle all the
	 * cases.
	 *
	 * First, get the lengths.
	 */

	size_t lengthSrc = 0;

	(void) TclGetByteArrayFromObj(objPtr, &length);
	(void) TclGetByteArrayFromObj(appendObjPtr, &lengthSrc);

	/*
	 * Grow buffer enough for the append.
	 */

	TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);

	/*
	 * Reset objPtr back to the original value.
	 */

	Tcl_SetByteArrayLength(objPtr, length);

	/*
	 * Now do the append knowing that buffer growth cannot cause any
	 * trouble.
	 */

	TclAppendBytesToByteArray(objPtr,
		Tcl_GetByteArrayFromObj(appendObjPtr, NULL), lengthSrc);
	return;
    }

    /*
     * Must append as strings.
     */

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * If objPtr has a valid Unicode rep, then get a Unicode string from
     * appendObjPtr and append it.
     */

    stringPtr = GET_STRING(objPtr);
    if (stringPtr->hasUnicode) {
    if (stringPtr->hasUnicode != 0) {
	/*
	 * If appendObjPtr is not of the "String" type, don't convert it.
	 */

	if (TclHasIntRep(appendObjPtr, &tclStringType)) {
	    Tcl_UniChar *unicode =
		    TclGetUnicodeFromObj(appendObjPtr, &numChars);

	    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
	if (appendObjPtr->typePtr == &tclStringType) {
	    stringPtr = GET_STRING(appendObjPtr);
	    if ((stringPtr->numChars == -1) || (stringPtr->hasUnicode == 0)) {
		/*
		 * If appendObjPtr is a string obj with no valid Unicode rep,
		 * then fill its unicode rep.
		 */

		FillUnicodeRep(appendObjPtr);
		stringPtr = GET_STRING(appendObjPtr);
	    }
	    AppendUnicodeToUnicodeRep(objPtr, stringPtr->unicode,
		    stringPtr->numChars);
	} else {
	    bytes = TclGetStringFromObj(appendObjPtr, &length);
	    AppendUtfToUnicodeRep(objPtr, bytes, length);
	}
	return;
    }

    /*
     * Append to objPtr's UTF string rep. If we know the number of characters
     * in both objects before appending, then set the combined number of
     * characters in the final (appended-to) object.
     */

    bytes = TclGetStringFromObj(appendObjPtr, &length);

    allOneByteChars = 0;
    numChars = stringPtr->numChars;
    if ((numChars != TCL_INDEX_NONE) && TclHasIntRep(appendObjPtr, &tclStringType)) {
	String *appendStringPtr = GET_STRING(appendObjPtr);

    if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
	stringPtr = GET_STRING(appendObjPtr);
	if ((stringPtr->numChars >= 0) && (stringPtr->numChars == length)) {
	    numChars += stringPtr->numChars;
	    allOneByteChars = 1;
	}
	appendNumChars = appendStringPtr->numChars;
    }

    AppendUtfToUtfRep(objPtr, bytes, length);

    if ((numChars != TCL_INDEX_NONE) && (appendNumChars != TCL_INDEX_NONE)) {
	stringPtr->numChars = numChars + appendNumChars;
    if (allOneByteChars) {
	stringPtr = GET_STRING(objPtr);
	stringPtr->numChars = numChars;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUnicodeToUnicodeRep --
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
1439
1440
1441
1442
1443
1444

1445
1446
1447
1448
1449
1450
1451
1359
1360
1361
1362
1363
1364
1365

1366
1367
1368

1369
1370

1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389

1390


1391
1392
1393
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







-
+


-
+

-
+


















-
+
-
-

+


-
-
+
+

-
+

-
-
+
+
+





-
-
+
-
-
+
-
-
+









-
+







 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to append. */
    size_t appendNumChars)		/* Number of chars of "unicode" to append. */
    int appendNumChars)		/* Number of chars of "unicode" to append. */
{
    String *stringPtr;
    size_t numChars;
    int numChars;

    if (appendNumChars == TCL_INDEX_NONE) {
    if (appendNumChars < 0) {
	appendNumChars = UnicodeLength(unicode);
    }
    if (appendNumChars == 0) {
	return;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    /*
     * If not enough space has been allocated for the unicode rep, reallocate
     * the internal rep object with additional space. First try to double the
     * required allocation; if that fails, try a more modest increase. See the
     * "TCL STRING GROWTH ALGORITHM" comment at the top of this file for an
     * explanation of this growth algorithm.
     */

    numChars = stringPtr->numChars + appendNumChars;

    stringCheckLimits(numChars);
    if (numChars > stringPtr->maxChars) {
	size_t index = TCL_INDEX_NONE;

    if (STRING_UALLOC(numChars) > stringPtr->uallocated) {
	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 * stringPtr->unicode array.  Force it to follow any relocations
	 * due to the reallocs below.
	 */

	int offset = -1;
	if (unicode && unicode >= stringPtr->unicode
		&& unicode <= stringPtr->unicode + stringPtr->maxChars) {
	    index = unicode - stringPtr->unicode;
		&& unicode <= stringPtr->unicode
		+ stringPtr->uallocated / sizeof(Tcl_UniChar)) {
	    offset = unicode - stringPtr->unicode;
	}

	GrowUnicodeBuffer(objPtr, numChars);
	stringPtr = GET_STRING(objPtr);

	/*
	 * Relocate unicode if needed; see above.
	/* Relocate unicode if needed; see above. */
	 */

	if (offset >= 0) {
	if (index != TCL_INDEX_NONE) {
	    unicode = stringPtr->unicode + index;
	    unicode = stringPtr->unicode + offset;
	}
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    if (unicode) {
	memmove(stringPtr->unicode + stringPtr->numChars, unicode,
	memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
		appendNumChars * sizeof(Tcl_UniChar));
    }
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->allocated = 0;

    TclInvalidateStringRep(objPtr);
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
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544

1545
1546
1547

1548



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
1596
1597
1598
1599

1600
1601
1602
1603

1604
1605
1606
1607





















































































































































1608
1609
1610
1611
1612
1613
1614
1444
1445
1446
1447
1448
1449
1450

1451
1452

1453
1454
1455
1456


1457
1458


1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475

1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490

1491
1492

1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505




1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534

1535
1536
1537

1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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







-
+

-
+
+

+
-
-
+
+
-
-
+
+

+
+
+
+
+









-
+














-
+

-
+
+
+

+
+
+




+
+
-
-
-
-
+
+
+
+
+
+









-














-
+


-
+

+
+
+









-
-
-


+
+
-
+
+

-
+
-
-


-
-
+
+

-
+






-
-
+
+
+
+
+


-
-
-
+
+
-
-
+
+
+
+
+
+

+
+
+
+
-
+








-
+



-
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

static void
AppendUnicodeToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const Tcl_UniChar *unicode,	/* String to convert to UTF. */
    size_t numChars)		/* Number of chars of "unicode" to convert. */
    int numChars)		/* Number of chars of "unicode" to convert. */
{
    String *stringPtr = GET_STRING(objPtr);
    Tcl_DString dsPtr;
    const char *bytes;

    if (numChars < 0) {
    numChars = ExtendStringRepWithUnicode(objPtr, unicode, numChars);

	numChars = UnicodeLength(unicode);
    }
    if (stringPtr->numChars != TCL_INDEX_NONE) {
	stringPtr->numChars += numChars;
    if (numChars == 0) {
	return;
    }

    Tcl_DStringInit(&dsPtr);
    bytes = Tcl_UniCharToUtfDString(unicode, numChars, &dsPtr);
    AppendUtfToUtfRep(objPtr, bytes, Tcl_DStringLength(&dsPtr));
    Tcl_DStringFree(&dsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUtfToUnicodeRep --
 *
 *	This function converts the contents of "bytes" to Unicode and appends
 *	the Unicode to the Unicode rep of "objPtr". objPtr must already have a
 *	valid Unicode rep. numBytes must be non-negative.
 *	valid Unicode rep.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	objPtr's internal rep is reallocated.
 *
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUnicodeRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to convert to Unicode. */
    size_t numBytes)		/* Number of bytes of "bytes" to convert. */
    int numBytes)		/* Number of bytes of "bytes" to convert. */
{
    String *stringPtr;
    Tcl_DString dsPtr;
    int numChars = numBytes;
    Tcl_UniChar *unicode = NULL;

    if (numBytes < 0) {
	numBytes = (bytes ? strlen(bytes) : 0);
    }
    if (numBytes == 0) {
	return;
    }

    Tcl_DStringInit(&dsPtr);
    if (bytes) {
    ExtendUnicodeRepWithString(objPtr, bytes, numBytes, -1);
    TclInvalidateStringRep(objPtr);
    stringPtr = GET_STRING(objPtr);
    stringPtr->allocated = 0;
	numChars = Tcl_NumUtfChars(bytes, numBytes);
	unicode = (Tcl_UniChar *) Tcl_UtfToUniCharDString(bytes, numBytes,
		&dsPtr);
    }
    AppendUnicodeToUnicodeRep(objPtr, unicode, numChars);
    Tcl_DStringFree(&dsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AppendUtfToUtfRep --
 *
 *	This function appends "numBytes" bytes of "bytes" to the UTF string
 *	rep of "objPtr". objPtr must already have a valid String rep.
 *	numBytes must be non-negative.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	objPtr's internal rep is reallocated.
 *
 *----------------------------------------------------------------------
 */

static void
AppendUtfToUtfRep(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    const char *bytes,		/* String to append. */
    size_t numBytes)		/* Number of bytes of "bytes" to append. */
    int numBytes)		/* Number of bytes of "bytes" to append. */
{
    String *stringPtr;
    size_t newLength, oldLength;
    int newLength, oldLength;

    if (numBytes < 0) {
	numBytes = (bytes ? strlen(bytes) : 0);
    }
    if (numBytes == 0) {
	return;
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    oldLength = objPtr->length;
    newLength = numBytes + oldLength;
    if (newLength < 0) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);

    }

    stringPtr = GET_STRING(objPtr);
    if (newLength > stringPtr->allocated) {
    if (newLength > (int) stringPtr->allocated) {
	size_t offset = TCL_INDEX_NONE;

	/*
	 * Protect against case where unicode points into the existing
	 * stringPtr->unicode array. Force it to follow any relocations due to
	 * the reallocs below.
	 * stringPtr->unicode array.  Force it to follow any relocations
	 * due to the reallocs below.
	 */

	int offset = -1;
	if (bytes && bytes >= objPtr->bytes
		&& bytes <= objPtr->bytes + objPtr->length) {
	    offset = bytes - objPtr->bytes;
	}

	/*
	 * TODO: consider passing flag=1: no overalloc on first append. This
	 * would make test stringObj-8.1 fail.
	 * There isn't currently enough space in the string representation so
	 * allocate additional space. First, try to double the length
	 * required. If that fails, try a more modest allocation. See the "TCL
	 * STRING GROWTH ALGORITHM" comment at the top of this file for an
	 * explanation of this growth algorithm.
	 */

	GrowStringBuffer(objPtr, newLength, 0);

	/*
	if (Tcl_AttemptSetObjLength(objPtr, 2 * newLength) == 0) {
	    /*
	 * Relocate bytes if needed; see above.
	 */
	     * Take care computing the amount of modest growth to avoid
	     * overflow into invalid argument values for Tcl_SetObjLength.
	     */
	    unsigned int limit = INT_MAX - newLength;
	    unsigned int extra = numBytes + TCL_GROWTH_MIN_ALLOC;
	    int growth = (int) ((extra > limit) ? limit : extra);

	    Tcl_SetObjLength(objPtr, newLength + growth);
	}

	/* Relocate bytes if needed; see above. */
	if (offset != TCL_INDEX_NONE) {
	if (offset >=0) {
	    bytes = objPtr->bytes + offset;
	}
    }

    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = TCL_INDEX_NONE;
    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    if (bytes) {
	memmove(objPtr->bytes + oldLength, bytes, numBytes);
	memcpy(objPtr->bytes + oldLength, bytes, (size_t) numBytes);
    }
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendStringsToObjVA --
 *
 *	This function appends one or more null-terminated strings to an
 *	object.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The contents of all the string arguments are appended to the string
 *	representation of objPtr.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AppendStringsToObjVA(
    Tcl_Obj *objPtr,		/* Points to the object to append to. */
    va_list argList)		/* Variable argument list. */
{
#define STATIC_LIST_SIZE 16
    String *stringPtr;
    int newLength, oldLength, attemptLength;
    register char *string, *dst;
    char *static_list[STATIC_LIST_SIZE];
    char **args = static_list;
    int nargs_space = STATIC_LIST_SIZE;
    int nargs, i;

    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
    }

    SetStringFromAny(NULL, objPtr);

    /*
     * Force the existence of a string rep. so we avoid crashes operating
     * on a pure unicode value.  [Bug 2597185]
     */

    (void) Tcl_GetStringFromObj(objPtr, &oldLength);

    /*
     * Figure out how much space is needed for all the strings, and expand the
     * string representation if it isn't big enough. If no bytes would be
     * appended, just return. Note that on some platforms (notably OS/390) the
     * argList is an array so we need to use memcpy.
     */

    nargs = 0;
    newLength = 0;
    while (1) {
	string = va_arg(argList, char *);
	if (string == NULL) {
	    break;
	}
	if (nargs >= nargs_space) {
	    /*
	     * Expand the args buffer.
	     */

	    nargs_space += STATIC_LIST_SIZE;
	    if (args == static_list) {
		args = (void *) ckalloc(nargs_space * sizeof(char *));
		for (i = 0; i < nargs; ++i) {
		    args[i] = static_list[i];
		}
	    } else {
		args = (void *) ckrealloc((void *) args,
			nargs_space * sizeof(char *));
	    }
	}
	newLength += strlen(string);
	args[nargs++] = string;
    }
    if (newLength == 0) {
	goto done;
    }

    stringPtr = GET_STRING(objPtr);
    if (oldLength + newLength > (int) stringPtr->allocated) {
	/*
	 * There isn't currently enough space in the string representation, so
	 * allocate additional space. If the current string representation
	 * isn't empty (i.e. it looks like we're doing a series of appends)
	 * then try to allocate extra space to accomodate future growth: first
	 * try to double the required memory; if that fails, try a more modest
	 * allocation. See the "TCL STRING GROWTH ALGORITHM" comment at the
	 * top of this file for an explanation of this growth algorithm.
	 * Otherwise, if the current string representation is empty, exactly
	 * enough memory is allocated.
	 */

	if (oldLength == 0) {
	    Tcl_SetObjLength(objPtr, newLength);
	} else {
	    attemptLength = 2 * (oldLength + newLength);
	    if (Tcl_AttemptSetObjLength(objPtr, attemptLength) == 0) {
		attemptLength = oldLength + (2 * newLength) +
			TCL_GROWTH_MIN_ALLOC;
		Tcl_SetObjLength(objPtr, attemptLength);
	    }
	}
    }

    /*
     * Make a second pass through the arguments, appending all the strings to
     * the object.
     */

    dst = objPtr->bytes + oldLength;
    for (i = 0; i < nargs; ++i) {
	string = args[i];
	if (string == NULL) {
	    break;
	}
	while (*string != 0) {
	    *dst = *string;
	    dst++;
	    string++;
	}
    }

    /*
     * Add a null byte to terminate the string. However, be careful: it's
     * possible that the object is totally empty (if it was empty originally
     * and there was nothing to append). In this case dst is NULL; just leave
     * everything alone.
     */

    if (dst != NULL) {
	*dst = 0;
    }
    objPtr->length = oldLength + newLength;

  done:
    /*
     * If we had to allocate a buffer from the heap, free it now.
     */

    if (args != static_list) {
	ckfree((void *) args);
    }
#undef STATIC_LIST_SIZE
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendStringsToObj --
 *
 *	This function appends one or more null-terminated strings to an
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
1779
1780
1781
1782
1783
1784
1785


1786










1787
1788
1789
1790
1791
1792
1793







-
-
+
-
-
-
-
-
-
-
-
-
-







Tcl_AppendStringsToObj(
    Tcl_Obj *objPtr,
    ...)
{
    va_list argList;

    va_start(argList, objPtr);
    if (Tcl_IsShared(objPtr)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendStringsToObj");
    Tcl_AppendStringsToObjVA(objPtr, argList);
    }

    while (1) {
	const char *bytes = va_arg(argList, char *);

	if (bytes == NULL) {
	    break;
	}
	Tcl_AppendToObj(objPtr, bytes, -1);
    }
    va_end(argList);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppendFormatToObj --
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
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781

1782
1783
1784
1785
1786
1787
1788
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
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







-
-
-
+
+
+
-


-
+








-
-
+
+







-
-
+
+
-
-
-
-
+
-

+
-
+









-













-
+














-




-
+





-






-






-







+







Tcl_AppendFormatToObj(
    Tcl_Interp *interp,
    Tcl_Obj *appendObj,
    const char *format,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *span = format, *msg, *errCode;
    int objIndex = 0, gotXpg = 0, gotSequential = 0;
    size_t originalLength, limit, numBytes = 0;
    const char *span = format, *msg;
    int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
    int originalLength, limit;
    Tcl_UniChar ch = 0;
    static const char *mixedXPG =
	    "cannot mix \"%\" and \"%n$\" conversion specifiers";
    static const char *const badIndex[2] = {
    static const char *badIndex[2] = {
	"not enough arguments for all format specifiers",
	"\"%n$\" argument index out of range"
    };
    static const char *overflow = "max size for a Tcl value exceeded";

    if (Tcl_IsShared(appendObj)) {
	Tcl_Panic("%s called with shared object", "Tcl_AppendFormatToObj");
    }
    (void)TclGetStringFromObj(appendObj, &originalLength);
    limit = (size_t)INT_MAX - originalLength;
    TclGetStringFromObj(appendObj, &originalLength);
    limit = INT_MAX - originalLength;

    /*
     * Format string is NUL-terminated.
     */

    while (*format != '\0') {
	char *end;
	int gotMinus = 0, gotHash = 0, gotZero = 0, gotSpace = 0, gotPlus = 0;
	int width, gotPrecision, precision, sawFlag, useShort = 0, useBig = 0;
	int gotMinus, gotHash, gotZero, gotSpace, gotPlus, sawFlag;
	int width, gotPrecision, precision, useShort, useWide, useBig;
#ifndef TCL_WIDE_INT_IS_LONG
	int useWide = 0;
#endif
	int newXpg, numChars, allocSegment = 0, segmentLimit;
	int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes;
	size_t segmentNumBytes;
	Tcl_Obj *segment;
	Tcl_UniChar ch;
	int step = TclUtfToUniChar(format, &ch);
	int step = Tcl_UtfToUniChar(format, &ch);

	format += step;
	if (ch != '%') {
	    numBytes += step;
	    continue;
	}
	if (numBytes) {
	    if (numBytes > limit) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    Tcl_AppendToObj(appendObj, span, numBytes);
	    limit -= numBytes;
	    numBytes = 0;
	}

	/*
	 * Saw a % : process the format specifier.
	 *
	 * Step 0. Handle special case of escaped format marker (i.e., %%).
	 */

	step = TclUtfToUniChar(format, &ch);
	step = Tcl_UtfToUniChar(format, &ch);
	if (ch == '%') {
	    span = format;
	    numBytes = step;
	    format += step;
	    continue;
	}

	/*
	 * Step 1. XPG3 position specifier
	 */

	newXpg = 0;
	if (isdigit(UCHAR(ch))) {
	    int position = strtoul(format, &end, 10);

	    if (*end == '$') {
		newXpg = 1;
		objIndex = position - 1;
		format = end + 1;
		step = TclUtfToUniChar(format, &ch);
		step = Tcl_UtfToUniChar(format, &ch);
	    }
	}
	if (newXpg) {
	    if (gotSequential) {
		msg = mixedXPG;
		errCode = "MIXEDSPECTYPES";
		goto errorMsg;
	    }
	    gotXpg = 1;
	} else {
	    if (gotXpg) {
		msg = mixedXPG;
		errCode = "MIXEDSPECTYPES";
		goto errorMsg;
	    }
	    gotSequential = 1;
	}
	if ((objIndex < 0) || (objIndex >= objc)) {
	    msg = badIndex[gotXpg];
	    errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
	    goto errorMsg;
	}

	/*
	 * Step 2. Set of flags.
	 */

	gotMinus = gotHash = gotZero = gotSpace = gotPlus = 0;
	sawFlag = 1;
	do {
	    switch (ch) {
	    case '-':
		gotMinus = 1;
		break;
	    case '#':
1798
1799
1800
1801
1802
1803
1804
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
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
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







-
+












-



-
+



-











-
+

-
+

-











-
+




-
+



-
















-
+






+



-
+


-
+



-
+
-

-
-
-
-
-
-
-



-
-
-
-
-
-

-
-
-
-
-

















-













-
+






-
-
-
-







+
+
+
+



-

-
+
-
-
+






-
-
-
-
-

-



-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
+
-
+

-
+
-
-

-
-
+
+
+
+
+
+
+
+
+
+
+

-
+


-
-
+
+
-

-
+
-


-
-
+
+
-

-
+
-


-
+




-
+
-
-
+



-
+


-
-
+
+
+

-





-
-
-
-





-
+




-
+
-

-
+
-



-
+







		gotPlus = 1;
		break;
	    default:
		sawFlag = 0;
	    }
	    if (sawFlag) {
		format += step;
		step = TclUtfToUniChar(format, &ch);
		step = Tcl_UtfToUniChar(format, &ch);
	    }
	} while (sawFlag);

	/*
	 * Step 3. Minimum field width.
	 */

	width = 0;
	if (isdigit(UCHAR(ch))) {
	    width = strtoul(format, &end, 10);
	    if (width < 0) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    format = end;
	    step = TclUtfToUniChar(format, &ch);
	    step = Tcl_UtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetIntFromObj(interp, objv[objIndex], &width) != TCL_OK) {
		goto error;
	    }
	    if (width < 0) {
		width = -width;
		gotMinus = 1;
	    }
	    objIndex++;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	    step = Tcl_UtfToUniChar(format, &ch);
	}
	if (width > (int) limit) {
	if (width > limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}

	/*
	 * Step 4. Precision.
	 */

	gotPrecision = precision = 0;
	if (ch == '.') {
	    gotPrecision = 1;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	    step = Tcl_UtfToUniChar(format, &ch);
	}
	if (isdigit(UCHAR(ch))) {
	    precision = strtoul(format, &end, 10);
	    format = end;
	    step = TclUtfToUniChar(format, &ch);
	    step = Tcl_UtfToUniChar(format, &ch);
	} else if (ch == '*') {
	    if (objIndex >= objc - 1) {
		msg = badIndex[gotXpg];
		errCode = gotXpg ? "INDEXRANGE" : "FIELDVARMISMATCH";
		goto errorMsg;
	    }
	    if (TclGetIntFromObj(interp, objv[objIndex], &precision)
		    != TCL_OK) {
		goto error;
	    }

	    /*
	     * TODO: Check this truncation logic.
	     */

	    if (precision < 0) {
		precision = 0;
	    }
	    objIndex++;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	    step = Tcl_UtfToUniChar(format, &ch);
	}

	/*
	 * Step 5. Length modifier.
	 */

	useShort = useWide = useBig = 0;
	if (ch == 'h') {
	    useShort = 1;
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	    step = Tcl_UtfToUniChar(format, &ch);
	} else if (ch == 'l') {
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	    step = Tcl_UtfToUniChar(format, &ch);
	    if (ch == 'l') {
		useBig = 1;
		format += step;
		step = TclUtfToUniChar(format, &ch);
		step = Tcl_UtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
	    } else {
		useWide = 1;
#endif
	    }
	} else if (ch == 'I') {
	    if ((format[1] == '6') && (format[2] == '4')) {
		format += (step + 2);
		step = TclUtfToUniChar(format, &ch);
#ifndef TCL_WIDE_INT_IS_LONG
		useWide = 1;
#endif
	    } else if ((format[1] == '3') && (format[2] == '2')) {
		format += (step + 2);
		step = TclUtfToUniChar(format, &ch);
	    } else {
		format += step;
		step = TclUtfToUniChar(format, &ch);
	    }
	} else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j')
		|| (ch == 'L')) {
	    format += step;
	    step = TclUtfToUniChar(format, &ch);
	    useBig = 1;
	}

	format += step;
	span = format;

	/*
	 * Step 6. The actual conversion character.
	 */

	segment = objv[objIndex];
	numChars = -1;
	if (ch == 'i') {
	    ch = 'd';
	}
	switch (ch) {
	case '\0':
	    msg = "format string ended in middle of field specifier";
	    errCode = "INCOMPLETE";
	    goto errorMsg;
	case 's':
	    if (gotPrecision) {
		numChars = Tcl_GetCharLength(segment);
		if (precision < numChars) {
		    segment = Tcl_GetRange(segment, 0, precision - 1);
		    numChars = precision;
		    Tcl_IncrRefCount(segment);
		    allocSegment = 1;
		}
	    }
	    break;
	case 'c': {
	    char buf[4] = "";
	    char buf[TCL_UTF_MAX];
	    int code, length;

	    if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
		goto error;
	    }
	    length = Tcl_UniCharToUtf(code, buf);
	    if ((code >= 0xD800) && (length < 3)) {
		/* Special case for handling high surrogates. */
		length += Tcl_UniCharToUtf(-1, buf + length);
	    }
	    segment = Tcl_NewStringObj(buf, length);
	    Tcl_IncrRefCount(segment);
	    allocSegment = 1;
	    break;
	}

	case 'u':
	    if (useBig) {
		msg = "unsigned bignum format is invalid";
		goto errorMsg;
	    }
	    /* FALLTHRU */
	case 'd':
	case 'o':
	case 'p':
	case 'x':
	case 'X':
	case 'X': {
	case 'b': {
	    short s = 0;	/* Silence compiler warning; only defined and
	    short int s = 0;	/* Silence compiler warning; only defined and
				 * used when useShort is true. */
	    long l;
	    Tcl_WideInt w;
	    mp_int big;
	    int toAppend, isNegative = 0;

#ifndef TCL_WIDE_INT_IS_LONG
	    if (ch == 'p') {
		useWide = 1;
	    }
#endif
	    if (useBig) {
		int cmpResult;
		if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
		    goto error;
		}
		cmpResult = mp_cmp_d(&big, 0);
		isNegative = (mp_cmp_d(&big, 0) == MP_LT);
		isNegative = (cmpResult == MP_LT);
		if (cmpResult == MP_EQ) gotHash = 0;
		if (ch == 'u') {
		    if (isNegative) {
			mp_clear(&big);
			msg = "unsigned bignum format is invalid";
			errCode = "BADUNSIGNED";
			goto errorMsg;
		    } else {
	    } else if (useWide) {
			ch = 'd';
		    }
		}
		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;

		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
			goto error;
		    }
#ifndef TCL_WIDE_INT_IS_LONG
	    } else if (useWide) {
		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
		    mp_mod_2d(&big, CHAR_BIT*sizeof(Tcl_WideInt), &big);
		    objPtr = Tcl_NewBignumObj(&big);
		    Tcl_IncrRefCount(objPtr);
		    Tcl_GetWideIntFromObj(NULL, objPtr, &w);
		    goto error;
		    Tcl_DecrRefCount(objPtr);
		}
		isNegative = (w < (Tcl_WideInt) 0);
		isNegative = (w < (Tcl_WideInt)0);
		if (w == (Tcl_WideInt) 0) gotHash = 0;
#endif
	    } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
		    goto error;
		if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
		    Tcl_Obj *objPtr;

		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
			goto error;
		    }
		    mp_mod_2d(&big, CHAR_BIT * sizeof(long), &big);
		    objPtr = Tcl_NewBignumObj(&big);
		    Tcl_IncrRefCount(objPtr);
		    TclGetLongFromObj(NULL, objPtr, &l);
		    Tcl_DecrRefCount(objPtr);
		} else {
		    l = (long) w;
		    l = Tcl_WideAsLong(w);
		}
		if (useShort) {
		    s = (short) l;
		    isNegative = (s < (short) 0);
		    s = (short int) l;
		    isNegative = (s < (short int)0);
		    if (s == (short) 0) gotHash = 0;
		} else {
		    isNegative = (l < (long) 0);
		    isNegative = (l < (long)0);
		    if (l == (long) 0) gotHash = 0;
		}
	    } else if (useShort) {
		s = (short) l;
		isNegative = (s < (short) 0);
		s = (short int) l;
		isNegative = (s < (short int)0);
		if (s == (short) 0) gotHash = 0;
	    } else {
		isNegative = (l < (long) 0);
		isNegative = (l < (long)0);
		if (l == (long) 0) gotHash = 0;
	    }

	    TclNewObj(segment);
	    segment = Tcl_NewObj();
	    allocSegment = 1;
	    segmentLimit = INT_MAX;
	    Tcl_IncrRefCount(segment);

	    if ((isNegative || gotPlus || gotSpace) && (useBig || ch=='d')) {
	    if ((isNegative || gotPlus || gotSpace) && (useBig || (ch == 'd'))) {
		Tcl_AppendToObj(segment,
			(isNegative ? "-" : gotPlus ? "+" : " "), 1);
		Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1);
		segmentLimit -= 1;
	    }

	    if (gotHash || (ch == 'p')) {
	    if (gotHash) {
		switch (ch) {
		case 'o':
		    Tcl_AppendToObj(segment, "0o", 2);
		    segmentLimit -= 2;
		    Tcl_AppendToObj(segment, "0", 1);
		    segmentLimit -= 1;
		    precision--;
		    break;
		case 'p':
		case 'x':
		case 'X':
		    Tcl_AppendToObj(segment, "0x", 2);
		    segmentLimit -= 2;
		    break;
		case 'b':
		    Tcl_AppendToObj(segment, "0b", 2);
		    segmentLimit -= 2;
		    break;
		}
	    }

	    switch (ch) {
	    case 'd': {
		size_t length;
		int length;
		Tcl_Obj *pure;
		const char *bytes;

		if (useShort) {
		    TclNewIntObj(pure, s);
		    pure = Tcl_NewIntObj((int)(s));
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {
		    TclNewIntObj(pure, w);
		    pure = Tcl_NewWideIntObj(w);
#endif
		} else if (useBig) {
		    pure = Tcl_NewBignumObj(&big);
		} else {
		    TclNewIntObj(pure, l);
		    pure = Tcl_NewLongObj(l);
		}
		Tcl_IncrRefCount(pure);
		bytes = TclGetStringFromObj(pure, &length);

		/*
		 * Already did the sign above.
		 */
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
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







-
-
+
+

-
+







-
-
+
+

-
+






-









-

-
+
-
-
-
-
-
+
+
+
+





+
-
+


-
-
-


-
+






-








-
-
+




-
+






-



-
+












-
+


-
-
+
+

-
+



-
+


-
+




-
+

-
-
-
-
+
-









-
-
+
+

-
+







-
-
+
+

-
+






-











-
-







		/*
		 * Canonical decimal string reps for integers are composed
		 * entirely of one-byte encoded characters, so "length" is the
		 * number of chars.
		 */

		if (gotPrecision) {
		    if (length < (size_t)precision) {
			segmentLimit -= precision - length;
		    if (length < precision) {
			segmentLimit -= (precision - length);
		    }
		    while (length < (size_t)precision) {
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < (size_t)width) {
			segmentLimit -= width - length;
		    if (length < width) {
			segmentLimit -= (width - length);
		    }
		    while (length < (size_t)width) {
		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		Tcl_AppendToObj(segment, bytes, toAppend);
		Tcl_DecrRefCount(pure);
		break;
	    }

	    case 'u':
	    case 'o':
	    case 'p':
	    case 'x':
	    case 'X':
	    case 'X': {
	    case 'b': {
		Tcl_WideUInt bits = 0;
		Tcl_WideInt numDigits = 0;
		int numBits = 4, base = 16, index = 0, shift = 0;
		size_t length;
		Tcl_WideUInt bits = (Tcl_WideUInt)0;
		Tcl_WideInt numDigits = (Tcl_WideInt)0;
		int length, numBits = 4, base = 16;
		int index = 0, shift = 0;
		Tcl_Obj *pure;
		char *bytes;

		if (ch == 'u') {
		    base = 10;
		}
		} else if (ch == 'o') {
		if (ch == 'o') {
		    base = 8;
		    numBits = 3;
		} else if (ch == 'b') {
		    base = 2;
		    numBits = 1;
		}
		if (useShort) {
		    unsigned short us = (unsigned short) s;
		    unsigned short int us = (unsigned short int) s;

		    bits = (Tcl_WideUInt) us;
		    while (us) {
			numDigits++;
			us /= base;
		    }
#ifndef TCL_WIDE_INT_IS_LONG
		} else if (useWide) {
		    Tcl_WideUInt uw = (Tcl_WideUInt) w;

		    bits = uw;
		    while (uw) {
			numDigits++;
			uw /= base;
		    }
#endif
		} else if (useBig && !mp_iszero(&big)) {
		} else if (useBig && big.used) {
		    int leftover = (big.used * MP_DIGIT_BIT) % numBits;
		    mp_digit mask = (~(mp_digit)0) << (MP_DIGIT_BIT-leftover);

		    numDigits = 1 +
			    (((Tcl_WideInt) big.used * MP_DIGIT_BIT) / numBits);
			    (((Tcl_WideInt)big.used * MP_DIGIT_BIT) / numBits);
		    while ((mask & big.dp[big.used-1]) == 0) {
			numDigits--;
			mask >>= numBits;
		    }
		    if (numDigits > INT_MAX) {
			msg = overflow;
			errCode = "OVERFLOW";
			goto errorMsg;
		    }
		} else if (!useBig) {
		    unsigned long ul = (unsigned long) l;
		    unsigned long int ul = (unsigned long int) l;

		    bits = (Tcl_WideUInt) ul;
		    while (ul) {
			numDigits++;
			ul /= base;
		    }
		}

		/*
		 * Need to be sure zero becomes "0", not "".
		 */

		if (numDigits == 0) {
		if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
		    numDigits = 1;
		}
		TclNewObj(pure);
		Tcl_SetObjLength(pure, numDigits);
		pure = Tcl_NewObj();
		Tcl_SetObjLength(pure, (int)numDigits);
		bytes = TclGetString(pure);
		toAppend = length = numDigits;
		toAppend = length = (int)numDigits;
		while (numDigits--) {
		    int digitOffset;

		    if (useBig && !mp_iszero(&big)) {
		    if (useBig && big.used) {
			if (index < big.used && (size_t) shift <
				CHAR_BIT*sizeof(Tcl_WideUInt) - MP_DIGIT_BIT) {
			    bits |= ((Tcl_WideUInt) big.dp[index++]) << shift;
			    bits |= (((Tcl_WideUInt)big.dp[index++]) <<shift);
			    shift += MP_DIGIT_BIT;
			}
			shift -= numBits;
		    }
		    digitOffset = bits % base;
		    digitOffset = (int) (bits % base);
		    if (digitOffset > 9) {
			if (ch == 'X') {
			    bytes[numDigits] = 'A' + digitOffset - 10;
			} else {
			    bytes[numDigits] = 'a' + digitOffset - 10;
			bytes[numDigits] = 'a' + digitOffset - 10;
			}
		    } else {
			bytes[numDigits] = '0' + digitOffset;
		    }
		    bits /= base;
		}
		if (useBig) {
		    mp_clear(&big);
		}
		if (gotPrecision) {
		    if (length < (size_t)precision) {
			segmentLimit -= precision - length;
		    if (length < precision) {
			segmentLimit -= (precision - length);
		    }
		    while (length < (size_t)precision) {
		    while (length < precision) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		    gotZero = 0;
		}
		if (gotZero) {
		    length += Tcl_GetCharLength(segment);
		    if (length < (size_t)width) {
			segmentLimit -= width - length;
		    if (length < width) {
			segmentLimit -= (width - length);
		    }
		    while (length < (size_t)width) {
		    while (length < width) {
			Tcl_AppendToObj(segment, "0", 1);
			length++;
		    }
		}
		if (toAppend > segmentLimit) {
		    msg = overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		Tcl_AppendObjToObj(segment, pure);
		Tcl_DecrRefCount(pure);
		break;
	    }

	    }
	    break;
	}

	case 'a':
	case 'A':
	case 'e':
	case 'E':
	case 'f':
	case 'g':
	case 'G': {
#define MAX_FLOAT_SIZE 320
	    char spec[2*TCL_INTEGER_SPACE + 9], *p = spec;
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
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







-
+
-












-
+



-





-


-
-
-
-
-
-






-




+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-









-
+












-












-









-
+





-
+












-
+
-
-







		    length = width;
		}
	    }
	    if (gotPrecision) {
		*p++ = '.';
		p += sprintf(p, "%d", precision);
		if (precision > INT_MAX - length) {
		    msg = overflow;
		    msg=overflow;
		    errCode = "OVERFLOW";
		    goto errorMsg;
		}
		length += precision;
	    }

	    /*
	     * Don't pass length modifiers!
	     */

	    *p++ = (char) ch;
	    *p = '\0';

	    TclNewObj(segment);
	    segment = Tcl_NewObj();
	    allocSegment = 1;
	    if (!Tcl_AttemptSetObjLength(segment, length)) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    bytes = TclGetString(segment);
	    if (!Tcl_AttemptSetObjLength(segment, sprintf(bytes, spec, d))) {
		msg = overflow;
		errCode = "OVERFLOW";
		goto errorMsg;
	    }
	    if (ch == 'A') {
		char *q = TclGetString(segment) + 1;
		*q = 'x';
		q = strchr(q, 'P');
		if (q) *q = 'p';
	    }
	    break;
	}
	default:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp,
			Tcl_ObjPrintf("bad field specifier \"%c\"", ch));
		Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADTYPE", NULL);
	    }
	    goto error;
	}

	switch (ch) {
	case 'E':
	case 'G':
	case 'X': {
	    Tcl_SetObjLength(segment, Tcl_UtfToUpper(TclGetString(segment)));
	}
	}

	if (width>0 && numChars<0) {
	    numChars = Tcl_GetCharLength(segment);
	}
	if (!gotMinus && width>0) {
	    if (numChars < width) {
		limit -= width - numChars;
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	(void)TclGetStringFromObj(segment, &segmentNumBytes);
	if (width > 0) {
	    if (numChars < 0) {
		numChars = Tcl_GetCharLength(segment);
	    }
	    if (!gotMinus) {
		if (numChars < width) {
		    limit -= (width - numChars);
		}
		while (numChars < width) {
		    Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		    numChars++;
		}
	    }
	}

	Tcl_GetStringFromObj(segment, &segmentNumBytes);
	if (segmentNumBytes > limit) {
	    if (allocSegment) {
		Tcl_DecrRefCount(segment);
	    }
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}
	Tcl_AppendObjToObj(appendObj, segment);
	limit -= segmentNumBytes;
	if (allocSegment) {
	    Tcl_DecrRefCount(segment);
	}
	if (width > 0) {
	    if (numChars < width) {
		limit -= width-numChars;
		limit -= (width - numChars);
	    }
	    while (numChars < width) {
		Tcl_AppendToObj(appendObj, (gotZero ? "0" : " "), 1);
		numChars++;
	    }
	}

	objIndex += gotSequential;
    }
    if (numBytes) {
	if (numBytes > limit) {
	    msg = overflow;
	    errCode = "OVERFLOW";
	    goto errorMsg;
	}
	Tcl_AppendToObj(appendObj, span, numBytes);
	limit -= numBytes;
	numBytes = 0;
    }

    return TCL_OK;

  errorMsg:
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
	Tcl_SetErrorCode(interp, "TCL", "FORMAT", errCode, NULL);
    }
  error:
    Tcl_SetObjLength(appendObj, originalLength);
    return TCL_ERROR;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_Format --
 * Tcl_Format--
 *
 * Results:
 *	A refcount zero Tcl_Obj.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_Format(
    Tcl_Interp *interp,
    const char *format,
    int objc,
    Tcl_Obj *const objv[])
{
    int result;
    Tcl_Obj *objPtr;
    Tcl_Obj *objPtr = Tcl_NewObj();

    TclNewObj(objPtr);
    result = Tcl_AppendFormatToObj(interp, objPtr, format, objc, objv);
    if (result != TCL_OK) {
	Tcl_DecrRefCount(objPtr);
	return NULL;
    }
    return objPtr;
}
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
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







-
+

+

-















+







static void
AppendPrintfToObjVA(
    Tcl_Obj *objPtr,
    const char *format,
    va_list argList)
{
    int code, objc;
    Tcl_Obj **objv, *list;
    Tcl_Obj **objv, *list = Tcl_NewObj();
    const char *p;
    char *end;

    TclNewObj(list);
    p = format;
    Tcl_IncrRefCount(list);
    while (*p != '\0') {
	int size = 0, seekingConversion = 1, gotPrecision = 0;
	int lastNum = -1;

	if (*p++ != '%') {
	    continue;
	}
	if (*p == '%') {
	    p++;
	    continue;
	}
	do {
	    switch (*p) {

	    case '\0':
		seekingConversion = 0;
		break;
	    case 's': {
		const char *q, *end, *bytes = va_arg(argList, char *);
		seekingConversion = 0;

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
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
2658
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




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
2658
2659
2660
2661
2662
2663
2664
2665

2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679

2680
2681
2682
2683
2684
2685
2686
2687







-
+



-
+






-
+








-






-
-
+
+


-
-
+
+
-
-
-
-
-
-
-
-



-
-





-

-
-
-
-
+
-



-
-
+
+



-
+
-
-
-
+


-




+

-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
+













-
+







		/*
		 * Within that buffer, we trim both ends if needed so that we
		 * copy only whole characters, and avoid copying any partial
		 * multi-byte characters.
		 */

		q = TclUtfPrev(end, bytes);
		if (!Tcl_UtfCharComplete(q, (end - q))) {
		if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
		    end = q;
		}

		q = bytes + 4;
		q = bytes + TCL_UTF_MAX;
		while ((bytes < end) && (bytes < q)
			&& ((*bytes & 0xC0) == 0x80)) {
		    bytes++;
		}

		Tcl_ListObjAppendElement(NULL, list,
			Tcl_NewStringObj(bytes , (end - bytes)));
			Tcl_NewStringObj(bytes , (int)(end - bytes)));

		break;
	    }
	    case 'c':
	    case 'i':
	    case 'u':
	    case 'd':
	    case 'o':
	    case 'p':
	    case 'x':
	    case 'X':
		seekingConversion = 0;
		switch (size) {
		case -1:
		case 0:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
			    va_arg(argList, int)));
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
			    (long int)va_arg(argList, int)));
		    break;
		case 1:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
			    va_arg(argList, long)));
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
			    va_arg(argList, long int)));
		    break;
		case 2:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
			    va_arg(argList, Tcl_WideInt)));
		    break;
		case 3:
		    Tcl_ListObjAppendElement(NULL, list, Tcl_NewBignumObj(
			    va_arg(argList, mp_int *)));
		    break;
		}
		break;
	    case 'a':
	    case 'A':
	    case 'e':
	    case 'E':
	    case 'f':
	    case 'g':
	    case 'G':
		if (size > 0) {
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
			(double)va_arg(argList, long double)));
		} else {
			Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
				va_arg(argList, double)));
			va_arg(argList, double)));
		}
		seekingConversion = 0;
		break;
	    case '*':
		lastNum = va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum));
		lastNum = (int)va_arg(argList, int);
		Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
		p++;
		break;
	    case '0': case '1': case '2': case '3': case '4':
	    case '5': case '6': case '7': case '8': case '9': {
	    case '5': case '6': case '7': case '8': case '9':
		char *end;

		lastNum = strtoul(p, &end, 10);
		lastNum = (int) strtoul(p, &end, 10);
		p = end;
		break;
	    }
	    case '.':
		gotPrecision = 1;
		p++;
		break;
	    /* TODO: support for wide (and bignum?) arguments */
	    case 'l':
		++size;
		p++;
		break;
	    case 't':
	    case 'z':
		if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
		    size = 2;
		size = 1;
		}
		p++;
		break;
	    case 'j':
	    case 'q':
		size = 2;
		p++;
		break;
	    case 'I':
		if (p[1]=='6' && p[2]=='4') {
		    p += 2;
		    size = 2;
		} else if (p[1]=='3' && p[2]=='2') {
		    p += 2;
		} else if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
		    size = 2;
		}
		p++;
		break;
	    case 'L':
		size = 3;
		p++;
		break;
	    case 'h':
		size = -1;
		/* FALLTHRU */
	    default:
		p++;
	    }
	} while (seekingConversion);
    }
    TclListObjGetElements(NULL, list, &objc, &objv);
    code = Tcl_AppendFormatToObj(NULL, objPtr, format, objc, objv);
    if (code != TCL_OK) {
	Tcl_AppendPrintfToObj(objPtr,
		"Unable to format \"%s\" with supplied arguments: %s",
		format, TclGetString(list));
		format, Tcl_GetString(list));
    }
    Tcl_DecrRefCount(list);
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_AppendPrintfToObj --
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *---------------------------------------------------------------------------
 */

void
Tcl_AppendPrintfToObj(
    Tcl_Obj *objPtr,
2671
2672
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
2700
2701
2702
2703
2704
2705
2706

2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717

2718
2719

2720
2721
2722
2723
2724
2725
2726







-
+










-
+

-







 *
 * Tcl_ObjPrintf --
 *
 * Results:
 *	A refcount zero Tcl_Obj.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ObjPrintf(
    const char *format,
    ...)
{
    va_list argList;
    Tcl_Obj *objPtr;
    Tcl_Obj *objPtr = Tcl_NewObj();

    TclNewObj(objPtr);
    va_start(argList, format);
    AppendPrintfToObjVA(objPtr, format, argList);
    va_end(argList);
    return objPtr;
}

/*
2711
2712
2713
2714
2715
2716
2717
2718

2719
2720
2721
2722
2723


2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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




3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813






3814
3815
3816
3817
3818
3819
3820
3821
3822

3823
3824
3825
3826
3827
3828
3829

3830
3831
3832
3833

3834
3835
3836

3837
3838
3839
3840
3841
3842
3843
3844
3845
3846


3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868

3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887

3888
3889
3890

3891
3892
3893
3894
3895
3896

3897
3898
3899
3900
3901

3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913

3914
3915
3916
3917
3918
3919
3920
3921
2739
2740
2741
2742
2743
2744
2745

2746
2747
2748
2749


2750
2751
2752
2753
2754
2755
2756
2757

2758


































































































































































































































2759





2760





































































































































































































































































































2761

























































































































































































































































































































































































2762
2763
2764
2765



2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
























2776


2777
2778

2779
2780

2781


2782


2783

2784

2785



2786
2787
2788

2789

2790


2791
2792


2793
2794
2795
2796
2797
2798
2799
2800



2801
2802
2803



2804





2805








2806





2807






2808










2809






















2810
2811
2812
2813
2814
2815






2816
2817
2818
2819







































2820
2821
2822
2823
2824
2825









2826







2827




2828



2829










2830
2831
















2832





2833



















2834



2835






2836





2837












2838

2839
2840
2841
2842
2843
2844
2845







-
+



-
-
+
+






-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
+
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+
-


-
+
-
-
+
-
-
+
-

-
+
-
-
-



-

-

-
-
+

-
-
+
+






-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-







 *
 *---------------------------------------------------------------------------
 */

char *
TclGetStringStorage(
    Tcl_Obj *objPtr,
    size_t *sizePtr)
    unsigned int *sizePtr)
{
    String *stringPtr;

    if (!TclHasIntRep(objPtr, &tclStringType) || objPtr->bytes == NULL) {
	return TclGetStringFromObj(objPtr, sizePtr);
    if (objPtr->typePtr != &tclStringType || objPtr->bytes == NULL) {
	return TclGetStringFromObj(objPtr, (int *)sizePtr);
    }

    stringPtr = GET_STRING(objPtr);
    *sizePtr = stringPtr->allocated;
    return objPtr->bytes;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringRepeat --
 *
 *	Performs the [string repeat] function.
 *
 * Results:
 * 	A (Tcl_Obj *) pointing to the result value, or NULL in case of an
 * 	error.
 *
 * Side effects:
 * 	On error, when interp is not NULL, error information is left in it.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringRepeat(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,
    size_t count,
    int flags)
{
    Tcl_Obj *objResultPtr;
    int inPlace = flags & TCL_STRING_IN_PLACE;
    size_t length = 0, unichar = 0, done = 1;
    int binary = TclIsPureByteArray(objPtr);

    /* assert (count >= 2) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
     * 		Error on overflow.
     */

    if (!binary) {
	if (TclHasIntRep(objPtr, &tclStringType)) {
	    String *stringPtr = GET_STRING(objPtr);
	    if (stringPtr->hasUnicode) {
		unichar = 1;
	    }
	}
    }

    if (binary) {
	/* Result will be pure byte array. Pre-size it */
	(void)TclGetByteArrayFromObj(objPtr, &length);
    } else if (unichar) {
	/* Result will be pure Tcl_UniChar array. Pre-size it. */
	(void)TclGetUnicodeFromObj(objPtr, &length);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	(void)TclGetStringFromObj(objPtr, &length);
    }

    if (length == 0) {
	/* Any repeats of empty is empty. */
	return objPtr;
    }

    if (count > INT_MAX/length) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	}
	return NULL;
    }

    if (binary) {
	/* Efficiently produce a pure byte array result */
	objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ?
		Tcl_DuplicateObj(objPtr) : objPtr;

	Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
	Tcl_SetByteArrayLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	TclAppendBytesToByteArray(objResultPtr,
		Tcl_GetByteArrayFromObj(objResultPtr, NULL),
		(count - done) * length);
    } else if (unichar) {
	/*
	 * Efficiently produce a pure Tcl_UniChar array result.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
	} else {
	    TclInvalidateStringRep(objPtr);
	    objResultPtr = objPtr;
	}

        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(count*length)));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	TclAppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
		(count - done) * length);
    } else {
	/*
	 * Efficiently concatenate string reps.
	 */

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    objResultPtr = Tcl_NewStringObj(TclGetString(objPtr), length);
	} else {
	    TclFreeIntRep(objPtr);
	    objResultPtr = objPtr;
	}
        if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"string size overflow: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			count*length));
		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    }
	    return NULL;
	}
	Tcl_SetObjLength(objResultPtr, length);
	while (count - done > done) {
	    Tcl_AppendObjToObj(objResultPtr, objResultPtr);
	    done *= 2;
	}
	Tcl_AppendToObj(objResultPtr, TclGetString(objResultPtr),
		(count - done) * length);
    }
    return objResultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringCat --
 *
 *	Performs the [string cat] function.
 *
 * Results:
 * 	A (Tcl_Obj *) pointing to the result value, or NULL in case of an
 * 	error.
 *
 * Side effects:
 * 	On error, when interp is not NULL, error information is left in it.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringCat(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj * const objv[],
    int flags)
{
    Tcl_Obj *objResultPtr, * const *ov;
    int oc, binary = 1;
	size_t length = 0;
    int allowUniChar = 1, requestUniChar = 0;
    int first = objc - 1;	/* Index of first value possibly not empty */
    int last = 0;		/* Index of last value possibly not empty */
    int inPlace = flags & TCL_STRING_IN_PLACE;

    /* assert ( objc >= 0 ) */

    if (objc <= 1) {
	/* Only one or no objects; return first or empty */
	return objc ? objv[0] : Tcl_NewObj();
    }

    /* assert ( objc >= 2 ) */

    /*
     * Analyze to determine what representation result should be.
     * GOALS:	Avoid shimmering & string rep generation.
     * 		Produce pure bytearray when possible.
     * 		Error on overflow.
     */

    ov = objv, oc = objc;
    do {
	Tcl_Obj *objPtr = *ov++;

	if (TclIsPureByteArray(objPtr)) {
	    allowUniChar = 0;
	} else if (objPtr->bytes) {
	    /* Value has a string rep. */
	    if (objPtr->length) {
		/*
		 * Non-empty string rep. Not a pure bytearray, so we won't
		 * create a pure bytearray.
		 */

	 	binary = 0;
		if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
		    /* Prevent shimmer of non-string types. */
		    allowUniChar = 0;
		}
	    }
	} else {
	    /* assert (objPtr->typePtr != NULL) -- stork! */
	    binary = 0;
	    if (TclHasIntRep(objPtr, &tclStringType)) {
		/* Have a pure Unicode value; ask to preserve it */
		requestUniChar = 1;
	    } else {
		/* Have another type; prevent shimmer */
		allowUniChar = 0;
	    }
	}
    } while (--oc && (binary || allowUniChar));

 *---------------------------------------------------------------------------
    if (binary) {
	/*
	 * Result will be pure byte array. Pre-size it
	 */

 *
	size_t numBytes = 0;
	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to count bytes for the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		(void)TclGetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */

		if (numBytes) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    length += numBytes;
		}
	    }
	} while (--oc);
    } else if (allowUniChar && requestUniChar) {
	/*
	 * Result will be pure Tcl_UniChar array. Pre-size it.
	 */

	ov = objv;
	oc = objc;
	do {
	    Tcl_Obj *objPtr = *ov++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t numChars;

		(void)TclGetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
		if (numChars) {
		    last = objc - oc;
		    if (length == 0) {
			first = last;
		    }
		    length += numChars;
		}
	    }
	} while (--oc);
    } else {
	/* Result will be concat of string reps. Pre-size it. */
	ov = objv; oc = objc;
	do {
	    Tcl_Obj *pendingPtr = NULL;

	    /*
	     * Loop until a possibly non-empty value is reached.
	     * Keep string rep generation pending when possible.
	     */

	    do {
		/* assert ( pendingPtr == NULL ) */
		/* assert ( length == 0 ) */

		Tcl_Obj *objPtr = *ov++;

		if (objPtr->bytes == NULL) {
		    /* No string rep; Take the chance we can avoid making it */
		    pendingPtr = objPtr;
		} else {
		    (void)TclGetStringFromObj(objPtr, &length); /* PANIC? */
		}
	    } while (--oc && (length == 0) && (pendingPtr == NULL));

	    /*
 	     * Either we found a possibly non-empty value, and we remember
 	     * this index as the first and last such value so far seen,
	     * or (oc == 0) and all values are known empty,
 	     * so first = last = objc - 1 signals the right quick return.
 	     */

	    first = last = objc - oc - 1;

	    if (oc && (length == 0)) {
		size_t numBytes;

		/* assert ( pendingPtr != NULL ) */

		/*
		 * There's a pending value followed by more values.  Loop over
		 * remaining values generating strings until a non-empty value
		 * is found, or the pending value gets its string generated.
		 */

		do {
		    Tcl_Obj *objPtr = *ov++;
		    (void)TclGetStringFromObj(objPtr, &numBytes); /* PANIC? */
		} while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);

		if (numBytes) {
		    last = objc -oc -1;
		}
		if (oc || numBytes) {
		    (void)TclGetStringFromObj(pendingPtr, &length);
		}
		if (length == 0) {
		    if (numBytes) {
			first = last;
		    }
		} else if (numBytes + length > (size_t)INT_MAX) {
		    goto overflow;
		}
		length += numBytes;
	    }
	} while (oc && (length == 0));

	while (oc) {
	    size_t numBytes;
	    Tcl_Obj *objPtr = *ov++;

	    /* assert ( length > 0 && pendingPtr == NULL )  */

	    TclGetString(objPtr); /* PANIC? */
	    numBytes = objPtr->length;
	    if (numBytes) {
		last = objc - oc;
		if (numBytes + length > (size_t)INT_MAX) {
		    goto overflow;
		}
		length += numBytes;
	    }
	    --oc;
	}
    }

    if (last <= first /*|| length == 0 */) {
	/* Only one non-empty value or zero length; return first */
	/* NOTE: (length == 0) implies (last <= first) */
	return objv[first];
    }

    objv += first; objc = (last - first + 1);

    if (binary) {
	/* Efficiently produce a pure byte array result */
	unsigned char *dst;

	/*
	 * Broken interface! Byte array value routines offer no way to handle
	 * failure to allocate enough space. Following stanza may panic.
	 */

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start = 0;

	    objResultPtr = *objv++; objc--;
	    (void)TclGetByteArrayFromObj(objResultPtr, &start);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
	} else {
	    objResultPtr = Tcl_NewByteArrayObj(NULL, length);
	    dst = Tcl_SetByteArrayLength(objResultPtr, length);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    /*
	     * Every argument is either a bytearray with a ("pure")
	     * value we know we can safely use, or it is an empty string.
	     * We don't need to copy bytes from the empty strings.
	     */

	    if (TclIsPureByteArray(objPtr)) {
		size_t more = 0;
		unsigned char *src = TclGetByteArrayFromObj(objPtr, &more);
		memcpy(dst, src, more);
		dst += more;
	    }
	}
    } else if (allowUniChar && requestUniChar) {
	/* Efficiently produce a pure Tcl_UniChar array result */
	Tcl_UniChar *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;

	    /* Ugly interface! Force resize of the unicode array. */
	    (void)TclGetUnicodeFromObj(objResultPtr, &start);
	    Tcl_InvalidateStringRep(objResultPtr);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetUnicode(objResultPtr) + start;
	} else {
	    Tcl_UniChar ch = 0;

	    /* Ugly interface! No scheme to init array size. */
	    objResultPtr = Tcl_NewUnicodeObj(&ch, 0);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %"
			TCL_Z_MODIFIER "u bytes",
			STRING_SIZE(length)));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = Tcl_GetUnicode(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		Tcl_UniChar *src = TclGetUnicodeFromObj(objPtr, &more);
		memcpy(dst, src, more * sizeof(Tcl_UniChar));
		dst += more;
	    }
	}
    } else {
	/* Efficiently concatenate string reps */
	char *dst;

	if (inPlace && !Tcl_IsShared(*objv)) {
	    size_t start;

	    objResultPtr = *objv++; objc--;

	    (void)TclGetStringFromObj(objResultPtr, &start);
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr) + start;

	    /* assert ( length > start ) */
	    TclFreeIntRep(objResultPtr);
	} else {
	    TclNewObj(objResultPtr);	/* PANIC? */
	    if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
		Tcl_DecrRefCount(objResultPtr);
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    	"concatenation failed: unable to alloc %" TCL_Z_MODIFIER "u bytes",
			length));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    dst = TclGetString(objResultPtr);
	}
	while (objc--) {
	    Tcl_Obj *objPtr = *objv++;

	    if ((objPtr->bytes == NULL) || (objPtr->length)) {
		size_t more;
		char *src = TclGetStringFromObj(objPtr, &more);

		memcpy(dst, src, more);
		dst += more;
	    }
	}
	/* Must NUL-terminate! */
	*dst = '\0';
    }
    return objResultPtr;

  overflow:
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
    }
    return NULL;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringCmp --
 * TclStringObjReverse --
 *	Compare two Tcl_Obj values as strings.
 *
 * Results:
 *	Like memcmp, return -1, 0, or 1.
 *
 * Side effects:
 *	String representations may be generated.  Internal representation may
 *	be changed.
 *
 *---------------------------------------------------------------------------
 */

int
TclStringCmp(
    Tcl_Obj *value1Ptr,
    Tcl_Obj *value2Ptr,
    int checkEq,		/* comparison is only for equality */
    int nocase,			/* comparison is not case sensitive */
    size_t reqlength)		/* requested length */
{
    char *s1, *s2;
    int empty, match;
    size_t length, s1len = 0, s2len = 0;
    memCmpFn_t memCmpFn;

    if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
	/*
	 * Always match at 0 chars of if it is the same obj.
	 */
	match = 0;
    } else {
	if (!nocase && TclIsPureByteArray(value1Ptr)
		&& TclIsPureByteArray(value2Ptr)) {
	    /*
	     * Use binary versions of comparisons since that won't cause undue
	     * type conversions and it is much faster. Only do this if we're
	     * case-sensitive (which is all that really makes sense with byte
	     * arrays anyway, and we have no memcasecmp() for some reason... :^)
	     */

	    s1 = (char *) TclGetByteArrayFromObj(value1Ptr, &s1len);
	    s2 = (char *) TclGetByteArrayFromObj(value2Ptr, &s2len);
	    memCmpFn = memcmp;
	} else if (TclHasIntRep(value1Ptr, &tclStringType)
		&& TclHasIntRep(value2Ptr, &tclStringType)) {
	    /*
	     * Do a unicode-specific comparison if both of the args are of
	     * String type. If the char length == byte length, we can do a
	     * memcmp. In benchmark testing this proved the most efficient
	     * check between the unicode and string comparison operations.
	     */

	    if (nocase) {
		s1 = (char *) TclGetUnicodeFromObj(value1Ptr, &s1len);
		s2 = (char *) TclGetUnicodeFromObj(value2Ptr, &s2len);
		memCmpFn = (memCmpFn_t)TclUniCharNcasecmp;
	    } else {
		s1len = Tcl_GetCharLength(value1Ptr);
		s2len = Tcl_GetCharLength(value2Ptr);
		if ((s1len == value1Ptr->length)
			&& (value1Ptr->bytes != NULL)
			&& (s2len == value2Ptr->length)
			&& (value2Ptr->bytes != NULL)) {
		    s1 = value1Ptr->bytes;
		    s2 = value2Ptr->bytes;
		    memCmpFn = memcmp;
		} else {
		    s1 = (char *) Tcl_GetUnicode(value1Ptr);
		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
		    if (
#ifdef WORDS_BIGENDIAN
			    1
#else
			    checkEq
#endif
			    ) {
			memCmpFn = memcmp;
			s1len *= sizeof(Tcl_UniChar);
			s2len *= sizeof(Tcl_UniChar);
		    } else {
			memCmpFn = (memCmpFn_t) TclUniCharNcmp;
		    }
		}
	    }
	} else {
	    empty = TclCheckEmptyString(value1Ptr);
	    if (empty > 0) {
		switch (TclCheckEmptyString(value2Ptr)) {
		case -1:
		    s1 = 0;
		    s1len = 0;
		    s2 = TclGetStringFromObj(value2Ptr, &s2len);
		    break;
		case 0:
		    match = -1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s2` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else if (TclCheckEmptyString(value2Ptr) > 0) {
		switch (empty) {
		case -1:
		    s2 = 0;
		    s2len = 0;
		    s1 = TclGetStringFromObj(value1Ptr, &s1len);
		    break;
		case 0:
		    match = 1;
		    goto matchdone;
		case 1:
		default: /* avoid warn: `s1` may be used uninitialized */
		    match = 0;
		    goto matchdone;
		}
	    } else {
		s1 = TclGetStringFromObj(value1Ptr, &s1len);
		s2 = TclGetStringFromObj(value2Ptr, &s2len);
	    }
	    if (!nocase && checkEq) {
		/*
		 * When we have equal-length we can check only for
		 * (in)equality. We can use memcmp in all (n)eq cases because
		 * we don't need to worry about lexical LE/BE variance.
		 */

		memCmpFn = memcmp;
	    } else {
		/*
		 * As a catch-all we will work with UTF-8. We cannot use
		 * memcmp() as that is unsafe with any string containing NUL
		 * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
		 * TclpUtfNcmp2 if we are case-sensitive and no specific
		 * length was requested.
		 */

		if ((reqlength == TCL_INDEX_NONE) && !nocase) {
		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
		} else {
		    s1len = Tcl_NumUtfChars(s1, s1len);
		    s2len = Tcl_NumUtfChars(s2, s2len);
		    memCmpFn = (memCmpFn_t)
			    (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
		}
	    }
	}

	length = (s1len < s2len) ? s1len : s2len;
	if (reqlength == TCL_INDEX_NONE) {
	    /*
	     * The requested length is negative, so we ignore it by setting it
	     * to length + 1 so we correct the match var.
	     */

	    reqlength = length + 1;
	} else if (reqlength > 0 && reqlength < length) {
	    length = reqlength;
	}

	if (checkEq && (s1len != s2len)) {
	    match = 1;		/* This will be reversed below. */
	} else {
	    /*
	     * The comparison function should compare up to the minimum byte
	     * length only.
	     */

	    match = memCmpFn(s1, s2, length);
	}
	if ((match == 0) && (reqlength > length)) {
	    match = s1len - s2len;
	}
	match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
    }
  matchdone:
    return match;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringFirst --
 *
 *	Implements the [string first] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	first instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringFirst(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    size_t start)
{
    size_t lh = 0, ln = Tcl_GetCharLength(needle);
    size_t value = TCL_INDEX_NONE;
    Tcl_UniChar *checkStr, *endStr, *uh, *un;
    Tcl_Obj *obj;

    if (start == TCL_INDEX_NONE) {
	start = 0;
    }
    if (ln == 0) {
	/* We don't find empty substrings.  Bizarre!
	 * Whenever this routine is turned into a proper substring
	 * finder, change to `return start` after limits imposed. */
	goto firstEnd;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *end, *check, *bh;
	unsigned char *bn = TclGetByteArrayFromObj(needle, &ln);

	/* Find bytes in bytes */
	bh = TclGetByteArrayFromObj(haystack, &lh);
	if ((lh < ln) || (start > lh - ln)) {
	    /* Don't start the loop if there cannot be a valid answer */
	    goto firstEnd;
	}
	end = bh + lh;

	check = bh + start;
	while (check + ln <= end) {
	    /*
	     * Look for the leading byte of the needle in the haystack
	     * starting at check and stopping when there's not enough room
	     * for the needle left.
	     */
	    check = (unsigned char *)memchr(check, bn[0], (end + 1 - ln) - check);
	    if (check == NULL) {
		/* Leading byte not found -> needle cannot be found. */
		goto firstEnd;
	    }
	    /* Leading byte found, check rest of needle. */
	    if (0 == memcmp(check+1, bn+1, ln-1)) {
		/* Checks! Return the successful index. */
		value = (check - bh);
		goto firstEnd;
	    }
	    /* Rest of needle match failed; Iterate to continue search. */
	    check++;
	}
	goto firstEnd;
    }

    /*
     * TODO: It might be nice to support some cases where it is not
     * necessary to shimmer to &tclStringType to compute the result,
     * and instead operate just on the objPtr->bytes values directly.
     * However, we also do not want the answer to change based on the
     * code pathway, or if it does we want that to be for some values
     * we explicitly decline to support.  Getting there will involve
     * locking down in practice more firmly just what encodings produce
     * what supported results for the objPtr->bytes values.  For now,
     * do only the well-defined Tcl_UniChar array search.
     */

    un = TclGetUnicodeFromObj(needle, &ln);
    uh = TclGetUnicodeFromObj(haystack, &lh);
    if ((lh < ln) || (start > lh - ln)) {
	/* Don't start the loop if there cannot be a valid answer */
	goto firstEnd;
    }
    endStr = uh + lh;

    for (checkStr = uh + start; checkStr + ln <= endStr; checkStr++) {
	if ((*checkStr == *un) && (0 ==
		memcmp(checkStr + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
	    value =  (checkStr - uh);
	    goto firstEnd;
	}
    }
  firstEnd:
    TclNewIndexObj(obj, value);
    return obj;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringLast --
 *
 *	Implements the [string last] operation.
 *
 * Results:
 *	If needle is found as a substring of haystack, the index of the
 *	last instance of such a find is returned.  If needle is not present
 *	as a substring of haystack, -1 is returned.
 *
 * Side effects:
 *	needle and haystack may have their Tcl_ObjType changed.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringLast(
    Tcl_Obj *needle,
    Tcl_Obj *haystack,
    size_t last)
{
    size_t lh = 0, ln = Tcl_GetCharLength(needle);
    size_t value = TCL_INDEX_NONE;
    Tcl_UniChar *checkStr, *uh, *un;
    Tcl_Obj *obj;

    if (ln == 0) {
	/*
	 * 	We don't find empty substrings.  Bizarre!
	 *
	 * 	TODO: When we one day make this a true substring
	 * 	finder, change this to "return last", after limitation.
	 */
	goto lastEnd;
    }

    if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
	unsigned char *check, *bh = TclGetByteArrayFromObj(haystack, &lh);
	unsigned char *bn = TclGetByteArrayFromObj(needle, &ln);

	if (last + 1 >= lh + 1) {
	    last = lh - 1;
	}
	if (last + 1 < ln) {
	    /* Don't start the loop if there cannot be a valid answer */
	    goto lastEnd;
	}
	check = bh + last + 1 - ln;

	while (check >= bh) {
	    if ((*check == bn[0])
		    && (0 == memcmp(check+1, bn+1, ln-1))) {
		value = (check - bh);
		goto lastEnd;
	    }
	    check--;
	}
	goto lastEnd;
    }

    uh = TclGetUnicodeFromObj(haystack, &lh);
    un = TclGetUnicodeFromObj(needle, &ln);

    if (last + 1 >= lh + 1) {
	last = lh - 1;
    }
    if (last + 1 < ln) {
	/* Don't start the loop if there cannot be a valid answer */
	goto lastEnd;
    }
    checkStr = uh + last + 1 - ln;
    while (checkStr >= uh) {
	if ((*checkStr == un[0])
		&& (0 == memcmp(checkStr+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
	    value = (checkStr - uh);
	    goto lastEnd;
	}
	checkStr--;
    }
  lastEnd:
    TclNewIndexObj(obj, value);
    return obj;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclStringReverse --
 *
 *	Implements the [string reverse] operation.
 *
 * Results:
 *	A Tcl value which is the [string reverse] of the argument supplied.
 *	When sharing rules permit and the caller requests, the returned value
 *	might be the argument with modifications done in place.
 *	An unshared Tcl value which is the [string reverse] of the argument
 *	supplied.  When sharing rules permit, the returned value might be
 *	the argument with modifications done in place.
 *
 * Side effects:
 *	May allocate a new Tcl_Obj.
 *
 *---------------------------------------------------------------------------
 */

static void
ReverseBytes(
    unsigned char *to,		/* Copy bytes into here... */
    unsigned char *from,	/* ...from here... */
    size_t count)		/* Until this many are copied, */
				/* reversing as you go. */
{
    unsigned char *src = from + count;

    if (to == from) {
	/* Reversing in place */
	while (--src > to) {
	    unsigned char c = *src;

	    *src = *to;
	    *to++ = c;
	}
    } else {
	while (--src >= from) {
	    *to++ = *src;
	}
    }
}

Tcl_Obj *
TclStringReverse(
    Tcl_Obj *objPtr,
TclStringObjReverse(
    Tcl_Obj *objPtr)
    int flags)
{
    String *stringPtr;
    Tcl_UniChar ch = 0;
    int numChars = Tcl_GetCharLength(objPtr);
    int inPlace = flags & TCL_STRING_IN_PLACE;

    int i = 0, lastCharIdx = numChars - 1;
    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes = 0;
    char *bytes;
	unsigned char *from = TclGetByteArrayFromObj(objPtr, &numBytes);

	if (!inPlace || Tcl_IsShared(objPtr)) {
    if (numChars <= 1) {
	    objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
	}
	ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
	return objPtr;
    }

    SetStringFromAny(NULL, objPtr);
    stringPtr = GET_STRING(objPtr);

    if (stringPtr->hasUnicode) {
	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
	Tcl_UniChar *src = from + stringPtr->numChars;
	Tcl_UniChar *source = stringPtr->unicode;

	if (!inPlace || Tcl_IsShared(objPtr)) {
	    Tcl_UniChar *to;
	if (Tcl_IsShared(objPtr)) {
	    Tcl_UniChar *dest, ch = 0;

	    /*
	     * Create a non-empty, pure unicode value, so we can coax
	     * Tcl_SetObjLength into growing the unicode rep buffer.
	     */

	    objPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
	    to = Tcl_GetUnicode(objPtr);
	    Tcl_Obj *resultPtr = Tcl_NewUnicodeObj(&ch, 1);
	    Tcl_SetObjLength(resultPtr, numChars);
	    dest = Tcl_GetUnicode(resultPtr);
	    while (--src >= from) {
		*to++ = *src;
	    }

	} else {
	    /*
	     * Reversing in place.
	     */

	    while (i < numChars) {
	    while (--src > from) {
		ch = *src;
		*src = *from;
		*from++ = ch;
	    }
	}
    }

		dest[i++] = source[lastCharIdx--];
    if (objPtr->bytes) {
	size_t numChars = stringPtr->numChars;
	size_t numBytes = objPtr->length;
	char *to, *from = objPtr->bytes;

	    }
	if (!inPlace || Tcl_IsShared(objPtr)) {
	    TclNewObj(objPtr);
	    Tcl_SetObjLength(objPtr, numBytes);
	}
	to = objPtr->bytes;

	    return resultPtr;
	if ((numChars == TCL_INDEX_NONE) || (numChars < numBytes)) {
	    /*
	     * Either numChars == -1 and we don't know how many chars are
	     * represented by objPtr->bytes and we need Pass 1 just in case,
	     * or numChars >= 0 and we know we have fewer chars than bytes, so
	     * we know there's a multibyte character needing Pass 1.
	     *
	     * Pass 1. Reverse the bytes of each multi-byte character.
	     */

	}
	    size_t charCount = 0;
	    size_t bytesLeft = numBytes;

	    while (bytesLeft) {
		/*
		 * NOTE: We know that the from buffer is NUL-terminated. It's
		 * part of the contract for objPtr->bytes values. Thus, we can
		 * skip calling Tcl_UtfCharComplete() here.
		 */

		size_t bytesInChar = TclUtfToUniChar(from, &ch);

		ReverseBytes((unsigned char *)to, (unsigned char *)from,
			bytesInChar);
		to += bytesInChar;
		from += bytesInChar;
		bytesLeft -= bytesInChar;
		charCount++;
	    }

	    from = to = objPtr->bytes;
	    stringPtr->numChars = charCount;

	while (i < lastCharIdx) {
	    Tcl_UniChar tmp = source[lastCharIdx];
	    source[lastCharIdx--] = source[i];
	    source[i++] = tmp;
	}
	/* Pass 2. Reverse all the bytes. */
	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
    }

    return objPtr;
}
	TclInvalidateStringRep(objPtr);
	stringPtr->allocated = 0;
	return objPtr;
    }

/*
 *---------------------------------------------------------------------------
 *
 * TclStringReplace --
 *
 *	Implements the inner engine of the [string replace] and
 *	[string insert] commands.
 *
 *	The result is a concatenation of a prefix from objPtr, characters
 *	0 through first-1, the insertPtr string value, and a suffix from
 *	objPtr, characters from first + count to the end. The effect is as if
 *	the inner substring of characters first through first+count-1 are
 *	removed and replaced with insertPtr. If insertPtr is NULL, it is
 *	treated as an empty string. When passed the flag TCL_STRING_IN_PLACE,
 *	this routine will try to do the work within objPtr, so long as no
 *	sharing forbids it. Without that request, or as needed, a new Tcl
 *	value will be allocated to be the result.
 *
 * Results:
 *	A Tcl value that is the result of the substring replacement. May
 *	return NULL in case of an error. When NULL is returned and interp is
 *	non-NULL, error information is left in interp
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclStringReplace(
    Tcl_Interp *interp,		/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,		/* String to act upon */
    size_t first,		/* First index to replace */
    size_t count,		/* How many chars to replace */
    Tcl_Obj *insertPtr,		/* Replacement string, may be NULL */
    int flags)			/* TCL_STRING_IN_PLACE => attempt in-place */
{
    int inPlace = flags & TCL_STRING_IN_PLACE;
    Tcl_Obj *result;


    bytes = TclGetString(objPtr);
    if (Tcl_IsShared(objPtr)) {
	char *dest;
	Tcl_Obj *resultPtr = Tcl_NewObj();
	Tcl_SetObjLength(resultPtr, numChars);
    /* Replace nothing with nothing */
    if ((insertPtr == NULL) && (count == 0)) {
	if (inPlace) {
	    return objPtr;
	} else {
	    return Tcl_DuplicateObj(objPtr);
	}
    }

	dest = TclGetString(resultPtr);
    /*
     * The caller very likely had to call Tcl_GetCharLength() or similar
     * to be able to process index values.  This means it is likely that
     * objPtr is either a proper "bytearray" or a "string" or else it has
     * a known and short string rep.
     */

	while (i < numChars) {
    if (TclIsPureByteArray(objPtr)) {
	size_t numBytes = 0;
	unsigned char *bytes = TclGetByteArrayFromObj(objPtr, &numBytes);

	    dest[i++] = bytes[lastCharIdx--];
	if (insertPtr == NULL) {
	    /* Replace something with nothing. */

	}
	    assert ( first <= numBytes ) ;
	    assert ( count <= numBytes ) ;
	    assert ( first + count <= numBytes ) ;

	    result = Tcl_NewByteArrayObj(NULL, numBytes - count);/* PANIC? */
	    TclAppendBytesToByteArray(result, bytes, first);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}
	return resultPtr;
    }

	/* Replace everything */
	if ((first == 0) && (count == numBytes)) {
	    return insertPtr;
	}

	if (TclIsPureByteArray(insertPtr)) {
	    size_t newBytes = 0;
	    unsigned char *iBytes
		    = TclGetByteArrayFromObj(insertPtr, &newBytes);

	    if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
		/*
		 * Removal count and replacement count are equal.
		 * Other conditions permit. Do in-place splice.
		 */

		memcpy(bytes + first, iBytes, count);
		Tcl_InvalidateStringRep(objPtr);
		return objPtr;
	    }

    while (i < lastCharIdx) {
	    if ((size_t)newBytes > INT_MAX - (numBytes - count)) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "max size for a Tcl value (%d bytes) exceeded",
			    INT_MAX));
		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
		}
		return NULL;
	    }
	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
								/* PANIC? */
	    Tcl_SetByteArrayLength(result, 0);
	    TclAppendBytesToByteArray(result, bytes, first);
	    TclAppendBytesToByteArray(result, iBytes, newBytes);
	    TclAppendBytesToByteArray(result, bytes + first + count,
		    numBytes - count - first);
	    return result;
	}

	char tmp = bytes[lastCharIdx];
	/* Flow through to try other approaches below */
    }

	bytes[lastCharIdx--] = bytes[i];
    /*
     * TODO: Figure out how not to generate a Tcl_UniChar array rep
     * when it can be determined objPtr->bytes points to a string of
     * all single-byte characters so we can index it directly.
     */

	bytes[i++] = tmp;
    /* The traditional implementation... */
    {
	size_t numChars;
	Tcl_UniChar *ustring = TclGetUnicodeFromObj(objPtr, &numChars);

    }
	/* TODO: Is there an in-place option worth pursuing here? */

	result = Tcl_NewUnicodeObj(ustring, first);
	if (insertPtr) {
	    Tcl_AppendObjToObj(result, insertPtr);
	}
	if (first + count < (size_t)numChars) {
	    TclAppendUnicodeToObj(result, ustring + first + count,
		    numChars - first - count);
	}

	return result;
    return objPtr;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * FillUnicodeRep --
 *
3932
3933
3934
3935
3936
3937
3938
3939
3940


3941
3942
3943
3944

3945
3946
3947
3948

3949
3950
3951
3952


3953
3954
3955
3956
3957


3958
3959

3960
3961

3962
3963
3964
3965




3966
3967
3968

3969

3970
3971
3972
3973
3974
3975
3976





3977
3978
3979


3980
3981
3982
3983
3984
3985
3986
2856
2857
2858
2859
2860
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







-
-
+
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
+
+

-
+
-
-
+
-
-
-
-
+
+
+
+



+
-
+
-
-
-
-
-
-
-
+
+
+
+
+
-


+
+







 */

static void
FillUnicodeRep(
    Tcl_Obj *objPtr)		/* The object in which to fill the unicode
				 * rep. */
{
    String *stringPtr = GET_STRING(objPtr);

    String *stringPtr;
    size_t uallocated;
    ExtendUnicodeRepWithString(objPtr, objPtr->bytes, objPtr->length,
	    stringPtr->numChars);
}

    char *srcEnd, *src = objPtr->bytes;
static void
ExtendUnicodeRepWithString(
    Tcl_Obj *objPtr,
    const char *bytes,
    Tcl_UniChar *dst;
    size_t numBytes,
    size_t numAppendChars)
{
    String *stringPtr = GET_STRING(objPtr);

    stringPtr = GET_STRING(objPtr);
    size_t needed, numOrigChars = 0;
    Tcl_UniChar *dst, unichar = 0;

    if (stringPtr->hasUnicode) {
	numOrigChars = stringPtr->numChars;
    if (stringPtr->numChars == -1) {
	stringPtr->numChars = Tcl_NumUtfChars(src, objPtr->length);
    }
    if (numAppendChars == TCL_INDEX_NONE) {
    stringPtr->hasUnicode = (stringPtr->numChars > 0);
	TclNumUtfChars(numAppendChars, bytes, numBytes);
    }

    needed = numOrigChars + numAppendChars;

    if (needed > stringPtr->maxChars) {
	GrowUnicodeBuffer(objPtr, needed);
    stringCheckLimits(stringPtr->numChars);
    uallocated = STRING_UALLOC(stringPtr->numChars);
    if (uallocated > stringPtr->uallocated) {
	GrowUnicodeBuffer(objPtr, stringPtr->numChars);
	stringPtr = GET_STRING(objPtr);
    }

    /*
    stringPtr->hasUnicode = 1;
     * Convert src to Unicode and store the coverted data in "unicode".
    if (bytes) {
	stringPtr->numChars = needed;
    } else {
	numAppendChars = 0;
    }
    for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
	bytes += TclUtfToUniChar(bytes, &unichar);
     */

    srcEnd = src + objPtr->length;
    for (dst = stringPtr->unicode; src < srcEnd; dst++) {
	src += TclUtfToUniChar(src, dst);
	*dst = unichar;
    }
    *dst = 0;

    SET_STRING(objPtr, stringPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * DupStringInternalRep --
 *
3995
3996
3997
3998
3999
4000
4001
4002

4003
4004

4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015






4016
4017
4018
4019
4020

4021
4022

4023
4024
4025


4026
4027
4028
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
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







-
+

-
+





-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
-

-
+

-
-
-
-

-

+
+







-
+







 *	representation.
 *
 *----------------------------------------------------------------------
 */

static void
DupStringInternalRep(
    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. Must have
    register Tcl_Obj *srcPtr,	/* Object with internal rep to copy. Must have
				 * an internal rep of type "String". */
    Tcl_Obj *copyPtr)		/* Object with internal rep to set. Must not
    register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
				 * currently have an internal rep.*/
{
    String *srcStringPtr = GET_STRING(srcPtr);
    String *copyStringPtr = NULL;

    if (srcStringPtr->numChars == TCL_INDEX_NONE) {
	/*
	 * The String struct in the source value holds zero useful data. Don't
	 * bother copying it. Don't even bother allocating space in which to
	 * copy it. Just let the copy be untyped.
	 */
    /*
     * If the src obj is a string of 1-byte Utf chars, then copy the string
     * rep of the source object and create an "empty" Unicode internal rep for
     * the new object. Otherwise, copy Unicode internal rep, and invalidate
     * the string rep of the new object.
     */

	return;
    }

    if (srcStringPtr->hasUnicode) {
    if (srcStringPtr->hasUnicode == 0) {
	int copyMaxChars;

	copyStringPtr = (String *) ckalloc(sizeof(String));
	if (srcStringPtr->maxChars / 2 >= srcStringPtr->numChars) {
	    copyMaxChars = 2 * srcStringPtr->numChars;
	} else {
	copyStringPtr->uallocated = 0;
    } else {
	    copyMaxChars = srcStringPtr->maxChars;
	}
	copyStringPtr = stringAttemptAlloc(copyMaxChars);
	if (copyStringPtr == NULL) {
	    copyMaxChars = srcStringPtr->numChars;
	    copyStringPtr = stringAlloc(copyMaxChars);
	}
	copyStringPtr = (String *) ckalloc(
		STRING_SIZE(srcStringPtr->uallocated));
	copyStringPtr->uallocated = srcStringPtr->uallocated;

	copyStringPtr->maxChars = copyMaxChars;
	memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
		srcStringPtr->numChars * sizeof(Tcl_UniChar));
		(size_t) srcStringPtr->numChars * sizeof(Tcl_UniChar));
	copyStringPtr->unicode[srcStringPtr->numChars] = 0;
    } else {
	copyStringPtr = stringAlloc(0);
	copyStringPtr->maxChars = 0;
	copyStringPtr->unicode[0] = 0;
    }
    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
    copyStringPtr->numChars = srcStringPtr->numChars;
    copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
    copyStringPtr->allocated = srcStringPtr->allocated;

    /*
     * Tricky point: the string value was copied by generic object management
     * code, so it doesn't contain any extra bytes that might exist in the
     * source object.
     */

    copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
    copyStringPtr->allocated = copyPtr->length;

    SET_STRING(copyPtr, copyStringPtr);
    copyPtr->typePtr = &tclStringType;
}

/*
 *----------------------------------------------------------------------
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
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







-
-
+
+

+
+
+
+
+
+
-
-
+
+

-
-
+
+
+
-
-
+
-
-
-
+
+
+
+

-
+
-


+

-
-
+

+
+
+
+
+
+
+
+
+

-







 *	representation is set to "String".
 *
 *----------------------------------------------------------------------
 */

static int
SetStringFromAny(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *objPtr)		/* The object to convert. */
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    register Tcl_Obj *objPtr)	/* The object to convert. */
{
    /*
     * The Unicode object is optimized for the case where each UTF char in a
     * string is only one byte. In this case, we store the value of numChars,
     * but we don't copy the bytes to the unicodeObj->unicode.
     */

    if (!TclHasIntRep(objPtr, &tclStringType)) {
	String *stringPtr = stringAlloc(0);
    if (objPtr->typePtr != &tclStringType) {
	String *stringPtr;

	/*
	 * Convert whatever we have into an untyped value. Just A String.
	if (objPtr->typePtr != NULL) {
	    if (objPtr->bytes == NULL) {
		objPtr->typePtr->updateStringProc(objPtr);
	 */

	    }
	(void) TclGetString(objPtr);
	TclFreeIntRep(objPtr);

	    TclFreeIntRep(objPtr);
	}
	objPtr->typePtr = &tclStringType;

	/*
	 * Create a basic String intrep that just points to the UTF-8 string
	 * Allocate enough space for the basic String structure.
	 * already in place at objPtr->bytes.
	 */

	stringPtr = (String *) ckalloc(sizeof(String));
	stringPtr->numChars = -1;
	stringPtr->allocated = objPtr->length;
	stringPtr->maxChars = 0;
	stringPtr->uallocated = 0;
	stringPtr->hasUnicode = 0;

	if (objPtr->bytes != NULL) {
	    stringPtr->allocated = objPtr->length;
            if (objPtr->bytes != tclEmptyStringRep) {
	        objPtr->bytes[objPtr->length] = 0;
            }
	} else {
	    objPtr->length = 0;
	}
	SET_STRING(objPtr, stringPtr);
	objPtr->typePtr = &tclStringType;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
3033
3034
3035
3036
3037
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







+
+
+
+
-
+

+
+
+
-
+
-
-
+
+
-
-
-
-
+

-
-
+
-
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+

+
-
-
-
-
+
+
+
+
+
+
-
-
-

+
+
-
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
+







 *----------------------------------------------------------------------
 */

static void
UpdateStringOfString(
    Tcl_Obj *objPtr)		/* Object with string rep to update. */
{
    int i, size;
    Tcl_UniChar *unicode;
    char dummy[TCL_UTF_MAX];
    char *dst;
    String *stringPtr = GET_STRING(objPtr);
    String *stringPtr;

    stringPtr = GET_STRING(objPtr);
    if ((objPtr->bytes == NULL) || (stringPtr->allocated == 0)) {
	if (stringPtr->numChars <= 0) {
    /*
	    /*
     * This routine is only called when we need to generate the
     * string rep objPtr->bytes because it does not exist -- it is NULL.
	     * If there is no Unicode rep, or the string has 0 chars, then set
	     * the string rep to an empty string.
     * In that circumstance, any lingering claim about the size of
     * memory pointed to by that NULL pointer is clearly bogus, and
     * needs a reset.
     */
	     */

    stringPtr->allocated = 0;

	    objPtr->bytes = tclEmptyStringRep;
    if (stringPtr->numChars == 0) {
	TclInitStringRep(objPtr, NULL, 0);
    } else {
	    objPtr->length = 0;
	    return;
	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
		stringPtr->numChars);
    }
}

	}

	unicode = stringPtr->unicode;
static size_t
ExtendStringRepWithUnicode(
    Tcl_Obj *objPtr,
    const Tcl_UniChar *unicode,
    size_t numChars)
{
    /*
     * Pre-condition: this is the "string" Tcl_ObjType.
     */

	/*
	 * Translate the Unicode string to UTF. "size" will hold the amount of
	 * space the UTF string needs.
	 */

    size_t i, origLength, size = 0;
    char *dst;
    String *stringPtr = GET_STRING(objPtr);

    if (numChars == TCL_INDEX_NONE) {
	numChars = UnicodeLength(unicode);
    }

    if (numChars == 0) {
	return 0;
    }


	if (stringPtr->numChars <= INT_MAX/TCL_UTF_MAX
    if (objPtr->bytes == NULL) {
	objPtr->length = 0;
    }
    size = origLength = objPtr->length;

    /*
     * Quick cheap check in case we have more than enough room.
     */

    if (numChars <= (INT_MAX - size)/TCL_UTF_MAX
	    && stringPtr->allocated >= size + numChars * TCL_UTF_MAX) {
	goto copyBytes;
    }
	    && stringPtr->allocated >= stringPtr->numChars * (size_t)TCL_UTF_MAX) {
	    goto copyBytes;
	}

	size = 0;
    for (i = 0; i < numChars; i++) {
	size += TclUtfCount(unicode[i]);
    }

	for (i = 0; i < stringPtr->numChars && size >= 0; i++) {
	    size += Tcl_UniCharToUtf((int) unicode[i], dummy);
	}
	if (size < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    /*
     * Grow space if needed.
     */

	objPtr->bytes = (char *) ckalloc((unsigned) (size + 1));
	objPtr->length = size;
    if (size > stringPtr->allocated) {
	stringPtr->allocated = size;
	GrowStringBuffer(objPtr, size, 1);
    }


  copyBytes:
    dst = objPtr->bytes + origLength;
    for (i = 0; i < numChars; i++) {
	dst += Tcl_UniCharToUtf(unicode[i], dst);
    }
    *dst = '\0';
    copyBytes:
	dst = objPtr->bytes;
	for (i = 0; i < stringPtr->numChars; i++) {
	    dst += Tcl_UniCharToUtf(unicode[i], dst);
	}
	*dst = '\0';
    objPtr->length = dst - objPtr->bytes;
    return numChars;
    }
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * FreeStringInternalRep --
 *
4218
4219
4220
4221
4222
4223
4224
4225

4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
3107
3108
3109
3110
3111
3112
3113

3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124







-
+










 *----------------------------------------------------------------------
 */

static void
FreeStringInternalRep(
    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
{
    Tcl_Free(GET_STRING(objPtr));
    ckfree((char *) GET_STRING(objPtr));
    objPtr->typePtr = NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclStringRep.h.

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






























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclStringRep.h --
 *
 *	This file contains the definition of the Unicode string internal
 *	representation and macros to access it.
 *
 *	A Unicode string is an internationalized string. Conceptually, a
 *	Unicode string is an array of 16-bit quantities organized as a
 *	sequence of properly formed UTF-8 characters. There is a one-to-one
 *	map between Unicode and UTF characters. Because Unicode characters
 *	have a fixed width, operations such as indexing operate on Unicode
 *	data. The String object is optimized for the case where each UTF char
 *	in a string is only one byte. In this case, we store the value of
 *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
 *	is explicitly called).
 *
 *	The String object type stores one or both formats. The default
 *	behavior is to store UTF. Once Unicode is calculated by a function, it
 *	is stored in the internal rep for future access (without an additional
 *	O(n) cost).
 *
 *	To allow many appends to be done to an object without constantly
 *	reallocating the space for the string or Unicode representation, we
 *	allocate double the space for the string or Unicode and use the
 *	internal representation to keep track of how much space is used vs.
 *	allocated.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 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.
 */

#ifndef _TCLSTRINGREP
#define _TCLSTRINGREP


/*
 * The following structure is the internal rep for a String object. It keeps
 * track of how much memory has been used and how much has been allocated for
 * the Unicode and UTF string to enable growing and shrinking of the UTF and
 * Unicode reps of the String object with fewer mallocs. To optimize string
 * length and indexing operations, this structure also stores the number of
 * characters (same of UTF and Unicode!) once that value has been computed.
 *
 * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
 * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
 * can be officially modified by altering the definition of Tcl_UniChar in
 * tcl.h, but do not do that unless you are sure what you're doing!
 */

typedef struct {
    size_t numChars;		/* The number of chars in the string. -1 means
				 * this value has not been calculated. Any other
				 * means that there is a valid Unicode rep, or
				 * that the number of UTF bytes == the number
				 * of chars. */
    size_t allocated;		/* The amount of space actually allocated for
				 * the UTF string (minus 1 byte for the
				 * termination char). */
    size_t maxChars;		/* Max number of chars that can fit in the
				 * space allocated for the unicode array. */
    int hasUnicode;		/* Boolean determining whether the string has
				 * a Unicode representation. */
    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Unicode chars. The actual size
				 * of this field depends on the 'maxChars'
				 * field above. */
} String;

#define STRING_SIZE(numChars) \
    (offsetof(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar)))
#define stringAttemptAlloc(numChars) \
    (String *) Tcl_AttemptAlloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
    (String *) Tcl_Alloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
    (String *) Tcl_Realloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
    (String *) Tcl_AttemptRealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
    ((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
    ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL),			\
    ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))

#endif /*  _TCLSTRINGREP */
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclStringTrim.h.

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













































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclStringTrim.h --
 *
 *	This file contains the definition of what characters are to be trimmed
 *	from a string by [string trim] by default. It's only needed by Tcl's
 *	implementation; it does not form a public or private API at all.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Scriptics Corporation.
 * Copyright (c) 2002 ActiveState Corporation.
 * Copyright (c) 2003-2013 Donal K. Fellows.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef TCL_STRING_TRIM_H
#define TCL_STRING_TRIM_H

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters. [TIP #413]
 */

MODULE_SCOPE const char tclDefaultTrimSet[];

/*
 * The whitespace trimming set used when [concat]enating. This is a subset of
 * the above, and deliberately so.
 *
 * TODO: Find a reasonable way to guarantee in sync with TclIsSpaceProc()
 */

#define CONCAT_TRIM_SET " \f\v\r\t\n"

#endif /* TCL_STRING_TRIM_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclStubInit.c.

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

69
70
71
72
73
74
75
76
77
















78
79

80
81
82
83
84
85



86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115






116
117
118
119

120
121
122
123

124
125
126



127
128


129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145












146
147
148
149
150
151
152
153
154
155
156

157
158
159
160
161
162
163
164
165


















166




167







168
169
170























171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186


187


188
189
190
191
192
193
194
195

























196



197


198
199
200
201
202
203
204
205






















206
207
208
209
210

211
212
213
214
215



216
217
218
219
220
221
222
223
224
225
226

227
228
229
230
231



232
233
234
235
236
237




238
239
240
241

242
243
244
245
246
247











248



249

250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271

272
273
274
275
276




277
278

279
280
281
282

283
284
285
286
287

288
289

290
291
292
293
294
295





296
297
298
299
300
301


302
303
304


305
306
307
308
309
310




311
312
313
314
315
316
317

318
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
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
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
611
612

613
614
615
616
617
618
619
620




621
622
623
624
625
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
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
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
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

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
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
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
611
612


613
614
615
616
617
618
619
620
621
622
623
624

625
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
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
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
897
898
899
900












-
+
-
-
-
-
-
-
-
-
-
-
-














-


-
-
-
-




-
-
-
-


-
-
-



-
-
-

-
-
-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-


-
+


-



-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+















-
+
+

+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
+
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+



-
-
+
+
+










-
+



-
-
+
+
+






+
+
+
+



-
+



-
-
-
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
+







-
-
-
-
-
-
-
-
-
-
-
-


-
+

-
-
-
-
+
+
+
+

-
+



-
+




-
+

-
+

-
-
-
-
-
+
+
+
+
+




-
-
+
+

-
-
+
+


-
-
-
-
+
+
+
+






-
+



-
-
-
-
+
+
+
+

-
+



-
-
+
+

-
+





-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+



-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+



-
-
+
+



-
-
+
+



-
-
-
-
+
+
+
+




-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+

-
+





-
-
-
-
-
+
+
+
+
+

-
-
+
+













-
-
+
+


-
-
-
+
+
+






-
-
+
+





-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+









-
-
-
+
+
+







-
-
-
-
-
+
+
+
+
+




-
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
+


-
+

-
-
+
+





-
+




-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-

-
+

-
-
-
+
+
+


-
-
+
+

-
-
+
+










-
+

-
+

-
-
+
+

-
+

-







-
+




-
-
-
-
+
+
+
+






-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-



-
+

+
+
+
+
-
+
+
+

-
+

+



-
+

-
+

















-
+

-
+



















-
-
+
+



-
-
-
-
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+





-
+











-
+


-
-
+
+




-
+


-
-
+
+















-
+



-
+









-
+












-
+


-
+

-
+


-
+



-
+

-
+


-
-
+
+








-
-
+
+



-
+













-
+

-
+







/*
 * tclStubInit.c --
 *
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * 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"
#include "tommath_private.h"
#include "tommath.h"
#include "tclTomMath.h"

#ifdef __CYGWIN__
#   include <wchar.h>
#endif

#ifdef __GNUC__
#pragma GCC dependency "tcl.decls"
#pragma GCC dependency "tclInt.decls"
#pragma GCC dependency "tclTomMath.decls"
#endif

/*
 * Remove macros that will interfere with the definitions below.
 */

#undef Tcl_Alloc
#undef Tcl_Free
#undef Tcl_Realloc
#undef Tcl_NewBooleanObj
#undef Tcl_NewByteArrayObj
#undef Tcl_NewDoubleObj
#undef Tcl_NewIntObj
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
#undef Tcl_DbNewLongObj
#undef Tcl_NewObj
#undef Tcl_NewStringObj
#undef Tcl_GetUnicode
#undef Tcl_GetUnicodeFromObj
#undef Tcl_NewUnicodeObj
#undef Tcl_SetUnicodeObj
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
#undef Tcl_SetExitProc
#undef Tcl_SetPanicProc
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
#undef TclWinNToHS
#undef TclStaticPackage
#undef Tcl_BackgroundError
#define TclStaticPackage Tcl_StaticPackage
#undef Tcl_UniCharToUtfDString
#undef Tcl_UtfToUniCharDString
#undef Tcl_UtfToUniChar
#define TclUnusedStubEntry NULL

#if TCL_UTF_MAX <= 3
static void uniCodePanic() {
    Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
}
#   define Tcl_GetUnicode (int *(*)(Tcl_Obj *))(void *)uniCodePanic
#   define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
#   define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, size_t))(void *)uniCodePanic
#   define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, size_t))(void *)uniCodePanic
/*
 * Keep a record of the original Notifier procedures, created in the
 * same compilation unit as the stub tables so we can later do reliable,
 * portable comparisons to see whether a Tcl_SetNotifier() call swapped
 * new routines into the stub table.
 */

Tcl_NotifierProcs tclOriginalNotifier = {
    Tcl_SetTimer,
    Tcl_WaitForEvent,
#if !defined(__WIN32__) /* UNIX */
    Tcl_CreateFileHandler,
    Tcl_DeleteFileHandler,
#else
    NULL,
    NULL,
#endif

    NULL,
#define TclBN_mp_add mp_add
#define TclBN_mp_add_d mp_add_d
#define TclBN_mp_and mp_and
#define TclBN_mp_clamp mp_clamp
#define TclBN_mp_clear mp_clear
#define TclBN_mp_clear_multi mp_clear_multi
    NULL,
    NULL,
    NULL
#define TclBN_mp_cmp mp_cmp
#define TclBN_mp_cmp_d mp_cmp_d
#define TclBN_mp_cmp_mag mp_cmp_mag
#define TclBN_mp_cnt_lsb mp_cnt_lsb
#define TclBN_mp_copy mp_copy
#define TclBN_mp_count_bits mp_count_bits
#define TclBN_mp_div mp_div
#define TclBN_mp_div_d mp_div_d
#define TclBN_mp_div_2 mp_div_2
#define TclBN_mp_div_2d mp_div_2d
#define TclBN_mp_exch mp_exch
#define TclBN_mp_expt_u32 mp_expt_u32
#define TclBN_mp_get_mag_u64 mp_get_mag_u64
#define TclBN_mp_grow mp_grow
#define TclBN_mp_init mp_init
#define TclBN_mp_init_copy mp_init_copy
#define TclBN_mp_init_multi mp_init_multi
#define TclBN_mp_init_set mp_init_set
#define TclBN_mp_init_size mp_init_size
#define TclBN_mp_init_i64 mp_init_i64
#define TclBN_mp_init_u64 mp_init_u64
#define TclBN_mp_lshd mp_lshd
#define TclBN_mp_mod mp_mod
#define TclBN_mp_mod_2d mp_mod_2d
#define TclBN_mp_mul mp_mul
#define TclBN_mp_mul_d mp_mul_d
#define TclBN_mp_mul_2 mp_mul_2
#define TclBN_mp_mul_2d mp_mul_2d
#define TclBN_mp_neg mp_neg
#define TclBN_mp_or mp_or
};

/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#ifdef _WIN64
#   define TclSockMinimumBuffersOld 0
#else
#define TclBN_mp_radix_size mp_radix_size
#define TclBN_mp_reverse mp_reverse
#define TclBN_mp_read_radix mp_read_radix
#define TclBN_mp_rshd mp_rshd
int TclSockMinimumBuffersOld(sock, size)
#define TclBN_mp_set_i64 mp_set_i64
#define TclBN_mp_set_u64 mp_set_u64
#define TclBN_mp_shrink mp_shrink
#define TclBN_mp_sqr mp_sqr
    int sock;
#define TclBN_mp_sqrt mp_sqrt
#define TclBN_mp_sub mp_sub
#define TclBN_mp_sub_d mp_sub_d
    int size;
{
    return TclSockMinimumBuffers(INT2PTR(sock), size);
#define TclBN_mp_signed_rsh mp_signed_rsh
#define TclBN_mp_to_radix mp_to_radix
}
#endif
#define TclBN_mp_to_ubin mp_to_ubin
#define TclBN_mp_ubin_size mp_ubin_size
#define TclBN_mp_xor mp_xor
#define TclBN_mp_zero mp_zero
#define TclBN_s_mp_add s_mp_add
#define TclBN_s_mp_balance_mul mp_balance_mul
#define TclBN_mp_karatsuba_mul s_mp_karatsuba_mul
#define TclBN_mp_karatsuba_sqr s_mp_karatsuba_sqr
#define TclBN_s_mp_mul_digs s_mp_mul_digs
#define TclBN_s_mp_mul_digs_fast s_mp_mul_digs_fast
#define TclBN_s_mp_reverse s_mp_reverse
#define TclBN_s_mp_sqr s_mp_sqr
#define TclBN_s_mp_sqr_fast s_mp_sqr_fast
#define TclBN_s_mp_sub s_mp_sub
#define TclBN_mp_toom_mul s_mp_toom_mul
#define TclBN_mp_toom_sqr s_mp_toom_sqr


MODULE_SCOPE TclIntStubs tclIntStubs;
MODULE_SCOPE TclIntPlatStubs tclIntPlatStubs;
MODULE_SCOPE TclPlatStubs tclPlatStubs;
MODULE_SCOPE TclStubs tclStubs;
MODULE_SCOPE TclTomMathStubs tclTomMathStubs;

#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
unsigned short TclWinNToHS(unsigned short ns) {
	return ntohs(ns);
}
#define TclpCreateTempFile_ TclpCreateTempFile
#define TclUnixWaitForFile_ TclUnixWaitForFile
#ifndef MAC_OSX_TCL /* On UNIX, fill with other stub entries */
#define TclMacOSXGetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj **))(void *)TclpCreateProcess
#define TclMacOSXSetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj *))(void *)isatty
#define TclMacOSXCopyFileAttributes (int (*)(const char *, const char *, const Tcl_StatBuf *))(void *)TclUnixCopyFile
#define TclMacOSXMatchType (int (*)(Tcl_Interp *, const char *, const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))(void *)TclpMakeFile
#define TclMacOSXNotifierAddRunLoopMode (void (*)(const void *))(void *)TclpOpenFile
#endif

#ifdef _WIN32
#ifdef __WIN32__
#   define TclUnixWaitForFile 0
#   define TclUnixCopyFile 0
#   define TclUnixOpenTemporaryFile 0
#   define TclpReaddir 0
#   define TclpIsAtty 0
#elif defined(__CYGWIN__)
#   define TclpIsAtty isatty
static void
doNothing(void)
#   define TclpIsAtty TclPlatIsAtty
#   define TclWinSetInterfaces (void (*) (int)) doNothing
#   define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#   define TclWinFlushDirtyChannels doNothing
#   define TclWinResetInterfaces doNothing
#   define TclpGetTZName 0

static Tcl_Encoding winTCharEncoding;

static int
TclpIsAtty(int fd)
{
    return isatty(fd);
}

#define TclWinGetPlatformId winGetPlatformId
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 */;
}
    /* dummy implementation, no need to do anything */

void *TclWinGetTclInstance()
{
    void *hInstance = NULL;
    GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
	    (const char *)&winTCharEncoding, &hInstance);
    return hInstance;
}
#   define TclWinAddProcess (void (*) (void *, size_t)) doNothing
#   define TclWinFlushDirtyChannels doNothing

#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
	    const char *optval, int optlen)
{
    return setsockopt((int) s, level, optname, optval, optlen);
}

#define TclWinGetSockOpt winGetSockOpt
static int
TclWinGetSockOpt(SOCKET s, int level, int optname,
	    char *optval, int *optlen)
{
    return getsockopt((int) s, level, optname, optval, optlen);
}

#define TclWinGetServByName winGetServByName
static struct servent *
TclWinGetServByName(const char *name, const char *proto)
{
    return getservbyname(name, proto);
}

#define TclWinNoBackslash winNoBackslash
static char *
TclWinNoBackslash(char *path)
{
    char *p;

    for (p = path; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
    return path;
}

void *TclWinGetTclInstance()
int
TclpGetPid(Tcl_Pid pid)
{
    return (int) (size_t) pid;
}
    void *hInstance = NULL;
    GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
	    (const wchar_t *)&TclWinNoBackslash, &hInstance);
    return hInstance;
}

size_t
TclpGetPid(Tcl_Pid pid)

static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}

char *
Tcl_WinUtfToTChar(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    if (!winTCharEncoding) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
    }
    return Tcl_UtfToExternalDString(winTCharEncoding,
	    string, len, dsPtr);
}

char *
Tcl_WinTCharToUtf(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    if (!winTCharEncoding) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
    }
    return (size_t)pid;
    return Tcl_ExternalToUtfDString(winTCharEncoding,
	    string, len, dsPtr);
}

#if defined(TCL_WIDE_INT_IS_LONG)
/* On Cygwin64, long is 64-bit while on Win64 long is 32-bit. Therefore
 * we have to make sure that all stub entries on Cygwin64 follow the Win64
 * signature. Tcl 9 must find a better solution, but that cannot be done
 * without introducing a binary incompatibility.
 */
#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
static Tcl_Obj *dbNewLongObj(
    int intValue,
    const char *file,
    int line
) {
#ifdef TCL_MEM_DEBUG
    register Tcl_Obj *objPtr;

    TclDbNewObj(objPtr, file, line);
    objPtr->bytes = NULL;

    objPtr->internalRep.longValue = (long) intValue;
    objPtr->typePtr = &tclIntType;
    return objPtr;
#else
    return Tcl_NewIntObj(intValue);
#endif
}
#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLong(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= (long)(INT_MIN))
	    if ((longValue >= -(long)(UINT_MAX))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    Tcl_SetResult(interp,
		    "integer value too large to represent as non-long integer",
		    TCL_STATIC);
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLong (int(*)(Tcl_Interp*,const char*,long*))exprInt
static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
    long longValue;
    int result = Tcl_ExprLongObj(interp, expr, &longValue);
    if (result == TCL_OK) {
	    if ((longValue >= (long)(INT_MIN))
	    if ((longValue >= -(long)(UINT_MAX))
		    && (longValue <= (long)(UINT_MAX))) {
	    *ptr = (int)longValue;
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "integer value too large to represent as non-long integer", -1));
	    Tcl_SetResult(interp,
		    "integer value too large to represent as non-long integer",
		    TCL_STATIC);
	    result = TCL_ERROR;
	}
    }
    return result;
}
#define Tcl_ExprLongObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))exprIntObj
static int uniCharNcmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
   return Tcl_UniCharNcmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcmp
static int utfNcmp(const char *s1, const char *s2, unsigned int n){
   return Tcl_UtfNcmp(s1, s2, (unsigned long)n);
}
#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcmp
#define Tcl_UtfNcmp (int(*)(const char*,const char*,unsigned long))utfNcmp
static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
   return Tcl_UtfNcasecmp(s1, s2, (unsigned long)n);
}
#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))(void *)utfNcasecmp

#endif /* TCL_WIDE_INT_IS_LONG */
#define Tcl_UtfNcasecmp (int(*)(const char*,const char*,unsigned long))utfNcasecmp
static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned int n){
   return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
static int formatInt(char *buffer, int n){
   return TclFormatInt(buffer, (long)n);
}
#define TclFormatInt (int(*)(char *, long))formatInt

#endif

#else /* UNIX and MAC */
#   define TclpLocaltime_unix TclpLocaltime
#   define TclpGmtime_unix TclpGmtime
#endif /* __CYGWIN__ */
#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.
 */

MODULE_SCOPE const TclStubs tclStubs;
MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;

#ifdef __GNUC__
/*
 * The rest of this file shouldn't warn about deprecated functions; they're
 * there because we intend them to be so and know that this file is OK to
 * touch those fields.
 */
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#endif

/* !BEGIN!: Do not edit below this line. */

static const TclIntStubs tclIntStubs = {
TclIntStubs tclIntStubs = {
    TCL_STUB_MAGIC,
    0,
    0, /* 0 */
    0, /* 1 */
    0, /* 2 */
    NULL,
    NULL, /* 0 */
    NULL, /* 1 */
    NULL, /* 2 */
    TclAllocateFreeObjects, /* 3 */
    0, /* 4 */
    NULL, /* 4 */
    TclCleanupChildren, /* 5 */
    TclCleanupCommand, /* 6 */
    TclCopyAndCollapse, /* 7 */
    0, /* 8 */
    TclCopyChannel, /* 8 */
    TclCreatePipeline, /* 9 */
    TclCreateProc, /* 10 */
    TclDeleteCompiledLocalVars, /* 11 */
    TclDeleteVars, /* 12 */
    0, /* 13 */
    NULL, /* 13 */
    TclDumpMemoryInfo, /* 14 */
    0, /* 15 */
    NULL, /* 15 */
    TclExprFloatError, /* 16 */
    0, /* 17 */
    0, /* 18 */
    0, /* 19 */
    0, /* 20 */
    0, /* 21 */
    NULL, /* 17 */
    NULL, /* 18 */
    NULL, /* 19 */
    NULL, /* 20 */
    NULL, /* 21 */
    TclFindElement, /* 22 */
    TclFindProc, /* 23 */
    TclFormatInt, /* 24 */
    TclFreePackageInfo, /* 25 */
    0, /* 26 */
    0, /* 27 */
    NULL, /* 26 */
    NULL, /* 27 */
    TclpGetDefaultStdChannel, /* 28 */
    0, /* 29 */
    0, /* 30 */
    NULL, /* 29 */
    NULL, /* 30 */
    TclGetExtension, /* 31 */
    TclGetFrame, /* 32 */
    0, /* 33 */
    0, /* 34 */
    0, /* 35 */
    0, /* 36 */
    NULL, /* 33 */
    TclGetIntForIndex, /* 34 */
    NULL, /* 35 */
    TclGetLong, /* 36 */
    TclGetLoadedPackages, /* 37 */
    TclGetNamespaceForQualName, /* 38 */
    TclGetObjInterpProc, /* 39 */
    TclGetOpenMode, /* 40 */
    TclGetOriginalCommand, /* 41 */
    TclpGetUserHome, /* 42 */
    0, /* 43 */
    NULL, /* 43 */
    TclGuessPackageName, /* 44 */
    TclHideUnsafeCommands, /* 45 */
    TclInExit, /* 46 */
    0, /* 47 */
    0, /* 48 */
    0, /* 49 */
    0, /* 50 */
    NULL, /* 47 */
    NULL, /* 48 */
    NULL, /* 49 */
    TclInitCompiledLocals, /* 50 */
    TclInterpInit, /* 51 */
    0, /* 52 */
    NULL, /* 52 */
    TclInvokeObjectCommand, /* 53 */
    TclInvokeStringCommand, /* 54 */
    TclIsProc, /* 55 */
    0, /* 56 */
    0, /* 57 */
    NULL, /* 56 */
    NULL, /* 57 */
    TclLookupVar, /* 58 */
    0, /* 59 */
    NULL, /* 59 */
    TclNeedSpace, /* 60 */
    TclNewProcBodyObj, /* 61 */
    TclObjCommandComplete, /* 62 */
    TclObjInterpProc, /* 63 */
    TclObjInvoke, /* 64 */
    0, /* 65 */
    0, /* 66 */
    0, /* 67 */
    0, /* 68 */
    NULL, /* 65 */
    NULL, /* 66 */
    NULL, /* 67 */
    NULL, /* 68 */
    TclpAlloc, /* 69 */
    0, /* 70 */
    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    NULL, /* 70 */
    NULL, /* 71 */
    NULL, /* 72 */
    NULL, /* 73 */
    TclpFree, /* 74 */
    TclpGetClicks, /* 75 */
    TclpGetSeconds, /* 76 */
    0, /* 77 */
    0, /* 78 */
    0, /* 79 */
    0, /* 80 */
    TclpGetTime, /* 77 */
    TclpGetTimeZone, /* 78 */
    NULL, /* 79 */
    NULL, /* 80 */
    TclpRealloc, /* 81 */
    0, /* 82 */
    0, /* 83 */
    0, /* 84 */
    0, /* 85 */
    0, /* 86 */
    0, /* 87 */
    0, /* 88 */
    NULL, /* 82 */
    NULL, /* 83 */
    NULL, /* 84 */
    NULL, /* 85 */
    NULL, /* 86 */
    NULL, /* 87 */
    TclPrecTraceProc, /* 88 */
    TclPreventAliasLoop, /* 89 */
    0, /* 90 */
    NULL, /* 90 */
    TclProcCleanupProc, /* 91 */
    TclProcCompileProc, /* 92 */
    TclProcDeleteProc, /* 93 */
    0, /* 94 */
    0, /* 95 */
    NULL, /* 94 */
    NULL, /* 95 */
    TclRenameCommand, /* 96 */
    TclResetShadowedCmdRefs, /* 97 */
    TclServiceIdle, /* 98 */
    0, /* 99 */
    0, /* 100 */
    NULL, /* 99 */
    NULL, /* 100 */
    TclSetPreInitScript, /* 101 */
    TclSetupEnv, /* 102 */
    TclSockGetPort, /* 103 */
    0, /* 104 */
    0, /* 105 */
    0, /* 106 */
    0, /* 107 */
    TclSockMinimumBuffersOld, /* 104 */
    NULL, /* 105 */
    NULL, /* 106 */
    NULL, /* 107 */
    TclTeardownNamespace, /* 108 */
    TclUpdateReturnInfo, /* 109 */
    TclSockMinimumBuffers, /* 110 */
    Tcl_AddInterpResolvers, /* 111 */
    0, /* 112 */
    0, /* 113 */
    0, /* 114 */
    0, /* 115 */
    0, /* 116 */
    0, /* 117 */
    Tcl_AppendExportList, /* 112 */
    Tcl_CreateNamespace, /* 113 */
    Tcl_DeleteNamespace, /* 114 */
    Tcl_Export, /* 115 */
    Tcl_FindCommand, /* 116 */
    Tcl_FindNamespace, /* 117 */
    Tcl_GetInterpResolvers, /* 118 */
    Tcl_GetNamespaceResolvers, /* 119 */
    Tcl_FindNamespaceVar, /* 120 */
    0, /* 121 */
    0, /* 122 */
    0, /* 123 */
    0, /* 124 */
    0, /* 125 */
    Tcl_ForgetImport, /* 121 */
    Tcl_GetCommandFromObj, /* 122 */
    Tcl_GetCommandFullName, /* 123 */
    Tcl_GetCurrentNamespace, /* 124 */
    Tcl_GetGlobalNamespace, /* 125 */
    Tcl_GetVariableFullName, /* 126 */
    0, /* 127 */
    Tcl_Import, /* 127 */
    Tcl_PopCallFrame, /* 128 */
    Tcl_PushCallFrame, /* 129 */
    Tcl_RemoveInterpResolvers, /* 130 */
    Tcl_SetNamespaceResolvers, /* 131 */
    TclpHasSockets, /* 132 */
    0, /* 133 */
    0, /* 134 */
    0, /* 135 */
    0, /* 136 */
    0, /* 137 */
    TclpGetDate, /* 133 */
    NULL, /* 134 */
    NULL, /* 135 */
    NULL, /* 136 */
    NULL, /* 137 */
    TclGetEnv, /* 138 */
    0, /* 139 */
    0, /* 140 */
    NULL, /* 139 */
    NULL, /* 140 */
    TclpGetCwd, /* 141 */
    TclSetByteCodeFromAny, /* 142 */
    TclAddLiteralObj, /* 143 */
    TclHideLiteral, /* 144 */
    TclGetAuxDataType, /* 145 */
    TclHandleCreate, /* 146 */
    TclHandleFree, /* 147 */
    TclHandlePreserve, /* 148 */
    TclHandleRelease, /* 149 */
    TclRegAbout, /* 150 */
    TclRegExpRangeUniChar, /* 151 */
    TclSetLibraryPath, /* 152 */
    TclGetLibraryPath, /* 153 */
    0, /* 154 */
    0, /* 155 */
    NULL, /* 154 */
    NULL, /* 155 */
    TclRegError, /* 156 */
    TclVarTraceExists, /* 157 */
    0, /* 158 */
    0, /* 159 */
    0, /* 160 */
    TclSetStartupScriptFileName, /* 158 */
    TclGetStartupScriptFileName, /* 159 */
    NULL, /* 160 */
    TclChannelTransform, /* 161 */
    TclChannelEventScriptInvoker, /* 162 */
    TclGetInstructionTable, /* 163 */
    TclExpandCodeArray, /* 164 */
    TclpSetInitialEncodings, /* 165 */
    TclListObjSetElement, /* 166 */
    0, /* 167 */
    0, /* 168 */
    TclSetStartupScriptPath, /* 167 */
    TclGetStartupScriptPath, /* 168 */
    TclpUtfNcmp2, /* 169 */
    TclCheckInterpTraces, /* 170 */
    TclCheckExecutionTraces, /* 171 */
    TclInThreadExit, /* 172 */
    TclUniCharMatch, /* 173 */
    0, /* 174 */
    NULL, /* 174 */
    TclCallVarTraces, /* 175 */
    TclCleanupVar, /* 176 */
    TclVarErrMsg, /* 177 */
    0, /* 178 */
    0, /* 179 */
    0, /* 180 */
    0, /* 181 */
    0, /* 182 */
    0, /* 183 */
    0, /* 184 */
    0, /* 185 */
    0, /* 186 */
    0, /* 187 */
    0, /* 188 */
    0, /* 189 */
    0, /* 190 */
    0, /* 191 */
    0, /* 192 */
    0, /* 193 */
    0, /* 194 */
    0, /* 195 */
    0, /* 196 */
    0, /* 197 */
    Tcl_SetStartupScript, /* 178 */
    Tcl_GetStartupScript, /* 179 */
    NULL, /* 180 */
    NULL, /* 181 */
    TclpLocaltime, /* 182 */
    TclpGmtime, /* 183 */
    NULL, /* 184 */
    NULL, /* 185 */
    NULL, /* 186 */
    NULL, /* 187 */
    NULL, /* 188 */
    NULL, /* 189 */
    NULL, /* 190 */
    NULL, /* 191 */
    NULL, /* 192 */
    NULL, /* 193 */
    NULL, /* 194 */
    NULL, /* 195 */
    NULL, /* 196 */
    NULL, /* 197 */
    TclObjGetFrame, /* 198 */
    0, /* 199 */
    NULL, /* 199 */
    TclpObjRemoveDirectory, /* 200 */
    TclpObjCopyDirectory, /* 201 */
    TclpObjCreateDirectory, /* 202 */
    TclpObjDeleteFile, /* 203 */
    TclpObjCopyFile, /* 204 */
    TclpObjRenameFile, /* 205 */
    TclpObjStat, /* 206 */
    TclpObjAccess, /* 207 */
    TclpOpenFileChannel, /* 208 */
    0, /* 209 */
    0, /* 210 */
    0, /* 211 */
    NULL, /* 209 */
    NULL, /* 210 */
    NULL, /* 211 */
    TclpFindExecutable, /* 212 */
    TclGetObjNameOfExecutable, /* 213 */
    TclSetObjNameOfExecutable, /* 214 */
    TclStackAlloc, /* 215 */
    TclStackFree, /* 216 */
    TclPushStackFrame, /* 217 */
    TclPopStackFrame, /* 218 */
    0, /* 219 */
    0, /* 220 */
    0, /* 221 */
    0, /* 222 */
    0, /* 223 */
    NULL, /* 219 */
    NULL, /* 220 */
    NULL, /* 221 */
    NULL, /* 222 */
    NULL, /* 223 */
    TclGetPlatform, /* 224 */
    TclTraceDictPath, /* 225 */
    TclObjBeingDeleted, /* 226 */
    TclSetNsPath, /* 227 */
    0, /* 228 */
    TclObjInterpProcCore, /* 228 */
    TclPtrMakeUpvar, /* 229 */
    TclObjLookupVar, /* 230 */
    TclGetNamespaceFromObj, /* 231 */
    TclEvalObjEx, /* 232 */
    TclGetSrcInfoForPc, /* 233 */
    TclVarHashCreateVar, /* 234 */
    TclInitVarHashTable, /* 235 */
    0, /* 236 */
    TclResetCancellation, /* 237 */
    TclNRInterpProc, /* 238 */
    TclNRInterpProcCore, /* 239 */
    TclNRRunCallbacks, /* 240 */
    TclNREvalObjEx, /* 241 */
    TclNREvalObjv, /* 242 */
    TclBackgroundException, /* 236 */
    NULL, /* 237 */
    NULL, /* 238 */
    NULL, /* 239 */
    NULL, /* 240 */
    NULL, /* 241 */
    NULL, /* 242 */
    TclDbDumpActiveObjects, /* 243 */
    TclGetNamespaceChildTable, /* 244 */
    TclGetNamespaceCommandTable, /* 245 */
    TclInitRewriteEnsemble, /* 246 */
    TclResetRewriteEnsemble, /* 247 */
    TclCopyChannel, /* 248 */
    NULL, /* 244 */
    NULL, /* 245 */
    NULL, /* 246 */
    NULL, /* 247 */
    NULL, /* 248 */
    TclDoubleDigits, /* 249 */
    TclSetChildCancelFlags, /* 250 */
    NULL, /* 250 */
    TclRegisterLiteral, /* 251 */
    TclPtrGetVar, /* 252 */
    TclPtrSetVar, /* 253 */
    TclPtrIncrObjVar, /* 254 */
    TclPtrObjMakeUpvar, /* 255 */
    TclPtrUnsetVar, /* 256 */
    NULL, /* 252 */
    NULL, /* 253 */
    NULL, /* 254 */
    NULL, /* 255 */
    NULL, /* 256 */
    TclStaticPackage, /* 257 */
    TclpCreateTemporaryDirectory, /* 258 */
    TclAppendUnicodeToObj, /* 259 */
    TclGetBytesFromObj, /* 260 */
    NULL, /* 258 */
    NULL, /* 259 */
    NULL, /* 260 */
    TclUnusedStubEntry, /* 261 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    NULL,
#if !defined(__WIN32__) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    NULL, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    0, /* 12 */
    0, /* 13 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
    0, /* 21 */
    TclpCreateTempFile_, /* 22 */
    0, /* 23 */
    0, /* 24 */
    0, /* 25 */
    0, /* 26 */
    0, /* 27 */
    0, /* 28 */
    NULL, /* 15 */
    NULL, /* 16 */
    NULL, /* 17 */
    NULL, /* 18 */
    NULL, /* 19 */
    NULL, /* 20 */
    NULL, /* 21 */
    NULL, /* 22 */
    NULL, /* 23 */
    NULL, /* 24 */
    NULL, /* 25 */
    NULL, /* 26 */
    NULL, /* 27 */
    NULL, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
    TclWinConvertError, /* 0 */
    0, /* 1 */
    0, /* 2 */
    0, /* 3 */
    TclWinConvertWSAError, /* 1 */
    TclWinGetServByName, /* 2 */
    TclWinGetSockOpt, /* 3 */
    TclWinGetTclInstance, /* 4 */
    TclUnixWaitForFile, /* 5 */
    0, /* 6 */
    0, /* 7 */
    TclWinNToHS, /* 6 */
    TclWinSetSockOpt, /* 7 */
    TclpGetPid, /* 8 */
    0, /* 9 */
    0, /* 10 */
    TclWinGetPlatformId, /* 9 */
    TclpReaddir, /* 10 */
    TclGetAndDetachPids, /* 11 */
    TclpCloseFile, /* 12 */
    TclpCreateCommandChannel, /* 13 */
    TclpCreatePipe, /* 14 */
    TclpCreateProcess, /* 15 */
    TclpIsAtty, /* 16 */
    TclUnixCopyFile, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpInetNtoa, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclpGetTZName, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    0, /* 26 */
    NULL, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    0, /* 28 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    TclUnixWaitForFile_, /* 5 */
    NULL, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    0, /* 10 */
    0, /* 11 */
    0, /* 12 */
    0, /* 13 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    0, /* 20 */
    0, /* 21 */
    TclpCreateTempFile_, /* 22 */
    0, /* 23 */
    0, /* 24 */
    0, /* 25 */
    0, /* 26 */
    0, /* 27 */
    0, /* 28 */
    NULL, /* 20 */
    NULL, /* 21 */
    NULL, /* 22 */
    NULL, /* 23 */
    NULL, /* 24 */
    NULL, /* 25 */
    NULL, /* 26 */
    NULL, /* 27 */
    NULL, /* 28 */
    TclWinCPUID, /* 29 */
    TclUnixOpenTemporaryFile, /* 30 */
#endif /* MACOSX */
};

static const TclPlatStubs tclPlatStubs = {
TclPlatStubs tclPlatStubs = {
    TCL_STUB_MAGIC,
    NULL,
#if defined(__WIN32__) || defined(__CYGWIN__) /* WIN */
    Tcl_WinUtfToTChar, /* 0 */
    Tcl_WinTCharToUtf, /* 1 */
    0,
    NULL, /* 2 */
    TclUnusedStubEntry, /* 3 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    0, /* 0 */
    Tcl_MacOSXOpenBundleResources, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
    TclUnusedStubEntry, /* 2 */
#endif /* MACOSX */
};

const TclTomMathStubs tclTomMathStubs = {
TclTomMathStubs tclTomMathStubs = {
    TCL_STUB_MAGIC,
    0,
    NULL,
    TclBN_epoch, /* 0 */
    TclBN_revision, /* 1 */
    TclBN_mp_add, /* 2 */
    TclBN_mp_add_d, /* 3 */
    TclBN_mp_and, /* 4 */
    TclBN_mp_clamp, /* 5 */
    TclBN_mp_clear, /* 6 */
    TclBN_mp_clear_multi, /* 7 */
    TclBN_mp_cmp, /* 8 */
    TclBN_mp_cmp_d, /* 9 */
    TclBN_mp_cmp_mag, /* 10 */
    TclBN_mp_copy, /* 11 */
    TclBN_mp_count_bits, /* 12 */
    TclBN_mp_div, /* 13 */
    TclBN_mp_div_d, /* 14 */
    TclBN_mp_div_2, /* 15 */
    TclBN_mp_div_2d, /* 16 */
    0, /* 17 */
    TclBN_mp_div_3, /* 17 */
    TclBN_mp_exch, /* 18 */
    TclBN_mp_expt_u32, /* 19 */
    TclBN_mp_expt_d, /* 19 */
    TclBN_mp_grow, /* 20 */
    TclBN_mp_init, /* 21 */
    TclBN_mp_init_copy, /* 22 */
    TclBN_mp_init_multi, /* 23 */
    TclBN_mp_init_set, /* 24 */
    TclBN_mp_init_size, /* 25 */
    TclBN_mp_lshd, /* 26 */
    TclBN_mp_mod, /* 27 */
    TclBN_mp_mod_2d, /* 28 */
    TclBN_mp_mul, /* 29 */
    TclBN_mp_mul_d, /* 30 */
    TclBN_mp_mul_2, /* 31 */
    TclBN_mp_mul_2d, /* 32 */
    TclBN_mp_neg, /* 33 */
    TclBN_mp_or, /* 34 */
    TclBN_mp_radix_size, /* 35 */
    TclBN_mp_read_radix, /* 36 */
    TclBN_mp_rshd, /* 37 */
    TclBN_mp_shrink, /* 38 */
    0, /* 39 */
    0, /* 40 */
    TclBN_mp_set, /* 39 */
    TclBN_mp_sqr, /* 40 */
    TclBN_mp_sqrt, /* 41 */
    TclBN_mp_sub, /* 42 */
    TclBN_mp_sub_d, /* 43 */
    0, /* 44 */
    0, /* 45 */
    0, /* 46 */
    TclBN_mp_ubin_size, /* 47 */
    TclBN_mp_to_unsigned_bin, /* 44 */
    TclBN_mp_to_unsigned_bin_n, /* 45 */
    TclBN_mp_toradix_n, /* 46 */
    TclBN_mp_unsigned_bin_size, /* 47 */
    TclBN_mp_xor, /* 48 */
    TclBN_mp_zero, /* 49 */
    0, /* 50 */
    0, /* 51 */
    0, /* 52 */
    0, /* 53 */
    0, /* 54 */
    0, /* 55 */
    0, /* 56 */
    0, /* 57 */
    0, /* 58 */
    0, /* 59 */
    0, /* 60 */
    0, /* 61 */
    0, /* 62 */
    TclBN_reverse, /* 50 */
    TclBN_fast_s_mp_mul_digs, /* 51 */
    TclBN_fast_s_mp_sqr, /* 52 */
    TclBN_mp_karatsuba_mul, /* 53 */
    TclBN_mp_karatsuba_sqr, /* 54 */
    TclBN_mp_toom_mul, /* 55 */
    TclBN_mp_toom_sqr, /* 56 */
    TclBN_s_mp_add, /* 57 */
    TclBN_s_mp_mul_digs, /* 58 */
    TclBN_s_mp_sqr, /* 59 */
    TclBN_s_mp_sub, /* 60 */
    TclBN_mp_init_set_int, /* 61 */
    TclBN_mp_set_int, /* 62 */
    TclBN_mp_cnt_lsb, /* 63 */
    0, /* 64 */
    TclBN_mp_init_i64, /* 65 */
    TclBN_mp_init_u64, /* 66 */
    0, /* 67 */
    TclBN_mp_set_u64, /* 68 */
    TclBN_mp_get_mag_u64, /* 69 */
    TclBN_mp_set_i64, /* 70 */
    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    0, /* 74 */
    0, /* 75 */
    TclBN_mp_signed_rsh, /* 76 */
    0, /* 77 */
    TclBN_mp_to_ubin, /* 78 */
    0, /* 79 */
    TclBN_mp_to_radix, /* 80 */
    NULL, /* 64 */
    NULL, /* 65 */
    NULL, /* 66 */
    NULL, /* 67 */
    NULL, /* 68 */
    NULL, /* 69 */
    NULL, /* 70 */
    NULL, /* 71 */
    NULL, /* 72 */
    NULL, /* 73 */
    NULL, /* 74 */
    NULL, /* 75 */
    NULL, /* 76 */
    NULL, /* 77 */
    NULL, /* 78 */
    NULL, /* 79 */
    TclUnusedStubEntry, /* 80 */
};

static const TclStubHooks tclStubHooks = {
static TclStubHooks tclStubHooks = {
    &tclPlatStubs,
    &tclIntStubs,
    &tclIntPlatStubs
};

const TclStubs tclStubs = {
TclStubs tclStubs = {
    TCL_STUB_MAGIC,
    &tclStubHooks,
    Tcl_PkgProvideEx, /* 0 */
    Tcl_PkgRequireEx, /* 1 */
    Tcl_Panic, /* 2 */
    Tcl_Alloc, /* 3 */
    Tcl_Free, /* 4 */
    Tcl_Realloc, /* 5 */
    Tcl_DbCkalloc, /* 6 */
    Tcl_DbCkfree, /* 7 */
    Tcl_DbCkrealloc, /* 8 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    Tcl_CreateFileHandler, /* 9 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    0, /* 9 */
#if defined(__WIN32__) /* WIN */
    NULL, /* 9 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_CreateFileHandler, /* 9 */
#endif /* MACOSX */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    Tcl_DeleteFileHandler, /* 10 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    0, /* 10 */
#if defined(__WIN32__) /* WIN */
    NULL, /* 10 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_DeleteFileHandler, /* 10 */
#endif /* MACOSX */
    Tcl_SetTimer, /* 11 */
    Tcl_Sleep, /* 12 */
    Tcl_WaitForEvent, /* 13 */
    Tcl_AppendAllObjTypes, /* 14 */
    Tcl_AppendStringsToObj, /* 15 */
    Tcl_AppendToObj, /* 16 */
    Tcl_ConcatObj, /* 17 */
    Tcl_ConvertToType, /* 18 */
    Tcl_DbDecrRefCount, /* 19 */
    Tcl_DbIncrRefCount, /* 20 */
    Tcl_DbIsShared, /* 21 */
    0, /* 22 */
    Tcl_DbNewBooleanObj, /* 22 */
    Tcl_DbNewByteArrayObj, /* 23 */
    Tcl_DbNewDoubleObj, /* 24 */
    Tcl_DbNewListObj, /* 25 */
    0, /* 26 */
    Tcl_DbNewLongObj, /* 26 */
    Tcl_DbNewObj, /* 27 */
    Tcl_DbNewStringObj, /* 28 */
    Tcl_DuplicateObj, /* 29 */
    TclFreeObj, /* 30 */
    Tcl_GetBoolean, /* 31 */
    Tcl_GetBooleanFromObj, /* 32 */
    Tcl_GetByteArrayFromObj, /* 33 */
    Tcl_GetDouble, /* 34 */
    Tcl_GetDoubleFromObj, /* 35 */
    0, /* 36 */
    Tcl_GetIndexFromObj, /* 36 */
    Tcl_GetInt, /* 37 */
    Tcl_GetIntFromObj, /* 38 */
    Tcl_GetLongFromObj, /* 39 */
    Tcl_GetObjType, /* 40 */
    Tcl_GetStringFromObj, /* 41 */
    Tcl_InvalidateStringRep, /* 42 */
    Tcl_ListObjAppendList, /* 43 */
    Tcl_ListObjAppendElement, /* 44 */
    Tcl_ListObjGetElements, /* 45 */
    Tcl_ListObjIndex, /* 46 */
    Tcl_ListObjLength, /* 47 */
    Tcl_ListObjReplace, /* 48 */
    0, /* 49 */
    Tcl_NewBooleanObj, /* 49 */
    Tcl_NewByteArrayObj, /* 50 */
    Tcl_NewDoubleObj, /* 51 */
    0, /* 52 */
    Tcl_NewIntObj, /* 52 */
    Tcl_NewListObj, /* 53 */
    0, /* 54 */
    Tcl_NewLongObj, /* 54 */
    Tcl_NewObj, /* 55 */
    Tcl_NewStringObj, /* 56 */
    0, /* 57 */
    Tcl_SetBooleanObj, /* 57 */
    Tcl_SetByteArrayLength, /* 58 */
    Tcl_SetByteArrayObj, /* 59 */
    Tcl_SetDoubleObj, /* 60 */
    0, /* 61 */
    Tcl_SetIntObj, /* 61 */
    Tcl_SetListObj, /* 62 */
    0, /* 63 */
    Tcl_SetLongObj, /* 63 */
    Tcl_SetObjLength, /* 64 */
    Tcl_SetStringObj, /* 65 */
    0, /* 66 */
    0, /* 67 */
    Tcl_AddErrorInfo, /* 66 */
    Tcl_AddObjErrorInfo, /* 67 */
    Tcl_AllowExceptions, /* 68 */
    Tcl_AppendElement, /* 69 */
    Tcl_AppendResult, /* 70 */
    Tcl_AsyncCreate, /* 71 */
    Tcl_AsyncDelete, /* 72 */
    Tcl_AsyncInvoke, /* 73 */
    Tcl_AsyncMark, /* 74 */
    Tcl_AsyncReady, /* 75 */
    0, /* 76 */
    0, /* 77 */
    Tcl_BackgroundError, /* 76 */
    Tcl_Backslash, /* 77 */
    Tcl_BadChannelOption, /* 78 */
    Tcl_CallWhenDeleted, /* 79 */
    Tcl_CancelIdleCall, /* 80 */
    0, /* 81 */
    Tcl_Close, /* 81 */
    Tcl_CommandComplete, /* 82 */
    Tcl_Concat, /* 83 */
    Tcl_ConvertElement, /* 84 */
    Tcl_ConvertCountedElement, /* 85 */
    Tcl_CreateAlias, /* 86 */
    Tcl_CreateAliasObj, /* 87 */
    Tcl_CreateChannel, /* 88 */
    Tcl_CreateChannelHandler, /* 89 */
    Tcl_CreateCloseHandler, /* 90 */
    Tcl_CreateCommand, /* 91 */
    Tcl_CreateEventSource, /* 92 */
    Tcl_CreateExitHandler, /* 93 */
    Tcl_CreateInterp, /* 94 */
    0, /* 95 */
    Tcl_CreateMathFunc, /* 95 */
    Tcl_CreateObjCommand, /* 96 */
    Tcl_CreateChild, /* 97 */
    Tcl_CreateSlave, /* 97 */
    Tcl_CreateTimerHandler, /* 98 */
    Tcl_CreateTrace, /* 99 */
    Tcl_DeleteAssocData, /* 100 */
    Tcl_DeleteChannelHandler, /* 101 */
    Tcl_DeleteCloseHandler, /* 102 */
    Tcl_DeleteCommand, /* 103 */
    Tcl_DeleteCommandFromToken, /* 104 */
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
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







-
+

-
+












-
+


-
+
















-
+


-
+


-
-
+
+








-
+

-
-
+
+

-
-
+
+









-
+







    Tcl_DStringInit, /* 122 */
    Tcl_DStringResult, /* 123 */
    Tcl_DStringSetLength, /* 124 */
    Tcl_DStringStartSublist, /* 125 */
    Tcl_Eof, /* 126 */
    Tcl_ErrnoId, /* 127 */
    Tcl_ErrnoMsg, /* 128 */
    0, /* 129 */
    Tcl_Eval, /* 129 */
    Tcl_EvalFile, /* 130 */
    0, /* 131 */
    Tcl_EvalObj, /* 131 */
    Tcl_EventuallyFree, /* 132 */
    Tcl_Exit, /* 133 */
    Tcl_ExposeCommand, /* 134 */
    Tcl_ExprBoolean, /* 135 */
    Tcl_ExprBooleanObj, /* 136 */
    Tcl_ExprDouble, /* 137 */
    Tcl_ExprDoubleObj, /* 138 */
    Tcl_ExprLong, /* 139 */
    Tcl_ExprLongObj, /* 140 */
    Tcl_ExprObj, /* 141 */
    Tcl_ExprString, /* 142 */
    Tcl_Finalize, /* 143 */
    0, /* 144 */
    Tcl_FindExecutable, /* 144 */
    Tcl_FirstHashEntry, /* 145 */
    Tcl_Flush, /* 146 */
    0, /* 147 */
    Tcl_FreeResult, /* 147 */
    Tcl_GetAlias, /* 148 */
    Tcl_GetAliasObj, /* 149 */
    Tcl_GetAssocData, /* 150 */
    Tcl_GetChannel, /* 151 */
    Tcl_GetChannelBufferSize, /* 152 */
    Tcl_GetChannelHandle, /* 153 */
    Tcl_GetChannelInstanceData, /* 154 */
    Tcl_GetChannelMode, /* 155 */
    Tcl_GetChannelName, /* 156 */
    Tcl_GetChannelOption, /* 157 */
    Tcl_GetChannelType, /* 158 */
    Tcl_GetCommandInfo, /* 159 */
    Tcl_GetCommandName, /* 160 */
    Tcl_GetErrno, /* 161 */
    Tcl_GetHostName, /* 162 */
    Tcl_GetInterpPath, /* 163 */
    Tcl_GetParent, /* 164 */
    Tcl_GetMaster, /* 164 */
    Tcl_GetNameOfExecutable, /* 165 */
    Tcl_GetObjResult, /* 166 */
#if !defined(_WIN32) && !defined(MAC_OSX_TCL) /* UNIX */
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    Tcl_GetOpenFile, /* 167 */
#endif /* UNIX */
#if defined(_WIN32) /* WIN */
    0, /* 167 */
#if defined(__WIN32__) /* WIN */
    NULL, /* 167 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_GetOpenFile, /* 167 */
#endif /* MACOSX */
    Tcl_GetPathType, /* 168 */
    Tcl_Gets, /* 169 */
    Tcl_GetsObj, /* 170 */
    Tcl_GetServiceMode, /* 171 */
    Tcl_GetChild, /* 172 */
    Tcl_GetSlave, /* 172 */
    Tcl_GetStdChannel, /* 173 */
    0, /* 174 */
    0, /* 175 */
    Tcl_GetStringResult, /* 174 */
    Tcl_GetVar, /* 175 */
    Tcl_GetVar2, /* 176 */
    0, /* 177 */
    0, /* 178 */
    Tcl_GlobalEval, /* 177 */
    Tcl_GlobalEvalObj, /* 178 */
    Tcl_HideCommand, /* 179 */
    Tcl_Init, /* 180 */
    Tcl_InitHashTable, /* 181 */
    Tcl_InputBlocked, /* 182 */
    Tcl_InputBuffered, /* 183 */
    Tcl_InterpDeleted, /* 184 */
    Tcl_IsSafe, /* 185 */
    Tcl_JoinPath, /* 186 */
    Tcl_LinkVar, /* 187 */
    0, /* 188 */
    NULL, /* 188 */
    Tcl_MakeFileChannel, /* 189 */
    Tcl_MakeSafe, /* 190 */
    Tcl_MakeTcpClientChannel, /* 191 */
    Tcl_Merge, /* 192 */
    Tcl_NextHashEntry, /* 193 */
    Tcl_NotifyChannel, /* 194 */
    Tcl_ObjGetVar2, /* 195 */
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
1065
1066
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







-
+









-
+

-
+




-
+






-
-
-
-
+
+
+
+





-
+

-
+


-
+


-
+





-
-
+
+


-
+

-
-
-
-
+
+
+
+

-
+






-
+




-
+







    Tcl_RegExpExec, /* 213 */
    Tcl_RegExpMatch, /* 214 */
    Tcl_RegExpRange, /* 215 */
    Tcl_Release, /* 216 */
    Tcl_ResetResult, /* 217 */
    Tcl_ScanElement, /* 218 */
    Tcl_ScanCountedElement, /* 219 */
    0, /* 220 */
    Tcl_SeekOld, /* 220 */
    Tcl_ServiceAll, /* 221 */
    Tcl_ServiceEvent, /* 222 */
    Tcl_SetAssocData, /* 223 */
    Tcl_SetChannelBufferSize, /* 224 */
    Tcl_SetChannelOption, /* 225 */
    Tcl_SetCommandInfo, /* 226 */
    Tcl_SetErrno, /* 227 */
    Tcl_SetErrorCode, /* 228 */
    Tcl_SetMaxBlockTime, /* 229 */
    0, /* 230 */
    Tcl_SetPanicProc, /* 230 */
    Tcl_SetRecursionLimit, /* 231 */
    0, /* 232 */
    Tcl_SetResult, /* 232 */
    Tcl_SetServiceMode, /* 233 */
    Tcl_SetObjErrorCode, /* 234 */
    Tcl_SetObjResult, /* 235 */
    Tcl_SetStdChannel, /* 236 */
    0, /* 237 */
    Tcl_SetVar, /* 237 */
    Tcl_SetVar2, /* 238 */
    Tcl_SignalId, /* 239 */
    Tcl_SignalMsg, /* 240 */
    Tcl_SourceRCFile, /* 241 */
    Tcl_SplitList, /* 242 */
    Tcl_SplitPath, /* 243 */
    0, /* 244 */
    0, /* 245 */
    0, /* 246 */
    0, /* 247 */
    Tcl_StaticPackage, /* 244 */
    Tcl_StringMatch, /* 245 */
    Tcl_TellOld, /* 246 */
    Tcl_TraceVar, /* 247 */
    Tcl_TraceVar2, /* 248 */
    Tcl_TranslateFileName, /* 249 */
    Tcl_Ungets, /* 250 */
    Tcl_UnlinkVar, /* 251 */
    Tcl_UnregisterChannel, /* 252 */
    0, /* 253 */
    Tcl_UnsetVar, /* 253 */
    Tcl_UnsetVar2, /* 254 */
    0, /* 255 */
    Tcl_UntraceVar, /* 255 */
    Tcl_UntraceVar2, /* 256 */
    Tcl_UpdateLinkedVar, /* 257 */
    0, /* 258 */
    Tcl_UpVar, /* 258 */
    Tcl_UpVar2, /* 259 */
    Tcl_VarEval, /* 260 */
    0, /* 261 */
    Tcl_VarTraceInfo, /* 261 */
    Tcl_VarTraceInfo2, /* 262 */
    Tcl_Write, /* 263 */
    Tcl_WrongNumArgs, /* 264 */
    Tcl_DumpActiveMemory, /* 265 */
    Tcl_ValidateAllMemory, /* 266 */
    0, /* 267 */
    0, /* 268 */
    Tcl_AppendResultVA, /* 267 */
    Tcl_AppendStringsToObjVA, /* 268 */
    Tcl_HashStats, /* 269 */
    Tcl_ParseVar, /* 270 */
    0, /* 271 */
    Tcl_PkgPresent, /* 271 */
    Tcl_PkgPresentEx, /* 272 */
    0, /* 273 */
    0, /* 274 */
    0, /* 275 */
    0, /* 276 */
    Tcl_PkgProvide, /* 273 */
    Tcl_PkgRequire, /* 274 */
    Tcl_SetErrorCodeVA, /* 275 */
    Tcl_VarEvalVA, /* 276 */
    Tcl_WaitPid, /* 277 */
    0, /* 278 */
    Tcl_PanicVA, /* 278 */
    Tcl_GetVersion, /* 279 */
    Tcl_InitMemory, /* 280 */
    Tcl_StackChannel, /* 281 */
    Tcl_UnstackChannel, /* 282 */
    Tcl_GetStackedChannel, /* 283 */
    Tcl_SetMainLoop, /* 284 */
    0, /* 285 */
    NULL, /* 285 */
    Tcl_AppendObjToObj, /* 286 */
    Tcl_CreateEncoding, /* 287 */
    Tcl_CreateThreadExitHandler, /* 288 */
    Tcl_DeleteThreadExitHandler, /* 289 */
    0, /* 290 */
    Tcl_DiscardResult, /* 290 */
    Tcl_EvalEx, /* 291 */
    Tcl_EvalObjv, /* 292 */
    Tcl_EvalObjEx, /* 293 */
    Tcl_ExitThread, /* 294 */
    Tcl_ExternalToUtf, /* 295 */
    Tcl_ExternalToUtfDString, /* 296 */
    Tcl_FinalizeThread, /* 297 */
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
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

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







-
-
+
+




















-
+




-
-
+
+









-
-
-
-
+
+
+
+

-
+







    Tcl_InitNotifier, /* 307 */
    Tcl_MutexLock, /* 308 */
    Tcl_MutexUnlock, /* 309 */
    Tcl_ConditionNotify, /* 310 */
    Tcl_ConditionWait, /* 311 */
    Tcl_NumUtfChars, /* 312 */
    Tcl_ReadChars, /* 313 */
    0, /* 314 */
    0, /* 315 */
    Tcl_RestoreResult, /* 314 */
    Tcl_SaveResult, /* 315 */
    Tcl_SetSystemEncoding, /* 316 */
    Tcl_SetVar2Ex, /* 317 */
    Tcl_ThreadAlert, /* 318 */
    Tcl_ThreadQueueEvent, /* 319 */
    Tcl_UniCharAtIndex, /* 320 */
    Tcl_UniCharToLower, /* 321 */
    Tcl_UniCharToTitle, /* 322 */
    Tcl_UniCharToUpper, /* 323 */
    Tcl_UniCharToUtf, /* 324 */
    Tcl_UtfAtIndex, /* 325 */
    Tcl_UtfCharComplete, /* 326 */
    Tcl_UtfBackslash, /* 327 */
    Tcl_UtfFindFirst, /* 328 */
    Tcl_UtfFindLast, /* 329 */
    Tcl_UtfNext, /* 330 */
    Tcl_UtfPrev, /* 331 */
    Tcl_UtfToExternal, /* 332 */
    Tcl_UtfToExternalDString, /* 333 */
    Tcl_UtfToLower, /* 334 */
    Tcl_UtfToTitle, /* 335 */
    Tcl_UtfToChar16, /* 336 */
    Tcl_UtfToUniChar, /* 336 */
    Tcl_UtfToUpper, /* 337 */
    Tcl_WriteChars, /* 338 */
    Tcl_WriteObj, /* 339 */
    Tcl_GetString, /* 340 */
    0, /* 341 */
    0, /* 342 */
    Tcl_GetDefaultEncodingDir, /* 341 */
    Tcl_SetDefaultEncodingDir, /* 342 */
    Tcl_AlertNotifier, /* 343 */
    Tcl_ServiceModeHook, /* 344 */
    Tcl_UniCharIsAlnum, /* 345 */
    Tcl_UniCharIsAlpha, /* 346 */
    Tcl_UniCharIsDigit, /* 347 */
    Tcl_UniCharIsLower, /* 348 */
    Tcl_UniCharIsSpace, /* 349 */
    Tcl_UniCharIsUpper, /* 350 */
    Tcl_UniCharIsWordChar, /* 351 */
    0, /* 352 */
    0, /* 353 */
    Tcl_Char16ToUtfDString, /* 354 */
    Tcl_UtfToChar16DString, /* 355 */
    Tcl_UniCharLen, /* 352 */
    Tcl_UniCharNcmp, /* 353 */
    Tcl_UniCharToUtfDString, /* 354 */
    Tcl_UtfToUniCharDString, /* 355 */
    Tcl_GetRegExpFromObj, /* 356 */
    0, /* 357 */
    Tcl_EvalTokens, /* 357 */
    Tcl_FreeParse, /* 358 */
    Tcl_LogCommandInfo, /* 359 */
    Tcl_ParseBraces, /* 360 */
    Tcl_ParseCommand, /* 361 */
    Tcl_ParseExpr, /* 362 */
    Tcl_ParseQuotedString, /* 363 */
    Tcl_ParseVarName, /* 364 */
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
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







-
+

-
+
















-
+



-
+













-
-
-
-
+
+
+
+












-
-
+
+







    Tcl_UniCharIsPunct, /* 375 */
    Tcl_RegExpExecObj, /* 376 */
    Tcl_RegExpGetInfo, /* 377 */
    Tcl_NewUnicodeObj, /* 378 */
    Tcl_SetUnicodeObj, /* 379 */
    Tcl_GetCharLength, /* 380 */
    Tcl_GetUniChar, /* 381 */
    0, /* 382 */
    Tcl_GetUnicode, /* 382 */
    Tcl_GetRange, /* 383 */
    0, /* 384 */
    Tcl_AppendUnicodeToObj, /* 384 */
    Tcl_RegExpMatchObj, /* 385 */
    Tcl_SetNotifier, /* 386 */
    Tcl_GetAllocMutex, /* 387 */
    Tcl_GetChannelNames, /* 388 */
    Tcl_GetChannelNamesEx, /* 389 */
    Tcl_ProcObjCmd, /* 390 */
    Tcl_ConditionFinalize, /* 391 */
    Tcl_MutexFinalize, /* 392 */
    Tcl_CreateThread, /* 393 */
    Tcl_ReadRaw, /* 394 */
    Tcl_WriteRaw, /* 395 */
    Tcl_GetTopChannel, /* 396 */
    Tcl_ChannelBuffered, /* 397 */
    Tcl_ChannelName, /* 398 */
    Tcl_ChannelVersion, /* 399 */
    Tcl_ChannelBlockModeProc, /* 400 */
    0, /* 401 */
    Tcl_ChannelCloseProc, /* 401 */
    Tcl_ChannelClose2Proc, /* 402 */
    Tcl_ChannelInputProc, /* 403 */
    Tcl_ChannelOutputProc, /* 404 */
    0, /* 405 */
    Tcl_ChannelSeekProc, /* 405 */
    Tcl_ChannelSetOptionProc, /* 406 */
    Tcl_ChannelGetOptionProc, /* 407 */
    Tcl_ChannelWatchProc, /* 408 */
    Tcl_ChannelGetHandleProc, /* 409 */
    Tcl_ChannelFlushProc, /* 410 */
    Tcl_ChannelHandlerProc, /* 411 */
    Tcl_JoinThread, /* 412 */
    Tcl_IsChannelShared, /* 413 */
    Tcl_IsChannelRegistered, /* 414 */
    Tcl_CutChannel, /* 415 */
    Tcl_SpliceChannel, /* 416 */
    Tcl_ClearChannelHandlers, /* 417 */
    Tcl_IsChannelExisting, /* 418 */
    0, /* 419 */
    0, /* 420 */
    0, /* 421 */
    0, /* 422 */
    Tcl_UniCharNcasecmp, /* 419 */
    Tcl_UniCharCaseMatch, /* 420 */
    Tcl_FindHashEntry, /* 421 */
    Tcl_CreateHashEntry, /* 422 */
    Tcl_InitCustomHashTable, /* 423 */
    Tcl_InitObjHashTable, /* 424 */
    Tcl_CommandTraceInfo, /* 425 */
    Tcl_TraceCommand, /* 426 */
    Tcl_UntraceCommand, /* 427 */
    Tcl_AttemptAlloc, /* 428 */
    Tcl_AttemptDbCkalloc, /* 429 */
    Tcl_AttemptRealloc, /* 430 */
    Tcl_AttemptDbCkrealloc, /* 431 */
    Tcl_AttemptSetObjLength, /* 432 */
    Tcl_GetChannelThread, /* 433 */
    Tcl_GetUnicodeFromObj, /* 434 */
    0, /* 435 */
    0, /* 436 */
    Tcl_GetMathFuncInfo, /* 435 */
    Tcl_ListMathFuncs, /* 436 */
    Tcl_SubstObj, /* 437 */
    Tcl_DetachChannel, /* 438 */
    Tcl_IsStandardChannel, /* 439 */
    Tcl_FSCopyFile, /* 440 */
    Tcl_FSCopyDirectory, /* 441 */
    Tcl_FSCreateDirectory, /* 442 */
    Tcl_FSDeleteFile, /* 443 */
1281
1282
1283
1284
1285
1286
1287
1288

1289
1290
1291
1292
1293
1294
1295
1316
1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1330







-
+







    Tcl_GetCurrentNamespace, /* 512 */
    Tcl_GetGlobalNamespace, /* 513 */
    Tcl_FindNamespace, /* 514 */
    Tcl_FindCommand, /* 515 */
    Tcl_GetCommandFromObj, /* 516 */
    Tcl_GetCommandFullName, /* 517 */
    Tcl_FSEvalFileEx, /* 518 */
    0, /* 519 */
    Tcl_SetExitProc, /* 519 */
    Tcl_LimitAddHandler, /* 520 */
    Tcl_LimitRemoveHandler, /* 521 */
    Tcl_LimitReady, /* 522 */
    Tcl_LimitCheck, /* 523 */
    Tcl_LimitExceeded, /* 524 */
    Tcl_LimitSetCommands, /* 525 */
    Tcl_LimitSetTime, /* 526 */
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



    Tcl_PkgRequireProc, /* 573 */
    Tcl_AppendObjToErrorInfo, /* 574 */
    Tcl_AppendLimitedToObj, /* 575 */
    Tcl_Format, /* 576 */
    Tcl_AppendFormatToObj, /* 577 */
    Tcl_ObjPrintf, /* 578 */
    Tcl_AppendPrintfToObj, /* 579 */
    Tcl_CancelEval, /* 580 */
    Tcl_Canceled, /* 581 */
    Tcl_CreatePipe, /* 582 */
    Tcl_NRCreateCommand, /* 583 */
    Tcl_NREvalObj, /* 584 */
    Tcl_NREvalObjv, /* 585 */
    Tcl_NRCmdSwap, /* 586 */
    Tcl_NRAddCallback, /* 587 */
    Tcl_NRCallObjProc, /* 588 */
    Tcl_GetFSDeviceFromStat, /* 589 */
    Tcl_GetFSInodeFromStat, /* 590 */
    Tcl_GetModeFromStat, /* 591 */
    Tcl_GetLinkCountFromStat, /* 592 */
    Tcl_GetUserIdFromStat, /* 593 */
    Tcl_GetGroupIdFromStat, /* 594 */
    Tcl_GetDeviceTypeFromStat, /* 595 */
    Tcl_GetAccessTimeFromStat, /* 596 */
    Tcl_GetModificationTimeFromStat, /* 597 */
    Tcl_GetChangeTimeFromStat, /* 598 */
    Tcl_GetSizeFromStat, /* 599 */
    Tcl_GetBlocksFromStat, /* 600 */
    Tcl_GetBlockSizeFromStat, /* 601 */
    Tcl_SetEnsembleParameterList, /* 602 */
    Tcl_GetEnsembleParameterList, /* 603 */
    Tcl_ParseArgsObjv, /* 604 */
    Tcl_GetErrorLine, /* 605 */
    Tcl_SetErrorLine, /* 606 */
    Tcl_TransferResult, /* 607 */
    Tcl_InterpActive, /* 608 */
    Tcl_BackgroundException, /* 609 */
    Tcl_ZlibDeflate, /* 610 */
    Tcl_ZlibInflate, /* 611 */
    Tcl_ZlibCRC32, /* 612 */
    Tcl_ZlibAdler32, /* 613 */
    Tcl_ZlibStreamInit, /* 614 */
    Tcl_ZlibStreamGetCommandName, /* 615 */
    Tcl_ZlibStreamEof, /* 616 */
    Tcl_ZlibStreamChecksum, /* 617 */
    Tcl_ZlibStreamPut, /* 618 */
    Tcl_ZlibStreamGet, /* 619 */
    Tcl_ZlibStreamClose, /* 620 */
    Tcl_ZlibStreamReset, /* 621 */
    Tcl_SetStartupScript, /* 622 */
    Tcl_GetStartupScript, /* 623 */
    Tcl_CloseEx, /* 624 */
    Tcl_NRExprObj, /* 625 */
    Tcl_NRSubstObj, /* 626 */
    Tcl_LoadFile, /* 627 */
    Tcl_FindSymbol, /* 628 */
    Tcl_FSUnloadFile, /* 629 */
    Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
    Tcl_OpenTcpServerEx, /* 631 */
    TclZipfs_Mount, /* 632 */
    TclZipfs_Unmount, /* 633 */
    TclZipfs_TclLibrary, /* 634 */
    TclZipfs_MountBuffer, /* 635 */
    Tcl_FreeIntRep, /* 636 */
    Tcl_InitStringRep, /* 637 */
    Tcl_FetchIntRep, /* 638 */
    Tcl_StoreIntRep, /* 639 */
    Tcl_HasStringRep, /* 640 */
    Tcl_IncrRefCount, /* 641 */
    Tcl_DecrRefCount, /* 642 */
    Tcl_IsShared, /* 643 */
    Tcl_LinkArray, /* 644 */
    Tcl_GetIntForIndex, /* 645 */
    Tcl_UtfToUniChar, /* 646 */
    Tcl_UniCharToUtfDString, /* 647 */
    Tcl_UtfToUniCharDString, /* 648 */
    NULL, /* 580 */
    NULL, /* 581 */
    NULL, /* 582 */
    NULL, /* 583 */
    NULL, /* 584 */
    NULL, /* 585 */
    NULL, /* 586 */
    NULL, /* 587 */
    NULL, /* 588 */
    NULL, /* 589 */
    NULL, /* 590 */
    NULL, /* 591 */
    NULL, /* 592 */
    NULL, /* 593 */
    NULL, /* 594 */
    NULL, /* 595 */
    NULL, /* 596 */
    NULL, /* 597 */
    NULL, /* 598 */
    NULL, /* 599 */
    NULL, /* 600 */
    NULL, /* 601 */
    NULL, /* 602 */
    NULL, /* 603 */
    NULL, /* 604 */
    NULL, /* 605 */
    NULL, /* 606 */
    NULL, /* 607 */
    NULL, /* 608 */
    NULL, /* 609 */
    NULL, /* 610 */
    NULL, /* 611 */
    NULL, /* 612 */
    NULL, /* 613 */
    NULL, /* 614 */
    NULL, /* 615 */
    NULL, /* 616 */
    NULL, /* 617 */
    NULL, /* 618 */
    NULL, /* 619 */
    NULL, /* 620 */
    NULL, /* 621 */
    NULL, /* 622 */
    NULL, /* 623 */
    NULL, /* 624 */
    NULL, /* 625 */
    NULL, /* 626 */
    NULL, /* 627 */
    NULL, /* 628 */
    NULL, /* 629 */
    NULL, /* 630 */
    NULL, /* 631 */
    NULL, /* 632 */
    NULL, /* 633 */
    NULL, /* 634 */
    NULL, /* 635 */
    NULL, /* 636 */
    NULL, /* 637 */
    NULL, /* 638 */
    NULL, /* 639 */
    NULL, /* 640 */
    NULL, /* 641 */
    NULL, /* 642 */
    NULL, /* 643 */
    NULL, /* 644 */
    NULL, /* 645 */
    NULL, /* 646 */
    NULL, /* 647 */
    NULL, /* 648 */
    NULL, /* 649 */
    NULL, /* 650 */
    NULL, /* 651 */
    NULL, /* 652 */
    NULL, /* 653 */
    NULL, /* 654 */
    NULL, /* 655 */
    NULL, /* 656 */
    NULL, /* 657 */
    NULL, /* 658 */
    NULL, /* 659 */
    NULL, /* 660 */
    NULL, /* 661 */
    NULL, /* 662 */
    NULL, /* 663 */
    NULL, /* 664 */
    NULL, /* 665 */
    NULL, /* 666 */
    NULL, /* 667 */
    NULL, /* 668 */
    NULL, /* 669 */
    NULL, /* 670 */
    NULL, /* 671 */
    NULL, /* 672 */
    NULL, /* 673 */
    NULL, /* 674 */
    NULL, /* 675 */
    NULL, /* 676 */
    NULL, /* 677 */
    NULL, /* 678 */
    NULL, /* 679 */
    NULL, /* 680 */
    NULL, /* 681 */
    NULL, /* 682 */
    NULL, /* 683 */
    NULL, /* 684 */
    NULL, /* 685 */
    NULL, /* 686 */
    TclUnusedStubEntry, /* 687 */
};

/* !END!: Do not edit above this line. */

Changes to generic/tclStubLib.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24





25
26
27
28
29
30
31
9
10
11
12
13
14
15









16
17
18
19
20
21
22
23
24
25
26
27







-
-
-
-
-
-
-
-
-
+
+
+
+
+







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

MODULE_SCOPE const TclStubs *tclStubsPtr;
MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;

const TclStubs *tclStubsPtr = NULL;
const TclPlatStubs *tclPlatStubsPtr = NULL;
const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
TclStubs *tclStubsPtr = NULL;
TclPlatStubs *tclPlatStubsPtr = NULL;
TclIntStubs *tclIntStubsPtr = NULL;
TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
TclTomMathStubs* tclTomMathStubsPtr = NULL;

/*
 * Use our own ISDIGIT to avoid linking to libc on windows
 */

#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)

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
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







-
+


-
-
+
+
-


-
+

-
+







-
-
-
+
+
+







-
-
+
+






-
+

















-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */
#undef Tcl_InitStubs
MODULE_SCOPE const char *
CONST char *
Tcl_InitStubs(
    Tcl_Interp *interp,
    const char *version,
    int exact,
    CONST char *version,
    int exact)
    int magic)
{
    Interp *iPtr = (Interp *) interp;
    const char *actualVersion = NULL;
    CONST char *actualVersion = NULL;
    ClientData pkgData = NULL;
    const TclStubs *stubsPtr = iPtr->stubTable;
    TclStubs *stubsPtr = iPtr->stubTable;

    /*
     * We can't optimize this check by caching tclStubsPtr because that
     * prevents apps from being able to load/unload Tcl dynamically multiple
     * times. [Bug 615304]
     */

    if (!stubsPtr || (stubsPtr->magic != (((exact&0xFF00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
	iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
	iPtr->legacyFreeProc = 0; /* TCL_STATIC */
    if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
	iPtr->result = "interpreter uses an incompatible stubs mechanism";
	iPtr->freeProc = TCL_STATIC;
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }
    if (exact&1) {
	const char *p = version;
    if (exact) {
	CONST char *p = version;
	int count = 0;

	while (*p) {
	    count += !ISDIGIT(*p++);
	}
	if (count == 1) {
	    const char *q = actualVersion;
	    CONST char *q = actualVersion;

	    p = version;
	    while (*p && (*p == *q)) {
		p++; q++;
	    }
	    if (*p || ISDIGIT(*q)) {
		/* Construct error message */
		stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
		return NULL;
	    }
	} else {
	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
	    if (actualVersion == NULL) {
		return NULL;
	    }
	}
    }
    if (((exact&0xFF00) < 0x900)) {
	/* We are running Tcl 8.x */
	stubsPtr = (TclStubs *)pkgData;
    }
    tclStubsPtr = (TclStubs *)pkgData;

    tclStubsPtr = stubsPtr;

    if (stubsPtr->hooks) {
	tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs;
	tclIntStubsPtr = stubsPtr->hooks->tclIntStubs;
	tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs;
    if (tclStubsPtr->hooks) {
	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
    } else {
	tclPlatStubsPtr = NULL;
	tclIntStubsPtr = NULL;
	tclIntPlatStubsPtr = NULL;
    }

    return actualVersion;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTomMathInitStubs --
 *
 *	Initializes the Stubs table for Tcl's subset of libtommath
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * This procedure should not be called directly, but rather through
 * the TclTomMath_InitStubs macro, to insure that the Stubs table
 * matches the header files used in compilation.
 *
 *----------------------------------------------------------------------
 */

#undef TclTomMathInitializeStubs

CONST char*
TclTomMathInitializeStubs(
    Tcl_Interp* interp,		/* Tcl interpreter */
    CONST char* version,	/* Tcl version needed */
    int epoch,			/* Stubs table epoch from the header files */
    int revision		/* Stubs table revision number from the
				 * header files */
) {
    int exact = 0;
    const char* packageName = "tcl::tommath";
    const char* errMsg = NULL;
    ClientData pkgClientData = NULL;
    const char* actualVersion =
	tclStubsPtr->tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
    TclTomMathStubs* stubsPtr = (TclTomMathStubs*) pkgClientData;
    if (actualVersion == NULL) {
	return NULL;
    }
    if (pkgClientData == NULL) {
	errMsg = "missing stub table pointer";
    } else if ((stubsPtr->tclBN_epoch)() != epoch) {
	errMsg = "epoch number mismatch";
    } else if ((stubsPtr->tclBN_revision)() != revision) {
	errMsg = "requires a later revision";
    } else {
	tclTomMathStubsPtr = stubsPtr;
	return actualVersion;
    }
    tclStubsPtr->tcl_ResetResult(interp);
    tclStubsPtr->tcl_AppendResult(interp, "error loading ", packageName,
		     " (requested version ", version,
		     ", actual version ", actualVersion,
		     "): ", errMsg, NULL);
    return NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclTest.c.

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
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







-
-
-
+
-

-
+
-
-
-
-
-







+
+
+
+
+








-
-







 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 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.
 */

#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#define TCL_TEST
#endif
#include "tclInt.h"
#ifdef TCL_WITH_EXTERNAL_TOMMATH

#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif
#include "tclOO.h"
#include <math.h>

/*
 * Required for Testregexp*Cmd
 */
#include "tclRegexp.h"

/*
 * Required for TestlocaleCmd
 */
#include <locale.h>

/*
 * Required for the TestChannelCmd and TestChannelEventCmd
 */
#include "tclIO.h"

/*
 * Declare external functions used in Windows tests.
 */
DLLEXPORT int		Tcltest_Init(Tcl_Interp *interp);
DLLEXPORT int		Tcltest_SafeInit(Tcl_Interp *interp);

/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
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
57
58
59
60
61
62
63












64
65
66
67
68
69
70







-
-
-
-
-
-
-
-
-
-
-
-







    Tcl_AsyncHandler handler;	/* Tcl's token for the handler. */
    char *command;		/* Command to invoke when the handler is
				 * invoked. */
    struct TestAsyncHandler *nextPtr;
				/* Next is list of handlers. */
} TestAsyncHandler;

/*
 * Start of the socket driver state structure to acces field testFlags
 */

typedef struct TcpState TcpState;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this socket. */
    int testFlags;              /* bit field for tests. Is set by testsocket
                                 * test procedure */
};

TCL_DECLARE_MUTEX(asyncTestMutex)

static TestAsyncHandler *firstHandler = NULL;

/*
 * The dynamic string below is used by the "testdstring" command to test the
 * dynamic string facilities.
131
132
133
134
135
136
137
138

139
140
141
142
143
144
145
114
115
116
117
118
119
120

121
122
123
124
125
126
127
128







-
+








static int exitMainLoop = 0;

/*
 * Event structure used in testing the event queue management procedures.
 */

typedef struct {
typedef struct TestEvent {
    Tcl_Event header;		/* Header common to all events */
    Tcl_Interp *interp;		/* Interpreter that will handle the event */
    Tcl_Obj *command;		/* Command to evaluate when the event occurs */
    Tcl_Obj *tag;		/* Tag for this event used to delete it */
} TestEvent;

/*
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
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







+
-
+

-
-
+
+


-
-
-
+
+
+



-
+

-
-
-
+
+
+

-
-
+
+


-
+


-
-
-
+
+
+




-
+




-
-
+
+

-



-
+



-
+

-
+

+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















-
+












-




-
-
+
+
+
+
+
+
+




-



-
-



-
+

-
+






+







-




-
-








static TestChannel *firstDetached;

/*
 * Forward declarations for procedures defined later in this file:
 */

int			Tcltest_Init(Tcl_Interp *interp);
static int		AsyncHandlerProc(void *clientData,
static int		AsyncHandlerProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
#if TCL_THREADS
static Tcl_ThreadCreateType AsyncThreadProc(void *);
#ifdef TCL_THREADS
static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
#endif
static void		CleanupTestSetassocdataTests(
			    void *clientData, Tcl_Interp *interp);
static void		CmdDelProc1(void *clientData);
static void		CmdDelProc2(void *clientData);
			    ClientData clientData, Tcl_Interp *interp);
static void		CmdDelProc1(ClientData clientData);
static void		CmdDelProc2(ClientData clientData);
static Tcl_CmdProc	CmdProc1;
static Tcl_CmdProc	CmdProc2;
static void		CmdTraceDeleteProc(
			    void *clientData, Tcl_Interp *interp,
			    ClientData clientData, Tcl_Interp *interp,
			    int level, char *command, Tcl_CmdProc *cmdProc,
			    void *cmdClientData, int argc,
			    const char *argv[]);
static void		CmdTraceProc(void *clientData,
			    ClientData cmdClientData, int argc,
			    char **argv);
static void		CmdTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level, char *command,
			    Tcl_CmdProc *cmdProc, void *cmdClientData,
			    int argc, const char *argv[]);
			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
			    int argc, char **argv);
static Tcl_CmdProc	CreatedCommandProc;
static Tcl_CmdProc	CreatedCommandProc2;
static void		DelCallbackProc(void *clientData,
static void		DelCallbackProc(ClientData clientData,
			    Tcl_Interp *interp);
static Tcl_CmdProc	DelCmdProc;
static void		DelDeleteProc(void *clientData);
static void		EncodingFreeProc(void *clientData);
static int		EncodingToUtfProc(void *clientData,
static void		DelDeleteProc(ClientData clientData);
static void		EncodingFreeProc(ClientData clientData);
static int		EncodingToUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst,
			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static int		EncodingFromUtfProc(void *clientData,
static int		EncodingFromUtfProc(ClientData clientData,
			    const char *src, int srcLen, int flags,
			    Tcl_EncodingState *statePtr, char *dst,
			    int dstLen, int *srcReadPtr, int *dstWrotePtr,
			    int *dstCharsPtr);
static void		ExitProcEven(void *clientData);
static void		ExitProcOdd(void *clientData);
static void		ExitProcEven(ClientData clientData);
static void		ExitProcOdd(ClientData clientData);
static Tcl_ObjCmdProc	GetTimesObjCmd;
static Tcl_ResolveCompiledVarProc	InterpCompiledVarResolver;
static void		MainLoop(void);
static Tcl_CmdProc	NoopCmd;
static Tcl_ObjCmdProc	NoopObjCmd;
static int		ObjTraceProc(void *clientData,
static int		ObjTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level, const char *command,
			    Tcl_Command commandToken, int objc,
			    Tcl_Obj *const objv[]);
static void		ObjTraceDeleteProc(void *clientData);
static void		ObjTraceDeleteProc(ClientData clientData);
static void		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void		SpecialFree(void *blockPtr);
static void		SpecialFree(char *blockPtr);
static int		StaticInitProc(Tcl_Interp *interp);
#undef USE_OBSOLETE_FS_HOOKS
#ifdef USE_OBSOLETE_FS_HOOKS
static Tcl_CmdProc	TestasyncCmd;
static Tcl_ObjCmdProc	TestbumpinterpepochObjCmd;
static Tcl_ObjCmdProc	TestbytestringObjCmd;
static Tcl_ObjCmdProc	TestsetbytearraylengthObjCmd;
static Tcl_ObjCmdProc	TestpurebytesobjObjCmd;
static Tcl_CmdProc	TestaccessprocCmd;
static Tcl_CmdProc	TestopenfilechannelprocCmd;
static Tcl_CmdProc	TeststatprocCmd;
static int		PretendTclpAccess(const char *path, int mode);
static int		TestAccessProc1(const char *path, int mode);
static int		TestAccessProc2(const char *path, int mode);
static int		TestAccessProc3(const char *path, int mode);
static Tcl_Channel	PretendTclpOpenFileChannel(
			    Tcl_Interp *interp, const char *fileName,
			    const char *modeString, int permissions);
static Tcl_Channel	TestOpenFileChannelProc1(
			    Tcl_Interp *interp, const char *fileName,
			    const char *modeString, int permissions);
static Tcl_Channel	TestOpenFileChannelProc2(
			    Tcl_Interp *interp, const char *fileName,
			    const char *modeString, int permissions);
static Tcl_Channel	TestOpenFileChannelProc3(
			    Tcl_Interp *interp, const char *fileName,
			    const char *modeString, int permissions);
static int		PretendTclpStat(const char *path, struct stat *buf);
static int		TestStatProc1(const char *path, struct stat *buf);
static int		TestStatProc2(const char *path, struct stat *buf);
static int		TestStatProc3(const char *path, struct stat *buf);
#endif
static Tcl_CmdProc	TestasyncCmd;
static Tcl_ObjCmdProc	TestbytestringObjCmd;
static Tcl_ObjCmdProc	TeststringbytesObjCmd;
static Tcl_CmdProc	TestcmdinfoCmd;
static Tcl_CmdProc	TestcmdtokenCmd;
static Tcl_CmdProc	TestcmdtraceCmd;
static Tcl_CmdProc	TestconcatobjCmd;
static Tcl_CmdProc	TestcreatecommandCmd;
static Tcl_CmdProc	TestdcallCmd;
static Tcl_CmdProc	TestdelCmd;
static Tcl_CmdProc	TestdelassocdataCmd;
static Tcl_ObjCmdProc	TestdoubledigitsObjCmd;
static Tcl_CmdProc	TestdstringCmd;
static Tcl_ObjCmdProc	TestencodingObjCmd;
static Tcl_ObjCmdProc	TestevalexObjCmd;
static Tcl_ObjCmdProc	TestevalobjvObjCmd;
static Tcl_ObjCmdProc	TesteventObjCmd;
static int		TesteventProc(Tcl_Event *event, int flags);
static int		TesteventDeleteProc(Tcl_Event *event,
			    void *clientData);
			    ClientData clientData);
static Tcl_CmdProc	TestexithandlerCmd;
static Tcl_CmdProc	TestexprlongCmd;
static Tcl_ObjCmdProc	TestexprlongobjCmd;
static Tcl_CmdProc	TestexprdoubleCmd;
static Tcl_ObjCmdProc	TestexprdoubleobjCmd;
static Tcl_ObjCmdProc	TestexprparserObjCmd;
static Tcl_CmdProc	TestexprstringCmd;
static Tcl_ObjCmdProc	TestfileCmd;
static Tcl_ObjCmdProc	TestfilelinkCmd;
static Tcl_CmdProc	TestfeventCmd;
static Tcl_CmdProc	TestgetassocdataCmd;
static Tcl_CmdProc	TestgetintCmd;
static Tcl_CmdProc	TestlongsizeCmd;
static Tcl_CmdProc	TestgetplatformCmd;
static Tcl_ObjCmdProc	TestgetvarfullnameCmd;
static Tcl_CmdProc	TestinterpdeleteCmd;
static Tcl_CmdProc	TestlinkCmd;
static Tcl_ObjCmdProc	TestlinkarrayCmd;
static Tcl_ObjCmdProc	TestlocaleCmd;
static Tcl_ObjCmdProc	TestlocaleCmd;
static int		TestMathFunc(ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr);
static int		TestMathFunc2(ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr);
static Tcl_CmdProc	TestmainthreadCmd;
static Tcl_CmdProc	TestsetmainloopCmd;
static Tcl_CmdProc	TestexitmainloopCmd;
static Tcl_CmdProc	TestpanicCmd;
static Tcl_ObjCmdProc	TestparseargsCmd;
static Tcl_ObjCmdProc	TestparserObjCmd;
static Tcl_ObjCmdProc	TestparsevarObjCmd;
static Tcl_ObjCmdProc	TestparsevarnameObjCmd;
static Tcl_ObjCmdProc	TestpreferstableObjCmd;
static Tcl_ObjCmdProc	TestprintObjCmd;
static Tcl_ObjCmdProc	TestregexpObjCmd;
static Tcl_ObjCmdProc	TestreturnObjCmd;
static void		TestregexpXflags(const char *string,
			    size_t length, int *cflagsPtr, int *eflagsPtr);
			    int length, int *cflagsPtr, int *eflagsPtr);
static Tcl_ObjCmdProc	TestsaveresultCmd;
static void		TestsaveresultFree(void *blockPtr);
static void		TestsaveresultFree(char *blockPtr);
static Tcl_CmdProc	TestsetassocdataCmd;
static Tcl_CmdProc	TestsetCmd;
static Tcl_CmdProc	Testset2Cmd;
static Tcl_CmdProc	TestseterrorcodeCmd;
static Tcl_ObjCmdProc	TestsetobjerrorcodeCmd;
static Tcl_CmdProc	TestsetplatformCmd;
static Tcl_ObjCmdProc	TestsizeCmd;
static Tcl_CmdProc	TeststaticpkgCmd;
static Tcl_CmdProc	TesttranslatefilenameCmd;
static Tcl_CmdProc	TestupvarCmd;
static Tcl_ObjCmdProc	TestWrongNumArgsObjCmd;
static Tcl_ObjCmdProc	TestGetIndexFromObjStructObjCmd;
static Tcl_CmdProc	TestChannelCmd;
static Tcl_CmdProc	TestChannelEventCmd;
static Tcl_CmdProc	TestSocketCmd;
static Tcl_ObjCmdProc	TestFilesystemObjCmd;
static Tcl_ObjCmdProc	TestSimpleFilesystemObjCmd;
static void		TestReport(const char *cmd, Tcl_Obj *arg1,
			    Tcl_Obj *arg2);
static Tcl_ObjCmdProc	TestgetencpathObjCmd;
static Tcl_ObjCmdProc	TestsetencpathObjCmd;
static Tcl_Obj *	TestReportGetNativePath(Tcl_Obj *pathPtr);
static Tcl_FSStatProc TestReportStat;
static Tcl_FSAccessProc TestReportAccess;
static Tcl_FSOpenFileChannelProc TestReportOpenFileChannel;
static Tcl_FSMatchInDirectoryProc TestReportMatchInDirectory;
static Tcl_FSChdirProc TestReportChdir;
static Tcl_FSLstatProc TestReportLstat;
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
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







-
+













-
-
-
-
-




-
+







static Tcl_FSFileAttrsGetProc TestReportFileAttrsGet;
static Tcl_FSFileAttrsSetProc TestReportFileAttrsSet;
static Tcl_FSUtimeProc TestReportUtime;
static Tcl_FSNormalizePathProc TestReportNormalizePath;
static Tcl_FSPathInFilesystemProc TestReportInFilesystem;
static Tcl_FSFreeInternalRepProc TestReportFreeInternalRep;
static Tcl_FSDupInternalRepProc TestReportDupInternalRep;
static Tcl_CmdProc TestServiceModeCmd;

static Tcl_FSStatProc SimpleStat;
static Tcl_FSAccessProc SimpleAccess;
static Tcl_FSOpenFileChannelProc SimpleOpenFileChannel;
static Tcl_FSListVolumesProc SimpleListVolumes;
static Tcl_FSPathInFilesystemProc SimplePathInFilesystem;
static Tcl_Obj *	SimpleRedirect(Tcl_Obj *pathPtr);
static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
static Tcl_ObjCmdProc	TestUtfNextCmd;
static Tcl_ObjCmdProc	TestUtfPrevCmd;
static Tcl_ObjCmdProc	TestNumUtfCharsCmd;
static Tcl_ObjCmdProc	TestFindFirstCmd;
static Tcl_ObjCmdProc	TestFindLastCmd;
static Tcl_ObjCmdProc	TestHashSystemHashCmd;

static Tcl_NRPostProc	NREUnwind_callback;
static Tcl_ObjCmdProc	TestNREUnwind;
static Tcl_ObjCmdProc	TestNRELevels;
static Tcl_ObjCmdProc	TestInterpResolverCmd;
#if defined(HAVE_CPUID) || defined(_WIN32)
static Tcl_ObjCmdProc	TestcpuidCmd;
#endif

static const Tcl_Filesystem testReportingFilesystem = {
static Tcl_Filesystem testReportingFilesystem = {
    "reporting",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_1,
    TestReportInFilesystem, /* path in */
    TestReportDupInternalRep,
    TestReportFreeInternalRep,
    NULL, /* native to norm */
365
366
367
368
369
370
371
372

373
374
375
376
377
378
379
365
366
367
368
369
370
371

372
373
374
375
376
377
378
379







-
+







    TestReportCopyDirectory,
    TestReportLstat,
    (Tcl_FSLoadFileProc *) TestReportLoadFile,
    NULL /* cwd */,
    TestReportChdir
};

static const Tcl_Filesystem simpleFilesystem = {
static Tcl_Filesystem simpleFilesystem = {
    "simple",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_1,
    SimplePathInFilesystem,
    NULL,
    NULL,
    /* No internal to normalized, since we don't create any
413
414
415
416
417
418
419









420
421
422
423
424
425
426
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435







+
+
+
+
+
+
+
+
+







    NULL,
    /* We don't need a getcwd or chdir - fallback on Tcl's versions */
    NULL,
    NULL
};


/*
 * External (platform specific) initialization routine, these declarations
 * explicitly don't use EXTERN since this code does not get compiled into the
 * library:
 */

extern int		TclplatformtestInit(Tcl_Interp *interp);
extern int		TclThread_Init(Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * Tcltest_Init --
 *
 *	This procedure performs application-specific initialization. Most
 *	applications, especially those that incorporate additional packages,
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
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







+
+







-
-
-
-
-
-
-
-
-
-
-


-
+










-
-










+
+
+
-
-
-
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    Tcl_ValueType t3ArgTypes[2];

    Tcl_Obj **objv, *objPtr;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
#ifndef TCL_WITH_EXTERNAL_TOMMATH
    if (Tcl_TomMath_InitStubs(interp, "8.5-") == NULL) {
	return TCL_ERROR;
    }
#endif
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
    if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetbytearraylength", TestsetbytearraylengthObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetindexfromobjstruct",
	    TestGetIndexFromObjStructObjCmd, NULL, NULL);
#ifdef USE_OBSOLETE_FS_HOOKS
    Tcl_CreateCommand(interp, "testaccessproc", TestaccessprocCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbumpinterpepoch",
	    TestbumpinterpepochObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testopenfilechannelproc",
    	    TestopenfilechannelprocCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "teststatproc", TeststatprocCmd, NULL,
	    NULL);
#endif
    Tcl_CreateCommand(interp, "testasync", TestasyncCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testchannel", TestChannelCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testchannelevent", TestChannelEventCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
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
611
612
613
614
615
616
617
618
619
620
621
622




623
624
625
626
627
628
629
630
631
632
633
634
635
636

637
638
639
640
641
642
643
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
611
612
613




614
615
616
617






618







619
620
621
622
623
624
625
626







-
-







-



-






-
-
-
-






-
-





-
+

-
+
















-
+
-





+
+










-
-
-
-
+
+
+
+
-
-
-
-
-
-

-
-
-
-
-
-
-
+







	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testhashsystemhash",
	    TestHashSystemHashCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testgetassocdata", TestgetassocdataCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetvarfullname",
	    TestgetvarfullnameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlinkarray", TestlinkarrayCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testservicemode", TestServiceModeCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
	    INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
    Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
	    INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
	    (ClientData) TCL_LEAVE_ERR_MSG, NULL);
    Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
	    TestsetobjerrorcodeCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testutfnext",
	    TestUtfNextCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testutfprev",
	    TestUtfPrevCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testnumutfchars",
	    TestNumUtfCharsCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfindfirst",
	    TestFindFirstCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfindlast",
	    TestFindLastCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
    Tcl_CreateObjCommand(interp, "testsize", TestsizeCmd, NULL, NULL);
	    NULL, NULL);
    Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testtranslatefilename",
	    TesttranslatefilenameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
    Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
    Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
    Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
	    NULL, NULL);
#if defined(HAVE_CPUID) || defined(_WIN32)
    Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
	    NULL, NULL);
#endif
    Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
	    NULL, NULL);
    t3ArgTypes[0] = TCL_EITHER;
    t3ArgTypes[1] = TCL_EITHER;
    Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
	    NULL);
    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd,
	    NULL, NULL);

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#if TCL_THREADS
#ifdef TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
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
756
757
758
759
760
761
762
763
764
765
766
767
768


769
770
771
772
773
774
775
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+







+










-
-
+
+

















-
-
+
+








    /*
     * And finally add any platform specific test commands.
     */

    return TclplatformtestInit(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcltest_SafeInit --
 *
 *	This procedure performs application-specific initialization. Most
 *	applications, especially those that incorporate additional packages,
 *	will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error message in
 *	the interp's result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int
Tcltest_SafeInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    return Procbodytest_SafeInit(interp);
}

/*
 *----------------------------------------------------------------------
 *
 * TestasyncCmd --
 *
 *	This procedure implements the "testasync" command.  It is used
 *	to test the asynchronous handler facilities of Tcl.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates, deletes, and invokes handlers.
 *
 *----------------------------------------------------------------------
 */

static int
TestasyncCmd(
    TCL_UNUSED(void *),
    ClientData dummy,			/* Not used. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int argc,				/* Number of arguments. */
    const char **argv)			/* Argument strings. */
{
    TestAsyncHandler *asyncPtr, *prevPtr;
    int id, code;
    static int nextId = 1;
    (void)dummy;

    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	asyncPtr = (TestAsyncHandler *)Tcl_Alloc(sizeof(TestAsyncHandler));
	asyncPtr->command = (char *)Tcl_Alloc(strlen(argv[2]) + 1);
	asyncPtr = (TestAsyncHandler *)ckalloc(sizeof(TestAsyncHandler));
	asyncPtr->command = (char *)ckalloc(strlen(argv[2]) + 1);
	strcpy(asyncPtr->command, argv[2]);
        Tcl_MutexLock(&asyncTestMutex);
	asyncPtr->id = nextId;
	nextId++;
	asyncPtr->handler = Tcl_AsyncCreate(AsyncHandlerProc,
                                            INT2PTR(asyncPtr->id));
	asyncPtr->nextPtr = firstHandler;
	firstHandler = asyncPtr;
        Tcl_MutexUnlock(&asyncTestMutex);
	Tcl_SetObjResult(interp, Tcl_NewIntObj(asyncPtr->id));
    } else if (strcmp(argv[1], "delete") == 0) {
	if (argc == 2) {
            Tcl_MutexLock(&asyncTestMutex);
	    while (firstHandler != NULL) {
		asyncPtr = firstHandler;
		firstHandler = asyncPtr->nextPtr;
		Tcl_AsyncDelete(asyncPtr->handler);
		Tcl_Free(asyncPtr->command);
		Tcl_Free(asyncPtr);
		ckfree(asyncPtr->command);
		ckfree((char *)asyncPtr);
	    }
            Tcl_MutexUnlock(&asyncTestMutex);
	    return TCL_OK;
	}
	if (argc != 3) {
	    goto wrongNumArgs;
	}
784
785
786
787
788
789
790
791
792


793
794
795
796
797
798
799
739
740
741
742
743
744
745


746
747
748
749
750
751
752
753
754







-
-
+
+







	    }
	    if (prevPtr == NULL) {
		firstHandler = asyncPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = asyncPtr->nextPtr;
	    }
	    Tcl_AsyncDelete(asyncPtr->handler);
	    Tcl_Free(asyncPtr->command);
	    Tcl_Free(asyncPtr);
	    ckfree(asyncPtr->command);
	    ckfree((char *)asyncPtr);
	    break;
	}
        Tcl_MutexUnlock(&asyncTestMutex);
    } else if (strcmp(argv[1], "mark") == 0) {
	if (argc != 5) {
	    goto wrongNumArgs;
	}
808
809
810
811
812
813
814
815

816
817
818
819
820
821
822
763
764
765
766
767
768
769

770
771
772
773
774
775
776
777







-
+







		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
#if TCL_THREADS
#ifdef TCL_THREADS
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
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
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
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







-
+







-
+
-


















-
+




-
+






-
+



















-
+


-
+



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















+



-
+





+







-
+







#endif
    }
    return TCL_OK;
}

static int
AsyncHandlerProc(
    void *clientData,	/* If of TestAsyncHandler structure.
    ClientData clientData,	/* If of TestAsyncHandler structure.
                                 * in global list. */
    Tcl_Interp *interp,		/* Interpreter in which command was
				 * executed, or NULL. */
    int code)			/* Current return code from command. */
{
    TestAsyncHandler *asyncPtr;
    int id = PTR2INT(clientData);
    const char *listArgv[4];
    const char *listArgv[4], *cmd;
    char *cmd;
    char string[TCL_INTEGER_SPACE];

    Tcl_MutexLock(&asyncTestMutex);
    for (asyncPtr = firstHandler; asyncPtr != NULL;
            asyncPtr = asyncPtr->nextPtr) {
        if (asyncPtr->id == id) {
            break;
        }
    }
    Tcl_MutexUnlock(&asyncTestMutex);

    if (!asyncPtr) {
        /* Woops - this one was deleted between the AsyncMark and now */
        return TCL_OK;
    }

    TclFormatInt(string, code);
    listArgv[0] = asyncPtr->command;
    listArgv[1] = Tcl_GetStringResult(interp);
    listArgv[1] = Tcl_GetString(Tcl_GetObjResult(interp));
    listArgv[2] = string;
    listArgv[3] = NULL;
    cmd = Tcl_Merge(3, listArgv);
    if (interp != NULL) {
	code = Tcl_EvalEx(interp, cmd, -1, 0);
	code = Tcl_Eval(interp, cmd);
    } else {
	/*
	 * this should not happen, but by definition of how async handlers are
	 * invoked, it's possible.  Better error checking is needed here.
	 */
    }
    Tcl_Free(cmd);
    ckfree((char *)cmd);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * AsyncThreadProc --
 *
 *	Delivers an asynchronous event to a handler in another thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Invokes Tcl_AsyncMark on the handler
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
#ifdef TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
    void *clientData)	/* Parameter is the id of a
    ClientData clientData)	/* Parameter is the id of a
				 * TestAsyncHandler, defined above. */
{
    TestAsyncHandler *asyncPtr;
    int id = PTR2INT(clientData);

    Tcl_Sleep(1);
    Tcl_MutexLock(&asyncTestMutex);
    for (asyncPtr = firstHandler; asyncPtr != NULL;
         asyncPtr = asyncPtr->nextPtr) {
        if (asyncPtr->id == id) {
            Tcl_AsyncMark(asyncPtr->handler);
            break;
        }
    }
    Tcl_MutexUnlock(&asyncTestMutex);
    Tcl_ExitThread(TCL_OK);
    TCL_THREAD_CREATE_RETURN;
}
#endif

static int
TestbumpinterpepochObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *)interp;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }
    iPtr->compileEpoch++;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestcmdinfoCmd --
 *
 *	This procedure implements the "testcmdinfo" command.  It is used to
 *	test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and
 *	deletion.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates and deletes various commands and modifies their data.
 *
 *----------------------------------------------------------------------
 */


static int
TestcmdinfoCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_CmdInfo info;
    (void)dummy;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option cmdName\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	Tcl_CreateCommand(interp, argv[2], CmdProc1, (void *) "original",
	Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original",
		CmdDelProc1);
    } else if (strcmp(argv[1], "delete") == 0) {
	Tcl_DStringInit(&delString);
	Tcl_DeleteCommand(interp, argv[2]);
	Tcl_DStringResult(interp, &delString);
    } else if (strcmp(argv[1], "get") == 0) {
	if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
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
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







-
+



-
+















-
+

-
-
+
+







-
+

-
-
+
+







-
+








-
+







	if (info.isNativeObjectProc) {
	    Tcl_AppendResult(interp, " nativeObjectProc", NULL);
	} else {
	    Tcl_AppendResult(interp, " stringProc", NULL);
	}
    } else if (strcmp(argv[1], "modify") == 0) {
	info.proc = CmdProc2;
	info.clientData = (void *) "new_command_data";
	info.clientData = (ClientData) "new_command_data";
	info.objProc = NULL;
	info.objClientData = NULL;
	info.deleteProc = CmdDelProc2;
	info.deleteData = (void *) "new_delete_data";
	info.deleteData = (ClientData) "new_delete_data";
	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	} else {
	    Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
	}
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create, delete, get, or modify", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static int
CmdProc1(
    void *clientData,	/* String to return. */
    ClientData clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, NULL);
    return TCL_OK;
}

static int
CmdProc2(
    void *clientData,	/* String to return. */
    ClientData clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, NULL);
    return TCL_OK;
}

static void
CmdDelProc1(
    void *clientData)	/* String to save. */
    ClientData clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
    Tcl_DStringAppend(&delString, (char *) clientData, -1);
}

static void
CmdDelProc2(
    void *clientData)	/* String to save. */
    ClientData clientData)	/* String to save. */
{
    Tcl_DStringInit(&delString);
    Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
    Tcl_DStringAppend(&delString, (char *) clientData, -1);
}

/*
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
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







+



-
+















-
+

-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates and deletes various commands and modifies their data.
 *
 *----------------------------------------------------------------------
 */


static int
TestcmdtokenCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Command token;
    int *l;
    char buf[30];

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option arg\"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
		(void *) "original", NULL);
		(ClientData) "original", NULL);
	sprintf(buf, "%p", (void *)token);
	Tcl_AppendResult(interp, buf, NULL);
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if (strcmp(argv[1], "name") == 0) {
	Tcl_Obj *objPtr;

	if (sscanf(argv[2], "%p", &l) != 1) {
	    Tcl_AppendResult(interp, "bad command token \"", argv[2],
		    "\"", NULL);
	    return TCL_ERROR;
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
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


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







+



-
+















-
-
+
+
+











-
+


-
-
+
+
+



-
-
-
+
+
+
















-
-
+
+


-
+








-
-
-
+
+
+
+
+

















-
+


-
-
+
+


-
-
+
+
+

-
+















-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
+








-
+

-
-
-
-
-
+
+
+
+
+







 *
 * Side effects:
 *	Creates and deletes a command trace, and tests the invocation of
 *	a procedure by the command trace.
 *
 *----------------------------------------------------------------------
 */


static int
TestcmdtraceCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_DString buffer;
    int result;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option script\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "tracetest") == 0) {
	Tcl_DStringInit(&buffer);
	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
	cmdTrace = Tcl_CreateTrace(interp, 50000,
		(Tcl_CmdTraceProc *) CmdTraceProc, &buffer);
	result = Tcl_Eval(interp, argv[2]);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, cmdTrace);
	Tcl_DStringFree(&buffer);
    } else if (strcmp(argv[1], "deletetest") == 0) {
	/*
	 * Create a command trace then eval a script to check whether it is
	 * called. Note that this trace procedure removes itself as a further
	 * check of the robustness of the trace proc calling code in
	 * TclNRExecuteByteCode.
	 * TclExecuteByteCode.
	 */

	cmdTrace = Tcl_CreateTrace(interp, 50000, CmdTraceDeleteProc, NULL);
	Tcl_EvalEx(interp, argv[2], -1, 0);
	cmdTrace = Tcl_CreateTrace(interp, 50000,
		(Tcl_CmdTraceProc *) CmdTraceDeleteProc, NULL);
	Tcl_Eval(interp, argv[2]);
    } else if (strcmp(argv[1], "leveltest") == 0) {
	Interp *iPtr = (Interp *) interp;
	Tcl_DStringInit(&buffer);
	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4, CmdTraceProc,
		&buffer);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
	cmdTrace = Tcl_CreateTrace(interp, iPtr->numLevels + 4,
		(Tcl_CmdTraceProc *) CmdTraceProc, &buffer);
	result = Tcl_Eval(interp, argv[2]);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, cmdTrace);
	Tcl_DStringFree(&buffer);
    } else if (strcmp(argv[1], "resulttest") == 0) {
	/* Create an object-based trace, then eval a script. This is used
	 * to test return codes other than TCL_OK from the trace engine.
	 */

	static int deleteCalled;

	deleteCalled = 0;
	cmdTrace = Tcl_CreateObjTrace(interp, 50000,
		TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
		&deleteCalled, ObjTraceDeleteProc);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
		(ClientData) &deleteCalled, ObjTraceDeleteProc);
	result = Tcl_Eval(interp, argv[2]);
	Tcl_DeleteTrace(interp, cmdTrace);
	if (!deleteCalled) {
	    Tcl_AppendResult(interp, "Delete wasn't called", NULL);
	    Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC);
	    return TCL_ERROR;
	} else {
	    return result;
	}
    } else if (strcmp(argv[1], "doubletest") == 0) {
	Tcl_Trace t1, t2;

	Tcl_DStringInit(&buffer);
	t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
	t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
	result = Tcl_EvalEx(interp, argv[2], -1, 0);
	t1 = Tcl_CreateTrace(interp, 1,
		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
	t2 = Tcl_CreateTrace(interp, 50000,
		(Tcl_CmdTraceProc *) CmdTraceProc, (ClientData) &buffer);
	result = Tcl_Eval(interp, argv[2]);
	if (result == TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
	}
	Tcl_DeleteTrace(interp, t2);
	Tcl_DeleteTrace(interp, t1);
	Tcl_DStringFree(&buffer);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be tracetest, deletetest, doubletest or resulttest", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void
CmdTraceProc(
    void *clientData,	/* Pointer to buffer in which the
    ClientData clientData,	/* Pointer to buffer in which the
				 * command and arguments are appended.
				 * Accumulates test result. */
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int) /*level*/,
    Tcl_Interp *interp,		/* Current interpreter. */
    int level,			/* Current trace level. */
    char *command,		/* The command being traced (after
				 * substitutions). */
    TCL_UNUSED(Tcl_CmdProc *) /*cmdProc*/,
    TCL_UNUSED(void *),
    Tcl_CmdProc *cmdProc,	/* Points to command's command procedure. */
    ClientData cmdClientData,	/* Client data associated with command
				 * procedure. */
    int argc,			/* Number of arguments. */
    const char *argv[])		/* Argument strings. */
    char **argv)		/* Argument strings. */
{
    Tcl_DString *bufPtr = (Tcl_DString *) clientData;
    int i;

    Tcl_DStringAppendElement(bufPtr, command);

    Tcl_DStringStartSublist(bufPtr);
    for (i = 0;  i < argc;  i++) {
	Tcl_DStringAppendElement(bufPtr, argv[i]);
    }
    Tcl_DStringEndSublist(bufPtr);
}

static void
CmdTraceDeleteProc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Unused. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*level*/,
    TCL_UNUSED(char *) /*command*/,
    TCL_UNUSED(Tcl_CmdProc *),
    TCL_UNUSED(void *),
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    int level,			/* Current trace level. */
    char *command,		/* The command being traced (after
				 * substitutions). */
    Tcl_CmdProc *cmdProc,	/* Points to command's command procedure. */
    ClientData cmdClientData,	/* Client data associated with command
				 * procedure. */
    int argc,			/* Number of arguments. */
    char **argv)		/* Argument strings. */
{
    /*
     * Remove ourselves to test whether calling Tcl_DeleteTrace within a trace
     * callback causes the for loop in TclNRExecuteByteCode that calls traces to
     * callback causes the for loop in TclExecuteByteCode that calls traces to
     * reference freed memory.
     */

    Tcl_DeleteTrace(interp, cmdTrace);
}

static int
ObjTraceProc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    TCL_UNUSED(int) /*level*/,
    const char *command,
    TCL_UNUSED(Tcl_Command),
    TCL_UNUSED(int) /*objc*/,
    Tcl_Obj *const objv[])	/* Argument objects. */
    int level,			/* Execution level */
    const char *command,	/* Command being executed */
    Tcl_Command token,		/* Command information */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter list */
{
    const char *word = Tcl_GetString(objv[0]);

    if (!strcmp(word, "Error")) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(command, -1));
	return TCL_ERROR;
    } else if (!strcmp(word, "Break")) {
1322
1323
1324
1325
1326
1327
1328
1329

1330
1331
1332
1333
1334
1335
1336
1270
1271
1272
1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283
1284







-
+







    } else {
	return TCL_OK;
    }
}

static void
ObjTraceDeleteProc(
    void *clientData)
    ClientData clientData)
{
    int *intPtr = (int *) clientData;
    *intPtr = 1;		/* Record that the trace was deleted */
}

/*
 *----------------------------------------------------------------------
1351
1352
1353
1354
1355
1356
1357
1358

1359
1360
1361
1362
1363
1364
1365
1299
1300
1301
1302
1303
1304
1305

1306
1307
1308
1309
1310
1311
1312
1313







-
+







 *	and "value:at:").
 *
 *----------------------------------------------------------------------
 */

static int
TestcreatecommandCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option\"", NULL);
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
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
1356
1357

1358
1359


1360
1361
1362
1363
1364
1365
1366
1367
1368







-
+

-
-
+
+


















-
+

-
-
+
+







	return TCL_ERROR;
    }
    return TCL_OK;
}

static int
CreatedCommandProc(
    TCL_UNUSED(void *),
    ClientData clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_CmdInfo info;
    int found;

    found = Tcl_GetCommandInfo(interp, "test_ns_basic::createdcommand",
	    &info);
    if (!found) {
	Tcl_AppendResult(interp, "CreatedCommandProc could not get command info for test_ns_basic::createdcommand",
		NULL);
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "CreatedCommandProc in ",
	    info.namespacePtr->fullName, NULL);
    return TCL_OK;
}

static int
CreatedCommandProc2(
    TCL_UNUSED(void *),
    ClientData clientData,	/* String to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_CmdInfo info;
    int found;

    found = Tcl_GetCommandInfo(interp, "value:at:", &info);
    if (!found) {
	Tcl_AppendResult(interp, "CreatedCommandProc2 could not get command info for test_ns_basic::createdcommand",
1438
1439
1440
1441
1442
1443
1444

1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463

1464
1465
1466

1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480

1481
1482
1483
1484
1485
1486
1487
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







+



-
+














-
+


-
+













-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates and deletes interpreters.
 *
 *----------------------------------------------------------------------
 */


static int
TestdcallCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int i, id;

    delInterp = Tcl_CreateInterp();
    Tcl_DStringInit(&delString);
    for (i = 1; i < argc; i++) {
	if (Tcl_GetInt(interp, argv[i], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (id < 0) {
	    Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc,
		    INT2PTR(-id));
		    (ClientData) INT2PTR(-id));
	} else {
	    Tcl_CallWhenDeleted(delInterp, DelCallbackProc,
		    INT2PTR(id));
		    (ClientData) INT2PTR(id));
	}
    }
    Tcl_DeleteInterp(delInterp);
    Tcl_DStringResult(interp, &delString);
    return TCL_OK;
}

/*
 * The deletion callback used by TestdcallCmd:
 */

static void
DelCallbackProc(
    void *clientData,	/* Numerical value to append to delString. */
    ClientData clientData,	/* Numerical value to append to delString. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
{
    int id = PTR2INT(clientData);
    char buffer[TCL_INTEGER_SPACE];

    TclFormatInt(buffer, id);
    Tcl_DStringAppendElement(&delString, buffer);
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

1531
1532

1533
1534
1535

1536
1537
1538
1539
1540
1541
1542

1543
1544
1545


1546
1547
1548
1549
1550
1551


1552
1553
1554
1555
1556
1557

1558
1559
1560
1561

1562
1563
1564


1565
1566
1567
1568
1569
1570
1571
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461

1462
1463
1464
1465
1466
1467

1468
1469
1470

1471
1472
1473
1474


1475
1476
1477
1478
1479

1480
1481

1482
1483
1484

1485
1486
1487
1488
1489
1490
1491

1492
1493


1494
1495
1496
1497
1498
1499


1500
1501
1502
1503
1504
1505
1506

1507
1508
1509
1510

1511
1512


1513
1514
1515
1516
1517
1518
1519
1520
1521







+



-
+





-
+


-
+



-
-
+
+



-
+

-
+


-
+






-
+

-
-
+
+




-
-
+
+





-
+



-
+

-
-
+
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates a command.
 *
 *----------------------------------------------------------------------
 */


static int
TestdelCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    DelCmd *dPtr;
    Tcl_Interp *child;
    Tcl_Interp *slave;

    if (argc != 4) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
	return TCL_ERROR;
    }

    child = Tcl_GetChild(interp, argv[1]);
    if (child == NULL) {
    slave = Tcl_GetSlave(interp, argv[1]);
    if (slave == NULL) {
	return TCL_ERROR;
    }

    dPtr = (DelCmd *)Tcl_Alloc(sizeof(DelCmd));
    dPtr = (DelCmd *)ckalloc(sizeof(DelCmd));
    dPtr->interp = interp;
    dPtr->deleteCmd = (char *)Tcl_Alloc(strlen(argv[3]) + 1);
    dPtr->deleteCmd = (char *)ckalloc(strlen(argv[3]) + 1);
    strcpy(dPtr->deleteCmd, argv[3]);

    Tcl_CreateCommand(child, argv[2], DelCmdProc, dPtr,
    Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
	    DelDeleteProc);
    return TCL_OK;
}

static int
DelCmdProc(
    void *clientData,	/* String result to return. */
    ClientData clientData,	/* String result to return. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    DelCmd *dPtr = (DelCmd *) clientData;

    Tcl_AppendResult(interp, dPtr->deleteCmd, NULL);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
    ckfree(dPtr->deleteCmd);
    ckfree((char *)dPtr);
    return TCL_OK;
}

static void
DelDeleteProc(
    void *clientData)	/* String command to evaluate. */
    ClientData clientData)	/* String command to evaluate. */
{
    DelCmd *dPtr = (DelCmd *)clientData;

    Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
    Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
    Tcl_ResetResult(dPtr->interp);
    Tcl_Free(dPtr->deleteCmd);
    Tcl_Free(dPtr);
    ckfree(dPtr->deleteCmd);
    ckfree((char *)dPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestdelassocdataCmd --
 *
1580
1581
1582
1583
1584
1585
1586
1587

1588
1589
1590
1591
1592
1593
1594
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542
1543
1544







-
+







 *	interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
TestdelassocdataCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key\"", NULL);
1609
1610
1611
1612
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
1641
1642
1643
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
1596
1597
1598







-
+






-
-
-
-
-
+
+
+
+
+
+
+
+



+






+







 *
 * Usage:
 *	testdoubledigits fpval ndigits type ?shorten"
 *
 * Parameters:
 *	fpval - Floating-point value to format.
 *	ndigits - Digit count to request from Tcl_DoubleDigits
 *	type - One of 'shortest', 'e', 'f'
 *	type - One of 'shortest', 'Steele', 'e', 'f'
 *	shorten - Indicates that the 'shorten' flag should be passed in.
 *
 *-----------------------------------------------------------------------------
 */

static int
TestdoubledigitsObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj* const objv[])	/* Parameter vector */
TestdoubledigitsObjCmd(ClientData unused,
				/* NULL */
		       Tcl_Interp* interp,
				/* Tcl interpreter */
		       int objc,
				/* Parameter count */
		       Tcl_Obj* const objv[])
				/* Parameter vector */
{
    static const char* options[] = {
	"shortest",
	"Steele",
	"e",
	"f",
	NULL
    };
    static const int types[] = {
	TCL_DD_SHORTEST,
	TCL_DD_STEELE,
	TCL_DD_E_FORMAT,
	TCL_DD_F_FORMAT
    };

    const Tcl_ObjType* doubleType;
    double d;
    int status;
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
1608
1609
1610
1611
1612
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
1641
1642
1643
1644
1645







-
-
+
+

















-
+



-
+







    if (objc < 4 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "fpval ndigits type ?shorten?");
	return TCL_ERROR;
    }
    status = Tcl_GetDoubleFromObj(interp, objv[1], &d);
    if (status != TCL_OK) {
	doubleType = Tcl_GetObjType("double");
	if (Tcl_FetchIntRep(objv[1], doubleType)
	    && TclIsNaN(objv[1]->internalRep.doubleValue)) {
	if (objv[1]->typePtr == doubleType
	    || TclIsNaN(objv[1]->internalRep.doubleValue)) {
	    status = TCL_OK;
	    memcpy(&d, &(objv[1]->internalRep.doubleValue), sizeof(double));
	}
    }
    if (status != TCL_OK
	|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
	|| Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
			       TCL_EXACT, &type) != TCL_OK) {
	fprintf(stderr, "bad value? %g\n", d);
	return TCL_ERROR;
    }
    type = types[type];
    if (objc > 4) {
	if (strcmp(Tcl_GetString(objv[4]), "shorten")) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad flag", -1));
	    return TCL_ERROR;
	}
	type |= TCL_DD_SHORTEST;
	type |= TCL_DD_SHORTEN_FLAG;
    }
    str = TclDoubleDigits(d, ndigits, type, &decpt, &signum, &endPtr);
    strObj = Tcl_NewStringObj(str, endPtr-str);
    Tcl_Free(str);
    ckfree(str);
    retval = Tcl_NewListObj(1, &strObj);
    Tcl_ListObjAppendElement(NULL, retval, Tcl_NewIntObj(decpt));
    strObj = Tcl_NewStringObj(signum ? "-" : "+", 1);
    Tcl_ListObjAppendElement(NULL, retval, strObj);
    Tcl_SetObjResult(interp, retval);
    return TCL_OK;
}
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
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







+



-
+








-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates, deletes, and invokes handlers.
 *
 *----------------------------------------------------------------------
 */


static int
TestdstringCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int count;

    if (argc < 2) {
	wrongNumArgs:
	Tcl_AppendResult(interp, "wrong # args", NULL);
	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "append") == 0) {
	if (argc != 4) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[3], &count) != TCL_OK) {
1749
1750
1751
1752
1753
1754
1755
1756

1757
1758

1759
1760

1761
1762
1763
1764

1765
1766
1767
1768
1769
1770
1771
1705
1706
1707
1708
1709
1710
1711

1712
1713

1714
1715

1716
1717
1718
1719

1720
1721
1722
1723
1724
1725
1726
1727







-
+

-
+

-
+



-
+







	}
	Tcl_SetResult(interp, Tcl_DStringValue(&dstring), TCL_VOLATILE);
    } else if (strcmp(argv[1], "gresult") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_AppendResult(interp, "short", NULL);
	    Tcl_SetResult(interp, "short", TCL_STATIC);
	} else if (strcmp(argv[2], "staticlarge") == 0) {
	    Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
	    Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
	} else if (strcmp(argv[2], "free") == 0) {
	    char *s = (char *)Tcl_Alloc(100);
	    char *s = ckalloc(100);
	    strcpy(s, "This is a malloc-ed string");
	    Tcl_SetResult(interp, s, TCL_DYNAMIC);
	} else if (strcmp(argv[2], "special") == 0) {
	    char *s = (char *)Tcl_Alloc(100) + 16;
	    char *s = (char*)ckalloc(100) + 16;
	    strcpy(s, "This is a specially-allocated string");
	    Tcl_SetResult(interp, s, SpecialFree);
	} else {
	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
		    "\": must be staticsmall, staticlarge, free, or special",
		    NULL);
	    return TCL_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

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
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
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
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







-
-
+
+
-
-
+
+


















+



-
+








-
+


















-
+



-
-
+
+


-
-
+
+







-
+









-
+
-
-
-
-
+
+
-







-
-
+
+

-
-
+
+










-
+





-
+










-
-
+
+

-
-
+
+










-
+





-
+










-
+



-
-
-
+
+
+







}

/*
 * The procedure below is used as a special freeProc to test how well
 * Tcl_DStringGetResult handles freeProc's other than free.
 */

static void SpecialFree(
    void *blockPtr			/* Block to free. */
static void SpecialFree(blockPtr)
    char *blockPtr;			/* Block to free. */
) {
    Tcl_Free(((char *)blockPtr) - 16);
{
    ckfree(blockPtr - 16);
}

/*
 *----------------------------------------------------------------------
 *
 * TestencodingCmd --
 *
 *	This procedure implements the "testencoding" command.  It is used
 *	to test the encoding package.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Load encodings.
 *
 *----------------------------------------------------------------------
 */


static int
TestencodingObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Encoding encoding;
    int index, length;
    const char *string;
    TclEncoding *encodingPtr;
    static const char *const optionStrings[] = {
    static const char *optionStrings[] = {
	"create",	"delete",	NULL
    };
    enum options {
	ENC_CREATE,	ENC_DELETE
    };

    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum options) index) {
    case ENC_CREATE: {
	Tcl_EncodingType type;

	if (objc != 5) {
	    return TCL_ERROR;
	}
	encodingPtr = (TclEncoding*)Tcl_Alloc(sizeof(TclEncoding));
	encodingPtr = (TclEncoding *)ckalloc(sizeof(TclEncoding));
	encodingPtr->interp = interp;

	string = Tcl_GetStringFromObj(objv[3], &length);
	encodingPtr->toUtfCmd = (char *)Tcl_Alloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, length + 1);
	encodingPtr->toUtfCmd = (char *)ckalloc(length + 1);
	memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);

	string = Tcl_GetStringFromObj(objv[4], &length);
	encodingPtr->fromUtfCmd = (char *)Tcl_Alloc(length + 1);
	memcpy(encodingPtr->fromUtfCmd, string, length + 1);
	encodingPtr->fromUtfCmd = (char *)ckalloc(length + 1);
	memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));

	string = Tcl_GetStringFromObj(objv[2], &length);

	type.encodingName = string;
	type.toUtfProc = EncodingToUtfProc;
	type.fromUtfProc = EncodingFromUtfProc;
	type.freeProc = EncodingFreeProc;
	type.clientData = encodingPtr;
	type.clientData = (ClientData) encodingPtr;
	type.nullSize = 1;

	Tcl_CreateEncoding(&type);
	break;
    }
    case ENC_DELETE:
	if (objc != 3) {
	    return TCL_ERROR;
	}
	if (TCL_OK != Tcl_GetEncodingFromObj(interp, objv[2], &encoding)) {
	encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
	    return TCL_ERROR;
	}
	Tcl_FreeEncoding(encoding);	/* Free returned reference */
	Tcl_FreeEncoding(encoding);	/* Free to match CREATE */
	Tcl_FreeEncoding(encoding);
	Tcl_FreeEncoding(encoding);
	TclFreeIntRep(objv[2]);		/* Free the cached ref */
	break;
    }
    return TCL_OK;
}

static int
EncodingToUtfProc(
    void *clientData,	/* TclEncoding structure. */
    TCL_UNUSED(const char *) /*src*/,
    ClientData clientData,	/* TclEncoding structure. */
    const char *src,		/* Source string in specified encoding. */
    int srcLen,			/* Source string length in bytes. */
    TCL_UNUSED(int) /*flags*/,
    TCL_UNUSED(Tcl_EncodingState *),
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Current state. */
    char *dst,			/* Output buffer. */
    int dstLen,			/* The maximum length of output buffer. */
    int *srcReadPtr,		/* Filled with number of bytes read. */
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL);
    Tcl_GlobalEval(encodingPtr->interp, encodingPtr->toUtfCmd);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
    }
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
    Tcl_ResetResult(encodingPtr->interp);

    *srcReadPtr = srcLen;
    *dstWrotePtr = len;
    *dstCharsPtr = len;
    return TCL_OK;
}

static int
EncodingFromUtfProc(
    void *clientData,	/* TclEncoding structure. */
    TCL_UNUSED(const char *) /*src*/,
    ClientData clientData,	/* TclEncoding structure. */
    const char *src,		/* Source string in specified encoding. */
    int srcLen,			/* Source string length in bytes. */
    TCL_UNUSED(int) /*flags*/,
    TCL_UNUSED(Tcl_EncodingState *),
    int flags,			/* Conversion control flags. */
    Tcl_EncodingState *statePtr,/* Current state. */
    char *dst,			/* Output buffer. */
    int dstLen,			/* The maximum length of output buffer. */
    int *srcReadPtr,		/* Filled with number of bytes read. */
    int *dstWrotePtr,		/* Filled with number of bytes stored. */
    int *dstCharsPtr)		/* Filled with number of chars stored. */
{
    int len;
    TclEncoding *encodingPtr;

    encodingPtr = (TclEncoding *) clientData;
    Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL);
    Tcl_GlobalEval(encodingPtr->interp, encodingPtr->fromUtfCmd);

    len = strlen(Tcl_GetStringResult(encodingPtr->interp));
    if (len > dstLen) {
	len = dstLen;
    }
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
    memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
    Tcl_ResetResult(encodingPtr->interp);

    *srcReadPtr = srcLen;
    *dstWrotePtr = len;
    *dstCharsPtr = len;
    return TCL_OK;
}

static void
EncodingFreeProc(
    void *clientData)	/* ClientData associated with type. */
    ClientData clientData)	/* ClientData associated with type. */
{
    TclEncoding *encodingPtr = (TclEncoding *)clientData;

    Tcl_Free(encodingPtr->toUtfCmd);
    Tcl_Free(encodingPtr->fromUtfCmd);
    Tcl_Free(encodingPtr);
    ckfree((char *)encodingPtr->toUtfCmd);
    ckfree((char *)encodingPtr->fromUtfCmd);
    ckfree((char *)encodingPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TestevalexObjCmd --
 *
1990
1991
1992
1993
1994
1995
1996
1997

1998
1999
2000
2001
2002
2003
2004
1944
1945
1946
1947
1948
1949
1950

1951
1952
1953
1954
1955
1956
1957
1958







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestevalexObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int length, flags;
    const char *script;

2035
2036
2037
2038
2039
2040
2041
2042

2043
2044
2045
2046
2047
2048
2049
1989
1990
1991
1992
1993
1994
1995

1996
1997
1998
1999
2000
2001
2002
2003







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestevalobjvObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int evalGlobal;

    if (objc < 3) {
2084
2085
2086
2087
2088
2089
2090
2091

2092
2093
2094
2095
2096

2097
2098
2099
2100

2101
2102
2103
2104
2105
2106
2107
2038
2039
2040
2041
2042
2043
2044

2045
2046
2047
2048
2049

2050
2051
2052
2053

2054
2055
2056
2057
2058
2059
2060
2061







-
+




-
+



-
+







 *	Manipulates the event queue as directed.
 *
 *----------------------------------------------------------------------
 */

static int
TesteventObjCmd(
    TCL_UNUSED(void *),
    ClientData unused,		/* Not used */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    static const char *const subcommands[] = { /* Possible subcommands */
    static const char *subcommands[] = { /* Possible subcommands */
	"queue", "delete", NULL
    };
    int subCmdIndex;		/* Index of the chosen subcommand */
    static const char *const positions[] = { /* Possible queue positions */
    static const char *positions[] = { /* Possible queue positions */
	"head", "tail", "mark", NULL
    };
    int posIndex;		/* Index of the chosen position */
    static const Tcl_QueuePosition posNum[] = {
				/* Interpretation of the chosen position */
	TCL_QUEUE_HEAD,
	TCL_QUEUE_TAIL,
2123
2124
2125
2126
2127
2128
2129
2130

2131
2132
2133
2134
2135
2136
2137
2077
2078
2079
2080
2081
2082
2083

2084
2085
2086
2087
2088
2089
2090
2091







-
+







	    Tcl_WrongNumArgs(interp, 2, objv, "name position script");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[3], positions,
		"position specifier", TCL_EXACT, &posIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	ev = (TestEvent *)Tcl_Alloc(sizeof(TestEvent));
	ev = (TestEvent *)ckalloc(sizeof(TestEvent));
	ev->header.proc = TesteventProc;
	ev->header.nextPtr = NULL;
	ev->interp = interp;
	ev->command = objv[4];
	Tcl_IncrRefCount(ev->command);
	ev->tag = objv[2];
	Tcl_IncrRefCount(ev->tag);
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
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







-
+











-
+






-
+







 *
 *----------------------------------------------------------------------
 */

static int
TesteventProc(
    Tcl_Event *event,		/* Event to deliver */
    TCL_UNUSED(int) /*flags*/)
    int flags)			/* Current flags for Tcl_ServiceEvent */
{
    TestEvent *ev = (TestEvent *) event;
    Tcl_Interp *interp = ev->interp;
    Tcl_Obj *command = ev->command;
    int result = Tcl_EvalObjEx(interp, command,
	    TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
    int retval;

    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"    (command bound to \"testevent\" callback)");
	Tcl_BackgroundException(interp, TCL_ERROR);
	Tcl_BackgroundError(interp);
	return 1;		/* Avoid looping on errors */
    }
    if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
	    &retval) != TCL_OK) {
	Tcl_AddErrorInfo(interp,
		"    (return value from \"testevent\" callback)");
	Tcl_BackgroundException(interp, TCL_ERROR);
	Tcl_BackgroundError(interp);
	return 1;
    }
    if (retval) {
	Tcl_DecrRefCount(ev->tag);
	Tcl_DecrRefCount(ev->command);
    }

2220
2221
2222
2223
2224
2225
2226
2227

2228
2229
2230
2231
2232
2233
2234
2174
2175
2176
2177
2178
2179
2180

2181
2182
2183
2184
2185
2186
2187
2188







-
+







 *
 *----------------------------------------------------------------------
 */

static int
TesteventDeleteProc(
    Tcl_Event *event,		/* Event to examine */
    void *clientData)	/* Tcl_Obj containing the name of the event(s)
    ClientData clientData)	/* Tcl_Obj containing the name of the event(s)
				 * to remove */
{
    TestEvent *ev;		/* Event to examine */
    const char *evNameStr;
    Tcl_Obj *targetName;	/* Name of the event(s) to delete */
    const char *targetNameStr;

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
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







-
+
















-
+


-
+










-
+













-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexithandlerCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int value;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" create|delete value\"", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "create") == 0) {
	Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
		INT2PTR(value));
		(ClientData) INT2PTR(value));
    } else if (strcmp(argv[1], "delete") == 0) {
	Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
		INT2PTR(value));
		(ClientData) INT2PTR(value));
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be create or delete", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void
ExitProcOdd(
    void *clientData)	/* Integer value to print. */
    ClientData clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    int len;

    sprintf(buf, "odd %d\n", (int)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (int) write(1, buf, len)) {
	Tcl_Panic("ExitProcOdd: unable to write to stdout");
    }
}

static void
ExitProcEven(
    void *clientData)	/* Integer value to print. */
    ClientData clientData)	/* Integer value to print. */
{
    char buf[16 + TCL_INTEGER_SPACE];
    int len;

    sprintf(buf, "even %d\n", (int)PTR2INT(clientData));
    len = strlen(buf);
    if (len != (int) write(1, buf, len)) {
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
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







-
+













-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprlongCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    long exprResult;
    char buf[4 + TCL_INTEGER_SPACE];
    int result;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" expression\"", NULL);
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
    result = Tcl_ExprLong(interp, argv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    sprintf(buf, ": %ld", exprResult);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
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
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







-
+












-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprlongobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument objects. */
{
    long exprResult;
    char buf[4 + TCL_INTEGER_SPACE];
    int result;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "expression");
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
    result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    sprintf(buf, ": %ld", exprResult);
    Tcl_AppendResult(interp, buf, NULL);
    return TCL_OK;
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
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







-
+













-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprdoubleCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    double exprResult;
    char buf[4 + TCL_DOUBLE_SPACE];
    int result;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" expression\"", NULL);
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
    result = Tcl_ExprDouble(interp, argv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    strcpy(buf, ": ");
    Tcl_PrintDouble(interp, exprResult, buf+2);
    Tcl_AppendResult(interp, buf, NULL);
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
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







-
+












-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprdoubleobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument objects. */
{
    double exprResult;
    char buf[4 + TCL_DOUBLE_SPACE];
    int result;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "expression");
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, "This is a result", NULL);
    Tcl_SetResult(interp, "This is a result", TCL_STATIC);
    result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
    if (result != TCL_OK) {
	return result;
    }
    strcpy(buf, ": ");
    Tcl_PrintDouble(interp, exprResult, buf+2);
    Tcl_AppendResult(interp, buf, NULL);
2510
2511
2512
2513
2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
2464
2465
2466
2467
2468
2469
2470

2471
2472
2473
2474
2475
2476
2477
2478







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprstringCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" expression\"", NULL);
2542
2543
2544
2545
2546
2547
2548
2549

2550
2551
2552
2553
2554
2555
2556
2496
2497
2498
2499
2500
2501
2502

2503
2504
2505
2506
2507
2508
2509
2510







-
+







 *	May create a link on disk.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilelinkCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Obj *contents;

    if (objc < 2 || objc > 3) {
2609
2610
2611
2612
2613
2614
2615
2616

2617
2618
2619
2620
2621
2622
2623
2563
2564
2565
2566
2567
2568
2569

2570
2571
2572
2573
2574
2575
2576
2577







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetassocdataCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    char *res;

    if (argc != 2) {
2647
2648
2649
2650
2651
2652
2653
2654

2655
2656
2657
2658
2659

2660
2661
2662
2663
2664
2665
2666
2601
2602
2603
2604
2605
2606
2607

2608
2609
2610
2611
2612

2613
2614
2615
2616
2617
2618
2619
2620







-
+




-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetplatformCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static const char *const platformStrings[] = { "unix", "mac", "windows" };
    static const char *platformStrings[] = { "unix", "mac", "windows" };
    TclPlatformType *platform;

    platform = TclGetPlatform();

    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		NULL);
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
2709
2710

2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730

2731
2732
2733
2734

2735
2736
2737
2738
2739
2740
2741
2742

2743
2744
2745
2746
2747
2748
2749
2750
2751
2752

2753
2754
2755
2756
2757
2758
2759
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648

2649
2650
2651
2652
2653

2654
2655
2656
2657
2658
2659
2660


2661
2662
2663
2664

2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715







+



-
+




-
+






-
-
+
+


-
+




















+



-
+







-
+









-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Deletes one or more interpreters.
 *
 *----------------------------------------------------------------------
 */


static int
TestinterpdeleteCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Interp *childToDelete;
    Tcl_Interp *slaveToDelete;

    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" path\"", NULL);
	return TCL_ERROR;
    }
    childToDelete = Tcl_GetChild(interp, argv[1]);
    if (childToDelete == NULL) {
    slaveToDelete = Tcl_GetSlave(interp, argv[1]);
    if (slaveToDelete == NULL) {
	return TCL_ERROR;
    }
    Tcl_DeleteInterp(childToDelete);
    Tcl_DeleteInterp(slaveToDelete);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestlinkCmd --
 *
 *	This procedure implements the "testlink" command.  It is used
 *	to test Tcl_LinkVar and related library procedures.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates and deletes various variable links, plus returns
 *	values of the linked variables.
 *
 *----------------------------------------------------------------------
 */


static int
TestlinkCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static int intVar = 43;
    static int boolVar = 4;
    static double realVar = 1.23;
    static Tcl_WideInt wideVar = 79;
    static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
    static char *stringVar = NULL;
    static char charVar = '@';
    static unsigned char ucharVar = 130;
    static short shortVar = 3000;
    static unsigned short ushortVar = 60000;
    static unsigned int uintVar = 0xBEEFFEED;
    static long longVar = 123456789L;
    static unsigned long ulongVar = 3456789012UL;
    static float floatVar = 4.5;
    static Tcl_WideUInt uwideVar = 123;
    static Tcl_WideUInt uwideVar = (Tcl_WideUInt) Tcl_LongAsWide(123);
    static int created = 0;
    char buffer[2*TCL_DOUBLE_SPACE];
    int writable, flag;
    Tcl_Obj *tmp;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
2786
2787
2788
2789
2790
2791
2792
2793

2794
2795
2796
2797
2798
2799
2800
2801

2802
2803
2804
2805
2806
2807
2808
2809

2810
2811
2812
2813
2814
2815
2816
2817

2818
2819
2820
2821
2822
2823
2824
2825

2826
2827
2828
2829
2830
2831
2832
2833

2834
2835
2836
2837
2838
2839
2840
2841

2842
2843
2844
2845
2846
2847
2848
2849

2850
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
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
2742
2743
2744
2745
2746
2747
2748

2749
2750
2751
2752
2753
2754
2755
2756

2757
2758
2759
2760
2761
2762
2763
2764

2765
2766
2767
2768
2769
2770
2771
2772

2773
2774
2775
2776
2777
2778
2779
2780

2781
2782
2783
2784
2785
2786
2787
2788

2789
2790
2791
2792
2793
2794
2795
2796

2797
2798
2799
2800
2801
2802
2803
2804

2805
2806
2807
2808
2809
2810
2811
2812

2813
2814
2815
2816
2817
2818
2819
2820

2821
2822
2823
2824
2825
2826
2827
2828

2829
2830
2831
2832
2833
2834
2835
2836

2837
2838
2839
2840
2841
2842
2843
2844

2845
2846
2847
2848
2849
2850
2851
2852

2853
2854
2855
2856
2857
2858
2859
2860







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







	    Tcl_UnlinkVar(interp, "uwide");
	}
	created = 1;
	if (Tcl_GetBoolean(interp, argv[2], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "int", &intVar,
	if (Tcl_LinkVar(interp, "int", (char *) &intVar,
		TCL_LINK_INT | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[3], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "real", &realVar,
	if (Tcl_LinkVar(interp, "real", (char *) &realVar,
		TCL_LINK_DOUBLE | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[4], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "bool", &boolVar,
	if (Tcl_LinkVar(interp, "bool", (char *) &boolVar,
		TCL_LINK_BOOLEAN | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[5], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "string", &stringVar,
	if (Tcl_LinkVar(interp, "string", (char *) &stringVar,
		TCL_LINK_STRING | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[6], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "wide", &wideVar,
	if (Tcl_LinkVar(interp, "wide", (char *) &wideVar,
			TCL_LINK_WIDE_INT | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[7], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "char", &charVar,
	if (Tcl_LinkVar(interp, "char", (char *) &charVar,
		TCL_LINK_CHAR | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[8], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "uchar", &ucharVar,
	if (Tcl_LinkVar(interp, "uchar", (char *) &ucharVar,
		TCL_LINK_UCHAR | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[9], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "short", &shortVar,
	if (Tcl_LinkVar(interp, "short", (char *) &shortVar,
		TCL_LINK_SHORT | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[10], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "ushort", &ushortVar,
	if (Tcl_LinkVar(interp, "ushort", (char *) &ushortVar,
		TCL_LINK_USHORT | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[11], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "uint", &uintVar,
	if (Tcl_LinkVar(interp, "uint", (char *) &uintVar,
		TCL_LINK_UINT | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[12], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "long", &longVar,
	if (Tcl_LinkVar(interp, "long", (char *) &longVar,
		TCL_LINK_LONG | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[13], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "ulong", &ulongVar,
	if (Tcl_LinkVar(interp, "ulong", (char *) &ulongVar,
		TCL_LINK_ULONG | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[14], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "float", &floatVar,
	if (Tcl_LinkVar(interp, "float", (char *) &floatVar,
		TCL_LINK_FLOAT | flag) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBoolean(interp, argv[15], &writable) != TCL_OK) {
	    return TCL_ERROR;
	}
	flag = (writable != 0) ? 0 : TCL_LINK_READ_ONLY;
	if (Tcl_LinkVar(interp, "uwide", &uwideVar,
	if (Tcl_LinkVar(interp, "uwide", (char *) &uwideVar,
		TCL_LINK_WIDE_UINT | flag) != TCL_OK) {
	    return TCL_ERROR;
	}

    } else if (strcmp(argv[1], "delete") == 0) {
	Tcl_UnlinkVar(interp, "int");
	Tcl_UnlinkVar(interp, "real");
2935
2936
2937
2938
2939
2940
2941
2942

2943
2944
2945

2946
2947
2948
2949
2950
2951
2952
2891
2892
2893
2894
2895
2896
2897

2898
2899
2900

2901
2902
2903
2904
2905
2906
2907
2908







-
+


-
+







	Tcl_AppendElement(interp, buffer);
	TclFormatInt(buffer, (int) shortVar);
	Tcl_AppendElement(interp, buffer);
	TclFormatInt(buffer, (int) ushortVar);
	Tcl_AppendElement(interp, buffer);
	TclFormatInt(buffer, (int) uintVar);
	Tcl_AppendElement(interp, buffer);
	tmp = Tcl_NewWideIntObj(longVar);
	tmp = Tcl_NewLongObj(longVar);
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
	tmp = Tcl_NewWideIntObj((long)ulongVar);
	tmp = Tcl_NewLongObj((long)ulongVar);
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
	Tcl_PrintDouble(NULL, (double)floatVar, buffer);
	Tcl_AppendElement(interp, buffer);
	tmp = Tcl_NewWideIntObj((Tcl_WideInt)uwideVar);
	Tcl_AppendElement(interp, Tcl_GetString(tmp));
	Tcl_DecrRefCount(tmp);
2974
2975
2976
2977
2978
2979
2980
2981

2982
2983
2984
2985
2986

2987
2988
2989
2990
2991
2992
2993
2930
2931
2932
2933
2934
2935
2936

2937
2938
2939
2940
2941

2942
2943
2944
2945
2946
2947
2948
2949







-
+




-
+







	if (argv[4][0] != 0) {
	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		Tcl_Free(stringVar);
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		stringVar = (char *)ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
		Tcl_DecrRefCount(tmp);
3081
3082
3083
3084
3085
3086
3087
3088

3089
3090
3091
3092
3093

3094
3095
3096
3097
3098
3099
3100
3037
3038
3039
3040
3041
3042
3043

3044
3045
3046
3047
3048

3049
3050
3051
3052
3053
3054
3055
3056







-
+




-
+







	    if (Tcl_GetInt(interp, argv[4], &boolVar) != TCL_OK) {
		return TCL_ERROR;
	    }
	    Tcl_UpdateLinkedVar(interp, "bool");
	}
	if (argv[5][0] != 0) {
	    if (stringVar != NULL) {
		Tcl_Free(stringVar);
		ckfree(stringVar);
	    }
	    if (strcmp(argv[5], "-") == 0) {
		stringVar = NULL;
	    } else {
		stringVar = (char *)Tcl_Alloc(strlen(argv[5]) + 1);
		stringVar = (char *)ckalloc(strlen(argv[5]) + 1);
		strcpy(stringVar, argv[5]);
	    }
	    Tcl_UpdateLinkedVar(interp, "string");
	}
	if (argv[6][0] != 0) {
	    tmp = Tcl_NewStringObj(argv[6], -1);
	    if (Tcl_GetWideIntFromObj(interp, tmp, &wideVar) != TCL_OK) {
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















-
+






+
-
+







    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestlinkarrayCmd --
 *
 *      This function is invoked to process the "testlinkarray" Tcl command.
 *      It is used to test the 'Tcl_LinkArray' function.
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *	Creates, deletes, and invokes variable links.
 *
 *----------------------------------------------------------------------
 */

static int
TestlinkarrayCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,         /* Current interpreter. */
    int objc,                   /* Number of arguments. */
    Tcl_Obj *const objv[])      /* Argument objects. */
{
    static const char *LinkOption[] = {
        "update", "remove", "create", NULL
    };
    enum LinkOptionEnum { LINK_UPDATE, LINK_REMOVE, LINK_CREATE };
    static const char *LinkType[] = {
	"char", "uchar", "short", "ushort", "int", "uint", "long", "ulong",
	"wide", "uwide", "float", "double", "string", "char*", "binary", NULL
    };
    /* all values after TCL_LINK_CHARS_ARRAY are used as arrays (see below) */
    static int LinkTypes[] = {
	TCL_LINK_CHAR, TCL_LINK_UCHAR,
	TCL_LINK_SHORT, TCL_LINK_USHORT, TCL_LINK_INT, TCL_LINK_UINT,
	TCL_LINK_LONG, TCL_LINK_ULONG, TCL_LINK_WIDE_INT, TCL_LINK_WIDE_UINT,
	TCL_LINK_FLOAT, TCL_LINK_DOUBLE, TCL_LINK_STRING, TCL_LINK_CHARS,
	TCL_LINK_BINARY
    };
    int optionIndex, typeIndex, readonly, i, size, length;
    char *name, *arg;
    Tcl_WideInt addr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option args");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], LinkOption, "option", 0,
	    &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum LinkOptionEnum) optionIndex) {
    case LINK_UPDATE:
	for (i=2; i<objc; i++) {
	    Tcl_UpdateLinkedVar(interp, Tcl_GetString(objv[i]));
	}
	return TCL_OK;
    case LINK_REMOVE:
	for (i=2; i<objc; i++) {
	    Tcl_UnlinkVar(interp, Tcl_GetString(objv[i]));
	}
	return TCL_OK;
    case LINK_CREATE:
	if (objc < 4) {
	    goto wrongArgs;
	}
	readonly = 0;
	i = 2;

	/*
	 * test on switch -r...
	 */

	arg = Tcl_GetStringFromObj(objv[i], &length);
	if (length < 2) {
	    goto wrongArgs;
	}
	if (arg[0] == '-') {
	    if (arg[1] != 'r') {
		goto wrongArgs;
	    }
	    readonly = TCL_LINK_READ_ONLY;
	    i++;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i++], LinkType, "type", 0,
 		&typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[i++], &size) == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong size value", -1));
	    return TCL_ERROR;
	}
	name = Tcl_GetString(objv[i++]);

	/*
	 * If no address is given request one in the underlying function
	 */

	if (i < objc) {
	    if (Tcl_GetWideIntFromObj(interp, objv[i], &addr) == TCL_ERROR) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"wrong address value", -1));
		return TCL_ERROR;
	    }
	} else {
	    addr = 0;
	}
	return Tcl_LinkArray(interp, name, INT2PTR(addr),
		LinkTypes[typeIndex] | readonly, size);
    }
    return TCL_OK;

  wrongArgs:
    Tcl_WrongNumArgs(interp, 2, objv, "?-readonly? type size name ?address?");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TestlocaleCmd --
 *
 *	This procedure implements the "testlocale" command.  It is used
 *	to test the effects of setting different locales in Tcl.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Modifies the current C locale.
 *
 *----------------------------------------------------------------------
 */

static int
TestlocaleCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int index;
    const char *locale;

    static const char *const optionStrings[] = {
    static const char *optionStrings[] = {
	"ctype", "numeric", "time", "collate", "monetary",
	"all",	NULL
    };
    static const int lcTypes[] = {
	LC_CTYPE, LC_NUMERIC, LC_TIME, LC_COLLATE, LC_MONETARY,
	LC_ALL
    };
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-
-
+
+

-
+







    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestMathFunc --
 *
 *	This is a user-defined math procedure to test out math procedures
 *	with no arguments.
 *
 * Results:
 *	A normal Tcl completion code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


static int
TestMathFunc(
    ClientData clientData,	/* Integer value to return. */
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Value *args,		/* Not used. */
    Tcl_Value *resultPtr)	/* Where to store result. */
{
    resultPtr->type = TCL_INT;
    resultPtr->intValue = PTR2INT(clientData);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestMathFunc2 --
 *
 *	This is a user-defined math procedure to test out math procedures
 *	that do have arguments, in this case 2.
 *
 * Results:
 *	A normal Tcl completion code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


static int
TestMathFunc2(
    ClientData clientData,	/* Integer value to return. */
    Tcl_Interp *interp,		/* Used to report errors. */
    Tcl_Value *args,		/* Points to an array of two Tcl_Value structs
				 * for the two arguments. */
    Tcl_Value *resultPtr)	/* Where to store the result. */
{
    int result = TCL_OK;

    /*
     * Return the maximum of the two arguments with the correct type.
     */

    if (args[0].type == TCL_INT) {
	int i0 = args[0].intValue;

	if (args[1].type == TCL_INT) {
	    int i1 = args[1].intValue;

	    resultPtr->type = TCL_INT;
	    resultPtr->intValue = ((i0 > i1)? i0 : i1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d0 = i0;
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    Tcl_WideInt w0 = Tcl_LongAsWide(i0);
	    Tcl_WideInt w1 = args[1].wideValue;

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else {
	    Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
	    result = TCL_ERROR;
	}
    } else if (args[0].type == TCL_DOUBLE) {
	double d0 = args[0].doubleValue;

	if (args[1].type == TCL_INT) {
	    double d1 = args[1].intValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    double d1 = Tcl_WideAsDouble(args[1].wideValue);

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else {
	    Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
	    result = TCL_ERROR;
	}
    } else if (args[0].type == TCL_WIDE_INT) {
	Tcl_WideInt w0 = args[0].wideValue;

	if (args[1].type == TCL_INT) {
	    Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d0 = Tcl_WideAsDouble(w0);
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    Tcl_WideInt w1 = args[1].wideValue;

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else {
	    Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
	    result = TCL_ERROR;
	}
    } else {
	Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC);
	result = TCL_ERROR;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * CleanupTestSetassocdataTests --
 *
 *	This function is called when an interpreter is deleted to clean
 *	up any data left over from running the testsetassocdata command.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Releases storage.
 *
 *----------------------------------------------------------------------
 */

static void
CleanupTestSetassocdataTests(
    void *clientData,	/* Data to be released. */
    TCL_UNUSED(Tcl_Interp *))
    ClientData clientData,	/* Data to be released. */
    Tcl_Interp *interp)		/* Interpreter being deleted. */
{
    Tcl_Free(clientData);
    ckfree((char *)clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TestparserObjCmd --
 *
3399
3400
3401
3402
3403
3404
3405
3406

3407
3408
3409
3410
3411
3412
3413
3376
3377
3378
3379
3380
3381
3382

3383
3384
3385
3386
3387
3388
3389
3390







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestparserObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int length, dummy;
    Tcl_Parse parse;
3455
3456
3457
3458
3459
3460
3461
3462

3463
3464
3465
3466
3467
3468
3469
3432
3433
3434
3435
3436
3437
3438

3439
3440
3441
3442
3443
3444
3445
3446







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexprparserObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int length, dummy;
    Tcl_Parse parse;
3602
3603
3604
3605
3606
3607
3608
3609

3610
3611
3612
3613
3614
3615
3616
3579
3580
3581
3582
3583
3584
3585

3586
3587
3588
3589
3590
3591
3592
3593







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestparsevarObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *value, *name, *termPtr;

    if (objc != 2) {
3643
3644
3645
3646
3647
3648
3649
3650

3651
3652
3653
3654
3655
3656
3657
3620
3621
3622
3623
3624
3625
3626

3627
3628
3629
3630
3631
3632
3633
3634







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestparsevarnameObjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *script;
    int append, length, dummy;
    Tcl_Parse parse;
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
3775
3776
3777
3778
3779
3780

3781
3782
3783
3784

3785
3786
3787
3788
3789

3790
3791
3792
3793
3794
3795
3796

3797
3798
3799
3800
3801
3802

3803
3804
3805
3806
3807
3808
3809
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















+



-
+




-
+
-





-
+





-
+







    Tcl_FreeParse(&parse);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestpreferstableObjCmd --
 *
 *	This procedure implements the "testpreferstable" command.  It is
 *	used for being able to test the "package" command even when the
 *  environment variable TCL_PKG_PREFER_LATEST is set in your environment.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestpreferstableObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
    Interp *iPtr = (Interp *) interp;

    iPtr->packagePrefer = PKG_PREFER_STABLE;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestprintObjCmd --
 *
 *	This procedure implements the "testprint" command.  It is
 *	used for being able to test the Tcl_ObjPrintf() function.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestprintObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_WideInt argv1 = 0;
    size_t argv2;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
    }

    if (objc > 1) {
	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
    }
    argv2 = (size_t)argv1;
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestregexpObjCmd --
 *
 *	This procedure implements the "testregexp" command. It is used to give
 *	a direct interface for regexp flags. It's identical to
 *	Tcl_RegexpObjCmd except for the -xflags option, and the consequences
 *	thereof (including the REG_EXPECT kludge).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */


static int
TestregexpObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, indices, stringLength, match, about;
    int i, ii, indices, stringLength, match, about;
    size_t ii;
    int hasxflags, cflags, eflags;
    Tcl_RegExp regExpr;
    const char *string;
    Tcl_Obj *objPtr;
    Tcl_RegExpInfo info;
    static const char *const options[] = {
    static const char *options[] = {
	"-indices",	"-nocase",	"-about",	"-expanded",
	"-line",	"-linestop",	"-lineanchor",
	"-xflags",
	"--",		NULL
    };
    enum optionsEnum {
    enum options {
	REGEXP_INDICES, REGEXP_NOCASE,	REGEXP_ABOUT,	REGEXP_EXPANDED,
	REGEXP_MULTI,	REGEXP_NOCROSS,	REGEXP_NEWL,
	REGEXP_XFLAGS,
	REGEXP_LAST
    };

    indices = 0;
3820
3821
3822
3823
3824
3825
3826
3827

3828
3829
3830
3831
3832
3833
3834
3727
3728
3729
3730
3731
3732
3733

3734
3735
3736
3737
3738
3739
3740
3741







-
+







	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum optionsEnum) index) {
	switch ((enum options) index) {
	case REGEXP_INDICES:
	    indices = 1;
	    break;
	case REGEXP_NOCASE:
	    cflags |= REG_ICASE;
	    break;
	case REGEXP_ABOUT:
3896
3897
3898
3899
3900
3901
3902
3903

3904
3905
3906
3907
3908
3909


3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923


3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943

3944
3945
3946
3947

3948
3949
3950
3951

3952
3953
3954
3955


3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966

3967
3968
3969
3970
3971


3972
3973
3974
3975

3976
3977
3978
3979
3980
3981
3982
3983
3984
3985

3986


3987
3988
3989
3990
3991
3992
3993
3803
3804
3805
3806
3807
3808
3809

3810
3811
3812
3813
3814


3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828


3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849

3850
3851
3852
3853

3854
3855
3856
3857

3858
3859
3860


3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872

3873
3874
3875
3876


3877
3878
3879
3880
3881

3882
3883
3884
3885
3886
3887
3888
3889
3890
3891

3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902







-
+




-
-
+
+












-
-
+
+



















-
+



-
+



-
+


-
-
+
+










-
+



-
-
+
+



-
+









-
+

+
+







	 * value 0.
	 */

	Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
	if (objc > 2 && (cflags&REG_EXPECT) && indices) {
	    const char *varName;
	    const char *value;
	    size_t start, end;
	    int start, end;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    varName = Tcl_GetString(objv[2]);
	    TclRegExpRangeUniChar(regExpr, -1, &start, &end);
	    sprintf(resinfo, "%d %d", (int)start, (int)(end-1));
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    sprintf(resinfo, "%d %d", start, end-1);
	    value = Tcl_SetVar(interp, varName, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	} else if (cflags & TCL_REG_CANMATCH) {
	    const char *varName;
	    const char *value;
	    char resinfo[TCL_INTEGER_SPACE * 2];

	    Tcl_RegExpGetInfo(regExpr, &info);
	    varName = Tcl_GetString(objv[2]);
	    sprintf(resinfo, "%d", (int)info.extendStart);
	    value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
	    sprintf(resinfo, "%ld", info.extendStart);
	    value = Tcl_SetVar(interp, varName, resinfo, 0);
	    if (value == NULL) {
		Tcl_AppendResult(interp, "couldn't set variable \"",
			varName, "\"", NULL);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    }

    /*
     * If additional variable names have been specified, return
     * index information in those variables.
     */

    objc -= 2;
    objv += 2;

    Tcl_RegExpGetInfo(regExpr, &info);
    for (i = 0; i < objc; i++) {
	size_t start, end;
	int start, end;
	Tcl_Obj *newPtr, *varPtr, *valuePtr;

	varPtr = objv[i];
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? TCL_INDEX_NONE : (size_t)i;
	ii = ((cflags&REG_EXPECT) && i == objc-1) ? -1 : i;
	if (indices) {
	    Tcl_Obj *objs[2];

	    if (ii == TCL_INDEX_NONE) {
	    if (ii == -1) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
	    } else if (ii > info.nsubs) {
		start = TCL_INDEX_NONE;
		end = TCL_INDEX_NONE;
		start = -1;
		end = -1;
	    } else {
		start = info.matches[ii].start;
		end = info.matches[ii].end;
	    }

	    /*
	     * Adjust index so it refers to the last character in the match
	     * instead of the first character after the match.
	     */

	    if (end != TCL_INDEX_NONE) {
	    if (end >= 0) {
		end--;
	    }

	    objs[0] = Tcl_NewIntObj(start);
	    objs[1] = Tcl_NewIntObj(end);
	    objs[0] = Tcl_NewLongObj(start);
	    objs[1] = Tcl_NewLongObj(end);

	    newPtr = Tcl_NewListObj(2, objs);
	} else {
	    if (ii == TCL_INDEX_NONE) {
	    if (ii == -1) {
		TclRegExpRangeUniChar(regExpr, ii, &start, &end);
		newPtr = Tcl_GetRange(objPtr, start, end);
	    } else if (ii > info.nsubs) {
		newPtr = Tcl_NewObj();
	    } else {
		newPtr = Tcl_GetRange(objPtr, info.matches[ii].start,
			info.matches[ii].end - 1);
	    }
	}
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, TCL_LEAVE_ERR_MSG);
	valuePtr = Tcl_ObjSetVar2(interp, varPtr, NULL, newPtr, 0);
	if (valuePtr == NULL) {
	    Tcl_AppendResult(interp, "couldn't set variable \"",
		    Tcl_GetString(varPtr), "\"", NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result to an integer object w/ value 1.
     */
4012
4013
4014
4015
4016
4017
4018
4019

4020
4021
4022
4023
4024

4025
4026
4027
4028
4029
4030
4031
3921
3922
3923
3924
3925
3926
3927

3928
3929
3930
3931


3932
3933
3934
3935
3936
3937
3938
3939







-
+



-
-
+







 *
 *----------------------------------------------------------------------
 */

static void
TestregexpXflags(
    const char *string,	/* The string of flags. */
    size_t length,			/* The length of the string in bytes. */
    int length,			/* The length of the string in bytes. */
    int *cflagsPtr,		/* compile flags word */
    int *eflagsPtr)		/* exec flags word */
{
    size_t i;
    int cflags, eflags;
    int i, cflags, eflags;

    cflags = *cflagsPtr;
    eflags = *eflagsPtr;
    for (i = 0; i < length; i++) {
	switch (string[i]) {
	case 'a':
	    cflags |= REG_ADVF;
4099
4100
4101
4102
4103
4104
4105

4106
4107
4108
4109
4110
4111
4112




4113
4114
4115
4116
4117
4118
4119
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017




4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028







+



-
-
-
-
+
+
+
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */


static int
TestreturnObjCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return TCL_RETURN;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+













-
+









-
+


-
+
+







 *	data for this interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetassocdataCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    char *buf, *oldData;
    Tcl_InterpDeleteProc *procPtr;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" data_key data_item\"", NULL);
	return TCL_ERROR;
    }

    buf = (char *)Tcl_Alloc(strlen(argv[2]) + 1);
    buf = ckalloc(strlen(argv[2]) + 1);
    strcpy(buf, argv[2]);

    /*
     * If we previously associated a malloced value with the variable,
     * free it before associating a new value.
     */

    oldData = (char *) Tcl_GetAssocData(interp, argv[1], &procPtr);
    if ((oldData != NULL) && (procPtr == CleanupTestSetassocdataTests)) {
	Tcl_Free(oldData);
	ckfree(oldData);
    }

    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,	buf);
    Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
	(ClientData) buf);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetplatformCmd --
4181
4182
4183
4184
4185
4186
4187
4188

4189
4190
4191
4192
4193
4194
4195
4091
4092
4093
4094
4095
4096
4097

4098
4099
4100
4101
4102
4103
4104
4105







-
+







 *	Sets the tclPlatform global variable.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetplatformCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    size_t length;
    TclPlatformType *platform;

4209
4210
4211
4212
4213
4214
4215





























4216
4217
4218
4219
4220
4221
4222
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    } else {
	Tcl_AppendResult(interp, "unsupported platform: should be one of "
		"unix, or windows", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static int
TestsizeCmd(
    ClientData clientData,      /* Unused */
    Tcl_Interp* interp,         /* Tcl interpreter */
    int objc,                   /* Parameter count */
    Tcl_Obj *const * objv)      /* Parameter vector */
{
    if (objc != 2) {
        goto syntax;
    }
    if (strcmp(Tcl_GetString(objv[1]), "time_t") == 0) {
        Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(time_t)));
        return TCL_OK;
    }
    if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) {
        Tcl_StatBuf *statPtr;
        Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime)));
        return TCL_OK;
    }
    if (strcmp(Tcl_GetString(objv[1]), "unichar") == 0) {
        Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(Tcl_UniChar)));
        return TCL_OK;
    }

syntax:
    Tcl_WrongNumArgs(interp, 1, objv, "time_t|st_mtime|unichar");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TeststaticpkgCmd --
 *
 *	This procedure implements the "teststaticpkg" command.
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
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







-
+

















-
-
+
+








-
+







 *	variable "x" in that interpreter is set to "loaded".
 *
 *----------------------------------------------------------------------
 */

static int
TeststaticpkgCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int safe, loaded;

    if (argc != 4) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
		argv[0], " pkgName safe loaded\"", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
	    StaticInitProc, (safe) ? StaticInitProc : NULL);
    Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc,
	    (safe) ? StaticInitProc : NULL);
    return TCL_OK;
}

static int
StaticInitProc(
    Tcl_Interp *interp)		/* Interpreter in which package is supposedly
				 * being loaded. */
{
    Tcl_SetVar2(interp, "x", NULL, "loaded", TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TesttranslatefilenameCmd --
4281
4282
4283
4284
4285
4286
4287
4288

4289
4290
4291
4292
4293
4294
4295
4220
4221
4222
4223
4224
4225
4226

4227
4228
4229
4230
4231
4232
4233
4234







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TesttranslatefilenameCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_DString buffer;
    const char *result;

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
4346
4347
4348

4349
4350
4351
4352
4353
4354
4355
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







+



-
+


















-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates or modifies an "upvar" reference.
 *
 *----------------------------------------------------------------------
 */


static int
TestupvarCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int flags = 0;

    if ((argc != 5) && (argc != 6)) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
		argv[0], " level name ?name2? dest global\"", NULL);
	return TCL_ERROR;
    }

    if (argc == 5) {
	if (strcmp(argv[4], "global") == 0) {
	    flags = TCL_GLOBAL_ONLY;
	} else if (strcmp(argv[4], "namespace") == 0) {
	    flags = TCL_NAMESPACE_ONLY;
	}
	return Tcl_UpVar2(interp, argv[1], argv[2], NULL, argv[3], flags);
	return Tcl_UpVar(interp, argv[1], argv[2], argv[3], flags);
    } else {
	if (strcmp(argv[5], "global") == 0) {
	    flags = TCL_GLOBAL_ONLY;
	} else if (strcmp(argv[5], "namespace") == 0) {
	    flags = TCL_NAMESPACE_ONLY;
	}
	return Tcl_UpVar2(interp, argv[1], argv[2],
4371
4372
4373
4374
4375
4376
4377

4378
4379
4380
4381

4382
4383
4384
4385
4386
4387

4388
4389
4390
4391
4392
4393
4394
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







+



-
+





-
+







 *	the error code can be tested.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


static int
TestseterrorcodeCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    if (argc > 6) {
	Tcl_AppendResult(interp, "too many args", NULL);
	Tcl_SetResult(interp, "too many args", TCL_STATIC);
	return TCL_ERROR;
    }
    switch (argc) {
    case 1:
	Tcl_SetErrorCode(interp, "NONE", NULL);
	break;
    case 2:
4423
4424
4425
4426
4427
4428
4429

4430
4431
4432
4433

4434
4435
4436
4437
4438
4439
4440
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374

4375
4376
4377
4378
4379
4380
4381
4382







+



-
+







 *	the error code can be tested.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


static int
TestsetobjerrorcodeCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_SetObjErrorCode(interp, Tcl_ConcatObj(objc - 1, objv + 1));
    return TCL_ERROR;
}
4451
4452
4453
4454
4455
4456
4457

4458
4459
4460
4461

4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482

4483
4484
4485
4486
4487
4488
4489
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403

4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424

4425
4426
4427
4428
4429
4430
4431
4432







+



-
+




















-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates and deletes interpreters.
 *
 *----------------------------------------------------------------------
 */


static int
TestfeventCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static Tcl_Interp *interp2 = NULL;
    int code;
    Tcl_Channel chan;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option ?arg ...?", NULL);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "cmd") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " cmd script", NULL);
	    return TCL_ERROR;
	}
	if (interp2 != NULL) {
	    code = Tcl_EvalEx(interp2, argv[2], -1, TCL_EVAL_GLOBAL);
	    code = Tcl_GlobalEval(interp2, argv[2]);
	    Tcl_SetObjResult(interp, Tcl_GetObjResult(interp2));
	    return code;
	} else {
	    Tcl_AppendResult(interp,
		    "called \"testfevent code\" before \"testfevent create\"",
		    NULL);
	    return TCL_ERROR;
4526
4527
4528
4529
4530
4531
4532
4533
4534


4535
4536
4537


4538
4539
4540
4541
4542
4543

4544
4545

4546
4547
4548
4549
4550
4551
4552

4553
4554
4555
4556
4557
4558
4559
4469
4470
4471
4472
4473
4474
4475


4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487

4488
4489

4490
4491
4492
4493
4494
4495
4496

4497
4498
4499
4500
4501
4502
4503
4504







-
-
+
+



+
+





-
+

-
+






-
+







 *	May exit application.
 *
 *----------------------------------------------------------------------
 */

static int
TestpanicCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    char *argString;

    /*
     *  Put the arguments into a var args structure
     *  Append all of the arguments together separated by spaces
     */

    char *argString = Tcl_Merge(argc-1, argv+1);
    argString = Tcl_Merge(argc-1, argv+1);
    Tcl_Panic("%s", argString);
    Tcl_Free(argString);
    ckfree(argString);

    return TCL_OK;
}

static int
TestfileCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    Tcl_Obj *const argv[])	/* The argument objects. */
{
    int force, i, j, result;
    Tcl_Obj *error = NULL;
    const char *subcmd;
4627
4628
4629
4630
4631
4632
4633
4634

4635
4636
4637
4638
4639
4640
4641
4642
4643

4644
4645
4646
4647
4648
4649
4650
4572
4573
4574
4575
4576
4577
4578

4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596







-
+









+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetvarfullnameCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    const char *name, *arg;
    int flags = 0;
    Tcl_Namespace *namespacePtr;
    Tcl_CallFrame *framePtr;
    Tcl_Var variable;
    int result;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name scope");
	return TCL_ERROR;
    }

    name = Tcl_GetString(objv[1]);
4664
4665
4666
4667
4668
4669
4670
4671

4672



4673
4674
4675
4676
4677
4678
4679
4610
4611
4612
4613
4614
4615
4616

4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628







-
+

+
+
+








    if (flags == TCL_NAMESPACE_ONLY) {
	namespacePtr = Tcl_FindNamespace(interp, "::test_ns_var", NULL,
		TCL_LEAVE_ERR_MSG);
	if (namespacePtr == NULL) {
	    return TCL_ERROR;
	}
	(void) TclPushStackFrame(interp, &framePtr, namespacePtr,
	result = TclPushStackFrame(interp, &framePtr, namespacePtr,
		/*isProcCallFrame*/ 0);
	if (result != TCL_OK) {
	    return result;
	}
    }

    variable = Tcl_FindNamespaceVar(interp, name, NULL,
	    (flags | TCL_LEAVE_ERR_MSG));

    if (flags == TCL_NAMESPACE_ONLY) {
	TclPopStackFrame(interp);
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
4650
4651
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







-
+

-
-
+
+








+
+





-
-
+
+







-
+


-
+









-
+







 *	Allocates and frees memory, sets a variable "a" in the interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
GetTimesObjCmd(
    TCL_UNUSED(void *),
    ClientData unused,		/* Unused. */
    Tcl_Interp *interp,		/* The current interpreter. */
    TCL_UNUSED(int) /*cobjc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*cobjv*/)
    int objc,			/* Number of arguments. (not used)*/
    Tcl_Obj *const dummy[])	/* The argument objects (not used). */
{
    Interp *iPtr = (Interp *) interp;
    int i, n;
    double timePer;
    Tcl_Time start, stop;
    Tcl_Obj *objPtr, **objv;
    const char *s;
    char newString[TCL_INTEGER_SPACE];
    (void)objc;
    (void)dummy;

    /* alloc & free 100000 times */
    fprintf(stderr, "alloc & free 100000 6 word items\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	objPtr = (Tcl_Obj *)Tcl_Alloc(sizeof(Tcl_Obj));
	Tcl_Free(objPtr);
	objPtr = (Tcl_Obj *)ckalloc(sizeof(Tcl_Obj));
	ckfree((char *)objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc+free\n", timePer/100000);

    /* alloc 5000 times */
    fprintf(stderr, "alloc 5000 6 word items\n");
    objv = (Tcl_Obj **)Tcl_Alloc(5000 * sizeof(Tcl_Obj *));
    objv = (Tcl_Obj **) ckalloc(5000 * sizeof(Tcl_Obj *));
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	objv[i] = (Tcl_Obj *)Tcl_Alloc(sizeof(Tcl_Obj));
	objv[i] = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj));
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per alloc\n", timePer/5000);

    /* free 5000 times */
    fprintf(stderr, "free 5000 6 word items\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 5000;  i++) {
	Tcl_Free(objv[i]);
	ckfree((char *)objv[i]);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per free\n", timePer/5000);

    /* Tcl_NewObj 5000 times */
    fprintf(stderr, "Tcl_NewObj 5000 times\n");
4766
4767
4768
4769
4770
4771
4772
4773

4774
4775
4776
4777
4778
4779
4780
4717
4718
4719
4720
4721
4722
4723

4724
4725
4726
4727
4728
4729
4730
4731







-
+







    for (i = 0;  i < 5000;  i++) {
	objPtr = objv[i];
	Tcl_DecrRefCount(objPtr);
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_DecrRefCount\n", timePer/5000);
    Tcl_Free(objv);
    ckfree((char *)objv);

    /* TclGetString 100000 times */
    fprintf(stderr, "TclGetStringFromObj of \"12345\" 100000 times\n");
    objPtr = Tcl_NewStringObj("12345", -1);
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	(void) TclGetString(objPtr);
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
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







-
+


-
+













-
+







    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per hashtable lookup of \"gettimes\"\n",
	    timePer/100000);

    /* Tcl_SetVar 100000 times */
    fprintf(stderr, "Tcl_SetVar2 of \"12345\" 100000 times\n");
    fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	s = Tcl_SetVar2(interp, "a", NULL, "12345", TCL_LEAVE_ERR_MSG);
	s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG);
	if (s == NULL) {
	    return TCL_ERROR;
	}
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_SetVar of a to \"12345\"\n",
	    timePer/100000);

    /* Tcl_GetVar 100000 times */
    fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n");
    Tcl_GetTime(&start);
    for (i = 0;  i < 100000;  i++) {
	s = Tcl_GetVar2(interp, "a", NULL, TCL_LEAVE_ERR_MSG);
	s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG);
	if (s == NULL) {
	    return TCL_ERROR;
	}
    }
    Tcl_GetTime(&stop);
    timePer = (stop.sec - start.sec)*1000000 + (stop.usec - start.usec);
    fprintf(stderr, "   %.3f usec per Tcl_GetVar of a==\"12345\"\n",
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890




4891
4892
4893
4894
4895
4896
4897
4831
4832
4833
4834
4835
4836
4837




4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848







-
-
-
-
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NoopCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    ClientData unused,		/* Unused. */
    Tcl_Interp *interp,		/* The current interpreter. */
    int argc,			/* The number of arguments. */
    const char **argv)		/* The argument strings. */
{
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917




4918
4919
4920
4921
4922
4923
4924
4858
4859
4860
4861
4862
4863
4864




4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875







-
-
-
-
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NoopObjCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
4932
4933
4934
4935
4936
4937
4938
4939

4940
4941
4942
4943
4944
4945

4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
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







-
+






+









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+




-
+

+






-
+
-
-
-







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TeststringbytesObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n;
    const unsigned char *p;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n);
    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestpurebytesobjObjCmd --
 *
 *	This object-based procedure constructs a pure bytes object
 *	without type and with internal representation containing NULL's.
 *
 *	If no argument supplied it returns empty object with tclEmptyStringRep,
 *	otherwise it returns this as pure bytes object with bytes value equal
 *	string.
 *
 * Results:
 *	Returns the TCL_OK result code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestpurebytesobjObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Obj *objPtr;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?string?");
	return TCL_ERROR;
    }
    objPtr = Tcl_NewObj();
    /*
    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    */
    memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
    if (objc == 2) {
	const char *s = Tcl_GetString(objv[1]);
	objPtr->length = objv[1]->length;
	objPtr->bytes = (char *)Tcl_Alloc(objPtr->length + 1);
	memcpy(objPtr->bytes, s, objPtr->length);
	objPtr->bytes[objPtr->length] = 0;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetbytearraylengthObjCmd --
 *
 *	Testing command 'testsetbytearraylength` used to test the public
 *	interface routine Tcl_SetByteArrayLength().
 *
 * Results:
 *	Returns the TCL_OK result code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetbytearraylengthObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    int n;
    Tcl_Obj *obj = NULL;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "value length");
	return TCL_ERROR;
    }
    if (TCL_OK != Tcl_GetIntFromObj(interp, objv[2], &n)) {
	return TCL_ERROR;
    }
    if (Tcl_IsShared(objv[1])) {
	obj = Tcl_DuplicateObj(objv[1]);
    } else {
	obj = objv[1];
    }
    Tcl_SetByteArrayLength(obj, n);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestbytestringObjCmd --
 *
 *	This object-based procedure constructs a string which can
 *	possibly contain invalid UTF-8 bytes.
 *
 * Results:
 *	Returns the TCL_OK result code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestbytestringObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    size_t n = 0;
    int n = 0;
    const char *p;
    (void)dummy;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytearray");
	return TCL_ERROR;
    }

    p = (const char *)TclGetBytesFromObj(interp, objv[1], &n);
    p = (const char *)Tcl_GetByteArrayFromObj(objv[1], &n);
    if (p == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
5103
5104
5105
5106
5107
5108
5109
5110

5111
5112
5113
5114
5115
5116
5117
5118
5119

5120
5121
5122
5123
5124
5125
5126
5127

5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142

5143
5144
5145
5146
5147
5148
5149
5150
5151

5152
5153
5154
5155
5156
5157
5158
5159

5160
5161
5162
5163
5164
5165
5166
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021







-
+








-
+







-
+














-
+








-
+







-
+







 *     Variables may be set.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetCmd(
    void *data,		/* Additional flags for Get/SetVar2. */
    ClientData data,		/* Additional flags for Get/SetVar2. */
    Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int flags = PTR2INT(data);
    const char *value;

    if (argc == 2) {
	Tcl_AppendResult(interp, "before get", NULL);
	Tcl_SetResult(interp, "before get", TCL_STATIC);
	value = Tcl_GetVar2(interp, argv[1], NULL, flags);
	if (value == NULL) {
	    return TCL_ERROR;
	}
	Tcl_AppendElement(interp, value);
	return TCL_OK;
    } else if (argc == 3) {
	Tcl_AppendResult(interp, "before set", NULL);
	Tcl_SetResult(interp, "before set", TCL_STATIC);
	value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags);
	if (value == NULL) {
	    return TCL_ERROR;
	}
	Tcl_AppendElement(interp, value);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " varName ?newValue?\"", NULL);
	return TCL_ERROR;
    }
}
static int
Testset2Cmd(
    void *data,		/* Additional flags for Get/SetVar2. */
    ClientData data,		/* Additional flags for Get/SetVar2. */
    Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int flags = PTR2INT(data);
    const char *value;

    if (argc == 3) {
	Tcl_AppendResult(interp, "before get", NULL);
	Tcl_SetResult(interp, "before get", TCL_STATIC);
	value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
	if (value == NULL) {
	    return TCL_ERROR;
	}
	Tcl_AppendElement(interp, value);
	return TCL_OK;
    } else if (argc == 4) {
	Tcl_AppendResult(interp, "before set", NULL);
	Tcl_SetResult(interp, "before set", TCL_STATIC);
	value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
	if (value == NULL) {
	    return TCL_ERROR;
	}
	Tcl_AppendElement(interp, value);
	return TCL_OK;
    } else {
5185
5186
5187
5188
5189
5190
5191
5192

5193
5194
5195
5196

5197
5198
5199
5200

5201
5202
5203
5204
5205
5206
5207
5040
5041
5042
5043
5044
5045
5046

5047
5048
5049
5050
5051
5052
5053
5054
5055

5056
5057
5058
5059
5060
5061
5062
5063







-
+




+



-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestsaveresultCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Interp* iPtr = (Interp*) interp;
    int discard, result, index;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *const optionStrings[] = {
    static const char *optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
	RESULT_APPEND, RESULT_DYNAMIC, RESULT_FREE, RESULT_OBJECT, RESULT_SMALL
    };

    /*
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227

5228
5229
5230
5231
5232
5233

5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247

5248
5249
5250
5251
5252
5253

5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265






5266

5267
5268
5269
5270
5271
5272
5273
5072
5073
5074
5075
5076
5077
5078

5079
5080
5081

5082
5083
5084
5085
5086
5087

5088
5089
5090
5091
5092
5093
5094
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108

5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119


5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134







-



-
+





-
+














+





-
+










-
-
+
+
+
+
+
+

+







	    &index) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[3], &discard) != TCL_OK) {
	return TCL_ERROR;
    }

    freeCount = 0;
    objPtr = NULL;		/* Lint. */
    switch ((enum options) index) {
    case RESULT_SMALL:
	Tcl_AppendResult(interp, "small result", NULL);
	Tcl_SetResult(interp, "small result", TCL_VOLATILE);
	break;
    case RESULT_APPEND:
	Tcl_AppendResult(interp, "append result", NULL);
	break;
    case RESULT_FREE: {
	char *buf = (char *)Tcl_Alloc(200);
	char *buf = ckalloc(200);

	strcpy(buf, "free result");
	Tcl_SetResult(interp, buf, TCL_DYNAMIC);
	break;
    }
    case RESULT_DYNAMIC:
	Tcl_SetResult(interp, (char *)"dynamic result", TestsaveresultFree);
	break;
    case RESULT_OBJECT:
	objPtr = Tcl_NewStringObj("object result", -1);
	Tcl_SetObjResult(interp, objPtr);
	break;
    }

    freeCount = 0;
    Tcl_SaveResult(interp, &state);

    if (((enum options) index) == RESULT_OBJECT) {
	result = Tcl_EvalObjEx(interp, objv[2], 0);
    } else {
	result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0);
	result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
    }

    if (discard) {
	Tcl_DiscardResult(&state);
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC:
	Tcl_AppendElement(interp, freeCount ? "freed" : "leak");
    case RESULT_DYNAMIC: {
	int present = iPtr->freeProc == TestsaveresultFree;
	int called = freeCount;

	Tcl_AppendElement(interp, called ? "called" : "notCalled");
	Tcl_AppendElement(interp, present ? "present" : "missing");
	break;
    }
    case RESULT_OBJECT:
	Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
		? "same" : "different");
	break;
    default:
	break;
    }
5288
5289
5290
5291
5292
5293
5294
5295

5296
5297
5298



































































































































































































5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320


5321
5322

5323
5324
5325


5326
5327
5328
5329
5330
5331
5332






5333
5334
5335
5336
5337
5338
5339
5149
5150
5151
5152
5153
5154
5155

5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374


5375
5376
5377

5378
5379


5380
5381







5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394







-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















-
-
+
+

-
+

-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+







 *	Increments the freeCount.
 *
 *----------------------------------------------------------------------
 */

static void
TestsaveresultFree(
    TCL_UNUSED(void *))
    char *blockPtr)
{
    freeCount++;
}
#ifdef USE_OBSOLETE_FS_HOOKS

/*
 *----------------------------------------------------------------------
 *
 * TeststatprocCmd  --
 *
 *	Implements the "testTclStatProc" cmd that is used to test the
 *	'TclStatInsertProc' & 'TclStatDeleteProc' C Apis.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TeststatprocCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TclStatProc_ *proc;
    int retVal;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option arg\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[2], "TclpStat") == 0) {
	proc = PretendTclpStat;
    } else if (strcmp(argv[2], "TestStatProc1") == 0) {
	proc = TestStatProc1;
    } else if (strcmp(argv[2], "TestStatProc2") == 0) {
	proc = TestStatProc2;
    } else if (strcmp(argv[2], "TestStatProc3") == 0) {
	proc = TestStatProc3;
    } else {
	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		"must be TclpStat, "
		"TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "insert") == 0) {
	if (proc == PretendTclpStat) {
	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		   "must be "
		   "TestStatProc1, TestStatProc2, or TestStatProc3", NULL);
	    return TCL_ERROR;
	}
	retVal = TclStatInsertProc(proc);
    } else if (strcmp(argv[1], "delete") == 0) {
	retVal = TclStatDeleteProc(proc);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
		"must be insert or delete", NULL);
	return TCL_ERROR;
    }

    if (retVal == TCL_ERROR) {
	Tcl_AppendResult(interp, "\"", argv[2], "\": "
		"could not be ", argv[1], "ed", NULL);
    }

    return retVal;
}

static int
PretendTclpStat(
    const char *path,
    struct stat *buf)
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
#ifdef TCL_WIDE_INT_IS_LONG
    Tcl_IncrRefCount(pathPtr);
    ret = TclpObjStat(pathPtr, buf);
    Tcl_DecrRefCount(pathPtr);
    return ret;
#else /* TCL_WIDE_INT_IS_LONG */
    Tcl_StatBuf realBuf;
    Tcl_IncrRefCount(pathPtr);
    ret = TclpObjStat(pathPtr, &realBuf);
    Tcl_DecrRefCount(pathPtr);
    if (ret != -1) {
#   define OUT_OF_RANGE(x) \
	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
#if defined(__GNUC__) && __GNUC__ >= 2
/*
 * Workaround gcc warning of "comparison is always false due to limited range of
 * data type" in this macro by checking max type size, and when necessary ANDing
 * with the complement of ULONG_MAX instead of the comparison:
 */
#   define OUT_OF_URANGE(x) \
	((((Tcl_WideUInt)(~ (__typeof__(x)) 0)) > (Tcl_WideUInt)ULONG_MAX) && \
	 (((Tcl_WideUInt)(x)) & ~(Tcl_WideUInt)ULONG_MAX))
#else
#   define OUT_OF_URANGE(x) \
	(((Tcl_WideUInt)(x)) > (Tcl_WideUInt)ULONG_MAX)
#endif

	/*
	 * Perform the result-buffer overflow check manually.
	 *
	 * Note that ino_t/ino64_t is unsigned...
	 */

	if (OUT_OF_URANGE(realBuf.st_ino) || OUT_OF_RANGE(realBuf.st_size)
#   ifdef HAVE_STRUCT_STAT_ST_BLOCKS
		|| OUT_OF_RANGE(realBuf.st_blocks)
#   endif
	    ) {
#   ifdef EOVERFLOW
	    errno = EOVERFLOW;
#   else
#       ifdef EFBIG
	    errno = EFBIG;
#       else
#	    error "what error should be returned for a value out of range?"
#       endif
#   endif
	    return -1;
	}

#   undef OUT_OF_RANGE
#   undef OUT_OF_URANGE

	/*
	 * Copy across all supported fields, with possible type coercions on
	 * those fields that change between the normal and lf64 versions of
	 * the stat structure (on Solaris at least.) This is slow when the
	 * structure sizes coincide, but that's what you get for mixing
	 * interfaces...
	 */

	buf->st_mode    = realBuf.st_mode;
	buf->st_ino     = (ino_t) realBuf.st_ino;
	buf->st_dev     = realBuf.st_dev;
	buf->st_rdev    = realBuf.st_rdev;
	buf->st_nlink   = realBuf.st_nlink;
	buf->st_uid     = realBuf.st_uid;
	buf->st_gid     = realBuf.st_gid;
	buf->st_size    = (off_t) realBuf.st_size;
	buf->st_atime   = realBuf.st_atime;
	buf->st_mtime   = realBuf.st_mtime;
	buf->st_ctime   = realBuf.st_ctime;
#   ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
	buf->st_blksize = realBuf.st_blksize;
#   endif
#   ifdef HAVE_STRUCT_STAT_ST_BLOCKS
	buf->st_blocks  = (blkcnt_t) realBuf.st_blocks;
#   endif
    }
    return ret;
#endif /* TCL_WIDE_INT_IS_LONG */
}

static int
TestStatProc1(
    const char *path,
    struct stat *buf)
{
    memset(buf, 0, sizeof(struct stat));
    buf->st_size = 1234;
    return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
}

static int
TestStatProc2(
    const char *path,
    struct stat *buf)
{
    memset(buf, 0, sizeof(struct stat));
    buf->st_size = 2345;
    return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
}

static int
TestStatProc3(
    const char *path,
    struct stat *buf)
{
    memset(buf, 0, sizeof(struct stat));
    buf->st_size = 3456;
    return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TestmainthreadCmd  --
 *
 *	Implements the "testmainthread" cmd that is used to test the
 *	'Tcl_GetCurrentThread' API.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestmainthreadCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,/* Current interpreter. */
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    TCL_UNUSED(const char **) /*argv*/)
    const char **argv)		/* Argument strings. */
{
    if (argc == 1) {
	Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
  if (argc == 1) {
      Tcl_Obj *idObj = Tcl_NewLongObj((long)(size_t)Tcl_GetCurrentThread());

	Tcl_SetObjResult(interp, idObj);
	return TCL_OK;
    } else {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
      Tcl_SetObjResult(interp, idObj);
      return TCL_OK;
  } else {
      Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
      return TCL_ERROR;
  }
}

/*
 *----------------------------------------------------------------------
 *
 * MainLoop --
 *
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383




5384
5385
5386
5387



5388
5389
5390
5391
5392
5393
5394
5428
5429
5430
5431
5432
5433
5434




5435
5436
5437
5438
5439



5440
5441
5442
5443
5444
5445
5446
5447
5448
5449







-
-
-
-
+
+
+
+

-
-
-
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetmainloopCmd(
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    exitMainLoop = 0;
    Tcl_SetMainLoop(MainLoop);
    return TCL_OK;
  exitMainLoop = 0;
  Tcl_SetMainLoop(MainLoop);
  return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestexitmainloopCmd  --
 *
5402
5403
5404
5405
5406
5407
5408









5409
5410
5411
5412
5413
5414
5415




























































































































































































































5416

















































































5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433

5434
5435
5436
5437

5438
5439
5440
5441
5442
5443
5444
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472







5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795

5796
5797
5798
5799
5800
5801
5802
5803







+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















+



-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestexitmainloopCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
  exitMainLoop = 1;
  return TCL_OK;
}
#ifdef USE_OBSOLETE_FS_HOOKS
    TCL_UNUSED(void *),
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
{
    exitMainLoop = 1;
    return TCL_OK;

/*
 *----------------------------------------------------------------------
 *
 * TestaccessprocCmd  --
 *
 *	Implements the "testTclAccessProc" cmd that is used to test the
 *	'TclAccessInsertProc' & 'TclAccessDeleteProc' C Apis.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestaccessprocCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TclAccessProc_ *proc;
    int retVal;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option arg\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[2], "TclpAccess") == 0) {
	proc = PretendTclpAccess;
    } else if (strcmp(argv[2], "TestAccessProc1") == 0) {
	proc = TestAccessProc1;
    } else if (strcmp(argv[2], "TestAccessProc2") == 0) {
	proc = TestAccessProc2;
    } else if (strcmp(argv[2], "TestAccessProc3") == 0) {
	proc = TestAccessProc3;
    } else {
	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		"must be TclpAccess, "
		"TestAccessProc1, TestAccessProc2, or TestAccessProc3", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "insert") == 0) {
	if (proc == PretendTclpAccess) {
	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": must be "
		   "TestAccessProc1, TestAccessProc2, or TestAccessProc3"
		   NULL);
	    return TCL_ERROR;
	}
	retVal = TclAccessInsertProc(proc);
    } else if (strcmp(argv[1], "delete") == 0) {
	retVal = TclAccessDeleteProc(proc);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
		"must be insert or delete", NULL);
	return TCL_ERROR;
    }

    if (retVal == TCL_ERROR) {
	Tcl_AppendResult(interp, "\"", argv[2], "\": "
		"could not be ", argv[1], "ed", NULL);
    }

    return retVal;
}

static int
PretendTclpAccess(
    const char *path,
    int mode)
{
    int ret;
    Tcl_Obj *pathPtr = Tcl_NewStringObj(path, -1);
    Tcl_IncrRefCount(pathPtr);
    ret = TclpObjAccess(pathPtr, mode);
    Tcl_DecrRefCount(pathPtr);
    return ret;
}

static int
TestAccessProc1(
    const char *path,
    int mode)
{
    return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
}

static int
TestAccessProc2(
    const char *path,
    int mode)
{
    return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
}

static int
TestAccessProc3(
    const char *path,
    int mode)
{
    return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
}

/*
 *----------------------------------------------------------------------
 *
 * TestopenfilechannelprocCmd  --
 *
 *	Implements the "testTclOpenFileChannelProc" cmd that is used to test
 *	the 'TclOpenFileChannelInsertProc' & 'TclOpenFileChannelDeleteProc' C
 *	Apis.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestopenfilechannelprocCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    TclOpenFileChannelProc_ *proc;
    int retVal;

    if (argc != 3) {
	Tcl_AppendResult(interp, "wrong # args: should be \"",
		argv[0], " option arg\"", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[2], "TclpOpenFileChannel") == 0) {
	proc = PretendTclpOpenFileChannel;
    } else if (strcmp(argv[2], "TestOpenFileChannelProc1") == 0) {
	proc = TestOpenFileChannelProc1;
    } else if (strcmp(argv[2], "TestOpenFileChannelProc2") == 0) {
	proc = TestOpenFileChannelProc2;
    } else if (strcmp(argv[2], "TestOpenFileChannelProc3") == 0) {
	proc = TestOpenFileChannelProc3;
    } else {
	Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		"must be TclpOpenFileChannel, "
		"TestOpenFileChannelProc1, TestOpenFileChannelProc2, or "
		"TestOpenFileChannelProc3", NULL);
	return TCL_ERROR;
    }

    if (strcmp(argv[1], "insert") == 0) {
	if (proc == PretendTclpOpenFileChannel) {
	    Tcl_AppendResult(interp, "bad arg \"", argv[1], "\": "
		   "must be "
		   "TestOpenFileChannelProc1, TestOpenFileChannelProc2, or "
		   "TestOpenFileChannelProc3", NULL);
	    return TCL_ERROR;
	}
	retVal = TclOpenFileChannelInsertProc(proc);
    } else if (strcmp(argv[1], "delete") == 0) {
	retVal = TclOpenFileChannelDeleteProc(proc);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1], "\": "
		"must be insert or delete", NULL);
	return TCL_ERROR;
    }

    if (retVal == TCL_ERROR) {
	Tcl_AppendResult(interp, "\"", argv[2], "\": "
		"could not be ", argv[1], "ed", NULL);
    }

    return retVal;
}

static Tcl_Channel
PretendTclpOpenFileChannel(
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    const char *fileName,	/* Name of file to open. */
    const char *modeString,	/* A list of POSIX open modes or
				 * a string such as "rw". */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    Tcl_Channel ret;
    int mode, seekFlag;
    Tcl_Obj *pathPtr;
    mode = TclGetOpenMode(interp, modeString, &seekFlag);
    if (mode == -1) {
	return NULL;
    }
    pathPtr = Tcl_NewStringObj(fileName, -1);
    Tcl_IncrRefCount(pathPtr);
    ret = TclpOpenFileChannel(interp, pathPtr, mode, permissions);
    Tcl_DecrRefCount(pathPtr);
    if (ret != NULL) {
	if (seekFlag) {
	    if (Tcl_Seek(ret, (Tcl_WideInt)0, SEEK_END) < (Tcl_WideInt)0) {
		if (interp != NULL) {
		    Tcl_AppendResult(interp,
			    "could not seek to end of file while opening \"",
			    fileName, "\": ", Tcl_PosixError(interp), NULL);
		}
		Tcl_Close(NULL, ret);
		return NULL;
	    }
	}
    }
    return ret;
}

static Tcl_Channel
TestOpenFileChannelProc1(
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    const char *fileName,	/* Name of file to open. */
    const char *modeString,	/* A list of POSIX open modes or
				 * a string such as "rw". */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    const char *expectname = "testOpenFileChannel1%.fil";
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
    Tcl_JoinPath(1, &expectname, &ds);

    if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
	Tcl_DStringFree(&ds);
	return (PretendTclpOpenFileChannel(interp,
		"__testOpenFileChannel1%__.fil",
		modeString, permissions));
    } else {
	Tcl_DStringFree(&ds);
	return NULL;
    }
}

static Tcl_Channel
TestOpenFileChannelProc2(
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    const char *fileName,	/* Name of file to open. */
    const char *modeString,	/* A list of POSIX open modes or
				 * a string such as "rw". */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    const char *expectname = "testOpenFileChannel2%.fil";
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
    Tcl_JoinPath(1, &expectname, &ds);

    if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
	Tcl_DStringFree(&ds);
	return (PretendTclpOpenFileChannel(interp,
		"__testOpenFileChannel2%__.fil",
		modeString, permissions));
    } else {
	Tcl_DStringFree(&ds);
	return (NULL);
    }
}

static Tcl_Channel
TestOpenFileChannelProc3(
    Tcl_Interp *interp,		/* Interpreter for error reporting; can be
				 * NULL. */
    const char *fileName,	/* Name of file to open. */
    const char *modeString,	/* A list of POSIX open modes or a string such
				 * as "rw". */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    const char *expectname = "testOpenFileChannel3%.fil";
    Tcl_DString ds;

    Tcl_DStringInit(&ds);
    Tcl_JoinPath(1, &expectname, &ds);

    if (!strcmp(Tcl_DStringValue(&ds), fileName)) {
	Tcl_DStringFree(&ds);
	return (PretendTclpOpenFileChannel(interp, "__testOpenFileChannel3%__.fil",
		modeString, permissions));
    } else {
	Tcl_DStringFree(&ds);
	return (NULL);
    }
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TestChannelCmd --
 *
 *	Implements the Tcl "testchannel" debugging command and its
 *	subcommands. This is part of the testing environment.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


static int
TestChannelCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter for result. */
    int argc,			/* Count of additional args. */
    const char **argv)		/* Additional arg strings. */
{
    const char *cmdName;	/* Sub command. */
    Tcl_HashTable *hTblPtr;	/* Hash table of channels. */
    Tcl_HashSearch hSearch;	/* Search variable. */
5474
5475
5476
5477
5478
5479
5480
5481

5482
5483
5484
5485
5486
5487
5488
5833
5834
5835
5836
5837
5838
5839

5840
5841
5842
5843
5844
5845
5846
5847







-
+







		 curPtr != NULL;
		 nextPtrPtr = &(curPtr->nextPtr), curPtr = curPtr->nextPtr) {

		if (strcmp(argv[2], Tcl_GetChannelName(curPtr->chan)) == 0) {
		    *nextPtrPtr = curPtr->nextPtr;
		    curPtr->nextPtr = NULL;
		    chan = curPtr->chan;
		    Tcl_Free(curPtr);
		    ckfree((char *)curPtr);
		    break;
		}
	    }
	} else {
	    chan = Tcl_GetChannel(interp, argv[2], &mode);
	}
	if (chan == (Tcl_Channel) NULL) {
5543
5544
5545
5546
5547
5548
5549
5550

5551
5552
5553
5554
5555
5556
5557
5902
5903
5904
5905
5906
5907
5908

5909
5910
5911
5912
5913
5914
5915
5916







-
+







	Tcl_RegisterChannel(NULL, chan); /* prevent closing */
	Tcl_UnregisterChannel(interp, chan);

	Tcl_CutChannel(chan);

	/* Remember the channel in the pool of detached channels */

	det = (TestChannel *)Tcl_Alloc(sizeof(TestChannel));
	det = (TestChannel *)ckalloc(sizeof(TestChannel));
	det->chan     = chan;
	det->nextPtr  = firstDetached;
	firstDetached = det;

	return TCL_OK;
    }

5894
5895
5896
5897
5898
5899
5900

5901
5902
5903
5904

5905
5906
5907
5908
5909
5910
5911
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263

6264
6265
6266
6267
6268
6269
6270
6271







+



-
+







 *	A standard Tcl result.
 *
 * Side effects:
 *	Creates, deletes and returns channel event handlers.
 *
 *----------------------------------------------------------------------
 */


static int
TestChannelEventCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Obj *resultListPtr;
    Channel *chanPtr;
    ChannelState *statePtr;	/* state info for channel */
5922
5923
5924
5925
5926
5927
5928
5929

5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947


5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958

5959
5960
5961
5962
5963

5964
5965
5966
5967
5968
5969
5970
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







-
+

















-
+
+










-
+




-
+







    if (chanPtr == NULL) {
	return TCL_ERROR;
    }
    statePtr = chanPtr->state;

    cmd = argv[2];
    len = strlen(cmd);
    if ((cmd[0] == 'a') && (strncmp(cmd, "add", len) == 0)) {
    if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " channelName add eventSpec script\"", NULL);
	    return TCL_ERROR;
	}
	if (strcmp(argv[3], "readable") == 0) {
	    mask = TCL_READABLE;
	} else if (strcmp(argv[3], "writable") == 0) {
	    mask = TCL_WRITABLE;
	} else if (strcmp(argv[3], "none") == 0) {
	    mask = 0;
	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[3],
		    "\": must be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}

	esPtr = (EventScriptRecord *)Tcl_Alloc(sizeof(EventScriptRecord));
	esPtr = (EventScriptRecord *) ckalloc((unsigned)
		sizeof(EventScriptRecord));
	esPtr->nextPtr = statePtr->scriptRecordPtr;
	statePtr->scriptRecordPtr = esPtr;

	esPtr->chanPtr = chanPtr;
	esPtr->interp = interp;
	esPtr->mask = mask;
	esPtr->scriptPtr = Tcl_NewStringObj(argv[4], -1);
	Tcl_IncrRefCount(esPtr->scriptPtr);

	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, esPtr);
		TclChannelEventScriptInvoker, (ClientData) esPtr);

	return TCL_OK;
    }

    if ((cmd[0] == 'd') && (strncmp(cmd, "delete", len) == 0)) {
    if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
	if (argc != 4) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " channelName delete index\"", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
	    return TCL_ERROR;
5995
5996
5997
5998
5999
6000
6001
6002

6003
6004

6005
6006
6007
6008
6009

6010
6011
6012
6013
6014
6015
6016
6356
6357
6358
6359
6360
6361
6362

6363
6364

6365
6366
6367
6368
6369

6370
6371
6372
6373
6374
6375
6376
6377







-
+

-
+




-
+







	    }
	    if (prevEsPtr == NULL) {
		Tcl_Panic("TestChannelEventCmd: damaged event script list");
	    }
	    prevEsPtr->nextPtr = esPtr->nextPtr;
	}
	Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		TclChannelEventScriptInvoker, esPtr);
		TclChannelEventScriptInvoker, (ClientData) esPtr);
	Tcl_DecrRefCount(esPtr->scriptPtr);
	Tcl_Free(esPtr);
	ckfree((char *)esPtr);

	return TCL_OK;
    }

    if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) {
    if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " channelName list\"", NULL);
	    return TCL_ERROR;
	}
	resultListPtr = Tcl_GetObjResult(interp);
	for (esPtr = statePtr->scriptRecordPtr;
6025
6026
6027
6028
6029
6030
6031
6032

6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043

6044
6045

6046
6047
6048
6049
6050
6051

6052
6053
6054
6055
6056
6057
6058
6386
6387
6388
6389
6390
6391
6392

6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403

6404
6405

6406
6407
6408
6409
6410
6411

6412
6413
6414
6415
6416
6417
6418
6419







-
+










-
+

-
+





-
+







	    }
	    Tcl_ListObjAppendElement(interp, resultListPtr, esPtr->scriptPtr);
	}
	Tcl_SetObjResult(interp, resultListPtr);
	return TCL_OK;
    }

    if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", len) == 0)) {
    if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " channelName removeall\"", NULL);
	    return TCL_ERROR;
	}
	for (esPtr = statePtr->scriptRecordPtr;
	     esPtr != NULL;
	     esPtr = nextEsPtr) {
	    nextEsPtr = esPtr->nextPtr;
	    Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
		    TclChannelEventScriptInvoker, esPtr);
		    TclChannelEventScriptInvoker, (ClientData) esPtr);
	    Tcl_DecrRefCount(esPtr->scriptPtr);
	    Tcl_Free(esPtr);
	    ckfree((char *)esPtr);
	}
	statePtr->scriptRecordPtr = NULL;
	return TCL_OK;
    }

    if	((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) {
    if	((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " channelName delete index event\"", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, argv[3], &index) == TCL_ERROR) {
	    return TCL_ERROR;
6082
6083
6084
6085
6086
6087
6088
6089

6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174
6175
6176
6177
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231

6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244

6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261

6262
6263
6264
6265
6266
6267
6268
6443
6444
6445
6446
6447
6448
6449

6450
6451
6452
6453
6454
6455
6456
6457




















































































































6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475

6476
6477
6478
6479
6480
6481
6482
6483
6484
6485
6486
6487
6488

6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
6499
6500
6501
6502
6503
6504
6505

6506
6507
6508
6509
6510
6511
6512
6513







-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















-
+












-
+
















-
+







	} else {
	    Tcl_AppendResult(interp, "bad event name \"", argv[4],
		    "\": must be readable, writable, or none", NULL);
	    return TCL_ERROR;
	}
	esPtr->mask = mask;
	Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
		TclChannelEventScriptInvoker, esPtr);
		TclChannelEventScriptInvoker, (ClientData) esPtr);
	return TCL_OK;
    }
    Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of "
	    "add, delete, list, set, or removeall", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TestSocketCmd --
 *
 *	Implements the Tcl "testsocket" debugging command and its
 *	subcommands. This is part of the testing environment.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestSocketCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Interpreter for result. */
    int argc,			/* Count of additional args. */
    const char **argv)		/* Additional arg strings. */
{
    const char *cmdName;	/* Sub command. */
    size_t len;			/* Length of subcommand string. */

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" subcommand ?additional args..?\"", NULL);
	return TCL_ERROR;
    }
    cmdName = argv[1];
    len = strlen(cmdName);

    if ((cmdName[0] == 't') && (strncmp(cmdName, "testflags", len) == 0)) {
        Tcl_Channel hChannel;
        int modePtr;
        TcpState *statePtr;
        /* Set test value in the socket driver
         */
        /* Check for argument "channel name"
         */
        if (argc < 4) {
            Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                    " testflags channel flags\"", NULL);
            return TCL_ERROR;
        }
        hChannel = Tcl_GetChannel(interp, argv[2], &modePtr);
        if ( NULL == hChannel ) {
            Tcl_AppendResult(interp, "unknown channel:", argv[2], NULL);
            return TCL_ERROR;
        }
        statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel);
        if ( NULL == statePtr) {
            Tcl_AppendResult(interp, "No channel instance data:", argv[2],
                    NULL);
            return TCL_ERROR;
        }
        statePtr->testFlags = atoi(argv[3]);
        return TCL_OK;
    }

    Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be "
	    "testflags", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TestServiceModeCmd --
 *
 *	This procedure implements the "testservicemode" command which gets or
 *      sets the current Tcl ServiceMode.  There are several tests which open
 *      a file and assign various handlers to it.  For these tests to be
 *      deterministic it is important that file events not be processed until
 *      all of the handlers are in place.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May change the ServiceMode setting.
 *
 *----------------------------------------------------------------------
 */

static int
TestServiceModeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int newmode, oldmode;
    if (argc > 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                         " ?newmode?\"", NULL);
        return TCL_ERROR;
    }
    oldmode = (Tcl_GetServiceMode() != TCL_SERVICE_NONE);
    if (argc == 2) {
        if (Tcl_GetInt(interp, argv[1], &newmode) == TCL_ERROR) {
            return TCL_ERROR;
        }
        if (newmode == 0) {
            Tcl_SetServiceMode(TCL_SERVICE_NONE);
        } else {
            Tcl_SetServiceMode(TCL_SERVICE_ALL);
        }
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(oldmode));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestWrongNumArgsObjCmd --
 *
 *	Test the Tcl_WrongNumArgs function.
 *
 * Results:
 *	Standard Tcl result.
 *
 * Side effects:
 *	Sets interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
TestWrongNumArgsObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, length;
    const char *msg;

    if (objc < 3) {
	/*
	 * Don't use Tcl_WrongNumArgs here, as that is the function
	 * we want to test!
	 */
	Tcl_AppendResult(interp, "insufficient arguments", NULL);
	Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
	return TCL_ERROR;
    }

    msg = Tcl_GetStringFromObj(objv[2], &length);
    if (length == 0) {
	msg = NULL;
    }

    if (i > objc - 3) {
	/*
	 * Asked for more arguments than were given.
	 */
	Tcl_AppendResult(interp, "insufficient arguments", NULL);
	Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
	return TCL_ERROR;
    }

    Tcl_WrongNumArgs(interp, i, &(objv[3]), msg);
    return TCL_OK;
}

6280
6281
6282
6283
6284
6285
6286
6287

6288
6289
6290
6291
6292
6293
6294
6525
6526
6527
6528
6529
6530
6531

6532
6533
6534
6535
6536
6537
6538
6539







-
+







 *	Sets interpreter result.
 *
 *----------------------------------------------------------------------
 */

static int
TestGetIndexFromObjStructObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *const ary[] = {
	"a", "b", "c", "d", "e", "f", NULL, NULL
    };
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
6579
6580
6581
6582
6583
6584
6585

6586
6587
6588
6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601

6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614

6615
6616
6617
6618
6619
6620
6621
6622







-
+















-
+












-
+







 *	Inserts or removes a filesystem from Tcl's stack.
 *
 *----------------------------------------------------------------------
 */

static int
TestFilesystemObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int res, boolVal;
    const char *msg;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
	return TCL_ERROR;
    }
    if (boolVal) {
	res = Tcl_FSRegister(interp, &testReportingFilesystem);
	res = Tcl_FSRegister((ClientData)interp, &testReportingFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&testReportingFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
    return res;
}

static int
TestReportInFilesystem(
    Tcl_Obj *pathPtr,
    void **clientDataPtr)
    ClientData *clientDataPtr)
{
    static Tcl_Obj *lastPathPtr = NULL;
    Tcl_Obj *newPathPtr;

    if (pathPtr == lastPathPtr) {
	/* Reject all files second time around */
	return -1;
6385
6386
6387
6388
6389
6390
6391
6392

6393
6394
6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410

6411
6412
6413
6414
6415
6416
6417
6418
6419
6420

6421
6422

6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440





6441

6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458


6459
6460
6461
6462
6463


6464
6465
6466
6467
6468
6469
6470
6630
6631
6632
6633
6634
6635
6636

6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654

6655
6656
6657
6658
6659
6660
6661
6662
6663
6664

6665
6666

6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690

6691
6692
6693
6694
6695
6696
6697
6698
6699
6700
6701
6702
6703
6704




6705
6706
6707




6708
6709
6710
6711
6712
6713
6714
6715
6716







-
+

















-
+









-
+

-
+


















+
+
+
+
+
-
+













-
-
-
-
+
+

-
-
-
-
+
+







    if (Tcl_FSGetFileSystemForPath(newPathPtr) == NULL) {
	/* Nothing claimed it. Therefore we don't either */
	Tcl_DecrRefCount(newPathPtr);
	lastPathPtr = NULL;
	return -1;
    }
    lastPathPtr = NULL;
    *clientDataPtr = newPathPtr;
    *clientDataPtr = (ClientData) newPathPtr;
    return TCL_OK;
}

/*
 * Simple helper function to extract the native vfs representation of a path
 * object, or NULL if no such representation exists.
 */

static Tcl_Obj *
TestReportGetNativePath(
    Tcl_Obj *pathPtr)
{
    return (Tcl_Obj*) Tcl_FSGetInternalRep(pathPtr, &testReportingFilesystem);
}

static void
TestReportFreeInternalRep(
    void *clientData)
    ClientData clientData)
{
    Tcl_Obj *nativeRep = (Tcl_Obj *) clientData;

    if (nativeRep != NULL) {
	/* Free the path */
	Tcl_DecrRefCount(nativeRep);
    }
}

static void *
static ClientData
TestReportDupInternalRep(
    void *clientData)
    ClientData clientData)
{
    Tcl_Obj *original = (Tcl_Obj *) clientData;

    Tcl_IncrRefCount(original);
    return clientData;
}

static void
TestReport(
    const char *cmd,
    Tcl_Obj *path,
    Tcl_Obj *arg2)
{
    Tcl_Interp *interp = (Tcl_Interp *) Tcl_FSData(&testReportingFilesystem);

    if (interp == NULL) {
	/* This is bad, but not much we can do about it */
    } else {
	/*
	 * No idea why I decided to program this up using the old string-based
	 * API, but there you go. We should convert it to objects.
	 */

	Tcl_Obj *savedResult;
	Tcl_SavedResult savedResult;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "lappend filesystemReport ", -1);
	Tcl_DStringStartSublist(&ds);
	Tcl_DStringAppendElement(&ds, cmd);
	if (path != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(path));
	}
	if (arg2 != NULL) {
	    Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
	}
	Tcl_DStringEndSublist(&ds);
	savedResult = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(savedResult);
	Tcl_SetObjResult(interp, Tcl_NewObj());
	Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0);
	Tcl_SaveResult(interp, &savedResult);
	Tcl_Eval(interp, Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, savedResult);
	Tcl_DecrRefCount(savedResult);
    }
	Tcl_RestoreResult(interp, &savedResult);
   }
}

static int
TestReportStat(
    Tcl_Obj *path,		/* Path of file to stat (in current CP). */
    Tcl_StatBuf *buf)		/* Filled with results of stat call. */
{
6621
6622
6623
6624
6625
6626
6627
6628

6629
6630
6631
6632
6633
6634
6635
6867
6868
6869
6870
6871
6872
6873

6874
6875
6876
6877
6878
6879
6880
6881







-
+







				 * of file causing error. */
{
    TestReport("removedirectory", path, NULL);
    return Tcl_FSRemoveDirectory(TestReportGetNativePath(path), recursive,
	    errorPtr);
}

static const char *const *
static const char **
TestReportFileAttrStrings(
    Tcl_Obj *fileName,
    Tcl_Obj **objPtrRef)
{
    TestReport("fileattributestrings", fileName, NULL);
    return Tcl_FSFileAttrStrings(TestReportGetNativePath(fileName), objPtrRef);
}
6665
6666
6667
6668
6669
6670
6671
6672

6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683

6684
6685
6686
6687
6688
6689
6690
6911
6912
6913
6914
6915
6916
6917

6918
6919
6920
6921
6922
6923
6924
6925
6926
6927
6928

6929
6930
6931
6932
6933
6934
6935
6936







-
+










-
+







{
    TestReport("utime", fileName, NULL);
    return Tcl_FSUtime(TestReportGetNativePath(fileName), tval);
}

static int
TestReportNormalizePath(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr,
    int nextCheckpoint)
{
    TestReport("normalizepath", pathPtr, NULL);
    return nextCheckpoint;
}

static int
SimplePathInFilesystem(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(void **))
    ClientData *clientDataPtr)
{
    const char *str = Tcl_GetString(pathPtr);

    if (strncmp(str, "simplefs:/", 10)) {
	return -1;
    }
    return TCL_OK;
6705
6706
6707
6708
6709
6710
6711
6712

6713
6714
6715
6716
6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728

6729
6730
6731
6732
6733
6734
6735
6951
6952
6953
6954
6955
6956
6957

6958
6959
6960
6961
6962
6963
6964
6965
6966
6967
6968
6969
6970
6971
6972
6973

6974
6975
6976
6977
6978
6979
6980
6981







-
+















-
+







 * Please do not consider this filesystem a model of how things are to be
 * done. It is quite the opposite!  But, it does allow us to test some
 * important features.
 */

static int
TestSimpleFilesystemObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int res, boolVal;
    const char *msg;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "boolean");
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[1], &boolVal) != TCL_OK) {
	return TCL_ERROR;
    }
    if (boolVal) {
	res = Tcl_FSRegister(interp, &simpleFilesystem);
	res = Tcl_FSRegister((ClientData)interp, &simpleFilesystem);
	msg = (res == TCL_OK) ? "registered" : "failed";
    } else {
	res = Tcl_FSUnregister(&simpleFilesystem);
	msg = (res == TCL_OK) ? "unregistered" : "failed";
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(msg , -1));
    return res;
6867
6868
6869
6870
6871
6872
6873
6874

6875
6876
6877
6878
6879


6880
6881
6882
6883
6884
6885
6886
6887


6888
6889

6890
6891





6892












6893

6894
6895
6896
6897
6898
6899
6900
6901
6902







6903

6904
6905
6906

6907
6908
6909
6910
6911
6912
6913
6914
6915

6916


6917
6918


6919
6920
6921
6922
6923
6924
6925
6926
6927
6928
6929
6930
6931
6932
6933
6934

6935
6936
6937
6938
6939

6940
6941
6942
6943
6944
6945
6946
6947
6948

6949
6950
6951
6952

6953
6954
6955

6956
6957
6958
6959
6960
6961
6962
6963
6964
6965

6966
6967
6968
6969
6970
6971
6972
6973
6974
6975

6976
6977
6978
6979
6980
6981
6982


6983
6984
6985
6986

6987
6988
6989
6990
6991
6992
6993
6994

6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005

7006
7007
7008
7009
7010
7011
7012
7113
7114
7115
7116
7117
7118
7119

7120
7121
7122
7123
7124

7125
7126
7127
7128
7129
7130
7131
7132


7133
7134
7135
7136
7137


7138
7139
7140
7141
7142
7143
7144
7145
7146
7147
7148
7149
7150
7151
7152
7153
7154
7155

7156
7157
7158
7159
7160
7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172

7173
7174
7175

7176
7177
7178
7179
7180
7181
7182
7183
7184

7185
7186
7187
7188


7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205

7206
7207
7208
7209
7210

7211
7212
7213
7214
7215
7216
7217
7218
7219

7220

7221
7222

7223
7224
7225

7226
7227
7228
7229
7230
7231
7232
7233
7234
7235

7236
7237
7238
7239
7240
7241
7242
7243
7244
7245

7246
7247
7248
7249
7250
7251


7252
7253

7254
7255

7256
7257
7258
7259
7260
7261
7262
7263

7264
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274

7275
7276
7277
7278
7279
7280
7281
7282







-
+




-
+
+






-
-
+
+


+
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
-
+









+
+
+
+
+
+
+
-
+


-
+








-
+

+
+
-
-
+
+















-
+




-
+








-
+
-


-
+


-
+









-
+









-
+





-
-
+
+
-


-
+







-
+










-
+







 * Used to check operations of Tcl_UtfNext.
 *
 * Usage: testutfnext -bytestring $bytes
 */

static int
TestUtfNextCmd(
    TCL_UNUSED(void *),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t numBytes;
    int numBytes;	/* Number of bytes supplied in the test string */
    int offset;		/* Number of bytes we are permitted to read */
    char *bytes;
    const char *result, *first;
    char buffer[32];
    static const char tobetested[] = "A\xA0\xC0\xC1\xC2\xD0\xE0\xE8\xF2\xF7\xF8\xFE\xFF";
    const char *p = tobetested;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?-bytestring? bytes");
    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "string ?numBytes?");
	return TCL_ERROR;
    }

	bytes = Tcl_GetString(objv[1]);
	numBytes = objv[1]->length;
    bytes = Tcl_GetStringFromObj(objv[1], &numBytes);

    offset = numBytes +TCL_UTF_MAX -1;	/* If no constraint is given, allow
					 * the terminating NUL to limit
					 * operations. */

    if (objc == 3) {
	if (TCL_OK != TclGetIntForIndex(interp, objv[2], numBytes, &offset)) {
	    return TCL_ERROR;
	}
	if (offset < 0) {
	    offset = 0;
	}
	if (offset > numBytes +TCL_UTF_MAX -1) {
	    offset = numBytes +TCL_UTF_MAX -1;
	}
    }

    if (numBytes > (int)sizeof(buffer) - 4) {
    if (numBytes > (int)sizeof(buffer) - 3) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"testutfnext\" can only handle %d bytes",
		(int)sizeof(buffer) - 4));
	return TCL_ERROR;
    }

    memcpy(buffer + 1, bytes, numBytes);
    buffer[0] = buffer[numBytes + 1] = buffer[numBytes + 2] = buffer[numBytes + 3] = '\xA0';

    if (!Tcl_UtfCharComplete(buffer + 1, offset)) {
	/* Cannot scan a complete sequence from the data */

	Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
	return TCL_OK;
    }

    first = result = Tcl_UtfNext(buffer + 1);
    first = result = TclUtfNext(buffer + 1);
    while ((buffer[0] = *p++) != '\0') {
	/* Run Tcl_UtfNext with many more possible bytes at src[-1], all should give the same result */
	result = Tcl_UtfNext(buffer + 1);
	result = TclUtfNext(buffer + 1);
	if (first != result) {
	    Tcl_AppendResult(interp, "Tcl_UtfNext is not supposed to read src[-1]", NULL);
	    return TCL_ERROR;
	}
    }
    p = tobetested;
    while ((buffer[numBytes + 1] = *p++) != '\0') {
	/* Run Tcl_UtfNext with many more possible bytes at src[end], all should give the same result */
	result = Tcl_UtfNext(buffer + 1);
	result = TclUtfNext(buffer + 1);
	if (first != result) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "Tcl_UtfNext is not supposed to read src[end]\n"
	    first = buffer;
	    break;
		    "Different result when src[end] is %#x", UCHAR(p[-1])));
	    return TCL_ERROR;
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewIntObj(first - buffer - 1));

    return TCL_OK;
}
/*
 * Used to check operations of Tcl_UtfPrev.
 *
 * Usage: testutfprev $bytes $offset
 */

static int
TestUtfPrevCmd(
    TCL_UNUSED(void *),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    size_t numBytes, offset;
    int numBytes, offset;
    char *bytes;
    const char *result;

    if (objc < 2 || objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "bytes ?offset?");
	return TCL_ERROR;
    }

    bytes = Tcl_GetString(objv[1]);
    bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
    numBytes = objv[1]->length;

    if (objc == 3) {
	if (TCL_OK != Tcl_GetIntForIndex(interp, objv[2], numBytes, &offset)) {
	if (TCL_OK != TclGetIntForIndex(interp, objv[2], numBytes, &offset)) {
	    return TCL_ERROR;
	}
	if (offset == TCL_INDEX_NONE) {
	if (offset < 0) {
	    offset = 0;
	}
	if (offset > numBytes) {
	    offset = numBytes;
	}
    } else {
	offset = numBytes;
    }
    result = TclUtfPrev(bytes + offset, bytes);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result - bytes));
    Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes));
    return TCL_OK;
}

/*
 * Used to check correct string-length determining in Tcl_NumUtfChars
 */

static int
TestNumUtfCharsCmd(
    TCL_UNUSED(void *),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	size_t len, limit = TCL_INDEX_NONE;
	const char *bytes = Tcl_GetString(objv[1]);
	int numBytes, len, limit = -1;
	const char *bytes = Tcl_GetStringFromObj(objv[1], &numBytes);
	size_t numBytes = objv[1]->length;

	if (objc > 2) {
	    if (Tcl_GetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) {
	    if (TclGetIntForIndex(interp, objv[2], numBytes, &limit) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (limit > numBytes + 1) {
		limit = numBytes + 1;
	    }
	}
	len = Tcl_NumUtfChars(bytes, limit);
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(len));
	Tcl_SetObjResult(interp, Tcl_NewIntObj(len));
    }
    return TCL_OK;
}

/*
 * Used to check correct operation of Tcl_UtfFindFirst
 */

static int
TestFindFirstCmd(
    TCL_UNUSED(void *),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	int len = -1;

7020
7021
7022
7023
7024
7025
7026
7027

7028
7029
7030
7031
7032
7033
7034
7290
7291
7292
7293
7294
7295
7296

7297
7298
7299
7300
7301
7302
7303
7304







-
+








/*
 * Used to check correct operation of Tcl_UtfFindLast
 */

static int
TestFindLastCmd(
    TCL_UNUSED(void *),
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    if (objc > 1) {
	int len = -1;

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
7332
7333
7334
7335
7336
7337
7338

7339
7340
7341
7342
7343
7344

7345
7346
7347
7348
7349
7350
7351
7352
7353
7354

7355
7356
7357
7358
7359
7360
7361

7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374

7375
7376
7377
7378
7379

7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394







-
+





-
+









-
+






-
+












-
+




-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestcpuidCmd(
    TCL_UNUSED(void *),
    ClientData dummy,
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int status, index, i;
    int regs[4];
    unsigned int regs[4];
    Tcl_Obj *regsObjs[4];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "eax");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
	return TCL_ERROR;
    }
    status = TclWinCPUID(index, regs);
    status = TclWinCPUID((unsigned) index, regs);
    if (status != TCL_OK) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("operation not available", -1));
	return status;
    }
    for (i=0 ; i<4 ; ++i) {
	regsObjs[i] = Tcl_NewIntObj(regs[i]);
	regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
    }
    Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
    return TCL_OK;
}
#endif

/*
 * Used to do basic checks of the TCL_HASH_KEY_SYSTEM_HASH flag
 */

static int
TestHashSystemHashCmd(
    TCL_UNUSED(void *),
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const Tcl_HashKeyType hkType = {
    static Tcl_HashKeyType hkType = {
	TCL_HASH_KEY_TYPE_VERSION, TCL_HASH_KEY_SYSTEM_HASH,
	NULL, NULL, NULL, NULL
    };
    Tcl_HashTable hash;
    Tcl_HashEntry *hPtr;
    int i, isNew, limit = 100;
    (void)dummy;

    if (objc>1 && Tcl_GetIntFromObj(interp, objv[1], &limit)!=TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_InitCustomHashTable(&hash, TCL_CUSTOM_TYPE_KEYS, &hkType);

7134
7135
7136
7137
7138
7139
7140
7141

7142
7143
7144
7145
7146
7147
7148
7405
7406
7407
7408
7409
7410
7411

7412
7413
7414
7415
7416
7417
7418
7419







-
+







	    Tcl_AppendToObj(Tcl_GetObjResult(interp)," creation problem",-1);
	    Tcl_DeleteHashTable(&hash);
	    return TCL_ERROR;
	}
	Tcl_SetHashValue(hPtr, INT2PTR(i+42));
    }

    if (hash.numEntries != (size_t)limit) {
    if (hash.numEntries != limit) {
	Tcl_AppendResult(interp, "unexpected maximal size", NULL);
	Tcl_DeleteHashTable(&hash);
	return TCL_ERROR;
    }

    for (i=0 ; i<limit ; i++) {
	hPtr = Tcl_FindHashEntry(&hash, (char *) INT2PTR(i));
7174
7175
7176
7177
7178
7179
7180
7181

7182
7183
7184
7185


7186
7187

7188
7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
7252
7253
7254
7255
7256
7257
7258
7259
7260
7261
7262
7263
7264
7265
7266
7267
7268
7269
7270
7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288
7289
7290
7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
7445
7446
7447
7448
7449
7450
7451

7452
7453
7454
7455
7456
7457
7458
7459

7460
7461
7462
7463
7464
7465
7466
7467
7468
7469
7470
7471
7472
7473
7474




































































































7475
7476
7477
7478
7479
7480
7481







-
+




+
+

-
+














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








/*
 * Used for testing Tcl_GetInt which is no longer used directly by the
 * core very much.
 */
static int
TestgetintCmd(
    TCL_UNUSED(void *),
    ClientData dummy,
    Tcl_Interp *interp,
    int argc,
    const char **argv)
{
    (void)dummy;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
	return TCL_ERROR;
    } else {
	int val, i, total=0;

	for (i=1 ; i<argc ; i++) {
	    if (Tcl_GetInt(interp, argv[i], &val) != TCL_OK) {
		return TCL_ERROR;
	    }
	    total += val;
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(total));
	return TCL_OK;
    }
}

/*
 * Used for determining sizeof(long) at script level.
 */
static int
TestlongsizeCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int argc,
    TCL_UNUSED(const char **) /*argv*/)
{
    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args", NULL);
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(sizeof(long)));
    return TCL_OK;
}

static int
NREUnwind_callback(
    void *data[],
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*result*/)
{
    int none;

    if (data[0] == INT2PTR(-1)) {
        Tcl_NRAddCallback(interp, NREUnwind_callback, &none, INT2PTR(-1),
                INT2PTR(-1), NULL);
    } else if (data[1] == INT2PTR(-1)) {
        Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], &none,
                INT2PTR(-1), NULL);
    } else if (data[2] == INT2PTR(-1)) {
        Tcl_NRAddCallback(interp, NREUnwind_callback, data[0], data[1],
                &none, NULL);
    } else {
        Tcl_Obj *idata[3];
        idata[0] = Tcl_NewIntObj(((char *) data[1] - (char *) data[0]));
        idata[1] = Tcl_NewIntObj(((char *) data[2] - (char *) data[0]));
        idata[2] = Tcl_NewIntObj(((char *) &none   - (char *) data[0]));
        Tcl_SetObjResult(interp, Tcl_NewListObj(3, idata));
    }
    return TCL_OK;
}

static int
TestNREUnwind(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
    /*
     * Insure that callbacks effectively run at the proper level during the
     * unwinding of the NRE stack.
     */

    Tcl_NRAddCallback(interp, NREUnwind_callback, INT2PTR(-1), INT2PTR(-1),
            INT2PTR(-1), NULL);
    return TCL_OK;
}


static int
TestNRELevels(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{
    Interp *iPtr = (Interp *) interp;
    static ptrdiff_t *refDepth = NULL;
    ptrdiff_t depth;
    Tcl_Obj *levels[6];
    int i = 0;
    NRE_callback *cbPtr = iPtr->execEnvPtr->callbackPtr;

    if (refDepth == NULL) {
	refDepth = &depth;
    }

    depth = (refDepth - &depth);

    levels[0] = Tcl_NewIntObj(depth);
    levels[1] = Tcl_NewIntObj(iPtr->numLevels);
    levels[2] = Tcl_NewIntObj(iPtr->cmdFramePtr->level);
    levels[3] = Tcl_NewIntObj(iPtr->varFramePtr->level);
    levels[4] = Tcl_NewIntObj(iPtr->execEnvPtr->execStackPtr->tosPtr
	    - iPtr->execEnvPtr->execStackPtr->stackWords);

    while (cbPtr) {
	i++;
	cbPtr = cbPtr->nextPtr;
    }
    levels[5] = Tcl_NewIntObj(i);

    Tcl_SetObjResult(interp, Tcl_NewListObj(6, levels));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestconcatobjCmd --
 *
 *	This procedure implements the "testconcatobj" command. It is used
7317
7318
7319
7320
7321
7322
7323
7324

7325
7326
7327


7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344


7345


7346
7347
7348


7349


7350
7351
7352
7353
7354
7355
7356
7490
7491
7492
7493
7494
7495
7496

7497
7498


7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
7514
7515
7516
7517
7518
7519

7520
7521
7522
7523
7524
7525
7526

7527
7528
7529
7530
7531
7532
7533
7534
7535







-
+

-
-
+
+

















+
+
-
+
+



+
+
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestconcatobjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*argc*/,
    TCL_UNUSED(const char **) /*argv*/)
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    Tcl_Obj *list1Ptr, *list2Ptr, *emptyPtr, *concatPtr, *tmpPtr;
    int result = TCL_OK, len;
    Tcl_Obj *objv[3];

    /*
     * Set the start of the error message as obj result; it will be cleared at
     * the end if no errors were found.
     */

    Tcl_SetObjResult(interp,
	    Tcl_NewStringObj("Tcl_ConcatObj is unsafe:", -1));

    emptyPtr = Tcl_NewObj();

    list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
    Tcl_ListObjLength(NULL, list1Ptr, &len);
    if (list1Ptr->bytes != NULL) {
	ckfree((char *)list1Ptr->bytes);
    Tcl_InvalidateStringRep(list1Ptr);
	list1Ptr->bytes = NULL;
    }

    list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
    Tcl_ListObjLength(NULL, list2Ptr, &len);
    if (list2Ptr->bytes != NULL) {
	ckfree((char *)list2Ptr->bytes);
    Tcl_InvalidateStringRep(list2Ptr);
	list2Ptr->bytes = NULL;
    }

    /*
     * Verify that concat'ing a list obj with one or more empty strings does
     * return a fresh Tcl_Obj (see also [Bug 2055782]).
     */

    tmpPtr = Tcl_DuplicateObj(list1Ptr);
7486
7487
7488
7489
7490
7491
7492


7493
7494
7495
7496
7497
7498
7499
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680







+
+







    concatPtr = Tcl_ConcatObj(2, objv);
    if (concatPtr->refCount != 0) {
	result = TCL_ERROR;
	Tcl_AppendResult(interp,
		"\n\t* (e) concatObj does not have refCount 0", NULL);
    }
    if (concatPtr == tmpPtr) {
	int len;

	result = TCL_ERROR;
	Tcl_AppendResult(interp, "\n\t* (e) concatObj is not a new obj ",
		NULL);

	(void) Tcl_ListObjLength(NULL, concatPtr, &len);
	switch (tmpPtr->refCount) {
	case 3:
7516
7517
7518
7519
7520
7521
7522


7523
7524
7525
7526
7527
7528
7529
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712







+
+







    concatPtr = Tcl_ConcatObj(2, objv);
    if (concatPtr->refCount != 0) {
	result = TCL_ERROR;
	Tcl_AppendResult(interp,
		"\n\t* (f) concatObj does not have refCount 0", NULL);
    }
    if (concatPtr == tmpPtr) {
	int len;

	result = TCL_ERROR;
	Tcl_AppendResult(interp, "\n\t* (f) concatObj is not a new obj ",
		NULL);

	(void) Tcl_ListObjLength(NULL, concatPtr, &len);
	switch (tmpPtr->refCount) {
	case 3:
7547
7548
7549
7550
7551
7552
7553


7554
7555
7556
7557
7558
7559
7560
7730
7731
7732
7733
7734
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745







+
+







    concatPtr = Tcl_ConcatObj(2, objv);
    if (concatPtr->refCount != 0) {
	result = TCL_ERROR;
	Tcl_AppendResult(interp,
		"\n\t* (g) concatObj does not have refCount 0", NULL);
    }
    if (concatPtr == tmpPtr) {
	int len;

	result = TCL_ERROR;
	Tcl_AppendResult(interp, "\n\t* (g) concatObj is not a new obj ",
		NULL);

	(void) Tcl_ListObjLength(NULL, concatPtr, &len);
	switch (tmpPtr->refCount) {
	case 3:
7587
7588
7589
7590
7591
7592
7593
7594
7595
7596
7597
7598
7599
7600
7601
7602
7603
7604
7605
7606
7607
7608
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628
7629
7630
7631
7632
7633
7634
7635
7636
7637
7638
7639
7640
7641
7642
7643
7644
7645
7646
7647
7648
7649
7650
7651
7652
7653
7654
7655
7656
7657
7658
7659
7660
7661
7662
7663
7664
7665
7666
7667
7668
7669
7670
7671
7672
7673
7674
7675
7676
7677
7678
7679
7680
7681
7682
7683
7684
7685
7686
7687
7688
7689
7690
7691
7692
7693
7694
7695
7696
7697
7698
7699
7700
7701
7702
7703
7704
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
7720
7721
7722
7723
7724
7725
7726
7727
7728
7729
7730
7731
7732
7733
7734
7735
7736
7737
7738
7739
7740
7741
7742
7743
7744
7745
7746
7747
7748
7749
7750
7751
7752
7753
7754
7755
7756
7757
7758
7759
7760
7761
7762
7763
7764
7765
7766
7767
7768
7769
7770
7771
7772
7773
7774
7775
7776
7777
7778
7779
7780
7781
7782
7783
7784
7785
7786
7787
7788
7789
7790
7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
7803
7804
7805
7806
7807
7808
7809
7810
7811
7812
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822
7823
7824
7825
7826
7827
7828
7829
7830
7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
7841
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890
7891
7892
7893
7894
7895
7896
7897
7898
7899
7900
7901
7902
7903
7904
7905
7906
7907
7908
7909
7910
7911
7912
7913
7914
7915
7916
7917
7918
7919
7920
7921
7922
7923
7924
7925
7926
7927
7928
7929
7930
7931
7932
7933
7934
7935
7936
7937
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962
7963
7964
7965
7966
7967
7968
7969
7772
7773
7774
7775
7776
7777
7778














































































































































































































































































































































































7779
7780
7781
7782
7783
7784
7785
7786
7787
7788







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










    Tcl_DecrRefCount(tmpPtr);

    if (result == TCL_OK) {
	Tcl_ResetResult(interp);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TestgetencpathObjCmd --
 *
 *	This function implements the "testgetencpath" command. It is used to
 *	test Tcl_GetEncodingSearchPath().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetencpathObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
{
    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, "");
        return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetencpathCmd --
 *
 *	This function implements the "testsetencpath" command. It is used to
 *	test Tcl_SetDefaultEncodingDir().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetencpathObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "defaultDir");
        return TCL_ERROR;
    }

    Tcl_SetEncodingSearchPath(objv[1]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestparseargsCmd --
 *
 *	This procedure implements the "testparseargs" command. It is used to
 *	test that Tcl_ParseArgsObjv does indeed return the right number of
 *	arguments. In other words, that [Bug 3413857] was fixed properly.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestparseargsCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Arguments. */
{
    static int foo = 0;
    int count = objc;
    Tcl_Obj **remObjv, *result[3];
    Tcl_ArgvInfo argTable[] = {
        {TCL_ARGV_CONSTANT, "-bool", INT2PTR(1), &foo, "booltest", NULL},
        TCL_ARGV_AUTO_REST, TCL_ARGV_AUTO_HELP, TCL_ARGV_TABLE_END
    };

    foo = 0;
    if (Tcl_ParseArgsObjv(interp, argTable, &count, objv, &remObjv)!=TCL_OK) {
        return TCL_ERROR;
    }
    result[0] = Tcl_NewIntObj(foo);
    result[1] = Tcl_NewIntObj(count);
    result[2] = Tcl_NewListObj(count, remObjv);
    Tcl_SetObjResult(interp, Tcl_NewListObj(3, result));
    Tcl_Free(remObjv);
    return TCL_OK;
}

/**
 * Test harness for command and variable resolvers.
 */

static int
InterpCmdResolver(
    Tcl_Interp *interp,
    const char *name,
    TCL_UNUSED(Tcl_Namespace *),
    TCL_UNUSED(int) /*flags*/,
    Tcl_Command *rPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ?
            varFramePtr->procPtr : NULL;
    Namespace *callerNsPtr = varFramePtr->nsPtr;
    Tcl_Command resolvedCmdPtr = NULL;

    /*
     * Just do something special on a cmd literal "z" in two cases:
     *  A)  when the caller is a proc "x", and the proc is either in "::" or in "::ns2".
     *  B) the caller's namespace is "ctx1" or "ctx2"
     */
    if ( (name[0] == 'z') && (name[1] == '\0') ) {
        Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0);

        if (procPtr != NULL
            && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr)
                || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr)
                )
            ) {
            /*
             * Case A)
             *
             *    - The context, in which this resolver becomes active, is
             *      determined by the name of the caller proc, which has to be
             *      named "x".
             *
             *    - To determine the name of the caller proc, the proc is taken
             *      from the topmost stack frame.
             *
             *    - Note that the context is NOT provided during byte-code
             *      compilation (e.g. in TclProcCompileProc)
             *
             *   When these conditions hold, this function resolves the
             *   passed-in cmd literal into a cmd "y", which is taken from the
             *   the global namespace (for simplicity).
             */

            const char *callingCmdName =
                Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr);

            if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) {
                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
            }
        } else if (callerNsPtr != NULL) {
            /*
             * Case B)
             *
             *    - The context, in which this resolver becomes active, is
             *      determined by the name of the parent namespace, which has
             *      to be named "ctx1" or "ctx2".
             *
             *    - To determine the name of the parent namesace, it is taken
             *      from the 2nd highest stack frame.
             *
             *    - Note that the context can be provided during byte-code
             *      compilation (e.g. in TclProcCompileProc)
             *
             *   When these conditions hold, this function resolves the
             *   passed-in cmd literal into a cmd "y" or "Y" depending on the
             *   context. The resolved procs are taken from the the global
             *   namespace (for simplicity).
             */

            CallFrame *parentFramePtr = varFramePtr->callerPtr;
            const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)";

            if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
                resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
                /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/

            } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
                resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY);
                /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/
            }
        }

        if (resolvedCmdPtr != NULL) {
            *rPtr = resolvedCmdPtr;
            return TCL_OK;
        }
    }
    return TCL_CONTINUE;
}

static int
InterpVarResolver(
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(const char *),
    TCL_UNUSED(Tcl_Namespace *),
    TCL_UNUSED(int),
    TCL_UNUSED(Tcl_Var *))
{
    /*
     * Don't resolve the variable; use standard rules.
     */

    return TCL_CONTINUE;
}

typedef struct MyResolvedVarInfo {
    Tcl_ResolvedVarInfo vInfo;  /* This must be the first element. */
    Tcl_Var var;
    Tcl_Obj *nameObj;
} MyResolvedVarInfo;

static inline void
HashVarFree(
    Tcl_Var var)
{
    if (VarHashRefCount(var) < 2) {
        Tcl_Free(var);
    } else {
        VarHashRefCount(var)--;
    }
}

static void
MyCompiledVarFree(
    Tcl_ResolvedVarInfo *vInfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vInfoPtr;

    Tcl_DecrRefCount(resVarInfo->nameObj);
    if (resVarInfo->var) {
        HashVarFree(resVarInfo->var);
    }
    Tcl_Free(vInfoPtr);
}

#define TclVarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))

static Tcl_Var
MyCompiledVarFetch(
    Tcl_Interp *interp,
    Tcl_ResolvedVarInfo *vinfoPtr)
{
    MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;
    Tcl_Var var = resVarInfo->var;
    int isNewVar;
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;

    if (var != NULL) {
        if (!(((Var *) var)->flags & VAR_DEAD_HASH)) {
            /*
             * The cached variable is valid, return it.
             */

            return var;
        }

        /*
         * The variable is not valid anymore. Clean it up.
         */

        HashVarFree(var);
    }

    hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) &iPtr->globalNsPtr->varTable,
            (char *) resVarInfo->nameObj, &isNewVar);
    if (hPtr) {
        var = (Tcl_Var) TclVarHashGetValue(hPtr);
    } else {
        var = NULL;
    }
    resVarInfo->var = var;

    /*
     * Increment the reference counter to avoid Tcl_Free() of the variable in
     * Tcl's FreeVarEntry(); for cleanup, we provide our own HashVarFree();
     */

    VarHashRefCount(var)++;
    return var;
}

static int
InterpCompiledVarResolver(
    TCL_UNUSED(Tcl_Interp *),
    const char *name,
    TCL_UNUSED(int) /*length*/,
    TCL_UNUSED(Tcl_Namespace *),
    Tcl_ResolvedVarInfo **rPtr)
{
    if (*name == 'T') {
 	MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *)Tcl_Alloc(sizeof(MyResolvedVarInfo));

 	resVarInfo->vInfo.fetchProc = MyCompiledVarFetch;
 	resVarInfo->vInfo.deleteProc = MyCompiledVarFree;
 	resVarInfo->var = NULL;
 	resVarInfo->nameObj = Tcl_NewStringObj(name, -1);
 	Tcl_IncrRefCount(resVarInfo->nameObj);
 	*rPtr = &resVarInfo->vInfo;
 	return TCL_OK;
    }
    return TCL_CONTINUE;
}

static int
TestInterpResolverCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const table[] = {
        "down", "up", NULL
    };
    int idx;
#define RESOLVER_KEY "testInterpResolver"

    if ((objc < 2) || (objc > 3)) {
	Tcl_WrongNumArgs(interp, 1, objv, "up|down ?interp?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	interp = Tcl_GetChild(interp, Tcl_GetString(objv[2]));
	if (interp == NULL) {
	    Tcl_AppendResult(interp, "provided interpreter not found", NULL);
	    return TCL_ERROR;
	}
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT,
            &idx) != TCL_OK) {
        return TCL_ERROR;
    }
    switch (idx) {
    case 1: /* up */
        Tcl_AddInterpResolvers(interp, RESOLVER_KEY, InterpCmdResolver,
                InterpVarResolver, InterpCompiledVarResolver);
        break;
    case 0: /*down*/
        if (!Tcl_RemoveInterpResolvers(interp, RESOLVER_KEY)) {
            Tcl_AppendResult(interp, "could not remove the resolver scheme",
                    NULL);
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to generic/tclTestObj.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
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
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







-
-
-

-
-
-
+
+
-
-
-
+
+
+
+
+

+
+





-
+


-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
+
+







 * Copyright (c) 1999 by Scriptics Corporation.
 * Copyright (c) 2005 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.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#include "tommath.h"

#   include "tclTomMath.h"
#endif
#include "tclStringRep.h"
/*
 * An array of Tcl_Obj pointers used in the commands that operate on or get
 * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
 * Tcl_Obj *.
 */

#define NUMBER_OF_OBJECT_VARS 20
static Tcl_Obj *varPtr[NUMBER_OF_OBJECT_VARS];

/*
 * Forward declarations for functions defined later in this file:
 */

static int		CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
static int		CheckIfVarUnset(Tcl_Interp *interp, int varIndex);
static int		GetVariableIndex(Tcl_Interp *interp,
			    const char *string, int *indexPtr);
static void		SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
static Tcl_ObjCmdProc	TestbignumobjCmd;
static Tcl_ObjCmdProc	TestbooleanobjCmd;
static Tcl_ObjCmdProc	TestdoubleobjCmd;
static Tcl_ObjCmdProc	TestindexobjCmd;
static Tcl_ObjCmdProc	TestintobjCmd;
static Tcl_ObjCmdProc	TestlistobjCmd;
static Tcl_ObjCmdProc	TestobjCmd;
static Tcl_ObjCmdProc	TeststringobjCmd;

static void		SetVarToObj(int varIndex, Tcl_Obj *objPtr);
int			TclObjTest_Init(Tcl_Interp *interp);
static int		TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestbooleanobjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20

static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp)
			    int objc, Tcl_Obj *const objv[]);
static int 		TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
{
    int i;
    Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
			    int objc, Tcl_Obj *const objv[]);
static int		TestobjCmd(ClientData dummy, Tcl_Interp *interp,
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
    }
    Tcl_DeleteAssocData(interp, VARPTR_KEY);
    Tcl_Free(varPtr);
			    int objc, Tcl_Obj *const objv[]);
}

static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
{
    Tcl_InterpDeleteProc *proc;

static int		TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);

typedef struct TestString {
    int numChars;
    size_t allocated;
    return (Tcl_Obj **) Tcl_GetAssocData(interp, VARPTR_KEY, &proc);
}
    size_t uallocated;
    Tcl_UniChar unicode[2];
} TestString;

/*
 *----------------------------------------------------------------------
 *
 * TclObjTest_Init --
 *
 *	This function creates additional commands that are used to test the
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
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







-
+
-
-
-
-
-
-

-
-
-
-
-

-
+



-
+

-
+

-
+

-
+

-
+

-
-
+
+

-
+








-
+














-
+




-
+






+

-
-
+
+
-


-
+










-







 *----------------------------------------------------------------------
 */

int
TclObjTest_Init(
    Tcl_Interp *interp)
{
    int i;
    register int i;
    /*
     * An array of Tcl_Obj pointers used in the commands that operate on or get
     * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
     * Tcl_Obj *.
     */
    Tcl_Obj **varPtr;

    varPtr = (Tcl_Obj **) Tcl_Alloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
    if (!varPtr) {
	return TCL_ERROR;
    }
    Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr);
    for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	varPtr[i] = NULL;
        varPtr[i] = NULL;
    }

    Tcl_CreateObjCommand(interp, "testbignumobj", TestbignumobjCmd,
	    NULL, NULL);
	    (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "testbooleanobj", TestbooleanobjCmd,
	    NULL, NULL);
	    (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "testdoubleobj", TestdoubleobjCmd,
	    NULL, NULL);
	    (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "testintobj", TestintobjCmd,
	    NULL, NULL);
	    (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "testindexobj", TestindexobjCmd,
	    NULL, NULL);
	    (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "testlistobj", TestlistobjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, NULL, NULL);
	    (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "testobj", TestobjCmd, (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "teststringobj", TeststringobjCmd,
	    NULL, NULL);
	    (ClientData) 0, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestbignumobjCmd --
 *
 *	This function implements the "testbignumobj" command.  It is used
 *	This function implmenets the "testbignumobj" command.  It is used
 *	to exercise the bignum Tcl object type implementation.
 *
 * Results:
 *	Returns a standard Tcl object result.
 *
 * Side effects:
 *	Creates and frees bignum objects; converts objects to have bignum
 *	type.
 *
 *----------------------------------------------------------------------
 */

static int
TestbignumobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* unused */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    const char *const subcmds[] = {
    const char * subcmds[] = {
	"set", "get", "mult10", "div10", "iseven", "radixsize", NULL
    };
    enum options {
	BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
	BIGNUM_RADIXSIZE
    };

    int index, varIndex;
    const char *string;
    mp_int bignumValue;
    char* string;
    mp_int bignumValue, newValue;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?...");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
	    &index) != TCL_OK) {
	return TCL_ERROR;
    }
    string = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, string, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    varPtr = GetVarPtr(interp);

    switch (index) {
    case BIGNUM_SET:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "var value");
	    return TCL_ERROR;
	}
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
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







-
+








-
+









-
+






+
-
+

+




+

-
+

-
+








-
+






+
-
+

+




+

-
+

-
+








-
+






-
-
-
-
-
-

-
+

-
+









-
+












-
+







	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
	    SetVarToObj(varIndex, Tcl_NewBignumObj(&bignumValue));
	}
	break;

    case BIGNUM_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	break;

    case BIGNUM_MULT10:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (mp_init(&newValue) != MP_OKAY
	if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) {
		|| (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) {
	    mp_clear(&bignumValue);
	    mp_clear(&newValue);
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("error in mp_mul_d", -1));
	    return TCL_ERROR;
	}
	mp_clear(&bignumValue);
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
	    SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
	}
	break;

    case BIGNUM_DIV10:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (mp_init(&newValue) != MP_OKAY
	if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) {
		|| (mp_div_d(&bignumValue, 10, &newValue, NULL) != MP_OKAY)) {
	    mp_clear(&bignumValue);
	    mp_clear(&newValue);
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("error in mp_div_d", -1));
	    return TCL_ERROR;
	}
	mp_clear(&bignumValue);
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
	    Tcl_SetBignumObj(varPtr[varIndex], &newValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
	    SetVarToObj(varIndex, Tcl_NewBignumObj(&newValue));
	}
	break;

    case BIGNUM_ISEVEN:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) {
	    mp_clear(&bignumValue);
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("error in mp_mod_2d", -1));
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue));
	    Tcl_SetIntObj(varPtr[varIndex], !mp_isodd(&bignumValue));
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue)));
	    SetVarToObj(varIndex, Tcl_NewIntObj(!mp_isodd(&bignumValue)));
	}
	mp_clear(&bignumValue);
	break;

    case BIGNUM_RADIXSIZE:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBignumFromObj(interp, varPtr[varIndex],
		&bignumValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (mp_radix_size(&bignumValue, 10, &index) != MP_OKAY) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], index);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(index));
	    SetVarToObj(varIndex, Tcl_NewIntObj(index));
	}
	mp_clear(&bignumValue);
	break;
    }

    Tcl_SetObjResult(interp, varPtr[varIndex]);
    return TCL_OK;
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
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







-
+





-
+
-












-
-


















-
+

-
+






-
+







-
+







-
+

-
+







 *	have boolean type.
 *
 *----------------------------------------------------------------------
 */

static int
TestbooleanobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex, boolValue;
    const char *index, *subCmd;
    char *index, *subCmd;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    varPtr = GetVarPtr(interp);

    subCmd = Tcl_GetString(objv[1]);
    if (strcmp(subCmd, "set") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetBooleanFromObj(interp, objv[3], &boolValue) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * If the object currently bound to the variable with index varIndex
	 * has ref count 1 (i.e. the object is unshared) we can modify that
	 * object directly. Otherwise, if RC>1 (i.e. the object is shared),
	 * we must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0);
	    Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0));
	    SetVarToObj(varIndex, Tcl_NewBooleanObj(boolValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "not") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetBooleanFromObj(interp, varPtr[varIndex],
				  &boolValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0);
	    Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0));
	    SetVarToObj(varIndex, Tcl_NewBooleanObj(!boolValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, or not", NULL);
	return TCL_ERROR;
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
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







-
+






-
+
-







-
-







 *	have double type.
 *
 *----------------------------------------------------------------------
 */

static int
TestdoubleobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex;
    double doubleValue;
    const char *index, *subCmd, *string;
    char *index, *subCmd, *string;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    varPtr = GetVarPtr(interp);

    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    subCmd = Tcl_GetString(objv[1]);
    if (strcmp(subCmd, "set") == 0) {
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
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







-
+






-
+







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	 * must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue));
	    SetVarToObj(varIndex, Tcl_NewDoubleObj(doubleValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "mult10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
				 &doubleValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue * 10.0));
	} else {
	    SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue * 10.0) ));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "div10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
				 &doubleValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue * 10.0);
	    Tcl_SetDoubleObj(varPtr[varIndex], (doubleValue / 10.0));
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue * 10.0));
	    SetVarToObj(varIndex, Tcl_NewDoubleObj( (doubleValue / 10.0) ));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "div10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetDoubleFromObj(interp, varPtr[varIndex],
		&doubleValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetDoubleObj(varPtr[varIndex], doubleValue / 10.0);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewDoubleObj(doubleValue / 10.0));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, mult10, or div10", NULL);
	return TCL_ERROR;
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
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







-
+






-
+
-




-
-
-
+
+
+
















-
+







 *	have int type.
 *
 *----------------------------------------------------------------------
 */

static int
TestindexobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int allowAbbrev, index, index2, setError, i, result;
    const char **argv;
    static const char *const tablePtr[] = {"a", "b", "check", NULL};
    static const char *tablePtr[] = {"a", "b", "check", NULL};

    /*
     * Keep this structure declaration in sync with tclIndexObj.c
     */
    struct IndexRep {
	void *tablePtr;		/* Pointer to the table of strings. */
	size_t offset;		/* Offset between table entries. */
	size_t index;		/* Selected index into table. */
	VOID *tablePtr;			/* Pointer to the table of strings */
	int offset;			/* Offset between table entries */
	int index;			/* Selected index into table. */
    };
    struct IndexRep *indexRep;

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]),
	    "check") == 0)) {
	/*
	 * This code checks to be sure that the results of Tcl_GetIndexFromObj
	 * are properly cached in the object and returned on subsequent
	 * lookups.
	 */

	if (Tcl_GetIntFromObj(interp, objv[2], &index2) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
	indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
	indexRep = (struct IndexRep *) objv[1]->internalRep.twoPtrValue.ptr1;
	indexRep->index = index2;
	result = Tcl_GetIndexFromObj(NULL, objv[1],
		tablePtr, "token", 0, &index);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
	}
	return result;
608
609
610
611
612
613
614
615

616
617
618
619
620
















621
622

623
624

625
626
627
628
629
630
631
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
618
619
620
621
622
623







-
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
+







    if (Tcl_GetBooleanFromObj(interp, objv[1], &setError) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetBooleanFromObj(interp, objv[2], &allowAbbrev) != TCL_OK) {
	return TCL_ERROR;
    }

    argv = (const char **)Tcl_Alloc((objc-3) * sizeof(char *));
    argv = (const char **) ckalloc((unsigned) ((objc-3) * sizeof(char *)));
    for (i = 4; i < objc; i++) {
	argv[i-4] = Tcl_GetString(objv[i]);
    }
    argv[objc-4] = NULL;

    /*
     * Tcl_GetIndexFromObj assumes that the table is statically-allocated so
     * that its address is different for each index object. If we accidently
     * allocate a table at the same address as that cached in the index
     * object, clear out the object's cached state.
     */

    if ( objv[3]->typePtr != NULL
	 && !strcmp( "index", objv[3]->typePtr->name ) ) {
	indexRep = (struct IndexRep *) objv[3]->internalRep.twoPtrValue.ptr1;
	if (indexRep->tablePtr == (VOID *) argv) {
	    objv[3]->typePtr->freeIntRepProc(objv[3]);
	    objv[3]->typePtr = NULL;
	}
    }

    result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
	    argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
	    argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
	    &index);
    Tcl_Free((void *)argv);
    ckfree((char *) argv);
    if (result == TCL_OK) {
	Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
    }
    return result;
}

/*
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
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







-
+





-
-
+
+
-







-







 *	have int type.
 *
 *----------------------------------------------------------------------
 */

static int
TestintobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int intValue, varIndex, i;
    Tcl_WideInt wideValue;
    const char *index, *subCmd, *string;
    long longValue;
    char *index, *subCmd, *string;
    Tcl_Obj **varPtr;

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    varPtr = GetVarPtr(interp);
    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    subCmd = Tcl_GetString(objv[1]);
    if (strcmp(subCmd, "set") == 0) {
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
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
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
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







-
+














-
+

-
+









-
+

-
+


-
-
+
+




-
+

-
+

-
+



-
+


-
+



-
+




-
+







-
+



















-
+

-
+












-
+



-
+



-
+

-
+






-
+



-
+



-
+

-
+







	 * must create a new object to modify/set and decrement the old
	 * formerly-shared object's ref count. This is "copy on write".
	 */

	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "set2") == 0) { /* doesn't set result */
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
	    SetVarToObj(varIndex, Tcl_NewIntObj(intValue));
	}
    } else if (strcmp(subCmd, "setint") == 0) {
    } else if (strcmp(subCmd, "setlong") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	string = Tcl_GetString(objv[3]);
	if (Tcl_GetInt(interp, string, &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	intValue = i;
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], intValue);
	    Tcl_SetLongObj(varPtr[varIndex], intValue);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
	    SetVarToObj(varIndex, Tcl_NewLongObj(intValue));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "setmax") == 0) {
	Tcl_WideInt maxWide = WIDE_MAX;
    } else if (strcmp(subCmd, "setmaxlong") == 0) {
	long maxLong = LONG_MAX;
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], maxWide);
	    Tcl_SetLongObj(varPtr[varIndex], maxLong);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide));
	    SetVarToObj(varIndex, Tcl_NewLongObj(maxLong));
	}
    } else if (strcmp(subCmd, "ismax") == 0) {
    } else if (strcmp(subCmd, "ismaxlong") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) {
	if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp),
		((wideValue == WIDE_MAX)? "1" : "0"), -1);
	        ((longValue == LONG_MAX)? "1" : "0"), -1);
    } else if (strcmp(subCmd, "get") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "get2") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	string = Tcl_GetString(varPtr[varIndex]);
	Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
    } else if (strcmp(subCmd, "inttoobigtest") == 0) {
	/*
	 * If long ints have more bits than ints on this platform, verify that
	 * Tcl_GetIntFromObj returns an error if the long int held in an
	 * integer object's internal representation is too large to fit in an
	 * int.
	 */

	if (objc != 3) {
	    goto wrongNumArgs;
	}
#if (INT_MAX == LONG_MAX)   /* int is same size as long int */
	Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
#else
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetWideIntObj(varPtr[varIndex], LONG_MAX);
	    Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(LONG_MAX));
	    SetVarToObj(varIndex, Tcl_NewLongObj(LONG_MAX));
	}
	if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
	    return TCL_OK;
	}
	Tcl_AppendToObj(Tcl_GetObjResult(interp), "0", -1);
#endif
    } else if (strcmp(subCmd, "mult10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
		&intValue) != TCL_OK) {
			      &intValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue * 10);
	    Tcl_SetIntObj(varPtr[varIndex], (intValue * 10));
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue * 10));
	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue * 10) ));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "div10") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, varPtr[varIndex],
		&intValue) != TCL_OK) {
			      &intValue) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetIntObj(varPtr[varIndex], intValue / 10);
	    Tcl_SetIntObj(varPtr[varIndex], (intValue / 10));
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue / 10));
	    SetVarToObj(varIndex, Tcl_NewIntObj( (intValue / 10) ));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
		"\": must be set, get, get2, mult10, or div10", NULL);
	return TCL_ERROR;
848
849
850
851
852
853
854
855

856
857
858
859
860
861
862
838
839
840
841
842
843
844

845
846
847
848
849
850
851
852







-
+







 *	Creates, manipulates and frees list objects.
 *
 *-----------------------------------------------------------------------------
 */

static int
TestlistobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Number of arguments */
    Tcl_Obj *const objv[])	/* Argument objects */
{
    /* Subcommands supported by this command */
    const char* subcommands[] = {
	"set",
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
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







-





-













-
+









-
+
















-
+







    };

    const char* index;		/* Argument giving the variable number */
    int varIndex;		/* Variable number converted to binary */
    int cmdIndex;		/* Ordinal number of the subcommand */
    int first;			/* First index in the list */
    int count;			/* Count of elements in a list */
    Tcl_Obj **varPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg...?");
	return TCL_ERROR;
    }
    varPtr = GetVarPtr(interp);
    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], subcommands, "command",
			    0, &cmdIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch(cmdIndex) {
    case LISTOBJ_SET:
	if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
	    Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
	} else {
	    SetVarToObj(varPtr, varIndex, Tcl_NewListObj(objc-3, objv+3));
	    SetVarToObj(varIndex, Tcl_NewListObj(objc-3, objv+3));
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
	break;

    case LISTOBJ_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "varIndex");
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, varPtr[varIndex]);
	break;

    case LISTOBJ_REPLACE:
	if (objc < 5) {
	    Tcl_WrongNumArgs(interp, 2, objv,
			     "varIndex start count ?element...?");
	    return TCL_ERROR;
	}
	if (Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK
	    || Tcl_GetIntFromObj(interp, objv[4], &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (Tcl_IsShared(varPtr[varIndex])) {
	    SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	}
	Tcl_ResetResult(interp);
	return Tcl_ListObjReplace(interp, varPtr[varIndex], first, count,
				  objc-5, objv+5);
    }
    return TCL_OK;
}
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
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
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



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







-
+





-
-
+
+
-







-


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
-
-
-
+
+
+
+












-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
+
+


-
-
-
-
-
-
+
+
+
+
+
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
-
-
-
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+


-
+


-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+





-
-
+
+


-
-
-
+
+
+




-
-
-



+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
+

-
-
-
-
-
-
-
-
-
+
+
+
+

-
-
-
+
+
+







 *	Creates and frees objects.
 *
 *----------------------------------------------------------------------
 */

static int
TestobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int varIndex, destIndex, i;
    const char *index, *subCmd, *string;
    const Tcl_ObjType *targetType;
    char *index, *subCmd, *string;
    Tcl_ObjType *targetType;
    Tcl_Obj **varPtr;

    if (objc < 2) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    varPtr = GetVarPtr(interp);
    subCmd = Tcl_GetString(objv[1]);
    if (strcmp(subCmd, "assign") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
        if (objc != 4) {
            goto wrongNumArgs;
        }
        index = Tcl_GetString(objv[2]);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	string = Tcl_GetString(objv[3]);
	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	SetVarToObj(varPtr, destIndex, varPtr[varIndex]);
        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        SetVarToObj(destIndex, varPtr[varIndex]);
	Tcl_SetObjResult(interp, varPtr[destIndex]);
    } else if (strcmp(subCmd, "bug3598580") == 0) {
	Tcl_Obj *listObjPtr, *elemObjPtr;
	if (objc != 2) {
	    goto wrongNumArgs;
	}
	elemObjPtr = Tcl_NewIntObj(123);
	listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
	/* Replace the single list element through itself, nonsense but legal. */
	Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
	Tcl_SetObjResult(interp, listObjPtr);
	return TCL_OK;
    } else if (strcmp(subCmd, "convert") == 0) {
	const char *typeName;
     } else if (strcmp(subCmd, "convert") == 0) {
        char *typeName;

	if (objc != 4) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
        if (objc != 4) {
            goto wrongNumArgs;
        }
        index = Tcl_GetString(objv[2]);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	typeName = Tcl_GetString(objv[3]);
	if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
        typeName = Tcl_GetString(objv[3]);
        if ((targetType = Tcl_GetObjType(typeName)) == NULL) {
	    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		    "no type ", typeName, " found", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
		!= TCL_OK) {
	    return TCL_ERROR;
	}
            return TCL_ERROR;
        }
        if (Tcl_ConvertToType(interp, varPtr[varIndex], targetType)
            != TCL_OK) {
            return TCL_ERROR;
        }
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "duplicate") == 0) {
	if (objc != 4) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
        if (objc != 4) {
            goto wrongNumArgs;
        }
        index = Tcl_GetString(objv[2]);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	string = Tcl_GetString(objv[3]);
	if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	SetVarToObj(varPtr, destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
        if (GetVariableIndex(interp, string, &destIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        SetVarToObj(destIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	Tcl_SetObjResult(interp, varPtr[destIndex]);
    } else if (strcmp(subCmd, "freeallvars") == 0) {
	if (objc != 2) {
	    goto wrongNumArgs;
	}
	for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
	    if (varPtr[i] != NULL) {
		Tcl_DecrRefCount(varPtr[i]);
		varPtr[i] = NULL;
	    }
	}
    } else if (strcmp(subCmd, "invalidateStringRep") == 0) {
	if (objc != 3) {
        if (objc != 2) {
            goto wrongNumArgs;
        }
        for (i = 0;  i < NUMBER_OF_OBJECT_VARS;  i++) {
            if (varPtr[i] != NULL) {
                Tcl_DecrRefCount(varPtr[i]);
                varPtr[i] = NULL;
            }
        }
    } else if ( strcmp ( subCmd, "invalidateStringRep" ) == 0 ) {
	if ( objc != 3 ) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	index = Tcl_GetString( objv[2] );
	if ( GetVariableIndex( interp, index, &varIndex ) != TCL_OK ) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_InvalidateStringRep(varPtr[varIndex]);
	Tcl_SetObjResult(interp, varPtr[varIndex]);
	Tcl_InvalidateStringRep( varPtr[varIndex] );
	Tcl_SetObjResult( interp, varPtr[varIndex] );
    } else if (strcmp(subCmd, "newobj") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	SetVarToObj(varPtr, varIndex, Tcl_NewObj());
        if (objc != 3) {
            goto wrongNumArgs;
        }
        index = Tcl_GetString(objv[2]);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        SetVarToObj(varIndex, Tcl_NewObj());
	Tcl_SetObjResult(interp, varPtr[varIndex]);
    } else if (strcmp(subCmd, "objtype") == 0) {
	const char *typeName;

	/*
	 * Return an object containing the name of the argument's type of
	 * internal rep. If none exists, return "none".
	 * return an object containing the name of the argument's type
	 * of internal rep.  If none exists, return "none".
	 */

	if (objc != 3) {
	    goto wrongNumArgs;
	}
        if (objc != 3) {
            goto wrongNumArgs;
        }
	if (objv[2]->typePtr == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
	} else {
	    typeName = objv[2]->typePtr->name;
#ifndef TCL_WIDE_INT_IS_LONG
	    if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
	}
    } else if (strcmp(subCmd, "refcount") == 0) {
	char buf[TCL_INTEGER_SPACE];

	if (objc != 3) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
        if (objc != 3) {
            goto wrongNumArgs;
        }
        index = Tcl_GetString(objv[2]);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(varPtr[varIndex]->refCount));
	TclFormatInt(buf, varPtr[varIndex]->refCount);
        Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if (strcmp(subCmd, "type") == 0) {
	if (objc != 3) {
	    goto wrongNumArgs;
	}
	index = Tcl_GetString(objv[2]);
	if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (CheckIfVarUnset(interp, varPtr,varIndex)) {
        if (objc != 3) {
            goto wrongNumArgs;
        }
        index = Tcl_GetString(objv[2]);
        if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
            return TCL_ERROR;
        }
        if (CheckIfVarUnset(interp, varIndex)) {
	    return TCL_ERROR;
	}
	if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
        if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
#ifndef TCL_WIDE_INT_IS_LONG
	} else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) {
	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		    "int", -1);
#endif
	} else {
	    Tcl_AppendToObj(Tcl_GetObjResult(interp),
		    varPtr[varIndex]->typePtr->name, -1);
	}
        } else {
            Tcl_AppendToObj(Tcl_GetObjResult(interp),
                    varPtr[varIndex]->typePtr->name, -1);
        }
    } else if (strcmp(subCmd, "types") == 0) {
	if (objc != 2) {
	    goto wrongNumArgs;
	}
        if (objc != 2) {
            goto wrongNumArgs;
        }
	if (Tcl_AppendAllObjTypes(interp,
		Tcl_GetObjResult(interp)) != TCL_OK) {
	    return TCL_ERROR;
	}
    } else {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad option \"", Tcl_GetString(objv[1]),
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
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

1258


1259
1260
1261
1262
1263
1264
1265
1266







-
+




-

+

-
-
+
+
-
-
+

-
-
+
+








-


















-
+








-
+










-
+








-
+

















-
+








-
+









-
-
+
+






-
+
-
-
+







 *	have string type.
 *
 *----------------------------------------------------------------------
 */

static int
TeststringobjCmd(
    TCL_UNUSED(void *),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_UniChar *unicode;
    int varIndex, option, i, length;
    Tcl_UniChar *unicode;
#define MAX_STRINGS 11
    const char *index, *string, *strings[MAX_STRINGS+1];
    String *strPtr;
    char *index, *string, *strings[MAX_STRINGS+1];
    TestString *strPtr;
    Tcl_Obj **varPtr;
    static const char *const options[] = {
    static const char *options[] = {
	"append", "appendstrings", "get", "get2", "length", "length2",
	"set", "set2", "setlength", "maxchars", "appendself",
	"appendself2", NULL
	"set", "set2", "setlength", "ualloc", "getunicode",
	"appendself", "appendself2", NULL
    };

    if (objc < 3) {
	wrongNumArgs:
	Tcl_WrongNumArgs(interp, 1, objv, "option arg ?arg ...?");
	return TCL_ERROR;
    }

    varPtr = GetVarPtr(interp);
    index = Tcl_GetString(objv[2]);
    if (GetVariableIndex(interp, index, &varIndex) != TCL_OK) {
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &option)
	    != TCL_OK) {
	return TCL_ERROR;
    }
    switch (option) {
	case 0:				/* append */
	    if (objc != 5) {
		goto wrongNumArgs;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[4], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
		SetVarToObj(varIndex, Tcl_NewObj());
	    }

	    /*
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }
	    string = Tcl_GetString(objv[3]);
	    Tcl_AppendToObj(varPtr[varIndex], string, length);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 1:				/* appendstrings */
	    if (objc > (MAX_STRINGS+3)) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
		SetVarToObj(varIndex, Tcl_NewObj());
	    }

	    /*
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }
	    for (i = 3;  i < objc;  i++) {
		strings[i-3] = Tcl_GetString(objv[i]);
	    }
	    for ( ; i < 12 + 3; i++) {
		strings[i - 3] = NULL;
	    }
	    Tcl_AppendStringsToObj(varPtr[varIndex], strings[0], strings[1],
		    strings[2], strings[3], strings[4], strings[5],
		    strings[6], strings[7], strings[8], strings[9],
		    strings[10], strings[11]);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 2:				/* get */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (CheckIfVarUnset(interp, varPtr,varIndex)) {
	    if (CheckIfVarUnset(interp, varIndex)) {
		return TCL_ERROR;
	    }
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 3:				/* get2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (CheckIfVarUnset(interp, varPtr, varIndex)) {
	    if (CheckIfVarUnset(interp, varIndex)) {
		return TCL_ERROR;
	    }
	    string = Tcl_GetString(varPtr[varIndex]);
	    Tcl_AppendToObj(Tcl_GetObjResult(interp), string, -1);
	    break;
	case 4:				/* length */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
		    ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1);
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
		    ? varPtr[varIndex]->length : -1);
	    break;
	case 5:				/* length2 */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
		strPtr = (TestString *)
			Tcl_GetObjType("string"));
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		    (varPtr[varIndex])->internalRep.twoPtrValue.ptr1;
		length = (int) strPtr->allocated;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 6:				/* set */
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
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
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
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
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
1385
1386
1387
1388
1389
1390
1391







-
+







-
+












-
+




-
+
-
-
-
+
+





-
+
+
+
+
+
+
+




-
+








-
+
















-
+




-
+








-
+













-
+







	     */

	    string = Tcl_GetStringFromObj(objv[3], &length);
	    if ((varPtr[varIndex] != NULL)
		    && !Tcl_IsShared(varPtr[varIndex])) {
		Tcl_SetStringObj(varPtr[varIndex], string, length);
	    } else {
		SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
		SetVarToObj(varIndex, Tcl_NewStringObj(string, length));
	    }
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 7:				/* set2 */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    SetVarToObj(varPtr, varIndex, objv[3]);
	    SetVarToObj(varIndex, objv[3]);
	    break;
	case 8:				/* setlength */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[3], &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_SetObjLength(varPtr[varIndex], length);
	    }
	    break;
	case 9:				/* maxchars */
	case 9:				/* ualloc */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] != NULL) {
		Tcl_ConvertToType(NULL, varPtr[varIndex],
		strPtr = (TestString *)
			Tcl_GetObjType("string"));
		strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
		length = strPtr->maxChars;
		    (varPtr[varIndex])->internalRep.twoPtrValue.ptr1;
		length = (int) strPtr->uallocated;
	    } else {
		length = -1;
	    }
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
	    break;
	case 10:			/* appendself */
	case 10:			/* getunicode */
	    if (objc != 3) {
		goto wrongNumArgs;
	    }
	    Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
	    break;
	case 11:			/* appendself */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
		SetVarToObj(varIndex, Tcl_NewObj());
	    }

	    /*
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }

	    string = Tcl_GetStringFromObj(varPtr[varIndex], &length);

	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((i < 0) || (i > length)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    Tcl_AppendToObj(varPtr[varIndex], string + i, length - i);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
	case 11:			/* appendself2 */
	case 12:			/* appendself2 */
	    if (objc != 4) {
		goto wrongNumArgs;
	    }
	    if (varPtr[varIndex] == NULL) {
		SetVarToObj(varPtr, varIndex, Tcl_NewObj());
		SetVarToObj(varIndex, Tcl_NewObj());
	    }

	    /*
	     * If the object bound to variable "varIndex" is shared, we must
	     * "copy on write" and append to a copy of the object.
	     */

	    if (Tcl_IsShared(varPtr[varIndex])) {
		SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
		SetVarToObj(varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
	    }

	    unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);

	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if ((i < 0) || (i > length)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"index value out of range", -1));
		return TCL_ERROR;
	    }

	    TclAppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
	    Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
	    Tcl_SetObjResult(interp, varPtr[varIndex]);
	    break;
    }

    return TCL_OK;
}

1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1406
1407
1408
1409
1410
1411
1412

1413
1414
1415
1416
1417
1418
1419







-







 *	incremented (also if not NULL).
 *
 *----------------------------------------------------------------------
 */

static void
SetVarToObj(
    Tcl_Obj **varPtr,
    int varIndex,		/* Designates the assignment variable. */
    Tcl_Obj *objPtr)		/* Points to object to assign to var. */
{
    if (varPtr[varIndex] != NULL) {
	Tcl_DecrRefCount(varPtr[varIndex]);
    }
    varPtr[varIndex] = objPtr;
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1478
1479
1480
1481
1482
1483
1484

1485
1486
1487
1488
1489
1490
1491







-







 *
 *----------------------------------------------------------------------
 */

static int
CheckIfVarUnset(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Tcl_Obj ** varPtr,
    int varIndex)		/* Index of the test variable to check. */
{
    if (varPtr[varIndex] == NULL) {
	char buf[32 + TCL_INTEGER_SPACE];

	sprintf(buf, "variable %d is unset (NULL)", varIndex);
	Tcl_ResetResult(interp);

Changes to generic/tclTestProcBodyObj.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39



40
41
42
43
44
45
46
47
48
49


50
51
52
53
54



55
56
57
58
59
60
61

62
63
64
65
66
67

68
69
70
71
72
73
74
75
76
77
78

79
80
81

82
83
84

85
86
87
88
89
90
91
92

93
94
95
96
97
98
99
100
101
102

103
104
105

106
107
108

109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125
126

127
128
129
130

131
132
133

134
135
136
137
138

139
140

141
142

143
144

145
146
147
148
149
150
151
152
153
154






155
156

157

158
159
160
161
162
163
164
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













-
-
-







-
+






-






-
-
+
+
+








-
-
+
+
-
-


-
+
+
+






-
+

-



-
+

-








-
+


-
+


-
+







-
+









-
+


-
+


-
+







-
+









-
+
-


-
+


-
+




-
+
-
-
+

-
+

-
+




-
-
-
-
-
-
+
+
+
+
+
+
-
-
+

+







/*
 * tclTestProcBodyObj.c --
 *
 *	Implements the "procbodytest" package, which contains commands to test
 *	creation of Tcl procedures whose body argument is a Tcl_Obj of type
 *	"procbody" rather than a string.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

/*
 * name and version of this package
 */

static const char packageName[] = "procbodytest";
static const char packageVersion[] = "1.1";
static const char packageVersion[] = "1.0";

/*
 * Name of the commands exported by this package
 */

static const char procCommand[] = "proc";
static const char checkCommand[] = "check";

/*
 * this struct describes an entry in the table of command names and command
 * procs
 */

typedef struct {
    const char *cmdName;		/* command name */
typedef struct CmdTable
{
    const char *cmdName;	/* command name */
    Tcl_ObjCmdProc *proc;	/* command proc */
    int exportIt;		/* if 1, export the command */
} CmdTable;

/*
 * Declarations for functions defined in this file.
 */

static int	ProcBodyTestProcObjCmd(void *dummy,
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int	ProcBodyTestProcObjCmd(ClientData dummy,
			Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
static int	ProcBodyTestCheckObjCmd(void *dummy,
			Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int	ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
static int	RegisterCommand(Tcl_Interp* interp,
			const char *namesp, const CmdTable *cmdTablePtr);
			const char *namespace, const CmdTable *cmdTablePtr);
int             Procbodytest_Init(Tcl_Interp * interp);
int             Procbodytest_SafeInit(Tcl_Interp * interp);

/*
 * List of commands to create when the package is loaded; must go after the
 * declarations of the enable command procedure.
 */

static const CmdTable commands[] = {
static CONST CmdTable commands[] = {
    { procCommand,	ProcBodyTestProcObjCmd,	1 },
    { checkCommand,	ProcBodyTestCheckObjCmd,	1 },
    { 0, 0, 0 }
};

static const CmdTable safeCommands[] = {
static CONST CmdTable safeCommands[] = {
    { procCommand,	ProcBodyTestProcObjCmd,	1 },
    { checkCommand,	ProcBodyTestCheckObjCmd,	1 },
    { 0, 0, 0 }
};

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_Init --
 *
 *	This function initializes the "procbodytest" package.
 *  This function initializes the "procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *  A standard Tcl result.
 *
 * Side effects:
 *	None.
 *  None.
 *
 *----------------------------------------------------------------------
 */

int
Procbodytest_Init(
    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
				 * is initialized */
                                 * is initialized */
{
    return ProcBodyTestInitInternal(interp, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_SafeInit --
 *
 *	This function initializes the "procbodytest" package.
 *  This function initializes the "procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *  A standard Tcl result.
 *
 * Side effects:
 *	None.
 *  None.
 *
 *----------------------------------------------------------------------
 */

int
Procbodytest_SafeInit(
    Tcl_Interp *interp)		/* the Tcl interpreter for which the package
				 * is initialized */
                                 * is initialized */
{
    return ProcBodyTestInitInternal(interp, 1);
}

/*
 *----------------------------------------------------------------------
 *
 * RegisterCommand --
 *
 *	This function registers a command in the context of the given
 *  This function registers a command in the context of the given namespace.
 *	namespace.
 *
 * Results:
 *	A standard Tcl result.
 *  A standard Tcl result.
 *
 * Side effects:
 *	None.
 *  None.
 *
 *----------------------------------------------------------------------
 */

static int
static int RegisterCommand(interp, namespace, cmdTablePtr)
RegisterCommand(
    Tcl_Interp* interp,		/* the Tcl interpreter for which the operation
    Tcl_Interp* interp;		/* the Tcl interpreter for which the operation
				 * is performed */
    const char *namesp,		/* the namespace in which the command is
    const char *namespace;		/* the namespace in which the command is
				 * registered */
    const CmdTable *cmdTablePtr)/* the command to register */
    const CmdTable *cmdTablePtr;/* the command to register */
{
    char buf[128];

    if (cmdTablePtr->exportIt) {
	sprintf(buf, "namespace eval %s { namespace export %s }",
		namesp, cmdTablePtr->cmdName);
	if (Tcl_EvalEx(interp, buf, -1, 0) != TCL_OK) {
	    return TCL_ERROR;
	}
    }
        sprintf(buf, "namespace eval %s { namespace export %s }",
                namespace, cmdTablePtr->cmdName);
        if (Tcl_Eval(interp, buf) != TCL_OK)
            return TCL_ERROR;
    }


    sprintf(buf, "%s::%s", namesp, cmdTablePtr->cmdName);
    sprintf(buf, "%s::%s", namespace, cmdTablePtr->cmdName);
    Tcl_CreateObjCommand(interp, buf, cmdTablePtr->proc, 0, 0);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyTestInitInternal --
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
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







-
+


-
+



-
-
-
+
+
+


-
+







 *
 *----------------------------------------------------------------------
 */

static int
ProcBodyTestInitInternal(
    Tcl_Interp *interp,		/* the Tcl interpreter for which the package
				 * is initialized */
                                 * is initialized */
    int isSafe)			/* 1 if this is a safe interpreter */
{
    const CmdTable *cmdTablePtr;
    CONST CmdTable *cmdTablePtr;

    cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
    for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
	if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
	    return TCL_ERROR;
	}
        if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
            return TCL_ERROR;
        }
    }

    return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
    return Tcl_PkgProvide(interp, packageName, packageVersion);
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyTestProcObjCmd --
 *
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
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







-
+




-
+
















-
+


-
+






-
+


-
-
+
+

-
+








-
-
-
+
+
+
+








-
+

-
-
+
+









-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








 *  Leaves an error message in the interp's result on error.
 *
 *----------------------------------------------------------------------
 */

static int
ProcBodyTestProcObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* context; not used */
    Tcl_Interp *interp,		/* the current interpreter */
    int objc,			/* argument count */
    Tcl_Obj *const objv[])	/* arguments */
{
    const char *fullName;
    char *fullName;
    Tcl_Command procCmd;
    Command *cmdPtr;
    Proc *procPtr = NULL;
    Tcl_Obj *bodyObjPtr;
    Tcl_Obj *myobjv[5];
    int result;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "newName argsList bodyName");
	return TCL_ERROR;
    }

    /*
     * Find the Command pointer to this procedure
     */

    fullName = Tcl_GetString(objv[3]);
    fullName = Tcl_GetStringFromObj(objv[3], NULL);
    procCmd = Tcl_FindCommand(interp, fullName, NULL, TCL_LEAVE_ERR_MSG);
    if (procCmd == NULL) {
	return TCL_ERROR;
        return TCL_ERROR;
    }

    cmdPtr = (Command *) procCmd;

    /*
     * check that this is a procedure and not a builtin command:
     * If a procedure, cmdPtr->objClientData is TclIsProc(cmdPtr).
     * If a procedure, cmdPtr->objProc is TclObjInterpProc.
     */

    if (cmdPtr->objClientData != TclIsProc(cmdPtr)) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
    if (cmdPtr->objProc != TclGetObjInterpProc()) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"command \"", fullName, "\" is not a Tcl procedure", NULL);
	return TCL_ERROR;
        return TCL_ERROR;
    }

    /*
     * it is a Tcl procedure: the client data is the Proc structure
     */

    procPtr = (Proc *) cmdPtr->objClientData;
    if (procPtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "procedure \"",
		fullName, "\" does not have a Proc struct!", NULL);
	return TCL_ERROR;
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"procedure \"", fullName,
		"\" does not have a Proc struct!", NULL);
        return TCL_ERROR;
    }

    /*
     * create a new object, initialize our argument vector, call into Tcl
     */

    bodyObjPtr = TclNewProcBodyObj(procPtr);
    if (bodyObjPtr == NULL) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"failed to create a procbody object for procedure \"",
		fullName, "\"", NULL);
	return TCL_ERROR;
                fullName, "\"", NULL);
        return TCL_ERROR;
    }
    Tcl_IncrRefCount(bodyObjPtr);

    myobjv[0] = objv[0];
    myobjv[1] = objv[1];
    myobjv[2] = objv[2];
    myobjv[3] = bodyObjPtr;
    myobjv[4] = NULL;

    result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
    result = Tcl_ProcObjCmd((ClientData) NULL, interp, objc, myobjv);
    Tcl_DecrRefCount(bodyObjPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ProcBodyTestCheckObjCmd --
 *
 *  Implements the "procbodytest::check" command. Here is the command
 *  description:
 *	procbodytest::check
 *
 *  Performs an internal check that the Tcl_PkgPresent() command returns
 *  the same version number as was registered when the procbodytest package
 *  was provided.  Places a boolean in the interp result indicating the
 *  test outcome.
 *
 * Results:
 *  Returns a standard Tcl code.
 *
 *----------------------------------------------------------------------
 */

static int
ProcBodyTestCheckObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* the current interpreter */
    int objc,			/* argument count */
    Tcl_Obj *const objv[])	/* arguments */
{
    const char *version;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }

    version = Tcl_PkgPresentEx(interp, packageName, packageVersion, 1, NULL);
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
	    strcmp(version, packageVersion) == 0));
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclThread.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14







-







/*
 * tclThread.c --
 *
 *	This file implements Platform independent thread operations. Most of
 *	the real work is done in the platform dependent files.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 2008 by George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

36
37
38
39
40
41
42















43
44
45
46
47
48
49
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 * Prototypes of functions used only in this file.
 */

static void		ForgetSyncObject(void *objPtr, SyncObjRecord *recPtr);
static void		RememberSyncObject(void *objPtr,
			    SyncObjRecord *recPtr);

/*
 * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
 * specified. Here we undo that so the functions are defined in the stubs
 * table.
 */

#ifndef TCL_THREADS
#undef Tcl_MutexLock
#undef Tcl_MutexUnlock
#undef Tcl_MutexFinalize
#undef Tcl_ConditionNotify
#undef Tcl_ConditionWait
#undef Tcl_ConditionFinalize
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetThreadData --
 *
 *	This function allocates and initializes a chunk of thread local
 *	storage.
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
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







-
+


-
+



-
-
+


-
-
-
+
+
+



-
-
-
+
+
+

-
-

+







 *
 *----------------------------------------------------------------------
 */

void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    size_t size)		/* Size of storage block */
    int size)			/* Size of storage block */
{
    void *result;
#if TCL_THREADS
#ifdef TCL_THREADS
    /*
     * Initialize the key for this thread.
     */

    result = TclThreadStorageKeyGet(keyPtr);
    result = TclpThreadDataKeyGet(keyPtr);

    if (result == NULL) {
	result = Tcl_Alloc(size);
	memset(result, 0, size);
	TclThreadStorageKeySet(keyPtr, result);
	result = ckalloc((size_t) size);
	memset(result, 0, (size_t) size);
	TclpThreadDataKeySet(keyPtr, result);
    }
#else /* TCL_THREADS */
    if (*keyPtr == NULL) {
	result = Tcl_Alloc(size);
	memset(result, 0, size);
	*keyPtr = result;
	result = ckalloc((size_t) size);
	memset(result, 0, (size_t) size);
	*keyPtr = (Tcl_ThreadDataKey)result;
	RememberSyncObject(keyPtr, &keyRecord);
    } else {
	result = *keyPtr;
    }
    result = * (void **) keyPtr;
#endif /* TCL_THREADS */
    return result;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
-
+
+

-
-
+
+

+
-
+


+









-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclThreadDataKeyGet(
    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk. */

    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk, really
				 * (pthread_key_t **) */
{
#if TCL_THREADS
    return TclThreadStorageKeyGet(keyPtr);
#ifdef TCL_THREADS
    return TclpThreadDataKeyGet(keyPtr);
#else /* TCL_THREADS */
    char *result = *(char **) keyPtr;
    return *keyPtr;
    return result;
#endif /* TCL_THREADS */
}


/*
 *----------------------------------------------------------------------
 *
 * RememberSyncObject
 *
 *	Keep a list of (mutexes/condition variable/data key) used during
 *	finalization.
 *
 *	Assume global lock is held.
 *	Assume master lock is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Add to the appropriate list.
 *
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
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







-
+






-
+















-
+







    /*
     * Grow the list of pointers if necessary, copying only non-NULL
     * pointers to the new list.
     */

    if (recPtr->num >= recPtr->max) {
	recPtr->max += 8;
	newList = (void **)Tcl_Alloc(recPtr->max * sizeof(void *));
	newList = (void **) ckalloc(recPtr->max * sizeof(char *));
	for (i=0,j=0 ; i<recPtr->num ; i++) {
	    if (recPtr->list[i] != NULL) {
		newList[j++] = recPtr->list[i];
	    }
	}
	if (recPtr->list != NULL) {
	    Tcl_Free(recPtr->list);
	    ckfree((char *) recPtr->list);
	}
	recPtr->list = newList;
	recPtr->num = j;
    }

    recPtr->list[recPtr->num] = objPtr;
    recPtr->num++;
}

/*
 *----------------------------------------------------------------------
 *
 * ForgetSyncObject
 *
 *	Remove a single object from the list.
 *	Assume global lock is held.
 *	Assume master lock is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Remove from the appropriate list.
 *
215
216
217
218
219
220
221
222

223
224
225
226
227
228
229
229
230
231
232
233
234
235

236
237
238
239
240
241
242
243







-
+








/*
 *----------------------------------------------------------------------
 *
 * TclRememberMutex
 *
 *	Keep a list of mutexes used during finalization.
 *	Assume global lock is held.
 *	Assume master lock is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Add to the mutex list.
 *
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
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







-




-
+


-
+

-
+








-
+







 *
 * Side effects:
 *	Remove the mutex from the list.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_MutexFinalize
void
Tcl_MutexFinalize(
    Tcl_Mutex *mutexPtr)
{
#if TCL_THREADS
#ifdef TCL_THREADS
    TclpFinalizeMutex(mutexPtr);
#endif
    TclpGlobalLock();
    TclpMasterLock();
    ForgetSyncObject(mutexPtr, &mutexRecord);
    TclpGlobalUnlock();
    TclpMasterUnlock();
}

/*
 *----------------------------------------------------------------------
 *
 * TclRememberCondition
 *
 *	Keep a list of condition variables used during finalization.
 *	Assume global lock is held.
 *	Assume master lock is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Add to the condition variable list.
 *
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
317
318
319
320
321
322
323

324
325
326
327

328
329
330

331
332

333
334
335
336
337
338
339
340







-




-
+


-
+

-
+







 *
 * Side effects:
 *	Remove the condition variable from the list.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_ConditionFinalize
void
Tcl_ConditionFinalize(
    Tcl_Condition *condPtr)
{
#if TCL_THREADS
#ifdef TCL_THREADS
    TclpFinalizeCondition(condPtr);
#endif
    TclpGlobalLock();
    TclpMasterLock();
    ForgetSyncObject(condPtr, &condRecord);
    TclpGlobalUnlock();
    TclpMasterUnlock();
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadData --
 *
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
348
349
350
351
352
353
354

355
356


357
358





359



360
361
362
363
364
365
366







-
+

-
-
+
+
-
-
-
-
-
+
-
-
-







 * Side effects:
 *	Frees up all thread local storage.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadData(int quick)
TclFinalizeThreadData(void)
{
    TclFinalizeThreadDataThread();
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    TclpFinalizeThreadDataThread();
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
    if (!quick) {
	/*
	 * Quick exit principle makes it useless to terminate allocators
	 */
	TclFinalizeThreadAllocThread();
    TclFinalizeThreadAllocThread();
    }
#else
    (void)quick;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeSynchronization --
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
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
450







-
+



-
+










-
-
+
+

-
+




-
-
+
+

-
+











-
+












-
+





-
+








void
TclFinalizeSynchronization(void)
{
    int i;
    void *blockPtr;
    Tcl_ThreadDataKey *keyPtr;
#if TCL_THREADS
#ifdef TCL_THREADS
    Tcl_Mutex *mutexPtr;
    Tcl_Condition *condPtr;

    TclpGlobalLock();
    TclpMasterLock();
#endif

    /*
     * If we're running unthreaded, the TSD blocks are simply stored inside
     * their thread data keys. Free them here.
     */

    if (keyRecord.list != NULL) {
	for (i=0 ; i<keyRecord.num ; i++) {
	    keyPtr = (Tcl_ThreadDataKey *) keyRecord.list[i];
	    blockPtr = *keyPtr;
	    Tcl_Free(blockPtr);
	    blockPtr = (void *) *keyPtr;
	    ckfree(blockPtr);
	}
	Tcl_Free(keyRecord.list);
	ckfree((char *) keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

#if TCL_THREADS
    
#ifdef TCL_THREADS
    /*
     * Call thread storage global cleanup.
     * Call thread storage master cleanup.
     */

    TclFinalizeThreadStorage();

    for (i=0 ; i<mutexRecord.num ; i++) {
	mutexPtr = (Tcl_Mutex *)mutexRecord.list[i];
	if (mutexPtr != NULL) {
	    TclpFinalizeMutex(mutexPtr);
	}
    }
    if (mutexRecord.list != NULL) {
	Tcl_Free(mutexRecord.list);
	ckfree((char *) mutexRecord.list);
	mutexRecord.list = NULL;
    }
    mutexRecord.max = 0;
    mutexRecord.num = 0;

    for (i=0 ; i<condRecord.num ; i++) {
	condPtr = (Tcl_Condition *) condRecord.list[i];
	if (condPtr != NULL) {
	    TclpFinalizeCondition(condPtr);
	}
    }
    if (condRecord.list != NULL) {
	Tcl_Free(condRecord.list);
	ckfree((char *) condRecord.list);
	condRecord.list = NULL;
    }
    condRecord.max = 0;
    condRecord.num = 0;

    TclpGlobalUnlock();
    TclpMasterUnlock();
#endif /* TCL_THREADS */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ExitThread --
458
459
460
461
462
463
464

465

466
467
468

469
470
471
472
473
474
475
463
464
465
466
467
468
469
470
471
472
473
474

475
476
477
478
479
480
481
482







+

+


-
+







 */

void
Tcl_ExitThread(
    int status)
{
    Tcl_FinalizeThread();
#ifdef TCL_THREADS
    TclpThreadExit(status);
#endif
}

#if !TCL_THREADS
#ifndef TCL_THREADS

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait, et al. --
 *
 *	These noop functions are provided so the stub table does not have to
486
487
488
489
490
491
492
493

494
495
496
497
498
499
500
493
494
495
496
497
498
499

500
501
502
503
504
505
506
507







-
+







 */

#undef Tcl_ConditionWait
void
Tcl_ConditionWait(
    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
    Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
    const Tcl_Time *timePtr) /* Timeout on waiting period */
    Tcl_Time *timePtr)		/* Timeout on waiting period */
{
}

#undef Tcl_ConditionNotify
void
Tcl_ConditionNotify(
    Tcl_Condition *condPtr)

Changes to generic/tclThreadAlloc.c.

9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23







-
+







 * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * If range checking is enabled, an additional byte will be allocated to store
 * the magic number at the end of the requested memory.
 */

#ifndef RCHECK
31
32
33
34
35
36
37
38
39
40

41
42
43
44
45
46
47
31
32
33
34
35
36
37



38
39
40
41
42
43
44
45







-
-
-
+







/*
 * The following define the number of Tcl_Obj's to allocate/move at a time and
 * the high water mark to prune a per-thread cache. On a 32 bit system,
 * sizeof(Tcl_Obj) = 24 so 800 * 24 = ~16k.
 */

#define NOBJALLOC	800

/* Actual definition moved to tclInt.h */
#define NOBJHIGH	ALLOC_NOBJHIGH
#define NOBJHIGH	1200

/*
 * The following union stores accounting information for each block including
 * two small magic numbers and a bucket number when in use or a next pointer
 * when free. The original requested size (not including the Block overhead)
 * is also maintained.
 */
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
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







-
+

-
-
+



-
-
-
-
-
+
+
+
+
+




-
+
-
-







-











-
-
+
+












-
-
+
+

-










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#define MAXALLOC	(MINALLOC << (NBUCKETS - 1))

/*
 * The following structure defines a bucket of blocks with various accounting
 * and statistics information.
 */

typedef struct {
typedef struct Bucket {
    Block *firstPtr;		/* First block available */
    Block *lastPtr;		/* End of block list */
    size_t numFree;		/* Number of blocks available */
    long numFree;		/* Number of blocks available */

    /* All fields below for accounting only */

    size_t numRemoves;		/* Number of removes from bucket */
    size_t numInserts;		/* Number of inserts into bucket */
    size_t numWaits;		/* Number of waits to acquire a lock */
    size_t numLocks;		/* Number of locks acquired */
    size_t totalAssigned;	/* Total space assigned to bucket */
    long numRemoves;		/* Number of removes from bucket */
    long numInserts;		/* Number of inserts into bucket */
    long numWaits;		/* Number of waits to acquire a lock */
    long numLocks;		/* Number of locks acquired */
    long totalAssigned;		/* Total space assigned to bucket */
} Bucket;

/*
 * The following structure defines a cache of buckets and objs, of which there
 * will be (at most) one per thread. Any changes need to be reflected in the
 * will be (at most) one per thread.
 * struct AllocCache defined in tclInt.h, possibly also in the initialisation
 * code in Tcl_CreateInterp().
 */

typedef struct Cache {
    struct Cache *nextPtr;	/* Linked list of cache entries */
    Tcl_ThreadId owner;		/* Which thread's cache is this? */
    Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
    int numObjects;		/* Number of objects for thread */
    Tcl_Obj *lastPtr;		/* Last object in this cache */
    int totalAssigned;		/* Total space assigned to thread */
    Bucket buckets[NBUCKETS];	/* The buckets for this thread */
} Cache;

/*
 * The following array specifies various per-bucket limits and locks. The
 * values are statically initialized to avoid calculating them repeatedly.
 */

static struct {
    size_t blockSize;		/* Bucket blocksize. */
    size_t maxBlocks;		/* Max blocks before move to share. */
    size_t numMove;			/* Num blocks to move to share. */
    int maxBlocks;		/* Max blocks before move to share. */
    int numMove;		/* Num blocks to move to share. */
    Tcl_Mutex *lockPtr;		/* Share bucket lock. */
} bucketInfo[NBUCKETS];

/*
 * Static functions defined in this file.
 */

static Cache *	GetCache(void);
static void	LockBucket(Cache *cachePtr, int bucket);
static void	UnlockBucket(Cache *cachePtr, int bucket);
static void	PutBlocks(Cache *cachePtr, int bucket, int numMove);
static int	GetBlocks(Cache *cachePtr, int bucket);
static Block *	Ptr2Block(void *ptr);
static void *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
static Block *	Ptr2Block(char *ptr);
static char *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
static void	PutObjs(Cache *fromPtr, int numMove);

/*
 * Local variables defined in this file and initialized at startup.
 */

static Tcl_Mutex *listLockPtr;
static Tcl_Mutex *objLockPtr;
static Cache sharedCache;
static Cache *sharedPtr = &sharedCache;
static Cache *firstCachePtr = &sharedCache;

#if defined(HAVE_FAST_TSD)
static __thread Cache *tcachePtr;

# define GETCACHE(cachePtr)			\
    do {					\
	if (!tcachePtr) {			\
	    tcachePtr = GetCache();		\
	}					\
	(cachePtr) = tcachePtr;			\
    } while (0)
#else
# define GETCACHE(cachePtr)			\
    do {					\
	(cachePtr) = (Cache*)TclpGetAllocCache();	\
	if ((cachePtr) == NULL) {		\
	    (cachePtr) = GetCache();		\
	}					\
    } while (0)
#endif

/*
 *----------------------------------------------------------------------
 *
 * GetCache ---
 *
 *	Gets per-thread memory cache, allocating it if necessary.
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
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







+




-
+
+
+
+
+
+
+
+
+








-
+

-
+



-








    /*
     * Check for first-time initialization.
     */

    if (listLockPtr == NULL) {
	Tcl_Mutex *initLockPtr;
	unsigned int i;

	initLockPtr = Tcl_GetAllocMutex();
	Tcl_MutexLock(initLockPtr);
	if (listLockPtr == NULL) {
	    TclInitThreadAlloc();
	    listLockPtr = TclpNewAllocMutex();
	    objLockPtr = TclpNewAllocMutex();
	    for (i = 0; i < NBUCKETS; ++i) {
		bucketInfo[i].blockSize = MINALLOC << i;
		bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
		bucketInfo[i].numMove = i < NBUCKETS - 1 ?
			1 << (NBUCKETS - 2 - i) : 1;
		bucketInfo[i].lockPtr = TclpNewAllocMutex();
	    }
	}
	Tcl_MutexUnlock(initLockPtr);
    }

    /*
     * Get this thread's cache, allocating if necessary.
     */

    cachePtr = (Cache*)TclpGetAllocCache();
    cachePtr = TclpGetAllocCache();
    if (cachePtr == NULL) {
	cachePtr = (Cache*)TclpSysAlloc(sizeof(Cache));
	cachePtr = calloc(1, sizeof(Cache));
	if (cachePtr == NULL) {
	    Tcl_Panic("alloc: could not allocate new cache");
	}
        memset(cachePtr, 0, sizeof(Cache));
	Tcl_MutexLock(listLockPtr);
	cachePtr->nextPtr = firstCachePtr;
	firstCachePtr = cachePtr;
	Tcl_MutexUnlock(listLockPtr);
	cachePtr->owner = Tcl_GetCurrentThread();
	TclpSetAllocCache(cachePtr);
    }
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
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







-
+

-
+
















+
-
+
+














-
+


















-
+

-
+



-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+



-
+







-
+



-
+






-
+




-
-
+
+







 *----------------------------------------------------------------------
 */

void
TclFreeAllocCache(
    void *arg)
{
    Cache *cachePtr = (Cache*)arg;
    Cache *cachePtr = arg;
    Cache **nextPtrPtr;
    unsigned int bucket;
    register unsigned int bucket;

    /*
     * Flush blocks.
     */

    for (bucket = 0; bucket < NBUCKETS; ++bucket) {
	if (cachePtr->buckets[bucket].numFree > 0) {
	    PutBlocks(cachePtr, bucket, cachePtr->buckets[bucket].numFree);
	}
    }

    /*
     * Flush objs.
     */

    if (cachePtr->numObjects > 0) {
	Tcl_MutexLock(objLockPtr);
	PutObjs(cachePtr, cachePtr->numObjects);
	MoveObjs(cachePtr, sharedPtr, cachePtr->numObjects);
	Tcl_MutexUnlock(objLockPtr);
    }

    /*
     * Remove from pool list.
     */

    Tcl_MutexLock(listLockPtr);
    nextPtrPtr = &firstCachePtr;
    while (*nextPtrPtr != cachePtr) {
	nextPtrPtr = &(*nextPtrPtr)->nextPtr;
    }
    *nextPtrPtr = cachePtr->nextPtr;
    cachePtr->nextPtr = NULL;
    Tcl_MutexUnlock(listLockPtr);
    TclpSysFree(cachePtr);
    free(cachePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpAlloc --
 *
 *	Allocate memory.
 *
 * Results:
 *	Pointer to memory just beyond Block pointer.
 *
 * Side effects:
 *	May allocate more blocks for a bucket.
 *
 *----------------------------------------------------------------------
 */

void *
char *
TclpAlloc(
    size_t reqSize)
    unsigned int reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    int bucket;
    register int bucket;
    size_t size;

#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    cachePtr = TclpGetAllocCache();
    GETCACHE(cachePtr);
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }

    /*
     * Increment the requested size to include room for the Block structure.
     * Call TclpSysAlloc() directly if the required amount is greater than the
     * Call malloc() directly if the required amount is greater than the
     * largest block, otherwise pop the smallest block large enough,
     * allocating more blocks if necessary.
     */

    blockPtr = NULL;
    size = reqSize + sizeof(Block);
#if RCHECK
    size++;
    ++size;
#endif
    if (size > MAXALLOC) {
	bucket = NBUCKETS;
	blockPtr = (Block *)TclpSysAlloc(size);
	blockPtr = malloc(size);
	if (blockPtr != NULL) {
	    cachePtr->totalAssigned += reqSize;
	}
    } else {
	bucket = 0;
	while (bucketInfo[bucket].blockSize < size) {
	    bucket++;
	    ++bucket;
	}
	if (cachePtr->buckets[bucket].numFree || GetBlocks(cachePtr, bucket)) {
	    blockPtr = cachePtr->buckets[bucket].firstPtr;
	    cachePtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
	    cachePtr->buckets[bucket].numFree--;
	    cachePtr->buckets[bucket].numRemoves++;
	    --cachePtr->buckets[bucket].numFree;
	    ++cachePtr->buckets[bucket].numRemoves;
	    cachePtr->buckets[bucket].totalAssigned += reqSize;
	}
    }
    if (blockPtr == NULL) {
	return NULL;
    }
    return Block2Ptr(blockPtr, bucket, reqSize);
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
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







-
+









+
-
+
+
+











-
+






-
-
-
-
-
+
+







 *	May move blocks to shared cache.
 *
 *----------------------------------------------------------------------
 */

void
TclpFree(
    void *ptr)
    char *ptr)
{
    Cache *cachePtr;
    Block *blockPtr;
    int bucket;

    if (ptr == NULL) {
	return;
    }

    cachePtr = TclpGetAllocCache();
    GETCACHE(cachePtr);
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }

    /*
     * Get the block back from the user pointer and call system free directly
     * for large blocks. Otherwise, push the block back on the bucket and move
     * blocks to the shared cache if there are now too many free.
     */

    blockPtr = Ptr2Block(ptr);
    bucket = blockPtr->sourceBucket;
    if (bucket == NBUCKETS) {
	cachePtr->totalAssigned -= blockPtr->blockReqSize;
	TclpSysFree(blockPtr);
	free(blockPtr);
	return;
    }

    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
    blockPtr->nextBlock = cachePtr->buckets[bucket].firstPtr;
    cachePtr->buckets[bucket].firstPtr = blockPtr;
    if (cachePtr->buckets[bucket].numFree == 0) {
	cachePtr->buckets[bucket].lastPtr = blockPtr;
    }
    cachePtr->buckets[bucket].numFree++;
    cachePtr->buckets[bucket].numInserts++;
    ++cachePtr->buckets[bucket].numFree;
    ++cachePtr->buckets[bucket].numInserts;

    if (cachePtr != sharedPtr &&
	    cachePtr->buckets[bucket].numFree > bucketInfo[bucket].maxBlocks) {
	PutBlocks(cachePtr, bucket, bucketInfo[bucket].numMove);
    }
}

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
458
459
460
461
462
463
464
465
466
467
468

469
470
471
472
473
474
475
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
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







-
+

-
-
+
+











+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+




-
+





-
+
















-
+







 *
 * Side effects:
 *	Previous memory, if any, may be freed.
 *
 *----------------------------------------------------------------------
 */

void *
char *
TclpRealloc(
    void *ptr,
    size_t reqSize)
    char *ptr,
    unsigned int reqSize)
{
    Cache *cachePtr;
    Block *blockPtr;
    void *newPtr;
    size_t size, min;
    int bucket;

    if (ptr == NULL) {
	return TclpAlloc(reqSize);
    }

#ifndef __LP64__
    if (sizeof(int) >= sizeof(size_t)) {
	/* An unsigned int overflow can also be a size_t overflow */
	const size_t zero = 0;
	const size_t max = ~zero;

	if (((size_t) reqSize) > max - sizeof(Block) - RCHECK) {
	    /* Requested allocation exceeds memory */
	    return NULL;
	}
    }
#endif

    cachePtr = TclpGetAllocCache();
    GETCACHE(cachePtr);
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }

    /*
     * If the block is not a system block and fits in place, simply return the
     * existing pointer. Otherwise, if the block is a system block and the new
     * size would also require a system block, call TclpSysRealloc() directly.
     * size would also require a system block, call realloc() directly.
     */

    blockPtr = Ptr2Block(ptr);
    size = reqSize + sizeof(Block);
#if RCHECK
    size++;
    ++size;
#endif
    bucket = blockPtr->sourceBucket;
    if (bucket != NBUCKETS) {
	if (bucket > 0) {
	    min = bucketInfo[bucket-1].blockSize;
	} else {
	    min = 0;
	}
	if (size > min && size <= bucketInfo[bucket].blockSize) {
	    cachePtr->buckets[bucket].totalAssigned -= blockPtr->blockReqSize;
	    cachePtr->buckets[bucket].totalAssigned += reqSize;
	    return Block2Ptr(blockPtr, bucket, reqSize);
	}
    } else if (size > MAXALLOC) {
	cachePtr->totalAssigned -= blockPtr->blockReqSize;
	cachePtr->totalAssigned += reqSize;
	blockPtr = (Block*)TclpSysRealloc(blockPtr, size);
	blockPtr = realloc(blockPtr, size);
	if (blockPtr == NULL) {
	    return NULL;
	}
	return Block2Ptr(blockPtr, NBUCKETS, reqSize);
    }

    /*
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
595
596
597
598
599
600
601

602
603
604
605
606
607
608

609


610
611
612
613
614
615
616
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
611
612
613
614
615

616
617
618
619
620
621
622
623
624







-
-
-
-






-
-
+
+

-
+
+
+







-
+














-
+



-
-

+
-
-
+
+

-








-
-
+
+
















-
-
-
-







-
+

-
+
+
+







-
-
-
-
+







+
-
+
+







 * Results:
 *	Pointer to uninitialized Tcl_Obj.
 *
 * Side effects:
 *	May move Tcl_Obj's from shared cached or allocate new Tcl_Obj's if
 *	list is empty.
 *
 * Note:
 *	If this code is updated, the changes need to be reflected in the macro
 *	TclAllocObjStorageEx() defined in tclInt.h
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclThreadAllocObj(void)
{
    Cache *cachePtr;
    Tcl_Obj *objPtr;
    register Cache *cachePtr = TclpGetAllocCache();
    register Tcl_Obj *objPtr;

    GETCACHE(cachePtr);
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }

    /*
     * Get this thread's obj list structure and move or allocate new objs if
     * necessary.
     */

    if (cachePtr->numObjects == 0) {
	int numMove;
	register int numMove;

	Tcl_MutexLock(objLockPtr);
	numMove = sharedPtr->numObjects;
	if (numMove > 0) {
	    if (numMove > NOBJALLOC) {
		numMove = NOBJALLOC;
	    }
	    MoveObjs(sharedPtr, cachePtr, numMove);
	}
	Tcl_MutexUnlock(objLockPtr);
	if (cachePtr->numObjects == 0) {
	    Tcl_Obj *newObjsPtr;

	    cachePtr->numObjects = numMove = NOBJALLOC;
	    newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove);
	    newObjsPtr = malloc(sizeof(Tcl_Obj) * numMove);
	    if (newObjsPtr == NULL) {
		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
	    }
	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
	    objPtr = cachePtr->firstObjPtr;	/* NULL */
	    while (--numMove >= 0) {
		objPtr = &newObjsPtr[numMove];
		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
		objPtr = newObjsPtr + numMove;
		objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
		cachePtr->firstObjPtr = objPtr;
	    }
	    cachePtr->firstObjPtr = newObjsPtr;
	}
    }

    /*
     * Pop the first object.
     */

    objPtr = cachePtr->firstObjPtr;
    cachePtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
    cachePtr->numObjects--;
    cachePtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;
    --cachePtr->numObjects;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclThreadFreeObj --
 *
 *	Return a free Tcl_Obj to the per-thread cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May move free Tcl_Obj's to shared list upon hitting high water mark.
 *
 * Note:
 *	If this code is updated, the changes need to be reflected in the macro
 *	TclAllocObjStorageEx() defined in tclInt.h
 *
 *----------------------------------------------------------------------
 */

void
TclThreadFreeObj(
    Tcl_Obj *objPtr)
{
    Cache *cachePtr;
    Cache *cachePtr = TclpGetAllocCache();

    GETCACHE(cachePtr);
    if (cachePtr == NULL) {
	cachePtr = GetCache();
    }

    /*
     * Get this thread's list and push on the free Tcl_Obj.
     */

    objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr;
    cachePtr->firstObjPtr = objPtr;
    if (cachePtr->numObjects == 0) {
	cachePtr->lastPtr = objPtr;
    }
    cachePtr->numObjects++;
    ++cachePtr->numObjects;

    /*
     * If the number of free objects has exceeded the high water mark, move
     * some blocks to the shared list.
     */

    if (cachePtr->numObjects > NOBJHIGH) {
	Tcl_MutexLock(objLockPtr);
	PutObjs(cachePtr, NOBJALLOC);
	MoveObjs(cachePtr, sharedPtr, NOBJALLOC);
	Tcl_MutexUnlock(objLockPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetMemoryInfo --
641
642
643
644
645
646
647
648
649


650
651
652
653
654
655
656
649
650
651
652
653
654
655


656
657
658
659
660
661
662
663
664







-
-
+
+







	if (cachePtr == sharedPtr) {
	    Tcl_DStringAppendElement(dsPtr, "shared");
	} else {
	    sprintf(buf, "thread%p", cachePtr->owner);
	    Tcl_DStringAppendElement(dsPtr, buf);
	}
	for (n = 0; n < NBUCKETS; ++n) {
	    sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u",
		    bucketInfo[n].blockSize,
	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
		    (unsigned long) bucketInfo[n].blockSize,
		    cachePtr->buckets[n].numFree,
		    cachePtr->buckets[n].numRemoves,
		    cachePtr->buckets[n].numInserts,
		    cachePtr->buckets[n].totalAssigned,
		    cachePtr->buckets[n].numLocks,
		    cachePtr->buckets[n].numWaits);
	    Tcl_DStringAppendElement(dsPtr, buf);
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
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
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
756

757
758
759
760
761
762
763
764







-
+











-
+

-
+






-
-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

















-
+





-
+








-
+




-
+

-
+








static void
MoveObjs(
    Cache *fromPtr,
    Cache *toPtr,
    int numMove)
{
    Tcl_Obj *objPtr = fromPtr->firstObjPtr;
    register Tcl_Obj *objPtr = fromPtr->firstObjPtr;
    Tcl_Obj *fromFirstObjPtr = objPtr;

    toPtr->numObjects += numMove;
    fromPtr->numObjects -= numMove;

    /*
     * Find the last object to be moved; set the next one (the first one not
     * to be moved) as the first object in the 'from' cache.
     */

    while (--numMove) {
	objPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
	objPtr = objPtr->internalRep.twoPtrValue.ptr1;
    }
    fromPtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
    fromPtr->firstObjPtr = objPtr->internalRep.twoPtrValue.ptr1;

    /*
     * Move all objects as a block - they are already linked to each other, we
     * just have to update the first and last.
     */

    toPtr->lastPtr = objPtr;
    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr; /* NULL */
    objPtr->internalRep.twoPtrValue.ptr1 = toPtr->firstObjPtr;
    toPtr->firstObjPtr = fromFirstObjPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * PutObjs --
 *
 *	Move Tcl_Obj's from thread cache to shared cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
PutObjs(
    Cache *fromPtr,
    int numMove)
{
    int keep = fromPtr->numObjects - numMove;
    Tcl_Obj *firstPtr, *lastPtr = NULL;

    fromPtr->numObjects = keep;
    firstPtr = fromPtr->firstObjPtr;
    if (keep == 0) {
	fromPtr->firstObjPtr = NULL;
    } else {
	do {
	    lastPtr = firstPtr;
	    firstPtr = (Tcl_Obj *)firstPtr->internalRep.twoPtrValue.ptr1;
	} while (--keep > 0);
	lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
    }

    /*
     * Move all objects as a block - they are already linked to each other, we
     * just have to update the first and last.
     */

    Tcl_MutexLock(objLockPtr);
    fromPtr->lastPtr->internalRep.twoPtrValue.ptr1 = sharedPtr->firstObjPtr;
    sharedPtr->firstObjPtr = firstPtr;
    if (sharedPtr->numObjects == 0) {
	sharedPtr->lastPtr = fromPtr->lastPtr;
    }
    sharedPtr->numObjects += numMove;
    Tcl_MutexUnlock(objLockPtr);

    fromPtr->lastPtr = lastPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Block2Ptr, Ptr2Block --
 *
 *	Convert between internal blocks and user pointers.
 *
 * Results:
 *	User pointer or internal block.
 *
 * Side effects:
 *	Invalid blocks will abort the server.
 *
 *----------------------------------------------------------------------
 */

static void *
static char *
Block2Ptr(
    Block *blockPtr,
    int bucket,
    unsigned int reqSize)
{
    void *ptr;
    register void *ptr;

    blockPtr->magicNum1 = blockPtr->magicNum2 = MAGIC;
    blockPtr->sourceBucket = bucket;
    blockPtr->blockReqSize = reqSize;
    ptr = ((void *) (blockPtr + 1));
#if RCHECK
    ((unsigned char *)(ptr))[reqSize] = MAGIC;
#endif
    return ptr;
    return (char *) ptr;
}

static Block *
Ptr2Block(
    void *ptr)
    char *ptr)
{
    Block *blockPtr;
    register Block *blockPtr;

    blockPtr = (((Block *) ptr) - 1);
    if (blockPtr->magicNum1 != MAGIC || blockPtr->magicNum2 != MAGIC) {
	Tcl_Panic("alloc: invalid block: %p: %x %x",
		blockPtr, blockPtr->magicNum1, blockPtr->magicNum2);
    }
#if RCHECK
835
836
837
838
839
840
841


842
843
844









845
846
847
848
849

850
851
852
853
854
855
856
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







+
+
-
-
-
+
+
+
+
+
+
+
+
+




-
+







 */

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].numLocks++;
    sharedPtr->buckets[bucket].numLocks++;
	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(
    TCL_UNUSED(Cache *),
    Cache *cachePtr,
    int bucket)
{
    Tcl_MutexUnlock(bucketInfo[bucket].lockPtr);
}

/*
 *----------------------------------------------------------------------
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
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







+
+
+

-
-
+
+


-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-







-
-
+

-
-
-
-


-
-








static void
PutBlocks(
    Cache *cachePtr,
    int bucket,
    int numMove)
{
    register Block *lastPtr, *firstPtr;
    register int n = numMove;

    /*
     * We have numFree.  Want to shed numMove. So compute how many
     * Blocks to keep.
     * Before acquiring the lock, walk the block list to find the last block
     * to be moved.
     */

    int keep = cachePtr->buckets[bucket].numFree - numMove;
    Block *lastPtr = NULL, *firstPtr;

    cachePtr->buckets[bucket].numFree = keep;
    firstPtr = lastPtr = cachePtr->buckets[bucket].firstPtr;
    while (--n > 0) {
	lastPtr = lastPtr->nextBlock;
    }
    cachePtr->buckets[bucket].firstPtr = lastPtr->nextBlock;
    firstPtr = cachePtr->buckets[bucket].firstPtr;
    if (keep == 0) {
	cachePtr->buckets[bucket].firstPtr = NULL;
    cachePtr->buckets[bucket].numFree -= numMove;
    } else {
	do {
	    lastPtr = firstPtr;
	    firstPtr = firstPtr->nextBlock;
	} while (--keep > 0);
	lastPtr->nextBlock = NULL;
    }

    /*
     * Aquire the lock and place the list of blocks at the front of the shared
     * cache bucket.
     */

    LockBucket(cachePtr, bucket);
    cachePtr->buckets[bucket].lastPtr->nextBlock
	    = sharedPtr->buckets[bucket].firstPtr;
    lastPtr->nextBlock = sharedPtr->buckets[bucket].firstPtr;
    sharedPtr->buckets[bucket].firstPtr = firstPtr;
    if (sharedPtr->buckets[bucket].numFree == 0) {
	sharedPtr->buckets[bucket].lastPtr
		= cachePtr->buckets[bucket].lastPtr;
    }
    sharedPtr->buckets[bucket].numFree += numMove;
    UnlockBucket(cachePtr, bucket);

    cachePtr->buckets[bucket].lastPtr = lastPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * GetBlocks --
 *
930
931
932
933
934
935
936
937
938


939
940
941
942
943
944
945
880
881
882
883
884
885
886


887
888
889
890
891
892
893
894
895







-
-
+
+







 */

static int
GetBlocks(
    Cache *cachePtr,
    int bucket)
{
    Block *blockPtr;
    size_t n;
    register Block *blockPtr;
    register int n;

    /*
     * First, atttempt to move blocks from the shared cache. Note the
     * potentially dirty read of numFree before acquiring the lock which is a
     * slight performance enhancement. The value is verified after the lock is
     * actually acquired.
     */
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
1065
1066
1067
1068
1069
1070
1071
1072
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







-
-













-







-
+








-
-
+
+




-
+










-
+

















-




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	     * block to move.
	     */

	    n = bucketInfo[bucket].numMove;
	    if (n >= sharedPtr->buckets[bucket].numFree) {
		cachePtr->buckets[bucket].firstPtr =
			sharedPtr->buckets[bucket].firstPtr;
		cachePtr->buckets[bucket].lastPtr =
			sharedPtr->buckets[bucket].lastPtr;
		cachePtr->buckets[bucket].numFree =
			sharedPtr->buckets[bucket].numFree;
		sharedPtr->buckets[bucket].firstPtr = NULL;
		sharedPtr->buckets[bucket].numFree = 0;
	    } else {
		blockPtr = sharedPtr->buckets[bucket].firstPtr;
		cachePtr->buckets[bucket].firstPtr = blockPtr;
		sharedPtr->buckets[bucket].numFree -= n;
		cachePtr->buckets[bucket].numFree = n;
		while (--n > 0) {
		    blockPtr = blockPtr->nextBlock;
		}
		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
		cachePtr->buckets[bucket].lastPtr = blockPtr;
		blockPtr->nextBlock = NULL;
	    }
	}
	UnlockBucket(cachePtr, bucket);
    }

    if (cachePtr->buckets[bucket].numFree == 0) {
	size_t size;
	register size_t size;

	/*
	 * If no blocks could be moved from shared, first look for a larger
	 * block in this cache to split up.
	 */

	blockPtr = NULL;
	n = NBUCKETS;
	size = 0;
	while (--n > (size_t)bucket) {
	size = 0; /* lint */
	while (--n > bucket) {
	    if (cachePtr->buckets[n].numFree > 0) {
		size = bucketInfo[n].blockSize;
		blockPtr = cachePtr->buckets[n].firstPtr;
		cachePtr->buckets[n].firstPtr = blockPtr->nextBlock;
		cachePtr->buckets[n].numFree--;
		--cachePtr->buckets[n].numFree;
		break;
	    }
	}

	/*
	 * Otherwise, allocate a big new block directly.
	 */

	if (blockPtr == NULL) {
	    size = MAXALLOC;
	    blockPtr = (Block*)TclpSysAlloc(size);
	    blockPtr = malloc(size);
	    if (blockPtr == NULL) {
		return 0;
	    }
	}

	/*
	 * Split the larger block into smaller blocks for this bucket.
	 */

	n = size / bucketInfo[bucket].blockSize;
	cachePtr->buckets[bucket].numFree = n;
	cachePtr->buckets[bucket].firstPtr = blockPtr;
	while (--n > 0) {
	    blockPtr->nextBlock = (Block *)
		((char *) blockPtr + bucketInfo[bucket].blockSize);
	    blockPtr = blockPtr->nextBlock;
	}
	cachePtr->buckets[bucket].lastPtr = blockPtr;
	blockPtr->nextBlock = NULL;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitThreadAlloc --
 *
 *	Initializes the allocator cache-maintenance structures.
 *      It is done early and protected during the Tcl_InitSubsystems().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclInitThreadAlloc(void)
{
    unsigned int i;

    listLockPtr = TclpNewAllocMutex();
    objLockPtr = TclpNewAllocMutex();
    for (i = 0; i < NBUCKETS; ++i) {
	bucketInfo[i].blockSize = MINALLOC << i;
	bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i);
	bucketInfo[i].numMove = i < NBUCKETS - 1 ?
		1 << (NBUCKETS - 2 - i) : 1;
	bucketInfo[i].lockPtr = TclpNewAllocMutex();
    }
    TclpInitAllocCache();
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadAlloc --
 *
 *	This procedure is used to destroy all private resources used in this
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
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







-
-
+
+
















-
-
-
+
+
+













-
+








void
TclFinalizeThreadAlloc(void)
{
    unsigned int i;

    for (i = 0; i < NBUCKETS; ++i) {
	TclpFreeAllocMutex(bucketInfo[i].lockPtr);
	bucketInfo[i].lockPtr = NULL;
        TclpFreeAllocMutex(bucketInfo[i].lockPtr);
        bucketInfo[i].lockPtr = NULL;
    }

    TclpFreeAllocMutex(objLockPtr);
    objLockPtr = NULL;

    TclpFreeAllocMutex(listLockPtr);
    listLockPtr = NULL;

    TclpFreeAllocCache(NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadAllocThread --
 *
 *	This procedure is used to destroy single thread private resources
 *	defined in this file. Called either during Tcl_FinalizeThread() or
 *	Tcl_Finalize().
 *	This procedure is used to destroy single thread private resources used
 *	in this file. 
 * Called in TclpFinalizeThreadData when a thread exits (Tcl_FinalizeThread).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadAllocThread(void)
{
    Cache *cachePtr = (Cache *)TclpGetAllocCache();
    Cache *cachePtr = TclpGetAllocCache();
    if (cachePtr != NULL) {
	TclpFreeAllocCache(cachePtr);
    }
}

#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
/*
1142
1143
1144
1145
1146
1147
1148
1149

1150
1151
1152
1153
1154
1155
1156
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1068







-
+







 *	List appended to given dstring.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_GetMemoryInfo(
    TCL_UNUSED(Tcl_DString *))
    Tcl_DString *dsPtr)
{
    Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use");
}

/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclThreadJoin.c.

10
11
12
13
14
15
16
17

18
19
20
21
22
23
24
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24







-
+







 *
 * 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
#ifdef WIN32

/*
 * The information about each joinable thread is remembered in a structure as
 * defined below.
 */

typedef struct JoinableThread {
48
49
50
51
52
53
54
55

56
57
58
59
60
61
62
48
49
50
51
52
53
54

55
56
57
58
59
60
61
62







-
+







 * The following variable is used to maintain the global list of all joinable
 * threads. Usage by a thread is allowed only if the thread acquired the
 * 'joinMutex'.
 */

TCL_DECLARE_MUTEX(joinMutex)

static JoinableThread *firstThreadPtr;
static JoinableThread* firstThreadPtr;

/*
 *----------------------------------------------------------------------
 *
 * TclJoinThread --
 *
 *	This procedure waits for the exit of the thread with the specified id
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211
197
198
199
200
201
202
203

204
205
206
207
208
209
210
211







-
+







     * the structure and return.
     */

    *result = threadPtr->result;

    Tcl_ConditionFinalize(&threadPtr->cond);
    Tcl_MutexFinalize(&threadPtr->threadMutex);
    Tcl_Free(threadPtr);
    ckfree((char *) threadPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
226
227
228
229
230
231
232

233
234
235
236
237
238
239
240







-
+








void
TclRememberJoinableThread(
    Tcl_ThreadId id)		/* The thread to remember as joinable */
{
    JoinableThread *threadPtr;

    threadPtr = (JoinableThread *)Tcl_Alloc(sizeof(JoinableThread));
    threadPtr = (JoinableThread *) ckalloc(sizeof(JoinableThread));
    threadPtr->id = id;
    threadPtr->done = 0;
    threadPtr->waitedUpon = 0;
    threadPtr->threadMutex = (Tcl_Mutex) NULL;
    threadPtr->cond = (Tcl_Condition) NULL;

    Tcl_MutexLock(&joinMutex);
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315
316
301
302
303
304
305
306
307

308
309
310
311
312
313
314
315
316







-
+









    if (threadPtr->waitedUpon) {
	Tcl_ConditionNotify(&threadPtr->cond);
    }

    Tcl_MutexUnlock(&threadPtr->threadMutex);
}
#endif /* _WIN32 */
#endif /* WIN32 */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclThreadStorage.c.

1
2
3
4

5
6
7
8
9
10
11
12
13
14
15
16

17
18
19

20
21
22
23
24
25
26





















27











28










29
30

31
32
33

34

35
36
37
38
39
40








41
42
43
44









45


46
47



48
49

50

51
52
53
54






55
56
57


58











59
60
61










62
63
64
65
66
67
68














69
70
71
72
73
74










75
76
77
78
79





80
81
82
83



84
85
86
87
























88
89
90
91
92
93
94
95












96
97
98

























99



100
101
102













103
104
105


106
107
108
109
110




111
112
113
114







115


116
117
118















119

120
121





122


123
124
125

126
127
128
129
130
131

132
133

134
135
136
137
138
139




140

141






142
143
144
145

146
147
148

149
150
151

152
153

154
155
156




157
158
159


160
161
162
163


164
165
166
167




168
169
170
171
172
173
174
175

176
177

178
179
180


181
182
183
184
185
186
187
188
189
190



191
192
193
194
195



196
197
198


199
200
201

202
203
204
205
206
207

208
209

210
211
212
213
214
215
216


217
218
219
220
221
222
223


224
225
226
227
228

229
230
231

232
233

234
235
236
237
238
239
240
241

242
243

244
245
246
247
248

249
250

251
252
253

254
255
256
257
258
259
260

261
262
263
264


265
266
267
268
269
270
271
272
273
274
275

276
277


278
279
280
281
282

283

284
285
286
287
288
289

290




291







292


293
294


295
296
297
298
299














300
301
302
303











304
305
306
307
308
309
310










311
312




313
314





315



316
317
318
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
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

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
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
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



-
+
-


-







-
+
-


+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+

-
+
-


+
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+

+
+

-
+
+
+


+
-
+
-
-
-
-
+
+
+
+
+
+


-
+
+

+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+


-
-
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+

+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
+
+
+
+
+

+
+

-
-
+





-
+

-
+
-





+
+
+
+
-
+

+
+
+
+
+
+



-
+
-
-
-
+

-
-
+
-
-
+
-
-
-
+
+
+
+

-
-
+
+
-
-
-
-
+
+
-
-
-
-
+
+
+
+
-
-





-
+

-
+


-
+
+








-
-
+
+
+

-
-
-
-
+
+
+

-
-
+
+
-

-
+





-
+

-
+
-





-
+
+





-
-
+
+
-
-
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-





-
+

-
+
+





+
-
+





-
+

+
+
+
+
-
+
+
+
+
+
+
+

+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
-
-
+
+
+
+
+

+
+
+
-
-
-
-
+
+
+
+
+
+
+
+







-
-
+
+





+
-
+







+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
+







-
+
+







/*
 * tclThreadStorage.c --
 *
 *	This file implements platform independent thread storage operations to
 *	This file implements platform independent thread storage operations.
 *	work around system limits on the number of thread-specific variables.
 *
 * Copyright (c) 2003-2004 by Joe Mistachkin
 * Copyright (c) 2008 by George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if TCL_THREADS
#if defined(TCL_THREADS)
#include <signal.h>

/*
 * This is the thread storage cache array and it's accompanying mutex. The
 * IMPLEMENTATION NOTES:
 *
 * The primary idea is that we create one platform-specific TSD slot, and use
 * it for storing a table pointer. Each Tcl_ThreadDataKey has an offset into
 * the table of TSD values. We don't use more than 1 platform-specific TSD
 * slot, because there is a hard limit on the number of TSD slots. Valid key
 * offsets are greater than 0; 0 is for the initialized Tcl_ThreadDataKey.
 * elements are pairs of thread Id and an associated hash table pointer; the
 * hash table being pointed to contains the thread storage for it's associated
 * thread. The purpose of this cache is to minimize the number of hash table
 * lookups in the master thread storage hash table.
 */

static Tcl_Mutex threadStorageLock;

/*
 * This is the struct used for a thread storage cache slot. It contains the
 * owning thread Id and the associated hash table pointer.
 */

typedef struct ThreadStorage {
    Tcl_ThreadId id;		/* the owning thread id */
    Tcl_HashTable *hashTablePtr;/* the hash table for the thread */
} ThreadStorage;

/*
 * These are the prototypes for the custom hash table allocation functions
 * used by the thread storage subsystem.
 */

static Tcl_HashEntry *	AllocThreadStorageEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static void		FreeThreadStorageEntry(Tcl_HashEntry *hPtr);
static Tcl_HashTable *	ThreadStorageGetHashTable(Tcl_ThreadId id);

/*
 * This is the hash key type for thread storage. We MUST use this in
 * combination with the new hash key type flag TCL_HASH_KEY_SYSTEM_HASH
 * because these hash tables MAY be used by the threaded memory allocator.
 */

static Tcl_HashKeyType tclThreadStorageHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
    TCL_HASH_KEY_SYSTEM_HASH | TCL_HASH_KEY_RANDOMIZE_HASH,
				        /* flags */
    NULL,				/* hashKeyProc */
    NULL,				/* compareKeysProc */
    AllocThreadStorageEntry,		/* allocEntryProc */
    FreeThreadStorageEntry		/* freeEntryProc */
};

/*
 * The global collection of information about TSDs. This is shared across the
 * This is an invalid thread value.
 * whole process, and includes the mutex used to protect it.
 */

#define STORAGE_INVALID_THREAD  (Tcl_ThreadId)0
static struct {

    void *key;			/* Key into the system TSD structure. The
				 * collection of Tcl TSD values for a
				 * particular thread will hang off the
				 * back-end of this. */
    sig_atomic_t counter;	/* The number of different Tcl TSDs used
				 * across *all* threads. This is a strictly
/*
 * This is the value for an invalid thread storage key.
 */

#define STORAGE_INVALID_KEY	0

/*
 * This is the first valid key for use by external callers. All the values
				 * increasing value. */
    Tcl_Mutex mutex;		/* Protection for the rest of this structure,
				 * which holds per-process data. */
} tsdGlobal = { NULL, 0, NULL };
 * below this are RESERVED for future use.
 */

#define STORAGE_FIRST_KEY	1

/*
 * This is the default number of thread storage cache slots. This define may
 * need to be fine tuned for maximum performance.
 */

#define STORAGE_CACHE_SLOTS	97

/*
 * The type of the data held per thread in a system TSD.
 * This is the master thread storage hash table. It is keyed on thread Id and
 * contains values that are hash tables for each thread. The thread specific
 * hash tables contain the actual thread storage.
 */

static Tcl_HashTable threadStorageHashTable;
typedef struct {

    ClientData *tablePtr;	/* The table of Tcl TSDs. */
    sig_atomic_t allocated;	/* The size of the table in the current
				 * thread. */
} TSDTable;
/*
 * This is the next thread data key value to use. We increment this everytime
 * we "allocate" one. It is initially set to 1 in TclInitThreadStorage.
 */

static int nextThreadStorageKey = STORAGE_INVALID_KEY;

/*
 * The actual type of Tcl_ThreadDataKey.
 * This is the master thread storage cache. Per Kevin Kenny's idea, this
 * prevents unnecessary lookups for threads that use a lot of thread storage.
 */

static volatile ThreadStorage threadStorageCache[STORAGE_CACHE_SLOTS];

/*
 *----------------------------------------------------------------------
 *
 * AllocThreadStorageEntry --
 *
 *	Allocate space for a Tcl_HashEntry using TclpSysAlloc (not ckalloc).
 *	We do this because the threaded memory allocator MAY use the thread
 *	storage hash tables.

typedef union {
    volatile sig_atomic_t offset;
 *
 * Results:
 *	The return value is a pointer to the created entry.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

				/* The type is really an offset into the
				 * thread-local table of TSDs, which is this
				 * field. */
    void *ptr;			/* For alignment purposes only. Not actually
				 * accessed through this. */
} TSDUnion;

static Tcl_HashEntry *
AllocThreadStorageEntry(
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_HashEntry *hPtr;

    hPtr = (Tcl_HashEntry *) TclpSysAlloc(sizeof(Tcl_HashEntry), 0);
    hPtr->key.oneWordValue = keyPtr;
    hPtr->clientData = NULL;

    return hPtr;
}

/*
 * Forward declarations of functions in this file.
 */

static TSDTable *	TSDTableCreate(void);
static void		TSDTableDelete(TSDTable *tsdTablePtr);
 *----------------------------------------------------------------------
 *
 * FreeThreadStorageEntry --
 *
 *	Frees space for a Tcl_HashEntry using TclpSysFree (not ckfree). We do
 *	this because the threaded memory allocator MAY use the thread storage
 *	hash tables.
 *
 * Results:
 *	None.
static void		TSDTableGrow(TSDTable *tsdTablePtr,
			    sig_atomic_t atLeast);

/*
 * Allocator and deallocator for a TSDTable structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static TSDTable *
TSDTableCreate(void)
static void
FreeThreadStorageEntry(
    Tcl_HashEntry *hPtr)	/* Hash entry to free. */
{
    TSDTable *tsdTablePtr;
    sig_atomic_t i;

    TclpSysFree((char *) hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ThreadStorageGetHashTable --
 *
 *	This procedure returns a hash table pointer to be used for thread
 *	storage for the specified thread.
 *
 * Results:
 *	A hash table pointer for the specified thread, or NULL if the hash
 *	table has not been created yet.
 *
 * Side effects:
 *	May change an entry in the master thread storage cache to point to the
 *	specified thread and it's associated hash table.
 *
 * Thread safety:
 *	This function assumes that integer operations are safe (atomic)
 *	on all (currently) supported Tcl platforms.  Hence there are
 * 	places where shared integer arithmetic is done w/o protective locks.
 *
    tsdTablePtr = (TSDTable *)TclpSysAlloc(sizeof(TSDTable));
    if (tsdTablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }

    tsdTablePtr->allocated = 8;
    tsdTablePtr->tablePtr =
	    (void **)TclpSysAlloc(sizeof(void *) * tsdTablePtr->allocated);
 *----------------------------------------------------------------------
 */

static Tcl_HashTable *
ThreadStorageGetHashTable(
    Tcl_ThreadId id)		/* Id of thread to get hash table for */
{
    int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
    Tcl_HashEntry *hPtr;
    int isNew;
    Tcl_HashTable *hashTablePtr;

    if (tsdTablePtr->tablePtr == NULL) {
	Tcl_Panic("unable to allocate TSDTable");
    }
    /*
     * It's important that we pick up the hash table pointer BEFORE comparing
     * thread Id in case another thread is in the critical region changing
     * things out from under you.
     *
     * Thread safety: threadStorageCache is accessed w/o locks in order to
     * avoid serialization of all threads at this hot-spot. It is safe to
     * do this here because (threadStorageCache[index].id != id) test below
     * should be atomic on all (currently) supported platforms and there
     * are no devastatig side effects of the test.
     *
     * Note Valgrind users: this place will show up as a race-condition in
     * helgrind-tool output. To silence this warnings, define VALGRIND
     * symbol at compilation time.
     */

#if !defined(VALGRIND)
    hashTablePtr = threadStorageCache[index].hashTablePtr;
    if (threadStorageCache[index].id != id) {
	Tcl_MutexLock(&threadStorageLock);
#else
    Tcl_MutexLock(&threadStorageLock);
    hashTablePtr = threadStorageCache[index].hashTablePtr;
    if (threadStorageCache[index].id != id) {
#endif

	/*
	 * It's not in the cache, so we look it up...
	 */
    for (i = 0; i < tsdTablePtr->allocated; ++i) {
	tsdTablePtr->tablePtr[i] = NULL;
    }

	hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char *) id);

	if (hPtr != NULL) {
	    /*
	     * We found it, extract the hash table pointer.
	     */

	    hashTablePtr = Tcl_GetHashValue(hPtr);
	} else {
	    /*
	     * The thread specific hash table is not found.
	     */

    return tsdTablePtr;
}
	    hashTablePtr = NULL;
	}

static void
TSDTableDelete(
    TSDTable *tsdTablePtr)
{
	if (hashTablePtr == NULL) {
	    hashTablePtr = (Tcl_HashTable *)
		    TclpSysAlloc(sizeof(Tcl_HashTable), 0);

    sig_atomic_t i;

    for (i=0 ; i<tsdTablePtr->allocated ; i++) {
	if (tsdTablePtr->tablePtr[i] != NULL) {
	    if (hashTablePtr == NULL) {
		Tcl_Panic("could not allocate thread specific hash table, "
			"TclpSysAlloc failed from ThreadStorageGetHashTable!");
	    }
	    Tcl_InitCustomHashTable(hashTablePtr, TCL_CUSTOM_TYPE_KEYS,
		    &tclThreadStorageHashKeyType);

	    /*
	     * Add new thread storage hash table to the master hash table.
	     */
	     * These values were allocated in Tcl_GetThreadData in tclThread.c
	     * and must now be deallocated or they will leak.
	     */

	    hPtr = Tcl_CreateHashEntry(&threadStorageHashTable, (char *) id,
		    &isNew);

	    if (hPtr == NULL) {
		Tcl_Panic("Tcl_CreateHashEntry failed from "
			"ThreadStorageGetHashTable!");
	    }
	    Tcl_SetHashValue(hPtr, hashTablePtr);
	}

	/*
	 * Now, we put it in the cache since it is highly likely it will be
	 * needed again shortly.
	 */

	threadStorageCache[index].id = id;
	    Tcl_Free(tsdTablePtr->tablePtr[i]);
	}
	threadStorageCache[index].hashTablePtr = hashTablePtr;
#if !defined(VALGRIND)
	Tcl_MutexUnlock(&threadStorageLock);
    }
#else
    }
    Tcl_MutexUnlock(&threadStorageLock);
#endif

    TclpSysFree(tsdTablePtr->tablePtr);
    TclpSysFree(tsdTablePtr);
    return hashTablePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TSDTableGrow --
 * TclInitThreadStorage --
 *
 *	This procedure makes the passed TSDTable grow to fit the atLeast
 *	Initializes the thread storage allocator.
 *	value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This procedure initializes the master hash table that maps thread ID
 *	onto the individual index tables that map thread data key to thread
 *	data. It also creates a cache that enables fast lookup of the thread
 *	data block array for a recently executing thread without using
 *	The table is enlarged.
 *	spinlocks.
 *
 * This procedure is called from an extremely early point in Tcl's
 * initialization. In particular, it may not use ckalloc/ckfree because they
 * may depend on thread-local storage (it uses TclpSysAlloc and TclpSysFree
 * instead). It may not depend on synchronization primitives - but no threads
 * other than the master thread have yet been launched.
 *
 *----------------------------------------------------------------------
 */

static void
void
TSDTableGrow(
    TSDTable *tsdTablePtr,
    sig_atomic_t atLeast)
TclInitThreadStorage(void)
{
    sig_atomic_t newAllocated = tsdTablePtr->allocated * 2;
    void **newTablePtr;
    Tcl_InitCustomHashTable(&threadStorageHashTable, TCL_CUSTOM_TYPE_KEYS,
    sig_atomic_t i;

	    &tclThreadStorageHashKeyType);
    if (newAllocated <= atLeast) {
	newAllocated = atLeast + 10;
    }

    /*
     * We also initialize the cache.
     */

    newTablePtr = (void **)TclpSysRealloc(tsdTablePtr->tablePtr,
	    sizeof(void *) * newAllocated);
    memset((void*) &threadStorageCache, 0,
	    sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);
    if (newTablePtr == NULL) {
	Tcl_Panic("unable to reallocate TSDTable");
    }


    /*
    for (i = tsdTablePtr->allocated; i < newAllocated; ++i) {
	newTablePtr[i] = NULL;
    }

     * Now, we set the first value to be used for a thread data key.
     */

    nextThreadStorageKey = STORAGE_FIRST_KEY;
    tsdTablePtr->allocated = newAllocated;
    tsdTablePtr->tablePtr = newTablePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclThreadStorageKeyGet --
 * TclpThreadDataKeyGet --
 *
 *    This procedure gets the value associated with the passed key.
 *	This procedure returns a pointer to a block of thread local storage.
 *
 * Results:
 *	A pointer value associated with the Tcl_ThreadDataKey or NULL.
 *	A thread-specific pointer to the data structure, or NULL if the memory
 *	has not been assigned to this key for this thread.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclThreadStorageKeyGet(
    Tcl_ThreadDataKey *dataKeyPtr)
TclpThreadDataKeyGet(
    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk, really
				 * (int**) */
{
    TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetGlobalTSD(tsdGlobal.key);
    ClientData resultPtr = NULL;
    TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;
    sig_atomic_t offset = keyPtr->offset;
    Tcl_HashTable *hashTablePtr =
	    ThreadStorageGetHashTable(Tcl_GetCurrentThread());
    Tcl_HashEntry *hPtr = Tcl_FindHashEntry(hashTablePtr, (char *) keyPtr);

    if ((tsdTablePtr != NULL) && (offset > 0)
	    && (offset < tsdTablePtr->allocated)) {
    if (hPtr == NULL) {
	return NULL;
	resultPtr = tsdTablePtr->tablePtr[offset];
    }
    return resultPtr;
    return Tcl_GetHashValue(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclThreadStorageKeySet --
 * TclpThreadDataKeySet --
 *
 *	This procedure set an association of value with the key passed. The
 *	This procedure sets the pointer to a block of thread local storage.
 *	associated value may be retrieved with TclThreadDataKeyGet().
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The thread-specific table may be created or reallocated.
 *	Sets up the thread so future calls to TclpThreadDataKeyGet with this
 *	key will return the data pointer.
 *
 *----------------------------------------------------------------------
 */

void
TclThreadStorageKeySet(
    Tcl_ThreadDataKey *dataKeyPtr,
TclpThreadDataKeySet(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk, really
    void *value)
{
    TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetGlobalTSD(tsdGlobal.key);
    TSDUnion *keyPtr = (TSDUnion *) dataKeyPtr;

				 * (pthread_key_t **) */
    if (tsdTablePtr == NULL) {
	tsdTablePtr = TSDTableCreate();
	TclpThreadSetGlobalTSD(tsdGlobal.key, tsdTablePtr);
    void *data)			/* Thread local storage */
    }

{
    /*
     * Get the lock while we check if this TSD is new or not. Note that this
     * is the only place where Tcl_ThreadDataKey values are set. We use a
     * double-checked lock to try to avoid having to grab this lock a lot,
     * since it is on quite a few critical paths and will only get set once in
     * each location.
     */

    Tcl_HashTable *hashTablePtr;
    if (keyPtr->offset == 0) {
	Tcl_MutexLock(&tsdGlobal.mutex);
    Tcl_HashEntry *hPtr;
	if (keyPtr->offset == 0) {
	    /*
	     * The Tcl_ThreadDataKey hasn't been used yet. Make a new one.
	     */

    int dummy;
	    keyPtr->offset = ++tsdGlobal.counter;
	}

	Tcl_MutexUnlock(&tsdGlobal.mutex);
    }

    hashTablePtr = ThreadStorageGetHashTable(Tcl_GetCurrentThread());
    /*
     * Check if this is the first time this Tcl_ThreadDataKey has been used
     * with the current thread. Note that we don't need to hold a lock when
     * doing this, as we are *definitely* the only point accessing this
     * tsdTablePtr right now; it's thread-local.
     */

    hPtr = Tcl_CreateHashEntry(hashTablePtr, (char *)keyPtr, &dummy);
    if (keyPtr->offset >= tsdTablePtr->allocated) {
	TSDTableGrow(tsdTablePtr, keyPtr->offset);
    }


    Tcl_SetHashValue(hPtr, data);
    /*
     * Set the value in the Tcl thread-local variable.
     */

    tsdTablePtr->tablePtr[keyPtr->offset] = value;
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadDataThread --
 * TclpFinalizeThreadDataThread --
 *
 *	This procedure finalizes the data for a single thread.
 *	This procedure cleans up the thread storage hash table for the
 *	current thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees all associated thread storage, all hash table entries for
 *	The TSDTable is deleted/freed.
 *	the thread's thread storage, and the hash table itself.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadDataThread(void)
TclpFinalizeThreadDataThread(void)
{
    Tcl_ThreadId id = Tcl_GetCurrentThread();
				/* Id of the thread to finalize. */
    int index = PTR2UINT(id) % STORAGE_CACHE_SLOTS;
    Tcl_HashEntry *hPtr;	/* Hash entry for current thread in master
    TSDTable *tsdTablePtr = (TSDTable *)TclpThreadGetGlobalTSD(tsdGlobal.key);
				 * table. */
    Tcl_HashTable* hashTablePtr;/* Pointer to the hash table holding TSD
				 * blocks for the current thread*/
    Tcl_HashSearch search;	/* Search object to walk the TSD blocks in the
				 * designated thread */
    Tcl_HashEntry *hPtr2;	/* Hash entry for a TSD block in the
				 * designated thread. */

    Tcl_MutexLock(&threadStorageLock);
    hPtr = Tcl_FindHashEntry(&threadStorageHashTable, (char*)id);
    if (tsdTablePtr != NULL) {
	TSDTableDelete(tsdTablePtr);
    if (hPtr == NULL) {
	hashTablePtr = NULL;
	TclpThreadSetGlobalTSD(tsdGlobal.key, NULL);
    }
}

/*
    } else {
	/*
	 * We found it, extract the hash table pointer.
	 */

	hashTablePtr = Tcl_GetHashValue(hPtr);
	Tcl_DeleteHashEntry(hPtr);

	/*
	 * Make sure cache entry for this thread is NULL.
	 */

	if (threadStorageCache[index].id == id) {
	    /*
 *----------------------------------------------------------------------
 *
 * TclInitializeThreadStorage --
 *
	     * We do not step on another thread's cache entry. This is
	     * especially important if we are creating and exiting a lot of
	     * threads.
	     */

	    threadStorageCache[index].id = STORAGE_INVALID_THREAD;
	    threadStorageCache[index].hashTablePtr = NULL;
	}
    }
    Tcl_MutexUnlock(&threadStorageLock);

 *	This procedure initializes the TSD subsystem with per-platform code.
 *	This should be called before any Tcl threads are created.
 *
 * Results:
 *	None.
 *
 * Side effects:
    /*
     * The thread's hash table has been extracted and removed from the master
     * hash table. Now clean up the thread.
     */

    if (hashTablePtr != NULL) {
	/*
	 * Free all TSD
	 */

 *	Allocates a system TSD.
 *
	for (hPtr2 = Tcl_FirstHashEntry(hashTablePtr, &search); hPtr2 != NULL;
		hPtr2 = Tcl_NextHashEntry(&search)) {
	    void *blockPtr = Tcl_GetHashValue(hPtr2);

 *----------------------------------------------------------------------
 */
	    if (blockPtr != NULL) {
		/*
		 * The block itself was allocated in Tcl_GetThreadData using
		 * ckalloc; use ckfree to dispose of it.
		 */

		ckfree(blockPtr);
	    }
	}
void
TclInitThreadStorage(void)
{
    tsdGlobal.key = TclpThreadCreateKey();

	/*
	 * Delete thread specific hash table and free the struct.
	 */

	Tcl_DeleteHashTable(hashTablePtr);
	TclpSysFree((char *) hashTablePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeThreadStorage --
 *
 *	This procedure cleans up the thread storage data key for all threads.
 *	IMPORTANT: All Tcl threads must be finalized before calling this!
 *	This procedure cleans up the master thread storage hash table, all
 *	thread specific hash tables, and the thread storage cache.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The master thread storage hash table and thread storage cache are
 *	Releases the thread data key.
 *	reset to their initial (empty) state.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadStorage(void)
{
    Tcl_HashSearch search;	/* We need to hit every thread with this
				 * search. */
    Tcl_HashEntry *hPtr;	/* Hash entry for current thread in master
				 * table. */
    Tcl_MutexLock(&threadStorageLock);
    TclpThreadDeleteKey(tsdGlobal.key);
    tsdGlobal.key = NULL;
}

#else /* !TCL_THREADS */

    /*
     * We are going to delete the hash table for every thread now. This hash
     * table should be empty at this point, except for one entry for the
     * current thread.
     */

    for (hPtr = Tcl_FirstHashEntry(&threadStorageHashTable, &search);
	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_HashTable *hashTablePtr = Tcl_GetHashValue(hPtr);

	if (hashTablePtr != NULL) {
	    /*
	     * Delete thread specific hash table for the thread in question
	     * and free the struct.
	     */

	    Tcl_DeleteHashTable(hashTablePtr);
	    TclpSysFree((char *)hashTablePtr);
	}

	/*
	 * Delete thread specific entry from master hash table.
	 */

	Tcl_SetHashValue(hPtr, NULL);
    }

    Tcl_DeleteHashTable(&threadStorageHashTable);

    /*
     * Clear out the thread storage cache as well.
     */

    memset((void*) &threadStorageCache, 0,
	    sizeof(ThreadStorage) * STORAGE_CACHE_SLOTS);

    /*
     * Reset this to zero, it will be set to STORAGE_FIRST_KEY if the thread
     * storage subsystem gets reinitialized
     */

    nextThreadStorageKey = STORAGE_INVALID_KEY;

    Tcl_MutexUnlock(&threadStorageLock);
}

#else /* !defined(TCL_THREADS) */

/*
 * Stub functions for non-threaded builds
 */

void
TclInitThreadStorage(void)
{
}

void
TclFinalizeThreadDataThread(void)
TclpFinalizeThreadDataThread(void)
{
}

void
TclFinalizeThreadStorage(void)
{
}
#endif /* TCL_THREADS */

#endif /* defined(TCL_THREADS) && defined(USE_THREAD_STORAGE) */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:

Changes to generic/tclThreadTest.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20


21

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37




38
39

40
41
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56

57
58
59
60
61

62
63
64
65

66
67
68
69
70
71
72
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









-





-
-
-


+
+
-
+












-
-
-
-
+
+
+
+
-
-
+
-








-
+





-
-
+




-
+



-
+







/*
 * tclThreadTest.c --
 *
 *	This file implements the testthread command. Eventually this should be
 *	tclThreadCmd.c
 *	Some of this code is based on work done by Richard Hipp on behalf of
 *	Conservation Through Innovation, Limited, with their permission.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

extern int	Tcltest_Init(Tcl_Interp *interp);

#if TCL_THREADS
#ifdef TCL_THREADS
/*
 * Each thread has an single instance of the following structure. There is one
 * instance of this structure per thread even if that thread contains multiple
 * interpreters. The interpreter identified by this structure is the main
 * interpreter for the thread.
 *
 * The main interpreter is the one that will process any messages received by
 * a thread. Any thread can send messages but only the main interpreter can
 * receive them.
 */

typedef struct ThreadSpecificData {
    Tcl_ThreadId threadId;	/* Tcl ID for this thread */
    Tcl_Interp *interp;		/* Main interpreter for this thread */
    int flags;			/* See the TP_ defines below... */
    struct ThreadSpecificData *nextPtr;
    Tcl_ThreadId  threadId;          /* Tcl ID for this thread */
    Tcl_Interp *interp;              /* Main interpreter for this thread */
    int flags;                       /* See the TP_ defines below... */
    struct ThreadSpecificData *nextPtr;	/* List for "thread names" */
				/* List for "thread names" */
    struct ThreadSpecificData *prevPtr;
    struct ThreadSpecificData *prevPtr;	/* List for "thread names" */
				/* List for "thread names" */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * This list is used to list all threads that have interpreters. This is
 * protected by threadMutex.
 */

static ThreadSpecificData *threadList = NULL;
static struct ThreadSpecificData *threadList;

/*
 * The following bit-values are legal for the "flags" field of the
 * ThreadSpecificData structure.
 */

#define TP_Dying		0x001 /* This thread is being canceled */
#define TP_Dying               0x001 /* This thread is being cancelled */

/*
 * An instance of the following structure contains all information that is
 * passed into a new thread when the thread is created using either the
 * "thread create" Tcl command or the ThreadCreate() C function.
 * "thread create" Tcl command or the TclCreateThread() C function.
 */

typedef struct ThreadCtrl {
    const char *script;		/* The Tcl command this thread should
    const char *script;	/* The Tcl command this thread should
				 * execute */
    int flags;			/* Initial value of the "flags" field in the
				 * ThreadSpecificData structure for the new
				 * thread. Might contain TP_Detached or
				 * TP_TclThread. */
    Tcl_Condition condWait;	/* This condition variable is used to
				 * synchronize the parent and child threads.
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
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
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







-










+
+
-
+
+
+


-
+

-
-
+
+

-
+
-
+
+

-
+




-
+

-
-
+
+
-









-
+











-
-
-

-
-
-
-
-
-
-
+
+


+




-
+




-

-
-
+

-
+














+
-
-
+
+
-
+






-
-
-
+
+
+
-


-
-
-
+
+



-
+




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



















-
-
+
+
+















+
-
-
+
+
+
+





-
+










-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-



















-
+

-
+

-
+











-
+








static ThreadEventResult *resultList;

/*
 * This is for simple error handling when a thread script exits badly.
 */

static Tcl_ThreadId mainThreadId;
static Tcl_ThreadId errorThreadId;
static char *errorProcString;

/*
 * Access to the list of threads and to the thread send results is guarded by
 * this mutex.
 */

TCL_DECLARE_MUTEX(threadMutex)

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
static int		ThreadObjCmd(void *clientData,

EXTERN int		TclThread_Init(Tcl_Interp *interp);
EXTERN int		Tcl_ThreadObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ThreadCreate(Tcl_Interp *interp, const char *script,
EXTERN int		TclCreateThread(Tcl_Interp *interp, const char *script,
			    int joinable);
static int		ThreadList(Tcl_Interp *interp);
static int		ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
EXTERN int		TclThreadList(Tcl_Interp *interp);
EXTERN int		TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
			    const char *script, int wait);
static int		ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id,

			    const char *result, int flags);
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

static Tcl_ThreadCreateType	NewTestThread(void *clientData);
Tcl_ThreadCreateType	NewTestThread(ClientData clientData);
static void		ListRemove(ThreadSpecificData *tsdPtr);
static void		ListUpdateInner(ThreadSpecificData *tsdPtr);
static int		ThreadEventProc(Tcl_Event *evPtr, int mask);
static void		ThreadErrorProc(Tcl_Interp *interp);
static void		ThreadFreeProc(void *clientData);
static void		ThreadFreeProc(ClientData clientData);
static int		ThreadDeleteEvent(Tcl_Event *eventPtr,
			    void *clientData);
static void		ThreadExitProc(void *clientData);
			    ClientData clientData);
static void		ThreadExitProc(ClientData clientData);
extern int		Tcltest_Init(Tcl_Interp *interp);

/*
 *----------------------------------------------------------------------
 *
 * TclThread_Init --
 *
 *	Initialize the test thread command.
 *
 * Results:
 *	TCL_OK if the package was properly initialized.
 *      TCL_OK if the package was properly initialized.
 *
 * Side effects:
 *	Add the "testthread" command to the interp.
 *
 *----------------------------------------------------------------------
 */

int
TclThread_Init(
    Tcl_Interp *interp)		/* The current Tcl interpreter */
{
    /*
     * If the main thread Id has not been set, do it now.
     */

    Tcl_MutexLock(&threadMutex);
    if (mainThreadId == 0) {
	mainThreadId = Tcl_GetCurrentThread();
    }
    Tcl_MutexUnlock(&threadMutex);

    Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testthread", Tcl_ThreadObjCmd,
	    (ClientData) NULL, NULL);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * ThreadObjCmd --
 * Tcl_ThreadObjCmd --
 *
 *	This procedure is invoked to process the "testthread" Tcl command. See
 *	the user documentation for details on what it does.
 *
 *	thread cancel ?-unwind? id ?result?
 *	thread create ?-joinable? ?script?
 *	thread send ?-async? id script
 *	thread event
 *	thread send id ?-async? script
 *	thread exit
 *	thread id ?-main?
 *	thread info id
 *	thread names
 *	thread wait
 *	thread errorproc proc
 *	thread join id
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ThreadObjCmd(
int
Tcl_ThreadObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int option;
    static const char *const threadOptions[] = {
	"cancel", "create", "event", "exit", "id",
	"join", "names", "send", "wait", "errorproc",
    static const char *threadOptions[] = {
	"create", "exit", "id", "join", "names",
	"send", "wait", "errorproc", NULL
	NULL
    };
    enum options {
	THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT,
	THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND,
	THREAD_WAIT, THREAD_ERRORPROC
	THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
	THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
	    &option) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Make sure the initial thread is on the list before doing anything.
     */

    if (tsdPtr->interp == NULL) {
	Tcl_MutexLock(&threadMutex);
	tsdPtr->interp = interp;
	ListUpdateInner(tsdPtr);
	Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
	Tcl_MutexUnlock(&threadMutex);
    }

    switch ((enum options)option) {
    case THREAD_CANCEL: {
	Tcl_WideInt id;
	const char *result;
	int flags, arg;

	if ((objc < 3) || (objc > 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?");
	    return TCL_ERROR;
	}
	flags = 0;
	arg = 2;
	if ((objc == 4) || (objc == 5)) {
	    if (strcmp("-unwind", Tcl_GetString(objv[arg])) == 0) {
		flags = TCL_CANCEL_UNWIND;
		arg++;
	    }
	}
	if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
	arg++;
	if (arg < objc) {
	    result = Tcl_GetString(objv[arg]);
	} else {
	    result = NULL;
	}
	return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags);
    }
    case THREAD_CREATE: {
	const char *script;
	int joinable, len;

	if (objc == 2) {
	    /*
	     * Neither joinable nor special script
	     */

	    joinable = 0;
	    script = "testthread wait";		/* Just enter event loop */
	} else if (objc == 3) {
	    /*
	     * Possibly -joinable, then no special script, no joinable, then
	     * its a script.
	     */

	    script = Tcl_GetStringFromObj(objv[2], &len);

	    if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
		    (0 == strncmp(script, "-joinable", len))) {
	    if ((len > 1) &&
		    (script [0] == '-') && (script [1] == 'j') &&
		    (0 == strncmp (script, "-joinable", (size_t) len))) {
		joinable = 1;
		script = "testthread wait";	/* Just enter event loop */
	    } else {
		/*
		 * Remember the script
		 */

		joinable = 0;
	    }
	} else if (objc == 4) {
	    /*
	     * Definitely a script available, but is the flag -joinable?
	     */

	    script = Tcl_GetStringFromObj(objv[2], &len);

	    joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j')
		    && (0 == strncmp(script, "-joinable", len)));
	    joinable = ((len > 1) &&
		    (script [0] == '-') && (script [1] == 'j') &&
		    (0 == strncmp(script, "-joinable", (size_t) len)));

	    script = Tcl_GetString(objv[3]);
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
	    return TCL_ERROR;
	}
	return ThreadCreate(interp, script, joinable);
	return TclCreateThread(interp, script, joinable);
    }
    case THREAD_EXIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	ListRemove(NULL);
	Tcl_ExitThread(0);
	return TCL_OK;
    case THREAD_ID:
	if (objc == 2 || objc == 3) {
	    Tcl_Obj *idObj;

	    /*
	     * Check if they want the main thread id or the current thread id.
	     */

	    if (objc == 2) {
	if (objc == 2) {
		idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
	    } else if (objc == 3
		    && strcmp("-main", Tcl_GetString(objv[2])) == 0) {
		Tcl_MutexLock(&threadMutex);
		idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)mainThreadId);
	    Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t) Tcl_GetCurrentThread());
		Tcl_MutexUnlock(&threadMutex);
	    } else {
		Tcl_WrongNumArgs(interp, 2, objv, NULL);
		return TCL_ERROR;
	    }

	    Tcl_SetObjResult(interp, idObj);
	    return TCL_OK;
	} else {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
    case THREAD_JOIN: {
	Tcl_WideInt id;
	int result, status;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "id");
	    return TCL_ERROR;
	}
	if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) {
	    return TCL_ERROR;
	}

	result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status);
	result = Tcl_JoinThread ((Tcl_ThreadId)(size_t)id, &status);
	if (result == TCL_OK) {
	    Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
	    Tcl_SetIntObj (Tcl_GetObjResult (interp), status);
	} else {
	    char buf[20];
	    char buf [20];

	    sprintf(buf, "%" TCL_LL_MODIFIER "d", id);
	    Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
	}
	return result;
    }
    case THREAD_NAMES:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	return ThreadList(interp);
	return TclThreadList(interp);
    case THREAD_SEND: {
	Tcl_WideInt id;
	const char *script;
	int wait, arg;

	if ((objc != 4) && (objc != 5)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script");
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
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
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







-
+
-
-
-
-
-
-
-
-
-






-
+








-
+


-
+





-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-







-
+













+
-
-
+
+














-
+


-
+







	    arg = 2;
	}
	if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
	arg++;
	script = Tcl_GetString(objv[arg]);
	return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
	return TclThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
    }
    case THREAD_EVENT: {
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
		Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)));
	return TCL_OK;
    }
    case THREAD_ERRORPROC: {
	/*
	 * Arrange for this proc to handle thread death errors.
	 */

	const char *proc;
	char *proc;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "proc");
	    return TCL_ERROR;
	}
	Tcl_MutexLock(&threadMutex);
	errorThreadId = Tcl_GetCurrentThread();
	if (errorProcString) {
	    Tcl_Free(errorProcString);
	    ckfree(errorProcString);
	}
	proc = Tcl_GetString(objv[2]);
	errorProcString = (char *)Tcl_Alloc(strlen(proc) + 1);
	errorProcString = ckalloc(strlen(proc)+1);
	strcpy(errorProcString, proc);
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }
    case THREAD_WAIT:
	if (objc > 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, "");
	    return TCL_ERROR;
	}
	while (1) {
	    /*
	     * If the script has been unwound, bail out immediately. This does
	     * not follow the recommended guidelines for how extensions should
	     * handle the script cancellation functionality because this is
	     * not a "normal" extension. Most extensions do not have a command
	     * that simply enters an infinite Tcl event loop. Normal
	     * extensions should not specify the TCL_CANCEL_UNWIND when
	     * calling Tcl_Canceled to check if the command has been canceled.
	     */

	    if (Tcl_Canceled(interp,
		    TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) {
		break;
	    }
	    (void) Tcl_DoOneEvent(TCL_ALL_EVENTS);
	}

	/*
	 * If we get to this point, we have been canceled by another thread,
	 * which is considered to be an "error".
	 */

	ThreadErrorProc(interp);
	return TCL_OK;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ThreadCreate --
 * TclCreateThread --
 *
 *	This procedure is invoked to create a thread containing an interp to
 *	run a script. This returns after the thread has started executing.
 *
 * Results:
 *	A standard Tcl result, which is the thread ID.
 *
 * Side effects:
 *	Create a thread.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ThreadCreate(
int
TclCreateThread(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *script,		/* Script to execute */
    int joinable)		/* Flag, joinable thread or not */
{
    ThreadCtrl ctrl;
    Tcl_ThreadId id;

    ctrl.script = script;
    ctrl.condWait = NULL;
    ctrl.flags = 0;

    joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;

    Tcl_MutexLock(&threadMutex);
    if (Tcl_CreateThread(&id, NewTestThread, &ctrl,
    if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
	    TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
	Tcl_MutexUnlock(&threadMutex);
	Tcl_AppendResult(interp, "can't create a new thread", NULL);
        Tcl_AppendResult(interp, "can't create a new thread", NULL);
	return TCL_ERROR;
    }

    /*
     * Wait for the thread to start because it is using something on our stack!
     */

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
611
612
613


614
615
616
617
618
619
620
621
622
623
624


625
626
627
628
629
630
631
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
524
525
526
527
528
529
530


531
532
533
534
535
536
537
538
539
540







-
+

-
+





-
+




-
-
+
-







-
-
-













-
+


-
+












-
-
+
+








-
-

+
+







 *	A Tcl script is executed in a new thread.
 *
 *------------------------------------------------------------------------
 */

Tcl_ThreadCreateType
NewTestThread(
    void *clientData)
    ClientData clientData)
{
    ThreadCtrl *ctrlPtr = (ThreadCtrl *)clientData;
    ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int result;
    char *threadEvalScript;

    /*
     * Initialize the interpreter. This should be more general.
     * Initialize the interpreter.  This should be more general.
     */

    tsdPtr->interp = Tcl_CreateInterp();
    result = Tcl_Init(tsdPtr->interp);
    if (result != TCL_OK) {
	ThreadErrorProc(tsdPtr->interp);
    result = TclThread_Init(tsdPtr->interp);
    }

    /*
     * This is part of the test facility. Initialize _ALL_ test commands for
     * use by the new thread.
     */

    result = Tcltest_Init(tsdPtr->interp);
    if (result != TCL_OK) {
	ThreadErrorProc(tsdPtr->interp);
    }

    /*
     * Update the list of threads.
     */

    Tcl_MutexLock(&threadMutex);
    ListUpdateInner(tsdPtr);

    /*
     * We need to keep a pointer to the alloc'ed mem of the script we are
     * eval'ing, for the case that we exit during evaluation
     */

    threadEvalScript = (char *)Tcl_Alloc(strlen(ctrlPtr->script) + 1);
    threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
    strcpy(threadEvalScript, ctrlPtr->script);

    Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);
    Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);

    /*
     * Notify the parent we are alive.
     */

    Tcl_ConditionNotify(&ctrlPtr->condWait);
    Tcl_MutexUnlock(&threadMutex);

    /*
     * Run the script.
     */

    Tcl_Preserve(tsdPtr->interp);
    result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0);
    Tcl_Preserve((ClientData) tsdPtr->interp);
    result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
    if (result != TCL_OK) {
	ThreadErrorProc(tsdPtr->interp);
    }

    /*
     * Clean up.
     */

    Tcl_DeleteInterp(tsdPtr->interp);
    Tcl_Release(tsdPtr->interp);
    ListRemove(tsdPtr);
    Tcl_Release((ClientData) tsdPtr->interp);
    Tcl_DeleteInterp(tsdPtr->interp);
    Tcl_ExitThread(result);

    TCL_THREAD_CREATE_RETURN;
}

/*
 *------------------------------------------------------------------------
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
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







-
+
-

-
+












-
-
+
+







ThreadErrorProc(
    Tcl_Interp *interp)		/* Interp that failed */
{
    Tcl_Channel errChannel;
    const char *errorInfo, *argv[3];
    char *script;
    char buf[TCL_DOUBLE_SPACE+1];

    sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
    sprintf(buf, "%p", Tcl_GetCurrentThread());

    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
    if (errorProcString == NULL) {
	errChannel = Tcl_GetStdChannel(TCL_STDERR);
	Tcl_WriteChars(errChannel, "Error from thread ", -1);
	Tcl_WriteChars(errChannel, buf, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
	Tcl_WriteChars(errChannel, errorInfo, -1);
	Tcl_WriteChars(errChannel, "\n", 1);
    } else {
	argv[0] = errorProcString;
	argv[1] = buf;
	argv[2] = errorInfo;
	script = Tcl_Merge(3, argv);
	ThreadSend(interp, errorThreadId, script, 0);
	Tcl_Free(script);
	TclThreadSend(interp, errorThreadId, script, 0);
	ckfree(script);
    }
}


/*
 *------------------------------------------------------------------------
 *
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
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
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







-






-
+











-
-
+
+



















-
+












-
-
+
+







    } else {
	threadList = tsdPtr->nextPtr;
    }
    if (tsdPtr->nextPtr) {
	tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
    }
    tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
    tsdPtr->interp = NULL;
    Tcl_MutexUnlock(&threadMutex);
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadList --
 * TclThreadList --
 *
 *    Return a list of threads running Tcl interpreters.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */
static int
ThreadList(
int
TclThreadList(
    Tcl_Interp *interp)
{
    ThreadSpecificData *tsdPtr;
    Tcl_Obj *listPtr;

    listPtr = Tcl_NewListObj(0, NULL);
    Tcl_MutexLock(&threadMutex);
    for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
	Tcl_ListObjAppendElement(interp, listPtr,
		Tcl_NewWideIntObj((Tcl_WideInt)(size_t)tsdPtr->threadId));
    }
    Tcl_MutexUnlock(&threadMutex);
    Tcl_SetObjResult(interp, listPtr);
    return TCL_OK;
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadSend --
 * TclThreadSend --
 *
 *    Send a script to another thread.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */

static int
ThreadSend(
int
TclThreadSend(
    Tcl_Interp *interp,		/* The current interpreter. */
    Tcl_ThreadId id,		/* Thread Id of other interpreter. */
    const char *script,		/* The script to evaluate. */
    int wait)			/* If 1, we block for the result. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadEvent *threadEventPtr;
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
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







-
-
+
+






-
-
+
+




-
+








    /*
     * Short circut sends to ourself. Ought to do something with -async, like
     * run in an idle handler.
     */

    if (threadId == Tcl_GetCurrentThread()) {
	Tcl_MutexUnlock(&threadMutex);
	return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
        Tcl_MutexUnlock(&threadMutex);
	return Tcl_GlobalEval(interp, script);
    }

    /*
     * Create the event for its event queue.
     */

    threadEventPtr = (ThreadEvent*)Tcl_Alloc(sizeof(ThreadEvent));
    threadEventPtr->script = (char *)Tcl_Alloc(strlen(script) + 1);
    threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent));
    threadEventPtr->script = ckalloc(strlen(script) + 1);
    strcpy(threadEventPtr->script, script);
    if (!wait) {
	resultPtr = threadEventPtr->resultPtr = NULL;
    } else {
	resultPtr = (ThreadEventResult *)Tcl_Alloc(sizeof(ThreadEventResult));
	resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
	threadEventPtr->resultPtr = resultPtr;

	/*
	 * Initialize the result fields.
	 */

	resultPtr->done = NULL;
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
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







-
+














-
+







    }

    /*
     * Queue the event and poke the other thread's notifier.
     */

    threadEventPtr->event.proc = ThreadEventProc;
    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
    Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr,
	    TCL_QUEUE_TAIL);
    Tcl_ThreadAlert(threadId);

    if (!wait) {
	Tcl_MutexUnlock(&threadMutex);
	return TCL_OK;
    }

    /*
     * Block on the results and then get them.
     */

    Tcl_ResetResult(interp);
    while (resultPtr->result == NULL) {
	Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
        Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
    }

    /*
     * Unlink result from the result list.
     */

    if (resultPtr->prevPtr) {
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
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
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







-
+



-
+


-
+



-
-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+


-
+











-
+

-
-
-
+
+
+
+
+

-
-
+
+





-
+



-
+


-
+



-
+






-
+
















-
+




+


-
+


-
+




















+



-
+


-
+







    resultPtr->prevPtr = NULL;

    Tcl_MutexUnlock(&threadMutex);

    if (resultPtr->code != TCL_OK) {
	if (resultPtr->errorCode) {
	    Tcl_SetErrorCode(interp, resultPtr->errorCode, NULL);
	    Tcl_Free(resultPtr->errorCode);
	    ckfree(resultPtr->errorCode);
	}
	if (resultPtr->errorInfo) {
	    Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
	    Tcl_Free(resultPtr->errorInfo);
	    ckfree(resultPtr->errorInfo);
	}
    }
    Tcl_AppendResult(interp, resultPtr->result, NULL);
    Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
    Tcl_ConditionFinalize(&resultPtr->done);
    code = resultPtr->code;

    Tcl_Free(resultPtr->result);
    Tcl_Free(resultPtr);
    ckfree((char *) resultPtr);

    return code;
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadCancel --
 *
 *    Cancels a script in another thread.
 *
 * Results:
 *    A standard Tcl result.
 *
 * Side effects:
 *    None.
 *
 *------------------------------------------------------------------------
 */

static int
ThreadCancel(
    Tcl_Interp *interp,		/* The current interpreter. */
    Tcl_ThreadId id,		/* Thread Id of other interpreter. */
    const char *result,		/* The result or NULL for default. */
    int flags)			/* Flags for Tcl_CancelEval. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int found;
    Tcl_ThreadId threadId = (Tcl_ThreadId) id;

    /*
     * Verify the thread exists.
     */

    Tcl_MutexLock(&threadMutex);
    found = 0;
    for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
	if (tsdPtr->threadId == threadId) {
	    found = 1;
	    break;
	}
    }
    if (!found) {
	Tcl_MutexUnlock(&threadMutex);
	Tcl_AppendResult(interp, "invalid thread id", NULL);
	return TCL_ERROR;
    }

    /*
     * Since Tcl_CancelEval can be safely called from any thread,
     * we do it now.
     */

    Tcl_MutexUnlock(&threadMutex);
    Tcl_ResetResult(interp);
    return Tcl_CancelEval(tsdPtr->interp,
    	(result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags);
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadEventProc --
 *
 *    Handle the event in the target thread.
 *
 * Results:
 *    Returns 1 to indicate that the event was processed.
 *
 * Side effects:
 *    Fills out the ThreadEventResult struct.
 *
 *------------------------------------------------------------------------
 */

static int
ThreadEventProc(
    Tcl_Event *evPtr,		/* Really ThreadEvent */
    TCL_UNUSED(int) /*mask*/)
    int mask)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadEvent *threadEventPtr = (ThreadEvent *) evPtr;
    ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr;
    ThreadEventResult *resultPtr = threadEventPtr->resultPtr;
    Tcl_Interp *interp = tsdPtr->interp;
    int code;
    const char *result, *errorCode, *errorInfo;

    if (interp == NULL) {
	code = TCL_ERROR;
	result = "no target interp!";
	errorCode = "THREAD";
	errorInfo = "";
    } else {
	Tcl_Preserve(interp);
	Tcl_Preserve((ClientData) interp);
	Tcl_ResetResult(interp);
	Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
	code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL);
	Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
	Tcl_CreateThreadExitHandler(ThreadFreeProc,
		(ClientData) threadEventPtr->script);
	code = Tcl_GlobalEval(interp, threadEventPtr->script);
	Tcl_DeleteThreadExitHandler(ThreadFreeProc,
		(ClientData) threadEventPtr->script);
	if (code != TCL_OK) {
	    errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
	    errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
	    errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
	} else {
	    errorCode = errorInfo = NULL;
	}
	result = Tcl_GetStringResult(interp);
    }
    Tcl_Free(threadEventPtr->script);
    ckfree(threadEventPtr->script);
    if (resultPtr) {
	Tcl_MutexLock(&threadMutex);
	resultPtr->code = code;
	resultPtr->result = (char *)Tcl_Alloc(strlen(result) + 1);
	resultPtr->result = ckalloc(strlen(result) + 1);
	strcpy(resultPtr->result, result);
	if (errorCode != NULL) {
	    resultPtr->errorCode = (char *)Tcl_Alloc(strlen(errorCode) + 1);
	    resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
	    strcpy(resultPtr->errorCode, errorCode);
	}
	if (errorInfo != NULL) {
	    resultPtr->errorInfo = (char *)Tcl_Alloc(strlen(errorInfo) + 1);
	    resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
	    strcpy(resultPtr->errorInfo, errorInfo);
	}
	Tcl_ConditionNotify(&resultPtr->done);
	Tcl_MutexUnlock(&threadMutex);
    }
    if (interp != NULL) {
	Tcl_Release(interp);
	Tcl_Release((ClientData) interp);
    }
    return 1;
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadFreeProc --
 *
 *    This is called from when we are exiting and memory needs
 *    to be freed.
 *
 * Results:
 *    None.
 *
 * Side effects:
 *	Clears up mem specified in clientData
 *	Clears up mem specified in ClientData
 *
 *------------------------------------------------------------------------
 */

     /* ARGSUSED */
static void
ThreadFreeProc(
    void *clientData)
    ClientData clientData)
{
    if (clientData) {
	Tcl_Free(clientData);
	ckfree((char *) clientData);
    }
}

/*
 *------------------------------------------------------------------------
 *
 * ThreadDeleteEvent --
 *
 *    This is called from the ThreadExitProc to delete memory related
 *    to events that we put on the queue.
 *
 * Results:
 *    1 it was our event and we want it removed, 0 otherwise.
 *
 * Side effects:
 *	It cleans up our events in the event queue for this thread.
 *
 *------------------------------------------------------------------------
 */

     /* ARGSUSED */
static int
ThreadDeleteEvent(
    Tcl_Event *eventPtr,	/* Really ThreadEvent */
    TCL_UNUSED(void *))
    ClientData clientData)	/* dummy */
{
    if (eventPtr->proc == ThreadEventProc) {
	Tcl_Free(((ThreadEvent *) eventPtr)->script);
	ckfree((char *) ((ThreadEvent *) eventPtr)->script);
	return 1;
    }

    /*
     * If it was NULL, we were in the middle of servicing the event and it
     * should be removed
     */
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
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







+


-
+

-
+


-
-
-
-
-



-
-
-
-
-
-
-
-

-
+


-
+



















-
+









-
+







 * Side effects:
 *	It unblocks anyone that is waiting on a send to this thread. It cleans
 *	up any events in the event queue for this thread.
 *
 *------------------------------------------------------------------------
 */

     /* ARGSUSED */
static void
ThreadExitProc(
    void *clientData)
    ClientData clientData)
{
    char *threadEvalScript = (char *)clientData;
    char *threadEvalScript = (char *) clientData;
    ThreadEventResult *resultPtr, *nextPtr;
    Tcl_ThreadId self = Tcl_GetCurrentThread();
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->interp != NULL) {
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);

    if (self == errorThreadId) {
	if (errorProcString) {	/* Extra safety */
	    Tcl_Free(errorProcString);
	    errorProcString = NULL;
	}
	errorThreadId = 0;
    }

    if (threadEvalScript) {
	Tcl_Free(threadEvalScript);
	ckfree((char *) threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);
    Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);

    for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
	nextPtr = resultPtr->nextPtr;
	if (resultPtr->srcThreadId == self) {
	    /*
	     * We are going away. By freeing up the result we signal to the
	     * other thread we don't care about the result.
	     */

	    if (resultPtr->prevPtr) {
		resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
	    } else {
		resultList = resultPtr->nextPtr;
	    }
	    if (resultPtr->nextPtr) {
		resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
	    }
	    resultPtr->nextPtr = resultPtr->prevPtr = 0;
	    resultPtr->eventPtr->resultPtr = NULL;
	    Tcl_Free(resultPtr);
	    ckfree((char *) resultPtr);
	} else if (resultPtr->dstThreadId == self) {
	    /*
	     * Dang. The target is going away. Unblock the caller. The result
	     * string must be dynamically allocated because the main thread is
	     * going to call free on it.
	     */

	    const char *msg = "target thread died";

	    resultPtr->result = (char *)Tcl_Alloc(strlen(msg) + 1);
	    resultPtr->result = ckalloc(strlen(msg)+1);
	    strcpy(resultPtr->result, msg);
	    resultPtr->code = TCL_ERROR;
	    Tcl_ConditionNotify(&resultPtr->done);
	}
    }
    Tcl_MutexUnlock(&threadMutex);
}

Changes to generic/tclTimer.c.

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
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







-
+


















-
+







/*
 * There is one of the following structures for each of the handlers declared
 * in a call to Tcl_DoWhenIdle. All of the currently-active handlers are
 * linked together into a list.
 */

typedef struct IdleHandler {
    Tcl_IdleProc *proc;		/* Function to call. */
    Tcl_IdleProc (*proc);	/* Function to call. */
    ClientData clientData;	/* Value to pass to proc. */
    int generation;		/* Used to distinguish older handlers from
				 * recently-created ones. */
    struct IdleHandler *nextPtr;/* Next in list of active handlers. */
} IdleHandler;

/*
 * The timer and idle queues are per-thread because they are associated with
 * the notifier, which is also per-thread.
 *
 * All static variables used in this file are collected into a single instance
 * of the following structure. For multi-threaded implementations, there is
 * one instance of this structure for each thread.
 *
 * Notice that different structures with the same name appear in other files.
 * The structure defined below is used in this file only.
 */

typedef struct {
typedef struct ThreadSpecificData {
    TimerHandler *firstTimerHandlerPtr;	/* First event in queue. */
    int lastTimerId;		/* Timer identifier of most recently created
				 * timer. */
    int timerPending;		/* 1 if a timer event is in the queue. */
    IdleHandler *idleList;	/* First in list of all idle handlers. */
    IdleHandler *lastIdlePtr;	/* Last in list (or NULL for empty list). */
    int idleGeneration;		/* Used to fill in the "generation" fields of
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
123
124
125
126
127
128
129



















130
131
132
133
134
135
136







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#define TCL_TIME_BEFORE(t1, t2) \
    (((t1).sec<(t2).sec) || ((t1).sec==(t2).sec && (t1).usec<(t2).usec))

#define TCL_TIME_DIFF_MS(t1, t2) \
    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
	    ((long)(t1).usec - (long)(t2).usec)/1000)

#define TCL_TIME_DIFF_MS_CEILING(t1, t2) \
    (1000*((Tcl_WideInt)(t1).sec - (Tcl_WideInt)(t2).sec) + \
	    ((long)(t1).usec - (long)(t2).usec + 999)/1000)

/*
 * Sleeps under that number of milliseconds don't get double-checked
 * and are done in exactly one Tcl_Sleep(). This to limit gettimeofday()s.
 */

#define SLEEP_OFFLOAD_GETTIMEOFDAY 20

/*
 * The maximum number of milliseconds for each Tcl_Sleep call in AfterDelay.
 * This is used to limit the maximum lag between interp limit and script
 * cancellation checks.
 */

#define TCL_TIME_MAXIMUM_SLICE 500

/*
 * Prototypes for functions referenced only in this file:
 */

static void		AfterCleanupProc(ClientData clientData,
			    Tcl_Interp *interp);
static int		AfterDelay(Tcl_Interp *interp, Tcl_WideInt ms);
178
179
180
181
182
183
184
185


186
187
188
189
190
191
192
159
160
161
162
163
164
165

166
167
168
169
170
171
172
173
174







-
+
+







 *
 *----------------------------------------------------------------------
 */

static ThreadSpecificData *
InitTimer(void)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);

    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	Tcl_CreateEventSource(TimerSetupProc, TimerCheckProc, NULL);
	Tcl_CreateThreadExitHandler(TimerExitProc, NULL);
    }
    return tsdPtr;
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
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







-
+

-
+
+



-
+




-
+







 *	Removes the timer and idle event sources and remaining events.
 *
 *----------------------------------------------------------------------
 */

static void
TimerExitProc(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Not used. */
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);

    Tcl_DeleteEventSource(TimerSetupProc, TimerCheckProc, NULL);
    if (tsdPtr != NULL) {
	TimerHandler *timerHandlerPtr;
	register TimerHandler *timerHandlerPtr;

	timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	while (timerHandlerPtr != NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	    Tcl_Free(timerHandlerPtr);
	    ckfree((char *) timerHandlerPtr);
	    timerHandlerPtr = tsdPtr->firstTimerHandlerPtr;
	}
    }
}

/*
 *--------------------------------------------------------------
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
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







-
-
+
+

+
-
+





-
+






-
-
+
+








Tcl_TimerToken
TclCreateAbsoluteTimerHandler(
    Tcl_Time *timePtr,
    Tcl_TimerProc *proc,
    ClientData clientData)
{
    TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();
    register TimerHandler *timerHandlerPtr, *tPtr2, *prevPtr;
    ThreadSpecificData *tsdPtr;

    tsdPtr = InitTimer();
    timerHandlerPtr = (TimerHandler *)Tcl_Alloc(sizeof(TimerHandler));
    timerHandlerPtr = (TimerHandler *) ckalloc(sizeof(TimerHandler));

    /*
     * Fill in fields for the event.
     */

    memcpy(&timerHandlerPtr->time, timePtr, sizeof(Tcl_Time));
    memcpy((void *)&timerHandlerPtr->time, (void *)timePtr, sizeof(Tcl_Time));
    timerHandlerPtr->proc = proc;
    timerHandlerPtr->clientData = clientData;
    tsdPtr->lastTimerId++;
    timerHandlerPtr->token = (Tcl_TimerToken) INT2PTR(tsdPtr->lastTimerId);

    /*
     * Add the event to the queue in the correct position (ordered by event
     * firing time).
     * Add the event to the queue in the correct position
     * (ordered by event firing time).
     */

    for (tPtr2 = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL; tPtr2 != NULL;
	    prevPtr = tPtr2, tPtr2 = tPtr2->nextPtr) {
	if (TCL_TIME_BEFORE(timerHandlerPtr->time, tPtr2->time)) {
	    break;
	}
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
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







-
+

















-
+







 */

void
Tcl_DeleteTimerHandler(
    Tcl_TimerToken token)	/* Result previously returned by
				 * Tcl_DeleteTimerHandler. */
{
    TimerHandler *timerHandlerPtr, *prevPtr;
    register TimerHandler *timerHandlerPtr, *prevPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    if (token == NULL) {
	return;
    }

    for (timerHandlerPtr = tsdPtr->firstTimerHandlerPtr, prevPtr = NULL;
	    timerHandlerPtr != NULL; prevPtr = timerHandlerPtr,
	    timerHandlerPtr = timerHandlerPtr->nextPtr) {
	if (timerHandlerPtr->token != token) {
	    continue;
	}
	if (prevPtr == NULL) {
	    tsdPtr->firstTimerHandlerPtr = timerHandlerPtr->nextPtr;
	} else {
	    prevPtr->nextPtr = timerHandlerPtr->nextPtr;
	}
	Tcl_Free(timerHandlerPtr);
	ckfree((char *) timerHandlerPtr);
	return;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+













+







 *	May update the maximum notifier block time.
 *
 *----------------------------------------------------------------------
 */

static void
TimerSetupProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    if (((flags & TCL_IDLE_EVENTS) && tsdPtr->idleList)
	    || ((flags & TCL_TIMER_EVENTS) && tsdPtr->timerPending)) {
	/*
	 * There is an idle handler or a pending timer event, so just poll.
	 */

	blockTime.sec = 0;
	blockTime.usec = 0;

    } else if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
	/*
	 * Compute the timeout for the next timer on the list.
	 */

	Tcl_GetTime(&blockTime);
	blockTime.sec = tsdPtr->firstTimerHandlerPtr->time.sec - blockTime.sec;
452
453
454
455
456
457
458
459

460
461
462
463
464
465
466
437
438
439
440
441
442
443

444
445
446
447
448
449
450
451







-
+







 *	May queue an event and update the maximum notifier block time.
 *
 *----------------------------------------------------------------------
 */

static void
TimerCheckProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    Tcl_Event *timerEvPtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    if ((flags & TCL_TIMER_EVENTS) && tsdPtr->firstTimerHandlerPtr) {
484
485
486
487
488
489
490
491

492
493
494
495
496
497
498
469
470
471
472
473
474
475

476
477
478
479
480
481
482
483







-
+







	/*
	 * If the first timer has expired, stick an event on the queue.
	 */

	if (blockTime.sec == 0 && blockTime.usec == 0 &&
		!tsdPtr->timerPending) {
	    tsdPtr->timerPending = 1;
	    timerEvPtr = (Tcl_Event *)Tcl_Alloc(sizeof(Tcl_Event));
	    timerEvPtr = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
	    timerEvPtr->proc = TimerHandlerEventProc;
	    Tcl_QueueEvent(timerEvPtr, TCL_QUEUE_TAIL);
	}
    }
}

/*
514
515
516
517
518
519
520
521

522
523
524
525
526
527
528
499
500
501
502
503
504
505

506
507
508
509
510
511
512
513







-
+







 *	Whatever the timer handler callback functions do.
 *
 *----------------------------------------------------------------------
 */

static int
TimerHandlerEventProc(
    TCL_UNUSED(Tcl_Event *),
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    TimerHandler *timerHandlerPtr, **nextPtrPtr;
    Tcl_Time time;
    int currentTimerId;
    ThreadSpecificData *tsdPtr = InitTimer();
585
586
587
588
589
590
591
592
593
594



595
596
597
598
599
600
601
570
571
572
573
574
575
576



577
578
579
580
581
582
583
584
585
586







-
-
-
+
+
+







	}

	/*
	 * Remove the handler from the queue before invoking it, to avoid
	 * potential reentrancy problems.
	 */

	*nextPtrPtr = timerHandlerPtr->nextPtr;
	timerHandlerPtr->proc(timerHandlerPtr->clientData);
	Tcl_Free(timerHandlerPtr);
	(*nextPtrPtr) = timerHandlerPtr->nextPtr;
	(*timerHandlerPtr->proc)(timerHandlerPtr->clientData);
	ckfree((char *) timerHandlerPtr);
    }
    TimerSetupProc(NULL, TCL_TIMER_EVENTS);
    return 1;
}

/*
 *--------------------------------------------------------------
617
618
619
620
621
622
623
624

625
626
627
628

629
630
631
632
633
634
635
602
603
604
605
606
607
608

609
610
611
612

613
614
615
616
617
618
619
620







-
+



-
+







 */

void
Tcl_DoWhenIdle(
    Tcl_IdleProc *proc,		/* Function to invoke. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr;
    register IdleHandler *idlePtr;
    Tcl_Time blockTime;
    ThreadSpecificData *tsdPtr = InitTimer();

    idlePtr = (IdleHandler *)Tcl_Alloc(sizeof(IdleHandler));
    idlePtr = (IdleHandler *) ckalloc(sizeof(IdleHandler));
    idlePtr->proc = proc;
    idlePtr->clientData = clientData;
    idlePtr->generation = tsdPtr->idleGeneration;
    idlePtr->nextPtr = NULL;
    if (tsdPtr->lastIdlePtr == NULL) {
	tsdPtr->idleList = idlePtr;
    } else {
661
662
663
664
665
666
667
668

669
670
671
672
673
674
675
676
677

678
679
680
681
682
683
684
646
647
648
649
650
651
652

653
654
655
656
657
658
659
660
661

662
663
664
665
666
667
668
669







-
+








-
+







 */

void
Tcl_CancelIdleCall(
    Tcl_IdleProc *proc,		/* Function that was previously registered. */
    ClientData clientData)	/* Arbitrary value to pass to proc. */
{
    IdleHandler *idlePtr, *prevPtr;
    register IdleHandler *idlePtr, *prevPtr;
    IdleHandler *nextPtr;
    ThreadSpecificData *tsdPtr = InitTimer();

    for (prevPtr = NULL, idlePtr = tsdPtr->idleList; idlePtr != NULL;
	    prevPtr = idlePtr, idlePtr = idlePtr->nextPtr) {
	while ((idlePtr->proc == proc)
		&& (idlePtr->clientData == clientData)) {
	    nextPtr = idlePtr->nextPtr;
	    Tcl_Free(idlePtr);
	    ckfree((char *) idlePtr);
	    idlePtr = nextPtr;
	    if (prevPtr == NULL) {
		tsdPtr->idleList = idlePtr;
	    } else {
		prevPtr->nextPtr = idlePtr;
	    }
	    if (idlePtr == NULL) {
744
745
746
747
748
749
750
751
752


753
754
755
756
757
758
759
729
730
731
732
733
734
735


736
737
738
739
740
741
742
743
744







-
-
+
+







	    ((idlePtr != NULL)
		    && ((oldGeneration - idlePtr->generation) >= 0));
	    idlePtr = tsdPtr->idleList) {
	tsdPtr->idleList = idlePtr->nextPtr;
	if (tsdPtr->idleList == NULL) {
	    tsdPtr->lastIdlePtr = NULL;
	}
	idlePtr->proc(idlePtr->clientData);
	Tcl_Free(idlePtr);
	(*idlePtr->proc)(idlePtr->clientData);
	ckfree((char *) idlePtr);
    }
    if (tsdPtr->idleList) {
	blockTime.sec = 0;
	blockTime.usec = 0;
	Tcl_SetMaxBlockTime(&blockTime);
    }
    return 1;
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
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







+


-
+


-
+

-
+



-
-
-
+
+
+
+


-
+



-
+








-
+

-
+


-
+
+






+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
+




-
+












-
+




-
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_AfterObjCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Unused */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    Tcl_Obj *CONST objv[])	/* Argument objects. */
{
    Tcl_WideInt ms = 0;		/* Number of milliseconds to wait */
    Tcl_WideInt ms;		/* Number of milliseconds to wait */
    Tcl_Time wakeup;
    AfterInfo *afterPtr;
    AfterAssocData *assocPtr;
    size_t length;
    int index = -1;
    static const char *const afterSubCmds[] = {
    int length;
    int index;
    char buf[16 + TCL_INTEGER_SPACE];
    static CONST char *afterSubCmds[] = {
	"cancel", "idle", "info", NULL
    };
    enum afterSubCmdsEnum {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    enum afterSubCmds {AFTER_CANCEL, AFTER_IDLE, AFTER_INFO};
    ThreadSpecificData *tsdPtr = InitTimer();

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

    /*
     * Create the "after" information associated for this interpreter, if it
     * doesn't already exist.
     */

    assocPtr = (AfterAssocData *)Tcl_GetAssocData(interp, "tclAfter", NULL);
    assocPtr = Tcl_GetAssocData(interp, "tclAfter", NULL);
    if (assocPtr == NULL) {
	assocPtr = (AfterAssocData *)Tcl_Alloc(sizeof(AfterAssocData));
	assocPtr = (AfterAssocData *) ckalloc(sizeof(AfterAssocData));
	assocPtr->interp = interp;
	assocPtr->firstAfterPtr = NULL;
	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc, assocPtr);
	Tcl_SetAssocData(interp, "tclAfter", AfterCleanupProc,
		(ClientData) assocPtr);
    }

    /*
     * First lets see if the command was passed a number as the first argument.
     */

    if (objv[1]->typePtr == &tclIntType
#ifndef NO_WIDE_TYPE
	|| objv[1]->typePtr == &tclWideIntType
#endif
    if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
	if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index)
		!= TCL_OK) {
            const char *arg = TclGetString(objv[1]);

	|| objv[1]->typePtr == &tclBignumType
	|| ( Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, 
				 &index) != TCL_OK )) {
	index = -1;
	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "bad argument \"%s\": must be"
                    " cancel, idle, info, or an integer", arg));
	    Tcl_AppendResult(interp, "bad argument \"",
			     Tcl_GetString(objv[1]),
			     "\": must be cancel, idle, info, or an integer",
            Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "argument",
                    arg, NULL);
			     NULL);
	    return TCL_ERROR;
	}
    }

    /*
    /* 
     * At this point, either index = -1 and ms contains the number of ms
     * to wait, or else index is the index of a subcommand.
     */

    switch (index) {
    case -1: {
	if (ms < 0) {
	    ms = 0;
	}
	if (objc == 2) {
	    return AfterDelay(interp, ms);
	}
	afterPtr = (AfterInfo *)Tcl_Alloc(sizeof(AfterInfo));
	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
 	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);

	/*
	 * The variable below is used to generate unique identifiers for after
	 * commands. This id can wrap around, which can potentially cause
	 * problems. However, there are not likely to be problems in practice,
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
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
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







-
-
+
+







-
-
+
+










-
+


-
+


-
+
+













-
+







-
+


-
+












-
+


-
+
-
-
+

-
+



-
-
+
+


-








-
+
-
-
-
+
-

-
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-

+
















-
+

















-
+
-
-
-
+
+






-
+
-
-
-
-
-
-
-

-
+






-
-
+
+
-
-
+
-
-
-
-
+
+
+
+

-
+
-
-
-
-
+
+
-
-
-

+
-
-
+
+

+

-
+
-
-
-
-
-
-
-
-





-







	Tcl_GetTime(&wakeup);
	wakeup.sec += (long)(ms / 1000);
	wakeup.usec += ((long)(ms % 1000)) * 1000;
	if (wakeup.usec > 1000000) {
	    wakeup.sec++;
	    wakeup.usec -= 1000000;
	}
	afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup,
		AfterProc, afterPtr);
	afterPtr->token = TclCreateAbsoluteTimerHandler(&wakeup, AfterProc,
							(ClientData) afterPtr);
	afterPtr->nextPtr = assocPtr->firstAfterPtr;
	assocPtr->firstAfterPtr = afterPtr;
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
	return TCL_OK;
    }
    case AFTER_CANCEL: {
	Tcl_Obj *commandPtr;
	const char *command, *tempCommand;
	size_t tempLength;
	char *command, *tempCommand;
	int tempLength;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "id|command");
	    return TCL_ERROR;
	}
	if (objc == 3) {
	    commandPtr = objv[2];
	} else {
	    commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	command = TclGetStringFromObj(commandPtr, &length);
	command = Tcl_GetStringFromObj(commandPtr, &length);
	for (afterPtr = assocPtr->firstAfterPtr;  afterPtr != NULL;
		afterPtr = afterPtr->nextPtr) {
	    tempCommand = TclGetStringFromObj(afterPtr->commandPtr,
	    tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
		    &tempLength);
	    if ((length == tempLength)
		    && !memcmp(command, tempCommand, length)) {
		    && (memcmp((void*) command, (void*) tempCommand,
			    (unsigned) length) == 0)) {
		break;
	    }
	}
	if (afterPtr == NULL) {
	    afterPtr = GetAfterEvent(assocPtr, commandPtr);
	}
	if (objc != 3) {
	    Tcl_DecrRefCount(commandPtr);
	}
	if (afterPtr != NULL) {
	    if (afterPtr->token != NULL) {
		Tcl_DeleteTimerHandler(afterPtr->token);
	    } else {
		Tcl_CancelIdleCall(AfterProc, afterPtr);
		Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
	    }
	    FreeAfterPtr(afterPtr);
	}
	break;
    }
    case AFTER_IDLE:
	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "script ?script ...?");
	    Tcl_WrongNumArgs(interp, 2, objv, "script script ...");
	    return TCL_ERROR;
	}
	afterPtr = (AfterInfo *)Tcl_Alloc(sizeof(AfterInfo));
	afterPtr = (AfterInfo *) ckalloc((unsigned) (sizeof(AfterInfo)));
	afterPtr->assocPtr = assocPtr;
	if (objc == 3) {
	    afterPtr->commandPtr = objv[2];
	} else {
	    afterPtr->commandPtr = Tcl_ConcatObj(objc-2, objv+2);
	}
	Tcl_IncrRefCount(afterPtr->commandPtr);
	afterPtr->id = tsdPtr->afterId;
	tsdPtr->afterId += 1;
	afterPtr->token = NULL;
	afterPtr->nextPtr = assocPtr->firstAfterPtr;
	assocPtr->firstAfterPtr = afterPtr;
	Tcl_DoWhenIdle(AfterProc, afterPtr);
	Tcl_DoWhenIdle(AfterProc, (ClientData) afterPtr);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("after#%d", afterPtr->id));
	break;
    case AFTER_INFO:
    case AFTER_INFO: {
	if (objc == 2) {
	    Tcl_Obj *resultObj;
	Tcl_Obj *resultListPtr;

	    TclNewObj(resultObj);
	if (objc == 2) {
	    for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
		    afterPtr = afterPtr->nextPtr) {
		if (assocPtr->interp == interp) {
                    Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf(
                            "after#%d", afterPtr->id));
		    sprintf(buf, "after#%d", afterPtr->id);
		    Tcl_AppendElement(interp, buf);
		}
	    }
            Tcl_SetObjResult(interp, resultObj);
	    return TCL_OK;
	}
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?id?");
	    return TCL_ERROR;
	}
	afterPtr = GetAfterEvent(assocPtr, objv[2]);
	if (afterPtr == NULL) {
            const char *eventStr = TclGetString(objv[2]);
	    Tcl_AppendResult(interp, "event \"", TclGetString(objv[2]),

	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "event \"%s\" doesn't exist", eventStr));
		    "\" doesn't exist", NULL);
            Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL);
	    return TCL_ERROR;
	} else {
            Tcl_Obj *resultListPtr;

            TclNewObj(resultListPtr);
            Tcl_ListObjAppendElement(interp, resultListPtr,
	}
	resultListPtr = Tcl_NewObj();
	Tcl_ListObjAppendElement(interp, resultListPtr, afterPtr->commandPtr);
                    afterPtr->commandPtr);
            Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
		    (afterPtr->token == NULL) ? "idle" : "timer", -1));
            Tcl_SetObjResult(interp, resultListPtr);
	Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj(
 		(afterPtr->token == NULL) ? "idle" : "timer", -1));
	Tcl_SetObjResult(interp, resultListPtr);
        }
	break;
    }
    default:
	Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds");
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AfterDelay --
 *
 *	Implements the blocking delay behaviour of [after $time]. Tricky
 *	because it has to take into account any time limit that has been set.
 *
 * Results:
 *	Standard Tcl result code (with error set if an error occurred due to a
 *	time limit being exceeded or being canceled).
 *	time limit being exceeded).
 *
 * Side effects:
 *	May adjust the time limit granularity marker.
 *
 *----------------------------------------------------------------------
 */

static int
AfterDelay(
    Tcl_Interp *interp,
    Tcl_WideInt ms)
{
    Interp *iPtr = (Interp *) interp;

    Tcl_Time endTime, now;
    Tcl_WideInt diff;

    Tcl_GetTime(&now);
    Tcl_GetTime(&endTime);
    endTime = now;
    endTime.sec += (long)(ms / 1000);
    endTime.usec += ((int)(ms % 1000)) * 1000;
    endTime.sec += (long)(ms/1000);
    endTime.usec += ((int)(ms%1000))*1000;
    if (endTime.usec >= 1000000) {
	endTime.sec++;
	endTime.usec -= 1000000;
    }

    do {
	if (Tcl_AsyncReady()) {
	Tcl_GetTime(&now);
	    if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (iPtr->limit.timeEvent != NULL
		&& TCL_TIME_BEFORE(iPtr->limit.time, now)) {
	    && TCL_TIME_BEFORE(iPtr->limit.time, now)) {
	    iPtr->limit.granularityTicker = 0;
	    if (Tcl_LimitCheck(interp) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (iPtr->limit.timeEvent == NULL
		|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
	    diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
	    || TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
	    diff = TCL_TIME_DIFF_MS(endTime, now);
	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
		diff = TCL_TIME_MAXIMUM_SLICE;
#ifndef TCL_WIDE_INT_IS_LONG
	    }
            if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
                diff = 1;
            }
	    if (diff > LONG_MAX) {
		diff = LONG_MAX;
	    }
#endif
	    if (diff > 0) {
		Tcl_Sleep((long) diff);
		Tcl_Sleep((long)diff);
                if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
                    break;
                }
	    } else {
	    }
	} else {
                break;
            }
	} else {
	    diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
#ifndef TCL_WIDE_INT_IS_LONG
	    if (diff > TCL_TIME_MAXIMUM_SLICE) {
		diff = TCL_TIME_MAXIMUM_SLICE;
	    if (diff > LONG_MAX) {
		diff = LONG_MAX;
	    }
#endif
	    if (diff > 0) {
		Tcl_Sleep((int) diff);
		Tcl_Sleep((long)diff);
	    }
	    if (Tcl_AsyncReady()) {
		if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
		    return TCL_ERROR;
		}
	    }
	    if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) {
		return TCL_ERROR;
	    }
	    if (Tcl_LimitCheck(interp) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	Tcl_GetTime(&now);
    } while (TCL_TIME_BEFORE(now, endTime));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1063
1064
1065
1066
1067
1068
1069

1070
1071
1072
1073
1074
1075
1076
1077







-
+








static AfterInfo *
GetAfterEvent(
    AfterAssocData *assocPtr,	/* Points to "after"-related information for
				 * this interpreter. */
    Tcl_Obj *commandPtr)
{
    const char *cmdString;	/* Textual identifier for after event, such as
    char *cmdString;		/* Textual identifier for after event, such as
				 * "after#6". */
    AfterInfo *afterPtr;
    int id;
    char *end;

    cmdString = TclGetString(commandPtr);
    if (strncmp(cmdString, "after#", 6) != 0) {
1147
1148
1149
1150
1151
1152
1153
1154

1155
1156
1157
1158
1159
1160
1161
1110
1111
1112
1113
1114
1115
1116

1117
1118
1119
1120
1121
1122
1123
1124







-
+







 *----------------------------------------------------------------------
 */

static void
AfterProc(
    ClientData clientData)	/* Describes command to execute. */
{
    AfterInfo *afterPtr = (AfterInfo *)clientData;
    AfterInfo *afterPtr = (AfterInfo *) clientData;
    AfterAssocData *assocPtr = afterPtr->assocPtr;
    AfterInfo *prevPtr;
    int result;
    Tcl_Interp *interp;

    /*
     * First remove the callback from our list of callbacks; otherwise someone
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
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







-
+



-
+

-
+






-
+







    }

    /*
     * Execute the callback.
     */

    interp = assocPtr->interp;
    Tcl_Preserve(interp);
    Tcl_Preserve((ClientData) interp);
    result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
	Tcl_BackgroundException(interp, result);
	TclBackgroundException(interp, result);
    }
    Tcl_Release(interp);
    Tcl_Release((ClientData) interp);

    /*
     * Free the memory for the callback.
     */

    Tcl_DecrRefCount(afterPtr->commandPtr);
    Tcl_Free(afterPtr);
    ckfree((char *) afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeAfterPtr --
 *
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
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







-
+



















+




-
+

-
+








-
+


-
+

-
+







-
-


	for (prevPtr = assocPtr->firstAfterPtr; prevPtr->nextPtr != afterPtr;
		prevPtr = prevPtr->nextPtr) {
	    /* Empty loop body. */
	}
	prevPtr->nextPtr = afterPtr->nextPtr;
    }
    Tcl_DecrRefCount(afterPtr->commandPtr);
    Tcl_Free(afterPtr);
    ckfree((char *) afterPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * AfterCleanupProc --
 *
 *	This function is invoked whenever an interpreter is deleted
 *	to cleanup the AssocData for "tclAfter".
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	After commands are removed.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static void
AfterCleanupProc(
    ClientData clientData,	/* Points to AfterAssocData for the
				 * interpreter. */
    TCL_UNUSED(Tcl_Interp *))
    Tcl_Interp *interp)		/* Interpreter that is being deleted. */
{
    AfterAssocData *assocPtr = (AfterAssocData *)clientData;
    AfterAssocData *assocPtr = (AfterAssocData *) clientData;
    AfterInfo *afterPtr;

    while (assocPtr->firstAfterPtr != NULL) {
	afterPtr = assocPtr->firstAfterPtr;
	assocPtr->firstAfterPtr = afterPtr->nextPtr;
	if (afterPtr->token != NULL) {
	    Tcl_DeleteTimerHandler(afterPtr->token);
	} else {
	    Tcl_CancelIdleCall(AfterProc, afterPtr);
	    Tcl_CancelIdleCall(AfterProc, (ClientData) afterPtr);
	}
	Tcl_DecrRefCount(afterPtr->commandPtr);
	Tcl_Free(afterPtr);
	ckfree((char *) afterPtr);
    }
    Tcl_Free(assocPtr);
    ckfree((char *) assocPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to generic/tclTomMath.decls.

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
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







-





-
+


-
+



-
+


-
+


-
+











-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+

-
-
-
+
+
-
+




-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+





-
+

-
-
-
+
+
-
-
-
-
+
+
+
-
+

-
+


-
+


-
+

-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
+

-
+


-
+




-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+

-
-
-
-
-
-
+
+

-
-
+
+

+
+
-
+
-
-
-
+
+
-
-
-
-
+
+
+

-
-
+
+

-
-
+
+

+
+
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+

+
+
-
+
-
-
-
+
+

-
-
-
+
+
-
+

-
+






# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

interface tclTomMath
# hooks {tclTomMathInt}
scspec EXTERN

# Declare each of the functions in the Tcl tommath interface

declare 0 {
    int MP_WUR TclBN_epoch(void)
    int TclBN_epoch(void)
}
declare 1 {
    int MP_WUR TclBN_revision(void)
    int TclBN_revision(void)
}

declare 2 {
    mp_err MP_WUR TclBN_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
    int TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c)
}
declare 3 {
    mp_err MP_WUR TclBN_mp_add_d(const mp_int *a, mp_digit b, mp_int *c)
    int TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c)
}
declare 4 {
    mp_err MP_WUR TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c)
    int TclBN_mp_and(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 5 {
    void TclBN_mp_clamp(mp_int *a)
}
declare 6 {
    void TclBN_mp_clear(mp_int *a)
}
declare 7 {
    void TclBN_mp_clear_multi(mp_int *a, ...)
}
declare 8 {
    mp_ord MP_WUR TclBN_mp_cmp(const mp_int *a, const mp_int *b)
    int TclBN_mp_cmp(const mp_int *a, const mp_int *b)
}
declare 9 {
    mp_ord MP_WUR TclBN_mp_cmp_d(const mp_int *a, mp_digit b)
    int TclBN_mp_cmp_d(const mp_int *a, mp_digit b)
}
declare 10 {
    mp_ord MP_WUR TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b)
    int TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b)
}
declare 11 {
    mp_err MP_WUR TclBN_mp_copy(const mp_int *a, mp_int *b)
    int TclBN_mp_copy(mp_int *a, mp_int *b)
}
declare 12 {
    int MP_WUR TclBN_mp_count_bits(const mp_int *a)
    int TclBN_mp_count_bits(mp_int *a)
}
declare 13 {
    mp_err MP_WUR TclBN_mp_div(const mp_int *a, const mp_int *b, mp_int *q, mp_int *r)
    int TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q, mp_int *r)
}
declare 14 {
    mp_err MP_WUR TclBN_mp_div_d(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
    int TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
}
declare 15 {
    mp_err MP_WUR TclBN_mp_div_2(const mp_int *a, mp_int *q)
    int TclBN_mp_div_2(mp_int *a, mp_int *q)
}
declare 16 {
    mp_err MP_WUR TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r)
    int TclBN_mp_div_2d(mp_int *a, int b, mp_int *q, mp_int *r)
}
# Removed in 9.0
#declare 17 {deprecated {is private function in libtommath}} {
#    mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r)
declare 17 {
    int TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r)
#}
}
declare 18 {
    void TclBN_mp_exch(mp_int *a, mp_int *b)
}
declare 19 {
    mp_err MP_WUR TclBN_mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c)
    int TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c)
}
declare 20 {
    mp_err MP_WUR TclBN_mp_grow(mp_int *a, int size)
    int TclBN_mp_grow(mp_int *a, int size)
}
declare 21 {
    mp_err MP_WUR TclBN_mp_init(mp_int *a)
    int TclBN_mp_init(mp_int *a)
}
declare 22 {
    mp_err MP_WUR TclBN_mp_init_copy(mp_int *a, const mp_int *b)
    int TclBN_mp_init_copy(mp_int *a, mp_int *b)
}
declare 23 {
    mp_err MP_WUR TclBN_mp_init_multi(mp_int *a, ...)
    int TclBN_mp_init_multi(mp_int *a, ...)
}
declare 24 {
    mp_err MP_WUR TclBN_mp_init_set(mp_int *a, mp_digit b)
    int TclBN_mp_init_set(mp_int *a, mp_digit b)
}
declare 25 {
    mp_err MP_WUR TclBN_mp_init_size(mp_int *a, int size)
    int TclBN_mp_init_size(mp_int *a, int size)
}
declare 26 {
    mp_err MP_WUR TclBN_mp_lshd(mp_int *a, int shift)
    int TclBN_mp_lshd(mp_int *a, int shift)
}
declare 27 {
    mp_err MP_WUR TclBN_mp_mod(const mp_int *a, const mp_int *b, mp_int *r)
    int TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r)
}
declare 28 {
    mp_err MP_WUR TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r)
    int TclBN_mp_mod_2d(mp_int *a, int b, mp_int *r)
}
declare 29 {
    mp_err MP_WUR TclBN_mp_mul(const mp_int *a, const mp_int *b, mp_int *p)
    int TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p)
}
declare 30 {
    mp_err MP_WUR TclBN_mp_mul_d(const mp_int *a, mp_digit b, mp_int *p)
    int TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p)
}
declare 31 {
    mp_err MP_WUR TclBN_mp_mul_2(const mp_int *a, mp_int *p)
    int TclBN_mp_mul_2(mp_int *a, mp_int *p)
}
declare 32 {
    mp_err MP_WUR TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p)
    int TclBN_mp_mul_2d(mp_int *a, int d, mp_int *p)
}
declare 33 {
    mp_err MP_WUR TclBN_mp_neg(const mp_int *a, mp_int *b)
    int TclBN_mp_neg(mp_int *a, mp_int *b)
}
declare 34 {
    mp_err MP_WUR TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c)
    int TclBN_mp_or(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 35 {
    mp_err MP_WUR TclBN_mp_radix_size(const mp_int *a, int radix, int *size)
    int TclBN_mp_radix_size(mp_int *a, int radix, int *size)
}
declare 36 {
    mp_err MP_WUR TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
    int TclBN_mp_read_radix(mp_int *a, const char *str, int radix)
}
declare 37 {
    void TclBN_mp_rshd(mp_int *a, int shift)
}
declare 38 {
    mp_err MP_WUR TclBN_mp_shrink(mp_int *a)
    int TclBN_mp_shrink(mp_int *a)
}
# Removed in 9.0
#declare 39 {deprecated {macro calling mp_set_u64}} {
#    void TclBN_mp_set(mp_int *a, unsigned int b)
declare 39 {
    void TclBN_mp_set(mp_int *a, mp_digit b)
#}
# Removed in 9.0
#declare 40 {nostub {is private function in libtommath}} {
#    mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b)
}
declare 40 {
    int TclBN_mp_sqr(mp_int *a, mp_int *b)
#}
}
declare 41 {
    mp_err MP_WUR TclBN_mp_sqrt(const mp_int *a, mp_int *b)
    int TclBN_mp_sqrt(mp_int *a, mp_int *b)
}
declare 42 {
    mp_err MP_WUR TclBN_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
    int TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c)
}
declare 43 {
    mp_err MP_WUR TclBN_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c)
    int TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c)
}
# Removed in 9.0
#declare 44 {
#    mp_err TclBN_mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
declare 44 {
    int TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b)
#}
# Removed in 9.0
#declare 45 {
#    mp_err TclBN_mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b,
#	    unsigned long *outlen)
}
declare 45 {
    int TclBN_mp_to_unsigned_bin_n(mp_int *a, unsigned char *b,
	    unsigned long *outlen)
#}
# Removed in 9.0
#declare 46 {
#    mp_err TclBN_mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
}
declare 46 {
    int TclBN_mp_toradix_n(mp_int *a, char *str, int radix, int maxlen)
#}
}
declare 47 {
    size_t MP_WUR TclBN_mp_ubin_size(const mp_int *a)
    int TclBN_mp_unsigned_bin_size(mp_int *a)
}
declare 48 {
    mp_err MP_WUR TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
    int TclBN_mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
}
declare 49 {
    void TclBN_mp_zero(mp_int *a)
}
# Removed in 9.0
#declare 61 {deprecated {macro calling mp_init_u64}} {
#    mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i)
#}

# internal routines to libtommath - should not be called but must be
# exported to accommodate the "tommath" extension

# Removed in 9.0
#declare 62 {deprecated {macro calling mp_set_u64}} {
#    void TclBN_mp_set_ul(mp_int *a, unsigned long i)
#}
declare 63 {
    int MP_WUR TclBN_mp_cnt_lsb(const mp_int *a)
declare 50 {
    void TclBN_reverse(unsigned char *s, int len)
}
# Removed in 9.0
#declare 64 {deprecated {macro calling mp_init_i64}} {
#    int TclBN_mp_init_l(mp_int *bignum, long initVal)
#}
declare 65 {
    int MP_WUR TclBN_mp_init_i64(mp_int *bignum, int64_t initVal)
declare 51 {
    int TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)
}
declare 66 {
    int MP_WUR TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal)
declare 52 {
    int TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b)
}
declare 53 {
    int TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c)

}
# Removed in 9.0
#declare 67 {
#    mp_err TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
declare 54 {
    int TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b)
#}
# Added in libtommath 1.0.1
declare 68 {
    void TclBN_mp_set_u64(mp_int *a, uint64_t i)
}
declare 55 {
    int TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
}
declare 69 {
    uint64_t MP_WUR TclBN_mp_get_mag_u64(const mp_int *a)
declare 56 {
    int TclBN_mp_toom_sqr(mp_int *a, mp_int *b)
}
declare 70 {
    void TclBN_mp_set_i64(mp_int *a, int64_t i)
declare 57 {
    int TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c)
}
declare 58 {
    int TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs)

}
# Added in libtommath 1.1.0
# No longer in use: replaced by mp_and()
#declare 73 {
#    int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)
declare 59 {
    int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
#}
# No longer in use: replaced by mp_or()
#declare 74 {
#    int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
#}
# No longer in use: replaced by mp_xor()
#declare 75 {
#    int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
#}
declare 76 {
    mp_err MP_WUR TclBN_mp_signed_rsh(const mp_int *a, int b, mp_int *c)
}
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)

}
# Added in libtommath 1.2.0
declare 78 {
    int MP_WUR TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written)
declare 62 {
    int TclBN_mp_set_int(mp_int *a, unsigned long i)
}
# Removed in 9.0
#declare 79 {
#    mp_err MP_WUR TclBN_mp_div_ld(const mp_int *a, mp_digit b, mp_int *q, mp_digit *r)
declare 63 {
    int TclBN_mp_cnt_lsb(mp_int *a)
#}
}
declare 80 {
    int MP_WUR TclBN_mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix)
    void TclUnusedStubEntry(void)
}


# Local Variables:
# mode: tcl
# End:

Changes to generic/tclTomMath.h.




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
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+


/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef BN_TCL_H_
#define BN_TCL_H_
#ifndef BN_H_
#define BN_H_

#include <tclTomMathDecls.h>
#ifndef MODULE_SCOPE
#define MODULE_SCOPE extern
#endif

#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <ctype.h>
#include <limits.h>

#ifndef MIN
   #define MIN(x,y) ((x)<(y)?(x):(y))
#endif

#ifndef MAX
   #define MAX(x,y) ((x)>(y)?(x):(y))
#endif

#ifdef __cplusplus
extern "C" {

/* C++ compilers don't like assigning void * to mp_digit * */
#define  OPT_CAST(x)  (x *)

#else

/* C on the other hand doesn't care */
#define  OPT_CAST(x)

#endif


/* detect 64-bit mode if possible */
#if defined(NEVER)  /* 128-bit ints fail in too many places */
   #if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
      #define MP_64BIT
   #endif
#endif

/* some default configurations.
 *
 * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
 * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
 *
 * At the very least a mp_digit must be able to hold 7 bits
 * [any size beyond that is ok provided it doesn't overflow the data type]
 */
#ifdef MP_8BIT
#ifndef MP_DIGIT_DECLARED
   typedef unsigned char      mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef unsigned short     mp_word;
#elif defined(MP_16BIT)
#ifndef MP_DIGIT_DECLARED
   typedef unsigned short     mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef unsigned long      mp_word;
#elif defined(MP_64BIT)
   /* for GCC only on supported platforms */
#ifndef CRYPT
   typedef unsigned long long ulong64;
   typedef signed long long   long64;
#endif

#ifndef MP_DIGIT_DECLARED
   typedef unsigned long      mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef unsigned long      mp_word __attribute__ ((mode(TI)));

   #define DIGIT_BIT          60
#else
   /* this is the default case, 28-bit digits */

   /* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT
   #if defined(_MSC_VER) || defined(__BORLANDC__)
      typedef unsigned __int64   ulong64;
      typedef signed __int64     long64;
   #else
      typedef unsigned long long ulong64;
      typedef signed long long   long64;
   #endif
#endif

#ifndef MP_DIGIT_DECLARED
   typedef unsigned int      mp_digit;
#define MP_DIGIT_DECLARED
#endif
   typedef ulong64            mp_word;

#ifdef MP_31BIT
   /* this is an extension that uses 31-bit digits */
   #define DIGIT_BIT          31
#else
   /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
   #define DIGIT_BIT          28
   #define MP_28BIT
#endif
#endif

/* define heap macros */
#if 0 /* these are macros in tclTomMathDecls.h */
#ifndef CRYPT
   /* default to libc stuff */
   #ifndef XMALLOC
       #define XMALLOC  malloc
       #define XFREE    free
       #define XREALLOC realloc
       #define XCALLOC  calloc
   #else
      /* prototypes for our heap functions */
      extern void *XMALLOC(size_t n);
      extern void *XREALLOC(void *p, size_t n);
      extern void *XCALLOC(size_t n, size_t s);
      extern void XFREE(void *p);
   #endif
#endif
#endif


/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
   #define DIGIT_BIT     ((int)((CHAR_BIT * sizeof(mp_digit) - 1)))  /* bits per digit */
#endif

#define MP_DIGIT_BIT     DIGIT_BIT
#define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
#define MP_DIGIT_MAX     MP_MASK

typedef int mp_sign;
#define MP_ZPOS       0   /* positive integer */
#define MP_NEG        1   /* negative */
typedef int mp_ord;
#define MP_LT        -1   /* less than */
#define MP_EQ         0   /* equal to */
#define MP_GT         1   /* greater than */
typedef int mp_bool;
#define MP_YES        1   /* yes response */
#define MP_NO         0   /* no response */
typedef int mp_err;
#define MP_OKAY       0   /* ok result */
#define MP_ERR        -1  /* unknown error */
#define MP_MEM        -2  /* out of mem */
#define MP_VAL        -3  /* invalid input */
#define MP_RANGE      MP_VAL
#define MP_ITER       -4  /* Max. iterations reached */

/* Primality generation flags */
#define LTM_PRIME_BBS      0x0001 /* BBS style prime */
#define LTM_PRIME_SAFE     0x0002 /* Safe prime (p-1)/2 == prime */
#define LTM_PRIME_2MSB_ON  0x0008 /* force 2nd MSB to 1 */

/* tunable cutoffs */

#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE int KARATSUBA_MUL_CUTOFF,
           KARATSUBA_SQR_CUTOFF,
           TOOM_MUL_CUTOFF,
           TOOM_SQR_CUTOFF;
#endif

/* define this to use lower memory usage routines (exptmods mostly) */
/* #define MP_LOW_MEM */

/* default precision */
#ifndef MP_PREC
#   ifndef MP_LOW_MEM
#      define MP_PREC 32        /* default digits of precision */
#   elif defined(MP_8BIT)
#      define MP_PREC 16        /* default digits of precision */
#   else
#      define MP_PREC 8         /* default digits of precision */
#   endif
#endif

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define MP_WARRAY               (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))

/*
 * MP_WUR - warn unused result
 * ---------------------------
 *
 * The result of functions annotated with MP_WUR must be
 * checked and cannot be ignored.
 *
 * Most functions in libtommath return an error code.
 * This error code must be checked in order to prevent crashes or invalid
 * results.
 *
 * If you still want to avoid the error checks for quick and dirty programs
 * without robustness guarantees, you can `#define MP_WUR` before including
 * tommath.h, disabling the warnings.
 */
#ifndef MP_WUR
#  if defined(__GNUC__) && __GNUC__ >= 4
#     define MP_WUR __attribute__((warn_unused_result))
#  else
#     define MP_WUR
#  endif
#endif

#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301)
#  define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
#  define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
#  define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
#elif defined(_MSC_VER) && _MSC_VER >= 1500
#  define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
#  define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
#else
#  define MP_DEPRECATED
#  define MP_DEPRECATED_PRAGMA(s)
#endif

#define USED(m)    ((m)->used)
#define DIGIT(m,k) ((m)->dp[(k)])
#define SIGN(m)    ((m)->sign)

/* the infamous mp_int structure */
#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
typedef struct mp_int mp_int;
#endif
struct mp_int {
    int used, alloc, sign;
    mp_digit *dp;
};

/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);


/* error code to char* string */
/*
const char *mp_error_to_string(mp_err code);
*/

/* ---> init and deinit bignum functions <--- */
/* init a bignum */
/*
mp_err mp_init(mp_int *a);
*/

/* free a bignum */
/*
void mp_clear(mp_int *a);
*/

/* init a null terminated series of arguments */
/*
mp_err mp_init_multi(mp_int *mp, ...);
*/

/* clear a null terminated series of arguments */
/*
void mp_clear_multi(mp_int *mp, ...);
*/

/* exchange two ints */
/*
void mp_exch(mp_int *a, mp_int *b);
*/

/* shrink ram required for a bignum */
/*
mp_err mp_shrink(mp_int *a);
*/

/* grow an int to a given size */
/*
mp_err mp_grow(mp_int *a, int size);
*/

/* init to a given number of digits */
/*
mp_err mp_init_size(mp_int *a, int size);
*/

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
#define mp_isodd(a)  (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
#define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)

/* set to zero */
/*
void mp_zero(mp_int *a);
*/

/* set to a digit */
/*
void mp_set(mp_int *a, mp_digit b);
*/

/* set a 32-bit const */
/*
int mp_set_int(mp_int *a, unsigned long b);
*/

/* set a platform dependent unsigned long value */
/*
int mp_set_long(mp_int *a, unsigned long b);
*/

/* set a platform dependent unsigned long long value */
/*
int mp_set_long_long(mp_int *a, unsigned long long b);
*/

/* get a 32-bit value */
unsigned long mp_get_int(mp_int * a);

/* initialize and set a digit */
/*
int mp_init_set (mp_int * a, mp_digit b);
*/

/* initialize and set 32-bit value */
/*
int mp_init_set_int (mp_int * a, unsigned long b);
*/

/* copy, b = a */
/*
int mp_copy(mp_int *a, mp_int *b);
*/
#ifdef MP_NO_STDINT
#   ifdef HAVE_STDINT_H
#	include <stdint.h>
#else
#	include "../compat/stdint.h"
#   endif
#endif
#if defined(TCL_NO_TOMMATH_H)
    typedef size_t mp_digit;
    typedef int mp_sign;
#   define MP_ZPOS       0   /* positive integer */
#   define MP_NEG        1   /* negative */
    typedef int mp_ord;
#   define MP_LT        -1   /* less than */
#   define MP_EQ         0   /* equal to */
#   define MP_GT         1   /* greater than */
    typedef int mp_err;
#   define MP_OKAY       0   /* no error */
#   define MP_ERR        -1  /* unknown error */
#   define MP_MEM        -2  /* out of mem */
#   define MP_VAL        -3  /* invalid input */
#   define MP_ITER       -4  /* maximum iterations reached */
#   define MP_BUF        -5  /* buffer overflow, supplied buffer too small */
#   define MP_WUR            /* nothing */
#   define mp_iszero(a) ((a)->used == 0)
#   define mp_isneg(a)  ((a)->sign != 0)

/* inits and copies, a = b */
/*
int mp_init_copy(mp_int *a, mp_int *b);
*/

/* trim unused digits */
/*
void mp_clamp(mp_int *a);
*/

/* ---> digit manipulation <--- */

/* right shift by "b" digits */
/*
void mp_rshd(mp_int *a, int b);
*/

/* left shift by "b" digits */
/*
int mp_lshd(mp_int *a, int b);
*/

/* c = a / 2**b */
/*
int mp_div_2d(mp_int *a, int b, mp_int *c, mp_int *d);
*/

/* b = a/2 */
/*
int mp_div_2(mp_int *a, mp_int *b);
*/

/* c = a * 2**b */
/*
int mp_mul_2d(mp_int *a, int b, mp_int *c);
*/

/* b = a*2 */
/*
int mp_mul_2(mp_int *a, mp_int *b);
*/

/* c = a mod 2**d */
/*
int mp_mod_2d(mp_int *a, int b, mp_int *c);
*/

/* computes a = 2**b */
/*
int mp_2expt(mp_int *a, int b);
*/

/* Counts the number of lsbs which are zero before the first zero bit */
/*
int mp_cnt_lsb(mp_int *a);
*/

/* I Love Earth! */

/* makes a pseudo-random int of a given size */
/*
int mp_rand(mp_int *a, int digits);
*/

/* ---> binary operations <--- */
/* c = a XOR b  */
/*
int mp_xor(mp_int *a, mp_int *b, mp_int *c);
*/

/* c = a OR b */
/*
int mp_or(mp_int *a, mp_int *b, mp_int *c);
*/

/* c = a AND b */
/*
int mp_and(mp_int *a, mp_int *b, mp_int *c);
*/

/* ---> Basic arithmetic <--- */

/* b = -a */
/*
int mp_neg(mp_int *a, mp_int *b);
*/

/* b = |a| */
/*
int mp_abs(mp_int *a, mp_int *b);
*/

/* compare a to b */
/*
int mp_cmp(mp_int *a, mp_int *b);
*/

/* compare |a| to |b| */
/*
int mp_cmp_mag(mp_int *a, mp_int *b);
*/

/* c = a + b */
/*
int mp_add(mp_int *a, mp_int *b, mp_int *c);
*/

/* c = a - b */
/*
int mp_sub(mp_int *a, mp_int *b, mp_int *c);
*/

/* c = a * b */
/*
int mp_mul(mp_int *a, mp_int *b, mp_int *c);
*/

/* b = a*a  */
/*
int mp_sqr(mp_int *a, mp_int *b);
*/

/* a/b => cb + d == a */
/*
int mp_div(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
*/

/* c = a mod b, 0 <= c < b  */
/*
int mp_mod(mp_int *a, mp_int *b, mp_int *c);
*/

/* ---> single digit functions <--- */

/* compare against a single digit */
/*
int mp_cmp_d(mp_int *a, mp_digit b);
*/

/* c = a + b */
/*
int mp_add_d(mp_int *a, mp_digit b, mp_int *c);
*/

/* c = a - b */
/*
int mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
*/

/* c = a * b */
/*
int mp_mul_d(mp_int *a, mp_digit b, mp_int *c);
*/

/* a/b => cb + d == a */
/*
int mp_div_d(mp_int *a, mp_digit b, mp_int *c, mp_digit *d);
*/

/* a/3 => 3c + d == a */
/*
int mp_div_3(mp_int *a, mp_int *c, mp_digit *d);
*/

/* c = a**b */
/*
int mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
*/

/* c = a mod b, 0 <= c < b  */
/*
int mp_mod_d(mp_int *a, mp_digit b, mp_digit *c);
*/

/* ---> number theory <--- */

/* d = a + b (mod c) */
/*
int mp_addmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
*/

/* d = a - b (mod c) */
/*
int mp_submod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
*/

/* d = a * b (mod c) */
/*
int mp_mulmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
*/

/* c = a * a (mod b) */
/*
int mp_sqrmod(mp_int *a, mp_int *b, mp_int *c);
*/

/* c = 1/a (mod b) */
/*
int mp_invmod(mp_int *a, mp_int *b, mp_int *c);
*/

/* c = (a, b) */
/*
int mp_gcd(mp_int *a, mp_int *b, mp_int *c);
*/

/* produces value such that U1*a + U2*b = U3 */
/*
int mp_exteuclid(mp_int *a, mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);
*/

/* c = [a, b] or (a*b)/(a, b) */
/*
int mp_lcm(mp_int *a, mp_int *b, mp_int *c);
*/

/* finds one of the b'th root of a, such that |c|**b <= |a|
 *
 * returns error if a < 0 and b is even
 */
/*
int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
*/

/* special sqrt algo */
/*
int mp_sqrt(mp_int *arg, mp_int *ret);
*/

/* is number a square? */
/*
int mp_is_square(mp_int *arg, int *ret);
*/

/* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
/*
int mp_jacobi(mp_int *a, mp_int *n, int *c);
*/

/* used to setup the Barrett reduction for a given modulus b */
/*
int mp_reduce_setup(mp_int *a, mp_int *b);
*/

/* Barrett Reduction, computes a (mod b) with a precomputed value c
 *
 * Assumes that 0 < a <= b*b, note if 0 > a > -(b*b) then you can merely
 * compute the reduction as -1 * mp_reduce(mp_abs(a)) [pseudo code].
 */
/*
int mp_reduce(mp_int *a, mp_int *b, mp_int *c);
*/

/* setups the montgomery reduction */
/*
int mp_montgomery_setup(mp_int *a, mp_digit *mp);
*/

/* computes a = B**n mod b without division or multiplication useful for
 * normalizing numbers in a Montgomery system.
 */
/*
int mp_montgomery_calc_normalization(mp_int *a, mp_int *b);
*/

/* computes x/R == x (mod N) via Montgomery Reduction */
/*
int mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
*/

/* returns 1 if a is a valid DR modulus */
/*
int mp_dr_is_modulus(mp_int *a);
*/

/* sets the value of "d" required for mp_dr_reduce */
/*
void mp_dr_setup(mp_int *a, mp_digit *d);
*/

/* reduces a modulo b using the Diminished Radix method */
/*
int mp_dr_reduce(mp_int *a, mp_int *b, mp_digit mp);
*/

/* returns true if a can be reduced with mp_reduce_2k */
/*
int mp_reduce_is_2k(mp_int *a);
*/

/* determines k value for 2k reduction */
/*
int mp_reduce_2k_setup(mp_int *a, mp_digit *d);
*/

/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
/*
int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d);
*/

/* returns true if a can be reduced with mp_reduce_2k_l */
/*
int mp_reduce_is_2k_l(mp_int *a);
*/

/* determines k value for 2k reduction */
/*
int mp_reduce_2k_setup_l(mp_int *a, mp_int *d);
*/

/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
/*
int mp_reduce_2k_l(mp_int *a, mp_int *n, mp_int *d);
*/

/* d = a**b (mod c) */
/*
int mp_exptmod(mp_int *a, mp_int *b, mp_int *c, mp_int *d);
*/

/* ---> Primes <--- */
    /* the infamous mp_int structure */
#   ifndef MP_INT_DECLARED
#	define MP_INT_DECLARED
	typedef struct mp_int mp_int;
#   endif
    struct mp_int {
	int used, alloc;
	mp_sign sign;
	mp_digit *dp;
};

/* number of primes */
#ifdef MP_8BIT
   #define PRIME_SIZE      31
#else
   #define PRIME_SIZE      256
#endif

/* table of first PRIME_SIZE primes */
#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE const mp_digit ltm_prime_tab[];
#endif

/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
/*
int mp_prime_is_divisible(mp_int *a, int *result);
*/

/* performs one Fermat test of "a" using base "b".
 * Sets result to 0 if composite or 1 if probable prime
 */
/*
mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result);
*/

/* performs one Miller-Rabin test of "a" using base "b".
 * Sets result to 0 if composite or 1 if probable prime
 */
/*
mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result);
*/

/* This gives [for a given bit size] the number of trials required
 * such that Miller-Rabin gives a prob of failure lower than 2^-96
 */
/*
int mp_prime_rabin_miller_trials(int size);
*/

/* performs t rounds of Miller-Rabin on "a" using the first
 * t prime bases.  Also performs an initial sieve of trial
 * division.  Determines if "a" is prime with probability
 * of error no more than (1/4)**t.
 *
 * Sets result to 1 if probably prime, 0 otherwise
 */
/*
mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result);
*/

/* finds the next prime after the number "a" using "t" trials
 * of Miller-Rabin.
 *
 * bbs_style = 1 means the prime must be congruent to 3 mod 4
 */
/*
mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style);
*/

/* makes a truly random prime of a given size (bytes),
 * call with bbs = 1 if you want it to be congruent to 3 mod 4
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 * The prime generated will be larger than 2^(8*size).
 */
#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat)

/* makes a truly random prime of a given size (bits),
 *
 * Flags are as follows:
 *
 *   MP_PRIME_BBS      - make prime congruent to 3 mod 4
 *   MP_PRIME_SAFE     - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS)
 *   MP_PRIME_2MSB_ON  - make the 2nd highest bit one
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 */
/*
int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat);
*/

/* ---> radix conversion <--- */
/*
int mp_count_bits(mp_int *a);
*/

/*
int mp_unsigned_bin_size(mp_int *a);
*/
/*
int mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
*/
/*
int mp_to_unsigned_bin(mp_int *a, unsigned char *b);
*/
/*
int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
*/

/*
int mp_signed_bin_size(mp_int *a);
*/
/*
int mp_read_signed_bin(mp_int *a, const unsigned char *b, int c);
*/
/*
int mp_to_signed_bin(mp_int *a,  unsigned char *b);
*/
/*
int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen);
*/

/*
int mp_read_radix(mp_int *a, const char *str, int radix);
*/
/*
int mp_toradix(mp_int *a, char *str, int radix);
*/
/*
int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen);
*/
/*
int mp_radix_size(mp_int *a, int radix, int *size);
*/
#elif !defined(BN_H_) /* If BN_H_ already defined, don't try to include tommath.h again. */
#   include "tommath.h"

/*
int mp_fread(mp_int *a, int radix, FILE *stream);
*/
/*
int mp_fwrite(mp_int *a, int radix, FILE *stream);
*/

#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
#define mp_raw_size(mp)           mp_signed_bin_size(mp)
#define mp_toraw(mp, str)         mp_to_signed_bin((mp), (str))
#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len))
#define mp_mag_size(mp)           mp_unsigned_bin_size(mp)
#define mp_tomag(mp, str)         mp_to_unsigned_bin((mp), (str))

#define mp_tobinary(M, S)  mp_toradix((M), (S), 2)
#define mp_tooctal(M, S)   mp_toradix((M), (S), 8)
#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
#define mp_tohex(M, S)     mp_toradix((M), (S), 16)

/* lowlevel functions, do not call! */
/*
int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
*/
#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
/*
int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
*/
/*
int fast_s_mp_sqr(mp_int *a, mp_int *b);
*/
/*
int s_mp_sqr(mp_int *a, mp_int *b);
*/
/*
int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_karatsuba_sqr(mp_int *a, mp_int *b);
*/
/*
int mp_toom_sqr(mp_int *a, mp_int *b);
*/
/*
int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
*/
/*
int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
*/
/*
int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
*/
/*
int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
*/
/*
int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
*/
/*
void bn_reverse(unsigned char *s, int len);
*/

#if defined(BUILD_tcl) || !defined(_WIN32)
MODULE_SCOPE const char *mp_s_rmap;
#endif
#include "tclTomMathDecls.h"

#ifdef __cplusplus
}
#endif

#endif

Changes to generic/tclTomMathDecls.h.

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
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







-
-
-
-















-
+
-
-

-
+

-
-
+
+
-
-
-
-
+
-
-
-
-

-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
+
-

-

+
+
+
+
+













-
-
+
+

-
+


-
-
-



-


+

-
+
+
+
+




-


+





-
+
-
-
-
-
+
+
-





-
-
-
-
-


-
-
-
-
+
+
+
+
+
+



-
-
-

-
-

-

-
-
-







 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLTOMMATHDECLS
#define _TCLTOMMATHDECLS

#include "tcl.h"
#include <string.h>
#ifndef BN_H_
#include "tclTomMath.h"
#endif

/*
 * Define the version of the Stubs table that's exported for tommath
 */

#define TCLTOMMATH_EPOCH 0
#define TCLTOMMATH_REVISION 0

#define Tcl_TomMath_InitStubs(interp,version) \
    (TclTomMathInitializeStubs((interp),(version),\
                               TCLTOMMATH_EPOCH,TCLTOMMATH_REVISION))

/* Define custom memory allocation for libtommath */

/* MODULE_SCOPE void* TclBNAlloc( size_t ); */
#define TclBNAlloc(s) ((void*)Tcl_Alloc(s))
#define TclBNAlloc(s) ((void*)ckalloc((size_t)(s)))
/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
#define TclBNCalloc(m,s) memset(Tcl_Alloc((size_t)(m)*(size_t)(s)),0,(size_t)(m)*(size_t)(s))
/* MODULE_SCOPE void* TclBNRealloc( void*, size_t ); */
#define TclBNRealloc(x,s) ((void*)Tcl_Realloc((char*)(x),(size_t)(s)))
#define TclBNRealloc(x,s) ((void*)ckrealloc((char*)(x),(size_t)(s)))
/* MODULE_SCOPE void  TclBNFree( void* ); */
#define TclBNFree(x) (Tcl_Free((char*)(x)))

#define TclBNFree(x) (ckfree((char*)(x)))
/* MODULE_SCOPE void* TclBNCalloc( size_t, size_t ); */
#undef MP_MALLOC
#undef MP_CALLOC
#undef MP_REALLOC
#undef MP_FREE
/* unused - no macro */
#define MP_MALLOC(size)                   TclBNAlloc(size)
#define MP_CALLOC(nmemb, size)            TclBNCalloc(nmemb, size)
#define MP_REALLOC(mem, oldsize, newsize) TclBNRealloc(mem, newsize)
#define MP_FREE(mem, size)                TclBNFree(mem)

#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#define XMALLOC(x) TclBNAlloc(x)
#define XFREE(x) TclBNFree(x)
#endif

#define XREALLOC(x,n) TclBNRealloc(x,n)
#ifdef __cplusplus
extern "C" {
#endif
MODULE_SCOPE mp_err TclBN_mp_sqr(const mp_int *a, mp_int *b);
MODULE_SCOPE mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r);
#ifdef __cplusplus
}
#endif

#define XCALLOC(n,x) TclBNCalloc(n,x)
/* Rename the global symbols in libtommath to avoid linkage conflicts */

#ifndef TCL_WITH_EXTERNAL_TOMMATH
#define bn_reverse TclBN_reverse
#define s_mp_reverse TclBN_reverse
#define fast_s_mp_mul_digs TclBN_fast_s_mp_mul_digs
#define s_mp_mul_digs_fast TclBN_fast_s_mp_mul_digs
#define fast_s_mp_sqr TclBN_fast_s_mp_sqr
#define s_mp_sqr_fast TclBN_fast_s_mp_sqr
#define mp_add TclBN_mp_add
#define mp_add_d TclBN_mp_add_d
#define mp_and TclBN_mp_and
#define mp_clamp TclBN_mp_clamp
#define mp_clear TclBN_mp_clear
#define mp_clear_multi TclBN_mp_clear_multi
#define mp_cmp TclBN_mp_cmp
#define mp_cmp_d TclBN_mp_cmp_d
#define mp_cmp_mag TclBN_mp_cmp_mag
#define mp_cnt_lsb TclBN_mp_cnt_lsb
#define mp_copy TclBN_mp_copy
#define mp_count_bits TclBN_mp_count_bits
#define mp_div TclBN_mp_div
#define mp_div_d TclBN_mp_div_d
#define mp_div_2 TclBN_mp_div_2
#define mp_div_2 TclBN_mp_div_2
#define mp_div_2d TclBN_mp_div_2d
#define mp_div_3 TclBN_mp_div_3
#define mp_div_2d TclBN_mp_div_2d
#define mp_div_d TclBN_mp_div_d
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d
#define mp_expt_d_ex TclBN_mp_expt_d_ex
#define mp_expt_u32 TclBN_mp_expt_u32
#define mp_get_mag_u64 TclBN_mp_get_mag_u64
#define mp_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
#define mp_init_i64 TclBN_mp_init_i64
#define mp_init_multi TclBN_mp_init_multi
#define mp_init_set TclBN_mp_init_set
#define mp_init_set_int TclBN_mp_init_set_int
#define mp_init_size TclBN_mp_init_size
#define mp_init_u64 TclBN_mp_init_u64
#define mp_karatsuba_mul TclBN_mp_karatsuba_mul
#define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul
#define mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
#define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
#define mp_lshd TclBN_mp_lshd
#define mp_mod TclBN_mp_mod
#define mp_mod_2d TclBN_mp_mod_2d
#define mp_mul TclBN_mp_mul
#define mp_mul_d TclBN_mp_mul_d
#define mp_mul_2 TclBN_mp_mul_2
#define mp_mul_2d TclBN_mp_mul_2d
#define mp_mul_d TclBN_mp_mul_d
#define mp_neg TclBN_mp_neg
#define mp_or TclBN_mp_or
#define mp_radix_size TclBN_mp_radix_size
#define mp_read_radix TclBN_mp_read_radix
#define mp_rshd TclBN_mp_rshd
#define mp_s_rmap TclBN_mp_s_rmap
#define mp_s_rmap TclBNMpSRmap
#define mp_s_rmap_reverse TclBN_mp_s_rmap_reverse
#define mp_s_rmap_reverse_sz TclBN_mp_s_rmap_reverse_sz
#define mp_set TclBN_s_mp_set
#define mp_set_i64 TclBN_mp_set_i64
#define mp_set TclBN_mp_set
#define mp_set_int TclBN_mp_set_int
#define mp_set_u64 TclBN_mp_set_u64
#define mp_shrink TclBN_mp_shrink
#define mp_sqr TclBN_mp_sqr
#define mp_sqrt TclBN_mp_sqrt
#define mp_sub TclBN_mp_sub
#define mp_sub_d TclBN_mp_sub_d
#define mp_signed_rsh TclBN_mp_signed_rsh
#define mp_tc_and TclBN_mp_and
#define mp_tc_div_2d TclBN_mp_signed_rsh
#define mp_tc_or TclBN_mp_or
#define mp_tc_xor TclBN_mp_xor
#define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
#define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
#define mp_toradix_n TclBN_mp_toradix_n
#define mp_to_radix TclBN_mp_to_radix
#define mp_to_ubin TclBN_mp_to_ubin
#define mp_ubin_size TclBN_mp_ubin_size
#define mp_toom_mul TclBN_mp_toom_mul
#define s_mp_toom_mul TclBN_mp_toom_mul
#define mp_toom_sqr TclBN_mp_toom_sqr
#define s_mp_toom_sqr TclBN_mp_toom_sqr
#define mp_toradix_n TclBN_mp_toradix_n
#define mp_unsigned_bin_size TclBN_mp_unsigned_bin_size
#define mp_xor TclBN_mp_xor
#define mp_zero TclBN_mp_zero
#define s_mp_add TclBN_s_mp_add
#define s_mp_balance_mul TclBN_mp_balance_mul
#define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul
#define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
#define s_mp_mul_digs TclBN_s_mp_mul_digs
#define s_mp_mul_digs_fast TclBN_s_mp_mul_digs_fast
#define s_mp_reverse TclBN_s_mp_reverse
#define s_mp_sqr TclBN_s_mp_sqr
#define s_mp_sqr_fast TclBN_s_mp_sqr_fast
#define s_mp_sub TclBN_s_mp_sub
#define s_mp_toom_mul TclBN_mp_toom_mul
#define s_mp_toom_sqr TclBN_mp_toom_sqr
#endif /* !TCL_WITH_EXTERNAL_TOMMATH */

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
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
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


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


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
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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







+
+

-
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+

-
-
+
+
+
+

-
-
+
+
+
+
+


+
+
+


+
+
+


+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+
+

-
-
+
+
+
+
+

-
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+


+
+
+

-
-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+

-
-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+
+

-
+
-
+
+
+

-
-
+
+
+
+
+


+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+

-
-
+
+
+
+
+


+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+

-
+
-
-
+
-

-
+
-
-
+
-
-
+
-





-
+
-
-

-
+
-
-

+
+

-
+
-
+



-
+

-
-
-
-
-
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
+
+


-
+





-
+





+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
+
+
+
+
+
+


+
+
-
-
+
+
+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


+
+


-
-
+
+
+
+
+
+
+
+
+
+


+
+


+
+


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
-
-
-





-
+
-

-
-
+

+
-
-
+
+
+

-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




extern "C" {
#endif

/*
 * Exported function declarations:
 */

#ifndef TclBN_epoch_TCL_DECLARED
#define TclBN_epoch_TCL_DECLARED
/* 0 */
EXTERN int		TclBN_epoch(void) MP_WUR;
EXTERN int		TclBN_epoch(void);
#endif
#ifndef TclBN_revision_TCL_DECLARED
#define TclBN_revision_TCL_DECLARED
/* 1 */
EXTERN int		TclBN_revision(void) MP_WUR;
EXTERN int		TclBN_revision(void);
#endif
#ifndef TclBN_mp_add_TCL_DECLARED
#define TclBN_mp_add_TCL_DECLARED
/* 2 */
EXTERN mp_err		TclBN_mp_add(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
EXTERN int		TclBN_mp_add(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_mp_add_d_TCL_DECLARED
#define TclBN_mp_add_d_TCL_DECLARED
/* 3 */
EXTERN mp_err		TclBN_mp_add_d(const mp_int *a, mp_digit b,
				mp_int *c) MP_WUR;
EXTERN int		TclBN_mp_add_d(mp_int *a, mp_digit b, mp_int *c);
#endif
#ifndef TclBN_mp_and_TCL_DECLARED
#define TclBN_mp_and_TCL_DECLARED
/* 4 */
EXTERN mp_err		TclBN_mp_and(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
EXTERN int		TclBN_mp_and(CONST mp_int *a, CONST mp_int *b,
				mp_int *c);
#endif
#ifndef TclBN_mp_clamp_TCL_DECLARED
#define TclBN_mp_clamp_TCL_DECLARED
/* 5 */
EXTERN void		TclBN_mp_clamp(mp_int *a);
#endif
#ifndef TclBN_mp_clear_TCL_DECLARED
#define TclBN_mp_clear_TCL_DECLARED
/* 6 */
EXTERN void		TclBN_mp_clear(mp_int *a);
#endif
#ifndef TclBN_mp_clear_multi_TCL_DECLARED
#define TclBN_mp_clear_multi_TCL_DECLARED
/* 7 */
EXTERN void		TclBN_mp_clear_multi(mp_int *a, ...);
#endif
#ifndef TclBN_mp_cmp_TCL_DECLARED
#define TclBN_mp_cmp_TCL_DECLARED
/* 8 */
EXTERN mp_ord		TclBN_mp_cmp(const mp_int *a, const mp_int *b) MP_WUR;
EXTERN int		TclBN_mp_cmp(CONST mp_int *a, CONST mp_int *b);
#endif
#ifndef TclBN_mp_cmp_d_TCL_DECLARED
#define TclBN_mp_cmp_d_TCL_DECLARED
/* 9 */
EXTERN mp_ord		TclBN_mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR;
EXTERN int		TclBN_mp_cmp_d(CONST mp_int *a, mp_digit b);
#endif
#ifndef TclBN_mp_cmp_mag_TCL_DECLARED
#define TclBN_mp_cmp_mag_TCL_DECLARED
/* 10 */
EXTERN mp_ord		TclBN_mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR;
EXTERN int		TclBN_mp_cmp_mag(CONST mp_int *a, CONST mp_int *b);
#endif
#ifndef TclBN_mp_copy_TCL_DECLARED
#define TclBN_mp_copy_TCL_DECLARED
/* 11 */
EXTERN mp_err		TclBN_mp_copy(const mp_int *a, mp_int *b) MP_WUR;
EXTERN int		TclBN_mp_copy(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_count_bits_TCL_DECLARED
#define TclBN_mp_count_bits_TCL_DECLARED
/* 12 */
EXTERN int		TclBN_mp_count_bits(const mp_int *a) MP_WUR;
EXTERN int		TclBN_mp_count_bits(mp_int *a);
#endif
#ifndef TclBN_mp_div_TCL_DECLARED
#define TclBN_mp_div_TCL_DECLARED
/* 13 */
EXTERN mp_err		TclBN_mp_div(const mp_int *a, const mp_int *b,
				mp_int *q, mp_int *r) MP_WUR;
EXTERN int		TclBN_mp_div(mp_int *a, mp_int *b, mp_int *q,
				mp_int *r);
#endif
#ifndef TclBN_mp_div_d_TCL_DECLARED
#define TclBN_mp_div_d_TCL_DECLARED
/* 14 */
EXTERN mp_err		TclBN_mp_div_d(const mp_int *a, mp_digit b,
				mp_int *q, mp_digit *r) MP_WUR;
EXTERN int		TclBN_mp_div_d(mp_int *a, mp_digit b, mp_int *q,
				mp_digit *r);
#endif
#ifndef TclBN_mp_div_2_TCL_DECLARED
#define TclBN_mp_div_2_TCL_DECLARED
/* 15 */
EXTERN mp_err		TclBN_mp_div_2(const mp_int *a, mp_int *q) MP_WUR;
EXTERN int		TclBN_mp_div_2(mp_int *a, mp_int *q);
#endif
#ifndef TclBN_mp_div_2d_TCL_DECLARED
#define TclBN_mp_div_2d_TCL_DECLARED
/* 16 */
EXTERN mp_err		TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q,
				mp_int *r) MP_WUR;
/* Slot 17 is reserved */
EXTERN int		TclBN_mp_div_2d(mp_int *a, int b, mp_int *q,
				mp_int *r);
#endif
#ifndef TclBN_mp_div_3_TCL_DECLARED
#define TclBN_mp_div_3_TCL_DECLARED
/* 17 */
EXTERN int		TclBN_mp_div_3(mp_int *a, mp_int *q, mp_digit *r);
#endif
#ifndef TclBN_mp_exch_TCL_DECLARED
#define TclBN_mp_exch_TCL_DECLARED
/* 18 */
EXTERN void		TclBN_mp_exch(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_expt_d_TCL_DECLARED
#define TclBN_mp_expt_d_TCL_DECLARED
/* 19 */
EXTERN mp_err		TclBN_mp_expt_u32(const mp_int *a, uint32_t b,
				mp_int *c) MP_WUR;
EXTERN int		TclBN_mp_expt_d(mp_int *a, mp_digit b, mp_int *c);
#endif
#ifndef TclBN_mp_grow_TCL_DECLARED
#define TclBN_mp_grow_TCL_DECLARED
/* 20 */
EXTERN mp_err		TclBN_mp_grow(mp_int *a, int size) MP_WUR;
EXTERN int		TclBN_mp_grow(mp_int *a, int size);
#endif
#ifndef TclBN_mp_init_TCL_DECLARED
#define TclBN_mp_init_TCL_DECLARED
/* 21 */
EXTERN mp_err		TclBN_mp_init(mp_int *a) MP_WUR;
EXTERN int		TclBN_mp_init(mp_int *a);
#endif
#ifndef TclBN_mp_init_copy_TCL_DECLARED
#define TclBN_mp_init_copy_TCL_DECLARED
/* 22 */
EXTERN mp_err		TclBN_mp_init_copy(mp_int *a, const mp_int *b) MP_WUR;
EXTERN int		TclBN_mp_init_copy(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_init_multi_TCL_DECLARED
#define TclBN_mp_init_multi_TCL_DECLARED
/* 23 */
EXTERN mp_err		TclBN_mp_init_multi(mp_int *a, ...) MP_WUR;
EXTERN int		TclBN_mp_init_multi(mp_int *a, ...);
#endif
#ifndef TclBN_mp_init_set_TCL_DECLARED
#define TclBN_mp_init_set_TCL_DECLARED
/* 24 */
EXTERN mp_err		TclBN_mp_init_set(mp_int *a, mp_digit b) MP_WUR;
EXTERN int		TclBN_mp_init_set(mp_int *a, mp_digit b);
#endif
#ifndef TclBN_mp_init_size_TCL_DECLARED
#define TclBN_mp_init_size_TCL_DECLARED
/* 25 */
EXTERN mp_err		TclBN_mp_init_size(mp_int *a, int size) MP_WUR;
EXTERN int		TclBN_mp_init_size(mp_int *a, int size);
#endif
#ifndef TclBN_mp_lshd_TCL_DECLARED
#define TclBN_mp_lshd_TCL_DECLARED
/* 26 */
EXTERN mp_err		TclBN_mp_lshd(mp_int *a, int shift) MP_WUR;
EXTERN int		TclBN_mp_lshd(mp_int *a, int shift);
#endif
#ifndef TclBN_mp_mod_TCL_DECLARED
#define TclBN_mp_mod_TCL_DECLARED
/* 27 */
EXTERN mp_err		TclBN_mp_mod(const mp_int *a, const mp_int *b,
				mp_int *r) MP_WUR;
EXTERN int		TclBN_mp_mod(mp_int *a, mp_int *b, mp_int *r);
#endif
#ifndef TclBN_mp_mod_2d_TCL_DECLARED
#define TclBN_mp_mod_2d_TCL_DECLARED
/* 28 */
EXTERN mp_err		TclBN_mp_mod_2d(const mp_int *a, int b, mp_int *r) MP_WUR;
EXTERN int		TclBN_mp_mod_2d(mp_int *a, int b, mp_int *r);
#endif
#ifndef TclBN_mp_mul_TCL_DECLARED
#define TclBN_mp_mul_TCL_DECLARED
/* 29 */
EXTERN mp_err		TclBN_mp_mul(const mp_int *a, const mp_int *b,
				mp_int *p) MP_WUR;
EXTERN int		TclBN_mp_mul(mp_int *a, mp_int *b, mp_int *p);
#endif
#ifndef TclBN_mp_mul_d_TCL_DECLARED
#define TclBN_mp_mul_d_TCL_DECLARED
/* 30 */
EXTERN mp_err		TclBN_mp_mul_d(const mp_int *a, mp_digit b,
				mp_int *p) MP_WUR;
EXTERN int		TclBN_mp_mul_d(mp_int *a, mp_digit b, mp_int *p);
#endif
#ifndef TclBN_mp_mul_2_TCL_DECLARED
#define TclBN_mp_mul_2_TCL_DECLARED
/* 31 */
EXTERN mp_err		TclBN_mp_mul_2(const mp_int *a, mp_int *p) MP_WUR;
EXTERN int		TclBN_mp_mul_2(mp_int *a, mp_int *p);
#endif
#ifndef TclBN_mp_mul_2d_TCL_DECLARED
#define TclBN_mp_mul_2d_TCL_DECLARED
/* 32 */
EXTERN mp_err		TclBN_mp_mul_2d(const mp_int *a, int d, mp_int *p) MP_WUR;
EXTERN int		TclBN_mp_mul_2d(mp_int *a, int d, mp_int *p);
#endif
#ifndef TclBN_mp_neg_TCL_DECLARED
#define TclBN_mp_neg_TCL_DECLARED
/* 33 */
EXTERN mp_err		TclBN_mp_neg(const mp_int *a, mp_int *b) MP_WUR;
EXTERN int		TclBN_mp_neg(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_or_TCL_DECLARED
#define TclBN_mp_or_TCL_DECLARED
/* 34 */
EXTERN mp_err		TclBN_mp_or(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
EXTERN int		TclBN_mp_or(CONST mp_int *a, CONST mp_int *b,
				mp_int *c);
#endif
#ifndef TclBN_mp_radix_size_TCL_DECLARED
#define TclBN_mp_radix_size_TCL_DECLARED
/* 35 */
EXTERN mp_err		TclBN_mp_radix_size(const mp_int *a, int radix,
EXTERN int		TclBN_mp_radix_size(mp_int *a, int radix, int *size);
				int *size) MP_WUR;
#endif
#ifndef TclBN_mp_read_radix_TCL_DECLARED
#define TclBN_mp_read_radix_TCL_DECLARED
/* 36 */
EXTERN mp_err		TclBN_mp_read_radix(mp_int *a, const char *str,
				int radix) MP_WUR;
EXTERN int		TclBN_mp_read_radix(mp_int *a, CONST char *str,
				int radix);
#endif
#ifndef TclBN_mp_rshd_TCL_DECLARED
#define TclBN_mp_rshd_TCL_DECLARED
/* 37 */
EXTERN void		TclBN_mp_rshd(mp_int *a, int shift);
#endif
#ifndef TclBN_mp_shrink_TCL_DECLARED
#define TclBN_mp_shrink_TCL_DECLARED
/* 38 */
EXTERN mp_err		TclBN_mp_shrink(mp_int *a) MP_WUR;
/* Slot 39 is reserved */
/* Slot 40 is reserved */
EXTERN int		TclBN_mp_shrink(mp_int *a);
#endif
#ifndef TclBN_mp_set_TCL_DECLARED
#define TclBN_mp_set_TCL_DECLARED
/* 39 */
EXTERN void		TclBN_mp_set(mp_int *a, mp_digit b);
#endif
#ifndef TclBN_mp_sqr_TCL_DECLARED
#define TclBN_mp_sqr_TCL_DECLARED
/* 40 */
EXTERN int		TclBN_mp_sqr(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_sqrt_TCL_DECLARED
#define TclBN_mp_sqrt_TCL_DECLARED
/* 41 */
EXTERN mp_err		TclBN_mp_sqrt(const mp_int *a, mp_int *b) MP_WUR;
EXTERN int		TclBN_mp_sqrt(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_sub_TCL_DECLARED
#define TclBN_mp_sub_TCL_DECLARED
/* 42 */
EXTERN mp_err		TclBN_mp_sub(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
EXTERN int		TclBN_mp_sub(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_mp_sub_d_TCL_DECLARED
#define TclBN_mp_sub_d_TCL_DECLARED
/* 43 */
EXTERN mp_err		TclBN_mp_sub_d(const mp_int *a, mp_digit b,
				mp_int *c) MP_WUR;
/* Slot 44 is reserved */
/* Slot 45 is reserved */
/* Slot 46 is reserved */
EXTERN int		TclBN_mp_sub_d(mp_int *a, mp_digit b, mp_int *c);
#endif
#ifndef TclBN_mp_to_unsigned_bin_TCL_DECLARED
#define TclBN_mp_to_unsigned_bin_TCL_DECLARED
/* 44 */
EXTERN int		TclBN_mp_to_unsigned_bin(mp_int *a, unsigned char *b);
#endif
#ifndef TclBN_mp_to_unsigned_bin_n_TCL_DECLARED
#define TclBN_mp_to_unsigned_bin_n_TCL_DECLARED
/* 45 */
EXTERN int		TclBN_mp_to_unsigned_bin_n(mp_int *a,
				unsigned char *b, unsigned long *outlen);
#endif
#ifndef TclBN_mp_toradix_n_TCL_DECLARED
#define TclBN_mp_toradix_n_TCL_DECLARED
/* 46 */
EXTERN int		TclBN_mp_toradix_n(mp_int *a, char *str, int radix,
				int maxlen);
#endif
#ifndef TclBN_mp_unsigned_bin_size_TCL_DECLARED
#define TclBN_mp_unsigned_bin_size_TCL_DECLARED
/* 47 */
EXTERN size_t		TclBN_mp_ubin_size(const mp_int *a) MP_WUR;
EXTERN int		TclBN_mp_unsigned_bin_size(mp_int *a);
#endif
#ifndef TclBN_mp_xor_TCL_DECLARED
#define TclBN_mp_xor_TCL_DECLARED
/* 48 */
EXTERN mp_err		TclBN_mp_xor(const mp_int *a, const mp_int *b,
				mp_int *c) MP_WUR;
EXTERN int		TclBN_mp_xor(CONST mp_int *a, CONST mp_int *b,
				mp_int *c);
#endif
#ifndef TclBN_mp_zero_TCL_DECLARED
#define TclBN_mp_zero_TCL_DECLARED
/* 49 */
EXTERN void		TclBN_mp_zero(mp_int *a);
#endif
#ifndef TclBN_reverse_TCL_DECLARED
#define TclBN_reverse_TCL_DECLARED
/* Slot 50 is reserved */
/* Slot 51 is reserved */
/* Slot 52 is reserved */
/* Slot 53 is reserved */
/* Slot 54 is reserved */
/* Slot 55 is reserved */
/* Slot 56 is reserved */
/* Slot 57 is reserved */
/* Slot 58 is reserved */
/* Slot 59 is reserved */
/* Slot 60 is reserved */
/* Slot 61 is reserved */
/* Slot 62 is reserved */
/* 50 */
EXTERN void		TclBN_reverse(unsigned char *s, int len);
#endif
#ifndef TclBN_fast_s_mp_mul_digs_TCL_DECLARED
#define TclBN_fast_s_mp_mul_digs_TCL_DECLARED
/* 51 */
EXTERN int		TclBN_fast_s_mp_mul_digs(mp_int *a, mp_int *b,
				mp_int *c, int digs);
#endif
#ifndef TclBN_fast_s_mp_sqr_TCL_DECLARED
#define TclBN_fast_s_mp_sqr_TCL_DECLARED
/* 52 */
EXTERN int		TclBN_fast_s_mp_sqr(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_karatsuba_mul_TCL_DECLARED
#define TclBN_mp_karatsuba_mul_TCL_DECLARED
/* 53 */
EXTERN int		TclBN_mp_karatsuba_mul(mp_int *a, mp_int *b,
				mp_int *c);
#endif
#ifndef TclBN_mp_karatsuba_sqr_TCL_DECLARED
#define TclBN_mp_karatsuba_sqr_TCL_DECLARED
/* 54 */
EXTERN int		TclBN_mp_karatsuba_sqr(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_mp_toom_mul_TCL_DECLARED
#define TclBN_mp_toom_mul_TCL_DECLARED
/* 55 */
EXTERN int		TclBN_mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_mp_toom_sqr_TCL_DECLARED
#define TclBN_mp_toom_sqr_TCL_DECLARED
/* 56 */
EXTERN int		TclBN_mp_toom_sqr(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_s_mp_add_TCL_DECLARED
#define TclBN_s_mp_add_TCL_DECLARED
/* 57 */
EXTERN int		TclBN_s_mp_add(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_s_mp_mul_digs_TCL_DECLARED
#define TclBN_s_mp_mul_digs_TCL_DECLARED
/* 58 */
EXTERN int		TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
				int digs);
#endif
#ifndef TclBN_s_mp_sqr_TCL_DECLARED
#define TclBN_s_mp_sqr_TCL_DECLARED
/* 59 */
EXTERN int		TclBN_s_mp_sqr(mp_int *a, mp_int *b);
#endif
#ifndef TclBN_s_mp_sub_TCL_DECLARED
#define TclBN_s_mp_sub_TCL_DECLARED
/* 60 */
EXTERN int		TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
#endif
#ifndef TclBN_mp_init_set_int_TCL_DECLARED
#define TclBN_mp_init_set_int_TCL_DECLARED
/* 61 */
EXTERN int		TclBN_mp_init_set_int(mp_int *a, unsigned long i);
#endif
#ifndef TclBN_mp_set_int_TCL_DECLARED
#define TclBN_mp_set_int_TCL_DECLARED
/* 62 */
EXTERN int		TclBN_mp_set_int(mp_int *a, unsigned long i);
#endif
#ifndef TclBN_mp_cnt_lsb_TCL_DECLARED
#define TclBN_mp_cnt_lsb_TCL_DECLARED
/* 63 */
EXTERN int		TclBN_mp_cnt_lsb(const mp_int *a) MP_WUR;
EXTERN int		TclBN_mp_cnt_lsb(mp_int *a);
#endif
/* Slot 64 is reserved */
/* 65 */
/* Slot 65 is reserved */
EXTERN int		TclBN_mp_init_i64(mp_int *bignum, int64_t initVal) MP_WUR;
/* 66 */
/* Slot 66 is reserved */
EXTERN int		TclBN_mp_init_u64(mp_int *bignum, uint64_t initVal) MP_WUR;
/* Slot 67 is reserved */
/* 68 */
/* Slot 68 is reserved */
EXTERN void		TclBN_mp_set_u64(mp_int *a, uint64_t i);
/* 69 */
/* Slot 69 is reserved */
EXTERN uint64_t		TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR;
/* 70 */
/* Slot 70 is reserved */
EXTERN void		TclBN_mp_set_i64(mp_int *a, int64_t i);
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* Slot 74 is reserved */
/* Slot 75 is reserved */
/* 76 */
/* Slot 76 is reserved */
EXTERN mp_err		TclBN_mp_signed_rsh(const mp_int *a, int b,
				mp_int *c) MP_WUR;
/* Slot 77 is reserved */
/* 78 */
/* Slot 78 is reserved */
EXTERN int		TclBN_mp_to_ubin(const mp_int *a, unsigned char *buf,
				size_t maxlen, size_t *written) MP_WUR;
/* Slot 79 is reserved */
#ifndef TclUnusedStubEntry_TCL_DECLARED
#define TclUnusedStubEntry_TCL_DECLARED
/* 80 */
EXTERN int		TclBN_mp_to_radix(const mp_int *a, char *str,
EXTERN void		TclUnusedStubEntry(void);
				size_t maxlen, size_t *written, int radix) MP_WUR;
#endif

typedef struct TclTomMathStubs {
    int magic;
    void *hooks;
    struct TclTomMathStubHooks *hooks;

    int (*tclBN_epoch) (void) MP_WUR; /* 0 */
    int (*tclBN_revision) (void) MP_WUR; /* 1 */
    mp_err (*tclBN_mp_add) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 2 */
    mp_err (*tclBN_mp_add_d) (const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* 3 */
    mp_err (*tclBN_mp_and) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 4 */
    int (*tclBN_epoch) (void); /* 0 */
    int (*tclBN_revision) (void); /* 1 */
    int (*tclBN_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 2 */
    int (*tclBN_mp_add_d) (mp_int *a, mp_digit b, mp_int *c); /* 3 */
    int (*tclBN_mp_and) (CONST mp_int *a, CONST mp_int *b, mp_int *c); /* 4 */
    void (*tclBN_mp_clamp) (mp_int *a); /* 5 */
    void (*tclBN_mp_clear) (mp_int *a); /* 6 */
    void (*tclBN_mp_clear_multi) (mp_int *a, ...); /* 7 */
    mp_ord (*tclBN_mp_cmp) (const mp_int *a, const mp_int *b) MP_WUR; /* 8 */
    mp_ord (*tclBN_mp_cmp_d) (const mp_int *a, mp_digit b) MP_WUR; /* 9 */
    mp_ord (*tclBN_mp_cmp_mag) (const mp_int *a, const mp_int *b) MP_WUR; /* 10 */
    mp_err (*tclBN_mp_copy) (const mp_int *a, mp_int *b) MP_WUR; /* 11 */
    int (*tclBN_mp_count_bits) (const mp_int *a) MP_WUR; /* 12 */
    mp_err (*tclBN_mp_div) (const mp_int *a, const mp_int *b, mp_int *q, mp_int *r) MP_WUR; /* 13 */
    mp_err (*tclBN_mp_div_d) (const mp_int *a, mp_digit b, mp_int *q, mp_digit *r) MP_WUR; /* 14 */
    mp_err (*tclBN_mp_div_2) (const mp_int *a, mp_int *q) MP_WUR; /* 15 */
    mp_err (*tclBN_mp_div_2d) (const mp_int *a, int b, mp_int *q, mp_int *r) MP_WUR; /* 16 */
    void (*reserved17)(void);
    int (*tclBN_mp_cmp) (CONST mp_int *a, CONST mp_int *b); /* 8 */
    int (*tclBN_mp_cmp_d) (CONST mp_int *a, mp_digit b); /* 9 */
    int (*tclBN_mp_cmp_mag) (CONST mp_int *a, CONST mp_int *b); /* 10 */
    int (*tclBN_mp_copy) (mp_int *a, mp_int *b); /* 11 */
    int (*tclBN_mp_count_bits) (mp_int *a); /* 12 */
    int (*tclBN_mp_div) (mp_int *a, mp_int *b, mp_int *q, mp_int *r); /* 13 */
    int (*tclBN_mp_div_d) (mp_int *a, mp_digit b, mp_int *q, mp_digit *r); /* 14 */
    int (*tclBN_mp_div_2) (mp_int *a, mp_int *q); /* 15 */
    int (*tclBN_mp_div_2d) (mp_int *a, int b, mp_int *q, mp_int *r); /* 16 */
    int (*tclBN_mp_div_3) (mp_int *a, mp_int *q, mp_digit *r); /* 17 */
    void (*tclBN_mp_exch) (mp_int *a, mp_int *b); /* 18 */
    mp_err (*tclBN_mp_expt_u32) (const mp_int *a, uint32_t b, mp_int *c) MP_WUR; /* 19 */
    mp_err (*tclBN_mp_grow) (mp_int *a, int size) MP_WUR; /* 20 */
    mp_err (*tclBN_mp_init) (mp_int *a) MP_WUR; /* 21 */
    mp_err (*tclBN_mp_init_copy) (mp_int *a, const mp_int *b) MP_WUR; /* 22 */
    mp_err (*tclBN_mp_init_multi) (mp_int *a, ...) MP_WUR; /* 23 */
    mp_err (*tclBN_mp_init_set) (mp_int *a, mp_digit b) MP_WUR; /* 24 */
    mp_err (*tclBN_mp_init_size) (mp_int *a, int size) MP_WUR; /* 25 */
    mp_err (*tclBN_mp_lshd) (mp_int *a, int shift) MP_WUR; /* 26 */
    mp_err (*tclBN_mp_mod) (const mp_int *a, const mp_int *b, mp_int *r) MP_WUR; /* 27 */
    mp_err (*tclBN_mp_mod_2d) (const mp_int *a, int b, mp_int *r) MP_WUR; /* 28 */
    mp_err (*tclBN_mp_mul) (const mp_int *a, const mp_int *b, mp_int *p) MP_WUR; /* 29 */
    mp_err (*tclBN_mp_mul_d) (const mp_int *a, mp_digit b, mp_int *p) MP_WUR; /* 30 */
    mp_err (*tclBN_mp_mul_2) (const mp_int *a, mp_int *p) MP_WUR; /* 31 */
    mp_err (*tclBN_mp_mul_2d) (const mp_int *a, int d, mp_int *p) MP_WUR; /* 32 */
    mp_err (*tclBN_mp_neg) (const mp_int *a, mp_int *b) MP_WUR; /* 33 */
    mp_err (*tclBN_mp_or) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 34 */
    mp_err (*tclBN_mp_radix_size) (const mp_int *a, int radix, int *size) MP_WUR; /* 35 */
    mp_err (*tclBN_mp_read_radix) (mp_int *a, const char *str, int radix) MP_WUR; /* 36 */
    int (*tclBN_mp_expt_d) (mp_int *a, mp_digit b, mp_int *c); /* 19 */
    int (*tclBN_mp_grow) (mp_int *a, int size); /* 20 */
    int (*tclBN_mp_init) (mp_int *a); /* 21 */
    int (*tclBN_mp_init_copy) (mp_int *a, mp_int *b); /* 22 */
    int (*tclBN_mp_init_multi) (mp_int *a, ...); /* 23 */
    int (*tclBN_mp_init_set) (mp_int *a, mp_digit b); /* 24 */
    int (*tclBN_mp_init_size) (mp_int *a, int size); /* 25 */
    int (*tclBN_mp_lshd) (mp_int *a, int shift); /* 26 */
    int (*tclBN_mp_mod) (mp_int *a, mp_int *b, mp_int *r); /* 27 */
    int (*tclBN_mp_mod_2d) (mp_int *a, int b, mp_int *r); /* 28 */
    int (*tclBN_mp_mul) (mp_int *a, mp_int *b, mp_int *p); /* 29 */
    int (*tclBN_mp_mul_d) (mp_int *a, mp_digit b, mp_int *p); /* 30 */
    int (*tclBN_mp_mul_2) (mp_int *a, mp_int *p); /* 31 */
    int (*tclBN_mp_mul_2d) (mp_int *a, int d, mp_int *p); /* 32 */
    int (*tclBN_mp_neg) (mp_int *a, mp_int *b); /* 33 */
    int (*tclBN_mp_or) (CONST mp_int *a, CONST mp_int *b, mp_int *c); /* 34 */
    int (*tclBN_mp_radix_size) (mp_int *a, int radix, int *size); /* 35 */
    int (*tclBN_mp_read_radix) (mp_int *a, CONST char *str, int radix); /* 36 */
    void (*tclBN_mp_rshd) (mp_int *a, int shift); /* 37 */
    mp_err (*tclBN_mp_shrink) (mp_int *a) MP_WUR; /* 38 */
    void (*reserved39)(void);
    void (*reserved40)(void);
    mp_err (*tclBN_mp_sqrt) (const mp_int *a, mp_int *b) MP_WUR; /* 41 */
    mp_err (*tclBN_mp_sub) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 42 */
    mp_err (*tclBN_mp_sub_d) (const mp_int *a, mp_digit b, mp_int *c) MP_WUR; /* 43 */
    void (*reserved44)(void);
    void (*reserved45)(void);
    void (*reserved46)(void);
    size_t (*tclBN_mp_ubin_size) (const mp_int *a) MP_WUR; /* 47 */
    mp_err (*tclBN_mp_xor) (const mp_int *a, const mp_int *b, mp_int *c) MP_WUR; /* 48 */
    int (*tclBN_mp_shrink) (mp_int *a); /* 38 */
    void (*tclBN_mp_set) (mp_int *a, mp_digit b); /* 39 */
    int (*tclBN_mp_sqr) (mp_int *a, mp_int *b); /* 40 */
    int (*tclBN_mp_sqrt) (mp_int *a, mp_int *b); /* 41 */
    int (*tclBN_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 42 */
    int (*tclBN_mp_sub_d) (mp_int *a, mp_digit b, mp_int *c); /* 43 */
    int (*tclBN_mp_to_unsigned_bin) (mp_int *a, unsigned char *b); /* 44 */
    int (*tclBN_mp_to_unsigned_bin_n) (mp_int *a, unsigned char *b, unsigned long *outlen); /* 45 */
    int (*tclBN_mp_toradix_n) (mp_int *a, char *str, int radix, int maxlen); /* 46 */
    int (*tclBN_mp_unsigned_bin_size) (mp_int *a); /* 47 */
    int (*tclBN_mp_xor) (CONST mp_int *a, CONST mp_int *b, mp_int *c); /* 48 */
    void (*tclBN_mp_zero) (mp_int *a); /* 49 */
    void (*reserved50)(void);
    void (*reserved51)(void);
    void (*reserved52)(void);
    void (*reserved53)(void);
    void (*reserved54)(void);
    void (*reserved55)(void);
    void (*reserved56)(void);
    void (*reserved57)(void);
    void (*reserved58)(void);
    void (*reserved59)(void);
    void (*reserved60)(void);
    void (*reserved61)(void);
    void (*reserved62)(void);
    void (*tclBN_reverse) (unsigned char *s, int len); /* 50 */
    int (*tclBN_fast_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 51 */
    int (*tclBN_fast_s_mp_sqr) (mp_int *a, mp_int *b); /* 52 */
    int (*tclBN_mp_karatsuba_mul) (mp_int *a, mp_int *b, mp_int *c); /* 53 */
    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) (mp_int *a); /* 63 */
    VOID *reserved64;
    VOID *reserved65;
    VOID *reserved66;
    VOID *reserved67;
    VOID *reserved68;
    VOID *reserved69;
    VOID *reserved70;
    int (*tclBN_mp_cnt_lsb) (const mp_int *a) MP_WUR; /* 63 */
    void (*reserved64)(void);
    VOID *reserved71;
    int (*tclBN_mp_init_i64) (mp_int *bignum, int64_t initVal) MP_WUR; /* 65 */
    int (*tclBN_mp_init_u64) (mp_int *bignum, uint64_t initVal) MP_WUR; /* 66 */
    void (*reserved67)(void);
    VOID *reserved72;
    void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */
    uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */
    void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*reserved74)(void);
    void (*reserved75)(void);
    VOID *reserved73;
    VOID *reserved74;
    VOID *reserved75;
    VOID *reserved76;
    VOID *reserved77;
    mp_err (*tclBN_mp_signed_rsh) (const mp_int *a, int b, mp_int *c) MP_WUR; /* 76 */
    void (*reserved77)(void);
    VOID *reserved78;
    int (*tclBN_mp_to_ubin) (const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR; /* 78 */
    void (*reserved79)(void);
    int (*tclBN_mp_to_radix) (const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR; /* 80 */
    VOID *reserved79;
    void (*tclUnusedStubEntry) (void); /* 80 */
} TclTomMathStubs;

extern const TclTomMathStubs *tclTomMathStubsPtr;
extern TclTomMathStubs *tclTomMathStubsPtr;

#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)

/*
 * Inline function declarations:
 */

#ifndef TclBN_epoch
#define TclBN_epoch \
	(tclTomMathStubsPtr->tclBN_epoch) /* 0 */
#endif
#ifndef TclBN_revision
#define TclBN_revision \
	(tclTomMathStubsPtr->tclBN_revision) /* 1 */
#endif
#ifndef TclBN_mp_add
#define TclBN_mp_add \
	(tclTomMathStubsPtr->tclBN_mp_add) /* 2 */
#endif
#ifndef TclBN_mp_add_d
#define TclBN_mp_add_d \
	(tclTomMathStubsPtr->tclBN_mp_add_d) /* 3 */
#endif
#ifndef TclBN_mp_and
#define TclBN_mp_and \
	(tclTomMathStubsPtr->tclBN_mp_and) /* 4 */
#endif
#ifndef TclBN_mp_clamp
#define TclBN_mp_clamp \
	(tclTomMathStubsPtr->tclBN_mp_clamp) /* 5 */
#endif
#ifndef TclBN_mp_clear
#define TclBN_mp_clear \
	(tclTomMathStubsPtr->tclBN_mp_clear) /* 6 */
#endif
#ifndef TclBN_mp_clear_multi
#define TclBN_mp_clear_multi \
	(tclTomMathStubsPtr->tclBN_mp_clear_multi) /* 7 */
#endif
#ifndef TclBN_mp_cmp
#define TclBN_mp_cmp \
	(tclTomMathStubsPtr->tclBN_mp_cmp) /* 8 */
#endif
#ifndef TclBN_mp_cmp_d
#define TclBN_mp_cmp_d \
	(tclTomMathStubsPtr->tclBN_mp_cmp_d) /* 9 */
#endif
#ifndef TclBN_mp_cmp_mag
#define TclBN_mp_cmp_mag \
	(tclTomMathStubsPtr->tclBN_mp_cmp_mag) /* 10 */
#endif
#ifndef TclBN_mp_copy
#define TclBN_mp_copy \
	(tclTomMathStubsPtr->tclBN_mp_copy) /* 11 */
#endif
#ifndef TclBN_mp_count_bits
#define TclBN_mp_count_bits \
	(tclTomMathStubsPtr->tclBN_mp_count_bits) /* 12 */
#endif
#ifndef TclBN_mp_div
#define TclBN_mp_div \
	(tclTomMathStubsPtr->tclBN_mp_div) /* 13 */
#endif
#ifndef TclBN_mp_div_d
#define TclBN_mp_div_d \
	(tclTomMathStubsPtr->tclBN_mp_div_d) /* 14 */
#endif
#ifndef TclBN_mp_div_2
#define TclBN_mp_div_2 \
	(tclTomMathStubsPtr->tclBN_mp_div_2) /* 15 */
#endif
#ifndef TclBN_mp_div_2d
#define TclBN_mp_div_2d \
	(tclTomMathStubsPtr->tclBN_mp_div_2d) /* 16 */
/* Slot 17 is reserved */
#endif
#ifndef TclBN_mp_div_3
#define TclBN_mp_div_3 \
	(tclTomMathStubsPtr->tclBN_mp_div_3) /* 17 */
#endif
#ifndef TclBN_mp_exch
#define TclBN_mp_exch \
	(tclTomMathStubsPtr->tclBN_mp_exch) /* 18 */
#endif
#ifndef TclBN_mp_expt_d
#define TclBN_mp_expt_u32 \
	(tclTomMathStubsPtr->tclBN_mp_expt_u32) /* 19 */
#define TclBN_mp_expt_d \
	(tclTomMathStubsPtr->tclBN_mp_expt_d) /* 19 */
#endif
#ifndef TclBN_mp_grow
#define TclBN_mp_grow \
	(tclTomMathStubsPtr->tclBN_mp_grow) /* 20 */
#endif
#ifndef TclBN_mp_init
#define TclBN_mp_init \
	(tclTomMathStubsPtr->tclBN_mp_init) /* 21 */
#endif
#ifndef TclBN_mp_init_copy
#define TclBN_mp_init_copy \
	(tclTomMathStubsPtr->tclBN_mp_init_copy) /* 22 */
#endif
#ifndef TclBN_mp_init_multi
#define TclBN_mp_init_multi \
	(tclTomMathStubsPtr->tclBN_mp_init_multi) /* 23 */
#endif
#ifndef TclBN_mp_init_set
#define TclBN_mp_init_set \
	(tclTomMathStubsPtr->tclBN_mp_init_set) /* 24 */
#endif
#ifndef TclBN_mp_init_size
#define TclBN_mp_init_size \
	(tclTomMathStubsPtr->tclBN_mp_init_size) /* 25 */
#endif
#ifndef TclBN_mp_lshd
#define TclBN_mp_lshd \
	(tclTomMathStubsPtr->tclBN_mp_lshd) /* 26 */
#endif
#ifndef TclBN_mp_mod
#define TclBN_mp_mod \
	(tclTomMathStubsPtr->tclBN_mp_mod) /* 27 */
#endif
#ifndef TclBN_mp_mod_2d
#define TclBN_mp_mod_2d \
	(tclTomMathStubsPtr->tclBN_mp_mod_2d) /* 28 */
#endif
#ifndef TclBN_mp_mul
#define TclBN_mp_mul \
	(tclTomMathStubsPtr->tclBN_mp_mul) /* 29 */
#endif
#ifndef TclBN_mp_mul_d
#define TclBN_mp_mul_d \
	(tclTomMathStubsPtr->tclBN_mp_mul_d) /* 30 */
#endif
#ifndef TclBN_mp_mul_2
#define TclBN_mp_mul_2 \
	(tclTomMathStubsPtr->tclBN_mp_mul_2) /* 31 */
#endif
#ifndef TclBN_mp_mul_2d
#define TclBN_mp_mul_2d \
	(tclTomMathStubsPtr->tclBN_mp_mul_2d) /* 32 */
#endif
#ifndef TclBN_mp_neg
#define TclBN_mp_neg \
	(tclTomMathStubsPtr->tclBN_mp_neg) /* 33 */
#endif
#ifndef TclBN_mp_or
#define TclBN_mp_or \
	(tclTomMathStubsPtr->tclBN_mp_or) /* 34 */
#endif
#ifndef TclBN_mp_radix_size
#define TclBN_mp_radix_size \
	(tclTomMathStubsPtr->tclBN_mp_radix_size) /* 35 */
#endif
#ifndef TclBN_mp_read_radix
#define TclBN_mp_read_radix \
	(tclTomMathStubsPtr->tclBN_mp_read_radix) /* 36 */
#endif
#ifndef TclBN_mp_rshd
#define TclBN_mp_rshd \
	(tclTomMathStubsPtr->tclBN_mp_rshd) /* 37 */
#endif
#ifndef TclBN_mp_shrink
#define TclBN_mp_shrink \
	(tclTomMathStubsPtr->tclBN_mp_shrink) /* 38 */
/* Slot 39 is reserved */
/* Slot 40 is reserved */
#endif
#ifndef TclBN_mp_set
#define TclBN_mp_set \
	(tclTomMathStubsPtr->tclBN_mp_set) /* 39 */
#endif
#ifndef TclBN_mp_sqr
#define TclBN_mp_sqr \
	(tclTomMathStubsPtr->tclBN_mp_sqr) /* 40 */
#endif
#ifndef TclBN_mp_sqrt
#define TclBN_mp_sqrt \
	(tclTomMathStubsPtr->tclBN_mp_sqrt) /* 41 */
#endif
#ifndef TclBN_mp_sub
#define TclBN_mp_sub \
	(tclTomMathStubsPtr->tclBN_mp_sub) /* 42 */
#endif
#ifndef TclBN_mp_sub_d
#define TclBN_mp_sub_d \
	(tclTomMathStubsPtr->tclBN_mp_sub_d) /* 43 */
/* Slot 44 is reserved */
/* Slot 45 is reserved */
/* Slot 46 is reserved */
#define TclBN_mp_ubin_size \
	(tclTomMathStubsPtr->tclBN_mp_ubin_size) /* 47 */
#endif
#ifndef TclBN_mp_to_unsigned_bin
#define TclBN_mp_to_unsigned_bin \
	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin) /* 44 */
#endif
#ifndef TclBN_mp_to_unsigned_bin_n
#define TclBN_mp_to_unsigned_bin_n \
	(tclTomMathStubsPtr->tclBN_mp_to_unsigned_bin_n) /* 45 */
#endif
#ifndef TclBN_mp_toradix_n
#define TclBN_mp_toradix_n \
	(tclTomMathStubsPtr->tclBN_mp_toradix_n) /* 46 */
#endif
#ifndef TclBN_mp_unsigned_bin_size
#define TclBN_mp_unsigned_bin_size \
	(tclTomMathStubsPtr->tclBN_mp_unsigned_bin_size) /* 47 */
#endif
#ifndef TclBN_mp_xor
#define TclBN_mp_xor \
	(tclTomMathStubsPtr->tclBN_mp_xor) /* 48 */
#endif
#ifndef TclBN_mp_zero
#define TclBN_mp_zero \
	(tclTomMathStubsPtr->tclBN_mp_zero) /* 49 */
/* Slot 50 is reserved */
/* Slot 51 is reserved */
/* Slot 52 is reserved */
/* Slot 53 is reserved */
/* Slot 54 is reserved */
/* Slot 55 is reserved */
/* Slot 56 is reserved */
/* Slot 57 is reserved */
/* Slot 58 is reserved */
/* Slot 59 is reserved */
/* Slot 60 is reserved */
/* Slot 61 is reserved */
/* Slot 62 is reserved */
#define TclBN_mp_cnt_lsb \
	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
#endif
#ifndef TclBN_reverse
#define TclBN_reverse \
	(tclTomMathStubsPtr->tclBN_reverse) /* 50 */
#endif
#ifndef TclBN_fast_s_mp_mul_digs
#define TclBN_fast_s_mp_mul_digs \
	(tclTomMathStubsPtr->tclBN_fast_s_mp_mul_digs) /* 51 */
#endif
#ifndef TclBN_fast_s_mp_sqr
#define TclBN_fast_s_mp_sqr \
	(tclTomMathStubsPtr->tclBN_fast_s_mp_sqr) /* 52 */
#endif
#ifndef TclBN_mp_karatsuba_mul
#define TclBN_mp_karatsuba_mul \
	(tclTomMathStubsPtr->tclBN_mp_karatsuba_mul) /* 53 */
#endif
#ifndef TclBN_mp_karatsuba_sqr
#define TclBN_mp_karatsuba_sqr \
	(tclTomMathStubsPtr->tclBN_mp_karatsuba_sqr) /* 54 */
#endif
#ifndef TclBN_mp_toom_mul
#define TclBN_mp_toom_mul \
	(tclTomMathStubsPtr->tclBN_mp_toom_mul) /* 55 */
/* Slot 64 is reserved */
#define TclBN_mp_init_i64 \
	(tclTomMathStubsPtr->tclBN_mp_init_i64) /* 65 */
#define TclBN_mp_init_u64 \
	(tclTomMathStubsPtr->tclBN_mp_init_u64) /* 66 */
#endif
#ifndef TclBN_mp_toom_sqr
#define TclBN_mp_toom_sqr \
	(tclTomMathStubsPtr->tclBN_mp_toom_sqr) /* 56 */
#endif
#ifndef TclBN_s_mp_add
#define TclBN_s_mp_add \
	(tclTomMathStubsPtr->tclBN_s_mp_add) /* 57 */
#endif
#ifndef TclBN_s_mp_mul_digs
#define TclBN_s_mp_mul_digs \
	(tclTomMathStubsPtr->tclBN_s_mp_mul_digs) /* 58 */
#endif
#ifndef TclBN_s_mp_sqr
#define TclBN_s_mp_sqr \
	(tclTomMathStubsPtr->tclBN_s_mp_sqr) /* 59 */
#endif
#ifndef TclBN_s_mp_sub
#define TclBN_s_mp_sub \
	(tclTomMathStubsPtr->tclBN_s_mp_sub) /* 60 */
#endif
#ifndef TclBN_mp_init_set_int
#define TclBN_mp_init_set_int \
	(tclTomMathStubsPtr->tclBN_mp_init_set_int) /* 61 */
#endif
#ifndef TclBN_mp_set_int
#define TclBN_mp_set_int \
	(tclTomMathStubsPtr->tclBN_mp_set_int) /* 62 */
#endif
#ifndef TclBN_mp_cnt_lsb
#define TclBN_mp_cnt_lsb \
	(tclTomMathStubsPtr->tclBN_mp_cnt_lsb) /* 63 */
#endif
/* Slot 64 is reserved */
/* Slot 65 is reserved */
/* Slot 66 is reserved */
/* Slot 67 is reserved */
#define TclBN_mp_set_u64 \
	(tclTomMathStubsPtr->tclBN_mp_set_u64) /* 68 */
#define TclBN_mp_get_mag_u64 \
/* Slot 68 is reserved */
/* Slot 69 is reserved */
/* Slot 70 is reserved */
	(tclTomMathStubsPtr->tclBN_mp_get_mag_u64) /* 69 */
#define TclBN_mp_set_i64 \
	(tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */
/* Slot 71 is reserved */
/* Slot 72 is reserved */
/* Slot 73 is reserved */
/* Slot 74 is reserved */
/* Slot 75 is reserved */
#define TclBN_mp_signed_rsh \
/* Slot 76 is reserved */
	(tclTomMathStubsPtr->tclBN_mp_signed_rsh) /* 76 */
/* Slot 77 is reserved */
#define TclBN_mp_to_ubin \
	(tclTomMathStubsPtr->tclBN_mp_to_ubin) /* 78 */
/* Slot 78 is reserved */
/* Slot 79 is reserved */
#ifndef TclUnusedStubEntry
#define TclBN_mp_to_radix \
	(tclTomMathStubsPtr->tclBN_mp_to_radix) /* 80 */
#define TclUnusedStubEntry \
	(tclTomMathStubsPtr->tclUnusedStubEntry) /* 80 */
#endif

#endif /* defined(USE_TCL_STUBS) */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef mp_get_ll
#define mp_get_ll(a) ((long long)mp_get_i64(a))
#undef mp_set_ll
#define mp_set_ll(a,b) mp_set_i64(a,b)
#undef mp_init_ll
#define mp_init_ll(a,b) mp_init_i64(a,b)
#undef mp_get_ull
#define mp_get_ull(a) ((unsigned long long)mp_get_i64(a))
#undef mp_set_ull
#define mp_set_ull(a,b) mp_set_u64(a,b)
#undef mp_init_ull
#define mp_init_ull(a,b) mp_init_u64(a,b)
#undef mp_set
#define mp_set(a,b) mp_set_i64((a),(int32_t)(b))
#define mp_set_i32(a,b) mp_set_i64((a),(int32_t)(b))
#define mp_set_l(a,b) mp_set_i64((a),(long)(b))
#define mp_set_u32(a,b) mp_set_u64((a),(uint32_t)(b))
#define mp_set_ul(a,b) mp_set_u64((a),(unsigned long)(b))
#define mp_init_i32(a,b) mp_init_i64((a),(int32_t)(b))
#define mp_init_l(a,b) mp_init_i64((a),(long)(b))
#define mp_init_u32(a,b) mp_init_u64((a),(uint32_t)(b))
#define mp_init_ul(a,b) mp_init_u64((a),(unsigned long)(b))
#undef mp_iseven
#undef mp_isodd
#define mp_iseven(a) (!mp_isodd(a))
#define mp_isodd(a)  (((a)->used != 0) && (((a)->dp[0] & 1) != 0))
#undef mp_sqr
#define mp_sqr(a,b) mp_mul(a,a,b)

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLINTDECLS */

Changes to generic/tclTomMathInt.h.

1
2
3

1
2
-


#include "tclInt.h"
#include "tclTomMath.h"
#include "tommath_class.h"

Changes to generic/tclTomMathInterface.c.

9
10
11
12
13
14
15
16


17
18

19
20
21
22
23
24
25
9
10
11
12
13
14
15

16
17
18

19
20
21
22
23
24
25
26







-
+
+

-
+







 * Copyright (c) 2005 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 "tclTomMath.h"
#include "tommath.h"
#include <limits.h>

MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
extern TclTomMathStubs tclTomMathStubs;

/*
 *----------------------------------------------------------------------
 *
 * TclTommath_Init --
 *
 *	Initializes the TclTomMath 'package', which exists as a
33
34
35
36
37
38
39
40

41

42
43
44
45

46
47
48
49
50
51
52
34
35
36
37
38
39
40

41

42
43
44
45

46
47
48
49
50
51
52
53







-
+
-
+



-
+







 *	Installs the stub table for tommath.
 *
 *----------------------------------------------------------------------
 */

int
TclTommath_Init(
    Tcl_Interp *interp)		/* Tcl interpreter */
    Tcl_Interp* interp		/* Tcl interpreter */
{
) {
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
	    &tclTomMathStubs) != TCL_OK) {
			 (ClientData)&tclTomMathStubs) != TCL_OK) {
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
85
86
87
88
89
90
91



















































































































































































































92
93
94
95
96
97
98
99
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








 */

int
TclBN_revision(void)
{
    return TCLTOMMATH_REVISION;
}
#if 0

/*
 *----------------------------------------------------------------------
 *
 * TclBNAlloc --
 *
 *	Allocate memory for libtommath.
 *
 * Results:
 *	Returns a pointer to the allocated block.
 *
 * This procedure is a wrapper around Tcl_Alloc, needed because of a
 * mismatched type signature between Tcl_Alloc and malloc.
 *
 *----------------------------------------------------------------------
 */

extern void *
TclBNAlloc(
    size_t x)
{
    return (void *) ckalloc((unsigned int) x);
}

/*
 *----------------------------------------------------------------------
 *
 * TclBNRealloc --
 *
 *	Change the size of an allocated block of memory in libtommath
 *
 * Results:
 *	Returns a pointer to the allocated block.
 *
 * This procedure is a wrapper around Tcl_Realloc, needed because of a
 * mismatched type signature between Tcl_Realloc and realloc.
 *
 *----------------------------------------------------------------------
 */

void *
TclBNRealloc(
    void *p,
    size_t s)
{
    return (void *) ckrealloc((char *) p, (unsigned int) s);
}

/*
 *----------------------------------------------------------------------
 *
 * TclBNFree --
 *
 *	Free allocated memory in libtommath.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory is freed.
 *
 * This function is simply a wrapper around Tcl_Free, needed in libtommath
 * because of a type mismatch between free and Tcl_Free.
 *
 *----------------------------------------------------------------------
 */

extern void
TclBNFree(
    void *p)
{
    ckfree((char *) p);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclBNInitBignumFromLong --
 *
 *	Allocate and initialize a 'bignum' from a native 'long'.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The 'bignum' is constructed.
 *
 *----------------------------------------------------------------------
 */

extern void
TclBNInitBignumFromLong(
    mp_int *a,
    long initVal)
{
    int status;
    unsigned long v;
    mp_digit* p;

    /*
     * Allocate enough memory to hold the largest possible long
     */

    status = mp_init_size(a,
	    (CHAR_BIT * sizeof(long) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT);
    if (status != MP_OKAY) {
	Tcl_Panic("initialization failure in TclBNInitBignumFromLong");
    }

    /*
     * Convert arg to sign and magnitude.
     */

    if (initVal < 0) {
	a->sign = MP_NEG;
	v = -initVal;
    } else {
	a->sign = MP_ZPOS;
	v = initVal;
    }

    /*
     * Store the magnitude in the bignum.
     */

    p = a->dp;
    while (v) {
	*p++ = (mp_digit) (v & MP_MASK);
	v >>= MP_DIGIT_BIT;
    }
    a->used = p - a->dp;
}

/*
 *----------------------------------------------------------------------
 *
 * TclBNInitBignumFromWideInt --
 *
 *	Allocate and initialize a 'bignum' from a Tcl_WideInt
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The 'bignum' is constructed.
 *
 *----------------------------------------------------------------------
 */

extern void
TclBNInitBignumFromWideInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideInt v)		/* Initial value */
{
    if (v < (Tcl_WideInt)0) {
	TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v));
	mp_neg(a, a);
    } else {
	TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclBNInitBignumFromWideUInt --
 *
 *	Allocate and initialize a 'bignum' from a Tcl_WideUInt
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The 'bignum' is constructed.
 *
 *----------------------------------------------------------------------
 */

extern void
TclBNInitBignumFromWideUInt(
    mp_int *a,			/* Bignum to initialize */
    Tcl_WideUInt v)		/* Initial value */
{
    int status;
    mp_digit *p;

    /*
     * Allocate enough memory to hold the largest possible Tcl_WideUInt.
     */

    status = mp_init_size(a,
	    (CHAR_BIT * sizeof(Tcl_WideUInt) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT);
    if (status != MP_OKAY) {
	Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt");
    }

    a->sign = MP_ZPOS;

    /*
     * Store the magnitude in the bignum.
     */

    p = a->dp;
    while (v) {
	*p++ = (mp_digit) (v & MP_MASK);
	v >>= MP_DIGIT_BIT;
    }
    a->used = p - a->dp;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclTomMathStubLib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclTomMathStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * 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 "tclTomMath.h"

MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;

const TclTomMathStubs *tclTomMathStubsPtr = NULL;


/*
 *----------------------------------------------------------------------
 *
 * TclTomMathInitStubs --
 *
 *	Initializes the Stubs table for Tcl's subset of libtommath
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * This procedure should not be called directly, but rather through
 * the TclTomMath_InitStubs macro, to insure that the Stubs table
 * matches the header files used in compilation.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE const char *
TclTomMathInitializeStubs(
    Tcl_Interp *interp,		/* Tcl interpreter */
    const char *version,	/* Tcl version needed */
    int epoch,			/* Stubs table epoch from the header files */
    int revision)		/* Stubs table revision number from the
				 * header files */
{
    int exact = 0;
    const char *packageName = "tcl::tommath";
    const char *errMsg = NULL;
    TclTomMathStubs *stubsPtr = NULL;
    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
	    packageName, version, exact, &stubsPtr);

    if (actualVersion == NULL) {
	return NULL;
    }
    if (stubsPtr == NULL) {
	errMsg = "missing stub table pointer";
    } else if (stubsPtr->tclBN_epoch() != epoch) {
	errMsg = "epoch number mismatch";
    } else if (stubsPtr->tclBN_revision() != revision) {
	errMsg = "requires a later revision";
    } else {
	tclTomMathStubsPtr = stubsPtr;
	return actualVersion;
    }
    tclStubsPtr->tcl_ResetResult(interp);
    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
	    " (requested version ", version, ", actual version ",
	    actualVersion, "): ", errMsg, NULL);
    return NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclTrace.c.

18
19
20
21
22
23
24
25

26
27
28
29


30
31
32
33
34
35
36
18
19
20
21
22
23
24

25
26
27


28
29
30
31
32
33
34
35
36







-
+


-
-
+
+







 * Structures used to hold information about variable traces:
 */

typedef struct {
    int flags;			/* Operations for which Tcl command is to be
				 * invoked. */
    size_t length;		/* Number of non-NUL chars. in command. */
    char command[1];		/* Space for Tcl command to invoke. Actual
    char command[4];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
				 * structure, so that it can be larger than 4
				 * bytes. */
} TraceVarInfo;

typedef struct {
    VarTrace traceInfo;
    TraceVarInfo traceCmdInfo;
} CombinedTraceVarInfo;

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
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







-
+



-
+


-
-
+
+


















+
-
+







				 * traces, store the level at which the step
				 * trace was invoked */
    char *startCmd;		/* Used for bookkeeping with step execution
				 * traces, store the command name which
				 * invoked step trace */
    int curFlags;		/* Trace flags for the current command */
    int curCode;		/* Return code for the current command */
    size_t refCount;		/* Used to ensure this structure is not
    int refCount;		/* Used to ensure this structure is not
				 * deleted too early. Keeps track of how many
				 * pieces of code have a pointer to this
				 * structure. */
    char command[1];		/* Space for Tcl command to invoke. Actual
    char command[4];		/* Space for Tcl command to invoke. Actual
				 * size will be as large as necessary to hold
				 * command. This field must be the last in the
				 * structure, so that it can be larger than 1
				 * byte. */
				 * structure, so that it can be larger than 4
				 * bytes. */
} TraceCommandInfo;

/*
 * Used by command execution traces. Note that we assume in the code that
 * TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and that
 * TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC.
 *
 * TCL_TRACE_ENTER_DURING_EXEC  - Trace each command inside the command
 *				  currently being traced, before execution.
 * TCL_TRACE_LEAVE_DURING_EXEC  - Trace each command inside the command
 *				  currently being traced, after execution.
 * TCL_TRACE_ANY_EXEC		- OR'd combination of all EXEC flags.
 * TCL_TRACE_EXEC_IN_PROGRESS   - The callback function on this trace is
 *				  currently executing. Therefore we don't let
 *				  further traces execute.
 * TCL_TRACE_EXEC_DIRECT	- This execution trace is triggered directly
 *				  by the command being traced, not because of
 *				  an internal trace.
 * The flags 'TCL_TRACE_DESTROYED' and 'TCL_INTERP_DESTROYED' may also be used
 * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces.
 * in command execution traces.
 */

#define TCL_TRACE_ENTER_DURING_EXEC	4
#define TCL_TRACE_LEAVE_DURING_EXEC	8
#define TCL_TRACE_ANY_EXEC		15
#define TCL_TRACE_EXEC_IN_PROGRESS	0x10
#define TCL_TRACE_EXEC_DIRECT		0x20
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
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







-
+













-
+














-
+






-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















+


-
+






-
-
+


-
+







-
+







-
+



-
-
+
+


-
+











-
+






-
+







/*
 * Each subcommand has a number of 'types' to which it can apply. Currently
 * 'execution', 'command' and 'variable' are the only types supported. These
 * three arrays MUST be kept in sync! In the future we may provide an API to
 * add to the list of supported trace types.
 */

static const char *const traceTypeOptions[] = {
static const char *traceTypeOptions[] = {
    "execution", "command", "variable", NULL
};
static Tcl_TraceTypeObjCmd *const traceSubCmds[] = {
    TraceExecutionObjCmd,
    TraceCommandObjCmd,
    TraceVariableObjCmd
};

/*
 * Declarations for local functions to this file:
 */

static int		CallTraceFunction(Tcl_Interp *interp, Trace *tracePtr,
			    Command *cmdPtr, const char *command, size_t numChars,
			    Command *cmdPtr, const char *command, int numChars,
			    int objc, Tcl_Obj *const objv[]);
static char *		TraceVarProc(ClientData clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		TraceCommandProc(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
static Tcl_CmdObjTraceProc TraceExecutionProc;
static int		StringTraceProc(ClientData clientData,
			    Tcl_Interp *interp, int level,
			    const char *command, Tcl_Command commandInfo,
			    int objc, Tcl_Obj *const objv[]);
static void		StringTraceDeleteProc(ClientData clientData);
static void		DisposeTraceResult(int flags, char *result);
static int		TraceVarEx(Tcl_Interp *interp, const char *part1,
			    const char *part2, VarTrace *tracePtr);
			    const char *part2, register VarTrace *tracePtr);

/*
 * The following structure holds the client data for string-based
 * trace procs
 */

typedef struct {
typedef struct StringTraceData {
    ClientData clientData;	/* Client data from Tcl_CreateTrace */
    Tcl_CmdTraceProc *proc;	/* Trace function from Tcl_CreateTrace */
} StringTraceData;

/*
 * Convenience macros for iterating over the list of traces. Note that each of
 * these *must* be treated as a command, and *must* have a block following it.
 */

#define FOREACH_VAR_TRACE(interp, name, clientData) \
    (clientData) = NULL; \
    while (((clientData) = Tcl_VarTraceInfo2((interp), (name), NULL, \
	    0, TraceVarProc, (clientData))) != NULL)

#define FOREACH_COMMAND_TRACE(interp, name, clientData) \
    (clientData) = NULL; \
    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \
	    TraceCommandProc, clientData)) != NULL)

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TraceObjCmd --
 *
 *	This function is invoked to process the "trace" Tcl command. See the
 *	user documentation for details on what it does.
 *
 *	Standard syntax as of Tcl 8.4 is:
 *	    trace {add|info|remove} {command|variable} name ops cmd
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_TraceObjCmd(
    TCL_UNUSED(void *),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int optionIndex;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    const char *name;
    const char *flagOps, *p;
    char *name, *flagOps, *p;
#endif
    /* Main sub commands to 'trace' */
    static const char *const traceOptions[] = {
    static const char *traceOptions[] = {
	"add", "info", "remove",
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	"variable", "vdelete", "vinfo",
#endif
	NULL
    };
    /* 'OLD' options are pre-Tcl-8.4 style */
    enum traceOptionsEnum {
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE,
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	TRACE_OLD_VARIABLE, TRACE_OLD_VDELETE, TRACE_OLD_VINFO
#endif
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions, "option", 0,
	    &optionIndex) != TCL_OK) {
    if (Tcl_GetIndexFromObj(interp, objv[1], traceOptions,
		"option", 0, &optionIndex) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum traceOptionsEnum) optionIndex) {
    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	/*
	 * All sub commands of trace add/remove must take at least one more
	 * argument. Beyond that we let the subcommand itself control the
	 * argument structure.
	 */

	int typeIndex;

	if (objc < 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "type ?arg ...?");
	    Tcl_WrongNumArgs(interp, 2, objv, "type ?arg arg ...?");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option",
		0, &typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
	return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
    }
    case TRACE_INFO: {
	/*
	 * All sub commands of trace info must take exactly two more arguments
	 * which name the type of thing being traced and the name of the thing
	 * being traced.
	 */
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
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







-
+








-
+
-






-
+

-
+







	    Tcl_WrongNumArgs(interp, 2, objv, "type name");
	    return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(interp, objv[2], traceTypeOptions, "option",
		0, &typeIndex) != TCL_OK) {
	    return TCL_ERROR;
	}
	return traceSubCmds[typeIndex](interp, optionIndex, objc, objv);
	return (traceSubCmds[typeIndex])(interp, optionIndex, objc, objv);
	break;
    }

#ifndef TCL_REMOVE_OBSOLETE_TRACES
    case TRACE_OLD_VARIABLE:
    case TRACE_OLD_VDELETE: {
	Tcl_Obj *copyObjv[6];
	Tcl_Obj *opsList;
	int code;
	int code, numFlags;
	size_t numFlags;

	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name ops command");
	    return TCL_ERROR;
	}

	TclNewObj(opsList);
	opsList = Tcl_NewObj();
	Tcl_IncrRefCount(opsList);
	flagOps = TclGetStringFromObj(objv[3], &numFlags);
	flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
	if (numFlags == 0) {
	    Tcl_DecrRefCount(opsList);
	    goto badVarOps;
	}
	for (p = flagOps; *p != 0; p++) {
	    Tcl_Obj *opObj;

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
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







-
+

-
+













-
-
-
-
+
+
+
+
+
+
+
-


+

-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+

-
+







	    }
	    Tcl_ListObjAppendElement(NULL, opsList, opObj);
	}
	copyObjv[0] = NULL;
	memcpy(copyObjv+1, objv, objc*sizeof(Tcl_Obj *));
	copyObjv[4] = opsList;
	if (optionIndex == TRACE_OLD_VARIABLE) {
	    code = traceSubCmds[2](interp, TRACE_ADD, objc+1, copyObjv);
	    code = (traceSubCmds[2])(interp, TRACE_ADD, objc+1, copyObjv);
	} else {
	    code = traceSubCmds[2](interp, TRACE_REMOVE, objc+1, copyObjv);
	    code = (traceSubCmds[2])(interp, TRACE_REMOVE, objc+1, copyObjv);
	}
	Tcl_DecrRefCount(opsList);
	return code;
    }
    case TRACE_OLD_VINFO: {
	ClientData clientData;
	char ops[5];
	Tcl_Obj *resultListPtr, *pairObjPtr, *elemObjPtr;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "name");
	    return TCL_ERROR;
	}
	TclNewObj(resultListPtr);
	name = TclGetString(objv[2]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;
	resultListPtr = Tcl_NewObj();
	clientData = 0;
	name = Tcl_GetString(objv[2]);
	while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
		TraceVarProc, clientData)) != 0) {

	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
	    char *q = ops;

	    pairObjPtr = Tcl_NewListObj(0, NULL);
	    p = ops;
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		*q = 'r';
		q++;
		*p = 'r';
		p++;
	    }
	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
		*q = 'w';
		q++;
		*p = 'w';
		p++;
	    }
	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
		*q = 'u';
		q++;
		*p = 'u';
		p++;
	    }
	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
		*q = 'a';
		q++;
		*p = 'a';
		p++;
	    }
	    *q = '\0';
	    *p = '\0';

	    /*
	     * Build a pair (2-item list) with the ops string as the first obj
	     * element and the tvarPtr->command string as the second obj
	     * element. Append the pair (as an element) to the end of the
	     * result object list.
	     */
364
365
366
367
368
369
370
371
372


373
374
375
376
377
378
379
380
381
352
353
354
355
356
357
358


359
360


361
362
363
364
365
366
367







-
-
+
+
-
-







    }
#endif /* TCL_REMOVE_OBSOLETE_TRACES */
    }
    return TCL_OK;

#ifndef TCL_REMOVE_OBSOLETE_TRACES
  badVarOps:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "bad operations \"%s\": should be one or more of rwua",
    Tcl_AppendResult(interp, "bad operations \"", flagOps,
	    "\": should be one or more of rwua", NULL);
	    flagOps));
    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "BADOPS", NULL);
    return TCL_ERROR;
#endif
}

/*
 *----------------------------------------------------------------------
 *
398
399
400
401
402
403
404
405
406
407



408
409
410
411

412
413
414
415
416
417
418
384
385
386
387
388
389
390



391
392
393
394
395
396

397
398
399
400
401
402
403
404







-
-
-
+
+
+



-
+







static int
TraceExecutionObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;
    const char *name, *command;
    size_t commandLength, length;
    int commandLength, index;
    char *name, *command;
    size_t length;
    enum traceOptions {
	TRACE_ADD, TRACE_INFO, TRACE_REMOVE
    };
    static const char *const opStrings[] = {
    static const char *opStrings[] = {
	"enter", "leave", "enterstep", "leavestep", NULL
    };
    enum operations {
	TRACE_EXEC_ENTER, TRACE_EXEC_LEAVE,
	TRACE_EXEC_ENTER_STEP, TRACE_EXEC_LEAVE_STEP
    };

434
435
436
437
438
439
440
441
442
443


444
445

446
447
448
449
450
451
452
420
421
422
423
424
425
426



427
428


429
430
431
432
433
434
435
436







-
-
-
+
+
-
-
+







	 */

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " enter, leave, enterstep, or leavestep", -1));
	    Tcl_SetResult(interp, "bad operation list \"\": must be "
		    "one or more of enter, leave, enterstep, or leavestep",
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
		    TCL_STATIC);
	    return TCL_ERROR;
	}
	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
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

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
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
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







-
-
+
+

-
+
-

+
+
+












-
+

-
-
+
+









+
-
+
+





-




+
-
-
+
+











-
+















+
-
+
+








-
-
+
+









-
+






+
-
+










+
-
+

-
-
+
+







		flags |= TCL_TRACE_ENTER_DURING_EXEC;
		break;
	    case TRACE_EXEC_LEAVE_STEP:
		flags |= TCL_TRACE_LEAVE_DURING_EXEC;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
	    TraceCommandInfo *tcmdPtr;
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
			    + length + 1));
	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
		    TCL_TRACE_LEAVE_DURING_EXEC)) {
		flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
	    }
	    memcpy(tcmdPtr->command, command, length+1);
	    name = TclGetString(objv[3]);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		Tcl_Free(tcmdPtr);
		    (ClientData) tcmdPtr) != TCL_OK) {
		ckfree((char *) tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    TraceCommandInfo *tcmdPtr;
	    ClientData clientData;
	    ClientData clientData = NULL;
	    name = Tcl_GetString(objv[3]);

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
		    TraceCommandProc, clientData)) != NULL) {
		tcmdPtr = (TraceCommandInfo *) clientData;

		/*
		 * In checking the 'flags' field we must remove any extraneous
		 * flags which may have been temporarily added by various
		 * pieces of the trace mechanism.
		 */

		if ((tcmdPtr->length == length)
			&& ((tcmdPtr->flags & (TCL_TRACE_ANY_EXEC |
				TCL_TRACE_RENAME | TCL_TRACE_DELETE)) == flags)
			&& (strncmp(command, tcmdPtr->command,
				length) == 0)) {
				(size_t) length) == 0)) {
		    flags |= TCL_TRACE_DELETE;
		    if (flags & (TCL_TRACE_ENTER_DURING_EXEC |
			    TCL_TRACE_LEAVE_DURING_EXEC)) {
			flags |= (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC);
		    }
		    Tcl_UntraceCommand(interp, name, flags,
			    TraceCommandProc, clientData);
		    if (tcmdPtr->stepTrace != NULL) {
			/*
			 * We need to remove the interpreter-wide trace which
			 * we created to allow 'step' traces.
			 */

			Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
			tcmdPtr->stepTrace = NULL;
			if (tcmdPtr->startCmd != NULL) {
			Tcl_Free(tcmdPtr->startCmd);
			    ckfree((char *) tcmdPtr->startCmd);
			}
		    }
		    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
			/*
			 * Postpone deletion.
			 */

			tcmdPtr->flags = 0;
		    }
		    if (tcmdPtr->refCount-- <= 1) {
			Tcl_Free(tcmdPtr);
		    if ((--tcmdPtr->refCount) <= 0) {
			ckfree((char *) tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;
	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	clientData = NULL;
	name = TclGetString(objv[3]);
	name = Tcl_GetString(objv[3]);

	/*
	 * First ensure the name given is valid.
	 */

	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandProc, clientData)) != NULL) {
	    int numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
	    Tcl_Obj *opObj;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

646
647
648
649
650
651
652
653
654
655



656
657

658
659
660
661
662
663
664
638
639
640
641
642
643
644



645
646
647
648

649
650
651
652
653
654
655
656







-
-
-
+
+
+

-
+







static int
TraceCommandObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;
    const char *name, *command;
    size_t commandLength, length;
    int commandLength, index;
    char *name, *command;
    size_t length;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = { "delete", "rename", NULL };
    static const char *opStrings[] = { "delete", "rename", NULL };
    enum operations { TRACE_CMD_DELETE, TRACE_CMD_RENAME };

    switch ((enum traceOptions) optionIndex) {
    case TRACE_ADD:
    case TRACE_REMOVE: {
	int flags = 0;
	int i, listLen, result;
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
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
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

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







-
-
-
+
+
-
-


















-
-
+
+

-
+
-

+
+
+








-
+

-
-
+
+









+
-
+
+





-




+
-
-
-
-
+
+
+
+

-
+



-
-
+
+









-
+






+
+
+




-





+
-
+

-
-
+
+







	 */

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " delete or rename", -1));
	    Tcl_SetResult(interp, "bad operation list \"\": must be "
		    "one or more of delete or rename", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}

	for (i = 0; i < listLen; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum operations) index) {
	    case TRACE_CMD_RENAME:
		flags |= TCL_TRACE_RENAME;
		break;
	    case TRACE_CMD_DELETE:
		flags |= TCL_TRACE_DELETE;
		break;
	    }
	}

	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)Tcl_Alloc(
	    TraceCommandInfo *tcmdPtr;
		    offsetof(TraceCommandInfo, command) + 1 + length);

	    tcmdPtr = (TraceCommandInfo *) ckalloc((unsigned)
		    (sizeof(TraceCommandInfo) - sizeof(tcmdPtr->command)
			    + length + 1));
	    tcmdPtr->flags = flags;
	    tcmdPtr->stepTrace = NULL;
	    tcmdPtr->startLevel = 0;
	    tcmdPtr->startCmd = NULL;
	    tcmdPtr->length = length;
	    tcmdPtr->refCount = 1;
	    flags |= TCL_TRACE_DELETE;
	    memcpy(tcmdPtr->command, command, length+1);
	    name = TclGetString(objv[3]);
	    name = Tcl_GetString(objv[3]);
	    if (Tcl_TraceCommand(interp, name, flags, TraceCommandProc,
		    tcmdPtr) != TCL_OK) {
		Tcl_Free(tcmdPtr);
		    (ClientData) tcmdPtr) != TCL_OK) {
		ckfree((char *) tcmdPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this command to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    TraceCommandInfo *tcmdPtr;
	    ClientData clientData;
	    ClientData clientData = NULL;
	    name = Tcl_GetString(objv[3]);

	    /*
	     * First ensure the name given is valid.
	     */

	    name = TclGetString(objv[3]);
	    if (Tcl_FindCommand(interp,name,NULL,TCL_LEAVE_ERR_MSG) == NULL) {
		return TCL_ERROR;
	    }

	    while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
	    FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;

		if ((tcmdPtr->length == length) && (tcmdPtr->flags == flags)
		    TraceCommandProc, clientData)) != NULL) {
		tcmdPtr = (TraceCommandInfo *) clientData;
		if ((tcmdPtr->length == length)
			&& (tcmdPtr->flags == flags)
			&& (strncmp(command, tcmdPtr->command,
				length) == 0)) {
				(size_t) length) == 0)) {
		    Tcl_UntraceCommand(interp, name, flags | TCL_TRACE_DELETE,
			    TraceCommandProc, clientData);
		    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
		    if (tcmdPtr->refCount-- <= 1) {
			Tcl_Free(tcmdPtr);
		    if ((--tcmdPtr->refCount) <= 0) {
			ckfree((char *) tcmdPtr);
		    }
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;
	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	clientData = NULL;
	name = Tcl_GetString(objv[3]);

	/*
	 * First ensure the name given is valid.
	 */

	name = TclGetString(objv[3]);
	if (Tcl_FindCommand(interp, name, NULL, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}

	resultListPtr = Tcl_NewListObj(0, NULL);
	while ((clientData = Tcl_CommandTraceInfo(interp, name, 0,
	FOREACH_COMMAND_TRACE(interp, name, clientData) {
		TraceCommandProc, clientData)) != NULL) {
	    int numOps = 0;
	    Tcl_Obj *opObj, *eachTraceObjPtr, *elemObjPtr;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
	    Tcl_Obj *opObj;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

840
841
842
843
844
845
846
847
848
849



850
851
852

853
854
855
856
857
858
859
836
837
838
839
840
841
842



843
844
845

846

847
848
849
850
851
852
853
854







-
-
-
+
+
+
-

-
+







static int
TraceVariableObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int optionIndex,		/* Add, info or remove */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int index;
    const char *name, *command;
    size_t commandLength, length;
    int commandLength, index;
    char *name, *command;
    size_t length;
    ClientData clientData;
    enum traceOptions { TRACE_ADD, TRACE_INFO, TRACE_REMOVE };
    static const char *const opStrings[] = {
    static const char *opStrings[] = {
	"array", "read", "unset", "write", NULL
    };
    enum operations {
	TRACE_VAR_ARRAY, TRACE_VAR_READ, TRACE_VAR_UNSET, TRACE_VAR_WRITE
    };

    switch ((enum traceOptions) optionIndex) {
874
875
876
877
878
879
880
881
882
883


884
885
886
887
888
889
890
891
892
869
870
871
872
873
874
875



876
877


878
879
880
881
882
883
884







-
-
-
+
+
-
-







	 */

	result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (listLen == 0) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "bad operation list \"\": must be one or more of"
		    " array, read, unset, or write", -1));
	    Tcl_SetResult(interp, "bad operation list \"\": must be "
		    "one or more of array, read, unset, or write", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRACE", "NOOPS",
		    NULL);
	    return TCL_ERROR;
	}
	for (i = 0; i < listLen ; i++) {
	    if (Tcl_GetIndexFromObj(interp, elemPtrs[i], opStrings,
		    "operation", TCL_EXACT, &index) != TCL_OK) {
		return TCL_ERROR;
	    }
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
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







-
-
+
+

-
-
-
-
+
+
+
+
+










-
+
+

-
-
+
+
-
-
+









+
+
-
-
-
+
+
+
+
-







-
+










+
-
+






-
-
-
-
-
+
+
+
+
+
+
+









-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+







		flags |= TCL_TRACE_UNSETS;
		break;
	    case TRACE_VAR_WRITE:
		flags |= TCL_TRACE_WRITES;
		break;
	    }
	}
	command = TclGetStringFromObj(objv[5], &commandLength);
	length = commandLength;
	command = Tcl_GetStringFromObj(objv[5], &commandLength);
	length = (size_t) commandLength;
	if ((enum traceOptions) optionIndex == TRACE_ADD) {
	    CombinedTraceVarInfo *ctvarPtr = (CombinedTraceVarInfo *)Tcl_Alloc(
		    offsetof(CombinedTraceVarInfo, traceCmdInfo.command)
		    + 1 + length);

	    CombinedTraceVarInfo *ctvarPtr;

	    ctvarPtr = (CombinedTraceVarInfo *) ckalloc((unsigned)
		    (sizeof(CombinedTraceVarInfo) + length + 1
		    - sizeof(ctvarPtr->traceCmdInfo.command)));
	    ctvarPtr->traceCmdInfo.flags = flags;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (objv[0] == NULL) {
		ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE;
	    }
#endif
	    ctvarPtr->traceCmdInfo.length = length;
	    flags |= TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT;
	    memcpy(ctvarPtr->traceCmdInfo.command, command, length+1);
	    ctvarPtr->traceInfo.traceProc = TraceVarProc;
	    ctvarPtr->traceInfo.clientData = &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.clientData = (ClientData)
		    &ctvarPtr->traceCmdInfo;
	    ctvarPtr->traceInfo.flags = flags;
	    name = TclGetString(objv[3]);
	    if (TraceVarEx(interp, name, NULL, (VarTrace *) ctvarPtr)
	    name = Tcl_GetString(objv[3]);
	    if (TraceVarEx(interp,name,NULL,(VarTrace*)ctvarPtr) != TCL_OK) {
		    != TCL_OK) {
		Tcl_Free(ctvarPtr);
		ckfree((char *) ctvarPtr);
		return TCL_ERROR;
	    }
	} else {
	    /*
	     * Search through all of our traces on this variable to see if
	     * there's one with the given command. If so, then delete the
	     * first one that matches.
	     */

	    TraceVarInfo *tvarPtr;
	    ClientData clientData = 0;
	    name = TclGetString(objv[3]);
	    FOREACH_VAR_TRACE(interp, name, clientData) {
		TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;
	    name = Tcl_GetString(objv[3]);
	    while ((clientData = Tcl_VarTraceInfo(interp, name, 0,
		    TraceVarProc, clientData)) != 0) {
		tvarPtr = (TraceVarInfo *) clientData;

		if ((tvarPtr->length == length)
			&& ((tvarPtr->flags
#ifndef TCL_REMOVE_OBSOLETE_TRACES
& ~TCL_TRACE_OLD_STYLE
#endif
						)==flags)
			&& (strncmp(command, tvarPtr->command,
				length) == 0)) {
				(size_t) length) == 0)) {
		    Tcl_UntraceVar2(interp, name, NULL,
			    flags | TCL_TRACE_UNSETS | TCL_TRACE_RESULT_OBJECT,
			    TraceVarProc, clientData);
		    break;
		}
	    }
	}
	break;
    }
    case TRACE_INFO: {
	ClientData clientData;
	Tcl_Obj *resultListPtr;
	Tcl_Obj *resultListPtr, *eachTraceObjPtr, *elemObjPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 3, objv, "name");
	    return TCL_ERROR;
	}

	TclNewObj(resultListPtr);
	name = TclGetString(objv[3]);
	FOREACH_VAR_TRACE(interp, name, clientData) {
	    Tcl_Obj *opObjPtr, *eachTraceObjPtr, *elemObjPtr;
	    TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;
	resultListPtr = Tcl_NewObj();
	clientData = 0;
	name = Tcl_GetString(objv[3]);
	while ((clientData = Tcl_VarTraceInfo(interp, name, 0, TraceVarProc,
		clientData)) != 0) {
	    Tcl_Obj *opObj;
	    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;

	    /*
	     * Build a list with the ops list as the first obj element and the
	     * tcmdPtr->command string as the second obj element. Append this
	     * list (as an element) to the end of the result object list.
	     */

	    elemObjPtr = Tcl_NewListObj(0, NULL);
	    if (tvarPtr->flags & TCL_TRACE_ARRAY) {
		TclNewLiteralStringObj(opObjPtr, "array");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
		TclNewLiteralStringObj(opObj, "array");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    if (tvarPtr->flags & TCL_TRACE_READS) {
		TclNewLiteralStringObj(opObjPtr, "read");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
		TclNewLiteralStringObj(opObj, "read");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    if (tvarPtr->flags & TCL_TRACE_WRITES) {
		TclNewLiteralStringObj(opObjPtr, "write");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
		TclNewLiteralStringObj(opObj, "write");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    if (tvarPtr->flags & TCL_TRACE_UNSETS) {
		TclNewLiteralStringObj(opObjPtr, "unset");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObjPtr);
		TclNewLiteralStringObj(opObj, "unset");
		Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj);
	    }
	    eachTraceObjPtr = Tcl_NewListObj(0, NULL);
	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);

	    elemObjPtr = Tcl_NewStringObj(tvarPtr->command, -1);
	    Tcl_ListObjAppendElement(NULL, eachTraceObjPtr, elemObjPtr);
	    Tcl_ListObjAppendElement(interp, resultListPtr,
1035
1036
1037
1038
1039
1040
1041
1042


1043
1044
1045
1046
1047
1048
1049
1050

1051
1052
1053
1054
1055
1056
1057
1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056







-
+
+







-
+







 *----------------------------------------------------------------------
 */

ClientData
Tcl_CommandTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *cmdName,	/* Name of command. */
    TCL_UNUSED(int) /*flags*/,
    int flags,			/* OR-ed combo or TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY (can be 0). */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;
    register CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return NULL;
    }

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

1140
1141
1142
1143
1144
1145
1146
1147

1148
1149
1150
1151
1152
1153
1154
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
1140
1141
1142
1143
1144
1145

1146
1147
1148
1149
1150
1151
1152
1153







-
+











-
+











-
+







-
+







				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon cmdName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    Command *cmdPtr;
    CommandTrace *tracePtr;
    register CommandTrace *tracePtr;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Set up trace information.
     */

    tracePtr = (CommandTrace *)Tcl_Alloc(sizeof(CommandTrace));
    tracePtr = (CommandTrace *) ckalloc(sizeof(CommandTrace));
    tracePtr->traceProc = proc;
    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 --
1171
1172
1173
1174
1175
1176
1177
1178

1179
1180
1181

1182
1183
1184
1185
1186
1187
1188
1170
1171
1172
1173
1174
1175
1176

1177
1178
1179

1180
1181
1182
1183
1184
1185
1186
1187







-
+


-
+







    const char *cmdName,	/* Name of command. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_RENAME, TCL_TRACE_DELETE, and any
				 * of the TRACE_*_EXEC flags */
    Tcl_CommandTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    CommandTrace *tracePtr;
    register CommandTrace *tracePtr;
    CommandTrace *prevPtr;
    Command *cmdPtr;
    Interp *iPtr = (Interp *)interp;
    Interp *iPtr = (Interp *) interp;
    ActiveCommandTrace *activePtr;
    int hasExecTraces = 0;

    cmdPtr = (Command *) Tcl_FindCommand(interp, cmdName, NULL,
	    TCL_LEAVE_ERR_MSG);
    if (cmdPtr == NULL) {
	return;
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
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







-
-
+
+




















-
+

+







    if (prevPtr == NULL) {
	cmdPtr->tracePtr = tracePtr->nextPtr;
    } else {
	prevPtr->nextPtr = tracePtr->nextPtr;
    }
    tracePtr->flags = 0;

    if (tracePtr->refCount-- <= 1) {
	Tcl_Free(tracePtr);
    if ((--tracePtr->refCount) <= 0) {
	ckfree((char *) tracePtr);
    }

    if (hasExecTraces) {
	for (tracePtr = cmdPtr->tracePtr, prevPtr = NULL; tracePtr != NULL ;
		prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
		return;
	    }
	}

	/*
	 * 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++;
	}
    }
}

/*
 *----------------------------------------------------------------------
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
1348
1349
1350
1351
1352
1353
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

1348
1349
1350
1351
1352
1353
1354
1355
1356







+











-
+













-
+



-
+

-
+


















-
+
















+
-
+
+







 *
 * Side effects:
 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static void
TraceCommandProc(
    ClientData clientData,	/* Information about the command trace. */
    Tcl_Interp *interp,		/* Interpreter containing command. */
    const char *oldName,	/* Name of command being changed. */
    const char *newName,	/* New name of command. Empty string or NULL
				 * means command is being deleted (renamed to
				 * ""). */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
    int code;
    Tcl_DString cmd;

    tcmdPtr->refCount++;

    if ((tcmdPtr->flags & flags) && !Tcl_InterpDeleted(interp)
	    && !Tcl_LimitExceeded(interp)) {
	/*
	 * Generate a command to execute by appending list elements for the
	 * old and new command name and the operation.
	 */

	Tcl_DStringInit(&cmd);
	Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length);
	Tcl_DStringAppend(&cmd, tcmdPtr->command, (int) tcmdPtr->length);
	Tcl_DStringAppendElement(&cmd, oldName);
	Tcl_DStringAppendElement(&cmd, (newName ? newName : ""));
	if (flags & TCL_TRACE_RENAME) {
	    TclDStringAppendLiteral(&cmd, " rename");
	    Tcl_DStringAppend(&cmd, " rename", 7);
	} else if (flags & TCL_TRACE_DELETE) {
	    TclDStringAppendLiteral(&cmd, " delete");
	    Tcl_DStringAppend(&cmd, " delete", 7);
	}

	/*
	 * Execute the command. We discard any object result the command
	 * returns.
	 *
	 * Add the TCL_TRACE_DESTROYED flag to tcmdPtr to indicate to other
	 * areas that this will be destroyed by us, otherwise a double-free
	 * might occur depending on what the eval does.
	 */

	if (flags & TCL_TRACE_DESTROYED) {
	    tcmdPtr->flags |= TCL_TRACE_DESTROYED;
	}
	code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
		Tcl_DStringLength(&cmd), 0);
	if (code != TCL_OK) {
	    /* We ignore errors in these traced commands */
	    /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/
	    /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/
	}
	Tcl_DStringFree(&cmd);
    }

    /*
     * We delete when the trace was destroyed or if this is a delete trace,
     * because command deletes are unconditional, so the trace must go away.
     */

    if (flags & (TCL_TRACE_DESTROYED | TCL_TRACE_DELETE)) {
	int untraceFlags = tcmdPtr->flags;
	Tcl_InterpState state;

	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
	    Tcl_Free(tcmdPtr->startCmd);
		ckfree((char *) tcmdPtr->startCmd);
	    }
	}
	if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	    /*
	     * Postpone deletion, until exec trace returns.
	     */

	    tcmdPtr->flags = 0;
1377
1378
1379
1380
1381
1382
1383
1384

1385
1386
1387
1388


1389
1390
1391
1392
1393
1394
1395
1380
1381
1382
1383
1384
1385
1386

1387
1388
1389


1390
1391
1392
1393
1394
1395
1396
1397
1398







-
+


-
-
+
+







	 * Note that we save the (return) state of the interpreter to prevent
	 * bizarre error messages.
	 */

	state = Tcl_SaveInterpState(interp, TCL_OK);
	Tcl_UntraceCommand(interp, oldName, untraceFlags,
		TraceCommandProc, clientData);
	Tcl_RestoreInterpState(interp, state);
	(void) Tcl_RestoreInterpState(interp, state);
	tcmdPtr->refCount--;
    }
    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    if ((--tcmdPtr->refCount) <= 0) {
	ckfree((char *) tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckExecutionTraces --
1415
1416
1417
1418
1419
1420
1421
1422


1423
1424
1425
1426
1427
1428
1429
1418
1419
1420
1421
1422
1423
1424

1425
1426
1427
1428
1429
1430
1431
1432
1433







-
+
+







 */

int
TclCheckExecutionTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    TCL_UNUSED(size_t) /*numChars*/,
    int numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    int objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
1460
1461
1462
1463
1464
1465
1466
1467


1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479




1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501
1502
1503
1464
1465
1466
1467
1468
1469
1470

1471
1472
1473
1474
1475
1476
1477
1478
1479
1480




1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500

1501
1502
1503
1504
1505
1506
1507
1508







-
+
+








-
-
-
-
+
+
+
+
















-
+







		tracePtr = tracePtr->nextPtr;
	    }
	} else {
	    active.reverseScan = 0;
	    active.nextTracePtr = tracePtr->nextPtr;
	}
	if (tracePtr->traceProc == TraceCommandProc) {
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData;
	    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
		    tracePtr->clientData;

	    if (tcmdPtr->flags != 0) {
		tcmdPtr->curFlags = traceFlags | TCL_TRACE_EXEC_DIRECT;
		tcmdPtr->curCode  = code;
		tcmdPtr->refCount++;
		if (state == NULL) {
		    state = Tcl_SaveInterpState(interp, code);
		}
		traceCode = TraceExecutionProc(tcmdPtr, interp, curLevel,
			command, (Tcl_Command) cmdPtr, objc, objv);
		if (tcmdPtr->refCount-- <= 1) {
		    Tcl_Free(tcmdPtr);
		traceCode = TraceExecutionProc((ClientData) tcmdPtr, interp,
			curLevel, command, (Tcl_Command) cmdPtr, objc, objv);
		if ((--tcmdPtr->refCount) <= 0) {
		    ckfree((char *) tcmdPtr);
		}
	    }
	}
	if (active.nextTracePtr) {
	    lastTracePtr = active.nextTracePtr->nextPtr;
	}
    }
    iPtr->activeCmdTracePtr = active.nextPtr;
    if (state) {
	if (traceCode == TCL_OK) {
	    (void) Tcl_RestoreInterpState(interp, state);
	} else {
	    Tcl_DiscardInterpState(state);
	}
    }

    return traceCode;
    return(traceCode);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckInterpTraces --
 *
1520
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532
1533
1534
1525
1526
1527
1528
1529
1530
1531

1532
1533
1534
1535
1536
1537
1538
1539







-
+







 */

int
TclCheckInterpTraces(
    Tcl_Interp *interp,		/* The current interpreter. */
    const char *command,	/* Pointer to beginning of the current command
				 * string. */
    size_t numChars,		/* The number of characters in 'command' which
    int numChars,		/* The number of characters in 'command' which
				 * are part of the command string. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    int code,			/* The current result code. */
    int traceFlags,		/* Current tracing situation. */
    int objc,			/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
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
1631
1632
1633

1634
1635
1636
1637
1638
1639

1640
1641
1642
1643
1644
1645

1646
1647
1648
1649
1650
1651
1652
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
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







-
+













-
+
+




-
-
-
+
+
+

















-
+





-
+





-
+







	     * The proc invoked might delete the traced command which which
	     * might try to free tracePtr. We want to use tracePtr until the
	     * end of this if section, so we use Tcl_Preserve() and
	     * Tcl_Release() to be sure it is not freed while we still need
	     * it.
	     */

	    Tcl_Preserve(tracePtr);
	    Tcl_Preserve((ClientData) tracePtr);
	    tracePtr->flags |= TCL_TRACE_EXEC_IN_PROGRESS;
	    if (state == NULL) {
		state = Tcl_SaveInterpState(interp, code);
	    }

	    if (tracePtr->flags &
		    (TCL_TRACE_ENTER_EXEC | TCL_TRACE_LEAVE_EXEC)) {
		/*
		 * New style trace.
		 */

		if (tracePtr->flags & traceFlags) {
		    if (tracePtr->proc == TraceExecutionProc) {
			TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)tracePtr->clientData;
			TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)
				tracePtr->clientData;

			tcmdPtr->curFlags = traceFlags;
			tcmdPtr->curCode = code;
		    }
		    traceCode = tracePtr->proc(tracePtr->clientData, interp,
			    curLevel, command, (Tcl_Command) cmdPtr, objc,
			    objv);
		    traceCode = (tracePtr->proc)(tracePtr->clientData,
			    interp, curLevel, command, (Tcl_Command) cmdPtr,
			    objc, objv);
		}
	    } else {
		/*
		 * Old-style trace.
		 */

		if (traceFlags & TCL_TRACE_ENTER_EXEC) {
		    /*
		     * Old-style interpreter-wide traces only trigger before
		     * the command is executed.
		     */

		    traceCode = CallTraceFunction(interp, tracePtr, cmdPtr,
			    command, numChars, objc, objv);
		}
	    }
	    tracePtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;
	    Tcl_Release(tracePtr);
	    Tcl_Release((ClientData) tracePtr);
	}
    }
    iPtr->activeInterpTracePtr = active.nextPtr;
    if (state) {
	if (traceCode == TCL_OK) {
	    Tcl_RestoreInterpState(interp, state);
	    (void) Tcl_RestoreInterpState(interp, state);
	} else {
	    Tcl_DiscardInterpState(state);
	}
    }

    return traceCode;
    return(traceCode);
}

/*
 *----------------------------------------------------------------------
 *
 * CallTraceFunction --
 *
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
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







-
+



-
+

-
+










-
-
+
+






-
+







 *
 *----------------------------------------------------------------------
 */

static int
CallTraceFunction(
    Tcl_Interp *interp,		/* The current interpreter. */
    Trace *tracePtr,	/* Describes the trace function to call. */
    register Trace *tracePtr,	/* Describes the trace function to call. */
    Command *cmdPtr,		/* Points to command's Command struct. */
    const char *command,	/* Points to the first character of the
				 * command's source before substitutions. */
    size_t numChars,		/* The number of characters in the command's
    int numChars,		/* The number of characters in the command's
				 * source. */
    int objc,		/* Number of arguments for the command. */
    register int objc,		/* Number of arguments for the command. */
    Tcl_Obj *const objv[])	/* Pointers to Tcl_Obj of each argument. */
{
    Interp *iPtr = (Interp *) interp;
    char *commandCopy;
    int traceCode;

    /*
     * Copy the command characters into a new string.
     */

    commandCopy = (char *)TclStackAlloc(interp, numChars + 1);
    memcpy(commandCopy, command, numChars);
    commandCopy = TclStackAlloc(interp, (unsigned) (numChars + 1));
    memcpy(commandCopy, command, (size_t) numChars);
    commandCopy[numChars] = '\0';

    /*
     * Call the trace function then free allocated storage.
     */

    traceCode = tracePtr->proc(tracePtr->clientData, (Tcl_Interp *) iPtr,
    traceCode = (tracePtr->proc)(tracePtr->clientData, (Tcl_Interp *) iPtr,
	    iPtr->numLevels, commandCopy, (Tcl_Command) cmdPtr, objc, objv);

    TclStackFree(interp, commandCopy);
    return traceCode;
}

/*
1716
1717
1718
1719
1720
1721
1722
1723

1724
1725
1726


1727
1728
1729
1730
1731
1732
1733
1722
1723
1724
1725
1726
1727
1728

1729
1730


1731
1732
1733
1734
1735
1736
1737
1738
1739







-
+

-
-
+
+







 *----------------------------------------------------------------------
 */

static void
CommandObjTraceDeleted(
    ClientData clientData)
{
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;

    if (tcmdPtr->refCount-- <= 1) {
	Tcl_Free(tcmdPtr);
    if ((--tcmdPtr->refCount) <= 0) {
	ckfree((char *) tcmdPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceExecutionProc --
1754
1755
1756
1757
1758
1759
1760
1761

1762
1763
1764
1765
1766
1767

1768
1769
1770
1771
1772
1773
1774
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770
1771
1772

1773
1774
1775
1776
1777
1778
1779
1780







-
+





-
+








static int
TraceExecutionProc(
    ClientData clientData,
    Tcl_Interp *interp,
    int level,
    const char *command,
    TCL_UNUSED(Tcl_Command),
    Tcl_Command cmdInfo,
    int objc,
    struct Tcl_Obj *const objv[])
{
    int call = 0;
    Interp *iPtr = (Interp *) interp;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *)clientData;
    TraceCommandInfo *tcmdPtr = (TraceCommandInfo *) clientData;
    int flags = tcmdPtr->curFlags;
    int code = tcmdPtr->curCode;
    int traceCode = TCL_OK;

    if (tcmdPtr->flags & TCL_TRACE_EXEC_IN_PROGRESS) {
	/*
	 * Inside any kind of execution trace callback, we do not allow any
1801
1802
1803
1804
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
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







+
-
+
+







-
+
+



-
+







-
+
















-
+





-
-
+
+







	 */

	if ((flags & TCL_TRACE_LEAVE_EXEC) && (tcmdPtr->stepTrace != NULL)
		&& (level == tcmdPtr->startLevel)
		&& (strcmp(command, tcmdPtr->startCmd) == 0)) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
	    Tcl_Free(tcmdPtr->startCmd);
		ckfree((char *) tcmdPtr->startCmd);
	    }
	}

	/*
	 * Second, create the tcl callback, if required.
	 */

	if (call) {
	    Tcl_DString cmd, sub;
	    Tcl_DString cmd;
	    Tcl_DString sub;
	    int i, saveInterpFlags;

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tcmdPtr->command, tcmdPtr->length);
	    Tcl_DStringAppend(&cmd, tcmdPtr->command, (int)tcmdPtr->length);

	    /*
	     * Append command with arguments.
	     */

	    Tcl_DStringInit(&sub);
	    for (i = 0; i < objc; i++) {
		Tcl_DStringAppendElement(&sub, TclGetString(objv[i]));
		Tcl_DStringAppendElement(&sub, Tcl_GetString(objv[i]));
	    }
	    Tcl_DStringAppendElement(&cmd, Tcl_DStringValue(&sub));
	    Tcl_DStringFree(&sub);

	    if (flags & TCL_TRACE_ENTER_EXEC) {
		/*
		 * Append trace operation.
		 */

		if (flags & TCL_TRACE_EXEC_DIRECT) {
		    Tcl_DStringAppendElement(&cmd, "enter");
		} else {
		    Tcl_DStringAppendElement(&cmd, "enterstep");
		}
	    } else if (flags & TCL_TRACE_LEAVE_EXEC) {
		Tcl_Obj *resultCode;
		const char *resultCodeStr;
		char *resultCodeStr;

		/*
		 * Append result code.
		 */

		TclNewIntObj(resultCode, code);
		resultCodeStr = TclGetString(resultCode);
		resultCode = Tcl_NewIntObj(code);
		resultCodeStr = Tcl_GetString(resultCode);
		Tcl_DStringAppendElement(&cmd, resultCodeStr);
		Tcl_DecrRefCount(resultCode);

		/*
		 * Append result string.
		 */

1884
1885
1886
1887
1888
1889
1890
1891

1892
1893
1894
1895
1896
1897
1898
1899
1893
1894
1895
1896
1897
1898
1899

1900

1901
1902
1903
1904
1905
1906
1907







-
+
-








	    /*
	     * This line can have quite arbitrary side-effects, including
	     * deleting the trace, the command being traced, or even the
	     * interpreter.
	     */

	    traceCode = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
	    traceCode = Tcl_Eval(interp, Tcl_DStringValue(&cmd));
		    Tcl_DStringLength(&cmd), 0);
	    tcmdPtr->flags &= ~TCL_TRACE_EXEC_IN_PROGRESS;

	    /*
	     * Restore the interp tracing flag to prevent cmd traces from
	     * affecting interp traces.
	     */

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
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







-
+


-
+




+
-
+






+
-
+
+



-
-
+
+







	 * string in startLevel and startCmd so that we can delete this
	 * interpreter trace when it reaches the end of this proc.
	 */

	if ((flags & TCL_TRACE_ENTER_EXEC) && (tcmdPtr->stepTrace == NULL)
		&& (tcmdPtr->flags & (TCL_TRACE_ENTER_DURING_EXEC |
			TCL_TRACE_LEAVE_DURING_EXEC))) {
	    unsigned len = strlen(command) + 1;
	    register unsigned len = strlen(command) + 1;

	    tcmdPtr->startLevel = level;
	    tcmdPtr->startCmd = (char *)Tcl_Alloc(len);
	    tcmdPtr->startCmd = ckalloc(len);
	    memcpy(tcmdPtr->startCmd, command, len);
	    tcmdPtr->refCount++;
	    tcmdPtr->stepTrace = Tcl_CreateObjTrace(interp, 0,
		   (tcmdPtr->flags & TCL_TRACE_ANY_EXEC) >> 2,
		   TraceExecutionProc, (ClientData)tcmdPtr,
		   TraceExecutionProc, tcmdPtr, CommandObjTraceDeleted);
		   CommandObjTraceDeleted);
	}
    }
    if (flags & TCL_TRACE_DESTROYED) {
	if (tcmdPtr->stepTrace != NULL) {
	    Tcl_DeleteTrace(interp, tcmdPtr->stepTrace);
	    tcmdPtr->stepTrace = NULL;
	    if (tcmdPtr->startCmd != NULL) {
	    Tcl_Free(tcmdPtr->startCmd);
		ckfree(tcmdPtr->startCmd);
	    }
	}
    }
    if (call) {
	if (tcmdPtr->refCount-- <= 1) {
	    Tcl_Free(tcmdPtr);
	if ((--tcmdPtr->refCount) <= 0) {
	    ckfree((char *) tcmdPtr);
	}
    }
    return traceCode;
}

/*
 *----------------------------------------------------------------------
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
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







+










-
+



-


-
+








-
+






-
+





-
+

-
+

-
+

-
+




-
+

-
+

-
+

-
+



















-
-
-
-
-
-
-
-
-


-
-
-


-







-
+







 *
 * Side effects:
 *	Depends on the command associated with the trace.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static char *
TraceVarProc(
    ClientData clientData,	/* Information about the variable trace. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable or array. */
    const char *name2,		/* Name of element within array; NULL means
				 * scalar variable is being referenced. */
    int flags)			/* OR-ed bits giving operation and other
				 * information. */
{
    TraceVarInfo *tvarPtr = (TraceVarInfo *)clientData;
    TraceVarInfo *tvarPtr = (TraceVarInfo *) clientData;
    char *result;
    int code, destroy = 0;
    Tcl_DString cmd;
    int rewind = ((Interp *)interp)->execEnvPtr->rewind;

    /*
     * We might call Tcl_EvalEx() below, and that might evaluate [trace vdelete]
     * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
     * which might try to free tvarPtr. We want to use tvarPtr until the end
     * of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure
     * it is not freed while we still need it.
     */

    result = NULL;
    if ((tvarPtr->flags & flags) && !Tcl_InterpDeleted(interp)
	    && !Tcl_LimitExceeded(interp)) {
	if (tvarPtr->length) {
	if (tvarPtr->length != (size_t) 0) {
	    /*
	     * Generate a command to execute by appending list elements for
	     * the two variable names and the operation.
	     */

	    Tcl_DStringInit(&cmd);
	    Tcl_DStringAppend(&cmd, tvarPtr->command, tvarPtr->length);
	    Tcl_DStringAppend(&cmd, tvarPtr->command, (int) tvarPtr->length);
	    Tcl_DStringAppendElement(&cmd, name1);
	    Tcl_DStringAppendElement(&cmd, (name2 ? name2 : ""));
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    if (tvarPtr->flags & TCL_TRACE_OLD_STYLE) {
		if (flags & TCL_TRACE_ARRAY) {
		    TclDStringAppendLiteral(&cmd, " a");
		    Tcl_DStringAppend(&cmd, " a", 2);
		} else if (flags & TCL_TRACE_READS) {
		    TclDStringAppendLiteral(&cmd, " r");
		    Tcl_DStringAppend(&cmd, " r", 2);
		} else if (flags & TCL_TRACE_WRITES) {
		    TclDStringAppendLiteral(&cmd, " w");
		    Tcl_DStringAppend(&cmd, " w", 2);
		} else if (flags & TCL_TRACE_UNSETS) {
		    TclDStringAppendLiteral(&cmd, " u");
		    Tcl_DStringAppend(&cmd, " u", 2);
		}
	    } else {
#endif
		if (flags & TCL_TRACE_ARRAY) {
		    TclDStringAppendLiteral(&cmd, " array");
		    Tcl_DStringAppend(&cmd, " array", 6);
		} else if (flags & TCL_TRACE_READS) {
		    TclDStringAppendLiteral(&cmd, " read");
		    Tcl_DStringAppend(&cmd, " read", 5);
		} else if (flags & TCL_TRACE_WRITES) {
		    TclDStringAppendLiteral(&cmd, " write");
		    Tcl_DStringAppend(&cmd, " write", 6);
		} else if (flags & TCL_TRACE_UNSETS) {
		    TclDStringAppendLiteral(&cmd, " unset");
		    Tcl_DStringAppend(&cmd, " unset", 6);
		}
#ifndef TCL_REMOVE_OBSOLETE_TRACES
	    }
#endif

	    /*
	     * Execute the command. We discard any object result the command
	     * returns.
	     *
	     * Add the TCL_TRACE_DESTROYED flag to tvarPtr to indicate to
	     * other areas that this will be destroyed by us, otherwise a
	     * double-free might occur depending on what the eval does.
	     */

	    if ((flags & TCL_TRACE_DESTROYED)
		    && !(tvarPtr->flags & TCL_TRACE_DESTROYED)) {
		destroy = 1;
		tvarPtr->flags |= TCL_TRACE_DESTROYED;
	    }

	    /*
	     * Make sure that unset traces are rune even if the execEnv is
	     * rewinding (coroutine deletion, [Bug 2093947]
	     */

	    if (rewind && (flags & TCL_TRACE_UNSETS)) {
		((Interp *)interp)->execEnvPtr->rewind = 0;
	    }
	    code = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd),
		    Tcl_DStringLength(&cmd), 0);
	    if (rewind) {
		((Interp *)interp)->execEnvPtr->rewind = rewind;
	    }
	    if (code != TCL_OK) {		/* copy error msg to result */
		Tcl_Obj *errMsgObj = Tcl_GetObjResult(interp);

		Tcl_IncrRefCount(errMsgObj);
		result = (char *) errMsgObj;
	    }
	    Tcl_DStringFree(&cmd);
	}
    }
    if (destroy && result != NULL) {
	Tcl_Obj *errMsgObj = (Tcl_Obj *) result;
	register Tcl_Obj *errMsgObj = (Tcl_Obj *) result;

	Tcl_DecrRefCount(errMsgObj);
	result = NULL;
    }
    return result;
}

2132
2133
2134
2135
2136
2137
2138
2139
2140


2141
2142
2143
2144
2145
2146
2147
2130
2131
2132
2133
2134
2135
2136


2137
2138
2139
2140
2141
2142
2143
2144
2145







-
-
+
+







    int level,			/* Maximum nesting level */
    int flags,			/* Flags, see above */
    Tcl_CmdObjTraceProc *proc,	/* Trace callback */
    ClientData clientData,	/* Client data for the callback */
    Tcl_CmdObjTraceDeleteProc *delProc)
				/* Function to call when trace is deleted */
{
    Trace *tracePtr;
    Interp *iPtr = (Interp *) interp;
    register Trace *tracePtr;
    register Interp *iPtr = (Interp *) interp;

    /*
     * Test if this trace allows inline compilation of commands.
     */

    if (!(flags & TCL_ALLOW_INLINE_COMPILATION)) {
	if (iPtr->tracesForbiddingInline == 0) {
2157
2158
2159
2160
2161
2162
2163
2164

2165
2166
2167
2168
2169
2170
2171
2155
2156
2157
2158
2159
2160
2161

2162
2163
2164
2165
2166
2167
2168
2169







-
+








	    iPtr->compileEpoch++;
	    iPtr->flags |= DONT_COMPILE_CMDS_INLINE;
	}
	iPtr->tracesForbiddingInline++;
    }

    tracePtr = (Trace *)Tcl_Alloc(sizeof(Trace));
    tracePtr = (Trace *) ckalloc(sizeof(Trace));
    tracePtr->level = level;
    tracePtr->proc = proc;
    tracePtr->clientData = clientData;
    tracePtr->delProc = delProc;
    tracePtr->nextPtr = iPtr->tracePtr;
    tracePtr->flags = flags;
    iPtr->tracePtr = tracePtr;
2220
2221
2222
2223
2224
2225
2226
2227


2228
2229
2230
2231
2232

2233
2234
2235
2236
2237
2238
2239
2218
2219
2220
2221
2222
2223
2224

2225
2226
2227
2228
2229
2230

2231
2232
2233
2234
2235
2236
2237
2238







-
+
+




-
+







    Tcl_Interp *interp,		/* Interpreter in which to create trace. */
    int level,			/* Only call proc for commands at nesting
				 * level<=argument level (1=>top level). */
    Tcl_CmdTraceProc *proc,	/* Function to call before executing each
				 * command. */
    ClientData clientData)	/* Arbitrary value word to pass to proc. */
{
    StringTraceData *data = (StringTraceData *)Tcl_Alloc(sizeof(StringTraceData));
    StringTraceData *data = (StringTraceData *)
	    ckalloc(sizeof(StringTraceData));

    data->clientData = clientData;
    data->proc = proc;
    return Tcl_CreateObjTrace(interp, level, 0, StringTraceProc,
	    data, StringTraceDeleteProc);
	    (ClientData) data, StringTraceDeleteProc);
}

/*
 *----------------------------------------------------------------------
 *
 * StringTraceProc --
 *
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
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







-
+










-
+

-
+









-
+







    Tcl_Interp *interp,
    int level,
    const char *command,
    Tcl_Command commandInfo,
    int objc,
    Tcl_Obj *const *objv)
{
    StringTraceData *data = (StringTraceData *)clientData;
    StringTraceData *data = (StringTraceData *) clientData;
    Command *cmdPtr = (Command *) commandInfo;
    const char **argv;		/* Args to pass to string trace proc */
    int i;

    /*
     * This is a bit messy because we have to emulate the old trace interface,
     * which uses strings for everything.
     */

    argv = (const char **) TclStackAlloc(interp,
	    (objc + 1) * sizeof(const char *));
	    (unsigned) ((objc + 1) * sizeof(const char *)));
    for (i = 0; i < objc; i++) {
	argv[i] = TclGetString(objv[i]);
	argv[i] = Tcl_GetString(objv[i]);
    }
    argv[objc] = 0;

    /*
     * Invoke the command function. Note that we cast away const-ness on two
     * parameters for compatibility with legacy code; the code MUST NOT modify
     * either command or argv.
     */

    data->proc(data->clientData, interp, level, (char *) command,
    (data->proc)(data->clientData, interp, level, (char *) command,
	    cmdPtr->proc, cmdPtr->clientData, objc, argv);
    TclStackFree(interp, (void *) argv);

    return TCL_OK;
}

/*
2304
2305
2306
2307
2308
2309
2310
2311

2312
2313
2314
2315
2316
2317
2318
2303
2304
2305
2306
2307
2308
2309

2310
2311
2312
2313
2314
2315
2316
2317







-
+







 *----------------------------------------------------------------------
 */

static void
StringTraceDeleteProc(
    ClientData clientData)
{
    Tcl_Free(clientData);
    ckfree((char *) clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteTrace --
 *
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
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







-
+








-
+

-
+




-
+







Tcl_DeleteTrace(
    Tcl_Interp *interp,		/* Interpreter that contains trace. */
    Tcl_Trace trace)		/* Token for trace (returned previously by
				 * Tcl_CreateTrace). */
{
    Interp *iPtr = (Interp *) interp;
    Trace *prevPtr, *tracePtr = (Trace *) trace;
    Trace **tracePtr2 = &iPtr->tracePtr;
    register Trace **tracePtr2 = &(iPtr->tracePtr);
    ActiveInterpTrace *activePtr;

    /*
     * Locate the trace entry in the interpreter's trace list, and remove it
     * from the list.
     */

    prevPtr = NULL;
    while (*tracePtr2 != NULL && *tracePtr2 != tracePtr) {
    while ((*tracePtr2) != NULL && (*tracePtr2) != tracePtr) {
	prevPtr = *tracePtr2;
	tracePtr2 = &prevPtr->nextPtr;
	tracePtr2 = &((*tracePtr2)->nextPtr);
    }
    if (*tracePtr2 == NULL) {
	return;
    }
    *tracePtr2 = (*tracePtr2)->nextPtr;
    (*tracePtr2) = (*tracePtr2)->nextPtr;

    /*
     * The code below makes it possible to delete traces while traces are
     * active: it makes sure that the deleted trace won't be processed by
     * TclCheckInterpTraces.
     */

2387
2388
2389
2390
2391
2392
2393
2394

2395
2396
2397
2398
2399
2400
2401
2386
2387
2388
2389
2390
2391
2392

2393
2394
2395
2396
2397
2398
2399
2400







-
+







    }

    /*
     * Execute any delete callback.
     */

    if (tracePtr->delProc != NULL) {
	tracePtr->delProc(tracePtr->clientData);
	(tracePtr->delProc)(tracePtr->clientData);
    }

    /*
     * Delete the trace object.
     */

    Tcl_EventuallyFree((char *) tracePtr, TCL_DYNAMIC);
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
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







-
+
+



















-
+















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 */

Var *
TclVarTraceExists(
    Tcl_Interp *interp,		/* The interpreter */
    const char *varName)	/* The variable name */
{
    Var *varPtr, *arrayPtr;
    Var *varPtr;
    Var *arrayPtr;

    /*
     * The choice of "create" flag values is delicate here, and matches the
     * semantics of GetVar. Things are still not perfect, however, because if
     * you do "info exists x" you get a varPtr and therefore trigger traces.
     * However, if you do "info exists x(i)", then you only get a varPtr if x
     * is already known to be an array. Otherwise you get NULL, and no trace
     * is triggered. This matches Tcl 7.6 semantics.
     */

    varPtr = TclLookupVar(interp, varName, NULL, 0, "access",
	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);

    if (varPtr == NULL) {
	return NULL;
    }

    if ((varPtr->flags & VAR_TRACED_READ)
	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ))) {
	TclCallVarTraces((Interp *) interp, arrayPtr, varPtr, varName, NULL,
	TclCallVarTraces((Interp *)interp, arrayPtr, varPtr, varName, NULL,
		TCL_TRACE_READS, /* leaveErrMsg */ 0);
    }

    /*
     * If the variable doesn't exist anymore and no-one's using it, then free
     * up the relevant structures and hash table entries.
     */

    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
	return NULL;
    }

    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCheckArrayTraces --
 *
 *	This function is invoked to when we operate on an array variable,
 *	to allow any array traces to fire.
 *
 * Results:
 *	Returns TCL_OK to indicate normal operation. Returns TCL_ERROR if
 *	invocation of a trace function indicated an error. When TCL_ERROR is
 *	returned, then error information is left in interp.
 *
 * Side effects:
 *	Almost anything can happen, depending on trace; this function itself
 *	doesn't have any side effects.
 *
 *----------------------------------------------------------------------
 */

int
TclCheckArrayTraces(
    Tcl_Interp *interp,
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *name,
    int index)
{
    int code = TCL_OK;

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	&& (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	Interp *iPtr = (Interp *)interp;

	code = TclObjCallVarTraces(iPtr, arrayPtr, varPtr, name, NULL,
		(TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY),
		/* leaveErrMsg */ 1, index);
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCallVarTraces --
 *
 *	This function is invoked to find and invoke relevant trace functions
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
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







-
+















-
+




-
-
-










-
+












-
+







 *
 *----------------------------------------------------------------------
 */

int
TclObjCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
    register Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    Tcl_Obj *part1Ptr,
    Tcl_Obj *part2Ptr,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe
				 * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
    int leaveErrMsg,		/* If true, and one of the traces indicates an
				 * error, then leave an error message and
				 * stack trace information in *iPTr. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    const char *part1, *part2;
    char *part1, *part2;

    if (!part1Ptr) {
	part1Ptr = localName(iPtr->varFramePtr, index);
    }
    if (!part1Ptr) {
	Tcl_Panic("Cannot trace a variable with no name");
    }
    part1 = TclGetString(part1Ptr);
    part2 = part2Ptr? TclGetString(part2Ptr) : NULL;

    return TclCallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags,
	    leaveErrMsg);
}

int
TclCallVarTraces(
    Interp *iPtr,		/* Interpreter containing variable. */
    Var *arrayPtr,	/* Pointer to array variable that contains the
    register Var *arrayPtr,	/* Pointer to array variable that contains the
				 * variable, or NULL if the variable isn't an
				 * element of an array. */
    Var *varPtr,		/* Variable whose traces are to be invoked. */
    const char *part1,
    const char *part2,		/* Variable's two-part name. */
    int flags,			/* Flags passed to trace functions: indicates
				 * what's happening to variable, plus maybe
				 * TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY */
    int leaveErrMsg)		/* If true, and one of the traces indicates an
				 * error, then leave an error message and
				 * stack trace information in *iPTr. */
{
    VarTrace *tracePtr;
    register VarTrace *tracePtr;
    ActiveVarTrace active;
    char *result;
    const char *openParen, *p;
    Tcl_DString nameCopy;
    int copiedName;
    int code = TCL_OK;
    int disposeFlags = 0;
2621
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
2658

2659
2660

2661



2662

2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717

2718
2719
2720
2721
2722
2723
2724
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
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
2658


2659
2660
2661
2662
2663
2664

2665
2666

2667
2668
2669
2670
2671

2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685

2686
2687
2688
2689
2690
2691
2692
2693







-
+











+
+
+
+
+
+
+







-
+




-
-
+
+




-
+

-
+

+
+
+
-
+













-
+
















-
-
+
+




-
+

-
+

+
+
+
-
+













-
+







		} while (*p != '\0');
		p--;
		if (*p == ')') {
		    int offset = (openParen - part1);
		    char *newPart1;

		    Tcl_DStringInit(&nameCopy);
		    Tcl_DStringAppend(&nameCopy, part1, p-part1);
		    Tcl_DStringAppend(&nameCopy, part1, (p-part1));
		    newPart1 = Tcl_DStringValue(&nameCopy);
		    newPart1[offset] = 0;
		    part1 = newPart1;
		    part2 = newPart1 + offset + 1;
		    copiedName = 1;
		}
		break;
	    }
	}
    }

    /*
     * Ignore any caller-provided TCL_INTERP_DESTROYED flag.  Only we can
     * set it correctly.
     */

    flags &= ~TCL_INTERP_DESTROYED;

    /*
     * Invoke traces on the array containing the variable, if relevant.
     */

    result = NULL;
    active.nextPtr = iPtr->activeVarTracePtr;
    iPtr->activeVarTracePtr = &active;
    Tcl_Preserve(iPtr);
    Tcl_Preserve((ClientData) iPtr);
    if (arrayPtr && !TclIsVarTraceActive(arrayPtr)
	    && (arrayPtr->flags & traceflags)) {
	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) arrayPtr);
	active.varPtr = arrayPtr;
	for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);
		tracePtr != NULL; tracePtr = active.nextTracePtr) {
	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    Tcl_Preserve((ClientData) tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
	    }
	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
		flags |= TCL_INTERP_DESTROYED;
	    }
	    result = tracePtr->traceProc(tracePtr->clientData,
	    result = (*tracePtr->traceProc)(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.
		     */

		    DisposeTraceResult(tracePtr->flags, result);
		} else {
		    disposeFlags = tracePtr->flags;
		    code = TCL_ERROR;
		}
	    }
	    Tcl_Release(tracePtr);
	    Tcl_Release((ClientData) tracePtr);
	    if (code == TCL_ERROR) {
		goto done;
	    }
	}
    }

    /*
     * Invoke traces on the variable itself.
     */

    if (flags & TCL_TRACE_UNSETS) {
	flags |= TCL_TRACE_DESTROYED;
    }
    active.varPtr = varPtr;
    if (varPtr->flags & traceflags) {
	hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
	for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);
		tracePtr != NULL; tracePtr = active.nextTracePtr) {
	for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr);
	     tracePtr != NULL; tracePtr = active.nextTracePtr) {
	    active.nextTracePtr = tracePtr->nextPtr;
	    if (!(tracePtr->flags & flags)) {
		continue;
	    }
	    Tcl_Preserve(tracePtr);
	    Tcl_Preserve((ClientData) tracePtr);
	    if (state == NULL) {
		state = Tcl_SaveInterpState((Tcl_Interp *) iPtr, code);
		state = Tcl_SaveInterpState((Tcl_Interp *)iPtr, code);
	    }
	    if (Tcl_InterpDeleted((Tcl_Interp *)iPtr)) {
		flags |= TCL_INTERP_DESTROYED;
	    }
	    result = tracePtr->traceProc(tracePtr->clientData,
	    result = (*tracePtr->traceProc)(tracePtr->clientData,
		    (Tcl_Interp *) iPtr, part1, part2, flags);
	    if (result != NULL) {
		if (flags & TCL_TRACE_UNSETS) {
		    /*
		     * Ignore errors in unset traces.
		     */

		    DisposeTraceResult(tracePtr->flags, result);
		} else {
		    disposeFlags = tracePtr->flags;
		    code = TCL_ERROR;
		}
	    }
	    Tcl_Release(tracePtr);
	    Tcl_Release((ClientData) tracePtr);
	    if (code == TCL_ERROR) {
		goto done;
	    }
	}
    }

    /*
2746
2747
2748
2749
2750
2751
2752
2753

2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764

2765
2766
2767
2768
2769
2770
2771

2772
2773
2774
2775
2776

2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793

2794
2795
2796
2797
2798
2799
2800
2715
2716
2717
2718
2719
2720
2721

2722

2723
2724
2725
2726
2727
2728
2729
2730
2731

2732
2733
2734
2735
2736
2737
2738

2739
2740
2741
2742
2743

2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760

2761
2762
2763
2764
2765
2766
2767
2768







-
+
-









-
+






-
+




-
+
















-
+







		type = "array";
		break;
	    }

	    if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
		Tcl_SetObjResult((Tcl_Interp *)iPtr, (Tcl_Obj *) result);
	    } else {
		Tcl_SetObjResult((Tcl_Interp *)iPtr,
		Tcl_SetResult((Tcl_Interp *)iPtr, result, TCL_STATIC);
			Tcl_NewStringObj(result, -1));
	    }
	    Tcl_AddErrorInfo((Tcl_Interp *)iPtr, "");

	    Tcl_AppendObjToErrorInfo((Tcl_Interp *)iPtr, Tcl_ObjPrintf(
		    "\n    (%s trace on \"%s%s%s%s\")", type, part1,
		    (part2 ? "(" : ""), (part2 ? part2 : ""),
		    (part2 ? ")" : "") ));
	    if (disposeFlags & TCL_TRACE_RESULT_OBJECT) {
		TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb,
			TclGetString((Tcl_Obj *) result));
			Tcl_GetString((Tcl_Obj *) result));
	    } else {
		TclVarErrMsg((Tcl_Interp *) iPtr, part1, part2, verb, result);
	    }
	    iPtr->flags &= ~(ERR_ALREADY_LOGGED);
	    Tcl_DiscardInterpState(state);
	} else {
	    Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
	    (void) Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
	}
	DisposeTraceResult(disposeFlags,result);
    } else if (state) {
	if (code == TCL_OK) {
	    code = Tcl_RestoreInterpState((Tcl_Interp *) iPtr, state);
	    code = Tcl_RestoreInterpState((Tcl_Interp *)iPtr, state);
	} else {
	    Tcl_DiscardInterpState(state);
	}
    }

    if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	VarHashRefCount(arrayPtr)--;
    }
    if (copiedName) {
	Tcl_DStringFree(&nameCopy);
    }
    TclClearVarTraceActive(varPtr);
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    iPtr->activeVarTracePtr = active.nextPtr;
    Tcl_Release(iPtr);
    Tcl_Release((ClientData) iPtr);
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * DisposeTraceResult--
2816
2817
2818
2819
2820
2821
2822
2823

2824
2825
2826
2827

































2828
2829
2830
2831
2832
2833
2834
2784
2785
2786
2787
2788
2789
2790

2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835







-
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







DisposeTraceResult(
    int flags,			/* Indicates type of result to determine
				 * proper disposal method. */
    char *result)		/* The result returned from a trace function
				 * to be disposed. */
{
    if (flags & TCL_TRACE_RESULT_DYNAMIC) {
	Tcl_Free(result);
	ckfree(result);
    } else if (flags & TCL_TRACE_RESULT_OBJECT) {
	Tcl_DecrRefCount((Tcl_Obj *) result);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UntraceVar --
 *
 *	Remove a previously-created trace for a variable.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If there exists a trace for the variable given by varName with the
 *	given flags, proc, and clientData, then that trace is removed.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_UntraceVar
void
Tcl_UntraceVar(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *varName,	/* Name of variable; may end with "(index)" to
				 * signify an array reference. */
    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UntraceVar2 --
 *
 *	Remove a previously-created trace for a variable.
2853
2854
2855
2856
2857
2858
2859
2860

2861
2862
2863
2864
2865
2866
2867
2854
2855
2856
2857
2858
2859
2860

2861
2862
2863
2864
2865
2866
2867
2868







-
+







    int flags,			/* OR-ed collection of bits describing current
				 * trace, including any of TCL_TRACE_READS,
				 * TCL_TRACE_WRITES, TCL_TRACE_UNSETS,
				 * TCL_GLOBAL_ONLY, and TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    register VarTrace *tracePtr;
    VarTrace *prevPtr, *nextPtr;
    Var *varPtr, *arrayPtr;
    Interp *iPtr = (Interp *) interp;
    ActiveVarTrace *activePtr;
    int flagMask, allFlags = 0;
    Tcl_HashEntry *hPtr;

2885
2886
2887
2888
2889
2890
2891
2892
2893



2894
2895
2896
2897
2898
2899
2900
2886
2887
2888
2889
2890
2891
2892


2893
2894
2895
2896
2897
2898
2899
2900
2901
2902







-
-
+
+
+







    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif
    flags &= flagMask;

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
    for (tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
	    (char *) varPtr);
    for (tracePtr = (VarTrace *) Tcl_GetHashValue(hPtr), prevPtr = NULL; ;
	    prevPtr = tracePtr, tracePtr = tracePtr->nextPtr) {
	if (tracePtr == NULL) {
	    goto updateFlags;
	}
	if ((tracePtr->traceProc == proc) && (tracePtr->flags == flags)
		&& (tracePtr->clientData == clientData)) {
	    break;
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
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







-
+



















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	} else {
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	prevPtr->nextPtr = nextPtr;
    }
    tracePtr->nextPtr = NULL;
    Tcl_EventuallyFree(tracePtr, TCL_DYNAMIC);
    Tcl_EventuallyFree((ClientData) tracePtr, TCL_DYNAMIC);

    for (tracePtr = nextPtr; tracePtr != NULL;
	    tracePtr = tracePtr->nextPtr) {
	allFlags |= tracePtr->flags;
    }

  updateFlags:
    varPtr->flags &= ~VAR_ALL_TRACES;
    if (allFlags & VAR_ALL_TRACES) {
	varPtr->flags |= (allFlags & VAR_ALL_TRACES);
    } else if (TclIsVarUndefined(varPtr)) {
	/*
	 * If this is the last trace on the variable, and the variable is
	 * unset and unused, then free up the variable.
	 */

	TclCleanupVar(varPtr, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VarTraceInfo --
 *
 *	Return the clientData value associated with a trace on a variable.
 *	This function can also be used to step through all of the traces on a
 *	particular variable that have the same trace function.
 *
 * Results:
 *	The return value is the clientData value associated with a trace on
 *	the given variable. Information will only be returned for a trace with
 *	proc as trace function. If the clientData argument is NULL then the
 *	first such trace is returned; otherwise, the next relevant one after
 *	the one given by clientData will be returned. If the variable doesn't
 *	exist, or if there are no (more) traces for it, then NULL is returned.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_VarTraceInfo
ClientData
Tcl_VarTraceInfo(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *varName,	/* Name of variable; may end with "(index)" to
				 * signify an array reference. */
    int flags,			/* OR-ed combo or TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY (can be 0). */
    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc,
	    prevClientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_VarTraceInfo2 --
 *
 *	Same as Tcl_VarTraceInfo, except takes name in two pieces instead of
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
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
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







+














-
+
+


-
+


-
+







-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    Tcl_VarTraceProc *proc,	/* Function assocated with trace. */
    ClientData prevClientData)	/* If non-NULL, gives last value returned by
				 * this function, so this call will return the
				 * next trace after that one. If NULL, this
				 * call will return the first trace. */
{
    Interp *iPtr = (Interp *) interp;
    register VarTrace *tracePtr;
    Var *varPtr, *arrayPtr;
    Tcl_HashEntry *hPtr;

    varPtr = TclLookupVar(interp, part1, part2,
	    flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY), /*msg*/ NULL,
	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    if (varPtr == NULL) {
	return NULL;
    }

    /*
     * Find the relevant trace, if any, and return its clientData.
     */

    hPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
    hPtr = Tcl_FindHashEntry(&iPtr->varTraces,
	    (char *) varPtr);

    if (hPtr) {
	VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);
	tracePtr = Tcl_GetHashValue(hPtr);

	if (prevClientData != NULL) {
	    for (; tracePtr != NULL; tracePtr = tracePtr->nextPtr) {
	    for ( ;  tracePtr != NULL;  tracePtr = tracePtr->nextPtr) {
		if ((tracePtr->clientData == prevClientData)
			&& (tracePtr->traceProc == proc)) {
		    tracePtr = tracePtr->nextPtr;
		    break;
		}
	    }
	}
	for (; tracePtr != NULL ; tracePtr = tracePtr->nextPtr) {
	for (; tracePtr!=NULL ; tracePtr=tracePtr->nextPtr) {
	    if (tracePtr->traceProc == proc) {
		return tracePtr->clientData;
	    }
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TraceVar --
 *
 *	Arrange for reads and/or writes to a variable to cause a function to
 *	be invoked, which can monitor the operations and/or change their
 *	actions.
 *
 * Results:
 *	A standard Tcl return value.
 *
 * Side effects:
 *	A trace is set up on the variable given by varName, such that future
 *	references to the variable will be intermediated by proc. See the
 *	manual entry for complete details on the calling sequence for proc.
 *     The variable's flags are updated.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_TraceVar
int
Tcl_TraceVar(
    Tcl_Interp *interp,		/* Interpreter in which variable is to be
				 * traced. */
    const char *varName,	/* Name of variable; may end with "(index)" to
				 * signify an array reference. */
    int flags,			/* OR-ed collection of bits, including any of
				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TraceVar2 --
 *
 *	Arrange for reads and/or writes to a variable to cause a function to
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
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







-
+


-
+







-
+







				 * TCL_TRACE_READS, TCL_TRACE_WRITES,
				 * TCL_TRACE_UNSETS, TCL_GLOBAL_ONLY, and
				 * TCL_NAMESPACE_ONLY. */
    Tcl_VarTraceProc *proc,	/* Function to call when specified ops are
				 * invoked upon varName. */
    ClientData clientData)	/* Arbitrary argument to pass to proc. */
{
    VarTrace *tracePtr;
    register VarTrace *tracePtr;
    int result;

    tracePtr = (VarTrace *)Tcl_Alloc(sizeof(VarTrace));
    tracePtr = (VarTrace *) ckalloc(sizeof(VarTrace));
    tracePtr->traceProc = proc;
    tracePtr->clientData = clientData;
    tracePtr->flags = flags;

    result = TraceVarEx(interp, part1, part2, tracePtr);

    if (result != TCL_OK) {
	Tcl_Free(tracePtr);
	ckfree((char *) tracePtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
3104
3105
3106
3107
3108
3109
3110
3111

3112
3113

3114
3115
3116
3117
3118
3119
3120
3188
3189
3190
3191
3192
3193
3194

3195
3196

3197
3198
3199
3200
3201
3202
3203
3204







-
+

-
+







TraceVarEx(
    Tcl_Interp *interp,		/* Interpreter in which variable is to be
				 * traced. */
    const char *part1,		/* Name of scalar variable or array. */
    const char *part2,		/* Name of element within array; NULL means
				 * trace applies to scalar variable or array
				 * as-a-whole. */
    VarTrace *tracePtr)/* Structure containing flags, traceProc and
    register VarTrace *tracePtr)/* Structure containing flags, traceProc and
				 * clientData fields. Others should be left
				 * blank. Will be Tcl_Free()d (eventually) if
				 * blank. Will be ckfree()d (eventually) if
				 * this function returns TCL_OK, and up to
				 * caller to free if this function returns
				 * TCL_ERROR. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *arrayPtr;
    int flagMask, isNew;
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
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







-
-
+
+














-
+



-
+

-
+







    }

    /*
     * Check for a nonsense flag combination. Note that this is a Tcl_Panic()
     * because there should be no code path that ever sets both flags.
     */

    if ((tracePtr->flags & TCL_TRACE_RESULT_DYNAMIC)
	    && (tracePtr->flags & TCL_TRACE_RESULT_OBJECT)) {
    if ((tracePtr->flags&TCL_TRACE_RESULT_DYNAMIC)
	    && (tracePtr->flags&TCL_TRACE_RESULT_OBJECT)) {
	Tcl_Panic("bad result flag combination");
    }

    /*
     * Set up trace information.
     */

    flagMask = TCL_TRACE_READS | TCL_TRACE_WRITES | TCL_TRACE_UNSETS |
	  TCL_TRACE_ARRAY | TCL_TRACE_RESULT_DYNAMIC | TCL_TRACE_RESULT_OBJECT;
#ifndef TCL_REMOVE_OBSOLETE_TRACES
    flagMask |= TCL_TRACE_OLD_STYLE;
#endif
    tracePtr->flags = tracePtr->flags & flagMask;

    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, varPtr, &isNew);
    hPtr = Tcl_CreateHashEntry(&iPtr->varTraces, (char *) varPtr, &isNew);
    if (isNew) {
	tracePtr->nextPtr = NULL;
    } else {
	tracePtr->nextPtr = (VarTrace *)Tcl_GetHashValue(hPtr);
	tracePtr->nextPtr = (VarTrace *) Tcl_GetHashValue(hPtr);
    }
    Tcl_SetHashValue(hPtr, tracePtr);
    Tcl_SetHashValue(hPtr, (char *) tracePtr);

    /*
     * Mark the variable as traced so we know to call them.
     */

    varPtr->flags |= (tracePtr->flags & VAR_ALL_TRACES);

Changes to generic/tclUniData.c.

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
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







-
-
-
-
-
-
+
+
+
+
+
+






-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








static const unsigned short pageMap[] = {
    0, 32, 64, 96, 0, 128, 160, 192, 224, 256, 288, 320, 352, 384, 416,
    448, 224, 480, 512, 544, 576, 608, 640, 672, 704, 704, 736, 768, 800,
    832, 864, 896, 928, 960, 992, 224, 1024, 224, 1056, 224, 224, 1088,
    1120, 1152, 1184, 1216, 1248, 1280, 1312, 1344, 1376, 1408, 1344, 1344,
    1440, 1472, 1504, 1536, 1568, 1344, 1344, 1600, 1632, 1664, 1696, 1728,
    1760, 1792, 1824, 1856, 1888, 1920, 1952, 1984, 2016, 2048, 2080, 2112,
    2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432, 2464, 2496,
    2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816, 2848, 2880,
    2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168, 3200, 3232, 3264,
    3296, 1824, 3328, 3360, 3392, 1824, 3424, 3456, 3488, 3520, 3552, 3584,
    3616, 1824, 1344, 3648, 3680, 3712, 3744, 3776, 3808, 3840, 1344, 1344,
    1760, 1792, 1824, 1344, 1856, 1888, 1920, 1952, 1984, 2016, 2048, 2080,
    2112, 2144, 2176, 2208, 2240, 2272, 2304, 2336, 2368, 2400, 2432, 2464,
    2496, 2528, 2560, 2592, 2624, 2656, 2688, 2720, 2752, 2784, 2816, 2848,
    2880, 2912, 2944, 2976, 3008, 3040, 3072, 3104, 3136, 3168, 3200, 3232,
    3264, 3296, 3328, 3360, 3392, 3296, 3424, 3456, 3488, 3520, 3552, 3584,
    3616, 3296, 1344, 3648, 3680, 3712, 3744, 3776, 3808, 3840, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 3872, 1344, 3904, 3936,
    3968, 1344, 4000, 1344, 4032, 4064, 4096, 4128, 4128, 4160, 4192, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 4224, 4256, 1344, 1344, 4288, 4320, 4352,
    4384, 4416, 1344, 4448, 4480, 4512, 4544, 1344, 4576, 4608, 4640, 4672,
    1344, 4704, 4736, 4768, 4800, 4832, 1344, 4864, 4896, 4928, 4960, 1344,
    4992, 5024, 5056, 5088, 5120, 1824, 5152, 5184, 5216, 5248, 5280, 5312,
    4992, 5024, 5056, 5088, 5120, 3296, 5152, 5184, 5216, 5248, 5280, 5312,
    1344, 5344, 1344, 5376, 5408, 5440, 5472, 5504, 5536, 5568, 5600, 5632,
    5664, 5696, 5728, 5664, 704, 5760, 224, 224, 224, 224, 5792, 224, 224,
    224, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112, 6144,
    6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464, 6496, 6528,
    6560, 6592, 6592, 6592, 6592, 6592, 6592, 6592, 6592, 6624, 6656, 4928,
    6688, 6720, 6752, 6784, 6816, 4928, 6848, 6880, 6912, 6944, 6976, 7008,
    7040, 4928, 4928, 4928, 4928, 4928, 7072, 7104, 7136, 4928, 4928, 4928,
    7168, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7200, 7232, 4928, 7264,
    7296, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6592, 6592, 6592,
    6592, 7328, 6592, 7360, 7392, 6592, 6592, 6592, 6592, 6592, 6592, 6592,
    6592, 4928, 7424, 7456, 7488, 7520, 4928, 4928, 4928, 7552, 7584, 7616,
    7648, 224, 224, 224, 7680, 7712, 7744, 1344, 7776, 7808, 7840, 7840,
    704, 7872, 7904, 7936, 1824, 7968, 4928, 4928, 8000, 4928, 4928, 4928,
    4928, 4928, 4928, 8032, 8064, 8096, 8128, 3232, 1344, 8160, 4192, 1344,
    8192, 8224, 8256, 1344, 1344, 8288, 1344, 4928, 8320, 8352, 8384, 8416,
    4928, 8384, 8448, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    5664, 5696, 5728, 5664, 704, 704, 224, 224, 224, 224, 5760, 224, 224,
    224, 5792, 5824, 5856, 5888, 5920, 5952, 5984, 6016, 6048, 6080, 6112,
    6144, 6176, 6208, 6240, 6272, 6304, 6336, 6368, 6400, 6432, 6464, 6496,
    6528, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6560, 6592, 6624, 4928,
    6656, 6688, 6720, 6752, 6784, 4928, 6816, 6848, 6880, 6912, 6944, 6976,
    7008, 4928, 4928, 4928, 4928, 4928, 7040, 7072, 7104, 4928, 4928, 4928,
    7136, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 7168, 7200, 4928, 7232,
    7264, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 6560, 6560, 6560,
    6560, 7296, 6560, 7328, 7360, 6560, 6560, 6560, 6560, 6560, 6560, 6560,
    6560, 4928, 7392, 7424, 7456, 7488, 4928, 4928, 4928, 7520, 7552, 7584,
    7616, 224, 224, 224, 7648, 7680, 7712, 1344, 7744, 7776, 7808, 7808,
    704, 7840, 7872, 7904, 3296, 7936, 4928, 4928, 7968, 4928, 4928, 4928,
    4928, 4928, 4928, 8000, 8032, 8064, 8096, 3200, 1344, 8128, 4192, 1344,
    8160, 8192, 8224, 1344, 1344, 8256, 1344, 4928, 8288, 8320, 8352, 8384,
    4928, 8352, 8416, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
126
127
128
129
130
131
132
133

134
135
136
137
138
139
140
141






142
143
144
145
146
147
148
126
127
128
129
130
131
132

133
134
135






136
137
138
139
140
141
142
143
144
145
146
147
148







-
+


-
-
-
-
-
-
+
+
+
+
+
+







    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    8480, 8512, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 8448, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 8544, 4928, 8576, 5440, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 8608, 8640, 224, 8672, 8704, 1344, 1344, 8736, 8768, 8800, 224,
    8832, 8864, 8896, 8928, 8960, 8992, 9024, 1344, 9056, 9088, 9120, 9152,
    9184, 1632, 9216, 9248, 8480, 1952, 9280, 9312, 9344, 1344, 9376, 9408,
    9440, 1344, 9472, 9504, 9536, 9568, 9600, 9632, 9664, 9696, 9696, 1344,
    9728, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 8480, 4928, 8512, 5440, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 8544, 8576, 224, 8608, 8640, 1344, 1344, 8672, 8704, 8736, 224,
    8768, 8800, 8832, 8864, 8896, 8928, 8960, 1344, 8992, 9024, 9056, 9088,
    9120, 1632, 9152, 9184, 9216, 1920, 9248, 9280, 9312, 1344, 9344, 9376,
    9408, 1344, 9440, 9472, 9504, 9536, 9568, 9600, 9632, 9664, 9664, 1344,
    9696, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
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
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
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
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
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
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
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
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







+
+
+
+
+
+
-
+




-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+















-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 9728, 9760, 9792, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
    9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
    9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
    9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
    9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824,
    9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9824, 9856, 9856, 9856,
    1344, 1344, 9760, 9792, 9824, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9888, 9888, 9888,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888, 9888,
    9888, 9888, 9888, 9888, 9888, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 9920, 1344, 1344, 9952, 1824, 9984, 10016,
    10048, 1344, 1344, 10080, 10112, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 10144, 10176, 1344, 10208, 1344, 10240, 10272,
    10304, 10336, 10368, 10400, 1344, 1344, 1344, 10432, 10464, 64, 10496,
    10528, 10560, 4736, 10592, 10624
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856, 9856,
    9856, 9856, 9856, 9856, 9856, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 9888, 1344, 1344, 9920, 3296, 9952, 9984, 10016,
    1344, 1344, 10048, 10080, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272,
    10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496,
    10528, 4736, 10560, 10592
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
    ,10656, 10688, 10720, 1824, 1344, 1344, 1344, 10752, 10784, 10816,
    10848, 10880, 10912, 10944, 10976, 11008, 1824, 1824, 1824, 1824, 8480,
    1344, 11040, 11072, 1344, 11104, 11136, 11168, 11200, 1344, 11232,
    1824, 11264, 11296, 11328, 1344, 11360, 11392, 11424, 11456, 1344,
    11488, 1344, 11520, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 7808, 4704, 10240, 1824, 1824, 1824,
    1824, 11552, 11584, 11616, 11648, 4736, 11680, 1824, 11712, 11744,
    11776, 1824, 1824, 1344, 11808, 11840, 6912, 11872, 11904, 11936, 11968,
    12000, 1824, 12032, 12064, 1344, 12096, 12128, 12160, 12192, 12224,
    1824, 1824, 1344, 1344, 12256, 1824, 12288, 12320, 12352, 12384, 1344,
    ,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784,
    10816, 10848, 10880, 10912, 10944, 10976, 3296, 3296, 3296, 3296, 9216,
    1344, 11008, 11040, 1344, 11072, 11104, 11136, 11168, 1344, 11200,
    3296, 11232, 11264, 11296, 1344, 11328, 11360, 11392, 11424, 1344,
    11456, 1344, 11488, 11520, 11552, 3296, 3296, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 7776, 4704, 11584, 11616, 11648, 3296,
    3296, 11680, 11712, 11744, 11776, 4736, 11808, 3296, 11840, 11872,
    11904, 3296, 3296, 1344, 11936, 11968, 6880, 12000, 12032, 12064, 12096,
    12128, 3296, 12160, 12192, 1344, 12224, 12256, 12288, 12320, 12352,
    3296, 3296, 1344, 1344, 12384, 3296, 12416, 12448, 12480, 12512, 1344,
    12416, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 12448,
    1344, 12480, 1824, 1824, 12000, 12512, 12544, 1824, 1824, 10176, 12576,
    7808, 12608, 12640, 12672, 12704, 5280, 12736, 12768, 12800, 12832,
    12864, 12896, 12928, 5280, 12960, 12992, 13024, 13056, 13088, 1824,
    1824, 13120, 13152, 13184, 13216, 13248, 13280, 13312, 13344, 1824,
    1824, 1824, 1824, 1344, 13376, 13408, 13440, 1344, 13472, 13504, 1824,
    1824, 1824, 1824, 1824, 1344, 13536, 13568, 1824, 1344, 13600, 13632,
    12544, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12576,
    1344, 12608, 3296, 12640, 12128, 12672, 12704, 12736, 12768, 12736,
    12800, 7776, 12832, 12864, 12896, 12928, 5280, 12960, 12992, 13024,
    13056, 13088, 13120, 13152, 5280, 13184, 13216, 13248, 13280, 13312,
    13344, 3296, 13376, 13408, 13440, 13472, 13504, 13536, 13568, 13600,
    3296, 3296, 3296, 3296, 1344, 13632, 13664, 13696, 1344, 13728, 13760,
    13664, 1344, 13696, 13728, 1824, 4032, 13760, 1824, 1824, 1824, 1824,
    1824, 1824, 1344, 13792, 1824, 1824, 1824, 13824, 13856, 13888, 13920,
    13952, 13984, 1824, 1824, 14016, 14048, 14080, 14112, 14144, 14176,
    1344, 14208, 14240, 1344, 4608, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 14272, 14304, 14336, 14368, 14400, 14432, 1824, 1824, 14464,
    14496, 14528, 14560, 14592, 13728, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 14624, 1824, 1824, 1824, 1824, 1824, 14656, 14688,
    14720, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    3296, 3296, 3296, 3296, 3296, 1344, 13792, 13824, 3296, 1344, 13856,
    13888, 13920, 1344, 13952, 13984, 3296, 4032, 14016, 14048, 3296, 3296,
    3296, 3296, 3296, 1344, 14080, 3296, 3296, 3296, 14112, 14144, 14176,
    14208, 14240, 14272, 3296, 3296, 14304, 14336, 14368, 14400, 14432,
    14464, 1344, 14496, 14528, 1344, 4608, 14560, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 14592, 14624, 14656, 14688, 14720, 14752, 3296, 3296,
    14784, 14816, 14848, 14880, 14912, 13984, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 14944, 14976, 15008, 15040, 3296, 3296, 15072,
    15104, 15136, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 9952, 1824, 1824, 1824, 10848,
    10848, 10848, 14752, 1344, 1344, 1344, 1344, 1344, 1344, 14784, 1824,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 9920, 3296, 3296, 3296, 10816,
    10816, 10816, 15168, 1344, 1344, 1344, 1344, 1344, 1344, 15200, 3296,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12736, 1344, 1344,
    15232, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14816, 1824,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15264,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 14848,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4608, 4736,
    14880, 1824, 1824, 10176, 14912, 1344, 14944, 14976, 15008, 15040,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 13824, 13856,
    15072, 1824, 1824, 1824, 1344, 1344, 15104, 15136, 15168, 1824, 1824,
    15200, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    15296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 14048, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 4608, 4736, 15328, 1344, 4736, 15360, 15392, 1344, 15424, 15456,
    15488, 15520, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    14112, 14144, 15552, 3296, 3296, 3296, 1344, 1344, 15584, 15616, 15648,
    3296, 3296, 15680, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 15232, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 15712, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 4704, 1824, 12256, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 4736, 1824, 15264,
    15296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 9824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1344, 1344, 1344, 15328, 15360, 15392, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 8032, 4928, 15424, 4928, 15456, 15488, 15520, 4928, 15552,
    4928, 4928, 15584, 1824, 1824, 1824, 1824, 15616, 4928, 4928, 15648,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 4704, 3296, 12384, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 15744, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    15776, 15808, 15840, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 9792, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 1344, 1344, 1344, 15872, 15904, 15936, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 704, 15968, 16000, 4928, 4928, 4928, 16032, 3296, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 8000, 4928, 16064, 4928, 16096, 16128,
    16160, 4928, 6848, 4928, 4928, 16192, 3296, 3296, 3296, 16224, 16224,
    4928, 4928, 16256, 16288, 3296, 3296, 3296, 3296, 16320, 16352, 16384,
    15680, 1824, 1824, 1824, 1824, 15712, 15744, 15776, 15808, 15840, 15872,
    15904, 15936, 15968, 16000, 16032, 16064, 16096, 15712, 15744, 16128,
    16416, 16448, 16480, 16512, 16544, 16576, 16608, 16640, 16672, 16704,
    15808, 16160, 16192, 16224, 15936, 16256, 16288, 16320, 16352, 16384,
    16416, 16448, 16480, 16512, 16544, 16576, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 704,
    16608, 704, 16640, 16672, 16704, 1824, 1824, 1824, 1824, 1824, 1824,
    16320, 16352, 16736, 16416, 16768, 16800, 16832, 16544, 16864, 16896,
    16928, 16960, 16992, 17024, 17056, 17088, 17120, 17152, 17184, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 4928, 704, 17216, 704, 17248, 17280, 17312, 3296, 3296,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    16736, 16768, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 16800, 16832,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344,
    16864, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 17344, 17376, 3296,
    3296, 3296, 3296, 3296, 3296, 17408, 17440, 5664, 17472, 17504, 3296,
    3296, 3296, 1344, 17536, 17568, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 12736, 17600, 1344, 17632, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 12736,
    17664, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 17696, 1344, 1344, 1344, 1344, 1344, 1344, 17728, 3296, 17760,
    16896, 1824, 16928, 16960, 16992, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 17024, 6912, 17056, 1824, 1824,
    17088, 17120, 1824, 1824, 1824, 1824, 1824, 1824, 17152, 17184, 17216,
    17248, 17280, 17312, 1824, 17344, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 4928, 17376, 4928, 4928, 8000, 17408, 17440, 8032, 17472,
    4928, 4928, 4928, 4928, 17504, 1824, 17536, 17568, 17600, 17632, 17664,
    1824, 1824, 1824, 1824, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 17696,
    17792, 17824, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 17856, 6880, 17888, 3296, 3296, 17920, 17952, 3296,
    3296, 3296, 3296, 3296, 3296, 17984, 18016, 18048, 18080, 18112, 18144,
    3296, 18176, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 4928,
    18208, 4928, 4928, 7968, 18240, 18272, 8000, 18304, 4928, 4928, 4928,
    4928, 18336, 3296, 18368, 18400, 18432, 18464, 18496, 3296, 3296, 3296,
    3296, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 18528, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 17728,
    17760, 4928, 4928, 4928, 8000, 4928, 4928, 17792, 17824, 17376, 4928,
    17856, 4928, 17888, 17920, 1824, 1824, 4928, 4928, 4928, 17952, 4928,
    4928, 17984, 4928, 4928, 4928, 8000, 18016, 18048, 18080, 18112, 1824,
    4928, 4928, 4928, 4928, 18144, 4928, 6880, 18176, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    4928, 4928, 4928, 4928, 4928, 4928, 4928, 4928, 18560, 18592, 4928,
    4928, 4928, 18624, 4928, 4928, 18656, 18688, 18208, 4928, 18720, 4928,
    18752, 18784, 3296, 3296, 4928, 4928, 4928, 4928, 4928, 4928, 4928,
    4928, 4928, 4928, 7968, 18816, 18848, 18880, 18912, 18944, 4928, 4928,
    4928, 4928, 18976, 4928, 6848, 19008, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 3296, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 9920, 1344, 1344, 1344, 1344, 1344, 1344, 11328,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    19040, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 19072, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 11328, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296, 3296,
    3296, 3296, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1792, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15520
    
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 11360, 1824, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 18208, 1344, 1344, 1344,
    1344, 1344, 1344, 11360, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 18240, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    18272, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 11360, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824, 1824,
    1824, 1824, 1824, 1824, 1824, 1824, 1824, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
    1344, 1344, 1344, 1344, 1344, 1792
#endif /* TCL_UTF_MAX > 3 */
};

/*
 * The groupMap is indexed by combining the alternate page number with
 * the page offset and returns a group number that identifies a unique
 * set of character attributes.
641
642
643
644
645
646
647
648

649
650
651
652
653
654
655
653
654
655
656
657
658
659

660
661
662
663
664
665
666
667







-
+







    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 8, 93, 3, 93, 93, 3, 93, 93, 3, 93, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    15, 15, 15, 15, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17,
    17, 17, 17, 7, 7, 7, 3, 3, 4, 3, 3, 14, 14, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 3, 17, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15,
    93, 93, 93, 93, 93, 3, 17, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 15,
    93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 3, 15, 93, 93, 93, 93, 93, 93, 93, 17, 14, 93, 93, 93, 93,
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
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
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
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






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
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
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
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
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
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







-
-
-
-
+
+
-
-
-
+
+

+
+
-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+


-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+


-
-
+
+

-
-
+
+
-

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+

-
+
-
-
-
+
+

-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-


+
-
-
-
-
-
+
+
+
+
+

-
+



-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
+

+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-


-
-
+
+
-
-
+
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-
-
-
+
+
+


-
-
+
+


-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
+
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
+
+
+
+
+
+

-
+
-

-
+
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
+
-
+

-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+







    93, 93, 93, 93, 93, 93, 93, 93, 93, 92, 92, 14, 3, 3, 3, 92, 0, 0,
    93, 4, 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 92, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 92, 93, 93, 93, 92, 93, 93, 93, 93, 93, 0, 0, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 93, 93, 93, 0, 0, 3, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 17, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    15, 15, 0, 17, 17, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    17, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125,
    93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 93, 125, 93, 15, 125, 125, 125, 93, 93, 93, 93,
    93, 93, 93, 93, 125, 125, 125, 125, 93, 125, 125, 15, 93, 93, 93, 93,
    93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 3, 3, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 93, 15, 125, 125, 125,
    93, 93, 93, 93, 0, 0, 125, 125, 0, 0, 125, 125, 93, 15, 0, 0, 0, 0,
    0, 0, 0, 0, 125, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 93, 93, 0, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14,
    4, 15, 3, 93, 0, 0, 93, 93, 125, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0,
    0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 0, 15, 15, 0, 15, 15, 0, 0, 93, 0, 125, 125, 125, 93, 93,
    0, 0, 0, 0, 93, 93, 0, 0, 93, 93, 93, 0, 0, 0, 93, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 93, 93, 15, 15, 15, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93,
    93, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15,
    15, 15, 15, 93, 125, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 93,
    93, 93, 125, 125, 125, 125, 93, 125, 125, 15, 93, 93, 93, 93, 93, 93,
    93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 3, 3, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 3, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 93, 125, 125, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 0, 0, 0, 15, 15, 15, 15, 0, 0, 93, 15, 125, 125, 125, 93,
    93, 93, 93, 0, 0, 125, 125, 0, 0, 125, 125, 93, 15, 0, 0, 0, 0, 0,
    0, 0, 0, 125, 0, 0, 0, 0, 15, 15, 0, 15, 15, 15, 93, 93, 0, 0, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 4, 4, 18, 18, 18, 18, 18, 18, 14, 4,
    15, 3, 93, 0, 0, 93, 93, 125, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    15, 0, 15, 15, 0, 15, 15, 0, 0, 93, 0, 125, 125, 125, 93, 93, 0, 0,
    0, 0, 93, 93, 0, 0, 93, 93, 93, 0, 0, 0, 93, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 0, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 93, 93, 15, 15, 15, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93,
    125, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15,
    15, 15, 15, 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 0, 93,
    93, 125, 0, 125, 125, 93, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3,
    4, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 0, 93, 125, 125,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15,
    15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15,
    15, 15, 0, 0, 93, 15, 125, 125, 125, 93, 93, 93, 93, 93, 0, 93, 93,
    125, 0, 125, 125, 93, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 4,
    0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 0, 93, 125, 125, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15,
    15, 0, 0, 93, 15, 125, 93, 125, 93, 93, 93, 93, 0, 0, 125, 125, 0,
    0, 125, 125, 93, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 0, 0, 0, 0, 15,
    15, 0, 15, 15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14,
    15, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 0,
    15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0,
    0, 0, 15, 15, 0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    125, 125, 93, 125, 125, 0, 0, 0, 125, 125, 125, 0, 125, 125, 125, 93,
    0, 0, 15, 0, 0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14,
    14, 4, 14, 0, 0, 0, 0, 0, 93, 125, 125, 125, 93, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 93,
    93, 93, 125, 125, 125, 125, 0, 93, 93, 93, 0, 93, 93, 93, 93, 0, 0,
    0, 0, 0, 0, 0, 93, 93, 0, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 93, 93,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 3, 18, 18,
    18, 18, 18, 18, 18, 14, 15, 93, 125, 125, 3, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15,
    0, 0, 93, 15, 125, 93, 125, 93, 93, 93, 93, 0, 0, 125, 125, 0, 0, 125,
    125, 93, 0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 0, 0, 0, 0, 15, 15, 0, 15,
    15, 15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 14, 15, 18, 18,
    18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 0, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 0, 15, 15,
    0, 15, 0, 15, 15, 0, 0, 0, 15, 15, 0, 0, 0, 15, 15, 15, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 125, 125, 93,
    125, 125, 0, 0, 0, 125, 125, 125, 0, 125, 125, 125, 93, 0, 0, 15, 0,
    0, 0, 0, 0, 0, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 14, 14, 14, 14, 14, 14, 4, 14,
    0, 0, 0, 0, 0, 93, 125, 125, 125, 93, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 15, 93, 93, 93, 125,
    125, 125, 125, 0, 93, 93, 93, 0, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0,
    0, 93, 93, 0, 15, 15, 15, 0, 0, 15, 0, 0, 15, 15, 93, 93, 0, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 3, 18, 18, 18, 18,
    18, 18, 18, 14, 15, 93, 125, 125, 3, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 93, 125,
    125, 125, 125, 125, 0, 93, 125, 125, 0, 125, 125, 93, 93, 0, 0, 0,
    0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 15, 15, 0, 15, 15, 93, 93,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 125, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 93, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 0, 93, 15, 125, 93,
    125, 125, 125, 125, 125, 0, 93, 125, 125, 0, 125, 125, 93, 93, 0, 0,
    0, 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 15, 93, 93,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 93, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 15, 125, 125,
    125, 93, 93, 93, 93, 0, 125, 125, 125, 0, 125, 125, 125, 93, 15, 14,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 15, 125,
    125, 125, 93, 93, 93, 93, 0, 125, 125, 125, 0, 125, 125, 125, 93, 15,
    14, 0, 0, 0, 0, 15, 15, 15, 125, 18, 18, 18, 18, 18, 18, 18, 15, 15,
    15, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 14, 15, 15, 15, 15, 15, 15, 0, 93, 125, 125, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 0, 0,
    0, 0, 125, 125, 125, 93, 93, 93, 0, 93, 0, 125, 125, 125, 125, 125,
    0, 0, 0, 0, 15, 15, 15, 125, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15,
    93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 14, 15, 15, 15, 15, 15, 15, 0, 93, 125, 125, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    125, 125, 125, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
    125, 125, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, 93, 93, 93,
    93, 93, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93,
    93, 93, 93, 93, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 0, 15, 0, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 93, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 0,
    0, 15, 15, 15, 15, 15, 0, 92, 0, 93, 93, 93, 93, 93, 93, 93, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 15, 15, 15, 15, 15, 14, 14, 14, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 3, 14, 14, 14, 93, 93,
    14, 14, 14, 14, 14, 14, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 14, 93, 14, 93, 14, 93, 5, 6, 5, 6, 125, 125,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 0, 0, 0,
    0, 125, 125, 125, 93, 93, 93, 0, 93, 0, 125, 125, 125, 125, 125, 125,
    125, 125, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 125,
    125, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 93, 93, 93,
    15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93, 93, 93, 93, 93,
    93, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 92, 93, 93, 93, 93, 93,
    93, 93, 93, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 0, 0, 0, 0, 0, 15,
    15, 0, 15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 15, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 15, 0, 0, 15, 15, 15, 15, 15, 0, 92, 0,
    93, 93, 93, 93, 93, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 15,
    15, 15, 15, 15, 14, 14, 14, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 14, 3, 14, 14, 14, 93, 93, 14, 14, 14, 14, 14, 14, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 93, 14,
    93, 14, 93, 5, 6, 5, 6, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 125, 93, 93, 93, 93, 93, 3, 93, 93, 15, 15, 15, 15, 15, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93,
    3, 93, 93, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 93, 14, 14, 14, 14, 14, 14, 0, 14, 14, 3, 3, 3,
    3, 3, 14, 14, 14, 14, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93,
    93, 93, 125, 93, 93, 125, 125, 93, 93, 15, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 15,
    15, 15, 15, 93, 93, 93, 15, 125, 125, 125, 15, 15, 125, 125, 125, 125,
    125, 125, 125, 15, 15, 15, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 93, 125, 125, 93, 93, 125, 125, 125, 125,
    125, 125, 93, 15, 125, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 125, 125, 125,
    93, 14, 14, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
    93, 93, 93, 93, 93, 0, 14, 14, 14, 14, 14, 14, 14, 14, 93, 14, 14,
    14, 14, 14, 14, 0, 14, 14, 3, 3, 3, 3, 3, 14, 14, 14, 14, 3, 3, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 93,
    93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 125, 93, 93, 125, 125, 93,
    93, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 15, 15, 15,
    15, 15, 15, 125, 125, 93, 93, 15, 15, 15, 15, 93, 93, 93, 15, 125,
    125, 125, 15, 15, 125, 125, 125, 125, 125, 125, 125, 15, 15, 15, 93,
    93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93,
    125, 125, 93, 93, 125, 125, 125, 125, 125, 125, 93, 15, 125, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 125, 125, 125, 93, 14, 14, 126, 126, 126, 126,
    126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
    126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126,
    126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 126, 0,
    126, 0, 0, 0, 0, 0, 126, 0, 0, 127, 127, 127, 127, 127, 127, 127, 127,
    126, 126, 126, 126, 126, 126, 0, 126, 0, 0, 0, 0, 0, 126, 0, 0, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127, 127,
    127, 127, 127, 127, 127, 127, 127, 3, 92, 127, 127, 127, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    3, 92, 127, 127, 127, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
    15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15,
    15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 93, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    0, 0, 0, 0, 0, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    0, 0, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128, 128,
    128, 128, 128, 128, 128, 128, 128, 128, 128, 105, 105, 105, 105, 105,
    105, 0, 0, 111, 111, 111, 111, 111, 111, 0, 0, 8, 15, 15, 15, 15, 15,
    128, 128, 105, 105, 105, 105, 105, 105, 0, 0, 111, 111, 111, 111, 111,
    111, 0, 0, 8, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 14, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 3, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 2, 15,
    15, 15, 15, 15, 15, 15, 15, 2, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    5, 6, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3,
    129, 129, 129, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 5, 6, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 3, 3, 3, 129, 129, 129, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
    15, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 3,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    15, 15, 0, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 125, 125, 125, 125, 125, 125,
    125, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    3, 3, 3, 92, 3, 3, 3, 4, 15, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0,
    0, 0, 0, 3, 3, 3, 3, 3, 3, 8, 3, 3, 3, 3, 93, 93, 93, 17, 0, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 92, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 125, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 93, 93, 125, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 0, 93, 93, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 93, 93, 93, 93, 93, 93,
    93, 125, 125, 125, 125, 125, 125, 125, 125, 93, 125, 125, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 92, 3, 3, 3, 4, 15, 93, 0,
    0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 8, 3, 3,
    3, 3, 93, 93, 93, 17, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 93, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 93, 93, 15, 15, 15, 15, 15, 15,
    93, 93, 93, 125, 125, 125, 125, 93, 93, 125, 125, 125, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 15, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    125, 125, 93, 125, 125, 125, 125, 125, 125, 93, 93, 93, 0, 0, 0, 0,
    14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 93, 93, 93, 125, 125, 125, 125,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 0, 0, 0,
    93, 93, 125, 125, 125, 0, 0, 0, 0, 125, 125, 93, 125, 125, 125, 125,
    125, 125, 93, 93, 93, 0, 0, 0, 0, 14, 0, 0, 0, 3, 3, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    18, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 125, 93, 0, 0, 3,
    3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    93, 93, 125, 125, 93, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 125, 93, 93,
    15, 15, 15, 15, 15, 125, 93, 125, 93, 93, 93, 93, 93, 93, 93, 0, 93,
    125, 93, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 125, 125,
    125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 92, 3, 3, 3, 3, 3, 3, 0, 0,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 120, 93, 93,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 125, 15, 15, 15, 15, 15, 15,
    93, 93, 93, 93, 93, 0, 93, 125, 93, 125, 125, 93, 93, 93, 93, 93, 93,
    93, 93, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 0, 0, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 92,
    3, 3, 3, 3, 3, 3, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 120, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93,
    93, 93, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 93, 93, 93, 93, 125, 93, 125,
    125, 125, 125, 125, 93, 125, 125, 15, 15, 15, 15, 15, 15, 15, 0, 0,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 93, 93, 125, 15, 15, 15, 15,
    93, 125, 93, 93, 93, 93, 93, 125, 93, 125, 125, 125, 125, 125, 93,
    125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 3, 3, 3, 3, 3, 3, 3, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 3, 3, 0, 93, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 93, 93, 125, 125,
    93, 93, 125, 93, 93, 93, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 93, 125, 125,
    125, 93, 125, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3,
    3, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 93, 93,
    93, 93, 93, 93, 93, 93, 125, 125, 93, 93, 0, 0, 0, 3, 3, 3, 3, 3, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92,
    92, 92, 92, 92, 3, 3, 130, 131, 132, 133, 133, 134, 135, 136, 137,
    15, 15, 15, 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 93, 93, 93,
    15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 93, 125, 93, 93, 125, 125, 125, 93, 125, 93, 93, 93,
    125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 125,
    125, 125, 125, 125, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93,
    125, 125, 93, 93, 0, 0, 0, 3, 3, 3, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 0, 0, 0, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 92, 92, 92, 92, 3, 3, 130,
    131, 132, 133, 133, 134, 135, 136, 137, 0, 0, 0, 0, 0, 0, 0, 138, 138,
    0, 0, 0, 0, 0, 0, 0, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138,
    138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138,
    138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138,
    138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 0,
    138, 138, 138, 138, 138, 0, 0, 138, 138, 138, 3, 3, 3, 3, 3, 3, 3,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 3, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15,
    15, 93, 15, 15, 15, 15, 15, 15, 93, 15, 15, 125, 93, 93, 15, 0, 0,
    0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    0, 138, 138, 138, 3, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 93,
    93, 93, 3, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125,
    93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15,
    15, 93, 15, 15, 125, 93, 93, 15, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92, 92, 92,
    21, 21, 21, 21, 21, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 92, 139, 21, 21, 21, 140, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 141, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 139, 21, 21,
    21, 140, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 141, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 92, 92,
    21, 21, 21, 21, 92, 92, 92, 92, 92, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 0, 93, 93, 93, 93, 93, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21,
    142, 21, 21, 143, 21, 144, 144, 144, 144, 144, 144, 144, 144, 145,
    145, 145, 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 0,
    0, 145, 145, 145, 145, 145, 145, 0, 0, 144, 144, 144, 144, 144, 144,
    144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 144, 144, 144, 144,
    144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145, 144, 144,
    144, 144, 144, 144, 0, 0, 145, 145, 145, 145, 145, 145, 0, 0, 21, 144,
    21, 144, 21, 144, 21, 144, 0, 145, 0, 145, 0, 145, 0, 145, 144, 144,
    144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145, 145, 145,
    146, 146, 147, 147, 147, 147, 148, 148, 149, 149, 150, 150, 151, 151,
    0, 0, 144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152,
    152, 152, 152, 144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152,
    152, 152, 152, 152, 152, 144, 144, 144, 144, 144, 144, 144, 144, 152,
    152, 152, 152, 152, 152, 152, 152, 144, 144, 21, 153, 21, 0, 21, 21,
    145, 145, 154, 154, 155, 11, 156, 11, 11, 11, 21, 153, 21, 0, 21, 21,
    157, 157, 157, 157, 155, 11, 11, 11, 144, 144, 21, 21, 0, 0, 21, 21,
    145, 145, 158, 158, 0, 11, 11, 11, 144, 144, 21, 21, 21, 114, 21, 21,
    145, 145, 159, 159, 118, 11, 11, 11, 0, 0, 21, 153, 21, 0, 21, 21,
    160, 160, 161, 161, 155, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
    17, 17, 17, 17, 17, 8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20,
    5, 16, 3, 3, 3, 3, 3, 3, 3, 3, 162, 163, 17, 17, 17, 17, 17, 2, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5,
    6, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 2, 17, 17, 17, 17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17,
    17, 17, 18, 92, 0, 0, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 92, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 0, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4,
    4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
    4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 120, 120, 120, 120, 93, 120, 120,
    120, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 108, 14, 14, 14, 14, 108, 14,
    14, 21, 108, 108, 108, 21, 21, 108, 108, 108, 21, 14, 108, 14, 14,
    7, 108, 108, 108, 108, 108, 14, 14, 14, 14, 14, 14, 108, 14, 164, 14,
    108, 14, 165, 166, 108, 108, 14, 21, 108, 108, 167, 108, 21, 15, 15,
    15, 15, 21, 14, 14, 21, 21, 108, 108, 7, 7, 7, 7, 7, 108, 21, 21, 21,
    21, 14, 7, 14, 14, 168, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 169, 169, 169, 169, 169, 169, 169, 169, 169,
    169, 169, 169, 169, 169, 169, 169, 170, 170, 170, 170, 170, 170, 170,
    170, 170, 170, 170, 170, 170, 170, 170, 170, 129, 129, 129, 23, 24,
    129, 129, 129, 129, 18, 14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14,
    14, 14, 14, 7, 7, 14, 14, 14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14,
    14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 7, 7, 14, 14, 7, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    92, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 21, 21, 21, 21, 21, 142, 21, 21, 143, 21,
    144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145, 145, 145,
    145, 145, 144, 144, 144, 144, 144, 144, 0, 0, 145, 145, 145, 145, 145,
    145, 0, 0, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145, 145, 145,
    145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 144, 144, 145, 145,
    145, 145, 145, 145, 145, 145, 144, 144, 144, 144, 144, 144, 0, 0, 145,
    145, 145, 145, 145, 145, 0, 0, 21, 144, 21, 144, 21, 144, 21, 144,
    0, 145, 0, 145, 0, 145, 0, 145, 144, 144, 144, 144, 144, 144, 144,
    144, 145, 145, 145, 145, 145, 145, 145, 145, 146, 146, 147, 147, 147,
    147, 148, 148, 149, 149, 150, 150, 151, 151, 0, 0, 144, 144, 144, 144,
    144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152, 144, 144,
    144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152, 152, 152,
    144, 144, 144, 144, 144, 144, 144, 144, 152, 152, 152, 152, 152, 152,
    152, 152, 144, 144, 21, 153, 21, 0, 21, 21, 145, 145, 154, 154, 155,
    11, 156, 11, 11, 11, 21, 153, 21, 0, 21, 21, 157, 157, 157, 157, 155,
    11, 11, 11, 144, 144, 21, 21, 0, 0, 21, 21, 145, 145, 158, 158, 0,
    11, 11, 11, 144, 144, 21, 21, 21, 114, 21, 21, 145, 145, 159, 159,
    118, 11, 11, 11, 0, 0, 21, 153, 21, 0, 21, 21, 160, 160, 161, 161,
    155, 11, 11, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 17, 17, 17, 17, 17,
    8, 8, 8, 8, 8, 8, 3, 3, 16, 20, 5, 16, 16, 20, 5, 16, 3, 3, 3, 3, 3,
    3, 3, 3, 162, 163, 17, 17, 17, 17, 17, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    16, 20, 3, 3, 3, 3, 12, 12, 3, 3, 3, 7, 5, 6, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 7, 3, 12, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 2, 17, 17, 17,
    17, 17, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 18, 92, 0, 0, 18,
    18, 18, 18, 18, 18, 7, 7, 7, 5, 6, 92, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 7, 7, 7, 5, 6, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 0, 0, 0, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
    4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 120, 120, 120, 120, 93, 120, 120, 120, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 14, 14, 108, 14, 14, 14, 14, 108, 14, 14, 21, 108, 108, 108,
    21, 21, 108, 108, 108, 21, 14, 108, 14, 14, 7, 108, 108, 108, 108,
    108, 14, 14, 14, 14, 14, 14, 108, 14, 164, 14, 108, 14, 165, 166, 108,
    108, 14, 21, 108, 108, 167, 108, 21, 15, 15, 15, 15, 21, 14, 14, 21,
    21, 108, 108, 7, 7, 7, 7, 7, 108, 21, 21, 21, 21, 14, 7, 14, 14, 168,
    14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169, 169,
    169, 169, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170, 170,
    170, 170, 170, 170, 129, 129, 129, 23, 24, 129, 129, 129, 129, 18,
    14, 14, 0, 0, 0, 0, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 7, 7, 14, 14,
    14, 14, 7, 14, 14, 7, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 7, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 7,
    14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14,
    14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 14, 14, 14, 14,
    14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 7, 7, 14, 14, 14, 14, 14, 14, 14, 5, 6, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 171, 171, 171, 171, 171, 171,
    171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171,
    171, 171, 171, 171, 171, 171, 172, 172, 172, 172, 172, 172, 172, 172,
    172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172,
    172, 172, 172, 172, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7,
    7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 5, 6, 7, 7, 7, 7,
    171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171,
    171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 171, 172, 172,
    172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 172,
    172, 172, 172, 172, 172, 172, 172, 172, 172, 172, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5,
    6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 5, 6, 5, 6,
    5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7,
    7, 7, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 5, 6, 5,
    6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 5, 6, 5, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7,
    7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    7, 7, 7, 7, 7, 7, 7, 5, 6, 7, 7, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 14, 14, 7, 7, 7, 7, 7, 7, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 123, 123,
    0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123,
    123, 123, 123, 0, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 123, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124, 124,
    124, 124, 124, 124, 124, 124, 124, 124, 124, 0, 23, 24, 173, 174, 175,
    176, 177, 23, 24, 23, 24, 23, 24, 178, 179, 180, 181, 21, 23, 24, 21,
    23, 24, 21, 21, 21, 21, 21, 92, 92, 182, 182, 23, 24, 23, 24, 21, 14,
    14, 14, 14, 14, 14, 23, 24, 23, 24, 93, 93, 93, 23, 24, 0, 0, 0, 0,
    0, 3, 3, 3, 3, 18, 3, 3, 183, 183, 183, 183, 183, 183, 183, 183, 183,
    124, 124, 124, 124, 124, 23, 24, 173, 174, 175, 176, 177, 23, 24, 23,
    24, 23, 24, 178, 179, 180, 181, 21, 23, 24, 21, 23, 24, 21, 21, 21,
    21, 21, 92, 92, 182, 182, 23, 24, 23, 24, 21, 14, 14, 14, 14, 14, 14,
    23, 24, 23, 24, 93, 93, 93, 23, 24, 0, 0, 0, 0, 0, 3, 3, 3, 3, 18,
    3, 3, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
    183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
    183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183,
    183, 0, 183, 0, 0, 0, 0, 0, 183, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 0, 0, 92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20,
    3, 3, 3, 16, 20, 3, 16, 20, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8,
    3, 16, 20, 3, 3, 16, 20, 5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 92,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 3, 3, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 14, 14, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 183, 0, 183, 0, 0,
    0, 0, 0, 183, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    92, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
    15, 15, 15, 15, 0, 3, 3, 16, 20, 16, 20, 3, 3, 3, 16, 20, 3, 16, 20,
    3, 3, 3, 3, 3, 3, 3, 3, 3, 8, 3, 3, 8, 3, 16, 20, 3, 3, 16, 20, 5,
    6, 5, 6, 5, 6, 5, 6, 3, 3, 3, 3, 3, 92, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    3, 8, 8, 3, 3, 3, 3, 8, 3, 5, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    14, 14, 3, 3, 3, 5, 6, 5, 6, 5, 6, 5, 6, 8, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
    2, 3, 3, 3, 14, 92, 15, 129, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14,
    5, 6, 5, 6, 5, 6, 5, 6, 8, 5, 6, 6, 14, 129, 129, 129, 129, 129, 129,
    129, 129, 129, 93, 93, 93, 93, 125, 125, 8, 92, 92, 92, 92, 92, 14,
    14, 129, 129, 129, 92, 15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93,
    93, 11, 11, 92, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3,
    92, 92, 92, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 2, 3, 3, 3, 14, 92, 15,
    129, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6, 14, 14, 5, 6, 5, 6, 5, 6, 5, 6,
    8, 5, 6, 6, 14, 129, 129, 129, 129, 129, 129, 129, 129, 129, 93, 93,
    93, 93, 125, 125, 8, 92, 92, 92, 92, 92, 14, 14, 129, 129, 129, 92,
    15, 3, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 93, 93, 11, 11, 92, 92,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 92, 92, 92, 15, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14,
    18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 14, 14, 18, 18, 18, 18, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18,
    18, 18, 18, 18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 15,
    18, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 15, 93, 120, 120, 120, 3, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 3, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 92, 92, 93, 93, 15, 15, 15, 15, 15, 15, 129, 129, 129, 129,
    129, 129, 129, 129, 129, 129, 93, 93, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 3,
    3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 15, 93, 120, 120, 120, 3, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 3, 92, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92,
    92, 93, 93, 15, 15, 15, 15, 15, 15, 129, 129, 129, 129, 129, 129, 129,
    129, 129, 129, 93, 93, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 11,
    0, 0, 0, 0, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
    11, 11, 11, 11, 11, 11, 11, 11, 11, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 11, 11, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24,
    21, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 21,
    21, 21, 21, 21, 21, 21, 21, 23, 24, 23, 24, 184, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 92, 11, 11, 23, 24, 185, 21, 15, 23, 24, 23, 24,
    186, 21, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 187, 188, 189, 190, 187, 21, 191, 192, 193, 194,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 0, 0, 23, 24, 195,
    196, 197, 23, 24, 23, 24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
    11, 11, 11, 11, 11, 92, 92, 92, 92, 92, 92, 92, 92, 92, 11, 11, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 21, 21, 23, 24,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 92, 21, 21, 21, 21, 21,
    21, 21, 21, 23, 24, 23, 24, 184, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 92, 11, 11, 23, 24, 185, 21, 15, 23, 24, 23, 24, 186, 21, 23, 24,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23,
    24, 187, 188, 189, 190, 187, 21, 191, 192, 193, 194, 23, 24, 23, 24,
    23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 23, 24, 195, 196, 197, 23,
    24, 23, 24, 0, 0, 0, 0, 0, 23, 24, 0, 21, 0, 21, 23, 24, 23, 24, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 23, 24, 15, 92, 92, 21, 15, 15, 15, 15, 15, 15, 15,
    93, 15, 15, 15, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125,
    125, 93, 93, 125, 14, 14, 14, 14, 93, 0, 0, 0, 18, 18, 18, 18, 18,
    18, 14, 14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0,
    0, 0, 0, 0, 0, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 92, 92, 23, 24, 15, 92, 92, 21, 15, 15, 15, 15, 15, 15, 15, 93,
    15, 15, 15, 93, 15, 15, 15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125,
    93, 93, 125, 14, 14, 14, 14, 93, 0, 0, 0, 18, 18, 18, 18, 18, 18, 14,
    14, 4, 14, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 0, 0, 0, 0, 0,
    0, 0, 0, 125, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 125, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15,
    15, 15, 3, 3, 3, 15, 3, 15, 15, 93, 15, 15, 15, 15, 15, 15, 93, 93,
    93, 93, 93, 93, 93, 93, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 93, 125, 125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 125,
    125, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 0, 92, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 93, 92, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93,
    125, 125, 93, 93, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 93, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 0, 0, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 14,
    14, 14, 15, 125, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 93, 15, 93, 93, 93, 15, 15, 93, 93, 15,
    15, 15, 15, 15, 93, 93, 15, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 92, 3, 3, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 125, 125, 3, 3, 15, 92,
    92, 125, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 198, 21, 21, 21, 21, 21, 21, 21, 11, 92, 92, 92, 92,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 92, 11, 11, 0, 0, 0, 0, 199, 199,
    15, 15, 15, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15,
    3, 3, 3, 15, 3, 15, 15, 93, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93,
    93, 93, 93, 93, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 125,
    125, 93, 93, 93, 93, 125, 125, 93, 93, 125, 125, 125, 3, 3, 3, 3, 3,
    3, 3, 3, 3, 3, 3, 3, 3, 0, 92, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
    0, 0, 3, 3, 15, 15, 15, 15, 15, 93, 92, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 15, 15, 15, 15, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93,
    125, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 93, 15, 15,
    15, 15, 15, 15, 15, 15, 93, 125, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9,
    0, 0, 3, 3, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 92, 15, 15, 15, 15, 15, 15, 14, 14, 14, 15, 125, 93, 125,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 93, 15, 93, 93, 93, 15, 15, 93, 93, 15, 15, 15, 15, 15, 93, 93,
    15, 93, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 15, 92, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 125, 93, 93, 125, 125, 3, 3, 15, 92, 92, 125, 93, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
    15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 0, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 198, 21,
    21, 21, 21, 21, 21, 21, 11, 92, 92, 92, 92, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 92, 11, 11, 0, 0, 0, 0, 199, 199, 199, 199, 199, 199, 199,
    199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
    199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
    199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199,
    199, 199, 199, 199, 15, 15, 15, 125, 125, 93, 125, 125, 93, 125, 125,
    3, 125, 93, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 199, 15,
    15, 15, 125, 125, 93, 125, 125, 93, 125, 125, 3, 125, 93, 0, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    15, 15, 0, 0, 0, 0, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200,
    200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200,
    200, 200, 200, 200, 200, 200, 200, 200, 201, 201, 201, 201, 201, 201,
    200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200, 200,
    200, 200, 200, 200, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201,
    201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201,
    201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 201, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
    201, 201, 201, 201, 201, 201, 201, 201, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15,
    93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15,
    15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    0, 0, 0, 0, 0, 21, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 15, 93, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 7, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 0, 15, 0, 15, 15, 0, 15, 15,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11,
    11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 11, 11, 11, 11, 11, 11,
    11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 6, 5, 14,
    15, 6, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 0, 0, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 5,
    6, 3, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6, 5, 6,
    5, 6, 5, 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3, 0, 3,
    3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4, 3, 3,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 0, 0, 0, 0, 0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 4, 14, 14, 14, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3,
    3, 3, 5, 6, 3, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 3, 8, 8, 12, 12, 5, 6, 5, 6, 5, 6, 5, 6,
    5, 6, 5, 6, 5, 6, 5, 6, 3, 3, 5, 6, 3, 3, 3, 3, 12, 12, 12, 3, 3, 3,
    0, 3, 3, 3, 3, 8, 5, 6, 5, 6, 5, 6, 3, 3, 3, 7, 8, 7, 7, 7, 0, 3, 4,
    3, 3, 0, 0, 0, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17, 0,
    3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 5,
    7, 6, 7, 5, 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 17,
    0, 3, 3, 3, 4, 3, 3, 3, 5, 6, 3, 7, 3, 8, 3, 3, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 3, 3, 7, 7, 7, 3, 11, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    5, 7, 6, 7, 5, 6, 3, 5, 6, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 15, 15,
    15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15,
    15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14, 7,
    7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 92, 92, 0, 0, 15,
    15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15,
    15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14,
    7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14,
    0, 0
#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
    ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
1217
1218
1219
1220
1221
1222
1223
1224
1225












1226
1227
1228
1229
1230
1231
1232
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







-
-
+
+
+
+
+
+
+
+
+
+
+
+







    202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202,
    202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202, 202,
    202, 202, 202, 202, 0, 0, 0, 0, 203, 203, 203, 203, 203, 203, 203,
    203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203,
    203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203, 203,
    203, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 204, 204, 204,
    204, 204, 204, 204, 204, 204, 204, 204, 0, 204, 204, 204, 204, 204,
    204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 0, 204, 204, 204,
    204, 204, 204, 204, 0, 204, 204, 0, 205, 205, 205, 205, 205, 205, 205,
    205, 205, 205, 205, 0, 205, 205, 205, 205, 205, 205, 205, 205, 205,
    205, 205, 205, 205, 205, 205, 0, 205, 205, 205, 205, 205, 205, 205,
    0, 205, 205, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92,
    92, 92, 92, 0, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 0, 0, 15,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 0, 0, 15,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 3, 18, 18, 18, 18, 18, 18, 18, 18, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 14, 14, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0,
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
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







-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
-
-
+
-
-
-
-







    103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103,
    103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 103, 0, 0, 0,
    0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 15, 15, 15, 15, 93, 93, 93, 93,
    0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0,
    0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 93, 93, 8, 0, 0, 15, 15, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18,
    15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 18, 18, 18, 18, 3, 3, 3, 3, 3, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 93, 125, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93,
    18, 18, 18, 18, 18, 18, 18, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 18, 18, 18, 18,
    3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 93, 93, 93, 93, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 18, 18,
    18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 125, 93, 125, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 3, 3, 3,
    3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93,
    93, 125, 125, 93, 93, 3, 3, 17, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 17, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 0, 0, 0, 0, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 93, 15, 15, 93, 93, 15, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 125, 125, 93, 93, 3, 3,
    17, 3, 3, 3, 3, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 0, 0, 0, 0, 0, 0, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 125,
    93, 93, 93, 93, 93, 93, 93, 93, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 3,
    3, 3, 3, 15, 125, 125, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 93, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 93, 93, 93, 0, 9,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 3, 3, 3, 3, 15, 125, 125, 15, 0, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 3, 3, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 125, 125, 15, 15, 15, 15, 3, 3, 3, 3, 93, 93, 93,
    93, 3, 125, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 15, 3, 15, 3, 3, 3, 0,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 93, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125,
    125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 15, 15, 15,
    15, 3, 3, 3, 3, 93, 93, 93, 93, 3, 125, 93, 9, 9, 9, 9, 9, 9, 9, 9,
    15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 125, 125, 93, 125, 93, 93,
    3, 3, 3, 3, 3, 3, 93, 15, 15, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    9, 9, 15, 3, 15, 3, 3, 3, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93,
    93, 125, 125, 93, 125, 93, 93, 3, 3, 3, 3, 3, 3, 93, 0, 15, 15, 15,
    15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 3, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 93, 125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93,
    0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 93,
1337
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
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
1439
1440



1441
1442

1443
1444
1445

1446
1447
1448
1449
1450
1451
1452
1364
1365
1366
1367
1368
1369
1370

1371
1372
1373
1374
1375




1376
1377
1378
1379
1380









1381
1382
1383
1384
1385
1386
1387
1388
1389
1390












1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461














1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484



1485
1486
1487
1488

1489
1490


1491
1492
1493
1494
1495
1496
1497
1498







-
+



+
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
















+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
+

-
-
+







    3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 15, 15, 15, 15, 93, 93, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    125, 125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 125, 125, 93, 125, 93,
    93, 3, 3, 3, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 93, 125, 93, 125, 125, 93, 93, 93,
    93, 93, 93, 125, 93, 15, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9,
    93, 93, 93, 125, 93, 15, 3, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 125, 125, 93, 93, 93, 93, 125, 93, 93, 93, 93, 93, 0, 0, 0, 0,
    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 3, 3, 3, 14, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 125, 93, 93, 3, 0, 0, 0, 0, 10, 10, 10, 10, 10, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 10, 13, 13, 13, 13, 13, 13, 13, 13,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125,
    125, 125, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 3, 0, 0,
    0, 0, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 125, 125,
    125, 0, 125, 125, 0, 0, 93, 93, 125, 93, 15, 125, 15, 125, 93, 3, 3,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 9, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 15, 0, 0,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 125, 125, 125, 125, 125, 125, 0, 125, 125, 0, 0, 93, 93, 125, 93,
    15, 125, 15, 125, 93, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9,
    9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    125, 125, 125, 93, 93, 93, 93, 0, 0, 93, 93, 125, 125, 125, 125, 93,
    15, 3, 15, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 125, 15, 93, 93,
    93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 93, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93,
    93, 93, 93, 93, 93, 125, 125, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 125, 93, 93, 3, 3, 3, 15, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 125, 125, 125, 93, 93, 93, 93, 0, 0, 93,
    93, 125, 125, 125, 125, 93, 15, 3, 15, 125, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93,
    93, 93, 93, 125, 15, 93, 93, 93, 93, 3, 3, 3, 3, 3, 3, 3, 3, 93, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 93, 93, 93, 93, 93, 93, 125, 125, 93, 93,
    93, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 125, 93, 93, 3, 3, 3, 15,
    3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 3, 3, 3, 3, 3,
    3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93, 93,
    93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 125, 93, 15, 3, 3, 3, 3,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 125, 93, 93,
    93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 125, 93, 15, 3, 3, 3,
    3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 0, 0, 0, 3, 3, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 0, 125, 93, 93, 93, 93, 93, 93, 93, 125,
    93, 93, 125, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15,
    15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93, 93, 0, 0, 0,
    93, 0, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 15, 93, 0, 0, 0, 0, 0,
    0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15,
    15, 15, 15, 0, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 125, 125, 125, 125, 125, 0, 93, 93, 0, 125, 125, 93,
    125, 93, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 125, 125, 3, 3, 0,
    0, 0, 0, 0, 0, 0, 93, 93, 15, 125, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 125, 125, 93, 93, 93, 93, 93, 0, 0, 0, 125,
    125, 93, 125, 93, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 9, 9, 9, 9,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 14,
    14, 14, 14, 14, 14, 14, 4, 4, 4, 4, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 3, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129,
    129, 129, 129, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 17, 17, 17, 17, 17, 17, 17, 17, 17, 0, 0, 0,
    0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0,
    93, 93, 93, 93, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93,
    93, 93, 3, 3, 3, 3, 3, 14, 14, 14, 14, 92, 92, 92, 92, 3, 14, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 18, 18, 18,
    18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 3,
    3, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 0, 0, 0, 93, 15, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 4, 4, 4, 4, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 129, 129, 129, 129, 129, 129, 129, 129,
    129, 129, 129, 129, 129, 129, 129, 0, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 3, 3, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
    17, 17, 17, 17, 17, 93, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 93, 93, 93, 93, 93, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    93, 93, 93, 93, 93, 93, 93, 3, 3, 3, 3, 3, 14, 14, 14, 14, 92, 92,
    92, 92, 3, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 0, 18, 18, 18, 18, 18, 18, 18, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 3, 3, 3, 3, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 0, 0, 0, 93, 15, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125, 125,
    125, 125, 125, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3, 92, 93, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 14, 93, 93, 3, 17, 17, 17, 17, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    125, 125, 125, 125, 125, 125, 125, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93,
    93, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 3,
    92, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 125, 125, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, 92, 92,
    92, 0, 92, 92, 92, 92, 92, 92, 92, 0, 92, 92, 0, 15, 15, 15, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 0, 0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 14, 93, 93, 3, 17,
    17, 17, 17, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 0, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 125, 125, 93, 93, 93, 14, 14, 14, 125, 125, 125, 125, 125, 125,
    17, 17, 17, 17, 17, 17, 17, 17, 93, 93, 93, 93, 93, 93, 93, 93, 14,
    14, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 125, 125, 93, 93, 93, 14,
    14, 14, 125, 125, 125, 125, 125, 125, 17, 17, 17, 17, 17, 17, 17, 17,
    93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 93, 93, 93, 93, 93, 93, 93,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93, 93, 93, 93,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 14, 14, 93, 93, 93, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 93, 93, 93, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 108, 108,
    108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108, 108,
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524























1525
1526
1527
1528
1529
1530
1531







1532
1533
1534


1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
1596
1597
1598
1599




1600
1601
1602
1603
1604
1605
1606
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
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
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







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
+
-
-
-
+
-
-
-
-
+
-
-
+
-
-
-
+
-

-
-
-
-
+
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
+
+







    9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 14, 14, 14, 14, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 14, 14, 14, 14, 14, 14, 14,
    14, 93, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 93,
    14, 14, 3, 3, 3, 3, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 93,
    93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 93,
    93, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 92, 92, 92, 92, 92, 92, 92,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 15, 14, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0,
    0, 0, 0, 4, 15, 15, 15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 93, 93, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 204, 204,
    93, 93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 15, 21, 21, 21, 21, 21, 21, 21,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0,
    0, 21, 21, 21, 21, 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 93, 93, 93, 93, 93, 93, 93, 0, 93, 93, 93, 93,
    93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 93, 0, 0, 93, 93, 93,
    93, 93, 93, 93, 0, 93, 93, 0, 93, 93, 93, 93, 93, 0, 0, 0, 0, 0, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92,
    92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 92, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 93, 93, 93, 93,
    93, 93, 93, 92, 92, 92, 92, 92, 92, 92, 0, 0, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 15, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 93,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9,
    9, 9, 9, 0, 0, 0, 0, 0, 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 92, 93, 93, 93, 93, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0,
    0, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15,
    15, 15, 15, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 93, 93, 93, 93,
    93, 93, 93, 0, 0, 0, 0, 0, 0, 0, 0, 0, 206, 206, 206, 206, 206, 206,
    204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204,
    204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204, 204,
    204, 204, 204, 204, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205,
    205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 205,
    205, 205, 205, 205, 205, 205, 205, 205, 205, 205, 93, 93, 93, 93, 93,
    93, 93, 92, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3,
    3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18,
    206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
    206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206, 206,
    207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
    207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207, 207,
    207, 207, 207, 207, 207, 207, 93, 93, 93, 93, 93, 93, 93, 92, 0, 0,
    0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 14, 18, 18, 18, 4, 18, 18, 18, 18, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 14, 18, 18, 18, 4, 18, 18, 18, 18, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0,
    15, 15, 0, 15, 0, 0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    0, 15, 15, 15, 15, 0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0,
    15, 0, 15, 0, 15, 0, 15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15,
    0, 15, 0, 15, 0, 15, 0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15,
    0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 14, 18, 18,
    18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 0, 0, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 0, 15, 0,
    0, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
    0, 15, 0, 15, 0, 0, 0, 0, 0, 0, 15, 0, 0, 0, 0, 15, 0, 15, 0, 15, 0,
    15, 15, 15, 0, 15, 15, 0, 15, 0, 0, 15, 0, 15, 0, 15, 0, 15, 0, 15,
    0, 15, 15, 0, 15, 0, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15,
    15, 0, 15, 15, 15, 15, 0, 15, 15, 15, 15, 0, 15, 0, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 15, 15, 15, 0, 15, 15, 15,
    15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 18, 18, 18, 18, 18, 18, 18, 18,
    18, 18, 18, 18, 18, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14,
    14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 11, 11, 11, 11, 11,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0,
    0, 0, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0,
    0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0,
    0, 0, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14,
    14, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14,
    14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 14, 14,
    11, 11, 11, 11, 11, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0,
    0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14,
    14, 14, 14, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 14, 14,
    14, 14, 14, 0, 0, 0, 14, 14, 14, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14, 14,
    0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14,
    14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 0, 0, 0, 0, 0, 0, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    
#endif /* TCL_UTF_MAX > 3 */
};

/*
 * Each group represents a unique set of character attributes.  The attributes
 * are encoded into a 32-bit value as follows:
 *
1638
1639
1640
1641
1642
1643
1644
1645

1646
1647
1648
1649

1650
1651
1652
1653
1654
1655
1656
1695
1696
1697
1698
1699
1700
1701

1702
1703
1704
1705

1706
1707
1708
1709
1710
1711
1712
1713







-
+



-
+







    -21886, -25470, -32638, -28542, -32126, -1981, -2174, -18879,
    -2237, 1844610, -21951, -25535, -28607, -32703, -32191, 13, 14,
    -1924287, -2145983, -2115007, 7233, 7298, 4170, 4234, 6749, 6813,
    -2750143, -976319, -2746047, 2763650, 2762882, -2759615, -2751679,
    -2760383, -2760127, -2768575, 1859714, -9044927, -10823615, -12158,
    -10830783, -10833599, -10832575, -10830015, -10817983, -10824127,
    -10818751, 237633, -12223, -10830527, -9058239, 237698, 9949314,
    18, 17, 10305, 10370, 8769, 8834
    18, 17, 10305, 10370, 10049, 10114, 8769, 8834
};

#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x31360)
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
#else
#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
#endif

/*
 * The following constants are used to determine the category of a
 * Unicode character.

Changes to generic/tclUtf.c.

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
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







-
+








-
-
+
+
-
-









-
+
+










-
+
-
-
+

-
+

-
-





+





-
+












-
-
+
+








+



+







 * Unicode characters less than this value are represented by themselves in
 * UTF-8 strings.
 */

#define UNICODE_SELF	0x80

/*
 * The following structures are used when mapping between Unicode and
 * The following structures are used when mapping between Unicode (UCS-2) and
 * UTF-8.
 */

static const unsigned char totalBytes[256] = {
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
/* Tcl_UtfCharComplete() might point to 2nd byte of valid 4-byte sequence */
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
/* End of "continuation byte section" */
    2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
#if TCL_UTF_MAX > 3
    4,4,4,4,4,
#else
    1,1,1,1,1,
#endif
    1,1,1,1,1,1,1,1,1,1,1
};


#if TCL_UTF_MAX > 3
static const unsigned char complete[256] = {
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
/* Tcl_UtfCharComplete() might point to 2nd byte of valid 4-byte sequence */
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
/* End of "continuation byte section" */
    2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,1,1,1,1,1,1,1,1,1,1,1
#if TCL_UTF_MAX > 3
    4,4,4,4,4,
};
#else
    3,3,3,3,3,
#   define complete totalBytes
#endif
    1,1,1,1,1,1,1,1,1,1,1
};

/*
 * Functions used only in this module.
 */

static int		UtfCount(int ch);
static int		Invalid(const char *src);

/*
 *---------------------------------------------------------------------------
 *
 * TclUtfCount --
 * UtfCount --
 *
 *	Find the number of bytes in the Utf character "ch".
 *
 * Results:
 *	The return values is the number of bytes in the Utf character "ch".
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

size_t
TclUtfCount(
static INLINE int
UtfCount(
    int ch)			/* The Unicode character whose size is returned. */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	return 1;
    }
    if (ch <= 0x7FF) {
	return 2;
    }
#if TCL_UTF_MAX > 3
    if (((unsigned)(ch - 0x10000) <= 0xFFFFF)) {
	return 4;
    }
#endif
    return 3;
}

/*
 *---------------------------------------------------------------------------
 *
 * Invalid --
165
166
167
168
169
170
171

172
173




174
175
176

177
178
179
180
181
182
183
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187







+


+
+
+
+


-
+








static const unsigned char bounds[28] = {
    0x80, 0x80,		/* \xC0 accepts \x80 only */
    0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF,
    0x80, 0xBF,		/* (\xC4 - \xDC) -- all sequences valid */
    0xA0, 0xBF,	/* \xE0\x80 through \xE0\x9F are invalid prefixes */
    0x80, 0xBF, 0x80, 0xBF, 0x80, 0xBF, /* (\xE4 - \xEC) -- all valid */
#if TCL_UTF_MAX > 3
    0x90, 0xBF,	/* \xF0\x80 through \xF0\x8F are invalid prefixes */
    0x80, 0x8F  /* \xF4\x90 and higher are invalid prefixes */
#else
    0xC0, 0xBF,	/* Not used, but reject all again for safety. */
    0xC0, 0xBF	/* Not used, but reject all again for safety. */
#endif
};

static int
static INLINE int
Invalid(
    const char *src)	/* Points to lead byte of a UTF-8 byte sequence */
{
    unsigned char byte = UCHAR(*src);
    int index;

    if ((byte & 0xC3) == 0xC0) {
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-










-
+






-
+












-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+







-
-
-
-
-
-
-
-
-
+
-







 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharToUtf --
 *
 *	Store the given Tcl_UniChar as a sequence of UTF-8 bytes in the
 *	provided buffer. Equivalent to Plan 9 runetochar().
 *
 *	Special handling of Surrogate pairs is handled as follows:
 *	When this function is called for ch being a high surrogate,
 *	the first byte of the 4-byte UTF-8 sequence is produced and
 *	the function returns 1. Calling the function again with a
 *	low surrogate, the remaining 3 bytes of the 4-byte UTF-8
 *	sequence is produced, and the function returns 3. The buffer
 *	is used to remember the high surrogate between the two calls.
 *
 *	If no low surrogate follows the high surrogate (which is actually
 *	illegal), this can be handled reasonably by calling Tcl_UniCharToUtf
 *	again with ch = -1. This will produce a 3-byte UTF-8 sequence
 *	representing the high surrogate.
 *
 * Results:
 *	The return values is the number of bytes in the buffer that were
 *	consumed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
INLINE int
Tcl_UniCharToUtf(
    int ch,			/* The Tcl_UniChar to be stored in the
				 * buffer. */
    char *buf)			/* Buffer in which the UTF-8 representation of
				 * the Tcl_UniChar is stored. Buffer must be
				 * large enough to hold the UTF-8 character
				 * (at most 4 bytes). */
				 * (at most TCL_UTF_MAX bytes). */
{
    if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
	buf[0] = (char) ch;
	return 1;
    }
    if (ch >= 0) {
	if (ch <= 0x7FF) {
	    buf[1] = (char) ((ch | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 6) | 0xC0);
	    return 2;
	}
	if (ch <= 0xFFFF) {
	    if ((ch & 0xF800) == 0xD800) {
		if (ch & 0x0400) {
		    /* Low surrogate */
		    if (((buf[0] & 0xC0) == 0x80) && ((buf[1] & 0xCF) == 0)) {
			/* Previous Tcl_UniChar was a high surrogate, so combine */
			buf[2] = (char) ((ch & 0x3F) | 0x80);
			buf[1] |= (char) (((ch >> 6) & 0x0F) | 0x80);
			return 3;
		    }
	    goto three;
	}
		    /* Previous Tcl_UniChar was not a high surrogate, so just output */
		} else {
		    /* High surrogate */
		    ch += 0x40;
		    /* Fill buffer with specific 3-byte (invalid) byte combination,
		       so following low surrogate can recognize it and combine */
		    buf[2] = (char) ((ch << 4) & 0x30);
		    buf[1] = (char) (((ch >> 2) & 0x3F) | 0x80);
		    buf[0] = (char) (((ch >> 8) & 0x07) | 0xF0);
		    return 1;
		}

	    }
	    goto three;
	}
#if TCL_UTF_MAX > 3
	if (ch <= 0x10FFFF) {
	    buf[3] = (char) ((ch | 0x80) & 0xBF);
	    buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[1] = (char) (((ch >> 12) | 0x80) & 0xBF);
	    buf[0] = (char) ((ch >> 18) | 0xF0);
	    return 4;
	}
    } else if (ch == -1) {
	if (((buf[0] & 0xC0) == 0x80) && ((buf[1] & 0xCF) == 0)
		&& ((buf[-1] & 0xF8) == 0xF0)) {
	    ch = 0xD7C0 + ((buf[-1] & 0x07) << 8) + ((buf[0] & 0x3F) << 2)
		    + ((buf[1] & 0x30) >> 4);
	    buf[1] = (char) ((ch | 0x80) & 0xBF);
	    buf[0] = (char) (((ch >> 6) | 0x80) & 0xBF);
	    buf[-1] = (char) ((ch >> 12) | 0xE0);
	    return 2;
#endif
	}
    }

    ch = 0xFFFD;
three:
    buf[2] = (char) ((ch | 0x80) & 0xBF);
    buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF);
    buf[0] = (char) ((ch >> 12) | 0xE0);
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
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
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







-


-
-
+
+
+



-
+

-
+


-
+
+


-
-
-
-
-
-
-
-
-
-
-

-
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
-



-
+


-
+


-
+


-
+



-
+
-
-



-
-
-
-
+
-







 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#undef Tcl_UniCharToUtfDString
char *
Tcl_UniCharToUtfDString(
    const int *uniStr,	/* Unicode string to convert to UTF-8. */
    size_t uniLength,		/* Length of Unicode string. */
    const Tcl_UniChar *uniStr,	/* Unicode string to convert to UTF-8. */
    int uniLength,		/* Length of Unicode string in Tcl_UniChars
				 * (must be >= 0). */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const int *w, *wEnd;
    const Tcl_UniChar *w, *wEnd;
    char *p, *string;
    size_t oldLength;
    int oldLength;

    /*
     * UTF-8 string length in bytes will be <= Unicode string length * 4.
     * UTF-8 string length in bytes will be <= Unicode string length *
     * TCL_UTF_MAX.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength == TCL_INDEX_NONE) {
	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }
    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * TCL_UTF_MAX);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;
    for (w = uniStr; w < wEnd; ) {
	p += Tcl_UniCharToUtf(*w, p);
	w++;
    }
    Tcl_DStringSetLength(dsPtr, oldLength + (p - string));

    return string;
}

char *
Tcl_Char16ToUtfDString(
    const unsigned short *uniStr,/* Utf-16 string to convert to UTF-8. */
    size_t uniLength,		/* Length of Utf-16 string. */
    Tcl_DString *dsPtr)		/* UTF-8 representation of string is appended
				 * to this previously initialized DString. */
{
    const unsigned short *w, *wEnd;
    char *p, *string;
    size_t oldLength;
    int len = 1;

    /*
     * UTF-8 string length in bytes will be <= Utf16 string length * 3.
     */

    if (uniStr == NULL) {
	return NULL;
    }
    if (uniLength == TCL_INDEX_NONE) {

	uniLength = 0;
	w = uniStr;
	while (*w != '\0') {
	    uniLength++;
	    w++;
	}
    }
    oldLength = Tcl_DStringLength(dsPtr);
    Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 3);
    string = Tcl_DStringValue(dsPtr) + oldLength;

    p = string;
    wEnd = uniStr + uniLength;
    for (w = uniStr; w < wEnd; ) {
	if (!len && ((*w & 0xFC00) != 0xDC00)) {
	    /* Special case for handling high surrogates. */
	    p += Tcl_UniCharToUtf(-1, p);
	}
	len = Tcl_UniCharToUtf(*w, p);
	p += len;
	if ((*w >= 0xD800) && (len < 3)) {
	    len = 0; /* Indication that high surrogate was found */
	}
	w++;
    }
    if (!len) {
	/* Special case for handling high surrogates. */
	p += Tcl_UniCharToUtf(-1, p);
    }
    Tcl_DStringSetLength(dsPtr, oldLength + (p - string));

    return string;
}
/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfToUniChar --
 *
 *	Extract the Tcl_UniChar represented by the UTF-8 string. Bad UTF-8
 *	sequences are converted to valid Tcl_UniChars and processing
 *	continues. Equivalent to Plan 9 chartorune().
 *
 *	The caller must ensure that the source buffer is long enough that this
 *	routine does not run off the end and dereference non-existent memory
 *	looking for trail bytes. If the source buffer is known to be '\0'
 *	terminated, this cannot happen. Otherwise, the caller should call
 *	Tcl_UtfCharComplete() before calling this routine to ensure that
 *	enough bytes remain in the string.
 *
 *	If TCL_UTF_MAX <= 3, special handling of Surrogate pairs is done:
 *	For any UTF-8 string containing a character outside of the BMP, the
 *	first call to this function will fill *chPtr with the high surrogate
 *	and generate a return value of 1. Calling Tcl_UtfToUniChar again
 *	will produce the low surrogate and a return value of 3. Because *chPtr
 *	is used to remember whether the high surrogate is already produced, it
 *	is recommended to initialize the variable it points to as 0 before
 *	the first call to Tcl_UtfToUniChar is done.
 *
 * Results:
 *	*chPtr is filled with the Tcl_UniChar, and the return value is the
 *	number of bytes from the UTF-8 string that were consumed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static const unsigned short cp1252[32] = {
  0x20AC,   0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
  0x02C6, 0x2030, 0x0160, 0x2039, 0x0152,   0x8D, 0x017D,   0x8F,
    0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
   0x2DC, 0x2122, 0x0161, 0x203A, 0x0153,   0x9D, 0x017E, 0x0178
};

#undef Tcl_UtfToUniChar
int
Tcl_UtfToUniChar(
    const char *src,	/* The UTF-8 string. */
    int *chPtr)/* Filled with the Unicode character represented by
    Tcl_UniChar *chPtr)/* Filled with the Tcl_UniChar represented by
				 * the UTF-8 string. */
{
    int byte;
    Tcl_UniChar byte;

    /*
     * Unroll 1 to 4 byte UTF-8 sequences.
     * Unroll 1 to 3 (or 4) byte UTF-8 sequences.
     */

    byte = *((unsigned char *) src);
    byte = UCHAR(*src);
    if (byte < 0xC0) {
	/*
	 * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
	 * Treats naked trail bytes 0x80 to 0x9F as valid characters from
	 * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid
	 * the cp1252 table. See: <https://en.wikipedia.org/wiki/UTF-8>
	 * Also treats \0 and other naked trail bytes 0xA0 to 0xBF as valid
	 * characters representing themselves.
	 */

	if ((unsigned)(byte-0x80) < (unsigned)0x20) {
	    *chPtr = cp1252[byte-0x80];
	} else {
	    *chPtr = byte;
	*chPtr = byte;
	}
	return 1;
    } else if (byte < 0xE0) {
	if ((src[1] & 0xC0) == 0x80) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
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







+

















-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    }
#if TCL_UTF_MAX > 3
    else if (byte < 0xF5) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
	    /*
	     * Four-byte-character lead byte followed by three trail bytes.
	     */
	    *chPtr = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
		    | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F));
	    if ((unsigned)(*chPtr - 0x10000) <= 0xFFFFF) {
		return 4;
	    }
	}

	/*
	 * A four-byte-character lead-byte not followed by three trail-bytes
	 * represents itself.
	 */
    }

#endif
    *chPtr = byte;
    return 1;
}

int
Tcl_UtfToChar16(
    const char *src,	/* The UTF-8 string. */
    unsigned short *chPtr)/* Filled with the Tcl_UniChar represented by
				 * the UTF-8 string. This could be a surrogate too. */
{
    unsigned short byte;

    /*
     * Unroll 1 to 4 byte UTF-8 sequences.
     */

    byte = UCHAR(*src);
    if (byte < 0xC0) {
	/*
	 * Handles properly formed UTF-8 characters between 0x01 and 0x7F.
	 * Treats naked trail bytes 0x80 to 0x9F as valid characters from
	 * the cp1252 table. See: <https://en.wikipedia.org/wiki/UTF-8>
	 * Also treats \0 and other naked trail bytes 0xA0 to 0xBF as valid
	 * characters representing themselves.
	 */

	/* If *chPtr contains a high surrogate (produced by a previous
	 * Tcl_UtfToUniChar() call) and the next 3 bytes are UTF-8 continuation
	 * bytes, then we must produce a follow-up low surrogate. We only
	 * do that if the high surrogate matches the bits we encounter.
	 */
	if (((byte & 0xC0) == 0x80)
		&& ((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)
		&& (((((byte - 0x10) << 2) & 0xFC) | 0xD800) == (*chPtr & 0xFCFC))
		&& ((src[1] & 0xF0) == (((*chPtr << 4) & 0x30) | 0x80))) {
	    *chPtr = ((src[1] & 0x0F) << 6) + (src[2] & 0x3F) + 0xDC00;
	    return 3;
	}
	if ((unsigned)(byte-0x80) < (unsigned)0x20) {
	    *chPtr = cp1252[byte-0x80];
	} else {
	    *chPtr = byte;
	}
	return 1;
    } else if (byte < 0xE0) {
	if ((src[1] & 0xC0) == 0x80) {
	    /*
	     * Two-byte-character lead-byte followed by a trail-byte.
	     */

	    *chPtr = (((byte & 0x1F) << 6) | (src[1] & 0x3F));
	    if ((unsigned)(*chPtr - 1) >= (UNICODE_SELF - 1)) {
		return 2;
	    }
	}

	/*
	 * A two-byte-character lead-byte not followed by trail-byte
	 * represents itself.
	 */
    } else if (byte < 0xF0) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
	    /*
	     * Three-byte-character lead byte followed by two trail bytes.
	     */

	    *chPtr = (((byte & 0x0F) << 12)
		    | ((src[1] & 0x3F) << 6) | (src[2] & 0x3F));
	    if (*chPtr > 0x7FF) {
		return 3;
	    }
	}

	/*
	 * A three-byte-character lead-byte not followed by two trail-bytes
	 * represents itself.
	 */
    }
    else if (byte < 0xF5) {
	if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) {
	    /*
	     * Four-byte-character lead byte followed by at least two trail bytes.
	     * We don't test the validity of 3th trail byte, see [ed29806ba]
	     */
	    Tcl_UniChar high = (((byte & 0x07) << 8) | ((src[1] & 0x3F) << 2)
		    | ((src[2] & 0x3F) >> 4)) - 0x40;
	    if (high < 0x400) {
		/* produce high surrogate, advance source pointer */
		*chPtr = 0xD800 + high;
		return 1;
	    }
	    /* out of range, < 0x10000 or > 0x10FFFF */
	}

	/*
	 * A four-byte-character lead-byte not followed by three trail-bytes
	 * represents itself.
	 */
    }

    *chPtr = byte;
    return 1;
}

/*
 *---------------------------------------------------------------------------
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
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
756
757
758



759
760
761
762
763
764
765
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







-
+
-


-
+





-
+

-
+

-
+

-
+

-
-
-
-
+











-
-
+
+




-
+

-
-
+
+

-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+







 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#undef Tcl_UtfToUniCharDString
Tcl_UniChar *
int *
Tcl_UtfToUniCharDString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    size_t length,			/* Length of UTF-8 string in bytes, or -1 for
    int length,			/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    int ch = 0, *w, *wString;
    Tcl_UniChar *w, *wString;
    const char *p;
    size_t oldLength;
    int oldLength;
    /* Pointer to the end of string. Never read endPtr[0] */
    const char *endPtr = src + length;
    const char *endPtr;
    /* Pointer to last byte where optimization still can be used */
    const char *optPtr = endPtr - TCL_UTF_MAX;
    const char *optPtr;

    if (src == NULL) {
	return NULL;
    }
    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	length = strlen(src);
    }

    /*
     * Unicode string length in Tcl_UniChars will be <= UTF-8 string length in
     * bytes.
     */

    oldLength = Tcl_DStringLength(dsPtr);

    Tcl_DStringSetLength(dsPtr,
	    oldLength + ((length + 1) * sizeof(int)));
    wString = (int *) (Tcl_DStringValue(dsPtr) + oldLength);
	    oldLength + ((length + 1) * sizeof(Tcl_UniChar)));
    wString = (Tcl_UniChar *) (Tcl_DStringValue(dsPtr) + oldLength);

    w = wString;
    p = src;
    endPtr = src + length;
    optPtr = endPtr - 4;
    optPtr = endPtr - ((TCL_UTF_MAX > 3) ? 4 : 3) ;
    while (p <= optPtr) {
	p += TclUtfToUCS4(p, &ch);
	*w++ = ch;
	p += TclUtfToUniChar(p, w);
	w++;
    }
    while ((p < endPtr) && TclUCS4Complete(p, endPtr-p)) {
	p += TclUtfToUCS4(p, &ch);
	*w++ = ch;
    }
    while (p < endPtr) {
	*w++ = UCHAR(*p++);
    }
    *w = '\0';
    Tcl_DStringSetLength(dsPtr,
	    oldLength + ((char *) w - (char *) wString));

    return wString;
}

unsigned short *
Tcl_UtfToChar16DString(
    const char *src,		/* UTF-8 string to convert to Unicode. */
    size_t length,			/* Length of UTF-8 string in bytes, or -1 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Unicode representation of string is
				 * appended to this previously initialized
				 * DString. */
{
    unsigned short ch = 0, *w, *wString;
    const char *p;
    size_t oldLength;
    /* Pointer to the end of string. Never read endPtr[0] */
    const char *endPtr = src + length;
    /* Pointer to last byte where optimization still can be used */
    const char *optPtr = endPtr - TCL_UTF_MAX;

    if (src == NULL) {
	return NULL;
    }
    if (length == TCL_INDEX_NONE) {
	length = strlen(src);
    }

    /*
     * Unicode string length in WCHARs will be <= UTF-8 string length in
     * bytes.
     */

    oldLength = Tcl_DStringLength(dsPtr);

    Tcl_DStringSetLength(dsPtr,
	    oldLength + ((length + 1) * sizeof(unsigned short)));
    wString = (unsigned short *) (Tcl_DStringValue(dsPtr) + oldLength);

    w = wString;
    p = src;
    endPtr = src + length;
    optPtr = endPtr - 3;
    while (p <= optPtr) {
	p += Tcl_UtfToChar16(p, &ch);
	*w++ = ch;
    }
    while (p < endPtr) {
	if (TclChar16Complete(p, endPtr-p)) {
	    p += Tcl_UtfToChar16(p, &ch);
	    *w++ = ch;
	if (Tcl_UtfCharComplete(p, endPtr-p)) {
	    p += TclUtfToUniChar(p, w);
	    w++;
	} else {
	    *w++ = UCHAR(*p++);
	}
    }
    *w = '\0';
    Tcl_DStringSetLength(dsPtr,
	    oldLength + ((char *) w - (char *) wString));
786
787
788
789
790
791
792
793

794
795
796
797
798
799
800
503
504
505
506
507
508
509

510
511
512
513
514
515
516
517







-
+







 *---------------------------------------------------------------------------
 */

int
Tcl_UtfCharComplete(
    const char *src,		/* String to check if first few bytes contain
				 * a complete UTF-8 character. */
    size_t length)			/* Length of above string in bytes. */
    int length)			/* Length of above string in bytes. */
{
    return length >= complete[UCHAR(*src)];
}

/*
 *---------------------------------------------------------------------------
 *
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
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







-
+


-
-
+
+

-
-
+
+

-
+

-
+









-
+







 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

size_t
int
Tcl_NumUtfChars(
    const char *src,	/* The UTF-8 string to measure. */
    size_t length)	/* The length of the string in bytes, or
			 * TCL_INDEX_NONE for strlen(src). */
    int length)		/* The length of the string in bytes, or -1
			 * for strlen(string). */
{
    Tcl_UniChar ch = 0;
    size_t i = 0;
    Tcl_UniChar ch;
    int i = 0;

    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	/* string is NUL-terminated, so TclUtfToUniChar calls are safe. */
	while (*src != '\0') {
	while ((*src != '\0') && (i < INT_MAX)) {
	    src += TclUtfToUniChar(src, &ch);
	    i++;
	}
    } else {
	/* Will return value between 0 and length. No overflow checks. */

	/* Pointer to the end of string. Never read endPtr[0] */
	const char *endPtr = src + length;
	/* Pointer to last byte where optimization still can be used */
	const char *optPtr = endPtr - TCL_UTF_MAX;
	const char *optPtr = endPtr - ((TCL_UTF_MAX > 3) ? 4 : 3);

	/*
	 * Optimize away the call in this loop. Justified because...
	 * when (src <= optPtr), (endPtr - src) >= (endPtr - optPtr)
	 * By initialization above (endPtr - optPtr) = TCL_UTF_MAX
	 * So (endPtr - src) >= TCL_UTF_MAX, and passing that to
	 * Tcl_UtfCharComplete we know will cause return of 1.
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
600
601
602
603
604
605
606

607
608
609


610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626

627
628
629
630
631
632
633
634







-
+


-
-
+
+















-
+







 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfFindFirst(
    const char *src,		/* The UTF-8 string to be searched. */
    int ch)			/* The Unicode character to search for. */
    int ch)			/* The Tcl_UniChar to search for. */
{
    while (1) {
	int find, len = TclUtfToUCS4(src, &find);

	Tcl_UniChar find;
	int len = TclUtfToUniChar(src, &find);
	if (find == ch) {
	    return src;
	}
	if (*src == '\0') {
	    return NULL;
	}
	src += len;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfFindLast --
 *
 *	Returns a pointer to the last occurrence of the given Unicode character
 *	Returns a pointer to the last occurance of the given Unicode character
 *	in the NULL-terminated UTF-8 string. The NULL terminator is considered
 *	part of the UTF-8 string. Equivalent to Plan 9 utfrrune().
 *
 * Results:
 *	As above. If the Unicode character does not exist in the given string, the
 *	return value is NULL.
 *
925
926
927
928
929
930
931

932

933
934
935
936
937
938
939
642
643
644
645
646
647
648
649

650
651
652
653
654
655
656
657







+
-
+







Tcl_UtfFindLast(
    const char *src,		/* The UTF-8 string to be searched. */
    int ch)			/* The Unicode character to search for. */
{
    const char *last = NULL;

    while (1) {
	Tcl_UniChar find;
	int find, len = TclUtfToUCS4(src, &find);
	int len = TclUtfToUniChar(src, &find);

	if (find == ch) {
	    last = src;
	}
	if (*src == '\0') {
	    break;
	}
963
964
965
966
967
968
969
970

971
972

973




974
975
976
977
978

979
980
981
982
983
984
985
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







-
+


+

+
+
+
+





+







 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfNext(
    const char *src)		/* The current location in the string. */
{
    size_t left;
    int left;
    const char *next;

#if TCL_UTF_MAX > 3
    if (((*src) & 0xC0) == 0x80) {
	/* Continuation byte, so we start 'inside' a (possible valid) UTF-8
	 * sequence. Since we are not allowed to access src[-1], we cannot
	 * check if the sequence is actually valid, the best we can do is
	 * just assume it is valid and locate the end. */
	if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) {
	    ++src;
	}
	return src;
    }
#endif

    left = totalBytes[UCHAR(*src)];
    next = src + 1;
    while (--left) {
	if ((*next & 0xC0) != 0x80) {
	    /*
	     * src points to non-trail byte; We ran out of trail bytes
1061
1062
1063
1064
1065
1066
1067
1068

1069
1070
1071
1072
1073
1074
1075
785
786
787
788
789
790
791

792
793
794
795
796
797
798
799







-
+







		/*
		 * We've seen no trailing context to use to check
		 * anything. From what we know, this non-trail byte
		 * is a prefix of a previous character, and accepting
		 * it (the fallback) is correct.
		 */

		    || (trailBytesSeen >= complete[byte])) {
		    || (trailBytesSeen >= totalBytes[byte])) {
		/*
		 * That is, (1 + trailBytesSeen > needed).
		 * We've examined more bytes than needed to complete
		 * this lead byte. No matter about well-formedness or
		 * validity, the sequence starting with this lead byte
		 * will never include the fallback location, so we must
		 * return the fallback location. See test utf-7.17
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
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
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







-
+


-
+

-
+
-

-

-
-
-







-
+











-
+


-
+

-
+
-

-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-








-
+
-
-













-
+

-
+
-
-
-

-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-













-
+
















-
+









-
+
+







	     * and exit this loop before we run past the start of the string.
	     */
	    return fallback;
	}

	/* Continue the search backwards... */
	look--;
    } while (trailBytesSeen < TCL_UTF_MAX);
    } while (trailBytesSeen < (TCL_UTF_MAX < 4 ? 3 : 4));

    /*
     * We've seen TCL_UTF_MAX trail bytes, so we know there will not be a
     * We've seen 3 trail bytes, so we know there will not be a
     * properly formed byte sequence to find, and we can stop looking,
     * accepting the fallback (for TCL_UTF_MAX > 3) or just go back as
     * accepting the fallback.
     * far as we can.
     */
#if TCL_UTF_MAX > 3
    return fallback;
#else
    return src - TCL_UTF_MAX;
#endif
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UniCharAtIndex --
 *
 *	Returns the Unicode character represented at the specified character
 *	Returns the Tcl_UniChar represented at the specified character
 *	(not byte) position in the UTF-8 string.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

int
Tcl_UniChar
Tcl_UniCharAtIndex(
    const char *src,	/* The UTF-8 string to dereference. */
    size_t index)		/* The position of the desired character. */
    int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    Tcl_UniChar ch;
    int i = 0;

    if (index == TCL_INDEX_NONE) {
	return -1;
    }
    while (index--) {
	i = TclUtfToUniChar(src, &ch);
    TclUtfToUniChar(Tcl_UtfAtIndex(src, index), &ch);
	src += i;
    }
#if TCL_UTF_MAX <= 3
    if ((ch >= 0xD800) && (i < 3)) {
	/* Index points at character following high Surrogate */
	return -1;
    return ch;
    }
#endif
    TclUtfToUCS4(src, &i);
    return i;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfAtIndex --
 *
 *	Returns a pointer to the specified character (not byte) position in
 *	the UTF-8 string. If TCL_UTF_MAX <= 3, characters > U+FFFF count as
 *	the UTF-8 string.
 *	2 positions, but then the pointer should never be placed between
 *	the two positions.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

const char *
Tcl_UtfAtIndex(
    const char *src,	/* The UTF-8 string. */
    size_t index)		/* The position of the desired character. */
    int index)		/* The position of the desired character. */
{
    Tcl_UniChar ch = 0;
    Tcl_UniChar ch;
#if TCL_UTF_MAX <= 3
    size_t len = 0;
#endif

    if (index != TCL_INDEX_NONE) {
	while (index--) {
    while (index-- > 0) {
#if TCL_UTF_MAX <= 3
	    src += (len = TclUtfToUniChar(src, &ch));
#else
	    src += TclUtfToUniChar(src, &ch);
	src += TclUtfToUniChar(src, &ch);
#endif
	}
#if TCL_UTF_MAX <= 3
    if ((ch >= 0xD800) && (len < 3)) {
	/* Index points at character following high Surrogate */
	src += TclUtfToUniChar(src, &ch);
    }
#endif
    }
    return src;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_UtfBackslash --
 *
 *	Figure out how to handle a backslash sequence.
 *
 * Results:
 *	Stores the bytes represented by the backslash sequence in dst and
 *	returns the number of bytes written to dst. At most 4 bytes
 *	returns the number of bytes written to dst. At most TCL_UTF_MAX bytes
 *	are written to dst; dst must have been large enough to accept those
 *	bytes. If readPtr isn't NULL then it is filled in with a count of the
 *	number of bytes in the backslash sequence.
 *
 * Side effects:
 *	The maximum number of bytes it takes to represent a Unicode character
 *	in UTF-8 is guaranteed to be less than the number of bytes used to
 *	express the backslash sequence that represents that Unicode character.
 *	If the target buffer into which the caller is going to store the bytes
 *	that represent the Unicode character is at least as large as the
 *	source buffer from which the backslashed sequence was extracted, no
 *	buffer overruns should occur.
 *
 *---------------------------------------------------------------------------
 */

size_t
int
Tcl_UtfBackslash(
    const char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    int *readPtr,		/* Fill in with number of characters read from
				 * src, unless NULL. */
    char *dst)			/* Filled with the bytes represented by the
				 * backslash sequence. */
{
#define LINE_LENGTH 128
    size_t numRead, result;
    int numRead;
    int result;

    result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst);
    if (numRead == LINE_LENGTH) {
	/*
	 * We ate a whole line. Pay the price of a strlen()
	 */

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
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







-
+

-
+







-
+








-
+







 *----------------------------------------------------------------------
 */

int
Tcl_UtfToUpper(
    char *str)			/* String to convert in place. */
{
    int ch, upChar;
    Tcl_UniChar ch, upChar;
    char *src, *dst;
    size_t len;
    int len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
	len = TclUtfToUCS4(src, &ch);
	len = TclUtfToUniChar(src, &ch);
	upChar = Tcl_UniCharToUpper(ch);

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the upper case
	 * char to dst if its size is <= the original char.
	 */

	if ((len < TclUtfCount(upChar)) || ((upChar & ~0x7FF) == 0xD800)) {
	if (len < UtfCount(upChar)) {
	    memmove(dst, src, len);
	    dst += len;
	} else {
	    dst += Tcl_UniCharToUtf(upChar, dst);
	}
	src += len;
    }
1333
1334
1335
1336
1337
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
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







-
+

-
+







-
+








-
+







 *----------------------------------------------------------------------
 */

int
Tcl_UtfToLower(
    char *str)			/* String to convert in place. */
{
    int ch, lowChar;
    Tcl_UniChar ch, lowChar;
    char *src, *dst;
    size_t len;
    int len;

    /*
     * Iterate over the string until we hit the terminating null.
     */

    src = dst = str;
    while (*src) {
	len = TclUtfToUCS4(src, &ch);
	len = TclUtfToUniChar(src, &ch);
	lowChar = Tcl_UniCharToLower(ch);

	/*
	 * To keep badly formed Utf strings from getting inflated by the
	 * conversion (thereby causing a segfault), only copy the lower case
	 * char to dst if its size is <= the original char.
	 */

	if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) {
	if (len < UtfCount(lowChar)) {
	    memmove(dst, src, len);
	    dst += len;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += len;
    }
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
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







-
+

-
+









-
+


-
+








-
+






-
+







 *----------------------------------------------------------------------
 */

int
Tcl_UtfToTitle(
    char *str)			/* String to convert in place. */
{
    int ch, titleChar, lowChar;
    Tcl_UniChar ch, titleChar, lowChar;
    char *src, *dst;
    size_t len;
    int len;

    /*
     * Capitalize the first character and then lowercase the rest of the
     * characters until we get to a null.
     */

    src = dst = str;

    if (*src) {
	len = TclUtfToUCS4(src, &ch);
	len = TclUtfToUniChar(src, &ch);
	titleChar = Tcl_UniCharToTitle(ch);

	if ((len < TclUtfCount(titleChar)) || ((titleChar & ~0x7FF) == 0xD800)) {
	if (len < UtfCount(titleChar)) {
	    memmove(dst, src, len);
	    dst += len;
	} else {
	    dst += Tcl_UniCharToUtf(titleChar, dst);
	}
	src += len;
    }
    while (*src) {
	len = TclUtfToUCS4(src, &ch);
	len = TclUtfToUniChar(src, &ch);
	lowChar = ch;
	/* Special exception for Georgian Asomtavruli chars, no titlecase. */
	if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
	    lowChar = Tcl_UniCharToLower(lowChar);
	}

	if ((len < TclUtfCount(lowChar)) || ((lowChar & ~0x7FF) == 0xD800)) {
	if (len < UtfCount(lowChar)) {
	    memmove(dst, src, len);
	    dst += len;
	} else {
	    dst += Tcl_UniCharToUtf(lowChar, dst);
	}
	src += len;
    }
1451
1452
1453
1454
1455
1456
1457
1458

1459
1460
1461
1462
1463
1464
1465
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154







-
+







 *----------------------------------------------------------------------
 */

int
TclpUtfNcmp2(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numBytes)	/* Number of *bytes* to compare. */
    unsigned long numBytes)	/* Number of *bytes* to compare. */
{
    /*
     * We can't simply call 'memcmp(cs, ct, numBytes);' because we need to
     * check for Tcl's \xC0\x80 non-utf-8 null encoding. Otherwise utf-8 lexes
     * fine in the strcmp manner.
     */

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
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
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







-
+

-
+

















-
-
-
-
-
-
-
-
-
-







 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of UTF chars to compare. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;
    Tcl_UniChar ch1, ch2;

    /*
     * Cannot use 'memcmp(cs, ct, n);' as byte representation of \u0000 (the
     * pair of bytes 0xC0,0x80) is larger than byte representation of \u0001
     * (the byte 0x01.)
     */

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes. This should be called
	 * only when both strings are of at least n chars long (no need for \0
	 * check)
	 */

	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 3
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    return (ch1 - ch2);
	}
    }
    return 0;
}

/*
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
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
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
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







-
+

-
+
-









-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *----------------------------------------------------------------------
 */

int
Tcl_UtfNcasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct,		/* UTF string cs is compared to. */
    size_t numChars)	/* Number of UTF chars to compare. */
    unsigned long numChars)	/* Number of UTF chars to compare. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;
    Tcl_UniChar ch1, ch2;

    while (numChars-- > 0) {
	/*
	 * n must be interpreted as chars, not bytes.
	 * This should be called only when both strings are of
	 * at least n chars long (no need for \0 check)
	 */
	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 3
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    ch1 = Tcl_UniCharToLower(ch1);
	    ch2 = Tcl_UniCharToLower(ch2);
	    if (ch1 != ch2) {
		return (ch1 - ch2);
	    }
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UtfCmp --
 *
 *	Compare UTF chars of string cs to string ct case sensitively.
 *	Replacement for strcmp in Tcl core, in places where UTF-8 should
 *	be handled.
 *
 * Results:
 *	Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUtfCmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct)		/* UTF string cs is compared to. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;

    while (*cs && *ct) {
	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 3
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    return ch1 - ch2;
	}
    }
    return UCHAR(*cs) - UCHAR(*ct);
}


/*
 *----------------------------------------------------------------------
 *
 * TclUtfCasecmp --
 *
 *	Compare UTF chars of string cs to string ct case insensitively.
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
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289
1290
1291
1292










1293
1294
1295
1296
1297
1298
1299







-
+





-
-
-
-
-
-
-
-
-
-







 */

int
TclUtfCasecmp(
    const char *cs,		/* UTF string to compare to ct. */
    const char *ct)		/* UTF string cs is compared to. */
{
    Tcl_UniChar ch1 = 0, ch2 = 0;
    Tcl_UniChar ch1, ch2;

    while (*cs && *ct) {
	cs += TclUtfToUniChar(cs, &ch1);
	ct += TclUtfToUniChar(ct, &ch2);
	if (ch1 != ch2) {
#if TCL_UTF_MAX <= 3
	    /* Surrogates always report higher than non-surrogates */
	    if (((ch1 & 0xFC00) == 0xD800)) {
	    if ((ch2 & 0xFC00) != 0xD800) {
		return ch1;
	    }
	    } else if ((ch2 & 0xFC00) == 0xD800) {
		return -ch2;
	    }
#endif
	    ch1 = Tcl_UniCharToLower(ch1);
	    ch2 = Tcl_UniCharToLower(ch2);
	    if (ch1 != ch2) {
		return ch1 - ch2;
	    }
	}
    }
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

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
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
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
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
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


1439
1440
1441
1442

1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454

1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469

1470
1471
1472

1473
1474
1475
1476
1477
1478
1479
1480







-
+



+

+





+


-
+
+
+


















-
+



+

+






+


-
+
+
+


















-
+



+

+














+


-
+
+
+





-
+













-
-
+
+


-
+











-
+














-
+


-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniChar
Tcl_UniCharToUpper(
    int ch)			/* Unicode character to convert. */
{
#if TCL_UTF_MAX > 3
    if (!UNICODE_OUT_OF_RANGE(ch)) {
#endif
	int info = GetUniCharInfo(ch);

	if (GetCaseType(info) & 0x04) {
	    ch -= GetDelta(info);
	}
#if TCL_UTF_MAX > 3
    }
    /* Clear away extension bits, if any */
    return ch & 0x1FFFFF;
    ch &= 0x1FFFFF;
#endif
    return (Tcl_UniChar) ch;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToLower --
 *
 *	Compute the lowercase equivalent of the given Unicode character.
 *
 * Results:
 *	Returns the lowercase Unicode character.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniChar
Tcl_UniCharToLower(
    int ch)			/* Unicode character to convert. */
{
#if TCL_UTF_MAX > 3
    if (!UNICODE_OUT_OF_RANGE(ch)) {
#endif
	int info = GetUniCharInfo(ch);
	int mode = GetCaseType(info);

	if ((mode & 0x02) && (mode != 0x7)) {
	    ch += GetDelta(info);
	}
#if TCL_UTF_MAX > 3
    }
    /* Clear away extension bits, if any */
    return ch & 0x1FFFFF;
    ch &= 0x1FFFFF;
#endif
    return (Tcl_UniChar) ch;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharToTitle --
 *
 *	Compute the titlecase equivalent of the given Unicode character.
 *
 * Results:
 *	Returns the titlecase Unicode character.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UniChar
Tcl_UniCharToTitle(
    int ch)			/* Unicode character to convert. */
{
#if TCL_UTF_MAX > 3
    if (!UNICODE_OUT_OF_RANGE(ch)) {
#endif
	int info = GetUniCharInfo(ch);
	int mode = GetCaseType(info);

	if (mode & 0x1) {
	    /*
	     * Subtract or add one depending on the original case.
	     */

	    if (mode != 0x7) {
		ch += ((mode & 0x4) ? -1 : 1);
	    }
	} else if (mode == 0x4) {
	    ch -= GetDelta(info);
	}
#if TCL_UTF_MAX > 3
    }
    /* Clear away extension bits, if any */
    return ch & 0x1FFFFF;
    ch &= 0x1FFFFF;
#endif
    return (Tcl_UniChar) ch;
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharLen --
 * Tcl_UniCharLen --
 *
 *	Find the length of a UniChar string. The str input must be null
 *	terminated.
 *
 * Results:
 *	Returns the length of str in UniChars (not bytes).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclUniCharLen(
int
Tcl_UniCharLen(
    const Tcl_UniChar *uniStr)	/* Unicode string to find length of. */
{
    size_t len = 0;
    int len = 0;

    while (*uniStr != '\0') {
	len++;
	uniStr++;
    }
    return len;
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharNcmp --
 * Tcl_UniCharNcmp --
 *
 *	Compare at most numChars unichars of string ucs to string uct.
 *	Both ucs and uct are assumed to be at least numChars unichars long.
 *
 * Results:
 *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharNcmp(
Tcl_UniCharNcmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numChars)	/* Number of unichars to compare. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
#ifdef WORDS_BIGENDIAN
    /*
     * We are definitely on a big-endian machine; memcmp() is safe
     */

    return memcmp(ucs, uct, numChars*sizeof(Tcl_UniChar));
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
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







-
+















-
+


-
+







    return 0;
#endif /* WORDS_BIGENDIAN */
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharNcasecmp --
 * Tcl_UniCharNcasecmp --
 *
 *	Compare at most numChars unichars of string ucs to string uct case
 *	insensitive. Both ucs and uct are assumed to be at least numChars
 *	unichars long.
 *
 * Results:
 *	Return <0 if ucs < uct, 0 if ucs == uct, or >0 if ucs > uct.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharNcasecmp(
Tcl_UniCharNcasecmp(
    const Tcl_UniChar *ucs,	/* Unicode string to compare to uct. */
    const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
    size_t numChars)	/* Number of unichars to compare. */
    unsigned long numChars)	/* Number of unichars to compare. */
{
    for ( ; numChars != 0; numChars--, ucs++, uct++) {
	if (*ucs != *uct) {
	    Tcl_UniChar lcs = Tcl_UniCharToLower(*ucs);
	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);

	    if (lcs != lct) {
1919
1920
1921
1922
1923
1924
1925

1926
1927
1928

1929
1930
1931
1932
1933
1934
1935
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsAlnum(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsAlpha --
1945
1946
1947
1948
1949
1950
1951

1952
1953
1954

1955
1956
1957
1958
1959
1960
1961
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsAlpha(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return ((ALPHA_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsControl --
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
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







+











+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsControl(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	/* Clear away extension bits, if any */
	ch &= 0x1FFFFF;
	if ((ch == 0xE0001) || ((ch >= 0xE0020) && (ch <= 0xE007F))) {
	    return 1;
	}
	if ((ch >= 0xF0000) && ((ch & 0xFFFF) <= 0xFFFD)) {
	    return 1;
	}
	return 0;
    }
#endif
    return ((CONTROL_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsDigit --
2005
2006
2007
2008
2009
2010
2011

2012
2013
2014

2015
2016
2017
2018
2019
2020
2021
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsDigit(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsGraph --
2031
2032
2033
2034
2035
2036
2037

2038
2039
2040

2041
2042
2043
2044
2045
2046
2047
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsGraph(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return ((unsigned)((ch & 0x1FFFFF) - 0xE0100) <= 0xEF);
    }
#endif
    return ((GRAPH_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsLower --
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066

2067
2068
2069
2070
2071
2072
2073
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsLower(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (GetCategory(ch) == LOWERCASE_LETTER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsPrint --
2083
2084
2085
2086
2087
2088
2089

2090
2091
2092

2093
2094
2095
2096
2097
2098
2099
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsPrint(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return ((unsigned)((ch & 0x1FFFFF) - 0xE0100) <= 0xEF);
    }
#endif
    return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsPunct --
2109
2110
2111
2112
2113
2114
2115

2116
2117
2118

2119
2120
2121
2122
2123
2124
2125
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsPunct(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return ((PUNCT_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsSpace --
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
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







+


+
+
+
+








+


+
-
+
-







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsSpace(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    /* Ignore upper 11 bits. */
    ch &= 0x1FFFFF;
#else
    /* Ignore upper 16 bits. */
    ch &= 0xFFFF;
#endif

    /*
     * If the character is within the first 127 characters, just use the
     * standard C function, otherwise consult the Unicode table.
     */

    if (ch < 0x80) {
	return TclIsSpaceProcM((char) ch);
#if TCL_UTF_MAX > 3
    } else if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
#endif
    } else if (ch == 0x0085 || ch == 0x180E || ch == 0x200B
    } else if (ch == 0x180E || ch == 0x202F) {
	    || ch == 0x202F || ch == 0x2060 || ch == 0xFEFF) {
	return 1;
    } else {
	return ((SPACE_BITS >> GetCategory(ch)) & 1);
    }
}

/*
2175
2176
2177
2178
2179
2180
2181

2182
2183
2184

2185
2186
2187
2188
2189
2190
2191
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842







+



+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsUpper(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return (GetCategory(ch) == UPPERCASE_LETTER);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UniCharIsWordChar --
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
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







+



+






-
+




















-
+






-
+







 *----------------------------------------------------------------------
 */

int
Tcl_UniCharIsWordChar(
    int ch)			/* Unicode character to test. */
{
#if TCL_UTF_MAX > 3
    if (UNICODE_OUT_OF_RANGE(ch)) {
	return 0;
    }
#endif
    return ((WORD_BITS >> GetCategory(ch)) & 1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclUniCharCaseMatch --
 * Tcl_UniCharCaseMatch --
 *
 *	See if a particular Unicode string matches a particular pattern.
 *	Allows case insensitivity. This is the Unicode equivalent of the char*
 *	Tcl_StringCaseMatch. The UniChar strings must be NULL-terminated.
 *	This has no provision for counted UniChar strings, thus should not be
 *	used where NULLs are expected in the UniChar string. Use
 *	TclUniCharMatch where possible.
 *
 * Results:
 *	The return value is 1 if string matches pattern, and 0 otherwise. The
 *	matching operation permits the following special characters in the
 *	pattern: *?\[] (see the manual entry for details on what these mean).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharCaseMatch(
Tcl_UniCharCaseMatch(
    const Tcl_UniChar *uniStr,	/* Unicode String. */
    const Tcl_UniChar *uniPattern,
				/* Pattern, which may contain special
				 * characters. */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    Tcl_UniChar ch1 = 0, p;
    Tcl_UniChar ch1, p;

    while (1) {
	p = *uniPattern;

	/*
	 * See if we're at the end of both the pattern and the string. If so,
	 * we succeeded. If we're at the end of the pattern but not at the end
2298
2299
2300
2301
2302
2303
2304
2305

2306
2307
2308
2309
2310
2311
2312
1951
1952
1953
1954
1955
1956
1957

1958
1959
1960
1961
1962
1963
1964
1965







-
+







			}
		    } else {
			while (*uniStr && (p != *uniStr)) {
			    uniStr++;
			}
		    }
		}
		if (TclUniCharCaseMatch(uniStr, uniPattern, nocase)) {
		if (Tcl_UniCharCaseMatch(uniStr, uniPattern, nocase)) {
		    return 1;
		}
		if (*uniStr == 0) {
		    return 0;
		}
		uniStr++;
	    }
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
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







-
+
















-
+


-
+







/*
 *----------------------------------------------------------------------
 *
 * TclUniCharMatch --
 *
 *	See if a particular Unicode string matches a particular pattern.
 *	Allows case insensitivity. This is the Unicode equivalent of the char*
 *	Tcl_StringCaseMatch. This variant of TclUniCharCaseMatch uses counted
 *	Tcl_StringCaseMatch. This variant of Tcl_UniCharCaseMatch uses counted
 *	Strings, so embedded NULLs are allowed.
 *
 * Results:
 *	The return value is 1 if string matches pattern, and 0 otherwise. The
 *	matching operation permits the following special characters in the
 *	pattern: *?\[] (see the manual entry for details on what these mean).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclUniCharMatch(
    const Tcl_UniChar *string,	/* Unicode String. */
    size_t strLen,			/* Length of String */
    int strLen,			/* Length of String */
    const Tcl_UniChar *pattern,	/* Pattern, which may contain special
				 * characters. */
    size_t ptnLen,			/* Length of Pattern */
    int ptnLen,			/* Length of Pattern */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    const Tcl_UniChar *stringEnd, *patternEnd;
    Tcl_UniChar p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;
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
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2241
2242
2243
2244
2245
2246
2247




















































2248
2249
2250
2251
2252
2253
2254







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	    return 0;
	}
	string++;
	pattern++;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclUtfToUCS4 --
 *
 *	Extract the 4-byte codepoint from the leading bytes of the
 *	Modified UTF-8 string "src".  This is a utility routine to
 *	contain the surrogate gymnastics in one place.
 *
 *	The caller must ensure that the source buffer is long enough that this
 *	routine does not run off the end and dereference non-existent memory
 *	looking for trail bytes. If the source buffer is known to be '\0'
 *	terminated, this cannot happen. Otherwise, the caller should call
 *	Tcl_UtfCharComplete() before calling this routine to ensure that
 *	enough bytes remain in the string.
 *
 * Results:
 *	*usc4Ptr is filled with the UCS4 code point, and the return value is
 *	the number of bytes from the UTF-8 string that were consumed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

#if TCL_UTF_MAX <= 3
int
TclUtfToUCS4(
    const char *src,	/* The UTF-8 string. */
    int *ucs4Ptr)	/* Filled with the UCS4 codepoint represented
			 * by the UTF-8 string. */
{
    /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
    return Tcl_UtfToUniChar(src, ucs4Ptr);
}

int
TclUniCharToUCS4(
    const Tcl_UniChar *src,	/* The Tcl_UniChar string. */
    int *ucs4Ptr)	/* Filled with the UCS4 codepoint represented
			 * by the Tcl_UniChar string. */
{
    if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) {
	*ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[01] & 0x3FF)) + 0x10000;
	return 2;
    }
    *ucs4Ptr = src[0];
    return 1;
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclUtil.c.

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
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
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
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







-
+
-
-












-
-
-
+
+
+











-
-
-
-
-
+
+
+
+
+









-
-
+
+








-
+

-
+


-
+



-
-
-
+
+
+
















+
+
+
+
+
+
+







-
-

-
-
-
-
+
+
+
+
-
-
-



-
-
+
+
-
-
-
-


-
+



-
-
+
+





-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
+
+


















-
-
-
+
+
+



-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+
+




-
-
-
+
+
+

-
-
+
+





-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+


-
-
-
-
+
+
+
+





-
-
-
-
-
+
+
+
+
+










-
+





-
+

-
-
-
-
-
-
+
+
+
+
+
+








-
-
-
-
-
-
+
+
+
+
+
+




-
-
+
+









-
-
-
-
+
+
+
+
+










-
-
-
-
+
+
+
+








-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+





-
-
+
+




-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

















-
-
-
-
+
+
+
+


-
-
-
+
+
+









-
-
-
+
+
+

-
+

-
+




-
-
+
-
-


-
-
+
-
-

-
+



-
-
+
-
-



-
+

-
+


-
-
-
+
-


-
+


-
-
+
-
-


-
+







 * 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 <float.h>
#include "tclStringTrim.h"
#include "tclTomMath.h"
#include <math.h>

/*
 * The absolute pathname of the executable in which this Tcl library is
 * running.
 */

static ProcessGlobalValue executableName = {
    0, 0, NULL, NULL, NULL, NULL, NULL
};

/*
 * The following values are used in the flags arguments of Tcl*Scan*Element
 * and Tcl*Convert*Element.  The values TCL_DONT_USE_BRACES and
 * TCL_DONT_QUOTE_HASH are defined in tcl.h, like so:
 * The following values are used in the flags arguments of Tcl*Scan*Element and
 * Tcl*Convert*Element. The values TCL_DONT_USE_BRACES and TCL_DONT_QUOTE_HASH
 * are defined in tcl.h, like so:
 *
#define TCL_DONT_USE_BRACES     1
#define TCL_DONT_QUOTE_HASH     8
 *
 * Those are public flag bits which callers of the public routines
 * Tcl_Convert*Element() can use to indicate:
 *
 * TCL_DONT_USE_BRACES -	1 means the caller is insisting that brace
 *				quoting not be used when converting the list
 *				element.
 * TCL_DONT_QUOTE_HASH -	1 means the caller insists that a leading hash
 *				character ('#') should *not* be quoted. This
 *				is appropriate when the caller can guarantee
 *				the element is not the first element of a
 *				list, so [eval] cannot mis-parse the element
 *				as a comment.
 * 				character ('#') should *not* be quoted. This
 * 				is appropriate when the caller can guarantee
 * 				the element is not the first element of a
 * 				list, so [eval] cannot mis-parse the element
 * 				as a comment.
 *
 * The remaining values which can be carried by the flags of these routines
 * are for internal use only.  Make sure they do not overlap with the public
 * values above.
 *
 * The Tcl*Scan*Element() routines make a determination which of 4 modes of
 * conversion is most appropriate for Tcl*Convert*Element() to perform, and
 * sets two bits of the flags value to indicate the mode selected.
 *
 * CONVERT_NONE		The element needs no quoting. Its literal string is
 *			suitable as is.
 * CONVERT_NONE		The element needs no quoting.  Its literal string
 *			is suitable as is.
 * CONVERT_BRACE	The conversion should be enclosing the literal string
 *			in braces.
 * CONVERT_ESCAPE	The conversion should be using backslashes to escape
 *			any characters in the string that require it.
 * CONVERT_MASK		A mask value used to extract the conversion mode from
 *			the flags argument.
 *			Also indicates a strange conversion mode where all
 *			special characters are escaped with backslashes
 *			*except for braces*. This is a strange and unnecessary
 *			*except for braces*.  This is a strange and unnecessary
 *			case, but it's part of the historical way in which
 *			lists have been formatted in Tcl. To experiment with
 *			lists have been formatted in Tcl.  To experiment with
 *			removing this case, set the value of COMPAT to 0.
 *
 * One last flag value is used only by callers of TclScanElement(). The flag
 * One last flag value is used only by callers of TclScanElement().  The flag
 * value produced by a call to Tcl*Scan*Element() will never leave this bit
 * set.
 *
 * CONVERT_ANY		The caller of TclScanElement() declares it can make no
 *			promise about what public flags will be passed to the
 *			matching call of TclConvertElement(). As such,
 * CONVERT_ANY		The caller of TclScanElement() declares it can make
 *			no promise about what public flags will be passed to
 *			the matching call of TclConvertElement().  As such,
 *			TclScanElement() has to determine the worst case
 *			destination buffer length over all possibilities, and
 *			in other cases this means an overestimate of the
 *			required size.
 *
 * For more details, see the comments on the Tcl*Scan*Element and
 * Tcl*Convert*Element routines.
 */

#define COMPAT 1
#define CONVERT_NONE	0
#define CONVERT_BRACE	2
#define CONVERT_ESCAPE	4
#define CONVERT_MASK	(CONVERT_BRACE | CONVERT_ESCAPE)
#define CONVERT_ANY	16

/*
 * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
 * access the precision to be used for double formatting.
 */

static Tcl_ThreadDataKey precisionKey;

/*
 * Prototypes for functions defined later in this file.
 */

static void		ClearHash(Tcl_HashTable *tablePtr);
static void		FreeProcessGlobalValue(ClientData clientData);
static void		FreeThreadHash(ClientData clientData);
static int		GetEndOffsetFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    size_t endValue, Tcl_WideInt *widePtr);
static int		FindElement(Tcl_Interp *interp, const char *string,
			    int stringLength, const char *typeStr,
static int		SetEndOffsetFromAny(Tcl_Interp* interp,
			    Tcl_Obj* objPtr);
static void		UpdateStringOfEndOffset(Tcl_Obj* objPtr);

			    const char *typeCode, const char **elementPtr,
			    const char **nextPtr, size_t *sizePtr,
			    int *literalPtr);
/*
 * The following is the Tcl object type definition for an object that
 * represents a list index in the form, "end-offset". It is used as a
 * performance optimization in Tcl_GetIntForIndex. The internal rep is
 * stored directly in the wideValue, so no memory management is required
 * performance optimization in TclGetIntForIndex. The internal rep is an
 * integer, so no memory management is required for it.
 * for it. This is a caching intrep, keeping the result of a parse
 * around. This type is only created from a pre-existing string, so an
 * updateStringProc will never be called and need not exist. The type
 * is unregistered, so has no need of a setFromAnyProc either.
 */

static const Tcl_ObjType endOffsetType = {
Tcl_ObjType tclEndOffsetType = {
    "end-offset",			/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    NULL,				/* updateStringProc */
    NULL				/* setFromAnyProc */
    UpdateStringOfEndOffset,		/* updateStringProc */
    SetEndOffsetFromAny
};

/*
 *	*	STRING REPRESENTATION OF LISTS	*	*	*
 *
 * The next several routines implement the conversions of strings to and from
 * Tcl lists. To understand their operation, the rules of parsing and
 * generating the string representation of lists must be known.  Here we
 * describe them in one place.
 * The next several routines implement the conversions of strings to and
 * from Tcl lists.  To understand their operation, the rules of parsing
 * and generating the string representation of lists must be known.  Here
 * we describe them in one place.
 *
 * A list is made up of zero or more elements. Any string is a list if it is
 * made up of alternating substrings of element-separating ASCII whitespace
 * and properly formatted elements.
 * A list is made up of zero or more elements.  Any string is a list if
 * it is made up of alternating substrings of element-separating ASCII
 * whitespace and properly formatted elements.
 *
 * The ASCII characters which can make up the whitespace between list elements
 * are:
 * The ASCII characters which can make up the whitespace between list
 * elements are:
 *
 *	\u0009	\t	TAB
 *	\u000A	\n	NEWLINE
 *	\u000B	\v	VERTICAL TAB
 *	\u000C	\f	FORM FEED
 * 	\u000D	\r	CARRIAGE RETURN
 *	\u0020		SPACE
 *
 * NOTE: differences between this and other places where Tcl defines a role
 * for "whitespace".
 *
 *	* Unlike command parsing, here NEWLINE is just another whitespace
 *	  character; its role as a command terminator in a script has no
 *	  importance here.
 *
 *	* Unlike command parsing, the BACKSLASH NEWLINE sequence is not
 *	  considered to be a whitespace character.
 *
 *	* Other Unicode whitespace characters (recognized by [string is space]
 *	  or Tcl_UniCharIsSpace()) do not play any role as element separators
 *	  in Tcl lists.
 *	* Other Unicode whitespace characters (recognized by
 *	  [string is space] or Tcl_UniCharIsSpace()) do not play any role
 *	  as element separators in Tcl lists.
 *
 *	* The NUL byte ought not appear, as it is not in strings properly
 *	  encoded for Tcl, but if it is present, it is not treated as
 *	  separating whitespace, or a string terminator. It is just another
 *	  character in a list element.
 *	  separating whitespace, or a string terminator.  It is just
 *	  another character in a list element.
 *
 * The interpretation of a formatted substring as a list element follows rules
 * similar to the parsing of the words of a command in a Tcl script. Backslash
 * substitution plays a key role, and is defined exactly as it is in command
 * parsing. The same routine, TclParseBackslash() is used in both command
 * parsing and list parsing.
 * The interpretation of a formatted substring as a list element follows
 * rules similar to the parsing of the words of a command in a Tcl script.
 * Backslash substitution plays a key role, and is defined exactly as it is
 * in command parsing.  The same routine, TclParseBackslash() is used in both
 * command parsing and list parsing.
 *
 * NOTE: This means that if and when backslash substitution rules ever change
 * for command parsing, the interpretation of strings as lists also changes.
 * NOTE:  This means that if and when backslash substitution rules ever
 * change for command parsing, the interpretation of strings as lists also
 * changes.
 *
 * Backslash substitution replaces an "escape sequence" of one or more
 * characters starting with
 *		\u005c	\	BACKSLASH
 * with a single character. The one character escape sequence case happens only
 * when BACKSLASH is the last character in the string. In all other cases, the
 * escape sequence is at least two characters long.
 * with a single character.  The one character escape sequence case happens
 * only when BACKSLASH is the last character in the string.  In all other
 * cases, the escape sequence is at least two characters long.
 *
 * The formatted substrings are interpreted as element values according to the
 * following cases:
 * The formatted substrings are interpreted as element values according to
 * the following cases:
 *
 * * If the first character of a formatted substring is
 *		\u007b	{	OPEN BRACE
 *   then the end of the substring is the matching
 *		\u007d	}	CLOSE BRACE
 *   character, where matching is determined by counting nesting levels, and
 *   not including any brace characters that are contained within a backslash
 *   escape sequence in the nesting count. Having found the matching brace,
 *   all characters between the braces are the string value of the element.
 *   If no matching close brace is found before the end of the string, the
 *   string is not a Tcl list. If the character following the close brace is
 *   not an element separating whitespace character, or the end of the string,
 *   then the string is not a Tcl list.
 *   character, where matching is determined by counting nesting levels,
 *   and not including any brace characters that are contained within a
 *   backslash escape sequence in the nesting count.  Having found the
 *   matching brace, all characters between the braces are the string
 *   value of the element.  If no matching close brace is found before the
 *   end of the string, the string is not a Tcl list.  If the character
 *   following the close brace is not an element separating whitespace
 *   character, or the end of the string, then the string is not a Tcl list.
 *
 *   NOTE: this differs from a brace-quoted word in the parsing of a Tcl
 *   command only in its treatment of the backslash-newline sequence. In a
 *   list element, the literal characters in the backslash-newline sequence
 *   become part of the element value. In a script word, conversion to a
 *   single SPACE character is done.
 *   NOTE: this differs from a brace-quoted word in the parsing of a
 *   Tcl command only in its treatment of the backslash-newline sequence.
 *   In a list element, the literal characters in the backslash-newline
 *   sequence become part of the element value.  In a script word,
 *   conversion to a single SPACE character is done.
 *
 *   NOTE: Most list element values can be represented by a formatted
 *   substring using brace quoting. The exceptions are any element value that
 *   includes an unbalanced brace not in a backslash escape sequence, and any
 *   value that ends with a backslash not itself in a backslash escape
 *   sequence.
 *   substring using brace quoting.  The exceptions are any element value
 *   that includes an unbalanced brace not in a backslash escape sequence,
 *   and any value that ends with a backslash not itself in a backslash
 *   escape sequence.
 *
 * * If the first character of a formatted substring is
 *		\u0022	"	QUOTE
 *   then the end of the substring is the next QUOTE character, not counting
 *   any QUOTE characters that are contained within a backslash escape
 *   sequence. If no next QUOTE is found before the end of the string, the
 *   string is not a Tcl list. If the character following the closing QUOTE is
 *   not an element separating whitespace character, or the end of the string,
 *   then the string is not a Tcl list. Having found the limits of the
 *   substring, the element value is produced by performing backslash
 *   sequence.  If no next QUOTE is found before the end of the string, the
 *   string is not a Tcl list.  If the character following the closing QUOTE
 *   is not an element separating whitespace character, or the end of the
 *   string, then the string is not a Tcl list.  Having found the limits
 *   of the substring, the element value is produced by performing backslash
 *   substitution on the character sequence between the open and close QUOTEs.
 *
 *   NOTE: Any element value can be represented by this style of formatting,
 *   given suitable choice of backslash escape sequences.
 *
 * * All other formatted substrings are terminated by the next element
 *   separating whitespace character in the string.  Having found the limits
 *   of the substring, the element value is produced by performing backslash
 *   substitution on it.
 *
 *   NOTE: Any element value can be represented by this style of formatting,
 *   NOTE:  Any element value can be represented by this style of formatting,
 *   given suitable choice of backslash escape sequences, with one exception.
 *   The empty string cannot be represented as a list element without the use
 *   of either braces or quotes to delimit it.
 *
 * This collection of parsing rules is implemented in the routine
 * FindElement().
 * TclFindElement().
 *
 * In order to produce lists that can be parsed by these rules, we need the
 * ability to distinguish between characters that are part of a list element
 * value from characters providing syntax that define the structure of the
 * list. This means that our code that generates lists must at a minimum be
 * able to produce escape sequences for the 10 characters identified above
 * that have significance to a list parser.
 * In order to produce lists that can be parsed by these rules, we need
 * the ability to distinguish between characters that are part of a list
 * element value from characters providing syntax that define the structure
 * of the list.  This means that our code that generates lists must at a
 * minimum be able to produce escape sequences for the 10 characters
 * identified above that have significance to a list parser.
 *
 *	*	*	CANONICAL LISTS	*	*	*	*	*
 *
 * In addition to the basic rules for parsing strings into Tcl lists, there
 * are additional properties to be met by the set of list values that are
 * generated by Tcl.  Such list values are often said to be in "canonical
 * form":
 *
 * * When any canonical list is evaluated as a Tcl script, it is a script of
 *   either zero commands (an empty list) or exactly one command. The command
 *   word is exactly the first element of the list, and each argument word is
 *   exactly one of the following elements of the list. This means that any
 *   characters that have special meaning during script evaluation need
 *   special treatment when canonical lists are produced:
 * * When any canonical list is evaluated as a Tcl script, it is a script
 *   of either zero commands (an empty list) or exactly one command.  The
 *   command word is exactly the first element of the list, and each argument
 *   word is exactly one of the following elements of the list.  This means
 *   that any characters that have special meaning during script evaluation
 *   need special treatment when canonical lists are produced:
 *
 *	* Whitespace between elements may not include NEWLINE.
 *	* The command terminating character,
 *		\u003b	;	SEMICOLON
 *	  must be BRACEd, QUOTEd, or escaped so that it does not terminate the
 * 	  command prematurely.
 *	  must be BRACEd, QUOTEd, or escaped so that it does not terminate
 * 	  the command prematurely.
 *	* Any of the characters that begin substitutions in scripts,
 *		\u0024	$	DOLLAR
 *		\u005b	[	OPEN BRACKET
 *		\u005c	\	BACKSLASH
 *	  need to be BRACEd or escaped.
 *	* In any list where the first character of the first element is
 *		\u0023	#	HASH
 *	  that HASH character must be BRACEd, QUOTEd, or escaped so that it
 *	  does not convert the command into a comment.
 *	* Any list element that contains the character sequence BACKSLASH
 *	  NEWLINE cannot be formatted with BRACEs. The BACKSLASH character
 *	  must be represented by an escape sequence, and unless QUOTEs are
 *	  used, the NEWLINE must be as well.
 *	* Any list element that contains the character sequence
 *	  BACKSLASH NEWLINE cannot be formatted with BRACEs.  The
 *	  BACKSLASH character must be represented by an escape
 *	  sequence, and unless QUOTEs are used, the NEWLINE must
 *	  be as well.
 *
 * * It is also guaranteed that one can use a canonical list as a building
 *   block of a larger script within command substitution, as in this example:
 *	set script "puts \[[list $cmd $arg]]"; eval $script
 *   To support this usage, any appearance of the character
 *		\u005d	]	CLOSE BRACKET
 *   in a list element must be BRACEd, QUOTEd, or escaped.
 *
 * * Finally it is guaranteed that enclosing a canonical list in braces
 *   produces a new value that is also a canonical list.  This new list has
 *   length 1, and its only element is the original canonical list.  This same
 *   guarantee also makes it possible to construct scripts where an argument
 *   word is given a list value by enclosing the canonical form of that list
 *   in braces:
 *   length 1, and its only element is the original canonical list.  This
 *   same guarantee also makes it possible to construct scripts where an
 *   argument word is given a list value by enclosing the canonical form
 *   of that list in braces:
 *	set script "puts {[list $one $two $three]}"; eval $script
 *   This sort of coding was once fairly common, though it's become more
 *   idiomatic to see the following instead:
 *	set script [list puts [list $one $two $three]]; eval $script
 *   In order to support this guarantee, every canonical list must have
 *   balance when counting those braces that are not in escape sequences.
 *
 * Within these constraints, the canonical list generation routines
 * TclScanElement() and TclConvertElement() attempt to generate the string for
 * any list that is easiest to read. When an element value is itself
 * TclScanElement() and TclConvertElement() attempt to generate the string
 * for any list that is easiest to read.  When an element value is itself
 * acceptable as the formatted substring, it is usually used (CONVERT_NONE).
 * When some quoting or escaping is required, use of BRACEs (CONVERT_BRACE) is
 * usually preferred over the use of escape sequences (CONVERT_ESCAPE). There
 * are some exceptions to both of these preferences for reasons of code
 * simplicity, efficiency, and continuation of historical habits. Canonical
 * lists never use the QUOTE formatting to delimit their elements because that
 * form of quoting does not nest, which makes construction of nested lists far
 * too much trouble.  Canonical lists always use only a single SPACE character
 * for element-separating whitespace.
 * When some quoting or escaping is required, use of BRACEs (CONVERT_BRACE)
 * is usually preferred over the use of escape sequences (CONVERT_ESCAPE).
 * There are some exceptions to both of these preferences for reasons of
 * code simplicity, efficiency, and continuation of historical habits.
 * Canonical lists never use the QUOTE formatting to delimit their elements
 * because that form of quoting does not nest, which makes construction of
 * nested lists far too much trouble.  Canonical lists always use only a
 * single SPACE character for element-separating whitespace.
 *
 *	*	*	FUTURE CONSIDERATIONS	*	*	*
 *
 * When a list element requires quoting or escaping due to a CLOSE BRACKET
 * character or an internal QUOTE character, a strange formatting mode is
 * recommended. For example, if the value "a{b]c}d" is converted by the usual
 * modes:
 * recommended.  For example, if the value "a{b]c}d" is converted by the
 * usual modes:
 *
 *	CONVERT_BRACE:	a{b]c}d		=> {a{b]c}d}
 *	CONVERT_ESCAPE:	a{b]c}d		=> a\{b\]c\}d
 *
 * we get perfectly usable formatted list elements. However, this is not what
 * Tcl releases have been producing. Instead, we have:
 * we get perfectly usable formatted list elements.  However, this is not
 * what Tcl releases have been producing.  Instead, we have:
 *
 *	CONVERT_MASK:	a{b]c}d		=> a{b\]c}d
 *
 * where the CLOSE BRACKET is escaped, but the BRACEs are not. The same effect
 * can be seen replacing ] with " in this example. There does not appear to be
 * any functional or aesthetic purpose for this strange additional mode. The
 * sole purpose I can see for preserving it is to keep generating the same
 * formatted lists programmers have become accustomed to, and perhaps written
 * tests to expect. That is, compatibility only. The additional code
 * complexity required to support this mode is significant. The lines of code
 * supporting it are delimited in the routines below with #if COMPAT
 * directives. This makes it easy to experiment with eliminating this
 * formatting mode simply with "#define COMPAT 0" above. I believe this is
 * worth considering.
 * where the CLOSE BRACKET is escaped, but the BRACEs are not.  The same
 * effect can be seen replacing ] with " in this example.  There does not
 * appear to be any functional or aesthetic purpose for this strange
 * additional mode.  The sole purpose I can see for preserving it is to
 * keep generating the same formatted lists programmers have become accustomed
 * to, and perhaps written tests to expect.  That is, compatibility only.
 * The additional code complexity required to support this mode is significant.
 * The lines of code supporting it are delimited in the routines below with
 * #if COMPAT directives.  This makes it easy to experiment with eliminating
 * this formatting mode simply with "#define COMPAT 0" above.  I believe
 * this is worth considering.
 *
 * Another consideration is the treatment of QUOTE characters in list
 * elements. TclConvertElement() must have the ability to produce the escape
 * sequence \" so that when a list element begins with a QUOTE we do not
 * confuse that first character with a QUOTE used as list syntax to define
 * list structure. However, that is the only place where QUOTE characters need
 * quoting. In this way, handling QUOTE could really be much more like the way
 * we handle HASH which also needs quoting and escaping only in particular
 * situations. Following up this could increase the set of list elements that
 * can use the CONVERT_NONE formatting mode.
 * Another consideration is the treatment of QUOTE characters in list elements.
 * TclConvertElement() must have the ability to produce the escape sequence
 * \" so that when a list element begins with a QUOTE we do not confuse
 * that first character with a QUOTE used as list syntax to define list
 * structure.  However, that is the only place where QUOTE characters need
 * quoting.  In this way, handling QUOTE could really be much more like
 * the way we handle HASH which also needs quoting and escaping only in
 * particular situations.  Following up this could increase the set of
 * list elements that can use the CONVERT_NONE formatting mode.
 *
 * More speculative is that the demands of canonical list form require brace
 * balance for the list as a whole, while the current implementation achieves
 * this by establishing brace balance for every element.
 *
 * Finally, a reminder that the rules for parsing and formatting lists are
 * closely tied together with the rules for parsing and evaluating scripts,
 * and will need to evolve in sync.
 */

/*
 *----------------------------------------------------------------------
 *
 * TclMaxListLength --
 *
 *	Given 'bytes' pointing to 'numBytes' bytes, scan through them and
 *	count the number of whitespace runs that could be list element
 *	separators. If 'numBytes' is -1, scan to the terminating '\0'. Not a
 *	full list parser. Typically used to get a quick and dirty overestimate
 *	of length size in order to allocate space for an actual list parser to
 *	operate with.
 *	separators.  If 'numBytes' is -1, scan to the terminating '\0'.
 *	Not a full list parser.  Typically used to get a quick and dirty
 *	overestimate of length size in order to allocate space for an
 *	actual list parser to operate with.
 *
 * Results:
 *	Returns the largest number of list elements that could possibly be in
 *	this string, interpreted as a Tcl list. If 'endPtr' is not NULL,
 *	writes a pointer to the end of the string scanned there.
 *	Returns the largest number of list elements that could possibly
 *	be in this string, interpreted as a Tcl list.  If 'endPtr' is not
 *	NULL, writes a pointer to the end of the string scanned there.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMaxListLength(
    const char *bytes,
    size_t numBytes,
    const char **endPtr)
    CONST char *bytes,
    int numBytes,
    CONST char **endPtr)
{
    size_t count = 0;
    int count = 0;

    if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) {
    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
	/* Empty string case - quick exit */
	goto done;
    }

    /*
     * No list element before leading white space.
    /* No list element before leading white space */
     */

    count += 1 - TclIsSpaceProcM(*bytes);

    /*
     * Count white space runs as potential element separators.
    /* Count white space runs as potential element separators */
     */

    while (numBytes) {
	if ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0')) {
	if ((numBytes == -1) && (*bytes == '\0')) {
	    break;
	}
	if (TclIsSpaceProcM(*bytes)) {
	    /*
	     * Space run started; bump count.
	    /* Space run started; bump count */
	     */

	    count++;
	    do {
		bytes++;
		numBytes -= (numBytes != TCL_INDEX_NONE);
		numBytes -= (numBytes != -1);
	    } while (numBytes && TclIsSpaceProcM(*bytes));
	    if ((numBytes == 0) || ((numBytes == TCL_INDEX_NONE) && (*bytes == '\0'))) {
	    if ((numBytes == 0) || ((numBytes == -1) && (*bytes == '\0'))) {
		break;
	    }

	    /*
	     * (*bytes) is non-space; return to counting state.
	    /* (*bytes) is non-space; return to counting state */
	     */
	}
	bytes++;
	numBytes -= (numBytes != TCL_INDEX_NONE);
	numBytes -= (numBytes != -1);
    }

    /*
     * No list element following trailing white space.
    /* No list element following trailing white space */
     */

    count -= TclIsSpaceProcM(bytes[-1]);

  done:
    done:
    if (endPtr) {
	*endPtr = bytes;
    }
    return count;
}

/*
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
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
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







-
-
+
+




-
-
-
-
-
-
+
+
+
+
+
+












-
+



-
+

-
+


-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+


-
-
+
+

-
+



-
-
+
+


-
+







 *
 *	If TCL_OK is returned, then *elementPtr will be set to point to the
 *	first element of list, and *nextPtr will be set to point to the
 *	character just after any white space following the last character
 *	that's part of the element. If this is the last argument in the list,
 *	then *nextPtr will point just after the last character in the list
 *	(i.e., at the character at list+listLength). If sizePtr is non-NULL,
 *	*sizePtr is filled in with the number of bytes in the element. If the
 *	element is in braces, then *elementPtr will point to the character
 *	*sizePtr is filled in with the number of bytes in the element. If
 *	the element is in braces, then *elementPtr will point to the character
 *	after the opening brace and *sizePtr will not include either of the
 *	braces. If there isn't an element in the list, *sizePtr will be zero,
 *	and both *elementPtr and *nextPtr will point just after the last
 *	character in the list. If literalPtr is non-NULL, *literalPtr is set
 *	to a boolean value indicating whether the substring returned as the
 *	values of **elementPtr and *sizePtr is the literal value of a list
 *	element. If not, a call to TclCopyAndCollapse() is needed to produce
 *	the actual value of the list element. Note: this function does NOT
 *	collapse backslash sequences, but uses *literalPtr to tell callers
 *	when it is required for them to do so.
 *	to a boolean value indicating whether the substring returned as
 *	the values of **elementPtr and *sizePtr is the literal value of
 *	a list element.  If not, a call to TclCopyAndCollapse() is needed
 *	to produce the actual value of the list element.  Note: this function
 *	does NOT collapse backslash sequences, but uses *literalPtr to tell
 * 	callers when it is required for them to do so.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclFindElement(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *list,		/* Points to the first byte of a string
    CONST char *list,		/* Points to the first byte of a string
				 * containing a Tcl list with zero or more
				 * elements (possibly in braces). */
    int listLength,		/* Number of bytes in the list's string. */
    const char **elementPtr,	/* Where to put address of first significant
    CONST char **elementPtr,	/* Where to put address of first significant
				 * character in first element of list. */
    const char **nextPtr,	/* Fill in with location of character just
    CONST char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
    int *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
{
    return FindElement(interp, list, listLength, "list", "LIST", elementPtr,
	    nextPtr, sizePtr, literalPtr);
}

int
TclFindDictElement(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *dict,		/* Points to the first byte of a string
				 * containing a Tcl dictionary with zero or
				 * more keys and values (possibly in
				 * braces). */
    int dictLength,		/* Number of bytes in the dict's string. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in the first element (i.e., key
				 * or value) of dict. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * element (next arg or end of list). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal key or value and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
{
    return FindElement(interp, dict, dictLength, "dict", "DICTIONARY",
	    elementPtr, nextPtr, sizePtr, literalPtr);
}

static int
FindElement(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    const char *string,		/* Points to the first byte of a string
				 * containing a Tcl list or dictionary with
				 * zero or more elements (possibly in
				 * braces). */
    int stringLength,		/* Number of bytes in the string. */
    const char *typeStr,	/* The name of the type of thing we are
				 * parsing, for error messages. */
    const char *typeCode,	/* The type code for thing we are parsing, for
				 * error messages. */
    const char **elementPtr,	/* Where to put address of first significant
				 * character in first element. */
    const char **nextPtr,	/* Fill in with location of character just
				 * after all white space following end of
				 * argument (next arg or end of list/dict). */
    size_t *sizePtr,		/* If non-zero, fill in with size of
				 * element. */
    int *literalPtr)		/* If non-zero, fill in with non-zero/zero to
				 * indicate that the substring of *sizePtr
				 * bytes starting at **elementPtr is/is not
				 * the literal list/dict element and therefore
				 * does not/does require a call to
				 * TclCopyAndCollapse() by the caller. */
{
    const char *p = string;
    const char *elemStart;	/* Points to first byte of first element. */
    const char *limit;		/* Points just after list/dict's last byte. */
    CONST char *p = list;
    CONST char *elemStart;	/* Points to first byte of first element. */
    CONST char *limit;		/* Points just after list's last byte. */
    int openBraces = 0;		/* Brace nesting level during parse. */
    int inQuotes = 0;
    int size = 0;
    size_t numChars;
    int size = 0;		/* lint. */
    int numChars;
    int literal = 1;
    const char *p2;
    CONST char *p2;

    /*
     * Skim off leading white space and check for an opening brace or quote.
     * We treat embedded NULLs in the list/dict as bytes belonging to a list
     * element (or dictionary key or value).
     * We treat embedded NULLs in the list as bytes belonging to a list
     * element.
     */

    limit = (string + stringLength);
    limit = (list + listLength);
    while ((p < limit) && (TclIsSpaceProcM(*p))) {
	p++;
    }
    if (p == limit) {		/* no element found */
	elemStart = limit;
	goto done;
    }
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
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







-
-
+
+
-
-















-
-
+
+

-







		if (interp != NULL) {
		    p2 = p;
		    while ((p2 < limit) && (!TclIsSpaceProcM(*p2))
			    && (p2 < p+20)) {
			p2++;
		    }
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "%s element in braces followed by \"%.*s\" "
			    "instead of space", typeStr, (int) (p2-p), p));
			    "list element in braces followed by \"%.*s\" "
			    "instead of space", (int) (p2-p), p));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
			    NULL);
		}
		return TCL_ERROR;
	    }
	    break;

	    /*
	     * Backslash: skip over everything up to the end of the backslash
	     * sequence.
	     */

	case '\\':
	    if (openBraces == 0) {
		/*
		 * A backslash sequence not within a brace quoted element
		 * means the value of the element is different from the
		 * substring we are parsing. A call to TclCopyAndCollapse() is
		 * needed to produce the element value. Inform the caller.
		 * substring we are parsing.  A call to TclCopyAndCollapse()
		 * is needed to produce the element value.  Inform the caller.
		 */

		literal = 0;
	    }
	    TclParseBackslash(p, limit - p, &numChars, NULL);
	    p += (numChars - 1);
	    break;

	    /*
694
695
696
697
698
699
700
701
702


703
704
705
706
707
708
709
710
711
613
614
615
616
617
618
619


620
621


622
623
624
625
626
627
628







-
-
+
+
-
-







		if (interp != NULL) {
		    p2 = p;
		    while ((p2 < limit) && (!TclIsSpaceProcM(*p2))
			    && (p2 < p+20)) {
			p2++;
		    }
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "%s element in quotes followed by \"%.*s\" "
			    "instead of space", typeStr, (int) (p2-p), p));
			    "list element in quotes followed by \"%.*s\" "
			    "instead of space", (int) (p2-p), p));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "JUNK",
			    NULL);
		}
		return TCL_ERROR;
	    }
	    break;

	default:
	    if (TclIsSpaceProcM(*p)) {
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
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







-
+





-
-
+
-
-
+




-
-
+
-
-
+







	    break;

	}
	p++;
    }

    /*
     * End of list/dict: terminate element.
     * End of list: terminate element.
     */

    if (p == limit) {
	if (openBraces != 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"unmatched open brace in %s", typeStr));
		Tcl_SetResult(interp, "unmatched open brace in list",
		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "BRACE",
			NULL);
			TCL_STATIC);
	    }
	    return TCL_ERROR;
	} else if (inQuotes) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"unmatched open quote in %s", typeStr));
		Tcl_SetResult(interp, "unmatched open quote in list",
		Tcl_SetErrorCode(interp, "TCL", "VALUE", typeCode, "QUOTE",
			NULL);
			TCL_STATIC);
	    }
	    return TCL_ERROR;
	}
	size = (p - elemStart);
    }

  done:
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
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







-
-
-
+
+
+







-
+

-
-
+
+


-
+



-

-
-
+
+







 *
 * TclCopyAndCollapse --
 *
 *	Copy a string and substitute all backslash escape sequences
 *
 * Results:
 *	Count bytes get copied from src to dst. Along the way, backslash
 *	sequences are substituted in the copy. After scanning count bytes from
 *	src, a null character is placed at the end of dst. Returns the number
 *	of bytes that got written to dst.
 *	sequences are substituted in the copy.  After scanning count bytes
 *	from src, a null character is placed at the end of dst.  Returns
 *	the number of bytes that got written to dst.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
TclCopyAndCollapse(
    size_t count,			/* Number of byte to copy from src. */
    const char *src,		/* Copy from here... */
    int count,			/* Number of byte to copy from src. */
    CONST char *src,		/* Copy from here... */
    char *dst)			/* ... to here. */
{
    size_t newCount = 0;
    int newCount = 0;

    while (count > 0) {
	char c = *src;

	if (c == '\\') {
	    size_t numRead;
	    size_t backslashCount = TclParseBackslash(src, count, &numRead, dst);
	    int numRead;
	    int backslashCount = TclParseBackslash(src, count, &numRead, dst);

	    dst += backslashCount;
	    newCount += backslashCount;
	    src += numRead;
	    count -= numRead;
	} else {
	    *dst = c;
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
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







-
+


-
+


-
+

-
+
-


-
-
-
-
-
+
+
+
+
+
+




+
-
+



-
+






-
+






-
+

-
-
+
-
-
+





-
+







 *----------------------------------------------------------------------
 */

int
Tcl_SplitList(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, no error message is left. */
    const char *list,		/* Pointer to string with list structure. */
    CONST char *list,		/* Pointer to string with list structure. */
    int *argcPtr,		/* Pointer to location to fill in with the
				 * number of elements in the list. */
    const char ***argvPtr)	/* Pointer to place to store pointer to array
    CONST char ***argvPtr)	/* Pointer to place to store pointer to array
				 * of pointers to list elements. */
{
    const char **argv, *end, *element;
    CONST char **argv, *end, *element;
    char *p;
    int length, size, i, result;
    int length, size, i, result, elSize;
    size_t elSize;

    /*
     * Allocate enough space to work in. A (const char *) for each (possible)
     * list element plus one more for terminating NULL, plus as many bytes as
     * in the original string value, plus one more for a terminating '\0'.
     * Space used to hold element separating white space in the original
     * string gets re-purposed to hold '\0' characters in the argv array.
     * Allocate enough space to work in. A (CONST char *) for each
     * (possible) list element plus one more for terminating NULL,
     * plus as many bytes as in the original string value, plus one
     * more for a terminating '\0'.  Space used to hold element separating
     * white space in the original string gets re-purposed to hold '\0'
     * characters in the argv array.
     */

    size = TclMaxListLength(list, -1, &end) + 1;
    length = end - list;
    argv = (CONST char **) ckalloc((unsigned)
    argv = (const char **)Tcl_Alloc((size * sizeof(char *)) + length + 1);
	    ((size * sizeof(char *)) + length + 1));

    for (i = 0, p = ((char *) argv) + size*sizeof(char *);
	    *list != 0;  i++) {
	const char *prevList = list;
	CONST char *prevList = list;
	int literal;

	result = TclFindElement(interp, list, length, &element, &list,
		&elSize, &literal);
	length -= (list - prevList);
	if (result != TCL_OK) {
	    Tcl_Free((void *)argv);
	    ckfree((char *) argv);
	    return result;
	}
	if (*element == 0) {
	    break;
	}
	if (i >= size) {
	    Tcl_Free((void *)argv);
	    ckfree((char *) argv);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"internal error in Tcl_SplitList", -1));
		Tcl_SetResult(interp, "internal error in Tcl_SplitList",
		Tcl_SetErrorCode(interp, "TCL", "INTERNAL", "Tcl_SplitList",
			NULL);
			TCL_STATIC);
	    }
	    return TCL_ERROR;
	}
	argv[i] = p;
	if (literal) {
	    memcpy(p, element, elSize);
	    memcpy(p, element, (size_t) elSize);
	    p += elSize;
	    *p = 0;
	    p++;
	} else {
	    p += 1 + TclCopyAndCollapse(elSize, element, p);
	}
    }
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
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







-
-
-
+
+
+








-
+

-
-
-
+
+
+
















-
-
-
-
+
+
+
+







-
+

-
-
+
+



-
+











-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
+
+



-
-
-
-
+
+
+
+







-
+

-
-
-
+
+
+


-
+


-
+





-
+





-
+

-
+
-
-
+
-
-







 * Tcl_ScanElement --
 *
 *	This function is a companion function to Tcl_ConvertElement. It scans
 *	a string to see what needs to be done to it (e.g. add backslashes or
 *	enclosing braces) to make the string into a valid Tcl list element.
 *
 * Results:
 *	The return value is an overestimate of the number of bytes that will
 *	be needed by Tcl_ConvertElement to produce a valid list element from
 *	src. The word at *flagPtr is filled in with a value needed by
 *	The return value is an overestimate of the number of bytes that
 *	will be needed by Tcl_ConvertElement to produce a valid list element
 *	from src. The word at *flagPtr is filled in with a value needed by
 *	Tcl_ConvertElement when doing the actual conversion.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_ScanElement(
    const char *src,	/* String to convert to list element. */
    int *flagPtr)	/* Where to store information to guide
			 * Tcl_ConvertCountedElement. */
    register CONST char *src,	/* String to convert to list element. */
    register int *flagPtr)	/* Where to store information to guide
				 * Tcl_ConvertCountedElement. */
{
    return Tcl_ScanCountedElement(src, -1, flagPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ScanCountedElement --
 *
 *	This function is a companion function to Tcl_ConvertCountedElement. It
 *	scans a string to see what needs to be done to it (e.g. add
 *	backslashes or enclosing braces) to make the string into a valid Tcl
 *	list element. If length is -1, then the string is scanned from src up
 *	to the first null byte.
 *
 * Results:
 *	The return value is an overestimate of the number of bytes that will
 *	be needed by Tcl_ConvertCountedElement to produce a valid list element
 *	from src. The word at *flagPtr is filled in with a value needed by
 *	Tcl_ConvertCountedElement when doing the actual conversion.
 *	The return value is an overestimate of the number of bytes that
 *	will be needed by Tcl_ConvertCountedElement to produce a valid list
 *	element from src. The word at *flagPtr is filled in with a value
 *	needed by Tcl_ConvertCountedElement when doing the actual conversion.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_ScanCountedElement(
    const char *src,		/* String to convert to Tcl list element. */
    size_t length,		/* Number of bytes in src, or -1. */
    CONST char *src,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in src, or -1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    char flags = CONVERT_ANY;
    int flags = CONVERT_ANY;
    int numBytes = TclScanElement(src, length, &flags);

    *flagPtr = flags;
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclScanElement --
 *
 *	This function is a companion function to TclConvertElement. It scans a
 *	string to see what needs to be done to it (e.g. add backslashes or
 *	enclosing braces) to make the string into a valid Tcl list element. If
 *	length is -1, then the string is scanned from src up to the first null
 *	byte. A NULL value for src is treated as an empty string. The incoming
 *	value of *flagPtr is a report from the caller what additional flags it
 *	will pass to TclConvertElement().
 *	This function is a companion function to TclConvertElement. It
 *	scans a string to see what needs to be done to it (e.g. add
 *	backslashes or enclosing braces) to make the string into a valid Tcl
 *	list element. If length is -1, then the string is scanned from src up
 *	to the first null byte.  A NULL value for src is treated as an
 *	empty string.  The incoming value of *flagPtr is a report from the
 *	caller what additional flags it will pass to TclConvertElement().
 *
 * Results:
 *	The recommended formatting mode for the element is determined and a
 *	value is written to *flagPtr indicating that recommendation. This
 *	The recommended formatting mode for the element is determined and
 *	a value is written to *flagPtr indicating that recommendation.  This
 *	recommendation is combined with the incoming flag values in *flagPtr
 *	set by the caller to determine how many bytes will be needed by
 *	TclConvertElement() in which to write the formatted element following
 *	the recommendation modified by the flag values. This number of bytes
 *	is the return value of the routine.  In some situations it may be an
 *	overestimate, but so long as the caller passes the same flags to
 *	TclConvertElement(), it will be large enough.
 *	the recommendation modified by the flag values.  This number of bytes
 *	is the return value of the routine.  In some situations it may be
 *	an overestimate, but so long as the caller passes the same flags
 *	to TclConvertElement(), it will be large enough.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
TclScanElement(
    const char *src,		/* String to convert to Tcl list element. */
    size_t length,		/* Number of bytes in src, or -1. */
    char *flagPtr)		/* Where to store information to guide
    CONST char *src,		/* String to convert to Tcl list element. */
    int length,			/* Number of bytes in src, or -1. */
    int *flagPtr)		/* Where to store information to guide
				 * Tcl_ConvertElement. */
{
    const char *p = src;
    CONST char *p = src;
    int nestingLevel = 0;	/* Brace nesting count */
    int forbidNone = 0;		/* Do not permit CONVERT_NONE mode. Something
				 * needs protection or escape. */
				   needs protection or escape. */
    int requireEscape = 0;	/* Force use of CONVERT_ESCAPE mode.  For some
				 * reason bare or brace-quoted form fails. */
    int extra = 0;		/* Count of number of extra bytes needed for
				 * formatted element, assuming we use escape
				 * sequences in formatting. */
    size_t bytesNeeded;		/* Buffer length computed to complete the
    int bytesNeeded;		/* Buffer length computed to complete the
				 * element formatting in the selected mode. */
#if COMPAT
    int preferEscape = 0;	/* Use preferences to track whether to use */
    int preferBrace = 0;	/* CONVERT_MASK mode. */
    int braceCount = 0;		/* Count of all braces '{' '}' seen. */
#endif /* COMPAT */
#endif

    if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == TCL_INDEX_NONE))) {
    if ((p == NULL) || (length == 0) || ((*p == '\0') && (length == -1))) {
	/*
	 * Empty string element must be brace quoted.
	/* Empty string element must be brace quoted. */
	 */

	*flagPtr = CONVERT_BRACE;
	return 2;
    }

#if COMPAT
    /*
     * We have an established history in TclConvertElement() when quoting
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
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
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
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


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







-



-
+



-

-
+


-
+



-
+


-
+



-
-
+
-
-



-
-
+
+







-
-
-
-
+
+
+
+




-
+

-
+

-
+
-
-
+
-
-





-
-
-
+
-
-













-
+

-
-
+
+














-
-
+



-
+

-
-
+
-
-



-
-
+
-
-




-
-
+
+

-

-
-
-
+
-
-




-
+




-
-
-
-
-
+
+
+
+
+

-







-
-
+
-
-



-
-
-
-
+
+
+
+
+

-





-





-




-
+

-
+





-

-
-
-
+
-
-




-
-
+
-
-



-
+


-
-
+
-
-

-
-
+
-
-



+
+
+
+
+







#endif

    if ((*p == '{') || (*p == '"')) {
	/*
	 * Must escape or protect so leading character of value is not
	 * misinterpreted as list element delimiting syntax.
	 */

	forbidNone = 1;
#if COMPAT
	preferBrace = 1;
#endif /* COMPAT */
#endif
    }

    while (length) {
      if (CHAR_TYPE(*p) != TYPE_NORMAL) {
	switch (*p) {
	case '{':	/* TYPE_BRACE */
	case '{':
#if COMPAT
	    braceCount++;
#endif /* COMPAT */
#endif
	    extra++;				/* Escape '{' => '\{' */
	    nestingLevel++;
	    break;
	case '}':	/* TYPE_BRACE */
	case '}':
#if COMPAT
	    braceCount++;
#endif /* COMPAT */
#endif
	    extra++;				/* Escape '}' => '\}' */
	    nestingLevel--;
	    if (nestingLevel < 0) {
		/*
		 * Unbalanced braces!  Cannot format with brace quoting.
		/* Unbalanced braces!  Cannot format with brace quoting. */
		 */

		requireEscape = 1;
	    }
	    break;
	case ']':	/* TYPE_CLOSE_BRACK */
	case '"':	/* TYPE_SPACE */
	case ']':
	case '"':
#if COMPAT
	    forbidNone = 1;
	    extra++;		/* Escapes all just prepend a backslash */
	    preferEscape = 1;
	    break;
#else
	    /* FLOW THROUGH */
#endif /* COMPAT */
	case '[':	/* TYPE_SUBS */
	case '$':	/* TYPE_SUBS */
	case ';':	/* TYPE_COMMAND_END */
#endif
	case '[':
	case '$':
	case ';':
	    forbidNone = 1;
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
#endif
	    break;
	case '\\':	/* TYPE_SUBS */
	case '\\':
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == TCL_INDEX_NONE) && (p[1] == '\0'))) {
	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
		/*
		 * Final backslash. Cannot format with brace quoting.
		/* Final backslash. Cannot format with brace quoting. */
		 */

		requireEscape = 1;
		break;
	    }
	    if (p[1] == '\n') {
		extra++;	/* Escape newline => '\n', one byte longer */

		/*
		 * Backslash newline sequence.  Brace quoting not permitted.
		/* Backslash newline sequence.  Brace quoting not permitted. */
		 */

		requireEscape = 1;
		length -= (length > 0);
		p++;
		break;
	    }
	    if ((p[1] == '{') || (p[1] == '}') || (p[1] == '\\')) {
		extra++;	/* Escape sequences all one byte longer. */
		length -= (length > 0);
		p++;
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif /* COMPAT */
#endif
	    break;
	case '\0':	/* TYPE_SUBS */
	    if (length == TCL_INDEX_NONE) {
	case '\0':
	    if (length == -1) {
		goto endOfString;
	    }
	    /* TODO: Panic on improper encoding? */
	    break;
	default:
	    if (TclIsSpaceProcM(*p)) {
		forbidNone = 1;
		extra++;	/* Escape sequences all one byte longer. */
#if COMPAT
		preferBrace = 1;
#endif
	    }
	    break;
	}
      }
	length -= (length+1 > 1);
	length -= (length > 0);
	p++;
    }

  endOfString:
    endOfString:
    if (nestingLevel != 0) {
	/*
	 * Unbalanced braces!  Cannot format with brace quoting.
	/* Unbalanced braces!  Cannot format with brace quoting. */
	 */

	requireEscape = 1;
    }

    /*
     * We need at least as many bytes as are in the element value...
    /* We need at least as many bytes as are in the element value... */
     */

    bytesNeeded = p - src;

    if (requireEscape) {
	/*
	 * We must use escape sequences.  Add all the extra bytes needed to
	 * have room to create them.
	 * We must use escape sequences.  Add all the extra bytes needed
	 * to have room to create them.
	 */

	bytesNeeded += extra;

	/*
	 * Make room to escape leading #, if needed.
	/* Make room to escape leading #, if needed. */
	 */

	if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
	    bytesNeeded++;
	}
	*flagPtr = CONVERT_ESCAPE;
	return bytesNeeded;
	goto overflowCheck;
    }
    if (*flagPtr & CONVERT_ANY) {
	/*
	 * The caller has not let us know what flags it will pass to
	 * TclConvertElement() so compute the max size we might need for any
	 * possible choice.  Normally the formatting using escape sequences is
	 * the longer one, and a minimum "extra" value of 2 makes sure we
	 * don't request too small a buffer in those edge cases where that's
	 * not true.
	 * TclConvertElement() so compute the max size we might need for
	 * any possible choice.  Normally the formatting using escape
	 * sequences is the longer one, and a minimum "extra" value of 2
	 * makes sure we don't request too small a buffer in those edge
	 * cases where that's not true.
	 */

	if (extra < 2) {
	    extra = 2;
	}
	*flagPtr &= ~CONVERT_ANY;
	*flagPtr |= TCL_DONT_USE_BRACES;
    }
    if (forbidNone) {
	/*
	 * We must request some form of quoting of escaping...
	/* We must request some form of quoting of escaping... */
	 */

#if COMPAT
	if (preferEscape && !preferBrace) {
	    /*
	     * If we are quoting solely due to ] or internal " characters use
	     * the CONVERT_MASK mode where we escape all special characters
	     * except for braces. "extra" counted space needed to escape
	     * braces too, so substract "braceCount" to get our actual needs.
	     * If we are quoting solely due to ] or internal " characters
	     * use the CONVERT_MASK mode where we escape all special
	     * characters except for braces.  "extra" counted space needed
	     * to escape braces too, so substract "braceCount" to get our
	     * actual needs.
	     */

	    bytesNeeded += (extra - braceCount);
	    /* Make room to escape leading #, if needed. */
	    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
		bytesNeeded++;
	    }

	    /*
	     * If the caller reports it will direct TclConvertElement() to
	     * use full escapes on the element, add back the bytes needed to
	     * escape the braces.
	     */

	    if (*flagPtr & TCL_DONT_USE_BRACES) {
		bytesNeeded += braceCount;
	    }
	    *flagPtr = CONVERT_MASK;
	    return bytesNeeded;
	    goto overflowCheck;
	}
#endif /* COMPAT */
#endif
	if (*flagPtr & TCL_DONT_USE_BRACES) {
	    /*
	     * If the caller reports it will direct TclConvertElement() to
	     * use escapes, add the extra bytes needed to have room for them.
	     */

	    bytesNeeded += extra;

	    /*
	     * Make room to escape leading #, if needed.
	    /* Make room to escape leading #, if needed. */
	     */

	    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
		bytesNeeded++;
	    }
	} else {
	    /*
	     * Add 2 bytes for room for the enclosing braces.
	    /* Add 2 bytes for room for the enclosing braces. */
	     */

	    bytesNeeded += 2;
	}
	*flagPtr = CONVERT_BRACE;
	return bytesNeeded;
	goto overflowCheck;
    }

    /*
     * So far, no need to quote or escape anything.
    /* So far, no need to quote or escape anything. */
     */

    if ((*src == '#') && !(*flagPtr & TCL_DONT_QUOTE_HASH)) {
	/*
	 * If we need to quote a leading #, make room to enclose in braces.
	/* If we need to quote a leading #, make room to enclose in braces. */
	 */

	bytesNeeded += 2;
    }
    *flagPtr = CONVERT_NONE;

    overflowCheck:
    if (bytesNeeded < 0) {
	Tcl_Panic("TclScanElement: string length overflow");
    }
    return bytesNeeded;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConvertElement --
1306
1307
1308
1309
1310
1311
1312
1313

1314
1315
1316
1317



1318
1319
1320
1321
1322
1323
1324
1175
1176
1177
1178
1179
1180
1181

1182
1183



1184
1185
1186
1187
1188
1189
1190
1191
1192
1193







-
+

-
-
-
+
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_ConvertElement(
    const char *src,	/* Source information for list element. */
    char *dst,		/* Place to put list-ified element. */
    int flags)		/* Flags produced by Tcl_ScanElement. */
    register CONST char *src,	/* Source information for list element. */
    register char *dst,		/* Place to put list-ified element. */
    register int flags)		/* Flags produced by Tcl_ScanElement. */
{
    return Tcl_ConvertCountedElement(src, -1, dst, flags);
}

/*
 *----------------------------------------------------------------------
 *
1336
1337
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
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

1439
1440
1441
1442
1443
1444

1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455

1456
1457
1458
1459
1460
1461

1462
1463
1464

1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480


1481
1482
1483

1484

1485
1486
1487
1488
1489
1490
1491
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







-
+

-
-
+
+



-
+









-
-
-
+
+
+













-
-
-
-
+
+
+






-
-
+
-
-




-
-
+
-
-
-
-
-
-
+
+
+
+


-
-
+
-
-






-
+





-
-
+
-
-

-
+











-
-
+
-
-



-
+










-
+




-
-
+
-
-
-
+














-
-
+
+
-


+

+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
Tcl_ConvertCountedElement(
    const char *src,	/* Source information for list element. */
    size_t length,		/* Number of bytes in src, or -1. */
    register CONST char *src,	/* Source information for list element. */
    int length,			/* Number of bytes in src, or -1. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    size_t numBytes = TclConvertElement(src, length, dst, flags);
    int numBytes = TclConvertElement(src, length, dst, flags);
    dst[numBytes] = '\0';
    return numBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclConvertElement --
 *
 *	This is a companion function to TclScanElement. Given the information
 *	produced by TclScanElement, this function converts a string to a list
 *	element equal to that string.
 *	This is a companion function to TclScanElement. Given the
 *	information produced by TclScanElement, this function converts
 *	a string to a list element equal to that string.
 *
 * Results:
 *	Information is copied to *dst in the form of a list element identical
 *	to src (i.e. if Tcl_SplitList is applied to dst it will produce a
 *	string identical to src). The return value is a count of the number of
 *	characters copied (not including the terminating NULL character).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclConvertElement(
    const char *src,	/* Source information for list element. */
    size_t length,		/* Number of bytes in src, or -1. */
int TclConvertElement(
    register CONST char *src,	/* Source information for list element. */
    int length,			/* Number of bytes in src, or -1. */
    char *dst,			/* Place to put list-ified element. */
    int flags)			/* Flags produced by Tcl_ScanElement. */
{
    int conversion = flags & CONVERT_MASK;
    char *p = dst;

    /*
     * Let the caller demand we use escape sequences rather than braces.
    /* Let the caller demand we use escape sequences rather than braces. */
     */

    if ((flags & TCL_DONT_USE_BRACES) && (conversion & CONVERT_BRACE)) {
	conversion = CONVERT_ESCAPE;
    }

    /*
     * No matter what the caller demands, empty string must be braced!
    /* No matter what the caller demands, empty string must be braced! */
     */

    if ((src == NULL) || (length == 0) || (*src == '\0' && length == TCL_INDEX_NONE)) {
	p[0] = '{';
	p[1] = '}';
	return 2;
    if ((src == NULL) || (length == 0) || ((*src == '\0') && (length == -1))) {
	src = tclEmptyStringRep;
	length = 0;
	conversion = CONVERT_BRACE;
    }

    /*
     * Escape leading hash as needed and requested.
    /* Escape leading hash as needed and requested. */
     */

    if ((*src == '#') && !(flags & TCL_DONT_QUOTE_HASH)) {
	if (conversion == CONVERT_ESCAPE) {
	    p[0] = '\\';
	    p[1] = '#';
	    p += 2;
	    src++;
	    length -= (length+1 > 1);
	    length -= (length > 0);
	} else {
	    conversion = CONVERT_BRACE;
	}
    }

    /*
     * No escape or quoting needed.  Copy the literal string value.
    /* No escape or quoting needed.  Copy the literal string value. */
     */

    if (conversion == CONVERT_NONE) {
	if (length == TCL_INDEX_NONE) {
	if (length == -1) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	    return p - dst;
	} else {
	    memcpy(dst, src, length);
	    return length;
	}
    }

    /*
     * Formatted string is original string enclosed in braces.
    /* Formatted string is original string enclosed in braces. */
     */

    if (conversion == CONVERT_BRACE) {
	*p = '{';
	p++;
	if (length == TCL_INDEX_NONE) {
	if (length == -1) {
	    /* TODO: INT_MAX overflow? */
	    while (*src) {
		*p++ = *src++;
	    }
	} else {
	    memcpy(p, src, length);
	    p += length;
	}
	*p = '}';
	p++;
	return (size_t)(p - dst);
	return p - dst;
    }

    /* conversion == CONVERT_ESCAPE or CONVERT_MASK */

    /*
     * Formatted string is original string converted to escape sequences.
    /* Formatted string is original string converted to escape sequences. */
     */

    for ( ; length; src++, length -= (length+1 > 1)) {
    for ( ; length; src++, length -= (length > 0)) {
	switch (*src) {
	case ']':
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\\':
	case '"':
	    *p = '\\';
	    p++;
	    break;
	case '{':
	case '}':
#if COMPAT
	    if (conversion == CONVERT_ESCAPE)
#endif /* COMPAT */
	    if (conversion == CONVERT_ESCAPE) {
#endif
	    {
		*p = '\\';
		p++;
#if COMPAT
	    }
#endif
	    break;
	case '\f':
	    *p = '\\';
	    p++;
	    *p = 'f';
	    p++;
	    continue;
1510
1511
1512
1513
1514
1515
1516
1517
1518


1519
1520
1521
1522
1523
1524
1525
1526





1527
1528
1529
1530
1531
1532
1533
1534

1535
1536
1537
1538
1539
1540
1541
1361
1362
1363
1364
1365
1366
1367


1368
1369
1370

1371





1372
1373
1374
1375
1376
1377

1378
1379
1380
1381
1382

1383
1384
1385
1386
1387
1388
1389
1390







-
-
+
+

-

-
-
-
-
-
+
+
+
+
+

-





-
+







	case '\v':
	    *p = '\\';
	    p++;
	    *p = 'v';
	    p++;
	    continue;
	case '\0':
	    if (length == TCL_INDEX_NONE) {
		return (size_t)(p - dst);
	    if (length == -1) {
		return p - dst;
	    }

	    /*
	     * If we reach this point, there's an embedded NULL in the string
	     * range being processed, which should not happen when the
	     * encoding rules for Tcl strings are properly followed.  If the
	     * day ever comes when we stop tolerating such things, this is
	     * where to put the Tcl_Panic().
	     * If we reach this point, there's an embedded NULL in the
	     * string range being processed, which should not happen when
	     * the encoding rules for Tcl strings are properly followed.
	     * If the day ever comes when we stop tolerating such things,
	     * this is where to put the Tcl_Panic().
	     */

	    break;
	}
	*p = *src;
	p++;
    }
    return (size_t)(p - dst);
    return p - dst;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Merge --
 *
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447

1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465

1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476

1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532

1533
1534
1535

1536
1537
1538
1539

1540
1541
1542
1543
1544

1545
1546
1547
1548
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
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

1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641


1642


1643
1644
1645
1646
1647
1648
1649







-
+

-
-
+
+
-
-
+

+

+
-
-
-
-
+
+
+
+
-
-
-
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+




+
+
+
+
+
+







-
+










-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
+


-
+



-
+




-






-
-
+
-
-

+

-
+




-
+


-
-
+
-
-

+
-
+










-
-
+
-
-












-













-
+


-
+



-
+




-






-
-
+
-
-

+
-
+

-
+

-
-
+
-
-

+
-
+










-
-
+
-
-







 *
 *----------------------------------------------------------------------
 */

char *
Tcl_Merge(
    int argc,			/* How many strings to merge. */
    const char *const *argv)	/* Array of string values. */
    CONST char * CONST *argv)	/* Array of string values. */
{
#define LOCAL_SIZE 64
    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
#   define LOCAL_SIZE 20
    int localFlags[LOCAL_SIZE], *flagPtr = NULL;
    int i;
    size_t bytesNeeded = 0;
    int i, bytesNeeded = 0;
    char *result, *dst;
    const int maxFlags = UINT_MAX / sizeof(int);

    if (argc == 0) {
    /*
     * Handle empty list case first, so logic of the general case can be
     * simpler.
     */
	/*
	 * Handle empty list case first, so logic of the general case
	 * can be simpler.
	 */

    if (argc == 0) {
	result = (char *)Tcl_Alloc(1);
	result = ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * Pass 1: estimate space, gather flags.
     */

    if (argc <= LOCAL_SIZE) {
	flagPtr = localFlags;
    } else if (argc > maxFlags) {
	/*
	 * We cannot allocate a large enough flag array to format this
	 * list in one pass.  We could imagine converting this routine
	 * to a multi-pass implementation, but for sizeof(int) == 4,
	 * the limit is a max of 2^30 list elements and since each element
	 * is at least one byte formatted, and requires one byte space
	 * between it and the next one, that a minimum space requirement
	 * of 2^31 bytes, which is already INT_MAX. If we tried to format
	 * a list of > maxFlags elements, we're just going to overflow
	 * the size limits on the formatted string anyway, so just issue
	 * that same panic early.
	 */
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    } else {
	flagPtr = (char *)Tcl_Alloc(argc);
	flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
    }
    for (i = 0; i < argc; i++) {
	flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
	bytesNeeded += TclScanElement(argv[i], -1, &flagPtr[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
	}
    }
    if (bytesNeeded > INT_MAX - argc + 1) {
	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
    }
    bytesNeeded += argc;

    /*
     * Pass two: copy into the result area.
     */

    result = (char *)Tcl_Alloc(bytesNeeded);
    result = ckalloc((unsigned) bytesNeeded);
    dst = result;
    for (i = 0; i < argc; i++) {
	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
	dst += TclConvertElement(argv[i], -1, dst, flagPtr[i]);
	*dst = ' ';
	dst++;
    }
    dst[-1] = 0;

    if (flagPtr != localFlags) {
	Tcl_Free(flagPtr);
	ckfree((char *) flagPtr);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Backslash --
 *
 *	Figure out how to handle a backslash sequence.
 *
 * Results:
 *	The return value is the character that should be substituted in place
 *	of the backslash sequence that starts at src. If readPtr isn't NULL
 *	then it is filled in with a count of the number of characters in the
 *	backslash sequence.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char
Tcl_Backslash(
    CONST char *src,		/* Points to the backslash character of a
				 * backslash sequence. */
    int *readPtr)		/* Fill in with number of characters read from
				 * src, unless NULL. */
{
    char buf[TCL_UTF_MAX];
    Tcl_UniChar ch;

    Tcl_UtfBackslash(src, readPtr, buf);
    TclUtfToUniChar(buf, &ch);
    return (char) ch;
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrimRight --
 *	Takes two counted strings in the Tcl encoding.  Conceptually
 *	finds the sub string (offset) to trim from the right side of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the end of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
TclTrimRight(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
    int numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    size_t numTrim)	/* ...and its length in bytes */
    int numTrim)	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
{
    const char *pp, *p = bytes + numBytes;
    int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
    /* Outer loop: iterate over string to be trimmed */
     */

    do {
	Tcl_UniChar ch1;
	const char *q = trim;
    size_t pInc = 0, bytesLeft = numTrim;
	int pInc = 0, bytesLeft = numTrim;

	pp = TclUtfPrev(p, bytes);
	do {
	    pp += pInc;
 	    pInc = TclUtfToUCS4(pp, &ch1);
 	    pInc = TclUtfToUniChar(pp, &ch1);
	} while (pp + pInc < p);

	/*
	 * Inner loop: scan trim string for match to current character.
	/* Inner loop: scan trim string for match to current character */
	 */

	do {
	    Tcl_UniChar ch2;
	    size_t qInc = TclUtfToUCS4(q, &ch2);
	    int qInc = TclUtfToUniChar(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
	} while (bytesLeft);

	if (bytesLeft == 0) {
	    /*
	     * No match; trim task done; *p is last non-trimmed char.
	    /* No match; trim task done; *p is last non-trimmed char */
	     */

	    break;
	}
	p = pp;
    } while (p > bytes);

    return numBytes - (p - bytes);
}

/*
 *----------------------------------------------------------------------
 *
 * TclTrimLeft --
 *
 *	Takes two counted strings in the Tcl encoding.  Conceptually
 *	finds the sub string (offset) to trim from the left side of the
 *	first string all characters found in the second string.
 *
 * Results:
 *	The number of bytes to be removed from the start of the string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
TclTrimLeft(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
    int numBytes,	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    size_t numTrim)	/* ...and its length in bytes */
    int numTrim)	/* ...and its length in bytes */
			/* Calls to TclUtfToUniChar() in this routine
			 * rely on (trim[numTrim] == '\0'). */
{
    const char *p = bytes;
	int ch1, ch2;

    /* Empty strings -> nothing to do */
    if ((numBytes == 0) || (numTrim == 0)) {
	return 0;
    }

    /*
     * Outer loop: iterate over string to be trimmed.
    /* Outer loop: iterate over string to be trimmed */
     */

    do {
	Tcl_UniChar ch1;
	size_t pInc = TclUtfToUCS4(p, &ch1);
	int pInc = TclUtfToUniChar(p, &ch1);
	const char *q = trim;
	size_t bytesLeft = numTrim;
	int bytesLeft = numTrim;

	/*
	 * Inner loop: scan trim string for match to current character.
	/* Inner loop: scan trim string for match to current character */
	 */

	do {
	    Tcl_UniChar ch2;
	    size_t qInc = TclUtfToUCS4(q, &ch2);
	    int qInc = TclUtfToUniChar(q, &ch2);

	    if (ch1 == ch2) {
		break;
	    }

	    q += qInc;
	    bytesLeft -= qInc;
	} while (bytesLeft);

	if (bytesLeft == 0) {
	    /*
	     * No match; trim task done; *p is first non-trimmed char.
	    /* No match; trim task done; *p is first non-trimmed char */
	     */

	    break;
	}

	p += pInc;
	numBytes -= pInc;
    } while (numBytes > 0);

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
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







-
+


-
+



-
+


-
+

-
+











-

-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
TclTrim(
    const char *bytes,	/* String to be trimmed... */
    size_t numBytes,	/* ...and its length in bytes */
    int numBytes,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (bytes[numBytes] == '\0'). */
    const char *trim,	/* String of trim characters... */
    size_t numTrim,	/* ...and its length in bytes */
    int numTrim,	/* ...and its length in bytes */
			/* Calls in this routine
			 * rely on (trim[numTrim] == '\0'). */
    size_t *trimRightPtr)	/* Offset from the end of the string. */
    int *trimRightPtr)	/* Offset from the end of the string. */
{
    size_t trimLeft = 0, trimRight = 0;
    int trimLeft = 0, trimRight = 0;

    /* Empty strings -> nothing to do */
    if ((numBytes > 0) && (numTrim > 0)) {

	/* When bytes is NUL-terminated, returns 0 <= trimLeft <= numBytes */
	trimLeft = TclTrimLeft(bytes, numBytes, trim, numTrim);
	numBytes -= trimLeft;

	/* If we did not trim the whole string, it starts with a character
	 * that we will not trim. Skip over it. */
	if (numBytes > 0) {
	    int ch;
	    const char *first = bytes + trimLeft;
	    bytes += TclUtfToUCS4(first, &ch);
	    bytes = TclUtfNext(first);
	    numBytes -= (bytes - first);

	    if (numBytes > 0) {
		/* When bytes is NUL-terminated, returns
		 * 0 <= trimRight <= numBytes */
		trimRight = TclTrimRight(bytes, numBytes, trim, numTrim);
	    }
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
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
1786

1787
1788
1789
1790
1791
1792
1793
1794







+
-
+
+




-
+

-
-
+


-
-
+
-
-

-
+




-
-
+
-
-


+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


-
+






-
+
-


-



-
-
+
-
-




-
-
+
-
-



-
+







 *	Memory is allocated for the result; the caller is responsible for
 *	freeing the memory.
 *
 *----------------------------------------------------------------------
 */

/* The whitespace characters trimmed during [concat] operations */
/* TODO: Find a reasonable way to guarantee in sync with TclIsSpaceProc() */
#define CONCAT_WS_SIZE (sizeof(CONCAT_TRIM_SET "") - 1)
#define CONCAT_WS " \f\v\r\t\n"
#define CONCAT_WS_SIZE (int) (sizeof(CONCAT_WS "") - 1)

char *
Tcl_Concat(
    int argc,			/* Number of strings to concatenate. */
    const char *const *argv)	/* Array of strings to concatenate. */
    CONST char * CONST *argv)	/* Array of strings to concatenate. */
{
    int i;
    size_t needSpace = 0, bytesNeeded = 0;
    int i, needSpace = 0, bytesNeeded = 0;
    char *result, *p;

    /*
     * Dispose of the empty result corner case first to simplify later code.
    /* Dispose of the empty result corner case first to simplify later code */
     */

    if (argc == 0) {
	result = (char *) Tcl_Alloc(1);
	result = (char *) ckalloc(1);
	result[0] = '\0';
	return result;
    }

    /*
     * First allocate the result buffer at the size required.
    /* First allocate the result buffer at the size required */
     */

    for (i = 0;  i < argc;  i++) {
	bytesNeeded += strlen(argv[i]);
	if (bytesNeeded < 0) {
	    Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
    }

    /*
     * All element bytes + (argc - 1) spaces + 1 terminating NULL.
     */

    result = (char *)Tcl_Alloc(bytesNeeded + argc);
	}
    }
    if (bytesNeeded + argc - 1 < 0) {
	/*
	 * Panic test could be tighter, but not going to bother for
	 * this legacy routine.
	 */
	Tcl_Panic("Tcl_Concat: max size of Tcl value exceeded");
    }
    /* All element bytes + (argc - 1) spaces + 1 terminating NULL */
    result = (char *) ckalloc((unsigned) (bytesNeeded + argc));

    for (p = result, i = 0;  i < argc;  i++) {
	size_t triml, trimr, elemLength;
	int triml, trimr, elemLength;
	const char *element;

	element = argv[i];
	elemLength = strlen(argv[i]);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
	triml = TclTrim(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE, &trimr);
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;

	/* Do not permit trimming to expose a final backslash character. */
	elemLength += trimr && (element[elemLength - 1] == '\\');

	/*
	 * If we're left with empty element after trimming, do nothing.
	/* If we're left with empty element after trimming, do nothing */
	 */

	if (elemLength == 0) {
	    continue;
	}

	/*
	 * Append to the result with space if needed.
	/* Append to the result with space if needed */
	 */

	if (needSpace) {
	    *p++ = ' ';
	}
	memcpy(p, element, elemLength);
	memcpy(p, element, (size_t) elemLength);
	p += elemLength;
	needSpace = 1;
    }
    *p = '\0';
    return result;
}

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
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
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







-
+

-
-
+










-
+





-
+





+
+
+


+
+
+
+
+
+
+
+
+

-
+


+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+



-
+




-



-
-


+
+



+
+
-
-
+
+

-
-
-
+
+
+

-

-
+



-
+




-
+
-


-



-
-
+
-
-




-
-
+
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ConcatObj(
    int objc,			/* Number of objects to concatenate. */
    Tcl_Obj *const objv[])	/* Array of objects to concatenate. */
    Tcl_Obj *CONST objv[])	/* Array of objects to concatenate. */
{
    int i, needSpace = 0;
    size_t bytesNeeded = 0, elemLength;
    int i, elemLength, needSpace = 0, bytesNeeded = 0;
    const char *element;
    Tcl_Obj *objPtr, *resPtr;

    /*
     * Check first to see if all the items are of list type or empty. If so,
     * we will concat them together as lists, and return a list object. This
     * is only valid when the lists are in canonical form.
     */

    for (i = 0;  i < objc;  i++) {
	size_t length;
	int length;

	objPtr = objv[i];
	if (TclListObjIsCanonical(objPtr)) {
	    continue;
	}
	(void)TclGetStringFromObj(objPtr, &length);
	Tcl_GetStringFromObj(objPtr, &length);
	if (length > 0) {
	    break;
	}
    }
    if (i == objc) {
	Tcl_Obj **listv;
	int listc;

	resPtr = NULL;
	for (i = 0;  i < objc;  i++) {
	    /*
	     * Tcl_ListObjAppendList could be used here, but this saves us a
	     * bit of type checking (since we've already done it). Use of
	     * INT_MAX tells us to always put the new stuff on the end. It
	     * will be set right in Tcl_ListObjReplace.
	     * Note that all objs at this point are either lists or have an
	     * empty string rep.
	     */

	    objPtr = objv[i];
	    if (!TclListObjIsCanonical(objPtr)) {
	    if (objPtr->bytes && objPtr->length == 0) {
		continue;
	    }
	    TclListObjGetElements(NULL, objPtr, &listc, &listv);
	    if (listc) {
	    if (resPtr) {
		if (TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
		    /* Abandon ship! */
		    Tcl_DecrRefCount(resPtr);
		    goto slow;
		}
	    } else {
		resPtr = TclListObjCopy(NULL, objPtr);
		if (resPtr) {
		    if (Tcl_GetString(listv[0])[0] == '#'
			    || TCL_OK != Tcl_ListObjReplace(NULL, resPtr,
			    INT_MAX, 0, listc, listv)) {
			/* Abandon ship! */
			Tcl_DecrRefCount(resPtr);
			goto slow;
		    }
		} else {
		    resPtr = TclListObjCopy(NULL, objPtr);
		}
	    }
	}
	if (!resPtr) {
	    TclNewObj(resPtr);
	    resPtr = Tcl_NewObj();
	}
	return resPtr;
    }

  slow:
    /*
     * Something cannot be determined to be safe, so build the concatenation
     * the slow way, using the string representations.
     *
     * First try to pre-allocate the size required.
     */

  slow:
    /* First try to pre-allocate the size required */
    for (i = 0;  i < objc;  i++) {
	element = TclGetStringFromObj(objv[i], &elemLength);
	bytesNeeded += elemLength;
	if (bytesNeeded < 0) {
	    break;
    }

	}
    }
    /*
     * Does not matter if this fails, will simply try later to build up the
     * string with each Append reallocating as needed with the usual string
     * append algorithm.  When that fails it will report the error.
     * Does not matter if this fails, will simply try later to build up
     * the string with each Append reallocating as needed with the usual
     * string append algorithm.  When that fails it will report the error.
     */

    TclNewObj(resPtr);
    (void) Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_AttemptSetObjLength(resPtr, bytesNeeded + objc - 1);
    Tcl_SetObjLength(resPtr, 0);

    for (i = 0;  i < objc;  i++) {
	size_t triml, trimr;
	int triml, trimr;

	element = TclGetStringFromObj(objv[i], &elemLength);

	/* Trim away the leading/trailing whitespace. */
	triml = TclTrim(element, elemLength, CONCAT_TRIM_SET,
	triml = TclTrim(element, elemLength, CONCAT_WS, CONCAT_WS_SIZE, &trimr);
		CONCAT_WS_SIZE, &trimr);
	element += triml;
	elemLength -= triml + trimr;

	/* Do not permit trimming to expose a final backslash character. */
	elemLength += trimr && (element[elemLength - 1] == '\\');

	/*
	 * If we're left with empty element after trimming, do nothing.
	/* If we're left with empty element after trimming, do nothing */
	 */

	if (elemLength == 0) {
	    continue;
	}

	/*
	 * Append to the result with space if needed.
	/* Append to the result with space if needed */
	 */

	if (needSpace) {
	    Tcl_AppendToObj(resPtr, " ", 1);
	}
	Tcl_AppendToObj(resPtr, element, elemLength);
	needSpace = 1;
    }
    return resPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StringMatch --
 *
 *	See if a particular string matches a particular pattern.
 *
 * Results:
 *	The return value is 1 if string matches pattern, and 0 otherwise. The
 *	matching operation permits the following special characters in the
 *	pattern: *?\[] (see the manual entry for details on what these mean).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_StringMatch(
    CONST char *str,		/* String. */
    CONST char *pattern)	/* Pattern, which may contain special
				 * characters. */
{
    return Tcl_StringCaseMatch(str, pattern, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StringCaseMatch --
 *
 *	See if a particular string matches a particular pattern. Allows case
2059
2060
2061
2062
2063
2064
2065
2066
2067


2068
2069
2070
2071
2072

2073
2074
2075
2076
2077
2078
2079
1971
1972
1973
1974
1975
1976
1977


1978
1979
1980
1981
1982
1983

1984
1985
1986
1987
1988
1989
1990
1991







-
-
+
+




-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_StringCaseMatch(
    const char *str,		/* String. */
    const char *pattern,	/* Pattern, which may contain special
    CONST char *str,		/* String. */
    CONST char *pattern,	/* Pattern, which may contain special
				 * characters. */
    int nocase)			/* 0 for case sensitive, 1 for insensitive */
{
    int p, charLen;
    int ch1 = 0, ch2 = 0;
    Tcl_UniChar ch1, ch2;

    while (1) {
	p = *pattern;

	/*
	 * See if we're at the end of both the pattern and the string. If so,
	 * we succeeded. If we're at the end of the pattern but not at the end
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
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







-
+


-
+















-
+













-
+













-
+










-
+










-
+



-
+



-
+









-
+



-
+










-
+



-
+







	    }

	    /*
	     * This is a special case optimization for single-byte utf.
	     */

	    if (UCHAR(*pattern) < 0x80) {
		ch2 = (int)
		ch2 = (Tcl_UniChar)
			(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
	    } else {
		TclUtfToUCS4(pattern, &ch2);
		Tcl_UtfToUniChar(pattern, &ch2);
		if (nocase) {
		    ch2 = Tcl_UniCharToLower(ch2);
		}
	    }

	    while (1) {
		/*
		 * Optimization for matching - cruise through the string
		 * quickly if the next char in the pattern isn't a special
		 * character
		 */

		if ((p != '[') && (p != '?') && (p != '\\')) {
		    if (nocase) {
			while (*str) {
			    charLen = TclUtfToUCS4(str, &ch1);
			    charLen = TclUtfToUniChar(str, &ch1);
			    if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
				break;
			    }
			    str += charLen;
			}
		    } else {
			/*
			 * There's no point in trying to make this code
			 * shorter, as the number of bytes you want to compare
			 * each time is non-constant.
			 */

			while (*str) {
			    charLen = TclUtfToUCS4(str, &ch1);
			    charLen = TclUtfToUniChar(str, &ch1);
			    if (ch2 == ch1) {
				break;
			    }
			    str += charLen;
			}
		    }
		}
		if (Tcl_StringCaseMatch(str, pattern, nocase)) {
		    return 1;
		}
		if (*str == '\0') {
		    return 0;
		}
		str += TclUtfToUCS4(str, &ch1);
		str += TclUtfToUniChar(str, &ch1);
	    }
	}

	/*
	 * Check for a "?" as the next pattern character. It matches any
	 * single character.
	 */

	if (p == '?') {
	    pattern++;
	    str += TclUtfToUCS4(str, &ch1);
	    str += TclUtfToUniChar(str, &ch1);
	    continue;
	}

	/*
	 * Check for a "[" as the next pattern character. It is followed by a
	 * list of characters that are acceptable, or by a range (two
	 * characters separated by "-").
	 */

	if (p == '[') {
	    int startChar = 0, endChar = 0;
	    Tcl_UniChar startChar, endChar;

	    pattern++;
	    if (UCHAR(*str) < 0x80) {
		ch1 = (int)
		ch1 = (Tcl_UniChar)
			(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
		str++;
	    } else {
		str += TclUtfToUCS4(str, &ch1);
		str += Tcl_UtfToUniChar(str, &ch1);
		if (nocase) {
		    ch1 = Tcl_UniCharToLower(ch1);
		}
	    }
	    while (1) {
		if ((*pattern == ']') || (*pattern == '\0')) {
		    return 0;
		}
		if (UCHAR(*pattern) < 0x80) {
		    startChar = (int) (nocase
		    startChar = (Tcl_UniChar) (nocase
			    ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
		    pattern++;
		} else {
		    pattern += TclUtfToUCS4(pattern, &startChar);
		    pattern += Tcl_UtfToUniChar(pattern, &startChar);
		    if (nocase) {
			startChar = Tcl_UniCharToLower(startChar);
		    }
		}
		if (*pattern == '-') {
		    pattern++;
		    if (*pattern == '\0') {
			return 0;
		    }
		    if (UCHAR(*pattern) < 0x80) {
			endChar = (int) (nocase
			endChar = (Tcl_UniChar) (nocase
				? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
			pattern++;
		    } else {
			pattern += TclUtfToUCS4(pattern, &endChar);
			pattern += Tcl_UtfToUniChar(pattern, &endChar);
			if (nocase) {
			    endChar = Tcl_UniCharToLower(endChar);
			}
		    }
		    if (((startChar <= ch1) && (ch1 <= endChar))
			    || ((endChar <= ch1) && (ch1 <= startChar))) {
			/*
2260
2261
2262
2263
2264
2265
2266
2267
2268


2269
2270
2271
2272
2273
2274
2275
2172
2173
2174
2175
2176
2177
2178


2179
2180
2181
2182
2183
2184
2185
2186
2187







-
-
+
+







	}

	/*
	 * There's no special character. Just make sure that the next bytes of
	 * each string match.
	 */

	str += TclUtfToUCS4(str, &ch1);
	pattern += TclUtfToUCS4(pattern, &ch2);
	str += TclUtfToUniChar(str, &ch1);
	pattern += TclUtfToUniChar(pattern, &ch2);
	if (nocase) {
	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
		return 0;
	    }
	} else if (ch1 != ch2) {
	    return 0;
	}
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303



2304
2305
2306
2307



2308
2309
2310
2311
2312
2313
2314
2206
2207
2208
2209
2210
2211
2212



2213
2214
2215




2216
2217
2218
2219
2220
2221
2222
2223
2224
2225







-
-
-
+
+
+
-
-
-
-
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclByteArrayMatch(
    const unsigned char *string,/* String. */
    size_t strLen,			/* Length of String */
    const unsigned char *pattern,
    const unsigned char *string,	/* String. */
    int strLen,				/* Length of String */
    const unsigned char *pattern,	/* Pattern, which may contain special
				/* Pattern, which may contain special
				 * characters. */
    size_t ptnLen,			/* Length of Pattern */
    TCL_UNUSED(int) /*flags*/)
					 * characters. */
    int ptnLen,				/* Length of Pattern */
    int flags)
{
    const unsigned char *stringEnd, *patternEnd;
    unsigned char p;

    stringEnd = string + strLen;
    patternEnd = pattern + ptnLen;

2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2318
2319
2320
2321
2322
2323
2324

2325
2326
2327
2328
2329
2330
2331







-







		    endChar = *pattern;
		    pattern++;
		    if (((startChar <= ch1) && (ch1 <= endChar))
			    || ((endChar <= ch1) && (ch1 <= startChar))) {
			/*
			 * Matches ranges of form [a-z] or [z-a].
			 */

			break;
		    }
		} else if (startChar == ch1) {
		    break;
		}
	    }
	    while (*pattern != ']') {
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
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







-
-
-
+
+
+














-
-
-
+
+
+
-

-
+
-








-
+


-
-
+
+





-
-
+
+







}

/*
 *----------------------------------------------------------------------
 *
 * TclStringMatchObj --
 *
 *	See if a particular string matches a particular pattern. Allows case
 *	insensitivity. This is the generic multi-type handler for the various
 *	matching algorithms.
 *	See if a particular string matches a particular pattern.
 *	Allows case insensitivity.  This is the generic multi-type handler
 *	for the various matching algorithms.
 *
 * Results:
 *	The return value is 1 if string matches pattern, and 0 otherwise. The
 *	matching operation permits the following special characters in the
 *	pattern: *?\[] (see the manual entry for details on what these mean).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclStringMatchObj(
    Tcl_Obj *strObj,		/* string object. */
    Tcl_Obj *ptnObj,		/* pattern object. */
    int flags)			/* Only TCL_MATCH_NOCASE should be passed, or
    Tcl_Obj *strObj,	/* string object. */
    Tcl_Obj *ptnObj,	/* pattern object. */
    int flags)		/* Only TCL_MATCH_NOCASE should be passed or 0. */
				 * 0. */
{
    int match;
    int match, length, plen;
    size_t length = 0, plen = 0;

    /*
     * Promote based on the type of incoming object.
     * XXX: Currently doesn't take advantage of exact-ness that
     * XXX: TclReToGlob tells us about
    trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
     */

    if (TclHasIntRep(strObj, &tclStringType) || (strObj->typePtr == NULL)) {
    if (strObj->typePtr == &tclStringType) {
	Tcl_UniChar *udata, *uptn;

	udata = TclGetUnicodeFromObj(strObj, &length);
	uptn  = TclGetUnicodeFromObj(ptnObj, &plen);
	udata = Tcl_GetUnicodeFromObj(strObj, &length);
	uptn  = Tcl_GetUnicodeFromObj(ptnObj, &plen);
	match = TclUniCharMatch(udata, length, uptn, plen, flags);
    } else if (TclIsPureByteArray(strObj) && TclIsPureByteArray(ptnObj)
		&& !flags) {
	unsigned char *data, *ptn;

	data = TclGetByteArrayFromObj(strObj, &length);
	ptn  = TclGetByteArrayFromObj(ptnObj, &plen);
	data = Tcl_GetByteArrayFromObj(strObj, &length);
	ptn  = Tcl_GetByteArrayFromObj(ptnObj, &plen);
	match = TclByteArrayMatch(data, length, ptn, plen, 0);
    } else {
	match = Tcl_StringCaseMatch(TclGetString(strObj),
		TclGetString(ptnObj), flags);
    }
    return match;
}
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
2631
2632
2633

2634
2635
2636

2637
2638
2639
2640


2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
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







-
-
-
-
+
+
+
+


-
+
+
+

-
+













-
+

-
+


-
+




-
+


+
-
+

-
-
+
+








-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
+
+
-
-
-








 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DStringAppend(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *bytes,		/* String to append. If length is
				 * TCL_INDEX_NONE then this must be null-terminated. */
    size_t length)			/* Number of bytes from "bytes" to append. If
				 * TCL_INDEX_NONE, then append all of bytes, up to null
    CONST char *bytes,		/* String to append. If length is -1 then this
				 * must be null-terminated. */
    int length)			/* Number of bytes from "bytes" to append. If
				 * < 0, then append all of bytes, up to null
				 * at end. */
{
    size_t newSize;
    int newSize;
    char *dst;
    CONST char *end;

    if (length == TCL_INDEX_NONE) {
    if (length < 0) {
	length = strlen(bytes);
    }
    newSize = length + dsPtr->length;

    /*
     * Allocate a larger buffer for the string if the current one isn't large
     * enough. Allocate extra space in the new buffer so that there will be
     * room to grow before we have to allocate again.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);
	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    size_t index = TCL_INDEX_NONE;
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (bytes >= dsPtr->string
		    && bytes <= dsPtr->string + dsPtr->length) {
		index = bytes - dsPtr->string;
		offset = bytes - dsPtr->string;
	    }

	    dsPtr->string = ckrealloc((void *) dsPtr->string,
	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
		    (size_t) dsPtr->spaceAvl);

	    if (index != TCL_INDEX_NONE) {
		bytes = dsPtr->string + index;
	    if (offset >= 0) {
		bytes = dsPtr->string + offset;
	    }
	}
    }

    /*
     * Copy the new string into the buffer at the end of the old one.
     */

    memcpy(dsPtr->string + dsPtr->length, bytes, length);
    for (dst = dsPtr->string + dsPtr->length, end = bytes+length;
    dsPtr->length += length;
    dsPtr->string[dsPtr->length] = '\0';
    return dsPtr->string;
}

	    bytes < end; bytes++, dst++) {
/*
 *----------------------------------------------------------------------
 *
 * TclDStringAppendObj, TclDStringAppendDString --
 *
 *	Simple wrappers round Tcl_DStringAppend that make it easier to append
 *	from particular sources of strings.
 *
 *----------------------------------------------------------------------
 */

	*dst = *bytes;
char *
TclDStringAppendObj(
    Tcl_DString *dsPtr,
    Tcl_Obj *objPtr)
{
    size_t length;
    const char *bytes = TclGetStringFromObj(objPtr, &length);

    }
    return Tcl_DStringAppend(dsPtr, bytes, length);
}

    *dst = '\0';
char *
TclDStringAppendDString(
    Tcl_DString *dsPtr,
    Tcl_DString *toAppendPtr)
    dsPtr->length += length;
    return dsPtr->string;
{
    return Tcl_DStringAppend(dsPtr, Tcl_DStringValue(toAppendPtr),
	    Tcl_DStringLength(toAppendPtr));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringAppendElement --
 *
 *	Append a list element to the current value of a dynamic string.
2660
2661
2662
2663
2664
2665
2666
2667

2668
2669
2670
2671
2672
2673

2674
2675
2676
2677
2678
2679
2680
2681
2543
2544
2545
2546
2547
2548
2549

2550
2551
2552
2553
2554


2555

2556
2557
2558
2559
2560
2561
2562







-
+




-
-
+
-







 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DStringAppendElement(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    const char *element)	/* String to append. Must be
    CONST char *element)	/* String to append. Must be
				 * null-terminated. */
{
    char *dst = dsPtr->string + dsPtr->length;
    int needSpace = TclNeedSpace(dsPtr->string, dst);
    char flags = 0;
    int quoteHash = 1;
    int flags = 0, quoteHash = 1, newSize;
    size_t newSize;

    if (needSpace) {
	/*
	 * If we need a space to separate the new element from something
	 * already ending the string, we're not appending the first element
	 * of any list, so we need not quote any leading hash character.
	 */
2709
2710
2711
2712
2713
2714
2715
2716

2717
2718

2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729


2730
2731
2732
2733
2734
2735
2736
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







-
+

-
+










-
+
+







     * memcpy, not strcpy, to copy the string to a larger buffer, since there
     * may be embedded NULLs in the string in some cases.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize * 2;
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);
	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    int offset = -1;

	    /* See [16896d49fd] */
	    if (element >= dsPtr->string
		    && element <= dsPtr->string + dsPtr->length) {
		offset = element - dsPtr->string;
	    }

	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
	    dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
		    (size_t) dsPtr->spaceAvl);

	    if (offset >= 0) {
		element = dsPtr->string + offset;
	    }
	}
    }
    dst = dsPtr->string + dsPtr->length;
2760
2761
2762
2763
2764
2765
2766
2767


2768
2769
2770
2771
2772
2773
2774
2775

2776
2777

2778



2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799

2800
2801

2802
2803
2804


2805
2806
2807
2808
2809
2810
2811
2642
2643
2644
2645
2646
2647
2648

2649
2650
2651
2652
2653
2654
2655
2656
2657

2658
2659

2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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







-
+
+







-
+

-
+

+
+
+




















-
+

-
+


-
+
+







 *	either grow or shrink, depending on the value of length.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The length of dsPtr is changed to length and a null byte is stored at
 *	that position in the string.
 *	that position in the string. If length is larger than the space
 *	allocated for dsPtr, then a panic occurs.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DStringSetLength(
    Tcl_DString *dsPtr,		/* Structure describing dynamic string. */
    size_t length)			/* New length for dynamic string. */
    int length)			/* New length for dynamic string. */
{
    size_t newsize;
    int newsize;

    if (length < 0) {
	length = 0;
    }
    if (length >= dsPtr->spaceAvl) {
	/*
	 * There are two interesting cases here. In the first case, the user
	 * may be trying to allocate a large buffer of a specific size. It
	 * would be wasteful to overallocate that buffer, so we just allocate
	 * enough for the requested size plus the trailing null byte. In the
	 * second case, we are growing the buffer incrementally, so we need
	 * behavior similar to Tcl_DStringAppend. The requested length will
	 * usually be a small delta above the current spaceAvl, so we'll end
	 * up doubling the old size. This won't grow the buffer quite as
	 * quickly, but it should be close enough.
	 */

	newsize = dsPtr->spaceAvl * 2;
	if (length < newsize) {
	    dsPtr->spaceAvl = newsize;
	} else {
	    dsPtr->spaceAvl = length + 1;
	}
	if (dsPtr->string == dsPtr->staticSpace) {
	    char *newString = (char *)Tcl_Alloc(dsPtr->spaceAvl);
	    char *newString = ckalloc((unsigned) dsPtr->spaceAvl);

	    memcpy(newString, dsPtr->string, dsPtr->length);
	    memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
	    dsPtr->string = newString;
	} else {
	    dsPtr->string = (char *)Tcl_Realloc(dsPtr->string, dsPtr->spaceAvl);
	    dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
		    (size_t) dsPtr->spaceAvl);
	}
    }
    dsPtr->length = length;
    dsPtr->string[length] = 0;
}

/*
2827
2828
2829
2830
2831
2832
2833
2834

2835
2836
2837
2838
2839
2840
2841
2714
2715
2716
2717
2718
2719
2720

2721
2722
2723
2724
2725
2726
2727
2728







-
+







 */

void
Tcl_DStringFree(
    Tcl_DString *dsPtr)		/* Structure describing dynamic string. */
{
    if (dsPtr->string != dsPtr->staticSpace) {
	Tcl_Free(dsPtr->string);
	ckfree(dsPtr->string);
    }
    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}

2860
2861
2862
2863
2864
2865
2866

2867















2868
2869
2870
2871
2872
2873
2874
2747
2748
2749
2750
2751
2752
2753
2754

2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776







+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));

    if (dsPtr->string != dsPtr->staticSpace) {
	interp->result = dsPtr->string;
	interp->freeProc = TCL_DYNAMIC;
    } else if (dsPtr->length < TCL_RESULT_SIZE) {
	interp->result = ((Interp *) interp)->resultSpace;
	strcpy(interp->result, dsPtr->string);
    } else {
	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
    }

    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = '\0';
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringGetResult --
 *
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
2791
2792
2793
2794
2795
2796
2797

2798

2799
2800

2801





2802
2803
2804







2805



2806



2807





2808



2809








2810
2811
2812
2813
2814
2815

2816





2817
2818
2819
2820
2821
2822
2823




2824





2825
2826
2827
2828
2829
2830
2831
2832



2833




2834
2835


2836
2837
2838
2839
2840
2841
2842







-
+
-

+
-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-

-
-
-
-
-
+
+
+

+
+

-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-

-
-
-
-
+
+
-
-








void
Tcl_DStringGetResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
				 * of interp. */
{
    Tcl_Obj *obj = Tcl_GetObjResult(interp);
    Interp *iPtr = (Interp *) interp;
    char *bytes = TclGetString(obj);

    if (dsPtr->string != dsPtr->staticSpace) {
    Tcl_DStringFree(dsPtr);
	ckfree(dsPtr->string);
    Tcl_DStringAppend(dsPtr, bytes, obj->length);
    Tcl_ResetResult(interp);
}

/*
    }

    /*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --
 *
 *	This function moves a dynamic string's contents to a new Tcl_Obj. Be
 *	aware that this function does *not* check that the encoding of the
 *	contents of the dynamic string is correct; this is the caller's
     * If the string result is empty, move the object result to the string
 *	responsibility to enforce.
 *
 * Results:
     * result, then reset the object result.
 *	The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
 *	reference count of zero.
 *
     */
 * Side effects:
 *	The string is "moved" to the object. dsPtr is reinitialized to an
 *	empty string; it does not need to be Tcl_DStringFree'd after this if
 *	not used further.
 *

 *----------------------------------------------------------------------
 */

    (void) Tcl_GetStringResult(interp);
Tcl_Obj *
TclDStringToObj(
    Tcl_DString *dsPtr)
{
    Tcl_Obj *result;

    if (dsPtr->string == dsPtr->staticSpace) {
	if (dsPtr->length == 0) {

    dsPtr->length = strlen(iPtr->result);
    if (iPtr->freeProc != NULL) {
	if (iPtr->freeProc == TCL_DYNAMIC) {
	    dsPtr->string = iPtr->result;
	    dsPtr->spaceAvl = dsPtr->length+1;
	    TclNewObj(result);
	} else {
	    /*
	     * Static buffer, so must copy.
	     */

	    TclNewStringObj(result, dsPtr->string, dsPtr->length);
	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
	    memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
	    (*iPtr->freeProc)(iPtr->result);
	}
	dsPtr->spaceAvl = dsPtr->length+1;
	iPtr->freeProc = NULL;
    } else {
	/*
	 * Dynamic buffer, so transfer ownership and reset.
	 */

	if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
	TclNewObj(result);
	result->bytes = dsPtr->string;
	result->length = dsPtr->length;
    }

	    dsPtr->string = dsPtr->staticSpace;
	    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
	} else {
	    dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
	    dsPtr->spaceAvl = dsPtr->length + 1;
	}
	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
    }
    /*
     * Re-establish the DString as empty with no buffer allocated.
     */

    dsPtr->string = dsPtr->staticSpace;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->length = 0;
    dsPtr->staticSpace[0] = '\0';
    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringStartSublist --
 *
2980
2981
2982
2983
2984
2985
2986
2987

2988
2989

2990
2991
2992
2993
2994
2995
2996
2854
2855
2856
2857
2858
2859
2860

2861
2862

2863
2864
2865
2866
2867
2868
2869
2870







-
+

-
+







 */

void
Tcl_DStringStartSublist(
    Tcl_DString *dsPtr)		/* Dynamic string. */
{
    if (TclNeedSpace(dsPtr->string, dsPtr->string + dsPtr->length)) {
	TclDStringAppendLiteral(dsPtr, " {");
	Tcl_DStringAppend(dsPtr, " {", -1);
    } else {
	TclDStringAppendLiteral(dsPtr, "{");
	Tcl_DStringAppend(dsPtr, "{", -1);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringEndSublist --
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
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
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







-
+











-
-
-
+
+
+
+









-
+
+
+







-
-
+
+

+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
+




-
+

-
+

-
-
-
+
+
+

-
-
-
+
+
+

+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+















-
-
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
Tcl_DStringEndSublist(
    Tcl_DString *dsPtr)		/* Dynamic string. */
{
    TclDStringAppendLiteral(dsPtr, "}");
    Tcl_DStringAppend(dsPtr, "}", -1);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_PrintDouble --
 *
 *	Given a floating-point value, this function converts it to an ASCII
 *	string using.
 *
 * Results:
 *	The ASCII equivalent of "value" is written at "dst". It is guaranteed
 *	to contain a decimal point or exponent, so that it looks like a
 *	floating-point value and not an integer.
 *	The ASCII equivalent of "value" is written at "dst". It is written
 *	using the current precision, and it is guaranteed to contain a decimal
 *	point or exponent, so that it looks like a floating-point value and
 *	not an integer.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_PrintDouble(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Interpreter whose tcl_precision variable
				 * used to be used to control printing. It's
				 * ignored now. */
    double value,		/* Value to print as string. */
    char *dst)			/* Where to store converted value; must have
				 * at least TCL_DOUBLE_SPACE characters. */
{
    char *p, c;
    int exponent;
    int signum;
    char *digits;
    char *end;
    char* digits;
    char* end;

    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));

    /*
     * Handle NaN.
     */
	 * Handle NaN.
	 */

    if (TclIsNaN(value)) {
	TclFormatNaN(value, dst);
	return;
    }
	if (TclIsNaN(value)) {
	    TclFormatNaN(value, dst);
	    return;
	}

    /*
     * Handle infinities.
     */
	/*
	 * Handle infinities.
	 */

    if (TclIsInfinite(value)) {
	if (TclIsInfinite(value)) {
	/*
	 * Remember to copy the terminating NUL too.
	 */

	if (value < 0) {
	    if (value < 0) {
	    memcpy(dst, "-Inf", 5);
	} else {
	    } else {
	    memcpy(dst, "Inf", 4);
	}
	return;
    }
	    }
	    return;
	}

    /*
     * Ordinary (normal and denormal) values.
     */
	/*
	 * Ordinary (normal and denormal) values.
	 */

    if (*precisionPtr == 0) {
    digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
	    &exponent, &signum, &end);
    if (signum) {
	*dst++ = '-';
    }
	digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
				 &exponent, &signum, &end);
    } else {
	/*
	 * There are at least two possible interpretations for tcl_precision.
	 *
	 * The first is, "choose the decimal representation having
	 * $tcl_precision digits of significance that is nearest to the
	 * given number, breaking ties by rounding to even, and then
	 * trimming trailing zeros." This gives the greatest possible
	 * precision in the decimal string, but offers the anomaly that
	 * [expr 0.1] will be "0.10000000000000001".
	 *
	 * The second is "choose the decimal representation having at
	 * most $tcl_precision digits of significance that is nearest
	 * to the given number. If no such representation converts
	 * exactly to the given number, choose the one that is closest,
	 * breaking ties by rounding to even. If more than one such
	 * representation converts exactly to the given number, choose
	 * the shortest, breaking ties in favour of the nearest, breaking
	 * remaining ties in favour of the one ending in an even digit."
	 *
	 * Tcl 8.4 implements the first of these, which gives rise to
	 * anomalies in formatting:
	 *
	 * % expr 0.1
	 * 0.10000000000000001
	 * % expr 0.01
	 * 0.01
	 * % expr 1e-7
	 * 9.9999999999999995e-08
	 *
	 * For human readability, it appears better to choose the second rule,
	 * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we
	 * prefer the first (the recommended zero value for tcl_precision
	 * avoids the problem entirely).
	 *
	 * Uncomment TCL_DD_SHORTEN_FLAG in the next call to prefer the
	 * method that allows floating point values to be shortened if
	 * it can be done without loss of precision.
	 */

	digits = TclDoubleDigits(value, *precisionPtr,
				 TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
				 &exponent, &signum, &end);
    }
	if (signum) {
	    *dst++ = '-';
	}
    p = digits;
    if (exponent < -4 || exponent > 16) {
	/*
	 * E format for numbers < 1e-3 or >= 1e17.
	 */

	*dst++ = *p++;
	c = *p;
	if (c != '\0') {
	    *dst++ = '.';
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}

	sprintf(dst, "e%+d", exponent);
	/*
	 * Tcl 8.4 appears to format with at least a two-digit exponent; \
	 * preserve that behaviour when tcl_precision != 0
	 */
	if (*precisionPtr == 0) {
	    sprintf(dst, "e%+d", exponent);
	} else {
	    sprintf(dst, "e%+03d", exponent);
	}
    } else {
	/*
	 * F format for others.
	 */

	if (exponent < 0) {
	    *dst++ = '0';
3126
3127
3128
3129
3130
3131
3132
3133















































































3134
3135
3136
3137
3138
3139
3140
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







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}
	*dst++ = '\0';
    }
    Tcl_Free(digits);
    ckfree(digits);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPrecTraceProc --
 *
 *	This function is invoked whenever the variable "tcl_precision" is
 *	written.
 *
 * Results:
 *	Returns NULL if all went well, or an error message if the new value
 *	for the variable doesn't make sense.
 *
 * Side effects:
 *	If the new value doesn't make sense then this function undoes the
 *	effect of the variable modification. Otherwise it modifies the format
 *	string that's used by Tcl_PrintDouble.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
char *
TclPrecTraceProc(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    CONST char *name1,		/* Name of variable. */
    CONST char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    Tcl_Obj* value;
    int prec;
    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));

    /*
     * If the variable is unset, then recreate the trace.
     */

    if (flags & TCL_TRACE_UNSETS) {
	if ((flags & TCL_TRACE_DESTROYED) && !Tcl_InterpDeleted(interp)) {
	    Tcl_TraceVar2(interp, name1, name2,
		    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES
		    |TCL_TRACE_UNSETS, TclPrecTraceProc, clientData);
	}
	return NULL;
    }

    /*
     * When the variable is read, reset its value from our shared value. This
     * is needed in case the variable was modified in some other interpreter
     * so that this interpreter's value is out of date.
     */


    if (flags & TCL_TRACE_READS) {
	Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr),
		flags & TCL_GLOBAL_ONLY);
	return NULL;
    }

    /*
     * The variable is being written. Check the new value and disallow it if
     * it isn't reasonable or if this is a safe interpreter (we don't want
     * safe interpreters messing up the precision of other interpreters).
     */

    if (Tcl_IsSafe(interp)) {
	return "can't modify precision from a safe interpreter";
    }
    value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
    if (value == NULL
	    || Tcl_GetIntFromObj((Tcl_Interp*) NULL, value, &prec) != TCL_OK
	    || prec < 0 || prec > TCL_MAX_PREC) {
	return "improper value for precision";
    }
    *precisionPtr = prec;
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNeedSpace --
 *
3148
3149
3150
3151
3152
3153
3154
3155
3156


3157
3158
3159
3160
3161
3162
3163
3157
3158
3159
3160
3161
3162
3163


3164
3165
3166
3167
3168
3169
3170
3171
3172







-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclNeedSpace(
    const char *start,		/* First character in string. */
    const char *end)		/* End of string (place where space will be
    CONST char *start,		/* First character in string. */
    CONST char *end)		/* End of string (place where space will be
				 * added, if appropriate). */
{
    /*
     * A space is needed unless either:
     * (a) we're at the start of the string, or
     *
     * (NOTE: This check is now absorbed into the loop below.)
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

3775
3776

3777
3778

3779
3780



3781

3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793














































3794
3795
3796
3797

3798
3799
3800
3801
3802
3803
3804
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







-
-
-
-
-
+
+
+
+
+






-
-
+
+




-
-
-
+
+
+

-
+

+
-
-
+
+

+
+
+
+
+
+
+
+
+
+





-
+
+
+

+
-
+



+
-
+

-
-
+







-









-
+

-
-
+
+
-
-
-
-
+
-


+
-
+
-
-
-
+
+
+
-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+





-
+





-
+

-
+


-
-
+
+
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+

-
+
+
+
-
-
-

-
-
+
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
+
-
-
+
-
-
+
-
-

-
-
-
+
-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
+
+
-
-
+
-
-
-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
+
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
+
+








-
+

-
+
-
-
-
-
+
-
-
-
+
+
+
-
-
-
+
+
+
+
+
+
-

+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
+
+
-
-
-
-
-

-
+
-
-
+

-
-
+
+


-
-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+

-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
-






-
+

-
+
-
-
+


+
+
+
-
+




-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-

-
+







 *----------------------------------------------------------------------
 *
 * TclFormatInt --
 *
 *	This procedure formats an integer into a sequence of decimal digit
 *	characters in a buffer. If the integer is negative, a minus sign is
 *	inserted at the start of the buffer. A null character is inserted at
 *	the end of the formatted characters. It is the caller's responsibility
 *	to ensure that enough storage is available. This procedure has the
 *	effect of sprintf(buffer, "%ld", n) but is faster as proven in
 *	benchmarks.  This is key to UpdateStringOfInt, which is a common path
 *	for a lot of code (e.g. int-indexed arrays).
 *	the end of the formatted characters. It is the caller's
 *	responsibility to ensure that enough storage is available. This
 *	procedure has the effect of sprintf(buffer, "%ld", n) but is faster
 *	as proven in benchmarks.  This is key to UpdateStringOfInt, which
 *	is a common path for a lot of code (e.g. int-indexed arrays).
 *
 * Results:
 *	An integer representing the number of characters formatted, not
 *	including the terminating \0.
 *
 * Side effects:
 *	The formatted characters are written into the storage pointer to by
 *	the "buffer" argument.
 *	The formatted characters are written into the storage pointer to
 *	by the "buffer" argument.
 *
 *----------------------------------------------------------------------
 */

size_t
TclFormatInt(
    char *buffer,		/* Points to the storage into which the
int
TclFormatInt(buffer, n)
    char *buffer;		/* Points to the storage into which the
				 * formatted characters are written. */
    Tcl_WideInt n)			/* The integer to format. */
    long n;			/* The integer to format. */
{
    unsigned long intVal;
    Tcl_WideUInt intVal;
    size_t i = 0, numFormatted, j;
    int i;
    int numFormatted, j;
    static const char digits[] = "0123456789";

    /*
     * Check first whether "n" is zero.
     */

    if (n == 0) {
	buffer[0] = '0';
	buffer[1] = 0;
	return 1;
    }

    /*
     * Generate the characters of the result backwards in the buffer.
     */

    intVal = (n < 0 ? -(Tcl_WideUInt)n : (Tcl_WideUInt)n);
    intVal = (n < 0 ? -(unsigned long)n : (unsigned long)n);
    i = 0;
    buffer[0] = '\0';
    do {
	i++;
	buffer[i++] = digits[intVal % 10];
	buffer[i] = digits[intVal % 10];
	intVal = intVal / 10;
    } while (intVal > 0);
    if (n < 0) {
	i++;
	buffer[i++] = '-';
	buffer[i] = '-';
    }
    buffer[i] = '\0';
    numFormatted = i--;
    numFormatted = i;

    /*
     * Now reverse the characters.
     */

    for (j = 0;  j < i;  j++, i--) {
	char tmp = buffer[i];

	buffer[i] = buffer[j];
	buffer[j] = tmp;
    }
    return numFormatted;
}

/*
 *----------------------------------------------------------------------
 *
 * GetWideForIndex --
 * TclGetIntForIndex --
 *
 *	This function produces a wide integer value corresponding to the
 *	index value held in *objPtr. The parsing supports all values
 *	This function returns an integer corresponding to the list index held
 *	in a Tcl object. The Tcl object's value is expected to be in the
 *	recognized as any size of integer, and the syntaxes end[-+]$integer
 *	and $integer[-+]$integer. The argument endValue is used to give
 *	the meaning of the literal index value "end". Index arithmetic
 *	on arguments outside the wide integer range are only accepted
 *	format integer([+-]integer)? or the format end([+-]integer)?.
 *	when interp is a working interpreter, not NULL.
 *
 * Results:
 *	The return value is normally TCL_OK, which means that the index was
 *	When parsing of *objPtr successfully recognizes an index value,
 *	successfully stored into the location referenced by "indexPtr". If the
 *	TCL_OK is returned, and the wide integer value corresponding to
 *	the recognized index value is written to *widePtr. When parsing
 *	fails, TCL_ERROR is returned and error information is written to
 *	Tcl object referenced by "objPtr" has the value "end", the value
 *	stored is "endValue". If "objPtr"s values is not of one of the
 *	expected formats, TCL_ERROR is returned and, if "interp" is non-NULL,
 *	interp, if non-NULL.
 *	an error message is left in the interpreter's result object.
 *
 * Side effects:
 *	The type of *objPtr may change.
 *
 *----------------------------------------------------------------------
 */

static int
GetWideForIndex(
    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
    size_t endValue,            /* The value to be stored at *widePtr if
				 * objPtr holds "end".
                                 * NOTE: this value may be TCL_INDEX_NONE. */
    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
                                 * representing an index. */
{
    int numType;
    ClientData cd;
    int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);

    if (code == TCL_OK) {
	if (numType == TCL_NUMBER_INT) {
	    /* objPtr holds an integer in the signed wide range */
	    *widePtr = *(Tcl_WideInt *)cd;
	    return TCL_OK;
	}
	if (numType == TCL_NUMBER_BIG) {
	    /* objPtr holds an integer outside the signed wide range */
	    /* Truncate to the signed wide range. */
	    *widePtr = ((mp_isneg((mp_int *)cd)) ? WIDE_MIN : WIDE_MAX);
	    return TCL_OK;
	}
    }

    /* objPtr does not hold a number, check the end+/- format... */
    return GetEndOffsetFromObj(interp, objPtr, endValue, widePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetIntForIndex --
 *
 *	Provides an integer corresponding to the list index held in a Tcl
 *	object. The string value 'objPtr' is expected have the format
 *	integer([+-]integer)? or end([+-]integer)?.
 *
 * Value
 * 	TCL_OK
 *
 * 	    The index is stored at the address given by by 'indexPtr'. If
 * 	    'objPtr' has the value "end", the value stored is 'endValue'.
 *
 * 	TCL_ERROR
 *
 * 	    The value of 'objPtr' does not have one of the expected formats. If
 * 	    'interp' is non-NULL, an error message is left in the interpreter's
 * 	    result object.
 *
 * Effect
 *
 * 	The object referenced by 'objPtr' is converted, as needed, to an
 * 	integer, wide integer, or end-based-index object.
 *	The object referenced by "objPtr" might be converted to an integer,
 *	wide integer, or end-based-index object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetIntForIndex(
TclGetIntForIndex(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
				 * or an integer. */
    size_t endValue,		/* The value to be stored at "indexPtr" if
    int endValue,		/* The value to be stored at "indexPtr" if
				 * "objPtr" holds "end". */
    size_t *indexPtr)		/* Location filled in with an integer
    int *indexPtr)		/* Location filled in with an integer
				 * representing an index. */
{
    Tcl_WideInt wide;

    int length;
    char *opPtr, *bytes;
    /* Use platform-related size_t to wide-int to consider negative value
     * TCL_INDEX_NONE if wide-int and size_t have different dimensions. */
    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
	return TCL_ERROR;
    }

    if (indexPtr != NULL) {
	if ((wide < 0) && (endValue != TCL_INDEX_END)) {
	    *indexPtr = TCL_INDEX_NONE;
    if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
	} else if ((Tcl_WideUInt)wide > TCL_INDEX_END) {
	    *indexPtr = TCL_INDEX_END;
	} else {
	    *indexPtr = (size_t) wide;
	}
    }
    return TCL_OK;
}
	return TCL_OK;
    }
/*
 *----------------------------------------------------------------------
 *
 * GetEndOffsetFromObj --
 *
 *	Look for a string of the form "end[+-]offset" or "offset[+-]offset" and
 *	convert it to an internal representation.
 *
 *	The internal representation (wideValue) uses the following encoding:
 *
 *	WIDE_MIN:   Index value TCL_INDEX_NONE (or -1)
 *	WIDE_MIN+1: Index value n, for any n < -1  (usually same effect as -1)
 *	-$n:        Index "end-[expr {$n-1}]"
 *	-2:         Index "end-1"
 *	-1:         Index "end"
 *	0:          Index "0"
 *	WIDE_MAX-1: Index "end+n", for any n > 1
 *	WIDE_MAX:   Index "end+1"
 *

 * Results:
 *	Tcl return code.
 *
    if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
	/*
	 * If the object is already an offset from the end of the list, or can
	 * be converted to one, use it.
	 */
 * Side effects:
 *	May store a Tcl_ObjType.
 *

 *----------------------------------------------------------------------
 */

	*indexPtr = endValue + objPtr->internalRep.longValue;
	return TCL_OK;
    }
static int
GetEndOffsetFromObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr,            /* Pointer to the object to parse */
    size_t endValue,            /* The value to be stored at "indexPtr" if
                                 * "objPtr" holds "end". */
    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                 * representing an index. */
{

    Tcl_ObjIntRep *irPtr;
    Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
    ClientData cd;

    while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) {
	Tcl_ObjIntRep ir;
	size_t length;
	const char *bytes = TclGetStringFromObj(objPtr, &length);
    bytes = TclGetStringFromObj(objPtr, &length);

	if (*bytes != 'e') {
    /*
     * Leading whitespace is acceptable in an index.
     */
	    int numType;
	    const char *opPtr;
	    int len, t1 = 0, t2 = 0;

	    /* Value doesn't start with "e" */

    while (length && TclIsSpaceProcM(*bytes)) {
	    /* If we reach here, the string rep of objPtr exists. */

	bytes++;
	    /*
	     * The valid index syntax does not include any value that is
	     * a list of more than one element. This is necessary so that
	     * lists of index values can be reliably distinguished from any
	     * single index value.
	     */

	length--;
	    /*
	     * Quick scan to see if multi-value list is even possible.
	     * This relies on TclGetString() returning a NUL-terminated string.
	     */
	    if ((TclMaxListLength(bytes, -1, NULL) > 1)

    }
		    /* If it's possible, do the full list parse. */
	            && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &len))
	            && (len > 1)) {
	        goto parseError;
	    }


    if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
	    /* Passed the list screen, so parse for index arithmetic expression */
	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
	            TCL_PARSE_INTEGER_ONLY)) {
	    TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
		Tcl_WideInt w1=0, w2=0;

	int code, first, second;
		/* value starts with valid integer... */

	char savedOp = *opPtr;
		if ((*opPtr == '-') || (*opPtr == '+')) {
		    /* ... value continues with [-+] ... */

		    /* Save first integer as wide if possible */
		    TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
		    if (t1 == TCL_NUMBER_INT) {
	if ((savedOp != '+') && (savedOp != '-')) {
			w1 = (*(Tcl_WideInt *)cd);
		    }

	    goto parseError;
	}
	if (TclIsSpaceProcM(opPtr[1])) {
		    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
			    -1, NULL, TCL_PARSE_INTEGER_ONLY)) {
			/* ... value concludes with second valid integer */

	    goto parseError;
			/* Save second integer as wide if possible */
			TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
			if (t2 == TCL_NUMBER_INT) {
			    w2 = (*(Tcl_WideInt *)cd);
			}
	}
		    }
		}
		/* Clear invalid intreps left by TclParseNumber */
		TclFreeIntRep(objPtr);

	*opPtr = '\0';
	code = Tcl_GetInt(interp, bytes, &first);
		if (t1 && t2) {
		    /* We have both integer values */
		    if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
			/* Both are wide, do wide-integer math */
			if (*opPtr == '-') {
			    if (w2 == WIDE_MIN) {
				goto extreme;
			    }
	*opPtr = savedOp;
	if (code == TCL_ERROR) {
	    goto parseError;
	}
			    w2 = -w2;
			}

	if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
	    goto parseError;
	}
	if (savedOp == '+') {
			if ((w1 ^ w2) < 0) {
			    /* Different signs, sum cannot overflow */
			    offset = w1 + w2;
	    *indexPtr = first + second;
			} else if (w1 >= 0) {
			    if (w1 < WIDE_MAX - w2) {
				offset = w1 + w2;
			    } else {
				offset = WIDE_MAX;
			    }
	} else {
	    *indexPtr = first - second;
	}
			} else {
			    if (w1 > WIDE_MIN - w2) {
				offset = w1 + w2;
	return TCL_OK;
			    } else {
				offset = WIDE_MIN;
			    }
			}
    }

		    } else {
			/*
    /*
			 * At least one is big, do bignum math. Little reason to
			 * value performance here. Re-use code.  Parse has verified
			 * objPtr is an expression. Compute it.
			 */
     * Report a parse error.
     */

			Tcl_Obj *sum;

		    extreme:
			if (interp) {
			    Tcl_ExprObj(interp, objPtr, &sum);
			} else {
			    Tcl_Interp *compute = Tcl_CreateInterp();
			    Tcl_ExprObj(compute, objPtr, &sum);
			    Tcl_DeleteInterp(compute);
			}
			TclGetNumberFromObj(NULL, sum, &cd, &numType);

			if (numType == TCL_NUMBER_INT) {
			    /* sum holds an integer in the signed wide range */
			    offset = *(Tcl_WideInt *)cd;
			} else {
			    /* sum holds an integer outside the signed wide range */
			    /* Truncate to the signed wide range. */
			    if (mp_isneg((mp_int *)cd)) {
				offset = WIDE_MIN;
			    } else {
				offset = WIDE_MAX;
			    }
			}
			Tcl_DecrRefCount(sum);
		    }
		    if (offset < 0) {
			offset = (offset == -1) ? WIDE_MIN : WIDE_MIN+1;
		    }
		    goto parseOK;
		}
	    }
	    goto parseError;
	}

	if ((length < 3) || (length == 4) || (strncmp(bytes, "end", 3) != 0)) {
	    /* Doesn't start with "end" */
	    goto parseError;
	}
	if (length > 4) {
	    int t;

	    /* Parse for the "end-..." or "end+..." formats */

	    if ((bytes[3] != '-') && (bytes[3] != '+')) {
		/* No operator where we need one */
		goto parseError;
	    }
	    if (TclIsSpaceProc(bytes[4])) {
		/* Space after + or - not permitted. */
		goto parseError;
  parseError:
	    }

    if (interp != NULL) {
	    /* Parse the integer offset */
	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL,
	char *bytes = Tcl_GetString(objPtr);
			bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) {
		/* Not a recognized integer format */
		goto parseError;
	    }


	/*
	    /* Got an integer offset; pull it from where parser left it. */
	    TclGetNumberFromObj(NULL, objPtr, &cd, &t);

	 * The result might not be empty; this resets it which should be both
	    if (t == TCL_NUMBER_BIG) {
		/* Truncate to the signed wide range. */
		if (mp_isneg((mp_int *)cd)) {
		    offset = (bytes[3] == '-') ? WIDE_MAX : WIDE_MIN;
		} else {
		    offset = (bytes[3] == '-') ? WIDE_MIN : WIDE_MAX;
		}
	    } else {
		/* assert (t == TCL_NUMBER_INT); */
		offset = (*(Tcl_WideInt *)cd);
		if (bytes[3] == '-') {
		    offset = (offset == WIDE_MIN) ? WIDE_MAX : -offset;
		}
		if (offset == 1) {
		    offset = WIDE_MAX; /* "end+1" */
		} else if (offset > 1) {
		    offset = WIDE_MAX - 1; /* "end+n", out of range */
		} else if (offset != WIDE_MIN) {
		    offset--;
		}
	    }
	}

	 * a cheap operation, and of little problem because this is an
    parseOK:
	/* Success. Store the new internal rep. */
	ir.wideValue = offset;
	Tcl_StoreIntRep(objPtr, &endOffsetType, &ir);
    }

	 * error-generation path anyway.
    offset = irPtr->wideValue;

	 */
    if (offset == WIDE_MAX) {
	*widePtr = endValue + 1;
    } else if (offset == WIDE_MIN) {
	*widePtr = -1;
    } else if (endValue == (size_t)-1) {
	*widePtr = offset;
    } else if (offset < 0) {
	/* Different signs, sum cannot overflow */
	*widePtr = endValue + offset + 1;
    } else if (offset < WIDE_MAX) {
	*widePtr = offset;
    } else {
	*widePtr = WIDE_MAX;
    }

    return TCL_OK;

	Tcl_ResetResult(interp);
    /* Report a parse error. */
  parseError:
    if (interp != NULL) {
        char * bytes = TclGetString(objPtr);
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                "bad index \"%s\": must be integer?[+-]integer? or"
	Tcl_AppendResult(interp, "bad index \"", bytes,
		"\": must be integer?[+-]integer? or end?[+-]integer?", NULL);
                " end?[+-]integer?", bytes));
        if (!strncmp(bytes, "end-", 4)) {
            bytes += 4;
        }
        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	if (!strncmp(bytes, "end-", 4)) {
	    bytes += 4;
	}
	TclCheckBadOctal(interp, bytes);
    }

    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexEncode --
 * UpdateStringOfEndOffset --
 *
 *      Parse objPtr to determine if it is an index value. Two cases
 *	Update the string rep of a Tcl object holding an "end-offset"
 *	are possible.  The value objPtr might be parsed as an absolute
 *	index value in the C signed int range.  Note that this includes
 *	index values that are integers as presented and it includes index
 *      arithmetic expressions. The absolute index values that can be
 *	expression.
 *	directly meaningful as an index into either a list or a string are
 *	those integer values >= TCL_INDEX_START (0)
 *	and < INT_MAX.
 *
 * Results:
 *	None.
 *      The largest string supported in Tcl 8 has bytelength INT_MAX.
 *      This means the largest supported character length is also INT_MAX,
 *      and the index of the last character in a string of length INT_MAX
 *
 * Side effects:
 *	Stores a valid string in the object's string rep.
 *
 * This function does NOT free any earlier string rep. If it is called on an
 * object that already has a valid string rep, it will leak memory.
 *      is INT_MAX-1.
 *
 *----------------------------------------------------------------------
 *      Any absolute index value parsed outside that range is encoded
 *      using the before and after values passed in by the
 *      caller as the encoding to use for indices that are either
 *      less than or greater than the usable index range. TCL_INDEX_NONE
 *      is available as a good choice for most callers to use for
 *      after. Likewise, the value TCL_INDEX_NONE is good for
 */

static void
UpdateStringOfEndOffset(
    register Tcl_Obj* objPtr)
{
    char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
 *      most callers to use for before.  Other values are possible
 *      when the caller knows it is helpful in producing its own behavior
 *      for indices before and after the indexed item.
 *
 *      A token can also be parsed as an end-relative index expression.
 *      All end-relative expressions that indicate an index larger
    register int len;

    strcpy(buffer, "end");
    len = sizeof("end") - 1;
    if (objPtr->internalRep.longValue != 0) {
	buffer[len++] = '-';
	len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
    }
    objPtr->bytes = ckalloc((unsigned) len+1);
    memcpy(objPtr->bytes, buffer, (unsigned) len+1);
    objPtr->length = len;
}

 *      than end (end+2, end--5) point beyond the end of the indexed
 *      collection, and can be encoded as after.  The end-relative
 *      expressions that indicate an index less than or equal to end
/*
 *----------------------------------------------------------------------
 *      are encoded relative to the value TCL_INDEX_END (-2).  The
 *      index "end" is encoded as -2, down to the index "end-0x7FFFFFFE"
 *
 * SetEndOffsetFromAny --
 *      which is encoded as INT_MIN. Since the largest index into a
 *      string possible in Tcl 8 is 0x7FFFFFFE, the interpretation of
 *      "end-0x7FFFFFFE" for that largest string would be 0.  Thus,
 *      if the tokens "end-0x7FFFFFFF" or "end+-0x80000000" are parsed,
 *      they can be encoded with the before value.
 *
 *      These details will require re-examination whenever string and
 *	Look for a string of the form "end[+-]offset" and convert it to an
 *      list length limits are increased, but that will likely also
 *      mean a revised routine capable of returning Tcl_WideInt values.
 *	internal representation holding the offset.
 *
 * Returns:
 *      TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
 * Results:
 *	Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
 *
 * Side effects:
 *      When TCL_OK is returned, the encoded index value is written
 *      to *indexPtr.
 *	If interp is not NULL, stores an error message in the interpreter
 *	result.
 *
 *----------------------------------------------------------------------
 */

static int
SetEndOffsetFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
{
    int offset;			/* Offset in the "end-offset" expression */
    register char* bytes;	/* String rep of the object */
    int length;			/* Length of the object's string rep */

    /*
     * If it's already the right type, we're fine.
 */
     */

int
TclIndexEncode(
    Tcl_Interp *interp,	/* For error reporting, may be NULL */
    Tcl_Obj *objPtr,	/* Index value to parse */
    size_t before,		/* Value to return for index before beginning */
    size_t after,		/* Value to return for index after end */
    int *indexPtr)	/* Where to write the encoded answer, not NULL */
{
    Tcl_WideInt wide;
    int idx;

    if (TCL_OK == GetWideForIndex(interp, objPtr, (unsigned)TCL_INDEX_END , &wide)) {
	const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &endOffsetType);
	if (irPtr && irPtr->wideValue >= 0) {
    if (objPtr->typePtr == &tclEndOffsetType) {
	return TCL_OK;
    }

    /*
     * Check for a string rep of the right form.
     */

    bytes = TclGetStringFromObj(objPtr, &length);
    if ((*bytes != 'e') || (strncmp(bytes, "end",
	    (size_t)((length > 3) ? 3 : length)) != 0)) {
	if (interp != NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "bad index \"", bytes,
		    "\": must be end?[+-]integer?", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Convert the string rep.
     */

    if (length <= 3) {
	    /* "int[+-]int" syntax, works the same here as "int" */
	    irPtr = NULL;
	}
	offset = 0;
    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
	/*
	 * This is our limited string expression evaluator. Pass everything
	 * after "end-" to Tcl_GetInt, then reverse for offset.
	 */

	if (TclIsSpaceProcM(bytes[4])) {
	    return TCL_ERROR;
	}
	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (bytes[3] == '-') {
	    offset = -offset;
	}
    } else {
	/*
	 * We parsed an end+offset index value.
	 * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
	 * Conversion failed. Report the error.
	 */
	if (wide > (unsigned)(irPtr ? TCL_INDEX_END : INT_MAX)) {
	    /*

	if (interp != NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "bad index \"", bytes,
		    "\": must be end?[+-]integer?", NULL);
	}
	return TCL_ERROR;
    }

    /*
	     * All end+postive or end-negative expressions
	     * always indicate "after the end".
	     */
     * The conversion succeeded. Free the old internal rep and set the new
     * one.
     */
	    idx = after;
	} else if (wide <= (irPtr ? INT_MAX : -1)) {
	    /* These indices always indicate "before the beginning */
	    idx = before;
	} else {
	    /* Encoded end-positive (or end+negative) are offset */
	    idx = (int)wide;
	}

    } else {
	return TCL_ERROR;
    }
    TclFreeIntRep(objPtr);
    objPtr->internalRep.longValue = offset;
    objPtr->typePtr = &tclEndOffsetType;

    *indexPtr = idx;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclIndexDecode --
 * TclCheckBadOctal --
 *
 *	Decodes a value previously encoded by TclIndexEncode.  The argument
 *	This function checks for a bad octal value and appends a meaningful
 *	endValue indicates what value of "end" should be used in the
 *	decoding.
 *	error to the interp's result.
 *
 * Results:
 *	1 if the argument was a bad octal, else 0.
 *
 * Side effects:
 *	The decoded index value.
 *	The interpreter's result is modified.
 *
 *----------------------------------------------------------------------
 */

size_t
TclIndexDecode(
    int encoded,	/* Value to decode */
    size_t endValue)	/* Meaning of "end" to use, > TCL_INDEX_END */
{
    if (encoded > (int)TCL_INDEX_END) {
	return encoded;
    }
int
TclCheckBadOctal(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
				 * NULL, then no error message is left after
				 * errors. */
    CONST char *value)		/* String to check. */
{
    register CONST char *p = value;

    /*
     * A frequent mistake is invalid octal values due to an unwanted leading
     * zero. Try to generate a meaningful error message.
     */

    while (TclIsSpaceProcM(*p)) {
	p++;
    }
    if (*p == '+' || *p == '-') {
	p++;
    }
    if (*p == '0') {
	if ((p[1] == 'o') || p[1] == 'O') {
	    p+=2;
	}
	while (isdigit(UCHAR(*p))) {	/* INTL: digit. */
	    p++;
	}
	while (TclIsSpaceProcM(*p)) {
	    p++;
	}
	if (*p == '\0') {
	    /*
	     * Reached end of string.
	     */

	    if (interp != NULL) {
		/*
		 * Don't reset the result here because we want this result to
		 * be added to an existing error message as extra info.
		 */

		Tcl_AppendResult(interp, " (looks like invalid octal number)",
			NULL);
	    }
	    return 1;
	}
    if (endValue >= TCL_INDEX_END - encoded) {
	return endValue + encoded - TCL_INDEX_END;
    }
    return TCL_INDEX_NONE;
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ClearHash --
 *
3812
3813
3814
3815
3816
3817
3818
3819

3820
3821
3822
3823
3824
3825
3826
3827
3645
3646
3647
3648
3649
3650
3651

3652

3653
3654
3655
3656
3657
3658
3659







-
+
-







    Tcl_HashTable *tablePtr)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;

    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_Obj *objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
	Tcl_Obj *objPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);

	Tcl_DecrRefCount(objPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

/*
 *----------------------------------------------------------------------
3841
3842
3843
3844
3845
3846
3847
3848
3849


3850
3851
3852
3853


3854
3855
3856
3857
3858
3859
3860
3673
3674
3675
3676
3677
3678
3679


3680
3681
3682
3683


3684
3685
3686
3687
3688
3689
3690
3691
3692







-
-
+
+


-
-
+
+







 *----------------------------------------------------------------------
 */

static Tcl_HashTable *
GetThreadHash(
    Tcl_ThreadDataKey *keyPtr)
{
    Tcl_HashTable **tablePtrPtr =
	    (Tcl_HashTable **)Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));
    Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **)
	    Tcl_GetThreadData(keyPtr, (int) sizeof(Tcl_HashTable *));

    if (NULL == *tablePtrPtr) {
	*tablePtrPtr = (Tcl_HashTable *)Tcl_Alloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
	*tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	Tcl_CreateThreadExitHandler(FreeThreadHash, (ClientData)*tablePtrPtr);
	Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
    }
    return *tablePtrPtr;
}

/*
 *----------------------------------------------------------------------
3870
3871
3872
3873
3874
3875
3876
3877

3878
3879
3880
3881

3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899

3900
3901
3902
3903

3904
3905
3906
3907
3908
3909
3910
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







-
+



-
+

















-
+



-
+







 *----------------------------------------------------------------------
 */

static void
FreeThreadHash(
    ClientData clientData)
{
    Tcl_HashTable *tablePtr = (Tcl_HashTable *)clientData;
    Tcl_HashTable *tablePtr = (Tcl_HashTable *) clientData;

    ClearHash(tablePtr);
    Tcl_DeleteHashTable(tablePtr);
    Tcl_Free(tablePtr);
    ckfree((char *) tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FreeProcessGlobalValue --
 *
 *	Exit handler used by Tcl(Set|Get)ProcessGlobalValue to cleanup a
 *	ProcessGlobalValue at exit.
 *
 *----------------------------------------------------------------------
 */

static void
FreeProcessGlobalValue(
    ClientData clientData)
{
    ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *)clientData;
    ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *) clientData;

    pgvPtr->epoch++;
    pgvPtr->numBytes = 0;
    Tcl_Free(pgvPtr->value);
    ckfree(pgvPtr->value);
    pgvPtr->value = NULL;
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
	pgvPtr->encoding = NULL;
    }
    Tcl_MutexFinalize(&pgvPtr->mutex);
}
3922
3923
3924
3925
3926
3927
3928
3929

3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942

3943
3944

3945
3946
3947
3948
3949



3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965



3966
3967
3968
3969
3970
3971
3972
3754
3755
3756
3757
3758
3759
3760

3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773

3774
3775

3776
3777




3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794


3795
3796
3797
3798
3799
3800
3801
3802
3803
3804







-
+












-
+

-
+

-
-
-
-
+
+
+














-
-
+
+
+








void
TclSetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr,
    Tcl_Obj *newValue,
    Tcl_Encoding encoding)
{
    const char *bytes;
    CONST char *bytes;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    int dummy;

    Tcl_MutexLock(&pgvPtr->mutex);

    /*
     * Fill the global string value.
     */

    pgvPtr->epoch++;
    if (NULL != pgvPtr->value) {
	Tcl_Free(pgvPtr->value);
	ckfree(pgvPtr->value);
    } else {
	Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
	Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
    }
    bytes = TclGetString(newValue);
    pgvPtr->numBytes = newValue->length;
    pgvPtr->value = (char *)Tcl_Alloc(pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
    bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes);
    pgvPtr->value = ckalloc((unsigned) pgvPtr->numBytes + 1);
    memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
    if (pgvPtr->encoding) {
	Tcl_FreeEncoding(pgvPtr->encoding);
    }
    pgvPtr->encoding = encoding;

    /*
     * Fill the local thread copy directly with the Tcl_Obj value to avoid
     * loss of the intrep. Increment newValue refCount early to handle case
     * where we set a PGV to itself.
     */

    Tcl_IncrRefCount(newValue);
    cacheMap = GetThreadHash(&pgvPtr->key);
    ClearHash(cacheMap);
    hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
    Tcl_SetHashValue(hPtr, newValue);
    hPtr = Tcl_CreateHashEntry(cacheMap,
	    (char *) INT2PTR(pgvPtr->epoch), &dummy);
    Tcl_SetHashValue(hPtr, (ClientData) newValue);
    Tcl_MutexUnlock(&pgvPtr->mutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetProcessGlobalValue --
3983
3984
3985
3986
3987
3988
3989
3990

3991
3992
3993
3994
3995
3996
3997
3998


3999
4000
4001
4002
4003
4004
4005


4006
4007
4008
4009
4010
4011
4012



4013
4014

4015
4016
4017
4018
4019
4020
4021
4022
4023
4024

4025
4026
4027
4028
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
3815
3816
3817
3818
3819
3820
3821

3822
3823
3824
3825
3826
3827
3828


3829
3830
3831
3832
3833
3834
3835
3836

3837
3838
3839
3840
3841
3842
3843


3844
3845
3846
3847

3848
3849
3850
3851
3852
3853
3854
3855
3856
3857

3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878

3879
3880
3881
3882

3883
3884
3885
3886
3887
3888
3889
3890
3891

3892
3893

3894
3895
3896

3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908

3909
3910
3911
3912
3913
3914
3915
3916







-
+






-
-
+
+






-
+
+





-
-
+
+
+

-
+









-
+



















+
-
+



-
+








-
+

-
+


-
+











-
+







Tcl_Obj *
TclGetProcessGlobalValue(
    ProcessGlobalValue *pgvPtr)
{
    Tcl_Obj *value = NULL;
    Tcl_HashTable *cacheMap;
    Tcl_HashEntry *hPtr;
    size_t epoch = pgvPtr->epoch;
    int epoch = pgvPtr->epoch;

    if (pgvPtr->encoding) {
	Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);

	if (pgvPtr->encoding != current) {
	    /*
	     * The system encoding has changed since the global string value
	     * was saved. Convert the global value to be based on the new
	     * The system encoding has changed since the master string value
	     * was saved. Convert the master value to be based on the new
	     * system encoding.
	     */

	    Tcl_DString native, newValue;

	    Tcl_MutexLock(&pgvPtr->mutex);
	    epoch = ++pgvPtr->epoch;
	    pgvPtr->epoch++;
	    epoch = pgvPtr->epoch;
	    Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
		    pgvPtr->numBytes, &native);
	    Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
	    Tcl_DStringLength(&native), &newValue);
	    Tcl_DStringFree(&native);
	    Tcl_Free(pgvPtr->value);
	    pgvPtr->value = (char *)Tcl_Alloc(Tcl_DStringLength(&newValue) + 1);
	    ckfree(pgvPtr->value);
	    pgvPtr->value = ckalloc((unsigned int)
		    Tcl_DStringLength(&newValue) + 1);
	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
		    Tcl_DStringLength(&newValue) + 1);
		    (size_t) Tcl_DStringLength(&newValue) + 1);
	    Tcl_DStringFree(&newValue);
	    Tcl_FreeEncoding(pgvPtr->encoding);
	    pgvPtr->encoding = current;
	    Tcl_MutexUnlock(&pgvPtr->mutex);
	} else {
	    Tcl_FreeEncoding(current);
	}
    }
    cacheMap = GetThreadHash(&pgvPtr->key);
    hPtr = Tcl_FindHashEntry(cacheMap, INT2PTR(epoch));
    hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch));
    if (NULL == hPtr) {
	int dummy;

	/*
	 * No cache for the current epoch - must be a new one.
	 *
	 * First, clear the cacheMap, as anything in it must refer to some
	 * expired epoch.
	 */

	ClearHash(cacheMap);

	/*
	 * If no thread has set the shared value, call the initializer.
	 */

	Tcl_MutexLock(&pgvPtr->mutex);
	if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
	    pgvPtr->epoch++;
	    (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
	    pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding);
		    &pgvPtr->encoding);
	    if (pgvPtr->value == NULL) {
		Tcl_Panic("PGV Initializer did not initialize");
	    }
	    Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
	    Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData)pgvPtr);
	}

	/*
	 * Store a copy of the shared value in our epoch-indexed cache.
	 */

	value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
	hPtr = Tcl_CreateHashEntry(cacheMap,
		INT2PTR(pgvPtr->epoch), &dummy);
		(char *) INT2PTR(pgvPtr->epoch), &dummy);
	Tcl_MutexUnlock(&pgvPtr->mutex);
	Tcl_SetHashValue(hPtr, value);
	Tcl_SetHashValue(hPtr, (ClientData) value);
	Tcl_IncrRefCount(value);
    }
    return (Tcl_Obj *)Tcl_GetHashValue(hPtr);
    return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetObjNameOfExecutable --
 *
 *	This function stores the absolute pathname of the executable file
 *	(normally as computed by TclpFindExecutable).
 *
 * Results:
 *	None.
 * 	None.
 *
 * Side effects:
 *	Stores the executable name.
 *
 *----------------------------------------------------------------------
 */

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
3933
3934
3935
3936
3937
3938
3939

3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958


3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002


4003
4004
4005
4006



4007




4008
4009
4010
4011
4012
4013
4014







-
+


















-
-
+
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+



-
-
+
+
+

-
-
-
+
-
-
-
-







 *	the "info nameofexecutable" command.
 *
 * Results:
 *	A pointer to an "fsPath" Tcl_Obj, or to an empty Tcl_Obj if the
 *	pathname of the application is unknown.
 *
 * Side effects:
 *	None.
 * 	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclGetObjNameOfExecutable(void)
{
    return TclGetProcessGlobalValue(&executableName);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetNameOfExecutable --
 *
 *	This function retrieves the absolute pathname of the application in
 *	which the Tcl library is running, and returns it in string form.
 *
 *	The returned string belongs to Tcl and should be copied if the caller
 *	plans to keep it, to guard against it becoming invalid.
 * 	The returned string belongs to Tcl and should be copied if the caller
 * 	plans to keep it, to guard against it becoming invalid.
 *
 * Results:
 *	A pointer to the internal string or NULL if the internal full path
 *	name has not been computed or unknown.
 *
 * Side effects:
 * 	None.
 *
 *----------------------------------------------------------------------
 */

CONST char *
Tcl_GetNameOfExecutable(void)
{
    int numBytes;
    const char *bytes =
	    Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);

    if (numBytes == 0) {
	return NULL;
    }
    return bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTime --
 *
 *	Deprecated synonym for Tcl_GetTime. This function is provided for the
 *	benefit of extensions written before Tcl_GetTime was exported from the
 *	library.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Stores current time in the buffer designated by "timePtr"
 *
 *----------------------------------------------------------------------
 */

const char *
Tcl_GetNameOfExecutable(void)
void
TclpGetTime(
    Tcl_Time *timePtr)
{
    Tcl_Obj *obj = TclGetObjNameOfExecutable();
    const char *bytes = TclGetString(obj);

    Tcl_GetTime(timePtr);
    if (obj->length == 0) {
	return NULL;
    }
    return bytes;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetPlatform --
 *
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
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







-
+

-
+
-


-
-
+
+



-
-
-







-
-
+
+

-
-
+







 *----------------------------------------------------------------------
 */

int
TclReToGlob(
    Tcl_Interp *interp,
    const char *reStr,
    size_t reStrLen,
    int reStrLen,
    Tcl_DString *dsPtr,
    int *exactPtr,
    int *exactPtr)
    int *quantifiersFoundPtr)
{
    int anchorLeft, anchorRight, lastIsStar, numStars;
    char *dsStr, *dsStrStart;
    const char *msg, *p, *strEnd, *code;
    char *dsStr, *dsStrStart, *msg;
    const char *p, *strEnd;

    strEnd = reStr + reStrLen;
    Tcl_DStringInit(dsPtr);
    if (quantifiersFoundPtr != NULL) {
	*quantifiersFoundPtr = 0;
    }

    /*
     * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
     */

    if ((reStrLen >= 4) && (memcmp("***=", reStr, 4) == 0)) {
	/*
	 * At most, the glob pattern has length 2*reStrLen + 2 to backslash
	 * escape every character and have * at each end.
	 * At most, the glob pattern has length 2*reStrLen + 2 to
	 * backslash escape every character and have * at each end.
	 */

	Tcl_DStringSetLength(dsPtr, reStrLen + 2);
	Tcl_DStringSetLength(dsPtr, 2*reStrLen + 2);
	dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
	*dsStr++ = '*';
	for (p = reStr + 4; p < strEnd; p++) {
	    switch (*p) {
	    case '\\': case '*': case '[': case ']': case '?':
		/* Only add \ where necessary for glob */
		*dsStr++ = '\\';
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
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







-
-
+
+









-
-
+
+
+



-







	if (exactPtr) {
	    *exactPtr = 0;
	}
	return TCL_OK;
    }

    /*
     * At most, the glob pattern has length reStrLen + 2 to account for
     * possible * at each end.
     * At most, the glob pattern has length reStrLen + 2 to account
     * for possible * at each end.
     */

    Tcl_DStringSetLength(dsPtr, reStrLen + 2);
    dsStr = dsStrStart = Tcl_DStringValue(dsPtr);

    /*
     * Check for anchored REs (ie ^foo$), so we can use string equal if
     * possible. Do not alter the start of str so we can free it correctly.
     *
     * Keep track of the last char being an unescaped star to prevent multiple
     * instances.  Simpler than checking that the last star may be escaped.
     * Keep track of the last char being an unescaped star to prevent
     * multiple instances.  Simpler than checking that the last star
     * may be escaped.
     */

    msg = NULL;
    code = NULL;
    p = reStr;
    anchorRight = 0;
    lastIsStar = 0;
    numStars = 0;

    if (*p == '^') {
	anchorLeft = 1;
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4166
4167
4168
4169
4170
4171
4172

4173
4174
4175
4176



4177
4178
4179
4180
4181
4182
4183







-




-
-
-







		/* fall through */
	    case '{': case '}': case '(': case ')': case '+':
	    case '.': case '|': case '^': case '$':
		*dsStr++ = *p;
		break;
	    default:
		msg = "invalid escape sequence";
		code = "BADESCAPE";
		goto invalidGlob;
	    }
	    break;
	case '.':
	    if (quantifiersFoundPtr != NULL) {
		*quantifiersFoundPtr = 1;
	    }
	    anchorLeft = 0; /* prevent exact match */
	    if (p+1 < strEnd) {
		if (p[1] == '*') {
		    p++;
		    if (!lastIsStar) {
			*dsStr++ = '*';
			lastIsStar = 1;
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358

4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384






4385
4386
4387





4388
4389

4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
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







-







-

+











-

-












+
+
+
+
+
+



+
+
+
+
+

-
+
-












		}
	    }
	    *dsStr++ = '?';
	    break;
	case '$':
	    if (p+1 != strEnd) {
		msg = "$ not anchor";
		code = "NONANCHOR";
		goto invalidGlob;
	    }
	    anchorRight = 1;
	    break;
	case '*': case '+': case '?': case '|': case '^':
	case '{': case '}': case '(': case ')': case '[': case ']':
	    msg = "unhandled RE special char";
	    code = "UNHANDLED";
	    goto invalidGlob;
	    break;
	default:
	    *dsStr++ = *p;
	    break;
	}
	lastIsStar = 0;
    }
    if (numStars > 1) {
	/*
	 * Heuristic: if >1 non-anchoring *, the risk is large that glob
	 * matching is slower than the RE engine, so report invalid.
	 */

	msg = "excessive recursive glob backtrack potential";
	code = "OVERCOMPLEX";
	goto invalidGlob;
    }

    if (!anchorRight && !lastIsStar) {
	*dsStr++ = '*';
    }
    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_SetObjResult(interp, Tcl_NewStringObj(msg, -1));
	Tcl_AppendResult(interp, msg, NULL);
	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclVar.c.

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
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







-








+

-
+

-
-
+
+













-
+














-
+
+

-
+
+
+


-




-


-




-
+











-
+
+
+


-








-
+
+
+


-






-
+






-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
+
+
+















-


















-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
-
-
-
-


-
+
-
-
-
-
+










-
+
-
-
-
-
-
-
-
-
+
+
-
-












+



+
+
+
+





-
-
-
+
+
+
+
+
+
+








-
+

-
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
+

-
-
-
-
+
+
-
-
-
+
+
+

-
+

-
+


-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
+

















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * 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);
static int		CompareVarKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashVarKey(Tcl_HashTable *tablePtr, void *keyPtr);

static const Tcl_HashKeyType tclVarHashKeyType = {
static Tcl_HashKeyType tclVarHashKeyType = {
    TCL_HASH_KEY_TYPE_VERSION,	/* version */
    0,				/* flags */
    TclHashObjKey,		/* hashKeyProc */
    TCL_HASH_KEY_DIRECT_COMPARE,/* allows compare keys by pointers */
    HashVarKey,			/* hashKeyProc */
    CompareVarKeys,		/* compareKeysProc */
    AllocVarEntry,		/* allocEntryProc */
    FreeVarEntry		/* freeEntryProc */
};

static inline Var *	VarHashCreateVar(TclVarHashTable *tablePtr,
			    Tcl_Obj *key, int *newPtr);
static inline Var *	VarHashFirstVar(TclVarHashTable *tablePtr,
			    Tcl_HashSearch *searchPtr);
static inline Var *	VarHashNextVar(Tcl_HashSearch *searchPtr);
static inline void	CleanupVar(Var *varPtr, Var *arrayPtr);

#define VarHashGetValue(hPtr) \
    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))
    ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry)))

/*
 * NOTE: VarHashCreateVar increments the recount of its key argument.
 * All callers that will call Tcl_DecrRefCount on that argument must
 * call Tcl_IncrRefCount on it before passing it in.  This requirement
 * can bubble up to callers of callers .... etc.
 */

static inline Var *
VarHashCreateVar(
    TclVarHashTable *tablePtr,
    Tcl_Obj *key,
    int *newPtr)
{
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr);
    Tcl_HashEntry *hPtr = Tcl_CreateHashEntry((Tcl_HashTable *) tablePtr,
	    (char *) key, newPtr);

    if (!hPtr) {
    if (hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}

#define VarHashFindVar(tablePtr, key) \
    VarHashCreateVar((tablePtr), (key), NULL)

#define VarHashInvalidateEntry(varPtr) \
    ((varPtr)->flags |= VAR_DEAD_HASH)

#define VarHashDeleteEntry(varPtr) \
    Tcl_DeleteHashEntry(&(((VarInHash *) varPtr)->entry))

#define VarHashFirstEntry(tablePtr, searchPtr) \
    Tcl_FirstHashEntry(&(tablePtr)->table, (searchPtr))
    Tcl_FirstHashEntry((Tcl_HashTable *) (tablePtr), (searchPtr))

#define VarHashNextEntry(searchPtr) \
    Tcl_NextHashEntry((searchPtr))

static inline Var *
VarHashFirstVar(
    TclVarHashTable *tablePtr,
    Tcl_HashSearch *searchPtr)
{
    Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr);

    if (!hPtr) {
    if (hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}

static inline Var *
VarHashNextVar(
    Tcl_HashSearch *searchPtr)
{
    Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr);

    if (!hPtr) {
    if (hPtr) {
	return VarHashGetValue(hPtr);
    } else {
	return NULL;
    }
    return VarHashGetValue(hPtr);
}

#define VarHashGetKey(varPtr) \
    (((VarInHash *)(varPtr))->entry.key.objPtr)

#define VarHashDeleteTable(tablePtr) \
    Tcl_DeleteHashTable(&(tablePtr)->table)
    Tcl_DeleteHashTable((Tcl_HashTable *) (tablePtr))

/*
 * The strings below are used to indicate what went wrong when a variable
 * access is denied.
 */

static const char NOSUCHVAR[] =		"no such variable";
static const char ISARRAY[] =		"variable is array";
static const char NEEDARRAY[] =		"variable isn't array";
static const char NOSUCHELEMENT[] =	"no such element in array";
static const char DANGLINGELEMENT[] =
static const char *noSuchVar =		"no such variable";
static const char *isArray =		"variable is array";
static const char *needArray =		"variable isn't array";
static const char *noSuchElement =	"no such element in array";
static const char *danglingElement =
	"upvar refers to element in deleted array";
static const char DANGLINGVAR[] =
static const char *danglingVar =
	"upvar refers to variable in deleted namespace";
static const char BADNAMESPACE[] =	"parent namespace doesn't exist";
static const char MISSINGNAME[] =	"missing variable name";
static const char ISARRAYELEMENT[] =
static const char *badNamespace =	"parent namespace doesn't exist";
static const char *missingName =	"missing variable name";
static const char *isArrayElement =
	"name refers to an element in an array";

/*
 * A test to see if we are in a call frame that has local variables. This is
 * true if we are inside a procedure body.
 */

#define HasLocalVars(framePtr) ((framePtr)->isProcCallFrame & FRAME_IS_PROC)

/*
 * The following structure describes an enumerative search in progress on an
 * array variable; this are invoked with options to the "array" command.
 */

typedef struct ArraySearch {
    Tcl_Obj *name;		/* Name of this search */
    int id;			/* Integer id used to distinguish among
				 * multiple concurrent searches for the same
				 * array. */
    struct Var *varPtr;		/* Pointer to array variable that's being
				 * searched. */
    Tcl_HashSearch search;	/* Info kept by the hash module about progress
				 * through the array. */
    Tcl_HashEntry *nextEntry;	/* Non-null means this is the next element to
				 * be enumerated (it's leftover from the
				 * Tcl_FirstHashEntry call or from an "array
				 * anymore" command). NULL means must call
				 * Tcl_NextHashEntry to get value to
				 * return. */
    struct ArraySearch *nextPtr;/* Next in list of all active searches for
				 * this variable, or NULL if this is the last
				 * one. */
} ArraySearch;

/*
 * TIP #508: [array default]
 *
 * The following structure extends the regular TclVarHashTable used by array
 * variables to store their optional default value.
 */

typedef struct ArrayVarHashTable {
    TclVarHashTable table;
    Tcl_Obj *defaultObj;
} ArrayVarHashTable;

/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks);
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_NRPostProc   ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, int index);
			    Var *varPtr, int flags);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);
static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,
static Tcl_Var          ObjFindNamespaceVar(Tcl_Interp *interp,
			    Tcl_Obj *namePtr, Tcl_Namespace *contextNsPtr,
			    int flags);
static int		ObjMakeUpvar(Tcl_Interp *interp,
			    CallFrame *framePtr, Tcl_Obj *otherP1Ptr,
			    const char *otherP2, const int otherFlags,
			    Tcl_Obj *myNamePtr, int myFlags, int index);
static ArraySearch *	ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
			    Tcl_Obj *varNamePtr, Tcl_Obj *handleObj);
static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
			    Interp *iPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, int flags, int index);
			    Tcl_Obj *part2Ptr, int flags);

/*
 * TIP #508: [array default]
 */

static int		ArrayDefaultCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		SetArraySearchObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
static void		DeleteArrayVar(Var *arrayPtr);
static void		SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);

/*
 * Functions defined in this file that may be exported in the future for use
 * by the bytecode compiler and engine or to the public interface.
 */

MODULE_SCOPE Var *	TclLookupSimpleVar(Tcl_Interp *interp,
			    Tcl_Obj *varNamePtr, int flags, const int create,
			    const char **errMsgPtr, int *indexPtr);

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;
static Tcl_UpdateStringProc	PanicOnUpdateVarName;

static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;
static Tcl_UpdateStringProc	UpdateParsedVarName;

static Tcl_UpdateStringProc	PanicOnUpdateVarName;
static Tcl_SetFromAnyProc	PanicOnSetVarName;

/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table
 *   ptrAndLongRep.ptr:   pointer to name obj in varFramePtr->localCache
 *                        or NULL if it is this same obj
 *   ptrAndLongRep.value: index into locals table
 *
 * nsVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:	pointer to the namespace containing the reference
 *   twoPtrValue.ptr2:	pointer to the corresponding Var
 *
 * parsedVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:	pointer to the array name Tcl_Obj, or NULL if it is a
 *			scalar variable
 *   twoPtrValue.ptr2:	pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static const Tcl_ObjType localVarNameType = {
static Tcl_ObjType localVarNameType = {
    "localVarName",
    FreeLocalVarName, DupLocalVarName, NULL, NULL
    FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
};

#define LocalSetIntRep(objPtr, index, namePtr)				\
    do {								\
	Tcl_ObjIntRep ir;						\
	Tcl_Obj *ptr = (namePtr);					\
	if (ptr) {Tcl_IncrRefCount(ptr);}				\
	ir.twoPtrValue.ptr1 = ptr;					\
	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
	Tcl_StoreIntRep((objPtr), &localVarNameType, &ir);		\
/*
 * Caching of namespace variables disabled: no simple way was found to avoid
 * interfering with the resolver's idea of variable existence. A cached
 * varName may keep a variable's name in the namespace's hash table, which is
 * the resolver's criterion for existence (see test namespace-17.10).
 */

#define ENABLE_NS_VARNAME_CACHING 0

#if ENABLE_NS_VARNAME_CACHING
static Tcl_FreeInternalRepProc FreeNsVarName;
    } while (0)
static Tcl_DupInternalRepProc DupNsVarName;

#define LocalGetIntRep(objPtr, index, name)				\
    do {								\
	const Tcl_ObjIntRep *irPtr;					\
	irPtr = TclFetchIntRep((objPtr), &localVarNameType);		\
static Tcl_ObjType tclNsVarNameType = {
    "namespaceVarName",
	(name) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1;	\
    } while (0)
    FreeNsVarName, DupNsVarName, PanicOnUpdateVarName, PanicOnSetVarName
};
#endif

static const Tcl_ObjType parsedVarNameType = {
static Tcl_ObjType tclParsedVarNameType = {
    "parsedVarName",
    FreeParsedVarName, DupParsedVarName, NULL, NULL
    FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
};

#define ParsedSetIntRep(objPtr, arrayPtr, elem)				\
    do {								\
	Tcl_ObjIntRep ir;						\
	Tcl_Obj *ptr1 = (arrayPtr);					\
/*
 * Type of Tcl_Objs used to speed up array searches.
 *
 * INTERNALREP DEFINITION:
	Tcl_Obj *ptr2 = (elem);						\
	if (ptr1) {Tcl_IncrRefCount(ptr1);}				\
	if (ptr2) {Tcl_IncrRefCount(ptr2);}				\
	ir.twoPtrValue.ptr1 = ptr1;					\
	ir.twoPtrValue.ptr2 = ptr2;					\
 *   twoPtrValue.ptr1:	searchIdNumber (cast to pointer)
 *   twoPtrValue.ptr2:	variableNameStartInString (cast to pointer)
	Tcl_StoreIntRep((objPtr), &parsedVarNameType, &ir);		\
    } while (0)

#define ParsedGetIntRep(objPtr, parsed, array, elem)			\
 *
 * Note that the value stored in ptr2 is the offset into the string of the
 * start of the variable name and not the address of the variable name itself,
 * as this can be safely copied.
 */

    do {								\
	const Tcl_ObjIntRep *irPtr;					\
Tcl_ObjType tclArraySearchType = {
	irPtr = TclFetchIntRep((objPtr), &parsedVarNameType);		\
	(parsed) = (irPtr != NULL);					\
	(array) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;		\
	(elem) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL;		\
    } while (0)
    "array search",
    NULL, NULL, NULL, SetArraySearchObj
};

Var *
TclVarHashCreateVar(
    TclVarHashTable *tablePtr,
    const char *key,
    int *newPtr)
{
    Tcl_Obj *keyPtr;
    Var *varPtr;

    keyPtr = Tcl_NewStringObj(key, -1);
    Tcl_IncrRefCount(keyPtr);
    varPtr = VarHashCreateVar(tablePtr, keyPtr, newPtr);
    Tcl_DecrRefCount(keyPtr);

    return varPtr;
}

static int
LocateArray(
    Tcl_Interp *interp,
    Tcl_Obj *name,
    Var **varPtrPtr,
    int *isArrayPtr)
{
    Var *arrayPtr, *varPtr = TclObjLookupVarEx(interp, name, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    if (TclCheckArrayTraces(interp, varPtr, arrayPtr, name, -1) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (varPtrPtr) {
	*varPtrPtr = varPtr;
    }
    if (isArrayPtr) {
	*isArrayPtr = varPtr && !TclIsVarUndefined(varPtr)
		&& TclIsVarArray(varPtr);
    }
    return TCL_OK;
}

static int
NotArrayError(
    Tcl_Interp *interp,
    Tcl_Obj *name)
{
    const char *nameStr = TclGetString(name);

    Tcl_SetObjResult(interp,
	    Tcl_ObjPrintf("\"%s\" isn't an array", nameStr));
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAY", nameStr, NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCleanupVar --
 *
 *	This function is called when it looks like it may be OK to free up a
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
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







-
+
-

-
+






-
+
-

-
+







    Var *varPtr,		/* Pointer to variable that may be a candidate
				 * for being expunged. */
    Var *arrayPtr)		/* Array that contains the variable, or NULL
				 * if this variable isn't an array element. */
{
    if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
	    && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == (unsigned)
	    && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
		    !TclIsVarDeadHash(varPtr))) {
	if (VarHashRefCount(varPtr) == 0) {
	    Tcl_Free(varPtr);
	    ckfree((char *) varPtr);
	} else {
	    VarHashDeleteEntry(varPtr);
	}
    }
    if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
	    (VarHashRefCount(arrayPtr) == (unsigned)
	    (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
		    !TclIsVarDeadHash(arrayPtr))) {
	if (VarHashRefCount(arrayPtr) == 0) {
	    Tcl_Free(arrayPtr);
	    ckfree((char *) arrayPtr);
	} else {
	    VarHashDeleteEntry(arrayPtr);
	}
    }
}

void
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
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







-
-
+
+
+









-
+







 *	entry or array to be created). For example, the variable might be a
 *	global that has been unset but is still referenced by a procedure, or
 *	a variable that has been unset but it only being kept in existence (if
 *	VAR_UNDEFINED) by a trace.
 *
 * Side effects:
 *	New hashtable entries may be created if createPart1 or createPart2
 *	are 1. The object part1Ptr is converted to one of localVarNameType
 *	or parsedVarNameType and caches as much of the lookup as it can.
 *	are 1. The object part1Ptr is converted to one of localVarNameType,
 *	tclNsVarNameType or tclParsedVarNameType and caches as much of the
 *	lookup as it can.
 *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
 *	plan to DecrRefCount it.
 *
 *----------------------------------------------------------------------
 */

Var *
TclObjLookupVar(
    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
    Tcl_Obj *part1Ptr,	/* If part2 isn't NULL, this is the name of an
    register Tcl_Obj *part1Ptr,	/* If part2 isn't NULL, this is the name of an
				 * array. Otherwise, this is a full variable
				 * name that could include a parenthesized
				 * array element. */
    const char *part2,		/* Name of element within array, or NULL. */
    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * and TCL_LEAVE_ERR_MSG bits matter. */
    const char *msg,		/* Verb to use in error messages, e.g. "read"
599
600
601
602
603
604
605
606
607

608





609



610



611

612
613









614
615
616
617
618
619









620
621
622
623
624
625
626


627

628
629
630
631
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
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
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
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
611
612



613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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







-
-
+

+
+
+
+
+

+
+
+
-
+
+
+

+
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+







+
+
-
+








+
+
+
+
+
-
+
+
+
+
+

+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
-
-
+
+
+
+
+
+
+
+








-
+
-



+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+
-

-
-
-
-
+
+
+



-
+
-
-




+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
+
+
+
+
+
+
+

+
-
+
+
+
+
+
+
+
+










+
+
+





-
-
+
+
+













+
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-

-
-
+

-
-
-
-
+
+
-
-
+
-
+
+
+





-
+
+
+



+
+
+
+
+
+
+
+
+
+












+
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * return error if it doesn't exist. */
    Var **arrayPtrPtr)		/* If the name refers to an element of an
				 * array, *arrayPtrPtr gets filled in with
				 * address of array variable. Otherwise this
				 * is set to NULL. */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    Var *varPtr;	/* Points to the variable's in-frame Var
    register Var *varPtr;	/* Points to the variable's in-frame Var
				 * structure. */
    char *part1;
    int index, len1, len2;
    int parsed = 0;
    Tcl_Obj *objPtr;
    const Tcl_ObjType *typePtr = part1Ptr->typePtr;
    const char *errMsg = NULL;
    CallFrame *varFramePtr = iPtr->varFramePtr;
#if ENABLE_NS_VARNAME_CACHING
    Namespace *nsPtr;
    int index, parsed = 0;
#endif
    char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
    char *newPart2 = NULL;

    *arrayPtrPtr = NULL;
    int localIndex;
    Tcl_Obj *namePtr, *arrayPtr, *elem;

#if ENABLE_NS_VARNAME_CACHING
    if (varFramePtr) {
	nsPtr = varFramePtr->nsPtr;
    } else {
	/*
	 * Some variables in the global ns have to be initialized before the
	 * root call frame is in place.
	 */

    *arrayPtrPtr = NULL;

  restart:
    LocalGetIntRep(part1Ptr, localIndex, namePtr);
    if (localIndex >= 0) {
	nsPtr = NULL;
    }
#endif

    if (typePtr == &localVarNameType) {
	int localIndex;

    localVarNameTypeHandling:
	localIndex = (int) part1Ptr->internalRep.ptrAndLongRep.value;
	if (HasLocalVars(varFramePtr)
		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
		&& (localIndex < varFramePtr->numCompiledLocals)) {
	    /*
	     * Use the cached index if the names coincide.
	     */

	    Tcl_Obj *namePtr = (Tcl_Obj *)
		    part1Ptr->internalRep.ptrAndLongRep.ptr;
	    Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);
	    Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);

	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
		    (namePtr && (checkNamePtr == namePtr))) {
		varPtr = (Var *) &(varFramePtr->compiledLocals[localIndex]);
		goto donePart1;
	    }
	}
	goto doneParsing;
#if ENABLE_NS_VARNAME_CACHING
    } else if (typePtr == &tclNsVarNameType) {
	int useGlobal, useReference;
	Namespace *cachedNsPtr = part1Ptr->internalRep.twoPtrValue.ptr1;
	varPtr = part1Ptr->internalRep.twoPtrValue.ptr2;
    }

	useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && (
		(flags & TCL_GLOBAL_ONLY) ||
		(part1[0]==':' && part1[1]==':') ||
		(!HasLocalVars(varFramePtr) && (nsPtr==iPtr->globalNsPtr)));

	useReference = useGlobal || ((cachedNsPtr == nsPtr) && (
		(flags & TCL_NAMESPACE_ONLY) ||
		(!HasLocalVars(varFramePtr) && !(flags & TCL_GLOBAL_ONLY) &&
    /*
     * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
     */
		/*
		 * Careful: an undefined ns variable could be hiding a valid
		 * global reference.
		 */
		!TclIsVarUndefined(varPtr))));

	if (useReference && !TclIsVarDeadHash(varPtr)) {
	    /*
	     * A straight global or namespace reference, use it. It isn't so
	     * simple to deal with 'implicit' namespace references, i.e.,
	     * those where the reference could be to either a namespace or a
	     * global variable. Those we lookup again.
	     *
	     * If TclIsVarDeadHash(varPtr), this might be a reference to a
	     * variable in a deleted namespace, kept alive by e.g. part1Ptr.
	     * We could conceivably be so unlucky that a new namespace was
	     * created at the same address as the deleted one, so to be safe
	     * we test for a valid hPtr.
	     */

	    goto donePart1;
	}
	goto doneParsing;
#endif
    }
    ParsedGetIntRep(part1Ptr, parsed, arrayPtr, elem);
    if (parsed && arrayPtr) {

    /*
     * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
     * parts.
     */

    if (typePtr == &tclParsedVarNameType) {
	if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
	    if (part2Ptr != NULL) {
		/*
		 * ERROR: part1Ptr is already an array element, cannot specify
		 * a part2.
		 */

		if (flags & TCL_LEAVE_ERR_MSG) {
		    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
			    NOSUCHVAR, -1);
			    noSuchVar, -1);
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME", NULL);
		}
		return NULL;
	    }
	    part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
	    if (newPart2) {
	    part2Ptr = elem;
	    part1Ptr = arrayPtr;
	    goto restart;
    }

    if (!parsed) {
		part2Ptr = Tcl_NewStringObj(newPart2, -1);
		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}
	    }
	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
	    typePtr = part1Ptr->typePtr;
	    if (typePtr == &localVarNameType) {
		goto localVarNameTypeHandling;
	    }
	}
	parsed = 1;
    }
    part1 = TclGetStringFromObj(part1Ptr, &len1);

    if (!parsed && len1 && (*(part1 + len1 - 1) == ')')) {
	/*
	 * part1Ptr is possibly an unparsed array element.
	 */

	size_t len;
	register int i;
	const char *part1 = TclGetStringFromObj(part1Ptr, &len);

	if ((len > 1) && (part1[len - 1] == ')')) {
	    const char *part2 = strchr(part1, '(');

	    if (part2) {
	len2 = -1;
	for (i = 0; i < len1; i++) {
	    if (*(part1 + i) == '(') {
		if (part2Ptr != NULL) {
		    if (flags & TCL_LEAVE_ERR_MSG) {
			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
				NEEDARRAY, -1);
				needArray, -1);
			Tcl_SetErrorCode(interp, "TCL", "VALUE", "VARNAME",
				NULL);
		    }
		    return NULL;
		}

		/*
		 * part1Ptr points to an array element; first copy the element
		 * name to a new string part2.
		 */
		arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
		part2Ptr = Tcl_NewStringObj(part2 + 1,
			len - (part2 - part1) - 2);

		part2 = part1 + i + 1;
		len2 = len1 - i - 2;
		len1 = i;

		newPart2 = ckalloc((unsigned int) (len2+1));
		memcpy(newPart2, part2, (unsigned int) len2);
		*(newPart2+len2) = '\0';
		part2 = newPart2;
		part2Ptr = Tcl_NewStringObj(newPart2, -1);
		if (createPart2) {
		    Tcl_IncrRefCount(part2Ptr);
		}

		/*
		 * Free the internal rep of the original part1Ptr, now renamed
		 * objPtr, and set it to tclParsedVarNameType.
		 */

		objPtr = part1Ptr;
		TclFreeIntRep(objPtr);
		objPtr->typePtr = &tclParsedVarNameType;
		ParsedSetIntRep(part1Ptr, arrayPtr, part2Ptr);

		/*
		 * Define a new string object to hold the new part1Ptr, i.e.,
		 * the array name. Set the internal rep of objPtr, reset
		 * typePtr and part1 to contain the references to the array
		 * name.
		 */

		TclNewStringObj(part1Ptr, part1, len1);
		part1Ptr = arrayPtr;
		Tcl_IncrRefCount(part1Ptr);

		objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
		objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;

		typePtr = part1Ptr->typePtr;
		part1 = TclGetString(part1Ptr);
		break;
	    }
	}
    }

  doneParsing:
    /*
     * part1Ptr is not an array element; look it up, and convert it to one of
     * the cached types if possible.
     */

    TclFreeIntRep(part1Ptr);
    part1Ptr->typePtr = NULL;

    varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
	    &errMsg, &index);
    if (varPtr == NULL) {
	if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg, errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);
	}
	if (newPart2) {
	    Tcl_DecrRefCount(part2Ptr);
	}
	return NULL;
    }

    /*
     * Cache the newly found variable if possible.
     */

    if (index >= 0) {
	/*
	 * An indexed local variable.
	 */

	part1Ptr->typePtr = &localVarNameType;
	Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);

	if (part1Ptr == cachedNamePtr) {
	    LocalSetIntRep(part1Ptr, index, NULL);
	if (part1Ptr != localName(iPtr->varFramePtr, index)) {
	    part1Ptr->internalRep.ptrAndLongRep.ptr =
		    localName(iPtr->varFramePtr, index);
	    Tcl_IncrRefCount((Tcl_Obj *)
		    part1Ptr->internalRep.ptrAndLongRep.ptr);
	} else {
	    /*
	     * [80304238ac] Trickiness here.  We will store and incr the
	     * refcount on cachedNamePtr.  Trouble is that it's possible
	     * (see test var-22.1) for cachedNamePtr to have an intrep
	     * that contains a stored and refcounted part1Ptr.  This
	    part1Ptr->internalRep.ptrAndLongRep.ptr = NULL;
	     * would be a reference cycle which leads to a memory leak.
	     *
	     * The solution here is to wipe away all intrep(s) in
	     * cachedNamePtr and leave it as string only.  This is
	     * radical and destructive, so a better idea would be welcome.
	     */

	    /*
	}
	part1Ptr->internalRep.ptrAndLongRep.value = (long) index;
#if ENABLE_NS_VARNAME_CACHING
    } else if (index > -3) {
	/*
	     * Firstly set cached local var reference (avoid free before set,
	     * see [45b9faf103f2])
	     */
	 * A cacheable namespace or global variable.
	 */
	    LocalSetIntRep(part1Ptr, index, cachedNamePtr);

	    /* Then wipe it */
	    TclFreeIntRep(cachedNamePtr);
	Namespace *nsPtr;

	    /*
	     * Now go ahead and convert it the the "localVarName" type,
	     * since we suspect at least some use of the value as a
	     * varname and we want to resolve it quickly.
	nsPtr = ((index == -1) ? iPtr->globalNsPtr : varFramePtr->nsPtr);
	varPtr->refCount++;
	     */
	    LocalSetIntRep(cachedNamePtr, index, NULL);
	part1Ptr->typePtr = &tclNsVarNameType;
	}
	part1Ptr->internalRep.twoPtrValue.ptr1 = nsPtr;
	part1Ptr->internalRep.twoPtrValue.ptr2 = varPtr;
#endif
    } else {
	/*
	 * At least mark part1Ptr as already parsed.
	 */

	ParsedSetIntRep(part1Ptr, NULL, NULL);
	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);
	}
	return NULL;
    }
#endif
    while (TclIsVarLink(varPtr)) {
	varPtr = varPtr->value.linkPtr;
    }

    if (part2Ptr != NULL) {
	/*
	 * Array element sought: look it up.
	 */

	*arrayPtrPtr = varPtr;
	varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
		createPart1, createPart2, varPtr, -1);
	if (newPart2) {
	    Tcl_DecrRefCount(part2Ptr);
	}
    }
    return varPtr;
}

/*
 * This flag bit should not interfere with TCL_GLOBAL_ONLY,
 * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
 * lookup is performed for upvar (or similar) purposes, with slightly
 * different rules:
 *    - Bug #696893 - variable is either proc-local or in the current
 *	namespace; never follow the second (global) resolution path
 *    - Bug #631741 - do not use special namespace or interp resolvers
 *
 * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
 * (Bug #835020)
 */

#define AVOID_RESOLVERS 0x40000

/*
 *----------------------------------------------------------------------
 *
 * TclLookupSimpleVar --
 *
 *	This function is used by to locate a simple variable (i.e., not an
 *	array element) given its name.
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
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







-
-
+
+



















-
+
-
-
+


















-
+
+
+


-
+







-
+








Var *
TclLookupSimpleVar(
    Tcl_Interp *interp,		/* Interpreter to use for lookup. */
    Tcl_Obj *varNamePtr,	/* This is a simple variable name that could
				 * represent a scalar or an array. */
    int flags,			/* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG
				 * bits matter. */
				 * AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits
				 * matter. */
    const int create,		/* If 1, create hash table entry for varname,
				 * if it doesn't already exist. If 0, return
				 * error if it doesn't exist. */
    const char **errMsgPtr,
    int *indexPtr)
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
				/* Points to the procedure call frame whose
				 * variables are currently in use. Same as the
				 * current procedure's frame, if any, unless
				 * an "uplevel" is executing. */
    TclVarHashTable *tablePtr;	/* Points to the hashtable, if any, in which
				 * to look up the variable. */
    Tcl_Var var;		/* Used to search for global names. */
    Var *varPtr;		/* Points to the Var structure returned for
				 * the variable. */
    Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
    ResolverScheme *resPtr;
    int isNew, i, result;
    int isNew;
    size_t varLen;
    const char *varName = TclGetStringFromObj(varNamePtr, &varLen);
    const char *varName = TclGetString(varNamePtr);

    varPtr = NULL;
    varNsPtr = NULL;		/* Set non-NULL if a nonlocal variable. */
    *indexPtr = -3;

    if (flags & TCL_GLOBAL_ONLY) {
	cxtNsPtr = iPtr->globalNsPtr;
    } else {
	cxtNsPtr = iPtr->varFramePtr->nsPtr;
    }

    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
	    && !(flags & TCL_AVOID_RESOLVERS)) {
	    && !(flags & AVOID_RESOLVERS)) {
	int result;

	resPtr = iPtr->resolverPtr;
	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, varName,
	    result = (*cxtNsPtr->varResProc)(interp, varName,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}

	while (result == TCL_CONTINUE && resPtr) {
	    if (resPtr->varResProc) {
		result = resPtr->varResProc(interp, varName,
		result = (*resPtr->varResProc)(interp, varName,
			(Tcl_Namespace *) cxtNsPtr, flags, &var);
	    }
	    resPtr = resPtr->nextPtr;
	}

	if (result == TCL_OK) {
	    return (Var *) var;
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
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
1065
1066
1067

1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079

1080
1081
1082
1083
1084
1085
1086
1087







+
-
-
+
+
+
+
+









-
+

-

-
-
-
-
-
-
-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+




-
-
-
+
-
-
+

-
-
+
+

-
-
+
+

-
-
-
-
+
+
+
+
-






-
+
+










-
+







		|| (cxtNsPtr == iPtr->globalNsPtr)
		|| ((*varName == ':') && (*(varName+1) == ':'));

	if (lookGlobal) {
	    *indexPtr = -1;
	    flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
	} else {
	    if (flags & AVOID_RESOLVERS) {
	    flags = (flags | TCL_NAMESPACE_ONLY);
	    *indexPtr = -2;
		flags = (flags | TCL_NAMESPACE_ONLY);
	    }
	    if (flags & TCL_NAMESPACE_ONLY) {
		*indexPtr = -2;
	    }
	}

	/*
	 * Don't pass TCL_LEAVE_ERR_MSG, we may yet create the variable, or
	 * otherwise generate our own error!
	 */

	varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
		(Tcl_Namespace *) cxtNsPtr,
		(flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
		(flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
	if (varPtr == NULL) {
	    Tcl_Obj *tailPtr;

	    if (!create) {	/* Var wasn't found and not to create it. */
		*errMsgPtr = NOSUCHVAR;
		return NULL;
	    }

	    /*
	     * Var wasn't found so create it.
	     */
	    if (create) {	/* Var wasn't found so create it. */
		Tcl_Obj *tailPtr;

	    TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags,
		    &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
	    if (varNsPtr == NULL) {
		*errMsgPtr = BADNAMESPACE;
		return NULL;
	    } else if (tail == NULL) {
		*errMsgPtr = MISSINGNAME;
		return NULL;
	    }
	    if (tail != varName) {
		tailPtr = Tcl_NewStringObj(tail, -1);
	    } else {
		tailPtr = varNamePtr;
	    }
	    varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &isNew);
	    if (lookGlobal) {
		/*
		 * The variable was created starting from the global
		 * namespace: a global reference is returned even if it wasn't
		 * explicitly requested.
		 */
		TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
			flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
		if (varNsPtr == NULL) {
		    *errMsgPtr = badNamespace;
		    return NULL;
		} else if (tail == NULL) {
		    *errMsgPtr = missingName;
		    return NULL;
		}
		if (tail != varName) {
		    tailPtr = Tcl_NewStringObj(tail, -1);
		} else {
		    tailPtr = varNamePtr;
		}
		varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr,
			&isNew);
		if (lookGlobal) {
		    /*
		     * The variable was created starting from the global
		     * namespace: a global reference is returned even if it
		     * wasn't explicitly requested.
		     */

		*indexPtr = -1;
	    } else {
		*indexPtr = -2;
		    *indexPtr = -1;
		} else {
		    *indexPtr = -2;
		}
	    } else {		/* Var wasn't found and not to create it. */
		*errMsgPtr = noSuchVar;
		return NULL;
	    }
	}
    } else {			/* Local var: look in frame varFramePtr. */
	int localCt = varFramePtr->numCompiledLocals;

	if (localCt > 0) {
	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
	    const char *localNameStr;
	    size_t localLen;
	int i;

	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
		Tcl_Obj *objPtr = *objPtrPtr;
	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
	    register Tcl_Obj *objPtr = *objPtrPtr;

		if (objPtr) {
		    localNameStr = TclGetStringFromObj(objPtr, &localLen);
	    if (objPtr) {
		char *localName = TclGetString(objPtr);

		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
			&& !memcmp(varName, localNameStr, varLen)) {
			*indexPtr = i;
			return (Var *) &varFramePtr->compiledLocals[i];
		if ((varName[0] == localName[0])
			&& (strcmp(varName, localName) == 0)) {
		    *indexPtr = i;
		    return (Var *) &varFramePtr->compiledLocals[i];
		    }
		}
	    }
	}
	tablePtr = varFramePtr->varTablePtr;
	if (create) {
	    if (tablePtr == NULL) {
		tablePtr = (TclVarHashTable *)Tcl_Alloc(sizeof(TclVarHashTable));
		tablePtr = (TclVarHashTable *)
			ckalloc(sizeof(TclVarHashTable));
		TclInitVarHashTable(tablePtr, NULL);
		varFramePtr->varTablePtr = tablePtr;
	    }
	    varPtr = VarHashCreateVar(tablePtr, varNamePtr, &isNew);
	} else {
	    varPtr = NULL;
	    if (tablePtr != NULL) {
		varPtr = VarHashFindVar(tablePtr, varNamePtr);
	    }
	    if (varPtr == NULL) {
		*errMsgPtr = NOSUCHVAR;
		*errMsgPtr = noSuchVar;
	    }
	}
    }
    return varPtr;
}

/*
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
1140
1141
1142



































1143
1144
1145
1146
1147
1148
1149
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







+







+
+



-
+
-
-












-
+
-
-




-
+
+
+
+
+
+
+
+
+
+


-
+

-
-


















-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * element, if it doesn't already exist. If 0,
				 * return error if it doesn't exist. */
    Var *arrayPtr,		/* Pointer to the array's Var structure. */
    int index)			/* If >=0, the index of the local array. */
{
    int isNew;
    Var *varPtr;
    TclVarHashTable *tablePtr;

    /*
     * We're dealing with an array element. Make sure the variable is an array
     * and look up the element (create the element if desired).
     */

    if (TclIsVarUndefined(arrayPtr) && !TclIsVarArrayElement(arrayPtr)) {
	Namespace *nsPtr;

	if (!createArray) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			NOSUCHVAR, index);
			noSuchVar, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	    }
	    return NULL;
	}

	/*
	 * Make sure we are not resurrecting a namespace variable from a
	 * deleted namespace!
	 */

	if (TclIsVarDeadHash(arrayPtr)) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			DANGLINGVAR, index);
			danglingVar, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
			arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	    }
	    return NULL;
	}

	TclInitArrayVar(arrayPtr);
	TclSetVarArray(arrayPtr);
	tablePtr = (TclVarHashTable *) ckalloc(sizeof(TclVarHashTable));
	arrayPtr->value.tablePtr = tablePtr;

	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
	    nsPtr = TclGetVarNsPtr(arrayPtr);
	} else {
	    nsPtr = NULL;
	}
	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
    } else if (!TclIsVarArray(arrayPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, NEEDARRAY,
	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
		    index);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    arrayNamePtr?TclGetString(arrayNamePtr):NULL, NULL);
	}
	return NULL;
    }

    if (createElem) {
	varPtr = VarHashCreateVar(arrayPtr->value.tablePtr, elNamePtr,
		&isNew);
	if (isNew) {
	    if (arrayPtr->flags & VAR_SEARCH_ACTIVE) {
		DeleteSearches((Interp *) interp, arrayPtr);
	    }
	    TclSetVarArrayElement(varPtr);
	}
    } else {
	varPtr = VarHashFindVar(arrayPtr->value.tablePtr, elNamePtr);
	if (varPtr == NULL) {
	    if (flags & TCL_LEAVE_ERR_MSG) {
		TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg,
			NOSUCHELEMENT, index);
			noSuchElement, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT",
			TclGetString(elNamePtr), NULL);
	    }
	}
    }
    return varPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar --
 *
 *	Return the value of a Tcl variable as a string.
 *
 * Results:
 *	The return value points to the current value of varName as a string.
 *	If the variable is not defined or can't be read because of a clash in
 *	array usage then a NULL pointer is returned and an error message is
 *	left in the interp's result if the TCL_LEAVE_ERR_MSG flag is set.
 *	Note: the return value is only valid up until the next change to the
 *	variable; if you depend on the value lasting longer than that, then
 *	make yourself a private copy.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_GetVar
const char *
Tcl_GetVar(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    const char *varName,	/* Name of a variable in interp. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG
				 * bits. */
{
    return Tcl_GetVar2(interp, varName, NULL, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar2 --
 *
 *	Return the value of a Tcl variable as a string, given a two-part name
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
1283
1284
1285
1286
1287
1288
1289

1290

1291





1292







1293
1294
1295

1296
1297
1298
1299
1300
1301
1302
1303







-
+
-

-
-
-
-
-
+
-
-
-
-
-
-
-
+


-
+







				 * the name of a variable. */
    const char *part2,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY,
				 * TCL_NAMESPACE_ONLY and TCL_LEAVE_ERR_MSG *
				 * bits. */
{
    Tcl_Obj *resultPtr;
    Tcl_Obj *objPtr;
    Tcl_Obj *part2Ptr = NULL, *part1Ptr = Tcl_NewStringObj(part1, -1);

    if (part2) {
	part2Ptr = Tcl_NewStringObj(part2, -1);
	Tcl_IncrRefCount(part2Ptr);
    }

    objPtr = Tcl_GetVar2Ex(interp, part1, part2, flags);
    resultPtr = Tcl_ObjGetVar2(interp, part1Ptr, part2Ptr, flags);

    Tcl_DecrRefCount(part1Ptr);
    if (part2Ptr) {
	Tcl_DecrRefCount(part2Ptr);
    }
    if (resultPtr == NULL) {
    if (objPtr == NULL) {
	return NULL;
    }
    return TclGetString(resultPtr);
    return TclGetString(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetVar2Ex --
 *
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
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







-
+


-
+


















-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ObjGetVar2(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
    register Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,	/* If non-null, points to an object holding
    register Tcl_Obj *part2Ptr,	/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    int flags)			/* OR-ed combination of TCL_GLOBAL_ONLY and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    Var *varPtr, *arrayPtr;

    /*
     * Filter to pass through only the flags this interface supports.
     */

    flags &= (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG);
    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
	    /*createPart1*/ 0, /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	return NULL;
    }

    return TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
    return TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrGetVar --
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
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
1424
1425
1426
1427
1428
1429
1430















































1431
1432
1433
1434
1435
1436
1437
1438







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrGetVar(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Tcl_Var varPtr,		/* The variable to be read.*/
    Tcl_Var arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    const int flags)		/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    return TclPtrGetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrGetVarIdx --
 *
 *	Return the value of a Tcl variable as a Tcl object, given the pointers
 *	to the variable's (and possibly containing array's) VAR structure.
 *
 * Results:
 *	The return value points to the current object value of the variable
 *	given by varPtr. If the specified variable doesn't exist, or if there
 *	is a clash in array usage, then NULL is returned and a message will be
 *	left in the interpreter's result if the TCL_LEAVE_ERR_MSG flag is set.
 *
 * Side effects:
 *	The ref count for the returned object is _not_ incremented to reflect
 *	the returned reference; if you want to keep a reference to the object
 *	you must increment its ref count yourself.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrGetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Var *varPtr,	/* The variable to be read.*/
    register Var *varPtr,	/* The variable to be read.*/
    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    const int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
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
1439
1440

1441
1442

1443
1444

1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1462
1463
1464
1465
1466
1467
1468






















1469
1470
1471

1472
1473

1474
1475

1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486

1487
1488
1489
1490
1491
1492
1493







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+

-
+

-
+










-







     * Return the element if it's an existing scalar variable.
     */

    if (TclIsVarScalar(varPtr) && !TclIsVarUndefined(varPtr)) {
	return varPtr->value.objPtr;
    }

    /*
     * Return the array default value if any.
     */

    if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
	return TclGetArrayDefault(arrayPtr);
    }
    if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
	/*
	 * UGLY! Peek inside the implementation of things. This lets us get
	 * the default of an array even when we've been [upvar]ed to just an
	 * element of the array.
	 */

	ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
		((VarInHash *) varPtr)->entry.tablePtr;

	if (avhtPtr->defaultObj) {
	    return avhtPtr->defaultObj;
	}
    }

    if (flags & TCL_LEAVE_ERR_MSG) {
	if (TclIsVarUndefined(varPtr) && arrayPtr
		&& !TclIsVarUndefined(arrayPtr)) {
	    msg = NOSUCHELEMENT;
	    msg = noSuchElement;
	} else if (TclIsVarArray(varPtr)) {
	    msg = ISARRAY;
	    msg = isArray;
	} else {
	    msg = NOSUCHVAR;
	    msg = noSuchVar;
	}
	TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "read", msg, index);
    }

    /*
     * An error. If the variable doesn't exist anymore and no-one's using it,
     * then free up the relevant structures and hash table entries.
     */

  errorReturn:
    Tcl_SetErrorCode(interp, "TCL", "READ", "VARNAME", NULL);
    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
    }
    return NULL;
}

/*
1472
1473
1474
1475
1476
1477
1478

1479
1480
1481
1482


1483
1484
1485
1486
1487
1488
1489
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512


1513
1514
1515
1516
1517
1518
1519
1520
1521







+


-
-
+
+







 *
 * Side effects:
 *	A variable's value may be changed.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_SetObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,/* Current interpreter. */
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValueObj;

    if (objc == 2) {
	varValueObj = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
1501
1502
1503
1504
1505
1506
1507







































1508
1509
1510
1511
1512
1513
1514
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	Tcl_SetObjResult(interp, varValueObj);
	return TCL_OK;
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?newValue?");
	return TCL_ERROR;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetVar --
 *
 *	Change the value of a variable.
 *
 * Results:
 *	Returns a pointer to the malloc'ed string which is the character
 *	representation of the variable's new value. The caller must not modify
 *	this string. If the write operation was disallowed then NULL is
 *	returned; if the TCL_LEAVE_ERR_MSG flag is set, then an explanatory
 *	message will be left in the interp's result. Note that the returned
 *	string may not be the same as newValue; this is because variable
 *	traces may modify the variable's value.
 *
 * Side effects:
 *	If varName is defined as a local or global variable in interp, its
 *	value is changed to newValue. If varName isn't currently defined, then
 *	a new global variable by that name is created.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_SetVar
const char *
Tcl_SetVar(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    const char *varName,	/* Name of a variable in interp. */
    const char *newValue,	/* New value for varName. */
    int flags)			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
{
    return Tcl_SetVar2(interp, varName, NULL, newValue, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetVar2 --
 *
 *	Given a two-part variable name, which may refer either to a scalar
1652
1653
1654
1655
1656
1657
1658
1659

1660
1661
1662

1663
1664
1665
1666
1667
1668
1669
1723
1724
1725
1726
1727
1728
1729

1730
1731
1732

1733
1734
1735
1736
1737
1738
1739
1740







-
+


-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ObjSetVar2(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be found. */
    Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
    register Tcl_Obj *part1Ptr,	/* Points to an object holding the name of an
				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,	/* If non-NULL, points to an object holding
    register Tcl_Obj *part2Ptr,	/* If non-NULL, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    int flags)			/* Various flags that tell how to set value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT, or
				 * TCL_LEAVE_ERR_MSG. */
1681
1682
1683
1684
1685
1686
1687
1688

1689
1690
1691
1692
1693
1694
1695
1752
1753
1754
1755
1756
1757
1758

1759
1760
1761
1762
1763
1764
1765
1766







-
+







    if (varPtr == NULL) {
	if (newValuePtr->refCount == 0) {
	    Tcl_DecrRefCount(newValuePtr);
	}
	return NULL;
    }

    return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    newValuePtr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrSetVar --
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
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
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
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
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


















-













-
+
-


-
+
-











-
+
-









-
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrSetVar(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Tcl_Var varPtr,		/* Reference to the variable to set. */
    Tcl_Var arrayPtr,		/* Reference to the array containing the
				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    const int flags)		/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    if (newValuePtr == NULL) {
	Tcl_Panic("newValuePtr must not be NULL");
    }
    return TclPtrSetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, newValuePtr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * ListAppendInVar, StringAppendInVar --
 *
 *	Support functions for TclPtrSetVarIdx that implement various types of
 *	appending operations.
 *
 * Results:
 *	ListAppendInVar returns a Tcl result code (from the core list append
 *	operation). StringAppendInVar has no return value.
 *
 * Side effects:
 *	The variable or element of the array is updated. This may make the
 *	variable/element exist. Reference counts of values may be updated.
 *
 *----------------------------------------------------------------------
 */

static inline int
ListAppendInVar(
    Tcl_Interp *interp,
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *oldValuePtr,
    Tcl_Obj *newValuePtr)
{
    if (oldValuePtr == NULL) {
	/*
	 * No previous value. Check for defaults if there's an array we can
	 * ask this of.
	 */

	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		oldValuePtr = Tcl_DuplicateObj(defValuePtr);
	    }
	}

	if (oldValuePtr == NULL) {
	    /*
	     * No default. [lappend] semantics say this is like being an empty
	     * string.
	     */

	    TclNewObj(oldValuePtr);
	}
	varPtr->value.objPtr = oldValuePtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
    } else if (Tcl_IsShared(oldValuePtr)) {
	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
	TclDecrRefCount(oldValuePtr);
	oldValuePtr = varPtr->value.objPtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
    }

    return Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
}

static inline void
StringAppendInVar(
    Var *varPtr,
    Var *arrayPtr,
    Tcl_Obj *oldValuePtr,
    Tcl_Obj *newValuePtr)
{
    /*
     * If there was no previous value, either we use the array's default (if
     * this is an array with a default at all) or we treat this as a simple
     * set.
     */

    if (oldValuePtr == NULL) {
	if (arrayPtr) {
	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);

	    if (defValuePtr) {
		/*
		 * This is *almost* the same as the shared path below, except
		 * that the original value reference in defValuePtr is not
		 * decremented.
		 */

		Tcl_Obj *valuePtr = Tcl_DuplicateObj(defValuePtr);

		varPtr->value.objPtr = valuePtr;
		TclContinuationsCopy(valuePtr, defValuePtr);
		Tcl_IncrRefCount(valuePtr);
		Tcl_AppendObjToObj(valuePtr, newValuePtr);
		if (newValuePtr->refCount == 0) {
		    Tcl_DecrRefCount(newValuePtr);
		}
		return;
	    }
	}
	varPtr->value.objPtr = newValuePtr;
	Tcl_IncrRefCount(newValuePtr);
	return;
    }

    /*
     * We append newValuePtr's bytes but don't change its ref count. Unless
     * the reference is shared, when we have to duplicate in order to be safe
     * to modify at all.
     */

    if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

	TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);

	TclDecrRefCount(oldValuePtr);
	oldValuePtr = varPtr->value.objPtr;
	Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
    }

    Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
    if (newValuePtr->refCount == 0) {
	Tcl_DecrRefCount(newValuePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrSetVarIdx --
 *
 *	This function is the same as Tcl_SetVar2Ex above, except that it
 *	requires pointers to the variable's Var structs in addition to the
 *	variable names.
 *
 * Results:
 *	Returns a pointer to the Tcl_Obj holding the new value of the
 *	variable. If the write operation was disallowed because an array was
 *	expected but not found (or vice versa), then NULL is returned; if the
 *	TCL_LEAVE_ERR_MSG flag is set, then an explanatory message will be
 *	left in the interpreter's result. Note that the returned object may
 *	not be the same one referenced by newValuePtr; this is because
 *	variable traces may modify the variable's value.
 *
 * Side effects:
 *	The value of the given variable is set. If either the array or the
 *	entry didn't exist then a new variable is created.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrSetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be looked up. */
    Var *varPtr,	/* Reference to the variable to set. */
    register Var *varPtr,	/* Reference to the variable to set. */
    Var *arrayPtr,		/* Reference to the array containing the
				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. NULL if the 'index'
				 * parameter is >= 0 */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    Tcl_Obj *newValuePtr,	/* New value for variable. */
    const int flags,		/* OR-ed combination of TCL_GLOBAL_ONLY, and
				 * TCL_LEAVE_ERR_MSG bits. */
    int index)			/* Index of local var where part1 is to be
				 * found. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *oldValuePtr;
    Tcl_Obj *resultPtr = NULL;
    int result;
    int cleanupOnEarlyError = (newValuePtr->refCount == 0);

    /*
     * If the variable is in a hashtable and its hPtr field is NULL, then we
     * may have an upvar to an array element where the array was deleted or an
     * upvar to a namespace variable whose namespace was deleted. Generate an
     * error (allowing the variable to be reset would screw up our storage
     * allocation and is meaningless anyway).
     */

    if (TclIsVarDeadHash(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    if (TclIsVarArrayElement(varPtr)) {
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			DANGLINGELEMENT, index);
			danglingElement, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ELEMENT", NULL);
	    } else {
		TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set",
			DANGLINGVAR, index);
			danglingVar, index);
		Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME", NULL);
	    }
	}
	goto earlyError;
    }

    /*
     * It's an error to try to set an array variable itself.
     */

    if (TclIsVarArray(varPtr)) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", ISARRAY,index);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "set", isArray,index);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	}
	goto earlyError;
    }

    /*
     * Invoke any read traces that have been set for the variable if it is
     * requested. This was done for INST_LAPPEND_* but that was inconsistent
     * with the non-bc instruction, and would cause failures trying to
     * lappend to any non-existing ::env var, which is inconsistent with
     * documented behavior. [Bug #3057639].
     * documented behavior.  [Bug #3057639]
     */

    if ((flags & TCL_TRACE_READS) && ((varPtr->flags & VAR_TRACED_READ)
	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_READ)))) {
	if (TCL_ERROR == TclObjCallVarTraces(iPtr, arrayPtr, varPtr,
		part1Ptr, part2Ptr,
		TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG), index)) {
1977
1978
1979
1980
1981
1982
1983











1984

1985










1986
1987
1988
1989
1990






















1991





1992
1993
1994
1995
1996
1997
1998
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







+
+
+
+
+
+
+
+
+
+
+

+
-
+
+
+
+
+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+







     */

    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;
	    oldValuePtr = NULL;
	}
#endif
	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
	    if (oldValuePtr == NULL) {
	    result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,
		TclNewObj(oldValuePtr);
		varPtr->value.objPtr = oldValuePtr;
		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
	    } else if (Tcl_IsShared(oldValuePtr)) {
		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
		TclDecrRefCount(oldValuePtr);
		oldValuePtr = varPtr->value.objPtr;
		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
	    }
	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
		    newValuePtr);
	    if (result != TCL_OK) {
		goto earlyError;
	    }
	} else {				/* Append string. */
	    /*
	     * We append newValuePtr's bytes but don't change its ref count.
	     */

	    if (oldValuePtr == NULL) {
		varPtr->value.objPtr = newValuePtr;
		Tcl_IncrRefCount(newValuePtr);
	    } else {
		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);

		    /*
		     * TIP #280.
		     * Ensure that the continuation line data for the string
		     * is not lost and applies to the extended script as well.
		     */
		    TclContinuationsCopy (varPtr->value.objPtr, oldValuePtr);

		    TclDecrRefCount(oldValuePtr);
		    oldValuePtr = varPtr->value.objPtr;
		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
		}
	    StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);
		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
		if (newValuePtr->refCount == 0) {
		    Tcl_DecrRefCount(newValuePtr);
		}
	    }
	}
    } else if (newValuePtr != oldValuePtr) {
	/*
	 * In this case we are replacing the value, so we don't need to do
	 * more than swap the objects.
	 */

2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051

2052
2053
2054
2055
2056
2057
2058
1971
1972
1973
1974
1975
1976
1977



1978
1979
1980
1981
1982
1983

1984
1985
1986
1987
1988
1989
1990
1991







-
-
-






-
+








    /*
     * If the variable doesn't exist anymore and no-one's using it, then free
     * up the relevant structures and hash table entries.
     */

  cleanup:
    if (resultPtr == NULL) {
	Tcl_SetErrorCode(interp, "TCL", "WRITE", "VARNAME", NULL);
    }
    if (TclIsVarUndefined(varPtr)) {
	TclCleanupVar(varPtr, arrayPtr);
    }
    return resultPtr;

  earlyError:
    if (cleanupOnEarlyError) {
    if (newValuePtr->refCount == 0) {
	Tcl_DecrRefCount(newValuePtr);
    }
    goto cleanup;
}

/*
 *----------------------------------------------------------------------
2099
2100
2101
2102
2103
2104
2105
2106
2107


2108
2109
2110

2111
2112
2113
2114
2115
2116
2117
2032
2033
2034
2035
2036
2037
2038


2039
2040
2041
2042

2043
2044
2045
2046
2047
2048
2049
2050







-
-
+
+


-
+







				 * TCL_LEAVE_ERR_MSG. */
{
    Var *varPtr, *arrayPtr;

    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read",
	    1, 1, &arrayPtr);
    if (varPtr == NULL) {
	Tcl_AddErrorInfo(interp,
		"\n    (reading value of variable to increment)");
	Tcl_AddObjErrorInfo(interp,
		"\n    (reading value of variable to increment)", -1);
	return NULL;
    }
    return TclPtrIncrObjVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
    return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    incrPtr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrIncrObjVar --
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+




-
-
+
+




-
+






-
-
+
+







+







-
-
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrIncrObjVar(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be found. */
    Tcl_Var varPtr,		/* Reference to the variable to set. */
    Tcl_Var arrayPtr,		/* Reference to the array containing the
				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Points to an object holding the name of an
				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    Tcl_Obj *incrPtr,		/* Increment value. */
/* TODO: Which of these flag values really make sense? */
    const int flags)		/* Various flags that tell how to incr value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    return TclPtrIncrObjVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, incrPtr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrIncrObjVarIdx --
 *
 *	Given the pointers to a variable and possible containing array,
 *	increment the Tcl object value of the variable by a Tcl_Obj increment.
 *
 * Results:
 *	Returns a pointer to the Tcl_Obj holding the new value of the
 *	variable. If the specified variable doesn't exist, or there is a clash
 *	in array usage, or an error occurs while executing variable traces,
 *	then NULL is returned and a message will be left in the interpreter's
 *	result.
 *
 * Side effects:
 *	The value of the given variable is incremented by the specified
 *	amount. If either the array or the entry didn't exist then a new
 *	variable is created. The ref count for the returned object is _not_
 *	incremented to reflect the returned reference; if you want to keep a
 *	reference to the object you must increment its ref count yourself.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclPtrIncrObjVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which variable is to
				 * be found. */
    Var *varPtr,		/* Reference to the variable to set. */
    Var *arrayPtr,		/* Reference to the array containing the
				 * variable, or NULL if the variable is a
				 * scalar. */
    Tcl_Obj *part1Ptr,		/* Points to an object holding the name of an
				 * array (if part2 is non-NULL) or the name of
				 * a variable. */
    Tcl_Obj *part2Ptr,		/* If non-null, points to an object holding
				 * the name of an element in the array
				 * part1Ptr. */
    Tcl_Obj *incrPtr,		/* Increment value. */
/* TODO: Which of these flag values really make sense? */
    const int flags,		/* Various flags that tell how to incr value:
				 * any of TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Tcl_Obj *varValuePtr;
    register Tcl_Obj *varValuePtr;

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }
    varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
	    part2Ptr, flags, index);
    varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    flags, index);
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    if (varValuePtr == NULL) {
	TclNewIntObj(varValuePtr, 0);
	varValuePtr = Tcl_NewIntObj(0);
    }
    if (Tcl_IsShared(varValuePtr)) {
	/* Copy on write */
	varValuePtr = Tcl_DuplicateObj(varValuePtr);

	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
	    return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, varValuePtr, flags, index);
	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
		    varValuePtr, flags, index);
	} else {
	    Tcl_DecrRefCount(varValuePtr);
	    return NULL;
	}
    } else {
	/* Unshared - can Incr in place */
	if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {

	    /*
	     * This seems dumb to write the incremeted value into the var
	     * after we just adjusted the value in place, but the spec for
	     * [incr] requires that write traces fire, and making this call
	     * is the way to make that happen.
	     */

	    return TclPtrSetVarIdx(interp, varPtr, arrayPtr, part1Ptr,
		    part2Ptr, varValuePtr, flags, index);
	    return TclPtrSetVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
		    varValuePtr, flags, index);
	} else {
	    return NULL;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnsetVar --
 *
 *	Delete a variable, so that it may not be accessed anymore.
 *
 * Results:
 *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
 *	the variable can't be unset. In the event of an error, if the
 *	TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
 *	interp's result.
 *
 * Side effects:
 *	If varName is defined as a local or global variable in interp, it is
 *	deleted.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_UnsetVar
int
Tcl_UnsetVar(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    const char *varName,	/* Name of a variable in interp. May be either
				 * a scalar name or an array name or an
				 * element in an array. */
    int flags)			/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY or
				 * TCL_LEAVE_ERR_MSG. */
{
    return Tcl_UnsetVar2(interp, varName, NULL, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UnsetVar2 --
 *
 *	Delete a variable, given a 2-part name.
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
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







-
+
+
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+












-
+








-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+







				 * be looked up. */
    Tcl_Obj *part1Ptr,		/* Name of variable or array. */
    Tcl_Obj *part2Ptr,		/* Name of element within array or NULL. */
    int flags)			/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
{
    Var *varPtr, *arrayPtr;
    Var *varPtr;
    Interp *iPtr = (Interp *) interp;
    Var *arrayPtr;
    int result;

    varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "unset",
	    /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    if (varPtr == NULL) {
	return TCL_ERROR;
    }

    return TclPtrUnsetVarIdx(interp, varPtr, arrayPtr, part1Ptr, part2Ptr,
	    flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrUnsetVar --
 *
 *	Delete a variable, given the pointers to the variable's (and possibly
 *	containing array's) VAR structure.
 *
 * Results:
 *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
 *	the variable can't be unset. In the event of an error, if the
 *	TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
 *	interp's result.
 *
 * Side effects:
 *	If varPtr and arrayPtr indicate a local or global variable in interp,
 *	it is deleted. If varPtr is an array reference and part2Ptr is NULL,
 *	then the whole array is deleted.
 *
 *----------------------------------------------------------------------
 */

int
TclPtrUnsetVar(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    Tcl_Var varPtr,		/* The variable to be unset. */
    Tcl_Var arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    const int flags)		/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
{
    if (varPtr == NULL) {
	Tcl_Panic("varPtr must not be NULL");
    }
    if (part1Ptr == NULL) {
	Tcl_Panic("part1Ptr must not be NULL");
    }
    return TclPtrUnsetVarIdx(interp, (Var *) varPtr, (Var *) arrayPtr,
	    part1Ptr, part2Ptr, flags, -1);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrUnsetVarIdx --
 *
 *	Delete a variable, given the pointers to the variable's (and possibly
 *	containing array's) VAR structure.
 *
 * Results:
 *	Returns TCL_OK if the variable was successfully deleted, TCL_ERROR if
 *	the variable can't be unset. In the event of an error, if the
 *	TCL_LEAVE_ERR_MSG flag is set then an error message is left in the
 *	interp's result.
 *
 * Side effects:
 *	If varPtr and arrayPtr indicate a local or global variable in interp,
 *	it is deleted. If varPtr is an array reference and part2Ptr is NULL,
 *	then the whole array is deleted.
 *
 *----------------------------------------------------------------------
 */

int
TclPtrUnsetVarIdx(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    Var *varPtr,	/* The variable to be unset. */
    Var *arrayPtr,		/* NULL for scalar variables, pointer to the
				 * containing array otherwise. */
    Tcl_Obj *part1Ptr,		/* Name of an array (if part2 is non-NULL) or
				 * the name of a variable. */
    Tcl_Obj *part2Ptr,		/* If non-NULL, gives the name of an element
				 * in the array part1. */
    const int flags,		/* OR-ed combination of any of
				 * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
				 * TCL_LEAVE_ERR_MSG. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    Interp *iPtr = (Interp *) interp;
    int result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);
    result = (TclIsVarUndefined(varPtr)? TCL_ERROR : TCL_OK);

    /*
     * Keep the variable alive until we're done with it. We used to
     * increase/decrease the refCount for each operation, making it hard to
     * find [Bug 735335] - caused by unsetting the variable whose value was
     * the variable's name.
     */

    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }

    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags, index);
    UnsetVarStruct(varPtr, arrayPtr, iPtr, part1Ptr, part2Ptr, flags);

    /*
     * It's an error to unset an undefined variable.
     */

    if (result != TCL_OK) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, "unset",
		    ((arrayPtr == NULL) ? NOSUCHVAR : NOSUCHELEMENT), index);
	    Tcl_SetErrorCode(interp, "TCL", "UNSET", "VARNAME", NULL);
	}
		    ((arrayPtr == NULL) ? noSuchVar : noSuchElement), -1);
	}
    }

#if ENABLE_NS_VARNAME_CACHING
    /*
     * Try to avoid keeping the Var struct allocated due to a tclNsVarNameType
     * keeping a reference. This removes some additional exteriorisations of
     * [Bug 736729], but may be a good thing independently of the bug.
     */

    if (part1Ptr->typePtr == &tclNsVarNameType) {
	TclFreeIntRep(part1Ptr);
	part1Ptr->typePtr = NULL;
    }
#endif

    /*
     * Finally, if the variable is truly not in use then free up its Var
     * structure and remove it from its hash table, if any. The ref count of
     * its value object, if any, was decremented above.
     */

2503
2504
2505
2506
2507
2508
2509
2510

2511
2512
2513
2514
2515
2516
2517
2518
2339
2340
2341
2342
2343
2344
2345

2346

2347
2348
2349
2350
2351
2352
2353







-
+
-







static void
UnsetVarStruct(
    Var *varPtr,
    Var *arrayPtr,
    Interp *iPtr,
    Tcl_Obj *part1Ptr,
    Tcl_Obj *part2Ptr,
    int flags,
    int flags)
    int index)
{
    Var dummyVar;
    int traced = TclIsVarTraced(varPtr)
	    || (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET));

    if (arrayPtr && (arrayPtr->flags & VAR_SEARCH_ACTIVE)) {
	DeleteSearches(iPtr, arrayPtr);
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
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







-








+
+

-
-
+




-
+

+
+





+
+




-
+



-
+




-
-
+
+
+
+
+
-
-
+
-











-
+







     *    will use dummyVar so it won't increment varPtr's refCount itself.
     * 2. Turn off the VAR_TRACE_ACTIVE flag in dummyVar: we want to call
     *    unset traces even if other traces are pending.
     */

    if (traced) {
	VarTrace *tracePtr = NULL;
	Tcl_HashEntry *tPtr;

	if (TclIsVarTraced(&dummyVar)) {
	    /*
	     * Transfer any existing traces on var, IF there are unset traces.
	     * Otherwise just delete them.
	     */

	    int isNew;
	    Tcl_HashEntry *tPtr =
		    Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);

	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    tracePtr = Tcl_GetHashValue(tPtr);
	    varPtr->flags &= ~VAR_ALL_TRACES;
	    Tcl_DeleteHashEntry(tPtr);
	    if (dummyVar.flags & VAR_TRACED_UNSET) {
		tPtr = Tcl_CreateHashEntry(&iPtr->varTraces,
			&dummyVar, &isNew);
			(char *) &dummyVar, &isNew);
		Tcl_SetHashValue(tPtr, tracePtr);
	    } else {
		tPtr = NULL;
	    }
	}

	if ((dummyVar.flags & VAR_TRACED_UNSET)
		|| (arrayPtr && (arrayPtr->flags & VAR_TRACED_UNSET))) {
	    Tcl_HashEntry *tPtr = NULL;

	    dummyVar.flags &= ~VAR_TRACE_ACTIVE;
	    TclObjCallVarTraces(iPtr, arrayPtr, &dummyVar, part1Ptr, part2Ptr,
		    (flags & (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY))
			    | TCL_TRACE_UNSETS,
		    /* leaveErrMsg */ 0, index);
		    /* leaveErrMsg */ 0, -1);

	    /*
	     * The traces that we just called may have triggered a change in
	     * the set of traces. If so, reload the traces to manipulate.
	     * the set of traces. [Bug 2629338]
	     */

	    tracePtr = NULL;
	    if (TclIsVarTraced(&dummyVar)) {
		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, &dummyVar);
		if (tPtr) {
		tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) &dummyVar);
		tracePtr = Tcl_GetHashValue(tPtr);
	    }

	    if (tPtr) {
		    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
		    Tcl_DeleteHashEntry(tPtr);
		Tcl_DeleteHashEntry(tPtr);
		}
	    }
	}

	if (tracePtr) {
	    ActiveVarTrace *activePtr;

	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
		prevPtr->nextPtr = NULL;
		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
	    }
	    for (activePtr = iPtr->activeVarTracePtr;  activePtr != NULL;
		    activePtr = activePtr->nextPtr) {
		if (activePtr->varPtr == varPtr) {
		    activePtr->nextTracePtr = NULL;
		}
	    }
2626
2627
2628
2629
2630
2631
2632
2633

2634
2635
2636
2637
2638
2639
2640
2641
2466
2467
2468
2469
2470
2471
2472

2473

2474
2475
2476
2477
2478
2479
2480







-
+
-







	 * be done after calling and deleting the traces on the array, above
	 * (that's the way traces are defined). If the array name is not
	 * present and is required for a trace on some element, it will be
	 * computed at DeleteArray.
	 */

	DeleteArray(iPtr, part1Ptr, (Var *) &dummyVar, (flags
		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS,
		& (TCL_GLOBAL_ONLY|TCL_NAMESPACE_ONLY)) | TCL_TRACE_UNSETS);
		index);
    } else if (TclIsVarLink(&dummyVar)) {
	/*
	 * For global/upvar variables referenced in procedures, decrement the
	 * reference count on the variable referred to, and free the
	 * referenced variable if it's no longer needed.
	 */

2668
2669
2670
2671
2672
2673
2674

2675
2676
2677

2678
2679
2680
2681
2682
2683


2684
2685
2686
2687
2688
2689
2690
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516

2517
2518
2519
2520
2521


2522
2523
2524
2525
2526
2527
2528
2529
2530







+


-
+




-
-
+
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_UnsetObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int i, flags = TCL_LEAVE_ERR_MSG;
    const char *name;
    register int i, flags = TCL_LEAVE_ERR_MSG;
    register char *name;

    if (objc == 1) {
	/*
	 * Do nothing if no arguments supplied, so as to match command
	 * documentation.
	 */

2735
2736
2737
2738
2739
2740
2741

2742
2743
2744

2745
2746
2747
2748
2749
2750

2751
2752
2753
2754
2755

2756
2757
2758
2759
2760
2761
2762
2763
2764



2765
2766
2767
2768
2769
2770
2771
2772
2773
2774

2775
2776
2777
2778

2779
2780
2781
2782
2783
2784
2785
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







+


-
+




-
-
+

-


-
+









+
+
+









-
+



-
+







 *
 * Side effects:
 *	A variable's value may be changed.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_AppendObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varValuePtr = NULL;
    register Tcl_Obj *varValuePtr = NULL;
				/* Initialized to avoid compiler warning. */
    int i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
	return TCL_ERROR;
    }

    if (objc == 2) {
	varValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL,TCL_LEAVE_ERR_MSG);
	if (varValuePtr == NULL) {
	    return TCL_ERROR;
	}
    } else {
	Var *arrayPtr, *varPtr;
	int i;

	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
	for (i=2 ; i<objc ; i++) {
	    /*
	     * Note that we do not need to increase the refCount of the Var
	     * pointers: should a trace delete the variable, the return value
	     * of TclPtrSetVarIdx will be NULL or emptyObjPtr, and we will not
	     * of TclPtrSetVar will be NULL or emptyObjPtr, and we will not
	     * access the variable again.
	     */

	    varValuePtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, objv[1],
	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1],
		    NULL, objv[i], TCL_APPEND_VALUE|TCL_LEAVE_ERR_MSG, -1);
	    if ((varValuePtr == NULL) ||
		    (varValuePtr == ((Interp *) interp)->emptyObjPtr)) {
		return TCL_ERROR;
	    }
	}
    }
2800
2801
2802
2803
2804
2805
2806

2807
2808
2809

2810
2811
2812
2813
2814
2815

2816
2817
2818
2819
2820

2821
2822
2823
2824
2825
2826
2827
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651

2652
2653
2654
2655
2656
2657

2658

2659
2660
2661

2662
2663
2664
2665
2666
2667
2668
2669







+


-
+





-
+
-



-
+







 *
 * Side effects:
 *	A variable's value may be changed.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_LappendObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Obj *varValuePtr, *newValuePtr;
    int numElems, createdNewObj;
    int numElems;
    Var *varPtr, *arrayPtr;
    int result;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value ...?");
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?value value ...?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	newValuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
	if (newValuePtr == NULL) {
	    /*
	     * The variable doesn't exist yet. Just create it with an empty
2837
2838
2839
2840
2841
2842
2843



2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873

2874
2875
2876
2877
2878
2879
2880
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
2709
2710
2711
2712
2713
2714
2715

2716
2717
2718
2719
2720
2721
2722
2723







+
+
+










-
-

-
+















-
+







	} else {
	    result = TclListObjLength(interp, newValuePtr, &numElems);
	    if (result != TCL_OK) {
		return result;
	    }
	}
    } else {
	Var *varPtr, *arrayPtr;
	int createdNewObj = 0;

	/*
	 * We have arguments to append. We used to call Tcl_SetVar2 to append
	 * each argument one at a time to ensure that traces were run for each
	 * append step. We now append the arguments all at once because it's
	 * faster. Note that a read trace and a write trace for the variable
	 * will now each only be called once. Also, if the variable's old
	 * value is unshared we modify it directly, otherwise we create a new
	 * copy to modify: this is "copy on write".
	 */

	createdNewObj = 0;

	/*
	 * Protect the variable pointers around the TclPtrGetVarIdx call
	 * Protect the variable pointers around the TclPtrGetVar call
	 * to insure that they remain valid even if the variable was undefined
	 * and unused.
	 */

	varPtr = TclObjLookupVarEx(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG,
		"set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
	if (TclIsVarInHash(varPtr)) {
	    VarHashRefCount(varPtr)++;
	}
	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	    VarHashRefCount(arrayPtr)++;
	}
	varValuePtr = TclPtrGetVarIdx(interp, varPtr, arrayPtr, objv[1], NULL,
	varValuePtr = TclPtrGetVar(interp, varPtr, arrayPtr, objv[1], NULL,
		TCL_LEAVE_ERR_MSG, -1);
	if (TclIsVarInHash(varPtr)) {
	    VarHashRefCount(varPtr)--;
	}
	if (arrayPtr && TclIsVarInHash(arrayPtr)) {
	    VarHashRefCount(arrayPtr)--;
	}
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
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




3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786

3787
3788
3789
3790


3791
3792
3793
3794

3795
3796
3797
3798


3799
3800
3801
3802
3803
3804
3805




3806
3807
3808
3809
3810
3811
3812
3813
3814
















3815
3816
3817


3818
3819

3820
3821





3822
3823
3824
3825
3826




3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837






3838
3839

3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859




















3860
3861
3862
3863
3864
3865
3866
3867

























3868
3869


3870
3871

3872
3873
3874
3875






3876
3877
3878



3879
3880
3881
3882

3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899


































































3900
3901
3902
3903














3904





3905
3906
3907
3908
3909
3910
3911


































3912
3913
3914
3915
3916
3917

3918
3919
3920



3921
3922
3923
3924
3925
3926


3927
3928
3929
3930
3931
3932


3933
3934

3935
3936
3937
3938
3939




3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961

3962
3963
3964
3965




3966
3967
3968
3969
3970
3971

3972
3973
3974
3975
3976
3977
3978
3979
2750
2751
2752
2753
2754
2755
2756

2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775















































































































































































































































































































































2776




2777
































































2778


































































































































































































































































2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790






2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813













2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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







-
+


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











+
-
-
-
-
-
-
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-

+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

+
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-

-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
+
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

-
-
+
+
+





-
+
+




-
-
+
+
-
-
+
-
-
-
-
-
+
+
+
+



-
-
-
-
-
-
-
-
-
-








-
+
-
-


+
+
+
+





-
+
-








	/*
	 * Now store the list object back into the variable. If there is an
	 * error setting the new value, decrement its ref count if it was new
	 * and we didn't create the variable.
	 */

	newValuePtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr, objv[1], NULL,
	newValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, objv[1], NULL,
		varValuePtr, TCL_LEAVE_ERR_MSG, -1);
	if (newValuePtr == NULL) {
	    return TCL_ERROR;
	}
    }

    /*
     * Set the interpreter's object result to refer to the variable's value
     * object.
     */

    Tcl_SetObjResult(interp, newValuePtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayForObjCmd, ArrayForNRCmd, ArrayForLoopCallback, ArrayObjNext --
 *
 *	These functions implement the "array for" Tcl command.
 *	    array for {k v} a {}
 *	The array for command iterates over the array, setting the the
 *	specified loop variables, and executing the body each iteration.
 *
 *	ArrayForObjCmd() is the standard wrapper around ArrayForNRCmd().
 *
 *	ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr
 *	inside the structure and calls VarHashFirstEntry to start the hash
 *	iteration.
 *
 *	ArrayForNRCmd() does not execute the body or set the loop variables,
 *	it only initializes the iterator.
 *
 *	ArrayForLoopCallback() iterates over the entire array, executing the
 *	body each time.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayObjNext(
    Tcl_Interp *interp,
    Tcl_Obj *arrayNameObj,	/* array */
    Var *varPtr,		/* array */
    ArraySearch *searchPtr,
    Tcl_Obj **keyPtrPtr,	/* Pointer to a variable to have the key
				 * written into, or NULL. */
    Tcl_Obj **valuePtrPtr)	/* Pointer to a variable to have the
				 * value written into, or NULL.*/
{
    Tcl_Obj *keyObj;
    Tcl_Obj *valueObj = NULL;
    int gotValue;
    int donerc;

    donerc = TCL_BREAK;

    if ((varPtr->flags & VAR_SEARCH_ACTIVE) != VAR_SEARCH_ACTIVE) {
	donerc = TCL_ERROR;
	return donerc;
    }

    gotValue = 0;
    while (1) {
	Tcl_HashEntry *hPtr = searchPtr->nextEntry;

	if (hPtr != NULL) {
	    searchPtr->nextEntry = NULL;
	} else {
	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
	    if (hPtr == NULL) {
		gotValue = 0;
		break;
	    }
	}
	varPtr = VarHashGetValue(hPtr);
	if (!TclIsVarUndefined(varPtr)) {
	    gotValue = 1;
	    break;
	}
    }

    if (!gotValue) {
	return donerc;
    }

    donerc = TCL_CONTINUE;

    keyObj = VarHashGetKey(varPtr);
    *keyPtrPtr = keyObj;
    valueObj = Tcl_ObjGetVar2(interp, arrayNameObj, keyObj,
	    TCL_LEAVE_ERR_MSG);
    *valuePtrPtr = valueObj;

    return donerc;
}

static int
ArrayForObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_NRCallObjProc(interp, ArrayForNRCmd, clientData, objc, objv);
}

static int
ArrayForNRCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
    ArraySearch *searchPtr = NULL;
    Var *varPtr;
    int isArray, numVars;

    /*
     * array for {k v} a body
     */

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "{key value} arrayName script");
	return TCL_ERROR;
    }

    /*
     * Parse arguments.
     */

    if (Tcl_ListObjLength(interp, objv[1], &numVars) != TCL_OK) {
	return TCL_ERROR;
    }

    if (numVars != 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"must have two variable names", -1));
	Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
	return TCL_ERROR;
    }

    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, arrayNameObj);
    }

    /*
     * Make a new array search, put it on the stack.
     */

    searchPtr = (ArraySearch *)Tcl_Alloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);

    /*
     * Make sure that these objects (which we need throughout the body of the
     * loop) don't vanish.
     */

    varListObj = TclListObjCopy(NULL, objv[1]);
    scriptObj = objv[3];
    Tcl_IncrRefCount(scriptObj);

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
	    arrayNameObj, scriptObj);
    return TCL_OK;
}

static int
ArrayForLoopCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    Interp *iPtr = (Interp *) interp;
    ArraySearch *searchPtr = (ArraySearch *)data[0];
    Tcl_Obj *varListObj = (Tcl_Obj *)data[1];
    Tcl_Obj *arrayNameObj = (Tcl_Obj *)data[2];
    Tcl_Obj *scriptObj = (Tcl_Obj *)data[3];
    Tcl_Obj **varv;
    Tcl_Obj *keyObj, *valueObj;
    Var *varPtr;
    Var *arrayPtr;
    int done, varc;

    /*
     * Process the result from the previous execution of the script body.
     */

    done = TCL_ERROR;

    if (result == TCL_CONTINUE) {
	result = TCL_OK;
    } else if (result != TCL_OK) {
	if (result == TCL_BREAK) {
	    Tcl_ResetResult(interp);
	    result = TCL_OK;
	} else if (result == TCL_ERROR) {
	    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
		    "\n    (\"array for\" body line %d)",
		    Tcl_GetErrorLine(interp)));
	}
	goto arrayfordone;
    }

    /*
     * Get the next mapping from the array.
     */

    keyObj = NULL;
    valueObj = NULL;
    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
    if (varPtr == NULL) {
	done = TCL_ERROR;
    } else {
	done = ArrayObjNext(interp, arrayNameObj, varPtr, searchPtr, &keyObj,
		&valueObj);
    }

    result = TCL_OK;
    if (done != TCL_CONTINUE) {
	Tcl_ResetResult(interp);
	if (done == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "array changed during iteration", -1));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
	    varPtr->flags |= TCL_LEAVE_ERR_MSG;
	    result = done;
	}
	goto arrayfordone;
    }

    Tcl_ListObjGetElements(NULL, varListObj, &varc, &varv);
    if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
	    TCL_LEAVE_ERR_MSG) == NULL) {
	result = TCL_ERROR;
	goto arrayfordone;
    }
    if (valueObj != NULL) {
	if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,
		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	    goto arrayfordone;
	}
    }

    /*
     * Run the script.
     */

    TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
	    arrayNameObj, scriptObj);
    return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);

    /*
     * For unwinding everything once the iterating is done.
     */

  arrayfordone:
    if (done != TCL_ERROR) {
	/*
	 * If the search was terminated by an array change, the
	 * VAR_SEARCH_ACTIVE flag will no longer be set.
	 */

	ArrayDoneSearch(iPtr, varPtr, searchPtr);
	Tcl_DecrRefCount(searchPtr->name);
	Tcl_Free(searchPtr);
    }

    TclDecrRefCount(varListObj);
    TclDecrRefCount(scriptObj);
    return result;
}

/*
 * ArrayPopulateSearch
 */

static void
ArrayPopulateSearch(
    Tcl_Interp *interp,
    Tcl_Obj *arrayNameObj,
    Var *varPtr,
    ArraySearch *searchPtr)
{
    Interp *iPtr = (Interp *) interp;
    Tcl_HashEntry *hPtr;
    int isNew;

    hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
    if (isNew) {
	searchPtr->id = 1;
	varPtr->flags |= VAR_SEARCH_ACTIVE;
	searchPtr->nextPtr = NULL;
    } else {
	searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
	searchPtr->nextPtr = (ArraySearch *)Tcl_GetHashValue(hPtr);
    }
    searchPtr->varPtr = varPtr;
    searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
	    &searchPtr->search);
    Tcl_SetHashValue(hPtr, searchPtr);
    searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id,
	    TclGetString(arrayNameObj));
    Tcl_IncrRefCount(searchPtr->name);
}
/*
 *----------------------------------------------------------------------
 *
 * ArrayStartSearchCmd --
 *
 *	This object-based function is invoked to process the "array
 *	startsearch" Tcl command. See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayStartSearchCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    int isArray;
    ArraySearch *searchPtr;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

 * Tcl_ArrayObjCmd --
    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
	return TCL_ERROR;
    }

 *
    if (!isArray) {
	return NotArrayError(interp, objv[1]);
    }

    /*
     * Make a new array search with a free name.
     */

    searchPtr = (ArraySearch *)Tcl_Alloc(sizeof(ArraySearch));
    ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
    Tcl_SetObjResult(interp, searchPtr->name);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayDoneSearch --
 *
 *	Removes the search from the hash of active searches.
 *
 *----------------------------------------------------------------------
 */
static void
ArrayDoneSearch(
    Interp *iPtr,
    Var *varPtr,
    ArraySearch *searchPtr)
{
    Tcl_HashEntry *hPtr;
    ArraySearch *prevPtr;

    /*
     * Unhook the search from the list of searches associated with the
     * variable.
     */

    hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
    if (hPtr == NULL) {
	return;
    }
    if (searchPtr == Tcl_GetHashValue(hPtr)) {
	if (searchPtr->nextPtr) {
	    Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
	} else {
	    varPtr->flags &= ~VAR_SEARCH_ACTIVE;
	    Tcl_DeleteHashEntry(hPtr);
	}
    } else {
	for (prevPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); ; prevPtr=prevPtr->nextPtr) {
	    if (prevPtr->nextPtr == searchPtr) {
		prevPtr->nextPtr = searchPtr->nextPtr;
		break;
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayAnyMoreCmd --
 *
 *	This object-based function is invoked to process the "array anymore"
 *	This object-based function is invoked to process the "array" Tcl
 *	Tcl command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayAnyMoreCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    int gotValue, isArray;
    ArraySearch *searchPtr;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Scan forward to find if there are any further elements in the array
     * that are defined.
     */

    while (1) {
	if (searchPtr->nextEntry != NULL) {
	    varPtr = VarHashGetValue(searchPtr->nextEntry);
	    if (!TclIsVarUndefined(varPtr)) {
		gotValue = 1;
		break;
	    }
	}
	searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
	if (searchPtr->nextEntry == NULL) {
	    gotValue = 0;
	    break;
	}
    }
    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[gotValue]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayNextElementCmd --
 *
 *	This object-based function is invoked to process the "array
 *	nextelement" Tcl command. See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayNextElementCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;
    int isArray;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    /*
     * Get the next element from the search, or the empty string on
     * exhaustion. Note that the [array anymore] command may well have already
     * pulled a value from the hash enumeration, so we have to check the cache
     * there first.
     */

    while (1) {
	Tcl_HashEntry *hPtr = searchPtr->nextEntry;

	if (hPtr == NULL) {
	    hPtr = Tcl_NextHashEntry(&searchPtr->search);
	    if (hPtr == NULL) {
		return TCL_OK;
	    }
	} else {
	    searchPtr->nextEntry = NULL;
	}
	varPtr = VarHashGetValue(hPtr);
	if (!TclIsVarUndefined(varPtr)) {
	    Tcl_SetObjResult(interp, VarHashGetKey(varPtr));
	    return TCL_OK;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayDoneSearchCmd --
 *
 *	This object-based function is invoked to process the "array
 *	donesearch" Tcl command. See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayDoneSearchCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    Tcl_Obj *varNameObj, *searchObj;
    ArraySearch *searchPtr;
    int isArray;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName searchId");
	return TCL_ERROR;
    }
    varNameObj = objv[1];
    searchObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    /*
     * Get the search.
     */

    searchPtr = ParseSearchId(interp, varPtr, varNameObj, searchObj);
    if (searchPtr == NULL) {
	return TCL_ERROR;
    }

    ArrayDoneSearch(iPtr, varPtr, searchPtr);
    Tcl_DecrRefCount(searchPtr->name);
    Tcl_Free(searchPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayExistsCmd --
 *
 *	This object-based function is invoked to process the "array exists"
 *	Tcl command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayExistsCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Interp *iPtr = (Interp *)interp;
    int isArray;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, &isArray)) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[isArray]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayGetCmd --
 *
 *	This object-based function is invoked to process the "array get" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
ArrayGetCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
int
Tcl_ArrayObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    /*
     * The list of constants below should match the arrayOptions string array
     * below.
     */

    enum {
	ARRAY_ANYMORE, ARRAY_DONESEARCH, ARRAY_EXISTS, ARRAY_GET,
	ARRAY_NAMES, ARRAY_NEXTELEMENT, ARRAY_SET, ARRAY_SIZE,
	ARRAY_STARTSEARCH, ARRAY_STATISTICS, ARRAY_UNSET
    };
    static const char *arrayOptions[] = {
	"anymore", "donesearch", "exists", "get", "names", "nextelement",
	"set", "size", "startsearch", "statistics", "unset", NULL
    };

    Interp *iPtr = (Interp *) interp;
    Var *varPtr, *varPtr2;
    Tcl_Obj *varNameObj, *nameObj, *valueObj, *nameLstObj, *tmpResObj;
    Tcl_Obj **nameObjPtr, *patternObj;
    Tcl_HashSearch search;
    const char *pattern;
    int i, count, result, isArray;

    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
    case 3:
    Var *varPtr, *arrayPtr;
    Tcl_HashEntry *hPtr;
    Tcl_Obj *varNamePtr;
    int notArray;
    int index, result;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?arg ...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], arrayOptions, "option",
	    0, &index) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Locate the array variable
     */

    varNamePtr = objv[2];
    varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL, /*flags*/ 0,
	    /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);

    /*
     * Special array trace used to keep the env array in sync for array names,
     * array get, etc.
     */

    if (varPtr && (varPtr->flags & VAR_TRACED_ARRAY)
	    && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) {
	if (TclObjCallVarTraces(iPtr, arrayPtr, varPtr, varNamePtr, NULL,
		(TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY|
		TCL_TRACE_ARRAY), /* leaveErrMsg */ 1, -1) == TCL_ERROR) {
	    return TCL_ERROR;
	}
    }

    /*
     * Verify that it is indeed an array variable. This test comes after the
     * traces - the variable may actually become an array as an effect of said
     * traces.
     */

    notArray = 0;
    if ((varPtr == NULL) || !TclIsVarArray(varPtr)
	    || TclIsVarUndefined(varPtr)) {
	notArray = 1;
    }

    switch (index) {
    case ARRAY_ANYMORE: {
	ArraySearch *searchPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
	    return TCL_ERROR;
	}
	if (notArray) {
	    goto error;
	}
	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
	if (searchPtr == NULL) {
	    return TCL_ERROR;
	}
	while (1) {
	    if (searchPtr->nextEntry != NULL) {
		Var *varPtr2 = VarHashGetValue(searchPtr->nextEntry);
		if (!TclIsVarUndefined(varPtr2)) {
		    break;
		}
	    }
	    searchPtr->nextEntry = Tcl_NextHashEntry(&searchPtr->search);
	    if (searchPtr->nextEntry == NULL) {
		Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[0]);
		return TCL_OK;
	    }
	}
	Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[1]);
	break;
    }
    case ARRAY_DONESEARCH: {
	ArraySearch *searchPtr, *prevPtr;

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
	    return TCL_ERROR;
	}
	if (notArray) {
	    goto error;
	}
	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
	if (searchPtr == NULL) {
	    return TCL_ERROR;
	}
	hPtr = Tcl_FindHashEntry(&iPtr->varSearches,(char *) varPtr);
	if (searchPtr == Tcl_GetHashValue(hPtr)) {
	    if (searchPtr->nextPtr) {
		Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
	    } else {
		varPtr->flags &= ~VAR_SEARCH_ACTIVE;
		Tcl_DeleteHashEntry(hPtr);
	    }
	} else {
	    for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
		if (prevPtr->nextPtr == searchPtr) {
		    prevPtr->nextPtr = searchPtr->nextPtr;
		    break;
		}
	    }
	}
	ckfree((char *) searchPtr);
	varNameObj = objv[1];
	patternObj = objv[2];
	break;
    }
    case ARRAY_NEXTELEMENT: {
	ArraySearch *searchPtr;
	Tcl_HashEntry *hPtr;
	Var *varPtr2;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
	return TCL_ERROR;
    }

	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName searchId");
	    return TCL_ERROR;
	}
	if (notArray) {
	    goto error;
	}
	searchPtr = ParseSearchId(interp, varPtr, varNamePtr, objv[3]);
	if (searchPtr == NULL) {
	    return TCL_ERROR;
	}
	while (1) {
	    hPtr = searchPtr->nextEntry;
	    if (hPtr == NULL) {
		hPtr = Tcl_NextHashEntry(&searchPtr->search);
		if (hPtr == NULL) {
		    return TCL_OK;
		}
	    } else {
		searchPtr->nextEntry = NULL;
	    }
	    varPtr2 = VarHashGetValue(hPtr);
	    if (!TclIsVarUndefined(varPtr2)) {
		break;
	    }
	}
	Tcl_SetObjResult(interp, VarHashGetKey(varPtr2));
	break;
    }
    case ARRAY_STARTSEARCH: {
	ArraySearch *searchPtr;
	int isNew;
	char *varName = TclGetString(varNamePtr);

	if (objc != 3) {
    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    /* If not an array, it's an empty result. */
    if (!isArray) {
	return TCL_OK;
    }

	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	if (notArray) {
	    goto error;
	}
	searchPtr = (ArraySearch *) ckalloc(sizeof(ArraySearch));
	hPtr = Tcl_CreateHashEntry(&iPtr->varSearches,
		(char *) varPtr, &isNew);
	if (isNew) {
	    searchPtr->id = 1;
	    Tcl_AppendResult(interp, "s-1-", varName, NULL);
	    varPtr->flags |= VAR_SEARCH_ACTIVE;
	    searchPtr->nextPtr = NULL;
	} else {
	    char string[TCL_INTEGER_SPACE];

	    searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
	    TclFormatInt(string, searchPtr->id);
	    Tcl_AppendResult(interp, "s-", string, "-", varName, NULL);
	    searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
	}
	searchPtr->varPtr = varPtr;
	searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
		&searchPtr->search);
	Tcl_SetHashValue(hPtr, searchPtr);
	break;
    }

    case ARRAY_EXISTS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, iPtr->execEnvPtr->constants[!notArray]);
	break;
    case ARRAY_GET: {
	Tcl_HashSearch search;
	Var *varPtr2;
	char *pattern = NULL;
	char *name;
	Tcl_Obj *namePtr, *valuePtr, *nameLstPtr, *tmpResPtr, **namePtrPtr;
	int i, count;

	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
	    return TCL_ERROR;
	}
	if (notArray) {
	    return TCL_OK;
	}
	if (objc == 4) {
	    pattern = TclGetString(objv[3]);
	}
    pattern = (patternObj ? TclGetString(patternObj) : NULL);

    /*
     * Store the array names in a new object.
     */
	/*
	 * Store the array names in a new object.
	 */

    TclNewObj(nameLstObj);
    Tcl_IncrRefCount(nameLstObj);
    if ((patternObj != NULL) && TclMatchIsTrivial(pattern)) {
	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
	if (varPtr2 == NULL) {
	    goto searchDone;
	}
	if (TclIsVarUndefined(varPtr2)) {
	    goto searchDone;
	}
	result = Tcl_ListObjAppendElement(interp, nameLstObj,
		VarHashGetKey(varPtr2));
	if (result != TCL_OK) {
	    TclDecrRefCount(nameLstObj);
	    return result;
	}
	goto searchDone;
    }
	TclNewObj(nameLstPtr);
	Tcl_IncrRefCount(nameLstPtr);
	if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
	    if (varPtr2 == NULL) {
		goto searchDone;
	    }
	    if (TclIsVarUndefined(varPtr2)) {
		goto searchDone;
	    }
	    result = Tcl_ListObjAppendElement(interp, nameLstPtr,
		    VarHashGetKey(varPtr2));
	    if (result != TCL_OK) {
		TclDecrRefCount(nameLstPtr);
		return result;
	    }
	    goto searchDone;
	}

    for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
	    varPtr2; varPtr2 = VarHashNextVar(&search)) {
	if (TclIsVarUndefined(varPtr2)) {
	    continue;
	}
	nameObj = VarHashGetKey(varPtr2);
	if (patternObj && !Tcl_StringMatch(TclGetString(nameObj), pattern)) {
	    continue;		/* Element name doesn't match pattern. */
	}
	for (varPtr2 = VarHashFirstVar(varPtr->value.tablePtr, &search);
		varPtr2; varPtr2 = VarHashNextVar(&search)) {
	    if (TclIsVarUndefined(varPtr2)) {
		continue;
	    }
	    namePtr = VarHashGetKey(varPtr2);
	    name = TclGetString(namePtr);
	    if ((objc == 4) && !Tcl_StringMatch(name, pattern)) {
		continue;	/* Element name doesn't match pattern. */
	    }

	result = Tcl_ListObjAppendElement(interp, nameLstObj, nameObj);
	if (result != TCL_OK) {
	    TclDecrRefCount(nameLstObj);
	    return result;
	}
    }
	    result = Tcl_ListObjAppendElement(interp, nameLstPtr, namePtr);
	    if (result != TCL_OK) {
		TclDecrRefCount(nameLstPtr);
		return result;
	    }
	}

    searchDone:
    /*
     * Make sure the Var structure of the array is not removed by a trace
     * while we're working.
     */
	/*
	 * Make sure the Var structure of the array is not removed by a trace
	 * while we're working.
	 */

  searchDone:
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)++;
    }
	if (TclIsVarInHash(varPtr)) {
	    VarHashRefCount(varPtr)++;
	}

    /*
     * Get the array values corresponding to each element name.
     */
	/*
	 * Get the array values corresponding to each element name.
	 */

    TclNewObj(tmpResObj);
    result = Tcl_ListObjGetElements(interp, nameLstObj, &count, &nameObjPtr);
    if (result != TCL_OK) {
	goto errorInArrayGet;
    }
	TclNewObj(tmpResPtr);
	result = Tcl_ListObjGetElements(interp, nameLstPtr, &count,
		&namePtrPtr);
	if (result != TCL_OK) {
	    goto errorInArrayGet;
	}

    for (i=0 ; i<count ; i++) {
	nameObj = *nameObjPtr++;
	valueObj = Tcl_ObjGetVar2(interp, varNameObj, nameObj,
		TCL_LEAVE_ERR_MSG);
	if (valueObj == NULL) {
	    /*
	     * Some trace played a trick on us; we need to diagnose to adapt
	     * our behaviour: was the array element unset, or did the
	     * modification modify the complete array?
	     */
	for (i=0 ; i<count ; i++) {
	    namePtr = *namePtrPtr++;
	    valuePtr = Tcl_ObjGetVar2(interp, objv[2], namePtr,
		    TCL_LEAVE_ERR_MSG);
	    if (valuePtr == NULL) {
		/*
		 * Some trace played a trick on us; we need to diagnose to
		 * adapt our behaviour: was the array element unset, or did
		 * the modification modify the complete array?
		 */

	    if (TclIsVarArray(varPtr)) {
		/*
		 * The array itself looks OK, the variable was undefined:
		 * forget it.
		 */
		if (TclIsVarArray(varPtr)) {
		    /*
		     * The array itself looks OK, the variable was undefined:
		     * forget it.
		     */

		continue;
	    }
	    result = TCL_ERROR;
	    goto errorInArrayGet;
	}
	result = Tcl_DictObjPut(interp, tmpResObj, nameObj, valueObj);
	if (result != TCL_OK) {
	    goto errorInArrayGet;
	}
    }
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    Tcl_SetObjResult(interp, tmpResObj);
    TclDecrRefCount(nameLstObj);
    return TCL_OK;
		    continue;
		} else {
		    result = TCL_ERROR;
		    goto errorInArrayGet;
		}
	    }
	    result = Tcl_DictObjPut(interp, tmpResPtr, namePtr, valuePtr);
	    if (result != TCL_OK) {
		goto errorInArrayGet;
	    }
	}
	if (TclIsVarInHash(varPtr)) {
	    VarHashRefCount(varPtr)--;
	}
	Tcl_SetObjResult(interp, tmpResPtr);
	TclDecrRefCount(nameLstPtr);
	break;

  errorInArrayGet:
    if (TclIsVarInHash(varPtr)) {
	VarHashRefCount(varPtr)--;
    }
    TclDecrRefCount(nameLstObj);
    TclDecrRefCount(tmpResObj);	/* Free unneeded temp result. */
    return result;
}

    errorInArrayGet:
	if (TclIsVarInHash(varPtr)) {
	    VarHashRefCount(varPtr)--;
	}
	TclDecrRefCount(nameLstPtr);
	TclDecrRefCount(tmpResPtr);	/* Free unneeded temp result. */
	return result;
    }
    case ARRAY_NAMES: {
/*
 *----------------------------------------------------------------------
 *
 * ArrayNamesCmd --
 *
 *	This object-based function is invoked to process the "array names" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result object.
	Tcl_HashSearch search;
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayNamesCmd(
	Var *varPtr2;
	char *pattern;
	char *name;
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
	Tcl_Obj *namePtr, *resultPtr, *patternPtr;
	int mode, matched = 0;
    Tcl_Obj *const objv[])
{
    static const char *const options[] = {
	"-exact", "-glob", "-regexp", NULL
    };
    enum arrayNamesOptionsEnum { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
	static const char *options[] = {
	    "-exact", "-glob", "-regexp", NULL
	};
	enum options { OPT_EXACT, OPT_GLOB, OPT_REGEXP };
    Var *varPtr, *varPtr2;
    Tcl_Obj *nameObj, *resultObj, *patternObj;
    Tcl_HashSearch search;
    const char *pattern = NULL;
    int isArray, mode = OPT_GLOB;

    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?mode? ?pattern?");
	return TCL_ERROR;
    }
    patternObj = (objc > 2 ? objv[objc-1] : NULL);

	mode = OPT_GLOB;
    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
	return TCL_ERROR;
    }


	if ((objc < 3) || (objc > 5)) {
    /*
     * Finish parsing the arguments.
     */

	    Tcl_WrongNumArgs(interp, 2,objv, "arrayName ?mode? ?pattern?");
    if ((objc == 4) && Tcl_GetIndexFromObj(interp, objv[2], options, "option",
	    0, &mode) != TCL_OK) {
	return TCL_ERROR;
    }
	    return TCL_ERROR;
	}

    /* If not an array, the result is empty. */

    if (!isArray) {
	return TCL_OK;
    }

	if (notArray) {
	    return TCL_OK;
	}
	if (objc == 4) {
    /*
     * Check for the trivial cases where we can use a direct lookup.
     */

    TclNewObj(resultObj);
    if (patternObj) {
	pattern = TclGetString(patternObj);
    }
    if ((mode==OPT_GLOB && patternObj && TclMatchIsTrivial(pattern))
	    patternPtr = objv[3];
	    pattern = TclGetString(patternPtr);
	} else if (objc == 5) {
	    patternPtr = objv[4];
	    pattern = TclGetString(patternPtr);
	    if (Tcl_GetIndexFromObj(interp, objv[3], options, "option", 0,
		    &mode) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    patternPtr = NULL;
	    pattern = NULL;
	}
	TclNewObj(resultPtr);
	if (((enum options) mode)==OPT_GLOB && pattern!=NULL &&
		TclMatchIsTrivial(pattern)) {
	    || (mode==OPT_EXACT)) {
	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
	if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
	    varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternPtr);
	    if ((varPtr2 != NULL) && !TclIsVarUndefined(varPtr2)) {
	    /*
	     * This can't fail; lappending to an empty object always works.
		result = Tcl_ListObjAppendElement(interp, resultPtr,
	     */

			VarHashGetKey(varPtr2));
		if (result != TCL_OK) {
		    TclDecrRefCount(resultPtr);
		    return result;
		}
	    Tcl_ListObjAppendElement(NULL, resultObj, VarHashGetKey(varPtr2));
	}
	Tcl_SetObjResult(interp, resultObj);
	return TCL_OK;
    }
	    }
	    Tcl_SetObjResult(interp, resultPtr);
	    return TCL_OK;
	}

    /*
     * Must scan the array to select the elements.
     */

    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
	    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
	if (TclIsVarUndefined(varPtr2)) {
	    continue;
	}
	nameObj = VarHashGetKey(varPtr2);
	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
	    if (TclIsVarUndefined(varPtr2)) {
		continue;
	    }
	    namePtr = VarHashGetKey(varPtr2);
	if (patternObj) {
	    const char *name = TclGetString(nameObj);
	    name = TclGetString(namePtr);
	    int matched = 0;

	    switch ((enum arrayNamesOptionsEnum) mode) {
	    case OPT_EXACT:
		Tcl_Panic("exact matching shouldn't get here");
	    case OPT_GLOB:
		matched = Tcl_StringMatch(name, pattern);
		break;
	    case OPT_REGEXP:
		matched = Tcl_RegExpMatchObj(interp, nameObj, patternObj);
		if (matched < 0) {
		    TclDecrRefCount(resultObj);
		    return TCL_ERROR;
		}
		break;
	    }
	    if (matched == 0) {
		continue;
	    }
	}
	    if (objc > 3) {
		switch ((enum options) mode) {
		case OPT_EXACT:
		    matched = (strcmp(name, pattern) == 0);
		    break;
		case OPT_GLOB:
		    matched = Tcl_StringMatch(name, pattern);
		    break;
		case OPT_REGEXP:
		    matched = Tcl_RegExpMatch(interp, name, pattern);
		    if (matched < 0) {
			TclDecrRefCount(resultPtr);
			return TCL_ERROR;
		    }
		    break;
		}
		if (matched == 0) {
		    continue;
		}
	    }

	Tcl_ListObjAppendElement(NULL, resultObj, nameObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
	    result = Tcl_ListObjAppendElement(interp, resultPtr, namePtr);
	    if (result != TCL_OK) {
		TclDecrRefCount(namePtr);	/* Free unneeded name obj. */
		return result;
	    }
	}
	Tcl_SetObjResult(interp, resultPtr);
	break;
    }
    case ARRAY_SET:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName list");
	    return TCL_ERROR;
	}
	return TclArraySet(interp, objv[2], objv[3]);
    case ARRAY_UNSET:
	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName ?pattern?");
	    return TCL_ERROR;
	}
	if (notArray) {
	    return TCL_OK;
	}
	if (objc == 3) {
	    /*
 *----------------------------------------------------------------------
 *
	     * When no pattern is given, just unset the whole array.
	     */
 * TclFindArrayPtrElements --
 *

 *	Fill out a hash table (which *must* use Tcl_Obj* keys) with an entry
 *	for each existing element of the given array. The provided hash table
 *	is assumed to be initially empty.
 *
	    return TclObjUnsetVar2(interp, varNamePtr, NULL, 0);
	} else {
	    Tcl_HashSearch search;
	    Var *varPtr2, *protectedVarPtr;
	    const char *pattern = TclGetString(objv[3]);

 * Result:
 *	none
 *
	    /*
	     * With a trivial pattern, we can just unset.
	     */
 * Side effects:
 *	The keys of the array gain an extra reference. The supplied hash table
 *	has elements added to it.
 *

 *----------------------------------------------------------------------
 */

void
TclFindArrayPtrElements(
    Var *arrayPtr,
    Tcl_HashTable *tablePtr)
{
    Var *varPtr;
    Tcl_HashSearch search;

    if ((arrayPtr == NULL) || !TclIsVarArray(arrayPtr)
	    || TclIsVarUndefined(arrayPtr)) {
	return;
    }

    for (varPtr=VarHashFirstVar(arrayPtr->value.tablePtr, &search);
	    if (TclMatchIsTrivial(pattern)) {
		varPtr2 = VarHashFindVar(varPtr->value.tablePtr, objv[3]);
		if (varPtr2 != NULL && !TclIsVarUndefined(varPtr2)) {
		    return TclObjUnsetVar2(interp, varNamePtr, objv[3], 0);
		}
		return TCL_OK;
	    }

	    /*
	     * Non-trivial case (well, deeply tricky really). We peek inside
	     * the hash iterator in order to allow us to guarantee that the
	     * following element in the array will not be scrubbed until we
	     * have dealt with it. This stops the overall iterator from ending
	     * up pointing into deallocated memory. [Bug 2939073]
	     */

	    protectedVarPtr = NULL;
	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
		/*
		 * Drop the extra ref immediately. We don't need to free it at
		 * this point though; we'll be unsetting it if necessary soon.
		 */

		if (varPtr2 == protectedVarPtr) {
		    VarHashRefCount(varPtr2)--;
		}

		/*
		 * Guard the next item in the search chain by incrementing its
		 * refcount. This guarantees that the hash table iterator
		 * won't be dangling on the next time through the loop.
		 */

		if (search.nextEntryPtr != NULL) {
		    protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
		    VarHashRefCount(protectedVarPtr)++;
		} else {
		    protectedVarPtr = NULL;
		}

		if (!TclIsVarUndefined(varPtr2)) {
		    Tcl_Obj *namePtr = VarHashGetKey(varPtr2);

		    if (Tcl_StringMatch(TclGetString(namePtr), pattern)
			    && TclObjUnsetVar2(interp, varNamePtr, namePtr,
				    0) != TCL_OK) {
			/*
			 * If we incremented a refcount, we must decrement it
			 * here as we will not be coming back properly due to
			 * the error.
			 */

			if (protectedVarPtr) {
			    VarHashRefCount(protectedVarPtr)--;
			    CleanupVar(protectedVarPtr, varPtr);
			}
			return TCL_ERROR;
		    }
		} else {
		    CleanupVar(varPtr2, varPtr);
		}
	    }
	    break;
	}

	    varPtr!=NULL ; varPtr=VarHashNextVar(&search)) {
	Tcl_HashEntry *hPtr;
	Tcl_Obj *nameObj;
	int dummy;
    case ARRAY_SIZE: {
	Tcl_HashSearch search;
	int size;

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
	size = 0;

	/*
	 * Must iterate in order to get chance to check for present but
	 * "undefined" entries.
	 */

	if (!notArray) {
	    Var *varPtr2;

	    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
	if (TclIsVarUndefined(varPtr)) {
	    continue;
	}
	nameObj = VarHashGetKey(varPtr);
	hPtr = Tcl_CreateHashEntry(tablePtr, (char *) nameObj, &dummy);
	Tcl_SetHashValue(hPtr, nameObj);
    }
		if (TclIsVarUndefined(varPtr2)) {
		    continue;
		}
		size++;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewIntObj(size));
	break;
    }

    case ARRAY_STATISTICS: {
	const char *stats;

	if (notArray) {
	    goto error;
	}

	stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
	if (stats != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
	    ckfree((void *)stats);
	} else {
	    Tcl_SetResult(interp,"error reading array statistics",TCL_STATIC);
	    return TCL_ERROR;
	}
	break;
    }
    }
    return TCL_OK;

  error:
    Tcl_AppendResult(interp, "\"", TclGetString(varNamePtr),
	    "\" isn't an array", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ArraySetCmd --
 * TclArraySet --
 *
 *	This object-based function is invoked to process the "array set" Tcl
 *	command. See the user documentation for details on what it does.
 *	Set the elements of an array. If there are no elements to set, create
 *	an empty array. This routine is used by the Tcl_ArrayObjCmd and by the
 *	TclSetupEnv routine.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *	A variable will be created if one does not already exist.
 *	Callers must Incr arrayNameObj if they pland to Decr it.
 *
 *----------------------------------------------------------------------
 */

static int
ArraySetCmd(
int
TclArraySet(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_Obj *arrayNameObj;
    Tcl_Obj *arrayElemObj;
    Tcl_Obj *arrayNameObj,	/* The array name. */
    Tcl_Obj *arrayElemObj)	/* The array elements list or dict. If this is
				 * NULL, create an empty array. */
{
    Var *varPtr, *arrayPtr;
    int result, i;

    if (objc != 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName list");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], NULL, NULL)) {
	return TCL_ERROR;
    }

    arrayNameObj = objv[1];
    varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
	    /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "set", /*createPart1*/ 1,
	    /*createPart2*/ 1, &arrayPtr);
    if (varPtr == NULL) {
	return TCL_ERROR;
    }
    if (arrayPtr) {
	CleanupVar(varPtr, arrayPtr);
	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", NEEDARRAY, -1);
	TclObjVarErrMsg(interp, arrayNameObj, NULL, "set", needArray, -1);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		TclGetString(arrayNameObj), NULL);
	return TCL_ERROR;
    }

    if (arrayElemObj == NULL) {
	goto ensureArray;
    }

    /*
     * Install the contents of the dictionary or list into the array.
     */

    arrayElemObj = objv[2];
    if (arrayElemObj->typePtr == &tclDictType && arrayElemObj->bytes == NULL) {
    if (TclHasIntRep(arrayElemObj, &tclDictType) && arrayElemObj->bytes == NULL) {
	Tcl_Obj *keyPtr, *valuePtr;
	Tcl_DictSearch search;
	int done;

	if (Tcl_DictObjSize(interp, arrayElemObj, &done) != TCL_OK) {
	    return TCL_ERROR;
	}
3999
4000
4001
4002
4003
4004
4005
4006

4007
4008
4009
4010
4011
4012
4013
3441
3442
3443
3444
3445
3446
3447

3448
3449
3450
3451
3452
3453
3454
3455







-
+







	     * by the array. This isn't the case though.
	     */

	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    keyPtr, TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
		    keyPtr, valuePtr, TCL_LEAVE_ERR_MSG, -1) == NULL)) {
		Tcl_DictObjDone(&search);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    } else {
4023
4024
4025
4026
4027
4028
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
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







-








-
-
+
+








-
+
-
-
+







		&elemLen, &elemPtrs);
	if (result != TCL_OK) {
	    return result;
	}
	if (elemLen & 1) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "list must have an even number of elements", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "FORMAT", NULL);
	    return TCL_ERROR;
	}
	if (elemLen == 0) {
	    goto ensureArray;
	}

	/*
	 * We needn't worry about traces invalidating arrayPtr: should that be
	 * the case, TclPtrSetVarIdx will return NULL so that we break out of
	 * the loop and return an error.
	 * the case, TclPtrSetVar will return NULL so that we break out of the
	 * loop and return an error.
	 */

	copyListObj = TclListObjCopy(NULL, arrayElemObj);
	for (i=0 ; i<elemLen ; i+=2) {
	    Var *elemVarPtr = TclLookupArrayElement(interp, arrayNameObj,
		    elemPtrs[i], TCL_LEAVE_ERR_MSG, "set", 1, 1, varPtr, -1);

	    if ((elemVarPtr == NULL) ||
		    (TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
		    (TclPtrSetVar(interp, elemVarPtr, varPtr, arrayNameObj,
			    elemPtrs[i], elemPtrs[i+1], TCL_LEAVE_ERR_MSG,
			    -1) == NULL)) {
		    elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
		result = TCL_ERROR;
		break;
	    }
	}
	Tcl_DecrRefCount(copyListObj);
	return result;
    }
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389

4390
4391
4392
4393
4394
4395
4396
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







-
+
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
+







	}
	if (TclIsVarArrayElement(varPtr) || !TclIsVarUndefined(varPtr)) {
	    /*
	     * Either an array element, or a scalar: lose!
	     */

	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array set",
		    NEEDARRAY, -1);
		    needArray, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}
    }
    TclInitArrayVar(varPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArraySizeCmd --
 *
 *	This object-based function is invoked to process the "array size" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArraySizeCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_HashSearch search;
    Var *varPtr2;
    int isArray, size = 0;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, objv[1], &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    /* We can only iterate over the array if it exists... */

    if (isArray) {
	/*
	 * Must iterate in order to get chance to check for present but
	 * "undefined" entries.
	 */

	for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
		varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
	    if (!TclIsVarUndefined(varPtr2)) {
		size++;
	    }
	}
    }

    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(size));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayStatsCmd --
 *
 *	This object-based function is invoked to process the "array
 *	statistics" Tcl command. See the user documentation for details on
 *	what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayStatsCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr;
    Tcl_Obj *varNameObj;
    char *stats;
    int isArray;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
	return TCL_ERROR;
    }
    varNameObj = objv[1];

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return NotArrayError(interp, varNameObj);
    }

    stats = Tcl_HashStats((Tcl_HashTable *) varPtr->value.tablePtr);
    if (stats == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"error reading array statistics", -1));
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(stats, -1));
    Tcl_Free(stats);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayUnsetCmd --
 *
 *	This object-based function is invoked to process the "array unset" Tcl
 *	command. See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result object.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
ArrayUnsetCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Var *varPtr, *varPtr2, *protectedVarPtr;
    Tcl_Obj *varNameObj, *patternObj, *nameObj;
    Tcl_HashSearch search;
    const char *pattern;
    const int unsetFlags = 0;	/* Should this be TCL_LEAVE_ERR_MSG? */
    int isArray;

    TclSetVarArray(varPtr);
    switch (objc) {
    case 2:
	varNameObj = objv[1];
	patternObj = NULL;
	break;
    case 3:
	varNameObj = objv[1];
	patternObj = objv[2];
	break;
    default:
	Tcl_WrongNumArgs(interp, 1, objv, "arrayName ?pattern?");
	return TCL_ERROR;
    }

    if (TCL_ERROR == LocateArray(interp, varNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

    if (!isArray) {
	return TCL_OK;
    }

    if (!patternObj) {
	/*
	 * When no pattern is given, just unset the whole array.
	 */

	return TclObjUnsetVar2(interp, varNameObj, NULL, 0);
    }

    /*
     * With a trivial pattern, we can just unset.
     */

    pattern = TclGetString(patternObj);
    if (TclMatchIsTrivial(pattern)) {
	varPtr2 = VarHashFindVar(varPtr->value.tablePtr, patternObj);
    varPtr->value.tablePtr = (TclVarHashTable *)
	if (!varPtr2 || TclIsVarUndefined(varPtr2)) {
	    return TCL_OK;
	}
	return TclPtrUnsetVarIdx(interp, varPtr2, varPtr, varNameObj,
		patternObj, unsetFlags, -1);
    }

	    ckalloc(sizeof(TclVarHashTable));
    /*
     * Non-trivial case (well, deeply tricky really). We peek inside the hash
     * iterator in order to allow us to guarantee that the following element
     * in the array will not be scrubbed until we have dealt with it. This
     * stops the overall iterator from ending up pointing into deallocated
     * memory. [Bug 2939073]
     */

    protectedVarPtr = NULL;
    for (varPtr2=VarHashFirstVar(varPtr->value.tablePtr, &search);
    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
	    varPtr2!=NULL ; varPtr2=VarHashNextVar(&search)) {
	/*
	 * Drop the extra ref immediately. We don't need to free it at this
	 * point though; we'll be unsetting it if necessary soon.
	 */

	if (varPtr2 == protectedVarPtr) {
	    VarHashRefCount(varPtr2)--;
	}

	/*
	 * Guard the next (peeked) item in the search chain by incrementing
	 * its refcount. This guarantees that the hash table iterator won't be
	 * dangling on the next time through the loop.
	 */

	if (search.nextEntryPtr != NULL) {
	    protectedVarPtr = VarHashGetValue(search.nextEntryPtr);
	    VarHashRefCount(protectedVarPtr)++;
	} else {
	    protectedVarPtr = NULL;
	}

	/*
	 * If the variable is undefined, clean it out as it has been hit by
	 * something else (i.e., an unset trace).
	 */

	if (TclIsVarUndefined(varPtr2)) {
	    CleanupVar(varPtr2, varPtr);
	    continue;
	}

	nameObj = VarHashGetKey(varPtr2);
	if (Tcl_StringMatch(TclGetString(nameObj), pattern)
		&& TclPtrUnsetVarIdx(interp, varPtr2, varPtr, varNameObj,
			nameObj, unsetFlags, -1) != TCL_OK) {
	    /*
	     * If we incremented a refcount, we must decrement it here as we
	     * will not be coming back properly due to the error.
	     */

	    if (protectedVarPtr) {
		VarHashRefCount(protectedVarPtr)--;
		CleanupVar(protectedVarPtr, varPtr);
	    }
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitArrayCmd --
 *
 *	This creates the ensemble for the "array" command.
 *
 * Results:
 *	The handle for the created ensemble.
 *
 * Side effects:
 *	Creates a command in the global namespace.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitArrayCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap arrayImplMap[] = {
	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
	{"size",	ArraySizeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"unset",	ArrayUnsetCmd,		TclCompileArrayUnsetCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "array", arrayImplMap);
}

/*
 *----------------------------------------------------------------------
 *
 * ObjMakeUpvar --
 *
 *	This function does all of the work of the "global" and "upvar"
 *	commands.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs then an error
 *	message is left in interp.
 *	message is left in iPtr->result.
 *
 * Side effects:
 *	The variable given by myName is linked to the variable in framePtr
 *	given by otherP1 and otherP2, so that references to myName are
 *	redirected to the other variable like a symbolic link.
 *	Callers must Incr myNamePtr if they plan to Decr it.
 *	Callers must Incr otherP1Ptr if they plan to Decr it.
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463



4464
4465
4466
4467
4468
4469
4470

4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483

4484
4485
4486
4487
4488
4489
4490
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







-
-
-
+
+
+
-
-




-
+












-
+







	if (!(arrayPtr != NULL
		     ? (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr))
		     : (TclIsVarInHash(otherPtr) && TclGetVarNsPtr(otherPtr)))
		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
			|| (varFramePtr == NULL)
			|| !HasLocalVars(varFramePtr)
			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		    "bad variable name \"%s\": can't create namespace "
		    "variable that refers to procedure variable",
	    Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
		    TclGetString(myNamePtr), "\": can't create namespace "
		    "variable that refers to procedure variable", NULL);
		    TclGetString(myNamePtr)));
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
	    return TCL_ERROR;
	}
    }

    return TclPtrObjMakeUpvarIdx(interp, otherPtr, myNamePtr, myFlags, index);
    return TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPtrMakeUpvar --
 *
 *	This procedure does all of the work of the "global" and "upvar"
 *	commands.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs then an error
 *	message is left in interp.
 *	message is left in iPtr->result.
 *
 * Side effects:
 *	The variable given by myName is linked to the variable in framePtr
 *	given by otherP1 and otherP2, so that references to myName are
 *	redirected to the other variable like a symbolic link.
 *
 *----------------------------------------------------------------------
4505
4506
4507
4508
4509
4510
4511
4512

4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537

4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550

4551
4552
4553
4554
4555
4556
4557
4558
4559
4560

4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579



4580
4581
4582
4583
4584
4585
4586
4587
4588
4589


4590
4591
4592
4593
4594
4595
4596

4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607


4608
4609
4610
4611
4612
4613
4614


4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627

4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642














4643
4644
4645
4646
4647
4648
4649
4650
4651





































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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830


3831
3832

3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845

3846
3847

3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859

3860
3861
3862
3863
3864
3865
3866
3867







-
+
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+












-
+










+
















-
-
-
+
+
+
-
-






-
-
+
+






-
+


-
-





-
-
+
+
-




-
-
+
+
-


-
-







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+















-
-
+
+
-













-
+

-
+











-
+







    Tcl_Obj *myNamePtr = NULL;
    int result;

    if (myName) {
	myNamePtr = Tcl_NewStringObj(myName, -1);
	Tcl_IncrRefCount(myNamePtr);
    }
    result = TclPtrObjMakeUpvarIdx(interp, otherPtr, myNamePtr, myFlags,
    result = TclPtrObjMakeUpvar(interp, otherPtr, myNamePtr, myFlags, index);
	    index);
    if (myNamePtr) {
	Tcl_DecrRefCount(myNamePtr);
    }
    return result;
}

int
TclPtrObjMakeUpvar(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    Tcl_Var otherPtr,		/* Pointer to the variable being linked-to. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags)		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
{
    return TclPtrObjMakeUpvarIdx(interp, (Var *) otherPtr, myNamePtr, myFlags,
	    -1);
}

/* Callers must Incr myNamePtr if they plan to Decr it. */

int
TclPtrObjMakeUpvarIdx(
TclPtrObjMakeUpvar(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages, too. */
    Var *otherPtr,		/* Pointer to the variable being linked-to. */
    Tcl_Obj *myNamePtr,		/* Name of variable which will refer to
				 * otherP1/otherP2. Must be a scalar. */
    int myFlags,		/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of myName. */
    int index)			/* If the variable to be linked is an indexed
				 * scalar, this is its index. Otherwise, -1 */
{
    Interp *iPtr = (Interp *) interp;
    CallFrame *varFramePtr = iPtr->varFramePtr;
    const char *errMsg, *p, *myName;
    const char *errMsg, *myName;
    Var *varPtr;

    if (index >= 0) {
	if (!HasLocalVars(varFramePtr)) {
	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
	}
	varPtr = (Var *) &(varFramePtr->compiledLocals[index]);
	myNamePtr = localName(iPtr->varFramePtr, index);
	myName = myNamePtr? TclGetString(myNamePtr) : NULL;
    } else {
	const char *p;
	/*
	 * Do not permit the new variable to look like an array reference, as
	 * it will not be reachable in that case [Bug 600812, TIP 184]. The
	 * "definition" of what "looks like an array reference" is consistent
	 * (and must remain consistent) with the code in TclObjLookupVar().
	 */

	myName = TclGetString(myNamePtr);
	p = strstr(myName, "(");
	if (p != NULL) {
	    p += strlen(p)-1;
	    if (*p == ')') {
		/*
		 * myName looks like an array reference.
		 */

		Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
			"bad variable name \"%s\": can't create a scalar "
			"variable that looks like an array element", myName));
		Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"",
			myName, "\": can't create a scalar variable that "
			"looks like an array element", NULL);
		Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
			NULL);
		return TCL_ERROR;
	    }
	}

	/*
	 * Lookup and eventually create the new variable. Set the flag bit
	 * TCL_AVOID_RESOLVERS to indicate the special resolution rules for
	 * upvar purposes:
	 * AVOID_RESOLVERS to indicate the special resolution rules for upvar
	 * purposes:
	 *   - Bug #696893 - variable is either proc-local or in the current
	 *     namespace; never follow the second (global) resolution path.
	 *   - Bug #631741 - do not use special namespace or interp resolvers.
	 */

	varPtr = TclLookupSimpleVar(interp, myNamePtr,
		myFlags|TCL_AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
		myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
	if (varPtr == NULL) {
	    TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(myNamePtr), NULL);
	    return TCL_ERROR;
	}
    }

    if (varPtr == otherPtr) {
	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_NewStringObj(
		"can't upvar from variable to itself", -1));
	Tcl_SetResult((Tcl_Interp *) iPtr,
		"can't upvar from variable to itself", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "SELF", NULL);
	return TCL_ERROR;
    }

    if (TclIsVarTraced(varPtr)) {
	Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		"variable \"%s\" has traces: can't use for upvar", myName));
	Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
		"\" has traces: can't use for upvar", NULL);
	Tcl_SetErrorCode(interp, "TCL", "UPVAR", "TRACED", NULL);
	return TCL_ERROR;
    } else if (!TclIsVarUndefined(varPtr)) {
	Var *linkPtr;

	/*
	 * The variable already existed. Make sure this variable "varPtr"
	 * isn't the same as "otherPtr" (avoid circular links). Also, if it's
	 * not an upvar then it's an error. If it is an upvar, then just
	 * disconnect it from the thing it currently refers to.
	 */

	if (!TclIsVarLink(varPtr)) {
	if (TclIsVarLink(varPtr)) {
	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
		    "variable \"%s\" already exists", myName));
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "EXISTS", NULL);
	    return TCL_ERROR;
	}

	linkPtr = varPtr->value.linkPtr;
	if (linkPtr == otherPtr) {
	    return TCL_OK;
	}
	if (TclIsVarInHash(linkPtr)) {
	    VarHashRefCount(linkPtr)--;
	    if (TclIsVarUndefined(linkPtr)) {
		CleanupVar(linkPtr, NULL);
	    }
	    Var *linkPtr = varPtr->value.linkPtr;
	    if (linkPtr == otherPtr) {
		return TCL_OK;
	    }
	    if (TclIsVarInHash(linkPtr)) {
		VarHashRefCount(linkPtr)--;
		if (TclIsVarUndefined(linkPtr)) {
		    CleanupVar(linkPtr, NULL);
		}
	    }
	} else {
	    Tcl_AppendResult((Tcl_Interp *) iPtr, "variable \"", myName,
		    "\" already exists", NULL);
	    return TCL_ERROR;
	}
    }
    TclSetVarLink(varPtr);
    varPtr->value.linkPtr = otherPtr;
    if (TclIsVarInHash(otherPtr)) {
	VarHashRefCount(otherPtr)++;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpVar --
 *
 *	This function links one variable to another, just like the "upvar"
 *	command.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs then an error
 *	message is left in the interp's result.
 *
 * Side effects:
 *	The variable in frameName whose name is given by varName becomes
 *	accessible under the name localName, so that references to localName
 *	are redirected to the other variable like a symbolic link.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_UpVar
int
Tcl_UpVar(
    Tcl_Interp *interp,		/* Command interpreter in which varName is to
				 * be looked up. */
    const char *frameName,	/* Name of the frame containing the source
				 * variable, such as "1" or "#0". */
    const char *varName,	/* Name of a variable in interp to link to.
				 * May be either a scalar name or an element
				 * in an array. */
    const char *localName,	/* Name of link variable. */
    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of localName. */
{
    return Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UpVar2 --
 *
 *	This function links one variable to another, just like the "upvar"
 *	command.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs then an error
 *	message is left in the interp's result.
 *
 * Side effects:
 *	The variable in frameName whose name is given by part1 and part2
 *	becomes accessible under the name localNameStr, so that references to
 *	localNameStr are redirected to the other variable like a symbolic
 *	becomes accessible under the name localName, so that references to
 *	localName are redirected to the other variable like a symbolic link.
 *	link.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_UpVar2(
    Tcl_Interp *interp,		/* Interpreter containing variables. Used for
				 * error messages too. */
    const char *frameName,	/* Name of the frame containing the source
				 * variable, such as "1" or "#0". */
    const char *part1,
    const char *part2,		/* Two parts of source variable name to link
				 * to. */
    const char *localNameStr,	/* Name of link variable. */
    const char *localName,	/* Name of link variable. */
    int flags)			/* 0, TCL_GLOBAL_ONLY or TCL_NAMESPACE_ONLY:
				 * indicates scope of localNameStr. */
				 * indicates scope of localName. */
{
    int result;
    CallFrame *framePtr;
    Tcl_Obj *part1Ptr, *localNamePtr;

    if (TclGetFrame(interp, frameName, &framePtr) == -1) {
	return TCL_ERROR;
    }

    part1Ptr = Tcl_NewStringObj(part1, -1);
    Tcl_IncrRefCount(part1Ptr);
    localNamePtr = Tcl_NewStringObj(localNameStr, -1);
    localNamePtr = Tcl_NewStringObj(localName, -1);
    Tcl_IncrRefCount(localNamePtr);

    result = ObjMakeUpvar(interp, framePtr, part1Ptr, part2, 0,
	    localNamePtr, flags, -1);
    Tcl_DecrRefCount(part1Ptr);
    Tcl_DecrRefCount(localNamePtr);
    return result;
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
3891
3892
3893
3894
3895
3896
3897

3898


3899




3900
3901
3902
3903
3904
3905
3906
3907
3908
3909














3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925



3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937







-
+
-
-

-
-
-
-





+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
+
+
+
+
+







    Tcl_Interp *interp,		/* Interpreter containing the variable. */
    Tcl_Var variable,		/* Token for the variable returned by a
				 * previous call to Tcl_FindNamespaceVar. */
    Tcl_Obj *objPtr)		/* Points to the object onto which the
				 * variable's full name is appended. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr = (Var *) variable;
    register Var *varPtr = (Var *) variable;
    Tcl_Obj *namePtr;
    Namespace *nsPtr;

    if (!varPtr || TclIsVarArrayElement(varPtr)) {
	return;
    }

    /*
     * Add the full name of the containing namespace (if any), followed by the
     * "::" separator, then the variable name.
     */

    if (varPtr) {
	if (!TclIsVarArrayElement(varPtr)) {
	    Tcl_Obj *namePtr;
	    Namespace *nsPtr;

    nsPtr = TclGetVarNsPtr(varPtr);
    if (nsPtr) {
	Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
	if (nsPtr != iPtr->globalNsPtr) {
	    Tcl_AppendToObj(objPtr, "::", 2);
	}
    }
    if (TclIsVarInHash(varPtr)) {
	if (!TclIsVarDeadHash(varPtr)) {
	    namePtr = VarHashGetKey(varPtr);
	    Tcl_AppendObjToObj(objPtr, namePtr);
	}
    } else if (iPtr->varFramePtr->procPtr) {
	int index = varPtr - iPtr->varFramePtr->compiledLocals;
	    nsPtr = TclGetVarNsPtr(varPtr);
	    if (nsPtr) {
		Tcl_AppendToObj(objPtr, nsPtr->fullName, -1);
		if (nsPtr != iPtr->globalNsPtr) {
		    Tcl_AppendToObj(objPtr, "::", 2);
		}
	    }
	    if (TclIsVarInHash(varPtr)) {
		if (!TclIsVarDeadHash(varPtr)) {
		    namePtr = VarHashGetKey(varPtr);
		    Tcl_AppendObjToObj(objPtr, namePtr);
		}
	    } else if (iPtr->varFramePtr->procPtr) {
		int index = varPtr - iPtr->varFramePtr->compiledLocals;

		if (index >= 0
	if (index >= 0 && index < iPtr->varFramePtr->numCompiledLocals) {
	    namePtr = localName(iPtr->varFramePtr, index);
	    Tcl_AppendObjToObj(objPtr, namePtr);
			&& index < iPtr->varFramePtr->numCompiledLocals) {
		    namePtr = localName(iPtr->varFramePtr, index);
		    Tcl_AppendObjToObj(objPtr, namePtr);
		}
	    }
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
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
3947
3948
3949
3950
3951
3952
3953

3954
3955
3956
3957
3958
3959




3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987







-
+





-
-
-
-
+
+
+
+
+
+
+
+
+










+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GlobalObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *objPtr, *tailPtr;
    const char *varName;
    const char *tail;
    int result, i;
    register Tcl_Obj *objPtr, *tailPtr;
    char *varName;
    register char *tail;
    int i;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName ?varName ...?");
	return TCL_ERROR;
    }

    /*
     * If we are not executing inside a Tcl procedure, just return.
     */

    if (!HasLocalVars(iPtr->varFramePtr)) {
	return TCL_OK;
    }

    for (i=1 ; i<objc ; i++) {
	int result;

	/*
	 * Make a local variable linked to its counterpart in the global ::
	 * namespace.
	 */

	objPtr = objv[i];
	varName = TclGetString(objPtr);
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
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







-
+





-
+
-




+
+
+
+
+

+
+


















-
+
-







 *	result in the interpreter's result object.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_VariableObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    const char *varName, *tail, *cp;
    char *varName, *tail, *cp;
    Var *varPtr, *arrayPtr;
    Tcl_Obj *varValuePtr;
    int i, result;
    Tcl_Obj *varNamePtr, *tailPtr;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name value...? name ?value?");
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i+=2) {
	Var *varPtr, *arrayPtr;

	/*
	 * Look up each variable in the current namespace context, creating it
	 * if necessary.
	 */

	varNamePtr = objv[i];
	varName = TclGetString(varNamePtr);
	varPtr = TclObjLookupVarEx(interp, varNamePtr, NULL,
		(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "define",
		/*createPart1*/ 1, /*createPart2*/ 0, &arrayPtr);

	if (arrayPtr != NULL) {
	    /*
	     * Variable cannot be an element in an array. If arrayPtr is
	     * non-NULL, it is, so throw up an error and return.
	     */

	    TclObjVarErrMsg(interp, varNamePtr, NULL, "define",
		    ISARRAYELEMENT, -1);
		    isArrayElement, -1);
	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", NULL);
	    return TCL_ERROR;
	}

	if (varPtr == NULL) {
	    return TCL_ERROR;
	}

4942
4943
4944
4945
4946
4947
4948
4949
4950


4951
4952
4953
4954
4955
4956
4957
4958
4119
4120
4121
4122
4123
4124
4125


4126
4127

4128
4129
4130
4131
4132
4133
4134







-
-
+
+
-







	 * If a value was specified, set the variable to that value.
	 * Otherwise, if the variable is new, leave it undefined. (If the
	 * variable already exists and no value was specified, leave its value
	 * unchanged; just create the local link if we're in a Tcl procedure).
	 */

	if (i+1 < objc) {	/* A value was specified. */
	    varValuePtr = TclPtrSetVarIdx(interp, varPtr, arrayPtr,
		    varNamePtr, NULL, objv[i+1],
	    varValuePtr = TclPtrSetVar(interp, varPtr, arrayPtr, varNamePtr,
		    NULL, objv[i+1], TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG,-1);
		    (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), -1);
	    if (varValuePtr == NULL) {
		return TCL_ERROR;
	    }
	}

	/*
	 * If we are executing inside a Tcl procedure, create a local variable
5017
5018
5019
5020
5021
5022
5023

5024
5025
5026

5027
5028
5029
5030
5031
5032

5033
5034
5035

5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105



































































5106
5107
5108
5109
5110
5111
5112
5113
5114




5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130



5131
5132
5133





5134



5135
5136
5137





















5138



5139
5140
5141
5142








5143
5144
5145








5146
5147
5148
5149



5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165

5166
5167


5168
5169
5170
5171
5172
5173
5174
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351


4352
4353
4354
4355
4356
4357
4358
4359
4360



4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385




4386
4387
4388
4389
4390
4391
4392
4393



4394
4395
4396
4397
4398
4399
4400
4401




4402
4403
4404
4405
4406
4407
4408












4409


4410
4411
4412
4413
4414
4415
4416
4417
4418







+


-
+





-
+
-


+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+



-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
+




















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









+
+
+
+
















+
+
+

-
-
+
+
+
+
+

+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
+







 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
int
Tcl_UpvarObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    CallFrame *framePtr;
    int result, hasLevel;
    int result;
    Tcl_Obj *levelObj;

    if (objc < 3) {
    upvarSyntax:
	Tcl_WrongNumArgs(interp, 1, objv,
		"?level? otherVar localVar ?otherVar localVar ...?");
	return TCL_ERROR;
    }

    if (objc & 1) {
	/*
	 * Even number of arguments, so use the default level of "1" by
	 * passing NULL to TclObjGetFrame.
	 */

	levelObj = NULL;
	hasLevel = 0;
    } else {
	/*
	 * Odd number of arguments, so objv[1] must contain the level.
	 */

	levelObj = objv[1];
	hasLevel = 1;
    }

    /*
     * Find the call frame containing each of the "other variables" to be
     * linked to.
     */

    result = TclObjGetFrame(interp, levelObj, &framePtr);
    result = TclObjGetFrame(interp, objv[1], &framePtr);
    if (result == -1) {
	return TCL_ERROR;
    }
    if ((result == 0) && hasLevel) {
    objc -= result+1;
	/*
	 * Synthesize an error message since TclObjGetFrame doesn't do this
	 * for this particular case.
	 */

    if ((objc & 1) != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad level \"%s\"", TclGetString(levelObj)));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL",
		TclGetString(levelObj), NULL);
	return TCL_ERROR;
    }

	goto upvarSyntax;
    /*
     * We've now finished with parsing levels; skip to the variable names.
     */

    }
    objc -= hasLevel + 1;
    objv += hasLevel + 1;
    objv += result+1;

    /*
     * Iterate over each (other variable, local variable) pair. Divide the
     * other variable name into two parts, then call MakeUpvar to do all the
     * work of linking it to the local variable.
     */

    for (; objc>0 ; objc-=2, objv+=2) {
	result = ObjMakeUpvar(interp, framePtr, /* othervarName */ objv[0],
		NULL, 0, /* myVarName */ objv[1], /*flags*/ 0, -1);
	if (result != TCL_OK) {
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * SetArraySearchObj --
 *
 *	This function converts the given tcl object into one that has the
 *	"array search" internal type.
 *
 * Results:
 *	TCL_OK if the conversion succeeded, and TCL_ERROR if it failed (when
 *	an error message will be placed in the interpreter's result.)
 *
 * Side effects:
 *	Updates the internal type and representation of the object to make
 *	this an array-search object. See the tclArraySearchType declaration
 *	above for details of the internal representation.
 *
 *----------------------------------------------------------------------
 */

static int
SetArraySearchObj(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    char *string;
    char *end;
    int id;
    size_t offset;

    /*
     * Get the string representation. Make it up-to-date if necessary.
     */

    string = TclGetString(objPtr);

    /*
     * Parse the id into the three parts separated by dashes.
     */

    if ((string[0] != 's') || (string[1] != '-')) {
	goto syntax;
    }
    id = strtoul(string+2, &end, 10);
    if ((end == (string+2)) || (*end != '-')) {
	goto syntax;
    }

    /*
     * Can't perform value check in this context, so place reference to place
     * in string to use for the check in the object instead.
     */

    end++;
    offset = end - string;

    TclFreeIntRep(objPtr);
    objPtr->typePtr = &tclArraySearchType;
    objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id);
    objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset);
    return TCL_OK;

  syntax:
    Tcl_AppendResult(interp, "illegal search identifier \"",string,"\"",NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ParseSearchId --
 *
 *	This function translates from a tcl object to a pointer to an active
 *	array search (if there is one that matches the string).
 *
 * Results:
 *	The return value is a pointer to the array search indicated by string,
 *	or NULL if there isn't one. If NULL is returned, the interp's result
 *	contains an error message.
 *
 * Side effects:
 *	The tcl object might have its internal type and representation
 *	modified.
 *
 *----------------------------------------------------------------------
 */

static ArraySearch *
ParseSearchId(
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const Var *varPtr,		/* Array variable search is for. */
    Tcl_Obj *varNamePtr,	/* Name of array variable that search is
				 * supposed to be for. */
    Tcl_Obj *handleObj)		/* Object containing id of search. Must have
				 * form "search-num-var" where "num" is a
				 * decimal number and "var" is a variable
				 * name. */
{
    Interp *iPtr = (Interp *) interp;
    register char *string;
    register size_t offset;
    int id;
    ArraySearch *searchPtr;
    const char *handle = TclGetString(handleObj);
    char *end;
    char *varName = TclGetString(varNamePtr);

    /*
     * Parse the id.
     */

    if (Tcl_ConvertToType(interp, handleObj, &tclArraySearchType) != TCL_OK) {
	return NULL;
    }
    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(&iPtr->varSearches, varPtr);

    /*
     * Extract the information out of the Tcl_Obj.
     */

#if 1
    id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1);
    string = TclGetString(handleObj);
    offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2);
#else
    id = (int)(((char *) handleObj->internalRep.twoPtrValue.ptr1) -
	    ((char *) NULL));
    string = TclGetString(handleObj);
    offset = (((char *) handleObj->internalRep.twoPtrValue.ptr2) -
	    ((char *) NULL));
#endif

    /*
     * This test cannot be placed inside the Tcl_Obj machinery, since it is
     * dependent on the variable context.
     */

    if (strcmp(string+offset, varName) != 0) {
	Tcl_AppendResult(interp, "search identifier \"", string,
		"\" isn't for variable \"", varName, "\"", NULL);
	/* First look for same (Tcl_Obj *) */
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (searchPtr->name == handleObj) {
	goto badLookup;
    }

    /*
     * Search through the list of active searches on the interpreter to see if
     * the desired one exists.
     *
     * Note that we cannot store the searchPtr directly in the Tcl_Obj as that
		return searchPtr;
	    }
	}
     * would run into trouble when DeleteSearches() was called so we must scan
     * this list every time.
     */

    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
	Tcl_HashEntry *hPtr =
		Tcl_FindHashEntry(&iPtr->varSearches, (char *) varPtr);

	/* Fallback: do string compares. */
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(hPtr); searchPtr != NULL;
		searchPtr = searchPtr->nextPtr) {
	    if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(hPtr);
		searchPtr != NULL; searchPtr = searchPtr->nextPtr) {
	    if (searchPtr->id == id) {
		return searchPtr;
	    }
	}
    }
    if ((handle[0] != 's') || (handle[1] != '-')
	    || (strtoul(handle + 2, &end, 10), end == (handle + 2))
	    || (*end != '-')) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"illegal search identifier \"%s\"", handle));
    } else if (strcmp(end + 1, TclGetString(varNamePtr)) != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"search identifier \"%s\" isn't for variable \"%s\"",
		handle, TclGetString(varNamePtr)));
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't find search \"%s\"", handle));
    Tcl_AppendResult(interp, "couldn't find search \"", string, "\"", NULL);
    }
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", handle, NULL);
  badLookup:
    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * DeleteSearches --
5184
5185
5186
5187
5188
5189
5190
5191

5192
5193

5194
5195


5196
5197
5198
5199
5200



5201
5202
5203

5204
5205
5206
5207
5208
5209
5210
4428
4429
4430
4431
4432
4433
4434

4435
4436
4437
4438


4439
4440
4441




4442
4443
4444
4445


4446
4447
4448
4449
4450
4451
4452
4453







-
+


+
-
-
+
+

-
-
-
-
+
+
+

-
-
+







 *
 *----------------------------------------------------------------------
 */

static void
DeleteSearches(
    Interp *iPtr,
    Var *arrayVarPtr)	/* Variable whose searches are to be
    register Var *arrayVarPtr)	/* Variable whose searches are to be
				 * deleted. */
{
    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
    ArraySearch *searchPtr, *nextPtr;
    Tcl_HashEntry *sPtr;
	ArraySearch *searchPtr, *nextPtr;
	Tcl_HashEntry *sPtr;

    if (arrayVarPtr->flags & VAR_SEARCH_ACTIVE) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, arrayVarPtr);
	for (searchPtr = (ArraySearch *)Tcl_GetHashValue(sPtr); searchPtr != NULL;
		searchPtr = nextPtr) {
	sPtr = Tcl_FindHashEntry(&iPtr->varSearches, (char *) arrayVarPtr);
	for (searchPtr = (ArraySearch *) Tcl_GetHashValue(sPtr);
		searchPtr != NULL; searchPtr = nextPtr) {
	    nextPtr = searchPtr->nextPtr;
	    Tcl_DecrRefCount(searchPtr->name);
	    Tcl_Free(searchPtr);
	    ckfree((char *) searchPtr);
	}
	arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
	Tcl_DeleteHashEntry(sPtr);
    }
}

/*
5244
5245
5246
5247
5248
5249
5250
5251
5252


5253
5254
5255
5256
5257

5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268

5269
5270



5271
5272
5273
5274
5275
5276
5277
5278

5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297

5298
5299
5300
5301
5302
5303
5304
4487
4488
4489
4490
4491
4492
4493


4494
4495
4496
4497
4498
4499

4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512


4513
4514
4515

4516
4517
4518
4519
4520
4521

4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540

4541
4542
4543
4544
4545
4546
4547
4548







-
-
+
+




-
+











+
-
-
+
+
+
-






-
+


















-
+







	flags = TCL_GLOBAL_ONLY;
    } else if (nsPtr == (Namespace *) TclGetCurrentNamespace(interp)) {
	flags = TCL_NAMESPACE_ONLY;
    }

    for (varPtr = VarHashFirstVar(tablePtr, &search);  varPtr != NULL;
	    varPtr = VarHashFirstVar(tablePtr, &search)) {
	Tcl_Obj *objPtr;
	TclNewObj(objPtr);
	Tcl_Obj *objPtr = Tcl_NewObj();

	VarHashRefCount(varPtr)++;	/* Make sure we get to remove from
					 * hash. */
	Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr);
	UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
		NULL, flags, -1);
		NULL, flags);

	/*
	 * We just unset the variable. However, an unset trace might
	 * have re-set it, or might have re-established traces on it.
	 * This namespace and its vartable are going away unconditionally,
	 * so we cannot let such things linger. That would be a leak.
	 *
	 * First we destroy all traces. ...
	 */

	if (TclIsVarTraced(varPtr)) {
	    ActiveVarTrace *activePtr;
	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr);
	    VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces,
		    (char *) varPtr);
	    VarTrace *tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
	    ActiveVarTrace *activePtr;

	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
		prevPtr->nextPtr = NULL;
		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
	    }
	    Tcl_DeleteHashEntry(tPtr);
	    varPtr->flags &= ~VAR_ALL_TRACES;
	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
		    activePtr = activePtr->nextPtr) {
		if (activePtr->varPtr == varPtr) {
		    activePtr->nextTracePtr = NULL;
		}
	    }
	}

	/*
	 * ...and then, if the variable still holds a value, we unset it
	 * again. This time with no traces left, we're sure it goes away.
	 */

	if (!TclIsVarUndefined(varPtr)) {
	    UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr,
		    NULL, flags, -1);
		    NULL, flags);
	}
	Tcl_DecrRefCount(objPtr); /* free no longer needed obj */
	VarHashRefCount(varPtr)--;
	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}
5327
5328
5329
5330
5331
5332
5333
5334

5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351



5352
5353
5354
5355
5356
5357
5358
5359
4571
4572
4573
4574
4575
4576
4577

4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593


4594
4595
4596

4597
4598
4599
4600
4601
4602
4603







-
+















-
-
+
+
+
-







TclDeleteVars(
    Interp *iPtr,		/* Interpreter to which variables belong. */
    TclVarHashTable *tablePtr)	/* Hash table containing variables to
				 * delete. */
{
    Tcl_Interp *interp = (Tcl_Interp *) iPtr;
    Tcl_HashSearch search;
    Var *varPtr;
    register Var *varPtr;
    int flags;
    Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp);

    /*
     * Determine what flags to pass to the trace callback functions.
     */

    flags = TCL_TRACE_UNSETS;
    if (tablePtr == &iPtr->globalNsPtr->varTable) {
	flags |= TCL_GLOBAL_ONLY;
    } else if (tablePtr == &currNsPtr->varTable) {
	flags |= TCL_NAMESPACE_ONLY;
    }

    for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL;
	 varPtr = VarHashFirstVar(tablePtr, &search)) {
	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags,
	     varPtr = VarHashFirstVar(tablePtr, &search)) {

	UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags);
		-1);
	VarHashDeleteEntry(varPtr);
    }
    VarHashDeleteTable(tablePtr);
}

/*
 *----------------------------------------------------------------------
5379
5380
5381
5382
5383
5384
5385
5386

5387
5388
5389
5390
5391
5392
5393
5394
5395

5396
5397
5398
5399
5400
5401
5402
4623
4624
4625
4626
4627
4628
4629

4630
4631
4632
4633
4634
4635
4636
4637
4638

4639
4640
4641
4642
4643
4644
4645
4646







-
+








-
+








void
TclDeleteCompiledLocalVars(
    Interp *iPtr,		/* Interpreter to which variables belong. */
    CallFrame *framePtr)	/* Procedure call frame containing compiler-
				 * assigned local variables to delete. */
{
    Var *varPtr;
    register Var *varPtr;
    int numLocals, i;
    Tcl_Obj **namePtrPtr;

    numLocals = framePtr->numCompiledLocals;
    varPtr = framePtr->compiledLocals;
    namePtrPtr = &localName(framePtr, 0);
    for (i=0 ; i<numLocals ; i++, namePtrPtr++, varPtr++) {
	UnsetVarStruct(varPtr, NULL, iPtr, *namePtrPtr, NULL,
		TCL_TRACE_UNSETS, i);
		TCL_TRACE_UNSETS);
    }
    framePtr->numCompiledLocals = 0;
}

/*
 *----------------------------------------------------------------------
 *
5421
5422
5423
5424
5425
5426
5427
5428

5429
5430
5431
5432
5433
5434
5435

5436
5437
5438
5439



5440
5441
5442
5443
5444
5445
5446
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







-
+


-



-
+




+
+
+







static void
DeleteArray(
    Interp *iPtr,		/* Interpreter containing array. */
    Tcl_Obj *arrayNamePtr,	/* Name of array (used for trace callbacks),
				 * or NULL if it is to be computed on
				 * demand. */
    Var *varPtr,		/* Pointer to variable structure. */
    int flags,			/* Flags to pass to TclCallVarTraces:
    int flags)			/* Flags to pass to TclCallVarTraces:
				 * TCL_TRACE_UNSETS and sometimes
				 * TCL_NAMESPACE_ONLY or TCL_GLOBAL_ONLY. */
    int index)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *tPtr;
    Var *elPtr;
    register Var *elPtr;
    ActiveVarTrace *activePtr;
    Tcl_Obj *objPtr;
    VarTrace *tracePtr;

    if (varPtr->flags & VAR_SEARCH_ACTIVE) {
	DeleteSearches(iPtr, varPtr);
    }
    for (elPtr = VarHashFirstVar(varPtr->value.tablePtr, &search);
	    elPtr != NULL; elPtr = VarHashNextVar(&search)) {
	if (TclIsVarScalar(elPtr) && (elPtr->value.objPtr != NULL)) {
	    objPtr = elPtr->value.objPtr;
	    TclDecrRefCount(objPtr);
	    elPtr->value.objPtr = NULL;
	}
5457
5458
5459
5460
5461
5462
5463
5464

5465
5466
5467


5468
5469
5470
5471
5472
5473

5474
5475
5476
5477
5478
5479
5480
4703
4704
4705
4706
4707
4708
4709

4710
4711


4712
4713
4714
4715
4716
4717


4718
4719
4720
4721
4722
4723
4724
4725







-
+

-
-
+
+




-
-
+







	     */

	    if (elPtr->flags & VAR_TRACED_UNSET) {
		Tcl_Obj *elNamePtr = VarHashGetKey(elPtr);

		elPtr->flags &= ~VAR_TRACE_ACTIVE;
		TclObjCallVarTraces(iPtr, NULL, elPtr, arrayNamePtr,
			elNamePtr, flags,/* leaveErrMsg */ 0, index);
			elNamePtr, flags,/* leaveErrMsg */ 0, -1);
	    }
	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, elPtr);
	    tracePtr = (VarTrace *)Tcl_GetHashValue(tPtr);
	    tPtr = Tcl_FindHashEntry(&iPtr->varTraces, (char *) elPtr);
	    tracePtr = (VarTrace *) Tcl_GetHashValue(tPtr);
	    while (tracePtr) {
		VarTrace *prevPtr = tracePtr;

		tracePtr = tracePtr->nextPtr;
		prevPtr->nextPtr = NULL;
		Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC);
		Tcl_EventuallyFree((ClientData) prevPtr, TCL_DYNAMIC);
	    }
	    Tcl_DeleteHashEntry(tPtr);
	    elPtr->flags &= ~VAR_ALL_TRACES;
	    for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL;
		    activePtr = activePtr->nextPtr) {
		if (activePtr->varPtr == elPtr) {
		    activePtr->nextTracePtr = NULL;
5488
5489
5490
5491
5492
5493
5494
5495


5496
5497
5498
5499
5500
5501

5502
5503
5504
5505
5506
5507
5508
4733
4734
4735
4736
4737
4738
4739

4740
4741
4742
4743
4744
4745
4746

4747
4748
4749
4750
4751
4752
4753
4754







-
+
+





-
+







	 * variables, some combinations of [upvar] and [variable] may create
	 * such beasts - see [Bug 604239]. This is necessary to avoid leaking
	 * the corresponding Var struct, and is otherwise harmless.
	 */

	TclClearVarNamespaceVar(elPtr);
    }
    DeleteArrayVar(varPtr);
    VarHashDeleteTable(varPtr->value.tablePtr);
    ckfree((char *) varPtr->value.tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjVarErrMsg --
 * TclTclObjVarErrMsg --
 *
 *	Generate a reasonable error message describing why a variable
 *	operation failed.
 *
 * Results:
 *	None.
 *
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570






















5571
5572
5573
5574
5575
5576
5577
5578



5579
5580
5581
5582
5583
5584
5585
5586

5587
5588
5589
5590
5591
5592
5593

5594
5595
5596
5597
5598
5599
5600
5601
5602

5603
5604
5605
5606
5607


5608




5609









































5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624

5625
5626

5627
5628
5629
5630
5631
5632

5633

5634
5635
5636
5637
5638
5639
5640






















5641
5642






5643




5644
5645
5646
5647



















5648
5649
5650
5651
5652
5653
5654
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
4955
4956
4957
4958
4959
4960
4961
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







-
-
-















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+






-
-
+
-
-
-
-



+







-
-
+

-



+
+
-
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














-
+
-
-
+
-

-


-
+

+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+

+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * e.g. "read", "set", or "unset". */
    const char *reason,		/* String describing why operation failed. */
    int index)			/* Index into the local variable table of the
				 * variable, or -1. Only used when part1Ptr is
				 * NULL. */
{
    if (!part1Ptr) {
	if (index == -1) {
	    Tcl_Panic("invalid part1Ptr and invalid index together");
	}
	part1Ptr = localName(((Interp *)interp)->varFramePtr, index);
    }
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("can't %s \"%s%s%s%s\": %s",
	    operation, TclGetString(part1Ptr), (part2Ptr ? "(" : ""),
	    (part2Ptr ? TclGetString(part2Ptr) : ""), (part2Ptr ? ")" : ""),
	    reason));
}

/*
 *----------------------------------------------------------------------
 *
 * Internal functions for variable name object types --
 *
 *----------------------------------------------------------------------
 */

/*
 * Panic functions that should never be called in normal operation.
 */

static void
PanicOnUpdateVarName(
    Tcl_Obj *objPtr)
{
    Tcl_Panic("%s of type %s should not be called", "updateStringProc",
	    objPtr->typePtr->name);
}

static int
PanicOnSetVarName(
    Tcl_Interp *interp,
    Tcl_Obj *objPtr)
{
    Tcl_Panic("%s of type %s should not be called", "setFromAnyProc",
	    objPtr->typePtr->name);
    return TCL_ERROR;
}

/*
 * localVarName -
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
 *   twoPtrValue.ptr2: index into locals table
 *   ptrAndLongRep.ptr:   pointer to name obj in varFramePtr->localCache
 *                        or NULL if it is this same obj
 *   ptrAndLongRep.value: index into locals table
 */

static void
FreeLocalVarName(
    Tcl_Obj *objPtr)
{
    int index;
    Tcl_Obj *namePtr;
    Tcl_Obj *namePtr = (Tcl_Obj *) objPtr->internalRep.ptrAndLongRep.ptr;

    LocalGetIntRep(objPtr, index, namePtr);

    index++;	/* Compiler warning bait. */
    if (namePtr) {
	Tcl_DecrRefCount(namePtr);
    }
    objPtr->typePtr = NULL;
}

static void
DupLocalVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    int index;
    Tcl_Obj *namePtr;
    Tcl_Obj *namePtr = srcPtr->internalRep.ptrAndLongRep.ptr;

    LocalGetIntRep(srcPtr, index, namePtr);
    if (!namePtr) {
	namePtr = srcPtr;
    }
    dupPtr->internalRep.ptrAndLongRep.ptr = namePtr;
    Tcl_IncrRefCount(namePtr);
    LocalSetIntRep(dupPtr, index, namePtr);

    dupPtr->internalRep.ptrAndLongRep.value =
	    srcPtr->internalRep.ptrAndLongRep.value;
    dupPtr->typePtr = &localVarNameType;
}

#if ENABLE_NS_VARNAME_CACHING
/*
 * nsVarName -
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1: pointer to the namespace containing the reference.
 *   twoPtrValue.ptr2: pointer to the corresponding Var
 */

static void
FreeNsVarName(
    Tcl_Obj *objPtr)
{
    register Var *varPtr = objPtr->internalRep.twoPtrValue.ptr2;

    if (TclIsVarInHash(varPtr)) {
	varPtr->refCount--;
	if (TclIsVarUndefined(varPtr) && (varPtr->refCount == 0)) {
	    CleanupVar(varPtr, NULL);
	}
    }
    objPtr->typePtr = NULL;
}

static void
DupNsVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    Namespace *nsPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    register Var *varPtr = srcPtr->internalRep.twoPtrValue.ptr2;

    dupPtr->internalRep.twoPtrValue.ptr1 = nsPtr;
    dupPtr->internalRep.twoPtrValue.ptr2 = varPtr;
    if (TclIsVarInHash(varPtr)) {
	varPtr->refCount++;
    }
    dupPtr->typePtr = &tclNsVarNameType;
}
#endif

/*
 * parsedVarName -
 *
 * INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1 = pointer to the array name Tcl_Obj (NULL if scalar)
 *   twoPtrValue.ptr2 = pointer to the element name string (owned by this
 *			Tcl_Obj), or NULL if it is a scalar variable
 */

static void
FreeParsedVarName(
    Tcl_Obj *objPtr)
{
    Tcl_Obj *arrayPtr, *elem;
    register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
    int parsed;

    register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
    ParsedGetIntRep(objPtr, parsed, arrayPtr, elem);

    parsed++;				/* Silence compiler. */
    if (arrayPtr != NULL) {
	TclDecrRefCount(arrayPtr);
	TclDecrRefCount(elem);
	ckfree(elem);
    }
    objPtr->typePtr = NULL;
}

static void
DupParsedVarName(
    Tcl_Obj *srcPtr,
    Tcl_Obj *dupPtr)
{
    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
    register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
    char *elemCopy;

    if (arrayPtr != NULL) {
	unsigned int elemLen;

	Tcl_IncrRefCount(arrayPtr);
	elemLen = strlen(elem);
	elemCopy = ckalloc(elemLen+1);
	memcpy(elemCopy, elem, elemLen);
	*(elemCopy + elemLen) = '\0';
	elem = elemCopy;
    }

    dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
    dupPtr->internalRep.twoPtrValue.ptr2 = elem;
    dupPtr->typePtr = &tclParsedVarNameType;
}

static void
UpdateParsedVarName(
    Tcl_Obj *arrayPtr, *elem;
    int parsed;
    Tcl_Obj *objPtr)
{
    Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
    char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
    char *part1, *p;
    int len1, len2, totalLen;

    if (arrayPtr == NULL) {
	/*
	 * This is a parsed scalar name: what is it doing here?
	 */
    ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem);

    parsed++;				/* Silence compiler. */
    ParsedSetIntRep(dupPtr, arrayPtr, elem);

	Tcl_Panic("scalar parsedVarName without a string rep");
    }

    part1 = TclGetStringFromObj(arrayPtr, &len1);
    len2 = strlen(part2);

    totalLen = len1 + len2 + 2;
    p = ckalloc((unsigned int) totalLen + 1);
    objPtr->bytes = p;
    objPtr->length = totalLen;

    memcpy(p, part1, (unsigned int) len1);
    p += len1;
    *p++ = '(';
    memcpy(p, part2, (unsigned int) len2);
    p += len2;
    *p++ = ')';
    *p = '\0';
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindNamespaceVar -- MOVED OVER from tclNamesp.c
 *
5677
5678
5679
5680
5681
5682
5683
5684
5685


5686
5687
5688
5689



5690
5691
5692
5693
5694
5695
5696
5025
5026
5027
5028
5029
5030
5031


5032
5033




5034
5035
5036
5037
5038
5039
5040
5041
5042
5043







-
-
+
+
-
-
-
-
+
+
+







				 * Else, looked up first in contextNsPtr
				 * (current namespace if contextNsPtr is
				 * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
				 * Otherwise, points to namespace in which to
				 * resolve name. If NULL, look up name in the
				 * current namespace. */
    int flags)			/* An OR'd combination of:
				 * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
    int flags)			/* An OR'd combination of: AVOID_RESOLVERS,
				 * TCL_GLOBAL_ONLY (look up name only in
				 * up name only in global namespace),
				 * TCL_NAMESPACE_ONLY (look up only in
				 * contextNsPtr, or the current namespace if
				 * contextNsPtr is NULL), and
				 * global namespace), TCL_NAMESPACE_ONLY (look
				 * up only in contextNsPtr, or the current
				 * namespace if contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Tcl_Obj *namePtr = Tcl_NewStringObj(name, -1);
    Tcl_Var var;

5708
5709
5710
5711
5712
5713
5714
5715
5716


5717
5718
5719
5720



5721
5722
5723
5724
5725
5726
5727
5728
5729
5730

5731
5732
5733
5734

5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750

5751


5752
5753
5754
5755

5756
5757
5758
5759
5760
5761
5762
5763

5764
5765
5766
5767
5768
5769
5770
5771
5772

5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
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

5095
5096
5097
5098
5099
5100
5101

5102
5103
5104
5105
5106
5107
5108
5109

5110
5111
5112
5113
5114
5115
5116
5117
5118

5119
5120
5121
5122
5123
5124
5125
5126




5127
5128
5129
5130
5131
5132
5133







-
-
+
+
-
-
-
-
+
+
+









-
+
-


-
+















-
+

+
+



-
+







-
+








-
+







-
-
-
-







				 * Else, looked up first in contextNsPtr
				 * (current namespace if contextNsPtr is
				 * NULL), then in global namespace. */
    Tcl_Namespace *contextNsPtr,/* Ignored if TCL_GLOBAL_ONLY flag set.
				 * Otherwise, points to namespace in which to
				 * resolve name. If NULL, look up name in the
				 * current namespace. */
    int flags)			/* An OR'd combination of:
				 * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
    int flags)			/* An OR'd combination of: AVOID_RESOLVERS,
				 * TCL_GLOBAL_ONLY (look up name only in
				 * up name only in global namespace),
				 * TCL_NAMESPACE_ONLY (look up only in
				 * contextNsPtr, or the current namespace if
				 * contextNsPtr is NULL), and
				 * global namespace), TCL_NAMESPACE_ONLY (look
				 * up only in contextNsPtr, or the current
				 * namespace if contextNsPtr is NULL), and
				 * TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
				 * and TCL_NAMESPACE_ONLY are given,
				 * TCL_GLOBAL_ONLY is ignored. */
{
    Interp *iPtr = (Interp *) interp;
    ResolverScheme *resPtr;
    Namespace *nsPtr[2], *cxtNsPtr;
    const char *simpleName;
    Var *varPtr;
    int search;
    register int search;
    int result;
    Tcl_Var var;
    Tcl_Obj *simpleNamePtr;
    const char *name = TclGetString(namePtr);
    char *name = TclGetString(namePtr);

    /*
     * If this namespace has a variable resolver, then give it first crack at
     * the variable resolution. It may return a Tcl_Var value, it may signal
     * to continue onward, or it may signal an error.
     */

    if ((flags & TCL_GLOBAL_ONLY) != 0) {
	cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp);
    } else if (contextNsPtr != NULL) {
	cxtNsPtr = (Namespace *) contextNsPtr;
    } else {
	cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
    }

    if (!(flags & TCL_AVOID_RESOLVERS) &&
    if (!(flags & AVOID_RESOLVERS) &&
	    (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
	int result;

	resPtr = iPtr->resolverPtr;

	if (cxtNsPtr->varResProc) {
	    result = cxtNsPtr->varResProc(interp, name,
	    result = (*cxtNsPtr->varResProc)(interp, name,
		    (Tcl_Namespace *) cxtNsPtr, flags, &var);
	} else {
	    result = TCL_CONTINUE;
	}

	while (result == TCL_CONTINUE && resPtr) {
	    if (resPtr->varResProc) {
		result = resPtr->varResProc(interp, name,
		result = (*resPtr->varResProc)(interp, name,
			(Tcl_Namespace *) cxtNsPtr, flags, &var);
	    }
	    resPtr = resPtr->nextPtr;
	}

	if (result == TCL_OK) {
	    return var;
	} else if (result != TCL_CONTINUE) {
	    return NULL;
	    return (Tcl_Var) NULL;
	}
    }

    /*
     * Find the namespace(s) that contain the variable.
     */

    if (!(flags & TCL_GLOBAL_ONLY)) {
	flags |= TCL_NAMESPACE_ONLY;
    }

    TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
	    flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);

    /*
     * Look for the variable in the variable table of its namespace. Be sure
     * to check both possible search paths: from the specified namespace
     * context and from the global namespace.
5802
5803
5804
5805
5806
5807
5808
5809
5810


5811
5812
5813
5814
5815
5816
5817
5145
5146
5147
5148
5149
5150
5151


5152
5153
5154
5155
5156
5157
5158
5159
5160







-
-
+
+







	    varPtr = VarHashFindVar(&nsPtr[search]->varTable, simpleNamePtr);
	}
    }
    if (simpleName != name) {
	Tcl_DecrRefCount(simpleNamePtr);
    }
    if ((varPtr == NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"unknown variable \"%s\"", name));
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "unknown variable \"", name, "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARIABLE", name, NULL);
    }
    return (Tcl_Var) varPtr;
}

/*
 *----------------------------------------------------------------------
5835
5836
5837
5838
5839
5840
5841
5842

5843
5844
5845
5846
5847

5848

5849
5850
5851
5852
5853
5854

5855
5856

5857
5858
5859
5860
5861
5862
5863
5178
5179
5180
5181
5182
5183
5184

5185
5186
5187
5188
5189
5190
5191

5192
5193

5194
5195
5196

5197
5198

5199
5200
5201
5202
5203
5204
5205
5206







-
+





+
-
+

-



-
+

-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

int
TclInfoVarsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    char *pattern;
    const char *varName, *pattern, *simplePattern;
    const char *simplePattern;
    Tcl_HashSearch search;
    Var *varPtr;
    Namespace *nsPtr;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
    Tcl_Obj *listPtr, *elemObjPtr, *varNamePtr;
    Tcl_Obj *listPtr;
    int specificNsInPattern = 0;/* Init. to avoid compiler warning. */
    Tcl_Obj *simplePatternPtr = NULL;
    Tcl_Obj *simplePatternPtr = NULL, *varNamePtr;

    /*
     * Get the pattern and find the "effective namespace" in which to list
     * variables. We only use this effective namespace if there's no active
     * Tcl procedure frame.
     */

5873
5874
5875
5876
5877
5878
5879
5880
5881



5882
5883
5884
5885
5886
5887
5888
5216
5217
5218
5219
5220
5221
5222


5223
5224
5225
5226
5227
5228
5229
5230
5231
5232







-
-
+
+
+







	 * namespace wasn't found, just leave nsPtr NULL: we will return an
	 * empty list since no variables there can be found.
	 */

	Namespace *dummy1NsPtr, *dummy2NsPtr;

	pattern = TclGetString(objv[1]);
	TclGetNamespaceForQualName(interp, pattern, NULL, /*flags*/ 0,
		&nsPtr, &dummy1NsPtr, &dummy2NsPtr, &simplePattern);
	TclGetNamespaceForQualName(interp, pattern, (Namespace *) NULL,
		/*flags*/ 0, &nsPtr, &dummy1NsPtr, &dummy2NsPtr,
		&simplePattern);

	if (nsPtr != NULL) {	/* We successfully found the pattern's ns. */
	    specificNsInPattern = (strcmp(simplePattern, pattern) != 0);
	    if (simplePattern == pattern) {
		simplePatternPtr = objv[1];
	    } else {
		simplePatternPtr = Tcl_NewStringObj(simplePattern, -1);
5900
5901
5902
5903
5904
5905
5906

5907




5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925

5926
5927
5928
5929
5930
5931
5932
5244
5245
5246
5247
5248
5249
5250
5251

5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272

5273
5274
5275
5276
5277
5278
5279
5280







+
-
+
+
+
+

















-
+








    if (nsPtr == NULL) {
	return TCL_OK;
    }

    listPtr = Tcl_NewListObj(0, NULL);

    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
    if (!HasLocalVars(iPtr->varFramePtr) || specificNsInPattern) {
	    || specificNsInPattern) {
	Var *varPtr;
	Tcl_Obj *elemObjPtr;

	/*
	 * There is no frame pointer, the frame pointer was pushed only to
	 * activate a namespace, or we are in a procedure call frame but a
	 * specific namespace was specified. Create a list containing only the
	 * variables in the effective namespace's variable table.
	 */

	if (simplePattern && TclMatchIsTrivial(simplePattern)) {
	    /*
	     * If we can just do hash lookups, that simplifies things a lot.
	     */

	    varPtr = VarHashFindVar(&nsPtr->varTable, simplePatternPtr);
	    if (varPtr) {
		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    if (specificNsInPattern) {
			TclNewObj(elemObjPtr);
			elemObjPtr = Tcl_NewObj();
			Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				elemObjPtr);
		    } else {
			elemObjPtr = VarHashGetKey(varPtr);
		    }
		    Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		}
5941
5942
5943
5944
5945
5946
5947

5948
5949
5950

5951
5952
5953
5954
5955
5956
5957
5958

5959
5960
5961
5962
5963
5964
5965
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307

5308
5309
5310
5311
5312
5313
5314
5315







+



+







-
+







		    }
		}
	    }
	} else {
	    /*
	     * Have to scan the tables of variables.
	     */
	    char *varName;

	    varPtr = VarHashFirstVar(&nsPtr->varTable, &search);
	    while (varPtr) {

		if (!TclIsVarUndefined(varPtr)
			|| TclIsVarNamespaceVar(varPtr)) {
		    varNamePtr = VarHashGetKey(varPtr);
		    varName = TclGetString(varNamePtr);
		    if ((simplePattern == NULL)
			    || Tcl_StringMatch(varName, simplePattern)) {
			if (specificNsInPattern) {
			    TclNewObj(elemObjPtr);
			    elemObjPtr = Tcl_NewObj();
			    Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr,
				    elemObjPtr);
			} else {
			    elemObjPtr = varNamePtr;
			}
			Tcl_ListObjAppendElement(interp, listPtr, elemObjPtr);
		    }
5973
5974
5975
5976
5977
5978
5979
5980

5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999

6000
6001
6002
6003
6004
6005
6006
5323
5324
5325
5326
5327
5328
5329

5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348

5349
5350
5351
5352
5353
5354
5355
5356







-
+


















-
+







	     * pattern only specifies variable names), then add in all global
	     * :: variables that match the simple pattern. Of course, add in
	     * only those variables that aren't hidden by a variable in the
	     * effective namespace.
	     */

	    if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
		varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search);
		while (varPtr) {
		    if (!TclIsVarUndefined(varPtr)
			    || TclIsVarNamespaceVar(varPtr)) {
			varNamePtr = VarHashGetKey(varPtr);
			varName = TclGetString(varNamePtr);
			if ((simplePattern == NULL)
				|| Tcl_StringMatch(varName, simplePattern)) {
			    if (VarHashFindVar(&nsPtr->varTable,
				    varNamePtr) == NULL) {
				Tcl_ListObjAppendElement(interp, listPtr,
					varNamePtr);
			    }
			}
		    }
		    varPtr = VarHashNextVar(&search);
		}
	    }
	}
    } else if (iPtr->varFramePtr->procPtr != NULL) {
    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
	AppendLocals(interp, listPtr, simplePatternPtr, 1);
    }

    if (simplePatternPtr) {
	Tcl_DecrRefCount(simplePatternPtr);
    }
    Tcl_SetObjResult(interp, listPtr);
6026
6027
6028
6029
6030
6031
6032
6033

6034
6035
6036
6037
6038

6039
6040
6041
6042

6043
6044
6045
6046
6047
6048
6049
5376
5377
5378
5379
5380
5381
5382

5383
5384
5385
5386
5387

5388
5389
5390
5391

5392
5393
5394
5395
5396
5397
5398
5399







-
+




-
+



-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

int
TclInfoGlobalsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *varName, *pattern;
    char *pattern;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Tcl_HashSearch search;
    Var *varPtr;
    Tcl_Obj *listPtr, *varNamePtr, *patternPtr;
    Tcl_Obj *listPtr, *patternPtr;

    if (objc == 1) {
	pattern = NULL;
    } else if (objc == 2) {
	pattern = TclGetString(objv[1]);

	/*
6082
6083
6084
6085
6086
6087
6088



6089
6090
6091
6092
6093
6094
6095
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448







+
+
+







	    }
	}
	Tcl_DecrRefCount(patternPtr);
    } else {
	for (varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
		varPtr != NULL;
		varPtr = VarHashNextVar(&search)) {
	    char *varName;
	    Tcl_Obj *varNamePtr;

	    if (TclIsVarUndefined(varPtr)) {
		continue;
	    }
	    varNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, varNamePtr);
6119
6120
6121
6122
6123
6124
6125
6126

6127
6128
6129
6130
6131
6132


6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143

6144
6145
6146
6147
6148
6149
6150
5472
5473
5474
5475
5476
5477
5478

5479
5480
5481
5482
5483
5484

5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496

5497
5498
5499
5500
5501
5502
5503
5504







-
+





-
+
+










-
+







 *	error, the result is an error message.
 *
 *----------------------------------------------------------------------
 */

int
TclInfoLocalsCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    Tcl_Obj *patternPtr, *listPtr;
    Tcl_Obj *patternPtr;
    Tcl_Obj *listPtr;

    if (objc == 1) {
	patternPtr = NULL;
    } else if (objc == 2) {
	patternPtr = objv[1];
    } else {
	Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
	return TCL_ERROR;
    }

    if (!HasLocalVars(iPtr->varFramePtr)) {
    if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
	return TCL_OK;
    }

    /*
     * Return a list containing names of first the compiled locals (i.e. the
     * ones stored in the call frame), then the variables in the local hash
     * table (if one exists).
6178
6179
6180
6181
6182
6183
6184
6185
6186
6187



6188
6189
6190
6191

6192
6193
6194
6195
6196
6197
6198
6199
6200
6201

6202
6203
6204
6205
6206




6207
6208

6209
6210
6211
6212



6213
6214
6215
6216


6217
6218

6219
6220
6221
6222
6223
6224
6225
6226
6227

6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245


6246
6247

6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264
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
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
6390
6391
6392
6393



6394


6395
6396
6397
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407

6408
6409
6410

6411
6412

6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428

6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443

6444
6445
6446
6447

6448
6449
6450
6451
6452
6453
6454
6455
6456

6457
6458
6459
6460
6461
6462



6463
6464
6465
6466
6467
6468

6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
6483


6484
6485
6486
6487
6488
6489


6490
6491
6492
6493
6494
6495
6496
6497
6498
6499

6500
6501
6502
6503
6504


6505
6506
6507
6508
6509
6510
6511
6512
6513
6514
6515

6516
6517
6518
6519
6520
6521

6522
6523

6524
6525

6526
6527
6528

6529
6530
6531
6532
6533
6534

6535
6536
6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
6552
6553
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569

6570
6571
6572

6573
6574
6575
6576
6577
6578

6579
6580
6581
6582

6583
6584

6585
6586
6587
6588

6589
6590
6591
6592
6593
6594
6595
6596
6597
6598
6599
6600
6601
6602

6603
6604
6605
6606
6607
6608
6609

6610
6611
6612
6613

6614
6615

6616
6617
6618
6619

6620
6621
6622
6623

6624
6625
6626
6627

6628
6629
6630
6631
6632
6633
6634

6635
6636
6637
6638
6639
6640

6641
6642
6643
6644
6645
6646
6647
6648
6649

6650
6651
6652
6653
6654
6655
6656
6657
6658

6659
6660
6661
6662
6663
6664

6665
6666
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
5532
5533
5534
5535
5536
5537
5538



5539
5540
5541
5542
5543

5544
5545
5546
5547
5548
5549






5550
5551




5552
5553
5554
5555
5556

5557
5558



5559
5560
5561




5562
5563


5564

5565
5566
5567
5568
5569
5570
5571

5572
5573
5574
5575
5576
5577
5578
5579
5580
5581
5582
5583
5584
5585





5586
5587


5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603





5604
5605
5606























































5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622
5623
5624

5625
5626
5627

5628
5629
5630
5631

5632
5633
5634
5635
5636

5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653

5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664

5665
5666
5667

5668
5669


5670
5671
5672
5673
5674



5675
5676
5677

5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691

5692
5693
5694

5695


5696
















5697















5698




5699









5700






5701
5702
5703






5704



5705











5706
5707






5708
5709










5710





5711
5712











5713






5714


5715


5716



5717






5718




5719






























5720



5721






5722




5723


5724




5725














5726







5727




5728


5729




5730




5731




5732







5733






5734
5735








5736









5737



5738


5739



5740
5741
5742
5743
5744
5745
5746
5747
5748







-
-
-
+
+
+


-

+




-
-
-
-
-
-
+

-
-
-
-
+
+
+
+

-
+

-
-
-
+
+
+
-
-
-
-
+
+
-
-
+
-







-
+













-
-
-
-
-
+
+
-
-
+















-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















-
+


-
+



-
+




-
+
















-
+










-
+


-
+

-
-
+
+



-
-
-
+
+
+
-
+
+












-
+


-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
-
-
-

-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
+
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-

-
-
+
-
-
-









    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 *objNamePtr;
    const char *varName;
    int i, localVarCt;
    Tcl_Obj **varNamePtr;
    char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;
    Tcl_Obj *objNamePtr;

    localVarCt = iPtr->varFramePtr->numCompiledLocals;
    varPtr = iPtr->varFramePtr->compiledLocals;
    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
    if (includeLinks) {
	Tcl_InitObjHashTable(&addedTable);
    }

    if (localVarCt > 0) {
	Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;

	for (i = 0; i < localVarCt; i++, varNamePtr++) {
	    /*
	     * Skip nameless (temporary) variables and undefined variables.
	     */
    for (i = 0; i < localVarCt; i++, varNamePtr++) {
	/*
	 * Skip nameless (temporary) variables and undefined variables.
	 */

	    if (*varNamePtr && !TclIsVarUndefined(varPtr)
	if (*varNamePtr && !TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
		varName = TclGetString(*varNamePtr);
		if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		    Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
	    varName = TclGetString(*varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
		    if (includeLinks) {
			Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		    }
		}
	    }
	}
	    }
	    varPtr++;
	varPtr++;
	}
    }

    /*
     * Do nothing if no local variables.
     */

    if (localVarTablePtr == NULL) {
	goto objectVars;
	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));
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
			    &added);
		}
	    }
	    }
	}
	}
	goto objectVars;
	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);
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		}
	    }
	}
	    }
	}
    }
    }

  objectVars:
    if (!includeLinks) {
	return;
    }

    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
	Method *mPtr = (Method *)
		Tcl_ObjectContextMethod((Tcl_ObjectContext)iPtr->varFramePtr->clientData);
	PrivateVariableMapping *privatePtr;

	if (mPtr->declaringObjectPtr) {
	    Object *oPtr = mPtr->declaringObjectPtr;

	    FOREACH(objNamePtr, oPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	} else {
	    Class *clsPtr = mPtr->declaringClassPtr;

	    FOREACH(objNamePtr, clsPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	    FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
		Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
			&added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(privatePtr->variableObj),
				pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr,
			    privatePtr->variableObj);
		}
	    }
	}
    }
    Tcl_DeleteHashTable(&addedTable);
}

/*
 * Hash table implementation - first, just copy and adapt the obj key stuff
 */

void
TclInitVarHashTable(
    TclVarHashTable *tablePtr,
    Namespace *nsPtr)
{
    Tcl_InitCustomHashTable(&tablePtr->table,
	    TCL_CUSTOM_TYPE_KEYS, &tclVarHashKeyType);
    tablePtr->nsPtr = nsPtr;
}

static Tcl_HashEntry *
AllocVarEntry(
    TCL_UNUSED(Tcl_HashTable *),
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key to store in the hash table entry. */
{
    Tcl_Obj *objPtr = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
    Tcl_HashEntry *hPtr;
    Var *varPtr;

    varPtr = (Var *)Tcl_Alloc(sizeof(VarInHash));
    varPtr = (Var *) ckalloc(sizeof(VarInHash));
    varPtr->flags = VAR_IN_HASHTABLE;
    varPtr->value.objPtr = NULL;
    VarHashRefCount(varPtr) = 1;

    hPtr = &(((VarInHash *) varPtr)->entry);
    hPtr = &(((VarInHash *)varPtr)->entry);
    Tcl_SetHashValue(hPtr, varPtr);
    hPtr->key.objPtr = objPtr;
    Tcl_IncrRefCount(objPtr);

    return hPtr;
}

static void
FreeVarEntry(
    Tcl_HashEntry *hPtr)
{
    Var *varPtr = VarHashGetValue(hPtr);
    Tcl_Obj *objPtr = hPtr->key.objPtr;

    if (TclIsVarUndefined(varPtr) && !TclIsVarTraced(varPtr)
	    && (VarHashRefCount(varPtr) == 1)) {
	Tcl_Free(varPtr);
	ckfree((char *) varPtr);
    } else {
	VarHashInvalidateEntry(varPtr);
	TclSetVarUndefined(varPtr);
	VarHashRefCount(varPtr)--;
    }
    Tcl_DecrRefCount(objPtr);
}

static int
CompareVarKeys(
    void *keyPtr,			/* New key to compare. */
    void *keyPtr,		/* New key to compare. */
    Tcl_HashEntry *hPtr)	/* Existing key to compare. */
{
    Tcl_Obj *objPtr1 = (Tcl_Obj *)keyPtr;
    Tcl_Obj *objPtr1 = (Tcl_Obj *) keyPtr;
    Tcl_Obj *objPtr2 = hPtr->key.objPtr;
    const char *p1, *p2;
    size_t l1, l2;
    register const char *p1, *p2;
    register int l1, l2;

    /*
     * If the object pointers are the same then they match.
     * OPT: this comparison was moved to the caller
     *
     * if (objPtr1 == objPtr2) return 1;
     */

    if (objPtr1 == objPtr2) {
     */
	return 1;
    }

    /*
     * Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
     * register.
     */

    p1 = TclGetString(objPtr1);
    l1 = objPtr1->length;
    p2 = TclGetString(objPtr2);
    l2 = objPtr2->length;

    /*
     * Only compare string representations of the same length.
     * Only compare if the string representations are of the same length.
     */

    return ((l1 == l2) && !memcmp(p1, p2, l1));
    if (l1 == l2) {
}

	for (;; p1++, p2++, l1--) {
/*----------------------------------------------------------------------
 *
 * ArrayDefaultCmd --
 *
 *	This function implements the 'array default' Tcl command.
 *	Refer to the user documentation for details on what it does.
 *
 * Results:
 *	Returns a standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

	    if (*p1 != *p2) {
static int
ArrayDefaultCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"get", "set", "exists", "unset", NULL
    };
    enum arrayDefaultOptionsEnum { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
    Tcl_Obj *arrayNameObj, *defaultValueObj;
    Var *varPtr, *arrayPtr;
    int isArray, option;

		break;
    /*
     * Parse arguments.
     */

	    }
    if (objc != 3 && objc != 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
	    0, &option) != TCL_OK) {
	return TCL_ERROR;
    }

	    if (l1 == 0) {
    arrayNameObj = objv[2];

    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
	return TCL_ERROR;
    }

		return 1;
	    }
	}
    switch ((enum arrayDefaultOptionsEnum)option) {
    case OPT_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}
    }
	if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
	    return NotArrayError(interp, arrayNameObj);
	}

	defaultValueObj = TclGetArrayDefault(varPtr);
	if (!defaultValueObj) {
	    /* Array default must exist. */
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "array has no default value", -1));
	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, defaultValueObj);
	return TCL_OK;

    return 0;
}
    case OPT_SET:
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
	    return TCL_ERROR;
	}


static unsigned int
	/*
	 * Attempt to create array if needed.
	 */
	varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
		/*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
	if (varPtr == NULL) {
	    return TCL_ERROR;
	}
	if (arrayPtr) {
HashVarKey(
	    /*
	     * Not a valid array name.
	     */

	    CleanupVar(varPtr, arrayPtr);
    Tcl_HashTable *tablePtr,	/* Hash table. */
    void *keyPtr)		/* Key from which to compute hash value. */
	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    NEEDARRAY, -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(arrayNameObj), NULL);
	    return TCL_ERROR;
	}
	if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
	    /*
	     * Not an array.
	     */

{
	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
		    NEEDARRAY, -1);
	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
	    return TCL_ERROR;
	}

    Tcl_Obj *objPtr = (Tcl_Obj *) keyPtr;
	if (!TclIsVarArray(varPtr)) {
	    TclInitArrayVar(varPtr);
    const char *string = TclGetString(objPtr);
	}
	defaultValueObj = objv[3];
    int length = objPtr->length;
	SetArrayDefault(varPtr, defaultValueObj);
	return TCL_OK;

    unsigned int result = 0;
    case OPT_EXISTS:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}

    int i;
	/*
	 * Undefined variables (whether or not they have storage allocated) do
	 * not have defaults, and this is not an error case.
	 */

	if (!varPtr || TclIsVarUndefined(varPtr)) {
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
	} else if (!isArray) {
	    return NotArrayError(interp, arrayNameObj);
	} else {
	    defaultValueObj = TclGetArrayDefault(varPtr);
	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!defaultValueObj));
	}
	return TCL_OK;

    case OPT_UNSET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
	    return TCL_ERROR;
	}

	if (varPtr && !TclIsVarUndefined(varPtr)) {
	    if (!isArray) {
		return NotArrayError(interp, arrayNameObj);
	    }
	    SetArrayDefault(varPtr, NULL);
	}
	return TCL_OK;
    }

    /* Unreached */
    return TCL_ERROR;
}

/*
    /*
 * Initialize array variable.
 */

     * I tried a zillion different hash functions and asked many other people
void
TclInitArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)Tcl_Alloc(sizeof(ArrayVarHashTable));

     * for advice. Many people had their own favorite functions, all
    /*
     * Mark the variable as an array.
     */

     * different, but no-one had much idea why they were good ones. I chose
    TclSetVarArray(arrayPtr);

     * the one below (multiply by 9 and add new character) because of the
    /*
     * Regular TclVarHashTable initialization.
     */

     * following reasons:
    arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr;
    TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr));

    /*
     * Default value initialization.
     */

    tablePtr->defaultObj = NULL;
}

/*
 * Cleanup array variable.
 */

     *
static void
DeleteArrayVar(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

     * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
    /*
     * Default value cleanup.
     */

     *	  multiplying by 9 is just about as good.
    SetArrayDefault(arrayPtr, NULL);

     * 2. Times-9 is (shift-left-3) plus (old). This means that each
    /*
     * Regular TclVarHashTable cleanup.
     */

     *	  character's bits hang around in the low-order bits of the hash value
    VarHashDeleteTable(arrayPtr->value.tablePtr);
    Tcl_Free(tablePtr);
}

     *	  for ever, plus they spread fairly rapidly up to the high-order bits
/*
 * Get array default value if any.
 */

     *	  to fill out the hash value. This seems works well both for decimal
Tcl_Obj *
TclGetArrayDefault(
    Var *arrayPtr)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

     *	  and non-decimal strings.
    return tablePtr->defaultObj;
}

/*
 * Set/replace/unset array default value.
 */
     */

static void
SetArrayDefault(
    Var *arrayPtr,
    Tcl_Obj *defaultObj)
{
    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
	    arrayPtr->value.tablePtr;

    for (i=0 ; i<length ; i++) {
    /*
     * Increment/decrement refcount twice to ensure that the object is shared,
     * so that it doesn't get modified accidentally by the folling code:
     *
     *      array default set v 1
     *      lappend v(a) 2; # returns a new object {1 2}
     *      set v(b); # returns the original default object "1"
     */

	result += (result << 3) + string[i];
    if (tablePtr->defaultObj) {
        Tcl_DecrRefCount(tablePtr->defaultObj);
        Tcl_DecrRefCount(tablePtr->defaultObj);
    }
    tablePtr->defaultObj = defaultObj;
    if (tablePtr->defaultObj) {
    return result;
        Tcl_IncrRefCount(tablePtr->defaultObj);
        Tcl_IncrRefCount(tablePtr->defaultObj);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclZipfs.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
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
4955
4956
4957
4958
4959
4960
4961
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

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclZipfs.c --
 *
 *	Implementation of the ZIP filesystem used in TIP 430
 *	Adapted from the implentation for AndroWish.
 *
 * Copyright (c) 2016-2017 Sean Woods <yoda@etoyoc.com>
 * Copyright (c) 2013-2015 Christian Werner <chw@ch-werner.de>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This file is distributed in two ways:
 *   generic/tclZipfs.c file in the TIP430-enabled Tcl cores.
 *   compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430
 *	projects.
 */

#include "tclInt.h"
#include "tclFileSystem.h"

#ifndef _WIN32
#include <sys/mman.h>
#endif /* _WIN32*/

#ifndef MAP_FILE
#define MAP_FILE 0
#endif /* !MAP_FILE */
#define NOBYFOUR
#define crc32tab crc_table[0]
#ifndef TBLS
#define TBLS 1
#endif

#ifdef HAVE_ZLIB
#include "zlib.h"
#include "crypt.h"
#include "zutil.h"
#include "crc32.h"

#ifdef CFG_RUNTIME_DLLFILE

/*
** We are compiling as part of the core.
** TIP430 style zipfs prefix
*/

#define ZIPFS_VOLUME	  "//zipfs:/"
#define ZIPFS_VOLUME_LEN  9
#define ZIPFS_APP_MOUNT	  "//zipfs:/app"
#define ZIPFS_ZIP_MOUNT	  "//zipfs:/lib/tcl"

#else /* !CFG_RUNTIME_DLLFILE */

/*
** We are compiling from the /compat folder of tclconfig
** Pre TIP430 style zipfs prefix
** //zipfs:/ doesn't work straight out of the box on either windows or Unix
** without other changes made to tip 430
*/

#define ZIPFS_VOLUME	  "zipfs:/"
#define ZIPFS_VOLUME_LEN  7
#define ZIPFS_APP_MOUNT	  "zipfs:/app"
#define ZIPFS_ZIP_MOUNT	  "zipfs:/lib/tcl"

#endif /* CFG_RUNTIME_DLLFILE */

/*
 * Various constants and offsets found in ZIP archive files
 */

#define ZIP_SIG_LEN			4

/*
 * Local header of ZIP archive member (at very beginning of each member).
 */

#define ZIP_LOCAL_HEADER_SIG		0x04034b50
#define ZIP_LOCAL_HEADER_LEN		30
#define ZIP_LOCAL_SIG_OFFS		0
#define ZIP_LOCAL_VERSION_OFFS		4
#define ZIP_LOCAL_FLAGS_OFFS		6
#define ZIP_LOCAL_COMPMETH_OFFS		8
#define ZIP_LOCAL_MTIME_OFFS		10
#define ZIP_LOCAL_MDATE_OFFS		12
#define ZIP_LOCAL_CRC32_OFFS		14
#define ZIP_LOCAL_COMPLEN_OFFS		18
#define ZIP_LOCAL_UNCOMPLEN_OFFS	22
#define ZIP_LOCAL_PATHLEN_OFFS		26
#define ZIP_LOCAL_EXTRALEN_OFFS		28

/*
 * Central header of ZIP archive member at end of ZIP file.
 */

#define ZIP_CENTRAL_HEADER_SIG		0x02014b50
#define ZIP_CENTRAL_HEADER_LEN		46
#define ZIP_CENTRAL_SIG_OFFS		0
#define ZIP_CENTRAL_VERSIONMADE_OFFS	4
#define ZIP_CENTRAL_VERSION_OFFS	6
#define ZIP_CENTRAL_FLAGS_OFFS		8
#define ZIP_CENTRAL_COMPMETH_OFFS	10
#define ZIP_CENTRAL_MTIME_OFFS		12
#define ZIP_CENTRAL_MDATE_OFFS		14
#define ZIP_CENTRAL_CRC32_OFFS		16
#define ZIP_CENTRAL_COMPLEN_OFFS	20
#define ZIP_CENTRAL_UNCOMPLEN_OFFS	24
#define ZIP_CENTRAL_PATHLEN_OFFS	28
#define ZIP_CENTRAL_EXTRALEN_OFFS	30
#define ZIP_CENTRAL_FCOMMENTLEN_OFFS	32
#define ZIP_CENTRAL_DISKFILE_OFFS	34
#define ZIP_CENTRAL_IATTR_OFFS		36
#define ZIP_CENTRAL_EATTR_OFFS		38
#define ZIP_CENTRAL_LOCALHDR_OFFS	42

/*
 * Central end signature at very end of ZIP file.
 */

#define ZIP_CENTRAL_END_SIG		0x06054b50
#define ZIP_CENTRAL_END_LEN		22
#define ZIP_CENTRAL_END_SIG_OFFS	0
#define ZIP_CENTRAL_DISKNO_OFFS		4
#define ZIP_CENTRAL_DISKDIR_OFFS	6
#define ZIP_CENTRAL_ENTS_OFFS		8
#define ZIP_CENTRAL_TOTALENTS_OFFS	10
#define ZIP_CENTRAL_DIRSIZE_OFFS	12
#define ZIP_CENTRAL_DIRSTART_OFFS	16
#define ZIP_CENTRAL_COMMENTLEN_OFFS	20

#define ZIP_MIN_VERSION			20
#define ZIP_COMPMETH_STORED		0
#define ZIP_COMPMETH_DEFLATED		8

#define ZIP_PASSWORD_END_SIG		0x5a5a4b50

#define DEFAULT_WRITE_MAX_SIZE		(2 * 1024 * 1024)

/*
 * Macros to report errors only if an interp is present.
 */

#define ZIPFS_ERROR(interp,errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1));	\
	}								\
    } while (0)
#define ZIPFS_POSIX_ERROR(interp,errstr) \
    do {								\
	if (interp) {							\
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(			\
		    "%s: %s", errstr, Tcl_PosixError(interp)));		\
	}								\
    } while (0)

/*
 * Macros to read and write 16 and 32 bit integers from/to ZIP archives.
 */

#define ZipReadInt(p) \
    ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
#define ZipReadShort(p) \
    ((p)[0] | ((p)[1] << 8))

#define ZipWriteInt(p, v) \
    do {			     \
	(p)[0] = (v) & 0xff;	     \
	(p)[1] = ((v) >> 8) & 0xff;  \
	(p)[2] = ((v) >> 16) & 0xff; \
	(p)[3] = ((v) >> 24) & 0xff; \
    } while (0)
#define ZipWriteShort(p, v) \
    do {			    \
	(p)[0] = (v) & 0xff;	    \
	(p)[1] = ((v) >> 8) & 0xff; \
    } while (0)

/*
 * Windows drive letters.
 */

#ifdef _WIN32
static const char drvletters[] =
    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
#endif /* _WIN32 */

/*
 * Mutex to protect localtime(3) when no reentrant version available.
 */

#if !defined(_WIN32) && !defined(HAVE_LOCALTIME_R) && TCL_THREADS
TCL_DECLARE_MUTEX(localtimeMutex)
#endif /* !_WIN32 && !HAVE_LOCALTIME_R && TCL_THREADS */

/*
 * In-core description of mounted ZIP archive file.
 */

typedef struct ZipFile {
    char *name;			/* Archive name */
    size_t nameLength;		/* Length of archive name */
    char isMemBuffer;		/* When true, not a file but a memory buffer */
    Tcl_Channel chan;		/* Channel handle or NULL */
    unsigned char *data;	/* Memory mapped or malloc'ed file */
    size_t length;		/* Length of memory mapped file */
    void *ptrToFree;		/* Non-NULL if malloc'ed file */
    size_t numFiles;		/* Number of files in archive */
    size_t baseOffset;		/* Archive start */
    size_t passOffset;		/* Password start */
    size_t directoryOffset;	/* Archive directory start */
    unsigned char passBuf[264];	/* Password buffer */
    size_t numOpen;		/* Number of open files on archive */
    struct ZipEntry *entries;	/* List of files in archive */
    struct ZipEntry *topEnts;	/* List of top-level dirs in archive */
    char *mountPoint;		/* Mount point name */
    size_t mountPointLen;	/* Length of mount point name */
#ifdef _WIN32
    HANDLE mountHandle;		/* Handle used for direct file access. */
#endif /* _WIN32 */
} ZipFile;

/*
 * In-core description of file contained in mounted ZIP archive.
 */

typedef struct ZipEntry {
    char *name;			/* The full pathname of the virtual file */
    ZipFile *zipFilePtr;	/* The ZIP file holding this virtual file */
    Tcl_WideInt offset;		/* Data offset into memory mapped ZIP file */
    int numBytes;		/* Uncompressed size of the virtual file */
    int numCompressedBytes;	/* Compressed size of the virtual file */
    int compressMethod;		/* Compress method */
    int isDirectory;		/* Set to 1 if directory, or -1 if root */
    int depth;			/* Number of slashes in path. */
    int crc32;			/* CRC-32 */
    int timestamp;		/* Modification time */
    int isEncrypted;		/* True if data is encrypted */
    unsigned char *data;	/* File data if written */
    struct ZipEntry *next;	/* Next file in the same archive */
    struct ZipEntry *tnext;	/* Next top-level dir in archive */
} ZipEntry;

/*
 * File channel for file contained in mounted ZIP archive.
 */

typedef struct ZipChannel {
    ZipFile *zipFilePtr;	/* The ZIP file holding this channel */
    ZipEntry *zipEntryPtr;	/* Pointer back to virtual file */
    size_t maxWrite;		/* Maximum size for write */
    size_t numBytes;		/* Number of bytes of uncompressed data */
    size_t numRead;		/* Position of next byte to be read from the
				 * channel */
    unsigned char *ubuf;	/* Pointer to the uncompressed data */
    int iscompr;		/* True if data is compressed */
    int isDirectory;		/* Set to 1 if directory, or -1 if root */
    int isEncrypted;		/* True if data is encrypted */
    int isWriting;		/* True if open for writing */
    unsigned long keys[3];	/* Key for decryption */
} ZipChannel;

/*
 * Global variables.
 *
 * Most are kept in single ZipFS struct. When build with threading support
 * this struct is protected by the ZipFSMutex (see below).
 *
 * The "fileHash" component is the process wide global table of all known ZIP
 * archive members in all mounted ZIP archives.
 *
 * The "zipHash" components is the process wide global table of all mounted
 * ZIP archive files.
 */

static struct {
    int initialized;		/* True when initialized */
    int lock;			/* RW lock, see below */
    int waiters;		/* RW lock, see below */
    int wrmax;			/* Maximum write size of a file */
    int idCount;		/* Counter for channel names */
    Tcl_HashTable fileHash;	/* File name to ZipEntry mapping */
    Tcl_HashTable zipHash;	/* Mount to ZipFile mapping */
} ZipFS = {
    0, 0, 0, DEFAULT_WRITE_MAX_SIZE, 0,
	    {0,{0,0,0,0},0,0,0,0,0,0,0,0,0},
	    {0,{0,0,0,0},0,0,0,0,0,0,0,0,0}
};

/*
 * For password rotation.
 */

static const char pwrot[17] =
    "\x00\x80\x40\xC0\x20\xA0\x60\xE0"
    "\x10\x90\x50\xD0\x30\xB0\x70\xF0";

static const char *zipfs_literal_tcl_library = NULL;

/* Function prototypes */

static inline int	DescribeMounted(Tcl_Interp *interp,
			    const char *mountPoint);
static inline int	ListMountPoints(Tcl_Interp *interp);
static int		ZipfsAppHookFindTclInit(const char *archive);
static int		ZipFSPathInFilesystemProc(Tcl_Obj *pathPtr,
			    void **clientDataPtr);
static Tcl_Obj *	ZipFSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
static Tcl_Obj *	ZipFSFilesystemSeparatorProc(Tcl_Obj *pathPtr);
static int		ZipFSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
static int		ZipFSAccessProc(Tcl_Obj *pathPtr, int mode);
static Tcl_Channel	ZipFSOpenFileChannelProc(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int mode, int permissions);
static int		ZipFSMatchInDirectoryProc(Tcl_Interp *interp,
			    Tcl_Obj *result, Tcl_Obj *pathPtr,
			    const char *pattern, Tcl_GlobTypeData *types);
static Tcl_Obj *	ZipFSListVolumesProc(void);
static const char *const *ZipFSFileAttrStringsProc(Tcl_Obj *pathPtr,
			    Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsGetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
static int		ZipFSFileAttrsSetProc(Tcl_Interp *interp, int index,
			    Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
static int		ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
			    Tcl_LoadHandle *loadHandle,
			    Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
static void		ZipfsExitHandler(ClientData clientData);
static void		ZipfsSetup(void);
static int		ZipChannelClose(void *instanceData,
			    Tcl_Interp *interp, int flags);
static Tcl_DriverGetHandleProc	ZipChannelGetFile;
static int		ZipChannelRead(void *instanceData, char *buf,
			    int toRead, int *errloc);
static Tcl_WideInt ZipChannelWideSeek(void *instanceData, Tcl_WideInt offset,
			    int mode, int *errloc);
static void		ZipChannelWatchChannel(void *instanceData,
			    int mask);
static int		ZipChannelWrite(void *instanceData,
			    const char *buf, int toWrite, int *errloc);

/*
 * Define the ZIP filesystem dispatch table.
 */

static const Tcl_Filesystem zipfsFilesystem = {
    "zipfs",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    ZipFSPathInFilesystemProc,
    NULL, /* dupInternalRepProc */
    NULL, /* freeInternalRepProc */
    NULL, /* internalToNormalizedProc */
    NULL, /* createInternalRepProc */
    NULL, /* normalizePathProc */
    ZipFSFilesystemPathTypeProc,
    ZipFSFilesystemSeparatorProc,
    ZipFSStatProc,
    ZipFSAccessProc,
    ZipFSOpenFileChannelProc,
    ZipFSMatchInDirectoryProc,
    NULL, /* utimeProc */
    NULL, /* linkProc */
    ZipFSListVolumesProc,
    ZipFSFileAttrStringsProc,
    ZipFSFileAttrsGetProc,
    ZipFSFileAttrsSetProc,
    NULL, /* createDirectoryProc */
    NULL, /* removeDirectoryProc */
    NULL, /* deleteFileProc */
    NULL, /* copyFileProc */
    NULL, /* renameFileProc */
    NULL, /* copyDirectoryProc */
    NULL, /* lstatProc */
    (Tcl_FSLoadFileProc *)(void *)ZipFSLoadFile,
    NULL, /* getCwdProc */
    NULL, /* chdirProc */
};

/*
 * The channel type/driver definition used for ZIP archive members.
 */

static Tcl_ChannelType ZipChannelType = {
    "zip",		    /* Type name. */
    TCL_CHANNEL_VERSION_5,
    NULL,	    /* Close channel, clean instance data */
    ZipChannelRead,	    /* Handle read request */
    ZipChannelWrite,	    /* Handle write request */
	NULL,	    /* Move location of access point, NULL'able */
    NULL,		    /* Set options, NULL'able */
    NULL,		    /* Get options, NULL'able */
    ZipChannelWatchChannel, /* Initialize notifier */
    ZipChannelGetFile,	    /* Get OS handle from the channel */
    ZipChannelClose,	    /* 2nd version of close channel, NULL'able */
    NULL,		    /* Set blocking mode for raw channel, NULL'able */
    NULL,		    /* Function to flush channel, NULL'able */
    NULL,		    /* Function to handle event, NULL'able */
    ZipChannelWideSeek,	/* Wide seek function, NULL'able */
    NULL,		    /* Thread action function, NULL'able */
    NULL,		    /* Truncate function, NULL'able */
};

/*
 *-------------------------------------------------------------------------
 *
 * ReadLock, WriteLock, Unlock --
 *
 *	POSIX like rwlock functions to support multiple readers and single
 *	writer on internal structs.
 *
 *	Limitations:
 *	 - a read lock cannot be promoted to a write lock
 *	 - a write lock may not be nested
 *
 *-------------------------------------------------------------------------
 */

TCL_DECLARE_MUTEX(ZipFSMutex)

#if TCL_THREADS

static Tcl_Condition ZipFSCond;

static void
ReadLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock < 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock++;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
WriteLock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    while (ZipFS.lock != 0) {
	ZipFS.waiters++;
	Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
	ZipFS.waiters--;
    }
    ZipFS.lock = -1;
    Tcl_MutexUnlock(&ZipFSMutex);
}

static void
Unlock(void)
{
    Tcl_MutexLock(&ZipFSMutex);
    if (ZipFS.lock > 0) {
	--ZipFS.lock;
    } else if (ZipFS.lock < 0) {
	ZipFS.lock = 0;
    }
    if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) {
	Tcl_ConditionNotify(&ZipFSCond);
    }
    Tcl_MutexUnlock(&ZipFSMutex);
}

#else /* !TCL_THREADS */
#define ReadLock()	do {} while (0)
#define WriteLock()	do {} while (0)
#define Unlock()	do {} while (0)
#endif /* TCL_THREADS */

/*
 *-------------------------------------------------------------------------
 *
 * DosTimeDate, ToDosTime, ToDosDate --
 *
 *	Functions to perform conversions between DOS time stamps and POSIX
 *	time_t.
 *
 *-------------------------------------------------------------------------
 */

static time_t
DosTimeDate(
    int dosDate,
    int dosTime)
{
    struct tm tm;
    time_t ret;

    memset(&tm, 0, sizeof(tm));
    tm.tm_isdst = -1;			/* let mktime() deal with DST */
    tm.tm_year = ((dosDate & 0xfe00) >> 9) + 80;
    tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1;
    tm.tm_mday = dosDate & 0x1f;
    tm.tm_hour = (dosTime & 0xf800) >> 11;
    tm.tm_min = (dosTime & 0x7e0) >> 5;
    tm.tm_sec = (dosTime & 0x1f) << 1;
    ret = mktime(&tm);
    if (ret == (time_t) -1) {
	/* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */
	ret = (time_t) 315532800;
    }
    return ret;
}

static int
ToDosTime(
    time_t when)
{
    struct tm *tmp, tm;

#if !TCL_THREADS || defined(_WIN32)
    /* Not threaded, or on Win32 which uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#elif defined(HAVE_LOCALTIME_R)
    /* Threaded, have reentrant API */
    tmp = &tm;
    localtime_r(&when, tmp);
#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
    /* Only using a mutex is safe. */
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
    return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1);
}

static int
ToDosDate(
    time_t when)
{
    struct tm *tmp, tm;

#if !TCL_THREADS || defined(_WIN32)
    /* Not threaded, or on Win32 which uses thread local storage */
    tmp = localtime(&when);
    tm = *tmp;
#elif /* TCL_THREADS && !_WIN32 && */ defined(HAVE_LOCALTIME_R)
    /* Threaded, have reentrant API */
    tmp = &tm;
    localtime_r(&when, tmp);
#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
    /* Only using a mutex is safe. */
    Tcl_MutexLock(&localtimeMutex);
    tmp = localtime(&when);
    tm = *tmp;
    Tcl_MutexUnlock(&localtimeMutex);
#endif
    return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday;
}

/*
 *-------------------------------------------------------------------------
 *
 * CountSlashes --
 *
 *	This function counts the number of slashes in a pathname string.
 *
 * Results:
 *	Number of slashes found in string.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
CountSlashes(
    const char *string)
{
    int count = 0;
    const char *p = string;

    while (*p != '\0') {
	if (*p == '/') {
	    count++;
	}
	p++;
    }
    return count;
}

/*
 *-------------------------------------------------------------------------
 *
 * CanonicalPath --
 *
 *	This function computes the canonical path from a directory and file
 *	name components into the specified Tcl_DString.
 *
 * Results:
 *	Returns the pointer to the canonical path contained in the specified
 *	Tcl_DString.
 *
 * Side effects:
 *	Modifies the specified Tcl_DString.
 *
 *-------------------------------------------------------------------------
 */

static char *
CanonicalPath(
    const char *root,
    const char *tail,
    Tcl_DString *dsPtr,
    int inZipfs)
{
    char *path;
    int i, j, c, isUNC = 0, isVfs = 0, n = 0;
    int haveZipfsPath = 1;

#ifdef _WIN32
    if (tail[0] != '\0' && strchr(drvletters, tail[0]) && tail[1] == ':') {
	tail += 2;
	haveZipfsPath = 0;
    }
    /* UNC style path */
    if (tail[0] == '\\') {
	root = "";
	++tail;
	haveZipfsPath = 0;
    }
    if (tail[0] == '\\') {
	root = "/";
	++tail;
	haveZipfsPath = 0;
    }
#endif /* _WIN32 */

    if (haveZipfsPath) {
	/* UNC style path */
	if (root && strncmp(root, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
	    isVfs = 1;
	} else if (tail &&
		strncmp(tail, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
	    isVfs = 2;
	}
	if (isVfs != 1 && (root[0] == '/') && (root[1] == '/')) {
	    isUNC = 1;
	}
    }

    if (isVfs != 2) {
	if (tail[0] == '/') {
	    if (isVfs != 1) {
		root = "";
	    }
	    ++tail;
	    isUNC = 0;
	}
	if (tail[0] == '/') {
	    if (isVfs != 1) {
		root = "/";
	    }
	    ++tail;
	    isUNC = 1;
	}
    }
    i = strlen(root);
    j = strlen(tail);

    switch (isVfs) {
    case 1:
	if (i > ZIPFS_VOLUME_LEN) {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    memcpy(path + i, tail, j);
	}
	break;
    case 2:
	Tcl_DStringSetLength(dsPtr, j);
	path = Tcl_DStringValue(dsPtr);
	memcpy(path, tail, j);
	break;
    default:
	if (inZipfs) {
	    Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN);
	    memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j);
	} else {
	    Tcl_DStringSetLength(dsPtr, i + j + 1);
	    path = Tcl_DStringValue(dsPtr);
	    memcpy(path, root, i);
	    path[i++] = '/';
	    memcpy(path + i, tail, j);
	}
	break;
    }

#ifdef _WIN32
    for (i = 0; path[i] != '\0'; i++) {
	if (path[i] == '\\') {
	    path[i] = '/';
	}
    }
#endif /* _WIN32 */

    if (inZipfs) {
	n = ZIPFS_VOLUME_LEN;
    } else {
	n = 0;
    }

    for (i = j = n; (c = path[i]) != '\0'; i++) {
	if (c == '/') {
	    int c2 = path[i + 1];

	    if (c2 == '\0' || c2 == '/') {
		continue;
	    }
	    if (c2 == '.') {
		int c3 = path[i + 2];

		if ((c3 == '/') || (c3 == '\0')) {
		    i++;
		    continue;
		}
		if ((c3 == '.')
			&& ((path[i + 3] == '/') || (path[i + 3] == '\0'))) {
		    i += 2;
		    while ((j > 0) && (path[j - 1] != '/')) {
			j--;
		    }
		    if (j > isUNC) {
			--j;
			while ((j > 1 + isUNC) && (path[j - 2] == '/')) {
			    j--;
			}
		    }
		    continue;
		}
	    }
	}
	path[j++] = c;
    }
    if (j == 0) {
	path[j++] = '/';
    }
    path[j] = 0;
    Tcl_DStringSetLength(dsPtr, j);
    return Tcl_DStringValue(dsPtr);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookup --
 *
 *	This function returns the ZIP entry struct corresponding to the ZIP
 *	archive member of the given file name. Caller must hold the right
 *	lock.
 *
 * Results:
 *	Returns the pointer to ZIP entry struct or NULL if the the given file
 *	name could not be found in the global list of ZIP archive members.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static ZipEntry *
ZipFSLookup(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    ZipEntry *z = NULL;

    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
    if (hPtr) {
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
    }
    return z;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLookupMount --
 *
 *	This function returns an indication if the given file name corresponds
 *	to a mounted ZIP archive file.
 *
 * Results:
 *	Returns true, if the given file name is a mounted ZIP archive file.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

#ifdef NEVER_USED
static int
ZipFSLookupMount(
    char *filename)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	   hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = Tcl_GetHashValue(hPtr);

	if (strcmp(zf->mountPoint, filename) == 0) {
	    return 1;
	}
    }
    return 0;
}
#endif /* NEVER_USED */

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCloseArchive --
 *
 *	This function closes a mounted ZIP archive file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	A memory mapped ZIP archive is unmapped, allocated memory is released.
 *	The ZipFile pointer is *NOT* deallocated by this function.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipFSCloseArchive(
    Tcl_Interp *interp,		/* Current interpreter. */
    ZipFile *zf)
{
    if (zf->nameLength) {
	Tcl_Free(zf->name);
    }
    if (zf->isMemBuffer) {
	/* Pointer to memory */
	if (zf->ptrToFree) {
	    Tcl_Free(zf->ptrToFree);
	    zf->ptrToFree = NULL;
	}
	zf->data = NULL;
	return;
    }

#ifdef _WIN32
    if (zf->data && !zf->ptrToFree) {
	UnmapViewOfFile(zf->data);
	zf->data = NULL;
    }
    if (zf->mountHandle != INVALID_HANDLE_VALUE) {
	CloseHandle(zf->mountHandle);
    }
#else /* !_WIN32 */
    if ((zf->data != MAP_FAILED) && !zf->ptrToFree) {
	munmap(zf->data, zf->length);
	zf->data = (unsigned char *)MAP_FAILED;
    }
#endif /* _WIN32 */

    if (zf->ptrToFree) {
	Tcl_Free(zf->ptrToFree);
	zf->ptrToFree = NULL;
    }
    if (zf->chan) {
	Tcl_CloseEx(interp, zf->chan, 0);
	zf->chan = NULL;
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFindTOC --
 *
 *	This function takes a memory mapped zip file and indexes the contents.
 *	When "needZip" is zero an embedded ZIP archive in an executable file
 *	is accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	The given ZipFile struct is filled with information about the ZIP
 *	archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFindTOC(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    int needZip,
    ZipFile *zf)
{
    size_t i;
    unsigned char *p, *q;

    p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
    while (p >= zf->data) {
	if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
	    if (ZipReadInt(p) == ZIP_CENTRAL_END_SIG) {
		break;
	    }
	    p -= ZIP_SIG_LEN;
	} else {
	    --p;
	}
    }
    if (p < zf->data) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "wrong end signature");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
	}
	goto error;
    }
    zf->numFiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
    if (zf->numFiles == 0) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "empty archive");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	}
	goto error;
    }
    q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
    p -= ZipReadInt(p + ZIP_CENTRAL_DIRSIZE_OFFS);
    if ((p < zf->data) || (p > zf->data + zf->length)
	    || (q < zf->data) || (q > zf->data + zf->length)) {
	if (!needZip) {
	    zf->baseOffset = zf->passOffset = zf->length;
	    return TCL_OK;
	}
	ZIPFS_ERROR(interp, "archive directory not found");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
	}
	goto error;
    }
    zf->baseOffset = zf->passOffset = p - q;
    zf->directoryOffset = p - zf->data;
    q = p;
    for (i = 0; i < zf->numFiles; i++) {
	int pathlen, comlen, extra;

	if (q + ZIP_CENTRAL_HEADER_LEN > zf->data + zf->length) {
	    ZIPFS_ERROR(interp, "wrong header length");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
	    }
	    goto error;
	}
	if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
	    ZIPFS_ERROR(interp, "wrong header signature");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_SIG", NULL);
	    }
	    goto error;
	}
	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    q = zf->data + zf->baseOffset;
    if ((zf->baseOffset >= 6) && (ZipReadInt(q - 4) == ZIP_PASSWORD_END_SIG)) {
	i = q[-5];
	if (q - 5 - i > zf->data) {
	    zf->passBuf[0] = i;
	    memcpy(zf->passBuf + 1, q - 5 - i, i);
	    zf->passOffset -= i ? (5 + i) : 0;
	}
    }
    return TCL_OK;

  error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenArchive --
 *
 *	This function opens a ZIP archive file for reading. An attempt is made
 *	to memory map that file. Otherwise it is read into an allocated memory
 *	buffer. The ZIP archive header is verified and must be valid for the
 *	function to succeed. When "needZip" is zero an embedded ZIP archive in
 *	an executable file is accepted.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	ZIP archive is memory mapped or read into allocated memory, the given
 *	ZipFile struct is filled with information about the ZIP archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSOpenArchive(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *zipname,	/* Path to ZIP file to open. */
    int needZip,
    ZipFile *zf)
{
    size_t i;
    void *handle;

    zf->nameLength = 0;
    zf->isMemBuffer = 0;
#ifdef _WIN32
    zf->data = NULL;
    zf->mountHandle = INVALID_HANDLE_VALUE;
#else /* !_WIN32 */
    zf->data = (unsigned char *)MAP_FAILED;
#endif /* _WIN32 */
    zf->length = 0;
    zf->numFiles = 0;
    zf->baseOffset = zf->passOffset = 0;
    zf->ptrToFree = NULL;
    zf->passBuf[0] = 0;
    zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
    if (!zf->chan) {
	return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
	zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
	if (zf->length == TCL_IO_FAILURE) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	if ((zf->length - ZIP_CENTRAL_END_LEN)
		> (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_ERROR(interp, "illegal file size");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
	if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) {
	    ZIPFS_POSIX_ERROR(interp, "seek error");
	    goto error;
	}
	zf->ptrToFree = zf->data = (unsigned char *)Tcl_AttemptAlloc(zf->length);
	if (!zf->ptrToFree) {
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    goto error;
	}
	i = Tcl_Read(zf->chan, (char *) zf->data, zf->length);
	if (i != zf->length) {
	    ZIPFS_POSIX_ERROR(interp, "file read error");
	    goto error;
	}
	Tcl_CloseEx(interp, zf->chan, 0);
	zf->chan = NULL;
    } else {
#ifdef _WIN32
	int readSuccessful;
#   ifdef _WIN64
	i = GetFileSizeEx((HANDLE) handle, (PLARGE_INTEGER) &zf->length);
	readSuccessful = (i != 0);
#   else /* !_WIN64 */
	zf->length = GetFileSize((HANDLE) handle, 0);
	readSuccessful = (zf->length != (size_t) INVALID_FILE_SIZE);
#   endif /* _WIN64 */
	if (!readSuccessful || (zf->length < ZIP_CENTRAL_END_LEN)) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	zf->mountHandle = CreateFileMappingW((HANDLE) handle, 0, PAGE_READONLY,
		0, zf->length, 0);
	if (zf->mountHandle == INVALID_HANDLE_VALUE) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
	zf->data = (unsigned char *)MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0,
		zf->length);
	if (!zf->data) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#else /* !_WIN32 */
	zf->length = lseek(PTR2INT(handle), 0, SEEK_END);
	if (zf->length == TCL_IO_FAILURE || zf->length < ZIP_CENTRAL_END_LEN) {
	    ZIPFS_POSIX_ERROR(interp, "invalid file size");
	    goto error;
	}
	lseek(PTR2INT(handle), 0, SEEK_SET);
	zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ,
		MAP_FILE | MAP_PRIVATE, PTR2INT(handle), 0);
	if (zf->data == MAP_FAILED) {
	    ZIPFS_POSIX_ERROR(interp, "file mapping failed");
	    goto error;
	}
#endif /* _WIN32 */
    }
    return ZipFSFindTOC(interp, needZip, zf);

  error:
    ZipFSCloseArchive(interp, zf);
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSRootNode --
 *
 *	This function generates the root node for a ZIPFS filesystem.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with an error message placed
 *	into the given "interp" if it is not NULL.
 *
 * Side effects:
 *	...
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSCatalogFilesystem(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    ZipFile *zf0,
    const char *mountPoint,	/* Mount point path. */
    const char *passwd,		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
    const char *zipname)	/* Path to ZIP file to build a catalog of. */
{
    int pwlen, isNew;
    size_t i;
    ZipFile *zf;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_DString ds, dsm, fpBuf;
    unsigned char *q;

    /*
     * Basic verification of the password for sanity.
     */

    pwlen = 0;
    if (passwd) {
	pwlen = strlen(passwd);
	if ((pwlen > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }

    WriteLock();

    /*
     * Mount point sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */

    Tcl_DStringInit(&ds);
    Tcl_DStringInit(&dsm);
    if (strcmp(mountPoint, "/") == 0) {
	mountPoint = "";
    } else {
	mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
    }
    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew);
    if (!isNew) {
	if (interp) {
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s is already mounted on %s", zf->name, mountPoint));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "MOUNTED", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	Unlock();
	ZipFSCloseArchive(interp, zf0);
	return TCL_ERROR;
    }
    Unlock();

    *zf = *zf0;
    zf->mountPoint = (char *)Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
    Tcl_CreateExitHandler(ZipfsExitHandler, zf);
    zf->mountPointLen = strlen(zf->mountPoint);
    zf->nameLength = strlen(zipname);
    zf->name = (char *)Tcl_Alloc(zf->nameLength + 1);
    memcpy(zf->name, zipname, zf->nameLength + 1);
    zf->entries = NULL;
    zf->topEnts = NULL;
    zf->numOpen = 0;
    Tcl_SetHashValue(hPtr, zf);
    if ((zf->passBuf[0] == 0) && pwlen) {
	int k = 0;

	zf->passBuf[k++] = pwlen;
	for (i = pwlen; i-- > 0 ;) {
	    zf->passBuf[k++] = (passwd[i] & 0x0f)
		    | pwrot[(passwd[i] >> 4) & 0x0f];
	}
	zf->passBuf[k] = '\0';
    }
    if (mountPoint[0] != '\0') {
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew);
	if (isNew) {
	    z = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));
	    Tcl_SetHashValue(hPtr, z);

	    z->tnext = NULL;
	    z->depth = CountSlashes(mountPoint);
	    z->zipFilePtr = zf;
	    z->isDirectory = (zf->baseOffset == 0) ? 1 : -1; /* root marker */
	    z->isEncrypted = 0;
	    z->offset = zf->baseOffset;
	    z->crc32 = 0;
	    z->timestamp = 0;
	    z->numBytes = z->numCompressedBytes = 0;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->data = NULL;
	    z->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	}
    }
    q = zf->data + zf->directoryOffset;
    Tcl_DStringInit(&fpBuf);
    for (i = 0; i < zf->numFiles; i++) {
	int extra, isdir = 0, dosTime, dosDate, nbcompr;
	size_t offs, pathlen, comlen;
	unsigned char *lq, *gq = NULL;
	char *fullpath, *path;

	pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
	comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
	extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
	Tcl_DStringSetLength(&ds, 0);
	Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
	path = Tcl_DStringValue(&ds);
	if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
	    Tcl_DStringSetLength(&ds, pathlen - 1);
	    path = Tcl_DStringValue(&ds);
	    isdir = 1;
	}
	if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
	    goto nextent;
	}
	lq = zf->data + zf->baseOffset
		+ ZipReadInt(q + ZIP_CENTRAL_LOCALHDR_OFFS);
	if ((lq < zf->data) || (lq > zf->data + zf->length)) {
	    goto nextent;
	}
	nbcompr = ZipReadInt(lq + ZIP_LOCAL_COMPLEN_OFFS);
	if (!isdir && (nbcompr == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
		&& (ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
	    gq = q;
	    nbcompr = ZipReadInt(gq + ZIP_CENTRAL_COMPLEN_OFFS);
	}
	offs = (lq - zf->data)
		+ ZIP_LOCAL_HEADER_LEN
		+ ZipReadShort(lq + ZIP_LOCAL_PATHLEN_OFFS)
		+ ZipReadShort(lq + ZIP_LOCAL_EXTRALEN_OFFS);
	if (offs + nbcompr > zf->length) {
	    goto nextent;
	}
	if (!isdir && (mountPoint[0] == '\0') && !CountSlashes(path)) {
#ifdef ANDROID
	    /*
	     * When mounting the ZIP archive on the root directory try to
	     * remap top level regular files of the archive to
	     * /assets/.root/... since this directory should not be in a valid
	     * APK due to the leading dot in the file name component. This
	     * trick should make the files AndroidManifest.xml,
	     * resources.arsc, and classes.dex visible to Tcl.
	     */
	    Tcl_DString ds2;

	    Tcl_DStringInit(&ds2);
	    Tcl_DStringAppend(&ds2, "assets/.root/", -1);
	    Tcl_DStringAppend(&ds2, path, -1);
	    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
	    if (hPtr) {
		/* should not happen but skip it anyway */
		Tcl_DStringFree(&ds2);
		goto nextent;
	    }
	    Tcl_DStringSetLength(&ds, 0);
	    Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2),
		    Tcl_DStringLength(&ds2));
	    path = Tcl_DStringValue(&ds);
	    Tcl_DStringFree(&ds2);
#else /* !ANDROID */
	    /*
	     * Regular files skipped when mounting on root.
	     */
	    goto nextent;
#endif /* ANDROID */
	}
	Tcl_DStringSetLength(&fpBuf, 0);
	fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1);
	z = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));
	z->name = NULL;
	z->tnext = NULL;
	z->depth = CountSlashes(fullpath);
	z->zipFilePtr = zf;
	z->isDirectory = isdir;
	z->isEncrypted = (ZipReadShort(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
		&& (nbcompr > 12);
	z->offset = offs;
	if (gq) {
	    z->crc32 = ZipReadInt(gq + ZIP_CENTRAL_CRC32_OFFS);
	    dosDate = ZipReadShort(gq + ZIP_CENTRAL_MDATE_OFFS);
	    dosTime = ZipReadShort(gq + ZIP_CENTRAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(gq + ZIP_CENTRAL_COMPMETH_OFFS);
	} else {
	    z->crc32 = ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS);
	    dosDate = ZipReadShort(lq + ZIP_LOCAL_MDATE_OFFS);
	    dosTime = ZipReadShort(lq + ZIP_LOCAL_MTIME_OFFS);
	    z->timestamp = DosTimeDate(dosDate, dosTime);
	    z->numBytes = ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
	    z->compressMethod = ZipReadShort(lq + ZIP_LOCAL_COMPMETH_OFFS);
	}
	z->numCompressedBytes = nbcompr;
	z->data = NULL;
	hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
	if (!isNew) {
	    /* should not happen but skip it anyway */
	    Tcl_Free(z);
	} else {
	    Tcl_SetHashValue(hPtr, z);
	    z->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
	    z->next = zf->entries;
	    zf->entries = z;
	    if (isdir && (mountPoint[0] == '\0') && (z->depth == 1)) {
		z->tnext = zf->topEnts;
		zf->topEnts = z;
	    }
	    if (!z->isDirectory && (z->depth > 1)) {
		char *dir, *end;
		ZipEntry *zd;

		Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
		Tcl_DStringSetLength(&ds, 0);
		Tcl_DStringAppend(&ds, z->name, -1);
		dir = Tcl_DStringValue(&ds);
		for (end = strrchr(dir, '/'); end && (end != dir);
			end = strrchr(dir, '/')) {
		    Tcl_DStringSetLength(&ds, end - dir);
		    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
		    if (!isNew) {
			break;
		    }
		    zd = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));
		    zd->name = NULL;
		    zd->tnext = NULL;
		    zd->depth = CountSlashes(dir);
		    zd->zipFilePtr = zf;
		    zd->isDirectory = 1;
		    zd->isEncrypted = 0;
		    zd->offset = z->offset;
		    zd->crc32 = 0;
		    zd->timestamp = z->timestamp;
		    zd->numBytes = zd->numCompressedBytes = 0;
		    zd->compressMethod = ZIP_COMPMETH_STORED;
		    zd->data = NULL;
		    Tcl_SetHashValue(hPtr, zd);
		    zd->name = (char *)Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
		    zd->next = zf->entries;
		    zf->entries = zd;
		    if ((mountPoint[0] == '\0') && (zd->depth == 1)) {
			zd->tnext = zf->topEnts;
			zf->topEnts = zd;
		    }
		}
	    }
	}
    nextent:
	q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
    }
    Tcl_DStringFree(&fpBuf);
    Tcl_DStringFree(&ds);
    Tcl_FSMountsChanged(NULL);
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipfsSetup --
 *
 *	Common initialisation code. ZipFS.initialized must *not* be set prior
 *	to the call.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipfsSetup(void)
{
#if TCL_THREADS
    static const Tcl_Time t = { 0, 0 };

    /*
     * Inflate condition variable.
     */

    Tcl_MutexLock(&ZipFSMutex);
    Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t);
    Tcl_MutexUnlock(&ZipFSMutex);
#endif /* TCL_THREADS */

    Tcl_FSRegister(NULL, &zipfsFilesystem);
    Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
    Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
    ZipFS.idCount = 1;
    ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
    ZipFS.initialized = 1;
}

/*
 *-------------------------------------------------------------------------
 *
 * ListMountPoints --
 *
 *	This procedure lists the mount points and what's mounted there, or
 *	reports whether there are any mounts (if there's no interpreter). The
 *	read lock must be held by the caller.
 *
 * Results:
 *	A standard Tcl result. TCL_OK (or TCL_BREAK if no mounts and no
 *	interpreter).
 *
 * Side effects:
 *	Interpreter result may be updated.
 *
 *-------------------------------------------------------------------------
 */

static inline int
ListMountPoints(
    Tcl_Interp *interp)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    ZipFile *zf;

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	if (!interp) {
	    return TCL_OK;
	}
	zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	Tcl_AppendElement(interp, zf->mountPoint);
	Tcl_AppendElement(interp, zf->name);
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
 *-------------------------------------------------------------------------
 *
 * DescribeMounted --
 *
 *	This procedure describes what is mounted at the given the mount point.
 *	The interpreter result is not updated if there is nothing mounted at
 *	the given point. The read lock must be held by the caller.
 *
 * Results:
 *	A standard Tcl result. TCL_OK (or TCL_BREAK if nothing mounted there
 *	and no interpreter).
 *
 * Side effects:
 *	Interpreter result may be updated.
 *
 *-------------------------------------------------------------------------
 */

static inline int
DescribeMounted(
    Tcl_Interp *interp,
    const char *mountPoint)
{
    Tcl_HashEntry *hPtr;
    ZipFile *zf;

    if (interp) {
	hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
	if (hPtr) {
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1));
	    return TCL_OK;
	}
    }
    return (interp ? TCL_OK : TCL_BREAK);
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Mount --
 *
 *	This procedure is invoked to mount a given ZIP archive file on a given
 *	mountpoint with optional ZIP password.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    const char *zipname,	/* Path to ZIP file to mount. */
    const char *passwd)		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
{
    ZipFile *zf;

    ReadLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }

    /*
     * No mount point, so list all mount points and what is mounted there.
     */

    if (!mountPoint) {
	int ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    /*
     * Mount point but no file, so describe what is mounted at that mount
     * point.
     */

    if (!zipname) {
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }
    Unlock();

    /*
     * Have both a mount point and a file (name) to mount there.
     */

    if (passwd) {
	if ((strlen(passwd) > 255) || strchr(passwd, 0xff)) {
	    if (interp) {
		Tcl_SetObjResult(interp,
			Tcl_NewStringObj("illegal password", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    }
	    return TCL_ERROR;
	}
    }
    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
	Tcl_Free(zf);
	return TCL_ERROR;
    }
    if (ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname)
	    != TCL_OK) {
	Tcl_Free(zf);
	return TCL_ERROR;
    }
    Tcl_Free(zf);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_MountBuffer --
 *
 *	This procedure is invoked to mount a given ZIP archive file on a given
 *	mountpoint with optional ZIP password.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is read, analyzed and mounted, resources are
 *	allocated.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_MountBuffer(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    unsigned char *data,
    size_t datalen,
    int copy)
{
    ZipFile *zf;
    int result;

    ReadLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }

    /*
     * No mount point, so list all mount points and what is mounted there.
     */

    if (!mountPoint) {
	int ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    /*
     * Mount point but no data, so describe what is mounted at that mount
     * point.
     */

    if (!data) {
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }
    Unlock();

    /*
     * Have both a mount point and data to mount there.
     */

    zf = (ZipFile *)Tcl_AttemptAlloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
    if (!zf) {
	if (interp) {
	    Tcl_AppendResult(interp, "out of memory", (char *) NULL);
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	return TCL_ERROR;
    }
    zf->isMemBuffer = 1;
    zf->length = datalen;
    if (copy) {
	zf->data = (unsigned char *)Tcl_AttemptAlloc(datalen);
	if (!zf->data) {
	    if (interp) {
		Tcl_AppendResult(interp, "out of memory", (char *) NULL);
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    return TCL_ERROR;
	}
	memcpy(zf->data, data, datalen);
	zf->ptrToFree = zf->data;
    } else {
	zf->data = data;
	zf->ptrToFree = NULL;
    }
    zf->passBuf[0] = 0;	/* stop valgrind cries */
    if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
	return TCL_ERROR;
    }
    result = ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
	    "Memory Buffer");
    Tcl_Free(zf);
    return result;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Unmount --
 *
 *	This procedure is invoked to unmount a given ZIP archive.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint)	/* Mount point path. */
{
    ZipFile *zf;
    ZipEntry *z, *znext;
    Tcl_HashEntry *hPtr;
    Tcl_DString dsm;
    int ret = TCL_OK, unmounted = 0;

    WriteLock();
    if (!ZipFS.initialized) {
	goto done;
    }

    /*
     * Mount point sometimes is a relative or otherwise denormalized path.
     * But an absolute name is needed as mount point here.
     */

    Tcl_DStringInit(&dsm);
    mountPoint = CanonicalPath("", mountPoint, &dsm, 1);

    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
    /* don't report no-such-mount as an error */
    if (!hPtr) {
	goto done;
    }

    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
    if (zf->numOpen > 0) {
	ZIPFS_ERROR(interp, "filesystem is busy");
	ret = TCL_ERROR;
	goto done;
    }
    Tcl_DeleteHashEntry(hPtr);
    for (z = zf->entries; z; z = znext) {
	znext = z->next;
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
	if (z->data) {
	    Tcl_Free(z->data);
	}
	Tcl_Free(z);
    }
    ZipFSCloseArchive(interp, zf);
    Tcl_DeleteExitHandler(ZipfsExitHandler, zf);
    Tcl_Free(zf);
    unmounted = 1;
  done:
    Unlock();
    if (unmounted) {
	Tcl_FSMountsChanged(NULL);
    }
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mount] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is mounted, resources are allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMountObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    if (objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv,
		 "?mountpoint? ?zipfile? ?password?");
	return TCL_ERROR;
    }

    return TclZipfs_Mount(interp, (objc > 1) ? TclGetString(objv[1]) : NULL,
	    (objc > 2) ? TclGetString(objv[2]) : NULL,
	    (objc > 3) ? TclGetString(objv[3]) : NULL);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMountBufferObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mount_data] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A ZIP archive file is mounted, resources are allocated.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMountBufferObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    const char *mountPoint;	/* Mount point path. */
    unsigned char *data;
    size_t length = 0;

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
	return TCL_ERROR;
    }
    if (objc < 2) {
	int ret;

	ReadLock();
	ret = ListMountPoints(interp);
	Unlock();
	return ret;
    }

    mountPoint = TclGetString(objv[1]);
    if (objc < 3) {
	ReadLock();
	DescribeMounted(interp, mountPoint);
	Unlock();
	return TCL_OK;
    }

    data = TclGetBytesFromObj(interp, objv[2], &length);
    if (data == NULL) {
	return TCL_ERROR;
    }
    return TclZipfs_MountBuffer(interp, mountPoint, data, length, 1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSRootObjCmd --
 *
 *	This procedure is invoked to process the [zipfs root] command. It
 *	returns the root that all zipfs file systems are mounted under.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSRootObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *)) /*objv*/
{
    Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSUnmountObjCmd --
 *
 *	This procedure is invoked to process the [zipfs unmount] command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A mounted ZIP archive file is unmounted, resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSUnmountObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
	return TCL_ERROR;
    }
    return TclZipfs_Unmount(interp, TclGetString(objv[1]));
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkKeyObjCmd --
 *
 *	This procedure is invoked to process the [zipfs mkkey] command.  It
 *	produces a rotated password to be embedded into an image file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkKeyObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int len, i = 0;
    char *pw, passBuf[264];

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "password");
	return TCL_ERROR;
    }
    pw = TclGetString(objv[1]);
    len = strlen(pw);
    if (len == 0) {
	return TCL_OK;
    }
    if ((len > 255) || strchr(pw, 0xff)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1));
	return TCL_ERROR;
    }
    while (len > 0) {
	int ch = pw[len - 1];

	passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	i++;
	len--;
    }
    passBuf[i] = i;
    ++i;
    passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
    passBuf[i] = '\0';
    Tcl_AppendResult(interp, passBuf, (char *) NULL);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipAddFile --
 *
 *	This procedure is used by ZipFSMkZipOrImgCmd() to add a single file to
 *	the output ZIP archive file being written. A ZipEntry struct about the
 *	input file is added to the given fileHash table for later creation of
 *	the central ZIP directory.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Input file is read and (compressed and) written to the output ZIP
 *	archive file.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipAddFile(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *path,
    const char *name,
    Tcl_Channel out,
    const char *passwd,		/* Password for encoding the file, or NULL if
				 * the file is to be unprotected. */
    char *buf,
    int bufsize,
    Tcl_HashTable *fileHash)
{
    Tcl_Channel in;
    Tcl_HashEntry *hPtr;
    ZipEntry *z;
    z_stream stream;
    const char *zpath;
    int crc, flush, zpathlen;
    size_t nbyte, nbytecompr, len, olen, align = 0;
    Tcl_WideInt pos[3];
    int mtime = 0, isNew, compMeth;
    unsigned long keys[3], keys0[3];
    char obuf[4096];

    /*
     * Trim leading '/' characters. If this results in an empty string, we've
     * nothing to do.
     */

    zpath = name;
    while (zpath && zpath[0] == '/') {
	zpath++;
    }
    if (!zpath || (zpath[0] == '\0')) {
	return TCL_OK;
    }

    zpathlen = strlen(zpath);
    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"path too long for \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "PATH_LEN", NULL);
	return TCL_ERROR;
    }
    in = Tcl_OpenFileChannel(interp, path, "rb", 0);
    if (!in) {
#ifdef _WIN32
	/* hopefully a directory */
	if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_OK;
	}
#endif /* _WIN32 */
	Tcl_CloseEx(interp, in, 0);
	return TCL_ERROR;
    } else {
	Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
	Tcl_StatBuf statBuf;

	Tcl_IncrRefCount(pathObj);
	if (Tcl_FSStat(pathObj, &statBuf) != -1) {
	    mtime = statBuf.st_mtime;
	}
	Tcl_DecrRefCount(pathObj);
    }
    Tcl_ResetResult(interp);
    crc = 0;
    nbyte = nbytecompr = 0;
    while (1) {
	len = Tcl_Read(in, buf, bufsize);
	if (len == TCL_IO_FAILURE) {
	    if (nbyte == 0 && errno == EISDIR) {
		Tcl_CloseEx(interp, in, 0);
		return TCL_OK;
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
		    path, Tcl_PosixError(interp)));
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_ERROR;
	}
	if (len == 0) {
	    break;
	}
	crc = crc32(crc, (unsigned char *) buf, len);
	nbyte += len;
    }
    if (Tcl_Seek(in, 0, SEEK_SET) == -1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s",
		path, Tcl_PosixError(interp)));
	Tcl_CloseEx(interp, in, 0);
	return TCL_ERROR;
    }
    pos[0] = Tcl_Tell(out);
    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
    if (Tcl_Write(out, buf, len) != len) {
    wrerr:
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error on %s: %s", path, Tcl_PosixError(interp)));
	Tcl_CloseEx(interp, in, 0);
	return TCL_ERROR;
    }
    if ((len + pos[0]) & 3) {
	unsigned char abuf[8];

	/*
	 * Align payload to next 4-byte boundary using a dummy extra entry
	 * similar to the zipalign tool from Android's SDK.
	 */

	align = 4 + ((len + pos[0]) & 3);
	ZipWriteShort(abuf, 0xffff);
	ZipWriteShort(abuf + 2, align - 4);
	ZipWriteInt(abuf + 4, 0x03020100);
	if (Tcl_Write(out, (const char *) abuf, align) != align) {
	    goto wrerr;
	}
    }
    if (passwd) {
	int i, ch, tmp;
	unsigned char kvbuf[24];
	Tcl_Obj *ret;

	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    double r;

	    if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", -1, 0) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    ret = Tcl_GetObjResult(interp);
	    if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) {
		Tcl_Obj *eiPtr = Tcl_ObjPrintf(
			"\n    (evaluating PRNG step %d for password encoding)",
			i);

		Tcl_AppendObjToErrorInfo(interp, eiPtr);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    ch = (int) (r * 256);
	    kvbuf[i + 12] = UCHAR(zencode(keys, crc32tab, ch, tmp));
	}
	Tcl_ResetResult(interp);
	init_keys(passwd, keys, crc32tab);
	for (i = 0; i < 12 - 2; i++) {
	    kvbuf[i] = UCHAR(zencode(keys, crc32tab, kvbuf[i + 12], tmp));
	}
	kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 16, tmp));
	kvbuf[i++] = UCHAR(zencode(keys, crc32tab, crc >> 24, tmp));
	len = Tcl_Write(out, (char *) kvbuf, 12);
	memset(kvbuf, 0, 24);
	if (len != 12) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error on %s: %s", path, Tcl_PosixError(interp)));
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_ERROR;
	}
	memcpy(keys0, keys, sizeof(keys0));
	nbytecompr += 12;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    compMeth = ZIP_COMPMETH_DEFLATED;
    memset(&stream, 0, sizeof(z_stream));
    stream.zalloc = Z_NULL;
    stream.zfree = Z_NULL;
    stream.opaque = Z_NULL;
    if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8,
	    Z_DEFAULT_STRATEGY) != Z_OK) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"compression init error on \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL);
	Tcl_CloseEx(interp, in, 0);
	return TCL_ERROR;
    }
    do {
	len = Tcl_Read(in, buf, bufsize);
	if (len == TCL_IO_FAILURE) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "read error on %s: %s", path, Tcl_PosixError(interp)));
	    deflateEnd(&stream);
	    Tcl_CloseEx(interp, in, 0);
	    return TCL_ERROR;
	}
	stream.avail_in = len;
	stream.next_in = (unsigned char *) buf;
	flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
	do {
	    stream.avail_out = sizeof(obuf);
	    stream.next_out = (unsigned char *) obuf;
	    len = deflate(&stream, flush);
	    if (len == (size_t) Z_STREAM_ERROR) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"deflate error on %s", path));
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE", NULL);
		deflateEnd(&stream);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    olen = sizeof(obuf) - stream.avail_out;
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < olen; i++) {
		    obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp);
		}
	    }
	    if (olen && (Tcl_Write(out, obuf, olen) != olen)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		deflateEnd(&stream);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    nbytecompr += olen;
	} while (stream.avail_out == 0);
    } while (flush != Z_FINISH);
    deflateEnd(&stream);
    Tcl_Flush(out);
    pos[1] = Tcl_Tell(out);
    if (nbyte - nbytecompr <= 0) {
	/*
	 * Compressed file larger than input, write it again uncompressed.
	 */
	if (Tcl_Seek(in, 0, SEEK_SET) != 0) {
	    goto seekErr;
	}
	if (Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) {
	seekErr:
	    Tcl_CloseEx(interp, in, 0);
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "seek error: %s", Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}
	nbytecompr = (passwd ? 12 : 0);
	while (1) {
	    len = Tcl_Read(in, buf, bufsize);
	    if (len == TCL_IO_FAILURE) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read error on \"%s\": %s",
			path, Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    } else if (len == 0) {
		break;
	    }
	    if (passwd) {
		size_t i;
		int tmp;

		for (i = 0; i < len; i++) {
		    buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp);
		}
	    }
	    if (Tcl_Write(out, buf, len) != len) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    nbytecompr += len;
	}
	compMeth = ZIP_COMPMETH_STORED;
	Tcl_Flush(out);
	pos[1] = Tcl_Tell(out);
	Tcl_TruncateChannel(out, pos[1]);
    }
    Tcl_CloseEx(interp, in, 0);

    hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
    if (!isNew) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"non-unique path name \"%s\"", path));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL);
	return TCL_ERROR;
    }

    z = (ZipEntry *)Tcl_Alloc(sizeof(ZipEntry));
    Tcl_SetHashValue(hPtr, z);
    z->name = NULL;
    z->tnext = NULL;
    z->depth = 0;
    z->zipFilePtr = NULL;
    z->isDirectory = 0;
    z->isEncrypted = (passwd ? 1 : 0);
    z->offset = pos[0];
    z->crc32 = crc;
    z->timestamp = mtime;
    z->numBytes = nbyte;
    z->numCompressedBytes = nbytecompr;
    z->compressMethod = compMeth;
    z->data = NULL;
    z->name = (char *)Tcl_GetHashKey(fileHash, hPtr);
    z->next = NULL;

    /*
     * Write final local header information.
     */
    ZipWriteInt(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
    ZipWriteShort(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
    ZipWriteShort(buf + ZIP_LOCAL_FLAGS_OFFS, z->isEncrypted);
    ZipWriteShort(buf + ZIP_LOCAL_COMPMETH_OFFS, z->compressMethod);
    ZipWriteShort(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp));
    ZipWriteShort(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp));
    ZipWriteInt(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
    ZipWriteInt(buf + ZIP_LOCAL_COMPLEN_OFFS, z->numCompressedBytes);
    ZipWriteInt(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes);
    ZipWriteShort(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen);
    ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
    if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    Tcl_Flush(out);
    if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) {
	Tcl_DeleteHashEntry(hPtr);
	Tcl_Free(z);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"seek error: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipOrImgObjCmd --
 *
 *	This procedure is creates a new ZIP archive file or image file given
 *	output filename, input directory of files to be archived, optional
 *	password, and optional image to be prepended to the output ZIP archive
 *	file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	A new ZIP archive file or image file is written.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipOrImgObjCmd(
    Tcl_Interp *interp,		/* Current interpreter. */
    int isImg,
    int isList,
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Tcl_Channel out;
    int pwlen = 0, count, ret = TCL_ERROR, lobjc;
    size_t len, slen = 0, i = 0;
    Tcl_WideInt pos[3];
    Tcl_Obj **lobjv, *list = NULL;
    ZipEntry *z;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_HashTable fileHash;
    char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];

    /*
     * Caller has verified that the number of arguments is correct.
     */

    passBuf[0] = 0;
    if (objc > (isList ? 3 : 4)) {
	pw = TclGetString(objv[isList ? 3 : 4]);
	pwlen = strlen(pw);
	if ((pwlen > 255) || strchr(pw, 0xff)) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("illegal password", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
	    return TCL_ERROR;
	}
    }
    if (isList) {
	list = objv[2];
	Tcl_IncrRefCount(list);
    } else {
	Tcl_Obj *cmd[3];

	cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1);
	cmd[2] = objv[2];
	cmd[0] = Tcl_NewListObj(2, cmd + 1);
	Tcl_IncrRefCount(cmd[0]);
	if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
	    Tcl_DecrRefCount(cmd[0]);
	    return TCL_ERROR;
	}
	Tcl_DecrRefCount(cmd[0]);
	list = Tcl_GetObjResult(interp);
	Tcl_IncrRefCount(list);
    }
    if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (isList && (lobjc % 2)) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("need even number of elements", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "LIST_LENGTH", NULL);
	return TCL_ERROR;
    }
    if (lobjc == 0) {
	Tcl_DecrRefCount(list);
	Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
	return TCL_ERROR;
    }
    out = Tcl_OpenFileChannel(interp, TclGetString(objv[1]), "wb", 0755);
    if (out == NULL) {
	Tcl_DecrRefCount(list);
	return TCL_ERROR;
    }
    if (pwlen <= 0) {
	pw = NULL;
	pwlen = 0;
    }
    if (isImg) {
	ZipFile *zf, zf0;
	int isMounted = 0;
	const char *imgName;

	if (isList) {
	    imgName = (objc > 4) ? TclGetString(objv[4]) :
		    Tcl_GetNameOfExecutable();
	} else {
	    imgName = (objc > 5) ? TclGetString(objv[5]) :
		    Tcl_GetNameOfExecutable();
	}
	if (pwlen) {
	    i = 0;
	    for (len = pwlen; len-- > 0;) {
		int ch = pw[len];

		passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		i++;
	    }
	    passBuf[i] = i;
	    ++i;
	    passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
	    passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
	    passBuf[i] = '\0';
	}

	/*
	 * Check for mounted image.
	 */

	WriteLock();
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    zf = (ZipFile *)Tcl_GetHashValue(hPtr);
	    if (strcmp(zf->name, imgName) == 0) {
		isMounted = 1;
		zf->numOpen++;
		break;
	    }
	}
	Unlock();
	if (!isMounted) {
	    zf = &zf0;
	}
	if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
	    if (Tcl_Write(out, (char *) zf->data,
		    zf->passOffset) != zf->passOffset) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, out, 0);
		if (zf == &zf0) {
		    ZipFSCloseArchive(interp, zf);
		} else {
		    WriteLock();
		    zf->numOpen--;
		    Unlock();
		}
		return TCL_ERROR;
	    }
	    if (zf == &zf0) {
		ZipFSCloseArchive(interp, zf);
	    } else {
		WriteLock();
		zf->numOpen--;
		Unlock();
	    }
	} else {
	    size_t k;
	    int m, n;
	    Tcl_Channel in;
	    const char *errMsg = "seek error";

	    /*
	     * Fall back to read it as plain file which hopefully is a static
	     * tclsh or wish binary with proper zipfs infrastructure built in.
	     */

	    Tcl_ResetResult(interp);
	    in = Tcl_OpenFileChannel(interp, imgName, "rb", 0644);
	    if (!in) {
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_CloseEx(interp, out, 0);
		return TCL_ERROR;
	    }
	    i = Tcl_Seek(in, 0, SEEK_END);
	    if (i == TCL_IO_FAILURE) {
	    cperr:
		memset(passBuf, 0, sizeof(passBuf));
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"%s: %s", errMsg, Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, out, 0);
		Tcl_CloseEx(interp, in, 0);
		return TCL_ERROR;
	    }
	    Tcl_Seek(in, 0, SEEK_SET);
	    for (k = 0; k < i; k += m) {
		m = i - k;
		if (m > (int) sizeof(buf)) {
		    m = (int) sizeof(buf);
		}
		n = Tcl_Read(in, buf, m);
		if (n == -1) {
		    errMsg = "read error";
		    goto cperr;
		} else if (n == 0) {
		    break;
		}
		m = Tcl_Write(out, buf, n);
		if (m != n) {
		    errMsg = "write error";
		    goto cperr;
		}
	    }
	    Tcl_CloseEx(interp, in, 0);
	}
	len = strlen(passBuf);
	if (len > 0) {
	    i = Tcl_Write(out, passBuf, len);
	    if (i != len) {
		Tcl_DecrRefCount(list);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"write error: %s", Tcl_PosixError(interp)));
		Tcl_CloseEx(interp, out, 0);
		return TCL_ERROR;
	    }
	}
	memset(passBuf, 0, sizeof(passBuf));
	Tcl_Flush(out);
    }
    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
    pos[0] = Tcl_Tell(out);
    if (!isList && (objc > 3)) {
	strip = TclGetString(objv[3]);
	slen = strlen(strip);
    }
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = TclGetString(lobjv[i]);
	if (isList) {
	    name = TclGetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	if (ZipAddFile(interp, path, name, out, pw, buf, sizeof(buf),
		&fileHash) != TCL_OK) {
	    goto done;
	}
    }
    pos[1] = Tcl_Tell(out);
    count = 0;
    for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
	const char *path, *name;

	path = TclGetString(lobjv[i]);
	if (isList) {
	    name = TclGetString(lobjv[i + 1]);
	} else {
	    name = path;
	    if (slen > 0) {
		len = strlen(name);
		if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
		    continue;
		}
		name += slen;
	    }
	}
	while (name[0] == '/') {
	    ++name;
	}
	if (name[0] == '\0') {
	    continue;
	}
	hPtr = Tcl_FindHashEntry(&fileHash, name);
	if (!hPtr) {
	    continue;
	}
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	len = strlen(z->name);
	ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
	ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted);
	ZipWriteShort(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->compressMethod);
	ZipWriteShort(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
	ZipWriteShort(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp));
	ZipWriteInt(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
	ZipWriteInt(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->numCompressedBytes);
	ZipWriteInt(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes);
	ZipWriteShort(buf + ZIP_CENTRAL_PATHLEN_OFFS, len);
	ZipWriteShort(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
	ZipWriteShort(buf + ZIP_CENTRAL_IATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_EATTR_OFFS, 0);
	ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]);
	if ((Tcl_Write(out, buf,
		    ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN)
		|| (Tcl_Write(out, z->name, len) != len)) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "write error: %s", Tcl_PosixError(interp)));
	    goto done;
	}
	count++;
    }
    Tcl_Flush(out);
    pos[2] = Tcl_Tell(out);
    ZipWriteInt(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
    ZipWriteShort(buf + ZIP_CENTRAL_ENTS_OFFS, count);
    ZipWriteShort(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]);
    ZipWriteInt(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]);
    ZipWriteShort(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
    if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write error: %s", Tcl_PosixError(interp)));
	goto done;
    }
    Tcl_Flush(out);
    ret = TCL_OK;

  done:
    if (ret == TCL_OK) {
	ret = Tcl_CloseEx(interp, out, 0);
    } else {
	Tcl_CloseEx(interp, out, 0);
    }
    Tcl_DecrRefCount(list);
    for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	z = (ZipEntry *)Tcl_GetHashValue(hPtr);
	Tcl_Free(z);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&fileHash);
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkzip] and [zipfs
 *	lmkzip] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkZipObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv);
}

static int
ZipFSLMkZipObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 0, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMkImgObjCmd, ZipFSLMkImgObjCmd --
 *
 *	These procedures are invoked to process the [zipfs mkimg] and [zipfs
 *	lmkimg] commands.  See description of ZipFSMkZipOrImgCmd().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See description of ZipFSMkZipOrImgCmd().
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMkImgObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 6) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"outfile indir ?strip? ?password? ?infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 1, 0, objc, objv);
}

static int
ZipFSLMkImgObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    if (objc < 3 || objc > 5) {
	Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password infile?");
	return TCL_ERROR;
    }
    if (Tcl_IsSafe(interp)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"operation not permitted in a safe interpreter", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
	return TCL_ERROR;
    }
    return ZipFSMkZipOrImgObjCmd(interp, 1, 1, objc, objv);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSCanonicalObjCmd --
 *
 *	This procedure is invoked to process the [zipfs canonical] command.
 *	It returns the canonical name for a file within zipfs
 *
 * Results:
 *	Always TCL_OK provided the right number of arguments are supplied.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSCanonicalObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *mntpoint = NULL;
    char *filename = NULL;
    char *result;
    Tcl_DString dPath;

    if (objc < 2 || objc > 4) {
	Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename ?inZipfs?");
	return TCL_ERROR;
    }
    Tcl_DStringInit(&dPath);
    if (objc == 2) {
	filename = TclGetString(objv[1]);
	result = CanonicalPath("", filename, &dPath, 1);
    } else if (objc == 3) {
	mntpoint = TclGetString(objv[1]);
	filename = TclGetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, 1);
    } else {
	int zipfs = 0;

	if (Tcl_GetBooleanFromObj(interp, objv[3], &zipfs)) {
	    return TCL_ERROR;
	}
	mntpoint = TclGetString(objv[1]);
	filename = TclGetString(objv[2]);
	result = CanonicalPath(mntpoint, filename, &dPath, zipfs);
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSExistsObjCmd --
 *
 *	This procedure is invoked to process the [zipfs exists] command.  It
 *	tests for the existence of a file in the ZIP filesystem and places a
 *	boolean into the interp's result.
 *
 * Results:
 *	Always TCL_OK provided the right number of arguments are supplied.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSExistsObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    int exists;
    Tcl_DString ds;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }

    /*
     * Prepend ZIPFS_VOLUME to filename, eliding the final /
     */

    filename = TclGetString(objv[1]);
    Tcl_DStringInit(&ds);
    Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1);
    Tcl_DStringAppend(&ds, filename, -1);
    filename = Tcl_DStringValue(&ds);

    ReadLock();
    exists = ZipFSLookup(filename) != NULL;
    Unlock();

    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSInfoObjCmd --
 *
 *	This procedure is invoked to process the [zipfs info] command.	 On
 *	success, it returns a Tcl list made up of name of ZIP archive file,
 *	size uncompressed, size compressed, and archive offset of a file in
 *	the ZIP filesystem.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSInfoObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *filename;
    ZipEntry *z;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "filename");
	return TCL_ERROR;
    }
    filename = TclGetString(objv[1]);
    ReadLock();
    z = ZipFSLookup(filename);
    if (z) {
	Tcl_Obj *result = Tcl_GetObjResult(interp);

	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewStringObj(z->zipFilePtr->name, -1));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numBytes));
	Tcl_ListObjAppendElement(interp, result,
		Tcl_NewWideIntObj(z->numCompressedBytes));
	Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->offset));
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListObjCmd --
 *
 *	This procedure is invoked to process the [zipfs list] command.	 On
 *	success, it returns a Tcl list of files of the ZIP filesystem which
 *	match a search pattern (glob or regexp).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSListObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    char *pattern = NULL;
    Tcl_RegExp regexp = NULL;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *result = Tcl_GetObjResult(interp);

    if (objc > 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
	return TCL_ERROR;
    }
    if (objc == 3) {
	size_t n;
	char *what = TclGetStringFromObj(objv[1], &n);

	if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
	    pattern = TclGetString(objv[2]);
	} else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
	    regexp = Tcl_RegExpCompile(interp, TclGetString(objv[2]));
	    if (!regexp) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "unknown option \"%s\"", what));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL);
	    return TCL_ERROR;
	}
    } else if (objc == 2) {
	pattern = TclGetString(objv[1]);
    }
    ReadLock();
    if (pattern) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    if (Tcl_StringMatch(z->name, pattern)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else if (regexp) {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
		Tcl_ListObjAppendElement(interp, result,
			Tcl_NewStringObj(z->name, -1));
	    }
	}
    } else {
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
		hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    Tcl_ListObjAppendElement(interp, result,
		    Tcl_NewStringObj(z->name, -1));
	}
    }
    Unlock();
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_TclLibrary --
 *
 *	This procedure gets (and possibly finds) the root that Tcl's library
 *	files are mounted under.
 *
 * Results:
 *	A Tcl object holding the location (with zero refcount), or NULL if no
 *	Tcl library can be found.
 *
 * Side effects:
 *	May initialise the cache of where such library files are to be found.
 *	This cache is never cleared.
 *
 *-------------------------------------------------------------------------
 */

#ifdef _WIN32
#define LIBRARY_SIZE	    64
#endif /* _WIN32 */

Tcl_Obj *
TclZipfs_TclLibrary(void)
{
    Tcl_Obj *vfsInitScript;
    int found;
#ifdef _WIN32
    HMODULE hModule;
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char dllName[(MAX_PATH + LIBRARY_SIZE) * 3];
#endif /* _WIN32 */

    /*
     * Use the cached value if that has been set; we don't want to repeat the
     * searching and mounting.
     */

    if (zipfs_literal_tcl_library) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }

    /*
     * Look for the library file system within the executable.
     */

    vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
	    -1);
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == TCL_OK) {
	zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }

    /*
     * Look for the library file system within the DLL/shared library.  Note
     * that we must mount the zip file and dll before releasing to search.
     */

#if defined(_WIN32)
    hModule = (HMODULE)TclWinGetTclInstance();
    GetModuleFileNameW(hModule, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, dllName, sizeof(dllName), NULL, NULL);

    if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#elif /* !_WIN32 && */ defined(CFG_RUNTIME_DLLFILE)
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* _WIN32 || CFG_RUNTIME_DLLFILE */

    /*
     * If we're configured to know about a ZIP archive we should use, do that.
     */

#ifdef CFG_RUNTIME_ZIPFILE
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(
	    CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    if (ZipfsAppHookFindTclInit(CFG_RUNTIME_ZIPFILE) == TCL_OK) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
#endif /* CFG_RUNTIME_ZIPFILE */

    /*
     * If anything set the cache (but subsequently failed) go with that
     * anyway.
     */

    if (zipfs_literal_tcl_library) {
	return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
    }
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSTclLibraryObjCmd --
 *
 *	This procedure is invoked to process the
 *	[::tcl::zipfs::tcl_library_init] command, usually called during the
 *	execution of Tcl's interpreter startup. It returns the root that Tcl's
 *	library files are mounted under.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	May initialise the cache of where such library files are to be found.
 *	This cache is never cleared.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSTclLibraryObjCmd(
    TCL_UNUSED(ClientData),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *)) /*objv*/
{
    if (!Tcl_IsSafe(interp)) {
	Tcl_Obj *pResult = TclZipfs_TclLibrary();

	if (!pResult) {
	    TclNewObj(pResult);
	}
	Tcl_SetObjResult(interp, pResult);
    }
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelClose --
 *
 *	This function is called to close a channel.
 *
 * Results:
 *	Always TCL_OK.
 *
 * Side effects:
 *	Resources are free'd.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelClose(
    void *instanceData,
    TCL_UNUSED(Tcl_Interp *),
    int flags)
{
    ZipChannel *info = (ZipChannel *)instanceData;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    if (info->iscompr && info->ubuf) {
	Tcl_Free(info->ubuf);
	info->ubuf = NULL;
    }
    if (info->isEncrypted) {
	info->isEncrypted = 0;
	memset(info->keys, 0, sizeof(info->keys));
    }
    if (info->isWriting) {
	ZipEntry *z = info->zipEntryPtr;
	unsigned char *newdata = (unsigned char *)Tcl_AttemptRealloc(info->ubuf, info->numRead);

	if (newdata) {
	    if (z->data) {
		Tcl_Free(z->data);
	    }
	    z->data = newdata;
	    z->numBytes = z->numCompressedBytes = info->numBytes;
	    z->compressMethod = ZIP_COMPMETH_STORED;
	    z->timestamp = time(NULL);
	    z->isDirectory = 0;
	    z->isEncrypted = 0;
	    z->offset = 0;
	    z->crc32 = 0;
	} else {
	    Tcl_Free(info->ubuf);
	}
    }
    WriteLock();
    info->zipFilePtr->numOpen--;
    Unlock();
    Tcl_Free(info);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelRead --
 *
 *	This function is called to read data from channel.
 *
 * Results:
 *	Number of bytes read or -1 on error with error number set.
 *
 * Side effects:
 *	Data is read and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelRead(
    void *instanceData,
    char *buf,
    int toRead,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (info->isDirectory < 0) {
	/*
	 * Special case: when executable combined with ZIP archive file read
	 * data in front of ZIP, i.e. the executable itself.
	 */

	nextpos = info->numRead + toRead;
	if (nextpos > info->zipFilePtr->baseOffset) {
	    toRead = info->zipFilePtr->baseOffset - info->numRead;
	    nextpos = info->zipFilePtr->baseOffset;
	}
	if (toRead == 0) {
	    return 0;
	}
	memcpy(buf, info->zipFilePtr->data, toRead);
	info->numRead = nextpos;
	*errloc = 0;
	return toRead;
    }
    if (info->isDirectory) {
	*errloc = EISDIR;
	return -1;
    }
    nextpos = info->numRead + toRead;
    if (nextpos > info->numBytes) {
	toRead = info->numBytes - info->numRead;
	nextpos = info->numBytes;
    }
    if (toRead == 0) {
	return 0;
    }
    if (info->isEncrypted) {
	int i;

	for (i = 0; i < toRead; i++) {
	    int ch = info->ubuf[i + info->numRead];

	    buf[i] = zdecode(info->keys, crc32tab, ch);
	}
    } else {
	memcpy(buf, info->ubuf + info->numRead, toRead);
    }
    info->numRead = nextpos;
    *errloc = 0;
    return toRead;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWrite --
 *
 *	This function is called to write data into channel.
 *
 * Results:
 *	Number of bytes written or -1 on error with error number set.
 *
 * Side effects:
 *	Data is written and file pointer is advanced.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelWrite(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    unsigned long nextpos;

    if (!info->isWriting) {
	*errloc = EINVAL;
	return -1;
    }
    nextpos = info->numRead + toWrite;
    if (nextpos > info->maxWrite) {
	toWrite = info->maxWrite - info->numRead;
	nextpos = info->maxWrite;
    }
    if (toWrite == 0) {
	return 0;
    }
    memcpy(info->ubuf + info->numRead, buf, toWrite);
    info->numRead = nextpos;
    if (info->numRead > info->numBytes) {
	info->numBytes = info->numRead;
    }
    *errloc = 0;
    return toWrite;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelSeek/ZipChannelWideSeek --
 *
 *	This function is called to position file pointer of channel.
 *
 * Results:
 *	New file position or -1 on error with error number set.
 *
 * Side effects:
 *	File pointer is repositioned according to offset and mode.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_WideInt
ZipChannelWideSeek(
    void *instanceData,
    Tcl_WideInt offset,
    int mode,
    int *errloc)
{
    ZipChannel *info = (ZipChannel *) instanceData;
    size_t end;

    if (!info->isWriting && (info->isDirectory < 0)) {
	/*
	 * Special case: when executable combined with ZIP archive file, seek
	 * within front of ZIP, i.e. the executable itself.
	 */
	end = info->zipFilePtr->baseOffset;
    } else if (info->isDirectory) {
	*errloc = EINVAL;
	return -1;
    } else {
	end = info->numBytes;
    }
    switch (mode) {
    case SEEK_CUR:
	offset += info->numRead;
	break;
    case SEEK_END:
	offset += end;
	break;
    case SEEK_SET:
	break;
    default:
	*errloc = EINVAL;
	return -1;
    }
    if (offset < 0) {
	*errloc = EINVAL;
	return -1;
    }
    if (info->isWriting) {
	if ((size_t) offset > info->maxWrite) {
	    *errloc = EINVAL;
	    return -1;
	}
	if ((size_t) offset > info->numBytes) {
	    info->numBytes = offset;
	}
    } else if ((size_t) offset > end) {
	*errloc = EINVAL;
	return -1;
    }
    info->numRead = (size_t) offset;
    return info->numRead;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelWatchChannel --
 *
 *	This function is called for event notifications on channel. Does
 *	nothing.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static void
ZipChannelWatchChannel(
    TCL_UNUSED(ClientData),
    TCL_UNUSED(int) /*mask*/)
{
    return;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelGetFile --
 *
 *	This function is called to retrieve OS handle for channel.
 *
 * Results:
 *	Always TCL_ERROR since there's never an OS handle for a file within a
 *	ZIP archive.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipChannelGetFile(
    TCL_UNUSED(ClientData),
    TCL_UNUSED(int) /*direction*/,
    TCL_UNUSED(ClientData *) /*handlePtr*/)
{
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipChannelOpen --
 *
 *	This function opens a Tcl_Channel on a file from a mounted ZIP archive
 *	according to given open mode.
 *
 * Results:
 *	Tcl_Channel on success, or NULL on error.
 *
 * Side effects:
 *	Memory is allocated, the file from the ZIP archive is uncompressed.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipChannelOpen(
    Tcl_Interp *interp,		/* Current interpreter. */
    char *filename,
    int mode,
    TCL_UNUSED(int) /*permissions*/)
{
    ZipEntry *z;
    ZipChannel *info;
    int i, ch, trunc, wr, flags = 0;
    char cname[128];

    if ((mode & O_APPEND)
	    || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {
	if (interp) {
	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("unsupported open mode", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_MODE", NULL);
	}
	return NULL;
    }
    WriteLock();
    z = ZipFSLookup(filename);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "file not found \"%s\": %s", filename,
		    Tcl_PosixError(interp)));
	}
	goto error;
    }
    trunc = (mode & O_TRUNC) != 0;
    wr = (mode & (O_WRONLY | O_RDWR)) != 0;
    if ((z->compressMethod != ZIP_COMPMETH_STORED)
	    && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
	ZIPFS_ERROR(interp, "unsupported compression method");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "COMP_METHOD", NULL);
	}
	goto error;
    }
    if (wr && z->isDirectory) {
	ZIPFS_ERROR(interp, "unsupported file type");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_TYPE", NULL);
	}
	goto error;
    }
    if (!trunc) {
	flags |= TCL_READABLE;
	if (z->isEncrypted && (z->zipFilePtr->passBuf[0] == 0)) {
	    ZIPFS_ERROR(interp, "decryption failed");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DECRYPT", NULL);
	    }
	    goto error;
	} else if (wr && !z->data && (z->numBytes > ZipFS.wrmax)) {
	    ZIPFS_ERROR(interp, "file too large");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
	    }
	    goto error;
	}
    } else {
	flags = TCL_WRITABLE;
    }
    info = (ZipChannel *)Tcl_AttemptAlloc(sizeof(ZipChannel));
    if (!info) {
	ZIPFS_ERROR(interp, "out of memory");
	if (interp) {
	    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	}
	goto error;
    }
    info->zipFilePtr = z->zipFilePtr;
    info->zipEntryPtr = z;
    info->numRead = 0;
    if (wr) {
	flags |= TCL_WRITABLE;
	info->isWriting = 1;
	info->isDirectory = 0;
	info->maxWrite = ZipFS.wrmax;
	info->iscompr = 0;
	info->isEncrypted = 0;
	info->ubuf = (unsigned char *)Tcl_AttemptAlloc(info->maxWrite);
	if (!info->ubuf) {
	merror0:
	    if (info->ubuf) {
		Tcl_Free(info->ubuf);
	    }
	    Tcl_Free(info);
	    ZIPFS_ERROR(interp, "out of memory");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
	    }
	    goto error;
	}
	memset(info->ubuf, 0, info->maxWrite);
	if (trunc) {
	    info->numBytes = 0;
	} else if (z->data) {
	    size_t j = z->numBytes;

	    if (j > info->maxWrite) {
		j = info->maxWrite;
	    }
	    memcpy(info->ubuf, z->data, j);
	    info->numBytes = j;
	} else {
	    unsigned char *zbuf = z->zipFilePtr->data + z->offset;

	    if (z->isEncrypted) {
		int len = z->zipFilePtr->passBuf[0] & 0xFF;
		char passBuf[260];

		for (i = 0; i < len; i++) {
		    ch = z->zipFilePtr->passBuf[len - i];
		    passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
		}
		passBuf[i] = '\0';
		init_keys(passBuf, info->keys, crc32tab);
		memset(passBuf, 0, sizeof(passBuf));
		for (i = 0; i < 12; i++) {
		    ch = info->ubuf[i];
		    zdecode(info->keys, crc32tab, ch);
		}
		zbuf += i;
	    }
	    if (z->compressMethod == ZIP_COMPMETH_DEFLATED) {
		z_stream stream;
		int err;
		unsigned char *cbuf = NULL;

		memset(&stream, 0, sizeof(z_stream));
		stream.zalloc = Z_NULL;
		stream.zfree = Z_NULL;
		stream.opaque = Z_NULL;
		stream.avail_in = z->numCompressedBytes;
		if (z->isEncrypted) {
		    size_t j;

		    stream.avail_in -= 12;
		    cbuf = (unsigned char *)Tcl_AttemptAlloc(stream.avail_in);
		    if (!cbuf) {
			goto merror0;
		    }
		    for (j = 0; j < stream.avail_in; j++) {
			ch = info->ubuf[j];
			cbuf[j] = zdecode(info->keys, crc32tab, ch);
		    }
		    stream.next_in = cbuf;
		} else {
		    stream.next_in = zbuf;
		}
		stream.next_out = info->ubuf;
		stream.avail_out = info->maxWrite;
		if (inflateInit2(&stream, -15) != Z_OK) {
		    goto cerror0;
		}
		err = inflate(&stream, Z_SYNC_FLUSH);
		inflateEnd(&stream);
		if ((err == Z_STREAM_END)
			|| ((err == Z_OK) && (stream.avail_in == 0))) {
		    if (cbuf) {
			memset(info->keys, 0, sizeof(info->keys));
			Tcl_Free(cbuf);
		    }
		    goto wrapchan;
		}
	    cerror0:
		if (cbuf) {
		    memset(info->keys, 0, sizeof(info->keys));
		    Tcl_Free(cbuf);
		}
		if (info->ubuf) {
		    Tcl_Free(info->ubuf);
		}
		Tcl_Free(info);
		ZIPFS_ERROR(interp, "decompression error");
		if (interp) {
		    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
		}
		goto error;
	    } else if (z->isEncrypted) {
		for (i = 0; i < z->numBytes - 12; i++) {
		    ch = zbuf[i];
		    info->ubuf[i] = zdecode(info->keys, crc32tab, ch);
		}
	    } else {
		memcpy(info->ubuf, zbuf, z->numBytes);
	    }
	    memset(info->keys, 0, sizeof(info->keys));
	    goto wrapchan;
	}
    } else if (z->data) {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	info->iscompr = 0;
	info->isDirectory = 0;
	info->isEncrypted = 0;
	info->numBytes = z->numBytes;
	info->maxWrite = 0;
	info->ubuf = z->data;
    } else {
	flags |= TCL_READABLE;
	info->isWriting = 0;
	info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED);
	info->ubuf = z->zipFilePtr->data + z->offset;
	info->isDirectory = z->isDirectory;
	info->isEncrypted = z->isEncrypted;
	info->numBytes = z->numBytes;
	info->maxWrite = 0;
	if (info->isEncrypted) {
	    int len = z->zipFilePtr->passBuf[0] & 0xFF;
	    char passBuf[260];

	    for (i = 0; i < len; i++) {
		ch = z->zipFilePtr->passBuf[len - i];
		passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
	    }
	    passBuf[i] = '\0';
	    init_keys(passBuf, info->keys, crc32tab);
	    memset(passBuf, 0, sizeof(passBuf));
	    for (i = 0; i < 12; i++) {
		ch = info->ubuf[i];
		zdecode(info->keys, crc32tab, ch);
	    }
	    info->ubuf += i;
	}
	if (info->iscompr) {
	    z_stream stream;
	    int err;
	    unsigned char *ubuf = NULL;
	    size_t j;

	    memset(&stream, 0, sizeof(z_stream));
	    stream.zalloc = Z_NULL;
	    stream.zfree = Z_NULL;
	    stream.opaque = Z_NULL;
	    stream.avail_in = z->numCompressedBytes;
	    if (info->isEncrypted) {
		stream.avail_in -= 12;
		ubuf = (unsigned char *)Tcl_AttemptAlloc(stream.avail_in);
		if (!ubuf) {
		    info->ubuf = NULL;
		    goto merror;
		}
		for (j = 0; j < stream.avail_in; j++) {
		    ch = info->ubuf[j];
		    ubuf[j] = zdecode(info->keys, crc32tab, ch);
		}
		stream.next_in = ubuf;
	    } else {
		stream.next_in = info->ubuf;
	    }
	    stream.next_out = info->ubuf = (unsigned char *)Tcl_AttemptAlloc(info->numBytes);
	    if (!info->ubuf) {
	    merror:
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    Tcl_Free(ubuf);
		}
		Tcl_Free(info);
		if (interp) {
		    Tcl_SetObjResult(interp,
			    Tcl_NewStringObj("out of memory", -1));
		    Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
		}
		goto error;
	    }
	    stream.avail_out = info->numBytes;
	    if (inflateInit2(&stream, -15) != Z_OK) {
		goto cerror;
	    }
	    err = inflate(&stream, Z_SYNC_FLUSH);
	    inflateEnd(&stream);
	    if ((err == Z_STREAM_END)
		    || ((err == Z_OK) && (stream.avail_in == 0))) {
		if (ubuf) {
		    info->isEncrypted = 0;
		    memset(info->keys, 0, sizeof(info->keys));
		    Tcl_Free(ubuf);
		}
		goto wrapchan;
	    }
	cerror:
	    if (ubuf) {
		info->isEncrypted = 0;
		memset(info->keys, 0, sizeof(info->keys));
		Tcl_Free(ubuf);
	    }
	    if (info->ubuf) {
		Tcl_Free(info->ubuf);
	    }
	    Tcl_Free(info);
	    ZIPFS_ERROR(interp, "decompression error");
	    if (interp) {
		Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
	    }
	    goto error;
	} else if (info->isEncrypted) {
	    unsigned char *ubuf = NULL;
	    size_t j, len;

	    /*
	     * Decode encrypted but uncompressed file, since we support
	     * Tcl_Seek() on it, and it can be randomly accessed later.
	     */

	    len = z->numCompressedBytes - 12;
	    ubuf = (unsigned char *) Tcl_AttemptAlloc(len);
	    if (ubuf == NULL) {
		Tcl_Free((char *) info);
		if (interp != NULL) {
		    Tcl_SetObjResult(interp,
			Tcl_NewStringObj("out of memory", -1));
		}
		goto error;
	    }
	    for (j = 0; j < len; j++) {
		ch = info->ubuf[j];
		ubuf[j] = zdecode(info->keys, crc32tab, ch);
	    }
	    info->ubuf = ubuf;
	    info->isEncrypted = 0;
	}
    }

  wrapchan:
    sprintf(cname, "zipfs_%" TCL_LL_MODIFIER "x_%d", z->offset,
	    ZipFS.idCount++);
    z->zipFilePtr->numOpen++;
    Unlock();
    return Tcl_CreateChannel(&ZipChannelType, cname, info, flags);

  error:
    Unlock();
    return NULL;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryStat --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryStat(
    char *path,
    Tcl_StatBuf *buf)
{
    ZipEntry *z;
    int ret = -1;

    ReadLock();
    z = ZipFSLookup(path);
    if (z) {
	memset(buf, 0, sizeof(Tcl_StatBuf));
	if (z->isDirectory) {
	    buf->st_mode = S_IFDIR | 0555;
	} else {
	    buf->st_mode = S_IFREG | 0555;
	}
	buf->st_size = z->numBytes;
	buf->st_mtime = z->timestamp;
	buf->st_ctime = z->timestamp;
	buf->st_atime = z->timestamp;
	ret = 0;
    }
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipEntryAccess --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipEntryAccess(
    char *path,
    int mode)
{
    ZipEntry *z;

    if (mode & 3) {
	return -1;
    }
    ReadLock();
    z = ZipFSLookup(path);
    Unlock();
    return (z ? 0 : -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSOpenFileChannelProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Channel
ZipFSOpenFileChannelProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *pathPtr,
    int mode,
    int permissions)
{
    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return NULL;
    }
    return ZipChannelOpen(interp, TclGetString(pathPtr), mode,
	    permissions);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSStatProc --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of stat.
 *
 * Results:
 *	See stat documentation.
 *
 * Side effects:
 *	See stat documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSStatProc(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *buf)
{

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryStat(TclGetString(pathPtr), buf);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSAccessProc --
 *
 *	This function implements the ZIP filesystem specific version of the
 *	library version of access.
 *
 * Results:
 *	See access documentation.
 *
 * Side effects:
 *	See access documentation.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSAccessProc(
    Tcl_Obj *pathPtr,
    int mode)
{
    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    return ZipEntryAccess(TclGetString(pathPtr), mode);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemSeparatorProc --
 *
 *	This function returns the separator to be used for a given path. The
 *	object returned should have a refCount of zero
 *
 * Results:
 *	A Tcl object, with a refCount of zero. If the caller needs to retain a
 *	reference to the object, it should call Tcl_IncrRefCount, and should
 *	otherwise free the object.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemSeparatorProc(
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/)
{
    return Tcl_NewStringObj("/", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSMatchInDirectoryProc --
 *
 *	This routine is used by the globbing code to search a directory for
 *	all files which match a given pattern.
 *
 * Results:
 *	The return value is a standard Tcl result indicating whether an error
 *	occurred in globbing. Errors are left in interp, good results are
 *	lappend'ed to resultPtr (which must be a valid object).
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSMatchInDirectoryProc(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *result,
    Tcl_Obj *pathPtr,
    const char *pattern,
    Tcl_GlobTypeData *types)
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    int scnt, l, dirOnly = -1, strip = 0;
    size_t len, prefixLen;
    char *pat, *prefix, *path;
    Tcl_DString dsPref;

    if (!normPathPtr) {
	return -1;
    }
    if (types) {
	dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
    }

    /*
     * The prefix that gets prepended to results.
     */

    prefix = TclGetStringFromObj(pathPtr, &prefixLen);

    /*
     * The (normalized) path we're searching.
     */

    path = TclGetStringFromObj(normPathPtr, &len);

    Tcl_DStringInit(&dsPref);
    Tcl_DStringAppend(&dsPref, prefix, prefixLen);

    if (strcmp(prefix, path) == 0) {
	prefix = NULL;
    } else {
	strip = len + 1;
    }
    if (prefix) {
	Tcl_DStringAppend(&dsPref, "/", 1);
	prefixLen++;
	prefix = Tcl_DStringValue(&dsPref);
    }
    ReadLock();
    if (types && (types->type == TCL_GLOB_TYPE_MOUNT)) {
	l = CountSlashes(path);
	if (path[len - 1] == '/') {
	    len--;
	} else {
	    l++;
	}
	if (!pattern || (pattern[0] == '\0')) {
	    pattern = "*";
	}
	for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
		hPtr = Tcl_NextHashEntry(&search)) {
	    ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr);

	    if (zf->mountPointLen == 0) {
		ZipEntry *z;

		for (z = zf->topEnts; z; z = z->tnext) {
		    size_t lenz = strlen(z->name);

		    if ((lenz > len + 1) && (strncmp(z->name, path, len) == 0)
			    && (z->name[len] == '/')
			    && (CountSlashes(z->name) == l)
			    && Tcl_StringCaseMatch(z->name + len + 1, pattern,
				    0)) {
			if (prefix) {
			    Tcl_DStringAppend(&dsPref, z->name, lenz);
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
					    Tcl_DStringLength(&dsPref)));
			    Tcl_DStringSetLength(&dsPref, prefixLen);
			} else {
			    Tcl_ListObjAppendElement(NULL, result,
				    Tcl_NewStringObj(z->name, lenz));
			}
		    }
		}
	    } else if ((zf->mountPointLen > len + 1)
		    && (strncmp(zf->mountPoint, path, len) == 0)
		    && (zf->mountPoint[len] == '/')
		    && (CountSlashes(zf->mountPoint) == l)
		    && Tcl_StringCaseMatch(zf->mountPoint + len + 1,
			    pattern, 0)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, zf->mountPoint,
			    zf->mountPointLen);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(zf->mountPoint,
				    zf->mountPointLen));
		}
	    }
	}
	goto end;
    }

    if (!pattern || (pattern[0] == '\0')) {
	hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
	if (hPtr) {
	    ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	    if ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
		    || (dirOnly && z->isDirectory)) {
		if (prefix) {
		    Tcl_DStringAppend(&dsPref, z->name, -1);
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				    Tcl_DStringLength(&dsPref)));
		    Tcl_DStringSetLength(&dsPref, prefixLen);
		} else {
		    Tcl_ListObjAppendElement(NULL, result,
			    Tcl_NewStringObj(z->name, -1));
		}
	    }
	}
	goto end;
    }

    l = strlen(pattern);
    pat = (char *)Tcl_Alloc(len + l + 2);
    memcpy(pat, path, len);
    while ((len > 1) && (pat[len - 1] == '/')) {
	--len;
    }
    if ((len > 1) || (pat[0] != '/')) {
	pat[len] = '/';
	++len;
    }
    memcpy(pat + len, pattern, l + 1);
    scnt = CountSlashes(pat);
    for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
	    hPtr; hPtr = Tcl_NextHashEntry(&search)) {
	ZipEntry *z = (ZipEntry *)Tcl_GetHashValue(hPtr);

	if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory)
		|| (!dirOnly && z->isDirectory))) {
	    continue;
	}
	if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
	    if (prefix) {
		Tcl_DStringAppend(&dsPref, z->name + strip, -1);
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
				Tcl_DStringLength(&dsPref)));
		Tcl_DStringSetLength(&dsPref, prefixLen);
	    } else {
		Tcl_ListObjAppendElement(NULL, result,
			Tcl_NewStringObj(z->name + strip, -1));
	    }
	}
    }
    Tcl_Free(pat);

  end:
    Unlock();
    Tcl_DStringFree(&dsPref);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSPathInFilesystemProc --
 *
 *	This function determines if the given path object is in the ZIP
 *	filesystem.
 *
 * Results:
 *	TCL_OK when the path object is in the ZIP filesystem, -1 otherwise.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSPathInFilesystemProc(
    Tcl_Obj *pathPtr,
    TCL_UNUSED(ClientData *))
{
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    int ret = -1;
    size_t len;
    char *path;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }

    path = TclGetStringFromObj(pathPtr, &len);
    if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
	return -1;
    }

    ReadLock();
    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
    if (hPtr) {
	ret = TCL_OK;
	goto endloop;
    }

    for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
	    hPtr = Tcl_NextHashEntry(&search)) {
	ZipFile *zf = (ZipFile *)Tcl_GetHashValue(hPtr);

	if (zf->mountPointLen == 0) {
	    ZipEntry *z;

	    for (z = zf->topEnts; z != NULL; z = z->tnext) {
		size_t lenz = strlen(z->name);

		if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
		    ret = TCL_OK;
		    goto endloop;
		}
	    }
	} else if ((len >= zf->mountPointLen) &&
		(strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
	    ret = TCL_OK;
	    break;
	}
    }

  endloop:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSListVolumesProc --
 *
 *	Lists the currently mounted ZIP filesystem volumes.
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSListVolumesProc(void)
{
    return Tcl_NewStringObj(ZIPFS_VOLUME, -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrStringsProc --
 *
 *	This function implements the ZIP filesystem dependent 'file
 *	attributes' subcommand, for listing the set of possible attribute
 *	strings.
 *
 * Results:
 *	An array of strings
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static const char *const *
ZipFSFileAttrStringsProc(
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/,
    TCL_UNUSED(Tcl_Obj **) /*objPtrRef*/)
{
    static const char *const attrs[] = {
	"-uncompsize",
	"-compsize",
	"-offset",
	"-mount",
	"-archive",
	"-permissions",
	NULL,
    };

    return attrs;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrsGetProc --
 *
 *	This function implements the ZIP filesystem specific 'file attributes'
 *	subcommand, for 'get' operations.
 *
 * Results:
 *	Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
 *	was returned) is likely to have a refCount of zero. Either way we must
 *	either store it somewhere (e.g. the Tcl result), or Incr/Decr its
 *	refCount to ensure it is properly freed.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFileAttrsGetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    int index,
    Tcl_Obj *pathPtr,
    Tcl_Obj **objPtrRef)
{
    int ret = TCL_OK;
    char *path;
    ZipEntry *z;

    pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
    if (!pathPtr) {
	return -1;
    }
    path = TclGetString(pathPtr);
    ReadLock();
    z = ZipFSLookup(path);
    if (!z) {
	Tcl_SetErrno(ENOENT);
	ZIPFS_POSIX_ERROR(interp, "file not found");
	ret = TCL_ERROR;
	goto done;
    }
    switch (index) {
    case 0:
	TclNewIntObj(*objPtrRef, z->numBytes);
	break;
    case 1:
	TclNewIntObj(*objPtrRef, z->numCompressedBytes);
	break;
    case 2:
	TclNewIntObj(*objPtrRef, z->offset);
	break;
    case 3:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
		z->zipFilePtr->mountPointLen);
	break;
    case 4:
	*objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1);
	break;
    case 5:
	*objPtrRef = Tcl_NewStringObj("0o555", -1);
	break;
    default:
	ZIPFS_ERROR(interp, "unknown attribute");
	ret = TCL_ERROR;
    }

  done:
    Unlock();
    return ret;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFileAttrsSetProc --
 *
 *	This function implements the ZIP filesystem specific 'file attributes'
 *	subcommand, for 'set' operations.
 *
 * Results:
 *	Standard Tcl return code.
 *
 * Side effects:
 *	None.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSFileAttrsSetProc(
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*index*/,
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/,
    TCL_UNUSED(Tcl_Obj *) /*objPtr*/)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL);
    }
    return TCL_ERROR;
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSFilesystemPathTypeProc --
 *
 * Results:
 *
 * Side effects:
 *
 *-------------------------------------------------------------------------
 */

static Tcl_Obj *
ZipFSFilesystemPathTypeProc(
    TCL_UNUSED(Tcl_Obj *) /*pathPtr*/)
{
    return Tcl_NewStringObj("zip", -1);
}

/*
 *-------------------------------------------------------------------------
 *
 * ZipFSLoadFile --
 *
 *	This functions deals with loading native object code. If the given
 *	path object refers to a file within the ZIP filesystem, an approriate
 *	error code is returned to delegate loading to the caller (by copying
 *	the file to temp store and loading from there). As fallback when the
 *	file refers to the ZIP file system but is not present, it is looked up
 *	relative to the executable and loaded from there when available.
 *
 * Results:
 *	TCL_OK on success, TCL_ERROR otherwise with error message left.
 *
 * Side effects:
 *	Loads native code into the process address space.
 *
 *-------------------------------------------------------------------------
 */

static int
ZipFSLoadFile(
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *path,
    Tcl_LoadHandle *loadHandle,
    Tcl_FSUnloadFileProc **unloadProcPtr,
    int flags)
{
    Tcl_FSLoadFileProc2 *loadFileProc;
#ifdef ANDROID
    /*
     * Force loadFileProc to native implementation since the package manager
     * already extracted the shared libraries from the APK at install time.
     */

    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
    if (loadFileProc) {
	return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    }
    Tcl_SetErrno(ENOENT);
    ZIPFS_ERROR(interp, Tcl_PosixError(interp));
    return TCL_ERROR;
#else /* !ANDROID */
    Tcl_Obj *altPath = NULL;
    int ret = TCL_ERROR;
    Tcl_Obj *objs[2] = { NULL, NULL };

    if (Tcl_FSAccess(path, R_OK) == 0) {
	/*
	 * EXDEV should trigger loading by copying to temp store.
	 */

	Tcl_SetErrno(EXDEV);
	ZIPFS_ERROR(interp, Tcl_PosixError(interp));
	return ret;
    }

    objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME);
    if (objs[1] && (ZipFSAccessProc(objs[1], R_OK) == 0)) {
	const char *execName = Tcl_GetNameOfExecutable();

	/*
	 * Shared object is not in ZIP but its path prefix is, thus try to
	 * load from directory where the executable came from.
	 */

	TclDecrRefCount(objs[1]);
	objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL);

	/*
	 * Get directory name of executable manually to deal with cases where
	 * [file dirname [info nameofexecutable]] is equal to [info
	 * nameofexecutable] due to VFS effects.
	 */

	if (execName) {
	    const char *p = strrchr(execName, '/');

	    if (p > execName + 1) {
		--p;
		objs[0] = Tcl_NewStringObj(execName, p - execName);
	    }
	}
	if (!objs[0]) {
	    objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
		    TCL_PATH_DIRNAME);
	}
	if (objs[0]) {
	    altPath = TclJoinPath(2, objs, 0);
	    if (altPath) {
		Tcl_IncrRefCount(altPath);
		if (Tcl_FSAccess(altPath, R_OK) == 0) {
		    path = altPath;
		}
	    }
	}
    }
    if (objs[0]) {
	Tcl_DecrRefCount(objs[0]);
    }
    if (objs[1]) {
	Tcl_DecrRefCount(objs[1]);
    }

    loadFileProc = (Tcl_FSLoadFileProc2 *)(void *)tclNativeFilesystem.loadFileProc;
    if (loadFileProc) {
	ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
    } else {
	Tcl_SetErrno(ENOENT);
	ZIPFS_ERROR(interp, Tcl_PosixError(interp));
    }
    if (altPath) {
	Tcl_DecrRefCount(altPath);
    }
    return ret;
#endif /* ANDROID */
}

#endif /* HAVE_ZLIB */

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Init --
 *
 *	Perform per interpreter initialization of this module.
 *
 * Results:
 *	The return value is a standard Tcl result.
 *
 * Side effects:
 *	Initializes this module if not already initialized, and adds module
 *	related commands to the given interpreter.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Init(
    Tcl_Interp *interp)		/* Current interpreter. */
{
#ifdef HAVE_ZLIB
    static const EnsembleImplMap initMap[] = {
	{"mkimg",	ZipFSMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"mkzip",	ZipFSMkZipObjCmd,	NULL, NULL, NULL, 1},
	{"lmkimg",	ZipFSLMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"lmkzip",	ZipFSLMkZipObjCmd,	NULL, NULL, NULL, 1},
	/* The 4 entries above are not available in safe interpreters */
	{"mount",	ZipFSMountObjCmd,	NULL, NULL, NULL, 1},
	{"mount_data",	ZipFSMountBufferObjCmd,	NULL, NULL, NULL, 1},
	{"unmount",	ZipFSUnmountObjCmd,	NULL, NULL, NULL, 1},
	{"mkkey",	ZipFSMkKeyObjCmd,	NULL, NULL, NULL, 1},
	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 0},
	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 0},
	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 0},
	{"canonical",	ZipFSCanonicalObjCmd,	NULL, NULL, NULL, 0},
	{"root",	ZipFSRootObjCmd,	NULL, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    static const char findproc[] =
	"namespace eval ::tcl::zipfs {}\n"
	"proc ::tcl::zipfs::Find dir {\n"
	"    set result {}\n"
	"    if {[catch {glob -directory $dir -nocomplain * .*} list]} {\n"
	"        return $result\n"
	"    }\n"
	"    foreach file $list {\n"
	"        if {[file tail $file] in {. ..}} {\n"
	"            continue\n"
	"        }\n"
	"        lappend result $file {*}[Find $file]\n"
	"    }\n"
	"    return $result\n"
	"}\n"
	"proc ::tcl::zipfs::find {directoryName} {\n"
	"    return [lsort [Find $directoryName]]\n"
	"}\n";

    /*
     * One-time initialization.
     */

    WriteLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }
    Unlock();

    if (interp) {
	Tcl_Command ensemble;
	Tcl_Obj *mapObj;

	Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
	Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		TCL_LINK_INT);
	ensemble = TclMakeEnsemble(interp, "zipfs",
		Tcl_IsSafe(interp) ? (initMap + 4) : initMap);

	/*
	 * Add the [zipfs find] subcommand.
	 */

	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
		Tcl_NewStringObj("::tcl::zipfs::find", -1));
	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
		ZipFSTclLibraryObjCmd, NULL, NULL);
	Tcl_PkgProvideEx(interp, "zipfs", "2.0", NULL);
    }
    return TCL_OK;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    return TCL_ERROR;
#endif /* HAVE_ZLIB */
}

static int
ZipfsAppHookFindTclInit(
    const char *archive)
{
    Tcl_Obj *vfsInitScript;
    int found;

    if (zipfs_literal_tcl_library) {
	return TCL_ERROR;
    }
    if (TclZipfs_Mount(NULL, ZIPFS_ZIP_MOUNT, archive, NULL)) {
	/* Either the file doesn't exist or it is not a zip archive */
	return TCL_ERROR;
    }

    TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
	return TCL_OK;
    }

    TclNewLiteralStringObj(vfsInitScript,
	    ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
    Tcl_IncrRefCount(vfsInitScript);
    found = Tcl_FSAccess(vfsInitScript, F_OK);
    Tcl_DecrRefCount(vfsInitScript);
    if (found == 0) {
	zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
	return TCL_OK;
    }

    return TCL_ERROR;
}

static void
ZipfsExitHandler(
    ClientData clientData)
{
    ZipFile *zf = (ZipFile *)clientData;

    if (TCL_OK != TclZipfs_Unmount(NULL, zf->mountPoint)) {
	Tcl_Panic("tried to unmount busy filesystem");
    }
}

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_AppHook --
 *
 *	Performs the argument munging for the shell
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_AppHook(
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    int *argcPtr,		/* Pointer to argc */
#else
    TCL_UNUSED(int *), /*argcPtr*/
#endif
#ifdef _WIN32
    TCL_UNUSED(WCHAR ***)) /* argvPtr */
#else /* !_WIN32 */
    char ***argvPtr)		/* Pointer to argv */
#endif /* _WIN32 */
{
    char *archive;

#ifdef _WIN32
    Tcl_FindExecutable(NULL);
#else
    Tcl_FindExecutable((*argvPtr)[0]);
#endif
    archive = (char *) Tcl_GetNameOfExecutable();
    TclZipfs_Init(NULL);

    /*
     * Look for init.tcl in one of the locations mounted later in this
     * function.
     */

    if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
	int found;
	Tcl_Obj *vfsInitScript;

	TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
	Tcl_IncrRefCount(vfsInitScript);
	if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
	    /*
	     * Startup script should be set before calling Tcl_AppInit
	     */

	    Tcl_SetStartupScript(vfsInitScript, NULL);
	} else {
	    Tcl_DecrRefCount(vfsInitScript);
	}

	/*
	 * Set Tcl Encodings
	 */

	if (!zipfs_literal_tcl_library) {
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return TCL_OK;
	    }
	}
#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
    } else if (*argcPtr > 1) {
	/*
	 * If the first argument is "install", run the supplied installer
	 * script.
	 */

#ifdef _WIN32
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	archive = Tcl_WCharToUtfDString((*argvPtr)[1], -1, &ds);
#else /* !_WIN32 */
	archive = (*argvPtr)[1];
#endif /* _WIN32 */
	if (strcmp(archive, "install") == 0) {
	    Tcl_Obj *vfsInitScript;

	    /*
	     * Run this now to ensure the file is present by the time Tcl_Main
	     * wants it.
	     */

	    TclZipfs_TclLibrary();
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		Tcl_SetStartupScript(vfsInitScript, NULL);
	    }
	    return TCL_OK;
	} else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
	    int found;
	    Tcl_Obj *vfsInitScript;

	    TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
		/*
		 * Startup script should be set before calling Tcl_AppInit
		 */

		Tcl_SetStartupScript(vfsInitScript, NULL);
	    } else {
		Tcl_DecrRefCount(vfsInitScript);
	    }
	    /* Set Tcl Encodings */
	    TclNewLiteralStringObj(vfsInitScript,
		    ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
	    Tcl_IncrRefCount(vfsInitScript);
	    found = Tcl_FSAccess(vfsInitScript, F_OK);
	    Tcl_DecrRefCount(vfsInitScript);
	    if (found == TCL_OK) {
		zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
		return TCL_OK;
	    }
	}
#ifdef _WIN32
	Tcl_DStringFree(&ds);
#endif /* _WIN32 */
#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
    }
    return TCL_OK;
}

#ifndef HAVE_ZLIB

/*
 *-------------------------------------------------------------------------
 *
 * TclZipfs_Mount, TclZipfs_MountBuffer, TclZipfs_Unmount --
 *
 *	Dummy version when no ZLIB support available.
 *
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Mount(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *mountPoint,	/* Mount point path. */
    const char *zipname,	/* Path to ZIP file to mount. */
    const char *passwd)		/* Password for opening the ZIP, or NULL if
				 * the ZIP is unprotected. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}

int
TclZipfs_MountBuffer(
    Tcl_Interp *interp,		/* Current interpreter. NULLable. */
    const char *mountPoint,	/* Mount point path. */
    unsigned char *data,
    size_t datalen,
    int copy)
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}

int
TclZipfs_Unmount(
    Tcl_Interp *interp,		/* Current interpreter. */
    const char *mountPoint)	/* Mount point path. */
{
    ZIPFS_ERROR(interp, "no zlib available");
    if (interp) {
	Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    }
    return TCL_ERROR;
}
#endif /* !HAVE_ZLIB */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted generic/tclZlib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclZlib.c --
 *
 *	This file provides the interface to the Zlib library.
 *
 * Copyright (C) 2004-2005 Pascal Scheffers <pascal@scheffers.net>
 * Copyright (C) 2005 Unitas Software B.V.
 * Copyright (c) 2008-2012 Donal K. Fellows
 *
 * Parts written by Jean-Claude Wippler, as part of Tclkit, placed in the
 * public domain March 2003.
 *
 * 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 HAVE_ZLIB
#include <zlib.h>
#include "tclIO.h"

/*
 * The version of the zlib "package" that this implements. Note that this
 * thoroughly supersedes the versions included with tclkit, which are "1.1",
 * so this is at least "2.0" (there's no general *commitment* to have the same
 * interface, even if that is mostly true).
 */

#define TCL_ZLIB_VERSION	"2.0.1"

/*
 * Magic flags used with wbits fields to indicate that we're handling the gzip
 * format or automatic detection of format. Putting it here is slightly less
 * gross!
 */

#define WBITS_RAW		(-MAX_WBITS)
#define WBITS_ZLIB		(MAX_WBITS)
#define WBITS_GZIP		(MAX_WBITS | 16)
#define WBITS_AUTODETECT	(MAX_WBITS | 32)

/*
 * Structure used for handling gzip headers that are generated from a
 * dictionary. It comprises the header structure itself plus some working
 * space that it is very convenient to have attached.
 */

#define MAX_COMMENT_LEN		256

typedef struct {
    gz_header header;
    char nativeFilenameBuf[MAXPATHLEN];
    char nativeCommentBuf[MAX_COMMENT_LEN];
} GzipHeader;

/*
 * Structure used for the Tcl_ZlibStream* commands and [zlib stream ...]
 */

typedef struct {
    Tcl_Interp *interp;
    z_stream stream;		/* The interface to the zlib library. */
    int streamEnd;		/* If we've got to end-of-stream. */
    Tcl_Obj *inData, *outData;	/* Input / output buffers (lists) */
    Tcl_Obj *currentInput;	/* Pointer to what is currently being
				 * inflated. */
    size_t outPos;
    int mode;			/* Either TCL_ZLIB_STREAM_DEFLATE or
				 * TCL_ZLIB_STREAM_INFLATE. */
    int format;			/* Flags from the TCL_ZLIB_FORMAT_* */
    int level;			/* Default 5, 0-9 */
    int flush;			/* Stores the flush param for deferred the
				 * decompression. */
    int wbits;			/* The encoded compression mode, so we can
				 * restart the stream if necessary. */
    Tcl_Command cmd;		/* Token for the associated Tcl command. */
    Tcl_Obj *compDictObj;	/* Byte-array object containing compression
				 * dictionary (not dictObj!) to use if
				 * necessary. */
    int flags;			/* Miscellaneous flag bits. */
    GzipHeader *gzHeaderPtr;	/* If we've allocated a gzip header
				 * structure. */
} ZlibStreamHandle;

#define DICT_TO_SET	0x1	/* If we need to set a compression dictionary
				 * in the low-level engine at the next
				 * opportunity. */

/*
 * Macros to make it clearer in some of the twiddlier accesses what is
 * happening.
 */

#define IsRawStream(zshPtr)	((zshPtr)->format == TCL_ZLIB_FORMAT_RAW)
#define HaveDictToSet(zshPtr)	((zshPtr)->flags & DICT_TO_SET)
#define DictWasSet(zshPtr)	((zshPtr)->flags |= ~DICT_TO_SET)

/*
 * Structure used for stacked channel compression and decompression.
 */

typedef struct {
    Tcl_Channel chan;		/* Reference to the channel itself. */
    Tcl_Channel parent;		/* The underlying source and sink of bytes. */
    int flags;			/* General flag bits, see below... */
    int mode;			/* Either the value TCL_ZLIB_STREAM_DEFLATE
				 * for compression on output, or
				 * TCL_ZLIB_STREAM_INFLATE for decompression
				 * on input. */
    int format;			/* What format of data is going on the wire.
				 * Needed so that the correct [fconfigure]
				 * options can be enabled. */
    unsigned int readAheadLimit;/* The maximum number of bytes to read from
				 * the underlying stream in one go. */
    z_stream inStream;		/* Structure used by zlib for decompression of
				 * input. */
    z_stream outStream;		/* Structure used by zlib for compression of
				 * output. */
    char *inBuffer, *outBuffer;	/* Working buffers. */
    size_t inAllocated, outAllocated;
				/* Sizes of working buffers. */
    GzipHeader inHeader;	/* Header read from input stream, when
				 * decompressing a gzip stream. */
    GzipHeader outHeader;	/* Header to write to an output stream, when
				 * compressing a gzip stream. */
    Tcl_TimerToken timer;	/* Timer used for keeping events fresh. */
    Tcl_Obj *compDictObj;	/* Byte-array object containing compression
				 * dictionary (not dictObj!) to use if
				 * necessary. */
} ZlibChannelData;

/*
 * Value bits for the flags field. Definitions are:
 *	ASYNC -		Whether this is an asynchronous channel.
 *	IN_HEADER -	Whether the inHeader field has been registered with
 *			the input compressor.
 *	OUT_HEADER -	Whether the outputHeader field has been registered
 *			with the output decompressor.
 *	STREAM_DECOMPRESS - Signal decompress pending data.
 *	STREAM_DONE -	Flag to signal stream end up to transform input.
 */

#define ASYNC			0x01
#define IN_HEADER		0x02
#define OUT_HEADER		0x04
#define STREAM_DECOMPRESS	0x08
#define STREAM_DONE		0x10

/*
 * Size of buffers allocated by default, and the range it can be set to.  The
 * same sorts of values apply to streams, except with different limits (they
 * permit byte-level activity). Channels always use bytes unless told to use
 * larger buffers.
 */

#define DEFAULT_BUFFER_SIZE	4096
#define MIN_NONSTREAM_BUFFER_SIZE 16
#define MAX_BUFFER_SIZE		65536

/*
 * Prototypes for private procedures defined later in this file:
 */

static Tcl_CmdDeleteProc	ZlibStreamCmdDelete;
static Tcl_DriverBlockModeProc	ZlibTransformBlockMode;
static Tcl_DriverClose2Proc	ZlibTransformClose;
static Tcl_DriverGetHandleProc	ZlibTransformGetHandle;
static Tcl_DriverGetOptionProc	ZlibTransformGetOption;
static Tcl_DriverHandlerProc	ZlibTransformEventHandler;
static Tcl_DriverInputProc	ZlibTransformInput;
static Tcl_DriverOutputProc	ZlibTransformOutput;
static Tcl_DriverSetOptionProc	ZlibTransformSetOption;
static Tcl_DriverWatchProc	ZlibTransformWatch;
static Tcl_ObjCmdProc		ZlibCmd;
static Tcl_ObjCmdProc		ZlibStreamCmd;
static Tcl_ObjCmdProc		ZlibStreamAddCmd;
static Tcl_ObjCmdProc		ZlibStreamHeaderCmd;
static Tcl_ObjCmdProc		ZlibStreamPutCmd;

static void		ConvertError(Tcl_Interp *interp, int code,
			    uLong adler);
static Tcl_Obj *	ConvertErrorToList(int code, uLong adler);
static inline int	Deflate(z_streamp strm, void *bufferPtr,
			    size_t bufferSize, int flush, size_t *writtenPtr);
static void		ExtractHeader(gz_header *headerPtr, Tcl_Obj *dictObj);
static int		GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj,
			    GzipHeader *headerPtr, int *extraSizePtr);
static int		ZlibPushSubcmd(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		ResultDecompress(ZlibChannelData *cd, char *buf,
			    int toRead, int flush, int *errorCodePtr);
static Tcl_Channel	ZlibStackChannelTransform(Tcl_Interp *interp,
			    int mode, int format, int level, int limit,
			    Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr,
			    Tcl_Obj *compDictObj);
static void		ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
static int		ZlibStreamSubcmd(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static inline void	ZlibTransformEventTimerKill(ZlibChannelData *cd);
static void		ZlibTransformTimerRun(void *clientData);

/*
 * Type of zlib-based compressing and decompressing channels.
 */

static const Tcl_ChannelType zlibChannelType = {
    "zlib",
    TCL_CHANNEL_VERSION_5,
    NULL,
    ZlibTransformInput,
    ZlibTransformOutput,
    NULL,			/* seekProc */
    ZlibTransformSetOption,
    ZlibTransformGetOption,
    ZlibTransformWatch,
    ZlibTransformGetHandle,
	ZlibTransformClose,			/* close2Proc */
    ZlibTransformBlockMode,
    NULL,			/* flushProc */
    ZlibTransformEventHandler,
    NULL,			/* wideSeekProc */
    NULL,
    NULL
};

/*
 *----------------------------------------------------------------------
 *
 * ConvertError --
 *
 *	Utility function for converting a zlib error into a Tcl error.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates the interpreter result and errorcode.
 *
 *----------------------------------------------------------------------
 */

static void
ConvertError(
    Tcl_Interp *interp,		/* Interpreter to store the error in. May be
				 * NULL, in which case nothing happens. */
    int code,			/* The zlib error code. */
    uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
{
    const char *codeStr, *codeStr2 = NULL;
    char codeStrBuf[TCL_INTEGER_SPACE];

    if (interp == NULL) {
	return;
    }

    switch (code) {
	/*
	 * Firstly, the case that is *different* because it's really coming
	 * from the OS and is just being reported via zlib. It should be
	 * really uncommon because Tcl handles all I/O rather than delegating
	 * it to zlib, but proving it can't happen is hard.
	 */

    case Z_ERRNO:
	Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1));
	return;

	/*
	 * Normal errors/conditions, some of which have additional detail and
	 * some which don't. (This is not defined by array lookup because zlib
	 * error codes are sometimes negative.)
	 */

    case Z_STREAM_ERROR:
	codeStr = "STREAM";
	break;
    case Z_DATA_ERROR:
	codeStr = "DATA";
	break;
    case Z_MEM_ERROR:
	codeStr = "MEM";
	break;
    case Z_BUF_ERROR:
	codeStr = "BUF";
	break;
    case Z_VERSION_ERROR:
	codeStr = "VERSION";
	break;
    case Z_NEED_DICT:
	codeStr = "NEED_DICT";
	codeStr2 = codeStrBuf;
	sprintf(codeStrBuf, "%lu", adler);
	break;

	/*
	 * These should _not_ happen! This function is for dealing with error
	 * cases, not non-errors!
	 */

    case Z_OK:
	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
    case Z_STREAM_END:
	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");

	/*
	 * Anything else is bad news; it's unexpected. Convert to generic
	 * error.
	 */

    default:
	codeStr = "UNKNOWN";
	codeStr2 = codeStrBuf;
	sprintf(codeStrBuf, "%d", code);
	break;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1));

    /*
     * Tricky point! We might pass NULL twice here (and will when the error
     * type is known).
     */

    Tcl_SetErrorCode(interp, "TCL", "ZLIB", codeStr, codeStr2, NULL);
}

static Tcl_Obj *
ConvertErrorToList(
    int code,			/* The zlib error code. */
    uLong adler)		/* The checksum expected (for Z_NEED_DICT) */
{
    Tcl_Obj *objv[4];

    TclNewLiteralStringObj(objv[0], "TCL");
    TclNewLiteralStringObj(objv[1], "ZLIB");
    switch (code) {
    case Z_STREAM_ERROR:
	TclNewLiteralStringObj(objv[2], "STREAM");
	return Tcl_NewListObj(3, objv);
    case Z_DATA_ERROR:
	TclNewLiteralStringObj(objv[2], "DATA");
	return Tcl_NewListObj(3, objv);
    case Z_MEM_ERROR:
	TclNewLiteralStringObj(objv[2], "MEM");
	return Tcl_NewListObj(3, objv);
    case Z_BUF_ERROR:
	TclNewLiteralStringObj(objv[2], "BUF");
	return Tcl_NewListObj(3, objv);
    case Z_VERSION_ERROR:
	TclNewLiteralStringObj(objv[2], "VERSION");
	return Tcl_NewListObj(3, objv);
    case Z_ERRNO:
	TclNewLiteralStringObj(objv[2], "POSIX");
	objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
	return Tcl_NewListObj(4, objv);
    case Z_NEED_DICT:
	TclNewLiteralStringObj(objv[2], "NEED_DICT");
	TclNewIntObj(objv[3], (Tcl_WideInt)adler);
	return Tcl_NewListObj(4, objv);

	/*
	 * These should _not_ happen! This function is for dealing with error
	 * cases, not non-errors!
	 */

    case Z_OK:
	Tcl_Panic("unexpected zlib result in error handler: Z_OK");
    case Z_STREAM_END:
	Tcl_Panic("unexpected zlib result in error handler: Z_STREAM_END");

	/*
	 * Catch-all. Should be unreachable because all cases are already
	 * listed above.
	 */

    default:
	TclNewLiteralStringObj(objv[2], "UNKNOWN");
	TclNewIntObj(objv[3], code);
	return Tcl_NewListObj(4, objv);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * GenerateHeader --
 *
 *	Function for creating a gzip header from the contents of a dictionary
 *	(as described in the documentation). GetValue is a helper function.
 *
 * Results:
 *	A Tcl result code.
 *
 * Side effects:
 *	Updates the fields of the given gz_header structure. Adds amount of
 *	extra space required for the header to the variable referenced by the
 *	extraSizePtr argument.
 *
 *----------------------------------------------------------------------
 */

static inline int
GetValue(
    Tcl_Interp *interp,
    Tcl_Obj *dictObj,
    const char *nameStr,
    Tcl_Obj **valuePtrPtr)
{
    Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1);
    int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr);

    TclDecrRefCount(name);
    return result;
}

static int
GenerateHeader(
    Tcl_Interp *interp,		/* Where to put error messages. */
    Tcl_Obj *dictObj,		/* The dictionary whose contents are to be
				 * parsed. */
    GzipHeader *headerPtr,	/* Where to store the parsed-out values. */
    int *extraSizePtr)		/* Variable to add the length of header
				 * strings (filename, comment) to. */
{
    Tcl_Obj *value;
    int len, result = TCL_ERROR;
    size_t length;
    Tcl_WideInt wideValue = 0;
    const char *valueStr;
    Tcl_Encoding latin1enc;
    static const char *const types[] = {
	"binary", "text"
    };

    /*
     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
     */

    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
    if (latin1enc == NULL) {
	Tcl_Panic("no latin-1 encoding");
    }

    if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetStringFromObj(value, &length);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL,
		headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
		NULL);
	headerPtr->nativeCommentBuf[len] = '\0';
	headerPtr->header.comment = (Bytef *) headerPtr->nativeCommentBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }

    if (GetValue(interp, dictObj, "crc", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL &&
	    Tcl_GetBooleanFromObj(interp, value, &headerPtr->header.hcrc)) {
	goto error;
    }

    if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL) {
	valueStr = TclGetStringFromObj(value, &length);
	Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, 0, NULL,
		headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
	headerPtr->nativeFilenameBuf[len] = '\0';
	headerPtr->header.name = (Bytef *) headerPtr->nativeFilenameBuf;
	if (extraSizePtr != NULL) {
	    *extraSizePtr += len;
	}
    }

    if (GetValue(interp, dictObj, "os", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetIntFromObj(interp, value,
	    &headerPtr->header.os) != TCL_OK) {
	goto error;
    }

    /*
     * Ignore the 'size' field, since that is controlled by the size of the
     * input data.
     */

    if (GetValue(interp, dictObj, "time", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetWideIntFromObj(interp, value,
	    &wideValue) != TCL_OK) {
	goto error;
    }
    headerPtr->header.time = wideValue;

    if (GetValue(interp, dictObj, "type", &value) != TCL_OK) {
	goto error;
    } else if (value != NULL && Tcl_GetIndexFromObj(interp, value, types,
	    "type", TCL_EXACT, &headerPtr->header.text) != TCL_OK) {
	goto error;
    }

    result = TCL_OK;
  error:
    Tcl_FreeEncoding(latin1enc);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ExtractHeader --
 *
 *	Take the values out of a gzip header and store them in a dictionary.
 *	SetValue is a helper macro.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Updates the dictionary, which must be writable (i.e. refCount < 2).
 *
 *----------------------------------------------------------------------
 */

#define SetValue(dictObj, key, value) \
	Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value))

static void
ExtractHeader(
    gz_header *headerPtr,	/* The gzip header to extract from. */
    Tcl_Obj *dictObj)		/* The dictionary to store in. */
{
    Tcl_Encoding latin1enc = NULL;
    Tcl_DString tmp;

    if (headerPtr->comment != Z_NULL) {
	if (latin1enc == NULL) {
	    /*
	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
	     */

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
		&tmp);
	SetValue(dictObj, "comment", TclDStringToObj(&tmp));
    }
    SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
    if (headerPtr->name != Z_NULL) {
	if (latin1enc == NULL) {
	    /*
	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
	     */

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
		&tmp);
	SetValue(dictObj, "filename", TclDStringToObj(&tmp));
    }
    if (headerPtr->os != 255) {
	SetValue(dictObj, "os", Tcl_NewWideIntObj(headerPtr->os));
    }
    if (headerPtr->time != 0 /* magic - no time */) {
	SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time));
    }
    if (headerPtr->text != Z_UNKNOWN) {
	SetValue(dictObj, "type",
		Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1));
    }

    if (latin1enc != NULL) {
	Tcl_FreeEncoding(latin1enc);
    }
}

/*
 * Disentangle the worst of how the zlib API is used.
 */

static int
SetInflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	size_t length = 0;
	unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length);

	return inflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static int
SetDeflateDictionary(
    z_streamp strm,
    Tcl_Obj *compDictObj)
{
    if (compDictObj != NULL) {
	size_t length = 0;
	unsigned char *bytes = TclGetByteArrayFromObj(compDictObj, &length);

	return deflateSetDictionary(strm, bytes, length);
    }
    return Z_OK;
}

static inline int
Deflate(
    z_streamp strm,
    void *bufferPtr,
    size_t bufferSize,
    int flush,
    size_t *writtenPtr)
{
    int e;

    strm->next_out = (Bytef *) bufferPtr;
    strm->avail_out = bufferSize;
    e = deflate(strm, flush);
    if (writtenPtr != NULL) {
	*writtenPtr = bufferSize - strm->avail_out;
    }
    return e;
}

static inline void
AppendByteArray(
    Tcl_Obj *listObj,
    void *buffer,
    size_t size)
{
    if (size > 0) {
	Tcl_Obj *baObj = Tcl_NewByteArrayObj((unsigned char *) buffer, size);

	Tcl_ListObjAppendElement(NULL, listObj, baObj);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamInit --
 *
 *	This command initializes a (de)compression context/handle for
 *	(de)compressing data in chunks.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	The variable pointed to by zshandlePtr is initialised and memory
 *	allocated for internal state. Additionally, if interp is not null, a
 *	Tcl command is created and its name placed in the interp result obj.
 *
 * Note:
 *	At least one of interp and zshandlePtr should be non-NULL or the
 *	reference to the stream will be completely lost.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamInit(
    Tcl_Interp *interp,
    int mode,			/* Either TCL_ZLIB_STREAM_INFLATE or
				 * TCL_ZLIB_STREAM_DEFLATE. */
    int format,			/* Flags from the TCL_ZLIB_FORMAT_* set. */
    int level,			/* 0-9 or TCL_ZLIB_COMPRESS_DEFAULT. */
    Tcl_Obj *dictObj,		/* Dictionary containing headers for gzip. */
    Tcl_ZlibStream *zshandlePtr)
{
    int wbits = 0;
    int e;
    ZlibStreamHandle *zshPtr = NULL;
    Tcl_DString cmdname;
    GzipHeader *gzHeaderPtr = NULL;

    switch (mode) {
    case TCL_ZLIB_STREAM_DEFLATE:
	/*
	 * Compressed format is specified by the wbits parameter. See zlib.h
	 * for details.
	 */

	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    if (dictObj) {
		gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader));
		memset(gzHeaderPtr, 0, sizeof(GzipHeader));
		if (GenerateHeader(interp, dictObj, gzHeaderPtr,
			NULL) != TCL_OK) {
		    Tcl_Free(gzHeaderPtr);
		    return TCL_ERROR;
		}
	    }
	    break;
	case TCL_ZLIB_FORMAT_ZLIB:
	    wbits = WBITS_ZLIB;
	    break;
	default:
	    Tcl_Panic("incorrect zlib data format, must be "
		    "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP or "
		    "TCL_ZLIB_FORMAT_RAW");
	}
	if (level < -1 || level > 9) {
	    Tcl_Panic("compression level should be between 0 (no compression)"
		    " and 9 (best compression) or -1 for default compression "
		    "level");
	}
	break;
    case TCL_ZLIB_STREAM_INFLATE:
	/*
	 * wbits are the same as DEFLATE, but FORMAT_AUTO is valid too.
	 */

	switch (format) {
	case TCL_ZLIB_FORMAT_RAW:
	    wbits = WBITS_RAW;
	    break;
	case TCL_ZLIB_FORMAT_GZIP:
	    wbits = WBITS_GZIP;
	    gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader));
	    memset(gzHeaderPtr, 0, sizeof(GzipHeader));
	    gzHeaderPtr->header.name = (Bytef *)
		    gzHeaderPtr->nativeFilenameBuf;
	    gzHeaderPtr->header.name_max = MAXPATHLEN - 1;
	    gzHeaderPtr->header.comment = (Bytef *)
		    gzHeaderPtr->nativeCommentBuf;
	    gzHeaderPtr->header.name_max = MAX_COMMENT_LEN - 1;
	    break;
	case TCL_ZLIB_FORMAT_ZLIB:
	    wbits = WBITS_ZLIB;
	    break;
	case TCL_ZLIB_FORMAT_AUTO:
	    wbits = WBITS_AUTODETECT;
	    break;
	default:
	    Tcl_Panic("incorrect zlib data format, must be "
		    "TCL_ZLIB_FORMAT_ZLIB, TCL_ZLIB_FORMAT_GZIP, "
		    "TCL_ZLIB_FORMAT_RAW or TCL_ZLIB_FORMAT_AUTO");
	}
	break;
    default:
	Tcl_Panic("bad mode, must be TCL_ZLIB_STREAM_DEFLATE or"
		" TCL_ZLIB_STREAM_INFLATE");
    }

    zshPtr = (ZlibStreamHandle *)Tcl_Alloc(sizeof(ZlibStreamHandle));
    zshPtr->interp = interp;
    zshPtr->mode = mode;
    zshPtr->format = format;
    zshPtr->level = level;
    zshPtr->wbits = wbits;
    zshPtr->currentInput = NULL;
    zshPtr->streamEnd = 0;
    zshPtr->compDictObj = NULL;
    zshPtr->flags = 0;
    zshPtr->gzHeaderPtr = gzHeaderPtr;
    memset(&zshPtr->stream, 0, sizeof(z_stream));
    zshPtr->stream.adler = 1;

    /*
     * No output buffer available yet
     */

    if (mode == TCL_ZLIB_STREAM_DEFLATE) {
	e = deflateInit2(&zshPtr->stream, level, Z_DEFLATED, wbits,
		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
	if (e == Z_OK && zshPtr->gzHeaderPtr) {
	    e = deflateSetHeader(&zshPtr->stream,
		    &zshPtr->gzHeaderPtr->header);
	}
    } else {
	e = inflateInit2(&zshPtr->stream, wbits);
	if (e == Z_OK && zshPtr->gzHeaderPtr) {
	    e = inflateGetHeader(&zshPtr->stream,
		    &zshPtr->gzHeaderPtr->header);
	}
    }

    if (e != Z_OK) {
	ConvertError(interp, e, zshPtr->stream.adler);
	goto error;
    }

    /*
     * I could do all this in C, but this is easier.
     */

    if (interp != NULL) {
	if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", -1, 0) != TCL_OK) {
	    goto error;
	}
	Tcl_DStringInit(&cmdname);
	TclDStringAppendLiteral(&cmdname, "::tcl::zlib::streamcmd_");
	TclDStringAppendObj(&cmdname, Tcl_GetObjResult(interp));
	if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname),
		NULL, 0) != NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "BUG: Stream command name already exists", -1));
	    Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", NULL);
	    Tcl_DStringFree(&cmdname);
	    goto error;
	}
	Tcl_ResetResult(interp);

	/*
	 * Create the command.
	 */

	zshPtr->cmd = Tcl_CreateObjCommand(interp, Tcl_DStringValue(&cmdname),
		ZlibStreamCmd, zshPtr, ZlibStreamCmdDelete);
	Tcl_DStringFree(&cmdname);
	if (zshPtr->cmd == NULL) {
	    goto error;
	}
    } else {
	zshPtr->cmd = NULL;
    }

    /*
     * Prepare the buffers for use.
     */

    zshPtr->inData = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(zshPtr->inData);
    zshPtr->outData = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(zshPtr->outData);

    zshPtr->outPos = 0;

    /*
     * Now set the variable pointed to by *zshandlePtr to the pointer to the
     * zsh struct.
     */

    if (zshandlePtr) {
	*zshandlePtr = (Tcl_ZlibStream) zshPtr;
    }

    return TCL_OK;

  error:
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	Tcl_Free(zshPtr->gzHeaderPtr);
    }
    Tcl_Free(zshPtr);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStreamCmdDelete --
 *
 *	This is the delete command which Tcl invokes when a zlibstream command
 *	is deleted from the interpreter (on stream close, usually).
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
 *
 *----------------------------------------------------------------------
 */

static void
ZlibStreamCmdDelete(
    void *cd)
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd;

    zshPtr->cmd = NULL;
    ZlibStreamCleanup(zshPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamClose --
 *
 *	This procedure must be called after (de)compression is done to ensure
 *	memory is freed and the command is deleted from the interpreter (if
 *	any).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Invalidates the zlib stream handle as obtained from Tcl_ZlibStreamInit
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamClose(
    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit. */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;

    /*
     * If the interp is set, deleting the command will trigger
     * ZlibStreamCleanup in ZlibStreamCmdDelete. If no interp is set, call
     * ZlibStreamCleanup directly.
     */

    if (zshPtr->interp && zshPtr->cmd) {
	Tcl_DeleteCommandFromToken(zshPtr->interp, zshPtr->cmd);
    } else {
	ZlibStreamCleanup(zshPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStreamCleanup --
 *
 *	This procedure is called by either Tcl_ZlibStreamClose or
 *	ZlibStreamCmdDelete to cleanup the stream context.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	Invalidates the zlib stream handle.
 *
 *----------------------------------------------------------------------
 */

void
ZlibStreamCleanup(
    ZlibStreamHandle *zshPtr)
{
    if (!zshPtr->streamEnd) {
	if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    deflateEnd(&zshPtr->stream);
	} else {
	    inflateEnd(&zshPtr->stream);
	}
    }

    if (zshPtr->inData) {
	Tcl_DecrRefCount(zshPtr->inData);
    }
    if (zshPtr->outData) {
	Tcl_DecrRefCount(zshPtr->outData);
    }
    if (zshPtr->currentInput) {
	Tcl_DecrRefCount(zshPtr->currentInput);
    }
    if (zshPtr->compDictObj) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    if (zshPtr->gzHeaderPtr) {
	Tcl_Free(zshPtr->gzHeaderPtr);
    }

    Tcl_Free(zshPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamReset --
 *
 *	This procedure will reinitialize an existing stream handle.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Any data left in the (de)compression buffer is lost.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamReset(
    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    int e;

    if (!zshPtr->streamEnd) {
	if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    deflateEnd(&zshPtr->stream);
	} else {
	    inflateEnd(&zshPtr->stream);
	}
    }
    Tcl_SetByteArrayLength(zshPtr->inData, 0);
    Tcl_SetByteArrayLength(zshPtr->outData, 0);
    if (zshPtr->currentInput) {
	Tcl_DecrRefCount(zshPtr->currentInput);
	zshPtr->currentInput = NULL;
    }

    zshPtr->outPos = 0;
    zshPtr->streamEnd = 0;
    memset(&zshPtr->stream, 0, sizeof(z_stream));

    /*
     * No output buffer available yet.
     */

    if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
	e = deflateInit2(&zshPtr->stream, zshPtr->level, Z_DEFLATED,
		zshPtr->wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
	if (e == Z_OK && HaveDictToSet(zshPtr)) {
	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e == Z_OK) {
		DictWasSet(zshPtr);
	    }
	}
    } else {
	e = inflateInit2(&zshPtr->stream, zshPtr->wbits);
	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr) && e == Z_OK) {
	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e == Z_OK) {
		DictWasSet(zshPtr);
	    }
	}
    }

    if (e != Z_OK) {
	ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
	/* TODO:cleanup */
	return TCL_ERROR;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamGetCommandName --
 *
 *	This procedure will return the command name associated with the
 *	stream.
 *
 * Results:
 *	A Tcl_Obj with the name of the Tcl command or NULL if no command is
 *	associated with the stream.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_ZlibStreamGetCommandName(
    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    Tcl_Obj *objPtr;

    if (!zshPtr->interp) {
	return NULL;
    }

    TclNewObj(objPtr);
    Tcl_GetCommandFullName(zshPtr->interp, zshPtr->cmd, objPtr);
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamEof --
 *
 *	This procedure This function returns 0 or 1 depending on the state of
 *	the (de)compressor. For decompression, eof is reached when the entire
 *	compressed stream has been decompressed. For compression, eof is
 *	reached when the stream has been flushed with TCL_ZLIB_FINALIZE.
 *
 * Results:
 *	Integer.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamEof(
    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;

    return zshPtr->streamEnd;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamChecksum --
 *
 *	Return the checksum of the uncompressed data seen so far by the
 *	stream.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamChecksum(
    Tcl_ZlibStream zshandle)	/* As obtained from Tcl_ZlibStreamInit */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;

    return zshPtr->stream.adler;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamSetCompressionDictionary --
 *
 *	Sets the compression dictionary for a stream. This will be used as
 *	appropriate for the next compression or decompression action performed
 *	on the stream.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ZlibStreamSetCompressionDictionary(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *compressionDictionaryObj)
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;

    if (compressionDictionaryObj && (NULL == TclGetBytesFromObj(NULL,
	    compressionDictionaryObj, NULL))) {
	/* Missing or invalid compression dictionary */
	compressionDictionaryObj = NULL;
    }
    if (compressionDictionaryObj != NULL) {
	if (Tcl_IsShared(compressionDictionaryObj)) {
	    compressionDictionaryObj =
		    Tcl_DuplicateObj(compressionDictionaryObj);
	}
	Tcl_IncrRefCount(compressionDictionaryObj);
	zshPtr->flags |= DICT_TO_SET;
    } else {
	zshPtr->flags &= ~DICT_TO_SET;
    }
    if (zshPtr->compDictObj != NULL) {
	Tcl_DecrRefCount(zshPtr->compDictObj);
    }
    zshPtr->compDictObj = compressionDictionaryObj;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamPut --
 *
 *	Add data to the stream for compression or decompression from a
 *	bytearray Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

#define BUFFER_SIZE_LIMIT	0xFFFF

int
Tcl_ZlibStreamPut(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* Data to compress/decompress */
    int flush)			/* TCL_ZLIB_NO_FLUSH, TCL_ZLIB_FLUSH,
				 * TCL_ZLIB_FULLFLUSH, or TCL_ZLIB_FINALIZE */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    char *dataTmp = NULL;
    int e;
    size_t size = 0, outSize, toStore;
    unsigned char *bytes;

    if (zshPtr->streamEnd) {
	if (zshPtr->interp) {
	    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
		    "already past compressed stream end", -1));
	    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", NULL);
	}
	return TCL_ERROR;
    }

    bytes = TclGetBytesFromObj(zshPtr->interp, data, &size);
    if (bytes == NULL) {
	return TCL_ERROR;
    }

    if (zshPtr->mode == TCL_ZLIB_STREAM_DEFLATE) {
	zshPtr->stream.next_in = bytes;
	zshPtr->stream.avail_in = size;

	/*
	 * Must not do a zero-length compress unless finalizing. [Bug 25842c161]
	 */

	if (size == 0 && flush != Z_FINISH) {
	    return TCL_OK;
	}

	if (HaveDictToSet(zshPtr)) {
	    e = SetDeflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e != Z_OK) {
		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		return TCL_ERROR;
	    }
	    DictWasSet(zshPtr);
	}

	/*
	 * deflateBound() doesn't seem to take various header sizes into
	 * account, so we add 100 extra bytes. However, we can also loop
	 * around again so we also set an upper bound on the output buffer
	 * size.
	 */

	outSize = deflateBound(&zshPtr->stream, size) + 100;
	if (outSize > BUFFER_SIZE_LIMIT) {
	    outSize = BUFFER_SIZE_LIMIT;
	}
	dataTmp = (char *)Tcl_Alloc(outSize);

	while (1) {
	    e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore);

	    /*
	     * Test if we've filled the buffer up and have to ask deflate() to
	     * give us some more. Note that the condition for needing to
	     * repeat a buffer transfer when the result is Z_OK is whether
	     * there is no more space in the buffer we provided; the zlib
	     * library does not necessarily return a different code in that
	     * case. [Bug b26e38a3e4] [Tk Bug 10f2e7872b]
	     */

	    if ((e != Z_BUF_ERROR) && (e != Z_OK || toStore < outSize)) {
		if ((e == Z_OK) || (flush == Z_FINISH && e == Z_STREAM_END)) {
		    break;
		}
		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		return TCL_ERROR;
	    }

	    /*
	     * Output buffer too small to hold the data being generated or we
	     * are doing the end-of-stream flush (which can spit out masses of
	     * data). This means we need to put a new buffer into place after
	     * saving the old generated data to the outData list.
	     */

	    AppendByteArray(zshPtr->outData, dataTmp, outSize);

	    if (outSize < BUFFER_SIZE_LIMIT) {
		outSize = BUFFER_SIZE_LIMIT;
		/* There may be *lots* of data left to output... */
		dataTmp = (char *)Tcl_Realloc(dataTmp, outSize);
	    }
	}

	/*
	 * And append the final data block to the outData list.
	 */

	AppendByteArray(zshPtr->outData, dataTmp, toStore);
	Tcl_Free(dataTmp);
    } else {
	/*
	 * This is easy. Just append to the inData list.
	 */

	Tcl_ListObjAppendElement(NULL, zshPtr->inData, data);

	/*
	 * and we'll need the flush parameter for the Inflate call.
	 */

	zshPtr->flush = flush;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibStreamGet --
 *
 *	Retrieve data (now compressed or decompressed) from the stream into a
 *	bytearray Tcl_Obj.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,	/* As obtained from Tcl_ZlibStreamInit */
    Tcl_Obj *data,		/* A place to append the data. */
    size_t count)			/* Number of bytes to grab as a maximum, you
				 * may get less! */
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle;
    int e, i, listLen;
    size_t itemLen = 0, dataPos = 0;
    Tcl_Obj *itemObj;
    unsigned char *dataPtr, *itemPtr;
    size_t existing = 0;

    /*
     * Getting beyond the of stream, just return empty string.
     */

    if (zshPtr->streamEnd) {
	return TCL_OK;
    }

    if (NULL == TclGetBytesFromObj(zshPtr->interp, data, &existing)) {
	return TCL_ERROR;
    }

    if (zshPtr->mode == TCL_ZLIB_STREAM_INFLATE) {
	if (count == TCL_INDEX_NONE) {
	    /*
	     * The only safe thing to do is restict to 65k. We might cause a
	     * panic for out of memory if we just kept growing the buffer.
	     */

	    count = MAX_BUFFER_SIZE;
	}

	/*
	 * Prepare the place to store the data.
	 */

	dataPtr = Tcl_SetByteArrayLength(data, existing+count);
	dataPtr += existing;

	zshPtr->stream.next_out = dataPtr;
	zshPtr->stream.avail_out = count;
	if (zshPtr->stream.avail_in == 0) {
	    /*
	     * zlib will probably need more data to decompress.
	     */

	    if (zshPtr->currentInput) {
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = NULL;
	    }
	    Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);
	    if (listLen > 0) {
		/*
		 * There is more input available, get it from the list and
		 * give it to zlib. At this point, the data must not be shared
		 * since we require the bytearray representation to not vanish
		 * under our feet. [Bug 3081008]
		 */

		Tcl_ListObjIndex(NULL, zshPtr->inData, 0, &itemObj);
		if (Tcl_IsShared(itemObj)) {
		    itemObj = Tcl_DuplicateObj(itemObj);
		}
		itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
		Tcl_IncrRefCount(itemObj);
		zshPtr->currentInput = itemObj;
		zshPtr->stream.next_in = itemPtr;
		zshPtr->stream.avail_in = itemLen;

		/*
		 * And remove it from the list
		 */

		Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
	    }
	}

	/*
	 * When dealing with a raw stream, we set the dictionary here, once.
	 * (You can't do it in response to getting Z_NEED_DATA as raw streams
	 * don't ever issue that.)
	 */

	if (IsRawStream(zshPtr) && HaveDictToSet(zshPtr)) {
	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e != Z_OK) {
		ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
		return TCL_ERROR;
	    }
	    DictWasSet(zshPtr);
	}
	e = inflate(&zshPtr->stream, zshPtr->flush);
	if (e == Z_NEED_DICT && HaveDictToSet(zshPtr)) {
	    e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj);
	    if (e == Z_OK) {
		DictWasSet(zshPtr);
		e = inflate(&zshPtr->stream, zshPtr->flush);
	    }
	};
	Tcl_ListObjLength(NULL, zshPtr->inData, &listLen);

	while ((zshPtr->stream.avail_out > 0)
		&& (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) {
	    /*
	     * State: We have not satisfied the request yet and there may be
	     * more to inflate.
	     */

	    if (zshPtr->stream.avail_in > 0) {
		if (zshPtr->interp) {
		    Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj(
			    "unexpected zlib internal state during"
			    " decompression", -1));
		    Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE",
			    NULL);
		}
		Tcl_SetByteArrayLength(data, existing);
		return TCL_ERROR;
	    }

	    if (zshPtr->currentInput) {
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = 0;
	    }

	    /*
	     * Get the next block of data to go to inflate. At this point, the
	     * data must not be shared since we require the bytearray
	     * representation to not vanish under our feet. [Bug 3081008]
	     */

	    Tcl_ListObjIndex(zshPtr->interp, zshPtr->inData, 0, &itemObj);
	    if (Tcl_IsShared(itemObj)) {
		itemObj = Tcl_DuplicateObj(itemObj);
	    }
	    itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
	    Tcl_IncrRefCount(itemObj);
	    zshPtr->currentInput = itemObj;
	    zshPtr->stream.next_in = itemPtr;
	    zshPtr->stream.avail_in = itemLen;

	    /*
	     * Remove it from the list.
	     */

	    Tcl_ListObjReplace(NULL, zshPtr->inData, 0, 1, 0, NULL);
	    listLen--;

	    /*
	     * And call inflate again.
	     */

	    do {
		e = inflate(&zshPtr->stream, zshPtr->flush);
		if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) {
		    break;
		}
		e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj);
		DictWasSet(zshPtr);
	    } while (e == Z_OK);
	}
	if (zshPtr->stream.avail_out > 0) {
	    Tcl_SetByteArrayLength(data,
		    existing + count - zshPtr->stream.avail_out);
	}
	if (!(e==Z_OK || e==Z_STREAM_END || e==Z_BUF_ERROR)) {
	    Tcl_SetByteArrayLength(data, existing);
	    ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
	    return TCL_ERROR;
	}
	if (e == Z_STREAM_END) {
	    zshPtr->streamEnd = 1;
	    if (zshPtr->currentInput) {
		Tcl_DecrRefCount(zshPtr->currentInput);
		zshPtr->currentInput = 0;
	    }
	    inflateEnd(&zshPtr->stream);
	}
    } else {
	Tcl_ListObjLength(NULL, zshPtr->outData, &listLen);
	if (count == TCL_INDEX_NONE) {
	    count = 0;
	    for (i=0; i<listLen; i++) {
		Tcl_ListObjIndex(NULL, zshPtr->outData, i, &itemObj);
		(void) TclGetByteArrayFromObj(itemObj, &itemLen);
		if (i == 0) {
		    count += itemLen - zshPtr->outPos;
		} else {
		    count += itemLen;
		}
	    }
	}

	/*
	 * Prepare the place to store the data.
	 */

	dataPtr = Tcl_SetByteArrayLength(data, existing + count);
	dataPtr += existing;

	while ((count > dataPos) &&
		(Tcl_ListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK)
		&& (listLen > 0)) {
	    /*
	     * Get the next chunk off our list of chunks and grab the data out
	     * of it.
	     */

	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
	    itemPtr = TclGetByteArrayFromObj(itemObj, &itemLen);
	    if (itemLen-zshPtr->outPos + dataPos >= count) {
		size_t len = count - dataPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		zshPtr->outPos += len;
		dataPos += len;
		if (zshPtr->outPos == itemLen) {
		    zshPtr->outPos = 0;
		}
	    } else {
		size_t len = itemLen - zshPtr->outPos;

		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
		dataPos += len;
		zshPtr->outPos = 0;
	    }
	    if (zshPtr->outPos == 0) {
		Tcl_ListObjReplace(NULL, zshPtr->outData, 0, 1, 0, NULL);
		listLen--;
	    }
	}
	Tcl_SetByteArrayLength(data, existing + dataPos);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibDeflate --
 *
 *	Compress the contents of Tcl_Obj *data with compression level in
 *	output format, producing the compressed data in the interpreter
 *	result.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibDeflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int level,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0, extraSize = 0;
    size_t inLen = 0;
    Byte *inData = NULL;
    z_stream stream;
    GzipHeader header;
    gz_header *headerPtr = NULL;
    Tcl_Obj *obj;

    if (!interp) {
	return TCL_ERROR;
    }

    /*
     * Obtain the pointer to the byte array, we'll pass this pointer straight
     * to the deflate command.
     */

    inData = TclGetBytesFromObj(interp, data, &inLen);
    if (inData == NULL) {
	return TCL_ERROR;
    }

    /*
     * Compressed format is specified by the wbits parameter. See zlib.h for
     * details.
     */

    if (format == TCL_ZLIB_FORMAT_RAW) {
	wbits = WBITS_RAW;
    } else if (format == TCL_ZLIB_FORMAT_GZIP) {
	wbits = WBITS_GZIP;

	/*
	 * Need to allocate extra space for the gzip header and footer. The
	 * amount of space is (a bit less than) 32 bytes, plus a byte for each
	 * byte of string that we add. Note that over-allocation is not a
	 * problem. [Bug 2419061]
	 */

	extraSize = 32;
	if (gzipHeaderDictObj) {
	    headerPtr = &header.header;
	    memset(headerPtr, 0, sizeof(gz_header));
	    if (GenerateHeader(interp, gzipHeaderDictObj, &header,
		    &extraSize) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
    } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
	wbits = WBITS_ZLIB;
    } else {
	Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
		"TCL_ZLIB_FORMAT_GZIP or TCL_ZLIB_FORMAT_ZLIB");
    }

    if (level < -1 || level > 9) {
	Tcl_Panic("compression level should be between 0 (uncompressed) and "
		"9 (best compression) or -1 for default compression level");
    }

    /*
     * Allocate some space to store the output.
     */

    TclNewObj(obj);

    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = inLen;
    stream.next_in = inData;

    /*
     * No output buffer available yet, will alloc after deflateInit2.
     */

    e = deflateInit2(&stream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL,
	    Z_DEFAULT_STRATEGY);
    if (e != Z_OK) {
	goto error;
    }

    if (headerPtr != NULL) {
	e = deflateSetHeader(&stream, headerPtr);
	if (e != Z_OK) {
	    goto error;
	}
    }

    /*
     * Allocate the output buffer from the value of deflateBound(). This is
     * probably too much space. Before returning to the caller, we will reduce
     * it back to the actual compressed size.
     */

    stream.avail_out = deflateBound(&stream, inLen) + extraSize;
    stream.next_out = Tcl_SetByteArrayLength(obj, stream.avail_out);

    /*
     * Perform the compression, Z_FINISH means do it in one go.
     */

    e = deflate(&stream, Z_FINISH);

    if (e != Z_STREAM_END) {
	e = deflateEnd(&stream);

	/*
	 * deflateEnd() returns Z_OK when there are bytes left to compress, at
	 * this point we consider that an error, although we could continue by
	 * allocating more memory and calling deflate() again.
	 */

	if (e == Z_OK) {
	    e = Z_BUF_ERROR;
	}
    } else {
	e = deflateEnd(&stream);
    }

    if (e != Z_OK) {
	goto error;
    }

    /*
     * Reduce the bytearray length to the actual data length produced by
     * deflate.
     */

    Tcl_SetByteArrayLength(obj, stream.total_out);
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;

  error:
    ConvertError(interp, e, stream.adler);
    TclDecrRefCount(obj);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibInflate --
 *
 *	Decompress data in an object into the interpreter result.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    size_t bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    int wbits = 0, e = 0;
    size_t inLen = 0, newBufferSize;
    Byte *inData = NULL, *outData = NULL, *newOutData = NULL;
    z_stream stream;
    gz_header header, *headerPtr = NULL;
    Tcl_Obj *obj;
    char *nameBuf = NULL, *commentBuf = NULL;

    if (!interp) {
	return TCL_ERROR;
    }

    inData = TclGetBytesFromObj(interp, data, &inLen);
    if (inData == NULL) {
	return TCL_ERROR;
    }

    /*
     * Compressed format is specified by the wbits parameter. See zlib.h for
     * details.
     */

    switch (format) {
    case TCL_ZLIB_FORMAT_RAW:
	wbits = WBITS_RAW;
	gzipHeaderDictObj = NULL;
	break;
    case TCL_ZLIB_FORMAT_ZLIB:
	wbits = WBITS_ZLIB;
	gzipHeaderDictObj = NULL;
	break;
    case TCL_ZLIB_FORMAT_GZIP:
	wbits = WBITS_GZIP;
	break;
    case TCL_ZLIB_FORMAT_AUTO:
	wbits = WBITS_AUTODETECT;
	break;
    default:
	Tcl_Panic("incorrect zlib data format, must be TCL_ZLIB_FORMAT_ZLIB, "
		"TCL_ZLIB_FORMAT_GZIP, TCL_ZLIB_FORMAT_RAW or "
		"TCL_ZLIB_FORMAT_AUTO");
    }

    if (gzipHeaderDictObj) {
	headerPtr = &header;
	memset(headerPtr, 0, sizeof(gz_header));
	nameBuf = (char *)Tcl_Alloc(MAXPATHLEN);
	header.name = (Bytef *) nameBuf;
	header.name_max = MAXPATHLEN - 1;
	commentBuf = (char *)Tcl_Alloc(MAX_COMMENT_LEN);
	header.comment = (Bytef *) commentBuf;
	header.comm_max = MAX_COMMENT_LEN - 1;
    }

    if (bufferSize < 1) {
	/*
	 * Start with a buffer (up to) 3 times the size of the input data.
	 */

	if (inLen < 32*1024*1024) {
	    bufferSize = 3*inLen;
	} else if (inLen < 256*1024*1024) {
	    bufferSize = 2*inLen;
	} else {
	    bufferSize = inLen;
	}
    }

    TclNewObj(obj);
    outData = Tcl_SetByteArrayLength(obj, bufferSize);
    memset(&stream, 0, sizeof(z_stream));
    stream.avail_in = inLen+1;	/* +1 because zlib can "over-request"
					 * input (but ignore it!) */
    stream.next_in = inData;
    stream.avail_out = bufferSize;
    stream.next_out = outData;

    /*
     * Initialize zlib for decompression.
     */

    e = inflateInit2(&stream, wbits);
    if (e != Z_OK) {
	goto error;
    }
    if (headerPtr) {
	e = inflateGetHeader(&stream, headerPtr);
	if (e != Z_OK) {
	    inflateEnd(&stream);
	    goto error;
	}
    }

    /*
     * Start the decompression cycle.
     */

    while (1) {
	e = inflate(&stream, Z_FINISH);
	if (e != Z_BUF_ERROR) {
	    break;
	}

	/*
	 * Not enough room in the output buffer. Increase it by five times the
	 * bytes still in the input buffer. (Because 3 times didn't do the
	 * trick before, 5 times is what we do next.) Further optimization
	 * should be done by the user, specify the decompressed size!
	 */

	if ((stream.avail_in == 0) && (stream.avail_out > 0)) {
	    e = Z_STREAM_ERROR;
	    break;
	}
	newBufferSize = bufferSize + 5 * stream.avail_in;
	if (newBufferSize == bufferSize) {
	    newBufferSize = bufferSize+1000;
	}
	newOutData = Tcl_SetByteArrayLength(obj, newBufferSize);

	/*
	 * Set next out to the same offset in the new location.
	 */

	stream.next_out = newOutData + stream.total_out;

	/*
	 * And increase avail_out with the number of new bytes allocated.
	 */

	stream.avail_out += newBufferSize - bufferSize;
	outData = newOutData;
	bufferSize = newBufferSize;
    }

    if (e != Z_STREAM_END) {
	inflateEnd(&stream);
	goto error;
    }

    e = inflateEnd(&stream);
    if (e != Z_OK) {
	goto error;
    }

    /*
     * Reduce the BA length to the actual data length produced by deflate.
     */

    Tcl_SetByteArrayLength(obj, stream.total_out);
    if (headerPtr != NULL) {
	ExtractHeader(&header, gzipHeaderDictObj);
	SetValue(gzipHeaderDictObj, "size",
		Tcl_NewWideIntObj(stream.total_out));
	Tcl_Free(nameBuf);
	Tcl_Free(commentBuf);
    }
    Tcl_SetObjResult(interp, obj);
    return TCL_OK;

  error:
    TclDecrRefCount(obj);
    ConvertError(interp, e, stream.adler);
    if (nameBuf) {
	Tcl_Free(nameBuf);
    }
    if (commentBuf) {
	Tcl_Free(commentBuf);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ZlibCRC32, Tcl_ZlibAdler32 --
 *
 *	Access to the checksumming engines.
 *
 *----------------------------------------------------------------------
 */

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const unsigned char *buf,
    size_t len)
{
    /* Nothing much to do, just wrap the crc32(). */
    return crc32(crc, (Bytef *) buf, len);
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const unsigned char *buf,
    size_t len)
{
    return adler32(adler, (Bytef *) buf, len);
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibCmd --
 *
 *	Implementation of the [zlib] command.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    int command, i, option, level = -1;
    size_t dlen = 0, start, buffersize = 0;
    Tcl_WideInt wideLen;
    Byte *data;
    Tcl_Obj *headerDictObj;
    const char *extraInfoStr = NULL;
    static const char *const commands[] = {
	"adler32", "compress", "crc32", "decompress", "deflate", "gunzip",
	"gzip", "inflate", "push", "stream",
	NULL
    };
    enum zlibCommands {
	CMD_ADLER, CMD_COMPRESS, CMD_CRC, CMD_DECOMPRESS, CMD_DEFLATE,
	CMD_GUNZIP, CMD_GZIP, CMD_INFLATE, CMD_PUSH, CMD_STREAM
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command arg ?...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], commands, "command", 0,
	    &command) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum zlibCommands) command) {
    case CMD_ADLER:			/* adler32 str ?startvalue?
					 * -> checksum */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
	    return TCL_ERROR;
	}
	data = TclGetBytesFromObj(interp, objv[2], &dlen);
	if (data == NULL) {
	    return TCL_ERROR;
	}
	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
		(int *) &start) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc < 4) {
	    start = Tcl_ZlibAdler32(0, NULL, 0);
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
		(uLong) Tcl_ZlibAdler32(start, data, dlen)));
	return TCL_OK;
    case CMD_CRC:			/* crc32 str ?startvalue?
					 * -> checksum */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?");
	    return TCL_ERROR;
	}
	data = TclGetBytesFromObj(interp, objv[2], &dlen);
	if (data == NULL) {
	    return TCL_ERROR;
	}
	if (objc>3 && Tcl_GetIntFromObj(interp, objv[3],
		(int *) &start) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (objc < 4) {
	    start = Tcl_ZlibCRC32(0, NULL, 0);
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
		(uLong) Tcl_ZlibCRC32(start, data, dlen)));
	return TCL_OK;
    case CMD_DEFLATE:			/* deflate data ?level?
					 * -> rawCompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (level < 0 || level > 9) {
		goto badLevel;
	    }
	}
	return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level,
		NULL);
    case CMD_COMPRESS:			/* compress data ?level?
					 * -> zlibCompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?level?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetIntFromObj(interp, objv[3], &level) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (level < 0 || level > 9) {
		goto badLevel;
	    }
	}
	return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level,
		NULL);
    case CMD_GZIP:			/* gzip data ?level?
					 * -> gzippedCompressedData */
	headerDictObj = NULL;

	/*
	 * Legacy argument format support.
	 */

	if (objc == 4
		&& Tcl_GetIntFromObj(interp, objv[3], &level) == TCL_OK) {
	    if (level < 0 || level > 9) {
		extraInfoStr = "\n    (in -level option)";
		goto badLevel;
	    }
	    return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2],
		    level, NULL);
	}

	if (objc < 3 || objc > 7 || ((objc & 1) == 0)) {
	    Tcl_WrongNumArgs(interp, 2, objv,
		    "data ?-level level? ?-header header?");
	    return TCL_ERROR;
	}
	for (i=3 ; i<objc ; i+=2) {
	    static const char *const gzipopts[] = {
		"-header", "-level", NULL
	    };

	    if (Tcl_GetIndexFromObj(interp, objv[i], gzipopts, "option", 0,
		    &option) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (option) {
	    case 0:
		headerDictObj = objv[i+1];
		break;
	    case 1:
		if (Tcl_GetIntFromObj(interp, objv[i+1],
			&level) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (level < 0 || level > 9) {
		    extraInfoStr = "\n    (in -level option)";
		    goto badLevel;
		}
		break;
	    }
	}
	return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level,
		headerDictObj);
    case CMD_INFLATE:			/* inflate rawcomprdata ?bufferSize?
					 *	-> decompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetWideIntFromObj(interp, objv[3],
		    &wideLen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (wideLen < MIN_NONSTREAM_BUFFER_SIZE
		    || wideLen > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }
	    buffersize = wideLen;
	}
	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2],
		buffersize, NULL);
    case CMD_DECOMPRESS:		/* decompress zlibcomprdata \
					 *    ?bufferSize?
					 *	-> decompressedData */
	if (objc < 3 || objc > 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?");
	    return TCL_ERROR;
	}
	if (objc > 3) {
	    if (Tcl_GetWideIntFromObj(interp, objv[3],
		    &wideLen) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (wideLen < MIN_NONSTREAM_BUFFER_SIZE
		    || wideLen > MAX_BUFFER_SIZE) {
		goto badBuffer;
	    }
	    buffersize = wideLen;
	}
	return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2],
		buffersize, NULL);
    case CMD_GUNZIP: {			/* gunzip gzippeddata ?bufferSize?
					 *	-> decompressedData */
	Tcl_Obj *headerVarObj;

	if (objc < 3 || objc > 5 || ((objc & 1) == 0)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "data ?-headerVar varName?");
	    return TCL_ERROR;
	}
	headerDictObj = headerVarObj = NULL;
	for (i=3 ; i<objc ; i+=2) {
	    static const char *const gunzipopts[] = {
		"-buffersize", "-headerVar", NULL
	    };

	    if (Tcl_GetIndexFromObj(interp, objv[i], gunzipopts, "option", 0,
		    &option) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch (option) {
	    case 0:
		if (Tcl_GetWideIntFromObj(interp, objv[i+1],
			&wideLen) != TCL_OK) {
		    return TCL_ERROR;
		}
		if (wideLen < MIN_NONSTREAM_BUFFER_SIZE
			|| wideLen > MAX_BUFFER_SIZE) {
		    goto badBuffer;
		}
		buffersize = wideLen;
		break;
	    case 1:
		headerVarObj = objv[i+1];
		TclNewObj(headerDictObj);
		break;
	    }
	}
	if (Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2],
		buffersize, headerDictObj) != TCL_OK) {
	    if (headerDictObj) {
		TclDecrRefCount(headerDictObj);
	    }
	    return TCL_ERROR;
	}
	if (headerVarObj != NULL && Tcl_ObjSetVar2(interp, headerVarObj, NULL,
		headerDictObj, TCL_LEAVE_ERR_MSG) == NULL) {
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    case CMD_STREAM:			/* stream deflate/inflate/...gunzip \
					 *    ?options...?
					 *	-> handleCmd */
	return ZlibStreamSubcmd(interp, objc, objv);
    case CMD_PUSH:			/* push mode channel options...
					 *	-> channel */
	return ZlibPushSubcmd(interp, objc, objv);
    };

    return TCL_ERROR;

  badLevel:
    Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
    if (extraInfoStr) {
	Tcl_AddErrorInfo(interp, extraInfoStr);
    }
    return TCL_ERROR;
  badBuffer:
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "buffer size must be %d to %d",
	    MIN_NONSTREAM_BUFFER_SIZE, MAX_BUFFER_SIZE));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStreamSubcmd --
 *
 *	Implementation of the [zlib stream] subcommand.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibStreamSubcmd(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const stream_formats[] = {
	"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
	NULL
    };
    enum zlibFormats {
	FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
	FMT_INFLATE
    };
    int i, format, mode = 0, option, level;
    enum objIndices {
	OPT_COMPRESSION_DICTIONARY = 0,
	OPT_GZIP_HEADER = 1,
	OPT_COMPRESSION_LEVEL = 2,
	OPT_END = -1
    };
    Tcl_Obj *obj[3] = { NULL, NULL, NULL };
#define compDictObj	obj[OPT_COMPRESSION_DICTIONARY]
#define gzipHeaderObj	obj[OPT_GZIP_HEADER]
#define levelObj	obj[OPT_COMPRESSION_LEVEL]
    typedef struct {
	const char *name;
	enum objIndices offset;
    } OptDescriptor;
    static const OptDescriptor compressionOpts[] = {
	{ "-dictionary", OPT_COMPRESSION_DICTIONARY },
	{ "-level",	 OPT_COMPRESSION_LEVEL },
	{ NULL, OPT_END }
    };
    static const OptDescriptor gzipOpts[] = {
	{ "-header",	 OPT_GZIP_HEADER },
	{ "-level",	 OPT_COMPRESSION_LEVEL },
	{ NULL, OPT_END }
    };
    static const OptDescriptor expansionOpts[] = {
	{ "-dictionary", OPT_COMPRESSION_DICTIONARY },
	{ NULL, OPT_END }
    };
    static const OptDescriptor gunzipOpts[] = {
	{ NULL, OPT_END }
    };
    const OptDescriptor *desc = NULL;
    Tcl_ZlibStream zh;

    if (objc < 3 || !(objc & 1)) {
	Tcl_WrongNumArgs(interp, 2, objv, "mode ?-option value...?");
	return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
	    &format) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * The format determines the compression mode and the options that may be
     * specified.
     */

    switch ((enum zlibFormats) format) {
    case FMT_DEFLATE:
	desc = compressionOpts;
	mode = TCL_ZLIB_STREAM_DEFLATE;
	format = TCL_ZLIB_FORMAT_RAW;
	break;
    case FMT_INFLATE:
	desc = expansionOpts;
	mode = TCL_ZLIB_STREAM_INFLATE;
	format = TCL_ZLIB_FORMAT_RAW;
	break;
    case FMT_COMPRESS:
	desc = compressionOpts;
	mode = TCL_ZLIB_STREAM_DEFLATE;
	format = TCL_ZLIB_FORMAT_ZLIB;
	break;
    case FMT_DECOMPRESS:
	desc = expansionOpts;
	mode = TCL_ZLIB_STREAM_INFLATE;
	format = TCL_ZLIB_FORMAT_ZLIB;
	break;
    case FMT_GZIP:
	desc = gzipOpts;
	mode = TCL_ZLIB_STREAM_DEFLATE;
	format = TCL_ZLIB_FORMAT_GZIP;
	break;
    case FMT_GUNZIP:
	desc = gunzipOpts;
	mode = TCL_ZLIB_STREAM_INFLATE;
	format = TCL_ZLIB_FORMAT_GZIP;
	break;
    default:
	Tcl_Panic("should be unreachable");
    }

    /*
     * Parse the options.
     */

    for (i=3 ; i<objc ; i+=2) {
	if (Tcl_GetIndexFromObjStruct(interp, objv[i], desc,
		sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) {
	    return TCL_ERROR;
	}
	obj[desc[option].offset] = objv[i+1];
    }

    /*
     * If a compression level was given, parse it (integral: 0..9). Otherwise
     * use the default.
     */

    if (levelObj == NULL) {
	level = Z_DEFAULT_COMPRESSION;
    } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) {
	return TCL_ERROR;
    } else if (level < 0 || level > 9) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", NULL);
	Tcl_AddErrorInfo(interp, "\n    (in -level option)");
	return TCL_ERROR;
    }

    if (compDictObj) {
	if (NULL == TclGetBytesFromObj(interp, compDictObj, NULL)) {
	    return TCL_ERROR;
	}
    }

    /*
     * Construct the stream now we know its configuration.
     */

    if (Tcl_ZlibStreamInit(interp, mode, format, level, gzipHeaderObj,
	    &zh) != TCL_OK) {
	return TCL_ERROR;
    }
    if (compDictObj != NULL) {
	Tcl_ZlibStreamSetCompressionDictionary(zh, compDictObj);
    }
    Tcl_SetObjResult(interp, Tcl_ZlibStreamGetCommandName(zh));
    return TCL_OK;
#undef compDictObj
#undef gzipHeaderObj
#undef levelObj
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibPushSubcmd --
 *
 *	Implementation of the [zlib push] subcommand.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibPushSubcmd(
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    static const char *const stream_formats[] = {
	"compress", "decompress", "deflate", "gunzip", "gzip", "inflate",
	NULL
    };
    enum zlibFormats {
	FMT_COMPRESS, FMT_DECOMPRESS, FMT_DEFLATE, FMT_GUNZIP, FMT_GZIP,
	FMT_INFLATE
    };
    Tcl_Channel chan;
    int chanMode, format, mode = 0, level, i, option;
    static const char *const pushCompressOptions[] = {
	"-dictionary", "-header", "-level", NULL
    };
    static const char *const pushDecompressOptions[] = {
	"-dictionary", "-header", "-level", "-limit", NULL
    };
    const char *const *pushOptions = pushDecompressOptions;
    enum pushOptionsEnum {poDictionary, poHeader, poLevel, poLimit};
    Tcl_Obj *headerObj = NULL, *compDictObj = NULL;
    int limit = DEFAULT_BUFFER_SIZE, dummy;

    if (objc < 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "mode channel ?options...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[2], stream_formats, "mode", 0,
	    &format) != TCL_OK) {
	return TCL_ERROR;
    }
    switch ((enum zlibFormats) format) {
    case FMT_DEFLATE:
	mode = TCL_ZLIB_STREAM_DEFLATE;
	format = TCL_ZLIB_FORMAT_RAW;
	pushOptions = pushCompressOptions;
	break;
    case FMT_INFLATE:
	mode = TCL_ZLIB_STREAM_INFLATE;
	format = TCL_ZLIB_FORMAT_RAW;
	break;
    case FMT_COMPRESS:
	mode = TCL_ZLIB_STREAM_DEFLATE;
	format = TCL_ZLIB_FORMAT_ZLIB;
	pushOptions = pushCompressOptions;
	break;
    case FMT_DECOMPRESS:
	mode = TCL_ZLIB_STREAM_INFLATE;
	format = TCL_ZLIB_FORMAT_ZLIB;
	break;
    case FMT_GZIP:
	mode = TCL_ZLIB_STREAM_DEFLATE;
	format = TCL_ZLIB_FORMAT_GZIP;
	pushOptions = pushCompressOptions;
	break;
    case FMT_GUNZIP:
	mode = TCL_ZLIB_STREAM_INFLATE;
	format = TCL_ZLIB_FORMAT_GZIP;
	break;
    default:
	Tcl_Panic("should be unreachable");
    }

    if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK){
	return TCL_ERROR;
    }

    /*
     * Sanity checks.
     */

    if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"compression may only be applied to writable channels", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", NULL);
	return TCL_ERROR;
    }
    if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"decompression may only be applied to readable channels",-1));
	Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", NULL);
	return TCL_ERROR;
    }

    /*
     * Parse options.
     */

    level = Z_DEFAULT_COMPRESSION;
    for (i=4 ; i<objc ; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], pushOptions, "option", 0,
		&option) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (++i > objc-1) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "value missing for %s option", pushOptions[option]));
	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
	    return TCL_ERROR;
	}
	switch ((enum pushOptionsEnum) option) {
	case poHeader:
	    headerObj = objv[i];
	    if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) {
		goto genericOptionError;
	    }
	    break;
	case poLevel:
	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) {
		goto genericOptionError;
	    }
	    if (level < 0 || level > 9) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"level must be 0 to 9", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL",
			NULL);
		goto genericOptionError;
	    }
	    break;
	case poLimit:
	    if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) {
		goto genericOptionError;
	    }
	    if (limit < 1 || limit > MAX_BUFFER_SIZE) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"read ahead limit must be 1 to %d",
			MAX_BUFFER_SIZE));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
		goto genericOptionError;
	    }
	    break;
	case poDictionary:
	    if (format == TCL_ZLIB_FORMAT_GZIP) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"a compression dictionary may not be set in the "
			"gzip format", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", NULL);
		goto genericOptionError;
	    }
	    compDictObj = objv[i];
	    break;
	}
    }

    if (compDictObj && (NULL == TclGetBytesFromObj(interp, compDictObj, NULL))) {
	return TCL_ERROR;
    }

    if (ZlibStackChannelTransform(interp, mode, format, level, limit, chan,
	    headerObj, compDictObj) == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, objv[3]);
    return TCL_OK;

  genericOptionError:
    Tcl_AddErrorInfo(interp, "\n    (in ");
    Tcl_AddErrorInfo(interp, pushOptions[option]);
    Tcl_AddErrorInfo(interp, " option)");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStreamCmd --
 *
 *	Implementation of the commands returned by [zlib stream].
 *
 *----------------------------------------------------------------------
 */

static int
ZlibStreamCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd;
    int command, count, code;
    Tcl_Obj *obj;
    static const char *const cmds[] = {
	"add", "checksum", "close", "eof", "finalize", "flush",
	"fullflush", "get", "header", "put", "reset",
	NULL
    };
    enum zlibStreamCommands {
	zs_add, zs_checksum, zs_close, zs_eof, zs_finalize, zs_flush,
	zs_fullflush, zs_get, zs_header, zs_put, zs_reset
    };

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option data ?...?");
	return TCL_ERROR;
    }

    if (Tcl_GetIndexFromObj(interp, objv[1], cmds, "option", 0,
	    &command) != TCL_OK) {
	return TCL_ERROR;
    }

    switch ((enum zlibStreamCommands) command) {
    case zs_add:		/* $strm add ?$flushopt? $data */
	return ZlibStreamAddCmd(zstream, interp, objc, objv);
    case zs_header:		/* $strm header */
	return ZlibStreamHeaderCmd(zstream, interp, objc, objv);
    case zs_put:		/* $strm put ?$flushopt? $data */
	return ZlibStreamPutCmd(zstream, interp, objc, objv);

    case zs_get:		/* $strm get ?count? */
	if (objc > 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "?count?");
	    return TCL_ERROR;
	}

	count = -1;
	if (objc >= 3) {
	    if (Tcl_GetIntFromObj(interp, objv[2], &count) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	TclNewObj(obj);
	code = Tcl_ZlibStreamGet(zstream, obj, count);
	if (code == TCL_OK) {
	    Tcl_SetObjResult(interp, obj);
	} else {
	    TclDecrRefCount(obj);
	}
	return code;
    case zs_flush:		/* $strm flush */
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	TclNewObj(obj);
	Tcl_IncrRefCount(obj);
	code = Tcl_ZlibStreamPut(zstream, obj, Z_SYNC_FLUSH);
	TclDecrRefCount(obj);
	return code;
    case zs_fullflush:		/* $strm fullflush */
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	TclNewObj(obj);
	Tcl_IncrRefCount(obj);
	code = Tcl_ZlibStreamPut(zstream, obj, Z_FULL_FLUSH);
	TclDecrRefCount(obj);
	return code;
    case zs_finalize:		/* $strm finalize */
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}

	/*
	 * The flush commands slightly abuse the empty result obj as input
	 * data.
	 */

	TclNewObj(obj);
	Tcl_IncrRefCount(obj);
	code = Tcl_ZlibStreamPut(zstream, obj, Z_FINISH);
	TclDecrRefCount(obj);
	return code;
    case zs_close:		/* $strm close */
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	return Tcl_ZlibStreamClose(zstream);
    case zs_eof:		/* $strm eof */
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_ZlibStreamEof(zstream)));
	return TCL_OK;
    case zs_checksum:		/* $strm checksum */
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)
		(uLong) Tcl_ZlibStreamChecksum(zstream)));
	return TCL_OK;
    case zs_reset:		/* $strm reset */
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}
	return Tcl_ZlibStreamReset(zstream);
    }

    return TCL_OK;
}

static int
ZlibStreamAddCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd;
    int index, code, buffersize = -1, flush = -1, i;
    Tcl_Obj *obj, *compDictObj = NULL;
    static const char *const add_options[] = {
	"-buffer", "-dictionary", "-finalize", "-flush", "-fullflush", NULL
    };
    enum addOptions {
	ao_buffer, ao_dictionary, ao_finalize, ao_flush, ao_fullflush
    };

    for (i=2; i<objc-1; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], add_options, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}

	switch ((enum addOptions) index) {
	case ao_flush: /* -flush */
	    if (flush >= 0) {
		flush = -2;
	    } else {
		flush = Z_SYNC_FLUSH;
	    }
	    break;
	case ao_fullflush: /* -fullflush */
	    if (flush >= 0) {
		flush = -2;
	    } else {
		flush = Z_FULL_FLUSH;
	    }
	    break;
	case ao_finalize: /* -finalize */
	    if (flush >= 0) {
		flush = -2;
	    } else {
		flush = Z_FINISH;
	    }
	    break;
	case ao_buffer: /* -buffer */
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-buffer\" option must be followed by integer "
			"decompression buffersize", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
		return TCL_ERROR;
	    }
	    if (Tcl_GetIntFromObj(interp, objv[++i], &buffersize) != TCL_OK) {
		return TCL_ERROR;
	    }
	    if (buffersize < 1 || buffersize > MAX_BUFFER_SIZE) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"buffer size must be 1 to %d",
			MAX_BUFFER_SIZE));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "BUFFERSIZE", NULL);
		return TCL_ERROR;
	    }
	    break;
	case ao_dictionary:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-dictionary\" option must be followed by"
			" compression dictionary bytes", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
		return TCL_ERROR;
	    }
	    compDictObj = objv[++i];
	    break;
	}

	if (flush == -2) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\"-flush\", \"-fullflush\" and \"-finalize\" options"
		    " are mutually exclusive", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
	    return TCL_ERROR;
	}
    }
    if (flush == -1) {
	flush = 0;
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	size_t len = 0;

	if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}

	if (len == 0) {
	    compDictObj = NULL;
	}
	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
    }

    /*
     * Send the data to the stream core, along with any flushing directive.
     */

    if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Get such data out as we can (up to the requested length).
     */

    TclNewObj(obj);
    code = Tcl_ZlibStreamGet(zstream, obj, buffersize);
    if (code == TCL_OK) {
	Tcl_SetObjResult(interp, obj);
    } else {
	TclDecrRefCount(obj);
    }
    return code;
}

static int
ZlibStreamPutCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd;
    int index, flush = -1, i;
    Tcl_Obj *compDictObj = NULL;
    static const char *const put_options[] = {
	"-dictionary", "-finalize", "-flush", "-fullflush", NULL
    };
    enum putOptions {
	po_dictionary, po_finalize, po_flush, po_fullflush
    };

    for (i=2; i<objc-1; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], put_options, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}

	switch ((enum putOptions) index) {
	case po_flush: /* -flush */
	    if (flush >= 0) {
		flush = -2;
	    } else {
		flush = Z_SYNC_FLUSH;
	    }
	    break;
	case po_fullflush: /* -fullflush */
	    if (flush >= 0) {
		flush = -2;
	    } else {
		flush = Z_FULL_FLUSH;
	    }
	    break;
	case po_finalize: /* -finalize */
	    if (flush >= 0) {
		flush = -2;
	    } else {
		flush = Z_FINISH;
	    }
	    break;
	case po_dictionary:
	    if (i == objc-2) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-dictionary\" option must be followed by"
			" compression dictionary bytes", -1));
		Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", NULL);
		return TCL_ERROR;
	    }
	    compDictObj = objv[++i];
	    break;
	}
	if (flush == -2) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "\"-flush\", \"-fullflush\" and \"-finalize\" options"
		    " are mutually exclusive", -1));
	    Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", NULL);
	    return TCL_ERROR;
	}
    }
    if (flush == -1) {
	flush = 0;
    }

    /*
     * Set the compression dictionary if requested.
     */

    if (compDictObj != NULL) {
	size_t len = 0;

	if (NULL == TclGetBytesFromObj(interp, compDictObj, &len)) {
	    return TCL_ERROR;
	}
	if (len == 0) {
	    compDictObj = NULL;
	}
	Tcl_ZlibStreamSetCompressionDictionary(zstream, compDictObj);
    }

    /*
     * Send the data to the stream core, along with any flushing directive.
     */

    return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush);
}

static int
ZlibStreamHeaderCmd(
    void *cd,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd;
    Tcl_Obj *resultObj;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 2, objv, NULL);
	return TCL_ERROR;
    } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE
	    || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"only gunzip streams can produce header information", -1));
	Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", NULL);
	return TCL_ERROR;
    }

    TclNewObj(resultObj);
    ExtractHeader(&zshPtr->gzHeaderPtr->header, resultObj);
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *	Set of functions to support channel stacking.
 *----------------------------------------------------------------------
 *
 * ZlibTransformClose --
 *
 *	How to shut down a stacked compressing/decompressing transform.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformClose(
    void *instanceData,
    Tcl_Interp *interp,
	int flags)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    int e, result = TCL_OK;
    size_t written;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    /*
     * Delete the support timer.
     */

    ZlibTransformEventTimerKill(cd);

    /*
     * Flush any data waiting to be compressed.
     */

    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	cd->outStream.avail_in = 0;
	do {
	    e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		    Z_FINISH, &written);

	    /*
	     * Can't be sure that deflate() won't declare the buffer to be
	     * full (with Z_BUF_ERROR) so handle that case.
	     */

	    if (e == Z_BUF_ERROR) {
		e = Z_OK;
		written = cd->outAllocated;
	    }
	    if (e != Z_OK && e != Z_STREAM_END) {
		/* TODO: is this the right way to do errors on close? */
		if (!TclInThreadExit()) {
		    ConvertError(interp, e, cd->outStream.adler);
		}
		result = TCL_ERROR;
		break;
	    }
	    if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) == TCL_IO_FAILURE) {
		/* TODO: is this the right way to do errors on close?
		 * Note: when close is called from FinalizeIOSubsystem then
		 * interp may be NULL */
		if (!TclInThreadExit() && interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "error while finalizing file: %s",
			    Tcl_PosixError(interp)));
		}
		result = TCL_ERROR;
		break;
	    }
	} while (e != Z_STREAM_END);
	(void) deflateEnd(&cd->outStream);
    } else {
	/*
	 * If we have unused bytes from the read input (overshot by
	 * Z_STREAM_END or on possible error), unget them back to the parent
	 * channel, so that they appear as not being read yet.
	 */
	if (cd->inStream.avail_in) {
	    Tcl_Ungets (cd->parent, (char *)cd->inStream.next_in, cd->inStream.avail_in, 0);
	}

	(void) inflateEnd(&cd->inStream);
    }

    /*
     * Release all memory.
     */

    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
	cd->compDictObj = NULL;
    }

    if (cd->inBuffer) {
	Tcl_Free(cd->inBuffer);
	cd->inBuffer = NULL;
    }
    if (cd->outBuffer) {
	Tcl_Free(cd->outBuffer);
	cd->outBuffer = NULL;
    }
    Tcl_Free(cd);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformInput --
 *
 *	Reader filter that does decompression.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformInput(
    void *instanceData,
    char *buf,
    int toRead,
    int *errorCodePtr)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverInputProc *inProc =
	    Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent));
    int readBytes, gotBytes;

    if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead,
		errorCodePtr);
    }

    gotBytes = 0;
    readBytes = cd->inStream.avail_in; /* how many bytes in buffer now */
    while (!(cd->flags & STREAM_DONE) && toRead > 0) {
    	unsigned int n; int decBytes;

	/* if starting from scratch or continuation after full decompression */
	if (!cd->inStream.avail_in) {
	    /* buffer to start, we can read to whole available buffer */
	    cd->inStream.next_in = (Bytef *) cd->inBuffer;
	}
	/*
	 * If done - no read needed anymore, check we have to copy rest of
	 * decompressed data, otherwise return with size (or 0 for Eof)
	 */
	if (cd->flags & STREAM_DECOMPRESS) {
	    goto copyDecompressed;
	}
	/*
	 * The buffer is exhausted, but the caller wants even more. We now
	 * have to go to the underlying channel, get more bytes and then
	 * transform them for delivery. We may not get what we want (full EOF
	 * or temporarily out of data).
	 */

	/* Check free buffer size and adjust size of next chunk to read. */
	n = cd->inAllocated - ((char *)cd->inStream.next_in - cd->inBuffer);
	if (n <= 0) {
	    /* Normally unreachable: not enough input buffer to uncompress.
	     * Todo: firstly try to realloc inBuffer upto MAX_BUFFER_SIZE.
	     */
	    *errorCodePtr = ENOBUFS;
	    return -1;
	}
	if (n > cd->readAheadLimit) {
	    n = cd->readAheadLimit;
	}
	readBytes = Tcl_ReadRaw(cd->parent, (char *)cd->inStream.next_in, n);

	/*
	 * Three cases here:
	 *  1.	Got some data from the underlying channel (readBytes > 0) so
	 *	it should be fed through the decompression engine.
	 *  2.	Got an error (readBytes == -1) which we should report up except
	 *	for the case where we can convert it to a short read.
	 *  3.	Got an end-of-data from EOF or blocking (readBytes == 0). If
	 *	it is EOF, try flushing the data out of the decompressor.
	 */

	if (readBytes == -1) {

	    /* See ReflectInput() in tclIORTrans.c */
	    if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) {
		break;
	    }

	    *errorCodePtr = Tcl_GetErrno();
	    return -1;
	}

	/* more bytes (or Eof if readBytes == 0) */
	cd->inStream.avail_in += readBytes;

copyDecompressed:

	/*
	 * Transform the read chunk, if not empty. Anything we get
	 * back is a transformation result to be put into our buffers, and
	 * the next iteration will put it into the result.
	 * For the case readBytes is 0 which signaling Eof in parent, the
	 * partial data waiting is converted and returned.
	 */

	decBytes = ResultDecompress(cd, buf, toRead,
		    (readBytes != 0) ? Z_NO_FLUSH : Z_SYNC_FLUSH,
		    errorCodePtr);
	if (decBytes == -1) {
	    return -1;
	}
	gotBytes += decBytes;
	buf += decBytes;
	toRead -= decBytes;

	if (((decBytes == 0) || (cd->flags & STREAM_DECOMPRESS))) {
	    /*
	     * The drain delivered nothing (or buffer too small to decompress).
	     * Time to deliver what we've got.
	     */
	    if (!gotBytes && !(cd->flags & STREAM_DONE)) {
		/* if no-data, but not ready - avoid signaling Eof,
		 * continue in blocking mode, otherwise EAGAIN */
		if (Tcl_InputBlocked(cd->parent)) {
		    continue;
		}
		*errorCodePtr = EAGAIN;
		return -1;
	    }
	    break;
	}

	/*
	 * Loop until the request is satisfied (or no data available from
	 * above, possibly EOF).
	 */
    }

    return gotBytes;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformOutput --
 *
 *	Writer filter that does compression.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformOutput(
    void *instanceData,
    const char *buf,
    int toWrite,
    int *errorCodePtr)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverOutputProc *outProc =
	    Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent));
    int e;
    size_t produced;
    Tcl_Obj *errObj;

    if (cd->mode == TCL_ZLIB_STREAM_INFLATE) {
	return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite,
		errorCodePtr);
    }

    /*
     * No zero-length writes. Flushes must be explicit.
     */

    if (toWrite == 0) {
	return 0;
    }

    cd->outStream.next_in = (Bytef *) buf;
    cd->outStream.avail_in = toWrite;
    while (cd->outStream.avail_in > 0) {
	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		Z_NO_FLUSH, &produced);
	if (e != Z_OK || produced == 0) {
	    break;
	}

	if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) == TCL_IO_FAILURE) {
	    *errorCodePtr = Tcl_GetErrno();
	    return -1;
	}
    }

    if (e == Z_OK) {
	return toWrite - cd->outStream.avail_in;
    }

    errObj = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
    Tcl_ListObjAppendElement(NULL, errObj,
	    ConvertErrorToList(e, cd->outStream.adler));
    Tcl_ListObjAppendElement(NULL, errObj,
	    Tcl_NewStringObj(cd->outStream.msg, -1));
    Tcl_SetChannelError(cd->parent, errObj);
    *errorCodePtr = EINVAL;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformFlush --
 *
 *	How to perform a flush of a compressing transform.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformFlush(
    Tcl_Interp *interp,
    ZlibChannelData *cd,
    int flushType)
{
    int e;
    size_t len;

    cd->outStream.avail_in = 0;
    do {
	/*
	 * Get the bytes to go out of the compression engine.
	 */

	e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated,
		flushType, &len);
	if (e != Z_OK && e != Z_BUF_ERROR) {
	    ConvertError(interp, e, cd->outStream.adler);
	    return TCL_ERROR;
	}

	/*
	 * Write the bytes we've received to the next layer.
	 */

	if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) == TCL_IO_FAILURE) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "problem flushing channel: %s",
		    Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*
	 * If we get to this point, either we're in the Z_OK or the
	 * Z_BUF_ERROR state. In the former case, we're done. In the latter
	 * case, it's because there's more bytes to go than would fit in the
	 * buffer we provided, and we need to go round again to get some more.
	 *
	 * We also stop the loop if we would have done a zero-length write.
	 * Those can cause problems at the OS level.
	 */
    } while (len > 0 && e == Z_BUF_ERROR);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformSetOption --
 *
 *	Writing side of [fconfigure] on our channel.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformSetOption(			/* not used */
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    const char *value)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverSetOptionProc *setOptionProc =
	    Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent));
    static const char *compressChanOptions = "dictionary flush";
    static const char *gzipChanOptions = "flush";
    static const char *decompressChanOptions = "dictionary limit";
    static const char *gunzipChanOptions = "flush limit";
    int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE);

    if (optionName && (strcmp(optionName, "-dictionary") == 0)
	    && (cd->format != TCL_ZLIB_FORMAT_GZIP)) {
	Tcl_Obj *compDictObj;
	int code;

	TclNewStringObj(compDictObj, value, strlen(value));
	Tcl_IncrRefCount(compDictObj);
	if (NULL == TclGetBytesFromObj(interp, compDictObj, NULL)) {
	    Tcl_DecrRefCount(compDictObj);
	    return TCL_ERROR;
	}
	if (cd->compDictObj) {
	    TclDecrRefCount(cd->compDictObj);
	}
	cd->compDictObj = compDictObj;
	code = Z_OK;
	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    code = SetDeflateDictionary(&cd->outStream, compDictObj);
	    if (code != Z_OK) {
		ConvertError(interp, code, cd->outStream.adler);
		return TCL_ERROR;
	    }
	} else if (cd->format == TCL_ZLIB_FORMAT_RAW) {
	    code = SetInflateDictionary(&cd->inStream, compDictObj);
	    if (code != Z_OK) {
		ConvertError(interp, code, cd->inStream.adler);
		return TCL_ERROR;
	    }
	}
	return TCL_OK;
    }

    if (haveFlushOpt) {
	if (optionName && strcmp(optionName, "-flush") == 0) {
	    int flushType;

	    if (value[0] == 'f' && strcmp(value, "full") == 0) {
		flushType = Z_FULL_FLUSH;
	    } else if (value[0] == 's' && strcmp(value, "sync") == 0) {
		flushType = Z_SYNC_FLUSH;
	    } else {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"unknown -flush type \"%s\": must be full or sync",
			value));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "FLUSH", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Try to actually do the flush now.
	     */

	    return ZlibTransformFlush(interp, cd, flushType);
	}
    } else {
	if (optionName && strcmp(optionName, "-limit") == 0) {
	    int newLimit;

	    if (Tcl_GetInt(interp, value, &newLimit) != TCL_OK) {
		return TCL_ERROR;
	    } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"-limit must be between 1 and 65536", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", NULL);
		return TCL_ERROR;
	    }
	}
    }

    if (setOptionProc == NULL) {
	if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
	    return Tcl_BadChannelOption(interp, optionName,
		    (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
		    ? gzipChanOptions : gunzipChanOptions);
	} else {
	    return Tcl_BadChannelOption(interp, optionName,
		    (cd->mode == TCL_ZLIB_STREAM_DEFLATE)
		    ? compressChanOptions : decompressChanOptions);
	}
    }

    /*
     * Pass all unknown options down, to deeper transforms and/or the base
     * channel.
     */

    return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp,
	    optionName, value);
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformGetOption --
 *
 *	Reading side of [fconfigure] on our channel.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformGetOption(
    void *instanceData,
    Tcl_Interp *interp,
    const char *optionName,
    Tcl_DString *dsPtr)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverGetOptionProc *getOptionProc =
	    Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent));
    static const char *compressChanOptions = "checksum dictionary";
    static const char *gzipChanOptions = "checksum";
    static const char *decompressChanOptions = "checksum dictionary limit";
    static const char *gunzipChanOptions = "checksum header limit";

    /*
     * The "crc" option reports the current CRC (calculated with the Adler32
     * or CRC32 algorithm according to the format) given the data that has
     * been processed so far.
     */

    if (optionName == NULL || strcmp(optionName, "-checksum") == 0) {
	uLong crc;
	char buf[12];

	if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
	    crc = cd->outStream.adler;
	} else {
	    crc = cd->inStream.adler;
	}

	sprintf(buf, "%lu", crc);
	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-checksum");
	    Tcl_DStringAppendElement(dsPtr, buf);
	} else {
	    Tcl_DStringAppend(dsPtr, buf, -1);
	    return TCL_OK;
	}
    }

    if ((cd->format != TCL_ZLIB_FORMAT_GZIP) &&
	    (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) {
	/*
	 * Embedded NUL bytes are ok; they'll be C080-encoded.
	 */

	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-dictionary");
	    if (cd->compDictObj) {
		Tcl_DStringAppendElement(dsPtr,
			TclGetString(cd->compDictObj));
	    } else {
		Tcl_DStringAppendElement(dsPtr, "");
	    }
	} else {
	    if (cd->compDictObj) {
		size_t length;
		const char *str = TclGetStringFromObj(cd->compDictObj, &length);

		Tcl_DStringAppend(dsPtr, str, length);
	    }
	    return TCL_OK;
	}
    }

    /*
     * The "header" option, which is only valid on inflating gzip channels,
     * reports the header that has been read from the start of the stream.
     */

    if ((cd->flags & IN_HEADER) && ((optionName == NULL) ||
	    (strcmp(optionName, "-header") == 0))) {
	Tcl_Obj *tmpObj;

	TclNewObj(tmpObj);
	ExtractHeader(&cd->inHeader.header, tmpObj);
	if (optionName == NULL) {
	    Tcl_DStringAppendElement(dsPtr, "-header");
	    Tcl_DStringAppendElement(dsPtr, TclGetString(tmpObj));
	    Tcl_DecrRefCount(tmpObj);
	} else {
	    TclDStringAppendObj(dsPtr, tmpObj);
	    Tcl_DecrRefCount(tmpObj);
	    return TCL_OK;
	}
    }

    /*
     * Now we do the standard processing of the stream we wrapped.
     */

    if (getOptionProc) {
	return getOptionProc(Tcl_GetChannelInstanceData(cd->parent),
		interp, optionName, dsPtr);
    }
    if (optionName == NULL) {
	return TCL_OK;
    }
    if (cd->format == TCL_ZLIB_FORMAT_GZIP) {
	return Tcl_BadChannelOption(interp, optionName,
		(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
		? gzipChanOptions : gunzipChanOptions);
    } else {
	return Tcl_BadChannelOption(interp, optionName,
		(cd->mode == TCL_ZLIB_STREAM_DEFLATE)
		? compressChanOptions : decompressChanOptions);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformWatch, ZlibTransformEventHandler --
 *
 *	If we have data pending, trigger a readable event after a short time
 *	(in order to allow a real event to catch up).
 *
 *----------------------------------------------------------------------
 */

static void
ZlibTransformWatch(
    void *instanceData,
    int mask)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;
    Tcl_DriverWatchProc *watchProc;

    /*
     * This code is based on the code in tclIORTrans.c
     */

    watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent));
    watchProc(Tcl_GetChannelInstanceData(cd->parent), mask);

    if (!(mask & TCL_READABLE) || !(cd->flags & STREAM_DECOMPRESS)) {
	ZlibTransformEventTimerKill(cd);
    } else if (cd->timer == NULL) {
	cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME,
		ZlibTransformTimerRun, cd);
    }
}

static int
ZlibTransformEventHandler(
    void *instanceData,
    int interestMask)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;

    ZlibTransformEventTimerKill(cd);
    return interestMask;
}

static inline void
ZlibTransformEventTimerKill(
    ZlibChannelData *cd)
{
    if (cd->timer != NULL) {
	Tcl_DeleteTimerHandler(cd->timer);
	cd->timer = NULL;
    }
}

static void
ZlibTransformTimerRun(
    void *clientData)
{
    ZlibChannelData *cd = (ZlibChannelData *)clientData;

    cd->timer = NULL;
    Tcl_NotifyChannel(cd->chan, TCL_READABLE);
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformGetHandle --
 *
 *	Anything that needs the OS handle is told to get it from what we are
 *	stacked on top of.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformGetHandle(
    void *instanceData,
    int direction,
    void **handlePtr)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;

    return Tcl_GetChannelHandle(cd->parent, direction, handlePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibTransformBlockMode --
 *
 *	We need to keep track of the blocking mode; it changes our behavior.
 *
 *----------------------------------------------------------------------
 */

static int
ZlibTransformBlockMode(
    void *instanceData,
    int mode)
{
    ZlibChannelData *cd = (ZlibChannelData *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	cd->flags |= ASYNC;
    } else {
	cd->flags &= ~ASYNC;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ZlibStackChannelTransform --
 *
 *	Stacks either compression or decompression onto a channel.
 *
 * Results:
 *	The stacked channel, or NULL if there was an error.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Channel
ZlibStackChannelTransform(
    Tcl_Interp *interp,		/* Where to write error messages. */
    int mode,			/* Whether this is a compressing transform
				 * (TCL_ZLIB_STREAM_DEFLATE) or a
				 * decompressing transform
				 * (TCL_ZLIB_STREAM_INFLATE). Note that
				 * compressing transforms require that the
				 * channel is writable, and decompressing
				 * transforms require that the channel is
				 * readable. */
    int format,			/* One of the TCL_ZLIB_FORMAT_* values that
				 * indicates what compressed format to allow.
				 * TCL_ZLIB_FORMAT_AUTO is only supported for
				 * decompressing transforms. */
    int level,			/* What compression level to use. Ignored for
				 * decompressing transforms. */
    int limit,			/* The limit on the number of bytes to read
				 * ahead; always at least 1. */
    Tcl_Channel channel,	/* The channel to attach to. */
    Tcl_Obj *gzipHeaderDictPtr,	/* A description of header to use, or NULL to
				 * use a default. Ignored if not compressing
				 * to produce gzip-format data. */
    Tcl_Obj *compDictObj)	/* Byte-array object containing compression
				 * dictionary (not dictObj!) to use if
				 * necessary. */
{
    ZlibChannelData *cd = (ZlibChannelData *)Tcl_Alloc(sizeof(ZlibChannelData));
    Tcl_Channel chan;
    int wbits = 0;

    if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
	Tcl_Panic("unknown mode: %d", mode);
    }

    memset(cd, 0, sizeof(ZlibChannelData));
    cd->mode = mode;
    cd->format = format;
    cd->readAheadLimit = limit;

    if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) {
	if (mode == TCL_ZLIB_STREAM_DEFLATE) {
	    if (gzipHeaderDictPtr) {
		cd->flags |= OUT_HEADER;
		if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader,
			NULL) != TCL_OK) {
		    goto error;
		}
	    }
	} else {
	    cd->flags |= IN_HEADER;
	    cd->inHeader.header.name = (Bytef *)
		    &cd->inHeader.nativeFilenameBuf;
	    cd->inHeader.header.name_max = MAXPATHLEN - 1;
	    cd->inHeader.header.comment = (Bytef *)
		    &cd->inHeader.nativeCommentBuf;
	    cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1;
	}
    }

    if (compDictObj != NULL) {
	cd->compDictObj = Tcl_DuplicateObj(compDictObj);
	Tcl_IncrRefCount(cd->compDictObj);
	Tcl_GetByteArrayFromObj(cd->compDictObj, NULL);
    }

    if (format == TCL_ZLIB_FORMAT_RAW) {
	wbits = WBITS_RAW;
    } else if (format == TCL_ZLIB_FORMAT_ZLIB) {
	wbits = WBITS_ZLIB;
    } else if (format == TCL_ZLIB_FORMAT_GZIP) {
	wbits = WBITS_GZIP;
    } else if (format == TCL_ZLIB_FORMAT_AUTO) {
	wbits = WBITS_AUTODETECT;
    } else {
	Tcl_Panic("bad format: %d", format);
    }

    /*
     * Initialize input inflater or the output deflater.
     */

    if (mode == TCL_ZLIB_STREAM_INFLATE) {
	if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
	    goto error;
	}
	cd->inAllocated = DEFAULT_BUFFER_SIZE;
	if (cd->inAllocated < cd->readAheadLimit) {
	    cd->inAllocated = cd->readAheadLimit;
	}
	cd->inBuffer = (char *)Tcl_Alloc(cd->inAllocated);
	if (cd->flags & IN_HEADER) {
	    if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
	    if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
		goto error;
	    }
	}
    } else {
	if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
		MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
	    goto error;
	}
	cd->outAllocated = DEFAULT_BUFFER_SIZE;
	cd->outBuffer = (char *)Tcl_Alloc(cd->outAllocated);
	if (cd->flags & OUT_HEADER) {
	    if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
		goto error;
	    }
	}
	if (cd->compDictObj) {
	    if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {
		goto error;
	    }
	}
    }

    chan = Tcl_StackChannel(interp, &zlibChannelType, cd,
	    Tcl_GetChannelMode(channel), channel);
    if (chan == NULL) {
	goto error;
    }
    cd->chan = chan;
    cd->parent = Tcl_GetStackedChannel(chan);
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
    return chan;

  error:
    if (cd->inBuffer) {
	Tcl_Free(cd->inBuffer);
	inflateEnd(&cd->inStream);
    }
    if (cd->outBuffer) {
	Tcl_Free(cd->outBuffer);
	deflateEnd(&cd->outStream);
    }
    if (cd->compDictObj) {
	Tcl_DecrRefCount(cd->compDictObj);
    }
    Tcl_Free(cd);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ResultDecompress --
 *
 *	Extract uncompressed bytes from the compression engine and store them
 *	in our buffer (buf) up to toRead bytes.
 *
 * Result:
 *	Number of bytes decompressed or -1 if error (with *errorCodePtr updated with reason).
 *
 * Side effects:
 *	After execution it updates cd->inStream (next_in, avail_in) to reflect
 *	the data that has been decompressed.
 *
 *----------------------------------------------------------------------
 */

static int
ResultDecompress(
    ZlibChannelData *cd,
    char *buf,
    int toRead,
    int flush,
    int *errorCodePtr)
{
    int e, written, resBytes = 0;
    Tcl_Obj *errObj;


    cd->flags &= ~STREAM_DECOMPRESS;
    cd->inStream.next_out = (Bytef *) buf;
    cd->inStream.avail_out = toRead;
    while (cd->inStream.avail_out > 0) {

	e = inflate(&cd->inStream, flush);
	if (e == Z_NEED_DICT && cd->compDictObj) {
	    e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
	    if (e == Z_OK) {
		/*
		 * A repetition of Z_NEED_DICT is just an error.
		 */
		e = inflate(&cd->inStream, flush);
	    }
	}

	/*
	 * avail_out is now the left over space in the output.  Therefore
	 * "toRead - avail_out" is the amount of bytes generated.
	 */

	written = toRead - cd->inStream.avail_out;

	/*
	 * The cases where we're definitely done.
	 */

	if (e == Z_STREAM_END) {
	    cd->flags |= STREAM_DONE;
	    resBytes += written;
	    break;
	}
	if (e == Z_OK) {
	    if (written == 0) {
		break;
	    }
	    resBytes += written;
	}

	if ((flush == Z_SYNC_FLUSH) && (e == Z_BUF_ERROR)) {
	    break;
	}

	/*
	 * Z_BUF_ERROR can be ignored as per http://www.zlib.net/zlib_how.html
	 *
	 * Just indicates that the zlib couldn't consume input/produce output,
	 * and is fixed by supplying more input.
	 *
	 * Otherwise, we've got errors and need to report to higher-up.
	 */

	if ((e != Z_OK) && (e != Z_BUF_ERROR)) {
	    goto handleError;
	}

	/*
	 * Check if the inflate stopped early.
	 */

	if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) {
	    break;
	}
    }

    if (!(cd->flags & STREAM_DONE)) {
	/* if we have pending input data, but no available output buffer */
	if (cd->inStream.avail_in && !cd->inStream.avail_out) {
	    /* next time try to decompress it got readable (new output buffer) */
	    cd->flags |= STREAM_DECOMPRESS;
	}
    }

    return resBytes;

  handleError:
    errObj = Tcl_NewListObj(0, NULL);
    Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1));
    Tcl_ListObjAppendElement(NULL, errObj,
	    ConvertErrorToList(e, cd->inStream.adler));
    Tcl_ListObjAppendElement(NULL, errObj,
	    Tcl_NewStringObj(cd->inStream.msg, -1));
    Tcl_SetChannelError(cd->parent, errObj);
    *errorCodePtr = EINVAL;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *	Finally, the TclZlibInit function. Used to install the zlib API.
 *----------------------------------------------------------------------
 */

int
TclZlibInit(
    Tcl_Interp *interp)
{
    Tcl_Config cfg[2];

    /*
     * This does two things. It creates a counter used in the creation of
     * stream commands, and it creates the namespace that will contain those
     * commands.
     */

    Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", -1, 0);

    /*
     * Create the public scripted interface to this file's functionality.
     */

    Tcl_CreateObjCommand(interp, "zlib", ZlibCmd, 0, 0);

    /*
     * Store the underlying configuration information.
     *
     * TODO: Describe whether we're using the system version of the library or
     * a compatibility version built into Tcl?
     */

    cfg[0].key = "zlibVersion";
    cfg[0].value = zlibVersion();
    cfg[1].key = NULL;
    Tcl_RegisterConfig(interp, "zlib", cfg, "utf-8");

    /*
     * Allow command type introspection to do something sensible with streams.
     */

    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");

    /*
     * Formally provide the package as a Tcl built-in.
     */

    return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL);
}

/*
 *----------------------------------------------------------------------
 *	Stubs used when a suitable zlib installation was not found during
 *	configure.
 *----------------------------------------------------------------------
 */

#else /* !HAVE_ZLIB */
int
Tcl_ZlibStreamInit(
    Tcl_Interp *interp,
    int mode,
    int format,
    int level,
    Tcl_Obj *dictObj,
    Tcl_ZlibStream *zshandle)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
	Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
    }
    return TCL_ERROR;
}

int
Tcl_ZlibStreamClose(
    Tcl_ZlibStream zshandle)
{
    return TCL_OK;
}

int
Tcl_ZlibStreamReset(
    Tcl_ZlibStream zshandle)
{
    return TCL_OK;
}

Tcl_Obj *
Tcl_ZlibStreamGetCommandName(
    Tcl_ZlibStream zshandle)
{
    return NULL;
}

int
Tcl_ZlibStreamEof(
    Tcl_ZlibStream zshandle)
{
    return 1;
}

int
Tcl_ZlibStreamChecksum(
    Tcl_ZlibStream zshandle)
{
    return 0;
}

int
Tcl_ZlibStreamPut(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *data,
    int flush)
{
    return TCL_OK;
}

int
Tcl_ZlibStreamGet(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *data,
    size_t count)
{
    return TCL_OK;
}

int
Tcl_ZlibDeflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    int level,
    Tcl_Obj *gzipHeaderDictObj)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
	Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
    }
    return TCL_ERROR;
}

int
Tcl_ZlibInflate(
    Tcl_Interp *interp,
    int format,
    Tcl_Obj *data,
    size_t bufferSize,
    Tcl_Obj *gzipHeaderDictObj)
{
    if (interp) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
	Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
    }
    return TCL_ERROR;
}

unsigned int
Tcl_ZlibCRC32(
    unsigned int crc,
    const unsigned char *buf,
    size_t len)
{
    return 0;
}

unsigned int
Tcl_ZlibAdler32(
    unsigned int adler,
    const unsigned char *buf,
    size_t len)
{
    return 0;
}

void
Tcl_ZlibStreamSetCompressionDictionary(
    Tcl_ZlibStream zshandle,
    Tcl_Obj *compressionDictionaryObj)
{
    /* Do nothing. */
}
#endif /* HAVE_ZLIB */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Added generic/tommath.h.


1
+
#include "tclTomMathInt.h"

Changes to library/auto.tcl.

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
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







-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
+
+
+
+







    } else {
	# Do the canonical search

	# 1. From an environment variable, if it exists.  Placing this first
	#    gives the end-user ultimate control to work-around any bugs, or
	#    to customize.

        if {[info exists env($enVarName)]} {
            lappend dirs $env($enVarName)
        }
	if {[info exists env($enVarName)]} {
	    lappend dirs $env($enVarName)
	}

	catch {
      set found 0
	    set root [zipfs root]
	    set mountpoint [file join $root lib [string tolower $basename]]
      lappend dirs [file join $root app ${basename}_library]
      lappend dirs [file join $root lib $mountpoint ${basename}_library]
      lappend dirs [file join $root lib $mountpoint]
	    if {![zipfs exists [file join $root app ${basename}_library]] \
	      && ![zipfs exists $mountpoint]} {
	      set found 0
	      foreach pkgdat [info loaded] {
	        lassign $pkgdat dllfile dllpkg
	        if {[string tolower $dllpkg] ne [string tolower $basename]} continue
	        if {$dllfile eq {}} {
	          # Loaded statically
	          break
	        }
          set found 1
	        zipfs mount $mountpoint $dllfile
	        break
	      }
	      if {!$found} {
  	      set paths {}
  	      lappend paths [file join $root app]
    	    lappend paths [::${basename}::pkgconfig get libdir,runtime]
	        lappend paths [::${basename}::pkgconfig get bindir,runtime]
	        if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
  	        set zipfile [string tolower \
  	          "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
  	      }
  	      lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]
          foreach path $paths {
            set archive [file join $path $zipfile]
            if {![file exists $archive]} continue
            zipfs mount $mountpoint $archive
            if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
              lappend dirs [file join $mountpoint ${basename}_library]
              set found 1
              break
            } elseif {[zipfs exists [file join $mountpoint $initScript]]} {
              lappend dirs [file join $mountpoint $initScript]
              set found 1
              break
            } else {
              catch {zipfs unmount $archive}
            }
          }
        }
      }
   }

	# 2. In the package script directory registered within the
	#    configuration of the package itself.

	catch {
	    lappend dirs [::${basename}::pkgconfig get scriptdir,runtime]
	if {[catch {
	    ::${basename}::pkgconfig get scriptdir,runtime
	} value] == 0} {
	    lappend dirs $value
	}

	# 3. Relative to auto_path directories.  This checks relative to the
	# Tcl library as well as allowing loading of libraries added to the
	# auto_path that is not relative to the core library or binary paths.
	foreach d $auto_path {
	    lappend dirs [file join $d $basename$version]
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
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







-
-
-
-
-
+
+
+
+
+










-
+
+
+
+

-









+
+
+
+
-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







	#
	# ../../library		(From unix/arch directory in build hierarchy)
	# ../../foo1.0.1/library
	#		(From unix directory in parallel build hierarchy)
	# ../../../foo1.0.1/library
	#		(From unix/arch directory in parallel build hierarchy)

        set parentDir [file dirname [file dirname [info nameofexecutable]]]
        set grandParentDir [file dirname $parentDir]
        lappend dirs [file join $parentDir lib $basename$version]
        lappend dirs [file join $grandParentDir lib $basename$version]
        lappend dirs [file join $parentDir library]
	set parentDir [file dirname [file dirname [info nameofexecutable]]]
	set grandParentDir [file dirname $parentDir]
	lappend dirs [file join $parentDir lib $basename$version]
	lappend dirs [file join $grandParentDir lib $basename$version]
	lappend dirs [file join $parentDir library]
	if {0} {
	    lappend dirs [file join $grandParentDir library]
	    lappend dirs [file join $grandParentDir $basename$patch library]
	    lappend dirs [file join [file dirname $grandParentDir] \
			      $basename$patch library]
	}
    }
    # uniquify $dirs in order
    array set seen {}
    foreach i $dirs {
	# Make sure $i is unique under normalization. Avoid repeated [source].
	# Take note that the [file normalize] below has been noted to
	# cause difficulties for the freewrap utility.  See Bug 1072136.
	# Until freewrap resolves the matter, one might work around the
	# problem by disabling that branch.
	if {[interp issafe]} {
	    # Safe interps have no [file normalize].
	    set norm $i
	} else {
	    set norm [file normalize $i]
	}
	if {[info exists seen($norm)]} {
	    continue
	}
	set seen($norm) {}

	lappend uniqdirs $i
    }
    set dirs $uniqdirs
    foreach i $dirs {
        set the_library $i
        set file [file join $i $initScript]
	set the_library $i
	set file [file join $i $initScript]

	# source everything when in a safe interpreter because we have a
	# source command, but no file exists command
	# source everything when in a safe interpreter because
	# we have a source command, but no file exists command

        if {[interp issafe] || [file exists $file]} {
            if {![catch {uplevel #0 [list source $file]} msg opts]} {
                return
            }
	    append errors "$file: $msg\n"
	    append errors [dict get $opts -errorinfo]\n
        }
	if {[interp issafe] || [file exists $file]} {
	    if {![catch {uplevel #0 [list source $file]} msg opts]} {
		return
	    } else {
		append errors "$file: $msg\n"
		append errors [dict get $opts -errorinfo]\n
	    }
	}
    }
    unset -nocomplain the_library
    set msg "Can't find a usable $initScript in the following directories: \n"
    append msg "    $dirs\n\n"
    append msg "$errors\n\n"
    append msg "This probably means that $basename wasn't installed properly.\n"
    error $msg
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
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







-
+




+














-
-
-
+
+
+







-








# args -	Any number of additional arguments giving the names of files
#		within dir.  If no additional are given auto_mkindex will look
#		for *.tcl.

proc auto_mkindex {dir args} {
    if {[interp issafe]} {
        error "can't generate index within safe interpreter"
	error "can't generate index within safe interpreter"
    }

    set oldDir [pwd]
    cd $dir
    set dir [pwd]

    append index "# Tcl autoload index file, version 2.0\n"
    append index "# This file is generated by the \"auto_mkindex\" command\n"
    append index "# and sourced to set up indexing information for one or\n"
    append index "# more commands.  Typically each line is a command that\n"
    append index "# sets an element in the auto_index array, where the\n"
    append index "# element name is the name of a command and the value is\n"
    append index "# a script that loads the command.\n\n"
    if {![llength $args]} {
	set args *.tcl
    }

    auto_mkindex_parser::init
    foreach file [lsort [glob -- {*}$args]] {
	try {
	    append index [auto_mkindex_parser::mkindex $file]
	} on error {msg opts} {
	if {[catch {auto_mkindex_parser::mkindex $file} msg opts] == 0} {
	    append index $msg
	} else {
	    cd $oldDir
	    return -options $opts $msg
	}
    }
    auto_mkindex_parser::cleanup

    set fid [open "tclIndex" w]
    fconfigure $fid -encoding utf-8 -translation lf
    puts -nonewline $fid $index
    close $fid
    cd $oldDir
}

# Original version of auto_mkindex that just searches the source code for
# "proc" at the beginning of the line.
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
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







-
+


















-







    if {![llength $args]} {
	set args *.tcl
    }
    foreach file [lsort [glob -- {*}$args]] {
	set f ""
	set error [catch {
	    set f [open $file]
	    fconfigure $f -encoding utf-8 -eofchar \032
	    fconfigure $f -eofchar "\032 {}"
	    while {[gets $f line] >= 0} {
		if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
		    set procName [lindex [auto_qualify $procName "::"] 0]
		    append index "set [list auto_index($procName)]"
		    append index " \[list source \[file join \$dir [list $file]\]\]\n"
		}
	    }
	    close $f
	} msg opts]
	if {$error} {
	    catch {close $f}
	    cd $oldDir
	    return -options $opts $msg
	}
    }
    set f ""
    set error [catch {
	set f [open tclIndex w]
	fconfigure $f -encoding utf-8 -translation lf
	puts -nonewline $f $index
	close $f
	cd $oldDir
    } msg opts]
    if {$error} {
	catch {close $f}
	cd $oldDir
348
349
350
351
352
353
354
355
356
357
358

359
360
361
362
363
364
365
366
367
368
369
305
306
307
308
309
310
311




312




313
314
315
316
317
318
319







-
-
-
-
+
-
-
-
-







	    set parser [interp create -safe]
	    $parser hide info
	    $parser hide rename
	    $parser hide proc
	    $parser hide namespace
	    $parser hide eval
	    $parser hide puts
	    foreach ns [$parser invokehidden namespace children ::] {
		# MUST NOT DELETE "::tcl" OR BAD THINGS HAPPEN!
		if {$ns eq "::tcl"} continue
		$parser invokehidden namespace delete $ns
	    $parser invokehidden namespace delete ::
	    }
	    foreach cmd [$parser invokehidden info commands ::*] {
		$parser invokehidden rename $cmd {}
	    }
	    $parser invokehidden proc unknown {args} {}

	    # We'll need access to the "namespace" command within the
	    # interp.  Put it back, but move it out of the way.

	    $parser expose namespace
	    $parser invokehidden rename namespace _%@namespace
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
450
451

452
453
454

455
456
457
458
459
460
461
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







-
+



















-
+






-
-
+
+

-
+







-
+

-
-
+
+


-
+


-
+







    variable scriptFile
    variable contextStack
    variable imports

    set scriptFile $file

    set fid [open $file]
    fconfigure $fid -encoding utf-8 -eofchar \032
    fconfigure $fid -eofchar "\032 {}"
    set contents [read $fid]
    close $fid

    # There is one problem with sourcing files into the safe interpreter:
    # references like "$x" will fail since code is not really being executed
    # and variables do not really exist.  To avoid this, we replace all $ with
    # \0 (literally, the null char) later, when getting proc names we will
    # have to reverse this replacement, in case there were any $ in the proc
    # name.  This will cause a problem if somebody actually tries to have a \0
    # in their proc name.  Too bad for them.
    set contents [string map [list \$ \0] $contents]

    set index ""
    set contextStack ""
    set imports ""

    $parser eval $contents

    foreach name $imports {
        catch {$parser eval [list _%@namespace forget $name]}
	catch {$parser eval [list _%@namespace forget $name]}
    }
    return $index
}

# auto_mkindex_parser::hook command
#
# Registers a Tcl command to evaluate when initializing the child interpreter
# used by the mkindex parser.  The command is evaluated in the parent
# Registers a Tcl command to evaluate when initializing the slave interpreter
# used by the mkindex parser.  The command is evaluated in the master
# interpreter, and can use the variable auto_mkindex_parser::parser to get to
# the child
# the slave

proc auto_mkindex_parser::hook {cmd} {
    variable initCommands

    lappend initCommands $cmd
}

# auto_mkindex_parser::childhook command
# auto_mkindex_parser::slavehook command
#
# Registers a Tcl command to evaluate when initializing the child interpreter
# used by the mkindex parser.  The command is evaluated in the child
# Registers a Tcl command to evaluate when initializing the slave interpreter
# used by the mkindex parser.  The command is evaluated in the slave
# interpreter.

proc auto_mkindex_parser::childhook {cmd} {
proc auto_mkindex_parser::slavehook {cmd} {
    variable initCommands

    # The $parser variable is defined to be the name of the child interpreter
    # The $parser variable is defined to be the name of the slave interpreter
    # when this command is used later.

    lappend initCommands "\$parser eval [list $cmd]"
}

# auto_mkindex_parser::command --
#
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
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







-
+

-
+








-
-
+
+











-
-
-
+
+
+

-
+








proc auto_mkindex_parser::commandInit {name arglist body} {
    variable parser

    set ns [namespace qualifiers $name]
    set tail [namespace tail $name]
    if {$ns eq ""} {
        set fakeName [namespace current]::_%@fake_$tail
	set fakeName [namespace current]::_%@fake_$tail
    } else {
        set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
	set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
    }
    proc $fakeName $arglist $body

    # YUK!  Tcl won't let us alias fully qualified command names, so we can't
    # handle names like "::itcl::class".  Instead, we have to build procs with
    # the fully qualified names, and have the procs point to the aliases.

    if {[string match *::* $name]} {
        set exportCmd [list _%@namespace export [namespace tail $name]]
        $parser eval [list _%@namespace eval $ns $exportCmd]
	set exportCmd [list _%@namespace export [namespace tail $name]]
	$parser eval [list _%@namespace eval $ns $exportCmd]

	# The following proc definition does not work if you want to tolerate
	# space or something else diabolical in the procedure name, (i.e.,
	# space in $alias). The following does not work:
	#   "_%@eval {$alias} \$args"
	# because $alias gets concat'ed to $args.  The following does not work
	# because $cmd is somehow undefined
	#   "set cmd {$alias} \; _%@eval {\$cmd} \$args"
	# A gold star to someone that can make test autoMkindex-3.3 work
	# properly

        set alias [namespace tail $fakeName]
        $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
        $parser alias $alias $fakeName
	set alias [namespace tail $fakeName]
	$parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
	$parser alias $alias $fakeName
    } else {
        $parser alias $name $fakeName
	$parser alias $name $fakeName
    }
    return
}

# auto_mkindex_parser::fullname --
#
# Used by commands like "proc" within the auto_mkindex parser.  Returns the
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
611
612
613
614
615
616

617
618
619
620
621
622
623
624
625
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
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608







609
610
611
612
613
614
615













616







-
-
-
-
-
-
+
+
+
+
+
+



-
+

-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
+
+





-
+
+
+
+
+
+
+
+
+




-
+






-
-
+
-
-
-










-
+
+
+
+
+
+
+
+

















-
-
-
+
+
+

-
-
+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-
-
-







-
-
-
-
-
-
-
-
-
-
-
-
-

# Arguments:
# name -		Name that is being added to index.

proc auto_mkindex_parser::fullname {name} {
    variable contextStack

    if {![string match ::* $name]} {
        foreach ns $contextStack {
            set name "${ns}::$name"
            if {[string match ::* $name]} {
                break
            }
        }
	foreach ns $contextStack {
	    set name "${ns}::$name"
	    if {[string match ::* $name]} {
		break
	    }
	}
    }

    if {[namespace qualifiers $name] eq ""} {
        set name [namespace tail $name]
	set name [namespace tail $name]
    } elseif {![string match ::* $name]} {
        set name "::$name"
	set name "::$name"
    }

    # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse that
    # replacement.
    return [string map [list \0 \$] $name]
}

# auto_mkindex_parser::indexEntry --
#
# Used by commands like "proc" within the auto_mkindex parser to add a
# correctly-quoted entry to the index. This is shared code so it is done
# *right*, in one place.
#
# Arguments:
# name -		Name that is being added to index.

proc auto_mkindex_parser::indexEntry {name} {
    variable index
    variable scriptFile

    # We convert all metacharacters to their backslashed form, and pre-split
    # the file name that we know about (which will be a proper list, and so
    # correctly quoted).

    set name [string range [list \}[fullname $name]] 2 end]
    set filenameParts [file split $scriptFile]

    append index [format \
	    {set auto_index(%s) [list source [file join $dir %s]]%s} \
	    $name $filenameParts \n]
    return
}

if {[llength $::auto_mkindex_parser::initCommands]} {
    return
}

# Register all of the procedures for the auto_mkindex parser that will build
# the "tclIndex" file.
# Register all of the procedures for the auto_mkindex parser that
# will build the "tclIndex" file.

# AUTO MKINDEX:  proc name arglist body
# Adds an entry to the auto index list for the given procedure name.

auto_mkindex_parser::command proc {name args} {
    indexEntry $name
    variable index
    variable scriptFile
    # Do some fancy reformatting on the "source" call to handle platform
    # differences with respect to pathnames.  Use format just so that the
    # command is a little easier to read (otherwise it'd be full of
    # backslashed dollar signs, etc.
    append index [list set auto_index([fullname $name])] \
	    [format { [list source [file join $dir %s]]} \
	    [file split $scriptFile]] "\n"
}

# Conditionally add support for Tcl byte code files.  There are some tricky
# details here.  First, we need to get the tbcload library initialized in the
# current interpreter.  We cannot load tbcload into the child until we have
# current interpreter.  We cannot load tbcload into the slave until we have
# done so because it needs access to the tcl_patchLevel variable.  Second,
# because the package index file may defer loading the library until we invoke
# a command, we need to explicitly invoke auto_load to force it to be loaded.
# This should be a noop if the package has already been loaded

auto_mkindex_parser::hook {
    try {
	package require tbcload
    if {![catch {package require tbcload}]} {
    } on error {} {
	# OK, don't have it so do nothing
    } on ok {} {
	if {[namespace which -command tbcload::bcproc] eq ""} {
	    auto_load tbcload::bcproc
	}
	load {} tbcload $auto_mkindex_parser::parser

	# AUTO MKINDEX:  tbcload::bcproc name arglist body
	# Adds an entry to the auto index list for the given pre-compiled
	# procedure name.

	auto_mkindex_parser::commandInit tbcload::bcproc {name args} {
	    indexEntry $name
	    variable index
	    variable scriptFile
	    # Do some nice reformatting of the "source" call, to get around
	    # path differences on different platforms.  We use the format
	    # command just so that the code is a little easier to read.
	    append index [list set auto_index([fullname $name])] \
		    [format { [list source [file join $dir %s]]} \
		    [file split $scriptFile]] "\n"
	}
    }
}

# AUTO MKINDEX:  namespace eval name command ?arg arg...?
# Adds the namespace name onto the context stack and evaluates the associated
# body of commands.
#
# AUTO MKINDEX:  namespace import ?-force? pattern ?pattern...?
# Performs the "import" action in the parser interpreter.  This is important
# for any commands contained in a namespace that affect the index.  For
# example, a script may say "itcl::class ...", or it may import "itcl::*" and
# then say "class ...".  This procedure does the import operation, but keeps
# track of imported patterns so we can remove the imports later.

auto_mkindex_parser::command namespace {op args} {
    switch -- $op {
        eval {
            variable parser
            variable contextStack
	eval {
	    variable parser
	    variable contextStack

            set name [lindex $args 0]
            set args [lrange $args 1 end]
	    set name [lindex $args 0]
	    set args [lrange $args 1 end]

            set contextStack [linsert $contextStack 0 $name]
	    set contextStack [linsert $contextStack 0 $name]
	    $parser eval [list _%@namespace eval $name] $args
            set contextStack [lrange $contextStack 1 end]
        }
        import {
            variable parser
            variable imports
            foreach pattern $args {
                if {$pattern ne "-force"} {
                    lappend imports $pattern
                }
            }
            catch {$parser eval "_%@namespace import $args"}
        }
	    set contextStack [lrange $contextStack 1 end]
	}
	import {
	    variable parser
	    variable imports
	    foreach pattern $args {
		if {$pattern ne "-force"} {
		    lappend imports $pattern
		}
	    }
	    catch {$parser eval "_%@namespace import $args"}
	}
	ensemble {
	    variable parser
	    variable contextStack
	    if {[lindex $args 0] eq "create"} {
		set name ::[join [lreverse $contextStack] ::]
		catch {
		    set name [dict get [lrange $args 1 end] -command]
		    if {![string match ::* $name]} {
			set name ::[join [lreverse $contextStack] ::]$name
		    }
		    regsub -all ::+ $name :: name
		}
		# create artifical proc to force an entry in the tclIndex
		$parser eval [list ::proc $name {} {}]
	    }
	}
    }
}

# AUTO MKINDEX:  oo::class create name ?definition?
# Adds an entry to the auto index list for the given class name.
auto_mkindex_parser::command oo::class {op name {body ""}} {
    if {$op eq "create"} {
	indexEntry $name
    }
}
auto_mkindex_parser::command class {op name {body ""}} {
    if {$op eq "create"} {
	indexEntry $name
    }
}

return

Changes to library/clock.tcl.

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
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




-
-
-
+
+
+










-
-
+
+


-
+







-
-
+
+
+










-
-
+
+



















-
-















-
-
-
-
-
+
+
+
+
+







#----------------------------------------------------------------------
#
# clock.tcl --
#
#	This file implements the portions of the [clock] ensemble that are
#	coded in Tcl.  Refer to the users' manual to see the description of
#	the [clock] command and its subcommands.
#	This file implements the portions of the [clock] ensemble that
#	are coded in Tcl.  Refer to the users' manual to see the description
#	of the [clock] command and its subcommands.
#
#
#----------------------------------------------------------------------
#
# Copyright (c) 2004,2005,2006,2007 by Kevin B. Kenny
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#----------------------------------------------------------------------

# We must have message catalogs that support the root locale, and we need
# access to the Registry on Windows systems.
# We must have message catalogs that support the root locale, and
# we need access to the Registry on Windows systems.

uplevel \#0 {
    package require msgcat 1.6
    package require msgcat 1.4
    if { $::tcl_platform(platform) eq {windows} } {
	if { [catch { package require registry 1.1 }] } {
	    namespace eval ::tcl::clock [list variable NoRegistry {}]
	}
    }
}

# Put the library directory into the namespace for the ensemble so that the
# library code can find message catalogs and time zone definition files.
# Put the library directory into the namespace for the ensemble
# so that the library code can find message catalogs and time zone
# definition files.

namespace eval ::tcl::clock \
    [list variable LibDir [file dirname [info script]]]

#----------------------------------------------------------------------
#
# clock --
#
#	Manipulate times.
#
# The 'clock' command manipulates time.  Refer to the user documentation for
# the available subcommands and what they do.
# The 'clock' command manipulates time.  Refer to the user documentation
# for the available subcommands and what they do.
#
#----------------------------------------------------------------------

namespace eval ::tcl::clock {

    # Export the subcommands

    namespace export format
    namespace export clicks
    namespace export microseconds
    namespace export milliseconds
    namespace export scan
    namespace export seconds
    namespace export add

    # Import the message catalog commands that we use.

    namespace import ::msgcat::mcload
    namespace import ::msgcat::mclocale
    namespace import ::msgcat::mc
    namespace import ::msgcat::mcpackagelocale

}

#----------------------------------------------------------------------
#
# ::tcl::clock::Initialize --
#
#	Finish initializing the 'clock' subsystem
#
# Results:
#	None.
#
# Side effects:
#	Namespace variable in the 'clock' subsystem are initialized.
#
# The '::tcl::clock::Initialize' procedure initializes the namespace variables
# and root locale message catalog for the 'clock' subsystem.  It is broken
# into a procedure rather than simply evaluated as a script so that it will be
# able to use local variables, avoiding the dangers of 'creative writing' as
# in Bug 1185933.
# The '::tcl::clock::Initialize' procedure initializes the namespace
# variables and root locale message catalog for the 'clock' subsystem.
# It is broken into a procedure rather than simply evaluated as a script
# so that it will be able to use local variables, avoiding the dangers
# of 'creative writing' as in Bug 1185933.
#
#----------------------------------------------------------------------

proc ::tcl::clock::Initialize {} {

    rename ::tcl::clock::Initialize {}

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
103
104
105
106
107
108
109





110
111
112
113
114
115
116







-
-
-
-
-







	    {-9223372036854775808 0 0 UTC}
	}
	set TZData(:UTC) $TZData(:Etc/UTC)
	set TZData(:localtime) {}
    }
    InitTZData

    mcpackagelocale set {}
    ::msgcat::mcpackageconfig set mcfolder [file join $LibDir msgs]
    ::msgcat::mcpackageconfig set unknowncmd ""
    ::msgcat::mcpackageconfig set changecmd ChangeCurrentLocale

    # Define the message catalog for the root locale.

    ::msgcat::mcmset {} {
	AM {am}
	BCE {B.C.E.}
	CE {C.E.}
	DATE_FORMAT {%m/%d/%Y}
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
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







-
-
+
+




















-
-
+
+







    ::msgcat::mcset pt GREGORIAN_CHANGE_DATE 2299161
    ::msgcat::mcset pl GREGORIAN_CHANGE_DATE 2299161

    # France, Austria

    ::msgcat::mcset fr GREGORIAN_CHANGE_DATE 2299227

    # For Belgium, we follow Southern Netherlands; Liege Diocese changed
    # several weeks later.
    # For Belgium, we follow Southern Netherlands; Liege Diocese
    # changed several weeks later.

    ::msgcat::mcset fr_BE GREGORIAN_CHANGE_DATE 2299238
    ::msgcat::mcset nl_BE GREGORIAN_CHANGE_DATE 2299238

    # Austria

    ::msgcat::mcset de_AT GREGORIAN_CHANGE_DATE 2299527

    # Hungary

    ::msgcat::mcset hu GREGORIAN_CHANGE_DATE 2301004

    # Germany, Norway, Denmark (Catholic Germany changed earlier)

    ::msgcat::mcset de_DE GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset nb GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset nn GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset no GREGORIAN_CHANGE_DATE 2342032
    ::msgcat::mcset da GREGORIAN_CHANGE_DATE 2342032

    # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed at
    # various times)
    # Holland (Brabant, Gelderland, Flanders, Friesland, etc. changed
    # at various times)

    ::msgcat::mcset nl GREGORIAN_CHANGE_DATE 2342165

    # Protestant Switzerland (Catholic cantons changed earlier)

    ::msgcat::mcset fr_CH GREGORIAN_CHANGE_DATE 2361342
    ::msgcat::mcset it_CH GREGORIAN_CHANGE_DATE 2361342
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
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







-
-
+
+













-
-
+
+
















+








    ::msgcat::mcset sv GREGORIAN_CHANGE_DATE 2361390

    # Russia

    ::msgcat::mcset ru GREGORIAN_CHANGE_DATE 2421639

    # Romania (Transylvania changed earler - perhaps de_RO should show the
    # earlier date?)
    # Romania (Transylvania changed earler - perhaps de_RO should show
    # the earlier date?)

    ::msgcat::mcset ro GREGORIAN_CHANGE_DATE 2422063

    # Greece

    ::msgcat::mcset el GREGORIAN_CHANGE_DATE 2423480

    #------------------------------------------------------------------
    #
    #				CONSTANTS
    #
    #------------------------------------------------------------------

    # Paths at which binary time zone data for the Olson libraries are known
    # to reside on various operating systems
    # Paths at which binary time zone data for the Olson libraries
    # are known to reside on various operating systems

    variable ZoneinfoPaths {}
    foreach path {
	/usr/share/zoneinfo
	/usr/share/lib/zoneinfo
	/usr/lib/zoneinfo
	/usr/local/etc/zoneinfo
    } {
	if { [file isdirectory $path] } {
	    lappend ZoneinfoPaths $path
	}
    }

    # Define the directories for time zone data and message catalogs.

    variable DataDir [file join $LibDir tzdata]
    variable MsgDir [file join $LibDir msgs]

    # Number of days in the months, in common years and leap years.

    variable DaysInRomanMonthInCommonYear \
	{ 31 28 31 30 31 30 31 31 30 31 30 31 }
    variable DaysInRomanMonthInLeapYear \
	{ 31 29 31 30 31 30 31 31 30 31 30 31 }
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
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







-
-
-
-
+
+
+
+










-
-
-
-
+
+
+
+







    variable MINWIDE -9223372036854775808
    variable MAXWIDE 9223372036854775807

    # Day before Leap Day

    variable FEB_28	       58

    # Translation table to map Windows TZI onto cities, so that the Olson
    # rules can apply.  In some cases the mapping is ambiguous, so it's wise
    # to specify $::env(TCL_TZ) rather than simply depending on the system
    # time zone.
    # Translation table to map Windows TZI onto cities, so that
    # the Olson rules can apply.  In some cases the mapping is ambiguous,
    # so it's wise to specify $::env(TCL_TZ) rather than simply depending
    # on the system time zone.

    # The keys are long lists of values obtained from the time zone
    # information in the Registry.  In order, the list elements are:
    # 	Bias StandardBias DaylightBias
    #   StandardDate.wYear StandardDate.wMonth StandardDate.wDayOfWeek
    #   StandardDate.wDay StandardDate.wHour StandardDate.wMinute
    #   StandardDate.wSecond StandardDate.wMilliseconds
    #   DaylightDate.wYear DaylightDate.wMonth DaylightDate.wDayOfWeek
    #   DaylightDate.wDay DaylightDate.wHour DaylightDate.wMinute
    #   DaylightDate.wSecond DaylightDate.wMilliseconds
    # The values are the names of time zones where those rules apply.  There
    # is considerable ambiguity in certain zones; an attempt has been made to
    # make a reasonable guess, but this table needs to be taken with a grain
    # of salt.
    # The values are the names of time zones where those rules apply.
    # There is considerable ambiguity in certain zones; an attempt has
    # been made to make a reasonable guess, but this table needs to be
    # taken with a grain of salt.

    variable WinZoneInfo [dict create {*}{
	{-43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Kwajalein
	{-39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}	 :Pacific/Midway
	{-36000 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}  :Pacific/Honolulu
        {-32400 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Anchorage
        {-28800 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} :America/Los_Angeles
379
380
381
382
383
384
385
386
387
388
389




390
391
392
393
394
395
396
374
375
376
377
378
379
380




381
382
383
384
385
386
387
388
389
390
391







-
-
-
-
+
+
+
+







	{36000 0 3600 0 3 0 5 3 0 0 0 0 10 0 5 2 0 0 0}  :Australia/Sydney
	{39600 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Pacific/Noumea
	{43200 0 3600 0 3 0 3 3 0 0 0 0 10 0 1 2 0 0 0}  :Pacific/Auckland
	{43200 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Pacific/Fiji
	{46800 0 3600 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}   :Pacific/Tongatapu
    }]

    # Groups of fields that specify the date, priorities, and code bursts that
    # determine Julian Day Number given those groups.  The code in [clock
    # scan] will choose the highest priority (lowest numbered) set of fields
    # that determines the date.
    # Groups of fields that specify the date, priorities, and
    # code bursts that determine Julian Day Number given those groups.
    # The code in [clock scan] will choose the highest priority
    # (lowest numbered) set of fields that determines the date.

    variable DateParseActions {

	{ seconds } 0 {}

	{ julianDay } 1 {}

486
487
488
489
490
491
492
493
494


495
496
497
498
499
500
501
481
482
483
484
485
486
487


488
489
490
491
492
493
494
495
496







-
-
+
+








	{} 8 {
	    set date [AssignBaseJulianDay $date[set date {}] \
			  $baseTime $timeZone $changeover]
	}
    }

    # Groups of fields that specify time of day, priorities, and code that
    # processes them
    # Groups of fields that specify time of day, priorities,
    # and code that processes them

    variable TimeParseActions {

	seconds 1 {}

	{ hourAMPM minute second amPmIndicator } 2 {
	    dict set date secondOfDay [InterpretHMSP $date]
625
626
627
628
629
630
631





632
633
634
635
636
637
638
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638







+
+
+
+
+








    variable LocaleNumeralCache {};	# Dictionary whose keys are locale
					# names and whose values are pairs
					# comprising regexes matching numerals
					# in the given locales and dictionaries
					# mapping the numerals to their numeric
					# values.
    variable McLoaded {};		# Dictionary whose keys are locales
					# in which [mcload] has been executed
					# and whose values are second-level
    					# dictionaries indexed by message
    					# name and giving message text.
    # variable CachedSystemTimeZone;    # If 'CachedSystemTimeZone' exists,
					# it contains the value of the
					# system time zone, as determined from
					# the environment.
    variable TimeZoneBad {};	        # Dictionary whose keys are time zone
    					# names and whose values are 1 if
					# the time zone is unknown and 0
648
649
650
651
652
653
654
655


656
657
658


659
660
661
662
663
664
665
648
649
650
651
652
653
654

655
656
657


658
659
660
661
662
663
664
665
666







-
+
+

-
-
+
+







}
::tcl::clock::Initialize

#----------------------------------------------------------------------
#
# clock format --
#
#	Formats a count of seconds since the Posix Epoch as a time of day.
#	Formats a count of seconds since the Posix Epoch as a time
#	of day.
#
# The 'clock format' command formats times of day for output.  Refer to the
# user documentation to see what it does.
# The 'clock format' command formats times of day for output.
# Refer to the user documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::format { args } {

    variable FormatProc
    variable TZData
676
677
678
679
680
681
682
683
684
685



686
687
688
689
690
691
692
677
678
679
680
681
682
683



684
685
686
687
688
689
690
691
692
693







-
-
-
+
+
+







    if {![info exists TZData($timezone)]} {
	if {[catch {SetupTimeZone $timezone} retval opts]} {
	    dict unset opts -errorinfo
	    return -options $opts $retval
	}
    }

    # Build a procedure to format the result. Cache the built procedure's name
    # in the 'FormatProc' array to avoid losing its internal representation,
    # which contains the name resolution.
    # Build a procedure to format the result. Cache the built procedure's
    # name in the 'FormatProc' array to avoid losing its internal
    # representation, which contains the name resolution.

    set procName formatproc'$format'$locale
    set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
    if {[info exists FormatProc($procName)]} {
	set procName $FormatProc($procName)
    } else {
	set FormatProc($procName) \
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
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







-
+



+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+








    if {[namespace which $procName] ne {}} {
	return $procName
    }

    # Map away the locale-dependent composite format groups

    EnterLocale $locale
    EnterLocale $locale oldLocale

    # Change locale if a fresh locale has been given on the command line.

    set status [catch {
    try {
	return [ParseClockFormatFormat2 $format $locale $procName]
    } trap CLOCK {result opts} {
	dict unset opts -errorinfo
	return -options $opts $result
    }

	ParseClockFormatFormat2 $format $locale $procName

    } result opts]

    # Restore the locale

    if { [info exists oldLocale] } {
	mclocale $oldLocale
    }

    # Return either the error or the proc name

    if { $status == 1 } {
	if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
	    return -code error $result
	} else {
	    return -options $opts $result
	}
    } else {
	return $result
    }

}

proc ::tcl::clock::ParseClockFormatFormat2 {format locale procName} {

    set didLocaleEra 0
    set didLocaleNumerals 0
    set preFormatCode \
	[string map [list @GREGORIAN_CHANGE_DATE@ \
				       [mc GREGORIAN_CHANGE_DATE]] \
	     {
		 variable TZData
1167
1168
1169
1170
1171
1172
1173
1174


1175
1176
1177


1178
1179
1180
1181
1182
1183
1184
1187
1188
1189
1190
1191
1192
1193

1194
1195
1196


1197
1198
1199
1200
1201
1202
1203
1204
1205







-
+
+

-
-
+
+







    return $procName
}

#----------------------------------------------------------------------
#
# clock scan --
#
#	Inputs a count of seconds since the Posix Epoch as a time of day.
#	Inputs a count of seconds since the Posix Epoch as a time
#	of day.
#
# The 'clock format' command scans times of day on input.  Refer to the user
# documentation to see what it does.
# The 'clock format' command scans times of day on input.
# Refer to the user documentation to see what it does.
#
#----------------------------------------------------------------------

proc ::tcl::clock::scan { args } {

    set format {}

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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361





1362
1363
1364
1365
1366
1367
1368
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
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
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







-
-
+
+













+
-
+

-
-
-
-
+
+
+
+
+
+
+



-
-
+
+











-
+

+
-
+



-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+















-
-
+
+









-
-
+
-




-
-
+
+

-
-
+
+
+
+
+
-
-
+

-
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
+
+
+



















-
-
-
-
-
+
+
+
+
+







		set locale [string tolower $value]
	    }
	    -t - -ti - -tim - -time - -timez - -timezo - -timezon - -timezone {
		set timezone $value
	    }
	    default {
		return -code error \
		    -errorcode [list CLOCK badOption $flag] \
		    "bad option \"$flag\",\
		    -errorcode [list CLOCK badSwitch $flag] \
		    "bad switch \"$flag\",\
                     must be -base, -format, -gmt, -locale or -timezone"
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }
    if { [catch { expr { wide($base) } } result] } {
	return -code error \
	return -code error "expected integer but got \"$base\""
	    "expected integer but got \"$base\""
    }
    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    if { ![string is boolean $gmt] } {
	return -code error \
	    "expected boolean value but got \"$gmt\""
    } else {
	if { $gmt } {
	    set timezone :GMT
	}
    }

    if { ![info exists saw(-format)] } {
	# Perhaps someday we'll localize the legacy code. Right now, it's not
	# localized.
	# Perhaps someday we'll localize the legacy code. Right now,
	# it's not localized.
	if { [info exists saw(-locale)] } {
	    return -code error \
		-errorcode [list CLOCK flagWithLegacyFormat] \
		"legacy \[clock scan\] does not support -locale"

	}
	return [FreeScan $string $base $timezone $locale]
    }

    # Change locale if a fresh locale has been given on the command line.

    EnterLocale $locale
    EnterLocale $locale oldLocale

    set status [catch {
    try {

	# Map away the locale-dependent composite format groups

	set scanner [ParseClockScanFormat $format $locale]
	return [$scanner $string $base $timezone]
    } trap CLOCK {result opts} {
	# Conceal location of generation of expected errors
	dict unset opts -errorinfo
	return -options $opts $result
    }
	$scanner $string $base $timezone

    } result opts]

    # Restore the locale

    if { [info exists oldLocale] } {
	mclocale $oldLocale
    }

    if { $status == 1 } {
	if { [lindex [dict get $opts -errorcode] 0] eq {clock} } {
	    return -code error $result
	} else {
	    return -options $opts $result
	}
    } else {
	return $result
    }

}

#----------------------------------------------------------------------
#
# FreeScan --
#
#	Scans a time in free format
#
# Parameters:
#	string - String containing the time to scan
#	base - Base time, expressed in seconds from the Epoch
#	timezone - Default time zone in which the time will be expressed
#	locale - (Unused) Name of the locale where the time will be scanned.
#
# Results:
#	Returns the date and time extracted from the string in seconds from
#	the epoch
#	Returns the date and time extracted from the string in seconds
#	from the epoch
#
#----------------------------------------------------------------------

proc ::tcl::clock::FreeScan { string base timezone locale } {

    variable TZData

    # Get the data for time changes in the given zone

    try {
	SetupTimeZone $timezone
    if {[catch {SetupTimeZone $timezone} retval opts]} {
    } on error {retval opts} {
	dict unset opts -errorinfo
	return -options $opts $retval
    }

    # Extract year, month and day from the base time for the parser to use as
    # defaults
    # Extract year, month and day from the base time for the
    # parser to use as defaults

    set date [GetDateFields $base $TZData($timezone) 2361222]
    dict set date secondOfDay [expr {
    set date [GetDateFields \
		  $base \
		  $TZData($timezone) \
		  2361222]
    dict set date secondOfDay [expr { [dict get $date localSeconds]
	[dict get $date localSeconds] % 86400
    }]
				      % 86400 }]

    # Parse the date.  The parser will return a list comprising date, time,
    # time zone, relative month/day/seconds, relative weekday, ordinal month.
    # Parse the date.  The parser will return a list comprising
    # date, time, time zone, relative month/day/seconds, relative
    # weekday, ordinal month.

    try {
	set scanned [Oldscan $string \
		     [dict get $date year] \
		     [dict get $date month] \
		     [dict get $date dayOfMonth]]
	lassign $scanned \
	    parseDate parseTime parseZone parseRel \
	    parseWeekday parseOrdinalMonth
    set status [catch {
	Oldscan $string \
	    [dict get $date year] \
	    [dict get $date month] \
	    [dict get $date dayOfMonth]
    } result]
    if { $status != 0 } {
	return -code error "unable to convert date-time string \"$string\": $result"
    }

    lassign $result parseDate parseTime parseZone parseRel \
	parseWeekday parseOrdinalMonth
    } on error message {
	return -code error \
	    "unable to convert date-time string \"$string\": $message"
    }


    # If the caller supplied a date in the string, update the 'date' dict with
    # the value. If the caller didn't specify a time with the date, default to
    # midnight.
    # If the caller supplied a date in the string, update the 'date' dict
    # with the value. If the caller didn't specify a time with the date,
    # default to midnight.

    if { [llength $parseDate] > 0 } {
	lassign $parseDate y m d
	if { $y < 100 } {
	    if { $y >= 39 } {
		incr y 1900
	    } else {
		incr y 2000
	    }
	}
	dict set date era CE
	dict set date year $y
	dict set date month $m
	dict set date dayOfMonth $d
	if { $parseTime eq {} } {
	    set parseTime 0
	}
    }

    # If the caller supplied a time zone in the string, it comes back as a
    # two-element list; the first element is the number of minutes east of
    # Greenwich, and the second is a Daylight Saving Time indicator (1 == yes,
    # 0 == no, -1 == unknown). We make it into a time zone indicator of
    # +-hhmm.
    # If the caller supplied a time zone in the string, it comes back
    # as a two-element list; the first element is the number of minutes
    # east of Greenwich, and the second is a Daylight Saving Time
    # indicator ( 1 == yes, 0 == no, -1 == unknown ). We make it into
    # a time zone indicator of +-hhmm.

    if { [llength $parseZone] > 0 } {
	lassign $parseZone minEast dstFlag
	set timezone [FormatNumericTimeZone \
			  [expr { 60 * $minEast + 3600 * $dstFlag }]]
	SetupTimeZone $timezone
    }
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448

1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469





1470
1471
1472
1473


1474
1475
1476
1477
1478
1479






1480
1481
1482
1483
1484

1485
1486


1487
1488
1489
1490
1491
1492
1493
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
1458




1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507




1508
1509
1510
1511
1512
1513
1514


1515
1516
1517





1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529


1530
1531
1532
1533
1534
1535
1536
1537
1538







-
-
-
-
+
+
+
+
-
















+



-
-
-
+
+
+







-
-
-
-
+
+
+
+
-










+
















+

















-
-
-
-
+
+
+
+
+


-
-
+
+

-
-
-
-
-
+
+
+
+
+
+





+
-
-
+
+







	       || [llength $parseOrdinalMonth] != 0
	       || ( [llength $parseRel] != 0
		    && ( [lindex $parseRel 0] != 0
			 || [lindex $parseRel 1] != 0 ) ) } {
	dict set date secondOfDay 0
    }

    dict set date localSeconds [expr {
	-210866803200
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    dict set date localSeconds \
	[expr { -210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay] }]
    }]
    dict set date tzName $timezone
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) 2361222]
    set seconds [dict get $date seconds]

    # Do relative times

    if { [llength $parseRel] > 0 } {
	lassign $parseRel relMonth relDay relSecond
	set seconds [add $seconds \
			 $relMonth months $relDay days $relSecond seconds \
			 -timezone $timezone -locale $locale]
    }

    # Do relative weekday

    if { [llength $parseWeekday] > 0 } {

	lassign $parseWeekday dayOrdinal dayOfWeek
	set date2 [GetDateFields $seconds $TZData($timezone) 2361222]
	dict set date2 era CE
	set jdwkday [WeekdayOnOrBefore $dayOfWeek [expr {
	    [dict get $date2 julianDay] + 6
	}]]
	set jdwkday [WeekdayOnOrBefore $dayOfWeek \
			 [expr { [dict get $date2 julianDay]
				 + 6 }]]
	incr jdwkday [expr { 7 * $dayOrdinal }]
	if { $dayOrdinal > 0 } {
	    incr jdwkday -7
	}
	dict set date2 secondOfDay \
	    [expr { [dict get $date2 localSeconds] % 86400 }]
	dict set date2 julianDay $jdwkday
	dict set date2 localSeconds [expr {
	    -210866803200
	    + ( 86400 * wide([dict get $date2 julianDay]) )
	    + [dict get $date secondOfDay]
	dict set date2 localSeconds \
	    [expr { -210866803200
		    + ( 86400 * wide([dict get $date2 julianDay]) )
		    + [dict get $date secondOfDay] }]
	}]
	dict set date2 tzName $timezone
	set date2 [ConvertLocalToUTC $date2[set date2 {}] $TZData($timezone) \
		       2361222]
	set seconds [dict get $date2 seconds]

    }

    # Do relative month

    if { [llength $parseOrdinalMonth] > 0 } {

	lassign $parseOrdinalMonth monthOrdinal monthNumber
	if { $monthOrdinal > 0 } {
	    set monthDiff [expr { $monthNumber - [dict get $date month] }]
	    if { $monthDiff <= 0 } {
		incr monthDiff 12
	    }
	    incr monthOrdinal -1
	} else {
	    set monthDiff [expr { [dict get $date month] - $monthNumber }]
	    if { $monthDiff >= 0 } {
		incr monthDiff -12
	    }
	    incr monthOrdinal
	}
	set seconds [add $seconds $monthOrdinal years $monthDiff months \
			 -timezone $timezone -locale $locale]

    }

    return $seconds
}


#----------------------------------------------------------------------
#
# ParseClockScanFormat --
#
#	Parses a format string given to [clock scan -format]
#
# Parameters:
#	formatString - The format being parsed
#	locale - The current locale
#
# Results:
#	Constructs and returns a procedure that accepts the string being
#	scanned, the base time, and the time zone.  The procedure will either
#	return the scanned time or else throw an error that should be rethrown
#	to the caller of [clock scan]
#	Constructs and returns a procedure that accepts the
#	string being scanned, the base time, and the time zone.
#	The procedure will either return the scanned time or
#	else throw an error that should be rethrown to the caller
#	of [clock scan]
#
# Side effects:
#	The given procedure is defined in the ::tcl::clock namespace.  Scan
#	procedures are not deleted once installed.
#	The given procedure is defined in the ::tcl::clock
#	namespace.  Scan procedures are not deleted once installed.
#
# Why do we parse dates by defining a procedure to parse them?  The reason is
# that by doing so, we have one convenient place to cache all the information:
# the regular expressions that match the patterns (which will be compiled),
# the code that assembles the date information, everything lands in one place.
# In this way, when a given format is reused at run time, all the information
# Why do we parse dates by defining a procedure to parse them?
# The reason is that by doing so, we have one convenient place to
# cache all the information: the regular expressions that match the
# patterns (which will be compiled), the code that assembles the
# date information, everything lands in one place.  In this way,
# when a given format is reused at run time, all the information
# of how to apply it is available in a single place.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParseClockScanFormat {formatString locale} {

    # Check whether the format has been parsed previously, and return the
    # existing recognizer if it has.
    # Check whether the format has been parsed previously, and return
    # the existing recognizer if it has.

    set procName scanproc'$formatString'$locale
    set procName [namespace current]::[string map {: {\:} \\ {\\}} $procName]
    if { [namespace which $procName] != {} } {
	return $procName
    }

1523
1524
1525
1526
1527
1528
1529
1530
1531


1532
1533
1534
1535
1536
1537
1538
1568
1569
1570
1571
1572
1573
1574


1575
1576
1577
1578
1579
1580
1581
1582
1583







-
-
+
+







	    {} {
		if { $c eq "%" } {
		    set state %
		} elseif { $c eq " " } {
		    append re {[[:space:]]+}
		} else {
		    if { ! [string is alnum $c] } {
			append re "\\"
		    }
			append re \\
			}
		    append re $c
		}
	    }
	    % {
		set state {}
		switch -exact -- $c {
		    % {
1641
1642
1643
1644
1645
1646
1647
1648

1649
1650
1651
1652
1653
1654
1655
1686
1687
1688
1689
1690
1691
1692

1693
1694
1695
1696
1697
1698
1699
1700







-
+







		    J {			# Julian Day Number
			append re \\s*(\\d+)
			dict set fieldSet julianDay [incr fieldCount]
			append postcode "dict set date julianDay \[" \
			    "::scan \$field" [incr captureCount] " %ld" \
			    "\]\n"
		    }
		    m - N {		# Month number
		    m - N {			# Month number
			append re \\s*(\\d\\d?)
			dict set fieldSet month [incr fieldCount]
			append postcode "dict set date month \[" \
			    "::scan \$field" [incr captureCount] " %d" \
			    "\]\n"
		    }
		    M {			# Minute
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693




1694
1695
1696
1697
1698
1699
1700
1729
1730
1731
1732
1733
1734
1735



1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746







-
-
-
+
+
+
+







			append postcode {dict set date seconds } \[ \
			    {ParseStarDate $field} [incr captureCount] \
			    { $field} [incr captureCount] \
			    { $field} [incr captureCount] \
			    \] \n
		    }
		    s {			# Seconds from Posix Epoch
			# This next case is insanely difficult, because it's
			# problematic to determine whether the field is
			# actually within the range of a wide integer.
			# This next case is insanely difficult,
			# because it's problematic to determine
			# whether the field is actually within
			# the range of a wide integer.
			append re {\s*([-+]?\d+)}
			dict set fieldSet seconds [incr fieldCount]
			append postcode {dict set date seconds } \[ \
			    {ScanWide $field} [incr captureCount] \] \n
		    }
		    S {			# Second
			append re \\s*(\\d\\d?)
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728




1729
1730
1731
1732
1733
1734
1735
1765
1766
1767
1768
1769
1770
1771



1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782







-
-
-
+
+
+
+







				    return -code error \
					-errorcode [list CLOCK badDayOfWeek] \
					"day of week is greater than 7"
				}
				dict set date dayOfWeek $dow
			    }
		    }
		    U {			# Week of year. The first Sunday of
					# the year is the first day of week
					# 01. No scan rule uses this group.
		    U {			# Week of year. The
					# first Sunday of the year is the
					# first day of week 01. No scan rule
					# uses this group.
			append re \\s*\\d\\d?
		    }
		    V {			# Week of ISO8601 year

			append re \\s*(\\d\\d?)
			dict set fieldSet iso8601Week [incr fieldCount]
			append postcode "dict set date iso8601Week \[" \
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
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







-
+
-


-
+


















-
+
-
-








-
-
-
-
+
+
+
+
-

-
-
-


-
+
+


















-
-
+
+





-
+
+







+







    }
    append procBody \}\n
    append procBody "set date \[dict create\]" \n
    append procBody {dict set date tzName $timeZone} \n
    append procBody $postcode
    append procBody [list set changeover [mc GREGORIAN_CHANGE_DATE]] \n

    # Set up the time zone before doing anything with a default base date
    # Get time zone if needed
    # that might need a timezone to interpret it.

    if { ![dict exists $fieldSet seconds]
	    && ![dict exists $fieldSet starDate] } {
	 && ![dict exists $fieldSet starDate] } {
	if { [dict exists $fieldSet tzName] } {
	    append procBody {
		set timeZone [dict get $date tzName]
	    }
	}
	append procBody {
	    ::tcl::clock::SetupTimeZone $timeZone
	}
    }

    # Add code that gets Julian Day Number from the fields.

    append procBody [MakeParseCodeFromFields $fieldSet $DateParseActions]

    # Get time of day

    append procBody [MakeParseCodeFromFields $fieldSet $TimeParseActions]

    # Assemble seconds from the Julian day and second of the day.
    # Assemble seconds, and convert local nominal time to UTC.
    # Convert to local time unless epoch seconds or stardate are
    # being processed - they're always absolute

    if { ![dict exists $fieldSet seconds]
         && ![dict exists $fieldSet starDate] } {
	append procBody {
	    if { [dict get $date julianDay] > 5373484 } {
		return -code error -errorcode [list CLOCK dateTooLarge] \
		    "requested date too large to represent"
	    }
	    dict set date localSeconds [expr {
		-210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay]
	    dict set date localSeconds \
		[expr { -210866803200
			+ ( 86400 * wide([dict get $date julianDay]) )
			+ [dict get $date secondOfDay] }]
	    }]
	}

	# Finally, convert the date to local time

	append procBody {
	    set date [::tcl::clock::ConvertLocalToUTC $date[set date {}] \
			  $TZData($timeZone) $changeover]
			  $TZData($timeZone) \
			  $changeover]
	}
    }

    # Return result

    append procBody {return [dict get $date seconds]} \n

    proc $procName { string baseTime timeZone } $procBody

    # puts [list proc $procName [list string baseTime timeZone] $procBody]

    return $procName
}

#----------------------------------------------------------------------
#
# LocaleNumeralMatcher --
#
#	Composes a regexp that captures the numerals in the given locale, and
#	a dictionary to map them to conventional numerals.
#	Composes a regexp that captures the numerals in the given
#	locale, and a dictionary to map them to conventional numerals.
#
# Parameters:
#	locale - Name of the current locale
#
# Results:
#	Returns a two-element list comprising the regexp and the dictionary.
#	Returns a two-element list comprising the regexp and the
#	dictionary.
#
# Side effects:
#	Caches the result.
#
#----------------------------------------------------------------------

proc ::tcl::clock::LocaleNumeralMatcher {l} {

    variable LocaleNumeralCache

    if { ![dict exists $LocaleNumeralCache $l] } {
	set d {}
	set i 0
	set sep \(
	foreach n [mc LOCALE_NUMERALS] {
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
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







-
-
-
+
+
+







-
-
-
-
+
+
+
+







+
-
-
-
-
+
+
+
+







+


















-
-
+
+










#----------------------------------------------------------------------
#
# UniquePrefixRegexp --
#
#	Composes a regexp that performs unique-prefix matching.  The RE
#	matches one of a supplied set of strings, or any unique prefix
#	thereof.
#	Composes a regexp that performs unique-prefix matching.  The
#	RE matches one of a supplied set of strings, or any unique
#	prefix thereof.
#
# Parameters:
#	data - List of alternating match-strings and values.
#	       Match-strings with distinct values are considered
#	       distinct.
#
# Results:
#	Returns a two-element list.  The first is a regexp that matches any
#	unique prefix of any of the strings.  The second is a dictionary whose
#	keys are match values from the regexp and whose values are the
#	corresponding values from 'data'.
#	Returns a two-element list.  The first is a regexp that
#	matches any unique prefix of any of the strings.  The second
#	is a dictionary whose keys are match values from the regexp
#	and whose values are the corresponding values from 'data'.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::UniquePrefixRegexp { data } {

    # The 'successors' dictionary will contain, for each string that is a
    # prefix of any key, all characters that may follow that prefix.  The
    # 'prefixMapping' dictionary will have keys that are prefixes of keys and
    # values that correspond to the keys.
    # The 'successors' dictionary will contain, for each string that
    # is a prefix of any key, all characters that may follow that
    # prefix.  The 'prefixMapping' dictionary will have keys that
    # are prefixes of keys and values that correspond to the keys.

    set prefixMapping [dict create]
    set successors [dict create {} {}]

    # Walk the key-value pairs

    foreach { key value } $data {

	# Construct all prefixes of the key;

	set prefix {}
	foreach char [split $key {}] {
	    set oldPrefix $prefix
	    dict set successors $oldPrefix $char {}
	    append prefix $char

	    # Put the prefixes in the 'prefixMapping' and 'successors'
	    # dictionaries

	    dict lappend prefixMapping $prefix $value
	    if { ![dict exists $successors $prefix] } {
		dict set successors $prefix {}
	    }
	}
    }

    # Identify those prefixes that designate unique values, and those that are
    # the full keys
    # Identify those prefixes that designate unique values, and
    # those that are the full keys

    set uniquePrefixMapping {}
    dict for { key valueList } $prefixMapping {
	if { [llength $valueList] == 1 } {
	    dict set uniquePrefixMapping $key [lindex $valueList 0]
	}
    }
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
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







-
-
+
+











-
-
+
+

















-
-
+
+



-
-
-
+
+
-







		$uniquePrefixMapping]
}

#----------------------------------------------------------------------
#
# MakeUniquePrefixRegexp --
#
#	Service procedure for 'UniquePrefixRegexp' that constructs a regular
#	expresison that matches the unique prefixes.
#	Service procedure for 'UniquePrefixRegexp' that constructs
#	a regular expresison that matches the unique prefixes.
#
# Parameters:
#	successors - Dictionary whose keys are all prefixes
#		     of keys passed to 'UniquePrefixRegexp' and whose
#		     values are dictionaries whose keys are the characters
#		     that may follow those prefixes.
#	uniquePrefixMapping - Dictionary whose keys are the unique
#			      prefixes and whose values are not examined.
#	prefixString - Current prefix being processed.
#
# Results:
#	Returns a constructed regular expression that matches the set of
#	unique prefixes beginning with the 'prefixString'.
#	Returns a constructed regular expression that matches the set
#	of unique prefixes beginning with the 'prefixString'.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::MakeUniquePrefixRegexp { successors
					  uniquePrefixMapping
					  prefixString } {

    # Get the characters that may follow the current prefix string

    set schars [lsort -ascii [dict keys [dict get $successors $prefixString]]]
    if { [llength $schars] == 0 } {
	return {}
    }

    # If there is more than one successor character, or if the current prefix
    # is a unique prefix, surround the generated re with non-capturing
    # If there is more than one successor character, or if the current
    # prefix is a unique prefix, surround the generated re with non-capturing
    # parentheses.

    set re {}
    if {
	[dict exists $uniquePrefixMapping $prefixString]
	|| [llength $schars] > 1
    if { [dict exists $uniquePrefixMapping $prefixString]
	 || [llength $schars] > 1 } {
    } then {
	append re "(?:"
    }

    # Generate a regexp that matches the successors.

    set sep ""
    foreach { c } $schars {
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
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







-
+










-
-
+
+










-
-
+
+















+
-
-
+
+





-
-
+
+








    # If the current prefix is a unique prefix, make all following text
    # optional. Otherwise, if there is more than one successor character,
    # close the non-capturing parentheses.

    if { [dict exists $uniquePrefixMapping $prefixString] } {
	append re ")?"
    } elseif { [llength $schars] > 1 } {
    }  elseif { [llength $schars] > 1 } {
	append re ")"
    }

    return $re
}

#----------------------------------------------------------------------
#
# MakeParseCodeFromFields --
#
#	Composes Tcl code to extract the Julian Day Number from a dictionary
#	containing date fields.
#	Composes Tcl code to extract the Julian Day Number from a
#	dictionary containing date fields.
#
# Parameters:
#	dateFields -- Dictionary whose keys are fields of the date,
#	              and whose values are the rightmost positions
#		      at which those fields appear.
#	parseActions -- List of triples: field set, priority, and
#			code to emit.  Smaller priorities are better, and
#			the list must be in ascending order by priority
#
# Results:
#	Returns a burst of code that extracts the day number from the given
#	date.
#	Returns a burst of code that extracts the day number from the
#	given date.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::MakeParseCodeFromFields { dateFields parseActions } {

    set currPrio 999
    set currFieldPos [list]
    set currCodeBurst {
	error "in ::tcl::clock::MakeParseCodeFromFields: can't happen"
    }

    foreach { fieldSet prio parseAction } $parseActions {

	# If we've found an answer that's better than any that follow, quit
	# now.
	# If we've found an answer that's better than any that follow,
	# quit now.

	if { $prio > $currPrio } {
	    break
	}

	# Accumulate the field positions that are used in the current field
	# grouping.
	# Accumulate the field positions that are used in the current
	# field grouping.

	set fieldPos [list]
	set ok true
	foreach field $fieldSet {
	    if { ! [dict exists $dateFields $field] } {
		set ok 0
		break
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
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







-
-
-
-
+
+
+
-

















+



+










+
+





-
+
+
+



-
+
+
+
+
+
+
+
+

+

+
-
-
+
+



+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-

-
-
+
+

-
-
+
+

+




-
+
+
+
+
+
+

+
-
-
+
+
+
+






-
-
+
+











-
-
+
+
+




+








	# Determine whether the current answer is better than the last.

	set fPos [lsort -integer -decreasing $fieldPos]

	if { $prio ==  $currPrio } {
	    foreach currPos $currFieldPos newPos $fPos {
		if {
		    ![string is integer $newPos]
		    || ![string is integer $currPos]
		    || $newPos > $currPos
		if { ![string is integer $newPos]
		     || ![string is integer $currPos]
		     || $newPos > $currPos } {
		} then {
		    break
		}
		if { $newPos < $currPos } {
		    set ok 0
		    break
		}
	    }
	}
	if { !$ok } {
	    continue
	}

	# Remember the best possibility for extracting date information

	set currPrio $prio
	set currFieldPos $fPos
	set currCodeBurst $parseAction

    }

    return $currCodeBurst

}

#----------------------------------------------------------------------
#
# EnterLocale --
#
#	Switch [mclocale] to a given locale if necessary
#
# Parameters:
#	locale -- Desired locale
#	oldLocaleVar -- Name of a variable in caller's scope that
#		        tracks the previous locale name.
#
# Results:
#	Returns the locale that was previously current.
#
# Side effects:
#	Does [mclocale].  If necessary, loades the designated locale's files.
#	Does [mclocale].  If necessary, uses [mcload] to load the
#	designated locale's files, and tracks that it has done so
#	in the 'McLoaded' variable.
#
#----------------------------------------------------------------------

proc ::tcl::clock::EnterLocale { locale } {
proc ::tcl::clock::EnterLocale { locale oldLocaleVar } {

    upvar 1 $oldLocaleVar oldLocale

    variable MsgDir
    variable McLoaded

    set oldLocale [mclocale]
    if { $locale eq {system} } {

	if { $::tcl_platform(platform) ne {windows} } {

	    # On a non-windows platform, the 'system' locale is the same as
	    # the 'current' locale
	    # On a non-windows platform, the 'system' locale is
	    # the same as the 'current' locale

	    set locale current
	} else {

	    # On a windows platform, the 'system' locale is adapted from the
	    # 'current' locale by applying the date and time formats from the
	    # Control Panel.  First, load the 'current' locale if it's not yet
	    # loaded

	    # On a windows platform, the 'system' locale is
	    # adapted from the 'current' locale by applying the
	    # date and time formats from the Control Panel.
	    # First, load the 'current' locale if it's not yet loaded

	    if {![dict exists $McLoaded $oldLocale] } {
		mcload $MsgDir
		dict set McLoaded $oldLocale {}
	    }
	    mcpackagelocale set [mclocale]

	    # Make a new locale string for the system locale, and get the
	    # Control Panel information
	    # Make a new locale string for the system locale, and
	    # get the Control Panel information

	    set locale [mclocale]_windows
	    if { ! [mcpackagelocale present $locale] } {
	    set locale ${oldLocale}_windows
	    if { ![dict exists $McLoaded $locale] } {
		LoadWindowsDateTimeFormats $locale
		dict set McLoaded $locale {}
	    }
	}
    }
    if { $locale eq {current}} {
	set locale [mclocale]
	set locale $oldLocale
	unset oldLocale
    } elseif { $locale eq $oldLocale } {
	unset oldLocale
    } else {
	mclocale $locale
    }
    if { ![dict exists $McLoaded $locale] } {
    # Eventually load the locale
    mcpackagelocale set $locale
	mcload $MsgDir
	dict set McLoaded $locale {}
    }

}

#----------------------------------------------------------------------
#
# LoadWindowsDateTimeFormats --
#
#	Load the date/time formats from the Control Panel in Windows and
#	convert them so that they're usable by Tcl.
#	Load the date/time formats from the Control Panel in Windows
#	and convert them so that they're usable by Tcl.
#
# Parameters:
#	locale - Name of the locale in whose message catalog
#	         the converted formats are to be stored.
#
# Results:
#	None.
#
# Side effects:
#	Updates the given message catalog with the locale strings.
#
# Presumes that on entry, [mclocale] is set to the current locale, so that
# default strings can be obtained if the Registry query fails.
# Presumes that on entry, [mclocale] is set to the current locale,
# so that default strings can be obtained if the Registry query
# fails.
#
#----------------------------------------------------------------------

proc ::tcl::clock::LoadWindowsDateTimeFormats { locale } {

    # Bail out if we can't find the Registry

    variable NoRegistry
    if { [info exists NoRegistry] } return

    if { ![catch {
	registry get "HKEY_CURRENT_USER\\Control Panel\\International" \
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
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







-
-
+
+








+
-
-
-
+
+
+
+
-
-
-
+
+







#
# Parameters:
#	locale -- Current [mclocale] locale, supplied to avoid
#		  an extra call
#	format -- Format supplied to [clock scan] or [clock format]
#
# Results:
#	Returns the string with locale-dependent composite format groups
#	substituted out.
#	Returns the string with locale-dependent composite format
#	groups substituted out.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::LocalizeFormat { locale format } {

    variable McLoaded
    # message catalog key to cache this format
    set key FORMAT_$format


    if { [dict exists $McLoaded $locale FORMAT $format] } {
	return [dict get $McLoaded $locale FORMAT $format]
    }
    if { [::msgcat::mcexists -exactlocale -exactnamespace $key] } {
	return [mc $key]
    }
    set inFormat $format

    # Handle locale-dependent format groups by mapping them out of the format
    # string.  Note that the order of the [string map] operations is
    # significant because later formats can refer to later ones; for example
    # %c can refer to %X, which in turn can refer to %T.

    set list {
	%% %%
2506
2507
2508
2509
2510
2511
2512
2513

2514
2515
2516
2517
2518
2519
2520
2579
2580
2581
2582
2583
2584
2585

2586
2587
2588
2589
2590
2591
2592
2593







-
+







    lappend list %EX [string map $list [mc LOCALE_TIME_FORMAT]]
    lappend list %x  [string map $list [mc DATE_FORMAT]]
    lappend list %Ex [string map $list [mc LOCALE_DATE_FORMAT]]
    lappend list %c  [string map $list [mc DATE_TIME_FORMAT]]
    lappend list %Ec [string map $list [mc LOCALE_DATE_TIME_FORMAT]]
    set format [string map $list $format]

    ::msgcat::mcset $locale $key $format
    dict set McLoaded $locale FORMAT $inFormat $format
    return $format
}

#----------------------------------------------------------------------
#
# FormatNumericTimeZone --
#
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
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







+














+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::FormatNumericTimeZone { z } {

    if { $z < 0 } {
	set z [expr { - $z }]
	set retval -
    } else {
	set retval +
    }
    append retval [::format %02d [expr { $z / 3600 }]]
    set z [expr { $z % 3600 }]
    append retval [::format %02d [expr { $z / 60 }]]
    set z [expr { $z % 60 }]
    if { $z != 0 } {
	append retval [::format %02d $z]
    }
    return $retval

}

#----------------------------------------------------------------------
#
# FormatStarDate --
#
#	Formats a date as a StarDate.
2566
2567
2568
2569
2570
2571
2572

2573
2574
2575
2576
2577
2578
2579
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655







+







#
# Jeff Hobbs put this in to support an atrocious pun about Tcl being
# "Enterprise ready."  Now we're stuck with it.
#
#----------------------------------------------------------------------

proc ::tcl::clock::FormatStarDate { date } {

    variable Roddenberry

    # Get day of year, zero based

    set doy [expr { [dict get $date dayOfYear] - 1 }]

    # Determine whether the year is a leap year
2616
2617
2618
2619
2620
2621
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670


2671
2672
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
2709
2710
2711
2712
2713





2714
2715
2716
2717
2718
2719

2720
2721
2722
2723
2724
2725
2726

2727
2728
2729
2730
2731
2732
2733
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714


2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728





2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744


2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766


2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784





2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811







+















-
-
+
+












-
-
-
-
-
+
+
+
+












-
-
+
+




















-
-
+
+
















-
-
-
-
-
+
+
+
+
+






+







+







#
# Jeff Hobbs put this in to support an atrocious pun about Tcl being
# "Enterprise ready."  Now we're stuck with it.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParseStarDate { year fractYear fractDay } {

    variable Roddenberry

    # Build a tentative date from year and fraction.

    set date [dict create \
		  gregorian 1 \
		  era CE \
		  year [expr { $year + $Roddenberry }] \
		  dayOfYear [expr { $fractYear * 365 / 1000 + 1 }]]
    set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]

    # Determine whether the given year is a leap year

    set lp [IsGregorianLeapYear $date]

    # Reconvert the fractional year according to whether the given year is a
    # leap year
    # Reconvert the fractional year according to whether the given
    # year is a leap year

    if { $lp } {
	dict set date dayOfYear \
	    [expr { $fractYear * 366 / 1000 + 1 }]
    } else {
	dict set date dayOfYear \
	    [expr { $fractYear * 365 / 1000 + 1 }]
    }
    dict unset date julianDay
    dict unset date gregorian
    set date [GetJulianDayFromGregorianEraYearDay $date[set date {}]]

    return [expr {
	86400 * [dict get $date julianDay]
	- 210866803200
	+ ( 86400 / 10 ) * $fractDay
    }]
    return [expr { 86400 * [dict get $date julianDay]
		   - 210866803200
		   + ( 86400 / 10 ) * $fractDay }]

}

#----------------------------------------------------------------------
#
# ScanWide --
#
#	Scans a wide integer from an input
#
# Parameters:
#	str - String containing a decimal wide integer
#
# Results:
#	Returns the string as a pure wide integer.  Throws an error if the
#	string is misformatted or out of range.
#	Returns the string as a pure wide integer.  Throws an error if
#	the string is misformatted or out of range.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ScanWide { str } {
    set count [::scan $str {%ld %c} result junk]
    if { $count != 1 } {
	return -code error -errorcode [list CLOCK notAnInteger $str] \
	    "\"$str\" is not an integer"
    }
    if { [incr result 0] != $str } {
	return -code error -errorcode [list CLOCK integervalueTooLarge] \
	    "integer value too large to represent"
    }
    return $result
}

#----------------------------------------------------------------------
#
# InterpretTwoDigitYear --
#
#	Given a date that contains only the year of the century, determines
#	the target value of a two-digit year.
#	Given a date that contains only the year of the century,
#	determines the target value of a two-digit year.
#
# Parameters:
#	date - Dictionary containing fields of the date.
#	baseTime - Base time relative to which the date is expressed.
#	twoDigitField - Name of the field that stores the two-digit year.
#			Default is 'yearOfCentury'
#	fourDigitField - Name of the field that will receive the four-digit
#	                 year.  Default is 'year'
#
# Results:
#	Returns the dictionary augmented with the four-digit year, stored in
#	the given key.
#
# Side effects:
#	None.
#
# The current rule for interpreting a two-digit year is that the year shall be
# between 1937 and 2037, thus staying within the range of a 32-bit signed
# value for time.  This rule may change to a sliding window in future
# versions, so the 'baseTime' parameter (which is currently ignored) is
# provided in the procedure signature.
# The current rule for interpreting a two-digit year is that the year
# shall be between 1937 and 2037, thus staying within the range of a
# 32-bit signed value for time.  This rule may change to a sliding
# window in future versions, so the 'baseTime' parameter (which is
# currently ignored) is provided in the procedure signature.
#
#----------------------------------------------------------------------

proc ::tcl::clock::InterpretTwoDigitYear { date baseTime
					   { twoDigitField yearOfCentury }
					   { fourDigitField year } } {

    set yr [dict get $date $twoDigitField]
    if { $yr <= 37 } {
	dict set date $fourDigitField [expr { $yr + 2000 }]
    } else {
	dict set date $fourDigitField [expr { $yr + 1900 }]
    }
    return $date

}

#----------------------------------------------------------------------
#
# AssignBaseYear --
#
#	Places the number of the current year into a dictionary.
2745
2746
2747
2748
2749
2750
2751

2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764

2765
2766
2767
2768
2769
2770
2771
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851







+













+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseYear { date baseTime timezone changeover } {

    variable TZData

    # Find the Julian Day Number corresponding to the base time, and
    # find the Gregorian year corresponding to that Julian Day.

    set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]

    # Store the converted year

    dict set date era [dict get $date2 era]
    dict set date year [dict get $date2 year]

    return $date

}

#----------------------------------------------------------------------
#
# AssignBaseIso8601Year --
#
#	Determines the base year in the ISO8601 fiscal calendar.
2784
2785
2786
2787
2788
2789
2790

2791
2792
2793
2794
2795
2796
2797
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878







+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseIso8601Year {date baseTime timeZone changeover} {

    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]

    # Calculate the ISO8601 date and transfer the year
2820
2821
2822
2823
2824
2825
2826

2827
2828
2829
2830
2831
2832
2833
2834
2835

2836
2837
2838
2839
2840
2841
2842
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







+









+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseMonth {date baseTime timezone changeover} {

    variable TZData

    # Find the year and month corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timezone) $changeover]
    dict set date era [dict get $date2 era]
    dict set date year [dict get $date2 year]
    dict set date month [dict get $date2 month]
    return $date

}

#----------------------------------------------------------------------
#
# AssignBaseWeek --
#
#	Determines the base year and week in the ISO8601 fiscal calendar.
2854
2855
2856
2857
2858
2859
2860

2861
2862
2863
2864
2865
2866
2867
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951







+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseWeek {date baseTime timeZone changeover} {

    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]

    # Calculate the ISO8601 date and transfer the year
2890
2891
2892
2893
2894
2895
2896

2897
2898
2899
2900
2901
2902
2903
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988







+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AssignBaseJulianDay { date baseTime timeZone changeover } {

    variable TZData

    # Find the Julian Day Number corresponding to the base time

    set date2 [GetDateFields $baseTime $TZData($timeZone) $changeover]
    dict set date julianDay [dict get $date2 julianDay]

2919
2920
2921
2922
2923
2924
2925

2926
2927
2928
2929
2930
2931
2932
2933
2934

2935
2936
2937
2938
2939
2940
2941
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







+









+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::InterpretHMSP { date } {

    set hr [dict get $date hourAMPM]
    if { $hr == 12 } {
	set hr 0
    }
    if { [dict get $date amPmIndicator] } {
	incr hr 12
    }
    dict set date hour $hr
    return [InterpretHMS $date[set date {}]]

}

#----------------------------------------------------------------------
#
# InterpretHMS --
#
#	Interprets a 24-hour time "hh:mm:ss"
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961





2962
2963
2964
2965
2966
2967
2968
3037
3038
3039
3040
3041
3042
3043





3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055







-
-
-
-
-
+
+
+
+
+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::InterpretHMS { date } {
    return [expr {
	( [dict get $date hour] * 60
	  + [dict get $date minute] ) * 60
	+ [dict get $date second]
    }]

    return [expr { ( [dict get $date hour] * 60
		     + [dict get $date minute] ) * 60
		   + [dict get $date second] }]

}

#----------------------------------------------------------------------
#
# GetSystemTimeZone --
#
#	Determines the system time zone, which is the default for the
2977
2978
2979
2980
2981
2982
2983

2984
2985
2986
2987
2988
2989
2990
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078







+







# Side effects:
#	Stores the sustem time zone in the 'CachedSystemTimeZone'
#	variable, since determining it may be an expensive process.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetSystemTimeZone {} {

    variable CachedSystemTimeZone
    variable TimeZoneBad

    if {[set result [getenv TCL_TZ]] ne {}} {
	set timezone $result
    } elseif {[set result [getenv TZ]] ne {}} {
	set timezone $result
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
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
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







+






-
-
+
+
+





-
-
+
+

-
-
-
-
+
+
+
+
+




+






+
+

-
+






-
-
+
+





-
-
-
+
+
+




+





+


-
-
-
-
+
+
+




















+





+
-
+


-
+




+

+












+
-
-
+
+







	dict set TimeZoneBad $timezone [catch {SetupTimeZone $timezone}]
    }
    if { [dict get $TimeZoneBad $timezone] } {
	return :localtime
    } else {
	return $timezone
    }

}

#----------------------------------------------------------------------
#
# ConvertLegacyTimeZone --
#
#	Given an alphanumeric time zone identifier and the system time zone,
#	convert the alphanumeric identifier to an unambiguous time zone.
#	Given an alphanumeric time zone identifier and the system
#	time zone, convert the alphanumeric identifier to an
#	unambiguous time zone.
#
# Parameters:
#	tzname - Name of the time zone to convert
#
# Results:
#	Returns a time zone name corresponding to tzname, but in an
#	unambiguous form, generally +hhmm.
#	Returns a time zone name corresponding to tzname, but
#	in an unambiguous form, generally +hhmm.
#
# This procedure is implemented primarily to allow the parsing of RFC822
# date/time strings.  Processing a time zone name on input is not recommended
# practice, because there is considerable room for ambiguity; for instance, is
# BST Brazilian Standard Time, or British Summer Time?
# This procedure is implemented primarily to allow the parsing of
# RFC822 date/time strings.  Processing a time zone name on input
# is not recommended practice, because there is considerable room
# for ambiguity; for instance, is BST Brazilian Standard Time, or
# British Summer Time?
#
#----------------------------------------------------------------------

proc ::tcl::clock::ConvertLegacyTimeZone { tzname } {

    variable LegacyTimeZone

    set tzname [string tolower $tzname]
    if { ![dict exists $LegacyTimeZone $tzname] } {
	return -code error -errorcode [list CLOCK badTZName $tzname] \
	    "time zone \"$tzname\" not found"
    } else {
	return [dict get $LegacyTimeZone $tzname]
    }
    return [dict get $LegacyTimeZone $tzname]

}

#----------------------------------------------------------------------
#
# SetupTimeZone --
#
#	Given the name or specification of a time zone, sets up its in-memory
#	data.
#	Given the name or specification of a time zone, sets up
#	its in-memory data.
#
# Parameters:
#	tzname - Name of a time zone
#
# Results:
#	Unless the time zone is ':localtime', sets the TZData array to contain
#	the lookup table for local<->UTC conversion.  Returns an error if the
#	time zone cannot be parsed.
#	Unless the time zone is ':localtime', sets the TZData array
#	to contain the lookup table for local<->UTC conversion.
#	Returns an error if the time zone cannot be parsed.
#
#----------------------------------------------------------------------

proc ::tcl::clock::SetupTimeZone { timezone } {

    variable TZData

    if {! [info exists TZData($timezone)] } {
	variable MINWIDE
	if { $timezone eq {:localtime} } {

	    # Nothing to do, we'll convert using the localtime function

	} elseif {
	    [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
		    -> s hh mm ss]
	} then {
	} elseif { [regexp {^([-+])(\d\d)(?::?(\d\d)(?::?(\d\d))?)?} $timezone \
		    -> s hh mm ss] } {

	    # Make a fixed offset

	    ::scan $hh %d hh
	    if { $mm eq {} } {
		set mm 0
	    } else {
		::scan $mm %d mm
	    }
	    if { $ss eq {} } {
		set ss 0
	    } else {
		::scan $ss %d ss
	    }
	    set offset [expr { ( $hh * 60 + $mm ) * 60 + $ss }]
	    if { $s eq {-} } {
		set offset [expr { - $offset }]
	    }
	    set TZData($timezone) [list [list $MINWIDE $offset -1 $timezone]]

	} elseif { [string index $timezone 0] eq {:} } {

	    # Convert using a time zone file

	    if {
		[catch {
		    LoadTimeZoneFile [string range $timezone 1 end]
		}]
		}] && [catch {
		&& [catch {
		    LoadZoneinfoFile [string range $timezone 1 end]
		}]
	    } then {
	    } {
		return -code error \
		    -errorcode [list CLOCK badTimeZone $timezone] \
		    "time zone \"$timezone\" not found"
	    }

	} elseif { ![catch {ParsePosixTimeZone $timezone} tzfields] } {

	    # This looks like a POSIX time zone - try to process it

	    if { [catch {ProcessPosixTimeZone $tzfields} data opts] } {
		if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
		    dict unset opts -errorinfo
		}
		return -options $opts $data
	    } else {
		set TZData($timezone) $data
	    }

	} else {

	    # We couldn't parse this as a POSIX time zone.  Try again with a
	    # time zone file - this time without a colon
	    # We couldn't parse this as a POSIX time zone.  Try
	    # again with a time zone file - this time without a colon

	    if { [catch { LoadTimeZoneFile $timezone }]
		 && [catch { LoadZoneinfoFile $timezone } - opts] } {
		dict unset opts -errorinfo
		return -options $opts "time zone $timezone not found"
	    }
	    set TZData($timezone) $TZData(:$timezone)
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
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







-
-
+
+


-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
+




+







#
#	Determines the system time zone on windows.
#
# Parameters:
#	None.
#
# Results:
#	Returns a time zone specifier that corresponds to the system time zone
#	information found in the Registry.
#	Returns a time zone specifier that corresponds to the system
#	time zone information found in the Registry.
#
# Bugs:
#	Fixed dates for DST change are unimplemented at present, because no
#	time zone information supplied with Windows actually uses them!
#	Fixed dates for DST change are unimplemented at present, because
#	no time zone information supplied with Windows actually uses
#	them!
#
# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is specified,
# GuessWindowsTimeZone looks in the Registry for the system time zone
# information.  It then attempts to find an entry in WinZoneInfo for a time
# zone that uses the same rules.  If it finds one, it returns it; otherwise,
# it constructs a Posix-style time zone string and returns that.
# On a Windows system where neither $env(TCL_TZ) nor $env(TZ) is
# specified, GuessWindowsTimeZone looks in the Registry for the
# system time zone information.  It then attempts to find an entry
# in WinZoneInfo for a time zone that uses the same rules.  If
# it finds one, it returns it; otherwise, it constructs a Posix-style
# time zone string and returns that.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GuessWindowsTimeZone {} {

    variable WinZoneInfo
    variable NoRegistry
    variable TimeZoneBad

    if { [info exists NoRegistry] } {
	return :localtime
    }
3189
3190
3191
3192
3193
3194
3195

3196
3197
3198
3199
3200
3201
3202
3203




3204
3205
3206
3207
3208
3209
3210
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304



3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315







+





-
-
-
+
+
+
+







	}
	set daytzi [registry get $rpath DaylightStart]
	foreach ind {0 2 14 4 6 8 10 12} {
	    binary scan $daytzi @${ind}s val
	    lappend data $val
	}
    }] } {

	# Missing values in the Registry - bail out

	return :localtime
    }

    # Make up a Posix time zone specifier if we can't find one.  Check here
    # that the tzdata file exists, in case we're running in an environment
    # (e.g. starpack) where tzdata is incomplete.  (Bug 1237907)
    # Make up a Posix time zone specifier if we can't find one.
    # Check here that the tzdata file exists, in case we're running
    # in an environment (e.g. starpack) where tzdata is incomplete.
    # (Bug 1237907)

    if { [dict exists $WinZoneInfo $data] } {
	set tzname [dict get $WinZoneInfo $data]
	if { ! [dict exists $TimeZoneBad $tzname] } {
	    dict set TimeZoneBad $tzname [catch {SetupTimeZone $tzname}]
	}
    } else {
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
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







-
-
-
-
-
+
+
+
+
+








-
-
-
-
-
+
+
+
+
+










+







	    set hh [::format %02d [expr { $dstDelta / 3600 }]]
	    set mm [::format %02d [expr { ($dstDelta / 60 ) % 60 }]]
	    set ss [::format %02d [expr { $dstDelta % 60 }]]
	    append tzname < $dispDstSignum $hh $mm > $dstSignum $hh : $mm : $ss
	    if { $dstYear == 0 } {
		append tzname ,M $dstMonth . $dstDayOfMonth . $dstDayOfWeek
	    } else {
		# I have not been able to find any locale on which Windows
		# converts time zone on a fixed day of the year, hence don't
		# know how to interpret the fields.  If someone can inform me,
		# I'd be glad to code it up.  For right now, we bail out in
		# such a case.
		# I have not been able to find any locale on which
		# Windows converts time zone on a fixed day of the year,
		# hence don't know how to interpret the fields.
		# If someone can inform me, I'd be glad to code it up.
		# For right now, we bail out in such a case.
		return :localtime
	    }
	    append tzname / [::format %02d $dstHour] \
		: [::format %02d $dstMinute] \
		: [::format %02d $dstSecond]
	    if { $stdYear == 0 } {
		append tzname ,M $stdMonth . $stdDayOfMonth . $stdDayOfWeek
	    } else {
		# I have not been able to find any locale on which Windows
		# converts time zone on a fixed day of the year, hence don't
		# know how to interpret the fields.  If someone can inform me,
		# I'd be glad to code it up.  For right now, we bail out in
		# such a case.
		# I have not been able to find any locale on which
		# Windows converts time zone on a fixed day of the year,
		# hence don't know how to interpret the fields.
		# If someone can inform me, I'd be glad to code it up.
		# For right now, we bail out in such a case.
		return :localtime
	    }
	    append tzname / [::format %02d $stdHour] \
		: [::format %02d $stdMinute] \
		: [::format %02d $stdSecond]
	}
	dict set WinZoneInfo $data $tzname
    }

    return [dict get $WinZoneInfo $data]

}

#----------------------------------------------------------------------
#
# LoadTimeZoneFile --
#
#	Load the data file that specifies the conversion between a
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
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







-
-
-
+
+
+






-
-
-
+
+
+

















-
-
+
+







+


-
-
-
+
+
+







    variable DataDir
    variable TZData

    if { [info exists TZData($fileName)] } {
	return
    }

    # Since an unsafe interp uses the [clock] command in the parent, this code
    # is security sensitive.  Make sure that the path name cannot escape the
    # given directory.
    # Since an unsafe interp uses the [clock] command in the master,
    # this code is security sensitive.  Make sure that the path name
    # cannot escape the given directory.

    if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone $:fileName] \
	    "time zone \":$fileName\" not valid"
    }
    try {
	source [file join $DataDir $fileName]
    } on error {} {
    if { [catch {
	source -encoding utf-8 [file join $DataDir $fileName]
    }] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone :$fileName] \
	    "time zone \":$fileName\" not found"
    }
    return
}

#----------------------------------------------------------------------
#
# LoadZoneinfoFile --
#
#	Loads a binary time zone information file in Olson format.
#
# Parameters:
#	fileName - Relative path name of the file to load.
#
# Results:
#	Returns an empty result normally; returns an error if no Olson file
#	was found or the file was malformed in some way.
#	Returns an empty result normally; returns an error if no
#	Olson file was found or the file was malformed in some way.
#
# Side effects:
#	TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------

proc ::tcl::clock::LoadZoneinfoFile { fileName } {

    variable ZoneinfoPaths

    # Since an unsafe interp uses the [clock] command in the parent, this code
    # is security sensitive.  Make sure that the path name cannot escape the
    # given directory.
    # Since an unsafe interp uses the [clock] command in the master,
    # this code is security sensitive.  Make sure that the path name
    # cannot escape the given directory.

    if { ![regexp {^[[.-.][:alpha:]_]+(?:/[[.-.][:alpha:]_]+)*$} $fileName] } {
	return -code error \
	    -errorcode [list CLOCK badTimeZone $:fileName] \
	    "time zone \":$fileName\" not valid"
    }
    foreach d $ZoneinfoPaths {
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
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







-
-
+
+





+



















-
-
+
+

















-
-
+
+


-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+







#
# Parameters:
#	fileName - Name of the time zone (relative path name of the
#		   file).
#	fname - Absolute path name of the file.
#
# Results:
#	Returns an empty result normally; returns an error if no Olson file
#	was found or the file was malformed in some way.
#	Returns an empty result normally; returns an error if no
#	Olson file was found or the file was malformed in some way.
#
# Side effects:
#	TZData(:fileName) contains the time zone data
#
#----------------------------------------------------------------------


proc ::tcl::clock::ReadZoneinfoFile {fileName fname} {
    variable MINWIDE
    variable TZData
    if { ![file exists $fname] } {
	return -code error "$fileName not found"
    }

    if { [file size $fname] > 262144 } {
	return -code error "$fileName too big"
    }

    # Suck in all the data from the file

    set f [open $fname r]
    fconfigure $f -translation binary
    set d [read $f]
    close $f

    # The file begins with a magic number, sixteen reserved bytes, and then
    # six 4-byte integers giving counts of fileds in the file.
    # The file begins with a magic number, sixteen reserved bytes,
    # and then six 4-byte integers giving counts of fileds in the file.

    binary scan $d a4a1x15IIIIII \
	magic version nIsGMT nIsStd nLeap nTime nType nChar
    set seek 44
    set ilen 4
    set iformat I
    if { $magic != {TZif} } {
	return -code error "$fileName not a time zone information file"
    }
    if { $nType > 255 } {
	return -code error "$fileName contains too many time types"
    }
    # Accept only Posix-style zoneinfo.  Sorry, 'leaps' bigots.
    if { $nLeap != 0 } {
	return -code error "$fileName contains leap seconds"
    }

    # In a version 2 file, we use the second part of the file, which contains
    # 64-bit transition times.
    # In a version 2 file, we use the second part of the file, which
    # contains 64-bit transition times.

    if {$version eq "2"} {
	set seek [expr {
	set seek [expr {44
	    44
	    + 5 * $nTime
	    + 6 * $nType
	    + 4 * $nLeap
	    + $nIsStd
	    + $nIsGMT
	    + $nChar
	}]
			+ 5 * $nTime
			+ 6 * $nType
			+ 4 * $nLeap
			+ $nIsStd
			+ $nIsGMT
			+ $nChar
		    }]
	binary scan $d @${seek}a4a1x15IIIIII \
	    magic version nIsGMT nIsStd nLeap nTime nType nChar
	if {$magic ne {TZif}} {
	    return -code error "seek address $seek miscomputed, magic = $magic"
	}
	set iformat W
	set ilen 8
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
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







-
-
-
+
+
+







-
-
-
-
+
+
+
+







    set times [linsert $times 0 $MINWIDE]
    set codes {}
    foreach c $tempCodes {
	lappend codes [expr { $c & 0xFF }]
    }
    set codes [linsert $codes 0 0]

    # Next come ${nType} time type descriptions, each of which has an offset
    # (seconds east of GMT), a DST indicator, and an index into the
    # abbreviation text.
    # Next come ${nType} time type descriptions, each of which has an
    # offset (seconds east of GMT), a DST indicator, and an index into
    # the abbreviation text.

    for { set i 0 } { $i < $nType } { incr i } {
	binary scan $d @${seek}Icc gmtOff isDst abbrInd
	lappend types [list $gmtOff $isDst $abbrInd]
	incr seek 6
    }

    # Next come $nChar characters of time zone name abbreviations, which are
    # null-terminated.
    # We build them up into a dictionary indexed by character index, because
    # that's what's in the indices above.
    # Next come $nChar characters of time zone name abbreviations,
    # which are null-terminated.
    # We build them up into a dictionary indexed by character index,
    # because that's what's in the indices above.

    binary scan $d @${seek}a${nChar} abbrs
    incr seek ${nChar}
    set abbrList [split $abbrs \0]
    set i 0
    set abbrevs {}
    foreach a $abbrList {
3495
3496
3497
3498
3499
3500
3501
3502
3503


3504
3505
3506
3507
3508
3509
3510
3602
3603
3604
3605
3606
3607
3608


3609
3610
3611
3612
3613
3614
3615
3616
3617







-
-
+
+







	set lastTime $t
	lassign [lindex $types $c] gmtoff isDst abbrInd
	set abbrev [dict get $abbrevs $abbrInd]
	lappend r [list $t $gmtoff $isDst $abbrev]
    }

    # In a version 2 file, there is also a POSIX-style time zone description
    # at the very end of the file.  To get to it, skip over nLeap leap second
    # values (8 bytes each),
    # at the very end of the file.  To get to it, skip over
    # nLeap leap second values (8 bytes each),
    # nIsStd standard/DST indicators and nIsGMT UTC/local indicators.

    if {$version eq {2}} {
	set seek [expr {$seek + 8 * $nLeap + $nIsStd + $nIsGMT + 1}]
	set last [string first \n $d $seek]
	set posix [string range $d $seek [expr {$last-1}]]
	if {[llength $posix] > 0} {
3529
3530
3531
3532
3533
3534
3535
3536
3537


3538
3539
3540
3541
3542
3543
3544
3636
3637
3638
3639
3640
3641
3642


3643
3644
3645
3646
3647
3648
3649
3650
3651







-
-
+
+







#
#	Parses the TZ environment variable in Posix form
#
# Parameters:
#	tz	Time zone specifier to be interpreted
#
# Results:
#	Returns a dictionary whose values contain the various pieces of the
#	time zone specification.
#	Returns a dictionary whose values contain the various pieces of
#	the time zone specification.
#
# Side effects:
#	None.
#
# Errors:
#	Throws an error if the syntax of the time zone is incorrect.
#
3587
3588
3589
3590
3591
3592
3593
3594
3595


3596
3597
3598
3599

3600
3601
3602
3603
3604
3605
3606
3694
3695
3696
3697
3698
3699
3700


3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714







-
-
+
+




+







#	startSeconds - The seconds part of the time of day at which DST begins.
#		       An empty string is presumed zero.
#	endDayOfYear, endJ, endMonth, endWeekOfMonth, endDayOfWeek,
#	endHours, endMinutes, endSeconds -
#		Specify the end of DST in the same way that the start* fields
#		specify the beginning of DST.
#
# This procedure serves only to break the time specifier into fields.  No
# attempt is made to canonicalize the fields or supply default values.
# This procedure serves only to break the time specifier into fields.
# No attempt is made to canonicalize the fields or supply default values.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ParsePosixTimeZone { tz } {

    if {[regexp -expanded -nocase -- {
	^
	# 1 - Standard time zone name
	([[:alpha:]]+ | <[-+[:alnum:]]+>)
	# 2 - Standard time zone offset, signum
	([-+]?)
	# 3 - Standard time zone offset, hours
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
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802

3803
3804
3805



3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817

3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840







+



-
+
+

-
-
-
+
+
+
+
+
+






-
+
+













+







	     x(dstName) x(dstSignum) x(dstHours) x(dstMinutes) x(dstSeconds) \
	     x(startJ) x(startDayOfYear) \
	     x(startMonth) x(startWeekOfMonth) x(startDayOfWeek) \
	     x(startHours) x(startMinutes) x(startSeconds) \
	     x(endJ) x(endDayOfYear) \
	     x(endMonth) x(endWeekOfMonth) x(endDayOfWeek) \
	     x(endHours) x(endMinutes) x(endSeconds)] } {

	# it's a good timezone

	return [array get x]
    }

    } else {

    return -code error\
	-errorcode [list CLOCK badTimeZone $tz] \
	"unable to parse time zone specification \"$tz\""
	return -code error\
	    -errorcode [list CLOCK badTimeZone $tz] \
	    "unable to parse time zone specification \"$tz\""

    }

}

#----------------------------------------------------------------------
#
# ProcessPosixTimeZone --
#
#	Handle a Posix time zone after it's been broken out into fields.
#	Handle a Posix time zone after it's been broken out into
#	fields.
#
# Parameters:
#	z - Dictionary returned from 'ParsePosixTimeZone'
#
# Results:
#	Returns time zone information for the 'TZData' array.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ProcessPosixTimeZone { z } {

    variable MINWIDE
    variable TZData

    # Determine the standard time zone name and seconds east of Greenwich

    set stdName [dict get $z stdName]
    if { [string index $stdName 0] eq {<} } {
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746



3747
3748
3749
3750
3751
3752
3753
3852
3853
3854
3855
3856
3857
3858



3859
3860
3861
3862
3863
3864
3865
3866
3867
3868







-
-
-
+
+
+







	set stdMinutes 0
    }
    if { [dict get $z stdSeconds] ne {} } {
	set stdSeconds [lindex [::scan [dict get $z stdSeconds] %d] 0]
    } else {
	set stdSeconds 0
    }
    set stdOffset [expr {
	(($stdHours * 60 + $stdMinutes) * 60 + $stdSeconds) * $stdSignum
    }]
    set stdOffset [expr { ( ( $stdHours * 60 + $stdMinutes )
			    * 60 + $stdSeconds )
			  * $stdSignum }]
    set data [list [list $MINWIDE $stdOffset 0 $stdName]]

    # If there's no daylight zone, we're done

    set dstName [dict get $z dstName]
    if { $dstName eq {} } {
	return $data
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782



3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793


3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815


3816
3817
3818
3819
3820
3821
3822
3823
3888
3889
3890
3891
3892
3893
3894



3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905



3906
3907

3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925



3926
3927

3928
3929
3930
3931
3932
3933
3934







-
-
-
+
+
+








-
-
-
+
+
-


















-
-
-
+
+
-







	    set dstMinutes 0
	}
	if { [dict get $z dstSeconds] ne {} } {
	    set dstSeconds [lindex [::scan [dict get $z dstSeconds] %d] 0]
	} else {
	    set dstSeconds 0
	}
	set dstOffset [expr {
	    (($dstHours*60 + $dstMinutes) * 60 + $dstSeconds) * $dstSignum
	}]
	set dstOffset [expr { ( ( $dstHours * 60 + $dstMinutes )
				* 60 + $dstSeconds )
			      * $dstSignum }]
    }

    # Fill in defaults for European or US DST rules
    # US start time is the second Sunday in March
    # EU start time is the last Sunday in March
    # US end time is the first Sunday in November.
    # EU end time is the last Sunday in October

    if {
	[dict get $z startDayOfYear] eq {}
	&& [dict get $z startMonth] eq {}
    if { [dict get $z startDayOfYear] eq {}
	 && [dict get $z startMonth] eq {} } {
    } then {
	if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
	    # EU
	    dict set z startWeekOfMonth 5
	    if {$stdHours>2} {
		dict set z startHours 2
	    } else {
		dict set z startHours [expr {$stdHours+1}]
	    }
	} else {
	    # US
	    dict set z startWeekOfMonth 2
	    dict set z startHours 2
	}
	dict set z startMonth 3
	dict set z startDayOfWeek 0
	dict set z startMinutes 0
	dict set z startSeconds 0
    }
    if {
	[dict get $z endDayOfYear] eq {}
	&& [dict get $z endMonth] eq {}
    if { [dict get $z endDayOfYear] eq {}
	 && [dict get $z endMonth] eq {} } {
    } then {
	if {($stdSignum * $stdHours>=0) && ($stdSignum * $stdHours<=12)} {
	    # EU
	    dict set z endMonth 10
	    dict set z endWeekOfMonth 5
	    if {$stdHours>2} {
		dict set z endHours 3
	    } else {
3849
3850
3851
3852
3853
3854
3855

3856
3857
3858
3859
3860
3861
3862
3863


3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874


3875
3876
3877
3878
3879
3880
3881
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973


3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984


3985
3986
3987
3988
3989
3990
3991
3992
3993







+






-
-
+
+









-
-
+
+







	    lappend data \
		[list $endTime $stdOffset 0 $stdName] \
		[list $startTime $dstOffset 1 $dstName]
	}
    }

    return $data

}

#----------------------------------------------------------------------
#
# DeterminePosixDSTTime --
#
#	Determines the time that Daylight Saving Time starts or ends from a
#	Posix time zone specification.
#	Determines the time that Daylight Saving Time starts or ends
#	from a Posix time zone specification.
#
# Parameters:
#	z - Time zone data returned from ParsePosixTimeZone.
#	    Missing fields are expected to be filled in with
#	    default values.
#	bound - The word 'start' or 'end'
#	y - The year for which the transition time is to be determined.
#
# Results:
#	Returns the transition time as a count of seconds from the epoch.  The
#	time is relative to the wall clock, not UTC.
#	Returns the transition time as a count of seconds from
#	the epoch.  The time is relative to the wall clock, not UTC.
#
#----------------------------------------------------------------------

proc ::tcl::clock::DeterminePosixDSTTime { z bound y } {

    variable FEB_28

3891
3892
3893
3894
3895
3896
3897

3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913


3914
3915
3916
3917
3918
3919
3920
3921
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024


4025
4026

4027
4028
4029
4030
4031
4032
4033







+














-
-
+
+
-







	     && [IsGregorianLeapYear $y]
	     && ( $doy > $FEB_28 ) } {
	    incr doy
	}
	dict set date dayOfYear $doy
	set date [GetJulianDayFromEraYearDay $date[set date {}] 2361222]
    } else {

	# Time was specified as a day of the week within a month

	dict set date month [dict get $z ${bound}Month]
	dict set date dayOfWeek [dict get $z ${bound}DayOfWeek]
	set dowim [dict get $z ${bound}WeekOfMonth]
	if { $dowim >= 5 } {
	    set dowim -1
	}
	dict set date dayOfWeekInMonth $dowim
	set date [GetJulianDayFromEraYearMonthWeekDay $date[set date {}] 2361222]

    }

    set jd [dict get $date julianDay]
    set seconds [expr {
	wide($jd) * wide(86400) - wide(210866803200)
    set seconds [expr { wide($jd) * wide(86400)
			- wide(210866803200) }]
    }]

    set h [dict get $z ${bound}Hours]
    if { $h eq {} } {
	set h 2
    } else {
	set h [lindex [::scan $h %d] 0]
    }
3929
3930
3931
3932
3933
3934
3935

3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954


3955
3956
3957
3958

3959
3960
3961
3962
3963
3964


3965
3966
3967
3968
3969


3970
3971
3972

3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992




3993
3994
3995
3996
3997
3998
3999
4000
4001
4002

4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018

4019
4020
4021
4022
4023
4024





4025
4026
4027
4028
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
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







+

















-
-
+
+




+




-
-
+
+
-


-
-
+
+
-


+

















-
-
-
+
+
+
+










+















-
+
-
-
-
-
-
-
+
+
+
+
+
-





-
+
-
-
-
-
+
+
+
-










-
-
+
+


















+
-
-
-
+
+
+















+







    if { $s eq {} } {
	set s 0
    } else {
	set s [lindex [::scan $s %d] 0]
    }
    set tod [expr { ( $h * 60 + $m ) * 60 + $s }]
    return [expr { $seconds + $tod }]

}

#----------------------------------------------------------------------
#
# GetLocaleEra --
#
#	Given local time expressed in seconds from the Posix epoch,
#	determine localized era and year within the era.
#
# Parameters:
#	date - Dictionary that must contain the keys, 'localSeconds',
#	       whose value is expressed as the appropriate local time;
#	       and 'year', whose value is the Gregorian year.
#	etable - Value of the LOCALE_ERAS key in the message catalogue
#	         for the target locale.
#
# Results:
#	Returns the dictionary, augmented with the keys, 'localeEra' and
#	'localeYear'.
#	Returns the dictionary, augmented with the keys, 'localeEra'
#	and 'localeYear'.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetLocaleEra { date etable } {

    set index [BSearch $etable [dict get $date localSeconds]]
    if { $index < 0} {
	dict set date localeEra \
	    [::format %02d [expr { [dict get $date year] / 100 }]]
	dict set date localeYear [expr {
	    [dict get $date year] % 100
	dict set date localeYear \
	    [expr { [dict get $date year] % 100 }]
	}]
    } else {
	dict set date localeEra [lindex $etable $index 1]
	dict set date localeYear [expr {
	    [dict get $date year] - [lindex $etable $index 2]
	dict set date localeYear [expr { [dict get $date year]
					 - [lindex $etable $index 2] }]
	}]
    }
    return $date

}

#----------------------------------------------------------------------
#
# GetJulianDayFromEraYearDay --
#
#	Given a year, month and day on the Gregorian calendar, determines
#	the Julian Day Number beginning at noon on that date.
#
# Parameters:
#	date -- A dictionary in which the 'era', 'year', and
#		'dayOfYear' slots are populated. The calendar in use
#		is determined by the date itself relative to:
#       changeover -- Julian day on which the Gregorian calendar was
#		adopted in the current locale.
#
# Results:
#	Returns the given dictionary augmented with a 'julianDay' key whose
#	value is the desired Julian Day Number, and a 'gregorian' key that
#	specifies whether the calendar is Gregorian (1) or Julian (0).
#	Returns the given dictionary augmented with a 'julianDay' key
#	whose value is the desired Julian Day Number, and a 'gregorian'
#	key that specifies whether the calendar is Gregorian (1) or
#	Julian (0).
#
# Side effects:
#	None.
#
# Bugs:
#	This code needs to be moved to the C layer.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetJulianDayFromEraYearDay {date changeover} {

    # Get absolute year number from the civil year

    switch -exact -- [dict get $date era] {
	BCE {
	    set year [expr { 1 - [dict get $date year] }]
	}
	CE {
	    set year [dict get $date year]
	}
    }
    set ym1 [expr { $year - 1 }]

    # Try the Gregorian calendar first.

    dict set date gregorian 1
    set jd [expr {
    set jd [expr { 1721425
	1721425
	+ [dict get $date dayOfYear]
	+ ( 365 * $ym1 )
	+ ( $ym1 / 4 )
	- ( $ym1 / 100 )
	+ ( $ym1 / 400 )
		   + [dict get $date dayOfYear]
		   + ( 365 * $ym1 )
		   + ( $ym1 / 4 )
		   - ( $ym1 / 100 )
		   + ( $ym1 / 400 ) }]
    }]

    # If the date is before the Gregorian change, use the Julian calendar.

    if { $jd < $changeover } {
	dict set date gregorian 0
	set jd [expr {
	set jd [expr { 1721423
	    1721423
	    + [dict get $date dayOfYear]
	    + ( 365 * $ym1 )
	    + ( $ym1 / 4 )
		       + [dict get $date dayOfYear]
		       + ( 365 * $ym1 )
		       + ( $ym1 / 4 ) }]
	}]
    }

    dict set date julianDay $jd
    return $date
}

#----------------------------------------------------------------------
#
# GetJulianDayFromEraYearMonthWeekDay --
#
#	Determines the Julian Day number corresponding to the nth given
#	day-of-the-week in a given month.
#	Determines the Julian Day number corresponding to the nth
#	given day-of-the-week in a given month.
#
# Parameters:
#	date - Dictionary containing the keys, 'era', 'year', 'month'
#	       'weekOfMonth', 'dayOfWeek', and 'dayOfWeekInMonth'.
#	changeover - Julian Day of adoption of the Gregorian calendar
#
# Results:
#	Returns the given dictionary, augmented with a 'julianDay' key.
#
# Side effects:
#	None.
#
# Bugs:
#	This code needs to be moved to the C layer.
#
#----------------------------------------------------------------------

proc ::tcl::clock::GetJulianDayFromEraYearMonthWeekDay {date changeover} {

    # Come up with a reference day; either the zeroeth day of the given month
    # (dayOfWeekInMonth >= 0) or the seventh day of the following month
    # (dayOfWeekInMonth < 0)
    # Come up with a reference day; either the zeroeth day of the
    # given month (dayOfWeekInMonth >= 0) or the seventh day of the
    # following month (dayOfWeekInMonth < 0)

    set date2 $date
    set week [dict get $date dayOfWeekInMonth]
    if { $week >= 0 } {
	dict set date2 dayOfMonth 0
    } else {
	dict incr date2 month
	dict set date2 dayOfMonth 7
    }
    set date2 [GetJulianDayFromEraYearMonthDay $date2[set date2 {}] \
		   $changeover]
    set wd0 [WeekdayOnOrBefore [dict get $date dayOfWeek] \
		 [dict get $date2 julianDay]]
    dict set date julianDay [expr { $wd0 + 7 * $week }]
    return $date

}

#----------------------------------------------------------------------
#
# IsGregorianLeapYear --
#
#	Determines whether a given date represents a leap year in the
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
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







+



















+






-
-
+
+














+


+






-
-
+
+







-
-
+
+







+











+




-
-
+
+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::IsGregorianLeapYear { date } {

    switch -exact -- [dict get $date era] {
	BCE {
	    set year [expr { 1 - [dict get $date year]}]
	}
	CE {
	    set year [dict get $date year]
	}
    }
    if { $year % 4 != 0 } {
	return 0
    } elseif { ![dict get $date gregorian] } {
	return 1
    } elseif { $year % 400 == 0 } {
	return 1
    } elseif { $year % 100 == 0 } {
	return 0
    } else {
	return 1
    }

}

#----------------------------------------------------------------------
#
# WeekdayOnOrBefore --
#
#	Determine the nearest day of week (given by the 'weekday' parameter,
#	Sunday==0) on or before a given Julian Day.
#	Determine the nearest day of week (given by the 'weekday'
#	parameter, Sunday==0) on or before a given Julian Day.
#
# Parameters:
#	weekday -- Day of the week
#	j -- Julian Day number
#
# Results:
#	Returns the Julian Day Number of the desired date.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::WeekdayOnOrBefore { weekday j } {

    set k [expr { ( $weekday + 6 )  % 7 }]
    return [expr { $j - ( $j - $k ) % 7 }]

}

#----------------------------------------------------------------------
#
# BSearch --
#
#	Service procedure that does binary search in several places inside the
#	'clock' command.
#	Service procedure that does binary search in several places
#	inside the 'clock' command.
#
# Parameters:
#	list - List of lists, sorted in ascending order by the
#	       first elements
#	key - Value to search for
#
# Results:
#	Returns the index of the greatest element in $list that is less than
#	or equal to $key.
#	Returns the index of the greatest element in $list that is less
#	than or equal to $key.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::BSearch { list key } {

    if {[llength $list] == 0} {
	return -1
    }
    if { $key < [lindex $list 0 0] } {
	return -1
    }

    set l 0
    set u [expr { [llength $list] - 1 }]

    while { $l < $u } {

	# At this point, we know that
	#   $k >= [lindex $list $l 0]
	#   Either $u == [llength $list] or else $k < [lindex $list $u+1 0]
	# We find the midpoint of the interval {l,u} rounded UP, compare
	# against it, and set l or u to maintain the invariant.  Note that the
	# interval shrinks at each step, guaranteeing convergence.
	# against it, and set l or u to maintain the invariant.  Note
	# that the interval shrinks at each step, guaranteeing convergence.

	set m [expr { ( $l + $u + 1 ) / 2 }]
	if { $key >= [lindex $list $m 0] } {
	    set l $m
	} else {
	    set u [expr { $m - 1 }]
	}
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342





4343
4344
4345

4346
4347
4348
4349











4350


4351

4352
4353
4354
4355
4356
4357
4358
4346
4347
4348
4349
4350
4351
4352




4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400


4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417

4418
4419







4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438

4439
4440
4441
4442
4443
4444
4445


4446
4447
4448
4449
4450

4451
4452
4453
4454
4455

4456
4457
4458
4459

4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473



4474
4475
4476
4477
4478
4479
4480
4481
4482




4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505







-
-
-
-
+
+
+
+




+


















+

+

+

+

+











+
-
-
+
+














+
-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+








+
-
+

+

+

+
-
-
+
+



-
+




-
+



-
+













-
-
-
+
+
+
+
+



+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

+
+

+







#		Used to determine the Gregorian change date.
#
# Results:
#	Returns the given time adjusted by the given offset(s) in
#	order.
#
# Notes:
#	It is possible that adding a number of months or years will adjust the
#	day of the month as well.  For instance, the time at one month after
#	31 January is either 28 or 29 February, because February has fewer
#	than 31 days.
#	It is possible that adding a number of months or years will adjust
#	the day of the month as well.  For instance, the time at
#	one month after 31 January is either 28 or 29 February, because
#	February has fewer than 31 days.
#
#----------------------------------------------------------------------

proc ::tcl::clock::add { clockval args } {

    if { [llength $args] % 2 != 0 } {
	set cmdName "clock add"
	return -code error \
	    -errorcode [list CLOCK wrongNumArgs] \
	    "wrong \# args: should be\
             \"$cmdName clockval ?number units?...\
             ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
    }
    if { [catch { expr {wide($clockval)} } result] } {
	return -code error $result
    }

    set offsets {}
    set gmt 0
    set locale c
    set timezone [GetSystemTimeZone]

    foreach { a b } $args {

	if { [string is integer -strict $a] } {

	    lappend offsets $a $b

	} else {

	    switch -exact -- $a {

		-g - -gm - -gmt {
		    set gmt $b
		}
		-l - -lo - -loc - -loca - -local - -locale {
		    set locale [string tolower $b]
		}
		-t - -ti - -tim - -time - -timez - -timezo - -timezon -
		-timezone {
		    set timezone $b
		}
		default {
		    return -code error \
		    throw [list CLOCK badOption $a] \
			"bad option \"$a\",\
			-errorcode [list CLOCK badSwitch $a] \
			"bad switch \"$a\",\
                         must be -gmt, -locale or -timezone"
		}
	    }
	}
    }

    # Check options for validity

    if { [info exists saw(-gmt)] && [info exists saw(-timezone)] } {
	return -code error \
	    -errorcode [list CLOCK gmtWithTimezone] \
	    "cannot use -gmt and -timezone in same call"
    }
    if { [catch { expr { wide($clockval) } } result] } {
	return -code error \
	return -code error "expected integer but got \"$clockval\""
	    "expected integer but got \"$clockval\""
    }
    if { ![string is boolean -strict $gmt] } {
	return -code error "expected boolean value but got \"$gmt\""
    } elseif { $gmt } {
	set timezone :GMT
    }

    EnterLocale $locale
    if { ![string is boolean $gmt] } {
	return -code error \
	    "expected boolean value but got \"$gmt\""
    } else {
	if { $gmt } {
	    set timezone :GMT
	}
    }

    EnterLocale $locale oldLocale

    set changeover [mc GREGORIAN_CHANGE_DATE]

    if {[catch {SetupTimeZone $timezone} retval opts]} {
	dict unset opts -errorinfo
	return -options $opts $retval
    }

    set status [catch {
    try {

	foreach { quantity unit } $offsets {

	    switch -exact -- $unit {

		years - year {
		    set clockval \
		    set clockval [AddMonths [expr { 12 * $quantity }] \
			    $clockval $timezone $changeover]
			[AddMonths [expr { 12 * $quantity }] \
			     $clockval $timezone $changeover]
		}
		months - month {
		    set clockval [AddMonths $quantity $clockval $timezone \
			    $changeover]
				     $changeover]
		}

		weeks - week {
		    set clockval [AddDays [expr { 7 * $quantity }] \
			    $clockval $timezone $changeover]
				      $clockval $timezone $changeover]
		}
		days - day {
		    set clockval [AddDays $quantity $clockval $timezone \
			    $changeover]
				      $changeover]
		}

		hours - hour {
		    set clockval [expr { 3600 * $quantity + $clockval }]
		}
		minutes - minute {
		    set clockval [expr { 60 * $quantity + $clockval }]
		}
		seconds - second {
		    set clockval [expr { $quantity + $clockval }]
		}

		default {
		    throw [list CLOCK badUnit $unit] \
			"unknown unit \"$unit\", must be \
                        years, months, weeks, days, hours, minutes or seconds"
		    error "unknown unit \"$unit\", must be \
                        years, months, weeks, days, hours, minutes or seconds" \
			  "unknown unit \"$unit\", must be \
                        years, months, weeks, days, hours, minutes or seconds" \
			[list CLOCK badUnit $unit]
		}
	    }
	}
    } result opts]
	return $clockval
    } trap CLOCK {result opts} {
	# Conceal the innards of [clock] when it's an expected error
	dict unset opts -errorinfo

    # Restore the locale

    if { [info exists oldLocale] } {
	mclocale $oldLocale
    }

    if { $status == 1 } {
	if { [lindex [dict get $opts -errorcode] 0] eq {CLOCK} } {
	    dict unset opts -errorinfo
	}
	return -options $opts $result
    } else {
	return $clockval
    }

}

#----------------------------------------------------------------------
#
# AddMonths --
#
#	Add a given number of months to a given clock value in a given
4369
4370
4371
4372
4373
4374
4375

4376
4377
4378
4379
4380
4381
4382
4383

4384
4385

4386
4387
4388
4389
4390
4391
4392
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530

4531


4532
4533
4534
4535
4536
4537
4538
4539







+







-
+
-
-
+







#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AddMonths { months clockval timezone changeover } {

    variable DaysInRomanMonthInCommonYear
    variable DaysInRomanMonthInLeapYear
    variable TZData

    # Convert the time to year, month, day, and fraction of day.

    set date [GetDateFields $clockval $TZData($timezone) $changeover]
    dict set date secondOfDay [expr {
    dict set date secondOfDay [expr { [dict get $date localSeconds]
	[dict get $date localSeconds] % 86400
    }]
				      % 86400 }]
    dict set date tzName $timezone

    # Add the requisite number of months

    set m [dict get $date month]
    incr m $months
    incr m -1
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417




4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431


4432
4433
4434
4435
4436
4437
4438
4439
4440
4441


4442
4443
4444
4445
4446
4447
4448

4449
4450
4451
4452
4453
4454

4455
4456

4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468




4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479

4480
4481
4482


4483
4484
4485

4486
4487
4488

4489
4490
4491

4492



4493
4494
4495
4496
4497



4498
4499
4500

4501
4502
4503
4504
4505





4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529

4530
4531

4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543

4544
4545
4546
4547


4554
4555
4556
4557
4558
4559
4560




4561
4562
4563
4564

4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575


4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586

4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601

4602


4603
4604
4605
4606
4607
4608
4609
4610
4611




4612
4613
4614
4615

4616
4617
4618
4619
4620
4621
4622
4623
4624

4625
4626


4627
4628
4629
4630

4631
4632
4633

4634
4635
4636

4637
4638
4639
4640
4641
4642
4643



4644
4645
4646



4647





4648
4649
4650
4651
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







-
-
-
-
+
+
+
+
-











-
-
+
+









-
+
+







+





-
+
-
-
+








-
-
-
-
+
+
+
+
-









-
+

-
-
+
+


-
+


-
+


-
+

+
+
+


-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
+
+
+
+
+

-
-
-




















+


+












+



-
+
+
    }

    # Reconvert to a number of seconds

    set date [GetJulianDayFromEraYearMonthDay \
		  $date[set date {}]\
		  $changeover]
    dict set date localSeconds [expr {
	-210866803200
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    dict set date localSeconds \
	[expr { -210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay] }]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		 $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# AddDays --
#
#	Add a given number of days to a given clock value in a given time
#	zone.
#	Add a given number of days to a given clock value in a given
#	time zone.
#
# Parameters:
#	days - Number of days to add (may be negative)
#	clockval - Seconds since the epoch before the operation
#	timezone - Time zone in which the operation is to be performed
#	changeover - Julian Day on which the Gregorian calendar was adopted
#		     in the target locale.
#
# Results:
#	Returns the new clock value as a number of seconds since the epoch.
#	Returns the new clock value as a number of seconds since
#	the epoch.
#
# Side effects:
#	None.
#
#----------------------------------------------------------------------

proc ::tcl::clock::AddDays { days clockval timezone changeover } {

    variable TZData

    # Convert the time to Julian Day

    set date [GetDateFields $clockval $TZData($timezone) $changeover]
    dict set date secondOfDay [expr {
    dict set date secondOfDay [expr { [dict get $date localSeconds]
	[dict get $date localSeconds] % 86400
    }]
				      % 86400 }]
    dict set date tzName $timezone

    # Add the requisite number of days

    dict incr date julianDay $days

    # Reconvert to a number of seconds

    dict set date localSeconds [expr {
	-210866803200
	+ ( 86400 * wide([dict get $date julianDay]) )
	+ [dict get $date secondOfDay]
    dict set date localSeconds \
	[expr { -210866803200
		+ ( 86400 * wide([dict get $date julianDay]) )
		+ [dict get $date secondOfDay] }]
    }]
    set date [ConvertLocalToUTC $date[set date {}] $TZData($timezone) \
		  $changeover]

    return [dict get $date seconds]

}

#----------------------------------------------------------------------
#
# ChangeCurrentLocale --
# mc --
#
#        The global locale was changed within msgcat.
#        Clears the buffered parse functions of the current locale.
#	Wrapper around ::msgcat::mc that caches the result according
#	to the locale.
#
# Parameters:
#        loclist (ignored)
#	Accepts the name of the message to retrieve.
#
# Results:
#        None.
#	Returns the message text.
#
# Side effects:
#        Buffered parse functions are cleared.
#	Caches the message text.
#
# Notes:
#	Only the single-argument version of [mc] is supported.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ChangeCurrentLocale {args} {
    variable FormatProc
    variable LocaleNumeralCache
proc ::tcl::clock::mc { name } {
    variable McLoaded
    set Locale [mclocale]
    variable CachedSystemTimeZone
    variable TimeZoneBad

    if { [dict exists $McLoaded $Locale $name] } {
    foreach p [info procs [namespace current]::scanproc'*'current] {
        rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*'current] {
        rename $p {}
	return [dict get $McLoaded $Locale $name]
    } else {
	set val [::msgcat::mc $name]
	dict set McLoaded $Locale $name $val
	return $val
    }

    catch {array unset FormatProc *'current}
    set LocaleNumeralCache {}
}

#----------------------------------------------------------------------
#
# ClearCaches --
#
#	Clears all caches to reclaim the memory used in [clock]
#
# Parameters:
#	None.
#
# Results:
#	None.
#
# Side effects:
#	Caches are cleared.
#
#----------------------------------------------------------------------

proc ::tcl::clock::ClearCaches {} {

    variable FormatProc
    variable LocaleNumeralCache
    variable McLoaded
    variable CachedSystemTimeZone
    variable TimeZoneBad

    foreach p [info procs [namespace current]::scanproc'*] {
	rename $p {}
    }
    foreach p [info procs [namespace current]::formatproc'*] {
	rename $p {}
    }

    catch {unset FormatProc}
    set LocaleNumeralCache {}
    set McLoaded {}
    catch {unset CachedSystemTimeZone}
    set TimeZoneBad {}
    InitTZData
}

}

Deleted library/cookiejar/cookiejar.tcl.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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










































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# cookiejar.tcl --
#
#	Implementation of an HTTP cookie storage engine using SQLite. The
#	implementation is done as a TclOO class, and includes a punycode
#	encoder and decoder (though only the encoder is currently used).
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Dependencies
package require Tcl 8.6-
package require http 2.8.4
package require sqlite3
package require tcl::idna 1.0

#
# Configuration for the cookiejar package, plus basic support procedures.
#

# This is the class that we are creating
if {![llength [info commands ::http::cookiejar]]} {
    ::oo::class create ::http::cookiejar
}

namespace eval [info object namespace ::http::cookiejar] {
    proc setInt {*var val} {
	upvar 1 ${*var} var
	if {[catch {incr dummy $val} msg]} {
	    return -code error $msg
	}
	set var $val
    }
    proc setInterval {trigger *var val} {
	upvar 1 ${*var} var
	if {![string is integer -strict $val] || $val < 1} {
	    return -code error "expected positive integer but got \"$val\""
	}
	set var $val
	{*}$trigger
    }
    proc setBool {*var val} {
	upvar 1 ${*var} var
	if {[catch {if {$val} {}} msg]} {
	    return -code error $msg
	}
	set var [expr {!!$val}]
    }

    proc setLog {*var val} {
	upvar 1 ${*var} var
	set var [::tcl::prefix match -message "log level" \
		{debug info warn error} $val]
    }

    # Keep this in sync with pkgIndex.tcl and with the install directories in
    # Makefiles
    variable version 0.2.0

    variable domainlist \
	http://publicsuffix.org/list/effective_tld_names.dat
    variable domainfile \
	[file join [file dirname [info script]] effective_tld_names.txt.gz]
    # The list is directed to from http://publicsuffix.org/list/
    variable loglevel info
    variable vacuumtrigger 200
    variable retainlimit 100
    variable offline false
    variable purgeinterval 60000
    variable refreshinterval 10000000
    variable domaincache {}

    # Some support procedures, none particularly useful in general
    namespace eval support {
	# Set up a logger if the http package isn't actually loaded yet.
	if {![llength [info commands ::http::Log]]} {
	    proc ::http::Log args {
		# Do nothing by default...
	    }
	}

	namespace export *
	proc locn {secure domain path {key ""}} {
	    if {$key eq ""} {
		format "%s://%s%s" [expr {$secure?"https":"http"}] \
		    [::tcl::idna encode $domain] $path
	    } else {
		format "%s://%s%s?%s" \
		    [expr {$secure?"https":"http"}] [::tcl::idna encode $domain] \
		    $path $key
	    }
	}
	proc splitDomain domain {
	    set pieces [split $domain "."]
	    for {set i [llength $pieces]} {[incr i -1] >= 0} {} {
		lappend result [join [lrange $pieces $i end] "."]
	    }
	    return $result
	}
	proc splitPath path {
	    set pieces [split [string trimleft $path "/"] "/"]
	    set result /
	    for {set j 0} {$j < [llength $pieces]} {incr j} {
		lappend result /[join [lrange $pieces 0 $j] "/"]
	    }
	    return $result
	}
	proc isoNow {} {
	    set ms [clock milliseconds]
	    set ts [expr {$ms / 1000}]
	    set ms [format %03d [expr {$ms % 1000}]]
	    clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1
	}
	proc log {level msg args} {
	    namespace upvar [info object namespace ::http::cookiejar] \
		loglevel loglevel
	    set who [uplevel 1 self class]
	    set mth [uplevel 1 self method]
	    set map {debug 0 info 1 warn 2 error 3}
	    if {[string map $map $level] >= [string map $map $loglevel]} {
		set msg [format $msg {*}$args]
		set LVL [string toupper $level]
		::http::Log "[isoNow] $LVL $who $mth - $msg"
	    }
	}
    }
}

# Now we have enough information to provide the package.
package provide cookiejar \
    [set [info object namespace ::http::cookiejar]::version]

# The implementation of the cookiejar package
::oo::define ::http::cookiejar {
    self {
	method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} {
	    set tbl {
		-domainfile    {domainfile set}
		-domainlist    {domainlist set}
		-domainrefresh {refreshinterval setInterval}
		-loglevel      {loglevel setLog}
		-offline       {offline setBool}
		-purgeold      {purgeinterval setInterval}
		-retain        {retainlimit setInt}
		-vacuumtrigger {vacuumtrigger setInt}
	    }
	    dict lappend tbl -domainrefresh [namespace code {
		my IntervalTrigger PostponeRefresh
	    }]
	    dict lappend tbl -purgeold [namespace code {
		my IntervalTrigger PostponePurge
	    }]
	    if {$optionName eq "\u0000\u0000"} {
		return [dict keys $tbl]
	    }
	    set opt [::tcl::prefix match -message "option" \
		    [dict keys $tbl] $optionName]
	    set setter [lassign [dict get $tbl $opt] varname]
	    namespace upvar [namespace current] $varname var
	    if {$optionValue ne "\u0000\u0000"} {
		{*}$setter var $optionValue
	    }
	    return $var
	}

	method IntervalTrigger {method} {
	    # TODO: handle subclassing
	    foreach obj [info class instances [self]] {
		[info object namespace $obj]::my $method
	    }
	}
    }

    variable purgeTimer deletions refreshTimer
    constructor {{path ""}} {
	namespace import [info object namespace [self class]]::support::*

	if {$path eq ""} {
	    sqlite3 [namespace current]::db :memory:
	    set storeorigin "constructed cookie store in memory"
	} else {
	    sqlite3 [namespace current]::db $path
	    db timeout 500
	    set storeorigin "loaded cookie store from $path"
	}

	set deletions 0
	db transaction {
	    db eval {
		--;# Store the persistent cookies in this table.
		--;# Deletion policy: once they expire, or if explicitly
		--;# killed.
		CREATE TABLE IF NOT EXISTS persistentCookies (
		    id INTEGER PRIMARY KEY,
		    secure INTEGER NOT NULL,
		    domain TEXT NOT NULL COLLATE NOCASE,
		    path TEXT NOT NULL,
		    key TEXT NOT NULL,
		    value TEXT NOT NULL,
		    originonly INTEGER NOT NULL,
		    expiry INTEGER NOT NULL,
		    lastuse INTEGER NOT NULL,
		    creation INTEGER NOT NULL);
		CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique
		    ON persistentCookies (domain, path, key);
		CREATE INDEX IF NOT EXISTS persistentLookup
		    ON persistentCookies (domain, path);

		--;# Store the session cookies in this table.
		--;# Deletion policy: at cookiejar instance deletion, if
		--;# explicitly killed, or if the number of session cookies is
		--;# too large and the cookie has not been used recently.
		CREATE TEMP TABLE sessionCookies (
		    id INTEGER PRIMARY KEY,
		    secure INTEGER NOT NULL,
		    domain TEXT NOT NULL COLLATE NOCASE,
		    path TEXT NOT NULL,
		    key TEXT NOT NULL,
		    originonly INTEGER NOT NULL,
		    value TEXT NOT NULL,
		    lastuse INTEGER NOT NULL,
		    creation INTEGER NOT NULL);
		CREATE UNIQUE INDEX sessionUnique
		    ON sessionCookies (domain, path, key);
		CREATE INDEX sessionLookup ON sessionCookies (domain, path);

		--;# View to allow for simple looking up of a cookie.
		--;# Deletion policy: NOT SUPPORTED via this view.
		CREATE TEMP VIEW cookies AS
		    SELECT id, domain, (
			    CASE originonly WHEN 1 THEN path ELSE '.' || path END
			) AS path, key, value, secure, 1 AS persistent
			FROM persistentCookies
		    UNION
		    SELECT id, domain, (
			    CASE originonly WHEN 1 THEN path ELSE '.' || path END
			) AS path, key, value, secure, 0 AS persistent
			FROM sessionCookies;

		--;# Encoded domain permission policy; if forbidden is 1, no
		--;# cookie may be ever set for the domain, and if forbidden
		--;# is 0, cookies *may* be created for the domain (overriding
		--;# the forbiddenSuper table).
		--;# Deletion policy: normally not modified.
		CREATE TABLE IF NOT EXISTS domains (
		    domain TEXT PRIMARY KEY NOT NULL,
		    forbidden INTEGER NOT NULL);

		--;# Domains that may not have a cookie defined for direct
		--;# child domains of them.
		--;# Deletion policy: normally not modified.
		CREATE TABLE IF NOT EXISTS forbiddenSuper (
		    domain TEXT PRIMARY KEY);

		--;# When we last retrieved the domain list.
		CREATE TABLE IF NOT EXISTS domainCacheMetadata (
		    id INTEGER PRIMARY KEY,
		    retrievalDate INTEGER,
		    installDate INTEGER);
	    }

	    set cookieCount "no"
	    db eval {
		SELECT COUNT(*) AS cookieCount FROM persistentCookies
	    }
	    log info "%s with %s entries" $storeorigin $cookieCount

	    my PostponePurge

	    if {$path ne ""} {
		if {[db exists {SELECT 1 FROM domains}]} {
		    my RefreshDomains
		} else {
		    my InitDomainList
		    my PostponeRefresh
		}
	    } else {
		set data [my GetDomainListOffline metadata]
		my InstallDomainData $data $metadata
		my PostponeRefresh
	    }
	}
    }

    method PostponePurge {} {
	namespace upvar [info object namespace [self class]] \
	    purgeinterval interval
	catch {after cancel $purgeTimer}
	set purgeTimer [after $interval [namespace code {my PurgeCookies}]]
    }

    method PostponeRefresh {} {
	namespace upvar [info object namespace [self class]] \
	    refreshinterval interval
	catch {after cancel $refreshTimer}
	set refreshTimer [after $interval [namespace code {my RefreshDomains}]]
    }

    method RefreshDomains {} {
	# TODO: domain list refresh policy
	my PostponeRefresh
    }

    method HttpGet {url {timeout 0} {maxRedirects 5}} {
	for {set r 0} {$r < $maxRedirects} {incr r} {
	    set tok [::http::geturl $url -timeout $timeout]
	    try {
		if {[::http::status $tok] eq "timeout"} {
		    return -code error "connection timed out"
		} elseif {[::http::ncode $tok] == 200} {
		    return [::http::data $tok]
		} elseif {[::http::ncode $tok] >= 400} {
		    return -code error [::http::error $tok]
		} elseif {[dict exists [::http::meta $tok] Location]} {
		    set url [dict get [::http::meta $tok] Location]
		    continue
		}
		return -code error \
		    "unexpected state: [::http::code $tok]"
	    } finally {
		::http::cleanup $tok
	    }
	}
	return -code error "too many redirects"
    }
    method GetDomainListOnline {metaVar} {
	upvar 1 $metaVar meta
	namespace upvar [info object namespace [self class]] \
	    domainlist url domaincache cache
	lassign $cache when data
	if {$when > [clock seconds] - 3600} {
	    log debug "using cached value created at %s" \
		[clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1]
	    dict set meta retrievalDate $when
	    return $data
	}
	log debug "loading domain list from %s" $url
	try {
	    set when [clock seconds]
	    set data [my HttpGet $url]
	    set cache [list $when $data]
	    # TODO: Should we use the Last-Modified header instead?
	    dict set meta retrievalDate $when
	    return $data
	} on error msg {
	    log error "failed to fetch list of forbidden cookie domains from %s: %s" \
		    $url $msg
	    return {}
	}
    }
    method GetDomainListOffline {metaVar} {
	upvar 1 $metaVar meta
	namespace upvar [info object namespace [self class]] \
	    domainfile filename
	log debug "loading domain list from %s" $filename
	try {
	    set f [open $filename]
	    try {
		if {[string match *.gz $filename]} {
		    zlib push gunzip $f
		}
		fconfigure $f -encoding utf-8
		dict set meta retrievalDate [file mtime $filename]
		return [read $f]
	    } finally {
		close $f
	    }
	} on error {msg opt} {
	    log error "failed to read list of forbidden cookie domains from %s: %s" \
		    $filename $msg
	    return -options $opt $msg
	}
    }
    method InitDomainList {} {
	namespace upvar [info object namespace [self class]] \
	    offline offline
	if {!$offline} {
	    try {
		set data [my GetDomainListOnline metadata]
		if {[string length $data]} {
		    my InstallDomainData $data $metadata
		    return
		}
	    } on error {} {
		log warn "attempting to fall back to built in version"
	    }
	}
	set data [my GetDomainListOffline metadata]
	my InstallDomainData $data $metadata
    }

    method InstallDomainData {data meta} {
	set n [db total_changes]
	db transaction {
	    foreach line [split $data "\n"] {
		if {[string trim $line] eq ""} {
		    continue
		} elseif {[string match //* $line]} {
		    continue
		} elseif {[string match !* $line]} {
		    set line [string range $line 1 end]
		    set idna [string tolower [::tcl::idna encode $line]]
		    set utf [::tcl::idna decode [string tolower $line]]
		    db eval {
			INSERT OR REPLACE INTO domains (domain, forbidden)
			VALUES ($utf, 0);
		    }
		    if {$idna ne $utf} {
			db eval {
			    INSERT OR REPLACE INTO domains (domain, forbidden)
			    VALUES ($idna, 0);
			}
		    }
		} else {
		    if {[string match {\*.*} $line]} {
			set line [string range $line 2 end]
			set idna [string tolower [::tcl::idna encode $line]]
			set utf [::tcl::idna decode [string tolower $line]]
			db eval {
			    INSERT OR REPLACE INTO forbiddenSuper (domain)
			    VALUES ($utf);
			}
			if {$idna ne $utf} {
			    db eval {
				INSERT OR REPLACE INTO forbiddenSuper (domain)
				VALUES ($idna);
			    }
			}
		    } else {
			set idna [string tolower [::tcl::idna encode $line]]
			set utf [::tcl::idna decode [string tolower $line]]
		    }
		    db eval {
			INSERT OR REPLACE INTO domains (domain, forbidden)
			VALUES ($utf, 1);
		    }
		    if {$idna ne $utf} {
			db eval {
			    INSERT OR REPLACE INTO domains (domain, forbidden)
			    VALUES ($idna, 1);
			}
		    }
		}
		if {$utf ne [::tcl::idna decode [string tolower $idna]]} {
		    log warn "mismatch in IDNA handling for %s (%d, %s, %s)" \
			    $idna $line $utf [::tcl::idna decode $idna]
		}
	    }

	    dict with meta {
		set installDate [clock seconds]
		db eval {
		    INSERT OR REPLACE INTO domainCacheMetadata
			(id, retrievalDate, installDate)
		    VALUES (1, $retrievalDate, $installDate);
		}
	    }
	}
	set n [expr {[db total_changes] - $n}]
	log info "constructed domain info with %d entries" $n
    }

    # This forces the rebuild of the domain data, loading it from
    method forceLoadDomainData {} {
	db transaction {
	    db eval {
		DELETE FROM domains;
		DELETE FROM forbiddenSuper;
		INSERT OR REPLACE INTO domainCacheMetadata
		    (id, retrievalDate, installDate)
		VALUES (1, -1, -1);
	    }
	    my InitDomainList
	}
    }

    destructor {
	catch {
	    after cancel $purgeTimer
	}
	catch {
	    after cancel $refreshTimer
	}
	catch {
	    db close
	}
	return
    }

    method GetCookiesForHostAndPath {listVar secure host path fullhost} {
	upvar 1 $listVar result
	log debug "check for cookies for %s" [locn $secure $host $path]
	set exact [expr {$host eq $fullhost}]
	db eval {
	    SELECT key, value FROM persistentCookies
	    WHERE domain = $host AND path = $path AND secure <= $secure
		AND (NOT originonly OR domain = $fullhost)
		AND originonly = $exact
	} {
	    lappend result $key $value
	    db eval {
		UPDATE persistentCookies SET lastuse = $now WHERE id = $id
	    }
	}
	set now [clock seconds]
	db eval {
	    SELECT id, key, value FROM sessionCookies
	    WHERE domain = $host AND path = $path AND secure <= $secure
		AND (NOT originonly OR domain = $fullhost)
		AND originonly = $exact
	} {
	    lappend result $key $value
	    db eval {
		UPDATE sessionCookies SET lastuse = $now WHERE id = $id
	    }
	}
    }

    method getCookies {proto host path} {
	set result {}
	set paths [splitPath $path]
	if {[regexp {[^0-9.]} $host]} {
	    set domains [splitDomain [string tolower [::tcl::idna encode $host]]]
	} else {
	    # Ugh, it's a numeric domain! Restrict it to just itself...
	    set domains [list $host]
	}
	set secure [string equal -nocase $proto "https"]
	# Open question: how to move these manipulations into the database
	# engine (if that's where they *should* be).
	#
	# Suggestion from kbk:
	#LENGTH(theColumn) <= LENGTH($queryStr) AND
	#SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr
	#
	# However, we instead do most of the work in Tcl because that lets us
	# do the splitting exactly right, and it's far easier to work with
	# strings in Tcl than in SQL.
	db transaction {
	    foreach domain $domains {
		foreach p $paths {
		    my GetCookiesForHostAndPath result $secure $domain $p $host
		}
	    }
	    return $result
	}
    }

    method BadDomain options {
	if {![dict exists $options domain]} {
	    log error "no domain present in options"
	    return 0
	}
	dict with options {}
	if {$domain ne $origin} {
	    log debug "cookie domain varies from origin (%s, %s)" \
		    $domain $origin
	    if {[string match .* $domain]} {
		set dotd $domain
	    } else {
		set dotd .$domain
	    }
	    if {![string equal -length [string length $dotd] \
		    [string reverse $dotd] [string reverse $origin]]} {
		log warn "bad cookie: domain not suffix of origin"
		return 1
	    }
	}
	if {![regexp {[^0-9.]} $domain]} {
	    if {$domain eq $origin} {
		# May set for itself
		return 0
	    }
	    log warn "bad cookie: for a numeric address"
	    return 1
	}
	db eval {
	    SELECT forbidden FROM domains WHERE domain = $domain
	} {
	    if {$forbidden} {
		log warn "bad cookie: for a forbidden address"
	    }
	    return $forbidden
	}
	if {[regexp {^[^.]+\.(.+)$} $domain -> super] && [db exists {
	    SELECT 1 FROM forbiddenSuper WHERE domain = $super
	}]} then {
	    log warn "bad cookie: for a forbidden address"
	    return 1
	}
	return 0
    }

    # A defined extension point to allow users to easily impose extra policies
    # on whether to accept cookies from a particular domain and path.
    method policyAllow {operation domain path} {
	return true
    }

    method storeCookie {options} {
	db transaction {
	    if {[my BadDomain $options]} {
		return
	    }
	    set now [clock seconds]
	    set persistent [dict exists $options expires]
	    dict with options {}
	    if {!$persistent} {
		if {![my policyAllow session $domain $path]} {
		    log warn "bad cookie: $domain prohibited by user policy"
		    return
		}
		db eval {
		    INSERT OR REPLACE INTO sessionCookies (
			secure, domain, path, key, value, originonly, creation,
			lastuse)
		    VALUES ($secure, $domain, $path, $key, $value, $hostonly,
			$now, $now);
		    DELETE FROM persistentCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		incr deletions [db changes]
		log debug "defined session cookie for %s" \
			[locn $secure $domain $path $key]
	    } elseif {$expires < $now} {
		if {![my policyAllow delete $domain $path]} {
		    log warn "bad cookie: $domain prohibited by user policy"
		    return
		}
		db eval {
		    DELETE FROM persistentCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		set del [db changes]
		db eval {
		    DELETE FROM sessionCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		incr deletions [incr del [db changes]]
		log debug "deleted %d cookies for %s" \
			$del [locn $secure $domain $path $key]
	    } else {
		if {![my policyAllow set $domain $path]} {
		    log warn "bad cookie: $domain prohibited by user policy"
		    return
		}
		db eval {
		    INSERT OR REPLACE INTO persistentCookies (
			secure, domain, path, key, value, originonly, expiry,
			creation, lastuse)
		    VALUES ($secure, $domain, $path, $key, $value, $hostonly,
			$expires, $now, $now);
		    DELETE FROM sessionCookies
		    WHERE domain = $domain AND path = $path AND key = $key
			AND secure <= $secure AND originonly = $hostonly
		}
		incr deletions [db changes]
		log debug "defined persistent cookie for %s, expires at %s" \
			[locn $secure $domain $path $key] \
			[clock format $expires]
	    }
	}
    }

    method PurgeCookies {} {
	namespace upvar [info object namespace [self class]] \
	    vacuumtrigger trigger  retainlimit retain
	my PostponePurge
	set now [clock seconds]
	log debug "purging cookies that expired before %s" [clock format $now]
	db transaction {
	    db eval {
		DELETE FROM persistentCookies WHERE expiry < $now
	    }
	    incr deletions [db changes]
	    db eval {
		DELETE FROM persistentCookies WHERE id IN (
		    SELECT id FROM persistentCookies ORDER BY lastuse ASC
		    LIMIT -1 OFFSET $retain)
	    }
	    incr deletions [db changes]
	    db eval {
		DELETE FROM sessionCookies WHERE id IN (
		    SELECT id FROM sessionCookies ORDER BY lastuse
		    LIMIT -1 OFFSET $retain)
	    }
	    incr deletions [db changes]
	}

	# Once we've deleted a fair bit, vacuum the database. Must be done
	# outside a transaction.
	if {$deletions > $trigger} {
	    set deletions 0
	    log debug "vacuuming cookie database"
	    catch {
		db eval {
		    VACUUM
		}
	    }
	}
    }

    forward Database db

    method lookup {{host ""} {key ""}} {
	set host [string tolower [::tcl::idna encode $host]]
	db transaction {
	    if {$host eq ""} {
		set result {}
		db eval {
		    SELECT DISTINCT domain FROM cookies
		    ORDER BY domain
		} {
		    lappend result [::tcl::idna decode [string tolower $domain]]
		}
		return $result
	    } elseif {$key eq ""} {
		set result {}
		db eval {
		    SELECT DISTINCT key FROM cookies
		    WHERE domain = $host
		    ORDER BY key
		} {
		    lappend result $key
		}
		return $result
	    } else {
		db eval {
		    SELECT value FROM cookies
		    WHERE domain = $host AND key = $key
		    LIMIT 1
		} {
		    return $value
		}
		return -code error "no such key for that host"
	    }
	}
    }
}

# Local variables:
# mode: tcl
# fill-column: 78
# End:

Deleted library/cookiejar/effective_tld_names.txt.gz.

cannot compute difference between binary files

Deleted library/cookiejar/idna.tcl.

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




































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# cookiejar.tcl --
#
#	Implementation of IDNA (Internationalized Domain Names for
#	Applications) encoding/decoding system, built on a punycode engine
#	developed directly from the code in RFC 3492, Appendix C (with
#	substantial modifications).
#
# This implementation includes code from that RFC, translated to Tcl; the
# other parts are:
# Copyright (c) 2014 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval ::tcl::idna {
    namespace ensemble create -command puny -map {
	encode punyencode
	decode punydecode
    }
    namespace ensemble create -command ::tcl::idna -map {
	encode IDNAencode
	decode IDNAdecode
	puny puny
	version {::apply {{} {package present tcl::idna} ::}}
    }

    proc IDNAencode hostname {
	set parts {}
	# Split term from RFC 3490, Sec 3.1
	foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
	    if {[regexp {[^-A-Za-z0-9]} $part]} {
		if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} {
		    scan $ch %c c
		    if {$ch < "!" || $ch > "~"} {
			set ch [format "\\u%04x" $c]
		    }
		    throw [list IDNA INVALID_NAME_CHARACTER $ch] \
			"bad character \"$ch\" in DNS name"
		}
		set part xn--[punyencode $part]
		# Length restriction from RFC 5890, Sec 2.3.1
		if {[string length $part] > 63} {
		    throw [list IDNA OVERLONG_PART $part] \
			"hostname part too long"
		}
	    }
	    lappend parts $part
	}
	return [join $parts .]
    }
    proc IDNAdecode hostname {
	set parts {}
	# Split term from RFC 3490, Sec 3.1
	foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
	    if {[string match -nocase "xn--*" $part]} {
		set part [punydecode [string range $part 4 end]]
	    }
	    lappend parts $part
	}
	return [join $parts .]
    }

    variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""]
    # Bootstring parameters for Punycode
    variable base 36
    variable tmin 1
    variable tmax 26
    variable skew 38
    variable damp 700
    variable initial_bias 72
    variable initial_n 0x80

    variable max_codepoint 0x10FFFF

    proc adapt {delta first numchars} {
	variable base
	variable tmin
	variable tmax
	variable damp
	variable skew

	set delta [expr {$delta / ($first ? $damp : 2)}]
	incr delta [expr {$delta / $numchars}]
	set k 0
	while {$delta > ($base - $tmin) * $tmax / 2} {
	    set delta [expr {$delta / ($base-$tmin)}]
	    incr k $base
	}
	return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}]
    }

    # Main punycode encoding function
    proc punyencode {string {case ""}} {
	variable digits
	variable tmin
	variable tmax
	variable base
	variable initial_n
	variable initial_bias

	if {![string is boolean $case]} {
	    return -code error "\"$case\" must be boolean"
	}

	set in {}
	foreach char [set string [split $string ""]] {
	    scan $char "%c" ch
	    lappend in $ch
	}
	set output {}

	# Initialize the state:
	set n $initial_n
	set delta 0
	set bias $initial_bias

	# Handle the basic code points:
	foreach ch $string {
	    if {$ch < "\u0080"} {
		if {$case eq ""} {
		    append output $ch
		} elseif {[string is true $case]} {
		    append output [string toupper $ch]
		} elseif {[string is false $case]} {
		    append output [string tolower $ch]
		}
	    }
	}

	set b [string length $output]

	# h is the number of code points that have been handled, b is the
	# number of basic code points.

	if {$b > 0} {
	    append output "-"
	}

	# Main encoding loop:

	for {set h $b} {$h < [llength $in]} {incr delta; incr n} {
	    # All non-basic code points < n have been handled already.  Find
	    # the next larger one:

	    set m inf
	    foreach ch $in {
		if {$ch >= $n && $ch < $m} {
		    set m $ch
		}
	    }

	    # Increase delta enough to advance the decoder's <n,i> state to
	    # <m,0>, but guard against overflow:

	    if {$m-$n > (0xFFFFFFFF-$delta)/($h+1)} {
		throw {PUNYCODE OVERFLOW} "overflow in delta computation"
	    }
	    incr delta [expr {($m-$n) * ($h+1)}]
	    set n $m

	    foreach ch $in {
		if {$ch < $n && ([incr delta] & 0xFFFFFFFF) == 0} {
		    throw {PUNYCODE OVERFLOW} "overflow in delta computation"
		}

		if {$ch != $n} {
		    continue
		}

		# Represent delta as a generalized variable-length integer:

		for {set q $delta; set k $base} true {incr k $base} {
		    set t [expr {min(max($k-$bias, $tmin), $tmax)}]
		    if {$q < $t} {
			break
		    }
		    append output \
			[lindex $digits [expr {$t + ($q-$t)%($base-$t)}]]
		    set q [expr {($q-$t) / ($base-$t)}]
		}

		append output [lindex $digits $q]
		set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]]
		set delta 0
		incr h
	    }
	}

	return $output
    }

    # Main punycode decode function
    proc punydecode {string {case ""}} {
	variable tmin
	variable tmax
	variable base
	variable initial_n
	variable initial_bias
	variable max_codepoint

	if {![string is boolean $case]} {
	    return -code error "\"$case\" must be boolean"
	}

	# Initialize the state:

	set n $initial_n
	set i 0
	set first 1
	set bias $initial_bias

	# Split the string into the "real" ASCII characters and the ones to
	# feed into the main decoder. Note that we don't need to check the
	# result of [regexp] because that RE will technically match any string
	# at all.

	regexp {^(?:(.*)-)?([^-]*)$} $string -> pre post
	if {[string is true -strict $case]} {
	    set pre [string toupper $pre]
	} elseif {[string is false -strict $case]} {
	    set pre [string tolower $pre]
	}
	set output [split $pre ""]
	set out [llength $output]

	# Main decoding loop:

	for {set in 0} {$in < [string length $post]} {incr in} {
	    # Decode a generalized variable-length integer into delta, which
	    # gets added to i. The overflow checking is easier if we increase
	    # i as we go, then subtract off its starting value at the end to
	    # obtain delta.

	    for {set oldi $i; set w 1; set k $base} 1 {incr in} {
		if {[set ch [string index $post $in]] eq ""} {
		    throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data"
		}
		if {[string match -nocase {[a-z]} $ch]} {
		    scan [string toupper $ch] %c digit
		    incr digit -65
		} elseif {[string match {[0-9]} $ch]} {
		    set digit [expr {$ch + 26}]
		} else {
		    throw {PUNYCODE BAD_INPUT CHAR} \
			    "bad decode character \"$ch\""
		}
		incr i [expr {$digit * $w}]
		set t [expr {min(max($tmin, $k-$bias), $tmax)}]
		if {$digit < $t} {
		    set bias [adapt [expr {$i-$oldi}] $first [incr out]]
		    set first 0
		    break
		}
		if {[set w [expr {$w * ($base - $t)}]] > 0x7FFFFFFF} {
		    throw {PUNYCODE OVERFLOW} \
			"excessively large integer computed in digit decode"
		}
		incr k $base
	    }

	    # i was supposed to wrap around from out+1 to 0, incrementing n
	    # each time, so we'll fix that now:

	    if {[incr n [expr {$i / $out}]] > 0x7FFFFFFF} {
		throw {PUNYCODE OVERFLOW} \
		    "excessively large integer computed in character choice"
	    } elseif {$n > $max_codepoint} {
		if {$n >= 0x00D800 && $n < 0x00E000} {
		    # Bare surrogate?!
		    throw {PUNYCODE NON_BMP} \
			[format "unsupported character U+%06x" $n]
		}
		throw {PUNYCODE NON_UNICODE} "bad codepoint $n"
	    }
	    set i [expr {$i % $out}]

	    # Insert n at position i of the output:

	    set output [linsert $output $i [format "%c" $n]]
	    incr i
	}

	return [join $output ""]
    }
}

package provide tcl::idna 1.0.1

# Local variables:
# mode: tcl
# fill-column: 78
# End:

Deleted library/cookiejar/pkgIndex.tcl.

1
2
3



-
-
-
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded cookiejar 0.2.0 [list source [file join $dir cookiejar.tcl]]
package ifneeded tcl::idna 1.0.1 [list source [file join $dir idna.tcl]]

Changes to library/dde/pkgIndex.tcl.

1

2

3





1
2
3

4
5
6
7
-
+

+
-
+
+
+
+
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] dde]
    package ifneeded dde 1.4.3 [list load [file join $dir tcldde14g.dll] Dde]
} else {
    package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll] Dde]
}

Added library/encoding/cns11643.enc.

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Encoding file: cns11643, double-byte
D
2134 0 93
21
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00004E284E364E3F4E854E054E04518251965338536953B64E2A4E874E4951E2
4E464E8F4EBC4EBE516651E35204529C53B95902590A5B805DDB5E7A5E7F5EF4
5F505F515F61961D4E3C4E634E624EA351854EC54ECF4ECE4ECC518451865722
572351E45205529E529D52FD5300533A5C735346535D538653B7620953CC6C15
53CE57216C3F5E005F0C623762386534653565E04F0E738D4E974EE04F144EF1
4EE74EF74EE64F1D4F024F054F2256D8518B518C519951E55213520B52A60000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
22
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000053225304530353075407531E535F536D538953BA53D0598053F653F753F9
597E53F4597F5B565724590459185932593059345DDF59755E845B825BF95C14
5FD55FD45FCF625C625E626462615E815E835F0D5F52625A5FCA5FC7623965EE
624F65E7672F6B7A6C39673F673C6C376C446C45738C75927676909390926C4B
6C4C4E214E204E224E684E894E984EF94EEF7F5182784EF84F064F034EFC4EEE
4F1690994F284F1C4F074F1A4EFA4F17514A962351724F3B51B451B351B20000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
23
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00004F6451E84F675214520F5215521852A84F33534B534F518F5350521C538B
522153BE52AE53D2541653FF538E540054305405541354155445541956E35735
57365731573258EE59054E545447593656E756E55741597A574C5986574B5752
5B865F535C1859985C3D5C78598E59A25990598F5C8059A15E085B925C285C2A
5C8D5EF55F0E5C8B5C895C925FD35FDA5C935FDB5DE0620F625D625F62676257
9F505E8D65EB65EA5F7867375FD2673267366B226BCE5FEE6C586C516C770000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
24
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006C3C5FFA6C5A5FF76C53706F7072706E6283628C707372B172B26287738F
627B627A6270793C6288808D808E6272827B65F08D718FB99096909A67454E24
4E7167554E9C4F454F4A4F394F37674B4F324F426C1A4F444F4B6C6B4F404F35
4F3151516C6F5150514E6C6D6C87519D6C9C51B551B851EC522352275226521F
522B522052B452B372C65325533B537473957397739373947392544D75397594
543A7681793D5444544C5423541A5432544B5421828F54345449545054220000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
25
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000543F5451545A542F8FC956E956F256F356EF56ED56EC56E6574896285744
573F573C575357564F85575F5743575857574F744F894F8457464F4C573D4F6A
57425754575558F158F258F0590B9EA656F1593D4F955994598C519E599C51BE
5235599F5233599B52315989599A530B658853925B8D54875BFE5BFF5BFD5C2B
54885C845C8E5C9C5465546C5C855DF55E09546F54615E0B54985E925E905F03
56F75F1E5F6357725FE75FFE5FE65FDC5FCE57805FFC5FDF5FEC5FF657620000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
26
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00005FF25FF05FF95945621359BA59CF623B623C628259C159B659BC6278628B
59B1629E62A5629B629C6299628D6285629D62755C445C475CAE65F65CA05CB5
5CAF66F5675B5C9F675467525CA267586744674A67615CB66C7F6C916C9E5E14
6C6E6C7C6C9F6C755F246C566CA26C795F7D6CA15FE56CAA6CA0601970797077
707E600A7075707B7264601E72BB72BC72C772B972BE72B66011600C7398601C
6214623D62AD7593768062BE768376C076C162AE62B377F477F562A97ACC0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
27
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007ACD7CFA809F80918097809466048286828C65FB8295660B866C66058FB5
8FBE8FC766F68FC190A990A4678E6792677690A896279626962B963396349629
4E3D679F4E9D4F934F8A677D67814F6D4F8E4FA04FA24FA14F9F4FA36C1D4F72
6CEC4F8C51566CD96CB651906CAD6CE76CB751ED51FE522F6CC3523C52345239
52B952B552BF53556C9D5376537A53936D3053C153C253D554856CCF545F5493
548954799EFE548F5469546D70915494546A548A708356FD56FB56F872D80000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
28
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000056FC56F6576557815763576772D1576E5778577F73A673A258F3594B594C
74DD74E8753F59AD753E59C4759859C259B076F176F076F577F859BF77F959C9
59B859AC7942793F79C559B759D77AFB5B607CFD5B965B9E5B945B9F5B9D80B5
5C005C1982A082C05C495C4A82985CBB5CC182A782AE82BC5CB95C9E5CB45CBA
5DF65E135E125E7782C35E9882A25E995E9D5EF8866E5EF98FD25F065F218FCD
5F255F558FD790B290B45F845F8360306007963D6036963A96434FCD5FE90000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
29
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000603D60084FC94FCB62BA62B24FDC62B762E462A74FDB4FC74FD662D562E1
62DD62A662C162C562C062DF62E062DE53976589539965A665BA54A165FF54A5
66176618660165FE54AE670C54B6676B67966782678A54BC67A354BE67A2678F
54B067F967806B266B276B686B69579D6B816BB46BD1578F57996C1C579A5795
58F4590D59536C976C6C6CDF5A006CEA59DD6CE46CD86CB26CCE6CC859F2708B
70887090708F59F570877089708D70815BA8708C5CD05CD872405CD75CCB0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
2A
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007265726672685CC95CC772CD72D372DB5CD472CF73A773A3739E5CDF73AF
5DF95E2173AA739C5E2075427544753B75415E9B759B759E5F0779C479C379C6
6037603979C7607279CA604560537ACF7C767C747CFF7CFC6042605F7F5980A8
6058606680B0624280B362CF80A480B680A780AC630380A65367820E82C4833E
829C63006313631462FA631582AA62F082C9654365AA82A682B2662166326635
8FCC8FD98FCA8FD88FCF90B7661D90AD90B99637670F9641963E96B697510000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
2B
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000097634E574E794EB24EB04EAF4EB14FD24FD567E44FBE4FB84FB04FB14FC8
67F667EE4FC64FCC4FE54FE34FB4516A67B2519F67C651C167CC51C251C35245
524867C967CA524F67EA67CB52C552CA52C453275358537D6BE053DD53DC53DA
53D954B96D1F54D054B454CA6D0A54A354DA54A46D1954B2549E549F54B56D1D
6D4254CD6D1854CC6D03570057AC5791578E578D579257A1579057A657A8709F
579C579657A770A170B470B570A958F572495909590872705952726E72CA0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
2C
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000059DF72E859EB59EF59F059D55A0D5A0459F95A0259F859E259D959E75B6A
73B473EB5BAB73C75C1B5C2F73C6663C73CB74EC74EE5CD15CDC5CE65CE15CCD
76795CE25CDD5CE55DFB5DFA5E1E76F75EA176FA77E75EFC5EFB5F2F78127805
5F66780F780E7809605C7813604E6051794B794560236031607C605279D66060
604A60617AD162187B017C7A7C787C797C7F7C807C81631F631762EA63216304
63057FBE6531654465408014654265BE80C76629661B80C86623662C661A0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
2D
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006630663B661E6637663880C9670E80D780E667E867D6822167C767BC6852
67BF67D567FE836367FB833A67B168016805680067D782F26B2A6B6B82FB82F6
82F082EA6BE182E082FA6D236CFF6D146D056D136D066D21884E6D156CAF6CF4
6D026D458A076D268FE36D448FEE6D2470A590BD70A390D570A270BB70A070AA
90C891D470A870B670B270A79653964A70B9722E5005723C5013726D5030501B
72E772ED503372EC72E572E24FF773C473BD73CF73C973C173D0503173CE0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
2E
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000074ED74EB519374EF754975507546754A5261754D75A6525E525F525575A8
52CD530E76C776FF54E276FD77E6780A54F37804780B78075504781578085511
79D379D479D079D77A7C54F854E07A7D7A837A8257017AD47AD57AD37AD07AD2
7AFE7AFC7C777C7C7C7B57B657BF57C757D057B957C1590E594A7F8F80D35A2D
80CB80D25A0F810980E280DF80C65B6C822482F782D882DD5C565C5482F882FC
5CEE5CF182E95D0082EE5E2982D0830E82E2830B82FD517986765F6786780000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
2F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000605A60678675867D6088884288666081898C8A0560958A0660978C9F609C
8FF18FE78FE98FEF90C290BC632C90C690C06336634390CD90C9634B90C4633C
958163419CEC50324FF9501D4FFF50044FF05003635150024FFC4FF250245008
5036502E65C35010503850394FFD50564FFB51A351A651A1681A684951C751C9
5260526452595265526752575263682B5253682F52CF684452CE52D052D152CC
68266828682E550D54F46825551354EF54F554F9550255006B6D808255180000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
30
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000054F054F66BE86BE355196BE7570557C96D6357B757CD6D0D6D616D9257BE
57BB6D6D57DB57C857C457C557D157CA57C06D676D605A215A2A6D7C5A1D6D82
5A0B6D2F6D686D8B6D7E5A226D846D165A246D7B5A145A316D905A2F5A1A5A12
70DD70CB5A2670E270D75BBC5BBB5BB75C055C065C525C5370C770DA5CFA5CEB
72425CF35CF55CE95CEF72FA5E2A5E305E2E5E2C5E2F5EAF5EA973D95EFD5F32
5F8E5F935F8F604F609973D2607E73D46074604B6073607573E874DE60560000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
31
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000060A9608B60A6755B609360AE609E60A7624575C075BF632E75BA63526330
635B771B6319631B77126331635D6337633563537722635C633F654B78227835
658B7828659A66506646664E6640782A664B6648795B66606644664D79526837
682479EC79E0681B683679EA682C681968566847683E681E7A8B681568226827
685968586855683068236B2E6B2B6B306B6C7B096B8B7C846BE96BEA6BE56D6B
7C8D7C856D736D577D117D0E6D5D6D566D8F6D5B6D1C6D9A6D9B6D997F610000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
32
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006D816D717F5D7F5B6D726D5C6D9670C470DB70CC70D070E370DF80F270D6
70EE70D580FB81008201822F727A833372F573028319835173E273EC73D573F9
73DF73E683228342834E831B73E473E174F3834D831683248320755675557558
7557755E75C38353831E75B4834B75B18348865376CB76CC772A86967716770F
869E8687773F772B770E772486857721771877DD86A7869578247836869D7958
79598843796279DA79D9887679E179E579E879DB886F79E279F08874887C0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
33
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008A128C477ADA7ADD8CA47ADB7ADC8D788DB57B0D7B0B7B147C8E7C868FF5
7C877C837C8B90048FFC8FF690D67D2490D990DA90E37D257F627F937F997F97
90DC90E47FC47FC6800A91D591E28040803C803B80F680FF80EE810481038107
506A506180F750605053822D505D82278229831F8357505B504A506250158321
505F506983188358506450465040506E50738684869F869B868986A68692868F
86A0884F8878887A886E887B88848873555055348A0D8A0B8A19553655350000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
34
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000553055525545550C8FF990099008553990DE9151553B554091DB91DF91DE
91D691E095859660965957F4965657ED57FD96BD57F8580B5042505958075044
50665052505450715050507B507C505857E758015079506C507851A851D151CF
5268527652D45A5553A053C45A385558554C55685A5F55495A6C5A53555D5529
5A43555455535A44555A5A48553A553F552B57EA5A4C57EF5A695A4757DD57FE
5A4257DE57E65B6E57E857FF580358F768A6591F5D1A595B595D595E5D0D0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
35
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00005D265A2B5D0F5A3B5D125D235A615A3A5A6E5A4B5A6B5EB45EB95A455A4E
5A685A3D5A715A3F5A6F5A7560905A735A2C5A595A545A4F5A6360CF60E45BC8
60DD5BC360B15C5B5C6160CA5D215D0A5D0960C05D2C5D08638A63825D2A5D15
639E5D105D1363975D2F5D18636F5DE35E395E355E3A5E32639C636D63AE637C
5EBB5EBA5F345F39638563816391638D6098655360D066656661665B60D760AA
666260A160A4688760EE689C60E7686E68AE60DE6956686F637E638B68A90000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
36
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000687563796386639368776373636A686B636C68AA637F687163B263BA6896
688B6366637468A4655A687B654E654D658D658E65AD6B3365C765CA6B9165C9
6B8D65E366576C2A66636667671A671967166DAC6DE9689E68B6689868736E00
689A688E68B768DB68A5686C68C168846DDB6DF46895687A68996DF068B868B9
68706DCF6B356DD06B906BBB6BED6DD76DCD6DE36DC16DC36DCE70F771176DAD
6E0470F06DB970F36DE770FC6E086E0671136E0A6DB070F66DF86E0C710E0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
37
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006DB1727B6E026E076E096E016E176DFF6E12730A730871037107710170F5
70F1710870F2710F740170FE7407740073FA731A7310730E740273F374087564
73FB75CE75D275CF751B752375617568768F756775D37739772F769077317732
76D576D776D67730773B7726784877407849771E784A784C782678477850784B
7851784F78427846796B796E796C79F279F879F179F579F379F97A907B357B3B
7A9A7A937A917AE17B247B337B217B1C7B167B177B367B1F7B2F7C937C990000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
38
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007C9A7C9C7C947D497C967D347D377D3D7D2D7D367D4C7D457D2C7D487D41
7D477F3B7D3F7D4A7D3B7D288008801A7F9C801D7F9B8049804580447C9B7FD1
7FC7812A812E801F801E81318047811A8134811781258119811B831D83718384
8380837283A18127837983918211839F83AD823A8234832382748385839C83B7
8658865A8373865786B2838F86AE8395839983758845889C889488A3888F88A5
88A988A6888A88A0889089928991899483B08A268A328A2883AE83768A1C0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
39
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000086568A2B8A2086C28A2986C586BA86B08A218C3A86B38C5B8C588C7C86BB
8CA68CAE8CAD8D6588528D7E88958D7C8D7F8D7A8DBD889188A18DC08DBB8EAD
8EAF8ED6889788A488AC888C88938ED9898289D69012900E90258A27901390EE
8C3990AB90F78C5D9159915491F291F091E591F68DC28DB995878DC1965A8EDE
8EDD966E8ED78EE08EE19679900B98E198E6900C9EC49ED24E8090F04E81508F
50975088508990EC90E950815160915A91535E4251D391F491F151D251D60000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
3A
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000527391F9527091EB91F791E853A853A653C5559755DE966D966B559655B4
96BF55859804559B55A0509B555950945586508B50A355AF557A508E509D5068
559E509255A9570F570E581A5312581F53A4583C5818583E582655AD583A5645
5822559358FB5963596455815AA85AA35A825A885AA15A855A9855955A99558E
5A895A815A965A80581E58275A91582857F5584858255ACF581B5833583F5836
582E58395A875AA0582C5A7959615A865AAB5AAA5AA45A8D5A7E5A785BD50000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
3B
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00005A7C5AA55AAC5C1E5C5F5C5E5D445D3E5A975D485D1C5AA95D5B5D4D5A8C
5A9C5D575A935D535D4F5BCD5D3B5D465BD15BCA5E465E475C305E485EC05EBD
5EBF5D4B5F115D355F3E5F3B5D555F3A5D3A5D525D3D5FA75D5960EA5D396107
6122610C5D325D3660B360D660D25E4160E360E560E95FAB60C9611160FD60E2
60CE611E61206121621E611663E263DE63E660F860FC60FE60C163F8611863FE
63C163BF63F763D1655F6560656163B063CE65D163E863EF667D666B667F0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
3C
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000063CA63E066736681666D6669646163DF671E68ED63DC63C463D863D36903
63C768FE68E5691E690263D763D9690968CA690065646901691868E268CF659D
692E68C568FF65D2691C68C3667B6B6F66716B6E666A6BBE67016BF46C2D6904
6DB66E756E1E68EA6E18690F6E4868F76E4F68E46E426E6A6E706DFE68E16907
6E6D69086E7B6E7E6E5968EF6E5769146E806E5068FD6E296E766E2A6E4C712A
68CE7135712C7137711D68F468D1713868D47134712B7133712771246B3B0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
3D
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000712D7232728372827287730673247338732A732C732B6DFC732F73287417
6E496E88741974386E45741F7414743C73F7741C74157418743974F975246E51
6E3B6E03756E756D7571758E6E6175E56E286E606E716E6B769476B36E3076D9
6E657748774977436E776E55774277DF6E66786378766E5A785F786679667971
712E713179767984797579FF7A0771287A0E7A09724B725A7288728972867285
7AE77AE27B55733073227B437B577B6C7B427B5373267B417335730C7CA70000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
3E
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007CA07CA67CA47D74741A7D59742D7D607D577D6C7D7E7D6474207D5A7D5D
752F756F756C7D767D4D7D7575E67FD37FD675E475D78060804E8145813B7747
814881428149814081148141774C81EF81F68203786483ED785C83DA841883D2
8408787084007868785E786284178346841483D38405841F8402841683CD83E6
7AE6865D86D586E17B447B487B4C7B4E86EE884788467CA27C9E88BB7CA188BF
88B47D6388B57D56899A8A437D4F7D6D8A5A7D6B7D527D548A358A388A420000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
3F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008A498A5D8A4B8A3D7F667FA27FA07FA18C608C5E8C7F8C7E8C8380D48CB1
8D878152814F8D888D83814D813A8D868D8B8D828DCA8DD28204823C8DD48DC9
8EB0833B83CF83F98EF28EE48EF38EEA83E78EFD83FC8F9D902B902A83C89028
9029902C840183DD903A90309037903B83CB910A83D683F583C991FE922083DE
920B84069218922283D5921B920883D1920E9213839A83C3959583EE83C483FB
968C967B967F968183FE968286E286E686D386E386DA96EE96ED86EB96EC0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
40
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000975F976F86D7976D86D188488856885588BA88D798F088B888C088BE9AA9
88BC88B79AE04EB7890188C950CC50BC899750AA50B989DB50AB50C350CD517E
527E52798A588A4452E152E052E7538053AB53AA53A953E055EA8C8055D78CBE
8CB055C157158D84586C8D89585C58505861586A5869585658605866585F5923
596659688EEF8EF75ACE8EF95AC55AC38EE58EF55AD08EE88EF68EEB8EF18EEC
8EF45B745B765BDC5BD75BDA5BDB91045C205D6D5D6690F95D645D6E91000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
41
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00005D605F425F5A5F6E9164915F6130613A612A614361196131921A613D920F
920C92006408643264389206643192276419921C6411921992176429641D957B
958D958C643C96876446644796899683643A640796C8656B96F16570656D9770
65E4669398A998EB9CE69EF9668F4E844EB6669250BF668E50AE694650CA50B4
50C850C250B050C150BA693150CB50C9693E50B8697C694352786973527C6955
55DB55CC6985694D69506947696769366964696155BF697D6B446B406B710000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
42
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006B736B9C55C855F255CD6BC155C26BFA6C316C325864584F6EB86EA8586F
6E916EBB585D6E9A5865585B6EA9586358716EB56E6C6EE85ACB6EDD6EDA6EE6
6EAC5AB05ABF5AC86ED96EE36EE96EDB5ACA716F5AB65ACD71485A90714A716B
5BD9714F715771745D635D4A5D6571457151716D5D6872517250724E5E4F7341
5E4A732E73465EC574275EC674487453743D5FAF745D74566149741E74477443
74587449612E744C7445743E61297501751E91686223757A75EE760276970000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
43
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007698641064126409775D77647753775878827890788A6439787A787D6423
788B787864306428788D788878927881797E798364256427640B7980641B642E
64217A0F656F65927A1D66867AA17AA466907AE97AEA66997B627B6B67207B5E
695F7B79694E69627B6F7B686945696A7CAE6942695769597CB069487D906935
7D8A69337D8B7D997D9569787D877D787D977D897D986976695869417FA3694C
693B694B7FDD8057694F8163816A816C692F697B693C815D81756B43815F0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
44
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006B48817D816D6BFB6BFC8241844F84846E9B847F6EC88448842A847B8472
8464842E845C84536EC6844184C86EC184628480843E848384716EA6844A8455
84586EC36EDC6ED886FC86FD87156E8D871686FF6EBF6EB36ED0885888CF88E0
6EA371477154715289E78A6A8A80715D8A6F8A6571788A788A7D8A8871587143
8A648A7E715F8A678C638C88714D8CCD724F8CC9728C8DED7290728E733C7342
733B733A73408EB1734974448F048F9E8FA090439046904890459040904C0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
45
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000074427446910C9113911574FF916B9167925D9255923569839259922F923C
928F925C926A9262925F926B926E923B92449241959A7699959976DD7755775F
968F77529696775A7769776796F496FC776D9755788797797894788F788497EE
97F57886980B788398F37899788098F798FF98F5798298EC98F17A117A18999A
7A129AE29B3D9B5D9CE87A1B9CEB9CEF9CEE9E819F1450D050D950DC50D87B69
50E150EB7B737B7150F450E250DE7B767B637CB251F47CAF7D887D8652ED0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
46
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000052EA7D7F53327D7A53AE53B07D8355FB5603560B7D8456077D9255F87F6B
5628561E7F6C5618561156515605571758928164588C817758785884587358AD
58975895587758725896588D59108161596C82495AE782405AE4824584F15AEF
5626847684795AF05D7B84655D83844084865D8B5D8C844D5D785E5284598474
5ED05ECF85075FB35FB4843A8434847A617B8478616F6181613C614261386133
844261606169617D6186622C62288452644C84C56457647C8447843664550000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
47
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000064626471646A6456643B6481846E644F647E646486F7870C86FA86D686F5
657186F8870E66A5669A669C870D66A688D666A4698F69C569C8699269B288CC
88D0898569E369C069D669D1699F69A269D289DC89E68A7669E169D5699D8A3F
8A7769988A846B746BA18A816EF06EF38C3C8C4B6F1B6F0C6F1D6F346F286F17
8C856F446F426F046F116EFA6F4A7191718E8D93718B718D717F718C717E717C
71838DEE71888DE98DE372948DE773557353734F7354746C7465746674610000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
48
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000746B746874768F0B7460903F74747506760E91107607910F911176B99114
76B776E2916E7774777777767775923A777877719265777A715B777B78A678AE
78B8926C924F926078B178AF923679897987923192547A2992507A2A924E7A2D
7A2C92567A32959F7AEC7AF07B817B9E7B8396917B9296CE7BA37B9F7B9396F5
7B867CB87CB79772980F980D980E98AC7DC87DB699AF7DD199B07DA87DAB9AAB
7DB37DCD9CED7DCF7DA49EFD50E67F417F6F7F7150F350DB50EA50DD50E40000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
49
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000050D38023805B50EF8061805F818152805281818482135330824A824C5615
560C561284BD8495561C849284C35602849684A584B584B384A384E484D884D5
589884B784AD84DA84938736587A58875891873D872B87478739587B8745871D
58FE88FF88EA5AEE88F55AD5890088ED890388E95AF35AE289EA5ADB8A9B8A8E
8AA25AD98A9C8A948A908AA98AAC5C638A9F5D805D7D8A9D5D7A8C675D775D8A
8CD08CD68CD48D988D9A8D975D7F5E585E598E0B8E088E018EB48EB35EDC0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
4A
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008FA18FA25ED2905A5F449061905F5FB6612C9125917B9176917C61739289
92F692B192AD929292819284617A92AE9290929E616A6161615695A295A7622B
642B644D645B645D96A0969D969F96D0647D96D1646664A6975964829764645C
644B64539819645098149815981A646B645964656477990665A098F89901669F
99BE99BC99B799B699C069C999B869CE699669B099C469BC99BF69999ADA9AE4
9AE99AE89AEA9AE569BF9B2669BD69A49B4069B969CA699A69CF69B369930000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
4B
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000069AA9EBD699E69D969976990510E69B550F769C650FC510D510151DA51D9
51DB5286528E52EE533353B16EF15647562D56546F37564B5652563156445656
5650562B6F18564D5637564F58A258B76F7358B26EEE58AA58B558B06F3C58B4
58A458A76F0E59265AFE6EFD5B046F395AFC6EFC5B065B0A5AFA5B0D5B005B0E
7187719071895D9171855D8F5D905D985DA45D9B5DA35D965DE45E5A72957293
5E5E734D5FB86157615C61A661956188747261A3618F75006164750361590000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
4C
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006178761661856187619E7611760A6198619C7781777C622F6480649B648E
648D649464C678B264A8648378AD64B9648664B464AF649178A064AA64A164A7
66B666B3798B66BC66AC799466AD6A0E79886A1C6A1A7A2B7A4A6A0B7A2F69EF
6A0C69F06A227AAC69D87B886A1269FA7B916A2A7B966A107B8C7B9B6A2969F9
69EA6A2C6A247BA469E96B526B4F6B537CBA7DA76F106F656F757DAA7DC17DC0
7DC56FD07DCE6F5C6F3D6F717DCC6F916F0B6F796F816F8F7DA66F596F740000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
4D
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007DA171AE7F7371A371AD7FE57FDE71AB71A671A2818952F2725772557299
734B747A8215849784A4748C748484BA84CE74827493747B84AB750984B484C1
84CD84AA849A84B1778A849D779084BB78C678D378C078D278C778C284AF799F
799D799E84B67A4184A07A387A3A7A4284DB84B07A3E7AB07BAE7BB38728876B
7BBF872E871E7BCD87197BB28743872C8741873E8746872087327CC47CCD7CC2
7CC67CC37CC97CC787427DF887277DED7DE2871A873087117DDC7E027E010000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
4E
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000088F27DD688FE7DE47DFE88F67E007DFC7DFD88EB7DF57DFF899F7DEB7DE5
7F787FAE7FE78A998065806A80668068806B819481A18192819681938D968E09
85018DFF84F88DFD84F58E0385048E068E058DFE8E00851B85038533853484ED
9123911C853591228505911D911A91249121877D917A91729179877192A5885C
88E6890F891B92A089A989A589EE8AB1929A8ACC8ACE92978AB792A38AB58AE9
8AB492958AB38AC18AAF8ACA8AD09286928C92998C8E927E92878CE98CDB0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
4F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000928B8CEB8DA496A18DA28D9D977D977A977E97838E2A8E28977B97848EB8
8EB68EB98EB78F228F2B8F278F198FA499078FB3999C9071906A99BB99BA9188
918C92BF92B892BE92DC92E59B3F9B6092D492D69CF192DA92ED92F392DB5103
92B992E292EB95AF50F695B295B3510C50FD510A96A396A552F152EF56485642
970A563597879789978C97EF982A98225640981F563D9919563E99CA99DA563A
571A58AB99DE99C899E058A39AB69AB558A59AF458FF9B6B9B699B729B630000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
50
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00005AF69D0D5AF89D019D0C5B019CF85B055B0F9CFE9D029E845D9F9EAB9EAA
511D51165DA0512B511E511B5290529453145E605E5C56675EDB567B5EE1565F
5661618B6183617961B161B061A2618958C358CA58BB58C058C459015B1F5B18
5B115B1561B35B125B1C64705B225B795DA664975DB35DAB5EEA648A5F5B64A3
649F61B761CE61B961BD61CF61C06199619765B361BB61D061C4623166B764D3
64C06A006A066A1769E564DC64D164C869E464D566C369EC69E266BF66C50000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
51
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000069FE66CD66C167066A1467246A636A426A5269E66A436A3369FC6A6C6A57
6A046A4C6A6E6A0F69F66A266A0769F46A376B516A716A4A6A366BA66A536C00
6A456A706F416F266A5C6B586B576F926F8D6F896F8C6F626F4F6FBB6F5A6F96
6FBE6F6C6F826F556FB56FD36F9F6F576FB76FF571B76F0071BB6F6B71D16F67
71BA6F5371B671CC6F7F6F9571D3749B6F6A6F7B749674A2749D750A750E719A
7581762C76377636763B71A476A171AA719C779871B37796729A735873520000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
52
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000078D678EB736078DC735B79A579A998347A537A4574897A4F74867ABD7ABB
7AF17488747C7BEC7BED7507757E7CD3761E7CE1761D7E197623761A76287E27
7E26769D769E806E81AF778F778981AD78CD81AA821878CC78D178CE78D4856F
854C78C48542799A855C8570855F79A2855A854B853F878A7AB4878B87A1878E
7BBE7BAC8799885E885F892489A78AEA8AFD8AF98AE38AE57DDB7DEA8AEC7DD7
7DE17E037DFA8CF27DF68CEF7DF08DA67DDF7F767FAC8E3B8E437FED8E320000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
53
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008F318F307FE68F2D8F3C8FA78FA5819F819E819591379195918E82169196
82539345930A824E825192FD9317931C930793319332932C9330930393058527
95C284FB95B884FA95C1850C84F4852A96AB96B784F784EB97159714851284EA
970C971784FE9793851D97D2850284FD983698319833983C982E983A84F0983D
84F998B5992299239920991C991D866299A0876399EF99E899EB877387588754
99E199E68761875A9AF89AF5876D876A9B839B949B84875D9B8B9B8F877A0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
54
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009B8C875C9B89874F9B8E8775876287679D249D0F89059D139D0A890B8917
891889199D2A9D1A89119D279D169D2189A49E859EAC9EC69EC59ED79F538AB8
5128512751DF8AD5533553B38ABE568A567D56898AC358CD58D08AD95B2B5B33
5B295B355B315B375C365DBE8CDD5DB98DA05DBB8DA161E261DB61DD61DC61DA
8E2E61D98E1B8E1664DF8E198E2664E18E1464EE8E1865B566D466D58E1A66D0
66D166CE66D78F208F236A7D6A8A90736AA7906F6A996A826A88912B91290000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
55
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006A8691326A986A9D918591866A8F91816AAA91846B5D92D06C0A92C46FD7
6FD66FE592CF92F192DF6FD96FDA6FEA92DD6FF692EF92C271E392CA71E992CE
71EB71EF71F371EA92E092DE92E792D192D3737192E174AE92C674B3957C74AC
95AB95AE75837645764E764476A376A577A677A4978A77A977AF97D097CF981E
78F078F878F198287A49981B982798B27AC27AF27AF37BFA99167BF67BFC7C18
7C087C1299D399D47CDB7CDA99D699D899CB7E2C7E4D9AB39AEC7F467FF60000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
56
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000802B807481B881C89B679B749B71859285939B75857F85AB85979B6C9CFC
85AC9CFD9CFF9CF787CE9D0087CD9CFB9D0887C187B187C79ED389409F10893F
893951178943511151DE533489AB56708B1F8B098B0C566656638C4056728C96
56778CF68CF758C88E468E4F58BF58BA58C28F3D8F4193669378935D93699374
937D936E93729373936293489353935F93685DB1937F936B5DB595C45DAE96AF
96AD96B25DAD5DAF971A971B5E685E665E6F5EE9979B979F5EE85EE55F4B0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
57
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00005FBC5FBB619D61A86196984061B4984761C198B761BA61BF61B8618C64D7
99A264D064CF9A0099F3648964C399F564F364D99ABD9B009B0265A29B349B49
9B9F66CA9BA39BCD9B999B9D66BA66CC9D396A349D446A496A679D356A686A3E
9EAF6A6D512F6A5B6A519F8E6A5A569F569B569E5696569456A06A4F5B3B6A6F
6A695B3A5DC15F4D5F5D61F36A4D6A4E6A466B5564F664E564EA64E765056BC8
64F96C046C036C066AAB6AED6AB26AB06AB56ABE6AC16AC86FC46AC06ABC0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
58
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006AB16AC46ABF6FA56FAE700870036FFD7010700270136FA271FA720074B9
74BC6FB2765B7651764F76EB77B871D677B977C177C077BE790B71C77907790A
790871BC790D7906791579AF729E736973667AF5736C73657C2E736A7C1B749A
7C1A7C24749274957CE67CE37580762F7E5D7E4F7E667E5B7F477FB476327630
76BB7FFA802E779D77A181CE779B77A282197795779985CC85B278E985BB85C1
78DE78E378DB87E987EE87F087D6880E87DA8948894A894E894D89B189B00000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
59
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000089B37AB78B388B327BE78B2D7BD58B347BDA8B298C747BD47BEA8D037BDC
7BEB8DA98E587CD27CD48EBF8EC18F4A8FAC7E219089913D913C91A993A07E0E
93907E159393938B93AD93BB93B87E0D7E14939C95D895D77F7B7F7C7F7A975D
97A997DA8029806C81B181A6985481B99855984B81B0983F98B981B281B781A7
81F29938993699408556993B993999A4855385619A089A0C85469A1085419B07
85449BD285479BC29BBB9BCC9BCB854E856E9D4D9D639D4E85609D509D550000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
5A
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000855D9D5E85659E909EB29EB186649ECA9F029F279F26879356AF58E058DC
87965B39877987875B7C5BF3879087915C6B5DC4650B6508650A8789891E65DC
8930892D66E166DF6ACE6AD46AE36AD76AE2892C891F89F18AE06AD86AD56AD2
8AF58ADD701E702C70256FF37204720872158AE874C474C974C774C876A977C6
77C57918791A79208CF37A667A647A6A8DA78E338E3E8E388E408E457C357C34
8E3D8E417E6C8E3F7E6E7E718F2E81D481D6821A82628265827685DB85D60000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
5B
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000908685E79133913585F4919387FD87D58807918F880F87F89308931F8987
930F89B589F5933C8B3F8B438B4C93018D0B8E6B8E688E708E758E7792FA8EC3
92F993E993EA93CB93C593C6932993ED93D3932A93E5930C930B93DB93EB93E0
93C1931695BC95DD95BE95B995BA95B695BF95B595BD96A996D497B297B497B1
97B597F2979497F097F89856982F98329924994499279A269A1F9A189A219A17
99E49B0999E399EA9BC59BDF9AB99BE39AB49BE99BEE9AFA9AF99D669D7A0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
5C
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009B809D6E9D919D839D769D7E9D6D9B939E959EE39B7A9B959F039F049D25
9F179D2051369D1453369D1D5B429D229D105B445B465B7E5DCA5DC85DCC5EF0
9ED5658566E566E79F3D512651256AF451246AE9512952F45693568C568D703D
56847036567E7216567F7212720F72177211720B5B2D5B2574CD74D074CC74CE
74D15B2F75895B7B7A6F7C4B7C445E6C5E6A5FBE61C361B57E7F8B7161E0802F
807A807B807C64EF64E964E385FC861086026581658085EE860366D2860D0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
5D
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000086138608860F881888126A9B6AA18967896589BB8B698B626A838B6E6AA4
8B616A7F8B648B4D8C516A8C6A928E838EC66C09941F6FA99404941794089405
6FED93F3941E9402941A941B9427941C71E196B571E871F2973371F097349731
97B897BA749797FC74AB749098C374AD994D74A59A2F7510751175129AC97584
9AC89AC49B2A9B389B5076E99C0A9BFB9C049BFC9BFE77B477B177A89C029BF6
9C1B9BF99C159C109BFF9C009C0C78F978FE9D959DA579A87A5C7A5B7A560000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
5E
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009E989EC17A5A9F5A516456BB7C0558E65B495BF77BFF7BFB5DD07BF45FC2
7BF365117C096AFF6AFE6AFD7BFD6B017BF07BF1704B704D704774D376687667
7E33984877D179307932792E7E479F9D7AC97AC87E3B7C567C517E3A7F457F7F
7E857E897E8E7E84802C826A862B862F862881C586168615861D881A825A825C
858389BC8B758B7C85958D118D128F5C91BB85A493F4859E8577942D858985A1
96E497379736976797BE97BD97E29868986698C898CA98C798DC8585994F0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
5F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000099A99A3C85909A3B9ACE87BE9B149B5387C59C2E87AC9C1F87B587BC87AE
87C99DB09DBD87CC87B79DAE9DC49E7B87B487B69E9E87B89F0587DE9F699FA1
56C7571D5B4A5DD389525F72620289AD62356527651E651F8B1E8B186B076B06
8B058B0B7054721C72207AF88B077C5D7C588B067E927F4E8B1A8C4F8C708827
8C718B818B838C948C448D6F8E4E8E4D8E539442944D9454944E8F409443907E
9138973C974097C09199919F91A1919D995A9A5193839ADD936493569C380000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
60
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000937C9C459C3A93769C359350935193609EF1938F9F93529A937993578641
5DD7934F65289377937B936170537059936772219359766F793779B57C627C5E
7CF596AE96B0863D9720882D89898B8D8B878B908D1A8E99979E979D97D5945F
97F1984194569461945B945A945C9465992B9741992A9933986E986C986D9931
99AA9A5C9A589ADE9A029C4F9C5199F79C5399F899F699FB9DFC9F3999FC513E
9ABE56D29AFD5B4F6B149B487A727A739B9E9B9B9BA68B919BA59BA491BF0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
61
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009BA2946C9BAF9D3396E697459D3697C897E4995D9D389B219D459B2C9B57
9D3E9D379C5D9C619C659E089E8A9E899E8D9EB09EC89F459EFB9EFF620566EF
6B1B6B1D722572247C6D512E8642864956978978898A8B9759708C9B8D1C5C6A
8EA25E6D5E6E61D861DF61ED61EE61F161EA9C6C61EB9C6F61E99E0E65049F08
9F1D9FA3650364FC5F606B1C66DA66DB66D87CF36AB98B9B8EA791C46ABA947A
6AB76AC79A619A639AD79C766C0B9FA5700C7067700172AB864A897D8B9D0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
62
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008C538F65947B6FFC98CD98DD72019B309E16720371FD737674B874C096E7
9E189EA274B69F7C74C27E9E9484765C9E1C76597C7197CA7657765A76A69EA3
76EC9C7B9F97790C7913975079097910791257275C1379AC7A5F7C1C7C297C19
7C205FC87C2D7C1D7C267C287C2267657C307E5C52BD7E565B667E5865F96788
6CE66CCB7E574FBD5F8D7FB36018604880756B2970A681D07706825E85B485C6
5A105CFC5CFE85B385B585BD85C785C485BF70C985CE85C885C585B185B60000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
63
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000085D28624957985B796BA866987E787E687E287DB87EB87EA7B29812887F3
8A2E87D487DC87D39AD987D8582B584587D963FA87F487E887DD6E86894B894F
894C89468950586789495BDD656E8B238B338B308C878B4750D250DF8B3E8B31
8B258B3769BA8B366B9D8B2480598B3D8B3A8C428C758C998C988C978CFE8D04
8D028D008E5C6F8A8E608E577BC37BC28E658E678E5B8E5A90F68E5D98238E54
8F468F478F488F4B71CD7499913B913E91A891A591A7984291AA93B5938C0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
64
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000093927F84939B939D938993A7938E8D0E939E9861939593888B73939F9C27
938D945877D69B2D93A493A893B493A395D295D395D196B396D796DA5DC296DF
96D896DD97239722972597AC97AE97A84F664F684FE7503F97A550A6510F523E
53245365539B517F54CB55735571556B55F456225620569256BA569156B05759
578A580F581258135847589B5900594D5AD15AD35B675C575C775CD55D755D8E
5DA55DB65DBF5E655ECD5EED5F945F9A5FBA6125615062A36360636463B60000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
65
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000640364B6651A7A255C2166E2670267A467AC68106806685E685A692C6929
6A2D6A776A7A6ACA6AE66AF56B0D6B0E6BDC6BDD6BF66C1E6C636DA56E0F6E8A
6E846E8B6E7C6F4C6F486F496F9D6F996FF8702E702D705C79CC70BF70EA70E5
71117112713F7139713B713D71777175717671717196719371B471DD71DE720E
591172187347734873EF7412743B74A4748D74B47673767776BC7819781B783D
78537854785878B778D878EE7922794D7986799979A379BC7AA77B377B590000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
66
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007BD07C2F7C327C427C4E7C687CA97CED7DD07E077DD37E647F40791E8041
806380BB6711672582488310836283128421841E84E284DE84E1857385D485F5
863786458672874A87A987A587F5883488508887895489848B038C528CD88D0C
8D188DB08EBC8ED58FAA909C85E8915C922B9221927392F492F5933F93429386
93BE93BC93BD93F193F293EF94229423942494679466959795CE95E7973B974D
98E499429B1D9B9889629D4964495E715E8561D3990E8002781E898889B70000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
67
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00005528557255BA55F055EE56B856B956C4805392B08B558B518B428B528B57
8C438C778C768C9A8D068D078D098DAC8DAA8DAD8DAB8E6D8E788E738E6A8E6F
8E7B8EC28F528F518F4F8F508F538FB49140913F91B091AD93DE93C793CF93C2
93DA93D093F993EC93CC93D993A993E693CA93D493EE93E393D593C493CE93C0
93D293A593E7957D95DA95DB96E19729972B972C9728972697B397B797B697DD
97DE97DF985C9859985D985798BF98BD98BB98BE99489947994399A699A70000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
68
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009A1A9A159A259A1D9A249A1B9A229A209A279A239A1E9A1C9A149AC29B0B
9B0A9B0E9B0C9B379BEA9BEB9BE09BDE9BE49BE69BE29BF09BD49BD79BEC9BDC
9BD99BE59BD59BE19BDA9D779D819D8A9D849D889D719D809D789D869D8B9D8C
9D7D9D6B9D749D759D709D699D859D739D7B9D829D6F9D799D7F9D879D689E94
9E919EC09EFC9F2D9F409F419F4D9F569F579F58533756B256B556B358E35B45
5DC65DC75EEE5EEF5FC05FC161F9651765166515651365DF66E866E366E40000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
69
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006AF36AF06AEA6AE86AF96AF16AEE6AEF703C7035702F7037703470317042
7038703F703A7039702A7040703B703370417213721472A8737D737C74BA76AB
76AA76BE76ED77CC77CE77CF77CD77F279257923792779287924792979B27A6E
7A6C7A6D7AF77C497C487C4A7C477C457CEE7E7B7E7E7E817E807FBA7FFF8079
81DB81D982688269862285FF860185FE861B860085F6860486098605860C85FD
8819881088118817881388168963896689B989F78B608B6A8B5D8B688B630000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
6A
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008B658B678B6D8DAE8E868E888E848F598F568F578F558F588F5A908D9143
914191B791B591B291B3940B941393FB9420940F941493FE9415941094289419
940D93F5940093F79407940E9416941293FA940993F8943C940A93FF93FC940C
93F69411940695DE95E095DF972E972F97B997BB97FD97FE986098629863985F
98C198C29950994E9959994C994B99539A329A349A319A2C9A2A9A369A299A2E
9A389A2D9AC79ACA9AC69B109B129B119C0B9C089BF79C059C129BF89C400000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
6B
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009C079C0E9C069C179C149C099D9F9D999DA49D9D9D929D989D909D9B9DA0
9D949D9C9DAA9D979DA19D9A9DA29DA89D9E9DA39DBF9DA99D969DA69DA79E99
9E9B9E9A9EE59EE49EE79EE69F309F2E9F5B9F609F5E9F5D9F599F91513A5139
5298529756C356BD56BE5B485B475DCB5DCF5EF161FD651B6B026AFC6B036AF8
6B0070437044704A7048704970457046721D721A7219737E7517766A77D0792D
7931792F7C547C537CF27E8A7E877E887E8B7E867E8D7F4D7FBB803081DD0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
6C
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008618862A8626861F8623861C86198627862E862186208629861E86258829
881D881B88208824881C882B884A896D8969896E896B89FA8B798B788B458B7A
8B7B8D108D148DAF8E8E8E8C8F5E8F5B8F5D91469144914591B9943F943B9436
9429943D94309439942A9437942C9440943195E595E495E39735973A97BF97E1
986498C998C698C0995899569A399A3D9A469A449A429A419A3A9A3F9ACD9B15
9B179B189B169B3A9B529C2B9C1D9C1C9C2C9C239C289C299C249C219DB70000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
6D
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009DB69DBC9DC19DC79DCA9DCF9DBE9DC59DC39DBB9DB59DCE9DB99DBA9DAC
9DC89DB19DAD9DCC9DB39DCD9DB29E7A9E9C9EEB9EEE9EED9F1B9F189F1A9F31
9F4E9F659F649F924EB956C656C556CB59715B4B5B4C5DD55DD15EF265216520
652665226B0B6B086B096C0D7055705670577052721E721F72A9737F74D874D5
74D974D7766D76AD793579B47A707A717C577C5C7C597C5B7C5A7CF47CF17E91
7F4F7F8781DE826B863486358633862C86328636882C88288826882A88250000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
6E
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000897189BF89BE89FB8B7E8B848B828B868B858B7F8D158E958E948E9A8E92
8E908E968E978F608F629147944C9450944A944B944F94479445944894499446
973F97E3986A986998CB9954995B9A4E9A539A549A4C9A4F9A489A4A9A499A52
9A509AD09B199B2B9B3B9B569B559C469C489C3F9C449C399C339C419C3C9C37
9C349C329C3D9C369DDB9DD29DDE9DDA9DCB9DD09DDC9DD19DDF9DE99DD99DD8
9DD69DF59DD59DDD9EB69EF09F359F339F329F429F6B9F959FA2513D52990000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
6F
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000058E858E759725B4D5DD8882F5F4F62016203620465296525659666EB6B11
6B126B0F6BCA705B705A7222738273817383767077D47C677C667E95826C863A
86408639863C8631863B863E88308832882E883389768974897389FE8B8C8B8E
8B8B8B888C458D198E988F648F6391BC94629455945D9457945E97C497C59800
9A569A599B1E9B1F9B209C529C589C509C4A9C4D9C4B9C559C599C4C9C4E9DFB
9DF79DEF9DE39DEB9DF89DE49DF69DE19DEE9DE69DF29DF09DE29DEC9DF40000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
70
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009DF39DE89DED9EC29ED09EF29EF39F069F1C9F389F379F369F439F4F9F71
9F709F6E9F6F56D356CD5B4E5C6D652D66ED66EE6B13705F7061705D70607223
74DB74E577D5793879B779B67C6A7E977F89826D8643883888378835884B8B94
8B958E9E8E9F8EA08E9D91BE91BD91C2946B9468946996E597469743974797C7
97E59A5E9AD59B599C639C679C669C629C5E9C609E029DFE9E079E039E069E05
9E009E019E099DFF9DFD9E049EA09F1E9F469F749F759F7656D4652E65B80000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
71
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006B186B196B176B1A7062722672AA77D877D979397C697C6B7CF67E9A7E98
7E9B7E9981E081E18646864786488979897A897C897B89FF8B988B998EA58EA4
8EA3946E946D946F9471947397499872995F9C689C6E9C6D9E0B9E0D9E109E0F
9E129E119EA19EF59F099F479F789F7B9F7A9F79571E70667C6F883C8DB28EA6
91C394749478947694759A609B2E9C749C739C719C759E149E139EF69F0A9FA4
706870657CF7866A883E883D883F8B9E8C9C8EA98EC9974B9873987498CC0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
72
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000996199AB9A649A669A679B249E159E179F4862076B1E7227864C8EA89482
948094819A699A689E19864B8B9F94839C799EB776759A6B9C7A9E1D7069706A
72299EA49F7E9F499F988AF68AFC8C6B8C6D8C938CF48E448E318E348E428E39
8E358F3B8F2F8F388F338FA88FA69075907490789072907C907A913491929320
933692F89333932F932292FC932B9304931A9310932693219315932E931995BB
96A796A896AA96D5970E97119716970D9713970F975B975C9766979898300000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
73
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009838983B9837982D9839982499109928991E991B9921991A99ED99E299F1
9AB89ABC9AFB9AED9B289B919D159D239D269D289D129D1B9ED89ED49F8D9F9C
512A511F5121513252F5568E5680569056855687568F58D558D358D158CE5B30
5B2A5B245B7A5C375C685DBC5DBA5DBD5DB85E6B5F4C5FBD61C961C261C761E6
61CB6232623464CE64CA64D864E064F064E664EC64F164E264ED6582658366D9
66D66A806A946A846AA26A9C6ADB6AA36A7E6A976A906AA06B5C6BAE6BDA0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
74
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00006C086FD86FF16FDF6FE06FDB6FE46FEB6FEF6F806FEC6FE16FE96FD56FEE
6FF071E771DF71EE71E671E571ED71EC71F471E0723572467370737274A974B0
74A674A876467642764C76EA77B377AA77B077AC77A777AD77EF78F778FA78F4
78EF790179A779AA7A577ABF7C077C0D7BFE7BF77C0C7BE07CE07CDC7CDE7CE2
7CDF7CD97CDD7E2E7E3E7E467E377E327E437E2B7E3D7E317E457E417E347E39
7E487E357E3F7E2F7F447FF37FFC807180728070806F807381C681C381BA0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
75
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000081C281C081BF81BD81C981BE81E88209827185AA8584857E859C85918594
85AF859B858785A8858A85A6866787C087D187B387D287C687AB87BB87BA87C8
87CB893B893689448938893D89AC8B0E8B178B198B1B8B0A8B208B1D8B048B10
8C418C3F8C738CFA8CFD8CFC8CF88CFB8DA88E498E4B8E488E4A8F448F3E8F42
8F458F3F907F907D9084908190829080913991A3919E919C934D938293289375
934A9365934B9318937E936C935B9370935A935495CA95CB95CC95C895C60000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
76
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000096B196B896D6971C971E97A097D3984698B699359A0199FF9BAE9BAB9BAA
9BAD9D3B9D3F9E8B9ECF9EDE9EDC9EDD9EDB9F3E9F4B53E2569556AE58D958D8
5B385F5E61E3623364F464F264FE650664FA64FB64F765B766DC67266AB36AAC
6AC36ABB6AB86AC26AAE6AAF6B5F6B786BAF7009700B6FFE70066FFA7011700F
71FB71FC71FE71F87377737574A774BF751576567658765277BD77BF77BB77BC
790E79AE7A617A627A607AC47AC57C2B7C277C2A7C1E7C237C217CE77E540000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
77
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00007E557E5E7E5A7E617E527E597F487FF97FFB8077807681CD81CF820A85CF
85A985CD85D085C985B085BA85B987EF87EC87F287E0898689B289F48B288B39
8B2C8B2B8C508D058E598E638E668E648E5F8E558EC08F498F4D908790839088
91AB91AC91D09394938A939693A293B393AE93AC93B09398939A939795D495D6
95D095D596E296DC96D996DB96DE972497A397A697AD97F9984D984F984C984E
985398BA993E993F993D992E99A59A0E9AC19B039B069B4F9B4E9B4D9BCA0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
78
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009BC99BFD9BC89BC09D519D5D9D609EE09F159F2C513356A556A858DE58DF
58E25BF59F905EEC61F261F761F661F56500650F66E066DD6AE56ADD6ADA6AD3
701B701F7028701A701D701570187206720D725872A27378737A74BD74CA74E3
75877586765F766177C7791979B17A6B7A697C3E7C3F7C387C3D7C377C407E6B
7E6D7E797E697E6A7E737F857FB67FB97FB881D885E985DD85EA85D585E485E5
85F787FB8805880D87F987FE8960895F8956895E8B418B5C8B588B498B5A0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
79
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008B4E8B4F8B468B598D088D0A8E7C8E728E878E768E6C8E7A8E748F548F4E
8FAD908A908B91B191AE93E193D193DF93C393C893DC93DD93D693E293CD93D8
93E493D793E895DC96B496E3972A9727976197DC97FB985E9858985B98BC9945
99499A169A199B0D9BE89BE79BD69BDB9D899D619D729D6A9D6C9E929E979E93
9EB452F856B756B656B456BC58E45B405B435B7D5BF65DC961F861FA65186514
651966E667276AEC703E703070327210737B74CF766276657926792A792C0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
7A
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000792B7AC77AF67C4C7C437C4D7CEF7CF08FAE7E7D7E7C7E827F4C800081DA
826685FB85F9861185FA8606860B8607860A88148815896489BA89F88B708B6C
8B668B6F8B5F8B6B8D0F8D0D8E898E818E858E8291B491CB9418940393FD95E1
973098C49952995199A89A2B9A309A379A359C139C0D9E799EB59EE89F2F9F5F
9F639F615137513856C156C056C259145C6C5DCD61FC61FE651D651C659566E9
6AFB6B046AFA6BB2704C721B72A774D674D4766977D37C507E8F7E8C7FBC0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
7B
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00008617862D861A882388228821881F896A896C89BD8B748B778B7D8D138E8A
8E8D8E8B8F5F8FAF91BA942E94339435943A94389432942B95E2973897399732
97FF9867986599579A459A439A409A3E9ACF9B549B519C2D9C259DAF9DB49DC2
9DB89E9D9EEF9F199F5C9F669F67513C513B56C856CA56C95B7F5DD45DD25F4E
61FF65246B0A6B6170517058738074E4758A766E766C79B37C607C5F807E807D
81DF8972896F89FC8B808D168D178E918E938F619148944494519452973D0000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
7C
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000973E97C397C1986B99559A559A4D9AD29B1A9C499C319C3E9C3B9DD39DD7
9F349F6C9F6A9F9456CC5DD662006523652B652A66EC6B1074DA7ACA7C647C63
7C657E937E967E9481E28638863F88318B8A9090908F9463946094649768986F
995C9A5A9A5B9A579AD39AD49AD19C549C579C569DE59E9F9EF456D158E9652C
705E7671767277D77F507F888836883988628B938B928B9682778D1B91C0946A
97429748974497C698709A5F9B229B589C5F9DF99DFA9E7C9E7D9F079F770000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
7D
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00009F725EF36B1670637C6C7C6E883B89C08EA191C1947294709871995E9AD6
9B239ECC706477DA8B9A947797C99A629A657E9C8B9C8EAA91C5947D947E947C
9C779C789EF78C54947F9E1A72289A6A9B319E1B9E1E7C720000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000

Added library/encoding/iso8859-11.enc.





















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Encoding file: iso8859-11, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
00A00E010E020E030E040E050E060E070E080E090E0A0E0B0E0C0E0D0E0E0E0F
0E100E110E120E130E140E150E160E170E180E190E1A0E1B0E1C0E1D0E1E0E1F
0E200E210E220E230E240E250E260E270E280E290E2A0E2B0E2C0E2D0E2E0E2F
0E300E310E320E330E340E350E360E370E380E390E3A00000000000000000E3F
0E400E410E420E430E440E450E460E470E480E490E4A0E4B0E4C0E4D0E4E0E4F
0E500E510E520E530E540E550E560E570E580E590E5A0E5B0000000000000000

Changes to library/encoding/iso8859-7.enc.

8
9
10
11
12
13
14
15

16
17
18
19
20
8
9
10
11
12
13
14

15
16
17
18
19
20







-
+





0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
0080008100820083008400850086008700880089008A008B008C008D008E008F
0090009100920093009400950096009700980099009A009B009C009D009E009F
00A02018201900A30000000000A600A700A800A9000000AB00AC00AD00002015
00A02018201900A320AC20AF00A600A700A800A9037A00AB00AC00AD00002015
00B000B100B200B303840385038600B703880389038A00BB038C00BD038E038F
0390039103920393039403950396039703980399039A039B039C039D039E039F
03A003A1000003A303A403A503A603A703A803A903AA03AB03AC03AD03AE03AF
03B003B103B203B303B403B503B603B703B803B903BA03BB03BC03BD03BE03BF
03C003C103C203C303C403C503C603C703C803C903CA03CB03CC03CD03CE0000

Changes to library/history.tcl.

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
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
363
364
365
366
367
368

369
370
371

372
373




























-
-
+
+

-
-
-
+
+
+





-
+








-
+
-
-
-
-
-
-
-
-
-
-
+
-
-



-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+






-
+


-
-
-
-
-
-
-

-
+



+
-
-
-
-
+
+
+
+
-
-
-
+
+
+

-

-
+













-
+

-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+













-
+









-
+










-
+

-
-
+
+
-
-



-
+










-
+


-
-
+
+











-
+

+
+
-
+






-
+

-
+









-
-
+
+




-
+

-
+



-
+


-
+
















-
+





-
-
+
+




-
+


-
-
+
+
+
+

-

-
+





-
-
-
-
+
+
+
+




-
+


-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# history.tcl --
#
# Implementation of the history command.
#
# Copyright (c) 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# The tcl::history array holds the history list and some additional
# bookkeeping variables.

# The tcl::history array holds the history list and
# some additional bookkeeping variables.
#
# nextid	the index used for the next history list item.
# keep		the max size of the history list
# oldest	the index of the oldest item in the history.

namespace eval ::tcl {
namespace eval tcl {
    variable history
    if {![info exists history]} {
	array set history {
	    nextid	0
	    keep	20
	    oldest	-20
	}
    }

}
    namespace ensemble create -command ::tcl::history -map {
	add	::tcl::HistAdd
	change	::tcl::HistChange
	clear	::tcl::HistClear
	event	::tcl::HistEvent
	info	::tcl::HistInfo
	keep	::tcl::HistKeep
	nextid	::tcl::HistNextID
	redo	::tcl::HistRedo
    }

}

# history --
#
#	This is the main history command.  See the man page for its interface.
#	This does some argument checking and calls the helper ensemble in the
#	tcl namespace.
#	This does argument checking and calls helper procedures in the
#	history namespace.

proc ::history {args} {
    # If no command given, we're doing 'history info'. Can't be done with an
    # ensemble unknown handler, as those don't fire when no subcommand is
    # given at all.

    if {![llength $args]} {
	set args info
    }

    # Tricky stuff needed to make stack and errors come out right!
    tailcall apply {arglist {tailcall history {*}$arglist} ::tcl} $args
}

# (unnamed) --
proc history {args} {
    set len [llength $args]
    if {$len == 0} {
	return [tcl::HistInfo]
    }
    set key [lindex $args 0]
    set options "add, change, clear, event, info, keep, nextid, or redo"
    switch -glob -- $key {
	a* { # history add

	    if {$len > 3} {
		return -code error "wrong # args: should be \"history add event ?exec?\""
	    }
	    if {![string match $key* add]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    if {$len == 3} {
		set arg [lindex $args 2]
		if {! ([string match e* $arg] && [string match $arg* exec])} {
		    return -code error "bad argument \"$arg\": should be \"exec\""
		}
	    }
	    return [tcl::HistAdd [lindex $args 1] [lindex $args 2]]
	}
	ch* { # history change

	    if {($len > 3) || ($len < 2)} {
		return -code error "wrong # args: should be \"history change newValue ?event?\""
	    }
	    if {![string match $key* change]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    if {$len == 2} {
		set event 0
	    } else {
		set event [lindex $args 2]
	    }

	    return [tcl::HistChange [lindex $args 1] $event]
	}
	cl* { # history clear

	    if {($len > 1)} {
		return -code error "wrong # args: should be \"history clear\""
	    }
	    if {![string match $key* clear]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [tcl::HistClear]
	}
	e* { # history event

	    if {$len > 2} {
		return -code error "wrong # args: should be \"history event ?event?\""
	    }
	    if {![string match $key* event]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    if {$len == 1} {
		set event -1
#
#	Callback when [::history] is destroyed. Destroys the implementation.
#
	    } else {
		set event [lindex $args 1]
	    }
	    return [tcl::HistEvent $event]
	}
	i* { # history info

# Parameters:
#	oldName    what the command was called.
#	newName    what the command is now called (an empty string).
	    if {$len > 2} {
		return -code error "wrong # args: should be \"history info ?count?\""
	    }
	    if {![string match $key* info]} {
#	op	   the operation (= delete).
#
# Results:
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [tcl::HistInfo [lindex $args 1]]
	}
	k* { # history keep
#	none
#
# Side Effects:

	    if {$len > 2} {
		return -code error "wrong # args: should be \"history keep ?count?\""
	    }
	    if {$len == 1} {
		return [tcl::HistKeep]
	    } else {
#	The implementation of the [::history] command ceases to exist.

trace add command ::history delete [list apply {{oldName newName op} {
    variable history
    unset -nocomplain history
		set limit [lindex $args 1]
		if {[catch {expr {~$limit}}] || ($limit < 0)} {
		    return -code error "illegal keep count \"$limit\""
		}
		return [tcl::HistKeep $limit]
	    }
	}
	n* { # history nextid

    foreach c [info procs ::tcl::Hist*] {
	rename $c {}
    }
    rename ::tcl::history {}
} ::tcl}]

	    if {$len > 1} {
		return -code error "wrong # args: should be \"history nextid\""
	    }
	    if {![string match $key* nextid]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [expr {$tcl::history(nextid) + 1}]
	}
	r* { # history redo

	    if {$len > 2} {
		return -code error "wrong # args: should be \"history redo ?event?\""
	    }
	    if {![string match $key* redo]} {
		return -code error "bad option \"$key\": must be $options"
	    }
	    return [tcl::HistRedo [lindex $args 1]]
	}
	default {
	    return -code error "bad option \"$key\": must be $options"
	}
    }
}

# tcl::HistAdd --
#
#	Add an item to the history, and optionally eval it at the global scope
#
# Parameters:
#	event		the command to add
#	exec		(optional) a substring of "exec" causes the command to
#			be evaled.
#	command		the command to add
#	exec		(optional) a substring of "exec" causes the
#			command to be evaled.
# Results:
# 	If executing, then the results of the command are returned
#
# Side Effects:
#	Adds to the history list

proc ::tcl::HistAdd {event {exec {}}} {
 proc tcl::HistAdd {command {exec {}}} {
    variable history

    if {
	[prefix longest {exec {}} $exec] eq ""
	&& [llength [info level 0]] == 3
    } then {
	return -code error "bad argument \"$exec\": should be \"exec\""
    }

    # Do not add empty commands to the history
    if {[string trim $event] eq ""} {
    if {[string trim $command] eq ""} {
	return ""
    }

    set i [incr history(nextid)]
    # Maintain the history
    set history([incr history(nextid)]) $event
    unset -nocomplain history([incr history(oldest)])

    set history($i) $command
    set j [incr history(oldest)]
    unset -nocomplain history($j)
    if {[string match e* $exec]} {
    # Only execute if 'exec' (or non-empty prefix of it) given
    if {$exec eq ""} {
	return ""
	return [uplevel #0 $command]
    } else {
	return {}
    }
    tailcall eval $event
}


# tcl::HistKeep --
#
#	Set or query the limit on the length of the history list
#
# Parameters:
#	limit	(optional) the length of the history list
#
# Results:
#	If no limit is specified, the current limit is returned
#
# Side Effects:
#	Updates history(keep) if a limit is specified

proc ::tcl::HistKeep {{count {}}} {
 proc tcl::HistKeep {{limit {}}} {
    variable history
    if {[llength [info level 0]] == 1} {
    if {$limit eq ""} {
	return $history(keep)
    }
    } else {
    if {![string is integer -strict $count] || ($count < 0)} {
	return -code error "illegal keep count \"$count\""
    }
    set oldold $history(oldest)
    set history(oldest) [expr {$history(nextid) - $count}]
    for {} {$oldold <= $history(oldest)} {incr oldold} {
	unset -nocomplain history($oldold)
    }
    set history(keep) $count
}

	set oldold $history(oldest)
	set history(oldest) [expr {$history(nextid) - $limit}]
	for {} {$oldold <= $history(oldest)} {incr oldold} {
	    unset -nocomplain history($oldold)
	}
	set history(keep) $limit
    }
}

# tcl::HistClear --
#
#	Erase the history list
#
# Parameters:
#	none
#
# Results:
#	none
#
# Side Effects:
#	Resets the history array, except for the keep limit

proc ::tcl::HistClear {} {
 proc tcl::HistClear {} {
    variable history
    set keep $history(keep)
    unset history
    array set history [list \
	nextid	0	\
	keep	$keep	\
	oldest	-$keep	\
    ]
}


# tcl::HistInfo --
#
#	Return a pretty-printed version of the history list
#
# Parameters:
#	num	(optional) the length of the history list to return
#
# Results:
#	A formatted history list

proc ::tcl::HistInfo {{count {}}} {
 proc tcl::HistInfo {{num {}}} {
    variable history
    if {[llength [info level 0]] == 1} {
	set count [expr {$history(keep) + 1}]
    if {$num eq ""} {
	set num [expr {$history(keep) + 1}]
    } elseif {![string is integer -strict $count]} {
	return -code error "bad integer \"$count\""
    }
    set result {}
    set newline ""
    for {set i [expr {$history(nextid) - $count + 1}]} \
    for {set i [expr {$history(nextid) - $num + 1}]} \
	    {$i <= $history(nextid)} {incr i} {
	if {![info exists history($i)]} {
	    continue
	}
        set cmd [string map [list \n \n\t] [string trimright $history($i) \ \n]]
	append result $newline[format "%6d  %s" $i $cmd]
	set newline \n
    }
    return $result
}


# tcl::HistRedo --
#
#	Fetch the previous or specified event, execute it, and then replace
#	the current history item with that event.
#	Fetch the previous or specified event, execute it, and then
#	replace the current history item with that event.
#
# Parameters:
#	event	(optional) index of history item to redo.  Defaults to -1,
#		which means the previous event.
#
# Results:
#	Those of the command being redone.
#
# Side Effects:
#	Replaces the current history list item with the one being redone.

proc ::tcl::HistRedo {{event -1}} {
 proc tcl::HistRedo {{event -1}} {
    variable history
    if {$event eq ""} {
	set event -1

    }
    set i [HistIndex $event]
    if {$i == $history(nextid)} {
	return -code error "cannot redo the current event"
    }
    set cmd $history($i)
    HistChange $cmd 0
    tailcall eval $cmd
    uplevel #0 $cmd
}


# tcl::HistIndex --
#
#	Map from an event specifier to an index in the history list.
#
# Parameters:
#	event	index of history item to redo.
#		If this is a positive number, it is used directly.
#		If it is a negative number, then it counts back to a previous
#		event, where -1 is the most recent event.
#		A string can be matched, either by being the prefix of a
#		command or by matching a command with string match.
#		A string can be matched, either by being the prefix of
#		a command or by matching a command with string match.
#
# Results:
#	The index into history, or an error if the index didn't match.

proc ::tcl::HistIndex {event} {
 proc tcl::HistIndex {event} {
    variable history
    if {![string is integer -strict $event]} {
    if {[catch {expr {~$event}}]} {
	for {set i [expr {$history(nextid)-1}]} {[info exists history($i)]} \
		{incr i -1} {
	    if {[string match $event* $history($i)]} {
		return $i
		return $i;
	    }
	    if {[string match $event $history($i)]} {
		return $i
		return $i;
	    }
	}
	return -code error "no event matches \"$event\""
    } elseif {$event <= 0} {
	set i [expr {$history(nextid) + $event}]
    } else {
	set i $event
    }
    if {$i <= $history(oldest)} {
	return -code error "event \"$event\" is too far in the past"
    }
    if {$i > $history(nextid)} {
	return -code error "event \"$event\" hasn't occured yet"
    }
    return $i
}


# tcl::HistEvent --
#
#	Map from an event specifier to the value in the history list.
#
# Parameters:
#	event	index of history item to redo.  See index for a description of
#		possible event patterns.
#	event	index of history item to redo.  See index for a
#		description of possible event patterns.
#
# Results:
#	The value from the history list.

proc ::tcl::HistEvent {{event -1}} {
 proc tcl::HistEvent {event} {
    variable history
    set i [HistIndex $event]
    if {![info exists history($i)]} {
	return ""
    if {[info exists history($i)]} {
	return [string trimright $history($i) \ \n]
    } else {
	return "";
    }
    return [string trimright $history($i) \ \n]
}


# tcl::HistChange --
#
#	Replace a value in the history list.
#
# Parameters:
#	newValue  The new value to put into the history list.
#	event	  (optional) index of history item to redo.  See index for a
#		  description of possible event patterns.  This defaults to 0,
#		  which specifies the current event.
#	cmd	The new value to put into the history list.
#	event	(optional) index of history item to redo.  See index for a
#		description of possible event patterns.  This defaults
#		to 0, which specifies the current event.
#
# Side Effects:
#	Changes the history list.

proc ::tcl::HistChange {newValue {event 0}} {
 proc tcl::HistChange {cmd {event 0}} {
    variable history
    set i [HistIndex $event]
    set history($i) $newValue
    set history($i) $cmd
}

# tcl::HistNextID --
#
#	Returns the number of the next history event.
#
# Parameters:
#	None.
#
# Side Effects:
#	None.

proc ::tcl::HistNextID {} {
    variable history
    return [expr {$history(nextid) + 1}]
}

return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

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
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
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










-
+


-
+








-
-
-



-

-

-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-



















-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-







# 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-
package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.10.0a1
package provide http 2.7.15

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
	    -accept */*
	    -cookiejar {}
	    -pipeline 1
	    -postfresh 0
	    -proxyhost {}
	    -proxyport {}
	    -proxyfilter http::ProxyRequired
	    -repost 0
	    -urlencoding utf-8
	    -zip 1
	}
	# We need a useragent string of this style or various servers will
	# refuse to send us compressed content even when we ask for it. This
	# follows the de-facto layout of user-agent strings in current browsers.
	# Safe interpreters do not have ::tcl_platform(os) or
	# ::tcl_platform(osVersion).
	if {[interp issafe]} {
	    set http(-useragent) "Mozilla/5.0\
	set http(-useragent) "Tcl http client package [package provide http]"
		(Windows; U;\
		Windows NT 10.0)\
		http/[package provide http] Tcl/[package provide Tcl]"
	} else {
	    set http(-useragent) "Mozilla/5.0\
		([string totitle $::tcl_platform(platform)]; U;\
		$::tcl_platform(os) $::tcl_platform(osVersion))\
		http/[package provide http] Tcl/[package provide Tcl]"
	}
    }

    proc init {} {
	# Set up the map for quoting chars. RFC3986 Section 2.3 say percent
	# 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 socketMapping
	variable socketmap
	variable socketRdState
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketClosing
	variable socketPlayCmd
	if {[info exists socketMapping]} {
	    # Close open sockets on re-init.  Do not permit retries.
	    foreach {url sock} [array get socketMapping] {
	if {[info exists socketmap]} {
	    # Close but don't remove open sockets on re-init
	    foreach {url sock} [array get socketmap] {
		unset -nocomplain socketClosing($url)
		unset -nocomplain socketPlayCmd($url)
		CloseSocket $sock
		catch {close $sock}
	    }
	}

	# CloseSocket should have unset the socket* arrays, one element at
	# a time.  Now unset anything that was overlooked.
	# Traces on "unset socketRdState(*)" will call CancelReadPipeline and
	# cancel any queued responses.
	# Traces on "unset socketWrState(*)" will call CancelWritePipeline and
	# cancel any queued requests.
	array unset socketMapping
	array unset socketRdState
	array unset socketWrState
	array unset socketRdQueue
	array unset socketWrQueue
	array unset socketClosing
	array unset socketPlayCmd
	array set socketMapping {}
	array set socketmap {}
	array set socketRdState {}
	array set socketWrState {}
	array set socketRdQueue {}
	array set socketWrQueue {}
	array set socketClosing {}
	array set socketPlayCmd {}
    }
    init

    variable urlTypes
    if {![info exists urlTypes]} {
	set urlTypes(http) [list 80 ::socket]
    }
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-










-
+








    # Let user control default keepalive for compatibility
    variable defaultKeepalive
    if {![info exists defaultKeepalive]} {
	set defaultKeepalive 0
    }

    # Regular expression used to parse cookies
    variable CookieRE {(?x)                            # EXPANDED SYNTAX
	\s*                                            # Ignore leading spaces
	([^][\u0000- ()<>@,;:\\""/?={}\u007f-\uffff]+) # Match the name
	=                                              # LITERAL: Equal sign
	([!\u0023-+\u002D-:<-\u005B\u005D-~]*)         # Match the value
	(?:
	 \s* ; \s*                                     # LITERAL: semicolon
	 ([^\u0000]+)                                  # Match the options
	)?
    }

    namespace export geturl config reset wait formatQuery quoteString
    namespace export geturl config reset wait formatQuery register unregister
    namespace export register unregister registerError
    # - Useful, but not exported: data, size, status, code, cleanup, error,
    # Useful, but not exported: data size status code
    #   meta, ncode, mapReply, init.  Comments suggest that "init" can be used
    #   for re-initialisation, although the command is undocumented.
    # - Not exported, probably should be upper-case initial letter as part
    #   of the internals: getTextLine, make-transformation-chunked.
}

# http::Log --
#
#	Debugging output -- define this to observe HTTP/1.1 socket usage.
#	Should echo any args received.
#
# Arguments:
#     msg	Message to output
#
if {[info command http::Log] eq {}} {proc http::Log {args} {}}
proc http::Log {args} {}

# http::register --
#
#     See documentation for details.
#
# Arguments:
#     proto	URL protocol prefix, e.g. https
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
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

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
611
612
613
614
615
616
617
618
619
620
621



622
623
624

625
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


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
756
757
758
759
760
761
762

763
764
765



766
767
768
769
770
771
772
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
363
364
365
366
367
368
369
370







-
+





-
+


-
-
-
-
-
-
-
-



-




-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
+
-
-
-
-
-



-

-
-
+
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+

-
-
+
+
-
-
-
-
-
-
-
-
-

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-











-
+




















-
-
+
+



















-


-

-














-
+

-









-
+











-













+
-
-
-
+
+
+







# http::Finish --
#
#	Clean up the socket and eval close time callbacks
#
# Arguments:
#	token	    Connection token.
#	errormsg    (optional) If set, forces status to error.
#	skipCB      (optional) If set, don't call the -command callback. This
#       skipCB      (optional) If set, don't call the -command callback. This
#		    is useful when geturl wants to throw an exception instead
#		    of calling the callback. That way, the same error isn't
#		    reported to two places.
#
# Side Effects:
#        May close the socket.
#        Closes the socket

proc http::Finish {token {errormsg ""} {skipCB 0}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    global errorInfo errorCode
    set closeQueue 0
    if {$errormsg ne ""} {
	set state(error) [list $errormsg $errorInfo $errorCode]
	set state(status) "error"
    }
    if {[info commands ${token}EventCoroutine] ne {}} {
	rename ${token}EventCoroutine {}
    }
    if {  ($state(status) eq "timeout")
       || ($state(status) eq "error")
    if {
	($state(status) eq "timeout") || ($state(status) eq "error") ||
       || ($state(status) eq "eof")
       || ([info exists state(-keepalive)] && !$state(-keepalive))
       || ([info exists state(connection)] && ($state(connection) eq "close"))
    } {
	([info exists state(connection)] && ($state(connection) eq "close"))
    } then {
	set closeQueue 1
	set connId $state(socketinfo)
	set sock $state(sock)
	CloseSocket $state(sock) $token
        CloseSocket $state(sock) $token
    } elseif {
	  ([info exists state(-keepalive)] && $state(-keepalive))
       && ([info exists state(connection)] && ($state(connection) ne "close"))
    } {
	KeepSocket $token
    }
    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }
    if {[info exists state(-command)] && (!$skipCB)
	    && (![info exists state(done-command-cb)])} {
    if {[info exists state(-command)] && !$skipCB
	    && ![info exists state(done-command-cb)]} {
	set state(done-command-cb) yes
	if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
	    set state(error) [list $err $errorInfo $errorCode]
	    set state(status) error
	}
    }

    if {    $closeQueue
	 && [info exists socketMapping($connId)]
	 && ($socketMapping($connId) eq $sock)
    } {
	http::CloseQueuedQueries $connId $token
    }
}

# http::KeepSocket -
#
#	Keep a socket in the persistent sockets table and connect it to its next
#	queued task if possible.  Otherwise leave it idle and ready for its next
#	use.
#
#	If $socketClosing(*), then ($state(connection) eq "close") and therefore
#	this command will not be called by Finish.
#
# Arguments:
#	token	    Connection token.

proc http::KeepSocket {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    # Keep this socket open for another request ("Keep-Alive").
    # React if the server half-closes the socket.
    # Discussion is in http::geturl.
    catch {fileevent $state(sock) readable [list http::CheckEof $state(sock)]}

    # The line below should not be changed in production code.
    # It is edited by the test suite.
    set TEST_EOF 0
    if {$TEST_EOF} {
	# ONLY for testing reaction to server eof.
	# No server timeouts will be caught.
	catch {fileevent $state(sock) readable {}}
    }

    if {    [info exists state(socketinfo)]
	 && [info exists socketMapping($state(socketinfo))]
    } {
	set connId $state(socketinfo)
	# The value "Rready" is set only here.
	set socketRdState($connId) Rready

	if {    $state(-pipeline)
	     && [info exists socketRdQueue($connId)]
	     && [llength $socketRdQueue($connId)]
	} {
	    # The usual case for pipelined responses - if another response is
	    # queued, arrange to read it.
	    set token3 [lindex $socketRdQueue($connId) 0]
	    set socketRdQueue($connId) [lrange $socketRdQueue($connId) 1 end]
	    variable $token3
	    upvar 0 $token3 state3
	    set tk2 [namespace tail $token3]

	    #Log pipelined, GRANT read access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    ReceiveResponse $token3

	    # Other pipelined cases.
	    # - The test above ensures that, for the pipelined cases in the two
	    #   tests below, the read queue is empty.
	    # - In those two tests, check whether the next write will be
	    #   nonpipeline.
	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "peNding")

	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && (![set token3 [lindex $socketWrQueue($connId) 0]
		   set ${token3}(-pipeline)
		  ]
		)
	} {
	    # This case:
	    # - Now it the time to run the "pending" request.
	    # - The next token in the write queue is nonpipeline, and
	    #   socketWrState has been marked "pending" (in
	    #   http::NextPipelinedWrite or http::geturl) so a new pipelined
	    #   request cannot jump the queue.
	    #
	    # Tests:
	    # - In this case the read queue (tested above) is empty and this
	    #   "pending" write token is in front of the rest of the write
	    #   queue.
	    # - The write state is not Wready and therefore appears to be busy,
	    #   but because it is "pending" we know that it is reserved for the
	    #   first item in the write queue, a non-pipelined request that is
	    #   waiting for the read queue to empty.  That has now happened: so
	    #   give that request read and write access.
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)

	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "peNding")

	} {
	    # Should not come here.  The second block in the previous "elseif"
	    # test should be tautologous (but was needed in an earlier
	    # implementation) and will be removed after testing.
	    # If we get here, the value "pending" was assigned in error.
	    # This error would block the queue for ever.
	    Log ^X$tk <<<<< Error in queueing of requests >>>>> - token $token

	} elseif {
		$state(-pipeline)
	     && [info exists socketWrState($connId)]
	     && ($socketWrState($connId) eq "Wready")

	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && (![set token3 [lindex $socketWrQueue($connId) 0]
		   set ${token3}(-pipeline)
		  ]
		)
	} {
	    # This case:
	    # - The next token in the write queue is nonpipeline, and
	    #   socketWrState is Wready.  Get the next event from socketWrQueue.
	    # Tests:
	    # - In this case the read state (tested above) is Rready and the
	    #   write state (tested here) is Wready - there is no "pending"
	    #   request.
	    # Code:
	    # - The code is the same as the code below for the nonpipelined
	    #   case with a queued request.
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)

	} elseif {
		(!$state(-pipeline))
	     && [info exists socketWrQueue($connId)]
	     && [llength $socketWrQueue($connId)]
	     && ($state(connection) ne "close")
	} {
	    # If not pipelined, (socketRdState eq Rready) tells us that we are
	    # ready for the next write - there is no need to check
	    # socketWrState. Write the next request, if one is waiting.
	    # If the next request is pipelined, it receives premature read
	    # access to the socket. This is not a problem.
	    set token3 [lindex $socketWrQueue($connId) 0]
	    variable $token3
	    set conn [set ${token3}(tmpConnArgs)]
	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
	    set socketRdState($connId) $token3
	    set socketWrState($connId) $token3
	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	    # Connect does its own fconfigure.
	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	    #Log ---- $state(sock) << conn to $token3 for HTTP request (d)

	} elseif {(!$state(-pipeline))} {
	    set socketWrState($connId) Wready
	    # Rready and Wready and idle: nothing to do.
	}

    } else {
	CloseSocket $state(sock) $token
	# There is no socketMapping($state(socketinfo)), so it does not matter
	# that CloseQueuedQueries is not called.
    }
}

# http::CheckEof -
#
#	Read from a socket and close it if eof.
#	The command is bound to "fileevent readable" on an idle socket, and
#	"eof" is the only event that should trigger the binding, occurring when
#	the server times out and half-closes the socket.
#
#	A read is necessary so that [eof] gives a meaningful result.
#	Any bytes sent are junk (or a bug).

proc http::CheckEof {sock} {
    set junk [read $sock]
    set n [string length $junk]
    if {$n} {
	Log "WARNING: $n bytes received but no HTTP request sent"
    }

    if {[catch {eof $sock} res] || $res} {
	# The server has half-closed the socket.
	# If a new write has started, its transaction will fail and
	# will then be error-handled.
	CloseSocket $sock
    }
}

# http::CloseSocket -
#
#	Close a socket and remove it from the persistent sockets table.  If
#	possible an http token is included here but when we are called from a
#	fileevent on remote closure we need to find the correct entry - hence
#	the "else" block of the first "if" command.
#	the second section.

proc http::CloseSocket {s {token {}}} {
    variable socketMapping
proc ::http::CloseSocket {s {token {}}} {
    variable socketmap
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    set tk [namespace tail $token]

    catch {fileevent $s readable {}}
    set connId {}
    set conn_id {}
    if {$token ne ""} {
	variable $token
	upvar 0 $token state
	if {[info exists state(socketinfo)]} {
	    set connId $state(socketinfo)
	}
        variable $token
        upvar 0 $token state
        if {[info exists state(socketinfo)]} {
	    set conn_id $state(socketinfo)
        }
    } else {
	set map [array get socketMapping]
	set ndx [lsearch -exact $map $s]
	if {$ndx >= 0} {
        set map [array get socketmap]
        set ndx [lsearch -exact $map $s]
        if {$ndx != -1} {
	    incr ndx -1
	    set connId [lindex $map $ndx]
	}
	    set conn_id [lindex $map $ndx]
        }
    }
    if {    ($connId ne {})
	 && [info exists socketMapping($connId)]
    if {$conn_id eq {} || ![info exists socketmap($conn_id)]} {
	 && ($socketMapping($connId) eq $s)
    } {
	Log "Closing connection $connId (sock $socketMapping($connId))"
	if {[catch {close $socketMapping($connId)} err]} {
	    Log "Error closing connection: $err"
	}
	if {$token eq {}} {
	    # Cases with a non-empty token are handled by Finish, so the tokens
	    # are finished in connection order.
	    http::CloseQueuedQueries $connId
	}
    } else {
	Log "Closing socket $s (no connection info)"
	if {[catch {close $s} err]} {
	    Log "Error closing socket: $err"
        Log "Closing socket $s (no connection info)"
        if {[catch {close $s} err]} {
	    Log "Error: $err"
	}
    }
}

# http::CloseQueuedQueries
#
#	connId  - identifier "domain:port" for the connection
#	token   - (optional) used only for logging
#
# Called from http::CloseSocket and http::Finish, after a connection is closed,
# to clear the read and write queues if this has not already been done.

proc http::CloseQueuedQueries {connId {token {}}} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    if {![info exists socketMapping($connId)]} {
	# Command has already been called.
	# Don't come here again - especially recursively.
	return
    }

    # Used only for logging.
    if {$token eq {}} {
	set tk {}
    } else {
	set tk [namespace tail $token]
    }

    if {    [info exists socketPlayCmd($connId)]
	 && ($socketPlayCmd($connId) ne {ReplayIfClose Wready {} {}})
    } {
	# Before unsetting, there is some unfinished business.
	# - If the server sent "Connection: close", we have stored the command
	#   for retrying any queued requests in socketPlayCmd, so copy that
	#   value for execution below.  socketClosing(*) was also set.
	# - Also clear the queues to prevent calls to Finish that would set the
	#   state for the requests that will be retried to "finished with error
	#   status".
	set unfinished $socketPlayCmd($connId)
	set socketRdQueue($connId) {}
	set socketWrQueue($connId) {}
    } else {
	set unfinished {}
    }

    Unset $connId

	if {[info exists socketmap($conn_id)]} {
	    Log "Closing connection $conn_id (sock $socketmap($conn_id))"
	    if {[catch {close $socketmap($conn_id)} err]} {
    if {$unfinished ne {}} {
	Log ^R$tk Any unfinished transactions (excluding $token) failed \
		- token $token
		Log "Error: $err"
	{*}$unfinished
    }
}

	    }
	    unset socketmap($conn_id)
	} else {
	    Log "Cannot close connection $conn_id - no socket in socket map"
# http::Unset
#
#	The trace on "unset socketRdState(*)" will call CancelReadPipeline
#	and cancel any queued responses.
#	The trace on "unset socketWrState(*)" will call CancelWritePipeline
#	and cancel any queued requests.

	}
proc http::Unset {connId} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    }
    unset socketMapping($connId)
    unset socketRdState($connId)
    unset socketWrState($connId)
    unset -nocomplain socketRdQueue($connId)
    unset -nocomplain socketWrQueue($connId)
    unset -nocomplain socketClosing($connId)
    unset -nocomplain socketPlayCmd($connId)
}

# http::reset --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#	why	Status info.
#
# Side Effects:
#        See Finish
#       See Finish

proc http::reset {token {why reset}} {
    variable $token
    upvar 0 $token state
    set state(status) $why
    catch {fileevent $state(sock) readable {}}
    catch {fileevent $state(sock) writable {}}
    Finish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state
	eval ::error $errorlist
    }
}

# http::geturl --
#
#	Establishes a connection to a remote url via http.
#
# Arguments:
#	url		The http URL to goget.
#	args		Option value pairs. Valid options include:
#       url		The http URL to goget.
#       args		Option value pairs. Valid options include:
#				-blocksize, -validate, -headers, -timeout
# Results:
#	Returns a token for this connection. This token is the name of an
#	array that the caller should unset to garbage collect the state.

proc http::geturl {url args} {
    variable http
    variable urlTypes
    variable defaultCharset
    variable defaultKeepalive
    variable strict

    # Initialize the state variable, an array. We'll return the name of this
    # array as the token for the transaction.

    if {![info exists http(uid)]} {
	set http(uid) 0
    }
    set token [namespace current]::[incr http(uid)]
    ##Log Starting http::geturl - token $token
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    reset $token
    Log ^A$tk URL $url - token $token

    # Process command options.

    array set state {
	-binary		false
	-blocksize	8192
	-queryblocksize 8192
	-validate	0
	-headers	{}
	-timeout	0
	-type		application/x-www-form-urlencoded
	-queryprogress	{}
	-protocol	1.1
	binary		0
	state		created
	state		connecting
	meta		{}
	method		{}
	coding		{}
	currentsize	0
	totalsize	0
	querylength	0
	queryoffset	0
	type		text/html
	body		{}
	status		""
	http		""
	connection	keep-alive
	connection	close
    }
    set state(-keepalive) $defaultKeepalive
    set state(-strict) $strict
    # These flags have their types verified [Bug 811170]
    array set type {
	-binary		boolean
	-blocksize	integer
	-queryblocksize integer
	-strict		boolean
	-timeout	integer
	-validate	boolean
	-headers	dict
    }
    set state(charset)	$defaultCharset
    set options {
	-binary -blocksize -channel -command -handler -headers -keepalive
	-method -myaddr -progress -protocol -query -queryblocksize
	-querychannel -queryprogress -strict -timeout -type -validate
    }
    set usage [join [lsort $options] ", "]
    set options [string map {- ""} $options]
    set pat ^-(?:[join $options |])$
    foreach {flag value} $args {
	if {[regexp -- $pat $flag]} {
	    # Validate numbers
	    if {
	    if {($flag eq "-headers") ? [catch {dict size $value}] :
		([info exists type($flag)] && ![string is $type($flag) -strict $value])
	    } {
		[info exists type($flag)] &&
		![string is $type($flag) -strict $value]
	    } then {
		unset $token
		return -code error \
		    "Bad value for $flag ($value), must be $type($flag)"
	    }
	    set state($flag) $value
	} else {
	    unset $token
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
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







+














-
+
-
-
-













-







    # The "http" is the protocol, the user is "jschmoe", the password is
    # "xyzzy", the host is "www.bogus.net", the port is "8000", the path is
    # "/foo/bar.tml", the query is "q=foo", and the fragment is "changes".
    #
    # Note that the RE actually combines the user and password parts, as
    # recommended in RFC 3986. Indeed, that RFC states that putting passwords
    # in URLs is a Really Bad Idea, something with which I would agree utterly.
    # Also note that we do not currently support IPv6 addresses.
    #
    # From a validation perspective, we need to ensure that the parts of the
    # URL that are going to the server are correctly encoded.  This is only
    # done if $state(-strict) is true (inherited from $::http::strict).

    set URLmatcher {(?x)		# this is _expanded_ syntax
	^
	(?: (\w+) : ) ?			# <protocol scheme>
	(?: //
	    (?:
		(
		    [^@/\#?]+		# <userinfo part of authority>
		) @
	    )?
	    (				# <host part of authority>
	    ( [^/:\#?]+ )		# <host part of authority>
		[^/:\#?]+ |		# host name or IPv4 address
		\[ [^/\#?]+ \]		# IPv6 address in square brackets
	    )
	    (?: : (\d+) )?		# <port part of authority>
	)?
	( [/\?] [^\#]*)?		# <path> (including query)
	(?: \# (.*) )?			# <fragment>
	$
    }

    # Phase one: parse
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
	unset $token
	return -code error "Unsupported URL: $url"
    }
    # Phase two: validate
    set host [string trim $host {[]}]; # strip square brackets from IPv6 address
    if {$host eq ""} {
	# Caller has to provide a host name; we do not have a "default host"
	# that would enable us to handle relative URLs.
	unset $token
	return -code error "Missing host part: $url"
	# Note that we don't check the hostname for validity here; if it's
	# invalid, we'll simply fail to resolve it later on.
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
496
497
498
499
500
501
502



503
504

505
506
507
508
509
510
511







-
-
-


-







	    # Provide a better error message in this error case
	    if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
		return -code error \
		    "Illegal encoding character usage \"$bad\" in URL path"
	    }
	    return -code error "Illegal characters in URL path"
	}
	if {![regexp {^[^?#]+} $srvurl state(path)]} {
	    set state(path) /
	}
    } else {
	set srvurl /
	set state(path) /
    }
    if {$proto eq ""} {
	set proto http
    }
    set lower [string tolower $proto]
    if {![info exists urlTypes($lower)]} {
	unset $token
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
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
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
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
611







+
+
+

+
+
+
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
+
+




-
-
+
+

-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-

-
-
+
+
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-







    if {$port != $defport} {
	append url : $port
    }
    append url $srvurl
    # Don't append the fragment!
    set state(url) $url

    # If a timeout is specified we set up the after event and arrange for an
    # asynchronous socket connection.

    set sockopts [list -async]
    if {$state(-timeout) > 0} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    # If we are using the proxy, we must pass in the full URL that includes
    # the server name.

    if {[info exists phost] && ($phost ne "")} {
	set srvurl $url
	set targetAddr [list $phost $pport]
    } else {
	set targetAddr [list $host $port]
    }
    # Proxy connections aren't shared among different hosts.
    set state(socketinfo) $host:$port

    # Save the accept types at this point to prevent a race condition. [Bug
    # c11a51c482]
    set state(accept-types) $http(-accept)

    if {$isQuery || $isQueryChannel} {
	# It's a POST.
	# A client wishing to send a non-idempotent request SHOULD wait to send
	# that request until it has received the response status for the
	# previous request.
	if {$http(-postfresh)} {
	    # Override -keepalive for a POST.  Use a new connection, and thus
	    # avoid the small risk of a race against server timeout.
	    set state(-keepalive) 0
	} else {
	    # Allow -keepalive but do not -pipeline - wait for the previous
	    # transaction to finish.
	    # There is a small risk of a race against server timeout.
	    set state(-pipeline) 0
	}
    } else {
	# It's a GET or HEAD.
	set state(-pipeline) $http(-pipeline)
    }

    # We cannot handle chunked encodings with -handler, so force HTTP/1.0
    # until we can manage this.
    if {[info exists state(-handler)]} {
	set state(-protocol) 1.0
    }

    # RFC 7320 A.1 - HTTP/1.0 Keep-Alive is problematic. We do not support it.
    if {$state(-protocol) eq "1.0"} {
	set state(connection) close
	set state(-keepalive) 0
    }

    # See if we are supposed to use a previously opened channel.
    # - In principle, ANY call to http::geturl could use a previously opened
    #   channel if it is available - the "Connection: keep-alive" header is a
    #   request to leave the channel open AFTER completion of this call.
    # - In fact, we try to use an existing channel only if -keepalive 1 -- this
    #   means that at most one channel is left open for each value of
    #   $state(socketinfo). This property simplifies the mapping of open
    #   channels.
    set reusing 0
    set alreadyQueued 0
    if {$state(-keepalive)} {
	variable socketMapping
	variable socketmap
	variable socketRdState
	variable socketWrState
	variable socketRdQueue
	variable socketWrQueue
	variable socketClosing
	variable socketPlayCmd

	if {[info exists socketMapping($state(socketinfo))]} {
	    # - If the connection is idle, it has a "fileevent readable" binding
	    #   to http::CheckEof, in case the server times out and half-closes
	    #   the socket (http::CheckEof closes the other half).
	    # - We leave this binding in place until just before the last
	    #   puts+flush in http::Connected (GET/HEAD) or http::Write (POST),
	    #   after which the HTTP response might be generated.

	    if {    [info exists socketClosing($state(socketinfo))]
		       && $socketClosing($state(socketinfo))
	if {[info exists socketmap($state(socketinfo))]} {
	    } {
		# socketClosing(*) is set because the server has sent a
		# "Connection: close" header.
		# Do not use the persistent socket again.
		# Since we have only one persistent socket per server, and the
		# old socket is not yet dead, add the request to the write queue
		# of the dying socket, which will be replayed by ReplayIfClose.
		# Also add it to socketWrQueue(*) which is used only if an error
		# causes a call to Finish.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo) - token $token"

		set alreadyQueued 1
		lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3
		lappend com3 $token
		set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3]
		lappend socketWrQueue($state(socketinfo)) $token
	    } elseif {[catch {fconfigure $socketMapping($state(socketinfo))}]} {
	    if {[catch {fconfigure $socketmap($state(socketinfo))}]} {
		# FIXME Is it still possible for this code to be executed? If
		#       so, this could be another place to call TestForReplay,
		#       rather than discarding the queued transactions.
		Log "WARNING: socket for $state(socketinfo) was closed\
		Log "WARNING: socket for $state(socketinfo) was closed"
			- token $token"
		Log "WARNING - if testing, pay special attention to this\
			case (GH) which is seldom executed - token $token"

		# This will call CancelReadPipeline, CancelWritePipeline, and
		# cancel any queued requests, responses.
		Unset $state(socketinfo)
		unset socketmap($state(socketinfo))
	    } else {
		# Use the persistent socket.
		# The socket may not be ready to write: an earlier request might
		# still be still writing (in the pipelined case) or
		# writing/reading (in the nonpipeline case). This possibility
		# is handled by socketWrQueue later in this command.
		set reusing 1
		set sock $socketMapping($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo) - token $token"

	    }
	    # Do not automatically close the connection socket.
	    set state(connection) keep-alive
	}
		set sock $socketmap($state(socketinfo))
		Log "reusing socket $sock for $state(socketinfo)"
		catch {fileevent $sock writable {}}
		catch {fileevent $sock readable {}}
	    }
	}
	# don't automatically close this connection socket
	set state(connection) {}
    }
    }

    if {$reusing} {
	# Define state(tmpState) and state(tmpOpenCmd) for use
	# by http::ReplayIfDead if the persistent connection has died.
	set state(tmpState) [array get state]

	# Pass -myaddr directly to the socket command
	if {[info exists state(-myaddr)]} {
	    lappend sockopts -myaddr $state(-myaddr)
	}

	set state(tmpOpenCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr]
    }

    set state(reusing) $reusing
    # Excluding ReplayIfDead and the decision whether to call it, there are four
    # places outside http::geturl where state(reusing) is used:
    # - Connected   - if reusing and not pipelined, start the state(-timeout)
    #                 timeout (when writing).
    # - DoneRequest - if reusing and pipelined, send the next pipelined write
    # - Event       - if reusing and pipelined, start the state(-timeout)
    #                 timeout (when reading).
    # - Event       - if (not reusing) and pipelined, send the next pipelined
    #                 write

    # See comments above re the start of this timeout in other cases.
    if {(!$state(reusing)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    if {![info exists sock]} {
	# Pass -myaddr directly to the socket command
	if {[info exists state(-myaddr)]} {
	    lappend sockopts -myaddr $state(-myaddr)
	}
	set pre [clock milliseconds]
	##Log pre socket opened, - token $token
	##Log [concat $defcmd $sockopts $targetAddr] - token $token
	if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
	    # Something went wrong while trying to establish the connection.
        if {[catch {eval $defcmd $sockopts $targetAddr} sock]} {
	    # something went wrong while trying to establish the connection.
	    # Clean up after events and such, but DON'T call the command
	    # callback (if available) because we're going to throw an
	    # exception from here instead.

	    set state(sock) NONE
	    Finish $token $sock 1
	    set state(sock) $sock
	    Finish $token "" 1
	    cleanup $token
	    dict unset errdict -level
	    return -options $errdict $sock
	    return -code error $sock
	} else {
	    # Initialisation of a new socket.
	    ##Log post socket opened, - token $token
	    ##Log socket opened, now fconfigure - token $token
	    set delay [expr {[clock milliseconds] - $pre}]
	    if {$delay > 3000} {
		Log socket delay $delay - token $token
	    }
        }
	    fconfigure $sock -translation {auto crlf} \
			     -buffersize $state(-blocksize)
	    ##Log socket opened, DONE fconfigure - token $token
	}
    }
    }
    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
    # issue with my (KJN's) system (Fedora Linux).
    # This does not cause a problem (unless the request times out when this
    # command returns).

    set state(sock) $sock
    Log "Using $sock for $state(socketinfo) - token $token" \
	[expr {$state(-keepalive)?"keepalive":""}]
    Log "Using $sock for $state(socketinfo)" \
        [expr {$state(-keepalive)?"keepalive":""}]

    if {    $state(-keepalive)
    if {$state(-keepalive)} {
	 && (![info exists socketMapping($state(socketinfo))])
    } {
	# Freshly-opened socket that we would like to become persistent.
	set socketMapping($state(socketinfo)) $sock
        set socketmap($state(socketinfo)) $sock

	if {![info exists socketRdState($state(socketinfo))]} {
	    set socketRdState($state(socketinfo)) {}
	    set varName ::http::socketRdState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelReadPipeline
	}
	if {![info exists socketWrState($state(socketinfo))]} {
	    set socketWrState($state(socketinfo)) {}
	    set varName ::http::socketWrState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelWritePipeline
	}

	if {$state(-pipeline)} {
	    #Log new, init for pipelined, GRANT write access to $token in geturl
	    # Also grant premature read access to the socket. This is OK.
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	} else {
	    # socketWrState is not used by this non-pipelined transaction.
	    # We cannot leave it as "Wready" because the next call to
	    # http::geturl with a pipelined transaction would conclude that the
	    # socket is available for writing.
	    #Log new, init for nonpipeline, GRANT r/w access to $token in geturl
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	set socketRdQueue($state(socketinfo)) {}
	set socketWrQueue($state(socketinfo)) {}
	set socketClosing($state(socketinfo)) 0
	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    }

    if {![info exists phost]} {
	set phost ""
    }
    if {$reusing} {
	# For use by http::ReplayIfDead if the persistent connection has died.
	# Also used by NextPipelinedWrite.
	set state(tmpConnArgs) [list $proto $phost $srvurl]
    }

    # The element socketWrState($connId) has a value which is either the name of
    # the token that is permitted to write to the socket, or "Wready" if no
    # token is permitted to write.
    #
    # The code that sets the value to Wready immediately calls
    # http::NextPipelinedWrite, which examines socketWrQueue($connId) and
    # processes the next request in the queue, if there is one.  The value
    # Wready is not found when the interpreter is in the event loop unless the
    # socket is idle.
    #
    # The element socketRdState($connId) has a value which is either the name of
    # the token that is permitted to read from the socket, or "Rready" if no
    # token is permitted to read.
    #
    # The code that sets the value to Rready then examines
    # socketRdQueue($connId) and processes the next request in the queue, if
    # there is one.  The value Rready is not found when the interpreter is in
    # the event loop unless the socket is idle.

    if {$alreadyQueued} {
	# A write may or may not be in progress.  There is no need to set
	# socketWrState to prevent another call stealing write access - all
	# subsequent calls on this socket will come here because the socket
	# will close after the current read, and its
	# socketClosing($connId) is 1.
	##Log "HTTP request for token $token is queued"

    } elseif {    $reusing
	       && $state(-pipeline)
	       && ($socketWrState($state(socketinfo)) ne "Wready")
    } {
	##Log "HTTP request for token $token is queued for pipelined use"
	lappend socketWrQueue($state(socketinfo)) $token

    } elseif {    $reusing
	       && (!$state(-pipeline))
	       && ($socketWrState($state(socketinfo)) ne "Wready")
    } {
	# A write is queued or in progress.  Lappend to the write queue.
	##Log "HTTP request for token $token is queued for nonpipeline use"
	lappend socketWrQueue($state(socketinfo)) $token

    } elseif {    $reusing
	       && (!$state(-pipeline))
	       && ($socketWrState($state(socketinfo)) eq "Wready")
	       && ($socketRdState($state(socketinfo)) ne "Rready")
    } {
	# A read is queued or in progress, but not a write.  Cannot start the
	# nonpipeline transaction, but must set socketWrState to prevent a
	# pipelined request jumping the queue.
	##Log "HTTP request for token $token is queued for nonpipeline use"
	#Log re-use nonpipeline, GRANT delayed write access to $token in geturl

	set socketWrState($state(socketinfo)) peNding
	lappend socketWrQueue($state(socketinfo)) $token

    } else {
	if {$reusing && $state(-pipeline)} {
	    #Log re-use pipelined, GRANT write access to $token in geturl
	    set socketWrState($state(socketinfo)) $token

	} elseif {$reusing} {
	    # Cf tests above - both are ready.
	    #Log re-use nonpipeline, GRANT r/w access to $token in geturl
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	# All (!$reusing) cases come here, and also some $reusing cases if the
	# connection is ready.
	#Log ---- $state(socketinfo) << conn to $token for HTTP request (a)
	# Connect does its own fconfigure.
	fileevent $sock writable \
		[list http::Connect $token $proto $phost $srvurl]
    fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]
    }

    # Wait for the connection to complete.
    if {![info exists state(-command)]} {
	# geturl does EVERYTHING asynchronously, so if the user
	# calls it synchronously, we just do a wait here.
	http::wait $token

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
1348
620
621
622
623
624
625
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







-
+



-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+


-
-
-
-
-
-
-



-

-
-
-
-
-
-
+









-
-
+
+
-
-
-
+
-







	    # callback (if available) because we're going to throw an
	    # exception from here instead.
	    set err [lindex $state(error) 0]
	    cleanup $token
	    return -code error $err
	}
    }
    ##Log Leaving http::geturl - token $token

    return $token
}

# http::Connected --
#

#	Callback used when the connection to the HTTP server is actually
#	established.
#
# Arguments:
#	token	State token.
#	proto	What protocol (http, https, etc.) was used to connect.
#	phost	Are we using keep-alive? Non-empty if yes.
#	srvurl	Service-local URL that we're requesting
# Results:
#	None.

proc http::Connected {token proto phost srvurl} {
proc http::Connected { token proto phost srvurl} {
    variable http
    variable urlTypes
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]

    if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} {
	set state(after) [after $state(-timeout) \
		[list http::reset $token timeout]]
    }

    # Set back the variables needed here.
    # Set back the variables needed here
    set sock $state(sock)
    set isQueryChannel [info exists state(-querychannel)]
    set isQuery [info exists state(-query)]
    set host [lindex [split $state(socketinfo) :] 0]
    set port [lindex [split $state(socketinfo) :] 1]

    set lower [string tolower $proto]
    set defport [lindex $urlTypes($lower) 0]

    # Send data in cr-lf format, but accept any line terminators.
    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
    # Send data in cr-lf format, but accept any line terminators

    # We are concerned here with the request (write) not the response (read).
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list $trRead crlf] \
    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
		     -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket is
    # already in non-blocking mode in that case.

    catch {fconfigure $sock -blocking off}
    set how GET
    if {$isQuery} {
1360
1361
1362
1363
1364
1365
1366
1367

1368
1369
1370
1371
1372
1373
1374
1375
1376

1377


1378
1379
1380
1381

1382
1383
1384
1385
1386
1387
1388
1389
1390

1391
1392

1393
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

1439
1440
1441
1442




1443
1444
1445
1446
1447




1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485

1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506

1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526

1527
1528
1529
1530
1531
1532



1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544


1545
1546
1547
1548
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
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
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
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
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
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
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
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
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







-
+


-

-
-

-

+
-
+
+

-
-
-
+



-


-


+

-
+
-
-

-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+

-
+
-
-






-
-
-



+
+








-
+
-
-
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
+






-







-
-
-
-
-
-
-
+

-
-

-
-
-
-
-
-
-
-
-
-
-


-
-
-
+
-


-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+



-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+







    } elseif {$isQueryChannel} {
	set how POST
	# The query channel must be blocking for the async Write to
	# work properly.
	fconfigure $state(-querychannel) -blocking 1 -translation binary
	set contDone 0
    }
    if {[info exists state(-method)] && ($state(-method) ne "")} {
    if {[info exists state(-method)] && $state(-method) ne ""} {
	set how $state(-method)
    }
    set accept_types_seen 0

    Log ^B$tk begin sending request - token $token

    if {[catch {
	set state(method) $how
	puts $sock "$how $srvurl HTTP/$state(-protocol)"
	puts $sock "Accept: $http(-accept)"
	if {[dict exists $state(-headers) Host]} {
	array set hdrs $state(-headers)
	if {[info exists hdrs(Host)]} {
	    # Allow Host spoofing. [Bug 928154]
	    set hostHdr [dict get $state(-headers) Host]
	    regexp {^[^:]+} $hostHdr state(host)
	    puts $sock "Host: $hostHdr"
	    puts $sock "Host: $hdrs(Host)"
	} elseif {$port == $defport} {
	    # Don't add port in this case, to handle broken servers. [Bug
	    # #504508]
	    set state(host) $host
	    puts $sock "Host: $host"
	} else {
	    set state(host) $host
	    puts $sock "Host: $host:$port"
	}
	unset hdrs
	puts $sock "User-Agent: $http(-useragent)"
	if {($state(-protocol) > 1.0) && $state(-keepalive)} {
        if {$state(-protocol) == 1.0 && $state(-keepalive)} {
	    # Send this header, because a 1.1 server is not compelled to treat
	    # this as the default.
	    puts $sock "Connection: keep-alive"
	}
	if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
        }
        if {$state(-protocol) > 1.0 && !$state(-keepalive)} {
	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
	}
        }
	if {($state(-protocol) < 1.1)} {
	    # RFC7230 A.1
	    # Some server implementations of HTTP/1.0 have a faulty
	    # implementation of RFC 2068 Keep-Alive.
	    # Don't leave this to chance.
	    # For HTTP/1.0 we have already "set state(connection) close"
	    # and "state(-keepalive) 0".
	    puts $sock "Connection: close"
	}
        if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
	    puts $sock "Proxy-Connection: Keep-Alive"
        }
	# RFC7230 A.1 - "clients are encouraged not to send the
	# Proxy-Connection header field in any requests"
	set accept_encoding_seen 0
        set accept_encoding_seen 0
	set content_type_seen 0
	dict for {key value} $state(-headers) {
	foreach {key value} $state(-headers) {
	    set value [string map [list \n "" \r ""] $value]
	    set key [string map {" " -} [string trim $key]]
	    if {[string equal -nocase $key "host"]} {
		continue
	    }
	    if {[string equal -nocase $key "accept-encoding"]} {
		set accept_encoding_seen 1
	    }
	    if {[string equal -nocase $key "accept"]} {
		set accept_types_seen 1
	    }
	    if {[string equal -nocase $key "content-type"]} {
		set content_type_seen 1
	    }
	    set value [string map [list \n "" \r ""] $value]
	    set key [string trim $key]
	    if {[string equal -nocase $key "content-length"]} {
		set contDone 1
		set state(querylength) $value
	    }
	    if {[string length $key]} {
		puts $sock "$key: $value"
	    }
	}
	# Allow overriding the Accept header on a per-connection basis. Useful
	# Soft zlib dependency check - no package require
	# for working with REST services. [Bug c11a51c482]
	if {!$accept_types_seen} {
        if {
	    puts $sock "Accept: $state(accept-types)"
	}
	if {    (!$accept_encoding_seen)
	     && (![info exists state(-handler)])
	    !$accept_encoding_seen &&
	    ([package vsatisfies [package provide Tcl] 8.6]
		|| [llength [package provide zlib]]) &&
	    !([info exists state(-channel)] || [info exists state(-handler)])
	     && $http(-zip)
	} {
	    puts $sock "Accept-Encoding: gzip,deflate,compress"
	}
	if {$isQueryChannel && ($state(querylength) == 0)} {
        } then {
	    puts $sock "Accept-Encoding: gzip, identity, *;q=0.1"
        }
	if {$isQueryChannel && $state(querylength) == 0} {
	    # Try to determine size of data in channel. If we cannot seek, the
	    # surrounding catch will trap us

	    set start [tell $state(-querychannel)]
	    seek $state(-querychannel) 0 end
	    set state(querylength) \
		    [expr {[tell $state(-querychannel)] - $start}]
	    seek $state(-querychannel) $start
	}

	# Note that we don't do Cookie2; that's much nastier and not normally
	# observed in practice either. It also doesn't fix the multitude of
	# bugs in the basic cookie spec.
	if {$http(-cookiejar) ne ""} {
	    set cookies ""
	    set separator ""
	    foreach {key value} [{*}$http(-cookiejar) \
		    getCookies $proto $host $state(path)] {
		append cookies $separator $key = $value
		set separator "; "
	    }
	    if {$cookies ne ""} {
		puts $sock "Cookie: $cookies"
	    }
	}

	# Flush the request header and set up the fileevent that will either
	# push the POST data or read the response.
	#
	# fileevent note:
	#
	# It is possible to have both the read and write fileevents active at
	# this point. The only scenario it seems to affect is a server that
	# closes the connection without reading the POST data. (e.g., early
	# versions TclHttpd in various error cases). Depending on the
	# platform, the client may or may not be able to get the response from
	# the server because of the error it will get trying to write the post
	# data. Having both fileevents active changes the timing and the
	# data.  Having both fileevents active changes the timing and the
	# behavior, but no two platforms (among Solaris, Linux, and NT) behave
	# the same, and none behave all that well in any case. Servers should
	# always read their POST data if they expect the client to read their
	# response.

	if {$isQuery || $isQueryChannel} {
	    # POST method.
	    if {!$content_type_seen} {
		puts $sock "Content-Type: $state(-type)"
	    }
	    if {!$contDone} {
		puts $sock "Content-Length: $state(querylength)"
	    }
	    puts $sock ""
	    flush $sock
	    # Flush flushes the error in the https case with a bad handshake:
	    # else the socket never becomes writable again, and hangs until
	    # timeout (if any).

	    lassign [fconfigure $sock -translation] trRead trWrite
	    fconfigure $sock -translation [list $trRead binary]
	    fconfigure $sock -translation {auto binary}
	    fileevent $sock writable [list http::Write $token]
	    # The http::Write command decides when to make the socket readable,
	    # using the same test as the GET/HEAD case below.
	} else {
	    # GET or HEAD method.
	    if {    (![catch {fileevent $sock readable} binding])
		 && ($binding eq [list http::CheckEof $sock])
	    } {
		# Remove the "fileevent readable" binding of an idle persistent
		# socket to http::CheckEof.  We can no longer treat bytes
		# received as junk. The server might still time out and
		# half-close the socket if it has not yet received the first
		# "puts".
		fileevent $sock readable {}
	    }
	    puts $sock ""
	    flush $sock
	    Log ^C$tk end sending request - token $token
	    # End of writing (GET/HEAD methods).  The request has been sent.

	    fileevent $sock readable [list http::Event $sock $token]
	    DoneRequest $token
	}

    } err]} {
	# The socket probably was never connected, OR the connection dropped
	# later, OR https handshake error, which may be discovered as late as
    } err]} then {
	# The socket probably was never connected, or the connection dropped
	# later.
	# the "flush" command above...
	Log "WARNING - if testing, pay special attention to this\
		case (GI) which is seldom executed - token $token"
	if {[info exists state(reusing)] && $state(reusing)} {
	    # The socket was closed at the server end, and closed at
	    # this end by http::CheckEof.
    	    if {[TestForReplay $token write $err a]} {
		return
	    } else {
		Finish $token {failed to re-use socket}
	    }


	# if state(status) is error, it means someone's already called Finish
	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	} elseif {$state(status) eq ""} {
	    # ...https handshake errors come here.
	    set msg [registerError $sock]
	    registerError $sock {}
	    if {$msg eq {}} {
		set msg {failed to use socket}
	# to do the above-described clean up.
	    }
	    Finish $token $msg
	} elseif {$state(status) ne "error"} {
	if {$state(status) ne "error"} {
	    Finish $token $err
	}
    }
}


# http::registerError
#
#	Called (for example when processing TclTLS activity) to register
#	an error for a connection on a specific socket.  This helps
#	http::Connected to deliver meaningful error messages, e.g. when a TLS
#	certificate fails verification.
#
#	Usage: http::registerError socket ?newValue?
#
#	"set" semantics, except that a "get" (a call without a new value) for a
#	non-existent socket returns {}, not an error.

proc http::registerError {sock args} {
    variable registeredErrors

    if {    ([llength $args] == 0)
	 && (![info exists registeredErrors($sock)])
    } {
	return
    } elseif {    ([llength $args] == 1)
	       && ([lindex $args 0] eq {})
    } {
	unset -nocomplain registeredErrors($sock)
	return
    }
    set registeredErrors($sock) {*}$args
}

# http::DoneRequest --
#
#	Command called when a request has been sent.  It will arrange the
#	next request and/or response as appropriate.
#
#	If this command is called when $socketClosing(*), the request $token
#	that calls it must be pipelined and destined to fail.

proc http::DoneRequest {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # If pipelined, connect the next HTTP request to the socket.
    if {$state(reusing) && $state(-pipeline)} {
	# Enable next token (if any) to write.
	# The value "Wready" is set only here, and
	# in http::Event after reading the response-headers of a
	# non-reusing transaction.
	# Previous value is $token. It cannot be pending.
	set socketWrState($state(socketinfo)) Wready

	# Now ready to write the next pipelined request (if any).
	http::NextPipelinedWrite $token
    } else {
	# If pipelined, this is the first transaction on this socket.  We wait
	# for the response headers to discover whether the connection is
	# persistent.  (If this is not done and the connection is not
	# persistent, we SHOULD retry and then MUST NOT pipeline before knowing
	# that we have a persistent connection
	# (rfc2616 8.1.2.2)).
    }

    # Connect to receive the response, unless the socket is pipelined
    # and another response is being sent.
    # This code block is separate from the code below because there are
    # cases where socketRdState already has the value $token.
    if {    $state(-keepalive)
	 && $state(-pipeline)
	 && [info exists socketRdState($state(socketinfo))]
	 && ($socketRdState($state(socketinfo)) eq "Rready")
    } {
	#Log pipelined, GRANT read access to $token in Connected
	set socketRdState($state(socketinfo)) $token
    }

    if {    $state(-keepalive)
	 && $state(-pipeline)
	 && [info exists socketRdState($state(socketinfo))]
	 && ($socketRdState($state(socketinfo)) ne $token)
    } {
	# Do not read from the socket until it is ready.
	##Log "HTTP response for token $token is queued for pipelined use"
	# If $socketClosing(*), then the caller will be a pipelined write and
	# execution will come here.
	# This token has already been recorded as "in flight" for writing.
	# When the socket is closed, the read queue will be cleared in
	# CloseQueuedQueries and so the "lappend" here has no effect.
	lappend socketRdQueue($state(socketinfo)) $token
    } else {
	# In the pipelined case, connection for reading depends on the
	# value of socketRdState.
	# In the nonpipeline case, connection for reading always occurs.
	ReceiveResponse $token
    }
}

# http::ReceiveResponse
#
#	Connects token to its socket for reading.

proc http::ReceiveResponse {token} {
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
    lassign [fconfigure $sock -translation] trRead trWrite
    fconfigure $sock -translation [list auto $trWrite] \
		     -buffersize $state(-blocksize)
    Log ^D$tk begin receiving response - token $token

    coroutine ${token}EventCoroutine http::Event $sock $token
    if {[info exists state(-handler)] || [info exists state(-progress)]} {
        fileevent $sock readable [list http::EventGateway $sock $token]
    } else {
        fileevent $sock readable ${token}EventCoroutine
    }
    return
}


# http::EventGateway
#
#	Bug [c2dc1da315].
#	- Recursive launch of the coroutine can occur if a -handler or -progress
#	  callback is used, and the callback command enters the event loop.
#	- To prevent this, the fileevent "binding" is disabled while the
#	  coroutine is in flight.
#	- If a recursive call occurs despite these precautions, it is not
#	  trapped and discarded here, because it is better to report it as a
#	  bug.
#	- Although this solution is believed to be sufficiently general, it is
#	  used only if -handler or -progress is specified.  In other cases,
#	  the coroutine is called directly.

proc http::EventGateway {sock token} {
    variable $token
    upvar 0 $token state
    fileevent $sock readable {}
    catch {${token}EventCoroutine} res opts
    if {[info commands ${token}EventCoroutine] ne {}} {
        # The coroutine can be deleted by completion (a non-yield return), by
        # http::Finish (when there is a premature end to the transaction), by
        # http::reset or http::cleanup, or if the caller set option -channel
        # but not option -handler: in the last case reading from the socket is
        # now managed by commands ::http::Copy*, http::ReceiveChunked, and
        # http::make-transformation-chunked.
        #
        # Catch in case the coroutine has closed the socket.
        catch {fileevent $sock readable [list http::EventGateway $sock $token]}
    }

    # If there was an error, re-throw it.
    return -options $opts $res
}


# http::NextPipelinedWrite
#
# - Connecting a socket to a token for writing is done by this command and by
#   command KeepSocket.
# - If another request has a pipelined write scheduled for $token's socket,
#   and if the socket is ready to accept it, connect the write and update
#   the queue accordingly.
# - This command is called from http::DoneRequest and http::Event,
#   IF $state(-pipeline) AND (the current transfer has reached the point at
#   which the socket is ready for the next request to be written).
# - This command is called when a token has write access and is pipelined and
#   keep-alive, and sets socketWrState to Wready.
# - The command need not consider the case where socketWrState is set to a token
#   that does not yet have write access.  Such a token is waiting for Rready,
#   and the assignment of the connection to the token will be done elsewhere (in
#   http::KeepSocket).
# - This command cannot be called after socketWrState has been set to a
#   "pending" token value (that is then overwritten by the caller), because that
#   value is set by this command when it is called by an earlier token when it
#   relinquishes its write access, and the pending token is always the next in
#   line to write.

proc http::NextPipelinedWrite {token} {
    variable http
    variable socketRdState
    variable socketWrState
    variable socketWrQueue
    variable socketClosing
    variable $token
    upvar 0 $token state
    set connId $state(socketinfo)

    if {    [info exists socketClosing($connId)]
	 && $socketClosing($connId)
    } {
	# socketClosing(*) is set because the server has sent a
	# "Connection: close" header.
	# Behave as if the queues are empty - so do nothing.
    } elseif {    $state(-pipeline)
	 && [info exists socketWrState($connId)]
	 && ($socketWrState($connId) eq "Wready")

	 && [info exists socketWrQueue($connId)]
	 && [llength $socketWrQueue($connId)]
	 && ([set token2 [lindex $socketWrQueue($connId) 0]
	      set ${token2}(-pipeline)
	     ]
	    )
    } {
	# - The usual case for a pipelined connection, ready for a new request.
	#Log pipelined, GRANT write access to $token2 in NextPipelinedWrite
	set conn [set ${token2}(tmpConnArgs)]
	set socketWrState($connId) $token2
	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	# Connect does its own fconfigure.
	fileevent $state(sock) writable [list http::Connect $token2 {*}$conn]
	#Log ---- $connId << conn to $token2 for HTTP request (b)

	# In the tests below, the next request will be nonpipeline.
    } elseif {    $state(-pipeline)
	       && [info exists socketWrState($connId)]
	       && ($socketWrState($connId) eq "Wready")

	       && [info exists socketWrQueue($connId)]
	       && [llength $socketWrQueue($connId)]
	       && (![ set token3 [lindex $socketWrQueue($connId) 0]
		      set ${token3}(-pipeline)
		    ]
		  )

	       && [info exists socketRdState($connId)]
	       && ($socketRdState($connId) eq "Rready")
    } {
	# The case in which the next request will be non-pipelined, and the read
	# and write queues is ready: which is the condition for a non-pipelined
	# write.
	variable $token3
	upvar 0 $token3 state3
	set conn [set ${token3}(tmpConnArgs)]
	#Log nonpipeline, GRANT r/w access to $token3 in NextPipelinedWrite
	set socketRdState($connId) $token3
	set socketWrState($connId) $token3
	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
	# Connect does its own fconfigure.
	fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
	#Log ---- $state(sock) << conn to $token3 for HTTP request (c)

    } elseif {    $state(-pipeline)
	 && [info exists socketWrState($connId)]
	 && ($socketWrState($connId) eq "Wready")

	 && [info exists socketWrQueue($connId)]
	 && [llength $socketWrQueue($connId)]
	 && (![set token2 [lindex $socketWrQueue($connId) 0]
	      set ${token2}(-pipeline)
	     ]
	    )
    } {
	# - The case in which the next request will be non-pipelined, but the
	#   read queue is NOT ready.
	# - A read is queued or in progress, but not a write.  Cannot start the
	#   nonpipeline transaction, but must set socketWrState to prevent a new
	#   pipelined request (in http::geturl) jumping the queue.
	# - Because socketWrState($connId) is not set to Wready, the assignment
	#   of the connection to $token2 will be done elsewhere - by command
	#   http::KeepSocket when $socketRdState($connId) is set to "Rready".

	#Log re-use nonpipeline, GRANT delayed write access to $token in NextP..
	set socketWrState($connId) peNding
    }
}

# http::CancelReadPipeline
#
#	Cancel pipelined responses on a closing "Keep-Alive" socket.
#
#	- Called by a variable trace on "unset socketRdState($connId)".
#	- The variable relates to a Keep-Alive socket, which has been closed.
#	- Cancels all pipelined responses. The requests have been sent,
#	  the responses have not yet been received.
#	- This is a hard cancel that ends each transaction with error status,
#	  and closes the connection. Do not use it if you want to replay failed
#	  transactions.
#	- N.B. Always delete ::http::socketRdState($connId) before deleting
#	  ::http::socketRdQueue($connId), or this command will do nothing.
#
# Arguments
#	As for a trace command on a variable.

proc http::CancelReadPipeline {name1 connId op} {
    variable socketRdQueue
    ##Log CancelReadPipeline $name1 $connId $op
    if {[info exists socketRdQueue($connId)]} {
	set msg {the connection was closed by CancelReadPipeline}
	foreach token $socketRdQueue($connId) {
	    set tk [namespace tail $token]
	    Log ^X$tk end of response "($msg)" - token $token
	    set ${token}(status) eof
	    Finish $token ;#$msg
	}
	set socketRdQueue($connId) {}
    }
}

# http::CancelWritePipeline
#
#	Cancel queued events on a closing "Keep-Alive" socket.
#
#	- Called by a variable trace on "unset socketWrState($connId)".
#	- The variable relates to a Keep-Alive socket, which has been closed.
#	- In pipelined or nonpipeline case: cancels all queued requests.  The
#	  requests have not yet been sent, the responses are not due.
#	- This is a hard cancel that ends each transaction with error status,
#	  and closes the connection. Do not use it if you want to replay failed
#	  transactions.
#	- N.B. Always delete ::http::socketWrState($connId) before deleting
#	  ::http::socketWrQueue($connId), or this command will do nothing.
#
# Arguments
#	As for a trace command on a variable.

proc http::CancelWritePipeline {name1 connId op} {
    variable socketWrQueue

    ##Log CancelWritePipeline $name1 $connId $op
    if {[info exists socketWrQueue($connId)]} {
	set msg {the connection was closed by CancelWritePipeline}
	foreach token $socketWrQueue($connId) {
	    set tk [namespace tail $token]
	    Log ^X$tk end of response "($msg)" - token $token
	    set ${token}(status) eof
	    Finish $token ;#$msg
	}
	set socketWrQueue($connId) {}
    }
}

# http::ReplayIfDead --
#
# - A query on a re-used persistent socket failed at the earliest opportunity,
#   because the socket had been closed by the server.  Keep the token, tidy up,
#   and try to connect on a fresh socket.
# - The connection is monitored for eof by the command http::CheckEof.  Thus
#   http::ReplayIfDead is needed only when a server event (half-closing an
#   apparently idle connection), and a client event (sending a request) occur at
#   almost the same time, and neither client nor server detects the other's
#   action before performing its own (an "asynchronous close event").
# - To simplify testing of http::ReplayIfDead, set TEST_EOF 1 in
#   http::KeepSocket, and then http::ReplayIfDead will be called if http::geturl
#   is called at any time after the server timeout.
#
# Arguments:
#	token	Connection token.
#
# Side Effects:
#	Use the same token, but try to open a new socket.

proc http::ReplayIfDead {tokenArg doing} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $tokenArg
    upvar 0 $tokenArg stateArg

    Log running http::ReplayIfDead for $tokenArg $doing

    # 1. Merge the tokens for transactions in flight, the read (response) queue,
    #    and the write (request) queue.

    set InFlightR {}
    set InFlightW {}

    # Obtain the tokens for transactions in flight.
    if {$stateArg(-pipeline)} {
	# Two transactions may be in flight.  The "read" transaction was first.
	# It is unlikely that the server would close the socket if a response
	# was pending; however, an earlier request (as well as the present
	# request) may have been sent and ignored if the socket was half-closed
	# by the server.

	if {    [info exists socketRdState($stateArg(socketinfo))]
	     && ($socketRdState($stateArg(socketinfo)) ne "Rready")
	} {
	    lappend InFlightR $socketRdState($stateArg(socketinfo))
	} elseif {($doing eq "read")} {
	    lappend InFlightR $tokenArg
	}

	if {    [info exists socketWrState($stateArg(socketinfo))]
	     && $socketWrState($stateArg(socketinfo)) ni {Wready peNding}
	} {
	    lappend InFlightW $socketWrState($stateArg(socketinfo))
	} elseif {($doing eq "write")} {
	    lappend InFlightW $tokenArg
	}

	# Report any inconsistency of $tokenArg with socket*state.
	if {    ($doing eq "read")
	     && [info exists socketRdState($stateArg(socketinfo))]
	     && ($tokenArg ne $socketRdState($stateArg(socketinfo)))
	} {
	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
		    ne socketRdState($stateArg(socketinfo)) \
		      $socketRdState($stateArg(socketinfo))

	} elseif {
		($doing eq "write")
	     && [info exists socketWrState($stateArg(socketinfo))]
	     && ($tokenArg ne $socketWrState($stateArg(socketinfo)))
	} {
	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
		    ne socketWrState($stateArg(socketinfo)) \
		      $socketWrState($stateArg(socketinfo))
	}
    } else {
	# One transaction should be in flight.
	# socketRdState, socketWrQueue are used.
	# socketRdQueue should be empty.

	# Report any inconsistency of $tokenArg with socket*state.
	if {$tokenArg ne $socketRdState($stateArg(socketinfo))} {
	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
		    ne socketRdState($stateArg(socketinfo)) \
		      $socketRdState($stateArg(socketinfo))
	}

	# Report the inconsistency that socketRdQueue is non-empty.
	if {    [info exists socketRdQueue($stateArg(socketinfo))]
	     && ($socketRdQueue($stateArg(socketinfo)) ne {})
	} {
	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
		    has read queue socketRdQueue($stateArg(socketinfo)) \
		    $socketRdQueue($stateArg(socketinfo)) ne {}
	}

	lappend InFlightW $socketRdState($stateArg(socketinfo))
	set socketRdQueue($stateArg(socketinfo)) {}
    }

    set newQueue {}
    lappend newQueue {*}$InFlightR
    lappend newQueue {*}$socketRdQueue($stateArg(socketinfo))
    lappend newQueue {*}$InFlightW
    lappend newQueue {*}$socketWrQueue($stateArg(socketinfo))


    # 2. Tidy up tokenArg.  This is a cut-down form of Finish/CloseSocket.
    #    Do not change state(status).
    #    No need to after cancel stateArg(after) - either this is done in
    #    ReplayCore/ReInit, or Finish is called.

    catch {close $stateArg(sock)}

    # 2a. Tidy the tokens in the queues - this is done in ReplayCore/ReInit.
    # - Transactions, if any, that are awaiting responses cannot be completed.
    #   They are listed for re-sending in newQueue.
    # - All tokens are preserved for re-use by ReplayCore, and their variables
    #   will be re-initialised by calls to ReInit.
    # - The relevant element of socketMapping, socketRdState, socketWrState,
    #   socketRdQueue, socketWrQueue, socketClosing, socketPlayCmd will be set
    #   to new values in ReplayCore.

    ReplayCore $newQueue
}

# http::ReplayIfClose --
#
#	A request on a socket that was previously "Connection: keep-alive" has
#	received a "Connection: close" response header.  The server supplies
#	that response correctly, but any later requests already queued on this
#	connection will be lost when the socket closes.
#
#	This command takes arguments that represent the socketWrState,
#	socketRdQueue and socketWrQueue for this connection.  The socketRdState
#	is not needed because the server responds in full to the request that
#	received the "Connection: close" response header.
#
#	Existing request tokens $token (::http::$n) are preserved.  The caller
#	will be unaware that the request was processed this way.

proc http::ReplayIfClose {Wstate Rqueue Wqueue} {
    Log running http::ReplayIfClose for $Wstate $Rqueue $Wqueue

    if {$Wstate in $Rqueue || $Wstate in $Wqueue} {
	Log WARNING duplicate token in http::ReplayIfClose - token $Wstate
	set Wstate Wready
    }

    # 1. Create newQueue
    set InFlightW {}
    if {$Wstate ni {Wready peNding}} {
	lappend InFlightW $Wstate
    }

    set newQueue {}
    lappend newQueue {*}$Rqueue
    lappend newQueue {*}$InFlightW
    lappend newQueue {*}$Wqueue

    # 2. Cleanup - none needed, done by the caller.

    ReplayCore $newQueue
}

# http::ReInit --
#
#	Command to restore a token's state to a condition that
#	makes it ready to replay a request.
#
#	Command http::geturl stores extra state in state(tmp*) so
#	we don't need to do the argument processing again.
#
#	The caller must:
#	- Set state(reusing) and state(sock) to their new values after calling
#	  this command.
#	- Unset state(tmpState), state(tmpOpenCmd) if future calls to ReplayCore
#	  or ReInit are inappropriate for this token. Typically only one retry
#	  is allowed.
#	The caller may also unset state(tmpConnArgs) if this value (and the
#	token) will be used immediately.  The value is needed by tokens that
#	will be stored in a queue.
#
# Arguments:
#	token	Connection token.
#
# Return Value: (boolean) true iff the re-initialisation was successful.

proc http::ReInit {token} {
    variable $token
    upvar 0 $token state

    if {!(
	      [info exists state(tmpState)]
	   && [info exists state(tmpOpenCmd)]
	   && [info exists state(tmpConnArgs)]
	 )
    } {
	Log FAILED in http::ReInit via ReplayCore - NO tmp vars for $token
	return 0
    }

    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }

    # Don't alter state(status) - this would trigger http::wait if it is in use.
    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    foreach name [array names state] {
	if {$name ne "status"} {
	    unset state($name)
	}
    }

    # Don't alter state(status).
    # Restore state(tmp*) - the caller may decide to unset them.
    # Restore state(tmpConnArgs) which is needed for connection.
    # state(tmpState), state(tmpOpenCmd) are needed only for retries.

    dict unset tmpState status
    array set state $tmpState
    set state(tmpState)    $tmpState
    set state(tmpOpenCmd)  $tmpOpenCmd
    set state(tmpConnArgs) $tmpConnArgs

    return 1
}

# http::ReplayCore --
#
#	Command to replay a list of requests, using existing connection tokens.
#
#	Abstracted from http::geturl which stores extra state in state(tmp*) so
#	we don't need to do the argument processing again.
#
# Arguments:
#	newQueue	List of connection tokens.
#
# Side Effects:
#	Use existing tokens, but try to open a new socket.

proc http::ReplayCore {newQueue} {
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    if {[llength $newQueue] == 0} {
	# Nothing to do.
	return
    }

    ##Log running ReplayCore for {*}$newQueue
    set newToken [lindex $newQueue 0]
    set newQueue [lrange $newQueue 1 end]

    # 3. Use newToken, and restore its values of state(*).  Do not restore
    #    elements tmp* - we try again only once.

    set token $newToken
    variable $token
    upvar 0 $token state

    if {![ReInit $token]} {
	Log FAILED in http::ReplayCore - NO tmp vars
	Finish $token {cannot send this request again}
	return
    }

    set tmpState    $state(tmpState)
    set tmpOpenCmd  $state(tmpOpenCmd)
    set tmpConnArgs $state(tmpConnArgs)
    unset state(tmpState)
    unset state(tmpOpenCmd)
    unset state(tmpConnArgs)

    set state(reusing) 0

    if {$state(-timeout) > 0} {
	set resetCmd [list http::reset $token timeout]
	set state(after) [after $state(-timeout) $resetCmd]
    }

    set pre [clock milliseconds]
    ##Log pre socket opened, - token $token
    ##Log $tmpOpenCmd - token $token
    # 4. Open a socket.
    if {[catch {eval $tmpOpenCmd} sock]} {
	# Something went wrong while trying to establish the connection.
	Log FAILED - $sock
	set state(sock) NONE
	Finish $token $sock
	return
    }
    ##Log post socket opened, - token $token
    set delay [expr {[clock milliseconds] - $pre}]
    if {$delay > 3000} {
	Log socket delay $delay - token $token
    }
    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
    # issue with my (KJN's) system (Fedora Linux).
    # This does not cause a problem (unless the request times out when this
    # command returns).

    # 5. Configure the persistent socket data.
    if {$state(-keepalive)} {
	set socketMapping($state(socketinfo)) $sock

	if {![info exists socketRdState($state(socketinfo))]} {
	    set socketRdState($state(socketinfo)) {}
	    set varName ::http::socketRdState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelReadPipeline
	}

	if {![info exists socketWrState($state(socketinfo))]} {
	    set socketWrState($state(socketinfo)) {}
	    set varName ::http::socketWrState($state(socketinfo))
	    trace add variable $varName unset ::http::CancelWritePipeline
	}

	if {$state(-pipeline)} {
	    #Log new, init for pipelined, GRANT write acc to $token ReplayCore
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	} else {
	    #Log new, init for nonpipeline, GRANT r/w acc to $token ReplayCore
	    set socketRdState($state(socketinfo)) $token
	    set socketWrState($state(socketinfo)) $token
	}

	set socketRdQueue($state(socketinfo)) {}
	set socketWrQueue($state(socketinfo)) $newQueue
	set socketClosing($state(socketinfo)) 0
	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
    }

    ##Log pre newQueue ReInit, - token $token
    # 6. Configure sockets in the queue.
    foreach tok $newQueue {
	if {[ReInit $tok]} {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) $sock
	} else {
	    set ${tok}(reusing) 1
	    set ${tok}(sock) NONE
	    Finish $token {cannot send this request again}
	}
    }

    # 7. Configure the socket for newToken to send a request.
    set state(sock) $sock
    Log "Using $sock for $state(socketinfo) - token $token" \
	[expr {$state(-keepalive)?"keepalive":""}]

    # Initialisation of a new socket.
    ##Log socket opened, now fconfigure - token $token
    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
    ##Log socket opened, DONE fconfigure - token $token

    # Connect does its own fconfigure.
    fileevent $sock writable [list http::Connect $token {*}$tmpConnArgs]
    #Log ---- $sock << conn to $token for HTTP request (e)
}

# Data access functions:
# Data - the URL data
# Status - the transaction status: ok, reset, eof, timeout, error
# Status - the transaction status: ok, reset, eof, timeout
# Code - the HTTP transaction code, e.g., 200
# Size - the size of the URL data

proc http::data {token} {
    variable $token
    upvar 0 $token state
    return $state(body)
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
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
2658
2659
2660
2661
2662
2663

2664
2665
2666
2667

2668
2669
2670
2671
2672

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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719



2720
2721
2722
2723
2724
2725




2726
2727
2728
2729
2730
2731
2732



2733
2734

2735
2736

2737
2738
2739
2740
2741
2742
2743










2744
2745
2746
2747
2748
2749
2750









2751
2752
2753
2754



2755
2756
2757


2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784


























2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810

2811
2812
2813
2814

2815
2816
2817
2818
2819
2820
2821
2822







2823
2824
2825
2826



2827
2828
2829
2830
2831
2832

2833
2834

2835
2836
2837


2838
2839


2840
2841
2842
2843
2844
2845
2846

2847
2848

2849
2850
2851

2852
2853
2854
2855
2856
2857
2858
2859

2860
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
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
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
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
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







-
-
-
-
-
-
-



















-




-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-



+













-
-
-
-
-
-
-
-
-


-










-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-












-
-
-
-
-
-
-
-
-
-
-
-
-






-
+






-



-
-
-
+
-












-
+
-
-









-
-
-
-
-
-
-
-
-


-
-
-
-

-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
+

-
+

-
-
+
+
-
-
-
-
-
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+

-
+
-
-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
+
-
-
+
-
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







#
# Side Effects
#	unsets the state array

proc http::cleanup {token} {
    variable $token
    upvar 0 $token state
    if {[info commands ${token}EventCoroutine] ne {}} {
	rename ${token}EventCoroutine {}
    }
    if {[info exists state(after)]} {
	after cancel $state(after)
	unset state(after)
    }
    if {[info exists state]} {
	unset state
    }
}

# http::Connect
#
#	This callback is made when an asyncronous connection completes.
#
# Arguments
#	token	The token returned from http::geturl
#
# Side Effects
#	Sets the status of the connection, which unblocks
# 	the waiting geturl call

proc http::Connect {token proto phost srvurl} {
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set err "due to unexpected EOF"
    if {
	[eof $state(sock)] ||
	[set err [fconfigure $state(sock) -error]] ne ""
    } {
    } then {
	Log "WARNING - if testing, pay special attention to this\
		case (GJ) which is seldom executed - token $token"
	if {[info exists state(reusing)] && $state(reusing)} {
	    # The socket was closed at the server end, and closed at
	    # this end by http::CheckEof.
	    if {[TestForReplay $token write $err b]} {
		return
	    }

	    # else:
	    # This is NOT a persistent socket that has been closed since its
	    # last use.
	    # If any other requests are in flight or pipelined/queued, they will
	    # be discarded.
	}
	Finish $token "connect failed $err"
    } else {
	set state(state) connecting
	fileevent $state(sock) writable {}
	::http::Connected $token $proto $phost $srvurl
    }
    return
}

# http::Write
#
#	Write POST query data to the socket
#
# Arguments
#	token	The token for the connection
#
# Side Effects
#	Write the socket and handle callbacks.

proc http::Write {token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    set sock $state(sock)

    # Output a block.  Tcl will buffer this if the socket blocks
    set done 0
    if {[catch {
	# Catch I/O errors on dead sockets

	if {[info exists state(-query)]} {
	    # Chop up large query strings so queryprogress callback can give
	    # smooth feedback.
	    if {    $state(queryoffset) + $state(-queryblocksize)
		 >= $state(querylength)
	    } {
		# This will be the last puts for the request-body.
		if {    (![catch {fileevent $sock readable} binding])
		     && ($binding eq [list http::CheckEof $sock])
		} {
		    # Remove the "fileevent readable" binding of an idle
		    # persistent socket to http::CheckEof.  We can no longer
		    # treat bytes received as junk. The server might still time
		    # out and half-close the socket if it has not yet received
		    # the first "puts".
		    fileevent $sock readable {}
		}

	    }
	    puts -nonewline $sock \
		[string range $state(-query) $state(queryoffset) \
		     [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
	    incr state(queryoffset) $state(-queryblocksize)
	    if {$state(queryoffset) >= $state(querylength)} {
		set state(queryoffset) $state(querylength)
		set done 1
	    }
	} else {
	    # Copy blocks from the query channel

	    set outStr [read $state(-querychannel) $state(-queryblocksize)]
	    if {[eof $state(-querychannel)]} {
		# This will be the last puts for the request-body.
		if {    (![catch {fileevent $sock readable} binding])
		     && ($binding eq [list http::CheckEof $sock])
		} {
		    # Remove the "fileevent readable" binding of an idle
		    # persistent socket to http::CheckEof.  We can no longer
		    # treat bytes received as junk. The server might still time
		    # out and half-close the socket if it has not yet received
		    # the first "puts".
		    fileevent $sock readable {}
		}
	    }
	    puts -nonewline $sock $outStr
	    incr state(queryoffset) [string length $outStr]
	    if {[eof $state(-querychannel)]} {
		set done 1
	    }
	}
    } err]} {
    } err]} then {
	# Do not call Finish here, but instead let the read half of the socket
	# process whatever server reply there is to get.

	set state(posterror) $err
	set done 1
    }

    if {$done} {
	catch {flush $sock}
	fileevent $sock writable {}
	Log ^C$tk end sending request - token $token
	# End of writing (POST method).  The request has been sent.

	fileevent $sock readable [list http::Event $sock $token]
	DoneRequest $token
    }

    # Callback to the client after we've completely handled everything.

    if {[string length $state(-queryprogress)]} {
	eval $state(-queryprogress) \
	    [list $token $state(querylength) $state(queryoffset)]
    }
}

# http::Event
#
#	Handle input on the socket. This command is the core of
#	Handle input on the socket
#	the coroutine commands ${token}EventCoroutine that are
#	bound to "fileevent $sock readable" and process input.
#
# Arguments
#	sock	The socket receiving input.
#	token	The token returned from http::geturl
#
# Side Effects
#	Read the socket and handle callbacks.

proc http::Event {sock token} {
    variable http
    variable socketMapping
    variable socketRdState
    variable socketWrState
    variable socketRdQueue
    variable socketWrQueue
    variable socketClosing
    variable socketPlayCmd

    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    while 1 {
	yield
	##Log Event call - token $token

	if {![info exists state]} {
	    Log "Event $sock with invalid token '$token' - remote close?"
	    if {![eof $sock]} {
		if {[set d [read $sock]] ne ""} {
		    Log "WARNING: additional data left on closed socket\
    if {![info exists state]} {
	Log "Event $sock with invalid token '$token' - remote close?"
	if {![eof $sock]} {
	    if {[set d [read $sock]] ne ""} {
		Log "WARNING: additional data left on closed socket"
			    - token $token"
		}
	    }
	    }
	}
	    Log ^X$tk end of response (token error) - token $token
	    CloseSocket $sock
	    return
	}
	if {$state(state) eq "connecting"} {
	CloseSocket $sock
	return
    }
    if {$state(state) eq "connecting"} {
	    ##Log - connecting - token $token
	    if {    $state(reusing)
		 && $state(-pipeline)
		 && ($state(-timeout) > 0)
		 && (![info exists state(after)])
	    } {
		set state(after) [after $state(-timeout) \
			[list http::reset $token timeout]]
	    }

	    if {[catch {gets $sock state(http)} nsl]} {
	if {[catch {gets $sock state(http)} n]} {
		Log "WARNING - if testing, pay special attention to this\
			case (GK) which is seldom executed - token $token"
		if {[info exists state(reusing)] && $state(reusing)} {
		    # The socket was closed at the server end, and closed at
		    # this end by http::CheckEof.

		    if {[TestForReplay $token read $nsl c]} {
			return
		    }

		    # else:
		    # This is NOT a persistent socket that has been closed since
		    # its last use.
		    # If any other requests are in flight or pipelined/queued,
		    # they will be discarded.
		} else {
		    Log ^X$tk end of response (error) - token $token
		    Finish $token $nsl
	    return [Finish $token $n]
		    return
		}
	    } elseif {$nsl >= 0} {
		##Log - connecting 1 - token $token
		set state(state) "header"
	    } elseif {    [eof $sock]
		       && [info exists state(reusing)]
		       && $state(reusing)
	    } {
		# The socket was closed at the server end, and we didn't notice.
		# This is the first read - where the closure is usually first
		# detected.

		if {[TestForReplay $token read {} d]} {
		    return
		}

		# else:
		# This is NOT a persistent socket that has been closed since its
		# last use.
		# If any other requests are in flight or pipelined/queued, they
		# will be discarded.
	    }
	} elseif {$state(state) eq "header"} {
	    if {[catch {gets $sock line} nhl]} {
		##Log header failed - token $token
		Log ^X$tk end of response (error) - token $token
		Finish $token $nhl
		return
	    } elseif {$nhl == 0} {
		##Log header done - token $token
		Log ^E$tk end of response headers - token $token
		# We have now read all headers
		# We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
		if {    ($state(http) == "")
		     || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)
		} {
		    set state(state) "connecting"
	} elseif {$n >= 0} {
	    set state(state) "header"
		    continue
		    # This was a "return" in the pre-coroutine code.
		}

	}
    } elseif {$state(state) eq "header"} {
		if {    ([info exists state(connection)])
		     && ([info exists socketMapping($state(socketinfo))])
		     && ($state(connection) eq "keep-alive")
		     && ($state(-keepalive))
		     && (!$state(reusing))
		     && ($state(-pipeline))
		} {
		    # Response headers received for first request on a
		    # persistent socket.  Now ready for pipelined writes (if
		    # any).
		    # Previous value is $token. It cannot be "pending".
		    set socketWrState($state(socketinfo)) Wready
		    http::NextPipelinedWrite $token
		}

	if {[catch {gets $sock line} n]} {
		# Once a "close" has been signaled, the client MUST NOT send any
		# more requests on that connection.
		#
		# If either the client or the server sends the "close" token in
		# the Connection header, that request becomes the last one for
		# the connection.

	    return [Finish $token $n]
		if {    ([info exists state(connection)])
		     && ([info exists socketMapping($state(socketinfo))])
		     && ($state(connection) eq "close")
		     && ($state(-keepalive))
		} {
		    # The server warns that it will close the socket after this
		    # response.
		    ##Log WARNING - socket will close after response for $token
		    # Prepare data for a call to ReplayIfClose.
		    if {    ($socketRdQueue($state(socketinfo)) ne {})
			 || ($socketWrQueue($state(socketinfo)) ne {})
			 || ($socketWrState($state(socketinfo)) ni
						[list Wready peNding $token])
		    } {
			set InFlightW $socketWrState($state(socketinfo))
			if {$InFlightW in [list Wready peNding $token]} {
			    set InFlightW Wready
			} else {
	} elseif {$n == 0} {
			    set msg "token ${InFlightW} is InFlightW"
			    ##Log $msg - token $token
			}

	    # We have now read all headers
			set socketPlayCmd($state(socketinfo)) \
				[list ReplayIfClose $InFlightW \
				$socketRdQueue($state(socketinfo)) \
				$socketWrQueue($state(socketinfo))]

	    # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
			# - All tokens are preserved for re-use by ReplayCore.
			# - Queues are preserved in case of Finish with error,
			#   but are not used for anything else because
			#   socketClosing(*) is set below.
			# - Cancel the state(after) timeout events.
			foreach tokenVal $socketRdQueue($state(socketinfo)) {
			    if {[info exists ${tokenVal}(after)]} {
				after cancel [set ${tokenVal}(after)]
				unset ${tokenVal}(after)
			    }
			}

	    if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {
		    } else {
			set socketPlayCmd($state(socketinfo)) \
				{ReplayIfClose Wready {} {}}
		    }

		return
		    # Do not allow further connections on this socket.
		    set socketClosing($state(socketinfo)) 1
		}
	    }

		set state(state) body
	    set state(state) body

		# If doing a HEAD, then we won't get any body
		if {$state(-validate)} {
	    # If doing a HEAD, then we won't get any body
	    if {$state(-validate)} {
		    Log ^F$tk end of response for HEAD request - token $token
		    set state(state) complete
		    Eot $token
		    return
		}
		Eof $token
		return
	    }

		# - For non-chunked transfer we may have no body - in this case
		#   we may get no further file event if the connection doesn't
		#   close and no more data is sent. We can tell and must finish
		#   up now - not later - the alternative would be to wait until
	    # For non-chunked transfer we may have no body - in this case we
	    # may get no further file event if the connection doesn't close
	    # and no more data is sent. We can tell and must finish up now -
	    # not later.
		#   the server times out.
		# - In this case, the server has NOT told the client it will
		#   close the connection, AND it has NOT indicated the resource
		#   length EITHER by setting the Content-Length (totalsize) OR
		#   by using chunked Transfer-Encoding.
		# - Do not worry here about the case (Connection: close) because
		#   the server should close the connection.
		# - IF (NOT Connection: close) AND (NOT chunked encoding) AND
		#      (totalsize == 0).

		if {    (!(    [info exists state(connection)]
			    && ($state(connection) eq "close")
	    if {
		!(([info exists state(connection)]
			&& ($state(connection) eq "close"))
			  )
			)
		     && (![info exists state(transfer)])
		     && ($state(totalsize) == 0)
		} {
		    set msg {body size is 0 and no events likely - complete}
		    || [info exists state(transfer)])
		&& ($state(totalsize) == 0)
	    } then {
		Log "body size is 0 and no events likely - complete."
		    Log "$msg - token $token"
		    set msg {(length unknown, set to 0)}
		    Log ^F$tk end of response body {*}$msg - token $token
		    set state(state) complete
		    Eot $token
		    return
		}
		Eof $token
		return
	    }

		# We have to use binary translation to count bytes properly.
	    # We have to use binary translation to count bytes properly.
		lassign [fconfigure $sock -translation] trRead trWrite
		fconfigure $sock -translation [list binary $trWrite]
	    fconfigure $sock -translation binary

		if {
		    $state(-binary) || [IsBinaryContentType $state(type)]
		} {
		    # Turn off conversions for non-text data.
		    set state(binary) 1
		}
	    if {
		$state(-binary) || [IsBinaryContentType $state(type)]
	    } then {
		# Turn off conversions for non-text data
		set state(binary) 1
	    }
	    if {
		$state(binary) || [string match *gzip* $state(coding)] ||
		[string match *compress* $state(coding)]
	    } then {
		if {[info exists state(-channel)]} {
		    if {$state(binary) || [llength [ContentEncoding $token]]} {
			fconfigure $state(-channel) -translation binary
		    }
		    if {![info exists state(-handler)]} {
			# Initiate a sequence of background fcopies.
			fileevent $sock readable {}
		    fconfigure $state(-channel) -translation binary
		}
	    }
	    if {
		[info exists state(-channel)] &&
		![info exists state(-handler)]
	    } then {
		# Initiate a sequence of background fcopies
		fileevent $sock readable {}
			rename ${token}EventCoroutine {}
			CopyStart $sock $token
			return
		    }
		CopyStart $sock $token
		return
	    }
		}
	    } elseif {$nhl > 0} {
		# Process header lines.
	} elseif {$n > 0} {
	    # Process header lines
		##Log header - token $token - $line
		if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		    switch -- [string tolower $key] {
			content-type {
			    set state(type) [string trim [string tolower $value]]
			    # Grab the optional charset information.
			    if {[regexp -nocase \
				    {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
				    $state(type) -> cs]} {
				set state(charset) [string map {{\"} \"} $cs]
			    } else {
				regexp -nocase {charset\s*=\s*(\S+?);?} \
					$state(type) -> state(charset)
			    }
			}
			content-length {
			    set state(totalsize) [string trim $value]
			}
			content-encoding {
			    set state(coding) [string trim $value]
			}
			transfer-encoding {
			    set state(transfer) \
				    [string trim [string tolower $value]]
			}
			proxy-connection -
			connection {
	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		switch -- [string tolower $key] {
		    content-type {
			set state(type) [string trim [string tolower $value]]
			# grab the optional charset information
			if {[regexp -nocase \
				 {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
				 $state(type) -> cs]} {
			    set state(charset) [string map {{\"} \"} $cs]
			} else {
			    regexp -nocase {charset\s*=\s*(\S+?);?} \
				$state(type) -> state(charset)
			}
		    }
		    content-length {
			set state(totalsize) [string trim $value]
		    }
		    content-encoding {
			set state(coding) [string trim $value]
		    }
		    transfer-encoding {
			set state(transfer) \
			    [string trim [string tolower $value]]
		    }
		    proxy-connection -
		    connection {
			    set tmpHeader [string trim [string tolower $value]]
			    # RFC 7230 Section 6.1 states that a comma-separated
			    # list is an acceptable value.  According to
			    # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
			    # any comma-separated list implies keep-alive, but I
			    # don't see this in the RFC so we'll play safe and
			    # scan any list for "close".
			    if {$tmpHeader in {close keep-alive}} {
				# The common cases, continue.
			    } elseif {[string first , $tmpHeader] < 0} {
				# Not a comma-separated list, not "close",
				# therefore "keep-alive".
				set tmpHeader keep-alive
			    } else {
				set tmpResult keep-alive
				set tmpCsl [split $tmpHeader ,]
				# Optional whitespace either side of separator.
				foreach el $tmpCsl {
				    if {[string trim $el] eq {close}} {
					set tmpResult close
					break
				    }
			        }
				set tmpHeader $tmpResult
			    }
			    set state(connection) $tmpHeader
			set state(connection) \
			}
			set-cookie {
			    if {$http(-cookiejar) ne ""} {
				ParseCookie $token [string trim $value]
			    [string trim [string tolower $value]]
			    }
			}
		    }
		    lappend state(meta) $key [string trim $value]
		}
	    }
	} else {
	    # Now reading body
		    }
		}
		lappend state(meta) $key [string trim $value]
	    }
	}
    } else {
	# Now reading body
	    ##Log body - token $token
	    if {[catch {
		if {[info exists state(-handler)]} {
		    set n [eval $state(-handler) [list $sock $token]]
	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) [list $sock $token]]
		    ##Log handler $n - token $token
		    # N.B. the protocol has been set to 1.0 because the -handler
		    # logic is not expected to handle chunked encoding.
		    # FIXME Allow -handler with 1.1 on dechunked stacked chan.
		    if {$state(totalsize) == 0} {
			# We know the transfer is complete only when the server
	    } elseif {[info exists state(transfer_final)]} {
			# closes the connection - i.e. eof is not an error.
			set state(state) complete
		set line [getTextLine $sock]
		    }
		    if {![string is integer -strict $n]} {
			if 1 {
		set n [string length $line]
		if {$n > 0} {
			    # Do not tolerate bad -handler - fail with error
			    # status.
		    Log "found $n bytes following final chunk"
		    append state(transfer_final) $line
			    set msg {the -handler command for http::geturl must\
				    return an integer (the number of bytes\
				    read)}
			    Log ^X$tk end of response (handler error) -\
				    token $token
			    Eot $token $msg
			} else {
		} else {
			    # Tolerate the bad -handler, and continue.  The
			    # penalty:
		    Log "final chunk part"
			    # (a) Because the handler returns nonsense, we know
			    #     the transfer is complete only when the server
			    #     closes the connection - i.e. eof is not an
		    Eof $token
			    #     error.
			    # (b) http::size will not be accurate.
			    # (c) The transaction is already downgraded to 1.0
			    #     to avoid chunked transfer encoding.  It MUST
			    #     also be forced to "Connection: close" or the
			    #     HTTP/1.0 equivalent; or it MUST fail (as
			    #     above) if the server sends
			    #     "Connection: keep-alive" or the HTTP/1.0
		}
			    #     equivalent.
			    set n 0
			    set state(state) complete
			}
		    }
		} elseif {[info exists state(transfer_final)]} {
		    # This code forgives EOF in place of the final CRLF.
		    set line [getTextLine $sock]
		    set n [string length $line]
		    set state(state) complete
		    if {$n > 0} {
			# - HTTP trailers (late response headers) are permitted
			#   by Chunked Transfer-Encoding, and can be safely
			#   ignored.
			# - Do not count these bytes in the total received for
			#   the response body.
			Log "trailer of $n bytes after final chunk -\
				token $token"
			append state(transfer_final) $line
			set n 0
		    } else {
	    } elseif {
			Log ^F$tk end of response body (chunked) - token $token
			Log "final chunk part - token $token"
			Eot $token
		    }
		} elseif {    [info exists state(transfer)]
			   && ($state(transfer) eq "chunked")
		} {
		[info exists state(transfer)]
		&& $state(transfer) eq "chunked"
	    } then {
		    ##Log chunked - token $token
		    set size 0
		    set hexLenChunk [getTextLine $sock]
		    #set ntl [string length $hexLenChunk]
		    if {[string trim $hexLenChunk] ne ""} {
			scan $hexLenChunk %x size
			if {$size != 0} {
			    ##Log chunk-measure $size - token $token
			    set chunk [BlockingRead $sock $size]
			    set n [string length $chunk]
			    if {$n >= 0} {
				append state(body) $chunk
		set size 0
		set chunk [getTextLine $sock]
		set n [string length $chunk]
		if {[string trim $chunk] ne ""} {
		    scan $chunk %x size
		    if {$size != 0} {
			set bl [fconfigure $sock -blocking]
			fconfigure $sock -blocking 1
			set chunk [read $sock $size]
			fconfigure $sock -blocking $bl
			set n [string length $chunk]
			if {$n >= 0} {
			    append state(body) $chunk
				incr state(log_size) [string length $chunk]
				##Log chunk $n cumul $state(log_size) -\
					token $token
			    }
			    if {$size != [string length $chunk]} {
				Log "WARNING: mis-sized chunk:\
				    was [string length $chunk], should be\
			}
			if {$size != [string length $chunk]} {
			    Log "WARNING: mis-sized chunk:\
				was [string length $chunk], should be $size"
				    $size - token $token"
				set n 0
				set state(connection) close
				Log ^X$tk end of response (chunk error) \
					- token $token
				set msg {error in chunked encoding - fetch\
					terminated}
				Eot $token $msg
			    }
			}
			    # CRLF that follows chunk.
			    # If eof, this is handled at the end of this proc.
			    getTextLine $sock
			} else {
			getTextLine $sock
		    } else {
			    set n 0
			    set state(transfer_final) {}
			}
		    } else {
			# Line expected to hold chunk length is empty, or eof.
			##Log bad-chunk-measure - token $token
			set n 0
			set state(connection) close
			Log ^X$tk end of response (chunk error) - token $token
			Eot $token {error in chunked encoding -\
				fetch terminated}
		    }
		} else {
		    ##Log unchunked - token $token
		    if {$state(totalsize) == 0} {
			# We know the transfer is complete only when the server
			# closes the connection.
			set state(state) complete
			set state(transfer_final) {}
			set reqSize $state(-blocksize)
		    } else {
			# Ask for the whole of the unserved response-body.
			# This works around a problem with a tls::socket - for
			# https in keep-alive mode, and a request for
			# $state(-blocksize) bytes, the last part of the
			# resource does not get read until the server times out.
			set reqSize [expr {  $state(totalsize)
					   - $state(currentsize)}]

		    }
			# The workaround fails if reqSize is
			# capped at $state(-blocksize).
			# set reqSize [expr {min($reqSize, $state(-blocksize))}]
		    }
		    set c $state(currentsize)
		}
	    } else {
		#Log "read non-chunk $state(currentsize) of $state(totalsize)"
		    set t $state(totalsize)
		    ##Log non-chunk currentsize $c of totalsize $t -\
			    token $token
		    set block [read $sock $reqSize]
		    set n [string length $block]
		    if {$n >= 0} {
			append state(body) $block
		set block [read $sock $state(-blocksize)]
		set n [string length $block]
		if {$n >= 0} {
		    append state(body) $block
			##Log non-chunk [string length $state(body)] -\
				token $token
		    }
		}
		}
	    }
		# This calculation uses n from the -handler, chunked, or
		# unchunked case as appropriate.
		if {[info exists state]} {
		    if {$n >= 0} {
			incr state(currentsize) $n
	    if {[info exists state]} {
		if {$n >= 0} {
		    incr state(currentsize) $n
			set c $state(currentsize)
			set t $state(totalsize)
			##Log another $n currentsize $c totalsize $t -\
				token $token
		    }
		    # If Content-Length - check for end of data.
		    if {
			   ($state(totalsize) > 0)
			&& ($state(currentsize) >= $state(totalsize))
		    } {
		}
		# If Content-Length - check for end of data.
		if {
		    ($state(totalsize) > 0)
		    && ($state(currentsize) >= $state(totalsize))
		} then {
			Log ^F$tk end of response body (unchunked) -\
				token $token
			set state(state) complete
			Eot $token
		    }
		}
	    } err]} {
		    Eof $token
		}
	    }
	} err]} then {
		Log ^X$tk end of response (error ${err}) - token $token
		Finish $token $err
	    return [Finish $token $err]
		return
	    } else {
		if {[info exists state(-progress)]} {
		    eval $state(-progress) \
			[list $token $state(totalsize) $state(currentsize)]
		}
	    }
	}
	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) \
		    [list $token $state(totalsize) $state(currentsize)]
	    }
	}
    }

	# catch as an Eot above may have closed the socket already
    # catch as an Eof above may have closed the socket already
	# $state(state) may be connecting, header, body, or complete
	if {![set cc [catch {eof $sock} eof]] && $eof} {
    if {![catch {eof $sock} eof] && $eof} {
	    ##Log eof - token $token
	    if {[info exists $token]} {
		set state(connection) close
	if {[info exists $token]} {
	    set state(connection) close
		if {$state(state) eq "complete"} {
		    # This includes all cases in which the transaction
		    # can be completed by eof.
		    # The value "complete" is set only in http::Event, and it is
		    # used only in the test above.
		    Log ^F$tk end of response body (unchunked, eof) -\
			    token $token
		    Eot $token
		} else {
	    Eof $token
	} else {
		    # Premature eof.
		    Log ^X$tk end of response (unexpected eof) - token $token
		    Eot $token eof
		}
	    } else {
		# open connection closed on a token that has been cleaned up.
	    # open connection closed on a token that has been cleaned up.
		Log ^X$tk end of response (token error) - token $token
		CloseSocket $sock
	    }
	    CloseSocket $sock
	}
	} elseif {$cc} {
	    return
	return
	}
    }
}

# http::TestForReplay
#
#	Command called if eof is discovered when a socket is first used for a
#	new transaction.  Typically this occurs if a persistent socket is used
#	after a period of idleness and the server has half-closed the socket.
#
# token  - the connection token returned by http::geturl
# doing  - "read" or "write"
# err    - error message, if any
# caller - code to identify the caller - used only in logging
#
# Return Value: boolean, true iff the command calls http::ReplayIfDead.

proc http::TestForReplay {token doing err caller} {
    variable http
    variable $token
    upvar 0 $token state
    set tk [namespace tail $token]
    if {$doing eq "read"} {
	set code Q
	set action response
	set ing reading
    } else {
	set code P
	set action request
	set ing writing
    }

    if {$err eq {}} {
	set err "detect eof when $ing (server timed out?)"
    }

    if {$state(method) eq "POST" && !$http(-repost)} {
	# No Replay.
	# The present transaction will end when Finish is called.
	# That call to Finish will abort any other transactions
	# currently in the write queue.
	# For calls from http::Event this occurs when execution
	# reaches the code block at the end of that proc.
	set msg {no retry for POST with http::config -repost 0}
	Log reusing socket failed "($caller)" - $msg - token $token
	Log error - $err - token $token
	Log ^X$tk end of $action (error) - token $token
	return 0
    } else {
	# Replay.
	set msg {try a new socket}
	Log reusing socket failed "($caller)" - $msg - token $token
	Log error - $err - token $token
	Log ^$code$tk Any unfinished (incl this one) failed - token $token
	ReplayIfDead $token $doing
	return 1
    }
}

# http::IsBinaryContentType --
#
#	Determine if the content-type means that we should definitely transfer
#	the data as binary. [Bug 838e99a76d]
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+
-
-
-









-
-
-
-
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    # restrict things for now...
    if {[string match "*+xml" $minor]} {
	return false
    }
    return true
}

proc http::ParseCookie {token value} {
    variable http
    variable CookieRE
    variable $token
    upvar 0 $token state

    if {![regexp $CookieRE $value -> cookiename cookieval opts]} {
	# Bad cookie! No biscuit!
	return
    }

    # Convert the options into a list before feeding into the cookie store;
    # ugly, but quite easy.
    set realopts {hostonly 1 path / secure 0 httponly 0}
    dict set realopts origin $state(host)
    dict set realopts domain $state(host)
    foreach option [split [regsub -all {;\s+} $opts \u0000] \u0000] {
	regexp {^(.*?)(?:=(.*))?$} $option -> optname optval
	switch -exact -- [string tolower $optname] {
	    expires {
		if {[catch {
		    #Sun, 06 Nov 1994 08:49:37 GMT
		    dict set realopts expires \
			[clock scan $optval -format "%a, %d %b %Y %T %Z"]
		}] && [catch {
		    # Google does this one
		    #Mon, 01-Jan-1990 00:00:00 GMT
		    dict set realopts expires \
			[clock scan $optval -format "%a, %d-%b-%Y %T %Z"]
		}] && [catch {
		    # This is in the RFC, but it is also in the original
		    # Netscape cookie spec, now online at:
		    # <URL:http://curl.haxx.se/rfc/cookie_spec.html>
		    #Sunday, 06-Nov-94 08:49:37 GMT
		    dict set realopts expires \
			[clock scan $optval -format "%A, %d-%b-%y %T %Z"]
		}]} {catch {
		    #Sun Nov  6 08:49:37 1994
		    dict set realopts expires \
			[clock scan $optval -gmt 1 -format "%a %b %d %T %Y"]
		}}
	    }
	    max-age {
		# Normalize
		if {[string is integer -strict $optval]} {
		    dict set realopts expires [expr {[clock seconds] + $optval}]
		}
	    }
	    domain {
		# From the domain-matches definition [RFC 2109, section 2]:
		#   Host A's name domain-matches host B's if [...]
		#	A is a FQDN string and has the form NB, where N is a
		#	non-empty name string, B has the form .B', and B' is a
		#	FQDN string. (So, x.y.com domain-matches .y.com but
		#	not y.com.)
		if {$optval ne "" && ![string match *. $optval]} {
		    dict set realopts domain [string trimleft $optval "."]
		    dict set realopts hostonly [expr {
			! [string match .* $optval]
		    }]
		}
	    }
	    path {
		if {[string match /* $optval]} {
		    dict set realopts path $optval
		}
	    }
	    secure - httponly {
		dict set realopts [string tolower $optname] 1
	    }
	}
    }
    dict set realopts key $cookiename
    dict set realopts value $cookieval
    {*}$http(-cookiejar) storeCookie $realopts
}

# http::getTextLine --
#
#	Get one line with the stream in crlf mode.
#	Get one line with the stream in blocking crlf mode
#	Used if Transfer-Encoding is chunked.
#	Empty line is not distinguished from eof.  The caller must
#	be able to handle this.
#
# Arguments
#	sock	The socket receiving input.
#
# Results:
#	The line of text, without trailing newline

proc http::getTextLine {sock} {
    set tr [fconfigure $sock -translation]
    lassign $tr trRead trWrite
    fconfigure $sock -translation [list crlf $trWrite]
    set r [BlockingGets $sock]
    fconfigure $sock -translation $tr
    set bl [fconfigure $sock -blocking]
    fconfigure $sock -translation crlf -blocking 1
    set r [gets $sock]
    fconfigure $sock -translation $tr -blocking $bl
    return $r
}

# http::BlockingRead
#
#	Replacement for a blocking read.
#	The caller must be a coroutine.

proc http::BlockingRead {sock size} {
    if {$size < 1} {
	return
    }
    set result {}
    while 1 {
	set need [expr {$size - [string length $result]}]
	set block [read $sock $need]
	set eof [eof $sock]
	append result $block
	if {[string length $result] >= $size || $eof} {
	    return $result
	} else {
	    yield
	}
    }
}

# http::BlockingGets
#
#	Replacement for a blocking gets.
#	The caller must be a coroutine.
#	Empty line is not distinguished from eof.  The caller must
#	be able to handle this.

proc http::BlockingGets {sock} {
    while 1 {
	set count [gets $sock line]
	set eof [eof $sock]
	if {$count >= 0 || $eof} {
	    return $line
	} else {
	    yield
	}
    }
}

# http::CopyStart
#
#	Error handling wrapper around fcopy
#
# Arguments
#	sock	The socket to copy from
#	token	The token returned from http::geturl
#
# Side Effects
#	This closes the connection upon error

proc http::CopyStart {sock token {initial 1}} {
    upvar #0 $token state
proc http::CopyStart {sock token} {
    variable $token
    upvar 0 $token state
    if {[info exists state(transfer)] && $state(transfer) eq "chunked"} {
	foreach coding [ContentEncoding $token] {
	    lappend state(zlib) [zlib stream $coding]
	}
	make-transformation-chunked $sock [namespace code [list CopyChunk $token]]
    } else {
	if {$initial} {
	    foreach coding [ContentEncoding $token] {
		zlib push $coding $sock
	    }
	}
	if {[catch {
    if {[catch {
	    # FIXME Keep-Alive on https tls::socket with unchunked transfer
	    # hangs until the server times out. A workaround is possible, as for
	    # the case without -channel, but it does not use the neat "fcopy"
	    # solution.
	    fcopy $sock $state(-channel) -size $state(-blocksize) -command \
		[list http::CopyDone $token]
	} err]} {
	    Finish $token $err
	fcopy $sock $state(-channel) -size $state(-blocksize) -command \
	    [list http::CopyDone $token]
    } err]} then {
	Finish $token $err
	}
    }
}

proc http::CopyChunk {token chunk} {
    upvar 0 $token state
    if {[set count [string length $chunk]]} {
	incr state(currentsize) $count
	if {[info exists state(zlib)]} {
	    foreach stream $state(zlib) {
		set chunk [$stream add $chunk]
	    }
	}
	puts -nonewline $state(-channel) $chunk
	if {[info exists state(-progress)]} {
	    eval [linsert $state(-progress) end \
		      $token $state(totalsize) $state(currentsize)]
	}
    } else {
	Log "CopyChunk Finish - token $token"
	if {[info exists state(zlib)]} {
	    set excess ""
	    foreach stream $state(zlib) {
		catch {set excess [$stream add -finalize $excess]}
	    }
	    puts -nonewline $state(-channel) $excess
	    foreach stream $state(zlib) { $stream close }
	    unset state(zlib)
	}
	Eot $token ;# FIX ME: pipelining.
    }
}

# http::CopyDone
#
#	fcopy completion callback
#
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
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







-
+



-
+

-
+



-
+

-
-
+
-
-
-
-
-
-
-
-



-
-
-
-
-
-




-
+


-
-
+
+

-
-
-
-

-



-
-
-
-
+
+
+
+
+
+
+

-
+
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+










-
+







    upvar 0 $token state
    set sock $state(sock)
    incr state(currentsize) $count
    if {[info exists state(-progress)]} {
	eval $state(-progress) \
	    [list $token $state(totalsize) $state(currentsize)]
    }
    # At this point the token may have been reset.
    # At this point the token may have been reset
    if {[string length $error]} {
	Finish $token $error
    } elseif {[catch {eof $sock} iseof] || $iseof} {
	Eot $token
	Eof $token
    } else {
	CopyStart $sock $token 0
	CopyStart $sock $token
    }
}

# http::Eot
# http::Eof
#
#	Called when either:
#	a. An eof condition is detected on the socket.
#	Handle eof on the socket
#	b. The client decides that the response is complete.
#	c. The client detects an inconsistency and aborts the transaction.
#
#	Does:
#	1. Set state(status)
#	2. Reverse any Content-Encoding
#	3. Convert charset encoding and line ends if necessary
#	4. Call http::Finish
#
# Arguments
#	token	The token returned from http::geturl
#	force	(previously) optional, has no effect
#	reason	- "eof" means premature EOF (not EOF as the natural end of
#		  the response)
#		- "" means completion of response, with or without EOF
#		- anything else describes an error confition other than
#		  premature EOF.
#
# Side Effects
#	Clean up the socket

proc http::Eot {token {reason {}}} {
proc http::Eof {token {force 0}} {
    variable $token
    upvar 0 $token state
    if {$reason eq "eof"} {
	# Premature eof.
    if {$state(state) eq "header"} {
	# Premature eof
	set state(status) eof
	set reason {}
    } elseif {$reason ne ""} {
	# Abort the transaction.
	set state(status) $reason
    } else {
	# The response is complete.
	set state(status) ok
    }

    if {[string length $state(body)] > 0} {
	if {[catch {
	    foreach coding [ContentEncoding $token] {
		set state(body) [zlib $coding $state(body)]
    if {($state(coding) eq "gzip") && [string length $state(body)] > 0} {
        if {[catch {
	    if {[package vsatisfies [package provide Tcl] 8.6]} {
		# The zlib integration into 8.6 includes proper gzip support
		set state(body) [zlib gunzip $state(body)]
	    } else {
		set state(body) [Gunzip $state(body)]
	    }
	} err]} {
        } err]} then {
	    Log "error doing decompression for token $token: $err"
	    Finish $token $err
	    return [Finish $token $err]
	    return
	}

	if {!$state(binary)} {
	    # If we are getting text, set the incoming channel's encoding
	    # correctly.  iso8859-1 is the RFC default, but this could be any
	    # IANA charset.  However, we only know how to convert what we have
	    # encodings for.
        }
    }

    if {!$state(binary)} {
        # If we are getting text, set the incoming channel's encoding
        # correctly.  iso8859-1 is the RFC default, but this could be any IANA
        # charset.  However, we only know how to convert what we have
        # encodings for.

	    set enc [CharsetToEncoding $state(charset)]
	    if {$enc ne "binary"} {
		set state(body) [encoding convertfrom $enc $state(body)]
	    }
        set enc [CharsetToEncoding $state(charset)]
        if {$enc ne "binary"} {
	    set state(body) [encoding convertfrom $enc $state(body)]
        }

	    # Translate text line endings.
	    set state(body) [string map {\r\n \n \r \n} $state(body)]
	}
    }
    Finish $token $reason
        # Translate text line endings.
        set state(body) [string map {\r\n \n \r \n} $state(body)]
    }

    Finish $token
}

# http::wait --
#
#	See documentation for details.
#
# Arguments:
#	token	Connection token.
#
# Results:
#	The status after the wait.
#        The status after the wait.

proc http::wait {token} {
    variable $token
    upvar 0 $token state

    if {![info exists state(status)] || $state(status) eq ""} {
	# We must wait on the original variable name, not the upvar alias
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
1346
1347
1348
1349
1350
1351
1352






1353
1354
1355
1356
1357
1358
1359







-
-
-
-
-
-







# Arguments:
#	args	A list of name-value pairs.
#
# Results:
#	TODO

proc http::formatQuery {args} {
    if {[llength $args] % 2} {
        return \
            -code error \
            -errorcode [list HTTP BADARGCNT $args] \
            {Incorrect number of arguments, must be an even number.}
    }
    set result ""
    set sep ""
    foreach i $args {
	append result $sep [mapReply $i]
	if {$sep eq "="} {
	    set sep &
	} else {
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
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







-
+






-
















-
+








    if {$http(-urlencoding) ne ""} {
	set string [encoding convertto $http(-urlencoding) $string]
	return [string map $formMap $string]
    }
    set converted [string map $formMap $string]
    if {[string match "*\[\u0100-\uffff\]*" $converted]} {
	regexp "\[\u0100-\uffff\]" $converted badChar
	regexp {[\u0100-\uffff]} $converted badChar
	# Return this error message for maximum compatibility... :^/
	return -code error \
	    "can't read \"formMap($badChar)\": no such element in array"
    }
    return $converted
}
interp alias {} http::quoteString {} http::mapReply

# http::ProxyRequired --
#	Default proxy filter.
#
# Arguments:
#	host	The destination host
#
# Results:
#       The current proxy settings

proc http::ProxyRequired {host} {
    variable http
    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
	if {
	    ![info exists http(-proxyport)] ||
	    ![string length $http(-proxyport)]
	} {
	} then {
	    set http(-proxyport) 8080
	}
	return [list $http(-proxyhost) $http(-proxyport)]
    }
}

# http::CharsetToEncoding --
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
1452
1453
1454
1455
1456
1457
1458


1459




1460
1461
1462
1463



1464
1465










1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484



1485




1486
1487
1488
1489










1490
1491
1492
1493
1494
1495
1496
1497






1498
1499
1500
1501







1502
1503
1504
1505
1506
1507
1508
1509
1510
1511



1512
1513
1514
1515
1516







-
-
+
-
-
-
-
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-





    if {$idx >= 0} {
	return $encoding
    } else {
	return "binary"
    }
}

# Return the list of content-encoding transformations we need to do in order.
proc http::ContentEncoding {token} {
# http::Gunzip --
    upvar 0 $token state
    set r {}
    if {[info exists state(coding)]} {
	foreach coding [split $state(coding) ,] {
#
#	Decompress data transmitted using the gzip transfer coding.
#

	    switch -exact -- $coding {
		deflate { lappend r inflate }
		gzip - x-gzip { lappend r gunzip }
# FIX ME: redo using zlib sinflate
proc http::Gunzip {data} {
		compress - x-compress { lappend r decompress }
		identity {}
		default {
		    return -code error "unsupported content-encoding \"$coding\""
		}
	    }
	}
    }
    return $r
}
    binary scan $data Scb5icc magic method flags time xfl os
    set pos 10
    if {$magic != 0x1f8b} {
        return -code error "invalid data: supplied data is not in gzip format"
    }
    if {$method != 8} {
        return -code error "invalid compression method"
    }

    # lassign [split $flags ""] f_text f_crc f_extra f_name f_comment
    foreach {f_text f_crc f_extra f_name f_comment} [split $flags ""] break
    set extra ""
    if {$f_extra} {
	binary scan $data @${pos}S xlen
        incr pos 2
        set extra [string range $data $pos $xlen]
        set pos [incr xlen]
    }

proc http::ReceiveChunked {chan command} {
    set data ""
    set size -1
    set name ""
    yield
    while {1} {
	chan configure $chan -translation {crlf binary}
	while {[gets $chan line] < 1} { yield }
    if {$f_name} {
        set ndx [string first \0 $data $pos]
        set name [string range $data $pos $ndx]
        set pos [incr ndx]
	chan configure $chan -translation {binary binary}
	if {[scan $line %x size] != 1} {
	    return -code error "invalid size: \"$line\""
	}
	set chunk ""
	while {$size && ![chan eof $chan]} {
	    set part [chan read $chan $size]
	    incr size -[string length $part]
	    append chunk $part
	}
    }

    set comment ""
    if {$f_comment} {
        set ndx [string first \0 $data $pos]
        set comment [string range $data $pos $ndx]
        set pos [incr ndx]
    }
	if {[catch {
	    uplevel #0 [linsert $command end $chunk]
	}]} {
	    http::Log "Error in callback: $::errorInfo"
	}
	if {[string length $chunk] == 0} {

    set fcrc ""
    if {$f_crc} {
	set fcrc [string range $data $pos [incr pos]]
	    # channel might have been closed in the callback
	    catch {chan event $chan readable {}}
	    return
	}
    }
}

        incr pos
    }

    binary scan [string range $data end-7 end] ii crc size
    set inflated [zlib inflate [string range $data $pos end-8]]
    set chk [zlib crc32 $inflated]
    if {($crc & 0xffffffff) != ($chk & 0xffffffff)} {
	return -code error "invalid data: checksum mismatch $crc != $chk"
    }
    return $inflated
proc http::make-transformation-chunked {chan command} {
    coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command
    chan event $chan readable [namespace current]::dechunk$chan
}

# Local variables:
# indent-tabs-mode: t
# End:

Changes to library/http/pkgIndex.tcl.



1
2


1
2


3
4
+
+
-
-
+
+
# Tcl package index file, version 1.1

if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.10.0a1 [list tclPkgSetup $dir http 2.10.0a1 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded http 2.7.15 [list tclPkgSetup $dir http 2.7.15 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

Added library/http1.0/http.tcl.


























































































































































































































































































































































































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
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# 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 http.n man page for documentation

package provide http 1.0

array set http {
    -accept */*
    -proxyhost {}
    -proxyport {}
    -useragent {Tcl http client package 1.0}
    -proxyfilter httpProxyRequired
}
proc http_config {args} {
    global http
    set options [lsort [array names http -*]]
    set usage [join $options ", "]
    if {[llength $args] == 0} {
	set result {}
	foreach name $options {
	    lappend result $name $http($name)
	}
	return $result
    }
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    if {[llength $args] == 1} {
	set flag [lindex $args 0]
	if {[regexp -- $pat $flag]} {
	    return $http($flag)
	} else {
	    return -code error "Unknown option $flag, must be: $usage"
	}
    } else {
	foreach {flag value} $args {
	    if {[regexp -- $pat $flag]} {
		set http($flag) $value
	    } else {
		return -code error "Unknown option $flag, must be: $usage"
	    }
	}
    }
}

 proc httpFinish { token {errormsg ""} } {
    upvar #0 $token state
    global errorInfo errorCode
    if {[string length $errormsg] != 0} {
	set state(error) [list $errormsg $errorInfo $errorCode]
	set state(status) error
    }
    catch {close $state(sock)}
    catch {after cancel $state(after)}
    if {[info exists state(-command)]} {
	if {[catch {eval $state(-command) {$token}} err]} {
	    if {[string length $errormsg] == 0} {
		set state(error) [list $err $errorInfo $errorCode]
		set state(status) error
	    }
	}
	unset state(-command)
    }
}
proc http_reset { token {why reset} } {
    upvar #0 $token state
    set state(status) $why
    catch {fileevent $state(sock) readable {}}
    httpFinish $token
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state(error)
	eval error $errorlist
    }
}
proc http_get { url args } {
    global http
    if {![info exists http(uid)]} {
	set http(uid) 0
    }
    set token http#[incr http(uid)]
    upvar #0 $token state
    http_reset $token
    array set state {
	-blocksize 	8192
	-validate 	0
	-headers 	{}
	-timeout 	0
	state		header
	meta		{}
	currentsize	0
	totalsize	0
        type            text/html
        body            {}
	status		""
    }
    set options {-blocksize -channel -command -handler -headers \
		-progress -query -validate -timeout}
    set usage [join $options ", "]
    regsub -all -- - $options {} options
    set pat ^-([join $options |])$
    foreach {flag value} $args {
	if {[regexp $pat $flag]} {
	    # Validate numbers
	    if {[info exists state($flag)] && \
		    [regexp {^[0-9]+$} $state($flag)] && \
		    ![regexp {^[0-9]+$} $value]} {
		return -code error "Bad value for $flag ($value), must be integer"
	    }
	    set state($flag) $value
	} else {
	    return -code error "Unknown option $flag, can be: $usage"
	}
    }
    if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
	    x proto host y port srvurl]} {
	error "Unsupported URL: $url"
    }
    if {[string length $port] == 0} {
	set port 80
    }
    if {[string length $srvurl] == 0} {
	set srvurl /
    }
    if {[string length $proto] == 0} {
	set url http://$url
    }
    set state(url) $url
    if {![catch {$http(-proxyfilter) $host} proxy]} {
	set phost [lindex $proxy 0]
	set pport [lindex $proxy 1]
    }
    if {$state(-timeout) > 0} {
	set state(after) [after $state(-timeout) [list http_reset $token timeout]]
    }
    if {[info exists phost] && [string length $phost]} {
	set srvurl $url
	set s [socket $phost $pport]
    } else {
	set s [socket $host $port]
    }
    set state(sock) $s

    # Send data in cr-lf format, but accept any line terminators

    fconfigure $s -translation {auto crlf} -buffersize $state(-blocksize)

    # The following is disallowed in safe interpreters, but the socket
    # is already in non-blocking mode in that case.

    catch {fconfigure $s -blocking off}
    set len 0
    set how GET
    if {[info exists state(-query)]} {
	set len [string length $state(-query)]
	if {$len > 0} {
	    set how POST
	}
    } elseif {$state(-validate)} {
	set how HEAD
    }
    puts $s "$how $srvurl HTTP/1.0"
    puts $s "Accept: $http(-accept)"
    puts $s "Host: $host"
    puts $s "User-Agent: $http(-useragent)"
    foreach {key value} $state(-headers) {
	regsub -all \[\n\r\]  $value {} value
	set key [string trim $key]
	if {[string length $key]} {
	    puts $s "$key: $value"
	}
    }
    if {$len > 0} {
	puts $s "Content-Length: $len"
	puts $s "Content-Type: application/x-www-form-urlencoded"
	puts $s ""
	fconfigure $s -translation {auto binary}
	puts -nonewline $s $state(-query)
    } else {
	puts $s ""
    }
    flush $s
    fileevent $s readable [list httpEvent $token]
    if {! [info exists state(-command)]} {
	http_wait $token
    }
    return $token
}
proc http_data {token} {
    upvar #0 $token state
    return $state(body)
}
proc http_status {token} {
    upvar #0 $token state
    return $state(status)
}
proc http_code {token} {
    upvar #0 $token state
    return $state(http)
}
proc http_size {token} {
    upvar #0 $token state
    return $state(currentsize)
}

 proc httpEvent {token} {
    upvar #0 $token state
    set s $state(sock)

     if {[eof $s]} {
	httpEof $token
	return
    }
    if {$state(state) == "header"} {
	set n [gets $s line]
	if {$n == 0} {
	    set state(state) body
	    if {![regexp -nocase ^text $state(type)]} {
		# Turn off conversions for non-text data
		fconfigure $s -translation binary
		if {[info exists state(-channel)]} {
		    fconfigure $state(-channel) -translation binary
		}
	    }
	    if {[info exists state(-channel)] &&
		    ![info exists state(-handler)]} {
		# Initiate a sequence of background fcopies
		fileevent $s readable {}
		httpCopyStart $s $token
	    }
	} elseif {$n > 0} {
	    if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
		set state(type) [string trim $type]
	    }
	    if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
		set state(totalsize) [string trim $length]
	    }
	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
		lappend state(meta) $key $value
	    } elseif {[regexp ^HTTP $line]} {
		set state(http) $line
	    }
	}
    } else {
	if {[catch {
	    if {[info exists state(-handler)]} {
		set n [eval $state(-handler) {$s $token}]
	    } else {
		set block [read $s $state(-blocksize)]
		set n [string length $block]
		if {$n >= 0} {
		    append state(body) $block
		}
	    }
	    if {$n >= 0} {
		incr state(currentsize) $n
	    }
	} err]} {
	    httpFinish $token $err
	} else {
	    if {[info exists state(-progress)]} {
		eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
	    }
	}
    }
}
 proc httpCopyStart {s token} {
    upvar #0 $token state
    if {[catch {
	fcopy $s $state(-channel) -size $state(-blocksize) -command \
	    [list httpCopyDone $token]
    } err]} {
	httpFinish $token $err
    }
}
 proc httpCopyDone {token count {error {}}} {
    upvar #0 $token state
    set s $state(sock)
    incr state(currentsize) $count
    if {[info exists state(-progress)]} {
	eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
    }
    if {([string length $error] != 0)} {
	httpFinish $token $error
    } elseif {[eof $s]} {
	httpEof $token
    } else {
	httpCopyStart $s $token
    }
}
 proc httpEof {token} {
    upvar #0 $token state
    if {$state(state) == "header"} {
	# Premature eof
	set state(status) eof
    } else {
	set state(status) ok
    }
    set state(state) eof
    httpFinish $token
}
proc http_wait {token} {
    upvar #0 $token state
    if {![info exists state(status)] || [string length $state(status)] == 0} {
	vwait $token\(status)
    }
    if {[info exists state(error)]} {
	set errorlist $state(error)
	unset state(error)
	eval error $errorlist
    }
    return $state(status)
}

# Call http_formatQuery with an even number of arguments, where the first is
# a name, the second is a value, the third is another name, and so on.

proc http_formatQuery {args} {
    set result ""
    set sep ""
    foreach i $args {
	append result  $sep [httpMapReply $i]
	if {$sep != "="} {
	    set sep =
	} else {
	    set sep &
	}
    }
    return $result
}

# do x-www-urlencoded character mapping
# The spec says: "non-alphanumeric characters are replaced by '%HH'"
# 1 leave alphanumerics characters alone
# 2 Convert every other character to an array lookup
# 3 Escape constructs that are "special" to the tcl parser
# 4 "subst" the result, doing all the array substitutions

 proc httpMapReply {string} {
    global httpFormMap
    set alphanumeric	a-zA-Z0-9
    if {![info exists httpFormMap]} {

	for {set i 1} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match \[$alphanumeric\] $c]} {
		set httpFormMap($c) %[format %.2x $i]
	    }
	}
	# These are handled specially
	array set httpFormMap {
	    " " +   \n %0d%0a
	}
    }
    regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string
    regsub -all \n $string {\\n} string
    regsub -all \t $string {\\t} string
    regsub -all {[][{})\\]\)} $string {\\&} string
    return [subst $string]
}

# Default proxy filter.
 proc httpProxyRequired {host} {
    global http
    if {[info exists http(-proxyhost)] && [string length $http(-proxyhost)]} {
	if {![info exists http(-proxyport)] || ![string length $http(-proxyport)]} {
	    set http(-proxyport) 8080
	}
	return [list $http(-proxyhost) $http(-proxyport)]
    } else {
	return {}
    }
}

Added library/http1.0/pkgIndex.tcl.












1
2
3
4
5
6
7
8
9
10
11
+
+
+
+
+
+
+
+
+
+
+
# Tcl package index file, version 1.0
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}]

Changes to library/init.tcl.

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
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








-
+
-
-
-









-
+




















-
+
-
-
-
-

-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# init.tcl --
#
# Default system startup file for Tcl-based applications.  Defines
# "unknown" procedure and auto-load facilities.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2004 by Kevin B. Kenny.
# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2018 by Sean Woods
#
# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# This test intentionally written in pre-7.5 Tcl
if {[info commands package] == ""} {
    error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 9.0a2
package require -exact Tcl 8.5.19

# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
#
# The environment variable TCLLIBPATH
#
# tcl_library, which is the directory containing this init.tcl script.
# [tclInit] (Tcl_Init()) searches around for the directory containing this
# init.tcl and defines tcl_library to that location before sourcing it.
#
# The parent directory of tcl_library. Adding the parent
# means that packages in peer directories will be found automatically.
#
# Also add the directory ../lib relative to the directory where the
# executable is located.  This is meant to find binary packages for the
# same architecture as the current executable.
#
# tcl_pkgPath, which is set by the platform-specific initialization routines
#	On UNIX it is compiled in
#       On Windows, it is not used
#

# (Ticket 41c9857bdd) In a safe interpreter, this file does not set
# ::auto_path (other than to {} if it is undefined). The caller, typically
# a Safe Base command, is responsible for setting ::auto_path.

if {![info exists auto_path]} {
    if {[info exists env(TCLLIBPATH)] && (![interp issafe])} {
    if {[info exists env(TCLLIBPATH)]} {
	set auto_path $env(TCLLIBPATH)
    } else {
	set auto_path ""
    }
}
namespace eval tcl {
    if {![interp issafe]} {
	variable Dir
	foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
	    if {$Dir ni $::auto_path} {
		lappend ::auto_path $Dir
	    }
	}
	set Dir [file join [file dirname [file dirname \
		[info nameofexecutable]]] lib]
	if {$Dir ni $::auto_path} {
	    lappend ::auto_path $Dir
	}
	if {[info exists ::tcl_pkgPath]} { catch {
	    foreach Dir $::tcl_pkgPath {
		if {$Dir ni $::auto_path} {
		    lappend ::auto_path $Dir
		}
	    }
	}}
    variable Dir
    foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
	if {$Dir ni $::auto_path} {
	    lappend ::auto_path $Dir
	}
    }
    set Dir [file join [file dirname [file dirname \
	    [info nameofexecutable]]] lib]
    if {$Dir ni $::auto_path} {
	lappend ::auto_path $Dir
    }
    if {[info exists ::tcl_pkgPath]} { catch {
	foreach Dir $::tcl_pkgPath {
	    if {$Dir ni $::auto_path} {
		lappend ::auto_path $Dir
	    }
	}
    }}

    if {![interp issafe]} {
	variable Path [encoding dirs]
	set Dir [file join $::tcl_library encoding]
	if {$Dir ni $Path} {
        variable Path [encoding dirs]
        set Dir [file join $::tcl_library encoding]
        if {$Dir ni $Path} {
	    lappend Path $Dir
	    encoding dirs $Path
	}
	unset Dir Path
    }
}

namespace eval tcl::Pkg {}

        }
    }

    # TIP #255 min and max functions
    namespace eval mathfunc {
	proc min {args} {
	    if {![llength $args]} {
		return -code error \
		    "too few arguments to math function \"min\""
	    }
	    set val Inf
	    foreach arg $args {
		# This will handle forcing the numeric value without
		# ruining the internal type of a numeric object
		if {[catch {expr {double($arg)}} err]} {
		    return -code error $err
		}
		if {$arg < $val} {set val $arg}
	    }
	    return $val
	}
	proc max {args} {
	    if {![llength $args]} {
		return -code error \
		    "too few arguments to math function \"max\""
	    }
	    set val -Inf
	    foreach arg $args {
		# This will handle forcing the numeric value without
		# ruining the internal type of a numeric object
		if {[catch {expr {double($arg)}} err]} {
		    return -code error $err
		}
		if {$arg > $val} {set val $arg}
	    }
	    return $val
	}
	namespace export min max
    }
}

# Windows specific end of initialization

if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
    namespace eval tcl {
	proc EnvTraceProc {lo n1 n2 op} {
	    global env
	    set x $env($n2)
	    set env($lo) $x
	    set env([string toupper $lo]) $x
	}
	proc InitWinEnv {} {
	    global env tcl_platform
	    foreach p [array names env] {
		set u [string toupper $p]
		if {$u ne $p} {
		    switch -- $u {
			COMSPEC -
			PATH {
			    set temp $env($p)
			    unset env($p)
			    set env($u) $temp
			    trace add variable env($p) write \
				    [namespace code [list EnvTraceProc $p]]
			    trace add variable env($u) write \
				    [namespace code [list EnvTraceProc $p]]
			}
		    }
		}
	    }
	    if {![info exists env(COMSPEC)]} {
		if {$tcl_platform(os) eq "Windows NT"} {
		    set env(COMSPEC) cmd.exe
		} else {
		    set env(COMSPEC) command.com
		}
	    }
	}
	InitWinEnv
    }
}

# Setup the unknown package handler


if {[interp issafe]} {
    package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
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
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







+
+
+
+
+
+
-
+





-
+




-
+

-







	package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
    }

    # Set up the 'clock' ensemble

    namespace eval ::tcl::clock [list variable TclLibDir $::tcl_library]

    proc clock args {
	namespace eval ::tcl::clock [list namespace ensemble create -command \
		[uplevel 1 [list namespace origin [lindex [info level 0] 0]]] \
		-subcommands {
		    add clicks format microseconds milliseconds scan seconds
		}]
    proc ::tcl::initClock {} {

	# Auto-loading stubs for 'clock.tcl'

	foreach cmd {add format scan} {
	    proc ::tcl::clock::$cmd args {
		variable TclLibDir
		source [file join $TclLibDir clock.tcl]
		source -encoding utf-8 [file join $TclLibDir clock.tcl]
		return [uplevel 1 [info level 0]]
	    }
	}

	rename ::tcl::initClock {}
	return [uplevel 1 [info level 0]]
    }
    ::tcl::initClock
}

# Conditionalize for presence of exec.

if {[namespace which -command exec] eq ""} {

    # Some machines do not have exec. Also, on all
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
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







+
+
-
+

-
+
















-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


+
+
-
+







}

# unknown --
# This procedure is called when a Tcl command is invoked that doesn't
# exist in the interpreter.  It takes the following steps to make the
# command available:
#
#	1. See if the command has the form "namespace inscope ns cmd" and
#	   if so, concatenate its arguments onto the end and evaluate it.
#	1. See if the autoload facility can locate the command in a
#	2. See if the autoload facility can locate the command in a
#	   Tcl script file.  If so, load it and execute it.
#	2. If the command was invoked interactively at top-level:
#	3. If the command was invoked interactively at top-level:
#	    (a) see if the command exists as an executable UNIX program.
#		If so, "exec" the command.
#	    (b) see if the command requests csh-like history substitution
#		in one of the common forms !!, !<number>, or ^old^new.  If
#		so, emulate csh's history substitution.
#	    (c) see if the command is a unique abbreviation for another
#		command.  If so, invoke the command.
#
# Arguments:
# args -	A list whose elements are the words of the original
#		command, including the command name.

proc unknown args {
    variable ::tcl::UnknownPending
    global auto_noexec auto_noload env tcl_interactive errorInfo errorCode

    if {[info exists errorInfo]} {
	set savedErrorInfo $errorInfo
    }
    if {[info exists errorCode]} {
	set savedErrorCode $errorCode
    # If the command word has the form "namespace inscope ns cmd"
    # then concatenate its arguments onto the end and evaluate it.

    set cmd [lindex $args 0]
    if {[regexp "^:*namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
	#return -code error "You need an {*}"
        set arglist [lrange $args 1 end]
	set ret [catch {uplevel 1 ::$cmd $arglist} result opts]
	dict unset opts -errorinfo
	dict incr opts -level
	return -options $opts $result
    }

    catch {set savedErrorInfo $errorInfo}
    catch {set savedErrorCode $errorCode}
    set name [lindex $args 0]
    set name $cmd
    if {![info exists auto_noload]} {
	#
	# Make sure we're not trying to load the same proc twice.
	#
	if {[info exists UnknownPending($name)]} {
	    return -code error "self-referential recursion\
		    in \"unknown\" for command \"$name\""
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
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







-
-
-
+
+
+
+
+
+
+
+













+
-
-
+
+
-
-
+
-
-
+
-
-
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+

-
-
-
-
-
+
+
-
-







		if {[string bytelength $cinfo] > 150} {
		    set cinfo [string range $cinfo 0 150]
		    while {[string bytelength $cinfo] > 150} {
			set cinfo [string range $cinfo 0 end-1]
		    }
		    append cinfo ...
		}
		set tail "\n    (\"uplevel\" body line 1)\n    invoked\
			from within\n\"uplevel 1 \$args\""
		set expect "$msg\n    while executing\n\"$cinfo\"$tail"
		append cinfo "\"\n    (\"uplevel\" body line 1)"
		append cinfo "\n    invoked from within"
		append cinfo "\n\"uplevel 1 \$args\""
		#
		# Try each possible form of the stack trace
		# and trim the extra contribution from the matching case
		#
		set expect "$msg\n    while executing\n\"$cinfo"
		if {$errInfo eq $expect} {
		    #
		    # The stack has only the eval from the expanded command
		    # Do not generate any stack trace here.
		    #
		    dict unset opts -errorinfo
		    dict incr opts -level
		    return -options $opts $msg
		}
		#
		# Stack trace is nested, trim off just the contribution
		# from the extra "eval" of $args due to the "catch" above.
		#
		set expect "\n    invoked from within\n\"$cinfo"
		set last [string last $tail $errInfo]
		if {$last + [string length $tail] != [string length $errInfo]} {
		set exlen [string length $expect]
		set eilen [string length $errInfo]
		    # Very likely cannot happen
		    return -options $opts $msg
		set i [expr {$eilen - $exlen - 1}]
		}
		set errInfo [string range $errInfo 0 $last-1]
		set einfo [string range $errInfo 0 $i]
		set tail "\"$cinfo\""
		set last [string last $tail $errInfo]
		#
		# For now verify that $errInfo consists of what we are about
		if {$last < 0 || $last + [string length $tail] != [string length $errInfo]} {
		    return -code error -errorcode $errCode \
			    -errorinfo $errInfo $msg
		# to return plus what we expected to trim off.
		#
		if {$errInfo ne "$einfo$expect"} {
		}
		set errInfo [string range $errInfo 0 $last-1]
		set tail "\n    invoked from within\n"
		set last [string last $tail $errInfo]
		if {$last + [string length $tail] == [string length $errInfo]} {
		    return -code error -errorcode $errCode \
			    -errorinfo [string range $errInfo 0 $last-1] $msg
		    error "Tcl bug: unexpected stack trace in \"unknown\"" {} \
			[list CORE UNKNOWN BADTRACE $einfo $expect $errInfo]
		}
		set tail "\n    while executing\n"
		set last [string last $tail $errInfo]
		if {$last + [string length $tail] == [string length $errInfo]} {
		    return -code error -errorcode $errCode \
			    -errorinfo [string range $errInfo 0 $last-1] $msg
		return -code error -errorcode $errCode \
			-errorinfo $einfo $msg
		}
		return -options $opts $msg
	    } else {
		dict incr opts -level
		return -options $opts $msg
	    }
	}
    }

332
333
334
335
336
337
338
339
340

341
342
343
344
345
346
347
408
409
410
411
412
413
414


415
416
417
418
419
420
421
422







-
-
+







	    dict incr ::tcl::UnknownOptions -level
	    return -options $::tcl::UnknownOptions $::tcl::UnknownResult
	}
	if {[llength $cmds]} {
	    return -code error "ambiguous command name \"$name\": [lsort $cmds]"
	}
    }
    return -code error -errorcode [list TCL LOOKUP COMMAND $name] \
	"invalid command name \"$name\""
    return -code error "invalid command name \"$name\""
}

# auto_load --
# Checks a collection of library directories to see if a procedure
# is defined in one of them.  If so, it sources the appropriate
# library file to create the procedure.  Returns 1 if it successfully
# loaded the procedure, 0 otherwise.
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
466
467
468
469
470
471
472
















473
474
475
476
477
478
479







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







		return 1
	    }
	}
    }
    return 0
}

# ::tcl::Pkg::source --
# This procedure provides an alternative "source" command, which doesn't
# register the file for the "package files" command. Safe interpreters
# don't have to do anything special.
#
# Arguments:
# filename

proc ::tcl::Pkg::source {filename} {
    if {[interp issafe]} {
	uplevel 1 [list ::source $filename]
    } else {
	uplevel 1 [list ::source -nopkg $filename]
    }
}

# auto_load_index --
# Loads the contents of tclIndex files on the auto_path directory
# list.  This is usually invoked within auto_load to load the index
# of available commands.  Returns 1 if the index is loaded, and 0 if
# the index is already loaded and up to date.
#
# Arguments:
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
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







-
+











-
+







	set f ""
	if {$issafe} {
	    catch {source [file join $dir tclIndex]}
	} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
	    continue
	} else {
	    set error [catch {
		fconfigure $f -eofchar \032
		fconfigure $f -eofchar "\032 {}"
		set id [gets $f]
		if {$id eq "# Tcl autoload index file, version 2.0"} {
		    eval [read $f]
		} elseif {$id eq "# Tcl autoload index file: each line identifies a Tcl"} {
		    while {[gets $f line] >= 0} {
			if {([string index $line 0] eq "#") \
				|| ([llength $line] != 2)} {
			    continue
			}
			set name [lindex $line 0]
			set auto_index($name) \
				"::tcl::Pkg::source [file join $dir [lindex $line 1]]"
				"source [file join $dir [lindex $line 1]]"
		    }
		} else {
		    error "[file join $dir tclIndex] isn't a proper Tcl index file"
		}
	    } msg opts]
	    if {$f ne ""} {
		close $f
587
588
589
590
591
592
593
594

595
596
597
598
599
600
601
646
647
648
649
650
651
652

653
654
655
656
657
658
659
660







-
+







    global auto_execs env tcl_platform

    if {[info exists auto_execs($name)]} {
	return $auto_execs($name)
    }
    set auto_execs($name) ""

    set shellBuiltins [list assoc cls copy date del dir echo erase ftype \
    set shellBuiltins [list assoc cls copy date del dir echo erase exit ftype \
	    md mkdir mklink move rd ren rename rmdir start time type ver vol]
    if {[info exists env(PATHEXT)]} {
	# Add an initial ; to have the {} extension check first.
	set execExtensions [split ";$env(PATHEXT)" ";"]
    } else {
	set execExtensions [list {} .com .exe .bat .cmd]
    }
624
625
626
627
628
629
630

631



632
633
634
635
636
637
638
683
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698
699
700







+
-
+
+
+







    set path "[file dirname [info nameof]];.;"
    if {[info exists env(SystemRoot)]} {
	set windir $env(SystemRoot)
    } elseif {[info exists env(WINDIR)]} {
	set windir $env(WINDIR)
    }
    if {[info exists windir]} {
	if {$tcl_platform(os) eq "Windows NT"} {
	append path "$windir/system32;$windir/system;$windir;"
	    append path "$windir/system32;"
	}
	append path "$windir/system;$windir;"
    }

    foreach var {PATH Path path} {
	if {[info exists env($var)]} {
	    append path ";$env($var)"
	}
    }

Deleted library/install.tcl.

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























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
###
# Installer actions built into tclsh and invoked
# if the first command line argument is "install"
###
if {[llength $argv] < 2} {
  exit 0
}
namespace eval ::practcl {}
###
# Installer tools
###
proc ::practcl::_isdirectory name {
  return [file isdirectory $name]
}
###
# Return true if the pkgindex file contains
# any statement other than "package ifneeded"
# and/or if any package ifneeded loads a DLL
###
proc ::practcl::_pkgindex_directory {path} {
  set buffer {}
  set pkgidxfile [file join $path pkgIndex.tcl]
  if {![file exists $pkgidxfile]} {
    # No pkgIndex file, read the source
    foreach file [glob -nocomplain $path/*.tm] {
      set file [file normalize $file]
      set fname [file rootname [file tail $file]]
      ###
      # We used to be able to ... Assume the package is correct in the filename
      # No hunt for a "package provides"
      ###
      set package [lindex [split $fname -] 0]
      set version [lindex [split $fname -] 1]
      ###
      # Read the file, and override assumptions as needed
      ###
      set fin [open $file r]
      fconfigure $fin -encoding utf-8 -eofchar \032
      set dat [read $fin]
      close $fin
      # Look for a teapot style Package statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 9] != "# Package " } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        break
      }
      # Look for a package provide statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 14] != "package provide" } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        break
      }
      append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
    }
    foreach file [glob -nocomplain $path/*.tcl] {
      if { [file tail $file] == "version_info.tcl" } continue
      set fin [open $file r]
      fconfigure $fin -encoding utf-8 -eofchar \032
      set dat [read $fin]
      close $fin
      if {![regexp "package provide" $dat]} continue
      set fname [file rootname [file tail $file]]
      # Look for a package provide statement
      foreach line [split $dat \n] {
        set line [string trim $line]
        if { [string range $line 0 14] != "package provide" } continue
        set package [lindex $line 2]
        set version [lindex $line 3]
        if {[string index $package 0] in "\$ \[ @"} continue
        if {[string index $version 0] in "\$ \[ @"} continue
        append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
        break
      }
    }
    return $buffer
  }
  set fin [open $pkgidxfile r]
  fconfigure $fin -encoding utf-8 -eofchar \032
  set dat [read $fin]
  close $fin
  set trace 0
  #if {[file tail $path] eq "tool"} {
  #  set trace 1
  #}
  set thisline {}
  foreach line [split $dat \n] {
    append thisline $line \n
    if {![info complete $thisline]} continue
    set line [string trim $line]
    if {[string length $line]==0} {
      set thisline {} ; continue
    }
    if {[string index $line 0] eq "#"} {
      set thisline {} ; continue
    }
    if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} {
      if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"}
      set thisline {} ; continue
    }
    if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} {
      if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" }
      set thisline {} ; continue
    }
    if {![regexp "package.*ifneeded" $thisline]} {
      # This package index contains arbitrary code
      # source instead of trying to add it to the main
      # package index
      if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" }
      return {source [file join $dir pkgIndex.tcl]}
    }
    append buffer $thisline \n
    set thisline {}
  }
  if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]}
  return $buffer
}


proc ::practcl::_pkgindex_path_subdir {path} {
  set result {}
  foreach subpath [glob -nocomplain [file join $path *]] {
    if {[file isdirectory $subpath]} {
      lappend result $subpath {*}[_pkgindex_path_subdir $subpath]
    }
  }
  return $result
}
###
# Index all paths given as though they will end up in the same
# virtual file system
###
proc ::practcl::pkgindex_path args {
  set stack {}
  set buffer {
lappend ::PATHSTACK $dir
  }
  foreach base $args {
    set base [file normalize $base]
    set paths {}
    foreach dir [glob -nocomplain [file join $base *]] {
      if {[file tail $dir] eq "teapot"} continue
      lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir]
    }
    set i    [string length  $base]
    # Build a list of all of the paths
    if {[llength $paths]} {
      foreach path $paths {
        if {$path eq $base} continue
        set path_indexed($path) 0
      }
    } else {
      puts [list WARNING: NO PATHS FOUND IN $base]
    }
    set path_indexed($base) 1
    set path_indexed([file join $base boot tcl]) 1
    foreach teapath [glob -nocomplain [file join $base teapot *]] {
      set pkg [file tail $teapath]
      append buffer [list set pkg $pkg]
      append buffer {
set pkginstall [file join $::g(HOME) teapot $pkg]
if {![file exists $pkginstall]} {
  installDir [file join $dir teapot $pkg] $pkginstall
}
}
    }
    foreach path $paths {
      if {$path_indexed($path)} continue
      set thisdir [file_relative $base $path]
      set idxbuf [::practcl::_pkgindex_directory $path]
      if {[string length $idxbuf]} {
        incr path_indexed($path)
        append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n
        append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n
      }
    }
  }
  append buffer {
set dir [lindex $::PATHSTACK end]
set ::PATHSTACK [lrange $::PATHSTACK 0 end-1]
}
  return $buffer
}

###
# topic: 64319f4600fb63c82b2258d908f9d066
# description: Script to build the VFS file system
###
proc ::practcl::installDir {d1 d2} {

  puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]]
  file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      installDir $f [file join $d2 $ftail]
    } elseif {[file isfile $f]} {
	    file copy -force $f [file join $d2 $ftail]
	    if {$::tcl_platform(platform) eq {unix}} {
        file attributes [file join $d2 $ftail] -permissions 0644
	    } else {
        file attributes [file join $d2 $ftail] -readonly 1
	    }
    }
  }

  if {$::tcl_platform(platform) eq {unix}} {
    file attributes $d2 -permissions 0755
  } else {
    file attributes $d2 -readonly 1
  }
}

proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
  #if {$toplevel} {
  #  puts [list ::practcl::copyDir $d1 -> $d2]
  #}
  #file delete -force -- $d2
  file mkdir $d2

  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
    set f [file join $d1 $ftail]
    if {[file isdirectory $f] && [string compare CVS $ftail]} {
      copyDir $f [file join $d2 $ftail] 0
    } elseif {[file isfile $f]} {
      file copy -force $f [file join $d2 $ftail]
    }
  }
}

switch [lindex $argv 1] {
  mkzip {
    zipfs mkzip {*}[lrange $argv 2 end]
  }
  mkzip {
    zipfs mkimg {*}[lrange $argv 2 end]
  }
  default {
    ::practcl::[lindex $argv 1] {*}[lrange $argv 2 end]
  }
}
exit 0

Deleted library/manifest.txt.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
###
# Package manifest for all Tcl packages included in the /library file system
###
apply {{dir} {
  set ::test [info script]
  set isafe [interp issafe]
  foreach {safe package version file} {
    0 http            2.10.0a1  {http http.tcl}
    1 msgcat          1.7.1  {msgcat msgcat.tcl}
    1 opt             0.4.8  {opt optparse.tcl}
    0 cookiejar       0.2.0  {cookiejar cookiejar.tcl}
    0 tcl::idna       1.0.1  {cookiejar idna.tcl}
    0 platform        1.0.14 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.3  {tcltest tcltest.tcl}
  } {
    if {$isafe && !$safe} continue
    package ifneeded $package $version  [list source [file join $dir {*}$file]]
  }
}} $dir

Changes to library/msgcat/msgcat.tcl.

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
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






-






-
-
+


-
+


-
-
-
-
+
+
+
+
+




-
-
-



-
-
-
-
-
-

-
+



-
-
-
-
-
-







# msgcat.tcl --
#
#	This file defines various procedures which implement a
#	message catalog facility for Tcl programs.  It should be
#	loaded with the command "package require msgcat".
#
# Copyright (c) 2010-2018 by Harald Oehlmann.
# Copyright (c) 1998-2000 by Ajuba Solutions.
# Copyright (c) 1998 by Mark Harrison.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# We use oo::define::self, which is new in Tcl 8.7
package require Tcl 8.7-
package require Tcl 8.5
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
package provide msgcat 1.7.1
package provide msgcat 1.5.2

namespace eval msgcat {
    namespace export mc mcn mcexists mcload mclocale mcmax\
	    mcmset mcpreferences mcset\
            mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
	    mcpackagenamespaceget mcpackageconfig mcpackagelocale mcutil
    namespace export mc mcload mclocale mcmax mcmset mcpreferences mcset \
	    mcunknown mcflset mcflmset

    # Records the current locale as passed to mclocale
    variable Locale ""

    # Records the list of locales to search
    variable Loclist {}

    # List of currently loaded locales
    variable LoadedLocales {}

    # Records the locale of the currently sourced message catalogue file
    variable FileLocale

    # Configuration values per Package (e.g. client namespace).
    # The dict key is of the form "<option> <namespace>" and the value is the
    # configuration option. A nonexisting key is an unset option.
    variable PackageConfig [dict create mcfolder {} loadcmd {} changecmd {}\
	    unknowncmd {} loadedlocales {} loclist {}]

    # Records the mapping between source strings and translated strings.  The
    # dict key is of the form "<namespace> <locale> <src>", where locale and
    # dict key is of the form "<locale> <namespace> <src>", where locale and
    # namespace should be themselves dict values and the value is
    # the translated string.
    variable Msgs [dict create]
}

# create ensemble namespace for mcutil command
namespace eval msgcat::mcutil {
    namespace export getsystemlocale getpreferences
    namespace ensemble create -prefix 0

    # Map of language codes used in Windows registry to those of ISO-639
    if {[info sharedlibextension] eq ".dll"} {
	variable WinRegToISO639 [dict create  {*}{
	    01 ar 0401 ar_SA 0801 ar_IQ 0c01 ar_EG 1001 ar_LY 1401 ar_DZ
		  1801 ar_MA 1c01 ar_TN 2001 ar_OM 2401 ar_YE 2801 ar_SY
		  2c01 ar_JO 3001 ar_LB 3401 ar_KW 3801 ar_AE 3c01 ar_BH
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
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







-
+

-
-









-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





+

-
+

-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
+
-
-
-
-


-


+
-
+
+












-
+



-
+








-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-

+
+

-
+








-
+




-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+






-
+
-



-
+









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



















-
+



-
+




















-
-
+
+

+
+
+
+
+
-
+
+



















-
+



-
+


-
+




















-
-
+
+

+
+
+
+
+
+
+
+
-
+
+
+





-
-
+



-
+









-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-

-
+










-
+







}

# msgcat::mc --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the local namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the translated
#	specified, use the format command to work them into the traslated
#	string.
#	If no catalog item is found, mcunknown is called in the caller frame
#	and its result is returned.
#
# Arguments:
#	src	The string to translate.
#	args	Args to pass to the format command
#
# Results:
#	Returns the translated string.  Propagates errors thrown by the
#	format command.

proc msgcat::mc {args} {
proc msgcat::mc {src args} {
    tailcall mcn [PackageNamespaceGet] {*}$args
}

# msgcat::mcn --
#
#	Find the translation for the given string based on the current
#	locale setting. Check the passed namespace first, then look in each
#	parent namespace until the source is found.  If additional args are
#	specified, use the format command to work them into the translated
#	string.
#	If no catalog item is found, mcunknown is called in the caller frame
#	and its result is returned.
#
# Arguments:
#	ns	Package namespace of the translation
#	src	The string to translate.
#	args	Args to pass to the format command
#
# Results:
#	Returns the translated string.  Propagates errors thrown by the
#	format command.

proc msgcat::mcn {ns src args} {

    # Check for the src in each namespace starting from the local and
    # ending in the global.

    variable Msgs
    variable Loclist
    variable Locale

    set loclist [PackagePreferences $ns]
    set ns [uplevel 1 [list ::namespace current]]

    set nscur $ns
    while {$nscur != ""} {
	foreach loc $loclist {
	    if {[dict exists $Msgs $nscur $loc $src]} {
    while {$ns != ""} {
	foreach loc $Loclist {
	    if {[dict exists $Msgs $loc $ns $src]} {
		return [DefaultUnknown "" [dict get $Msgs $nscur $loc $src]\
			{*}$args]
	    }
	}
	set nscur [namespace parent $nscur]
    }
    # call package local or default unknown command
    set args [linsert $args 0 [lindex $loclist 0] $src]
    switch -exact -- [Invoke unknowncmd $args $ns result 1] {
	0 { tailcall mcunknown {*}$args }
	1 { return [DefaultUnknown {*}$args] }
	default { return $result }
    }
}

# msgcat::mcexists --
#
#	Check if a catalog item is set or if mc would invoke mcunknown.
#
# Arguments:
#	-exactnamespace		Only check the exact namespace and no
#				parent namespaces
#	-exactlocale		Only check the exact locale and not all members
#				of the preferences list
#	src			Message catalog key
#
# Results:
#	true if an adequate catalog key was found

proc msgcat::mcexists {args} {

    variable Msgs
    variable Loclist
    variable PackageConfig

    while {[llength $args] != 1} {
	set args [lassign $args option]
	switch -glob -- $option {
	    -exactnamespace - -exactlocale { set $option 1 }
	    -namespace {
		if {[llength $args] < 2} {
		    return -code error\
		if {[llength $args] == 0} {
		    return [dict get $Msgs $loc $ns $src]
			    "Argument missing for switch \"-namespace\""
		}
		set args [lassign $args ns]
	    }
	    -* { return -code error "unknown option \"$option\"" }
	    default {
		return -code error "wrong # args: should be\
			\"[lindex [info level 0] 0] ?-exactnamespace?\
			?-exactlocale? ?-namespace ns? src\""
	    }
	}
    }
    set src [lindex $args 0]

		} else {
    if {![info exists ns]} { set ns [PackageNamespaceGet] }

		    return [format [dict get $Msgs $loc $ns $src] {*}$args]
    set loclist [PackagePreferences $ns]
    if {[info exists -exactlocale]} { set loclist [lrange $loclist 0 0] }

		}
    while {$ns ne ""} {
	foreach loc $loclist {
	    if {[dict exists $Msgs $ns $loc $src]} {
		return 1
	    }
	}
	if {[info exists -exactnamespace]} {return 0}
	set ns [namespace parent $ns]
    }
    # we have not found the translation
    return 0
    return [uplevel 1 [list [namespace origin mcunknown] \
	    $Locale $src {*}$args]]
}

# msgcat::mclocale --
#
#	Query or set the current locale.
#
# Arguments:
#	newLocale	(Optional) The new locale string. Locale strings
#			should be composed of one or more sublocale parts
#			separated by underscores (e.g. en_US).
#
# Results:
#	Returns the normalized set locale.
#	Returns the current locale.

proc msgcat::mclocale {args} {
    variable Loclist
    variable LoadedLocales
    variable Locale
    set len [llength $args]

    if {$len > 1} {
	return -code error "wrong # args: should be\
		\"[lindex [info level 0] 0] ?newLocale?\""
    }

    if {$len == 1} {
	set newLocale [string tolower [lindex $args 0]]
	set newLocale [lindex $args 0]
	if {$newLocale ne [file tail $newLocale]} {
	    return -code error "invalid newLocale value \"$newLocale\":\
		    could be path to unsafe code."
	}
	mcpreferences {*}[mcutil getpreferences $newLocale]
    }
    return [lindex $Loclist 0]
}

# msgcat::mcutil::getpreferences --
#
#	Get list of locales from a locale.
#	The first element is always the lowercase locale.
#	Other elements have one component separated by "_" less.
#	Multiple "_" are seen as one separator: de__ch_spec de__ch de {}
#
#	This method is part of the ensemble mcutil
#
# Arguments:
#	Locale.
#
# Results:
#	Locale list

proc msgcat::mcutil::getpreferences {locale} {
    set locale [string tolower $locale]
    set result [list {}]
    set el {}
    foreach e [split $locale _] {
	set Locale [string tolower $newLocale]
	set Loclist {}
	set word ""
	foreach part [split $Locale _] {
	if {$el eq {}} {
	    set el ${e}
	} else {
	    set el ${el}_${e}
	}
	    set word [string trim "${word}_${part}" _]
	    if {$word ne [lindex $Loclist 0]} {
		set Loclist [linsert $Loclist 0 $word]
	    }
	if {[string index $el end] != {_}} {
	    set result [linsert $result 0 $el]
	}
	lappend Loclist {}
	set Locale [lindex $Loclist 0]
    }
    return $result
    return $Locale
}

# msgcat::mcpreferences --
#
#	Fetch the list of locales used to look up strings, ordered from
#	most preferred to least preferred.
#
# Arguments:
#	New location list
#	None.
#
# Results:
#	Returns an ordered list of the locales preferred by the user.

proc msgcat::mcpreferences {args} {
proc msgcat::mcpreferences {} {
    variable Loclist

    if {[llength $args] > 0} {
	# args is the new loclist
	if {![ListEqualString $args $Loclist]} {
	    set Loclist $args

	    # locale not loaded jet
	    LoadAll $Loclist
	    # Invoke callback
	    Invoke changecmd $Loclist
	}
    }
    return $Loclist
}

# msgcat::ListStringEqual --
#
#	Compare two strings for equal string contents
#
# Arguments:
#	list1		first list
#	list2		second list
#
# Results:
#	1 if lists of strings are identical, 0 otherwise

proc msgcat::ListEqualString {list1 list2} {
    if {[llength $list1] != [llength $list2]} {
	return 0
    }
    foreach item1 $list1 item2 $list2 {
	if {$item1 ne $item2} {
	    return 0
	}
    }
    return 1
}

# msgcat::mcloadedlocales --
#
#	Get or change the list of currently loaded default locales
#
#	The following subcommands are available:
#	loaded
#	    Get the current list of loaded locales
#	clear
#	    Remove all loaded locales not present in mcpreferences.
#
# Arguments:
#	subcommand		One of loaded or clear
#
# Results:
#	Empty string, if not stated differently for the subcommand

proc msgcat::mcloadedlocales {subcommand} {
    variable Loclist
    variable LoadedLocales
    variable Msgs
    variable PackageConfig
    switch -exact -- $subcommand {
	clear {
	    # Remove all locales not contained in Loclist
	    # skip any packages with package locale
	    set LoadedLocales $Loclist
	    foreach ns [dict keys $Msgs] {
		if {![dict exists $PackageConfig loclist $ns]} {
		    foreach locale [dict keys [dict get $Msgs $ns]] {
			if {$locale ni $Loclist} {
			    dict unset Msgs $ns $locale
			}
		    }
		}
	    }
	}
	loaded { return $LoadedLocales }
	default {
	    return -code error "unknown subcommand \"$subcommand\": must be\
		    clear, or loaded"
	}
    }
    return
}

# msgcat::mcpackagelocale --
#
#	Get or change the package locale of the calling package.
#
#	The following subcommands are available:
#	set
#	    Set a package locale.
#	    This may load message catalog files and may clear message catalog
#	    items, if the former locale was the default locale.
#	    Returns the normalized set locale.
#	    The default locale is taken, if locale is not given.
#	get
#	    Get the locale valid for this package.
#	isset
#	    Returns true, if a package locale is set
#	unset
#	    Unset the package locale and activate the default locale.
#	    This loads message catalog file which where missing in the package
#	    locale.
#	preferences
#	    Return locale preference list valid for the package.
#	loaded
#	    Return loaded locale list valid for the current package.
#	clear
#	    If the current package has a package locale, remove all package
#	    locales not containes in package mcpreferences.
#	    It is an error to call this without a package locale set.
#
#	The subcommands get, preferences and loaded return the corresponding
#	default data, if no package locale is set.
#
# Arguments:
#	subcommand		see list above
#	locale			package locale (only set subcommand)
#
# Results:
#	Empty string, if not stated differently for the subcommand

proc msgcat::mcpackagelocale {subcommand args} {
    # todo: implement using an ensemble
    variable Loclist
    variable LoadedLocales
    variable Msgs
    variable PackageConfig
    # Check option
    # check if required item is exactly provided
    if {    [llength $args] > 0
	    && $subcommand in {"get" "isset" "unset" "loaded" "clear"} } {
	return -code error "wrong # args: should be\
		\"[lrange [info level 0] 0 1]\""
    }
    set ns [PackageNamespaceGet]

    switch -exact -- $subcommand {
	get { return [lindex [PackagePreferences $ns] 0] }
	loaded { return [PackageLocales $ns] }
	present {
	    if {[llength $args] != 1} {
		return -code error "wrong # args: should be\
			\"[lrange [info level 0] 0 1] locale\""
	    }
	    return [expr {[string tolower [lindex $args 0]]
		    in [PackageLocales $ns]} ]
	}
	isset { return [dict exists $PackageConfig loclist $ns] }
	set - preferences {
	    # set a package locale or add a package locale
	    set fSet [expr {$subcommand eq "set"}]

	    # Check parameter
	    if {$fSet && 1 < [llength $args] } {
		return -code error "wrong # args: should be\
			\"[lrange [info level 0] 0 1] ?locale?\""
	    }

	    # > Return preferences if no parameter
	    if {!$fSet && 0 == [llength $args] } {
		return [PackagePreferences $ns]
	    }

	    # Copy the default locale if no package locale set so far
	    if {![dict exists $PackageConfig loclist $ns]} {
		dict set PackageConfig loclist $ns $Loclist
		dict set PackageConfig loadedlocales $ns $LoadedLocales
	    }

	    # No argument for set: return current package locale
	    # The difference to no argument and subcommand "preferences" is,
	    # that "preferences" does not set the package locale property.
	    # This case is processed above, so no check for fSet here
	    if { 0 == [llength $args] } {
		return [lindex [dict get $PackageConfig loclist $ns] 0]
	    }

	    # Get new loclist
	    if {$fSet} {
		set loclist [mcutil getpreferences [lindex $args 0]]
	    } else {
		set loclist $args
	    }

	    # Check if not changed to return imediately
	    if {    [ListEqualString $loclist\
			[dict get $PackageConfig loclist $ns]] } {
		if {$fSet} {
		    return [lindex $loclist 0]
		}
		return $loclist
	    }

	    # Change loclist
	    dict set PackageConfig loclist $ns $loclist

	    # load eventual missing locales
	    set loadedLocales [dict get $PackageConfig loadedlocales $ns]
	    set loadLocales [ListComplement $loadedLocales $loclist]
	    dict set PackageConfig loadedlocales $ns\
		    [concat $loadedLocales $loadLocales]
	    Load $ns $loadLocales
	    if {$fSet} {
		return [lindex $loclist 0]
	    }
	    return $loclist
	}
	clear { # Remove all locales not contained in Loclist
	    if {![dict exists $PackageConfig loclist $ns]} {
		return -code error "clear only when package locale set"
	    }
	    set loclist [dict get $PackageConfig loclist $ns]
	    dict set PackageConfig loadedlocales $ns $loclist
	    if {[dict exists $Msgs $ns]} {
		foreach locale [dict keys [dict get $Msgs $ns]] {
		    if {$locale ni $loclist} {
			dict unset Msgs $ns $locale
		    }
		}
	    }
	}
	unset {	# unset package locale and restore default locales

	    if { ![dict exists $PackageConfig loclist $ns] } { return }

	    # unset package locale
	    set loadLocales [ListComplement\
		    [dict get $PackageConfig loadedlocales $ns] $LoadedLocales]
	    dict unset PackageConfig loadedlocales $ns
	    dict unset PackageConfig loclist $ns

	    # unset keys not in global loaded locales
	    if {[dict exists $Msgs $ns]} {
		foreach locale [dict keys [dict get $Msgs $ns]] {
		    if {$locale ni $LoadedLocales} {
			dict unset Msgs $ns $locale
		    }
		}
	    }

	    # Add missing locales
	    Load $ns $loadLocales
	}
	default {
	    return -code error "unknown subcommand \"$subcommand\": must be\
		    clear, get, isset, loaded, present, set, or unset"
	}
    }
    return
}

# msgcat::mcforgetpackage --
#
#	Remove any data of the calling package from msgcat
#

proc msgcat::mcforgetpackage {} {
    # todo: this may be implemented using an ensemble
    variable PackageConfig
    variable Msgs
    set ns [PackageNamespaceGet]
    # Remove MC items
    dict unset Msgs $ns
    # Remove config items
    foreach key [dict keys $PackageConfig] {
	dict unset PackageConfig $key $ns
    }
    return
}

# msgcat::mcgetmynamespace --
#
#	Return the package namespace of the caller
#	This consideres to be called from a class or object.

proc msgcat::mcpackagenamespaceget {} {
    return [PackageNamespaceGet]
}

# msgcat::mcpackageconfig --
#
#	Get or modify the per caller namespace (e.g. packages) config options.
#
#	Available subcommands are:
#
#	    get		get the current value or an error if not set.
#	    isset	return true, if the option is set
#	    set		set the value (see also distinct option).
#			Returns the number of loaded message files.
#	    unset	Clear option. return "".
#
#	Available options are:
#
#	mcfolder
#	    The message catalog folder of the package.
#	    This is automatically set by mcload.
#	    If the value is changed using the set subcommand, an evntual
#	    loadcmd is invoked and all message files of the package locale are
#	    loaded.
#
#	loadcmd
#	    The command gets executed before a message file would be
#	    sourced for this module.
#	    The command is invoked with the expanded locale list to load.
#	    The command is not invoked if the registering package namespace
#	    is not present.
#	    This callback might also be used as an alternative to message
#	    files.
#	    If the value is changed using the set subcommand, the callback is
#	    directly invoked with the current file locale list. No file load is
#	    executed.
#
#	changecmd
#	    The command is invoked, after an executed locale change.
#	    Appended argument is expanded mcpreferences.
#
#	unknowncmd
#	    Use a package locale mcunknown procedure instead the global one.
#	    The appended arguments are identical to mcunknown.
#	    A default unknown handler is used if set to the empty string.
#	    This consists in returning the key if no arguments are given.
#	    With given arguments, format is used to process the arguments.
#
# Arguments:
#	subcommand		Operation on the package
#	option			The package option to get or set.
#	?value?			Eventual value for the subcommand
#
# Results:
#	Depends on the subcommand and option and is described there

proc msgcat::mcpackageconfig {subcommand option {value ""}} {
    variable PackageConfig
    # get namespace
    set ns [PackageNamespaceGet]

    if {$option ni {"mcfolder" "loadcmd" "changecmd" "unknowncmd"}} {
	return -code error "bad option \"$option\": must be mcfolder, loadcmd,\
		changecmd, or unknowncmd"
    }

    # check if value argument is exactly provided
    if {[llength [info level 0]] == 4 } {
	# value provided
	if {$subcommand in {"get" "isset" "unset"}} {
	    return -code error "wrong # args: should be\
		    \"[lrange [info level 0] 0 2] value\""
	}
    } elseif {$subcommand eq "set"} {
        return -code error\
		"wrong # args: should be \"[lrange [info level 0] 0 2]\""
    }

    # Execute subcommands
    switch -exact -- $subcommand {
	get {	# Operation get return current value
	    if {![dict exists $PackageConfig $option $ns]} {
		return -code error "package option \"$option\" not set"
	    }
	    return [dict get $PackageConfig $option $ns]
	}
	isset {	return [dict exists $PackageConfig $option $ns] }
	unset {	dict unset PackageConfig $option $ns }
	set {	# Set option

	    if {$option eq "mcfolder"} {
		set value [file normalize $value]
	    }
	    # Check if changed
	    if { [dict exists $PackageConfig $option $ns]
		    && $value eq [dict get $PackageConfig $option $ns] } {
		return 0
	    }

	    # set new value
	    dict set PackageConfig $option $ns $value

	    # Reload pending message catalogs
	    switch -exact -- $option {
		mcfolder { return [Load $ns [PackageLocales $ns]] }
		loadcmd { return [Load $ns [PackageLocales $ns] 1] }
	    }
	    return 0
	}
	default {
	    return -code error "unknown subcommand \"$subcommand\":\
		    must be get, isset, set, or unset"
	}
    }
    return
}

# msgcat::PackagePreferences --
#
#	Return eventual present package preferences or the default list if not
#	present.
#
# Arguments:
#	ns		Package namespace
#
# Results:
#	locale list

proc msgcat::PackagePreferences {ns} {
    variable PackageConfig
    if {[dict exists $PackageConfig loclist $ns]} {
	return [dict get $PackageConfig loclist $ns]
    }
    variable Loclist
    return $Loclist
}

# msgcat::PackageLocales --
#
#	Return eventual present package locales or the default list if not
#	present.
#
# Arguments:
#	ns		Package namespace
#
# Results:
#	locale list

proc msgcat::PackageLocales {ns} {
    variable PackageConfig
    if {[dict exists $PackageConfig loadedlocales $ns]} {
	return [dict get $PackageConfig loadedlocales $ns]
    }
    variable LoadedLocales
    return $LoadedLocales
}

# msgcat::ListComplement --
#
#	Build the complement of two lists.
#	Return a list with all elements in list2 but not in list1.
#	Optionally return the intersection.
#
# Arguments:
#	list1		excluded list
#	list2		included list
#	inlistname	If not "", write in this variable the intersection list
#
# Results:
#	list with all elements in list2 but not in list1

proc msgcat::ListComplement {list1 list2 {inlistname ""}} {
    if {"" ne $inlistname} {
	upvar 1 $inlistname inlist
    }
    set inlist {}
    set outlist {}
    foreach item $list2 {
	if {$item in $list1} {
	    lappend inlist $item
	} else {
	    lappend outlist $item
	}
    }
    return $outlist
}

# msgcat::mcload --
#
#	Attempt to load message catalogs for each locale in the
#	preference list from the specified directory.
#
# Arguments:
#	langdir		The directory to search.
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::mcload {langdir} {
    tailcall mcpackageconfig set mcfolder $langdir
}

# msgcat::LoadAll --
#
#	Load a list of locales for all packages not having a package locale
#	list.
#
# Arguments:
#	langdir		The directory to search.
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::LoadAll {locales} {
    variable PackageConfig
    variable LoadedLocales
    if {0 == [llength $locales]} { return {} }
    # filter jet unloaded locales
    set locales [ListComplement $LoadedLocales $locales]
    if {0 == [llength $locales]} { return {} }
    lappend LoadedLocales {*}$locales

    set packages [lsort -unique [concat\
	    [dict keys [dict get $PackageConfig loadcmd]]\
	    [dict keys [dict get $PackageConfig mcfolder]]]]
    foreach ns $packages {
	if {! [dict exists $PackageConfig loclist $ns] } {
	    Load $ns $locales
	}
    }
    return $locales
}

# msgcat::Load --
#
#	Invoke message load callback and load message catalog files.
#
# Arguments:
#	ns		Namespace (equal package) to load the message catalog.
#	locales		List of locales to load.
#	callbackonly	true if only callback should be invoked
#
# Results:
#	Returns the number of message catalogs that were loaded.

proc msgcat::Load {ns locales {callbackonly 0}} {
    variable FileLocale
    variable PackageConfig
    variable LoadedLocals

    if {0 == [llength $locales]} { return 0 }

    # Invoke callback
    Invoke loadcmd $locales $ns

    if {$callbackonly || ![dict exists $PackageConfig mcfolder $ns]} {
	return 0
    }

    # Invoke file load
    set langdir [dict get $PackageConfig mcfolder $ns]

    # Save the file locale if we are recursively called
    if {[info exists FileLocale]} {
	set nestedFileLocale $FileLocale
    }
    set x 0
    foreach p $locales {
    foreach p [mcpreferences] {
	if {$p eq {}} {
	    set p ROOT
	}
	set langfile [file join $langdir $p.msg]
	if {[file exists $langfile]} {
	    incr x
	    set FileLocale [string tolower\
	    set FileLocale [string tolower [file tail [file rootname $langfile]]]
		    [file tail [file rootname $langfile]]]
	    if {"root" eq $FileLocale} {
		set FileLocale ""
	    }
	    namespace inscope $ns [list ::source -encoding utf-8 $langfile]
	    uplevel 1 [list ::source -encoding utf-8 $langfile]
	    unset FileLocale
	}
    }
    if {[info exists nestedFileLocale]} {
	set FileLocale $nestedFileLocale
    }
    return $x
}

# msgcat::Invoke --
#
#	Invoke a set of registered callbacks.
#	The callback is only invoked, if its registered namespace exists.
#
# Arguments:
#	index		Index into PackageConfig to get callback command
#	arglist		parameters to the callback invocation
#	ns		(Optional) package to call.
#			If not given or empty, check all registered packages.
#	resultname	Variable to save the callback result of the last called
#			callback to. May be set to "" to discard the result.
#	failerror (0)	Fail on error if true. Otherwise call bgerror.
#
# Results:
#	Possible values:
#	- 0: no valid command registered
#	- 1: registered command was the empty string
#	- 2: registered command called, resultname is set
#	- 3: registered command failed
#	If multiple commands are called, the maximum of all results is returned.

proc msgcat::Invoke {index arglist {ns ""} {resultname ""} {failerror 0}} {
    variable PackageConfig
    variable Config
    if {"" ne $resultname} {
	upvar 1 $resultname result
    }
    if {"" eq $ns} {
	set packageList [dict keys [dict get $PackageConfig $index]]
    } else {
	set packageList [list $ns]
    }
    set ret 0
    foreach ns $packageList {
	if {[dict exists $PackageConfig $index $ns] && [namespace exists $ns]} {
	    set cmd [dict get $PackageConfig $index $ns]
	    if {"" eq $cmd} {
		if {$ret == 0} {set ret 1}
	    } else {
		if {$failerror} {
		    set result [namespace inscope $ns $cmd {*}$arglist]
		    set ret 2
		} elseif {1 == [catch {
		    set result [namespace inscope $ns $cmd {*}$arglist]
		    if {$ret < 2} {set ret 2}
		} err derr]} {
		    after idle [concat [::interp bgerror ""]\
			    [list $err $derr]]
		    set ret 3
		}
	    }
	}
    }
    return $ret
}

# msgcat::mcset --
#
#	Set the translation for a given string in a specified locale.
#
# Arguments:
#	locale		The locale to use.
#	src		The source string.
#	dest		(Optional) The translated string.  If omitted,
#			the source string is used.
#
# Results:
#	Returns the new locale.

proc msgcat::mcset {locale src {dest ""}} {
    variable Msgs
    if {[llength [info level 0]] == 3} { ;# dest not specified
	set dest $src
    }

    set ns [PackageNamespaceGet]
    set ns [uplevel 1 [list ::namespace current]]

    set locale [string tolower $locale]

    dict set Msgs $ns $locale $src $dest
    dict set Msgs $locale $ns $src $dest
    return $dest
}

# msgcat::mcflset --
#
#	Set the translation for a given string in the current file locale.
#
# Arguments:
#	src		The source string.
#	dest		(Optional) The translated string.  If omitted,
#			the source string is used.
#
# Results:
#	Returns the new locale.

proc msgcat::mcflset {src {dest ""}} {
    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error "must only be used inside a message catalog loaded\
		with ::msgcat::mcload"
	return -code error \
	    "must only be used inside a message catalog loaded with ::msgcat::mcload"
    }
    if {[llength [info level 0]] == 2} { ;# dest not specified
	set dest $src
    }

    set ns [uplevel 1 [list ::namespace current]]
    tailcall mcset $FileLocale $src $dest
    dict set Msgs $FileLocale $ns $src $dest
    return $dest
}

# msgcat::mcmset --
#
#	Set the translation for multiple strings in a specified locale.
#
# Arguments:
#	locale		The locale to use.
#	pairs		One or more src/dest pairs (must be even length)
#
# Results:
#	Returns the number of pairs processed

proc msgcat::mcmset {locale pairs} {
    variable Msgs

    set length [llength $pairs]
    if {$length % 2} {
	return -code error "bad translation list:\
		should be \"[lindex [info level 0] 0] locale {src dest ...}\""
		 should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set locale [string tolower $locale]
    set ns [PackageNamespaceGet]
    set ns [uplevel 1 [list ::namespace current]]

    foreach {src dest} $pairs {
	dict set Msgs $ns $locale $src $dest
	dict set Msgs $locale $ns $src $dest
    }

    return [expr {$length / 2}]
}

# msgcat::mcflmset --
#
#	Set the translation for multiple strings in the mc file locale.
#
# Arguments:
#	pairs		One or more src/dest pairs (must be even length)
#
# Results:
#	Returns the number of pairs processed

proc msgcat::mcflmset {pairs} {
    variable FileLocale
    variable Msgs

    if {![info exists FileLocale]} {
	return -code error "must only be used inside a message catalog loaded\
		with ::msgcat::mcload"
	return -code error \
	    "must only be used inside a message catalog loaded with ::msgcat::mcload"
    }
    set length [llength $pairs]
    if {$length % 2} {
	return -code error "bad translation list:\
		should be \"[lindex [info level 0] 0] locale {src dest ...}\""
    }

    set ns [uplevel 1 [list ::namespace current]]
    foreach {src dest} $pairs {
    tailcall mcmset $FileLocale $pairs
	dict set Msgs $FileLocale $ns $src $dest
    }
    return [expr {$length / 2}]
}

# msgcat::mcunknown --
#
#	This routine is called by msgcat::mc if a translation cannot
#	be found for a string and no unknowncmd is set for the current
#	package. This routine is intended to be replaced
#	be found for a string.  This routine is intended to be replaced
#	by an application specific routine for error reporting
#	purposes.  The default behavior is to return the source string.
#	If additional args are specified, the format command will be used
#	to work them into the translated string.
#	to work them into the traslated string.
#
# Arguments:
#	locale		The current locale.
#	src		The string to be translated.
#	args		Args to pass to the format command
#
# Results:
#	Returns the translated value.

proc msgcat::mcunknown {args} {
proc msgcat::mcunknown {locale src args} {
    tailcall DefaultUnknown {*}$args
}

# msgcat::DefaultUnknown --
#
#	This routine is called by msgcat::mc if a translation cannot
#	be found for a string in the following circumstances:
#	- Default global handler, if mcunknown is not redefined.
#	- Per package handler, if the package sets unknowncmd to the empty
#	  string.
#	It returns the source string if the argument list is empty.
#	If additional args are specified, the format command will be used
#	to work them into the translated string.
#
# Arguments:
#	locale		(unused) The current locale.
#	src		The string to be translated.
#	args		Args to pass to the format command
#
# Results:
#	Returns the translated value.

proc msgcat::DefaultUnknown {locale src args} {
    if {[llength $args]} {
	return [format $src {*}$args]
    } else {
	return $src
    }
}

# msgcat::mcmax --
#
#	Calculates the maximum length of the translated strings of the given
#	list.
#
# Arguments:
#	args	strings to translate.
#
# Results:
#	Returns the length of the longest translated string.

proc msgcat::mcmax {args} {
    set max 0
    set ns [PackageNamespaceGet]
    foreach string $args {
	set translated [uplevel 1 [list [namespace origin mcn] $ns $string]]
	set translated [uplevel 1 [list [namespace origin mc] $string]]
	set len [string length $translated]
	if {$len>$max} {
	    set max $len
	}
    }
    return $max
}

# Convert the locale values stored in environment variables to a form
# suitable for passing to [mclocale]
proc msgcat::mcutil::ConvertLocale {value} {
proc msgcat::ConvertLocale {value} {
    # Assume $value is of form: $language[_$territory][.$codeset][@modifier]
    # Convert to form: $language[_$territory][_$modifier]
    #
    # Comment out expanded RE version -- bugs alleged
    # regexp -expanded {
    #	^		# Match all the way to the beginning
    #	([^_.@]*)	# Match "lanugage"; ends with _, ., or @
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+







+
-
-
+
+
+







+
-
-
+
+
+








+
-
+








-
+







    }
    if {[string length $modifier]} {
	append ret _$modifier
    }
    return $ret
}

# helper function to find package namespace of stack-frame -2
# There are 4 possibilities:
# - called from a proc
# - called within a class definition script
# - called from an class defined oo object
# - called from a classless oo object
proc ::msgcat::PackageNamespaceGet {} {
    uplevel 2 {
	# Check self namespace to determine environment
	switch -exact -- [namespace which self] {
	    {::oo::define::self} {
		# We are within a class definition
		return [namespace qualifiers [self]]
	    }
	    {::oo::Helpers::self} {
		# We are within an object
		set Class [info object class [self]]
		# Check for classless defined object
		if {$Class eq {::oo::object}} {
		    return [namespace qualifiers [self]]
		}
		# Class defined object
		return [namespace qualifiers $Class]
	    }
	    default {
		# Not in object environment
		return [namespace current]
	    }
	}
    }
}

# Initialize the default locale
proc msgcat::mcutil::getsystemlocale {} {
proc msgcat::Init {} {
    global env

    #
    # set default locale, try to get from environment
    #
    foreach varName {LC_ALL LC_MESSAGES LANG} {
	if {[info exists env($varName)] && ("" ne $env($varName))} {
	    if {![catch {
	    if {![catch { ConvertLocale $env($varName) } locale]} {
		return $locale
		mclocale [ConvertLocale $env($varName)]
	    }]} {
		return
	    }
	}
    }
    #
    # On Darwin, fallback to current CFLocale identifier if available.
    #
    if {[info exists ::tcl::mac::locale] && $::tcl::mac::locale ne ""} {
	if {![catch {
	if {![catch { ConvertLocale $::tcl::mac::locale } locale]} {
	    return $locale
	    mclocale [ConvertLocale $::tcl::mac::locale]
	}]} {
	    return
	}
    }
    #
    # The rest of this routine is special processing for Windows or
    # Cygwin. All other platforms, get out now.
    #
    if {([info sharedlibextension] ne ".dll")
	    || [catch {package require registry}]} {
	mclocale C
	return C
	return
    }
    #
    # On Windows or Cygwin, try to set locale depending on registry
    # settings, or fall back on locale of "C".
    #

    # On Vista and later:
    # HCU/Control Panel/Desktop : PreferredUILanguages is for language packs,
    # HCU/Control Panel/International : localName is the default locale.
    # HCU/Control Pannel/International : localName is the default locale.
    #
    # They contain the local string as RFC5646, composed of:
    # [a-z]{2,3} : language
    # -[a-z]{4}  : script (optional, translated by table Latn->latin)
    # -[a-z]{2}|[0-9]{3} : territory (optional, numerical region codes not used)
    # (-.*)* : variant, extension, private use (optional, not used)
    # Those are translated to local strings.
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

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







-
-
+
+








+
-
+



-
-
+
+









-
-
-
+
+
+






-
+

-
+
	    if {"" ne $territory} {
		append locale _ $territory
	    }
	    set modifierDict [dict create latn latin cyrl cyrillic]
	    if {[dict exists $modifierDict $script]} {
		append locale @ [dict get $modifierDict $script]
	    }
	    if {![catch {ConvertLocale $locale} locale]} {
		return $locale
	    if {![catch {mclocale [ConvertLocale $locale]}]} {
		return
	    }
	}
    }

    # then check value locale which contains a numerical language ID
    if {[catch {
	set locale [registry get $key "locale"]
    }]} {
	mclocale C
	return C
	return
    }
    #
    # Keep trying to match against smaller and smaller suffixes
    # of the registry value, since the latter hexdigits appear
    # to determine general language and earlier hexdigits determine
    # of the registry value, since the latter hexadigits appear
    # to determine general language and earlier hexadigits determine
    # more precise information, such as territory.  For example,
    #     0409 - English - United States
    #     0809 - English - United Kingdom
    # Add more translations to the WinRegToISO639 array above.
    #
    variable WinRegToISO639
    set locale [string tolower $locale]
    while {[string length $locale]} {
	if {![catch {
	    ConvertLocale [dict get $WinRegToISO639 $locale]
	} localeOut]} {
	    return $localeOut
	    mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]]
	}]} {
	    return
	}
	set locale [string range $locale 1 end]
    }
    #
    # No translation known.  Fall back on "C" locale
    #
    return C
    mclocale C
}
msgcat::mclocale [msgcat::mcutil getsystemlocale]
msgcat::Init

Changes to library/msgcat/pkgIndex.tcl.

1
2




1
2
-
-
+
+
if {![package vsatisfies [package provide Tcl] 8.7-]} {return}
package ifneeded msgcat 1.7.1 [list source [file join $dir msgcat.tcl]]
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded msgcat 1.5.2 [list source [file join $dir msgcat.tcl]]

Changes to library/msgs/ar.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar DAYS_OF_WEEK_ABBREV [list \
        "Ø­"\
        "Ù†"\
        "Ø«"\
        "ر"\
        "Ø®"\
        "ج"\
        "س"]
        "\u062d"\
        "\u0646"\
        "\u062b"\
        "\u0631"\
        "\u062e"\
        "\u062c"\
        "\u0633"]
    ::msgcat::mcset ar DAYS_OF_WEEK_FULL [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
        "\u0627\u0644\u0623\u062d\u062f"\
        "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
        "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
        "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
        "\u0627\u0644\u062e\u0645\u064a\u0633"\
        "\u0627\u0644\u062c\u0645\u0639\u0629"\
        "\u0627\u0644\u0633\u0628\u062a"]
    ::msgcat::mcset ar MONTHS_ABBREV [list \
        "ينا"\
        "Ùبر"\
        "مار"\
        "أبر"\
        "ماي"\
        "يون"\
        "يول"\
        "أغس"\
        "سبت"\
        "أكت"\
        "نوÙ"\
        "ديس"\
        "\u064a\u0646\u0627"\
        "\u0641\u0628\u0631"\
        "\u0645\u0627\u0631"\
        "\u0623\u0628\u0631"\
        "\u0645\u0627\u064a"\
        "\u064a\u0648\u0646"\
        "\u064a\u0648\u0644"\
        "\u0623\u063a\u0633"\
        "\u0633\u0628\u062a"\
        "\u0623\u0643\u062a"\
        "\u0646\u0648\u0641"\
        "\u062f\u064a\u0633"\
        ""]
    ::msgcat::mcset ar MONTHS_FULL [list \
        "يناير"\
        "Ùبراير"\
        "مارس"\
        "أبريل"\
        "مايو"\
        "يونيو"\
        "يوليو"\
        "أغسطس"\
        "سبتمبر"\
        "أكتوبر"\
        "نوÙمبر"\
        "ديسمبر"\
        "\u064a\u0646\u0627\u064a\u0631"\
        "\u0641\u0628\u0631\u0627\u064a\u0631"\
        "\u0645\u0627\u0631\u0633"\
        "\u0623\u0628\u0631\u064a\u0644"\
        "\u0645\u0627\u064a\u0648"\
        "\u064a\u0648\u0646\u064a\u0648"\
        "\u064a\u0648\u0644\u064a\u0648"\
        "\u0623\u063a\u0633\u0637\u0633"\
        "\u0633\u0628\u062a\u0645\u0628\u0631"\
        "\u0623\u0643\u062a\u0648\u0628\u0631"\
        "\u0646\u0648\u0641\u0645\u0628\u0631"\
        "\u062f\u064a\u0633\u0645\u0628\u0631"\
        ""]
    ::msgcat::mcset ar BCE "Ù‚.Ù…"
    ::msgcat::mcset ar CE "Ù…"
    ::msgcat::mcset ar AM "ص"
    ::msgcat::mcset ar PM "Ù…"
    ::msgcat::mcset ar BCE "\u0642.\u0645"
    ::msgcat::mcset ar CE "\u0645"
    ::msgcat::mcset ar AM "\u0635"
    ::msgcat::mcset ar PM "\u0645"
    ::msgcat::mcset ar DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset ar TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset ar DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}

Changes to library/msgs/ar_jo.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar_JO DAYS_OF_WEEK_ABBREV [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
        "\u0627\u0644\u0623\u062d\u062f"\
        "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
        "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
        "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
        "\u0627\u0644\u062e\u0645\u064a\u0633"\
        "\u0627\u0644\u062c\u0645\u0639\u0629"\
        "\u0627\u0644\u0633\u0628\u062a"]
    ::msgcat::mcset ar_JO MONTHS_ABBREV [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0634\u0628\u0627\u0637"\
        "\u0622\u0630\u0627\u0631"\
        "\u0646\u064a\u0633\u0627\u0646"\
        "\u0646\u0648\u0627\u0631"\
        "\u062d\u0632\u064a\u0631\u0627\u0646"\
        "\u062a\u0645\u0648\u0632"\
        "\u0622\u0628"\
        "\u0623\u064a\u0644\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
        ""]
    ::msgcat::mcset ar_JO MONTHS_FULL [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0634\u0628\u0627\u0637"\
        "\u0622\u0630\u0627\u0631"\
        "\u0646\u064a\u0633\u0627\u0646"\
        "\u0646\u0648\u0627\u0631"\
        "\u062d\u0632\u064a\u0631\u0627\u0646"\
        "\u062a\u0645\u0648\u0632"\
        "\u0622\u0628"\
        "\u0623\u064a\u0644\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
        ""]
}

Changes to library/msgs/ar_lb.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar_LB DAYS_OF_WEEK_ABBREV [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
        "\u0627\u0644\u0623\u062d\u062f"\
        "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
        "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
        "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
        "\u0627\u0644\u062e\u0645\u064a\u0633"\
        "\u0627\u0644\u062c\u0645\u0639\u0629"\
        "\u0627\u0644\u0633\u0628\u062a"]
    ::msgcat::mcset ar_LB MONTHS_ABBREV [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0634\u0628\u0627\u0637"\
        "\u0622\u0630\u0627\u0631"\
        "\u0646\u064a\u0633\u0627\u0646"\
        "\u0646\u0648\u0627\u0631"\
        "\u062d\u0632\u064a\u0631\u0627\u0646"\
        "\u062a\u0645\u0648\u0632"\
        "\u0622\u0628"\
        "\u0623\u064a\u0644\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
        ""]
    ::msgcat::mcset ar_LB MONTHS_FULL [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0634\u0628\u0627\u0637"\
        "\u0622\u0630\u0627\u0631"\
        "\u0646\u064a\u0633\u0627\u0646"\
        "\u0646\u0648\u0627\u0631"\
        "\u062d\u0632\u064a\u0631\u0627\u0646"\
        "\u062a\u0645\u0648\u0632"\
        "\u0622\u0628"\
        "\u0623\u064a\u0644\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
        ""]
}

Changes to library/msgs/ar_sy.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ar_SY DAYS_OF_WEEK_ABBREV [list \
        "الأحد"\
        "الاثنين"\
        "الثلاثاء"\
        "الأربعاء"\
        "الخميس"\
        "الجمعة"\
        "السبت"]
        "\u0627\u0644\u0623\u062d\u062f"\
        "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
        "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
        "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
        "\u0627\u0644\u062e\u0645\u064a\u0633"\
        "\u0627\u0644\u062c\u0645\u0639\u0629"\
        "\u0627\u0644\u0633\u0628\u062a"]
    ::msgcat::mcset ar_SY MONTHS_ABBREV [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نوار"\
        "حزيران"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0634\u0628\u0627\u0637"\
        "\u0622\u0630\u0627\u0631"\
        "\u0646\u064a\u0633\u0627\u0646"\
        "\u0646\u0648\u0627\u0631"\
        "\u062d\u0632\u064a\u0631\u0627\u0646"\
        "\u062a\u0645\u0648\u0632"\
        "\u0622\u0628"\
        "\u0623\u064a\u0644\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
        ""]
    ::msgcat::mcset ar_SY MONTHS_FULL [list \
        "كانون الثاني"\
        "شباط"\
        "آذار"\
        "نيسان"\
        "نواران"\
        "حزير"\
        "تموز"\
        "آب"\
        "أيلول"\
        "تشرين الأول"\
        "تشرين الثاني"\
        "كانون الأول"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0634\u0628\u0627\u0637"\
        "\u0622\u0630\u0627\u0631"\
        "\u0646\u064a\u0633\u0627\u0646"\
        "\u0646\u0648\u0627\u0631\u0627\u0646"\
        "\u062d\u0632\u064a\u0631"\
        "\u062a\u0645\u0648\u0632"\
        "\u0622\u0628"\
        "\u0623\u064a\u0644\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
        "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
        "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
        ""]
}

Changes to library/msgs/be.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset be DAYS_OF_WEEK_ABBREV [list \
        "нд"\
        "пн"\
        "ат"\
        "ÑÑ€"\
        "чц"\
        "пт"\
        "Ñб"]
        "\u043d\u0434"\
        "\u043f\u043d"\
        "\u0430\u0442"\
        "\u0441\u0440"\
        "\u0447\u0446"\
        "\u043f\u0442"\
        "\u0441\u0431"]
    ::msgcat::mcset be DAYS_OF_WEEK_FULL [list \
        "нÑдзелÑ"\
        "панÑдзелак"\
        "аўторак"\
        "Ñерада"\
        "чацвер"\
        "пÑтніца"\
        "Ñубота"]
        "\u043d\u044f\u0434\u0437\u0435\u043b\u044f"\
        "\u043f\u0430\u043d\u044f\u0434\u0437\u0435\u043b\u0430\u043a"\
        "\u0430\u045e\u0442\u043e\u0440\u0430\u043a"\
        "\u0441\u0435\u0440\u0430\u0434\u0430"\
        "\u0447\u0430\u0446\u0432\u0435\u0440"\
        "\u043f\u044f\u0442\u043d\u0456\u0446\u0430"\
        "\u0441\u0443\u0431\u043e\u0442\u0430"]
    ::msgcat::mcset be MONTHS_ABBREV [list \
        "Ñтд"\
        "лют"\
        "Ñкв"\
        "крÑ"\
        "май"\
        "чрв"\
        "лпн"\
        "жнв"\
        "врÑ"\
        "кÑÑ‚"\
        "лÑÑ‚"\
        "Ñнж"\
        "\u0441\u0442\u0434"\
        "\u043b\u044e\u0442"\
        "\u0441\u043a\u0432"\
        "\u043a\u0440\u0441"\
        "\u043c\u0430\u0439"\
        "\u0447\u0440\u0432"\
        "\u043b\u043f\u043d"\
        "\u0436\u043d\u0432"\
        "\u0432\u0440\u0441"\
        "\u043a\u0441\u0442"\
        "\u043b\u0441\u0442"\
        "\u0441\u043d\u0436"\
        ""]
    ::msgcat::mcset be MONTHS_FULL [list \
        "ÑтудзенÑ"\
        "лютага"\
        "Ñакавіка"\
        "краÑавіка"\
        "маÑ"\
        "чрвенÑ"\
        "ліпенÑ"\
        "жніўнÑ"\
        "вераÑнÑ"\
        "каÑтрычніка"\
        "лиÑтапада"\
        "ÑнежнÑ"\
        "\u0441\u0442\u0443\u0434\u0437\u0435\u043d\u044f"\
        "\u043b\u044e\u0442\u0430\u0433\u0430"\
        "\u0441\u0430\u043a\u0430\u0432\u0456\u043a\u0430"\
        "\u043a\u0440\u0430\u0441\u0430\u0432\u0456\u043a\u0430"\
        "\u043c\u0430\u044f"\
        "\u0447\u0440\u0432\u0435\u043d\u044f"\
        "\u043b\u0456\u043f\u0435\u043d\u044f"\
        "\u0436\u043d\u0456\u045e\u043d\u044f"\
        "\u0432\u0435\u0440\u0430\u0441\u043d\u044f"\
        "\u043a\u0430\u0441\u0442\u0440\u044b\u0447\u043d\u0456\u043a\u0430"\
        "\u043b\u0438\u0441\u0442\u0430\u043f\u0430\u0434\u0430"\
        "\u0441\u043d\u0435\u0436\u043d\u044f"\
        ""]
    ::msgcat::mcset be BCE "да н.е."
    ::msgcat::mcset be CE "н.е."
    ::msgcat::mcset be BCE "\u0434\u0430 \u043d.\u0435."
    ::msgcat::mcset be CE "\u043d.\u0435."
    ::msgcat::mcset be DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset be TIME_FORMAT "%k.%M.%S"
    ::msgcat::mcset be DATE_TIME_FORMAT "%e.%m.%Y %k.%M.%S %z"
}

Changes to library/msgs/bg.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+















-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset bg DAYS_OF_WEEK_ABBREV [list \
        "Ðд"\
        "Пн"\
        "Ð’Ñ‚"\
        "Ср"\
        "Чт"\
        "Пт"\
        "Сб"]
        "\u041d\u0434"\
        "\u041f\u043d"\
        "\u0412\u0442"\
        "\u0421\u0440"\
        "\u0427\u0442"\
        "\u041f\u0442"\
        "\u0421\u0431"]
    ::msgcat::mcset bg DAYS_OF_WEEK_FULL [list \
        "ÐеделÑ"\
        "Понеделник"\
        "Вторник"\
        "СрÑда"\
        "Четвъртък"\
        "Петък"\
        "Събота"]
        "\u041d\u0435\u0434\u0435\u043b\u044f"\
        "\u041f\u043e\u043d\u0435\u0434\u0435\u043b\u043d\u0438\u043a"\
        "\u0412\u0442\u043e\u0440\u043d\u0438\u043a"\
        "\u0421\u0440\u044f\u0434\u0430"\
        "\u0427\u0435\u0442\u0432\u044a\u0440\u0442\u044a\u043a"\
        "\u041f\u0435\u0442\u044a\u043a"\
        "\u0421\u044a\u0431\u043e\u0442\u0430"]
    ::msgcat::mcset bg MONTHS_ABBREV [list \
        "I"\
        "II"\
        "III"\
        "IV"\
        "V"\
        "VI"\
        "VII"\
        "VIII"\
        "IX"\
        "X"\
        "XI"\
        "XII"\
        ""]
    ::msgcat::mcset bg MONTHS_FULL [list \
        "Януари"\
        "Февруари"\
        "Март"\
        "Ðприл"\
        "Май"\
        "Юни"\
        "Юли"\
        "ÐвгуÑÑ‚"\
        "Септември"\
        "Октомври"\
        "Ðоември"\
        "Декември"\
        "\u042f\u043d\u0443\u0430\u0440\u0438"\
        "\u0424\u0435\u0432\u0440\u0443\u0430\u0440\u0438"\
        "\u041c\u0430\u0440\u0442"\
        "\u0410\u043f\u0440\u0438\u043b"\
        "\u041c\u0430\u0439"\
        "\u042e\u043d\u0438"\
        "\u042e\u043b\u0438"\
        "\u0410\u0432\u0433\u0443\u0441\u0442"\
        "\u0421\u0435\u043f\u0442\u0435\u043c\u0432\u0440\u0438"\
        "\u041e\u043a\u0442\u043e\u043c\u0432\u0440\u0438"\
        "\u041d\u043e\u0435\u043c\u0432\u0440\u0438"\
        "\u0414\u0435\u043a\u0435\u043c\u0432\u0440\u0438"\
        ""]
    ::msgcat::mcset bg BCE "пр.н.е."
    ::msgcat::mcset bg CE "н.е."
    ::msgcat::mcset bg BCE "\u043f\u0440.\u043d.\u0435."
    ::msgcat::mcset bg CE "\u043d.\u0435."
    ::msgcat::mcset bg DATE_FORMAT "%Y-%m-%e"
    ::msgcat::mcset bg TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset bg DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"
}

Changes to library/msgs/bn.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset bn DAYS_OF_WEEK_ABBREV [list \
        "রবি"\
        "সোম"\
        "মঙগল"\
        "বà§à¦§"\
        "বৃহসà§à¦ªà¦¤à¦¿"\
        "শà§à¦•à§à¦°"\
        "শনি"]
        "\u09b0\u09ac\u09bf"\
        "\u09b8\u09cb\u09ae"\
        "\u09ae\u0999\u0997\u09b2"\
        "\u09ac\u09c1\u09a7"\
        "\u09ac\u09c3\u09b9\u09b8\u09cd\u09aa\u09a4\u09bf"\
        "\u09b6\u09c1\u0995\u09cd\u09b0"\
        "\u09b6\u09a8\u09bf"]
    ::msgcat::mcset bn DAYS_OF_WEEK_FULL [list \
        "রবিবার"\
        "সোমবার"\
        "মঙগলবার"\
        "বà§à¦§à¦¬à¦¾à¦°"\
        "বৃহসà§à¦ªà¦¤à¦¿à¦¬à¦¾à¦°"\
        "শà§à¦•à§à¦°à¦¬à¦¾à¦°"\
        "শনিবার"]
        "\u09b0\u09ac\u09bf\u09ac\u09be\u09b0"\
        "\u09b8\u09cb\u09ae\u09ac\u09be\u09b0"\
        "\u09ae\u0999\u0997\u09b2\u09ac\u09be\u09b0"\
        "\u09ac\u09c1\u09a7\u09ac\u09be\u09b0"\
        "\u09ac\u09c3\u09b9\u09b8\u09cd\u09aa\u09a4\u09bf\u09ac\u09be\u09b0"\
        "\u09b6\u09c1\u0995\u09cd\u09b0\u09ac\u09be\u09b0"\
        "\u09b6\u09a8\u09bf\u09ac\u09be\u09b0"]
    ::msgcat::mcset bn MONTHS_ABBREV [list \
        "জানà§à§Ÿà¦¾à¦°à§€"\
        "ফেবà§à¦°à§à§Ÿà¦¾à¦°à§€"\
        "মারà§à¦š"\
        "à¦à¦ªà§à¦°à¦¿à¦²"\
        "মে"\
        "জà§à¦¨"\
        "জà§à¦²à¦¾à¦‡"\
        "আগসà§à¦Ÿ"\
        "সেপà§à¦Ÿà§‡à¦®à§à¦¬à¦°"\
        "অকà§à¦Ÿà§‹à¦¬à¦°"\
        "নভেমà§à¦¬à¦°"\
        "ডিসেমà§à¦¬à¦°"\
        "\u099c\u09be\u09a8\u09c1\u09df\u09be\u09b0\u09c0"\
        "\u09ab\u09c7\u09ac\u09cd\u09b0\u09c1\u09df\u09be\u09b0\u09c0"\
        "\u09ae\u09be\u09b0\u09cd\u099a"\
        "\u098f\u09aa\u09cd\u09b0\u09bf\u09b2"\
        "\u09ae\u09c7"\
        "\u099c\u09c1\u09a8"\
        "\u099c\u09c1\u09b2\u09be\u0987"\
        "\u0986\u0997\u09b8\u09cd\u099f"\
        "\u09b8\u09c7\u09aa\u09cd\u099f\u09c7\u09ae\u09cd\u09ac\u09b0"\
        "\u0985\u0995\u09cd\u099f\u09cb\u09ac\u09b0"\
        "\u09a8\u09ad\u09c7\u09ae\u09cd\u09ac\u09b0"\
        "\u09a1\u09bf\u09b8\u09c7\u09ae\u09cd\u09ac\u09b0"\
        ""]
    ::msgcat::mcset bn MONTHS_FULL [list \
        "জানà§à§Ÿà¦¾à¦°à§€"\
        "ফেবà§à¦°à§à§Ÿà¦¾à¦°à§€"\
        "মারà§à¦š"\
        "à¦à¦ªà§à¦°à¦¿à¦²"\
        "মে"\
        "জà§à¦¨"\
        "জà§à¦²à¦¾à¦‡"\
        "আগসà§à¦Ÿ"\
        "সেপà§à¦Ÿà§‡à¦®à§à¦¬à¦°"\
        "অকà§à¦Ÿà§‹à¦¬à¦°"\
        "নভেমà§à¦¬à¦°"\
        "ডিসেমà§à¦¬à¦°"\
        "\u099c\u09be\u09a8\u09c1\u09df\u09be\u09b0\u09c0"\
        "\u09ab\u09c7\u09ac\u09cd\u09b0\u09c1\u09df\u09be\u09b0\u09c0"\
        "\u09ae\u09be\u09b0\u09cd\u099a"\
        "\u098f\u09aa\u09cd\u09b0\u09bf\u09b2"\
        "\u09ae\u09c7"\
        "\u099c\u09c1\u09a8"\
        "\u099c\u09c1\u09b2\u09be\u0987"\
        "\u0986\u0997\u09b8\u09cd\u099f"\
        "\u09b8\u09c7\u09aa\u09cd\u099f\u09c7\u09ae\u09cd\u09ac\u09b0"\
        "\u0985\u0995\u09cd\u099f\u09cb\u09ac\u09b0"\
        "\u09a8\u09ad\u09c7\u09ae\u09cd\u09ac\u09b0"\
        "\u09a1\u09bf\u09b8\u09c7\u09ae\u09cd\u09ac\u09b0"\
        ""]
    ::msgcat::mcset bn AM "পূরà§à¦¬à¦¾à¦¹à§à¦£"
    ::msgcat::mcset bn PM "অপরাহà§à¦£"
    ::msgcat::mcset bn AM "\u09aa\u09c2\u09b0\u09cd\u09ac\u09be\u09b9\u09cd\u09a3"
    ::msgcat::mcset bn PM "\u0985\u09aa\u09b0\u09be\u09b9\u09cd\u09a3"
}

Changes to library/msgs/ca.msg.

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
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







-
+













-
+







        "dimecres"\
        "dijous"\
        "divendres"\
        "dissabte"]
    ::msgcat::mcset ca MONTHS_ABBREV [list \
        "gen."\
        "feb."\
        "març"\
        "mar\u00e7"\
        "abr."\
        "maig"\
        "juny"\
        "jul."\
        "ag."\
        "set."\
        "oct."\
        "nov."\
        "des."\
        ""]
    ::msgcat::mcset ca MONTHS_FULL [list \
        "gener"\
        "febrer"\
        "març"\
        "mar\u00e7"\
        "abril"\
        "maig"\
        "juny"\
        "juliol"\
        "agost"\
        "setembre"\
        "octubre"\

Changes to library/msgs/cs.msg.

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
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





-
+

-
-
+
+


-
-
-
-
-
-
+
+
+
+
+
+

















-
-
+
+

-
-
-
+
+
+

-
-
+
+



-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset cs DAYS_OF_WEEK_ABBREV [list \
        "Ne"\
        "Po"\
        "Út"\
        "\u00dat"\
        "St"\
        "ÄŒt"\
        "Pá"\
        "\u010ct"\
        "P\u00e1"\
        "So"]
    ::msgcat::mcset cs DAYS_OF_WEEK_FULL [list \
        "Neděle"\
        "Pondělí"\
        "Úterý"\
        "Středa"\
        "ÄŒtvrtek"\
        "Pátek"\
        "Ned\u011ble"\
        "Pond\u011bl\u00ed"\
        "\u00dater\u00fd"\
        "St\u0159eda"\
        "\u010ctvrtek"\
        "P\u00e1tek"\
        "Sobota"]
    ::msgcat::mcset cs MONTHS_ABBREV [list \
        "I"\
        "II"\
        "III"\
        "IV"\
        "V"\
        "VI"\
        "VII"\
        "VIII"\
        "IX"\
        "X"\
        "XI"\
        "XII"\
        ""]
    ::msgcat::mcset cs MONTHS_FULL [list \
        "leden"\
        "únor"\
        "březen"\
        "\u00fanor"\
        "b\u0159ezen"\
        "duben"\
        "květen"\
        "Äerven"\
        "Äervenec"\
        "kv\u011bten"\
        "\u010derven"\
        "\u010dervenec"\
        "srpen"\
        "září"\
        "říjen"\
        "z\u00e1\u0159\u00ed"\
        "\u0159\u00edjen"\
        "listopad"\
        "prosinec"\
        ""]
    ::msgcat::mcset cs BCE "pÅ™.Kr."
    ::msgcat::mcset cs BCE "p\u0159.Kr."
    ::msgcat::mcset cs CE "po Kr."
    ::msgcat::mcset cs AM "dop."
    ::msgcat::mcset cs PM "odp."
    ::msgcat::mcset cs DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset cs TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset cs DATE_TIME_FORMAT "%e.%m.%Y %k:%M:%S %z"
}

Changes to library/msgs/da.msg.

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
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



-
+





-
+

-
+





-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset da DAYS_OF_WEEK_ABBREV [list \
        "sø"\
        "s\u00f8"\
        "ma"\
        "ti"\
        "on"\
        "to"\
        "fr"\
        "lø"]
        "l\u00f8"]
    ::msgcat::mcset da DAYS_OF_WEEK_FULL [list \
        "søndag"\
        "s\u00f8ndag"\
        "mandag"\
        "tirsdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "lørdag"]
        "l\u00f8rdag"]
    ::msgcat::mcset da MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\

Changes to library/msgs/de.msg.

29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43







-
+







        "Okt"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset de MONTHS_FULL [list \
        "Januar"\
        "Februar"\
        "März"\
        "M\u00e4rz"\
        "April"\
        "Mai"\
        "Juni"\
        "Juli"\
        "August"\
        "September"\
        "Oktober"\

Changes to library/msgs/de_at.msg.

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
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



-
+

-
+











-
+

-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset de_AT MONTHS_ABBREV [list \
        "Jän"\
        "J\u00e4n"\
        "Feb"\
        "Mär"\
        "M\u00e4r"\
        "Apr"\
        "Mai"\
        "Jun"\
        "Jul"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset de_AT MONTHS_FULL [list \
        "Jänner"\
        "J\u00e4nner"\
        "Februar"\
        "März"\
        "M\u00e4rz"\
        "April"\
        "Mai"\
        "Juni"\
        "Juli"\
        "August"\
        "September"\
        "Oktober"\

Changes to library/msgs/de_be.msg.

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
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







-
+













-
+







        "Mittwoch"\
        "Donnerstag"\
        "Freitag"\
        "Samstag"]
    ::msgcat::mcset de_BE MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mär"\
        "M\u00e4r"\
        "Apr"\
        "Mai"\
        "Jun"\
        "Jul"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset de_BE MONTHS_FULL [list \
        "Januar"\
        "Februar"\
        "März"\
        "M\u00e4rz"\
        "April"\
        "Mai"\
        "Juni"\
        "Juli"\
        "August"\
        "September"\
        "Oktober"\

Changes to library/msgs/el.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset el DAYS_OF_WEEK_ABBREV [list \
        "ΚυÏ"\
        "Δευ"\
        "ΤÏι"\
        "Τετ"\
        "Πεμ"\
        "ΠαÏ"\
        "Σαβ"]
        "\u039a\u03c5\u03c1"\
        "\u0394\u03b5\u03c5"\
        "\u03a4\u03c1\u03b9"\
        "\u03a4\u03b5\u03c4"\
        "\u03a0\u03b5\u03bc"\
        "\u03a0\u03b1\u03c1"\
        "\u03a3\u03b1\u03b2"]
    ::msgcat::mcset el DAYS_OF_WEEK_FULL [list \
        "ΚυÏιακή"\
        "ΔευτέÏα"\
        "ΤÏίτη"\
        "ΤετάÏτη"\
        "Πέμπτη"\
        "ΠαÏασκευή"\
        "Σάββατο"]
        "\u039a\u03c5\u03c1\u03b9\u03b1\u03ba\u03ae"\
        "\u0394\u03b5\u03c5\u03c4\u03ad\u03c1\u03b1"\
        "\u03a4\u03c1\u03af\u03c4\u03b7"\
        "\u03a4\u03b5\u03c4\u03ac\u03c1\u03c4\u03b7"\
        "\u03a0\u03ad\u03bc\u03c0\u03c4\u03b7"\
        "\u03a0\u03b1\u03c1\u03b1\u03c3\u03ba\u03b5\u03c5\u03ae"\
        "\u03a3\u03ac\u03b2\u03b2\u03b1\u03c4\u03bf"]
    ::msgcat::mcset el MONTHS_ABBREV [list \
        "Ιαν"\
        "Φεβ"\
        "ΜαÏ"\
        "ΑπÏ"\
        "Μαϊ"\
        "Ιουν"\
        "Ιουλ"\
        "Αυγ"\
        "Σεπ"\
        "Οκτ"\
        "Îοε"\
        "Δεκ"\
        "\u0399\u03b1\u03bd"\
        "\u03a6\u03b5\u03b2"\
        "\u039c\u03b1\u03c1"\
        "\u0391\u03c0\u03c1"\
        "\u039c\u03b1\u03ca"\
        "\u0399\u03bf\u03c5\u03bd"\
        "\u0399\u03bf\u03c5\u03bb"\
        "\u0391\u03c5\u03b3"\
        "\u03a3\u03b5\u03c0"\
        "\u039f\u03ba\u03c4"\
        "\u039d\u03bf\u03b5"\
        "\u0394\u03b5\u03ba"\
        ""]
    ::msgcat::mcset el MONTHS_FULL [list \
        "ΙανουάÏιος"\
        "ΦεβÏουάÏιος"\
        "ΜάÏτιος"\
        "ΑπÏίλιος"\
        "Μάϊος"\
        "ΙοÏνιος"\
        "ΙοÏλιος"\
        "ΑÏγουστος"\
        "ΣεπτέμβÏιος"\
        "ΟκτώβÏιος"\
        "ÎοέμβÏιος"\
        "ΔεκέμβÏιος"\
        "\u0399\u03b1\u03bd\u03bf\u03c5\u03ac\u03c1\u03b9\u03bf\u03c2"\
        "\u03a6\u03b5\u03b2\u03c1\u03bf\u03c5\u03ac\u03c1\u03b9\u03bf\u03c2"\
        "\u039c\u03ac\u03c1\u03c4\u03b9\u03bf\u03c2"\
        "\u0391\u03c0\u03c1\u03af\u03bb\u03b9\u03bf\u03c2"\
        "\u039c\u03ac\u03ca\u03bf\u03c2"\
        "\u0399\u03bf\u03cd\u03bd\u03b9\u03bf\u03c2"\
        "\u0399\u03bf\u03cd\u03bb\u03b9\u03bf\u03c2"\
        "\u0391\u03cd\u03b3\u03bf\u03c5\u03c3\u03c4\u03bf\u03c2"\
        "\u03a3\u03b5\u03c0\u03c4\u03ad\u03bc\u03b2\u03c1\u03b9\u03bf\u03c2"\
        "\u039f\u03ba\u03c4\u03ce\u03b2\u03c1\u03b9\u03bf\u03c2"\
        "\u039d\u03bf\u03ad\u03bc\u03b2\u03c1\u03b9\u03bf\u03c2"\
        "\u0394\u03b5\u03ba\u03ad\u03bc\u03b2\u03c1\u03b9\u03bf\u03c2"\
        ""]
    ::msgcat::mcset el AM "πμ"
    ::msgcat::mcset el PM "μμ"
    ::msgcat::mcset el AM "\u03c0\u03bc"
    ::msgcat::mcset el PM "\u03bc\u03bc"
    ::msgcat::mcset el DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset el TIME_FORMAT_12 "%l:%M:%S %P"
    ::msgcat::mcset el DATE_TIME_FORMAT "%e/%m/%Y %l:%M:%S %P %z"
}

Changes to library/msgs/eo.msg.

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
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







-
+



-
+



-
+










-
+













-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset eo DAYS_OF_WEEK_ABBREV [list \
        "di"\
        "lu"\
        "ma"\
        "me"\
        "ĵa"\
        "\u0135a"\
        "ve"\
        "sa"]
    ::msgcat::mcset eo DAYS_OF_WEEK_FULL [list \
        "dimanĉo"\
        "diman\u0109o"\
        "lundo"\
        "mardo"\
        "merkredo"\
        "ĵaŭdo"\
        "\u0135a\u016ddo"\
        "vendredo"\
        "sabato"]
    ::msgcat::mcset eo MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\
        "jul"\
        "aÅ­g"\
        "a\u016dg"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset eo MONTHS_FULL [list \
        "januaro"\
        "februaro"\
        "marto"\
        "aprilo"\
        "majo"\
        "junio"\
        "julio"\
        "aÅ­gusto"\
        "a\u016dgusto"\
        "septembro"\
        "oktobro"\
        "novembro"\
        "decembro"\
        ""]
    ::msgcat::mcset eo BCE "aK"
    ::msgcat::mcset eo CE "pK"

Changes to library/msgs/es.msg.

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
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






-
+


-
+




-
+


-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset es DAYS_OF_WEEK_ABBREV [list \
        "dom"\
        "lun"\
        "mar"\
        "mié"\
        "mi\u00e9"\
        "jue"\
        "vie"\
        "sáb"]
        "s\u00e1b"]
    ::msgcat::mcset es DAYS_OF_WEEK_FULL [list \
        "domingo"\
        "lunes"\
        "martes"\
        "miércoles"\
        "mi\u00e9rcoles"\
        "jueves"\
        "viernes"\
        "sábado"]
        "s\u00e1bado"]
    ::msgcat::mcset es MONTHS_ABBREV [list \
        "ene"\
        "feb"\
        "mar"\
        "abr"\
        "may"\
        "jun"\

Changes to library/msgs/et.msg.

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
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











-
-
-
-
-
+
+
+
+
+

-
+



-
+













-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset et DAYS_OF_WEEK_ABBREV [list \
        "P"\
        "E"\
        "T"\
        "K"\
        "N"\
        "R"\
        "L"]
    ::msgcat::mcset et DAYS_OF_WEEK_FULL [list \
        "pühapäev"\
        "esmaspäev"\
        "teisipäev"\
        "kolmapäev"\
        "neljapäev"\
        "p\u00fchap\u00e4ev"\
        "esmasp\u00e4ev"\
        "teisip\u00e4ev"\
        "kolmap\u00e4ev"\
        "neljap\u00e4ev"\
        "reede"\
        "laupäev"]
        "laup\u00e4ev"]
    ::msgcat::mcset et MONTHS_ABBREV [list \
        "Jaan"\
        "Veebr"\
        "Märts"\
        "M\u00e4rts"\
        "Apr"\
        "Mai"\
        "Juuni"\
        "Juuli"\
        "Aug"\
        "Sept"\
        "Okt"\
        "Nov"\
        "Dets"\
        ""]
    ::msgcat::mcset et MONTHS_FULL [list \
        "Jaanuar"\
        "Veebruar"\
        "Märts"\
        "M\u00e4rts"\
        "Aprill"\
        "Mai"\
        "Juuni"\
        "Juuli"\
        "August"\
        "September"\
        "Oktoober"\

Changes to library/msgs/fa.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fa DAYS_OF_WEEK_ABBREV [list \
        "ی∔"\
        "د∔"\
        "س∔"\
        "چ∔"\
        "پ∔"\
        "ج∔"\
        "ش∔"]
        "\u06cc\u2214"\
        "\u062f\u2214"\
        "\u0633\u2214"\
        "\u0686\u2214"\
        "\u067e\u2214"\
        "\u062c\u2214"\
        "\u0634\u2214"]
    ::msgcat::mcset fa DAYS_OF_WEEK_FULL [list \
        "یی‌شنبه"\
        "دوشنبه"\
        "سه‌شنبه"\
        "چهارشنبه"\
        "پنج‌شنبه"\
        "جمعه"\
        "شنبه"]
        "\u06cc\u06cc\u200c\u0634\u0646\u0628\u0647"\
        "\u062f\u0648\u0634\u0646\u0628\u0647"\
        "\u0633\u0647\u200c\u0634\u0646\u0628\u0647"\
        "\u0686\u0647\u0627\u0631\u0634\u0646\u0628\u0647"\
        "\u067e\u0646\u062c\u200c\u0634\u0646\u0628\u0647"\
        "\u062c\u0645\u0639\u0647"\
        "\u0634\u0646\u0628\u0647"]
    ::msgcat::mcset fa MONTHS_ABBREV [list \
        "ژان"\
        "Ùور"\
        "مار"\
        "آور"\
        "مـه"\
        "ژون"\
        "ژوی"\
        "اوت"\
        "سپت"\
        "اكت"\
        "نوا"\
        "دسا"\
        "\u0698\u0627\u0646"\
        "\u0641\u0648\u0631"\
        "\u0645\u0627\u0631"\
        "\u0622\u0648\u0631"\
        "\u0645\u0640\u0647"\
        "\u0698\u0648\u0646"\
        "\u0698\u0648\u06cc"\
        "\u0627\u0648\u062a"\
        "\u0633\u067e\u062a"\
        "\u0627\u0643\u062a"\
        "\u0646\u0648\u0627"\
        "\u062f\u0633\u0627"\
        ""]
    ::msgcat::mcset fa MONTHS_FULL [list \
        "ژانویه"\
        "Ùورویه"\
        "مارس"\
        "آوریل"\
        "مه"\
        "ژوئن"\
        "ژوئیه"\
        "اوت"\
        "سپتامبر"\
        "اكتبر"\
        "نوامبر"\
        "دسامبر"\
        "\u0698\u0627\u0646\u0648\u06cc\u0647"\
        "\u0641\u0648\u0631\u0648\u06cc\u0647"\
        "\u0645\u0627\u0631\u0633"\
        "\u0622\u0648\u0631\u06cc\u0644"\
        "\u0645\u0647"\
        "\u0698\u0648\u0626\u0646"\
        "\u0698\u0648\u0626\u06cc\u0647"\
        "\u0627\u0648\u062a"\
        "\u0633\u067e\u062a\u0627\u0645\u0628\u0631"\
        "\u0627\u0643\u062a\u0628\u0631"\
        "\u0646\u0648\u0627\u0645\u0628\u0631"\
        "\u062f\u0633\u0627\u0645\u0628\u0631"\
        ""]
}

Changes to library/msgs/fa_in.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fa_IN DAYS_OF_WEEK_ABBREV [list \
        "ی∔"\
        "د∔"\
        "س∔"\
        "چ∔"\
        "پ∔"\
        "ج∔"\
        "ش∔"]
        "\u06cc\u2214"\
        "\u062f\u2214"\
        "\u0633\u2214"\
        "\u0686\u2214"\
        "\u067e\u2214"\
        "\u062c\u2214"\
        "\u0634\u2214"]
    ::msgcat::mcset fa_IN DAYS_OF_WEEK_FULL [list \
        "یی‌شنبه"\
        "دوشنبه"\
        "سه‌شنبه"\
        "چهارشنبه"\
        "پنج‌شنبه"\
        "جمعه"\
        "شنبه"]
        "\u06cc\u06cc\u200c\u0634\u0646\u0628\u0647"\
        "\u062f\u0648\u0634\u0646\u0628\u0647"\
        "\u0633\u0647\u200c\u0634\u0646\u0628\u0647"\
        "\u0686\u0647\u0627\u0631\u0634\u0646\u0628\u0647"\
        "\u067e\u0646\u062c\u200c\u0634\u0646\u0628\u0647"\
        "\u062c\u0645\u0639\u0647"\
        "\u0634\u0646\u0628\u0647"]
    ::msgcat::mcset fa_IN MONTHS_ABBREV [list \
        "ژان"\
        "Ùور"\
        "مار"\
        "آور"\
        "مـه"\
        "ژون"\
        "ژوی"\
        "اوت"\
        "سپت"\
        "اكت"\
        "نوا"\
        "دسا"\
        "\u0698\u0627\u0646"\
        "\u0641\u0648\u0631"\
        "\u0645\u0627\u0631"\
        "\u0622\u0648\u0631"\
        "\u0645\u0640\u0647"\
        "\u0698\u0648\u0646"\
        "\u0698\u0648\u06cc"\
        "\u0627\u0648\u062a"\
        "\u0633\u067e\u062a"\
        "\u0627\u0643\u062a"\
        "\u0646\u0648\u0627"\
        "\u062f\u0633\u0627"\
        ""]
    ::msgcat::mcset fa_IN MONTHS_FULL [list \
        "ژانویه"\
        "Ùورویه"\
        "مارس"\
        "آوریل"\
        "مه"\
        "ژوئن"\
        "ژوئیه"\
        "اوت"\
        "سپتامبر"\
        "اكتبر"\
        "نوامبر"\
        "دسامبر"\
        "\u0698\u0627\u0646\u0648\u06cc\u0647"\
        "\u0641\u0648\u0631\u0648\u06cc\u0647"\
        "\u0645\u0627\u0631\u0633"\
        "\u0622\u0648\u0631\u06cc\u0644"\
        "\u0645\u0647"\
        "\u0698\u0648\u0626\u0646"\
        "\u0698\u0648\u0626\u06cc\u0647"\
        "\u0627\u0648\u062a"\
        "\u0633\u067e\u062a\u0627\u0645\u0628\u0631"\
        "\u0627\u0643\u062a\u0628\u0631"\
        "\u0646\u0648\u0627\u0645\u0628\u0631"\
        "\u062f\u0633\u0627\u0645\u0628\u0631"\
        ""]
    ::msgcat::mcset fa_IN AM "صبح"
    ::msgcat::mcset fa_IN PM "عصر"
    ::msgcat::mcset fa_IN AM "\u0635\u0628\u062d"
    ::msgcat::mcset fa_IN PM "\u0639\u0635\u0631"
    ::msgcat::mcset fa_IN DATE_FORMAT "%A %d %B %Y"
    ::msgcat::mcset fa_IN TIME_FORMAT_12 "%I:%M:%S  %z"
    ::msgcat::mcset fa_IN DATE_TIME_FORMAT "%A %d %B %Y %I:%M:%S  %z %z"
}

Changes to library/msgs/fa_ir.msg.

1
2
3
4
5



6
7
8

9
1
2



3
4
5
6
7

8
9


-
-
-
+
+
+


-
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fa_IR AM "صبح"
    ::msgcat::mcset fa_IR PM "عصر"
    ::msgcat::mcset fa_IR DATE_FORMAT "%dâ„%mâ„%Y"
    ::msgcat::mcset fa_IR AM "\u0635\u0628\u062d"
    ::msgcat::mcset fa_IR PM "\u0639\u0635\u0631"
    ::msgcat::mcset fa_IR DATE_FORMAT "%d\u2044%m\u2044%Y"
    ::msgcat::mcset fa_IR TIME_FORMAT "%S:%M:%H"
    ::msgcat::mcset fa_IR TIME_FORMAT_12 "%S:%M:%l %P"
    ::msgcat::mcset fa_IR DATE_TIME_FORMAT "%dâ„%mâ„%Y %S:%M:%H %z"
    ::msgcat::mcset fa_IR DATE_TIME_FORMAT "%d\u2044%m\u2044%Y %S:%M:%H %z"
}

Changes to library/msgs/fi.msg.

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
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







-
-
+
+












-
-
+
+







        "lauantai"]
    ::msgcat::mcset fi MONTHS_ABBREV [list \
        "tammi"\
        "helmi"\
        "maalis"\
        "huhti"\
        "touko"\
        "kesä"\
        "heinä"\
        "kes\u00e4"\
        "hein\u00e4"\
        "elo"\
        "syys"\
        "loka"\
        "marras"\
        "joulu"\
        ""]
    ::msgcat::mcset fi MONTHS_FULL [list \
        "tammikuu"\
        "helmikuu"\
        "maaliskuu"\
        "huhtikuu"\
        "toukokuu"\
        "kesäkuu"\
        "heinäkuu"\
        "kes\u00e4kuu"\
        "hein\u00e4kuu"\
        "elokuu"\
        "syyskuu"\
        "lokakuu"\
        "marraskuu"\
        "joulukuu"\
        ""]
    ::msgcat::mcset fi DATE_FORMAT "%e.%m.%Y"

Changes to library/msgs/fo.msg.

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
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




-
-
+
+

-
-
+
+



-
-
+
+

-
-
+
+



















-
+










# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset fo DAYS_OF_WEEK_ABBREV [list \
        "sun"\
        "mán"\
        "týs"\
        "m\u00e1n"\
        "t\u00fds"\
        "mik"\
        "hós"\
        "frí"\
        "h\u00f3s"\
        "fr\u00ed"\
        "ley"]
    ::msgcat::mcset fo DAYS_OF_WEEK_FULL [list \
        "sunnudagur"\
        "mánadagur"\
        "týsdagur"\
        "m\u00e1nadagur"\
        "t\u00fdsdagur"\
        "mikudagur"\
        "hósdagur"\
        "fríggjadagur"\
        "h\u00f3sdagur"\
        "fr\u00edggjadagur"\
        "leygardagur"]
    ::msgcat::mcset fo MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "mai"\
        "jun"\
        "jul"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "des"\
        ""]
    ::msgcat::mcset fo MONTHS_FULL [list \
        "januar"\
        "februar"\
        "mars"\
        "apríl"\
        "apr\u00edl"\
        "mai"\
        "juni"\
        "juli"\
        "august"\
        "september"\
        "oktober"\
        "november"\
        "desember"\
        ""]
}

Changes to library/msgs/fr.msg.

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
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







-
+





-
+



-
+



-
+





-
+



-
+







        "mardi"\
        "mercredi"\
        "jeudi"\
        "vendredi"\
        "samedi"]
    ::msgcat::mcset fr MONTHS_ABBREV [list \
        "janv."\
        "févr."\
        "f\u00e9vr."\
        "mars"\
        "avr."\
        "mai"\
        "juin"\
        "juil."\
        "août"\
        "ao\u00fbt"\
        "sept."\
        "oct."\
        "nov."\
        "déc."\
        "d\u00e9c."\
        ""]
    ::msgcat::mcset fr MONTHS_FULL [list \
        "janvier"\
        "février"\
        "f\u00e9vrier"\
        "mars"\
        "avril"\
        "mai"\
        "juin"\
        "juillet"\
        "août"\
        "ao\u00fbt"\
        "septembre"\
        "octobre"\
        "novembre"\
        "décembre"\
        "d\u00e9cembre"\
        ""]
    ::msgcat::mcset fr BCE "av. J.-C."
    ::msgcat::mcset fr CE "ap. J.-C."
    ::msgcat::mcset fr DATE_FORMAT "%e %B %Y"
    ::msgcat::mcset fr TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset fr DATE_TIME_FORMAT "%e %B %Y %H:%M:%S %z"
}

Changes to library/msgs/ga.msg.

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
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





-
-
-
+
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+



-
+



-
-
-
-
+
+
+
+




-
+

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ga DAYS_OF_WEEK_ABBREV [list \
        "Domh"\
        "Luan"\
        "Máirt"\
        "Céad"\
        "Déar"\
        "M\u00e1irt"\
        "C\u00e9ad"\
        "D\u00e9ar"\
        "Aoine"\
        "Sath"]
    ::msgcat::mcset ga DAYS_OF_WEEK_FULL [list \
        "Dé Domhnaigh"\
        "Dé Luain"\
        "Dé Máirt"\
        "Dé Céadaoin"\
        "Déardaoin"\
        "Dé hAoine"\
        "Dé Sathairn"]
        "D\u00e9 Domhnaigh"\
        "D\u00e9 Luain"\
        "D\u00e9 M\u00e1irt"\
        "D\u00e9 C\u00e9adaoin"\
        "D\u00e9ardaoin"\
        "D\u00e9 hAoine"\
        "D\u00e9 Sathairn"]
    ::msgcat::mcset ga MONTHS_ABBREV [list \
        "Ean"\
        "Feabh"\
        "Márta"\
        "M\u00e1rta"\
        "Aib"\
        "Beal"\
        "Meith"\
        "Iúil"\
        "Lún"\
        "MFómh"\
        "DFómh"\
        "I\u00fail"\
        "L\u00fan"\
        "MF\u00f3mh"\
        "DF\u00f3mh"\
        "Samh"\
        "Noll"\
        ""]
    ::msgcat::mcset ga MONTHS_FULL [list \
        "Eanáir"\
        "Ean\u00e1ir"\
        "Feabhra"\
        "Márta"\
        "Aibreán"\
        "Mí na Bealtaine"\
        "M\u00e1rta"\
        "Aibre\u00e1n"\
        "M\u00ed na Bealtaine"\
        "Meith"\
        "Iúil"\
        "Lúnasa"\
        "Meán Fómhair"\
        "Deireadh Fómhair"\
        "Mí na Samhna"\
        "Mí na Nollag"\
        "I\u00fail"\
        "L\u00fanasa"\
        "Me\u00e1n F\u00f3mhair"\
        "Deireadh F\u00f3mhair"\
        "M\u00ed na Samhna"\
        "M\u00ed na Nollag"\
        ""]
}

Changes to library/msgs/gl.msg.

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
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






-
+


-
+




-
+


-
+






-
+













-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset gl DAYS_OF_WEEK_ABBREV [list \
        "Dom"\
        "Lun"\
        "Mar"\
        "Mér"\
        "M\u00e9r"\
        "Xov"\
        "Ven"\
        "Sáb"]
        "S\u00e1b"]
    ::msgcat::mcset gl DAYS_OF_WEEK_FULL [list \
        "Domingo"\
        "Luns"\
        "Martes"\
        "Mércores"\
        "M\u00e9rcores"\
        "Xoves"\
        "Venres"\
        "Sábado"]
        "S\u00e1bado"]
    ::msgcat::mcset gl MONTHS_ABBREV [list \
        "Xan"\
        "Feb"\
        "Mar"\
        "Abr"\
        "Mai"\
        "Xuñ"\
        "Xu\u00f1"\
        "Xul"\
        "Ago"\
        "Set"\
        "Out"\
        "Nov"\
        "Dec"\
        ""]
    ::msgcat::mcset gl MONTHS_FULL [list \
        "Xaneiro"\
        "Febreiro"\
        "Marzo"\
        "Abril"\
        "Maio"\
        "Xuño"\
        "Xu\u00f1o"\
        "Xullo"\
        "Agosto"\
        "Setembro"\
        "Outubro"\
        "Novembro"\
        "Decembro"\
        ""]

Changes to library/msgs/he.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset he DAYS_OF_WEEK_ABBREV [list \
        "×"\
        "ב"\
        "×’"\
        "ד"\
        "×”"\
        "ו"\
        "ש"]
        "\u05d0"\
        "\u05d1"\
        "\u05d2"\
        "\u05d3"\
        "\u05d4"\
        "\u05d5"\
        "\u05e9"]
    ::msgcat::mcset he DAYS_OF_WEEK_FULL [list \
        "×™×•× ×¨×שון"\
        "×™×•× ×©× ×™"\
        "×™×•× ×©×œ×™×©×™"\
        "×™×•× ×¨×‘×™×¢×™"\
        "×™×•× ×—×ž×™×©×™"\
        "×™×•× ×©×™×©×™"\
        "שבת"]
        "\u05d9\u05d5\u05dd \u05e8\u05d0\u05e9\u05d5\u05df"\
        "\u05d9\u05d5\u05dd \u05e9\u05e0\u05d9"\
        "\u05d9\u05d5\u05dd \u05e9\u05dc\u05d9\u05e9\u05d9"\
        "\u05d9\u05d5\u05dd \u05e8\u05d1\u05d9\u05e2\u05d9"\
        "\u05d9\u05d5\u05dd \u05d7\u05de\u05d9\u05e9\u05d9"\
        "\u05d9\u05d5\u05dd \u05e9\u05d9\u05e9\u05d9"\
        "\u05e9\u05d1\u05ea"]
    ::msgcat::mcset he MONTHS_ABBREV [list \
        "ינו"\
        "פבר"\
        "מרץ"\
        "×פר"\
        "מ××™"\
        "יונ"\
        "יול"\
        "×וג"\
        "ספט"\
        "×וק"\
        "נוב"\
        "דצמ"\
        "\u05d9\u05e0\u05d5"\
        "\u05e4\u05d1\u05e8"\
        "\u05de\u05e8\u05e5"\
        "\u05d0\u05e4\u05e8"\
        "\u05de\u05d0\u05d9"\
        "\u05d9\u05d5\u05e0"\
        "\u05d9\u05d5\u05dc"\
        "\u05d0\u05d5\u05d2"\
        "\u05e1\u05e4\u05d8"\
        "\u05d0\u05d5\u05e7"\
        "\u05e0\u05d5\u05d1"\
        "\u05d3\u05e6\u05de"\
        ""]
    ::msgcat::mcset he MONTHS_FULL [list \
        "ינו×ר"\
        "פברו×ר"\
        "מרץ"\
        "×פריל"\
        "מ××™"\
        "יוני"\
        "יולי"\
        "×וגוסט"\
        "ספטמבר"\
        "×וקטובר"\
        "נובמבר"\
        "דצמבר"\
        "\u05d9\u05e0\u05d5\u05d0\u05e8"\
        "\u05e4\u05d1\u05e8\u05d5\u05d0\u05e8"\
        "\u05de\u05e8\u05e5"\
        "\u05d0\u05e4\u05e8\u05d9\u05dc"\
        "\u05de\u05d0\u05d9"\
        "\u05d9\u05d5\u05e0\u05d9"\
        "\u05d9\u05d5\u05dc\u05d9"\
        "\u05d0\u05d5\u05d2\u05d5\u05e1\u05d8"\
        "\u05e1\u05e4\u05d8\u05de\u05d1\u05e8"\
        "\u05d0\u05d5\u05e7\u05d8\u05d5\u05d1\u05e8"\
        "\u05e0\u05d5\u05d1\u05de\u05d1\u05e8"\
        "\u05d3\u05e6\u05de\u05d1\u05e8"\
        ""]
    ::msgcat::mcset he BCE "לסה"נ"
    ::msgcat::mcset he CE "לפסה"נ"
    ::msgcat::mcset he BCE "\u05dc\u05e1\u05d4\u0022\u05e0"
    ::msgcat::mcset he CE "\u05dc\u05e4\u05e1\u05d4\u0022\u05e0"
    ::msgcat::mcset he DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset he TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset he DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"
}

Changes to library/msgs/hi.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset hi DAYS_OF_WEEK_FULL [list \
        "रविवार"\
        "सोमवार"\
        "मंगलवार"\
        "बà¥à¤§à¤µà¤¾à¤°"\
        "गà¥à¤°à¥à¤µà¤¾à¤°"\
        "शà¥à¤•à¥à¤°à¤µà¤¾à¤°"\
        "शनिवार"]
        "\u0930\u0935\u093f\u0935\u093e\u0930"\
        "\u0938\u094b\u092e\u0935\u093e\u0930"\
        "\u092e\u0902\u0917\u0932\u0935\u093e\u0930"\
        "\u092c\u0941\u0927\u0935\u093e\u0930"\
        "\u0917\u0941\u0930\u0941\u0935\u093e\u0930"\
        "\u0936\u0941\u0915\u094d\u0930\u0935\u093e\u0930"\
        "\u0936\u0928\u093f\u0935\u093e\u0930"]
    ::msgcat::mcset hi MONTHS_ABBREV [list \
        "जनवरी"\
        "फ़रवरी"\
        "मारà¥à¤š"\
        "अपà¥à¤°à¥‡à¤²"\
        "मई"\
        "जून"\
        "जà¥à¤²à¤¾à¤ˆ"\
        "अगसà¥à¤¤"\
        "सितमà¥à¤¬à¤°"\
        "अकà¥à¤Ÿà¥‚बर"\
        "नवमà¥à¤¬à¤°"\
        "दिसमà¥à¤¬à¤°"]
        "\u091c\u0928\u0935\u0930\u0940"\
        "\u092b\u093c\u0930\u0935\u0930\u0940"\
        "\u092e\u093e\u0930\u094d\u091a"\
        "\u0905\u092a\u094d\u0930\u0947\u0932"\
        "\u092e\u0908"\
        "\u091c\u0942\u0928"\
        "\u091c\u0941\u0932\u093e\u0908"\
        "\u0905\u0917\u0938\u094d\u0924"\
        "\u0938\u093f\u0924\u092e\u094d\u092c\u0930"\
        "\u0905\u0915\u094d\u091f\u0942\u092c\u0930"\
        "\u0928\u0935\u092e\u094d\u092c\u0930"\
        "\u0926\u093f\u0938\u092e\u094d\u092c\u0930"]
    ::msgcat::mcset hi MONTHS_FULL [list \
        "जनवरी"\
        "फ़रवरी"\
        "मारà¥à¤š"\
        "अपà¥à¤°à¥‡à¤²"\
        "मई"\
        "जून"\
        "जà¥à¤²à¤¾à¤ˆ"\
        "अगसà¥à¤¤"\
        "सितमà¥à¤¬à¤°"\
        "अकà¥à¤Ÿà¥‚बर"\
        "नवमà¥à¤¬à¤°"\
        "दिसमà¥à¤¬à¤°"]
    ::msgcat::mcset hi AM "ईसापूरà¥à¤µ"
        "\u091c\u0928\u0935\u0930\u0940"\
        "\u092b\u093c\u0930\u0935\u0930\u0940"\
        "\u092e\u093e\u0930\u094d\u091a"\
        "\u0905\u092a\u094d\u0930\u0947\u0932"\
        "\u092e\u0908"\
        "\u091c\u0942\u0928"\
        "\u091c\u0941\u0932\u093e\u0908"\
        "\u0905\u0917\u0938\u094d\u0924"\
        "\u0938\u093f\u0924\u092e\u094d\u092c\u0930"\
        "\u0905\u0915\u094d\u091f\u0942\u092c\u0930"\
        "\u0928\u0935\u092e\u094d\u092c\u0930"\
        "\u0926\u093f\u0938\u092e\u094d\u092c\u0930"]
    ::msgcat::mcset hi AM "\u0908\u0938\u093e\u092a\u0942\u0930\u094d\u0935"
    ::msgcat::mcset hi PM "."
}

Changes to library/msgs/hr.msg.

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
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







-
+







-
+





-
+











-
-
-
+
+
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset hr DAYS_OF_WEEK_ABBREV [list \
        "ned"\
        "pon"\
        "uto"\
        "sri"\
        "Äet"\
        "\u010det"\
        "pet"\
        "sub"]
    ::msgcat::mcset hr DAYS_OF_WEEK_FULL [list \
        "nedjelja"\
        "ponedjeljak"\
        "utorak"\
        "srijeda"\
        "Äetvrtak"\
        "\u010detvrtak"\
        "petak"\
        "subota"]
    ::msgcat::mcset hr MONTHS_ABBREV [list \
        "sij"\
        "vel"\
        "ožu"\
        "o\u017eu"\
        "tra"\
        "svi"\
        "lip"\
        "srp"\
        "kol"\
        "ruj"\
        "lis"\
        "stu"\
        "pro"\
        ""]
    ::msgcat::mcset hr MONTHS_FULL [list \
        "sijeÄanj"\
        "veljaÄa"\
        "ožujak"\
        "sije\u010danj"\
        "velja\u010da"\
        "o\u017eujak"\
        "travanj"\
        "svibanj"\
        "lipanj"\
        "srpanj"\
        "kolovoz"\
        "rujan"\
        "listopad"\

Changes to library/msgs/hu.msg.

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
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











-
-
+
+


-
-
+
+




-
-
-
-
-
+
+
+
+
+







-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset hu DAYS_OF_WEEK_ABBREV [list \
        "V"\
        "H"\
        "K"\
        "Sze"\
        "Cs"\
        "P"\
        "Szo"]
    ::msgcat::mcset hu DAYS_OF_WEEK_FULL [list \
        "vasárnap"\
        "hétfő"\
        "vas\u00e1rnap"\
        "h\u00e9tf\u0151"\
        "kedd"\
        "szerda"\
        "csütörtök"\
        "péntek"\
        "cs\u00fct\u00f6rt\u00f6k"\
        "p\u00e9ntek"\
        "szombat"]
    ::msgcat::mcset hu MONTHS_ABBREV [list \
        "jan."\
        "febr."\
        "márc."\
        "ápr."\
        "máj."\
        "jún."\
        "júl."\
        "m\u00e1rc."\
        "\u00e1pr."\
        "m\u00e1j."\
        "j\u00fan."\
        "j\u00fal."\
        "aug."\
        "szept."\
        "okt."\
        "nov."\
        "dec."\
        ""]
    ::msgcat::mcset hu MONTHS_FULL [list \
        "január"\
        "február"\
        "március"\
        "április"\
        "május"\
        "június"\
        "július"\
        "janu\u00e1r"\
        "febru\u00e1r"\
        "m\u00e1rcius"\
        "\u00e1prilis"\
        "m\u00e1jus"\
        "j\u00fanius"\
        "j\u00falius"\
        "augusztus"\
        "szeptember"\
        "október"\
        "okt\u00f3ber"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset hu BCE "i.e."
    ::msgcat::mcset hu CE "i.u."
    ::msgcat::mcset hu AM "DE"
    ::msgcat::mcset hu PM "DU"

Changes to library/msgs/is.msg.

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
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




-
-
-
+
+
+

-
+



-
-
-
+
+
+

-
+






-
-
-
-
+
+
+
+


-
+



-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+






# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset is DAYS_OF_WEEK_ABBREV [list \
        "sun."\
        "mán."\
        "þri."\
        "mið."\
        "m\u00e1n."\
        "\u00feri."\
        "mi\u00f0."\
        "fim."\
        "fös."\
        "f\u00f6s."\
        "lau."]
    ::msgcat::mcset is DAYS_OF_WEEK_FULL [list \
        "sunnudagur"\
        "mánudagur"\
        "þriðjudagur"\
        "miðvikudagur"\
        "m\u00e1nudagur"\
        "\u00feri\u00f0judagur"\
        "mi\u00f0vikudagur"\
        "fimmtudagur"\
        "föstudagur"\
        "f\u00f6studagur"\
        "laugardagur"]
    ::msgcat::mcset is MONTHS_ABBREV [list \
        "jan."\
        "feb."\
        "mar."\
        "apr."\
        "maí"\
        "jún."\
        "júl."\
        "ágú."\
        "ma\u00ed"\
        "j\u00fan."\
        "j\u00fal."\
        "\u00e1g\u00fa."\
        "sep."\
        "okt."\
        "nóv."\
        "n\u00f3v."\
        "des."\
        ""]
    ::msgcat::mcset is MONTHS_FULL [list \
        "janúar"\
        "febrúar"\
        "jan\u00faar"\
        "febr\u00faar"\
        "mars"\
        "apríl"\
        "maí"\
        "júní"\
        "júlí"\
        "ágúst"\
        "apr\u00edl"\
        "ma\u00ed"\
        "j\u00fan\u00ed"\
        "j\u00fal\u00ed"\
        "\u00e1g\u00fast"\
        "september"\
        "október"\
        "nóvember"\
        "okt\u00f3ber"\
        "n\u00f3vember"\
        "desember"\
        ""]
    ::msgcat::mcset is DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset is TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset is DATE_TIME_FORMAT "%e.%m.%Y %H:%M:%S %z"
}

Changes to library/msgs/it.msg.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17





18
19
20
21
22
23
24
1
2
3
4
5
6
7
8
9
10
11
12





13
14
15
16
17
18
19
20
21
22
23
24












-
-
-
-
-
+
+
+
+
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset it DAYS_OF_WEEK_ABBREV [list \
        "dom"\
        "lun"\
        "mar"\
        "mer"\
        "gio"\
        "ven"\
        "sab"]
    ::msgcat::mcset it DAYS_OF_WEEK_FULL [list \
        "domenica"\
        "lunedì"\
        "martedì"\
        "mercoledì"\
        "giovedì"\
        "venerdì"\
        "luned\u00ec"\
        "marted\u00ec"\
        "mercoled\u00ec"\
        "gioved\u00ec"\
        "venerd\u00ec"\
        "sabato"]
    ::msgcat::mcset it MONTHS_ABBREV [list \
        "gen"\
        "feb"\
        "mar"\
        "apr"\
        "mag"\

Changes to library/msgs/ja.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
-
-
+
+
+
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ja DAYS_OF_WEEK_ABBREV [list \
        "æ—¥"\
        "月"\
        "ç«"\
        "æ°´"\
        "木"\
        "金"\
        "土"]
        "\u65e5"\
        "\u6708"\
        "\u706b"\
        "\u6c34"\
        "\u6728"\
        "\u91d1"\
        "\u571f"]
    ::msgcat::mcset ja DAYS_OF_WEEK_FULL [list \
        "日曜日"\
        "月曜日"\
        "ç«æ›œæ—¥"\
        "水曜日"\
        "木曜日"\
        "金曜日"\
        "土曜日"]
        "\u65e5\u66dc\u65e5"\
        "\u6708\u66dc\u65e5"\
        "\u706b\u66dc\u65e5"\
        "\u6c34\u66dc\u65e5"\
        "\u6728\u66dc\u65e5"\
        "\u91d1\u66dc\u65e5"\
        "\u571f\u66dc\u65e5"]
    ::msgcat::mcset ja MONTHS_FULL [list \
        "1月"\
        "2月"\
        "3月"\
        "4月"\
        "5月"\
        "6月"\
        "7月"\
        "8月"\
        "9月"\
        "10月"\
        "11月"\
        "12月"]
    ::msgcat::mcset ja BCE "紀元å‰"
    ::msgcat::mcset ja CE "西暦"
    ::msgcat::mcset ja AM "åˆå‰"
    ::msgcat::mcset ja PM "åˆå¾Œ"
        "1\u6708"\
        "2\u6708"\
        "3\u6708"\
        "4\u6708"\
        "5\u6708"\
        "6\u6708"\
        "7\u6708"\
        "8\u6708"\
        "9\u6708"\
        "10\u6708"\
        "11\u6708"\
        "12\u6708"]
    ::msgcat::mcset ja BCE "\u7d00\u5143\u524d"
    ::msgcat::mcset ja CE "\u897f\u66a6"
    ::msgcat::mcset ja AM "\u5348\u524d"
    ::msgcat::mcset ja PM "\u5348\u5f8c"
    ::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d"
    ::msgcat::mcset ja TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z"
    ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY年%m月%d日"
    ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H時%M分%S秒"
    ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY年%m月%d日 (%a) %H時%M分%S秒 %z"
    ::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 西暦 0} {-3061011600 明治 1867} {-1812186000 大正 1911} {-1357635600 昭和 1925} {600220800 å¹³æˆ 1988} {1556668800 令和 2018}"
    ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY\u5e74%m\u6708%d\u65e5"
    ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H\u6642%M\u5206%S\u79d2"
    ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY\u5e74%m\u6708%d\u65e5 (%a) %H\u6642%M\u5206%S\u79d2 %z"
    ::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 \u897f\u66a6 0} {-3061011600 \u660e\u6cbb 1867} {-1812186000 \u5927\u6b63 1911} {-1357635600 \u662d\u548c 1925} {600220800 \u5e73\u6210 1988} {1556668800 \u4ee4\u548c 2018}"
}

Changes to library/msgs/ko.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+



-
-
-
+
+
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ko DAYS_OF_WEEK_ABBREV [list \
        "ì¼"\
        "ì›”"\
        "í™”"\
        "수"\
        "목"\
        "금"\
        "토"]
        "\uc77c"\
        "\uc6d4"\
        "\ud654"\
        "\uc218"\
        "\ubaa9"\
        "\uae08"\
        "\ud1a0"]
    ::msgcat::mcset ko DAYS_OF_WEEK_FULL [list \
        "ì¼ìš”ì¼"\
        "월요ì¼"\
        "화요ì¼"\
        "수요ì¼"\
        "목요ì¼"\
        "금요ì¼"\
        "토요ì¼"]
        "\uc77c\uc694\uc77c"\
        "\uc6d4\uc694\uc77c"\
        "\ud654\uc694\uc77c"\
        "\uc218\uc694\uc77c"\
        "\ubaa9\uc694\uc77c"\
        "\uae08\uc694\uc77c"\
        "\ud1a0\uc694\uc77c"]
    ::msgcat::mcset ko MONTHS_ABBREV [list \
        "1ì›”"\
        "2ì›”"\
        "3ì›”"\
        "4ì›”"\
        "5ì›”"\
        "6ì›”"\
        "7ì›”"\
        "8ì›”"\
        "9ì›”"\
        "10ì›”"\
        "11ì›”"\
        "12ì›”"\
        "1\uc6d4"\
        "2\uc6d4"\
        "3\uc6d4"\
        "4\uc6d4"\
        "5\uc6d4"\
        "6\uc6d4"\
        "7\uc6d4"\
        "8\uc6d4"\
        "9\uc6d4"\
        "10\uc6d4"\
        "11\uc6d4"\
        "12\uc6d4"\
        ""]
    ::msgcat::mcset ko MONTHS_FULL [list \
        "1ì›”"\
        "2ì›”"\
        "3ì›”"\
        "4ì›”"\
        "5ì›”"\
        "6ì›”"\
        "7ì›”"\
        "8ì›”"\
        "9ì›”"\
        "10ì›”"\
        "11ì›”"\
        "12ì›”"\
        "1\uc6d4"\
        "2\uc6d4"\
        "3\uc6d4"\
        "4\uc6d4"\
        "5\uc6d4"\
        "6\uc6d4"\
        "7\uc6d4"\
        "8\uc6d4"\
        "9\uc6d4"\
        "10\uc6d4"\
        "11\uc6d4"\
        "12\uc6d4"\
        ""]
    ::msgcat::mcset ko AM "오전"
    ::msgcat::mcset ko PM "오후"
    ::msgcat::mcset ko AM "\uc624\uc804"
    ::msgcat::mcset ko PM "\uc624\ud6c4"
    ::msgcat::mcset ko DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset ko TIME_FORMAT_12 "%P %l:%M:%S"
    ::msgcat::mcset ko DATE_TIME_FORMAT "%Y-%m-%d %P %l:%M:%S %z"
    ::msgcat::mcset ko LOCALE_DATE_FORMAT "%Yë…„%B%Odì¼"
    ::msgcat::mcset ko LOCALE_TIME_FORMAT "%H시%M분%S초"
    ::msgcat::mcset ko LOCALE_DATE_TIME_FORMAT "%A %Yë…„%B%Odì¼%Hì‹œ%M분%Sì´ˆ %z"
    ::msgcat::mcset ko LOCALE_DATE_FORMAT "%Y\ub144%B%Od\uc77c"
    ::msgcat::mcset ko LOCALE_TIME_FORMAT "%H\uc2dc%M\ubd84%S\ucd08"
    ::msgcat::mcset ko LOCALE_DATE_TIME_FORMAT "%A %Y\ub144%B%Od\uc77c%H\uc2dc%M\ubd84%S\ucd08 %z"
}

Changes to library/msgs/ko_kr.msg.

1
2
3
4


5
6
7
8
1
2


3
4
5
6
7
8


-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ko_KR BCE "기ì›ì „"
    ::msgcat::mcset ko_KR CE "서기"
    ::msgcat::mcset ko_KR BCE "\uae30\uc6d0\uc804"
    ::msgcat::mcset ko_KR CE "\uc11c\uae30"
    ::msgcat::mcset ko_KR DATE_FORMAT "%Y.%m.%d"
    ::msgcat::mcset ko_KR TIME_FORMAT_12 "%P %l:%M:%S"
    ::msgcat::mcset ko_KR DATE_TIME_FORMAT "%Y.%m.%d %P %l:%M:%S %z"
}

Changes to library/msgs/kok.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset kok DAYS_OF_WEEK_FULL [list \
        "आदितà¥à¤¯à¤µà¤¾à¤°"\
        "सोमवार"\
        "मंगळार"\
        "बà¥à¤§à¤µà¤¾à¤°"\
        "गà¥à¤°à¥à¤µà¤¾à¤°"\
        "शà¥à¤•à¥à¤°à¤µà¤¾à¤°"\
        "शनिवार"]
        "\u0906\u0926\u093f\u0924\u094d\u092f\u0935\u093e\u0930"\
        "\u0938\u094b\u092e\u0935\u093e\u0930"\
        "\u092e\u0902\u0917\u0933\u093e\u0930"\
        "\u092c\u0941\u0927\u0935\u093e\u0930"\
        "\u0917\u0941\u0930\u0941\u0935\u093e\u0930"\
        "\u0936\u0941\u0915\u094d\u0930\u0935\u093e\u0930"\
        "\u0936\u0928\u093f\u0935\u093e\u0930"]
    ::msgcat::mcset kok MONTHS_ABBREV [list \
        "जानेवारी"\
        "फेबृवारी"\
        "मारà¥à¤š"\
        "à¤à¤ªà¥à¤°à¤¿à¤²"\
        "मे"\
        "जून"\
        "जà¥à¤²à¥ˆ"\
        "ओगसà¥à¤Ÿ"\
        "सेपà¥à¤Ÿà¥‡à¤‚बर"\
        "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
        "नोवà¥à¤¹à¥‡à¤‚बर"\
        "डिसेंबर"]
        "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
        "\u092b\u0947\u092c\u0943\u0935\u093e\u0930\u0940"\
        "\u092e\u093e\u0930\u094d\u091a"\
        "\u090f\u092a\u094d\u0930\u093f\u0932"\
        "\u092e\u0947"\
        "\u091c\u0942\u0928"\
        "\u091c\u0941\u0932\u0948"\
        "\u0913\u0917\u0938\u094d\u091f"\
        "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
        "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
        "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
        "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
    ::msgcat::mcset kok MONTHS_FULL [list \
        "जानेवारी"\
        "फेबà¥à¤°à¥à¤µà¤¾à¤°à¥€"\
        "मारà¥à¤š"\
        "à¤à¤ªà¥à¤°à¤¿à¤²"\
        "मे"\
        "जून"\
        "जà¥à¤²à¥ˆ"\
        "ओगसà¥à¤Ÿ"\
        "सेपà¥à¤Ÿà¥‡à¤‚बर"\
        "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
        "नोवà¥à¤¹à¥‡à¤‚बर"\
        "डिसेंबर"]
    ::msgcat::mcset kok AM "कà¥à¤°à¤¿à¤¸à¥à¤¤à¤ªà¥‚रà¥à¤µ"
    ::msgcat::mcset kok PM "कà¥à¤°à¤¿à¤¸à¥à¤¤à¤¶à¤–ा"
        "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
        "\u092b\u0947\u092c\u094d\u0930\u0941\u0935\u093e\u0930\u0940"\
        "\u092e\u093e\u0930\u094d\u091a"\
        "\u090f\u092a\u094d\u0930\u093f\u0932"\
        "\u092e\u0947"\
        "\u091c\u0942\u0928"\
        "\u091c\u0941\u0932\u0948"\
        "\u0913\u0917\u0938\u094d\u091f"\
        "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
        "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
        "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
        "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
    ::msgcat::mcset kok AM "\u0915\u094d\u0930\u093f\u0938\u094d\u0924\u092a\u0942\u0930\u094d\u0935"
    ::msgcat::mcset kok PM "\u0915\u094d\u0930\u093f\u0938\u094d\u0924\u0936\u0916\u093e"
}

Changes to library/msgs/lt.msg.

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
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









-
+




-
+


-
+


















-
-
-
+
+
+

-
-
+
+

-
-
+
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset lt DAYS_OF_WEEK_ABBREV [list \
        "Sk"\
        "Pr"\
        "An"\
        "Tr"\
        "Kt"\
        "Pn"\
        "Å t"]
        "\u0160t"]
    ::msgcat::mcset lt DAYS_OF_WEEK_FULL [list \
        "Sekmadienis"\
        "Pirmadienis"\
        "Antradienis"\
        "TreÄiadienis"\
        "Tre\u010diadienis"\
        "Ketvirtadienis"\
        "Penktadienis"\
        "Šeštadienis"]
        "\u0160e\u0161tadienis"]
    ::msgcat::mcset lt MONTHS_ABBREV [list \
        "Sau"\
        "Vas"\
        "Kov"\
        "Bal"\
        "Geg"\
        "Bir"\
        "Lie"\
        "Rgp"\
        "Rgs"\
        "Spa"\
        "Lap"\
        "Grd"\
        ""]
    ::msgcat::mcset lt MONTHS_FULL [list \
        "Sausio"\
        "Vasario"\
        "Kovo"\
        "Balandžio"\
        "Gegužės"\
        "Birželio"\
        "Baland\u017eio"\
        "Gegu\u017e\u0117s"\
        "Bir\u017eelio"\
        "Liepos"\
        "RugpjÅ«Äio"\
        "RugsÄ—jo"\
        "Rugpj\u016b\u010dio"\
        "Rugs\u0117jo"\
        "Spalio"\
        "LapkriÄio"\
        "Gruodžio"\
        "Lapkri\u010dio"\
        "Gruod\u017eio"\
        ""]
    ::msgcat::mcset lt BCE "pr.Kr."
    ::msgcat::mcset lt CE "po.Kr."
    ::msgcat::mcset lt DATE_FORMAT "%Y.%m.%e"
    ::msgcat::mcset lt TIME_FORMAT "%H.%M.%S"
    ::msgcat::mcset lt DATE_TIME_FORMAT "%Y.%m.%e %H.%M.%S %z"
}

Changes to library/msgs/lv.msg.

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
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











-
+


-
+









-
-
+
+







-
-
+
+

-
+

-
-
+
+






-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset lv DAYS_OF_WEEK_ABBREV [list \
        "Sv"\
        "P"\
        "O"\
        "T"\
        "C"\
        "Pk"\
        "S"]
    ::msgcat::mcset lv DAYS_OF_WEEK_FULL [list \
        "svētdiena"\
        "sv\u0113tdiena"\
        "pirmdiena"\
        "otrdiena"\
        "trešdiena"\
        "tre\u0161diena"\
        "ceturdien"\
        "piektdiena"\
        "sestdiena"]
    ::msgcat::mcset lv MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mar"\
        "Apr"\
        "Maijs"\
        "JÅ«n"\
        "JÅ«l"\
        "J\u016bn"\
        "J\u016bl"\
        "Aug"\
        "Sep"\
        "Okt"\
        "Nov"\
        "Dec"\
        ""]
    ::msgcat::mcset lv MONTHS_FULL [list \
        "janvÄris"\
        "februÄris"\
        "janv\u0101ris"\
        "febru\u0101ris"\
        "marts"\
        "aprīlis"\
        "apr\u012blis"\
        "maijs"\
        "jūnijs"\
        "jūlijs"\
        "j\u016bnijs"\
        "j\u016blijs"\
        "augusts"\
        "septembris"\
        "oktobris"\
        "novembris"\
        "decembris"\
        ""]
    ::msgcat::mcset lv BCE "pmē"
    ::msgcat::mcset lv CE "mē"
    ::msgcat::mcset lv BCE "pm\u0113"
    ::msgcat::mcset lv CE "m\u0113"
    ::msgcat::mcset lv DATE_FORMAT "%Y.%e.%m"
    ::msgcat::mcset lv TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset lv DATE_TIME_FORMAT "%Y.%e.%m %H:%M:%S %z"
}

Changes to library/msgs/mk.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset mk DAYS_OF_WEEK_ABBREV [list \
        "нед."\
        "пон."\
        "вт."\
        "Ñре."\
        "чет."\
        "пет."\
        "Ñаб."]
        "\u043d\u0435\u0434."\
        "\u043f\u043e\u043d."\
        "\u0432\u0442."\
        "\u0441\u0440\u0435."\
        "\u0447\u0435\u0442."\
        "\u043f\u0435\u0442."\
        "\u0441\u0430\u0431."]
    ::msgcat::mcset mk DAYS_OF_WEEK_FULL [list \
        "недела"\
        "понеделник"\
        "вторник"\
        "Ñреда"\
        "четврток"\
        "петок"\
        "Ñабота"]
        "\u043d\u0435\u0434\u0435\u043b\u0430"\
        "\u043f\u043e\u043d\u0435\u0434\u0435\u043b\u043d\u0438\u043a"\
        "\u0432\u0442\u043e\u0440\u043d\u0438\u043a"\
        "\u0441\u0440\u0435\u0434\u0430"\
        "\u0447\u0435\u0442\u0432\u0440\u0442\u043e\u043a"\
        "\u043f\u0435\u0442\u043e\u043a"\
        "\u0441\u0430\u0431\u043e\u0442\u0430"]
    ::msgcat::mcset mk MONTHS_ABBREV [list \
        "јан."\
        "фев."\
        "мар."\
        "апр."\
        "мај."\
        "јун."\
        "јул."\
        "авг."\
        "Ñепт."\
        "окт."\
        "ноем."\
        "декем."\
        "\u0458\u0430\u043d."\
        "\u0444\u0435\u0432."\
        "\u043c\u0430\u0440."\
        "\u0430\u043f\u0440."\
        "\u043c\u0430\u0458."\
        "\u0458\u0443\u043d."\
        "\u0458\u0443\u043b."\
        "\u0430\u0432\u0433."\
        "\u0441\u0435\u043f\u0442."\
        "\u043e\u043a\u0442."\
        "\u043d\u043e\u0435\u043c."\
        "\u0434\u0435\u043a\u0435\u043c."\
        ""]
    ::msgcat::mcset mk MONTHS_FULL [list \
        "јануари"\
        "февруари"\
        "март"\
        "април"\
        "мај"\
        "јуни"\
        "јули"\
        "авгуÑÑ‚"\
        "Ñептември"\
        "октомври"\
        "ноември"\
        "декември"\
        "\u0458\u0430\u043d\u0443\u0430\u0440\u0438"\
        "\u0444\u0435\u0432\u0440\u0443\u0430\u0440\u0438"\
        "\u043c\u0430\u0440\u0442"\
        "\u0430\u043f\u0440\u0438\u043b"\
        "\u043c\u0430\u0458"\
        "\u0458\u0443\u043d\u0438"\
        "\u0458\u0443\u043b\u0438"\
        "\u0430\u0432\u0433\u0443\u0441\u0442"\
        "\u0441\u0435\u043f\u0442\u0435\u043c\u0432\u0440\u0438"\
        "\u043e\u043a\u0442\u043e\u043c\u0432\u0440\u0438"\
        "\u043d\u043e\u0435\u043c\u0432\u0440\u0438"\
        "\u0434\u0435\u043a\u0435\u043c\u0432\u0440\u0438"\
        ""]
    ::msgcat::mcset mk BCE "пр.н.е."
    ::msgcat::mcset mk CE "ае."
    ::msgcat::mcset mk BCE "\u043f\u0440.\u043d.\u0435."
    ::msgcat::mcset mk CE "\u0430\u0435."
    ::msgcat::mcset mk DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset mk TIME_FORMAT "%H:%M:%S %z"
    ::msgcat::mcset mk DATE_TIME_FORMAT "%e.%m.%Y %H:%M:%S %z %z"
}

Changes to library/msgs/mr.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+



# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset mr DAYS_OF_WEEK_FULL [list \
        "रविवार"\
        "सोमवार"\
        "मंगळवार"\
        "मंगळवार"\
        "गà¥à¤°à¥à¤µà¤¾à¤°"\
        "शà¥à¤•à¥à¤°à¤µà¤¾à¤°"\
        "शनिवार"]
        "\u0930\u0935\u093f\u0935\u093e\u0930"\
        "\u0938\u094b\u092e\u0935\u093e\u0930"\
        "\u092e\u0902\u0917\u0933\u0935\u093e\u0930"\
        "\u092e\u0902\u0917\u0933\u0935\u093e\u0930"\
        "\u0917\u0941\u0930\u0941\u0935\u093e\u0930"\
        "\u0936\u0941\u0915\u094d\u0930\u0935\u093e\u0930"\
        "\u0936\u0928\u093f\u0935\u093e\u0930"]
    ::msgcat::mcset mr MONTHS_ABBREV [list \
        "जानेवारी"\
        "फेबृवारी"\
        "मारà¥à¤š"\
        "à¤à¤ªà¥à¤°à¤¿à¤²"\
        "मे"\
        "जून"\
        "जà¥à¤²à¥ˆ"\
        "ओगसà¥à¤Ÿ"\
        "सेपà¥à¤Ÿà¥‡à¤‚बर"\
        "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
        "नोवà¥à¤¹à¥‡à¤‚बर"\
        "डिसेंबर"]
        "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
        "\u092b\u0947\u092c\u0943\u0935\u093e\u0930\u0940"\
        "\u092e\u093e\u0930\u094d\u091a"\
        "\u090f\u092a\u094d\u0930\u093f\u0932"\
        "\u092e\u0947"\
        "\u091c\u0942\u0928"\
        "\u091c\u0941\u0932\u0948"\
        "\u0913\u0917\u0938\u094d\u091f"\
        "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
        "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
        "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
        "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
    ::msgcat::mcset mr MONTHS_FULL [list \
        "जानेवारी"\
        "फेबृवारी"\
        "मारà¥à¤š"\
        "à¤à¤ªà¥à¤°à¤¿à¤²"\
        "मे"\
        "जून"\
        "जà¥à¤²à¥ˆ"\
        "ओगसà¥à¤Ÿ"\
        "सेपà¥à¤Ÿà¥‡à¤‚बर"\
        "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
        "नोवà¥à¤¹à¥‡à¤‚बर"\
        "डिसेंबर"]
        "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
        "\u092b\u0947\u092c\u0943\u0935\u093e\u0930\u0940"\
        "\u092e\u093e\u0930\u094d\u091a"\
        "\u090f\u092a\u094d\u0930\u093f\u0932"\
        "\u092e\u0947"\
        "\u091c\u0942\u0928"\
        "\u091c\u0941\u0932\u0948"\
        "\u0913\u0917\u0938\u094d\u091f"\
        "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
        "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
        "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
        "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
    ::msgcat::mcset mr AM "BC"
    ::msgcat::mcset mr PM "AD"
}

Changes to library/msgs/mt.msg.

1
2
3
4

5
6
7
8
9


10
11
12
13
14
15
16

17
18
19
20
21
22
23
1
2
3

4
5
6
7


8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23



-
+



-
-
+
+






-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset mt DAYS_OF_WEEK_ABBREV [list \
        "Ħad"\
        "\u0126ad"\
        "Tne"\
        "Tli"\
        "Erb"\
        "Ħam"\
        "Ä im"]
        "\u0126am"\
        "\u0120im"]
    ::msgcat::mcset mt MONTHS_ABBREV [list \
        "Jan"\
        "Fra"\
        "Mar"\
        "Apr"\
        "Mej"\
        "Ä un"\
        "\u0120un"\
        "Lul"\
        "Awi"\
        "Set"\
        "Ott"\
        "Nov"]
    ::msgcat::mcset mt BCE "QK"
    ::msgcat::mcset mt CE ""

Changes to library/msgs/nb.msg.

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
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



-
+





-
+

-
+





-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset nb DAYS_OF_WEEK_ABBREV [list \
        "sø"\
        "s\u00f8"\
        "ma"\
        "ti"\
        "on"\
        "to"\
        "fr"\
        "lø"]
        "l\u00f8"]
    ::msgcat::mcset nb DAYS_OF_WEEK_FULL [list \
        "søndag"\
        "s\u00f8ndag"\
        "mandag"\
        "tirsdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "lørdag"]
        "l\u00f8rdag"]
    ::msgcat::mcset nb MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "mai"\
        "jun"\

Changes to library/msgs/nn.msg.

1
2
3
4
5

6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4

5
6
7
8
9
10
11
12

13
14
15
16
17
18
19
20




-
+







-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset nn DAYS_OF_WEEK_ABBREV [list \
        "su"\
        "må"\
        "m\u00e5"\
        "ty"\
        "on"\
        "to"\
        "fr"\
        "lau"]
    ::msgcat::mcset nn DAYS_OF_WEEK_FULL [list \
        "sundag"\
        "måndag"\
        "m\u00e5ndag"\
        "tysdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "laurdag"]
    ::msgcat::mcset nn MONTHS_ABBREV [list \
        "jan"\

Changes to library/msgs/pl.msg.

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
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






-
+





-
+

-
+

-
+











-
+




-
+


-
+



-
-
-
+
+
+

-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset pl DAYS_OF_WEEK_ABBREV [list \
        "N"\
        "Pn"\
        "Wt"\
        "Åšr"\
        "\u015ar"\
        "Cz"\
        "Pt"\
        "So"]
    ::msgcat::mcset pl DAYS_OF_WEEK_FULL [list \
        "niedziela"\
        "poniedziałek"\
        "poniedzia\u0142ek"\
        "wtorek"\
        "środa"\
        "\u015broda"\
        "czwartek"\
        "piÄ…tek"\
        "pi\u0105tek"\
        "sobota"]
    ::msgcat::mcset pl MONTHS_ABBREV [list \
        "sty"\
        "lut"\
        "mar"\
        "kwi"\
        "maj"\
        "cze"\
        "lip"\
        "sie"\
        "wrz"\
        "paź"\
        "pa\u017a"\
        "lis"\
        "gru"\
        ""]
    ::msgcat::mcset pl MONTHS_FULL [list \
        "styczeń"\
        "stycze\u0144"\
        "luty"\
        "marzec"\
        "kwiecień"\
        "kwiecie\u0144"\
        "maj"\
        "czerwiec"\
        "lipiec"\
        "sierpień"\
        "wrzesień"\
        "październik"\
        "sierpie\u0144"\
        "wrzesie\u0144"\
        "pa\u017adziernik"\
        "listopad"\
        "grudzień"\
        "grudzie\u0144"\
        ""]
    ::msgcat::mcset pl BCE "p.n.e."
    ::msgcat::mcset pl CE "n.e."
    ::msgcat::mcset pl DATE_FORMAT "%Y-%m-%d"
    ::msgcat::mcset pl TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset pl DATE_TIME_FORMAT "%Y-%m-%d %H:%M:%S %z"
}

Changes to library/msgs/pt.msg.

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
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









-
+



-
+



-
+

















-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset pt DAYS_OF_WEEK_ABBREV [list \
        "Dom"\
        "Seg"\
        "Ter"\
        "Qua"\
        "Qui"\
        "Sex"\
        "Sáb"]
        "S\u00e1b"]
    ::msgcat::mcset pt DAYS_OF_WEEK_FULL [list \
        "Domingo"\
        "Segunda-feira"\
        "Terça-feira"\
        "Ter\u00e7a-feira"\
        "Quarta-feira"\
        "Quinta-feira"\
        "Sexta-feira"\
        "Sábado"]
        "S\u00e1bado"]
    ::msgcat::mcset pt MONTHS_ABBREV [list \
        "Jan"\
        "Fev"\
        "Mar"\
        "Abr"\
        "Mai"\
        "Jun"\
        "Jul"\
        "Ago"\
        "Set"\
        "Out"\
        "Nov"\
        "Dez"\
        ""]
    ::msgcat::mcset pt MONTHS_FULL [list \
        "Janeiro"\
        "Fevereiro"\
        "Março"\
        "Mar\u00e7o"\
        "Abril"\
        "Maio"\
        "Junho"\
        "Julho"\
        "Agosto"\
        "Setembro"\
        "Outubro"\

Changes to library/msgs/ro.msg.

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
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











-
+

-
+



-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ro DAYS_OF_WEEK_ABBREV [list \
        "D"\
        "L"\
        "Ma"\
        "Mi"\
        "J"\
        "V"\
        "S"]
    ::msgcat::mcset ro DAYS_OF_WEEK_FULL [list \
        "duminică"\
        "duminic\u0103"\
        "luni"\
        "marţi"\
        "mar\u0163i"\
        "miercuri"\
        "joi"\
        "vineri"\
        "sîmbătă"]
        "s\u00eemb\u0103t\u0103"]
    ::msgcat::mcset ro MONTHS_ABBREV [list \
        "Ian"\
        "Feb"\
        "Mar"\
        "Apr"\
        "Mai"\
        "Iun"\
41
42
43
44
45
46
47
48

49
50
51
52
41
42
43
44
45
46
47

48
49
50
51
52







-
+




        "august"\
        "septembrie"\
        "octombrie"\
        "noiembrie"\
        "decembrie"\
        ""]
    ::msgcat::mcset ro BCE "d.C."
    ::msgcat::mcset ro CE "î.d.C."
    ::msgcat::mcset ro CE "\u00ee.d.C."
    ::msgcat::mcset ro DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset ro TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset ro DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"
}

Changes to library/msgs/ru.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ru DAYS_OF_WEEK_ABBREV [list \
        "Ð’Ñ"\
        "Пн"\
        "Ð’Ñ‚"\
        "Ср"\
        "Чт"\
        "Пт"\
        "Сб"]
        "\u0412\u0441"\
        "\u041f\u043d"\
        "\u0412\u0442"\
        "\u0421\u0440"\
        "\u0427\u0442"\
        "\u041f\u0442"\
        "\u0421\u0431"]
    ::msgcat::mcset ru DAYS_OF_WEEK_FULL [list \
        "воÑкреÑенье"\
        "понедельник"\
        "вторник"\
        "Ñреда"\
        "четверг"\
        "пÑтница"\
        "Ñуббота"]
        "\u0432\u043e\u0441\u043a\u0440\u0435\u0441\u0435\u043d\u044c\u0435"\
        "\u043f\u043e\u043d\u0435\u0434\u0435\u043b\u044c\u043d\u0438\u043a"\
        "\u0432\u0442\u043e\u0440\u043d\u0438\u043a"\
        "\u0441\u0440\u0435\u0434\u0430"\
        "\u0447\u0435\u0442\u0432\u0435\u0440\u0433"\
        "\u043f\u044f\u0442\u043d\u0438\u0446\u0430"\
        "\u0441\u0443\u0431\u0431\u043e\u0442\u0430"]
    ::msgcat::mcset ru MONTHS_ABBREV [list \
        "Ñнв"\
        "фев"\
        "мар"\
        "апр"\
        "май"\
        "июн"\
        "июл"\
        "авг"\
        "Ñен"\
        "окт"\
        "ноÑ"\
        "дек"\
        "\u044f\u043d\u0432"\
        "\u0444\u0435\u0432"\
        "\u043c\u0430\u0440"\
        "\u0430\u043f\u0440"\
        "\u043c\u0430\u0439"\
        "\u0438\u044e\u043d"\
        "\u0438\u044e\u043b"\
        "\u0430\u0432\u0433"\
        "\u0441\u0435\u043d"\
        "\u043e\u043a\u0442"\
        "\u043d\u043e\u044f"\
        "\u0434\u0435\u043a"\
        ""]
    ::msgcat::mcset ru MONTHS_FULL [list \
        "Январь"\
        "Февраль"\
        "Март"\
        "Ðпрель"\
        "Май"\
        "Июнь"\
        "Июль"\
        "ÐвгуÑÑ‚"\
        "СентÑбрь"\
        "ОктÑбрь"\
        "ÐоÑбрь"\
        "Декабрь"\
        "\u042f\u043d\u0432\u0430\u0440\u044c"\
        "\u0424\u0435\u0432\u0440\u0430\u043b\u044c"\
        "\u041c\u0430\u0440\u0442"\
        "\u0410\u043f\u0440\u0435\u043b\u044c"\
        "\u041c\u0430\u0439"\
        "\u0418\u044e\u043d\u044c"\
        "\u0418\u044e\u043b\u044c"\
        "\u0410\u0432\u0433\u0443\u0441\u0442"\
        "\u0421\u0435\u043d\u0442\u044f\u0431\u0440\u044c"\
        "\u041e\u043a\u0442\u044f\u0431\u0440\u044c"\
        "\u041d\u043e\u044f\u0431\u0440\u044c"\
        "\u0414\u0435\u043a\u0430\u0431\u0440\u044c"\
        ""]
    ::msgcat::mcset ru BCE "до н.Ñ."
    ::msgcat::mcset ru CE "н.Ñ."
    ::msgcat::mcset ru BCE "\u0434\u043e \u043d.\u044d."
    ::msgcat::mcset ru CE "\u043d.\u044d."
    ::msgcat::mcset ru DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset ru TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset ru DATE_TIME_FORMAT "%d.%m.%Y %k:%M:%S %z"
}

Changes to library/msgs/sh.msg.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23







-
+







-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sh DAYS_OF_WEEK_ABBREV [list \
        "Ned"\
        "Pon"\
        "Uto"\
        "Sre"\
        "ÄŒet"\
        "\u010cet"\
        "Pet"\
        "Sub"]
    ::msgcat::mcset sh DAYS_OF_WEEK_FULL [list \
        "Nedelja"\
        "Ponedeljak"\
        "Utorak"\
        "Sreda"\
        "ÄŒetvrtak"\
        "\u010cetvrtak"\
        "Petak"\
        "Subota"]
    ::msgcat::mcset sh MONTHS_ABBREV [list \
        "Jan"\
        "Feb"\
        "Mar"\
        "Apr"\

Changes to library/msgs/sk.msg.

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
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







-
+



-
+



-
+







-
-
-
+
+
+







-
-
+
+

-
-
-
-
+
+
+
+


-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sk DAYS_OF_WEEK_ABBREV [list \
        "Ne"\
        "Po"\
        "Ut"\
        "St"\
        "Å t"\
        "\u0160t"\
        "Pa"\
        "So"]
    ::msgcat::mcset sk DAYS_OF_WEEK_FULL [list \
        "Nedeľe"\
        "Nede\u013ee"\
        "Pondelok"\
        "Utorok"\
        "Streda"\
        "Å tvrtok"\
        "\u0160tvrtok"\
        "Piatok"\
        "Sobota"]
    ::msgcat::mcset sk MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "máj"\
        "jún"\
        "júl"\
        "m\u00e1j"\
        "j\u00fan"\
        "j\u00fal"\
        "aug"\
        "sep"\
        "okt"\
        "nov"\
        "dec"\
        ""]
    ::msgcat::mcset sk MONTHS_FULL [list \
        "január"\
        "február"\
        "janu\u00e1r"\
        "febru\u00e1r"\
        "marec"\
        "apríl"\
        "máj"\
        "jún"\
        "júl"\
        "apr\u00edl"\
        "m\u00e1j"\
        "j\u00fan"\
        "j\u00fal"\
        "august"\
        "september"\
        "október"\
        "okt\u00f3ber"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset sk BCE "pred n.l."
    ::msgcat::mcset sk CE "n.l."
    ::msgcat::mcset sk DATE_FORMAT "%e.%m.%Y"
    ::msgcat::mcset sk TIME_FORMAT "%k:%M:%S"

Changes to library/msgs/sl.msg.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23







-
+







-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sl DAYS_OF_WEEK_ABBREV [list \
        "Ned"\
        "Pon"\
        "Tor"\
        "Sre"\
        "ÄŒet"\
        "\u010cet"\
        "Pet"\
        "Sob"]
    ::msgcat::mcset sl DAYS_OF_WEEK_FULL [list \
        "Nedelja"\
        "Ponedeljek"\
        "Torek"\
        "Sreda"\
        "ÄŒetrtek"\
        "\u010cetrtek"\
        "Petek"\
        "Sobota"]
    ::msgcat::mcset sl MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
40
41
42
43
44
45
46
47

48
49
50
51
52
40
41
42
43
44
45
46

47
48
49
50
51
52







-
+





        "julij"\
        "avgust"\
        "september"\
        "oktober"\
        "november"\
        "december"\
        ""]
    ::msgcat::mcset sl BCE "pr.n.Å¡."
    ::msgcat::mcset sl BCE "pr.n.\u0161."
    ::msgcat::mcset sl CE "po Kr."
    ::msgcat::mcset sl DATE_FORMAT "%Y.%m.%e"
    ::msgcat::mcset sl TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset sl DATE_TIME_FORMAT "%Y.%m.%e %k:%M:%S %z"
}

Changes to library/msgs/sq.msg.

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
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




-
+

-
+





-
-
-
+
+
+


-
+











-
+













-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sq DAYS_OF_WEEK_ABBREV [list \
        "Die"\
        "Hën"\
        "H\u00ebn"\
        "Mar"\
        "Mër"\
        "M\u00ebr"\
        "Enj"\
        "Pre"\
        "Sht"]
    ::msgcat::mcset sq DAYS_OF_WEEK_FULL [list \
        "e diel"\
        "e hënë"\
        "e martë"\
        "e mërkurë"\
        "e h\u00ebn\u00eb"\
        "e mart\u00eb"\
        "e m\u00ebrkur\u00eb"\
        "e enjte"\
        "e premte"\
        "e shtunë"]
        "e shtun\u00eb"]
    ::msgcat::mcset sq MONTHS_ABBREV [list \
        "Jan"\
        "Shk"\
        "Mar"\
        "Pri"\
        "Maj"\
        "Qer"\
        "Kor"\
        "Gsh"\
        "Sht"\
        "Tet"\
        "Nën"\
        "N\u00ebn"\
        "Dhj"\
        ""]
    ::msgcat::mcset sq MONTHS_FULL [list \
        "janar"\
        "shkurt"\
        "mars"\
        "prill"\
        "maj"\
        "qershor"\
        "korrik"\
        "gusht"\
        "shtator"\
        "tetor"\
        "nëntor"\
        "n\u00ebntor"\
        "dhjetor"\
        ""]
    ::msgcat::mcset sq BCE "p.e.r."
    ::msgcat::mcset sq CE "n.e.r."
    ::msgcat::mcset sq AM "PD"
    ::msgcat::mcset sq PM "MD"
    ::msgcat::mcset sq DATE_FORMAT "%Y-%m-%d"

Changes to library/msgs/sr.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sr DAYS_OF_WEEK_ABBREV [list \
        "Ðед"\
        "Пон"\
        "Уто"\
        "Сре"\
        "Чет"\
        "Пет"\
        "Суб"]
        "\u041d\u0435\u0434"\
        "\u041f\u043e\u043d"\
        "\u0423\u0442\u043e"\
        "\u0421\u0440\u0435"\
        "\u0427\u0435\u0442"\
        "\u041f\u0435\u0442"\
        "\u0421\u0443\u0431"]
    ::msgcat::mcset sr DAYS_OF_WEEK_FULL [list \
        "Ðедеља"\
        "Понедељак"\
        "Уторак"\
        "Среда"\
        "Четвртак"\
        "Петак"\
        "Субота"]
        "\u041d\u0435\u0434\u0435\u0459\u0430"\
        "\u041f\u043e\u043d\u0435\u0434\u0435\u0459\u0430\u043a"\
        "\u0423\u0442\u043e\u0440\u0430\u043a"\
        "\u0421\u0440\u0435\u0434\u0430"\
        "\u0427\u0435\u0442\u0432\u0440\u0442\u0430\u043a"\
        "\u041f\u0435\u0442\u0430\u043a"\
        "\u0421\u0443\u0431\u043e\u0442\u0430"]
    ::msgcat::mcset sr MONTHS_ABBREV [list \
        "Јан"\
        "Феб"\
        "Мар"\
        "Ðпр"\
        "Мај"\
        "Јун"\
        "Јул"\
        "Ðвг"\
        "Сеп"\
        "Окт"\
        "Ðов"\
        "Дец"\
        "\u0408\u0430\u043d"\
        "\u0424\u0435\u0431"\
        "\u041c\u0430\u0440"\
        "\u0410\u043f\u0440"\
        "\u041c\u0430\u0458"\
        "\u0408\u0443\u043d"\
        "\u0408\u0443\u043b"\
        "\u0410\u0432\u0433"\
        "\u0421\u0435\u043f"\
        "\u041e\u043a\u0442"\
        "\u041d\u043e\u0432"\
        "\u0414\u0435\u0446"\
        ""]
    ::msgcat::mcset sr MONTHS_FULL [list \
        "Јануар"\
        "Фебруар"\
        "Март"\
        "Ðприл"\
        "Мај"\
        "Јуни"\
        "Јули"\
        "ÐвгуÑÑ‚"\
        "Септембар"\
        "Октобар"\
        "Ðовембар"\
        "Децембар"\
        "\u0408\u0430\u043d\u0443\u0430\u0440"\
        "\u0424\u0435\u0431\u0440\u0443\u0430\u0440"\
        "\u041c\u0430\u0440\u0442"\
        "\u0410\u043f\u0440\u0438\u043b"\
        "\u041c\u0430\u0458"\
        "\u0408\u0443\u043d\u0438"\
        "\u0408\u0443\u043b\u0438"\
        "\u0410\u0432\u0433\u0443\u0441\u0442"\
        "\u0421\u0435\u043f\u0442\u0435\u043c\u0431\u0430\u0440"\
        "\u041e\u043a\u0442\u043e\u0431\u0430\u0440"\
        "\u041d\u043e\u0432\u0435\u043c\u0431\u0430\u0440"\
        "\u0414\u0435\u0446\u0435\u043c\u0431\u0430\u0440"\
        ""]
    ::msgcat::mcset sr BCE "п. н. е."
    ::msgcat::mcset sr CE "н. е"
    ::msgcat::mcset sr BCE "\u043f. \u043d. \u0435."
    ::msgcat::mcset sr CE "\u043d. \u0435"
    ::msgcat::mcset sr DATE_FORMAT "%Y.%m.%e"
    ::msgcat::mcset sr TIME_FORMAT "%k.%M.%S"
    ::msgcat::mcset sr DATE_TIME_FORMAT "%Y.%m.%e %k.%M.%S %z"
}

Changes to library/msgs/sv.msg.

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
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



-
-
+
+




-
+

-
-
+
+




-
+







# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset sv DAYS_OF_WEEK_ABBREV [list \
        "sö"\
        "må"\
        "s\u00f6"\
        "m\u00e5"\
        "ti"\
        "on"\
        "to"\
        "fr"\
        "lö"]
        "l\u00f6"]
    ::msgcat::mcset sv DAYS_OF_WEEK_FULL [list \
        "söndag"\
        "måndag"\
        "s\u00f6ndag"\
        "m\u00e5ndag"\
        "tisdag"\
        "onsdag"\
        "torsdag"\
        "fredag"\
        "lördag"]
        "l\u00f6rdag"]
    ::msgcat::mcset sv MONTHS_ABBREV [list \
        "jan"\
        "feb"\
        "mar"\
        "apr"\
        "maj"\
        "jun"\

Changes to library/msgs/ta.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset ta DAYS_OF_WEEK_FULL [list \
        "ஞாயிறà¯"\
        "திஙà¯à®•à®³à¯"\
        "செவà¯à®µà®¾à®¯à¯"\
        "பà¯à®¤à®©à¯"\
        "வியாழனà¯"\
        "வெளà¯à®³à®¿"\
        "சனி"]
        "\u0b9e\u0bbe\u0baf\u0bbf\u0bb1\u0bc1"\
        "\u0ba4\u0bbf\u0b99\u0bcd\u0b95\u0bb3\u0bcd"\
        "\u0b9a\u0bc6\u0bb5\u0bcd\u0bb5\u0bbe\u0baf\u0bcd"\
        "\u0baa\u0bc1\u0ba4\u0ba9\u0bcd"\
        "\u0bb5\u0bbf\u0baf\u0bbe\u0bb4\u0ba9\u0bcd"\
        "\u0bb5\u0bc6\u0bb3\u0bcd\u0bb3\u0bbf"\
        "\u0b9a\u0ba9\u0bbf"]
    ::msgcat::mcset ta MONTHS_ABBREV [list \
        "ஜனவரி"\
        "பெபà¯à®°à®µà®°à®¿"\
        "மாரà¯à®šà¯"\
        "à®à®ªà¯à®°à®²à¯"\
        "மே"\
        "ஜூனà¯"\
        "ஜூலை"\
        "ஆகஸà¯à®Ÿà¯"\
        "செபà¯à®Ÿà®®à¯à®ªà®°à¯"\
        "அகà¯à®Ÿà¯‹à®ªà®°à¯"\
        "நவமà¯à®ªà®°à¯"\
        "டிசமà¯à®ªà®°à¯r"]
        "\u0b9c\u0ba9\u0bb5\u0bb0\u0bbf"\
        "\u0baa\u0bc6\u0baa\u0bcd\u0bb0\u0bb5\u0bb0\u0bbf"\
        "\u0bae\u0bbe\u0bb0\u0bcd\u0b9a\u0bcd"\
        "\u0b8f\u0baa\u0bcd\u0bb0\u0bb2\u0bcd"\
        "\u0bae\u0bc7"\
        "\u0b9c\u0bc2\u0ba9\u0bcd"\
        "\u0b9c\u0bc2\u0bb2\u0bc8"\
        "\u0b86\u0b95\u0bb8\u0bcd\u0b9f\u0bcd"\
        "\u0b9a\u0bc6\u0baa\u0bcd\u0b9f\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
        "\u0b85\u0b95\u0bcd\u0b9f\u0bcb\u0baa\u0bb0\u0bcd"\
        "\u0ba8\u0bb5\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
        "\u0b9f\u0bbf\u0b9a\u0bae\u0bcd\u0baa\u0bb0\u0bcdr"]
    ::msgcat::mcset ta MONTHS_FULL [list \
        "ஜனவரி"\
        "பெபà¯à®°à®µà®°à®¿"\
        "மாரà¯à®šà¯"\
        "à®à®ªà¯à®°à®²à¯"\
        "மே"\
        "ஜூனà¯"\
        "ஜூலை"\
        "ஆகஸà¯à®Ÿà¯"\
        "செபà¯à®Ÿà®®à¯à®ªà®°à¯"\
        "அகà¯à®Ÿà¯‹à®ªà®°à¯"\
        "நவமà¯à®ªà®°à¯"\
        "டிசமà¯à®ªà®°à¯r"]
    ::msgcat::mcset ta AM "கிமà¯"
    ::msgcat::mcset ta PM "கிபி"
        "\u0b9c\u0ba9\u0bb5\u0bb0\u0bbf"\
        "\u0baa\u0bc6\u0baa\u0bcd\u0bb0\u0bb5\u0bb0\u0bbf"\
        "\u0bae\u0bbe\u0bb0\u0bcd\u0b9a\u0bcd"\
        "\u0b8f\u0baa\u0bcd\u0bb0\u0bb2\u0bcd"\
        "\u0bae\u0bc7"\
        "\u0b9c\u0bc2\u0ba9\u0bcd"\
        "\u0b9c\u0bc2\u0bb2\u0bc8"\
        "\u0b86\u0b95\u0bb8\u0bcd\u0b9f\u0bcd"\
        "\u0b9a\u0bc6\u0baa\u0bcd\u0b9f\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
        "\u0b85\u0b95\u0bcd\u0b9f\u0bcb\u0baa\u0bb0\u0bcd"\
        "\u0ba8\u0bb5\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
        "\u0b9f\u0bbf\u0b9a\u0bae\u0bcd\u0baa\u0bb0\u0bcdr"]
    ::msgcat::mcset ta AM "\u0b95\u0bbf\u0bae\u0bc1"
    ::msgcat::mcset ta PM "\u0b95\u0bbf\u0baa\u0bbf"
}

Changes to library/msgs/te.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset te DAYS_OF_WEEK_ABBREV [list \
        "ఆది"\
        "సోమ"\
        "మంగళ"\
        "à°¬à±à°§"\
        "à°—à±à°°à±"\
        "à°¶à±à°•à±à°°"\
        "శని"]
        "\u0c06\u0c26\u0c3f"\
        "\u0c38\u0c4b\u0c2e"\
        "\u0c2e\u0c02\u0c17\u0c33"\
        "\u0c2c\u0c41\u0c27"\
        "\u0c17\u0c41\u0c30\u0c41"\
        "\u0c36\u0c41\u0c15\u0c4d\u0c30"\
        "\u0c36\u0c28\u0c3f"]
    ::msgcat::mcset te DAYS_OF_WEEK_FULL [list \
        "ఆదివారం"\
        "సోమవారం"\
        "మంగళవారం"\
        "à°¬à±à°§à°µà°¾à°°à°‚"\
        "à°—à±à°°à±à°µà°¾à°°à°‚"\
        "à°¶à±à°•à±à°°à°µà°¾à°°à°‚"\
        "శనివారం"]
        "\u0c06\u0c26\u0c3f\u0c35\u0c3e\u0c30\u0c02"\
        "\u0c38\u0c4b\u0c2e\u0c35\u0c3e\u0c30\u0c02"\
        "\u0c2e\u0c02\u0c17\u0c33\u0c35\u0c3e\u0c30\u0c02"\
        "\u0c2c\u0c41\u0c27\u0c35\u0c3e\u0c30\u0c02"\
        "\u0c17\u0c41\u0c30\u0c41\u0c35\u0c3e\u0c30\u0c02"\
        "\u0c36\u0c41\u0c15\u0c4d\u0c30\u0c35\u0c3e\u0c30\u0c02"\
        "\u0c36\u0c28\u0c3f\u0c35\u0c3e\u0c30\u0c02"]
    ::msgcat::mcset te MONTHS_ABBREV [list \
        "జనవరి"\
        "à°«à°¿à°¬à±à°°à°µà°°à°¿"\
        "మారà±à°šà°¿"\
        "à°à°ªà±à°°à°¿à°²à±"\
        "మే"\
        "జూనà±"\
        "జూలై"\
        "ఆగసà±à°Ÿà±"\
        "సెపà±à°Ÿà±†à°‚బరà±"\
        "à°…à°•à±à°Ÿà±‹à°¬à°°à±"\
        "నవంబరà±"\
        "డిసెంబరà±"\
        "\u0c1c\u0c28\u0c35\u0c30\u0c3f"\
        "\u0c2b\u0c3f\u0c2c\u0c4d\u0c30\u0c35\u0c30\u0c3f"\
        "\u0c2e\u0c3e\u0c30\u0c4d\u0c1a\u0c3f"\
        "\u0c0f\u0c2a\u0c4d\u0c30\u0c3f\u0c32\u0c4d"\
        "\u0c2e\u0c47"\
        "\u0c1c\u0c42\u0c28\u0c4d"\
        "\u0c1c\u0c42\u0c32\u0c48"\
        "\u0c06\u0c17\u0c38\u0c4d\u0c1f\u0c41"\
        "\u0c38\u0c46\u0c2a\u0c4d\u0c1f\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
        "\u0c05\u0c15\u0c4d\u0c1f\u0c4b\u0c2c\u0c30\u0c4d"\
        "\u0c28\u0c35\u0c02\u0c2c\u0c30\u0c4d"\
        "\u0c21\u0c3f\u0c38\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
        ""]
    ::msgcat::mcset te MONTHS_FULL [list \
        "జనవరి"\
        "à°«à°¿à°¬à±à°°à°µà°°à°¿"\
        "మారà±à°šà°¿"\
        "à°à°ªà±à°°à°¿à°²à±"\
        "మే"\
        "జూనà±"\
        "జూలై"\
        "ఆగసà±à°Ÿà±"\
        "సెపà±à°Ÿà±†à°‚బరà±"\
        "à°…à°•à±à°Ÿà±‹à°¬à°°à±"\
        "నవంబరà±"\
        "డిసెంబరà±"\
        "\u0c1c\u0c28\u0c35\u0c30\u0c3f"\
        "\u0c2b\u0c3f\u0c2c\u0c4d\u0c30\u0c35\u0c30\u0c3f"\
        "\u0c2e\u0c3e\u0c30\u0c4d\u0c1a\u0c3f"\
        "\u0c0f\u0c2a\u0c4d\u0c30\u0c3f\u0c32\u0c4d"\
        "\u0c2e\u0c47"\
        "\u0c1c\u0c42\u0c28\u0c4d"\
        "\u0c1c\u0c42\u0c32\u0c48"\
        "\u0c06\u0c17\u0c38\u0c4d\u0c1f\u0c41"\
        "\u0c38\u0c46\u0c2a\u0c4d\u0c1f\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
        "\u0c05\u0c15\u0c4d\u0c1f\u0c4b\u0c2c\u0c30\u0c4d"\
        "\u0c28\u0c35\u0c02\u0c2c\u0c30\u0c4d"\
        "\u0c21\u0c3f\u0c38\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
        ""]
}

Changes to library/msgs/te_in.msg.

1
2
3
4


5
6
7
8
1
2


3
4
5
6
7
8


-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset te_IN AM "పూరà±à°µà°¾à°¹à±à°¨"
    ::msgcat::mcset te_IN PM "అపరాహà±à°¨"
    ::msgcat::mcset te_IN AM "\u0c2a\u0c42\u0c30\u0c4d\u0c35\u0c3e\u0c39\u0c4d\u0c28"
    ::msgcat::mcset te_IN PM "\u0c05\u0c2a\u0c30\u0c3e\u0c39\u0c4d\u0c28"
    ::msgcat::mcset te_IN DATE_FORMAT "%d/%m/%Y"
    ::msgcat::mcset te_IN TIME_FORMAT_12 "%I:%M:%S %P"
    ::msgcat::mcset te_IN DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
}

Changes to library/msgs/th.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset th DAYS_OF_WEEK_ABBREV [list \
        "อา."\
        "จ."\
        "อ."\
        "พ."\
        "พฤ."\
        "ศ."\
        "ส."]
        "\u0e2d\u0e32."\
        "\u0e08."\
        "\u0e2d."\
        "\u0e1e."\
        "\u0e1e\u0e24."\
        "\u0e28."\
        "\u0e2a."]
    ::msgcat::mcset th DAYS_OF_WEEK_FULL [list \
        "วันอาทิตย์"\
        "วันจันทร์"\
        "วันอังคาร"\
        "วันพุธ"\
        "วันพฤหัสบดี"\
        "วันศุà¸à¸£à¹Œ"\
        "วันเสาร์"]
        "\u0e27\u0e31\u0e19\u0e2d\u0e32\u0e17\u0e34\u0e15\u0e22\u0e4c"\
        "\u0e27\u0e31\u0e19\u0e08\u0e31\u0e19\u0e17\u0e23\u0e4c"\
        "\u0e27\u0e31\u0e19\u0e2d\u0e31\u0e07\u0e04\u0e32\u0e23"\
        "\u0e27\u0e31\u0e19\u0e1e\u0e38\u0e18"\
        "\u0e27\u0e31\u0e19\u0e1e\u0e24\u0e2b\u0e31\u0e2a\u0e1a\u0e14\u0e35"\
        "\u0e27\u0e31\u0e19\u0e28\u0e38\u0e01\u0e23\u0e4c"\
        "\u0e27\u0e31\u0e19\u0e40\u0e2a\u0e32\u0e23\u0e4c"]
    ::msgcat::mcset th MONTHS_ABBREV [list \
        "ม.ค."\
        "à¸.พ."\
        "มี.ค."\
        "เม.ย."\
        "พ.ค."\
        "มิ.ย."\
        "à¸.ค."\
        "ส.ค."\
        "à¸.ย."\
        "ต.ค."\
        "พ.ย."\
        "ธ.ค."\
        "\u0e21.\u0e04."\
        "\u0e01.\u0e1e."\
        "\u0e21\u0e35.\u0e04."\
        "\u0e40\u0e21.\u0e22."\
        "\u0e1e.\u0e04."\
        "\u0e21\u0e34.\u0e22."\
        "\u0e01.\u0e04."\
        "\u0e2a.\u0e04."\
        "\u0e01.\u0e22."\
        "\u0e15.\u0e04."\
        "\u0e1e.\u0e22."\
        "\u0e18.\u0e04."\
        ""]
    ::msgcat::mcset th MONTHS_FULL [list \
        "มà¸à¸£à¸²à¸„ม"\
        "à¸à¸¸à¸¡à¸ à¸²à¸žà¸±à¸™à¸˜à¹Œ"\
        "มีนาคม"\
        "เมษายน"\
        "พฤษภาคม"\
        "มิถุนายน"\
        "à¸à¸£à¸à¸Žà¸²à¸„ม"\
        "สิงหาคม"\
        "à¸à¸±à¸™à¸¢à¸²à¸¢à¸™"\
        "ตุลาคม"\
        "พฤศจิà¸à¸²à¸¢à¸™"\
        "ธันวาคม"\
        "\u0e21\u0e01\u0e23\u0e32\u0e04\u0e21"\
        "\u0e01\u0e38\u0e21\u0e20\u0e32\u0e1e\u0e31\u0e19\u0e18\u0e4c"\
        "\u0e21\u0e35\u0e19\u0e32\u0e04\u0e21"\
        "\u0e40\u0e21\u0e29\u0e32\u0e22\u0e19"\
        "\u0e1e\u0e24\u0e29\u0e20\u0e32\u0e04\u0e21"\
        "\u0e21\u0e34\u0e16\u0e38\u0e19\u0e32\u0e22\u0e19"\
        "\u0e01\u0e23\u0e01\u0e0e\u0e32\u0e04\u0e21"\
        "\u0e2a\u0e34\u0e07\u0e2b\u0e32\u0e04\u0e21"\
        "\u0e01\u0e31\u0e19\u0e22\u0e32\u0e22\u0e19"\
        "\u0e15\u0e38\u0e25\u0e32\u0e04\u0e21"\
        "\u0e1e\u0e24\u0e28\u0e08\u0e34\u0e01\u0e32\u0e22\u0e19"\
        "\u0e18\u0e31\u0e19\u0e27\u0e32\u0e04\u0e21"\
        ""]
    ::msgcat::mcset th BCE "ลที่"
    ::msgcat::mcset th CE "ค.ศ."
    ::msgcat::mcset th AM "à¸à¹ˆà¸­à¸™à¹€à¸—ี่ยง"
    ::msgcat::mcset th PM "หลังเที่ยง"
    ::msgcat::mcset th BCE "\u0e25\u0e17\u0e35\u0e48"
    ::msgcat::mcset th CE "\u0e04.\u0e28."
    ::msgcat::mcset th AM "\u0e01\u0e48\u0e2d\u0e19\u0e40\u0e17\u0e35\u0e48\u0e22\u0e07"
    ::msgcat::mcset th PM "\u0e2b\u0e25\u0e31\u0e07\u0e40\u0e17\u0e35\u0e48\u0e22\u0e07"
    ::msgcat::mcset th DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset th TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset th DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"
}

Changes to library/msgs/tr.msg.

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
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






-
+






-
-
-
+
+
+




-
+





-
+







-
+


-
+


-
-
+
+

-
-
+
+





# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset tr DAYS_OF_WEEK_ABBREV [list \
        "Paz"\
        "Pzt"\
        "Sal"\
        "Çar"\
        "\u00c7ar"\
        "Per"\
        "Cum"\
        "Cmt"]
    ::msgcat::mcset tr DAYS_OF_WEEK_FULL [list \
        "Pazar"\
        "Pazartesi"\
        "Salı"\
        "Çarşamba"\
        "PerÅŸembe"\
        "Sal\u0131"\
        "\u00c7ar\u015famba"\
        "Per\u015fembe"\
        "Cuma"\
        "Cumartesi"]
    ::msgcat::mcset tr MONTHS_ABBREV [list \
        "Oca"\
        "Åžub"\
        "\u015eub"\
        "Mar"\
        "Nis"\
        "May"\
        "Haz"\
        "Tem"\
        "AÄŸu"\
        "A\u011fu"\
        "Eyl"\
        "Eki"\
        "Kas"\
        "Ara"\
        ""]
    ::msgcat::mcset tr MONTHS_FULL [list \
        "Ocak"\
        "Åžubat"\
        "\u015eubat"\
        "Mart"\
        "Nisan"\
        "Mayıs"\
        "May\u0131s"\
        "Haziran"\
        "Temmuz"\
        "AÄŸustos"\
        "Eylül"\
        "A\u011fustos"\
        "Eyl\u00fcl"\
        "Ekim"\
        "Kasım"\
        "Aralık"\
        "Kas\u0131m"\
        "Aral\u0131k"\
        ""]
    ::msgcat::mcset tr DATE_FORMAT "%d.%m.%Y"
    ::msgcat::mcset tr TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset tr DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"
}

Changes to library/msgs/uk.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset uk DAYS_OF_WEEK_ABBREV [list \
        "нд"\
        "пн"\
        "вт"\
        "ÑÑ€"\
        "чт"\
        "пт"\
        "Ñб"]
        "\u043d\u0434"\
        "\u043f\u043d"\
        "\u0432\u0442"\
        "\u0441\u0440"\
        "\u0447\u0442"\
        "\u043f\u0442"\
        "\u0441\u0431"]
    ::msgcat::mcset uk DAYS_OF_WEEK_FULL [list \
        "неділÑ"\
        "понеділок"\
        "вівторок"\
        "Ñереда"\
        "четвер"\
        "п'ÑтницÑ"\
        "Ñубота"]
        "\u043d\u0435\u0434\u0456\u043b\u044f"\
        "\u043f\u043e\u043d\u0435\u0434\u0456\u043b\u043e\u043a"\
        "\u0432\u0456\u0432\u0442\u043e\u0440\u043e\u043a"\
        "\u0441\u0435\u0440\u0435\u0434\u0430"\
        "\u0447\u0435\u0442\u0432\u0435\u0440"\
        "\u043f'\u044f\u0442\u043d\u0438\u0446\u044f"\
        "\u0441\u0443\u0431\u043e\u0442\u0430"]
    ::msgcat::mcset uk MONTHS_ABBREV [list \
        "Ñіч"\
        "лют"\
        "бер"\
        "квіт"\
        "трав"\
        "черв"\
        "лип"\
        "Ñерп"\
        "вер"\
        "жовт"\
        "лиÑÑ‚"\
        "груд"\
        "\u0441\u0456\u0447"\
        "\u043b\u044e\u0442"\
        "\u0431\u0435\u0440"\
        "\u043a\u0432\u0456\u0442"\
        "\u0442\u0440\u0430\u0432"\
        "\u0447\u0435\u0440\u0432"\
        "\u043b\u0438\u043f"\
        "\u0441\u0435\u0440\u043f"\
        "\u0432\u0435\u0440"\
        "\u0436\u043e\u0432\u0442"\
        "\u043b\u0438\u0441\u0442"\
        "\u0433\u0440\u0443\u0434"\
        ""]
    ::msgcat::mcset uk MONTHS_FULL [list \
        "ÑічнÑ"\
        "лютого"\
        "березнÑ"\
        "квітнÑ"\
        "травнÑ"\
        "червнÑ"\
        "липнÑ"\
        "ÑерпнÑ"\
        "вереÑнÑ"\
        "жовтнÑ"\
        "лиÑтопада"\
        "груднÑ"\
        "\u0441\u0456\u0447\u043d\u044f"\
        "\u043b\u044e\u0442\u043e\u0433\u043e"\
        "\u0431\u0435\u0440\u0435\u0437\u043d\u044f"\
        "\u043a\u0432\u0456\u0442\u043d\u044f"\
        "\u0442\u0440\u0430\u0432\u043d\u044f"\
        "\u0447\u0435\u0440\u0432\u043d\u044f"\
        "\u043b\u0438\u043f\u043d\u044f"\
        "\u0441\u0435\u0440\u043f\u043d\u044f"\
        "\u0432\u0435\u0440\u0435\u0441\u043d\u044f"\
        "\u0436\u043e\u0432\u0442\u043d\u044f"\
        "\u043b\u0438\u0441\u0442\u043e\u043f\u0430\u0434\u0430"\
        "\u0433\u0440\u0443\u0434\u043d\u044f"\
        ""]
    ::msgcat::mcset uk BCE "до н.е."
    ::msgcat::mcset uk CE "піÑÐ»Ñ Ð½.е."
    ::msgcat::mcset uk BCE "\u0434\u043e \u043d.\u0435."
    ::msgcat::mcset uk CE "\u043f\u0456\u0441\u043b\u044f \u043d.\u0435."
    ::msgcat::mcset uk DATE_FORMAT "%e/%m/%Y"
    ::msgcat::mcset uk TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset uk DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"
}

Changes to library/msgs/vi.msg.

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
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











-
-
-
-
-
-
-
+
+
+
+
+
+
+















-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+





# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset vi DAYS_OF_WEEK_ABBREV [list \
        "Th 2"\
        "Th 3"\
        "Th 4"\
        "Th 5"\
        "Th 6"\
        "Th 7"\
        "CN"]
    ::msgcat::mcset vi DAYS_OF_WEEK_FULL [list \
        "ThÆ°Ì hai"\
        "ThÆ°Ì ba"\
        "ThÆ°Ì tÆ°"\
        "ThÆ°Ì năm"\
        "ThÆ°Ì sáu"\
        "ThÆ°Ì bảy"\
        "Chủ nhật"]
        "Th\u01b0\u0301 hai"\
        "Th\u01b0\u0301 ba"\
        "Th\u01b0\u0301 t\u01b0"\
        "Th\u01b0\u0301 n\u0103m"\
        "Th\u01b0\u0301 s\u00e1u"\
        "Th\u01b0\u0301 ba\u0309y"\
        "Chu\u0309 nh\u00e2\u0323t"]
    ::msgcat::mcset vi MONTHS_ABBREV [list \
        "Thg 1"\
        "Thg 2"\
        "Thg 3"\
        "Thg 4"\
        "Thg 5"\
        "Thg 6"\
        "Thg 7"\
        "Thg 8"\
        "Thg 9"\
        "Thg 10"\
        "Thg 11"\
        "Thg 12"\
        ""]
    ::msgcat::mcset vi MONTHS_FULL [list \
        "Tháng một"\
        "Tháng hai"\
        "Tháng ba"\
        "Tháng tư"\
        "Tháng năm"\
        "Tháng sáu"\
        "Tháng bảy"\
        "Tháng tám"\
        "Tháng chín"\
        "Tháng mười"\
        "Tháng mười một"\
        "Tháng mười hai"\
        "Th\u00e1ng m\u00f4\u0323t"\
        "Th\u00e1ng hai"\
        "Th\u00e1ng ba"\
        "Th\u00e1ng t\u01b0"\
        "Th\u00e1ng n\u0103m"\
        "Th\u00e1ng s\u00e1u"\
        "Th\u00e1ng ba\u0309y"\
        "Th\u00e1ng t\u00e1m"\
        "Th\u00e1ng ch\u00edn"\
        "Th\u00e1ng m\u01b0\u01a1\u0300i"\
        "Th\u00e1ng m\u01b0\u01a1\u0300i m\u00f4\u0323t"\
        "Th\u00e1ng m\u01b0\u01a1\u0300i hai"\
        ""]
    ::msgcat::mcset vi DATE_FORMAT "%d %b %Y"
    ::msgcat::mcset vi TIME_FORMAT "%H:%M:%S"
    ::msgcat::mcset vi DATE_TIME_FORMAT "%d %b %Y %H:%M:%S %z"
}

Changes to library/msgs/zh.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh DAYS_OF_WEEK_ABBREV [list \
        "星期日"\
        "星期一"\
        "星期二"\
        "星期三"\
        "星期四"\
        "星期五"\
        "星期六"]
        "\u661f\u671f\u65e5"\
        "\u661f\u671f\u4e00"\
        "\u661f\u671f\u4e8c"\
        "\u661f\u671f\u4e09"\
        "\u661f\u671f\u56db"\
        "\u661f\u671f\u4e94"\
        "\u661f\u671f\u516d"]
    ::msgcat::mcset zh DAYS_OF_WEEK_FULL [list \
        "星期日"\
        "星期一"\
        "星期二"\
        "星期三"\
        "星期四"\
        "星期五"\
        "星期六"]
        "\u661f\u671f\u65e5"\
        "\u661f\u671f\u4e00"\
        "\u661f\u671f\u4e8c"\
        "\u661f\u671f\u4e09"\
        "\u661f\u671f\u56db"\
        "\u661f\u671f\u4e94"\
        "\u661f\u671f\u516d"]
    ::msgcat::mcset zh MONTHS_ABBREV [list \
        "一月"\
        "二月"\
        "三月"\
        "四月"\
        "五月"\
        "六月"\
        "七月"\
        "八月"\
        "ä¹æœˆ"\
        "å月"\
        "å一月"\
        "å二月"\
        "\u4e00\u6708"\
        "\u4e8c\u6708"\
        "\u4e09\u6708"\
        "\u56db\u6708"\
        "\u4e94\u6708"\
        "\u516d\u6708"\
        "\u4e03\u6708"\
        "\u516b\u6708"\
        "\u4e5d\u6708"\
        "\u5341\u6708"\
        "\u5341\u4e00\u6708"\
        "\u5341\u4e8c\u6708"\
        ""]
    ::msgcat::mcset zh MONTHS_FULL [list \
        "一月"\
        "二月"\
        "三月"\
        "四月"\
        "五月"\
        "六月"\
        "七月"\
        "八月"\
        "ä¹æœˆ"\
        "å月"\
        "å一月"\
        "å二月"\
        "\u4e00\u6708"\
        "\u4e8c\u6708"\
        "\u4e09\u6708"\
        "\u56db\u6708"\
        "\u4e94\u6708"\
        "\u516d\u6708"\
        "\u4e03\u6708"\
        "\u516b\u6708"\
        "\u4e5d\u6708"\
        "\u5341\u6708"\
        "\u5341\u4e00\u6708"\
        "\u5341\u4e8c\u6708"\
        ""]
    ::msgcat::mcset zh BCE "公元å‰"
    ::msgcat::mcset zh CE "公元"
    ::msgcat::mcset zh AM "上åˆ"
    ::msgcat::mcset zh PM "下åˆ"
    ::msgcat::mcset zh LOCALE_NUMERALS "〇 一 二 三 å›› 五 å…­ 七 å…« ä¹ å å一 å二 å三 åå›› å五 åå…­ å七 åå…« åä¹ äºŒå 廿一 廿二 廿三 廿四 廿五 廿六 廿七 廿八 å»¿ä¹ ä¸‰å å…一 å…二 å…三 å…å›› å…五 å…å…­ å…七 å…å…« å…ä¹ å››å å››å一 å››å二 å››å三 å››åå›› å››å五 å››åå…­ å››å七 å››åå…« å››åä¹ äº”å 五å一 五å二 五å三 五åå›› 五å五 五åå…­ 五å七 五åå…« 五åä¹ å…­å å…­å一 å…­å二 å…­å三 å…­åå›› å…­å五 å…­åå…­ å…­å七 å…­åå…« å…­åä¹ ä¸ƒå 七å一 七å二 七å三 七åå›› 七å五 七åå…­ 七å七 七åå…« 七åä¹ å…«å å…«å一 å…«å二 å…«å三 å…«åå›› å…«å五 å…«åå…­ å…«å七 å…«åå…« å…«åä¹ ä¹å ä¹å一 ä¹å二 ä¹å三 ä¹åå›› ä¹å五 ä¹åå…­ ä¹å七 ä¹åå…« ä¹åä¹"
    ::msgcat::mcset zh LOCALE_DATE_FORMAT "公元%Y年%B%Od日"
    ::msgcat::mcset zh LOCALE_TIME_FORMAT "%OH时%OM分%OS秒"
    ::msgcat::mcset zh LOCALE_DATE_TIME_FORMAT "%A %Y年%B%Od日%OH时%OM分%OS秒 %z"
    ::msgcat::mcset zh BCE "\u516c\u5143\u524d"
    ::msgcat::mcset zh CE "\u516c\u5143"
    ::msgcat::mcset zh AM "\u4e0a\u5348"
    ::msgcat::mcset zh PM "\u4e0b\u5348"
    ::msgcat::mcset zh LOCALE_NUMERALS "\u3007 \u4e00 \u4e8c \u4e09 \u56db \u4e94 \u516d \u4e03 \u516b \u4e5d \u5341 \u5341\u4e00 \u5341\u4e8c \u5341\u4e09 \u5341\u56db \u5341\u4e94 \u5341\u516d \u5341\u4e03 \u5341\u516b \u5341\u4e5d \u4e8c\u5341 \u5eff\u4e00 \u5eff\u4e8c \u5eff\u4e09 \u5eff\u56db \u5eff\u4e94 \u5eff\u516d \u5eff\u4e03 \u5eff\u516b \u5eff\u4e5d \u4e09\u5341 \u5345\u4e00 \u5345\u4e8c \u5345\u4e09 \u5345\u56db \u5345\u4e94 \u5345\u516d \u5345\u4e03 \u5345\u516b \u5345\u4e5d \u56db\u5341 \u56db\u5341\u4e00 \u56db\u5341\u4e8c \u56db\u5341\u4e09 \u56db\u5341\u56db \u56db\u5341\u4e94 \u56db\u5341\u516d \u56db\u5341\u4e03 \u56db\u5341\u516b \u56db\u5341\u4e5d \u4e94\u5341 \u4e94\u5341\u4e00 \u4e94\u5341\u4e8c \u4e94\u5341\u4e09 \u4e94\u5341\u56db \u4e94\u5341\u4e94 \u4e94\u5341\u516d \u4e94\u5341\u4e03 \u4e94\u5341\u516b \u4e94\u5341\u4e5d \u516d\u5341 \u516d\u5341\u4e00 \u516d\u5341\u4e8c \u516d\u5341\u4e09 \u516d\u5341\u56db \u516d\u5341\u4e94 \u516d\u5341\u516d \u516d\u5341\u4e03 \u516d\u5341\u516b \u516d\u5341\u4e5d \u4e03\u5341 \u4e03\u5341\u4e00 \u4e03\u5341\u4e8c \u4e03\u5341\u4e09 \u4e03\u5341\u56db \u4e03\u5341\u4e94 \u4e03\u5341\u516d \u4e03\u5341\u4e03 \u4e03\u5341\u516b \u4e03\u5341\u4e5d \u516b\u5341 \u516b\u5341\u4e00 \u516b\u5341\u4e8c \u516b\u5341\u4e09 \u516b\u5341\u56db \u516b\u5341\u4e94 \u516b\u5341\u516d \u516b\u5341\u4e03 \u516b\u5341\u516b \u516b\u5341\u4e5d \u4e5d\u5341 \u4e5d\u5341\u4e00 \u4e5d\u5341\u4e8c \u4e5d\u5341\u4e09 \u4e5d\u5341\u56db \u4e5d\u5341\u4e94 \u4e5d\u5341\u516d \u4e5d\u5341\u4e03 \u4e5d\u5341\u516b \u4e5d\u5341\u4e5d"
    ::msgcat::mcset zh LOCALE_DATE_FORMAT "\u516c\u5143%Y\u5e74%B%Od\u65e5"
    ::msgcat::mcset zh LOCALE_TIME_FORMAT "%OH\u65f6%OM\u5206%OS\u79d2"
    ::msgcat::mcset zh LOCALE_DATE_TIME_FORMAT "%A %Y\u5e74%B%Od\u65e5%OH\u65f6%OM\u5206%OS\u79d2 %z"
}

Changes to library/msgs/zh_cn.msg.

1
2
3
4
5

6
7
1
2
3
4

5
6
7




-
+


# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_CN DATE_FORMAT "%Y-%m-%e"
    ::msgcat::mcset zh_CN TIME_FORMAT "%k:%M:%S"
    ::msgcat::mcset zh_CN TIME_FORMAT_12 "%P%I时%M分%S秒"
    ::msgcat::mcset zh_CN TIME_FORMAT_12 "%P%I\u65f6%M\u5206%S\u79d2"
    ::msgcat::mcset zh_CN DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"
}

Changes to library/msgs/zh_hk.msg.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_HK DAYS_OF_WEEK_ABBREV [list \
        "æ—¥"\
        "一"\
        "二"\
        "三"\
        "å››"\
        "五"\
        "å…­"]
        "\u65e5"\
        "\u4e00"\
        "\u4e8c"\
        "\u4e09"\
        "\u56db"\
        "\u4e94"\
        "\u516d"]
    ::msgcat::mcset zh_HK MONTHS_ABBREV [list \
        "1月"\
        "2月"\
        "3月"\
        "4月"\
        "5月"\
        "6月"\
        "7月"\
        "8月"\
        "9月"\
        "10月"\
        "11月"\
        "12月"\
        "1\u6708"\
        "2\u6708"\
        "3\u6708"\
        "4\u6708"\
        "5\u6708"\
        "6\u6708"\
        "7\u6708"\
        "8\u6708"\
        "9\u6708"\
        "10\u6708"\
        "11\u6708"\
        "12\u6708"\
        ""]
    ::msgcat::mcset zh_HK DATE_FORMAT "%Y年%m月%e日"
    ::msgcat::mcset zh_HK DATE_FORMAT "%Y\u5e74%m\u6708%e\u65e5"
    ::msgcat::mcset zh_HK TIME_FORMAT_12 "%P%I:%M:%S"
    ::msgcat::mcset zh_HK DATE_TIME_FORMAT "%Y年%m月%e日 %P%I:%M:%S %z"
    ::msgcat::mcset zh_HK DATE_TIME_FORMAT "%Y\u5e74%m\u6708%e\u65e5 %P%I:%M:%S %z"
}

Changes to library/msgs/zh_sg.msg.

1
2
3
4


5
6
7
8
1
2


3
4
5
6
7
8


-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_SG AM "上åˆ"
    ::msgcat::mcset zh_SG PM "中åˆ"
    ::msgcat::mcset zh_SG AM "\u4e0a\u5348"
    ::msgcat::mcset zh_SG PM "\u4e2d\u5348"
    ::msgcat::mcset zh_SG DATE_FORMAT "%d %B %Y"
    ::msgcat::mcset zh_SG TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset zh_SG DATE_TIME_FORMAT "%d %B %Y %P %I:%M:%S %z"
}

Changes to library/msgs/zh_tw.msg.

1
2
3
4


5
6
7
8
1
2


3
4
5
6
7
8


-
-
+
+




# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
    ::msgcat::mcset zh_TW BCE "民國å‰"
    ::msgcat::mcset zh_TW CE "民國"
    ::msgcat::mcset zh_TW BCE "\u6c11\u570b\u524d"
    ::msgcat::mcset zh_TW CE "\u6c11\u570b"
    ::msgcat::mcset zh_TW DATE_FORMAT "%Y/%m/%e"
    ::msgcat::mcset zh_TW TIME_FORMAT_12 "%P %I:%M:%S"
    ::msgcat::mcset zh_TW DATE_TIME_FORMAT "%Y/%m/%e %P %I:%M:%S %z"
}

Changes to library/opt/optparse.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21













-
+







# optparse.tcl --
#
#       (private) Option parsing package
#       Primarily used internally by the safe:: code.
#
#	WARNING: This code will go away in a future release
#	of Tcl.  It is NOT supported and you should not rely
#	on it.  If your code does rely on this package you
#	may directly incorporate this code into your application.

package require Tcl 8.5-
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
package provide opt 0.4.8
package provide opt 0.4.7

namespace eval ::tcl {

    # Exported APIs
    namespace export OptKeyRegister OptKeyDelete OptKeyError OptKeyParse \
             OptProc OptProcArgGiven OptParse \
	     Lempty Lget \
40
41
42
43
44
45
46
47
48


49
50
51
52
53
54
55
40
41
42
43
44
45
46


47
48
49
50
51
52
53
54
55







-
-
+
+







	OptProc OptParseTest {
            {subcommand -choice {save print} "sub command"}
            {arg1 3 "some number"}
            {-aflag}
            {-intflag      7}
            {-weirdflag                    "help string"}
            {-noStatics                    "Not ok to load static packages"}
            {-nestedloading1 true           "OK to load into nested children"}
            {-nestedloading2 -boolean true "OK to load into nested children"}
            {-nestedloading1 true           "OK to load into nested slaves"}
            {-nestedloading2 -boolean true "OK to load into nested slaves"}
            {-libsOK        -choice {Tk SybTcl}
		                      "List of packages that can be loaded"}
            {-precision     -int 12        "Number of digits of precision"}
            {-intval        7               "An integer"}
            {-scale         -float 1.0     "Scale factor"}
            {-zoom          1.0             "Zoom factor"}
            {-arbitrary     foobar          "Arbitrary string"}

Changes to library/opt/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11
12

1
2
3
4
5
6
7
8
9
10
11

12











-
+
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
package ifneeded opt 0.4.8 [list source [file join $dir optparse.tcl]]
package ifneeded opt 0.4.7 [list source [file join $dir optparse.tcl]]

Changes to library/package.tcl.

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
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







-
-
-
+
+
+










-
+




















-
+








-
-
-
-
+
+
+
+
+




















-
+







# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

namespace eval tcl::Pkg {}

# ::tcl::Pkg::CompareExtension --
#
# Used internally by pkg_mkIndex to compare the extension of a file to a given
# extension. On Windows, it uses a case-insensitive comparison because the
# file system can be file insensitive.
#  Used internally by pkg_mkIndex to compare the extension of a file to
#  a given extension. On Windows, it uses a case-insensitive comparison
#  because the file system can be file insensitive.
#
# Arguments:
#  fileName	name of a file whose extension is compared
#  ext		(optional) The extension to compare against; you must
#		provide the starting dot.
#		Defaults to [info sharedlibextension]
#
# Results:
#  Returns 1 if the extension matches, 0 otherwise

proc tcl::Pkg::CompareExtension {fileName {ext {}}} {
proc tcl::Pkg::CompareExtension { fileName {ext {}} } {
    global tcl_platform
    if {$ext eq ""} {set ext [info sharedlibextension]}
    if {$tcl_platform(platform) eq "windows"} {
        return [string equal -nocase [file extension $fileName] $ext]
    } else {
        # Some unices add trailing numbers after the .so, so
        # we could have something like '.so.1.2'.
        set root $fileName
        while {1} {
            set currExt [file extension $root]
            if {$currExt eq $ext} {
                return 1
            }

	    # The current extension does not match; if it is not a numeric
	    # value, quit, as we are only looking to ignore version number
	    # extensions.  Otherwise we might return 1 in this case:
	    #		tcl::Pkg::CompareExtension foo.so.bar .so
	    # which should not match.

	    if {![string is integer -strict [string range $currExt 1 end]]} {
	    if { ![string is integer -strict [string range $currExt 1 end]] } {
		return 0
	    }
            set root [file rootname $root]
	}
    }
}

# pkg_mkIndex --
# This procedure creates a package index in a given directory.  The package
# index consists of a "pkgIndex.tcl" file whose contents are a Tcl script that
# sets up package information with "package require" commands.  The commands
# describe all of the packages defined by the files given as arguments.
# This procedure creates a package index in a given directory.  The
# package index consists of a "pkgIndex.tcl" file whose contents are
# a Tcl script that sets up package information with "package require"
# commands.  The commands describe all of the packages defined by the
# files given as arguments.
#
# Arguments:
# -direct		(optional) If this flag is present, the generated
#			code in pkgMkIndex.tcl will cause the package to be
#			loaded when "package require" is executed, rather
#			than lazily when the first reference to an exported
#			procedure in the package is made.
# -verbose		(optional) Verbose output; the name of each file that
#			was successfully rocessed is printed out. Additionally,
#			if processing of a file failed a message is printed.
# -load pat		(optional) Preload any packages whose names match
#			the pattern.  Used to handle DLLs that depend on
#			other packages during their Init procedure.
# dir -			Name of the directory in which to create the index.
# args -		Any number of additional arguments, each giving
#			a glob pattern that matches the names of one or
#			more shared libraries or Tcl script files in
#			dir.

proc pkg_mkIndex {args} {
    set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"}
    set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"};

    set argCount [llength $args]
    if {$argCount < 1} {
	return -code error "wrong # args: should be\n$usage"
    }

    set more ""
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
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







-
+



-
-
-
+
+
+
-
-
+




-
-
+
+







		break
	    }
	}
    }

    set dir [lindex $args $idx]
    set patternList [lrange $args [expr {$idx + 1}] end]
    if {![llength $patternList]} {
    if {[llength $patternList] == 0} {
	set patternList [list "*.tcl" "*[info sharedlibextension]"]
    }

    try {
	set fileList [glob -directory $dir -tails -types {r f} -- \
		{*}$patternList]
    if {[catch {
	    glob -directory $dir -tails -types {r f} -- {*}$patternList
    } fileList o]} {
    } on error {msg opt} {
	return -options $opt $msg
	return -options $o $fileList
    }
    foreach file $fileList {
	# For each file, figure out what commands and packages it provides.
	# To do this, create a child interpreter, load the file into the
	# interpreter, and get a list of the new commands and packages that
	# are defined.
	# interpreter, and get a list of the new commands and packages
	# that are defined.

	if {$file eq "pkgIndex.tcl"} {
	    continue
	}

	set c [interp create]

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
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







-
+





-
+

-
+

-
+
-

-
-
-
+
+
-








-
-
+
+




-
-
+
-
-
-
+
-





-
-
+
+







-
-
-
+
+
+




















-
-
-
+
+
+






-
+



-
-
-
+
+
+







	    }
	    if {![llength [info loaded]]} {
		tclLog "warning: no packages are currently loaded, nothing"
		tclLog "can possibly match '$loadPat'"
	    }
	}
	foreach pkg [info loaded] {
	    if {![string match -nocase $loadPat [lindex $pkg 1]]} {
	    if {! [string match -nocase $loadPat [lindex $pkg 1]]} {
		continue
	    }
	    if {$doVerbose} {
		tclLog "package [lindex $pkg 1] matches '$loadPat'"
	    }
	    try {
	    if {[catch {
		load [lindex $pkg 0] [lindex $pkg 1] $c
	    } on error err {
	    } err]} {
		if {$doVerbose} {
		    tclLog "warning: load [lindex $pkg 0]\
		    tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
			    [lindex $pkg 1]\nfailed with: $err"
		}
	    } on ok {} {
		if {$doVerbose} {
		    tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
	    } elseif {$doVerbose} {
		tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
		}
	    }
	    if {[lindex $pkg 1] eq "Tk"} {
		# Withdraw . if Tk was loaded, to avoid showing a window.
		$c eval [list wm withdraw .]
	    }
	}

	$c eval {
	    # Stub out the package command so packages can require other
	    # packages.
	    # Stub out the package command so packages can
	    # require other packages.

	    rename package __package_orig
	    proc package {what args} {
		switch -- $what {
		    require {
			return;		# Ignore transitive requires
		    require { return ; # ignore transitive requires }
		    }
		    default {
			__package_orig $what {*}$args
		    default { __package_orig $what {*}$args }
		    }
		}
	    }
	    proc tclPkgUnknown args {}
	    package unknown tclPkgUnknown

	    # Stub out the unknown command so package can call into each other
	    # during their initialilzation.
	    # Stub out the unknown command so package can call
	    # into each other during their initialilzation.

	    proc unknown {args} {}

	    # Stub out the auto_import mechanism

	    proc auto_import {args} {}

	    # reserve the ::tcl namespace for support procs and temporary
	    # variables.  This might make it awkward to generate a
	    # pkgIndex.tcl file for the ::tcl namespace.
	    # reserve the ::tcl namespace for support procs
	    # and temporary variables.  This might make it awkward
	    # to generate a pkgIndex.tcl file for the ::tcl namespace.

	    namespace eval ::tcl {
		variable dir		;# Current directory being processed
		variable file		;# Current file being processed
		variable direct		;# -direct flag value
		variable x		;# Loop variable
		variable debug		;# For debugging
		variable type		;# "load" or "source", for -direct
		variable namespaces	;# Existing namespaces (e.g., ::tcl)
		variable packages	;# Existing packages (e.g., Tcl)
		variable origCmds	;# Existing commands
		variable newCmds	;# Newly created commands
		variable newPkgs {}	;# Newly created packages
	    }
	}

	$c eval [list set ::tcl::dir $dir]
	$c eval [list set ::tcl::file $file]
	$c eval [list set ::tcl::direct $direct]

	# Download needed procedures into the child because we've just deleted
	# the unknown procedure.  This doesn't handle procedures with default
	# arguments.
	# Download needed procedures into the slave because we've
	# just deleted the unknown procedure.  This doesn't handle
	# procedures with default arguments.

	foreach p {::tcl::Pkg::CompareExtension} {
	    $c eval [list namespace eval [namespace qualifiers $p] {}]
	    $c eval [list proc $p [info args $p] [info body $p]]
	}

	try {
	if {[catch {
	    $c eval {
		set ::tcl::debug "loading or sourcing"

		# we need to track command defined by each package even in the
		# -direct case, because they are needed internally by the
		# "partial pkgIndex.tcl" step above.
		# we need to track command defined by each package even in
		# the -direct case, because they are needed internally by
		# the "partial pkgIndex.tcl" step above.

		proc ::tcl::GetAllNamespaces {{root ::}} {
		    set list $root
		    foreach ns [namespace children $root] {
			lappend list {*}[::tcl::GetAllNamespaces $ns]
		    }
		    return $list
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
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







-
-
-
-
-
+
+
+
+
+


-
-
-
-
+
+
+
+
+










-
-
-
-
-
+
+
+
+
+
+




-
+
















-
-
+
+
-














-
-
+
+









-
+




-
+








-
+







		foreach ::tcl::x [package names] {
		    if {[package provide $::tcl::x] ne ""} {
			set ::tcl::packages($::tcl::x) 1
		    }
		}
		set ::tcl::origCmds [info commands]

		# Try to load the file if it has the shared library extension,
		# otherwise source it.  It's important not to try to load
		# files that aren't shared libraries, because on some systems
		# (like SunOS) the loader will abort the whole application
		# when it gets an error.
		# Try to load the file if it has the shared library
		# extension, otherwise source it.  It's important not to
		# try to load files that aren't shared libraries, because
		# on some systems (like SunOS) the loader will abort the
		# whole application when it gets an error.

		if {[::tcl::Pkg::CompareExtension $::tcl::file [info sharedlibextension]]} {
		    # The "file join ." command below is necessary.  Without
		    # it, if the file name has no \'s and we're on UNIX, the
		    # load command will invoke the LD_LIBRARY_PATH search
		    # mechanism, which could cause the wrong file to be used.
		    # The "file join ." command below is necessary.
		    # Without it, if the file name has no \'s and we're
		    # on UNIX, the load command will invoke the
		    # LD_LIBRARY_PATH search mechanism, which could cause
		    # the wrong file to be used.

		    set ::tcl::debug loading
		    load [file join $::tcl::dir $::tcl::file]
		    set ::tcl::type load
		} else {
		    set ::tcl::debug sourcing
		    source [file join $::tcl::dir $::tcl::file]
		    set ::tcl::type source
		}

		# As a performance optimization, if we are creating direct
		# load packages, don't bother figuring out the set of commands
		# created by the new packages.  We only need that list for
		# setting up the autoloading used in the non-direct case.
		if {!$::tcl::direct} {
		# As a performance optimization, if we are creating
		# direct load packages, don't bother figuring out the
		# set of commands created by the new packages.  We
		# only need that list for setting up the autoloading
		# used in the non-direct case.
		if { !$::tcl::direct } {
		    # See what new namespaces appeared, and import commands
		    # from them.  Only exported commands go into the index.

		    foreach ::tcl::x [::tcl::GetAllNamespaces] {
			if {![info exists ::tcl::namespaces($::tcl::x)]} {
			if {! [info exists ::tcl::namespaces($::tcl::x)]} {
			    namespace import -force ${::tcl::x}::*
			}

			# Figure out what commands appeared

			foreach ::tcl::x [info commands] {
			    set ::tcl::newCmds($::tcl::x) 1
			}
			foreach ::tcl::x $::tcl::origCmds {
			    unset -nocomplain ::tcl::newCmds($::tcl::x)
			}
			foreach ::tcl::x [array names ::tcl::newCmds] {
			    # determine which namespace a command comes from

			    set ::tcl::abs [namespace origin $::tcl::x]

			    # special case so that global names have no
			    # leading ::, this is required by the unknown
			    # special case so that global names have no leading
			    # ::, this is required by the unknown command
			    # command

			    set ::tcl::abs \
				    [lindex [auto_qualify $::tcl::abs ::] 0]

			    if {$::tcl::x ne $::tcl::abs} {
				# Name changed during qualification

				set ::tcl::newCmds($::tcl::abs) 1
				unset ::tcl::newCmds($::tcl::x)
			    }
			}
		    }
		}

		# Look through the packages that appeared, and if there is a
		# version provided, then record it
		# Look through the packages that appeared, and if there is
		# a version provided, then record it

		foreach ::tcl::x [package names] {
		    if {[package provide $::tcl::x] ne ""
			    && ![info exists ::tcl::packages($::tcl::x)]} {
			lappend ::tcl::newPkgs \
			    [list $::tcl::x [package provide $::tcl::x]]
		    }
		}
	    }
	} on error msg {
	} msg] == 1} {
	    set what [$c eval set ::tcl::debug]
	    if {$doVerbose} {
		tclLog "warning: error while $what $file: $msg"
	    }
	} on ok {} {
	} else {
	    set what [$c eval set ::tcl::debug]
	    if {$doVerbose} {
		tclLog "successful $what of $file"
	    }
	    set type [$c eval set ::tcl::type]
	    set cmds [lsort [$c eval array names ::tcl::newCmds]]
	    set pkgs [$c eval set ::tcl::newPkgs]
	    if {$doVerbose} {
		if {!$direct} {
		if { !$direct } {
		    tclLog "commands provided were $cmds"
		}
		tclLog "packages provided were $pkgs"
	    }
	    if {[llength $pkgs] > 1} {
		tclLog "warning: \"$file\" provides more than one package ($pkgs)"
	    }
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
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







-
+









-





-
-
-
-
+
+
+
+
+








    foreach pkg [lsort [array names files]] {
	set cmd {}
	lassign $pkg name version
	lappend cmd ::tcl::Pkg::Create -name $name -version $version
	foreach spec [lsort -index 0 $files($pkg)] {
	    foreach {file type procs} $spec {
		if {$direct} {
		if { $direct } {
		    set procs {}
		}
		lappend cmd "-$type" [list $file $procs]
	    }
	}
	append index "\n[eval $cmd]"
    }

    set f [open [file join $dir pkgIndex.tcl] w]
    fconfigure $f -encoding utf-8 -translation lf
    puts $f $index
    close $f
}

# tclPkgSetup --
# This is a utility procedure use by pkgIndex.tcl files.  It is invoked as
# part of a "package ifneeded" script.  It calls "package provide" to indicate
# that a package is available, then sets entries in the auto_index array so
# that the package's files will be auto-loaded when the commands are used.
# This is a utility procedure use by pkgIndex.tcl files.  It is invoked
# as part of a "package ifneeded" script.  It calls "package provide"
# to indicate that a package is available, then sets entries in the
# auto_index array so that the package's files will be auto-loaded when
# the commands are used.
#
# Arguments:
# dir -			Directory containing all the files for this package.
# pkg -			Name of the package (no version number).
# version -		Version number for the package, such as 2.1.3.
# files -		List of files that constitute the package.  Each
#			element is a sub-list with three elements.  The first
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
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
611
612
613
614


615
616

617
618
619
620
621
622
623
624
625
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625





626
627
628
629
630
631
632
633
634
635
636
637







-
-
-
-
-
-
+
+
+
+
+
+












-
-
+
+











+
+
-
+
-
-
-
-
-





-
-
-
+
+
+
+


-
-
-
-
-
-
-
+
+
+
+










-
-
-
+
+
+
+


-
-
-
-
-
+
+

-
+







-
-
-
-
-
+
+
+
+
+
+











-
-
-
-
-
+
+
+
+
+










-
-
-
+
+
+








+









-
-
+
+












-




-
-
-
+
+
+
+


-
-
-
-
-
+
+

-
+






-
-
-
-
-
+
+
+
+
+
+











-
-
-
-
-
+
+
+
+
+







		set auto_index($cmd) [list source [file join $dir $f]]
	    }
	}
    }
}

# tclPkgUnknown --
# This procedure provides the default for the "package unknown" function.  It
# is invoked when a package that's needed can't be found.  It scans the
# auto_path directories and their immediate children looking for pkgIndex.tcl
# files and sources any such files that are found to setup the package
# database. As it searches, it will recognize changes to the auto_path and
# scan any new directories.
# This procedure provides the default for the "package unknown" function.
# It is invoked when a package that's needed can't be found.  It scans
# the auto_path directories and their immediate children looking for
# pkgIndex.tcl files and sources any such files that are found to setup
# the package database. As it searches, it will recognize changes
# to the auto_path and scan any new directories.
#
# Arguments:
# name -		Name of desired package.  Not used.
# version -		Version of desired package.  Not used.
# exact -		Either "-exact" or omitted.  Not used.

proc tclPkgUnknown {name args} {
    global auto_path env

    if {![info exists auto_path]} {
	return
    }
    # Cache the auto_path, because it may change while we run through the
    # first set of pkgIndex.tcl files
    # Cache the auto_path, because it may change while we run through
    # the first set of pkgIndex.tcl files
    set old_path [set use_path $auto_path]
    while {[llength $use_path]} {
	set dir [lindex $use_path end]

	# Make sure we only scan each directory one time.
	if {[info exists tclSeenPath($dir)]} {
	    set use_path [lrange $use_path 0 end-1]
	    continue
	}
	set tclSeenPath($dir) 1

	# we can't use glob in safe interps, so enclose the following
	# in a catch statement, where we get the pkgIndex files out
	# Get the pkgIndex.tcl files in subdirectories of auto_path directories.
	# of the subdirectories
	# - Safe Base interpreters have a restricted "glob" command that
	#   works in this case.
	# - The "catch" was essential when there was no safe glob and every
	#   call in a safe interp failed; it is retained only for corner
	#   cases in which the eventual call to glob returns an error.
	catch {
	    foreach file [glob -directory $dir -join -nocomplain \
		    * pkgIndex.tcl] {
		set dir [file dirname $file]
		if {![info exists procdDirs($dir)]} {
		    try {
			::tcl::Pkg::source $file
		    } trap {POSIX EACCES} {} {
		    set code [catch {source $file} msg opt]
		    if {$code == 1 &&
			    [lindex [dict get $opt -errorcode] 0] eq "POSIX" &&
			    [lindex [dict get $opt -errorcode] 1] eq "EACCES"} {
			# $file was not readable; silently ignore
			continue
		    } on error msg {
			if {[regexp {version conflict for package} $msg]} {
			    # In case of version conflict, silently ignore
			    continue
			}
    			tclLog "error reading package index file $file: $msg"
		    } on ok {} {
		    }
		    if {$code} {
			tclLog "error reading package index file $file: $msg"
		    } else {
			set procdDirs($dir) 1
		    }
		}
	    }
	}
	set dir [lindex $use_path end]
	if {![info exists procdDirs($dir)]} {
	    set file [file join $dir pkgIndex.tcl]
	    # safe interps usually don't have "file exists",
	    if {([interp issafe] || [file exists $file])} {
		try {
		    ::tcl::Pkg::source $file
		} trap {POSIX EACCES} {} {
		set code [catch {source $file} msg opt]
		if {$code == 1 &&
			[lindex [dict get $opt -errorcode] 0] eq "POSIX" &&
			[lindex [dict get $opt -errorcode] 1] eq "EACCES"} {
		    # $file was not readable; silently ignore
		    continue
		} on error msg {
		    if {[regexp {version conflict for package} $msg]} {
			# In case of version conflict, silently ignore
			continue
		    }
		}
		if {$code}  {
		    tclLog "error reading package index file $file: $msg"
		} on ok {} {
		} else {
		    set procdDirs($dir) 1
		}
	    }
	}

	set use_path [lrange $use_path 0 end-1]

	# Check whether any of the index scripts we [source]d above set a new
	# value for $::auto_path.  If so, then find any new directories on the
	# $::auto_path, and lappend them to the $use_path we are working from.
	# This gives index scripts the (arguably unwise) power to expand the
	# index script search path while the search is in progress.
	# Check whether any of the index scripts we [source]d above
	# set a new value for $::auto_path.  If so, then find any
	# new directories on the $::auto_path, and lappend them to
	# the $use_path we are working from.  This gives index scripts
	# the (arguably unwise) power to expand the index script search
	# path while the search is in progress.
	set index 0
	if {[llength $old_path] == [llength $auto_path]} {
	    foreach dir $auto_path old $old_path {
		if {$dir ne $old} {
		    # This entry in $::auto_path has changed.
		    break
		}
		incr index
	    }
	}

	# $index now points to the first element of $auto_path that has
	# changed, or the beginning if $auto_path has changed length Scan the
	# new elements of $auto_path for directories to add to $use_path.
	# Don't add directories we've already seen, or ones already on the
	# $use_path.
	# $index now points to the first element of $auto_path that
	# has changed, or the beginning if $auto_path has changed length
	# Scan the new elements of $auto_path for directories to add to
	# $use_path.  Don't add directories we've already seen, or ones
	# already on the $use_path.
	foreach dir [lrange $auto_path $index end] {
	    if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} {
		lappend use_path $dir
	    }
	}
	set old_path $auto_path
    }
}

# tcl::MacOSXPkgUnknown --
# This procedure extends the "package unknown" function for MacOSX.  It scans
# the Resources/Scripts directories of the immediate children of the auto_path
# directories for pkgIndex files.
# This procedure extends the "package unknown" function for MacOSX.
# It scans the Resources/Scripts directories of the immediate children
# of the auto_path directories for pkgIndex files.
#
# Arguments:
# original -		original [package unknown] procedure
# name -		Name of desired package.  Not used.
# version -		Version of desired package.  Not used.
# exact -		Either "-exact" or omitted.  Not used.

proc tcl::MacOSXPkgUnknown {original name args} {

    #  First do the cross-platform default search
    uplevel 1 $original [linsert $args 0 $name]

    # Now do MacOSX specific searching
    global auto_path

    if {![info exists auto_path]} {
	return
    }
    # Cache the auto_path, because it may change while we run through the
    # first set of pkgIndex.tcl files
    # Cache the auto_path, because it may change while we run through
    # the first set of pkgIndex.tcl files
    set old_path [set use_path $auto_path]
    while {[llength $use_path]} {
	set dir [lindex $use_path end]

	# Make sure we only scan each directory one time.
	if {[info exists tclSeenPath($dir)]} {
	    set use_path [lrange $use_path 0 end-1]
	    continue
	}
	set tclSeenPath($dir) 1

	# get the pkgIndex files out of the subdirectories
	# Safe interpreters do not use tcl::MacOSXPkgUnknown - see init.tcl.
	foreach file [glob -directory $dir -join -nocomplain \
		* Resources Scripts pkgIndex.tcl] {
	    set dir [file dirname $file]
	    if {![info exists procdDirs($dir)]} {
		try {
		    ::tcl::Pkg::source $file
		} trap {POSIX EACCES} {} {
		set code [catch {source $file} msg opt]
		if {$code == 1 &&
			[lindex [dict get $opt -errorcode] 0] eq "POSIX" &&
			[lindex [dict get $opt -errorcode] 1] eq "EACCES"} {
		    # $file was not readable; silently ignore
		    continue
		} on error msg {
		    if {[regexp {version conflict for package} $msg]} {
		 	# In case of version conflict, silently ignore
			continue
		    }
		}
		if {$code} {
		    tclLog "error reading package index file $file: $msg"
		} on ok {} {
		} else {
		    set procdDirs($dir) 1
		}
	    }
	}
	set use_path [lrange $use_path 0 end-1]

	# Check whether any of the index scripts we [source]d above set a new
	# value for $::auto_path.  If so, then find any new directories on the
	# $::auto_path, and lappend them to the $use_path we are working from.
	# This gives index scripts the (arguably unwise) power to expand the
	# index script search path while the search is in progress.
	# Check whether any of the index scripts we [source]d above
	# set a new value for $::auto_path.  If so, then find any
	# new directories on the $::auto_path, and lappend them to
	# the $use_path we are working from.  This gives index scripts
	# the (arguably unwise) power to expand the index script search
	# path while the search is in progress.
	set index 0
	if {[llength $old_path] == [llength $auto_path]} {
	    foreach dir $auto_path old $old_path {
		if {$dir ne $old} {
		    # This entry in $::auto_path has changed.
		    break
		}
		incr index
	    }
	}

	# $index now points to the first element of $auto_path that has
	# changed, or the beginning if $auto_path has changed length Scan the
	# new elements of $auto_path for directories to add to $use_path.
	# Don't add directories we've already seen, or ones already on the
	# $use_path.
	# $index now points to the first element of $auto_path that
	# has changed, or the beginning if $auto_path has changed length
	# Scan the new elements of $auto_path for directories to add to
	# $use_path.  Don't add directories we've already seen, or ones
	# already on the $use_path.
	foreach dir [lrange $auto_path $index end] {
	    if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} {
		lappend use_path $dir
	    }
	}
	set old_path $auto_path
    }
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
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
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







-
-
-
-
-
-
+
+
+
+
+
+

















-
+













-
+






-
+











-
+


-
+



-
+







#			-load		{filename ?{procs}?}
#			...
#			-source		{filename ?{procs}?}
#			...
#
#			Any number of -load and -source parameters may be
#			specified, so long as there is at least one -load or
#			-source parameter.  If the procs component of a module
#			specifier is left off, that module will be set up for
#			direct loading; otherwise, it will be set up for lazy
#			loading.  If both -source and -load are specified, the
#			-load'ed files will be loaded first, followed by the
#			-source'd files.
#			-source parameter.  If the procs component of a
#			module specifier is left off, that module will be
#			set up for direct loading; otherwise, it will be
#			set up for lazy loading.  If both -source and -load
#			are specified, the -load'ed files will be loaded
#			first, followed by the -source'd files.
#
# Results:
#	An appropriate "package ifneeded" statement for the package.

proc ::tcl::Pkg::Create {args} {
    append err(usage) "[lindex [info level 0] 0] "
    append err(usage) "-name packageName -version packageVersion"
    append err(usage) "?-load {filename ?{procs}?}? ... "
    append err(usage) "?-source {filename ?{procs}?}? ..."

    set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
    set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
    set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""
    set err(noLoadOrSource) "at least one of -load and -source must be given"

    # process arguments
    set len [llength $args]
    if {$len < 6} {
    if { $len < 6 } {
	error $err(wrongNumArgs)
    }

    # Initialize parameters
    array set opts {-name {} -version {} -source {} -load {}}

    # process parameters
    for {set i 0} {$i < $len} {incr i} {
	set flag [lindex $args $i]
	incr i
	switch -glob -- $flag {
	    "-name"		-
	    "-version"		{
		if {$i >= $len} {
		if { $i >= $len } {
		    error [format $err(valueMissing) $flag]
		}
		set opts($flag) [lindex $args $i]
	    }
	    "-source"		-
	    "-load"		{
		if {$i >= $len} {
		if { $i >= $len } {
		    error [format $err(valueMissing) $flag]
		}
		lappend opts($flag) [lindex $args $i]
	    }
	    default {
		error [format $err(unknownOpt) [lindex $args $i]]
	    }
	}
    }

    # Validate the parameters
    if {![llength $opts(-name)]} {
    if { [llength $opts(-name)] == 0 } {
	error [format $err(valueMissing) "-name"]
    }
    if {![llength $opts(-version)]} {
    if { [llength $opts(-version)] == 0 } {
	error [format $err(valueMissing) "-version"]
    }

    if {!([llength $opts(-source)] || [llength $opts(-load)])} {
    if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {
	error $err(noLoadOrSource)
    }

    # OK, now everything is good.  Generate the package ifneeded statment.
    set cmdline "package ifneeded $opts(-name) $opts(-version) "

    set cmdList {}
749
750
751
752
753
754
755
756

757
758
759
760
761
762
763
764
736
737
738
739
740
741
742

743
744
745
746
747
748
749
750
751







-
+








		lappend cmdList $cmd
	    } else {
		lappend lazyFileList [list $filename $key $proclist]
	    }
	}
    }

    if {[llength $lazyFileList]} {
    if { [llength $lazyFileList] > 0 } {
	lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
		$opts(-version) [list $lazyFileList]\]"
    }
    append cmdline [join $cmdList "\\n"]
    return $cmdline
}

interp alias {} ::pkg::create {} ::tcl::Pkg::Create

Changes to library/platform/pkgIndex.tcl.

1

2
3

1
2
3
-
+


package ifneeded platform        1.0.14 [list source [file join $dir platform.tcl]]
package ifneeded platform        1.0.18 [list source [file join $dir platform.tcl]]
package ifneeded platform::shell 1.1.4 [list source [file join $dir shell.tcl]]

Changes to library/platform/platform.tcl.

25
26
27
28
29
30
31

32
33

34
35
36
37
38
39
40
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42







+


+







# result.
#
# General
# Only the first element of 'os' is used - we don't care whether we
# are on "Windows NT" or "Windows XP" or whatever.
#
# Machine specific
# % amd64  -> x86_64
# % arm*   -> arm
# % sun4*  -> sparc
# % ia32*  -> ix86
# % intel  -> ix86
# % i*86*  -> ix86
# % Power* -> powerpc
# % x86_64 + wordSize 4 => x86 code
#
# OS specific
# % AIX are always powerpc machines
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
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







+









+














-
-
-







    set cpu  $tcl_platform(machine)

    switch -glob -- $cpu {
	sun4* {
	    set cpu sparc
	}
	intel -
	ia32* -
	i*86* {
	    set cpu ix86
	}
	x86_64 {
	    if {$tcl_platform(wordSize) == 4} {
		# See Example <1> at the top of this file.
		set cpu ix86
	    }
	}
	ppc -
	"Power*" {
	    set cpu powerpc
	}
	"arm*" {
	    set cpu arm
	}
	ia64 {
	    if {$tcl_platform(wordSize) == 4} {
		append cpu _32
	    }
	}
    }

    switch -glob -- $plat {
	cygwin* {
	    set plat cygwin
	}
	windows {
	    if {$tcl_platform(platform) == "unix"} {
		set plat cygwin
	    } else {
		set plat win32
	    }
	    if {$cpu eq "amd64"} {
145
146
147
148
149
150
151



152
153
154
155
156
157
158
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162







+
+
+







		    append cpu 64
		}
	    }
	}
	osf1 {
	    set plat tru64
	}
	default {
	    set plat [lindex [split $plat _-] 0]
	}
    }

    return "${plat}-${cpu}"
}

# -- platform::identify
#
171
172
173
174
175
176
177
178





179
180
181
182

183
184
185
186
187
188
189
175
176
177
178
179
180
181

182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198







-
+
+
+
+
+




+







	solaris {
	    regsub {^5} $tcl_platform(osVersion) 2 text
	    append plat $text
	    return "${plat}-${cpu}"
	}
	macosx {
	    set major [lindex [split $tcl_platform(osVersion) .] 0]
	    if {$major > 8} {
	    if {$major > 19} {
		set minor [lindex [split $tcl_platform(osVersion) .] 1]
		incr major -9
		append plat $major.[expr {$minor - 1}]
	    } else {
		incr major -4
		append plat 10.$major
		return "${plat}-${cpu}"
	    }
	    return "${plat}-${cpu}"
	}
	linux {
	    # Look for the libc*.so and determine its version
	    # (libc5/6, libc6 further glibc 2.X)

	    set v unknown

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
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







-
+







-
+
+
+
+
+
+
+
+
+
+






-

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+
+







	macosx-x86_64 {
	    lappend res macosx-i386-x86_64
	}
	macosx-ix86 {
	    lappend res macosx-universal macosx-i386-x86_64
	}
	macosx*-*    {
	    # 10.5+
	    # 10.5+,11.0+
	    if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {

		switch -exact -- $cpu {
		    ix86    {
			lappend alt i386-x86_64
			lappend alt universal
		    }
		    x86_64  { lappend alt i386-x86_64 }
		    x86_64  {
			if {[lindex [split $::tcl_platform(osVersion) .] 0] < 19} {
			    set alt i386-x86_64
			} else {
			    set alt {}
			}
		    }
		    arm  {
			lappend alt x86_64
		    }
		    default { set alt {} }
		}

		if {$v ne ""} {
		    foreach {major minor} [split $v .] break

		    # Add 10.5 to 10.minor to patterns.
		    set res {}
		    if {$major eq 12} {
			# Add 12.0 to 12.minor to patterns.
			for {set j $minor} {$j >= 0} {incr j -1} {
			    lappend res macosx${major}.${j}-${cpu}
			    foreach a $alt {
				lappend res macosx${major}.${j}-$a
			    }
			}
			set major 11
			set minor 5
		    }
		    if {$major eq 11} {
			# Add 11.0 to 11.minor to patterns.
			for {set j $minor} {$j >= 0} {incr j -1} {
			    lappend res macosx${major}.${j}-${cpu}
			    foreach a $alt {
				lappend res macosx${major}.${j}-$a
			    }
			}
			set major 10
			set minor 15
		    }
		    # Add 10.5 to 10.minor to patterns.
		    for {set j $minor} {$j >= 5} {incr j -1} {
			if {$cpu ne "arm"} {
			lappend res macosx${major}.${j}-${cpu}
			    lappend res macosx${major}.${j}-${cpu}
			}
			foreach a $alt {
			    lappend res macosx${major}.${j}-$a
			}
		    }

		    # Add unversioned patterns for 10.3/10.4 builds.
		    lappend res macosx-${cpu}
374
375
376
377
378
379
380
381

382
383
384
385
386
387
388
416
417
418
419
420
421
422

423
424
425
426
427
428
429
430







-
+







    return $res
}


# ### ### ### ######### ######### #########
## Ready

package provide platform 1.0.14
package provide platform 1.0.18

# ### ### ### ######### ######### #########
## Demo application

if {[info exists argv0] && ($argv0 eq [info script])} {
    puts ====================================
    parray tcl_platform

Changes to library/reg/pkgIndex.tcl.

1

2

3
4







1
2
3


4
5
6
7
8
9
-
+

+
-
-
+
+
+
+
+
+
if {![package vsatisfies [package provide Tcl] 8.5-]} return
if {![package vsatisfies [package provide Tcl] 8.5]} return
if {[info sharedlibextension] != ".dll"} return
if {[::tcl::pkgconfig get debug]} {
package ifneeded registry 1.3.5 \
        [list load [file join $dir tclreg13.dll] registry]
    package ifneeded registry 1.3.5 \
            [list load [file join $dir tclreg13g.dll] Registry]
} else {
    package ifneeded registry 1.3.5 \
            [list load [file join $dir tclreg13.dll] Registry]
}

Changes to library/safe.tcl.

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
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




-
-
+
+
















-
+







# safe.tcl --
#
# This file provide a safe loading/sourcing mechanism for safe interpreters.
# It implements a virtual path mecanism to hide the real pathnames from the
# child. It runs in a parent interpreter and sets up data structure and
# aliases that will be invoked when used from a child interpreter.
# slave. It runs in a master interpreter and sets up data structure and
# aliases that will be invoked when used from a slave interpreter.
#
# See the safe.n man page for details.
#
# Copyright (c) 1996-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.

#
# The implementation is based on namespaces. These naming conventions are
# followed:
# Private procs starts with uppercase.
# Public  procs are exported and starts with lowercase
#

# Needed utilities package
package require opt 0.4.8
package require opt 0.4.1

# Create the safe namespace
namespace eval ::safe {
    # Exported API:
    namespace export interpCreate interpInit interpConfigure interpDelete \
	interpAddToAccessPath interpFindInAccessPath setLogCmd
}
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
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







-
-
+





-
-
+
+

-
-
+



-
-
-
-
+
+
+
+

-
+















-
+





-
+


-
-
+
+





-
+




-
+










-
-
+
+




-
-
+
-
-
+
-
-
-
+
-
-
-
-
+
-







#  API entry points that needs argument parsing :
#
####

# Interface/entry point function and front end for "Create"
proc ::safe::interpCreate {args} {
    set Args [::tcl::OptKeyParse ::safe::interpCreate $args]
    RejectExcessColons $child
    InterpCreate $child $accessPath \
    InterpCreate $slave $accessPath \
	[InterpStatics] [InterpNested] $deleteHook
}

proc ::safe::interpInit {args} {
    set Args [::tcl::OptKeyParse ::safe::interpIC $args]
    if {![::interp exists $child]} {
	return -code error "\"$child\" is not an interpreter"
    if {![::interp exists $slave]} {
	return -code error "\"$slave\" is not an interpreter"
    }
    RejectExcessColons $child
    InterpInit $child $accessPath \
    InterpInit $slave $accessPath \
	[InterpStatics] [InterpNested] $deleteHook
}

# Check that the given child is "one of us"
proc ::safe::CheckInterp {child} {
    namespace upvar ::safe [VarName $child] state
    if {![info exists state] || ![::interp exists $child]} {
# Check that the given slave is "one of us"
proc ::safe::CheckInterp {slave} {
    namespace upvar ::safe S$slave state
    if {![info exists state] || ![::interp exists $slave]} {
	return -code error \
	    "\"$child\" is not an interpreter managed by ::safe::"
	    "\"$slave\" is not an interpreter managed by ::safe::"
    }
}

# Interface/entry point function and front end for "Configure".  This code
# is awfully pedestrian because it would need more coupling and support
# between the way we store the configuration values in safe::interp's and
# the Opt package. Obviously we would like an OptConfigure to avoid
# duplicating all this code everywhere.
# -> TODO (the app should share or access easily the program/value stored
# by opt)

# This is even more complicated by the boolean flags with no values that
# we had the bad idea to support for the sake of user simplicity in
# create/init but which makes life hard in configure...
# So this will be hopefully written and some integrated with opt1.0
# (hopefully for tcl9.0 ?)
# (hopefully for tcl8.1 ?)
proc ::safe::interpConfigure {args} {
    switch [llength $args] {
	1 {
	    # If we have exactly 1 argument the semantic is to return all
	    # the current configuration. We still call OptKeyParse though
	    # we know that "child" is our given argument because it also
	    # we know that "slave" is our given argument because it also
	    # checks for the "-help" option.
	    set Args [::tcl::OptKeyParse ::safe::interpIC $args]
	    CheckInterp $child
	    namespace upvar ::safe [VarName $child] state
	    CheckInterp $slave
	    namespace upvar ::safe S$slave state

	    return [join [list \
		[list -accessPath $state(access_path)] \
		[list -statics    $state(staticsok)]   \
		[list -nested     $state(nestedok)]    \
	        [list -deleteHook $state(cleanupHook)]]]
		[list -deleteHook $state(cleanupHook)]]]
	}
	2 {
	    # If we have exactly 2 arguments the semantic is a "configure
	    # get"
	    lassign $args child arg
	    lassign $args slave arg

	    # get the flag sub program (we 'know' about Opt's internal
	    # representation of data)
	    set desc [lindex [::tcl::OptKeyGetDesc ::safe::interpIC] 2]
	    set hits [::tcl::OptHits desc $arg]
	    if {$hits > 1} {
		return -code error [::tcl::OptAmbigous $desc $arg]
	    } elseif {$hits == 0} {
		return -code error [::tcl::OptFlagUsage $desc $arg]
	    }
	    CheckInterp $child
	    namespace upvar ::safe [VarName $child] state
	    CheckInterp $slave
	    namespace upvar ::safe S$slave state

	    set item [::tcl::OptCurDesc $desc]
	    set name [::tcl::OptName $item]
	    switch -exact -- $name {
		-accessPath {
		    return [list -accessPath $state(access_path)]
		-accessPath {return [list -accessPath $state(access_path)]}
		}
		-statics    {
		-statics    {return [list -statics    $state(staticsok)]}
		    return [list -statics $state(staticsok)]
		}
		-nested     {
		-nested     {return [list -nested     $state(nestedok)]}
		    return [list -nested $state(nestedok)]
		}
		-deleteHook {
		    return [list -deleteHook $state(cleanupHook)]
		-deleteHook {return [list -deleteHook $state(cleanupHook)]}
		}
		-noStatics {
		    # it is most probably a set in fact but we would need
		    # then to jump to the set part and it is not *sure*
		    # that it is a set action that the user want, so force
		    # it to use the unambigous -statics ?value? instead:
		    return -code error\
			"ambigous query (get or set -noStatics ?)\
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

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
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
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
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
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
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







-
-
+
+




-
+


-
+




-
+







-
+








-
-
+
+

-
-
+
+

-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
+

-
+


-
+


-
+

-
+







-
+





-
+
-
-
-
-
+
+

-
-
+
+

-
+

-
-
+
+




-
-
+
+

-
-
+
+


-
+









-
+


-
-
+
+





-
-
+
+



-
+




-
+


-
+





-
+



-
+


-
+




-
+







-








-
-
-
-
-
-





-
+



-
-
-
-
-
+
-










-






-
-
+
+




-
+
-







-
+
-
-
+


-
+









-
+


-
-
+









-
+




-
+







-
+






-
+




-
-
+
+




-
+




+



-
+


-
-
-
-
-
-
-
-
+


-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
-
-
-

-
+

-
+


-
+

-
-
-
+
+
+


-
+

-
-
-
+
+
+




-
-
-
-
+
+
+
+

-
+







		}
	    }
	}
	default {
	    # Otherwise we want to parse the arguments like init and
	    # create did
	    set Args [::tcl::OptKeyParse ::safe::interpIC $args]
	    CheckInterp $child
	    namespace upvar ::safe [VarName $child] state
	    CheckInterp $slave
	    namespace upvar ::safe S$slave state

	    # Get the current (and not the default) values of whatever has
	    # not been given:
	    if {![::tcl::OptProcArgGiven -accessPath]} {
		set doreset 0
		set doreset 1
		set accessPath $state(access_path)
	    } else {
		set doreset 1
		set doreset 0
	    }
	    if {
		![::tcl::OptProcArgGiven -statics]
		&& ![::tcl::OptProcArgGiven -noStatics]
	    } then {
	    } {
		set statics    $state(staticsok)
	    } else {
		set statics    [InterpStatics]
	    }
	    if {
		[::tcl::OptProcArgGiven -nested] ||
		[::tcl::OptProcArgGiven -nestedLoadOk]
	    } then {
	    } {
		set nested     [InterpNested]
	    } else {
		set nested     $state(nestedok)
	    }
	    if {![::tcl::OptProcArgGiven -deleteHook]} {
		set deleteHook $state(cleanupHook)
	    }
	    # we can now reconfigure :
	    InterpSetConfig $child $accessPath $statics $nested $deleteHook
	    # auto_reset the child (to completly synch the new access_path)
	    InterpSetConfig $slave $accessPath $statics $nested $deleteHook
	    # auto_reset the slave (to completly synch the new access_path)
	    if {$doreset} {
		if {[catch {::interp eval $child {auto_reset}} msg]} {
		    Log $child "auto_reset failed: $msg"
		if {[catch {::interp eval $slave {auto_reset}} msg]} {
		    Log $slave "auto_reset failed: $msg"
		} else {
		    Log $child "successful auto_reset" NOTICE
		    Log $slave "successful auto_reset" NOTICE
		}

	    }
		# Sync the paths used to search for Tcl modules.
		::interp eval $child {tcl::tm::path remove {*}[tcl::tm::list]}
		if {[llength $state(tm_path_child)] > 0} {
		    ::interp eval $child [list \
			    ::tcl::tm::add {*}[lreverse $state(tm_path_child)]]
		}

		# Remove stale "package ifneeded" data for non-loaded packages.
		# - Not for loaded packages, because "package forget" erases
		#   data from "package provide" as well as "package ifneeded".
		# - This is OK because the script cannot reload any version of
		#   the package unless it first does "package forget".
		foreach pkg [::interp eval $child {package names}] {
		    if {[::interp eval $child [list package provide $pkg]] eq ""} {
			::interp eval $child [list package forget $pkg]
		    }
		}
	    }
	    return
	}
    }
}

####
#
#  Functions that actually implements the exported APIs
#
####

#
# safe::InterpCreate : doing the real job
#
# This procedure creates a safe interpreter and initializes it with the safe
# This procedure creates a safe slave and initializes it with the safe
# base aliases.
# NB: child name must be simple alphanumeric string, no spaces, no (), no
# NB: slave name must be simple alphanumeric string, no spaces, no (), no
# {},...  {because the state array is stored as part of the name}
#
# Returns the child name.
# Returns the slave name.
#
# Optional Arguments :
# + child name : if empty, generated name will be used
# + slave name : if empty, generated name will be used
# + access_path: path list controlling where load/source can occur,
#                if empty: the parent auto_path will be used.
#                if empty: the master auto_path will be used.
# + staticsok  : flag, if 0 :no static package can be loaded (load {} Xxx)
#                      if 1 :static packages are ok.
# + nestedok: flag, if 0 :no loading to sub-sub interps (load xx xx sub)
#                      if 1 : multiple levels are ok.

# use the full name and no indent so auto_mkIndex can find us
proc ::safe::InterpCreate {
			   child
			   slave
			   access_path
			   staticsok
			   nestedok
			   deletehook
		       } {
    # Create the child.
    # Create the slave.
    # If evaluated in ::safe, the interpreter command for foo is ::foo;
    # but for foo::bar is safe::foo::bar.  So evaluate in :: instead.
    if {$child ne ""} {
	namespace eval :: [list ::interp create -safe $child]
    if {$slave ne ""} {
	::interp create -safe $slave
    } else {
	# empty argument: generate child name
	set child [::interp create -safe]
	# empty argument: generate slave name
	set slave [::interp create -safe]
    }
    Log $child "Created" NOTICE
    Log $slave "Created" NOTICE

    # Initialize it. (returns child name)
    InterpInit $child $access_path $staticsok $nestedok $deletehook
    # Initialize it. (returns slave name)
    InterpInit $slave $access_path $staticsok $nestedok $deletehook
}

#
# InterpSetConfig (was setAccessPath) :
#    Sets up child virtual auto_path and corresponding structure within
#    the parent. Also sets the tcl_library in the child to be the first
#    Sets up slave virtual auto_path and corresponding structure within
#    the master. Also sets the tcl_library in the slave to be the first
#    directory in the path.
#    NB: If you change the path after the child has been initialized you
#    probably need to call "auto_reset" in the child in order that it gets
#    NB: If you change the path after the slave has been initialized you
#    probably need to call "auto_reset" in the slave in order that it gets
#    the right auto_index() array values.

proc ::safe::InterpSetConfig {child access_path staticsok nestedok deletehook} {
proc ::safe::InterpSetConfig {slave access_path staticsok nestedok deletehook} {
    global auto_path

    # determine and store the access path if empty
    if {$access_path eq ""} {
	set access_path $auto_path

	# Make sure that tcl_library is in auto_path and at the first
	# position (needed by setAccessPath)
	set where [lsearch -exact $access_path [info library]]
	if {$where < 0} {
	if {$where == -1} {
	    # not found, add it.
	    set access_path [linsert $access_path 0 [info library]]
	    Log $child "tcl_library was not in auto_path,\
			added it to child's access_path" NOTICE
	    Log $slave "tcl_library was not in auto_path,\
			added it to slave's access_path" NOTICE
	} elseif {$where != 0} {
	    # not first, move it first
	    set access_path [linsert \
				 [lreplace $access_path $where $where] \
				 0 [info library]]
	    Log $child "tcl_libray was not in first in auto_path,\
			moved it to front of child's access_path" NOTICE
	    Log $slave "tcl_libray was not in first in auto_path,\
			moved it to front of slave's access_path" NOTICE
	}

	# Add 1st level sub dirs (will searched by auto loading from tcl
	# code in the child using glob and thus fail, so we add them here
	# code in the slave using glob and thus fail, so we add them here
	# so by default it works the same).
	set access_path [AddSubDirs $access_path]
    }

    Log $child "Setting accessPath=($access_path) staticsok=$staticsok\
    Log $slave "Setting accessPath=($access_path) staticsok=$staticsok\
		nestedok=$nestedok deletehook=($deletehook)" NOTICE

    namespace upvar ::safe [VarName $child] state
    namespace upvar ::safe S$slave state

    # clear old autopath if it existed
    # build new one
    # Extend the access list with the paths used to look for Tcl Modules.
    # We save the virtual form separately as well, as syncing it with the
    # child has to be defered until the necessary commands are present for
    # slave has to be defered until the necessary commands are present for
    # setup.

    set norm_access_path  {}
    set child_access_path {}
    set slave_access_path {}
    set map_access_path   {}
    set remap_access_path {}
    set child_tm_path     {}
    set slave_tm_path     {}

    set i 0
    foreach dir $access_path {
	set token [PathToken $i]
	lappend child_access_path  $token
	lappend slave_access_path  $token
	lappend map_access_path    $token $dir
	lappend remap_access_path  $dir $token
	lappend norm_access_path   [file normalize $dir]
	incr i
    }

    set morepaths [::tcl::tm::list]
    set firstpass 1
    while {[llength $morepaths]} {
	set addpaths $morepaths
	set morepaths {}

	foreach dir $addpaths {
	    # Prevent the addition of dirs on the tm list to the
	    # result if they are already known.
	    if {[dict exists $remap_access_path $dir]} {
	        if {$firstpass} {
		    # $dir is in [::tcl::tm::list] and belongs in the child_tm_path.
		    # Later passes handle subdirectories, which belong in the
		    # access path but not in the module path.
		    lappend child_tm_path  [dict get $remap_access_path $dir]
		}
		continue
	    }

	    set token [PathToken $i]
	    lappend access_path        $dir
	    lappend child_access_path  $token
	    lappend slave_access_path  $token
	    lappend map_access_path    $token $dir
	    lappend remap_access_path  $dir $token
	    lappend norm_access_path   [file normalize $dir]
	    if {$firstpass} {
		# $dir is in [::tcl::tm::list] and belongs in the child_tm_path.
		# Later passes handle subdirectories, which belong in the
		# access path but not in the module path.
		lappend child_tm_path  $token
	    lappend slave_tm_path $token
	    }
	    incr i

	    # [Bug 2854929]
	    # Recursively find deeper paths which may contain
	    # modules. Required to handle modules with names like
	    # 'platform::shell', which translate into
	    # 'platform/shell-X.tm', i.e arbitrarily deep
	    # subdirectories.
	    lappend morepaths {*}[glob -nocomplain -directory $dir -type d *]
	}
	set firstpass 0
    }

    set state(access_path)       $access_path
    set state(access_path,map)   $map_access_path
    set state(access_path,remap) $remap_access_path
    set state(access_path,norm)  $norm_access_path
    set state(access_path,child) $child_access_path
    set state(tm_path_child)     $child_tm_path
    set state(access_path,slave) $slave_access_path
    set state(tm_path_slave)     $slave_tm_path
    set state(staticsok)         $staticsok
    set state(nestedok)          $nestedok
    set state(cleanupHook)       $deletehook

    SyncAccessPath $child
    SyncAccessPath $slave
    return
}

#
#
# FindInAccessPath:
#    Search for a real directory and returns its virtual Id (including the
#    "$")
proc ::safe::interpFindInAccessPath {child path} {
proc ::safe::interpFindInAccessPath {slave path} {
    CheckInterp $child
    namespace upvar ::safe [VarName $child] state
    namespace upvar ::safe S$slave state

    if {![dict exists $state(access_path,remap) $path]} {
	return -code error "$path not found in access path"
	return -code error "$path not found in access path $access_path"
    }

    return [dict get $state(access_path,remap) $path]
}

#
# addToAccessPath:
#    add (if needed) a real directory to access path and return its
#    virtual token (including the "$").
proc ::safe::interpAddToAccessPath {child path} {
proc ::safe::interpAddToAccessPath {slave path} {
    # first check if the directory is already in there
    # (inlined interpFindInAccessPath).
    CheckInterp $child
    namespace upvar ::safe [VarName $child] state
    namespace upvar ::safe S$slave state

    if {[dict exists $state(access_path,remap) $path]} {
	return [dict get $state(access_path,remap) $path]
    }

    # new one, add it:
    set token [PathToken [llength $state(access_path)]]

    lappend state(access_path)       $path
    lappend state(access_path,child) $token
    lappend state(access_path,slave) $token
    lappend state(access_path,map)   $token $path
    lappend state(access_path,remap) $path $token
    lappend state(access_path,norm)  [file normalize $path]

    SyncAccessPath $child
    SyncAccessPath $slave
    return $token
}

# This procedure applies the initializations to an already existing
# interpreter. It is useful when you want to install the safe base aliases
# into a preexisting safe interpreter.
proc ::safe::InterpInit {
			 child
			 slave
			 access_path
			 staticsok
			 nestedok
			 deletehook
		     } {
    # Configure will generate an access_path when access_path is empty.
    InterpSetConfig $child $access_path $staticsok $nestedok $deletehook
    InterpSetConfig $slave $access_path $staticsok $nestedok $deletehook

    # NB we need to add [namespace current], aliases are always absolute
    # paths.

    # These aliases let the child load files to define new commands
    # This alias lets the child use the encoding names, convertfrom,
    # These aliases let the slave load files to define new commands
    # This alias lets the slave use the encoding names, convertfrom,
    # convertto, and system, but not "encoding system <name>" to set the
    # system encoding.
    # Handling Tcl Modules, we need a restricted form of Glob.
    # This alias interposes on the 'exit' command and cleanly terminates
    # the child.
    # the slave.

    foreach {command alias} {
	source   AliasSource
	load     AliasLoad
	encoding AliasEncoding
	exit     interpDelete
	glob     AliasGlob
    } {
	::interp alias $child $command {} [namespace current]::$alias $child
	::interp alias $slave $command {} [namespace current]::$alias $slave
    }

    # UGLY POINT! These commands are safe (they're ensembles with unsafe
    # subcommands), but is assumed to not be by existing policies so it is
    # hidden by default. Hack it...
    foreach command {encoding file} {
	::interp alias $child $command {} interp invokehidden $child $command
    }

    # This alias lets the child have access to a subset of the 'file'
    # This alias lets the slave have access to a subset of the 'file'
    # command functionality.

    foreach subcommand {dirname extension rootname tail} {
	::interp alias $child ::tcl::file::$subcommand {} \
	    ::safe::AliasFileSubcommand $child $subcommand
    }

    # Subcommand of 'encoding' that has special handling; [encoding system] is
    AliasSubset $slave file \
	file  dir.* join root.* ext.* tail path.* split

    # Subcommands of info
    foreach {subcommand alias} {
    # OK provided it has no other arguments passed to it.
    ::interp alias $child ::tcl::encoding::system {} \
	::safe::AliasEncodingSystem $child

	nameofexecutable   AliasExeName
    } {
	::interp alias $slave ::tcl::info::$subcommand \
	    {} [namespace current]::$alias $slave
    }
    # Subcommands of info
    ::interp alias $child ::tcl::info::nameofexecutable {} \
	::safe::AliasExeName $child

    # The allowed child variables already have been set by Tcl_MakeSafe(3)
    # The allowed slave variables already have been set by Tcl_MakeSafe(3)

    # Source init.tcl and tm.tcl into the child, to get auto_load and
    # Source init.tcl and tm.tcl into the slave, to get auto_load and
    # other procedures defined:

    if {[catch {::interp eval $child {
    if {[catch {::interp eval $slave {
	source [file join $tcl_library init.tcl]
    }} msg opt]} {
	Log $child "can't source init.tcl ($msg)"
	return -options $opt "can't source init.tcl into child $child ($msg)"
    }} msg]} {
	Log $slave "can't source init.tcl ($msg)"
	return -code error "can't source init.tcl into slave $slave ($msg)"
    }

    if {[catch {::interp eval $child {
    if {[catch {::interp eval $slave {
	source [file join $tcl_library tm.tcl]
    }} msg opt]} {
	Log $child "can't source tm.tcl ($msg)"
	return -options $opt "can't source tm.tcl into child $child ($msg)"
    }} msg]} {
	Log $slave "can't source tm.tcl ($msg)"
	return -code error "can't source tm.tcl into slave $slave ($msg)"
    }

    # Sync the paths used to search for Tcl modules. This can be done only
    # now, after tm.tcl was loaded.
    namespace upvar ::safe [VarName $child] state
    if {[llength $state(tm_path_child)] > 0} {
	::interp eval $child [list \
		::tcl::tm::add {*}[lreverse $state(tm_path_child)]]
    namespace upvar ::safe S$slave state
    if {[llength $state(tm_path_slave)] > 0} {
	::interp eval $slave [list \
		::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
    }
    return $child
    return $slave
}

# Add (only if needed, avoid duplicates) 1 level of sub directories to an
# existing path list.  Also removes non directories from the returned
# list.
proc ::safe::AddSubDirs {pathList} {
    set res {}
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
618
619
620

621
622
623
624
625
626
627
628
629
630
631



632
633
634
635
636
637
638
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







-
-
+
+
-
-
-

-
-
+
+

-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
+









-
-
-
-
+
+
+
+




-
+








-
-
-
+
+
+







		}
	    }
	}
    }
    return $res
}

# This procedure deletes a safe interpreter managed by Safe Tcl and cleans up
# associated state.
# This procedure deletes a safe slave managed by Safe Tcl and cleans up
# associated state:
# - The command will also delete non-Safe-Base interpreters.
# - This is regrettable, but to avoid breaking existing code this should be
#   amended at the next major revision by uncommenting "CheckInterp".

proc ::safe::interpDelete {child} {
    Log $child "About to delete" NOTICE
proc ::safe::interpDelete {slave} {
    Log $slave "About to delete" NOTICE

    # CheckInterp $child
    namespace upvar ::safe [VarName $child] state
    namespace upvar ::safe S$slave state

    # When an interpreter is deleted with [interp delete], any sub-interpreters
    # are deleted automatically, but this leaves behind their data in the Safe
    # Base. To clean up properly, we call safe::interpDelete recursively on each
    # Safe Base sub-interpreter, so each one is deleted cleanly and not by
    # the automatic mechanism built into [interp delete].
    foreach sub [interp children $child] {
        if {[info exists ::safe::[VarName [list $child $sub]]]} {
            ::safe::interpDelete [list $child $sub]
        }
    }

    # If the child has a cleanup hook registered, call it.  Check the
    # If the slave has a cleanup hook registered, call it.  Check the
    # existance because we might be called to delete an interp which has
    # not been registered with us at all

    if {[info exists state(cleanupHook)]} {
	set hook $state(cleanupHook)
	if {[llength $hook]} {
	    # remove the hook now, otherwise if the hook calls us somehow,
	    # we'll loop
	    unset state(cleanupHook)
	    try {
		{*}$hook $child
	    } on error err {
		Log $child "Delete hook error ($err)"
	    if {[catch {
		{*}$hook $slave
	    } err]} {
		Log $slave "Delete hook error ($err)"
	    }
	}
    }

    # Discard the global array of state associated with the child, and
    # Discard the global array of state associated with the slave, and
    # delete the interpreter.

    if {[info exists state]} {
	unset state
    }

    # if we have been called twice, the interp might have been deleted
    # already
    if {[::interp exists $child]} {
	::interp delete $child
	Log $child "Deleted" NOTICE
    if {[::interp exists $slave]} {
	::interp delete $slave
	Log $slave "Deleted" NOTICE
    }

    return
}

# Set (or get) the logging mecanism

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


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
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
618
619
620
621
622
623
624
625
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







-
+

-
+








-
+


-
-
+
+

-
-
+
+

-
+






-
-
+
+












-
-
+
+














-
+
















-
-
-
-
-
-
-
-
-
-
-

-
-
-
+
+







    if {$Log eq ""} {
	# Disable logging completely. Calls to it will be compiled out
	# of all users.
	proc ::safe::Log {args} {}
    } else {
	# Activate logging, define proper command.

	proc ::safe::Log {child msg {type ERROR}} {
	proc ::safe::Log {slave msg {type ERROR}} {
	    variable Log
	    {*}$Log "$type for child $child : $msg"
	    {*}$Log "$type for slave $slave : $msg"
	    return
	}
    }
}

# ------------------- END OF PUBLIC METHODS ------------

#
# Sets the child auto_path to the parent recorded value.  Also sets
# Sets the slave auto_path to the master recorded value.  Also sets
# tcl_library to the first token of the virtual path.
#
proc ::safe::SyncAccessPath {child} {
    namespace upvar ::safe [VarName $child] state
proc ::safe::SyncAccessPath {slave} {
    namespace upvar ::safe S$slave state

    set child_access_path $state(access_path,child)
    ::interp eval $child [list set auto_path $child_access_path]
    set slave_access_path $state(access_path,slave)
    ::interp eval $slave [list set auto_path $slave_access_path]

    Log $child "auto_path in $child has been set to $child_access_path"\
    Log $slave "auto_path in $slave has been set to $slave_access_path"\
	NOTICE

    # This code assumes that info library is the first element in the
    # list of auto_path's. See -> InterpSetConfig for the code which
    # ensures this condition.

    ::interp eval $child [list \
	      set tcl_library [lindex $child_access_path 0]]
    ::interp eval $slave [list \
	      set tcl_library [lindex $slave_access_path 0]]
}

# Returns the virtual token for directory number N.
proc ::safe::PathToken {n} {
    # We need to have a ":" in the token string so [file join] on the
    # mac won't turn it into a relative path.
    return "\$p(:$n:)" ;# Form tested by case 7.2
}

#
# translate virtual path into real path
#
proc ::safe::TranslatePath {child path} {
    namespace upvar ::safe [VarName $child] state
proc ::safe::TranslatePath {slave path} {
    namespace upvar ::safe S$slave state

    # somehow strip the namespaces 'functionality' out (the danger is that
    # we would strip valid macintosh "../" queries... :
    if {[string match "*::*" $path] || [string match "*..*" $path]} {
	return -code error "invalid characters in path $path"
    }

    # Use a cached map instead of computed local vars and subst.

    return [string map $state(access_path,map) $path]
}

# file name control (limit access to files/resources that should be a
# valid tcl source file)
proc ::safe::CheckFileName {child file} {
proc ::safe::CheckFileName {slave file} {
    # This used to limit what can be sourced to ".tcl" and forbid files
    # with more than 1 dot and longer than 14 chars, but I changed that
    # for 8.4 as a safe interp has enough internal protection already to
    # allow sourcing anything. - hobbs

    if {![file exists $file]} {
	# don't tell the file path
	return -code error "no such file or directory"
    }

    if {![file readable $file]} {
	# don't tell the file path
	return -code error "not readable"
    }
}

# AliasFileSubcommand handles selected subcommands of [file] in safe
# interpreters that are *almost* safe. In particular, it just acts to
# prevent discovery of what home directories exist.

proc ::safe::AliasFileSubcommand {child subcommand name} {
    if {[string match ~* $name]} {
	set name ./$name
    }
    tailcall ::interp invokehidden $child tcl:file:$subcommand $name
}

# AliasGlob is the target of the "glob" alias in safe interpreters.

proc ::safe::AliasGlob {child args} {
    Log $child "GLOB ! $args" NOTICE
proc ::safe::AliasGlob {slave args} {
    Log $slave "GLOB ! $args" NOTICE
    set cmd {}
    set at 0
    array set got {
	-directory 0
	-nocomplain 0
	-join 0
	-tails 0
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
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
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
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
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
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
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
1065
1066

1067
1068

1069
1070
1071
1072
1073
1074
1075

1076
1077

1078
1079
1080
1081
1082
1083
1084
1085







-
+

-
-
-
-
















+
+
+
+
+
+
+

-
+










-
+


-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
-
-
+




-
-
+
-




-

-
-
-
-
-
-
+

-
+


-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
+






-
+




-
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+



-
+

-
+


-
+






-
+





-
+








-
+




-
+



-
+






-
+

-
+



-
+

-
+

-
+



-
+
-
-
-

-
+

-
-
+
+



-
+

-
+
-


+
+
-
+
+


-
+
+

-
-
-
-
-
+



-
-
+
+






-
+



-
+






-
+








-
+










-
+



-
+







-
-
-
-
+
+
+
+




-
-
-
-
+
+
+
+




-
-
-
+
+
+
-
-
-
-
+
+
-
-
-
+
-
-
-
+
+



-
+



-
-
+
+











-
+





-
-
+
+










-
+





-
-
+
+

+
-
+
+
+
+

-
-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+




-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
+







-
+

-
+






-
+

-
+







    }

    set dir        {}
    set virtualdir {}

    while {$at < [llength $args]} {
	switch -glob -- [set opt [lindex $args $at]] {
	    -nocomplain - -- - -tails {
	    -nocomplain - -- - -join - -tails {
		lappend cmd $opt
		set got($opt) 1
		incr at
	    }
	    -join {
		set got($opt) 1
		incr at
	    }
	    -types - -type {
		lappend cmd -types [lindex $args [incr at]]
		incr at
	    }
	    -directory {
		if {$got($opt)} {
		    return -code error \
			{"-directory" cannot be used with "-path"}
		}
		set got($opt) 1
		set virtualdir [lindex $args [incr at]]
		incr at
	    }
	    pkgIndex.tcl {
		# Oops, this is globbing a subdirectory in regular package
		# search. That is not wanted. Abort, handler does catch
		# already (because glob was not defined before). See
		# package.tcl, lines 484ff in tclPkgUnknown.
		return -code error "unknown command glob"
	    }
	    -* {
		Log $child "Safe base rejecting glob option '$opt'"
		Log $slave "Safe base rejecting glob option '$opt'"
		return -code error "Safe base rejecting glob option '$opt'"
	    }
	    default {
		break
	    }
	}
	if {$got(--)} break
    }

    # Get the real path from the virtual one and check that the path is in the
    # access path of that child. Done after basic argument processing so that
    # access path of that slave. Done after basic argument processing so that
    # we know if -nocomplain is set.
    if {$got(-directory)} {
	try {
	    set dir [TranslatePath $child $virtualdir]
	    DirInAccessPath $child $dir
	} on error msg {
	    Log $child $msg
	    if {$got(-nocomplain)} return
	if {[catch {
	    set dir [TranslatePath $slave $virtualdir]
	    DirInAccessPath $slave $dir
	} msg]} {
	    Log $slave $msg
	    if {$got(-nocomplain)} {
		return
	    }
	    return -code error "permission denied"
	}
	if {$got(--)} {
	    set cmd [linsert $cmd end-1 -directory $dir]
	} else {
	    lappend cmd -directory $dir
	}
	lappend cmd -directory $dir
    }
    } else {
	# The code after this "if ... else" block would conspire to return with
	# no results in this case, if it were allowed to proceed.  Instead,
	# return now and reduce the number of cases to be considered later.
	Log $child {option -directory must be supplied}
	if {$got(-nocomplain)} return
	return -code error "permission denied"
    }


    # Apply the -join semantics ourselves.
    # Apply the -join semantics ourselves
    if {$got(-join)} {
	set args [lreplace $args $at end [join [lrange $args $at end] "/"]]
    }

    # Process the pattern arguments.  If we've done a join there is only one
    # pattern argument.
    # Process remaining pattern arguments

    set firstPattern [llength $cmd]
    foreach opt [lrange $args $at end] {
	if {![regexp $dirPartRE $opt -> thedir thefile]} {
	    set thedir .
	    # The *.tm search comes here.
	}
	# "Special" treatment for (joined) argument {*/pkgIndex.tcl}.
	# Do the expansion of "*" here, and filter out any directories that are
	# not in the access path.  The outcome is to lappend to cmd a path of
	# the form $virtualdir/subdir/pkgIndex.tcl for each subdirectory subdir,
	# after removing any subdir that are not in the access path.
	if {($thedir eq "*") && ($thefile eq "pkgIndex.tcl")} {
	if {$thedir eq "*"} {
	    set mapped 0
	    foreach d [glob -directory [TranslatePath $child $virtualdir] \
	    foreach d [glob -directory [TranslatePath $slave $virtualdir] \
			   -types d -tails *] {
		catch {
		    DirInAccessPath $child \
			[TranslatePath $child [file join $virtualdir $d]]
		    lappend cmd [file join $d $thefile]
		    set mapped 1
		}
	    }
		    DirInAccessPath $slave \
			[TranslatePath $slave [file join $virtualdir $d]]
		    if {$thefile eq "pkgIndex.tcl" || $thefile eq "*.tm"} {
			lappend cmd [file join $d $thefile]
			set mapped 1
		    }
		}
	    }
	    if {$mapped} continue
	    # Don't [continue] if */pkgIndex.tcl has no matches in the access
	    # path.  The pattern will now receive the same treatment as a
	    # "non-special" pattern (and will fail because it includes a "*" in
	    # the directory name).
	}
	# Any directory pattern that is not an exact (i.e. non-glob) match to a
	# directory in the access path will be rejected here.
	# - Rejections include any directory pattern that has glob matching
	#   patterns "*", "?", backslashes, braces or square brackets, (UNLESS
	#   it corresponds to a genuine directory name AND that directory is in
	#   the access path).
	# - The only "special matching characters" that remain in patterns for
	#   processing by glob are in the filename tail.
	# - [file join $anything ~${foo}] is ~${foo}, which is not an exact
	#   match to any directory in the access path.  Hence directory patterns
	#   that begin with "~" are rejected here.  Tests safe-16.[5-8] check
	#   that "file join" remains as required and does not expand ~${foo}.
	# - Bug [3529949] relates to unwanted expansion of ~${foo} and this is
	#   how the present code avoids the bug.  All tests safe-16.* relate.
	try {
	if {[catch {
	    DirInAccessPath $child [TranslatePath $child \
		    [file join $virtualdir $thedir]]
	} on error msg {
	    Log $child $msg
	    set thedir [file join $virtualdir $thedir]
	    DirInAccessPath $slave [TranslatePath $slave $thedir]
	} msg]} {
	    Log $slave $msg
	    if {$got(-nocomplain)} continue
	    return -code error "permission denied"
	}
	lappend cmd $opt
    }

    Log $child "GLOB = $cmd" NOTICE
    Log $slave "GLOB = $cmd" NOTICE

    if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} {
	return
    }
    try {
    if {[catch {
	# >>>>>>>>>> HERE'S THE CALL TO SAFE INTERP GLOB <<<<<<<<<<
	# - Pattern arguments added to cmd have NOT been translated from tokens.
	#   Only the virtualdir is translated (to dir).
	# - In the pkgIndex.tcl case, there is no "*" in the pattern arguments,
	#   which are a list of names each with tail pkgIndex.tcl.  The purpose
	#   of the call to glob is to remove the names for which the file does
	#   not exist.
	set entries [::interp invokehidden $child glob {*}$cmd]
    } on error msg {
	::interp invokehidden $slave glob {*}$cmd
    } msg]} {
	# This is the only place that a call with -nocomplain and no invalid
	# "dash-options" can return an error.
	Log $child $msg
	Log $slave $msg
	return -code error "script error"
    }

    Log $child "GLOB < $entries" NOTICE
    Log $slave "GLOB < $msg" NOTICE

    # Translate path back to what the child should see.
    # Translate path back to what the slave should see.
    set res {}
    set l [string length $dir]
    foreach p $entries {
    foreach p $msg {
	if {[string equal -length $l $dir $p]} {
	    set p [string replace $p 0 [expr {$l-1}] $virtualdir]
	}
	lappend res $p
    }

    Log $child "GLOB > $res" NOTICE
    Log $slave "GLOB > $res" NOTICE
    return $res
}

# AliasSource is the target of the "source" alias in safe interpreters.

proc ::safe::AliasSource {child args} {
proc ::safe::AliasSource {slave args} {
    set argc [llength $args]
    # Extended for handling of Tcl Modules to allow not only "source
    # filename", but "source -encoding E filename" as well.
    if {[lindex $args 0] eq "-encoding"} {
	incr argc -2
	set encoding [lindex $args 1]
	set at 2
	if {$encoding eq "identity"} {
	    Log $child "attempt to use the identity encoding"
	    Log $slave "attempt to use the identity encoding"
	    return -code error "permission denied"
	}
    } else {
	set at 0
	set encoding utf-8
	set encoding {}
    }
    if {$argc != 1} {
	set msg "wrong # args: should be \"source ?-encoding E? fileName\""
	Log $child "$msg ($args)"
	Log $slave "$msg ($args)"
	return -code error $msg
    }
    set file [lindex $args $at]

    # get the real path from the virtual one.
    if {[catch {
	set realfile [TranslatePath $child $file]
	set realfile [TranslatePath $slave $file]
    } msg]} {
	Log $child $msg
	Log $slave $msg
	return -code error "permission denied"
    }

    # check that the path is in the access path of that child
    # check that the path is in the access path of that slave
    if {[catch {
	FileInAccessPath $child $realfile
	FileInAccessPath $slave $realfile
    } msg]} {
	Log $child $msg
	Log $slave $msg
	return -code error "permission denied"
    }

    # Check that the filename exists and is readable.  If it is not, deliver
    # do the checks on the filename :
    # this -errorcode so that caller in tclPkgUnknown does not write a message
    # to tclLog.  Has no effect on other callers of ::source, which are in
    # "package ifneeded" scripts.
    if {[catch {
	CheckFileName $child $realfile
	CheckFileName $slave $realfile
    } msg]} {
	Log $child "$realfile:$msg"
	return -code error -errorcode {POSIX EACCES} $msg
	Log $slave "$realfile:$msg"
	return -code error $msg
    }

    # Passed all the tests, lets source it. Note that we do this all manually
    # because we want to control [info script] in the child so information
    # because we want to control [info script] in the slave so information
    # doesn't leak so much. [Bug 2913625]
    set old [::interp eval $child {info script}]
    set old [::interp eval $slave {info script}]
    set replacementMsg "script error"
    set code [catch {
	set f [open $realfile]
	fconfigure $f -eofchar "\032 {}"
	if {$encoding ne ""} {
	fconfigure $f -encoding $encoding -eofchar \032
	    fconfigure $f -encoding $encoding
	}
	set contents [read $f]
	close $f
	::interp eval $child [list info script $file]
	::interp eval $slave [list info script $file]
	::interp eval $slave $contents
    } msg opt]
    if {$code == 0} {
	set code [catch {::interp eval $child $contents} msg opt]
	set replacementMsg $msg
    }
    catch {interp eval $child [list info script $old]}
    catch {interp eval $slave [list info script $old]}
    # Note that all non-errors are fine result codes from [source], so we must
    # take a little care to do it properly. [Bug 2923613]
    if {$code == 1} {
	Log $child $msg
	return -code error $replacementMsg
	Log $slave $msg
	return -code error "script error"
    }
    return -code $code -options $opt $msg
}

# AliasLoad is the target of the "load" alias in safe interpreters.

proc ::safe::AliasLoad {child file args} {
proc ::safe::AliasLoad {slave file args} {
    set argc [llength $args]
    if {$argc > 2} {
	set msg "load error: too many arguments"
	Log $child "$msg ($argc) {$file $args}"
	Log $slave "$msg ($argc) {$file $args}"
	return -code error $msg
    }

    # package name (can be empty if file is not).
    set package [lindex $args 0]

    namespace upvar ::safe [VarName $child] state
    namespace upvar ::safe S$slave state

    # Determine where to load. load use a relative interp path and {}
    # means self, so we can directly and safely use passed arg.
    set target [lindex $args 1]
    if {$target ne ""} {
	# we will try to load into a sub sub interp; check that we want to
	# authorize that.
	if {!$state(nestedok)} {
	    Log $child "loading to a sub interp (nestedok)\
	    Log $slave "loading to a sub interp (nestedok)\
			disabled (trying to load $package to $target)"
	    return -code error "permission denied (nested load)"
	}
    }

    # Determine what kind of load is requested
    if {$file eq ""} {
	# static package loading
	if {$package eq ""} {
	    set msg "load error: empty filename and no package name"
	    Log $child $msg
	    Log $slave $msg
	    return -code error $msg
	}
	if {!$state(staticsok)} {
	    Log $child "static packages loading disabled\
	    Log $slave "static packages loading disabled\
			(trying to load $package to $target)"
	    return -code error "permission denied (static package)"
	}
    } else {
	# file loading

	# get the real path from the virtual one.
	try {
	    set file [TranslatePath $child $file]
	} on error msg {
	    Log $child $msg
	if {[catch {
	    set file [TranslatePath $slave $file]
	} msg]} {
	    Log $slave $msg
	    return -code error "permission denied"
	}

	# check the translated path
	try {
	    FileInAccessPath $child $file
	} on error msg {
	    Log $child $msg
	if {[catch {
	    FileInAccessPath $slave $file
	} msg]} {
	    Log $slave $msg
	    return -code error "permission denied (path)"
	}
    }

    try {
	return [::interp invokehidden $child load $file $package $target]
    } on error msg {
    if {[catch {
	::interp invokehidden $slave load $file $package $target
    } msg]} {
	# Some packages return no error message.
	set msg0 "load of binary library for package $package failed"
	if {$msg eq {}} {
	    set msg $msg0
	Log $slave $msg
	return -code error $msg
	} else {
	    set msg "$msg0: $msg"
	}
    }
	Log $child $msg
	return -code error $msg
    }

    return $msg
}

# FileInAccessPath raises an error if the file is not found in the list of
# directories contained in the (parent side recorded) child's access path.
# directories contained in the (master side recorded) slave's access path.

# the security here relies on "file dirname" answering the proper
# result... needs checking ?
proc ::safe::FileInAccessPath {child file} {
    namespace upvar ::safe [VarName $child] state
proc ::safe::FileInAccessPath {slave file} {
    namespace upvar ::safe S$slave state
    set access_path $state(access_path)

    if {[file isdirectory $file]} {
	return -code error "\"$file\": is a directory"
    }
    set parent [file dirname $file]

    # Normalize paths for comparison since lsearch knows nothing of
    # potential pathname anomalies.
    set norm_parent [file normalize $parent]

    namespace upvar ::safe [VarName $child] state
    namespace upvar ::safe S$slave state
    if {$norm_parent ni $state(access_path,norm)} {
	return -code error "\"$file\": not in access_path"
    }
}

proc ::safe::DirInAccessPath {child dir} {
    namespace upvar ::safe [VarName $child] state
proc ::safe::DirInAccessPath {slave dir} {
    namespace upvar ::safe S$slave state
    set access_path $state(access_path)

    if {[file isfile $dir]} {
	return -code error "\"$dir\": is a file"
    }

    # Normalize paths for comparison since lsearch knows nothing of
    # potential pathname anomalies.
    set norm_dir [file normalize $dir]

    namespace upvar ::safe [VarName $child] state
    namespace upvar ::safe S$slave state
    if {$norm_dir ni $state(access_path,norm)} {
	return -code error "\"$dir\": not in access_path"
    }
}

# This procedure is used to report an attempt to use an unsafe member of an
# ensemble command.
# This procedure enables access from a safe interpreter to only a subset
# of the subcommands of a command:

proc ::safe::Subset {slave command okpat args} {
proc ::safe::BadSubcommand {child command subcommand args} {
    set subcommand [lindex $args 0]
    if {[regexp $okpat $subcommand]} {
	return [$command {*}$args]
    }
    set msg "not allowed to invoke subcommand $subcommand of $command"
    Log $child $msg
    return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
    Log $slave $msg
    return -code error $msg
}

# This procedure installs an alias in a slave that invokes "safesubset" in
# the master to execute allowed subcommands. It precomputes the pattern of
# allowed subcommands; you can use wildcards in the pattern if you wish to
# allow subcommand abbreviation.
#
# Syntax is: AliasSubset slave alias target subcommand1 subcommand2...

proc ::safe::AliasSubset {slave alias target args} {
    set pat "^([join $args |])\$"
    ::interp alias $slave $alias {}\
	[namespace current]::Subset $slave $target $pat
}

# AliasEncodingSystem is the target of the "encoding system" alias in safe
# interpreters.
proc ::safe::AliasEncodingSystem {child args} {
    try {
	# Must not pass extra arguments; safe interpreters may not set the
	# system encoding but they may read it.
	if {[llength $args]} {
	    return -code error -errorcode {TCL WRONGARGS} \
# AliasEncoding is the target of the "encoding" alias in safe interpreters.

proc ::safe::AliasEncoding {slave option args} {
    # Careful; do not want empty option to get through to the [string equal]
    if {[regexp {^(name.*|convert.*|)$} $option]} {
	return [::interp invokehidden $slave encoding $option {*}$args]
    }

    if {[string equal -length [string length $option] $option "system"]} {
	if {[llength $args] == 0} {
	    # passed all the tests , lets source it:
	    if {[catch {
		set sysenc [::interp invokehidden $slave encoding system]
	    } msg]} {
		Log $slave $msg
		return -code error "script error"
		"wrong # args: should be \"encoding system\""
	}
	    }
    } on error {msg options} {
	Log $child $msg
	return -options $options $msg
    }
    tailcall ::interp invokehidden $child tcl:encoding:system
	    return $sysenc
	}
	set msg "wrong # args: should be \"encoding system\""
	set code {TCL WRONGARGS}
    } else {
	set msg "bad option \"$option\": must be convertfrom, convertto, names, or system"
	set code [list TCL LOOKUP INDEX option $option]
    }
    Log $slave $msg
    return -code error -errorcode $code $msg
}

# Various minor hiding of platform features. [Bug 2913625]

proc ::safe::AliasExeName {child} {
proc ::safe::AliasExeName {slave} {
    return ""
}

# ------------------------------------------------------------------------------
# Using Interpreter Names with Namespace Qualifiers
# ------------------------------------------------------------------------------
# (1) We wish to preserve compatibility with existing code, in which Safe Base
#     interpreter names have no namespace qualifiers.
# (2) safe::interpCreate and the rest of the Safe Base previously could not
#     accept namespace qualifiers in an interpreter name.
# (3) The interp command will accept namespace qualifiers in an interpreter
#     name, but accepts distinct interpreters that will have the same command
#     name (e.g. foo, ::foo, and :::foo) (bug 66c2e8c974).
# (4) To satisfy these constraints, Safe Base interpreter names will be fully
#     qualified namespace names with no excess colons and with the leading "::"
#     omitted.
# (5) Trailing "::" implies a namespace tail {}, which interp reads as {{}}.
#     Reject such names.
# (6) We could:
#     (a) EITHER reject usable but non-compliant names (e.g. excess colons) in
#         interpCreate, interpInit;
#     (b) OR accept such names and then translate to a compliant name in every
#         command.
#     The problem with (b) is that the user will expect to use the name with the
#     interp command and will find that it is not recognised.
#     E.g "interpCreate ::foo" creates interpreter "foo", and the user's name
#     "::foo" works with all the Safe Base commands, but "interp eval ::foo"
#     fails.
#     So we choose (a).
# (7) The command
#         namespace upvar ::safe S$child state
#     becomes
#         namespace upvar ::safe [VarName $child] state
# ------------------------------------------------------------------------------

proc ::safe::RejectExcessColons {child} {
    set stripped [regsub -all -- {:::*} $child ::]
    if {[string range $stripped end-1 end] eq {::}} {
        return -code error {interpreter name must not end in "::"}
    }
    if {$stripped ne $child} {
        set msg {interpreter name has excess colons in namespace separators}
        return -code error $msg
    }
    if {[string range $stripped 0 1] eq {::}} {
        return -code error {interpreter name must not begin "::"}
    }
    return
}

proc ::safe::VarName {child} {
    # return S$child
    return S[string map {:: @N @ @A} $child]
}

proc ::safe::Setup {} {
    ####
    #
    # Setup the arguments parsing
    #
    ####

    # Share the descriptions
    set temp [::tcl::OptKeyRegister {
	{-accessPath -list {} "access path for the child"}
	{-accessPath -list {} "access path for the slave"}
	{-noStatics "prevent loading of statically linked pkgs"}
	{-statics true "loading of statically linked pkgs"}
	{-nestedLoadOk "allow nested loading"}
	{-nested false "nested loading"}
	{-deleteHook -script {} "delete hook"}
    }]

    # create case (child is optional)
    # create case (slave is optional)
    ::tcl::OptKeyRegister {
	{?child? -name {} "name of the child (optional)"}
	{?slave? -name {} "name of the slave (optional)"}
    } ::safe::interpCreate

    # adding the flags sub programs to the command program (relying on Opt's
    # internal implementation details)
    lappend ::tcl::OptDesc(::safe::interpCreate) $::tcl::OptDesc($temp)

    # init and configure (child is needed)
    # init and configure (slave is needed)
    ::tcl::OptKeyRegister {
	{child -name {} "name of the child"}
	{slave -name {} "name of the slave"}
    } ::safe::interpIC

    # adding the flags sub programs to the command program (relying on Opt's
    # internal implementation details)
    lappend ::tcl::OptDesc(::safe::interpIC) $::tcl::OptDesc($temp)

    # temp not needed anymore
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
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







-
+


-
+




-
+

-
+


-
+







namespace eval ::safe {
    # internal variables

    # Log command, set via 'setLogCmd'. Logging is disabled when empty.
    variable Log {}

    # The package maintains a state array per child interp under its
    # The package maintains a state array per slave interp under its
    # control. The name of this array is S<interp-name>. This array is
    # brought into scope where needed, using 'namespace upvar'. The S
    # prefix is used to avoid that a child interp called "Log" smashes
    # prefix is used to avoid that a slave interp called "Log" smashes
    # the "Log" variable.
    #
    # The array's elements are:
    #
    # access_path       : List of paths accessible to the child.
    # access_path       : List of paths accessible to the slave.
    # access_path,norm  : Ditto, in normalized form.
    # access_path,child : Ditto, as the path tokens as seen by the child.
    # access_path,slave : Ditto, as the path tokens as seen by the slave.
    # access_path,map   : dict ( token -> path )
    # access_path,remap : dict ( path -> token )
    # tm_path_child     : List of TM root directories, as tokens seen by the child.
    # tm_path_slave     : List of TM root directories, as tokens seen by the slave.
    # staticsok         : Value of option -statics
    # nestedok          : Value of option -nested
    # cleanupHook       : Value of option -deleteHook
}

::safe::Setup

Changes to library/tclIndex.

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






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

-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
# Tcl autoload index file, version 2.0
# -*- tcl -*-
# This file is generated by the "auto_mkindex" command
# and sourced to set up indexing information for one or
# more commands.  Typically each line is a command that
# sets an element in the auto_index array, where the
# element name is the name of a command and the value is
# a script that loads the command.

set auto_index(auto_reset) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(tcl_findLibrary) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(auto_mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(auto_mkindex_old) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::init) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::childhook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistClear) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistInfo) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistRedo) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistIndex) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistEvent) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(::tcl::HistChange) [list ::tcl::Pkg::source [file join $dir history.tcl]]
set auto_index(pkg_mkIndex) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(tclPkgSetup) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]]
set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]]
set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::CheckInterp) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpConfigure) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::InterpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::InterpSetConfig) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpFindInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpAddToAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::InterpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::AddSubDirs) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::interpDelete) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::setLogCmd) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::SyncAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::PathToken) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::TranslatePath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::Log) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::CheckFileName) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(auto_reset) [list source [file join $dir auto.tcl]]
set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]]
set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]]
set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]]
set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]]
set auto_index(history) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]
set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]
set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]
set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]
set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]]
set auto_index(::pkg::create) [list source [file join $dir package.tcl]]
set auto_index(parray) [list source [file join $dir parray.tcl]]
set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]
set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]
set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]
set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]]
set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]
set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]
set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]
set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::InterpStateName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::IsInterp) [list source [file join $dir safe.tcl]]
set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]
set auto_index(::safe::PathListName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::VirtualPathListName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::PathNumberName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::StaticsOkName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::NestedOkName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Toplevel) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Set) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Lappend) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Unset) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Exists) [list source [file join $dir safe.tcl]]
set auto_index(::safe::GetAccessPath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::StaticsOk) [list source [file join $dir safe.tcl]]
set auto_index(::safe::NestedOk) [list source [file join $dir safe.tcl]]
set auto_index(::safe::DeleteHookName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]
set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasGlob) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::AliasSource) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::AliasLoad) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::FileInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]
set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]
set auto_index(::safe::DirInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::Subset) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::AliasSubset) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(::safe::AliasEncoding) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]
set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]]
set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]
set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]
set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]
set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]
set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]
set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]]
set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]]
if {[namespace exists ::tcl::unsupported]} {
    set auto_index(timerate) {namespace import ::tcl::unsupported::timerate}
}

Changes to library/tcltest/tcltest.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22













-
-
+
+







# tcltest.tcl --
#
#	This file contains support code for the Tcl test suite.  It
#       defines the tcltest namespace and finds and defines the output
#       directory, constraints available, output and error channels,
#	etc. used by Tcl tests.  See the tcltest man page for more
#	details.
#
#       This design was based on the Tcl testing approach designed and
#       initially implemented by Mary Ann May-Pumphrey of Sun
#	Microsystems.
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2000 Ajuba Solutions
# Contributions from Don Porter, NIST, 2002.  (not subject to US copyright)
# All rights reserved.

package require Tcl 8.5-		;# -verbose line uses [info frame]
namespace eval tcltest {

    # When the version number changes, be sure to update the pkgIndex.tcl file,
37
38
39
40
41
42
43

44


45
46
47
48
49
50
51
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
52
53







+
-
+
+







	makeFile removeDirectory removeFile runAllTests test

    # Export configuration commands that control the functional commands
    namespace export configure customMatch errorChannel interpreter \
	    outputChannel testConstraint

    # Export commands that are duplication (candidates for deprecation)
    if {![package vsatisfies [package provide Tcl] 8.7-]} {
    namespace export bytestring		;# dups [encoding convertfrom identity]
	namespace export bytestring	;# dups [encoding convertfrom identity]
    }
    namespace export debug		;#	[configure -debug]
    namespace export errorFile		;#	[configure -errfile]
    namespace export limitConstraints	;#	[configure -limitconstraints]
    namespace export loadFile		;#	[configure -loadfile]
    namespace export loadScript		;#	[configure -load]
    namespace export match		;#	[configure -match]
    namespace export matchFiles		;#	[configure -file]
1265
1266
1267
1268
1269
1270
1271
1272

1273
1274
1275
1276
1277
1278
1279
1267
1268
1269
1270
1271
1272
1273

1274
1275
1276
1277
1278
1279
1280
1281







-
+







    ConstraintInitializer notRoot {expr {![testConstraint root]}}

    # Set nonBlockFiles constraint: 1 means this platform supports
    # setting files into nonblocking mode.

    ConstraintInitializer nonBlockFiles {
	    set code [expr {[catch {set f [open defs r]}]
		    || [catch {chan configure $f -blocking off}]}]
		    || [catch {fconfigure $f -blocking off}]}]
	    catch {close $f}
	    set code
    }

    # Set asyncPipeClose constraint: 1 means this platform supports
    # async flush and async close on a pipe.
    #
3075
3076
3077
3078
3079
3080
3081
3082




3083
3084
3085
3086
3087
3088
3089
3077
3078
3079
3080
3081
3082
3083

3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094







-
+
+
+
+








    set fullName [file join $directory $name]

    DebugPuts 3 "[lindex [info level 0] 0]:\
	     putting ``$contents'' into $fullName"

    set fd [open $fullName w]
    chan configure $fd -translation lf
    fconfigure $fd -translation lf
    if {[package vsatisfies [package provide Tcl] 8.7-]} {
	fconfigure $fd -encoding utf-8
    }
    if {[string index $contents end] eq "\n"} {
	puts -nonewline $fd $contents
    } else {
	puts $fd $contents
    }
    close $fd

3224
3225
3226
3227
3228
3229
3230



3231
3232
3233
3234
3235
3236
3237
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245







+
+
+







proc tcltest::viewFile {name {directory ""}} {
    FillFilesExisted
    if {[llength [info level 0]] == 2} {
	set directory [temporaryDirectory]
    }
    set fullName [file join $directory $name]
    set f [open $fullName]
    if {[package vsatisfies [package provide Tcl] 8.7-]} {
	fconfigure $f -encoding utf-8
    }
    set data [read -nonewline $f]
    close $f
    return $data
}

# tcltest::bytestring --
#
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
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







+
+
+









+
-
-
+
+
+







#    instance to confirm that "\xE0\0" in a Tcl script is stored
#    internally in UTF-8 as the sequence of bytes "\xC3\xA0\xC0\x80".
#
# Generally, it's a bad idea to examine the bytes in a Tcl string or to
# construct improperly formed strings in this manner, because it involves
# exposing that Tcl uses UTF-8 internally.
#
# This function doesn't work any more in Tcl 8.7, since the 'identity'
# is gone (TIP #345)
#
# Arguments:
#	string being converted
#
# Results:
#	result fom encoding
#
# Side effects:
#	None

if {![package vsatisfies [package provide Tcl] 8.7-]} {
proc tcltest::bytestring {string} {
    return [encoding convertfrom identity $string]
    proc tcltest::bytestring {string} {
	return [encoding convertfrom identity $string]
    }
}

# tcltest::OpenFiles --
#
#	used in io tests, uses testchannel
#
# Arguments:

Changes to library/tm.tcl.

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
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







+
-
-
+
+
+
-
-
-
+
-













-
-
+
-





-
+
-
-





-
-


















-
+







	    }
	    set currentsearchpath [file join $path $pkgroot]
	    if {![interp issafe] && ![file exists $currentsearchpath]} {
		continue
	    }
	    set strip [llength [file split $path]]

	    # We can't use glob in safe interps, so enclose the following in a
	    # Get the module files out of the subdirectories.
	    # - Safe Base interpreters have a restricted "glob" command that
	    # catch statement, where we get the module files out of the
	    # subdirectories. In other words, Tcl Modules are not-functional
	    # in such an interpreter. This is the same as for the command
	    #   works in this case.
	    # - The "catch" was essential when there was no safe glob and every
	    #   call in a safe interp failed; it is retained only for corner
	    # "tclPkgUnknown", i.e. the search for regular packages.
	    #   cases in which the eventual call to glob returns an error.

	    catch {
		# We always look for _all_ possible modules in the current
		# path, to get the max result out of the glob.

		foreach file [glob -nocomplain -directory $currentsearchpath *.tm] {
		    set pkgfilename [join [lrange [file split $file] $strip end] ::]

		    if {![regexp -- $pkgpattern $pkgfilename --> pkgname pkgversion]} {
			# Ignore everything not matching our pattern for
			# package names.
			continue
		    }
		    try {
			package vcompare $pkgversion 0
		    if {[catch {package vcompare $pkgversion 0}]} {
		    } on error {} {
			# Ignore everything where the version part is not
			# acceptable to "package vcompare".
			continue
		    }

		    if {([package ifneeded $pkgname $pkgversion] ne {})
		    if {[package ifneeded $pkgname $pkgversion] ne {}} {
			    && (![interp issafe])
		    } {
			# There's already a provide script registered for
			# this version of this package.  Since all units of
			# code claiming to be the same version of the same
			# package ought to be identical, just stick with
			# the one we already have.
			# This does not apply to Safe Base interpreters because
			# the token-to-directory mapping may have changed.
			continue
		    }

		    # We have found a candidate, generate a "provide script"
		    # for it, and remember it.  Note that we are using ::list
		    # to do this; locally [list] means something else without
		    # the namespace specifier.

		    # NOTE. When making changes to the format of the provide
		    # command generated below CHECK that the 'LOCATE'
		    # procedure in core file 'platform/shell.tcl' still
		    # understands it, or, if not, update its implementation
		    # appropriately.
		    #
		    # Right now LOCATE's implementation assumes that the path
		    # of the package file is the last element in the list.

		    package ifneeded $pkgname $pkgversion \
			"[::list package provide $pkgname $pkgversion];[::list source $file]"
			"[::list package provide $pkgname $pkgversion];[::list source -encoding utf-8 $file]"

		    # We abort in this unknown handler only if we got a
		    # satisfying candidate for the requested package.
		    # Otherwise we still have to fallback to the regular
		    # package search to complete the processing.

		    if {($pkgname eq $name)

Changes to library/tzdata/Africa/Accra.

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
1
2
3


4
5


















































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
    LoadTimeZoneFile Africa/Abidjan

set TZData(:Africa/Accra) {
}
set TZData(:Africa/Accra) $TZData(:Africa/Abidjan)
    {-9223372036854775808 -52 0 LMT}
    {-1640995148 0 0 GMT}
    {-1556841600 1200 1 GMT}
    {-1546388400 0 0 GMT}
    {-1525305600 1200 1 GMT}
    {-1514852400 0 0 GMT}
    {-1493769600 1200 1 GMT}
    {-1483316400 0 0 GMT}
    {-1462233600 1200 1 GMT}
    {-1451780400 0 0 GMT}
    {-1430611200 1200 1 GMT}
    {-1420158000 0 0 GMT}
    {-1399075200 1200 1 GMT}
    {-1388622000 0 0 GMT}
    {-1367539200 1200 1 GMT}
    {-1357086000 0 0 GMT}
    {-1336003200 1200 1 GMT}
    {-1325550000 0 0 GMT}
    {-1304380800 1200 1 GMT}
    {-1293927600 0 0 GMT}
    {-1272844800 1200 1 GMT}
    {-1262391600 0 0 GMT}
    {-1241308800 1200 1 GMT}
    {-1230855600 0 0 GMT}
    {-1209772800 1200 1 GMT}
    {-1199319600 0 0 GMT}
    {-1178150400 1200 1 GMT}
    {-1167697200 0 0 GMT}
    {-1146614400 1200 1 GMT}
    {-1136161200 0 0 GMT}
    {-1115078400 1200 1 GMT}
    {-1104625200 0 0 GMT}
    {-1083542400 1200 1 GMT}
    {-1073089200 0 0 GMT}
    {-1051920000 1200 1 GMT}
    {-1041466800 0 0 GMT}
    {-1020384000 1200 1 GMT}
    {-1009930800 0 0 GMT}
    {-988848000 1200 1 GMT}
    {-978394800 0 0 GMT}
    {-957312000 1200 1 GMT}
    {-946858800 0 0 GMT}
    {-925689600 1200 1 GMT}
    {-915236400 0 0 GMT}
    {-894153600 1200 1 GMT}
    {-883700400 0 0 GMT}
    {-862617600 1200 1 GMT}
    {-852164400 0 0 GMT}
}

Changes to library/tzdata/Africa/Juba.

32
33
34
35
36
37
38

39
32
33
34
35
36
37
38
39
40







+

    {419983200 10800 1 CAST}
    {435013200 7200 0 CAT}
    {452037600 10800 1 CAST}
    {466635600 7200 0 CAT}
    {483487200 10800 1 CAST}
    {498171600 7200 0 CAT}
    {947930400 10800 0 EAT}
    {1612126800 7200 0 CAT}
}

Changes to library/tzdata/Africa/Lagos.

1
2
3
4
5





6
1
2
3


4
5
6
7
8
9



-
-
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Lagos) {
    {-9223372036854775808 816 0 LMT}
    {-1588464816 3600 0 WAT}
    {-9223372036854775808 815 0 LMT}
    {-2035584815 0 0 GMT}
    {-1940889600 815 0 LMT}
    {-1767226415 1800 0 +0030}
    {-1588465800 3600 0 WAT}
}

Changes to library/tzdata/Africa/Nairobi.

1
2
3
4

5
6
7
8




9
1
2
3
4
5




6
7
8
9
10




+
-
-
-
-
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Africa/Nairobi) {
    {-9223372036854775808 8836 0 LMT}
    {-1946168836 9000 0 +0230}
    {-1309746436 10800 0 EAT}
    {-1262314800 9000 0 +0230}
    {-946780200 9900 0 +0245}
    {-315629100 10800 0 EAT}
    {-1309746600 10800 0 EAT}
    {-1261969200 9000 0 +0230}
    {-1041388200 9900 0 +0245}
    {-865305900 10800 0 EAT}
}

Changes to library/tzdata/America/Anguilla.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Anguilla) $TZData(:America/Port_of_Spain)
set TZData(:America/Anguilla) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Antigua.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Antigua) $TZData(:America/Port_of_Spain)
set TZData(:America/Antigua) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Aruba.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Curacao)]} {
    LoadTimeZoneFile America/Curacao
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Aruba) $TZData(:America/Curacao)
set TZData(:America/Aruba) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Atikokan.

1


2
3


4
5
6
7
8
9
10
11
12
1
2
3


4
5










+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Panama)]} {
    LoadTimeZoneFile America/Panama

set TZData(:America/Atikokan) {
}
set TZData(:America/Atikokan) $TZData(:America/Panama)
    {-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/Bahia_Banderas.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
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/Bahia_Banderas) {
    {-9223372036854775808 -25260 0 LMT}
    {-1514739600 -25200 0 MST}
    {-1343066400 -21600 0 CST}
    {-1234807200 -25200 0 MST}
    {-1220292000 -21600 0 CST}
    {-1220292000 -21600 1 MDT}
    {-1207159200 -25200 0 MST}
    {-1191344400 -21600 0 CST}
    {-873828000 -25200 0 MST}
    {-661539600 -28800 0 PST}
    {28800 -25200 0 MST}
    {828867600 -21600 1 MDT}
    {846403200 -25200 0 MST}
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
61
62
63
64
65
66
67


























































































































































68







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1572159600 -21600 0 CST}
    {1586073600 -18000 1 CDT}
    {1603609200 -21600 0 CST}
    {1617523200 -18000 1 CDT}
    {1635663600 -21600 0 CST}
    {1648972800 -18000 1 CDT}
    {1667113200 -21600 0 CST}
    {1680422400 -18000 1 CDT}
    {1698562800 -21600 0 CST}
    {1712476800 -18000 1 CDT}
    {1730012400 -21600 0 CST}
    {1743926400 -18000 1 CDT}
    {1761462000 -21600 0 CST}
    {1775376000 -18000 1 CDT}
    {1792911600 -21600 0 CST}
    {1806825600 -18000 1 CDT}
    {1824966000 -21600 0 CST}
    {1838275200 -18000 1 CDT}
    {1856415600 -21600 0 CST}
    {1869724800 -18000 1 CDT}
    {1887865200 -21600 0 CST}
    {1901779200 -18000 1 CDT}
    {1919314800 -21600 0 CST}
    {1933228800 -18000 1 CDT}
    {1950764400 -21600 0 CST}
    {1964678400 -18000 1 CDT}
    {1982818800 -21600 0 CST}
    {1996128000 -18000 1 CDT}
    {2014268400 -21600 0 CST}
    {2027577600 -18000 1 CDT}
    {2045718000 -21600 0 CST}
    {2059027200 -18000 1 CDT}
    {2077167600 -21600 0 CST}
    {2091081600 -18000 1 CDT}
    {2108617200 -21600 0 CST}
    {2122531200 -18000 1 CDT}
    {2140066800 -21600 0 CST}
    {2153980800 -18000 1 CDT}
    {2172121200 -21600 0 CST}
    {2185430400 -18000 1 CDT}
    {2203570800 -21600 0 CST}
    {2216880000 -18000 1 CDT}
    {2235020400 -21600 0 CST}
    {2248934400 -18000 1 CDT}
    {2266470000 -21600 0 CST}
    {2280384000 -18000 1 CDT}
    {2297919600 -21600 0 CST}
    {2311833600 -18000 1 CDT}
    {2329369200 -21600 0 CST}
    {2343283200 -18000 1 CDT}
    {2361423600 -21600 0 CST}
    {2374732800 -18000 1 CDT}
    {2392873200 -21600 0 CST}
    {2406182400 -18000 1 CDT}
    {2424322800 -21600 0 CST}
    {2438236800 -18000 1 CDT}
    {2455772400 -21600 0 CST}
    {2469686400 -18000 1 CDT}
    {2487222000 -21600 0 CST}
    {2501136000 -18000 1 CDT}
    {2519276400 -21600 0 CST}
    {2532585600 -18000 1 CDT}
    {2550726000 -21600 0 CST}
    {2564035200 -18000 1 CDT}
    {2582175600 -21600 0 CST}
    {2596089600 -18000 1 CDT}
    {2613625200 -21600 0 CST}
    {2627539200 -18000 1 CDT}
    {2645074800 -21600 0 CST}
    {2658988800 -18000 1 CDT}
    {2676524400 -21600 0 CST}
    {2690438400 -18000 1 CDT}
    {2708578800 -21600 0 CST}
    {2721888000 -18000 1 CDT}
    {2740028400 -21600 0 CST}
    {2753337600 -18000 1 CDT}
    {2771478000 -21600 0 CST}
    {2785392000 -18000 1 CDT}
    {2802927600 -21600 0 CST}
    {2816841600 -18000 1 CDT}
    {2834377200 -21600 0 CST}
    {2848291200 -18000 1 CDT}
    {2866431600 -21600 0 CST}
    {2879740800 -18000 1 CDT}
    {2897881200 -21600 0 CST}
    {2911190400 -18000 1 CDT}
    {2929330800 -21600 0 CST}
    {2942640000 -18000 1 CDT}
    {2960780400 -21600 0 CST}
    {2974694400 -18000 1 CDT}
    {2992230000 -21600 0 CST}
    {3006144000 -18000 1 CDT}
    {3023679600 -21600 0 CST}
    {3037593600 -18000 1 CDT}
    {3055734000 -21600 0 CST}
    {3069043200 -18000 1 CDT}
    {3087183600 -21600 0 CST}
    {3100492800 -18000 1 CDT}
    {3118633200 -21600 0 CST}
    {3132547200 -18000 1 CDT}
    {3150082800 -21600 0 CST}
    {3163996800 -18000 1 CDT}
    {3181532400 -21600 0 CST}
    {3195446400 -18000 1 CDT}
    {3212982000 -21600 0 CST}
    {3226896000 -18000 1 CDT}
    {3245036400 -21600 0 CST}
    {3258345600 -18000 1 CDT}
    {3276486000 -21600 0 CST}
    {3289795200 -18000 1 CDT}
    {3307935600 -21600 0 CST}
    {3321849600 -18000 1 CDT}
    {3339385200 -21600 0 CST}
    {3353299200 -18000 1 CDT}
    {3370834800 -21600 0 CST}
    {3384748800 -18000 1 CDT}
    {3402889200 -21600 0 CST}
    {3416198400 -18000 1 CDT}
    {3434338800 -21600 0 CST}
    {3447648000 -18000 1 CDT}
    {3465788400 -21600 0 CST}
    {3479702400 -18000 1 CDT}
    {3497238000 -21600 0 CST}
    {3511152000 -18000 1 CDT}
    {3528687600 -21600 0 CST}
    {3542601600 -18000 1 CDT}
    {3560137200 -21600 0 CST}
    {3574051200 -18000 1 CDT}
    {3592191600 -21600 0 CST}
    {3605500800 -18000 1 CDT}
    {3623641200 -21600 0 CST}
    {3636950400 -18000 1 CDT}
    {3655090800 -21600 0 CST}
    {3669004800 -18000 1 CDT}
    {3686540400 -21600 0 CST}
    {3700454400 -18000 1 CDT}
    {3717990000 -21600 0 CST}
    {3731904000 -18000 1 CDT}
    {3750044400 -21600 0 CST}
    {3763353600 -18000 1 CDT}
    {3781494000 -21600 0 CST}
    {3794803200 -18000 1 CDT}
    {3812943600 -21600 0 CST}
    {3826252800 -18000 1 CDT}
    {3844393200 -21600 0 CST}
    {3858307200 -18000 1 CDT}
    {3875842800 -21600 0 CST}
    {3889756800 -18000 1 CDT}
    {3907292400 -21600 0 CST}
    {3921206400 -18000 1 CDT}
    {3939346800 -21600 0 CST}
    {3952656000 -18000 1 CDT}
    {3970796400 -21600 0 CST}
    {3984105600 -18000 1 CDT}
    {4002246000 -21600 0 CST}
    {4016160000 -18000 1 CDT}
    {4033695600 -21600 0 CST}
    {4047609600 -18000 1 CDT}
    {4065145200 -21600 0 CST}
    {4079059200 -18000 1 CDT}
    {4096594800 -21600 0 CST}
}

Changes to library/tzdata/America/Barbados.

1
2
3
4
5
6









7
8
9
10
11
12
13
1
2
3
4


5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20




-
-
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Barbados) {
    {-9223372036854775808 -14309 0 LMT}
    {-1451678491 -14309 0 BMT}
    {-1199217691 -14400 0 AST}
    {-1841256091 -14400 0 AST}
    {-874263600 -10800 1 ADT}
    {-862682400 -14400 0 AST}
    {-841604400 -10800 1 ADT}
    {-830714400 -14400 0 AST}
    {-820526400 -14400 0 -0330}
    {-811882800 -12600 1 AST}
    {-798660000 -14400 0 -0330}
    {-788904000 -14400 0 AST}
    {234943200 -10800 1 ADT}
    {244616400 -14400 0 AST}
    {261554400 -10800 1 ADT}
    {276066000 -14400 0 AST}
    {293004000 -10800 1 ADT}
    {307515600 -14400 0 AST}
    {325058400 -10800 1 ADT}

Changes to library/tzdata/America/Belize.

47
48
49
50
51
52
53







































54
55






56
57
58
59
60
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+





    {-974658600 -21600 0 CST}
    {-954093600 -19800 1 -0530}
    {-943209000 -21600 0 CST}
    {-922644000 -19800 1 -0530}
    {-911759400 -21600 0 CST}
    {-891194400 -19800 1 -0530}
    {-879705000 -21600 0 CST}
    {-868212000 -18000 1 CWT}
    {-769395600 -18000 1 CPT}
    {-758746800 -21600 0 CST}
    {-701892000 -19800 1 -0530}
    {-690402600 -21600 0 CST}
    {-670442400 -19800 1 -0530}
    {-658953000 -21600 0 CST}
    {-638992800 -19800 1 -0530}
    {-627503400 -21600 0 CST}
    {-606938400 -19800 1 -0530}
    {-596053800 -21600 0 CST}
    {-575488800 -19800 1 -0530}
    {-564604200 -21600 0 CST}
    {-544039200 -19800 1 -0530}
    {-532549800 -21600 0 CST}
    {-512589600 -19800 1 -0530}
    {-501100200 -21600 0 CST}
    {-481140000 -19800 1 -0530}
    {-469650600 -21600 0 CST}
    {-449690400 -19800 1 -0530}
    {-438201000 -21600 0 CST}
    {-417636000 -19800 1 -0530}
    {-406751400 -21600 0 CST}
    {-386186400 -19800 1 -0530}
    {-375301800 -21600 0 CST}
    {-354736800 -19800 1 -0530}
    {-343247400 -21600 0 CST}
    {-323287200 -19800 1 -0530}
    {-311797800 -21600 0 CST}
    {-291837600 -19800 1 -0530}
    {-280348200 -21600 0 CST}
    {-259783200 -19800 1 -0530}
    {-248898600 -21600 0 CST}
    {-228333600 -19800 1 -0530}
    {-217449000 -21600 0 CST}
    {-196884000 -19800 1 -0530}
    {-185999400 -21600 0 CST}
    {-165434400 -19800 1 -0530}
    {-153945000 -21600 0 CST}
    {-859744800 -19800 1 -0530}
    {-848255400 -21600 0 CST}
    {-133984800 -19800 1 -0530}
    {-122495400 -21600 0 CST}
    {-102535200 -19800 1 -0530}
    {-91045800 -21600 0 CST}
    {-70480800 -19800 1 -0530}
    {-59596200 -21600 0 CST}
    {123919200 -18000 1 CDT}
    {129618000 -21600 0 CST}
    {409039200 -18000 1 CDT}
    {413874000 -21600 0 CST}
}

Changes to library/tzdata/America/Blanc-Sablon.

1


2
3


4
5
6
7
8
9
10
11
12
1
2
3


4
5










+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico

set TZData(:America/Blanc-Sablon) {
}
set TZData(:America/Blanc-Sablon) $TZData(:America/Puerto_Rico)
    {-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}
}

Changes to library/tzdata/America/Bogota.

1
2
3
4
5
6
7
8

9
1
2
3
4
5
6
7

8
9







-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Bogota) {
    {-9223372036854775808 -17776 0 LMT}
    {-2707671824 -17776 0 BMT}
    {-1739041424 -18000 0 -05}
    {704869200 -14400 1 -05}
    {733896000 -18000 0 -05}
    {729057600 -18000 0 -05}
}

Changes to library/tzdata/America/Cambridge_Bay.

1
2
3
4
5
6
7
8




9
10












11
12
13
14
15
16
17
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








+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Cambridge_Bay) {
    {-9223372036854775808 0 0 -00}
    {-1577923200 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {73472400 -21600 1 MDT}
    {89193600 -25200 0 MST}
    {104922000 -21600 1 MDT}
    {120643200 -25200 0 MST}
    {-147891600 -18000 1 MDDT}
    {-131562000 -25200 0 MST}
    {136371600 -21600 1 MDT}
    {152092800 -25200 0 MST}
    {167821200 -21600 1 MDT}
    {183542400 -25200 0 MST}
    {199270800 -21600 1 MDT}
    {215596800 -25200 0 MST}
    {230720400 -21600 1 MDT}
    {247046400 -25200 0 MST}
    {262774800 -21600 1 MDT}
    {278496000 -25200 0 MST}
    {294224400 -21600 1 MDT}
    {309945600 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}
    {420022800 -21600 1 MDT}

Changes to library/tzdata/America/Chihuahua.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
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/Chihuahua) {
    {-9223372036854775808 -25460 0 LMT}
    {-1514739600 -25200 0 MST}
    {-1343066400 -21600 0 CST}
    {-1234807200 -25200 0 MST}
    {-1220292000 -21600 0 CST}
    {-1220292000 -21600 1 MDT}
    {-1207159200 -25200 0 MST}
    {-1191344400 -21600 0 CST}
    {820476000 -21600 0 CST}
    {828864000 -18000 1 CDT}
    {846399600 -21600 0 CST}
    {860313600 -18000 1 CDT}
    {877849200 -21600 0 CST}
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
59
60
61
62
63
64
65




66























































































































































67







-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1554627600 -21600 1 MDT}
    {1572163200 -25200 0 MST}
    {1586077200 -21600 1 MDT}
    {1603612800 -25200 0 MST}
    {1617526800 -21600 1 MDT}
    {1635667200 -25200 0 MST}
    {1648976400 -21600 1 MDT}
    {1667116800 -25200 0 MST}
    {1680426000 -21600 1 MDT}
    {1698566400 -25200 0 MST}
    {1712480400 -21600 1 MDT}
    {1667120400 -21600 0 CST}
    {1730016000 -25200 0 MST}
    {1743930000 -21600 1 MDT}
    {1761465600 -25200 0 MST}
    {1775379600 -21600 1 MDT}
    {1792915200 -25200 0 MST}
    {1806829200 -21600 1 MDT}
    {1824969600 -25200 0 MST}
    {1838278800 -21600 1 MDT}
    {1856419200 -25200 0 MST}
    {1869728400 -21600 1 MDT}
    {1887868800 -25200 0 MST}
    {1901782800 -21600 1 MDT}
    {1919318400 -25200 0 MST}
    {1933232400 -21600 1 MDT}
    {1950768000 -25200 0 MST}
    {1964682000 -21600 1 MDT}
    {1982822400 -25200 0 MST}
    {1996131600 -21600 1 MDT}
    {2014272000 -25200 0 MST}
    {2027581200 -21600 1 MDT}
    {2045721600 -25200 0 MST}
    {2059030800 -21600 1 MDT}
    {2077171200 -25200 0 MST}
    {2091085200 -21600 1 MDT}
    {2108620800 -25200 0 MST}
    {2122534800 -21600 1 MDT}
    {2140070400 -25200 0 MST}
    {2153984400 -21600 1 MDT}
    {2172124800 -25200 0 MST}
    {2185434000 -21600 1 MDT}
    {2203574400 -25200 0 MST}
    {2216883600 -21600 1 MDT}
    {2235024000 -25200 0 MST}
    {2248938000 -21600 1 MDT}
    {2266473600 -25200 0 MST}
    {2280387600 -21600 1 MDT}
    {2297923200 -25200 0 MST}
    {2311837200 -21600 1 MDT}
    {2329372800 -25200 0 MST}
    {2343286800 -21600 1 MDT}
    {2361427200 -25200 0 MST}
    {2374736400 -21600 1 MDT}
    {2392876800 -25200 0 MST}
    {2406186000 -21600 1 MDT}
    {2424326400 -25200 0 MST}
    {2438240400 -21600 1 MDT}
    {2455776000 -25200 0 MST}
    {2469690000 -21600 1 MDT}
    {2487225600 -25200 0 MST}
    {2501139600 -21600 1 MDT}
    {2519280000 -25200 0 MST}
    {2532589200 -21600 1 MDT}
    {2550729600 -25200 0 MST}
    {2564038800 -21600 1 MDT}
    {2582179200 -25200 0 MST}
    {2596093200 -21600 1 MDT}
    {2613628800 -25200 0 MST}
    {2627542800 -21600 1 MDT}
    {2645078400 -25200 0 MST}
    {2658992400 -21600 1 MDT}
    {2676528000 -25200 0 MST}
    {2690442000 -21600 1 MDT}
    {2708582400 -25200 0 MST}
    {2721891600 -21600 1 MDT}
    {2740032000 -25200 0 MST}
    {2753341200 -21600 1 MDT}
    {2771481600 -25200 0 MST}
    {2785395600 -21600 1 MDT}
    {2802931200 -25200 0 MST}
    {2816845200 -21600 1 MDT}
    {2834380800 -25200 0 MST}
    {2848294800 -21600 1 MDT}
    {2866435200 -25200 0 MST}
    {2879744400 -21600 1 MDT}
    {2897884800 -25200 0 MST}
    {2911194000 -21600 1 MDT}
    {2929334400 -25200 0 MST}
    {2942643600 -21600 1 MDT}
    {2960784000 -25200 0 MST}
    {2974698000 -21600 1 MDT}
    {2992233600 -25200 0 MST}
    {3006147600 -21600 1 MDT}
    {3023683200 -25200 0 MST}
    {3037597200 -21600 1 MDT}
    {3055737600 -25200 0 MST}
    {3069046800 -21600 1 MDT}
    {3087187200 -25200 0 MST}
    {3100496400 -21600 1 MDT}
    {3118636800 -25200 0 MST}
    {3132550800 -21600 1 MDT}
    {3150086400 -25200 0 MST}
    {3164000400 -21600 1 MDT}
    {3181536000 -25200 0 MST}
    {3195450000 -21600 1 MDT}
    {3212985600 -25200 0 MST}
    {3226899600 -21600 1 MDT}
    {3245040000 -25200 0 MST}
    {3258349200 -21600 1 MDT}
    {3276489600 -25200 0 MST}
    {3289798800 -21600 1 MDT}
    {3307939200 -25200 0 MST}
    {3321853200 -21600 1 MDT}
    {3339388800 -25200 0 MST}
    {3353302800 -21600 1 MDT}
    {3370838400 -25200 0 MST}
    {3384752400 -21600 1 MDT}
    {3402892800 -25200 0 MST}
    {3416202000 -21600 1 MDT}
    {3434342400 -25200 0 MST}
    {3447651600 -21600 1 MDT}
    {3465792000 -25200 0 MST}
    {3479706000 -21600 1 MDT}
    {3497241600 -25200 0 MST}
    {3511155600 -21600 1 MDT}
    {3528691200 -25200 0 MST}
    {3542605200 -21600 1 MDT}
    {3560140800 -25200 0 MST}
    {3574054800 -21600 1 MDT}
    {3592195200 -25200 0 MST}
    {3605504400 -21600 1 MDT}
    {3623644800 -25200 0 MST}
    {3636954000 -21600 1 MDT}
    {3655094400 -25200 0 MST}
    {3669008400 -21600 1 MDT}
    {3686544000 -25200 0 MST}
    {3700458000 -21600 1 MDT}
    {3717993600 -25200 0 MST}
    {3731907600 -21600 1 MDT}
    {3750048000 -25200 0 MST}
    {3763357200 -21600 1 MDT}
    {3781497600 -25200 0 MST}
    {3794806800 -21600 1 MDT}
    {3812947200 -25200 0 MST}
    {3826256400 -21600 1 MDT}
    {3844396800 -25200 0 MST}
    {3858310800 -21600 1 MDT}
    {3875846400 -25200 0 MST}
    {3889760400 -21600 1 MDT}
    {3907296000 -25200 0 MST}
    {3921210000 -21600 1 MDT}
    {3939350400 -25200 0 MST}
    {3952659600 -21600 1 MDT}
    {3970800000 -25200 0 MST}
    {3984109200 -21600 1 MDT}
    {4002249600 -25200 0 MST}
    {4016163600 -21600 1 MDT}
    {4033699200 -25200 0 MST}
    {4047613200 -21600 1 MDT}
    {4065148800 -25200 0 MST}
    {4079062800 -21600 1 MDT}
    {4096598400 -25200 0 MST}
}

Changes to library/tzdata/America/Coral_Harbour.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Atikokan)]} {
    LoadTimeZoneFile America/Atikokan
if {![info exists TZData(America/Panama)]} {
    LoadTimeZoneFile America/Panama
}
set TZData(:America/Coral_Harbour) $TZData(:America/Atikokan)
set TZData(:America/Coral_Harbour) $TZData(:America/Panama)

Changes to library/tzdata/America/Creston.

1


2
3


4
5
6
7
8
1
2
3


4
5






+
+
-
-
+
+
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Phoenix)]} {
    LoadTimeZoneFile America/Phoenix

set TZData(:America/Creston) {
}
set TZData(:America/Creston) $TZData(:America/Phoenix)
    {-9223372036854775808 -27964 0 LMT}
    {-2713882436 -25200 0 MST}
    {-1680454800 -28800 0 PST}
    {-1627833600 -25200 0 MST}
}

Changes to library/tzdata/America/Curacao.

1


2
3


4
5
6
7
1
2
3


4
5





+
+
-
-
+
+
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico

set TZData(:America/Curacao) {
}
set TZData(:America/Curacao) $TZData(:America/Puerto_Rico)
    {-9223372036854775808 -16547 0 LMT}
    {-1826738653 -16200 0 -0430}
    {-157750200 -14400 0 AST}
}

Changes to library/tzdata/America/Dawson.

1
2
3
4
5
6
7
8
9
10
11
12

13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23












+


+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Dawson) {
    {-9223372036854775808 -33460 0 LMT}
    {-2188996940 -32400 0 YST}
    {-1632056400 -28800 1 YDT}
    {-1615125600 -32400 0 YST}
    {-1596978000 -28800 1 YDT}
    {-1583164800 -32400 0 YST}
    {-880203600 -28800 1 YWT}
    {-769395600 -28800 1 YPT}
    {-765381600 -32400 0 YST}
    {-157734000 -32400 0 YST}
    {-147884400 -25200 1 YDDT}
    {-131554800 -32400 0 YST}
    {120646800 -28800 0 PST}
    {315561600 -28800 0 PST}
    {325677600 -25200 1 PDT}
    {341398800 -28800 0 PST}
    {357127200 -25200 1 PDT}
    {372848400 -28800 0 PST}
    {388576800 -25200 1 PDT}
    {404902800 -28800 0 PST}

Changes to library/tzdata/America/Dominica.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Dominica) $TZData(:America/Port_of_Spain)
set TZData(:America/Dominica) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Grand_Turk.

73
74
75
76
77
78
79
80

81
82
83
84
85
86
87
88
73
74
75
76
77
78
79

80

81
82
83
84
85
86
87







-
+
-







    {1320559200 -18000 0 EST}
    {1331449200 -14400 1 EDT}
    {1352008800 -18000 0 EST}
    {1362898800 -14400 1 EDT}
    {1383458400 -18000 0 EST}
    {1394348400 -14400 1 EDT}
    {1414908000 -18000 0 EST}
    {1425798000 -14400 1 EDT}
    {1425798000 -14400 0 AST}
    {1446361200 -14400 0 AST}
    {1520751600 -14400 0 EDT}
    {1541311200 -18000 0 EST}
    {1552201200 -14400 1 EDT}
    {1572760800 -18000 0 EST}
    {1583650800 -14400 1 EDT}
    {1604210400 -18000 0 EST}
    {1615705200 -14400 1 EDT}

Changes to library/tzdata/America/Grenada.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Grenada) $TZData(:America/Port_of_Spain)
set TZData(:America/Grenada) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Guadeloupe.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Guadeloupe) $TZData(:America/Port_of_Spain)
set TZData(:America/Guadeloupe) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Guyana.

1
2
3
4
5
6
7





8
1
2
3




4
5
6
7
8
9



-
-
-
-
+
+
+
+
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Guyana) {
    {-9223372036854775808 -13960 0 LMT}
    {-1730578040 -13500 0 -0345}
    {176010300 -10800 0 -03}
    {662698800 -14400 0 -04}
    {-9223372036854775808 -13959 0 LMT}
    {-1843589241 -14400 0 -04}
    {-1730577600 -13500 0 -0345}
    {176096700 -10800 0 -03}
    {701841600 -14400 0 -04}
}

Changes to library/tzdata/America/Hermosillo.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
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/Hermosillo) {
    {-9223372036854775808 -26632 0 LMT}
    {-1514739600 -25200 0 MST}
    {-1343066400 -21600 0 CST}
    {-1234807200 -25200 0 MST}
    {-1220292000 -21600 0 CST}
    {-1220292000 -21600 1 MDT}
    {-1207159200 -25200 0 MST}
    {-1191344400 -21600 0 CST}
    {-873828000 -25200 0 MST}
    {-661539600 -28800 0 PST}
    {28800 -25200 0 MST}
    {828867600 -21600 1 MDT}
    {846403200 -25200 0 MST}

Changes to library/tzdata/America/Inuvik.

1
2
3
4
5
6
7
















8
9
10
11
12
13
14
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





-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Inuvik) {
    {-9223372036854775808 0 0 -00}
    {-536457600 -28800 0 PST}
    {-147888000 -21600 1 PDDT}
    {-131558400 -28800 0 PST}
    {73476000 -25200 1 PDT}
    {89197200 -28800 0 PST}
    {104925600 -25200 1 PDT}
    {120646800 -28800 0 PST}
    {136375200 -25200 1 PDT}
    {152096400 -28800 0 PST}
    {167824800 -25200 1 PDT}
    {183546000 -28800 0 PST}
    {199274400 -25200 1 PDT}
    {215600400 -28800 0 PST}
    {230724000 -25200 1 PDT}
    {247050000 -28800 0 PST}
    {262778400 -25200 1 PDT}
    {278499600 -28800 0 PST}
    {294228000 -21600 0 MDT}
    {309945600 -25200 0 MST}
    {315558000 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}

Changes to library/tzdata/America/Iqaluit.

1
2
3
4
5
6
7


8
9














10
11
12
13
14
15
16
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







+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Iqaluit) {
    {-9223372036854775808 0 0 -00}
    {-865296000 -14400 0 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}
    {73465200 -14400 1 EDT}
    {89186400 -18000 0 EST}
    {-147898800 -10800 1 EDDT}
    {-131569200 -18000 0 EST}
    {104914800 -14400 1 EDT}
    {120636000 -18000 0 EST}
    {136364400 -14400 1 EDT}
    {152085600 -18000 0 EST}
    {167814000 -14400 1 EDT}
    {183535200 -18000 0 EST}
    {199263600 -14400 1 EDT}
    {215589600 -18000 0 EST}
    {230713200 -14400 1 EDT}
    {247039200 -18000 0 EST}
    {262767600 -14400 1 EDT}
    {278488800 -18000 0 EST}
    {294217200 -14400 1 EDT}
    {309938400 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}
    {357116400 -14400 1 EDT}
    {372837600 -18000 0 EST}
    {388566000 -14400 1 EDT}
    {404892000 -18000 0 EST}
    {420015600 -14400 1 EDT}

Changes to library/tzdata/America/Kralendijk.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Curacao)]} {
    LoadTimeZoneFile America/Curacao
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Kralendijk) $TZData(:America/Curacao)
set TZData(:America/Kralendijk) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Lower_Princes.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Curacao)]} {
    LoadTimeZoneFile America/Curacao
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Lower_Princes) $TZData(:America/Curacao)
set TZData(:America/Lower_Princes) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Marigot.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Marigot) $TZData(:America/Port_of_Spain)
set TZData(:America/Marigot) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Matamoros.

1
2
3
4

5
6
7
8
9
10
11
1
2
3

4
5
6
7
8
9
10
11



-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Matamoros) {
    {-9223372036854775808 -24000 0 LMT}
    {-9223372036854775808 -23400 0 LMT}
    {-1514743200 -21600 0 CST}
    {568015200 -21600 0 CST}
    {576057600 -18000 1 CDT}
    {594198000 -21600 0 CST}
    {599637600 -21600 0 CST}
    {828864000 -18000 1 CDT}
    {846399600 -21600 0 CST}

Changes to library/tzdata/America/Mazatlan.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
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/Mazatlan) {
    {-9223372036854775808 -25540 0 LMT}
    {-1514739600 -25200 0 MST}
    {-1343066400 -21600 0 CST}
    {-1234807200 -25200 0 MST}
    {-1220292000 -21600 0 CST}
    {-1220292000 -21600 1 MDT}
    {-1207159200 -25200 0 MST}
    {-1191344400 -21600 0 CST}
    {-873828000 -25200 0 MST}
    {-661539600 -28800 0 PST}
    {28800 -25200 0 MST}
    {828867600 -21600 1 MDT}
    {846403200 -25200 0 MST}
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
61
62
63
64
65
66
67


























































































































































68







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1572163200 -25200 0 MST}
    {1586077200 -21600 1 MDT}
    {1603612800 -25200 0 MST}
    {1617526800 -21600 1 MDT}
    {1635667200 -25200 0 MST}
    {1648976400 -21600 1 MDT}
    {1667116800 -25200 0 MST}
    {1680426000 -21600 1 MDT}
    {1698566400 -25200 0 MST}
    {1712480400 -21600 1 MDT}
    {1730016000 -25200 0 MST}
    {1743930000 -21600 1 MDT}
    {1761465600 -25200 0 MST}
    {1775379600 -21600 1 MDT}
    {1792915200 -25200 0 MST}
    {1806829200 -21600 1 MDT}
    {1824969600 -25200 0 MST}
    {1838278800 -21600 1 MDT}
    {1856419200 -25200 0 MST}
    {1869728400 -21600 1 MDT}
    {1887868800 -25200 0 MST}
    {1901782800 -21600 1 MDT}
    {1919318400 -25200 0 MST}
    {1933232400 -21600 1 MDT}
    {1950768000 -25200 0 MST}
    {1964682000 -21600 1 MDT}
    {1982822400 -25200 0 MST}
    {1996131600 -21600 1 MDT}
    {2014272000 -25200 0 MST}
    {2027581200 -21600 1 MDT}
    {2045721600 -25200 0 MST}
    {2059030800 -21600 1 MDT}
    {2077171200 -25200 0 MST}
    {2091085200 -21600 1 MDT}
    {2108620800 -25200 0 MST}
    {2122534800 -21600 1 MDT}
    {2140070400 -25200 0 MST}
    {2153984400 -21600 1 MDT}
    {2172124800 -25200 0 MST}
    {2185434000 -21600 1 MDT}
    {2203574400 -25200 0 MST}
    {2216883600 -21600 1 MDT}
    {2235024000 -25200 0 MST}
    {2248938000 -21600 1 MDT}
    {2266473600 -25200 0 MST}
    {2280387600 -21600 1 MDT}
    {2297923200 -25200 0 MST}
    {2311837200 -21600 1 MDT}
    {2329372800 -25200 0 MST}
    {2343286800 -21600 1 MDT}
    {2361427200 -25200 0 MST}
    {2374736400 -21600 1 MDT}
    {2392876800 -25200 0 MST}
    {2406186000 -21600 1 MDT}
    {2424326400 -25200 0 MST}
    {2438240400 -21600 1 MDT}
    {2455776000 -25200 0 MST}
    {2469690000 -21600 1 MDT}
    {2487225600 -25200 0 MST}
    {2501139600 -21600 1 MDT}
    {2519280000 -25200 0 MST}
    {2532589200 -21600 1 MDT}
    {2550729600 -25200 0 MST}
    {2564038800 -21600 1 MDT}
    {2582179200 -25200 0 MST}
    {2596093200 -21600 1 MDT}
    {2613628800 -25200 0 MST}
    {2627542800 -21600 1 MDT}
    {2645078400 -25200 0 MST}
    {2658992400 -21600 1 MDT}
    {2676528000 -25200 0 MST}
    {2690442000 -21600 1 MDT}
    {2708582400 -25200 0 MST}
    {2721891600 -21600 1 MDT}
    {2740032000 -25200 0 MST}
    {2753341200 -21600 1 MDT}
    {2771481600 -25200 0 MST}
    {2785395600 -21600 1 MDT}
    {2802931200 -25200 0 MST}
    {2816845200 -21600 1 MDT}
    {2834380800 -25200 0 MST}
    {2848294800 -21600 1 MDT}
    {2866435200 -25200 0 MST}
    {2879744400 -21600 1 MDT}
    {2897884800 -25200 0 MST}
    {2911194000 -21600 1 MDT}
    {2929334400 -25200 0 MST}
    {2942643600 -21600 1 MDT}
    {2960784000 -25200 0 MST}
    {2974698000 -21600 1 MDT}
    {2992233600 -25200 0 MST}
    {3006147600 -21600 1 MDT}
    {3023683200 -25200 0 MST}
    {3037597200 -21600 1 MDT}
    {3055737600 -25200 0 MST}
    {3069046800 -21600 1 MDT}
    {3087187200 -25200 0 MST}
    {3100496400 -21600 1 MDT}
    {3118636800 -25200 0 MST}
    {3132550800 -21600 1 MDT}
    {3150086400 -25200 0 MST}
    {3164000400 -21600 1 MDT}
    {3181536000 -25200 0 MST}
    {3195450000 -21600 1 MDT}
    {3212985600 -25200 0 MST}
    {3226899600 -21600 1 MDT}
    {3245040000 -25200 0 MST}
    {3258349200 -21600 1 MDT}
    {3276489600 -25200 0 MST}
    {3289798800 -21600 1 MDT}
    {3307939200 -25200 0 MST}
    {3321853200 -21600 1 MDT}
    {3339388800 -25200 0 MST}
    {3353302800 -21600 1 MDT}
    {3370838400 -25200 0 MST}
    {3384752400 -21600 1 MDT}
    {3402892800 -25200 0 MST}
    {3416202000 -21600 1 MDT}
    {3434342400 -25200 0 MST}
    {3447651600 -21600 1 MDT}
    {3465792000 -25200 0 MST}
    {3479706000 -21600 1 MDT}
    {3497241600 -25200 0 MST}
    {3511155600 -21600 1 MDT}
    {3528691200 -25200 0 MST}
    {3542605200 -21600 1 MDT}
    {3560140800 -25200 0 MST}
    {3574054800 -21600 1 MDT}
    {3592195200 -25200 0 MST}
    {3605504400 -21600 1 MDT}
    {3623644800 -25200 0 MST}
    {3636954000 -21600 1 MDT}
    {3655094400 -25200 0 MST}
    {3669008400 -21600 1 MDT}
    {3686544000 -25200 0 MST}
    {3700458000 -21600 1 MDT}
    {3717993600 -25200 0 MST}
    {3731907600 -21600 1 MDT}
    {3750048000 -25200 0 MST}
    {3763357200 -21600 1 MDT}
    {3781497600 -25200 0 MST}
    {3794806800 -21600 1 MDT}
    {3812947200 -25200 0 MST}
    {3826256400 -21600 1 MDT}
    {3844396800 -25200 0 MST}
    {3858310800 -21600 1 MDT}
    {3875846400 -25200 0 MST}
    {3889760400 -21600 1 MDT}
    {3907296000 -25200 0 MST}
    {3921210000 -21600 1 MDT}
    {3939350400 -25200 0 MST}
    {3952659600 -21600 1 MDT}
    {3970800000 -25200 0 MST}
    {3984109200 -21600 1 MDT}
    {4002249600 -25200 0 MST}
    {4016163600 -21600 1 MDT}
    {4033699200 -25200 0 MST}
    {4047613200 -21600 1 MDT}
    {4065148800 -25200 0 MST}
    {4079062800 -21600 1 MDT}
    {4096598400 -25200 0 MST}
}

Changes to library/tzdata/America/Merida.

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
55
56
57
58
59
60
61


























































































































































62







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1572159600 -21600 0 CST}
    {1586073600 -18000 1 CDT}
    {1603609200 -21600 0 CST}
    {1617523200 -18000 1 CDT}
    {1635663600 -21600 0 CST}
    {1648972800 -18000 1 CDT}
    {1667113200 -21600 0 CST}
    {1680422400 -18000 1 CDT}
    {1698562800 -21600 0 CST}
    {1712476800 -18000 1 CDT}
    {1730012400 -21600 0 CST}
    {1743926400 -18000 1 CDT}
    {1761462000 -21600 0 CST}
    {1775376000 -18000 1 CDT}
    {1792911600 -21600 0 CST}
    {1806825600 -18000 1 CDT}
    {1824966000 -21600 0 CST}
    {1838275200 -18000 1 CDT}
    {1856415600 -21600 0 CST}
    {1869724800 -18000 1 CDT}
    {1887865200 -21600 0 CST}
    {1901779200 -18000 1 CDT}
    {1919314800 -21600 0 CST}
    {1933228800 -18000 1 CDT}
    {1950764400 -21600 0 CST}
    {1964678400 -18000 1 CDT}
    {1982818800 -21600 0 CST}
    {1996128000 -18000 1 CDT}
    {2014268400 -21600 0 CST}
    {2027577600 -18000 1 CDT}
    {2045718000 -21600 0 CST}
    {2059027200 -18000 1 CDT}
    {2077167600 -21600 0 CST}
    {2091081600 -18000 1 CDT}
    {2108617200 -21600 0 CST}
    {2122531200 -18000 1 CDT}
    {2140066800 -21600 0 CST}
    {2153980800 -18000 1 CDT}
    {2172121200 -21600 0 CST}
    {2185430400 -18000 1 CDT}
    {2203570800 -21600 0 CST}
    {2216880000 -18000 1 CDT}
    {2235020400 -21600 0 CST}
    {2248934400 -18000 1 CDT}
    {2266470000 -21600 0 CST}
    {2280384000 -18000 1 CDT}
    {2297919600 -21600 0 CST}
    {2311833600 -18000 1 CDT}
    {2329369200 -21600 0 CST}
    {2343283200 -18000 1 CDT}
    {2361423600 -21600 0 CST}
    {2374732800 -18000 1 CDT}
    {2392873200 -21600 0 CST}
    {2406182400 -18000 1 CDT}
    {2424322800 -21600 0 CST}
    {2438236800 -18000 1 CDT}
    {2455772400 -21600 0 CST}
    {2469686400 -18000 1 CDT}
    {2487222000 -21600 0 CST}
    {2501136000 -18000 1 CDT}
    {2519276400 -21600 0 CST}
    {2532585600 -18000 1 CDT}
    {2550726000 -21600 0 CST}
    {2564035200 -18000 1 CDT}
    {2582175600 -21600 0 CST}
    {2596089600 -18000 1 CDT}
    {2613625200 -21600 0 CST}
    {2627539200 -18000 1 CDT}
    {2645074800 -21600 0 CST}
    {2658988800 -18000 1 CDT}
    {2676524400 -21600 0 CST}
    {2690438400 -18000 1 CDT}
    {2708578800 -21600 0 CST}
    {2721888000 -18000 1 CDT}
    {2740028400 -21600 0 CST}
    {2753337600 -18000 1 CDT}
    {2771478000 -21600 0 CST}
    {2785392000 -18000 1 CDT}
    {2802927600 -21600 0 CST}
    {2816841600 -18000 1 CDT}
    {2834377200 -21600 0 CST}
    {2848291200 -18000 1 CDT}
    {2866431600 -21600 0 CST}
    {2879740800 -18000 1 CDT}
    {2897881200 -21600 0 CST}
    {2911190400 -18000 1 CDT}
    {2929330800 -21600 0 CST}
    {2942640000 -18000 1 CDT}
    {2960780400 -21600 0 CST}
    {2974694400 -18000 1 CDT}
    {2992230000 -21600 0 CST}
    {3006144000 -18000 1 CDT}
    {3023679600 -21600 0 CST}
    {3037593600 -18000 1 CDT}
    {3055734000 -21600 0 CST}
    {3069043200 -18000 1 CDT}
    {3087183600 -21600 0 CST}
    {3100492800 -18000 1 CDT}
    {3118633200 -21600 0 CST}
    {3132547200 -18000 1 CDT}
    {3150082800 -21600 0 CST}
    {3163996800 -18000 1 CDT}
    {3181532400 -21600 0 CST}
    {3195446400 -18000 1 CDT}
    {3212982000 -21600 0 CST}
    {3226896000 -18000 1 CDT}
    {3245036400 -21600 0 CST}
    {3258345600 -18000 1 CDT}
    {3276486000 -21600 0 CST}
    {3289795200 -18000 1 CDT}
    {3307935600 -21600 0 CST}
    {3321849600 -18000 1 CDT}
    {3339385200 -21600 0 CST}
    {3353299200 -18000 1 CDT}
    {3370834800 -21600 0 CST}
    {3384748800 -18000 1 CDT}
    {3402889200 -21600 0 CST}
    {3416198400 -18000 1 CDT}
    {3434338800 -21600 0 CST}
    {3447648000 -18000 1 CDT}
    {3465788400 -21600 0 CST}
    {3479702400 -18000 1 CDT}
    {3497238000 -21600 0 CST}
    {3511152000 -18000 1 CDT}
    {3528687600 -21600 0 CST}
    {3542601600 -18000 1 CDT}
    {3560137200 -21600 0 CST}
    {3574051200 -18000 1 CDT}
    {3592191600 -21600 0 CST}
    {3605500800 -18000 1 CDT}
    {3623641200 -21600 0 CST}
    {3636950400 -18000 1 CDT}
    {3655090800 -21600 0 CST}
    {3669004800 -18000 1 CDT}
    {3686540400 -21600 0 CST}
    {3700454400 -18000 1 CDT}
    {3717990000 -21600 0 CST}
    {3731904000 -18000 1 CDT}
    {3750044400 -21600 0 CST}
    {3763353600 -18000 1 CDT}
    {3781494000 -21600 0 CST}
    {3794803200 -18000 1 CDT}
    {3812943600 -21600 0 CST}
    {3826252800 -18000 1 CDT}
    {3844393200 -21600 0 CST}
    {3858307200 -18000 1 CDT}
    {3875842800 -21600 0 CST}
    {3889756800 -18000 1 CDT}
    {3907292400 -21600 0 CST}
    {3921206400 -18000 1 CDT}
    {3939346800 -21600 0 CST}
    {3952656000 -18000 1 CDT}
    {3970796400 -21600 0 CST}
    {3984105600 -18000 1 CDT}
    {4002246000 -21600 0 CST}
    {4016160000 -18000 1 CDT}
    {4033695600 -21600 0 CST}
    {4047609600 -18000 1 CDT}
    {4065145200 -21600 0 CST}
    {4079059200 -18000 1 CDT}
    {4096594800 -21600 0 CST}
}

Changes to library/tzdata/America/Mexico_City.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
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/Mexico_City) {
    {-9223372036854775808 -23796 0 LMT}
    {-1514739600 -25200 0 MST}
    {-1343066400 -21600 0 CST}
    {-1234807200 -25200 0 MST}
    {-1220292000 -21600 0 CST}
    {-1220292000 -21600 1 MDT}
    {-1207159200 -25200 0 MST}
    {-1191344400 -21600 0 CST}
    {-975261600 -18000 1 CDT}
    {-963169200 -21600 0 CST}
    {-917114400 -18000 1 CDT}
    {-907354800 -21600 0 CST}
    {-821901600 -18000 1 CWT}
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
67
68
69
70
71
72
73


























































































































































74







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1572159600 -21600 0 CST}
    {1586073600 -18000 1 CDT}
    {1603609200 -21600 0 CST}
    {1617523200 -18000 1 CDT}
    {1635663600 -21600 0 CST}
    {1648972800 -18000 1 CDT}
    {1667113200 -21600 0 CST}
    {1680422400 -18000 1 CDT}
    {1698562800 -21600 0 CST}
    {1712476800 -18000 1 CDT}
    {1730012400 -21600 0 CST}
    {1743926400 -18000 1 CDT}
    {1761462000 -21600 0 CST}
    {1775376000 -18000 1 CDT}
    {1792911600 -21600 0 CST}
    {1806825600 -18000 1 CDT}
    {1824966000 -21600 0 CST}
    {1838275200 -18000 1 CDT}
    {1856415600 -21600 0 CST}
    {1869724800 -18000 1 CDT}
    {1887865200 -21600 0 CST}
    {1901779200 -18000 1 CDT}
    {1919314800 -21600 0 CST}
    {1933228800 -18000 1 CDT}
    {1950764400 -21600 0 CST}
    {1964678400 -18000 1 CDT}
    {1982818800 -21600 0 CST}
    {1996128000 -18000 1 CDT}
    {2014268400 -21600 0 CST}
    {2027577600 -18000 1 CDT}
    {2045718000 -21600 0 CST}
    {2059027200 -18000 1 CDT}
    {2077167600 -21600 0 CST}
    {2091081600 -18000 1 CDT}
    {2108617200 -21600 0 CST}
    {2122531200 -18000 1 CDT}
    {2140066800 -21600 0 CST}
    {2153980800 -18000 1 CDT}
    {2172121200 -21600 0 CST}
    {2185430400 -18000 1 CDT}
    {2203570800 -21600 0 CST}
    {2216880000 -18000 1 CDT}
    {2235020400 -21600 0 CST}
    {2248934400 -18000 1 CDT}
    {2266470000 -21600 0 CST}
    {2280384000 -18000 1 CDT}
    {2297919600 -21600 0 CST}
    {2311833600 -18000 1 CDT}
    {2329369200 -21600 0 CST}
    {2343283200 -18000 1 CDT}
    {2361423600 -21600 0 CST}
    {2374732800 -18000 1 CDT}
    {2392873200 -21600 0 CST}
    {2406182400 -18000 1 CDT}
    {2424322800 -21600 0 CST}
    {2438236800 -18000 1 CDT}
    {2455772400 -21600 0 CST}
    {2469686400 -18000 1 CDT}
    {2487222000 -21600 0 CST}
    {2501136000 -18000 1 CDT}
    {2519276400 -21600 0 CST}
    {2532585600 -18000 1 CDT}
    {2550726000 -21600 0 CST}
    {2564035200 -18000 1 CDT}
    {2582175600 -21600 0 CST}
    {2596089600 -18000 1 CDT}
    {2613625200 -21600 0 CST}
    {2627539200 -18000 1 CDT}
    {2645074800 -21600 0 CST}
    {2658988800 -18000 1 CDT}
    {2676524400 -21600 0 CST}
    {2690438400 -18000 1 CDT}
    {2708578800 -21600 0 CST}
    {2721888000 -18000 1 CDT}
    {2740028400 -21600 0 CST}
    {2753337600 -18000 1 CDT}
    {2771478000 -21600 0 CST}
    {2785392000 -18000 1 CDT}
    {2802927600 -21600 0 CST}
    {2816841600 -18000 1 CDT}
    {2834377200 -21600 0 CST}
    {2848291200 -18000 1 CDT}
    {2866431600 -21600 0 CST}
    {2879740800 -18000 1 CDT}
    {2897881200 -21600 0 CST}
    {2911190400 -18000 1 CDT}
    {2929330800 -21600 0 CST}
    {2942640000 -18000 1 CDT}
    {2960780400 -21600 0 CST}
    {2974694400 -18000 1 CDT}
    {2992230000 -21600 0 CST}
    {3006144000 -18000 1 CDT}
    {3023679600 -21600 0 CST}
    {3037593600 -18000 1 CDT}
    {3055734000 -21600 0 CST}
    {3069043200 -18000 1 CDT}
    {3087183600 -21600 0 CST}
    {3100492800 -18000 1 CDT}
    {3118633200 -21600 0 CST}
    {3132547200 -18000 1 CDT}
    {3150082800 -21600 0 CST}
    {3163996800 -18000 1 CDT}
    {3181532400 -21600 0 CST}
    {3195446400 -18000 1 CDT}
    {3212982000 -21600 0 CST}
    {3226896000 -18000 1 CDT}
    {3245036400 -21600 0 CST}
    {3258345600 -18000 1 CDT}
    {3276486000 -21600 0 CST}
    {3289795200 -18000 1 CDT}
    {3307935600 -21600 0 CST}
    {3321849600 -18000 1 CDT}
    {3339385200 -21600 0 CST}
    {3353299200 -18000 1 CDT}
    {3370834800 -21600 0 CST}
    {3384748800 -18000 1 CDT}
    {3402889200 -21600 0 CST}
    {3416198400 -18000 1 CDT}
    {3434338800 -21600 0 CST}
    {3447648000 -18000 1 CDT}
    {3465788400 -21600 0 CST}
    {3479702400 -18000 1 CDT}
    {3497238000 -21600 0 CST}
    {3511152000 -18000 1 CDT}
    {3528687600 -21600 0 CST}
    {3542601600 -18000 1 CDT}
    {3560137200 -21600 0 CST}
    {3574051200 -18000 1 CDT}
    {3592191600 -21600 0 CST}
    {3605500800 -18000 1 CDT}
    {3623641200 -21600 0 CST}
    {3636950400 -18000 1 CDT}
    {3655090800 -21600 0 CST}
    {3669004800 -18000 1 CDT}
    {3686540400 -21600 0 CST}
    {3700454400 -18000 1 CDT}
    {3717990000 -21600 0 CST}
    {3731904000 -18000 1 CDT}
    {3750044400 -21600 0 CST}
    {3763353600 -18000 1 CDT}
    {3781494000 -21600 0 CST}
    {3794803200 -18000 1 CDT}
    {3812943600 -21600 0 CST}
    {3826252800 -18000 1 CDT}
    {3844393200 -21600 0 CST}
    {3858307200 -18000 1 CDT}
    {3875842800 -21600 0 CST}
    {3889756800 -18000 1 CDT}
    {3907292400 -21600 0 CST}
    {3921206400 -18000 1 CDT}
    {3939346800 -21600 0 CST}
    {3952656000 -18000 1 CDT}
    {3970796400 -21600 0 CST}
    {3984105600 -18000 1 CDT}
    {4002246000 -21600 0 CST}
    {4016160000 -18000 1 CDT}
    {4033695600 -21600 0 CST}
    {4047609600 -18000 1 CDT}
    {4065145200 -21600 0 CST}
    {4079059200 -18000 1 CDT}
    {4096594800 -21600 0 CST}
}

Changes to library/tzdata/America/Monterrey.

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
57
58
59
60
61
62
63


























































































































































64







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1572159600 -21600 0 CST}
    {1586073600 -18000 1 CDT}
    {1603609200 -21600 0 CST}
    {1617523200 -18000 1 CDT}
    {1635663600 -21600 0 CST}
    {1648972800 -18000 1 CDT}
    {1667113200 -21600 0 CST}
    {1680422400 -18000 1 CDT}
    {1698562800 -21600 0 CST}
    {1712476800 -18000 1 CDT}
    {1730012400 -21600 0 CST}
    {1743926400 -18000 1 CDT}
    {1761462000 -21600 0 CST}
    {1775376000 -18000 1 CDT}
    {1792911600 -21600 0 CST}
    {1806825600 -18000 1 CDT}
    {1824966000 -21600 0 CST}
    {1838275200 -18000 1 CDT}
    {1856415600 -21600 0 CST}
    {1869724800 -18000 1 CDT}
    {1887865200 -21600 0 CST}
    {1901779200 -18000 1 CDT}
    {1919314800 -21600 0 CST}
    {1933228800 -18000 1 CDT}
    {1950764400 -21600 0 CST}
    {1964678400 -18000 1 CDT}
    {1982818800 -21600 0 CST}
    {1996128000 -18000 1 CDT}
    {2014268400 -21600 0 CST}
    {2027577600 -18000 1 CDT}
    {2045718000 -21600 0 CST}
    {2059027200 -18000 1 CDT}
    {2077167600 -21600 0 CST}
    {2091081600 -18000 1 CDT}
    {2108617200 -21600 0 CST}
    {2122531200 -18000 1 CDT}
    {2140066800 -21600 0 CST}
    {2153980800 -18000 1 CDT}
    {2172121200 -21600 0 CST}
    {2185430400 -18000 1 CDT}
    {2203570800 -21600 0 CST}
    {2216880000 -18000 1 CDT}
    {2235020400 -21600 0 CST}
    {2248934400 -18000 1 CDT}
    {2266470000 -21600 0 CST}
    {2280384000 -18000 1 CDT}
    {2297919600 -21600 0 CST}
    {2311833600 -18000 1 CDT}
    {2329369200 -21600 0 CST}
    {2343283200 -18000 1 CDT}
    {2361423600 -21600 0 CST}
    {2374732800 -18000 1 CDT}
    {2392873200 -21600 0 CST}
    {2406182400 -18000 1 CDT}
    {2424322800 -21600 0 CST}
    {2438236800 -18000 1 CDT}
    {2455772400 -21600 0 CST}
    {2469686400 -18000 1 CDT}
    {2487222000 -21600 0 CST}
    {2501136000 -18000 1 CDT}
    {2519276400 -21600 0 CST}
    {2532585600 -18000 1 CDT}
    {2550726000 -21600 0 CST}
    {2564035200 -18000 1 CDT}
    {2582175600 -21600 0 CST}
    {2596089600 -18000 1 CDT}
    {2613625200 -21600 0 CST}
    {2627539200 -18000 1 CDT}
    {2645074800 -21600 0 CST}
    {2658988800 -18000 1 CDT}
    {2676524400 -21600 0 CST}
    {2690438400 -18000 1 CDT}
    {2708578800 -21600 0 CST}
    {2721888000 -18000 1 CDT}
    {2740028400 -21600 0 CST}
    {2753337600 -18000 1 CDT}
    {2771478000 -21600 0 CST}
    {2785392000 -18000 1 CDT}
    {2802927600 -21600 0 CST}
    {2816841600 -18000 1 CDT}
    {2834377200 -21600 0 CST}
    {2848291200 -18000 1 CDT}
    {2866431600 -21600 0 CST}
    {2879740800 -18000 1 CDT}
    {2897881200 -21600 0 CST}
    {2911190400 -18000 1 CDT}
    {2929330800 -21600 0 CST}
    {2942640000 -18000 1 CDT}
    {2960780400 -21600 0 CST}
    {2974694400 -18000 1 CDT}
    {2992230000 -21600 0 CST}
    {3006144000 -18000 1 CDT}
    {3023679600 -21600 0 CST}
    {3037593600 -18000 1 CDT}
    {3055734000 -21600 0 CST}
    {3069043200 -18000 1 CDT}
    {3087183600 -21600 0 CST}
    {3100492800 -18000 1 CDT}
    {3118633200 -21600 0 CST}
    {3132547200 -18000 1 CDT}
    {3150082800 -21600 0 CST}
    {3163996800 -18000 1 CDT}
    {3181532400 -21600 0 CST}
    {3195446400 -18000 1 CDT}
    {3212982000 -21600 0 CST}
    {3226896000 -18000 1 CDT}
    {3245036400 -21600 0 CST}
    {3258345600 -18000 1 CDT}
    {3276486000 -21600 0 CST}
    {3289795200 -18000 1 CDT}
    {3307935600 -21600 0 CST}
    {3321849600 -18000 1 CDT}
    {3339385200 -21600 0 CST}
    {3353299200 -18000 1 CDT}
    {3370834800 -21600 0 CST}
    {3384748800 -18000 1 CDT}
    {3402889200 -21600 0 CST}
    {3416198400 -18000 1 CDT}
    {3434338800 -21600 0 CST}
    {3447648000 -18000 1 CDT}
    {3465788400 -21600 0 CST}
    {3479702400 -18000 1 CDT}
    {3497238000 -21600 0 CST}
    {3511152000 -18000 1 CDT}
    {3528687600 -21600 0 CST}
    {3542601600 -18000 1 CDT}
    {3560137200 -21600 0 CST}
    {3574051200 -18000 1 CDT}
    {3592191600 -21600 0 CST}
    {3605500800 -18000 1 CDT}
    {3623641200 -21600 0 CST}
    {3636950400 -18000 1 CDT}
    {3655090800 -21600 0 CST}
    {3669004800 -18000 1 CDT}
    {3686540400 -21600 0 CST}
    {3700454400 -18000 1 CDT}
    {3717990000 -21600 0 CST}
    {3731904000 -18000 1 CDT}
    {3750044400 -21600 0 CST}
    {3763353600 -18000 1 CDT}
    {3781494000 -21600 0 CST}
    {3794803200 -18000 1 CDT}
    {3812943600 -21600 0 CST}
    {3826252800 -18000 1 CDT}
    {3844393200 -21600 0 CST}
    {3858307200 -18000 1 CDT}
    {3875842800 -21600 0 CST}
    {3889756800 -18000 1 CDT}
    {3907292400 -21600 0 CST}
    {3921206400 -18000 1 CDT}
    {3939346800 -21600 0 CST}
    {3952656000 -18000 1 CDT}
    {3970796400 -21600 0 CST}
    {3984105600 -18000 1 CDT}
    {4002246000 -21600 0 CST}
    {4016160000 -18000 1 CDT}
    {4033695600 -21600 0 CST}
    {4047609600 -18000 1 CDT}
    {4065145200 -21600 0 CST}
    {4079059200 -18000 1 CDT}
    {4096594800 -21600 0 CST}
}

Changes to library/tzdata/America/Montserrat.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Montserrat) $TZData(:America/Port_of_Spain)
set TZData(:America/Montserrat) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Nassau.

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
1
2
3


4
5





















































































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Toronto)]} {
    LoadTimeZoneFile America/Toronto

set TZData(:America/Nassau) {
}
set TZData(:America/Nassau) $TZData(:America/Toronto)
    {-9223372036854775808 -18570 0 LMT}
    {-1825095030 -18000 0 EST}
    {-179341200 -14400 1 EDT}
    {-163620000 -18000 0 EST}
    {-147891600 -14400 1 EDT}
    {-131565600 -18000 0 EST}
    {-116442000 -14400 1 EDT}
    {-100116000 -18000 0 EST}
    {-84387600 -14400 1 EDT}
    {-68666400 -18000 0 EST}
    {-52938000 -14400 1 EDT}
    {-37216800 -18000 0 EST}
    {-21488400 -14400 1 EDT}
    {-5767200 -18000 0 EST}
    {9961200 -14400 1 EDT}
    {25682400 -18000 0 EST}
    {41410800 -14400 1 EDT}
    {57736800 -18000 0 EST}
    {73465200 -14400 1 EDT}
    {89186400 -18000 0 EST}
    {104914800 -14400 1 EDT}
    {120636000 -18000 0 EST}
    {136364400 -14400 1 EDT}
    {152085600 -18000 0 EST}
    {167814000 -14400 1 EDT}
    {183535200 -18000 0 EST}
    {189320400 -18000 0 EST}
    {199263600 -14400 1 EDT}
    {215589600 -18000 0 EST}
    {230713200 -14400 1 EDT}
    {247039200 -18000 0 EST}
    {262767600 -14400 1 EDT}
    {278488800 -18000 0 EST}
    {294217200 -14400 1 EDT}
    {309938400 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}
    {357116400 -14400 1 EDT}
    {372837600 -18000 0 EST}
    {388566000 -14400 1 EDT}
    {404892000 -18000 0 EST}
    {420015600 -14400 1 EDT}
    {436341600 -18000 0 EST}
    {452070000 -14400 1 EDT}
    {467791200 -18000 0 EST}
    {483519600 -14400 1 EDT}
    {499240800 -18000 0 EST}
    {514969200 -14400 1 EDT}
    {530690400 -18000 0 EST}
    {544604400 -14400 1 EDT}
    {562140000 -18000 0 EST}
    {576054000 -14400 1 EDT}
    {594194400 -18000 0 EST}
    {607503600 -14400 1 EDT}
    {625644000 -18000 0 EST}
    {638953200 -14400 1 EDT}
    {657093600 -18000 0 EST}
    {671007600 -14400 1 EDT}
    {688543200 -18000 0 EST}
    {702457200 -14400 1 EDT}
    {719992800 -18000 0 EST}
    {733906800 -14400 1 EDT}
    {752047200 -18000 0 EST}
    {765356400 -14400 1 EDT}
    {783496800 -18000 0 EST}
    {796806000 -14400 1 EDT}
    {814946400 -18000 0 EST}
    {828860400 -14400 1 EDT}
    {846396000 -18000 0 EST}
    {860310000 -14400 1 EDT}
    {877845600 -18000 0 EST}
    {891759600 -14400 1 EDT}
    {909295200 -18000 0 EST}
    {923209200 -14400 1 EDT}
    {941349600 -18000 0 EST}
    {954658800 -14400 1 EDT}
    {972799200 -18000 0 EST}
    {986108400 -14400 1 EDT}
    {1004248800 -18000 0 EST}
    {1018162800 -14400 1 EDT}
    {1035698400 -18000 0 EST}
    {1049612400 -14400 1 EDT}
    {1067148000 -18000 0 EST}
    {1081062000 -14400 1 EDT}
    {1099202400 -18000 0 EST}
    {1112511600 -14400 1 EDT}
    {1130652000 -18000 0 EST}
    {1143961200 -14400 1 EDT}
    {1162101600 -18000 0 EST}
    {1173596400 -14400 1 EDT}
    {1194156000 -18000 0 EST}
    {1205046000 -14400 1 EDT}
    {1225605600 -18000 0 EST}
    {1236495600 -14400 1 EDT}
    {1257055200 -18000 0 EST}
    {1268550000 -14400 1 EDT}
    {1289109600 -18000 0 EST}
    {1299999600 -14400 1 EDT}
    {1320559200 -18000 0 EST}
    {1331449200 -14400 1 EDT}
    {1352008800 -18000 0 EST}
    {1362898800 -14400 1 EDT}
    {1383458400 -18000 0 EST}
    {1394348400 -14400 1 EDT}
    {1414908000 -18000 0 EST}
    {1425798000 -14400 1 EDT}
    {1446357600 -18000 0 EST}
    {1457852400 -14400 1 EDT}
    {1478412000 -18000 0 EST}
    {1489302000 -14400 1 EDT}
    {1509861600 -18000 0 EST}
    {1520751600 -14400 1 EDT}
    {1541311200 -18000 0 EST}
    {1552201200 -14400 1 EDT}
    {1572760800 -18000 0 EST}
    {1583650800 -14400 1 EDT}
    {1604210400 -18000 0 EST}
    {1615705200 -14400 1 EDT}
    {1636264800 -18000 0 EST}
    {1647154800 -14400 1 EDT}
    {1667714400 -18000 0 EST}
    {1678604400 -14400 1 EDT}
    {1699164000 -18000 0 EST}
    {1710054000 -14400 1 EDT}
    {1730613600 -18000 0 EST}
    {1741503600 -14400 1 EDT}
    {1762063200 -18000 0 EST}
    {1772953200 -14400 1 EDT}
    {1793512800 -18000 0 EST}
    {1805007600 -14400 1 EDT}
    {1825567200 -18000 0 EST}
    {1836457200 -14400 1 EDT}
    {1857016800 -18000 0 EST}
    {1867906800 -14400 1 EDT}
    {1888466400 -18000 0 EST}
    {1899356400 -14400 1 EDT}
    {1919916000 -18000 0 EST}
    {1930806000 -14400 1 EDT}
    {1951365600 -18000 0 EST}
    {1962860400 -14400 1 EDT}
    {1983420000 -18000 0 EST}
    {1994310000 -14400 1 EDT}
    {2014869600 -18000 0 EST}
    {2025759600 -14400 1 EDT}
    {2046319200 -18000 0 EST}
    {2057209200 -14400 1 EDT}
    {2077768800 -18000 0 EST}
    {2088658800 -14400 1 EDT}
    {2109218400 -18000 0 EST}
    {2120108400 -14400 1 EDT}
    {2140668000 -18000 0 EST}
    {2152162800 -14400 1 EDT}
    {2172722400 -18000 0 EST}
    {2183612400 -14400 1 EDT}
    {2204172000 -18000 0 EST}
    {2215062000 -14400 1 EDT}
    {2235621600 -18000 0 EST}
    {2246511600 -14400 1 EDT}
    {2267071200 -18000 0 EST}
    {2277961200 -14400 1 EDT}
    {2298520800 -18000 0 EST}
    {2309410800 -14400 1 EDT}
    {2329970400 -18000 0 EST}
    {2341465200 -14400 1 EDT}
    {2362024800 -18000 0 EST}
    {2372914800 -14400 1 EDT}
    {2393474400 -18000 0 EST}
    {2404364400 -14400 1 EDT}
    {2424924000 -18000 0 EST}
    {2435814000 -14400 1 EDT}
    {2456373600 -18000 0 EST}
    {2467263600 -14400 1 EDT}
    {2487823200 -18000 0 EST}
    {2499318000 -14400 1 EDT}
    {2519877600 -18000 0 EST}
    {2530767600 -14400 1 EDT}
    {2551327200 -18000 0 EST}
    {2562217200 -14400 1 EDT}
    {2582776800 -18000 0 EST}
    {2593666800 -14400 1 EDT}
    {2614226400 -18000 0 EST}
    {2625116400 -14400 1 EDT}
    {2645676000 -18000 0 EST}
    {2656566000 -14400 1 EDT}
    {2677125600 -18000 0 EST}
    {2688620400 -14400 1 EDT}
    {2709180000 -18000 0 EST}
    {2720070000 -14400 1 EDT}
    {2740629600 -18000 0 EST}
    {2751519600 -14400 1 EDT}
    {2772079200 -18000 0 EST}
    {2782969200 -14400 1 EDT}
    {2803528800 -18000 0 EST}
    {2814418800 -14400 1 EDT}
    {2834978400 -18000 0 EST}
    {2846473200 -14400 1 EDT}
    {2867032800 -18000 0 EST}
    {2877922800 -14400 1 EDT}
    {2898482400 -18000 0 EST}
    {2909372400 -14400 1 EDT}
    {2929932000 -18000 0 EST}
    {2940822000 -14400 1 EDT}
    {2961381600 -18000 0 EST}
    {2972271600 -14400 1 EDT}
    {2992831200 -18000 0 EST}
    {3003721200 -14400 1 EDT}
    {3024280800 -18000 0 EST}
    {3035775600 -14400 1 EDT}
    {3056335200 -18000 0 EST}
    {3067225200 -14400 1 EDT}
    {3087784800 -18000 0 EST}
    {3098674800 -14400 1 EDT}
    {3119234400 -18000 0 EST}
    {3130124400 -14400 1 EDT}
    {3150684000 -18000 0 EST}
    {3161574000 -14400 1 EDT}
    {3182133600 -18000 0 EST}
    {3193023600 -14400 1 EDT}
    {3213583200 -18000 0 EST}
    {3225078000 -14400 1 EDT}
    {3245637600 -18000 0 EST}
    {3256527600 -14400 1 EDT}
    {3277087200 -18000 0 EST}
    {3287977200 -14400 1 EDT}
    {3308536800 -18000 0 EST}
    {3319426800 -14400 1 EDT}
    {3339986400 -18000 0 EST}
    {3350876400 -14400 1 EDT}
    {3371436000 -18000 0 EST}
    {3382930800 -14400 1 EDT}
    {3403490400 -18000 0 EST}
    {3414380400 -14400 1 EDT}
    {3434940000 -18000 0 EST}
    {3445830000 -14400 1 EDT}
    {3466389600 -18000 0 EST}
    {3477279600 -14400 1 EDT}
    {3497839200 -18000 0 EST}
    {3508729200 -14400 1 EDT}
    {3529288800 -18000 0 EST}
    {3540178800 -14400 1 EDT}
    {3560738400 -18000 0 EST}
    {3572233200 -14400 1 EDT}
    {3592792800 -18000 0 EST}
    {3603682800 -14400 1 EDT}
    {3624242400 -18000 0 EST}
    {3635132400 -14400 1 EDT}
    {3655692000 -18000 0 EST}
    {3666582000 -14400 1 EDT}
    {3687141600 -18000 0 EST}
    {3698031600 -14400 1 EDT}
    {3718591200 -18000 0 EST}
    {3730086000 -14400 1 EDT}
    {3750645600 -18000 0 EST}
    {3761535600 -14400 1 EDT}
    {3782095200 -18000 0 EST}
    {3792985200 -14400 1 EDT}
    {3813544800 -18000 0 EST}
    {3824434800 -14400 1 EDT}
    {3844994400 -18000 0 EST}
    {3855884400 -14400 1 EDT}
    {3876444000 -18000 0 EST}
    {3887334000 -14400 1 EDT}
    {3907893600 -18000 0 EST}
    {3919388400 -14400 1 EDT}
    {3939948000 -18000 0 EST}
    {3950838000 -14400 1 EDT}
    {3971397600 -18000 0 EST}
    {3982287600 -14400 1 EDT}
    {4002847200 -18000 0 EST}
    {4013737200 -14400 1 EDT}
    {4034296800 -18000 0 EST}
    {4045186800 -14400 1 EDT}
    {4065746400 -18000 0 EST}
    {4076636400 -14400 1 EDT}
    {4097196000 -18000 0 EST}
}

Changes to library/tzdata/America/Nipigon.

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
1
2
3


4
5






































































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Toronto)]} {
    LoadTimeZoneFile America/Toronto

set TZData(:America/Nipigon) {
}
set TZData(:America/Nipigon) $TZData(:America/Toronto)
    {-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}
    {183535200 -18000 0 EST}
    {199263600 -14400 1 EDT}
    {215589600 -18000 0 EST}
    {230713200 -14400 1 EDT}
    {247039200 -18000 0 EST}
    {262767600 -14400 1 EDT}
    {278488800 -18000 0 EST}
    {294217200 -14400 1 EDT}
    {309938400 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}
    {357116400 -14400 1 EDT}
    {372837600 -18000 0 EST}
    {388566000 -14400 1 EDT}
    {404892000 -18000 0 EST}
    {420015600 -14400 1 EDT}
    {436341600 -18000 0 EST}
    {452070000 -14400 1 EDT}
    {467791200 -18000 0 EST}
    {483519600 -14400 1 EDT}
    {499240800 -18000 0 EST}
    {514969200 -14400 1 EDT}
    {530690400 -18000 0 EST}
    {544604400 -14400 1 EDT}
    {562140000 -18000 0 EST}
    {576054000 -14400 1 EDT}
    {594194400 -18000 0 EST}
    {607503600 -14400 1 EDT}
    {625644000 -18000 0 EST}
    {638953200 -14400 1 EDT}
    {657093600 -18000 0 EST}
    {671007600 -14400 1 EDT}
    {688543200 -18000 0 EST}
    {702457200 -14400 1 EDT}
    {719992800 -18000 0 EST}
    {733906800 -14400 1 EDT}
    {752047200 -18000 0 EST}
    {765356400 -14400 1 EDT}
    {783496800 -18000 0 EST}
    {796806000 -14400 1 EDT}
    {814946400 -18000 0 EST}
    {828860400 -14400 1 EDT}
    {846396000 -18000 0 EST}
    {860310000 -14400 1 EDT}
    {877845600 -18000 0 EST}
    {891759600 -14400 1 EDT}
    {909295200 -18000 0 EST}
    {923209200 -14400 1 EDT}
    {941349600 -18000 0 EST}
    {954658800 -14400 1 EDT}
    {972799200 -18000 0 EST}
    {986108400 -14400 1 EDT}
    {1004248800 -18000 0 EST}
    {1018162800 -14400 1 EDT}
    {1035698400 -18000 0 EST}
    {1049612400 -14400 1 EDT}
    {1067148000 -18000 0 EST}
    {1081062000 -14400 1 EDT}
    {1099202400 -18000 0 EST}
    {1112511600 -14400 1 EDT}
    {1130652000 -18000 0 EST}
    {1143961200 -14400 1 EDT}
    {1162101600 -18000 0 EST}
    {1173596400 -14400 1 EDT}
    {1194156000 -18000 0 EST}
    {1205046000 -14400 1 EDT}
    {1225605600 -18000 0 EST}
    {1236495600 -14400 1 EDT}
    {1257055200 -18000 0 EST}
    {1268550000 -14400 1 EDT}
    {1289109600 -18000 0 EST}
    {1299999600 -14400 1 EDT}
    {1320559200 -18000 0 EST}
    {1331449200 -14400 1 EDT}
    {1352008800 -18000 0 EST}
    {1362898800 -14400 1 EDT}
    {1383458400 -18000 0 EST}
    {1394348400 -14400 1 EDT}
    {1414908000 -18000 0 EST}
    {1425798000 -14400 1 EDT}
    {1446357600 -18000 0 EST}
    {1457852400 -14400 1 EDT}
    {1478412000 -18000 0 EST}
    {1489302000 -14400 1 EDT}
    {1509861600 -18000 0 EST}
    {1520751600 -14400 1 EDT}
    {1541311200 -18000 0 EST}
    {1552201200 -14400 1 EDT}
    {1572760800 -18000 0 EST}
    {1583650800 -14400 1 EDT}
    {1604210400 -18000 0 EST}
    {1615705200 -14400 1 EDT}
    {1636264800 -18000 0 EST}
    {1647154800 -14400 1 EDT}
    {1667714400 -18000 0 EST}
    {1678604400 -14400 1 EDT}
    {1699164000 -18000 0 EST}
    {1710054000 -14400 1 EDT}
    {1730613600 -18000 0 EST}
    {1741503600 -14400 1 EDT}
    {1762063200 -18000 0 EST}
    {1772953200 -14400 1 EDT}
    {1793512800 -18000 0 EST}
    {1805007600 -14400 1 EDT}
    {1825567200 -18000 0 EST}
    {1836457200 -14400 1 EDT}
    {1857016800 -18000 0 EST}
    {1867906800 -14400 1 EDT}
    {1888466400 -18000 0 EST}
    {1899356400 -14400 1 EDT}
    {1919916000 -18000 0 EST}
    {1930806000 -14400 1 EDT}
    {1951365600 -18000 0 EST}
    {1962860400 -14400 1 EDT}
    {1983420000 -18000 0 EST}
    {1994310000 -14400 1 EDT}
    {2014869600 -18000 0 EST}
    {2025759600 -14400 1 EDT}
    {2046319200 -18000 0 EST}
    {2057209200 -14400 1 EDT}
    {2077768800 -18000 0 EST}
    {2088658800 -14400 1 EDT}
    {2109218400 -18000 0 EST}
    {2120108400 -14400 1 EDT}
    {2140668000 -18000 0 EST}
    {2152162800 -14400 1 EDT}
    {2172722400 -18000 0 EST}
    {2183612400 -14400 1 EDT}
    {2204172000 -18000 0 EST}
    {2215062000 -14400 1 EDT}
    {2235621600 -18000 0 EST}
    {2246511600 -14400 1 EDT}
    {2267071200 -18000 0 EST}
    {2277961200 -14400 1 EDT}
    {2298520800 -18000 0 EST}
    {2309410800 -14400 1 EDT}
    {2329970400 -18000 0 EST}
    {2341465200 -14400 1 EDT}
    {2362024800 -18000 0 EST}
    {2372914800 -14400 1 EDT}
    {2393474400 -18000 0 EST}
    {2404364400 -14400 1 EDT}
    {2424924000 -18000 0 EST}
    {2435814000 -14400 1 EDT}
    {2456373600 -18000 0 EST}
    {2467263600 -14400 1 EDT}
    {2487823200 -18000 0 EST}
    {2499318000 -14400 1 EDT}
    {2519877600 -18000 0 EST}
    {2530767600 -14400 1 EDT}
    {2551327200 -18000 0 EST}
    {2562217200 -14400 1 EDT}
    {2582776800 -18000 0 EST}
    {2593666800 -14400 1 EDT}
    {2614226400 -18000 0 EST}
    {2625116400 -14400 1 EDT}
    {2645676000 -18000 0 EST}
    {2656566000 -14400 1 EDT}
    {2677125600 -18000 0 EST}
    {2688620400 -14400 1 EDT}
    {2709180000 -18000 0 EST}
    {2720070000 -14400 1 EDT}
    {2740629600 -18000 0 EST}
    {2751519600 -14400 1 EDT}
    {2772079200 -18000 0 EST}
    {2782969200 -14400 1 EDT}
    {2803528800 -18000 0 EST}
    {2814418800 -14400 1 EDT}
    {2834978400 -18000 0 EST}
    {2846473200 -14400 1 EDT}
    {2867032800 -18000 0 EST}
    {2877922800 -14400 1 EDT}
    {2898482400 -18000 0 EST}
    {2909372400 -14400 1 EDT}
    {2929932000 -18000 0 EST}
    {2940822000 -14400 1 EDT}
    {2961381600 -18000 0 EST}
    {2972271600 -14400 1 EDT}
    {2992831200 -18000 0 EST}
    {3003721200 -14400 1 EDT}
    {3024280800 -18000 0 EST}
    {3035775600 -14400 1 EDT}
    {3056335200 -18000 0 EST}
    {3067225200 -14400 1 EDT}
    {3087784800 -18000 0 EST}
    {3098674800 -14400 1 EDT}
    {3119234400 -18000 0 EST}
    {3130124400 -14400 1 EDT}
    {3150684000 -18000 0 EST}
    {3161574000 -14400 1 EDT}
    {3182133600 -18000 0 EST}
    {3193023600 -14400 1 EDT}
    {3213583200 -18000 0 EST}
    {3225078000 -14400 1 EDT}
    {3245637600 -18000 0 EST}
    {3256527600 -14400 1 EDT}
    {3277087200 -18000 0 EST}
    {3287977200 -14400 1 EDT}
    {3308536800 -18000 0 EST}
    {3319426800 -14400 1 EDT}
    {3339986400 -18000 0 EST}
    {3350876400 -14400 1 EDT}
    {3371436000 -18000 0 EST}
    {3382930800 -14400 1 EDT}
    {3403490400 -18000 0 EST}
    {3414380400 -14400 1 EDT}
    {3434940000 -18000 0 EST}
    {3445830000 -14400 1 EDT}
    {3466389600 -18000 0 EST}
    {3477279600 -14400 1 EDT}
    {3497839200 -18000 0 EST}
    {3508729200 -14400 1 EDT}
    {3529288800 -18000 0 EST}
    {3540178800 -14400 1 EDT}
    {3560738400 -18000 0 EST}
    {3572233200 -14400 1 EDT}
    {3592792800 -18000 0 EST}
    {3603682800 -14400 1 EDT}
    {3624242400 -18000 0 EST}
    {3635132400 -14400 1 EDT}
    {3655692000 -18000 0 EST}
    {3666582000 -14400 1 EDT}
    {3687141600 -18000 0 EST}
    {3698031600 -14400 1 EDT}
    {3718591200 -18000 0 EST}
    {3730086000 -14400 1 EDT}
    {3750645600 -18000 0 EST}
    {3761535600 -14400 1 EDT}
    {3782095200 -18000 0 EST}
    {3792985200 -14400 1 EDT}
    {3813544800 -18000 0 EST}
    {3824434800 -14400 1 EDT}
    {3844994400 -18000 0 EST}
    {3855884400 -14400 1 EDT}
    {3876444000 -18000 0 EST}
    {3887334000 -14400 1 EDT}
    {3907893600 -18000 0 EST}
    {3919388400 -14400 1 EDT}
    {3939948000 -18000 0 EST}
    {3950838000 -14400 1 EDT}
    {3971397600 -18000 0 EST}
    {3982287600 -14400 1 EDT}
    {4002847200 -18000 0 EST}
    {4013737200 -14400 1 EDT}
    {4034296800 -18000 0 EST}
    {4045186800 -14400 1 EDT}
    {4065746400 -18000 0 EST}
    {4076636400 -14400 1 EDT}
    {4097196000 -18000 0 EST}
}

Changes to library/tzdata/America/Nuuk.

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
85
86
87
88
89
90
91

92

























































































































































93







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1572138000 -10800 0 -03}
    {1585443600 -7200 1 -02}
    {1603587600 -10800 0 -03}
    {1616893200 -7200 1 -02}
    {1635642000 -10800 0 -03}
    {1648342800 -7200 1 -02}
    {1667091600 -10800 0 -03}
    {1679792400 -7200 1 -02}
    {1679792400 -7200 0 -02}
    {1698541200 -10800 0 -03}
    {1711846800 -7200 1 -02}
    {1729990800 -10800 0 -03}
    {1743296400 -7200 1 -02}
    {1761440400 -10800 0 -03}
    {1774746000 -7200 1 -02}
    {1792890000 -10800 0 -03}
    {1806195600 -7200 1 -02}
    {1824944400 -10800 0 -03}
    {1837645200 -7200 1 -02}
    {1856394000 -10800 0 -03}
    {1869094800 -7200 1 -02}
    {1887843600 -10800 0 -03}
    {1901149200 -7200 1 -02}
    {1919293200 -10800 0 -03}
    {1932598800 -7200 1 -02}
    {1950742800 -10800 0 -03}
    {1964048400 -7200 1 -02}
    {1982797200 -10800 0 -03}
    {1995498000 -7200 1 -02}
    {2014246800 -10800 0 -03}
    {2026947600 -7200 1 -02}
    {2045696400 -10800 0 -03}
    {2058397200 -7200 1 -02}
    {2077146000 -10800 0 -03}
    {2090451600 -7200 1 -02}
    {2108595600 -10800 0 -03}
    {2121901200 -7200 1 -02}
    {2140045200 -10800 0 -03}
    {2153350800 -7200 1 -02}
    {2172099600 -10800 0 -03}
    {2184800400 -7200 1 -02}
    {2203549200 -10800 0 -03}
    {2216250000 -7200 1 -02}
    {2234998800 -10800 0 -03}
    {2248304400 -7200 1 -02}
    {2266448400 -10800 0 -03}
    {2279754000 -7200 1 -02}
    {2297898000 -10800 0 -03}
    {2311203600 -7200 1 -02}
    {2329347600 -10800 0 -03}
    {2342653200 -7200 1 -02}
    {2361402000 -10800 0 -03}
    {2374102800 -7200 1 -02}
    {2392851600 -10800 0 -03}
    {2405552400 -7200 1 -02}
    {2424301200 -10800 0 -03}
    {2437606800 -7200 1 -02}
    {2455750800 -10800 0 -03}
    {2469056400 -7200 1 -02}
    {2487200400 -10800 0 -03}
    {2500506000 -7200 1 -02}
    {2519254800 -10800 0 -03}
    {2531955600 -7200 1 -02}
    {2550704400 -10800 0 -03}
    {2563405200 -7200 1 -02}
    {2582154000 -10800 0 -03}
    {2595459600 -7200 1 -02}
    {2613603600 -10800 0 -03}
    {2626909200 -7200 1 -02}
    {2645053200 -10800 0 -03}
    {2658358800 -7200 1 -02}
    {2676502800 -10800 0 -03}
    {2689808400 -7200 1 -02}
    {2708557200 -10800 0 -03}
    {2721258000 -7200 1 -02}
    {2740006800 -10800 0 -03}
    {2752707600 -7200 1 -02}
    {2771456400 -10800 0 -03}
    {2784762000 -7200 1 -02}
    {2802906000 -10800 0 -03}
    {2816211600 -7200 1 -02}
    {2834355600 -10800 0 -03}
    {2847661200 -7200 1 -02}
    {2866410000 -10800 0 -03}
    {2879110800 -7200 1 -02}
    {2897859600 -10800 0 -03}
    {2910560400 -7200 1 -02}
    {2929309200 -10800 0 -03}
    {2942010000 -7200 1 -02}
    {2960758800 -10800 0 -03}
    {2974064400 -7200 1 -02}
    {2992208400 -10800 0 -03}
    {3005514000 -7200 1 -02}
    {3023658000 -10800 0 -03}
    {3036963600 -7200 1 -02}
    {3055712400 -10800 0 -03}
    {3068413200 -7200 1 -02}
    {3087162000 -10800 0 -03}
    {3099862800 -7200 1 -02}
    {3118611600 -10800 0 -03}
    {3131917200 -7200 1 -02}
    {3150061200 -10800 0 -03}
    {3163366800 -7200 1 -02}
    {3181510800 -10800 0 -03}
    {3194816400 -7200 1 -02}
    {3212960400 -10800 0 -03}
    {3226266000 -7200 1 -02}
    {3245014800 -10800 0 -03}
    {3257715600 -7200 1 -02}
    {3276464400 -10800 0 -03}
    {3289165200 -7200 1 -02}
    {3307914000 -10800 0 -03}
    {3321219600 -7200 1 -02}
    {3339363600 -10800 0 -03}
    {3352669200 -7200 1 -02}
    {3370813200 -10800 0 -03}
    {3384118800 -7200 1 -02}
    {3402867600 -10800 0 -03}
    {3415568400 -7200 1 -02}
    {3434317200 -10800 0 -03}
    {3447018000 -7200 1 -02}
    {3465766800 -10800 0 -03}
    {3479072400 -7200 1 -02}
    {3497216400 -10800 0 -03}
    {3510522000 -7200 1 -02}
    {3528666000 -10800 0 -03}
    {3541971600 -7200 1 -02}
    {3560115600 -10800 0 -03}
    {3573421200 -7200 1 -02}
    {3592170000 -10800 0 -03}
    {3604870800 -7200 1 -02}
    {3623619600 -10800 0 -03}
    {3636320400 -7200 1 -02}
    {3655069200 -10800 0 -03}
    {3668374800 -7200 1 -02}
    {3686518800 -10800 0 -03}
    {3699824400 -7200 1 -02}
    {3717968400 -10800 0 -03}
    {3731274000 -7200 1 -02}
    {3750022800 -10800 0 -03}
    {3762723600 -7200 1 -02}
    {3781472400 -10800 0 -03}
    {3794173200 -7200 1 -02}
    {3812922000 -10800 0 -03}
    {3825622800 -7200 1 -02}
    {3844371600 -10800 0 -03}
    {3857677200 -7200 1 -02}
    {3875821200 -10800 0 -03}
    {3889126800 -7200 1 -02}
    {3907270800 -10800 0 -03}
    {3920576400 -7200 1 -02}
    {3939325200 -10800 0 -03}
    {3952026000 -7200 1 -02}
    {3970774800 -10800 0 -03}
    {3983475600 -7200 1 -02}
    {4002224400 -10800 0 -03}
    {4015530000 -7200 1 -02}
    {4033674000 -10800 0 -03}
    {4046979600 -7200 1 -02}
    {4065123600 -10800 0 -03}
    {4078429200 -7200 1 -02}
    {4096573200 -10800 0 -03}
}

Changes to library/tzdata/America/Ojinaga.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
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/Ojinaga) {
    {-9223372036854775808 -25060 0 LMT}
    {-1514739600 -25200 0 MST}
    {-1343066400 -21600 0 CST}
    {-1234807200 -25200 0 MST}
    {-1220292000 -21600 0 CST}
    {-1220292000 -21600 1 MDT}
    {-1207159200 -25200 0 MST}
    {-1191344400 -21600 0 CST}
    {820476000 -21600 0 CST}
    {828864000 -18000 1 CDT}
    {846399600 -21600 0 CST}
    {860313600 -18000 1 CDT}
    {877849200 -21600 0 CST}
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+

    {1552208400 -21600 1 MDT}
    {1572768000 -25200 0 MST}
    {1583658000 -21600 1 MDT}
    {1604217600 -25200 0 MST}
    {1615712400 -21600 1 MDT}
    {1636272000 -25200 0 MST}
    {1647162000 -21600 1 MDT}
    {1667721600 -25200 0 MST}
    {1678611600 -21600 1 MDT}
    {1699171200 -25200 0 MST}
    {1710061200 -21600 1 MDT}
    {1730620800 -25200 0 MST}
    {1741510800 -21600 1 MDT}
    {1762070400 -25200 0 MST}
    {1772960400 -21600 1 MDT}
    {1793520000 -25200 0 MST}
    {1805014800 -21600 1 MDT}
    {1825574400 -25200 0 MST}
    {1836464400 -21600 1 MDT}
    {1857024000 -25200 0 MST}
    {1867914000 -21600 1 MDT}
    {1888473600 -25200 0 MST}
    {1899363600 -21600 1 MDT}
    {1919923200 -25200 0 MST}
    {1930813200 -21600 1 MDT}
    {1951372800 -25200 0 MST}
    {1962867600 -21600 1 MDT}
    {1983427200 -25200 0 MST}
    {1994317200 -21600 1 MDT}
    {2014876800 -25200 0 MST}
    {2025766800 -21600 1 MDT}
    {2046326400 -25200 0 MST}
    {2057216400 -21600 1 MDT}
    {1667120400 -21600 0 CST}
    {1669788000 -21600 0 CST}
    {1678608000 -18000 1 CDT}
    {1699167600 -21600 0 CST}
    {1710057600 -18000 1 CDT}
    {1730617200 -21600 0 CST}
    {1741507200 -18000 1 CDT}
    {1762066800 -21600 0 CST}
    {1772956800 -18000 1 CDT}
    {1793516400 -21600 0 CST}
    {1805011200 -18000 1 CDT}
    {1825570800 -21600 0 CST}
    {1836460800 -18000 1 CDT}
    {1857020400 -21600 0 CST}
    {1867910400 -18000 1 CDT}
    {1888470000 -21600 0 CST}
    {1899360000 -18000 1 CDT}
    {1919919600 -21600 0 CST}
    {1930809600 -18000 1 CDT}
    {1951369200 -21600 0 CST}
    {1962864000 -18000 1 CDT}
    {1983423600 -21600 0 CST}
    {1994313600 -18000 1 CDT}
    {2014873200 -21600 0 CST}
    {2025763200 -18000 1 CDT}
    {2046322800 -21600 0 CST}
    {2057212800 -18000 1 CDT}
    {2077772400 -21600 0 CST}
    {2077776000 -25200 0 MST}
    {2088666000 -21600 1 MDT}
    {2109225600 -25200 0 MST}
    {2120115600 -21600 1 MDT}
    {2140675200 -25200 0 MST}
    {2152170000 -21600 1 MDT}
    {2172729600 -25200 0 MST}
    {2183619600 -21600 1 MDT}
    {2204179200 -25200 0 MST}
    {2215069200 -21600 1 MDT}
    {2235628800 -25200 0 MST}
    {2246518800 -21600 1 MDT}
    {2267078400 -25200 0 MST}
    {2277968400 -21600 1 MDT}
    {2298528000 -25200 0 MST}
    {2309418000 -21600 1 MDT}
    {2329977600 -25200 0 MST}
    {2341472400 -21600 1 MDT}
    {2362032000 -25200 0 MST}
    {2372922000 -21600 1 MDT}
    {2393481600 -25200 0 MST}
    {2404371600 -21600 1 MDT}
    {2424931200 -25200 0 MST}
    {2435821200 -21600 1 MDT}
    {2456380800 -25200 0 MST}
    {2467270800 -21600 1 MDT}
    {2487830400 -25200 0 MST}
    {2499325200 -21600 1 MDT}
    {2519884800 -25200 0 MST}
    {2530774800 -21600 1 MDT}
    {2551334400 -25200 0 MST}
    {2562224400 -21600 1 MDT}
    {2582784000 -25200 0 MST}
    {2593674000 -21600 1 MDT}
    {2614233600 -25200 0 MST}
    {2625123600 -21600 1 MDT}
    {2645683200 -25200 0 MST}
    {2656573200 -21600 1 MDT}
    {2677132800 -25200 0 MST}
    {2688627600 -21600 1 MDT}
    {2709187200 -25200 0 MST}
    {2720077200 -21600 1 MDT}
    {2740636800 -25200 0 MST}
    {2751526800 -21600 1 MDT}
    {2772086400 -25200 0 MST}
    {2782976400 -21600 1 MDT}
    {2803536000 -25200 0 MST}
    {2814426000 -21600 1 MDT}
    {2834985600 -25200 0 MST}
    {2846480400 -21600 1 MDT}
    {2088662400 -18000 1 CDT}
    {2109222000 -21600 0 CST}
    {2120112000 -18000 1 CDT}
    {2140671600 -21600 0 CST}
    {2152166400 -18000 1 CDT}
    {2172726000 -21600 0 CST}
    {2183616000 -18000 1 CDT}
    {2204175600 -21600 0 CST}
    {2215065600 -18000 1 CDT}
    {2235625200 -21600 0 CST}
    {2246515200 -18000 1 CDT}
    {2267074800 -21600 0 CST}
    {2277964800 -18000 1 CDT}
    {2298524400 -21600 0 CST}
    {2309414400 -18000 1 CDT}
    {2329974000 -21600 0 CST}
    {2341468800 -18000 1 CDT}
    {2362028400 -21600 0 CST}
    {2372918400 -18000 1 CDT}
    {2393478000 -21600 0 CST}
    {2404368000 -18000 1 CDT}
    {2424927600 -21600 0 CST}
    {2435817600 -18000 1 CDT}
    {2456377200 -21600 0 CST}
    {2467267200 -18000 1 CDT}
    {2487826800 -21600 0 CST}
    {2499321600 -18000 1 CDT}
    {2519881200 -21600 0 CST}
    {2530771200 -18000 1 CDT}
    {2551330800 -21600 0 CST}
    {2562220800 -18000 1 CDT}
    {2582780400 -21600 0 CST}
    {2593670400 -18000 1 CDT}
    {2614230000 -21600 0 CST}
    {2625120000 -18000 1 CDT}
    {2645679600 -21600 0 CST}
    {2656569600 -18000 1 CDT}
    {2677129200 -21600 0 CST}
    {2688624000 -18000 1 CDT}
    {2709183600 -21600 0 CST}
    {2720073600 -18000 1 CDT}
    {2740633200 -21600 0 CST}
    {2751523200 -18000 1 CDT}
    {2772082800 -21600 0 CST}
    {2782972800 -18000 1 CDT}
    {2803532400 -21600 0 CST}
    {2814422400 -18000 1 CDT}
    {2834982000 -21600 0 CST}
    {2846476800 -18000 1 CDT}
    {2867036400 -21600 0 CST}
    {2867040000 -25200 0 MST}
    {2877930000 -21600 1 MDT}
    {2898489600 -25200 0 MST}
    {2909379600 -21600 1 MDT}
    {2929939200 -25200 0 MST}
    {2940829200 -21600 1 MDT}
    {2961388800 -25200 0 MST}
    {2972278800 -21600 1 MDT}
    {2992838400 -25200 0 MST}
    {3003728400 -21600 1 MDT}
    {3024288000 -25200 0 MST}
    {3035782800 -21600 1 MDT}
    {3056342400 -25200 0 MST}
    {3067232400 -21600 1 MDT}
    {3087792000 -25200 0 MST}
    {3098682000 -21600 1 MDT}
    {3119241600 -25200 0 MST}
    {3130131600 -21600 1 MDT}
    {3150691200 -25200 0 MST}
    {3161581200 -21600 1 MDT}
    {3182140800 -25200 0 MST}
    {3193030800 -21600 1 MDT}
    {3213590400 -25200 0 MST}
    {3225085200 -21600 1 MDT}
    {3245644800 -25200 0 MST}
    {3256534800 -21600 1 MDT}
    {3277094400 -25200 0 MST}
    {3287984400 -21600 1 MDT}
    {3308544000 -25200 0 MST}
    {3319434000 -21600 1 MDT}
    {3339993600 -25200 0 MST}
    {3350883600 -21600 1 MDT}
    {3371443200 -25200 0 MST}
    {3382938000 -21600 1 MDT}
    {3403497600 -25200 0 MST}
    {3414387600 -21600 1 MDT}
    {3434947200 -25200 0 MST}
    {3445837200 -21600 1 MDT}
    {3466396800 -25200 0 MST}
    {3477286800 -21600 1 MDT}
    {3497846400 -25200 0 MST}
    {3508736400 -21600 1 MDT}
    {3529296000 -25200 0 MST}
    {3540186000 -21600 1 MDT}
    {3560745600 -25200 0 MST}
    {3572240400 -21600 1 MDT}
    {3592800000 -25200 0 MST}
    {3603690000 -21600 1 MDT}
    {3624249600 -25200 0 MST}
    {3635139600 -21600 1 MDT}
    {3655699200 -25200 0 MST}
    {3666589200 -21600 1 MDT}
    {3687148800 -25200 0 MST}
    {3698038800 -21600 1 MDT}
    {3718598400 -25200 0 MST}
    {3730093200 -21600 1 MDT}
    {3750652800 -25200 0 MST}
    {3761542800 -21600 1 MDT}
    {3782102400 -25200 0 MST}
    {3792992400 -21600 1 MDT}
    {3813552000 -25200 0 MST}
    {3824442000 -21600 1 MDT}
    {3845001600 -25200 0 MST}
    {3855891600 -21600 1 MDT}
    {3876451200 -25200 0 MST}
    {3887341200 -21600 1 MDT}
    {3907900800 -25200 0 MST}
    {3919395600 -21600 1 MDT}
    {3939955200 -25200 0 MST}
    {3950845200 -21600 1 MDT}
    {3971404800 -25200 0 MST}
    {3982294800 -21600 1 MDT}
    {2877926400 -18000 1 CDT}
    {2898486000 -21600 0 CST}
    {2909376000 -18000 1 CDT}
    {2929935600 -21600 0 CST}
    {2940825600 -18000 1 CDT}
    {2961385200 -21600 0 CST}
    {2972275200 -18000 1 CDT}
    {2992834800 -21600 0 CST}
    {3003724800 -18000 1 CDT}
    {3024284400 -21600 0 CST}
    {3035779200 -18000 1 CDT}
    {3056338800 -21600 0 CST}
    {3067228800 -18000 1 CDT}
    {3087788400 -21600 0 CST}
    {3098678400 -18000 1 CDT}
    {3119238000 -21600 0 CST}
    {3130128000 -18000 1 CDT}
    {3150687600 -21600 0 CST}
    {3161577600 -18000 1 CDT}
    {3182137200 -21600 0 CST}
    {3193027200 -18000 1 CDT}
    {3213586800 -21600 0 CST}
    {3225081600 -18000 1 CDT}
    {3245641200 -21600 0 CST}
    {3256531200 -18000 1 CDT}
    {3277090800 -21600 0 CST}
    {3287980800 -18000 1 CDT}
    {3308540400 -21600 0 CST}
    {3319430400 -18000 1 CDT}
    {3339990000 -21600 0 CST}
    {3350880000 -18000 1 CDT}
    {3371439600 -21600 0 CST}
    {3382934400 -18000 1 CDT}
    {3403494000 -21600 0 CST}
    {3414384000 -18000 1 CDT}
    {3434943600 -21600 0 CST}
    {3445833600 -18000 1 CDT}
    {3466393200 -21600 0 CST}
    {3477283200 -18000 1 CDT}
    {3497842800 -21600 0 CST}
    {3508732800 -18000 1 CDT}
    {3529292400 -21600 0 CST}
    {3540182400 -18000 1 CDT}
    {3560742000 -21600 0 CST}
    {3572236800 -18000 1 CDT}
    {3592796400 -21600 0 CST}
    {3603686400 -18000 1 CDT}
    {3624246000 -21600 0 CST}
    {3635136000 -18000 1 CDT}
    {3655695600 -21600 0 CST}
    {3666585600 -18000 1 CDT}
    {3687145200 -21600 0 CST}
    {3698035200 -18000 1 CDT}
    {3718594800 -21600 0 CST}
    {3730089600 -18000 1 CDT}
    {3750649200 -21600 0 CST}
    {3761539200 -18000 1 CDT}
    {3782098800 -21600 0 CST}
    {3792988800 -18000 1 CDT}
    {3813548400 -21600 0 CST}
    {3824438400 -18000 1 CDT}
    {3844998000 -21600 0 CST}
    {3855888000 -18000 1 CDT}
    {3876447600 -21600 0 CST}
    {3887337600 -18000 1 CDT}
    {3907897200 -21600 0 CST}
    {3919392000 -18000 1 CDT}
    {3939951600 -21600 0 CST}
    {3950841600 -18000 1 CDT}
    {3971401200 -21600 0 CST}
    {3982291200 -18000 1 CDT}
    {4002850800 -21600 0 CST}
    {4002854400 -25200 0 MST}
    {4013744400 -21600 1 MDT}
    {4034304000 -25200 0 MST}
    {4045194000 -21600 1 MDT}
    {4065753600 -25200 0 MST}
    {4076643600 -21600 1 MDT}
    {4097203200 -25200 0 MST}
    {4013740800 -18000 1 CDT}
    {4034300400 -21600 0 CST}
    {4045190400 -18000 1 CDT}
    {4065750000 -21600 0 CST}
    {4076640000 -18000 1 CDT}
    {4097199600 -21600 0 CST}
}

Changes to library/tzdata/America/Pangnirtung.

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
1
2
3


4
5


























































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Iqaluit)]} {
    LoadTimeZoneFile America/Iqaluit

set TZData(:America/Pangnirtung) {
}
set TZData(:America/Pangnirtung) $TZData(:America/Iqaluit)
    {-9223372036854775808 0 0 -00}
    {-1546300800 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {-147902400 -7200 1 ADDT}
    {-131572800 -14400 0 AST}
    {325663200 -10800 1 ADT}
    {341384400 -14400 0 AST}
    {357112800 -10800 1 ADT}
    {372834000 -14400 0 AST}
    {388562400 -10800 1 ADT}
    {404888400 -14400 0 AST}
    {420012000 -10800 1 ADT}
    {436338000 -14400 0 AST}
    {452066400 -10800 1 ADT}
    {467787600 -14400 0 AST}
    {483516000 -10800 1 ADT}
    {499237200 -14400 0 AST}
    {514965600 -10800 1 ADT}
    {530686800 -14400 0 AST}
    {544600800 -10800 1 ADT}
    {562136400 -14400 0 AST}
    {576050400 -10800 1 ADT}
    {594190800 -14400 0 AST}
    {607500000 -10800 1 ADT}
    {625640400 -14400 0 AST}
    {638949600 -10800 1 ADT}
    {657090000 -14400 0 AST}
    {671004000 -10800 1 ADT}
    {688539600 -14400 0 AST}
    {702453600 -10800 1 ADT}
    {719989200 -14400 0 AST}
    {733903200 -10800 1 ADT}
    {752043600 -14400 0 AST}
    {765352800 -10800 1 ADT}
    {783493200 -14400 0 AST}
    {796802400 -18000 0 EST}
    {796806000 -14400 1 EDT}
    {814946400 -18000 0 EST}
    {828860400 -14400 1 EDT}
    {846396000 -18000 0 EST}
    {860310000 -14400 1 EDT}
    {877845600 -18000 0 EST}
    {891759600 -14400 1 EDT}
    {909295200 -18000 0 EST}
    {923209200 -14400 1 EDT}
    {941353200 -21600 0 CST}
    {954662400 -18000 1 CDT}
    {972806400 -18000 0 EST}
    {986108400 -14400 1 EDT}
    {1004248800 -18000 0 EST}
    {1018162800 -14400 1 EDT}
    {1035698400 -18000 0 EST}
    {1049612400 -14400 1 EDT}
    {1067148000 -18000 0 EST}
    {1081062000 -14400 1 EDT}
    {1099202400 -18000 0 EST}
    {1112511600 -14400 1 EDT}
    {1130652000 -18000 0 EST}
    {1143961200 -14400 1 EDT}
    {1162101600 -18000 0 EST}
    {1173596400 -14400 1 EDT}
    {1194156000 -18000 0 EST}
    {1205046000 -14400 1 EDT}
    {1225605600 -18000 0 EST}
    {1236495600 -14400 1 EDT}
    {1257055200 -18000 0 EST}
    {1268550000 -14400 1 EDT}
    {1289109600 -18000 0 EST}
    {1299999600 -14400 1 EDT}
    {1320559200 -18000 0 EST}
    {1331449200 -14400 1 EDT}
    {1352008800 -18000 0 EST}
    {1362898800 -14400 1 EDT}
    {1383458400 -18000 0 EST}
    {1394348400 -14400 1 EDT}
    {1414908000 -18000 0 EST}
    {1425798000 -14400 1 EDT}
    {1446357600 -18000 0 EST}
    {1457852400 -14400 1 EDT}
    {1478412000 -18000 0 EST}
    {1489302000 -14400 1 EDT}
    {1509861600 -18000 0 EST}
    {1520751600 -14400 1 EDT}
    {1541311200 -18000 0 EST}
    {1552201200 -14400 1 EDT}
    {1572760800 -18000 0 EST}
    {1583650800 -14400 1 EDT}
    {1604210400 -18000 0 EST}
    {1615705200 -14400 1 EDT}
    {1636264800 -18000 0 EST}
    {1647154800 -14400 1 EDT}
    {1667714400 -18000 0 EST}
    {1678604400 -14400 1 EDT}
    {1699164000 -18000 0 EST}
    {1710054000 -14400 1 EDT}
    {1730613600 -18000 0 EST}
    {1741503600 -14400 1 EDT}
    {1762063200 -18000 0 EST}
    {1772953200 -14400 1 EDT}
    {1793512800 -18000 0 EST}
    {1805007600 -14400 1 EDT}
    {1825567200 -18000 0 EST}
    {1836457200 -14400 1 EDT}
    {1857016800 -18000 0 EST}
    {1867906800 -14400 1 EDT}
    {1888466400 -18000 0 EST}
    {1899356400 -14400 1 EDT}
    {1919916000 -18000 0 EST}
    {1930806000 -14400 1 EDT}
    {1951365600 -18000 0 EST}
    {1962860400 -14400 1 EDT}
    {1983420000 -18000 0 EST}
    {1994310000 -14400 1 EDT}
    {2014869600 -18000 0 EST}
    {2025759600 -14400 1 EDT}
    {2046319200 -18000 0 EST}
    {2057209200 -14400 1 EDT}
    {2077768800 -18000 0 EST}
    {2088658800 -14400 1 EDT}
    {2109218400 -18000 0 EST}
    {2120108400 -14400 1 EDT}
    {2140668000 -18000 0 EST}
    {2152162800 -14400 1 EDT}
    {2172722400 -18000 0 EST}
    {2183612400 -14400 1 EDT}
    {2204172000 -18000 0 EST}
    {2215062000 -14400 1 EDT}
    {2235621600 -18000 0 EST}
    {2246511600 -14400 1 EDT}
    {2267071200 -18000 0 EST}
    {2277961200 -14400 1 EDT}
    {2298520800 -18000 0 EST}
    {2309410800 -14400 1 EDT}
    {2329970400 -18000 0 EST}
    {2341465200 -14400 1 EDT}
    {2362024800 -18000 0 EST}
    {2372914800 -14400 1 EDT}
    {2393474400 -18000 0 EST}
    {2404364400 -14400 1 EDT}
    {2424924000 -18000 0 EST}
    {2435814000 -14400 1 EDT}
    {2456373600 -18000 0 EST}
    {2467263600 -14400 1 EDT}
    {2487823200 -18000 0 EST}
    {2499318000 -14400 1 EDT}
    {2519877600 -18000 0 EST}
    {2530767600 -14400 1 EDT}
    {2551327200 -18000 0 EST}
    {2562217200 -14400 1 EDT}
    {2582776800 -18000 0 EST}
    {2593666800 -14400 1 EDT}
    {2614226400 -18000 0 EST}
    {2625116400 -14400 1 EDT}
    {2645676000 -18000 0 EST}
    {2656566000 -14400 1 EDT}
    {2677125600 -18000 0 EST}
    {2688620400 -14400 1 EDT}
    {2709180000 -18000 0 EST}
    {2720070000 -14400 1 EDT}
    {2740629600 -18000 0 EST}
    {2751519600 -14400 1 EDT}
    {2772079200 -18000 0 EST}
    {2782969200 -14400 1 EDT}
    {2803528800 -18000 0 EST}
    {2814418800 -14400 1 EDT}
    {2834978400 -18000 0 EST}
    {2846473200 -14400 1 EDT}
    {2867032800 -18000 0 EST}
    {2877922800 -14400 1 EDT}
    {2898482400 -18000 0 EST}
    {2909372400 -14400 1 EDT}
    {2929932000 -18000 0 EST}
    {2940822000 -14400 1 EDT}
    {2961381600 -18000 0 EST}
    {2972271600 -14400 1 EDT}
    {2992831200 -18000 0 EST}
    {3003721200 -14400 1 EDT}
    {3024280800 -18000 0 EST}
    {3035775600 -14400 1 EDT}
    {3056335200 -18000 0 EST}
    {3067225200 -14400 1 EDT}
    {3087784800 -18000 0 EST}
    {3098674800 -14400 1 EDT}
    {3119234400 -18000 0 EST}
    {3130124400 -14400 1 EDT}
    {3150684000 -18000 0 EST}
    {3161574000 -14400 1 EDT}
    {3182133600 -18000 0 EST}
    {3193023600 -14400 1 EDT}
    {3213583200 -18000 0 EST}
    {3225078000 -14400 1 EDT}
    {3245637600 -18000 0 EST}
    {3256527600 -14400 1 EDT}
    {3277087200 -18000 0 EST}
    {3287977200 -14400 1 EDT}
    {3308536800 -18000 0 EST}
    {3319426800 -14400 1 EDT}
    {3339986400 -18000 0 EST}
    {3350876400 -14400 1 EDT}
    {3371436000 -18000 0 EST}
    {3382930800 -14400 1 EDT}
    {3403490400 -18000 0 EST}
    {3414380400 -14400 1 EDT}
    {3434940000 -18000 0 EST}
    {3445830000 -14400 1 EDT}
    {3466389600 -18000 0 EST}
    {3477279600 -14400 1 EDT}
    {3497839200 -18000 0 EST}
    {3508729200 -14400 1 EDT}
    {3529288800 -18000 0 EST}
    {3540178800 -14400 1 EDT}
    {3560738400 -18000 0 EST}
    {3572233200 -14400 1 EDT}
    {3592792800 -18000 0 EST}
    {3603682800 -14400 1 EDT}
    {3624242400 -18000 0 EST}
    {3635132400 -14400 1 EDT}
    {3655692000 -18000 0 EST}
    {3666582000 -14400 1 EDT}
    {3687141600 -18000 0 EST}
    {3698031600 -14400 1 EDT}
    {3718591200 -18000 0 EST}
    {3730086000 -14400 1 EDT}
    {3750645600 -18000 0 EST}
    {3761535600 -14400 1 EDT}
    {3782095200 -18000 0 EST}
    {3792985200 -14400 1 EDT}
    {3813544800 -18000 0 EST}
    {3824434800 -14400 1 EDT}
    {3844994400 -18000 0 EST}
    {3855884400 -14400 1 EDT}
    {3876444000 -18000 0 EST}
    {3887334000 -14400 1 EDT}
    {3907893600 -18000 0 EST}
    {3919388400 -14400 1 EDT}
    {3939948000 -18000 0 EST}
    {3950838000 -14400 1 EDT}
    {3971397600 -18000 0 EST}
    {3982287600 -14400 1 EDT}
    {4002847200 -18000 0 EST}
    {4013737200 -14400 1 EDT}
    {4034296800 -18000 0 EST}
    {4045186800 -14400 1 EDT}
    {4065746400 -18000 0 EST}
    {4076636400 -14400 1 EDT}
    {4097196000 -18000 0 EST}
}

Changes to library/tzdata/America/Port_of_Spain.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico

set TZData(:America/Port_of_Spain) {
}
set TZData(:America/Port_of_Spain) $TZData(:America/Puerto_Rico)
    {-9223372036854775808 -14764 0 LMT}
    {-1825098836 -14400 0 AST}
}

Changes to library/tzdata/America/Punta_Arenas.

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
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




-
-
-
-
-
-
+
+
+
+
+
+













+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Punta_Arenas) {
    {-9223372036854775808 -17020 0 LMT}
    {-2524504580 -16966 0 SMT}
    {-1892661434 -18000 0 -05}
    {-1688410800 -16966 0 SMT}
    {-1619205434 -14400 0 -04}
    {-1593806400 -16966 0 SMT}
    {-1335986234 -18000 0 -05}
    {-2524504580 -16965 0 SMT}
    {-1892661435 -18000 0 -05}
    {-1688410800 -16965 0 SMT}
    {-1619205435 -14400 0 -04}
    {-1593806400 -16965 0 SMT}
    {-1335986235 -18000 0 -05}
    {-1335985200 -14400 1 -05}
    {-1317585600 -18000 0 -05}
    {-1304362800 -14400 1 -05}
    {-1286049600 -18000 0 -05}
    {-1272826800 -14400 1 -05}
    {-1254513600 -18000 0 -05}
    {-1241290800 -14400 1 -05}
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}
    {-736632000 -14400 1 -04}
    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -04}

Changes to library/tzdata/America/Rainy_River.

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
1
2
3


4
5






































































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Winnipeg)]} {
    LoadTimeZoneFile America/Winnipeg

set TZData(:America/Rainy_River) {
}
set TZData(:America/Rainy_River) $TZData(:America/Winnipeg)
    {-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}
    {183538800 -21600 0 CST}
    {199267200 -18000 1 CDT}
    {215593200 -21600 0 CST}
    {230716800 -18000 1 CDT}
    {247042800 -21600 0 CST}
    {262771200 -18000 1 CDT}
    {278492400 -21600 0 CST}
    {294220800 -18000 1 CDT}
    {309942000 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}
    {388569600 -18000 1 CDT}
    {404895600 -21600 0 CST}
    {420019200 -18000 1 CDT}
    {436345200 -21600 0 CST}
    {452073600 -18000 1 CDT}
    {467794800 -21600 0 CST}
    {483523200 -18000 1 CDT}
    {499244400 -21600 0 CST}
    {514972800 -18000 1 CDT}
    {530694000 -21600 0 CST}
    {544608000 -18000 1 CDT}
    {562143600 -21600 0 CST}
    {576057600 -18000 1 CDT}
    {594198000 -21600 0 CST}
    {607507200 -18000 1 CDT}
    {625647600 -21600 0 CST}
    {638956800 -18000 1 CDT}
    {657097200 -21600 0 CST}
    {671011200 -18000 1 CDT}
    {688546800 -21600 0 CST}
    {702460800 -18000 1 CDT}
    {719996400 -21600 0 CST}
    {733910400 -18000 1 CDT}
    {752050800 -21600 0 CST}
    {765360000 -18000 1 CDT}
    {783500400 -21600 0 CST}
    {796809600 -18000 1 CDT}
    {814950000 -21600 0 CST}
    {828864000 -18000 1 CDT}
    {846399600 -21600 0 CST}
    {860313600 -18000 1 CDT}
    {877849200 -21600 0 CST}
    {891763200 -18000 1 CDT}
    {909298800 -21600 0 CST}
    {923212800 -18000 1 CDT}
    {941353200 -21600 0 CST}
    {954662400 -18000 1 CDT}
    {972802800 -21600 0 CST}
    {986112000 -18000 1 CDT}
    {1004252400 -21600 0 CST}
    {1018166400 -18000 1 CDT}
    {1035702000 -21600 0 CST}
    {1049616000 -18000 1 CDT}
    {1067151600 -21600 0 CST}
    {1081065600 -18000 1 CDT}
    {1099206000 -21600 0 CST}
    {1112515200 -18000 1 CDT}
    {1130655600 -21600 0 CST}
    {1143964800 -18000 1 CDT}
    {1162105200 -21600 0 CST}
    {1173600000 -18000 1 CDT}
    {1194159600 -21600 0 CST}
    {1205049600 -18000 1 CDT}
    {1225609200 -21600 0 CST}
    {1236499200 -18000 1 CDT}
    {1257058800 -21600 0 CST}
    {1268553600 -18000 1 CDT}
    {1289113200 -21600 0 CST}
    {1300003200 -18000 1 CDT}
    {1320562800 -21600 0 CST}
    {1331452800 -18000 1 CDT}
    {1352012400 -21600 0 CST}
    {1362902400 -18000 1 CDT}
    {1383462000 -21600 0 CST}
    {1394352000 -18000 1 CDT}
    {1414911600 -21600 0 CST}
    {1425801600 -18000 1 CDT}
    {1446361200 -21600 0 CST}
    {1457856000 -18000 1 CDT}
    {1478415600 -21600 0 CST}
    {1489305600 -18000 1 CDT}
    {1509865200 -21600 0 CST}
    {1520755200 -18000 1 CDT}
    {1541314800 -21600 0 CST}
    {1552204800 -18000 1 CDT}
    {1572764400 -21600 0 CST}
    {1583654400 -18000 1 CDT}
    {1604214000 -21600 0 CST}
    {1615708800 -18000 1 CDT}
    {1636268400 -21600 0 CST}
    {1647158400 -18000 1 CDT}
    {1667718000 -21600 0 CST}
    {1678608000 -18000 1 CDT}
    {1699167600 -21600 0 CST}
    {1710057600 -18000 1 CDT}
    {1730617200 -21600 0 CST}
    {1741507200 -18000 1 CDT}
    {1762066800 -21600 0 CST}
    {1772956800 -18000 1 CDT}
    {1793516400 -21600 0 CST}
    {1805011200 -18000 1 CDT}
    {1825570800 -21600 0 CST}
    {1836460800 -18000 1 CDT}
    {1857020400 -21600 0 CST}
    {1867910400 -18000 1 CDT}
    {1888470000 -21600 0 CST}
    {1899360000 -18000 1 CDT}
    {1919919600 -21600 0 CST}
    {1930809600 -18000 1 CDT}
    {1951369200 -21600 0 CST}
    {1962864000 -18000 1 CDT}
    {1983423600 -21600 0 CST}
    {1994313600 -18000 1 CDT}
    {2014873200 -21600 0 CST}
    {2025763200 -18000 1 CDT}
    {2046322800 -21600 0 CST}
    {2057212800 -18000 1 CDT}
    {2077772400 -21600 0 CST}
    {2088662400 -18000 1 CDT}
    {2109222000 -21600 0 CST}
    {2120112000 -18000 1 CDT}
    {2140671600 -21600 0 CST}
    {2152166400 -18000 1 CDT}
    {2172726000 -21600 0 CST}
    {2183616000 -18000 1 CDT}
    {2204175600 -21600 0 CST}
    {2215065600 -18000 1 CDT}
    {2235625200 -21600 0 CST}
    {2246515200 -18000 1 CDT}
    {2267074800 -21600 0 CST}
    {2277964800 -18000 1 CDT}
    {2298524400 -21600 0 CST}
    {2309414400 -18000 1 CDT}
    {2329974000 -21600 0 CST}
    {2341468800 -18000 1 CDT}
    {2362028400 -21600 0 CST}
    {2372918400 -18000 1 CDT}
    {2393478000 -21600 0 CST}
    {2404368000 -18000 1 CDT}
    {2424927600 -21600 0 CST}
    {2435817600 -18000 1 CDT}
    {2456377200 -21600 0 CST}
    {2467267200 -18000 1 CDT}
    {2487826800 -21600 0 CST}
    {2499321600 -18000 1 CDT}
    {2519881200 -21600 0 CST}
    {2530771200 -18000 1 CDT}
    {2551330800 -21600 0 CST}
    {2562220800 -18000 1 CDT}
    {2582780400 -21600 0 CST}
    {2593670400 -18000 1 CDT}
    {2614230000 -21600 0 CST}
    {2625120000 -18000 1 CDT}
    {2645679600 -21600 0 CST}
    {2656569600 -18000 1 CDT}
    {2677129200 -21600 0 CST}
    {2688624000 -18000 1 CDT}
    {2709183600 -21600 0 CST}
    {2720073600 -18000 1 CDT}
    {2740633200 -21600 0 CST}
    {2751523200 -18000 1 CDT}
    {2772082800 -21600 0 CST}
    {2782972800 -18000 1 CDT}
    {2803532400 -21600 0 CST}
    {2814422400 -18000 1 CDT}
    {2834982000 -21600 0 CST}
    {2846476800 -18000 1 CDT}
    {2867036400 -21600 0 CST}
    {2877926400 -18000 1 CDT}
    {2898486000 -21600 0 CST}
    {2909376000 -18000 1 CDT}
    {2929935600 -21600 0 CST}
    {2940825600 -18000 1 CDT}
    {2961385200 -21600 0 CST}
    {2972275200 -18000 1 CDT}
    {2992834800 -21600 0 CST}
    {3003724800 -18000 1 CDT}
    {3024284400 -21600 0 CST}
    {3035779200 -18000 1 CDT}
    {3056338800 -21600 0 CST}
    {3067228800 -18000 1 CDT}
    {3087788400 -21600 0 CST}
    {3098678400 -18000 1 CDT}
    {3119238000 -21600 0 CST}
    {3130128000 -18000 1 CDT}
    {3150687600 -21600 0 CST}
    {3161577600 -18000 1 CDT}
    {3182137200 -21600 0 CST}
    {3193027200 -18000 1 CDT}
    {3213586800 -21600 0 CST}
    {3225081600 -18000 1 CDT}
    {3245641200 -21600 0 CST}
    {3256531200 -18000 1 CDT}
    {3277090800 -21600 0 CST}
    {3287980800 -18000 1 CDT}
    {3308540400 -21600 0 CST}
    {3319430400 -18000 1 CDT}
    {3339990000 -21600 0 CST}
    {3350880000 -18000 1 CDT}
    {3371439600 -21600 0 CST}
    {3382934400 -18000 1 CDT}
    {3403494000 -21600 0 CST}
    {3414384000 -18000 1 CDT}
    {3434943600 -21600 0 CST}
    {3445833600 -18000 1 CDT}
    {3466393200 -21600 0 CST}
    {3477283200 -18000 1 CDT}
    {3497842800 -21600 0 CST}
    {3508732800 -18000 1 CDT}
    {3529292400 -21600 0 CST}
    {3540182400 -18000 1 CDT}
    {3560742000 -21600 0 CST}
    {3572236800 -18000 1 CDT}
    {3592796400 -21600 0 CST}
    {3603686400 -18000 1 CDT}
    {3624246000 -21600 0 CST}
    {3635136000 -18000 1 CDT}
    {3655695600 -21600 0 CST}
    {3666585600 -18000 1 CDT}
    {3687145200 -21600 0 CST}
    {3698035200 -18000 1 CDT}
    {3718594800 -21600 0 CST}
    {3730089600 -18000 1 CDT}
    {3750649200 -21600 0 CST}
    {3761539200 -18000 1 CDT}
    {3782098800 -21600 0 CST}
    {3792988800 -18000 1 CDT}
    {3813548400 -21600 0 CST}
    {3824438400 -18000 1 CDT}
    {3844998000 -21600 0 CST}
    {3855888000 -18000 1 CDT}
    {3876447600 -21600 0 CST}
    {3887337600 -18000 1 CDT}
    {3907897200 -21600 0 CST}
    {3919392000 -18000 1 CDT}
    {3939951600 -21600 0 CST}
    {3950841600 -18000 1 CDT}
    {3971401200 -21600 0 CST}
    {3982291200 -18000 1 CDT}
    {4002850800 -21600 0 CST}
    {4013740800 -18000 1 CDT}
    {4034300400 -21600 0 CST}
    {4045190400 -18000 1 CDT}
    {4065750000 -21600 0 CST}
    {4076640000 -18000 1 CDT}
    {4097199600 -21600 0 CST}
}

Changes to library/tzdata/America/Rankin_Inlet.

1
2
3
4
5
6
7
















8
9
10
11
12
13
14
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





-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rankin_Inlet) {
    {-9223372036854775808 0 0 -00}
    {-410227200 -21600 0 CST}
    {-147895200 -14400 1 CDDT}
    {-131565600 -21600 0 CST}
    {73468800 -18000 1 CDT}
    {89190000 -21600 0 CST}
    {104918400 -18000 1 CDT}
    {120639600 -21600 0 CST}
    {136368000 -18000 1 CDT}
    {152089200 -21600 0 CST}
    {167817600 -18000 1 CDT}
    {183538800 -21600 0 CST}
    {199267200 -18000 1 CDT}
    {215593200 -21600 0 CST}
    {230716800 -18000 1 CDT}
    {247042800 -21600 0 CST}
    {262771200 -18000 1 CDT}
    {278492400 -21600 0 CST}
    {294220800 -18000 1 CDT}
    {309942000 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}
    {388569600 -18000 1 CDT}
    {404895600 -21600 0 CST}
    {420019200 -18000 1 CDT}

Changes to library/tzdata/America/Resolute.

1
2
3
4
5
6
7
















8
9
10
11
12
13
14
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





-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Resolute) {
    {-9223372036854775808 0 0 -00}
    {-704937600 -21600 0 CST}
    {-147895200 -14400 1 CDDT}
    {-131565600 -21600 0 CST}
    {73468800 -18000 1 CDT}
    {89190000 -21600 0 CST}
    {104918400 -18000 1 CDT}
    {120639600 -21600 0 CST}
    {136368000 -18000 1 CDT}
    {152089200 -21600 0 CST}
    {167817600 -18000 1 CDT}
    {183538800 -21600 0 CST}
    {199267200 -18000 1 CDT}
    {215593200 -21600 0 CST}
    {230716800 -18000 1 CDT}
    {247042800 -21600 0 CST}
    {262771200 -18000 1 CDT}
    {278492400 -21600 0 CST}
    {294220800 -18000 1 CDT}
    {309942000 -21600 0 CST}
    {325670400 -18000 1 CDT}
    {341391600 -21600 0 CST}
    {357120000 -18000 1 CDT}
    {372841200 -21600 0 CST}
    {388569600 -18000 1 CDT}
    {404895600 -21600 0 CST}
    {420019200 -18000 1 CDT}

Changes to library/tzdata/America/Santiago.

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
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



-
-
-
-
-
-
-
+
+
+
+
+
+
+














-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Santiago) {
    {-9223372036854775808 -16966 0 LMT}
    {-2524504634 -16966 0 SMT}
    {-1892661434 -18000 0 -05}
    {-1688410800 -16966 0 SMT}
    {-1619205434 -14400 0 -04}
    {-1593806400 -16966 0 SMT}
    {-1335986234 -18000 0 -05}
    {-9223372036854775808 -16965 0 LMT}
    {-2524504635 -16965 0 SMT}
    {-1892661435 -18000 0 -05}
    {-1688410800 -16965 0 SMT}
    {-1619205435 -14400 0 -04}
    {-1593806400 -16965 0 SMT}
    {-1335986235 -18000 0 -05}
    {-1335985200 -14400 1 -05}
    {-1317585600 -18000 0 -05}
    {-1304362800 -14400 1 -05}
    {-1286049600 -18000 0 -05}
    {-1272826800 -14400 1 -05}
    {-1254513600 -18000 0 -05}
    {-1241290800 -14400 1 -05}
    {-1222977600 -18000 0 -05}
    {-1209754800 -14400 1 -05}
    {-1191355200 -18000 0 -05}
    {-1178132400 -14400 0 -04}
    {-870552000 -18000 0 -05}
    {-865278000 -14400 0 -04}
    {-740520000 -10800 1 -03}
    {-736376400 -14400 0 -04}
    {-736635600 -14400 1 -04}
    {-718056000 -18000 0 -05}
    {-713649600 -14400 0 -04}
    {-36619200 -10800 1 -04}
    {-23922000 -14400 0 -04}
    {-3355200 -10800 1 -04}
    {7527600 -14400 0 -04}
    {24465600 -10800 1 -04}
127
128
129
130
131
132
133
134

135
136
137
138
139
140
141
127
128
129
130
131
132
133

134
135
136
137
138
139
140
141







-
+







    {1554606000 -14400 0 -04}
    {1567915200 -10800 1 -04}
    {1586055600 -14400 0 -04}
    {1599364800 -10800 1 -04}
    {1617505200 -14400 0 -04}
    {1630814400 -10800 1 -04}
    {1648954800 -14400 0 -04}
    {1662264000 -10800 1 -04}
    {1662868800 -10800 1 -04}
    {1680404400 -14400 0 -04}
    {1693713600 -10800 1 -04}
    {1712458800 -14400 0 -04}
    {1725768000 -10800 1 -04}
    {1743908400 -14400 0 -04}
    {1757217600 -10800 1 -04}
    {1775358000 -14400 0 -04}

Changes to library/tzdata/America/St_Barthelemy.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Barthelemy) $TZData(:America/Port_of_Spain)
set TZData(:America/St_Barthelemy) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/St_Kitts.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Kitts) $TZData(:America/Port_of_Spain)
set TZData(:America/St_Kitts) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/St_Lucia.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Lucia) $TZData(:America/Port_of_Spain)
set TZData(:America/St_Lucia) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/St_Thomas.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Thomas) $TZData(:America/Port_of_Spain)
set TZData(:America/St_Thomas) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/St_Vincent.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/St_Vincent) $TZData(:America/Port_of_Spain)
set TZData(:America/St_Vincent) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Thunder_Bay.

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
1
2
3


4
5














































































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Toronto)]} {
    LoadTimeZoneFile America/Toronto

set TZData(:America/Thunder_Bay) {
}
set TZData(:America/Thunder_Bay) $TZData(:America/Toronto)
    {-9223372036854775808 -21420 0 LMT}
    {-2366733780 -21600 0 CST}
    {-1893434400 -18000 0 EST}
    {-883594800 -18000 0 EST}
    {-880218000 -14400 1 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}
    {18000 -18000 0 EST}
    {9961200 -14400 1 EDT}
    {25682400 -18000 0 EST}
    {41410800 -14400 1 EDT}
    {57736800 -18000 0 EST}
    {73465200 -14400 1 EDT}
    {89186400 -18000 0 EST}
    {94712400 -18000 0 EST}
    {126248400 -18000 0 EST}
    {136364400 -14400 1 EDT}
    {152085600 -18000 0 EST}
    {167814000 -14400 1 EDT}
    {183535200 -18000 0 EST}
    {199263600 -14400 1 EDT}
    {215589600 -18000 0 EST}
    {230713200 -14400 1 EDT}
    {247039200 -18000 0 EST}
    {262767600 -14400 1 EDT}
    {278488800 -18000 0 EST}
    {294217200 -14400 1 EDT}
    {309938400 -18000 0 EST}
    {325666800 -14400 1 EDT}
    {341388000 -18000 0 EST}
    {357116400 -14400 1 EDT}
    {372837600 -18000 0 EST}
    {388566000 -14400 1 EDT}
    {404892000 -18000 0 EST}
    {420015600 -14400 1 EDT}
    {436341600 -18000 0 EST}
    {452070000 -14400 1 EDT}
    {467791200 -18000 0 EST}
    {483519600 -14400 1 EDT}
    {499240800 -18000 0 EST}
    {514969200 -14400 1 EDT}
    {530690400 -18000 0 EST}
    {544604400 -14400 1 EDT}
    {562140000 -18000 0 EST}
    {576054000 -14400 1 EDT}
    {594194400 -18000 0 EST}
    {607503600 -14400 1 EDT}
    {625644000 -18000 0 EST}
    {638953200 -14400 1 EDT}
    {657093600 -18000 0 EST}
    {671007600 -14400 1 EDT}
    {688543200 -18000 0 EST}
    {702457200 -14400 1 EDT}
    {719992800 -18000 0 EST}
    {733906800 -14400 1 EDT}
    {752047200 -18000 0 EST}
    {765356400 -14400 1 EDT}
    {783496800 -18000 0 EST}
    {796806000 -14400 1 EDT}
    {814946400 -18000 0 EST}
    {828860400 -14400 1 EDT}
    {846396000 -18000 0 EST}
    {860310000 -14400 1 EDT}
    {877845600 -18000 0 EST}
    {891759600 -14400 1 EDT}
    {909295200 -18000 0 EST}
    {923209200 -14400 1 EDT}
    {941349600 -18000 0 EST}
    {954658800 -14400 1 EDT}
    {972799200 -18000 0 EST}
    {986108400 -14400 1 EDT}
    {1004248800 -18000 0 EST}
    {1018162800 -14400 1 EDT}
    {1035698400 -18000 0 EST}
    {1049612400 -14400 1 EDT}
    {1067148000 -18000 0 EST}
    {1081062000 -14400 1 EDT}
    {1099202400 -18000 0 EST}
    {1112511600 -14400 1 EDT}
    {1130652000 -18000 0 EST}
    {1143961200 -14400 1 EDT}
    {1162101600 -18000 0 EST}
    {1173596400 -14400 1 EDT}
    {1194156000 -18000 0 EST}
    {1205046000 -14400 1 EDT}
    {1225605600 -18000 0 EST}
    {1236495600 -14400 1 EDT}
    {1257055200 -18000 0 EST}
    {1268550000 -14400 1 EDT}
    {1289109600 -18000 0 EST}
    {1299999600 -14400 1 EDT}
    {1320559200 -18000 0 EST}
    {1331449200 -14400 1 EDT}
    {1352008800 -18000 0 EST}
    {1362898800 -14400 1 EDT}
    {1383458400 -18000 0 EST}
    {1394348400 -14400 1 EDT}
    {1414908000 -18000 0 EST}
    {1425798000 -14400 1 EDT}
    {1446357600 -18000 0 EST}
    {1457852400 -14400 1 EDT}
    {1478412000 -18000 0 EST}
    {1489302000 -14400 1 EDT}
    {1509861600 -18000 0 EST}
    {1520751600 -14400 1 EDT}
    {1541311200 -18000 0 EST}
    {1552201200 -14400 1 EDT}
    {1572760800 -18000 0 EST}
    {1583650800 -14400 1 EDT}
    {1604210400 -18000 0 EST}
    {1615705200 -14400 1 EDT}
    {1636264800 -18000 0 EST}
    {1647154800 -14400 1 EDT}
    {1667714400 -18000 0 EST}
    {1678604400 -14400 1 EDT}
    {1699164000 -18000 0 EST}
    {1710054000 -14400 1 EDT}
    {1730613600 -18000 0 EST}
    {1741503600 -14400 1 EDT}
    {1762063200 -18000 0 EST}
    {1772953200 -14400 1 EDT}
    {1793512800 -18000 0 EST}
    {1805007600 -14400 1 EDT}
    {1825567200 -18000 0 EST}
    {1836457200 -14400 1 EDT}
    {1857016800 -18000 0 EST}
    {1867906800 -14400 1 EDT}
    {1888466400 -18000 0 EST}
    {1899356400 -14400 1 EDT}
    {1919916000 -18000 0 EST}
    {1930806000 -14400 1 EDT}
    {1951365600 -18000 0 EST}
    {1962860400 -14400 1 EDT}
    {1983420000 -18000 0 EST}
    {1994310000 -14400 1 EDT}
    {2014869600 -18000 0 EST}
    {2025759600 -14400 1 EDT}
    {2046319200 -18000 0 EST}
    {2057209200 -14400 1 EDT}
    {2077768800 -18000 0 EST}
    {2088658800 -14400 1 EDT}
    {2109218400 -18000 0 EST}
    {2120108400 -14400 1 EDT}
    {2140668000 -18000 0 EST}
    {2152162800 -14400 1 EDT}
    {2172722400 -18000 0 EST}
    {2183612400 -14400 1 EDT}
    {2204172000 -18000 0 EST}
    {2215062000 -14400 1 EDT}
    {2235621600 -18000 0 EST}
    {2246511600 -14400 1 EDT}
    {2267071200 -18000 0 EST}
    {2277961200 -14400 1 EDT}
    {2298520800 -18000 0 EST}
    {2309410800 -14400 1 EDT}
    {2329970400 -18000 0 EST}
    {2341465200 -14400 1 EDT}
    {2362024800 -18000 0 EST}
    {2372914800 -14400 1 EDT}
    {2393474400 -18000 0 EST}
    {2404364400 -14400 1 EDT}
    {2424924000 -18000 0 EST}
    {2435814000 -14400 1 EDT}
    {2456373600 -18000 0 EST}
    {2467263600 -14400 1 EDT}
    {2487823200 -18000 0 EST}
    {2499318000 -14400 1 EDT}
    {2519877600 -18000 0 EST}
    {2530767600 -14400 1 EDT}
    {2551327200 -18000 0 EST}
    {2562217200 -14400 1 EDT}
    {2582776800 -18000 0 EST}
    {2593666800 -14400 1 EDT}
    {2614226400 -18000 0 EST}
    {2625116400 -14400 1 EDT}
    {2645676000 -18000 0 EST}
    {2656566000 -14400 1 EDT}
    {2677125600 -18000 0 EST}
    {2688620400 -14400 1 EDT}
    {2709180000 -18000 0 EST}
    {2720070000 -14400 1 EDT}
    {2740629600 -18000 0 EST}
    {2751519600 -14400 1 EDT}
    {2772079200 -18000 0 EST}
    {2782969200 -14400 1 EDT}
    {2803528800 -18000 0 EST}
    {2814418800 -14400 1 EDT}
    {2834978400 -18000 0 EST}
    {2846473200 -14400 1 EDT}
    {2867032800 -18000 0 EST}
    {2877922800 -14400 1 EDT}
    {2898482400 -18000 0 EST}
    {2909372400 -14400 1 EDT}
    {2929932000 -18000 0 EST}
    {2940822000 -14400 1 EDT}
    {2961381600 -18000 0 EST}
    {2972271600 -14400 1 EDT}
    {2992831200 -18000 0 EST}
    {3003721200 -14400 1 EDT}
    {3024280800 -18000 0 EST}
    {3035775600 -14400 1 EDT}
    {3056335200 -18000 0 EST}
    {3067225200 -14400 1 EDT}
    {3087784800 -18000 0 EST}
    {3098674800 -14400 1 EDT}
    {3119234400 -18000 0 EST}
    {3130124400 -14400 1 EDT}
    {3150684000 -18000 0 EST}
    {3161574000 -14400 1 EDT}
    {3182133600 -18000 0 EST}
    {3193023600 -14400 1 EDT}
    {3213583200 -18000 0 EST}
    {3225078000 -14400 1 EDT}
    {3245637600 -18000 0 EST}
    {3256527600 -14400 1 EDT}
    {3277087200 -18000 0 EST}
    {3287977200 -14400 1 EDT}
    {3308536800 -18000 0 EST}
    {3319426800 -14400 1 EDT}
    {3339986400 -18000 0 EST}
    {3350876400 -14400 1 EDT}
    {3371436000 -18000 0 EST}
    {3382930800 -14400 1 EDT}
    {3403490400 -18000 0 EST}
    {3414380400 -14400 1 EDT}
    {3434940000 -18000 0 EST}
    {3445830000 -14400 1 EDT}
    {3466389600 -18000 0 EST}
    {3477279600 -14400 1 EDT}
    {3497839200 -18000 0 EST}
    {3508729200 -14400 1 EDT}
    {3529288800 -18000 0 EST}
    {3540178800 -14400 1 EDT}
    {3560738400 -18000 0 EST}
    {3572233200 -14400 1 EDT}
    {3592792800 -18000 0 EST}
    {3603682800 -14400 1 EDT}
    {3624242400 -18000 0 EST}
    {3635132400 -14400 1 EDT}
    {3655692000 -18000 0 EST}
    {3666582000 -14400 1 EDT}
    {3687141600 -18000 0 EST}
    {3698031600 -14400 1 EDT}
    {3718591200 -18000 0 EST}
    {3730086000 -14400 1 EDT}
    {3750645600 -18000 0 EST}
    {3761535600 -14400 1 EDT}
    {3782095200 -18000 0 EST}
    {3792985200 -14400 1 EDT}
    {3813544800 -18000 0 EST}
    {3824434800 -14400 1 EDT}
    {3844994400 -18000 0 EST}
    {3855884400 -14400 1 EDT}
    {3876444000 -18000 0 EST}
    {3887334000 -14400 1 EDT}
    {3907893600 -18000 0 EST}
    {3919388400 -14400 1 EDT}
    {3939948000 -18000 0 EST}
    {3950838000 -14400 1 EDT}
    {3971397600 -18000 0 EST}
    {3982287600 -14400 1 EDT}
    {4002847200 -18000 0 EST}
    {4013737200 -14400 1 EDT}
    {4034296800 -18000 0 EST}
    {4045186800 -14400 1 EDT}
    {4065746400 -18000 0 EST}
    {4076636400 -14400 1 EDT}
    {4097196000 -18000 0 EST}
}

Changes to library/tzdata/America/Tijuana.

1
2
3
4
5

6
7
8
9
10
11
12
1
2
3
4

5
6
7
8
9
10
11
12




-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Tijuana) {
    {-9223372036854775808 -28084 0 LMT}
    {-1514736000 -25200 0 MST}
    {-1514739600 -25200 0 MST}
    {-1451667600 -28800 0 PST}
    {-1343062800 -25200 0 MST}
    {-1234803600 -28800 0 PST}
    {-1222963200 -25200 1 PDT}
    {-1207242000 -28800 0 PST}
    {-873820800 -25200 1 PWT}
    {-769395600 -25200 1 PPT}

Changes to library/tzdata/America/Tortola.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Tortola) $TZData(:America/Port_of_Spain)
set TZData(:America/Tortola) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Virgin.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Port_of_Spain)]} {
    LoadTimeZoneFile America/Port_of_Spain
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:America/Virgin) $TZData(:America/Port_of_Spain)
set TZData(:America/Virgin) $TZData(:America/Puerto_Rico)

Changes to library/tzdata/America/Whitehorse.

1
2
3
4
5
6
7
8
9
10
11
12

13
14

15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23












+


+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Whitehorse) {
    {-9223372036854775808 -32412 0 LMT}
    {-2188997988 -32400 0 YST}
    {-1632056400 -28800 1 YDT}
    {-1615125600 -32400 0 YST}
    {-1596978000 -28800 1 YDT}
    {-1583164800 -32400 0 YST}
    {-880203600 -28800 1 YWT}
    {-769395600 -28800 1 YPT}
    {-765381600 -32400 0 YST}
    {-157734000 -32400 0 YST}
    {-147884400 -25200 1 YDDT}
    {-131554800 -32400 0 YST}
    {-121273200 -28800 0 PST}
    {315561600 -28800 0 PST}
    {325677600 -25200 1 PDT}
    {341398800 -28800 0 PST}
    {357127200 -25200 1 PDT}
    {372848400 -28800 0 PST}
    {388576800 -25200 1 PDT}
    {404902800 -28800 0 PST}

Changes to library/tzdata/America/Yellowknife.

1
2
3
4
5
6
7
8




9
10












11
12
13
14
15
16
17
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








+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Yellowknife) {
    {-9223372036854775808 0 0 -00}
    {-1104537600 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {73472400 -21600 1 MDT}
    {89193600 -25200 0 MST}
    {104922000 -21600 1 MDT}
    {120643200 -25200 0 MST}
    {-147891600 -18000 1 MDDT}
    {-131562000 -25200 0 MST}
    {136371600 -21600 1 MDT}
    {152092800 -25200 0 MST}
    {167821200 -21600 1 MDT}
    {183542400 -25200 0 MST}
    {199270800 -21600 1 MDT}
    {215596800 -25200 0 MST}
    {230720400 -21600 1 MDT}
    {247046400 -25200 0 MST}
    {262774800 -21600 1 MDT}
    {278496000 -25200 0 MST}
    {294224400 -21600 1 MDT}
    {309945600 -25200 0 MST}
    {315558000 -25200 0 MST}
    {325674000 -21600 1 MDT}
    {341395200 -25200 0 MST}
    {357123600 -21600 1 MDT}
    {372844800 -25200 0 MST}
    {388573200 -21600 1 MDT}
    {404899200 -25200 0 MST}

Changes to library/tzdata/Antarctica/DumontDUrville.

1


2
3


4
5
6
7
8
1
2
3


4
5






+
+
-
-
+
+
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Port_Moresby)]} {
    LoadTimeZoneFile Pacific/Port_Moresby

set TZData(:Antarctica/DumontDUrville) {
}
set TZData(:Antarctica/DumontDUrville) $TZData(:Pacific/Port_Moresby)
    {-9223372036854775808 0 0 -00}
    {-725846400 36000 0 +10}
    {-566992800 0 0 -00}
    {-415497600 36000 0 +10}
}

Changes to library/tzdata/Antarctica/Macquarie.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
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(:Antarctica/Macquarie) {
    {-9223372036854775808 0 0 -00}
    {-2214259200 36000 0 AEST}
    {-1680508800 39600 1 AEDT}
    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}
    {-1665388800 36000 0 AEST}
    {-1601719200 0 0 -00}
    {-94730400 36000 0 AEST}
    {-71136000 39600 1 AEDT}
    {-55411200 36000 0 AEST}
    {-37267200 39600 1 AEDT}
    {-25776000 36000 0 AEST}
    {-5817600 39600 1 AEDT}

Changes to library/tzdata/Antarctica/Syowa.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Riyadh)]} {
    LoadTimeZoneFile Asia/Riyadh

set TZData(:Antarctica/Syowa) {
}
set TZData(:Antarctica/Syowa) $TZData(:Asia/Riyadh)
    {-9223372036854775808 0 0 -00}
    {-407808000 10800 0 +03}
}

Changes to library/tzdata/Antarctica/Vostok.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Urumqi)]} {
    LoadTimeZoneFile Asia/Urumqi

set TZData(:Antarctica/Vostok) {
}
set TZData(:Antarctica/Vostok) $TZData(:Asia/Urumqi)
    {-9223372036854775808 0 0 -00}
    {-380073600 21600 0 +06}
}

Changes to library/tzdata/Arctic/Longyearbyen.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Oslo)]} {
    LoadTimeZoneFile Europe/Oslo
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin
}
set TZData(:Arctic/Longyearbyen) $TZData(:Europe/Oslo)
set TZData(:Arctic/Longyearbyen) $TZData(:Europe/Berlin)

Changes to library/tzdata/Asia/Amman.

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
83
84
85
86
87
88
89


90
91


























































































































































92







-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1540504800 7200 0 EET}
    {1553810400 10800 1 EEST}
    {1571954400 7200 0 EET}
    {1585260000 10800 1 EEST}
    {1604008800 7200 0 EET}
    {1616709600 10800 1 EEST}
    {1635458400 7200 0 EET}
    {1648764000 10800 1 EEST}
    {1666908000 7200 0 EET}
    {1645740000 10800 1 EEST}
    {1666908000 10800 0 +03}
    {1680213600 10800 1 EEST}
    {1698357600 7200 0 EET}
    {1711663200 10800 1 EEST}
    {1729807200 7200 0 EET}
    {1743112800 10800 1 EEST}
    {1761861600 7200 0 EET}
    {1774562400 10800 1 EEST}
    {1793311200 7200 0 EET}
    {1806012000 10800 1 EEST}
    {1824760800 7200 0 EET}
    {1838066400 10800 1 EEST}
    {1856210400 7200 0 EET}
    {1869516000 10800 1 EEST}
    {1887660000 7200 0 EET}
    {1900965600 10800 1 EEST}
    {1919109600 7200 0 EET}
    {1932415200 10800 1 EEST}
    {1951164000 7200 0 EET}
    {1963864800 10800 1 EEST}
    {1982613600 7200 0 EET}
    {1995919200 10800 1 EEST}
    {2014063200 7200 0 EET}
    {2027368800 10800 1 EEST}
    {2045512800 7200 0 EET}
    {2058818400 10800 1 EEST}
    {2076962400 7200 0 EET}
    {2090268000 10800 1 EEST}
    {2109016800 7200 0 EET}
    {2121717600 10800 1 EEST}
    {2140466400 7200 0 EET}
    {2153167200 10800 1 EEST}
    {2171916000 7200 0 EET}
    {2185221600 10800 1 EEST}
    {2203365600 7200 0 EET}
    {2216671200 10800 1 EEST}
    {2234815200 7200 0 EET}
    {2248120800 10800 1 EEST}
    {2266264800 7200 0 EET}
    {2279570400 10800 1 EEST}
    {2298319200 7200 0 EET}
    {2311020000 10800 1 EEST}
    {2329768800 7200 0 EET}
    {2343074400 10800 1 EEST}
    {2361218400 7200 0 EET}
    {2374524000 10800 1 EEST}
    {2392668000 7200 0 EET}
    {2405973600 10800 1 EEST}
    {2424117600 7200 0 EET}
    {2437423200 10800 1 EEST}
    {2455567200 7200 0 EET}
    {2468872800 10800 1 EEST}
    {2487621600 7200 0 EET}
    {2500322400 10800 1 EEST}
    {2519071200 7200 0 EET}
    {2532376800 10800 1 EEST}
    {2550520800 7200 0 EET}
    {2563826400 10800 1 EEST}
    {2581970400 7200 0 EET}
    {2595276000 10800 1 EEST}
    {2613420000 7200 0 EET}
    {2626725600 10800 1 EEST}
    {2645474400 7200 0 EET}
    {2658175200 10800 1 EEST}
    {2676924000 7200 0 EET}
    {2689624800 10800 1 EEST}
    {2708373600 7200 0 EET}
    {2721679200 10800 1 EEST}
    {2739823200 7200 0 EET}
    {2753128800 10800 1 EEST}
    {2771272800 7200 0 EET}
    {2784578400 10800 1 EEST}
    {2802722400 7200 0 EET}
    {2816028000 10800 1 EEST}
    {2834776800 7200 0 EET}
    {2847477600 10800 1 EEST}
    {2866226400 7200 0 EET}
    {2879532000 10800 1 EEST}
    {2897676000 7200 0 EET}
    {2910981600 10800 1 EEST}
    {2929125600 7200 0 EET}
    {2942431200 10800 1 EEST}
    {2960575200 7200 0 EET}
    {2973880800 10800 1 EEST}
    {2992629600 7200 0 EET}
    {3005330400 10800 1 EEST}
    {3024079200 7200 0 EET}
    {3036780000 10800 1 EEST}
    {3055528800 7200 0 EET}
    {3068834400 10800 1 EEST}
    {3086978400 7200 0 EET}
    {3100284000 10800 1 EEST}
    {3118428000 7200 0 EET}
    {3131733600 10800 1 EEST}
    {3149877600 7200 0 EET}
    {3163183200 10800 1 EEST}
    {3181932000 7200 0 EET}
    {3194632800 10800 1 EEST}
    {3213381600 7200 0 EET}
    {3226687200 10800 1 EEST}
    {3244831200 7200 0 EET}
    {3258136800 10800 1 EEST}
    {3276280800 7200 0 EET}
    {3289586400 10800 1 EEST}
    {3307730400 7200 0 EET}
    {3321036000 10800 1 EEST}
    {3339180000 7200 0 EET}
    {3352485600 10800 1 EEST}
    {3371234400 7200 0 EET}
    {3383935200 10800 1 EEST}
    {3402684000 7200 0 EET}
    {3415989600 10800 1 EEST}
    {3434133600 7200 0 EET}
    {3447439200 10800 1 EEST}
    {3465583200 7200 0 EET}
    {3478888800 10800 1 EEST}
    {3497032800 7200 0 EET}
    {3510338400 10800 1 EEST}
    {3529087200 7200 0 EET}
    {3541788000 10800 1 EEST}
    {3560536800 7200 0 EET}
    {3573237600 10800 1 EEST}
    {3591986400 7200 0 EET}
    {3605292000 10800 1 EEST}
    {3623436000 7200 0 EET}
    {3636741600 10800 1 EEST}
    {3654885600 7200 0 EET}
    {3668191200 10800 1 EEST}
    {3686335200 7200 0 EET}
    {3699640800 10800 1 EEST}
    {3718389600 7200 0 EET}
    {3731090400 10800 1 EEST}
    {3749839200 7200 0 EET}
    {3763144800 10800 1 EEST}
    {3781288800 7200 0 EET}
    {3794594400 10800 1 EEST}
    {3812738400 7200 0 EET}
    {3826044000 10800 1 EEST}
    {3844188000 7200 0 EET}
    {3857493600 10800 1 EEST}
    {3876242400 7200 0 EET}
    {3888943200 10800 1 EEST}
    {3907692000 7200 0 EET}
    {3920392800 10800 1 EEST}
    {3939141600 7200 0 EET}
    {3952447200 10800 1 EEST}
    {3970591200 7200 0 EET}
    {3983896800 10800 1 EEST}
    {4002040800 7200 0 EET}
    {4015346400 10800 1 EEST}
    {4033490400 7200 0 EET}
    {4046796000 10800 1 EEST}
    {4065544800 7200 0 EET}
    {4078245600 10800 1 EEST}
    {4096994400 7200 0 EET}
}

Changes to library/tzdata/Asia/Brunei.

1


2
3


4
5
6
7
1
2
3


4
5





+
+
-
-
+
+
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Kuching)]} {
    LoadTimeZoneFile Asia/Kuching

set TZData(:Asia/Brunei) {
}
set TZData(:Asia/Brunei) $TZData(:Asia/Kuching)
    {-9223372036854775808 27580 0 LMT}
    {-1383464380 27000 0 +0730}
    {-1167636600 28800 0 +08}
}

Changes to library/tzdata/Asia/Damascus.

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
118
119
120
121
122
123
124




























125































































































































126







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {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}
    {1666908000 10800 0 +03}
    {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.

1
2
3
4
5
6
7




8
9
10
11
12
13





14
15

16
17
18
19
20
21
22
1
2
3
4
5


6
7
8
9
10





11
12
13
14
15
16

17
18
19
20
21
22
23
24





-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Gaza) {
    {-9223372036854775808 8272 0 LMT}
    {-2185409872 7200 0 EEST}
    {-933645600 10800 1 EEST}
    {-857358000 7200 0 EEST}
    {-933638400 10800 1 EEST}
    {-923097600 7200 0 EEST}
    {-919036800 10800 1 EEST}
    {-857347200 7200 0 EEST}
    {-844300800 10800 1 EEST}
    {-825822000 7200 0 EEST}
    {-812685600 10800 1 EEST}
    {-794199600 7200 0 EEST}
    {-779853600 10800 1 EEST}
    {-762656400 7200 0 EEST}
    {-825811200 7200 0 EEST}
    {-812678400 10800 1 EEST}
    {-794188800 7200 0 EEST}
    {-779846400 10800 1 EEST}
    {-762652800 7200 0 EEST}
    {-748310400 10800 1 EEST}
    {-731127600 7200 0 EEST}
    {-731116800 7200 0 EEST}
    {-682653600 7200 0 EET}
    {-399088800 10800 1 EEST}
    {-386650800 7200 0 EET}
    {-368330400 10800 1 EEST}
    {-355114800 7200 0 EET}
    {-336790800 10800 1 EEST}
    {-323654400 7200 0 EET}
36
37
38
39
40
41
42
43
44
45
46




47
48

49
50
51
52
53
54
55
38
39
40
41
42
43
44




45
46
47
48
49

50
51
52
53
54
55
56
57







-
-
-
-
+
+
+
+

-
+







    {-102643200 7200 0 EET}
    {-84330000 10800 1 EEST}
    {-81313200 10800 0 IST}
    {142376400 10800 1 IDT}
    {150843600 7200 0 IST}
    {167176800 10800 1 IDT}
    {178664400 7200 0 IST}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {334101600 10800 1 IDT}
    {337730400 7200 0 IST}
    {452642400 10800 1 IDT}
    {462319200 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 7200 0 IST}
    {494370000 7200 0 IST}
    {516751200 10800 1 IDT}
    {526424400 7200 0 IST}
    {545436000 10800 1 IDT}
    {558478800 7200 0 IST}
    {576626400 10800 1 IDT}
    {589323600 7200 0 IST}
    {609890400 10800 1 IDT}
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-

    {1521846000 10800 1 EEST}
    {1540591200 7200 0 EET}
    {1553810400 10800 1 EEST}
    {1572037200 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603490400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1635544800 7200 0 EET}
    {1648245600 10800 1 EEST}
    {1666994400 7200 0 EET}
    {1679695200 10800 1 EEST}
    {1698444000 7200 0 EET}
    {1711749600 10800 1 EEST}
    {1729893600 7200 0 EET}
    {1743199200 10800 1 EEST}
    {1761343200 7200 0 EET}
    {1774648800 10800 1 EEST}
    {1792792800 7200 0 EET}
    {1806098400 10800 1 EEST}
    {1824847200 7200 0 EET}
    {1837548000 10800 1 EEST}
    {1856296800 7200 0 EET}
    {1868997600 10800 1 EEST}
    {1887746400 7200 0 EET}
    {1901052000 10800 1 EEST}
    {1635458400 7200 0 EET}
    {1648332000 10800 1 EEST}
    {1666998000 7200 0 EET}
    {1679702400 10800 1 EEST}
    {1698447600 7200 0 EET}
    {1711756800 10800 1 EEST}
    {1729897200 7200 0 EET}
    {1743206400 10800 1 EEST}
    {1761346800 7200 0 EET}
    {1774656000 10800 1 EEST}
    {1792796400 7200 0 EET}
    {1806105600 10800 1 EEST}
    {1824850800 7200 0 EET}
    {1837555200 10800 1 EEST}
    {1856300400 7200 0 EET}
    {1869004800 10800 1 EEST}
    {1887750000 7200 0 EET}
    {1901059200 10800 1 EEST}
    {1919199600 7200 0 EET}
    {1932508800 10800 1 EEST}
    {1950649200 7200 0 EET}
    {1963958400 10800 1 EEST}
    {1919196000 7200 0 EET}
    {1932501600 10800 1 EEST}
    {1950645600 7200 0 EET}
    {1963951200 10800 1 EEST}
    {1982700000 7200 0 EET}
    {1995400800 10800 1 EEST}
    {2014149600 7200 0 EET}
    {2026850400 10800 1 EEST}
    {2045599200 7200 0 EET}
    {2058300000 10800 1 EEST}
    {2077048800 7200 0 EET}
    {2090354400 10800 1 EEST}
    {2108498400 7200 0 EET}
    {2121804000 10800 1 EEST}
    {2139948000 7200 0 EET}
    {2153253600 10800 1 EEST}
    {2172002400 7200 0 EET}
    {2184703200 10800 1 EEST}
    {2203452000 7200 0 EET}
    {2216152800 10800 1 EEST}
    {2234901600 7200 0 EET}
    {2248207200 10800 1 EEST}
    {2266351200 7200 0 EET}
    {2279656800 10800 1 EEST}
    {2297800800 7200 0 EET}
    {2311106400 10800 1 EEST}
    {2329250400 7200 0 EET}
    {2342556000 10800 1 EEST}
    {2361304800 7200 0 EET}
    {2374005600 10800 1 EEST}
    {2392754400 7200 0 EET}
    {2405455200 10800 1 EEST}
    {2424204000 7200 0 EET}
    {2437509600 10800 1 EEST}
    {2455653600 7200 0 EET}
    {2468959200 10800 1 EEST}
    {2487103200 7200 0 EET}
    {1982703600 7200 0 EET}
    {1995408000 10800 1 EEST}
    {2014153200 7200 0 EET}
    {2026857600 10800 1 EEST}
    {2045602800 7200 0 EET}
    {2058307200 10800 1 EEST}
    {2077052400 7200 0 EET}
    {2090361600 10800 1 EEST}
    {2108502000 7200 0 EET}
    {2121811200 10800 1 EEST}
    {2139951600 7200 0 EET}
    {2153260800 10800 1 EEST}
    {2172006000 7200 0 EET}
    {2184710400 10800 1 EEST}
    {2203455600 7200 0 EET}
    {2216160000 10800 1 EEST}
    {2234905200 7200 0 EET}
    {2248214400 10800 1 EEST}
    {2266354800 7200 0 EET}
    {2279664000 10800 1 EEST}
    {2297804400 7200 0 EET}
    {2311113600 10800 1 EEST}
    {2329254000 7200 0 EET}
    {2342563200 10800 1 EEST}
    {2361308400 7200 0 EET}
    {2374012800 10800 1 EEST}
    {2392758000 7200 0 EET}
    {2405462400 10800 1 EEST}
    {2424207600 7200 0 EET}
    {2437516800 10800 1 EEST}
    {2455657200 7200 0 EET}
    {2468966400 10800 1 EEST}
    {2487106800 7200 0 EET}
    {2500416000 10800 1 EEST}
    {2519161200 7200 0 EET}
    {2500408800 10800 1 EEST}
    {2519157600 7200 0 EET}
    {2531858400 10800 1 EEST}
    {2550607200 7200 0 EET}
    {2563308000 10800 1 EEST}
    {2582056800 7200 0 EET}
    {2595362400 10800 1 EEST}
    {2613506400 7200 0 EET}
    {2626812000 10800 1 EEST}
    {2644956000 7200 0 EET}
    {2658261600 10800 1 EEST}
    {2676405600 7200 0 EET}
    {2689711200 10800 1 EEST}
    {2708460000 7200 0 EET}
    {2721160800 10800 1 EEST}
    {2739909600 7200 0 EET}
    {2752610400 10800 1 EEST}
    {2771359200 7200 0 EET}
    {2784664800 10800 1 EEST}
    {2802808800 7200 0 EET}
    {2816114400 10800 1 EEST}
    {2834258400 7200 0 EET}
    {2847564000 10800 1 EEST}
    {2866312800 7200 0 EET}
    {2879013600 10800 1 EEST}
    {2897762400 7200 0 EET}
    {2910463200 10800 1 EEST}
    {2929212000 7200 0 EET}
    {2941912800 10800 1 EEST}
    {2960661600 7200 0 EET}
    {2973967200 10800 1 EEST}
    {2992111200 7200 0 EET}
    {3005416800 10800 1 EEST}
    {3023560800 7200 0 EET}
    {3036866400 10800 1 EEST}
    {3055615200 7200 0 EET}
    {3068316000 10800 1 EEST}
    {3087064800 7200 0 EET}
    {3099765600 10800 1 EEST}
    {3118514400 7200 0 EET}
    {3131820000 10800 1 EEST}
    {3149964000 7200 0 EET}
    {3163269600 10800 1 EEST}
    {3181413600 7200 0 EET}
    {3194719200 10800 1 EEST}
    {3212863200 7200 0 EET}
    {3226168800 10800 1 EEST}
    {3244917600 7200 0 EET}
    {3257618400 10800 1 EEST}
    {3276367200 7200 0 EET}
    {3289068000 10800 1 EEST}
    {3307816800 7200 0 EET}
    {3321122400 10800 1 EEST}
    {3339266400 7200 0 EET}
    {3352572000 10800 1 EEST}
    {3370716000 7200 0 EET}
    {3384021600 10800 1 EEST}
    {3402770400 7200 0 EET}
    {3415471200 10800 1 EEST}
    {3434220000 7200 0 EET}
    {3446920800 10800 1 EEST}
    {3465669600 7200 0 EET}
    {3478975200 10800 1 EEST}
    {3497119200 7200 0 EET}
    {3510424800 10800 1 EEST}
    {3528568800 7200 0 EET}
    {3541874400 10800 1 EEST}
    {3560018400 7200 0 EET}
    {3573324000 10800 1 EEST}
    {3592072800 7200 0 EET}
    {3604773600 10800 1 EEST}
    {3623522400 7200 0 EET}
    {3636223200 10800 1 EEST}
    {3654972000 7200 0 EET}
    {3668277600 10800 1 EEST}
    {3686421600 7200 0 EET}
    {3699727200 10800 1 EEST}
    {3717871200 7200 0 EET}
    {3731176800 10800 1 EEST}
    {3749925600 7200 0 EET}
    {3762626400 10800 1 EEST}
    {3781375200 7200 0 EET}
    {3794076000 10800 1 EEST}
    {3812824800 7200 0 EET}
    {3825525600 10800 1 EEST}
    {3844274400 7200 0 EET}
    {3857580000 10800 1 EEST}
    {3875724000 7200 0 EET}
    {3889029600 10800 1 EEST}
    {3907173600 7200 0 EET}
    {3920479200 10800 1 EEST}
    {3939228000 7200 0 EET}
    {3951928800 10800 1 EEST}
    {3970677600 7200 0 EET}
    {3983378400 10800 1 EEST}
    {4002127200 7200 0 EET}
    {4015432800 10800 1 EEST}
    {4033576800 7200 0 EET}
    {4046882400 10800 1 EEST}
    {4065026400 7200 0 EET}
    {2531865600 10800 1 EEST}
    {2550610800 7200 0 EET}
    {2563315200 10800 1 EEST}
    {2582060400 7200 0 EET}
    {2595369600 10800 1 EEST}
    {2613510000 7200 0 EET}
    {2626819200 10800 1 EEST}
    {2644959600 7200 0 EET}
    {2658268800 10800 1 EEST}
    {2676409200 7200 0 EET}
    {2689718400 10800 1 EEST}
    {2708463600 7200 0 EET}
    {2721168000 10800 1 EEST}
    {2739913200 7200 0 EET}
    {2752617600 10800 1 EEST}
    {2771362800 7200 0 EET}
    {2784672000 10800 1 EEST}
    {2802812400 7200 0 EET}
    {2816121600 10800 1 EEST}
    {2834262000 7200 0 EET}
    {2847571200 10800 1 EEST}
    {2866316400 7200 0 EET}
    {2879020800 10800 1 EEST}
    {2897766000 7200 0 EET}
    {2910470400 10800 1 EEST}
    {2929215600 7200 0 EET}
    {2941920000 10800 1 EEST}
    {2960665200 7200 0 EET}
    {2973974400 10800 1 EEST}
    {2992114800 7200 0 EET}
    {3005424000 10800 1 EEST}
    {3023564400 7200 0 EET}
    {3036873600 10800 1 EEST}
    {3055618800 7200 0 EET}
    {3068323200 10800 1 EEST}
    {3087068400 7200 0 EET}
    {3099772800 10800 1 EEST}
    {3118518000 7200 0 EET}
    {3131827200 10800 1 EEST}
    {3149967600 7200 0 EET}
    {3163276800 10800 1 EEST}
    {3181417200 7200 0 EET}
    {3194726400 10800 1 EEST}
    {3212866800 7200 0 EET}
    {3226176000 10800 1 EEST}
    {3244921200 7200 0 EET}
    {3257625600 10800 1 EEST}
    {3276370800 7200 0 EET}
    {3289075200 10800 1 EEST}
    {3307820400 7200 0 EET}
    {3321129600 10800 1 EEST}
    {3339270000 7200 0 EET}
    {3352579200 10800 1 EEST}
    {3370719600 7200 0 EET}
    {3384028800 10800 1 EEST}
    {3402774000 7200 0 EET}
    {3415478400 10800 1 EEST}
    {3434223600 7200 0 EET}
    {3446928000 10800 1 EEST}
    {3465673200 7200 0 EET}
    {3478982400 10800 1 EEST}
    {3497122800 7200 0 EET}
    {3510432000 10800 1 EEST}
    {3528572400 7200 0 EET}
    {3541881600 10800 1 EEST}
    {3560022000 7200 0 EET}
    {3573331200 10800 1 EEST}
    {3592076400 7200 0 EET}
    {3604780800 10800 1 EEST}
    {3623526000 7200 0 EET}
    {3636230400 10800 1 EEST}
    {3654975600 7200 0 EET}
    {3668284800 10800 1 EEST}
    {3686425200 7200 0 EET}
    {3699734400 10800 1 EEST}
    {3717874800 7200 0 EET}
    {3731184000 10800 1 EEST}
    {3749929200 7200 0 EET}
    {3762633600 10800 1 EEST}
    {3781378800 7200 0 EET}
    {3794083200 10800 1 EEST}
    {3812828400 7200 0 EET}
    {3825532800 10800 1 EEST}
    {3844278000 7200 0 EET}
    {3857587200 10800 1 EEST}
    {3875727600 7200 0 EET}
    {3889036800 10800 1 EEST}
    {3907177200 7200 0 EET}
    {3920486400 10800 1 EEST}
    {3939231600 7200 0 EET}
    {3951936000 10800 1 EEST}
    {3970681200 7200 0 EET}
    {3983385600 10800 1 EEST}
    {4002130800 7200 0 EET}
    {4015440000 10800 1 EEST}
    {4033580400 7200 0 EET}
    {4046889600 10800 1 EEST}
    {4065030000 7200 0 EET}
    {4078339200 10800 1 EEST}
    {4096479600 7200 0 EET}
    {4078332000 10800 1 EEST}
    {4096476000 7200 0 EET}
}

Changes to library/tzdata/Asia/Hebron.

1
2
3
4
5
6
7




8
9
10
11
12
13





14
15

16
17
18
19
20
21
22
1
2
3
4
5


6
7
8
9
10





11
12
13
14
15
16

17
18
19
20
21
22
23
24





-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Hebron) {
    {-9223372036854775808 8423 0 LMT}
    {-2185410023 7200 0 EEST}
    {-933645600 10800 1 EEST}
    {-857358000 7200 0 EEST}
    {-933638400 10800 1 EEST}
    {-923097600 7200 0 EEST}
    {-919036800 10800 1 EEST}
    {-857347200 7200 0 EEST}
    {-844300800 10800 1 EEST}
    {-825822000 7200 0 EEST}
    {-812685600 10800 1 EEST}
    {-794199600 7200 0 EEST}
    {-779853600 10800 1 EEST}
    {-762656400 7200 0 EEST}
    {-825811200 7200 0 EEST}
    {-812678400 10800 1 EEST}
    {-794188800 7200 0 EEST}
    {-779846400 10800 1 EEST}
    {-762652800 7200 0 EEST}
    {-748310400 10800 1 EEST}
    {-731127600 7200 0 EEST}
    {-731116800 7200 0 EEST}
    {-682653600 7200 0 EET}
    {-399088800 10800 1 EEST}
    {-386650800 7200 0 EET}
    {-368330400 10800 1 EEST}
    {-355114800 7200 0 EET}
    {-336790800 10800 1 EEST}
    {-323654400 7200 0 EET}
36
37
38
39
40
41
42
43
44
45
46




47
48

49
50
51
52
53
54
55
38
39
40
41
42
43
44




45
46
47
48
49

50
51
52
53
54
55
56
57







-
-
-
-
+
+
+
+

-
+







    {-102643200 7200 0 EET}
    {-84330000 10800 1 EEST}
    {-81313200 10800 0 IST}
    {142376400 10800 1 IDT}
    {150843600 7200 0 IST}
    {167176800 10800 1 IDT}
    {178664400 7200 0 IST}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {334101600 10800 1 IDT}
    {337730400 7200 0 IST}
    {452642400 10800 1 IDT}
    {462319200 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 7200 0 IST}
    {494370000 7200 0 IST}
    {516751200 10800 1 IDT}
    {526424400 7200 0 IST}
    {545436000 10800 1 IDT}
    {558478800 7200 0 IST}
    {576626400 10800 1 IDT}
    {589323600 7200 0 IST}
    {609890400 10800 1 IDT}
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-

    {1521846000 10800 1 EEST}
    {1540591200 7200 0 EET}
    {1553810400 10800 1 EEST}
    {1572037200 7200 0 EET}
    {1585346400 10800 1 EEST}
    {1603490400 7200 0 EET}
    {1616796000 10800 1 EEST}
    {1635544800 7200 0 EET}
    {1648245600 10800 1 EEST}
    {1666994400 7200 0 EET}
    {1679695200 10800 1 EEST}
    {1698444000 7200 0 EET}
    {1711749600 10800 1 EEST}
    {1729893600 7200 0 EET}
    {1743199200 10800 1 EEST}
    {1761343200 7200 0 EET}
    {1774648800 10800 1 EEST}
    {1792792800 7200 0 EET}
    {1806098400 10800 1 EEST}
    {1824847200 7200 0 EET}
    {1837548000 10800 1 EEST}
    {1856296800 7200 0 EET}
    {1868997600 10800 1 EEST}
    {1887746400 7200 0 EET}
    {1901052000 10800 1 EEST}
    {1635458400 7200 0 EET}
    {1648332000 10800 1 EEST}
    {1666998000 7200 0 EET}
    {1679702400 10800 1 EEST}
    {1698447600 7200 0 EET}
    {1711756800 10800 1 EEST}
    {1729897200 7200 0 EET}
    {1743206400 10800 1 EEST}
    {1761346800 7200 0 EET}
    {1774656000 10800 1 EEST}
    {1792796400 7200 0 EET}
    {1806105600 10800 1 EEST}
    {1824850800 7200 0 EET}
    {1837555200 10800 1 EEST}
    {1856300400 7200 0 EET}
    {1869004800 10800 1 EEST}
    {1887750000 7200 0 EET}
    {1901059200 10800 1 EEST}
    {1919199600 7200 0 EET}
    {1932508800 10800 1 EEST}
    {1950649200 7200 0 EET}
    {1963958400 10800 1 EEST}
    {1919196000 7200 0 EET}
    {1932501600 10800 1 EEST}
    {1950645600 7200 0 EET}
    {1963951200 10800 1 EEST}
    {1982700000 7200 0 EET}
    {1995400800 10800 1 EEST}
    {2014149600 7200 0 EET}
    {2026850400 10800 1 EEST}
    {2045599200 7200 0 EET}
    {2058300000 10800 1 EEST}
    {2077048800 7200 0 EET}
    {2090354400 10800 1 EEST}
    {2108498400 7200 0 EET}
    {2121804000 10800 1 EEST}
    {2139948000 7200 0 EET}
    {2153253600 10800 1 EEST}
    {2172002400 7200 0 EET}
    {2184703200 10800 1 EEST}
    {2203452000 7200 0 EET}
    {2216152800 10800 1 EEST}
    {2234901600 7200 0 EET}
    {2248207200 10800 1 EEST}
    {2266351200 7200 0 EET}
    {2279656800 10800 1 EEST}
    {2297800800 7200 0 EET}
    {2311106400 10800 1 EEST}
    {2329250400 7200 0 EET}
    {2342556000 10800 1 EEST}
    {2361304800 7200 0 EET}
    {2374005600 10800 1 EEST}
    {2392754400 7200 0 EET}
    {2405455200 10800 1 EEST}
    {2424204000 7200 0 EET}
    {2437509600 10800 1 EEST}
    {2455653600 7200 0 EET}
    {2468959200 10800 1 EEST}
    {2487103200 7200 0 EET}
    {1982703600 7200 0 EET}
    {1995408000 10800 1 EEST}
    {2014153200 7200 0 EET}
    {2026857600 10800 1 EEST}
    {2045602800 7200 0 EET}
    {2058307200 10800 1 EEST}
    {2077052400 7200 0 EET}
    {2090361600 10800 1 EEST}
    {2108502000 7200 0 EET}
    {2121811200 10800 1 EEST}
    {2139951600 7200 0 EET}
    {2153260800 10800 1 EEST}
    {2172006000 7200 0 EET}
    {2184710400 10800 1 EEST}
    {2203455600 7200 0 EET}
    {2216160000 10800 1 EEST}
    {2234905200 7200 0 EET}
    {2248214400 10800 1 EEST}
    {2266354800 7200 0 EET}
    {2279664000 10800 1 EEST}
    {2297804400 7200 0 EET}
    {2311113600 10800 1 EEST}
    {2329254000 7200 0 EET}
    {2342563200 10800 1 EEST}
    {2361308400 7200 0 EET}
    {2374012800 10800 1 EEST}
    {2392758000 7200 0 EET}
    {2405462400 10800 1 EEST}
    {2424207600 7200 0 EET}
    {2437516800 10800 1 EEST}
    {2455657200 7200 0 EET}
    {2468966400 10800 1 EEST}
    {2487106800 7200 0 EET}
    {2500416000 10800 1 EEST}
    {2519161200 7200 0 EET}
    {2500408800 10800 1 EEST}
    {2519157600 7200 0 EET}
    {2531858400 10800 1 EEST}
    {2550607200 7200 0 EET}
    {2563308000 10800 1 EEST}
    {2582056800 7200 0 EET}
    {2595362400 10800 1 EEST}
    {2613506400 7200 0 EET}
    {2626812000 10800 1 EEST}
    {2644956000 7200 0 EET}
    {2658261600 10800 1 EEST}
    {2676405600 7200 0 EET}
    {2689711200 10800 1 EEST}
    {2708460000 7200 0 EET}
    {2721160800 10800 1 EEST}
    {2739909600 7200 0 EET}
    {2752610400 10800 1 EEST}
    {2771359200 7200 0 EET}
    {2784664800 10800 1 EEST}
    {2802808800 7200 0 EET}
    {2816114400 10800 1 EEST}
    {2834258400 7200 0 EET}
    {2847564000 10800 1 EEST}
    {2866312800 7200 0 EET}
    {2879013600 10800 1 EEST}
    {2897762400 7200 0 EET}
    {2910463200 10800 1 EEST}
    {2929212000 7200 0 EET}
    {2941912800 10800 1 EEST}
    {2960661600 7200 0 EET}
    {2973967200 10800 1 EEST}
    {2992111200 7200 0 EET}
    {3005416800 10800 1 EEST}
    {3023560800 7200 0 EET}
    {3036866400 10800 1 EEST}
    {3055615200 7200 0 EET}
    {3068316000 10800 1 EEST}
    {3087064800 7200 0 EET}
    {3099765600 10800 1 EEST}
    {3118514400 7200 0 EET}
    {3131820000 10800 1 EEST}
    {3149964000 7200 0 EET}
    {3163269600 10800 1 EEST}
    {3181413600 7200 0 EET}
    {3194719200 10800 1 EEST}
    {3212863200 7200 0 EET}
    {3226168800 10800 1 EEST}
    {3244917600 7200 0 EET}
    {3257618400 10800 1 EEST}
    {3276367200 7200 0 EET}
    {3289068000 10800 1 EEST}
    {3307816800 7200 0 EET}
    {3321122400 10800 1 EEST}
    {3339266400 7200 0 EET}
    {3352572000 10800 1 EEST}
    {3370716000 7200 0 EET}
    {3384021600 10800 1 EEST}
    {3402770400 7200 0 EET}
    {3415471200 10800 1 EEST}
    {3434220000 7200 0 EET}
    {3446920800 10800 1 EEST}
    {3465669600 7200 0 EET}
    {3478975200 10800 1 EEST}
    {3497119200 7200 0 EET}
    {3510424800 10800 1 EEST}
    {3528568800 7200 0 EET}
    {3541874400 10800 1 EEST}
    {3560018400 7200 0 EET}
    {3573324000 10800 1 EEST}
    {3592072800 7200 0 EET}
    {3604773600 10800 1 EEST}
    {3623522400 7200 0 EET}
    {3636223200 10800 1 EEST}
    {3654972000 7200 0 EET}
    {3668277600 10800 1 EEST}
    {3686421600 7200 0 EET}
    {3699727200 10800 1 EEST}
    {3717871200 7200 0 EET}
    {3731176800 10800 1 EEST}
    {3749925600 7200 0 EET}
    {3762626400 10800 1 EEST}
    {3781375200 7200 0 EET}
    {3794076000 10800 1 EEST}
    {3812824800 7200 0 EET}
    {3825525600 10800 1 EEST}
    {3844274400 7200 0 EET}
    {3857580000 10800 1 EEST}
    {3875724000 7200 0 EET}
    {3889029600 10800 1 EEST}
    {3907173600 7200 0 EET}
    {3920479200 10800 1 EEST}
    {3939228000 7200 0 EET}
    {3951928800 10800 1 EEST}
    {3970677600 7200 0 EET}
    {3983378400 10800 1 EEST}
    {4002127200 7200 0 EET}
    {4015432800 10800 1 EEST}
    {4033576800 7200 0 EET}
    {4046882400 10800 1 EEST}
    {4065026400 7200 0 EET}
    {2531865600 10800 1 EEST}
    {2550610800 7200 0 EET}
    {2563315200 10800 1 EEST}
    {2582060400 7200 0 EET}
    {2595369600 10800 1 EEST}
    {2613510000 7200 0 EET}
    {2626819200 10800 1 EEST}
    {2644959600 7200 0 EET}
    {2658268800 10800 1 EEST}
    {2676409200 7200 0 EET}
    {2689718400 10800 1 EEST}
    {2708463600 7200 0 EET}
    {2721168000 10800 1 EEST}
    {2739913200 7200 0 EET}
    {2752617600 10800 1 EEST}
    {2771362800 7200 0 EET}
    {2784672000 10800 1 EEST}
    {2802812400 7200 0 EET}
    {2816121600 10800 1 EEST}
    {2834262000 7200 0 EET}
    {2847571200 10800 1 EEST}
    {2866316400 7200 0 EET}
    {2879020800 10800 1 EEST}
    {2897766000 7200 0 EET}
    {2910470400 10800 1 EEST}
    {2929215600 7200 0 EET}
    {2941920000 10800 1 EEST}
    {2960665200 7200 0 EET}
    {2973974400 10800 1 EEST}
    {2992114800 7200 0 EET}
    {3005424000 10800 1 EEST}
    {3023564400 7200 0 EET}
    {3036873600 10800 1 EEST}
    {3055618800 7200 0 EET}
    {3068323200 10800 1 EEST}
    {3087068400 7200 0 EET}
    {3099772800 10800 1 EEST}
    {3118518000 7200 0 EET}
    {3131827200 10800 1 EEST}
    {3149967600 7200 0 EET}
    {3163276800 10800 1 EEST}
    {3181417200 7200 0 EET}
    {3194726400 10800 1 EEST}
    {3212866800 7200 0 EET}
    {3226176000 10800 1 EEST}
    {3244921200 7200 0 EET}
    {3257625600 10800 1 EEST}
    {3276370800 7200 0 EET}
    {3289075200 10800 1 EEST}
    {3307820400 7200 0 EET}
    {3321129600 10800 1 EEST}
    {3339270000 7200 0 EET}
    {3352579200 10800 1 EEST}
    {3370719600 7200 0 EET}
    {3384028800 10800 1 EEST}
    {3402774000 7200 0 EET}
    {3415478400 10800 1 EEST}
    {3434223600 7200 0 EET}
    {3446928000 10800 1 EEST}
    {3465673200 7200 0 EET}
    {3478982400 10800 1 EEST}
    {3497122800 7200 0 EET}
    {3510432000 10800 1 EEST}
    {3528572400 7200 0 EET}
    {3541881600 10800 1 EEST}
    {3560022000 7200 0 EET}
    {3573331200 10800 1 EEST}
    {3592076400 7200 0 EET}
    {3604780800 10800 1 EEST}
    {3623526000 7200 0 EET}
    {3636230400 10800 1 EEST}
    {3654975600 7200 0 EET}
    {3668284800 10800 1 EEST}
    {3686425200 7200 0 EET}
    {3699734400 10800 1 EEST}
    {3717874800 7200 0 EET}
    {3731184000 10800 1 EEST}
    {3749929200 7200 0 EET}
    {3762633600 10800 1 EEST}
    {3781378800 7200 0 EET}
    {3794083200 10800 1 EEST}
    {3812828400 7200 0 EET}
    {3825532800 10800 1 EEST}
    {3844278000 7200 0 EET}
    {3857587200 10800 1 EEST}
    {3875727600 7200 0 EET}
    {3889036800 10800 1 EEST}
    {3907177200 7200 0 EET}
    {3920486400 10800 1 EEST}
    {3939231600 7200 0 EET}
    {3951936000 10800 1 EEST}
    {3970681200 7200 0 EET}
    {3983385600 10800 1 EEST}
    {4002130800 7200 0 EET}
    {4015440000 10800 1 EEST}
    {4033580400 7200 0 EET}
    {4046889600 10800 1 EEST}
    {4065030000 7200 0 EET}
    {4078339200 10800 1 EEST}
    {4096479600 7200 0 EET}
    {4078332000 10800 1 EEST}
    {4096476000 7200 0 EET}
}

Changes to library/tzdata/Asia/Ho_Chi_Minh.

1
2
3
4
5


6
7
8
9
10
11
12
1
2
3


4
5
6
7
8
9
10
11
12



-
-
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Ho_Chi_Minh) {
    {-9223372036854775808 25600 0 LMT}
    {-2004073600 25590 0 PLMT}
    {-9223372036854775808 25590 0 LMT}
    {-2004073590 25590 0 PLMT}
    {-1851577590 25200 0 +07}
    {-852105600 28800 0 +08}
    {-782643600 32400 0 +09}
    {-767869200 25200 0 +07}
    {-718095600 28800 0 +08}
    {-457776000 25200 0 +07}
    {-315648000 28800 0 +08}

Changes to library/tzdata/Asia/Jerusalem.

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
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






-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+





-
-
-
-
-
+
+
+
+
+

-
-
+
+




-
-
-
-
+
+
+
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Jerusalem) {
    {-9223372036854775808 8454 0 LMT}
    {-2840149254 8440 0 JMT}
    {-1641003640 7200 0 IST}
    {-933645600 10800 1 IDT}
    {-857358000 7200 0 IST}
    {-933638400 10800 1 IDT}
    {-923097600 7200 0 IST}
    {-919036800 10800 1 IDT}
    {-857347200 7200 0 IST}
    {-844300800 10800 1 IDT}
    {-825822000 7200 0 IST}
    {-812685600 10800 1 IDT}
    {-794199600 7200 0 IST}
    {-779853600 10800 1 IDT}
    {-762656400 7200 0 IST}
    {-825811200 7200 0 IST}
    {-812678400 10800 1 IDT}
    {-794188800 7200 0 IST}
    {-779846400 10800 1 IDT}
    {-762652800 7200 0 IST}
    {-748310400 10800 1 IDT}
    {-731127600 7200 0 IST}
    {-681962400 14400 1 IDDT}
    {-673243200 10800 1 IDT}
    {-667962000 7200 0 IST}
    {-652327200 10800 1 IDT}
    {-636426000 7200 0 IST}
    {-622087200 10800 1 IDT}
    {-731116800 7200 0 IST}
    {-681955200 14400 1 IDDT}
    {-673228800 10800 1 IDT}
    {-667958400 7200 0 IST}
    {-652320000 10800 1 IDT}
    {-636422400 7200 0 IST}
    {-622080000 10800 1 IDT}
    {-608947200 7200 0 IST}
    {-591847200 10800 1 IDT}
    {-591840000 10800 1 IDT}
    {-572486400 7200 0 IST}
    {-558576000 10800 1 IDT}
    {-542851200 7200 0 IST}
    {-527731200 10800 1 IDT}
    {-514425600 7200 0 IST}
    {-490845600 10800 1 IDT}
    {-482986800 7200 0 IST}
    {-459475200 10800 1 IDT}
    {-451537200 7200 0 IST}
    {-428551200 10800 1 IDT}
    {-490838400 10800 1 IDT}
    {-482976000 7200 0 IST}
    {-459388800 10800 1 IDT}
    {-451526400 7200 0 IST}
    {-428544000 10800 1 IDT}
    {-418262400 7200 0 IST}
    {-400032000 10800 1 IDT}
    {-387428400 7200 0 IST}
    {-400118400 10800 1 IDT}
    {-387417600 7200 0 IST}
    {142380000 10800 1 IDT}
    {150843600 7200 0 IST}
    {167176800 10800 1 IDT}
    {178664400 7200 0 IST}
    {334015200 10800 1 IDT}
    {337644000 7200 0 IST}
    {452556000 10800 1 IDT}
    {462232800 7200 0 IST}
    {334101600 10800 1 IDT}
    {337730400 7200 0 IST}
    {452642400 10800 1 IDT}
    {462319200 7200 0 IST}
    {482277600 10800 1 IDT}
    {495579600 7200 0 IST}
    {494370000 7200 0 IST}
    {516751200 10800 1 IDT}
    {526424400 7200 0 IST}
    {545436000 10800 1 IDT}
    {558478800 7200 0 IST}
    {576626400 10800 1 IDT}
    {589323600 7200 0 IST}
    {609890400 10800 1 IDT}

Changes to library/tzdata/Asia/Kuala_Lumpur.

1


2
3


4
5
6
7
8
9
10
11
12
13
1
2
3


4
5











+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Singapore)]} {
    LoadTimeZoneFile Asia/Singapore

set TZData(:Asia/Kuala_Lumpur) {
}
set TZData(:Asia/Kuala_Lumpur) $TZData(:Asia/Singapore)
    {-9223372036854775808 24406 0 LMT}
    {-2177477206 24925 0 SMT}
    {-2038200925 25200 0 +07}
    {-1167634800 26400 1 +0720}
    {-1073028000 26400 0 +0720}
    {-894180000 27000 0 +0730}
    {-879665400 32400 0 +09}
    {-767005200 27000 0 +0730}
    {378664200 28800 0 +08}
}

Changes to library/tzdata/Asia/Singapore.

1
2
3
4
5
6
7
8
9
10
11
12

13
1
2
3
4
5
6
7
8
9
10
11

12
13











-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Singapore) {
    {-9223372036854775808 24925 0 LMT}
    {-2177477725 24925 0 SMT}
    {-2038200925 25200 0 +07}
    {-1167634800 26400 1 +0720}
    {-1073028000 26400 0 +0720}
    {-894180000 27000 0 +0730}
    {-879665400 32400 0 +09}
    {-767005200 27000 0 +0730}
    {378664200 28800 0 +08}
    {378662400 28800 0 +08}
}

Changes to library/tzdata/Asia/Tehran.

1
2
3
4
5
6
7
8
9





10
11

12
13
14
15
16
17
18
1
2
3
4
5




6
7
8
9
10
11

12
13
14
15
16
17
18
19





-
-
-
-
+
+
+
+
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Asia/Tehran) {
    {-9223372036854775808 12344 0 LMT}
    {-1704165944 12344 0 TMT}
    {-757394744 12600 0 +0330}
    {247177800 14400 0 +04}
    {259272000 18000 1 +04}
    {277758000 14400 0 +04}
    {-1090466744 12600 0 +0330}
    {227820600 16200 1 +0330}
    {246227400 14400 0 +04}
    {259617600 18000 1 +04}
    {271108800 14400 0 +04}
    {283982400 12600 0 +0330}
    {290809800 16200 1 +0330}
    {296598600 16200 1 +0330}
    {306531000 12600 0 +0330}
    {322432200 16200 1 +0330}
    {338499000 12600 0 +0330}
    {673216200 16200 1 +0330}
    {685481400 12600 0 +0330}
    {701209800 16200 1 +0330}
    {717103800 12600 0 +0330}
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
69
70
71
72
73
74
75


























































































































































76







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1569094200 12600 0 +0330}
    {1584736200 16200 1 +0330}
    {1600630200 12600 0 +0330}
    {1616358600 16200 1 +0330}
    {1632252600 12600 0 +0330}
    {1647894600 16200 1 +0330}
    {1663788600 12600 0 +0330}
    {1679430600 16200 1 +0330}
    {1695324600 12600 0 +0330}
    {1710966600 16200 1 +0330}
    {1726860600 12600 0 +0330}
    {1742589000 16200 1 +0330}
    {1758483000 12600 0 +0330}
    {1774125000 16200 1 +0330}
    {1790019000 12600 0 +0330}
    {1805661000 16200 1 +0330}
    {1821555000 12600 0 +0330}
    {1837197000 16200 1 +0330}
    {1853091000 12600 0 +0330}
    {1868733000 16200 1 +0330}
    {1884627000 12600 0 +0330}
    {1900355400 16200 1 +0330}
    {1916249400 12600 0 +0330}
    {1931891400 16200 1 +0330}
    {1947785400 12600 0 +0330}
    {1963427400 16200 1 +0330}
    {1979321400 12600 0 +0330}
    {1994963400 16200 1 +0330}
    {2010857400 12600 0 +0330}
    {2026585800 16200 1 +0330}
    {2042479800 12600 0 +0330}
    {2058121800 16200 1 +0330}
    {2074015800 12600 0 +0330}
    {2089657800 16200 1 +0330}
    {2105551800 12600 0 +0330}
    {2121193800 16200 1 +0330}
    {2137087800 12600 0 +0330}
    {2152816200 16200 1 +0330}
    {2168710200 12600 0 +0330}
    {2184352200 16200 1 +0330}
    {2200246200 12600 0 +0330}
    {2215888200 16200 1 +0330}
    {2231782200 12600 0 +0330}
    {2247424200 16200 1 +0330}
    {2263318200 12600 0 +0330}
    {2279046600 16200 1 +0330}
    {2294940600 12600 0 +0330}
    {2310582600 16200 1 +0330}
    {2326476600 12600 0 +0330}
    {2342118600 16200 1 +0330}
    {2358012600 12600 0 +0330}
    {2373654600 16200 1 +0330}
    {2389548600 12600 0 +0330}
    {2405277000 16200 1 +0330}
    {2421171000 12600 0 +0330}
    {2436813000 16200 1 +0330}
    {2452707000 12600 0 +0330}
    {2468349000 16200 1 +0330}
    {2484243000 12600 0 +0330}
    {2499885000 16200 1 +0330}
    {2515779000 12600 0 +0330}
    {2531507400 16200 1 +0330}
    {2547401400 12600 0 +0330}
    {2563043400 16200 1 +0330}
    {2578937400 12600 0 +0330}
    {2594579400 16200 1 +0330}
    {2610473400 12600 0 +0330}
    {2626115400 16200 1 +0330}
    {2642009400 12600 0 +0330}
    {2657737800 16200 1 +0330}
    {2673631800 12600 0 +0330}
    {2689273800 16200 1 +0330}
    {2705167800 12600 0 +0330}
    {2720809800 16200 1 +0330}
    {2736703800 12600 0 +0330}
    {2752345800 16200 1 +0330}
    {2768239800 12600 0 +0330}
    {2783968200 16200 1 +0330}
    {2799862200 12600 0 +0330}
    {2815504200 16200 1 +0330}
    {2831398200 12600 0 +0330}
    {2847040200 16200 1 +0330}
    {2862934200 12600 0 +0330}
    {2878576200 16200 1 +0330}
    {2894470200 12600 0 +0330}
    {2910112200 16200 1 +0330}
    {2926006200 12600 0 +0330}
    {2941734600 16200 1 +0330}
    {2957628600 12600 0 +0330}
    {2973270600 16200 1 +0330}
    {2989164600 12600 0 +0330}
    {3004806600 16200 1 +0330}
    {3020700600 12600 0 +0330}
    {3036342600 16200 1 +0330}
    {3052236600 12600 0 +0330}
    {3067965000 16200 1 +0330}
    {3083859000 12600 0 +0330}
    {3099501000 16200 1 +0330}
    {3115395000 12600 0 +0330}
    {3131037000 16200 1 +0330}
    {3146931000 12600 0 +0330}
    {3162573000 16200 1 +0330}
    {3178467000 12600 0 +0330}
    {3194195400 16200 1 +0330}
    {3210089400 12600 0 +0330}
    {3225731400 16200 1 +0330}
    {3241625400 12600 0 +0330}
    {3257267400 16200 1 +0330}
    {3273161400 12600 0 +0330}
    {3288803400 16200 1 +0330}
    {3304697400 12600 0 +0330}
    {3320425800 16200 1 +0330}
    {3336319800 12600 0 +0330}
    {3351961800 16200 1 +0330}
    {3367855800 12600 0 +0330}
    {3383497800 16200 1 +0330}
    {3399391800 12600 0 +0330}
    {3415033800 16200 1 +0330}
    {3430927800 12600 0 +0330}
    {3446656200 16200 1 +0330}
    {3462550200 12600 0 +0330}
    {3478192200 16200 1 +0330}
    {3494086200 12600 0 +0330}
    {3509728200 16200 1 +0330}
    {3525622200 12600 0 +0330}
    {3541264200 16200 1 +0330}
    {3557158200 12600 0 +0330}
    {3572886600 16200 1 +0330}
    {3588780600 12600 0 +0330}
    {3604422600 16200 1 +0330}
    {3620316600 12600 0 +0330}
    {3635958600 16200 1 +0330}
    {3651852600 12600 0 +0330}
    {3667494600 16200 1 +0330}
    {3683388600 12600 0 +0330}
    {3699117000 16200 1 +0330}
    {3715011000 12600 0 +0330}
    {3730653000 16200 1 +0330}
    {3746547000 12600 0 +0330}
    {3762189000 16200 1 +0330}
    {3778083000 12600 0 +0330}
    {3793725000 16200 1 +0330}
    {3809619000 12600 0 +0330}
    {3825261000 16200 1 +0330}
    {3841155000 12600 0 +0330}
    {3856883400 16200 1 +0330}
    {3872777400 12600 0 +0330}
    {3888419400 16200 1 +0330}
    {3904313400 12600 0 +0330}
    {3919955400 16200 1 +0330}
    {3935849400 12600 0 +0330}
    {3951491400 16200 1 +0330}
    {3967385400 12600 0 +0330}
    {3983113800 16200 1 +0330}
    {3999007800 12600 0 +0330}
    {4014649800 16200 1 +0330}
    {4030543800 12600 0 +0330}
    {4046185800 16200 1 +0330}
    {4062079800 12600 0 +0330}
    {4077721800 16200 1 +0330}
    {4093615800 12600 0 +0330}
}

Changes to library/tzdata/Atlantic/Azores.

62
63
64
65
66
67
68


69
70
71
72
73
74
75
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77







+
+







    {-733359600 -7200 0 -02}
    {-717624000 -3600 1 -01}
    {-701899200 -7200 0 -02}
    {-686174400 -3600 1 -01}
    {-670449600 -7200 0 -02}
    {-654724800 -3600 1 -01}
    {-639000000 -7200 0 -02}
    {-623275200 -3600 1 -01}
    {-607550400 -7200 0 -02}
    {-591825600 -3600 1 -01}
    {-575496000 -7200 0 -02}
    {-559771200 -3600 1 -01}
    {-544046400 -7200 0 -02}
    {-528321600 -3600 1 -01}
    {-512596800 -7200 0 -02}
    {-496872000 -3600 1 -01}

Changes to library/tzdata/Atlantic/Bermuda.

1
2
3
4





5























6
7
8
9
10
11
12
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




+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Atlantic/Bermuda) {
    {-9223372036854775808 -15558 0 LMT}
    {-2524506042 -15558 0 BMT}
    {-1664307642 -11958 1 BMT}
    {-1648932042 -15558 0 BMT}
    {-1632080442 -11958 1 BMT}
    {-1618692042 -15558 0 BST}
    {-1262281242 -14400 0 AST}
    {-1262281242 -14400 0 AT}
    {-882727200 -10800 1 ADT}
    {-858538800 -14400 0 AST}
    {-845229600 -10800 1 ADT}
    {-825879600 -14400 0 AST}
    {-814384800 -10800 1 ADT}
    {-793825200 -14400 0 AST}
    {-782935200 -10800 1 ADT}
    {-762375600 -14400 0 AST}
    {-713988000 -10800 1 ADT}
    {-703710000 -14400 0 AST}
    {-681933600 -10800 1 ADT}
    {-672865200 -14400 0 AST}
    {-650484000 -10800 1 ADT}
    {-641415600 -14400 0 AST}
    {-618429600 -10800 1 ADT}
    {-609966000 -14400 0 AST}
    {-586980000 -10800 1 ADT}
    {-578516400 -14400 0 AST}
    {-555530400 -10800 1 ADT}
    {-546462000 -14400 0 AST}
    {-429127200 -10800 1 ADT}
    {-415825200 -14400 0 AST}
    {136360800 -10800 0 ADT}
    {152082000 -14400 0 AST}
    {167810400 -10800 1 ADT}
    {183531600 -14400 0 AST}
    {189316800 -14400 0 AST}
    {199260000 -10800 1 ADT}
    {215586000 -14400 0 AST}

Changes to library/tzdata/Atlantic/Jan_Mayen.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Oslo)]} {
    LoadTimeZoneFile Europe/Oslo
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin
}
set TZData(:Atlantic/Jan_Mayen) $TZData(:Europe/Oslo)
set TZData(:Atlantic/Jan_Mayen) $TZData(:Europe/Berlin)

Changes to library/tzdata/Atlantic/Madeira.

62
63
64
65
66
67
68


69
70
71
72
73
74
75
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77







+
+







    {-733363200 -3600 0 -01}
    {-717627600 0 1 +00}
    {-701902800 -3600 0 -01}
    {-686178000 0 1 +00}
    {-670453200 -3600 0 -01}
    {-654728400 0 1 +00}
    {-639003600 -3600 0 -01}
    {-623278800 0 1 +00}
    {-607554000 -3600 0 -01}
    {-591829200 0 1 +00}
    {-575499600 -3600 0 -01}
    {-559774800 0 1 +00}
    {-544050000 -3600 0 -01}
    {-528325200 0 1 +00}
    {-512600400 -3600 0 -01}
    {-496875600 0 1 +00}

Changes to library/tzdata/Atlantic/Reykjavik.

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
1
2
3


4
5







































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Africa/Abidjan)]} {
    LoadTimeZoneFile Africa/Abidjan

set TZData(:Atlantic/Reykjavik) {
}
set TZData(:Atlantic/Reykjavik) $TZData(:Africa/Abidjan)
    {-9223372036854775808 -5280 0 LMT}
    {-1956609120 -3600 0 -01}
    {-1668211200 0 1 -01}
    {-1647212400 -3600 0 -01}
    {-1636675200 0 1 -01}
    {-1613430000 -3600 0 -01}
    {-1605139200 0 1 -01}
    {-1581894000 -3600 0 -01}
    {-1539561600 0 1 -01}
    {-1531350000 -3600 0 -01}
    {-968025600 0 1 -01}
    {-952293600 -3600 0 -01}
    {-942008400 0 1 -01}
    {-920239200 -3600 0 -01}
    {-909957600 0 1 -01}
    {-888789600 -3600 0 -01}
    {-877903200 0 1 -01}
    {-857944800 -3600 0 -01}
    {-846453600 0 1 -01}
    {-826495200 -3600 0 -01}
    {-815004000 0 1 -01}
    {-795045600 -3600 0 -01}
    {-783554400 0 1 -01}
    {-762991200 -3600 0 -01}
    {-752104800 0 1 -01}
    {-731541600 -3600 0 -01}
    {-717631200 0 1 -01}
    {-700092000 -3600 0 -01}
    {-686181600 0 1 -01}
    {-668642400 -3600 0 -01}
    {-654732000 0 1 -01}
    {-636588000 -3600 0 -01}
    {-623282400 0 1 -01}
    {-605743200 -3600 0 -01}
    {-591832800 0 1 -01}
    {-573688800 -3600 0 -01}
    {-559778400 0 1 -01}
    {-542239200 -3600 0 -01}
    {-528328800 0 1 -01}
    {-510789600 -3600 0 -01}
    {-496879200 0 1 -01}
    {-479340000 -3600 0 -01}
    {-465429600 0 1 -01}
    {-447890400 -3600 0 -01}
    {-433980000 0 1 -01}
    {-415836000 -3600 0 -01}
    {-401925600 0 1 -01}
    {-384386400 -3600 0 -01}
    {-370476000 0 1 -01}
    {-352936800 -3600 0 -01}
    {-339026400 0 1 -01}
    {-321487200 -3600 0 -01}
    {-307576800 0 1 -01}
    {-290037600 -3600 0 -01}
    {-276127200 0 1 -01}
    {-258588000 -3600 0 -01}
    {-244677600 0 1 -01}
    {-226533600 -3600 0 -01}
    {-212623200 0 1 -01}
    {-195084000 -3600 0 -01}
    {-181173600 0 1 -01}
    {-163634400 -3600 0 -01}
    {-149724000 0 1 -01}
    {-132184800 -3600 0 -01}
    {-118274400 0 1 -01}
    {-100735200 -3600 0 -01}
    {-86824800 0 1 -01}
    {-68680800 -3600 0 -01}
    {-54770400 0 0 GMT}
}

Changes to library/tzdata/Australia/Adelaide.

1
2
3
4
5
6
7
8


9
10

11
12

13
14

15
16
17
18
19
20
21
1
2
3
4
5
6


7
8
9

10
11

12
13

14
15
16
17
18
19
20
21






-
-
+
+

-
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Adelaide) {
    {-9223372036854775808 33260 0 LMT}
    {-2364110060 32400 0 ACST}
    {-2230189200 34200 0 ACST}
    {-1672565340 37800 1 ACDT}
    {-1665390600 34200 0 ACST}
    {-1672558200 37800 1 ACDT}
    {-1665387000 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-876123000 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-844673400 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 34200 0 ACST}
    {-813223800 34200 0 ACST}
    {31501800 34200 0 ACST}
    {57688200 37800 1 ACDT}
    {67969800 34200 0 ACST}
    {89137800 37800 1 ACDT}
    {100024200 34200 0 ACST}
    {120587400 37800 1 ACDT}
    {131473800 34200 0 ACST}

Changes to library/tzdata/Australia/Brisbane.

1
2
3
4
5
6
7


8
9

10
11

12
13

14
15
16
17
18
19
20
1
2
3
4
5


6
7
8

9
10

11
12

13
14
15
16
17
18
19
20





-
-
+
+

-
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Brisbane) {
    {-9223372036854775808 36728 0 LMT}
    {-2366791928 36000 0 AEST}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-813225600 36000 0 AEST}
    {31500000 36000 0 AEST}
    {57686400 39600 1 AEDT}
    {67968000 36000 0 AEST}
    {625593600 39600 1 AEDT}
    {636480000 36000 0 AEST}
    {657043200 39600 1 AEDT}
    {667929600 36000 0 AEST}

Changes to library/tzdata/Australia/Broken_Hill.

1
2
3
4
5
6
7
8
9


10
11

12
13

14
15

16
17
18
19
20
21
22
1
2
3
4
5
6
7


8
9
10

11
12

13
14

15
16
17
18
19
20
21
22







-
-
+
+

-
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Broken_Hill) {
    {-9223372036854775808 33948 0 LMT}
    {-2364110748 36000 0 AEST}
    {-2314951200 32400 0 ACST}
    {-2230189200 34200 0 ACST}
    {-1672565340 37800 1 ACDT}
    {-1665390600 34200 0 ACST}
    {-1672558200 37800 1 ACDT}
    {-1665387000 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-876123000 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-844673400 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 34200 0 ACST}
    {-813223800 34200 0 ACST}
    {31501800 34200 0 ACST}
    {57688200 37800 1 ACDT}
    {67969800 34200 0 ACST}
    {89137800 37800 1 ACDT}
    {100024200 34200 0 ACST}
    {120587400 37800 1 ACDT}
    {131473800 34200 0 ACST}

Changes to library/tzdata/Australia/Currie.

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
1
2
3


4
5















































































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Australia/Hobart)]} {
    LoadTimeZoneFile Australia/Hobart

set TZData(:Australia/Currie) {
}
set TZData(:Australia/Currie) $TZData(:Australia/Hobart)
    {-9223372036854775808 34528 0 LMT}
    {-2345794528 36000 0 AEST}
    {-1680508800 39600 1 AEDT}
    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {47138400 36000 0 AEST}
    {57686400 39600 1 AEDT}
    {67968000 36000 0 AEST}
    {89136000 39600 1 AEDT}
    {100022400 36000 0 AEST}
    {120585600 39600 1 AEDT}
    {131472000 36000 0 AEST}
    {152035200 39600 1 AEDT}
    {162921600 36000 0 AEST}
    {183484800 39600 1 AEDT}
    {194976000 36000 0 AEST}
    {215539200 39600 1 AEDT}
    {226425600 36000 0 AEST}
    {246988800 39600 1 AEDT}
    {257875200 36000 0 AEST}
    {278438400 39600 1 AEDT}
    {289324800 36000 0 AEST}
    {309888000 39600 1 AEDT}
    {320774400 36000 0 AEST}
    {341337600 39600 1 AEDT}
    {352224000 36000 0 AEST}
    {372787200 39600 1 AEDT}
    {386092800 36000 0 AEST}
    {404841600 39600 1 AEDT}
    {417542400 36000 0 AEST}
    {436291200 39600 1 AEDT}
    {447177600 36000 0 AEST}
    {467740800 39600 1 AEDT}
    {478627200 36000 0 AEST}
    {499190400 39600 1 AEDT}
    {510076800 36000 0 AEST}
    {530035200 39600 1 AEDT}
    {542736000 36000 0 AEST}
    {562089600 39600 1 AEDT}
    {574790400 36000 0 AEST}
    {594144000 39600 1 AEDT}
    {606240000 36000 0 AEST}
    {625593600 39600 1 AEDT}
    {637689600 36000 0 AEST}
    {657043200 39600 1 AEDT}
    {670348800 36000 0 AEST}
    {686678400 39600 1 AEDT}
    {701798400 36000 0 AEST}
    {718128000 39600 1 AEDT}
    {733248000 36000 0 AEST}
    {749577600 39600 1 AEDT}
    {764697600 36000 0 AEST}
    {781027200 39600 1 AEDT}
    {796147200 36000 0 AEST}
    {812476800 39600 1 AEDT}
    {828201600 36000 0 AEST}
    {844531200 39600 1 AEDT}
    {859651200 36000 0 AEST}
    {875980800 39600 1 AEDT}
    {891100800 36000 0 AEST}
    {907430400 39600 1 AEDT}
    {922550400 36000 0 AEST}
    {938880000 39600 1 AEDT}
    {954000000 36000 0 AEST}
    {967305600 39600 1 AEDT}
    {985449600 36000 0 AEST}
    {1002384000 39600 1 AEDT}
    {1017504000 36000 0 AEST}
    {1033833600 39600 1 AEDT}
    {1048953600 36000 0 AEST}
    {1065283200 39600 1 AEDT}
    {1080403200 36000 0 AEST}
    {1096732800 39600 1 AEDT}
    {1111852800 36000 0 AEST}
    {1128182400 39600 1 AEDT}
    {1143907200 36000 0 AEST}
    {1159632000 39600 1 AEDT}
    {1174752000 36000 0 AEST}
    {1191686400 39600 1 AEDT}
    {1207411200 36000 0 AEST}
    {1223136000 39600 1 AEDT}
    {1238860800 36000 0 AEST}
    {1254585600 39600 1 AEDT}
    {1270310400 36000 0 AEST}
    {1286035200 39600 1 AEDT}
    {1301760000 36000 0 AEST}
    {1317484800 39600 1 AEDT}
    {1333209600 36000 0 AEST}
    {1349539200 39600 1 AEDT}
    {1365264000 36000 0 AEST}
    {1380988800 39600 1 AEDT}
    {1396713600 36000 0 AEST}
    {1412438400 39600 1 AEDT}
    {1428163200 36000 0 AEST}
    {1443888000 39600 1 AEDT}
    {1459612800 36000 0 AEST}
    {1475337600 39600 1 AEDT}
    {1491062400 36000 0 AEST}
    {1506787200 39600 1 AEDT}
    {1522512000 36000 0 AEST}
    {1538841600 39600 1 AEDT}
    {1554566400 36000 0 AEST}
    {1570291200 39600 1 AEDT}
    {1586016000 36000 0 AEST}
    {1601740800 39600 1 AEDT}
    {1617465600 36000 0 AEST}
    {1633190400 39600 1 AEDT}
    {1648915200 36000 0 AEST}
    {1664640000 39600 1 AEDT}
    {1680364800 36000 0 AEST}
    {1696089600 39600 1 AEDT}
    {1712419200 36000 0 AEST}
    {1728144000 39600 1 AEDT}
    {1743868800 36000 0 AEST}
    {1759593600 39600 1 AEDT}
    {1775318400 36000 0 AEST}
    {1791043200 39600 1 AEDT}
    {1806768000 36000 0 AEST}
    {1822492800 39600 1 AEDT}
    {1838217600 36000 0 AEST}
    {1853942400 39600 1 AEDT}
    {1869667200 36000 0 AEST}
    {1885996800 39600 1 AEDT}
    {1901721600 36000 0 AEST}
    {1917446400 39600 1 AEDT}
    {1933171200 36000 0 AEST}
    {1948896000 39600 1 AEDT}
    {1964620800 36000 0 AEST}
    {1980345600 39600 1 AEDT}
    {1996070400 36000 0 AEST}
    {2011795200 39600 1 AEDT}
    {2027520000 36000 0 AEST}
    {2043244800 39600 1 AEDT}
    {2058969600 36000 0 AEST}
    {2075299200 39600 1 AEDT}
    {2091024000 36000 0 AEST}
    {2106748800 39600 1 AEDT}
    {2122473600 36000 0 AEST}
    {2138198400 39600 1 AEDT}
    {2153923200 36000 0 AEST}
    {2169648000 39600 1 AEDT}
    {2185372800 36000 0 AEST}
    {2201097600 39600 1 AEDT}
    {2216822400 36000 0 AEST}
    {2233152000 39600 1 AEDT}
    {2248876800 36000 0 AEST}
    {2264601600 39600 1 AEDT}
    {2280326400 36000 0 AEST}
    {2296051200 39600 1 AEDT}
    {2311776000 36000 0 AEST}
    {2327500800 39600 1 AEDT}
    {2343225600 36000 0 AEST}
    {2358950400 39600 1 AEDT}
    {2374675200 36000 0 AEST}
    {2390400000 39600 1 AEDT}
    {2406124800 36000 0 AEST}
    {2422454400 39600 1 AEDT}
    {2438179200 36000 0 AEST}
    {2453904000 39600 1 AEDT}
    {2469628800 36000 0 AEST}
    {2485353600 39600 1 AEDT}
    {2501078400 36000 0 AEST}
    {2516803200 39600 1 AEDT}
    {2532528000 36000 0 AEST}
    {2548252800 39600 1 AEDT}
    {2563977600 36000 0 AEST}
    {2579702400 39600 1 AEDT}
    {2596032000 36000 0 AEST}
    {2611756800 39600 1 AEDT}
    {2627481600 36000 0 AEST}
    {2643206400 39600 1 AEDT}
    {2658931200 36000 0 AEST}
    {2674656000 39600 1 AEDT}
    {2690380800 36000 0 AEST}
    {2706105600 39600 1 AEDT}
    {2721830400 36000 0 AEST}
    {2737555200 39600 1 AEDT}
    {2753280000 36000 0 AEST}
    {2769609600 39600 1 AEDT}
    {2785334400 36000 0 AEST}
    {2801059200 39600 1 AEDT}
    {2816784000 36000 0 AEST}
    {2832508800 39600 1 AEDT}
    {2848233600 36000 0 AEST}
    {2863958400 39600 1 AEDT}
    {2879683200 36000 0 AEST}
    {2895408000 39600 1 AEDT}
    {2911132800 36000 0 AEST}
    {2926857600 39600 1 AEDT}
    {2942582400 36000 0 AEST}
    {2958912000 39600 1 AEDT}
    {2974636800 36000 0 AEST}
    {2990361600 39600 1 AEDT}
    {3006086400 36000 0 AEST}
    {3021811200 39600 1 AEDT}
    {3037536000 36000 0 AEST}
    {3053260800 39600 1 AEDT}
    {3068985600 36000 0 AEST}
    {3084710400 39600 1 AEDT}
    {3100435200 36000 0 AEST}
    {3116764800 39600 1 AEDT}
    {3132489600 36000 0 AEST}
    {3148214400 39600 1 AEDT}
    {3163939200 36000 0 AEST}
    {3179664000 39600 1 AEDT}
    {3195388800 36000 0 AEST}
    {3211113600 39600 1 AEDT}
    {3226838400 36000 0 AEST}
    {3242563200 39600 1 AEDT}
    {3258288000 36000 0 AEST}
    {3274012800 39600 1 AEDT}
    {3289737600 36000 0 AEST}
    {3306067200 39600 1 AEDT}
    {3321792000 36000 0 AEST}
    {3337516800 39600 1 AEDT}
    {3353241600 36000 0 AEST}
    {3368966400 39600 1 AEDT}
    {3384691200 36000 0 AEST}
    {3400416000 39600 1 AEDT}
    {3416140800 36000 0 AEST}
    {3431865600 39600 1 AEDT}
    {3447590400 36000 0 AEST}
    {3463315200 39600 1 AEDT}
    {3479644800 36000 0 AEST}
    {3495369600 39600 1 AEDT}
    {3511094400 36000 0 AEST}
    {3526819200 39600 1 AEDT}
    {3542544000 36000 0 AEST}
    {3558268800 39600 1 AEDT}
    {3573993600 36000 0 AEST}
    {3589718400 39600 1 AEDT}
    {3605443200 36000 0 AEST}
    {3621168000 39600 1 AEDT}
    {3636892800 36000 0 AEST}
    {3653222400 39600 1 AEDT}
    {3668947200 36000 0 AEST}
    {3684672000 39600 1 AEDT}
    {3700396800 36000 0 AEST}
    {3716121600 39600 1 AEDT}
    {3731846400 36000 0 AEST}
    {3747571200 39600 1 AEDT}
    {3763296000 36000 0 AEST}
    {3779020800 39600 1 AEDT}
    {3794745600 36000 0 AEST}
    {3810470400 39600 1 AEDT}
    {3826195200 36000 0 AEST}
    {3842524800 39600 1 AEDT}
    {3858249600 36000 0 AEST}
    {3873974400 39600 1 AEDT}
    {3889699200 36000 0 AEST}
    {3905424000 39600 1 AEDT}
    {3921148800 36000 0 AEST}
    {3936873600 39600 1 AEDT}
    {3952598400 36000 0 AEST}
    {3968323200 39600 1 AEDT}
    {3984048000 36000 0 AEST}
    {4000377600 39600 1 AEDT}
    {4016102400 36000 0 AEST}
    {4031827200 39600 1 AEDT}
    {4047552000 36000 0 AEST}
    {4063276800 39600 1 AEDT}
    {4079001600 36000 0 AEST}
    {4094726400 39600 1 AEDT}
}

Changes to library/tzdata/Australia/Darwin.

1
2
3
4
5
6
7
8


9
10

11
12

13
14

15
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(:Australia/Darwin) {
    {-9223372036854775808 31400 0 LMT}
    {-2364108200 32400 0 ACST}
    {-2230189200 34200 0 ACST}
    {-1672565340 37800 1 ACDT}
    {-1665390600 34200 0 ACST}
    {-1672558200 37800 1 ACDT}
    {-1665387000 34200 0 ACST}
    {-883639800 37800 1 ACDT}
    {-876126600 34200 0 ACST}
    {-876123000 34200 0 ACST}
    {-860398200 37800 1 ACDT}
    {-844677000 34200 0 ACST}
    {-844673400 34200 0 ACST}
    {-828343800 37800 1 ACDT}
    {-813227400 34200 0 ACST}
    {-813223800 34200 0 ACST}
}

Changes to library/tzdata/Australia/Eucla.

1
2
3
4
5
6
7


8
9

10
11

12
13
14
15
16
17
18
1
2
3
4
5


6
7
8

9
10

11
12
13
14
15
16
17
18





-
-
+
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Eucla) {
    {-9223372036854775808 30928 0 LMT}
    {-2337928528 31500 0 +0945}
    {-1672562640 35100 1 +0945}
    {-1665387900 31500 0 +0945}
    {-1672555500 35100 1 +0945}
    {-1665384300 31500 0 +0945}
    {-883637100 35100 1 +0945}
    {-876123900 31500 0 +0945}
    {-876120300 31500 0 +0945}
    {-860395500 35100 1 +0945}
    {-844674300 31500 0 +0945}
    {-844670700 31500 0 +0945}
    {-836473500 35100 0 +0945}
    {152039700 35100 1 +0945}
    {162926100 31500 0 +0945}
    {436295700 35100 1 +0945}
    {447182100 31500 0 +0945}
    {690311700 35100 1 +0945}
    {699383700 31500 0 +0945}

Changes to library/tzdata/Australia/Hobart.

1
2
3
4
5
6



7
8



9
10

11
12

13
14

15
16
17
18
19
20
21
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






+
+
+
-
-
+
+
+

-
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Hobart) {
    {-9223372036854775808 35356 0 LMT}
    {-2345795356 36000 0 AEST}
    {-1680508800 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-1646640000 39600 1 AEDT}
    {-1635753600 36000 0 AEST}
    {-1669892400 39600 0 AEDT}
    {-1665392400 36000 0 AEST}
    {-1615190400 39600 1 AEDT}
    {-1604304000 36000 0 AEST}
    {-1583920800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-813225600 36000 0 AEST}
    {-94730400 36000 0 AEST}
    {-71136000 39600 1 AEDT}
    {-55411200 36000 0 AEST}
    {-37267200 39600 1 AEDT}
    {-25776000 36000 0 AEST}
    {-5817600 39600 1 AEDT}
    {5673600 36000 0 AEST}

Changes to library/tzdata/Australia/Lindeman.

1
2
3
4
5
6
7


8
9

10
11

12
13

14
15
16
17
18
19
20
1
2
3
4
5


6
7
8

9
10

11
12

13
14
15
16
17
18
19
20





-
-
+
+

-
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Lindeman) {
    {-9223372036854775808 35756 0 LMT}
    {-2366790956 36000 0 AEST}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-813225600 36000 0 AEST}
    {31500000 36000 0 AEST}
    {57686400 39600 1 AEDT}
    {67968000 36000 0 AEST}
    {625593600 39600 1 AEDT}
    {636480000 36000 0 AEST}
    {657043200 39600 1 AEDT}
    {667929600 36000 0 AEST}

Changes to library/tzdata/Australia/Melbourne.

1
2
3
4
5
6
7


8
9

10
11

12
13

14
15
16
17
18
19
20
1
2
3
4
5


6
7
8

9
10

11
12

13
14
15
16
17
18
19
20





-
-
+
+

-
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Melbourne) {
    {-9223372036854775808 34792 0 LMT}
    {-2364111592 36000 0 AEST}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-813225600 36000 0 AEST}
    {31500000 36000 0 AEST}
    {57686400 39600 1 AEDT}
    {67968000 36000 0 AEST}
    {89136000 39600 1 AEDT}
    {100022400 36000 0 AEST}
    {120585600 39600 1 AEDT}
    {131472000 36000 0 AEST}

Changes to library/tzdata/Australia/Perth.

1
2
3
4
5
6
7


8
9

10
11

12
13
14
15
16
17
18
1
2
3
4
5


6
7
8

9
10

11
12
13
14
15
16
17
18





-
-
+
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Perth) {
    {-9223372036854775808 27804 0 LMT}
    {-2337925404 28800 0 AWST}
    {-1672559940 32400 1 AWDT}
    {-1665385200 28800 0 AWST}
    {-1672552800 32400 1 AWDT}
    {-1665381600 28800 0 AWST}
    {-883634400 32400 1 AWDT}
    {-876121200 28800 0 AWST}
    {-876117600 28800 0 AWST}
    {-860392800 32400 1 AWDT}
    {-844671600 28800 0 AWST}
    {-844668000 28800 0 AWST}
    {-836470800 32400 0 AWST}
    {152042400 32400 1 AWDT}
    {162928800 28800 0 AWST}
    {436298400 32400 1 AWDT}
    {447184800 28800 0 AWST}
    {690314400 32400 1 AWDT}
    {699386400 28800 0 AWST}

Changes to library/tzdata/Australia/Sydney.

1
2
3
4
5
6
7


8
9

10
11

12
13

14
15
16
17
18
19
20
1
2
3
4
5


6
7
8

9
10

11
12

13
14
15
16
17
18
19
20





-
-
+
+

-
+

-
+

-
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Australia/Sydney) {
    {-9223372036854775808 36292 0 LMT}
    {-2364113092 36000 0 AEST}
    {-1672567140 39600 1 AEDT}
    {-1665392400 36000 0 AEST}
    {-1672560000 39600 1 AEDT}
    {-1665388800 36000 0 AEST}
    {-883641600 39600 1 AEDT}
    {-876128400 36000 0 AEST}
    {-876124800 36000 0 AEST}
    {-860400000 39600 1 AEDT}
    {-844678800 36000 0 AEST}
    {-844675200 36000 0 AEST}
    {-828345600 39600 1 AEDT}
    {-813229200 36000 0 AEST}
    {-813225600 36000 0 AEST}
    {31500000 36000 0 AEST}
    {57686400 39600 1 AEDT}
    {67968000 36000 0 AEST}
    {89136000 39600 1 AEDT}
    {100022400 36000 0 AEST}
    {120585600 39600 1 AEDT}
    {131472000 36000 0 AEST}

Deleted library/tzdata/Canada/East-Saskatchewan.

1
2
3
4
5





-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Regina)]} {
    LoadTimeZoneFile America/Regina
}
set TZData(:Canada/East-Saskatchewan) $TZData(:America/Regina)

Changes to library/tzdata/Europe/Amsterdam.

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

1

2


























































































































































3

























































































































































4
5

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

+
# created by tools/tclZIC.tcl - do not edit

if {![info exists TZData(Europe/Brussels)]} {
set TZData(:Europe/Amsterdam) {
    {-9223372036854775808 1172 0 LMT}
    {-4260212372 1172 0 AMT}
    {-1693700372 4772 1 NST}
    {-1680484772 1172 0 AMT}
    {-1663453172 4772 1 NST}
    {-1650147572 1172 0 AMT}
    {-1633213172 4772 1 NST}
    {-1617488372 1172 0 AMT}
    {-1601158772 4772 1 NST}
    {-1586038772 1172 0 AMT}
    {-1569709172 4772 1 NST}
    {-1554589172 1172 0 AMT}
    {-1538259572 4772 1 NST}
    {-1523139572 1172 0 AMT}
    {-1507501172 4772 1 NST}
    {-1490566772 1172 0 AMT}
    {-1470176372 4772 1 NST}
    {-1459117172 1172 0 AMT}
    {-1443997172 4772 1 NST}
    {-1427667572 1172 0 AMT}
    {-1406672372 4772 1 NST}
    {-1396217972 1172 0 AMT}
    {-1376950772 4772 1 NST}
    {-1364768372 1172 0 AMT}
    {-1345414772 4772 1 NST}
    {-1333318772 1172 0 AMT}
    {-1313792372 4772 1 NST}
    {-1301264372 1172 0 AMT}
    {-1282256372 4772 1 NST}
    {-1269814772 1172 0 AMT}
    {-1250720372 4772 1 NST}
    {-1238365172 1172 0 AMT}
    {-1219184372 4772 1 NST}
    {-1206915572 1172 0 AMT}
    {-1186957172 4772 1 NST}
    {-1175465972 1172 0 AMT}
    {-1156025972 4772 1 NST}
    {-1143411572 1172 0 AMT}
    {-1124489972 4772 1 NST}
    {-1111961972 1172 0 AMT}
    {-1092953972 4772 1 NST}
    {-1080512372 1172 0 AMT}
    {-1061331572 4772 1 NST}
    {-1049062772 1172 0 AMT}
    {-1029190772 4772 1 NST}
    {-1025741972 4800 0 +0120}
    {-1017613200 1200 0 +0020}
    {-998259600 4800 1 +0120}
    {-986163600 1200 0 +0020}
    {-966723600 4800 1 +0120}
    {-954109200 1200 0 +0020}
    {-935022000 7200 0 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-781052400 7200 0 CEST}
    {-766623600 3600 0 CET}
    {220921200 3600 0 CET}
    {228877200 7200 1 CEST}
    {243997200 3600 0 CET}
    {260326800 7200 1 CEST}
    {276051600 3600 0 CET}
    {291776400 7200 1 CEST}
    {307501200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    LoadTimeZoneFile Europe/Brussels
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}
set TZData(:Europe/Amsterdam) $TZData(:Europe/Brussels)

Changes to library/tzdata/Europe/Copenhagen.

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
1
2
3


4
5






































































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin

set TZData(:Europe/Copenhagen) {
}
set TZData(:Europe/Copenhagen) $TZData(:Europe/Berlin)
    {-9223372036854775808 3020 0 LMT}
    {-2524524620 3020 0 CMT}
    {-2398294220 3600 0 CET}
    {-1692496800 7200 1 CEST}
    {-1680490800 3600 0 CET}
    {-935110800 7200 1 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-781052400 7200 0 CEST}
    {-769388400 3600 0 CET}
    {-747010800 7200 1 CEST}
    {-736383600 3600 0 CET}
    {-715215600 7200 1 CEST}
    {-706748400 3600 0 CET}
    {-683161200 7200 1 CEST}
    {-675298800 3600 0 CET}
    {315529200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}

Changes to library/tzdata/Europe/Dublin.

1
2
3
4
5


6
7
8
9
10
11
12
1
2
3


4
5
6
7
8
9
10
11
12



-
-
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Dublin) {
    {-9223372036854775808 -1500 0 LMT}
    {-2821649700 -1521 0 DMT}
    {-9223372036854775808 -1521 0 LMT}
    {-2821649679 -1521 0 DMT}
    {-1691962479 2079 1 IST}
    {-1680471279 0 0 GMT}
    {-1664143200 3600 1 BST}
    {-1650146400 0 0 GMT}
    {-1633903200 3600 1 BST}
    {-1617487200 0 0 GMT}
    {-1601848800 3600 1 BST}

Changes to library/tzdata/Europe/Kiev.

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
1
2
3


4
5

























































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Kyiv)]} {
    LoadTimeZoneFile Europe/Kyiv

set TZData(:Europe/Kiev) {
}
set TZData(:Europe/Kiev) $TZData(:Europe/Kyiv)
    {-9223372036854775808 7324 0 LMT}
    {-2840148124 7324 0 KMT}
    {-1441159324 7200 0 EET}
    {-1247536800 10800 0 MSK}
    {-892522800 3600 0 CET}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-825382800 10800 0 MSD}
    {354920400 14400 1 MSD}
    {370728000 10800 0 MSK}
    {386456400 14400 1 MSD}
    {402264000 10800 0 MSK}
    {417992400 14400 1 MSD}
    {433800000 10800 0 MSK}
    {449614800 14400 1 MSD}
    {465346800 10800 0 MSK}
    {481071600 14400 1 MSD}
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {646786800 10800 1 EEST}
    {686102400 7200 0 EET}
    {701820000 10800 1 EEST}
    {717541200 7200 0 EET}
    {733269600 10800 1 EEST}
    {748990800 7200 0 EET}
    {764719200 10800 1 EEST}
    {780440400 7200 0 EET}
    {788911200 7200 0 EET}
    {796179600 10800 1 EEST}
    {811904400 7200 0 EET}
    {828234000 10800 1 EEST}
    {846378000 7200 0 EET}
    {859683600 10800 1 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}
    {972781200 7200 0 EET}
    {985482000 10800 1 EEST}
    {1004230800 7200 0 EET}
    {1017536400 10800 1 EEST}
    {1035680400 7200 0 EET}
    {1048986000 10800 1 EEST}
    {1067130000 7200 0 EET}
    {1080435600 10800 1 EEST}
    {1099184400 7200 0 EET}
    {1111885200 10800 1 EEST}
    {1130634000 7200 0 EET}
    {1143334800 10800 1 EEST}
    {1162083600 7200 0 EET}
    {1174784400 10800 1 EEST}
    {1193533200 7200 0 EET}
    {1206838800 10800 1 EEST}
    {1224982800 7200 0 EET}
    {1238288400 10800 1 EEST}
    {1256432400 7200 0 EET}
    {1269738000 10800 1 EEST}
    {1288486800 7200 0 EET}
    {1301187600 10800 1 EEST}
    {1319936400 7200 0 EET}
    {1332637200 10800 1 EEST}
    {1351386000 7200 0 EET}
    {1364691600 10800 1 EEST}
    {1382835600 7200 0 EET}
    {1396141200 10800 1 EEST}
    {1414285200 7200 0 EET}
    {1427590800 10800 1 EEST}
    {1445734800 7200 0 EET}
    {1459040400 10800 1 EEST}
    {1477789200 7200 0 EET}
    {1490490000 10800 1 EEST}
    {1509238800 7200 0 EET}
    {1521939600 10800 1 EEST}
    {1540688400 7200 0 EET}
    {1553994000 10800 1 EEST}
    {1572138000 7200 0 EET}
    {1585443600 10800 1 EEST}
    {1603587600 7200 0 EET}
    {1616893200 10800 1 EEST}
    {1635642000 7200 0 EET}
    {1648342800 10800 1 EEST}
    {1667091600 7200 0 EET}
    {1679792400 10800 1 EEST}
    {1698541200 7200 0 EET}
    {1711846800 10800 1 EEST}
    {1729990800 7200 0 EET}
    {1743296400 10800 1 EEST}
    {1761440400 7200 0 EET}
    {1774746000 10800 1 EEST}
    {1792890000 7200 0 EET}
    {1806195600 10800 1 EEST}
    {1824944400 7200 0 EET}
    {1837645200 10800 1 EEST}
    {1856394000 7200 0 EET}
    {1869094800 10800 1 EEST}
    {1887843600 7200 0 EET}
    {1901149200 10800 1 EEST}
    {1919293200 7200 0 EET}
    {1932598800 10800 1 EEST}
    {1950742800 7200 0 EET}
    {1964048400 10800 1 EEST}
    {1982797200 7200 0 EET}
    {1995498000 10800 1 EEST}
    {2014246800 7200 0 EET}
    {2026947600 10800 1 EEST}
    {2045696400 7200 0 EET}
    {2058397200 10800 1 EEST}
    {2077146000 7200 0 EET}
    {2090451600 10800 1 EEST}
    {2108595600 7200 0 EET}
    {2121901200 10800 1 EEST}
    {2140045200 7200 0 EET}
    {2153350800 10800 1 EEST}
    {2172099600 7200 0 EET}
    {2184800400 10800 1 EEST}
    {2203549200 7200 0 EET}
    {2216250000 10800 1 EEST}
    {2234998800 7200 0 EET}
    {2248304400 10800 1 EEST}
    {2266448400 7200 0 EET}
    {2279754000 10800 1 EEST}
    {2297898000 7200 0 EET}
    {2311203600 10800 1 EEST}
    {2329347600 7200 0 EET}
    {2342653200 10800 1 EEST}
    {2361402000 7200 0 EET}
    {2374102800 10800 1 EEST}
    {2392851600 7200 0 EET}
    {2405552400 10800 1 EEST}
    {2424301200 7200 0 EET}
    {2437606800 10800 1 EEST}
    {2455750800 7200 0 EET}
    {2469056400 10800 1 EEST}
    {2487200400 7200 0 EET}
    {2500506000 10800 1 EEST}
    {2519254800 7200 0 EET}
    {2531955600 10800 1 EEST}
    {2550704400 7200 0 EET}
    {2563405200 10800 1 EEST}
    {2582154000 7200 0 EET}
    {2595459600 10800 1 EEST}
    {2613603600 7200 0 EET}
    {2626909200 10800 1 EEST}
    {2645053200 7200 0 EET}
    {2658358800 10800 1 EEST}
    {2676502800 7200 0 EET}
    {2689808400 10800 1 EEST}
    {2708557200 7200 0 EET}
    {2721258000 10800 1 EEST}
    {2740006800 7200 0 EET}
    {2752707600 10800 1 EEST}
    {2771456400 7200 0 EET}
    {2784762000 10800 1 EEST}
    {2802906000 7200 0 EET}
    {2816211600 10800 1 EEST}
    {2834355600 7200 0 EET}
    {2847661200 10800 1 EEST}
    {2866410000 7200 0 EET}
    {2879110800 10800 1 EEST}
    {2897859600 7200 0 EET}
    {2910560400 10800 1 EEST}
    {2929309200 7200 0 EET}
    {2942010000 10800 1 EEST}
    {2960758800 7200 0 EET}
    {2974064400 10800 1 EEST}
    {2992208400 7200 0 EET}
    {3005514000 10800 1 EEST}
    {3023658000 7200 0 EET}
    {3036963600 10800 1 EEST}
    {3055712400 7200 0 EET}
    {3068413200 10800 1 EEST}
    {3087162000 7200 0 EET}
    {3099862800 10800 1 EEST}
    {3118611600 7200 0 EET}
    {3131917200 10800 1 EEST}
    {3150061200 7200 0 EET}
    {3163366800 10800 1 EEST}
    {3181510800 7200 0 EET}
    {3194816400 10800 1 EEST}
    {3212960400 7200 0 EET}
    {3226266000 10800 1 EEST}
    {3245014800 7200 0 EET}
    {3257715600 10800 1 EEST}
    {3276464400 7200 0 EET}
    {3289165200 10800 1 EEST}
    {3307914000 7200 0 EET}
    {3321219600 10800 1 EEST}
    {3339363600 7200 0 EET}
    {3352669200 10800 1 EEST}
    {3370813200 7200 0 EET}
    {3384118800 10800 1 EEST}
    {3402867600 7200 0 EET}
    {3415568400 10800 1 EEST}
    {3434317200 7200 0 EET}
    {3447018000 10800 1 EEST}
    {3465766800 7200 0 EET}
    {3479072400 10800 1 EEST}
    {3497216400 7200 0 EET}
    {3510522000 10800 1 EEST}
    {3528666000 7200 0 EET}
    {3541971600 10800 1 EEST}
    {3560115600 7200 0 EET}
    {3573421200 10800 1 EEST}
    {3592170000 7200 0 EET}
    {3604870800 10800 1 EEST}
    {3623619600 7200 0 EET}
    {3636320400 10800 1 EEST}
    {3655069200 7200 0 EET}
    {3668374800 10800 1 EEST}
    {3686518800 7200 0 EET}
    {3699824400 10800 1 EEST}
    {3717968400 7200 0 EET}
    {3731274000 10800 1 EEST}
    {3750022800 7200 0 EET}
    {3762723600 10800 1 EEST}
    {3781472400 7200 0 EET}
    {3794173200 10800 1 EEST}
    {3812922000 7200 0 EET}
    {3825622800 10800 1 EEST}
    {3844371600 7200 0 EET}
    {3857677200 10800 1 EEST}
    {3875821200 7200 0 EET}
    {3889126800 10800 1 EEST}
    {3907270800 7200 0 EET}
    {3920576400 10800 1 EEST}
    {3939325200 7200 0 EET}
    {3952026000 10800 1 EEST}
    {3970774800 7200 0 EET}
    {3983475600 10800 1 EEST}
    {4002224400 7200 0 EET}
    {4015530000 10800 1 EEST}
    {4033674000 7200 0 EET}
    {4046979600 10800 1 EEST}
    {4065123600 7200 0 EET}
    {4078429200 10800 1 EEST}
    {4096573200 7200 0 EET}
}

Added library/tzdata/Europe/Kyiv.




























































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# created by tools/tclZIC.tcl - do not edit

set TZData(:Europe/Kyiv) {
    {-9223372036854775808 7324 0 LMT}
    {-2840148124 7324 0 KMT}
    {-1441159324 7200 0 EET}
    {-1247536800 10800 0 MSK}
    {-892522800 3600 0 CET}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-825382800 10800 0 MSD}
    {354920400 14400 1 MSD}
    {370728000 10800 0 MSK}
    {386456400 14400 1 MSD}
    {402264000 10800 0 MSK}
    {417992400 14400 1 MSD}
    {433800000 10800 0 MSK}
    {449614800 14400 1 MSD}
    {465346800 10800 0 MSK}
    {481071600 14400 1 MSD}
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {646786800 10800 1 EEST}
    {686102400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {780451200 7200 0 EET}
    {796176000 10800 1 EEST}
    {811900800 7200 0 EET}
    {828230400 10800 1 EEST}
    {831938400 10800 0 EEST}
    {846378000 7200 0 EET}
    {859683600 10800 1 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}
    {972781200 7200 0 EET}
    {985482000 10800 1 EEST}
    {1004230800 7200 0 EET}
    {1017536400 10800 1 EEST}
    {1035680400 7200 0 EET}
    {1048986000 10800 1 EEST}
    {1067130000 7200 0 EET}
    {1080435600 10800 1 EEST}
    {1099184400 7200 0 EET}
    {1111885200 10800 1 EEST}
    {1130634000 7200 0 EET}
    {1143334800 10800 1 EEST}
    {1162083600 7200 0 EET}
    {1174784400 10800 1 EEST}
    {1193533200 7200 0 EET}
    {1206838800 10800 1 EEST}
    {1224982800 7200 0 EET}
    {1238288400 10800 1 EEST}
    {1256432400 7200 0 EET}
    {1269738000 10800 1 EEST}
    {1288486800 7200 0 EET}
    {1301187600 10800 1 EEST}
    {1319936400 7200 0 EET}
    {1332637200 10800 1 EEST}
    {1351386000 7200 0 EET}
    {1364691600 10800 1 EEST}
    {1382835600 7200 0 EET}
    {1396141200 10800 1 EEST}
    {1414285200 7200 0 EET}
    {1427590800 10800 1 EEST}
    {1445734800 7200 0 EET}
    {1459040400 10800 1 EEST}
    {1477789200 7200 0 EET}
    {1490490000 10800 1 EEST}
    {1509238800 7200 0 EET}
    {1521939600 10800 1 EEST}
    {1540688400 7200 0 EET}
    {1553994000 10800 1 EEST}
    {1572138000 7200 0 EET}
    {1585443600 10800 1 EEST}
    {1603587600 7200 0 EET}
    {1616893200 10800 1 EEST}
    {1635642000 7200 0 EET}
    {1648342800 10800 1 EEST}
    {1667091600 7200 0 EET}
    {1679792400 10800 1 EEST}
    {1698541200 7200 0 EET}
    {1711846800 10800 1 EEST}
    {1729990800 7200 0 EET}
    {1743296400 10800 1 EEST}
    {1761440400 7200 0 EET}
    {1774746000 10800 1 EEST}
    {1792890000 7200 0 EET}
    {1806195600 10800 1 EEST}
    {1824944400 7200 0 EET}
    {1837645200 10800 1 EEST}
    {1856394000 7200 0 EET}
    {1869094800 10800 1 EEST}
    {1887843600 7200 0 EET}
    {1901149200 10800 1 EEST}
    {1919293200 7200 0 EET}
    {1932598800 10800 1 EEST}
    {1950742800 7200 0 EET}
    {1964048400 10800 1 EEST}
    {1982797200 7200 0 EET}
    {1995498000 10800 1 EEST}
    {2014246800 7200 0 EET}
    {2026947600 10800 1 EEST}
    {2045696400 7200 0 EET}
    {2058397200 10800 1 EEST}
    {2077146000 7200 0 EET}
    {2090451600 10800 1 EEST}
    {2108595600 7200 0 EET}
    {2121901200 10800 1 EEST}
    {2140045200 7200 0 EET}
    {2153350800 10800 1 EEST}
    {2172099600 7200 0 EET}
    {2184800400 10800 1 EEST}
    {2203549200 7200 0 EET}
    {2216250000 10800 1 EEST}
    {2234998800 7200 0 EET}
    {2248304400 10800 1 EEST}
    {2266448400 7200 0 EET}
    {2279754000 10800 1 EEST}
    {2297898000 7200 0 EET}
    {2311203600 10800 1 EEST}
    {2329347600 7200 0 EET}
    {2342653200 10800 1 EEST}
    {2361402000 7200 0 EET}
    {2374102800 10800 1 EEST}
    {2392851600 7200 0 EET}
    {2405552400 10800 1 EEST}
    {2424301200 7200 0 EET}
    {2437606800 10800 1 EEST}
    {2455750800 7200 0 EET}
    {2469056400 10800 1 EEST}
    {2487200400 7200 0 EET}
    {2500506000 10800 1 EEST}
    {2519254800 7200 0 EET}
    {2531955600 10800 1 EEST}
    {2550704400 7200 0 EET}
    {2563405200 10800 1 EEST}
    {2582154000 7200 0 EET}
    {2595459600 10800 1 EEST}
    {2613603600 7200 0 EET}
    {2626909200 10800 1 EEST}
    {2645053200 7200 0 EET}
    {2658358800 10800 1 EEST}
    {2676502800 7200 0 EET}
    {2689808400 10800 1 EEST}
    {2708557200 7200 0 EET}
    {2721258000 10800 1 EEST}
    {2740006800 7200 0 EET}
    {2752707600 10800 1 EEST}
    {2771456400 7200 0 EET}
    {2784762000 10800 1 EEST}
    {2802906000 7200 0 EET}
    {2816211600 10800 1 EEST}
    {2834355600 7200 0 EET}
    {2847661200 10800 1 EEST}
    {2866410000 7200 0 EET}
    {2879110800 10800 1 EEST}
    {2897859600 7200 0 EET}
    {2910560400 10800 1 EEST}
    {2929309200 7200 0 EET}
    {2942010000 10800 1 EEST}
    {2960758800 7200 0 EET}
    {2974064400 10800 1 EEST}
    {2992208400 7200 0 EET}
    {3005514000 10800 1 EEST}
    {3023658000 7200 0 EET}
    {3036963600 10800 1 EEST}
    {3055712400 7200 0 EET}
    {3068413200 10800 1 EEST}
    {3087162000 7200 0 EET}
    {3099862800 10800 1 EEST}
    {3118611600 7200 0 EET}
    {3131917200 10800 1 EEST}
    {3150061200 7200 0 EET}
    {3163366800 10800 1 EEST}
    {3181510800 7200 0 EET}
    {3194816400 10800 1 EEST}
    {3212960400 7200 0 EET}
    {3226266000 10800 1 EEST}
    {3245014800 7200 0 EET}
    {3257715600 10800 1 EEST}
    {3276464400 7200 0 EET}
    {3289165200 10800 1 EEST}
    {3307914000 7200 0 EET}
    {3321219600 10800 1 EEST}
    {3339363600 7200 0 EET}
    {3352669200 10800 1 EEST}
    {3370813200 7200 0 EET}
    {3384118800 10800 1 EEST}
    {3402867600 7200 0 EET}
    {3415568400 10800 1 EEST}
    {3434317200 7200 0 EET}
    {3447018000 10800 1 EEST}
    {3465766800 7200 0 EET}
    {3479072400 10800 1 EEST}
    {3497216400 7200 0 EET}
    {3510522000 10800 1 EEST}
    {3528666000 7200 0 EET}
    {3541971600 10800 1 EEST}
    {3560115600 7200 0 EET}
    {3573421200 10800 1 EEST}
    {3592170000 7200 0 EET}
    {3604870800 10800 1 EEST}
    {3623619600 7200 0 EET}
    {3636320400 10800 1 EEST}
    {3655069200 7200 0 EET}
    {3668374800 10800 1 EEST}
    {3686518800 7200 0 EET}
    {3699824400 10800 1 EEST}
    {3717968400 7200 0 EET}
    {3731274000 10800 1 EEST}
    {3750022800 7200 0 EET}
    {3762723600 10800 1 EEST}
    {3781472400 7200 0 EET}
    {3794173200 10800 1 EEST}
    {3812922000 7200 0 EET}
    {3825622800 10800 1 EEST}
    {3844371600 7200 0 EET}
    {3857677200 10800 1 EEST}
    {3875821200 7200 0 EET}
    {3889126800 10800 1 EEST}
    {3907270800 7200 0 EET}
    {3920576400 10800 1 EEST}
    {3939325200 7200 0 EET}
    {3952026000 10800 1 EEST}
    {3970774800 7200 0 EET}
    {3983475600 10800 1 EEST}
    {4002224400 7200 0 EET}
    {4015530000 10800 1 EEST}
    {4033674000 7200 0 EET}
    {4046979600 10800 1 EEST}
    {4065123600 7200 0 EET}
    {4078429200 10800 1 EEST}
    {4096573200 7200 0 EET}
}

Changes to library/tzdata/Europe/Lisbon.

66
67
68
69
70
71
72


73
74
75
76
77
78
79
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81







+
+







    {-733366800 0 0 WET}
    {-717631200 3600 1 WEST}
    {-701906400 0 0 WET}
    {-686181600 3600 1 WEST}
    {-670456800 0 0 WET}
    {-654732000 3600 1 WEST}
    {-639007200 0 0 WET}
    {-623282400 3600 1 WEST}
    {-607557600 0 0 WET}
    {-591832800 3600 1 WEST}
    {-575503200 0 0 WET}
    {-559778400 3600 1 WEST}
    {-544053600 0 0 WET}
    {-528328800 3600 1 WEST}
    {-512604000 0 0 WET}
    {-496879200 3600 1 WEST}

Changes to library/tzdata/Europe/Luxembourg.

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

1

2




























































































































































3


























































































































































4
5

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

+
# created by tools/tclZIC.tcl - do not edit

if {![info exists TZData(Europe/Brussels)]} {
set TZData(:Europe/Luxembourg) {
    {-9223372036854775808 1476 0 LMT}
    {-2069713476 3600 0 CET}
    {-1692496800 7200 1 CEST}
    {-1680483600 3600 0 CET}
    {-1662343200 7200 1 CEST}
    {-1650157200 3600 0 CET}
    {-1632006000 7200 1 CEST}
    {-1618700400 3600 0 CET}
    {-1612659600 0 0 WET}
    {-1604278800 3600 1 WEST}
    {-1585519200 0 0 WET}
    {-1574038800 3600 1 WEST}
    {-1552258800 0 0 WET}
    {-1539997200 3600 1 WEST}
    {-1520550000 0 0 WET}
    {-1507510800 3600 1 WEST}
    {-1490572800 0 0 WET}
    {-1473642000 3600 1 WEST}
    {-1459119600 0 0 WET}
    {-1444006800 3600 1 WEST}
    {-1427673600 0 0 WET}
    {-1411866000 3600 1 WEST}
    {-1396224000 0 0 WET}
    {-1379293200 3600 1 WEST}
    {-1364774400 0 0 WET}
    {-1348448400 3600 1 WEST}
    {-1333324800 0 0 WET}
    {-1316394000 3600 1 WEST}
    {-1301270400 0 0 WET}
    {-1284339600 3600 1 WEST}
    {-1269813600 0 0 WET}
    {-1253484000 3600 1 WEST}
    {-1238364000 0 0 WET}
    {-1221429600 3600 1 WEST}
    {-1206914400 0 0 WET}
    {-1191189600 3600 1 WEST}
    {-1175464800 0 0 WET}
    {-1160344800 3600 1 WEST}
    {-1143410400 0 0 WET}
    {-1127685600 3600 1 WEST}
    {-1111960800 0 0 WET}
    {-1096840800 3600 1 WEST}
    {-1080511200 0 0 WET}
    {-1063576800 3600 1 WEST}
    {-1049061600 0 0 WET}
    {-1033336800 3600 1 WEST}
    {-1017612000 0 0 WET}
    {-1002492000 3600 1 WEST}
    {-986162400 0 0 WET}
    {-969228000 3600 1 WEST}
    {-950479200 0 0 WET}
    {-942012000 3600 1 WEST}
    {-935186400 7200 0 WEST}
    {-857257200 3600 0 WET}
    {-844556400 7200 1 WEST}
    {-828226800 3600 0 WET}
    {-812502000 7200 1 WEST}
    {-797983200 3600 0 CET}
    {-781052400 7200 1 CEST}
    {-766623600 3600 0 CET}
    {-745455600 7200 1 CEST}
    {-733273200 3600 0 CET}
    {220921200 3600 0 CET}
    {228877200 7200 1 CEST}
    {243997200 3600 0 CET}
    {260326800 7200 1 CEST}
    {276051600 3600 0 CET}
    {291776400 7200 1 CEST}
    {307501200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    LoadTimeZoneFile Europe/Brussels
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}
set TZData(:Europe/Luxembourg) $TZData(:Europe/Brussels)

Changes to library/tzdata/Europe/Monaco.

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

1

2





























































































































































3



























































































































































4
5

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

+
# created by tools/tclZIC.tcl - do not edit

if {![info exists TZData(Europe/Paris)]} {
set TZData(:Europe/Monaco) {
    {-9223372036854775808 1772 0 LMT}
    {-2448318572 561 0 PMT}
    {-1854403761 0 0 WET}
    {-1689814800 3600 1 WEST}
    {-1680397200 0 0 WET}
    {-1665363600 3600 1 WEST}
    {-1648342800 0 0 WET}
    {-1635123600 3600 1 WEST}
    {-1616893200 0 0 WET}
    {-1604278800 3600 1 WEST}
    {-1585443600 0 0 WET}
    {-1574038800 3600 1 WEST}
    {-1552266000 0 0 WET}
    {-1539997200 3600 1 WEST}
    {-1520557200 0 0 WET}
    {-1507510800 3600 1 WEST}
    {-1490576400 0 0 WET}
    {-1470618000 3600 1 WEST}
    {-1459126800 0 0 WET}
    {-1444006800 3600 1 WEST}
    {-1427677200 0 0 WET}
    {-1411952400 3600 1 WEST}
    {-1396227600 0 0 WET}
    {-1379293200 3600 1 WEST}
    {-1364778000 0 0 WET}
    {-1348448400 3600 1 WEST}
    {-1333328400 0 0 WET}
    {-1316394000 3600 1 WEST}
    {-1301274000 0 0 WET}
    {-1284339600 3600 1 WEST}
    {-1269824400 0 0 WET}
    {-1253494800 3600 1 WEST}
    {-1238374800 0 0 WET}
    {-1221440400 3600 1 WEST}
    {-1206925200 0 0 WET}
    {-1191200400 3600 1 WEST}
    {-1175475600 0 0 WET}
    {-1160355600 3600 1 WEST}
    {-1143421200 0 0 WET}
    {-1127696400 3600 1 WEST}
    {-1111971600 0 0 WET}
    {-1096851600 3600 1 WEST}
    {-1080522000 0 0 WET}
    {-1063587600 3600 1 WEST}
    {-1049072400 0 0 WET}
    {-1033347600 3600 1 WEST}
    {-1017622800 0 0 WET}
    {-1002502800 3600 1 WEST}
    {-986173200 0 0 WET}
    {-969238800 3600 1 WEST}
    {-950490000 0 0 WET}
    {-942012000 3600 1 WEST}
    {-904438800 7200 1 WEMT}
    {-891136800 3600 1 WEST}
    {-877827600 7200 1 WEMT}
    {-857257200 3600 1 WEST}
    {-844556400 7200 1 WEMT}
    {-828226800 3600 1 WEST}
    {-812502000 7200 1 WEMT}
    {-796266000 3600 1 WEST}
    {-781052400 7200 1 WEMT}
    {-766616400 3600 0 CET}
    {196819200 7200 1 CEST}
    {212540400 3600 0 CET}
    {220921200 3600 0 CET}
    {228877200 7200 1 CEST}
    {243997200 3600 0 CET}
    {260326800 7200 1 CEST}
    {276051600 3600 0 CET}
    {291776400 7200 1 CEST}
    {307501200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    LoadTimeZoneFile Europe/Paris
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}
set TZData(:Europe/Monaco) $TZData(:Europe/Paris)

Changes to library/tzdata/Europe/Oslo.

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
1
2
3


4
5













































































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin

set TZData(:Europe/Oslo) {
}
set TZData(:Europe/Oslo) $TZData(:Europe/Berlin)
    {-9223372036854775808 2580 0 LMT}
    {-2366757780 3600 0 CET}
    {-1691884800 7200 1 CEST}
    {-1680573600 3600 0 CET}
    {-927511200 7200 0 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796777200 3600 0 CET}
    {-781052400 7200 0 CEST}
    {-765327600 3600 0 CET}
    {-340844400 7200 1 CEST}
    {-324514800 3600 0 CET}
    {-308790000 7200 1 CEST}
    {-293065200 3600 0 CET}
    {-277340400 7200 1 CEST}
    {-261615600 3600 0 CET}
    {-245890800 7200 1 CEST}
    {-230166000 3600 0 CET}
    {-214441200 7200 1 CEST}
    {-198716400 3600 0 CET}
    {-182991600 7200 1 CEST}
    {-166662000 3600 0 CET}
    {-147913200 7200 1 CEST}
    {-135212400 3600 0 CET}
    {315529200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}

Changes to library/tzdata/Europe/Simferopol.

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
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







-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
+







    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {631141200 10800 0 MSK}
    {646786800 7200 0 EET}
    {694216800 7200 0 EET}
    {701820000 10800 1 EEST}
    {717541200 7200 0 EET}
    {733269600 10800 1 EEST}
    {748990800 7200 0 EET}
    {764719200 10800 1 EEST}
    {701042400 7200 0 EET}
    {701827200 10800 1 EEST}
    {717552000 7200 0 EET}
    {733276800 10800 1 EEST}
    {749001600 7200 0 EET}
    {764726400 10800 1 EEST}
    {767743200 14400 0 MSD}
    {780436800 10800 0 MSK}
    {796165200 14400 1 MSD}
    {811886400 10800 0 MSK}
    {780447600 10800 0 MSK}
    {796172400 14400 1 MSD}
    {811897200 10800 0 MSK}
    {828219600 14400 1 MSD}
    {852066000 10800 0 MSK}
    {846374400 10800 0 MSK}
    {859683600 10800 0 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}

Changes to library/tzdata/Europe/Stockholm.

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
1
2
3


4
5
























































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Berlin)]} {
    LoadTimeZoneFile Europe/Berlin

set TZData(:Europe/Stockholm) {
}
set TZData(:Europe/Stockholm) $TZData(:Europe/Berlin)
    {-9223372036854775808 4332 0 LMT}
    {-2871681132 3614 0 SET}
    {-2208992414 3600 0 CET}
    {-1692496800 7200 1 CEST}
    {-1680483600 3600 0 CET}
    {315529200 3600 0 CET}
    {323830800 7200 1 CEST}
    {338950800 3600 0 CET}
    {354675600 7200 1 CEST}
    {370400400 3600 0 CET}
    {386125200 7200 1 CEST}
    {401850000 3600 0 CET}
    {417574800 7200 1 CEST}
    {433299600 3600 0 CET}
    {449024400 7200 1 CEST}
    {465354000 3600 0 CET}
    {481078800 7200 1 CEST}
    {496803600 3600 0 CET}
    {512528400 7200 1 CEST}
    {528253200 3600 0 CET}
    {543978000 7200 1 CEST}
    {559702800 3600 0 CET}
    {575427600 7200 1 CEST}
    {591152400 3600 0 CET}
    {606877200 7200 1 CEST}
    {622602000 3600 0 CET}
    {638326800 7200 1 CEST}
    {654656400 3600 0 CET}
    {670381200 7200 1 CEST}
    {686106000 3600 0 CET}
    {701830800 7200 1 CEST}
    {717555600 3600 0 CET}
    {733280400 7200 1 CEST}
    {749005200 3600 0 CET}
    {764730000 7200 1 CEST}
    {780454800 3600 0 CET}
    {796179600 7200 1 CEST}
    {811904400 3600 0 CET}
    {828234000 7200 1 CEST}
    {846378000 3600 0 CET}
    {859683600 7200 1 CEST}
    {877827600 3600 0 CET}
    {891133200 7200 1 CEST}
    {909277200 3600 0 CET}
    {922582800 7200 1 CEST}
    {941331600 3600 0 CET}
    {954032400 7200 1 CEST}
    {972781200 3600 0 CET}
    {985482000 7200 1 CEST}
    {1004230800 3600 0 CET}
    {1017536400 7200 1 CEST}
    {1035680400 3600 0 CET}
    {1048986000 7200 1 CEST}
    {1067130000 3600 0 CET}
    {1080435600 7200 1 CEST}
    {1099184400 3600 0 CET}
    {1111885200 7200 1 CEST}
    {1130634000 3600 0 CET}
    {1143334800 7200 1 CEST}
    {1162083600 3600 0 CET}
    {1174784400 7200 1 CEST}
    {1193533200 3600 0 CET}
    {1206838800 7200 1 CEST}
    {1224982800 3600 0 CET}
    {1238288400 7200 1 CEST}
    {1256432400 3600 0 CET}
    {1269738000 7200 1 CEST}
    {1288486800 3600 0 CET}
    {1301187600 7200 1 CEST}
    {1319936400 3600 0 CET}
    {1332637200 7200 1 CEST}
    {1351386000 3600 0 CET}
    {1364691600 7200 1 CEST}
    {1382835600 3600 0 CET}
    {1396141200 7200 1 CEST}
    {1414285200 3600 0 CET}
    {1427590800 7200 1 CEST}
    {1445734800 3600 0 CET}
    {1459040400 7200 1 CEST}
    {1477789200 3600 0 CET}
    {1490490000 7200 1 CEST}
    {1509238800 3600 0 CET}
    {1521939600 7200 1 CEST}
    {1540688400 3600 0 CET}
    {1553994000 7200 1 CEST}
    {1572138000 3600 0 CET}
    {1585443600 7200 1 CEST}
    {1603587600 3600 0 CET}
    {1616893200 7200 1 CEST}
    {1635642000 3600 0 CET}
    {1648342800 7200 1 CEST}
    {1667091600 3600 0 CET}
    {1679792400 7200 1 CEST}
    {1698541200 3600 0 CET}
    {1711846800 7200 1 CEST}
    {1729990800 3600 0 CET}
    {1743296400 7200 1 CEST}
    {1761440400 3600 0 CET}
    {1774746000 7200 1 CEST}
    {1792890000 3600 0 CET}
    {1806195600 7200 1 CEST}
    {1824944400 3600 0 CET}
    {1837645200 7200 1 CEST}
    {1856394000 3600 0 CET}
    {1869094800 7200 1 CEST}
    {1887843600 3600 0 CET}
    {1901149200 7200 1 CEST}
    {1919293200 3600 0 CET}
    {1932598800 7200 1 CEST}
    {1950742800 3600 0 CET}
    {1964048400 7200 1 CEST}
    {1982797200 3600 0 CET}
    {1995498000 7200 1 CEST}
    {2014246800 3600 0 CET}
    {2026947600 7200 1 CEST}
    {2045696400 3600 0 CET}
    {2058397200 7200 1 CEST}
    {2077146000 3600 0 CET}
    {2090451600 7200 1 CEST}
    {2108595600 3600 0 CET}
    {2121901200 7200 1 CEST}
    {2140045200 3600 0 CET}
    {2153350800 7200 1 CEST}
    {2172099600 3600 0 CET}
    {2184800400 7200 1 CEST}
    {2203549200 3600 0 CET}
    {2216250000 7200 1 CEST}
    {2234998800 3600 0 CET}
    {2248304400 7200 1 CEST}
    {2266448400 3600 0 CET}
    {2279754000 7200 1 CEST}
    {2297898000 3600 0 CET}
    {2311203600 7200 1 CEST}
    {2329347600 3600 0 CET}
    {2342653200 7200 1 CEST}
    {2361402000 3600 0 CET}
    {2374102800 7200 1 CEST}
    {2392851600 3600 0 CET}
    {2405552400 7200 1 CEST}
    {2424301200 3600 0 CET}
    {2437606800 7200 1 CEST}
    {2455750800 3600 0 CET}
    {2469056400 7200 1 CEST}
    {2487200400 3600 0 CET}
    {2500506000 7200 1 CEST}
    {2519254800 3600 0 CET}
    {2531955600 7200 1 CEST}
    {2550704400 3600 0 CET}
    {2563405200 7200 1 CEST}
    {2582154000 3600 0 CET}
    {2595459600 7200 1 CEST}
    {2613603600 3600 0 CET}
    {2626909200 7200 1 CEST}
    {2645053200 3600 0 CET}
    {2658358800 7200 1 CEST}
    {2676502800 3600 0 CET}
    {2689808400 7200 1 CEST}
    {2708557200 3600 0 CET}
    {2721258000 7200 1 CEST}
    {2740006800 3600 0 CET}
    {2752707600 7200 1 CEST}
    {2771456400 3600 0 CET}
    {2784762000 7200 1 CEST}
    {2802906000 3600 0 CET}
    {2816211600 7200 1 CEST}
    {2834355600 3600 0 CET}
    {2847661200 7200 1 CEST}
    {2866410000 3600 0 CET}
    {2879110800 7200 1 CEST}
    {2897859600 3600 0 CET}
    {2910560400 7200 1 CEST}
    {2929309200 3600 0 CET}
    {2942010000 7200 1 CEST}
    {2960758800 3600 0 CET}
    {2974064400 7200 1 CEST}
    {2992208400 3600 0 CET}
    {3005514000 7200 1 CEST}
    {3023658000 3600 0 CET}
    {3036963600 7200 1 CEST}
    {3055712400 3600 0 CET}
    {3068413200 7200 1 CEST}
    {3087162000 3600 0 CET}
    {3099862800 7200 1 CEST}
    {3118611600 3600 0 CET}
    {3131917200 7200 1 CEST}
    {3150061200 3600 0 CET}
    {3163366800 7200 1 CEST}
    {3181510800 3600 0 CET}
    {3194816400 7200 1 CEST}
    {3212960400 3600 0 CET}
    {3226266000 7200 1 CEST}
    {3245014800 3600 0 CET}
    {3257715600 7200 1 CEST}
    {3276464400 3600 0 CET}
    {3289165200 7200 1 CEST}
    {3307914000 3600 0 CET}
    {3321219600 7200 1 CEST}
    {3339363600 3600 0 CET}
    {3352669200 7200 1 CEST}
    {3370813200 3600 0 CET}
    {3384118800 7200 1 CEST}
    {3402867600 3600 0 CET}
    {3415568400 7200 1 CEST}
    {3434317200 3600 0 CET}
    {3447018000 7200 1 CEST}
    {3465766800 3600 0 CET}
    {3479072400 7200 1 CEST}
    {3497216400 3600 0 CET}
    {3510522000 7200 1 CEST}
    {3528666000 3600 0 CET}
    {3541971600 7200 1 CEST}
    {3560115600 3600 0 CET}
    {3573421200 7200 1 CEST}
    {3592170000 3600 0 CET}
    {3604870800 7200 1 CEST}
    {3623619600 3600 0 CET}
    {3636320400 7200 1 CEST}
    {3655069200 3600 0 CET}
    {3668374800 7200 1 CEST}
    {3686518800 3600 0 CET}
    {3699824400 7200 1 CEST}
    {3717968400 3600 0 CET}
    {3731274000 7200 1 CEST}
    {3750022800 3600 0 CET}
    {3762723600 7200 1 CEST}
    {3781472400 3600 0 CET}
    {3794173200 7200 1 CEST}
    {3812922000 3600 0 CET}
    {3825622800 7200 1 CEST}
    {3844371600 3600 0 CET}
    {3857677200 7200 1 CEST}
    {3875821200 3600 0 CET}
    {3889126800 7200 1 CEST}
    {3907270800 3600 0 CET}
    {3920576400 7200 1 CEST}
    {3939325200 3600 0 CET}
    {3952026000 7200 1 CEST}
    {3970774800 3600 0 CET}
    {3983475600 7200 1 CEST}
    {4002224400 3600 0 CET}
    {4015530000 7200 1 CEST}
    {4033674000 3600 0 CET}
    {4046979600 7200 1 CEST}
    {4065123600 3600 0 CET}
    {4078429200 7200 1 CEST}
    {4096573200 3600 0 CET}
}

Changes to library/tzdata/Europe/Uzhgorod.

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
1
2
3


4
5




























































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Kyiv)]} {
    LoadTimeZoneFile Europe/Kyiv

set TZData(:Europe/Uzhgorod) {
}
set TZData(:Europe/Uzhgorod) $TZData(:Europe/Kyiv)
    {-9223372036854775808 5352 0 LMT}
    {-2500939752 3600 0 CET}
    {-946774800 3600 0 CET}
    {-938905200 7200 1 CEST}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-812502000 7200 1 CEST}
    {-796870800 7200 1 CEST}
    {-794714400 3600 0 CET}
    {-773456400 10800 0 MSD}
    {354920400 14400 1 MSD}
    {370728000 10800 0 MSK}
    {386456400 14400 1 MSD}
    {402264000 10800 0 MSK}
    {417992400 14400 1 MSD}
    {433800000 10800 0 MSK}
    {449614800 14400 1 MSD}
    {465346800 10800 0 MSK}
    {481071600 14400 1 MSD}
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {631141200 10800 0 MSK}
    {646786800 3600 0 CET}
    {670384800 7200 0 EET}
    {694216800 7200 0 EET}
    {701820000 10800 1 EEST}
    {717541200 7200 0 EET}
    {733269600 10800 1 EEST}
    {748990800 7200 0 EET}
    {764719200 10800 1 EEST}
    {780440400 7200 0 EET}
    {788911200 7200 0 EET}
    {796179600 10800 1 EEST}
    {811904400 7200 0 EET}
    {828234000 10800 1 EEST}
    {846378000 7200 0 EET}
    {859683600 10800 1 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}
    {972781200 7200 0 EET}
    {985482000 10800 1 EEST}
    {1004230800 7200 0 EET}
    {1017536400 10800 1 EEST}
    {1035680400 7200 0 EET}
    {1048986000 10800 1 EEST}
    {1067130000 7200 0 EET}
    {1080435600 10800 1 EEST}
    {1099184400 7200 0 EET}
    {1111885200 10800 1 EEST}
    {1130634000 7200 0 EET}
    {1143334800 10800 1 EEST}
    {1162083600 7200 0 EET}
    {1174784400 10800 1 EEST}
    {1193533200 7200 0 EET}
    {1206838800 10800 1 EEST}
    {1224982800 7200 0 EET}
    {1238288400 10800 1 EEST}
    {1256432400 7200 0 EET}
    {1269738000 10800 1 EEST}
    {1288486800 7200 0 EET}
    {1301187600 10800 1 EEST}
    {1319936400 7200 0 EET}
    {1332637200 10800 1 EEST}
    {1351386000 7200 0 EET}
    {1364691600 10800 1 EEST}
    {1382835600 7200 0 EET}
    {1396141200 10800 1 EEST}
    {1414285200 7200 0 EET}
    {1427590800 10800 1 EEST}
    {1445734800 7200 0 EET}
    {1459040400 10800 1 EEST}
    {1477789200 7200 0 EET}
    {1490490000 10800 1 EEST}
    {1509238800 7200 0 EET}
    {1521939600 10800 1 EEST}
    {1540688400 7200 0 EET}
    {1553994000 10800 1 EEST}
    {1572138000 7200 0 EET}
    {1585443600 10800 1 EEST}
    {1603587600 7200 0 EET}
    {1616893200 10800 1 EEST}
    {1635642000 7200 0 EET}
    {1648342800 10800 1 EEST}
    {1667091600 7200 0 EET}
    {1679792400 10800 1 EEST}
    {1698541200 7200 0 EET}
    {1711846800 10800 1 EEST}
    {1729990800 7200 0 EET}
    {1743296400 10800 1 EEST}
    {1761440400 7200 0 EET}
    {1774746000 10800 1 EEST}
    {1792890000 7200 0 EET}
    {1806195600 10800 1 EEST}
    {1824944400 7200 0 EET}
    {1837645200 10800 1 EEST}
    {1856394000 7200 0 EET}
    {1869094800 10800 1 EEST}
    {1887843600 7200 0 EET}
    {1901149200 10800 1 EEST}
    {1919293200 7200 0 EET}
    {1932598800 10800 1 EEST}
    {1950742800 7200 0 EET}
    {1964048400 10800 1 EEST}
    {1982797200 7200 0 EET}
    {1995498000 10800 1 EEST}
    {2014246800 7200 0 EET}
    {2026947600 10800 1 EEST}
    {2045696400 7200 0 EET}
    {2058397200 10800 1 EEST}
    {2077146000 7200 0 EET}
    {2090451600 10800 1 EEST}
    {2108595600 7200 0 EET}
    {2121901200 10800 1 EEST}
    {2140045200 7200 0 EET}
    {2153350800 10800 1 EEST}
    {2172099600 7200 0 EET}
    {2184800400 10800 1 EEST}
    {2203549200 7200 0 EET}
    {2216250000 10800 1 EEST}
    {2234998800 7200 0 EET}
    {2248304400 10800 1 EEST}
    {2266448400 7200 0 EET}
    {2279754000 10800 1 EEST}
    {2297898000 7200 0 EET}
    {2311203600 10800 1 EEST}
    {2329347600 7200 0 EET}
    {2342653200 10800 1 EEST}
    {2361402000 7200 0 EET}
    {2374102800 10800 1 EEST}
    {2392851600 7200 0 EET}
    {2405552400 10800 1 EEST}
    {2424301200 7200 0 EET}
    {2437606800 10800 1 EEST}
    {2455750800 7200 0 EET}
    {2469056400 10800 1 EEST}
    {2487200400 7200 0 EET}
    {2500506000 10800 1 EEST}
    {2519254800 7200 0 EET}
    {2531955600 10800 1 EEST}
    {2550704400 7200 0 EET}
    {2563405200 10800 1 EEST}
    {2582154000 7200 0 EET}
    {2595459600 10800 1 EEST}
    {2613603600 7200 0 EET}
    {2626909200 10800 1 EEST}
    {2645053200 7200 0 EET}
    {2658358800 10800 1 EEST}
    {2676502800 7200 0 EET}
    {2689808400 10800 1 EEST}
    {2708557200 7200 0 EET}
    {2721258000 10800 1 EEST}
    {2740006800 7200 0 EET}
    {2752707600 10800 1 EEST}
    {2771456400 7200 0 EET}
    {2784762000 10800 1 EEST}
    {2802906000 7200 0 EET}
    {2816211600 10800 1 EEST}
    {2834355600 7200 0 EET}
    {2847661200 10800 1 EEST}
    {2866410000 7200 0 EET}
    {2879110800 10800 1 EEST}
    {2897859600 7200 0 EET}
    {2910560400 10800 1 EEST}
    {2929309200 7200 0 EET}
    {2942010000 10800 1 EEST}
    {2960758800 7200 0 EET}
    {2974064400 10800 1 EEST}
    {2992208400 7200 0 EET}
    {3005514000 10800 1 EEST}
    {3023658000 7200 0 EET}
    {3036963600 10800 1 EEST}
    {3055712400 7200 0 EET}
    {3068413200 10800 1 EEST}
    {3087162000 7200 0 EET}
    {3099862800 10800 1 EEST}
    {3118611600 7200 0 EET}
    {3131917200 10800 1 EEST}
    {3150061200 7200 0 EET}
    {3163366800 10800 1 EEST}
    {3181510800 7200 0 EET}
    {3194816400 10800 1 EEST}
    {3212960400 7200 0 EET}
    {3226266000 10800 1 EEST}
    {3245014800 7200 0 EET}
    {3257715600 10800 1 EEST}
    {3276464400 7200 0 EET}
    {3289165200 10800 1 EEST}
    {3307914000 7200 0 EET}
    {3321219600 10800 1 EEST}
    {3339363600 7200 0 EET}
    {3352669200 10800 1 EEST}
    {3370813200 7200 0 EET}
    {3384118800 10800 1 EEST}
    {3402867600 7200 0 EET}
    {3415568400 10800 1 EEST}
    {3434317200 7200 0 EET}
    {3447018000 10800 1 EEST}
    {3465766800 7200 0 EET}
    {3479072400 10800 1 EEST}
    {3497216400 7200 0 EET}
    {3510522000 10800 1 EEST}
    {3528666000 7200 0 EET}
    {3541971600 10800 1 EEST}
    {3560115600 7200 0 EET}
    {3573421200 10800 1 EEST}
    {3592170000 7200 0 EET}
    {3604870800 10800 1 EEST}
    {3623619600 7200 0 EET}
    {3636320400 10800 1 EEST}
    {3655069200 7200 0 EET}
    {3668374800 10800 1 EEST}
    {3686518800 7200 0 EET}
    {3699824400 10800 1 EEST}
    {3717968400 7200 0 EET}
    {3731274000 10800 1 EEST}
    {3750022800 7200 0 EET}
    {3762723600 10800 1 EEST}
    {3781472400 7200 0 EET}
    {3794173200 10800 1 EEST}
    {3812922000 7200 0 EET}
    {3825622800 10800 1 EEST}
    {3844371600 7200 0 EET}
    {3857677200 10800 1 EEST}
    {3875821200 7200 0 EET}
    {3889126800 10800 1 EEST}
    {3907270800 7200 0 EET}
    {3920576400 10800 1 EEST}
    {3939325200 7200 0 EET}
    {3952026000 10800 1 EEST}
    {3970774800 7200 0 EET}
    {3983475600 10800 1 EEST}
    {4002224400 7200 0 EET}
    {4015530000 10800 1 EEST}
    {4033674000 7200 0 EET}
    {4046979600 10800 1 EEST}
    {4065123600 7200 0 EET}
    {4078429200 10800 1 EEST}
    {4096573200 7200 0 EET}
}

Changes to library/tzdata/Europe/Volgograd.

65
66
67
68
69
70
71

72
65
66
67
68
69
70
71
72
73







+

    {1238281200 14400 1 +04}
    {1256425200 10800 0 +03}
    {1269730800 14400 1 +04}
    {1288479600 10800 0 +03}
    {1301180400 14400 0 +04}
    {1414274400 10800 0 +03}
    {1540681200 14400 0 +04}
    {1609020000 10800 0 +03}
}

Changes to library/tzdata/Europe/Zaporozhye.

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
1
2
3


4
5


























































































































































































































































+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Europe/Kyiv)]} {
    LoadTimeZoneFile Europe/Kyiv

set TZData(:Europe/Zaporozhye) {
}
set TZData(:Europe/Zaporozhye) $TZData(:Europe/Kyiv)
    {-9223372036854775808 8440 0 LMT}
    {-2840149240 8400 0 +0220}
    {-1441160400 7200 0 EET}
    {-1247536800 10800 0 MSK}
    {-894769200 3600 0 CET}
    {-857257200 3600 0 CET}
    {-844556400 7200 1 CEST}
    {-828226800 3600 0 CET}
    {-826419600 10800 0 MSD}
    {354920400 14400 1 MSD}
    {370728000 10800 0 MSK}
    {386456400 14400 1 MSD}
    {402264000 10800 0 MSK}
    {417992400 14400 1 MSD}
    {433800000 10800 0 MSK}
    {449614800 14400 1 MSD}
    {465346800 10800 0 MSK}
    {481071600 14400 1 MSD}
    {496796400 10800 0 MSK}
    {512521200 14400 1 MSD}
    {528246000 10800 0 MSK}
    {543970800 14400 1 MSD}
    {559695600 10800 0 MSK}
    {575420400 14400 1 MSD}
    {591145200 10800 0 MSK}
    {606870000 14400 1 MSD}
    {622594800 10800 0 MSK}
    {638319600 14400 1 MSD}
    {654649200 10800 0 MSK}
    {670374000 10800 0 EEST}
    {686091600 7200 0 EET}
    {701820000 10800 1 EEST}
    {717541200 7200 0 EET}
    {733269600 10800 1 EEST}
    {748990800 7200 0 EET}
    {764719200 10800 1 EEST}
    {780440400 7200 0 EET}
    {788911200 7200 0 EET}
    {796179600 10800 1 EEST}
    {811904400 7200 0 EET}
    {828234000 10800 1 EEST}
    {846378000 7200 0 EET}
    {859683600 10800 1 EEST}
    {877827600 7200 0 EET}
    {891133200 10800 1 EEST}
    {909277200 7200 0 EET}
    {922582800 10800 1 EEST}
    {941331600 7200 0 EET}
    {954032400 10800 1 EEST}
    {972781200 7200 0 EET}
    {985482000 10800 1 EEST}
    {1004230800 7200 0 EET}
    {1017536400 10800 1 EEST}
    {1035680400 7200 0 EET}
    {1048986000 10800 1 EEST}
    {1067130000 7200 0 EET}
    {1080435600 10800 1 EEST}
    {1099184400 7200 0 EET}
    {1111885200 10800 1 EEST}
    {1130634000 7200 0 EET}
    {1143334800 10800 1 EEST}
    {1162083600 7200 0 EET}
    {1174784400 10800 1 EEST}
    {1193533200 7200 0 EET}
    {1206838800 10800 1 EEST}
    {1224982800 7200 0 EET}
    {1238288400 10800 1 EEST}
    {1256432400 7200 0 EET}
    {1269738000 10800 1 EEST}
    {1288486800 7200 0 EET}
    {1301187600 10800 1 EEST}
    {1319936400 7200 0 EET}
    {1332637200 10800 1 EEST}
    {1351386000 7200 0 EET}
    {1364691600 10800 1 EEST}
    {1382835600 7200 0 EET}
    {1396141200 10800 1 EEST}
    {1414285200 7200 0 EET}
    {1427590800 10800 1 EEST}
    {1445734800 7200 0 EET}
    {1459040400 10800 1 EEST}
    {1477789200 7200 0 EET}
    {1490490000 10800 1 EEST}
    {1509238800 7200 0 EET}
    {1521939600 10800 1 EEST}
    {1540688400 7200 0 EET}
    {1553994000 10800 1 EEST}
    {1572138000 7200 0 EET}
    {1585443600 10800 1 EEST}
    {1603587600 7200 0 EET}
    {1616893200 10800 1 EEST}
    {1635642000 7200 0 EET}
    {1648342800 10800 1 EEST}
    {1667091600 7200 0 EET}
    {1679792400 10800 1 EEST}
    {1698541200 7200 0 EET}
    {1711846800 10800 1 EEST}
    {1729990800 7200 0 EET}
    {1743296400 10800 1 EEST}
    {1761440400 7200 0 EET}
    {1774746000 10800 1 EEST}
    {1792890000 7200 0 EET}
    {1806195600 10800 1 EEST}
    {1824944400 7200 0 EET}
    {1837645200 10800 1 EEST}
    {1856394000 7200 0 EET}
    {1869094800 10800 1 EEST}
    {1887843600 7200 0 EET}
    {1901149200 10800 1 EEST}
    {1919293200 7200 0 EET}
    {1932598800 10800 1 EEST}
    {1950742800 7200 0 EET}
    {1964048400 10800 1 EEST}
    {1982797200 7200 0 EET}
    {1995498000 10800 1 EEST}
    {2014246800 7200 0 EET}
    {2026947600 10800 1 EEST}
    {2045696400 7200 0 EET}
    {2058397200 10800 1 EEST}
    {2077146000 7200 0 EET}
    {2090451600 10800 1 EEST}
    {2108595600 7200 0 EET}
    {2121901200 10800 1 EEST}
    {2140045200 7200 0 EET}
    {2153350800 10800 1 EEST}
    {2172099600 7200 0 EET}
    {2184800400 10800 1 EEST}
    {2203549200 7200 0 EET}
    {2216250000 10800 1 EEST}
    {2234998800 7200 0 EET}
    {2248304400 10800 1 EEST}
    {2266448400 7200 0 EET}
    {2279754000 10800 1 EEST}
    {2297898000 7200 0 EET}
    {2311203600 10800 1 EEST}
    {2329347600 7200 0 EET}
    {2342653200 10800 1 EEST}
    {2361402000 7200 0 EET}
    {2374102800 10800 1 EEST}
    {2392851600 7200 0 EET}
    {2405552400 10800 1 EEST}
    {2424301200 7200 0 EET}
    {2437606800 10800 1 EEST}
    {2455750800 7200 0 EET}
    {2469056400 10800 1 EEST}
    {2487200400 7200 0 EET}
    {2500506000 10800 1 EEST}
    {2519254800 7200 0 EET}
    {2531955600 10800 1 EEST}
    {2550704400 7200 0 EET}
    {2563405200 10800 1 EEST}
    {2582154000 7200 0 EET}
    {2595459600 10800 1 EEST}
    {2613603600 7200 0 EET}
    {2626909200 10800 1 EEST}
    {2645053200 7200 0 EET}
    {2658358800 10800 1 EEST}
    {2676502800 7200 0 EET}
    {2689808400 10800 1 EEST}
    {2708557200 7200 0 EET}
    {2721258000 10800 1 EEST}
    {2740006800 7200 0 EET}
    {2752707600 10800 1 EEST}
    {2771456400 7200 0 EET}
    {2784762000 10800 1 EEST}
    {2802906000 7200 0 EET}
    {2816211600 10800 1 EEST}
    {2834355600 7200 0 EET}
    {2847661200 10800 1 EEST}
    {2866410000 7200 0 EET}
    {2879110800 10800 1 EEST}
    {2897859600 7200 0 EET}
    {2910560400 10800 1 EEST}
    {2929309200 7200 0 EET}
    {2942010000 10800 1 EEST}
    {2960758800 7200 0 EET}
    {2974064400 10800 1 EEST}
    {2992208400 7200 0 EET}
    {3005514000 10800 1 EEST}
    {3023658000 7200 0 EET}
    {3036963600 10800 1 EEST}
    {3055712400 7200 0 EET}
    {3068413200 10800 1 EEST}
    {3087162000 7200 0 EET}
    {3099862800 10800 1 EEST}
    {3118611600 7200 0 EET}
    {3131917200 10800 1 EEST}
    {3150061200 7200 0 EET}
    {3163366800 10800 1 EEST}
    {3181510800 7200 0 EET}
    {3194816400 10800 1 EEST}
    {3212960400 7200 0 EET}
    {3226266000 10800 1 EEST}
    {3245014800 7200 0 EET}
    {3257715600 10800 1 EEST}
    {3276464400 7200 0 EET}
    {3289165200 10800 1 EEST}
    {3307914000 7200 0 EET}
    {3321219600 10800 1 EEST}
    {3339363600 7200 0 EET}
    {3352669200 10800 1 EEST}
    {3370813200 7200 0 EET}
    {3384118800 10800 1 EEST}
    {3402867600 7200 0 EET}
    {3415568400 10800 1 EEST}
    {3434317200 7200 0 EET}
    {3447018000 10800 1 EEST}
    {3465766800 7200 0 EET}
    {3479072400 10800 1 EEST}
    {3497216400 7200 0 EET}
    {3510522000 10800 1 EEST}
    {3528666000 7200 0 EET}
    {3541971600 10800 1 EEST}
    {3560115600 7200 0 EET}
    {3573421200 10800 1 EEST}
    {3592170000 7200 0 EET}
    {3604870800 10800 1 EEST}
    {3623619600 7200 0 EET}
    {3636320400 10800 1 EEST}
    {3655069200 7200 0 EET}
    {3668374800 10800 1 EEST}
    {3686518800 7200 0 EET}
    {3699824400 10800 1 EEST}
    {3717968400 7200 0 EET}
    {3731274000 10800 1 EEST}
    {3750022800 7200 0 EET}
    {3762723600 10800 1 EEST}
    {3781472400 7200 0 EET}
    {3794173200 10800 1 EEST}
    {3812922000 7200 0 EET}
    {3825622800 10800 1 EEST}
    {3844371600 7200 0 EET}
    {3857677200 10800 1 EEST}
    {3875821200 7200 0 EET}
    {3889126800 10800 1 EEST}
    {3907270800 7200 0 EET}
    {3920576400 10800 1 EEST}
    {3939325200 7200 0 EET}
    {3952026000 10800 1 EEST}
    {3970774800 7200 0 EET}
    {3983475600 10800 1 EEST}
    {4002224400 7200 0 EET}
    {4015530000 10800 1 EEST}
    {4033674000 7200 0 EET}
    {4046979600 10800 1 EEST}
    {4065123600 7200 0 EET}
    {4078429200 10800 1 EEST}
    {4096573200 7200 0 EET}
}

Changes to library/tzdata/Iceland.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Atlantic/Reykjavik)]} {
    LoadTimeZoneFile Atlantic/Reykjavik
if {![info exists TZData(Africa/Abidjan)]} {
    LoadTimeZoneFile Africa/Abidjan
}
set TZData(:Iceland) $TZData(:Atlantic/Reykjavik)
set TZData(:Iceland) $TZData(:Africa/Abidjan)

Changes to library/tzdata/Indian/Christmas.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Bangkok)]} {
    LoadTimeZoneFile Asia/Bangkok

set TZData(:Indian/Christmas) {
}
set TZData(:Indian/Christmas) $TZData(:Asia/Bangkok)
    {-9223372036854775808 25372 0 LMT}
    {-2364102172 25200 0 +07}
}

Changes to library/tzdata/Indian/Cocos.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Yangon)]} {
    LoadTimeZoneFile Asia/Yangon

set TZData(:Indian/Cocos) {
}
set TZData(:Indian/Cocos) $TZData(:Asia/Yangon)
    {-9223372036854775808 23260 0 LMT}
    {-2209012060 23400 0 +0630}
}

Changes to library/tzdata/Indian/Kerguelen.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Indian/Maldives)]} {
    LoadTimeZoneFile Indian/Maldives

set TZData(:Indian/Kerguelen) {
}
set TZData(:Indian/Kerguelen) $TZData(:Indian/Maldives)
    {-9223372036854775808 0 0 -00}
    {-631152000 18000 0 +05}
}

Changes to library/tzdata/Indian/Mahe.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Dubai)]} {
    LoadTimeZoneFile Asia/Dubai

set TZData(:Indian/Mahe) {
}
set TZData(:Indian/Mahe) $TZData(:Asia/Dubai)
    {-9223372036854775808 13308 0 LMT}
    {-2006653308 14400 0 +04}
}

Changes to library/tzdata/Indian/Reunion.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Asia/Dubai)]} {
    LoadTimeZoneFile Asia/Dubai

set TZData(:Indian/Reunion) {
}
set TZData(:Indian/Reunion) $TZData(:Asia/Dubai)
    {-9223372036854775808 13312 0 LMT}
    {-1848886912 14400 0 +04}
}

Changes to library/tzdata/Pacific/Apia.

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
24
25
26
27
28
29
30





























































































































































31







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1522504800 46800 0 +13}
    {1538229600 50400 1 +13}
    {1554559200 46800 0 +13}
    {1569679200 50400 1 +13}
    {1586008800 46800 0 +13}
    {1601128800 50400 1 +13}
    {1617458400 46800 0 +13}
    {1632578400 50400 1 +13}
    {1648908000 46800 0 +13}
    {1664028000 50400 1 +13}
    {1680357600 46800 0 +13}
    {1695477600 50400 1 +13}
    {1712412000 46800 0 +13}
    {1727532000 50400 1 +13}
    {1743861600 46800 0 +13}
    {1758981600 50400 1 +13}
    {1775311200 46800 0 +13}
    {1790431200 50400 1 +13}
    {1806760800 46800 0 +13}
    {1821880800 50400 1 +13}
    {1838210400 46800 0 +13}
    {1853330400 50400 1 +13}
    {1869660000 46800 0 +13}
    {1885384800 50400 1 +13}
    {1901714400 46800 0 +13}
    {1916834400 50400 1 +13}
    {1933164000 46800 0 +13}
    {1948284000 50400 1 +13}
    {1964613600 46800 0 +13}
    {1979733600 50400 1 +13}
    {1996063200 46800 0 +13}
    {2011183200 50400 1 +13}
    {2027512800 46800 0 +13}
    {2042632800 50400 1 +13}
    {2058962400 46800 0 +13}
    {2074687200 50400 1 +13}
    {2091016800 46800 0 +13}
    {2106136800 50400 1 +13}
    {2122466400 46800 0 +13}
    {2137586400 50400 1 +13}
    {2153916000 46800 0 +13}
    {2169036000 50400 1 +13}
    {2185365600 46800 0 +13}
    {2200485600 50400 1 +13}
    {2216815200 46800 0 +13}
    {2232540000 50400 1 +13}
    {2248869600 46800 0 +13}
    {2263989600 50400 1 +13}
    {2280319200 46800 0 +13}
    {2295439200 50400 1 +13}
    {2311768800 46800 0 +13}
    {2326888800 50400 1 +13}
    {2343218400 46800 0 +13}
    {2358338400 50400 1 +13}
    {2374668000 46800 0 +13}
    {2389788000 50400 1 +13}
    {2406117600 46800 0 +13}
    {2421842400 50400 1 +13}
    {2438172000 46800 0 +13}
    {2453292000 50400 1 +13}
    {2469621600 46800 0 +13}
    {2484741600 50400 1 +13}
    {2501071200 46800 0 +13}
    {2516191200 50400 1 +13}
    {2532520800 46800 0 +13}
    {2547640800 50400 1 +13}
    {2563970400 46800 0 +13}
    {2579090400 50400 1 +13}
    {2596024800 46800 0 +13}
    {2611144800 50400 1 +13}
    {2627474400 46800 0 +13}
    {2642594400 50400 1 +13}
    {2658924000 46800 0 +13}
    {2674044000 50400 1 +13}
    {2690373600 46800 0 +13}
    {2705493600 50400 1 +13}
    {2721823200 46800 0 +13}
    {2736943200 50400 1 +13}
    {2753272800 46800 0 +13}
    {2768997600 50400 1 +13}
    {2785327200 46800 0 +13}
    {2800447200 50400 1 +13}
    {2816776800 46800 0 +13}
    {2831896800 50400 1 +13}
    {2848226400 46800 0 +13}
    {2863346400 50400 1 +13}
    {2879676000 46800 0 +13}
    {2894796000 50400 1 +13}
    {2911125600 46800 0 +13}
    {2926245600 50400 1 +13}
    {2942575200 46800 0 +13}
    {2958300000 50400 1 +13}
    {2974629600 46800 0 +13}
    {2989749600 50400 1 +13}
    {3006079200 46800 0 +13}
    {3021199200 50400 1 +13}
    {3037528800 46800 0 +13}
    {3052648800 50400 1 +13}
    {3068978400 46800 0 +13}
    {3084098400 50400 1 +13}
    {3100428000 46800 0 +13}
    {3116152800 50400 1 +13}
    {3132482400 46800 0 +13}
    {3147602400 50400 1 +13}
    {3163932000 46800 0 +13}
    {3179052000 50400 1 +13}
    {3195381600 46800 0 +13}
    {3210501600 50400 1 +13}
    {3226831200 46800 0 +13}
    {3241951200 50400 1 +13}
    {3258280800 46800 0 +13}
    {3273400800 50400 1 +13}
    {3289730400 46800 0 +13}
    {3305455200 50400 1 +13}
    {3321784800 46800 0 +13}
    {3336904800 50400 1 +13}
    {3353234400 46800 0 +13}
    {3368354400 50400 1 +13}
    {3384684000 46800 0 +13}
    {3399804000 50400 1 +13}
    {3416133600 46800 0 +13}
    {3431253600 50400 1 +13}
    {3447583200 46800 0 +13}
    {3462703200 50400 1 +13}
    {3479637600 46800 0 +13}
    {3494757600 50400 1 +13}
    {3511087200 46800 0 +13}
    {3526207200 50400 1 +13}
    {3542536800 46800 0 +13}
    {3557656800 50400 1 +13}
    {3573986400 46800 0 +13}
    {3589106400 50400 1 +13}
    {3605436000 46800 0 +13}
    {3620556000 50400 1 +13}
    {3636885600 46800 0 +13}
    {3652610400 50400 1 +13}
    {3668940000 46800 0 +13}
    {3684060000 50400 1 +13}
    {3700389600 46800 0 +13}
    {3715509600 50400 1 +13}
    {3731839200 46800 0 +13}
    {3746959200 50400 1 +13}
    {3763288800 46800 0 +13}
    {3778408800 50400 1 +13}
    {3794738400 46800 0 +13}
    {3809858400 50400 1 +13}
    {3826188000 46800 0 +13}
    {3841912800 50400 1 +13}
    {3858242400 46800 0 +13}
    {3873362400 50400 1 +13}
    {3889692000 46800 0 +13}
    {3904812000 50400 1 +13}
    {3921141600 46800 0 +13}
    {3936261600 50400 1 +13}
    {3952591200 46800 0 +13}
    {3967711200 50400 1 +13}
    {3984040800 46800 0 +13}
    {3999765600 50400 1 +13}
    {4016095200 46800 0 +13}
    {4031215200 50400 1 +13}
    {4047544800 46800 0 +13}
    {4062664800 50400 1 +13}
    {4078994400 46800 0 +13}
    {4094114400 50400 1 +13}
}

Changes to library/tzdata/Pacific/Chuuk.

1


2
3


4
5
6
7
8
9
10
11
1
2
3


4
5









+
+
-
-
+
+
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Port_Moresby)]} {
    LoadTimeZoneFile Pacific/Port_Moresby

set TZData(:Pacific/Chuuk) {
}
set TZData(:Pacific/Chuuk) $TZData(:Pacific/Port_Moresby)
    {-9223372036854775808 -49972 0 LMT}
    {-3944628428 36428 0 LMT}
    {-2177489228 36000 0 +10}
    {-1743674400 32400 0 +09}
    {-1606813200 36000 0 +10}
    {-907408800 32400 0 +09}
    {-770634000 36000 0 +10}
}

Changes to library/tzdata/Pacific/Easter.

106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120







-
+







    {1554606000 -21600 0 -06}
    {1567915200 -18000 1 -06}
    {1586055600 -21600 0 -06}
    {1599364800 -18000 1 -06}
    {1617505200 -21600 0 -06}
    {1630814400 -18000 1 -06}
    {1648954800 -21600 0 -06}
    {1662264000 -18000 1 -06}
    {1662868800 -18000 1 -06}
    {1680404400 -21600 0 -06}
    {1693713600 -18000 1 -06}
    {1712458800 -21600 0 -06}
    {1725768000 -18000 1 -06}
    {1743908400 -21600 0 -06}
    {1757217600 -18000 1 -06}
    {1775358000 -21600 0 -06}

Changes to library/tzdata/Pacific/Efate.

1
2
3
4
5


6
7
8

9
10
11
12
13
14
15
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(:Pacific/Efate) {
    {-9223372036854775808 40396 0 LMT}
    {-1829387596 39600 0 +11}
    {125409600 43200 1 +11}
    {133876800 39600 0 +11}
    {433256400 43200 1 +11}
    {448977600 39600 0 +11}
    {467298000 43200 1 +11}
    {464706000 43200 1 +11}
    {480427200 39600 0 +11}
    {496760400 43200 1 +11}
    {511876800 39600 0 +11}
    {528210000 43200 1 +11}
    {543931200 39600 0 +11}
    {559659600 43200 1 +11}
    {575380800 39600 0 +11}

Changes to library/tzdata/Pacific/Enderbury.

1


2
3


4
5
6
7
8
1
2
3


4
5






+
+
-
-
+
+
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Kanton)]} {
    LoadTimeZoneFile Pacific/Kanton

set TZData(:Pacific/Enderbury) {
}
set TZData(:Pacific/Enderbury) $TZData(:Pacific/Kanton)
    {-9223372036854775808 -41060 0 LMT}
    {-2177411740 -43200 0 -12}
    {307627200 -39600 0 -11}
    {788871600 46800 0 +13}
}

Changes to library/tzdata/Pacific/Fiji.

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
27
28
29
30
31
32
33





























































































































































34







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    {1515852000 43200 0 +12}
    {1541253600 46800 1 +12}
    {1547301600 43200 0 +12}
    {1573308000 46800 1 +12}
    {1578751200 43200 0 +12}
    {1608386400 46800 1 +12}
    {1610805600 43200 0 +12}
    {1636812000 46800 1 +12}
    {1642255200 43200 0 +12}
    {1668261600 46800 1 +12}
    {1673704800 43200 0 +12}
    {1699711200 46800 1 +12}
    {1705154400 43200 0 +12}
    {1731160800 46800 1 +12}
    {1736604000 43200 0 +12}
    {1762610400 46800 1 +12}
    {1768658400 43200 0 +12}
    {1794060000 46800 1 +12}
    {1800108000 43200 0 +12}
    {1826114400 46800 1 +12}
    {1831557600 43200 0 +12}
    {1857564000 46800 1 +12}
    {1863007200 43200 0 +12}
    {1889013600 46800 1 +12}
    {1894456800 43200 0 +12}
    {1920463200 46800 1 +12}
    {1925906400 43200 0 +12}
    {1951912800 46800 1 +12}
    {1957960800 43200 0 +12}
    {1983967200 46800 1 +12}
    {1989410400 43200 0 +12}
    {2015416800 46800 1 +12}
    {2020860000 43200 0 +12}
    {2046866400 46800 1 +12}
    {2052309600 43200 0 +12}
    {2078316000 46800 1 +12}
    {2083759200 43200 0 +12}
    {2109765600 46800 1 +12}
    {2115813600 43200 0 +12}
    {2141215200 46800 1 +12}
    {2147263200 43200 0 +12}
    {2173269600 46800 1 +12}
    {2178712800 43200 0 +12}
    {2204719200 46800 1 +12}
    {2210162400 43200 0 +12}
    {2236168800 46800 1 +12}
    {2241612000 43200 0 +12}
    {2267618400 46800 1 +12}
    {2273061600 43200 0 +12}
    {2299068000 46800 1 +12}
    {2305116000 43200 0 +12}
    {2330517600 46800 1 +12}
    {2336565600 43200 0 +12}
    {2362572000 46800 1 +12}
    {2368015200 43200 0 +12}
    {2394021600 46800 1 +12}
    {2399464800 43200 0 +12}
    {2425471200 46800 1 +12}
    {2430914400 43200 0 +12}
    {2456920800 46800 1 +12}
    {2462364000 43200 0 +12}
    {2488370400 46800 1 +12}
    {2494418400 43200 0 +12}
    {2520424800 46800 1 +12}
    {2525868000 43200 0 +12}
    {2551874400 46800 1 +12}
    {2557317600 43200 0 +12}
    {2583324000 46800 1 +12}
    {2588767200 43200 0 +12}
    {2614773600 46800 1 +12}
    {2620216800 43200 0 +12}
    {2646223200 46800 1 +12}
    {2652271200 43200 0 +12}
    {2677672800 46800 1 +12}
    {2683720800 43200 0 +12}
    {2709727200 46800 1 +12}
    {2715170400 43200 0 +12}
    {2741176800 46800 1 +12}
    {2746620000 43200 0 +12}
    {2772626400 46800 1 +12}
    {2778069600 43200 0 +12}
    {2804076000 46800 1 +12}
    {2809519200 43200 0 +12}
    {2835525600 46800 1 +12}
    {2841573600 43200 0 +12}
    {2867580000 46800 1 +12}
    {2873023200 43200 0 +12}
    {2899029600 46800 1 +12}
    {2904472800 43200 0 +12}
    {2930479200 46800 1 +12}
    {2935922400 43200 0 +12}
    {2961928800 46800 1 +12}
    {2967372000 43200 0 +12}
    {2993378400 46800 1 +12}
    {2999426400 43200 0 +12}
    {3024828000 46800 1 +12}
    {3030876000 43200 0 +12}
    {3056882400 46800 1 +12}
    {3062325600 43200 0 +12}
    {3088332000 46800 1 +12}
    {3093775200 43200 0 +12}
    {3119781600 46800 1 +12}
    {3125224800 43200 0 +12}
    {3151231200 46800 1 +12}
    {3156674400 43200 0 +12}
    {3182680800 46800 1 +12}
    {3188728800 43200 0 +12}
    {3214130400 46800 1 +12}
    {3220178400 43200 0 +12}
    {3246184800 46800 1 +12}
    {3251628000 43200 0 +12}
    {3277634400 46800 1 +12}
    {3283077600 43200 0 +12}
    {3309084000 46800 1 +12}
    {3314527200 43200 0 +12}
    {3340533600 46800 1 +12}
    {3345976800 43200 0 +12}
    {3371983200 46800 1 +12}
    {3378031200 43200 0 +12}
    {3404037600 46800 1 +12}
    {3409480800 43200 0 +12}
    {3435487200 46800 1 +12}
    {3440930400 43200 0 +12}
    {3466936800 46800 1 +12}
    {3472380000 43200 0 +12}
    {3498386400 46800 1 +12}
    {3503829600 43200 0 +12}
    {3529836000 46800 1 +12}
    {3535884000 43200 0 +12}
    {3561285600 46800 1 +12}
    {3567333600 43200 0 +12}
    {3593340000 46800 1 +12}
    {3598783200 43200 0 +12}
    {3624789600 46800 1 +12}
    {3630232800 43200 0 +12}
    {3656239200 46800 1 +12}
    {3661682400 43200 0 +12}
    {3687688800 46800 1 +12}
    {3693132000 43200 0 +12}
    {3719138400 46800 1 +12}
    {3725186400 43200 0 +12}
    {3751192800 46800 1 +12}
    {3756636000 43200 0 +12}
    {3782642400 46800 1 +12}
    {3788085600 43200 0 +12}
    {3814092000 46800 1 +12}
    {3819535200 43200 0 +12}
    {3845541600 46800 1 +12}
    {3850984800 43200 0 +12}
    {3876991200 46800 1 +12}
    {3883039200 43200 0 +12}
    {3908440800 46800 1 +12}
    {3914488800 43200 0 +12}
    {3940495200 46800 1 +12}
    {3945938400 43200 0 +12}
    {3971944800 46800 1 +12}
    {3977388000 43200 0 +12}
    {4003394400 46800 1 +12}
    {4008837600 43200 0 +12}
    {4034844000 46800 1 +12}
    {4040287200 43200 0 +12}
    {4066293600 46800 1 +12}
    {4072341600 43200 0 +12}
    {4097743200 46800 1 +12}
}

Changes to library/tzdata/Pacific/Funafuti.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa

set TZData(:Pacific/Funafuti) {
}
set TZData(:Pacific/Funafuti) $TZData(:Pacific/Tarawa)
    {-9223372036854775808 43012 0 LMT}
    {-2177495812 43200 0 +12}
}

Added library/tzdata/Pacific/Kanton.









1
2
3
4
5
6
7
8
+
+
+
+
+
+
+
+
# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Kanton) {
    {-9223372036854775808 0 0 -00}
    {-1020470400 -43200 0 -12}
    {307627200 -39600 0 -11}
    {788871600 46800 0 +13}
}

Changes to library/tzdata/Pacific/Majuro.

1


2
3


4
5
6
7
8
9
10
11
12
1
2
3


4
5










+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa

set TZData(:Pacific/Majuro) {
}
set TZData(:Pacific/Majuro) $TZData(:Pacific/Tarawa)
    {-9223372036854775808 41088 0 LMT}
    {-2177493888 39600 0 +11}
    {-1743678000 32400 0 +09}
    {-1606813200 39600 0 +11}
    {-1041418800 36000 0 +10}
    {-907408800 32400 0 +09}
    {-818067600 39600 0 +11}
    {-7988400 43200 0 +12}
}

Changes to library/tzdata/Pacific/Niue.

1
2
3
4
5

6
7

8
1
2
3
4

5


6
7




-
+
-
-
+

# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Niue) {
    {-9223372036854775808 -40780 0 LMT}
    {-2177412020 -40800 0 -1120}
    {-543069620 -40800 0 -1120}
    {-599575200 -41400 0 -1130}
    {276089400 -39600 0 -11}
    {-173623200 -39600 0 -11}
}

Changes to library/tzdata/Pacific/Pohnpei.

1


2
3


4
5
6
7
8
9
10
11
12
1
2
3


4
5










+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Guadalcanal)]} {
    LoadTimeZoneFile Pacific/Guadalcanal

set TZData(:Pacific/Pohnpei) {
}
set TZData(:Pacific/Pohnpei) $TZData(:Pacific/Guadalcanal)
    {-9223372036854775808 -48428 0 LMT}
    {-3944629972 37972 0 LMT}
    {-2177490772 39600 0 +11}
    {-1743678000 32400 0 +09}
    {-1606813200 39600 0 +11}
    {-1041418800 36000 0 +10}
    {-907408800 32400 0 +09}
    {-770634000 39600 0 +11}
}

Changes to library/tzdata/Pacific/Ponape.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Pohnpei)]} {
    LoadTimeZoneFile Pacific/Pohnpei
if {![info exists TZData(Pacific/Guadalcanal)]} {
    LoadTimeZoneFile Pacific/Guadalcanal
}
set TZData(:Pacific/Ponape) $TZData(:Pacific/Pohnpei)
set TZData(:Pacific/Ponape) $TZData(:Pacific/Guadalcanal)

Changes to library/tzdata/Pacific/Rarotonga.

1
2
3
4
5



6
7
8
9
10
11
12
1
2
3


4
5
6
7
8
9
10
11
12
13



-
-
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Rarotonga) {
    {-9223372036854775808 -38344 0 LMT}
    {-2177414456 -37800 0 -1030}
    {-9223372036854775808 48056 0 LMT}
    {-2209555256 -38344 0 LMT}
    {-543072056 -37800 0 -1030}
    {279714600 -34200 0 -10}
    {289387800 -36000 0 -10}
    {309952800 -34200 1 -10}
    {320837400 -36000 0 -10}
    {341402400 -34200 1 -10}
    {352287000 -36000 0 -10}
    {372852000 -34200 1 -10}

Changes to library/tzdata/Pacific/Tongatapu.

1
2
3
4
5
6



7
8
9
10
11
12
13
1
2
3



4
5
6
7
8
9
10
11
12
13



-
-
-
+
+
+







# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Tongatapu) {
    {-9223372036854775808 44360 0 LMT}
    {-2177497160 44400 0 +1220}
    {-915193200 46800 0 +13}
    {-9223372036854775808 44352 0 LMT}
    {-767189952 44400 0 +1220}
    {-284041200 46800 0 +13}
    {915102000 46800 0 +13}
    {939214800 50400 1 +13}
    {953384400 46800 0 +13}
    {973342800 50400 1 +13}
    {980596800 46800 0 +13}
    {1004792400 50400 1 +13}
    {1012046400 46800 0 +13}

Changes to library/tzdata/Pacific/Truk.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Chuuk)]} {
    LoadTimeZoneFile Pacific/Chuuk
if {![info exists TZData(Pacific/Port_Moresby)]} {
    LoadTimeZoneFile Pacific/Port_Moresby
}
set TZData(:Pacific/Truk) $TZData(:Pacific/Chuuk)
set TZData(:Pacific/Truk) $TZData(:Pacific/Port_Moresby)

Changes to library/tzdata/Pacific/Wake.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa

set TZData(:Pacific/Wake) {
}
set TZData(:Pacific/Wake) $TZData(:Pacific/Tarawa)
    {-9223372036854775808 39988 0 LMT}
    {-2177492788 43200 0 +12}
}

Changes to library/tzdata/Pacific/Wallis.

1


2
3


4
5
6
1
2
3


4
5




+
+
-
-
+
+
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Tarawa)]} {
    LoadTimeZoneFile Pacific/Tarawa

set TZData(:Pacific/Wallis) {
}
set TZData(:Pacific/Wallis) $TZData(:Pacific/Tarawa)
    {-9223372036854775808 44120 0 LMT}
    {-2177496920 43200 0 +12}
}

Changes to library/tzdata/Pacific/Yap.

1
2
3


4
5

1


2
3
4

5

-
-
+
+

-
+
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Chuuk)]} {
    LoadTimeZoneFile Pacific/Chuuk
if {![info exists TZData(Pacific/Port_Moresby)]} {
    LoadTimeZoneFile Pacific/Port_Moresby
}
set TZData(:Pacific/Yap) $TZData(:Pacific/Chuuk)
set TZData(:Pacific/Yap) $TZData(:Pacific/Port_Moresby)

Added library/tzdata/SystemV/AST4.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Puerto_Rico)]} {
    LoadTimeZoneFile America/Puerto_Rico
}
set TZData(:SystemV/AST4) $TZData(:America/Puerto_Rico)

Added library/tzdata/SystemV/AST4ADT.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Halifax)]} {
    LoadTimeZoneFile America/Halifax
}
set TZData(:SystemV/AST4ADT) $TZData(:America/Halifax)

Added library/tzdata/SystemV/CST6.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Regina)]} {
    LoadTimeZoneFile America/Regina
}
set TZData(:SystemV/CST6) $TZData(:America/Regina)

Added library/tzdata/SystemV/CST6CDT.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Chicago)]} {
    LoadTimeZoneFile America/Chicago
}
set TZData(:SystemV/CST6CDT) $TZData(:America/Chicago)

Added library/tzdata/SystemV/EST5.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Indianapolis)]} {
    LoadTimeZoneFile America/Indianapolis
}
set TZData(:SystemV/EST5) $TZData(:America/Indianapolis)

Added library/tzdata/SystemV/EST5EDT.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/New_York)]} {
    LoadTimeZoneFile America/New_York
}
set TZData(:SystemV/EST5EDT) $TZData(:America/New_York)

Added library/tzdata/SystemV/HST10.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Honolulu)]} {
    LoadTimeZoneFile Pacific/Honolulu
}
set TZData(:SystemV/HST10) $TZData(:Pacific/Honolulu)

Added library/tzdata/SystemV/MST7.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Phoenix)]} {
    LoadTimeZoneFile America/Phoenix
}
set TZData(:SystemV/MST7) $TZData(:America/Phoenix)

Added library/tzdata/SystemV/MST7MDT.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Denver)]} {
    LoadTimeZoneFile America/Denver
}
set TZData(:SystemV/MST7MDT) $TZData(:America/Denver)

Added library/tzdata/SystemV/PST8.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Pitcairn)]} {
    LoadTimeZoneFile Pacific/Pitcairn
}
set TZData(:SystemV/PST8) $TZData(:Pacific/Pitcairn)

Added library/tzdata/SystemV/PST8PDT.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Los_Angeles)]} {
    LoadTimeZoneFile America/Los_Angeles
}
set TZData(:SystemV/PST8PDT) $TZData(:America/Los_Angeles)

Added library/tzdata/SystemV/YST9.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(Pacific/Gambier)]} {
    LoadTimeZoneFile Pacific/Gambier
}
set TZData(:SystemV/YST9) $TZData(:Pacific/Gambier)

Added library/tzdata/SystemV/YST9YDT.






1
2
3
4
5
+
+
+
+
+
# created by ../tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Anchorage)]} {
    LoadTimeZoneFile America/Anchorage
}
set TZData(:SystemV/YST9YDT) $TZData(:America/Anchorage)

Deleted library/tzdata/US/Pacific-New.

1
2
3
4
5





-
-
-
-
-
# created by tools/tclZIC.tcl - do not edit
if {![info exists TZData(America/Los_Angeles)]} {
    LoadTimeZoneFile America/Los_Angeles
}
set TZData(:US/Pacific-New) $TZData(:America/Los_Angeles)

Changes to library/word.tcl.

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
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













-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# word.tcl --
#
# This file defines various procedures for computing word boundaries in
# strings. This file is primarily needed so Tk text and entry widgets behave
# properly for different platforms.
#
# Copyright (c) 1996 by Sun Microsystems, Inc.
# Copyright (c) 1998 by Scritpics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# The following variables are used to determine which characters are
# interpreted as word characters. See bug [f1253530cdd8]. Will
# probably be removed in Tcl 9.

if {![info exists ::tcl_wordchars]} {
    set ::tcl_wordchars {\w}
}
if {![info exists ::tcl_nonwordchars]} {
    set ::tcl_nonwordchars {\W}
# interpreted as white space.

if {$::tcl_platform(platform) eq "windows"} {
    # Windows style - any but a unicode space char
    if {![info exists ::tcl_wordchars]} {
	set ::tcl_wordchars {\S}
    }
    if {![info exists ::tcl_nonwordchars]} {
	set ::tcl_nonwordchars {\s}
    }
} else {
    # Motif style - any unicode word char (number, letter, or underscore)
    if {![info exists ::tcl_wordchars]} {
	set ::tcl_wordchars {\w}
    }
    if {![info exists ::tcl_nonwordchars]} {
	set ::tcl_nonwordchars {\W}
    }
}

# Arrange for caches of the real matcher REs to be kept, which enables the REs
# themselves to be cached for greater performance (and somewhat greater
# clarity too).

namespace eval ::tcl {
132
133
134
135
136
137
138
139
140
141


142
143
144
142
143
144
145
146
147
148



149
150

151
152







-
-
-
+
+
-


# Arguments:
# str -		String to search.
# start -	Index into string specifying starting point.

proc tcl_startOfPreviousWord {str start} {
    variable ::tcl::WordBreakRE
    set word {-1 -1}
    if {$start > 0} {
	regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
		result word
    regexp -indices -- $WordBreakRE(previous) [string range $str 0 $start-1] \
	    result word
    }
    return [lindex $word 0]
}

Changes to libtommath/LICENSE.

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


1

2





3







4









-
-
+
-

-
-
-
-
-
+
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
                          The LibTom license

LibTomMath is hereby released into the Public Domain.  
This is free and unencumbered software released into the public domain.

Anyone is free to copy, modify, publish, use, compile, sell, or
distribute this software, either in source code form or as a compiled
binary, for any purpose, commercial or non-commercial, and by any
means.

-- Tom St Denis
In jurisdictions that recognize copyright laws, the author or authors
of this software dedicate any and all copyright interest in the
software to the public domain. We make this dedication for the benefit
of the public at large and to the detriment of our heirs and
successors. We intend this dedication to be an overt act of
relinquishment in perpetuity of all present and future rights to this
software under copyright law.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE.

For more information, please refer to <http://unlicense.org/>

Deleted libtommath/README.md.

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












































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# libtommath

This is the git repository for [LibTomMath](http://www.libtom.net/LibTomMath/), a free open source portable number theoretic multiple-precision integer (MPI) library written entirely in C.

## Build Status

### Travis CI

master: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=master)](https://travis-ci.org/libtom/libtommath)

develop: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=develop)](https://travis-ci.org/libtom/libtommath)

### AppVeyor

master: [![Build status](https://ci.appveyor.com/api/projects/status/b80lpolw3i8m6hsh/branch/master?svg=true)](https://ci.appveyor.com/project/libtom/libtommath/branch/master)

develop: [![Build status](https://ci.appveyor.com/api/projects/status/b80lpolw3i8m6hsh/branch/develop?svg=true)](https://ci.appveyor.com/project/libtom/libtommath/branch/develop)

### ABI Laboratory

API/ABI changes: [check here](https://abi-laboratory.pro/tracker/timeline/libtommath/)

## Summary

The `develop` branch contains the in-development version. Stable releases are tagged.

Documentation is built from the LaTeX file `bn.tex`. There is also limited documentation in `tommath.h`.
There is also a document, `tommath.pdf`, which describes the goals of the project and many of the algorithms used.

The project can be build by using `make`. Along with the usual `make`, `make clean` and `make install`,
there are several other build targets, see the makefile for details.
There are also makefiles for certain specific platforms.

## Testing

Tests are located in `demo/` and can be built in two flavors.
* `make test` creates a stand-alone test binary that executes several test routines.
* `make mtest_opponent` creates a test binary that is intended to be run against `mtest`.
  `mtest` can be built with `make mtest` and test execution is done like `./mtest/mtest | ./mtest_opponent`.
  `mtest` is creating test vectors using an alternative MPI library and `test` is consuming these vectors to verify correct behavior of ltm

## Building and Installing

Building is straightforward for GNU Linux only, the section "Building LibTomMath" in the documentation in `doc/bn.pdf` has the details.

Deleted libtommath/appveyor.yml.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21





















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
version: 1.2.0-{build}
branches:
  only:
  - master
  - develop
  - /^release/
  - /^support/
  - /^travis/
image:
- Visual Studio 2019
- Visual Studio 2017
- Visual Studio 2015
build_script:
- cmd: >-
    if "Visual Studio 2019"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars64.bat"
        if "Visual Studio 2017"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat"
        if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x64
        if "Visual Studio 2015"=="%APPVEYOR_BUILD_WORKER_IMAGE%" call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64
        nmake -f makefile.msvc all
test_script:
- cmd: test.exe

Deleted libtommath/astylerc.

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






























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Artistic Style, see http://astyle.sourceforge.net/
# full documentation, see: http://astyle.sourceforge.net/astyle.html
#
# usage:
#       astyle --options=astylerc *.[ch]

# Do not create backup, annonying in the times of git
suffix=none

## Bracket Style Options
style=kr

## Tab Options
indent=spaces=3

## Bracket Modify Options

## Indentation Options
min-conditional-indent=0

## Padding Options
pad-header
unpad-paren
align-pointer=name

## Formatting Options
break-after-logical
max-code-length=120
convert-tabs
mode=c

Deleted libtommath/bn_cutoffs.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14














-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_CUTOFFS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef MP_FIXED_CUTOFFS
#include "tommath_cutoffs.h"
int KARATSUBA_MUL_CUTOFF = MP_DEFAULT_KARATSUBA_MUL_CUTOFF,
    KARATSUBA_SQR_CUTOFF = MP_DEFAULT_KARATSUBA_SQR_CUTOFF,
    TOOM_MUL_CUTOFF = MP_DEFAULT_TOOM_MUL_CUTOFF,
    TOOM_SQR_CUTOFF = MP_DEFAULT_TOOM_SQR_CUTOFF;
#endif

#endif

Deleted libtommath/bn_deprecated.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321

































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_DEPRECATED_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifdef BN_MP_GET_BIT_C
int mp_get_bit(const mp_int *a, int b)
{
   if (b < 0) {
      return MP_VAL;
   }
   return (s_mp_get_bit(a, (unsigned int)b) == MP_YES) ? MP_YES : MP_NO;
}
#endif
#ifdef BN_MP_JACOBI_C
mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c)
{
   if (a->sign == MP_NEG) {
      return MP_VAL;
   }
   if (mp_cmp_d(n, 0uL) != MP_GT) {
      return MP_VAL;
   }
   return mp_kronecker(a, n, c);
}
#endif
#ifdef BN_MP_PRIME_RANDOM_EX_C
mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat)
{
   return s_mp_prime_random_ex(a, t, size, flags, cb, dat);
}
#endif
#ifdef BN_MP_RAND_DIGIT_C
mp_err mp_rand_digit(mp_digit *r)
{
   mp_err err = s_mp_rand_source(r, sizeof(mp_digit));
   *r &= MP_MASK;
   return err;
}
#endif
#ifdef BN_FAST_MP_INVMOD_C
mp_err fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c)
{
   return s_mp_invmod_fast(a, b, c);
}
#endif
#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C
mp_err fast_mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho)
{
   return s_mp_montgomery_reduce_fast(x, n, rho);
}
#endif
#ifdef BN_FAST_S_MP_MUL_DIGS_C
mp_err fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
{
   return s_mp_mul_digs_fast(a, b, c, digs);
}
#endif
#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C
mp_err fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
{
   return s_mp_mul_high_digs_fast(a, b, c, digs);
}
#endif
#ifdef BN_FAST_S_MP_SQR_C
mp_err fast_s_mp_sqr(const mp_int *a, mp_int *b)
{
   return s_mp_sqr_fast(a, b);
}
#endif
#ifdef BN_MP_BALANCE_MUL_C
mp_err mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c)
{
   return s_mp_balance_mul(a, b, c);
}
#endif
#ifdef BN_MP_EXPTMOD_FAST_C
mp_err mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode)
{
   return s_mp_exptmod_fast(G, X, P, Y, redmode);
}
#endif
#ifdef BN_MP_INVMOD_SLOW_C
mp_err mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c)
{
   return s_mp_invmod_slow(a, b, c);
}
#endif
#ifdef BN_MP_KARATSUBA_MUL_C
mp_err mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c)
{
   return s_mp_karatsuba_mul(a, b, c);
}
#endif
#ifdef BN_MP_KARATSUBA_SQR_C
mp_err mp_karatsuba_sqr(const mp_int *a, mp_int *b)
{
   return s_mp_karatsuba_sqr(a, b);
}
#endif
#ifdef BN_MP_TOOM_MUL_C
mp_err mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c)
{
   return s_mp_toom_mul(a, b, c);
}
#endif
#ifdef BN_MP_TOOM_SQR_C
mp_err mp_toom_sqr(const mp_int *a, mp_int *b)
{
   return s_mp_toom_sqr(a, b);
}
#endif
#ifdef S_MP_REVERSE_C
void bn_reverse(unsigned char *s, int len)
{
   if (len > 0) {
      s_mp_reverse(s, (size_t)len);
   }
}
#endif
#ifdef BN_MP_TC_AND_C
mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)
{
   return mp_and(a, b, c);
}
#endif
#ifdef BN_MP_TC_OR_C
mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
{
   return mp_or(a, b, c);
}
#endif
#ifdef BN_MP_TC_XOR_C
mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
{
   return mp_xor(a, b, c);
}
#endif
#ifdef BN_MP_TC_DIV_2D_C
mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c)
{
   return mp_signed_rsh(a, b, c);
}
#endif
#ifdef BN_MP_INIT_SET_INT_C
mp_err mp_init_set_int(mp_int *a, unsigned long b)
{
   return mp_init_u32(a, (uint32_t)b);
}
#endif
#ifdef BN_MP_SET_INT_C
mp_err mp_set_int(mp_int *a, unsigned long b)
{
   mp_set_u32(a, (uint32_t)b);
   return MP_OKAY;
}
#endif
#ifdef BN_MP_SET_LONG_C
mp_err mp_set_long(mp_int *a, unsigned long b)
{
   mp_set_u64(a, b);
   return MP_OKAY;
}
#endif
#ifdef BN_MP_SET_LONG_LONG_C
mp_err mp_set_long_long(mp_int *a, unsigned long long b)
{
   mp_set_u64(a, b);
   return MP_OKAY;
}
#endif
#ifdef BN_MP_GET_INT_C
unsigned long mp_get_int(const mp_int *a)
{
   return (unsigned long)mp_get_mag_u32(a);
}
#endif
#ifdef BN_MP_GET_LONG_C
unsigned long mp_get_long(const mp_int *a)
{
   return (unsigned long)mp_get_mag_ul(a);
}
#endif
#ifdef BN_MP_GET_LONG_LONG_C
unsigned long long mp_get_long_long(const mp_int *a)
{
   return mp_get_mag_ull(a);
}
#endif
#ifdef BN_MP_PRIME_IS_DIVISIBLE_C
mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result)
{
   return s_mp_prime_is_divisible(a, result);
}
#endif
#ifdef BN_MP_EXPT_D_EX_C
mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
{
   (void)fast;
   if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) {
      return MP_VAL;
   }
   return mp_expt_u32(a, (uint32_t)b, c);
}
#endif
#ifdef BN_MP_EXPT_D_C
mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c)
{
   if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) {
      return MP_VAL;
   }
   return mp_expt_u32(a, (uint32_t)b, c);
}
#endif
#ifdef BN_MP_N_ROOT_EX_C
mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
{
   (void)fast;
   if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) {
      return MP_VAL;
   }
   return mp_root_u32(a, (uint32_t)b, c);
}
#endif
#ifdef BN_MP_N_ROOT_C
mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c)
{
   if (b > MP_MIN(MP_DIGIT_MAX, UINT32_MAX)) {
      return MP_VAL;
   }
   return mp_root_u32(a, (uint32_t)b, c);
}
#endif
#ifdef BN_MP_UNSIGNED_BIN_SIZE_C
int mp_unsigned_bin_size(const mp_int *a)
{
   return (int)mp_ubin_size(a);
}
#endif
#ifdef BN_MP_READ_UNSIGNED_BIN_C
mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c)
{
   return mp_from_ubin(a, b, (size_t) c);
}
#endif
#ifdef BN_MP_TO_UNSIGNED_BIN_C
mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b)
{
   return mp_to_ubin(a, b, SIZE_MAX, NULL);
}
#endif
#ifdef BN_MP_TO_UNSIGNED_BIN_N_C
mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen)
{
   size_t n = mp_ubin_size(a);
   if (*outlen < (unsigned long)n) {
      return MP_VAL;
   }
   *outlen = (unsigned long)n;
   return mp_to_ubin(a, b, n, NULL);
}
#endif
#ifdef BN_MP_SIGNED_BIN_SIZE_C
int mp_signed_bin_size(const mp_int *a)
{
   return (int)mp_sbin_size(a);
}
#endif
#ifdef BN_MP_READ_SIGNED_BIN_C
mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c)
{
   return mp_from_sbin(a, b, (size_t) c);
}
#endif
#ifdef BN_MP_TO_SIGNED_BIN_C
mp_err mp_to_signed_bin(const mp_int *a, unsigned char *b)
{
   return mp_to_sbin(a, b, SIZE_MAX, NULL);
}
#endif
#ifdef BN_MP_TO_SIGNED_BIN_N_C
mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen)
{
   size_t n = mp_sbin_size(a);
   if (*outlen < (unsigned long)n) {
      return MP_VAL;
   }
   *outlen = (unsigned long)n;
   return mp_to_sbin(a, b, n, NULL);
}
#endif
#ifdef BN_MP_TORADIX_N_C
mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen)
{
   if (maxlen < 0) {
      return MP_VAL;
   }
   return mp_to_radix(a, str, (size_t)maxlen, NULL, radix);
}
#endif
#ifdef BN_MP_TORADIX_C
mp_err mp_toradix(const mp_int *a, char *str, int radix)
{
   return mp_to_radix(a, str, SIZE_MAX, NULL, radix);
}
#endif
#ifdef BN_MP_IMPORT_C
mp_err mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails,
                 const void *op)
{
   return mp_unpack(rop, count, order, size, endian, nails, op);
}
#endif
#ifdef BN_MP_EXPORT_C
mp_err mp_export(void *rop, size_t *countp, int order, size_t size,
                 int endian, size_t nails, const mp_int *op)
{
   return mp_pack(rop, SIZE_MAX, countp, order, size, endian, nails, op);
}
#endif
#endif

Added libtommath/bn_error.c.












































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_ERROR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

static const struct {
     int code;
     char *msg;
} msgs[] = {
     { MP_OKAY, "Successful" },
     { MP_MEM,  "Out of heap" },
     { MP_VAL,  "Value out of range" }
};

/* return a char * string for a given code */
char *mp_error_to_string(int code)
{
   int x;

   /* scan the lookup table for the given message */
   for (x = 0; x < (int)(sizeof(msgs) / sizeof(msgs[0])); x++) {
       if (msgs[x].code == code) {
          return msgs[x].msg;
       }
   }

   /* generic reply for invalid code */
   return "Invalid error code";
}

#endif

Added libtommath/bn_fast_mp_invmod.c.

















































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_FAST_MP_INVMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes the modular inverse via binary extended euclidean algorithm, 
 * that is c = 1/a mod b 
 *
 * Based on slow invmod except this is optimized for the case where b is 
 * odd as per HAC Note 14.64 on pp. 610
 */
int fast_mp_invmod (mp_int * a, mp_int * b, mp_int * c)
{
  mp_int  x, y, u, v, B, D;
  int     res, neg;

  /* 2. [modified] b must be odd   */
  if (mp_iseven (b) == 1) {
    return MP_VAL;
  }

  /* init all our temps */
  if ((res = mp_init_multi(&x, &y, &u, &v, &B, &D, NULL)) != MP_OKAY) {
     return res;
  }

  /* x == modulus, y == value to invert */
  if ((res = mp_copy (b, &x)) != MP_OKAY) {
    goto LBL_ERR;
  }

  /* we need y = |a| */
  if ((res = mp_mod (a, b, &y)) != MP_OKAY) {
    goto LBL_ERR;
  }

  /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */
  if ((res = mp_copy (&x, &u)) != MP_OKAY) {
    goto LBL_ERR;
  }
  if ((res = mp_copy (&y, &v)) != MP_OKAY) {
    goto LBL_ERR;
  }
  mp_set (&D, 1);

top:
  /* 4.  while u is even do */
  while (mp_iseven (&u) == 1) {
    /* 4.1 u = u/2 */
    if ((res = mp_div_2 (&u, &u)) != MP_OKAY) {
      goto LBL_ERR;
    }
    /* 4.2 if B is odd then */
    if (mp_isodd (&B) == 1) {
      if ((res = mp_sub (&B, &x, &B)) != MP_OKAY) {
        goto LBL_ERR;
      }
    }
    /* B = B/2 */
    if ((res = mp_div_2 (&B, &B)) != MP_OKAY) {
      goto LBL_ERR;
    }
  }

  /* 5.  while v is even do */
  while (mp_iseven (&v) == 1) {
    /* 5.1 v = v/2 */
    if ((res = mp_div_2 (&v, &v)) != MP_OKAY) {
      goto LBL_ERR;
    }
    /* 5.2 if D is odd then */
    if (mp_isodd (&D) == 1) {
      /* D = (D-x)/2 */
      if ((res = mp_sub (&D, &x, &D)) != MP_OKAY) {
        goto LBL_ERR;
      }
    }
    /* D = D/2 */
    if ((res = mp_div_2 (&D, &D)) != MP_OKAY) {
      goto LBL_ERR;
    }
  }

  /* 6.  if u >= v then */
  if (mp_cmp (&u, &v) != MP_LT) {
    /* u = u - v, B = B - D */
    if ((res = mp_sub (&u, &v, &u)) != MP_OKAY) {
      goto LBL_ERR;
    }

    if ((res = mp_sub (&B, &D, &B)) != MP_OKAY) {
      goto LBL_ERR;
    }
  } else {
    /* v - v - u, D = D - B */
    if ((res = mp_sub (&v, &u, &v)) != MP_OKAY) {
      goto LBL_ERR;
    }

    if ((res = mp_sub (&D, &B, &D)) != MP_OKAY) {
      goto LBL_ERR;
    }
  }

  /* if not zero goto step 4 */
  if (mp_iszero (&u) == 0) {
    goto top;
  }

  /* now a = C, b = D, gcd == g*v */

  /* if v != 1 then there is no inverse */
  if (mp_cmp_d (&v, 1) != MP_EQ) {
    res = MP_VAL;
    goto LBL_ERR;
  }

  /* b is now the inverse */
  neg = a->sign;
  while (D.sign == MP_NEG) {
    if ((res = mp_add (&D, b, &D)) != MP_OKAY) {
      goto LBL_ERR;
    }
  }
  mp_exch (&D, c);
  c->sign = neg;
  res = MP_OKAY;

LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &B, &D, NULL);
  return res;
}
#endif

Added libtommath/bn_fast_mp_montgomery_reduce.c.









































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes xR**-1 == x (mod N) via Montgomery Reduction
 *
 * This is an optimized implementation of montgomery_reduce
 * which uses the comba method to quickly calculate the columns of the
 * reduction.
 *
 * Based on Algorithm 14.32 on pp.601 of HAC.
*/
int fast_mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
{
  int     ix, res, olduse;
  mp_word W[MP_WARRAY];

  /* get old used count */
  olduse = x->used;

  /* grow a as required */
  if (x->alloc < n->used + 1) {
    if ((res = mp_grow (x, n->used + 1)) != MP_OKAY) {
      return res;
    }
  }

  /* first we have to get the digits of the input into
   * an array of double precision words W[...]
   */
  {
    register mp_word *_W;
    register mp_digit *tmpx;

    /* alias for the W[] array */
    _W   = W;

    /* alias for the digits of  x*/
    tmpx = x->dp;

    /* copy the digits of a into W[0..a->used-1] */
    for (ix = 0; ix < x->used; ix++) {
      *_W++ = *tmpx++;
    }

    /* zero the high words of W[a->used..m->used*2] */
    for (; ix < n->used * 2 + 1; ix++) {
      *_W++ = 0;
    }
  }

  /* now we proceed to zero successive digits
   * from the least significant upwards
   */
  for (ix = 0; ix < n->used; ix++) {
    /* mu = ai * m' mod b
     *
     * We avoid a double precision multiplication (which isn't required)
     * by casting the value down to a mp_digit.  Note this requires
     * that W[ix-1] have  the carry cleared (see after the inner loop)
     */
    register mp_digit mu;
    mu = (mp_digit) (((W[ix] & MP_MASK) * rho) & MP_MASK);

    /* a = a + mu * m * b**i
     *
     * This is computed in place and on the fly.  The multiplication
     * by b**i is handled by offseting which columns the results
     * are added to.
     *
     * Note the comba method normally doesn't handle carries in the
     * inner loop In this case we fix the carry from the previous
     * column since the Montgomery reduction requires digits of the
     * result (so far) [see above] to work.  This is
     * handled by fixing up one carry after the inner loop.  The
     * carry fixups are done in order so after these loops the
     * first m->used words of W[] have the carries fixed
     */
    {
      register int iy;
      register mp_digit *tmpn;
      register mp_word *_W;

      /* alias for the digits of the modulus */
      tmpn = n->dp;

      /* Alias for the columns set by an offset of ix */
      _W = W + ix;

      /* inner loop */
      for (iy = 0; iy < n->used; iy++) {
          *_W++ += ((mp_word)mu) * ((mp_word)*tmpn++);
      }
    }

    /* now fix carry for next digit, W[ix+1] */
    W[ix + 1] += W[ix] >> ((mp_word) DIGIT_BIT);
  }

  /* now we have to propagate the carries and
   * shift the words downward [all those least
   * significant digits we zeroed].
   */
  {
    register mp_digit *tmpx;
    register mp_word *_W, *_W1;

    /* nox fix rest of carries */

    /* alias for current word */
    _W1 = W + ix;

    /* alias for next word, where the carry goes */
    _W = W + ++ix;

    for (; ix <= n->used * 2 + 1; ix++) {
      *_W++ += *_W1++ >> ((mp_word) DIGIT_BIT);
    }

    /* copy out, A = A/b**n
     *
     * The result is A/b**n but instead of converting from an
     * array of mp_word to mp_digit than calling mp_rshd
     * we just copy them in the right order
     */

    /* alias for destination word */
    tmpx = x->dp;

    /* alias for shifted double precision result */
    _W = W + n->used;

    for (ix = 0; ix < n->used + 1; ix++) {
      *tmpx++ = (mp_digit)(*_W++ & ((mp_word) MP_MASK));
    }

    /* zero oldused digits, if the input a was larger than
     * m->used+1 we'll have to clear the digits
     */
    for (; ix < olduse; ix++) {
      *tmpx++ = 0;
    }
  }

  /* set the max used and clamp */
  x->used = n->used + 1;
  mp_clamp (x);

  /* if A >= m then A = A - m */
  if (mp_cmp_mag (x, n) != MP_LT) {
    return s_mp_sub (x, n, x);
  }
  return MP_OKAY;
}
#endif

Added libtommath/bn_fast_s_mp_mul_digs.c.








































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_FAST_S_MP_MUL_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* Fast (comba) multiplier
 *
 * This is the fast column-array [comba] multiplier.  It is 
 * designed to compute the columns of the product first 
 * then handle the carries afterwards.  This has the effect 
 * of making the nested loops that compute the columns very
 * simple and schedulable on super-scalar processors.
 *
 * This has been modified to produce a variable number of 
 * digits of output so if say only a half-product is required 
 * you don't have to compute the upper half (a feature 
 * required for fast Barrett reduction).
 *
 * Based on Algorithm 14.12 on pp.595 of HAC.
 *
 */
int fast_s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
{
  int     olduse, res, pa, ix, iz;
  mp_digit W[MP_WARRAY];
  register mp_word  _W;

  /* grow the destination as required */
  if (c->alloc < digs) {
    if ((res = mp_grow (c, digs)) != MP_OKAY) {
      return res;
    }
  }

  /* number of output digits to produce */
  pa = MIN(digs, a->used + b->used);

  /* clear the carry */
  _W = 0;
  for (ix = 0; ix < pa; ix++) { 
      int      tx, ty;
      int      iy;
      mp_digit *tmpx, *tmpy;

      /* get offsets into the two bignums */
      ty = MIN(b->used-1, ix);
      tx = ix - ty;

      /* setup temp aliases */
      tmpx = a->dp + tx;
      tmpy = b->dp + ty;

      /* this is the number of times the loop will iterrate, essentially 
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MIN(a->used-tx, ty+1);

      /* execute loop */
      for (iz = 0; iz < iy; ++iz) {
         _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);

      }

      /* store term */
      W[ix] = ((mp_digit)_W) & MP_MASK;

      /* make next carry */
      _W = _W >> ((mp_word)DIGIT_BIT);
 }

  /* setup dest */
  olduse  = c->used;
  c->used = pa;

  {
    register mp_digit *tmpc;
    tmpc = c->dp;
    for (ix = 0; ix < pa; ix++) {
      /* now extract the previous digit [below the carry] */
      *tmpc++ = W[ix];
    }

    /* clear unused digits [that existed in the old copy of c] */
    for (; ix < olduse; ix++) {
      *tmpc++ = 0;
    }
  }
  mp_clamp (c);
  return MP_OKAY;
}
#endif

Added libtommath/bn_fast_s_mp_mul_high_digs.c.































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* this is a modified version of fast_s_mul_digs that only produces
 * output digits *above* digs.  See the comments for fast_s_mul_digs
 * to see how it works.
 *
 * This is used in the Barrett reduction since for one of the multiplications
 * only the higher digits were needed.  This essentially halves the work.
 *
 * Based on Algorithm 14.12 on pp.595 of HAC.
 */
int fast_s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
{
  int     olduse, res, pa, ix, iz;
  mp_digit W[MP_WARRAY];
  mp_word  _W;

  /* grow the destination as required */
  pa = a->used + b->used;
  if (c->alloc < pa) {
    if ((res = mp_grow (c, pa)) != MP_OKAY) {
      return res;
    }
  }

  /* number of output digits to produce */
  pa = a->used + b->used;
  _W = 0;
  for (ix = digs; ix < pa; ix++) { 
      int      tx, ty, iy;
      mp_digit *tmpx, *tmpy;

      /* get offsets into the two bignums */
      ty = MIN(b->used-1, ix);
      tx = ix - ty;

      /* setup temp aliases */
      tmpx = a->dp + tx;
      tmpy = b->dp + ty;

      /* this is the number of times the loop will iterrate, essentially its 
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MIN(a->used-tx, ty+1);

      /* execute loop */
      for (iz = 0; iz < iy; iz++) {
         _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
      }

      /* store term */
      W[ix] = ((mp_digit)_W) & MP_MASK;

      /* make next carry */
      _W = _W >> ((mp_word)DIGIT_BIT);
  }
  
  /* setup dest */
  olduse  = c->used;
  c->used = pa;

  {
    register mp_digit *tmpc;

    tmpc = c->dp + digs;
    for (ix = digs; ix < pa; ix++) {
      /* now extract the previous digit [below the carry] */
      *tmpc++ = W[ix];
    }

    /* clear unused digits [that existed in the old copy of c] */
    for (; ix < olduse; ix++) {
      *tmpc++ = 0;
    }
  }
  mp_clamp (c);
  return MP_OKAY;
}
#endif

Added libtommath/bn_fast_s_mp_sqr.c.















































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_FAST_S_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* the jist of squaring...
 * you do like mult except the offset of the tmpx [one that 
 * starts closer to zero] can't equal the offset of tmpy.  
 * So basically you set up iy like before then you min it with
 * (ty-tx) so that it never happens.  You double all those 
 * you add in the inner loop

After that loop you do the squares and add them in.
*/

int fast_s_mp_sqr (mp_int * a, mp_int * b)
{
  int       olduse, res, pa, ix, iz;
  mp_digit   W[MP_WARRAY], *tmpx;
  mp_word   W1;

  /* grow the destination as required */
  pa = a->used + a->used;
  if (b->alloc < pa) {
    if ((res = mp_grow (b, pa)) != MP_OKAY) {
      return res;
    }
  }

  /* number of output digits to produce */
  W1 = 0;
  for (ix = 0; ix < pa; ix++) { 
      int      tx, ty, iy;
      mp_word  _W;
      mp_digit *tmpy;

      /* clear counter */
      _W = 0;

      /* get offsets into the two bignums */
      ty = MIN(a->used-1, ix);
      tx = ix - ty;

      /* setup temp aliases */
      tmpx = a->dp + tx;
      tmpy = a->dp + ty;

      /* this is the number of times the loop will iterrate, essentially
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MIN(a->used-tx, ty+1);

      /* now for squaring tx can never equal ty 
       * we halve the distance since they approach at a rate of 2x
       * and we have to round because odd cases need to be executed
       */
      iy = MIN(iy, (ty-tx+1)>>1);

      /* execute loop */
      for (iz = 0; iz < iy; iz++) {
         _W += ((mp_word)*tmpx++)*((mp_word)*tmpy--);
      }

      /* double the inner product and add carry */
      _W = _W + _W + W1;

      /* even columns have the square term in them */
      if ((ix&1) == 0) {
         _W += ((mp_word)a->dp[ix>>1])*((mp_word)a->dp[ix>>1]);
      }

      /* store it */
      W[ix] = (mp_digit)(_W & MP_MASK);

      /* make next carry */
      W1 = _W >> ((mp_word)DIGIT_BIT);
  }

  /* setup dest */
  olduse  = b->used;
  b->used = a->used+a->used;

  {
    mp_digit *tmpb;
    tmpb = b->dp;
    for (ix = 0; ix < pa; ix++) {
      *tmpb++ = W[ix] & MP_MASK;
    }

    /* clear unused digits [that existed in the old copy of c] */
    for (; ix < olduse; ix++) {
      *tmpb++ = 0;
    }
  }
  mp_clamp (b);
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_2expt.c.

1

2
3

4
5
6















7
8
9
10

11

12
13

14
15
16


17
18
19
20
21




22
23
24


25
26
27


28
29

30
31

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
-
+

-
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_2EXPT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* computes a = 2**b
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes a = 2**b 
 *
 * Simple algorithm which zeroes the int, grows it then just sets one bit
 * as required.
 */
int
mp_err mp_2expt(mp_int *a, int b)
mp_2expt (mp_int * a, int b)
{
   mp_err    err;
  int     res;

   /* zero a as per default */
   mp_zero(a);
  /* zero a as per default */
  mp_zero (a);

   /* grow a to accomodate the single bit */
   if ((err = mp_grow(a, (b / MP_DIGIT_BIT) + 1)) != MP_OKAY) {
      return err;
   }
  /* grow a to accomodate the single bit */
  if ((res = mp_grow (a, b / DIGIT_BIT + 1)) != MP_OKAY) {
    return res;
  }

   /* set the used count of where the bit will go */
   a->used = (b / MP_DIGIT_BIT) + 1;
  /* set the used count of where the bit will go */
  a->used = b / DIGIT_BIT + 1;

   /* put the single bit in its place */
   a->dp[b / MP_DIGIT_BIT] = (mp_digit)1 << (mp_digit)(b % MP_DIGIT_BIT);
  /* put the single bit in its place */
  a->dp[b / DIGIT_BIT] = ((mp_digit)1) << (b % DIGIT_BIT);

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_abs.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

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+
-
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_ABS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* b = |a|
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* b = |a| 
 *
 * Simple function copies the input and fixes the sign to positive
 */
int
mp_err mp_abs(const mp_int *a, mp_int *b)
mp_abs (mp_int * a, mp_int * b)
{
   mp_err     err;
  int     res;

   /* copy a to b */
   if (a != b) {
      if ((err = mp_copy(a, b)) != MP_OKAY) {
         return err;
      }
   }
  /* copy a to b */
  if (a != b) {
     if ((res = mp_copy (a, b)) != MP_OKAY) {
       return res;
     }
  }

   /* force the sign of b to positive */
   b->sign = MP_ZPOS;
  /* force the sign of b to positive */
  b->sign = MP_ZPOS;

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_add.c.

1

2
3

4













5
6
7

8
9

10
11
12
13
14



15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35




















36
37
38

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+
-

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_ADD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* high level addition (handles signs) */
mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c)
int mp_add (mp_int * a, mp_int * b, mp_int * c)
{
   mp_sign sa, sb;
  int     sa, sb, res;
   mp_err err;

   /* get sign of both inputs */
   sa = a->sign;
   sb = b->sign;
  /* get sign of both inputs */
  sa = a->sign;
  sb = b->sign;

   /* handle two cases, not four */
   if (sa == sb) {
      /* both positive or both negative */
      /* add their magnitudes, copy the sign */
      c->sign = sa;
      err = s_mp_add(a, b, c);
   } else {
      /* one positive, the other negative */
      /* subtract the one with the greater magnitude from */
      /* the one of the lesser magnitude.  The result gets */
      /* the sign of the one with the greater magnitude. */
      if (mp_cmp_mag(a, b) == MP_LT) {
         c->sign = sb;
         err = s_mp_sub(b, a, c);
      } else {
         c->sign = sa;
         err = s_mp_sub(a, b, c);
      }
   }
   return err;
  /* handle two cases, not four */
  if (sa == sb) {
    /* both positive or both negative */
    /* add their magnitudes, copy the sign */
    c->sign = sa;
    res = s_mp_add (a, b, c);
  } else {
    /* one positive, the other negative */
    /* subtract the one with the greater magnitude from */
    /* the one of the lesser magnitude.  The result gets */
    /* the sign of the one with the greater magnitude. */
    if (mp_cmp_mag (a, b) == MP_LT) {
      c->sign = sb;
      res = s_mp_sub (b, a, c);
    } else {
      c->sign = sa;
      res = s_mp_sub (a, b, c);
    }
  }
  return res;
}

#endif

Changes to libtommath/bn_mp_add_d.c.

1

2
3

4













5
6

7

8
9
10
11


12
13
14
15
16
17
18






19
20
21


22
23
24


25
26
27


28
29
30


31
32
33


34
35
36


37
38
39





40
41
42


43
44
45


46
47
48
49
50
51
52
53
54
55
56
57
58


















59
60
61
62
63
64





65
66
67
68
69
70
71






72
73
74
75
76
77





78
79
80
81




82
83
84

85
86

87
88
89





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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+
-
-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
+
-
-
-
+

-
+



+
+
+
+
#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_ADD_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://libtom.org
 */

/* single digit addition */
int
mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c)
mp_add_d (mp_int * a, mp_digit b, mp_int * c)
{
   mp_err     err;
   int ix, oldused;
   mp_digit *tmpa, *tmpc;
  int     res, ix, oldused;
  mp_digit *tmpa, *tmpc, mu;

   /* grow c as required */
   if (c->alloc < (a->used + 1)) {
      if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) {
         return err;
      }
   }
  /* grow c as required */
  if (c->alloc < a->used + 1) {
     if ((res = mp_grow(c, a->used + 1)) != MP_OKAY) {
        return res;
     }
  }

   /* if a is negative and |a| >= b, call c = |a| - b */
   if ((a->sign == MP_NEG) && ((a->used > 1) || (a->dp[0] >= b))) {
  /* if a is negative and |a| >= b, call c = |a| - b */
  if (a->sign == MP_NEG && (a->used > 1 || a->dp[0] >= b)) {
      mp_int a_ = *a;
      /* temporarily fix sign of a */
      a_.sign = MP_ZPOS;
     /* temporarily fix sign of a */
     a->sign = MP_ZPOS;

      /* c = |a| - b */
      err = mp_sub_d(&a_, b, c);
     /* c = |a| - b */
     res = mp_sub_d(a, b, c);

      /* fix sign  */
      c->sign = MP_NEG;
     /* fix sign  */
     a->sign = c->sign = MP_NEG;

      /* clamp */
      mp_clamp(c);
     /* clamp */
     mp_clamp(c);

      return err;
   }
     return res;
  }

   /* old number of used digits in c */
   oldused = c->used;
  /* old number of used digits in c */
  oldused = c->used;

  /* sign always positive */
  c->sign = MP_ZPOS;

   /* source alias */
   tmpa    = a->dp;
  /* source alias */
  tmpa    = a->dp;

   /* destination alias */
   tmpc    = c->dp;
  /* destination alias */
  tmpc    = c->dp;

   /* if a is positive */
   if (a->sign == MP_ZPOS) {
      /* add digits, mu is carry */
      mp_digit mu = b;
      for (ix = 0; ix < a->used; ix++) {
         *tmpc   = *tmpa++ + mu;
         mu      = *tmpc >> MP_DIGIT_BIT;
         *tmpc++ &= MP_MASK;
      }
      /* set final carry */
      ix++;
      *tmpc++  = mu;
  /* if a is positive */
  if (a->sign == MP_ZPOS) {
     /* add digit, after this we're propagating
      * the carry.
      */
     *tmpc   = *tmpa++ + b;
     mu      = *tmpc >> DIGIT_BIT;
     *tmpc++ &= MP_MASK;

     /* now handle rest of the digits */
     for (ix = 1; ix < a->used; ix++) {
        *tmpc   = *tmpa++ + mu;
        mu      = *tmpc >> DIGIT_BIT;
        *tmpc++ &= MP_MASK;
     }
     /* set final carry */
     ix++;
     *tmpc++  = mu;

      /* setup size */
      c->used = a->used + 1;
   } else {
      /* a was negative and |a| < b */
      c->used  = 1;
     /* setup size */
     c->used = a->used + 1;
  } else {
     /* a was negative and |a| < b */
     c->used  = 1;

      /* the result is a single digit */
      if (a->used == 1) {
         *tmpc++  =  b - a->dp[0];
      } else {
         *tmpc++  =  b;
      }
     /* the result is a single digit */
     if (a->used == 1) {
        *tmpc++  =  b - a->dp[0];
     } else {
        *tmpc++  =  b;
     }

      /* setup count so the clearing of oldused
       * can fall through correctly
       */
      ix       = 1;
   }
     /* setup count so the clearing of oldused
      * can fall through correctly
      */
     ix       = 1;
  }

   /* sign always positive */
   c->sign = MP_ZPOS;

  /* now zero to oldused */
  while (ix++ < oldused) {
     *tmpc++ = 0;
  }
   /* now zero to oldused */
   MP_ZERO_DIGITS(tmpc, oldused - ix);
   mp_clamp(c);
  mp_clamp(c);

   return MP_OKAY;
  return MP_OKAY;
}

#endif

/* $Source$ */
/* $Revision: 0.41 $ */
/* $Date: 2007-04-18 09:58:18 +0000 $ */

Changes to libtommath/bn_mp_addmod.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

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+

-
-
+
+

-
-
-
+
+
+

-
+
-
-
-
+
+
+
+
-
-
-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_ADDMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* d = a + b (mod c) */
int
mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d)
mp_addmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
{
   mp_err  err;
   mp_int  t;
  int     res;
  mp_int  t;

   if ((err = mp_init(&t)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (&t)) != MP_OKAY) {
    return res;
  }

   if ((err = mp_add(a, b, &t)) != MP_OKAY) {
  if ((res = mp_add (a, b, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
   err = mp_mod(&t, c, d);
    mp_clear (&t);
    return res;
  }
  res = mp_mod (&t, c, d);

LBL_ERR:
   mp_clear(&t);
   return err;
  mp_clear (&t);
  return res;
}
#endif

Changes to libtommath/bn_mp_and.c.

1

2
3
4
5
6
7
8
9

10
11
12
13
14
15
16

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
-
+







-
+







#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_AND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* two complement and */
mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c)
{
   int used = MP_MAX(a->used, b->used) + 1, i;
   int used = MAX(a->used, b->used) + 1, i;
   mp_err err;
   mp_digit ac = 1, bc = 1, cc = 1;
   mp_sign csign = ((a->sign == MP_NEG) && (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS;

   if (c->alloc < used) {
      if ((err = mp_grow(c, used)) != MP_OKAY) {
         return err;

Changes to libtommath/bn_mp_clamp.c.

1

2
3

4
5
6















7
8
9
10
11
12

13

14
15
16
17
18
19
20






21
22
23
24
25




26
27

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






+
-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_CLAMP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* trim unused digits
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* trim unused digits 
 *
 * This is used to ensure that leading zero digits are
 * trimed and the leading "used" digit will be non-zero
 * Typically very fast.  Also fixes the sign if there
 * are no more leading digits
 */
void
void mp_clamp(mp_int *a)
mp_clamp (mp_int * a)
{
   /* decrease used while the most significant digit is
    * zero.
    */
   while ((a->used > 0) && (a->dp[a->used - 1] == 0u)) {
      --(a->used);
   }
  /* decrease used while the most significant digit is
   * zero.
   */
  while (a->used > 0 && a->dp[a->used - 1] == 0) {
    --(a->used);
  }

   /* reset the sign flag if used == 0 */
   if (a->used == 0) {
      a->sign = MP_ZPOS;
   }
  /* reset the sign flag if used == 0 */
  if (a->used == 0) {
    a->sign = MP_ZPOS;
  }
}
#endif

Changes to libtommath/bn_mp_clear.c.

1

2
3

4
5














6

7

8


9
10
11
12









13
14
15
16
17
18





19
20

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+

+
+
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_CLEAR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* clear one (frees)  */
void
void mp_clear(mp_int *a)
mp_clear (mp_int * a)
{
  int i;

   /* only do anything if a hasn't been freed previously */
   if (a->dp != NULL) {
      /* free ram */
      MP_FREE_DIGITS(a->dp, a->alloc);
  /* only do anything if a hasn't been freed previously */
  if (a->dp != NULL) {
    /* first zero the digits */
    for (i = 0; i < a->used; i++) {
        a->dp[i] = 0;
    }

    /* free ram */
    XFREE(a->dp);

      /* reset members to make debugging easier */
      a->dp    = NULL;
      a->alloc = a->used = 0;
      a->sign  = MP_ZPOS;
   }
    /* reset members to make debugging easier */
    a->dp    = NULL;
    a->alloc = a->used = 0;
    a->sign  = MP_ZPOS;
  }
}
#endif

Changes to libtommath/bn_mp_clear_multi.c.

1

2
3

4
5













6
7
8

9
10
11
12
13
14
15
16
17








18
19

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_CLEAR_MULTI_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */
#include <stdarg.h>

void mp_clear_multi(mp_int *mp, ...)
void mp_clear_multi(mp_int *mp, ...) 
{
   mp_int *next_mp = mp;
   va_list args;
   va_start(args, mp);
   while (next_mp != NULL) {
      mp_clear(next_mp);
      next_mp = va_arg(args, mp_int *);
   }
   va_end(args);
    mp_int* next_mp = mp;
    va_list args;
    va_start(args, mp);
    while (next_mp != NULL) {
        mp_clear(next_mp);
        next_mp = va_arg(args, mp_int*);
    }
    va_end(args);
}
#endif

Changes to libtommath/bn_mp_cmp.c.

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_CMP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* compare two ints (signed)*/
mp_ord mp_cmp(const mp_int *a, const mp_int *b)
{

Changes to libtommath/bn_mp_cmp_d.c.

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_CMP_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* compare a digit */
mp_ord mp_cmp_d(const mp_int *a, mp_digit b)
{

Changes to libtommath/bn_mp_cmp_mag.c.

1

2
3
4
5
6
7
8

1
2
3
4
5
6
7
8
-
+







#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_CMP_MAG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* compare maginitude of two ints (unsigned) */
mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b)
{

Changes to libtommath/bn_mp_cnt_lsb.c.

1

2
3

4
5
6















7
8
9
10
11

12
13
14
15
16
17

18
19
20
21
22

23
24

25
26
27

28
29

30
31
32

33
34
35
36
37

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+





-
+




-
+

-
+


-
+

-
+


-
+





#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_CNT_LSB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

static const int lnz[16] = {
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

static const int lnz[16] = { 
   4, 0, 1, 0, 2, 0, 1, 0, 3, 0, 1, 0, 2, 0, 1, 0
};

/* Counts the number of lsbs which are zero before the first zero bit */
int mp_cnt_lsb(const mp_int *a)
int mp_cnt_lsb(mp_int *a)
{
   int x;
   mp_digit q, qq;

   /* easy out */
   if (MP_IS_ZERO(a)) {
   if (mp_iszero(a) == 1) {
      return 0;
   }

   /* scan lower digits until non-zero */
   for (x = 0; (x < a->used) && (a->dp[x] == 0u); x++) {}
   for (x = 0; x < a->used && a->dp[x] == 0; x++);
   q = a->dp[x];
   x *= MP_DIGIT_BIT;
   x *= DIGIT_BIT;

   /* now scan this digit until a 1 is found */
   if ((q & 1u) == 0u) {
   if ((q & 1) == 0) {
      do {
         qq  = q & 15u;
         qq  = q & 15;
         x  += lnz[qq];
         q >>= 4;
      } while (qq == 0u);
      } while (qq == 0);
   }
   return x;
}

#endif

Deleted libtommath/bn_mp_complement.c.

1
2
3
4
5
6
7
8
9
10
11
12












-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_COMPLEMENT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* b = ~a */
mp_err mp_complement(const mp_int *a, mp_int *b)
{
   mp_err err = mp_neg(a, b);
   return (err == MP_OKAY) ? mp_sub_d(b, 1uL, b) : err;
}
#endif

Changes to libtommath/bn_mp_copy.c.

1

2
3

4













5
6

7

8
9

10
11
12
13
14
15
16




17
18
19
20
21
22
23






24
25
26





27
28
29


30
31
32


33
34
35


36
37

38
39
40
41
42
43
44
45










46
47

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
+
-
-

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_COPY_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* copy, b = a */
int
mp_err mp_copy(const mp_int *a, mp_int *b)
mp_copy (mp_int * a, mp_int * b)
{
   int n;
  int     res, n;
   mp_digit *tmpa, *tmpb;
   mp_err err;

   /* if dst == src do nothing */
   if (a == b) {
      return MP_OKAY;
   }
  /* if dst == src do nothing */
  if (a == b) {
    return MP_OKAY;
  }

   /* grow dest */
   if (b->alloc < a->used) {
      if ((err = mp_grow(b, a->used)) != MP_OKAY) {
         return err;
      }
   }
  /* grow dest */
  if (b->alloc < a->used) {
     if ((res = mp_grow (b, a->used)) != MP_OKAY) {
        return res;
     }
  }

   /* zero b and copy the parameters over */
   /* pointer aliases */
  /* zero b and copy the parameters over */
  {
    register mp_digit *tmpa, *tmpb;

    /* pointer aliases */

   /* source */
   tmpa = a->dp;
    /* source */
    tmpa = a->dp;

   /* destination */
   tmpb = b->dp;
    /* destination */
    tmpb = b->dp;

   /* copy all the digits */
   for (n = 0; n < a->used; n++) {
    /* copy all the digits */
    for (n = 0; n < a->used; n++) {
      *tmpb++ = *tmpa++;
   }
    }

   /* clear high digits */
   MP_ZERO_DIGITS(tmpb, b->used - n);

   /* copy used count and sign */
   b->used = a->used;
   b->sign = a->sign;
   return MP_OKAY;
    /* clear high digits */
    for (; n < b->used; n++) {
      *tmpb++ = 0;
    }
  }

  /* copy used count and sign */
  b->used = a->used;
  b->sign = a->sign;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_count_bits.c.

1

2
3

4
5














6

7

8
9
10


11
12
13
14
15




16
17
18
19
20
21
22
23
24
25
26










27
28

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_COUNT_BITS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* returns the number of bits in an int */
int
int mp_count_bits(const mp_int *a)
mp_count_bits (mp_int * a)
{
   int     r;
   mp_digit q;
  int     r;
  mp_digit q;

   /* shortcut */
   if (MP_IS_ZERO(a)) {
      return 0;
   }
  /* shortcut */
  if (a->used == 0) {
    return 0;
  }

   /* get number of digits and add that */
   r = (a->used - 1) * MP_DIGIT_BIT;

   /* take the last digit and count the bits in it */
   q = a->dp[a->used - 1];
   while (q > 0u) {
      ++r;
      q >>= 1u;
   }
   return r;
  /* get number of digits and add that */
  r = (a->used - 1) * DIGIT_BIT;
  
  /* take the last digit and count the bits in it */
  q = a->dp[a->used - 1];
  while (q > ((mp_digit) 0)) {
    ++r;
    q >>= ((mp_digit) 1);
  }
  return r;
}
#endif

Deleted libtommath/bn_mp_decr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34


































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_DECR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Decrement "a" by one like "a--". Changes input! */
mp_err mp_decr(mp_int *a)
{
   if (MP_IS_ZERO(a)) {
      mp_set(a,1uL);
      a->sign = MP_NEG;
      return MP_OKAY;
   } else if (a->sign == MP_NEG) {
      mp_err err;
      a->sign = MP_ZPOS;
      if ((err = mp_incr(a)) != MP_OKAY) {
         return err;
      }
      /* There is no -0 in LTM */
      if (!MP_IS_ZERO(a)) {
         a->sign = MP_NEG;
      }
      return MP_OKAY;
   } else if (a->dp[0] > 1uL) {
      a->dp[0]--;
      if (a->dp[0] == 0u) {
         mp_zero(a);
      }
      return MP_OKAY;
   } else {
      return mp_sub_d(a, 1uL,a);
   }
}
#endif

Changes to libtommath/bn_mp_div.c.

1

2
3

4













5
6
7
8
9

10
11
12

13
14
15
16
17
18




19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

















37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

































66
67
68

69
70
71
72
73

74
75
76
77
78
79
80




81
82
83

84
85
86

87
88
89


90
91
92
93
94
95
96




97
98
99
100
101
102
103
104












105
106
107
108
109





110
111
112
113



114
115
116
117



118
119
120
121
122







123
124
125
126



127
128
129
130
131
132
133
134
135
136













137
138
139
140



141
142
143
144
145
146
147
148
149
150
151
152














153
154
155
156
157
158





159
160
161
162
163
164
165
166
167
168
169
170











171
172
173


174
175
176
177
178
179
180
181
182








183
184
185
186
187
188
189
190
191
192
193
194
195
196















197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213




























214
215
216
217
218
219
220






221
222
223
224
225
226





227
228
229
230
231




232
233

234
235

236
237

238
239

240
241

242
243

244
245

246
247
248
249
250

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+


-
+
-

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+




-
+



-
-
-
-
+
+
+
+


-
+


-
+

-
-
+
+
-
-

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
-

-
-
+
+
+
-

-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
+

-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
+





#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DIV_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

#ifdef BN_MP_DIV_SMALL

/* slower bit-bang division... also smaller */
mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d)
int mp_div(mp_int * a, mp_int * b, mp_int * c, mp_int * d)
{
   mp_int ta, tb, tq, q;
   int     n, n2;
   int    res, n, n2;
   mp_err err;

   /* is divisor zero ? */
   if (MP_IS_ZERO(b)) {
      return MP_VAL;
   }
  /* is divisor zero ? */
  if (mp_iszero (b) == 1) {
    return MP_VAL;
  }

   /* if a < b then q=0, r = a */
   if (mp_cmp_mag(a, b) == MP_LT) {
      if (d != NULL) {
         err = mp_copy(a, d);
      } else {
         err = MP_OKAY;
      }
      if (c != NULL) {
         mp_zero(c);
      }
      return err;
   }

   /* init our temps */
   if ((err = mp_init_multi(&ta, &tb, &tq, &q, NULL)) != MP_OKAY) {
      return err;
   }
  /* if a < b then q=0, r = a */
  if (mp_cmp_mag (a, b) == MP_LT) {
    if (d != NULL) {
      res = mp_copy (a, d);
    } else {
      res = MP_OKAY;
    }
    if (c != NULL) {
      mp_zero (c);
    }
    return res;
  }
	
  /* init our temps */
  if ((res = mp_init_multi(&ta, &tb, &tq, &q, NULL) != MP_OKAY)) {
     return res;
  }


   mp_set(&tq, 1uL);
   n = mp_count_bits(a) - mp_count_bits(b);
   if ((err = mp_abs(a, &ta)) != MP_OKAY)                         goto LBL_ERR;
   if ((err = mp_abs(b, &tb)) != MP_OKAY)                         goto LBL_ERR;
   if ((err = mp_mul_2d(&tb, n, &tb)) != MP_OKAY)                 goto LBL_ERR;
   if ((err = mp_mul_2d(&tq, n, &tq)) != MP_OKAY)                 goto LBL_ERR;

   while (n-- >= 0) {
      if (mp_cmp(&tb, &ta) != MP_GT) {
         if ((err = mp_sub(&ta, &tb, &ta)) != MP_OKAY)            goto LBL_ERR;
         if ((err = mp_add(&q, &tq, &q)) != MP_OKAY)              goto LBL_ERR;
      }
      if ((err = mp_div_2d(&tb, 1, &tb, NULL)) != MP_OKAY)        goto LBL_ERR;
      if ((err = mp_div_2d(&tq, 1, &tq, NULL)) != MP_OKAY)        goto LBL_ERR;
   }

   /* now q == quotient and ta == remainder */
   n  = a->sign;
   n2 = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
   if (c != NULL) {
      mp_exch(c, &q);
      c->sign  = MP_IS_ZERO(c) ? MP_ZPOS : n2;
   }
   if (d != NULL) {
      mp_exch(d, &ta);
      d->sign = MP_IS_ZERO(d) ? MP_ZPOS : n;
   }
  mp_set(&tq, 1);
  n = mp_count_bits(a) - mp_count_bits(b);
  if (((res = mp_abs(a, &ta)) != MP_OKAY) ||
      ((res = mp_abs(b, &tb)) != MP_OKAY) || 
      ((res = mp_mul_2d(&tb, n, &tb)) != MP_OKAY) ||
      ((res = mp_mul_2d(&tq, n, &tq)) != MP_OKAY)) {
      goto LBL_ERR;
  }

  while (n-- >= 0) {
     if (mp_cmp(&tb, &ta) != MP_GT) {
        if (((res = mp_sub(&ta, &tb, &ta)) != MP_OKAY) ||
            ((res = mp_add(&q, &tq, &q)) != MP_OKAY)) {
           goto LBL_ERR;
        }
     }
     if (((res = mp_div_2d(&tb, 1, &tb, NULL)) != MP_OKAY) ||
         ((res = mp_div_2d(&tq, 1, &tq, NULL)) != MP_OKAY)) {
           goto LBL_ERR;
     }
  }

  /* now q == quotient and ta == remainder */
  n  = a->sign;
  n2 = (a->sign == b->sign ? MP_ZPOS : MP_NEG);
  if (c != NULL) {
     mp_exch(c, &q);
     c->sign  = (mp_iszero(c) == MP_YES) ? MP_ZPOS : n2;
  }
  if (d != NULL) {
     mp_exch(d, &ta);
     d->sign = (mp_iszero(d) == MP_YES) ? MP_ZPOS : n;
  }
LBL_ERR:
   mp_clear_multi(&ta, &tb, &tq, &q, NULL);
   return err;
   return res;
}

#else

/* integer signed division.
/* integer signed division. 
 * c*b + d == a [e.g. a/b, c=quotient, d=remainder]
 * HAC pp.598 Algorithm 14.20
 *
 * Note that the description in HAC is horribly
 * incomplete.  For example, it doesn't consider
 * the case where digits are removed from 'x' in
 * the inner loop.  It also doesn't consider the
 * Note that the description in HAC is horribly 
 * incomplete.  For example, it doesn't consider 
 * the case where digits are removed from 'x' in 
 * the inner loop.  It also doesn't consider the 
 * case that y has fewer than three digits, etc..
 *
 * The overall algorithm is as described as
 * The overall algorithm is as described as 
 * 14.20 from HAC but fixed to treat these cases.
*/
mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d)
int mp_div (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
{
   mp_int  q, x, y, t1, t2;
   int     n, t, i, norm;
  mp_int  q, x, y, t1, t2;
  int     res, n, t, i, norm, neg;
   mp_sign neg;
   mp_err  err;

   /* is divisor zero ? */
   if (MP_IS_ZERO(b)) {
      return MP_VAL;
   }
  /* is divisor zero ? */
  if (mp_iszero (b) == 1) {
    return MP_VAL;
  }

   /* if a < b then q=0, r = a */
   if (mp_cmp_mag(a, b) == MP_LT) {
      if (d != NULL) {
         err = mp_copy(a, d);
      } else {
         err = MP_OKAY;
      }
  /* if a < b then q=0, r = a */
  if (mp_cmp_mag (a, b) == MP_LT) {
    if (d != NULL) {
      res = mp_copy (a, d);
    } else {
      res = MP_OKAY;
    }
    if (c != NULL) {
      mp_zero (c);
    }
    return res;
  }
      if (c != NULL) {
         mp_zero(c);
      }
      return err;
   }

  if ((res = mp_init_size (&q, a->used + 2)) != MP_OKAY) {
    return res;
  }
  q.used = a->used + 2;

   if ((err = mp_init_size(&q, a->used + 2)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (&t1)) != MP_OKAY) {
    goto LBL_Q;
  }
   q.used = a->used + 2;

   if ((err = mp_init(&t1)) != MP_OKAY)                           goto LBL_Q;

  if ((res = mp_init (&t2)) != MP_OKAY) {
    goto LBL_T1;
  }
   if ((err = mp_init(&t2)) != MP_OKAY)                           goto LBL_T1;

   if ((err = mp_init_copy(&x, a)) != MP_OKAY)                    goto LBL_T2;

   if ((err = mp_init_copy(&y, b)) != MP_OKAY)                    goto LBL_X;
  if ((res = mp_init_copy (&x, a)) != MP_OKAY) {
    goto LBL_T2;
  }

  if ((res = mp_init_copy (&y, b)) != MP_OKAY) {
    goto LBL_X;
  }

   /* fix the sign */
   neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
   x.sign = y.sign = MP_ZPOS;
  /* fix the sign */
  neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
  x.sign = y.sign = MP_ZPOS;

   /* normalize both x and y, ensure that y >= b/2, [b == 2**MP_DIGIT_BIT] */
   norm = mp_count_bits(&y) % MP_DIGIT_BIT;
   if (norm < (MP_DIGIT_BIT - 1)) {
      norm = (MP_DIGIT_BIT - 1) - norm;
      if ((err = mp_mul_2d(&x, norm, &x)) != MP_OKAY)             goto LBL_Y;
      if ((err = mp_mul_2d(&y, norm, &y)) != MP_OKAY)             goto LBL_Y;
   } else {
      norm = 0;
   }
  /* normalize both x and y, ensure that y >= b/2, [b == 2**DIGIT_BIT] */
  norm = mp_count_bits(&y) % DIGIT_BIT;
  if (norm < (int)(DIGIT_BIT-1)) {
     norm = (DIGIT_BIT-1) - norm;
     if ((res = mp_mul_2d (&x, norm, &x)) != MP_OKAY) {
       goto LBL_Y;
     }
     if ((res = mp_mul_2d (&y, norm, &y)) != MP_OKAY) {
       goto LBL_Y;
     }
  } else {
     norm = 0;
  }

   /* note hac does 0 based, so if used==5 then its 0,1,2,3,4, e.g. use 4 */
   n = x.used - 1;
   t = y.used - 1;
  /* note hac does 0 based, so if used==5 then its 0,1,2,3,4, e.g. use 4 */
  n = x.used - 1;
  t = y.used - 1;

   /* while (x >= y*b**n-t) do { q[n-t] += 1; x -= y*b**{n-t} } */
   /* y = y*b**{n-t} */
   if ((err = mp_lshd(&y, n - t)) != MP_OKAY)                     goto LBL_Y;

   while (mp_cmp(&x, &y) != MP_LT) {
      ++(q.dp[n - t]);
      if ((err = mp_sub(&x, &y, &x)) != MP_OKAY)                  goto LBL_Y;
   }

   /* reset y by shifting it back down */
   mp_rshd(&y, n - t);
  /* while (x >= y*b**n-t) do { q[n-t] += 1; x -= y*b**{n-t} } */
  if ((res = mp_lshd (&y, n - t)) != MP_OKAY) { /* y = y*b**{n-t} */
    goto LBL_Y;
  }

  while (mp_cmp (&x, &y) != MP_LT) {
    ++(q.dp[n - t]);
    if ((res = mp_sub (&x, &y, &x)) != MP_OKAY) {
      goto LBL_Y;
    }
  }

  /* reset y by shifting it back down */
  mp_rshd (&y, n - t);

   /* step 3. for i from n down to (t + 1) */
   for (i = n; i >= (t + 1); i--) {
      if (i > x.used) {
         continue;
      }
  /* step 3. for i from n down to (t + 1) */
  for (i = n; i >= (t + 1); i--) {
    if (i > x.used) {
      continue;
    }

      /* step 3.1 if xi == yt then set q{i-t-1} to b-1,
       * otherwise set q{i-t-1} to (xi*b + x{i-1})/yt */
      if (x.dp[i] == y.dp[t]) {
         q.dp[(i - t) - 1] = ((mp_digit)1 << (mp_digit)MP_DIGIT_BIT) - (mp_digit)1;
      } else {
         mp_word tmp;
         tmp = (mp_word)x.dp[i] << (mp_word)MP_DIGIT_BIT;
         tmp |= (mp_word)x.dp[i - 1];
         tmp /= (mp_word)y.dp[t];
         if (tmp > (mp_word)MP_MASK) {
            tmp = MP_MASK;
    /* step 3.1 if xi == yt then set q{i-t-1} to b-1, 
     * otherwise set q{i-t-1} to (xi*b + x{i-1})/yt */
    if (x.dp[i] == y.dp[t]) {
      q.dp[i - t - 1] = ((((mp_digit)1) << DIGIT_BIT) - 1);
    } else {
      mp_word tmp;
      tmp = ((mp_word) x.dp[i]) << ((mp_word) DIGIT_BIT);
      tmp |= ((mp_word) x.dp[i - 1]);
      tmp /= ((mp_word) y.dp[t]);
      if (tmp > (mp_word) MP_MASK)
        tmp = MP_MASK;
         }
         q.dp[(i - t) - 1] = (mp_digit)(tmp & (mp_word)MP_MASK);
      }
      q.dp[i - t - 1] = (mp_digit) (tmp & (mp_word) (MP_MASK));
    }

      /* while (q{i-t-1} * (yt * b + y{t-1})) >
               xi * b**2 + xi-1 * b + xi-2

         do q{i-t-1} -= 1;
      */
      q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] + 1uL) & (mp_digit)MP_MASK;
      do {
         q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1uL) & (mp_digit)MP_MASK;
    /* while (q{i-t-1} * (yt * b + y{t-1})) > 
             xi * b**2 + xi-1 * b + xi-2 
     
       do q{i-t-1} -= 1; 
    */
    q.dp[i - t - 1] = (q.dp[i - t - 1] + 1) & MP_MASK;
    do {
      q.dp[i - t - 1] = (q.dp[i - t - 1] - 1) & MP_MASK;

         /* find left hand */
         mp_zero(&t1);
         t1.dp[0] = ((t - 1) < 0) ? 0u : y.dp[t - 1];
         t1.dp[1] = y.dp[t];
         t1.used = 2;
         if ((err = mp_mul_d(&t1, q.dp[(i - t) - 1], &t1)) != MP_OKAY) goto LBL_Y;

         /* find right hand */
         t2.dp[0] = ((i - 2) < 0) ? 0u : x.dp[i - 2];
         t2.dp[1] = x.dp[i - 1]; /* i >= 1 always holds */
         t2.dp[2] = x.dp[i];
         t2.used = 3;
      } while (mp_cmp_mag(&t1, &t2) == MP_GT);
      /* find left hand */
      mp_zero (&t1);
      t1.dp[0] = (t - 1 < 0) ? 0 : y.dp[t - 1];
      t1.dp[1] = y.dp[t];
      t1.used = 2;
      if ((res = mp_mul_d (&t1, q.dp[i - t - 1], &t1)) != MP_OKAY) {
        goto LBL_Y;
      }

      /* find right hand */
      t2.dp[0] = (i - 2 < 0) ? 0 : x.dp[i - 2];
      t2.dp[1] = (i - 1 < 0) ? 0 : x.dp[i - 1];
      t2.dp[2] = x.dp[i];
      t2.used = 3;
    } while (mp_cmp_mag(&t1, &t2) == MP_GT);

      /* step 3.3 x = x - q{i-t-1} * y * b**{i-t-1} */
      if ((err = mp_mul_d(&y, q.dp[(i - t) - 1], &t1)) != MP_OKAY) goto LBL_Y;

      if ((err = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY)           goto LBL_Y;

      if ((err = mp_sub(&x, &t1, &x)) != MP_OKAY)                 goto LBL_Y;

      /* if x < 0 then { x = x + y*b**{i-t-1}; q{i-t-1} -= 1; } */
      if (x.sign == MP_NEG) {
         if ((err = mp_copy(&y, &t1)) != MP_OKAY)                 goto LBL_Y;
         if ((err = mp_lshd(&t1, (i - t) - 1)) != MP_OKAY)        goto LBL_Y;
         if ((err = mp_add(&x, &t1, &x)) != MP_OKAY)              goto LBL_Y;

         q.dp[(i - t) - 1] = (q.dp[(i - t) - 1] - 1uL) & MP_MASK;
      }
   }
    /* step 3.3 x = x - q{i-t-1} * y * b**{i-t-1} */
    if ((res = mp_mul_d (&y, q.dp[i - t - 1], &t1)) != MP_OKAY) {
      goto LBL_Y;
    }

    if ((res = mp_lshd (&t1, i - t - 1)) != MP_OKAY) {
      goto LBL_Y;
    }

    if ((res = mp_sub (&x, &t1, &x)) != MP_OKAY) {
      goto LBL_Y;
    }

    /* if x < 0 then { x = x + y*b**{i-t-1}; q{i-t-1} -= 1; } */
    if (x.sign == MP_NEG) {
      if ((res = mp_copy (&y, &t1)) != MP_OKAY) {
        goto LBL_Y;
      }
      if ((res = mp_lshd (&t1, i - t - 1)) != MP_OKAY) {
        goto LBL_Y;
      }
      if ((res = mp_add (&x, &t1, &x)) != MP_OKAY) {
        goto LBL_Y;
      }

      q.dp[i - t - 1] = (q.dp[i - t - 1] - 1UL) & MP_MASK;
    }
  }

   /* now q is the quotient and x is the remainder
    * [which we have to normalize]
    */

   /* get sign before writing to c */
   x.sign = (x.used == 0) ? MP_ZPOS : a->sign;
  /* now q is the quotient and x is the remainder 
   * [which we have to normalize] 
   */
  
  /* get sign before writing to c */
  x.sign = x.used == 0 ? MP_ZPOS : a->sign;

   if (c != NULL) {
      mp_clamp(&q);
      mp_exch(&q, c);
      c->sign = neg;
   }
  if (c != NULL) {
    mp_clamp (&q);
    mp_exch (&q, c);
    c->sign = neg;
  }

   if (d != NULL) {
      if ((err = mp_div_2d(&x, norm, &x, NULL)) != MP_OKAY)       goto LBL_Y;
      mp_exch(&x, d);
   }
  if (d != NULL) {
    mp_div_2d (&x, norm, &x, NULL);
    mp_exch (&x, d);
  }

   err = MP_OKAY;
  res = MP_OKAY;

LBL_Y:
LBL_Y:mp_clear (&y);
   mp_clear(&y);
LBL_X:
LBL_X:mp_clear (&x);
   mp_clear(&x);
LBL_T2:
LBL_T2:mp_clear (&t2);
   mp_clear(&t2);
LBL_T1:
LBL_T1:mp_clear (&t1);
   mp_clear(&t1);
LBL_Q:
LBL_Q:mp_clear (&q);
   mp_clear(&q);
   return err;
  return res;
}

#endif

#endif

Changes to libtommath/bn_mp_div_2.c.

1

2
3

4













5
6
7

8
9

10
11
12
13
14
15
16
17
18






19
20
21
22
23
24







25
26
27


28
29
30
31



32
33

34
35
36

37
38
39
40

41
42
43
44
45
46
47









48
49

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+
-
-

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
+


-
+



-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DIV_2_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* b = a/2 */
mp_err mp_div_2(const mp_int *a, mp_int *b)
int mp_div_2(mp_int * a, mp_int * b)
{
   int     x, oldused;
  int     x, res, oldused;
   mp_digit r, rr, *tmpa, *tmpb;
   mp_err err;

   /* copy */
   if (b->alloc < a->used) {
      if ((err = mp_grow(b, a->used)) != MP_OKAY) {
         return err;
      }
   }
  /* copy */
  if (b->alloc < a->used) {
    if ((res = mp_grow (b, a->used)) != MP_OKAY) {
      return res;
    }
  }

   oldused = b->used;
   b->used = a->used;

   /* source alias */
   tmpa = a->dp + b->used - 1;
  oldused = b->used;
  b->used = a->used;
  {
    register mp_digit r, rr, *tmpa, *tmpb;

    /* source alias */
    tmpa = a->dp + b->used - 1;

   /* dest alias */
   tmpb = b->dp + b->used - 1;
    /* dest alias */
    tmpb = b->dp + b->used - 1;

   /* carry */
   r = 0;
   for (x = b->used - 1; x >= 0; x--) {
    /* carry */
    r = 0;
    for (x = b->used - 1; x >= 0; x--) {
      /* get the carry for the next iteration */
      rr = *tmpa & 1u;
      rr = *tmpa & 1;

      /* shift the current digit, add in carry and store */
      *tmpb-- = (*tmpa-- >> 1) | (r << (MP_DIGIT_BIT - 1));
      *tmpb-- = (*tmpa-- >> 1) | (r << (DIGIT_BIT - 1));

      /* forward carry to next iteration */
      r = rr;
   }
    }

   /* zero excess digits */
   MP_ZERO_DIGITS(b->dp + b->used, oldused - b->used);

   b->sign = a->sign;
   mp_clamp(b);
   return MP_OKAY;
    /* zero excess digits */
    tmpb = b->dp + b->used;
    for (x = b->used; x < oldused; x++) {
      *tmpb++ = 0;
    }
  }
  b->sign = a->sign;
  mp_clamp (b);
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_div_2d.c.

1

2
3

4













5
6
7

8
9
10
11




12
13
14
15
16
17
18
19
20








21
22
23
24
25



26
27
28
29
30
31
32
33







34






35
36
37
38




39
40
41
42
43




44
45
46


47
48
49


50
51
52


53
54
55
56
57
58





59
60
61
62



63
64
65
66
67
68
69










70
71

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
-

-
-
-
-
-
-
+
+
+
+
+
+
+

+
+
+
+
+
+
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DIV_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* shift right by a certain bit count (store quotient in c, optional remainder in d) */
mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d)
int mp_div_2d (mp_int * a, int b, mp_int * c, mp_int * d)
{
   mp_digit D, r, rr;
   int     x;
   mp_err err;
  mp_digit D, r, rr;
  int     x, res;
  mp_int  t;


   /* if the shift count is <= 0 then we do no work */
   if (b <= 0) {
      err = mp_copy(a, c);
      if (d != NULL) {
         mp_zero(d);
      }
      return err;
   }
  /* if the shift count is <= 0 then we do no work */
  if (b <= 0) {
    res = mp_copy (a, c);
    if (d != NULL) {
      mp_zero (d);
    }
    return res;
  }

   /* copy */
   if ((err = mp_copy(a, c)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (&t)) != MP_OKAY) {
    return res;
  }
   /* 'a' should not be used after here - it might be the same as d */

   /* get the remainder */
   if (d != NULL) {
      if ((err = mp_mod_2d(a, b, d)) != MP_OKAY) {
         return err;
      }
   }
  /* get the remainder */
  if (d != NULL) {
    if ((res = mp_mod_2d (a, b, &t)) != MP_OKAY) {
      mp_clear (&t);
      return res;
    }
  }

  /* copy */
  if ((res = mp_copy (a, c)) != MP_OKAY) {
    mp_clear (&t);
    return res;
  }

   /* shift by as many digits in the bit count */
   if (b >= MP_DIGIT_BIT) {
      mp_rshd(c, b / MP_DIGIT_BIT);
   }
  /* shift by as many digits in the bit count */
  if (b >= (int)DIGIT_BIT) {
    mp_rshd (c, b / DIGIT_BIT);
  }

   /* shift any bit count < MP_DIGIT_BIT */
   D = (mp_digit)(b % MP_DIGIT_BIT);
   if (D != 0u) {
      mp_digit *tmpc, mask, shift;
  /* shift any bit count < DIGIT_BIT */
  D = (mp_digit) (b % DIGIT_BIT);
  if (D != 0) {
    register mp_digit *tmpc, mask, shift;

      /* mask */
      mask = ((mp_digit)1 << D) - 1uL;
    /* mask */
    mask = (((mp_digit)1) << D) - 1;

      /* shift for lsb */
      shift = (mp_digit)MP_DIGIT_BIT - D;
    /* shift for lsb */
    shift = DIGIT_BIT - D;

      /* alias */
      tmpc = c->dp + (c->used - 1);
    /* alias */
    tmpc = c->dp + (c->used - 1);

      /* carry */
      r = 0;
      for (x = c->used - 1; x >= 0; x--) {
         /* get the lower  bits of this word in a temp */
         rr = *tmpc & mask;
    /* carry */
    r = 0;
    for (x = c->used - 1; x >= 0; x--) {
      /* get the lower  bits of this word in a temp */
      rr = *tmpc & mask;

         /* shift the current word and mix in the carry bits from the previous word */
         *tmpc = (*tmpc >> D) | (r << shift);
         --tmpc;
      /* shift the current word and mix in the carry bits from the previous word */
      *tmpc = (*tmpc >> D) | (r << shift);
      --tmpc;

         /* set the carry to the carry bits of the current word found above */
         r = rr;
      }
   }
   mp_clamp(c);
   return MP_OKAY;
      /* set the carry to the carry bits of the current word found above */
      r = rr;
    }
  }
  mp_clamp (c);
  if (d != NULL) {
    mp_exch (&t, d);
  }
  mp_clear (&t);
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_div_3.c.

1

2
3

4













5
6

7

8
9
10
11



12
13
14
15
16




17
18
19
20
21
22
23
24
25
26









27
28
29
30



31
32
33


34
35
36
37
38
39
40
41







42
43

44
45
46

47
48
49
50
51




52
53
54
55
56
57
58
59
60








61
62
63

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
-
-
+
+
+
-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+


-
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DIV_3_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* divide by three (based on routine from MPI and the GMP manual) */
int
mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d)
mp_div_3 (mp_int * a, mp_int *c, mp_digit * d)
{
   mp_int   q;
   mp_word  w, t;
   mp_digit b;
  mp_int   q;
  mp_word  w, t;
  mp_digit b;
   mp_err   err;
   int      ix;

   /* b = 2**MP_DIGIT_BIT / 3 */
   b = ((mp_word)1 << (mp_word)MP_DIGIT_BIT) / (mp_word)3;
  int      res, ix;
  
  /* b = 2**DIGIT_BIT / 3 */
  b = (((mp_word)1) << ((mp_word)DIGIT_BIT)) / ((mp_word)3);

   if ((err = mp_init_size(&q, a->used)) != MP_OKAY) {
      return err;
   }

   q.used = a->used;
   q.sign = a->sign;
   w = 0;
   for (ix = a->used - 1; ix >= 0; ix--) {
      w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix];
  if ((res = mp_init_size(&q, a->used)) != MP_OKAY) {
     return res;
  }
  
  q.used = a->used;
  q.sign = a->sign;
  w = 0;
  for (ix = a->used - 1; ix >= 0; ix--) {
     w = (w << ((mp_word)DIGIT_BIT)) | ((mp_word)a->dp[ix]);

      if (w >= 3u) {
         /* multiply w by [1/3] */
         t = (w * (mp_word)b) >> (mp_word)MP_DIGIT_BIT;
     if (w >= 3) {
        /* multiply w by [1/3] */
        t = (w * ((mp_word)b)) >> ((mp_word)DIGIT_BIT);

         /* now subtract 3 * [w/3] from w, to get the remainder */
         w -= t+t+t;
        /* now subtract 3 * [w/3] from w, to get the remainder */
        w -= t+t+t;

         /* fixup the remainder as required since
          * the optimization is not exact.
          */
         while (w >= 3u) {
            t += 1u;
            w -= 3u;
         }
        /* fixup the remainder as required since
         * the optimization is not exact.
         */
        while (w >= 3) {
           t += 1;
           w -= 3;
        }
      } else {
         t = 0;
        t = 0;
      }
      q.dp[ix] = (mp_digit)t;
   }
  }

   /* [optional] store the remainder */
   if (d != NULL) {
      *d = (mp_digit)w;
   }
  /* [optional] store the remainder */
  if (d != NULL) {
     *d = (mp_digit)w;
  }

   /* [optional] store the quotient */
   if (c != NULL) {
      mp_clamp(&q);
      mp_exch(&q, c);
   }
   mp_clear(&q);

   return err;
  /* [optional] store the quotient */
  if (c != NULL) {
     mp_clamp(&q);
     mp_exch(&q, c);
  }
  mp_clear(&q);
  
  return res;
}

#endif

Changes to libtommath/bn_mp_div_d.c.

1

2
3
4































5
6
7

8
9
10
11



12
13

14
15
16
17
18




19
20
21
22
23
24
25
26
27
28
29










30
31
32


33
34
35
36
37
38
39
40
41
42
43
44








45

46
47
48
49





50
51
52
53
54
55
56
57
58
59
60
61
62
63
64














65
66

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81














82
83
84

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
-
+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
-
+
+
+
-
-
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

+
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DIV_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

static int s_is_power_of_two(mp_digit b, int *p)
{
   int x;

   /* quick out - if (b & (b-1)) isn't zero, b isn't a power of two */
   if ((b==0) || (b & (b-1))) {
       return 0;
   }
   for (x = 1; x < DIGIT_BIT; x++) {
      if (b == (((mp_digit)1)<<x)) {
         *p = x;
         return 1;
      }
   }
   return 0;
}

/* single digit division (based on routine from MPI) */
mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d)
int mp_div_d (mp_int * a, mp_digit b, mp_int * c, mp_digit * d)
{
   mp_int  q;
   mp_word w;
   mp_digit t;
  mp_int  q;
  mp_word w;
  mp_digit t;
   mp_err err;
   int ix;
  int     res, ix;

   /* cannot divide by zero */
   if (b == 0u) {
      return MP_VAL;
   }
  /* cannot divide by zero */
  if (b == 0) {
     return MP_VAL;
  }

   /* quick outs */
   if ((b == 1u) || MP_IS_ZERO(a)) {
      if (d != NULL) {
         *d = 0;
      }
      if (c != NULL) {
         return mp_copy(a, c);
      }
      return MP_OKAY;
   }
  /* quick outs */
  if (b == 1 || mp_iszero(a) == 1) {
     if (d != NULL) {
        *d = 0;
     }
     if (c != NULL) {
        return mp_copy(a, c);
     }
     return MP_OKAY;
  }

   /* power of two ? */
   if ((b & (b - 1u)) == 0u) {
  /* power of two ? */
  if (s_is_power_of_two(b, &ix) == 1) {
      ix = 1;
      while ((ix < MP_DIGIT_BIT) && (b != (((mp_digit)1)<<ix))) {
         ix++;
      }
      if (d != NULL) {
         *d = a->dp[0] & (((mp_digit)1<<(mp_digit)ix) - 1uL);
      }
      if (c != NULL) {
         return mp_div_2d(a, ix, c, NULL);
      }
      return MP_OKAY;
   }
     if (d != NULL) {
        *d = a->dp[0] & ((((mp_digit)1)<<ix) - 1);
     }
     if (c != NULL) {
        return mp_div_2d(a, ix, c, NULL);
     }
     return MP_OKAY;
  }

#ifdef BN_MP_DIV_3_C
   /* three? */
   if (MP_HAS(MP_DIV_3) && (b == 3u)) {
      return mp_div_3(a, c, d);
   }
  /* three? */
  if (b == 3) {
     return mp_div_3(a, c, d);
  }
#endif

   /* no easy answer [c'est la vie].  Just division */
   if ((err = mp_init_size(&q, a->used)) != MP_OKAY) {
      return err;
   }

   q.used = a->used;
   q.sign = a->sign;
   w = 0;
   for (ix = a->used - 1; ix >= 0; ix--) {
      w = (w << (mp_word)MP_DIGIT_BIT) | (mp_word)a->dp[ix];

      if (w >= b) {
         t = (mp_digit)(w / b);
         w -= (mp_word)t * (mp_word)b;
  /* no easy answer [c'est la vie].  Just division */
  if ((res = mp_init_size(&q, a->used)) != MP_OKAY) {
     return res;
  }
  
  q.used = a->used;
  q.sign = a->sign;
  w = 0;
  for (ix = a->used - 1; ix >= 0; ix--) {
     w = (w << ((mp_word)DIGIT_BIT)) | ((mp_word)a->dp[ix]);
     
     if (w >= b) {
        t = (mp_digit)(w / b);
        w -= ((mp_word)t) * ((mp_word)b);
      } else {
         t = 0;
        t = 0;
      }
      q.dp[ix] = t;
   }

   if (d != NULL) {
      *d = (mp_digit)w;
   }

   if (c != NULL) {
      mp_clamp(&q);
      mp_exch(&q, c);
   }
   mp_clear(&q);

   return err;
      q.dp[ix] = (mp_digit)t;
  }
  
  if (d != NULL) {
     *d = (mp_digit)w;
  }
  
  if (c != NULL) {
     mp_clamp(&q);
     mp_exch(&q, c);
  }
  mp_clear(&q);
  
  return res;
}

#endif

Changes to libtommath/bn_mp_dr_is_modulus.c.

1

2
3

4
5














6
7

8
9
10
11
12
13

14
15
16
17
18
19
20
21
22



23
24

25
26
27

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+





-
+






-
-
-
+
+
+

-
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DR_IS_MODULUS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* determines if a number is a valid DR modulus */
mp_bool mp_dr_is_modulus(const mp_int *a)
int mp_dr_is_modulus(mp_int *a)
{
   int ix;

   /* must be at least two digits */
   if (a->used < 2) {
      return MP_NO;
      return 0;
   }

   /* must be of the form b**k - a [a <= b] so all
    * but the first digit must be equal to -1 (mod b).
    */
   for (ix = 1; ix < a->used; ix++) {
      if (a->dp[ix] != MP_MASK) {
         return MP_NO;
      }
       if (a->dp[ix] != MP_MASK) {
          return 0;
       }
   }
   return MP_YES;
   return 1;
}

#endif

Changes to libtommath/bn_mp_dr_reduce.c.

1

2
3

4













5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

20

21
22

23
24
25


26
27
28


29
30
31
32
33
34
35






36
37
38
39



40
41
42
43



44
45
46


47
48
49


50
51
52
53



54
55
56


57
58
59


60
61
62
63
64
65







66
67
68
69
70
71





72
73
74
75
76



77
78

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+















+
-
+

-
+
-
-
-
+
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DR_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* reduce "x" in place modulo "n" using the Diminished Radix algorithm.
 *
 * Based on algorithm from the paper
 *
 * "Generating Efficient Primes for Discrete Log Cryptosystems"
 *                 Chae Hoon Lim, Pil Joong Lee,
 *          POSTECH Information Research Laboratories
 *
 * The modulus must be of a special format [see manual]
 *
 * Has been modified to use algorithm 7.10 from the LTM book instead
 *
 * Input x must be in the range 0 <= x <= (n-1)**2
 */
int
mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k)
mp_dr_reduce (mp_int * x, mp_int * n, mp_digit k)
{
   mp_err      err;
  int      err, i, m;
   int i, m;
   mp_word  r;
   mp_digit mu, *tmpx1, *tmpx2;
  mp_word  r;
  mp_digit mu, *tmpx1, *tmpx2;

   /* m = digits in modulus */
   m = n->used;
  /* m = digits in modulus */
  m = n->used;

   /* ensure that "x" has at least 2m digits */
   if (x->alloc < (m + m)) {
      if ((err = mp_grow(x, m + m)) != MP_OKAY) {
         return err;
      }
   }
  /* ensure that "x" has at least 2m digits */
  if (x->alloc < m + m) {
    if ((err = mp_grow (x, m + m)) != MP_OKAY) {
      return err;
    }
  }

   /* top of loop, this is where the code resumes if
    * another reduction pass is required.
    */
/* top of loop, this is where the code resumes if
 * another reduction pass is required.
 */
top:
   /* aliases for digits */
   /* alias for lower half of x */
   tmpx1 = x->dp;
  /* aliases for digits */
  /* alias for lower half of x */
  tmpx1 = x->dp;

   /* alias for upper half of x, or x/B**m */
   tmpx2 = x->dp + m;
  /* alias for upper half of x, or x/B**m */
  tmpx2 = x->dp + m;

   /* set carry to zero */
   mu = 0;
  /* set carry to zero */
  mu = 0;

   /* compute (x mod B**m) + k * [x/B**m] inline and inplace */
   for (i = 0; i < m; i++) {
      r         = ((mp_word)*tmpx2++ * (mp_word)k) + *tmpx1 + mu;
  /* compute (x mod B**m) + k * [x/B**m] inline and inplace */
  for (i = 0; i < m; i++) {
      r         = ((mp_word)*tmpx2++) * ((mp_word)k) + *tmpx1 + mu;
      *tmpx1++  = (mp_digit)(r & MP_MASK);
      mu        = (mp_digit)(r >> ((mp_word)MP_DIGIT_BIT));
   }
      mu        = (mp_digit)(r >> ((mp_word)DIGIT_BIT));
  }

   /* set final carry */
   *tmpx1++ = mu;
  /* set final carry */
  *tmpx1++ = mu;

   /* zero words above m */
   MP_ZERO_DIGITS(tmpx1, (x->used - m) - 1);

   /* clamp, sub and return */
   mp_clamp(x);
  /* zero words above m */
  for (i = m + 1; i < x->used; i++) {
      *tmpx1++ = 0;
  }

  /* clamp, sub and return */
  mp_clamp (x);

   /* if x >= n then subtract and reduce again
    * Each successive "recursion" makes the input smaller and smaller.
    */
   if (mp_cmp_mag(x, n) != MP_LT) {
      if ((err = s_mp_sub(x, n, x)) != MP_OKAY) {
  /* if x >= n then subtract and reduce again
   * Each successive "recursion" makes the input smaller and smaller.
   */
  if (mp_cmp_mag (x, n) != MP_LT) {
    s_mp_sub(x, n, x);
         return err;
      }
      goto top;
   }
   return MP_OKAY;
    goto top;
  }
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_dr_setup.c.

1

2
3

4
5














6
7

8
9
10


11

12

13
14
15

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
+
+

+
-
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_DR_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* determines the setup value */
void mp_dr_setup(const mp_int *a, mp_digit *d)
void mp_dr_setup(mp_int *a, mp_digit *d)
{
   /* the casts are required if MP_DIGIT_BIT is one less than
    * the number of bits in a mp_digit [e.g. MP_DIGIT_BIT==31]
   /* the casts are required if DIGIT_BIT is one less than
    * the number of bits in a mp_digit [e.g. DIGIT_BIT==31]
    */
   *d = (mp_digit)((((mp_word)1) << ((mp_word)DIGIT_BIT)) - 
   *d = (mp_digit)(((mp_word)1 << (mp_word)MP_DIGIT_BIT) - (mp_word)a->dp[0]);
        ((mp_word)a->dp[0]));
}

#endif

Deleted libtommath/bn_mp_error_to_string.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27



























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_ERROR_TO_STRING_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* return a char * string for a given code */
const char *mp_error_to_string(mp_err code)
{
   switch (code) {
   case MP_OKAY:
      return "Successful";
   case MP_ERR:
      return "Unknown error";
   case MP_MEM:
      return "Out of heap";
   case MP_VAL:
      return "Value out of range";
   case MP_ITER:
      return "Max. iterations reached";
   case MP_BUF:
      return "Buffer overflow";
   default:
      return "Invalid error code";
   }
}

#endif

Changes to libtommath/bn_mp_exch.c.

1

2
3

4
5
6















7
8

9

10
11

12
13
14
15



16
17

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
+

-
-
-
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_EXCH_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* swap the elements of two integers, for cases where you can't simply swap the
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* swap the elements of two integers, for cases where you can't simply swap the 
 * mp_int pointers around
 */
void
void mp_exch(mp_int *a, mp_int *b)
mp_exch (mp_int * a, mp_int * b)
{
   mp_int  t;
  mp_int  t;

   t  = *a;
   *a = *b;
   *b = t;
  t  = *a;
  *a = *b;
  *b = t;
}
#endif

Added libtommath/bn_mp_expt_d.c.






















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_EXPT_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* calculate c = a**b  using a square-multiply algorithm */
int mp_expt_d (mp_int * a, mp_digit b, mp_int * c)
{
  int     res, x;
  mp_int  g;

  if ((res = mp_init_copy (&g, a)) != MP_OKAY) {
    return res;
  }

  /* set initial result */
  mp_set (c, 1);

  for (x = 0; x < (int) DIGIT_BIT; x++) {
    /* square */
    if ((res = mp_sqr (c, c)) != MP_OKAY) {
      mp_clear (&g);
      return res;
    }

    /* if the bit is set multiply */
    if ((b & (mp_digit) (((mp_digit)1) << (DIGIT_BIT - 1))) != 0) {
      if ((res = mp_mul (c, &g, c)) != MP_OKAY) {
         mp_clear (&g);
         return res;
      }
    }

    /* shift to next bit */
    b <<= 1;
  }

  mp_clear (&g);
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_mp_expt_u32.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46














































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_EXPT_U32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* calculate c = a**b  using a square-multiply algorithm */
mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c)
{
   mp_err err;

   mp_int  g;

   if ((err = mp_init_copy(&g, a)) != MP_OKAY) {
      return err;
   }

   /* set initial result */
   mp_set(c, 1uL);

   while (b > 0u) {
      /* if the bit is set multiply */
      if ((b & 1u) != 0u) {
         if ((err = mp_mul(c, &g, c)) != MP_OKAY) {
            goto LBL_ERR;
         }
      }

      /* square */
      if (b > 1u) {
         if ((err = mp_sqr(&g, &g)) != MP_OKAY) {
            goto LBL_ERR;
         }
      }

      /* shift to next bit */
      b >>= 1;
   }

   err = MP_OKAY;

LBL_ERR:
   mp_clear(&g);
   return err;
}

#endif

Changes to libtommath/bn_mp_exptmod.c.

1

2
3
4















5
6
7
8
9
10
11

12
13

14
15
16
17
18




19
20
21
22
23





24

25
26
27
28
29
30
31







32
33
34


35
36



37
38
39

40
41



42
43
44


45
46
47
48







49
50
51
52
53
54






55

56
57






58

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73






















74
75
76

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
-
+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+

-
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
+

+
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+
-
-
+
+
+
-
-
-
+
-
-
+
+
+

-
-
+
+
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+

+
-
-
+
+
+
+
+
+

+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_EXPTMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */


/* this is a shell function that calls either the normal or Montgomery
 * exptmod functions.  Originally the call to the montgomery code was
 * embedded in the normal function but that wasted alot of stack space
 * for nothing (since 99% of the time the Montgomery code would be called)
 */
mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y)
int mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y)
{
   int dr;
  int dr;

   /* modulus P must be positive */
   if (P->sign == MP_NEG) {
      return MP_VAL;
   }
  /* modulus P must be positive */
  if (P->sign == MP_NEG) {
     return MP_VAL;
  }

   /* if exponent X is negative we have to recurse */
   if (X->sign == MP_NEG) {
      mp_int tmpG, tmpX;
      mp_err err;
  /* if exponent X is negative we have to recurse */
  if (X->sign == MP_NEG) {
#ifdef BN_MP_INVMOD_C
     mp_int tmpG, tmpX;
     int err;

     /* first compute 1/G mod P */
      if (!MP_HAS(MP_INVMOD)) {
         return MP_VAL;
      }

      if ((err = mp_init_multi(&tmpG, &tmpX, NULL)) != MP_OKAY) {
         return err;
      }
     if ((err = mp_init(&tmpG)) != MP_OKAY) {
        return err;
     }
     if ((err = mp_invmod(G, P, &tmpG)) != MP_OKAY) {
        mp_clear(&tmpG);
        return err;
     }

      /* first compute 1/G mod P */
      if ((err = mp_invmod(G, P, &tmpG)) != MP_OKAY) {
     /* now get |X| */
     if ((err = mp_init(&tmpX)) != MP_OKAY) {
         goto LBL_ERR;
      }
        mp_clear(&tmpG);
        return err;
     }

      /* now get |X| */
      if ((err = mp_abs(X, &tmpX)) != MP_OKAY) {
     if ((err = mp_abs(X, &tmpX)) != MP_OKAY) {
         goto LBL_ERR;
      }
        mp_clear_multi(&tmpG, &tmpX, NULL);
        return err;
     }

      /* and now compute (1/G)**|X| instead of G**X [X < 0] */
      err = mp_exptmod(&tmpG, &tmpX, P, Y);
     /* and now compute (1/G)**|X| instead of G**X [X < 0] */
     err = mp_exptmod(&tmpG, &tmpX, P, Y);
LBL_ERR:
      mp_clear_multi(&tmpG, &tmpX, NULL);
      return err;
   }
     mp_clear_multi(&tmpG, &tmpX, NULL);
     return err;
#else 
     /* no invmod */
     return MP_VAL;
#endif
  }

   /* modified diminished radix reduction */
   if (MP_HAS(MP_REDUCE_IS_2K_L) && MP_HAS(MP_REDUCE_2K_L) && MP_HAS(S_MP_EXPTMOD) &&
       (mp_reduce_is_2k_l(P) == MP_YES)) {
      return s_mp_exptmod(G, X, P, Y, 1);
   }
/* modified diminished radix reduction */
#if defined(BN_MP_REDUCE_IS_2K_L_C) && defined(BN_MP_REDUCE_2K_L_C) && defined(BN_S_MP_EXPTMOD_C)
  if (mp_reduce_is_2k_l(P) == MP_YES) {
     return s_mp_exptmod(G, X, P, Y, 1);
  }
#endif

#ifdef BN_MP_DR_IS_MODULUS_C
   /* is it a DR modulus? default to no */
   dr = (MP_HAS(MP_DR_IS_MODULUS) && (mp_dr_is_modulus(P) == MP_YES)) ? 1 : 0;
  /* is it a DR modulus? */
  dr = mp_dr_is_modulus(P);
#else
  /* default to no */
  dr = 0;
#endif

#ifdef BN_MP_REDUCE_IS_2K_C
   /* if not, is it a unrestricted DR modulus? */
   if (MP_HAS(MP_REDUCE_IS_2K) && (dr == 0)) {
      dr = (mp_reduce_is_2k(P) == MP_YES) ? 2 : 0;
   }

   /* if the modulus is odd or dr != 0 use the montgomery method */
   if (MP_HAS(S_MP_EXPTMOD_FAST) && (MP_IS_ODD(P) || (dr != 0))) {
      return s_mp_exptmod_fast(G, X, P, Y, dr);
   } else if (MP_HAS(S_MP_EXPTMOD)) {
      /* otherwise use the generic Barrett reduction technique */
      return s_mp_exptmod(G, X, P, Y, 0);
   } else {
      /* no exptmod for evens */
      return MP_VAL;
   }
  /* if not, is it a unrestricted DR modulus? */
  if (dr == 0) {
     dr = mp_reduce_is_2k(P) << 1;
  }
#endif
    
  /* if the modulus is odd or dr != 0 use the montgomery method */
#ifdef BN_MP_EXPTMOD_FAST_C
  if (mp_isodd (P) == 1 || dr !=  0) {
    return mp_exptmod_fast (G, X, P, Y, dr);
  } else {
#endif
#ifdef BN_S_MP_EXPTMOD_C
    /* otherwise use the generic Barrett reduction technique */
    return s_mp_exptmod (G, X, P, Y, 0);
#else
    /* no exptmod for evens */
    return MP_VAL;
#endif
#ifdef BN_MP_EXPTMOD_FAST_C
  }
#endif
}

#endif

Added libtommath/bn_mp_exptmod_fast.c.





























































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_EXPTMOD_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85
 *
 * Uses a left-to-right k-ary sliding window to compute the modular exponentiation.
 * The value of k changes based on the size of the exponent.
 *
 * Uses Montgomery or Diminished Radix reduction [whichever appropriate]
 */

#ifdef MP_LOW_MEM
   #define TAB_SIZE 32
#else
   #define TAB_SIZE 256
#endif

int mp_exptmod_fast (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int redmode)
{
  mp_int  M[TAB_SIZE], res;
  mp_digit buf, mp;
  int     err, bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize;

  /* use a pointer to the reduction algorithm.  This allows us to use
   * one of many reduction algorithms without modding the guts of
   * the code with if statements everywhere.
   */
  int     (*redux)(mp_int*,mp_int*,mp_digit);

  /* find window size */
  x = mp_count_bits (X);
  if (x <= 7) {
    winsize = 2;
  } else if (x <= 36) {
    winsize = 3;
  } else if (x <= 140) {
    winsize = 4;
  } else if (x <= 450) {
    winsize = 5;
  } else if (x <= 1303) {
    winsize = 6;
  } else if (x <= 3529) {
    winsize = 7;
  } else {
    winsize = 8;
  }

#ifdef MP_LOW_MEM
  if (winsize > 5) {
     winsize = 5;
  }
#endif

  /* init M array */
  /* init first cell */
  if ((err = mp_init(&M[1])) != MP_OKAY) {
     return err;
  }

  /* now init the second half of the array */
  for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
    if ((err = mp_init(&M[x])) != MP_OKAY) {
      for (y = 1<<(winsize-1); y < x; y++) {
        mp_clear (&M[y]);
      }
      mp_clear(&M[1]);
      return err;
    }
  }

  /* determine and setup reduction code */
  if (redmode == 0) {
#ifdef BN_MP_MONTGOMERY_SETUP_C     
     /* now setup montgomery  */
     if ((err = mp_montgomery_setup (P, &mp)) != MP_OKAY) {
        goto LBL_M;
     }
#else
     err = MP_VAL;
     goto LBL_M;
#endif

     /* automatically pick the comba one if available (saves quite a few calls/ifs) */
#ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C
     if (((P->used * 2 + 1) < MP_WARRAY) &&
          P->used < (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) {
        redux = fast_mp_montgomery_reduce;
     } else 
#endif
     {
#ifdef BN_MP_MONTGOMERY_REDUCE_C
        /* use slower baseline Montgomery method */
        redux = mp_montgomery_reduce;
#else
        err = MP_VAL;
        goto LBL_M;
#endif
     }
  } else if (redmode == 1) {
#if defined(BN_MP_DR_SETUP_C) && defined(BN_MP_DR_REDUCE_C)
     /* setup DR reduction for moduli of the form B**k - b */
     mp_dr_setup(P, &mp);
     redux = mp_dr_reduce;
#else
     err = MP_VAL;
     goto LBL_M;
#endif
  } else {
#if defined(BN_MP_REDUCE_2K_SETUP_C) && defined(BN_MP_REDUCE_2K_C)
     /* setup DR reduction for moduli of the form 2**k - b */
     if ((err = mp_reduce_2k_setup(P, &mp)) != MP_OKAY) {
        goto LBL_M;
     }
     redux = mp_reduce_2k;
#else
     err = MP_VAL;
     goto LBL_M;
#endif
  }

  /* setup result */
  if ((err = mp_init (&res)) != MP_OKAY) {
    goto LBL_M;
  }

  /* create M table
   *

   *
   * The first half of the table is not computed though accept for M[0] and M[1]
   */

  if (redmode == 0) {
#ifdef BN_MP_MONTGOMERY_CALC_NORMALIZATION_C
     /* now we need R mod m */
     if ((err = mp_montgomery_calc_normalization (&res, P)) != MP_OKAY) {
       goto LBL_RES;
     }
#else 
     err = MP_VAL;
     goto LBL_RES;
#endif

     /* now set M[1] to G * R mod m */
     if ((err = mp_mulmod (G, &res, P, &M[1])) != MP_OKAY) {
       goto LBL_RES;
     }
  } else {
     mp_set(&res, 1);
     if ((err = mp_mod(G, P, &M[1])) != MP_OKAY) {
        goto LBL_RES;
     }
  }

  /* compute the value at M[1<<(winsize-1)] by squaring M[1] (winsize-1) times */
  if ((err = mp_copy (&M[1], &M[1 << (winsize - 1)])) != MP_OKAY) {
    goto LBL_RES;
  }

  for (x = 0; x < (winsize - 1); x++) {
    if ((err = mp_sqr (&M[1 << (winsize - 1)], &M[1 << (winsize - 1)])) != MP_OKAY) {
      goto LBL_RES;
    }
    if ((err = redux (&M[1 << (winsize - 1)], P, mp)) != MP_OKAY) {
      goto LBL_RES;
    }
  }

  /* create upper table */
  for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) {
    if ((err = mp_mul (&M[x - 1], &M[1], &M[x])) != MP_OKAY) {
      goto LBL_RES;
    }
    if ((err = redux (&M[x], P, mp)) != MP_OKAY) {
      goto LBL_RES;
    }
  }

  /* set initial mode and bit cnt */
  mode   = 0;
  bitcnt = 1;
  buf    = 0;
  digidx = X->used - 1;
  bitcpy = 0;
  bitbuf = 0;

  for (;;) {
    /* grab next digit as required */
    if (--bitcnt == 0) {
      /* if digidx == -1 we are out of digits so break */
      if (digidx == -1) {
        break;
      }
      /* read next digit and reset bitcnt */
      buf    = X->dp[digidx--];
      bitcnt = (int)DIGIT_BIT;
    }

    /* grab the next msb from the exponent */
    y     = (mp_digit)(buf >> (DIGIT_BIT - 1)) & 1;
    buf <<= (mp_digit)1;

    /* if the bit is zero and mode == 0 then we ignore it
     * These represent the leading zero bits before the first 1 bit
     * in the exponent.  Technically this opt is not required but it
     * does lower the # of trivial squaring/reductions used
     */
    if (mode == 0 && y == 0) {
      continue;
    }

    /* if the bit is zero and mode == 1 then we square */
    if (mode == 1 && y == 0) {
      if ((err = mp_sqr (&res, &res)) != MP_OKAY) {
        goto LBL_RES;
      }
      if ((err = redux (&res, P, mp)) != MP_OKAY) {
        goto LBL_RES;
      }
      continue;
    }

    /* else we add it to the window */
    bitbuf |= (y << (winsize - ++bitcpy));
    mode    = 2;

    if (bitcpy == winsize) {
      /* ok window is filled so square as required and multiply  */
      /* square first */
      for (x = 0; x < winsize; x++) {
        if ((err = mp_sqr (&res, &res)) != MP_OKAY) {
          goto LBL_RES;
        }
        if ((err = redux (&res, P, mp)) != MP_OKAY) {
          goto LBL_RES;
        }
      }

      /* then multiply */
      if ((err = mp_mul (&res, &M[bitbuf], &res)) != MP_OKAY) {
        goto LBL_RES;
      }
      if ((err = redux (&res, P, mp)) != MP_OKAY) {
        goto LBL_RES;
      }

      /* empty window and reset */
      bitcpy = 0;
      bitbuf = 0;
      mode   = 1;
    }
  }

  /* if bits remain then square/multiply */
  if (mode == 2 && bitcpy > 0) {
    /* square then multiply if the bit is set */
    for (x = 0; x < bitcpy; x++) {
      if ((err = mp_sqr (&res, &res)) != MP_OKAY) {
        goto LBL_RES;
      }
      if ((err = redux (&res, P, mp)) != MP_OKAY) {
        goto LBL_RES;
      }

      /* get next bit of the window */
      bitbuf <<= 1;
      if ((bitbuf & (1 << winsize)) != 0) {
        /* then multiply */
        if ((err = mp_mul (&res, &M[1], &res)) != MP_OKAY) {
          goto LBL_RES;
        }
        if ((err = redux (&res, P, mp)) != MP_OKAY) {
          goto LBL_RES;
        }
      }
    }
  }

  if (redmode == 0) {
     /* fixup result if Montgomery reduction is used
      * recall that any value in a Montgomery system is
      * actually multiplied by R mod n.  So we have
      * to reduce one more time to cancel out the factor
      * of R.
      */
     if ((err = redux(&res, P, mp)) != MP_OKAY) {
       goto LBL_RES;
     }
  }

  /* swap res with Y */
  mp_exch (&res, Y);
  err = MP_OKAY;
LBL_RES:mp_clear (&res);
LBL_M:
  mp_clear(&M[1]);
  for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
    mp_clear (&M[x]);
  }
  return err;
}
#endif

Changes to libtommath/bn_mp_exteuclid.c.

1

2
3

4
5
6















7
8
9

10
11
12


13
14
15
16
17
18
19
20


21
22
23
24


25
26
27
28
29



30
31
32
33
34
35
36
37







38
39
40
41
42




43
44
45
46
47




48
49
50
51
52
53
54



55
56
57
58

59
60
61

62
63
64

65
66

67
68
69
70

71
72
73

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
+
+






-
-
+
+


-
-
+
+


-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+




-
-
-
+
+
+



-
+
-
-
-
+
-
-
-
+
-
-
+
-

-
-
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_EXTEUCLID_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* Extended euclidean algorithm of (a, b) produces
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* Extended euclidean algorithm of (a, b) produces 
   a*u1 + b*u2 = u3
 */
mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3)
int mp_exteuclid(mp_int *a, mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3)
{
   mp_int u1, u2, u3, v1, v2, v3, t1, t2, t3, q, tmp;
   mp_err err;
   mp_int u1,u2,u3,v1,v2,v3,t1,t2,t3,q,tmp;
   int err;

   if ((err = mp_init_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL)) != MP_OKAY) {
      return err;
   }

   /* initialize, (u1,u2,u3) = (1,0,a) */
   mp_set(&u1, 1uL);
   if ((err = mp_copy(a, &u3)) != MP_OKAY)                        goto LBL_ERR;
   mp_set(&u1, 1);
   if ((err = mp_copy(a, &u3)) != MP_OKAY)                                        { goto _ERR; }

   /* initialize, (v1,v2,v3) = (0,1,b) */
   mp_set(&v2, 1uL);
   if ((err = mp_copy(b, &v3)) != MP_OKAY)                        goto LBL_ERR;
   mp_set(&v2, 1);
   if ((err = mp_copy(b, &v3)) != MP_OKAY)                                        { goto _ERR; }

   /* loop while v3 != 0 */
   while (!MP_IS_ZERO(&v3)) {
      /* q = u3/v3 */
      if ((err = mp_div(&u3, &v3, &q, NULL)) != MP_OKAY)          goto LBL_ERR;
   while (mp_iszero(&v3) == MP_NO) {
       /* q = u3/v3 */
       if ((err = mp_div(&u3, &v3, &q, NULL)) != MP_OKAY)                         { goto _ERR; }

      /* (t1,t2,t3) = (u1,u2,u3) - (v1,v2,v3)q */
      if ((err = mp_mul(&v1, &q, &tmp)) != MP_OKAY)               goto LBL_ERR;
      if ((err = mp_sub(&u1, &tmp, &t1)) != MP_OKAY)              goto LBL_ERR;
      if ((err = mp_mul(&v2, &q, &tmp)) != MP_OKAY)               goto LBL_ERR;
      if ((err = mp_sub(&u2, &tmp, &t2)) != MP_OKAY)              goto LBL_ERR;
      if ((err = mp_mul(&v3, &q, &tmp)) != MP_OKAY)               goto LBL_ERR;
      if ((err = mp_sub(&u3, &tmp, &t3)) != MP_OKAY)              goto LBL_ERR;
       /* (t1,t2,t3) = (u1,u2,u3) - (v1,v2,v3)q */
       if ((err = mp_mul(&v1, &q, &tmp)) != MP_OKAY)                              { goto _ERR; }
       if ((err = mp_sub(&u1, &tmp, &t1)) != MP_OKAY)                             { goto _ERR; }
       if ((err = mp_mul(&v2, &q, &tmp)) != MP_OKAY)                              { goto _ERR; }
       if ((err = mp_sub(&u2, &tmp, &t2)) != MP_OKAY)                             { goto _ERR; }
       if ((err = mp_mul(&v3, &q, &tmp)) != MP_OKAY)                              { goto _ERR; }
       if ((err = mp_sub(&u3, &tmp, &t3)) != MP_OKAY)                             { goto _ERR; }

      /* (u1,u2,u3) = (v1,v2,v3) */
      if ((err = mp_copy(&v1, &u1)) != MP_OKAY)                   goto LBL_ERR;
      if ((err = mp_copy(&v2, &u2)) != MP_OKAY)                   goto LBL_ERR;
      if ((err = mp_copy(&v3, &u3)) != MP_OKAY)                   goto LBL_ERR;
       /* (u1,u2,u3) = (v1,v2,v3) */
       if ((err = mp_copy(&v1, &u1)) != MP_OKAY)                                  { goto _ERR; }
       if ((err = mp_copy(&v2, &u2)) != MP_OKAY)                                  { goto _ERR; }
       if ((err = mp_copy(&v3, &u3)) != MP_OKAY)                                  { goto _ERR; }

      /* (v1,v2,v3) = (t1,t2,t3) */
      if ((err = mp_copy(&t1, &v1)) != MP_OKAY)                   goto LBL_ERR;
      if ((err = mp_copy(&t2, &v2)) != MP_OKAY)                   goto LBL_ERR;
      if ((err = mp_copy(&t3, &v3)) != MP_OKAY)                   goto LBL_ERR;
       /* (v1,v2,v3) = (t1,t2,t3) */
       if ((err = mp_copy(&t1, &v1)) != MP_OKAY)                                  { goto _ERR; }
       if ((err = mp_copy(&t2, &v2)) != MP_OKAY)                                  { goto _ERR; }
       if ((err = mp_copy(&t3, &v3)) != MP_OKAY)                                  { goto _ERR; }
   }

   /* make sure U3 >= 0 */
   if (u3.sign == MP_NEG) {
      if ((err = mp_neg(&u1, &u1)) != MP_OKAY)                    goto LBL_ERR;
      if ((err = mp_neg(&u2, &u2)) != MP_OKAY)                    goto LBL_ERR;
      if ((err = mp_neg(&u3, &u3)) != MP_OKAY)                    goto LBL_ERR;
      mp_neg(&u1, &u1);
      mp_neg(&u2, &u2);
      mp_neg(&u3, &u3);
   }

   /* copy result out */
   if (U1 != NULL) {
   if (U1 != NULL) { mp_exch(U1, &u1); }
      mp_exch(U1, &u1);
   }
   if (U2 != NULL) {
   if (U2 != NULL) { mp_exch(U2, &u2); }
      mp_exch(U2, &u2);
   }
   if (U3 != NULL) {
   if (U3 != NULL) { mp_exch(U3, &u3); }
      mp_exch(U3, &u3);
   }


   err = MP_OKAY;
LBL_ERR:
   mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL);
_ERR: mp_clear_multi(&u1, &u2, &u3, &v1, &v2, &v3, &t1, &t2, &t3, &q, &tmp, NULL);
   return err;
}
#endif

Changes to libtommath/bn_mp_fread.c.

1

2
3

4
5
6














7
8

9
10
11
12





13
14
15


16
17
18
19
20
21
22


23
24
25
26

27
28
29

30
31
32
33
34
35
36




37
38

39
40
41
42

43
44

45
46
47

48
49

50
51
52



53
54
55

56
57
58
59
60

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
+
+
+
+
+

-
-
+
+





-
-
+
+
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
+
-


-
+

-
+


-
+


+
-
-
-
+
+
+


-
+


-


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_FREAD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

#ifndef MP_NO_FILE
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* read a bigint from a file stream in ASCII */
mp_err mp_fread(mp_int *a, int radix, FILE *stream)
int mp_fread(mp_int *a, int radix, FILE *stream)
{
   mp_err err;
   mp_sign neg;

   int err, ch, neg, y;
   
   /* clear a */
   mp_zero(a);
   
   /* if first digit is - then set negative */
   int ch = fgetc(stream);
   if (ch == (int)'-') {
   ch = fgetc(stream);
   if (ch == '-') {
      neg = MP_NEG;
      ch = fgetc(stream);
   } else {
      neg = MP_ZPOS;
   }

   /* no digits, return error */
   
   for (;;) {
   if (ch == EOF) {
      return MP_ERR;
   }

      /* find y in the radix map */
   /* clear a */
   mp_zero(a);

      for (y = 0; y < radix; y++) {
   do {
      int y;
      unsigned pos = (unsigned)(ch - (int)'(');
      if (mp_s_rmap_reverse_sz < pos) {
         break;
      }

          if (mp_s_rmap[y] == ch) {
             break;
          }
      }
      y = (int)mp_s_rmap_reverse[pos];

      if (y == radix) {
      if ((y == 0xff) || (y >= radix)) {
         break;
      }

      
      /* shift up and add */
      if ((err = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) {
      if ((err = mp_mul_d(a, radix, a)) != MP_OKAY) {
         return err;
      }
      if ((err = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) {
      if ((err = mp_add_d(a, y, a)) != MP_OKAY) {
         return err;
      }
      
   } while ((ch = fgetc(stream)) != EOF);

   if (a->used != 0) {
      ch = fgetc(stream);
   }
   if (mp_cmp_d(a, 0) != MP_EQ) {
      a->sign = neg;
   }

   
   return MP_OKAY;
}
#endif

#endif

Deleted libtommath/bn_mp_from_sbin.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

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_FROM_SBIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* read signed bin, big endian, first byte is 0==positive or 1==negative */
mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size)
{
   mp_err err;

   /* read magnitude */
   if ((err = mp_from_ubin(a, buf + 1, size - 1u)) != MP_OKAY) {
      return err;
   }

   /* first byte is 0 for positive, non-zero for negative */
   if (buf[0] == (unsigned char)0) {
      a->sign = MP_ZPOS;
   } else {
      a->sign = MP_NEG;
   }

   return MP_OKAY;
}
#endif

Deleted libtommath/bn_mp_from_ubin.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39







































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_FROM_UBIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* reads a unsigned char array, assumes the msb is stored first [big endian] */
mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size)
{
   mp_err err;

   /* make sure there are at least two digits */
   if (a->alloc < 2) {
      if ((err = mp_grow(a, 2)) != MP_OKAY) {
         return err;
      }
   }

   /* zero the int */
   mp_zero(a);

   /* read the bytes in */
   while (size-- > 0u) {
      if ((err = mp_mul_2d(a, 8, a)) != MP_OKAY) {
         return err;
      }

#ifndef MP_8BIT
      a->dp[0] |= *buf++;
      a->used += 1;
#else
      a->dp[0] = (*buf & MP_MASK);
      a->dp[1] |= ((*buf++ >> 7) & 1u);
      a->used += 2;
#endif
   }
   mp_clamp(a);
   return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_fwrite.c.

1

2
3

4
5
6
7















8
9
10
11

12
13

14
15
16
17
18
19
20
21
22





23
24
25
26
27
28
29




30
31
32
33





34
35

36
37
38


39
40
41


42
43
44
45

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
-
+

-
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-



-
-
-
+
+
+
+

-
-
-
+
+
+
+
+
-
-
+
-
-
-
+
+
-
-
-
+
+

-


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_FWRITE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

#ifndef MP_NO_FILE
mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream)
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

int mp_fwrite(mp_int *a, int radix, FILE *stream)
{
   char *buf;
   mp_err err;
   int len;
   int err, len, x;
   size_t written;

   
   /* TODO: this function is not in this PR */
   if (MP_HAS(MP_RADIX_SIZE_OVERESTIMATE)) {
      /* if ((err = mp_radix_size_overestimate(&t, base, &len)) != MP_OKAY)      goto LBL_ERR; */
   } else {
      if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) {
         return err;
      }
   }

   if ((err = mp_radix_size(a, radix, &len)) != MP_OKAY) {
      return err;
   }

   buf = OPT_CAST(char) XMALLOC (len);
   buf = (char *) MP_MALLOC((size_t)len);
   if (buf == NULL) {
      return MP_MEM;
   }

   if ((err = mp_to_radix(a, buf, (size_t)len, &written, radix)) != MP_OKAY) {
      goto LBL_ERR;
   
   if ((err = mp_toradix(a, buf, radix)) != MP_OKAY) {
      XFREE (buf);
      return err;
   }

   if (fwrite(buf, written, 1uL, stream) != 1uL) {
      err = MP_ERR;
   
   for (x = 0; x < len; x++) {
       if (fputc(buf[x], stream) == EOF) {
          XFREE (buf);
          return MP_VAL;
      goto LBL_ERR;
   }
       }
   err = MP_OKAY;


   }
   
LBL_ERR:
   MP_FREE_BUFFER(buf, (size_t)len);
   return err;
   XFREE (buf);
   return MP_OKAY;
}
#endif

#endif

Changes to libtommath/bn_mp_gcd.c.

1

2
3

4













5
6
7

8
9
10


11
12
13
14
15
16
17
18
19







20
21
22
23
24




25
26
27
28



29
30
31


32
33
34
35
36




37
38
39
40
41
42





43
44
45
46
47




48
49
50
51
52
53
54






55
56
57
58
59
60





61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

















79
80
81
82
83
84
85
86







87
88

89
90

91
92

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
+
+
-

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_GCD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* Greatest Common Divisor using the binary method */
mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c)
int mp_gcd (mp_int * a, mp_int * b, mp_int * c)
{
   mp_int  u, v;
   int     k, u_lsb, v_lsb;
  mp_int  u, v;
  int     k, u_lsb, v_lsb, res;
   mp_err err;

   /* either zero than gcd is the largest */
   if (MP_IS_ZERO(a)) {
      return mp_abs(b, c);
   }
   if (MP_IS_ZERO(b)) {
      return mp_abs(a, c);
   }
  /* either zero than gcd is the largest */
  if (mp_iszero (a) == MP_YES) {
    return mp_abs (b, c);
  }
  if (mp_iszero (b) == MP_YES) {
    return mp_abs (a, c);
  }

   /* get copies of a and b we can modify */
   if ((err = mp_init_copy(&u, a)) != MP_OKAY) {
      return err;
   }
  /* get copies of a and b we can modify */
  if ((res = mp_init_copy (&u, a)) != MP_OKAY) {
    return res;
  }

   if ((err = mp_init_copy(&v, b)) != MP_OKAY) {
      goto LBL_U;
   }
  if ((res = mp_init_copy (&v, b)) != MP_OKAY) {
    goto LBL_U;
  }

   /* must be positive for the remainder of the algorithm */
   u.sign = v.sign = MP_ZPOS;
  /* must be positive for the remainder of the algorithm */
  u.sign = v.sign = MP_ZPOS;

   /* B1.  Find the common power of two for u and v */
   u_lsb = mp_cnt_lsb(&u);
   v_lsb = mp_cnt_lsb(&v);
   k     = MP_MIN(u_lsb, v_lsb);
  /* B1.  Find the common power of two for u and v */
  u_lsb = mp_cnt_lsb(&u);
  v_lsb = mp_cnt_lsb(&v);
  k     = MIN(u_lsb, v_lsb);

   if (k > 0) {
      /* divide the power of two out */
      if ((err = mp_div_2d(&u, k, &u, NULL)) != MP_OKAY) {
         goto LBL_V;
      }
  if (k > 0) {
     /* divide the power of two out */
     if ((res = mp_div_2d(&u, k, &u, NULL)) != MP_OKAY) {
        goto LBL_V;
     }

      if ((err = mp_div_2d(&v, k, &v, NULL)) != MP_OKAY) {
         goto LBL_V;
      }
   }
     if ((res = mp_div_2d(&v, k, &v, NULL)) != MP_OKAY) {
        goto LBL_V;
     }
  }

   /* divide any remaining factors of two out */
   if (u_lsb != k) {
      if ((err = mp_div_2d(&u, u_lsb - k, &u, NULL)) != MP_OKAY) {
         goto LBL_V;
      }
   }
  /* divide any remaining factors of two out */
  if (u_lsb != k) {
     if ((res = mp_div_2d(&u, u_lsb - k, &u, NULL)) != MP_OKAY) {
        goto LBL_V;
     }
  }

   if (v_lsb != k) {
      if ((err = mp_div_2d(&v, v_lsb - k, &v, NULL)) != MP_OKAY) {
         goto LBL_V;
      }
   }
  if (v_lsb != k) {
     if ((res = mp_div_2d(&v, v_lsb - k, &v, NULL)) != MP_OKAY) {
        goto LBL_V;
     }
  }

   while (!MP_IS_ZERO(&v)) {
      /* make sure v is the largest */
      if (mp_cmp_mag(&u, &v) == MP_GT) {
         /* swap u and v to make sure v is >= u */
         mp_exch(&u, &v);
      }

      /* subtract smallest from largest */
      if ((err = s_mp_sub(&v, &u, &v)) != MP_OKAY) {
         goto LBL_V;
      }

      /* Divide out all factors of two */
      if ((err = mp_div_2d(&v, mp_cnt_lsb(&v), &v, NULL)) != MP_OKAY) {
         goto LBL_V;
      }
   }
  while (mp_iszero(&v) == 0) {
     /* make sure v is the largest */
     if (mp_cmp_mag(&u, &v) == MP_GT) {
        /* swap u and v to make sure v is >= u */
        mp_exch(&u, &v);
     }
     
     /* subtract smallest from largest */
     if ((res = s_mp_sub(&v, &u, &v)) != MP_OKAY) {
        goto LBL_V;
     }
     
     /* Divide out all factors of two */
     if ((res = mp_div_2d(&v, mp_cnt_lsb(&v), &v, NULL)) != MP_OKAY) {
        goto LBL_V;
     } 
  } 

   /* multiply by 2**k which we divided out at the beginning */
   if ((err = mp_mul_2d(&u, k, c)) != MP_OKAY) {
      goto LBL_V;
   }
   c->sign = MP_ZPOS;
   err = MP_OKAY;
LBL_V:
  /* multiply by 2**k which we divided out at the beginning */
  if ((res = mp_mul_2d (&u, k, c)) != MP_OKAY) {
     goto LBL_V;
  }
  c->sign = MP_ZPOS;
  res = MP_OKAY;
LBL_V:mp_clear (&u);
   mp_clear(&u);
LBL_U:
LBL_U:mp_clear (&v);
   mp_clear(&v);
   return err;
  return res;
}
#endif

Deleted libtommath/bn_mp_get_double.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_DOUBLE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

double mp_get_double(const mp_int *a)
{
   int i;
   double d = 0.0, fac = 1.0;
   for (i = 0; i < MP_DIGIT_BIT; ++i) {
      fac *= 2.0;
   }
   for (i = a->used; i --> 0;) {
      d = (d * fac) + (double)a->dp[i];
   }
   return (a->sign == MP_NEG) ? -d : d;
}
#endif

Deleted libtommath/bn_mp_get_i32.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_I32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_SIGNED(mp_get_i32, mp_get_mag_u32, int32_t, uint32_t)
#endif

Deleted libtommath/bn_mp_get_i64.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_I64_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_SIGNED(mp_get_i64, mp_get_mag_u64, int64_t, uint64_t)
#endif

Added libtommath/bn_mp_get_int.c.










































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_GET_INT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* get the lower 32-bits of an mp_int */
unsigned long mp_get_int(mp_int * a) 
{
  int i;
  unsigned long res;

  if (a->used == 0) {
     return 0;
  }

  /* get number of digits of the lsb we have to read */
  i = MIN(a->used,(int)((sizeof(unsigned long)*CHAR_BIT+DIGIT_BIT-1)/DIGIT_BIT))-1;

  /* get most significant digit of result */
  res = DIGIT(a,i);
   
  while (--i >= 0) {
    res = (res << DIGIT_BIT) | DIGIT(a,i);
  }

  /* force result to 32-bits always so it is consistent on non 32-bit platforms */
  return res & 0xFFFFFFFFUL;
}
#endif

Deleted libtommath/bn_mp_get_l.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_SIGNED(mp_get_l, mp_get_mag_ul, long, unsigned long)
#endif

Deleted libtommath/bn_mp_get_ll.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_LL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_SIGNED(mp_get_ll, mp_get_mag_ull, long long, unsigned long long)
#endif

Deleted libtommath/bn_mp_get_mag_u32.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_MAG_U32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_MAG(mp_get_mag_u32, uint32_t)
#endif

Deleted libtommath/bn_mp_get_mag_u64.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_MAG_U64_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_MAG(mp_get_mag_u64, uint64_t)
#endif

Deleted libtommath/bn_mp_get_mag_ul.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_MAG_UL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_MAG(mp_get_mag_ul, unsigned long)
#endif

Deleted libtommath/bn_mp_get_mag_ull.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_GET_MAG_ULL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_GET_MAG(mp_get_mag_ull, unsigned long long)
#endif

Changes to libtommath/bn_mp_grow.c.

1

2
3

4













5
6
7

8
9
10


11
12
13
14
15
16
17
18
19











20
21

22
23
24
25
26




27
28
29


30
31
32
33
34
35
36








37
38

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_GROW_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* grow as required */
mp_err mp_grow(mp_int *a, int size)
int mp_grow (mp_int * a, int size)
{
   int     i;
   mp_digit *tmp;
  int     i;
  mp_digit *tmp;

   /* if the alloc size is smaller alloc more ram */
   if (a->alloc < size) {
      /* reallocate the array a->dp
       *
       * We store the return in a temporary variable
       * in case the operation failed we don't want
       * to overwrite the dp member of a.
       */
  /* if the alloc size is smaller alloc more ram */
  if (a->alloc < size) {
    /* ensure there are always at least MP_PREC digits extra on top */
    size += (MP_PREC * 2) - (size % MP_PREC);

    /* reallocate the array a->dp
     *
     * We store the return in a temporary variable
     * in case the operation failed we don't want
     * to overwrite the dp member of a.
     */
      tmp = (mp_digit *) MP_REALLOC(a->dp,
                                    (size_t)a->alloc * sizeof(mp_digit),
    tmp = OPT_CAST(mp_digit) XREALLOC (a->dp, sizeof (mp_digit) * size);
                                    (size_t)size * sizeof(mp_digit));
      if (tmp == NULL) {
         /* reallocation failed but "a" is still valid [can be freed] */
         return MP_MEM;
      }
    if (tmp == NULL) {
      /* reallocation failed but "a" is still valid [can be freed] */
      return MP_MEM;
    }

      /* reallocation succeeded so set a->dp */
      a->dp = tmp;
    /* reallocation succeeded so set a->dp */
    a->dp = tmp;

      /* zero excess digits */
      i        = a->alloc;
      a->alloc = size;
      MP_ZERO_DIGITS(a->dp + i, a->alloc - i);
   }
   return MP_OKAY;
    /* zero excess digits */
    i        = a->alloc;
    a->alloc = size;
    for (; i < a->alloc; i++) {
      a->dp[i] = 0;
    }
  }
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_mp_incr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30






























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INCR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Increment "a" by one like "a++". Changes input! */
mp_err mp_incr(mp_int *a)
{
   if (MP_IS_ZERO(a)) {
      mp_set(a,1uL);
      return MP_OKAY;
   } else if (a->sign == MP_NEG) {
      mp_err err;
      a->sign = MP_ZPOS;
      if ((err = mp_decr(a)) != MP_OKAY) {
         return err;
      }
      /* There is no -0 in LTM */
      if (!MP_IS_ZERO(a)) {
         a->sign = MP_NEG;
      }
      return MP_OKAY;
   } else if (a->dp[0] < MP_DIGIT_MAX) {
      a->dp[0]++;
      return MP_OKAY;
   } else {
      return mp_add_d(a, 1uL,a);
   }
}
#endif

Changes to libtommath/bn_mp_init.c.

1

2
3

4
5














6
7

8


9
10
11
12
13





14





15
16
17
18
19





20
21

22
23

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

+
+
-
-
-
-
-
+
+
+
+
+

+
+
+
+
+
-
-
-
-
-
+
+
+
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_INIT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* init a new mp_int */
mp_err mp_init(mp_int *a)
int mp_init (mp_int * a)
{
  int i;

   /* allocate memory required and clear it */
   a->dp = (mp_digit *) MP_CALLOC((size_t)MP_PREC, sizeof(mp_digit));
   if (a->dp == NULL) {
      return MP_MEM;
   }
  /* allocate memory required and clear it */
  a->dp = OPT_CAST(mp_digit) XMALLOC (sizeof (mp_digit) * MP_PREC);
  if (a->dp == NULL) {
    return MP_MEM;
  }

  /* set the digits to zero */
  for (i = 0; i < MP_PREC; i++) {
      a->dp[i] = 0;
  }

   /* set the used to zero, allocated digits to the default precision
    * and sign to positive */
   a->used  = 0;
   a->alloc = MP_PREC;
   a->sign  = MP_ZPOS;
  /* set the used to zero, allocated digits to the default precision
   * and sign to positive */
  a->used  = 0;
  a->alloc = MP_PREC;
  a->sign  = MP_ZPOS;

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_init_copy.c.

1

2
3

4
5














6
7

8
9

10
11
12
13



14
15
16
17
18
19

20
21

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
-
-
+
+
+
-
-
-
-
-
-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_INIT_COPY_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* creates "a" then copies b into it */
mp_err mp_init_copy(mp_int *a, const mp_int *b)
int mp_init_copy (mp_int * a, mp_int * b)
{
   mp_err     err;
  int     res;

   if ((err = mp_init_size(a, b->used)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (a)) != MP_OKAY) {
    return res;
  }

   if ((err = mp_copy(b, a)) != MP_OKAY) {
      mp_clear(a);
   }

   return err;
  return mp_copy (b, a);
}
#endif

Deleted libtommath/bn_mp_init_i32.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_I32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_i32, mp_set_i32, int32_t)
#endif

Deleted libtommath/bn_mp_init_i64.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_I64_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_i64, mp_set_i64, int64_t)
#endif

Deleted libtommath/bn_mp_init_l.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_l, mp_set_l, long)
#endif

Deleted libtommath/bn_mp_init_ll.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_LL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_ll, mp_set_ll, long long)
#endif

Changes to libtommath/bn_mp_init_multi.c.

1

2
3

4
5













6
7
8

9
10
11
12
13




14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38



























39
40
41

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_INIT_MULTI_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */
#include <stdarg.h>

mp_err mp_init_multi(mp_int *mp, ...)
int mp_init_multi(mp_int *mp, ...) 
{
   mp_err err = MP_OKAY;      /* Assume ok until proven otherwise */
   int n = 0;                 /* Number of ok inits */
   mp_int *cur_arg = mp;
   va_list args;
    mp_err res = MP_OKAY;      /* Assume ok until proven otherwise */
    int n = 0;                 /* Number of ok inits */
    mp_int* cur_arg = mp;
    va_list args;

   va_start(args, mp);        /* init args to next argument from caller */
   while (cur_arg != NULL) {
      if (mp_init(cur_arg) != MP_OKAY) {
         /* Oops - error! Back-track and mp_clear what we already
            succeeded in init-ing, then return error.
         */
         va_list clean_args;

         /* now start cleaning up */
         cur_arg = mp;
         va_start(clean_args, mp);
         while (n-- != 0) {
            mp_clear(cur_arg);
            cur_arg = va_arg(clean_args, mp_int *);
         }
         va_end(clean_args);
         err = MP_MEM;
         break;
      }
      n++;
      cur_arg = va_arg(args, mp_int *);
   }
   va_end(args);
   return err;                /* Assumed ok, if error flagged above. */
    va_start(args, mp);        /* init args to next argument from caller */
    while (cur_arg != NULL) {
        if (mp_init(cur_arg) != MP_OKAY) {
            /* Oops - error! Back-track and mp_clear what we already
               succeeded in init-ing, then return error.
            */
            va_list clean_args;
            
            /* end the current list */
            va_end(args);
            
            /* now start cleaning up */            
            cur_arg = mp;
            va_start(clean_args, mp);
            while (n--) {
                mp_clear(cur_arg);
                cur_arg = va_arg(clean_args, mp_int*);
            }
            va_end(clean_args);
            res = MP_MEM;
            break;
        }
        n++;
        cur_arg = va_arg(args, mp_int*);
    }
    va_end(args);
    return res;                /* Assumed ok, if error flagged above. */
}

#endif

Changes to libtommath/bn_mp_init_set.c.

1

2
3

4
5














6
7

8
9
10
11
12
13
14






15
16

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_INIT_SET_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* initialize and set a digit */
mp_err mp_init_set(mp_int *a, mp_digit b)
int mp_init_set (mp_int * a, mp_digit b)
{
   mp_err err;
   if ((err = mp_init(a)) != MP_OKAY) {
      return err;
   }
   mp_set(a, b);
   return err;
  int err;
  if ((err = mp_init(a)) != MP_OKAY) {
     return err;
  }
  mp_set(a, b);
  return err;
}
#endif

Added libtommath/bn_mp_init_set_int.c.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_INIT_SET_INT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* initialize and set a digit */
int mp_init_set_int (mp_int * a, unsigned long b)
{
  int err;
  if ((err = mp_init(a)) != MP_OKAY) {
     return err;
  }
  return mp_set_int(a, b);
}
#endif

Changes to libtommath/bn_mp_init_size.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

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

+
+
+
+
+
-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_INIT_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* init an mp_init for a given size */
mp_err mp_init_size(mp_int *a, int size)
int mp_init_size (mp_int * a, int size)
{
  int x;
   size = MP_MAX(MP_MIN_PREC, size);

   /* alloc mem */
   a->dp = (mp_digit *) MP_CALLOC((size_t)size, sizeof(mp_digit));
   if (a->dp == NULL) {
      return MP_MEM;
   }

  /* pad size so there are always extra digits */
  size += (MP_PREC * 2) - (size % MP_PREC);	
  
  /* alloc mem */
  a->dp = OPT_CAST(mp_digit) XMALLOC (sizeof (mp_digit) * size);
  if (a->dp == NULL) {
    return MP_MEM;
  }

   /* set the members */
   a->used  = 0;
   a->alloc = size;
   a->sign  = MP_ZPOS;
  /* set the members */
  a->used  = 0;
  a->alloc = size;
  a->sign  = MP_ZPOS;

  /* zero the digits */
  for (x = 0; x < size; x++) {
      a->dp[x] = 0;
  }

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_mp_init_u32.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_U32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_u32, mp_set_u32, uint32_t)
#endif

Deleted libtommath/bn_mp_init_u64.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_U64_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_u64, mp_set_u64, uint64_t)
#endif

Deleted libtommath/bn_mp_init_ul.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_UL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_ul, mp_set_ul, unsigned long)
#endif

Deleted libtommath/bn_mp_init_ull.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_INIT_ULL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_INIT_INT(mp_init_ull, mp_set_ull, unsigned long long)
#endif

Changes to libtommath/bn_mp_invmod.c.

1

2
3

4
5














6
7

8
9
10
11
12




13

14
15
16
17





18
19
20
21





22
23

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
+
+
+
+

+
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_INVMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* hac 14.61, pp608 */
mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c)
int mp_invmod (mp_int * a, mp_int * b, mp_int * c)
{
   /* b cannot be negative and has to be >1 */
   if ((b->sign == MP_NEG) || (mp_cmp_d(b, 1uL) != MP_GT)) {
      return MP_VAL;
   }
  /* b cannot be negative */
  if (b->sign == MP_NEG || mp_iszero(b) == 1) {
    return MP_VAL;
  }

#ifdef BN_FAST_MP_INVMOD_C
   /* if the modulus is odd we can use a faster routine instead */
   if (MP_HAS(S_MP_INVMOD_FAST) && MP_IS_ODD(b)) {
      return s_mp_invmod_fast(a, b, c);
   }
  /* if the modulus is odd we can use a faster routine instead */
  if (mp_isodd (b) == 1) {
    return fast_mp_invmod (a, b, c);
  }
#endif

   return MP_HAS(S_MP_INVMOD_SLOW)
          ? s_mp_invmod_slow(a, b, c)
          : MP_VAL;
#ifdef BN_MP_INVMOD_SLOW_C
  return mp_invmod_slow(a, b, c);
#endif

  return MP_VAL;
}
#endif

Added libtommath/bn_mp_invmod_slow.c.












































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_INVMOD_SLOW_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* hac 14.61, pp608 */
int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c)
{
  mp_int  x, y, u, v, A, B, C, D;
  int     res;

  /* b cannot be negative */
  if (b->sign == MP_NEG || mp_iszero(b) == 1) {
    return MP_VAL;
  }

  /* init temps */
  if ((res = mp_init_multi(&x, &y, &u, &v, 
                           &A, &B, &C, &D, NULL)) != MP_OKAY) {
     return res;
  }

  /* x = a, y = b */
  if ((res = mp_mod(a, b, &x)) != MP_OKAY) {
      goto LBL_ERR;
  }
  if ((res = mp_copy (b, &y)) != MP_OKAY) {
    goto LBL_ERR;
  }

  /* 2. [modified] if x,y are both even then return an error! */
  if (mp_iseven (&x) == 1 && mp_iseven (&y) == 1) {
    res = MP_VAL;
    goto LBL_ERR;
  }

  /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */
  if ((res = mp_copy (&x, &u)) != MP_OKAY) {
    goto LBL_ERR;
  }
  if ((res = mp_copy (&y, &v)) != MP_OKAY) {
    goto LBL_ERR;
  }
  mp_set (&A, 1);
  mp_set (&D, 1);

top:
  /* 4.  while u is even do */
  while (mp_iseven (&u) == 1) {
    /* 4.1 u = u/2 */
    if ((res = mp_div_2 (&u, &u)) != MP_OKAY) {
      goto LBL_ERR;
    }
    /* 4.2 if A or B is odd then */
    if (mp_isodd (&A) == 1 || mp_isodd (&B) == 1) {
      /* A = (A+y)/2, B = (B-x)/2 */
      if ((res = mp_add (&A, &y, &A)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((res = mp_sub (&B, &x, &B)) != MP_OKAY) {
         goto LBL_ERR;
      }
    }
    /* A = A/2, B = B/2 */
    if ((res = mp_div_2 (&A, &A)) != MP_OKAY) {
      goto LBL_ERR;
    }
    if ((res = mp_div_2 (&B, &B)) != MP_OKAY) {
      goto LBL_ERR;
    }
  }

  /* 5.  while v is even do */
  while (mp_iseven (&v) == 1) {
    /* 5.1 v = v/2 */
    if ((res = mp_div_2 (&v, &v)) != MP_OKAY) {
      goto LBL_ERR;
    }
    /* 5.2 if C or D is odd then */
    if (mp_isodd (&C) == 1 || mp_isodd (&D) == 1) {
      /* C = (C+y)/2, D = (D-x)/2 */
      if ((res = mp_add (&C, &y, &C)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((res = mp_sub (&D, &x, &D)) != MP_OKAY) {
         goto LBL_ERR;
      }
    }
    /* C = C/2, D = D/2 */
    if ((res = mp_div_2 (&C, &C)) != MP_OKAY) {
      goto LBL_ERR;
    }
    if ((res = mp_div_2 (&D, &D)) != MP_OKAY) {
      goto LBL_ERR;
    }
  }

  /* 6.  if u >= v then */
  if (mp_cmp (&u, &v) != MP_LT) {
    /* u = u - v, A = A - C, B = B - D */
    if ((res = mp_sub (&u, &v, &u)) != MP_OKAY) {
      goto LBL_ERR;
    }

    if ((res = mp_sub (&A, &C, &A)) != MP_OKAY) {
      goto LBL_ERR;
    }

    if ((res = mp_sub (&B, &D, &B)) != MP_OKAY) {
      goto LBL_ERR;
    }
  } else {
    /* v - v - u, C = C - A, D = D - B */
    if ((res = mp_sub (&v, &u, &v)) != MP_OKAY) {
      goto LBL_ERR;
    }

    if ((res = mp_sub (&C, &A, &C)) != MP_OKAY) {
      goto LBL_ERR;
    }

    if ((res = mp_sub (&D, &B, &D)) != MP_OKAY) {
      goto LBL_ERR;
    }
  }

  /* if not zero goto step 4 */
  if (mp_iszero (&u) == 0)
    goto top;

  /* now a = C, b = D, gcd == g*v */

  /* if v != 1 then there is no inverse */
  if (mp_cmp_d (&v, 1) != MP_EQ) {
    res = MP_VAL;
    goto LBL_ERR;
  }

  /* if its too low */
  while (mp_cmp_d(&C, 0) == MP_LT) {
      if ((res = mp_add(&C, b, &C)) != MP_OKAY) {
         goto LBL_ERR;
      }
  }
  
  /* too big */
  while (mp_cmp_mag(&C, b) != MP_LT) {
      if ((res = mp_sub(&C, b, &C)) != MP_OKAY) {
         goto LBL_ERR;
      }
  }
  
  /* C is now the inverse */
  mp_exch (&C, c);
  res = MP_OKAY;
LBL_ERR:mp_clear_multi (&x, &y, &u, &v, &A, &B, &C, &D, NULL);
  return res;
}
#endif

Changes to libtommath/bn_mp_is_square.c.

1

2
3

4
5














6
7
8
9
10
11
12
13
14
15








16
17
18
19
20
21
22
23
24
25







26
27
28
29

30
31
32
33
34




35
36
37


38
39
40
41



42

43
44
45



46
47
48
49
50




51
52
53
54
55
56
57
58







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78


















79
80
81
82
83
84
85
86







87
88

89
90
91


92
93

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+



-
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
+
+
+

+
-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+
-
-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_IS_SQUARE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* Check if remainders are possible squares - fast exclude non-squares */
static const char rem_128[128] = {
   0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
   1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1
 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
 1, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1,
 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1
};

static const char rem_105[105] = {
   0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1,
   0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1,
   0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1,
   1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1,
   0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1,
   1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1,
   1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1
 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1,
 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1,
 0, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1, 1,
 1, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1,
 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1,
 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1,
 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1
};

/* Store non-zero to ret if arg is square, and zero if not */
mp_err mp_is_square(const mp_int *arg, mp_bool *ret)
int mp_is_square(mp_int *arg,int *ret) 
{
   mp_err        err;
   mp_digit      c;
   mp_int        t;
   unsigned long r;
  int           res;
  mp_digit      c;
  mp_int        t;
  unsigned long r;

   /* Default to Non-square :) */
   *ret = MP_NO;
  /* Default to Non-square :) */
  *ret = MP_NO; 

   if (arg->sign == MP_NEG) {
      return MP_VAL;
   }
  if (arg->sign == MP_NEG) {
    return MP_VAL;
  }

  /* digits used?  (TSD) */
   if (MP_IS_ZERO(arg)) {
      return MP_OKAY;
   }
  if (arg->used == 0) {
     return MP_OKAY;
  }

   /* First check mod 128 (suppose that MP_DIGIT_BIT is at least 7) */
   if (rem_128[127u & arg->dp[0]] == (char)1) {
      return MP_OKAY;
   }
  /* First check mod 128 (suppose that DIGIT_BIT is at least 7) */
  if (rem_128[127 & DIGIT(arg,0)] == 1) {
     return MP_OKAY;
  }

   /* Next check mod 105 (3*5*7) */
   if ((err = mp_mod_d(arg, 105uL, &c)) != MP_OKAY) {
      return err;
   }
   if (rem_105[c] == (char)1) {
      return MP_OKAY;
   }
  /* Next check mod 105 (3*5*7) */
  if ((res = mp_mod_d(arg,105,&c)) != MP_OKAY) {
     return res;
  }
  if (rem_105[c] == 1) {
     return MP_OKAY;
  }


   if ((err = mp_init_u32(&t, 11u*13u*17u*19u*23u*29u*31u)) != MP_OKAY) {
      return err;
   }
   if ((err = mp_mod(arg, &t, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
   r = mp_get_u32(&t);
   /* Check for other prime modules, note it's not an ERROR but we must
    * free "t" so the easiest way is to goto LBL_ERR.  We know that err
    * is already equal to MP_OKAY from the mp_mod call
    */
   if (((1uL<<(r%11uL)) & 0x5C4uL) != 0uL)         goto LBL_ERR;
   if (((1uL<<(r%13uL)) & 0x9E4uL) != 0uL)         goto LBL_ERR;
   if (((1uL<<(r%17uL)) & 0x5CE8uL) != 0uL)        goto LBL_ERR;
   if (((1uL<<(r%19uL)) & 0x4F50CuL) != 0uL)       goto LBL_ERR;
   if (((1uL<<(r%23uL)) & 0x7ACCA0uL) != 0uL)      goto LBL_ERR;
   if (((1uL<<(r%29uL)) & 0xC2EDD0CuL) != 0uL)     goto LBL_ERR;
   if (((1uL<<(r%31uL)) & 0x6DE2B848uL) != 0uL)    goto LBL_ERR;
  if ((res = mp_init_set_int(&t,11L*13L*17L*19L*23L*29L*31L)) != MP_OKAY) {
     return res;
  }
  if ((res = mp_mod(arg,&t,&t)) != MP_OKAY) {
     goto ERR;
  }
  r = mp_get_int(&t);
  /* Check for other prime modules, note it's not an ERROR but we must
   * free "t" so the easiest way is to goto ERR.  We know that res
   * is already equal to MP_OKAY from the mp_mod call 
   */ 
  if ( (1L<<(r%11)) & 0x5C4L )             goto ERR;
  if ( (1L<<(r%13)) & 0x9E4L )             goto ERR;
  if ( (1L<<(r%17)) & 0x5CE8L )            goto ERR;
  if ( (1L<<(r%19)) & 0x4F50CL )           goto ERR;
  if ( (1L<<(r%23)) & 0x7ACCA0L )          goto ERR;
  if ( (1L<<(r%29)) & 0xC2EDD0CL )         goto ERR;
  if ( (1L<<(r%31)) & 0x6DE2B848L )        goto ERR;

   /* Final check - is sqr(sqrt(arg)) == arg ? */
   if ((err = mp_sqrt(arg, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
   if ((err = mp_sqr(&t, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
  /* Final check - is sqr(sqrt(arg)) == arg ? */
  if ((res = mp_sqrt(arg,&t)) != MP_OKAY) {
     goto ERR;
  }
  if ((res = mp_sqr(&t,&t)) != MP_OKAY) {
     goto ERR;
  }

   *ret = (mp_cmp_mag(&t, arg) == MP_EQ) ? MP_YES : MP_NO;
  *ret = (mp_cmp_mag(&t,arg) == MP_EQ) ? MP_YES : MP_NO;
LBL_ERR:
   mp_clear(&t);
   return err;
ERR:mp_clear(&t);
  return res;
}
#endif

Deleted libtommath/bn_mp_iseven.c.

1
2
3
4
5
6
7
8
9
10










-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_ISEVEN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

mp_bool mp_iseven(const mp_int *a)
{
   return MP_IS_EVEN(a) ? MP_YES : MP_NO;
}
#endif

Deleted libtommath/bn_mp_isodd.c.

1
2
3
4
5
6
7
8
9
10










-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_ISODD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

mp_bool mp_isodd(const mp_int *a)
{
   return MP_IS_ODD(a) ? MP_YES : MP_NO;
}
#endif

Added libtommath/bn_mp_jacobi.c.






































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_JACOBI_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes the jacobi c = (a | n) (or Legendre if n is prime)
 * HAC pp. 73 Algorithm 2.149
 */
int mp_jacobi (mp_int * a, mp_int * p, int *c)
{
  mp_int  a1, p1;
  int     k, s, r, res;
  mp_digit residue;

  /* if p <= 0 return MP_VAL */
  if (mp_cmp_d(p, 0) != MP_GT) {
     return MP_VAL;
  }

  /* step 1.  if a == 0, return 0 */
  if (mp_iszero (a) == 1) {
    *c = 0;
    return MP_OKAY;
  }

  /* step 2.  if a == 1, return 1 */
  if (mp_cmp_d (a, 1) == MP_EQ) {
    *c = 1;
    return MP_OKAY;
  }

  /* default */
  s = 0;

  /* step 3.  write a = a1 * 2**k  */
  if ((res = mp_init_copy (&a1, a)) != MP_OKAY) {
    return res;
  }

  if ((res = mp_init (&p1)) != MP_OKAY) {
    goto LBL_A1;
  }

  /* divide out larger power of two */
  k = mp_cnt_lsb(&a1);
  if ((res = mp_div_2d(&a1, k, &a1, NULL)) != MP_OKAY) {
     goto LBL_P1;
  }

  /* step 4.  if e is even set s=1 */
  if ((k & 1) == 0) {
    s = 1;
  } else {
    /* else set s=1 if p = 1/7 (mod 8) or s=-1 if p = 3/5 (mod 8) */
    residue = p->dp[0] & 7;

    if (residue == 1 || residue == 7) {
      s = 1;
    } else if (residue == 3 || residue == 5) {
      s = -1;
    }
  }

  /* step 5.  if p == 3 (mod 4) *and* a1 == 3 (mod 4) then s = -s */
  if ( ((p->dp[0] & 3) == 3) && ((a1.dp[0] & 3) == 3)) {
    s = -s;
  }

  /* if a1 == 1 we're done */
  if (mp_cmp_d (&a1, 1) == MP_EQ) {
    *c = s;
  } else {
    /* n1 = n mod a1 */
    if ((res = mp_mod (p, &a1, &p1)) != MP_OKAY) {
      goto LBL_P1;
    }
    if ((res = mp_jacobi (&p1, &a1, &r)) != MP_OKAY) {
      goto LBL_P1;
    }
    *c = s * r;
  }

  /* done */
  res = MP_OKAY;
LBL_P1:mp_clear (&p1);
LBL_A1:mp_clear (&a1);
  return res;
}
#endif

Added libtommath/bn_mp_karatsuba_mul.c.




































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_KARATSUBA_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* c = |a| * |b| using Karatsuba Multiplication using 
 * three half size multiplications
 *
 * Let B represent the radix [e.g. 2**DIGIT_BIT] and 
 * let n represent half of the number of digits in 
 * the min(a,b)
 *
 * a = a1 * B**n + a0
 * b = b1 * B**n + b0
 *
 * Then, a * b => 
   a1b1 * B**2n + ((a1 + a0)(b1 + b0) - (a0b0 + a1b1)) * B + a0b0
 *
 * Note that a1b1 and a0b0 are used twice and only need to be 
 * computed once.  So in total three half size (half # of 
 * digit) multiplications are performed, a0b0, a1b1 and 
 * (a1+b1)(a0+b0)
 *
 * Note that a multiplication of half the digits requires
 * 1/4th the number of single precision multiplications so in 
 * total after one call 25% of the single precision multiplications 
 * are saved.  Note also that the call to mp_mul can end up back 
 * in this function if the a0, a1, b0, or b1 are above the threshold.  
 * This is known as divide-and-conquer and leads to the famous 
 * O(N**lg(3)) or O(N**1.584) work which is asymptopically lower than 
 * the standard O(N**2) that the baseline/comba methods use.  
 * Generally though the overhead of this method doesn't pay off 
 * until a certain size (N ~ 80) is reached.
 */
int mp_karatsuba_mul (mp_int * a, mp_int * b, mp_int * c)
{
  mp_int  x0, x1, y0, y1, t1, x0y0, x1y1;
  int     B, err;

  /* default the return code to an error */
  err = MP_MEM;

  /* min # of digits */
  B = MIN (a->used, b->used);

  /* now divide in two */
  B = B >> 1;

  /* init copy all the temps */
  if (mp_init_size (&x0, B) != MP_OKAY)
    goto ERR;
  if (mp_init_size (&x1, a->used - B) != MP_OKAY)
    goto X0;
  if (mp_init_size (&y0, B) != MP_OKAY)
    goto X1;
  if (mp_init_size (&y1, b->used - B) != MP_OKAY)
    goto Y0;

  /* init temps */
  if (mp_init_size (&t1, B * 2) != MP_OKAY)
    goto Y1;
  if (mp_init_size (&x0y0, B * 2) != MP_OKAY)
    goto T1;
  if (mp_init_size (&x1y1, B * 2) != MP_OKAY)
    goto X0Y0;

  /* now shift the digits */
  x0.used = y0.used = B;
  x1.used = a->used - B;
  y1.used = b->used - B;

  {
    register int x;
    register mp_digit *tmpa, *tmpb, *tmpx, *tmpy;

    /* we copy the digits directly instead of using higher level functions
     * since we also need to shift the digits
     */
    tmpa = a->dp;
    tmpb = b->dp;

    tmpx = x0.dp;
    tmpy = y0.dp;
    for (x = 0; x < B; x++) {
      *tmpx++ = *tmpa++;
      *tmpy++ = *tmpb++;
    }

    tmpx = x1.dp;
    for (x = B; x < a->used; x++) {
      *tmpx++ = *tmpa++;
    }

    tmpy = y1.dp;
    for (x = B; x < b->used; x++) {
      *tmpy++ = *tmpb++;
    }
  }

  /* only need to clamp the lower words since by definition the 
   * upper words x1/y1 must have a known number of digits
   */
  mp_clamp (&x0);
  mp_clamp (&y0);

  /* now calc the products x0y0 and x1y1 */
  /* after this x0 is no longer required, free temp [x0==t2]! */
  if (mp_mul (&x0, &y0, &x0y0) != MP_OKAY)  
    goto X1Y1;          /* x0y0 = x0*y0 */
  if (mp_mul (&x1, &y1, &x1y1) != MP_OKAY)
    goto X1Y1;          /* x1y1 = x1*y1 */

  /* now calc x1+x0 and y1+y0 */
  if (s_mp_add (&x1, &x0, &t1) != MP_OKAY)
    goto X1Y1;          /* t1 = x1 - x0 */
  if (s_mp_add (&y1, &y0, &x0) != MP_OKAY)
    goto X1Y1;          /* t2 = y1 - y0 */
  if (mp_mul (&t1, &x0, &t1) != MP_OKAY)
    goto X1Y1;          /* t1 = (x1 + x0) * (y1 + y0) */

  /* add x0y0 */
  if (mp_add (&x0y0, &x1y1, &x0) != MP_OKAY)
    goto X1Y1;          /* t2 = x0y0 + x1y1 */
  if (s_mp_sub (&t1, &x0, &t1) != MP_OKAY)
    goto X1Y1;          /* t1 = (x1+x0)*(y1+y0) - (x1y1 + x0y0) */

  /* shift by B */
  if (mp_lshd (&t1, B) != MP_OKAY)
    goto X1Y1;          /* t1 = (x0y0 + x1y1 - (x1-x0)*(y1-y0))<<B */
  if (mp_lshd (&x1y1, B * 2) != MP_OKAY)
    goto X1Y1;          /* x1y1 = x1y1 << 2*B */

  if (mp_add (&x0y0, &t1, &t1) != MP_OKAY)
    goto X1Y1;          /* t1 = x0y0 + t1 */
  if (mp_add (&t1, &x1y1, c) != MP_OKAY)
    goto X1Y1;          /* t1 = x0y0 + t1 + x1y1 */

  /* Algorithm succeeded set the return code to MP_OKAY */
  err = MP_OKAY;

X1Y1:mp_clear (&x1y1);
X0Y0:mp_clear (&x0y0);
T1:mp_clear (&t1);
Y1:mp_clear (&y1);
Y0:mp_clear (&y0);
X1:mp_clear (&x1);
X0:mp_clear (&x0);
ERR:
  return err;
}
#endif

Added libtommath/bn_mp_karatsuba_sqr.c.






















































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_KARATSUBA_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* Karatsuba squaring, computes b = a*a using three 
 * half size squarings
 *
 * See comments of karatsuba_mul for details.  It 
 * is essentially the same algorithm but merely 
 * tuned to perform recursive squarings.
 */
int mp_karatsuba_sqr (mp_int * a, mp_int * b)
{
  mp_int  x0, x1, t1, t2, x0x0, x1x1;
  int     B, err;

  err = MP_MEM;

  /* min # of digits */
  B = a->used;

  /* now divide in two */
  B = B >> 1;

  /* init copy all the temps */
  if (mp_init_size (&x0, B) != MP_OKAY)
    goto ERR;
  if (mp_init_size (&x1, a->used - B) != MP_OKAY)
    goto X0;

  /* init temps */
  if (mp_init_size (&t1, a->used * 2) != MP_OKAY)
    goto X1;
  if (mp_init_size (&t2, a->used * 2) != MP_OKAY)
    goto T1;
  if (mp_init_size (&x0x0, B * 2) != MP_OKAY)
    goto T2;
  if (mp_init_size (&x1x1, (a->used - B) * 2) != MP_OKAY)
    goto X0X0;

  {
    register int x;
    register mp_digit *dst, *src;

    src = a->dp;

    /* now shift the digits */
    dst = x0.dp;
    for (x = 0; x < B; x++) {
      *dst++ = *src++;
    }

    dst = x1.dp;
    for (x = B; x < a->used; x++) {
      *dst++ = *src++;
    }
  }

  x0.used = B;
  x1.used = a->used - B;

  mp_clamp (&x0);

  /* now calc the products x0*x0 and x1*x1 */
  if (mp_sqr (&x0, &x0x0) != MP_OKAY)
    goto X1X1;           /* x0x0 = x0*x0 */
  if (mp_sqr (&x1, &x1x1) != MP_OKAY)
    goto X1X1;           /* x1x1 = x1*x1 */

  /* now calc (x1+x0)**2 */
  if (s_mp_add (&x1, &x0, &t1) != MP_OKAY)
    goto X1X1;           /* t1 = x1 - x0 */
  if (mp_sqr (&t1, &t1) != MP_OKAY)
    goto X1X1;           /* t1 = (x1 - x0) * (x1 - x0) */

  /* add x0y0 */
  if (s_mp_add (&x0x0, &x1x1, &t2) != MP_OKAY)
    goto X1X1;           /* t2 = x0x0 + x1x1 */
  if (s_mp_sub (&t1, &t2, &t1) != MP_OKAY)
    goto X1X1;           /* t1 = (x1+x0)**2 - (x0x0 + x1x1) */

  /* shift by B */
  if (mp_lshd (&t1, B) != MP_OKAY)
    goto X1X1;           /* t1 = (x0x0 + x1x1 - (x1-x0)*(x1-x0))<<B */
  if (mp_lshd (&x1x1, B * 2) != MP_OKAY)
    goto X1X1;           /* x1x1 = x1x1 << 2*B */

  if (mp_add (&x0x0, &t1, &t1) != MP_OKAY)
    goto X1X1;           /* t1 = x0x0 + t1 */
  if (mp_add (&t1, &x1x1, b) != MP_OKAY)
    goto X1X1;           /* t1 = x0x0 + t1 + x1x1 */

  err = MP_OKAY;

X1X1:mp_clear (&x1x1);
X0X0:mp_clear (&x0x0);
T2:mp_clear (&t2);
T1:mp_clear (&t1);
X1:mp_clear (&x1);
X0:mp_clear (&x0);
ERR:
  return err;
}
#endif

Deleted libtommath/bn_mp_kronecker.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129

































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_KRONECKER_C

/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/*
   Kronecker symbol (a|p)
   Straightforward implementation of algorithm 1.4.10 in
   Henri Cohen: "A Course in Computational Algebraic Number Theory"

   @book{cohen2013course,
     title={A course in computational algebraic number theory},
     author={Cohen, Henri},
     volume={138},
     year={2013},
     publisher={Springer Science \& Business Media}
    }
 */
mp_err mp_kronecker(const mp_int *a, const mp_int *p, int *c)
{
   mp_int a1, p1, r;
   mp_err err;
   int v, k;

   static const int table[8] = {0, 1, 0, -1, 0, -1, 0, 1};

   if (MP_IS_ZERO(p)) {
      if ((a->used == 1) && (a->dp[0] == 1u)) {
         *c = 1;
      } else {
         *c = 0;
      }
      return MP_OKAY;
   }

   if (MP_IS_EVEN(a) && MP_IS_EVEN(p)) {
      *c = 0;
      return MP_OKAY;
   }

   if ((err = mp_init_copy(&a1, a)) != MP_OKAY) {
      return err;
   }
   if ((err = mp_init_copy(&p1, p)) != MP_OKAY) {
      goto LBL_KRON_0;
   }

   v = mp_cnt_lsb(&p1);
   if ((err = mp_div_2d(&p1, v, &p1, NULL)) != MP_OKAY) {
      goto LBL_KRON_1;
   }

   if ((v & 1) == 0) {
      k = 1;
   } else {
      k = table[a->dp[0] & 7u];
   }

   if (p1.sign == MP_NEG) {
      p1.sign = MP_ZPOS;
      if (a1.sign == MP_NEG) {
         k = -k;
      }
   }

   if ((err = mp_init(&r)) != MP_OKAY) {
      goto LBL_KRON_1;
   }

   for (;;) {
      if (MP_IS_ZERO(&a1)) {
         if (mp_cmp_d(&p1, 1uL) == MP_EQ) {
            *c = k;
            goto LBL_KRON;
         } else {
            *c = 0;
            goto LBL_KRON;
         }
      }

      v = mp_cnt_lsb(&a1);
      if ((err = mp_div_2d(&a1, v, &a1, NULL)) != MP_OKAY) {
         goto LBL_KRON;
      }

      if ((v & 1) == 1) {
         k = k * table[p1.dp[0] & 7u];
      }

      if (a1.sign == MP_NEG) {
         /*
          * Compute k = (-1)^((a1)*(p1-1)/4) * k
          * a1.dp[0] + 1 cannot overflow because the MSB
          * of the type mp_digit is not set by definition
          */
         if (((a1.dp[0] + 1u) & p1.dp[0] & 2u) != 0u) {
            k = -k;
         }
      } else {
         /* compute k = (-1)^((a1-1)*(p1-1)/4) * k */
         if ((a1.dp[0] & p1.dp[0] & 2u) != 0u) {
            k = -k;
         }
      }

      if ((err = mp_copy(&a1, &r)) != MP_OKAY) {
         goto LBL_KRON;
      }
      r.sign = MP_ZPOS;
      if ((err = mp_mod(&p1, &r, &a1)) != MP_OKAY) {
         goto LBL_KRON;
      }
      if ((err = mp_copy(&r, &p1)) != MP_OKAY) {
         goto LBL_KRON;
      }
   }

LBL_KRON:
   mp_clear(&r);
LBL_KRON_1:
   mp_clear(&p1);
LBL_KRON_0:
   mp_clear(&a1);

   return err;
}

#endif

Changes to libtommath/bn_mp_lcm.c.

1

2
3

4













5
6
7

8
9
10


11
12
13
14
15



16
17
18
19
20




21
22
23
24
25
26
27
28
29
30
31
32
33
34
35














36
37
38


39
40
41
42


43
44

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
+
+


-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+


-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_LCM_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes least common multiple as |a*b|/(a, b) */
mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c)
int mp_lcm (mp_int * a, mp_int * b, mp_int * c)
{
   mp_err  err;
   mp_int  t1, t2;
  int     res;
  mp_int  t1, t2;


   if ((err = mp_init_multi(&t1, &t2, NULL)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init_multi (&t1, &t2, NULL)) != MP_OKAY) {
    return res;
  }

   /* t1 = get the GCD of the two inputs */
   if ((err = mp_gcd(a, b, &t1)) != MP_OKAY) {
      goto LBL_T;
   }
  /* t1 = get the GCD of the two inputs */
  if ((res = mp_gcd (a, b, &t1)) != MP_OKAY) {
    goto LBL_T;
  }

   /* divide the smallest by the GCD */
   if (mp_cmp_mag(a, b) == MP_LT) {
      /* store quotient in t2 such that t2 * b is the LCM */
      if ((err = mp_div(a, &t1, &t2, NULL)) != MP_OKAY) {
         goto LBL_T;
      }
      err = mp_mul(b, &t2, c);
   } else {
      /* store quotient in t2 such that t2 * a is the LCM */
      if ((err = mp_div(b, &t1, &t2, NULL)) != MP_OKAY) {
         goto LBL_T;
      }
      err = mp_mul(a, &t2, c);
   }
  /* divide the smallest by the GCD */
  if (mp_cmp_mag(a, b) == MP_LT) {
     /* store quotient in t2 such that t2 * b is the LCM */
     if ((res = mp_div(a, &t1, &t2, NULL)) != MP_OKAY) {
        goto LBL_T;
     }
     res = mp_mul(b, &t2, c);
  } else {
     /* store quotient in t2 such that t2 * a is the LCM */
     if ((res = mp_div(b, &t1, &t2, NULL)) != MP_OKAY) {
        goto LBL_T;
     }
     res = mp_mul(a, &t2, c);
  }

   /* fix the sign to positive */
   c->sign = MP_ZPOS;
  /* fix the sign to positive */
  c->sign = MP_ZPOS;

LBL_T:
   mp_clear_multi(&t1, &t2, NULL);
   return err;
  mp_clear_multi (&t1, &t2, NULL);
  return res;
}
#endif

Deleted libtommath/bn_mp_log_u32.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180




















































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_LOG_U32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Compute log_{base}(a) */
static mp_word s_pow(mp_word base, mp_word exponent)
{
   mp_word result = 1u;
   while (exponent != 0u) {
      if ((exponent & 1u) == 1u) {
         result *= base;
      }
      exponent >>= 1;
      base *= base;
   }

   return result;
}

static mp_digit s_digit_ilogb(mp_digit base, mp_digit n)
{
   mp_word bracket_low = 1u, bracket_mid, bracket_high, N;
   mp_digit ret, high = 1u, low = 0uL, mid;

   if (n < base) {
      return 0uL;
   }
   if (n == base) {
      return 1uL;
   }

   bracket_high = (mp_word) base ;
   N = (mp_word) n;

   while (bracket_high < N) {
      low = high;
      bracket_low = bracket_high;
      high <<= 1;
      bracket_high *= bracket_high;
   }

   while (((mp_digit)(high - low)) > 1u) {
      mid = (low + high) >> 1;
      bracket_mid = bracket_low * s_pow(base, (mp_word)(mid - low));

      if (N < bracket_mid) {
         high = mid ;
         bracket_high = bracket_mid ;
      }
      if (N > bracket_mid) {
         low = mid ;
         bracket_low = bracket_mid ;
      }
      if (N == bracket_mid) {
         return (mp_digit) mid;
      }
   }

   if (bracket_high == N) {
      ret = high;
   } else {
      ret = low;
   }

   return ret;
}

/* TODO: output could be "int" because the output of mp_radix_size is int, too,
         as is the output of mp_bitcount.
         With the same problem: max size is INT_MAX * MP_DIGIT not INT_MAX only!
*/
mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c)
{
   mp_err err;
   mp_ord cmp;
   uint32_t high, low, mid;
   mp_int bracket_low, bracket_high, bracket_mid, t, bi_base;

   err = MP_OKAY;

   if (a->sign == MP_NEG) {
      return MP_VAL;
   }

   if (MP_IS_ZERO(a)) {
      return MP_VAL;
   }

   if (base < 2u) {
      return MP_VAL;
   }

   /* A small shortcut for bases that are powers of two. */
   if ((base & (base - 1u)) == 0u) {
      int y, bit_count;
      for (y=0; (y < 7) && ((base & 1u) == 0u); y++) {
         base >>= 1;
      }
      bit_count = mp_count_bits(a) - 1;
      *c = (uint32_t)(bit_count/y);
      return MP_OKAY;
   }

   if (a->used == 1) {
      *c = (uint32_t)s_digit_ilogb(base, a->dp[0]);
      return err;
   }

   cmp = mp_cmp_d(a, base);
   if ((cmp == MP_LT) || (cmp == MP_EQ)) {
      *c = cmp == MP_EQ;
      return err;
   }

   if ((err =
           mp_init_multi(&bracket_low, &bracket_high,
                         &bracket_mid, &t, &bi_base, NULL)) != MP_OKAY) {
      return err;
   }

   low = 0u;
   mp_set(&bracket_low, 1uL);
   high = 1u;

   mp_set(&bracket_high, base);

   /*
       A kind of Giant-step/baby-step algorithm.
       Idea shamelessly stolen from https://programmingpraxis.com/2010/05/07/integer-logarithms/2/
       The effect is asymptotic, hence needs benchmarks to test if the Giant-step should be skipped
       for small n.
    */
   while (mp_cmp(&bracket_high, a) == MP_LT) {
      low = high;
      if ((err = mp_copy(&bracket_high, &bracket_low)) != MP_OKAY) {
         goto LBL_ERR;
      }
      high <<= 1;
      if ((err = mp_sqr(&bracket_high, &bracket_high)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }
   mp_set(&bi_base, base);

   while ((high - low) > 1u) {
      mid = (high + low) >> 1;

      if ((err = mp_expt_u32(&bi_base, (uint32_t)(mid - low), &t)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_mul(&bracket_low, &t, &bracket_mid)) != MP_OKAY) {
         goto LBL_ERR;
      }
      cmp = mp_cmp(a, &bracket_mid);
      if (cmp == MP_LT) {
         high = mid;
         mp_exch(&bracket_mid, &bracket_high);
      }
      if (cmp == MP_GT) {
         low = mid;
         mp_exch(&bracket_mid, &bracket_low);
      }
      if (cmp == MP_EQ) {
         *c = mid;
         goto LBL_END;
      }
   }

   *c = (mp_cmp(&bracket_high, a) == MP_EQ) ? high : low;

LBL_END:
LBL_ERR:
   mp_clear_multi(&bracket_low, &bracket_high, &bracket_mid,
                  &t, &bi_base, NULL);
   return err;
}


#endif

Changes to libtommath/bn_mp_lshd.c.

1

2
3

4













5
6
7

8
9

10
11
12
13
14
15
16




17
18
19
20

21
22
23
24
25
26
27






28



29
30


31
32
33


34
35
36


37
38
39
40
41
42





43
44

45
46
47
48
49







50
51

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+
-
-

-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+

+
+
+
-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_LSHD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* shift left a certain amount of digits */
mp_err mp_lshd(mp_int *a, int b)
int mp_lshd (mp_int * a, int b)
{
   int x;
  int     x, res;
   mp_err err;
   mp_digit *top, *bottom;

   /* if its less than zero return */
   if (b <= 0) {
      return MP_OKAY;
   }
  /* if its less than zero return */
  if (b <= 0) {
    return MP_OKAY;
  }
   /* no need to shift 0 around */
   if (MP_IS_ZERO(a)) {
      return MP_OKAY;
   }


   /* grow to fit the new digits */
   if (a->alloc < (a->used + b)) {
      if ((err = mp_grow(a, a->used + b)) != MP_OKAY) {
         return err;
      }
   }
  /* grow to fit the new digits */
  if (a->alloc < a->used + b) {
     if ((res = mp_grow (a, a->used + b)) != MP_OKAY) {
       return res;
     }
  }

  {
    register mp_digit *top, *bottom;

   /* increment the used by the shift amount then copy upwards */
   a->used += b;
    /* increment the used by the shift amount then copy upwards */
    a->used += b;

   /* top */
   top = a->dp + a->used - 1;
    /* top */
    top = a->dp + a->used - 1;

   /* base */
   bottom = (a->dp + a->used - 1) - b;
    /* base */
    bottom = a->dp + a->used - 1 - b;

   /* much like mp_rshd this is implemented using a sliding window
    * except the window goes the otherway around.  Copying from
    * the bottom to the top.  see bn_mp_rshd.c for more info.
    */
   for (x = a->used - 1; x >= b; x--) {
    /* much like mp_rshd this is implemented using a sliding window
     * except the window goes the otherway around.  Copying from
     * the bottom to the top.  see bn_mp_rshd.c for more info.
     */
    for (x = a->used - 1; x >= b; x--) {
      *top-- = *bottom--;
   }
    }

   /* zero the lower digits */
   MP_ZERO_DIGITS(a->dp, b);

   return MP_OKAY;
    /* zero the lower digits */
    top = a->dp;
    for (x = 0; x < b; x++) {
      *top++ = 0;
    }
  }
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_mod.c.

1

2
3

4
5
6
7

















8
9
10


11
12
13
14



15
16

17
18



19
20

21
22
23
24
25





26
27
28
29


30
31

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
-
+

-
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
+
-
-
+
+
+

-
+
-
-
-
-
-
+
+
+
+
+

-
-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* c = a mod b, 0 <= c < b if b > 0, b < c <= 0 if b < 0 */
mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c)
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* c = a mod b, 0 <= c < b */
int
mp_mod (mp_int * a, mp_int * b, mp_int * c)
{
   mp_int  t;
   mp_err  err;
  mp_int  t;
  int     res;

   if ((err = mp_init_size(&t, b->used)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (&t)) != MP_OKAY) {
    return res;
  }

   if ((err = mp_div(a, b, NULL, &t)) != MP_OKAY) {
  if ((res = mp_div (a, b, NULL, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
    mp_clear (&t);
    return res;
  }

   if (MP_IS_ZERO(&t) || (t.sign == b->sign)) {
  if (t.sign != b->sign) {
      err = MP_OKAY;
      mp_exch(&t, c);
   } else {
      err = mp_add(b, &t, c);
   }
    res = mp_add (b, &t, c);
  } else {
    res = MP_OKAY;
    mp_exch (&t, c);
  }

LBL_ERR:
   mp_clear(&t);
   return err;
  mp_clear (&t);
  return res;
}
#endif

Changes to libtommath/bn_mp_mod_2d.c.

1

2
3

4













5
6

7

8
9

10
11
12
13
14
15
16





17
18
19
20
21





22
23
24
25
26




27
28
29
30
31
32
33
34
35
36









37
38

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
+
-

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MOD_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* calc a value mod 2**b */
int
mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c)
mp_mod_2d (mp_int * a, int b, mp_int * c)
{
   int x;
  int     x, res;
   mp_err err;

   /* if b is <= 0 then zero the int */
   if (b <= 0) {
      mp_zero(c);
      return MP_OKAY;
   }
  /* if b is <= 0 then zero the int */
  if (b <= 0) {
    mp_zero (c);
    return MP_OKAY;
  }

   /* if the modulus is larger than the value than return */
   if (b >= (a->used * MP_DIGIT_BIT)) {
      return mp_copy(a, c);
   }
  /* if the modulus is larger than the value than return */
  if (b >= (int) (a->used * DIGIT_BIT)) {
    res = mp_copy (a, c);
    return res;
  }

   /* copy */
   if ((err = mp_copy(a, c)) != MP_OKAY) {
      return err;
   }
  /* copy */
  if ((res = mp_copy (a, c)) != MP_OKAY) {
    return res;
  }

   /* zero digits above the last digit of the modulus */
   x = (b / MP_DIGIT_BIT) + (((b % MP_DIGIT_BIT) == 0) ? 0 : 1);
   MP_ZERO_DIGITS(c->dp + x, c->used - x);

   /* clear the digit that is not completely outside/inside the modulus */
   c->dp[b / MP_DIGIT_BIT] &=
      ((mp_digit)1 << (mp_digit)(b % MP_DIGIT_BIT)) - (mp_digit)1;
   mp_clamp(c);
   return MP_OKAY;
  /* zero digits above the last digit of the modulus */
  for (x = (b / DIGIT_BIT) + ((b % DIGIT_BIT) == 0 ? 0 : 1); x < c->used; x++) {
    c->dp[x] = 0;
  }
  /* clear the digit that is not completely outside/inside the modulus */
  c->dp[b / DIGIT_BIT] &=
    (mp_digit) ((((mp_digit) 1) << (((mp_digit) b) % DIGIT_BIT)) - ((mp_digit) 1));
  mp_clamp (c);
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_mod_d.c.

1

2
3

4
5
6
















7
8

9
10

1
2

3



4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

21
22
23
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MOD_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c)
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

int
mp_mod_d (mp_int * a, mp_digit b, mp_digit * c)
{
   return mp_div_d(a, b, NULL, c);
  return mp_div_d(a, b, NULL, c);
}
#endif

Changes to libtommath/bn_mp_montgomery_calc_normalization.c.

1

2
3

4













5
6
7
8
9
10
11
12

13
14

15
16
17
18


19
20
21
22
23
24
25
26
27








28
29
30
31
32
33
34
35
36
37
38
39
40











41
42

43
44

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+

-
+
-

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MONTGOMERY_CALC_NORMALIZATION_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/*
 * shifts with subtractions when the result is greater than b.
 *
 * The method is slightly modified to shift B unconditionally upto just under
 * the leading bit of b.  This saves alot of multiple precision shifting.
 */
mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b)
int mp_montgomery_calc_normalization (mp_int * a, mp_int * b)
{
   int    x, bits;
  int     x, bits, res;
   mp_err err;

   /* how many bits of last digit does b use */
   bits = mp_count_bits(b) % MP_DIGIT_BIT;
  /* how many bits of last digit does b use */
  bits = mp_count_bits (b) % DIGIT_BIT;

   if (b->used > 1) {
      if ((err = mp_2expt(a, ((b->used - 1) * MP_DIGIT_BIT) + bits - 1)) != MP_OKAY) {
         return err;
      }
   } else {
      mp_set(a, 1uL);
      bits = 1;
   }
  if (b->used > 1) {
     if ((res = mp_2expt (a, (b->used - 1) * DIGIT_BIT + bits - 1)) != MP_OKAY) {
        return res;
     }
  } else {
     mp_set(a, 1);
     bits = 1;
  }


   /* now compute C = A * B mod b */
   for (x = bits - 1; x < (int)MP_DIGIT_BIT; x++) {
      if ((err = mp_mul_2(a, a)) != MP_OKAY) {
         return err;
      }
      if (mp_cmp_mag(a, b) != MP_LT) {
         if ((err = s_mp_sub(a, b, a)) != MP_OKAY) {
            return err;
         }
      }
   }
  /* now compute C = A * B mod b */
  for (x = bits - 1; x < (int)DIGIT_BIT; x++) {
    if ((res = mp_mul_2 (a, a)) != MP_OKAY) {
      return res;
    }
    if (mp_cmp_mag (a, b) != MP_LT) {
      if ((res = s_mp_sub (a, b, a)) != MP_OKAY) {
        return res;
      }
    }
  }

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_montgomery_reduce.c.

1

2
3

4













5
6

7

8
9

10
11

12
13
14
15
16
17
18
19
20
21
22
23
24












25
26
27
28
29
30
31
32







33
34
35
36
37
38
39
40
41
42
43










44
45
46
47
48
49





50
51
52


53
54
55


56
57
58


59
60
61
62
63
64





65
66
67


68
69
70
71
72




73
74
75
76
77
78
79
80
81
82








83
84
85
86
87
88
89






90
91
92
93



94
95
96
97
98




99
100

101
102

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
+
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MONTGOMERY_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes xR**-1 == x (mod N) via Montgomery Reduction */
int
mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho)
mp_montgomery_reduce (mp_int * x, mp_int * n, mp_digit rho)
{
   int      ix, digs;
  int     ix, res, digs;
   mp_err   err;
   mp_digit mu;
  mp_digit mu;

   /* can the fast reduction [comba] method be used?
    *
    * Note that unlike in mul you're safely allowed *less*
    * than the available columns [255 per default] since carries
    * are fixed up in the inner loop.
    */
   digs = (n->used * 2) + 1;
   if ((digs < MP_WARRAY) &&
       (x->used <= MP_WARRAY) &&
       (n->used < MP_MAXFAST)) {
      return s_mp_montgomery_reduce_fast(x, n, rho);
   }
  /* can the fast reduction [comba] method be used?
   *
   * Note that unlike in mul you're safely allowed *less*
   * than the available columns [255 per default] since carries
   * are fixed up in the inner loop.
   */
  digs = n->used * 2 + 1;
  if ((digs < MP_WARRAY) &&
      n->used <
      (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) {
    return fast_mp_montgomery_reduce (x, n, rho);
  }

   /* grow the input as required */
   if (x->alloc < digs) {
      if ((err = mp_grow(x, digs)) != MP_OKAY) {
         return err;
      }
   }
   x->used = digs;
  /* grow the input as required */
  if (x->alloc < digs) {
    if ((res = mp_grow (x, digs)) != MP_OKAY) {
      return res;
    }
  }
  x->used = digs;

   for (ix = 0; ix < n->used; ix++) {
      /* mu = ai * rho mod b
       *
       * The value of rho must be precalculated via
       * montgomery_setup() such that
       * it equals -1/n0 mod b this allows the
       * following inner loop to reduce the
       * input one digit at a time
       */
      mu = (mp_digit)(((mp_word)x->dp[ix] * (mp_word)rho) & MP_MASK);
  for (ix = 0; ix < n->used; ix++) {
    /* mu = ai * rho mod b
     *
     * The value of rho must be precalculated via
     * montgomery_setup() such that
     * it equals -1/n0 mod b this allows the
     * following inner loop to reduce the
     * input one digit at a time
     */
    mu = (mp_digit) (((mp_word)x->dp[ix]) * ((mp_word)rho) & MP_MASK);

      /* a = a + mu * m * b**i */
      {
         int iy;
         mp_digit *tmpn, *tmpx, u;
         mp_word r;
    /* a = a + mu * m * b**i */
    {
      register int iy;
      register mp_digit *tmpn, *tmpx, u;
      register mp_word r;

         /* alias for digits of the modulus */
         tmpn = n->dp;
      /* alias for digits of the modulus */
      tmpn = n->dp;

         /* alias for the digits of x [the input] */
         tmpx = x->dp + ix;
      /* alias for the digits of x [the input] */
      tmpx = x->dp + ix;

         /* set the carry to zero */
         u = 0;
      /* set the carry to zero */
      u = 0;

         /* Multiply and add in place */
         for (iy = 0; iy < n->used; iy++) {
            /* compute product and sum */
            r       = ((mp_word)mu * (mp_word)*tmpn++) +
                      (mp_word)u + (mp_word)*tmpx;
      /* Multiply and add in place */
      for (iy = 0; iy < n->used; iy++) {
        /* compute product and sum */
        r       = ((mp_word)mu) * ((mp_word)*tmpn++) +
                  ((mp_word) u) + ((mp_word) * tmpx);

            /* get carry */
            u       = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT);
        /* get carry */
        u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));

            /* fix digit */
            *tmpx++ = (mp_digit)(r & (mp_word)MP_MASK);
         }
         /* At this point the ix'th digit of x should be zero */
        /* fix digit */
        *tmpx++ = (mp_digit)(r & ((mp_word) MP_MASK));
      }
      /* At this point the ix'th digit of x should be zero */


         /* propagate carries upwards as required*/
         while (u != 0u) {
            *tmpx   += u;
            u        = *tmpx >> MP_DIGIT_BIT;
            *tmpx++ &= MP_MASK;
         }
      }
   }
      /* propagate carries upwards as required*/
      while (u) {
        *tmpx   += u;
        u        = *tmpx >> DIGIT_BIT;
        *tmpx++ &= MP_MASK;
      }
    }
  }

   /* at this point the n.used'th least
    * significant digits of x are all zero
    * which means we can shift x to the
    * right by n.used digits and the
    * residue is unchanged.
    */
  /* at this point the n.used'th least
   * significant digits of x are all zero
   * which means we can shift x to the
   * right by n.used digits and the
   * residue is unchanged.
   */

   /* x = x/b**n.used */
   mp_clamp(x);
   mp_rshd(x, n->used);
  /* x = x/b**n.used */
  mp_clamp(x);
  mp_rshd (x, n->used);

   /* if x >= n then x = x - n */
   if (mp_cmp_mag(x, n) != MP_LT) {
      return s_mp_sub(x, n, x);
   }
  /* if x >= n then x = x - n */
  if (mp_cmp_mag (x, n) != MP_LT) {
    return s_mp_sub (x, n, x);
  }

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_montgomery_setup.c.

1

2
3

4
5














6

7

8
9

10
11
12
13
14
15
16
17
18
19









20
21
22
23



24
25
26


27
28

29
30
31

32
33
34

35
36
37
38


39
40

41
42

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+

-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
+


-
+


-
+


-
-
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MONTGOMERY_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* setups the montgomery reduction stuff */
int
mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho)
mp_montgomery_setup (mp_int * n, mp_digit * rho)
{
   mp_digit x, b;
  mp_digit x, b;

   /* fast inversion mod 2**k
    *
    * Based on the fact that
    *
    * XA = 1 (mod 2**n)  =>  (X(2-XA)) A = 1 (mod 2**2n)
    *                    =>  2*X*A - X*X*A*A = 1
    *                    =>  2*(1) - (1)     = 1
    */
   b = n->dp[0];
/* fast inversion mod 2**k
 *
 * Based on the fact that
 *
 * XA = 1 (mod 2**n)  =>  (X(2-XA)) A = 1 (mod 2**2n)
 *                    =>  2*X*A - X*X*A*A = 1
 *                    =>  2*(1) - (1)     = 1
 */
  b = n->dp[0];

   if ((b & 1u) == 0u) {
      return MP_VAL;
   }
  if ((b & 1) == 0) {
    return MP_VAL;
  }

   x = (((b + 2u) & 4u) << 1) + b; /* here x*a==1 mod 2**4 */
   x *= 2u - (b * x);              /* here x*a==1 mod 2**8 */
  x = (((b + 2) & 4) << 1) + b; /* here x*a==1 mod 2**4 */
  x *= 2 - b * x;               /* here x*a==1 mod 2**8 */
#if !defined(MP_8BIT)
   x *= 2u - (b * x);              /* here x*a==1 mod 2**16 */
  x *= 2 - b * x;               /* here x*a==1 mod 2**16 */
#endif
#if defined(MP_64BIT) || !(defined(MP_8BIT) || defined(MP_16BIT))
   x *= 2u - (b * x);              /* here x*a==1 mod 2**32 */
  x *= 2 - b * x;               /* here x*a==1 mod 2**32 */
#endif
#ifdef MP_64BIT
   x *= 2u - (b * x);              /* here x*a==1 mod 2**64 */
  x *= 2 - b * x;               /* here x*a==1 mod 2**64 */
#endif

   /* rho = -1/m mod b */
   *rho = (mp_digit)(((mp_word)1 << (mp_word)MP_DIGIT_BIT) - x) & MP_MASK;
  /* rho = -1/m mod b */
  *rho = (unsigned long)(((mp_word)1 << ((mp_word) DIGIT_BIT)) - x) & MP_MASK;

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_mul.c.

1

2
3

4













5
6
7

8
9
10

11
12
13

14
15
16
17

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52




































53
54

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
+
-
-
-
+

-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* high level multiplication (handles sign) */
mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c)
int mp_mul (mp_int * a, mp_int * b, mp_int * c)
{
   mp_err err;
   int min_len = MP_MIN(a->used, b->used),
  int     res, neg;
       max_len = MP_MAX(a->used, b->used),
       digs = a->used + b->used + 1;
   mp_sign neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;
  neg = (a->sign == b->sign) ? MP_ZPOS : MP_NEG;

   if (a == b) {
       return mp_sqr(a,c);
   } else if (MP_HAS(S_MP_BALANCE_MUL) &&
  /* use Toom-Cook? */
       /* Check sizes. The smaller one needs to be larger than the Karatsuba cut-off.
        * The bigger one needs to be at least about one MP_KARATSUBA_MUL_CUTOFF bigger
        * to make some sense, but it depends on architecture, OS, position of the
        * stars... so YMMV.
        * Using it to cut the input into slices small enough for fast_s_mp_mul_digs
        * was actually slower on the author's machine, but YMMV.
        */
       (min_len >= MP_KARATSUBA_MUL_CUTOFF) &&
       ((max_len / 2) >= MP_KARATSUBA_MUL_CUTOFF) &&
       /* Not much effect was observed below a ratio of 1:2, but again: YMMV. */
       (max_len >= (2 * min_len))) {
      err = s_mp_balance_mul(a,b,c);
   } else if (MP_HAS(S_MP_TOOM_MUL) &&
              (min_len >= MP_TOOM_MUL_CUTOFF)) {
      err = s_mp_toom_mul(a, b, c);
   } else if (MP_HAS(S_MP_KARATSUBA_MUL) &&
              (min_len >= MP_KARATSUBA_MUL_CUTOFF)) {
      err = s_mp_karatsuba_mul(a, b, c);
   } else if (MP_HAS(S_MP_MUL_DIGS_FAST) &&
              /* can we use the fast multiplier?
               *
               * The fast multiplier can be used if the output will
               * have less than MP_WARRAY digits and the number of
               * digits won't affect carry propagation
               */
              (digs < MP_WARRAY) &&
              (min_len <= MP_MAXFAST)) {
      err = s_mp_mul_digs_fast(a, b, c, digs);
   } else if (MP_HAS(S_MP_MUL_DIGS)) {
      err = s_mp_mul_digs(a, b, c, digs);
   } else {
      err = MP_VAL;
   }
   c->sign = (c->used > 0) ? neg : MP_ZPOS;
   return err;
#ifdef BN_MP_TOOM_MUL_C
  if (MIN (a->used, b->used) >= TOOM_MUL_CUTOFF) {
    res = mp_toom_mul(a, b, c);
  } else 
#endif
#ifdef BN_MP_KARATSUBA_MUL_C
  /* use Karatsuba? */
  if (MIN (a->used, b->used) >= KARATSUBA_MUL_CUTOFF) {
    res = mp_karatsuba_mul (a, b, c);
  } else 
#endif
  {
    /* can we use the fast multiplier?
     *
     * The fast multiplier can be used if the output will 
     * have less than MP_WARRAY digits and the number of 
     * digits won't affect carry propagation
     */
    int     digs = a->used + b->used + 1;

#ifdef BN_FAST_S_MP_MUL_DIGS_C
    if ((digs < MP_WARRAY) &&
        MIN(a->used, b->used) <= 
        (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) {
      res = fast_s_mp_mul_digs (a, b, c, digs);
    } else 
#endif
#ifdef BN_S_MP_MUL_DIGS_C
      res = s_mp_mul (a, b, c); /* uses s_mp_mul_digs */
#else
      res = MP_VAL;
#endif

  }
  c->sign = (c->used > 0) ? neg : MP_ZPOS;
  return res;
}
#endif

Changes to libtommath/bn_mp_mul_2.c.

1

2
3

4













5
6
7

8
9

10
11
12
13
14
15
16
17






18
19
20


21
22
23


24
25
26
27
28
29





30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

















48
49
50
51
52
53
54






55
56
57
58
59
60
61
62










63
64

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+
-

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MUL_2_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* b = a*2 */
mp_err mp_mul_2(const mp_int *a, mp_int *b)
int mp_mul_2(mp_int * a, mp_int * b)
{
   int     x, oldused;
  int     x, res, oldused;
   mp_err err;

   /* grow to accomodate result */
   if (b->alloc < (a->used + 1)) {
      if ((err = mp_grow(b, a->used + 1)) != MP_OKAY) {
         return err;
      }
   }
  /* grow to accomodate result */
  if (b->alloc < a->used + 1) {
    if ((res = mp_grow (b, a->used + 1)) != MP_OKAY) {
      return res;
    }
  }

   oldused = b->used;
   b->used = a->used;
  oldused = b->used;
  b->used = a->used;

   {
      mp_digit r, rr, *tmpa, *tmpb;
  {
    register mp_digit r, rr, *tmpa, *tmpb;

      /* alias for source */
      tmpa = a->dp;

      /* alias for dest */
      tmpb = b->dp;
    /* alias for source */
    tmpa = a->dp;
    
    /* alias for dest */
    tmpb = b->dp;

      /* carry */
      r = 0;
      for (x = 0; x < a->used; x++) {

         /* get what will be the *next* carry bit from the
          * MSB of the current digit
          */
         rr = *tmpa >> (mp_digit)(MP_DIGIT_BIT - 1);

         /* now shift up this digit, add in the carry [from the previous] */
         *tmpb++ = ((*tmpa++ << 1uL) | r) & MP_MASK;

         /* copy the carry that would be from the source
          * digit into the next iteration
          */
         r = rr;
      }
    /* carry */
    r = 0;
    for (x = 0; x < a->used; x++) {
    
      /* get what will be the *next* carry bit from the 
       * MSB of the current digit 
       */
      rr = *tmpa >> ((mp_digit)(DIGIT_BIT - 1));
      
      /* now shift up this digit, add in the carry [from the previous] */
      *tmpb++ = ((*tmpa++ << ((mp_digit)1)) | r) & MP_MASK;
      
      /* copy the carry that would be from the source 
       * digit into the next iteration 
       */
      r = rr;
    }

      /* new leading digit? */
      if (r != 0u) {
         /* add a MSB which is always 1 at this point */
         *tmpb = 1;
         ++(b->used);
      }
    /* new leading digit? */
    if (r != 0) {
      /* add a MSB which is always 1 at this point */
      *tmpb = 1;
      ++(b->used);
    }

      /* now zero any excess digits on the destination
       * that we didn't write to
       */
      MP_ZERO_DIGITS(b->dp + b->used, oldused - b->used);
   }
   b->sign = a->sign;
   return MP_OKAY;
    /* now zero any excess digits on the destination 
     * that we didn't write to 
     */
    tmpb = b->dp + b->used;
    for (x = b->used; x < oldused; x++) {
      *tmpb++ = 0;
    }
  }
  b->sign = a->sign;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_mul_2d.c.

1

2
3

4













5
6
7

8
9
10


11
12
13
14
15
16
17






18
19
20
21
22
23





24
25
26
27
28
29
30






31
32
33
34
35
36





37
38
39


40
41
42


43
44
45


46
47
48
49
50
51





52
53
54
55



56
57
58
59
60
61
62
63
64
65
66
67











68
69

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MUL_2D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* shift left by a certain bit count */
mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c)
int mp_mul_2d (mp_int * a, int b, mp_int * c)
{
   mp_digit d;
   mp_err   err;
  mp_digit d;
  int      res;

   /* copy */
   if (a != c) {
      if ((err = mp_copy(a, c)) != MP_OKAY) {
         return err;
      }
   }
  /* copy */
  if (a != c) {
     if ((res = mp_copy (a, c)) != MP_OKAY) {
       return res;
     }
  }

   if (c->alloc < (c->used + (b / MP_DIGIT_BIT) + 1)) {
      if ((err = mp_grow(c, c->used + (b / MP_DIGIT_BIT) + 1)) != MP_OKAY) {
         return err;
      }
   }
  if (c->alloc < (int)(c->used + b/DIGIT_BIT + 1)) {
     if ((res = mp_grow (c, c->used + b / DIGIT_BIT + 1)) != MP_OKAY) {
       return res;
     }
  }

   /* shift by as many digits in the bit count */
   if (b >= MP_DIGIT_BIT) {
      if ((err = mp_lshd(c, b / MP_DIGIT_BIT)) != MP_OKAY) {
         return err;
      }
   }
  /* shift by as many digits in the bit count */
  if (b >= (int)DIGIT_BIT) {
    if ((res = mp_lshd (c, b / DIGIT_BIT)) != MP_OKAY) {
      return res;
    }
  }

   /* shift any bit count < MP_DIGIT_BIT */
   d = (mp_digit)(b % MP_DIGIT_BIT);
   if (d != 0u) {
      mp_digit *tmpc, shift, mask, r, rr;
      int x;
  /* shift any bit count < DIGIT_BIT */
  d = (mp_digit) (b % DIGIT_BIT);
  if (d != 0) {
    register mp_digit *tmpc, shift, mask, r, rr;
    register int x;

      /* bitmask for carries */
      mask = ((mp_digit)1 << d) - (mp_digit)1;
    /* bitmask for carries */
    mask = (((mp_digit)1) << d) - 1;

      /* shift for msbs */
      shift = (mp_digit)MP_DIGIT_BIT - d;
    /* shift for msbs */
    shift = DIGIT_BIT - d;

      /* alias */
      tmpc = c->dp;
    /* alias */
    tmpc = c->dp;

      /* carry */
      r    = 0;
      for (x = 0; x < c->used; x++) {
         /* get the higher bits of the current word */
         rr = (*tmpc >> shift) & mask;
    /* carry */
    r    = 0;
    for (x = 0; x < c->used; x++) {
      /* get the higher bits of the current word */
      rr = (*tmpc >> shift) & mask;

         /* shift the current word and OR in the carry */
         *tmpc = ((*tmpc << d) | r) & MP_MASK;
         ++tmpc;
      /* shift the current word and OR in the carry */
      *tmpc = ((*tmpc << d) | r) & MP_MASK;
      ++tmpc;

         /* set the carry to the carry bits of the current word */
         r = rr;
      }

      /* set final carry */
      if (r != 0u) {
         c->dp[(c->used)++] = r;
      }
   }
   mp_clamp(c);
   return MP_OKAY;
      /* set the carry to the carry bits of the current word */
      r = rr;
    }
    
    /* set final carry */
    if (r != 0) {
       c->dp[(c->used)++] = r;
    }
  }
  mp_clamp (c);
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_mul_d.c.

1

2
3

4













5
6

7

8
9
10


11
12

13
14
15
16
17
18
19






20
21
22


23
24
25


26
27
28


29
30
31


32
33
34


35
36
37
38
39




40
41
42


43
44
45
46



47
48
49
50



51
52
53
54
55
56
57








58
59

60
61

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
-
+
+
-
-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MUL_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* multiply by a digit */
int
mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c)
mp_mul_d (mp_int * a, mp_digit b, mp_int * c)
{
   mp_digit u, *tmpa, *tmpc;
   mp_word  r;
  mp_digit u, *tmpa, *tmpc;
  mp_word  r;
   mp_err   err;
   int      ix, olduse;
  int      ix, res, olduse;

   /* make sure c is big enough to hold a*b */
   if (c->alloc < (a->used + 1)) {
      if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) {
         return err;
      }
   }
  /* make sure c is big enough to hold a*b */
  if (c->alloc < a->used + 1) {
    if ((res = mp_grow (c, a->used + 1)) != MP_OKAY) {
      return res;
    }
  }

   /* get the original destinations used count */
   olduse = c->used;
  /* get the original destinations used count */
  olduse = c->used;

   /* set the sign */
   c->sign = a->sign;
  /* set the sign */
  c->sign = a->sign;

   /* alias for a->dp [source] */
   tmpa = a->dp;
  /* alias for a->dp [source] */
  tmpa = a->dp;

   /* alias for c->dp [dest] */
   tmpc = c->dp;
  /* alias for c->dp [dest] */
  tmpc = c->dp;

   /* zero carry */
   u = 0;
  /* zero carry */
  u = 0;

   /* compute columns */
   for (ix = 0; ix < a->used; ix++) {
      /* compute product and carry sum for this term */
      r       = (mp_word)u + ((mp_word)*tmpa++ * (mp_word)b);
  /* compute columns */
  for (ix = 0; ix < a->used; ix++) {
    /* compute product and carry sum for this term */
    r       = ((mp_word) u) + ((mp_word)*tmpa++) * ((mp_word)b);

      /* mask off higher bits to get a single digit */
      *tmpc++ = (mp_digit)(r & (mp_word)MP_MASK);
    /* mask off higher bits to get a single digit */
    *tmpc++ = (mp_digit) (r & ((mp_word) MP_MASK));

      /* send carry into next iteration */
      u       = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT);
   }
    /* send carry into next iteration */
    u       = (mp_digit) (r >> ((mp_word) DIGIT_BIT));
  }

   /* store final carry [if any] and increment ix offset  */
   *tmpc++ = u;
   ++ix;
  /* store final carry [if any] and increment ix offset  */
  *tmpc++ = u;
  ++ix;

   /* now zero digits above the top */
   MP_ZERO_DIGITS(tmpc, olduse - ix);

   /* set used count */
   c->used = a->used + 1;
   mp_clamp(c);
  /* now zero digits above the top */
  while (ix++ < olduse) {
     *tmpc++ = 0;
  }

  /* set used count */
  c->used = a->used + 1;
  mp_clamp(c);

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_mulmod.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

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
+
+

-
-
-
+
+
+

-
+
-
-
-
+
+
+
+
-
-
-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_MULMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* d = a * b (mod c) */
mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d)
int mp_mulmod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
{
   mp_err err;
   mp_int t;
  int     res;
  mp_int  t;

   if ((err = mp_init_size(&t, c->used)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (&t)) != MP_OKAY) {
    return res;
  }

   if ((err = mp_mul(a, b, &t)) != MP_OKAY) {
  if ((res = mp_mul (a, b, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
   err = mp_mod(&t, c, d);
    mp_clear (&t);
    return res;
  }
  res = mp_mod (&t, c, d);

LBL_ERR:
   mp_clear(&t);
   return err;
  mp_clear (&t);
  return res;
}
#endif

Added libtommath/bn_mp_n_root.c.

































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_N_ROOT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* find the n'th root of an integer 
 *
 * Result found such that (c)**b <= a and (c+1)**b > a 
 *
 * This algorithm uses Newton's approximation 
 * x[i+1] = x[i] - f(x[i])/f'(x[i]) 
 * which will find the root in log(N) time where 
 * each step involves a fair bit.  This is not meant to 
 * find huge roots [square and cube, etc].
 */
int mp_n_root (mp_int * a, mp_digit b, mp_int * c)
{
  mp_int  t1, t2, t3;
  int     res, neg;

  /* input must be positive if b is even */
  if ((b & 1) == 0 && a->sign == MP_NEG) {
    return MP_VAL;
  }

  if ((res = mp_init (&t1)) != MP_OKAY) {
    return res;
  }

  if ((res = mp_init (&t2)) != MP_OKAY) {
    goto LBL_T1;
  }

  if ((res = mp_init (&t3)) != MP_OKAY) {
    goto LBL_T2;
  }

  /* if a is negative fudge the sign but keep track */
  neg     = a->sign;
  a->sign = MP_ZPOS;

  /* t2 = 2 */
  mp_set (&t2, 2);

  do {
    /* t1 = t2 */
    if ((res = mp_copy (&t2, &t1)) != MP_OKAY) {
      goto LBL_T3;
    }

    /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */
    
    /* t3 = t1**(b-1) */
    if ((res = mp_expt_d (&t1, b - 1, &t3)) != MP_OKAY) {   
      goto LBL_T3;
    }

    /* numerator */
    /* t2 = t1**b */
    if ((res = mp_mul (&t3, &t1, &t2)) != MP_OKAY) {    
      goto LBL_T3;
    }

    /* t2 = t1**b - a */
    if ((res = mp_sub (&t2, a, &t2)) != MP_OKAY) {  
      goto LBL_T3;
    }

    /* denominator */
    /* t3 = t1**(b-1) * b  */
    if ((res = mp_mul_d (&t3, b, &t3)) != MP_OKAY) {    
      goto LBL_T3;
    }

    /* t3 = (t1**b - a)/(b * t1**(b-1)) */
    if ((res = mp_div (&t2, &t3, &t3, NULL)) != MP_OKAY) {  
      goto LBL_T3;
    }

    if ((res = mp_sub (&t1, &t3, &t2)) != MP_OKAY) {
      goto LBL_T3;
    }
  }  while (mp_cmp (&t1, &t2) != MP_EQ);

  /* result can be off by a few so check */
  for (;;) {
    if ((res = mp_expt_d (&t1, b, &t2)) != MP_OKAY) {
      goto LBL_T3;
    }

    if (mp_cmp (&t2, a) == MP_GT) {
      if ((res = mp_sub_d (&t1, 1, &t1)) != MP_OKAY) {
         goto LBL_T3;
      }
    } else {
      break;
    }
  }

  /* reset the sign of a first */
  a->sign = neg;

  /* set the result */
  mp_exch (&t1, c);

  /* set the sign of the result */
  c->sign = neg;

  res = MP_OKAY;

LBL_T3:mp_clear (&t3);
LBL_T2:mp_clear (&t2);
LBL_T1:mp_clear (&t1);
  return res;
}
#endif

Changes to libtommath/bn_mp_neg.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

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_NEG_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* b = -a */
mp_err mp_neg(const mp_int *a, mp_int *b)
int mp_neg (mp_int * a, mp_int * b)
{
   mp_err err;
   if (a != b) {
      if ((err = mp_copy(a, b)) != MP_OKAY) {
         return err;
      }
   }
  int     res;
  if (a != b) {
     if ((res = mp_copy (a, b)) != MP_OKAY) {
        return res;
     }
  }

   if (!MP_IS_ZERO(b)) {
      b->sign = (a->sign == MP_ZPOS) ? MP_NEG : MP_ZPOS;
   } else {
      b->sign = MP_ZPOS;
   }
  if (mp_iszero(b) != MP_YES) {
     b->sign = (a->sign == MP_ZPOS) ? MP_NEG : MP_ZPOS;
  } else {
     b->sign = MP_ZPOS;
  }

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_or.c.

1

2
3
4
5
6
7
8
9

10
11
12
13
14
15
16

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
-
+







-
+







#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_OR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* two complement or */
mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c)
{
   int used = MP_MAX(a->used, b->used) + 1, i;
   int used = MAX(a->used, b->used) + 1, i;
   mp_err err;
   mp_digit ac = 1, bc = 1, cc = 1;
   mp_sign csign = ((a->sign == MP_NEG) || (b->sign == MP_NEG)) ? MP_NEG : MP_ZPOS;

   if (c->alloc < used) {
      if ((err = mp_grow(c, used)) != MP_OKAY) {
         return err;

Deleted libtommath/bn_mp_pack.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69





































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_PACK_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* based on gmp's mpz_export.
 * see http://gmplib.org/manual/Integer-Import-and-Export.html
 */
mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size,
               mp_endian endian, size_t nails, const mp_int *op)
{
   mp_err err;
   size_t odd_nails, nail_bytes, i, j, count;
   unsigned char odd_nail_mask;

   mp_int t;

   count = mp_pack_count(op, nails, size);

   if (count > maxcount) {
      return MP_BUF;
   }

   if ((err = mp_init_copy(&t, op)) != MP_OKAY) {
      return err;
   }

   if (endian == MP_NATIVE_ENDIAN) {
      MP_GET_ENDIANNESS(endian);
   }

   odd_nails = (nails % 8u);
   odd_nail_mask = 0xff;
   for (i = 0u; i < odd_nails; ++i) {
      odd_nail_mask ^= (unsigned char)(1u << (7u - i));
   }
   nail_bytes = nails / 8u;

   for (i = 0u; i < count; ++i) {
      for (j = 0u; j < size; ++j) {
         unsigned char *byte = (unsigned char *)rop +
                               (((order == MP_LSB_FIRST) ? i : ((count - 1u) - i)) * size) +
                               ((endian == MP_LITTLE_ENDIAN) ? j : ((size - 1u) - j));

         if (j >= (size - nail_bytes)) {
            *byte = 0;
            continue;
         }

         *byte = (unsigned char)((j == ((size - nail_bytes) - 1u)) ? (t.dp[0] & odd_nail_mask) : (t.dp[0] & 0xFFuL));

         if ((err = mp_div_2d(&t, (j == ((size - nail_bytes) - 1u)) ? (int)(8u - odd_nails) : 8, &t, NULL)) != MP_OKAY) {
            goto LBL_ERR;
         }

      }
   }

   if (written != NULL) {
      *written = count;
   }
   err = MP_OKAY;

LBL_ERR:
   mp_clear(&t);
   return err;
}

#endif

Deleted libtommath/bn_mp_pack_count.c.

1
2
3
4
5
6
7
8
9
10
11
12












-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_PACK_COUNT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

size_t mp_pack_count(const mp_int *a, size_t nails, size_t size)
{
   size_t bits = (size_t)mp_count_bits(a);
   return ((bits / ((size * 8u) - nails)) + (((bits % ((size * 8u) - nails)) != 0u) ? 1u : 0u));
}

#endif

Changes to libtommath/bn_mp_prime_fermat.c.

1

2
3

4
5














6
7

8
9
10
11
12
13
14

15
16
17


18
19
20


21
22
23
24
25




26
27
28
29
30




31
32
33
34
35




36
37
38
39
40




41
42
43


44
45

46
47

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+






-
+

-
-
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+
-
-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_PRIME_FERMAT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* performs one Fermat test.
 *
 * 
 * If "a" were prime then b**a == b (mod a) since the order of
 * the multiplicative sub-group would be phi(a) = a-1.  That means
 * it would be the same as b**(a mod (a-1)) == b**1 == b (mod a).
 *
 * Sets result to 1 if the congruence holds, or zero otherwise.
 */
mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result)
int mp_prime_fermat (mp_int * a, mp_int * b, int *result)
{
   mp_int  t;
   mp_err  err;
  mp_int  t;
  int     err;

   /* default to composite  */
   *result = MP_NO;
  /* default to composite  */
  *result = MP_NO;

   /* ensure b > 1 */
   if (mp_cmp_d(b, 1uL) != MP_GT) {
      return MP_VAL;
   }
  /* ensure b > 1 */
  if (mp_cmp_d(b, 1) != MP_GT) {
     return MP_VAL;
  }

   /* init t */
   if ((err = mp_init(&t)) != MP_OKAY) {
      return err;
   }
  /* init t */
  if ((err = mp_init (&t)) != MP_OKAY) {
    return err;
  }

   /* compute t = b**a mod a */
   if ((err = mp_exptmod(b, a, a, &t)) != MP_OKAY) {
      goto LBL_T;
   }
  /* compute t = b**a mod a */
  if ((err = mp_exptmod (b, a, a, &t)) != MP_OKAY) {
    goto LBL_T;
  }

   /* is it equal to b? */
   if (mp_cmp(&t, b) == MP_EQ) {
      *result = MP_YES;
   }
  /* is it equal to b? */
  if (mp_cmp (&t, b) == MP_EQ) {
    *result = MP_YES;
  }

   err = MP_OKAY;
LBL_T:
  err = MP_OKAY;
LBL_T:mp_clear (&t);
   mp_clear(&t);
   return err;
  return err;
}
#endif

Deleted libtommath/bn_mp_prime_frobenius_underwood.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132




































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_PRIME_FROBENIUS_UNDERWOOD_C

/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/*
 *  See file bn_mp_prime_is_prime.c or the documentation in doc/bn.tex for the details
 */
#ifndef LTM_USE_ONLY_MR

#ifdef MP_8BIT
/*
 * floor of positive solution of
 * (2^16)-1 = (a+4)*(2*a+5)
 * TODO: Both values are smaller than N^(1/4), would have to use a bigint
 *       for a instead but any a biger than about 120 are already so rare that
 *       it is possible to ignore them and still get enough pseudoprimes.
 *       But it is still a restriction of the set of available pseudoprimes
 *       which makes this implementation less secure if used stand-alone.
 */
#define LTM_FROBENIUS_UNDERWOOD_A 177
#else
#define LTM_FROBENIUS_UNDERWOOD_A 32764
#endif
mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result)
{
   mp_int T1z, T2z, Np1z, sz, tz;

   int a, ap2, length, i, j;
   mp_err err;

   *result = MP_NO;

   if ((err = mp_init_multi(&T1z, &T2z, &Np1z, &sz, &tz, NULL)) != MP_OKAY) {
      return err;
   }

   for (a = 0; a < LTM_FROBENIUS_UNDERWOOD_A; a++) {
      /* TODO: That's ugly! No, really, it is! */
      if ((a==2) || (a==4) || (a==7) || (a==8) || (a==10) ||
          (a==14) || (a==18) || (a==23) || (a==26) || (a==28)) {
         continue;
      }
      /* (32764^2 - 4) < 2^31, no bigint for >MP_8BIT needed) */
      mp_set_u32(&T1z, (uint32_t)a);

      if ((err = mp_sqr(&T1z, &T1z)) != MP_OKAY)                  goto LBL_FU_ERR;

      if ((err = mp_sub_d(&T1z, 4uL, &T1z)) != MP_OKAY)           goto LBL_FU_ERR;

      if ((err = mp_kronecker(&T1z, N, &j)) != MP_OKAY)           goto LBL_FU_ERR;

      if (j == -1) {
         break;
      }

      if (j == 0) {
         /* composite */
         goto LBL_FU_ERR;
      }
   }
   /* Tell it a composite and set return value accordingly */
   if (a >= LTM_FROBENIUS_UNDERWOOD_A) {
      err = MP_ITER;
      goto LBL_FU_ERR;
   }
   /* Composite if N and (a+4)*(2*a+5) are not coprime */
   mp_set_u32(&T1z, (uint32_t)((a+4)*((2*a)+5)));

   if ((err = mp_gcd(N, &T1z, &T1z)) != MP_OKAY)                  goto LBL_FU_ERR;

   if (!((T1z.used == 1) && (T1z.dp[0] == 1u)))                   goto LBL_FU_ERR;

   ap2 = a + 2;
   if ((err = mp_add_d(N, 1uL, &Np1z)) != MP_OKAY)                goto LBL_FU_ERR;

   mp_set(&sz, 1uL);
   mp_set(&tz, 2uL);
   length = mp_count_bits(&Np1z);

   for (i = length - 2; i >= 0; i--) {
      /*
       * temp = (sz*(a*sz+2*tz))%N;
       * tz   = ((tz-sz)*(tz+sz))%N;
       * sz   = temp;
       */
      if ((err = mp_mul_2(&tz, &T2z)) != MP_OKAY)                 goto LBL_FU_ERR;

      /* a = 0 at about 50% of the cases (non-square and odd input) */
      if (a != 0) {
         if ((err = mp_mul_d(&sz, (mp_digit)a, &T1z)) != MP_OKAY) goto LBL_FU_ERR;
         if ((err = mp_add(&T1z, &T2z, &T2z)) != MP_OKAY)         goto LBL_FU_ERR;
      }

      if ((err = mp_mul(&T2z, &sz, &T1z)) != MP_OKAY)             goto LBL_FU_ERR;
      if ((err = mp_sub(&tz, &sz, &T2z)) != MP_OKAY)              goto LBL_FU_ERR;
      if ((err = mp_add(&sz, &tz, &sz)) != MP_OKAY)               goto LBL_FU_ERR;
      if ((err = mp_mul(&sz, &T2z, &tz)) != MP_OKAY)              goto LBL_FU_ERR;
      if ((err = mp_mod(&tz, N, &tz)) != MP_OKAY)                 goto LBL_FU_ERR;
      if ((err = mp_mod(&T1z, N, &sz)) != MP_OKAY)                goto LBL_FU_ERR;
      if (s_mp_get_bit(&Np1z, (unsigned int)i) == MP_YES) {
         /*
          *  temp = (a+2) * sz + tz
          *  tz   = 2 * tz - sz
          *  sz   = temp
          */
         if (a == 0) {
            if ((err = mp_mul_2(&sz, &T1z)) != MP_OKAY)           goto LBL_FU_ERR;
         } else {
            if ((err = mp_mul_d(&sz, (mp_digit)ap2, &T1z)) != MP_OKAY) goto LBL_FU_ERR;
         }
         if ((err = mp_add(&T1z, &tz, &T1z)) != MP_OKAY)          goto LBL_FU_ERR;
         if ((err = mp_mul_2(&tz, &T2z)) != MP_OKAY)              goto LBL_FU_ERR;
         if ((err = mp_sub(&T2z, &sz, &tz)) != MP_OKAY)           goto LBL_FU_ERR;
         mp_exch(&sz, &T1z);
      }
   }

   mp_set_u32(&T1z, (uint32_t)((2 * a) + 5));
   if ((err = mp_mod(&T1z, N, &T1z)) != MP_OKAY)                  goto LBL_FU_ERR;
   if (MP_IS_ZERO(&sz) && (mp_cmp(&tz, &T1z) == MP_EQ)) {
      *result = MP_YES;
   }

LBL_FU_ERR:
   mp_clear_multi(&tz, &sz, &Np1z, &T2z, &T1z, NULL);
   return err;
}

#endif
#endif

Added libtommath/bn_mp_prime_is_divisible.c.















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_PRIME_IS_DIVISIBLE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* determines if an integers is divisible by one 
 * of the first PRIME_SIZE primes or not
 *
 * sets result to 0 if not, 1 if yes
 */
int mp_prime_is_divisible (mp_int * a, int *result)
{
  int     err, ix;
  mp_digit res;

  /* default to not */
  *result = MP_NO;

  for (ix = 0; ix < PRIME_SIZE; ix++) {
    /* what is a mod LBL_prime_tab[ix] */
    if ((err = mp_mod_d (a, ltm_prime_tab[ix], &res)) != MP_OKAY) {
      return err;
    }

    /* is the residue zero? */
    if (res == 0) {
      *result = MP_YES;
      return MP_OKAY;
    }
  }

  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_prime_is_prime.c.

1

2
3

4
5
6



7
8
9
10
11
12
13
14
15
16





17
18
19


20
21
22
23
24

25
26
27

28
29

30
31
32
33
34




35
36
37
38

39
40
41






42
43
44


45
46


47
48
49
50
51





52
53
54
55
56




57
58
59

60
61
62
63
64

65
66
67
68
69
70




71
72
73
74
75




76
77
78

79
80
81
82



83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237


238
239
240
241
242
243
244
245
246
247
248
249
250
251

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302


303
304
305


306
307
308
309



310
311

312
313
314

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
-
+

-
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+


-
+
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
-
-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+

-
-
-
+
+
+
-
-
+

-

#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_PRIME_IS_PRIME_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* portable integer log of two with small footprint */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
static unsigned int s_floor_ilog2(int value)
{
   unsigned int r = 0;
   while ((value >>= 1) != 0) {
      r++;
   }
   return r;
}


 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result)
{
   mp_int  b;
 * The library is free for all purposes without any express
 * guarantee it works.
   int     ix, p_max = 0, size_a, len;
   mp_bool res;
   mp_err  err;
   unsigned int fips_rand, mask;

 *
   /* default to no */
   *result = MP_NO;

 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
   /* Some shortcuts */
   /* N > 3 */
 */
   if (a->used == 1) {
      if ((a->dp[0] == 0u) || (a->dp[0] == 1u)) {
         *result = MP_NO;
         return MP_OKAY;
      }

/* performs a variable number of rounds of Miller-Rabin
 *
 * Probability of error after t rounds is no more than
      if (a->dp[0] == 2u) {
         *result = MP_YES;
         return MP_OKAY;
      }

   }

   /* N must be odd */
 *
 * Sets result to 1 if probably prime, 0 otherwise
 */
int mp_prime_is_prime (mp_int * a, int t, int *result)
{
  mp_int  b;
   if (MP_IS_EVEN(a)) {
      return MP_OKAY;
   }
  int     ix, err, res;

   /* N is not a perfect square: floor(sqrt(N))^2 != N */
   if ((err = mp_is_square(a, &res)) != MP_OKAY) {
  /* default to no */
  *result = MP_NO;
      return err;
   }
   if (res != MP_NO) {
      return MP_OKAY;
   }

  /* valid value of t? */
  if (t <= 0 || t > PRIME_SIZE) {
    return MP_VAL;
  }

   /* is the input equal to one of the primes in the table? */
   for (ix = 0; ix < PRIVATE_MP_PRIME_TAB_SIZE; ix++) {
      if (mp_cmp_d(a, s_mp_prime_tab[ix]) == MP_EQ) {
         *result = MP_YES;
  /* is the input equal to one of the primes in the table? */
  for (ix = 0; ix < PRIME_SIZE; ix++) {
      if (mp_cmp_d(a, ltm_prime_tab[ix]) == MP_EQ) {
         *result = 1;
         return MP_OKAY;
      }
   }
  }
#ifdef MP_8BIT
   /* The search in the loop above was exhaustive in this case */
   if ((a->used == 1) && (PRIVATE_MP_PRIME_TAB_SIZE >= 31)) {
      return MP_OKAY;
   }

#endif

   /* first perform trial division */
   if ((err = s_mp_prime_is_divisible(a, &res)) != MP_OKAY) {
      return err;
   }
  /* first perform trial division */
  if ((err = mp_prime_is_divisible (a, &res)) != MP_OKAY) {
    return err;
  }

   /* return if it was trivially divisible */
   if (res == MP_YES) {
      return MP_OKAY;
   }
  /* return if it was trivially divisible */
  if (res == MP_YES) {
    return MP_OKAY;
  }

   /*
       Run the Miller-Rabin test with base 2 for the BPSW test.
  /* now perform the miller-rabin rounds */
    */
   if ((err = mp_init_set(&b, 2uL)) != MP_OKAY) {
      return err;
   }
  if ((err = mp_init (&b)) != MP_OKAY) {
    return err;
  }

   if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {
      goto LBL_B;
   }
   if (res == MP_NO) {
      goto LBL_B;
   }
   /*
      Rumours have it that Mathematica does a second M-R test with base 3.
      Other rumours have it that their strong L-S test is slightly different.
      It does not hurt, though, beside a bit of extra runtime.
   */
   b.dp[0]++;
   if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {
      goto LBL_B;
   }
   if (res == MP_NO) {
      goto LBL_B;
   }

  for (ix = 0; ix < t; ix++) {
   /*
    * Both, the Frobenius-Underwood test and the the Lucas-Selfridge test are quite
    * slow so if speed is an issue, define LTM_USE_ONLY_MR to use M-R tests with
    * bases 2, 3 and t random bases.
    */
#ifndef LTM_USE_ONLY_MR
   if (t >= 0) {
      /*
       * Use a Frobenius-Underwood test instead of the Lucas-Selfridge test for
       * MP_8BIT (It is unknown if the Lucas-Selfridge test works with 16-bit
       * integers but the necesssary analysis is on the todo-list).
       */
#if defined (MP_8BIT) || defined (LTM_USE_FROBENIUS_TEST)
      err = mp_prime_frobenius_underwood(a, &res);
      if ((err != MP_OKAY) && (err != MP_ITER)) {
         goto LBL_B;
      }
      if (res == MP_NO) {
         goto LBL_B;
      }
#else
      if ((err = mp_prime_strong_lucas_selfridge(a, &res)) != MP_OKAY) {
         goto LBL_B;
      }
      if (res == MP_NO) {
         goto LBL_B;
      }
#endif
   }
#endif

    /* set the prime */
   /* run at least one Miller-Rabin test with a random base */
   if (t == 0) {
      t = 1;
   }

   /*
      Only recommended if the input range is known to be < 3317044064679887385961981

      It uses the bases necessary for a deterministic M-R test if the input is
      smaller than  3317044064679887385961981
      The caller has to check the size.
      TODO: can be made a bit finer grained but comparing is not free.
   */
   if (t < 0) {
      /*
          Sorenson, Jonathan; Webster, Jonathan (2015).
           "Strong Pseudoprimes to Twelve Prime Bases".
       */
      /* 0x437ae92817f9fc85b7e5 = 318665857834031151167461 */
      if ((err =   mp_read_radix(&b, "437ae92817f9fc85b7e5", 16)) != MP_OKAY) {
         goto LBL_B;
      }

      if (mp_cmp(a, &b) == MP_LT) {
         p_max = 12;
      } else {
         /* 0x2be6951adc5b22410a5fd = 3317044064679887385961981 */
         if ((err = mp_read_radix(&b, "2be6951adc5b22410a5fd", 16)) != MP_OKAY) {
            goto LBL_B;
         }

         if (mp_cmp(a, &b) == MP_LT) {
            p_max = 13;
         } else {
            err = MP_VAL;
            goto LBL_B;
         }
      }

      /* we did bases 2 and 3  already, skip them */
      for (ix = 2; ix < p_max; ix++) {
         mp_set(&b, s_mp_prime_tab[ix]);
    mp_set (&b, ltm_prime_tab[ix]);
         if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {
            goto LBL_B;
         }
         if (res == MP_NO) {
            goto LBL_B;
         }
      }
   }
   /*
       Do "t" M-R tests with random bases between 3 and "a".
       See Fips 186.4 p. 126ff
   */
   else if (t > 0) {
      /*
       * The mp_digit's have a defined bit-size but the size of the
       * array a.dp is a simple 'int' and this library can not assume full
       * compliance to the current C-standard (ISO/IEC 9899:2011) because
       * it gets used for small embeded processors, too. Some of those MCUs
       * have compilers that one cannot call standard compliant by any means.
       * Hence the ugly type-fiddling in the following code.
       */
      size_a = mp_count_bits(a);
      mask = (1u << s_floor_ilog2(size_a)) - 1u;
      /*
         Assuming the General Rieman hypothesis (never thought to write that in a
         comment) the upper bound can be lowered to  2*(log a)^2.
         E. Bach, "Explicit bounds for primality testing and related problems,"
         Math. Comp. 55 (1990), 355-380.

            size_a = (size_a/10) * 7;
            len = 2 * (size_a * size_a);

    if ((err = mp_prime_miller_rabin (a, &b, &res)) != MP_OKAY) {
         E.g.: a number of size 2^2048 would be reduced to the upper limit

            floor(2048/10)*7 = 1428
            2 * 1428^2       = 4078368

         (would have been ~4030331.9962 with floats and natural log instead)
         That number is smaller than 2^28, the default bit-size of mp_digit.
      */

      /*
        How many tests, you might ask? Dana Jacobsen of Math::Prime::Util fame
        does exactly 1. In words: one. Look at the end of _GMP_is_prime() in
        Math-Prime-Util-GMP-0.50/primality.c if you do not believe it.

        The function mp_rand() goes to some length to use a cryptographically
        good PRNG. That also means that the chance to always get the same base
        in the loop is non-zero, although very low.
        If the BPSW test and/or the addtional Frobenious test have been
        performed instead of just the Miller-Rabin test with the bases 2 and 3,
        a single extra test should suffice, so such a very unlikely event
        will not do much harm.

        To preemptivly answer the dangling question: no, a witness does not
        need to be prime.
      */
      for (ix = 0; ix < t; ix++) {
         /* mp_rand() guarantees the first digit to be non-zero */
         if ((err = mp_rand(&b, 1)) != MP_OKAY) {
            goto LBL_B;
         }
      goto LBL_B;
    }
         /*
          * Reduce digit before casting because mp_digit might be bigger than
          * an unsigned int and "mask" on the other side is most probably not.
          */
         fips_rand = (unsigned int)(b.dp[0] & (mp_digit) mask);
#ifdef MP_8BIT
         /*
          * One 8-bit digit is too small, so concatenate two if the size of
          * unsigned int allows for it.
          */
         if ((MP_SIZEOF_BITS(unsigned int)/2) >= MP_SIZEOF_BITS(mp_digit)) {
            if ((err = mp_rand(&b, 1)) != MP_OKAY) {
               goto LBL_B;
            }

            fips_rand <<= MP_SIZEOF_BITS(mp_digit);
            fips_rand |= (unsigned int) b.dp[0];
            fips_rand &= mask;
         }
#endif
         if (fips_rand > (unsigned int)(INT_MAX - MP_DIGIT_BIT)) {
            len = INT_MAX / MP_DIGIT_BIT;
         } else {
            len = (((int)fips_rand + MP_DIGIT_BIT) / MP_DIGIT_BIT);
         }
         /*  Unlikely. */
         if (len < 0) {
            ix--;
            continue;
         }
         /*
          * As mentioned above, one 8-bit digit is too small and
          * although it can only happen in the unlikely case that
          * an "unsigned int" is smaller than 16 bit a simple test
          * is cheap and the correction even cheaper.
          */
#ifdef MP_8BIT
         /* All "a" < 2^8 have been caught before */
         if (len == 1) {
            len++;
         }
#endif
         if ((err = mp_rand(&b, len)) != MP_OKAY) {
            goto LBL_B;
         }
         /*
          * That number might got too big and the witness has to be
          * smaller than "a"
          */
         len = mp_count_bits(&b);
         if (len >= size_a) {
            len = (len - size_a) + 1;
            if ((err = mp_div_2d(&b, len, &b, NULL)) != MP_OKAY) {
               goto LBL_B;
            }
         }
         /* Although the chance for b <= 3 is miniscule, try again. */
         if (mp_cmp_d(&b, 3uL) != MP_GT) {
            ix--;
            continue;
         }
         if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {
            goto LBL_B;
         }
         if (res == MP_NO) {
            goto LBL_B;
    if (res == MP_NO) {
      goto LBL_B;
         }
      }
   }
    }
  }

   /* passed the test */
   *result = MP_YES;
LBL_B:
  /* passed the test */
  *result = MP_YES;
LBL_B:mp_clear (&b);
   mp_clear(&b);
   return err;
  return err;
}

#endif

Changes to libtommath/bn_mp_prime_miller_rabin.c.

1

2
3

4
5
6















7
8
9
10

11
12
13

14
15

16
17

18
19
20


21
22
23
24
25




26
27
28
29
30
31
32
33







34
35
36
37
38




39
40
41
42
43




44
45
46
47
48




49
50
51
52
53
54
55
56







57
58
59
60
61
62
63
64
65








66
67
68
69
70




71
72
73


74
75
76
77
78
79





80
81
82
83



84
85

86
87

88
89

90
91

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+


-
+

-
+
-
-
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
-
-
+
-
-
+
-
-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_PRIME_MILLER_RABIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* Miller-Rabin test of "a" to the base of "b" as described in
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* Miller-Rabin test of "a" to the base of "b" as described in 
 * HAC pp. 139 Algorithm 4.24
 *
 * Sets result to 0 if definitely composite or 1 if probably prime.
 * Randomly the chance of error is no more than 1/4 and often
 * Randomly the chance of error is no more than 1/4 and often 
 * very much lower.
 */
mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result)
int mp_prime_miller_rabin (mp_int * a, mp_int * b, int *result)
{
   mp_int  n1, y, r;
  mp_int  n1, y, r;
   mp_err  err;
   int     s, j;
  int     s, j, err;

   /* default */
   *result = MP_NO;
  /* default */
  *result = MP_NO;

   /* ensure b > 1 */
   if (mp_cmp_d(b, 1uL) != MP_GT) {
      return MP_VAL;
   }
  /* ensure b > 1 */
  if (mp_cmp_d(b, 1) != MP_GT) {
     return MP_VAL;
  }     

   /* get n1 = a - 1 */
   if ((err = mp_init_copy(&n1, a)) != MP_OKAY) {
      return err;
   }
   if ((err = mp_sub_d(&n1, 1uL, &n1)) != MP_OKAY) {
      goto LBL_N1;
   }
  /* get n1 = a - 1 */
  if ((err = mp_init_copy (&n1, a)) != MP_OKAY) {
    return err;
  }
  if ((err = mp_sub_d (&n1, 1, &n1)) != MP_OKAY) {
    goto LBL_N1;
  }

   /* set 2**s * r = n1 */
   if ((err = mp_init_copy(&r, &n1)) != MP_OKAY) {
      goto LBL_N1;
   }
  /* set 2**s * r = n1 */
  if ((err = mp_init_copy (&r, &n1)) != MP_OKAY) {
    goto LBL_N1;
  }

   /* count the number of least significant bits
    * which are zero
    */
   s = mp_cnt_lsb(&r);
  /* count the number of least significant bits
   * which are zero
   */
  s = mp_cnt_lsb(&r);

   /* now divide n - 1 by 2**s */
   if ((err = mp_div_2d(&r, s, &r, NULL)) != MP_OKAY) {
      goto LBL_R;
   }
  /* now divide n - 1 by 2**s */
  if ((err = mp_div_2d (&r, s, &r, NULL)) != MP_OKAY) {
    goto LBL_R;
  }

   /* compute y = b**r mod a */
   if ((err = mp_init(&y)) != MP_OKAY) {
      goto LBL_R;
   }
   if ((err = mp_exptmod(b, &r, a, &y)) != MP_OKAY) {
      goto LBL_Y;
   }
  /* compute y = b**r mod a */
  if ((err = mp_init (&y)) != MP_OKAY) {
    goto LBL_R;
  }
  if ((err = mp_exptmod (b, &r, a, &y)) != MP_OKAY) {
    goto LBL_Y;
  }

   /* if y != 1 and y != n1 do */
   if ((mp_cmp_d(&y, 1uL) != MP_EQ) && (mp_cmp(&y, &n1) != MP_EQ)) {
      j = 1;
      /* while j <= s-1 and y != n1 */
      while ((j <= (s - 1)) && (mp_cmp(&y, &n1) != MP_EQ)) {
         if ((err = mp_sqrmod(&y, a, &y)) != MP_OKAY) {
            goto LBL_Y;
         }
  /* if y != 1 and y != n1 do */
  if (mp_cmp_d (&y, 1) != MP_EQ && mp_cmp (&y, &n1) != MP_EQ) {
    j = 1;
    /* while j <= s-1 and y != n1 */
    while ((j <= (s - 1)) && mp_cmp (&y, &n1) != MP_EQ) {
      if ((err = mp_sqrmod (&y, a, &y)) != MP_OKAY) {
         goto LBL_Y;
      }

         /* if y == 1 then composite */
         if (mp_cmp_d(&y, 1uL) == MP_EQ) {
            goto LBL_Y;
         }
      /* if y == 1 then composite */
      if (mp_cmp_d (&y, 1) == MP_EQ) {
         goto LBL_Y;
      }

         ++j;
      }
      ++j;
    }

      /* if y != n1 then composite */
      if (mp_cmp(&y, &n1) != MP_EQ) {
         goto LBL_Y;
      }
   }
    /* if y != n1 then composite */
    if (mp_cmp (&y, &n1) != MP_EQ) {
      goto LBL_Y;
    }
  }

   /* probably prime now */
   *result = MP_YES;
LBL_Y:
  /* probably prime now */
  *result = MP_YES;
LBL_Y:mp_clear (&y);
   mp_clear(&y);
LBL_R:
LBL_R:mp_clear (&r);
   mp_clear(&r);
LBL_N1:
LBL_N1:mp_clear (&n1);
   mp_clear(&n1);
   return err;
  return err;
}
#endif

Changes to libtommath/bn_mp_prime_next_prime.c.

1

2
3

4













5
6
7
8
9
10
11

12
13

14
15
16
17

18





19
20
21
22
23
24
25
26
27
28
29
30


















31
32
33
34
35
36
37
38
39












40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56


57
58

59
60
61

62
63

64
65
66
67
68
69
70
71


72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94



95
96
97
98
99




100
101
102
103
104




105
106

107
108
109
110
111
112
113
114


115
116
117



118
119
120








121
122
123
124
125
126
127
128
129
130
131
132

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+

-
+
-
-
-
-
+

+
+
+
+
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+















-
-
+
+
-
-
+
-

-
+

-
+






-
-
+
+




















-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
+






-
-
+
+



+
+
+
-
-
-
+
+
+
+
+
+
+
+












#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_PRIME_NEXT_PRIME_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* finds the next prime after the number "a" using "t" trials
 * of Miller-Rabin.
 *
 * bbs_style = 1 means the prime must be congruent to 3 mod 4
 */
mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style)
int mp_prime_next_prime(mp_int *a, int t, int bbs_style)
{
   int      x, y;
   int      err, res, x, y;
   mp_ord   cmp;
   mp_err   err;
   mp_bool  res = MP_NO;
   mp_digit res_tab[PRIVATE_MP_PRIME_TAB_SIZE], step, kstep;
   mp_digit res_tab[PRIME_SIZE], step, kstep;
   mp_int   b;

   /* ensure t is valid */
   if (t <= 0 || t > PRIME_SIZE) {
      return MP_VAL;
   }

   /* force positive */
   a->sign = MP_ZPOS;

   /* simple algo if a is less than the largest prime in the table */
   if (mp_cmp_d(a, s_mp_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE-1]) == MP_LT) {
      /* find which prime it is bigger than "a" */
      for (x = 0; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) {
         cmp = mp_cmp_d(a, s_mp_prime_tab[x]);
         if (cmp == MP_EQ) {
            continue;
         }
   if (mp_cmp_d(a, ltm_prime_tab[PRIME_SIZE-1]) == MP_LT) {
      /* find which prime it is bigger than */
      for (x = PRIME_SIZE - 2; x >= 0; x--) {
          if (mp_cmp_d(a, ltm_prime_tab[x]) != MP_LT) {
             if (bbs_style == 1) {
                /* ok we found a prime smaller or
                 * equal [so the next is larger]
                 *
                 * however, the prime must be
                 * congruent to 3 mod 4
                 */
                if ((ltm_prime_tab[x + 1] & 3) != 3) {
                   /* scan upwards for a prime congruent to 3 mod 4 */
                   for (y = x + 1; y < PRIME_SIZE; y++) {
                       if ((ltm_prime_tab[y] & 3) == 3) {
                          mp_set(a, ltm_prime_tab[y]);
                          return MP_OKAY;
                       }
         if (cmp != MP_GT) {
            if ((bbs_style == 1) && ((s_mp_prime_tab[x] & 3u) != 3u)) {
               /* try again until we get a prime congruent to 3 mod 4 */
               continue;
            } else {
               mp_set(a, s_mp_prime_tab[x]);
               return MP_OKAY;
            }
         }
                   }
                }
             } else {
                mp_set(a, ltm_prime_tab[x + 1]);
                return MP_OKAY;
             }
          }
      }
      /* at this point a maybe 1 */
      if (mp_cmp_d(a, 1) == MP_EQ) {
         mp_set(a, 2);
         return MP_OKAY;
      }
      /* fall through to the sieve */
   }

   /* generate a prime congruent to 3 mod 4 or 1/3 mod 4? */
   if (bbs_style == 1) {
      kstep   = 4;
   } else {
      kstep   = 2;
   }

   /* at this point we will use a combination of a sieve and Miller-Rabin */

   if (bbs_style == 1) {
      /* if a mod 4 != 3 subtract the correct value to make it so */
      if ((a->dp[0] & 3u) != 3u) {
         if ((err = mp_sub_d(a, (a->dp[0] & 3u) + 1u, a)) != MP_OKAY) {
      if ((a->dp[0] & 3) != 3) {
         if ((err = mp_sub_d(a, (a->dp[0] & 3) + 1, a)) != MP_OKAY) { return err; };
            return err;
         }
      }
      }
   } else {
      if (MP_IS_EVEN(a)) {
      if (mp_iseven(a) == 1) {
         /* force odd */
         if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) {
         if ((err = mp_sub_d(a, 1, a)) != MP_OKAY) {
            return err;
         }
      }
   }

   /* generate the restable */
   for (x = 1; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) {
      if ((err = mp_mod_d(a, s_mp_prime_tab[x], res_tab + x)) != MP_OKAY) {
   for (x = 1; x < PRIME_SIZE; x++) {
      if ((err = mp_mod_d(a, ltm_prime_tab[x], res_tab + x)) != MP_OKAY) {
         return err;
      }
   }

   /* init temp used for Miller-Rabin Testing */
   if ((err = mp_init(&b)) != MP_OKAY) {
      return err;
   }

   for (;;) {
      /* skip to the next non-trivially divisible candidate */
      step = 0;
      do {
         /* y == 1 if any residue was zero [e.g. cannot be prime] */
         y     =  0;

         /* increase step to next candidate */
         step += kstep;

         /* compute the new residue without using division */
         for (x = 1; x < PRIVATE_MP_PRIME_TAB_SIZE; x++) {
            /* add the step to each residue */
            res_tab[x] += kstep;
         for (x = 1; x < PRIME_SIZE; x++) {
             /* add the step to each residue */
             res_tab[x] += kstep;

            /* subtract the modulus [instead of using division] */
            if (res_tab[x] >= s_mp_prime_tab[x]) {
               res_tab[x]  -= s_mp_prime_tab[x];
            }
             /* subtract the modulus [instead of using division] */
             if (res_tab[x] >= ltm_prime_tab[x]) {
                res_tab[x]  -= ltm_prime_tab[x];
             }

            /* set flag if zero */
            if (res_tab[x] == 0u) {
               y = 1;
            }
             /* set flag if zero */
             if (res_tab[x] == 0) {
                y = 1;
             }
         }
      } while ((y == 1) && (step < (((mp_digit)1 << MP_DIGIT_BIT) - kstep)));
      } while (y == 1 && step < ((((mp_digit)1)<<DIGIT_BIT) - kstep));

      /* add the step */
      if ((err = mp_add_d(a, step, a)) != MP_OKAY) {
         goto LBL_ERR;
      }

      /* if didn't pass sieve and step == MP_MAX then skip test */
      if ((y == 1) && (step >= (((mp_digit)1 << MP_DIGIT_BIT) - kstep))) {
      /* if didn't pass sieve and step == MAX then skip test */
      if (y == 1 && step >= ((((mp_digit)1)<<DIGIT_BIT) - kstep)) {
         continue;
      }

      /* is this prime? */
      for (x = 0; x < t; x++) {
          mp_set(&b, ltm_prime_tab[x]);
      if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) {
         goto LBL_ERR;
      }
          if ((err = mp_prime_miller_rabin(a, &b, &res)) != MP_OKAY) {
             goto LBL_ERR;
          }
          if (res == MP_NO) {
             break;
          }
      }

      if (res == MP_YES) {
         break;
      }
   }

   err = MP_OKAY;
LBL_ERR:
   mp_clear(&b);
   return err;
}

#endif

Changes to libtommath/bn_mp_prime_rabin_miller_trials.c.

1

2
3
4















5
6
7
8
9
10
11
12

13
14
15
16
17
18
19







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41





42
43

44
45
46
47

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
-
+

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-








-
-
-
-
-
+
+
+
+
+

-
+




#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_PRIME_RABIN_MILLER_TRIALS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */


static const struct {
   int k, t;
} sizes[] = {
   {    80, -1 }, /* Use deterministic algorithm for size <= 80 bits */
   {    81, 37 }, /* max. error = 2^(-96)*/
   {    96, 32 }, /* max. error = 2^(-96)*/
   {   128, 40 }, /* max. error = 2^(-112)*/
{   128,    28 },
   {   160, 35 }, /* max. error = 2^(-112)*/
   {   256, 27 }, /* max. error = 2^(-128)*/
   {   384, 16 }, /* max. error = 2^(-128)*/
   {   512, 18 }, /* max. error = 2^(-160)*/
   {   768, 11 }, /* max. error = 2^(-160)*/
   {   896, 10 }, /* max. error = 2^(-160)*/
   {  1024, 12 }, /* max. error = 2^(-192)*/
{   256,    16 },
{   384,    10 },
{   512,     7 },
{   640,     6 },
{   768,     5 },
{   896,     4 },
{  1024,     4 }
   {  1536, 8  }, /* max. error = 2^(-192)*/
   {  2048, 6  }, /* max. error = 2^(-192)*/
   {  3072, 4  }, /* max. error = 2^(-192)*/
   {  4096, 5  }, /* max. error = 2^(-256)*/
   {  5120, 4  }, /* max. error = 2^(-256)*/
   {  6144, 4  }, /* max. error = 2^(-256)*/
   {  8192, 3  }, /* max. error = 2^(-256)*/
   {  9216, 3  }, /* max. error = 2^(-256)*/
   { 10240, 2  }  /* For bigger keysizes use always at least 2 Rounds */
};

/* returns # of RM trials required for a given bit size */
int mp_prime_rabin_miller_trials(int size)
{
   int x;

   for (x = 0; x < (int)(sizeof(sizes)/(sizeof(sizes[0]))); x++) {
      if (sizes[x].k == size) {
         return sizes[x].t;
      } else if (sizes[x].k > size) {
         return (x == 0) ? sizes[0].t : sizes[x - 1].t;
      }
       if (sizes[x].k == size) {
          return sizes[x].t;
       } else if (sizes[x].k > size) {
          return (x == 0) ? sizes[0].t : sizes[x - 1].t;
       }
   }
   return sizes[x-1].t;
   return sizes[x-1].t + 1;
}


#endif

Deleted libtommath/bn_mp_prime_rand.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141













































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_PRIME_RAND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* makes a truly random prime of a given size (bits),
 *
 * Flags are as follows:
 *
 *   MP_PRIME_BBS      - make prime congruent to 3 mod 4
 *   MP_PRIME_SAFE     - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS)
 *   MP_PRIME_2MSB_ON  - make the 2nd highest bit one
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 */

/* This is possibly the mother of all prime generation functions, muahahahahaha! */
mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat)
{
   unsigned char *tmp, maskAND, maskOR_msb, maskOR_lsb;
   int bsize, maskOR_msb_offset;
   mp_bool res;
   mp_err err;

   /* sanity check the input */
   if ((size <= 1) || (t <= 0)) {
      return MP_VAL;
   }

   /* MP_PRIME_SAFE implies MP_PRIME_BBS */
   if ((flags & MP_PRIME_SAFE) != 0) {
      flags |= MP_PRIME_BBS;
   }

   /* calc the byte size */
   bsize = (size>>3) + ((size&7)?1:0);

   /* we need a buffer of bsize bytes */
   tmp = (unsigned char *) MP_MALLOC((size_t)bsize);
   if (tmp == NULL) {
      return MP_MEM;
   }

   /* calc the maskAND value for the MSbyte*/
   maskAND = ((size&7) == 0) ? 0xFFu : (unsigned char)(0xFFu >> (8 - (size & 7)));

   /* calc the maskOR_msb */
   maskOR_msb        = 0;
   maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0;
   if ((flags & MP_PRIME_2MSB_ON) != 0) {
      maskOR_msb       |= (unsigned char)(0x80 >> ((9 - size) & 7));
   }

   /* get the maskOR_lsb */
   maskOR_lsb         = 1u;
   if ((flags & MP_PRIME_BBS) != 0) {
      maskOR_lsb     |= 3u;
   }

   do {
      /* read the bytes */
      if (cb(tmp, bsize, dat) != bsize) {
         err = MP_VAL;
         goto error;
      }

      /* work over the MSbyte */
      tmp[0]    &= maskAND;
      tmp[0]    |= (unsigned char)(1 << ((size - 1) & 7));

      /* mix in the maskORs */
      tmp[maskOR_msb_offset]   |= maskOR_msb;
      tmp[bsize-1]             |= maskOR_lsb;

      /* read it in */
      /* TODO: casting only for now until all lengths have been changed to the type "size_t"*/
      if ((err = mp_from_ubin(a, tmp, (size_t)bsize)) != MP_OKAY) {
         goto error;
      }

      /* is it prime? */
      if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) {
         goto error;
      }
      if (res == MP_NO) {
         continue;
      }

      if ((flags & MP_PRIME_SAFE) != 0) {
         /* see if (a-1)/2 is prime */
         if ((err = mp_sub_d(a, 1uL, a)) != MP_OKAY) {
            goto error;
         }
         if ((err = mp_div_2(a, a)) != MP_OKAY) {
            goto error;
         }

         /* is it prime? */
         if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY) {
            goto error;
         }
      }
   } while (res == MP_NO);

   if ((flags & MP_PRIME_SAFE) != 0) {
      /* restore a to the original value */
      if ((err = mp_mul_2(a, a)) != MP_OKAY) {
         goto error;
      }
      if ((err = mp_add_d(a, 1uL, a)) != MP_OKAY) {
         goto error;
      }
   }

   err = MP_OKAY;
error:
   MP_FREE_BUFFER(tmp, (size_t)bsize);
   return err;
}

static int s_mp_rand_cb(unsigned char *dst, int len, void *dat)
{
   (void)dat;
   if (len <= 0) {
      return len;
   }
   if (s_mp_rand_source(dst, (size_t)len) != MP_OKAY) {
      return 0;
   }
   return len;
}

mp_err mp_prime_rand(mp_int *a, int t, int size, int flags)
{
   return s_mp_prime_random_ex(a, t, size, flags, s_mp_rand_cb, NULL);
}

#endif

Added libtommath/bn_mp_prime_random_ex.c.


























































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_PRIME_RANDOM_EX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* makes a truly random prime of a given size (bits),
 *
 * Flags are as follows:
 * 
 *   LTM_PRIME_BBS      - make prime congruent to 3 mod 4
 *   LTM_PRIME_SAFE     - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
 *   LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
 *   LTM_PRIME_2MSB_ON  - make the 2nd highest bit one
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 */

/* This is possibly the mother of all prime generation functions, muahahahahaha! */
int mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat)
{
   unsigned char *tmp, maskAND, maskOR_msb, maskOR_lsb;
   int res, err, bsize, maskOR_msb_offset;

   /* sanity check the input */
   if (size <= 1 || t <= 0) {
      return MP_VAL;
   }

   /* LTM_PRIME_SAFE implies LTM_PRIME_BBS */
   if (flags & LTM_PRIME_SAFE) {
      flags |= LTM_PRIME_BBS;
   }

   /* calc the byte size */
   bsize = (size>>3) + ((size&7)?1:0);

   /* we need a buffer of bsize bytes */
   tmp = OPT_CAST(unsigned char) XMALLOC(bsize);
   if (tmp == NULL) {
      return MP_MEM;
   }

   /* calc the maskAND value for the MSbyte*/
   maskAND = ((size&7) == 0) ? 0xFF : (0xFF >> (8 - (size & 7)));

   /* calc the maskOR_msb */
   maskOR_msb        = 0;
   maskOR_msb_offset = ((size & 7) == 1) ? 1 : 0;
   if (flags & LTM_PRIME_2MSB_ON) {
      maskOR_msb       |= 0x80 >> ((9 - size) & 7);
   }  

   /* get the maskOR_lsb */
   maskOR_lsb         = 1;
   if (flags & LTM_PRIME_BBS) {
      maskOR_lsb     |= 3;
   }

   do {
      /* read the bytes */
      if (cb(tmp, bsize, dat) != bsize) {
         err = MP_VAL;
         goto error;
      }
 
      /* work over the MSbyte */
      tmp[0]    &= maskAND;
      tmp[0]    |= 1 << ((size - 1) & 7);

      /* mix in the maskORs */
      tmp[maskOR_msb_offset]   |= maskOR_msb;
      tmp[bsize-1]             |= maskOR_lsb;

      /* read it in */
      if ((err = mp_read_unsigned_bin(a, tmp, bsize)) != MP_OKAY)     { goto error; }

      /* is it prime? */
      if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY)           { goto error; }
      if (res == MP_NO) {  
         continue;
      }

      if (flags & LTM_PRIME_SAFE) {
         /* see if (a-1)/2 is prime */
         if ((err = mp_sub_d(a, 1, a)) != MP_OKAY)                    { goto error; }
         if ((err = mp_div_2(a, a)) != MP_OKAY)                       { goto error; }
 
         /* is it prime? */
         if ((err = mp_prime_is_prime(a, t, &res)) != MP_OKAY)        { goto error; }
      }
   } while (res == MP_NO);

   if (flags & LTM_PRIME_SAFE) {
      /* restore a to the original value */
      if ((err = mp_mul_2(a, a)) != MP_OKAY)                          { goto error; }
      if ((err = mp_add_d(a, 1, a)) != MP_OKAY)                       { goto error; }
   }

   err = MP_OKAY;
error:
   XFREE(tmp);
   return err;
}


#endif

Deleted libtommath/bn_mp_prime_strong_lucas_selfridge.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289

































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C

/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/*
 *  See file bn_mp_prime_is_prime.c or the documentation in doc/bn.tex for the details
 */
#ifndef LTM_USE_ONLY_MR

/*
 *  8-bit is just too small. You can try the Frobenius test
 *  but that frobenius test can fail, too, for the same reason.
 */
#ifndef MP_8BIT

/*
 * multiply bigint a with int d and put the result in c
 * Like mp_mul_d() but with a signed long as the small input
 */
static mp_err s_mp_mul_si(const mp_int *a, int32_t d, mp_int *c)
{
   mp_int t;
   mp_err err;

   if ((err = mp_init(&t)) != MP_OKAY) {
      return err;
   }

   /*
    * mp_digit might be smaller than a long, which excludes
    * the use of mp_mul_d() here.
    */
   mp_set_i32(&t, d);
   err = mp_mul(a, &t, c);
   mp_clear(&t);
   return err;
}
/*
    Strong Lucas-Selfridge test.
    returns MP_YES if it is a strong L-S prime, MP_NO if it is composite

    Code ported from  Thomas Ray Nicely's implementation of the BPSW test
    at http://www.trnicely.net/misc/bpsw.html

    Freeware copyright (C) 2016 Thomas R. Nicely <http://www.trnicely.net>.
    Released into the public domain by the author, who disclaims any legal
    liability arising from its use

    The multi-line comments are made by Thomas R. Nicely and are copied verbatim.
    Additional comments marked "CZ" (without the quotes) are by the code-portist.

    (If that name sounds familiar, he is the guy who found the fdiv bug in the
     Pentium (P5x, I think) Intel processor)
*/
mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result)
{
   /* CZ TODO: choose better variable names! */
   mp_int Dz, gcd, Np1, Uz, Vz, U2mz, V2mz, Qmz, Q2mz, Qkdz, T1z, T2z, T3z, T4z, Q2kdz;
   /* CZ TODO: Some of them need the full 32 bit, hence the (temporary) exclusion of MP_8BIT */
   int32_t D, Ds, J, sign, P, Q, r, s, u, Nbits;
   mp_err err;
   mp_bool oddness;

   *result = MP_NO;
   /*
   Find the first element D in the sequence {5, -7, 9, -11, 13, ...}
   such that Jacobi(D,N) = -1 (Selfridge's algorithm). Theory
   indicates that, if N is not a perfect square, D will "nearly
   always" be "small." Just in case, an overflow trap for D is
   included.
   */

   if ((err = mp_init_multi(&Dz, &gcd, &Np1, &Uz, &Vz, &U2mz, &V2mz, &Qmz, &Q2mz, &Qkdz, &T1z, &T2z, &T3z, &T4z, &Q2kdz,
                            NULL)) != MP_OKAY) {
      return err;
   }

   D = 5;
   sign = 1;

   for (;;) {
      Ds   = sign * D;
      sign = -sign;
      mp_set_u32(&Dz, (uint32_t)D);
      if ((err = mp_gcd(a, &Dz, &gcd)) != MP_OKAY)                goto LBL_LS_ERR;

      /* if 1 < GCD < N then N is composite with factor "D", and
         Jacobi(D,N) is technically undefined (but often returned
         as zero). */
      if ((mp_cmp_d(&gcd, 1uL) == MP_GT) && (mp_cmp(&gcd, a) == MP_LT)) {
         goto LBL_LS_ERR;
      }
      if (Ds < 0) {
         Dz.sign = MP_NEG;
      }
      if ((err = mp_kronecker(&Dz, a, &J)) != MP_OKAY)            goto LBL_LS_ERR;

      if (J == -1) {
         break;
      }
      D += 2;

      if (D > (INT_MAX - 2)) {
         err = MP_VAL;
         goto LBL_LS_ERR;
      }
   }



   P = 1;              /* Selfridge's choice */
   Q = (1 - Ds) / 4;   /* Required so D = P*P - 4*Q */

   /* NOTE: The conditions (a) N does not divide Q, and
      (b) D is square-free or not a perfect square, are included by
      some authors; e.g., "Prime numbers and computer methods for
      factorization," Hans Riesel (2nd ed., 1994, Birkhauser, Boston),
      p. 130. For this particular application of Lucas sequences,
      these conditions were found to be immaterial. */

   /* Now calculate N - Jacobi(D,N) = N + 1 (even), and calculate the
      odd positive integer d and positive integer s for which
      N + 1 = 2^s*d (similar to the step for N - 1 in Miller's test).
      The strong Lucas-Selfridge test then returns N as a strong
      Lucas probable prime (slprp) if any of the following
      conditions is met: U_d=0, V_d=0, V_2d=0, V_4d=0, V_8d=0,
      V_16d=0, ..., etc., ending with V_{2^(s-1)*d}=V_{(N+1)/2}=0
      (all equalities mod N). Thus d is the highest index of U that
      must be computed (since V_2m is independent of U), compared
      to U_{N+1} for the standard Lucas-Selfridge test; and no
      index of V beyond (N+1)/2 is required, just as in the
      standard Lucas-Selfridge test. However, the quantity Q^d must
      be computed for use (if necessary) in the latter stages of
      the test. The result is that the strong Lucas-Selfridge test
      has a running time only slightly greater (order of 10 %) than
      that of the standard Lucas-Selfridge test, while producing
      only (roughly) 30 % as many pseudoprimes (and every strong
      Lucas pseudoprime is also a standard Lucas pseudoprime). Thus
      the evidence indicates that the strong Lucas-Selfridge test is
      more effective than the standard Lucas-Selfridge test, and a
      Baillie-PSW test based on the strong Lucas-Selfridge test
      should be more reliable. */

   if ((err = mp_add_d(a, 1uL, &Np1)) != MP_OKAY)                 goto LBL_LS_ERR;
   s = mp_cnt_lsb(&Np1);

   /* CZ
    * This should round towards zero because
    * Thomas R. Nicely used GMP's mpz_tdiv_q_2exp()
    * and mp_div_2d() is equivalent. Additionally:
    * dividing an even number by two does not produce
    * any leftovers.
    */
   if ((err = mp_div_2d(&Np1, s, &Dz, NULL)) != MP_OKAY)          goto LBL_LS_ERR;
   /* We must now compute U_d and V_d. Since d is odd, the accumulated
      values U and V are initialized to U_1 and V_1 (if the target
      index were even, U and V would be initialized instead to U_0=0
      and V_0=2). The values of U_2m and V_2m are also initialized to
      U_1 and V_1; the FOR loop calculates in succession U_2 and V_2,
      U_4 and V_4, U_8 and V_8, etc. If the corresponding bits
      (1, 2, 3, ...) of t are on (the zero bit having been accounted
      for in the initialization of U and V), these values are then
      combined with the previous totals for U and V, using the
      composition formulas for addition of indices. */

   mp_set(&Uz, 1uL);    /* U=U_1 */
   mp_set(&Vz, (mp_digit)P);    /* V=V_1 */
   mp_set(&U2mz, 1uL);  /* U_1 */
   mp_set(&V2mz, (mp_digit)P);  /* V_1 */

   mp_set_i32(&Qmz, Q);
   if ((err = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY)                  goto LBL_LS_ERR;
   /* Initializes calculation of Q^d */
   mp_set_i32(&Qkdz, Q);

   Nbits = mp_count_bits(&Dz);

   for (u = 1; u < Nbits; u++) { /* zero bit off, already accounted for */
      /* Formulas for doubling of indices (carried out mod N). Note that
       * the indices denoted as "2m" are actually powers of 2, specifically
       * 2^(ul-1) beginning each loop and 2^ul ending each loop.
       *
       * U_2m = U_m*V_m
       * V_2m = V_m*V_m - 2*Q^m
       */

      if ((err = mp_mul(&U2mz, &V2mz, &U2mz)) != MP_OKAY)         goto LBL_LS_ERR;
      if ((err = mp_mod(&U2mz, a, &U2mz)) != MP_OKAY)             goto LBL_LS_ERR;
      if ((err = mp_sqr(&V2mz, &V2mz)) != MP_OKAY)                goto LBL_LS_ERR;
      if ((err = mp_sub(&V2mz, &Q2mz, &V2mz)) != MP_OKAY)         goto LBL_LS_ERR;
      if ((err = mp_mod(&V2mz, a, &V2mz)) != MP_OKAY)             goto LBL_LS_ERR;

      /* Must calculate powers of Q for use in V_2m, also for Q^d later */
      if ((err = mp_sqr(&Qmz, &Qmz)) != MP_OKAY)                  goto LBL_LS_ERR;

      /* prevents overflow */ /* CZ  still necessary without a fixed prealloc'd mem.? */
      if ((err = mp_mod(&Qmz, a, &Qmz)) != MP_OKAY)               goto LBL_LS_ERR;
      if ((err = mp_mul_2(&Qmz, &Q2mz)) != MP_OKAY)               goto LBL_LS_ERR;

      if (s_mp_get_bit(&Dz, (unsigned int)u) == MP_YES) {
         /* Formulas for addition of indices (carried out mod N);
          *
          * U_(m+n) = (U_m*V_n + U_n*V_m)/2
          * V_(m+n) = (V_m*V_n + D*U_m*U_n)/2
          *
          * Be careful with division by 2 (mod N)!
          */
         if ((err = mp_mul(&U2mz, &Vz, &T1z)) != MP_OKAY)         goto LBL_LS_ERR;
         if ((err = mp_mul(&Uz, &V2mz, &T2z)) != MP_OKAY)         goto LBL_LS_ERR;
         if ((err = mp_mul(&V2mz, &Vz, &T3z)) != MP_OKAY)         goto LBL_LS_ERR;
         if ((err = mp_mul(&U2mz, &Uz, &T4z)) != MP_OKAY)         goto LBL_LS_ERR;
         if ((err = s_mp_mul_si(&T4z, Ds, &T4z)) != MP_OKAY)      goto LBL_LS_ERR;
         if ((err = mp_add(&T1z, &T2z, &Uz)) != MP_OKAY)          goto LBL_LS_ERR;
         if (MP_IS_ODD(&Uz)) {
            if ((err = mp_add(&Uz, a, &Uz)) != MP_OKAY)           goto LBL_LS_ERR;
         }
         /* CZ
          * This should round towards negative infinity because
          * Thomas R. Nicely used GMP's mpz_fdiv_q_2exp().
          * But mp_div_2() does not do so, it is truncating instead.
          */
         oddness = MP_IS_ODD(&Uz) ? MP_YES : MP_NO;
         if ((err = mp_div_2(&Uz, &Uz)) != MP_OKAY)               goto LBL_LS_ERR;
         if ((Uz.sign == MP_NEG) && (oddness != MP_NO)) {
            if ((err = mp_sub_d(&Uz, 1uL, &Uz)) != MP_OKAY)       goto LBL_LS_ERR;
         }
         if ((err = mp_add(&T3z, &T4z, &Vz)) != MP_OKAY)          goto LBL_LS_ERR;
         if (MP_IS_ODD(&Vz)) {
            if ((err = mp_add(&Vz, a, &Vz)) != MP_OKAY)           goto LBL_LS_ERR;
         }
         oddness = MP_IS_ODD(&Vz) ? MP_YES : MP_NO;
         if ((err = mp_div_2(&Vz, &Vz)) != MP_OKAY)               goto LBL_LS_ERR;
         if ((Vz.sign == MP_NEG) && (oddness != MP_NO)) {
            if ((err = mp_sub_d(&Vz, 1uL, &Vz)) != MP_OKAY)       goto LBL_LS_ERR;
         }
         if ((err = mp_mod(&Uz, a, &Uz)) != MP_OKAY)              goto LBL_LS_ERR;
         if ((err = mp_mod(&Vz, a, &Vz)) != MP_OKAY)              goto LBL_LS_ERR;

         /* Calculating Q^d for later use */
         if ((err = mp_mul(&Qkdz, &Qmz, &Qkdz)) != MP_OKAY)       goto LBL_LS_ERR;
         if ((err = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY)          goto LBL_LS_ERR;
      }
   }

   /* If U_d or V_d is congruent to 0 mod N, then N is a prime or a
      strong Lucas pseudoprime. */
   if (MP_IS_ZERO(&Uz) || MP_IS_ZERO(&Vz)) {
      *result = MP_YES;
      goto LBL_LS_ERR;
   }

   /* NOTE: Ribenboim ("The new book of prime number records," 3rd ed.,
      1995/6) omits the condition V0 on p.142, but includes it on
      p. 130. The condition is NECESSARY; otherwise the test will
      return false negatives---e.g., the primes 29 and 2000029 will be
      returned as composite. */

   /* Otherwise, we must compute V_2d, V_4d, V_8d, ..., V_{2^(s-1)*d}
      by repeated use of the formula V_2m = V_m*V_m - 2*Q^m. If any of
      these are congruent to 0 mod N, then N is a prime or a strong
      Lucas pseudoprime. */

   /* Initialize 2*Q^(d*2^r) for V_2m */
   if ((err = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY)                goto LBL_LS_ERR;

   for (r = 1; r < s; r++) {
      if ((err = mp_sqr(&Vz, &Vz)) != MP_OKAY)                    goto LBL_LS_ERR;
      if ((err = mp_sub(&Vz, &Q2kdz, &Vz)) != MP_OKAY)            goto LBL_LS_ERR;
      if ((err = mp_mod(&Vz, a, &Vz)) != MP_OKAY)                 goto LBL_LS_ERR;
      if (MP_IS_ZERO(&Vz)) {
         *result = MP_YES;
         goto LBL_LS_ERR;
      }
      /* Calculate Q^{d*2^r} for next r (final iteration irrelevant). */
      if (r < (s - 1)) {
         if ((err = mp_sqr(&Qkdz, &Qkdz)) != MP_OKAY)             goto LBL_LS_ERR;
         if ((err = mp_mod(&Qkdz, a, &Qkdz)) != MP_OKAY)          goto LBL_LS_ERR;
         if ((err = mp_mul_2(&Qkdz, &Q2kdz)) != MP_OKAY)          goto LBL_LS_ERR;
      }
   }
LBL_LS_ERR:
   mp_clear_multi(&Q2kdz, &T4z, &T3z, &T2z, &T1z, &Qkdz, &Q2mz, &Qmz, &V2mz, &U2mz, &Vz, &Uz, &Np1, &gcd, &Dz, NULL);
   return err;
}
#endif
#endif
#endif

Changes to libtommath/bn_mp_radix_size.c.

1

2
3

4
5
6
7
















8
9
10
11
12



13
14

15
16
17
18
19





20

21

22
23
24


25
26
27
28
29
30




31
32
33


34
35
36
37
38




39
40
41
42
43




44
45
46


47
48
49
50
51
52
53
54









55
56
57


58
59
60
61
62

63
64
65





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
-
+

-
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+

-
+

-
-
-
-
+
+
+
+
+

+
-
+
-
-
-
+
+

-
-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
-
-
-
-
-
+



+
+
+
+
#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_RADIX_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* returns size of ASCII representation */
mp_err mp_radix_size(const mp_int *a, int radix, int *size)
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://libtom.org
 */

/* returns size of ASCII reprensentation */
int mp_radix_size (mp_int * a, int radix, int *size)
{
   mp_err  err;
   int digs;
   mp_int   t;
   mp_digit d;
  int     res, digs;
  mp_int  t;
  mp_digit d;

   *size = 0;
  *size = 0;

   /* make sure the radix is in range */
   if ((radix < 2) || (radix > 64)) {
      return MP_VAL;
   }
  /* special case for binary */
  if (radix == 2) {
    *size = mp_count_bits (a) + (a->sign == MP_NEG ? 1 : 0) + 1;
    return MP_OKAY;
  }

  /* make sure the radix is in range */
   if (MP_IS_ZERO(a)) {
  if (radix < 2 || radix > 64) {
      *size = 2;
      return MP_OKAY;
   }
    return MP_VAL;
  }

   /* special case for binary */
   if (radix == 2) {
      *size = (mp_count_bits(a) + ((a->sign == MP_NEG) ? 1 : 0) + 1);
      return MP_OKAY;
   }
  if (mp_iszero(a) == MP_YES) {
    *size = 2;
    return MP_OKAY;
  }

   /* digs is the digit count */
   digs = 0;
  /* digs is the digit count */
  digs = 0;

   /* if it's negative add one for the sign */
   if (a->sign == MP_NEG) {
      ++digs;
   }
  /* if it's negative add one for the sign */
  if (a->sign == MP_NEG) {
    ++digs;
  }

   /* init a copy of the input */
   if ((err = mp_init_copy(&t, a)) != MP_OKAY) {
      return err;
   }
  /* init a copy of the input */
  if ((res = mp_init_copy (&t, a)) != MP_OKAY) {
    return res;
  }

   /* force temp to positive */
   t.sign = MP_ZPOS;
  /* force temp to positive */
  t.sign = MP_ZPOS; 

   /* fetch out all of the digits */
   while (!MP_IS_ZERO(&t)) {
      if ((err = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) {
         goto LBL_ERR;
      }
      ++digs;
   }
  /* fetch out all of the digits */
  while (mp_iszero (&t) == MP_NO) {
    if ((res = mp_div_d (&t, (mp_digit) radix, &t, &d)) != MP_OKAY) {
      mp_clear (&t);
      return res;
    }
    ++digs;
  }
  mp_clear (&t);

   /* return digs + 1, the 1 is for the NULL byte that would be required. */
   *size = digs + 1;
  /* return digs + 1, the 1 is for the NULL byte that would be required. */
  *size = digs + 1;
   err = MP_OKAY;

LBL_ERR:
   mp_clear(&t);
   return err;
  return MP_OKAY;
}

#endif

/* $Source$ */
/* $Revision: 0.41 $ */
/* $Date: 2007-04-18 09:58:18 +0000 $ */

Changes to libtommath/bn_mp_radix_smap.c.

1

2
3

4
5














6
7

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

1
2

3


4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

19














20
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_RADIX_SMAP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* chars used in radix conversions */
const char *const mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/";
const char *mp_s_rmap = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/";
const uint8_t mp_s_rmap_reverse[] = {
   0xff, 0xff, 0xff, 0x3e, 0xff, 0xff, 0xff, 0x3f, /* ()*+,-./ */
   0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, /* 01234567 */
   0x08, 0x09, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, /* 89:;<=>? */
   0xff, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, 0x10, /* @ABCDEFG */
   0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, /* HIJKLMNO */
   0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, 0x20, /* PQRSTUVW */
   0x21, 0x22, 0x23, 0xff, 0xff, 0xff, 0xff, 0xff, /* XYZ[\]^_ */
   0xff, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, /* `abcdefg */
   0x2b, 0x2c, 0x2d, 0x2e, 0x2f, 0x30, 0x31, 0x32, /* hijklmno */
   0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, /* pqrstuvw */
   0x3b, 0x3c, 0x3d, 0xff, 0xff, 0xff, 0xff, 0xff, /* xyz{|}~. */
};
const size_t mp_s_rmap_reverse_sz = sizeof(mp_s_rmap_reverse);
#endif

Changes to libtommath/bn_mp_rand.c.

1

2
3

4
5
6
7
8





9
10
11
12
13












14
15
16


17
18

19
20
21
22



23
24
25
26




27
28
29
30



31
32
33
34
35
36
37
38








39
40
41
42

43
44

45
46

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
-
+

-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
+
-
-
-
-
+
+
+

-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_RAND_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

mp_err(*s_mp_rand_source)(void *out, size_t size) = s_mp_rand_platform;

void mp_rand_source(mp_err(*source)(void *out, size_t size))
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
{
   s_mp_rand_source = (source == NULL) ? s_mp_rand_platform : source;
}

mp_err mp_rand(mp_int *a, int digits)
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* makes a pseudo-random int of a given size */
int
mp_rand (mp_int * a, int digits)
{
   int i;
   mp_err err;
  int     res;
  mp_digit d;

   mp_zero(a);
  mp_zero (a);

   if (digits <= 0) {
      return MP_OKAY;
   }
  if (digits <= 0) {
    return MP_OKAY;
  }

   if ((err = mp_grow(a, digits)) != MP_OKAY) {
      return err;
   }
  /* first place a random non-zero digit */
  do {
    d = ((mp_digit) abs (rand ())) & MP_MASK;
  } while (d == 0);

   if ((err = s_mp_rand_source(a->dp, (size_t)digits * sizeof(mp_digit))) != MP_OKAY) {
      return err;
   }
  if ((res = mp_add_d (a, d, a)) != MP_OKAY) {
    return res;
  }

   /* TODO: We ensure that the highest digit is nonzero. Should this be removed? */
   while ((a->dp[digits - 1] & MP_MASK) == 0u) {
      if ((err = s_mp_rand_source(a->dp + digits - 1, sizeof(mp_digit))) != MP_OKAY) {
         return err;
      }
   }

  while (--digits > 0) {
    if ((res = mp_lshd (a, 1)) != MP_OKAY) {
      return res;
    }

    if ((res = mp_add_d (a, ((mp_digit) abs (rand ())), a)) != MP_OKAY) {
      return res;
    }
   a->used = digits;
   for (i = 0; i < digits; ++i) {
      a->dp[i] &= MP_MASK;
   }
  }

   return MP_OKAY;
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_read_radix.c.

1

2
3

4
5
6
7














8
9

10
11
12

13
14
15

16
17
18


19
20
21
22
23




24
25
26
27
28
29
30
31
32
33









34
35
36
37
38
39
40
41
42
43
44
45
46












47
48
49

50
51
52
53
54
55
56







57
58
59


60
61
62
63
64
65
66
67
68
69










70
71

72
73
74
75
76
77





78
79

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
-
+

-
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
+
-
-
-
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_READ_RADIX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

#define MP_TOUPPER(c) ((((c) >= 'a') && ((c) <= 'z')) ? (((c) + 'A') - 'a') : (c))

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* read a string [ASCII] in a given radix */
mp_err mp_read_radix(mp_int *a, const char *str, int radix)
int mp_read_radix (mp_int * a, const char *str, int radix)
{
   mp_err   err;
   int      y;
  int     y, res, neg;
   mp_sign  neg;
   unsigned pos;
   char     ch;
  char    ch;

   /* zero the digit bignum */
   mp_zero(a);
  /* zero the digit bignum */
  mp_zero(a);

   /* make sure the radix is ok */
   if ((radix < 2) || (radix > 64)) {
      return MP_VAL;
   }
  /* make sure the radix is ok */
  if (radix < 2 || radix > 64) {
    return MP_VAL;
  }

   /* if the leading digit is a
    * minus set the sign to negative.
    */
   if (*str == '-') {
      ++str;
      neg = MP_NEG;
   } else {
      neg = MP_ZPOS;
   }
  /* if the leading digit is a 
   * minus set the sign to negative. 
   */
  if (*str == '-') {
    ++str;
    neg = MP_NEG;
  } else {
    neg = MP_ZPOS;
  }

   /* set the integer to the default of zero */
   mp_zero(a);

   /* process each digit of the string */
   while (*str != '\0') {
      /* if the radix <= 36 the conversion is case insensitive
       * this allows numbers like 1AB and 1ab to represent the same  value
       * [e.g. in hex]
       */
      ch = (radix <= 36) ? (char)MP_TOUPPER((int)*str) : *str;
      pos = (unsigned)(ch - '(');
      if (mp_s_rmap_reverse_sz < pos) {
  /* set the integer to the default of zero */
  mp_zero (a);
  
  /* process each digit of the string */
  while (*str) {
    /* if the radix < 36 the conversion is case insensitive
     * this allows numbers like 1AB and 1ab to represent the same  value
     * [e.g. in hex]
     */
    ch = (char) ((radix < 36) ? toupper ((unsigned char) *str) : *str);
    for (y = 0; y < 64; y++) {
      if (ch == mp_s_rmap[y]) {
         break;
      }
      y = (int)mp_s_rmap_reverse[pos];
    }

      /* if the char was found in the map
       * and is less than the given radix add it
       * to the number, otherwise exit the loop.
       */
      if ((y == 0xff) || (y >= radix)) {
         break;
    /* if the char was found in the map 
     * and is less than the given radix add it
     * to the number, otherwise exit the loop. 
     */
    if (y < radix) {
      if ((res = mp_mul_d (a, (mp_digit) radix, a)) != MP_OKAY) {
         return res;
      }
      if ((err = mp_mul_d(a, (mp_digit)radix, a)) != MP_OKAY) {
         return err;
      if ((res = mp_add_d (a, (mp_digit) y, a)) != MP_OKAY) {
         return res;
      }
      if ((err = mp_add_d(a, (mp_digit)y, a)) != MP_OKAY) {
         return err;
      }
      ++str;
   }

   /* if an illegal character was found, fail. */
   if (!((*str == '\0') || (*str == '\r') || (*str == '\n'))) {
      mp_zero(a);
    } else {
      break;
    }
    ++str;
  }
  
  /* if an illegal character was found, fail. */

  if ( *str != '\0' ) {
      mp_zero( a );
      return MP_VAL;
   }
  }

   /* set the sign only if a != 0 */
   if (!MP_IS_ZERO(a)) {
      a->sign = neg;
   }
   return MP_OKAY;
  /* set the sign only if a != 0 */
  if (mp_iszero(a) != 1) {
     a->sign = neg;
  }
  return MP_OKAY;
}
#endif

Added libtommath/bn_mp_read_signed_bin.c.






































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_READ_SIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* read signed bin, big endian, first byte is 0==positive or 1==negative */
int mp_read_signed_bin (mp_int * a, const unsigned char *b, int c)
{
  int     res;

  /* read magnitude */
  if ((res = mp_read_unsigned_bin (a, b + 1, c - 1)) != MP_OKAY) {
    return res;
  }

  /* first byte is 0 for positive, non-zero for negative */
  if (b[0] == 0) {
     a->sign = MP_ZPOS;
  } else {
     a->sign = MP_NEG;
  }

  return MP_OKAY;
}
#endif

Added libtommath/bn_mp_read_unsigned_bin.c.




















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_READ_UNSIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* reads a unsigned char array, assumes the msb is stored first [big endian] */
int mp_read_unsigned_bin (mp_int * a, const unsigned char *b, int c)
{
  int     res;

  /* make sure there are at least two digits */
  if (a->alloc < 2) {
     if ((res = mp_grow(a, 2)) != MP_OKAY) {
        return res;
     }
  }

  /* zero the int */
  mp_zero (a);

  /* read the bytes in */
  while (c-- > 0) {
    if ((res = mp_mul_2d (a, 8, a)) != MP_OKAY) {
      return res;
    }

#ifndef MP_8BIT
      a->dp[0] |= *b++;
      a->used += 1;
#else
      a->dp[0] = (*b & MP_MASK);
      a->dp[1] |= ((*b++ >> 7U) & 1);
      a->used += 2;
#endif
  }
  mp_clamp (a);
  return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_reduce.c.

1

2
3

4
5
6















7
8
9
10

11
12

13
14

15
16
17
18
19




20
21
22


23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

















39
40
41
42
43






44
45
46
47
48




49
50
51
52
53




54
55
56
57
58




59
60
61
62
63
64





65
66
67
68
69




70
71
72
73
74
75
76
77







78
79

80
81

82
83

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+

-
+
-
-
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* reduces x mod m, assumes 0 < x < m**2, mu is
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* reduces x mod m, assumes 0 < x < m**2, mu is 
 * precomputed via mp_reduce_setup.
 * From HAC pp.604 Algorithm 14.42
 */
mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu)
int mp_reduce (mp_int * x, mp_int * m, mp_int * mu)
{
   mp_int  q;
  mp_int  q;
   mp_err  err;
   int     um = m->used;
  int     res, um = m->used;

   /* q = x */
   if ((err = mp_init_copy(&q, x)) != MP_OKAY) {
      return err;
   }
  /* q = x */
  if ((res = mp_init_copy (&q, x)) != MP_OKAY) {
    return res;
  }

   /* q1 = x / b**(k-1)  */
   mp_rshd(&q, um - 1);
  /* q1 = x / b**(k-1)  */
  mp_rshd (&q, um - 1);         

   /* according to HAC this optimization is ok */
   if ((mp_digit)um > ((mp_digit)1 << (MP_DIGIT_BIT - 1))) {
      if ((err = mp_mul(&q, mu, &q)) != MP_OKAY) {
         goto CLEANUP;
      }
   } else if (MP_HAS(S_MP_MUL_HIGH_DIGS)) {
      if ((err = s_mp_mul_high_digs(&q, mu, &q, um)) != MP_OKAY) {
         goto CLEANUP;
      }
   } else if (MP_HAS(S_MP_MUL_HIGH_DIGS_FAST)) {
      if ((err = s_mp_mul_high_digs_fast(&q, mu, &q, um)) != MP_OKAY) {
         goto CLEANUP;
      }
   } else {
      err = MP_VAL;
  /* according to HAC this optimization is ok */
  if (((unsigned long) um) > (((mp_digit)1) << (DIGIT_BIT - 1))) {
    if ((res = mp_mul (&q, mu, &q)) != MP_OKAY) {
      goto CLEANUP;
    }
  } else {
#ifdef BN_S_MP_MUL_HIGH_DIGS_C
    if ((res = s_mp_mul_high_digs (&q, mu, &q, um)) != MP_OKAY) {
      goto CLEANUP;
    }
#elif defined(BN_FAST_S_MP_MUL_HIGH_DIGS_C)
    if ((res = fast_s_mp_mul_high_digs (&q, mu, &q, um)) != MP_OKAY) {
      goto CLEANUP;
    }
#else 
    { 
      res = MP_VAL;
      goto CLEANUP;
   }

   /* q3 = q2 / b**(k+1) */
   mp_rshd(&q, um + 1);
    }
#endif
  }

  /* q3 = q2 / b**(k+1) */
  mp_rshd (&q, um + 1);         

   /* x = x mod b**(k+1), quick (no division) */
   if ((err = mp_mod_2d(x, MP_DIGIT_BIT * (um + 1), x)) != MP_OKAY) {
      goto CLEANUP;
   }
  /* x = x mod b**(k+1), quick (no division) */
  if ((res = mp_mod_2d (x, DIGIT_BIT * (um + 1), x)) != MP_OKAY) {
    goto CLEANUP;
  }

   /* q = q * m mod b**(k+1), quick (no division) */
   if ((err = s_mp_mul_digs(&q, m, &q, um + 1)) != MP_OKAY) {
      goto CLEANUP;
   }
  /* q = q * m mod b**(k+1), quick (no division) */
  if ((res = s_mp_mul_digs (&q, m, &q, um + 1)) != MP_OKAY) {
    goto CLEANUP;
  }

   /* x = x - q */
   if ((err = mp_sub(x, &q, x)) != MP_OKAY) {
      goto CLEANUP;
   }
  /* x = x - q */
  if ((res = mp_sub (x, &q, x)) != MP_OKAY) {
    goto CLEANUP;
  }

   /* If x < 0, add b**(k+1) to it */
   if (mp_cmp_d(x, 0uL) == MP_LT) {
      mp_set(&q, 1uL);
      if ((err = mp_lshd(&q, um + 1)) != MP_OKAY) {
         goto CLEANUP;
  /* If x < 0, add b**(k+1) to it */
  if (mp_cmp_d (x, 0) == MP_LT) {
    mp_set (&q, 1);
    if ((res = mp_lshd (&q, um + 1)) != MP_OKAY)
      goto CLEANUP;
      }
      if ((err = mp_add(x, &q, x)) != MP_OKAY) {
         goto CLEANUP;
      }
   }
    if ((res = mp_add (x, &q, x)) != MP_OKAY)
      goto CLEANUP;
  }


   /* Back off if it's too big */
   while (mp_cmp(x, m) != MP_LT) {
      if ((err = s_mp_sub(x, m, x)) != MP_OKAY) {
         goto CLEANUP;
      }
   }

  /* Back off if it's too big */
  while (mp_cmp (x, m) != MP_LT) {
    if ((res = s_mp_sub (x, m, x)) != MP_OKAY) {
      goto CLEANUP;
    }
  }
  
CLEANUP:
   mp_clear(&q);
  mp_clear (&q);

   return err;
  return res;
}
#endif

Changes to libtommath/bn_mp_reduce_2k.c.

1

2
3

4
5














6
7

8
9
10
11
12
13
14




15
16
17


18
19
20
21


22
23
24


25
26
27


28
29
30

31
32
33


34
35

36
37

38
39
40
41
42
43


44
45

46
47
48

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


-
-
-
-
-
+
+
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+


-
+

-
-
+
+

-
+

-
+
-
-


-
-
+
+

-
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_2K_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* reduces a modulo n where n is of the form 2**p - d */
mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d)
int mp_reduce_2k(mp_int *a, mp_int *n, mp_digit d)
{
   mp_int q;
   mp_err err;
   int    p;

   if ((err = mp_init(&q)) != MP_OKAY) {
      return err;
   int    p, res;
   
   if ((res = mp_init(&q)) != MP_OKAY) {
      return res;
   }

   p = mp_count_bits(n);
   
   p = mp_count_bits(n);    
top:
   /* q = a/2**p, a = a mod 2**p */
   if ((err = mp_div_2d(a, p, &q, a)) != MP_OKAY) {
      goto LBL_ERR;
   if ((res = mp_div_2d(a, p, &q, a)) != MP_OKAY) {
      goto ERR;
   }

   if (d != 1u) {
   
   if (d != 1) {
      /* q = q * d */
      if ((err = mp_mul_d(&q, d, &q)) != MP_OKAY) {
         goto LBL_ERR;
      if ((res = mp_mul_d(&q, d, &q)) != MP_OKAY) { 
         goto ERR;
      }
   }

   
   /* a = a + q */
   if ((err = s_mp_add(a, &q, a)) != MP_OKAY) {
      goto LBL_ERR;
   if ((res = s_mp_add(a, &q, a)) != MP_OKAY) {
      goto ERR;
   }

   
   if (mp_cmp_mag(a, n) != MP_LT) {
      if ((err = s_mp_sub(a, n, a)) != MP_OKAY) {
      s_mp_sub(a, n, a);
         goto LBL_ERR;
      }
      goto top;
   }

LBL_ERR:
   
ERR:
   mp_clear(&q);
   return err;
   return res;
}

#endif

Changes to libtommath/bn_mp_reduce_2k_l.c.

1

2
3

4
5
6















7
8
9
10

11
12
13
14
15
16
17




18
19
20


21
22
23
24


25
26

27
28
29


30
31

32
33
34


35
36

37
38

39
40
41
42
43
44


45
46

47
48
49

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
-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+


-
-
-
-
-
+
+
+
+

-
-
+
+


-
-
+
+

-
+

-
-
+
+

-
+

-
-
+
+

-
+

-
+
-
-


-
-
+
+

-
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_2K_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

/* reduces a modulo n where n is of the form 2**p - d
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* reduces a modulo n where n is of the form 2**p - d 
   This differs from reduce_2k since "d" can be larger
   than a single digit.
*/
mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d)
int mp_reduce_2k_l(mp_int *a, mp_int *n, mp_int *d)
{
   mp_int q;
   mp_err err;
   int    p;

   if ((err = mp_init(&q)) != MP_OKAY) {
      return err;
   int    p, res;
   
   if ((res = mp_init(&q)) != MP_OKAY) {
      return res;
   }

   p = mp_count_bits(n);
   
   p = mp_count_bits(n);    
top:
   /* q = a/2**p, a = a mod 2**p */
   if ((err = mp_div_2d(a, p, &q, a)) != MP_OKAY) {
      goto LBL_ERR;
   if ((res = mp_div_2d(a, p, &q, a)) != MP_OKAY) {
      goto ERR;
   }

   
   /* q = q * d */
   if ((err = mp_mul(&q, d, &q)) != MP_OKAY) {
      goto LBL_ERR;
   if ((res = mp_mul(&q, d, &q)) != MP_OKAY) { 
      goto ERR;
   }

   
   /* a = a + q */
   if ((err = s_mp_add(a, &q, a)) != MP_OKAY) {
      goto LBL_ERR;
   if ((res = s_mp_add(a, &q, a)) != MP_OKAY) {
      goto ERR;
   }

   
   if (mp_cmp_mag(a, n) != MP_LT) {
      if ((err = s_mp_sub(a, n, a)) != MP_OKAY) {
      s_mp_sub(a, n, a);
         goto LBL_ERR;
      }
      goto top;
   }

LBL_ERR:
   
ERR:
   mp_clear(&q);
   return err;
   return res;
}

#endif

Changes to libtommath/bn_mp_reduce_2k_setup.c.

1

2
3

4
5














6
7

8
9

10
11
12
13
14



15
16

17
18

19
20

21
22
23


24
25

26
27

28
29
30
31
32

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
-
-
-
+
+
+

-
+

-
+

-
+

-
-
+
+

-
+

-
+





#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_2K_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* determines the setup value */
mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d)
int mp_reduce_2k_setup(mp_int *a, mp_digit *d)
{
   mp_err err;
   int res, p;
   mp_int tmp;
   int    p;

   if ((err = mp_init(&tmp)) != MP_OKAY) {
      return err;
   
   if ((res = mp_init(&tmp)) != MP_OKAY) {
      return res;
   }

   
   p = mp_count_bits(a);
   if ((err = mp_2expt(&tmp, p)) != MP_OKAY) {
   if ((res = mp_2expt(&tmp, p)) != MP_OKAY) {
      mp_clear(&tmp);
      return err;
      return res;
   }

   if ((err = s_mp_sub(&tmp, a, &tmp)) != MP_OKAY) {
   
   if ((res = s_mp_sub(&tmp, a, &tmp)) != MP_OKAY) {
      mp_clear(&tmp);
      return err;
      return res;
   }

   
   *d = tmp.dp[0];
   mp_clear(&tmp);
   return MP_OKAY;
}
#endif

Changes to libtommath/bn_mp_reduce_2k_setup_l.c.

1

2
3

4
5














6
7

8
9

10
11
12
13



14
15
16
17



18
19
20
21



22
23
24


25
26

27
28

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+

-
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_2K_SETUP_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* determines the setup value */
mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d)
int mp_reduce_2k_setup_l(mp_int *a, mp_int *d)
{
   mp_err err;
   int    res;
   mp_int tmp;

   if ((err = mp_init(&tmp)) != MP_OKAY) {
      return err;
   
   if ((res = mp_init(&tmp)) != MP_OKAY) {
      return res;
   }

   if ((err = mp_2expt(&tmp, mp_count_bits(a))) != MP_OKAY) {
      goto LBL_ERR;
   
   if ((res = mp_2expt(&tmp, mp_count_bits(a))) != MP_OKAY) {
      goto ERR;
   }

   if ((err = s_mp_sub(&tmp, a, d)) != MP_OKAY) {
      goto LBL_ERR;
   
   if ((res = s_mp_sub(&tmp, a, d)) != MP_OKAY) {
      goto ERR;
   }

LBL_ERR:
   
ERR:
   mp_clear(&tmp);
   return err;
   return res;
}
#endif

Changes to libtommath/bn_mp_reduce_is_2k.c.

1

2
3

4
5














6
7

8
9
10
11

12
13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30









31
32
33
34
35

36
37
38

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+



-
+








-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-

+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_IS_2K_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* determines if mp_reduce_2k can be used */
mp_bool mp_reduce_is_2k(const mp_int *a)
int mp_reduce_is_2k(mp_int *a)
{
   int ix, iy, iw;
   mp_digit iz;

   
   if (a->used == 0) {
      return MP_NO;
   } else if (a->used == 1) {
      return MP_YES;
   } else if (a->used > 1) {
      iy = mp_count_bits(a);
      iz = 1;
      iw = 1;

    
      /* Test every bit from the second digit up, must be 1 */
      for (ix = MP_DIGIT_BIT; ix < iy; ix++) {
         if ((a->dp[iw] & iz) == 0u) {
            return MP_NO;
         }
         iz <<= 1;
         if (iz > MP_DIGIT_MAX) {
            ++iw;
            iz = 1;
         }
      for (ix = DIGIT_BIT; ix < iy; ix++) {
          if ((a->dp[iw] & iz) == 0) {
             return MP_NO;
          }
          iz <<= 1;
          if (iz > (mp_digit)MP_MASK) {
             ++iw;
             iz = 1;
          }
      }
      return MP_YES;
   } else {
      return MP_YES;
   }
   return MP_YES;
}

#endif

Changes to libtommath/bn_mp_reduce_is_2k_l.c.

1

2
3

4
5














6
7

8
9
10

11
12
13
14
15
16
17
18
19
20



21
22
23

24
25

26
27
28

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


-
+







-
-
-
+
+
+


-
+
-

+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_IS_2K_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* determines if reduce_2k_l can be used */
mp_bool mp_reduce_is_2k_l(const mp_int *a)
int mp_reduce_is_2k_l(mp_int *a)
{
   int ix, iy;

   
   if (a->used == 0) {
      return MP_NO;
   } else if (a->used == 1) {
      return MP_YES;
   } else if (a->used > 1) {
      /* if more than half of the digits are -1 we're sold */
      for (iy = ix = 0; ix < a->used; ix++) {
         if (a->dp[ix] == MP_DIGIT_MAX) {
            ++iy;
         }
          if (a->dp[ix] == MP_MASK) {
              ++iy;
          }
      }
      return (iy >= (a->used/2)) ? MP_YES : MP_NO;
   } else {
      
      return MP_NO;
   }
   return MP_NO;
}

#endif

Changes to libtommath/bn_mp_reduce_setup.c.

1

2
3

4













5
6
7
8
9

10

11
12
13
14
15





16
17

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+

+
-
-
-
-
-
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_REDUCE_SETUP_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* pre-calculate the value required for Barrett reduction
 * For a given modulus "b" it calulates the value required in "a"
 */
mp_err mp_reduce_setup(mp_int *a, const mp_int *b)
int mp_reduce_setup (mp_int * a, mp_int * b)
{
  int     res;
   mp_err err;
   if ((err = mp_2expt(a, b->used * 2 * MP_DIGIT_BIT)) != MP_OKAY) {
      return err;
   }
   return mp_div(a, b, a, NULL);
  
  if ((res = mp_2expt (a, b->used * 2 * DIGIT_BIT)) != MP_OKAY) {
    return res;
  }
  return mp_div (a, b, a, NULL);
}
#endif

Deleted libtommath/bn_mp_root_u32.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139











































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_ROOT_U32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* find the n'th root of an integer
 *
 * Result found such that (c)**b <= a and (c+1)**b > a
 *
 * This algorithm uses Newton's approximation
 * x[i+1] = x[i] - f(x[i])/f'(x[i])
 * which will find the root in log(N) time where
 * each step involves a fair bit.
 */
mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c)
{
   mp_int t1, t2, t3, a_;
   mp_ord cmp;
   int    ilog2;
   mp_err err;

   /* input must be positive if b is even */
   if (((b & 1u) == 0u) && (a->sign == MP_NEG)) {
      return MP_VAL;
   }

   if ((err = mp_init_multi(&t1, &t2, &t3, NULL)) != MP_OKAY) {
      return err;
   }

   /* if a is negative fudge the sign but keep track */
   a_ = *a;
   a_.sign = MP_ZPOS;

   /* Compute seed: 2^(log_2(n)/b + 2)*/
   ilog2 = mp_count_bits(a);

   /*
     If "b" is larger than INT_MAX it is also larger than
     log_2(n) because the bit-length of the "n" is measured
     with an int and hence the root is always < 2 (two).
   */
   if (b > (uint32_t)(INT_MAX/2)) {
      mp_set(c, 1uL);
      c->sign = a->sign;
      err = MP_OKAY;
      goto LBL_ERR;
   }

   /* "b" is smaller than INT_MAX, we can cast safely */
   if (ilog2 < (int)b) {
      mp_set(c, 1uL);
      c->sign = a->sign;
      err = MP_OKAY;
      goto LBL_ERR;
   }
   ilog2 =  ilog2 / ((int)b);
   if (ilog2 == 0) {
      mp_set(c, 1uL);
      c->sign = a->sign;
      err = MP_OKAY;
      goto LBL_ERR;
   }
   /* Start value must be larger than root */
   ilog2 += 2;
   if ((err = mp_2expt(&t2,ilog2)) != MP_OKAY)                    goto LBL_ERR;
   do {
      /* t1 = t2 */
      if ((err = mp_copy(&t2, &t1)) != MP_OKAY)                   goto LBL_ERR;

      /* t2 = t1 - ((t1**b - a) / (b * t1**(b-1))) */

      /* t3 = t1**(b-1) */
      if ((err = mp_expt_u32(&t1, b - 1u, &t3)) != MP_OKAY)       goto LBL_ERR;

      /* numerator */
      /* t2 = t1**b */
      if ((err = mp_mul(&t3, &t1, &t2)) != MP_OKAY)               goto LBL_ERR;

      /* t2 = t1**b - a */
      if ((err = mp_sub(&t2, &a_, &t2)) != MP_OKAY)               goto LBL_ERR;

      /* denominator */
      /* t3 = t1**(b-1) * b  */
      if ((err = mp_mul_d(&t3, b, &t3)) != MP_OKAY)               goto LBL_ERR;

      /* t3 = (t1**b - a)/(b * t1**(b-1)) */
      if ((err = mp_div(&t2, &t3, &t3, NULL)) != MP_OKAY)         goto LBL_ERR;

      if ((err = mp_sub(&t1, &t3, &t2)) != MP_OKAY)               goto LBL_ERR;

      /*
          Number of rounds is at most log_2(root). If it is more it
          got stuck, so break out of the loop and do the rest manually.
       */
      if (ilog2-- == 0) {
         break;
      }
   }  while (mp_cmp(&t1, &t2) != MP_EQ);

   /* result can be off by a few so check */
   /* Loop beneath can overshoot by one if found root is smaller than actual root */
   for (;;) {
      if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY)            goto LBL_ERR;
      cmp = mp_cmp(&t2, &a_);
      if (cmp == MP_EQ) {
         err = MP_OKAY;
         goto LBL_ERR;
      }
      if (cmp == MP_LT) {
         if ((err = mp_add_d(&t1, 1uL, &t1)) != MP_OKAY)          goto LBL_ERR;
      } else {
         break;
      }
   }
   /* correct overshoot from above or from recurrence */
   for (;;) {
      if ((err = mp_expt_u32(&t1, b, &t2)) != MP_OKAY)            goto LBL_ERR;
      if (mp_cmp(&t2, &a_) == MP_GT) {
         if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY)          goto LBL_ERR;
      } else {
         break;
      }
   }

   /* set the result */
   mp_exch(&t1, c);

   /* set the sign of the result */
   c->sign = a->sign;

   err = MP_OKAY;

LBL_ERR:
   mp_clear_multi(&t1, &t2, &t3, NULL);
   return err;
}

#endif

Changes to libtommath/bn_mp_rshd.c.

1

2
3

4













5
6
7

8
9

10
11
12
13
14
15




16
17
18
19
20
21








22
23

24
25
26


27
28
29


30
31
32
33
34
35





36
37
38
39
40
41





42
43

44
45
46
47
48
49








50
51

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+
-

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_RSHD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* shift right a certain amount of digits */
void mp_rshd(mp_int *a, int b)
void mp_rshd (mp_int * a, int b)
{
   int     x;
  int     x;
   mp_digit *bottom, *top;

   /* if b <= 0 then ignore it */
   if (b <= 0) {
      return;
   }
  /* if b <= 0 then ignore it */
  if (b <= 0) {
    return;
  }

   /* if b > used then simply zero it and return */
   if (a->used <= b) {
      mp_zero(a);
      return;
   }
  /* if b > used then simply zero it and return */
  if (a->used <= b) {
    mp_zero (a);
    return;
  }

  {
    register mp_digit *bottom, *top;

   /* shift the digits down */
    /* shift the digits down */

   /* bottom */
   bottom = a->dp;
    /* bottom */
    bottom = a->dp;

   /* top [offset into digits] */
   top = a->dp + b;
    /* top [offset into digits] */
    top = a->dp + b;

   /* this is implemented as a sliding window where
    * the window is b-digits long and digits from
    * the top of the window are copied to the bottom
    *
    * e.g.
    /* this is implemented as a sliding window where 
     * the window is b-digits long and digits from 
     * the top of the window are copied to the bottom
     *
     * e.g.

    b-2 | b-1 | b0 | b1 | b2 | ... | bb |   ---->
                /\                   |      ---->
                 \-------------------/      ---->
    */
   for (x = 0; x < (a->used - b); x++) {
     b-2 | b-1 | b0 | b1 | b2 | ... | bb |   ---->
                 /\                   |      ---->
                  \-------------------/      ---->
     */
    for (x = 0; x < (a->used - b); x++) {
      *bottom++ = *top++;
   }
    }

   /* zero the top digits */
   MP_ZERO_DIGITS(bottom, a->used - x);

   /* remove excess digits */
   a->used -= b;
    /* zero the top digits */
    for (; x < a->used; x++) {
      *bottom++ = 0;
    }
  }
  
  /* remove excess digits */
  a->used -= b;
}
#endif

Deleted libtommath/bn_mp_sbin_size.c.

1
2
3
4
5
6
7
8
9
10
11











-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SBIN_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* get the size for an signed equivalent */
size_t mp_sbin_size(const mp_int *a)
{
   return 1u + mp_ubin_size(a);
}
#endif

Changes to libtommath/bn_mp_set.c.

1

2
3

4
5














6
7

8

9

10
11

12
13
14

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

+
-
+
-
-
+
-


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_SET_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* set to a digit */
void mp_set(mp_int *a, mp_digit b)
void mp_set (mp_int * a, mp_digit b)
{
  mp_zero (a);
   a->dp[0] = b & MP_MASK;
  a->dp[0] = b & MP_MASK;
   a->sign  = MP_ZPOS;
   a->used  = (a->dp[0] != 0u) ? 1 : 0;
  a->used  = (a->dp[0] != 0) ? 1 : 0;
   MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used);
}
#endif

Deleted libtommath/bn_mp_set_double.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_DOUBLE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#if defined(__STDC_IEC_559__) || defined(__GCC_IEC_559)
mp_err mp_set_double(mp_int *a, double b)
{
   uint64_t frac;
   int exp;
   mp_err err;
   union {
      double   dbl;
      uint64_t bits;
   } cast;
   cast.dbl = b;

   exp = (int)((unsigned)(cast.bits >> 52) & 0x7FFu);
   frac = (cast.bits & (((uint64_t)1 << 52) - (uint64_t)1)) | ((uint64_t)1 << 52);

   if (exp == 0x7FF) { /* +-inf, NaN */
      return MP_VAL;
   }
   exp -= 1023 + 52;

   mp_set_u64(a, frac);

   err = (exp < 0) ? mp_div_2d(a, -exp, a, NULL) : mp_mul_2d(a, exp, a);
   if (err != MP_OKAY) {
      return err;
   }

   if (((cast.bits >> 63) != 0u) && !MP_IS_ZERO(a)) {
      a->sign = MP_NEG;
   }

   return MP_OKAY;
}
#else
/* pragma message() not supported by several compilers (in mostly older but still used versions) */
#  ifdef _MSC_VER
#    pragma message("mp_set_double implementation is only available on platforms with IEEE754 floating point format")
#  else
#    warning "mp_set_double implementation is only available on platforms with IEEE754 floating point format"
#  endif
#endif
#endif

Deleted libtommath/bn_mp_set_i32.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_I32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_SIGNED(mp_set_i32, mp_set_u32, int32_t, uint32_t)
#endif

Deleted libtommath/bn_mp_set_i64.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_I64_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_SIGNED(mp_set_i64, mp_set_u64, int64_t, uint64_t)
#endif

Added libtommath/bn_mp_set_int.c.













































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_SET_INT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* set a 32-bit const */
int mp_set_int (mp_int * a, unsigned long b)
{
  int     x, res;

  mp_zero (a);
  
  /* set four bits at a time */
  for (x = 0; x < 8; x++) {
    /* shift the number up four bits */
    if ((res = mp_mul_2d (a, 4, a)) != MP_OKAY) {
      return res;
    }

    /* OR in the top four bits of the source */
    a->dp[0] |= (b >> 28) & 15;

    /* shift the source up to the next four bits */
    b <<= 4;

    /* ensure that digits are not clamped off */
    a->used += 1;
  }
  mp_clamp (a);
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_mp_set_l.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_L_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_SIGNED(mp_set_l, mp_set_ul, long, unsigned long)
#endif

Deleted libtommath/bn_mp_set_ll.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_LL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_SIGNED(mp_set_ll, mp_set_ull, long long, unsigned long long)
#endif

Deleted libtommath/bn_mp_set_u32.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_U32_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_UNSIGNED(mp_set_u32, uint32_t)
#endif

Deleted libtommath/bn_mp_set_u64.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_U64_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_UNSIGNED(mp_set_u64, uint64_t)
#endif

Deleted libtommath/bn_mp_set_ul.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_UL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_UNSIGNED(mp_set_ul, unsigned long)
#endif

Deleted libtommath/bn_mp_set_ull.c.

1
2
3
4
5
6
7







-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SET_ULL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

MP_SET_UNSIGNED(mp_set_ull, unsigned long long)
#endif

Changes to libtommath/bn_mp_shrink.c.

1

2
3

4
5














6
7

8
9
10
11
12








13
14
15
16
17
18
19
20






21
22

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_SHRINK_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* shrink a bignum */
mp_err mp_shrink(mp_int *a)
int mp_shrink (mp_int * a)
{
   mp_digit *tmp;
   int alloc = MP_MAX(MP_MIN_PREC, a->used);
   if (a->alloc != alloc) {
      if ((tmp = (mp_digit *) MP_REALLOC(a->dp,
  mp_digit *tmp;
  int used = 1;
  
  if(a->used > 0)
    used = a->used;
  
  if (a->alloc != used) {
    if ((tmp = OPT_CAST(mp_digit) XREALLOC (a->dp, sizeof (mp_digit) * used)) == NULL) {
                                         (size_t)a->alloc * sizeof(mp_digit),
                                         (size_t)alloc * sizeof(mp_digit))) == NULL) {
         return MP_MEM;
      }
      a->dp    = tmp;
      a->alloc = alloc;
   }
   return MP_OKAY;
      return MP_MEM;
    }
    a->dp    = tmp;
    a->alloc = used;
  }
  return MP_OKAY;
}
#endif

Added libtommath/bn_mp_signed_bin_size.c.
























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_SIGNED_BIN_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* get the size for an signed equivalent */
int mp_signed_bin_size (mp_int * a)
{
  return 1 + mp_unsigned_bin_size (a);
}
#endif

Deleted libtommath/bn_mp_signed_rsh.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22






















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SIGNED_RSH_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* shift right by a certain bit count with sign extension */
mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c)
{
   mp_err res;
   if (a->sign == MP_ZPOS) {
      return mp_div_2d(a, b, c, NULL);
   }

   res = mp_add_d(a, 1uL, c);
   if (res != MP_OKAY) {
      return res;
   }

   res = mp_div_2d(c, b, c, NULL);
   return (res == MP_OKAY) ? mp_sub_d(c, 1uL, c) : res;
}
#endif

Changes to libtommath/bn_mp_sqr.c.

1

2
3

4













5
6

7

8

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26






























27
28

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* computes b = a*a */
int
mp_err mp_sqr(const mp_int *a, mp_int *b)
mp_sqr (mp_int * a, mp_int * b)
{
  int     res;
   mp_err err;
   if (MP_HAS(S_MP_TOOM_SQR) && /* use Toom-Cook? */
       (a->used >= MP_TOOM_SQR_CUTOFF)) {
      err = s_mp_toom_sqr(a, b);
   } else if (MP_HAS(S_MP_KARATSUBA_SQR) &&  /* Karatsuba? */
              (a->used >= MP_KARATSUBA_SQR_CUTOFF)) {
      err = s_mp_karatsuba_sqr(a, b);
   } else if (MP_HAS(S_MP_SQR_FAST) && /* can we use the fast comba multiplier? */
              (((a->used * 2) + 1) < MP_WARRAY) &&
              (a->used < (MP_MAXFAST / 2))) {
      err = s_mp_sqr_fast(a, b);
   } else if (MP_HAS(S_MP_SQR)) {
      err = s_mp_sqr(a, b);
   } else {
      err = MP_VAL;
   }
   b->sign = MP_ZPOS;
   return err;

#ifdef BN_MP_TOOM_SQR_C
  /* use Toom-Cook? */
  if (a->used >= TOOM_SQR_CUTOFF) {
    res = mp_toom_sqr(a, b);
  /* Karatsuba? */
  } else 
#endif
#ifdef BN_MP_KARATSUBA_SQR_C
if (a->used >= KARATSUBA_SQR_CUTOFF) {
    res = mp_karatsuba_sqr (a, b);
  } else 
#endif
  {
#ifdef BN_FAST_S_MP_SQR_C
    /* can we use the fast comba multiplier? */
    if ((a->used * 2 + 1) < MP_WARRAY && 
         a->used < 
         (1 << (sizeof(mp_word) * CHAR_BIT - 2*DIGIT_BIT - 1))) {
      res = fast_s_mp_sqr (a, b);
    } else
#endif
#ifdef BN_S_MP_SQR_C
      res = s_mp_sqr (a, b);
#else
      res = MP_VAL;
#endif
  }
  b->sign = MP_ZPOS;
  return res;
}
#endif

Changes to libtommath/bn_mp_sqrmod.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

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+

-
-
+
+

-
-
-
+
+
+

-
+
-
-
-
+
+
+
+
-
-
-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_SQRMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* c = a * a (mod b) */
int
mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c)
mp_sqrmod (mp_int * a, mp_int * b, mp_int * c)
{
   mp_err  err;
   mp_int  t;
  int     res;
  mp_int  t;

   if ((err = mp_init(&t)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (&t)) != MP_OKAY) {
    return res;
  }

   if ((err = mp_sqr(a, &t)) != MP_OKAY) {
  if ((res = mp_sqr (a, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
   err = mp_mod(&t, b, c);
    mp_clear (&t);
    return res;
  }
  res = mp_mod (&t, b, c);

LBL_ERR:
   mp_clear(&t);
   return err;
  mp_clear (&t);
  return res;
}
#endif

Changes to libtommath/bn_mp_sqrt.c.

1


2
3

4













5
6
7
8
9
10
11
12
13
14

15
16
17


18
19
20
21




22
23
24
25
26
27




28
29
30
31
32
33
34




















35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

52
53
54
55
56




57
58
59
60
61
62
63






64
65

66
67

68
69
70
71
72
73
74






75
76

77
78

79
80
81


82
83
84


85
86

87
88
89

90
91
92
93

94
95
96


97
98
99
100

101
102

103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128























129
130

131
132
133

134
135
136


137
138
139

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
-
+
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-



-
+

-
-
+
+
-
-
-
-
+
+
+
+


-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
+

-
+

-
-
+
+

-
-
+
+

-
+


-
+



-
+
-
-
-
+
+
-
-
-
-
+
-
-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

-
-
+
-
-
-
+
+



#include "tommath_private.h"
#include <tommath.h>

#ifdef BN_MP_SQRT_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

#ifndef NO_FLOATING_POINT
#include <math.h>
#if (MP_DIGIT_BIT != 28) || (FLT_RADIX != 2) || (DBL_MANT_DIG != 53) || (DBL_MAX_EXP != 1024)
#define NO_FLOATING_POINT
#endif
#endif

/* this function is less generic than mp_n_root, simpler and faster */
mp_err mp_sqrt(const mp_int *arg, mp_int *ret)
int mp_sqrt(mp_int *arg, mp_int *ret) 
{
   mp_err err;
   mp_int t1, t2;
  int res;
  mp_int t1,t2;
#ifndef NO_FLOATING_POINT
   int i, j, k;
   volatile double d;
   mp_digit dig;
  int i, j, k;
#ifndef NO_FLOATING_POINT
  volatile double d;
  mp_digit dig;
#endif

   /* must be positive */
   if (arg->sign == MP_NEG) {
      return MP_VAL;
   }
  /* must be positive */
  if (arg->sign == MP_NEG) {
    return MP_VAL;
  }

   /* easy out */
   if (MP_IS_ZERO(arg)) {
      mp_zero(ret);
      return MP_OKAY;
   }

  /* easy out */
  if (mp_iszero(arg) == MP_YES) {
    mp_zero(ret);
    return MP_OKAY;
  }
  
  i = (arg->used / 2) - 1;
  j = 2 * i;
  if ((res = mp_init_size(&t1, i+2)) != MP_OKAY) {
      return res;
  }
  
  if ((res = mp_init(&t2)) != MP_OKAY) {
    goto E2;
  }

  for (k = 0; k < i; ++k) {
      t1.dp[k] = (mp_digit) 0;
  }
      
#ifndef NO_FLOATING_POINT

   i = (arg->used / 2) - 1;
   j = 2 * i;
   if ((err = mp_init_size(&t1, i+2)) != MP_OKAY) {
      return err;
   }

   if ((err = mp_init(&t2)) != MP_OKAY) {
      goto E2;
   }

   for (k = 0; k < i; ++k) {
      t1.dp[k] = (mp_digit) 0;
   }

   /* Estimate the square root using the hardware floating point unit. */
  /* Estimate the square root using the hardware floating point unit. */

   d = 0.0;
   for (k = arg->used-1; k >= j; --k) {
      d = ldexp(d, MP_DIGIT_BIT) + (double)(arg->dp[k]);
   }
  d = 0.0;
  for (k = arg->used-1; k >= j; --k) {
      d = ldexp(d, DIGIT_BIT) + (double) (arg->dp[k]);
  }

   /*
    * At this point, d is the nearest floating point number to the most
    * significant 1 or 2 mp_digits of arg. Extract its square root.
    */

   d = sqrt(d);
  /* 
   * At this point, d is the nearest floating point number to the most
   * significant 1 or 2 mp_digits of arg. Extract its square root.
   */
     
  d = sqrt(d);

   /* dig is the most significant mp_digit of the square root */
  /* dig is the most significant mp_digit of the square root */

   dig = (mp_digit) ldexp(d, -MP_DIGIT_BIT);
  dig = (mp_digit) ldexp(d, -DIGIT_BIT);

   /*
    * If the most significant digit is nonzero, find the next digit down
    * by subtracting MP_DIGIT_BIT times thie most significant digit.
    * Subtract one from the result so that our initial estimate is always
    * low.
    */
  /* 
   * If the most significant digit is nonzero, find the next digit down
   * by subtracting DIGIT_BIT times thie most significant digit. 
   * Subtract one from the result so that our initial estimate is always
   * low.
   */

   if (dig) {
  if (dig) {
      t1.used = i+2;
      d -= ldexp((double) dig, MP_DIGIT_BIT);
      d -= ldexp((double) dig, DIGIT_BIT);
      if (d >= 1.0) {
         t1.dp[i+1] = dig;
         t1.dp[i] = ((mp_digit) d) - 1;
	  t1.dp[i+1] = dig;
	  t1.dp[i] = ((mp_digit) d) - 1;
      } else {
         t1.dp[i+1] = dig-1;
         t1.dp[i] = MP_DIGIT_MAX;
	  t1.dp[i+1] = dig-1;
	  t1.dp[i] = MP_DIGIT_MAX;
      }
   } else {
  } else {
      t1.used = i+1;
      t1.dp[i] = ((mp_digit) d) - 1;
   }
  }

#else

   if ((err = mp_init_copy(&t1, arg)) != MP_OKAY) {
  /* Estimate the square root as having 1 in the most significant place. */
      return err;
   }


  t1.used = i + 2;
   if ((err = mp_init(&t2)) != MP_OKAY) {
      goto E2;
   }

  t1.dp[i+1] = (mp_digit) 1;
   /* First approx. (not very bad for large arg) */
   mp_rshd(&t1, t1.used/2);
  t1.dp[i] = (mp_digit) 0;

#endif

   /* t1 > 0  */
   if ((err = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) {
      goto E1;
   }
   if ((err = mp_add(&t1, &t2, &t1)) != MP_OKAY) {
      goto E1;
   }
   if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) {
      goto E1;
   }
   /* And now t1 > sqrt(arg) */
   do {
      if ((err = mp_div(arg, &t1, &t2, NULL)) != MP_OKAY) {
         goto E1;
      }
      if ((err = mp_add(&t1, &t2, &t1)) != MP_OKAY) {
         goto E1;
      }
      if ((err = mp_div_2(&t1, &t1)) != MP_OKAY) {
         goto E1;
      }
      /* t1 >= sqrt(arg) >= t2 at this point */
   } while (mp_cmp_mag(&t1, &t2) == MP_GT);
  /* t1 > 0  */ 
  if ((res = mp_div(arg,&t1,&t2,NULL)) != MP_OKAY) {
    goto E1;
  }
  if ((res = mp_add(&t1,&t2,&t1)) != MP_OKAY) {
    goto E1;
  }
  if ((res = mp_div_2(&t1,&t1)) != MP_OKAY) {
    goto E1;
  }
  /* And now t1 > sqrt(arg) */
  do { 
    if ((res = mp_div(arg,&t1,&t2,NULL)) != MP_OKAY) {
      goto E1;
    }
    if ((res = mp_add(&t1,&t2,&t1)) != MP_OKAY) {
      goto E1;
    }
    if ((res = mp_div_2(&t1,&t1)) != MP_OKAY) {
      goto E1;
    }
    /* t1 >= sqrt(arg) >= t2 at this point */
  } while (mp_cmp_mag(&t1,&t2) == MP_GT);

   mp_exch(&t1, ret);
  mp_exch(&t1,ret);

E1:
   mp_clear(&t2);
E1: mp_clear(&t2);
E2:
   mp_clear(&t1);
   return err;
E2: mp_clear(&t1);
  return res;
}

#endif

Deleted libtommath/bn_mp_sqrtmod_prime.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118






















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_SQRTMOD_PRIME_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Tonelli-Shanks algorithm
 * https://en.wikipedia.org/wiki/Tonelli%E2%80%93Shanks_algorithm
 * https://gmplib.org/list-archives/gmp-discuss/2013-April/005300.html
 *
 */

mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret)
{
   mp_err err;
   int legendre;
   mp_int t1, C, Q, S, Z, M, T, R, two;
   mp_digit i;

   /* first handle the simple cases */
   if (mp_cmp_d(n, 0uL) == MP_EQ) {
      mp_zero(ret);
      return MP_OKAY;
   }
   if (mp_cmp_d(prime, 2uL) == MP_EQ)                            return MP_VAL; /* prime must be odd */
   if ((err = mp_kronecker(n, prime, &legendre)) != MP_OKAY)        return err;
   if (legendre == -1)                                           return MP_VAL; /* quadratic non-residue mod prime */

   if ((err = mp_init_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL)) != MP_OKAY) {
      return err;
   }

   /* SPECIAL CASE: if prime mod 4 == 3
    * compute directly: err = n^(prime+1)/4 mod prime
    * Handbook of Applied Cryptography algorithm 3.36
    */
   if ((err = mp_mod_d(prime, 4uL, &i)) != MP_OKAY)               goto cleanup;
   if (i == 3u) {
      if ((err = mp_add_d(prime, 1uL, &t1)) != MP_OKAY)           goto cleanup;
      if ((err = mp_div_2(&t1, &t1)) != MP_OKAY)                  goto cleanup;
      if ((err = mp_div_2(&t1, &t1)) != MP_OKAY)                  goto cleanup;
      if ((err = mp_exptmod(n, &t1, prime, ret)) != MP_OKAY)      goto cleanup;
      err = MP_OKAY;
      goto cleanup;
   }

   /* NOW: Tonelli-Shanks algorithm */

   /* factor out powers of 2 from prime-1, defining Q and S as: prime-1 = Q*2^S */
   if ((err = mp_copy(prime, &Q)) != MP_OKAY)                    goto cleanup;
   if ((err = mp_sub_d(&Q, 1uL, &Q)) != MP_OKAY)                 goto cleanup;
   /* Q = prime - 1 */
   mp_zero(&S);
   /* S = 0 */
   while (MP_IS_EVEN(&Q)) {
      if ((err = mp_div_2(&Q, &Q)) != MP_OKAY)                    goto cleanup;
      /* Q = Q / 2 */
      if ((err = mp_add_d(&S, 1uL, &S)) != MP_OKAY)               goto cleanup;
      /* S = S + 1 */
   }

   /* find a Z such that the Legendre symbol (Z|prime) == -1 */
   mp_set_u32(&Z, 2u);
   /* Z = 2 */
   for (;;) {
      if ((err = mp_kronecker(&Z, prime, &legendre)) != MP_OKAY)     goto cleanup;
      if (legendre == -1) break;
      if ((err = mp_add_d(&Z, 1uL, &Z)) != MP_OKAY)               goto cleanup;
      /* Z = Z + 1 */
   }

   if ((err = mp_exptmod(&Z, &Q, prime, &C)) != MP_OKAY)         goto cleanup;
   /* C = Z ^ Q mod prime */
   if ((err = mp_add_d(&Q, 1uL, &t1)) != MP_OKAY)                goto cleanup;
   if ((err = mp_div_2(&t1, &t1)) != MP_OKAY)                    goto cleanup;
   /* t1 = (Q + 1) / 2 */
   if ((err = mp_exptmod(n, &t1, prime, &R)) != MP_OKAY)         goto cleanup;
   /* R = n ^ ((Q + 1) / 2) mod prime */
   if ((err = mp_exptmod(n, &Q, prime, &T)) != MP_OKAY)          goto cleanup;
   /* T = n ^ Q mod prime */
   if ((err = mp_copy(&S, &M)) != MP_OKAY)                       goto cleanup;
   /* M = S */
   mp_set_u32(&two, 2u);

   for (;;) {
      if ((err = mp_copy(&T, &t1)) != MP_OKAY)                    goto cleanup;
      i = 0;
      for (;;) {
         if (mp_cmp_d(&t1, 1uL) == MP_EQ) break;
         if ((err = mp_exptmod(&t1, &two, prime, &t1)) != MP_OKAY) goto cleanup;
         i++;
      }
      if (i == 0u) {
         if ((err = mp_copy(&R, ret)) != MP_OKAY)                  goto cleanup;
         err = MP_OKAY;
         goto cleanup;
      }
      if ((err = mp_sub_d(&M, i, &t1)) != MP_OKAY)                goto cleanup;
      if ((err = mp_sub_d(&t1, 1uL, &t1)) != MP_OKAY)             goto cleanup;
      if ((err = mp_exptmod(&two, &t1, prime, &t1)) != MP_OKAY)   goto cleanup;
      /* t1 = 2 ^ (M - i - 1) */
      if ((err = mp_exptmod(&C, &t1, prime, &t1)) != MP_OKAY)     goto cleanup;
      /* t1 = C ^ (2 ^ (M - i - 1)) mod prime */
      if ((err = mp_sqrmod(&t1, prime, &C)) != MP_OKAY)           goto cleanup;
      /* C = (t1 * t1) mod prime */
      if ((err = mp_mulmod(&R, &t1, prime, &R)) != MP_OKAY)       goto cleanup;
      /* R = (R * t1) mod prime */
      if ((err = mp_mulmod(&T, &C, prime, &T)) != MP_OKAY)        goto cleanup;
      /* T = (T * C) mod prime */
      mp_set(&M, i);
      /* M = i */
   }

cleanup:
   mp_clear_multi(&t1, &C, &Q, &S, &Z, &M, &T, &R, &two, NULL);
   return err;
}

#endif

Changes to libtommath/bn_mp_sub.c.

1

2
3

4













5
6

7

8



9

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37


























38
39
40

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

+
+
+
-
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_SUB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* high level subtraction (handles signs) */
int
mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
mp_sub (mp_int * a, mp_int * b, mp_int * c)
{
  int     sa, sb, res;

  sa = a->sign;
   mp_sign sa = a->sign, sb = b->sign;
  sb = b->sign;
   mp_err err;

   if (sa != sb) {
      /* subtract a negative from a positive, OR */
      /* subtract a positive from a negative. */
      /* In either case, ADD their magnitudes, */
      /* and use the sign of the first number. */
      c->sign = sa;
      err = s_mp_add(a, b, c);
   } else {
      /* subtract a positive from a positive, OR */
      /* subtract a negative from a negative. */
      /* First, take the difference between their */
      /* magnitudes, then... */
      if (mp_cmp_mag(a, b) != MP_LT) {
         /* Copy the sign from the first */
         c->sign = sa;
         /* The first has a larger or equal magnitude */
         err = s_mp_sub(a, b, c);
      } else {
         /* The result has the *opposite* sign from */
         /* the first number. */
         c->sign = (sa == MP_ZPOS) ? MP_NEG : MP_ZPOS;
         /* The second has a larger magnitude */
         err = s_mp_sub(b, a, c);
      }
   }
   return err;
  if (sa != sb) {
    /* subtract a negative from a positive, OR */
    /* subtract a positive from a negative. */
    /* In either case, ADD their magnitudes, */
    /* and use the sign of the first number. */
    c->sign = sa;
    res = s_mp_add (a, b, c);
  } else {
    /* subtract a positive from a positive, OR */
    /* subtract a negative from a negative. */
    /* First, take the difference between their */
    /* magnitudes, then... */
    if (mp_cmp_mag (a, b) != MP_LT) {
      /* Copy the sign from the first */
      c->sign = sa;
      /* The first has a larger or equal magnitude */
      res = s_mp_sub (a, b, c);
    } else {
      /* The result has the *opposite* sign from */
      /* the first number. */
      c->sign = (sa == MP_ZPOS) ? MP_NEG : MP_ZPOS;
      /* The second has a larger magnitude */
      res = s_mp_sub (b, a, c);
    }
  }
  return res;
}

#endif

Changes to libtommath/bn_mp_sub_d.c.

1

2
3

4













5
6

7

8
9

10
11

12
13
14
15
16
17
18






19
20
21
22
23




24
25
26
27



28
29
30


31
32
33


34
35
36
37
38




39
40
41
42
43
44
45
46
47








48
49
50
51
52




53
54
55
56
57



58
59
60
61
62
63
64
65












66
67
68
69
70
71






72
73
74

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
+
-
-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_SUB_D_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* single digit subtraction */
int
mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c)
mp_sub_d (mp_int * a, mp_digit b, mp_int * c)
{
   mp_digit *tmpa, *tmpc;
  mp_digit *tmpa, *tmpc, mu;
   mp_err    err;
   int       ix, oldused;
  int       res, ix, oldused;

   /* grow c as required */
   if (c->alloc < (a->used + 1)) {
      if ((err = mp_grow(c, a->used + 1)) != MP_OKAY) {
         return err;
      }
   }
  /* grow c as required */
  if (c->alloc < a->used + 1) {
     if ((res = mp_grow(c, a->used + 1)) != MP_OKAY) {
        return res;
     }
  }

   /* if a is negative just do an unsigned
    * addition [with fudged signs]
    */
   if (a->sign == MP_NEG) {
  /* if a is negative just do an unsigned
   * addition [with fudged signs]
   */
  if (a->sign == MP_NEG) {
      mp_int a_ = *a;
      a_.sign = MP_ZPOS;
      err     = mp_add_d(&a_, b, c);
      c->sign = MP_NEG;
     a->sign = MP_ZPOS;
     res     = mp_add_d(a, b, c);
     a->sign = c->sign = MP_NEG;

      /* clamp */
      mp_clamp(c);
     /* clamp */
     mp_clamp(c);

      return err;
   }
     return res;
  }

   /* setup regs */
   oldused = c->used;
   tmpa    = a->dp;
   tmpc    = c->dp;
  /* setup regs */
  oldused = c->used;
  tmpa    = a->dp;
  tmpc    = c->dp;

   /* if a <= b simply fix the single digit */
   if (((a->used == 1) && (a->dp[0] <= b)) || (a->used == 0)) {
      if (a->used == 1) {
         *tmpc++ = b - *tmpa;
      } else {
         *tmpc++ = b;
      }
      ix      = 1;
  /* if a <= b simply fix the single digit */
  if ((a->used == 1 && a->dp[0] <= b) || a->used == 0) {
     if (a->used == 1) {
        *tmpc++ = b - *tmpa;
     } else {
        *tmpc++ = b;
     }
     ix      = 1;

      /* negative/1digit */
      c->sign = MP_NEG;
      c->used = 1;
   } else {
     /* negative/1digit */
     c->sign = MP_NEG;
     c->used = 1;
  } else {
      mp_digit mu = b;

      /* positive/size */
      c->sign = MP_ZPOS;
      c->used = a->used;
     /* positive/size */
     c->sign = MP_ZPOS;
     c->used = a->used;

      /* subtract digits, mu is carry */
      for (ix = 0; ix < a->used; ix++) {
         *tmpc    = *tmpa++ - mu;
         mu       = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u);
         *tmpc++ &= MP_MASK;
      }
   }
     /* subtract first digit */
     *tmpc    = *tmpa++ - b;
     mu       = *tmpc >> (sizeof(mp_digit) * CHAR_BIT - 1);
     *tmpc++ &= MP_MASK;

     /* handle rest of the digits */
     for (ix = 1; ix < a->used; ix++) {
        *tmpc    = *tmpa++ - mu;
        mu       = *tmpc >> (sizeof(mp_digit) * CHAR_BIT - 1);
        *tmpc++ &= MP_MASK;
     }
  }

   /* zero excess digits */
   MP_ZERO_DIGITS(tmpc, oldused - ix);

   mp_clamp(c);
   return MP_OKAY;
  /* zero excess digits */
  while (ix++ < oldused) {
     *tmpc++ = 0;
  }
  mp_clamp(c);
  return MP_OKAY;
}

#endif

Changes to libtommath/bn_mp_submod.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

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+

-
-
+
+

+
-
-
-
+
+
+

-
+
-
-
-
+
+
+
+
-
-
-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_SUBMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* d = a - b (mod c) */
int
mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d)
mp_submod (mp_int * a, mp_int * b, mp_int * c, mp_int * d)
{
   mp_err err;
   mp_int t;
  int     res;
  mp_int  t;


   if ((err = mp_init(&t)) != MP_OKAY) {
      return err;
   }
  if ((res = mp_init (&t)) != MP_OKAY) {
    return res;
  }

   if ((err = mp_sub(a, b, &t)) != MP_OKAY) {
  if ((res = mp_sub (a, b, &t)) != MP_OKAY) {
      goto LBL_ERR;
   }
   err = mp_mod(&t, c, d);
    mp_clear (&t);
    return res;
  }
  res = mp_mod (&t, c, d);

LBL_ERR:
   mp_clear(&t);
   return err;
  mp_clear (&t);
  return res;
}
#endif

Deleted libtommath/bn_mp_to_radix.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84




















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_TO_RADIX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* stores a bignum as a ASCII string in a given radix (2..64)
 *
 * Stores upto "size - 1" chars and always a NULL byte, puts the number of characters
 * written, including the '\0', in "written".
 */
mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix)
{
   size_t  digs;
   mp_err  err;
   mp_int  t;
   mp_digit d;
   char   *_s = str;

   /* check range of radix and size*/
   if (maxlen < 2u) {
      return MP_BUF;
   }
   if ((radix < 2) || (radix > 64)) {
      return MP_VAL;
   }

   /* quick out if its zero */
   if (MP_IS_ZERO(a)) {
      *str++ = '0';
      *str = '\0';
      if (written != NULL) {
         *written = 2u;
      }
      return MP_OKAY;
   }

   if ((err = mp_init_copy(&t, a)) != MP_OKAY) {
      return err;
   }

   /* if it is negative output a - */
   if (t.sign == MP_NEG) {
      /* we have to reverse our digits later... but not the - sign!! */
      ++_s;

      /* store the flag and mark the number as positive */
      *str++ = '-';
      t.sign = MP_ZPOS;

      /* subtract a char */
      --maxlen;
   }
   digs = 0u;
   while (!MP_IS_ZERO(&t)) {
      if (--maxlen < 1u) {
         /* no more room */
         err = MP_BUF;
         goto LBL_ERR;
      }
      if ((err = mp_div_d(&t, (mp_digit)radix, &t, &d)) != MP_OKAY) {
         goto LBL_ERR;
      }
      *str++ = mp_s_rmap[d];
      ++digs;
   }
   /* reverse the digits of the string.  In this case _s points
    * to the first digit [exluding the sign] of the number
    */
   s_mp_reverse((unsigned char *)_s, digs);

   /* append a NULL so the string is properly terminated */
   *str = '\0';
   digs++;

   if (written != NULL) {
      *written = (a->sign == MP_NEG) ? (digs + 1u): digs;
   }

LBL_ERR:
   mp_clear(&t);
   return err;
}

#endif

Deleted libtommath/bn_mp_to_sbin.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22






















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_TO_SBIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* store in signed [big endian] format */
mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written)
{
   mp_err err;
   if (maxlen == 0u) {
      return MP_BUF;
   }
   if ((err = mp_to_ubin(a, buf + 1, maxlen - 1u, written)) != MP_OKAY) {
      return err;
   }
   if (written != NULL) {
      (*written)++;
   }
   buf[0] = (a->sign == MP_ZPOS) ? (unsigned char)0 : (unsigned char)1;
   return MP_OKAY;
}
#endif

Added libtommath/bn_mp_to_signed_bin.c.






























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TO_SIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* store in signed [big endian] format */
int mp_to_signed_bin (mp_int * a, unsigned char *b)
{
  int     res;

  if ((res = mp_to_unsigned_bin (a, b + 1)) != MP_OKAY) {
    return res;
  }
  b[0] = (unsigned char) ((a->sign == MP_ZPOS) ? 0 : 1);
  return MP_OKAY;
}
#endif

Added libtommath/bn_mp_to_signed_bin_n.c.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TO_SIGNED_BIN_N_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* store in signed [big endian] format */
int mp_to_signed_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
{
   if (*outlen < (unsigned long)mp_signed_bin_size(a)) {
      return MP_VAL;
   }
   *outlen = mp_signed_bin_size(a);
   return mp_to_signed_bin(a, b);
}
#endif

Deleted libtommath/bn_mp_to_ubin.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41









































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_TO_UBIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* store in unsigned [big endian] format */
mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written)
{
   size_t  x, count;
   mp_err  err;
   mp_int  t;

   count = mp_ubin_size(a);
   if (count > maxlen) {
      return MP_BUF;
   }

   if ((err = mp_init_copy(&t, a)) != MP_OKAY) {
      return err;
   }

   for (x = count; x --> 0u;) {
#ifndef MP_8BIT
      buf[x] = (unsigned char)(t.dp[0] & 255u);
#else
      buf[x] = (unsigned char)(t.dp[0] | ((t.dp[1] & 1u) << 7));
#endif
      if ((err = mp_div_2d(&t, 8, &t, NULL)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }

   if (written != NULL) {
      *written = count;
   }

LBL_ERR:
   mp_clear(&t);
   return err;
}
#endif

Added libtommath/bn_mp_to_unsigned_bin.c.













































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TO_UNSIGNED_BIN_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* store in unsigned [big endian] format */
int mp_to_unsigned_bin (mp_int * a, unsigned char *b)
{
  int     x, res;
  mp_int  t;

  if ((res = mp_init_copy (&t, a)) != MP_OKAY) {
    return res;
  }

  x = 0;
  while (mp_iszero (&t) == 0) {
#ifndef MP_8BIT
      b[x++] = (unsigned char) (t.dp[0] & 255);
#else
      b[x++] = (unsigned char) (t.dp[0] | ((t.dp[1] & 0x01) << 7));
#endif
    if ((res = mp_div_2d (&t, 8, &t, NULL)) != MP_OKAY) {
      mp_clear (&t);
      return res;
    }
  }
  bn_reverse (b, x);
  mp_clear (&t);
  return MP_OKAY;
}
#endif

Added libtommath/bn_mp_to_unsigned_bin_n.c.




























1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TO_UNSIGNED_BIN_N_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* store in unsigned [big endian] format */
int mp_to_unsigned_bin_n (mp_int * a, unsigned char *b, unsigned long *outlen)
{
   if (*outlen < (unsigned long)mp_unsigned_bin_size(a)) {
      return MP_VAL;
   }
   *outlen = mp_unsigned_bin_size(a);
   return mp_to_unsigned_bin(a, b);
}
#endif

Added libtommath/bn_mp_toom_mul.c.

























































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TOOM_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* multiplication using the Toom-Cook 3-way algorithm 
 *
 * Much more complicated than Karatsuba but has a lower 
 * asymptotic running time of O(N**1.464).  This algorithm is 
 * only particularly useful on VERY large inputs 
 * (we're talking 1000s of digits here...).
*/
int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c)
{
    mp_int w0, w1, w2, w3, w4, tmp1, tmp2, a0, a1, a2, b0, b1, b2;
    int res, B;
        
    /* init temps */
    if ((res = mp_init_multi(&w0, &w1, &w2, &w3, &w4, 
                             &a0, &a1, &a2, &b0, &b1, 
                             &b2, &tmp1, &tmp2, NULL)) != MP_OKAY) {
       return res;
    }
    
    /* B */
    B = MIN(a->used, b->used) / 3;
    
    /* a = a2 * B**2 + a1 * B + a0 */
    if ((res = mp_mod_2d(a, DIGIT_BIT * B, &a0)) != MP_OKAY) {
       goto ERR;
    }

    if ((res = mp_copy(a, &a1)) != MP_OKAY) {
       goto ERR;
    }
    mp_rshd(&a1, B);
    mp_mod_2d(&a1, DIGIT_BIT * B, &a1);

    if ((res = mp_copy(a, &a2)) != MP_OKAY) {
       goto ERR;
    }
    mp_rshd(&a2, B*2);
    
    /* b = b2 * B**2 + b1 * B + b0 */
    if ((res = mp_mod_2d(b, DIGIT_BIT * B, &b0)) != MP_OKAY) {
       goto ERR;
    }

    if ((res = mp_copy(b, &b1)) != MP_OKAY) {
       goto ERR;
    }
    mp_rshd(&b1, B);
    mp_mod_2d(&b1, DIGIT_BIT * B, &b1);

    if ((res = mp_copy(b, &b2)) != MP_OKAY) {
       goto ERR;
    }
    mp_rshd(&b2, B*2);
    
    /* w0 = a0*b0 */
    if ((res = mp_mul(&a0, &b0, &w0)) != MP_OKAY) {
       goto ERR;
    }
    
    /* w4 = a2 * b2 */
    if ((res = mp_mul(&a2, &b2, &w4)) != MP_OKAY) {
       goto ERR;
    }
    
    /* w1 = (a2 + 2(a1 + 2a0))(b2 + 2(b1 + 2b0)) */
    if ((res = mp_mul_2(&a0, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a2, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    
    if ((res = mp_mul_2(&b0, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp2, &b2, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    
    if ((res = mp_mul(&tmp1, &tmp2, &w1)) != MP_OKAY) {
       goto ERR;
    }
    
    /* w3 = (a0 + 2(a1 + 2a2))(b0 + 2(b1 + 2b2)) */
    if ((res = mp_mul_2(&a2, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    
    if ((res = mp_mul_2(&b2, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp2, &b1, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_mul_2(&tmp2, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    
    if ((res = mp_mul(&tmp1, &tmp2, &w3)) != MP_OKAY) {
       goto ERR;
    }
    

    /* w2 = (a2 + a1 + a0)(b2 + b1 + b0) */
    if ((res = mp_add(&a2, &a1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&b2, &b1, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp2, &b0, &tmp2)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_mul(&tmp1, &tmp2, &w2)) != MP_OKAY) {
       goto ERR;
    }
    
    /* now solve the matrix 
    
       0  0  0  0  1
       1  2  4  8  16
       1  1  1  1  1
       16 8  4  2  1
       1  0  0  0  0
       
       using 12 subtractions, 4 shifts, 
              2 small divisions and 1 small multiplication 
     */
     
     /* r1 - r4 */
     if ((res = mp_sub(&w1, &w4, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - r0 */
     if ((res = mp_sub(&w3, &w0, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r1/2 */
     if ((res = mp_div_2(&w1, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3/2 */
     if ((res = mp_div_2(&w3, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r2 - r0 - r4 */
     if ((res = mp_sub(&w2, &w0, &w2)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w2, &w4, &w2)) != MP_OKAY) {
        goto ERR;
     }
     /* r1 - r2 */
     if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - r2 */
     if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r1 - 8r0 */
     if ((res = mp_mul_2d(&w0, 3, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w1, &tmp1, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - 8r4 */
     if ((res = mp_mul_2d(&w4, 3, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w3, &tmp1, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* 3r2 - r1 - r3 */
     if ((res = mp_mul_d(&w2, 3, &w2)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w2, &w1, &w2)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w2, &w3, &w2)) != MP_OKAY) {
        goto ERR;
     }
     /* r1 - r2 */
     if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - r2 */
     if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r1/3 */
     if ((res = mp_div_3(&w1, &w1, NULL)) != MP_OKAY) {
        goto ERR;
     }
     /* r3/3 */
     if ((res = mp_div_3(&w3, &w3, NULL)) != MP_OKAY) {
        goto ERR;
     }
     
     /* at this point shift W[n] by B*n */
     if ((res = mp_lshd(&w1, 1*B)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_lshd(&w2, 2*B)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_lshd(&w3, 3*B)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_lshd(&w4, 4*B)) != MP_OKAY) {
        goto ERR;
     }     
     
     if ((res = mp_add(&w0, &w1, c)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_add(&w2, &w3, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_add(&w4, &tmp1, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_add(&tmp1, c, c)) != MP_OKAY) {
        goto ERR;
     }     
     
ERR:
     mp_clear_multi(&w0, &w1, &w2, &w3, &w4, 
                    &a0, &a1, &a2, &b0, &b1, 
                    &b2, &tmp1, &tmp2, NULL);
     return res;
}     
     
#endif

Added libtommath/bn_mp_toom_sqr.c.































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TOOM_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* squaring using Toom-Cook 3-way algorithm */
int
mp_toom_sqr(mp_int *a, mp_int *b)
{
    mp_int w0, w1, w2, w3, w4, tmp1, a0, a1, a2;
    int res, B;

    /* init temps */
    if ((res = mp_init_multi(&w0, &w1, &w2, &w3, &w4, &a0, &a1, &a2, &tmp1, NULL)) != MP_OKAY) {
       return res;
    }

    /* B */
    B = a->used / 3;

    /* a = a2 * B**2 + a1 * B + a0 */
    if ((res = mp_mod_2d(a, DIGIT_BIT * B, &a0)) != MP_OKAY) {
       goto ERR;
    }

    if ((res = mp_copy(a, &a1)) != MP_OKAY) {
       goto ERR;
    }
    mp_rshd(&a1, B);
    mp_mod_2d(&a1, DIGIT_BIT * B, &a1);

    if ((res = mp_copy(a, &a2)) != MP_OKAY) {
       goto ERR;
    }
    mp_rshd(&a2, B*2);

    /* w0 = a0*a0 */
    if ((res = mp_sqr(&a0, &w0)) != MP_OKAY) {
       goto ERR;
    }

    /* w4 = a2 * a2 */
    if ((res = mp_sqr(&a2, &w4)) != MP_OKAY) {
       goto ERR;
    }

    /* w1 = (a2 + 2(a1 + 2a0))**2 */
    if ((res = mp_mul_2(&a0, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a2, &tmp1)) != MP_OKAY) {
       goto ERR;
    }

    if ((res = mp_sqr(&tmp1, &w1)) != MP_OKAY) {
       goto ERR;
    }

    /* w3 = (a0 + 2(a1 + 2a2))**2 */
    if ((res = mp_mul_2(&a2, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_mul_2(&tmp1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
       goto ERR;
    }

    if ((res = mp_sqr(&tmp1, &w3)) != MP_OKAY) {
       goto ERR;
    }


    /* w2 = (a2 + a1 + a0)**2 */
    if ((res = mp_add(&a2, &a1, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_add(&tmp1, &a0, &tmp1)) != MP_OKAY) {
       goto ERR;
    }
    if ((res = mp_sqr(&tmp1, &w2)) != MP_OKAY) {
       goto ERR;
    }

    /* now solve the matrix

       0  0  0  0  1
       1  2  4  8  16
       1  1  1  1  1
       16 8  4  2  1
       1  0  0  0  0

       using 12 subtractions, 4 shifts, 2 small divisions and 1 small multiplication.
     */

     /* r1 - r4 */
     if ((res = mp_sub(&w1, &w4, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - r0 */
     if ((res = mp_sub(&w3, &w0, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r1/2 */
     if ((res = mp_div_2(&w1, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3/2 */
     if ((res = mp_div_2(&w3, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r2 - r0 - r4 */
     if ((res = mp_sub(&w2, &w0, &w2)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w2, &w4, &w2)) != MP_OKAY) {
        goto ERR;
     }
     /* r1 - r2 */
     if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - r2 */
     if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r1 - 8r0 */
     if ((res = mp_mul_2d(&w0, 3, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w1, &tmp1, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - 8r4 */
     if ((res = mp_mul_2d(&w4, 3, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w3, &tmp1, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* 3r2 - r1 - r3 */
     if ((res = mp_mul_d(&w2, 3, &w2)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w2, &w1, &w2)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_sub(&w2, &w3, &w2)) != MP_OKAY) {
        goto ERR;
     }
     /* r1 - r2 */
     if ((res = mp_sub(&w1, &w2, &w1)) != MP_OKAY) {
        goto ERR;
     }
     /* r3 - r2 */
     if ((res = mp_sub(&w3, &w2, &w3)) != MP_OKAY) {
        goto ERR;
     }
     /* r1/3 */
     if ((res = mp_div_3(&w1, &w1, NULL)) != MP_OKAY) {
        goto ERR;
     }
     /* r3/3 */
     if ((res = mp_div_3(&w3, &w3, NULL)) != MP_OKAY) {
        goto ERR;
     }

     /* at this point shift W[n] by B*n */
     if ((res = mp_lshd(&w1, 1*B)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_lshd(&w2, 2*B)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_lshd(&w3, 3*B)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_lshd(&w4, 4*B)) != MP_OKAY) {
        goto ERR;
     }

     if ((res = mp_add(&w0, &w1, b)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_add(&w2, &w3, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_add(&w4, &tmp1, &tmp1)) != MP_OKAY) {
        goto ERR;
     }
     if ((res = mp_add(&tmp1, b, b)) != MP_OKAY) {
        goto ERR;
     }

ERR:
     mp_clear_multi(&w0, &w1, &w2, &w3, &w4, &a0, &a1, &a2, &tmp1, NULL);
     return res;
}

#endif

Added libtommath/bn_mp_toradix.c.








































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TORADIX_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* stores a bignum as a ASCII string in a given radix (2..64) */
int mp_toradix (mp_int * a, char *str, int radix)
{
  int     res, digs;
  mp_int  t;
  mp_digit d;
  char   *_s = str;

  /* check range of the radix */
  if (radix < 2 || radix > 64) {
    return MP_VAL;
  }

  /* quick out if its zero */
  if (mp_iszero(a) == 1) {
     *str++ = '0';
     *str = '\0';
     return MP_OKAY;
  }

  if ((res = mp_init_copy (&t, a)) != MP_OKAY) {
    return res;
  }

  /* if it is negative output a - */
  if (t.sign == MP_NEG) {
    ++_s;
    *str++ = '-';
    t.sign = MP_ZPOS;
  }

  digs = 0;
  while (mp_iszero (&t) == 0) {
    if ((res = mp_div_d (&t, (mp_digit) radix, &t, &d)) != MP_OKAY) {
      mp_clear (&t);
      return res;
    }
    *str++ = mp_s_rmap[d];
    ++digs;
  }

  /* reverse the digits of the string.  In this case _s points
   * to the first digit [exluding the sign] of the number]
   */
  bn_reverse ((unsigned char *)_s, digs);

  /* append a NULL so the string is properly terminated */
  *str = '\0';

  mp_clear (&t);
  return MP_OKAY;
}

#endif

Added libtommath/bn_mp_toradix_n.c.





















































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_TORADIX_N_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* stores a bignum as a ASCII string in a given radix (2..64) 
 *
 * Stores upto maxlen-1 chars and always a NULL byte 
 */
int mp_toradix_n(mp_int * a, char *str, int radix, int maxlen)
{
  int     res, digs;
  mp_int  t;
  mp_digit d;
  char   *_s = str;

  /* check range of the maxlen, radix */
  if (maxlen < 2 || radix < 2 || radix > 64) {
    return MP_VAL;
  }

  /* quick out if its zero */
  if (mp_iszero(a) == MP_YES) {
     *str++ = '0';
     *str = '\0';
     return MP_OKAY;
  }

  if ((res = mp_init_copy (&t, a)) != MP_OKAY) {
    return res;
  }

  /* if it is negative output a - */
  if (t.sign == MP_NEG) {
    /* we have to reverse our digits later... but not the - sign!! */
    ++_s;

    /* store the flag and mark the number as positive */
    *str++ = '-';
    t.sign = MP_ZPOS;
 
    /* subtract a char */
    --maxlen;
  }

  digs = 0;
  while (mp_iszero (&t) == 0) {
    if (--maxlen < 1) {
       /* no more room */
       break;
    }
    if ((res = mp_div_d (&t, (mp_digit) radix, &t, &d)) != MP_OKAY) {
      mp_clear (&t);
      return res;
    }
    *str++ = mp_s_rmap[d];
    ++digs;
  }

  /* reverse the digits of the string.  In this case _s points
   * to the first digit [exluding the sign] of the number
   */
  bn_reverse ((unsigned char *)_s, digs);

  /* append a NULL so the string is properly terminated */
  *str = '\0';

  mp_clear (&t);
  return MP_OKAY;
}

#endif

Deleted libtommath/bn_mp_ubin_size.c.

1
2
3
4
5
6
7
8
9
10
11
12












-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_UBIN_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* get the size for an unsigned equivalent */
size_t mp_ubin_size(const mp_int *a)
{
   size_t size = (size_t)mp_count_bits(a);
   return (size / 8u) + (((size & 7u) != 0u) ? 1u : 0u);
}
#endif

Deleted libtommath/bn_mp_unpack.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_MP_UNPACK_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* based on gmp's mpz_import.
 * see http://gmplib.org/manual/Integer-Import-and-Export.html
 */
mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size,
                 mp_endian endian, size_t nails, const void *op)
{
   mp_err err;
   size_t odd_nails, nail_bytes, i, j;
   unsigned char odd_nail_mask;

   mp_zero(rop);

   if (endian == MP_NATIVE_ENDIAN) {
      MP_GET_ENDIANNESS(endian);
   }

   odd_nails = (nails % 8u);
   odd_nail_mask = 0xff;
   for (i = 0; i < odd_nails; ++i) {
      odd_nail_mask ^= (unsigned char)(1u << (7u - i));
   }
   nail_bytes = nails / 8u;

   for (i = 0; i < count; ++i) {
      for (j = 0; j < (size - nail_bytes); ++j) {
         unsigned char byte = *((const unsigned char *)op +
                                (((order == MP_MSB_FIRST) ? i : ((count - 1u) - i)) * size) +
                                ((endian == MP_BIG_ENDIAN) ? (j + nail_bytes) : (((size - 1u) - j) - nail_bytes)));

         if ((err = mp_mul_2d(rop, (j == 0u) ? (int)(8u - odd_nails) : 8, rop)) != MP_OKAY) {
            return err;
         }

         rop->dp[0] |= (j == 0u) ? (mp_digit)(byte & odd_nail_mask) : (mp_digit)byte;
         rop->used  += 1;
      }
   }

   mp_clamp(rop);

   return MP_OKAY;
}

#endif

Added libtommath/bn_mp_unsigned_bin_size.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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_MP_UNSIGNED_BIN_SIZE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* get the size for an unsigned equivalent */
int mp_unsigned_bin_size (mp_int * a)
{
  int     size = mp_count_bits (a);
  return (size / 8 + ((size & 7) != 0 ? 1 : 0));
}
#endif

Changes to libtommath/bn_mp_xor.c.

1

2
3
4
5
6
7
8
9

10
11
12
13
14
15
16

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
-
+







-
+







#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_XOR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* two complement xor */
mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c)
{
   int used = MP_MAX(a->used, b->used) + 1, i;
   int used = MAX(a->used, b->used) + 1, i;
   mp_err err;
   mp_digit ac = 1, bc = 1, cc = 1;
   mp_sign csign = (a->sign != b->sign) ? MP_NEG : MP_ZPOS;

   if (c->alloc < used) {
      if ((err = mp_grow(c, used)) != MP_OKAY) {
         return err;

Changes to libtommath/bn_mp_zero.c.

1

2
3

4
5














6
7

8



9
10
11







12
13

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+

+
+
+
-
-
-
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_MP_ZERO_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* set to zero */
void mp_zero(mp_int *a)
void mp_zero (mp_int * a)
{
  int       n;
  mp_digit *tmp;

   a->sign = MP_ZPOS;
   a->used = 0;
   MP_ZERO_DIGITS(a->dp, a->alloc);
  a->sign = MP_ZPOS;
  a->used = 0;

  tmp = a->dp;
  for (n = 0; n < a->alloc; n++) {
     *tmp++ = 0;
  }
}
#endif

Changes to libtommath/bn_prime_tab.c.

1

2
3

4
5













6
7
8
9
10




11
12
13
14
15
16





17
18
19
20
21
22
23
24
25








26
27
28
29
30
31
32
33
34








35
36
37
38
39
40
41
42
43








44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_PRIME_TAB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */
const mp_digit ltm_prime_tab[] = {
   0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013,
   0x0017, 0x001D, 0x001F, 0x0025, 0x0029, 0x002B, 0x002F, 0x0035,
   0x003B, 0x003D, 0x0043, 0x0047, 0x0049, 0x004F, 0x0053, 0x0059,
   0x0061, 0x0065, 0x0067, 0x006B, 0x006D, 0x0071, 0x007F,
  0x0002, 0x0003, 0x0005, 0x0007, 0x000B, 0x000D, 0x0011, 0x0013,
  0x0017, 0x001D, 0x001F, 0x0025, 0x0029, 0x002B, 0x002F, 0x0035,
  0x003B, 0x003D, 0x0043, 0x0047, 0x0049, 0x004F, 0x0053, 0x0059,
  0x0061, 0x0065, 0x0067, 0x006B, 0x006D, 0x0071, 0x007F,
#ifndef MP_8BIT
   0x0083,
   0x0089, 0x008B, 0x0095, 0x0097, 0x009D, 0x00A3, 0x00A7, 0x00AD,
   0x00B3, 0x00B5, 0x00BF, 0x00C1, 0x00C5, 0x00C7, 0x00D3, 0x00DF,
   0x00E3, 0x00E5, 0x00E9, 0x00EF, 0x00F1, 0x00FB, 0x0101, 0x0107,
   0x010D, 0x010F, 0x0115, 0x0119, 0x011B, 0x0125, 0x0133, 0x0137,
  0x0083,
  0x0089, 0x008B, 0x0095, 0x0097, 0x009D, 0x00A3, 0x00A7, 0x00AD,
  0x00B3, 0x00B5, 0x00BF, 0x00C1, 0x00C5, 0x00C7, 0x00D3, 0x00DF,
  0x00E3, 0x00E5, 0x00E9, 0x00EF, 0x00F1, 0x00FB, 0x0101, 0x0107,
  0x010D, 0x010F, 0x0115, 0x0119, 0x011B, 0x0125, 0x0133, 0x0137,

   0x0139, 0x013D, 0x014B, 0x0151, 0x015B, 0x015D, 0x0161, 0x0167,
   0x016F, 0x0175, 0x017B, 0x017F, 0x0185, 0x018D, 0x0191, 0x0199,
   0x01A3, 0x01A5, 0x01AF, 0x01B1, 0x01B7, 0x01BB, 0x01C1, 0x01C9,
   0x01CD, 0x01CF, 0x01D3, 0x01DF, 0x01E7, 0x01EB, 0x01F3, 0x01F7,
   0x01FD, 0x0209, 0x020B, 0x021D, 0x0223, 0x022D, 0x0233, 0x0239,
   0x023B, 0x0241, 0x024B, 0x0251, 0x0257, 0x0259, 0x025F, 0x0265,
   0x0269, 0x026B, 0x0277, 0x0281, 0x0283, 0x0287, 0x028D, 0x0293,
   0x0295, 0x02A1, 0x02A5, 0x02AB, 0x02B3, 0x02BD, 0x02C5, 0x02CF,
  0x0139, 0x013D, 0x014B, 0x0151, 0x015B, 0x015D, 0x0161, 0x0167,
  0x016F, 0x0175, 0x017B, 0x017F, 0x0185, 0x018D, 0x0191, 0x0199,
  0x01A3, 0x01A5, 0x01AF, 0x01B1, 0x01B7, 0x01BB, 0x01C1, 0x01C9,
  0x01CD, 0x01CF, 0x01D3, 0x01DF, 0x01E7, 0x01EB, 0x01F3, 0x01F7,
  0x01FD, 0x0209, 0x020B, 0x021D, 0x0223, 0x022D, 0x0233, 0x0239,
  0x023B, 0x0241, 0x024B, 0x0251, 0x0257, 0x0259, 0x025F, 0x0265,
  0x0269, 0x026B, 0x0277, 0x0281, 0x0283, 0x0287, 0x028D, 0x0293,
  0x0295, 0x02A1, 0x02A5, 0x02AB, 0x02B3, 0x02BD, 0x02C5, 0x02CF,

   0x02D7, 0x02DD, 0x02E3, 0x02E7, 0x02EF, 0x02F5, 0x02F9, 0x0301,
   0x0305, 0x0313, 0x031D, 0x0329, 0x032B, 0x0335, 0x0337, 0x033B,
   0x033D, 0x0347, 0x0355, 0x0359, 0x035B, 0x035F, 0x036D, 0x0371,
   0x0373, 0x0377, 0x038B, 0x038F, 0x0397, 0x03A1, 0x03A9, 0x03AD,
   0x03B3, 0x03B9, 0x03C7, 0x03CB, 0x03D1, 0x03D7, 0x03DF, 0x03E5,
   0x03F1, 0x03F5, 0x03FB, 0x03FD, 0x0407, 0x0409, 0x040F, 0x0419,
   0x041B, 0x0425, 0x0427, 0x042D, 0x043F, 0x0443, 0x0445, 0x0449,
   0x044F, 0x0455, 0x045D, 0x0463, 0x0469, 0x047F, 0x0481, 0x048B,
  0x02D7, 0x02DD, 0x02E3, 0x02E7, 0x02EF, 0x02F5, 0x02F9, 0x0301,
  0x0305, 0x0313, 0x031D, 0x0329, 0x032B, 0x0335, 0x0337, 0x033B,
  0x033D, 0x0347, 0x0355, 0x0359, 0x035B, 0x035F, 0x036D, 0x0371,
  0x0373, 0x0377, 0x038B, 0x038F, 0x0397, 0x03A1, 0x03A9, 0x03AD,
  0x03B3, 0x03B9, 0x03C7, 0x03CB, 0x03D1, 0x03D7, 0x03DF, 0x03E5,
  0x03F1, 0x03F5, 0x03FB, 0x03FD, 0x0407, 0x0409, 0x040F, 0x0419,
  0x041B, 0x0425, 0x0427, 0x042D, 0x043F, 0x0443, 0x0445, 0x0449,
  0x044F, 0x0455, 0x045D, 0x0463, 0x0469, 0x047F, 0x0481, 0x048B,

   0x0493, 0x049D, 0x04A3, 0x04A9, 0x04B1, 0x04BD, 0x04C1, 0x04C7,
   0x04CD, 0x04CF, 0x04D5, 0x04E1, 0x04EB, 0x04FD, 0x04FF, 0x0503,
   0x0509, 0x050B, 0x0511, 0x0515, 0x0517, 0x051B, 0x0527, 0x0529,
   0x052F, 0x0551, 0x0557, 0x055D, 0x0565, 0x0577, 0x0581, 0x058F,
   0x0593, 0x0595, 0x0599, 0x059F, 0x05A7, 0x05AB, 0x05AD, 0x05B3,
   0x05BF, 0x05C9, 0x05CB, 0x05CF, 0x05D1, 0x05D5, 0x05DB, 0x05E7,
   0x05F3, 0x05FB, 0x0607, 0x060D, 0x0611, 0x0617, 0x061F, 0x0623,
   0x062B, 0x062F, 0x063D, 0x0641, 0x0647, 0x0649, 0x064D, 0x0653
  0x0493, 0x049D, 0x04A3, 0x04A9, 0x04B1, 0x04BD, 0x04C1, 0x04C7,
  0x04CD, 0x04CF, 0x04D5, 0x04E1, 0x04EB, 0x04FD, 0x04FF, 0x0503,
  0x0509, 0x050B, 0x0511, 0x0515, 0x0517, 0x051B, 0x0527, 0x0529,
  0x052F, 0x0551, 0x0557, 0x055D, 0x0565, 0x0577, 0x0581, 0x058F,
  0x0593, 0x0595, 0x0599, 0x059F, 0x05A7, 0x05AB, 0x05AD, 0x05B3,
  0x05BF, 0x05C9, 0x05CB, 0x05CF, 0x05D1, 0x05D5, 0x05DB, 0x05E7,
  0x05F3, 0x05FB, 0x0607, 0x060D, 0x0611, 0x0617, 0x061F, 0x0623,
  0x062B, 0x062F, 0x063D, 0x0641, 0x0647, 0x0649, 0x064D, 0x0653
#endif
};

#if defined(__GNUC__) && __GNUC__ >= 4
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
const mp_digit *s_mp_prime_tab = ltm_prime_tab;
#pragma GCC diagnostic pop
#elif defined(_MSC_VER) && _MSC_VER >= 1500
#pragma warning(push)
#pragma warning(disable: 4996)
const mp_digit *s_mp_prime_tab = ltm_prime_tab;
#pragma warning(pop)
#else
const mp_digit *s_mp_prime_tab = ltm_prime_tab;
#endif

#endif

Added libtommath/bn_reverse.c.




































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BN_REVERSE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* reverse an array, used for radix code */
void
bn_reverse (unsigned char *s, int len)
{
  int     ix, iy;
  unsigned char t;

  ix = 0;
  iy = len - 1;
  while (ix < iy) {
    t     = s[ix];
    s[ix] = s[iy];
    s[iy] = t;
    ++ix;
    --iy;
  }
}
#endif

Changes to libtommath/bn_s_mp_add.c.

1

2
3

4













5
6

7

8
9

10
11

12
13
14
15
16
17
18
19
20
21
22
23
24












25
26
27
28
29
30
31






32
33
34
35



36
37
38
39



40
41

42
43
44


45
46
47


48
49
50


51
52
53
54
55
56





57
58
59


60
61
62
63



64
65
66
67
68
69
70
71







72
73
74


75
76
77
78
79




80
81
82


83
84
85
86
87
88
89








90
91

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
+
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_S_MP_ADD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* low level addition, based on HAC pp.594, Algorithm 14.7 */
int
mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c)
s_mp_add (mp_int * a, mp_int * b, mp_int * c)
{
   const mp_int *x;
  mp_int *x;
   mp_err err;
   int     olduse, min, max;
  int     olduse, res, min, max;

   /* find sizes, we let |a| <= |b| which means we have to sort
    * them.  "x" will point to the input with the most digits
    */
   if (a->used > b->used) {
      min = b->used;
      max = a->used;
      x = a;
   } else {
      min = a->used;
      max = b->used;
      x = b;
   }
  /* find sizes, we let |a| <= |b| which means we have to sort
   * them.  "x" will point to the input with the most digits
   */
  if (a->used > b->used) {
    min = b->used;
    max = a->used;
    x = a;
  } else {
    min = a->used;
    max = b->used;
    x = b;
  }

   /* init result */
   if (c->alloc < (max + 1)) {
      if ((err = mp_grow(c, max + 1)) != MP_OKAY) {
         return err;
      }
   }
  /* init result */
  if (c->alloc < max + 1) {
    if ((res = mp_grow (c, max + 1)) != MP_OKAY) {
      return res;
    }
  }

   /* get old used digit count and set new one */
   olduse = c->used;
   c->used = max + 1;
  /* get old used digit count and set new one */
  olduse = c->used;
  c->used = max + 1;

   {
      mp_digit u, *tmpa, *tmpb, *tmpc;
      int i;
  {
    register mp_digit u, *tmpa, *tmpb, *tmpc;
    register int i;

      /* alias for digit pointers */
    /* alias for digit pointers */

      /* first input */
      tmpa = a->dp;
    /* first input */
    tmpa = a->dp;

      /* second input */
      tmpb = b->dp;
    /* second input */
    tmpb = b->dp;

      /* destination */
      tmpc = c->dp;
    /* destination */
    tmpc = c->dp;

      /* zero the carry */
      u = 0;
      for (i = 0; i < min; i++) {
         /* Compute the sum at one digit, T[i] = A[i] + B[i] + U */
         *tmpc = *tmpa++ + *tmpb++ + u;
    /* zero the carry */
    u = 0;
    for (i = 0; i < min; i++) {
      /* Compute the sum at one digit, T[i] = A[i] + B[i] + U */
      *tmpc = *tmpa++ + *tmpb++ + u;

         /* U = carry bit of T[i] */
         u = *tmpc >> (mp_digit)MP_DIGIT_BIT;
      /* U = carry bit of T[i] */
      u = *tmpc >> ((mp_digit)DIGIT_BIT);

         /* take away carry bit from T[i] */
         *tmpc++ &= MP_MASK;
      }
      /* take away carry bit from T[i] */
      *tmpc++ &= MP_MASK;
    }

      /* now copy higher words if any, that is in A+B
       * if A or B has more digits add those in
       */
      if (min != max) {
         for (; i < max; i++) {
            /* T[i] = X[i] + U */
            *tmpc = x->dp[i] + u;
    /* now copy higher words if any, that is in A+B 
     * if A or B has more digits add those in 
     */
    if (min != max) {
      for (; i < max; i++) {
        /* T[i] = X[i] + U */
        *tmpc = x->dp[i] + u;

            /* U = carry bit of T[i] */
            u = *tmpc >> (mp_digit)MP_DIGIT_BIT;
        /* U = carry bit of T[i] */
        u = *tmpc >> ((mp_digit)DIGIT_BIT);

            /* take away carry bit from T[i] */
            *tmpc++ &= MP_MASK;
         }
      }
        /* take away carry bit from T[i] */
        *tmpc++ &= MP_MASK;
      }
    }

      /* add carry */
      *tmpc++ = u;
    /* add carry */
    *tmpc++ = u;

      /* clear digits above oldused */
      MP_ZERO_DIGITS(tmpc, olduse - c->used);
   }

   mp_clamp(c);
   return MP_OKAY;
    /* clear digits above oldused */
    for (i = c->used; i < olduse; i++) {
      *tmpc++ = 0;
    }
  }

  mp_clamp (c);
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_s_mp_balance_mul.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_BALANCE_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* single-digit multiplication with the smaller number as the single-digit */
mp_err s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c)
{
   int count, len_a, len_b, nblocks, i, j, bsize;
   mp_int a0, tmp, A, B, r;
   mp_err err;

   len_a = a->used;
   len_b = b->used;

   nblocks = MP_MAX(a->used, b->used) / MP_MIN(a->used, b->used);
   bsize = MP_MIN(a->used, b->used) ;

   if ((err = mp_init_size(&a0, bsize + 2)) != MP_OKAY) {
      return err;
   }
   if ((err = mp_init_multi(&tmp, &r, NULL)) != MP_OKAY) {
      mp_clear(&a0);
      return err;
   }

   /* Make sure that A is the larger one*/
   if (len_a < len_b) {
      B = *a;
      A = *b;
   } else {
      A = *a;
      B = *b;
   }

   for (i = 0, j=0; i < nblocks; i++) {
      /* Cut a slice off of a */
      a0.used = 0;
      for (count = 0; count < bsize; count++) {
         a0.dp[count] = A.dp[ j++ ];
         a0.used++;
      }
      mp_clamp(&a0);
      /* Multiply with b */
      if ((err = mp_mul(&a0, &B, &tmp)) != MP_OKAY) {
         goto LBL_ERR;
      }
      /* Shift tmp to the correct position */
      if ((err = mp_lshd(&tmp, bsize * i)) != MP_OKAY) {
         goto LBL_ERR;
      }
      /* Add to output. No carry needed */
      if ((err = mp_add(&r, &tmp, &r)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }
   /* The left-overs; there are always left-overs */
   if (j < A.used) {
      a0.used = 0;
      for (count = 0; j < A.used; count++) {
         a0.dp[count] = A.dp[ j++ ];
         a0.used++;
      }
      mp_clamp(&a0);
      if ((err = mp_mul(&a0, &B, &tmp)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_lshd(&tmp, bsize * i)) != MP_OKAY) {
         goto LBL_ERR;
      }
      if ((err = mp_add(&r, &tmp, &r)) != MP_OKAY) {
         goto LBL_ERR;
      }
   }

   mp_exch(&r,c);
LBL_ERR:
   mp_clear_multi(&a0, &tmp, &r,NULL);
   return err;
}
#endif

Changes to libtommath/bn_s_mp_exptmod.c.

1

2
3

4
5













6
7

8
9
10
11
































12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46





47
48
49
50
51
52
53
54
55
56
57










58
59
60
61
62
63
64
65
66
67
68
















69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104

















































105
106
107
108
109
110
111
112







113
114
115
116
117
118
119
120
121
122
123
124











125
126
127
128



129
130
131
132
133
134
135
136
137








138
139
140
141
142
143
144










145
146
147
148



149
150
151
152
153
154
155
156
157
158
159
160



















161
162
163
164
165
166
167






168
169
170
171
172
173
174
175
176
177
178
179
180
181




















182
183
184
185
186
187






188
189

190
191
192
193
194
195
196





197
198

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
-
-
+
-

-
-
-
-
-
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_S_MP_EXPTMOD_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */
#ifdef MP_LOW_MEM
#   define TAB_SIZE 32
   #define TAB_SIZE 32
#   define MAX_WINSIZE 5
#else
#   define TAB_SIZE 256
#   define MAX_WINSIZE 0
   #define TAB_SIZE 256
#endif

int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int redmode)
{
  mp_int  M[TAB_SIZE], res, mu;
  mp_digit buf;
  int     err, bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize;
  int (*redux)(mp_int*,mp_int*,mp_int*);

  /* find window size */
  x = mp_count_bits (X);
  if (x <= 7) {
    winsize = 2;
  } else if (x <= 36) {
    winsize = 3;
  } else if (x <= 140) {
    winsize = 4;
  } else if (x <= 450) {
    winsize = 5;
  } else if (x <= 1303) {
    winsize = 6;
  } else if (x <= 3529) {
    winsize = 7;
  } else {
    winsize = 8;
  }

#ifdef MP_LOW_MEM
    if (winsize > 5) {
       winsize = 5;
    }
#endif

mp_err s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode)
{
   mp_int  M[TAB_SIZE], res, mu;
   mp_digit buf;
   mp_err   err;
   int      bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize;
   mp_err(*redux)(mp_int *x, const mp_int *m, const mp_int *mu);

   /* find window size */
   x = mp_count_bits(X);
   if (x <= 7) {
      winsize = 2;
   } else if (x <= 36) {
      winsize = 3;
   } else if (x <= 140) {
      winsize = 4;
   } else if (x <= 450) {
      winsize = 5;
   } else if (x <= 1303) {
      winsize = 6;
   } else if (x <= 3529) {
      winsize = 7;
   } else {
      winsize = 8;
   }

   winsize = MAX_WINSIZE ? MP_MIN(MAX_WINSIZE, winsize) : winsize;

   /* init M array */
   /* init first cell */
   if ((err = mp_init(&M[1])) != MP_OKAY) {
      return err;
   }
  /* init M array */
  /* init first cell */
  if ((err = mp_init(&M[1])) != MP_OKAY) {
     return err; 
  }

   /* now init the second half of the array */
   for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
      if ((err = mp_init(&M[x])) != MP_OKAY) {
         for (y = 1<<(winsize-1); y < x; y++) {
            mp_clear(&M[y]);
         }
         mp_clear(&M[1]);
         return err;
      }
   }
  /* now init the second half of the array */
  for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
    if ((err = mp_init(&M[x])) != MP_OKAY) {
      for (y = 1<<(winsize-1); y < x; y++) {
        mp_clear (&M[y]);
      }
      mp_clear(&M[1]);
      return err;
    }
  }

   /* create mu, used for Barrett reduction */
   if ((err = mp_init(&mu)) != MP_OKAY)                           goto LBL_M;

   if (redmode == 0) {
      if ((err = mp_reduce_setup(&mu, P)) != MP_OKAY)             goto LBL_MU;
      redux = mp_reduce;
   } else {
      if ((err = mp_reduce_2k_setup_l(P, &mu)) != MP_OKAY)        goto LBL_MU;
      redux = mp_reduce_2k_l;
   }
  /* create mu, used for Barrett reduction */
  if ((err = mp_init (&mu)) != MP_OKAY) {
    goto LBL_M;
  }
  
  if (redmode == 0) {
     if ((err = mp_reduce_setup (&mu, P)) != MP_OKAY) {
        goto LBL_MU;
     }
     redux = mp_reduce;
  } else {
     if ((err = mp_reduce_2k_setup_l (P, &mu)) != MP_OKAY) {
        goto LBL_MU;
     }
     redux = mp_reduce_2k_l;
  }    

   /* create M table
    *
    * The M table contains powers of the base,
    * e.g. M[x] = G**x mod P
    *
    * The first half of the table is not
    * computed though accept for M[0] and M[1]
    */
   if ((err = mp_mod(G, P, &M[1])) != MP_OKAY)                    goto LBL_MU;

   /* compute the value at M[1<<(winsize-1)] by squaring
    * M[1] (winsize-1) times
    */
   if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_MU;

   for (x = 0; x < (winsize - 1); x++) {
      /* square it */
      if ((err = mp_sqr(&M[(size_t)1 << (winsize - 1)],
                        &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_MU;

      /* reduce modulo P */
      if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, &mu)) != MP_OKAY) goto LBL_MU;
   }

   /* create upper table, that is M[x] = M[x-1] * M[1] (mod P)
    * for x = (2**(winsize - 1) + 1) to (2**winsize - 1)
    */
   for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) {
      if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY)     goto LBL_MU;
      if ((err = redux(&M[x], P, &mu)) != MP_OKAY)                goto LBL_MU;
   }

   /* setup result */
   if ((err = mp_init(&res)) != MP_OKAY)                          goto LBL_MU;
   mp_set(&res, 1uL);
  /* create M table
   *
   * The M table contains powers of the base, 
   * e.g. M[x] = G**x mod P
   *
   * The first half of the table is not 
   * computed though accept for M[0] and M[1]
   */
  if ((err = mp_mod (G, P, &M[1])) != MP_OKAY) {
    goto LBL_MU;
  }

  /* compute the value at M[1<<(winsize-1)] by squaring 
   * M[1] (winsize-1) times 
   */
  if ((err = mp_copy (&M[1], &M[1 << (winsize - 1)])) != MP_OKAY) {
    goto LBL_MU;
  }

  for (x = 0; x < (winsize - 1); x++) {
    /* square it */
    if ((err = mp_sqr (&M[1 << (winsize - 1)], 
                       &M[1 << (winsize - 1)])) != MP_OKAY) {
      goto LBL_MU;
    }

    /* reduce modulo P */
    if ((err = redux (&M[1 << (winsize - 1)], P, &mu)) != MP_OKAY) {
      goto LBL_MU;
    }
  }

  /* create upper table, that is M[x] = M[x-1] * M[1] (mod P)
   * for x = (2**(winsize - 1) + 1) to (2**winsize - 1)
   */
  for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) {
    if ((err = mp_mul (&M[x - 1], &M[1], &M[x])) != MP_OKAY) {
      goto LBL_MU;
    }
    if ((err = redux (&M[x], P, &mu)) != MP_OKAY) {
      goto LBL_MU;
    }
  }

  /* setup result */
  if ((err = mp_init (&res)) != MP_OKAY) {
    goto LBL_MU;
  }
  mp_set (&res, 1);

   /* set initial mode and bit cnt */
   mode   = 0;
   bitcnt = 1;
   buf    = 0;
   digidx = X->used - 1;
   bitcpy = 0;
   bitbuf = 0;
  /* set initial mode and bit cnt */
  mode   = 0;
  bitcnt = 1;
  buf    = 0;
  digidx = X->used - 1;
  bitcpy = 0;
  bitbuf = 0;

   for (;;) {
      /* grab next digit as required */
      if (--bitcnt == 0) {
         /* if digidx == -1 we are out of digits */
         if (digidx == -1) {
            break;
         }
         /* read next digit and reset the bitcnt */
         buf    = X->dp[digidx--];
         bitcnt = (int)MP_DIGIT_BIT;
      }
  for (;;) {
    /* grab next digit as required */
    if (--bitcnt == 0) {
      /* if digidx == -1 we are out of digits */
      if (digidx == -1) {
        break;
      }
      /* read next digit and reset the bitcnt */
      buf    = X->dp[digidx--];
      bitcnt = (int) DIGIT_BIT;
    }

      /* grab the next msb from the exponent */
      y     = (buf >> (mp_digit)(MP_DIGIT_BIT - 1)) & 1uL;
      buf <<= (mp_digit)1;
    /* grab the next msb from the exponent */
    y     = (buf >> (mp_digit)(DIGIT_BIT - 1)) & 1;
    buf <<= (mp_digit)1;

      /* if the bit is zero and mode == 0 then we ignore it
       * These represent the leading zero bits before the first 1 bit
       * in the exponent.  Technically this opt is not required but it
       * does lower the # of trivial squaring/reductions used
       */
      if ((mode == 0) && (y == 0)) {
         continue;
      }
    /* if the bit is zero and mode == 0 then we ignore it
     * These represent the leading zero bits before the first 1 bit
     * in the exponent.  Technically this opt is not required but it
     * does lower the # of trivial squaring/reductions used
     */
    if (mode == 0 && y == 0) {
      continue;
    }

      /* if the bit is zero and mode == 1 then we square */
      if ((mode == 1) && (y == 0)) {
         if ((err = mp_sqr(&res, &res)) != MP_OKAY)               goto LBL_RES;
         if ((err = redux(&res, P, &mu)) != MP_OKAY)              goto LBL_RES;
         continue;
      }
    /* if the bit is zero and mode == 1 then we square */
    if (mode == 1 && y == 0) {
      if ((err = mp_sqr (&res, &res)) != MP_OKAY) {
        goto LBL_RES;
      }
      if ((err = redux (&res, P, &mu)) != MP_OKAY) {
        goto LBL_RES;
      }
      continue;
    }

      /* else we add it to the window */
      bitbuf |= (y << (winsize - ++bitcpy));
      mode    = 2;
    /* else we add it to the window */
    bitbuf |= (y << (winsize - ++bitcpy));
    mode    = 2;

      if (bitcpy == winsize) {
         /* ok window is filled so square as required and multiply  */
         /* square first */
         for (x = 0; x < winsize; x++) {
            if ((err = mp_sqr(&res, &res)) != MP_OKAY)            goto LBL_RES;
            if ((err = redux(&res, P, &mu)) != MP_OKAY)           goto LBL_RES;
         }

         /* then multiply */
         if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY)  goto LBL_RES;
         if ((err = redux(&res, P, &mu)) != MP_OKAY)             goto LBL_RES;
    if (bitcpy == winsize) {
      /* ok window is filled so square as required and multiply  */
      /* square first */
      for (x = 0; x < winsize; x++) {
        if ((err = mp_sqr (&res, &res)) != MP_OKAY) {
          goto LBL_RES;
        }
        if ((err = redux (&res, P, &mu)) != MP_OKAY) {
          goto LBL_RES;
        }
      }

      /* then multiply */
      if ((err = mp_mul (&res, &M[bitbuf], &res)) != MP_OKAY) {
        goto LBL_RES;
      }
      if ((err = redux (&res, P, &mu)) != MP_OKAY) {
        goto LBL_RES;
      }

         /* empty window and reset */
         bitcpy = 0;
         bitbuf = 0;
         mode   = 1;
      }
   }
      /* empty window and reset */
      bitcpy = 0;
      bitbuf = 0;
      mode   = 1;
    }
  }

   /* if bits remain then square/multiply */
   if ((mode == 2) && (bitcpy > 0)) {
      /* square then multiply if the bit is set */
      for (x = 0; x < bitcpy; x++) {
         if ((err = mp_sqr(&res, &res)) != MP_OKAY)               goto LBL_RES;
         if ((err = redux(&res, P, &mu)) != MP_OKAY)              goto LBL_RES;

         bitbuf <<= 1;
         if ((bitbuf & (1 << winsize)) != 0) {
            /* then multiply */
            if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY)     goto LBL_RES;
            if ((err = redux(&res, P, &mu)) != MP_OKAY)           goto LBL_RES;
         }
  /* if bits remain then square/multiply */
  if (mode == 2 && bitcpy > 0) {
    /* square then multiply if the bit is set */
    for (x = 0; x < bitcpy; x++) {
      if ((err = mp_sqr (&res, &res)) != MP_OKAY) {
        goto LBL_RES;
      }
      if ((err = redux (&res, P, &mu)) != MP_OKAY) {
        goto LBL_RES;
      }

      bitbuf <<= 1;
      if ((bitbuf & (1 << winsize)) != 0) {
        /* then multiply */
        if ((err = mp_mul (&res, &M[1], &res)) != MP_OKAY) {
          goto LBL_RES;
        }
        if ((err = redux (&res, P, &mu)) != MP_OKAY) {
          goto LBL_RES;
        }
      }
   }

   mp_exch(&res, Y);
   err = MP_OKAY;
LBL_RES:
    }
  }

  mp_exch (&res, Y);
  err = MP_OKAY;
LBL_RES:mp_clear (&res);
   mp_clear(&res);
LBL_MU:
LBL_MU:mp_clear (&mu);
   mp_clear(&mu);
LBL_M:
   mp_clear(&M[1]);
   for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
      mp_clear(&M[x]);
   }
   return err;
  mp_clear(&M[1]);
  for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
    mp_clear (&M[x]);
  }
  return err;
}
#endif

Deleted libtommath/bn_s_mp_exptmod_fast.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254






























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_EXPTMOD_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* computes Y == G**X mod P, HAC pp.616, Algorithm 14.85
 *
 * Uses a left-to-right k-ary sliding window to compute the modular exponentiation.
 * The value of k changes based on the size of the exponent.
 *
 * Uses Montgomery or Diminished Radix reduction [whichever appropriate]
 */

#ifdef MP_LOW_MEM
#   define TAB_SIZE 32
#   define MAX_WINSIZE 5
#else
#   define TAB_SIZE 256
#   define MAX_WINSIZE 0
#endif

mp_err s_mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode)
{
   mp_int  M[TAB_SIZE], res;
   mp_digit buf, mp;
   int     bitbuf, bitcpy, bitcnt, mode, digidx, x, y, winsize;
   mp_err   err;

   /* use a pointer to the reduction algorithm.  This allows us to use
    * one of many reduction algorithms without modding the guts of
    * the code with if statements everywhere.
    */
   mp_err(*redux)(mp_int *x, const mp_int *n, mp_digit rho);

   /* find window size */
   x = mp_count_bits(X);
   if (x <= 7) {
      winsize = 2;
   } else if (x <= 36) {
      winsize = 3;
   } else if (x <= 140) {
      winsize = 4;
   } else if (x <= 450) {
      winsize = 5;
   } else if (x <= 1303) {
      winsize = 6;
   } else if (x <= 3529) {
      winsize = 7;
   } else {
      winsize = 8;
   }

   winsize = MAX_WINSIZE ? MP_MIN(MAX_WINSIZE, winsize) : winsize;

   /* init M array */
   /* init first cell */
   if ((err = mp_init_size(&M[1], P->alloc)) != MP_OKAY) {
      return err;
   }

   /* now init the second half of the array */
   for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
      if ((err = mp_init_size(&M[x], P->alloc)) != MP_OKAY) {
         for (y = 1<<(winsize-1); y < x; y++) {
            mp_clear(&M[y]);
         }
         mp_clear(&M[1]);
         return err;
      }
   }

   /* determine and setup reduction code */
   if (redmode == 0) {
      if (MP_HAS(MP_MONTGOMERY_SETUP)) {
         /* now setup montgomery  */
         if ((err = mp_montgomery_setup(P, &mp)) != MP_OKAY)      goto LBL_M;
      } else {
         err = MP_VAL;
         goto LBL_M;
      }

      /* automatically pick the comba one if available (saves quite a few calls/ifs) */
      if (MP_HAS(S_MP_MONTGOMERY_REDUCE_FAST) &&
          (((P->used * 2) + 1) < MP_WARRAY) &&
          (P->used < MP_MAXFAST)) {
         redux = s_mp_montgomery_reduce_fast;
      } else if (MP_HAS(MP_MONTGOMERY_REDUCE)) {
         /* use slower baseline Montgomery method */
         redux = mp_montgomery_reduce;
      } else {
         err = MP_VAL;
         goto LBL_M;
      }
   } else if (redmode == 1) {
      if (MP_HAS(MP_DR_SETUP) && MP_HAS(MP_DR_REDUCE)) {
         /* setup DR reduction for moduli of the form B**k - b */
         mp_dr_setup(P, &mp);
         redux = mp_dr_reduce;
      } else {
         err = MP_VAL;
         goto LBL_M;
      }
   } else if (MP_HAS(MP_REDUCE_2K_SETUP) && MP_HAS(MP_REDUCE_2K)) {
      /* setup DR reduction for moduli of the form 2**k - b */
      if ((err = mp_reduce_2k_setup(P, &mp)) != MP_OKAY)          goto LBL_M;
      redux = mp_reduce_2k;
   } else {
      err = MP_VAL;
      goto LBL_M;
   }

   /* setup result */
   if ((err = mp_init_size(&res, P->alloc)) != MP_OKAY)           goto LBL_M;

   /* create M table
    *

    *
    * The first half of the table is not computed though accept for M[0] and M[1]
    */

   if (redmode == 0) {
      if (MP_HAS(MP_MONTGOMERY_CALC_NORMALIZATION)) {
         /* now we need R mod m */
         if ((err = mp_montgomery_calc_normalization(&res, P)) != MP_OKAY) goto LBL_RES;

         /* now set M[1] to G * R mod m */
         if ((err = mp_mulmod(G, &res, P, &M[1])) != MP_OKAY)     goto LBL_RES;
      } else {
         err = MP_VAL;
         goto LBL_RES;
      }
   } else {
      mp_set(&res, 1uL);
      if ((err = mp_mod(G, P, &M[1])) != MP_OKAY)                 goto LBL_RES;
   }

   /* compute the value at M[1<<(winsize-1)] by squaring M[1] (winsize-1) times */
   if ((err = mp_copy(&M[1], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_RES;

   for (x = 0; x < (winsize - 1); x++) {
      if ((err = mp_sqr(&M[(size_t)1 << (winsize - 1)], &M[(size_t)1 << (winsize - 1)])) != MP_OKAY) goto LBL_RES;
      if ((err = redux(&M[(size_t)1 << (winsize - 1)], P, mp)) != MP_OKAY) goto LBL_RES;
   }

   /* create upper table */
   for (x = (1 << (winsize - 1)) + 1; x < (1 << winsize); x++) {
      if ((err = mp_mul(&M[x - 1], &M[1], &M[x])) != MP_OKAY)     goto LBL_RES;
      if ((err = redux(&M[x], P, mp)) != MP_OKAY)                 goto LBL_RES;
   }

   /* set initial mode and bit cnt */
   mode   = 0;
   bitcnt = 1;
   buf    = 0;
   digidx = X->used - 1;
   bitcpy = 0;
   bitbuf = 0;

   for (;;) {
      /* grab next digit as required */
      if (--bitcnt == 0) {
         /* if digidx == -1 we are out of digits so break */
         if (digidx == -1) {
            break;
         }
         /* read next digit and reset bitcnt */
         buf    = X->dp[digidx--];
         bitcnt = (int)MP_DIGIT_BIT;
      }

      /* grab the next msb from the exponent */
      y     = (mp_digit)(buf >> (MP_DIGIT_BIT - 1)) & 1uL;
      buf <<= (mp_digit)1;

      /* if the bit is zero and mode == 0 then we ignore it
       * These represent the leading zero bits before the first 1 bit
       * in the exponent.  Technically this opt is not required but it
       * does lower the # of trivial squaring/reductions used
       */
      if ((mode == 0) && (y == 0)) {
         continue;
      }

      /* if the bit is zero and mode == 1 then we square */
      if ((mode == 1) && (y == 0)) {
         if ((err = mp_sqr(&res, &res)) != MP_OKAY)               goto LBL_RES;
         if ((err = redux(&res, P, mp)) != MP_OKAY)               goto LBL_RES;
         continue;
      }

      /* else we add it to the window */
      bitbuf |= (y << (winsize - ++bitcpy));
      mode    = 2;

      if (bitcpy == winsize) {
         /* ok window is filled so square as required and multiply  */
         /* square first */
         for (x = 0; x < winsize; x++) {
            if ((err = mp_sqr(&res, &res)) != MP_OKAY)            goto LBL_RES;
            if ((err = redux(&res, P, mp)) != MP_OKAY)            goto LBL_RES;
         }

         /* then multiply */
         if ((err = mp_mul(&res, &M[bitbuf], &res)) != MP_OKAY)   goto LBL_RES;
         if ((err = redux(&res, P, mp)) != MP_OKAY)               goto LBL_RES;

         /* empty window and reset */
         bitcpy = 0;
         bitbuf = 0;
         mode   = 1;
      }
   }

   /* if bits remain then square/multiply */
   if ((mode == 2) && (bitcpy > 0)) {
      /* square then multiply if the bit is set */
      for (x = 0; x < bitcpy; x++) {
         if ((err = mp_sqr(&res, &res)) != MP_OKAY)               goto LBL_RES;
         if ((err = redux(&res, P, mp)) != MP_OKAY)               goto LBL_RES;

         /* get next bit of the window */
         bitbuf <<= 1;
         if ((bitbuf & (1 << winsize)) != 0) {
            /* then multiply */
            if ((err = mp_mul(&res, &M[1], &res)) != MP_OKAY)     goto LBL_RES;
            if ((err = redux(&res, P, mp)) != MP_OKAY)            goto LBL_RES;
         }
      }
   }

   if (redmode == 0) {
      /* fixup result if Montgomery reduction is used
       * recall that any value in a Montgomery system is
       * actually multiplied by R mod n.  So we have
       * to reduce one more time to cancel out the factor
       * of R.
       */
      if ((err = redux(&res, P, mp)) != MP_OKAY)                  goto LBL_RES;
   }

   /* swap res with Y */
   mp_exch(&res, Y);
   err = MP_OKAY;
LBL_RES:
   mp_clear(&res);
LBL_M:
   mp_clear(&M[1]);
   for (x = 1<<(winsize-1); x < (1 << winsize); x++) {
      mp_clear(&M[x]);
   }
   return err;
}
#endif

Deleted libtommath/bn_s_mp_get_bit.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21





















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_GET_BIT_C

/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Get bit at position b and return MP_YES if the bit is 1, MP_NO if it is 0 */
mp_bool s_mp_get_bit(const mp_int *a, unsigned int b)
{
   mp_digit bit;
   int limb = (int)(b / MP_DIGIT_BIT);

   if (limb >= a->used) {
      return MP_NO;
   }

   bit = (mp_digit)1 << (b % MP_DIGIT_BIT);
   return ((a->dp[limb] & bit) != 0u) ? MP_YES : MP_NO;
}

#endif

Deleted libtommath/bn_s_mp_invmod_fast.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118






















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_INVMOD_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* computes the modular inverse via binary extended euclidean algorithm,
 * that is c = 1/a mod b
 *
 * Based on slow invmod except this is optimized for the case where b is
 * odd as per HAC Note 14.64 on pp. 610
 */
mp_err s_mp_invmod_fast(const mp_int *a, const mp_int *b, mp_int *c)
{
   mp_int  x, y, u, v, B, D;
   mp_sign neg;
   mp_err  err;

   /* 2. [modified] b must be odd   */
   if (MP_IS_EVEN(b)) {
      return MP_VAL;
   }

   /* init all our temps */
   if ((err = mp_init_multi(&x, &y, &u, &v, &B, &D, NULL)) != MP_OKAY) {
      return err;
   }

   /* x == modulus, y == value to invert */
   if ((err = mp_copy(b, &x)) != MP_OKAY)                         goto LBL_ERR;

   /* we need y = |a| */
   if ((err = mp_mod(a, b, &y)) != MP_OKAY)                       goto LBL_ERR;

   /* if one of x,y is zero return an error! */
   if (MP_IS_ZERO(&x) || MP_IS_ZERO(&y)) {
      err = MP_VAL;
      goto LBL_ERR;
   }

   /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */
   if ((err = mp_copy(&x, &u)) != MP_OKAY)                        goto LBL_ERR;
   if ((err = mp_copy(&y, &v)) != MP_OKAY)                        goto LBL_ERR;
   mp_set(&D, 1uL);

top:
   /* 4.  while u is even do */
   while (MP_IS_EVEN(&u)) {
      /* 4.1 u = u/2 */
      if ((err = mp_div_2(&u, &u)) != MP_OKAY)                    goto LBL_ERR;

      /* 4.2 if B is odd then */
      if (MP_IS_ODD(&B)) {
         if ((err = mp_sub(&B, &x, &B)) != MP_OKAY)               goto LBL_ERR;
      }
      /* B = B/2 */
      if ((err = mp_div_2(&B, &B)) != MP_OKAY)                    goto LBL_ERR;
   }

   /* 5.  while v is even do */
   while (MP_IS_EVEN(&v)) {
      /* 5.1 v = v/2 */
      if ((err = mp_div_2(&v, &v)) != MP_OKAY)                    goto LBL_ERR;

      /* 5.2 if D is odd then */
      if (MP_IS_ODD(&D)) {
         /* D = (D-x)/2 */
         if ((err = mp_sub(&D, &x, &D)) != MP_OKAY)               goto LBL_ERR;
      }
      /* D = D/2 */
      if ((err = mp_div_2(&D, &D)) != MP_OKAY)                    goto LBL_ERR;
   }

   /* 6.  if u >= v then */
   if (mp_cmp(&u, &v) != MP_LT) {
      /* u = u - v, B = B - D */
      if ((err = mp_sub(&u, &v, &u)) != MP_OKAY)                  goto LBL_ERR;

      if ((err = mp_sub(&B, &D, &B)) != MP_OKAY)                  goto LBL_ERR;
   } else {
      /* v - v - u, D = D - B */
      if ((err = mp_sub(&v, &u, &v)) != MP_OKAY)                  goto LBL_ERR;

      if ((err = mp_sub(&D, &B, &D)) != MP_OKAY)                  goto LBL_ERR;
   }

   /* if not zero goto step 4 */
   if (!MP_IS_ZERO(&u)) {
      goto top;
   }

   /* now a = C, b = D, gcd == g*v */

   /* if v != 1 then there is no inverse */
   if (mp_cmp_d(&v, 1uL) != MP_EQ) {
      err = MP_VAL;
      goto LBL_ERR;
   }

   /* b is now the inverse */
   neg = a->sign;
   while (D.sign == MP_NEG) {
      if ((err = mp_add(&D, b, &D)) != MP_OKAY)                   goto LBL_ERR;
   }

   /* too big */
   while (mp_cmp_mag(&D, b) != MP_LT) {
      if ((err = mp_sub(&D, b, &D)) != MP_OKAY)                   goto LBL_ERR;
   }

   mp_exch(&D, c);
   c->sign = neg;
   err = MP_OKAY;

LBL_ERR:
   mp_clear_multi(&x, &y, &u, &v, &B, &D, NULL);
   return err;
}
#endif

Deleted libtommath/bn_s_mp_invmod_slow.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_INVMOD_SLOW_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* hac 14.61, pp608 */
mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c)
{
   mp_int  x, y, u, v, A, B, C, D;
   mp_err  err;

   /* b cannot be negative */
   if ((b->sign == MP_NEG) || MP_IS_ZERO(b)) {
      return MP_VAL;
   }

   /* init temps */
   if ((err = mp_init_multi(&x, &y, &u, &v,
                            &A, &B, &C, &D, NULL)) != MP_OKAY) {
      return err;
   }

   /* x = a, y = b */
   if ((err = mp_mod(a, b, &x)) != MP_OKAY)                       goto LBL_ERR;
   if ((err = mp_copy(b, &y)) != MP_OKAY)                         goto LBL_ERR;

   /* 2. [modified] if x,y are both even then return an error! */
   if (MP_IS_EVEN(&x) && MP_IS_EVEN(&y)) {
      err = MP_VAL;
      goto LBL_ERR;
   }

   /* 3. u=x, v=y, A=1, B=0, C=0,D=1 */
   if ((err = mp_copy(&x, &u)) != MP_OKAY)                        goto LBL_ERR;
   if ((err = mp_copy(&y, &v)) != MP_OKAY)                        goto LBL_ERR;
   mp_set(&A, 1uL);
   mp_set(&D, 1uL);

top:
   /* 4.  while u is even do */
   while (MP_IS_EVEN(&u)) {
      /* 4.1 u = u/2 */
      if ((err = mp_div_2(&u, &u)) != MP_OKAY)                    goto LBL_ERR;

      /* 4.2 if A or B is odd then */
      if (MP_IS_ODD(&A) || MP_IS_ODD(&B)) {
         /* A = (A+y)/2, B = (B-x)/2 */
         if ((err = mp_add(&A, &y, &A)) != MP_OKAY)               goto LBL_ERR;
         if ((err = mp_sub(&B, &x, &B)) != MP_OKAY)               goto LBL_ERR;
      }
      /* A = A/2, B = B/2 */
      if ((err = mp_div_2(&A, &A)) != MP_OKAY)                    goto LBL_ERR;
      if ((err = mp_div_2(&B, &B)) != MP_OKAY)                    goto LBL_ERR;
   }

   /* 5.  while v is even do */
   while (MP_IS_EVEN(&v)) {
      /* 5.1 v = v/2 */
      if ((err = mp_div_2(&v, &v)) != MP_OKAY)                    goto LBL_ERR;

      /* 5.2 if C or D is odd then */
      if (MP_IS_ODD(&C) || MP_IS_ODD(&D)) {
         /* C = (C+y)/2, D = (D-x)/2 */
         if ((err = mp_add(&C, &y, &C)) != MP_OKAY)               goto LBL_ERR;
         if ((err = mp_sub(&D, &x, &D)) != MP_OKAY)               goto LBL_ERR;
      }
      /* C = C/2, D = D/2 */
      if ((err = mp_div_2(&C, &C)) != MP_OKAY)                    goto LBL_ERR;
      if ((err = mp_div_2(&D, &D)) != MP_OKAY)                    goto LBL_ERR;
   }

   /* 6.  if u >= v then */
   if (mp_cmp(&u, &v) != MP_LT) {
      /* u = u - v, A = A - C, B = B - D */
      if ((err = mp_sub(&u, &v, &u)) != MP_OKAY)                  goto LBL_ERR;

      if ((err = mp_sub(&A, &C, &A)) != MP_OKAY)                  goto LBL_ERR;

      if ((err = mp_sub(&B, &D, &B)) != MP_OKAY)                  goto LBL_ERR;
   } else {
      /* v - v - u, C = C - A, D = D - B */
      if ((err = mp_sub(&v, &u, &v)) != MP_OKAY)                  goto LBL_ERR;

      if ((err = mp_sub(&C, &A, &C)) != MP_OKAY)                  goto LBL_ERR;

      if ((err = mp_sub(&D, &B, &D)) != MP_OKAY)                  goto LBL_ERR;
   }

   /* if not zero goto step 4 */
   if (!MP_IS_ZERO(&u)) {
      goto top;
   }

   /* now a = C, b = D, gcd == g*v */

   /* if v != 1 then there is no inverse */
   if (mp_cmp_d(&v, 1uL) != MP_EQ) {
      err = MP_VAL;
      goto LBL_ERR;
   }

   /* if its too low */
   while (mp_cmp_d(&C, 0uL) == MP_LT) {
      if ((err = mp_add(&C, b, &C)) != MP_OKAY)                   goto LBL_ERR;
   }

   /* too big */
   while (mp_cmp_mag(&C, b) != MP_LT) {
      if ((err = mp_sub(&C, b, &C)) != MP_OKAY)                   goto LBL_ERR;
   }

   /* C is now the inverse */
   mp_exch(&C, c);
   err = MP_OKAY;
LBL_ERR:
   mp_clear_multi(&x, &y, &u, &v, &A, &B, &C, &D, NULL);
   return err;
}
#endif

Deleted libtommath/bn_s_mp_karatsuba_mul.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174














































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_KARATSUBA_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* c = |a| * |b| using Karatsuba Multiplication using
 * three half size multiplications
 *
 * Let B represent the radix [e.g. 2**MP_DIGIT_BIT] and
 * let n represent half of the number of digits in
 * the min(a,b)
 *
 * a = a1 * B**n + a0
 * b = b1 * B**n + b0
 *
 * Then, a * b =>
   a1b1 * B**2n + ((a1 + a0)(b1 + b0) - (a0b0 + a1b1)) * B + a0b0
 *
 * Note that a1b1 and a0b0 are used twice and only need to be
 * computed once.  So in total three half size (half # of
 * digit) multiplications are performed, a0b0, a1b1 and
 * (a1+b1)(a0+b0)
 *
 * Note that a multiplication of half the digits requires
 * 1/4th the number of single precision multiplications so in
 * total after one call 25% of the single precision multiplications
 * are saved.  Note also that the call to mp_mul can end up back
 * in this function if the a0, a1, b0, or b1 are above the threshold.
 * This is known as divide-and-conquer and leads to the famous
 * O(N**lg(3)) or O(N**1.584) work which is asymptopically lower than
 * the standard O(N**2) that the baseline/comba methods use.
 * Generally though the overhead of this method doesn't pay off
 * until a certain size (N ~ 80) is reached.
 */
mp_err s_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c)
{
   mp_int  x0, x1, y0, y1, t1, x0y0, x1y1;
   int     B;
   mp_err  err = MP_MEM; /* default the return code to an error */

   /* min # of digits */
   B = MP_MIN(a->used, b->used);

   /* now divide in two */
   B = B >> 1;

   /* init copy all the temps */
   if (mp_init_size(&x0, B) != MP_OKAY) {
      goto LBL_ERR;
   }
   if (mp_init_size(&x1, a->used - B) != MP_OKAY) {
      goto X0;
   }
   if (mp_init_size(&y0, B) != MP_OKAY) {
      goto X1;
   }
   if (mp_init_size(&y1, b->used - B) != MP_OKAY) {
      goto Y0;
   }

   /* init temps */
   if (mp_init_size(&t1, B * 2) != MP_OKAY) {
      goto Y1;
   }
   if (mp_init_size(&x0y0, B * 2) != MP_OKAY) {
      goto T1;
   }
   if (mp_init_size(&x1y1, B * 2) != MP_OKAY) {
      goto X0Y0;
   }

   /* now shift the digits */
   x0.used = y0.used = B;
   x1.used = a->used - B;
   y1.used = b->used - B;

   {
      int x;
      mp_digit *tmpa, *tmpb, *tmpx, *tmpy;

      /* we copy the digits directly instead of using higher level functions
       * since we also need to shift the digits
       */
      tmpa = a->dp;
      tmpb = b->dp;

      tmpx = x0.dp;
      tmpy = y0.dp;
      for (x = 0; x < B; x++) {
         *tmpx++ = *tmpa++;
         *tmpy++ = *tmpb++;
      }

      tmpx = x1.dp;
      for (x = B; x < a->used; x++) {
         *tmpx++ = *tmpa++;
      }

      tmpy = y1.dp;
      for (x = B; x < b->used; x++) {
         *tmpy++ = *tmpb++;
      }
   }

   /* only need to clamp the lower words since by definition the
    * upper words x1/y1 must have a known number of digits
    */
   mp_clamp(&x0);
   mp_clamp(&y0);

   /* now calc the products x0y0 and x1y1 */
   /* after this x0 is no longer required, free temp [x0==t2]! */
   if (mp_mul(&x0, &y0, &x0y0) != MP_OKAY) {
      goto X1Y1;          /* x0y0 = x0*y0 */
   }
   if (mp_mul(&x1, &y1, &x1y1) != MP_OKAY) {
      goto X1Y1;          /* x1y1 = x1*y1 */
   }

   /* now calc x1+x0 and y1+y0 */
   if (s_mp_add(&x1, &x0, &t1) != MP_OKAY) {
      goto X1Y1;          /* t1 = x1 - x0 */
   }
   if (s_mp_add(&y1, &y0, &x0) != MP_OKAY) {
      goto X1Y1;          /* t2 = y1 - y0 */
   }
   if (mp_mul(&t1, &x0, &t1) != MP_OKAY) {
      goto X1Y1;          /* t1 = (x1 + x0) * (y1 + y0) */
   }

   /* add x0y0 */
   if (mp_add(&x0y0, &x1y1, &x0) != MP_OKAY) {
      goto X1Y1;          /* t2 = x0y0 + x1y1 */
   }
   if (s_mp_sub(&t1, &x0, &t1) != MP_OKAY) {
      goto X1Y1;          /* t1 = (x1+x0)*(y1+y0) - (x1y1 + x0y0) */
   }

   /* shift by B */
   if (mp_lshd(&t1, B) != MP_OKAY) {
      goto X1Y1;          /* t1 = (x0y0 + x1y1 - (x1-x0)*(y1-y0))<<B */
   }
   if (mp_lshd(&x1y1, B * 2) != MP_OKAY) {
      goto X1Y1;          /* x1y1 = x1y1 << 2*B */
   }

   if (mp_add(&x0y0, &t1, &t1) != MP_OKAY) {
      goto X1Y1;          /* t1 = x0y0 + t1 */
   }
   if (mp_add(&t1, &x1y1, c) != MP_OKAY) {
      goto X1Y1;          /* t1 = x0y0 + t1 + x1y1 */
   }

   /* Algorithm succeeded set the return code to MP_OKAY */
   err = MP_OKAY;

X1Y1:
   mp_clear(&x1y1);
X0Y0:
   mp_clear(&x0y0);
T1:
   mp_clear(&t1);
Y1:
   mp_clear(&y1);
Y0:
   mp_clear(&y0);
X1:
   mp_clear(&x1);
X0:
   mp_clear(&x0);
LBL_ERR:
   return err;
}
#endif

Deleted libtommath/bn_s_mp_karatsuba_sqr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110














































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_KARATSUBA_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Karatsuba squaring, computes b = a*a using three
 * half size squarings
 *
 * See comments of karatsuba_mul for details.  It
 * is essentially the same algorithm but merely
 * tuned to perform recursive squarings.
 */
mp_err s_mp_karatsuba_sqr(const mp_int *a, mp_int *b)
{
   mp_int  x0, x1, t1, t2, x0x0, x1x1;
   int     B;
   mp_err  err = MP_MEM;

   /* min # of digits */
   B = a->used;

   /* now divide in two */
   B = B >> 1;

   /* init copy all the temps */
   if (mp_init_size(&x0, B) != MP_OKAY)
      goto LBL_ERR;
   if (mp_init_size(&x1, a->used - B) != MP_OKAY)
      goto X0;

   /* init temps */
   if (mp_init_size(&t1, a->used * 2) != MP_OKAY)
      goto X1;
   if (mp_init_size(&t2, a->used * 2) != MP_OKAY)
      goto T1;
   if (mp_init_size(&x0x0, B * 2) != MP_OKAY)
      goto T2;
   if (mp_init_size(&x1x1, (a->used - B) * 2) != MP_OKAY)
      goto X0X0;

   {
      int x;
      mp_digit *dst, *src;

      src = a->dp;

      /* now shift the digits */
      dst = x0.dp;
      for (x = 0; x < B; x++) {
         *dst++ = *src++;
      }

      dst = x1.dp;
      for (x = B; x < a->used; x++) {
         *dst++ = *src++;
      }
   }

   x0.used = B;
   x1.used = a->used - B;

   mp_clamp(&x0);

   /* now calc the products x0*x0 and x1*x1 */
   if (mp_sqr(&x0, &x0x0) != MP_OKAY)
      goto X1X1;           /* x0x0 = x0*x0 */
   if (mp_sqr(&x1, &x1x1) != MP_OKAY)
      goto X1X1;           /* x1x1 = x1*x1 */

   /* now calc (x1+x0)**2 */
   if (s_mp_add(&x1, &x0, &t1) != MP_OKAY)
      goto X1X1;           /* t1 = x1 - x0 */
   if (mp_sqr(&t1, &t1) != MP_OKAY)
      goto X1X1;           /* t1 = (x1 - x0) * (x1 - x0) */

   /* add x0y0 */
   if (s_mp_add(&x0x0, &x1x1, &t2) != MP_OKAY)
      goto X1X1;           /* t2 = x0x0 + x1x1 */
   if (s_mp_sub(&t1, &t2, &t1) != MP_OKAY)
      goto X1X1;           /* t1 = (x1+x0)**2 - (x0x0 + x1x1) */

   /* shift by B */
   if (mp_lshd(&t1, B) != MP_OKAY)
      goto X1X1;           /* t1 = (x0x0 + x1x1 - (x1-x0)*(x1-x0))<<B */
   if (mp_lshd(&x1x1, B * 2) != MP_OKAY)
      goto X1X1;           /* x1x1 = x1x1 << 2*B */

   if (mp_add(&x0x0, &t1, &t1) != MP_OKAY)
      goto X1X1;           /* t1 = x0x0 + t1 */
   if (mp_add(&t1, &x1x1, b) != MP_OKAY)
      goto X1X1;           /* t1 = x0x0 + t1 + x1x1 */

   err = MP_OKAY;

X1X1:
   mp_clear(&x1x1);
X0X0:
   mp_clear(&x0x0);
T2:
   mp_clear(&t2);
T1:
   mp_clear(&t1);
X1:
   mp_clear(&x1);
X0:
   mp_clear(&x0);
LBL_ERR:
   return err;
}
#endif

Deleted libtommath/bn_s_mp_montgomery_reduce_fast.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_MONTGOMERY_REDUCE_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* computes xR**-1 == x (mod N) via Montgomery Reduction
 *
 * This is an optimized implementation of montgomery_reduce
 * which uses the comba method to quickly calculate the columns of the
 * reduction.
 *
 * Based on Algorithm 14.32 on pp.601 of HAC.
*/
mp_err s_mp_montgomery_reduce_fast(mp_int *x, const mp_int *n, mp_digit rho)
{
   int     ix, olduse;
   mp_err  err;
   mp_word W[MP_WARRAY];

   if (x->used > MP_WARRAY) {
      return MP_VAL;
   }

   /* get old used count */
   olduse = x->used;

   /* grow a as required */
   if (x->alloc < (n->used + 1)) {
      if ((err = mp_grow(x, n->used + 1)) != MP_OKAY) {
         return err;
      }
   }

   /* first we have to get the digits of the input into
    * an array of double precision words W[...]
    */
   {
      mp_word *_W;
      mp_digit *tmpx;

      /* alias for the W[] array */
      _W   = W;

      /* alias for the digits of  x*/
      tmpx = x->dp;

      /* copy the digits of a into W[0..a->used-1] */
      for (ix = 0; ix < x->used; ix++) {
         *_W++ = *tmpx++;
      }

      /* zero the high words of W[a->used..m->used*2] */
      if (ix < ((n->used * 2) + 1)) {
         MP_ZERO_BUFFER(_W, sizeof(mp_word) * (size_t)(((n->used * 2) + 1) - ix));
      }
   }

   /* now we proceed to zero successive digits
    * from the least significant upwards
    */
   for (ix = 0; ix < n->used; ix++) {
      /* mu = ai * m' mod b
       *
       * We avoid a double precision multiplication (which isn't required)
       * by casting the value down to a mp_digit.  Note this requires
       * that W[ix-1] have  the carry cleared (see after the inner loop)
       */
      mp_digit mu;
      mu = ((W[ix] & MP_MASK) * rho) & MP_MASK;

      /* a = a + mu * m * b**i
       *
       * This is computed in place and on the fly.  The multiplication
       * by b**i is handled by offseting which columns the results
       * are added to.
       *
       * Note the comba method normally doesn't handle carries in the
       * inner loop In this case we fix the carry from the previous
       * column since the Montgomery reduction requires digits of the
       * result (so far) [see above] to work.  This is
       * handled by fixing up one carry after the inner loop.  The
       * carry fixups are done in order so after these loops the
       * first m->used words of W[] have the carries fixed
       */
      {
         int iy;
         mp_digit *tmpn;
         mp_word *_W;

         /* alias for the digits of the modulus */
         tmpn = n->dp;

         /* Alias for the columns set by an offset of ix */
         _W = W + ix;

         /* inner loop */
         for (iy = 0; iy < n->used; iy++) {
            *_W++ += (mp_word)mu * (mp_word)*tmpn++;
         }
      }

      /* now fix carry for next digit, W[ix+1] */
      W[ix + 1] += W[ix] >> (mp_word)MP_DIGIT_BIT;
   }

   /* now we have to propagate the carries and
    * shift the words downward [all those least
    * significant digits we zeroed].
    */
   {
      mp_digit *tmpx;
      mp_word *_W, *_W1;

      /* nox fix rest of carries */

      /* alias for current word */
      _W1 = W + ix;

      /* alias for next word, where the carry goes */
      _W = W + ++ix;

      for (; ix < ((n->used * 2) + 1); ix++) {
         *_W++ += *_W1++ >> (mp_word)MP_DIGIT_BIT;
      }

      /* copy out, A = A/b**n
       *
       * The result is A/b**n but instead of converting from an
       * array of mp_word to mp_digit than calling mp_rshd
       * we just copy them in the right order
       */

      /* alias for destination word */
      tmpx = x->dp;

      /* alias for shifted double precision result */
      _W = W + n->used;

      for (ix = 0; ix < (n->used + 1); ix++) {
         *tmpx++ = *_W++ & (mp_word)MP_MASK;
      }

      /* zero oldused digits, if the input a was larger than
       * m->used+1 we'll have to clear the digits
       */
      MP_ZERO_DIGITS(tmpx, olduse - ix);
   }

   /* set the max used and clamp */
   x->used = n->used + 1;
   mp_clamp(x);

   /* if A >= m then A = A - m */
   if (mp_cmp_mag(x, n) != MP_LT) {
      return s_mp_sub(x, n, x);
   }
   return MP_OKAY;
}
#endif

Changes to libtommath/bn_s_mp_mul_digs.c.

1

2
3

4
5














6
7

8
9
10

11
12

13
14
15
16
17




18
19
20
21
22
23






24
25
26
27
28




29
30
31
32
33
34





35
36
37


38
39
40
41
42
43
44
45
46
47









48
49
50
51
52
53
54






55
56
57


58
59
60
61
62
63
64
65
66








67
68
69


70
71
72


73
74

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
-
+

-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


-
+

-
+
-
-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_S_MP_MUL_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */

 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* multiplies |a| * |b| and only computes upto digs digits of result
 * HAC pp. 595, Algorithm 14.12  Modified so you can control how
 * HAC pp. 595, Algorithm 14.12  Modified so you can control how 
 * many digits of output are created.
 */
mp_err s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
int s_mp_mul_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
{
   mp_int  t;
  mp_int  t;
   mp_err  err;
   int     pa, pb, ix, iy;
   mp_digit u;
   mp_word r;
   mp_digit tmpx, *tmpt, *tmpy;
  int     res, pa, pb, ix, iy;
  mp_digit u;
  mp_word r;
  mp_digit tmpx, *tmpt, *tmpy;

   /* can we use the fast multiplier? */
   if ((digs < MP_WARRAY) &&
       (MP_MIN(a->used, b->used) < MP_MAXFAST)) {
      return s_mp_mul_digs_fast(a, b, c, digs);
   }
  /* can we use the fast multiplier? */
  if (((digs) < MP_WARRAY) &&
      MIN (a->used, b->used) < 
          (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) {
    return fast_s_mp_mul_digs (a, b, c, digs);
  }

   if ((err = mp_init_size(&t, digs)) != MP_OKAY) {
      return err;
   }
   t.used = digs;
  if ((res = mp_init_size (&t, digs)) != MP_OKAY) {
    return res;
  }
  t.used = digs;

   /* compute the digits of the product directly */
   pa = a->used;
   for (ix = 0; ix < pa; ix++) {
      /* set the carry to zero */
      u = 0;
  /* compute the digits of the product directly */
  pa = a->used;
  for (ix = 0; ix < pa; ix++) {
    /* set the carry to zero */
    u = 0;

      /* limit ourselves to making digs digits of output */
      pb = MP_MIN(b->used, digs - ix);
    /* limit ourselves to making digs digits of output */
    pb = MIN (b->used, digs - ix);

      /* setup some aliases */
      /* copy of the digit from a used within the nested loop */
      tmpx = a->dp[ix];

      /* an alias for the destination shifted ix places */
      tmpt = t.dp + ix;

      /* an alias for the digits of b */
      tmpy = b->dp;
    /* setup some aliases */
    /* copy of the digit from a used within the nested loop */
    tmpx = a->dp[ix];
    
    /* an alias for the destination shifted ix places */
    tmpt = t.dp + ix;
    
    /* an alias for the digits of b */
    tmpy = b->dp;

      /* compute the columns of the output and propagate the carry */
      for (iy = 0; iy < pb; iy++) {
         /* compute the column as a mp_word */
         r       = (mp_word)*tmpt +
                   ((mp_word)tmpx * (mp_word)*tmpy++) +
                   (mp_word)u;
    /* compute the columns of the output and propagate the carry */
    for (iy = 0; iy < pb; iy++) {
      /* compute the column as a mp_word */
      r       = ((mp_word)*tmpt) +
                ((mp_word)tmpx) * ((mp_word)*tmpy++) +
                ((mp_word) u);

         /* the new column is the lower part of the result */
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);
      /* the new column is the lower part of the result */
      *tmpt++ = (mp_digit) (r & ((mp_word) MP_MASK));

         /* get the carry word from the result */
         u       = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT);
      }
      /* set carry if it is placed below digs */
      if ((ix + iy) < digs) {
         *tmpt = u;
      }
   }
      /* get the carry word from the result */
      u       = (mp_digit) (r >> ((mp_word) DIGIT_BIT));
    }
    /* set carry if it is placed below digs */
    if (ix + iy < digs) {
      *tmpt = u;
    }
  }

   mp_clamp(&t);
   mp_exch(&t, c);
  mp_clamp (&t);
  mp_exch (&t, c);

   mp_clear(&t);
   return MP_OKAY;
  mp_clear (&t);
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_s_mp_mul_digs_fast.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90


























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_MUL_DIGS_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Fast (comba) multiplier
 *
 * This is the fast column-array [comba] multiplier.  It is
 * designed to compute the columns of the product first
 * then handle the carries afterwards.  This has the effect
 * of making the nested loops that compute the columns very
 * simple and schedulable on super-scalar processors.
 *
 * This has been modified to produce a variable number of
 * digits of output so if say only a half-product is required
 * you don't have to compute the upper half (a feature
 * required for fast Barrett reduction).
 *
 * Based on Algorithm 14.12 on pp.595 of HAC.
 *
 */
mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs)
{
   int      olduse, pa, ix, iz;
   mp_err   err;
   mp_digit W[MP_WARRAY];
   mp_word  _W;

   /* grow the destination as required */
   if (c->alloc < digs) {
      if ((err = mp_grow(c, digs)) != MP_OKAY) {
         return err;
      }
   }

   /* number of output digits to produce */
   pa = MP_MIN(digs, a->used + b->used);

   /* clear the carry */
   _W = 0;
   for (ix = 0; ix < pa; ix++) {
      int      tx, ty;
      int      iy;
      mp_digit *tmpx, *tmpy;

      /* get offsets into the two bignums */
      ty = MP_MIN(b->used-1, ix);
      tx = ix - ty;

      /* setup temp aliases */
      tmpx = a->dp + tx;
      tmpy = b->dp + ty;

      /* this is the number of times the loop will iterrate, essentially
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MP_MIN(a->used-tx, ty+1);

      /* execute loop */
      for (iz = 0; iz < iy; ++iz) {
         _W += (mp_word)*tmpx++ * (mp_word)*tmpy--;

      }

      /* store term */
      W[ix] = (mp_digit)_W & MP_MASK;

      /* make next carry */
      _W = _W >> (mp_word)MP_DIGIT_BIT;
   }

   /* setup dest */
   olduse  = c->used;
   c->used = pa;

   {
      mp_digit *tmpc;
      tmpc = c->dp;
      for (ix = 0; ix < pa; ix++) {
         /* now extract the previous digit [below the carry] */
         *tmpc++ = W[ix];
      }

      /* clear unused digits [that existed in the old copy of c] */
      MP_ZERO_DIGITS(tmpc, olduse - ix);
   }
   mp_clamp(c);
   return MP_OKAY;
}
#endif

Changes to libtommath/bn_s_mp_mul_high_digs.c.

1

2
3

4













5
6
7
8

9

10
11
12


13
14
15
16



17
18
19
20
21
22
23







24
25
26
27
28




29
30
31
32
33
34





35
36
37


38
39
40


41
42
43


44
45
46
47
48
49





50
51
52


53
54
55
56
57
58
59
60
61
62









63
64

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+




+
-
+

-
-
+
+
-
-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_S_MP_MUL_HIGH_DIGS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* multiplies |a| * |b| and does not compute the lower digs digits
 * [meant to get the higher part of the product]
 */
int
mp_err s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs)
s_mp_mul_high_digs (mp_int * a, mp_int * b, mp_int * c, int digs)
{
   mp_int   t;
   int      pa, pb, ix, iy;
  mp_int  t;
  int     res, pa, pb, ix, iy;
   mp_err   err;
   mp_digit u;
   mp_word  r;
   mp_digit tmpx, *tmpt, *tmpy;
  mp_digit u;
  mp_word r;
  mp_digit tmpx, *tmpt, *tmpy;

   /* can we use the fast multiplier? */
   if (MP_HAS(S_MP_MUL_HIGH_DIGS_FAST)
       && ((a->used + b->used + 1) < MP_WARRAY)
       && (MP_MIN(a->used, b->used) < MP_MAXFAST)) {
      return s_mp_mul_high_digs_fast(a, b, c, digs);
   }
  /* can we use the fast multiplier? */
#ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C
  if (((a->used + b->used + 1) < MP_WARRAY)
      && MIN (a->used, b->used) < (1 << ((CHAR_BIT * sizeof (mp_word)) - (2 * DIGIT_BIT)))) {
    return fast_s_mp_mul_high_digs (a, b, c, digs);
  }
#endif

   if ((err = mp_init_size(&t, a->used + b->used + 1)) != MP_OKAY) {
      return err;
   }
   t.used = a->used + b->used + 1;
  if ((res = mp_init_size (&t, a->used + b->used + 1)) != MP_OKAY) {
    return res;
  }
  t.used = a->used + b->used + 1;

   pa = a->used;
   pb = b->used;
   for (ix = 0; ix < pa; ix++) {
      /* clear the carry */
      u = 0;
  pa = a->used;
  pb = b->used;
  for (ix = 0; ix < pa; ix++) {
    /* clear the carry */
    u = 0;

      /* left hand side of A[ix] * B[iy] */
      tmpx = a->dp[ix];
    /* left hand side of A[ix] * B[iy] */
    tmpx = a->dp[ix];

      /* alias to the address of where the digits will be stored */
      tmpt = &(t.dp[digs]);
    /* alias to the address of where the digits will be stored */
    tmpt = &(t.dp[digs]);

      /* alias for where to read the right hand side from */
      tmpy = b->dp + (digs - ix);
    /* alias for where to read the right hand side from */
    tmpy = b->dp + (digs - ix);

      for (iy = digs - ix; iy < pb; iy++) {
         /* calculate the double precision result */
         r       = (mp_word)*tmpt +
                   ((mp_word)tmpx * (mp_word)*tmpy++) +
                   (mp_word)u;
    for (iy = digs - ix; iy < pb; iy++) {
      /* calculate the double precision result */
      r       = ((mp_word)*tmpt) +
                ((mp_word)tmpx) * ((mp_word)*tmpy++) +
                ((mp_word) u);

         /* get the lower part */
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);
      /* get the lower part */
      *tmpt++ = (mp_digit) (r & ((mp_word) MP_MASK));

         /* carry the carry */
         u       = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT);
      }
      *tmpt = u;
   }
   mp_clamp(&t);
   mp_exch(&t, c);
   mp_clear(&t);
   return MP_OKAY;
      /* carry the carry */
      u       = (mp_digit) (r >> ((mp_word) DIGIT_BIT));
    }
    *tmpt = u;
  }
  mp_clamp (&t);
  mp_exch (&t, c);
  mp_clear (&t);
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_s_mp_mul_high_digs_fast.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_MUL_HIGH_DIGS_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* this is a modified version of s_mp_mul_digs_fast that only produces
 * output digits *above* digs.  See the comments for s_mp_mul_digs_fast
 * to see how it works.
 *
 * This is used in the Barrett reduction since for one of the multiplications
 * only the higher digits were needed.  This essentially halves the work.
 *
 * Based on Algorithm 14.12 on pp.595 of HAC.
 */
mp_err s_mp_mul_high_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs)
{
   int     olduse, pa, ix, iz;
   mp_err   err;
   mp_digit W[MP_WARRAY];
   mp_word  _W;

   /* grow the destination as required */
   pa = a->used + b->used;
   if (c->alloc < pa) {
      if ((err = mp_grow(c, pa)) != MP_OKAY) {
         return err;
      }
   }

   /* number of output digits to produce */
   pa = a->used + b->used;
   _W = 0;
   for (ix = digs; ix < pa; ix++) {
      int      tx, ty, iy;
      mp_digit *tmpx, *tmpy;

      /* get offsets into the two bignums */
      ty = MP_MIN(b->used-1, ix);
      tx = ix - ty;

      /* setup temp aliases */
      tmpx = a->dp + tx;
      tmpy = b->dp + ty;

      /* this is the number of times the loop will iterrate, essentially its
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MP_MIN(a->used-tx, ty+1);

      /* execute loop */
      for (iz = 0; iz < iy; iz++) {
         _W += (mp_word)*tmpx++ * (mp_word)*tmpy--;
      }

      /* store term */
      W[ix] = (mp_digit)_W & MP_MASK;

      /* make next carry */
      _W = _W >> (mp_word)MP_DIGIT_BIT;
   }

   /* setup dest */
   olduse  = c->used;
   c->used = pa;

   {
      mp_digit *tmpc;

      tmpc = c->dp + digs;
      for (ix = digs; ix < pa; ix++) {
         /* now extract the previous digit [below the carry] */
         *tmpc++ = W[ix];
      }

      /* clear unused digits [that existed in the old copy of c] */
      MP_ZERO_DIGITS(tmpc, olduse - ix);
   }
   mp_clamp(c);
   return MP_OKAY;
}
#endif

Deleted libtommath/bn_s_mp_prime_is_divisible.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35



































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_PRIME_IS_DIVISIBLE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* determines if an integers is divisible by one
 * of the first PRIME_SIZE primes or not
 *
 * sets result to 0 if not, 1 if yes
 */
mp_err s_mp_prime_is_divisible(const mp_int *a, mp_bool *result)
{
   int      ix;
   mp_err   err;
   mp_digit res;

   /* default to not */
   *result = MP_NO;

   for (ix = 0; ix < PRIVATE_MP_PRIME_TAB_SIZE; ix++) {
      /* what is a mod LBL_prime_tab[ix] */
      if ((err = mp_mod_d(a, s_mp_prime_tab[ix], &res)) != MP_OKAY) {
         return err;
      }

      /* is the residue zero? */
      if (res == 0u) {
         *result = MP_YES;
         return MP_OKAY;
      }
   }

   return MP_OKAY;
}
#endif

Deleted libtommath/bn_s_mp_rand_jenkins.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52




















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_RAND_JENKINS_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* Bob Jenkins' http://burtleburtle.net/bob/rand/smallprng.html */
/* Chosen for speed and a good "mix" */
typedef struct {
   uint64_t a;
   uint64_t b;
   uint64_t c;
   uint64_t d;
} ranctx;

static ranctx jenkins_x;

#define rot(x,k) (((x)<<(k))|((x)>>(64-(k))))
static uint64_t s_rand_jenkins_val(void)
{
   uint64_t e = jenkins_x.a - rot(jenkins_x.b, 7);
   jenkins_x.a = jenkins_x.b ^ rot(jenkins_x.c, 13);
   jenkins_x.b = jenkins_x.c + rot(jenkins_x.d, 37);
   jenkins_x.c = jenkins_x.d + e;
   jenkins_x.d = e + jenkins_x.a;
   return jenkins_x.d;
}

void s_mp_rand_jenkins_init(uint64_t seed)
{
   int i;
   jenkins_x.a = 0xf1ea5eedULL;
   jenkins_x.b = jenkins_x.c = jenkins_x.d = seed;
   for (i = 0; i < 20; ++i) {
      (void)s_rand_jenkins_val();
   }
}

mp_err s_mp_rand_jenkins(void *p, size_t n)
{
   char *q = (char *)p;
   while (n > 0u) {
      int i;
      uint64_t x = s_rand_jenkins_val();
      for (i = 0; (i < 8) && (n > 0u); ++i, --n) {
         *q++ = (char)(x & 0xFFuLL);
         x >>= 8;
      }
   }
   return MP_OKAY;
}

#endif

Deleted libtommath/bn_s_mp_rand_platform.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148




















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_RAND_PLATFORM_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* First the OS-specific special cases
 * - *BSD
 * - Windows
 */
#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
#define BN_S_READ_ARC4RANDOM_C
static mp_err s_read_arc4random(void *p, size_t n)
{
   arc4random_buf(p, n);
   return MP_OKAY;
}
#endif

#if defined(_WIN32) || defined(_WIN32_WCE)
#define BN_S_READ_WINCSP_C

#ifndef _WIN32_WINNT
#define _WIN32_WINNT 0x0400
#endif
#ifdef _WIN32_WCE
#define UNDER_CE
#define ARM
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#include <wincrypt.h>

static mp_err s_read_wincsp(void *p, size_t n)
{
   static HCRYPTPROV hProv = 0;
   if (hProv == 0) {
      HCRYPTPROV h = 0;
      if (!CryptAcquireContext(&h, NULL, MS_DEF_PROV, PROV_RSA_FULL,
                               (CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET)) &&
          !CryptAcquireContext(&h, NULL, MS_DEF_PROV, PROV_RSA_FULL,
                               CRYPT_VERIFYCONTEXT | CRYPT_MACHINE_KEYSET | CRYPT_NEWKEYSET)) {
         return MP_ERR;
      }
      hProv = h;
   }
   return CryptGenRandom(hProv, (DWORD)n, (BYTE *)p) == TRUE ? MP_OKAY : MP_ERR;
}
#endif /* WIN32 */

#if !defined(BN_S_READ_WINCSP_C) && defined(__linux__) && defined(__GLIBC_PREREQ)
#if __GLIBC_PREREQ(2, 25)
#define BN_S_READ_GETRANDOM_C
#include <sys/random.h>
#include <errno.h>

static mp_err s_read_getrandom(void *p, size_t n)
{
   char *q = (char *)p;
   while (n > 0u) {
      ssize_t ret = getrandom(q, n, 0);
      if (ret < 0) {
         if (errno == EINTR) {
            continue;
         }
         return MP_ERR;
      }
      q += ret;
      n -= (size_t)ret;
   }
   return MP_OKAY;
}
#endif
#endif

/* We assume all platforms besides windows provide "/dev/urandom".
 * In case yours doesn't, define MP_NO_DEV_URANDOM at compile-time.
 */
#if !defined(BN_S_READ_WINCSP_C) && !defined(MP_NO_DEV_URANDOM)
#define BN_S_READ_URANDOM_C
#ifndef MP_DEV_URANDOM
#define MP_DEV_URANDOM "/dev/urandom"
#endif
#include <fcntl.h>
#include <errno.h>
#include <unistd.h>

static mp_err s_read_urandom(void *p, size_t n)
{
   int fd;
   char *q = (char *)p;

   do {
      fd = open(MP_DEV_URANDOM, O_RDONLY);
   } while ((fd == -1) && (errno == EINTR));
   if (fd == -1) return MP_ERR;

   while (n > 0u) {
      ssize_t ret = read(fd, p, n);
      if (ret < 0) {
         if (errno == EINTR) {
            continue;
         }
         close(fd);
         return MP_ERR;
      }
      q += ret;
      n -= (size_t)ret;
   }

   close(fd);
   return MP_OKAY;
}
#endif

#if defined(MP_PRNG_ENABLE_LTM_RNG)
#define BN_S_READ_LTM_RNG
unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
void (*ltm_rng_callback)(void);

static mp_err s_read_ltm_rng(void *p, size_t n)
{
   unsigned long res;
   if (ltm_rng == NULL) return MP_ERR;
   res = ltm_rng(p, n, ltm_rng_callback);
   if (res != n) return MP_ERR;
   return MP_OKAY;
}
#endif

mp_err s_read_arc4random(void *p, size_t n);
mp_err s_read_wincsp(void *p, size_t n);
mp_err s_read_getrandom(void *p, size_t n);
mp_err s_read_urandom(void *p, size_t n);
mp_err s_read_ltm_rng(void *p, size_t n);

mp_err s_mp_rand_platform(void *p, size_t n)
{
   mp_err err = MP_ERR;
   if ((err != MP_OKAY) && MP_HAS(S_READ_ARC4RANDOM)) err = s_read_arc4random(p, n);
   if ((err != MP_OKAY) && MP_HAS(S_READ_WINCSP))     err = s_read_wincsp(p, n);
   if ((err != MP_OKAY) && MP_HAS(S_READ_GETRANDOM))  err = s_read_getrandom(p, n);
   if ((err != MP_OKAY) && MP_HAS(S_READ_URANDOM))    err = s_read_urandom(p, n);
   if ((err != MP_OKAY) && MP_HAS(S_READ_LTM_RNG))    err = s_read_ltm_rng(p, n);
   return err;
}

#endif

Deleted libtommath/bn_s_mp_reverse.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22






















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_REVERSE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* reverse an array, used for radix code */
void s_mp_reverse(unsigned char *s, size_t len)
{
   size_t   ix, iy;
   unsigned char t;

   ix = 0u;
   iy = len - 1u;
   while (ix < iy) {
      t     = s[ix];
      s[ix] = s[iy];
      s[iy] = t;
      ++ix;
      --iy;
   }
}
#endif

Changes to libtommath/bn_s_mp_sqr.c.

1

2
3

4













5
6
7

8
9
10


11
12
13


14
15
16
17
18




19
20
21


22
23
24
25
26
27





28
29
30


31
32
33


34
35
36


37
38
39
40
41
42
43






44
45
46
47
48




49
50
51


52
53
54
55
56
57
58
59
60
61
62










63
64
65
66
67




68
69

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
-
+
+
-
-
-
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+


#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_S_MP_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* low level squaring, b = a*a, HAC pp.596-597, Algorithm 14.16 */
mp_err s_mp_sqr(const mp_int *a, mp_int *b)
int s_mp_sqr (mp_int * a, mp_int * b)
{
   mp_int   t;
   int      ix, iy, pa;
  mp_int  t;
  int     res, ix, iy, pa;
   mp_err   err;
   mp_word  r;
   mp_digit u, tmpx, *tmpt;
  mp_word r;
  mp_digit u, tmpx, *tmpt;

   pa = a->used;
   if ((err = mp_init_size(&t, (2 * pa) + 1)) != MP_OKAY) {
      return err;
   }
  pa = a->used;
  if ((res = mp_init_size (&t, 2*pa + 1)) != MP_OKAY) {
    return res;
  }

   /* default used is maximum possible size */
   t.used = (2 * pa) + 1;
  /* default used is maximum possible size */
  t.used = 2*pa + 1;

   for (ix = 0; ix < pa; ix++) {
      /* first calculate the digit at 2*ix */
      /* calculate double precision result */
      r = (mp_word)t.dp[2*ix] +
          ((mp_word)a->dp[ix] * (mp_word)a->dp[ix]);
  for (ix = 0; ix < pa; ix++) {
    /* first calculate the digit at 2*ix */
    /* calculate double precision result */
    r = ((mp_word) t.dp[2*ix]) +
        ((mp_word)a->dp[ix])*((mp_word)a->dp[ix]);

      /* store lower part in result */
      t.dp[ix+ix] = (mp_digit)(r & (mp_word)MP_MASK);
    /* store lower part in result */
    t.dp[ix+ix] = (mp_digit) (r & ((mp_word) MP_MASK));

      /* get the carry */
      u           = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT);
    /* get the carry */
    u           = (mp_digit)(r >> ((mp_word) DIGIT_BIT));

      /* left hand side of A[ix] * A[iy] */
      tmpx        = a->dp[ix];
    /* left hand side of A[ix] * A[iy] */
    tmpx        = a->dp[ix];

      /* alias for where to store the results */
      tmpt        = t.dp + ((2 * ix) + 1);

      for (iy = ix + 1; iy < pa; iy++) {
         /* first calculate the product */
         r       = (mp_word)tmpx * (mp_word)a->dp[iy];
    /* alias for where to store the results */
    tmpt        = t.dp + (2*ix + 1);
    
    for (iy = ix + 1; iy < pa; iy++) {
      /* first calculate the product */
      r       = ((mp_word)tmpx) * ((mp_word)a->dp[iy]);

         /* now calculate the double precision result, note we use
          * addition instead of *2 since it's easier to optimize
          */
         r       = (mp_word)*tmpt + r + r + (mp_word)u;
      /* now calculate the double precision result, note we use
       * addition instead of *2 since it's easier to optimize
       */
      r       = ((mp_word) *tmpt) + r + r + ((mp_word) u);

         /* store lower part */
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);
      /* store lower part */
      *tmpt++ = (mp_digit) (r & ((mp_word) MP_MASK));

         /* get carry */
         u       = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT);
      }
      /* propagate upwards */
      while (u != 0uL) {
         r       = (mp_word)*tmpt + (mp_word)u;
         *tmpt++ = (mp_digit)(r & (mp_word)MP_MASK);
         u       = (mp_digit)(r >> (mp_word)MP_DIGIT_BIT);
      }
   }
      /* get carry */
      u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
    }
    /* propagate upwards */
    while (u != ((mp_digit) 0)) {
      r       = ((mp_word) *tmpt) + ((mp_word) u);
      *tmpt++ = (mp_digit) (r & ((mp_word) MP_MASK));
      u       = (mp_digit)(r >> ((mp_word) DIGIT_BIT));
    }
  }

   mp_clamp(&t);
   mp_exch(&t, b);
   mp_clear(&t);
   return MP_OKAY;
  mp_clamp (&t);
  mp_exch (&t, b);
  mp_clear (&t);
  return MP_OKAY;
}
#endif

Deleted libtommath/bn_s_mp_sqr_fast.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97

































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_SQR_FAST_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* the jist of squaring...
 * you do like mult except the offset of the tmpx [one that
 * starts closer to zero] can't equal the offset of tmpy.
 * So basically you set up iy like before then you min it with
 * (ty-tx) so that it never happens.  You double all those
 * you add in the inner loop

After that loop you do the squares and add them in.
*/

mp_err s_mp_sqr_fast(const mp_int *a, mp_int *b)
{
   int       olduse, pa, ix, iz;
   mp_digit  W[MP_WARRAY], *tmpx;
   mp_word   W1;
   mp_err    err;

   /* grow the destination as required */
   pa = a->used + a->used;
   if (b->alloc < pa) {
      if ((err = mp_grow(b, pa)) != MP_OKAY) {
         return err;
      }
   }

   /* number of output digits to produce */
   W1 = 0;
   for (ix = 0; ix < pa; ix++) {
      int      tx, ty, iy;
      mp_word  _W;
      mp_digit *tmpy;

      /* clear counter */
      _W = 0;

      /* get offsets into the two bignums */
      ty = MP_MIN(a->used-1, ix);
      tx = ix - ty;

      /* setup temp aliases */
      tmpx = a->dp + tx;
      tmpy = a->dp + ty;

      /* this is the number of times the loop will iterrate, essentially
         while (tx++ < a->used && ty-- >= 0) { ... }
       */
      iy = MP_MIN(a->used-tx, ty+1);

      /* now for squaring tx can never equal ty
       * we halve the distance since they approach at a rate of 2x
       * and we have to round because odd cases need to be executed
       */
      iy = MP_MIN(iy, ((ty-tx)+1)>>1);

      /* execute loop */
      for (iz = 0; iz < iy; iz++) {
         _W += (mp_word)*tmpx++ * (mp_word)*tmpy--;
      }

      /* double the inner product and add carry */
      _W = _W + _W + W1;

      /* even columns have the square term in them */
      if (((unsigned)ix & 1u) == 0u) {
         _W += (mp_word)a->dp[ix>>1] * (mp_word)a->dp[ix>>1];
      }

      /* store it */
      W[ix] = (mp_digit)_W & MP_MASK;

      /* make next carry */
      W1 = _W >> (mp_word)MP_DIGIT_BIT;
   }

   /* setup dest */
   olduse  = b->used;
   b->used = a->used+a->used;

   {
      mp_digit *tmpb;
      tmpb = b->dp;
      for (ix = 0; ix < pa; ix++) {
         *tmpb++ = W[ix] & MP_MASK;
      }

      /* clear unused digits [that existed in the old copy of c] */
      MP_ZERO_DIGITS(tmpb, olduse - ix);
   }
   mp_clamp(b);
   return MP_OKAY;
}
#endif

Changes to libtommath/bn_s_mp_sub.c.

1

2
3

4













5
6

7

8
9

10
11
12
13
14



15
16
17
18
19
20
21
22
23








24
25
26
27



28
29
30
31
32




33
34
35
36
37
38





39
40
41
42
43
44
45






46
47
48
49



50
51
52
53
54




55
56
57


58
59
60
61



62
63
64
65
66
67
68








69
70
71

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
-
+

-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+

-
+
-

-
-
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+



#include "tommath_private.h"
#include <tommath.h>
#ifdef BN_S_MP_SUB_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* LibTomMath, multiple-precision integer library -- Tom St Denis
/* SPDX-License-Identifier: Unlicense */
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* low level subtraction (assumes |a| > |b|), HAC pp.595 Algorithm 14.9 */
int
mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c)
s_mp_sub (mp_int * a, mp_int * b, mp_int * c)
{
   int    olduse, min, max;
  int     olduse, res, min, max;
   mp_err err;

   /* find sizes */
   min = b->used;
   max = a->used;
  /* find sizes */
  min = b->used;
  max = a->used;

   /* init result */
   if (c->alloc < max) {
      if ((err = mp_grow(c, max)) != MP_OKAY) {
         return err;
      }
   }
   olduse = c->used;
   c->used = max;
  /* init result */
  if (c->alloc < max) {
    if ((res = mp_grow (c, max)) != MP_OKAY) {
      return res;
    }
  }
  olduse = c->used;
  c->used = max;

   {
      mp_digit u, *tmpa, *tmpb, *tmpc;
      int i;
  {
    register mp_digit u, *tmpa, *tmpb, *tmpc;
    register int i;

      /* alias for digit pointers */
      tmpa = a->dp;
      tmpb = b->dp;
      tmpc = c->dp;
    /* alias for digit pointers */
    tmpa = a->dp;
    tmpb = b->dp;
    tmpc = c->dp;

      /* set carry to zero */
      u = 0;
      for (i = 0; i < min; i++) {
         /* T[i] = A[i] - B[i] - U */
         *tmpc = (*tmpa++ - *tmpb++) - u;
    /* set carry to zero */
    u = 0;
    for (i = 0; i < min; i++) {
      /* T[i] = A[i] - B[i] - U */
      *tmpc = *tmpa++ - *tmpb++ - u;

         /* U = carry bit of T[i]
          * Note this saves performing an AND operation since
          * if a carry does occur it will propagate all the way to the
          * MSB.  As a result a single shift is enough to get the carry
          */
         u = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u);
      /* U = carry bit of T[i]
       * Note this saves performing an AND operation since
       * if a carry does occur it will propagate all the way to the
       * MSB.  As a result a single shift is enough to get the carry
       */
      u = *tmpc >> ((mp_digit)(CHAR_BIT * sizeof (mp_digit) - 1));

         /* Clear carry from T[i] */
         *tmpc++ &= MP_MASK;
      }
      /* Clear carry from T[i] */
      *tmpc++ &= MP_MASK;
    }

      /* now copy higher words if any, e.g. if A has more digits than B  */
      for (; i < max; i++) {
         /* T[i] = A[i] - U */
         *tmpc = *tmpa++ - u;
    /* now copy higher words if any, e.g. if A has more digits than B  */
    for (; i < max; i++) {
      /* T[i] = A[i] - U */
      *tmpc = *tmpa++ - u;

         /* U = carry bit of T[i] */
         u = *tmpc >> (MP_SIZEOF_BITS(mp_digit) - 1u);
      /* U = carry bit of T[i] */
      u = *tmpc >> ((mp_digit)(CHAR_BIT * sizeof (mp_digit) - 1));

         /* Clear carry from T[i] */
         *tmpc++ &= MP_MASK;
      }
      /* Clear carry from T[i] */
      *tmpc++ &= MP_MASK;
    }

      /* clear digits above used (since we may not have grown result above) */
      MP_ZERO_DIGITS(tmpc, olduse - c->used);
   }

   mp_clamp(c);
   return MP_OKAY;
    /* clear digits above used (since we may not have grown result above) */
    for (i = c->used; i < olduse; i++) {
      *tmpc++ = 0;
    }
  }

  mp_clamp (c);
  return MP_OKAY;
}

#endif

Deleted libtommath/bn_s_mp_toom_mul.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215























































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_TOOM_MUL_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* multiplication using the Toom-Cook 3-way algorithm
 *
 * Much more complicated than Karatsuba but has a lower
 * asymptotic running time of O(N**1.464).  This algorithm is
 * only particularly useful on VERY large inputs
 * (we're talking 1000s of digits here...).
*/

/*
   This file contains code from J. Arndt's book  "Matters Computational"
   and the accompanying FXT-library with permission of the author.
*/

/*
   Setup from

     Chung, Jaewook, and M. Anwar Hasan. "Asymmetric squaring formulae."
     18th IEEE Symposium on Computer Arithmetic (ARITH'07). IEEE, 2007.

   The interpolation from above needed one temporary variable more
   than the interpolation here:

     Bodrato, Marco, and Alberto Zanoni. "What about Toom-Cook matrices optimality."
     Centro Vito Volterra Universita di Roma Tor Vergata (2006)
*/

mp_err s_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c)
{
   mp_int S1, S2, T1, a0, a1, a2, b0, b1, b2;
   int B, count;
   mp_err err;

   /* init temps */
   if ((err = mp_init_multi(&S1, &S2, &T1, NULL)) != MP_OKAY) {
      return err;
   }

   /* B */
   B = MP_MIN(a->used, b->used) / 3;

   /** a = a2 * x^2 + a1 * x + a0; */
   if ((err = mp_init_size(&a0, B)) != MP_OKAY)                   goto LBL_ERRa0;

   for (count = 0; count < B; count++) {
      a0.dp[count] = a->dp[count];
      a0.used++;
   }
   mp_clamp(&a0);
   if ((err = mp_init_size(&a1, B)) != MP_OKAY)                   goto LBL_ERRa1;
   for (; count < (2 * B); count++) {
      a1.dp[count - B] = a->dp[count];
      a1.used++;
   }
   mp_clamp(&a1);
   if ((err = mp_init_size(&a2, B + (a->used - (3 * B)))) != MP_OKAY) goto LBL_ERRa2;
   for (; count < a->used; count++) {
      a2.dp[count - (2 * B)] = a->dp[count];
      a2.used++;
   }
   mp_clamp(&a2);

   /** b = b2 * x^2 + b1 * x + b0; */
   if ((err = mp_init_size(&b0, B)) != MP_OKAY)                   goto LBL_ERRb0;
   for (count = 0; count < B; count++) {
      b0.dp[count] = b->dp[count];
      b0.used++;
   }
   mp_clamp(&b0);
   if ((err = mp_init_size(&b1, B)) != MP_OKAY)                   goto LBL_ERRb1;
   for (; count < (2 * B); count++) {
      b1.dp[count - B] = b->dp[count];
      b1.used++;
   }
   mp_clamp(&b1);
   if ((err = mp_init_size(&b2, B + (b->used - (3 * B)))) != MP_OKAY) goto LBL_ERRb2;
   for (; count < b->used; count++) {
      b2.dp[count - (2 * B)] = b->dp[count];
      b2.used++;
   }
   mp_clamp(&b2);

   /** \\ S1 = (a2+a1+a0) * (b2+b1+b0); */
   /** T1 = a2 + a1; */
   if ((err = mp_add(&a2, &a1, &T1)) != MP_OKAY)                  goto LBL_ERR;

   /** S2 = T1 + a0; */
   if ((err = mp_add(&T1, &a0, &S2)) != MP_OKAY)                  goto LBL_ERR;

   /** c = b2 + b1; */
   if ((err = mp_add(&b2, &b1, c)) != MP_OKAY)                    goto LBL_ERR;

   /** S1 = c + b0; */
   if ((err = mp_add(c, &b0, &S1)) != MP_OKAY)                    goto LBL_ERR;

   /** S1 = S1 * S2; */
   if ((err = mp_mul(&S1, &S2, &S1)) != MP_OKAY)                  goto LBL_ERR;

   /** \\S2 = (4*a2+2*a1+a0) * (4*b2+2*b1+b0); */
   /** T1 = T1 + a2; */
   if ((err = mp_add(&T1, &a2, &T1)) != MP_OKAY)                  goto LBL_ERR;

   /** T1 = T1 << 1; */
   if ((err = mp_mul_2(&T1, &T1)) != MP_OKAY)                     goto LBL_ERR;

   /** T1 = T1 + a0; */
   if ((err = mp_add(&T1, &a0, &T1)) != MP_OKAY)                  goto LBL_ERR;

   /** c = c + b2; */
   if ((err = mp_add(c, &b2, c)) != MP_OKAY)                      goto LBL_ERR;

   /** c = c << 1; */
   if ((err = mp_mul_2(c, c)) != MP_OKAY)                         goto LBL_ERR;

   /** c = c + b0; */
   if ((err = mp_add(c, &b0, c)) != MP_OKAY)                      goto LBL_ERR;

   /** S2 = T1 * c; */
   if ((err = mp_mul(&T1, c, &S2)) != MP_OKAY)                    goto LBL_ERR;

   /** \\S3 = (a2-a1+a0) * (b2-b1+b0); */
   /** a1 = a2 - a1; */
   if ((err = mp_sub(&a2, &a1, &a1)) != MP_OKAY)                  goto LBL_ERR;

   /** a1 = a1 + a0; */
   if ((err = mp_add(&a1, &a0, &a1)) != MP_OKAY)                  goto LBL_ERR;

   /** b1 = b2 - b1; */
   if ((err = mp_sub(&b2, &b1, &b1)) != MP_OKAY)                  goto LBL_ERR;

   /** b1 = b1 + b0; */
   if ((err = mp_add(&b1, &b0, &b1)) != MP_OKAY)                  goto LBL_ERR;

   /** a1 = a1 * b1; */
   if ((err = mp_mul(&a1, &b1, &a1)) != MP_OKAY)                  goto LBL_ERR;

   /** b1 = a2 * b2; */
   if ((err = mp_mul(&a2, &b2, &b1)) != MP_OKAY)                  goto LBL_ERR;

   /** \\S2 = (S2 - S3)/3; */
   /** S2 = S2 - a1; */
   if ((err = mp_sub(&S2, &a1, &S2)) != MP_OKAY)                  goto LBL_ERR;

   /** S2 = S2 / 3; \\ this is an exact division  */
   if ((err = mp_div_3(&S2, &S2, NULL)) != MP_OKAY)               goto LBL_ERR;

   /** a1 = S1 - a1; */
   if ((err = mp_sub(&S1, &a1, &a1)) != MP_OKAY)                  goto LBL_ERR;

   /** a1 = a1 >> 1; */
   if ((err = mp_div_2(&a1, &a1)) != MP_OKAY)                     goto LBL_ERR;

   /** a0 = a0 * b0; */
   if ((err = mp_mul(&a0, &b0, &a0)) != MP_OKAY)                  goto LBL_ERR;

   /** S1 = S1 - a0; */
   if ((err = mp_sub(&S1, &a0, &S1)) != MP_OKAY)                  goto LBL_ERR;

   /** S2 = S2 - S1; */
   if ((err = mp_sub(&S2, &S1, &S2)) != MP_OKAY)                  goto LBL_ERR;

   /** S2 = S2 >> 1; */
   if ((err = mp_div_2(&S2, &S2)) != MP_OKAY)                     goto LBL_ERR;

   /** S1 = S1 - a1; */
   if ((err = mp_sub(&S1, &a1, &S1)) != MP_OKAY)                  goto LBL_ERR;

   /** S1 = S1 - b1; */
   if ((err = mp_sub(&S1, &b1, &S1)) != MP_OKAY)                  goto LBL_ERR;

   /** T1 = b1 << 1; */
   if ((err = mp_mul_2(&b1, &T1)) != MP_OKAY)                     goto LBL_ERR;

   /** S2 = S2 - T1; */
   if ((err = mp_sub(&S2, &T1, &S2)) != MP_OKAY)                  goto LBL_ERR;

   /** a1 = a1 - S2; */
   if ((err = mp_sub(&a1, &S2, &a1)) != MP_OKAY)                  goto LBL_ERR;


   /** P = b1*x^4+ S2*x^3+ S1*x^2+ a1*x + a0; */
   if ((err = mp_lshd(&b1, 4 * B)) != MP_OKAY)                    goto LBL_ERR;
   if ((err = mp_lshd(&S2, 3 * B)) != MP_OKAY)                    goto LBL_ERR;
   if ((err = mp_add(&b1, &S2, &b1)) != MP_OKAY)                  goto LBL_ERR;
   if ((err = mp_lshd(&S1, 2 * B)) != MP_OKAY)                    goto LBL_ERR;
   if ((err = mp_add(&b1, &S1, &b1)) != MP_OKAY)                  goto LBL_ERR;
   if ((err = mp_lshd(&a1, 1 * B)) != MP_OKAY)                    goto LBL_ERR;
   if ((err = mp_add(&b1, &a1, &b1)) != MP_OKAY)                  goto LBL_ERR;
   if ((err = mp_add(&b1, &a0, c)) != MP_OKAY)                    goto LBL_ERR;

   /** a * b - P */


LBL_ERR:
   mp_clear(&b2);
LBL_ERRb2:
   mp_clear(&b1);
LBL_ERRb1:
   mp_clear(&b0);
LBL_ERRb0:
   mp_clear(&a2);
LBL_ERRa2:
   mp_clear(&a1);
LBL_ERRa1:
   mp_clear(&a0);
LBL_ERRa0:
   mp_clear_multi(&S1, &S2, &T1, NULL);
   return err;
}

#endif

Deleted libtommath/bn_s_mp_toom_sqr.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147



















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include "tommath_private.h"
#ifdef BN_S_MP_TOOM_SQR_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* squaring using Toom-Cook 3-way algorithm */

/*
   This file contains code from J. Arndt's book  "Matters Computational"
   and the accompanying FXT-library with permission of the author.
*/

/* squaring using Toom-Cook 3-way algorithm */
/*
   Setup and interpolation from algorithm SQR_3 in

     Chung, Jaewook, and M. Anwar Hasan. "Asymmetric squaring formulae."
     18th IEEE Symposium on Computer Arithmetic (ARITH'07). IEEE, 2007.

*/
mp_err s_mp_toom_sqr(const mp_int *a, mp_int *b)
{
   mp_int S0, a0, a1, a2;
   mp_digit *tmpa, *tmpc;
   int B, count;
   mp_err err;


   /* init temps */
   if ((err = mp_init(&S0)) != MP_OKAY) {
      return err;
   }

   /* B */
   B = a->used / 3;

   /** a = a2 * x^2 + a1 * x + a0; */
   if ((err = mp_init_size(&a0, B)) != MP_OKAY)                   goto LBL_ERRa0;

   a0.used = B;
   if ((err = mp_init_size(&a1, B)) != MP_OKAY)                   goto LBL_ERRa1;
   a1.used = B;
   if ((err = mp_init_size(&a2, B + (a->used - (3 * B)))) != MP_OKAY) goto LBL_ERRa2;

   tmpa = a->dp;
   tmpc = a0.dp;
   for (count = 0; count < B; count++) {
      *tmpc++ = *tmpa++;
   }
   tmpc = a1.dp;
   for (; count < (2 * B); count++) {
      *tmpc++ = *tmpa++;
   }
   tmpc = a2.dp;
   for (; count < a->used; count++) {
      *tmpc++ = *tmpa++;
      a2.used++;
   }
   mp_clamp(&a0);
   mp_clamp(&a1);
   mp_clamp(&a2);

   /** S0 = a0^2;  */
   if ((err = mp_sqr(&a0, &S0)) != MP_OKAY)                       goto LBL_ERR;

   /** \\S1 = (a2 + a1 + a0)^2 */
   /** \\S2 = (a2 - a1 + a0)^2  */
   /** \\S1 = a0 + a2; */
   /** a0 = a0 + a2; */
   if ((err = mp_add(&a0, &a2, &a0)) != MP_OKAY)                  goto LBL_ERR;
   /** \\S2 = S1 - a1; */
   /** b = a0 - a1; */
   if ((err = mp_sub(&a0, &a1, b)) != MP_OKAY)                    goto LBL_ERR;
   /** \\S1 = S1 + a1; */
   /** a0 = a0 + a1; */
   if ((err = mp_add(&a0, &a1, &a0)) != MP_OKAY)                  goto LBL_ERR;
   /** \\S1 = S1^2;  */
   /** a0 = a0^2; */
   if ((err = mp_sqr(&a0, &a0)) != MP_OKAY)                       goto LBL_ERR;
   /** \\S2 = S2^2;  */
   /** b = b^2; */
   if ((err = mp_sqr(b, b)) != MP_OKAY)                           goto LBL_ERR;

   /** \\ S3 = 2 * a1 * a2  */
   /** \\S3 = a1 * a2;  */
   /** a1 = a1 * a2; */
   if ((err = mp_mul(&a1, &a2, &a1)) != MP_OKAY)                  goto LBL_ERR;
   /** \\S3 = S3 << 1;  */
   /** a1 = a1 << 1; */
   if ((err = mp_mul_2(&a1, &a1)) != MP_OKAY)                     goto LBL_ERR;

   /** \\S4 = a2^2;  */
   /** a2 = a2^2; */
   if ((err = mp_sqr(&a2, &a2)) != MP_OKAY)                       goto LBL_ERR;

   /** \\ tmp = (S1 + S2)/2  */
   /** \\tmp = S1 + S2; */
   /** b = a0 + b; */
   if ((err = mp_add(&a0, b, b)) != MP_OKAY)                      goto LBL_ERR;
   /** \\tmp = tmp >> 1; */
   /** b = b >> 1; */
   if ((err = mp_div_2(b, b)) != MP_OKAY)                         goto LBL_ERR;

   /** \\ S1 = S1 - tmp - S3  */
   /** \\S1 = S1 - tmp; */
   /** a0 = a0 - b; */
   if ((err = mp_sub(&a0, b, &a0)) != MP_OKAY)                    goto LBL_ERR;
   /** \\S1 = S1 - S3;  */
   /** a0 = a0 - a1; */
   if ((err = mp_sub(&a0, &a1, &a0)) != MP_OKAY)                  goto LBL_ERR;

   /** \\S2 = tmp - S4 -S0  */
   /** \\S2 = tmp - S4;  */
   /** b = b - a2; */
   if ((err = mp_sub(b, &a2, b)) != MP_OKAY)                      goto LBL_ERR;
   /** \\S2 = S2 - S0;  */
   /** b = b - S0; */
   if ((err = mp_sub(b, &S0, b)) != MP_OKAY)                      goto LBL_ERR;


   /** \\P = S4*x^4 + S3*x^3 + S2*x^2 + S1*x + S0; */
   /** P = a2*x^4 + a1*x^3 + b*x^2 + a0*x + S0; */

   if ((err = mp_lshd(&a2, 4 * B)) != MP_OKAY)                    goto LBL_ERR;
   if ((err = mp_lshd(&a1, 3 * B)) != MP_OKAY)                    goto LBL_ERR;
   if ((err = mp_lshd(b, 2 * B)) != MP_OKAY)                      goto LBL_ERR;
   if ((err = mp_lshd(&a0, 1 * B)) != MP_OKAY)                    goto LBL_ERR;
   if ((err = mp_add(&a2, &a1, &a2)) != MP_OKAY)                  goto LBL_ERR;
   if ((err = mp_add(&a2, b, b)) != MP_OKAY)                      goto LBL_ERR;
   if ((err = mp_add(b, &a0, b)) != MP_OKAY)                      goto LBL_ERR;
   if ((err = mp_add(b, &S0, b)) != MP_OKAY)                      goto LBL_ERR;
   /** a^2 - P  */


LBL_ERR:
   mp_clear(&a2);
LBL_ERRa2:
   mp_clear(&a1);
LBL_ERRa1:
   mp_clear(&a0);
LBL_ERRa0:
   mp_clear(&S0);

   return err;
}

#endif

Added libtommath/bncore.c.

































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#include <tommath.h>
#ifdef BNCORE_C
/* LibTomMath, multiple-precision integer library -- Tom St Denis
 *
 * LibTomMath is a library that provides multiple-precision
 * integer arithmetic as well as number theoretic functionality.
 *
 * The library was designed directly after the MPI library by
 * Michael Fromberger but has been written from scratch with
 * additional optimizations in place.
 *
 * The library is free for all purposes without any express
 * guarantee it works.
 *
 * Tom St Denis, tomstdenis@gmail.com, http://math.libtomcrypt.com
 */

/* Known optimal configurations

 CPU                    /Compiler     /MUL CUTOFF/SQR CUTOFF
-------------------------------------------------------------
 Intel P4 Northwood     /GCC v3.4.1   /        88/       128/LTM 0.32 ;-)
 AMD Athlon64           /GCC v3.4.4   /        80/       120/LTM 0.35
 
*/

int     KARATSUBA_MUL_CUTOFF = 80,      /* Min. number of digits before Karatsuba multiplication is used. */
        KARATSUBA_SQR_CUTOFF = 120,     /* Min. number of digits before Karatsuba squaring is used. */
        
        TOOM_MUL_CUTOFF      = 350,      /* no optimal values of these are known yet so set em high */
        TOOM_SQR_CUTOFF      = 400; 
#endif

Changes to libtommath/changes.txt.

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






























































































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
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+


-
+
















-
+



-
+









-
-
+
+










-
+










-
+
















-
+







-
+







Oct 22nd, 2019
v1.2.0
       -- A huge refactoring of the library happened - renaming,
          deprecating and replacing existing functions by improved API's.

          All deprecated functions, macros and symbols are only marked as such
          so this version is still API and ABI compatible to v1.x.

       -- Daniel Mendler was pushing for those changes and contributing a load of patches,
          refactorings, code reviews and whatnotelse.
       -- Christoph Zurnieden re-worked internals of the library, improved the performance,
          did code reviews and wrote documentation.
       -- Francois Perrad did some refactoring and took again care of linting the sources and
          provided all fixes.
       -- Jan Nijtmans, Karel Miko and Joachim Breitner contributed various patches.

       -- Private symbols can now be hidden for the shared library builds, disabled by default.
       -- All API's follow a single code style, are prefixed the same etc.
       -- Unified, safer and improved API's
       -- Less magic numbers - return values (where appropriate) and most flags are now enums,
          this was implemented in a backwards compatible way where return values were int.
       -- API's with return values are now by default marked as "warn on unsused result", this
          can be disabled if required (which will most likely hide bugs), c.f. MP_WUR in tommath.h
       -- Provide a whole set of setters&getters for different primitive types (long, uint32_t, etc.)
       -- All those primitive setters are now optimized.
       -- It's possible to automatically tune the cutoff values for Karatsuba&Toom-Cook
       -- The custom allocators which were formerly known as XMALLOC(), XFREE() etc. are now available
          as MP_MALLOC(), MP_REALLOC(), MP_CALLOC() and MP_FREE(). MP_REALLOC() and MP_FREE() now also
          provide the allocated size to ease the usage of simple allocators without tracking.
       -- Building is now also possible with MSVC 2015, 2017 and 2019 (use makefile.msvc)
       -- Added mp_decr() and mp_incr()
       -- Added mp_log_u32()
       -- Improved prime-checking
       -- Improved Toom-Cook multiplication
       -- Removed the LTM book (`make docs` now builds the user manual)


Jan 28th, 2019
v1.1.0
       -- Christoph Zurnieden contributed FIPS 186.4 compliant
          prime-checking (PR #113), several other fixes and a load of documentation
       -- Daniel Mendler provided two's-complement functions (PR #124)
          and mp_{set,get}_double() (PR #123)
       -- Francois Perrad took care of linting the sources, provided all fixes and
          a astylerc to auto-format the sources.
       -- A bunch of patches by Kevin B Kenny have been back-ported from TCL
       -- Jan Nijtmans provided the patches to `const`ify all API
          function arguments (also from TCL)
       -- mp_rand() has now several native random provider implementations
          and doesn't rely on `rand()` anymore
       -- Karel Miko provided fixes when building for MS Windows
          and re-worked the makefile generating process
       -- The entire environment and build logic has been extended and improved
          regarding auto-detection of platforms, libtool and a lot more
       -- Prevent some potential BOF cases
       -- Improved/fixed mp_lshd() and mp_invmod()
       -- A load more bugs were fixed by various contributors


Aug 29th, 2017
v1.0.1
       -- Dmitry Kovalenko provided fixes to mp_add_d() and mp_init_copy()
       -- Matt Johnston contributed some improvements to mp_div_2d(),
          mp_exptmod_fast(), mp_mod() and mp_mulmod()
       -- Julien Nabet provided a fix to the error handling in mp_init_multi()
       -- Ben Gardner provided a fix regarding usage of reserved keywords
       -- Fixed mp_rand() to fill the correct number of bits
       -- Fixed mp_invmod()
       -- Use the same 64-bit detection code as in libtomcrypt
       -- Correct usage of DESTDIR, PREFIX, etc. when installing the library
       -- Francois Perrad updated all the perl scripts to an actual perl version


Feb 5th, 2016
v1.0
       -- Bump to 1.0
       -- Dirkjan Bussink provided a faster version of mp_expt_d()
       -- Moritz Lenz contributed a fix to mp_mod()
          and provided mp_get_long() and mp_set_long()
       -- Fixed bugs in mp_read_radix(), mp_radix_size
          Thanks to shameister, Gerhard R,
       -- Christopher Brown provided mp_export() and mp_import()
       -- Improvements in the code of mp_init_copy()
          Thanks to ramkumarkoppu,
       -- lomereiter provided mp_balance_mul()
       -- Alexander Boström from the heimdal project contributed patches to
          mp_prime_next_prime() and mp_invmod() and added a mp_isneg() macro
       -- Fix build issues for Linux x32 ABI
       -- Added mp_get_long_long() and mp_set_long_long()
       -- Carlin provided a patch to use arc4random() instead of rand()
          on platforms where it is supported
       -- Karel Miko provided mp_sqrtmod_prime()


July 23rd, 2010
v0.42.0
       -- Fix for mp_prime_next_prime() bug when checking generated prime
       -- allow mp_shrink to shrink initialized, but empty MPI's
       -- Added project and solution files for Visual Studio 2005 and Visual Studio 2008.
       -- Added project and solution files for Visual Studio 2005 and Visual Studio 2008. 

March 10th, 2007
v0.41  -- Wolfgang Ehrhardt suggested a quick fix to mp_div_d() which makes the detection of powers of two quicker.
v0.41  -- Wolfgang Ehrhardt suggested a quick fix to mp_div_d() which makes the detection of powers of two quicker. 
       -- [CRI] Added libtommath.dsp for Visual C++ users.

December 24th, 2006
v0.40  -- Updated makefile to properly support LIBNAME
       -- Fixed bug in fast_s_mp_mul_high_digs() which overflowed (line 83), thanks Valgrind!

April 4th, 2006
v0.39  -- Jim Wigginton pointed out my Montgomery examples in figures 6.4 and 6.6 were off by one, k should be 9 not 8
       -- Bruce Guenter suggested I use --tag=CC for libtool builds where the compiler may think it's C++.
       -- "mm" from sci.crypt pointed out that my mp_gcd was sub-optimal (I also updated and corrected the book)
       -- updated some of the @@ tags in tommath.src to reflect source changes.
       -- updated email and url info in all source files

Jan 26th, 2006
v0.38  -- broken makefile.shared fixed
       -- removed some carry stores that were not required [updated text]

       
November 18th, 2005
v0.37  -- [Don Porter] reported on a TCL list [HEY SEND ME BUGREPORTS ALREADY!!!] that mp_add_d() would compute -0 with some inputs.  Fixed.
       -- [rinick@gmail.com] reported the makefile.bcc was messed up.  Fixed.
       -- [Kevin Kenny] reported some issues with mp_toradix_n().  Now it doesn't require a min of 3 chars of output.
       -- [Kevin Kenny] reported some issues with mp_toradix_n().  Now it doesn't require a min of 3 chars of output.  
       -- Made the make command renamable.  Wee

August 1st, 2005
v0.36  -- LTM_PRIME_2MSB_ON was fixed and the "OFF" flag was removed.
       -- [Peter LaDow] found a typo in the XREALLOC macro
       -- [Peter LaDow] pointed out that mp_read_(un)signed_bin should have "const" on the input
       -- Ported LTC patch to fix the prime_random_ex() function to get the bitsize correct [and the maskOR flags]
       -- Kevin Kenny pointed out a stray //
       -- David Hulton pointed out a typo in the textbook [mp_montgomery_setup() pseudo-code]
       -- Neal Hamilton (Elliptic Semiconductor) pointed out that my Karatsuba notation was backwards and that I could use
          unsigned operations in the routine.
       -- Neal Hamilton (Elliptic Semiconductor) pointed out that my Karatsuba notation was backwards and that I could use 
          unsigned operations in the routine.  
       -- Paul Schmidt pointed out a linking error in mp_exptmod() when BN_S_MP_EXPTMOD_C is undefined (and another for read_radix)
       -- Updated makefiles to be way more flexible

March 12th, 2005
v0.35  -- Stupid XOR function missing line again... oops.
       -- Fixed bug in invmod not handling negative inputs correctly [Wolfgang Ehrhardt]
       -- Made exteuclid always give positive u3 output...[ Wolfgang Ehrhardt ]
       -- [Wolfgang Ehrhardt] Suggested a fix for mp_reduce() which avoided underruns.  ;-)
       -- mp_rand() would emit one too many digits and it was possible to get a 0 out of it ... oops
       -- Added montgomery to the testing to make sure it handles 1..10 digit moduli correctly
       -- Fixed bug in comba that would lead to possible erroneous outputs when "pa < digs"
       -- Fixed bug in comba that would lead to possible erroneous outputs when "pa < digs" 
       -- Fixed bug in mp_toradix_size for "0" [Kevin Kenny]
       -- Updated chapters 1-5 of the textbook ;-) It now talks about the new comba code!

February 12th, 2005
v0.34  -- Fixed two more small errors in mp_prime_random_ex()
       -- Fixed overflow in mp_mul_d() [Kevin Kenny]
       -- Added mp_to_(un)signed_bin_n() functions which do bounds checking for ya [and report the size]
       -- Added "large" diminished radix support.  Speeds up things like DSA where the moduli is of the form 2^k - P for some P < 2^(k/2) or so
          Actually is faster than Montgomery on my AMD64 (and probably much faster on a P4)
       -- Updated the manual a bit
       -- Ok so I haven't done the textbook work yet... My current freelance gig has landed me in France till the
       -- Ok so I haven't done the textbook work yet... My current freelance gig has landed me in France till the 
          end of Feb/05.  Once I get back I'll have tons of free time and I plan to go to town on the book.
          As of this release the API will freeze.  At least until the book catches up with all the changes.  I welcome
          bug reports but new algorithms will have to wait.

December 23rd, 2004
v0.33  -- Fixed "small" variant for mp_div() which would munge with negative dividends...
       -- Fixed bug in mp_prime_random_ex() which would set the most significant byte to zero when
          no special flags were set
       -- Fixed overflow [minor] bug in fast_s_mp_sqr()
       -- Made the makefiles easier to configure the group/user that ltm will install as
       -- Fixed "final carry" bug in comba multipliers. (Volkan Ceylan)
       -- Matt Johnston pointed out a missing semi-colon in mp_exptmod

October 29th, 2004
v0.32  -- Added "makefile.shared" for shared object support
       -- Added more to the build options/configs in the manual
       -- Started the Depends framework, wrote dep.pl to scan deps and
       -- Started the Depends framework, wrote dep.pl to scan deps and 
          produce "callgraph.txt" ;-)
       -- Wrote SC_RSA_1 which will enable close to the minimum required to perform
          RSA on 32-bit [or 64-bit] platforms with LibTomCrypt
       -- Merged in the small/slower mp_div replacement.  You can now toggle which
          you want to use as your mp_div() at build time.  Saves roughly 8KB or so.
       -- Renamed a few files and changed some comments to make depends system work better.
          (No changes to function names)
       -- Merged in new Combas that perform 2 reads per inner loop instead of the older
       -- Merged in new Combas that perform 2 reads per inner loop instead of the older 
          3reads/2writes per inner loop of the old code.  Really though if you want speed
          learn to use TomsFastMath ;-)

August 9th, 2004
v0.31  -- "profiled" builds now :-) new timings for Intel Northwoods
       -- Added "pretty" build target
       -- Update mp_init() to actually assign 0's instead of relying on calloc()
203
204
205
206
207
208
209
210
211


212
213
214
215
216
217
218
109
110
111
112
113
114
115


116
117
118
119
120
121
122
123
124







-
-
+
+







          is only accurate to byte lengths).  See the new LTM_PRIME_* flags ;-)
       -- Alex Polushin contributed an optimized mp_sqrt() as well as mp_get_int() and mp_is_square().
          I've cleaned them all up to be a little more consistent [along with one bug fix] for this release.
       -- Added mp_init_set and mp_init_set_int to initialize and set small constants with one function
          call.
       -- Removed /etclib directory [um LibTomPoly deprecates this].
       -- Fixed mp_mod() so the sign of the result agrees with the sign of the modulus.
       ++ N.B.  My semester is almost up so expect updates to the textbook to be posted to the libtomcrypt.org
          website.
       ++ N.B.  My semester is almost up so expect updates to the textbook to be posted to the libtomcrypt.org 
          website.  

Jan 25th, 2004
v0.29  ++ Note: "Henrik" from the v0.28 changelog refers to Henrik Goldman ;-)
       -- Added fix to mp_shrink to prevent a realloc when used == 0 [e.g. realloc zero bytes???]
       -- Made the mp_prime_rabin_miller_trials() function internal table smaller and also
          set the minimum number of tests to two (sounds a bit safer).
       -- Added a mp_exteuclid() which computes the extended euclidean algorithm.

Deleted libtommath/helper.pl.

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
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
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


































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#!/usr/bin/env perl

use strict;
use warnings;

use Getopt::Long;
use File::Find 'find';
use File::Basename 'basename';
use File::Glob 'bsd_glob';

sub read_file {
  my $f = shift;
  open my $fh, "<", $f or die "FATAL: read_rawfile() cannot open file '$f': $!";
  binmode $fh;
  return do { local $/; <$fh> };
}

sub write_file {
  my ($f, $data) = @_;
  die "FATAL: write_file() no data" unless defined $data;
  open my $fh, ">", $f or die "FATAL: write_file() cannot open file '$f': $!";
  binmode $fh;
  print $fh $data or die "FATAL: write_file() cannot write to '$f': $!";
  close $fh or die "FATAL: write_file() cannot close '$f': $!";
  return;
}

sub sanitize_comments {
  my($content) = @_;
  $content =~ s{/\*(.*?)\*/}{my $x=$1; $x =~ s/\w/x/g; "/*$x*/";}egs;
  return $content;
}

sub check_source {
  my @all_files = (
        bsd_glob("makefile*"),
        bsd_glob("*.{h,c,sh,pl}"),
        bsd_glob("*/*.{h,c,sh,pl}"),
  );

  my $fails = 0;
  for my $file (sort @all_files) {
    my $troubles = {};
    my $lineno = 1;
    my $content = read_file($file);
    $content = sanitize_comments $content;
    push @{$troubles->{crlf_line_end}}, '?' if $content =~ /\r/;
    for my $l (split /\n/, $content) {
      push @{$troubles->{merge_conflict}},     $lineno if $l =~ /^(<<<<<<<|=======|>>>>>>>)([^<=>]|$)/;
      push @{$troubles->{trailing_space}},     $lineno if $l =~ / $/;
      push @{$troubles->{tab}},                $lineno if $l =~ /\t/ && basename($file) !~ /^makefile/i;
      push @{$troubles->{non_ascii_char}},     $lineno if $l =~ /[^[:ascii:]]/;
      push @{$troubles->{cpp_comment}},        $lineno if $file =~ /\.(c|h)$/ && ($l =~ /\s\/\// || $l =~ /\/\/\s/);
      # we prefer using MP_MALLOC, MP_FREE, MP_REALLOC, MP_CALLOC ...
      push @{$troubles->{unwanted_malloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmalloc\s*\(/;
      push @{$troubles->{unwanted_realloc}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\brealloc\s*\(/;
      push @{$troubles->{unwanted_calloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bcalloc\s*\(/;
      push @{$troubles->{unwanted_free}},      $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bfree\s*\(/;
      # and we probably want to also avoid the following
      push @{$troubles->{unwanted_memcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
      push @{$troubles->{unwanted_memset}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemset\s*\(/;
      push @{$troubles->{unwanted_memcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/;
      push @{$troubles->{unwanted_memmove}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemmove\s*\(/;
      push @{$troubles->{unwanted_memcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcmp\s*\(/;
      push @{$troubles->{unwanted_strcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcmp\s*\(/;
      push @{$troubles->{unwanted_strcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcpy\s*\(/;
      push @{$troubles->{unwanted_strncpy}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrncpy\s*\(/;
      push @{$troubles->{unwanted_clock}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bclock\s*\(/;
      push @{$troubles->{unwanted_qsort}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bqsort\s*\(/;
      push @{$troubles->{sizeof_no_brackets}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bsizeof\s*[^\(]/;
      if ($file =~ m|^[^\/]+\.c$| && $l =~ /^static(\s+[a-zA-Z0-9_]+)+\s+([a-zA-Z0-9_]+)\s*\(/) {
        my $funcname = $2;
        # static functions should start with s_
        push @{$troubles->{staticfunc_name}}, "$lineno($funcname)" if $funcname !~ /^s_/;
      }
      $lineno++;
    }
    for my $k (sort keys %$troubles) {
      warn "[$k] $file line:" . join(",", @{$troubles->{$k}}) . "\n";
      $fails++;
    }
  }

  warn( $fails > 0 ? "check-source:    FAIL $fails\n" : "check-source:    PASS\n" );
  return $fails;
}

sub check_comments {
  my $fails = 0;
  my $first_comment = <<'MARKER';
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
MARKER
  #my @all_files = (bsd_glob("*.{h,c}"), bsd_glob("*/*.{h,c}"));
  my @all_files = (bsd_glob("*.{h,c}"));
  for my $f (@all_files) {
    my $txt = read_file($f);
    if ($txt !~ /\Q$first_comment\E/s) {
      warn "[first_comment] $f\n";
      $fails++;
    }
  }
  warn( $fails > 0 ? "check-comments:  FAIL $fails\n" : "check-comments:  PASS\n" );
  return $fails;
}

sub check_doc {
  my $fails = 0;
  my $tex = read_file('doc/bn.tex');
  my $tmh = read_file('tommath.h');
  my @functions = $tmh =~ /\n\s*[a-zA-Z0-9_* ]+?(mp_[a-z0-9_]+)\s*\([^\)]+\)\s*;/sg;
  my @macros    = $tmh =~ /\n\s*#define\s+([a-z0-9_]+)\s*\([^\)]+\)/sg;
  for my $n (sort @functions) {
    (my $nn = $n) =~ s/_/\\_/g; # mp_sub_d >> mp\_sub\_d
    if ($tex !~ /index\Q{$nn}\E/) {
      warn "[missing_doc_for_function] $n\n";
      $fails++
    }
  }
  for my $n (sort @macros) {
    (my $nn = $n) =~ s/_/\\_/g; # mp_iszero >> mp\_iszero
    if ($tex !~ /index\Q{$nn}\E/) {
      warn "[missing_doc_for_macro] $n\n";
      $fails++
    }
  }
  warn( $fails > 0 ? "check_doc:       FAIL $fails\n" : "check-doc:       PASS\n" );
  return $fails;
}

sub prepare_variable {
  my ($varname, @list) = @_;
  my $output = "$varname=";
  my $len = length($output);
  foreach my $obj (sort @list) {
    $len = $len + length $obj;
    $obj =~ s/\*/\$/;
    if ($len > 100) {
      $output .= "\\\n";
      $len = length $obj;
    }
    $output .= $obj . ' ';
  }
  $output =~ s/ $//;
  return $output;
}

sub prepare_msvc_files_xml {
  my ($all, $exclude_re, $targets) = @_;
  my $last = [];
  my $depth = 2;

  # sort files in the same order as visual studio (ugly, I know)
  my @parts = ();
  for my $orig (@$all) {
    my $p = $orig;
    $p =~ s|/|/~|g;
    $p =~ s|/~([^/]+)$|/$1|g;
    my @l = map { sprintf "% -99s", $_ } split /\//, $p;
    push @parts, [ $orig, join(':', @l) ];
  }
  my @sorted = map { $_->[0] } sort { $a->[1] cmp $b->[1] } @parts;

  my $files = "<Files>\r\n";
  for my $full (@sorted) {
    my @items = split /\//, $full; # split by '/'
    $full =~ s|/|\\|g;             # replace '/' bt '\'
    shift @items; # drop first one (src)
    pop @items;   # drop last one (filename.ext)
    my $current = \@items;
    if (join(':', @$current) ne join(':', @$last)) {
      my $common = 0;
      $common++ while ($last->[$common] && $current->[$common] && $last->[$common] eq $current->[$common]);
      my $back = @$last - $common;
      if ($back > 0) {
        $files .= ("\t" x --$depth) . "</Filter>\r\n" for (1..$back);
      }
      my $fwd = [ @$current ]; splice(@$fwd, 0, $common);
      for my $i (0..scalar(@$fwd) - 1) {
        $files .= ("\t" x $depth) . "<Filter\r\n";
        $files .= ("\t" x $depth) . "\tName=\"$fwd->[$i]\"\r\n";
        $files .= ("\t" x $depth) . "\t>\r\n";
        $depth++;
      }
      $last = $current;
    }
    $files .= ("\t" x $depth) . "<File\r\n";
    $files .= ("\t" x $depth) . "\tRelativePath=\"$full\"\r\n";
    $files .= ("\t" x $depth) . "\t>\r\n";
    if ($full =~ $exclude_re) {
      for (@$targets) {
        $files .= ("\t" x $depth) . "\t<FileConfiguration\r\n";
        $files .= ("\t" x $depth) . "\t\tName=\"$_\"\r\n";
        $files .= ("\t" x $depth) . "\t\tExcludedFromBuild=\"true\"\r\n";
        $files .= ("\t" x $depth) . "\t\t>\r\n";
        $files .= ("\t" x $depth) . "\t\t<Tool\r\n";
        $files .= ("\t" x $depth) . "\t\t\tName=\"VCCLCompilerTool\"\r\n";
        $files .= ("\t" x $depth) . "\t\t\tAdditionalIncludeDirectories=\"\"\r\n";
        $files .= ("\t" x $depth) . "\t\t\tPreprocessorDefinitions=\"\"\r\n";
        $files .= ("\t" x $depth) . "\t\t/>\r\n";
        $files .= ("\t" x $depth) . "\t</FileConfiguration>\r\n";
      }
    }
    $files .= ("\t" x $depth) . "</File>\r\n";
  }
  $files .= ("\t" x --$depth) . "</Filter>\r\n" for (@$last);
  $files .= "\t</Files>";
  return $files;
}

sub patch_file {
  my ($content, @variables) = @_;
  for my $v (@variables) {
    if ($v =~ /^([A-Z0-9_]+)\s*=.*$/si) {
      my $name = $1;
      $content =~ s/\n\Q$name\E\b.*?[^\\]\n/\n$v\n/s;
    }
    else {
      die "patch_file failed: " . substr($v, 0, 30) . "..";
    }
  }
  return $content;
}

sub process_makefiles {
  my $write = shift;
  my $changed_count = 0;
  my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } bsd_glob("*.c");
  my @all = bsd_glob("*.{c,h}");

  my $var_o = prepare_variable("OBJECTS", @o);
  (my $var_obj = $var_o) =~ s/\.o\b/.obj/sg;

  # update MSVC project files
  my $msvc_files = prepare_msvc_files_xml(\@all, qr/NOT_USED_HERE/, ['Debug|Win32', 'Release|Win32', 'Debug|x64', 'Release|x64']);
  for my $m (qw/libtommath_VS2008.vcproj/) {
    my $old = read_file($m);
    my $new = $old;
    $new =~ s|<Files>.*</Files>|$msvc_files|s;
    if ($old ne $new) {
      write_file($m, $new) if $write;
      warn "changed: $m\n";
      $changed_count++;
    }
  }

  # update OBJECTS + HEADERS in makefile*
  for my $m (qw/ makefile makefile.shared makefile_include.mk makefile.msvc makefile.unix makefile.mingw /) {
    my $old = read_file($m);
    my $new = $m eq 'makefile.msvc' ? patch_file($old, $var_obj)
                                    : patch_file($old, $var_o);
    if ($old ne $new) {
      write_file($m, $new) if $write;
      warn "changed: $m\n";
      $changed_count++;
    }
  }

  if ($write) {
    return 0; # no failures
  }
  else {
    warn( $changed_count > 0 ? "check-makefiles: FAIL $changed_count\n" : "check-makefiles: PASS\n" );
    return $changed_count;
  }
}

sub draw_func
{
   my ($deplist, $depmap, $out, $indent, $funcslist) = @_;
   my @funcs = split ',', $funcslist;
   # try this if you want to have a look at a minimized version of the callgraph without all the trivial functions
   #if ($deplist =~ /$funcs[0]/ || $funcs[0] =~ /BN_MP_(ADD|SUB|CLEAR|CLEAR_\S+|DIV|MUL|COPY|ZERO|GROW|CLAMP|INIT|INIT_\S+|SET|ABS|CMP|CMP_D|EXCH)_C/) {
   if ($deplist =~ /$funcs[0]/) {
      return $deplist;
   } else {
      $deplist = $deplist . $funcs[0];
   }
   if ($indent == 0) {
   } elsif ($indent >= 1) {
      print {$out} '|   ' x ($indent - 1) . '+--->';
   }
   print {$out} $funcs[0] . "\n";
   shift @funcs;
   my $olddeplist = $deplist;
   foreach my $i (@funcs) {
      $deplist = draw_func($deplist, $depmap, $out, $indent + 1, ${$depmap}{$i}) if exists ${$depmap}{$i};
   }
   return $olddeplist;
}

sub update_dep
{
    #open class file and write preamble
    open(my $class, '>', 'tommath_class.h') or die "Couldn't open tommath_class.h for writing\n";
    print {$class} << 'EOS';
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#if !(defined(LTM1) && defined(LTM2) && defined(LTM3))
#define LTM_INSIDE
#if defined(LTM2)
#   define LTM3
#endif
#if defined(LTM1)
#   define LTM2
#endif
#define LTM1
#if defined(LTM_ALL)
EOS

    foreach my $filename (glob 'bn*.c') {
        my $define = $filename;

        print "Processing $filename\n";

        # convert filename to upper case so we can use it as a define
        $define =~ tr/[a-z]/[A-Z]/;
        $define =~ tr/\./_/;
        print {$class} "#   define $define\n";

        # now copy text and apply #ifdef as required
        my $apply = 0;
        open(my $src, '<', $filename);
        open(my $out, '>', 'tmp');

        # first line will be the #ifdef
        my $line = <$src>;
        if ($line =~ /include/) {
            print {$out} $line;
        } else {
            print {$out} << "EOS";
#include "tommath_private.h"
#ifdef $define
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
$line
EOS
            $apply = 1;
        }
        while (<$src>) {
            if ($_ !~ /tommath\.h/) {
                print {$out} $_;
            }
        }
        if ($apply == 1) {
            print {$out} "#endif\n";
        }
        close $src;
        close $out;

        unlink $filename;
        rename 'tmp', $filename;
    }
    print {$class} "#endif\n#endif\n";

    # now do classes
    my %depmap;
    foreach my $filename (glob 'bn*.c') {
        my $content;
        if ($filename =~ "bn_deprecated.c") {
            open(my $src, '<', $filename) or die "Can't open source file!\n";
            read $src, $content, -s $src;
            close $src;
        } else {
            my $cc = $ENV{'CC'} || 'gcc';
            $content = `$cc -E -x c -DLTM_ALL $filename`;
            $content =~ s/^# 1 "$filename".*?^# 2 "$filename"//ms;
        }

        # convert filename to upper case so we can use it as a define
        $filename =~ tr/[a-z]/[A-Z]/;
        $filename =~ tr/\./_/;

        print {$class} "#if defined($filename)\n";
        my $list = $filename;

        # strip comments
        $content =~ s{/\*.*?\*/}{}gs;

        # scan for mp_* and make classes
        my @deps = ();
        foreach my $line (split /\n/, $content) {
            while ($line =~ /(fast_)?(s_)?mp\_[a-z_0-9]*((?=\;)|(?=\())|(?<=\()mp\_[a-z_0-9]*(?=\()/g) {
                my $a = $&;
                next if $a eq "mp_err";
                $a =~ tr/[a-z]/[A-Z]/;
                $a = 'BN_' . $a . '_C';
                push @deps, $a;
            }
        }
        @deps = sort(@deps);
        foreach my $a (@deps) {
            if ($list !~ /$a/) {
                print {$class} "#   define $a\n";
            }
            $list = $list . ',' . $a;
        }
        $depmap{$filename} = $list;

        print {$class} "#endif\n\n";
    }

    print {$class} << 'EOS';
#ifdef LTM_INSIDE
#undef LTM_INSIDE
#ifdef LTM3
#   define LTM_LAST
#endif

#include "tommath_superclass.h"
#include "tommath_class.h"
#else
#   define LTM_LAST
#endif
EOS
    close $class;

    #now let's make a cool call graph...

    open(my $out, '>', 'callgraph.txt');
    foreach (sort keys %depmap) {
        draw_func("", \%depmap, $out, 0, $depmap{$_});
        print {$out} "\n\n";
    }
    close $out;

    return 0;
}

sub generate_def {
    my @files = split /\n/, `git ls-files`;
    @files = grep(/\.c/, @files);
    @files = map { my $x = $_; $x =~ s/^bn_|\.c$//g; $x; } @files;
    @files = grep(!/mp_radix_smap/, @files);

    push(@files, qw(mp_set_int mp_set_long mp_set_long_long mp_get_int mp_get_long mp_get_long_long mp_init_set_int));

    my $files = join("\n    ", sort(grep(/^mp_/, @files)));
    write_file "tommath.def", "; libtommath
;
; Use this command to produce a 32-bit .lib file, for use in any MSVC version
;   lib -machine:X86 -name:libtommath.dll -def:tommath.def -out:tommath.lib
; Use this command to produce a 64-bit .lib file, for use in any MSVC version
;   lib -machine:X64 -name:libtommath.dll -def:tommath.def -out:tommath.lib
;
EXPORTS
    $files
";
    return 0;
}

sub die_usage {
  die <<"MARKER";
usage: $0 -s   OR   $0 --check-source
       $0 -o   OR   $0 --check-comments
       $0 -m   OR   $0 --check-makefiles
       $0 -a   OR   $0 --check-all
       $0 -u   OR   $0 --update-files
MARKER
}

GetOptions( "s|check-source"        => \my $check_source,
            "o|check-comments"      => \my $check_comments,
            "m|check-makefiles"     => \my $check_makefiles,
            "d|check-doc"           => \my $check_doc,
            "a|check-all"           => \my $check_all,
            "u|update-files"        => \my $update_files,
            "h|help"                => \my $help
          ) or die_usage;

my $failure;
$failure ||= check_source()       if $check_all || $check_source;
$failure ||= check_comments()     if $check_all || $check_comments;
$failure ||= check_doc()          if $check_doc; # temporarily excluded from --check-all
$failure ||= process_makefiles(0) if $check_all || $check_makefiles;
$failure ||= process_makefiles(1) if $update_files;
$failure ||= update_dep()         if $update_files;
$failure ||= generate_def()       if $update_files;

die_usage unless defined $failure;
exit $failure ? 1 : 0;

Deleted libtommath/libtommath.pc.in.

1
2
3
4
5
6
7
8
9
10










-
-
-
-
-
-
-
-
-
-
prefix=@to-be-replaced@
exec_prefix=${prefix}
libdir=${exec_prefix}/lib
includedir=${prefix}/include

Name: LibTomMath
Description: public domain library for manipulating large integer numbers
Version: @to-be-replaced@
Libs: -L${libdir} -ltommath
Cflags: -I${includedir}

Deleted libtommath/libtommath_VS2008.sln.

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





























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

Microsoft Visual Studio Solution File, Format Version 10.00
# Visual Studio 2008
Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "tommath", "libtommath_VS2008.vcproj", "{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}"
EndProject
Global
	GlobalSection(SolutionConfigurationPlatforms) = preSolution
		Debug|Win32 = Debug|Win32
		Debug|x64 = Debug|x64
		Release|Win32 = Release|Win32
		Release|x64 = Release|x64
	EndGlobalSection
	GlobalSection(ProjectConfigurationPlatforms) = postSolution
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|Win32.ActiveCfg = Debug|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|Win32.Build.0 = Debug|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|x64.ActiveCfg = Debug|x64
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Debug|x64.Build.0 = Debug|x64
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|Win32.ActiveCfg = Release|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|Win32.Build.0 = Release|Win32
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|x64.ActiveCfg = Release|x64
		{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}.Release|x64.Build.0 = Release|x64
	EndGlobalSection
	GlobalSection(SolutionProperties) = preSolution
		HideSolutionNode = FALSE
	EndGlobalSection
	GlobalSection(ExtensibilityGlobals) = postSolution
		SolutionGuid = {83B84178-7B4F-4B78-9C5D-17B8201D5B61}
	EndGlobalSection
EndGlobal

Deleted libtommath/libtommath_VS2008.vcproj.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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






































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="Windows-1252"?>
<VisualStudioProject
	ProjectType="Visual C++"
	Version="9.00"
	Name="tommath"
	ProjectGUID="{42109FEE-B0B9-4FCD-9E56-2863BF8C55D2}"
	RootNamespace="tommath"
	TargetFrameworkVersion="0"
	>
	<Platforms>
		<Platform
			Name="Win32"
		/>
		<Platform
			Name="x64"
		/>
	</Platforms>
	<ToolFiles>
	</ToolFiles>
	<Configurations>
		<Configuration
			Name="Debug|Win32"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;_DEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				MinimalRebuild="true"
				ExceptionHandling="0"
				BasicRuntimeChecks="3"
				RuntimeLibrary="1"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
				DebugInformationFormat="4"
				CompileAs="1"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="_DEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Debug|x64"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="0"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;_DEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				MinimalRebuild="true"
				ExceptionHandling="0"
				BasicRuntimeChecks="3"
				RuntimeLibrary="1"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
				DebugInformationFormat="3"
				CompileAs="1"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="_DEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|Win32"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;NDEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				StringPooling="true"
				RuntimeLibrary="0"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
		<Configuration
			Name="Release|x64"
			OutputDirectory="MSVC_$(PlatformName)_$(ConfigurationName)"
			IntermediateDirectory="MSVC_$(PlatformName)_$(ConfigurationName)\Intermediate"
			ConfigurationType="4"
			UseOfMFC="0"
			ATLMinimizesCRunTimeLibraryUsage="false"
			CharacterSet="0"
			>
			<Tool
				Name="VCPreBuildEventTool"
			/>
			<Tool
				Name="VCCustomBuildTool"
			/>
			<Tool
				Name="VCXMLDataGeneratorTool"
			/>
			<Tool
				Name="VCMIDLTool"
				TargetEnvironment="3"
			/>
			<Tool
				Name="VCCLCompilerTool"
				Optimization="2"
				InlineFunctionExpansion="1"
				AdditionalIncludeDirectories="."
				PreprocessorDefinitions="WIN32;NDEBUG;_CRT_SECURE_NO_WARNINGS;_CRT_NONSTDC_NO_DEPRECATE"
				StringPooling="true"
				RuntimeLibrary="0"
				EnableFunctionLevelLinking="true"
				PrecompiledHeaderFile="$(IntDir)\libtomcrypt.pch"
				AssemblerListingLocation="$(IntDir)\"
				ObjectFile="$(IntDir)\"
				ProgramDataBaseFileName="$(IntDir)\"
				WarningLevel="3"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCManagedResourceCompilerTool"
			/>
			<Tool
				Name="VCResourceCompilerTool"
				PreprocessorDefinitions="NDEBUG"
				Culture="1033"
			/>
			<Tool
				Name="VCPreLinkEventTool"
			/>
			<Tool
				Name="VCLibrarianTool"
				OutputFile="$(OutDir)\tommath.lib"
				SuppressStartupBanner="true"
			/>
			<Tool
				Name="VCALinkTool"
			/>
			<Tool
				Name="VCXDCMakeTool"
			/>
			<Tool
				Name="VCBscMakeTool"
				SuppressStartupBanner="true"
				OutputFile="$(OutDir)\tommath.bsc"
			/>
			<Tool
				Name="VCFxCopTool"
			/>
			<Tool
				Name="VCPostBuildEventTool"
			/>
		</Configuration>
	</Configurations>
	<References>
	</References>
	<Files>
		<File
			RelativePath="bn_cutoffs.c"
			>
		</File>
		<File
			RelativePath="bn_deprecated.c"
			>
		</File>
		<File
			RelativePath="bn_mp_2expt.c"
			>
		</File>
		<File
			RelativePath="bn_mp_abs.c"
			>
		</File>
		<File
			RelativePath="bn_mp_add.c"
			>
		</File>
		<File
			RelativePath="bn_mp_add_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_addmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_and.c"
			>
		</File>
		<File
			RelativePath="bn_mp_clamp.c"
			>
		</File>
		<File
			RelativePath="bn_mp_clear.c"
			>
		</File>
		<File
			RelativePath="bn_mp_clear_multi.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cmp.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cmp_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cmp_mag.c"
			>
		</File>
		<File
			RelativePath="bn_mp_cnt_lsb.c"
			>
		</File>
		<File
			RelativePath="bn_mp_complement.c"
			>
		</File>
		<File
			RelativePath="bn_mp_copy.c"
			>
		</File>
		<File
			RelativePath="bn_mp_count_bits.c"
			>
		</File>
		<File
			RelativePath="bn_mp_decr.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div_2.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div_2d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div_3.c"
			>
		</File>
		<File
			RelativePath="bn_mp_div_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_dr_is_modulus.c"
			>
		</File>
		<File
			RelativePath="bn_mp_dr_reduce.c"
			>
		</File>
		<File
			RelativePath="bn_mp_dr_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_error_to_string.c"
			>
		</File>
		<File
			RelativePath="bn_mp_exch.c"
			>
		</File>
		<File
			RelativePath="bn_mp_expt_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_exptmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_exteuclid.c"
			>
		</File>
		<File
			RelativePath="bn_mp_fread.c"
			>
		</File>
		<File
			RelativePath="bn_mp_from_sbin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_from_ubin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_fwrite.c"
			>
		</File>
		<File
			RelativePath="bn_mp_gcd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_double.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_i32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_i64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_ll.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_mag_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_mag_u64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_mag_ul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_get_mag_ull.c"
			>
		</File>
		<File
			RelativePath="bn_mp_grow.c"
			>
		</File>
		<File
			RelativePath="bn_mp_incr.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_copy.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_i32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_i64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_ll.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_multi.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_set.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_u64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_ul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_init_ull.c"
			>
		</File>
		<File
			RelativePath="bn_mp_invmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_is_square.c"
			>
		</File>
		<File
			RelativePath="bn_mp_iseven.c"
			>
		</File>
		<File
			RelativePath="bn_mp_isodd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_kronecker.c"
			>
		</File>
		<File
			RelativePath="bn_mp_lcm.c"
			>
		</File>
		<File
			RelativePath="bn_mp_log_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_lshd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mod_2d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mod_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_montgomery_calc_normalization.c"
			>
		</File>
		<File
			RelativePath="bn_mp_montgomery_reduce.c"
			>
		</File>
		<File
			RelativePath="bn_mp_montgomery_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul_2.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul_2d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mul_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_mulmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_neg.c"
			>
		</File>
		<File
			RelativePath="bn_mp_or.c"
			>
		</File>
		<File
			RelativePath="bn_mp_pack.c"
			>
		</File>
		<File
			RelativePath="bn_mp_pack_count.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_fermat.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_frobenius_underwood.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_is_prime.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_miller_rabin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_next_prime.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_rabin_miller_trials.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_rand.c"
			>
		</File>
		<File
			RelativePath="bn_mp_prime_strong_lucas_selfridge.c"
			>
		</File>
		<File
			RelativePath="bn_mp_radix_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_radix_smap.c"
			>
		</File>
		<File
			RelativePath="bn_mp_rand.c"
			>
		</File>
		<File
			RelativePath="bn_mp_read_radix.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_2k_setup_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_is_2k.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_is_2k_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_reduce_setup.c"
			>
		</File>
		<File
			RelativePath="bn_mp_root_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_rshd.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sbin_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_double.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_i32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_i64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_l.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_ll.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_u32.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_u64.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_ul.c"
			>
		</File>
		<File
			RelativePath="bn_mp_set_ull.c"
			>
		</File>
		<File
			RelativePath="bn_mp_shrink.c"
			>
		</File>
		<File
			RelativePath="bn_mp_signed_rsh.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqr.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqrmod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqrt.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sqrtmod_prime.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sub.c"
			>
		</File>
		<File
			RelativePath="bn_mp_sub_d.c"
			>
		</File>
		<File
			RelativePath="bn_mp_submod.c"
			>
		</File>
		<File
			RelativePath="bn_mp_to_radix.c"
			>
		</File>
		<File
			RelativePath="bn_mp_to_sbin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_to_ubin.c"
			>
		</File>
		<File
			RelativePath="bn_mp_ubin_size.c"
			>
		</File>
		<File
			RelativePath="bn_mp_unpack.c"
			>
		</File>
		<File
			RelativePath="bn_mp_xor.c"
			>
		</File>
		<File
			RelativePath="bn_mp_zero.c"
			>
		</File>
		<File
			RelativePath="bn_prime_tab.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_add.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_balance_mul.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_exptmod.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_exptmod_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_get_bit.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_invmod_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_invmod_slow.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_karatsuba_mul.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_karatsuba_sqr.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_montgomery_reduce_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_digs.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_digs_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_high_digs.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_mul_high_digs_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_prime_is_divisible.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_rand_jenkins.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_rand_platform.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_reverse.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_sqr.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_sqr_fast.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_sub.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_toom_mul.c"
			>
		</File>
		<File
			RelativePath="bn_s_mp_toom_sqr.c"
			>
		</File>
		<File
			RelativePath="tommath.h"
			>
		</File>
		<File
			RelativePath="tommath_class.h"
			>
		</File>
		<File
			RelativePath="tommath_cutoffs.h"
			>
		</File>
		<File
			RelativePath="tommath_private.h"
			>
		</File>
		<File
			RelativePath="tommath_superclass.h"
			>
		</File>
	</Files>
	<Globals>
	</Globals>
</VisualStudioProject>

Changes to libtommath/makefile.

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







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




+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+
+
+
+
+
+







-
-
+
-

-
+
-
-
-
-

-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
+
-



-
+





-
+



-
-
+
+


-
+


-
-
-
-
-
+
+
+
+
+

-
+


-
-
-
-
+
+
+
+

-
-
+
-
-
-
+
+
+
-
-
+
-
-
+
-
-
+
-
-
-
+
-

+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-

-
-
-
-
+
+
+
+

+
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
+
+

+
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
#Makefile for GCC
#
#Tom St Denis

#version of library 
VERSION=0.42.0
ifeq ($V,1)
silent=

CFLAGS  +=  -I./ -Wall -W -Wshadow -Wsign-compare

ifndef MAKE
   MAKE=make
endif

ifndef IGNORE_SPEED

#for speed 
CFLAGS += -O3 -funroll-loops

#for size 
#CFLAGS += -Os

#x86 optimizations [should be valid for any GCC install though]
CFLAGS  += -fomit-frame-pointer

#debug
#CFLAGS += -g3

endif

#install as this user
ifndef INSTALL_GROUP
   GROUP=wheel
else
   GROUP=$(INSTALL_GROUP)
silent=@
endif

ifndef INSTALL_USER
   USER=root
else
   USER=$(INSTALL_USER)
endif

#default files to install
ifndef LIBNAME
   LIBNAME=libtommath.a
endif

coverage: LIBNAME:=-Wl,--whole-archive $(LIBNAME)  -Wl,--no-whole-archive

default: ${LIBNAME}
include makefile_include.mk

%.o: %.c $(HEADERS)
HEADERS=tommath.h tommath_class.h tommath_superclass.h
ifneq ($V,1)
	@echo "   * ${CC} $@"
endif
	${silent} ${CC} -c ${LTM_CFLAGS} $< -o $@

LCOV_ARGS=--directory .

#START_INS
#LIBPATH-The directory for libtommath to be installed to.
#INCPATH-The directory to install the header files for libtommath.
#DATAPATH-The directory to install the pdf docs.
DESTDIR=
OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \
bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \
bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \
bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \
bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \
bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \
bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \
bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \
bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \
bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \
bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \
LIBPATH=/usr/lib
INCPATH=/usr/include
DATAPATH=/usr/share/doc/libtommath/pdf

OBJECTS=bncore.o bn_mp_init.o bn_mp_clear.o bn_mp_exch.o bn_mp_grow.o bn_mp_shrink.o \
bn_mp_clamp.o bn_mp_zero.o  bn_mp_set.o bn_mp_set_int.o bn_mp_init_size.o bn_mp_copy.o \
bn_mp_init_copy.o bn_mp_abs.o bn_mp_neg.o bn_mp_cmp_mag.o bn_mp_cmp.o bn_mp_cmp_d.o \
bn_mp_rshd.o bn_mp_lshd.o bn_mp_mod_2d.o bn_mp_div_2d.o bn_mp_mul_2d.o bn_mp_div_2.o \
bn_mp_mul_2.o bn_s_mp_add.o bn_s_mp_sub.o bn_fast_s_mp_mul_digs.o bn_s_mp_mul_digs.o \
bn_fast_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_s_mp_sqr.o \
bn_mp_add.o bn_mp_sub.o bn_mp_karatsuba_mul.o bn_mp_mul.o bn_mp_karatsuba_sqr.o \
bn_mp_sqr.o bn_mp_div.o bn_mp_mod.o bn_mp_add_d.o bn_mp_sub_d.o bn_mp_mul_d.o \
bn_mp_div_d.o bn_mp_mod_d.o bn_mp_expt_d.o bn_mp_addmod.o bn_mp_submod.o \
bn_mp_mulmod.o bn_mp_sqrmod.o bn_mp_gcd.o bn_mp_lcm.o bn_fast_mp_invmod.o bn_mp_invmod.o \
bn_mp_reduce.o bn_mp_montgomery_setup.o bn_fast_mp_montgomery_reduce.o bn_mp_montgomery_reduce.o \
bn_mp_exptmod_fast.o bn_mp_exptmod.o bn_mp_2expt.o bn_mp_n_root.o bn_mp_jacobi.o bn_reverse.o \
bn_mp_count_bits.o bn_mp_read_unsigned_bin.o bn_mp_read_signed_bin.o bn_mp_to_unsigned_bin.o \
bn_mp_to_signed_bin.o bn_mp_unsigned_bin_size.o bn_mp_signed_bin_size.o  \
bn_mp_xor.o bn_mp_and.o bn_mp_or.o bn_mp_rand.o bn_mp_montgomery_calc_normalization.o \
bn_mp_prime_is_divisible.o bn_prime_tab.o bn_mp_prime_fermat.o bn_mp_prime_miller_rabin.o \
bn_mp_prime_is_prime.o bn_mp_prime_next_prime.o bn_mp_dr_reduce.o \
bn_mp_dr_is_modulus.o bn_mp_dr_setup.o bn_mp_reduce_setup.o \
bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_div_3.o bn_s_mp_exptmod.o \
bn_mp_reduce_2k.o bn_mp_reduce_is_2k.o bn_mp_reduce_2k_setup.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_2k_setup_l.o \
bn_mp_radix_smap.o bn_mp_read_radix.o bn_mp_toradix.o bn_mp_radix_size.o \
bn_mp_fread.o bn_mp_fwrite.o bn_mp_cnt_lsb.o bn_error.o \
bn_mp_init_multi.o bn_mp_clear_multi.o bn_mp_exteuclid.o bn_mp_toradix_n.o \
bn_mp_prime_random_ex.o bn_mp_get_int.o bn_mp_sqrt.o bn_mp_is_square.o bn_mp_init_set.o \
bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \
bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \
bn_mp_init_set_int.o bn_mp_invmod_slow.o bn_mp_prime_rabin_miller_trials.o \
bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \
bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \
bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \
bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin_n.o
#END_INS

$(LIBNAME):  $(OBJECTS)
	$(AR) $(ARFLAGS) $@ $(OBJECTS)
	$(RANLIB) $@
	ranlib $@

#make a profiled library (takes a while!!!)
#
# This will build the library with profile generation
# then run the test demo and rebuild the library.
#
# 
# So far I've seen improvements in the MP math
profiled:
	make CFLAGS="$(CFLAGS) -fprofile-arcs -DTESTING" timing
	./timing
	rm -f *.a *.o timing
	./ltmtest
	rm -f *.a *.o ltmtest
	make CFLAGS="$(CFLAGS) -fbranch-probabilities"

#make a single object profiled library
#make a single object profiled library 
profiled_single:
	perl gen.pl
	$(CC) $(LTM_CFLAGS) -fprofile-arcs -DTESTING -c mpi.c -o mpi.o
	$(CC) $(LTM_CFLAGS) -DTESTING -DTIMER demo/timing.c mpi.o -lgcov -o timing
	./timing
	rm -f *.o timing
	$(CC) $(LTM_CFLAGS) -fbranch-probabilities -DTESTING -c mpi.c -o mpi.o
	$(CC) $(CFLAGS) -fprofile-arcs -DTESTING -c mpi.c -o mpi.o
	$(CC) $(CFLAGS) -DTESTING -DTIMER demo/timing.c mpi.o -o ltmtest
	./ltmtest
	rm -f *.o ltmtest
	$(CC) $(CFLAGS) -fbranch-probabilities -DTESTING -c mpi.c -o mpi.o
	$(AR) $(ARFLAGS) $(LIBNAME) mpi.o
	ranlib $(LIBNAME)
	ranlib $(LIBNAME)	

install: $(LIBNAME)
	install -d $(DESTDIR)$(LIBPATH)
	install -d $(DESTDIR)$(INCPATH)
	install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)
	install -m 644 $(HEADERS_PUB) $(DESTDIR)$(INCPATH)
	install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(LIBPATH)
	install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(INCPATH)
	install -g $(GROUP) -o $(USER) $(LIBNAME) $(DESTDIR)$(LIBPATH)
	install -g $(GROUP) -o $(USER) $(HEADERS) $(DESTDIR)$(INCPATH)

uninstall:
	rm $(DESTDIR)$(LIBPATH)/$(LIBNAME)
test: $(LIBNAME) demo/demo.o
	rm $(HEADERS_PUB:%=$(DESTDIR)$(INCPATH)/%)

test_standalone: test
	$(CC) $(CFLAGS) demo/demo.o $(LIBNAME) -o test
	
mtest: test	
	@echo "test_standalone is deprecated, please use make-target 'test'"

	cd mtest ; $(CC) $(CFLAGS) mtest.c -o mtest
DEMOS=test mtest_opponent

        
define DEMO_template
$(1): demo/$(1).o demo/shared.o $$(LIBNAME)
timing: $(LIBNAME)
	$$(CC) $$(LTM_CFLAGS) $$(LTM_LFLAGS) $$^ -o $$@
endef

	$(CC) $(CFLAGS) -DTIMER demo/timing.c $(LIBNAME) -o ltmtest
$(foreach demo, $(strip $(DEMOS)), $(eval $(call DEMO_template,$(demo))))

# makes the LTM book DVI file, requires tetex, perl and makeindex [part of tetex I think]
.PHONY: mtest
mtest:
	cd mtest ; $(CC) $(LTM_CFLAGS) -O0 mtest.c $(LTM_LFLAGS) -o mtest

timing: $(LIBNAME) demo/timing.c
	$(CC) $(LTM_CFLAGS) -DTIMER demo/timing.c $(LIBNAME) $(LTM_LFLAGS) -o timing

tune: $(LIBNAME)
docdvi: tommath.src
	cd pics ; MAKE=${MAKE} ${MAKE} 
	echo "hello" > tommath.ind
	perl booker.pl
	latex tommath > /dev/null
	latex tommath > /dev/null
	makeindex tommath
	latex tommath > /dev/null
	$(MAKE) -C etc tune CFLAGS="$(LTM_CFLAGS)"
	$(MAKE)

# You have to create a file .coveralls.yml with the content "repo_token: <the token>"
# in the base folder to be able to submit to coveralls
coveralls: lcov
	coveralls-lcov
# poster, makes the single page PDF poster
poster: poster.tex
	pdflatex poster
	rm -f poster.aux poster.log 

# makes the LTM book PDF file, requires tetex, cleans up the LaTeX temp files
docs manual:
docs:   docdvi
	dvipdf tommath
	rm -f tommath.log tommath.aux tommath.dvi tommath.idx tommath.toc tommath.lof tommath.ind tommath.ilg
	cd pics ; MAKE=${MAKE} ${MAKE} clean
	$(MAKE) -C doc/ $@ V=$(V)

.PHONY: pre_gen
pre_gen:
	mkdir -p pre_gen
	perl gen.pl
	sed -e 's/[[:blank:]]*$$//' mpi.c > pre_gen/mpi.c
	rm mpi.c
	
#LTM user manual
mandvi: bn.tex
	echo "hello" > bn.ind
	latex bn > /dev/null
	latex bn > /dev/null
	makeindex bn
	latex bn > /dev/null

zipup: clean astyle new_file docs
	@# Update the index, so diff-index won't fail in case the pdf has been created.
	@#   As the pdf creation modifies the tex files, git sometimes detects the
	@#   modified files, but misses that it's put back to its original version.
	@git update-index --refresh
#LTM user manual [pdf]
manual:	mandvi
	pdflatex bn >/dev/null
	rm -f bn.aux bn.dvi bn.log bn.idx bn.lof bn.out bn.toc

pretty: 
	@git diff-index --quiet HEAD -- || ( echo "FAILURE: uncommited changes or not a git" && exit 1 )
	rm -rf libtommath-$(VERSION) ltm-$(VERSION).*
	perl pretty.build
	@# files/dirs excluded from "git archive" are defined in .gitattributes
	git archive --format=tar --prefix=libtommath-$(VERSION)/ HEAD | tar x
	@echo 'fixme check'
	-@(find libtommath-$(VERSION)/ -type f | xargs grep 'FIXM[E]') && echo '############## BEWARE: the "fixme" marker was found !!! ##############' || true
	mkdir -p libtommath-$(VERSION)/doc
	cp doc/bn.pdf libtommath-$(VERSION)/doc/
	$(MAKE) -C libtommath-$(VERSION)/ pre_gen

clean:
	rm -f *.bat *.pdf *.o *.a *.obj *.lib *.exe *.dll etclib/*.o demo/demo.o test ltmtest mpitest mtest/mtest mtest/mtest.exe \
        *.idx *.toc *.log *.aux *.dvi *.lof *.ind *.ilg *.ps *.log *.s mpi.c *.da *.dyn *.dpi tommath.tex `find . -type f | grep [~] | xargs` *.lo *.la
	tar -c libtommath-$(VERSION)/ | xz -6e -c - > ltm-$(VERSION).tar.xz
	zip -9rq ltm-$(VERSION).zip libtommath-$(VERSION)
	cp doc/bn.pdf bn-$(VERSION).pdf
	rm -rf libtommath-$(VERSION)
	rm -rf .libs
	gpg -b -a ltm-$(VERSION).tar.xz
	gpg -b -a ltm-$(VERSION).zip
	cd etc ; MAKE=${MAKE} ${MAKE} clean
	cd pics ; MAKE=${MAKE} ${MAKE} clean

#zipup the project (take that!)
new_file:
	perl helper.pl --update-files
no_oops: clean
	cd .. ; cvs commit 
	echo Scanning for scratch/dirty files
	find . -type f | grep -v CVS | xargs -n 1 bash mess.sh

perlcritic:
	perlcritic *.pl doc/*.pl

astyle:
	@echo "   * run astyle on all sources"
	@astyle --options=astylerc --formatted $(OBJECTS:.o=.c) tommath*.h demo/*.c etc/*.c mtest/mtest.c
zipup: clean manual poster docs
	perl gen.pl ; mv mpi.c pre_gen/ ; \
	cd .. ; rm -rf ltm* libtommath-$(VERSION) ; mkdir libtommath-$(VERSION) ; \
	cp -R ./libtommath/* ./libtommath-$(VERSION)/ ; \
	tar -c libtommath-$(VERSION)/* | bzip2 -9vvc > ltm-$(VERSION).tar.bz2 ; \
	zip -9 -r ltm-$(VERSION).zip libtommath-$(VERSION)/* ; \
	mv -f ltm* ~ ; rm -rf libtommath-$(VERSION)

Deleted libtommath/makefile.mingw.

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













































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# MAKEFILE for MS Windows (mingw + gcc + gmake)
#
# BEWARE: variable OBJECTS is updated via helper.pl

### USAGE:
# Open a command prompt with gcc + gmake in PATH and start:
#
# gmake -f makefile.mingw all
# test.exe
# gmake -f makefile.mingw PREFIX=c:\devel\libtom install

#The following can be overridden from command line e.g. make -f makefile.mingw CC=gcc ARFLAGS=rcs
PREFIX    = c:\mingw
CC        = gcc
AR        = ar
ARFLAGS   = r
RANLIB    = ranlib
STRIP     = strip
CFLAGS    = -O2
LDFLAGS   =

#Compilation flags
LTM_CFLAGS  = -I. $(CFLAGS)
LTM_LDFLAGS = $(LDFLAGS) -static-libgcc

#Libraries to be created
LIBMAIN_S =libtommath.a
LIBMAIN_I =libtommath.dll.a
LIBMAIN_D =libtommath.dll

#List of objects to compile (all goes to libtommath.a)
OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \
bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \
bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \
bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \
bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \
bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \
bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \
bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \
bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \
bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \
bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \
bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \
bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \
bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \
bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \
bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \
bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

#The default rule for make builds the libtommath.a library (static)
default: $(LIBMAIN_S)

#Dependencies on *.h
$(OBJECTS): $(HEADERS)

.c.o:
	$(CC) $(LTM_CFLAGS) -c $< -o $@

#Create libtommath.a
$(LIBMAIN_S): $(OBJECTS)
	$(AR) $(ARFLAGS) $@ $(OBJECTS)
	$(RANLIB) $@

#Create DLL + import library libtommath.dll.a
$(LIBMAIN_D) $(LIBMAIN_I): $(OBJECTS)
	$(CC) -s -shared -o $(LIBMAIN_D) $^ -Wl,--enable-auto-import,--export-all -Wl,--out-implib=$(LIBMAIN_I) $(LTM_LDFLAGS)
	$(STRIP) -S $(LIBMAIN_D)

#Build test suite
test.exe: demo/shared.o demo/test.o $(LIBMAIN_S)
	$(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) $^ -o $@
	@echo NOTICE: start the tests by launching test.exe

test_standalone: test.exe
	@echo test_standalone is deprecated, please use make-target 'test.exe'

all: $(LIBMAIN_S) test.exe

tune: $(LIBNAME_S)
	$(MAKE) -C etc tune
	$(MAKE)

clean:
	@-cmd /c del /Q /S *.o *.a *.exe *.dll 2>nul

#Install the library + headers
install: $(LIBMAIN_S) $(LIBMAIN_I) $(LIBMAIN_D)
	cmd /c if not exist "$(PREFIX)\bin" mkdir "$(PREFIX)\bin"
	cmd /c if not exist "$(PREFIX)\lib" mkdir "$(PREFIX)\lib"
	cmd /c if not exist "$(PREFIX)\include" mkdir "$(PREFIX)\include"
	copy /Y $(LIBMAIN_S) "$(PREFIX)\lib"
	copy /Y $(LIBMAIN_I) "$(PREFIX)\lib"
	copy /Y $(LIBMAIN_D) "$(PREFIX)\bin"
	copy /Y tommath*.h "$(PREFIX)\include"

Changes to libtommath/makefile.msvc.

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


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
-
+

-
-
+
-
-
-
+
-
-
-
-
+
-
-
-

-
-
-
+

-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-
+
-
-
-
+
-

-
-
-
-
+
-
-

-
+
-
-
-
-
-
-
+
# MAKEFILE for MS Windows (nmake + Windows SDK)
#MSVC Makefile
#
# BEWARE: variable OBJECTS is updated via helper.pl

#Tom St Denis
### USAGE:
# Open a command prompt with WinSDK variables set and start:
#

# nmake -f makefile.msvc all
# test.exe
# nmake -f makefile.msvc PREFIX=c:\devel\libtom install

CFLAGS = /I. /Ox /DWIN32 /W3 /Fo$@
#The following can be overridden from command line e.g. make -f makefile.msvc CC=gcc ARFLAGS=rcs
PREFIX    = c:\devel
CFLAGS    = /Ox

#Compilation flags
LTM_CFLAGS  = /nologo /I./ /D_CRT_SECURE_NO_WARNINGS /D_CRT_NONSTDC_NO_DEPRECATE /D__STDC_WANT_SECURE_LIB__=1 /D_CRT_HAS_CXX17=0 /Wall /wd4146 /wd4127 /wd4668 /wd4710 /wd4711 /wd4820 /wd5045 /WX $(CFLAGS)
LTM_LDFLAGS = advapi32.lib
default: library

#Libraries to be created (this makefile builds only static libraries)
LIBMAIN_S =tommath.lib

OBJECTS=bncore.obj bn_mp_init.obj bn_mp_clear.obj bn_mp_exch.obj bn_mp_grow.obj bn_mp_shrink.obj \
#List of objects to compile (all goes to tommath.lib)
OBJECTS=bn_cutoffs.obj bn_deprecated.obj bn_mp_2expt.obj bn_mp_abs.obj bn_mp_add.obj bn_mp_add_d.obj bn_mp_addmod.obj \
bn_mp_and.obj bn_mp_clamp.obj bn_mp_clear.obj bn_mp_clear_multi.obj bn_mp_cmp.obj bn_mp_cmp_d.obj bn_mp_cmp_mag.obj \
bn_mp_clamp.obj bn_mp_zero.obj  bn_mp_set.obj bn_mp_set_int.obj bn_mp_init_size.obj bn_mp_copy.obj \
bn_mp_cnt_lsb.obj bn_mp_complement.obj bn_mp_copy.obj bn_mp_count_bits.obj bn_mp_decr.obj bn_mp_div.obj bn_mp_div_2.obj \
bn_mp_div_2d.obj bn_mp_div_3.obj bn_mp_div_d.obj bn_mp_dr_is_modulus.obj bn_mp_dr_reduce.obj bn_mp_dr_setup.obj \
bn_mp_error_to_string.obj bn_mp_exch.obj bn_mp_expt_u32.obj bn_mp_exptmod.obj bn_mp_exteuclid.obj bn_mp_fread.obj \
bn_mp_from_sbin.obj bn_mp_from_ubin.obj bn_mp_fwrite.obj bn_mp_gcd.obj bn_mp_get_double.obj bn_mp_get_i32.obj \
bn_mp_get_i64.obj bn_mp_get_l.obj bn_mp_get_ll.obj bn_mp_get_mag_u32.obj bn_mp_get_mag_u64.obj bn_mp_get_mag_ul.obj \
bn_mp_get_mag_ull.obj bn_mp_grow.obj bn_mp_incr.obj bn_mp_init.obj bn_mp_init_copy.obj bn_mp_init_i32.obj \
bn_mp_init_copy.obj bn_mp_abs.obj bn_mp_neg.obj bn_mp_cmp_mag.obj bn_mp_cmp.obj bn_mp_cmp_d.obj \
bn_mp_init_i64.obj bn_mp_init_l.obj bn_mp_init_ll.obj bn_mp_init_multi.obj bn_mp_init_set.obj bn_mp_init_size.obj \
bn_mp_init_u32.obj bn_mp_init_u64.obj bn_mp_init_ul.obj bn_mp_init_ull.obj bn_mp_invmod.obj bn_mp_is_square.obj \
bn_mp_iseven.obj bn_mp_isodd.obj bn_mp_kronecker.obj bn_mp_lcm.obj bn_mp_log_u32.obj bn_mp_lshd.obj bn_mp_mod.obj \
bn_mp_rshd.obj bn_mp_lshd.obj bn_mp_mod_2d.obj bn_mp_div_2d.obj bn_mp_mul_2d.obj bn_mp_div_2.obj \
bn_mp_mod_2d.obj bn_mp_mod_d.obj bn_mp_montgomery_calc_normalization.obj bn_mp_montgomery_reduce.obj \
bn_mp_montgomery_setup.obj bn_mp_mul.obj bn_mp_mul_2.obj bn_mp_mul_2d.obj bn_mp_mul_d.obj bn_mp_mulmod.obj bn_mp_neg.obj \
bn_mp_or.obj bn_mp_pack.obj bn_mp_pack_count.obj bn_mp_prime_fermat.obj bn_mp_prime_frobenius_underwood.obj \
bn_mp_prime_is_prime.obj bn_mp_prime_miller_rabin.obj bn_mp_prime_next_prime.obj \
bn_mp_prime_rabin_miller_trials.obj bn_mp_prime_rand.obj bn_mp_prime_strong_lucas_selfridge.obj \
bn_mp_radix_size.obj bn_mp_radix_smap.obj bn_mp_rand.obj bn_mp_read_radix.obj bn_mp_reduce.obj bn_mp_reduce_2k.obj \
bn_mp_mul_2.obj bn_s_mp_add.obj bn_s_mp_sub.obj bn_fast_s_mp_mul_digs.obj bn_s_mp_mul_digs.obj \
bn_fast_s_mp_mul_high_digs.obj bn_s_mp_mul_high_digs.obj bn_fast_s_mp_sqr.obj bn_s_mp_sqr.obj \
bn_mp_add.obj bn_mp_sub.obj bn_mp_karatsuba_mul.obj bn_mp_mul.obj bn_mp_karatsuba_sqr.obj \
bn_mp_sqr.obj bn_mp_div.obj bn_mp_mod.obj bn_mp_add_d.obj bn_mp_sub_d.obj bn_mp_mul_d.obj \
bn_mp_div_d.obj bn_mp_mod_d.obj bn_mp_expt_d.obj bn_mp_addmod.obj bn_mp_submod.obj \
bn_mp_mulmod.obj bn_mp_sqrmod.obj bn_mp_gcd.obj bn_mp_lcm.obj bn_fast_mp_invmod.obj bn_mp_invmod.obj \
bn_mp_reduce.obj bn_mp_montgomery_setup.obj bn_fast_mp_montgomery_reduce.obj bn_mp_montgomery_reduce.obj \
bn_mp_reduce_2k_l.obj bn_mp_reduce_2k_setup.obj bn_mp_reduce_2k_setup_l.obj bn_mp_reduce_is_2k.obj \
bn_mp_reduce_is_2k_l.obj bn_mp_reduce_setup.obj bn_mp_root_u32.obj bn_mp_rshd.obj bn_mp_sbin_size.obj bn_mp_set.obj \
bn_mp_set_double.obj bn_mp_set_i32.obj bn_mp_set_i64.obj bn_mp_set_l.obj bn_mp_set_ll.obj bn_mp_set_u32.obj \
bn_mp_set_u64.obj bn_mp_set_ul.obj bn_mp_set_ull.obj bn_mp_shrink.obj bn_mp_signed_rsh.obj bn_mp_sqr.obj \
bn_mp_sqrmod.obj bn_mp_sqrt.obj bn_mp_sqrtmod_prime.obj bn_mp_sub.obj bn_mp_sub_d.obj bn_mp_submod.obj \
bn_mp_to_radix.obj bn_mp_to_sbin.obj bn_mp_to_ubin.obj bn_mp_ubin_size.obj bn_mp_unpack.obj bn_mp_xor.obj bn_mp_zero.obj \
bn_prime_tab.obj bn_s_mp_add.obj bn_s_mp_balance_mul.obj bn_s_mp_exptmod.obj bn_s_mp_exptmod_fast.obj \
bn_s_mp_get_bit.obj bn_s_mp_invmod_fast.obj bn_s_mp_invmod_slow.obj bn_s_mp_karatsuba_mul.obj \
bn_s_mp_karatsuba_sqr.obj bn_s_mp_montgomery_reduce_fast.obj bn_s_mp_mul_digs.obj bn_s_mp_mul_digs_fast.obj \
bn_s_mp_mul_high_digs.obj bn_s_mp_mul_high_digs_fast.obj bn_s_mp_prime_is_divisible.obj \
bn_mp_exptmod_fast.obj bn_mp_exptmod.obj bn_mp_2expt.obj bn_mp_n_root.obj bn_mp_jacobi.obj bn_reverse.obj \
bn_mp_count_bits.obj bn_mp_read_unsigned_bin.obj bn_mp_read_signed_bin.obj bn_mp_to_unsigned_bin.obj \
bn_mp_to_signed_bin.obj bn_mp_unsigned_bin_size.obj bn_mp_signed_bin_size.obj  \
bn_mp_xor.obj bn_mp_and.obj bn_mp_or.obj bn_mp_rand.obj bn_mp_montgomery_calc_normalization.obj \
bn_mp_prime_is_divisible.obj bn_prime_tab.obj bn_mp_prime_fermat.obj bn_mp_prime_miller_rabin.obj \
bn_s_mp_rand_jenkins.obj bn_s_mp_rand_platform.obj bn_s_mp_reverse.obj bn_s_mp_sqr.obj bn_s_mp_sqr_fast.obj \
bn_s_mp_sub.obj bn_s_mp_toom_mul.obj bn_s_mp_toom_sqr.obj

bn_mp_prime_is_prime.obj bn_mp_prime_next_prime.obj bn_mp_dr_reduce.obj \
bn_mp_dr_is_modulus.obj bn_mp_dr_setup.obj bn_mp_reduce_setup.obj \
bn_mp_toom_mul.obj bn_mp_toom_sqr.obj bn_mp_div_3.obj bn_s_mp_exptmod.obj \
bn_mp_reduce_2k.obj bn_mp_reduce_is_2k.obj bn_mp_reduce_2k_setup.obj \
HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

bn_mp_reduce_2k_l.obj bn_mp_reduce_is_2k_l.obj bn_mp_reduce_2k_setup_l.obj \
#The default rule for make builds the tommath.lib library (static)
default: $(LIBMAIN_S)

bn_mp_radix_smap.obj bn_mp_read_radix.obj bn_mp_toradix.obj bn_mp_radix_size.obj \
#Dependencies on *.h
$(OBJECTS): $(HEADERS)

bn_mp_fread.obj bn_mp_fwrite.obj bn_mp_cnt_lsb.obj bn_error.obj \
.c.obj:
	$(CC) $(LTM_CFLAGS) /c $< /Fo$@

bn_mp_init_multi.obj bn_mp_clear_multi.obj bn_mp_exteuclid.obj bn_mp_toradix_n.obj \
#Create tommath.lib
$(LIBMAIN_S): $(OBJECTS)
	lib /out:$(LIBMAIN_S) $(OBJECTS)

bn_mp_prime_random_ex.obj bn_mp_get_int.obj bn_mp_sqrt.obj bn_mp_is_square.obj \
#Build test suite
test.exe: $(LIBMAIN_S) demo/shared.obj demo/test.obj
	cl $(LTM_CFLAGS) $(TOBJECTS) $(LIBMAIN_S) $(LTM_LDFLAGS) demo/shared.c demo/test.c /Fe$@
	@echo NOTICE: start the tests by launching test.exe

bn_mp_init_set.obj bn_mp_init_set_int.obj bn_mp_invmod_slow.obj bn_mp_prime_rabin_miller_trials.obj \
test_standalone: test.exe
	@echo test_standalone is deprecated, please use make-target 'test.exe'

bn_mp_to_signed_bin_n.obj bn_mp_to_unsigned_bin_n.obj
all: $(LIBMAIN_S) test.exe

tune: $(LIBMAIN_S)
	$(MAKE) -C etc tune
	$(MAKE)

HEADERS=tommath.h tommath_class.h tommath_superclass.h
clean:
	@-cmd /c del /Q /S *.OBJ *.LIB *.EXE *.DLL 2>nul

#Install the library + headers
library: $(OBJECTS)
install: $(LIBMAIN_S)
	cmd /c if not exist "$(PREFIX)\bin" mkdir "$(PREFIX)\bin"
	cmd /c if not exist "$(PREFIX)\lib" mkdir "$(PREFIX)\lib"
	cmd /c if not exist "$(PREFIX)\include" mkdir "$(PREFIX)\include"
	copy /Y $(LIBMAIN_S) "$(PREFIX)\lib"
	copy /Y tommath*.h "$(PREFIX)\include"
	lib /out:tommath.lib $(OBJECTS)

Changes to libtommath/makefile.shared.

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
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









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-
+
-
-
-
-
-
+
+
-
-
-
+

-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
+
-



-
-
-
-
-

-
+


-
+
-
-
-
+
+
-
-
+
-

-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
#Makefile for GCC
#
#Tom St Denis
VERSION=0:41

CC = libtool --mode=compile --tag=CC gcc

CFLAGS  +=  -I./ -Wall -W -Wshadow -Wsign-compare

ifndef IGNORE_SPEED

#for speed 
CFLAGS += -O3 -funroll-loops

#for size 
#CFLAGS += -Os

#x86 optimizations [should be valid for any GCC install though]
CFLAGS  += -fomit-frame-pointer

endif

#install as this user
ifndef INSTALL_GROUP
   GROUP=wheel
else
   GROUP=$(INSTALL_GROUP)
endif

ifndef INSTALL_USER
   USER=root
else
   USER=$(INSTALL_USER)
endif

default: libtommath.la

#default files to install
ifndef LIBNAME
   LIBNAME=libtommath.la
endif

include makefile_include.mk


ifndef LIBTOOL
ifndef LIBNAME_S
  ifeq ($(PLATFORM), Darwin)
    LIBTOOL:=glibtool
  else
    LIBTOOL:=libtool
  endif
   LIBNAME_S=libtommath.a
endif
endif
LTCOMPILE = $(LIBTOOL) --mode=compile --tag=CC $(CC)
LTLINK = $(LIBTOOL) --mode=link --tag=CC $(CC)
HEADERS=tommath.h tommath_class.h tommath_superclass.h

LCOV_ARGS=--directory .libs --directory .

#START_INS
#LIBPATH-The directory for libtommath to be installed to.
#INCPATH-The directory to install the header files for libtommath.
#DATAPATH-The directory to install the pdf docs.
DESTDIR=
OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \
bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \
bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \
bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \
bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \
bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \
bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \
bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \
bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \
bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \
bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \
LIBPATH=/usr/lib
INCPATH=/usr/include
DATAPATH=/usr/share/doc/libtommath/pdf

OBJECTS=bncore.o bn_mp_init.o bn_mp_clear.o bn_mp_exch.o bn_mp_grow.o bn_mp_shrink.o \
bn_mp_clamp.o bn_mp_zero.o  bn_mp_set.o bn_mp_set_int.o bn_mp_init_size.o bn_mp_copy.o \
bn_mp_init_copy.o bn_mp_abs.o bn_mp_neg.o bn_mp_cmp_mag.o bn_mp_cmp.o bn_mp_cmp_d.o \
bn_mp_rshd.o bn_mp_lshd.o bn_mp_mod_2d.o bn_mp_div_2d.o bn_mp_mul_2d.o bn_mp_div_2.o \
bn_mp_mul_2.o bn_s_mp_add.o bn_s_mp_sub.o bn_fast_s_mp_mul_digs.o bn_s_mp_mul_digs.o \
bn_fast_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs.o bn_fast_s_mp_sqr.o bn_s_mp_sqr.o \
bn_mp_add.o bn_mp_sub.o bn_mp_karatsuba_mul.o bn_mp_mul.o bn_mp_karatsuba_sqr.o \
bn_mp_sqr.o bn_mp_div.o bn_mp_mod.o bn_mp_add_d.o bn_mp_sub_d.o bn_mp_mul_d.o \
bn_mp_div_d.o bn_mp_mod_d.o bn_mp_expt_d.o bn_mp_addmod.o bn_mp_submod.o \
bn_mp_mulmod.o bn_mp_sqrmod.o bn_mp_gcd.o bn_mp_lcm.o bn_fast_mp_invmod.o bn_mp_invmod.o \
bn_mp_reduce.o bn_mp_montgomery_setup.o bn_fast_mp_montgomery_reduce.o bn_mp_montgomery_reduce.o \
bn_mp_exptmod_fast.o bn_mp_exptmod.o bn_mp_2expt.o bn_mp_n_root.o bn_mp_jacobi.o bn_reverse.o \
bn_mp_count_bits.o bn_mp_read_unsigned_bin.o bn_mp_read_signed_bin.o bn_mp_to_unsigned_bin.o \
bn_mp_to_signed_bin.o bn_mp_unsigned_bin_size.o bn_mp_signed_bin_size.o  \
bn_mp_xor.o bn_mp_and.o bn_mp_or.o bn_mp_rand.o bn_mp_montgomery_calc_normalization.o \
bn_mp_prime_is_divisible.o bn_prime_tab.o bn_mp_prime_fermat.o bn_mp_prime_miller_rabin.o \
bn_mp_prime_is_prime.o bn_mp_prime_next_prime.o bn_mp_dr_reduce.o \
bn_mp_dr_is_modulus.o bn_mp_dr_setup.o bn_mp_reduce_setup.o \
bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_div_3.o bn_s_mp_exptmod.o \
bn_mp_reduce_2k.o bn_mp_reduce_is_2k.o bn_mp_reduce_2k_setup.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_is_2k_l.o bn_mp_reduce_2k_setup_l.o \
bn_mp_radix_smap.o bn_mp_read_radix.o bn_mp_toradix.o bn_mp_radix_size.o \
bn_mp_fread.o bn_mp_fwrite.o bn_mp_cnt_lsb.o bn_error.o \
bn_mp_init_multi.o bn_mp_clear_multi.o bn_mp_exteuclid.o bn_mp_toradix_n.o \
bn_mp_prime_random_ex.o bn_mp_get_int.o bn_mp_sqrt.o bn_mp_is_square.o bn_mp_init_set.o \
bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \
bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \
bn_mp_init_set_int.o bn_mp_invmod_slow.o bn_mp_prime_rabin_miller_trials.o \
bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \
bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \
bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \
bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

bn_mp_to_signed_bin_n.o bn_mp_to_unsigned_bin_n.o
#END_INS

objs: $(OBJECTS)

.c.o: $(HEADERS)
	$(LTCOMPILE) $(LTM_CFLAGS) $(LTM_LDFLAGS) -o $@ -c $<

LOBJECTS = $(OBJECTS:.o=.lo)

$(LIBNAME):  $(OBJECTS)
	$(LTLINK) $(LTM_LDFLAGS) $(LOBJECTS) -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION_SO) $(LTM_LIBTOOLFLAGS)
	libtool --mode=link gcc *.lo -o $(LIBNAME) -rpath $(LIBPATH) -version-info $(VERSION)

install: $(LIBNAME)
	install -d $(DESTDIR)$(LIBPATH)
	install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(LIBPATH)
	install -d $(DESTDIR)$(INCPATH)
	$(LIBTOOL) --mode=install install -m 644 $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	install -m 644 $(HEADERS_PUB) $(DESTDIR)$(INCPATH)
	libtool --mode=install install -c $(LIBNAME) $(DESTDIR)$(LIBPATH)/$(LIBNAME)
	install -d -g $(GROUP) -o $(USER) $(DESTDIR)$(INCPATH)
	sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION_PC),' libtommath.pc.in > libtommath.pc
	install -d $(DESTDIR)$(LIBPATH)/pkgconfig
	install -g $(GROUP) -o $(USER) $(HEADERS) $(DESTDIR)$(INCPATH)
	install -m 644 libtommath.pc $(DESTDIR)$(LIBPATH)/pkgconfig/

uninstall:
	$(LIBTOOL) --mode=uninstall rm $(DESTDIR)$(LIBPATH)/$(LIBNAME)
test: $(LIBNAME) demo/demo.o
	rm $(HEADERS_PUB:%=$(DESTDIR)$(INCPATH)/%)
	rm $(DESTDIR)$(LIBPATH)/pkgconfig/libtommath.pc

	gcc $(CFLAGS) -c demo/demo.c -o demo/demo.o
test_standalone: test
	@echo "test_standalone is deprecated, please use make-target 'test'"

	libtool --mode=link gcc -o test demo/demo.o $(LIBNAME_S)
test mtest_opponent: demo/shared.o $(LIBNAME) | demo/test.o demo/mtest_opponent.o
	$(LTLINK) $(LTM_LDFLAGS) demo/$@.o $^ -o $@

	
.PHONY: mtest
mtest:
	cd mtest ; $(CC) $(LTM_CFLAGS) -O0 mtest.c $(LTM_LDFLAGS) -o mtest

timing: $(LIBNAME) demo/timing.c
	$(LTLINK) $(LTM_CFLAGS) $(LTM_LDFLAGS) -DTIMER demo/timing.c $(LIBNAME) -o timing
mtest: test	
	cd mtest ; gcc $(CFLAGS) mtest.c -o mtest
        
timing: $(LIBNAME)
	gcc $(CFLAGS) -DTIMER demo/timing.c $(LIBNAME_S) -o ltmtest

tune: $(LIBNAME)
	$(LTCOMPILE) $(LTM_CFLAGS) -c etc/tune.c -o etc/tune.o
	$(LTLINK) $(LTM_LDFLAGS) -o etc/tune etc/tune.o $(LIBNAME)
	cd etc/; /bin/sh tune_it.sh; cd ..
	$(MAKE) -f makefile.shared

Deleted libtommath/makefile.unix.

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










































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# MAKEFILE that is intended to be compatible with any kind of make (GNU make, BSD make, ...)
# works on: Linux, *BSD, Cygwin, AIX, HP-UX and hopefully other UNIX systems
#
# Please do not use here neither any special make syntax nor any unusual tools/utilities!

# using ICC compiler:
# make -f makefile.unix CC=icc CFLAGS="-O3 -xP -ip"

# using Borland C++Builder:
# make -f makefile.unix CC=bcc32

#The following can be overridden from command line e.g. "make -f makefile.unix CC=gcc ARFLAGS=rcs"
DESTDIR   =
PREFIX    = /usr/local
LIBPATH   = $(PREFIX)/lib
INCPATH   = $(PREFIX)/include
CC        = cc
AR        = ar
ARFLAGS   = r
RANLIB    = ranlib
CFLAGS    = -O2
LDFLAGS   =

VERSION   = 1.2.0

#Compilation flags
LTM_CFLAGS  = -I. $(CFLAGS)
LTM_LDFLAGS = $(LDFLAGS)

#Library to be created (this makefile builds only static library)
LIBMAIN_S = libtommath.a

OBJECTS=bn_cutoffs.o bn_deprecated.o bn_mp_2expt.o bn_mp_abs.o bn_mp_add.o bn_mp_add_d.o bn_mp_addmod.o \
bn_mp_and.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_complement.o bn_mp_copy.o bn_mp_count_bits.o bn_mp_decr.o bn_mp_div.o bn_mp_div_2.o \
bn_mp_div_2d.o bn_mp_div_3.o bn_mp_div_d.o bn_mp_dr_is_modulus.o bn_mp_dr_reduce.o bn_mp_dr_setup.o \
bn_mp_error_to_string.o bn_mp_exch.o bn_mp_expt_u32.o bn_mp_exptmod.o bn_mp_exteuclid.o bn_mp_fread.o \
bn_mp_from_sbin.o bn_mp_from_ubin.o bn_mp_fwrite.o bn_mp_gcd.o bn_mp_get_double.o bn_mp_get_i32.o \
bn_mp_get_i64.o bn_mp_get_l.o bn_mp_get_ll.o bn_mp_get_mag_u32.o bn_mp_get_mag_u64.o bn_mp_get_mag_ul.o \
bn_mp_get_mag_ull.o bn_mp_grow.o bn_mp_incr.o bn_mp_init.o bn_mp_init_copy.o bn_mp_init_i32.o \
bn_mp_init_i64.o bn_mp_init_l.o bn_mp_init_ll.o bn_mp_init_multi.o bn_mp_init_set.o bn_mp_init_size.o \
bn_mp_init_u32.o bn_mp_init_u64.o bn_mp_init_ul.o bn_mp_init_ull.o bn_mp_invmod.o bn_mp_is_square.o \
bn_mp_iseven.o bn_mp_isodd.o bn_mp_kronecker.o bn_mp_lcm.o bn_mp_log_u32.o bn_mp_lshd.o bn_mp_mod.o \
bn_mp_mod_2d.o bn_mp_mod_d.o bn_mp_montgomery_calc_normalization.o bn_mp_montgomery_reduce.o \
bn_mp_montgomery_setup.o bn_mp_mul.o bn_mp_mul_2.o bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_mulmod.o bn_mp_neg.o \
bn_mp_or.o bn_mp_pack.o bn_mp_pack_count.o bn_mp_prime_fermat.o bn_mp_prime_frobenius_underwood.o \
bn_mp_prime_is_prime.o bn_mp_prime_miller_rabin.o bn_mp_prime_next_prime.o \
bn_mp_prime_rabin_miller_trials.o bn_mp_prime_rand.o bn_mp_prime_strong_lucas_selfridge.o \
bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_rand.o bn_mp_read_radix.o bn_mp_reduce.o bn_mp_reduce_2k.o \
bn_mp_reduce_2k_l.o bn_mp_reduce_2k_setup.o bn_mp_reduce_2k_setup_l.o bn_mp_reduce_is_2k.o \
bn_mp_reduce_is_2k_l.o bn_mp_reduce_setup.o bn_mp_root_u32.o bn_mp_rshd.o bn_mp_sbin_size.o bn_mp_set.o \
bn_mp_set_double.o bn_mp_set_i32.o bn_mp_set_i64.o bn_mp_set_l.o bn_mp_set_ll.o bn_mp_set_u32.o \
bn_mp_set_u64.o bn_mp_set_ul.o bn_mp_set_ull.o bn_mp_shrink.o bn_mp_signed_rsh.o bn_mp_sqr.o \
bn_mp_sqrmod.o bn_mp_sqrt.o bn_mp_sqrtmod_prime.o bn_mp_sub.o bn_mp_sub_d.o bn_mp_submod.o \
bn_mp_to_radix.o bn_mp_to_sbin.o bn_mp_to_ubin.o bn_mp_ubin_size.o bn_mp_unpack.o bn_mp_xor.o bn_mp_zero.o \
bn_prime_tab.o bn_s_mp_add.o bn_s_mp_balance_mul.o bn_s_mp_exptmod.o bn_s_mp_exptmod_fast.o \
bn_s_mp_get_bit.o bn_s_mp_invmod_fast.o bn_s_mp_invmod_slow.o bn_s_mp_karatsuba_mul.o \
bn_s_mp_karatsuba_sqr.o bn_s_mp_montgomery_reduce_fast.o bn_s_mp_mul_digs.o bn_s_mp_mul_digs_fast.o \
bn_s_mp_mul_high_digs.o bn_s_mp_mul_high_digs_fast.o bn_s_mp_prime_is_divisible.o \
bn_s_mp_rand_jenkins.o bn_s_mp_rand_platform.o bn_s_mp_reverse.o bn_s_mp_sqr.o bn_s_mp_sqr_fast.o \
bn_s_mp_sub.o bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o

HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

#The default rule for make builds the libtommath.a library (static)
default: $(LIBMAIN_S)

#Dependencies on *.h
$(OBJECTS): $(HEADERS)

#This is necessary for compatibility with BSD make (namely on OpenBSD)
.SUFFIXES: .o .c
.c.o:
	$(CC) $(LTM_CFLAGS) -c $< -o $@

#Create libtommath.a
$(LIBMAIN_S): $(OBJECTS)
	$(AR) $(ARFLAGS) $@ $(OBJECTS)
	$(RANLIB) $@

#Build test_standalone suite
test: demo/shared.o demo/test.o $(LIBMAIN_S)
	$(CC) $(LTM_CFLAGS) $(LTM_LDFLAGS) $^ -o $@
	@echo "NOTICE: start the tests by: ./test"

test_standalone: test
	@echo "test_standalone is deprecated, please use make-target 'test'"

all: $(LIBMAIN_S) test

tune: $(LIBMAIN_S)
	$(MAKE) -C etc tune
	$(MAKE)

#NOTE: this makefile works also on cygwin, thus we need to delete *.exe
clean:
	-@rm -f $(OBJECTS) $(LIBMAIN_S)
	-@rm -f demo/main.o demo/opponent.o demo/test.o test test.exe

#Install the library + headers
install: $(LIBMAIN_S)
	@mkdir -p $(DESTDIR)$(INCPATH) $(DESTDIR)$(LIBPATH)/pkgconfig
	@cp $(LIBMAIN_S) $(DESTDIR)$(LIBPATH)/
	@cp $(HEADERS_PUB) $(DESTDIR)$(INCPATH)/
	@sed -e 's,^prefix=.*,prefix=$(PREFIX),' -e 's,^Version:.*,Version: $(VERSION),' libtommath.pc.in > $(DESTDIR)$(LIBPATH)/pkgconfig/libtommath.pc

Deleted libtommath/makefile_include.mk.

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










































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#
# Include makefile for libtommath
#

#version of library
VERSION=1.2.0
VERSION_PC=1.2.0
VERSION_SO=3:0:2

PLATFORM := $(shell uname | sed -e 's/_.*//')

# default make target
default: ${LIBNAME}

# Compiler and Linker Names
ifndef CROSS_COMPILE
  CROSS_COMPILE=
endif

# We only need to go through this dance of determining the right compiler if we're using
# cross compilation, otherwise $(CC) is fine as-is.
ifneq (,$(CROSS_COMPILE))
ifeq ($(origin CC),default)
CSTR := "\#ifdef __clang__\nCLANG\n\#endif\n"
ifeq ($(PLATFORM),FreeBSD)
  # XXX: FreeBSD needs extra escaping for some reason
  CSTR := $$$(CSTR)
endif
ifneq (,$(shell echo $(CSTR) | $(CC) -E - | grep CLANG))
  CC := $(CROSS_COMPILE)clang
else
  CC := $(CROSS_COMPILE)gcc
endif # Clang
endif # cc is Make's default
endif # CROSS_COMPILE non-empty

LD=$(CROSS_COMPILE)ld
AR=$(CROSS_COMPILE)ar
RANLIB=$(CROSS_COMPILE)ranlib

ifndef MAKE
# BSDs refer to GNU Make as gmake
ifneq (,$(findstring $(PLATFORM),FreeBSD OpenBSD DragonFly NetBSD))
  MAKE=gmake
else
  MAKE=make
endif
endif

LTM_CFLAGS += -I./ -Wall -Wsign-compare -Wextra -Wshadow

ifdef SANITIZER
LTM_CFLAGS += -fsanitize=undefined -fno-sanitize-recover=all -fno-sanitize=float-divide-by-zero
endif

ifndef NO_ADDTL_WARNINGS
# additional warnings
LTM_CFLAGS += -Wdeclaration-after-statement -Wbad-function-cast -Wcast-align
LTM_CFLAGS += -Wstrict-prototypes -Wpointer-arith
endif

ifdef CONV_WARNINGS
LTM_CFLAGS += -std=c89 -Wconversion -Wsign-conversion
ifeq ($(CONV_WARNINGS), strict)
LTM_CFLAGS += -DMP_USE_ENUMS -Wc++-compat
endif
else
LTM_CFLAGS += -Wsystem-headers
endif

ifdef COMPILE_DEBUG
#debug
LTM_CFLAGS += -g3
endif

ifdef COMPILE_SIZE
#for size
LTM_CFLAGS += -Os
else

ifndef IGNORE_SPEED
#for speed
LTM_CFLAGS += -O3 -funroll-loops

#x86 optimizations [should be valid for any GCC install though]
LTM_CFLAGS  += -fomit-frame-pointer
endif

endif # COMPILE_SIZE

ifneq ($(findstring clang,$(CC)),)
LTM_CFLAGS += -Wno-typedef-redefinition -Wno-tautological-compare -Wno-builtin-requires-header
endif
ifneq ($(findstring mingw,$(CC)),)
LTM_CFLAGS += -Wno-shadow
endif
ifeq ($(PLATFORM), Darwin)
LTM_CFLAGS += -Wno-nullability-completeness
endif
ifeq ($(PLATFORM), CYGWIN)
LIBTOOLFLAGS += -no-undefined
endif

# add in the standard FLAGS
LTM_CFLAGS += $(CFLAGS)
LTM_LFLAGS += $(LFLAGS)
LTM_LDFLAGS += $(LDFLAGS)
LTM_LIBTOOLFLAGS += $(LIBTOOLFLAGS)


ifeq ($(PLATFORM),FreeBSD)
  _ARCH := $(shell sysctl -b hw.machine_arch)
else
  _ARCH := $(shell uname -m)
endif

# adjust coverage set
ifneq ($(filter $(_ARCH), i386 i686 x86_64 amd64 ia64),)
   COVERAGE = test timing
   COVERAGE_APP = ./test && ./timing
else
   COVERAGE = test
   COVERAGE_APP = ./test
endif

HEADERS_PUB=tommath.h
HEADERS=tommath_private.h tommath_class.h tommath_superclass.h tommath_cutoffs.h $(HEADERS_PUB)

#LIBPATH  The directory for libtommath to be installed to.
#INCPATH  The directory to install the header files for libtommath.
#DATAPATH The directory to install the pdf docs.
DESTDIR  ?=
PREFIX   ?= /usr/local
LIBPATH  ?= $(PREFIX)/lib
INCPATH  ?= $(PREFIX)/include
DATAPATH ?= $(PREFIX)/share/doc/libtommath/pdf

# build & run test-suite
check: test
	./test

#make the code coverage of the library
#
coverage: LTM_CFLAGS += -fprofile-arcs -ftest-coverage -DTIMING_NO_LOGS
coverage: LTM_LFLAGS += -lgcov
coverage: LTM_LDFLAGS += -lgcov

coverage: $(COVERAGE)
	$(COVERAGE_APP)

lcov: coverage
	rm -f coverage.info
	lcov --capture --no-external --no-recursion $(LCOV_ARGS) --output-file coverage.info -q
	genhtml coverage.info --output-directory coverage -q

# target that removes all coverage output
cleancov-clean:
	rm -f `find . -type f -name "*.info" | xargs`
	rm -rf coverage/

# cleans everything - coverage output and standard 'clean'
cleancov: cleancov-clean clean

clean:
	rm -f *.gcda *.gcno *.gcov *.bat *.o *.a *.obj *.lib *.exe *.dll etclib/*.o \
				demo/*.o test timing mtest_opponent mtest/mtest mtest/mtest.exe tuning_list \
				*.s mpi.c *.da *.dyn *.dpi tommath.tex `find . -type f | grep [~] | xargs` *.lo *.la
	rm -rf .libs/ demo/.libs
	${MAKE} -C etc/ clean MAKE=${MAKE}
	${MAKE} -C doc/ clean MAKE=${MAKE}

Deleted libtommath/tommath.def.

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

















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
; libtommath
;
; Use this command to produce a 32-bit .lib file, for use in any MSVC version
;   lib -machine:X86 -name:libtommath.dll -def:tommath.def -out:tommath.lib
; Use this command to produce a 64-bit .lib file, for use in any MSVC version
;   lib -machine:X64 -name:libtommath.dll -def:tommath.def -out:tommath.lib
;
EXPORTS
    mp_2expt
    mp_abs
    mp_add
    mp_add_d
    mp_addmod
    mp_and
    mp_clamp
    mp_clear
    mp_clear_multi
    mp_cmp
    mp_cmp_d
    mp_cmp_mag
    mp_cnt_lsb
    mp_complement
    mp_copy
    mp_count_bits
    mp_decr
    mp_div
    mp_div_2
    mp_div_2d
    mp_div_3
    mp_div_d
    mp_dr_is_modulus
    mp_dr_reduce
    mp_dr_setup
    mp_error_to_string
    mp_exch
    mp_expt_u32
    mp_exptmod
    mp_exteuclid
    mp_fread
    mp_from_sbin
    mp_from_ubin
    mp_fwrite
    mp_gcd
    mp_get_double
    mp_get_i32
    mp_get_i64
    mp_get_int
    mp_get_l
    mp_get_ll
    mp_get_long
    mp_get_long_long
    mp_get_mag_u32
    mp_get_mag_u64
    mp_get_mag_ul
    mp_get_mag_ull
    mp_grow
    mp_incr
    mp_init
    mp_init_copy
    mp_init_i32
    mp_init_i64
    mp_init_l
    mp_init_ll
    mp_init_multi
    mp_init_set
    mp_init_set_int
    mp_init_size
    mp_init_u32
    mp_init_u64
    mp_init_ul
    mp_init_ull
    mp_invmod
    mp_is_square
    mp_iseven
    mp_isodd
    mp_kronecker
    mp_lcm
    mp_log_u32
    mp_lshd
    mp_mod
    mp_mod_2d
    mp_mod_d
    mp_montgomery_calc_normalization
    mp_montgomery_reduce
    mp_montgomery_setup
    mp_mul
    mp_mul_2
    mp_mul_2d
    mp_mul_d
    mp_mulmod
    mp_neg
    mp_or
    mp_pack
    mp_pack_count
    mp_prime_fermat
    mp_prime_frobenius_underwood
    mp_prime_is_prime
    mp_prime_miller_rabin
    mp_prime_next_prime
    mp_prime_rabin_miller_trials
    mp_prime_rand
    mp_prime_strong_lucas_selfridge
    mp_radix_size
    mp_rand
    mp_read_radix
    mp_reduce
    mp_reduce_2k
    mp_reduce_2k_l
    mp_reduce_2k_setup
    mp_reduce_2k_setup_l
    mp_reduce_is_2k
    mp_reduce_is_2k_l
    mp_reduce_setup
    mp_root_u32
    mp_rshd
    mp_sbin_size
    mp_set
    mp_set_double
    mp_set_i32
    mp_set_i64
    mp_set_int
    mp_set_l
    mp_set_ll
    mp_set_long
    mp_set_long_long
    mp_set_u32
    mp_set_u64
    mp_set_ul
    mp_set_ull
    mp_shrink
    mp_signed_rsh
    mp_sqr
    mp_sqrmod
    mp_sqrt
    mp_sqrtmod_prime
    mp_sub
    mp_sub_d
    mp_submod
    mp_to_radix
    mp_to_sbin
    mp_to_ubin
    mp_ubin_size
    mp_unpack
    mp_xor
    mp_zero

Changes to libtommath/tommath.h.

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
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
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

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
611
612
613

614
615
616
617
618
619
620

621
622
623

624
625
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
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
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
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
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

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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629

630
631
632
633






-
+
-
-
+
-
-
+


-
-
-
+
+
+
+
+
+






-
-
-
-
+
+
+
+
+
+
+
-
-
-

+
-
-
+
+


-
-
-
-


-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-




-
-
+
+




-

-
-
+
+
-

-
-
+
+
-

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+


-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+
+
+
+

+
-
+



-
-
-
+
+
+
-
-
-
-



-
-
+
+


-
-
-
+
+
+






-
-
-
-
-
+
+
+
+
+
-

-
-
-
-
-
-
-
-
-









-
-
+
+

-
+



-
-
+
+
-
-
-
-
-
-
-
-


















-
+

-
+

-
+

-



-
-
-
+
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
+
-
-



-
+


-
-
+
+

+
+
+
+

-
+



-
+





-
+


-
+





-
+


-
+


-
+



-
-
+
+





-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-

-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
+


-
+




-
-
-
-
-

-
+
-
-

-
-
-
-
-
+
-
-
-
+







-
+


-
+


-
+

-
-
-

-
+


-
+


-
+


-
+


-
+



-
-
+
+
-
-
-
-

-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-

-
-
+


-
-
+


-
-
+
-
-
-
-
-
-
-




-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+
-
-
-
-
-
-




-
+


-
+

+
+
+

-
+

+
+
+

-
+


-
+

+
+
+
+
+
+

-
+




-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+





-
-
+
-


-
+

-
-
-

-
+


-
-
+
-
-


-
+






-
+


-
+




-
+


-
+


-
+





-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+





-
+

-
+

-


-
+


-
+




-
+




-
+




-
+




-
+




-
+















-
+






-
+










-
+














-
+
-
-


-
-
-
-
-
+
-


-
+

-
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
+


-
-
+
+


-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+



/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef BN_H_
#define BN_H_

#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \
#include <string.h>
	&& !defined(__CLANG_STDINT_H) && !defined(_STDINT)
#  include <stdint.h>
#include <stdlib.h>
#endif
#include <stddef.h>
#include <ctype.h>
#include <limits.h>

#ifdef LTM_NO_FILE
#  warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
#  define MP_NO_FILE
#ifndef MIN
   #define MIN(x,y) ((x)<(y)?(x):(y))
#endif

#ifndef MAX
   #define MAX(x,y) ((x)>(y)?(x):(y))
#endif

#ifndef MP_NO_FILE
#  include <stdio.h>
#endif

#ifdef MP_8BIT
#  ifdef _MSC_VER
#    pragma message("8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version.")
#  else
#ifdef __cplusplus
extern "C" {

/* C++ compilers don't like assigning void * to mp_digit * */
#define  OPT_CAST(x)  (x *)

#else
#    warning "8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version."
#  endif
#endif

/* C on the other hand doesn't care */
#ifdef __cplusplus
extern "C" {
#define  OPT_CAST(x)

#endif

/* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
#if (defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_32BIT) && !defined(MP_64BIT)
#   define MP_32BIT
#endif

/* detect 64-bit mode if possible */
#if defined(__x86_64__) || defined(_M_X64) || defined(_M_AMD64) || \
#if defined(__x86_64__)
    defined(__powerpc64__) || defined(__ppc64__) || defined(__PPC64__) || \
    defined(__s390x__) || defined(__arch64__) || defined(__aarch64__) || \
    defined(__sparcv9) || defined(__sparc_v9__) || defined(__sparc64__) || \
    defined(__ia64) || defined(__ia64__) || defined(__itanium__) || defined(_M_IA64) || \
    defined(__LP64__) || defined(_LP64) || defined(__64BIT__)
#   if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
   #if !(defined(MP_64BIT) && defined(MP_16BIT) && defined(MP_8BIT))
#      if defined(__GNUC__) && !defined(__hppa)
/* we support 128bit integers only via: __attribute__((mode(TI))) */
#         define MP_64BIT
      #define MP_64BIT
#      else
/* otherwise we fall back to MP_32BIT even on 64bit platforms */
#         define MP_32BIT
#      endif
#   endif
#endif
   #endif

#ifdef MP_DIGIT_BIT
#   error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT
#endif

/* some default configurations.
 *
 * A "mp_digit" must be able to hold MP_DIGIT_BIT + 1 bits
 * A "mp_word" must be able to hold 2*MP_DIGIT_BIT + 1 bits
 * A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
 * A "mp_word" must be able to hold 2*DIGIT_BIT + 1 bits
 *
 * At the very least a mp_digit must be able to hold 7 bits
 * [any size beyond that is ok provided it doesn't overflow the data type]
 */

#ifdef MP_8BIT
typedef uint8_t              mp_digit;
typedef uint16_t             private_mp_word;
   typedef unsigned char      mp_digit;
   typedef unsigned short     mp_word;
#   define MP_DIGIT_BIT 7
#elif defined(MP_16BIT)
typedef uint16_t             mp_digit;
typedef uint32_t             private_mp_word;
   typedef unsigned short     mp_digit;
   typedef unsigned long      mp_word;
#   define MP_DIGIT_BIT 15
#elif defined(MP_64BIT)
/* for GCC only on supported platforms */
typedef uint64_t mp_digit;
#if defined(__GNUC__)
typedef unsigned long        private_mp_word __attribute__((mode(TI)));
#endif
#   define MP_DIGIT_BIT 60
   /* for GCC only on supported platforms */
#ifndef CRYPT
   typedef unsigned long long ulong64;
   typedef signed long long   long64;
#endif

   typedef unsigned long      mp_digit;
   typedef unsigned long      mp_word __attribute__ ((mode(TI)));

   #define DIGIT_BIT          60
#else
   /* this is the default case, 28-bit digits */

   /* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT
   #if defined(_MSC_VER) || defined(__BORLANDC__)
      typedef unsigned __int64   ulong64;
      typedef signed __int64     long64;
   #else
      typedef unsigned long long ulong64;
      typedef signed long long   long64;
   #endif
#endif

   typedef unsigned long      mp_digit;
   typedef ulong64            mp_word;

#ifdef MP_31BIT
   /* this is an extension that uses 31-bit digits */
   #define DIGIT_BIT          31
#else
typedef uint32_t             mp_digit;
typedef uint64_t             private_mp_word;
#   ifdef MP_31BIT
/*
 * This is an extension that uses 31-bit digits.
 * Please be aware that not all functions support this size, especially s_mp_mul_digs_fast
 * will be reduced to work on small numbers only:
 * Up to 8 limbs, 248 bits instead of up to 512 limbs, 15872 bits with MP_28BIT.
 */
#      define MP_DIGIT_BIT 31
#   else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
#      define MP_DIGIT_BIT 28
#      define MP_28BIT
#   endif
   /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
   #define DIGIT_BIT          28
   #define MP_28BIT
#endif
#endif

/* mp_word is a private type */
#define mp_word MP_DEPRECATED_PRAGMA("mp_word has been made private") private_mp_word
/* define heap macros */
#ifndef CRYPT
   /* default to libc stuff */
   #ifndef XMALLOC
       #define XMALLOC  malloc
       #define XFREE    free
       #define XREALLOC realloc
       #define XCALLOC  calloc
   #else
      /* prototypes for our heap functions */
      extern void *XMALLOC(size_t n);
      extern void *XREALLOC(void *p, size_t n);
      extern void *XCALLOC(size_t n, size_t s);
      extern void XFREE(void *p);
   #endif
#endif

#define MP_SIZEOF_MP_DIGIT (MP_DEPRECATED_PRAGMA("MP_SIZEOF_MP_DIGIT has been deprecated, use sizeof (mp_digit)") sizeof (mp_digit))

/* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
#ifndef DIGIT_BIT
   #define DIGIT_BIT     ((int)((CHAR_BIT * sizeof(mp_digit) - 1)))  /* bits per digit */
#endif

#define MP_DIGIT_BIT     DIGIT_BIT
#define MP_MASK          ((((mp_digit)1)<<((mp_digit)MP_DIGIT_BIT))-((mp_digit)1))
#define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
#define MP_DIGIT_MAX     MP_MASK

/* Primality generation flags */
#define MP_PRIME_BBS      0x0001 /* BBS style prime */
#define MP_PRIME_SAFE     0x0002 /* Safe prime (p-1)/2 == prime */
#define MP_PRIME_2MSB_ON  0x0008 /* force 2nd MSB to 1 */
#define LTM_PRIME_BBS      0x0001 /* BBS style prime */
#define LTM_PRIME_SAFE     0x0002 /* Safe prime (p-1)/2 == prime */
#define LTM_PRIME_2MSB_ON  0x0008 /* force 2nd MSB to 1 */

#define LTM_PRIME_BBS      (MP_DEPRECATED_PRAGMA("LTM_PRIME_BBS has been deprecated, use MP_PRIME_BBS") MP_PRIME_BBS)
#define LTM_PRIME_SAFE     (MP_DEPRECATED_PRAGMA("LTM_PRIME_SAFE has been deprecated, use MP_PRIME_SAFE") MP_PRIME_SAFE)
#define LTM_PRIME_2MSB_ON  (MP_DEPRECATED_PRAGMA("LTM_PRIME_2MSB_ON has been deprecated, use MP_PRIME_2MSB_ON") MP_PRIME_2MSB_ON)

#ifdef MP_USE_ENUMS
typedef enum {
   MP_ZPOS = 0,   /* positive */
   MP_NEG = 1     /* negative */
   MP_ZPOS = 0,
   MP_NEG = 1
} mp_sign;
typedef enum {
   MP_LT = -1,    /* less than */
   MP_EQ = 0,     /* equal */
   MP_GT = 1      /* greater than */
   MP_LT = -1,
   MP_EQ = 0,
   MP_GT = 1
} mp_ord;
typedef enum {
   MP_NO = 0,
   MP_YES = 1
} mp_bool;
typedef enum {
   MP_OKAY  = 0,   /* no error */
   MP_ERR   = -1,  /* unknown error */
   MP_MEM   = -2,  /* out of mem */
   MP_VAL   = -3,  /* invalid input */
   MP_ITER  = -4,  /* maximum iterations reached */
   MP_OKAY  = 0,
   MP_ERR   = -1,
   MP_MEM   = -2,
   MP_VAL   = -3,
   MP_ITER  = -4
   MP_BUF   = -5   /* buffer overflow, supplied buffer too small */
} mp_err;
typedef enum {
   MP_LSB_FIRST = -1,
   MP_MSB_FIRST =  1
} mp_order;
typedef enum {
   MP_LITTLE_ENDIAN  = -1,
   MP_NATIVE_ENDIAN  =  0,
   MP_BIG_ENDIAN     =  1
} mp_endian;
#else
typedef int mp_sign;
#define MP_ZPOS       0   /* positive integer */
#define MP_NEG        1   /* negative */
typedef int mp_ord;
#define MP_LT        -1   /* less than */
#define MP_EQ         0   /* equal to */
#define MP_GT         1   /* greater than */
typedef int mp_bool;
#define MP_YES        1
#define MP_NO         0
#define MP_YES        1   /* yes response */
#define MP_NO         0   /* no response */
typedef int mp_err;
#define MP_OKAY       0   /* no error */
#define MP_OKAY       0   /* ok result */
#define MP_ERR        -1  /* unknown error */
#define MP_MEM        -2  /* out of mem */
#define MP_VAL        -3  /* invalid input */
#define MP_RANGE      (MP_DEPRECATED_PRAGMA("MP_RANGE has been deprecated in favor of MP_VAL") MP_VAL)
#define MP_ITER       -4  /* maximum iterations reached */
#define MP_RANGE      MP_VAL
#define MP_ITER       -4  /* Max. iterations reached */
#define MP_BUF        -5  /* buffer overflow, supplied buffer too small */
typedef int mp_order;
#define MP_LSB_FIRST -1
#define MP_MSB_FIRST  1
typedef int mp_endian;
#define MP_LITTLE_ENDIAN  -1
#define MP_NATIVE_ENDIAN  0
#define MP_BIG_ENDIAN     1
#endif

/* tunable cutoffs */

#ifndef MP_FIXED_CUTOFFS
extern int
KARATSUBA_MUL_CUTOFF,
KARATSUBA_SQR_CUTOFF,
TOOM_MUL_CUTOFF,
TOOM_SQR_CUTOFF;
#endif

/* define this to use lower memory usage routines (exptmods mostly) */
/* #define MP_LOW_MEM */

/* default precision */
#ifndef MP_PREC
#   ifndef MP_LOW_MEM
#      define PRIVATE_MP_PREC 32        /* default digits of precision */
#      define MP_PREC 32        /* default digits of precision */
#   elif defined(MP_8BIT)
#      define PRIVATE_MP_PREC 16        /* default digits of precision */
#      define MP_PREC 16        /* default digits of precision */
#   else
#      define PRIVATE_MP_PREC 8         /* default digits of precision */
#      define MP_PREC 8         /* default digits of precision */
#   endif
#   define MP_PREC (MP_DEPRECATED_PRAGMA("MP_PREC is an internal macro") PRIVATE_MP_PREC)
#endif

/* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
#define PRIVATE_MP_WARRAY (int)(1 << (((CHAR_BIT * (int)sizeof(private_mp_word)) - (2 * MP_DIGIT_BIT)) + 1))
#define MP_WARRAY (MP_DEPRECATED_PRAGMA("MP_WARRAY is an internal macro") PRIVATE_MP_WARRAY)

#define MP_WARRAY               (1 << (sizeof(mp_word) * CHAR_BIT - 2 * DIGIT_BIT + 1))
#if defined(__GNUC__) && __GNUC__ >= 4
#   define MP_NULL_TERMINATED __attribute__((sentinel))
#else
#   define MP_NULL_TERMINATED
#endif

/*
 * MP_WUR - warn unused result
 * ---------------------------
 *
 * The result of functions annotated with MP_WUR must be
 * checked and cannot be ignored.
 *
 * Most functions in libtommath return an error code.
 * This error code must be checked in order to prevent crashes or invalid
 * results.
 *
 * If you still want to avoid the error checks for quick and dirty programs
 * without robustness guarantees, you can `#define MP_WUR` before including
 * tommath.h, disabling the warnings.
 */
#ifndef MP_WUR
#  if defined(__GNUC__) && __GNUC__ >= 4
#     define MP_WUR __attribute__((warn_unused_result))
#  else
#     define MP_WUR
#  endif
#endif

#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405)
#  define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
#elif defined(_MSC_VER) && _MSC_VER >= 1500
#  define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
#else
#  define MP_DEPRECATED(x)
#endif

#ifndef MP_NO_DEPRECATED_PRAGMA
#if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 301)
#  define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
#  define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
#elif defined(_MSC_VER) && _MSC_VER >= 1500
#  define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
#endif
#endif

#ifndef MP_DEPRECATED_PRAGMA
#  define MP_DEPRECATED_PRAGMA(s)
#endif

#define DIGIT_BIT   (MP_DEPRECATED_PRAGMA("DIGIT_BIT macro is deprecated, MP_DIGIT_BIT instead") MP_DIGIT_BIT)
#define USED(m)     (MP_DEPRECATED_PRAGMA("USED macro is deprecated, use z->used instead") (m)->used)
#define DIGIT(m, k) (MP_DEPRECATED_PRAGMA("DIGIT macro is deprecated, use z->dp instead") (m)->dp[(k)])
#define SIGN(m)     (MP_DEPRECATED_PRAGMA("SIGN macro is deprecated, use z->sign instead") (m)->sign)

/* the infamous mp_int structure */
#ifndef MP_INT_DECLARED
#define MP_INT_DECLARED
typedef struct mp_int mp_int;
typedef struct  {
#endif
struct mp_int {
   int used, alloc;
   mp_sign sign;
   mp_digit *dp;
};
} mp_int;

/* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
typedef int private_mp_prime_callback(unsigned char *dst, int len, void *dat);
typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source) ltm_prime_callback;
typedef int ltm_prime_callback(unsigned char *dst, int len, void *dat);


#define USED(m)    ((m)->used)
#define DIGIT(m,k) ((m)->dp[(k)])
#define SIGN(m)    ((m)->sign)

/* error code to char* string */
const char *mp_error_to_string(mp_err code) MP_WUR;
const char *mp_error_to_string(mp_err code);

/* ---> init and deinit bignum functions <--- */
/* init a bignum */
mp_err mp_init(mp_int *a) MP_WUR;
mp_err mp_init(mp_int *a);

/* free a bignum */
void mp_clear(mp_int *a);

/* init a null terminated series of arguments */
mp_err mp_init_multi(mp_int *mp, ...) MP_NULL_TERMINATED MP_WUR;
mp_err mp_init_multi(mp_int *mp, ...);

/* clear a null terminated series of arguments */
void mp_clear_multi(mp_int *mp, ...) MP_NULL_TERMINATED;
void mp_clear_multi(mp_int *mp, ...);

/* exchange two ints */
void mp_exch(mp_int *a, mp_int *b);

/* shrink ram required for a bignum */
mp_err mp_shrink(mp_int *a) MP_WUR;
mp_err mp_shrink(mp_int *a);

/* grow an int to a given size */
mp_err mp_grow(mp_int *a, int size) MP_WUR;
mp_err mp_grow(mp_int *a, int size);

/* init to a given number of digits */
mp_err mp_init_size(mp_int *a, int size) MP_WUR;
mp_err mp_init_size(mp_int *a, int size);

/* ---> Basic Manipulations <--- */
#define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
mp_bool mp_iseven(const mp_int *a) MP_WUR;
mp_bool mp_isodd(const mp_int *a) MP_WUR;
#define mp_iseven(a) (((a)->used == 0 || (((a)->dp[0] & 1) == 0)) ? MP_YES : MP_NO)
#define mp_isodd(a)  (((a)->used > 0 && (((a)->dp[0] & 1) == 1)) ? MP_YES : MP_NO)
#define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)

/* set to zero */
void mp_zero(mp_int *a);

/* get and set doubles */
double mp_get_double(const mp_int *a) MP_WUR;
mp_err mp_set_double(mp_int *a, double b) MP_WUR;

/* set to a digit */
/* get integer, set integer and init with integer (int32_t) */
int32_t mp_get_i32(const mp_int *a) MP_WUR;
void mp_set_i32(mp_int *a, int32_t b);
mp_err mp_init_i32(mp_int *a, int32_t b) MP_WUR;

/* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint32_t) */
#define mp_get_u32(a) ((uint32_t)mp_get_i32(a))
void mp_set_u32(mp_int *a, uint32_t b);
mp_err mp_init_u32(mp_int *a, uint32_t b) MP_WUR;

/* get integer, set integer and init with integer (int64_t) */
int64_t mp_get_i64(const mp_int *a) MP_WUR;
void mp_set_i64(mp_int *a, int64_t b);
mp_err mp_init_i64(mp_int *a, int64_t b) MP_WUR;

/* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint64_t) */
#define mp_get_u64(a) ((uint64_t)mp_get_i64(a))
void mp_set_u64(mp_int *a, uint64_t b);
mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR;

/* get magnitude */
uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR;
uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR;
unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR;
#ifdef _MSC_VER
#define mp_get_mag_ull(a) ((unsigned __int64)mp_get_mag_u64(a))
#else
unsigned long long mp_get_mag_ull(const mp_int *a) MP_WUR;
#endif

/* get integer, set integer (long) */
long mp_get_l(const mp_int *a) MP_WUR;
void mp_set_l(mp_int *a, long b);
mp_err mp_init_l(mp_int *a, long b) MP_WUR;

/* get integer, set integer (unsigned long) */
#define mp_get_ul(a) ((unsigned long)mp_get_l(a))
void mp_set_ul(mp_int *a, unsigned long b);
mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR;

#ifdef _MSC_VER
/* get integer, set integer (long long) */
#define mp_get_ll(a) ((__int64)mp_get_i64(a))
#define mp_set_ll(a,b) mp_set_i64(a,b)
#define mp_init_ll(a,b) mp_init_i64(a,b)

/* get integer, set integer (unsigned long long) */
#define mp_get_ull(a) ((unsigned __int64)mp_get_i64(a))
#define mp_set_ull(a,b) mp_set_u64(a,b)
#define mp_init_ull(a,b) mp_init_u64(a,b)
#else
/* get integer, set integer (long long) */
long long mp_get_ll(const mp_int *a) MP_WUR;
void mp_set_ll(mp_int *a, long long b);
mp_err mp_init_ll(mp_int *a, long long b) MP_WUR;

/* get integer, set integer (unsigned long long) */
#define mp_get_ull(a) ((unsigned long long)mp_get_ll(a))
void mp_set_ull(mp_int *a, unsigned long long b);
mp_err mp_init_ull(mp_int *a, unsigned long long b) MP_WUR;
#endif

/* set to single unsigned digit, up to MP_DIGIT_MAX */
void mp_set(mp_int *a, mp_digit b);
mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR;

/* get integer, set integer and init with integer (deprecated) */
/* set a 32-bit const */
MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR;
MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR;
#ifdef _MSC_VER
MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned __int64 mp_get_long_long(const mp_int *a) MP_WUR;
#endif
MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int *a, unsigned long b);
MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int *a, unsigned long b);
#ifdef _MSC_VER
MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned __int64 b);
#endif
MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR;
int mp_set_int(mp_int *a, unsigned long b);

/* get a 32-bit value */
unsigned long mp_get_int(mp_int * a);

/* initialize and set a digit */
int mp_init_set (mp_int * a, mp_digit b);

/* initialize and set 32-bit value */
int mp_init_set_int (mp_int * a, unsigned long b);

/* copy, b = a */
mp_err mp_copy(const mp_int *a, mp_int *b) MP_WUR;
mp_err mp_copy(const mp_int *a, mp_int *b);

/* inits and copies, a = b */
mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR;
mp_err mp_init_copy(mp_int *a, const mp_int *b);

/* trim unused digits */
void mp_clamp(mp_int *a);


/* export binary data */
MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order, size_t size,
                                        int endian, size_t nails, const mp_int *op) MP_WUR;

/* import binary data */
MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int *rop, size_t count, int order,
mp_err mp_import(mp_int *rop, size_t count, int order, size_t size, int endian, size_t nails, const void *op);
      size_t size, int endian, size_t nails,
      const void *op) MP_WUR;

/* unpack binary data */
mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian,
                 size_t nails, const void *op) MP_WUR;

/* pack binary data */
/* export binary data */
size_t mp_pack_count(const mp_int *a, size_t nails, size_t size) MP_WUR;
mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size,
               mp_endian endian, size_t nails, const mp_int *op) MP_WUR;
mp_err mp_export(void *rop, size_t *countp, int order, size_t size, int endian, size_t nails, const mp_int *op);

/* ---> digit manipulation <--- */

/* right shift by "b" digits */
void mp_rshd(mp_int *a, int b);

/* left shift by "b" digits */
mp_err mp_lshd(mp_int *a, int b) MP_WUR;
mp_err mp_lshd(mp_int *a, int b);

/* c = a / 2**b, implemented as c = a >> b */
mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) MP_WUR;
mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d);

/* b = a/2 */
mp_err mp_div_2(const mp_int *a, mp_int *b) MP_WUR;
mp_err mp_div_2(const mp_int *a, mp_int *b);

/* a/3 => 3c + d == a */
mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR;

/* c = a * 2**b, implemented as c = a << b */
mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c);

/* b = a*2 */
mp_err mp_mul_2(const mp_int *a, mp_int *b) MP_WUR;
mp_err mp_mul_2(const mp_int *a, mp_int *b);

/* c = a mod 2**b */
mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c);

/* computes a = 2**b */
mp_err mp_2expt(mp_int *a, int b) MP_WUR;
mp_err mp_2expt(mp_int *a, int b);

/* Counts the number of lsbs which are zero before the first zero bit */
int mp_cnt_lsb(const mp_int *a) MP_WUR;
int mp_cnt_lsb(const mp_int *a);

/* I Love Earth! */

/* makes a pseudo-random mp_int of a given size */
mp_err mp_rand(mp_int *a, int digits) MP_WUR;
/* makes a pseudo-random int of a given size */
mp_err mp_rand(mp_int *a, int digits);
/* makes a pseudo-random small int of a given size */
MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit *r) MP_WUR;
/* use custom random data source instead of source provided the platform */
void mp_rand_source(mp_err(*source)(void *out, size_t size));

#ifdef MP_PRNG_ENABLE_LTM_RNG
#  warning MP_PRNG_ENABLE_LTM_RNG has been deprecated, use mp_rand_source instead.
/* A last resort to provide random data on systems without any of the other
 * implemented ways to gather entropy.
 * It is compatible with `rng_get_bytes()` from libtomcrypt so you could
 * provide that one and then set `ltm_rng = rng_get_bytes;` */
extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
extern void (*ltm_rng_callback)(void);
#endif

/* ---> binary operations <--- */

/* Checks the bit at position b and returns MP_YES
 * if the bit is 1, MP_NO if it is 0 and MP_VAL
 * in case of error
 */
MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int *a, int b) MP_WUR;

/* c = a XOR b (two complement) */
MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_xor(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a OR b (two complement) */
MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_or(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a AND b (two complement) */
MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_and(const mp_int *a, const mp_int *b, mp_int *c);

/* b = ~a (bitwise not, two complement) */
mp_err mp_complement(const mp_int *a, mp_int *b) MP_WUR;

/* right shift with sign extension */
MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
mp_err mp_signed_rsh(const mp_int *a, int b, mp_int *c) MP_WUR;

/* ---> Basic arithmetic <--- */

/* b = -a */
mp_err mp_neg(const mp_int *a, mp_int *b) MP_WUR;
mp_err mp_neg(const mp_int *a, mp_int *b);

/* b = |a| */
mp_err mp_abs(const mp_int *a, mp_int *b) MP_WUR;
mp_err mp_abs(const mp_int *a, mp_int *b);

/* compare a to b */
mp_ord mp_cmp(const mp_int *a, const mp_int *b) MP_WUR;
mp_ord mp_cmp(const mp_int *a, const mp_int *b);

/* compare |a| to |b| */
mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR;
mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b);

/* c = a + b */
mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a - b */
mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c);

/* c = a * b */
mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c);

/* b = a*a  */
mp_err mp_sqr(const mp_int *a, mp_int *b) MP_WUR;
mp_err mp_sqr(const mp_int *a, mp_int *b);

/* a/b => cb + d == a */
mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) MP_WUR;
mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d);

/* c = a mod b, 0 <= c < b  */
mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_mod(const mp_int *a, const mp_int *b, mp_int *c);

/* Increment "a" by one like "a++". Changes input! */
mp_err mp_incr(mp_int *a) MP_WUR;

/* Decrement "a" by one like "a--". Changes input! */
mp_err mp_decr(mp_int *a) MP_WUR;

/* ---> single digit functions <--- */

/* compare against a single digit */
mp_ord mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR;
mp_ord mp_cmp_d(const mp_int *a, mp_digit b);

/* c = a + b */
mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c);

/* Increment "a" by one like "a++". Changes input! */
mp_err mp_incr(mp_int *a);

/* c = a - b */
mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);

/* Decrement "a" by one like "a--". Changes input! */
mp_err mp_decr(mp_int *a);

/* c = a * b */
mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
mp_err mp_mul_d(const mp_int *a, mp_digit b, mp_int *c);

/* a/b => cb + d == a */
mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) MP_WUR;
mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d);

/* a/3 => 3c + d == a */
mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d);

/* c = a**b */
mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c);

/* c = a mod b, 0 <= c < b  */
mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) MP_WUR;
mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c);

/* ---> number theory <--- */

/* d = a + b (mod c) */
mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);

/* d = a - b (mod c) */
mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);

/* d = a * b (mod c) */
mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d);

/* c = a * a (mod b) */
mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_sqrmod(const mp_int *a, const mp_int *b, mp_int *c);

/* c = 1/a (mod b) */
mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c);

/* c = (a, b) */
mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_gcd(const mp_int *a, const mp_int *b, mp_int *c);

/* produces value such that U1*a + U2*b = U3 */
mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) MP_WUR;
mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3);

/* c = [a, b] or (a*b)/(a, b) */
mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c);

/* finds one of the b'th root of a, such that |c|**b <= |a|
 *
 * returns error if a < 0 and b is even
 */
mp_err mp_root_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR;
MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
int mp_n_root(mp_int *a, mp_digit b, mp_int *c);
MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;

/* special sqrt algo */
mp_err mp_sqrt(const mp_int *arg, mp_int *ret) MP_WUR;
mp_err mp_sqrt(const mp_int *arg, mp_int *ret);

/* special sqrt (mod prime) */
mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) MP_WUR;

/* is number a square? */
mp_err mp_is_square(const mp_int *arg, mp_bool *ret) MP_WUR;
mp_err mp_is_square(const mp_int *arg, mp_bool *ret);

/* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) MP_WUR;

int mp_jacobi(mp_int *a, mp_int *n, int *c);
/* computes the Kronecker symbol c = (a | p) (like jacobi() but with {a,p} in Z */
mp_err mp_kronecker(const mp_int *a, const mp_int *p, int *c) MP_WUR;

/* used to setup the Barrett reduction for a given modulus b */
mp_err mp_reduce_setup(mp_int *a, const mp_int *b) MP_WUR;
mp_err mp_reduce_setup(mp_int *a, const mp_int *b);

/* Barrett Reduction, computes a (mod b) with a precomputed value c
 *
 * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely
 * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code].
 */
mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) MP_WUR;
mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu);

/* setups the montgomery reduction */
mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) MP_WUR;
mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho);

/* computes a = B**n mod b without division or multiplication useful for
 * normalizing numbers in a Montgomery system.
 */
mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) MP_WUR;
mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b);

/* computes x/R == x (mod N) via Montgomery Reduction */
mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR;
mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho);

/* returns 1 if a is a valid DR modulus */
mp_bool mp_dr_is_modulus(const mp_int *a) MP_WUR;
mp_bool mp_dr_is_modulus(const mp_int *a);

/* sets the value of "d" required for mp_dr_reduce */
void mp_dr_setup(const mp_int *a, mp_digit *d);

/* reduces a modulo n using the Diminished Radix method */
mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) MP_WUR;
mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k);

/* returns true if a can be reduced with mp_reduce_2k */
mp_bool mp_reduce_is_2k(const mp_int *a) MP_WUR;
mp_bool mp_reduce_is_2k(const mp_int *a);

/* determines k value for 2k reduction */
mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) MP_WUR;
mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d);

/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) MP_WUR;
mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d);

/* returns true if a can be reduced with mp_reduce_2k_l */
mp_bool mp_reduce_is_2k_l(const mp_int *a) MP_WUR;
mp_bool mp_reduce_is_2k_l(const mp_int *a);

/* determines k value for 2k reduction */
mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) MP_WUR;
mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d);

/* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d) MP_WUR;
mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const mp_int *d);

/* Y = G**X (mod P) */
mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) MP_WUR;
mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y);

/* ---> Primes <--- */

/* number of primes */
#ifdef MP_8BIT
#  define PRIVATE_MP_PRIME_TAB_SIZE 31
   #define PRIME_SIZE      31
#else
#  define PRIVATE_MP_PRIME_TAB_SIZE 256
   #define PRIME_SIZE      256
#endif
#define PRIME_SIZE (MP_DEPRECATED_PRAGMA("PRIME_SIZE has been made internal") PRIVATE_MP_PRIME_TAB_SIZE)

/* table of first PRIME_SIZE primes */
MP_DEPRECATED(internal) extern const mp_digit ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE];
extern const mp_digit ltm_prime_tab[];

/* result=1 if a is divisible by one of the first PRIME_SIZE primes */
MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) MP_WUR;
mp_err mp_prime_is_divisible(mp_int *a, mp_bool *result);

/* performs one Fermat test of "a" using base "b".
 * Sets result to 0 if composite or 1 if probable prime
 */
mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR;
mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result);

/* performs one Miller-Rabin test of "a" using base "b".
 * Sets result to 0 if composite or 1 if probable prime
 */
mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR;
mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result);

/* This gives [for a given bit size] the number of trials required
 * such that Miller-Rabin gives a prob of failure lower than 2^-96
 */
int mp_prime_rabin_miller_trials(int size) MP_WUR;
int mp_prime_rabin_miller_trials(int size);

/* performs one strong Lucas-Selfridge test of "a".
 * Sets result to 0 if composite or 1 if probable prime
 */
mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) MP_WUR;
mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result);

/* performs one Frobenius test of "a" as described by Paul Underwood.
 * Sets result to 0 if composite or 1 if probable prime
 */
mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR;
mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result);

/* performs t random rounds of Miller-Rabin on "a" additional to
 * bases 2 and 3.  Also performs an initial sieve of trial
 * division.  Determines if "a" is prime with probability
 * of error no more than (1/4)**t.
 * Both a strong Lucas-Selfridge to complete the BPSW test
 * and a separate Frobenius test are available at compile time.
 * With t<0 a deterministic test is run for primes up to
 * 318665857834031151167461. With t<13 (abs(t)-13) additional
 * tests with sequential small primes are run starting at 43.
 * Is Fips 186.4 compliant if called with t as computed by
 * mp_prime_rabin_miller_trials();
 *
 * Sets result to 1 if probably prime, 0 otherwise
 */
mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) MP_WUR;
mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result);

/* finds the next prime after the number "a" using "t" trials
 * of Miller-Rabin.
 *
 * bbs_style = 1 means the prime must be congruent to 3 mod 4
 */
mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR;
mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style);

/* makes a truly random prime of a given size (bytes),
 * call with bbs = 1 if you want it to be congruent to 3 mod 4
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 * The prime generated will be larger than 2^(8*size).
 */
#define mp_prime_random(a, t, size, bbs, cb, dat) (MP_DEPRECATED_PRAGMA("mp_prime_random has been deprecated, use mp_prime_rand instead") mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?MP_PRIME_BBS:0, cb, dat))
#define mp_prime_random(a, t, size, bbs, cb, dat) mp_prime_random_ex(a, t, ((size) * 8) + 1, (bbs==1)?LTM_PRIME_BBS:0, cb, dat)

/* makes a truly random prime of a given size (bits),
 *
 * Flags are as follows:
 *
 *   MP_PRIME_BBS      - make prime congruent to 3 mod 4
 *   MP_PRIME_SAFE     - make sure (p-1)/2 is prime as well (implies MP_PRIME_BBS)
 *   MP_PRIME_2MSB_ON  - make the 2nd highest bit one
 *
 * You have to supply a callback which fills in a buffer with random bytes.  "dat" is a parameter you can
 * have passed to the callback (e.g. a state or something).  This function doesn't use "dat" itself
 * so it can be NULL
 *
 */
MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags,
mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags, ltm_prime_callback cb, void *dat);
      private_mp_prime_callback cb, void *dat) MP_WUR;
mp_err mp_prime_rand(mp_int *a, int t, int size, int flags) MP_WUR;

/* Integer logarithm to integer base */
mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) MP_WUR;

/* c = a**b */
mp_err mp_expt_u32(const mp_int *a, uint32_t b, mp_int *c) MP_WUR;
MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
mp_err mp_ilogb(const mp_int *a, mp_digit base, mp_int *c);
MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;

/* ---> radix conversion <--- */
int mp_count_bits(const mp_int *a) MP_WUR;
int mp_count_bits(const mp_int *a);


MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *a) MP_WUR;
MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) MP_WUR;
MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) MP_WUR;
MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR;
int mp_unsigned_bin_size(const mp_int *a);
mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c);
mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b);
mp_err mp_to_unsigned_bin_n(const mp_int * a, unsigned char *b, unsigned long *outlen);

MP_DEPRECATED(mp_sbin_size) int mp_signed_bin_size(const mp_int *a) MP_WUR;
MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) MP_WUR;
MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int *a,  unsigned char *b) MP_WUR;
MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR;
int mp_signed_bin_size(const mp_int *a);
mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c);
mp_err mp_to_signed_bin(const mp_int *a,  unsigned char *b);
mp_err mp_to_signed_bin_n(const mp_int * a, unsigned char *b, unsigned long *outlen);

size_t mp_ubin_size(const mp_int *a) MP_WUR;
mp_err mp_from_ubin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR;
mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR;

size_t mp_sbin_size(const mp_int *a) MP_WUR;
mp_err mp_from_sbin(mp_int *a, const unsigned char *buf, size_t size) MP_WUR;
mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR;

mp_err mp_read_radix(mp_int *a, const char *str, int radix) MP_WUR;
MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int *a, char *str, int radix) MP_WUR;
MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) MP_WUR;
mp_err mp_read_radix(mp_int *a, const char *str, int radix);
mp_err mp_toradix(const mp_int *a, char *str, int radix);
mp_err mp_toradix_n(const mp_int * a, char *str, int radix, int maxlen);
mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR;
mp_err mp_radix_size(const mp_int *a, int radix, int *size) MP_WUR;
mp_err mp_radix_size(const mp_int *a, int radix, int *size);

#ifndef MP_NO_FILE
mp_err mp_fread(mp_int *a, int radix, FILE *stream) MP_WUR;
mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR;
mp_err mp_fread(mp_int *a, int radix, FILE *stream);
mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream);
#endif

#define mp_read_raw(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_signed_bin") mp_read_signed_bin((mp), (str), (len)))
#define mp_raw_size(mp)           (MP_DEPRECATED_PRAGMA("replaced by mp_signed_bin_size") mp_signed_bin_size(mp))
#define mp_toraw(mp, str)         (MP_DEPRECATED_PRAGMA("replaced by mp_to_signed_bin") mp_to_signed_bin((mp), (str)))
#define mp_read_mag(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_unsigned_bin") mp_read_unsigned_bin((mp), (str), (len))
#define mp_mag_size(mp)           (MP_DEPRECATED_PRAGMA("replaced by mp_unsigned_bin_size") mp_unsigned_bin_size(mp))
#define mp_tomag(mp, str)         (MP_DEPRECATED_PRAGMA("replaced by mp_to_unsigned_bin") mp_to_unsigned_bin((mp), (str)))
#define mp_read_raw(mp, str, len) mp_read_signed_bin((mp), (str), (len))
#define mp_raw_size(mp)           mp_signed_bin_size(mp)
#define mp_toraw(mp, str)         mp_to_signed_bin((mp), (str))
#define mp_read_mag(mp, str, len) mp_read_unsigned_bin((mp), (str), (len))
#define mp_mag_size(mp)           mp_unsigned_bin_size(mp)
#define mp_tomag(mp, str)         mp_to_unsigned_bin((mp), (str))

#define mp_tobinary(M, S)  (MP_DEPRECATED_PRAGMA("replaced by mp_to_binary")  mp_toradix((M), (S), 2))
#define mp_tooctal(M, S)   (MP_DEPRECATED_PRAGMA("replaced by mp_to_octal")   mp_toradix((M), (S), 8))
#define mp_todecimal(M, S) (MP_DEPRECATED_PRAGMA("replaced by mp_to_decimal") mp_toradix((M), (S), 10))
#define mp_tohex(M, S)     (MP_DEPRECATED_PRAGMA("replaced by mp_to_hex")     mp_toradix((M), (S), 16))
#define mp_tobinary(M, S)  mp_toradix((M), (S), 2)
#define mp_tooctal(M, S)   mp_toradix((M), (S), 8)
#define mp_todecimal(M, S) mp_toradix((M), (S), 10)
#define mp_tohex(M, S)     mp_toradix((M), (S), 16)

/* lowlevel functions, do not call! */
int s_mp_add(mp_int *a, mp_int *b, mp_int *c);
int s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
#define mp_to_binary(M, S, N)  mp_to_radix((M), (S), (N), NULL, 2)
#define mp_to_octal(M, S, N)   mp_to_radix((M), (S), (N), NULL, 8)
#define mp_to_decimal(M, S, N) mp_to_radix((M), (S), (N), NULL, 10)
#define mp_to_hex(M, S, N)     mp_to_radix((M), (S), (N), NULL, 16)
#define s_mp_mul(a, b, c) s_mp_mul_digs(a, b, c, (a)->used + (b)->used + 1)
int fast_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
int s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
int fast_s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
int s_mp_mul_high_digs(mp_int *a, mp_int *b, mp_int *c, int digs);
int fast_s_mp_sqr(mp_int *a, mp_int *b);
int s_mp_sqr(mp_int *a, mp_int *b);
int mp_karatsuba_mul(mp_int *a, mp_int *b, mp_int *c);
int mp_toom_mul(mp_int *a, mp_int *b, mp_int *c);
int mp_karatsuba_sqr(mp_int *a, mp_int *b);
int mp_toom_sqr(mp_int *a, mp_int *b);
int fast_mp_invmod(mp_int *a, mp_int *b, mp_int *c);
int mp_invmod_slow (mp_int * a, mp_int * b, mp_int * c);
int fast_mp_montgomery_reduce(mp_int *a, mp_int *m, mp_digit mp);
int mp_exptmod_fast(mp_int *G, mp_int *X, mp_int *P, mp_int *Y, int mode);
int s_mp_exptmod (mp_int * G, mp_int * X, mp_int * P, mp_int * Y, int mode);
void bn_reverse(unsigned char *s, int len);

extern const char *mp_s_rmap;

#ifdef __cplusplus
}
   }
#endif

#endif

Changes to libtommath/tommath_class.h.

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
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
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
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
611
612
613
614
615
616


617
618
619
620
621
622


623
624
625
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

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
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
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
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
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



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









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
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



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
611




612





613
614
615
616
617
618
619

620










621









622
623
624



625





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
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
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
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
-
-
-

-

-
+


-
+


+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
-
-
-
+
+
-

-
-
+
+
+


-
+
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-



-
-
+
+



-
+



+
-
+
-
-
+



-
-
-
+
+
+



-
-
-
-
+
+
+
+



+
-
-
+
+
+









-
+



-
+









-
-
-
-
+
-



-
+





-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-



-
-
+
+



-
-
-
-
-
+
+
+
+
+
+
+
+



-
-
-
-
+
+
+
+



-
+
-
-
-
-
-
-
+
+
+
+
+
+
+






+
-
-
+
+
-
-
+





-
-
-



-
-
-
-
-
-
+
+
+
+
+
+



+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+



-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+



-
-
+
+



+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+


-
+
-
-
-
-
-
-
-
-
-





-
-
-
-
-
-




-
-
+
-


-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-



-
-
+
+


-
+
+
+


-
-
+
+
-


-
-
-
+
+
+
+
+


-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
+
+
+
+
+
+
+
+


-
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
+
+
-



-
+
+



+
-
-
-
-
+
+
+
+
-



-
-
-
+
+
+



-
+



-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
-
+
+
+
+
+
+






-
-
-
-
-
+
+
+
+
+



-
+



-
-
-
-
+
+
+
+



-
-
+
+



+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+
+



+
-
-
+
+
-
-
-
-
+
-
-
-


-
-
-
-

-
-
-
-
-
+
+
+
+
+


-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-



-
-
-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
-



-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+





-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-



-
-
-
-
+
+
+
+
+



+



-
-
-
+
+
+
-
-



-
-
-
+
+
+
+
+
+


+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+
-
-
-
+
+
-
-
-
-
+
+
+
+
+



-
+
-
-
-
+
+
-
-
-
-
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+



+
-
+






-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+


-
-
+
+


-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
+
+
-
-



+
-
-
-
+
+
+
-



-
-
-
-
+
+
+
+



-
+
-
-
-
-
-
+
+
-
-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
+
+
-



+
-
+
-
-
+



+
-
-
+
+
-



-
-
-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+
+
+
+
+


-
-
-
-
+
+
+
+
+
+
+
+
+
+



+
-
-
+
+
+








-
+
-
-


-
-
-
+
+
+
-
-
-
-
-
-
-



-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-



-
+
-
-
-
-
+
+
-
-
-
-
-
+
+



-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
+


-
-
-
-
-
-
-
-
-
-

-
-
-
+
+
+
-
-
-
-
-
+
-



-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-


-
+
-
-
-
-
-
-
-
-
-
-
-


-
-

-
+

-
-
-
+
+

-
+

/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#if !(defined(LTM1) && defined(LTM2) && defined(LTM3))
#define LTM_INSIDE
#if defined(LTM2)
#   define LTM3
#define LTM3
#endif
#if defined(LTM1)
#   define LTM2
#define LTM2
#endif
#define LTM1

#if defined(LTM_ALL)
#   define BN_CUTOFFS_C
#   define BN_DEPRECATED_C
#   define BN_MP_2EXPT_C
#   define BN_MP_ABS_C
#   define BN_MP_ADD_C
#   define BN_MP_ADD_D_C
#   define BN_MP_ADDMOD_C
#   define BN_MP_AND_C
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_CNT_LSB_C
#define BN_ERROR_C
#define BN_FAST_MP_INVMOD_C
#define BN_FAST_MP_MONTGOMERY_REDUCE_C
#define BN_FAST_S_MP_MUL_DIGS_C
#define BN_FAST_S_MP_MUL_HIGH_DIGS_C
#define BN_FAST_S_MP_SQR_C
#define BN_MP_2EXPT_C
#define BN_MP_ABS_C
#define BN_MP_ADD_C
#define BN_MP_ADD_D_C
#define BN_MP_ADDMOD_C
#define BN_MP_AND_C
#define BN_MP_CLAMP_C
#define BN_MP_CLEAR_C
#define BN_MP_CLEAR_MULTI_C
#define BN_MP_CMP_C
#define BN_MP_CMP_D_C
#define BN_MP_CMP_MAG_C
#define BN_MP_CNT_LSB_C
#   define BN_MP_COMPLEMENT_C
#   define BN_MP_COPY_C
#   define BN_MP_COUNT_BITS_C
#define BN_MP_COPY_C
#define BN_MP_COUNT_BITS_C
#   define BN_MP_DECR_C
#   define BN_MP_DIV_C
#   define BN_MP_DIV_2_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_DIV_3_C
#   define BN_MP_DIV_D_C
#   define BN_MP_DR_IS_MODULUS_C
#   define BN_MP_DR_REDUCE_C
#   define BN_MP_DR_SETUP_C
#define BN_MP_DIV_C
#define BN_MP_DIV_2_C
#define BN_MP_DIV_2D_C
#define BN_MP_DIV_3_C
#define BN_MP_DIV_D_C
#define BN_MP_DR_IS_MODULUS_C
#define BN_MP_DR_REDUCE_C
#define BN_MP_DR_SETUP_C
#   define BN_MP_ERROR_TO_STRING_C
#   define BN_MP_EXCH_C
#   define BN_MP_EXPT_U32_C
#   define BN_MP_EXPTMOD_C
#   define BN_MP_EXTEUCLID_C
#   define BN_MP_FREAD_C
#define BN_MP_EXCH_C
#define BN_MP_EXPT_D_C
#define BN_MP_EXPTMOD_C
#define BN_MP_EXPTMOD_FAST_C
#define BN_MP_EXTEUCLID_C
#define BN_MP_FREAD_C
#   define BN_MP_FROM_SBIN_C
#   define BN_MP_FROM_UBIN_C
#   define BN_MP_FWRITE_C
#   define BN_MP_GCD_C
#define BN_MP_FWRITE_C
#define BN_MP_GCD_C
#   define BN_MP_GET_DOUBLE_C
#   define BN_MP_GET_I32_C
#define BN_MP_GET_INT_C
#   define BN_MP_GET_I64_C
#   define BN_MP_GET_L_C
#   define BN_MP_GET_LL_C
#   define BN_MP_GET_MAG_U32_C
#   define BN_MP_GET_MAG_U64_C
#   define BN_MP_GET_MAG_UL_C
#   define BN_MP_GET_MAG_ULL_C
#   define BN_MP_GROW_C
#define BN_MP_GROW_C
#   define BN_MP_INCR_C
#   define BN_MP_INIT_C
#   define BN_MP_INIT_COPY_C
#define BN_MP_INIT_C
#define BN_MP_INIT_COPY_C
#   define BN_MP_INIT_I32_C
#   define BN_MP_INIT_I64_C
#   define BN_MP_INIT_L_C
#   define BN_MP_INIT_LL_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_INIT_SET_C
#   define BN_MP_INIT_SIZE_C
#define BN_MP_INIT_MULTI_C
#define BN_MP_INIT_SET_C
#define BN_MP_INIT_SET_INT_C
#   define BN_MP_INIT_U32_C
#   define BN_MP_INIT_U64_C
#   define BN_MP_INIT_UL_C
#define BN_MP_INIT_SIZE_C
#   define BN_MP_INIT_ULL_C
#   define BN_MP_INVMOD_C
#   define BN_MP_IS_SQUARE_C
#   define BN_MP_ISEVEN_C
#   define BN_MP_ISODD_C
#   define BN_MP_KRONECKER_C
#   define BN_MP_LCM_C
#define BN_MP_INVMOD_C
#define BN_MP_INVMOD_SLOW_C
#define BN_MP_IS_SQUARE_C
#define BN_MP_JACOBI_C
#define BN_MP_KARATSUBA_MUL_C
#define BN_MP_KARATSUBA_SQR_C
#define BN_MP_LCM_C
#   define BN_MP_LOG_U32_C
#   define BN_MP_LSHD_C
#   define BN_MP_MOD_C
#   define BN_MP_MOD_2D_C
#   define BN_MP_MOD_D_C
#   define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C
#   define BN_MP_MONTGOMERY_REDUCE_C
#   define BN_MP_MONTGOMERY_SETUP_C
#   define BN_MP_MUL_C
#   define BN_MP_MUL_2_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_MUL_D_C
#   define BN_MP_MULMOD_C
#   define BN_MP_NEG_C
#   define BN_MP_OR_C
#   define BN_MP_PACK_C
#define BN_MP_LSHD_C
#define BN_MP_MOD_C
#define BN_MP_MOD_2D_C
#define BN_MP_MOD_D_C
#define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C
#define BN_MP_MONTGOMERY_REDUCE_C
#define BN_MP_MONTGOMERY_SETUP_C
#define BN_MP_MUL_C
#define BN_MP_MUL_2_C
#define BN_MP_MUL_2D_C
#define BN_MP_MUL_D_C
#define BN_MP_MULMOD_C
#define BN_MP_N_ROOT_C
#define BN_MP_NEG_C
#define BN_MP_OR_C
#   define BN_MP_PACK_COUNT_C
#   define BN_MP_PRIME_FERMAT_C
#   define BN_MP_PRIME_FROBENIUS_UNDERWOOD_C
#   define BN_MP_PRIME_IS_PRIME_C
#   define BN_MP_PRIME_MILLER_RABIN_C
#   define BN_MP_PRIME_NEXT_PRIME_C
#   define BN_MP_PRIME_RABIN_MILLER_TRIALS_C
#   define BN_MP_PRIME_RAND_C
#define BN_MP_PRIME_FERMAT_C
#define BN_MP_PRIME_IS_DIVISIBLE_C
#define BN_MP_PRIME_IS_PRIME_C
#define BN_MP_PRIME_MILLER_RABIN_C
#define BN_MP_PRIME_NEXT_PRIME_C
#define BN_MP_PRIME_RABIN_MILLER_TRIALS_C
#define BN_MP_PRIME_RANDOM_EX_C
#   define BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C
#   define BN_MP_RADIX_SIZE_C
#   define BN_MP_RADIX_SMAP_C
#   define BN_MP_RAND_C
#   define BN_MP_READ_RADIX_C
#   define BN_MP_REDUCE_C
#   define BN_MP_REDUCE_2K_C
#   define BN_MP_REDUCE_2K_L_C
#   define BN_MP_REDUCE_2K_SETUP_C
#   define BN_MP_REDUCE_2K_SETUP_L_C
#   define BN_MP_REDUCE_IS_2K_C
#   define BN_MP_REDUCE_IS_2K_L_C
#   define BN_MP_REDUCE_SETUP_C
#define BN_MP_RADIX_SIZE_C
#define BN_MP_RADIX_SMAP_C
#define BN_MP_RAND_C
#define BN_MP_READ_RADIX_C
#define BN_MP_READ_SIGNED_BIN_C
#define BN_MP_READ_UNSIGNED_BIN_C
#define BN_MP_REDUCE_C
#define BN_MP_REDUCE_2K_C
#define BN_MP_REDUCE_2K_L_C
#define BN_MP_REDUCE_2K_SETUP_C
#define BN_MP_REDUCE_2K_SETUP_L_C
#define BN_MP_REDUCE_IS_2K_C
#define BN_MP_REDUCE_IS_2K_L_C
#define BN_MP_REDUCE_SETUP_C
#   define BN_MP_ROOT_U32_C
#   define BN_MP_RSHD_C
#define BN_MP_RSHD_C
#   define BN_MP_SBIN_SIZE_C
#   define BN_MP_SET_C
#define BN_MP_SET_C
#   define BN_MP_SET_DOUBLE_C
#   define BN_MP_SET_I32_C
#define BN_MP_SET_INT_C
#   define BN_MP_SET_I64_C
#   define BN_MP_SET_L_C
#   define BN_MP_SET_LL_C
#   define BN_MP_SET_U32_C
#   define BN_MP_SET_U64_C
#   define BN_MP_SET_UL_C
#   define BN_MP_SET_ULL_C
#   define BN_MP_SHRINK_C
#   define BN_MP_SIGNED_RSH_C
#   define BN_MP_SQR_C
#   define BN_MP_SQRMOD_C
#   define BN_MP_SQRT_C
#define BN_MP_SHRINK_C
#define BN_MP_SIGNED_BIN_SIZE_C
#define BN_MP_SQR_C
#define BN_MP_SQRMOD_C
#define BN_MP_SQRT_C
#   define BN_MP_SQRTMOD_PRIME_C
#   define BN_MP_SUB_C
#   define BN_MP_SUB_D_C
#   define BN_MP_SUBMOD_C
#   define BN_MP_TO_RADIX_C
#   define BN_MP_TO_SBIN_C
#   define BN_MP_TO_UBIN_C
#   define BN_MP_UBIN_SIZE_C
#   define BN_MP_UNPACK_C
#   define BN_MP_XOR_C
#   define BN_MP_ZERO_C
#   define BN_PRIME_TAB_C
#   define BN_S_MP_ADD_C
#   define BN_S_MP_BALANCE_MUL_C
#   define BN_S_MP_EXPTMOD_C
#define BN_MP_SUB_C
#define BN_MP_SUB_D_C
#define BN_MP_SUBMOD_C
#define BN_MP_TO_SIGNED_BIN_C
#define BN_MP_TO_SIGNED_BIN_N_C
#define BN_MP_TO_UNSIGNED_BIN_C
#define BN_MP_TO_UNSIGNED_BIN_N_C
#define BN_MP_TOOM_MUL_C
#define BN_MP_TOOM_SQR_C
#define BN_MP_TORADIX_C
#define BN_MP_TORADIX_N_C
#define BN_MP_UNSIGNED_BIN_SIZE_C
#define BN_MP_XOR_C
#define BN_MP_ZERO_C
#define BN_PRIME_TAB_C
#define BN_REVERSE_C
#define BN_S_MP_ADD_C
#define BN_S_MP_EXPTMOD_C
#   define BN_S_MP_EXPTMOD_FAST_C
#   define BN_S_MP_GET_BIT_C
#   define BN_S_MP_INVMOD_FAST_C
#   define BN_S_MP_INVMOD_SLOW_C
#   define BN_S_MP_KARATSUBA_MUL_C
#   define BN_S_MP_KARATSUBA_SQR_C
#   define BN_S_MP_MONTGOMERY_REDUCE_FAST_C
#   define BN_S_MP_MUL_DIGS_C
#define BN_S_MP_MUL_DIGS_C
#   define BN_S_MP_MUL_DIGS_FAST_C
#   define BN_S_MP_MUL_HIGH_DIGS_C
#define BN_S_MP_MUL_HIGH_DIGS_C
#   define BN_S_MP_MUL_HIGH_DIGS_FAST_C
#   define BN_S_MP_PRIME_IS_DIVISIBLE_C
#   define BN_S_MP_RAND_JENKINS_C
#   define BN_S_MP_RAND_PLATFORM_C
#   define BN_S_MP_REVERSE_C
#   define BN_S_MP_SQR_C
#define BN_S_MP_SQR_C
#   define BN_S_MP_SQR_FAST_C
#   define BN_S_MP_SUB_C
#   define BN_S_MP_TOOM_MUL_C
#define BN_S_MP_SUB_C
#define BNCORE_C
#   define BN_S_MP_TOOM_SQR_C
#endif
#endif
#if defined(BN_CUTOFFS_C)

#if defined(BN_ERROR_C)
   #define BN_MP_ERROR_TO_STRING_C
#endif

#if defined(BN_DEPRECATED_C)
#if defined(BN_FAST_MP_INVMOD_C)
#   define BN_FAST_MP_INVMOD_C
#   define BN_FAST_MP_MONTGOMERY_REDUCE_C
#   define BN_FAST_S_MP_MUL_DIGS_C
#   define BN_FAST_S_MP_MUL_HIGH_DIGS_C
#   define BN_FAST_S_MP_SQR_C
#   define BN_MP_AND_C
   #define BN_MP_ISEVEN_C
#   define BN_MP_BALANCE_MUL_C
#   define BN_MP_CMP_D_C
#   define BN_MP_EXPORT_C
   #define BN_MP_INIT_MULTI_C
   #define BN_MP_COPY_C
#   define BN_MP_EXPTMOD_FAST_C
#   define BN_MP_EXPT_D_C
#   define BN_MP_EXPT_D_EX_C
#   define BN_MP_EXPT_U32_C
#   define BN_MP_FROM_SBIN_C
#   define BN_MP_FROM_UBIN_C
#   define BN_MP_GET_BIT_C
#   define BN_MP_GET_INT_C
#   define BN_MP_GET_LONG_C
#   define BN_MP_GET_LONG_LONG_C
#   define BN_MP_GET_MAG_U32_C
#   define BN_MP_GET_MAG_ULL_C
#   define BN_MP_GET_MAG_UL_C
#   define BN_MP_IMPORT_C
   #define BN_MP_MOD_C
#   define BN_MP_INIT_SET_INT_C
#   define BN_MP_INIT_U32_C
#   define BN_MP_INVMOD_SLOW_C
#   define BN_MP_JACOBI_C
   #define BN_MP_SET_C
#   define BN_MP_KARATSUBA_MUL_C
#   define BN_MP_KARATSUBA_SQR_C
#   define BN_MP_KRONECKER_C
#   define BN_MP_N_ROOT_C
#   define BN_MP_N_ROOT_EX_C
#   define BN_MP_OR_C
#   define BN_MP_PACK_C
   #define BN_MP_DIV_2_C
   #define BN_MP_ISODD_C
#   define BN_MP_PRIME_IS_DIVISIBLE_C
#   define BN_MP_PRIME_RANDOM_EX_C
#   define BN_MP_RAND_DIGIT_C
#   define BN_MP_READ_SIGNED_BIN_C
#   define BN_MP_READ_UNSIGNED_BIN_C
#   define BN_MP_ROOT_U32_C
#   define BN_MP_SBIN_SIZE_C
#   define BN_MP_SET_INT_C
#   define BN_MP_SET_LONG_C
   #define BN_MP_SUB_C
   #define BN_MP_CMP_C
   #define BN_MP_ISZERO_C
#   define BN_MP_SET_LONG_LONG_C
#   define BN_MP_SET_U32_C
#   define BN_MP_SET_U64_C
   #define BN_MP_CMP_D_C
   #define BN_MP_ADD_C
#   define BN_MP_SIGNED_BIN_SIZE_C
#   define BN_MP_SIGNED_RSH_C
#   define BN_MP_TC_AND_C
#   define BN_MP_TC_DIV_2D_C
#   define BN_MP_TC_OR_C
#   define BN_MP_TC_XOR_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_FAST_MP_MONTGOMERY_REDUCE_C)
   #define BN_MP_GROW_C
#   define BN_MP_TOOM_MUL_C
#   define BN_MP_TOOM_SQR_C
#   define BN_MP_TORADIX_C
#   define BN_MP_TORADIX_N_C
#   define BN_MP_TO_RADIX_C
#   define BN_MP_TO_SBIN_C
#   define BN_MP_TO_SIGNED_BIN_C
#   define BN_MP_TO_SIGNED_BIN_N_C
#   define BN_MP_TO_UBIN_C
#   define BN_MP_TO_UNSIGNED_BIN_C
#   define BN_MP_TO_UNSIGNED_BIN_N_C
#   define BN_MP_UBIN_SIZE_C
#   define BN_MP_UNPACK_C
   #define BN_MP_RSHD_C
   #define BN_MP_CLAMP_C
   #define BN_MP_CMP_MAG_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_FAST_S_MP_MUL_DIGS_C)
   #define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_FAST_S_MP_MUL_HIGH_DIGS_C)
   #define BN_MP_GROW_C
#   define BN_MP_UNSIGNED_BIN_SIZE_C
#   define BN_MP_XOR_C
#   define BN_S_MP_BALANCE_MUL_C
#   define BN_S_MP_EXPTMOD_FAST_C
#   define BN_S_MP_GET_BIT_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_FAST_S_MP_SQR_C)
#   define BN_S_MP_INVMOD_FAST_C
#   define BN_S_MP_INVMOD_SLOW_C
#   define BN_S_MP_KARATSUBA_MUL_C
#   define BN_S_MP_KARATSUBA_SQR_C
#   define BN_S_MP_MONTGOMERY_REDUCE_FAST_C
#   define BN_S_MP_MUL_DIGS_FAST_C
#   define BN_S_MP_MUL_HIGH_DIGS_FAST_C
#   define BN_S_MP_PRIME_IS_DIVISIBLE_C
#   define BN_S_MP_PRIME_RANDOM_EX_C
#   define BN_S_MP_RAND_SOURCE_C
#   define BN_S_MP_REVERSE_C
#   define BN_S_MP_SQR_FAST_C
   #define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
#   define BN_S_MP_TOOM_MUL_C
#   define BN_S_MP_TOOM_SQR_C
#endif

#if defined(BN_MP_2EXPT_C)
#   define BN_MP_GROW_C
#   define BN_MP_ZERO_C
   #define BN_MP_ZERO_C
   #define BN_MP_GROW_C
#endif

#if defined(BN_MP_ABS_C)
#   define BN_MP_COPY_C
   #define BN_MP_COPY_C
#endif

#if defined(BN_MP_ADD_C)
   #define BN_S_MP_ADD_C
#   define BN_MP_CMP_MAG_C
   #define BN_MP_CMP_MAG_C
#   define BN_S_MP_ADD_C
#   define BN_S_MP_SUB_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_MP_ADD_D_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
#   define BN_MP_SUB_D_C
   #define BN_MP_GROW_C
   #define BN_MP_SUB_D_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_MP_ADDMOD_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_INIT_C
#   define BN_MP_MOD_C
   #define BN_MP_INIT_C
   #define BN_MP_ADD_C
   #define BN_MP_CLEAR_C
   #define BN_MP_MOD_C
#endif

#if defined(BN_MP_AND_C)
   #define BN_MP_INIT_COPY_C
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_CLAMP_C)
#endif

#if defined(BN_MP_CLEAR_C)
#endif

#if defined(BN_MP_CLEAR_MULTI_C)
#   define BN_MP_CLEAR_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_CMP_C)
#   define BN_MP_CMP_MAG_C
   #define BN_MP_CMP_MAG_C
#endif

#if defined(BN_MP_CMP_D_C)
#endif

#if defined(BN_MP_CMP_MAG_C)
#endif

#if defined(BN_MP_CNT_LSB_C)
#endif

#if defined(BN_MP_COMPLEMENT_C)
#   define BN_MP_NEG_C
   #define BN_MP_ISZERO_C
#   define BN_MP_SUB_D_C
#endif

#if defined(BN_MP_COPY_C)
#   define BN_MP_GROW_C
   #define BN_MP_GROW_C
#endif

#if defined(BN_MP_COUNT_BITS_C)
#endif

#if defined(BN_MP_DECR_C)
#   define BN_MP_INCR_C
#   define BN_MP_SET_C
#   define BN_MP_SUB_D_C
#   define BN_MP_ZERO_C
#if defined(BN_MP_DIV_C)
   #define BN_MP_ISZERO_C
   #define BN_MP_CMP_MAG_C
   #define BN_MP_COPY_C
   #define BN_MP_ZERO_C
#endif

   #define BN_MP_INIT_MULTI_C
#if defined(BN_MP_DIV_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_COPY_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_LSHD_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_MUL_D_C
#   define BN_MP_RSHD_C
#   define BN_MP_SUB_C
   #define BN_MP_SET_C
   #define BN_MP_COUNT_BITS_C
   #define BN_MP_ABS_C
   #define BN_MP_MUL_2D_C
   #define BN_MP_CMP_C
   #define BN_MP_SUB_C
   #define BN_MP_ADD_C
   #define BN_MP_DIV_2D_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_MULTI_C
   #define BN_MP_INIT_SIZE_C
   #define BN_MP_INIT_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_LSHD_C
   #define BN_MP_RSHD_C
   #define BN_MP_MUL_D_C
   #define BN_MP_CLAMP_C
   #define BN_MP_CLEAR_C
#   define BN_MP_ZERO_C
#endif

#if defined(BN_MP_DIV_2_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_MP_DIV_2D_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_COPY_C
#   define BN_MP_MOD_2D_C
#   define BN_MP_RSHD_C
#   define BN_MP_ZERO_C
   #define BN_MP_COPY_C
   #define BN_MP_ZERO_C
   #define BN_MP_INIT_C
   #define BN_MP_MOD_2D_C
   #define BN_MP_CLEAR_C
   #define BN_MP_RSHD_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
#endif

#if defined(BN_MP_DIV_3_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_SIZE_C
   #define BN_MP_INIT_SIZE_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_DIV_D_C)
#   define BN_MP_CLAMP_C
   #define BN_MP_ISZERO_C
#   define BN_MP_CLEAR_C
#   define BN_MP_COPY_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_DIV_3_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_SIZE_C
   #define BN_MP_COPY_C
   #define BN_MP_DIV_2D_C
   #define BN_MP_DIV_3_C
   #define BN_MP_INIT_SIZE_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_DR_IS_MODULUS_C)
#endif

#if defined(BN_MP_DR_REDUCE_C)
   #define BN_MP_GROW_C
#   define BN_MP_CLAMP_C
#   define BN_MP_CMP_MAG_C
   #define BN_MP_CLAMP_C
   #define BN_MP_CMP_MAG_C
#   define BN_MP_GROW_C
#   define BN_S_MP_SUB_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_MP_DR_SETUP_C)
#endif

#if defined(BN_MP_ERROR_TO_STRING_C)
#endif

#if defined(BN_MP_EXCH_C)
#endif

#if defined(BN_MP_EXPT_U32_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_MUL_C
#   define BN_MP_SET_C
#   define BN_MP_SQR_C
#if defined(BN_MP_EXPT_D_C)
   #define BN_MP_INIT_COPY_C
   #define BN_MP_SET_C
   #define BN_MP_SQR_C
   #define BN_MP_CLEAR_C
   #define BN_MP_MUL_C
#endif

#if defined(BN_MP_EXPTMOD_C)
   #define BN_MP_INIT_C
   #define BN_MP_INVMOD_C
   #define BN_MP_CLEAR_C
#   define BN_MP_ABS_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_DR_IS_MODULUS_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_INVMOD_C
#   define BN_MP_REDUCE_IS_2K_C
#   define BN_MP_REDUCE_IS_2K_L_C
#   define BN_S_MP_EXPTMOD_C
#   define BN_S_MP_EXPTMOD_FAST_C
   #define BN_MP_ABS_C
   #define BN_MP_CLEAR_MULTI_C
   #define BN_MP_REDUCE_IS_2K_L_C
   #define BN_S_MP_EXPTMOD_C
   #define BN_MP_DR_IS_MODULUS_C
   #define BN_MP_REDUCE_IS_2K_C
   #define BN_MP_ISODD_C
   #define BN_MP_EXPTMOD_FAST_C
#endif

#if defined(BN_MP_EXPTMOD_FAST_C)
   #define BN_MP_COUNT_BITS_C
   #define BN_MP_INIT_C
   #define BN_MP_CLEAR_C
   #define BN_MP_MONTGOMERY_SETUP_C
   #define BN_FAST_MP_MONTGOMERY_REDUCE_C
   #define BN_MP_MONTGOMERY_REDUCE_C
   #define BN_MP_DR_SETUP_C
   #define BN_MP_DR_REDUCE_C
   #define BN_MP_REDUCE_2K_SETUP_C
   #define BN_MP_REDUCE_2K_C
   #define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C
   #define BN_MP_MULMOD_C
   #define BN_MP_SET_C
   #define BN_MP_MOD_C
   #define BN_MP_COPY_C
   #define BN_MP_SQR_C
   #define BN_MP_MUL_C
   #define BN_MP_EXCH_C
#endif

#if defined(BN_MP_EXTEUCLID_C)
   #define BN_MP_INIT_MULTI_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_COPY_C
#   define BN_MP_DIV_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_MUL_C
#   define BN_MP_NEG_C
#   define BN_MP_SET_C
#   define BN_MP_SUB_C
   #define BN_MP_SET_C
   #define BN_MP_COPY_C
   #define BN_MP_ISZERO_C
   #define BN_MP_DIV_C
   #define BN_MP_MUL_C
   #define BN_MP_SUB_C
   #define BN_MP_NEG_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_FREAD_C)
#   define BN_MP_ADD_D_C
#   define BN_MP_MUL_D_C
#   define BN_MP_ZERO_C
   #define BN_MP_ZERO_C
#endif

#if defined(BN_MP_FROM_SBIN_C)
#   define BN_MP_FROM_UBIN_C
#endif

#if defined(BN_MP_FROM_UBIN_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_ZERO_C
   #define BN_MP_S_RMAP_C
   #define BN_MP_MUL_D_C
   #define BN_MP_ADD_D_C
   #define BN_MP_CMP_D_C
#endif

#if defined(BN_MP_FWRITE_C)
#   define BN_MP_RADIX_SIZE_C
#   define BN_MP_TO_RADIX_C
   #define BN_MP_RADIX_SIZE_C
   #define BN_MP_TORADIX_C
#endif

#if defined(BN_MP_GCD_C)
   #define BN_MP_ISZERO_C
#   define BN_MP_ABS_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_CNT_LSB_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_EXCH_C
   #define BN_MP_ABS_C
   #define BN_MP_ZERO_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_CNT_LSB_C
   #define BN_MP_DIV_2D_C
   #define BN_MP_CMP_MAG_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_MUL_2D_C
#   define BN_S_MP_SUB_C
   #define BN_MP_EXCH_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_MP_GET_DOUBLE_C)
#endif

#if defined(BN_MP_GET_I32_C)
#   define BN_MP_GET_MAG_U32_C
#endif

#if defined(BN_MP_GET_I64_C)
#   define BN_MP_GET_MAG_U64_C
#endif

#if defined(BN_MP_GET_L_C)
#   define BN_MP_GET_MAG_UL_C
   #define BN_MP_MUL_2D_C
#endif

#if defined(BN_MP_GET_LL_C)
#   define BN_MP_GET_MAG_ULL_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_GET_MAG_U32_C)
#if defined(BN_MP_GET_INT_C)
#endif

#if defined(BN_MP_GET_MAG_U64_C)
#endif

#if defined(BN_MP_GET_MAG_UL_C)
#endif

#if defined(BN_MP_GET_MAG_ULL_C)
#endif

#if defined(BN_MP_GROW_C)
#endif

#if defined(BN_MP_INCR_C)
#   define BN_MP_ADD_D_C
#   define BN_MP_DECR_C
#   define BN_MP_SET_C
#endif

#if defined(BN_MP_INIT_C)
#endif

#if defined(BN_MP_INIT_COPY_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_COPY_C
   #define BN_MP_COPY_C
#   define BN_MP_INIT_SIZE_C
#endif

#if defined(BN_MP_INIT_I32_C)
#   define BN_MP_INIT_C
#if defined(BN_MP_INIT_MULTI_C)
   #define BN_MP_ERR_C
#   define BN_MP_SET_I32_C
#endif

#if defined(BN_MP_INIT_I64_C)
#   define BN_MP_INIT_C
   #define BN_MP_INIT_C
#   define BN_MP_SET_I64_C
#endif

#if defined(BN_MP_INIT_L_C)
#   define BN_MP_INIT_C
#   define BN_MP_SET_L_C
#endif

#if defined(BN_MP_INIT_LL_C)
#   define BN_MP_INIT_C
#   define BN_MP_SET_LL_C
#endif

#if defined(BN_MP_INIT_MULTI_C)
#   define BN_MP_CLEAR_C
   #define BN_MP_CLEAR_C
#   define BN_MP_INIT_C
#endif

#if defined(BN_MP_INIT_SET_C)
#   define BN_MP_INIT_C
#   define BN_MP_SET_C
   #define BN_MP_INIT_C
   #define BN_MP_SET_C
#endif

#if defined(BN_MP_INIT_SIZE_C)
#if defined(BN_MP_INIT_SET_INT_C)
   #define BN_MP_INIT_C
   #define BN_MP_SET_INT_C
#endif

#if defined(BN_MP_INIT_U32_C)
#   define BN_MP_INIT_C
#if defined(BN_MP_INIT_SIZE_C)
   #define BN_MP_INIT_C
#   define BN_MP_SET_U32_C
#endif

#if defined(BN_MP_INIT_U64_C)
#   define BN_MP_INIT_C
#   define BN_MP_SET_U64_C
#if defined(BN_MP_INVMOD_C)
   #define BN_MP_ISZERO_C
   #define BN_MP_ISODD_C
   #define BN_FAST_MP_INVMOD_C
   #define BN_MP_INVMOD_SLOW_C
#endif

#if defined(BN_MP_INIT_UL_C)
#   define BN_MP_INIT_C
#   define BN_MP_SET_UL_C
#if defined(BN_MP_INVMOD_SLOW_C)
   #define BN_MP_ISZERO_C
   #define BN_MP_INIT_MULTI_C
   #define BN_MP_MOD_C
#endif

#if defined(BN_MP_INIT_ULL_C)
#   define BN_MP_INIT_C
#   define BN_MP_SET_ULL_C
   #define BN_MP_COPY_C
   #define BN_MP_ISEVEN_C
   #define BN_MP_SET_C
   #define BN_MP_DIV_2_C
   #define BN_MP_ISODD_C
   #define BN_MP_ADD_C
#endif

#if defined(BN_MP_INVMOD_C)
#   define BN_MP_CMP_D_C
#   define BN_S_MP_INVMOD_FAST_C
#   define BN_S_MP_INVMOD_SLOW_C
   #define BN_MP_SUB_C
   #define BN_MP_CMP_C
   #define BN_MP_CMP_D_C
   #define BN_MP_CMP_MAG_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_IS_SQUARE_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_GET_I32_C
#   define BN_MP_INIT_U32_C
#   define BN_MP_MOD_C
#   define BN_MP_MOD_D_C
#   define BN_MP_SQRT_C
#   define BN_MP_SQR_C
   #define BN_MP_MOD_D_C
   #define BN_MP_INIT_SET_INT_C
   #define BN_MP_MOD_C
   #define BN_MP_GET_INT_C
   #define BN_MP_SQRT_C
   #define BN_MP_SQR_C
   #define BN_MP_CMP_MAG_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_ISEVEN_C)
#if defined(BN_MP_JACOBI_C)
   #define BN_MP_CMP_D_C
   #define BN_MP_ISZERO_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_CNT_LSB_C
   #define BN_MP_DIV_2D_C
   #define BN_MP_MOD_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_ISODD_C)
#if defined(BN_MP_KARATSUBA_MUL_C)
   #define BN_MP_MUL_C
   #define BN_MP_INIT_SIZE_C
   #define BN_MP_CLAMP_C
   #define BN_MP_SUB_C
   #define BN_MP_ADD_C
   #define BN_MP_LSHD_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_KRONECKER_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_D_C
#   define BN_MP_CNT_LSB_C
#   define BN_MP_COPY_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_INIT_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_MOD_C
#if defined(BN_MP_KARATSUBA_SQR_C)
   #define BN_MP_INIT_SIZE_C
   #define BN_MP_CLAMP_C
   #define BN_MP_SQR_C
   #define BN_MP_SUB_C
   #define BN_S_MP_ADD_C
   #define BN_MP_LSHD_C
   #define BN_MP_ADD_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_LCM_C)
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_DIV_C
#   define BN_MP_GCD_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_MUL_C
   #define BN_MP_INIT_MULTI_C
   #define BN_MP_GCD_C
#endif

#if defined(BN_MP_LOG_U32_C)
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
   #define BN_MP_CMP_MAG_C
   #define BN_MP_DIV_C
#   define BN_MP_COPY_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_EXCH_C
#   define BN_MP_EXPT_U32_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_MUL_C
#   define BN_MP_SET_C
   #define BN_MP_MUL_C
   #define BN_MP_CLEAR_MULTI_C
#   define BN_MP_SQR_C
#endif

#if defined(BN_MP_LSHD_C)
#   define BN_MP_GROW_C
   #define BN_MP_GROW_C
   #define BN_MP_RSHD_C
#endif

#if defined(BN_MP_MOD_C)
   #define BN_MP_INIT_C
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_DIV_C
#   define BN_MP_EXCH_C
   #define BN_MP_DIV_C
   #define BN_MP_CLEAR_C
   #define BN_MP_ADD_C
   #define BN_MP_EXCH_C
#   define BN_MP_INIT_SIZE_C
#endif

#if defined(BN_MP_MOD_2D_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_COPY_C
#   define BN_MP_ZERO_C
   #define BN_MP_ZERO_C
   #define BN_MP_COPY_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_MP_MOD_D_C)
#   define BN_MP_DIV_D_C
   #define BN_MP_DIV_D_C
#endif

#if defined(BN_MP_MONTGOMERY_CALC_NORMALIZATION_C)
#   define BN_MP_2EXPT_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_MUL_2_C
#   define BN_MP_SET_C
#   define BN_S_MP_SUB_C
   #define BN_MP_COUNT_BITS_C
   #define BN_MP_2EXPT_C
   #define BN_MP_SET_C
   #define BN_MP_MUL_2_C
   #define BN_MP_CMP_MAG_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_MP_MONTGOMERY_REDUCE_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_GROW_C
#   define BN_MP_RSHD_C
#   define BN_S_MP_MONTGOMERY_REDUCE_FAST_C
#   define BN_S_MP_SUB_C
   #define BN_FAST_MP_MONTGOMERY_REDUCE_C
   #define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
   #define BN_MP_RSHD_C
   #define BN_MP_CMP_MAG_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_MP_MONTGOMERY_SETUP_C)
#endif

#if defined(BN_MP_MUL_C)
#   define BN_S_MP_BALANCE_MUL_C
#   define BN_S_MP_KARATSUBA_MUL_C
#   define BN_S_MP_MUL_DIGS_C
#   define BN_S_MP_MUL_DIGS_FAST_C
#   define BN_S_MP_TOOM_MUL_C
   #define BN_MP_TOOM_MUL_C
   #define BN_MP_KARATSUBA_MUL_C
   #define BN_FAST_S_MP_MUL_DIGS_C
   #define BN_S_MP_MUL_C
   #define BN_S_MP_MUL_DIGS_C
#endif

#if defined(BN_MP_MUL_2_C)
#   define BN_MP_GROW_C
   #define BN_MP_GROW_C
#endif

#if defined(BN_MP_MUL_2D_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_COPY_C
#   define BN_MP_GROW_C
#   define BN_MP_LSHD_C
   #define BN_MP_COPY_C
   #define BN_MP_GROW_C
   #define BN_MP_LSHD_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_MP_MUL_D_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_MP_MULMOD_C)
   #define BN_MP_INIT_C
   #define BN_MP_MUL_C
#   define BN_MP_CLEAR_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_MOD_C
#   define BN_MP_MUL_C
   #define BN_MP_CLEAR_C
   #define BN_MP_MOD_C
#endif

#if defined(BN_MP_N_ROOT_C)
   #define BN_MP_INIT_C
   #define BN_MP_SET_C
   #define BN_MP_COPY_C
   #define BN_MP_EXPT_D_C
   #define BN_MP_MUL_C
   #define BN_MP_SUB_C
   #define BN_MP_MUL_D_C
   #define BN_MP_DIV_C
   #define BN_MP_CMP_C
   #define BN_MP_SUB_D_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_NEG_C)
#   define BN_MP_COPY_C
   #define BN_MP_COPY_C
   #define BN_MP_ISZERO_C
#endif

#if defined(BN_MP_OR_C)
   #define BN_MP_INIT_COPY_C
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
#endif

#if defined(BN_MP_PACK_C)
#   define BN_MP_CLEAR_C
   #define BN_MP_CLEAR_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_PACK_COUNT_C
#endif

#if defined(BN_MP_PACK_COUNT_C)
#   define BN_MP_COUNT_BITS_C
#endif

#if defined(BN_MP_PRIME_FERMAT_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_EXPTMOD_C
#   define BN_MP_INIT_C
   #define BN_MP_CMP_D_C
   #define BN_MP_INIT_C
   #define BN_MP_EXPTMOD_C
   #define BN_MP_CMP_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_PRIME_FROBENIUS_UNDERWOOD_C)
#if defined(BN_MP_PRIME_IS_DIVISIBLE_C)
#   define BN_MP_ADD_C
#   define BN_MP_ADD_D_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_EXCH_C
#   define BN_MP_GCD_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_KRONECKER_C
#   define BN_MP_MOD_C
   #define BN_MP_MOD_D_C
#   define BN_MP_MUL_2_C
#   define BN_MP_MUL_C
#   define BN_MP_MUL_D_C
#   define BN_MP_SET_C
#   define BN_MP_SET_U32_C
#   define BN_MP_SQR_C
#   define BN_MP_SUB_C
#   define BN_MP_SUB_D_C
#   define BN_S_MP_GET_BIT_C
#endif

#if defined(BN_MP_PRIME_IS_PRIME_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
   #define BN_MP_CMP_D_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_INIT_SET_C
#   define BN_MP_IS_SQUARE_C
#   define BN_MP_PRIME_MILLER_RABIN_C
   #define BN_MP_PRIME_IS_DIVISIBLE_C
   #define BN_MP_INIT_C
   #define BN_MP_SET_C
   #define BN_MP_PRIME_MILLER_RABIN_C
#   define BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C
#   define BN_MP_RAND_C
#   define BN_MP_READ_RADIX_C
#   define BN_MP_SET_C
   #define BN_MP_CLEAR_C
#   define BN_S_MP_PRIME_IS_DIVISIBLE_C
#endif

#if defined(BN_MP_PRIME_MILLER_RABIN_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_CNT_LSB_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_EXPTMOD_C
#   define BN_MP_INIT_C
   #define BN_MP_CMP_D_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_SUB_D_C
   #define BN_MP_CNT_LSB_C
   #define BN_MP_DIV_2D_C
   #define BN_MP_EXPTMOD_C
   #define BN_MP_CMP_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_SQRMOD_C
#   define BN_MP_SUB_D_C
   #define BN_MP_SQRMOD_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_PRIME_NEXT_PRIME_C)
#   define BN_MP_ADD_D_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_D_C
#   define BN_MP_INIT_C
#   define BN_MP_MOD_D_C
#   define BN_MP_PRIME_IS_PRIME_C
#   define BN_MP_SET_C
#   define BN_MP_SUB_D_C
   #define BN_MP_CMP_D_C
   #define BN_MP_SET_C
   #define BN_MP_SUB_D_C
   #define BN_MP_ISEVEN_C
   #define BN_MP_MOD_D_C
   #define BN_MP_INIT_C
   #define BN_MP_ADD_D_C
   #define BN_MP_PRIME_MILLER_RABIN_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_PRIME_RABIN_MILLER_TRIALS_C)
#endif

#if defined(BN_MP_PRIME_RAND_C)
#   define BN_MP_ADD_D_C
#if defined(BN_MP_PRIME_RANDOM_EX_C)
   #define BN_MP_READ_UNSIGNED_BIN_C
#   define BN_MP_DIV_2_C
#   define BN_MP_FROM_UBIN_C
#   define BN_MP_MUL_2_C
#   define BN_MP_PRIME_IS_PRIME_C
#   define BN_MP_SUB_D_C
   #define BN_MP_PRIME_IS_PRIME_C
   #define BN_MP_SUB_D_C
#   define BN_S_MP_PRIME_RANDOM_EX_C
#   define BN_S_MP_RAND_CB_C
#   define BN_S_MP_RAND_SOURCE_C
#endif

#if defined(BN_MP_PRIME_STRONG_LUCAS_SELFRIDGE_C)
#   define BN_MP_ADD_C
#   define BN_MP_ADD_D_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_CNT_LSB_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_DIV_2_C
   #define BN_MP_DIV_2_C
#   define BN_MP_GCD_C
#   define BN_MP_INIT_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_KRONECKER_C
#   define BN_MP_MOD_C
#   define BN_MP_MUL_2_C
#   define BN_MP_MUL_C
   #define BN_MP_MUL_2_C
   #define BN_MP_ADD_D_C
#   define BN_MP_SET_C
#   define BN_MP_SET_I32_C
#   define BN_MP_SET_U32_C
#   define BN_MP_SQR_C
#   define BN_MP_SUB_C
#   define BN_MP_SUB_D_C
#   define BN_S_MP_GET_BIT_C
#   define BN_S_MP_MUL_SI_C
#endif

#if defined(BN_MP_RADIX_SIZE_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_D_C
#   define BN_MP_INIT_COPY_C
   #define BN_MP_COUNT_BITS_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_ISZERO_C
   #define BN_MP_DIV_D_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_RADIX_SMAP_C)
   #define BN_MP_S_RMAP_C
#endif

#if defined(BN_MP_RAND_C)
#   define BN_MP_GROW_C
#   define BN_MP_RAND_SOURCE_C
#   define BN_MP_ZERO_C
   #define BN_MP_ZERO_C
   #define BN_MP_ADD_D_C
   #define BN_MP_LSHD_C
#   define BN_S_MP_RAND_PLATFORM_C
#   define BN_S_MP_RAND_SOURCE_C
#endif

#if defined(BN_MP_READ_RADIX_C)
#   define BN_MP_ADD_D_C
#   define BN_MP_MUL_D_C
#   define BN_MP_ZERO_C
   #define BN_MP_ZERO_C
   #define BN_MP_S_RMAP_C
   #define BN_MP_RADIX_SMAP_C
   #define BN_MP_MUL_D_C
   #define BN_MP_ADD_D_C
   #define BN_MP_ISZERO_C
#endif

#if defined(BN_MP_READ_SIGNED_BIN_C)
   #define BN_MP_READ_UNSIGNED_BIN_C
#endif

#if defined(BN_MP_REDUCE_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_LSHD_C
#   define BN_MP_MOD_2D_C
#   define BN_MP_MUL_C
#   define BN_MP_RSHD_C
#   define BN_MP_SET_C
#   define BN_MP_SUB_C
#   define BN_S_MP_MUL_DIGS_C
#   define BN_S_MP_MUL_HIGH_DIGS_C
#   define BN_S_MP_MUL_HIGH_DIGS_FAST_C
#   define BN_S_MP_SUB_C
#if defined(BN_MP_READ_UNSIGNED_BIN_C)
   #define BN_MP_GROW_C
   #define BN_MP_ZERO_C
   #define BN_MP_MUL_2D_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_MP_REDUCE_C)
   #define BN_MP_REDUCE_SETUP_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_RSHD_C
   #define BN_MP_MUL_C
   #define BN_S_MP_MUL_HIGH_DIGS_C
   #define BN_FAST_S_MP_MUL_HIGH_DIGS_C
   #define BN_MP_MOD_2D_C
   #define BN_S_MP_MUL_DIGS_C
   #define BN_MP_SUB_C
   #define BN_MP_CMP_D_C
   #define BN_MP_SET_C
   #define BN_MP_LSHD_C
   #define BN_MP_ADD_C
   #define BN_MP_CMP_C
   #define BN_S_MP_SUB_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_REDUCE_2K_C)
#   define BN_MP_CLEAR_C
   #define BN_MP_INIT_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_2D_C
   #define BN_MP_COUNT_BITS_C
   #define BN_MP_DIV_2D_C
#   define BN_MP_INIT_C
#   define BN_MP_MUL_D_C
#   define BN_S_MP_ADD_C
#   define BN_S_MP_SUB_C
   #define BN_MP_MUL_D_C
   #define BN_S_MP_ADD_C
   #define BN_MP_CMP_MAG_C
   #define BN_S_MP_SUB_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_REDUCE_2K_L_C)
#   define BN_MP_CLEAR_C
   #define BN_MP_INIT_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_2D_C
   #define BN_MP_COUNT_BITS_C
   #define BN_MP_DIV_2D_C
#   define BN_MP_INIT_C
#   define BN_MP_MUL_C
#   define BN_S_MP_ADD_C
#   define BN_S_MP_SUB_C
   #define BN_MP_MUL_C
   #define BN_S_MP_ADD_C
   #define BN_MP_CMP_MAG_C
   #define BN_S_MP_SUB_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_REDUCE_2K_SETUP_C)
#   define BN_MP_2EXPT_C
#   define BN_MP_CLEAR_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_INIT_C
#   define BN_S_MP_SUB_C
   #define BN_MP_INIT_C
   #define BN_MP_COUNT_BITS_C
   #define BN_MP_2EXPT_C
   #define BN_MP_CLEAR_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_MP_REDUCE_2K_SETUP_L_C)
#   define BN_MP_2EXPT_C
#   define BN_MP_CLEAR_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_INIT_C
#   define BN_S_MP_SUB_C
   #define BN_MP_INIT_C
   #define BN_MP_2EXPT_C
   #define BN_MP_COUNT_BITS_C
   #define BN_S_MP_SUB_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_REDUCE_IS_2K_C)
   #define BN_MP_REDUCE_2K_C
#   define BN_MP_COUNT_BITS_C
   #define BN_MP_COUNT_BITS_C
#endif

#if defined(BN_MP_REDUCE_IS_2K_L_C)
#endif

#if defined(BN_MP_REDUCE_SETUP_C)
#   define BN_MP_2EXPT_C
#   define BN_MP_DIV_C
   #define BN_MP_2EXPT_C
   #define BN_MP_DIV_C
#endif

#if defined(BN_MP_ROOT_U32_C)
#   define BN_MP_2EXPT_C
#   define BN_MP_ADD_D_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
#   define BN_MP_COPY_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DIV_C
#   define BN_MP_EXCH_C
#   define BN_MP_EXPT_U32_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_MUL_C
#   define BN_MP_MUL_D_C
#   define BN_MP_SET_C
#   define BN_MP_SUB_C
#   define BN_MP_SUB_D_C
#endif

#if defined(BN_MP_RSHD_C)
#   define BN_MP_ZERO_C
   #define BN_MP_ZERO_C
#endif

#if defined(BN_MP_SBIN_SIZE_C)
#   define BN_MP_UBIN_SIZE_C
#if defined(BN_MP_SET_C)
   #define BN_MP_ZERO_C
#endif

#if defined(BN_MP_SET_C)
#endif

#if defined(BN_MP_SET_DOUBLE_C)
#   define BN_MP_DIV_2D_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_SET_U64_C
#if defined(BN_MP_SET_INT_C)
   #define BN_MP_ZERO_C
   #define BN_MP_MUL_2D_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_MP_SET_I32_C)
#   define BN_MP_SET_U32_C
#endif

#if defined(BN_MP_SET_I64_C)
#   define BN_MP_SET_U64_C
#endif

#if defined(BN_MP_SET_L_C)
#   define BN_MP_SET_UL_C
#endif

#if defined(BN_MP_SET_LL_C)
#   define BN_MP_SET_ULL_C
#endif

#if defined(BN_MP_SET_U32_C)
#endif

#if defined(BN_MP_SET_U64_C)
#endif

#if defined(BN_MP_SET_UL_C)
#endif

#if defined(BN_MP_SET_ULL_C)
#endif

#if defined(BN_MP_SHRINK_C)
#endif

#if defined(BN_MP_SIGNED_RSH_C)
#   define BN_MP_ADD_D_C
#if defined(BN_MP_SIGNED_BIN_SIZE_C)
   #define BN_MP_UNSIGNED_BIN_SIZE_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_SUB_D_C
#endif

#if defined(BN_MP_SQR_C)
   #define BN_MP_TOOM_SQR_C
#   define BN_S_MP_KARATSUBA_SQR_C
#   define BN_S_MP_SQR_C
#   define BN_S_MP_SQR_FAST_C
   #define BN_MP_KARATSUBA_SQR_C
   #define BN_FAST_S_MP_SQR_C
   #define BN_S_MP_SQR_C
#   define BN_S_MP_TOOM_SQR_C
#endif

#if defined(BN_MP_SQRMOD_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_INIT_C
#   define BN_MP_MOD_C
#   define BN_MP_SQR_C
   #define BN_MP_INIT_C
   #define BN_MP_SQR_C
   #define BN_MP_CLEAR_C
   #define BN_MP_MOD_C
#endif

#if defined(BN_MP_SQRT_C)
#   define BN_MP_ADD_C
   #define BN_MP_N_ROOT_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_DIV_2_C
#   define BN_MP_DIV_C
#   define BN_MP_EXCH_C
   #define BN_MP_ISZERO_C
   #define BN_MP_ZERO_C
#   define BN_MP_INIT_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_RSHD_C
#   define BN_MP_ZERO_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_RSHD_C
   #define BN_MP_DIV_C
#endif

#if defined(BN_MP_SQRTMOD_PRIME_C)
#   define BN_MP_ADD_D_C
   #define BN_MP_ADD_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_D_C
#   define BN_MP_COPY_C
#   define BN_MP_DIV_2_C
   #define BN_MP_DIV_2_C
#   define BN_MP_EXPTMOD_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_KRONECKER_C
#   define BN_MP_MOD_D_C
#   define BN_MP_MULMOD_C
#   define BN_MP_SET_C
   #define BN_MP_CMP_MAG_C
#   define BN_MP_SET_U32_C
#   define BN_MP_SQRMOD_C
#   define BN_MP_SUB_D_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_C
#   define BN_MP_ZERO_C
#endif

#if defined(BN_MP_SUB_C)
   #define BN_S_MP_ADD_C
#   define BN_MP_CMP_MAG_C
   #define BN_MP_CMP_MAG_C
#   define BN_S_MP_ADD_C
#   define BN_S_MP_SUB_C
   #define BN_S_MP_SUB_C
#endif

#if defined(BN_MP_SUB_D_C)
   #define BN_MP_GROW_C
#   define BN_MP_ADD_D_C
#   define BN_MP_CLAMP_C
   #define BN_MP_ADD_D_C
   #define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
#endif

#if defined(BN_MP_SUBMOD_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_INIT_C
#   define BN_MP_MOD_C
#   define BN_MP_SUB_C
   #define BN_MP_INIT_C
   #define BN_MP_SUB_C
   #define BN_MP_CLEAR_C
   #define BN_MP_MOD_C
#endif

#if defined(BN_MP_TO_SIGNED_BIN_C)
   #define BN_MP_TO_UNSIGNED_BIN_C
#endif

#if defined(BN_MP_TO_RADIX_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_DIV_D_C
#   define BN_MP_INIT_COPY_C
#   define BN_S_MP_REVERSE_C
#if defined(BN_MP_TO_SIGNED_BIN_N_C)
   #define BN_MP_SIGNED_BIN_SIZE_C
   #define BN_MP_TO_SIGNED_BIN_C
#endif

#if defined(BN_MP_TO_UNSIGNED_BIN_C)
   #define BN_MP_INIT_COPY_C
   #define BN_MP_ISZERO_C
   #define BN_MP_DIV_2D_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_TO_SBIN_C)
#   define BN_MP_TO_UBIN_C
#if defined(BN_MP_TO_UNSIGNED_BIN_N_C)
   #define BN_MP_UNSIGNED_BIN_SIZE_C
   #define BN_MP_TO_UNSIGNED_BIN_C
#endif

#if defined(BN_MP_TO_UBIN_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_DIV_2D_C
#   define BN_MP_INIT_COPY_C
#   define BN_MP_UBIN_SIZE_C
#if defined(BN_MP_TOOM_MUL_C)
   #define BN_MP_INIT_MULTI_C
   #define BN_MP_MOD_2D_C
   #define BN_MP_COPY_C
   #define BN_MP_RSHD_C
   #define BN_MP_MUL_C
   #define BN_MP_MUL_2_C
   #define BN_MP_ADD_C
   #define BN_MP_SUB_C
   #define BN_MP_DIV_2_C
   #define BN_MP_MUL_2D_C
   #define BN_MP_MUL_D_C
   #define BN_MP_DIV_3_C
   #define BN_MP_LSHD_C
   #define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_TOOM_SQR_C)
   #define BN_MP_INIT_MULTI_C
   #define BN_MP_MOD_2D_C
   #define BN_MP_COPY_C
   #define BN_MP_RSHD_C
   #define BN_MP_SQR_C
   #define BN_MP_MUL_2_C
   #define BN_MP_ADD_C
   #define BN_MP_SUB_C
   #define BN_MP_DIV_2_C
   #define BN_MP_MUL_2D_C
   #define BN_MP_MUL_D_C
   #define BN_MP_DIV_3_C
   #define BN_MP_LSHD_C
   #define BN_MP_CLEAR_MULTI_C
#endif

#if defined(BN_MP_UBIN_SIZE_C)
#   define BN_MP_COUNT_BITS_C
#if defined(BN_MP_TORADIX_C)
   #define BN_MP_ISZERO_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_DIV_D_C
   #define BN_MP_CLEAR_C
   #define BN_MP_S_RMAP_C
#endif

#if defined(BN_MP_UNPACK_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_MUL_2D_C
#   define BN_MP_ZERO_C
#if defined(BN_MP_TORADIX_N_C)
   #define BN_MP_ISZERO_C
   #define BN_MP_INIT_COPY_C
   #define BN_MP_DIV_D_C
   #define BN_MP_CLEAR_C
   #define BN_MP_S_RMAP_C
#endif

#if defined(BN_MP_UNSIGNED_BIN_SIZE_C)
   #define BN_MP_COUNT_BITS_C
#endif

#if defined(BN_MP_XOR_C)
   #define BN_MP_INIT_COPY_C
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_MP_ZERO_C)
#endif

#if defined(BN_PRIME_TAB_C)
#endif

#if defined(BN_S_MP_ADD_C)
#if defined(BN_REVERSE_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
#endif

#if defined(BN_S_MP_BALANCE_MUL_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLAMP_C
#if defined(BN_S_MP_ADD_C)
   #define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_LSHD_C
#   define BN_MP_MUL_C
#endif

#if defined(BN_S_MP_EXPTMOD_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_COPY_C
#   define BN_MP_COUNT_BITS_C
   #define BN_MP_COUNT_BITS_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_C
#   define BN_MP_MOD_C
#   define BN_MP_MUL_C
#   define BN_MP_REDUCE_2K_L_C
#   define BN_MP_REDUCE_2K_SETUP_L_C
#   define BN_MP_REDUCE_C
#   define BN_MP_REDUCE_SETUP_C
#   define BN_MP_SET_C
#   define BN_MP_SQR_C
#endif

#if defined(BN_S_MP_EXPTMOD_FAST_C)
#   define BN_MP_CLEAR_C
#   define BN_MP_COPY_C
#   define BN_MP_COUNT_BITS_C
#   define BN_MP_DR_REDUCE_C
#   define BN_MP_DR_SETUP_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_MOD_C
#   define BN_MP_MONTGOMERY_CALC_NORMALIZATION_C
#   define BN_MP_MONTGOMERY_REDUCE_C
#   define BN_MP_MONTGOMERY_SETUP_C
#   define BN_MP_MULMOD_C
#   define BN_MP_MUL_C
#   define BN_MP_REDUCE_2K_C
#   define BN_MP_REDUCE_2K_SETUP_C
#   define BN_MP_SET_C
#   define BN_MP_SQR_C
#   define BN_S_MP_MONTGOMERY_REDUCE_FAST_C
#endif

#if defined(BN_S_MP_GET_BIT_C)
#endif

#if defined(BN_S_MP_INVMOD_FAST_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_COPY_C
#   define BN_MP_DIV_2_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_MULTI_C
   #define BN_MP_INIT_C
#   define BN_MP_MOD_C
#   define BN_MP_SET_C
#   define BN_MP_SUB_C
#endif

#if defined(BN_S_MP_INVMOD_SLOW_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_CMP_C
   #define BN_MP_CLEAR_C
   #define BN_MP_REDUCE_SETUP_C
#   define BN_MP_CMP_D_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_COPY_C
#   define BN_MP_DIV_2_C
#   define BN_MP_EXCH_C
   #define BN_MP_REDUCE_C
   #define BN_MP_REDUCE_2K_SETUP_L_C
   #define BN_MP_REDUCE_2K_L_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_MOD_C
#   define BN_MP_SET_C
#   define BN_MP_SUB_C
   #define BN_MP_MOD_C
   #define BN_MP_COPY_C
   #define BN_MP_SQR_C
#endif

#if defined(BN_S_MP_KARATSUBA_MUL_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_LSHD_C
#   define BN_MP_MUL_C
   #define BN_MP_MUL_C
#   define BN_S_MP_ADD_C
#   define BN_S_MP_SUB_C
#endif

#if defined(BN_S_MP_KARATSUBA_SQR_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_LSHD_C
#   define BN_MP_SQR_C
   #define BN_MP_SET_C
#   define BN_S_MP_ADD_C
#   define BN_S_MP_SUB_C
#endif

#if defined(BN_S_MP_MONTGOMERY_REDUCE_FAST_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_CMP_MAG_C
#   define BN_MP_GROW_C
   #define BN_MP_EXCH_C
#   define BN_S_MP_SUB_C
#endif

#if defined(BN_S_MP_MUL_DIGS_C)
#   define BN_MP_CLAMP_C
   #define BN_FAST_S_MP_MUL_DIGS_C
#   define BN_MP_CLEAR_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_SIZE_C
#   define BN_S_MP_MUL_DIGS_FAST_C
   #define BN_MP_INIT_SIZE_C
   #define BN_MP_CLAMP_C
#endif

#if defined(BN_S_MP_MUL_DIGS_FAST_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_EXCH_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_S_MP_MUL_HIGH_DIGS_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_EXCH_C
#   define BN_MP_INIT_SIZE_C
   #define BN_FAST_S_MP_MUL_HIGH_DIGS_C
   #define BN_MP_INIT_SIZE_C
#   define BN_S_MP_MUL_HIGH_DIGS_FAST_C
#endif

#if defined(BN_S_MP_MUL_HIGH_DIGS_FAST_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
#endif

#if defined(BN_S_MP_PRIME_IS_DIVISIBLE_C)
#   define BN_MP_MOD_D_C
   #define BN_MP_CLEAR_C
#endif

#if defined(BN_S_MP_RAND_JENKINS_C)
#   define BN_S_MP_RAND_JENKINS_INIT_C
#endif

#if defined(BN_S_MP_RAND_PLATFORM_C)
#endif

#if defined(BN_S_MP_REVERSE_C)
#endif

#if defined(BN_S_MP_SQR_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_EXCH_C
   #define BN_MP_INIT_SIZE_C
   #define BN_MP_CLAMP_C
   #define BN_MP_EXCH_C
#   define BN_MP_INIT_SIZE_C
#endif

#if defined(BN_S_MP_SQR_FAST_C)
#   define BN_MP_CLAMP_C
   #define BN_MP_CLEAR_C
#   define BN_MP_GROW_C
#endif

#if defined(BN_S_MP_SUB_C)
#   define BN_MP_CLAMP_C
#   define BN_MP_GROW_C
   #define BN_MP_GROW_C
#endif

#if defined(BN_S_MP_TOOM_MUL_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLAMP_C
   #define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_DIV_2_C
#   define BN_MP_DIV_3_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_LSHD_C
#   define BN_MP_MUL_2_C
#   define BN_MP_MUL_C
#   define BN_MP_SUB_C
#endif

#if defined(BN_S_MP_TOOM_SQR_C)
#if defined(BNCORE_C)
#   define BN_MP_ADD_C
#   define BN_MP_CLAMP_C
#   define BN_MP_CLEAR_C
#   define BN_MP_DIV_2_C
#   define BN_MP_INIT_C
#   define BN_MP_INIT_SIZE_C
#   define BN_MP_LSHD_C
#   define BN_MP_MUL_2_C
#   define BN_MP_MUL_C
#   define BN_MP_SQR_C
#   define BN_MP_SUB_C
#endif

#ifdef LTM_INSIDE
#undef LTM_INSIDE
#ifdef LTM3
#   define LTM_LAST
#define LTM_LAST
#endif

#include "tommath_superclass.h"
#include "tommath_class.h"
#include <tommath_superclass.h>
#include <tommath_class.h>
#else
#   define LTM_LAST
#define LTM_LAST
#endif

Deleted libtommath/tommath_cutoffs.h.

1
2
3
4
5
6
7
8
9
10
11
12
13













-
-
-
-
-
-
-
-
-
-
-
-
-
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */
/*
   Current values evaluated on an AMD A8-6600K (64-bit).
   Type "make tune" to optimize them for your machine but
   be aware that it may take a long time. It took 2:30 minutes
   on the aforementioned machine for example.
 */

#define MP_DEFAULT_KARATSUBA_MUL_CUTOFF 80
#define MP_DEFAULT_KARATSUBA_SQR_CUTOFF 120
#define MP_DEFAULT_TOOM_MUL_CUTOFF      350
#define MP_DEFAULT_TOOM_SQR_CUTOFF      400

Deleted libtommath/tommath_private.h.

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





























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

#ifndef TOMMATH_PRIV_H_
#define TOMMATH_PRIV_H_

#ifdef MP_NO_STDINT
#ifdef HAVE_STDINT_H
#  include <stdint.h>
#else
#  include "../compat/stdint.h"
#endif
#endif
#include "tclTomMath.h"
#include "tommath_class.h"

/*
 * Private symbols
 * ---------------
 *
 * On Unix symbols can be marked as hidden if libtommath is compiled
 * as a shared object. By default, symbols are visible.
 * As of now, this feature is opt-in via the MP_PRIVATE_SYMBOLS define.
 *
 * On Win32 a .def file must be used to specify the exported symbols.
 */
#if defined (MP_PRIVATE_SYMBOLS) && defined(__GNUC__) && __GNUC__ >= 4
#   define MP_PRIVATE __attribute__ ((visibility ("hidden")))
#else
#   define MP_PRIVATE
#endif

/* Hardening libtommath
 * --------------------
 *
 * By default memory is zeroed before calling
 * MP_FREE to avoid leaking data. This is good
 * practice in cryptographical applications.
 *
 * Note however that memory allocators used
 * in cryptographical applications can often
 * be configured by itself to clear memory,
 * rendering the clearing in tommath unnecessary.
 * See for example https://github.com/GrapheneOS/hardened_malloc
 * and the option CONFIG_ZERO_ON_FREE.
 *
 * Furthermore there are applications which
 * value performance more and want this
 * feature to be disabled. For such applications
 * define MP_NO_ZERO_ON_FREE during compilation.
 */
#ifdef MP_NO_ZERO_ON_FREE
#  define MP_FREE_BUFFER(mem, size)   MP_FREE((mem), (size))
#  define MP_FREE_DIGITS(mem, digits) MP_FREE((mem), sizeof (mp_digit) * (size_t)(digits))
#else
#  define MP_FREE_BUFFER(mem, size)                     \
do {                                                    \
   size_t fs_ = (size);                                 \
   void* fm_ = (mem);                                   \
   if (fm_ != NULL) {                                   \
      MP_ZERO_BUFFER(fm_, fs_);                         \
      MP_FREE(fm_, fs_);                                \
   }                                                    \
} while (0)
#  define MP_FREE_DIGITS(mem, digits)                   \
do {                                                    \
   int fd_ = (digits);                                  \
   void* fm_ = (mem);                                   \
   if (fm_ != NULL) {                                   \
      size_t fs_ = sizeof (mp_digit) * (size_t)fd_;     \
      MP_ZERO_BUFFER(fm_, fs_);                         \
      MP_FREE(fm_, fs_);                                \
   }                                                    \
} while (0)
#endif

#ifdef MP_USE_MEMSET
#  include <string.h>
#  define MP_ZERO_BUFFER(mem, size)   memset((mem), 0, (size))
#  define MP_ZERO_DIGITS(mem, digits)                   \
do {                                                    \
   int zd_ = (digits);                                  \
   if (zd_ > 0) {                                       \
      memset((mem), 0, sizeof(mp_digit) * (size_t)zd_); \
   }                                                    \
} while (0)
#else
#  define MP_ZERO_BUFFER(mem, size)                     \
do {                                                    \
   size_t zs_ = (size);                                 \
   char* zm_ = (char*)(mem);                            \
   while (zs_-- > 0u) {                                 \
      *zm_++ = '\0';                                    \
   }                                                    \
} while (0)
#  define MP_ZERO_DIGITS(mem, digits)                   \
do {                                                    \
   int zd_ = (digits);                                  \
   mp_digit* zm_ = (mem);                               \
   while (zd_-- > 0) {                                  \
      *zm_++ = 0;                                       \
   }                                                    \
} while (0)
#endif

/* Tunable cutoffs
 * ---------------
 *
 *  - In the default settings, a cutoff X can be modified at runtime
 *    by adjusting the corresponding X_CUTOFF variable.
 *
 *  - Tunability of the library can be disabled at compile time
 *    by defining the MP_FIXED_CUTOFFS macro.
 *
 *  - There is an additional file tommath_cutoffs.h, which defines
 *    the default cutoffs. These can be adjusted manually or by the
 *    autotuner.
 *
 */

#ifdef MP_FIXED_CUTOFFS
#  include "tommath_cutoffs.h"
#  define MP_KARATSUBA_MUL_CUTOFF MP_DEFAULT_KARATSUBA_MUL_CUTOFF
#  define MP_KARATSUBA_SQR_CUTOFF MP_DEFAULT_KARATSUBA_SQR_CUTOFF
#  define MP_TOOM_MUL_CUTOFF      MP_DEFAULT_TOOM_MUL_CUTOFF
#  define MP_TOOM_SQR_CUTOFF      MP_DEFAULT_TOOM_SQR_CUTOFF
#else
#  define MP_KARATSUBA_MUL_CUTOFF KARATSUBA_MUL_CUTOFF
#  define MP_KARATSUBA_SQR_CUTOFF KARATSUBA_SQR_CUTOFF
#  define MP_TOOM_MUL_CUTOFF      TOOM_MUL_CUTOFF
#  define MP_TOOM_SQR_CUTOFF      TOOM_SQR_CUTOFF
#endif

/* define heap macros */
#ifndef MP_MALLOC
/* default to libc stuff */
#   include <stdlib.h>
#   define MP_MALLOC(size)                   malloc(size)
#   define MP_REALLOC(mem, oldsize, newsize) realloc((mem), (newsize))
#   define MP_CALLOC(nmemb, size)            calloc((nmemb), (size))
#   define MP_FREE(mem, size)                free(mem)
#elif 0
/* prototypes for our heap functions */
extern void *MP_MALLOC(size_t size);
extern void *MP_REALLOC(void *mem, size_t oldsize, size_t newsize);
extern void *MP_CALLOC(size_t nmemb, size_t size);
extern void MP_FREE(void *mem, size_t size);
#endif

/* feature detection macro */
#ifdef _MSC_VER
/* Prevent false positive: not enough arguments for function-like macro invocation */
#pragma warning(disable: 4003)
#endif
#define MP_STRINGIZE(x)  MP__STRINGIZE(x)
#define MP__STRINGIZE(x) ""#x""
#define MP_HAS(x)        (sizeof(MP_STRINGIZE(BN_##x##_C)) == 1u)

/* TODO: Remove private_mp_word as soon as deprecated mp_word is removed from tommath. */
#if !defined(MP_64BIT) || defined(__GNUC__)
#undef mp_word
typedef private_mp_word mp_word;
#endif

#define MP_MIN(x, y) (((x) < (y)) ? (x) : (y))
#define MP_MAX(x, y) (((x) > (y)) ? (x) : (y))

/* Static assertion */
#define MP_STATIC_ASSERT(msg, cond) typedef char mp_static_assert_##msg[(cond) ? 1 : -1];

/* ---> Basic Manipulations <--- */
#define MP_IS_ZERO(a) ((a)->used == 0)
#define MP_IS_EVEN(a) (((a)->used == 0) || (((a)->dp[0] & 1u) == 0u))
#define MP_IS_ODD(a)  (((a)->used > 0) && (((a)->dp[0] & 1u) == 1u))

#define MP_SIZEOF_BITS(type)    ((size_t)CHAR_BIT * sizeof(type))
#define MP_MAXFAST              (int)(1uL << (MP_SIZEOF_BITS(mp_word) - (2u * (size_t)MP_DIGIT_BIT)))

/* TODO: Remove PRIVATE_MP_WARRAY as soon as deprecated MP_WARRAY is removed from tommath.h */
#undef MP_WARRAY
#define MP_WARRAY PRIVATE_MP_WARRAY

/* TODO: Remove PRIVATE_MP_PREC as soon as deprecated MP_PREC is removed from tommath.h */
#ifdef PRIVATE_MP_PREC
#   undef MP_PREC
#   define MP_PREC PRIVATE_MP_PREC
#endif

/* Minimum number of available digits in mp_int, MP_PREC >= MP_MIN_PREC */
#define MP_MIN_PREC ((((int)MP_SIZEOF_BITS(uintmax_t) + MP_DIGIT_BIT) - 1) / MP_DIGIT_BIT)

MP_STATIC_ASSERT(prec_geq_min_prec, MP_PREC >= MP_MIN_PREC)

/* random number source */
extern MP_PRIVATE mp_err(*s_mp_rand_source)(void *out, size_t size);

/* lowlevel functions, do not call! */
MP_PRIVATE mp_bool s_mp_get_bit(const mp_int *a, unsigned int b);
MP_PRIVATE mp_err s_mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_mul_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR;
MP_PRIVATE mp_err s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR;
MP_PRIVATE mp_err s_mp_mul_high_digs_fast(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR;
MP_PRIVATE mp_err s_mp_mul_high_digs(const mp_int *a, const mp_int *b, mp_int *c, int digs) MP_WUR;
MP_PRIVATE mp_err s_mp_sqr_fast(const mp_int *a, mp_int *b) MP_WUR;
MP_PRIVATE mp_err s_mp_sqr(const mp_int *a, mp_int *b) MP_WUR;
MP_PRIVATE mp_err s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_karatsuba_sqr(const mp_int *a, mp_int *b) MP_WUR;
MP_PRIVATE mp_err s_mp_toom_sqr(const mp_int *a, mp_int *b) MP_WUR;
MP_PRIVATE mp_err s_mp_invmod_fast(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
MP_PRIVATE mp_err s_mp_montgomery_reduce_fast(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR;
MP_PRIVATE mp_err s_mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR;
MP_PRIVATE mp_err s_mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y, int redmode) MP_WUR;
MP_PRIVATE mp_err s_mp_rand_platform(void *p, size_t n) MP_WUR;
MP_PRIVATE mp_err s_mp_prime_random_ex(mp_int *a, int t, int size, int flags, private_mp_prime_callback cb, void *dat);
MP_PRIVATE void s_mp_reverse(unsigned char *s, size_t len);
MP_PRIVATE mp_err s_mp_prime_is_divisible(const mp_int *a, mp_bool *result);

/* TODO: jenkins prng is not thread safe as of now */
MP_PRIVATE mp_err s_mp_rand_jenkins(void *p, size_t n) MP_WUR;
MP_PRIVATE void s_mp_rand_jenkins_init(uint64_t seed);

extern MP_PRIVATE const char *const mp_s_rmap;
extern MP_PRIVATE const uint8_t mp_s_rmap_reverse[];
extern MP_PRIVATE const size_t mp_s_rmap_reverse_sz;
extern MP_PRIVATE const mp_digit *s_mp_prime_tab;

/* deprecated functions */
MP_DEPRECATED(s_mp_invmod_fast) mp_err fast_mp_invmod(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_montgomery_reduce_fast) mp_err fast_mp_montgomery_reduce(mp_int *x, const mp_int *n,
      mp_digit rho);
MP_DEPRECATED(s_mp_mul_digs_fast) mp_err fast_s_mp_mul_digs(const mp_int *a, const mp_int *b, mp_int *c,
      int digs);
MP_DEPRECATED(s_mp_mul_high_digs_fast) mp_err fast_s_mp_mul_high_digs(const mp_int *a, const mp_int *b,
      mp_int *c,
      int digs);
MP_DEPRECATED(s_mp_sqr_fast) mp_err fast_s_mp_sqr(const mp_int *a, mp_int *b);
MP_DEPRECATED(s_mp_balance_mul) mp_err mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_exptmod_fast) mp_err mp_exptmod_fast(const mp_int *G, const mp_int *X, const mp_int *P,
      mp_int *Y,
      int redmode);
MP_DEPRECATED(s_mp_invmod_slow) mp_err mp_invmod_slow(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_karatsuba_mul) mp_err mp_karatsuba_mul(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_karatsuba_sqr) mp_err mp_karatsuba_sqr(const mp_int *a, mp_int *b);
MP_DEPRECATED(s_mp_toom_mul) mp_err mp_toom_mul(const mp_int *a, const mp_int *b, mp_int *c);
MP_DEPRECATED(s_mp_toom_sqr) mp_err mp_toom_sqr(const mp_int *a, mp_int *b);
MP_DEPRECATED(s_mp_reverse) void bn_reverse(unsigned char *s, int len);

#ifndef TCL_WITH_EXTERNAL_TOMMATH
#undef mp_sqr
#define mp_sqr TclBN_mp_sqr
#endif

#define MP_GET_ENDIANNESS(x) \
   do{\
      int16_t n = 0x1;                                          \
      char *p = (char *)&n;                                     \
      x = (p[0] == '\x01') ? MP_LITTLE_ENDIAN : MP_BIG_ENDIAN;  \
   } while (0)

/* code-generating macros */
#define MP_SET_UNSIGNED(name, type)                                                    \
    void name(mp_int * a, type b)                                                      \
    {                                                                                  \
        int i = 0;                                                                     \
        while (b != 0u) {                                                              \
            a->dp[i++] = ((mp_digit)b & MP_MASK);                                      \
            if (MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) { break; }                       \
            b >>= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT);         \
        }                                                                              \
        a->used = i;                                                                   \
        a->sign = MP_ZPOS;                                                             \
        MP_ZERO_DIGITS(a->dp + a->used, a->alloc - a->used);                           \
    }

#define MP_SET_SIGNED(name, uname, type, utype)          \
    void name(mp_int * a, type b)                        \
    {                                                    \
        uname(a, (b < 0) ? -(utype)b : (utype)b);        \
        if (b < 0) { a->sign = MP_NEG; }                 \
    }

#define MP_INIT_INT(name , set, type)                    \
    mp_err name(mp_int * a, type b)                      \
    {                                                    \
        mp_err err;                                      \
        if ((err = mp_init(a)) != MP_OKAY) {             \
            return err;                                  \
        }                                                \
        set(a, b);                                       \
        return MP_OKAY;                                  \
    }

#define MP_GET_MAG(name, type)                                                         \
    type name(const mp_int* a)                                                         \
    {                                                                                  \
        unsigned i = MP_MIN((unsigned)a->used, (unsigned)((MP_SIZEOF_BITS(type) + MP_DIGIT_BIT - 1) / MP_DIGIT_BIT)); \
        type res = 0u;                                                                 \
        while (i --> 0u) {                                                             \
            res <<= ((MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) ? 0 : MP_DIGIT_BIT);       \
            res |= (type)a->dp[i];                                                     \
            if (MP_SIZEOF_BITS(type) <= MP_DIGIT_BIT) { break; }                       \
        }                                                                              \
        return res;                                                                    \
    }

#define MP_GET_SIGNED(name, mag, type, utype)                 \
    type name(const mp_int* a)                                \
    {                                                         \
        utype res = mag(a);                                   \
        return (a->sign == MP_NEG) ? (type)-res : (type)res;  \
    }

#endif

Changes to libtommath/tommath_superclass.h.

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



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
-
-
-



-

-



-







+
-
+
-
-
-
-
+
-
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
+
-
-
-
+
-

-
-
+
+
-

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
+
-
-
-

-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+


/* LibTomMath, multiple-precision integer library -- Tom St Denis */
/* SPDX-License-Identifier: Unlicense */

/* super class file for PK algos */

/* default ... include all MPI */
#ifndef LTM_NOTHING
#define LTM_ALL
#endif

/* RSA only (does not support DH/DSA/ECC) */
/* #define SC_RSA_1 */
/* #define SC_RSA_1_WITH_TESTS */

/* For reference.... On an Athlon64 optimizing for speed...

   LTM's mpi.o with all functions [striped] is 142KiB in size.

*/

/* Works for RSA only, mpi.o is 68KiB */
#ifdef SC_RSA_1_WITH_TESTS
#ifdef SC_RSA_1
#   define BN_MP_ERROR_TO_STRING_C
#   define BN_MP_FREAD_C
#   define BN_MP_FWRITE_C
#   define BN_MP_INCR_C
   #define BN_MP_SHRINK_C
#   define BN_MP_ISEVEN_C
#   define BN_MP_ISODD_C
#   define BN_MP_NEG_C
#   define BN_MP_PRIME_FROBENIUS_UNDERWOOD_C
   #define BN_MP_LCM_C
   #define BN_MP_PRIME_RANDOM_EX_C
#   define BN_MP_RADIX_SIZE_C
#   define BN_MP_RAND_C
#   define BN_MP_REDUCE_C
   #define BN_MP_INVMOD_C
   #define BN_MP_GCD_C
#   define BN_MP_REDUCE_2K_L_C
#   define BN_MP_FROM_SBIN_C
#   define BN_MP_ROOT_U32_C
#   define BN_MP_SET_L_C
#   define BN_MP_SET_UL_C
   #define BN_MP_MOD_C
   #define BN_MP_MULMOD_C
#   define BN_MP_SBIN_SIZE_C
#   define BN_MP_TO_RADIX_C
#   define BN_MP_TO_SBIN_C
#   define BN_S_MP_RAND_JENKINS_C
#   define BN_S_MP_RAND_PLATFORM_C
#endif

/* Works for RSA only, mpi.o is 68KiB */
#if defined(SC_RSA_1) || defined (SC_RSA_1_WITH_TESTS)
#   define BN_CUTOFFS_C
#   define BN_MP_ADDMOD_C
   #define BN_MP_ADDMOD_C
#   define BN_MP_CLEAR_MULTI_C
#   define BN_MP_EXPTMOD_C
#   define BN_MP_GCD_C
#   define BN_MP_INIT_MULTI_C
#   define BN_MP_INVMOD_C
#   define BN_MP_LCM_C
#   define BN_MP_MOD_C
#   define BN_MP_MOD_D_C
   #define BN_MP_EXPTMOD_C
   #define BN_MP_SET_INT_C
   #define BN_MP_INIT_MULTI_C
   #define BN_MP_CLEAR_MULTI_C
   #define BN_MP_UNSIGNED_BIN_SIZE_C
   #define BN_MP_TO_UNSIGNED_BIN_C
   #define BN_MP_MOD_D_C
#   define BN_MP_MULMOD_C
#   define BN_MP_PRIME_IS_PRIME_C
#   define BN_MP_PRIME_RABIN_MILLER_TRIALS_C
   #define BN_MP_PRIME_RABIN_MILLER_TRIALS_C
#   define BN_MP_PRIME_RAND_C
#   define BN_MP_RADIX_SMAP_C
#   define BN_MP_SET_INT_C
#   define BN_MP_SHRINK_C
   #define BN_REVERSE_C
#   define BN_MP_TO_UNSIGNED_BIN_C
#   define BN_MP_UNSIGNED_BIN_SIZE_C
#   define BN_PRIME_TAB_C
   #define BN_PRIME_TAB_C
#   define BN_S_MP_REVERSE_C

/* other modifiers */
#   define BN_MP_DIV_SMALL                    /* Slower division, not critical */
   /* other modifiers */
   #define BN_MP_DIV_SMALL                    /* Slower division, not critical */


/* here we are on the last pass so we turn things off.  The functions classes are still there
 * but we remove them specifically from the build.  This also invokes tweaks in functions
 * like removing support for even moduli, etc...
 */
#   ifdef LTM_LAST
#      undef BN_MP_DR_IS_MODULUS_C
#      undef BN_MP_DR_SETUP_C
#      undef BN_MP_DR_REDUCE_C
#      undef BN_MP_DIV_3_C
#      undef BN_MP_REDUCE_2K_SETUP_C
#      undef BN_MP_REDUCE_2K_C
   /* here we are on the last pass so we turn things off.  The functions classes are still there
    * but we remove them specifically from the build.  This also invokes tweaks in functions
    * like removing support for even moduli, etc...
    */
#ifdef LTM_LAST
   #undef  BN_MP_TOOM_MUL_C
   #undef  BN_MP_TOOM_SQR_C
   #undef  BN_MP_KARATSUBA_MUL_C
   #undef  BN_MP_KARATSUBA_SQR_C
   #undef  BN_MP_REDUCE_C
   #undef  BN_MP_REDUCE_SETUP_C
   #undef  BN_MP_DR_IS_MODULUS_C
   #undef  BN_MP_DR_SETUP_C
   #undef  BN_MP_DR_REDUCE_C
   #undef  BN_MP_REDUCE_IS_2K_C
   #undef  BN_MP_REDUCE_2K_SETUP_C
   #undef  BN_MP_REDUCE_2K_C
#      undef BN_MP_REDUCE_IS_2K_C
#      undef BN_MP_REDUCE_SETUP_C
#      undef BN_S_MP_BALANCE_MUL_C
#      undef BN_S_MP_EXPTMOD_C
#      undef BN_S_MP_INVMOD_FAST_C
   #undef  BN_S_MP_EXPTMOD_C
   #undef  BN_MP_DIV_3_C
#      undef BN_S_MP_KARATSUBA_MUL_C
#      undef BN_S_MP_KARATSUBA_SQR_C
#      undef BN_S_MP_MUL_HIGH_DIGS_C
#      undef BN_S_MP_MUL_HIGH_DIGS_FAST_C
   #undef  BN_S_MP_MUL_HIGH_DIGS_C
   #undef  BN_FAST_S_MP_MUL_HIGH_DIGS_C
#      undef BN_S_MP_TOOM_MUL_C
#      undef BN_S_MP_TOOM_SQR_C

   #undef  BN_FAST_MP_INVMOD_C
#      ifndef SC_RSA_1_WITH_TESTS
#         undef BN_MP_REDUCE_C
#      endif

/* To safely undefine these you have to make sure your RSA key won't exceed the Comba threshold
 * which is roughly 255 digits [7140 bits for 32-bit machines, 15300 bits for 64-bit machines]
 * which means roughly speaking you can handle upto 2536-bit RSA keys with these defined without
 * trouble.
 */
   /* To safely undefine these you have to make sure your RSA key won't exceed the Comba threshold
    * which is roughly 255 digits [7140 bits for 32-bit machines, 15300 bits for 64-bit machines]
    * which means roughly speaking you can handle upto 2536-bit RSA keys with these defined without
    * trouble.
    */
#      undef BN_MP_MONTGOMERY_REDUCE_C
#      undef BN_S_MP_MUL_DIGS_C
#      undef BN_S_MP_SQR_C
#   endif
   #undef  BN_S_MP_MUL_DIGS_C
   #undef  BN_S_MP_SQR_C
   #undef  BN_MP_MONTGOMERY_REDUCE_C
#endif

#endif

Deleted libtommath/win32/libtommath.dll.

cannot compute difference between binary files

Deleted libtommath/win32/tommath.lib.

cannot compute difference between binary files

Deleted libtommath/win64/libtommath.dll.

cannot compute difference between binary files

Deleted libtommath/win64/libtommath.dll.a.

cannot compute difference between binary files

Deleted libtommath/win64/tommath.lib.

cannot compute difference between binary files

Changes to license.terms.

30
31
32
33
34
35
36
37

38
39
40
30
31
32
33
34
35
36

37
38
39
40







-
+



GOVERNMENT USE: If you are acquiring this software on behalf of the
U.S. government, the Government shall have only "Restricted Rights"
in the software and related documentation as defined in the Federal
Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
are acquiring the software on behalf of the Department of Defense, the
software shall be classified as "Commercial Computer Software" and the
Government shall have only "Restricted Rights" as defined in Clause
252.227-7014 (b) (3) of DFARs.  Notwithstanding the foregoing, the
252.227-7013 (b) (3) of DFARs.  Notwithstanding the foregoing, the
authors grant the U.S. Government and others acting in its behalf
permission to use and distribute the software in accordance with the
terms specified in this license.

Changes to macosx/GNUmakefile.

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
28
29
30
31
32
33
34












35
36
37
38
39
40
41







-
-
-
-
-
-
-
-
-
-
-
-







BINDIR			?= ${PREFIX}/bin
LIBDIR			?= ${INSTALL_PATH}
MANDIR			?= ${PREFIX}/man

# set to non-empty value to install manpages in addition to html help:
INSTALL_MANPAGES	?=

# Checks and overrides for subframework builds
ifeq (${SUBFRAMEWORK},1)
ifeq (${DYLIB_INSTALL_DIR},)
	@echo "Cannot install subframework with empty DYLIB_INSTALL_DIR !" && false
endif
ifeq (${DESTDIR},)
	@echo "Cannot install subframework with empty DESTDIR !" && false
endif
override BUILD_DIR = ${DESTDIR}/build
override INSTALL_PATH = /Frameworks
endif

#-------------------------------------------------------------------------------------------------------
# meta targets

meta			:= all install embedded install-embedded clean distclean test

styles			:= develop deploy

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
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







-
+















-
+







-
+




-
+







OBJ_DIR			= ${OBJROOT}/${BUILD_STYLE}

empty			:=
space			:= ${empty} ${empty}
objdir			= $(subst ${space},\ ,${OBJ_DIR})

develop_make_args	:= BUILD_STYLE=Development CONFIGURE_ARGS=--enable-symbols
deploy_make_args	:= BUILD_STYLE=Deployment INSTALL_TARGET=install \
deploy_make_args	:= BUILD_STYLE=Deployment INSTALL_TARGET=install-strip \
			   EXTRA_CFLAGS=-DNDEBUG
embedded_make_args	:= EMBEDDED_BUILD=1
install_make_args	:= INSTALL_BUILD=1

${targets}:
	${MAKE} ${action}${PROJECT} \
	$(foreach s,${styles} embedded install,$(if $(findstring $s,$@),${${s}_make_args}))

#-------------------------------------------------------------------------------------------------------
# project specific settings

PROJECT			:= tcl
PRODUCT_NAME		:= Tcl

UNIX_DIR		:= ${CURDIR}/../unix
VERSION			:= $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.ac)
VERSION			:= $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.in)
TCLSH			:= tclsh${VERSION}

BUILD_TARGET		:= all tcltest
INSTALL_TARGET		:= install

export CPPROG		:= cp -p

INSTALL_TARGETS		= install-binaries install-headers install-libraries
INSTALL_TARGETS		= install-binaries install-libraries
ifeq (${EMBEDDED_BUILD},)
INSTALL_TARGETS		+= install-private-headers
endif
ifeq (${INSTALL_BUILD}_${EMBEDDED_BUILD}_${BUILD_STYLE},1__Deployment)
INSTALL_TARGETS		+= install-packages html-tcl
INSTALL_TARGETS		+= html-tcl
ifneq (${INSTALL_MANPAGES},)
INSTALL_TARGETS		+= install-doc
endif
endif

MAKE_VARS		:= INSTALL_ROOT INSTALL_TARGETS VERSION GENERIC_FLAGS
MAKE_ARGS_V		= $(foreach v,${MAKE_VARS},$v='${$v}')
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
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







-
+








-
-
-
+
+
+







-
+








+
+
+
+
+
+
+
+
+
+
+







	${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/"

${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \
		     ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in
	mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \
	if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
	--prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
	--mandir="${MANDIR}" --enable-framework --enable-dtrace \
	--mandir="${MANDIR}" --enable-threads --enable-framework --enable-dtrace \
	${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi

build-${PROJECT}: ${objdir}/Makefile
	${DO_MAKE}
ifeq (${INSTALL_BUILD},)
# symolic link hackery to trick
# 'make install INSTALL_ROOT=${OBJ_DIR}'
# into building Tcl.framework and tclsh in ${SYMROOT}
	@cd "${OBJ_DIR}" && mkdir -p $(dir $(subst ${space},\ ,.${LIBDIR})) $(dir $(subst ${space},\ ,.${BINDIR})) "${SYMROOT}" && \
	rm -f ".${LIBDIR}" ".${BINDIR}" && ln -fs "${SYMROOT}" ".${LIBDIR}" && \
	ln -fs "${SYMROOT}" ".${BINDIR}" && ln -fs "${OBJ_DIR}/tcltest" "${SYMROOT}"
	@cd "${OBJ_DIR}" && mkdir -p $(dir $(subst ${space},\ ,./${LIBDIR})) $(dir $(subst ${space},\ ,./${BINDIR})) "${SYMROOT}" && \
	rm -f "./${LIBDIR}" "./${BINDIR}" && ln -fs "${SYMROOT}" "./${LIBDIR}" && \
	ln -fs "${SYMROOT}" "./${BINDIR}" && ln -fs "${OBJ_DIR}/tcltest" "${SYMROOT}"
endif

install-${PROJECT}: build-${PROJECT}
ifeq (${EMBEDDED_BUILD}_${INSTALL_ROOT},1_)
	@echo "Cannot install-embedded with empty INSTALL_ROOT !" && false
endif
ifeq (${EMBEDDED_BUILD},1)
	@rm -rf "${INSTALL_ROOT}${LIBDIR}/Tcl.framework"
	@rm -rf "${INSTALL_ROOT}/${LIBDIR}/Tcl.framework"
endif
	${DO_MAKE}
ifeq (${INSTALL_BUILD},1)
ifeq (${EMBEDDED_BUILD},1)
# if we are embedding frameworks, don't install tclsh
	@rm -f "${INSTALL_ROOT}${BINDIR}/${TCLSH}" && \
	rmdir -p "${INSTALL_ROOT}${BINDIR}" 2>&- || true
else
# redo prebinding (when not building for Mac OS X 10.4 or later only)
	@if [ "`echo "$${MACOSX_DEPLOYMENT_TARGET}" | \
	awk -F '10\\.' '{print int($$2)}'`" -lt 4 -a "`echo "$${CFLAGS}" | \
	awk -F '-mmacosx-version-min=10\\.' '{print int($$2)}'`" -lt 4 ]; \
	then cd ${INSTALL_ROOT}/; \
	if [ ! -d usr/lib ]; then mkdir -p usr && ln -fs /usr/lib usr/ && RM_USRLIB=1; fi; \
	if [ ! -d System ]; then ln -fs /System . && RM_SYSTEM=1; fi; \
	redo_prebinding -r . "./${LIBDIR}/${PRODUCT_NAME}.framework/Versions/${VERSION}/${PRODUCT_NAME}"; \
	redo_prebinding -r . "./${BINDIR}/${TCLSH}"; \
	if [ -n "$${RM_USRLIB:-}" ]; then rm -f usr/lib; rmdir -p usr 2>&-; fi; \
	if [ -n "$${RM_SYSTEM:-}" ]; then rm -f System; fi; fi
# install tclsh symbolic link
	@ln -fs ${TCLSH} "${INSTALL_ROOT}${BINDIR}/tclsh"
endif
endif
ifeq (${BUILD_STYLE}_${EMBEDDED_BUILD},Development_)
# keep copy of debug library around, so that
# Deployment build can be installed on top

Changes to macosx/README.

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
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

















-
+
+









-
-
-
+
+
+






-
-
-
+
+
+
-









+





-
-
-
-
-
-
+
+
+
+
+
+









-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+

-
-
+
+






+
+
+
+
+
+
+
+
+
+



-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
+
+

+
-
+

-
-
+
+

-
+



-
-
+
+






-
+



-
-
-
-
-
-
-
-
-
-

- Please report bugs with Tcl on Mac OS X to the tracker:
	https://core.tcl-lang.org/tcl/reportlist

2. Using Tcl on Mac OS X
------------------------

- At a minimum, Mac OS X 10.3 is required to run Tcl.
- At a minimum, Mac OS X 10.1 is required to run Tcl, but OS X 10.3 or higher is
recommended (certain [file] operations behave incorrectly on earlier releases).

- Unless weak-linking is used, Tcl built on Mac OS X 10.x will not run on 10.y
with y < x; on the other hand Tcl built on 10.y will always run on 10.x with
y <= x (but without any of the fixes and optimizations that would be available
in a binary built on 10.x).
Weak-linking is available on OS X 10.2 or later, it additionally allows Tcl
built on 10.x to run on any 10.y with x > y >= z (for a chosen z >= 2).

- Tcl extensions can be installed in any of:
	$HOME/Library/Tcl /Library/Tcl
	$HOME/Library/Frameworks /Library/Frameworks
	(searched in that order).
	$HOME/Library/Tcl /Library/Tcl /Network/Library/Tcl /System/Library/Tcl
	$HOME/Library/Frameworks /Library/Frameworks /Network/Library/Frameworks
	/System/Library/Frameworks (searched in that order).
Given a potential package directory $pkg, Tcl on OSX checks for the file
$pkg/Resources/Scripts/pkgIndex.tcl as well as the usual $pkg/pkgIndex.tcl.
This allows building extensions as frameworks with all script files contained in
the Resources/Scripts directory of the framework.

- [load]able binary extensions can linked as either ordinary shared libraries
(.dylib) or as MachO bundles (since 8.4.10/8.5a3); bundles have the advantage
that they are [load]ed more efficiently from a tcl VFS (no temporary copy to the
native filesystem required), and prior to Mac OS X 10.5, only bundles can be
(.dylib) or as MachO bundles (since 8.4.10/8.5a3); only bundles can be unloaded,
and bundles are also loaded more efficiently from VFS (no temporary copy to the
native filesystem required).
[unload]ed.

- The 'deploy' target of macosx/GNUmakefile installs the html manpages into the
standard documentation location in the Tcl framework:
	Tcl.framework/Resources/Documentation/Reference/Tcl
No nroff manpages are installed by default by the GNUmakefile.

- The Tcl framework can be installed in any of the system's standard
framework directories:
	$HOME/Library/Frameworks /Library/Frameworks
	/Network/Library/Frameworks /System/Library/Frameworks


3. Building Tcl on Mac OS X
---------------------------

- At least Mac OS X 10.3 is required to build Tcl.
Apple's Xcode Developer Tools need to be installed (only the most recent version
matching your OS release is supported), the Xcode installer is available on Mac
OS X install media or may be present in /Applications/Installers on Macs that
came with OS X preinstalled. The most recent version can always be downloaded
from the ADC website http://connect.apple.com (free ADC membership required).
- At least Mac OS X 10.1 is required to build Tcl, and Apple's Developer Tools
need to be installed (only the most recent version matching your OS release is
supported). The Developer Tools installer is available on Mac OS X retail disks
or is present in /Applications/Installers on Macs that came with OS X
preinstalled. The most recent version can be downloaded from the ADC website
http://connect.apple.com (after you register for free ADC membership).

- Tcl is most easily built as a Mac OS X framework via GNUmakefile in tcl/macosx
(see below for details), but can also be built with the standard unix configure
and make buildsystem in tcl/unix as on any other unix platform (indeed, the
GNUmakefile is just a wrapper around the unix buildsystem).
The Mac OS X specific configure flags are --enable-framework and
--disable-corefoundation (which disables CF and notably reverts to the standard
select based notifier).

- It is also possible to build with the Xcode IDE via the projects in
tcl/macosx, take care to use the project matching your DevTools and OS version:
	Tcl.xcode: 		    for Xcode 3.1 on 10.5
	Tcl.xcodeproj:		    for Xcode 3.2 on 10.6
These have the following targets:
- It is also possible to build with Apple's IDE via the projects in tcl/macosx,
take care to only use the project matching your DevTools and OS version:
    * Tcl.pbproj for Xcode or ProjectBuilder on 10.3 and earlier, this has a
	'Tcl' target that simply calls through to the tcl/macosx/GNUMakefile.
    * Tcl.xcode for Xcode 2.4 on 10.4 and Xcode 2.5 on 10.4 and later, which
	additionally has native 'tcltest' and 'tests' targets for debugging and
	running the testsuite, these targets' 'Debug' build configuration has
	ZeroLink and Fix&Continue enabled, use the 'DebugNoFixZL' build
	configuration if you need a debug build without these features. The
	following build configurations are available:
	Tcl:			    calls through to tcl/macosx/GNUMakefile.
	tcltest:		    static build of tcltest for debugging.
	tests:			    build tcltest target and run tcl testsuite.
The following build configurations are available:
	Debug:			    debug build for the active architecture,
				    with Fix & Continue enabled.
	'DebugUnthreaded': debug build with threading turned off.
	'DebugNoCF': debug build with corefoundation turned off.
	'DebugNoCFUnthreaded': debug build with corefoundation & threading off.
	'DebugMemCompile': debug build with memory and bytecode debugging on.
	'DebugLeaks': debug build with PURIFY defined.
	'DebugGCov': debug build with generation of gcov data files enabled.
	'Debug64bit': builds the targets as 64bit with debugging enabled,
		requires a 64bit capable processor (i.e. G5 or Core2/Xeon).
	'ReleaseUniversal': builds the targets as universal binaries for the
		ppc, ppc64, i386 and x86_64 architectures.
	'ReleaseUniversal10.4uSDK': same as 'ReleaseUniversal' but builds
		against the 10.4u SDK, required to build universal binaries on
		PowerPC Tiger (where the system libraries are not universal).
	'ReleasePPC10.3.9SDK': builds for PowerPC against the 10.3.9 SDK, useful
		for verifying on Tiger that building on Panther would succeed.
	'ReleasePPC10.2.8SDK': builds for PowerPC with gcc-3.3 against the
		10.2.8 SDK, useful to verify on Tiger that building on Jaguar
		would succeed.
    * Tcl.xcodeproj for Xcode 3.1 on 10.5 and later, which has the following
	additional build configurations:
	'ReleaseUniversal10.5SDK': same as 'ReleaseUniversal' but builds
		against the 10.5 SDK on Leopard (with 10.5 deployment target).
	Debug clang:		    use clang compiler.
	Debug llvm-gcc:		    use llvm-gcc compiler.
	Debug gcc40:		    use gcc 4.0 compiler.
	'Debug gcc42':  same as 'Debug' but builds with gcc 4.2.
	DebugNoFixAndContinue:      disable Fix & Continue.
	DebugUnthreaded:	    disable threading.
	DebugNoCF:		    disable corefoundation.
	DebugNoCFUnthreaded:	    disable corefoundation an threading.
	DebugMemCompile:	    enable memory and bytecode debugging.
	DebugLeaks:		    define PURIFY.
	'Debug llvmgcc42': same as 'Debug' but builds with llvm-gcc 4.2.
	DebugGCov:		    enable generation of gcov data files.
	Debug64bit:		    configure with --enable-64bit (requires
				    building on a 64bit capable processor).
	Release:		    release build for the active architecture.
	ReleaseUniversal:	    32/64-bit universal build.
	ReleaseUniversal clang:	    use clang compiler.
	ReleaseUniversal llvm-gcc:  use llvm-gcc compiler.
	'ReleaseUniversal gcc42': same as 'ReleaseUniversal' but builds with
		gcc 4.2.
	'ReleaseUniversal llvmgcc42': same as 'ReleaseUniversal' but builds
		with llvm-gcc 4.2.
	ReleaseUniversal gcc40:	    use gcc 4.0 compiler.
	ReleaseUniversal10.5SDK:    build against the 10.5 SDK (with 10.5
				    deployment target).
	Note that the non-SDK configurations have their deployment target set to
	10.5 (Tcl.xcode) resp. 10.6 (Tcl.xcodeproj).
The Xcode projects refer to the toplevel tcl source directory via the
TCL_SRCROOT user build setting, by default this is set to the project-relative
path '../../tcl', if your tcl source directory is named differently, e.g.
'../../tcl9.0', you need to manually change the TCL_SRCROOT setting by editing
your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory)
with a text editor.
	Note that all non-SDK configurations have 10.5 deployment target.

Notes about the native targets of the Xcode projects:
    * the Xcode projects refer to the toplevel tcl source directory through the
	TCL_SRCROOT user build setting, by default this is set to the
	project-relative path '../../tcl', if your tcl source directory is named
	differently, e.g. '../../tcl8.5', you'll need to manually change the
	TCL_SRCROOT setting by editing your ${USER}.pbxuser file (located inside
	the Tcl.xcodeproj bundle directory) with a text editor.
    * the native targets need a version of the unix configure script with config
	headers enabled, this is automatically generated as tcl/macosx/configure
	by the project but that requires 2.59 versions of autoconf & autoheader.
	These are not available on Mac OS X 10.5 by default and need to be
	installed manually. By default they are assumed to be installed as
	/usr/local/bin/autoconf-2.59 and /usr/local/bin/autoheader-2.59, set the
	AUTOCONF and AUTOHEADER build settings in ${USER}.pbxuser to their true
	locations if necessary.

- To build universal binaries outside of the Xcode IDE, set CFLAGS as follows:
	export CFLAGS="-arch i386 -arch x86_64 -arch ppc"
- To build universal binaries outside of Tcl.xcodeproj, set CFLAGS as follows:
    export CFLAGS="-arch ppc -arch ppc64 -arch i386 -arch x86_64 \
	-isysroot /Developer/SDKs/MacOSX10.4u.sdk -mmacosx-version-min=10.4"
This requires Mac OS X 10.4 and Xcode 2.4 (or Xcode 2.2 if -arch x86_64 is
omitted, but _not_ Xcode 2.1) and will work on any architecture (on PowerPC
Tiger you need to add "-isysroot /Developer/SDKs/MacOSX10.4u.sdk").
omitted, but _not_ Xcode 2.1) and will work on any of the architectures (the
-isysroot flag is only required on PowerPC Tiger).
Note that configure requires CFLAGS to contain a least one architecture that can
be run on the build machine (i.e. ppc on G3/G4, ppc or ppc64 on G5, ppc or i386
on Core and ppc, i386 or x86_64 on Core2/Xeon).
Universal builds of Tcl TEA extensions are also possible with CFLAGS set as
above, they will be [load]able by universal as well as thin binaries of Tcl.

- To enable weak-linking, set the MACOSX_DEPLOYMENT_TARGET environment variable
to the minimal OS version (>= 10.2) the binaries should be able to run on, e.g:
    export MACOSX_DEPLOYMENT_TARGET=10.2
This requires Mac OS X 10.2 and gcc 3.1; if you have gcc 4 or later you can set
CFLAGS instead:
    export CFLAGS="-mmacosx-version-min=10.2"
The Tcl.xcode project is setup to produce binaries that can run on 10.2 or
later (except for the Universal and SDK configurations).
Support for weak-linking was added to the code for 8.4.14/8.5a5.

Detailed Instructions for building with macosx/GNUmakefile
----------------------------------------------------------

- Unpack the Tcl source release archive.
- Unpack the tcl source release archive.

- The following instructions assume the Tcl source tree is named "tcl${ver}",
(where ${ver} is a shell variable containing the Tcl version number e.g. '9.0').
Setup this shell variable as follows:
	ver="9.0"
If you are building from CVS, omit this step (CVS source tree names usually do
not contain a version number).

- The following instructions assume the tcl source tree is named "tcl${ver}",
where ${ver} is a shell variable containing the tcl version number (for example
'8.4.12').
Setup the shell variable as follows:
	set ver="8.4.12" ;: if your shell is csh
	ver="8.4.12"	 ;: if your shell is sh
The source tree will be named this way only if you are building from a release
archive, if you are building from CVS, the version numbers will be missing; so
set ${ver} to the empty string instead:
- Setup environment variables as desired, e.g. for a universal build on 10.5:
	CFLAGS="-arch i386 -arch x86_64 -arch ppc -mmacosx-version-min=10.5"
	export CFLAGS
	set ver=""	 ;: if your shell is csh
	ver=""		 ;: if your shell is sh

- The following steps will build Tcl from the Terminal, assuming you are located
- Change to the directory containing the Tcl source tree and build:
in the directory containing the tcl source tree:
	make -C tcl${ver}/macosx

- Install Tcl onto the root volume (admin password required):
and the following will then install Tcl onto the root volume (admin password
required):
	sudo make -C tcl${ver}/macosx install
if you don't have an admin password, you can install into your home directory
if you don't have the admin password, you can install into your home directory,
instead by passing an INSTALL_ROOT argument to make:
	make -C tcl${ver}/macosx install INSTALL_ROOT="${HOME}/"

- The default GNUmakefile targets will build _both_ debug and optimized versions
of the Tcl framework with the standard convention of naming the debug library
- The default Makefile targets will build _both_ debug and optimized versions of
the Tcl framework with the standard convention of naming the debug library
Tcl.framework/Tcl_debug.
This allows switching to the debug libraries at runtime by setting
	export DYLD_IMAGE_SUFFIX=_debug
(c.f. man dyld for more details)

If you only want to build and install the debug or optimized build, use the
'develop' or 'deploy' target variants of the GNUmakefile, respectively.
'develop' or 'deploy' target variants of the Makefiles, respectively.
For example, to build and install only the optimized versions:
	make -C tcl${ver}/macosx deploy
	sudo make -C tcl${ver}/macosx install-deploy

- To build a Tcl.framework for use as a subframework in another framework, use the
install-embedded target and set SUBFRAMEWORK=1.  Set the DYLIB_INSTALL_DIR
variable to the path which should be the install_name path of the Tcl library, set
the DESTDIR variable to the pathname of a staging directory where the framework
will be written .  For example, running this command in the Tcl source directory:
	make -C macosx install-embedded SUBFRAMEWORK=1 DESTDIR=/tmp/tcl \
	DYLIB_INSTALL_DIR=/Library/Frameworks/Some.framework/Versions/X.Y/Frameworks/Tcl.framework
will produce a Tcl.framework intended for installing as a subframework of
Some.framework.  The framework will be found in /tmp/tcl/Frameworks/

Changes to macosx/Tcl-Common.xcconfig.

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

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







+
-
-
-
+
+
+
+
+










-
+



-
+
OTHER_LDFLAGS = -headerpad_max_install_names -sectcreate __TEXT __info_plist "$(DERIVED_FILE_DIR)/tcl/Tclsh-Info.plist" $(OTHER_LDFLAGS)
INSTALL_PATH = $(BINDIR)
INSTALL_MODE_FLAG = go-w,a+rX
GCC_PREFIX_HEADER = $(DERIVED_FILE_DIR)/tcl/tclConfig.h
GCC_GENERATE_DEBUGGING_SYMBOLS = YES
GCC_NO_COMMON_BLOCKS = YES
GCC_DYNAMIC_NO_PIC = YES
GCC = $(DEVELOPER_DIR)/usr/bin/gcc
GCC_VERSION = 4.2
GCC = gcc-$(GCC_VERSION)
WARNING_CFLAGS = -Wall -Wextra -Wshadow -Wwrite-strings -Wpointer-arith -Wc++-compat -Wdeclaration-after-statement -Winit-self -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS)
GCC_VERSION = 4.0
CC = $(GCC)-$(GCC_VERSION)
LD = $(CC)
WARNING_CFLAGS_GCC3 = -Wall -Wno-implicit-int -Wno-unused-parameter -Wno-deprecated-declarations
WARNING_CFLAGS = -Wextra -Wno-missing-field-initializers -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS_GCC3) $(WARNING_CFLAGS)
BINDIR = $(PREFIX)/bin
CFLAGS = $(CFLAGS)
CPPFLAGS = -mmacosx-version-min=$(MACOSX_DEPLOYMENT_TARGET) $(CPPFLAGS)
FRAMEWORK_INSTALL_PATH = /Library/Frameworks
INCLUDEDIR = $(PREFIX)/include
LIBDIR = $(PREFIX)/lib
MANDIR = $(PREFIX)/man
PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
PREFIX = /usr/local
TCL_CONFIGURE_ARGS = --enable-dtrace
TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
VERSION = 9.0
VERSION = 8.5

Added macosx/Tcl.pbproj/default.pbxuser.














































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
// !$*UTF8*$!
{
	00E2F845016E82EB0ACA28DC = {
		activeBuildStyle = 00E2F847016E82EB0ACA28DC;
		activeExecutable = F594E5F1030774B1016F146B;
		activeTarget = 00E2F84C016E8B780ACA28DC;
		addToTargets = (
		);
		codeSenseManager = F9D167E40610239A0027C147;
		executables = (
			F53ACC52031D9AFE016F146B,
			F594E5F1030774B1016F146B,
		);
		sourceControlManager = F9D167E30610239A0027C147;
		userBuildSettings = {
			SYMROOT = "${SRCROOT}/../../build/tcl";
		};
	};
	00E2F84C016E8B780ACA28DC = {
		activeExec = 0;
	};
	F53ACC52031D9AFE016F146B = {
		activeArgIndex = 2147483647;
		activeArgIndices = (
			NO,
			NO,
		);
		argumentStrings = (
			"${SRCROOT}/../../tcl/tests/all.tcl",
			"-verbose \"\"",
		);
		configStateDict = {
			"PBXLSLaunchAction-0" = {
				PBXLSLaunchAction = 0;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXLSRunLaunchConfig;
				displayName = "Executable Runner";
				identifier = com.apple.Xcode.launch.runConfig;
				remoteHostInfo = "";
				startActionInfo = "";
			};
			"PBXLSLaunchAction-1" = {
				PBXLSLaunchAction = 1;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXGDB_LaunchConfig;
				displayName = GDB;
				identifier = com.apple.Xcode.launch.GDBMI_Config;
				remoteHostInfo = "";
				startActionInfo = "";
			};
		};
		cppStopOnCatchEnabled = 0;
		cppStopOnThrowEnabled = 0;
		customDataFormattersEnabled = 1;
		debuggerPlugin = GDBDebugging;
		disassemblyDisplayState = 0;
		dylibVariantSuffix = _debug;
		enableDebugStr = 0;
		environmentEntries = (
			{
				active = YES;
				name = TCL_LIBRARY;
				value = "${SRCROOT}/../../tcl/library";
			},
			{
				active = NO;
				name = DYLD_PRINT_LIBRARIES;
			},
		);
		isa = PBXExecutable;
		launchableReference = F5C37CF303D5BEDF016F146B;
		libgmallocEnabled = 0;
		name = tcltest;
		shlibInfoDictList = (
		);
		sourceDirectories = (
		);
		startupPath = "<<ProductDirectory>>";
	};
	F594E5F1030774B1016F146B = {
		activeArgIndex = 2147483647;
		activeArgIndices = (
		);
		argumentStrings = (
		);
		configStateDict = {
			"PBXLSLaunchAction-0" = {
				PBXLSLaunchAction = 0;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXLSRunLaunchConfig;
				displayName = "Executable Runner";
				identifier = com.apple.Xcode.launch.runConfig;
				remoteHostInfo = "";
				startActionInfo = "";
			};
			"PBXLSLaunchAction-1" = {
				PBXLSLaunchAction = 1;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXGDB_LaunchConfig;
				displayName = GDB;
				identifier = com.apple.Xcode.launch.GDBMI_Config;
				remoteHostInfo = "";
				startActionInfo = "";
			};
		};
		cppStopOnCatchEnabled = 0;
		cppStopOnThrowEnabled = 0;
		customDataFormattersEnabled = 1;
		debuggerPlugin = GDBDebugging;
		disassemblyDisplayState = 0;
		dylibVariantSuffix = _debug;
		enableDebugStr = 0;
		environmentEntries = (
			{
				active = NO;
				name = DYLD_PRINT_LIBRARIES;
			},
		);
		isa = PBXExecutable;
		launchableReference = F98F02E608E7EF9A00D0320A;
		libgmallocEnabled = 0;
		name = tclsh;
		shlibInfoDictList = (
		);
		sourceDirectories = (
		);
		startupPath = "<<ProductDirectory>>";
	};
	F5C37CF303D5BEDF016F146B = {
		isa = PBXFileReference;
		lastKnownFileType = "compiled.mach-o.executable";
		path = tcltest;
		refType = 3;
		sourceTree = BUILT_PRODUCTS_DIR;
	};
	F98F02E608E7EF9A00D0320A = {
		isa = PBXFileReference;
		lastKnownFileType = "compiled.mach-o.executable";
		path = tclsh8.5;
		refType = 3;
		sourceTree = BUILT_PRODUCTS_DIR;
	};
	F9D167E30610239A0027C147 = {
		fallbackIsa = XCSourceControlManager;
		isSCMEnabled = 0;
		isa = PBXSourceControlManager;
		scmConfiguration = {
		};
		scmType = scm.cvs;
	};
	F9D167E40610239A0027C147 = {
		indexTemplatePath = "";
		isa = PBXCodeSenseManager;
		usesDefaults = 1;
		wantsCodeCompletion = 1;
		wantsCodeCompletionAutoSuggestions = 1;
		wantsCodeCompletionCaseSensitivity = 1;
		wantsCodeCompletionListAlways = 1;
		wantsCodeCompletionOnlyMatchingItems = 1;
		wantsCodeCompletionParametersIncluded = 1;
		wantsCodeCompletionPlaceholdersInserted = 1;
		wantsCodeCompletionTabCompletes = 1;
		wantsIndex = 1;
	};
}

Added macosx/Tcl.pbproj/jingham.pbxuser.














































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
// !$*UTF8*$!
{
	00E2F845016E82EB0ACA28DC = {
		activeBuildStyle = 00E2F847016E82EB0ACA28DC;
		activeExecutable = F594E5F1030774B1016F146B;
		activeTarget = 00E2F84C016E8B780ACA28DC;
		addToTargets = (
		);
		codeSenseManager = F9D167E40610239A0027C147;
		executables = (
			F53ACC52031D9AFE016F146B,
			F594E5F1030774B1016F146B,
		);
		sourceControlManager = F9D167E30610239A0027C147;
		userBuildSettings = {
			SYMROOT = "${SRCROOT}/../../build/tcl";
		};
	};
	00E2F84C016E8B780ACA28DC = {
		activeExec = 0;
	};
	F53ACC52031D9AFE016F146B = {
		activeArgIndex = 2147483647;
		activeArgIndices = (
			NO,
			NO,
		);
		argumentStrings = (
			"${SRCROOT}/../../tcl/tests/all.tcl",
			"-verbose \"\"",
		);
		configStateDict = {
			"PBXLSLaunchAction-0" = {
				PBXLSLaunchAction = 0;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXLSRunLaunchConfig;
				displayName = "Executable Runner";
				identifier = com.apple.Xcode.launch.runConfig;
				remoteHostInfo = "";
				startActionInfo = "";
			};
			"PBXLSLaunchAction-1" = {
				PBXLSLaunchAction = 1;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXGDB_LaunchConfig;
				displayName = GDB;
				identifier = com.apple.Xcode.launch.GDBMI_Config;
				remoteHostInfo = "";
				startActionInfo = "";
			};
		};
		cppStopOnCatchEnabled = 0;
		cppStopOnThrowEnabled = 0;
		customDataFormattersEnabled = 1;
		debuggerPlugin = GDBDebugging;
		disassemblyDisplayState = 0;
		dylibVariantSuffix = _debug;
		enableDebugStr = 0;
		environmentEntries = (
			{
				active = YES;
				name = TCL_LIBRARY;
				value = "${SRCROOT}/../../tcl/library";
			},
			{
				active = NO;
				name = DYLD_PRINT_LIBRARIES;
			},
		);
		isa = PBXExecutable;
		launchableReference = F5C37CF303D5BEDF016F146B;
		libgmallocEnabled = 0;
		name = tcltest;
		shlibInfoDictList = (
		);
		sourceDirectories = (
		);
		startupPath = "<<ProductDirectory>>";
	};
	F594E5F1030774B1016F146B = {
		activeArgIndex = 2147483647;
		activeArgIndices = (
		);
		argumentStrings = (
		);
		configStateDict = {
			"PBXLSLaunchAction-0" = {
				PBXLSLaunchAction = 0;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXLSRunLaunchConfig;
				displayName = "Executable Runner";
				identifier = com.apple.Xcode.launch.runConfig;
				remoteHostInfo = "";
				startActionInfo = "";
			};
			"PBXLSLaunchAction-1" = {
				PBXLSLaunchAction = 1;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXGDB_LaunchConfig;
				displayName = GDB;
				identifier = com.apple.Xcode.launch.GDBMI_Config;
				remoteHostInfo = "";
				startActionInfo = "";
			};
		};
		cppStopOnCatchEnabled = 0;
		cppStopOnThrowEnabled = 0;
		customDataFormattersEnabled = 1;
		debuggerPlugin = GDBDebugging;
		disassemblyDisplayState = 0;
		dylibVariantSuffix = _debug;
		enableDebugStr = 0;
		environmentEntries = (
			{
				active = NO;
				name = DYLD_PRINT_LIBRARIES;
			},
		);
		isa = PBXExecutable;
		launchableReference = F98F02E608E7EF9A00D0320A;
		libgmallocEnabled = 0;
		name = tclsh;
		shlibInfoDictList = (
		);
		sourceDirectories = (
		);
		startupPath = "<<ProductDirectory>>";
	};
	F5C37CF303D5BEDF016F146B = {
		isa = PBXFileReference;
		lastKnownFileType = "compiled.mach-o.executable";
		path = tcltest;
		refType = 3;
		sourceTree = BUILT_PRODUCTS_DIR;
	};
	F98F02E608E7EF9A00D0320A = {
		isa = PBXFileReference;
		lastKnownFileType = "compiled.mach-o.executable";
		path = tclsh8.5;
		refType = 3;
		sourceTree = BUILT_PRODUCTS_DIR;
	};
	F9D167E30610239A0027C147 = {
		fallbackIsa = XCSourceControlManager;
		isSCMEnabled = 0;
		isa = PBXSourceControlManager;
		scmConfiguration = {
		};
		scmType = scm.cvs;
	};
	F9D167E40610239A0027C147 = {
		indexTemplatePath = "";
		isa = PBXCodeSenseManager;
		usesDefaults = 1;
		wantsCodeCompletion = 1;
		wantsCodeCompletionAutoSuggestions = 1;
		wantsCodeCompletionCaseSensitivity = 1;
		wantsCodeCompletionListAlways = 1;
		wantsCodeCompletionOnlyMatchingItems = 1;
		wantsCodeCompletionParametersIncluded = 1;
		wantsCodeCompletionPlaceholdersInserted = 1;
		wantsCodeCompletionTabCompletes = 1;
		wantsIndex = 1;
	};
}

Added macosx/Tcl.pbproj/project.pbxproj.




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
// !$*UTF8*$!
{
	archiveVersion = 1;
	classes = {
	};
	objectVersion = 39;
	objects = {
		00E2F845016E82EB0ACA28DC = {
			buildSettings = {
			};
			buildStyles = (
				00E2F847016E82EB0ACA28DC,
				00E2F848016E82EB0ACA28DC,
			);
			hasScannedForEncodings = 1;
			isa = PBXProject;
			mainGroup = 00E2F846016E82EB0ACA28DC;
			productRefGroup = 00E2F84A016E8A830ACA28DC;
			projectDirPath = "";
			targets = (
				00E2F84C016E8B780ACA28DC,
			);
		};
		00E2F846016E82EB0ACA28DC = {
			children = (
				F5306CA003CAC9AE016F146B,
				F5306C9F03CAC979016F146B,
				F5C88655017D604601DC9062,
				F5F24FEE016ED0DF01DC9062,
				00E2F855016E922C0ACA28DC,
				00E2F857016E92B00ACA28DC,
				00E2F85A016E92B00ACA28DC,
				00E2F84A016E8A830ACA28DC,
			);
			isa = PBXGroup;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F847016E82EB0ACA28DC = {
			buildSettings = {
				MAKE_TARGET = develop;
			};
			isa = PBXBuildStyle;
			name = Development;
		};
		00E2F848016E82EB0ACA28DC = {
			buildSettings = {
				MAKE_TARGET = deploy;
			};
			isa = PBXBuildStyle;
			name = Deployment;
		};
		00E2F84A016E8A830ACA28DC = {
			children = (
				F53ACC73031DA405016F146B,
				F53ACC5C031D9D11016F146B,
				F9A61C9D04C2B4E3006F5A0B,
			);
			isa = PBXGroup;
			name = Products;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F84C016E8B780ACA28DC = {
			buildArgumentsString = "-c \"cd \\\"${TCL_SRCROOT}/macosx\\\" && ACTION=${ACTION} && CFLAGS=\\\"${CFLAGS}\\\" gnumake \\${ACTION:+\\${ACTION/clean/distclean}-}${MAKE_TARGET} INSTALL_ROOT=\\\"${DSTROOT}\\\" INSTALL_PATH=\\\"${INSTALL_PATH}\\\" PREFIX=\\\"${PREFIX}\\\" BINDIR=\\\"${BINDIR}\\\" MANDIR=\\\"${MANDIR}\\\" \\${EXTRA_MAKE_FLAGS} ${ALL_SETTINGS}\"";
			buildPhases = (
			);
			buildSettings = {
				BINDIR = "${PREFIX}/bin";
				CFLAGS = "";
				INSTALL_PATH = /Library/Frameworks;
				MANDIR = "${PREFIX}/man";
				PREFIX = /usr/local;
				PRODUCT_NAME = Tcl;
				TCL_SRCROOT = "${SRCROOT}/../../tcl";
				TEMP_DIR = "${PROJECT_TEMP_DIR}";
			};
			buildToolPath = /bin/bash;
			buildWorkingDirectory = "${SRCROOT}";
			dependencies = (
			);
			isa = PBXLegacyTarget;
			name = Tcl;
			passBuildSettingsInEnvironment = 0;
			productName = Tcl;
		};
		00E2F854016E922C0ACA28DC = {
			children = (
				F5F24F87016ECAFC01DC9062,
				F5F24F88016ECAFC01DC9062,
				F5F24F89016ECAFC01DC9062,
				F5F24F8A016ECAFC01DC9062,
				F5F24F8B016ECAFC01DC9062,
				F5F24F8C016ECAFC01DC9062,
				F5F24F8D016ECAFC01DC9062,
				F5F24F8E016ECAFC01DC9062,
				F5F24F8F016ECAFC01DC9062,
				F5F24F90016ECAFC01DC9062,
				F5F24F91016ECAFC01DC9062,
				F5F24F92016ECAFC01DC9062,
				F5F24F93016ECAFC01DC9062,
				F5F24F94016ECAFC01DC9062,
				F5F24F95016ECAFC01DC9062,
				F5F24F96016ECAFC01DC9062,
				F5F24F97016ECAFC01DC9062,
				F5F24F98016ECAFC01DC9062,
				F5F24F99016ECAFC01DC9062,
				F5F24F9A016ECAFC01DC9062,
				F5F24F9B016ECAFC01DC9062,
				F5F24F9C016ECAFC01DC9062,
				F5F24F9D016ECAFC01DC9062,
				F5F24F9E016ECAFC01DC9062,
				F5F24F9F016ECAFC01DC9062,
				F5F24FA0016ECAFC01DC9062,
				F5F24FA1016ECAFC01DC9062,
				F5F24FA2016ECAFC01DC9062,
				F5F24FA3016ECAFC01DC9062,
				F5F24FA4016ECAFC01DC9062,
				F5F24FA5016ECAFC01DC9062,
				F5F24FA6016ECAFC01DC9062,
				F5F24FA7016ECAFC01DC9062,
				F5F24FA8016ECAFC01DC9062,
				F5F24FA9016ECAFC01DC9062,
				F5F24FAA016ECAFC01DC9062,
				F5F24FAB016ECAFC01DC9062,
				F5F24FAC016ECAFC01DC9062,
				F5F24FAD016ECAFC01DC9062,
				F5F24FAE016ECAFC01DC9062,
				F5F24FAF016ECAFC01DC9062,
				F5F24FB0016ECAFC01DC9062,
				F5F24FB1016ECAFC01DC9062,
				F5F24FB2016ECAFC01DC9062,
				F5F24FB3016ECAFC01DC9062,
				F5F24FB4016ECAFC01DC9062,
				F5F24FB5016ECAFC01DC9062,
				F5F24FB6016ECAFC01DC9062,
				F5F24FB7016ECAFC01DC9062,
				F5F24FB8016ECAFC01DC9062,
				F5F24FB9016ECAFC01DC9062,
				F5F24FBA016ECAFC01DC9062,
				F9FED5C7047C7D1B006F146B,
				F5F24FBB016ECAFC01DC9062,
				F5F24FD3016ECB4901DC9062,
				F5F24FBC016ECAFC01DC9062,
				F5F24FBD016ECAFC01DC9062,
				F5F24FBE016ECAFC01DC9062,
				F5F24FBF016ECAFC01DC9062,
				F5F24FC0016ECAFC01DC9062,
				F5F24FC1016ECAFC01DC9062,
				F5F24FC2016ECAFC01DC9062,
				F5F24FC3016ECAFC01DC9062,
				F5F24FC4016ECAFC01DC9062,
				F5F24FC5016ECAFC01DC9062,
				F5F24FC6016ECAFC01DC9062,
				F5F24FC7016ECAFC01DC9062,
				F5F24FC8016ECAFC01DC9062,
				F5F24FC9016ECAFC01DC9062,
				F5F24FCA016ECAFC01DC9062,
				F5F24FCB016ECAFC01DC9062,
				F5F24FCC016ECAFC01DC9062,
				F5F24FCD016ECAFC01DC9062,
				F5F24FCE016ECAFC01DC9062,
				F5F24FCF016ECAFC01DC9062,
				F5F24FD0016ECAFC01DC9062,
			);
			isa = PBXGroup;
			name = Sources;
			path = "";
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F855016E922C0ACA28DC = {
			children = (
				00E2F856016E92B00ACA28DC,
				00E2F854016E922C0ACA28DC,
			);
			isa = PBXGroup;
			name = generic;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F856016E92B00ACA28DC = {
			children = (
				F5F24F6B016ECAA401DC9062,
				F5F24F6C016ECAA401DC9062,
				F5F24F6D016ECAA401DC9062,
				F5F24F6E016ECAA401DC9062,
				F5F24F6F016ECAA401DC9062,
				F5F24F70016ECAA401DC9062,
				F5F24F72016ECAA401DC9062,
				F5F24F73016ECAA401DC9062,
				F5F24F74016ECAA401DC9062,
				F5F24F75016ECAA401DC9062,
				F5F24F77016ECAA401DC9062,
				F5F24F78016ECAA401DC9062,
				F5F24FD1016ECB1E01DC9062,
				F5F24FD2016ECB1E01DC9062,
			);
			isa = PBXGroup;
			name = Headers;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F857016E92B00ACA28DC = {
			children = (
				00E2F858016E92B00ACA28DC,
				00E2F859016E92B00ACA28DC,
			);
			isa = PBXGroup;
			name = macosx;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F858016E92B00ACA28DC = {
			children = (
			);
			isa = PBXGroup;
			name = Headers;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F859016E92B00ACA28DC = {
			children = (
				F5A1836F018242A501DC9062,
				F9FED5C6047C7CEC006F146B,
			);
			isa = PBXGroup;
			name = Sources;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F85A016E92B00ACA28DC = {
			children = (
				00E2F85B016E92B00ACA28DC,
				00E2F85C016E92B00ACA28DC,
			);
			isa = PBXGroup;
			name = unix;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F85B016E92B00ACA28DC = {
			children = (
				F5F24FD6016ECC0F01DC9062,
				F5F24FD7016ECC0F01DC9062,
			);
			isa = PBXGroup;
			name = Headers;
			refType = 4;
			sourceTree = "<group>";
		};
		00E2F85C016E92B00ACA28DC = {
			children = (
				F5F24FD8016ECC0F01DC9062,
				F5F24FD9016ECC0F01DC9062,
				F5F24FDB016ECC0F01DC9062,
				F5F24FDC016ECC0F01DC9062,
				F5F24FDD016ECC0F01DC9062,
				F5F24FDE016ECC0F01DC9062,
				F5F24FDF016ECC0F01DC9062,
				F5F24FE0016ECC0F01DC9062,
				F5F24FE1016ECC0F01DC9062,
				F5F24FE2016ECC0F01DC9062,
				F5F24FE3016ECC0F01DC9062,
				F5F24FE4016ECC0F01DC9062,
				F5F24FE5016ECC0F01DC9062,
				F5F24FE6016ECC0F01DC9062,
				F5F24FE7016ECC0F01DC9062,
			);
			isa = PBXGroup;
			name = Sources;
			refType = 4;
			sourceTree = "<group>";
		};
//000
//001
//002
//003
//004
//F50
//F51
//F52
//F53
//F54
		F5306C9F03CAC979016F146B = {
			children = (
				F5306CA303CAC9DE016F146B,
				F5306CA103CAC9DE016F146B,
				F5306CA203CAC9DE016F146B,
			);
			isa = PBXGroup;
			name = "Build System";
			refType = 4;
			sourceTree = "<group>";
		};
		F5306CA003CAC9AE016F146B = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = ChangeLog;
			path = ../ChangeLog;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5306CA103CAC9DE016F146B = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = text.script.sh;
			name = configure.in;
			path = ../unix/configure.in;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5306CA203CAC9DE016F146B = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = Makefile.in;
			path = ../unix/Makefile.in;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5306CA303CAC9DE016F146B = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = tcl.m4;
			path = ../unix/tcl.m4;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F53ACC5C031D9D11016F146B = {
			isa = PBXFileReference;
			lastKnownFileType = "compiled.mach-o.executable";
			path = tclsh8.5;
			refType = 3;
			sourceTree = BUILT_PRODUCTS_DIR;
		};
		F53ACC73031DA405016F146B = {
			isa = PBXFileReference;
			lastKnownFileType = "compiled.mach-o.executable";
			path = tcltest;
			refType = 3;
			sourceTree = BUILT_PRODUCTS_DIR;
		};
		F5A1836F018242A501DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			path = tclMacOSXBundle.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5C88655017D604601DC9062 = {
			children = (
				F5C88656017D604601DC9062,
				F5C88657017D60C901DC9062,
				F5C88658017D60C901DC9062,
			);
			isa = PBXGroup;
			name = "Header Tools";
			refType = 4;
			sourceTree = "<group>";
		};
		F5C88656017D604601DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = genStubs.tcl;
			path = ../tools/genStubs.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5C88657017D60C901DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = tcl.decls;
			path = ../generic/tcl.decls;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5C88658017D60C901DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = tclInt.decls;
			path = ../generic/tclInt.decls;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F6B016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = regcustom.h;
			path = ../generic/regcustom.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F6C016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = regerrs.h;
			path = ../generic/regerrs.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F6D016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = regguts.h;
			path = ../generic/regguts.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F6E016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tcl.h;
			path = ../generic/tcl.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F6F016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclCompile.h;
			path = ../generic/tclCompile.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F70016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclDecls.h;
			path = ../generic/tclDecls.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F72016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclInt.h;
			path = ../generic/tclInt.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F73016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclIntDecls.h;
			path = ../generic/tclIntDecls.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F74016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclIntPlatDecls.h;
			path = ../generic/tclIntPlatDecls.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F75016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclIO.h;
			path = ../generic/tclIO.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F77016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclPlatDecls.h;
			path = ../generic/tclPlatDecls.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F78016ECAA401DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclRegexp.h;
			path = ../generic/tclRegexp.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F87016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regc_color.c;
			path = ../generic/regc_color.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F88016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regc_cvec.c;
			path = ../generic/regc_cvec.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F89016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regc_lex.c;
			path = ../generic/regc_lex.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F8A016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regc_locale.c;
			path = ../generic/regc_locale.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F8B016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regc_nfa.c;
			path = ../generic/regc_nfa.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F8C016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regcomp.c;
			path = ../generic/regcomp.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F8D016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = rege_dfa.c;
			path = ../generic/rege_dfa.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F8E016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regerror.c;
			path = ../generic/regerror.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F8F016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regexec.c;
			path = ../generic/regexec.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F90016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regfree.c;
			path = ../generic/regfree.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F91016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = regfronts.c;
			path = ../generic/regfronts.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F92016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclAlloc.c;
			path = ../generic/tclAlloc.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F93016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclAsync.c;
			path = ../generic/tclAsync.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F94016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclBasic.c;
			path = ../generic/tclBasic.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F95016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclBinary.c;
			path = ../generic/tclBinary.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F96016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclCkalloc.c;
			path = ../generic/tclCkalloc.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F97016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclClock.c;
			path = ../generic/tclClock.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F98016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclCmdAH.c;
			path = ../generic/tclCmdAH.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F99016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclCmdIL.c;
			path = ../generic/tclCmdIL.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F9A016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclCmdMZ.c;
			path = ../generic/tclCmdMZ.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F9B016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclCompCmds.c;
			path = ../generic/tclCompCmds.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F9C016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclCompExpr.c;
			path = ../generic/tclCompExpr.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F9D016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclCompile.c;
			path = ../generic/tclCompile.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F9E016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclDate.c;
			path = ../generic/tclDate.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24F9F016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclEncoding.c;
			path = ../generic/tclEncoding.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA0016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclEnv.c;
			path = ../generic/tclEnv.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA1016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclEvent.c;
			path = ../generic/tclEvent.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA2016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclExecute.c;
			path = ../generic/tclExecute.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA3016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclFCmd.c;
			path = ../generic/tclFCmd.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA4016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclFileName.c;
			path = ../generic/tclFileName.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA5016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclGet.c;
			path = ../generic/tclGet.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA6016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclHash.c;
			path = ../generic/tclHash.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA7016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclHistory.c;
			path = ../generic/tclHistory.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA8016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclIndexObj.c;
			path = ../generic/tclIndexObj.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FA9016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclInterp.c;
			path = ../generic/tclInterp.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FAA016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclIO.c;
			path = ../generic/tclIO.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FAB016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclIOCmd.c;
			path = ../generic/tclIOCmd.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FAC016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclIOGT.c;
			path = ../generic/tclIOGT.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FAD016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclIOSock.c;
			path = ../generic/tclIOSock.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FAE016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclIOUtil.c;
			path = ../generic/tclIOUtil.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FAF016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclLink.c;
			path = ../generic/tclLink.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB0016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclListObj.c;
			path = ../generic/tclListObj.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB1016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclLiteral.c;
			path = ../generic/tclLiteral.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB2016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclLoad.c;
			path = ../generic/tclLoad.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB3016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclLoadNone.c;
			path = ../generic/tclLoadNone.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB4016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclMain.c;
			path = ../generic/tclMain.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB5016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclNamesp.c;
			path = ../generic/tclNamesp.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB6016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclNotify.c;
			path = ../generic/tclNotify.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB7016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclObj.c;
			path = ../generic/tclObj.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB8016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclPanic.c;
			path = ../generic/tclPanic.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FB9016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclParse.c;
			path = ../generic/tclParse.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FBA016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclParseExpr.c;
			path = ../generic/tclParseExpr.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FBB016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclPipe.c;
			path = ../generic/tclPipe.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FBC016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclPosixStr.c;
			path = ../generic/tclPosixStr.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FBD016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclPreserve.c;
			path = ../generic/tclPreserve.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FBE016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclProc.c;
			path = ../generic/tclProc.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FBF016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclRegexp.c;
			path = ../generic/tclRegexp.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC0016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclResolve.c;
			path = ../generic/tclResolve.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC1016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclResult.c;
			path = ../generic/tclResult.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC2016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclScan.c;
			path = ../generic/tclScan.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC3016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclStringObj.c;
			path = ../generic/tclStringObj.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC4016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclStubInit.c;
			path = ../generic/tclStubInit.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC5016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclStubLib.c;
			path = ../generic/tclStubLib.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC6016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclTest.c;
			path = ../generic/tclTest.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC7016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclTestObj.c;
			path = ../generic/tclTestObj.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC8016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclTestProcBodyObj.c;
			path = ../generic/tclTestProcBodyObj.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FC9016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclThread.c;
			path = ../generic/tclThread.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FCA016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclThreadJoin.c;
			path = ../generic/tclThreadJoin.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FCB016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclThreadTest.c;
			path = ../generic/tclThreadTest.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FCC016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclTimer.c;
			path = ../generic/tclTimer.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FCD016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUniData.c;
			path = ../generic/tclUniData.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FCE016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUtf.c;
			path = ../generic/tclUtf.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FCF016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUtil.c;
			path = ../generic/tclUtil.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD0016ECAFC01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclVar.c;
			path = ../generic/tclVar.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD1016ECB1E01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = regex.h;
			path = ../generic/regex.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD2016ECB1E01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclPort.h;
			path = ../generic/tclPort.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD3016ECB4901DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclPkg.c;
			path = ../generic/tclPkg.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD6016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclUnixPort.h;
			path = ../unix/tclUnixPort.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD7016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.h;
			name = tclUnixThrd.h;
			path = ../unix/tclUnixThrd.h;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD8016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclAppInit.c;
			path = ../unix/tclAppInit.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FD9016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclLoadDyld.c;
			path = ../unix/tclLoadDyld.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FDB016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixChan.c;
			path = ../unix/tclUnixChan.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FDC016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixEvent.c;
			path = ../unix/tclUnixEvent.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FDD016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixFCmd.c;
			path = ../unix/tclUnixFCmd.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FDE016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixFile.c;
			path = ../unix/tclUnixFile.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FDF016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixInit.c;
			path = ../unix/tclUnixInit.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE0016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixNotfy.c;
			path = ../unix/tclUnixNotfy.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE1016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixPipe.c;
			path = ../unix/tclUnixPipe.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE2016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixSock.c;
			path = ../unix/tclUnixSock.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE3016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixTest.c;
			path = ../unix/tclUnixTest.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE4016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixThrd.c;
			path = ../unix/tclUnixThrd.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE5016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclUnixTime.c;
			path = ../unix/tclUnixTime.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE6016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclXtNotify.c;
			path = ../unix/tclXtNotify.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FE7016ECC0F01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclXtTest.c;
			path = ../unix/tclXtTest.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FEE016ED0DF01DC9062 = {
			children = (
				F5F24FEF016ED0DF01DC9062,
				F5F24FF0016ED0DF01DC9062,
				F5F24FF3016ED0DF01DC9062,
				F5F24FF4016ED0DF01DC9062,
				F5F24FF5016ED0DF01DC9062,
				F5F24FF6016ED0DF01DC9062,
				F5F24FFA016ED0DF01DC9062,
				F5F24FFC016ED0DF01DC9062,
				F5F24FFE016ED0DF01DC9062,
				F5F25001016ED0DF01DC9062,
				F5F25002016ED0DF01DC9062,
				F5F25003016ED0DF01DC9062,
				F5F25005016ED0DF01DC9062,
				F5F25007016ED0DF01DC9062,
				F5F25008016ED0DF01DC9062,
				F5F2500A016ED0DF01DC9062,
			);
			isa = PBXGroup;
			name = Scripts;
			refType = 4;
			sourceTree = "<group>";
		};
		F5F24FEF016ED0DF01DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = auto.tcl;
			path = ../library/auto.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FF0016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = dde;
			path = ../library/dde;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FF3016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = encoding;
			path = ../library/encoding;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FF4016ED0DF01DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = history.tcl;
			path = ../library/history.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FF5016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = http;
			path = ../library/http;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FF6016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = http1.0;
			path = ../library/http1.0;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FFA016ED0DF01DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = init.tcl;
			path = ../library/init.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FFC016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = msgcat;
			path = ../library/msgcat;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F24FFE016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = opt;
			path = ../library/opt;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F25001016ED0DF01DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = package.tcl;
			path = ../library/package.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F25002016ED0DF01DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = parray.tcl;
			path = ../library/parray.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F25003016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = reg;
			path = ../library/reg;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F25005016ED0DF01DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = safe.tcl;
			path = ../library/safe.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F25007016ED0DF01DC9062 = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = tclIndex;
			path = ../library/tclIndex;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F25008016ED0DF01DC9062 = {
			includeInIndex = 0;
			isa = PBXFileReference;
			lastKnownFileType = folder;
			name = tcltest;
			path = ../library/tcltest;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
		F5F2500A016ED0DF01DC9062 = {
			isa = PBXFileReference;
			lastKnownFileType = text;
			name = word.tcl;
			path = ../library/word.tcl;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
//F50
//F51
//F52
//F53
//F54
//F90
//F91
//F92
//F93
//F94
		F9A61C9D04C2B4E3006F5A0B = {
			explicitFileType = wrapper.framework;
			isa = PBXFileReference;
			path = Tcl.framework;
			refType = 3;
			sourceTree = BUILT_PRODUCTS_DIR;
		};
		F9FED5C6047C7CEC006F146B = {
			fileEncoding = 30;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			path = tclMacOSXFCmd.c;
			refType = 4;
			sourceTree = "<group>";
		};
		F9FED5C7047C7D1B006F146B = {
			fileEncoding = 5;
			isa = PBXFileReference;
			lastKnownFileType = sourcecode.c.c;
			name = tclPathObj.c;
			path = ../generic/tclPathObj.c;
			refType = 2;
			sourceTree = SOURCE_ROOT;
		};
	};
	rootObject = 00E2F845016E82EB0ACA28DC;
}

Changes to macosx/Tcl.xcode/default.pbxuser.

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
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












-
+



+












+











-







// !$*UTF8*$!
{
	08FB7793FE84155DC02AAC07 /* Project object */ = {
		activeBuildConfigurationName = Debug;
		activeExecutable = F9E61D1C090A4282002B3151 /* tclsh */;
		activeTarget = F9E61D16090A3E94002B3151 /* Tcl */;
		codeSenseManager = F944EB9D08F798180049FDD4 /* Code sense */;
		executables = (
			F9E61D1C090A4282002B3151 /* tclsh */,
			F944EB8F08F798100049FDD4 /* tcltest */,
		);
		perUserDictionary = {
			com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f75708692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a0b707265666572656e63657386928497960892849a9a07666e6d617463688692849a9a008692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a0572656765788692849a9a065c2e286329248692849a9a097265637572736976658692848484084e534e756d626572008484074e5356616c7565009584012a849696018692849a9a0669734c656166869284b09db296008692849a9a0763616e536176658692af92849a9a1250425850726f6a65637453636f70654b65798692849a9a03594553868692849a9a08676c6f62616c49448692849a9a18314343304541343030343335304546393030343434313042868686>;
			com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b747970656473747265616d8103e88401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f75708692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a08676c6f62616c49448692849a9a183143433045413430303433353045463930303434343130428692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a0b707265666572656e63657386928497960892849a9a1250425850726f6a65637453636f70654b65798692849a9a035945538692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a0763616e536176658692848484084e534e756d626572008484074e5356616c7565009584012a849696018692849a9a0572656765788692849a9a065c2e286329248692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a097265637572736976658692ad92849a9a0669734c656166869284ae9db096008692849a9a07666e6d617463688692849a9a0086868686>;
		};
		sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */;
		userBuildSettings = {
			GCC = "${DEVELOPER_DIR}/usr/bin/gcc";
			SYMROOT = "${SRCROOT}/../../build/tcl";
			TCL_SRCROOT = "${SRCROOT}/../../tcl";
		};
	};
	8DD76FA90486AB0100D96B5E /* tcltest */ = {
		activeExec = 0;
		executables = (
			F944EB8F08F798100049FDD4 /* tcltest */,
		);
	};
	F944EB8F08F798100049FDD4 /* tcltest */ = {
		isa = PBXExecutable;
		activeArgIndex = 2147483647;
		activeArgIndices = (
			NO,
			NO,
			NO,
		);
		argumentStrings = (
			"${TCL_SRCROOT}/tests/all.tcl",
			"-singleproc 1",
			"-verbose \"bet\"",
		);
		autoAttachOnCrash = 1;
		breakpointsEnabled = 1;
		configStateDict = {
			"PBXLSLaunchAction-0" = {
				PBXLSLaunchAction = 0;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXLSRunLaunchConfig;
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
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







-
+
-
-
-


















+





-







	F944EB9C08F798180049FDD4 /* Source Control */ = {
		isa = PBXSourceControlManager;
		fallbackIsa = XCSourceControlManager;
		isSCMEnabled = 0;
		scmConfiguration = {
			CVSToolPath = /usr/bin/cvs;
			CVSUseSSH = NO;
			SubversionToolPath = /usr/bin/svn;
			SubversionToolPath = /usr/local/bin/svn;
			repositoryNamesForRoots = {
				.. = "";
			};
		};
		scmType = scm.cvs;
	};
	F944EB9D08F798180049FDD4 /* Code sense */ = {
		isa = PBXCodeSenseManager;
		indexTemplatePath = "";
	};
	F97258A50A86873C00096C78 /* tests */ = {
		activeExec = 0;
	};
	F9E61D16090A3E94002B3151 /* Tcl */ = {
		activeExec = 0;
		executables = (
			F9E61D1C090A4282002B3151 /* tclsh */,
		);
	};
	F9E61D1C090A4282002B3151 /* tclsh */ = {
		isa = PBXExecutable;
		activeArgIndex = 2147483647;
		activeArgIndices = (
		);
		argumentStrings = (
		);
		autoAttachOnCrash = 1;
		breakpointsEnabled = 1;
		configStateDict = {
			"PBXLSLaunchAction-0" = {
				PBXLSLaunchAction = 0;
				PBXLSLaunchStartAction = 1;
				PBXLSLaunchStdioStyle = 2;
				PBXLSLaunchStyle = 0;
				class = PBXLSRunLaunchConfig;

Changes to macosx/Tcl.xcode/project.pbxproj.

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
1
2
3
4
5

6
7
8
9
10











11
12
13
14
15
16
17





-
+




-
-
-
-
-
-
-
-
-
-
-







// !$*UTF8*$!
{
	archiveVersion = 1;
	classes = {
	};
	objectVersion = 45;
	objectVersion = 42;
	objects = {

/* Begin PBXBuildFile section */
		F90509300913A72400327603 /* tclAppInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445508F272B9004A47F5 /* tclAppInit.c */; settings = {COMPILER_FLAGS = "-DTCL_TEST -DTCL_BUILDTIME_LIBRARY=\\\"$(TCL_SRCROOT)/library\\\""; }; };
		F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
		F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
		F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
		F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
		F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
		F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
		F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
		F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; };
		F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; };
		F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; };
		F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; };
		F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; };
		F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; };
		F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; };
		F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; };
		F96D457608F272BB004A47F5 /* regfree.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED708F272A7004A47F5 /* regfree.c */; };
		F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDC08F272A7004A47F5 /* tclAlloc.c */; settings = {COMPILER_FLAGS = "-DUSE_TCLALLOC=0"; }; };
		F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDD08F272A7004A47F5 /* tclAsync.c */; };
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
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







-
+

+




+



-
+















-
-
+



+
-
-
+
+
-















-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-







		F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */; };
		F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BA08F272B3004A47F5 /* bn_mp_set.c */; };
		F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; };
		F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; };
		F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; };
		F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; };
		F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; };
		F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */; };
		F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */; };
		F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; };
		F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; };
		F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; };
		F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; };
		F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; };
		F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; };
		F96D495508F272C3004A47F5 /* bncore.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D708F272B3004A47F5 /* bncore.c */; };
		F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; };
		F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */; };
		F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */; };
		F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; settings = {COMPILER_FLAGS = "-Wno-deprecated-declarations"; }; };
		F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; };
		F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445F08F272B9004A47F5 /* tclUnixChan.c */; };
		F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446008F272B9004A47F5 /* tclUnixEvent.c */; };
		F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446108F272B9004A47F5 /* tclUnixFCmd.c */; };
		F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446208F272B9004A47F5 /* tclUnixFile.c */; };
		F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446308F272B9004A47F5 /* tclUnixInit.c */; settings = {COMPILER_FLAGS = "-DTCL_LIBRARY=\\\"$(TCL_LIBRARY)\\\" -DTCL_PACKAGE_PATH=\\\"$(TCL_PACKAGE_PATH)\\\""; }; };
		F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446408F272B9004A47F5 /* tclUnixNotfy.c */; };
		F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446508F272B9004A47F5 /* tclUnixPipe.c */; };
		F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446708F272B9004A47F5 /* tclUnixSock.c */; };
		F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446808F272B9004A47F5 /* tclUnixTest.c */; };
		F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; };
		F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; };
		F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; };
		F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; };
		F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; };
		F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; };
		F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */; };
		F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */; };
		F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; };
		F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; };
		F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; };
		F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; };
		F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; };
		F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */; };
		F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */; };
		F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; };
		F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; };
		F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; };
		F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; };
/* End PBXBuildFile section */

/* Begin PBXContainerItemProxy section */
		F97258D20A868C6F00096C78 /* PBXContainerItemProxy */ = {
			isa = PBXContainerItemProxy;
			containerPortal = 08FB7793FE84155DC02AAC07 /* Project object */;
			proxyType = 1;
			remoteGlobalIDString = 8DD76FA90486AB0100D96B5E;
			remoteInfo = tcltest;
		};
/* End PBXContainerItemProxy section */

/* Begin PBXFileReference section */
		8DD76FB20486AB0100D96B5E /* tcltest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tcltest; sourceTree = BUILT_PRODUCTS_DIR; };
		F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = "<group>"; };
		F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = "<group>"; };
		F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = "<group>"; };
		F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = "<group>"; };
		F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = "<group>"; };
		F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = "<group>"; };
		F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = "<group>"; };
		F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = "<group>"; };
		F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = "<group>"; };
		F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = "<group>"; };
		F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = "<group>"; };
		F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = "<group>"; };
		F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = "<group>"; };
		F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
		F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
		F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
		F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
		F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
		F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
		F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
		F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; };
		F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; };
		F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; };
		F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; };
		F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; };
		F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; };
		F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; };
		F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; };
		F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = "<group>"; };
		F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = "<group>"; };
		F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; };
		F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; };
		F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; };
		F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; };
		F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; };
		F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; };
		F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; };
		F96D3DFA08F272A4004A47F5 /* ChangeLog */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = ChangeLog; sourceTree = "<group>"; };
		F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = "<group>"; };
		F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = "<group>"; };
		F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = "<group>"; };
		F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = "<group>"; };
		F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = "<group>"; };
259
260
261
262
263
264
265
266

267
268
269
270
271
272
273
214
215
216
217
218
219
220

221
222
223
224
225
226
227
228







-
+







		F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChnlHdlr.3; sourceTree = "<group>"; };
		F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCloseHdlr.3; sourceTree = "<group>"; };
		F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCommand.3; sourceTree = "<group>"; };
		F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtFileHdlr.3; sourceTree = "<group>"; };
		F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = "<group>"; };
		F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = "<group>"; };
		F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = "<group>"; };
		F96D3E2208F272A5004A47F5 /* CrtAlias.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtAlias.3; sourceTree = "<group>"; };
		F96D3E2208F272A5004A47F5 /* CrtSlave.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtSlave.3; sourceTree = "<group>"; };
		F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = "<group>"; };
		F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = "<group>"; };
		F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = "<group>"; };
		F96D3E2608F272A5004A47F5 /* DetachPids.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DetachPids.3; sourceTree = "<group>"; };
		F96D3E2708F272A5004A47F5 /* dict.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dict.n; sourceTree = "<group>"; };
		F96D3E2808F272A5004A47F5 /* DictObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DictObj.3; sourceTree = "<group>"; };
		F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoOneEvent.3; sourceTree = "<group>"; };
530
531
532
533
534
535
536

537
538
539
540
541
542
543
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499







+







		F96D3F3008F272A7004A47F5 /* tclTomMath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMath.h; sourceTree = "<group>"; };
		F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTomMathInterface.c; sourceTree = "<group>"; };
		F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = "<group>"; };
		F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = "<group>"; };
		F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = "<group>"; };
		F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = "<group>"; };
		F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = "<group>"; };
		F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = "<group>"; };
		F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = "<group>"; };
		F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = "<group>"; };
		F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = "<group>"; };
		F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
		F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D3F9108F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
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
618
619
620
621
622
623
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620


621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646







+
+
+
+

+

+
+


+







+







+
+
+

-
+
+
+
+
+
+
+
+





+

+
+
+
+


+



+
+
+
+




+
+


+
+
+
+
+
+
+


+

+
+
+
+
+
+
+
+
+
+


+

+

+



-
+
+
+
+
+


-
-
+
+
+


+
+

+

+


+
+
+
+
+
+







		F96D401D08F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D401E08F272AA004A47F5 /* safe.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.tcl; sourceTree = "<group>"; };
		F96D401F08F272AA004A47F5 /* tclIndex */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclIndex; sourceTree = "<group>"; };
		F96D402108F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = "<group>"; };
		F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = "<group>"; };
		F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = "<group>"; };
		F96D425F08F272B3004A47F5 /* bn.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = bn.pdf; sourceTree = "<group>"; };
		F96D426108F272B3004A47F5 /* bn_error.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_error.c; sourceTree = "<group>"; };
		F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_invmod.c; sourceTree = "<group>"; };
		F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_montgomery_reduce.c; sourceTree = "<group>"; };
		F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = "<group>"; };
		F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_high_digs.c; sourceTree = "<group>"; };
		F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = "<group>"; };
		F96D426708F272B3004A47F5 /* bn_mp_2expt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_2expt.c; sourceTree = "<group>"; };
		F96D426808F272B3004A47F5 /* bn_mp_abs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_abs.c; sourceTree = "<group>"; };
		F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = "<group>"; };
		F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = "<group>"; };
		F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_addmod.c; sourceTree = "<group>"; };
		F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = "<group>"; };
		F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = "<group>"; };
		F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = "<group>"; };
		F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear_multi.c; sourceTree = "<group>"; };
		F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = "<group>"; };
		F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = "<group>"; };
		F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = "<group>"; };
		F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cnt_lsb.c; sourceTree = "<group>"; };
		F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = "<group>"; };
		F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = "<group>"; };
		F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = "<group>"; };
		F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = "<group>"; };
		F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = "<group>"; };
		F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = "<group>"; };
		F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = "<group>"; };
		F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_is_modulus.c; sourceTree = "<group>"; };
		F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_reduce.c; sourceTree = "<group>"; };
		F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_setup.c; sourceTree = "<group>"; };
		F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = "<group>"; };
		F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_u32.c; sourceTree = "<group>"; };
		F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = "<group>"; };
		F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod.c; sourceTree = "<group>"; };
		F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod_fast.c; sourceTree = "<group>"; };
		F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exteuclid.c; sourceTree = "<group>"; };
		F96D428308F272B3004A47F5 /* bn_mp_fread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fread.c; sourceTree = "<group>"; };
		F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fwrite.c; sourceTree = "<group>"; };
		F96D428508F272B3004A47F5 /* bn_mp_gcd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_gcd.c; sourceTree = "<group>"; };
		F96D428608F272B3004A47F5 /* bn_mp_get_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_get_int.c; sourceTree = "<group>"; };
		F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = "<group>"; };
		F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = "<group>"; };
		F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = "<group>"; };
		F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = "<group>"; };
		F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = "<group>"; };
		F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set_int.c; sourceTree = "<group>"; };
		F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = "<group>"; };
		F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod.c; sourceTree = "<group>"; };
		F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod_slow.c; sourceTree = "<group>"; };
		F96D429008F272B3004A47F5 /* bn_mp_is_square.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_is_square.c; sourceTree = "<group>"; };
		F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_jacobi.c; sourceTree = "<group>"; };
		F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = "<group>"; };
		F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = "<group>"; };
		F96D429408F272B3004A47F5 /* bn_mp_lcm.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lcm.c; sourceTree = "<group>"; };
		F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = "<group>"; };
		F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = "<group>"; };
		F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = "<group>"; };
		F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_d.c; sourceTree = "<group>"; };
		F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_calc_normalization.c; sourceTree = "<group>"; };
		F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_reduce.c; sourceTree = "<group>"; };
		F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_setup.c; sourceTree = "<group>"; };
		F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = "<group>"; };
		F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = "<group>"; };
		F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = "<group>"; };
		F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = "<group>"; };
		F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mulmod.c; sourceTree = "<group>"; };
		F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_n_root.c; sourceTree = "<group>"; };
		F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = "<group>"; };
		F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = "<group>"; };
		F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_fermat.c; sourceTree = "<group>"; };
		F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_divisible.c; sourceTree = "<group>"; };
		F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_prime.c; sourceTree = "<group>"; };
		F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_miller_rabin.c; sourceTree = "<group>"; };
		F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_next_prime.c; sourceTree = "<group>"; };
		F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_rabin_miller_trials.c; sourceTree = "<group>"; };
		F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_random_ex.c; sourceTree = "<group>"; };
		F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = "<group>"; };
		F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = "<group>"; };
		F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rand.c; sourceTree = "<group>"; };
		F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = "<group>"; };
		F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_signed_bin.c; sourceTree = "<group>"; };
		F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_unsigned_bin.c; sourceTree = "<group>"; };
		F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce.c; sourceTree = "<group>"; };
		F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k.c; sourceTree = "<group>"; };
		F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_l.c; sourceTree = "<group>"; };
		F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup.c; sourceTree = "<group>"; };
		F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup_l.c; sourceTree = "<group>"; };
		F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k.c; sourceTree = "<group>"; };
		F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k_l.c; sourceTree = "<group>"; };
		F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_setup.c; sourceTree = "<group>"; };
		F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = "<group>"; };
		F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = "<group>"; };
		F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set_int.c; sourceTree = "<group>"; };
		F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = "<group>"; };
		F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_signed_bin_size.c; sourceTree = "<group>"; };
		F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = "<group>"; };
		F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrmod.c; sourceTree = "<group>"; };
		F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = "<group>"; };
		F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = "<group>"; };
		F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = "<group>"; };
		F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_ubin.c; sourceTree = "<group>"; };
		F96D42C308F272B3004A47F5 /* bn_mp_submod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_submod.c; sourceTree = "<group>"; };
		F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin.c; sourceTree = "<group>"; };
		F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin_n.c; sourceTree = "<group>"; };
		F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = "<group>"; };
		F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = "<group>"; };
		F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = "<group>"; };
		F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = "<group>"; };
		F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_radix.c; sourceTree = "<group>"; };
		F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_ubin_size.c; sourceTree = "<group>"; };
		F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix.c; sourceTree = "<group>"; };
		F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = "<group>"; };
		F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = "<group>"; };
		F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = "<group>"; };
		F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = "<group>"; };
		F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_prime_tab.c; sourceTree = "<group>"; };
		F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = "<group>"; };
		F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = "<group>"; };
		F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_exptmod.c; sourceTree = "<group>"; };
		F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = "<group>"; };
		F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_high_digs.c; sourceTree = "<group>"; };
		F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = "<group>"; };
		F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = "<group>"; };
		F96D42D708F272B3004A47F5 /* bncore.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bncore.c; sourceTree = "<group>"; };
		F96D42D908F272B3004A47F5 /* callgraph.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = callgraph.txt; sourceTree = "<group>"; };
		F96D42DA08F272B3004A47F5 /* changes.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = changes.txt; sourceTree = "<group>"; };
		F96D42F008F272B3004A47F5 /* LICENSE */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = LICENSE; sourceTree = "<group>"; };
		F96D431D08F272B4004A47F5 /* poster.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = poster.pdf; sourceTree = "<group>"; };
		F96D432608F272B4004A47F5 /* tommath.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = tommath.pdf; sourceTree = "<group>"; };
		F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = "<group>"; };
		F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = "<group>"; };
		F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = "<group>"; };
		F96D432E08F272B5004A47F5 /* configure.ac */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure.ac; sourceTree = "<group>"; };
		F96D432F08F272B5004A47F5 /* GNUmakefile */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = GNUmakefile; sourceTree = "<group>"; };
		F96D433108F272B5004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */ = {isa = PBXFileReference; explicitFileType = text.plist; fileEncoding = 4; path = "Tcl-Info.plist.in"; sourceTree = "<group>"; };
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
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







-
+












+







		F96D436A08F272B6004A47F5 /* for-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "for-old.test"; sourceTree = "<group>"; };
		F96D436B08F272B6004A47F5 /* for.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = for.test; sourceTree = "<group>"; };
		F96D436C08F272B6004A47F5 /* foreach.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = foreach.test; sourceTree = "<group>"; };
		F96D436D08F272B6004A47F5 /* format.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = format.test; sourceTree = "<group>"; };
		F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; };
		F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = "<group>"; };
		F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = "<group>"; };
		F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = "<group>"; };
		F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = httpd; sourceTree = "<group>"; };
		F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = "<group>"; };
		F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = "<group>"; };
		F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = "<group>"; };
		F96D437508F272B6004A47F5 /* incr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "incr-old.test"; sourceTree = "<group>"; };
		F96D437608F272B6004A47F5 /* incr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = incr.test; sourceTree = "<group>"; };
		F96D437708F272B6004A47F5 /* indexObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = indexObj.test; sourceTree = "<group>"; };
		F96D437808F272B6004A47F5 /* info.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = info.test; sourceTree = "<group>"; };
		F96D437908F272B6004A47F5 /* init.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.test; sourceTree = "<group>"; };
		F96D437A08F272B6004A47F5 /* interp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = interp.test; sourceTree = "<group>"; };
		F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = "<group>"; };
		F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = "<group>"; };
		F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = "<group>"; };
		F96D437E08F272B6004A47F5 /* ioUtil.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioUtil.test; sourceTree = "<group>"; };
		F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = "<group>"; };
		F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = "<group>"; };
		F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = "<group>"; };
		F96D438208F272B6004A47F5 /* linsert.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = linsert.test; sourceTree = "<group>"; };
		F96D438308F272B6004A47F5 /* list.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = list.test; sourceTree = "<group>"; };
		F96D438408F272B6004A47F5 /* listObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = listObj.test; sourceTree = "<group>"; };
		F96D438508F272B6004A47F5 /* llength.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = llength.test; sourceTree = "<group>"; };
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
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







-
+
+














+

+
+






-
+







		F96D43CB08F272B7004A47F5 /* winFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFCmd.test; sourceTree = "<group>"; };
		F96D43CC08F272B7004A47F5 /* winFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFile.test; sourceTree = "<group>"; };
		F96D43CD08F272B7004A47F5 /* winNotify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winNotify.test; sourceTree = "<group>"; };
		F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = "<group>"; };
		F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = "<group>"; };
		F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; };
		F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
		F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; };
		F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
		F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
		F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; };
		F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; };
		F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; };
		F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
		F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
		F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
		F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
		F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
		F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; };
		F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; };
		F96D443408F272B8004A47F5 /* str2c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = str2c; sourceTree = "<group>"; };
		F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
		F96D443608F272B8004A47F5 /* tcl.wse.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.wse.in; sourceTree = "<group>"; };
		F96D443708F272B9004A47F5 /* tclmin.wse */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclmin.wse; sourceTree = "<group>"; };
		F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; };
		F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; };
		F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; };
		F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
		F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
		F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
		F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
		F96D444708F272B9004A47F5 /* pkgc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgc.c; sourceTree = "<group>"; };
		F96D444808F272B9004A47F5 /* pkgd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgd.c; sourceTree = "<group>"; };
		F96D444908F272B9004A47F5 /* pkge.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkge.c; sourceTree = "<group>"; };
		F96D444B08F272B9004A47F5 /* pkgua.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgua.c; sourceTree = "<group>"; };
817
818
819
820
821
822
823

824
825
826
827
828
829
830
831
832


833
834
835
836
837
838
839
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







+








-
+
+







		F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = "<group>"; };
		F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = "<group>"; };
		F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = "<group>"; };
		F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = "<group>"; };
		F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = "<group>"; };
		F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = "<group>"; };
		F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = "<group>"; };
		F96D446A08F272B9004A47F5 /* tclUnixThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixThrd.h; sourceTree = "<group>"; };
		F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = "<group>"; };
		F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = "<group>"; };
		F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = "<group>"; };
		F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = "<group>"; };
		F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
		F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };
		F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D447508F272BA004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
		F96D447608F272BA004A47F5 /* makefile.bc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.bc; sourceTree = "<group>"; };
		F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
		F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
		F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; };
		F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; };
		F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; };
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
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







-
-
-
-
-
-
-





-










-









-













-
+















-
-
-
-
-
-
-
-
-
-




-
















-







		F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = "<group>"; };
		F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = "<group>"; };
		F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = "<group>"; };
		F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = "<group>"; };
		F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = "<group>"; };
		F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = "<group>"; };
		F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = "<group>"; };
		F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = "<group>"; };
		F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = "<group>"; };
		F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = "<group>"; };
		F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = "<group>"; };
		F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = "<group>"; };
		F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = "<group>"; };
		F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = "<group>"; };
		F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = "<group>"; };
		F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = "<group>"; };
		F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Debug.xcconfig"; sourceTree = "<group>"; };
		F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = "<group>"; };
		F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = "<group>"; };
		F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = "<group>"; };
		F9A3084B08F2D4CE00BAE1AB /* tclsh */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tclsh; sourceTree = BUILT_PRODUCTS_DIR; };
		F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; };
		F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = "<group>"; };
		F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; };
		F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; };
		F9ECB1CA0B2652D300A28025 /* apply.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = apply.test; sourceTree = "<group>"; };
		F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = "<group>"; };
		F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = "<group>"; };
		F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = "<group>"; };
		F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = "<group>"; };
		F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = "<group>"; };
/* End PBXFileReference section */

/* Begin PBXFrameworksBuildPhase section */
		8DD76FAD0486AB0100D96B5E /* Frameworks */ = {
			isa = PBXFrameworksBuildPhase;
			buildActionMask = 2147483647;
			files = (
				F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */,
				F96437E70EF0D652003F468E /* libz.dylib in Frameworks */,
			);
			runOnlyForDeploymentPostprocessing = 0;
		};
/* End PBXFrameworksBuildPhase section */

/* Begin PBXGroup section */
		08FB7794FE84155DC02AAC07 /* Tcl */ = {
			isa = PBXGroup;
			children = (
				F96D3DF608F27169004A47F5 /* Tcl Sources */,
				F966C06F08F281DC005CB29B /* Frameworks */,
				1AB674ADFE9D54B511CA2CBB /* Products */,
			);
			comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\n";
			comments = "Copyright (c) 2004-2008 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n";
			name = Tcl;
			path = .;
			sourceTree = SOURCE_ROOT;
		};
		1AB674ADFE9D54B511CA2CBB /* Products */ = {
			isa = PBXGroup;
			children = (
				F9A3084B08F2D4CE00BAE1AB /* tclsh */,
				8DD76FB20486AB0100D96B5E /* tcltest */,
				F9A3084E08F2D4F400BAE1AB /* Tcl.framework */,
			);
			includeInIndex = 0;
			name = Products;
			sourceTree = "<group>";
		};
		F9183E690EFC81560030B814 /* pkgs */ = {
			isa = PBXGroup;
			children = (
				F9183E6A0EFC81560030B814 /* README */,
				F946FB8B0FBE3AED00CD6495 /* itcl */,
				F9183E8F0EFC817B0030B814 /* tdbc */,
			);
			path = pkgs;
			sourceTree = "<group>";
		};
		F966C06F08F281DC005CB29B /* Frameworks */ = {
			isa = PBXGroup;
			children = (
				F966C07408F2820D005CB29B /* CoreFoundation.framework */,
				F96437E60EF0D652003F468E /* libz.dylib */,
			);
			name = Frameworks;
			sourceTree = "<group>";
		};
		F96D3DF608F27169004A47F5 /* Tcl Sources */ = {
			isa = PBXGroup;
			children = (
				F96D3EC908F272A7004A47F5 /* generic */,
				F96D432C08F272B4004A47F5 /* macosx */,
				F96D443E08F272B9004A47F5 /* unix */,
				F96D425C08F272B2004A47F5 /* libtommath */,
				F96D446E08F272B9004A47F5 /* win */,
				F96D3F3808F272A7004A47F5 /* library */,
				F96D434408F272B5004A47F5 /* tests */,
				F96D3DFC08F272A4004A47F5 /* doc */,
				F96D43D008F272B8004A47F5 /* tools */,
				F9183E690EFC81560030B814 /* pkgs */,
				F96D3DFA08F272A4004A47F5 /* ChangeLog */,
				F96D3DFB08F272A4004A47F5 /* changes */,
				F96D434308F272B5004A47F5 /* README */,
				F96D432B08F272B4004A47F5 /* license.terms */,
			);
			name = "Tcl Sources";
			sourceTree = TCL_SRCROOT;
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
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







-
-






-
-








-
+



-







				F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */,
				F96D3E0E08F272A5004A47F5 /* CallDel.3 */,
				F96D3E0F08F272A5004A47F5 /* case.n */,
				F96D3E1008F272A5004A47F5 /* catch.n */,
				F96D3E1108F272A5004A47F5 /* cd.n */,
				F96D3E1208F272A5004A47F5 /* chan.n */,
				F96D3E1308F272A5004A47F5 /* ChnlStack.3 */,
				F93599CF0DF1F87F00E04F67 /* Class.3 */,
				F93599D00DF1F89E00E04F67 /* class.n */,
				F96D3E1408F272A5004A47F5 /* clock.n */,
				F96D3E1508F272A5004A47F5 /* close.n */,
				F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */,
				F96D3E1708F272A5004A47F5 /* Concat.3 */,
				F96D3E1808F272A5004A47F5 /* concat.n */,
				F96D3E1908F272A5004A47F5 /* continue.n */,
				F93599D20DF1F8DF00E04F67 /* copy.n */,
				F974D5720FBE7DC600BF728B /* coroutine.n */,
				F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */,
				F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */,
				F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */,
				F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */,
				F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */,
				F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */,
				F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */,
				F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */,
				F96D3E2208F272A5004A47F5 /* CrtAlias.3 */,
				F96D3E2208F272A5004A47F5 /* CrtSlave.3 */,
				F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */,
				F96D3E2408F272A5004A47F5 /* CrtTrace.3 */,
				F96D3E2508F272A5004A47F5 /* dde.n */,
				F93599D30DF1F8F500E04F67 /* define.n */,
				F96D3E2608F272A5004A47F5 /* DetachPids.3 */,
				F96D3E2708F272A5004A47F5 /* dict.n */,
				F96D3E2808F272A5004A47F5 /* DictObj.3 */,
				F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */,
				F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */,
				F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */,
				F96D3E2C08F272A5004A47F5 /* DString.3 */,
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1091
1092
1093
1094
1095
1096
1097

1098

1099
1100

1101
1102

1103
1104
1105
1106
1107
1108
1109







-

-


-


-







				F96D3E6C08F272A6004A47F5 /* lreplace.n */,
				F96D3E6D08F272A6004A47F5 /* lsearch.n */,
				F96D3E6E08F272A6004A47F5 /* lset.n */,
				F96D3E6F08F272A6004A47F5 /* lsort.n */,
				F96D3E7008F272A6004A47F5 /* man.macros */,
				F96D3E7108F272A6004A47F5 /* mathfunc.n */,
				F96D3E7208F272A6004A47F5 /* memory.n */,
				F93599D40DF1F91900E04F67 /* Method.3 */,
				F96D3E7308F272A6004A47F5 /* msgcat.n */,
				F93599D50DF1F93700E04F67 /* my.n */,
				F96D3E7408F272A6004A47F5 /* Namespace.3 */,
				F96D3E7508F272A6004A47F5 /* namespace.n */,
				F93599D60DF1F95000E04F67 /* next.n */,
				F96D3E7608F272A6004A47F5 /* Notifier.3 */,
				F96D3E7708F272A6004A47F5 /* Object.3 */,
				F93599D70DF1F96800E04F67 /* object.n */,
				F96D3E7808F272A6004A47F5 /* ObjectType.3 */,
				F96D3E7908F272A6004A47F5 /* open.n */,
				F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */,
				F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */,
				F96D3E7C08F272A6004A47F5 /* package.n */,
				F96D3E7D08F272A6004A47F5 /* packagens.n */,
				F96D3E7E08F272A6004A47F5 /* Panic.3 */,
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1129
1130
1131
1132
1133
1134
1135

1136
1137
1138
1139
1140
1141
1142







-







				F96D3E9008F272A6004A47F5 /* regsub.n */,
				F96D3E9108F272A6004A47F5 /* rename.n */,
				F96D3E9208F272A6004A47F5 /* return.n */,
				F96D3E9308F272A6004A47F5 /* safe.n */,
				F96D3E9408F272A6004A47F5 /* SaveResult.3 */,
				F96D3E9508F272A6004A47F5 /* scan.n */,
				F96D3E9608F272A6004A47F5 /* seek.n */,
				F93599D80DF1F98300E04F67 /* self.n */,
				F96D3E9708F272A6004A47F5 /* set.n */,
				F96D3E9808F272A6004A47F5 /* SetChanErr.3 */,
				F96D3E9908F272A6004A47F5 /* SetErrno.3 */,
				F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */,
				F96D3E9B08F272A7004A47F5 /* SetResult.3 */,
				F96D3E9C08F272A7004A47F5 /* SetVar.3 */,
				F96D3E9D08F272A7004A47F5 /* Signal.3 */,
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
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







-

-







-







-













-







				F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
				F96D3EA708F272A7004A47F5 /* string.n */,
				F96D3EA808F272A7004A47F5 /* StringObj.3 */,
				F96D3EA908F272A7004A47F5 /* StrMatch.3 */,
				F96D3EAA08F272A7004A47F5 /* subst.n */,
				F96D3EAB08F272A7004A47F5 /* SubstObj.3 */,
				F96D3EAC08F272A7004A47F5 /* switch.n */,
				F974D5760FBE7E1900BF728B /* tailcall.n */,
				F96D3EAD08F272A7004A47F5 /* Tcl.n */,
				F99D61180EF5573A00BBFE01 /* TclZlib.3 */,
				F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */,
				F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */,
				F96D3EB008F272A7004A47F5 /* tclsh.1 */,
				F96D3EB108F272A7004A47F5 /* tcltest.n */,
				F96D3EB208F272A7004A47F5 /* tclvars.n */,
				F96D3EB308F272A7004A47F5 /* tell.n */,
				F96D3EB408F272A7004A47F5 /* Thread.3 */,
				F9183E640EFC80CD0030B814 /* throw.n */,
				F96D3EB508F272A7004A47F5 /* time.n */,
				F96D3EB608F272A7004A47F5 /* tm.n */,
				F96D3EB708F272A7004A47F5 /* ToUpper.3 */,
				F96D3EB808F272A7004A47F5 /* trace.n */,
				F96D3EB908F272A7004A47F5 /* TraceCmd.3 */,
				F96D3EBA08F272A7004A47F5 /* TraceVar.3 */,
				F96D3EBB08F272A7004A47F5 /* Translate.3 */,
				F9183E650EFC80D70030B814 /* try.n */,
				F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */,
				F96D3EBD08F272A7004A47F5 /* unknown.n */,
				F96D3EBE08F272A7004A47F5 /* unload.n */,
				F96D3EBF08F272A7004A47F5 /* unset.n */,
				F96D3EC008F272A7004A47F5 /* update.n */,
				F96D3EC108F272A7004A47F5 /* uplevel.n */,
				F96D3EC208F272A7004A47F5 /* UpVar.3 */,
				F96D3EC308F272A7004A47F5 /* upvar.n */,
				F96D3EC408F272A7004A47F5 /* Utf.3 */,
				F96D3EC508F272A7004A47F5 /* variable.n */,
				F96D3EC608F272A7004A47F5 /* vwait.n */,
				F96D3EC708F272A7004A47F5 /* while.n */,
				F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */,
				F915432D0EF201EE0032D1E8 /* zlib.n */,
			);
			path = doc;
			sourceTree = "<group>";
		};
		F96D3EC908F272A7004A47F5 /* generic */ = {
			isa = PBXGroup;
			children = (
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1221
1222
1223
1224
1225
1226
1227

1228
1229
1230
1231
1232
1233
1234







-







				F96D3EE608F272A7004A47F5 /* tclCompExpr.c */,
				F96D3EE708F272A7004A47F5 /* tclCompile.c */,
				F96D3EE808F272A7004A47F5 /* tclCompile.h */,
				F96D3EE908F272A7004A47F5 /* tclConfig.c */,
				F96D3EEA08F272A7004A47F5 /* tclDate.c */,
				F96D3EEB08F272A7004A47F5 /* tclDecls.h */,
				F96D3EEC08F272A7004A47F5 /* tclDictObj.c */,
				F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */,
				F96D3EED08F272A7004A47F5 /* tclEncoding.c */,
				F96D3EEE08F272A7004A47F5 /* tclEnv.c */,
				F96D3EEF08F272A7004A47F5 /* tclEvent.c */,
				F96D3EF008F272A7004A47F5 /* tclExecute.c */,
				F96D3EF108F272A7004A47F5 /* tclFCmd.c */,
				F96D3EF208F272A7004A47F5 /* tclFileName.c */,
				F96D3EF308F272A7004A47F5 /* tclFileSystem.h */,
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
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







-











-
-
-
-
-
-
-
-
-
-
-
-
-







				F96D3EFC08F272A7004A47F5 /* tclInterp.c */,
				F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */,
				F96D3EFE08F272A7004A47F5 /* tclIO.c */,
				F96D3EFF08F272A7004A47F5 /* tclIO.h */,
				F96D3F0008F272A7004A47F5 /* tclIOCmd.c */,
				F96D3F0108F272A7004A47F5 /* tclIOGT.c */,
				F96D3F0208F272A7004A47F5 /* tclIORChan.c */,
				F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */,
				F96D3F0308F272A7004A47F5 /* tclIOSock.c */,
				F96D3F0408F272A7004A47F5 /* tclIOUtil.c */,
				F96D3F0508F272A7004A47F5 /* tclLink.c */,
				F96D3F0608F272A7004A47F5 /* tclListObj.c */,
				F96D3F0708F272A7004A47F5 /* tclLiteral.c */,
				F96D3F0808F272A7004A47F5 /* tclLoad.c */,
				F96D3F0908F272A7004A47F5 /* tclLoadNone.c */,
				F96D3F0A08F272A7004A47F5 /* tclMain.c */,
				F96D3F0B08F272A7004A47F5 /* tclNamesp.c */,
				F96D3F0C08F272A7004A47F5 /* tclNotify.c */,
				F96D3F0D08F272A7004A47F5 /* tclObj.c */,
				F93599B20DF1F75400E04F67 /* tclOO.c */,
				F93599B40DF1F75900E04F67 /* tclOO.decls */,
				F93599B50DF1F75D00E04F67 /* tclOO.h */,
				F93599B60DF1F76100E04F67 /* tclOOBasic.c */,
				F93599B80DF1F76600E04F67 /* tclOOCall.c */,
				F93599BA0DF1F76A00E04F67 /* tclOODecls.h */,
				F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */,
				F93599BD0DF1F77400E04F67 /* tclOOInfo.c */,
				F93599BF0DF1F77900E04F67 /* tclOOInt.h */,
				F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */,
				F93599C10DF1F78300E04F67 /* tclOOMethod.c */,
				F93599C30DF1F78800E04F67 /* tclOOStubInit.c */,
				F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */,
				F96D3F0E08F272A7004A47F5 /* tclPanic.c */,
				F96D3F0F08F272A7004A47F5 /* tclParse.c */,
				F96D3F1108F272A7004A47F5 /* tclPathObj.c */,
				F96D3F1208F272A7004A47F5 /* tclPipe.c */,
				F96D3F1308F272A7004A47F5 /* tclPkg.c */,
				F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */,
				F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */,
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
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







-
+












+







				F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */,
				F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */,
				F96D3F3208F272A7004A47F5 /* tclTrace.c */,
				F96D3F3308F272A7004A47F5 /* tclUniData.c */,
				F96D3F3408F272A7004A47F5 /* tclUtf.c */,
				F96D3F3508F272A7004A47F5 /* tclUtil.c */,
				F96D3F3608F272A7004A47F5 /* tclVar.c */,
				F96437C90EF0D4B2003F468E /* tclZlib.c */,
				F96D3F3708F272A7004A47F5 /* tommath.h */,
			);
			path = generic;
			sourceTree = "<group>";
		};
		F96D3F3808F272A7004A47F5 /* library */ = {
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,
				F96D3F9008F272A8004A47F5 /* http1.0 */,
				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,
1359
1360
1361
1362
1363
1364
1365









1366
1367
1368
1369
1370
1371
1372
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360







+
+
+
+
+
+
+
+
+







			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;
			sourceTree = "<group>";
		};
		F96D3F9008F272A8004A47F5 /* http1.0 */ = {
			isa = PBXGroup;
			children = (
				F96D3F9108F272A8004A47F5 /* http.tcl */,
				F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http1.0;
			sourceTree = "<group>";
		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
			);
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
1439
1440


1441
1442







1443
1444

1445










1446
1447

1448

1449

1450
1451
1452



1453


1454
1455

1456
1457


1458
1459


1460

1461

1462
1463






1464
1465
1466
1467
1468
1469
1470
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497
1498
1499


1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524







+
+
+
+

+

+
+


+







+







+
+
+

-
-
+
+
+
+
+
+
+
+





+

+
+
+
+


+



+
+
+
+




+
+


+
+
+
+
+
+
+


+

+
+
+
+
+
+
+
+
+
+


+

+

+



+
+
+
-
+
+


+
-
-
+
+


+
+

+

+


+
+
+
+
+
+







			);
			path = tcltest;
			sourceTree = "<group>";
		};
		F96D425C08F272B2004A47F5 /* libtommath */ = {
			isa = PBXGroup;
			children = (
				F96D425F08F272B3004A47F5 /* bn.pdf */,
				F96D426108F272B3004A47F5 /* bn_error.c */,
				F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */,
				F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */,
				F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */,
				F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */,
				F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */,
				F96D426708F272B3004A47F5 /* bn_mp_2expt.c */,
				F96D426808F272B3004A47F5 /* bn_mp_abs.c */,
				F96D426908F272B3004A47F5 /* bn_mp_add.c */,
				F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */,
				F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */,
				F96D426C08F272B3004A47F5 /* bn_mp_and.c */,
				F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */,
				F96D426E08F272B3004A47F5 /* bn_mp_clear.c */,
				F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */,
				F96D427008F272B3004A47F5 /* bn_mp_cmp.c */,
				F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */,
				F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */,
				F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */,
				F96D427408F272B3004A47F5 /* bn_mp_copy.c */,
				F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */,
				F96D427608F272B3004A47F5 /* bn_mp_div.c */,
				F96D427708F272B3004A47F5 /* bn_mp_div_2.c */,
				F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */,
				F96D427908F272B3004A47F5 /* bn_mp_div_3.c */,
				F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */,
				F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */,
				F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */,
				F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */,
				F96D427E08F272B3004A47F5 /* bn_mp_exch.c */,
				F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */,
				F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */,
				F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */,
				F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */,
				F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */,
				F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */,
				F96D428308F272B3004A47F5 /* bn_mp_fread.c */,
				F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */,
				F96D428508F272B3004A47F5 /* bn_mp_gcd.c */,
				F96D428608F272B3004A47F5 /* bn_mp_get_int.c */,
				F96D428708F272B3004A47F5 /* bn_mp_grow.c */,
				F96D428808F272B3004A47F5 /* bn_mp_init.c */,
				F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */,
				F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */,
				F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */,
				F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */,
				F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */,
				F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */,
				F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */,
				F96D429008F272B3004A47F5 /* bn_mp_is_square.c */,
				F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */,
				F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */,
				F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */,
				F96D429408F272B3004A47F5 /* bn_mp_lcm.c */,
				F96D429508F272B3004A47F5 /* bn_mp_lshd.c */,
				F96D429608F272B3004A47F5 /* bn_mp_mod.c */,
				F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */,
				F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */,
				F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */,
				F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */,
				F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */,
				F96D429C08F272B3004A47F5 /* bn_mp_mul.c */,
				F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */,
				F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */,
				F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */,
				F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */,
				F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */,
				F96D42A208F272B3004A47F5 /* bn_mp_neg.c */,
				F96D42A308F272B3004A47F5 /* bn_mp_or.c */,
				F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */,
				F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */,
				F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */,
				F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */,
				F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */,
				F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */,
				F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */,
				F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */,
				F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */,
				F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */,
				F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */,
				F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */,
				F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */,
				F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */,
				F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */,
				F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */,
				F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */,
				F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */,
				F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */,
				F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */,
				F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */,
				F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */,
				F96D42BA08F272B3004A47F5 /* bn_mp_set.c */,
				F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */,
				F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */,
				F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */,
				F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */,
				F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */,
				F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */,
				F96D42C108F272B3004A47F5 /* bn_mp_sub.c */,
				F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */,
				F96D42C308F272B3004A47F5 /* bn_mp_submod.c */,
				F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */,
				F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */,
				F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */,
				F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */,
				F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */,
				F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */,
				F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */,
				F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */,
				F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */,
				F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */,
				F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */,
				F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */,
				F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */,
				F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */,
				F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */,
				F96D42D008F272B3004A47F5 /* bn_reverse.c */,
				F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */,
				F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */,
				F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */,
				F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */,
				F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */,
				F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */,
				F96D42D708F272B3004A47F5 /* bncore.c */,
				F96D42D908F272B3004A47F5 /* callgraph.txt */,
				F96D42DA08F272B3004A47F5 /* changes.txt */,
				F96D42F008F272B3004A47F5 /* LICENSE */,
				F96D431D08F272B4004A47F5 /* poster.pdf */,
				F96D432608F272B4004A47F5 /* tommath.pdf */,
				F96D432908F272B4004A47F5 /* tommath_class.h */,
				F96D432A08F272B4004A47F5 /* tommath_superclass.h */,
			);
			path = libtommath;
			sourceTree = "<group>";
		};
		F96D432C08F272B4004A47F5 /* macosx */ = {
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1560
1561
1562
1563
1564
1565
1566

1567
1568
1569
1570
1571
1572
1573







-







				F96D435208F272B5004A47F5 /* cmdInfo.test */,
				F96D435308F272B5004A47F5 /* cmdMZ.test */,
				F96D435408F272B5004A47F5 /* compExpr-old.test */,
				F96D435508F272B5004A47F5 /* compExpr.test */,
				F96D435608F272B5004A47F5 /* compile.test */,
				F96D435708F272B5004A47F5 /* concat.test */,
				F96D435808F272B5004A47F5 /* config.test */,
				F974D5770FBE7E6100BF728B /* coroutine.test */,
				F96D435908F272B5004A47F5 /* dcall.test */,
				F96D435A08F272B5004A47F5 /* dict.test */,
				F96D435C08F272B5004A47F5 /* dstring.test */,
				F96D435E08F272B5004A47F5 /* encoding.test */,
				F96D435F08F272B5004A47F5 /* env.test */,
				F96D436008F272B5004A47F5 /* error.test */,
				F96D436108F272B5004A47F5 /* eval.test */,
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550

1551
1552
1553
1554
1555
1556
1557
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







-

-












+







				F96D436A08F272B6004A47F5 /* for-old.test */,
				F96D436B08F272B6004A47F5 /* for.test */,
				F96D436C08F272B6004A47F5 /* foreach.test */,
				F96D436D08F272B6004A47F5 /* format.test */,
				F96D436E08F272B6004A47F5 /* get.test */,
				F96D436F08F272B6004A47F5 /* history.test */,
				F96D437008F272B6004A47F5 /* http.test */,
				F974D56C0FBE7D6300BF728B /* http11.test */,
				F96D437108F272B6004A47F5 /* httpd */,
				F974D56D0FBE7D6300BF728B /* httpd11.tcl */,
				F96D437208F272B6004A47F5 /* httpold.test */,
				F96D437308F272B6004A47F5 /* if-old.test */,
				F96D437408F272B6004A47F5 /* if.test */,
				F96D437508F272B6004A47F5 /* incr-old.test */,
				F96D437608F272B6004A47F5 /* incr.test */,
				F96D437708F272B6004A47F5 /* indexObj.test */,
				F96D437808F272B6004A47F5 /* info.test */,
				F96D437908F272B6004A47F5 /* init.test */,
				F96D437A08F272B6004A47F5 /* interp.test */,
				F96D437B08F272B6004A47F5 /* io.test */,
				F96D437C08F272B6004A47F5 /* ioCmd.test */,
				F96D437D08F272B6004A47F5 /* iogt.test */,
				F96D437E08F272B6004A47F5 /* ioUtil.test */,
				F96D437F08F272B6004A47F5 /* join.test */,
				F96D438008F272B6004A47F5 /* lindex.test */,
				F96D438108F272B6004A47F5 /* link.test */,
				F96D438208F272B6004A47F5 /* linsert.test */,
				F96D438308F272B6004A47F5 /* list.test */,
				F96D438408F272B6004A47F5 /* listObj.test */,
				F96D438508F272B6004A47F5 /* llength.test */,
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1619
1620
1621
1622
1623
1624
1625

1626

1627
1628
1629
1630
1631
1632
1633







-

-







				F96D438E08F272B6004A47F5 /* main.test */,
				F9ECB1CB0B26534C00A28025 /* mathop.test */,
				F96D438F08F272B6004A47F5 /* misc.test */,
				F96D439008F272B6004A47F5 /* msgcat.test */,
				F96D439108F272B6004A47F5 /* namespace-old.test */,
				F96D439208F272B7004A47F5 /* namespace.test */,
				F96D439308F272B7004A47F5 /* notify.test */,
				F91DC23C0E44C51B002CB8D1 /* nre.test */,
				F96D439408F272B7004A47F5 /* obj.test */,
				F93599C80DF1F81900E04F67 /* oo.test */,
				F96D439508F272B7004A47F5 /* opt.test */,
				F96D439608F272B7004A47F5 /* package.test */,
				F96D439708F272B7004A47F5 /* parse.test */,
				F96D439808F272B7004A47F5 /* parseExpr.test */,
				F96D439908F272B7004A47F5 /* parseOld.test */,
				F96D439A08F272B7004A47F5 /* pid.test */,
				F96D439B08F272B7004A47F5 /* pkg.test */,
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1654
1655
1656
1657
1658
1659
1660

1661
1662
1663
1664
1665
1666
1667







-







				F96D43B008F272B7004A47F5 /* split.test */,
				F96D43B108F272B7004A47F5 /* stack.test */,
				F96D43B208F272B7004A47F5 /* string.test */,
				F96D43B308F272B7004A47F5 /* stringComp.test */,
				F96D43B408F272B7004A47F5 /* stringObj.test */,
				F96D43B508F272B7004A47F5 /* subst.test */,
				F96D43B608F272B7004A47F5 /* switch.test */,
				F974D5780FBE7E6100BF728B /* tailcall.test */,
				F96D43B708F272B7004A47F5 /* tcltest.test */,
				F96D43B808F272B7004A47F5 /* thread.test */,
				F96D43B908F272B7004A47F5 /* timer.test */,
				F96D43BA08F272B7004A47F5 /* tm.test */,
				F96D43BB08F272B7004A47F5 /* trace.test */,
				F96D43BC08F272B7004A47F5 /* unixFCmd.test */,
				F96D43BD08F272B7004A47F5 /* unixFile.test */,
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
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
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







-









-
+
+














+

+
+


-











-
+







-







				F96D43C908F272B7004A47F5 /* winConsole.test */,
				F96D43CA08F272B7004A47F5 /* winDde.test */,
				F96D43CB08F272B7004A47F5 /* winFCmd.test */,
				F96D43CC08F272B7004A47F5 /* winFile.test */,
				F96D43CD08F272B7004A47F5 /* winNotify.test */,
				F96D43CE08F272B7004A47F5 /* winPipe.test */,
				F96D43CF08F272B7004A47F5 /* winTime.test */,
				F915432A0EF201CF0032D1E8 /* zlib.test */,
			);
			path = tests;
			sourceTree = "<group>";
		};
		F96D43D008F272B8004A47F5 /* tools */ = {
			isa = PBXGroup;
			children = (
				F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
				F96D43D208F272B8004A47F5 /* configure */,
				F96D43D308F272B8004A47F5 /* configure.ac */,
				F96D43D308F272B8004A47F5 /* configure.in */,
				F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
				F96D442508F272B8004A47F5 /* genStubs.tcl */,
				F96D442708F272B8004A47F5 /* index.tcl */,
				F96D442808F272B8004A47F5 /* installData.tcl */,
				F96D442908F272B8004A47F5 /* loadICU.tcl */,
				F96D442A08F272B8004A47F5 /* Makefile.in */,
				F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
				F96D442C08F272B8004A47F5 /* man2help.tcl */,
				F96D442D08F272B8004A47F5 /* man2help2.tcl */,
				F96D442E08F272B8004A47F5 /* man2html.tcl */,
				F96D442F08F272B8004A47F5 /* man2html1.tcl */,
				F96D443008F272B8004A47F5 /* man2html2.tcl */,
				F96D443108F272B8004A47F5 /* man2tcl.c */,
				F96D443208F272B8004A47F5 /* README */,
				F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
				F96D443408F272B8004A47F5 /* str2c */,
				F96D443508F272B8004A47F5 /* tcl.hpj.in */,
				F96D443608F272B8004A47F5 /* tcl.wse.in */,
				F96D443708F272B9004A47F5 /* tclmin.wse */,
				F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
				F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
				F92D7F100DE777240033A13A /* tsdPerf.tcl */,
				F96D443B08F272B9004A47F5 /* uniClass.tcl */,
				F96D443C08F272B9004A47F5 /* uniParse.tcl */,
			);
			path = tools;
			sourceTree = "<group>";
		};
		F96D443E08F272B9004A47F5 /* unix */ = {
			isa = PBXGroup;
			children = (
				F96D444008F272B9004A47F5 /* aclocal.m4 */,
				F96D444108F272B9004A47F5 /* configure */,
				F96D444208F272B9004A47F5 /* configure.ac */,
				F96D444208F272B9004A47F5 /* configure.in */,
				F96D444308F272B9004A47F5 /* dltest */,
				F96D444D08F272B9004A47F5 /* install-sh */,
				F96D444E08F272B9004A47F5 /* installManPage */,
				F96D444F08F272B9004A47F5 /* ldAix */,
				F96D445008F272B9004A47F5 /* Makefile.in */,
				F96D445208F272B9004A47F5 /* README */,
				F96D445308F272B9004A47F5 /* tcl.m4 */,
				F974D5790FBE7E9C00BF728B /* tcl.pc.in */,
				F96D445408F272B9004A47F5 /* tcl.spec */,
				F96D445508F272B9004A47F5 /* tclAppInit.c */,
				F96D445608F272B9004A47F5 /* tclConfig.h.in */,
				F96D445708F272B9004A47F5 /* tclConfig.sh.in */,
				F96D445808F272B9004A47F5 /* tclLoadAix.c */,
				F96D445908F272B9004A47F5 /* tclLoadDl.c */,
				F96D445B08F272B9004A47F5 /* tclLoadDyld.c */,
1701
1702
1703
1704
1705
1706
1707

1708
1709
1710
1711
1712
1713
1714
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765







+







				F96D446308F272B9004A47F5 /* tclUnixInit.c */,
				F96D446408F272B9004A47F5 /* tclUnixNotfy.c */,
				F96D446508F272B9004A47F5 /* tclUnixPipe.c */,
				F96D446608F272B9004A47F5 /* tclUnixPort.h */,
				F96D446708F272B9004A47F5 /* tclUnixSock.c */,
				F96D446808F272B9004A47F5 /* tclUnixTest.c */,
				F96D446908F272B9004A47F5 /* tclUnixThrd.c */,
				F96D446A08F272B9004A47F5 /* tclUnixThrd.h */,
				F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
				F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
				F96D446D08F272B9004A47F5 /* tclXtTest.c */,
			);
			path = unix;
			sourceTree = "<group>";
		};
1731
1732
1733
1734
1735
1736
1737
1738


1739
1740
1741
1742
1743
1744
1745
1782
1783
1784
1785
1786
1787
1788

1789
1790
1791
1792
1793
1794
1795
1796
1797







-
+
+







			isa = PBXGroup;
			children = (
				F96D447008F272BA004A47F5 /* aclocal.m4 */,
				F96D447108F272BA004A47F5 /* buildall.vc.bat */,
				F96D447208F272BA004A47F5 /* cat.c */,
				F96D447308F272BA004A47F5 /* coffbase.txt */,
				F96D447408F272BA004A47F5 /* configure */,
				F96D447508F272BA004A47F5 /* configure.ac */,
				F96D447508F272BA004A47F5 /* configure.in */,
				F96D447608F272BA004A47F5 /* makefile.bc */,
				F96D447708F272BA004A47F5 /* Makefile.in */,
				F96D447808F272BA004A47F5 /* makefile.vc */,
				F96D447908F272BA004A47F5 /* nmakehlp.c */,
				F96D447A08F272BA004A47F5 /* README */,
				F96D447C08F272BA004A47F5 /* rules.vc */,
				F96D447D08F272BA004A47F5 /* stub16.c */,
				F96D447E08F272BA004A47F5 /* tcl.dsp */,
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
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
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
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







-
+


-
+















-
+














-
+















-
-
-

-













-
+














-






-

-
+






-




-
+
-

-
+







-





-
+
-

-
+






-
+






-





-
+
-







/* End PBXGroup section */

/* Begin PBXNativeTarget section */
		8DD76FA90486AB0100D96B5E /* tcltest */ = {
			isa = PBXNativeTarget;
			buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */;
			buildPhases = (
				F9A5C5F508F651A2008AE941 /* Configure Tcl */,
				F9A5C5F508F651A2008AE941 /* ShellScript */,
				8DD76FAB0486AB0100D96B5E /* Sources */,
				8DD76FAD0486AB0100D96B5E /* Frameworks */,
				F95FA74C0B32CE190072E431 /* Build dltest */,
				F95FA74C0B32CE190072E431 /* ShellScript */,
			);
			buildRules = (
			);
			dependencies = (
			);
			name = tcltest;
			productInstallPath = "$(BINDIR)";
			productName = tcltest;
			productReference = 8DD76FB20486AB0100D96B5E /* tcltest */;
			productType = "com.apple.product-type.tool";
		};
		F97258A50A86873C00096C78 /* tests */ = {
			isa = PBXNativeTarget;
			buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */;
			buildPhases = (
				F97258A40A86873C00096C78 /* Run Testsuite */,
				F97258A40A86873C00096C78 /* ShellScript */,
			);
			buildRules = (
			);
			dependencies = (
				F97258D30A868C6F00096C78 /* PBXTargetDependency */,
			);
			name = tests;
			productName = tests;
			productType = "com.apple.product-type.bundle";
		};
		F9E61D16090A3E94002B3151 /* Tcl */ = {
			isa = PBXNativeTarget;
			buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */;
			buildPhases = (
				F97AF02F0B665DA900310EA2 /* Build Tcl */,
				F97AF02F0B665DA900310EA2 /* ShellScript */,
			);
			buildRules = (
			);
			dependencies = (
			);
			name = Tcl;
			productName = tclsh;
			productReference = F9A3084B08F2D4CE00BAE1AB /* tclsh */;
			productType = "com.apple.product-type.tool";
		};
/* End PBXNativeTarget section */

/* Begin PBXProject section */
		08FB7793FE84155DC02AAC07 /* Project object */ = {
			isa = PBXProject;
			attributes = {
				BuildIndependentTargetsInParallel = YES;
			};
			buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */;
			compatibilityVersion = "Xcode 3.1";
			hasScannedForEncodings = 1;
			mainGroup = 08FB7794FE84155DC02AAC07 /* Tcl */;
			projectDirPath = "";
			projectRoot = ..;
			targets = (
				F9E61D16090A3E94002B3151 /* Tcl */,
				8DD76FA90486AB0100D96B5E /* tcltest */,
				F97258A50A86873C00096C78 /* tests */,
			);
		};
/* End PBXProject section */

/* Begin PBXShellScriptBuildPhase section */
		F95FA74C0B32CE190072E431 /* Build dltest */ = {
		F95FA74C0B32CE190072E431 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
				"$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
				"$(TCL_SRCROOT)/generic/tclStubLib.c",
				"$(TCL_SRCROOT)/unix/dltest/pkga.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgb.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgc.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgd.c",
				"$(TCL_SRCROOT)/unix/dltest/pkge.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgua.c",
			);
			name = "Build dltest";
			outputPaths = (
				"$(DERIVED_FILE_DIR)/tcl/dltest.marker",
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "## dltest build script phase\n\nrm -f \"${DERIVED_FILE_DIR}/tcl/dltest.marker\"\nmake -C \"${DERIVED_FILE_DIR}/tcl\" dltest.marker\nln -fsh \"${DERIVED_FILE_DIR}/tcl/dltest\" \"${CONFIGURATION_BUILD_DIR}\"\n";
			showEnvVarsInLog = 0;
		};
		F97258A40A86873C00096C78 /* Run Testsuite */ = {
		F97258A40A86873C00096C78 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
			);
			name = "Run Testsuite";
			outputPaths = (
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.5\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
			shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.2\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\n# following test only fails when testsuite is run from inside Xcode, so skip it\nconfigure -skip [concat [configure -skip] stack-3.1]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
			showEnvVarsInLog = 0;
		};
		F97AF02F0B665DA900310EA2 /* Build Tcl */ = {
		F97AF02F0B665DA900310EA2 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
				"${TARGET_TEMP_DIR}/.none",
			);
			name = "Build Tcl";
			outputPaths = (
				"${TARGET_BUILD_DIR}/${EXECUTABLE_NAME}",
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\nexport CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n";
			shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n";
			showEnvVarsInLog = 0;
		};
		F9A5C5F508F651A2008AE941 /* Configure Tcl */ = {
		F9A5C5F508F651A2008AE941 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
				"$(TCL_SRCROOT)/macosx/configure.ac",
				"$(TCL_SRCROOT)/unix/configure.ac",
				"$(TCL_SRCROOT)/unix/configure.in",
				"$(TCL_SRCROOT)/unix/tcl.m4",
				"$(TCL_SRCROOT)/unix/aclocal.m4",
				"$(TCL_SRCROOT)/unix/tclConfig.sh.in",
				"$(TCL_SRCROOT)/unix/Makefile.in",
				"$(TCL_SRCROOT)/unix/dltest/Makefile.in",
			);
			name = "Configure Tcl";
			outputPaths = (
				"$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.ac -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n    echo \"Running autoconf & autoheader in tcl/macosx\"\n    rm -rf autom4te.cache\n    ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n    rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n    echo \"Configuring Tcl\"\n    CC=$(xcrun -find ${GCC} || echo ${GCC})\n    \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n    ./config.status\nfi\n";
			shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n    echo \"Running autoconf & autoheader in tcl/macosx\"\n    rm -rf autom4te.cache\n    ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n    rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n    echo \"Configuring Tcl\"\n    \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared ${CONFIGURE_ARGS}\nelse\n    ./config.status\nfi\n";
			showEnvVarsInLog = 0;
		};
/* End PBXShellScriptBuildPhase section */

/* Begin PBXSourcesBuildPhase section */
		8DD76FAB0486AB0100D96B5E /* Sources */ = {
			isa = PBXSourcesBuildPhase;
			buildActionMask = 2147483647;
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
2014
2015
2016
2017
2018
2019
2020

2021
2022
2023
2024
2025
2026
2027
2028
2029
2030








2031
2032
2033
2034
2035
2036
2037







-










-
-
-
-
-
-
-
-







				F96D459608F272BC004A47F5 /* tclHistory.c in Sources */,
				F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */,
				F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */,
				F96D459D08F272BC004A47F5 /* tclIO.c in Sources */,
				F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */,
				F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */,
				F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */,
				F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */,
				F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */,
				F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */,
				F96D45A408F272BC004A47F5 /* tclLink.c in Sources */,
				F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */,
				F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */,
				F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */,
				F96D45A908F272BC004A47F5 /* tclMain.c in Sources */,
				F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */,
				F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */,
				F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */,
				F93599B30DF1F75400E04F67 /* tclOO.c in Sources */,
				F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */,
				F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */,
				F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */,
				F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */,
				F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */,
				F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */,
				F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */,
				F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */,
				F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */,
				F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */,
				F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */,
				F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */,
				F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */,
				F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */,
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
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







-




















-
+
-







				F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */,
				F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */,
				F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */,
				F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */,
				F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */,
				F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */,
				F96D45D508F272BC004A47F5 /* tclVar.c in Sources */,
				F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */,
				F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */,
				F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */,
				F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */,
				F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */,
				F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */,
				F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */,
				F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */,
				F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */,
				F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */,
				F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */,
				F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */,
				F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */,
				F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */,
				F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */,
				F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */,
				F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */,
				F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */,
				F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */,
				F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */,
				F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */,
				F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */,
				F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */,
				F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */,
				F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */,
				F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */,
				F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */,
				F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */,
				F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */,
				F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */,
				F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */,
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
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







+
-
+


-
-
+
+


+




+

















-







				F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */,
				F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */,
				F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */,
				F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */,
				F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */,
				F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */,
				F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */,
				F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */,
				F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */,
				F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */,
				F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */,
				F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */,
				F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */,
				F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */,
				F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */,
				F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */,
				F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */,
				F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */,
				F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */,
				F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */,
				F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */,
				F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */,
				F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */,
				F96D495508F272C3004A47F5 /* bncore.c in Sources */,
				F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */,
				F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */,
				F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */,
				F90509300913A72400327603 /* tclAppInit.c in Sources */,
				F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */,
				F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */,
				F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */,
				F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */,
				F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */,
				F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */,
				F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */,
				F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */,
				F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */,
				F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */,
				F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */,
				F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */,
				F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */,
				F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */,
			);
			runOnlyForDeploymentPostprocessing = 0;
		};
/* End PBXSourcesBuildPhase section */

/* Begin PBXTargetDependency section */
		F97258D30A868C6F00096C78 /* PBXTargetDependency */ = {
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145












2146
2147
2148
2149
2150
2151
2152
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







-
-
-
+
+
+
+
+
+
+
+
+
+
+
+







			};
			name = ReleaseUniversal;
		};
		F91BCC51093152310042A6BF /* ReleaseUniversal */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ARCHS = (
					ppc,
					ppc64,
					i386,
					x86_64,
				);
				CFLAGS = "-arch ppc -arch ppc64 -arch i386 -arch x86_64 $(CFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.4;
				OTHER_LDFLAGS = (
					"-Wl,-no_arch_warnings",
					"$(OTHER_LDFLAGS)",
				);
				PREBINDING = NO;
			};
			name = ReleaseUniversal;
		};
		F93084370BB93D2800CD0B9E /* DebugMemCompile */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
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
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







-











-
-
-
-

-
-
+
-








-
-
-
-
-


-
+
-







				PRODUCT_NAME = tcltest;
			};
			name = DebugMemCompile;
		};
		F93084390BB93D2800CD0B9E /* DebugMemCompile */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugMemCompile;
		};
		F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugMemCompile;
		};
		F9359B250DF212DA00E04F67 /* DebugGCov */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC_GENERATE_TEST_COVERAGE_FILES = YES;
				GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				OTHER_LDFLAGS = (
					"$(OTHER_LDFLAGS)",
					"-lgcov",
				);
				PREBINDING = NO;
			};
			name = DebugGCov;
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233

2234
2235
2236
2237
2238
2239
2240
2251
2252
2253
2254
2255
2256
2257

2258

2259
2260
2261
2262
2263
2264
2265
2266







-

-
+







				PRODUCT_NAME = tcltest;
			};
			name = DebugGCov;
		};
		F9359B280DF212DA00E04F67 /* DebugGCov */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCLTEST_OPTIONS = "-notfile http.test";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugGCov;
		};
		F95CC8AC09158F3100EA5ACE /* Debug */ = {
			isa = XCBuildConfiguration;
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
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







-
+





-
+













+










-
+




-
+





-
-
-
-
-
-
+
-








-
-
-
-
-
-
+
-
-
+



-
+



-
-
-
-
-
-
+
-


-
+




-










-







-
+


-





-
+




-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















-














-
+








-
-
-
-

-
-
+
-







			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = Release;
		};
		F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = {
		F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F95CC8B109158F3100EA5ACE /* Debug */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
				GCC_DYNAMIC_NO_PIC = NO;
				GCC_ENABLE_FIX_AND_CONTINUE = YES;
				GCC_PREPROCESSOR_DEFINITIONS = (
					"__private_extern__=extern",
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
				);
				GCC_SYMBOLS_PRIVATE_EXTERN = NO;
				PRODUCT_NAME = tcltest;
				ZERO_LINK = YES;
			};
			name = Debug;
		};
		F95CC8B209158F3100EA5ACE /* Release */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = Release;
		};
		F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = {
		F95CC8B309158F3100EA5ACE /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F95CC8B609158F3100EA5ACE /* Debug */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = Debug;
		};
		F95CC8B709158F3100EA5ACE /* Release */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
				PREBINDING = YES;
			};
			name = Release;
		};
		F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = {
		F95CC8B809158F3100EA5ACE /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F97258A90A86873D00096C78 /* Debug */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = Debug;
		};
		F97258AA0A86873D00096C78 /* Release */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = Release;
		};
		F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = {
		F97258AB0A86873D00096C78 /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F97258AC0A86873D00096C78 /* ReleaseUniversal */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleaseUniversal;
		};
		F97AED080B660A6C00310EA2 /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleaseUniversal10.4uSDK;
		};
		F97AED0F0B660AA300310EA2 /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleasePPC10.3.9SDK;
		};
		F97AED160B660AF100310EA2 /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleasePPC10.2.8SDK;
		};
		F97AED1B0B660B2100310EA2 /* Debug64bit */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = Debug64bit;
		};
		F97AED1C0B660B2100310EA2 /* Debug64bit */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = Debug64bit;
		};
		F97AED1D0B660B2100310EA2 /* Debug64bit */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = Debug64bit;
		};
		F97AED1E0B660B2100310EA2 /* Debug64bit */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = "$(NATIVE_ARCH_64_BIT)";
				CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)";
				CPPFLAGS = "-arch $(NATIVE_ARCH_64_BIT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				PREBINDING = NO;
			};
			name = Debug64bit;
		};
		F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugNoCF;
		};
		F98751300DE7B57E00B1C9EC /* DebugNoCF */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
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
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







-











-
-
-
-

-
-
+
-







				PRODUCT_NAME = tcltest;
			};
			name = DebugNoCF;
		};
		F98751320DE7B57E00B1C9EC /* DebugNoCF */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugNoCF;
		};
		F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugNoCFUnthreaded;
		};
		F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2509
2510
2511
2512
2513
2514
2515

2516
2517
2518
2519
2520
2521
2522




















































































































































































2523
2524
2525
2526
2527
2528
2529







-







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







				PRODUCT_NAME = tcltest;
			};
			name = DebugNoCFUnthreaded;
		};
		F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugNoCFUnthreaded;
		};
		F9988AB10D814C6500B6B03B /* Debug gcc40 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC_VERSION = 4.0;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = "Debug gcc40";
		};
		F9988AB20D814C6500B6B03B /* Debug gcc40 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "Debug gcc40";
		};
		F9988AB30D814C6500B6B03B /* Debug gcc40 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
				GCC_DYNAMIC_NO_PIC = NO;
				GCC_ENABLE_FIX_AND_CONTINUE = YES;
				GCC_PREPROCESSOR_DEFINITIONS = (
					"__private_extern__=extern",
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
				);
				GCC_SYMBOLS_PRIVATE_EXTERN = NO;
				PRODUCT_NAME = tcltest;
			};
			name = "Debug gcc40";
		};
		F9988AB40D814C6500B6B03B /* Debug gcc40 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "Debug gcc40";
		};
		F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC = "llvm-gcc";
				GCC_VERSION = com.apple.compilers.llvmgcc42;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = "Debug llvm-gcc";
		};
		F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "Debug llvm-gcc";
		};
		F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
				GCC_DYNAMIC_NO_PIC = NO;
				GCC_ENABLE_FIX_AND_CONTINUE = YES;
				GCC_PREPROCESSOR_DEFINITIONS = (
					"__private_extern__=extern",
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
				);
				GCC_SYMBOLS_PRIVATE_EXTERN = NO;
				PRODUCT_NAME = tcltest;
			};
			name = "Debug llvm-gcc";
		};
		F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "Debug llvm-gcc";
		};
		F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				GCC_VERSION = 4.0;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
			};
			name = "ReleaseUniversal gcc40";
		};
		F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "ReleaseUniversal gcc40";
		};
		F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = "ReleaseUniversal gcc40";
		};
		F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "ReleaseUniversal gcc40";
		};
		F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				DEBUG_INFORMATION_FORMAT = dwarf;
				GCC = "llvm-gcc";
				GCC_OPTIMIZATION_LEVEL = 4;
				GCC_VERSION = com.apple.compilers.llvmgcc42;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
			};
			name = "ReleaseUniversal llvm-gcc";
		};
		F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "ReleaseUniversal llvm-gcc";
		};
		F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = "ReleaseUniversal llvm-gcc";
		};
		F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "ReleaseUniversal llvm-gcc";
		};
		F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = DebugUnthreaded;
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745

2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764

2765
2766
2767
2768
2769
2770

2771
2772
2773
2774
2775
2776

2777





2778






























































2779
2780
2781
2782
2783

2784
2785

2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805














2806
2807

2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818

2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830



2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841

2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853



2854
2855
2856
2857
2858
2859
2860
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714



2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725



2726
2727
2728
2729
2730
2731
2732
2733
2734
2735



2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746



2747
2748
2749
2750
2751
2752
2753
2754
2755
2756



2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767



2768
2769
2770
2771
2772
2773
2774
2775
2776
2777



2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788







-










-











-
-
-
-

-
-
+
-








-
-
-
-
-




-
+
-




-
+





-
+

+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+

-
+

-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+








-
-
-
+









-
-
-
+
+
+








-
-
-
+









-
-
-
+
+
+








-
-
-
+









-
-
-
+
+
+








-
-
-
+









-
-
-
+
+
+








				PRODUCT_NAME = tcltest;
			};
			name = DebugLeaks;
		};
		F99EE73F0BE835310060D4AF /* DebugUnthreaded */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugUnthreaded;
		};
		F99EE7400BE835310060D4AF /* DebugLeaks */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugLeaks;
		};
		F99EE7410BE835310060D4AF /* DebugUnthreaded */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugUnthreaded;
		};
		F99EE7420BE835310060D4AF /* DebugLeaks */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC_PREPROCESSOR_DEFINITIONS = (
					PURIFY,
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
				);
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugLeaks;
		};
		F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
		F9DB62080B65ADA800A370FB /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = ReleaseUniversal10.5SDK;
			name = ReleaseUniversal10.4uSDK;
		};
		F9DB62090B65ADA800A370FB /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
		F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
			name = ReleaseUniversal10.4uSDK;
		};
		F9DB620A0B65ADA800A370FB /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = (
					ppc,
					ppc64,
					i386,
					x86_64,
				);
				CFLAGS = "-arch ppc -arch ppc64 -arch i386 -arch x86_64 $(CFLAGS)";
				CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.4;
				OTHER_LDFLAGS = (
					"-Wl,-no_arch_warnings",
					"$(OTHER_LDFLAGS)",
				);
				PREBINDING = NO;
				SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk;
			};
			name = ReleaseUniversal10.4uSDK;
		};
		F9DB621F0B65AFDE00A370FB /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				LDFLAGS = "-force_cpusubtype_ALL $(LDFLAGS)";
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = ReleasePPC10.3.9SDK;
		};
		F9DB62200B65AFDE00A370FB /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = ReleasePPC10.3.9SDK;
		};
		F9DB62210B65AFDE00A370FB /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = ppc;
				CFLAGS = "$(PER_ARCH_CFLAGS_ppc) $(CFLAGS)";
				CPPFLAGS = "-arch ppc -isysroot $(SDKROOT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.3;
				PREBINDING = YES;
				SDKROOT = /Developer/SDKs/MacOSX10.3.9.sdk;
			};
			name = ReleasePPC10.3.9SDK;
		};
		F9DB62350B65B03A00A370FB /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = ReleasePPC10.2.8SDK;
		};
		F9DB62360B65B03A00A370FB /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = ReleaseUniversal10.5SDK;
			name = ReleasePPC10.2.8SDK;
		};
		F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
		F9DB62370B65B03A00A370FB /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleaseUniversal10.5SDK;
		};
		F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
				SDKROOT = macosx10.5;
				ARCHS = ppc;
				CFLAGS = "$(PER_ARCH_CFLAGS_ppc) -fconstant-cfstrings $(CFLAGS)";
				CPPFLAGS = "-arch ppc -D__CONSTANT_CFSTRINGS__ -DMAC_OS_X_VERSION_MIN_REQUIRED=1020 -nostdinc -isystem $(SDKROOT)/usr/include/gcc/darwin/$(GCC_VERSION) -isystem $(SDKROOT)/usr/include -F$(SDKROOT)/System/Library/Frameworks";
				DEBUG_INFORMATION_FORMAT = stabs;
				GCC = /usr/bin/gcc;
				GCC_VERSION = 3.3;
				LDFLAGS = "-L$(SDKROOT)/usr/lib/gcc/darwin/$(GCC_VERSION) -Wl,-syslibroot,$(SDKROOT)";
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				PREBINDING = YES;
				SDKROOT = /Developer/SDKs/MacOSX10.2.8.sdk;
				WARNING_CFLAGS = (
					"$(WARNING_CFLAGS_GCC3)",
					"-Wno-long-double",
				);
			};
			name = ReleaseUniversal10.5SDK;
			name = ReleasePPC10.2.8SDK;
		};
/* End XCBuildConfiguration section */

/* Begin XCConfigurationList section */
		F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F95CC8AC09158F3100EA5ACE /* Debug */,
				F9988AB60D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB20D814C6500B6B03B /* Debug gcc40 */,
				F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */,
				F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */,
				F99EE73B0BE835310060D4AF /* DebugUnthreaded */,
				F98751300DE7B57E00B1C9EC /* DebugNoCF */,
				F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F93084370BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE73C0BE835310060D4AF /* DebugLeaks */,
				F9359B260DF212DA00E04F67 /* DebugGCov */,
				F97AED1B0B660B2100310EA2 /* Debug64bit */,
				F95CC8AD09158F3100EA5ACE /* Release */,
				F91BCC4F093152310042A6BF /* ReleaseUniversal */,
				F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F9DB62080B65ADA800A370FB /* ReleaseUniversal10.4uSDK */,
				F9DB621F0B65AFDE00A370FB /* ReleasePPC10.3.9SDK */,
				F9DB62350B65B03A00A370FB /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
		F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F95CC8B109158F3100EA5ACE /* Debug */,
				F9988AB70D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB30D814C6500B6B03B /* Debug gcc40 */,
				F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */,
				F95CC8B309158F3100EA5ACE /* DebugNoFixZL */,
				F99EE73D0BE835310060D4AF /* DebugUnthreaded */,
				F98751310DE7B57E00B1C9EC /* DebugNoCF */,
				F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F93084380BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE73E0BE835310060D4AF /* DebugLeaks */,
				F9359B270DF212DA00E04F67 /* DebugGCov */,
				F97AED1C0B660B2100310EA2 /* Debug64bit */,
				F95CC8B209158F3100EA5ACE /* Release */,
				F91BCC50093152310042A6BF /* ReleaseUniversal */,
				F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F9DB62090B65ADA800A370FB /* ReleaseUniversal10.4uSDK */,
				F9DB62200B65AFDE00A370FB /* ReleasePPC10.3.9SDK */,
				F9DB62360B65B03A00A370FB /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
		F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F95CC8B609158F3100EA5ACE /* Debug */,
				F9988AB50D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB10D814C6500B6B03B /* Debug gcc40 */,
				F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */,
				F95CC8B809158F3100EA5ACE /* DebugNoFixZL */,
				F99EE7410BE835310060D4AF /* DebugUnthreaded */,
				F987512F0DE7B57E00B1C9EC /* DebugNoCF */,
				F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F930843A0BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE7420BE835310060D4AF /* DebugLeaks */,
				F9359B250DF212DA00E04F67 /* DebugGCov */,
				F97AED1E0B660B2100310EA2 /* Debug64bit */,
				F95CC8B709158F3100EA5ACE /* Release */,
				F91BCC51093152310042A6BF /* ReleaseUniversal */,
				F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F9DB620A0B65ADA800A370FB /* ReleaseUniversal10.4uSDK */,
				F9DB62210B65AFDE00A370FB /* ReleasePPC10.3.9SDK */,
				F9DB62370B65B03A00A370FB /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
		F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F97258A90A86873D00096C78 /* Debug */,
				F9988AB80D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB40D814C6500B6B03B /* Debug gcc40 */,
				F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */,
				F97258AB0A86873D00096C78 /* DebugNoFixZL */,
				F99EE73F0BE835310060D4AF /* DebugUnthreaded */,
				F98751320DE7B57E00B1C9EC /* DebugNoCF */,
				F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F93084390BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE7400BE835310060D4AF /* DebugLeaks */,
				F9359B280DF212DA00E04F67 /* DebugGCov */,
				F97AED1D0B660B2100310EA2 /* Debug64bit */,
				F97258AA0A86873D00096C78 /* Release */,
				F97258AC0A86873D00096C78 /* ReleaseUniversal */,
				F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F97AED080B660A6C00310EA2 /* ReleaseUniversal10.4uSDK */,
				F97AED0F0B660AA300310EA2 /* ReleasePPC10.3.9SDK */,
				F97AED160B660AF100310EA2 /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
/* End XCConfigurationList section */
	};
	rootObject = 08FB7793FE84155DC02AAC07 /* Project object */;
}

Changes to macosx/Tcl.xcodeproj/default.pbxuser.

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16



17
18
19
20
21
22
23
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












-
+



+
+
+







// !$*UTF8*$!
{
	08FB7793FE84155DC02AAC07 /* Project object */ = {
		activeBuildConfigurationName = Debug;
		activeExecutable = F9E61D1C090A4282002B3151 /* tclsh */;
		activeTarget = F9E61D16090A3E94002B3151 /* Tcl */;
		codeSenseManager = F944EB9D08F798180049FDD4 /* Code sense */;
		executables = (
			F9E61D1C090A4282002B3151 /* tclsh */,
			F944EB8F08F798100049FDD4 /* tcltest */,
		);
		perUserDictionary = {
			com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a0b707265666572656e63657386928497960892849a9a0669734c6561668692848484084e534e756d626572008484074e5356616c7565009584012a849696008692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a09726563757273697665869284a29da496018692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a0763616e536176658692a892849a9a1250425850726f6a65637453636f70654b65798692849a9a035945538692849a9a0572656765788692849a9a065c2e286329248692849a9a07666e6d617463688692849a9a00868692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a08676c6f62616c49448692849a9a183143433045413430303433353045463930303434343130428692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f7570868686>;
			com.apple.ide.smrt.PBXUserSmartGroupsKey.Rev10 = <040b73747265616d747970656481e8038401408484840e4e534d757461626c654172726179008484074e534172726179008484084e534f626a65637400858401690192848484134e534d757461626c6544696374696f6e6172790084840c4e5344696374696f6e6172790095960792848484084e53537472696e67019584012b046e616d658692849a9a14496d706c656d656e746174696f6e2046696c65738692849a9a146162736f6c75746550617468546f42756e646c658692849a9a008692849a9a195042585472616e7369656e744c6f636174696f6e4174546f708692849a9a06626f74746f6d8692849a9a03636c7a8692849a9a1550425846696c656e616d65536d61727447726f75708692849a9a0b6465736372697074696f6e8692849a9a103c6e6f206465736372697074696f6e3e8692849a9a0b707265666572656e63657386928497960892849a9a07666e6d617463688692849a9a008692849a9a05696d6167658692849a9a0b536d617274466f6c6465728692849a9a04726f6f748692849a9a093c50524f4a4543543e8692849a9a0572656765788692849a9a065c2e286329248692849a9a097265637572736976658692848484084e534e756d626572008484074e5356616c7565009584012a849696018692849a9a0669734c656166869284b09db296008692849a9a0763616e536176658692af92849a9a1250425850726f6a65637453636f70654b65798692849a9a03594553868692849a9a08676c6f62616c49448692849a9a18314343304541343030343335304546393030343434313042868686>;
		};
		sourceControlManager = F944EB9C08F798180049FDD4 /* Source Control */;
		userBuildSettings = {
			AUTOCONF = "/usr/local/bin/autoconf-2.59";
			AUTOHEADER = "/usr/local/bin/autoheader-2.59";
			CODE_SIGN_IDENTITY = "";
			SYMROOT = "${SRCROOT}/../../build/tcl";
			TCL_SRCROOT = "${SRCROOT}/../../tcl";
		};
	};
	8DD76FA90486AB0100D96B5E /* tcltest */ = {
		activeExec = 0;
		executables = (
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
62
63
64
65
66
67
68



69
70
71
72
73
74
75







-
-
-







				displayName = GDB;
				identifier = com.apple.Xcode.launch.GDBMI_Config;
				remoteHostInfo = "";
				startActionInfo = "";
			};
		};
		customDataFormattersEnabled = 1;
		dataTipCustomDataFormattersEnabled = 1;
		dataTipShowTypeColumn = 1;
		dataTipSortType = 0;
		debuggerPlugin = GDBDebugging;
		disassemblyDisplayState = 0;
		dylibVariantSuffix = "";
		enableDebugStr = 0;
		environmentEntries = (
			{
				active = YES;
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
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







-







-
-
-




-
-
-







				value = 1;
			},
		);
		executableSystemSymbolLevel = 0;
		executableUserSymbolLevel = 0;
		libgmallocEnabled = 0;
		name = tcltest;
		showTypeColumn = 0;
		sourceDirectories = (
		);
	};
	F944EB9C08F798180049FDD4 /* Source Control */ = {
		isa = PBXSourceControlManager;
		fallbackIsa = XCSourceControlManager;
		isSCMEnabled = 0;
		repositoryNamesForRoots = {
			.. = "";
		};
		scmConfiguration = {
			CVSToolPath = /usr/bin/cvs;
			CVSUseSSH = NO;
			SubversionToolPath = /usr/bin/svn;
			repositoryNamesForRoots = {
				.. = "";
			};
		};
		scmType = scm.cvs;
	};
	F944EB9D08F798180049FDD4 /* Code sense */ = {
		isa = PBXCodeSenseManager;
		indexTemplatePath = "";
	};
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
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







-
-
-














-




				displayName = GDB;
				identifier = com.apple.Xcode.launch.GDBMI_Config;
				remoteHostInfo = "";
				startActionInfo = "";
			};
		};
		customDataFormattersEnabled = 1;
		dataTipCustomDataFormattersEnabled = 1;
		dataTipShowTypeColumn = 1;
		dataTipSortType = 0;
		debuggerPlugin = GDBDebugging;
		disassemblyDisplayState = 0;
		dylibVariantSuffix = _debug;
		enableDebugStr = 0;
		environmentEntries = (
			{
				active = NO;
				name = DYLD_PRINT_LIBRARIES;
			},
		);
		executableSystemSymbolLevel = 0;
		executableUserSymbolLevel = 0;
		libgmallocEnabled = 0;
		name = tclsh;
		showTypeColumn = 0;
		sourceDirectories = (
		);
	};
}

Changes to macosx/Tcl.xcodeproj/project.pbxproj.

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
1
2
3
4
5

6
7
8
9
10











11
12
13
14
15
16
17





-
+




-
-
-
-
-
-
-
-
-
-
-







// !$*UTF8*$!
{
	archiveVersion = 1;
	classes = {
	};
	objectVersion = 46;
	objectVersion = 45;
	objects = {

/* Begin PBXBuildFile section */
		F90509300913A72400327603 /* tclAppInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445508F272B9004A47F5 /* tclAppInit.c */; settings = {COMPILER_FLAGS = "-DTCL_TEST -DTCL_BUILDTIME_LIBRARY=\\\"$(TCL_SRCROOT)/library\\\""; }; };
		F93599B30DF1F75400E04F67 /* tclOO.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B20DF1F75400E04F67 /* tclOO.c */; };
		F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B60DF1F76100E04F67 /* tclOOBasic.c */; };
		F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599B80DF1F76600E04F67 /* tclOOCall.c */; };
		F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */; };
		F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599BD0DF1F77400E04F67 /* tclOOInfo.c */; };
		F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C10DF1F78300E04F67 /* tclOOMethod.c */; };
		F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C30DF1F78800E04F67 /* tclOOStubInit.c */; };
		F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */; };
		F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */ = {isa = PBXBuildFile; fileRef = F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */; };
		F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96437C90EF0D4B2003F468E /* tclZlib.c */; };
		F96437E70EF0D652003F468E /* libz.dylib in Frameworks */ = {isa = PBXBuildFile; fileRef = F96437E60EF0D652003F468E /* libz.dylib */; };
		F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = F966C07408F2820D005CB29B /* CoreFoundation.framework */; };
		F96D456F08F272BB004A47F5 /* regcomp.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED008F272A7004A47F5 /* regcomp.c */; };
		F96D457208F272BB004A47F5 /* regerror.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED308F272A7004A47F5 /* regerror.c */; };
		F96D457508F272BB004A47F5 /* regexec.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED608F272A7004A47F5 /* regexec.c */; };
		F96D457608F272BB004A47F5 /* regfree.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3ED708F272A7004A47F5 /* regfree.c */; };
		F96D457B08F272BB004A47F5 /* tclAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDC08F272A7004A47F5 /* tclAlloc.c */; settings = {COMPILER_FLAGS = "-DUSE_TCLALLOC=0"; }; };
		F96D457C08F272BB004A47F5 /* tclAsync.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3EDD08F272A7004A47F5 /* tclAsync.c */; };
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
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







-
+

+




+



-
+















-
+



+
-
-
+
+
















-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-







		F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */; };
		F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BA08F272B3004A47F5 /* bn_mp_set.c */; };
		F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */; };
		F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C108F272B3004A47F5 /* bn_mp_sub.c */; };
		F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */; };
		F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */; };
		F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */; };
		F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */; };
		F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */; };
		F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */; };
		F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D008F272B3004A47F5 /* bn_reverse.c */; };
		F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */; };
		F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */; };
		F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */; };
		F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */; };
		F96D495508F272C3004A47F5 /* bncore.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42D708F272B3004A47F5 /* bncore.c */; };
		F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433908F272B5004A47F5 /* tclMacOSXBundle.c */; };
		F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433D08F272B5004A47F5 /* tclMacOSXFCmd.c */; };
		F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D433E08F272B5004A47F5 /* tclMacOSXNotify.c */; };
		F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; settings = {COMPILER_FLAGS = "-Wno-deprecated-declarations"; }; };
		F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445B08F272B9004A47F5 /* tclLoadDyld.c */; };
		F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D445F08F272B9004A47F5 /* tclUnixChan.c */; };
		F96D4ACB08F272C9004A47F5 /* tclUnixEvent.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446008F272B9004A47F5 /* tclUnixEvent.c */; };
		F96D4ACC08F272C9004A47F5 /* tclUnixFCmd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446108F272B9004A47F5 /* tclUnixFCmd.c */; };
		F96D4ACD08F272C9004A47F5 /* tclUnixFile.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446208F272B9004A47F5 /* tclUnixFile.c */; };
		F96D4ACE08F272C9004A47F5 /* tclUnixInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446308F272B9004A47F5 /* tclUnixInit.c */; settings = {COMPILER_FLAGS = "-DTCL_LIBRARY=\\\"$(TCL_LIBRARY)\\\" -DTCL_PACKAGE_PATH=\\\"$(TCL_PACKAGE_PATH)\\\""; }; };
		F96D4ACF08F272C9004A47F5 /* tclUnixNotfy.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446408F272B9004A47F5 /* tclUnixNotfy.c */; };
		F96D4AD008F272C9004A47F5 /* tclUnixPipe.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446508F272B9004A47F5 /* tclUnixPipe.c */; };
		F96D4AD208F272CA004A47F5 /* tclUnixSock.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446708F272B9004A47F5 /* tclUnixSock.c */; };
		F96D4AD308F272CA004A47F5 /* tclUnixTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446808F272B9004A47F5 /* tclUnixTest.c */; };
		F96D4AD408F272CA004A47F5 /* tclUnixThrd.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446908F272B9004A47F5 /* tclUnixThrd.c */; };
		F96D4AD608F272CA004A47F5 /* tclUnixTime.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D446B08F272B9004A47F5 /* tclUnixTime.c */; };
		F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */; };
		F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; };
		F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; };
		F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; };
		F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */; };
		F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; };
		F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; };
		F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; };
		F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; };
		F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */; };
		F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */; };
		F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */; };
		F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */; };
		F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */; };
		F9F4415E0C8BAE6F00BCCD67 /* tclDTrace.d in Sources */ = {isa = PBXBuildFile; fileRef = F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */; };
		F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */ = {isa = PBXBuildFile; fileRef = F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */; };
/* End PBXBuildFile section */

/* Begin PBXContainerItemProxy section */
		F97258D20A868C6F00096C78 /* PBXContainerItemProxy */ = {
			isa = PBXContainerItemProxy;
			containerPortal = 08FB7793FE84155DC02AAC07 /* Project object */;
			proxyType = 1;
			remoteGlobalIDString = 8DD76FA90486AB0100D96B5E;
			remoteInfo = tcltest;
		};
/* End PBXContainerItemProxy section */

/* Begin PBXFileReference section */
		8DD76FB20486AB0100D96B5E /* tcltest */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tcltest; sourceTree = BUILT_PRODUCTS_DIR; };
		F915432A0EF201CF0032D1E8 /* zlib.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = zlib.test; sourceTree = "<group>"; };
		F915432D0EF201EE0032D1E8 /* zlib.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = zlib.n; sourceTree = "<group>"; };
		F9183E640EFC80CD0030B814 /* throw.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = throw.n; sourceTree = "<group>"; };
		F9183E650EFC80D70030B814 /* try.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = try.n; sourceTree = "<group>"; };
		F9183E6A0EFC81560030B814 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F9183E8F0EFC817B0030B814 /* tdbc */ = {isa = PBXFileReference; lastKnownFileType = folder; path = tdbc; sourceTree = "<group>"; };
		F91DC23C0E44C51B002CB8D1 /* nre.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = nre.test; sourceTree = "<group>"; };
		F91E62260C1AE686006C9D96 /* Tclsh-Info.plist.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xml; path = "Tclsh-Info.plist.in"; sourceTree = "<group>"; };
		F92D7F100DE777240033A13A /* tsdPerf.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tsdPerf.tcl; sourceTree = "<group>"; };
		F93599B20DF1F75400E04F67 /* tclOO.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOO.c; sourceTree = "<group>"; };
		F93599B40DF1F75900E04F67 /* tclOO.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclOO.decls; sourceTree = "<group>"; };
		F93599B50DF1F75D00E04F67 /* tclOO.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOO.h; sourceTree = "<group>"; };
		F93599B60DF1F76100E04F67 /* tclOOBasic.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOBasic.c; sourceTree = "<group>"; };
		F93599B80DF1F76600E04F67 /* tclOOCall.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOCall.c; sourceTree = "<group>"; };
		F93599BA0DF1F76A00E04F67 /* tclOODecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOODecls.h; sourceTree = "<group>"; };
		F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOODefineCmds.c; sourceTree = "<group>"; };
		F93599BD0DF1F77400E04F67 /* tclOOInfo.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOInfo.c; sourceTree = "<group>"; };
		F93599BF0DF1F77900E04F67 /* tclOOInt.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOInt.h; sourceTree = "<group>"; };
		F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclOOIntDecls.h; sourceTree = "<group>"; };
		F93599C10DF1F78300E04F67 /* tclOOMethod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOMethod.c; sourceTree = "<group>"; };
		F93599C30DF1F78800E04F67 /* tclOOStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubInit.c; sourceTree = "<group>"; };
		F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclOOStubLib.c; sourceTree = "<group>"; };
		F93599C80DF1F81900E04F67 /* oo.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = oo.test; sourceTree = "<group>"; };
		F93599CF0DF1F87F00E04F67 /* Class.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Class.3; sourceTree = "<group>"; };
		F93599D00DF1F89E00E04F67 /* class.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = class.n; sourceTree = "<group>"; };
		F93599D20DF1F8DF00E04F67 /* copy.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = copy.n; sourceTree = "<group>"; };
		F93599D30DF1F8F500E04F67 /* define.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = define.n; sourceTree = "<group>"; };
		F93599D40DF1F91900E04F67 /* Method.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Method.3; sourceTree = "<group>"; };
		F93599D50DF1F93700E04F67 /* my.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = my.n; sourceTree = "<group>"; };
		F93599D60DF1F95000E04F67 /* next.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = next.n; sourceTree = "<group>"; };
		F93599D70DF1F96800E04F67 /* object.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = object.n; sourceTree = "<group>"; };
		F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; };
		F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; };
		F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; };
		F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; };
		F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; };
		F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; };
		F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; };
		F96D3DFA08F272A4004A47F5 /* ChangeLog */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = ChangeLog; sourceTree = "<group>"; };
		F96D3DFB08F272A4004A47F5 /* changes */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes; sourceTree = "<group>"; };
		F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = "<group>"; };
		F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = "<group>"; };
		F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = "<group>"; };
		F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = "<group>"; };
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272
215
216
217
218
219
220
221

222
223
224
225
226
227
228
229







-
+







		F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtChnlHdlr.3; sourceTree = "<group>"; };
		F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCloseHdlr.3; sourceTree = "<group>"; };
		F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtCommand.3; sourceTree = "<group>"; };
		F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtFileHdlr.3; sourceTree = "<group>"; };
		F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtInterp.3; sourceTree = "<group>"; };
		F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtMathFnc.3; sourceTree = "<group>"; };
		F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtObjCmd.3; sourceTree = "<group>"; };
		F96D3E2208F272A5004A47F5 /* CrtAlias.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtAlias.3; sourceTree = "<group>"; };
		F96D3E2208F272A5004A47F5 /* CrtSlave.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtSlave.3; sourceTree = "<group>"; };
		F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTimerHdlr.3; sourceTree = "<group>"; };
		F96D3E2408F272A5004A47F5 /* CrtTrace.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = CrtTrace.3; sourceTree = "<group>"; };
		F96D3E2508F272A5004A47F5 /* dde.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dde.n; sourceTree = "<group>"; };
		F96D3E2608F272A5004A47F5 /* DetachPids.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DetachPids.3; sourceTree = "<group>"; };
		F96D3E2708F272A5004A47F5 /* dict.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = dict.n; sourceTree = "<group>"; };
		F96D3E2808F272A5004A47F5 /* DictObj.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DictObj.3; sourceTree = "<group>"; };
		F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = DoOneEvent.3; sourceTree = "<group>"; };
529
530
531
532
533
534
535

536
537
538
539
540
541
542
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500







+







		F96D3F3008F272A7004A47F5 /* tclTomMath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMath.h; sourceTree = "<group>"; };
		F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTomMathInterface.c; sourceTree = "<group>"; };
		F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = "<group>"; };
		F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = "<group>"; };
		F96D3F3408F272A7004A47F5 /* tclUtf.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtf.c; sourceTree = "<group>"; };
		F96D3F3508F272A7004A47F5 /* tclUtil.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUtil.c; sourceTree = "<group>"; };
		F96D3F3608F272A7004A47F5 /* tclVar.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclVar.c; sourceTree = "<group>"; };
		F96D3F3708F272A7004A47F5 /* tommath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath.h; sourceTree = "<group>"; };
		F96D3F3908F272A8004A47F5 /* auto.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = auto.tcl; sourceTree = "<group>"; };
		F96D3F3A08F272A8004A47F5 /* clock.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = clock.tcl; sourceTree = "<group>"; };
		F96D3F3C08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D3F8C08F272A8004A47F5 /* history.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.tcl; sourceTree = "<group>"; };
		F96D3F8E08F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
		F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D3F9108F272A8004A47F5 /* http.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.tcl; sourceTree = "<group>"; };
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
618
619
620
621
622
623
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614

615
616
617
618
619
620
621


622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647







+
+
+
+

+

+
+


+







+







+
+
+

-
-
+
+
+
+
+
+
+
+





+

+
+
+
+


+



+
+
+
+




+
+


+
+
+
+
+
+
+


+

+
+
+
+
+
+
+
+
+
+


+

+

+



-
+
+
+
+
+


-
-
+
+
+


+
+

+

+


+
+
+
+
+
+







		F96D401D08F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D401E08F272AA004A47F5 /* safe.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = safe.tcl; sourceTree = "<group>"; };
		F96D401F08F272AA004A47F5 /* tclIndex */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclIndex; sourceTree = "<group>"; };
		F96D402108F272AA004A47F5 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F96D402208F272AA004A47F5 /* tcltest.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tcltest.tcl; sourceTree = "<group>"; };
		F96D402308F272AA004A47F5 /* tm.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tm.tcl; sourceTree = "<group>"; };
		F96D425B08F272B2004A47F5 /* word.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = word.tcl; sourceTree = "<group>"; };
		F96D425F08F272B3004A47F5 /* bn.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = bn.pdf; sourceTree = "<group>"; };
		F96D426108F272B3004A47F5 /* bn_error.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_error.c; sourceTree = "<group>"; };
		F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_invmod.c; sourceTree = "<group>"; };
		F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_mp_montgomery_reduce.c; sourceTree = "<group>"; };
		F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_digs.c; sourceTree = "<group>"; };
		F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_mul_high_digs.c; sourceTree = "<group>"; };
		F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_fast_s_mp_sqr.c; sourceTree = "<group>"; };
		F96D426708F272B3004A47F5 /* bn_mp_2expt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_2expt.c; sourceTree = "<group>"; };
		F96D426808F272B3004A47F5 /* bn_mp_abs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_abs.c; sourceTree = "<group>"; };
		F96D426908F272B3004A47F5 /* bn_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add.c; sourceTree = "<group>"; };
		F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_add_d.c; sourceTree = "<group>"; };
		F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_addmod.c; sourceTree = "<group>"; };
		F96D426C08F272B3004A47F5 /* bn_mp_and.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_and.c; sourceTree = "<group>"; };
		F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clamp.c; sourceTree = "<group>"; };
		F96D426E08F272B3004A47F5 /* bn_mp_clear.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear.c; sourceTree = "<group>"; };
		F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_clear_multi.c; sourceTree = "<group>"; };
		F96D427008F272B3004A47F5 /* bn_mp_cmp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp.c; sourceTree = "<group>"; };
		F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_d.c; sourceTree = "<group>"; };
		F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cmp_mag.c; sourceTree = "<group>"; };
		F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_cnt_lsb.c; sourceTree = "<group>"; };
		F96D427408F272B3004A47F5 /* bn_mp_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_copy.c; sourceTree = "<group>"; };
		F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_count_bits.c; sourceTree = "<group>"; };
		F96D427608F272B3004A47F5 /* bn_mp_div.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div.c; sourceTree = "<group>"; };
		F96D427708F272B3004A47F5 /* bn_mp_div_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2.c; sourceTree = "<group>"; };
		F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_2d.c; sourceTree = "<group>"; };
		F96D427908F272B3004A47F5 /* bn_mp_div_3.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_3.c; sourceTree = "<group>"; };
		F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = "<group>"; };
		F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_is_modulus.c; sourceTree = "<group>"; };
		F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_reduce.c; sourceTree = "<group>"; };
		F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_dr_setup.c; sourceTree = "<group>"; };
		F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = "<group>"; };
		F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_u32.c; sourceTree = "<group>"; };
		F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d_ex.c; sourceTree = "<group>"; };
		F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = "<group>"; };
		F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod.c; sourceTree = "<group>"; };
		F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exptmod_fast.c; sourceTree = "<group>"; };
		F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exteuclid.c; sourceTree = "<group>"; };
		F96D428308F272B3004A47F5 /* bn_mp_fread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fread.c; sourceTree = "<group>"; };
		F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_fwrite.c; sourceTree = "<group>"; };
		F96D428508F272B3004A47F5 /* bn_mp_gcd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_gcd.c; sourceTree = "<group>"; };
		F96D428608F272B3004A47F5 /* bn_mp_get_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_get_int.c; sourceTree = "<group>"; };
		F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = "<group>"; };
		F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = "<group>"; };
		F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = "<group>"; };
		F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_multi.c; sourceTree = "<group>"; };
		F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set.c; sourceTree = "<group>"; };
		F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_set_int.c; sourceTree = "<group>"; };
		F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_size.c; sourceTree = "<group>"; };
		F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod.c; sourceTree = "<group>"; };
		F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_invmod_slow.c; sourceTree = "<group>"; };
		F96D429008F272B3004A47F5 /* bn_mp_is_square.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_is_square.c; sourceTree = "<group>"; };
		F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_jacobi.c; sourceTree = "<group>"; };
		F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_mul.c; sourceTree = "<group>"; };
		F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_karatsuba_sqr.c; sourceTree = "<group>"; };
		F96D429408F272B3004A47F5 /* bn_mp_lcm.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lcm.c; sourceTree = "<group>"; };
		F96D429508F272B3004A47F5 /* bn_mp_lshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_lshd.c; sourceTree = "<group>"; };
		F96D429608F272B3004A47F5 /* bn_mp_mod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod.c; sourceTree = "<group>"; };
		F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_2d.c; sourceTree = "<group>"; };
		F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mod_d.c; sourceTree = "<group>"; };
		F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_calc_normalization.c; sourceTree = "<group>"; };
		F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_reduce.c; sourceTree = "<group>"; };
		F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_montgomery_setup.c; sourceTree = "<group>"; };
		F96D429C08F272B3004A47F5 /* bn_mp_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul.c; sourceTree = "<group>"; };
		F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2.c; sourceTree = "<group>"; };
		F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_2d.c; sourceTree = "<group>"; };
		F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mul_d.c; sourceTree = "<group>"; };
		F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_mulmod.c; sourceTree = "<group>"; };
		F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_n_root.c; sourceTree = "<group>"; };
		F96D42A208F272B3004A47F5 /* bn_mp_neg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_neg.c; sourceTree = "<group>"; };
		F96D42A308F272B3004A47F5 /* bn_mp_or.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_or.c; sourceTree = "<group>"; };
		F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_fermat.c; sourceTree = "<group>"; };
		F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_divisible.c; sourceTree = "<group>"; };
		F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_is_prime.c; sourceTree = "<group>"; };
		F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_miller_rabin.c; sourceTree = "<group>"; };
		F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_next_prime.c; sourceTree = "<group>"; };
		F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_rabin_miller_trials.c; sourceTree = "<group>"; };
		F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_prime_random_ex.c; sourceTree = "<group>"; };
		F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_size.c; sourceTree = "<group>"; };
		F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_radix_smap.c; sourceTree = "<group>"; };
		F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rand.c; sourceTree = "<group>"; };
		F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_radix.c; sourceTree = "<group>"; };
		F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_signed_bin.c; sourceTree = "<group>"; };
		F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_read_unsigned_bin.c; sourceTree = "<group>"; };
		F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce.c; sourceTree = "<group>"; };
		F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k.c; sourceTree = "<group>"; };
		F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_l.c; sourceTree = "<group>"; };
		F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup.c; sourceTree = "<group>"; };
		F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_2k_setup_l.c; sourceTree = "<group>"; };
		F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k.c; sourceTree = "<group>"; };
		F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_is_2k_l.c; sourceTree = "<group>"; };
		F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_reduce_setup.c; sourceTree = "<group>"; };
		F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_rshd.c; sourceTree = "<group>"; };
		F96D42BA08F272B3004A47F5 /* bn_mp_set.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set.c; sourceTree = "<group>"; };
		F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_set_int.c; sourceTree = "<group>"; };
		F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_shrink.c; sourceTree = "<group>"; };
		F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_signed_bin_size.c; sourceTree = "<group>"; };
		F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqr.c; sourceTree = "<group>"; };
		F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrmod.c; sourceTree = "<group>"; };
		F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sqrt.c; sourceTree = "<group>"; };
		F96D42C108F272B3004A47F5 /* bn_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub.c; sourceTree = "<group>"; };
		F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_sub_d.c; sourceTree = "<group>"; };
		F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_ubin.c; sourceTree = "<group>"; };
		F96D42C308F272B3004A47F5 /* bn_mp_submod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_submod.c; sourceTree = "<group>"; };
		F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin.c; sourceTree = "<group>"; };
		F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_signed_bin_n.c; sourceTree = "<group>"; };
		F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin.c; sourceTree = "<group>"; };
		F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_unsigned_bin_n.c; sourceTree = "<group>"; };
		F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_mul.c; sourceTree = "<group>"; };
		F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toom_sqr.c; sourceTree = "<group>"; };
		F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_to_radix.c; sourceTree = "<group>"; };
		F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_ubin_size.c; sourceTree = "<group>"; };
		F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix.c; sourceTree = "<group>"; };
		F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_toradix_n.c; sourceTree = "<group>"; };
		F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_unsigned_bin_size.c; sourceTree = "<group>"; };
		F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_xor.c; sourceTree = "<group>"; };
		F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_zero.c; sourceTree = "<group>"; };
		F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_prime_tab.c; sourceTree = "<group>"; };
		F96D42D008F272B3004A47F5 /* bn_reverse.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_reverse.c; sourceTree = "<group>"; };
		F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_add.c; sourceTree = "<group>"; };
		F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_exptmod.c; sourceTree = "<group>"; };
		F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_digs.c; sourceTree = "<group>"; };
		F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_mul_high_digs.c; sourceTree = "<group>"; };
		F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sqr.c; sourceTree = "<group>"; };
		F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_s_mp_sub.c; sourceTree = "<group>"; };
		F96D42D708F272B3004A47F5 /* bncore.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bncore.c; sourceTree = "<group>"; };
		F96D42D908F272B3004A47F5 /* callgraph.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = callgraph.txt; sourceTree = "<group>"; };
		F96D42DA08F272B3004A47F5 /* changes.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = changes.txt; sourceTree = "<group>"; };
		F96D42F008F272B3004A47F5 /* LICENSE */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = LICENSE; sourceTree = "<group>"; };
		F96D431D08F272B4004A47F5 /* poster.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = poster.pdf; sourceTree = "<group>"; };
		F96D432608F272B4004A47F5 /* tommath.pdf */ = {isa = PBXFileReference; lastKnownFileType = image.pdf; path = tommath.pdf; sourceTree = "<group>"; };
		F96D432908F272B4004A47F5 /* tommath_class.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_class.h; sourceTree = "<group>"; };
		F96D432A08F272B4004A47F5 /* tommath_superclass.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tommath_superclass.h; sourceTree = "<group>"; };
		F96D432B08F272B4004A47F5 /* license.terms */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = license.terms; sourceTree = "<group>"; };
		F96D432E08F272B5004A47F5 /* configure.ac */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure.ac; sourceTree = "<group>"; };
		F96D432F08F272B5004A47F5 /* GNUmakefile */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = GNUmakefile; sourceTree = "<group>"; };
		F96D433108F272B5004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D433208F272B5004A47F5 /* Tcl-Info.plist.in */ = {isa = PBXFileReference; explicitFileType = text.plist; fileEncoding = 4; path = "Tcl-Info.plist.in"; sourceTree = "<group>"; };
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
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







-
+












+







		F96D436A08F272B6004A47F5 /* for-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "for-old.test"; sourceTree = "<group>"; };
		F96D436B08F272B6004A47F5 /* for.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = for.test; sourceTree = "<group>"; };
		F96D436C08F272B6004A47F5 /* foreach.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = foreach.test; sourceTree = "<group>"; };
		F96D436D08F272B6004A47F5 /* format.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = format.test; sourceTree = "<group>"; };
		F96D436E08F272B6004A47F5 /* get.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = get.test; sourceTree = "<group>"; };
		F96D436F08F272B6004A47F5 /* history.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = history.test; sourceTree = "<group>"; };
		F96D437008F272B6004A47F5 /* http.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http.test; sourceTree = "<group>"; };
		F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd; sourceTree = "<group>"; };
		F96D437108F272B6004A47F5 /* httpd */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = httpd; sourceTree = "<group>"; };
		F96D437208F272B6004A47F5 /* httpold.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpold.test; sourceTree = "<group>"; };
		F96D437308F272B6004A47F5 /* if-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "if-old.test"; sourceTree = "<group>"; };
		F96D437408F272B6004A47F5 /* if.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = if.test; sourceTree = "<group>"; };
		F96D437508F272B6004A47F5 /* incr-old.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "incr-old.test"; sourceTree = "<group>"; };
		F96D437608F272B6004A47F5 /* incr.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = incr.test; sourceTree = "<group>"; };
		F96D437708F272B6004A47F5 /* indexObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = indexObj.test; sourceTree = "<group>"; };
		F96D437808F272B6004A47F5 /* info.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = info.test; sourceTree = "<group>"; };
		F96D437908F272B6004A47F5 /* init.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = init.test; sourceTree = "<group>"; };
		F96D437A08F272B6004A47F5 /* interp.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = interp.test; sourceTree = "<group>"; };
		F96D437B08F272B6004A47F5 /* io.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = io.test; sourceTree = "<group>"; };
		F96D437C08F272B6004A47F5 /* ioCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioCmd.test; sourceTree = "<group>"; };
		F96D437D08F272B6004A47F5 /* iogt.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = iogt.test; sourceTree = "<group>"; };
		F96D437E08F272B6004A47F5 /* ioUtil.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = ioUtil.test; sourceTree = "<group>"; };
		F96D437F08F272B6004A47F5 /* join.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = join.test; sourceTree = "<group>"; };
		F96D438008F272B6004A47F5 /* lindex.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = lindex.test; sourceTree = "<group>"; };
		F96D438108F272B6004A47F5 /* link.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = link.test; sourceTree = "<group>"; };
		F96D438208F272B6004A47F5 /* linsert.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = linsert.test; sourceTree = "<group>"; };
		F96D438308F272B6004A47F5 /* list.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = list.test; sourceTree = "<group>"; };
		F96D438408F272B6004A47F5 /* listObj.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = listObj.test; sourceTree = "<group>"; };
		F96D438508F272B6004A47F5 /* llength.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = llength.test; sourceTree = "<group>"; };
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
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







-
+
+














+

+
+






-
+







		F96D43CB08F272B7004A47F5 /* winFCmd.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFCmd.test; sourceTree = "<group>"; };
		F96D43CC08F272B7004A47F5 /* winFile.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winFile.test; sourceTree = "<group>"; };
		F96D43CD08F272B7004A47F5 /* winNotify.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winNotify.test; sourceTree = "<group>"; };
		F96D43CE08F272B7004A47F5 /* winPipe.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winPipe.test; sourceTree = "<group>"; };
		F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = "<group>"; };
		F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; };
		F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
		F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; };
		F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
		F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
		F96D442808F272B8004A47F5 /* installData.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = installData.tcl; sourceTree = "<group>"; };
		F96D442908F272B8004A47F5 /* loadICU.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = loadICU.tcl; sourceTree = "<group>"; };
		F96D442A08F272B8004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D442B08F272B8004A47F5 /* makeTestCases.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = makeTestCases.tcl; sourceTree = "<group>"; };
		F96D442C08F272B8004A47F5 /* man2help.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help.tcl; sourceTree = "<group>"; };
		F96D442D08F272B8004A47F5 /* man2help2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2help2.tcl; sourceTree = "<group>"; };
		F96D442E08F272B8004A47F5 /* man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html.tcl; sourceTree = "<group>"; };
		F96D442F08F272B8004A47F5 /* man2html1.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html1.tcl; sourceTree = "<group>"; };
		F96D443008F272B8004A47F5 /* man2html2.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = man2html2.tcl; sourceTree = "<group>"; };
		F96D443108F272B8004A47F5 /* man2tcl.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = man2tcl.c; sourceTree = "<group>"; };
		F96D443208F272B8004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D443308F272B8004A47F5 /* regexpTestLib.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = regexpTestLib.tcl; sourceTree = "<group>"; };
		F96D443408F272B8004A47F5 /* str2c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = str2c; sourceTree = "<group>"; };
		F96D443508F272B8004A47F5 /* tcl.hpj.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.hpj.in; sourceTree = "<group>"; };
		F96D443608F272B8004A47F5 /* tcl.wse.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.wse.in; sourceTree = "<group>"; };
		F96D443708F272B9004A47F5 /* tclmin.wse */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tclmin.wse; sourceTree = "<group>"; };
		F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = "tcltk-man2html.tcl"; sourceTree = "<group>"; };
		F96D443A08F272B9004A47F5 /* tclZIC.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclZIC.tcl; sourceTree = "<group>"; };
		F96D443B08F272B9004A47F5 /* uniClass.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniClass.tcl; sourceTree = "<group>"; };
		F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
		F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
		F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
		F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
		F96D444708F272B9004A47F5 /* pkgc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgc.c; sourceTree = "<group>"; };
		F96D444808F272B9004A47F5 /* pkgd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgd.c; sourceTree = "<group>"; };
		F96D444908F272B9004A47F5 /* pkge.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkge.c; sourceTree = "<group>"; };
		F96D444B08F272B9004A47F5 /* pkgua.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgua.c; sourceTree = "<group>"; };
817
818
819
820
821
822
823

824
825
826
827
828
829
830
831
832


833
834
835
836
837
838
839
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







+








-
+
+







		F96D446308F272B9004A47F5 /* tclUnixInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixInit.c; sourceTree = "<group>"; };
		F96D446408F272B9004A47F5 /* tclUnixNotfy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixNotfy.c; sourceTree = "<group>"; };
		F96D446508F272B9004A47F5 /* tclUnixPipe.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixPipe.c; sourceTree = "<group>"; };
		F96D446608F272B9004A47F5 /* tclUnixPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixPort.h; sourceTree = "<group>"; };
		F96D446708F272B9004A47F5 /* tclUnixSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixSock.c; sourceTree = "<group>"; };
		F96D446808F272B9004A47F5 /* tclUnixTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTest.c; sourceTree = "<group>"; };
		F96D446908F272B9004A47F5 /* tclUnixThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixThrd.c; sourceTree = "<group>"; };
		F96D446A08F272B9004A47F5 /* tclUnixThrd.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclUnixThrd.h; sourceTree = "<group>"; };
		F96D446B08F272B9004A47F5 /* tclUnixTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixTime.c; sourceTree = "<group>"; };
		F96D446C08F272B9004A47F5 /* tclXtNotify.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtNotify.c; sourceTree = "<group>"; };
		F96D446D08F272B9004A47F5 /* tclXtTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclXtTest.c; sourceTree = "<group>"; };
		F96D447008F272BA004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
		F96D447108F272BA004A47F5 /* buildall.vc.bat */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = buildall.vc.bat; sourceTree = "<group>"; };
		F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
		F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };
		F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
		F96D447508F272BA004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
		F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
		F96D447608F272BA004A47F5 /* makefile.bc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.bc; sourceTree = "<group>"; };
		F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
		F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
		F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
		F96D447A08F272BA004A47F5 /* README */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = README; sourceTree = "<group>"; };
		F96D447C08F272BA004A47F5 /* rules.vc */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = rules.vc; sourceTree = "<group>"; };
		F96D447D08F272BA004A47F5 /* stub16.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = stub16.c; sourceTree = "<group>"; };
		F96D447E08F272BA004A47F5 /* tcl.dsp */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.dsp; sourceTree = "<group>"; };
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
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







-
-
-
-
-
-
-





-




















-













-
+















-
-
-
-
-
-
-
-
-
-




-
















-







		F96D449308F272BA004A47F5 /* tclWinPort.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclWinPort.h; sourceTree = "<group>"; };
		F96D449408F272BA004A47F5 /* tclWinReg.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinReg.c; sourceTree = "<group>"; };
		F96D449508F272BA004A47F5 /* tclWinSerial.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSerial.c; sourceTree = "<group>"; };
		F96D449608F272BA004A47F5 /* tclWinSock.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinSock.c; sourceTree = "<group>"; };
		F96D449708F272BA004A47F5 /* tclWinTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTest.c; sourceTree = "<group>"; };
		F96D449808F272BA004A47F5 /* tclWinThrd.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinThrd.c; sourceTree = "<group>"; };
		F96D449A08F272BA004A47F5 /* tclWinTime.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclWinTime.c; sourceTree = "<group>"; };
		F974D56C0FBE7D6300BF728B /* http11.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = http11.test; sourceTree = "<group>"; };
		F974D56D0FBE7D6300BF728B /* httpd11.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = httpd11.tcl; sourceTree = "<group>"; };
		F974D5720FBE7DC600BF728B /* coroutine.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = coroutine.n; sourceTree = "<group>"; };
		F974D5760FBE7E1900BF728B /* tailcall.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = tailcall.n; sourceTree = "<group>"; };
		F974D5770FBE7E6100BF728B /* coroutine.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = coroutine.test; sourceTree = "<group>"; };
		F974D5780FBE7E6100BF728B /* tailcall.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tailcall.test; sourceTree = "<group>"; };
		F974D5790FBE7E9C00BF728B /* tcl.pc.in */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = tcl.pc.in; sourceTree = "<group>"; };
		F97AE7F10B65C1E900310EA2 /* Tcl-Common.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Common.xcconfig"; sourceTree = "<group>"; };
		F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Release.xcconfig"; sourceTree = "<group>"; };
		F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.xcconfig; path = "Tcl-Debug.xcconfig"; sourceTree = "<group>"; };
		F9903CAF094FAADA004613E9 /* tclTomMath.decls */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = tclTomMath.decls; sourceTree = "<group>"; };
		F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMathDecls.h; sourceTree = "<group>"; };
		F99D61180EF5573A00BBFE01 /* TclZlib.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = TclZlib.3; sourceTree = "<group>"; };
		F9A3084B08F2D4CE00BAE1AB /* tclsh */ = {isa = PBXFileReference; explicitFileType = "compiled.mach-o.executable"; includeInIndex = 0; path = tclsh; sourceTree = BUILT_PRODUCTS_DIR; };
		F9A3084E08F2D4F400BAE1AB /* Tcl.framework */ = {isa = PBXFileReference; includeInIndex = 0; lastKnownFileType = wrapper.framework; path = Tcl.framework; sourceTree = BUILT_PRODUCTS_DIR; };
		F9A493240CEBF38300B78AE2 /* chanio.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = chanio.test; sourceTree = "<group>"; };
		F9ECB1120B26521500A28025 /* pkgIndex.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = pkgIndex.tcl; sourceTree = "<group>"; };
		F9ECB1130B26521500A28025 /* platform.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = platform.tcl; sourceTree = "<group>"; };
		F9ECB1140B26521500A28025 /* shell.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = shell.tcl; sourceTree = "<group>"; };
		F9ECB1CA0B2652D300A28025 /* apply.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = apply.test; sourceTree = "<group>"; };
		F9ECB1CB0B26534C00A28025 /* mathop.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = mathop.test; sourceTree = "<group>"; };
		F9ECB1E10B26543C00A28025 /* platform_shell.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform_shell.n; sourceTree = "<group>"; };
		F9ECB1E20B26543C00A28025 /* platform.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = platform.n; sourceTree = "<group>"; };
		F9F4415D0C8BAE6F00BCCD67 /* tclDTrace.d */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.dtrace; path = tclDTrace.d; sourceTree = "<group>"; };
		F9FC77B70AB29E9100B7077D /* tclUnixCompat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUnixCompat.c; sourceTree = "<group>"; };
/* End PBXFileReference section */

/* Begin PBXFrameworksBuildPhase section */
		8DD76FAD0486AB0100D96B5E /* Frameworks */ = {
			isa = PBXFrameworksBuildPhase;
			buildActionMask = 2147483647;
			files = (
				F966C07508F2820D005CB29B /* CoreFoundation.framework in Frameworks */,
				F96437E70EF0D652003F468E /* libz.dylib in Frameworks */,
			);
			runOnlyForDeploymentPostprocessing = 0;
		};
/* End PBXFrameworksBuildPhase section */

/* Begin PBXGroup section */
		08FB7794FE84155DC02AAC07 /* Tcl */ = {
			isa = PBXGroup;
			children = (
				F96D3DF608F27169004A47F5 /* Tcl Sources */,
				F966C06F08F281DC005CB29B /* Frameworks */,
				1AB674ADFE9D54B511CA2CBB /* Products */,
			);
			comments = "Copyright (c) 2004-2009 Daniel A. Steffen <das@users.sourceforge.net>\nCopyright 2008-2009, Apple Inc.\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\n";
			comments = "Copyright (c) 2004-2008 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n";
			name = Tcl;
			path = .;
			sourceTree = SOURCE_ROOT;
		};
		1AB674ADFE9D54B511CA2CBB /* Products */ = {
			isa = PBXGroup;
			children = (
				F9A3084B08F2D4CE00BAE1AB /* tclsh */,
				8DD76FB20486AB0100D96B5E /* tcltest */,
				F9A3084E08F2D4F400BAE1AB /* Tcl.framework */,
			);
			includeInIndex = 0;
			name = Products;
			sourceTree = "<group>";
		};
		F9183E690EFC81560030B814 /* pkgs */ = {
			isa = PBXGroup;
			children = (
				F9183E6A0EFC81560030B814 /* README */,
				F946FB8B0FBE3AED00CD6495 /* itcl */,
				F9183E8F0EFC817B0030B814 /* tdbc */,
			);
			path = pkgs;
			sourceTree = "<group>";
		};
		F966C06F08F281DC005CB29B /* Frameworks */ = {
			isa = PBXGroup;
			children = (
				F966C07408F2820D005CB29B /* CoreFoundation.framework */,
				F96437E60EF0D652003F468E /* libz.dylib */,
			);
			name = Frameworks;
			sourceTree = "<group>";
		};
		F96D3DF608F27169004A47F5 /* Tcl Sources */ = {
			isa = PBXGroup;
			children = (
				F96D3EC908F272A7004A47F5 /* generic */,
				F96D432C08F272B4004A47F5 /* macosx */,
				F96D443E08F272B9004A47F5 /* unix */,
				F96D425C08F272B2004A47F5 /* libtommath */,
				F96D446E08F272B9004A47F5 /* win */,
				F96D3F3808F272A7004A47F5 /* library */,
				F96D434408F272B5004A47F5 /* tests */,
				F96D3DFC08F272A4004A47F5 /* doc */,
				F96D43D008F272B8004A47F5 /* tools */,
				F9183E690EFC81560030B814 /* pkgs */,
				F96D3DFA08F272A4004A47F5 /* ChangeLog */,
				F96D3DFB08F272A4004A47F5 /* changes */,
				F96D434308F272B5004A47F5 /* README */,
				F96D432B08F272B4004A47F5 /* license.terms */,
			);
			name = "Tcl Sources";
			sourceTree = TCL_SRCROOT;
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
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







-
-






-
-








-
+



-







				F96D3E0D08F272A5004A47F5 /* ByteArrObj.3 */,
				F96D3E0E08F272A5004A47F5 /* CallDel.3 */,
				F96D3E0F08F272A5004A47F5 /* case.n */,
				F96D3E1008F272A5004A47F5 /* catch.n */,
				F96D3E1108F272A5004A47F5 /* cd.n */,
				F96D3E1208F272A5004A47F5 /* chan.n */,
				F96D3E1308F272A5004A47F5 /* ChnlStack.3 */,
				F93599CF0DF1F87F00E04F67 /* Class.3 */,
				F93599D00DF1F89E00E04F67 /* class.n */,
				F96D3E1408F272A5004A47F5 /* clock.n */,
				F96D3E1508F272A5004A47F5 /* close.n */,
				F96D3E1608F272A5004A47F5 /* CmdCmplt.3 */,
				F96D3E1708F272A5004A47F5 /* Concat.3 */,
				F96D3E1808F272A5004A47F5 /* concat.n */,
				F96D3E1908F272A5004A47F5 /* continue.n */,
				F93599D20DF1F8DF00E04F67 /* copy.n */,
				F974D5720FBE7DC600BF728B /* coroutine.n */,
				F96D3E1A08F272A5004A47F5 /* CrtChannel.3 */,
				F96D3E1B08F272A5004A47F5 /* CrtChnlHdlr.3 */,
				F96D3E1C08F272A5004A47F5 /* CrtCloseHdlr.3 */,
				F96D3E1D08F272A5004A47F5 /* CrtCommand.3 */,
				F96D3E1E08F272A5004A47F5 /* CrtFileHdlr.3 */,
				F96D3E1F08F272A5004A47F5 /* CrtInterp.3 */,
				F96D3E2008F272A5004A47F5 /* CrtMathFnc.3 */,
				F96D3E2108F272A5004A47F5 /* CrtObjCmd.3 */,
				F96D3E2208F272A5004A47F5 /* CrtAlias.3 */,
				F96D3E2208F272A5004A47F5 /* CrtSlave.3 */,
				F96D3E2308F272A5004A47F5 /* CrtTimerHdlr.3 */,
				F96D3E2408F272A5004A47F5 /* CrtTrace.3 */,
				F96D3E2508F272A5004A47F5 /* dde.n */,
				F93599D30DF1F8F500E04F67 /* define.n */,
				F96D3E2608F272A5004A47F5 /* DetachPids.3 */,
				F96D3E2708F272A5004A47F5 /* dict.n */,
				F96D3E2808F272A5004A47F5 /* DictObj.3 */,
				F96D3E2908F272A5004A47F5 /* DoOneEvent.3 */,
				F96D3E2A08F272A5004A47F5 /* DoubleObj.3 */,
				F96D3E2B08F272A5004A47F5 /* DoWhenIdle.3 */,
				F96D3E2C08F272A5004A47F5 /* DString.3 */,
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1093
1094
1095
1096
1097
1098
1099

1100

1101
1102

1103
1104

1105
1106
1107
1108
1109
1110
1111







-

-


-


-







				F96D3E6C08F272A6004A47F5 /* lreplace.n */,
				F96D3E6D08F272A6004A47F5 /* lsearch.n */,
				F96D3E6E08F272A6004A47F5 /* lset.n */,
				F96D3E6F08F272A6004A47F5 /* lsort.n */,
				F96D3E7008F272A6004A47F5 /* man.macros */,
				F96D3E7108F272A6004A47F5 /* mathfunc.n */,
				F96D3E7208F272A6004A47F5 /* memory.n */,
				F93599D40DF1F91900E04F67 /* Method.3 */,
				F96D3E7308F272A6004A47F5 /* msgcat.n */,
				F93599D50DF1F93700E04F67 /* my.n */,
				F96D3E7408F272A6004A47F5 /* Namespace.3 */,
				F96D3E7508F272A6004A47F5 /* namespace.n */,
				F93599D60DF1F95000E04F67 /* next.n */,
				F96D3E7608F272A6004A47F5 /* Notifier.3 */,
				F96D3E7708F272A6004A47F5 /* Object.3 */,
				F93599D70DF1F96800E04F67 /* object.n */,
				F96D3E7808F272A6004A47F5 /* ObjectType.3 */,
				F96D3E7908F272A6004A47F5 /* open.n */,
				F96D3E7A08F272A6004A47F5 /* OpenFileChnl.3 */,
				F96D3E7B08F272A6004A47F5 /* OpenTcp.3 */,
				F96D3E7C08F272A6004A47F5 /* package.n */,
				F96D3E7D08F272A6004A47F5 /* packagens.n */,
				F96D3E7E08F272A6004A47F5 /* Panic.3 */,
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1131
1132
1133
1134
1135
1136
1137

1138
1139
1140
1141
1142
1143
1144







-







				F96D3E9008F272A6004A47F5 /* regsub.n */,
				F96D3E9108F272A6004A47F5 /* rename.n */,
				F96D3E9208F272A6004A47F5 /* return.n */,
				F96D3E9308F272A6004A47F5 /* safe.n */,
				F96D3E9408F272A6004A47F5 /* SaveResult.3 */,
				F96D3E9508F272A6004A47F5 /* scan.n */,
				F96D3E9608F272A6004A47F5 /* seek.n */,
				F93599D80DF1F98300E04F67 /* self.n */,
				F96D3E9708F272A6004A47F5 /* set.n */,
				F96D3E9808F272A6004A47F5 /* SetChanErr.3 */,
				F96D3E9908F272A6004A47F5 /* SetErrno.3 */,
				F96D3E9A08F272A6004A47F5 /* SetRecLmt.3 */,
				F96D3E9B08F272A7004A47F5 /* SetResult.3 */,
				F96D3E9C08F272A7004A47F5 /* SetVar.3 */,
				F96D3E9D08F272A7004A47F5 /* Signal.3 */,
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
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







-

-







-







-













-







				F96D3EA608F272A7004A47F5 /* StdChannels.3 */,
				F96D3EA708F272A7004A47F5 /* string.n */,
				F96D3EA808F272A7004A47F5 /* StringObj.3 */,
				F96D3EA908F272A7004A47F5 /* StrMatch.3 */,
				F96D3EAA08F272A7004A47F5 /* subst.n */,
				F96D3EAB08F272A7004A47F5 /* SubstObj.3 */,
				F96D3EAC08F272A7004A47F5 /* switch.n */,
				F974D5760FBE7E1900BF728B /* tailcall.n */,
				F96D3EAD08F272A7004A47F5 /* Tcl.n */,
				F99D61180EF5573A00BBFE01 /* TclZlib.3 */,
				F96D3EAE08F272A7004A47F5 /* Tcl_Main.3 */,
				F96D3EAF08F272A7004A47F5 /* TCL_MEM_DEBUG.3 */,
				F96D3EB008F272A7004A47F5 /* tclsh.1 */,
				F96D3EB108F272A7004A47F5 /* tcltest.n */,
				F96D3EB208F272A7004A47F5 /* tclvars.n */,
				F96D3EB308F272A7004A47F5 /* tell.n */,
				F96D3EB408F272A7004A47F5 /* Thread.3 */,
				F9183E640EFC80CD0030B814 /* throw.n */,
				F96D3EB508F272A7004A47F5 /* time.n */,
				F96D3EB608F272A7004A47F5 /* tm.n */,
				F96D3EB708F272A7004A47F5 /* ToUpper.3 */,
				F96D3EB808F272A7004A47F5 /* trace.n */,
				F96D3EB908F272A7004A47F5 /* TraceCmd.3 */,
				F96D3EBA08F272A7004A47F5 /* TraceVar.3 */,
				F96D3EBB08F272A7004A47F5 /* Translate.3 */,
				F9183E650EFC80D70030B814 /* try.n */,
				F96D3EBC08F272A7004A47F5 /* UniCharIsAlpha.3 */,
				F96D3EBD08F272A7004A47F5 /* unknown.n */,
				F96D3EBE08F272A7004A47F5 /* unload.n */,
				F96D3EBF08F272A7004A47F5 /* unset.n */,
				F96D3EC008F272A7004A47F5 /* update.n */,
				F96D3EC108F272A7004A47F5 /* uplevel.n */,
				F96D3EC208F272A7004A47F5 /* UpVar.3 */,
				F96D3EC308F272A7004A47F5 /* upvar.n */,
				F96D3EC408F272A7004A47F5 /* Utf.3 */,
				F96D3EC508F272A7004A47F5 /* variable.n */,
				F96D3EC608F272A7004A47F5 /* vwait.n */,
				F96D3EC708F272A7004A47F5 /* while.n */,
				F96D3EC808F272A7004A47F5 /* WrongNumArgs.3 */,
				F915432D0EF201EE0032D1E8 /* zlib.n */,
			);
			path = doc;
			sourceTree = "<group>";
		};
		F96D3EC908F272A7004A47F5 /* generic */ = {
			isa = PBXGroup;
			children = (
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
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







-











-
-
-
-
-
-
-
-
-
-
-
-
-







				F96D3EFC08F272A7004A47F5 /* tclInterp.c */,
				F96D3EFD08F272A7004A47F5 /* tclIntPlatDecls.h */,
				F96D3EFE08F272A7004A47F5 /* tclIO.c */,
				F96D3EFF08F272A7004A47F5 /* tclIO.h */,
				F96D3F0008F272A7004A47F5 /* tclIOCmd.c */,
				F96D3F0108F272A7004A47F5 /* tclIOGT.c */,
				F96D3F0208F272A7004A47F5 /* tclIORChan.c */,
				F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */,
				F96D3F0308F272A7004A47F5 /* tclIOSock.c */,
				F96D3F0408F272A7004A47F5 /* tclIOUtil.c */,
				F96D3F0508F272A7004A47F5 /* tclLink.c */,
				F96D3F0608F272A7004A47F5 /* tclListObj.c */,
				F96D3F0708F272A7004A47F5 /* tclLiteral.c */,
				F96D3F0808F272A7004A47F5 /* tclLoad.c */,
				F96D3F0908F272A7004A47F5 /* tclLoadNone.c */,
				F96D3F0A08F272A7004A47F5 /* tclMain.c */,
				F96D3F0B08F272A7004A47F5 /* tclNamesp.c */,
				F96D3F0C08F272A7004A47F5 /* tclNotify.c */,
				F96D3F0D08F272A7004A47F5 /* tclObj.c */,
				F93599B20DF1F75400E04F67 /* tclOO.c */,
				F93599B40DF1F75900E04F67 /* tclOO.decls */,
				F93599B50DF1F75D00E04F67 /* tclOO.h */,
				F93599B60DF1F76100E04F67 /* tclOOBasic.c */,
				F93599B80DF1F76600E04F67 /* tclOOCall.c */,
				F93599BA0DF1F76A00E04F67 /* tclOODecls.h */,
				F93599BB0DF1F77000E04F67 /* tclOODefineCmds.c */,
				F93599BD0DF1F77400E04F67 /* tclOOInfo.c */,
				F93599BF0DF1F77900E04F67 /* tclOOInt.h */,
				F93599C00DF1F77D00E04F67 /* tclOOIntDecls.h */,
				F93599C10DF1F78300E04F67 /* tclOOMethod.c */,
				F93599C30DF1F78800E04F67 /* tclOOStubInit.c */,
				F93599C50DF1F78D00E04F67 /* tclOOStubLib.c */,
				F96D3F0E08F272A7004A47F5 /* tclPanic.c */,
				F96D3F0F08F272A7004A47F5 /* tclParse.c */,
				F96D3F1108F272A7004A47F5 /* tclPathObj.c */,
				F96D3F1208F272A7004A47F5 /* tclPipe.c */,
				F96D3F1308F272A7004A47F5 /* tclPkg.c */,
				F96D3F1408F272A7004A47F5 /* tclPkgConfig.c */,
				F96D3F1508F272A7004A47F5 /* tclPlatDecls.h */,
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
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







-
+












+







				F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */,
				F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */,
				F96D3F3208F272A7004A47F5 /* tclTrace.c */,
				F96D3F3308F272A7004A47F5 /* tclUniData.c */,
				F96D3F3408F272A7004A47F5 /* tclUtf.c */,
				F96D3F3508F272A7004A47F5 /* tclUtil.c */,
				F96D3F3608F272A7004A47F5 /* tclVar.c */,
				F96437C90EF0D4B2003F468E /* tclZlib.c */,
				F96D3F3708F272A7004A47F5 /* tommath.h */,
			);
			path = generic;
			sourceTree = "<group>";
		};
		F96D3F3808F272A7004A47F5 /* library */ = {
			isa = PBXGroup;
			children = (
				F96D3F3908F272A8004A47F5 /* auto.tcl */,
				F96D3F3A08F272A8004A47F5 /* clock.tcl */,
				F96D3F3B08F272A8004A47F5 /* dde */,
				F96D3F8C08F272A8004A47F5 /* history.tcl */,
				F96D3F8D08F272A8004A47F5 /* http */,
				F96D3F9008F272A8004A47F5 /* http1.0 */,
				F96D3F9308F272A8004A47F5 /* init.tcl */,
				F96D3F9408F272A8004A47F5 /* msgcat */,
				F96D401708F272AA004A47F5 /* opt */,
				F96D401A08F272AA004A47F5 /* package.tcl */,
				F96D401B08F272AA004A47F5 /* parray.tcl */,
				F9ECB1110B26521500A28025 /* platform */,
				F96D401C08F272AA004A47F5 /* reg */,
1359
1360
1361
1362
1363
1364
1365









1366
1367
1368
1369
1370
1371
1372
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363







+
+
+
+
+
+
+
+
+







			isa = PBXGroup;
			children = (
				F96D3F8E08F272A8004A47F5 /* http.tcl */,
				F96D3F8F08F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http;
			sourceTree = "<group>";
		};
		F96D3F9008F272A8004A47F5 /* http1.0 */ = {
			isa = PBXGroup;
			children = (
				F96D3F9108F272A8004A47F5 /* http.tcl */,
				F96D3F9208F272A8004A47F5 /* pkgIndex.tcl */,
			);
			path = http1.0;
			sourceTree = "<group>";
		};
		F96D3F9408F272A8004A47F5 /* msgcat */ = {
			isa = PBXGroup;
			children = (
				F96D3F9508F272A8004A47F5 /* msgcat.tcl */,
				F96D3F9608F272A8004A47F5 /* pkgIndex.tcl */,
			);
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
1439
1440


1441
1442







1443
1444

1445










1446
1447

1448

1449

1450
1451
1452



1453


1454
1455

1456
1457


1458
1459


1460

1461

1462
1463






1464
1465
1466
1467
1468
1469
1470
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497

1498
1499
1500
1501
1502


1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527







+
+
+
+

+

+
+


+







+







+
+
+

-
-
+
+
+
+
+
+
+
+





+

+
+
+
+


+



+
+
+
+




+
+


+
+
+
+
+
+
+


+

+
+
+
+
+
+
+
+
+
+


+

+

+



+
+
+
-
+
+


+
-
-
+
+


+
+

+

+


+
+
+
+
+
+







			);
			path = tcltest;
			sourceTree = "<group>";
		};
		F96D425C08F272B2004A47F5 /* libtommath */ = {
			isa = PBXGroup;
			children = (
				F96D425F08F272B3004A47F5 /* bn.pdf */,
				F96D426108F272B3004A47F5 /* bn_error.c */,
				F96D426208F272B3004A47F5 /* bn_fast_mp_invmod.c */,
				F96D426308F272B3004A47F5 /* bn_fast_mp_montgomery_reduce.c */,
				F96D426408F272B3004A47F5 /* bn_fast_s_mp_mul_digs.c */,
				F96D426508F272B3004A47F5 /* bn_fast_s_mp_mul_high_digs.c */,
				F96D426608F272B3004A47F5 /* bn_fast_s_mp_sqr.c */,
				F96D426708F272B3004A47F5 /* bn_mp_2expt.c */,
				F96D426808F272B3004A47F5 /* bn_mp_abs.c */,
				F96D426908F272B3004A47F5 /* bn_mp_add.c */,
				F96D426A08F272B3004A47F5 /* bn_mp_add_d.c */,
				F96D426B08F272B3004A47F5 /* bn_mp_addmod.c */,
				F96D426C08F272B3004A47F5 /* bn_mp_and.c */,
				F96D426D08F272B3004A47F5 /* bn_mp_clamp.c */,
				F96D426E08F272B3004A47F5 /* bn_mp_clear.c */,
				F96D426F08F272B3004A47F5 /* bn_mp_clear_multi.c */,
				F96D427008F272B3004A47F5 /* bn_mp_cmp.c */,
				F96D427108F272B3004A47F5 /* bn_mp_cmp_d.c */,
				F96D427208F272B3004A47F5 /* bn_mp_cmp_mag.c */,
				F96D427308F272B3004A47F5 /* bn_mp_cnt_lsb.c */,
				F96D427408F272B3004A47F5 /* bn_mp_copy.c */,
				F96D427508F272B3004A47F5 /* bn_mp_count_bits.c */,
				F96D427608F272B3004A47F5 /* bn_mp_div.c */,
				F96D427708F272B3004A47F5 /* bn_mp_div_2.c */,
				F96D427808F272B3004A47F5 /* bn_mp_div_2d.c */,
				F96D427908F272B3004A47F5 /* bn_mp_div_3.c */,
				F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */,
				F96D427B08F272B3004A47F5 /* bn_mp_dr_is_modulus.c */,
				F96D427C08F272B3004A47F5 /* bn_mp_dr_reduce.c */,
				F96D427D08F272B3004A47F5 /* bn_mp_dr_setup.c */,
				F96D427E08F272B3004A47F5 /* bn_mp_exch.c */,
				F96D427F08F272B3004A47F5 /* bn_mp_expt_u32.c */,
				F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */,
				F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */,
				F96D428008F272B3004A47F5 /* bn_mp_exptmod.c */,
				F96D428108F272B3004A47F5 /* bn_mp_exptmod_fast.c */,
				F96D428208F272B3004A47F5 /* bn_mp_exteuclid.c */,
				F96D428308F272B3004A47F5 /* bn_mp_fread.c */,
				F96D428408F272B3004A47F5 /* bn_mp_fwrite.c */,
				F96D428508F272B3004A47F5 /* bn_mp_gcd.c */,
				F96D428608F272B3004A47F5 /* bn_mp_get_int.c */,
				F96D428708F272B3004A47F5 /* bn_mp_grow.c */,
				F96D428808F272B3004A47F5 /* bn_mp_init.c */,
				F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */,
				F96D428A08F272B3004A47F5 /* bn_mp_init_multi.c */,
				F96D428B08F272B3004A47F5 /* bn_mp_init_set.c */,
				F96D428C08F272B3004A47F5 /* bn_mp_init_set_int.c */,
				F96D428D08F272B3004A47F5 /* bn_mp_init_size.c */,
				F96D428E08F272B3004A47F5 /* bn_mp_invmod.c */,
				F96D428F08F272B3004A47F5 /* bn_mp_invmod_slow.c */,
				F96D429008F272B3004A47F5 /* bn_mp_is_square.c */,
				F96D429108F272B3004A47F5 /* bn_mp_jacobi.c */,
				F96D429208F272B3004A47F5 /* bn_mp_karatsuba_mul.c */,
				F96D429308F272B3004A47F5 /* bn_mp_karatsuba_sqr.c */,
				F96D429408F272B3004A47F5 /* bn_mp_lcm.c */,
				F96D429508F272B3004A47F5 /* bn_mp_lshd.c */,
				F96D429608F272B3004A47F5 /* bn_mp_mod.c */,
				F96D429708F272B3004A47F5 /* bn_mp_mod_2d.c */,
				F96D429808F272B3004A47F5 /* bn_mp_mod_d.c */,
				F96D429908F272B3004A47F5 /* bn_mp_montgomery_calc_normalization.c */,
				F96D429A08F272B3004A47F5 /* bn_mp_montgomery_reduce.c */,
				F96D429B08F272B3004A47F5 /* bn_mp_montgomery_setup.c */,
				F96D429C08F272B3004A47F5 /* bn_mp_mul.c */,
				F96D429D08F272B3004A47F5 /* bn_mp_mul_2.c */,
				F96D429E08F272B3004A47F5 /* bn_mp_mul_2d.c */,
				F96D429F08F272B3004A47F5 /* bn_mp_mul_d.c */,
				F96D42A008F272B3004A47F5 /* bn_mp_mulmod.c */,
				F96D42A108F272B3004A47F5 /* bn_mp_n_root.c */,
				F96D42A208F272B3004A47F5 /* bn_mp_neg.c */,
				F96D42A308F272B3004A47F5 /* bn_mp_or.c */,
				F96D42A408F272B3004A47F5 /* bn_mp_prime_fermat.c */,
				F96D42A508F272B3004A47F5 /* bn_mp_prime_is_divisible.c */,
				F96D42A608F272B3004A47F5 /* bn_mp_prime_is_prime.c */,
				F96D42A708F272B3004A47F5 /* bn_mp_prime_miller_rabin.c */,
				F96D42A808F272B3004A47F5 /* bn_mp_prime_next_prime.c */,
				F96D42A908F272B3004A47F5 /* bn_mp_prime_rabin_miller_trials.c */,
				F96D42AA08F272B3004A47F5 /* bn_mp_prime_random_ex.c */,
				F96D42AB08F272B3004A47F5 /* bn_mp_radix_size.c */,
				F96D42AC08F272B3004A47F5 /* bn_mp_radix_smap.c */,
				F96D42AD08F272B3004A47F5 /* bn_mp_rand.c */,
				F96D42AE08F272B3004A47F5 /* bn_mp_read_radix.c */,
				F96D42AF08F272B3004A47F5 /* bn_mp_read_signed_bin.c */,
				F96D42B008F272B3004A47F5 /* bn_mp_read_unsigned_bin.c */,
				F96D42B108F272B3004A47F5 /* bn_mp_reduce.c */,
				F96D42B208F272B3004A47F5 /* bn_mp_reduce_2k.c */,
				F96D42B308F272B3004A47F5 /* bn_mp_reduce_2k_l.c */,
				F96D42B408F272B3004A47F5 /* bn_mp_reduce_2k_setup.c */,
				F96D42B508F272B3004A47F5 /* bn_mp_reduce_2k_setup_l.c */,
				F96D42B608F272B3004A47F5 /* bn_mp_reduce_is_2k.c */,
				F96D42B708F272B3004A47F5 /* bn_mp_reduce_is_2k_l.c */,
				F96D42B808F272B3004A47F5 /* bn_mp_reduce_setup.c */,
				F96D42B908F272B3004A47F5 /* bn_mp_rshd.c */,
				F96D42BA08F272B3004A47F5 /* bn_mp_set.c */,
				F96D42BB08F272B3004A47F5 /* bn_mp_set_int.c */,
				F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */,
				F96D42BD08F272B3004A47F5 /* bn_mp_signed_bin_size.c */,
				F96D42BE08F272B3004A47F5 /* bn_mp_sqr.c */,
				F96D42BF08F272B3004A47F5 /* bn_mp_sqrmod.c */,
				F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */,
				F96D42C108F272B3004A47F5 /* bn_mp_sub.c */,
				F96D42C208F272B3004A47F5 /* bn_mp_sub_d.c */,
				F96D42C308F272B3004A47F5 /* bn_mp_submod.c */,
				F96D42C408F272B3004A47F5 /* bn_mp_to_signed_bin.c */,
				F96D42C508F272B3004A47F5 /* bn_mp_to_signed_bin_n.c */,
				F96D42C608F272B3004A47F5 /* bn_mp_to_ubin.c */,
				F96D42C608F272B3004A47F5 /* bn_mp_to_unsigned_bin.c */,
				F96D42C708F272B3004A47F5 /* bn_mp_to_unsigned_bin_n.c */,
				F96D42C808F272B3004A47F5 /* bn_mp_toom_mul.c */,
				F96D42C908F272B3004A47F5 /* bn_mp_toom_sqr.c */,
				F96D42CA08F272B3004A47F5 /* bn_mp_toradix.c */,
				F96D42CB08F272B3004A47F5 /* bn_mp_to_radix.c */,
				F96D42CC08F272B3004A47F5 /* bn_mp_ubin_size.c */,
				F96D42CB08F272B3004A47F5 /* bn_mp_toradix_n.c */,
				F96D42CC08F272B3004A47F5 /* bn_mp_unsigned_bin_size.c */,
				F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */,
				F96D42CE08F272B3004A47F5 /* bn_mp_zero.c */,
				F96D42CF08F272B3004A47F5 /* bn_prime_tab.c */,
				F96D42D008F272B3004A47F5 /* bn_reverse.c */,
				F96D42D108F272B3004A47F5 /* bn_s_mp_add.c */,
				F96D42D208F272B3004A47F5 /* bn_s_mp_exptmod.c */,
				F96D42D308F272B3004A47F5 /* bn_s_mp_mul_digs.c */,
				F96D42D408F272B3004A47F5 /* bn_s_mp_mul_high_digs.c */,
				F96D42D508F272B3004A47F5 /* bn_s_mp_sqr.c */,
				F96D42D608F272B3004A47F5 /* bn_s_mp_sub.c */,
				F96D42D708F272B3004A47F5 /* bncore.c */,
				F96D42D908F272B3004A47F5 /* callgraph.txt */,
				F96D42DA08F272B3004A47F5 /* changes.txt */,
				F96D42F008F272B3004A47F5 /* LICENSE */,
				F96D431D08F272B4004A47F5 /* poster.pdf */,
				F96D432608F272B4004A47F5 /* tommath.pdf */,
				F96D432908F272B4004A47F5 /* tommath_class.h */,
				F96D432A08F272B4004A47F5 /* tommath_superclass.h */,
			);
			path = libtommath;
			sourceTree = "<group>";
		};
		F96D432C08F272B4004A47F5 /* macosx */ = {
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576







-







				F96D435208F272B5004A47F5 /* cmdInfo.test */,
				F96D435308F272B5004A47F5 /* cmdMZ.test */,
				F96D435408F272B5004A47F5 /* compExpr-old.test */,
				F96D435508F272B5004A47F5 /* compExpr.test */,
				F96D435608F272B5004A47F5 /* compile.test */,
				F96D435708F272B5004A47F5 /* concat.test */,
				F96D435808F272B5004A47F5 /* config.test */,
				F974D5770FBE7E6100BF728B /* coroutine.test */,
				F96D435908F272B5004A47F5 /* dcall.test */,
				F96D435A08F272B5004A47F5 /* dict.test */,
				F96D435C08F272B5004A47F5 /* dstring.test */,
				F96D435E08F272B5004A47F5 /* encoding.test */,
				F96D435F08F272B5004A47F5 /* env.test */,
				F96D436008F272B5004A47F5 /* error.test */,
				F96D436108F272B5004A47F5 /* eval.test */,
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550

1551
1552
1553
1554
1555
1556
1557
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







-

-












+







				F96D436A08F272B6004A47F5 /* for-old.test */,
				F96D436B08F272B6004A47F5 /* for.test */,
				F96D436C08F272B6004A47F5 /* foreach.test */,
				F96D436D08F272B6004A47F5 /* format.test */,
				F96D436E08F272B6004A47F5 /* get.test */,
				F96D436F08F272B6004A47F5 /* history.test */,
				F96D437008F272B6004A47F5 /* http.test */,
				F974D56C0FBE7D6300BF728B /* http11.test */,
				F96D437108F272B6004A47F5 /* httpd */,
				F974D56D0FBE7D6300BF728B /* httpd11.tcl */,
				F96D437208F272B6004A47F5 /* httpold.test */,
				F96D437308F272B6004A47F5 /* if-old.test */,
				F96D437408F272B6004A47F5 /* if.test */,
				F96D437508F272B6004A47F5 /* incr-old.test */,
				F96D437608F272B6004A47F5 /* incr.test */,
				F96D437708F272B6004A47F5 /* indexObj.test */,
				F96D437808F272B6004A47F5 /* info.test */,
				F96D437908F272B6004A47F5 /* init.test */,
				F96D437A08F272B6004A47F5 /* interp.test */,
				F96D437B08F272B6004A47F5 /* io.test */,
				F96D437C08F272B6004A47F5 /* ioCmd.test */,
				F96D437D08F272B6004A47F5 /* iogt.test */,
				F96D437E08F272B6004A47F5 /* ioUtil.test */,
				F96D437F08F272B6004A47F5 /* join.test */,
				F96D438008F272B6004A47F5 /* lindex.test */,
				F96D438108F272B6004A47F5 /* link.test */,
				F96D438208F272B6004A47F5 /* linsert.test */,
				F96D438308F272B6004A47F5 /* list.test */,
				F96D438408F272B6004A47F5 /* listObj.test */,
				F96D438508F272B6004A47F5 /* llength.test */,
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1622
1623
1624
1625
1626
1627
1628

1629

1630
1631
1632
1633
1634
1635
1636







-

-







				F96D438E08F272B6004A47F5 /* main.test */,
				F9ECB1CB0B26534C00A28025 /* mathop.test */,
				F96D438F08F272B6004A47F5 /* misc.test */,
				F96D439008F272B6004A47F5 /* msgcat.test */,
				F96D439108F272B6004A47F5 /* namespace-old.test */,
				F96D439208F272B7004A47F5 /* namespace.test */,
				F96D439308F272B7004A47F5 /* notify.test */,
				F91DC23C0E44C51B002CB8D1 /* nre.test */,
				F96D439408F272B7004A47F5 /* obj.test */,
				F93599C80DF1F81900E04F67 /* oo.test */,
				F96D439508F272B7004A47F5 /* opt.test */,
				F96D439608F272B7004A47F5 /* package.test */,
				F96D439708F272B7004A47F5 /* parse.test */,
				F96D439808F272B7004A47F5 /* parseExpr.test */,
				F96D439908F272B7004A47F5 /* parseOld.test */,
				F96D439A08F272B7004A47F5 /* pid.test */,
				F96D439B08F272B7004A47F5 /* pkg.test */,
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1657
1658
1659
1660
1661
1662
1663

1664
1665
1666
1667
1668
1669
1670







-







				F96D43B008F272B7004A47F5 /* split.test */,
				F96D43B108F272B7004A47F5 /* stack.test */,
				F96D43B208F272B7004A47F5 /* string.test */,
				F96D43B308F272B7004A47F5 /* stringComp.test */,
				F96D43B408F272B7004A47F5 /* stringObj.test */,
				F96D43B508F272B7004A47F5 /* subst.test */,
				F96D43B608F272B7004A47F5 /* switch.test */,
				F974D5780FBE7E6100BF728B /* tailcall.test */,
				F96D43B708F272B7004A47F5 /* tcltest.test */,
				F96D43B808F272B7004A47F5 /* thread.test */,
				F96D43B908F272B7004A47F5 /* timer.test */,
				F96D43BA08F272B7004A47F5 /* tm.test */,
				F96D43BB08F272B7004A47F5 /* trace.test */,
				F96D43BC08F272B7004A47F5 /* unixFCmd.test */,
				F96D43BD08F272B7004A47F5 /* unixFile.test */,
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
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
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







-









-
+
+














+

+
+


-











-
+







-







				F96D43C908F272B7004A47F5 /* winConsole.test */,
				F96D43CA08F272B7004A47F5 /* winDde.test */,
				F96D43CB08F272B7004A47F5 /* winFCmd.test */,
				F96D43CC08F272B7004A47F5 /* winFile.test */,
				F96D43CD08F272B7004A47F5 /* winNotify.test */,
				F96D43CE08F272B7004A47F5 /* winPipe.test */,
				F96D43CF08F272B7004A47F5 /* winTime.test */,
				F915432A0EF201CF0032D1E8 /* zlib.test */,
			);
			path = tests;
			sourceTree = "<group>";
		};
		F96D43D008F272B8004A47F5 /* tools */ = {
			isa = PBXGroup;
			children = (
				F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
				F96D43D208F272B8004A47F5 /* configure */,
				F96D43D308F272B8004A47F5 /* configure.ac */,
				F96D43D308F272B8004A47F5 /* configure.in */,
				F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
				F96D442508F272B8004A47F5 /* genStubs.tcl */,
				F96D442708F272B8004A47F5 /* index.tcl */,
				F96D442808F272B8004A47F5 /* installData.tcl */,
				F96D442908F272B8004A47F5 /* loadICU.tcl */,
				F96D442A08F272B8004A47F5 /* Makefile.in */,
				F96D442B08F272B8004A47F5 /* makeTestCases.tcl */,
				F96D442C08F272B8004A47F5 /* man2help.tcl */,
				F96D442D08F272B8004A47F5 /* man2help2.tcl */,
				F96D442E08F272B8004A47F5 /* man2html.tcl */,
				F96D442F08F272B8004A47F5 /* man2html1.tcl */,
				F96D443008F272B8004A47F5 /* man2html2.tcl */,
				F96D443108F272B8004A47F5 /* man2tcl.c */,
				F96D443208F272B8004A47F5 /* README */,
				F96D443308F272B8004A47F5 /* regexpTestLib.tcl */,
				F96D443408F272B8004A47F5 /* str2c */,
				F96D443508F272B8004A47F5 /* tcl.hpj.in */,
				F96D443608F272B8004A47F5 /* tcl.wse.in */,
				F96D443708F272B9004A47F5 /* tclmin.wse */,
				F96D443908F272B9004A47F5 /* tcltk-man2html.tcl */,
				F96D443A08F272B9004A47F5 /* tclZIC.tcl */,
				F92D7F100DE777240033A13A /* tsdPerf.tcl */,
				F96D443B08F272B9004A47F5 /* uniClass.tcl */,
				F96D443C08F272B9004A47F5 /* uniParse.tcl */,
			);
			path = tools;
			sourceTree = "<group>";
		};
		F96D443E08F272B9004A47F5 /* unix */ = {
			isa = PBXGroup;
			children = (
				F96D444008F272B9004A47F5 /* aclocal.m4 */,
				F96D444108F272B9004A47F5 /* configure */,
				F96D444208F272B9004A47F5 /* configure.ac */,
				F96D444208F272B9004A47F5 /* configure.in */,
				F96D444308F272B9004A47F5 /* dltest */,
				F96D444D08F272B9004A47F5 /* install-sh */,
				F96D444E08F272B9004A47F5 /* installManPage */,
				F96D444F08F272B9004A47F5 /* ldAix */,
				F96D445008F272B9004A47F5 /* Makefile.in */,
				F96D445208F272B9004A47F5 /* README */,
				F96D445308F272B9004A47F5 /* tcl.m4 */,
				F974D5790FBE7E9C00BF728B /* tcl.pc.in */,
				F96D445408F272B9004A47F5 /* tcl.spec */,
				F96D445508F272B9004A47F5 /* tclAppInit.c */,
				F96D445608F272B9004A47F5 /* tclConfig.h.in */,
				F96D445708F272B9004A47F5 /* tclConfig.sh.in */,
				F96D445808F272B9004A47F5 /* tclLoadAix.c */,
				F96D445908F272B9004A47F5 /* tclLoadDl.c */,
				F96D445B08F272B9004A47F5 /* tclLoadDyld.c */,
1701
1702
1703
1704
1705
1706
1707

1708
1709
1710
1711
1712
1713
1714
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768







+







				F96D446308F272B9004A47F5 /* tclUnixInit.c */,
				F96D446408F272B9004A47F5 /* tclUnixNotfy.c */,
				F96D446508F272B9004A47F5 /* tclUnixPipe.c */,
				F96D446608F272B9004A47F5 /* tclUnixPort.h */,
				F96D446708F272B9004A47F5 /* tclUnixSock.c */,
				F96D446808F272B9004A47F5 /* tclUnixTest.c */,
				F96D446908F272B9004A47F5 /* tclUnixThrd.c */,
				F96D446A08F272B9004A47F5 /* tclUnixThrd.h */,
				F96D446B08F272B9004A47F5 /* tclUnixTime.c */,
				F96D446C08F272B9004A47F5 /* tclXtNotify.c */,
				F96D446D08F272B9004A47F5 /* tclXtTest.c */,
			);
			path = unix;
			sourceTree = "<group>";
		};
1731
1732
1733
1734
1735
1736
1737
1738


1739
1740
1741
1742
1743
1744
1745
1785
1786
1787
1788
1789
1790
1791

1792
1793
1794
1795
1796
1797
1798
1799
1800







-
+
+







			isa = PBXGroup;
			children = (
				F96D447008F272BA004A47F5 /* aclocal.m4 */,
				F96D447108F272BA004A47F5 /* buildall.vc.bat */,
				F96D447208F272BA004A47F5 /* cat.c */,
				F96D447308F272BA004A47F5 /* coffbase.txt */,
				F96D447408F272BA004A47F5 /* configure */,
				F96D447508F272BA004A47F5 /* configure.ac */,
				F96D447508F272BA004A47F5 /* configure.in */,
				F96D447608F272BA004A47F5 /* makefile.bc */,
				F96D447708F272BA004A47F5 /* Makefile.in */,
				F96D447808F272BA004A47F5 /* makefile.vc */,
				F96D447908F272BA004A47F5 /* nmakehlp.c */,
				F96D447A08F272BA004A47F5 /* README */,
				F96D447C08F272BA004A47F5 /* rules.vc */,
				F96D447D08F272BA004A47F5 /* stub16.c */,
				F96D447E08F272BA004A47F5 /* tcl.dsp */,
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
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
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
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







-
+


-
+















-
+














-
+



















-
+













-
+














-








-
+






-




-
+


-
+







-





-
+


-
+






-
+






-





-
+







/* End PBXGroup section */

/* Begin PBXNativeTarget section */
		8DD76FA90486AB0100D96B5E /* tcltest */ = {
			isa = PBXNativeTarget;
			buildConfigurationList = F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */;
			buildPhases = (
				F9A5C5F508F651A2008AE941 /* Configure Tcl */,
				F9A5C5F508F651A2008AE941 /* ShellScript */,
				8DD76FAB0486AB0100D96B5E /* Sources */,
				8DD76FAD0486AB0100D96B5E /* Frameworks */,
				F95FA74C0B32CE190072E431 /* Build dltest */,
				F95FA74C0B32CE190072E431 /* ShellScript */,
			);
			buildRules = (
			);
			dependencies = (
			);
			name = tcltest;
			productInstallPath = "$(BINDIR)";
			productName = tcltest;
			productReference = 8DD76FB20486AB0100D96B5E /* tcltest */;
			productType = "com.apple.product-type.tool";
		};
		F97258A50A86873C00096C78 /* tests */ = {
			isa = PBXNativeTarget;
			buildConfigurationList = F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */;
			buildPhases = (
				F97258A40A86873C00096C78 /* Run Testsuite */,
				F97258A40A86873C00096C78 /* ShellScript */,
			);
			buildRules = (
			);
			dependencies = (
				F97258D30A868C6F00096C78 /* PBXTargetDependency */,
			);
			name = tests;
			productName = tests;
			productType = "com.apple.product-type.bundle";
		};
		F9E61D16090A3E94002B3151 /* Tcl */ = {
			isa = PBXNativeTarget;
			buildConfigurationList = F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */;
			buildPhases = (
				F97AF02F0B665DA900310EA2 /* Build Tcl */,
				F97AF02F0B665DA900310EA2 /* ShellScript */,
			);
			buildRules = (
			);
			dependencies = (
			);
			name = Tcl;
			productName = tclsh;
			productReference = F9A3084B08F2D4CE00BAE1AB /* tclsh */;
			productType = "com.apple.product-type.tool";
		};
/* End PBXNativeTarget section */

/* Begin PBXProject section */
		08FB7793FE84155DC02AAC07 /* Project object */ = {
			isa = PBXProject;
			attributes = {
				BuildIndependentTargetsInParallel = YES;
			};
			buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */;
			compatibilityVersion = "Xcode 3.2";
			compatibilityVersion = "Xcode 3.1";
			hasScannedForEncodings = 1;
			mainGroup = 08FB7794FE84155DC02AAC07 /* Tcl */;
			projectDirPath = "";
			projectRoot = ..;
			targets = (
				F9E61D16090A3E94002B3151 /* Tcl */,
				8DD76FA90486AB0100D96B5E /* tcltest */,
				F97258A50A86873C00096C78 /* tests */,
			);
		};
/* End PBXProject section */

/* Begin PBXShellScriptBuildPhase section */
		F95FA74C0B32CE190072E431 /* Build dltest */ = {
		F95FA74C0B32CE190072E431 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
				"$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
				"$(TCL_SRCROOT)/generic/tclStubLib.c",
				"$(TCL_SRCROOT)/unix/dltest/pkga.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgb.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgc.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgd.c",
				"$(TCL_SRCROOT)/unix/dltest/pkge.c",
				"$(TCL_SRCROOT)/unix/dltest/pkgua.c",
			);
			name = "Build dltest";
			outputPaths = (
				"$(DERIVED_FILE_DIR)/tcl/dltest.marker",
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "## dltest build script phase\n\nrm -f \"${DERIVED_FILE_DIR}/tcl/dltest.marker\"\nmake -C \"${DERIVED_FILE_DIR}/tcl\" dltest.marker\nln -fsh \"${DERIVED_FILE_DIR}/tcl/dltest\" \"${CONFIGURATION_BUILD_DIR}\"\n";
			showEnvVarsInLog = 0;
		};
		F97258A40A86873C00096C78 /* Run Testsuite */ = {
		F97258A40A86873C00096C78 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
			);
			name = "Run Testsuite";
			outputPaths = (
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.5\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
			shellScript = "if [ \"${ACTION:-build}\" == \"build\" ]; then\nif [ -z \"${HOME}\" ]; then export HOME=\"$(echo ~)\"; fi\ncd \"${TARGET_TEMP_DIR}\"; rm -rf \"${DERIVED_FILE_DIR}\"; mkdir -p \"${DERIVED_FILE_DIR}\"\nprintf '%s%s%s%s%s' '\npackage require tcltest 2.2\nnamespace import tcltest::*\nconfigure -testdir [file normalize {' \"${TCL_SRCROOT}\" '/tests}]\nconfigure -tmpdir [file normalize {' \"${DERIVED_FILE_DIR}\" '}]\nconfigure -verbose [concat [configure -verbose] line]\n# following test only fails when testsuite is run from inside Xcode, so skip it\nconfigure -skip [concat [configure -skip] stack-3.1]\nrunAllTests\n' | \"${TEST_RIG}\"; TEST_RIG_RESULT=$?\n[ ${TEST_RIG_RESULT} -ne 0 ] && echo \"tcltest:0: error: tcltest exited abnormally with code ${TEST_RIG_RESULT}.\"\nexit ${TEST_RIG_RESULT}\nfi";
			showEnvVarsInLog = 0;
		};
		F97AF02F0B665DA900310EA2 /* Build Tcl */ = {
		F97AF02F0B665DA900310EA2 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
				"${TARGET_TEMP_DIR}/.none",
			);
			name = "Build Tcl";
			outputPaths = (
				"${TARGET_BUILD_DIR}/${EXECUTABLE_NAME}",
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\nexport CC=$(xcrun -find ${GCC} || echo ${GCC}); export LD=${CC}\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n";
			shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n    mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n";
			showEnvVarsInLog = 0;
		};
		F9A5C5F508F651A2008AE941 /* Configure Tcl */ = {
		F9A5C5F508F651A2008AE941 /* ShellScript */ = {
			isa = PBXShellScriptBuildPhase;
			buildActionMask = 2147483647;
			files = (
			);
			inputPaths = (
				"$(TCL_SRCROOT)/macosx/configure.ac",
				"$(TCL_SRCROOT)/unix/configure.ac",
				"$(TCL_SRCROOT)/unix/configure.in",
				"$(TCL_SRCROOT)/unix/tcl.m4",
				"$(TCL_SRCROOT)/unix/aclocal.m4",
				"$(TCL_SRCROOT)/unix/tclConfig.sh.in",
				"$(TCL_SRCROOT)/unix/Makefile.in",
				"$(TCL_SRCROOT)/unix/dltest/Makefile.in",
			);
			name = "Configure Tcl";
			outputPaths = (
				"$(DERIVED_FILE_DIR)/tcl/tclConfig.sh",
			);
			runOnlyForDeploymentPostprocessing = 0;
			shellPath = /bin/bash;
			shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.ac -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n    echo \"Running autoconf & autoheader in tcl/macosx\"\n    rm -rf autom4te.cache\n    ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n    rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n    echo \"Configuring Tcl\"\n    CC=$(xcrun -find ${GCC} || echo ${GCC})\n    \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n    ./config.status\nfi\n";
			shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n    echo \"Running autoconf & autoheader in tcl/macosx\"\n    rm -rf autom4te.cache\n    ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n    rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n    echo \"Configuring Tcl\"\n    \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared ${CONFIGURE_ARGS}\nelse\n    ./config.status\nfi\n";
			showEnvVarsInLog = 0;
		};
/* End PBXShellScriptBuildPhase section */

/* Begin PBXSourcesBuildPhase section */
		8DD76FAB0486AB0100D96B5E /* Sources */ = {
			isa = PBXSourcesBuildPhase;
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
2025
2026
2027
2028
2029
2030
2031

2032
2033
2034
2035
2036
2037
2038
2039
2040
2041








2042
2043
2044
2045
2046
2047
2048







-










-
-
-
-
-
-
-
-







				F96D459608F272BC004A47F5 /* tclHistory.c in Sources */,
				F96D459708F272BC004A47F5 /* tclIndexObj.c in Sources */,
				F96D459B08F272BC004A47F5 /* tclInterp.c in Sources */,
				F96D459D08F272BC004A47F5 /* tclIO.c in Sources */,
				F96D459F08F272BC004A47F5 /* tclIOCmd.c in Sources */,
				F96D45A008F272BC004A47F5 /* tclIOGT.c in Sources */,
				F96D45A108F272BC004A47F5 /* tclIORChan.c in Sources */,
				F95D77EA0DFD820D00A8BF6F /* tclIORTrans.c in Sources */,
				F96D45A208F272BC004A47F5 /* tclIOSock.c in Sources */,
				F96D45A308F272BC004A47F5 /* tclIOUtil.c in Sources */,
				F96D45A408F272BC004A47F5 /* tclLink.c in Sources */,
				F96D45A508F272BC004A47F5 /* tclListObj.c in Sources */,
				F96D45A608F272BC004A47F5 /* tclLiteral.c in Sources */,
				F96D45A708F272BC004A47F5 /* tclLoad.c in Sources */,
				F96D45A908F272BC004A47F5 /* tclMain.c in Sources */,
				F96D45AA08F272BC004A47F5 /* tclNamesp.c in Sources */,
				F96D45AB08F272BC004A47F5 /* tclNotify.c in Sources */,
				F96D45AC08F272BC004A47F5 /* tclObj.c in Sources */,
				F93599B30DF1F75400E04F67 /* tclOO.c in Sources */,
				F93599B70DF1F76100E04F67 /* tclOOBasic.c in Sources */,
				F93599B90DF1F76600E04F67 /* tclOOCall.c in Sources */,
				F93599BC0DF1F77000E04F67 /* tclOODefineCmds.c in Sources */,
				F93599BE0DF1F77400E04F67 /* tclOOInfo.c in Sources */,
				F93599C20DF1F78300E04F67 /* tclOOMethod.c in Sources */,
				F93599C40DF1F78800E04F67 /* tclOOStubInit.c in Sources */,
				F93599C60DF1F78D00E04F67 /* tclOOStubLib.c in Sources */,
				F96D45AD08F272BC004A47F5 /* tclPanic.c in Sources */,
				F96D45AE08F272BC004A47F5 /* tclParse.c in Sources */,
				F96D45B008F272BC004A47F5 /* tclPathObj.c in Sources */,
				F96D45B108F272BC004A47F5 /* tclPipe.c in Sources */,
				F96D45B208F272BC004A47F5 /* tclPkg.c in Sources */,
				F96D45B308F272BC004A47F5 /* tclPkgConfig.c in Sources */,
				F96D45B608F272BC004A47F5 /* tclPosixStr.c in Sources */,
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
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







-




















-
+
-







				F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */,
				F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */,
				F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */,
				F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */,
				F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */,
				F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */,
				F96D45D508F272BC004A47F5 /* tclVar.c in Sources */,
				F96437CA0EF0D4B2003F468E /* tclZlib.c in Sources */,
				F96D48E208F272C3004A47F5 /* bn_fast_s_mp_mul_digs.c in Sources */,
				F96D48E408F272C3004A47F5 /* bn_fast_s_mp_sqr.c in Sources */,
				F96D48E708F272C3004A47F5 /* bn_mp_add.c in Sources */,
				F96D48E808F272C3004A47F5 /* bn_mp_add_d.c in Sources */,
				F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */,
				F96D48EB08F272C3004A47F5 /* bn_mp_clamp.c in Sources */,
				F96D48EC08F272C3004A47F5 /* bn_mp_clear.c in Sources */,
				F96D48ED08F272C3004A47F5 /* bn_mp_clear_multi.c in Sources */,
				F96D48EE08F272C3004A47F5 /* bn_mp_cmp.c in Sources */,
				F9E61D28090A481F002B3151 /* bn_mp_cmp_d.c in Sources */,
				F96D48F008F272C3004A47F5 /* bn_mp_cmp_mag.c in Sources */,
				F96D48F208F272C3004A47F5 /* bn_mp_cnt_lsb.c in Sources */,
				F96D48F208F272C3004A47F5 /* bn_mp_copy.c in Sources */,
				F96D48F308F272C3004A47F5 /* bn_mp_count_bits.c in Sources */,
				F96D48F408F272C3004A47F5 /* bn_mp_div.c in Sources */,
				F96D48F508F272C3004A47F5 /* bn_mp_div_2.c in Sources */,
				F96D48F608F272C3004A47F5 /* bn_mp_div_2d.c in Sources */,
				F96D48F708F272C3004A47F5 /* bn_mp_div_3.c in Sources */,
				F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */,
				F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */,
				F9E61D2C090A48AC002B3151 /* bn_mp_expt_u32.c in Sources */,
				F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */,
				F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */,
				F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */,
				F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */,
				F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */,
				F96D490808F272C3004A47F5 /* bn_mp_init_multi.c in Sources */,
				F96D490908F272C3004A47F5 /* bn_mp_init_set.c in Sources */,
				F96D490B08F272C3004A47F5 /* bn_mp_init_size.c in Sources */,
				F96D491008F272C3004A47F5 /* bn_mp_karatsuba_mul.c in Sources */,
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
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







+
-
+


-
-
+
+


+




+







				F96D493708F272C3004A47F5 /* bn_mp_rshd.c in Sources */,
				F96D493808F272C3004A47F5 /* bn_mp_set.c in Sources */,
				F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */,
				F96D493C08F272C3004A47F5 /* bn_mp_sqr.c in Sources */,
				F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */,
				F96D493F08F272C3004A47F5 /* bn_mp_sub.c in Sources */,
				F96D494008F272C3004A47F5 /* bn_mp_sub_d.c in Sources */,
				F9E61D30090A48E2002B3151 /* bn_mp_to_unsigned_bin_n.c in Sources */,
				F9E61D31090A48F9002B3151 /* bn_mp_to_ubin.c in Sources */,
				F9E61D31090A48F9002B3151 /* bn_mp_to_unsigned_bin.c in Sources */,
				F96D494608F272C3004A47F5 /* bn_mp_toom_mul.c in Sources */,
				F96D494708F272C3004A47F5 /* bn_mp_toom_sqr.c in Sources */,
				F96D494908F272C3004A47F5 /* bn_mp_to_radix.c in Sources */,
				F9E61D32090A48FA002B3151 /* bn_mp_ubin_size.c in Sources */,
				F96D494908F272C3004A47F5 /* bn_mp_toradix_n.c in Sources */,
				F9E61D32090A48FA002B3151 /* bn_mp_unsigned_bin_size.c in Sources */,
				F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */,
				F96D494C08F272C3004A47F5 /* bn_mp_zero.c in Sources */,
				F96D494E08F272C3004A47F5 /* bn_reverse.c in Sources */,
				F96D494F08F272C3004A47F5 /* bn_s_mp_add.c in Sources */,
				F96D495108F272C3004A47F5 /* bn_s_mp_mul_digs.c in Sources */,
				F96D495308F272C3004A47F5 /* bn_s_mp_sqr.c in Sources */,
				F96D495408F272C3004A47F5 /* bn_s_mp_sub.c in Sources */,
				F96D495508F272C3004A47F5 /* bncore.c in Sources */,
				F96D49A908F272C4004A47F5 /* tclMacOSXBundle.c in Sources */,
				F96D49AD08F272C4004A47F5 /* tclMacOSXFCmd.c in Sources */,
				F96D49AE08F272C4004A47F5 /* tclMacOSXNotify.c in Sources */,
				F90509300913A72400327603 /* tclAppInit.c in Sources */,
				F96D4AC608F272C9004A47F5 /* tclLoadDyld.c in Sources */,
				F96D4ACA08F272C9004A47F5 /* tclUnixChan.c in Sources */,
				F9FC77B80AB29E9100B7077D /* tclUnixCompat.c in Sources */,
2137
2138
2139
2140
2141
2142
2143
2144
2145


2146
2147
2148
2149
2150
2151
2152
2180
2181
2182
2183
2184
2185
2186


2187
2188
2189
2190
2191
2192
2193
2194
2195







-
-
+
+







			name = ReleaseUniversal;
		};
		F91BCC51093152310042A6BF /* ReleaseUniversal */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
			};
			name = ReleaseUniversal;
		};
		F93084370BB93D2800CD0B9E /* DebugMemCompile */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
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
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







-
-
-
-

-
-
+
-








-
-
-
-
-


-
+
-







			};
			name = DebugMemCompile;
		};
		F930843A0BB93D2800CD0B9E /* DebugMemCompile */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --enable-symbols=all";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugMemCompile;
		};
		F9359B250DF212DA00E04F67 /* DebugGCov */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC_GENERATE_TEST_COVERAGE_FILES = YES;
				GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				OTHER_LDFLAGS = (
					"$(OTHER_LDFLAGS)",
					"-lgcov",
				);
				PREBINDING = NO;
			};
			name = DebugGCov;
2226
2227
2228
2229
2230
2231
2232
2233

2234
2235
2236
2237
2238
2239
2240
2257
2258
2259
2260
2261
2262
2263

2264
2265
2266
2267
2268
2269
2270
2271







-
+







			name = DebugGCov;
		};
		F9359B280DF212DA00E04F67 /* DebugGCov */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCLTEST_OPTIONS = "-notfile http.test";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugGCov;
		};
		F95CC8AC09158F3100EA5ACE /* Debug */ = {
			isa = XCBuildConfiguration;
2248
2249
2250
2251
2252
2253
2254
2255

2256
2257
2258
2259
2260
2261

2262
2263
2264
2265
2266
2267
2268
2279
2280
2281
2282
2283
2284
2285

2286
2287
2288
2289
2290
2291

2292
2293
2294
2295
2296
2297
2298
2299







-
+





-
+







			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = Release;
		};
		F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */ = {
		F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F95CC8B109158F3100EA5ACE /* Debug */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
				GCC_DYNAMIC_NO_PIC = NO;
				GCC_ENABLE_FIX_AND_CONTINUE = YES;
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
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







-
+




-
+





-
-
-
-
-
-
+
-








-
-
-
-
-
-
+
-




-
+



-
-
-
-
-
-
+
-


-
+







		F95CC8B209158F3100EA5ACE /* Release */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = Release;
		};
		F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */ = {
		F95CC8B309158F3100EA5ACE /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F95CC8B609158F3100EA5ACE /* Debug */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = Debug;
		};
		F95CC8B709158F3100EA5ACE /* Release */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = Release;
		};
		F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */ = {
		F95CC8B809158F3100EA5ACE /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F97258A90A86873D00096C78 /* Debug */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
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
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







-
+








-
+











+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = Release;
		};
		F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */ = {
		F97258AB0A86873D00096C78 /* DebugNoFixZL */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugNoFixAndContinue;
			name = DebugNoFixZL;
		};
		F97258AC0A86873D00096C78 /* ReleaseUniversal */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleaseUniversal;
		};
		F97AED080B660A6C00310EA2 /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleaseUniversal10.4uSDK;
		};
		F97AED0F0B660AA300310EA2 /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleasePPC10.3.9SDK;
		};
		F97AED160B660AF100310EA2 /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = ReleasePPC10.2.8SDK;
		};
		F97AED1B0B660B2100310EA2 /* Debug64bit */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
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
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







-
+








-
-
-
-

-
-
+
-







		F97AED1E0B660B2100310EA2 /* Debug64bit */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = "$(NATIVE_ARCH_64_BIT)";
				CONFIGURE_ARGS = "--enable-64bit $(CONFIGURE_ARGS)";
				CPPFLAGS = "-arch $(NATIVE_ARCH_64_BIT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
			};
			name = Debug64bit;
		};
		F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugNoCF;
		};
		F98751300DE7B57E00B1C9EC /* DebugNoCF */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471

2472
2473
2474
2475
2476
2477
2478
2479
2498
2499
2500
2501
2502
2503
2504




2505


2506

2507
2508
2509
2510
2511
2512
2513







-
-
-
-

-
-
+
-







			};
			name = DebugNoCF;
		};
		F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugNoCFUnthreaded;
		};
		F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
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
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
2658

2659
2660
2661
2662
2663
2664

2665
2666

2667
2668
2669
2670
2671

2672
2673

2674
2675
2676
2677
2678
2679
2680
2681
2682

2683
2684
2685
2686
2687
2688
2689
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
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
2658
2659
2660
2661

2662
2663

2664
2665
2666
2667
2668
2669

2670
2671

2672

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
2709
2710
2711
2712
2713
2714
2715







-
+



-
-
-
-
-
-
-
+
+
-


-
+

-
+





-
+

-
+












-
+

-
+








-
+

-
+



-
-
-
-
-
-
+

-
+
-


-
+

-
+





-
+

-
+












-
+

-
+








-
+

-
+




-
-
-
+
+
+


-
+

-
+





-
+

-
+




-
+

-
+








-
+

-
+




+
-
+

-

-

-
+
+
+
+
+

+

-
+

-
+





-
+

-
+




-
+

-
+








-
+







				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = DebugNoCFUnthreaded;
		};
		F9988AB10D814C6500B6B03B /* Debug gcc40 */ = {
		F9988AB10D814C6500B6B03B /* Debug gcc42 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC_VERSION = 4.0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				GCC_VERSION = 4.2;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = "Debug gcc40";
			name = "Debug gcc42";
		};
		F9988AB20D814C6500B6B03B /* Debug gcc40 */ = {
		F9988AB20D814C6500B6B03B /* Debug gcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "Debug gcc40";
			name = "Debug gcc42";
		};
		F9988AB30D814C6500B6B03B /* Debug gcc40 */ = {
		F9988AB30D814C6500B6B03B /* Debug gcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
				GCC_DYNAMIC_NO_PIC = NO;
				GCC_ENABLE_FIX_AND_CONTINUE = YES;
				GCC_PREPROCESSOR_DEFINITIONS = (
					"__private_extern__=extern",
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
				);
				GCC_SYMBOLS_PRIVATE_EXTERN = NO;
				PRODUCT_NAME = tcltest;
			};
			name = "Debug gcc40";
			name = "Debug gcc42";
		};
		F9988AB40D814C6500B6B03B /* Debug gcc40 */ = {
		F9988AB40D814C6500B6B03B /* Debug gcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "Debug gcc40";
			name = "Debug gcc42";
		};
		F9988AB50D814C7500B6B03B /* Debug llvm-gcc */ = {
		F9988AB50D814C7500B6B03B /* Debug llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC = "llvm-gcc";
				CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2";
				GCC_VERSION = com.apple.compilers.llvmgcc42;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = "Debug llvm-gcc";
			name = "Debug llvmgcc42";
		};
		F9988AB60D814C7500B6B03B /* Debug llvm-gcc */ = {
		F9988AB60D814C7500B6B03B /* Debug llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "Debug llvm-gcc";
			name = "Debug llvmgcc42";
		};
		F9988AB70D814C7500B6B03B /* Debug llvm-gcc */ = {
		F9988AB70D814C7500B6B03B /* Debug llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
				GCC_DYNAMIC_NO_PIC = NO;
				GCC_ENABLE_FIX_AND_CONTINUE = YES;
				GCC_PREPROCESSOR_DEFINITIONS = (
					"__private_extern__=extern",
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
				);
				GCC_SYMBOLS_PRIVATE_EXTERN = NO;
				PRODUCT_NAME = tcltest;
			};
			name = "Debug llvm-gcc";
			name = "Debug llvmgcc42";
		};
		F9988AB80D814C7500B6B03B /* Debug llvm-gcc */ = {
		F9988AB80D814C7500B6B03B /* Debug llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "Debug llvm-gcc";
			name = "Debug llvmgcc42";
		};
		F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
		F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc42 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				GCC_VERSION = 4.0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)";
				GCC_VERSION = 4.2;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
			};
			name = "ReleaseUniversal gcc40";
			name = "ReleaseUniversal gcc42";
		};
		F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
		F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "ReleaseUniversal gcc40";
			name = "ReleaseUniversal gcc42";
		};
		F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
		F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = "ReleaseUniversal gcc40";
			name = "ReleaseUniversal gcc42";
		};
		F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */ = {
		F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "ReleaseUniversal gcc40";
			name = "ReleaseUniversal gcc42";
		};
		F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
		F9988BB50D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)";
				DEBUG_INFORMATION_FORMAT = dwarf;
				GCC = "llvm-gcc";
				GCC_OPTIMIZATION_LEVEL = 4;
				"GCC_OPTIMIZATION_LEVEL[arch=ppc]" = s;
				GCC_VERSION = com.apple.compilers.llvmgcc42;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				OTHER_CFLAGS = (
					"$(OTHER_CFLAGS)",
					"-emit-llvm",
				);
				PREBINDING = NO;
				TCL_CONFIGURE_ARGS = "$(TCL_CONFIGURE_ARGS) --disable-dtrace";
			};
			name = "ReleaseUniversal llvm-gcc";
			name = "ReleaseUniversal llvmgcc42";
		};
		F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
		F9988BB60D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "ReleaseUniversal llvm-gcc";
			name = "ReleaseUniversal llvmgcc42";
		};
		F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
		F9988BB70D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = "ReleaseUniversal llvm-gcc";
			name = "ReleaseUniversal llvmgcc42";
		};
		F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */ = {
		F9988BB80D81587400B6B03B /* ReleaseUniversal llvmgcc42 */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "ReleaseUniversal llvm-gcc";
			name = "ReleaseUniversal llvmgcc42";
		};
		F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765

2766
2767
2768
2769
2770
2771
2772

2773
2774
2775
2776

2777
2778
2779
2780
2781
2782
2783
2784
2785

2786
2787

2788
2789

2790
2791
2792

2793
2794
2795

2796
2797

2798

2799
2800
2801
2802
2803





2804
2805


2806
2807
2808


2809
2810

2811
2812

2813
2814
2815
2816
2817



2818
2819
2820
2821









2822
2823

2824
2825
2826
2827
2828


2829
2830
2831

2832
2833
2834
2835
2836
2837



2838
2839

2840
2841

2842
2843
2844
2845
2846
2847

2848
2849

2850
2851
2852
2853
2854

2855
2856

2857

2858
2859
2860
2861
2862
2863














2864
2865

2866
2867
2868
2869
2870
2871
2872
2759
2760
2761
2762
2763
2764
2765




2766


2767

2768
2769
2770
2771
2772
2773
2774
2775





2776
2777
2778
2779

2780

2781

2782
2783
2784

2785
2786

2787

2788









2789
2790

2791
2792

2793
2794
2795

2796

2797

2798
2799

2800
2801
2802
2803




2804
2805
2806
2807
2808


2809
2810
2811


2812
2813
2814

2815
2816

2817
2818
2819



2820
2821
2822




2823
2824
2825
2826
2827
2828
2829
2830
2831
2832

2833
2834
2835
2836


2837
2838



2839






2840
2841
2842
2843

2844
2845

2846
2847
2848
2849
2850
2851

2852
2853

2854
2855
2856
2857
2858

2859
2860

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







-
-
-
-

-
-
+
-








-
-
-
-
-




-
+
-

-



-
+

-

-
+
-
-
-
-
-
-
-
-
-
+

-
+

-
+


-
+
-

-
+

-
+

+

-
-
-
-
+
+
+
+
+
-
-
+
+

-
-
+
+

-
+

-
+


-
-
-
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+



-
-
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+

-
+

-
+





-
+

-
+




-
+

-
+

+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+







			};
			name = DebugLeaks;
		};
		F99EE7410BE835310060D4AF /* DebugUnthreaded */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads";
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
			};
			name = DebugUnthreaded;
		};
		F99EE7420BE835310060D4AF /* DebugLeaks */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC_PREPROCESSOR_DEFINITIONS = (
					PURIFY,
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
				);
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
				RUN_CLANG_STATIC_ANALYZER = YES;
			};
			name = DebugLeaks;
		};
		F9A9D1EF0FC77787002A2BE3 /* Debug clang */ = {
		F9DB62080B65ADA800A370FB /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */;
			buildSettings = {
				ARCHS = (
				PRODUCT_NAME = tclsh;
					"$(NATIVE_ARCH_64_BIT)",
					"$(NATIVE_ARCH_32_BIT)",
				);
				CPPFLAGS = "-arch $(CURRENT_ARCH) $(CPPFLAGS)";
				GCC = clang;
				GCC_VERSION = com.apple.compilers.llvm.clang.1_0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				ONLY_ACTIVE_ARCH = YES;
				PREBINDING = NO;
				SKIP_INSTALL = NO;
			};
			name = "Debug clang";
			name = ReleaseUniversal10.4uSDK;
		};
		F9A9D1F00FC77787002A2BE3 /* Debug clang */ = {
		F9DB62090B65ADA800A370FB /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				PRODUCT_NAME = tcltest;
				SKIP_INSTALL = NO;
			};
			name = "Debug clang";
			name = ReleaseUniversal10.4uSDK;
		};
		F9A9D1F10FC77787002A2BE3 /* Debug clang */ = {
		F9DB620A0B65ADA800A370FB /* ReleaseUniversal10.4uSDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				CONFIGURE_ARGS = "tcl_cv_cc_visibility_hidden=no $(CONFIGURE_ARGS)";
				GCC_DYNAMIC_NO_PIC = NO;
				GCC_ENABLE_FIX_AND_CONTINUE = YES;
				GCC_PREPROCESSOR_DEFINITIONS = (
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)";
				CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.4;
				OTHER_LDFLAGS = (
					"__private_extern__=extern",
					"$(GCC_PREPROCESSOR_DEFINITIONS)",
					"-Wl,-no_arch_warnings",
					"$(OTHER_LDFLAGS)",
				);
				GCC_SYMBOLS_PRIVATE_EXTERN = NO;
				PRODUCT_NAME = tcltest;
				PREBINDING = NO;
				SDKROOT = macosx10.4;
			};
			name = "Debug clang";
			name = ReleaseUniversal10.4uSDK;
		};
		F9A9D1F20FC77787002A2BE3 /* Debug clang */ = {
		F9DB621F0B65AFDE00A370FB /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				LDFLAGS = "-force_cpusubtype_ALL $(LDFLAGS)";
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
			};
			name = "Debug clang";
			};
			name = ReleasePPC10.3.9SDK;
		};
		F9DB62200B65AFDE00A370FB /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = ReleasePPC10.3.9SDK;
		};
		F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */ = {
		F9DB62210B65AFDE00A370FB /* ReleasePPC10.3.9SDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = (
					"$(NATIVE_ARCH_64_BIT)",
				ARCHS = ppc;
				CFLAGS = "$(PER_ARCH_CFLAGS_ppc) $(CFLAGS)";
					"$(NATIVE_ARCH_32_BIT)",
				);
				CFLAGS = "-arch i386 -arch x86_64 $(CFLAGS)";
				CPPFLAGS = "-arch ppc -isysroot $(SDKROOT) $(CPPFLAGS)";
				DEBUG_INFORMATION_FORMAT = dwarf;
				GCC = clang;
				GCC_OPTIMIZATION_LEVEL = 4;
				GCC_VERSION = com.apple.compilers.llvm.clang.1_0;
				MACOSX_DEPLOYMENT_TARGET = 10.6;
				PREBINDING = NO;
				MACOSX_DEPLOYMENT_TARGET = 10.3;
				PREBINDING = YES;
				SDKROOT = "$(DEVELOPER_SDK_DIR)/MacOSX10.3.9.sdk";
			};
			name = "ReleaseUniversal clang";
			name = ReleasePPC10.3.9SDK;
		};
		F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */ = {
		F9DB62350B65B03A00A370FB /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
			name = "ReleaseUniversal clang";
			name = ReleasePPC10.2.8SDK;
		};
		F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */ = {
		F9DB62360B65B03A00A370FB /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tcltest;
			};
			name = "ReleaseUniversal clang";
			name = ReleasePPC10.2.8SDK;
		};
		F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */ = {
		F9DB62370B65B03A00A370FB /* ReleasePPC10.2.8SDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				CODE_SIGN_IDENTITY = "";
				PRODUCT_NAME = tests;
				TCLTEST_OPTIONS = "";
				TCL_LIBRARY = "$(TCL_SRCROOT)/library";
				TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest";
				ARCHS = ppc;
				CFLAGS = "$(PER_ARCH_CFLAGS_ppc) -fconstant-cfstrings $(CFLAGS)";
				CPPFLAGS = "-arch ppc -D__CONSTANT_CFSTRINGS__ -DMAC_OS_X_VERSION_MIN_REQUIRED=1020 -nostdinc -isystem $(SDKROOT)/usr/include/gcc/darwin/$(GCC_VERSION) -isystem $(SDKROOT)/usr/include -F$(SDKROOT)/System/Library/Frameworks";
				DEBUG_INFORMATION_FORMAT = stabs;
				GCC = /usr/bin/gcc;
				GCC_VERSION = 3.3;
				LDFLAGS = "-L$(SDKROOT)/usr/lib/gcc/darwin/$(GCC_VERSION) -Wl,-syslibroot,$(SDKROOT)";
				MACOSX_DEPLOYMENT_TARGET = 10.2;
				PREBINDING = YES;
				SDKROOT = "$(DEVELOPER_SDK_DIR)/MacOSX10.2.8.sdk";
				WARNING_CFLAGS = (
					"$(WARNING_CFLAGS_GCC3)",
					"-Wno-long-double",
				);
			};
			name = "ReleaseUniversal clang";
			name = ReleasePPC10.2.8SDK;
		};
		F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
			isa = XCBuildConfiguration;
			buildSettings = {
				PRODUCT_NAME = tclsh;
				SKIP_INSTALL = NO;
			};
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
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







-
+














-
-
+
+
-
-
+









-
-
+
+
-

+
+
+








-
-
+
+
-
-
+









-
-
+
+
-

+
+
+








-
-
+
+
-
-
+









-
-
+
+
-

+
+
+








-
-
+
+
-
-
+









-
-
+
+
-

+
+
+








			name = ReleaseUniversal10.5SDK;
		};
		F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */ = {
			isa = XCBuildConfiguration;
			baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */;
			buildSettings = {
				ARCHS = "$(ARCHS_STANDARD_32_64_BIT)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc $(CFLAGS)";
				CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)";
				CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)";
				MACOSX_DEPLOYMENT_TARGET = 10.5;
				PREBINDING = NO;
				SDKROOT = macosx10.5;
			};
			name = ReleaseUniversal10.5SDK;
		};
/* End XCBuildConfiguration section */

/* Begin XCConfigurationList section */
		F95CC8AB09158F3100EA5ACE /* Build configuration list for PBXNativeTarget "Tcl" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F95CC8AC09158F3100EA5ACE /* Debug */,
				F9A9D1F00FC77787002A2BE3 /* Debug clang */,
				F9988AB60D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB20D814C6500B6B03B /* Debug gcc42 */,
				F9988AB60D814C7500B6B03B /* Debug llvmgcc42 */,
				F9988AB20D814C6500B6B03B /* Debug gcc40 */,
				F95CC8AE09158F3100EA5ACE /* DebugNoFixAndContinue */,
				F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */,
				F99EE73B0BE835310060D4AF /* DebugUnthreaded */,
				F98751300DE7B57E00B1C9EC /* DebugNoCF */,
				F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F93084370BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE73C0BE835310060D4AF /* DebugLeaks */,
				F9359B260DF212DA00E04F67 /* DebugGCov */,
				F97AED1B0B660B2100310EA2 /* Debug64bit */,
				F95CC8AD09158F3100EA5ACE /* Release */,
				F91BCC4F093152310042A6BF /* ReleaseUniversal */,
				F9A9D1F40FC77799002A2BE3 /* ReleaseUniversal clang */,
				F9988BB60D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc42 */,
				F9988BB60D81587400B6B03B /* ReleaseUniversal llvmgcc42 */,
				F9988BB20D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED960C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F9DB62080B65ADA800A370FB /* ReleaseUniversal10.4uSDK */,
				F9DB621F0B65AFDE00A370FB /* ReleasePPC10.3.9SDK */,
				F9DB62350B65B03A00A370FB /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
		F95CC8B009158F3100EA5ACE /* Build configuration list for PBXNativeTarget "tcltest" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F95CC8B109158F3100EA5ACE /* Debug */,
				F9A9D1F10FC77787002A2BE3 /* Debug clang */,
				F9988AB70D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB30D814C6500B6B03B /* Debug gcc42 */,
				F9988AB70D814C7500B6B03B /* Debug llvmgcc42 */,
				F9988AB30D814C6500B6B03B /* Debug gcc40 */,
				F95CC8B309158F3100EA5ACE /* DebugNoFixAndContinue */,
				F95CC8B309158F3100EA5ACE /* DebugNoFixZL */,
				F99EE73D0BE835310060D4AF /* DebugUnthreaded */,
				F98751310DE7B57E00B1C9EC /* DebugNoCF */,
				F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F93084380BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE73E0BE835310060D4AF /* DebugLeaks */,
				F9359B270DF212DA00E04F67 /* DebugGCov */,
				F97AED1C0B660B2100310EA2 /* Debug64bit */,
				F95CC8B209158F3100EA5ACE /* Release */,
				F91BCC50093152310042A6BF /* ReleaseUniversal */,
				F9A9D1F50FC77799002A2BE3 /* ReleaseUniversal clang */,
				F9988BB70D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc42 */,
				F9988BB70D81587400B6B03B /* ReleaseUniversal llvmgcc42 */,
				F9988BB30D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED970C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F9DB62090B65ADA800A370FB /* ReleaseUniversal10.4uSDK */,
				F9DB62200B65AFDE00A370FB /* ReleasePPC10.3.9SDK */,
				F9DB62360B65B03A00A370FB /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
		F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F95CC8B609158F3100EA5ACE /* Debug */,
				F9A9D1EF0FC77787002A2BE3 /* Debug clang */,
				F9988AB50D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB10D814C6500B6B03B /* Debug gcc42 */,
				F9988AB50D814C7500B6B03B /* Debug llvmgcc42 */,
				F9988AB10D814C6500B6B03B /* Debug gcc40 */,
				F95CC8B809158F3100EA5ACE /* DebugNoFixAndContinue */,
				F95CC8B809158F3100EA5ACE /* DebugNoFixZL */,
				F99EE7410BE835310060D4AF /* DebugUnthreaded */,
				F987512F0DE7B57E00B1C9EC /* DebugNoCF */,
				F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F930843A0BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE7420BE835310060D4AF /* DebugLeaks */,
				F9359B250DF212DA00E04F67 /* DebugGCov */,
				F97AED1E0B660B2100310EA2 /* Debug64bit */,
				F95CC8B709158F3100EA5ACE /* Release */,
				F91BCC51093152310042A6BF /* ReleaseUniversal */,
				F9A9D1F30FC77799002A2BE3 /* ReleaseUniversal clang */,
				F9988BB50D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc42 */,
				F9988BB50D81587400B6B03B /* ReleaseUniversal llvmgcc42 */,
				F9988BB10D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED990C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F9DB620A0B65ADA800A370FB /* ReleaseUniversal10.4uSDK */,
				F9DB62210B65AFDE00A370FB /* ReleasePPC10.3.9SDK */,
				F9DB62370B65B03A00A370FB /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
		F97258A80A86873D00096C78 /* Build configuration list for PBXNativeTarget "tests" */ = {
			isa = XCConfigurationList;
			buildConfigurations = (
				F97258A90A86873D00096C78 /* Debug */,
				F9A9D1F20FC77787002A2BE3 /* Debug clang */,
				F9988AB80D814C7500B6B03B /* Debug llvm-gcc */,
				F9988AB40D814C6500B6B03B /* Debug gcc42 */,
				F9988AB80D814C7500B6B03B /* Debug llvmgcc42 */,
				F9988AB40D814C6500B6B03B /* Debug gcc40 */,
				F97258AB0A86873D00096C78 /* DebugNoFixAndContinue */,
				F97258AB0A86873D00096C78 /* DebugNoFixZL */,
				F99EE73F0BE835310060D4AF /* DebugUnthreaded */,
				F98751320DE7B57E00B1C9EC /* DebugNoCF */,
				F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */,
				F93084390BB93D2800CD0B9E /* DebugMemCompile */,
				F99EE7400BE835310060D4AF /* DebugLeaks */,
				F9359B280DF212DA00E04F67 /* DebugGCov */,
				F97AED1D0B660B2100310EA2 /* Debug64bit */,
				F97258AA0A86873D00096C78 /* Release */,
				F97258AC0A86873D00096C78 /* ReleaseUniversal */,
				F9A9D1F60FC77799002A2BE3 /* ReleaseUniversal clang */,
				F9988BB80D81587400B6B03B /* ReleaseUniversal llvm-gcc */,
				F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc42 */,
				F9988BB80D81587400B6B03B /* ReleaseUniversal llvmgcc42 */,
				F9988BB40D81586D00B6B03B /* ReleaseUniversal gcc40 */,
				F9EEED980C2FEFD300396116 /* ReleaseUniversal10.5SDK */,
				F97AED080B660A6C00310EA2 /* ReleaseUniversal10.4uSDK */,
				F97AED0F0B660AA300310EA2 /* ReleasePPC10.3.9SDK */,
				F97AED160B660AF100310EA2 /* ReleasePPC10.2.8SDK */,
			);
			defaultConfigurationIsVisible = 0;
			defaultConfigurationName = Debug;
		};
/* End XCConfigurationList section */
	};
	rootObject = 08FB7793FE84155DC02AAC07 /* Project object */;
}

Changes to macosx/configure.ac.

1
2
3
4
5
6
7
8
9
10
11

1
2
3
4
5
6
7
8
9
10

11










-
+
#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

dnl	Ensure that the config (auto)headers support is used, then just
dnl	include the configure sources from ../unix:

m4_include(../unix/aclocal.m4)
m4_define(SC_USE_CONFIG_HEADERS)
m4_include(../unix/configure.ac)
m4_include(../unix/configure.in)

Changes to macosx/tclMacOSXBundle.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37
38
39
40

41
42
43
44
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
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







-













-
+










-
+







-
+
-
-
+

-
+







-
+



-
+
-
-
-
+
+
-
-
+


-
+
-
-
-
-
-
-


-
+



-
+

-
-
-
-
+
+
+
+

-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
-
-
+
+
+
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
+
+
-
-
-
-
-
+
-
-
+
+
-
-
-
-
+
+

-
-







 * Copyright (c) 2003-2009 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclPort.h"
#include "tclInt.h"

#ifdef HAVE_COREFOUNDATION
#include <CoreFoundation/CoreFoundation.h>

#ifndef TCL_DYLD_USE_DLFCN
/*
 * Use preferred dlfcn API on 10.4 and later
 */
#   if !defined(NO_DLFCN_H) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1040
#	define TCL_DYLD_USE_DLFCN 1
#   else
#	define TCL_DYLD_USE_DLFCN 0
#   endif
#endif /* TCL_DYLD_USE_DLFCN */
#endif

#ifndef TCL_DYLD_USE_NSMODULE
/*
 * Use deprecated NSModule API only to support 10.3 and earlier:
 */
#   if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
#	define TCL_DYLD_USE_NSMODULE 1
#   else
#	define TCL_DYLD_USE_NSMODULE 0
#   endif
#endif /* TCL_DYLD_USE_NSMODULE */
#endif

#if TCL_DYLD_USE_DLFCN
#include <dlfcn.h>
#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/*
 * Support for weakly importing dlfcn API.
 */
extern void *		dlsym(void *handle, const char *symbol)
extern void *dlsym(void *handle, const char *symbol) WEAK_IMPORT_ATTRIBUTE;
			    WEAK_IMPORT_ATTRIBUTE;
extern char *		dlerror(void) WEAK_IMPORT_ATTRIBUTE;
extern char *dlerror(void) WEAK_IMPORT_ATTRIBUTE;
#endif
#endif /* TCL_DYLD_USE_DLFCN */
#endif

#if TCL_DYLD_USE_NSMODULE
#include <mach-o/dyld.h>
#endif

#if (TCL_DYLD_USE_DLFCN && MAC_OS_X_VERSION_MIN_REQUIRED < 1040) || \
	(MAC_OS_X_VERSION_MIN_REQUIRED < 1050)
MODULE_SCOPE long	tclMacOSXDarwinRelease;
MODULE_SCOPE long tclMacOSXDarwinRelease;
#endif

#ifdef TCL_DEBUG_LOAD
#define TclLoadDbgMsg(m, ...) \
#define TclLoadDbgMsg(m, ...) do { \
    do {								\
	fprintf(stderr, "%s:%d: %s(): " m ".\n",			\
		strrchr(__FILE__, '/')+1, __LINE__, __func__,		\
	    fprintf(stderr, "%s:%d: %s(): " m ".\n", \
	    strrchr(__FILE__, '/')+1, __LINE__, __func__, ##__VA_ARGS__); \
		##__VA_ARGS__);						\
    } while (0)
	} while (0)
#else
#define TclLoadDbgMsg(m, ...)
#endif /* TCL_DEBUG_LOAD */
#endif

/*
 * Forward declaration of functions defined in this file:
 */

static short		OpenResourceMap(CFBundleRef bundleRef);

#endif /* HAVE_COREFOUNDATION */


/*
 *----------------------------------------------------------------------
 *
 * OpenResourceMap --
 * Tcl_MacOSXOpenBundleResources --
 *
 *	Wrapper that dynamically acquires the address for the function
 *	CFBundleOpenBundleResourceMap before calling it, since it is only
 *	present in full CoreFoundation on Mac OS X and not in CFLite on pure
 *	Darwin. Factored out because it is moderately ugly code.
 *	Given the bundle name for a shared library, this routine sets
 *	libraryPath to the Resources/Scripts directory in the framework
 *	package. If hasResourceFile is true, it will also open the main
 *	resource file for the bundle.
 *
 *----------------------------------------------------------------------
 */

 * Results:
 *	TCL_OK if the bundle could be opened, and the Scripts folder found.
#ifdef HAVE_COREFOUNDATION

 *	TCL_ERROR otherwise.
static short
OpenResourceMap(
    CFBundleRef bundleRef)
{
    static int initialized = FALSE;
    static short (*openresourcemap)(CFBundleRef) = NULL;

 *
    if (!initialized) {
#if TCL_DYLD_USE_DLFCN
#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
	if (tclMacOSXDarwinRelease >= 8)
#endif
	{
	    openresourcemap = (short (*)(CFBundleRef))dlsym(RTLD_NEXT,
		    "CFBundleOpenBundleResourceMap");
#ifdef TCL_DEBUG_LOAD
	    if (!openresourcemap) {
 * Side effects:
 *	libraryVariableName may be set, and the resource file opened.
		const char *errMsg = dlerror();

 *
		TclLoadDbgMsg("dlsym() failed: %s", errMsg);
	    }
 *----------------------------------------------------------------------
 */

#endif /* TCL_DEBUG_LOAD */
	}
	if (!openresourcemap)
#endif /* TCL_DYLD_USE_DLFCN */
	{
#if TCL_DYLD_USE_NSMODULE
	    if (NSIsSymbolNameDefinedWithHint(
int
		    "_CFBundleOpenBundleResourceMap", "CoreFoundation")) {
		NSSymbol nsSymbol = NSLookupAndBindSymbolWithHint(
			"_CFBundleOpenBundleResourceMap", "CoreFoundation");

Tcl_MacOSXOpenBundleResources(
    Tcl_Interp *interp,
		if (nsSymbol) {
		    openresourcemap = NSAddressOfSymbol(nsSymbol);
    CONST char *bundleName,
    int hasResourceFile,
		}
	    }
#endif /* TCL_DYLD_USE_NSMODULE */
	}
	initialized = TRUE;
    int maxPathLen,
    }

    char *libraryPath)
{
    if (openresourcemap) {
	return openresourcemap(bundleRef);
    }
    return -1;
    return Tcl_MacOSXOpenVersionedBundleResources(interp, bundleName,
	    NULL, hasResourceFile, maxPathLen, libraryPath);
}

#endif /* HAVE_COREFOUNDATION */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MacOSXOpenVersionedBundleResources --
 *
 *	Given the bundle and version name for a shared library (version name
162
163
164
165
166
167
168
169
170
171



172
173

174
175
176
177
178
179
180
120
121
122
123
124
125
126



127
128
129
130

131
132
133
134
135
136
137
138







-
-
-
+
+
+

-
+







 *	libraryVariableName may be set, and the resource file opened.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_MacOSXOpenVersionedBundleResources(
    TCL_UNUSED(Tcl_Interp *),
    const char *bundleName,
    const char *bundleVersion,
    Tcl_Interp *interp,
    CONST char *bundleName,
    CONST char *bundleVersion,
    int hasResourceFile,
    size_t maxPathLen,
    int maxPathLen,
    char *libraryPath)
{
#ifdef HAVE_COREFOUNDATION
    CFBundleRef bundleRef, versionedBundleRef = NULL;
    CFStringRef bundleNameRef;
    CFURLRef libURL;

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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+












-
+




-
-
+
-
-










+
+

-
+

+









	    }
	    CFRelease(bundleURL);
	}
    }

    if (bundleRef) {
	if (hasResourceFile) {
	    /*
	     * Dynamically acquire address for CFBundleOpenBundleResourceMap
	     * symbol, since it is only present in full CoreFoundation on Mac
	     * OS X and not in CFLite on pure Darwin.
	     */

	    static int initialized = FALSE;
	    static short (*openresourcemap)(CFBundleRef) = NULL;

	    if (!initialized) {
#if TCL_DYLD_USE_DLFCN
#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
		if (tclMacOSXDarwinRelease >= 8)
#endif
		{
		    const char *errMsg = nil;
		    openresourcemap = dlsym(RTLD_NEXT,
			    "CFBundleOpenBundleResourceMap");
		    if (!openresourcemap) {
			errMsg = dlerror();
			TclLoadDbgMsg("dlsym() failed: %s", errMsg);
		    }
		}
		if (!openresourcemap)
#endif
		{
#if TCL_DYLD_USE_NSMODULE
		    NSSymbol nsSymbol = NULL;
		    if (NSIsSymbolNameDefinedWithHint(
			    "_CFBundleOpenBundleResourceMap",
			    "CoreFoundation")) {
			nsSymbol = NSLookupAndBindSymbolWithHint(
				"_CFBundleOpenBundleResourceMap",
				"CoreFoundation");
			if (nsSymbol) {
			    openresourcemap = NSAddressOfSymbol(nsSymbol);
			}
		    }
#endif
		}
		initialized = TRUE;
	    }

	    if (openresourcemap) {
	    (void) OpenResourceMap(bundleRef);
		openresourcemap(bundleRef);
	    }
	}

	libURL = CFBundleCopyResourceURL(bundleRef, CFSTR("Scripts"),
		NULL, NULL);

	if (libURL) {
	    /*
	     * FIXME: This is a quick fix, it is probably not right for
	     * internationalization.
	     */

	    CFURLGetFileSystemRepresentation(libURL, TRUE,
		    (unsigned char *) libraryPath, maxPathLen);
		    (unsigned char*) libraryPath, maxPathLen);
	    CFRelease(libURL);
	}
	if (versionedBundleRef) {
#if MAC_OS_X_VERSION_MIN_REQUIRED < 1050
	    /*
	     * Workaround CFBundle bug in Tiger and earlier. [Bug 2569449]
	    /* Workaround CFBundle bug in Tiger and earlier. [Bug 2569449] */
	     */

	    if (tclMacOSXDarwinRelease >= 9)
#endif
	    {
		CFRelease(versionedBundleRef);
	    }
	}
    }

    if (libraryPath[0]) {
	return TCL_OK;
    } else {
	return TCL_ERROR;
    }
#endif /* HAVE_COREFOUNDATION */
#else  /* HAVE_COREFOUNDATION */
    return TCL_ERROR;
#endif /* HAVE_COREFOUNDATION */
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to macosx/tclMacOSXFCmd.c.

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
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







-
+


-
+
-
-
+


-
+
-
-
-
-
-
+
+
+
+


-
+
-
-
+




-
-
-
-
-
-
-
-







#include <libkern/OSByteOrder.h>
#endif

/* Darwin 8 copyfile API. */
#ifdef HAVE_COPYFILE
#ifdef HAVE_COPYFILE_H
#include <copyfile.h>
#if defined(HAVE_WEAK_IMPORT) && (MAC_OS_X_VERSION_MIN_REQUIRED < 1040)
#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/* Support for weakly importing copyfile. */
#define WEAK_IMPORT_COPYFILE
extern int		copyfile(const char *from, const char *to,
extern int copyfile(const char *from, const char *to, copyfile_state_t state,
			    copyfile_state_t state, copyfile_flags_t flags)
			    WEAK_IMPORT_ATTRIBUTE;
		    copyfile_flags_t flags) WEAK_IMPORT_ATTRIBUTE;
#endif /* HAVE_WEAK_IMPORT */
#else /* HAVE_COPYFILE_H */
int			copyfile(const char *from, const char *to,
int copyfile(const char *from, const char *to, void *state, uint32_t flags);
			    void *state, uint32_t flags);
#define COPYFILE_ACL		(1<<0)
#define COPYFILE_XATTR		(1<<2)
#define COPYFILE_NOFOLLOW_SRC	(1<<18)
#if defined(HAVE_WEAK_IMPORT) && (MAC_OS_X_VERSION_MIN_REQUIRED < 1040)
#define COPYFILE_ACL            (1<<0)
#define COPYFILE_XATTR          (1<<2)
#define COPYFILE_NOFOLLOW_SRC   (1<<18)
#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/* Support for weakly importing copyfile. */
#define WEAK_IMPORT_COPYFILE
extern int		copyfile(const char *from, const char *to,
extern int copyfile(const char *from, const char *to, void *state,
			    void *state, uint32_t flags)
			    WEAK_IMPORT_ATTRIBUTE;
                    uint32_t flags) WEAK_IMPORT_ATTRIBUTE;
#endif /* HAVE_WEAK_IMPORT */
#endif /* HAVE_COPYFILE_H */
#endif /* HAVE_COPYFILE */

#ifdef WEAK_IMPORT_COPYFILE
#define MayUseCopyFile()	(copyfile != NULL)
#elif defined(HAVE_COPYFILE)
#define MayUseCopyFile()	(1)
#else
#define MayUseCopyFile()	(0)
#endif

#include <libkern/OSByteOrder.h>

/*
 * Constants for file attributes subcommand. Need to be kept in sync with
 * tclUnixFCmd.c !
 */

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
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







-
+








-
+


-
+










-
+








static int		GetOSTypeFromObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr, OSType *osTypePtr);
static Tcl_Obj *	NewOSTypeObj(const OSType newOSType);
static int		SetOSTypeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void		UpdateStringOfOSType(Tcl_Obj *objPtr);

static const Tcl_ObjType tclOSTypeType = {
static Tcl_ObjType tclOSTypeType = {
    "osType",				/* name */
    NULL,				/* freeIntRepProc */
    NULL,				/* dupIntRepProc */
    UpdateStringOfOSType,		/* updateStringProc */
    SetOSTypeFromAny			/* setFromAnyProc */
};

enum {
    kIsInvisible = 0x4000,
   kIsInvisible = 0x4000,
};

#define kFinfoIsInvisible	(OSSwapHostToBigConstInt16(kIsInvisible))
#define kFinfoIsInvisible (OSSwapHostToBigConstInt16(kIsInvisible))

typedef	struct finderinfo {
    u_int32_t type;
    u_int32_t creator;
    u_int16_t fdFlags;
    u_int32_t location;
    u_int16_t reserved;
    u_int32_t extendedFileInfo[4];
} __attribute__ ((__packed__)) finderinfo;

typedef struct {
typedef struct fileinfobuf {
    u_int32_t info_length;
    u_int32_t data[8];
} fileinfobuf;

/*
 *----------------------------------------------------------------------
 *
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
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







-
-
+
+





-
-
-
+
+









-
-
+
+










-
+



-
-
-
+
+













-
+



-
+




-
-
+
-

-
+







    Tcl_Obj **attributePtrPtr)	 /* A pointer to return the object with. */
{
#ifdef HAVE_GETATTRLIST
    int result;
    Tcl_StatBuf statBuf;
    struct attrlist alist;
    fileinfobuf finfo;
    finderinfo *finder = (finderinfo *) &finfo.data;
    off_t *rsrcForkSize = (off_t *) &finfo.data;
    finderinfo *finder = (finderinfo*)(&finfo.data);
    off_t *rsrcForkSize = (off_t*)(&finfo.data);
    const char *native;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": %s",
		TclGetString(fileName), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "could not read \"",
		TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }

    if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) {
	/*
	 * Directories only support attribute "-hidden".
	 */

	errno = EISDIR;
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid attribute: %s", Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "invalid attribute: ",
		Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }

    bzero(&alist, sizeof(struct attrlist));
    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
    if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
	alist.fileattr = ATTR_FILE_RSRCLENGTH;
    } else {
	alist.commonattr = ATTR_CMN_FNDRINFO;
    }
    native = (const char *)Tcl_FSGetNativePath(fileName);
    native = Tcl_FSGetNativePath(fileName);
    result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);

    if (result != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read attributes of \"%s\": %s",
		TclGetString(fileName), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "could not read attributes of \"",
		TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }

    switch (objIndex) {
    case MACOSX_CREATOR_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->creator));
	break;
    case MACOSX_TYPE_ATTRIBUTE:
	*attributePtrPtr = NewOSTypeObj(
		OSSwapBigToHostInt32(finder->type));
	break;
    case MACOSX_HIDDEN_ATTRIBUTE:
	TclNewIntObj(*attributePtrPtr,
	*attributePtrPtr = Tcl_NewBooleanObj(
		(finder->fdFlags & kFinfoIsInvisible) != 0);
	break;
    case MACOSX_RSRCLENGTH_ATTRIBUTE:
	TclNewIntObj(*attributePtrPtr, *rsrcForkSize);
	*attributePtrPtr = Tcl_NewWideIntObj(*rsrcForkSize);
	break;
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", -1));
    Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif /* HAVE_GETATTRLIST */
#endif
}

/*
 *---------------------------------------------------------------------------
 *
 * TclMacOSXSetFileAttribute --
 *
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
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







-
-
+
+





-
-
-
+
+









-
-
+
+










-
+



-
-
-
+
+







    Tcl_Obj *attributePtr)	/* New owner for file. */
{
#ifdef HAVE_GETATTRLIST
    int result;
    Tcl_StatBuf statBuf;
    struct attrlist alist;
    fileinfobuf finfo;
    finderinfo *finder = (finderinfo *) &finfo.data;
    off_t *rsrcForkSize = (off_t *) &finfo.data;
    finderinfo *finder = (finderinfo*)(&finfo.data);
    off_t *rsrcForkSize = (off_t*)(&finfo.data);
    const char *native;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read \"%s\": %s",
		TclGetString(fileName), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "could not read \"",
		TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }

    if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) {
	/*
	 * Directories only support attribute "-hidden".
	 */

	errno = EISDIR;
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"invalid attribute: %s", Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "invalid attribute: ",
		Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }

    bzero(&alist, sizeof(struct attrlist));
    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
    if (objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
	alist.fileattr = ATTR_FILE_RSRCLENGTH;
    } else {
	alist.commonattr = ATTR_CMN_FNDRINFO;
    }
    native = (const char *)Tcl_FSGetNativePath(fileName);
    native = Tcl_FSGetNativePath(fileName);
    result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);

    if (result != 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"could not read attributes of \"%s\": %s",
		TclGetString(fileName), Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "could not read attributes of \"",
		TclGetString(fileName), "\": ", Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }

    if (objIndex != MACOSX_RSRCLENGTH_ATTRIBUTE) {
	OSType t;
	int h;

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
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







-
-
-
+
+
+





-
+












-
-
-
+
+
+
-











-
+


-
-
-
+
+
+

-

-








-
-
-
+
+
+
+






-
-
+
-







	    break;
	}

	result = setattrlist(native, &alist,
		&finfo.data, sizeof(finfo.data), 0);

	if (result != 0) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set attributes of \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not set attributes of \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	    return TCL_ERROR;
	}
    } else {
	Tcl_WideInt newRsrcForkSize;

	if (TclGetWideIntFromObj(interp, attributePtr,
	if (Tcl_GetWideIntFromObj(interp, attributePtr,
		&newRsrcForkSize) != TCL_OK) {
	    return TCL_ERROR;
	}

	if (newRsrcForkSize != *rsrcForkSize) {
	    Tcl_DString ds;

	    /*
	     * Only setting rsrclength to 0 to strip a file's resource fork is
	     * supported.
	     */

	    if (newRsrcForkSize != 0) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"setting nonzero rsrclength not supported", -1));
	    if(newRsrcForkSize != 0) {
		Tcl_AppendResult(interp,
			"setting nonzero rsrclength not supported", NULL);
		Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
		return TCL_ERROR;
	    }

	    /*
	     * Construct path to resource fork.
	     */

	    Tcl_DStringInit(&ds);
	    Tcl_DStringAppend(&ds, native, -1);
	    Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1);

	    result = truncate(Tcl_DStringValue(&ds), 0);
	    result = truncate(Tcl_DStringValue(&ds), (off_t)0);
	    if (result != 0) {
		/*
		 * truncate() on a valid resource fork path may fail with a
		 * permission error in some OS releases, try truncating with
		 * open() instead:
		 * truncate() on a valid resource fork path may fail with
		 * a permission error in some OS releases, try truncating
		 * with open() instead:
		 */

		int fd = open(Tcl_DStringValue(&ds), O_WRONLY | O_TRUNC);

		if (fd > 0) {
		    result = close(fd);
		}
	    }

	    Tcl_DStringFree(&ds);

	    if (result != 0) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not truncate resource fork of \"%s\": %s",
			TclGetString(fileName), Tcl_PosixError(interp)));
		Tcl_AppendResult(interp,
			"could not truncate resource fork of \"",
			TclGetString(fileName), "\": ",
			Tcl_PosixError(interp), NULL);
		return TCL_ERROR;
	    }
	}
    }
    return TCL_OK;
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(
	    "Mac OS X file attributes not supported", -1));
    Tcl_AppendResult(interp, "Mac OS X file attributes not supported", NULL);
    Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);
    return TCL_ERROR;
#endif
}

/*
 *---------------------------------------------------------------------------
 *
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
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
524
525
526
527

528
529
530

531
532
533
534
535
536
537
538
539
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
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







-
-
-
+
+
+


+
-
+
+

-
-
-
-
-
+
+
+
+
+
+

+

+
-
-
-
-
+
+
+
+
+
-
-

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+
-
-
-

-
+
-




+


-
-


+
+
+
+
-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+

+
+
+
+
+







-
-
+
+


-
-
-
+
+
+









-
-
-
-
-
+
+
+
+
+




-
+












-
+
-
-
-
+
-
-







 *	reflect the old file.
 *
 *---------------------------------------------------------------------------
 */

int
TclMacOSXCopyFileAttributes(
    const char *src,		/* Path name of source file (native). */
    const char *dst,		/* Path name of target file (native). */
    const Tcl_StatBuf *statBufPtr)
    CONST char *src,		/* Path name of source file (native). */
    CONST char *dst,		/* Path name of target file (native). */
    CONST Tcl_StatBuf *statBufPtr)
				/* Stat info for source file */
{
#ifdef WEAK_IMPORT_COPYFILE
    if (MayUseCopyFile()) {
    if (copyfile != NULL) {
#endif
#ifdef HAVE_COPYFILE
	if (0 == copyfile(src, dst, NULL, (S_ISLNK(statBufPtr->st_mode)
		? COPYFILE_XATTR | COPYFILE_NOFOLLOW_SRC
		: COPYFILE_XATTR | COPYFILE_ACL))) {
	    return TCL_OK;
	}
    if (copyfile(src, dst, NULL, COPYFILE_XATTR |
	    (S_ISLNK(statBufPtr->st_mode) ? COPYFILE_NOFOLLOW_SRC :
		                            COPYFILE_ACL)) < 0) {
	return TCL_ERROR;
    }
    return TCL_OK;
#endif /* HAVE_COPYFILE */
#ifdef WEAK_IMPORT_COPYFILE
    } else {
#endif
#if (!defined(HAVE_COPYFILE) || defined(WEAK_IMPORT_COPYFILE)) && defined(HAVE_GETATTRLIST)
	struct attrlist alist;
	fileinfobuf finfo;
	off_t *rsrcForkSize = (off_t *) &finfo.data;
#if !defined(HAVE_COPYFILE) || defined(WEAK_IMPORT_COPYFILE)
#ifdef HAVE_GETATTRLIST
    struct attrlist alist;
    fileinfobuf finfo;
    off_t *rsrcForkSize = (off_t*)(&finfo.data);
	Tcl_DString srcBuf, dstBuf;
	int result;

	bzero(&alist, sizeof(struct attrlist));
	alist.bitmapcount = ATTR_BIT_MAP_COUNT;
	alist.commonattr = ATTR_CMN_FNDRINFO;
    bzero(&alist, sizeof(struct attrlist));
    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
    alist.commonattr = ATTR_CMN_FNDRINFO;

	if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
	    return TCL_ERROR;
	}
	if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) {
	    return TCL_ERROR;
	}
    if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
	return TCL_ERROR;
    }

    if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) {
	return TCL_ERROR;
    }

	/*
	 * If we're a directory, we're done as they never have resource forks.
	 */

	if (S_ISDIR(statBufPtr->st_mode)) {
    if (!S_ISDIR(statBufPtr->st_mode)) {
	    return TCL_OK;
	}

	/*
	 * We only copy a non-empty resource fork, so determine if that's the
	 * Only copy non-empty resource fork.
	 * case first.
	 */

	alist.commonattr = 0;
	alist.fileattr = ATTR_FILE_RSRCLENGTH;

	if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
	    return TCL_ERROR;
	} else if (*rsrcForkSize == 0) {
	    return TCL_OK;
	}

	if(*rsrcForkSize > 0) {
	    int result;
	    Tcl_DString ds_src, ds_dst;

	/*
	 * Construct paths to resource forks.
	 */
	    /*
	     * Construct paths to resource forks.
	     */

	Tcl_DStringInit(&srcBuf);
	Tcl_DStringAppend(&srcBuf, src, -1);
	Tcl_DStringAppend(&srcBuf, _PATH_RSRCFORKSPEC, -1);
	Tcl_DStringInit(&dstBuf);
	Tcl_DStringAppend(&dstBuf, dst, -1);
	Tcl_DStringAppend(&dstBuf, _PATH_RSRCFORKSPEC, -1);
	    Tcl_DStringInit(&ds_src);
	    Tcl_DStringAppend(&ds_src, src, -1);
	    Tcl_DStringAppend(&ds_src, _PATH_RSRCFORKSPEC, -1);
	    Tcl_DStringInit(&ds_dst);
	    Tcl_DStringAppend(&ds_dst, dst, -1);
	    Tcl_DStringAppend(&ds_dst, _PATH_RSRCFORKSPEC, -1);

	/*
	 * Do the copy.
	 */

	result = TclUnixCopyFile(Tcl_DStringValue(&srcBuf),
		Tcl_DStringValue(&dstBuf), statBufPtr, 1);
	Tcl_DStringFree(&srcBuf);
	Tcl_DStringFree(&dstBuf);
	if (result == 0) {
	    return TCL_OK;
	}
	    result = TclUnixCopyFile(Tcl_DStringValue(&ds_src),
		    Tcl_DStringValue(&ds_dst), statBufPtr, 1);

	    Tcl_DStringFree(&ds_src);
	    Tcl_DStringFree(&ds_dst);

	    if (result != 0) {
		return TCL_ERROR;
	    }
#endif /* (!HAVE_COPYFILE || WEAK_IMPORT_COPYFILE) && HAVE_GETATTRLIST */
    }
	}
    }
    return TCL_OK;
#else
    return TCL_ERROR;
#endif /* HAVE_GETATTRLIST */
#endif /* !defined(HAVE_COPYFILE) || defined(WEAK_IMPORT_COPYFILE) */
#ifdef WEAK_IMPORT_COPYFILE
    }
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclMacOSXMatchType --
 *
 *	This routine is used by the globbing code to check if a file matches a
 *	given mac type and/or creator code.
 *	This routine is used by the globbing code to check if a file
 *	matches a given mac type and/or creator code.
 *
 * Results:
 *	The return value is 1, 0 or -1 indicating whether the file matches the
 *	given criteria, does not match them, or an error occurred (in wich
 *	case an error is left in interp).
 *	The return value is 1, 0 or -1 indicating whether the file
 *	matches the given criteria, does not match them, or an error
 *	occurred (in wich case an error is left in interp).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclMacOSXMatchType(
    Tcl_Interp *interp,		/* Interpreter to receive errors. */
    const char *pathName,	/* Native path to check. */
    const char *fileName,	/* Native filename to check. */
    Tcl_StatBuf *statBufPtr,	/* Stat info for file to check */
    Tcl_GlobTypeData *types)	/* Type description to match against. */
    Tcl_Interp *interp,       /* Interpreter to receive errors. */
    CONST char *pathName,     /* Native path to check. */
    CONST char *fileName,     /* Native filename to check. */
    Tcl_StatBuf *statBufPtr,  /* Stat info for file to check */
    Tcl_GlobTypeData *types)  /* Type description to match against. */
{
#ifdef HAVE_GETATTRLIST
    struct attrlist alist;
    fileinfobuf finfo;
    finderinfo *finder = (finderinfo *) &finfo.data;
    finderinfo *finder = (finderinfo*)(&finfo.data);
    OSType osType;

    bzero(&alist, sizeof(struct attrlist));
    alist.bitmapcount = ATTR_BIT_MAP_COUNT;
    alist.commonattr = ATTR_CMN_FNDRINFO;
    if (getattrlist(pathName, &alist, &finfo, sizeof(fileinfobuf), 0) != 0) {
	return 0;
    }
    if ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
	    !((finder->fdFlags & kFinfoIsInvisible) || (*fileName == '.'))) {
	return 0;
    }
    if (S_ISDIR(statBufPtr->st_mode)
    if (S_ISDIR(statBufPtr->st_mode) && (types->macType || types->macCreator)) {
	    && (types->macType || types->macCreator)) {
	/*
	 * Directories don't support types or creators.
	/* Directories don't support types or creators */
	 */

	return 0;
    }
    if (types->macType) {
	if (GetOSTypeFromObj(interp, types->macType, &osType) != TCL_OK) {
	    return -1;
	}
	if (osType != OSSwapBigToHostInt32(finder->type)) {
573
574
575
576
577
578
579
580
581
582
583




584
585
586
587
588
589
590
553
554
555
556
557
558
559




560
561
562
563
564
565
566
567
568
569
570







-
-
-
-
+
+
+
+







GetOSTypeFromObj(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *objPtr,		/* The object from which to get an OSType. */
    OSType *osTypePtr)		/* Place to store resulting OSType. */
{
    int result = TCL_OK;

    if (!TclHasIntRep(objPtr, &tclOSTypeType)) {
	result = SetOSTypeFromAny(interp, objPtr);
    }
    *osTypePtr = (OSType) objPtr->internalRep.wideValue;
    if (objPtr->typePtr != &tclOSTypeType) {
	result = tclOSTypeType.setFromAnyProc(interp, objPtr);
    };
    *osTypePtr = (OSType) objPtr->internalRep.longValue;
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * NewOSTypeObj --
598
599
600
601
602
603
604
605

606
607
608
609
610
611
612

613
614
615
616
617
618
619
578
579
580
581
582
583
584

585

586
587
588
589
590

591
592
593
594
595
596
597
598







-
+
-





-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Obj *
NewOSTypeObj(
    const OSType osType)	/* OSType used to initialize the new
    const OSType osType)    /* OSType used to initialize the new object. */
				 * object. */
{
    Tcl_Obj *objPtr;

    TclNewObj(objPtr);
    TclInvalidateStringRep(objPtr);
    objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
    objPtr->internalRep.longValue = (long) osType;
    objPtr->typePtr = &tclOSTypeType;
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
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
610
611
612
613
614
615
616


617
618
619
620

621

622
623
624
625
626



627
628
629
630
631
632







633
634
635
636
637
638
639
640

641
642
643
644
645
646
647
648







-
-
+
+


-

-
+




-
-
-
+
+




-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+







 */

static int
SetOSTypeFromAny(
    Tcl_Interp *interp,		/* Tcl interpreter */
    Tcl_Obj *objPtr)		/* Pointer to the object to convert */
{
    const char *string;
    int result = TCL_OK;
    char *string;
    int length, result = TCL_OK;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
    size_t length;

    string = TclGetStringFromObj(objPtr, &length);
    string = Tcl_GetStringFromObj(objPtr, &length);
    Tcl_UtfToExternalDString(encoding, string, length, &ds);

    if (Tcl_DStringLength(&ds) > 4) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "expected Macintosh OS type but got \"%s\": ", string));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "MAC_OSTYPE", NULL);
	    Tcl_AppendResult(interp, "expected Macintosh OS type but got \"",
		    string, "\": ", NULL);
	}
	result = TCL_ERROR;
    } else {
	OSType osType;
	char bytes[4] = {'\0','\0','\0','\0'};

	memcpy(bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	osType = (OSType) bytes[0] << 24 |
		 (OSType) bytes[1] << 16 |
		 (OSType) bytes[2] <<  8 |
		 (OSType) bytes[3];
	char string[4] = {'\0','\0','\0','\0'};
	memcpy(string, Tcl_DStringValue(&ds),
		(size_t) Tcl_DStringLength(&ds));
	osType = (OSType) string[0] << 24 |
		 (OSType) string[1] << 16 |
		 (OSType) string[2] <<  8 |
		 (OSType) string[3];
	TclFreeIntRep(objPtr);
	objPtr->internalRep.wideValue = (Tcl_WideInt) osType;
	objPtr->internalRep.longValue = (long) osType;
	objPtr->typePtr = &tclOSTypeType;
    }
    Tcl_DStringFree(&ds);
    Tcl_FreeEncoding(encoding);
    return result;
}

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
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







-
+
-

-
-
-
-
-
+
+
+
+
-

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-

-
-









 *	OSType-to-string conversion.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfOSType(
    Tcl_Obj *objPtr)	/* OSType object whose string rep to
    register Tcl_Obj *objPtr)	/* OSType object whose string rep to update. */
				 * update. */
{
    const size_t size = TCL_UTF_MAX * 4;
    char *dst = Tcl_InitStringRep(objPtr, NULL, size);
    OSType osType = (OSType) objPtr->internalRep.wideValue;
    int written = 0;
    Tcl_Encoding encoding;
    char string[5];
    OSType osType = (OSType) objPtr->internalRep.longValue;
    Tcl_DString ds;
    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
    char src[5];

    TclOOM(dst, size);

    src[0] = (char) (osType >> 24);
    src[1] = (char) (osType >> 16);
    src[2] = (char) (osType >>  8);
    src[3] = (char) (osType);
    src[4] = '\0';

    encoding = Tcl_GetEncoding(NULL, "macRoman");
    Tcl_ExternalToUtf(NULL, encoding, src, -1, /* flags */ 0,
    string[0] = (char) (osType >> 24);
    string[1] = (char) (osType >> 16);
    string[2] = (char) (osType >>  8);
    string[3] = (char) (osType);
    string[4] = '\0';
    Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
    objPtr->bytes = ckalloc((unsigned) Tcl_DStringLength(&ds) + 1);
    strcpy(objPtr->bytes, Tcl_DStringValue(&ds));
    objPtr->length = Tcl_DStringLength(&ds);
    Tcl_DStringFree(&ds);
	    /* statePtr */ NULL, dst, size, /* srcReadPtr */ NULL,
	    /* dstWrotePtr */ &written, /* dstCharsPtr */ NULL);
    Tcl_FreeEncoding(encoding);

    (void)Tcl_InitStringRep(objPtr, NULL, written);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to macosx/tclMacOSXNotify.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
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
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







-
-
-
-
-
-
-
-
-
-
-
-







-
+
+











-
-
-











-




-
+
-



-
-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
+
-





-
-
+
-







-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-

-
+







-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+

-

-


-
+


-
-
-
-


-


-
+


-
-
-
-
-
-
-
-






-

-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+





-
+
-
-
+
-
-
+
-
-
-
-
+
+
+





-
+





-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+






-







 * Copyright (c) 2005-2009 Daniel A. Steffen <das@users.sourceforge.net>
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * In macOS 10.12 the os_unfair_lock was introduced as a replacement for the
 * OSSpinLock, and the OSSpinLock was deprecated.
 */

#if MAC_OS_X_VERSION_MIN_REQUIRED >= 101200
#define USE_OS_UNFAIR_LOCK
#include <os/lock.h>
#undef TCL_MAC_DEBUG_NOTIFIER
#endif

#ifdef HAVE_COREFOUNDATION	/* Traditional unix select-based notifier is
				 * in tclUnixNotfy.c */
#include <CoreFoundation/CoreFoundation.h>
#include <pthread.h>

/* #define TCL_MAC_DEBUG_NOTIFIER 1 */

#if  !defined(USE_OS_UNFAIR_LOCK)
extern TclStubs tclStubs;
extern Tcl_NotifierProcs tclOriginalNotifier;

/*
 * We use the Darwin-native spinlock API rather than pthread mutexes for
 * notifier locking: this radically simplifies the implementation and lowers
 * overhead. Note that these are not pure spinlocks, they employ various
 * strategies to back off and relinquish the processor, making them immune to
 * most priority-inversion livelocks (c.f. 'man 3 OSSpinLockLock' and Darwin
 * sources: xnu/osfmk/{ppc,i386}/commpage/spinlocks.s).
 */

#if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK)
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#pragma GCC diagnostic ignored "-Wunused-function"
/*
 * Use OSSpinLock API where available (Tiger or later).
 */

#include <libkern/OSAtomic.h>

#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/*
 * Support for weakly importing spinlock API.
 */
#define WEAK_IMPORT_SPINLOCKLOCK

#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050
#define VOLATILE volatile
#else
#define VOLATILE
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 */
#endif

#ifndef bool
#define bool int
#endif

extern void		OSSpinLockLock(VOLATILE OSSpinLock *lock)
extern void OSSpinLockLock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE;
			    WEAK_IMPORT_ATTRIBUTE;
extern void		OSSpinLockUnlock(VOLATILE OSSpinLock *lock)
extern void OSSpinLockUnlock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE;
			    WEAK_IMPORT_ATTRIBUTE;
extern bool		OSSpinLockTry(VOLATILE OSSpinLock *lock)
extern bool OSSpinLockTry(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE;
			    WEAK_IMPORT_ATTRIBUTE;
extern void		_spin_lock(VOLATILE OSSpinLock *lock)
extern void _spin_lock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE;
			    WEAK_IMPORT_ATTRIBUTE;
extern void		_spin_unlock(VOLATILE OSSpinLock *lock)
extern void _spin_unlock(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE;
			    WEAK_IMPORT_ATTRIBUTE;
extern bool		_spin_lock_try(VOLATILE OSSpinLock *lock)
extern bool _spin_lock_try(VOLATILE OSSpinLock *lock) WEAK_IMPORT_ATTRIBUTE;
			    WEAK_IMPORT_ATTRIBUTE;
static void (* lockLock)(VOLATILE OSSpinLock *lock) = NULL;
static void (* lockUnlock)(VOLATILE OSSpinLock *lock) = NULL;
static bool (* lockTry)(VOLATILE OSSpinLock *lock) = NULL;
#undef VOLATILE
static pthread_once_t spinLockLockInitControl = PTHREAD_ONCE_INIT;
static void
SpinLockLockInit(void)
static void SpinLockLockInit(void) {
{
    lockLock   = OSSpinLockLock   != NULL ? OSSpinLockLock   : _spin_lock;
    lockUnlock = OSSpinLockUnlock != NULL ? OSSpinLockUnlock : _spin_unlock;
    lockTry    = OSSpinLockTry    != NULL ? OSSpinLockTry    : _spin_lock_try;
    if (lockLock == NULL || lockUnlock == NULL) {
	Tcl_Panic("SpinLockLockInit: no spinlock API available");
    }
}

/*
 * Wrappers so that we get warnings in just one small part of this file.
 */

static inline void
SpinLockLock(
#define SpinLockLock(p) 	lockLock(p)
    VOLATILE OSSpinLock *lock)
{
    lockLock(lock);
}
static inline void
SpinLockUnlock(
#define SpinLockUnlock(p)	lockUnlock(p)
    VOLATILE OSSpinLock *lock)
{
    lockUnlock(lock);
}
static inline bool
SpinLockTry(
#define SpinLockTry(p)  	lockTry(p)
    VOLATILE OSSpinLock *lock)
{
    return lockTry(lock);
}

#else
#else /* !HAVE_WEAK_IMPORT */

/*
 * Wrappers so that we get warnings in just one small part of this file.
 */

static inline void
SpinLockLock(
#define SpinLockLock(p) 	OSSpinLockLock(p)
    OSSpinLock *lock)
{
    OSSpinLockLock(lock);
}
static inline void
SpinLockUnlock(
#define SpinLockUnlock(p)	OSSpinLockUnlock(p)
    OSSpinLock *lock)
{
    OSSpinLockUnlock(lock);
}
static inline bool
SpinLockTry(
#define SpinLockTry(p)  	OSSpinLockTry(p)
    OSSpinLock *lock)
{
    return OSSpinLockTry(lock);
}
#endif /* HAVE_WEAK_IMPORT */
#define SPINLOCK_INIT		OS_SPINLOCK_INIT
#define SPINLOCK_INIT   	OS_SPINLOCK_INIT

#else
/*
 * Otherwise, use commpage spinlock SPI directly.
 */

typedef uint32_t OSSpinLock;

static inline void
SpinLockLock(
    OSSpinLock *lock)
{
    extern void _spin_lock(OSSpinLock *lock);
extern void _spin_lock(OSSpinLock *lock);

    _spin_lock(lock);
}

static inline void
SpinLockUnlock(
    OSSpinLock *lock)
{
    extern void _spin_unlock(OSSpinLock *lock);
extern void _spin_unlock(OSSpinLock *lock);

    _spin_unlock(lock);
}

static inline int
SpinLockTry(
    OSSpinLock *lock)
{
    extern int _spin_lock_try(OSSpinLock *lock);

    return _spin_lock_try(lock);
extern int  _spin_lock_try(OSSpinLock *lock);
#define SpinLockLock(p) 	_spin_lock(p)
#define SpinLockUnlock(p)	_spin_unlock(p)
}

#define SPINLOCK_INIT		0
#define SpinLockTry(p)  	_spin_lock_try(p)
#define SPINLOCK_INIT   	0

#pragma GCC diagnostic pop
#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
#endif /* not using os_unfair_lock */

/*
 * These locks control access to the global notifier state.
 * These spinlocks lock access to the global notifier state.
 */

#if defined(USE_OS_UNFAIR_LOCK)
static os_unfair_lock notifierInitLock = OS_UNFAIR_LOCK_INIT;
static os_unfair_lock notifierLock     = OS_UNFAIR_LOCK_INIT;
#else
static OSSpinLock notifierInitLock = SPINLOCK_INIT;
static OSSpinLock notifierLock     = SPINLOCK_INIT;
#endif

/*
 * Macros that abstract notifier locking/unlocking
 * Macros abstracting notifier locking/unlocking
 */

#if defined(USE_OS_UNFAIR_LOCK)
#define LOCK_NOTIFIER_INIT	os_unfair_lock_lock(&notifierInitLock)
#define UNLOCK_NOTIFIER_INIT	os_unfair_lock_unlock(&notifierInitLock)
#define LOCK_NOTIFIER		os_unfair_lock_lock(&notifierLock)
#define UNLOCK_NOTIFIER		os_unfair_lock_unlock(&notifierLock)
#define LOCK_NOTIFIER_TSD	os_unfair_lock_lock(&tsdPtr->tsdLock)
#define UNLOCK_NOTIFIER_TSD	os_unfair_lock_unlock(&tsdPtr->tsdLock)
#else
#define LOCK_NOTIFIER_INIT	SpinLockLock(&notifierInitLock)
#define UNLOCK_NOTIFIER_INIT	SpinLockUnlock(&notifierInitLock)
#define LOCK_NOTIFIER		SpinLockLock(&notifierLock)
#define UNLOCK_NOTIFIER		SpinLockUnlock(&notifierLock)
#define LOCK_NOTIFIER_TSD	SpinLockLock(&tsdPtr->tsdLock)
#define UNLOCK_NOTIFIER_TSD	SpinLockUnlock(&tsdPtr->tsdLock)
#endif

/*
 * The debug version of the Notifier only works if using OSSpinLock.
 */

#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
#define TclMacOSXNotifierDbgMsg(m, ...) \
#ifdef TCL_MAC_DEBUG_NOTIFIER
#define TclMacOSXNotifierDbgMsg(m, ...) do { \
    do {								\
	fprintf(notifierLog?notifierLog:stderr, "tclMacOSXNotify.c:%d: " \
		"%s() pid %5d thread %10p: " m "\n", __LINE__, __func__, \
		getpid(), pthread_self(), ##__VA_ARGS__);		\
	fflush(notifierLog?notifierLog:stderr);				\
    } while (0)
	    fprintf(notifierLog?notifierLog:stderr, "tclMacOSXNotify.c:%d: " \
	    "%s() pid %5d thread %10p: " m "\n", __LINE__, __func__, \
	    getpid(), pthread_self(), ##__VA_ARGS__); \
	    fflush(notifierLog?notifierLog:stderr); \
	} while (0)

/*
 * Debug version of SpinLockLock that logs the time spent waiting for the lock
 */

#define SpinLockLockDbg(p) \
#define SpinLockLockDbg(p)	if (!SpinLockTry(p)) { \
    if (!SpinLockTry(p)) {						\
	Tcl_WideInt s = TclpGetWideClicks(), e;				\
				    Tcl_WideInt s = TclpGetWideClicks(), e; \
									\
	SpinLockLock(p);						\
				    SpinLockLock(p); e = TclpGetWideClicks(); \
	e = TclpGetWideClicks();					\
	TclMacOSXNotifierDbgMsg("waited on %s for %8.0f ns",		\
		#p, TclpWideClicksToNanoseconds(e-s));			\
    }
				    TclMacOSXNotifierDbgMsg("waited on %s for %8.0f ns", \
				    #p, TclpWideClicksToNanoseconds(e-s)); \
				}
#undef LOCK_NOTIFIER_INIT
#define LOCK_NOTIFIER_INIT	SpinLockLockDbg(&notifierInitLock)
#undef LOCK_NOTIFIER
#define LOCK_NOTIFIER		SpinLockLockDbg(&notifierLock)
#undef LOCK_NOTIFIER_TSD
#define LOCK_NOTIFIER_TSD	SpinLockLockDbg(tsdPtr->tsdLock)
#define LOCK_NOTIFIER_TSD	SpinLockLockDbg(&tsdPtr->tsdLock)
#include <asl.h>
static FILE *notifierLog = NULL;
#ifndef NOTIFIER_LOG
#define NOTIFIER_LOG "/tmp/tclMacOSXNotify.log"
#endif
#define OPEN_NOTIFIER_LOG \
#define OPEN_NOTIFIER_LOG	if (!notifierLog) { \
    if (!notifierLog) {							\
	notifierLog = fopen(NOTIFIER_LOG, "a");				\
	/*TclMacOSXNotifierDbgMsg("open log");				\
	 *asl_set_filter(NULL,						\
	 *	ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG));			\
	 *asl_add_log_file(NULL, fileno(notifierLog));*/		\
    }
#define CLOSE_NOTIFIER_LOG \
				    notifierLog = fopen(NOTIFIER_LOG, "a"); \
				    /*TclMacOSXNotifierDbgMsg("open log"); \
				    asl_set_filter(NULL, \
				    ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG)); \
				    asl_add_log_file(NULL, \
					    fileno(notifierLog));*/ \
				}
#define CLOSE_NOTIFIER_LOG	if (notifierLog) { \
    if (notifierLog) {							\
	/*asl_remove_log_file(NULL, fileno(notifierLog));		\
	 *TclMacOSXNotifierDbgMsg("close log");*/			\
	fclose(notifierLog);						\
	notifierLog = NULL;						\
    }
#define ENABLE_ASL \
				    /*asl_remove_log_file(NULL, \
					    fileno(notifierLog)); \
				    TclMacOSXNotifierDbgMsg("close log");*/ \
				    fclose(notifierLog); \
				    notifierLog = NULL; \
				}
#define ENABLE_ASL		if (notifierLog) { \
    if (notifierLog) {							\
	/*tsdPtr->asl = asl_open(NULL, "com.apple.console",		\
				    /*tsdPtr->asl = asl_open(NULL, "com.apple.console", ASL_OPT_NO_REMOTE); \
	 *	ASL_OPT_NO_REMOTE);					\
	 *asl_set_filter(tsdPtr->asl,					\
	 *	ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG));			\
	 *asl_add_log_file(tsdPtr->asl, fileno(notifierLog));*/		\
    }
#define DISABLE_ASL \
				    asl_set_filter(tsdPtr->asl, \
				    ASL_FILTER_MASK_UPTO(ASL_LEVEL_DEBUG)); \
				    asl_add_log_file(tsdPtr->asl, \
					    fileno(notifierLog));*/ \
				}
#define DISABLE_ASL		/*if (tsdPtr->asl) { \
    /*if (tsdPtr->asl) {						\
     *	if (notifierLog) {						\
     *	    asl_remove_log_file(tsdPtr->asl, fileno(notifierLog));	\
     *	}								\
     *	asl_close(tsdPtr->asl);						\
     *}*/
#define ASLCLIENT_DECL		/*aslclient asl*/
				    if (notifierLog) { \
					asl_remove_log_file(tsdPtr->asl, \
						fileno(notifierLog)); \
				    } \
				    asl_close(tsdPtr->asl); \
				}*/
#define ASLCLIENT		/*aslclient asl*/
#else
#define TclMacOSXNotifierDbgMsg(m, ...)
#define OPEN_NOTIFIER_LOG
#define CLOSE_NOTIFIER_LOG
#define ENABLE_ASL
#define DISABLE_ASL
#define ASLCLIENT_DECL
#endif /* TCL_MAC_DEBUG_NOTIFIER */

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

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
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







-
+














-
+















-
+
+



-
+
-
-
-
+
+
+


-
+
-




-
+
+

-
-
-
-

-
+
-
-
-
+











-
+
-

-
+
-











-


+
-
+
+







} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */

typedef struct {
typedef struct FileHandlerEvent {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    int fd;			/* File descriptor that is ready. Used to find
				 * the FileHandler structure for the file
				 * (can't point directly to the FileHandler
				 * structure because it could go away while
				 * the event is queued). */
} FileHandlerEvent;

/*
 * The following structure contains a set of select() masks to track readable,
 * writable, and exceptional conditions.
 */

typedef struct {
typedef struct SelectMasks {
    fd_set readable;
    fd_set writable;
    fd_set exceptional;
} SelectMasks;

/*
 * The following static structure contains the state information for the
 * select based implementation of the Tcl notifier. One of these structures is
 * created for each thread that is using the notifier.
 */

typedef struct ThreadSpecificData {
    FileHandler *firstFileHandlerPtr;
				/* Pointer to head of file handler list. */
    int polled;			/* True if the notifier thread has polled for
				 * this thread. */
				 * this thread.
				 */
    int sleeping;		/* True if runloop is inside Tcl_Sleep. */
    int runLoopSourcePerformed;	/* True after the runLoopSource callack was
				 * performed. */
    int runLoopRunning;		/* True if this thread's Tcl runLoop is
    int runLoopRunning;		/* True if this thread's Tcl runLoop is running */
				 * running. */
    int runLoopNestingLevel;	/* Level of nested runLoop invocations. */

    int runLoopNestingLevel;	/* Level of nested runLoop invocations */
    int runLoopServicingEvents;	/* True if this thread's runLoop is servicing
				 * tcl events */
    /* Must hold the notifierLock before accessing the following fields: */
    /* Start notifierLock section */
    int onList;			/* True if this thread is on the
    int onList;			/* True if this thread is on the waitingList */
				 * waitingList */
    struct ThreadSpecificData *nextPtr, *prevPtr;
				/* All threads that are currently waiting on
				 * an event have their ThreadSpecificData
				 * structure on a doubly-linked listed formed
				 * from these pointers. */
				 * from these pointers.
				 */
    /* End notifierLock section */

#if defined(USE_OS_UNFAIR_LOCK)
    os_unfair_lock tsdLock;
#else
    OSSpinLock tsdLock;		/* Must hold this lock before acessing the
				 * following fields from more than one
				 * following fields from more than one thread.
				 * thread. */
#endif

				 */
    /* Start tsdLock section */
    SelectMasks checkMasks;	/* This structure is used to build up the
				 * masks to be used in the next call to
				 * select. Bits are set in response to calls
				 * to Tcl_CreateFileHandler. */
    SelectMasks readyMasks;	/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
    int numFdBits;		/* Number of valid bits in checkMasks (one
				 * more than highest fd for which
				 * Tcl_WatchFile has been called). */
    int polling;		/* True if this thread is polling for
    int polling;		/* True if this thread is polling for events */
				 * events. */
    CFRunLoopRef runLoop;	/* This thread's CFRunLoop, needs to be woken
				 * up whenever the runLoopSource is
				 * up whenever the runLoopSource is signaled */
				 * signaled. */
    CFRunLoopSourceRef runLoopSource;
				/* Any other thread alerts a notifier that an
				 * event is ready to be processed by signaling
				 * this CFRunLoopSource. */
    CFRunLoopObserverRef runLoopObserver, runLoopObserverTcl;
				/* Adds/removes this thread from waitingList
				 * when the CFRunLoop starts/stops. */
    CFRunLoopTimerRef runLoopTimer;
				/* Wakes up CFRunLoop after given timeout when
				 * running embedded. */
    /* End tsdLock section */

    CFTimeInterval waitTime;	/* runLoopTimer wait time when running
				 * embedded. */
#ifdef TCL_MAC_DEBUG_NOTIFIER
    ASLCLIENT_DECL;
    ASLCLIENT;
#endif
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following static indicates the number of threads that have initialized
 * notifiers.
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
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







-
-
+
+








-
+







 *
 * You must hold the notifierInitLock before accessing this variable.
 */

static int notifierThreadRunning;

/*
 * This is the thread ID of the notifier thread that does select. Only valid
 * when notifierThreadRunning is non-zero.
 * This is the thread ID of the notifier thread that does select.
 * Only valid when notifierThreadRunning is non-zero.
 *
 * You must hold the notifierInitLock before accessing this variable.
 */

static pthread_t notifierThread;

/*
 * Custom runloop mode for running with only the runloop source for the
 * notifier thread.
 * notifier thread
 */

#ifndef TCL_EVENTS_ONLY_RUN_LOOP_MODE
#define TCL_EVENTS_ONLY_RUN_LOOP_MODE	"com.tcltk.tclEventsOnlyRunLoopMode"
#endif
#ifdef __CONSTANT_CFSTRINGS__
#define tclEventsOnlyRunLoopMode	CFSTR(TCL_EVENTS_ONLY_RUN_LOOP_MODE)
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
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







-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
+
+
+


-
-
-
-
+
+
+
+



-
+
-
-
+
-
-
-

-




-



-
+

-
+








#define CF_TIMEINTERVAL_FOREVER 5.05e8

/*
 * Static routines defined in this file.
 */

static void		StartNotifierThread(void);
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static void		TimerWakeUp(CFRunLoopTimerRef timer, void *info);
static void		QueueFileEvents(void *info);
static void		UpdateWaitingListAndServiceEvents(
static void	StartNotifierThread(void);
static void	NotifierThreadProc(ClientData clientData)
			__attribute__ ((__noreturn__));
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static void	TimerWakeUp(CFRunLoopTimerRef timer, void *info);
static void	QueueFileEvents(void *info);
static void	UpdateWaitingListAndServiceEvents(CFRunLoopObserverRef observer,
			    CFRunLoopObserverRef observer,
			    CFRunLoopActivity activity, void *info);
static int		OnOffWaitingList(ThreadSpecificData *tsdPtr,
			    int onList, int signalNotifier);
			CFRunLoopActivity activity, void *info);
static int	OnOffWaitingList(ThreadSpecificData *tsdPtr, int onList,
			int signalNotifier);

#ifdef HAVE_PTHREAD_ATFORK
static int atForkInit = 0;
static void		AtForkPrepare(void);
static void		AtForkParent(void);
static void		AtForkChild(void);
static int	atForkInit = 0;
static void	AtForkPrepare(void);
static void	AtForkParent(void);
static void	AtForkChild(void);
#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/* Support for weakly importing pthread_atfork. */
#define WEAK_IMPORT_PTHREAD_ATFORK
extern int		pthread_atfork(void (*prepare)(void),
extern int	pthread_atfork(void (*prepare)(void), void (*parent)(void),
			    void (*parent)(void), void (*child)(void))
			    WEAK_IMPORT_ATTRIBUTE;
		    void (*child)(void)) WEAK_IMPORT_ATTRIBUTE;
#define MayUsePthreadAtfork()	(pthread_atfork != NULL)
#else
#define MayUsePthreadAtfork()	(1)
#endif /* HAVE_WEAK_IMPORT */

/*
 * On Darwin 9 and later, it is not possible to call CoreFoundation after
 * a fork.
 */

#if !defined(MAC_OS_X_VERSION_MIN_REQUIRED) || \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1050
MODULE_SCOPE long tclMacOSXDarwinRelease;
#define noCFafterFork	(tclMacOSXDarwinRelease >= 9)
#define noCFafterFork (tclMacOSXDarwinRelease >= 9)
#else /* MAC_OS_X_VERSION_MIN_REQUIRED */
#define noCFafterFork	1
#define noCFafterFork 1
#endif /* MAC_OS_X_VERSION_MIN_REQUIRED */
#endif /* HAVE_PTHREAD_ATFORK */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564

565
566
567
568
569
570
571
422
423
424
425
426
427
428




429
430
431
432
433
434
435
436
437
438
439
440
441
442







-
-
-
-






+







 */

ClientData
Tcl_InitNotifier(void)
{
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);

#ifdef WEAK_IMPORT_SPINLOCKLOCK
    /*
     * Initialize support for weakly imported spinlock API.
     */

    if (pthread_once(&spinLockLockInitControl, SpinLockLockInit)) {
	Tcl_Panic("Tcl_InitNotifier: pthread_once failed");
    }
#endif

#ifndef __CONSTANT_CFSTRINGS__
    if (!tclEventsOnlyRunLoopMode) {
594
595
596
597
598
599
600
601

602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619

620
621
622
623
624
625
626
627
628
629
630
631
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
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
524
525
526
527

528
529
530
531
532
533
534
535







-
+

















-
+















-
-
-

-









+
+
+
+
-
+







-
+







	}
	CFRunLoopAddSource(runLoop, runLoopSource, kCFRunLoopCommonModes);
	CFRunLoopAddSource(runLoop, runLoopSource, tclEventsOnlyRunLoopMode);

	bzero(&runLoopObserverContext, sizeof(CFRunLoopObserverContext));
	runLoopObserverContext.info = tsdPtr;
	runLoopObserver = CFRunLoopObserverCreate(NULL,
		kCFRunLoopEntry|kCFRunLoopExit, TRUE,
		kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
		LONG_MIN, UpdateWaitingListAndServiceEvents,
		&runLoopObserverContext);
	if (!runLoopObserver) {
	    Tcl_Panic("Tcl_InitNotifier: could not create "
		    "CFRunLoopObserver");
	}
	CFRunLoopAddObserver(runLoop, runLoopObserver, kCFRunLoopCommonModes);

	/*
	 * Create a second CFRunLoopObserver with the same callback as above
	 * for the tclEventsOnlyRunLoopMode to ensure that the callback can be
	 * re-entered via Tcl_ServiceAll() in the kCFRunLoopBeforeWaiting case
	 * (CFRunLoop prevents observer callback re-entry of a given observer
	 * instance).
	 */

	runLoopObserverTcl = CFRunLoopObserverCreate(NULL,
		kCFRunLoopEntry|kCFRunLoopExit, TRUE,
		kCFRunLoopEntry|kCFRunLoopExit|kCFRunLoopBeforeWaiting, TRUE,
		LONG_MIN, UpdateWaitingListAndServiceEvents,
		&runLoopObserverContext);
	if (!runLoopObserverTcl) {
	    Tcl_Panic("Tcl_InitNotifier: could not create "
		    "CFRunLoopObserver");
	}
	CFRunLoopAddObserver(runLoop, runLoopObserverTcl,
		tclEventsOnlyRunLoopMode);

	tsdPtr->runLoop = runLoop;
	tsdPtr->runLoopSource = runLoopSource;
	tsdPtr->runLoopObserver = runLoopObserver;
	tsdPtr->runLoopObserverTcl = runLoopObserverTcl;
	tsdPtr->runLoopTimer = NULL;
	tsdPtr->waitTime = CF_TIMEINTERVAL_FOREVER;
#if defined(USE_OS_UNFAIR_LOCK)
	tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
#else
	tsdPtr->tsdLock = SPINLOCK_INIT;
#endif
    }

    LOCK_NOTIFIER_INIT;
#ifdef HAVE_PTHREAD_ATFORK
    /*
     * Install pthread_atfork handlers to reinitialize the notifier in the
     * child of a fork.
     */

    if (
#ifdef WEAK_IMPORT_PTHREAD_ATFORK
	    pthread_atfork != NULL &&
#endif
    if (MayUsePthreadAtfork() && !atForkInit) {
	    !atForkInit) {
	int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);

	if (result) {
	    Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	}
	atForkInit = 1;
    }
#endif /* HAVE_PTHREAD_ATFORK */
#endif
    if (notifierCount == 0) {
	int fds[2], status;

	/*
	 * Initialize trigger pipe.
	 */

690
691
692
693
694
695
696

697

698
699
700
701
702
703
704
561
562
563
564
565
566
567
568

569
570
571
572
573
574
575
576







+
-
+








	notifierThreadRunning = 0;
	OPEN_NOTIFIER_LOG;
    }
    ENABLE_ASL;
    notifierCount++;
    UNLOCK_NOTIFIER_INIT;

    return tsdPtr;
    return (ClientData) tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclMacOSXNotifierAddRunLoopMode --
 *
712
713
714
715
716
717
718
719

720
721
722
723
724
725
726
584
585
586
587
588
589
590

591
592
593
594
595
596
597
598







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclMacOSXNotifierAddRunLoopMode(
    const void *runLoopMode)
    CONST void *runLoopMode)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    CFStringRef mode = (CFStringRef) runLoopMode;

    if (tsdPtr->runLoop) {
	CFRunLoopAddSource(tsdPtr->runLoop, tsdPtr->runLoopSource, mode);
	CFRunLoopAddObserver(tsdPtr->runLoop, tsdPtr->runLoopObserver, mode);
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
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







-
+



-
-
-
-
-


















-
-
-
-
+
+
+
+







 *	notifier instance.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)
    ClientData clientData)		/* Not used. */
{
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);

    LOCK_NOTIFIER_INIT;
    notifierCount--;
    DISABLE_ASL;

    /*
     * If this is the last thread to use the notifier, close the notifier pipe
     * and wait for the background thread to terminate.
     */

    if (notifierCount == 0) {
	if (triggerPipe != -1) {
	    /*
	     * Send "q" message to the notifier thread so that it will
	     * terminate. The notifier will return from its call to select()
	     * and notice that a "q" message has arrived, it will then close
	     * its side of the pipe and terminate its thread. Note the we can
	     * not just close the pipe and check for EOF in the notifier
	     * thread because if a background child process was created with
	     * exec, select() would not register the EOF on the pipe until the
	     * child processes had terminated. [Bug: 4139] [Bug 1222872]
	     * not just close the pipe and check for EOF in the notifier thread
	     * because if a background child process was created with exec,
	     * select() would not register the EOF on the pipe until the child
	     * processes had terminated. [Bug: 4139] [Bug: 1222872]
	     */

	    write(triggerPipe, "q", 1);
	    close(triggerPipe);

	    if (notifierThreadRunning) {
		int result = pthread_join(notifierThread, NULL);
892
893
894
895
896
897
898
899

900
901
902
903
904
905
906
907
908
909
910
911
759
760
761
762
763
764
765

766





767
768
769
770
771
772
773







-
+
-
-
-
-
-







 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(
    ClientData clientData)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;
    ThreadSpecificData *tsdPtr = clientData;

    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    }

    LOCK_NOTIFIER_TSD;
    if (tsdPtr->runLoop) {
	CFRunLoopSourceSignal(tsdPtr->runLoopSource);
	CFRunLoopWakeUp(tsdPtr->runLoop);
    }
    UNLOCK_NOTIFIER_TSD;
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
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







-
+





-
-
+
+









-
+







 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
    Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
{
    ThreadSpecificData *tsdPtr;
    CFRunLoopTimerRef runLoopTimer;
    CFTimeInterval waitTime;

    if (tclNotifierHooks.setTimerProc) {
	tclNotifierHooks.setTimerProc(timePtr);
    if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
	tclStubs.tcl_SetTimer(timePtr);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);
    runLoopTimer = tsdPtr->runLoopTimer;
    if (!runLoopTimer) {
	return;
    }
    if (timePtr) {
	Tcl_Time vTime = *timePtr;
	Tcl_Time vTime  = *timePtr;

	if (vTime.sec != 0 || vTime.usec != 0) {
	    tclScaleTimeProcPtr(&vTime, tclTimeClientData);
	    waitTime = vTime.sec + 1.0e-6 * vTime.usec;
	} else {
	    waitTime = 0;
	}
976
977
978
979
980
981
982
983
984


985
986
987
988
989
990
991
838
839
840
841
842
843
844


845
846
847
848
849
850
851
852
853







-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
TimerWakeUp(
    TCL_UNUSED(CFRunLoopTimerRef),
    TCL_UNUSED(ClientData))
    CFRunLoopTimerRef timer,
    void *info)
{
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
866
867
868
869
870
871
872





873
874
875
876
877
878
879







-
-
-
-
-







void
Tcl_ServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);

    if (mode == TCL_SERVICE_ALL && !tsdPtr->runLoopTimer) {
	if (!tsdPtr->runLoop) {
	    Tcl_Panic("Tcl_ServiceModeHook: Notifier not initialized");
	}
	tsdPtr->runLoopTimer = CFRunLoopTimerCreate(NULL,
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
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







+
-
-
+
+












-
+















-
+

-
+


-
+

-
+


-
+

-
+







    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr;
    FileHandler *filePtr;

    if (tclStubs.tcl_CreateFileHandler !=
    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	    tclOriginalNotifier.createFileHandlerProc) {
	tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);

    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	filePtr = (FileHandler *) ckalloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->readyMask = 0;
	filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	tsdPtr->firstFileHandlerPtr = filePtr;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;
    filePtr->mask = mask;

    /*
     * Update the check masks for this file.
     */

    LOCK_NOTIFIER_TSD;
    if (mask & TCL_READABLE) {
	FD_SET(fd, &tsdPtr->checkMasks.readable);
	FD_SET(fd, &(tsdPtr->checkMasks.readable));
    } else {
	FD_CLR(fd, &tsdPtr->checkMasks.readable);
	FD_CLR(fd, &(tsdPtr->checkMasks.readable));
    }
    if (mask & TCL_WRITABLE) {
	FD_SET(fd, &tsdPtr->checkMasks.writable);
	FD_SET(fd, &(tsdPtr->checkMasks.writable));
    } else {
	FD_CLR(fd, &tsdPtr->checkMasks.writable);
	FD_CLR(fd, &(tsdPtr->checkMasks.writable));
    }
    if (mask & TCL_EXCEPTION) {
	FD_SET(fd, &tsdPtr->checkMasks.exceptional);
	FD_SET(fd, &(tsdPtr->checkMasks.exceptional));
    } else {
	FD_CLR(fd, &tsdPtr->checkMasks.exceptional);
	FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
    }
    if (tsdPtr->numFdBits <= fd) {
	tsdPtr->numFdBits = fd+1;
    }
    UNLOCK_NOTIFIER_TSD;
}

1131
1132
1133
1134
1135
1136
1137

1138
1139


1140
1141
1142
1143
1144
1145
1146
989
990
991
992
993
994
995
996


997
998
999
1000
1001
1002
1003
1004
1005







+
-
-
+
+







    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    FileHandler *filePtr, *prevPtr;
    int i, numFdBits;
    ThreadSpecificData *tsdPtr;

    if (tclStubs.tcl_DeleteFileHandler !=
    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	    tclOriginalNotifier.deleteFileHandlerProc) {
	tclStubs.tcl_DeleteFileHandler(fd);
	return;
    }

    tsdPtr = TCL_TSD_INIT(&dataKey);
    numFdBits = -1;

    /*
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
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







-
-
-
+
+
+
















-
+


-
+


-
+












-
+







    /*
     * Find current max fd.
     */

    if (fd+1 == tsdPtr->numFdBits) {
	numFdBits = 0;
	for (i = fd-1; i >= 0; i--) {
	    if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
		    || FD_ISSET(i, &tsdPtr->checkMasks.writable)
		    || FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) {
	    if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))
		    || FD_ISSET(i, &(tsdPtr->checkMasks.writable))
		    || FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) {
		numFdBits = i+1;
		break;
	    }
	}
    }

    LOCK_NOTIFIER_TSD;
    if (numFdBits != -1) {
	tsdPtr->numFdBits = numFdBits;
    }

    /*
     * Update the check masks for this file.
     */

    if (filePtr->mask & TCL_READABLE) {
	FD_CLR(fd, &tsdPtr->checkMasks.readable);
	FD_CLR(fd, &(tsdPtr->checkMasks.readable));
    }
    if (filePtr->mask & TCL_WRITABLE) {
	FD_CLR(fd, &tsdPtr->checkMasks.writable);
	FD_CLR(fd, &(tsdPtr->checkMasks.writable));
    }
    if (filePtr->mask & TCL_EXCEPTION) {
	FD_CLR(fd, &tsdPtr->checkMasks.exceptional);
	FD_CLR(fd, &(tsdPtr->checkMasks.exceptional));
    }
    UNLOCK_NOTIFIER_TSD;

    /*
     * Clean up information in the callback record.
     */

    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    Tcl_Free(filePtr);
    ckfree((char *) filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileHandlerEventProc --
 *
1269
1270
1271
1272
1273
1274
1275
1276

1277
1278
1279

1280
1281
1282

1283
1284
1285
1286
1287
1288
1289
1128
1129
1130
1131
1132
1133
1134

1135
1136
1137

1138
1139
1140

1141
1142
1143
1144
1145
1146
1147
1148







-
+


-
+


-
+







	 */

	mask = filePtr->readyMask & filePtr->mask;
	filePtr->readyMask = 0;
	if (mask != 0) {
	    LOCK_NOTIFIER_TSD;
	    if (mask & TCL_READABLE) {
		FD_CLR(filePtr->fd, &tsdPtr->readyMasks.readable);
		FD_CLR(filePtr->fd, &(tsdPtr->readyMasks.readable));
	    }
	    if (mask & TCL_WRITABLE) {
		FD_CLR(filePtr->fd, &tsdPtr->readyMasks.writable);
		FD_CLR(filePtr->fd, &(tsdPtr->readyMasks.writable));
	    }
	    if (mask & TCL_EXCEPTION) {
		FD_CLR(filePtr->fd, &tsdPtr->readyMasks.exceptional);
		FD_CLR(filePtr->fd, &(tsdPtr->readyMasks.exceptional));
	    }
	    UNLOCK_NOTIFIER_TSD;
	    filePtr->proc(filePtr->clientData, mask);
	}
	break;
    }
    return 1;
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
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
1385
1386
1387
1388
1389



1390
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
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







-
+






-
-
+
+










-
-
-
-

-
+











-

+
-
+
-
-
-
-
-
+
-
-
-
-
-
+



-












-
-
-
-
+
+
+
+
+
-




-
-
-
+
+
+







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    int result, polling, runLoopRunning;
    CFTimeInterval waitTime;
    SInt32 runLoopStatus;
    ThreadSpecificData *tsdPtr;

    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
	return tclStubs.tcl_WaitForEvent(timePtr);
    }
    result = -1;
    polling = 0;
    waitTime = CF_TIMEINTERVAL_FOREVER;
    tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->runLoop) {
	Tcl_Panic("Tcl_WaitForEvent: Notifier not initialized");
    }

    /*
     * A NULL timePtr means wait forever.
     */

    if (timePtr) {
	Tcl_Time vTime = *timePtr;
	Tcl_Time vTime  = *timePtr;

	/*
	 * TIP #233 (Virtualized Time). Is virtual time in effect? And do we
	 * actually have something to scale? If yes to both then we call the
	 * handler to do this scaling.
	 */

	if (vTime.sec != 0 || vTime.usec != 0) {
	    tclScaleTimeProcPtr(&vTime, tclTimeClientData);
	    waitTime = vTime.sec + 1.0e-6 * vTime.usec;
	} else {

	    /*
	     * Polling: pretend to wait for files and tell the notifier thread
	     * The max block time was set to 0.
	     * what we are doing. The notifier thread makes sure it goes
	     *
	     * If we set the waitTime to 0, then the call to CFRunLoopInMode
	     * may return without processing all of its sources.  The Apple
	     * documentation says that if the waitTime is 0 "only one pass is
	     * made through the run loop before returning; if multiple sources
	     * through select with its select mask in the same state as ours
	     * or timers are ready to fire immediately, only one (possibly two
	     * if one is a version 0 source) will be fired, regardless of the
	     * value of returnAfterSourceHandled."  This can cause some chanio
	     * tests to fail.  So we use a small positive waitTime unless there
	     * is another RunLoop running.
	     * currently is. We block until that happens.
	     */

	    polling = 1;
	    waitTime = tsdPtr->runLoopRunning ? 0 : 0.0001;
	}
    }

    StartNotifierThread();

    LOCK_NOTIFIER_TSD;
    tsdPtr->polling = polling;
    UNLOCK_NOTIFIER_TSD;
    tsdPtr->runLoopSourcePerformed = 0;

    /*
     * If the Tcl runloop is already running (e.g. if Tcl_WaitForEvent was
     * called recursively) start a new runloop in a custom runloop mode
     * containing only the source for the notifier thread.  Otherwise wakeups
     * from other sources added to the common runloop mode might get lost or
     * 3rd party event handlers might get called when they do not expect to
     * called recursively) or is servicing events via the runloop observer,
     * re-run it in a custom runloop mode containing only the source for the
     * notifier thread, otherwise wakeups from other sources added to the
     * common runloop modes might get lost or 3rd party event handlers might
     * get called when they do not expect to be.
     * be.
     */

    runLoopRunning = tsdPtr->runLoopRunning;
    tsdPtr->runLoopRunning = 1;
    runLoopStatus = CFRunLoopRunInMode(
	runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
	waitTime, TRUE);
    runLoopStatus = CFRunLoopRunInMode(tsdPtr->runLoopServicingEvents ||
	    runLoopRunning ? tclEventsOnlyRunLoopMode : kCFRunLoopDefaultMode,
	    waitTime, TRUE);
    tsdPtr->runLoopRunning = runLoopRunning;

    LOCK_NOTIFIER_TSD;
    tsdPtr->polling = 0;
    UNLOCK_NOTIFIER_TSD;
    switch (runLoopStatus) {
    case kCFRunLoopRunFinished:
	Tcl_Panic("Tcl_WaitForEvent: CFRunLoop finished");
       Tcl_Panic("Tcl_WaitForEvent: CFRunLoop finished");
	break;
    case kCFRunLoopRunTimedOut:
	QueueFileEvents(tsdPtr);
	result = 0;
	break;
    case kCFRunLoopRunStopped:
    case kCFRunLoopRunHandledSource:
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
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







-
+






-
-
-
-
-
-
+
+
+
+
+
+








static void
QueueFileEvents(
    void *info)
{
    SelectMasks readyMasks;
    FileHandler *filePtr;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) info;

    /*
     * Queue all detected file events.
     */

    LOCK_NOTIFIER_TSD;
    FD_COPY(&tsdPtr->readyMasks.readable, &readyMasks.readable);
    FD_COPY(&tsdPtr->readyMasks.writable, &readyMasks.writable);
    FD_COPY(&tsdPtr->readyMasks.exceptional, &readyMasks.exceptional);
    FD_ZERO(&tsdPtr->readyMasks.readable);
    FD_ZERO(&tsdPtr->readyMasks.writable);
    FD_ZERO(&tsdPtr->readyMasks.exceptional);
    FD_COPY(&(tsdPtr->readyMasks.readable), &readyMasks.readable);
    FD_COPY(&(tsdPtr->readyMasks.writable), &readyMasks.writable);
    FD_COPY(&(tsdPtr->readyMasks.exceptional), &readyMasks.exceptional);
    FD_ZERO(&(tsdPtr->readyMasks.readable));
    FD_ZERO(&(tsdPtr->readyMasks.writable));
    FD_ZERO(&(tsdPtr->readyMasks.exceptional));
    UNLOCK_NOTIFIER_TSD;
    tsdPtr->runLoopSourcePerformed = 1;

    for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
	    filePtr = filePtr->nextPtr) {
	int mask = 0;

1466
1467
1468
1469
1470
1471
1472
1473
1474


1475
1476
1477
1478
1479
1480
1481
1312
1313
1314
1315
1316
1317
1318


1319
1320
1321
1322
1323
1324
1325
1326
1327







-
-
+
+








	/*
	 * Don't bother to queue an event if the mask was previously non-zero
	 * since an event must still be on the queue.
	 */

	if (filePtr->readyMask == 0) {
	    FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent));

	    FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
		    ckalloc(sizeof(FileHandlerEvent));
	    fileEvPtr->header.proc = FileHandlerEventProc;
	    fileEvPtr->fd = filePtr->fd;
	    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	}
	filePtr->readyMask = mask;
    }
}
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
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540


1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562


1563
1564
1565
1566
1567
1568
1569
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
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







-
+



-
+
+









-
+











+
+
+
+
+
+
+
+
+











-
-
+
+



















-
-
-
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateWaitingListAndServiceEvents(
    TCL_UNUSED(CFRunLoopObserverRef),
    CFRunLoopObserverRef observer,
    CFRunLoopActivity activity,
    void *info)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)info;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData*) info;

    if (tsdPtr->sleeping) {
	return;
    }
    switch (activity) {
    case kCFRunLoopEntry:
	tsdPtr->runLoopNestingLevel++;
	if (tsdPtr->numFdBits > 0 || tsdPtr->polling) {
	    LOCK_NOTIFIER;
	    if (!OnOffWaitingList(tsdPtr, 1, 1) && tsdPtr->polling) {
		write(triggerPipe, "", 1);
	       write(triggerPipe, "", 1);
	    }
	    UNLOCK_NOTIFIER;
	}
	break;
    case kCFRunLoopExit:
	if (tsdPtr->runLoopNestingLevel == 1) {
	    LOCK_NOTIFIER;
	    OnOffWaitingList(tsdPtr, 0, 1);
	    UNLOCK_NOTIFIER;
	}
	tsdPtr->runLoopNestingLevel--;
	break;
    case kCFRunLoopBeforeWaiting:
	if (tsdPtr->runLoopTimer && !tsdPtr->runLoopServicingEvents &&
		(tsdPtr->runLoopNestingLevel > 1 || !tsdPtr->runLoopRunning)) {
	    tsdPtr->runLoopServicingEvents = 1;
           /* This call seems to simply force event processing through and prevents hangups that have long been observed with Tk-Cocoa.  */
	    Tcl_ServiceAll();
	    tsdPtr->runLoopServicingEvents = 0;
	}
	break;
    default:
	break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * OnOffWaitingList --
 *
 *	Add/remove the specified thread to/from the global waitingList and
 *	optionally signal the notifier.
 *	Add/remove the specified thread to/from the global waitingList
 *	and optionally signal the notifier.
 *
 *	!!! Requires notifierLock to be held !!!
 *
 * Results:
 *	Boolean indicating whether the waitingList was changed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
OnOffWaitingList(
    ThreadSpecificData *tsdPtr,
    int onList,
    int signalNotifier)
{
    int changeWaitingList;

#if defined(TCL_MAC_DEBUG_NOTIFIER) && !defined(USE_OS_UNFAIR_LOCK)
    if (SpinLockTry(&notifierLock)) {
#ifdef TCL_MAC_DEBUG_NOTIFIER
    if(SpinLockTry(&notifierLock)) {
	Tcl_Panic("OnOffWaitingList: notifierLock unlocked");
    }
#endif
    changeWaitingList = (!onList ^ !tsdPtr->onList);
    if (changeWaitingList) {
	if (onList) {
	    tsdPtr->nextPtr = waitingListPtr;
1582
1583
1584
1585
1586
1587
1588
1589

1590
1591
1592
1593
1594
1595
1596
1437
1438
1439
1440
1441
1442
1443

1444
1445
1446
1447
1448
1449
1450
1451







-
+







	    if (tsdPtr->nextPtr) {
		tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
	    }
	    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
	    tsdPtr->onList = 0;
	}
	if (signalNotifier) {
	    write(triggerPipe, "", 1);
	   write(triggerPipe, "", 1);
	}
    }

    return changeWaitingList;
}

/*
1620
1621
1622
1623
1624
1625
1626
1627

1628
1629
1630
1631
1632
1633
1634
1475
1476
1477
1478
1479
1480
1481

1482
1483
1484
1485
1486
1487
1488
1489







-
+







	return;
    }

    /*
     * TIP #233: Scale from virtual time to real-time.
     */

    vdelay.sec = ms / 1000;
    vdelay.sec  = ms / 1000;
    vdelay.usec = (ms % 1000) * 1000;
    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);


    if (tsdPtr->runLoop) {
	CFTimeInterval waitTime;
	CFRunLoopTimerRef runLoopTimer = tsdPtr->runLoopTimer;
1646
1647
1648
1649
1650
1651
1652
1653
1654


1655
1656
1657
1658
1659
1660
1661
1501
1502
1503
1504
1505
1506
1507


1508
1509
1510
1511
1512
1513
1514
1515
1516







-
-
+
+







			CF_TIMEINTERVAL_FOREVER);
	    } else {
		runLoopTimer = NULL;
	    }
	}
	tsdPtr->sleeping = 1;
	do {
	    runLoopStatus = CFRunLoopRunInMode(kCFRunLoopDefaultMode,
		    waitTime, FALSE);
	    runLoopStatus = CFRunLoopRunInMode(kCFRunLoopDefaultMode, waitTime,
		    FALSE);
	    switch (runLoopStatus) {
	    case kCFRunLoopRunFinished:
		Tcl_Panic("Tcl_Sleep: CFRunLoop finished");
		break;
	    case kCFRunLoopRunStopped:
		TclMacOSXNotifierDbgMsg("CFRunLoop stopped");
		waitTime = waitEnd - CFAbsoluteTimeGetCurrent();
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
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
1668
1669
1670
1671
1672







-
+


-
+













-
+


-
+







	    }
	}

	/*
	 * Setup the select masks for the fd.
	 */

	if (mask & TCL_READABLE) {
	if (mask & TCL_READABLE)  {
	    FD_SET(fd, &readableMask);
	}
	if (mask & TCL_WRITABLE) {
	if (mask & TCL_WRITABLE)  {
	    FD_SET(fd, &writableMask);
	}
	if (mask & TCL_EXCEPTION) {
	    FD_SET(fd, &exceptionalMask);
	}

	/*
	 * Wait for the event or a timeout.
	 */

	numFound = select(fd + 1, &readableMask, &writableMask,
		&exceptionalMask, timeoutPtr);
	if (numFound == 1) {
	    if (FD_ISSET(fd, &readableMask)) {
	    if (FD_ISSET(fd, &readableMask))   {
		SET_BITS(result, TCL_READABLE);
	    }
	    if (FD_ISSET(fd, &writableMask)) {
	    if (FD_ISSET(fd, &writableMask))  {
		SET_BITS(result, TCL_WRITABLE);
	    }
	    if (FD_ISSET(fd, &exceptionalMask)) {
		SET_BITS(result, TCL_EXCEPTION);
	    }
	    result &= mask;
	    if (result) {
1858
1859
1860
1861
1862
1863
1864
1865

1866
1867

1868
1869
1870
1871
1872
1873
1874
1713
1714
1715
1716
1717
1718
1719

1720
1721

1722
1723
1724
1725
1726
1727
1728
1729







-
+

-
+







 * Side effects:
 *	The trigger pipe used to signal the notifier thread is created when
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */

static TCL_NORETURN void
static void
NotifierThreadProc(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Not used. */
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask, writableMask, exceptionalMask;
    int i, numFdBits = 0, polling;
    struct timeval poll = {0., 0.}, *timePtr;
    char buf[2];

1887
1888
1889
1890
1891
1892
1893
1894

1895
1896
1897

1898
1899
1900

1901
1902
1903
1904
1905
1906
1907
1742
1743
1744
1745
1746
1747
1748

1749
1750
1751

1752
1753
1754

1755
1756
1757
1758
1759
1760
1761
1762







-
+


-
+


-
+







	 */

	timePtr = NULL;
	LOCK_NOTIFIER;
	for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	    LOCK_NOTIFIER_TSD;
	    for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
		if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) {
		if (FD_ISSET(i, &(tsdPtr->checkMasks.readable))) {
		    FD_SET(i, &readableMask);
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) {
		if (FD_ISSET(i, &(tsdPtr->checkMasks.writable))) {
		    FD_SET(i, &writableMask);
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.exceptional)) {
		if (FD_ISSET(i, &(tsdPtr->checkMasks.exceptional))) {
		    FD_SET(i, &exceptionalMask);
		}
	    }
	    if (tsdPtr->numFdBits > numFdBits) {
		numFdBits = tsdPtr->numFdBits;
	    }
	    polling = tsdPtr->polling;
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945



1946
1947
1948
1949
1950
1951
1952
1791
1792
1793
1794
1795
1796
1797



1798
1799
1800
1801
1802
1803
1804
1805
1806
1807







-
-
-
+
+
+








	LOCK_NOTIFIER;
	for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	    int found = 0;
	    SelectMasks readyMasks, checkMasks;

	    LOCK_NOTIFIER_TSD;
	    FD_COPY(&tsdPtr->checkMasks.readable, &checkMasks.readable);
	    FD_COPY(&tsdPtr->checkMasks.writable, &checkMasks.writable);
	    FD_COPY(&tsdPtr->checkMasks.exceptional, &checkMasks.exceptional);
	    FD_COPY(&(tsdPtr->checkMasks.readable), &checkMasks.readable);
	    FD_COPY(&(tsdPtr->checkMasks.writable), &checkMasks.writable);
	    FD_COPY(&(tsdPtr->checkMasks.exceptional), &checkMasks.exceptional);
	    UNLOCK_NOTIFIER_TSD;
	    found = tsdPtr->polled;
	    FD_ZERO(&readyMasks.readable);
	    FD_ZERO(&readyMasks.writable);
	    FD_ZERO(&readyMasks.exceptional);

	    for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983



1984
1985
1986
1987
1988
1989
1990
1991
1829
1830
1831
1832
1833
1834
1835



1836
1837
1838

1839
1840
1841
1842
1843
1844
1845







-
-
-
+
+
+
-







		 * continuously on select until the other threads runs and
		 * services the file event.
		 */

		OnOffWaitingList(tsdPtr, 0, 0);

		LOCK_NOTIFIER_TSD;
		FD_COPY(&readyMasks.readable, &tsdPtr->readyMasks.readable);
		FD_COPY(&readyMasks.writable, &tsdPtr->readyMasks.writable);
		FD_COPY(&readyMasks.exceptional,
		FD_COPY(&readyMasks.readable, &(tsdPtr->readyMasks.readable));
		FD_COPY(&readyMasks.writable, &(tsdPtr->readyMasks.writable));
		FD_COPY(&readyMasks.exceptional, &(tsdPtr->readyMasks.exceptional));
			&tsdPtr->readyMasks.exceptional);
		UNLOCK_NOTIFIER_TSD;
		tsdPtr->polled = 0;
		if (tsdPtr->runLoop) {
		    CFRunLoopSourceSignal(tsdPtr->runLoopSource);
		    CFRunLoopWakeUp(tsdPtr->runLoop);
		}
	    }
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
1939
1940
1941
1942
1943
1944
1945












1946
1947
1948

1949
1950
1951
1952
1953
1954
1955







-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-







 */

static void
AtForkChild(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * If a child process unlocks an os_unfair_lock that was created in its parent
     * the child will exit with an illegal instruction error.  So we reinitialize
     * the lock in the child rather than attempt to unlock it.
     */

#if defined(USE_OS_UNFAIR_LOCK)
    tsdPtr->tsdLock = OS_UNFAIR_LOCK_INIT;
#else
       UNLOCK_NOTIFIER_TSD;
       UNLOCK_NOTIFIER;
       UNLOCK_NOTIFIER_INIT;
    UNLOCK_NOTIFIER_TSD;
    UNLOCK_NOTIFIER;
    UNLOCK_NOTIFIER_INIT;
#endif
    if (tsdPtr->runLoop) {
	tsdPtr->runLoop = NULL;
	if (!noCFafterFork) {
	    CFRunLoopSourceInvalidate(tsdPtr->runLoopSource);
	    CFRelease(tsdPtr->runLoopSource);
	    if (tsdPtr->runLoopTimer) {
		CFRunLoopTimerInvalidate(tsdPtr->runLoopTimer);
2135
2136
2137
2138
2139
2140
2141
2142

2143
2144
2145
2146
2147
2148
2149
1979
1980
1981
1982
1983
1984
1985

1986
1987
1988
1989
1990
1991
1992
1993







-
+







}
#endif /* HAVE_PTHREAD_ATFORK */

#else /* HAVE_COREFOUNDATION */

void
TclMacOSXNotifierAddRunLoopMode(
    const void *runLoopMode)
    CONST void *runLoopMode)
{
    Tcl_Panic("TclMacOSXNotifierAddRunLoopMode: "
	    "Tcl not built with CoreFoundation support");
}

#endif /* HAVE_COREFOUNDATION */


Deleted pkgs/README.

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

























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

The 'pkgs' subdirectory of the Tcl source code distribution is meant to be
a place where the source code distribution of Tcl packages may be placed so
that they are built, installed, and tested along with Tcl.  As originally
distributed, Tcl re-distributes a number of packages in this location.  The
build systems for Tcl are written so that additional packages may be added,
or the original packages removed in any number and still have all packages
present get built, installed, and tested along with Tcl.

In order for a package to work properly under the pkgs subdirectory, it
needs to conform to the following conventions.

  All files of the package need to be contained in (subdirs of ...) a
  single subdirectory of the "pkgs" directrory.

  In that subdirectory of "pkgs" there must be an executable file named
  "configure".  When the program "configure" is run, it should generate
  a file "Makefile" in the current working directory.  The "configure"
  program should be able to accept as command line arguments all the
  arguments that can be passed to the top unix/configure program.  It
  should also accept the --with-tcl= and --with-tclinclude= options in
  the conventional way.

  The generated "Makefile" must be one suitable for controlling the operations
  of a `make` program.  The following targets must be defined:

    <default>:	Perform a build of the runtime components of the
		package from sources.

    install:	Copy the runtime components of the package into their
		installed location.  Must respect the DESTDIR variable
		for determining the installation location.

    test:	Run the test suite of the package.  Must respect the
		TCLSH_PROG, TESTFLAGS variables.

    clean:	Delete all files generated by the default build target.

    distclean:	Delete all generated files.

    dist:	Produce a copy of the package's source code distribution.
		Must respect the DIST_ROOT variable determining where to
		write the generated directory.

Packages that are written to make use of the Tcl Extension Architecture (TEA)
and that make use of the tclconfig collection of support files, should
conform to these conventions without further efforts.

These conventions are subject to revision and refinement over time to
better support the needs of the build system.  Efforts will be made to
keep the TEA support scripts consistent with the demands of this system.

In addition, it is requested that packages also support building with
Microsoft Visual Studio tools.  This means the file win/makefile.vc
should be included, suitable for use by the nmake program, defining the
targets <default>, install, test, and clean.

Deleted pkgs/package.list.txt.

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



































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# This file contains the mapping of directory names to package names for
# documentation purposes. Each non-blank non-comment line is a two-element
# list that says a possible name of directory (multiple lines may be needed
# because of capitalization issues) and the documentation name of the package
# to match. Pseudo-numeric suffixes are interpreted as version numbers.

# [incr Tcl]
itcl {[incr Tcl]}
Itcl {[incr Tcl]}

# SQLite
Sqlite SQLite3
sqlite SQLite3
Sqlite3 SQLite3
sqlite3 SQLite3

# Thread
Thread Thread
thread Thread

# Tcl Database Connectivity
tdbc TDBC
Tdbc TDBC
TDBC TDBC
# Drivers for TDBC
Tdbcmysql	tdbc::mysql
tdbcmysql	tdbc::mysql
Tdbcodbc	tdbc::odbc
tdbcodbc	tdbc::odbc
Tdbcpostgres	tdbc::postgres
tdbcpostgres	tdbc::postgres
Tdbcsqlite3	tdbc::sqlite3
tdbcsqlite3	tdbc::sqlite3
Tdbcsqlite	tdbc::sqlite3
tdbcsqlite	tdbc::sqlite3

Changes to tests-perf/test-performance.tcl.

45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
45
46
47
48
49
50
51

52
53
54
55
56
57
58
59







-
+








  set tcnt [llength $_(itm)]
  if {!$tcnt} {
    puts ""
    return
  }

  set mintm 0x7FFFFFFF
  set mintm 0x7fffffff
  set maxtm 0
  set nettm 0
  set wtm 0
  set wcnt 0
  set i 0
  foreach tm $_(itm) {
    if {[llength $tm] > 6} {

Changes to tests/README.

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
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







-
+












-
+




-
+







Please note that the all.tcl file will source your new test file if
the filename matches the tests/*.test pattern (as it should).  The
names of test files that contain regression (or glass-box) tests
should correspond to the Tcl or C code file that they are testing.
For example, the test file for the C file "tclCmdAH.c" is
"cmdAH.test".  Test files that contain black-box tests may not
correspond to any Tcl or C code file so they should match the pattern
"*_bb.test".
"*_bb.test". 

Be sure your new test file can be run from any working directory.

Be sure no temporary files are left behind by your test file.
Use [tcltest::makeFile], [tcltest::removeFile], and [tcltest::cleanupTests]
properly to be sure of this.

Be sure your tests can run cross-platform in both a build environment
as well as an installation environment.  If your test file contains
tests that should not be run in one or more of those cases, please use
the constraints mechanism to skip those tests.

4. Incompatibilities of package tcltest 2.1 with
4. Incompatibilities of package tcltest 2.1 with 
   testing machinery of very old versions of Tcl:
------------------------------------------------

1) Global variables such as VERBOSE, TESTS, and testConfig of the
   old machinery correspond to the [configure -verbose],
   old machinery correspond to the [configure -verbose], 
   [configure -match], and [testConstraint] commands of tcltest 2.1,
   respectively.

2) VERBOSE values were longer numeric.  [configure -verbose] values
   are lists of keywords.

3) When you run "make test", the working dir for the test suite is now

Deleted tests/aaa_exit.test.

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






















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  exit, emphasis on finalization hangs
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test exit-1.1 {normal, quick exit} {
     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r]
     set aft [after 1000 {set done "Quick exit hangs !!!"}]
     fileevent $f readable {after cancel $aft;set done OK}
     vwait done
     if {$done != "OK"} {
     	fconfigure $f -blocking 0
	close $f
     } else {
	if {[catch {close $f} err]} {
	    set done "Quick exit misbehaves: $err"
	}
     }
     set done
} OK

test exit-1.2 {full-finalized exit} {
     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\"" r]
     set aft [after 1000 {set done "Full-finalized exit hangs !!!"}]
     fileevent $f readable {after cancel $aft;set done OK}
     vwait done
     if {$done != "OK"} {
     	fconfigure $f -blocking 0
	close $f
     } else {
	if {[catch {close $f} err]} {
	    set done "Full-finalized exit misbehaves: $err"
	}
     }
     set done
} OK


# cleanup
::tcltest::cleanupTests
return

Changes to tests/all.tcl.

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
1
2
3

4
5
6
7
8
9
10
11
12


13
14

15


16






17
18
19









-
+








-
-
+

-
+
-
-
+
-
-
-
-
-
-



-
-
-
-
-
-
# all.tcl --
#
# This file contains a top-level script to run all of the Tcl
# tests.  Execute it by invoking "source all.tcl" when running tcltest
# tests.  Execute it by invoking "source all.test" when running tcltest
# in this directory.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2000 by Ajuba Solutions
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package prefer latest
package require Tcl 8.5-
package require Tcl 8.5
package require tcltest 2.5
namespace import ::tcltest::*
namespace import tcltest::*

configure {*}$argv -testdir [file dirname [file dirname [file normalize [
configure {*}$argv -testdir [file dir [info script]]
    info script]/...]]]

if {[singleProcess]} {
    interp debug {} -frame 1
}

set ErrorOnFailures [info exists env(ERROR_ON_FAILURES)]
unset -nocomplain env(ERROR_ON_FAILURES)
if {[runAllTests] && $ErrorOnFailures} {exit 1}
# if calling direct only (avoid rewrite exit if inlined or interactive):
if { [info exists ::argv0] && [file tail $::argv0] eq [file tail [info script]]
  && !([info exists ::tcl_interactive] && $::tcl_interactive)
} {
    proc exit args {}
}

Changes to tests/append.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+


-
-
+
+

-
+







# Commands covered:  append lappend
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}
unset -nocomplain x

catch {unset x}

test append-1.1 {append command} {
    unset -nocomplain x
    catch {unset x}
    list [append x 1 2 abc "long string"] $x
} {{12abclong string} {12abclong string}}
test append-1.2 {append command} {
    set x ""
    list [append x first] [append x second] [append x third] $x
} {first firstsecond firstsecondthird firstsecondthird}
test append-1.3 {append command} {
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
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












-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+


-
+






-
+






-
+
-

+
-
+




















-
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+

















-
+



-
+



-
+



-
+



-
+

-
-
-
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+



-
+
-
-

-
-
-
-
+
+
+
+

-
-
+
+

-
+

-
+
-








-
-
-
-
+
+
+
+
-



-
-
-
+
+
+
-
-
-
-
-
+
+
+
+



-
-
-
-
-
+
+
+
+
+
-




-
-
-
-
-
+
+
+
+
+
-




-
+

-
-
-
-
-
-
+
+
+
+

-
-
+
+
-











-
-
-
+
+
+
+
-



-
-
-
-
-
+
+
+
+
-











-
-
-
+
+
+
+
-



-
-
-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

+




-
-
-
-
-
    set y "foobar"
    set y "$y $y $y $y $y $y $y $y $y $y"
    set y "$y $y $y $y $y $y $y $y $y $y"
    set y "$y $y $y $y $y $y $y $y $y $y "
    expr {$x == $y}
} 1

test append-3.1 {append errors} -returnCodes error -body {
    append
} -result {wrong # args: should be "append varName ?value ...?"}
test append-3.2 {append errors} -returnCodes error -body {
test append-3.1 {append errors} {
    list [catch {append} msg] $msg
} {1 {wrong # args: should be "append varName ?value value ...?"}}
test append-3.2 {append errors} {
    set x ""
    append x(0) 44
} -result {can't set "x(0)": variable isn't array}
test append-3.3 {append errors} -returnCodes error -body {
    unset -nocomplain x
    append x
} -result {can't read "x": no such variable}
    list [catch {append x(0) 44} msg] $msg
} {1 {can't set "x(0)": variable isn't array}}
test append-3.3 {append errors} {
    catch {unset x}
    list [catch {append x} msg] $msg
} {1 {can't read "x": no such variable}}

test append-4.1 {lappend command} {
    unset -nocomplain x
    catch {unset x}
    list [lappend x 1 2 abc "long string"] $x
} {{1 2 abc {long string}} {1 2 abc {long string}}}
test append-4.2 {lappend command} {
    set x ""
    list [lappend x first] [lappend x second] [lappend x third] $x
} {first {first second} {first second third} {first second third}}
test append-4.3 {lappend command} -body {
test append-4.3 {lappend command} {
    proc foo {} {
	global x
	set x old
	unset x
	lappend x new
    }
    foo
    set result [foo]
} -cleanup {
    rename foo {}
    set result
} -result {new}
} {new}
test append-4.4 {lappend command} {
    set x {}
    lappend x \{\  abc
} {\{\  abc}
test append-4.5 {lappend command} {
    set x {}
    lappend x \{ abc
} {\{ abc}
test append-4.6 {lappend command} {
    set x {1 2 3}
    lappend x
} {1 2 3}
test append-4.7 {lappend command} {
    set x "a\{"
    lappend x abc
} "a\\\{ abc"
test append-4.8 {lappend command} {
    set x "\\\{"
    lappend x abc
} "\\{ abc"
test append-4.9 {lappend command} -returnCodes error -body {
test append-4.9 {lappend command} {
    set x " \{"
    lappend x abc
} -result {unmatched open brace in list}
test append-4.10 {lappend command} -returnCodes error -body {
    list [catch {lappend x abc} msg] $msg
} {1 {unmatched open brace in list}}
test append-4.10 {lappend command} {
    set x "	\{"
    lappend x abc
} -result {unmatched open brace in list}
test append-4.11 {lappend command} -returnCodes error -body {
    list [catch {lappend x abc} msg] $msg
} {1 {unmatched open brace in list}}
test append-4.11 {lappend command} {
    set x "\{\{\{"
    lappend x abc
} -result {unmatched open brace in list}
test append-4.12 {lappend command} -returnCodes error -body {
    list [catch {lappend x abc} msg] $msg
} {1 {unmatched open brace in list}}
test append-4.12 {lappend command} {
    set x "x \{\{\{"
    lappend x abc
} -result {unmatched open brace in list}
    list [catch {lappend x abc} msg] $msg
} {1 {unmatched open brace in list}}
test append-4.13 {lappend command} {
    set x "x\{\{\{"
    lappend x abc
} "x\\\{\\\{\\\{ abc"
test append-4.14 {lappend command} {
    set x " "
    lappend x abc
} "abc"
test append-4.15 {lappend command} {
    set x "\\ "
    lappend x abc
} "{ } abc"
test append-4.16 {lappend command} {
    set x "x "
    lappend x abc
} "x abc"
test append-4.17 {lappend command} {
    unset -nocomplain x
    catch {unset x}
    lappend x
} {}
test append-4.18 {lappend command} {
    unset -nocomplain x
    catch {unset x}
    lappend x {}
} {{}}
test append-4.19 {lappend command} {
    unset -nocomplain x
    catch {unset x}
    lappend x(0)
} {}
test append-4.20 {lappend command} {
    unset -nocomplain x
    catch {unset x}
    lappend x(0) abc
} {abc}
unset -nocomplain x
test append-4.21 {lappend command} -returnCodes error -body {
test append-4.21 {lappend command} {
    set x \"
    lappend x
} -result {unmatched open quote in list}
test append-4.22 {lappend command} -returnCodes error -body {
    list [catch {lappend x} msg] $msg
} {1 {unmatched open quote in list}}
test append-4.22 {lappend command} {
    set x \"
    lappend x abc
} -result {unmatched open quote in list}
    list [catch {lappend x abc} msg] $msg
} {1 {unmatched open quote in list}}

test append-5.1 {long lappends} -setup {
    unset -nocomplain x
    proc check {var size} {
	set l [llength $var]
	if {$l != $size} {
	    return "length mismatch: should have been $size, was $l"
	}
	for {set i 0} {$i < $size} {set i [expr $i+1]} {
	    set j [lindex $var $i]
	    if {$j ne "item $i"} {
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }
} -body {
proc check {var size} {
    set l [llength $var]
    if {$l != $size} {
	return "length mismatch: should have been $size, was $l"
    }
    for {set i 0} {$i < $size} {set i [expr $i+1]} {
	set j [lindex $var $i]
	if {$j != "item $i"} {
	    return "element $i should have been \"item $i\", was \"$j\""
	}
    }
    return ok
}
test append-5.1 {long lappends} {
    catch {unset x}
    set x ""
    for {set i 0} {$i < 300} {incr i} {
    for {set i 0} {$i < 300} {set i [expr $i+1]} {
	lappend x "item $i"
    }
    check $x 300
} -cleanup {
} ok
    rename check {}
} -result ok

test append-6.1 {lappend errors} -returnCodes error -body {
    lappend
} -result {wrong # args: should be "lappend varName ?value ...?"}
test append-6.2 {lappend errors} -returnCodes error -body {
test append-6.1 {lappend errors} {
    list [catch {lappend} msg] $msg
} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
test append-6.2 {lappend errors} {
    set x ""
    lappend x(0) 44
} -result {can't set "x(0)": variable isn't array}
    list [catch {lappend x(0) 44} msg] $msg
} {1 {can't set "x(0)": variable isn't array}}

test append-7.1 {lappend-created var and error in trace on that var} -setup {
test append-7.1 {lappend-created var and error in trace on that var} {
    catch {rename foo ""}
    unset -nocomplain x
    catch {unset x}
} -body {
    trace variable x w foo
    proc foo {} {global x; unset x}
    catch {lappend x 1}
    proc foo {args} {global x; unset x}
    info exists x
    set x
    lappend x 1
    list [info exists x] [catch {set x} msg] $msg
} -result {0 1 {can't read "x": no such variable}}
test append-7.2 {lappend var triggers read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
} {0 1 {can't read "x": no such variable}}
test append-7.2 {lappend var triggers read trace} {
    catch {unset myvar}
    catch {unset ::result}
} -body {
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar a
    return $::result
} -result {myvar {} r}
test append-7.3 {lappend var triggers read trace, array var} -setup {
    list [catch {set ::result} msg] $msg
} {0 {myvar {} r}}
test append-7.3 {lappend var triggers read trace, array var} {
    unset -nocomplain myvar
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them, and was changed back in 8.4.
    # The behavior of read triggers on lappend changed in 8.0 to
    # not trigger them, and was changed back in 8.4.
    catch {unset myvar}
    catch {unset ::result}
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b r}
test append-7.4 {lappend var triggers read trace, array var exists} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
    list [catch {set ::result} msg] $msg
} {0 {myvar b r}}
test append-7.4 {lappend var triggers read trace, array var exists} {
    catch {unset myvar}
    catch {unset ::result}
} -body {
    set myvar(0) 1
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    lappend myvar(b) a
    return $::result
} -result {myvar b r}
test append-7.5 {append var does not trigger read trace} -setup {
    unset -nocomplain myvar
    unset -nocomplain ::result
    list [catch {set ::result} msg] $msg
} {0 {myvar b r}}
test append-7.5 {append var does not trigger read trace} {
    catch {unset myvar}
    catch {unset ::result}
} -body {
    trace variable myvar r foo
    proc foo {args} {append ::result $args}
    append myvar a
    info exists ::result
} -result {0}
} {0}

# THERE ARE NO append-8.* TESTS

# New tests for bug 3057639 to show off the more consistent behaviour of
# lappend in both direct-eval and bytecompiled code paths (see appendComp.test
# for the compiled variants). lappend now behaves like append. 9.0/1 lappend -
# 9.2/3 append
# New tests for bug 3057639 to show off the more consistent behaviour
# of lappend in both direct-eval and bytecompiled code paths (see
# appendComp.test for the compiled variants). lappend now behaves like
# append. 9.0/1 lappend - 9.2/3 append

test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} -setup {
    unset -nocomplain myvar
test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} {
    catch {unset myvar}
} -body {
    array set myvar {}
    proc nonull {var key val} {
	upvar 1 $var lvar
	if {![info exists lvar($key)]} {
	    return -code error "no such variable"
	}
    }
    trace add variable myvar read nonull
    list [catch {
	lappend myvar(key) "new value"
    } msg] $msg
} -result {0 {{new value}}}
test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
    unset -nocomplain ::env(__DUMMY__)
} {0 {{new value}}}

test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
    catch {unset ::env(__DUMMY__)}
} -body {
    list [catch {
	lappend ::env(__DUMMY__) "new value"
    } msg] $msg
} -cleanup {
    unset -nocomplain ::env(__DUMMY__)
} -result {0 {{new value}}}
test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} -setup {
    unset -nocomplain myvar
} {0 {{new value}}}

test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} {
    catch {unset myvar}
} -body {
    array set myvar {}
    proc nonull {var key val} {
	upvar 1 $var lvar
	if {![info exists lvar($key)]} {
	    return -code error "no such variable"
	}
    }
    trace add variable myvar read nonull
    list [catch {
	append myvar(key) "new value"
    } msg] $msg
} -result {0 {new value}}
test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
    unset -nocomplain ::env(__DUMMY__)
} {0 {new value}}

test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
    catch {unset ::env(__DUMMY__)}
} -body {
    list [catch {
	append ::env(__DUMMY__) "new value"
    } msg] $msg
} -cleanup {
    unset -nocomplain ::env(__DUMMY__)
} -result {0 {new value}}
} {0 {new value}}

test append-10.1 {Bug 214cc0eb22: lappend with no values} {

    set lst "# 1 2 3"
    [subst lappend] lst
} "# 1 2 3"
test append-10.2 {Bug 214cc0eb22: lappend with no values} -body {
    set lst "1 \{ 2"
    [subst lappend] lst
} -returnCodes error -result {unmatched open brace in list}
test append-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
    set lst "# 1 2 3"
    [subst lappend] lst {*}[list]
} "# 1 2 3"
test append-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
    set lst "1 \{ 2"
    [subst lappend] lst {*}[list]
} -returnCodes error -result {unmatched open brace in list}

unset -nocomplain i x result y

catch {unset i x result y}
catch {rename foo ""}
catch {rename check ""}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/appendComp.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+



-
-
-
+
+
+
-


-
+







# Commands covered:  append lappend
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}
catch {unset x}

test appendComp-1.1 {append command} -setup {
    unset -nocomplain x

test appendComp-1.1 {append command} {
    catch {unset x}
} -body {
    proc foo {} {append ::x 1 2 abc "long string"}
    list [foo] $x
} -result {{12abclong string} {12abclong string}}
} {{12abclong string} {12abclong string}}
test appendComp-1.2 {append command} {
    proc foo {} {
	set x ""
	list [append x first] [append x second] [append x third] $x
    }
    foo
} {first firstsecond firstsecondthird firstsecondthird}
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
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







-
+

-
-
-
+
+
+




-
-
-
+
+
+

-
+


-
-
+
+




-
+







	set y "$y $y $y $y $y $y $y $y $y $y"
	set y "$y $y $y $y $y $y $y $y $y $y "
	expr {$x == $y}
    }
    foo
} 1

test appendComp-3.1 {append errors} -returnCodes error -body {
test appendComp-3.1 {append errors} {
    proc foo {} {append}
    foo
} -result {wrong # args: should be "append varName ?value ...?"}
test appendComp-3.2 {append errors} -returnCodes error -body {
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "append varName ?value value ...?"}}
test appendComp-3.2 {append errors} {
    proc foo {} {
	set x ""
	append x(0) 44
    }
    foo
} -result {can't set "x(0)": variable isn't array}
test appendComp-3.3 {append errors} -returnCodes error -body {
    list [catch {foo} msg] $msg
} {1 {can't set "x(0)": variable isn't array}}
test appendComp-3.3 {append errors} {
    proc foo {} {
	unset -nocomplain x
	catch {unset x}
	append x
    }
    foo
} -result {can't read "x": no such variable}
    list [catch {foo} msg] $msg
} {1 {can't read "x": no such variable}}

test appendComp-4.1 {lappend command} {
    proc foo {} {
	global x
	unset -nocomplain x
	catch {unset x}
	lappend x 1 2 abc "long string"
    }
    list [foo] $x
} {{1 2 abc {long string}} {1 2 abc {long string}}}
test appendComp-4.2 {lappend command} {
    proc foo {} {
	set x ""
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
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







-
+


-
+


-
-
+
+


-
+


-
-
+
+


-
+


-
-
+
+


-
+


-
+







test appendComp-4.8 {lappend command} {
    proc foo {} {
	set x "\\\{"
	lappend x abc
    }
    foo
} "\\{ abc"
test appendComp-4.9 {lappend command} -returnCodes error -body {
test appendComp-4.9 {lappend command} {
    proc foo {} {
	set x " \{"
	lappend x abc
	list [catch {lappend x abc} msg] $msg
    }
    foo
} -result {unmatched open brace in list}
test appendComp-4.10 {lappend command} -returnCodes error -body {
} {1 {unmatched open brace in list}}
test appendComp-4.10 {lappend command} {
    proc foo {} {
	set x "	\{"
	lappend x abc
	list [catch {lappend x abc} msg] $msg
    }
    foo
} -result {unmatched open brace in list}
test appendComp-4.11 {lappend command} -returnCodes error -body {
} {1 {unmatched open brace in list}}
test appendComp-4.11 {lappend command} {
    proc foo {} {
	set x "\{\{\{"
	lappend x abc
	list [catch {lappend x abc} msg] $msg
    }
    foo
} -result {unmatched open brace in list}
test appendComp-4.12 {lappend command} -returnCodes error -body {
} {1 {unmatched open brace in list}}
test appendComp-4.12 {lappend command} {
    proc foo {} {
	set x "x \{\{\{"
	lappend x abc
	list [catch {lappend x abc} msg] $msg
    }
    foo
} -result {unmatched open brace in list}
} {1 {unmatched open brace in list}}
test appendComp-4.13 {lappend command} {
    proc foo {} {
	set x "x\{\{\{"
	lappend x abc
    }
    foo
} "x\\\{\\\{\\\{ abc"
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

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
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
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

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












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+
-
-
-

-
+

-
-
-
+
+
+




-
-
+
+

-
+
-
-
-


+
+










-
-
+
+
-
-

+
+



-
+


-
-
+
+
-
-
-

+
+



-
+


-
-
+
+
-
-
-
-
+
+

+
+



-
+


-
-
+
+
-
-
-
-
+
+

+
+



-
+


-
-
+
+
-
-

+
+




-
+


-
-
+
+
-
-
-

+
+



-
+


-
-
+
+
-
-
-

+
+



-
+


-
-
+
+
-
-

+
+






-
+


-
+

-
+







-
+


+
-
-
-
-
+
+
+
+

-
-
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-











-
-
-
+
+
+
+
+
-




+
-
-
-
-
-
+
+
+
+
+

-











-
-
-
+
+
+
+
+
-




-
-
-
+

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+









-
-
-
-
-
    foo
} {}
test appendComp-4.20 {lappend command} {
    proc foo {} { lappend x(0) abc }
    foo
} {abc}

test appendComp-5.1 {long lappends} -setup {
    unset -nocomplain x
    proc check {var size} {
	set l [llength $var]
	if {$l != $size} {
	    return "length mismatch: should have been $size, was $l"
	}
	for {set i 0} {$i < $size} {incr i} {
	    set j [lindex $var $i]
	    if {$j ne "item $i"} {
		return "element $i should have been \"item $i\", was \"$j\""
	    }
	}
	return ok
    }
} -body {
proc check {var size} {
    set l [llength $var]
    if {$l != $size} {
	return "length mismatch: should have been $size, was $l"
    }
    for {set i 0} {$i < $size} {set i [expr $i+1]} {
	set j [lindex $var $i]
	if {$j != "item $i"} {
	    return "element $i should have been \"item $i\", was \"$j\""
	}
    }
    return ok
}
test appendComp-5.1 {long lappends} {
    catch {unset x}
    set x ""
    for {set i 0} {$i < 300} {set i [expr $i+1]} {
	lappend x "item $i"
    }
    check $x 300
} -cleanup {
} ok
    unset -nocomplain x
    catch {rename check ""}
} -result ok

test appendComp-6.1 {lappend errors} -returnCodes error -body {
test appendComp-6.1 {lappend errors} {
    proc foo {} {lappend}
    foo
} -result {wrong # args: should be "lappend varName ?value ...?"}
test appendComp-6.2 {lappend errors} -returnCodes error -body {
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
test appendComp-6.2 {lappend errors} {
    proc foo {} {
	set x ""
	lappend x(0) 44
    }
    foo
} -result {can't set "x(0)": variable isn't array}
    list [catch {foo} msg] $msg
} {1 {can't set "x(0)": variable isn't array}}

test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
test appendComp-7.1 {lappendComp-created var and error in trace on that var} {
    catch {rename foo ""}
    unset -nocomplain x
} -body {
    proc bar {} {
	global x
	catch {rename foo ""}
	catch {unset x}
	trace variable x w foo
	proc foo {} {global x; unset x}
	catch {lappend x 1}
	proc foo {args} {global x; unset x}
	info exists x
	set x
	lappend x 1
	list [info exists x] [catch {set x} msg] $msg
    }
    bar
} -result {0 1 {can't read "x": no such variable}}
test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
} {0 1 {can't read "x": no such variable}}
test appendComp-7.2 {lappend var triggers read trace, index var} {bug-3057639} {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	catch {unset myvar}
	catch {unset ::result}
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar a
	return $::result
	list [catch {set ::result} msg] $msg
    }
    bar
} -result {myvar {} r} -constraints {bug-3057639}
test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
} {0 {myvar {} r}}
test appendComp-7.3 {lappend var triggers read trace, stack var} {bug-3057639} {
    unset -nocomplain ::result
    unset -nocomplain ::myvar
} -body {
    proc bar {} {
	catch {unset ::myvar}
	catch {unset ::result}
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar a
	return $::result
	list [catch {set ::result} msg] $msg
    }
    bar
} -result {::myvar {} r} -constraints {bug-3057639}
test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
} {0 {::myvar {} r}}
test appendComp-7.4 {lappend var triggers read trace, array var} {bug-3057639} {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    # The behavior of read triggers on lappend changed in 8.0 to
    # not trigger them.  Maybe not correct, but been there a while.
    proc bar {} {
	catch {unset myvar}
	catch {unset ::result}
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
	list [catch {set ::result} msg] $msg
    }
    bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
} {0 {myvar b r}}
test appendComp-7.5 {lappend var triggers read trace, array var} {
    unset -nocomplain ::result
} -body {
    # The behavior of read triggers on lappend changed in 8.0 to not trigger
    # them. Maybe not correct, but been there a while.
    # The behavior of read triggers on lappend changed in 8.0 to
    # not trigger them.  Maybe not correct, but been there a while.
    proc bar {} {
	catch {unset myvar}
	catch {unset ::result}
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a b
	return $::result
	list [catch {set ::result} msg] $msg
    }
    bar
} -result {myvar b r}
test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
} {0 {myvar b r}}
test appendComp-7.6 {lappend var triggers read trace, array var exists} {bug-3057639} {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	catch {unset myvar}
	catch {unset ::result}
	set myvar(0) 1
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	lappend myvar(b) a
	return $::result
	list [catch {set ::result} msg] $msg
    }
    bar
} -result {myvar b r} -constraints {bug-3057639}
test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
} {0 {myvar b r}}
test appendComp-7.7 {lappend var triggers read trace, array stack var} {bug-3057639} {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	catch {unset ::myvar}
	catch {unset ::result}
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a
	return $::result
	list [catch {set ::result} msg] $msg
    }
    bar
} -result {::myvar b r} -constraints {bug-3057639}
test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
} {0 {::myvar b r}}
test appendComp-7.8 {lappend var triggers read trace, array stack var} {
    unset -nocomplain ::myvar
    unset -nocomplain ::result
} -body {
    proc bar {} {
	catch {unset ::myvar}
	catch {unset ::result}
	trace variable ::myvar r foo
	proc foo {args} {append ::result $args}
	lappend ::myvar(b) a b
	return $::result
	list [catch {set ::result} msg] $msg
    }
    bar
} -result {::myvar b r}
test appendComp-7.9 {append var does not trigger read trace} -setup {
} {0 {::myvar b r}}
test appendComp-7.9 {append var does not trigger read trace} {
    unset -nocomplain ::result
} -body {
    proc bar {} {
	catch {unset myvar}
	catch {unset ::result}
	trace variable myvar r foo
	proc foo {args} {append ::result $args}
	append myvar a
	info exists ::result
    }
    bar
} -result {0}
} {0}

test appendComp-8.1 {defer error to runtime} -setup {
    interp create child
    interp create slave
} -body {
    child eval {
    slave eval {
	proc foo {} {
	    proc append args {}
	    append
	}
	foo
    }
} -cleanup {
    interp delete child
    interp delete slave
} -result {}


# New tests for bug 3057639 to show off the more consistent behaviour of
# lappend in both direct-eval and bytecompiled code paths (see append.test for
# the direct-eval variants). lappend now behaves like append. 9.0/1 lappend -
# 9.2/3 append.
# New tests for bug 3057639 to show off the more consistent behaviour
# of lappend in both direct-eval and bytecompiled code paths (see
# append.test for the direct-eval variants). lappend now behaves like
# append. 9.0/1 lappend - 9.2/3 append.

# Note also the tests above now constrained by bug-3057639, these changed
# behaviour with the triggering of read traces in bc mode gone.
# Note also the tests above now constrained by bug-3057639, these
# changed behaviour with the triggering of read traces in bc mode
# gone.

# Going back to the tests below. The direct-eval tests are ok before and after
# patch (no read traces run for lappend, append). The compiled tests are
# failing for lappend (9.0/1) before the patch, showing how it invokes read
# traces in the compiled path. The append tests are good (9.2/3). After the
# patch the failues are gone.
# Going back to the tests below. The direct-eval tests are ok before
# and after patch (no read traces run for lappend, append). The
# compiled tests are failing for lappend (9.0/1) before the patch,
# showing how it invokes read traces in the compiled path. The append
# tests are good (9.2/3). After the patch the failues are gone.

test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup {
    unset -nocomplain myvar
test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} {
    catch {unset myvar}
    array set myvar {}
} -body {
    proc nonull {var key val} {
	upvar 1 $var lvar
	if {![info exists lvar($key)]} {
	    return -code error "BOOM. no such variable"
	}
    }
    trace add variable myvar read nonull
    proc foo {} {
	lappend ::myvar(key) "new value"
    }
    list [catch { foo } msg] $msg
} -result {0 {{new value}}}
test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
    unset -nocomplain ::env(__DUMMY__)
} {0 {{new value}}}


test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
    catch {unset ::env(__DUMMY__)}
} -body {
    proc foo {} {
	lappend ::env(__DUMMY__) "new value"
    }
    list [catch { foo } msg] $msg
} {0 {{new value}}}
} -cleanup {
    unset -nocomplain ::env(__DUMMY__)
} -result {0 {{new value}}}
test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} -setup {
    unset -nocomplain myvar



test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} {
    catch {unset myvar}
    array set myvar {}
} -body {
    proc nonull {var key val} {
	upvar 1 $var lvar
	if {![info exists lvar($key)]} {
	    return -code error "BOOM. no such variable"
	}
    }
    trace add variable myvar read nonull
    proc foo {} {
	append ::myvar(key) "new value"
    }
    list [catch { foo } msg] $msg
} -result {0 {new value}}
test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
    unset -nocomplain ::env(__DUMMY__)
} {0 {new value}}


test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
    catch {unset ::env(__DUMMY__)}
} -body {
    proc foo {} {
	append ::env(__DUMMY__) "new value"
    }
    list [catch { foo } msg] $msg
} -cleanup {
    unset -nocomplain ::env(__DUMMY__)
} -result {0 {new value}}
} {0 {new value}}

test appendComp-10.1 {Bug 214cc0eb22: lappend with no values} {
    apply {lst {
	lappend lst



    }} "# 1 2 3"
} "# 1 2 3"
test appendComp-10.2 {Bug 214cc0eb22: lappend with no values} -body {
    apply {lst {
	lappend lst
    }} "1 \{ 2"
} -returnCodes error -result {unmatched open brace in list}
test appendComp-10.3 {Bug 214cc0eb22: expanded lappend with no values} {
    apply {lst {
	lappend lst {*}[list]
    }} "# 1 2 3"
} "# 1 2 3"
test appendComp-10.4 {Bug 214cc0eb22: expanded lappend with no values} -body {
    apply {lst {
	lappend lst {*}[list]
    }} "1 \{ 2"
} -returnCodes error -result {unmatched open brace in list}


catch {unset i x result y}
catch {rename foo ""}
catch {rename bar ""}
catch {rename check ""}
catch {rename bar {}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/apply.test.

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
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







-
-
+
+








-
+


-
-
-
+
+
+
+



-
+

-
-
-
+
+
+
+

-
-
+
+
+


-
+
+






-
+
+






-
+
+






-
+
+







# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2005-2006 Miguel Sofer
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.2
    namespace import -force ::tcltest::*
}

if {[info commands ::apply] eq {}} {
    return
}

testConstraint memory [llength [info commands memory]]


# Tests for wrong number of arguments

test apply-1.1 {not enough arguments} -returnCodes error -body {
    apply
} -result {wrong # args: should be "apply lambdaExpr ?arg ...?"}
test apply-1.1 {too few arguments} {
    set res [catch apply msg]
    list $res $msg
} {1 {wrong # args: should be "apply lambdaExpr ?arg1 arg2 ...?"}}

# Tests for malformed lambda

test apply-2.0 {malformed lambda} -returnCodes error -body {
test apply-2.0 {malformed lambda} {
    set lambda a
    apply $lambda
} -result {can't interpret "a" as a lambda expression}
test apply-2.1 {malformed lambda} -returnCodes error -body {
    set res [catch {apply $lambda} msg]
    list $res $msg
} {1 {can't interpret "a" as a lambda expression}}
test apply-2.1 {malformed lambda} {
    set lambda [list a b c d]
    apply $lambda
} -result {can't interpret "a b c d" as a lambda expression}
    set res [catch {apply $lambda} msg]
    list $res $msg
} {1 {can't interpret "a b c d" as a lambda expression}}
test apply-2.2 {malformed lambda} {
    set lambda [list {{}} boo]
    list [catch {apply $lambda} msg] $msg $::errorInfo
    set res [catch {apply $lambda} msg]
    list $res $msg $::errorInfo
} {1 {argument with no name} {argument with no name
    (parsing lambda expression "{{}} boo")
    invoked from within
"apply $lambda"}}
test apply-2.3 {malformed lambda} {
    set lambda [list {{a b c}} boo]
    list [catch {apply $lambda} msg] $msg $::errorInfo
    set res [catch {apply $lambda} msg]
    list $res $msg $::errorInfo
} {1 {too many fields in argument specifier "a b c"} {too many fields in argument specifier "a b c"
    (parsing lambda expression "{{a b c}} boo")
    invoked from within
"apply $lambda"}}
test apply-2.4 {malformed lambda} {
    set lambda [list a(1) boo]
    list [catch {apply $lambda} msg] $msg $::errorInfo
    set res [catch {apply $lambda} msg]
    list $res $msg $::errorInfo
} {1 {formal parameter "a(1)" is an array element} {formal parameter "a(1)" is an array element
    (parsing lambda expression "a(1) boo")
    invoked from within
"apply $lambda"}}
test apply-2.5 {malformed lambda} {
    set lambda [list a::b boo]
    list [catch {apply $lambda} msg] $msg $::errorInfo
    set res [catch {apply $lambda} msg]
    list $res $msg $::errorInfo
} {1 {formal parameter "a::b" is not a simple name} {formal parameter "a::b" is not a simple name
    (parsing lambda expression "a::b boo")
    invoked from within
"apply $lambda"}}

# Tests for runtime errors in the lambda expression

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
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







-
+

-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+















-
+
-
-
-
+
+







    namespace eval ::NONEXIST::FOR::SURE {}
    set lambda [list x {set x 1} NONEXIST::FOR::SURE]
    apply $lambda x
    namespace delete ::NONEXIST
    apply $lambda x
} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}

test apply-4.1 {error in arguments to lambda expression} -body {
test apply-4.1 {error in arguments to lambda expression} {
    set lambda [list x {set x 1}]
    apply $lambda
} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
test apply-4.2 {error in arguments to lambda expression} -body {
    set res [catch {apply $lambda} msg]
    list $res $msg
} {1 {wrong # args: should be "apply lambdaExpr x"}}
test apply-4.2 {error in arguments to lambda expression} {
    set lambda [list x {set x 1}]
    apply $lambda a b
} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
test apply-4.3 {error in arguments to lambda expression} -body {
    interp alias {} foo {} ::apply [list x {set x 1}]
    foo a b
    set res [catch {apply $lambda a b} msg]
    list $res $msg
} {1 {wrong # args: should be "apply lambdaExpr x"}}
test apply-4.3 {error in arguments to lambda expression} {
    set lambda [list x {set x 1}]
    interp alias {} foo {} ::apply $lambda
    set res [catch {foo a b} msg]
} -cleanup {
    rename foo {}
} -returnCodes error -result {wrong # args: should be "foo x"}
test apply-4.4 {error in arguments to lambda expression} -body {
    interp alias {} foo {} ::apply [list x {set x 1}] a
    foo b
    list $res $msg [rename foo {}]
} {1 {wrong # args: should be "foo x"} {}}
test apply-4.4 {error in arguments to lambda expression} {
    set lambda [list x {set x 1}]
    interp alias {} foo {} ::apply $lambda a
    set res [catch {foo b} msg]
} -cleanup {
    rename foo {}
} -returnCodes error -result {wrong # args: should be "foo"}
test apply-4.5 {error in arguments to lambda expression} -body {
    list $res $msg [rename foo {}]
} {1 {wrong # args: should be "foo"} {}}
test apply-4.5 {error in arguments to lambda expression} {
    set lambda [list x {set x 1}]
    namespace eval a {
	namespace ensemble create -command ::bar -map {id {::a::const foo}}
	proc const val { return $val }
	proc alias {object slot = command args} {
	    set map [namespace ensemble configure $object -map]
	    dict set map $slot [linsert $args 0 $command]
	    namespace ensemble configure $object -map $map
	}
	proc method {object name params body} {
	    set params [linsert $params 0 self]
	    alias $object $name = ::apply [list $params $body] $object
	}
	method ::bar boo x {return "[expr {$x*$x}] - $self"}
    }
    bar boo
    set res [catch {bar boo} msg]
} -cleanup {
    namespace delete ::a
} -returnCodes error -result {wrong # args: should be "bar boo x"}
    list $res $msg [namespace delete ::a]
} {1 {wrong # args: should be "bar boo x"} {}}

test apply-5.1 {runtime error in lambda expression} {
    set lambda [list {} {error foo}]
    set res [catch {apply $lambda}]
    list $res $::errorInfo
} {1 {foo
    while executing
224
225
226
227
228
229
230
231

232
233
234
235
236
237
238
232
233
234
235
236
237
238

239
240
241
242
243
244
245
246







-
+







test apply-8.2 {args treatment} {
    apply [list {x args} $applyBody] 1 2
} {{x 1} {args 2}}
test apply-8.3 {args treatment} {
    apply [list {x args} $applyBody] 1 2 3
} {{x 1} {args {2 3}}}
test apply-8.4 {default values} {
    apply [list {{x 1} {y 2}} $applyBody]
    apply [list {{x 1} {y 2}} $applyBody] 
} {{x 1} {y 2}}
test apply-8.5 {default values} {
    apply [list {{x 1} {y 2}} $applyBody] 3 4
} {{x 3} {y 4}}
test apply-8.6 {default values} {
    apply [list {{x 1} {y 2}} $applyBody] 3
} {{x 3} {y 2}}
303
304
305
306
307
308
309
310

311
312
313
314
315
316
317
318
319
320
321
311
312
313
314
315
316
317

318
319
320
321
322
323
324












-
+






-
-
-
-
-
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    rename getbytes {}
    unset -nocomplain end i x tmp leakedBytes
} -result 0

# Tests for the avoidance of recompilation


# cleanup

namespace delete testApply

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Deleted tests/assemble.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# assemble.test --
#
#	Test suite for the 'tcl::unsupported::assemble' command
#
# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
# Copyright (c) 2010 by Kevin B. Kenny.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#-----------------------------------------------------------------------------

# Commands covered: assemble

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
namespace eval tcl::unsupported {namespace export assemble}
namespace import tcl::unsupported::assemble

# Procedure to make code that fills the literal and local variable tables, to
# force instructions to spill to four bytes.

proc fillTables {} {
    set s {}
    set sep {}
    for {set i 0} {$i < 256} {incr i} {
	append s $sep [list set v$i literal$i]
	set sep \n
    }
    return $s
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}

# assemble-1 - TclNRAssembleObjCmd

test assemble-1.1 {wrong # args, direct eval} {
    -body {
	eval [list assemble]
    }
    -returnCodes error
    -result {wrong # args*}
    -match glob
}
test assemble-1.2 {wrong # args, direct eval} {
    -body {
	eval [list assemble too many]
    }
    -returnCodes error
    -result {wrong # args*}
    -match glob
}
test assemble-1.3 {error reporting, direct eval} {
    -body {
	list [catch {
	    eval [list assemble {
		# bad opcode
		rubbish
	    }]
	} result] $result $errorInfo
    }
    -match glob
    -result {1 {bad instruction "rubbish":*} {bad instruction "rubbish":*
    while executing
"rubbish"
    ("assemble" body, line 3)*}}
    -cleanup {unset result}
}
test assemble-1.4 {simple direct eval} {
    -body {
	eval [list assemble {push {this is a test}}]
    }
    -result {this is a test}
}

# assemble-2 - CompileAssembleObj

test assemble-2.1 {bytecode reuse, direct eval} {
    -body {
	set x {push "this is a test"}
	list [eval [list assemble $x]] \
	    [eval [list assemble $x]]
    }
    -result {{this is a test} {this is a test}}
}
test assemble-2.2 {bytecode discard, direct eval} {
    -body {
	set x {load value}
	proc p1 {x} {
	    set value value1
	    assemble $x
	}
	proc p2 {x} {
	    set a b
	    set value value2
	    assemble $x
	}
	list [p1 $x] [p2 $x]
    }
    -result {value1 value2}
    -cleanup {
	unset x
	rename p1 {}
	rename p2 {}
    }
}
test assemble-2.3 {null script, direct eval} {
    -body {
	set x {}
	assemble $x
    }
    -result {}
    -cleanup {unset x}
}

# assemble-3 - TclCompileAssembleCmd

test assemble-3.1 {wrong # args, compiled path} {
    -body {
	proc x {} {
	    assemble
	}
	x
    }
    -returnCodes error
    -match glob
    -result {wrong # args:*}
}
test assemble-3.2 {wrong # args, compiled path} {
    -body {
	proc x {} {
	    assemble too many
	}
	x
    }
    -returnCodes error
    -match glob
    -result {wrong # args:*}
    -cleanup {
	rename x {}
    }
}

# assemble-4 - TclAssembleCode mainline

test assemble-4.1 {syntax error} {
    -body {
	proc x {} {
	    assemble {
		{}extra
	    }
	}
	list [catch x result] $result $::errorInfo
    }
    -cleanup {
	rename x {}
	unset result
    }
    -match glob
    -result {1 {extra characters after close-brace} {extra characters after close-brace
    while executing
"{}e"
    ("assemble" body, line 2)*}}
}
test assemble-4.2 {null command} {
    -body {
	proc x {} {
	    assemble {
		push hello; pop;;push goodbye
	    }
	}
	x
    }
    -result goodbye
    -cleanup {
	rename x {}
    }
}

# assemble-5 - GetNextOperand off-nominal cases

test assemble-5.1 {unsupported expansion} {
    -body {
	proc x {y} {
	    assemble {
		{*}$y
	    }
	}
	list [catch {x {push hello}} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
    -cleanup {
	rename x {}
	unset result
    }
}
test assemble-5.2 {unsupported substitution} {
    -body {
	proc x {y} {
	    assemble {
		$y
	    }
	}
	list [catch {x {nop}} result] $result $::errorCode
    }
    -cleanup {
	rename x {}
	unset result
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}
test assemble-5.3 {unsupported substitution} {
    -body {
	proc x {} {
	    assemble {
		[x]
	    }
	}
	list [catch {x} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}
test assemble-5.4 {backslash substitution} {
    -body {
	proc x {} {
	    assemble {
		p\x75sh\
		    hello\ world
	    }
	}
	x
    }
    -cleanup {
	rename x {}
    }
    -result {hello world}
}

# assemble-6 - ASSEM_PUSH

test assemble-6.1 {push, wrong # args} {
    -body {
	assemble push
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-6.2 {push, wrong # args} {
    -body {
	assemble {push too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-6.3 {push} {
    -body {
	eval [list assemble {push hello}]
    }
    -result hello
}
test assemble-6.4 {push4} {
    -body {
	proc x {} "
            [fillTables]
            assemble {push hello}
        "
	x
    }
    -cleanup {
	rename x {}
    }
    -result hello
}

# assemble-7 - ASSEM_1BYTE

test assemble-7.1 {add, wrong # args} {
    -body {
	assemble {add excess}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-7.2 {add} {
    -body {
	assemble {
	    push 2
	    push 2
	    add
	}
    }
    -result {4}
}
test assemble-7.3 {appendArrayStk} {
    -body {
	set a(b) {hello, }
	assemble {
	    push a
	    push b
	    push world
	    appendArrayStk
	}
	set a(b)
    }
    -result {hello, world}
    -cleanup {unset a}
}
test assemble-7.4 {appendStk} {
    -body {
	set a {hello, }
	assemble {
	    push a
	    push world
	    appendStk
	}
	set a
    }
    -result {hello, world}
    -cleanup {unset a}
}
test assemble-7.5 {bitwise ops} {
    -body {
	list \
	    [assemble {push 0b1100; push 0b1010; bitand}] \
	    [assemble {push 0b1100; bitnot}] \
	    [assemble {push 0b1100; push 0b1010; bitor}] \
	    [assemble {push 0b1100; push 0b1010; bitxor}]
    }
    -result {8 -13 14 6}
}
test assemble-7.6 {div} {
    -body {
	assemble {push 999999; push 7; div}
    }
    -result 142857
}
test assemble-7.7 {dup} {
    -body {
	assemble {
	    push 1; dup; dup; add; dup; add; dup; add; add
	}
    }
    -result 9
}
test assemble-7.8 {eq} {
    -body {
	list \
	    [assemble {push able; push baker; eq}] \
	    [assemble {push able; push able;  eq}]
    }
    -result {0 1}
}
test assemble-7.9 {evalStk} {
    -body {
	assemble {
	    push {concat test 7.3}
	    evalStk
	}
    }
    -result {test 7.3}
}
test assemble-7.9a {evalStk, syntax} {
    -body {
	assemble {
	    push {{}bad}
	    evalStk
	}
    }
    -returnCodes error
    -result {extra characters after close-brace}
}
test assemble-7.9b {evalStk, backtrace} {
    -body {
	proc y {z} {
	    error testing
	}
	proc x {} {
	    assemble {
		push {
		    # test error in evalStk
		    y asd
		}
		evalStk
	    }
	}
	list [catch x result] $result $errorInfo
    }
    -result {1 testing {testing
    while executing
"error testing"
    (procedure "y" line 2)
    invoked from within
"y asd"*}}
    -match glob
    -cleanup {
	rename y {}
	rename x {}
    }
}
test assemble-7.10 {existArrayStk} {
    -body {
	proc x {name key} {
	    set a(b) c
	    assemble {
		load name; load key; existArrayStk
	    }
	}
	list [x a a] [x a b] [x b a] [x b b]
    }
    -result {0 1 0 0}
    -cleanup {rename x {}}
}
test assemble-7.11 {existStk} {
    -body {
	proc x {name} {
	    set a b
	    assemble {
		load name; existStk
	    }
	}
	list [x a] [x b]
    }
    -result {1 0}
    -cleanup {rename x {}}
}
test assemble-7.12 {expon} {
    -body {
	assemble {push 3; push 4; expon}
    }
    -result 81
}
test assemble-7.13 {exprStk} {
    -body {
	assemble {
	    push {acos(-1)}
	    exprStk
	}
    }
    -result 3.141592653589793
}
test assemble-7.13a {exprStk, syntax} {
    -body {
	assemble {
	    push {2+}
	    exprStk
	}
    }
    -returnCodes error
    -result {missing operand at _@_
in expression "2+_@_"}
}
test assemble-7.13b {exprStk, backtrace} {
    -body {
	proc y {z} {
	    error testing
	}
	proc x {} {
	    assemble {
		push {[y asd]}
		exprStk
	    }
	}
	list [catch x result] $result $errorInfo
    }
    -result {1 testing {testing
    while executing
"error testing"
    (procedure "y" line 2)
    invoked from within
"y asd"*}}
    -match glob
    -cleanup {
	rename y {}
	rename x {}
    }
}
test assemble-7.14 {ge gt le lt} {
    -body {
	proc x {a b} {
	    list [assemble {load a; load b; ge}] \
		[assemble {load a; load b; gt}] \
		[assemble {load a; load b; le}] \
		[assemble {load a; load b; lt}]
	}
	list [x 0 0] [x 0 1] [x 1 0]
    }
    -result {{1 0 1 0} {0 0 1 1} {1 1 0 0}}
    -cleanup {rename x {}}
}
test assemble-7.15 {incrArrayStk} {
    -body {
	proc x {} {
	    set a(b) 5
	    assemble {
		push a; push b; push 7; incrArrayStk
	    }
	}
	x
    }
    -result 12
    -cleanup {rename x {}}
}
test assemble-7.16 {incrStk} {
    -body {
	proc x {} {
	    set a 5
	    assemble {
		push a; push 7; incrStk
	    }
	}
	x
    }
    -result 12
    -cleanup {rename x {}}
}
test assemble-7.18 {lappendArrayStk} {
    -body {
	proc x {} {
	    set able(baker) charlie
	    assemble {
		push able
		push baker
		push dog
		lappendArrayStk
	    }
	}
	x
    }
    -result {charlie dog}
    -cleanup {rename x {}}
}
test assemble-7.19 {lappendStk} {
    -body {
	proc x {} {
	    set able baker
	    assemble {
		push able
		push charlie
		lappendStk
	    }
	}
	x
    }
    -result {baker charlie}
    -cleanup {rename x {}}
}
test assemble-7.20 {listIndex} {
    -body {
	assemble {
	    push {a b c d}
	    push 2
	    listIndex
	}
    }
    -result c
}
test assemble-7.21 {listLength} {
    -body {
	assemble {
	    push {a b c d}
	    listLength
	}
    }
    -result 4
}
test assemble-7.22 {loadArrayStk} {
    -body {
	proc x {} {
	    set able(baker) charlie
	    assemble {
		push able
		push baker
		loadArrayStk
	    }
	}
	x
    }
    -result charlie
    -cleanup {rename x {}}
}
test assemble-7.23 {loadStk} {
    -body {
	proc x {} {
	    set able baker
	    assemble {
		push able
		loadStk
	    }
	}
	x
    }
    -result baker
    -cleanup {rename x {}}
}
test assemble-7.24 {lsetList} {
    -body {
	proc x {} {
	    set l {{a b} {c d} {e f} {g h}}
	    assemble {
		push {2 1}; push i; load l; lsetList
	    }
	}
	x
    }
    -result {{a b} {c d} {e i} {g h}}
}
test assemble-7.25 {lshift} {
    -body {
	assemble {push 16; push 4; lshift}
    }
    -result 256
}
test assemble-7.26 {mod} {
    -body {
	assemble {push 123456; push 1000; mod}
    }
    -result 456
}
test assemble-7.27 {mult} {
    -body {
	assemble {push 12345679; push 9; mult}
    }
    -result 111111111
}
test assemble-7.28 {neq} {
    -body {
	list \
	    [assemble {push able; push baker; neq}] \
	    [assemble {push able; push able;  neq}]
    }
    -result {1 0}
}
test assemble-7.29 {not} {
    -body {
	list \
	    [assemble {push 17; not}] \
	    [assemble {push 0; not}]
    }
    -result {0 1}
}
test assemble-7.30 {pop} {
    -body {
	assemble {push this; pop; push that}
    }
    -result that
}
test assemble-7.31 {rshift} {
    -body {
	assemble {push 257; push 4; rshift}
    }
    -result 16
}
test assemble-7.32 {storeArrayStk} {
    -body {
	proc x {} {
	    assemble {
		push able; push baker; push charlie; storeArrayStk
	    }
	    array get able
	}
	x
    }
    -result {baker charlie}
    -cleanup {rename x {}}
}
test assemble-7.33 {storeStk} {
    -body {
	proc x {} {
	    assemble {
		push able; push baker; storeStk
	    }
	    set able
	}
	x
    }
    -result {baker}
    -cleanup {rename x {}}
}
test assemble-7,34 {strcmp} {
    -body {
	proc x {a b} {
	    assemble {
		load a; load b; strcmp
	    }
	}
	list [x able baker] [x baker able] [x baker baker]
    }
    -result {-1 1 0}
    -cleanup {rename x {}}
}
test assemble-7.35 {streq/strneq} {
    -body {
	proc x {a b} {
	    list \
		[assemble {load a; load b; streq}] \
		[assemble {load a; load b; strneq}]
	}
	list [x able able] [x able baker]
    }
    -result {{1 0} {0 1}}
    -cleanup {rename x {}}
}
test assemble-7.36 {strindex} {
    -body {
	assemble {push testing; push 4; strindex}
    }
    -result i
}
test assemble-7.37 {strlen} {
    -body {
	assemble {push testing; strlen}
    }
    -result 7
}
test assemble-7.38 {sub} {
    -body {
	assemble {push 42; push 17; sub}
    }
    -result 25
}
test assemble-7.39 {tryCvtToNumeric} {
    -body {
	assemble {
	    push 42; tryCvtToNumeric
	}
    }
    -result 42
}
# assemble-7.40 absent
test assemble-7.41 {uminus} {
    -body {
	assemble {
	    push 42; uminus
	}
    }
    -result -42
}
test assemble-7.42 {uplus} {
    -body {
	assemble {
	    push 42; uplus
	}
    }
    -result 42
}
test assemble-7.43 {uplus} {
    -body {
	assemble {
	    push NaN; uplus
	}
    }
    -returnCodes error
    -result {can't use non-numeric floating-point value "NaN" as operand of "+"}
}
test assemble-7.43.1 {tryCvtToNumeric} {
    -body {
	assemble {
	    push NaN; tryCvtToNumeric
	}
    }
    -returnCodes error
    -result {domain error: argument not in valid range}
}
test assemble-7.44 {listIn} {
    -body {
	assemble {
	    push b; push {a b c}; listIn
	}
    }
    -result 1
}
test assemble-7.45 {listNotIn} {
    -body {
	assemble {
	    push d; push {a b c}; listNotIn
	}
    }
    -result 1
}
test assemble-7.46 {nop} {
    -body {
	assemble { push x; nop; nop; nop}
    }
    -result x
}

# assemble-8 ASSEM_LVT and FindLocalVar

test assemble-8.1 {load, wrong # args} {
    -body {
	assemble load
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-8.2 {load, wrong # args} {
    -body {
	assemble {load too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-8.3 {nonlocal var} {
    -body {
	list [catch {assemble {load ::env}} result] $result $errorCode
    }
    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
    -cleanup {unset result}
}
test assemble-8.4 {bad context} {
    -body {
	set x 1
	list [catch {assemble {load x}} result] $result $errorCode
    }
    -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
    -cleanup {unset result}
}
test assemble-8.5 {bad context} {
    -body {
	namespace eval assem {
	    set x 1
	    assemble {load x}
	}
    }
    -result {cannot use this instruction to create a variable in a non-proc context}
    -errorCode {TCL ASSEM LVT}
    -cleanup {namespace delete assem}
}
test assemble-8.6 {load1} {
    -body {
	proc x {a} {
	    assemble {
		load a
	    }
	}
	x able
    }
    -result able
    -cleanup {rename x {}}
}
test assemble-8.7 {load4} {
    -body {
	proc x {a} "
	    [fillTables]
            set b \$a
            assemble {load b}
        "
	x able
    }
    -result able
    -cleanup {rename x {}}
}
test assemble-8.8 {loadArray1} {
    -body {
	proc x {} {
	    set able(baker) charlie
	    assemble {
		push baker
		loadArray able
	    }
	}
	x
    }
    -result charlie
    -cleanup {rename x {}}
}
test assemble-8.9 {loadArray4} {
    -body "
	proc x {} {
            [fillTables]
	    set able(baker) charlie
	    assemble {
		push baker
		loadArray able
	    }
	}
	x
    "
    -result charlie
    -cleanup {rename x {}}
}
test assemble-8.10 {append1} {
    -body {
	proc x {} {
	    set y {hello, }
	    assemble {
		push world; append y
	    }
	}
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.11 {append4} {
    -body {
	proc x {} "
            [fillTables]
	    set y {hello, }
	    assemble {
		push world; append y
	    }
	"
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.12 {appendArray1} {
    -body {
	proc x {} {
	    set y(z) {hello, }
	    assemble {
		push z; push world; appendArray y
	    }
	}
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.13 {appendArray4} {
    -body {
	proc x {} "
            [fillTables]
	    set y(z) {hello, }
	    assemble {
		push z; push world; appendArray y
	    }
	"
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.14 {lappend1} {
    -body {
	proc x {} {
	    set y {hello,}
	    assemble {
		push world; lappend y
	    }
	}
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.15 {lappend4} {
    -body {
	proc x {} "
            [fillTables]
	    set y {hello,}
	    assemble {
		push world; lappend y
	    }
	"
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.16 {lappendArray1} {
    -body {
	proc x {} {
	    set y(z) {hello,}
	    assemble {
		push z; push world; lappendArray y
	    }
	}
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.17 {lappendArray4} {
    -body {
	proc x {} "
            [fillTables]
	    set y(z) {hello,}
	    assemble {
		push z; push world; lappendArray y
	    }
	"
	x
    }
    -result {hello, world}
    -cleanup {rename x {}}
}
test assemble-8.18 {store1} {
    -body {
	proc x {} {
	    assemble {
		push test; store y
	    }
	    set y
	}
	x
    }
    -result {test}
    -cleanup {rename x {}}
}
test assemble-8.19 {store4} {
    -body {
	proc x {} "
            [fillTables]
	    assemble {
		push test; store y
	    }
            set y
	"
	x
    }
    -result test
    -cleanup {rename x {}}
}
test assemble-8.20 {storeArray1} {
    -body {
	proc x {} {
	    assemble {
		push z; push test; storeArray y
	    }
	    set y(z)
	}
	x
    }
    -result test
    -cleanup {rename x {}}
}
test assemble-8.21 {storeArray4} {
    -body {
	proc x {} "
            [fillTables]
	    assemble {
		push z; push test; storeArray y
	    }
	"
	x
    }
    -result test
    -cleanup {rename x {}}
}

# assemble-9 - ASSEM_CONCAT1, GetIntegerOperand, CheckOneByte

test assemble-9.1 {wrong # args} {
    -body {assemble concat}
    -result {wrong # args*}
    -match glob
    -returnCodes error
}
test assemble-9.2 {wrong # args} {
    -body {assemble {concat too many}}
    -result {wrong # args*}
    -match glob
    -returnCodes error
}
test assemble-9.3 {not a number} {
    -body {assemble {concat rubbish}}
    -result {expected integer but got "rubbish"}
    -returnCodes error
}
test assemble-9.4 {too small} {
    -body {assemble {concat -1}}
    -result {operand does not fit in one byte}
    -returnCodes error
}
test assemble-9.5 {too small} {
    -body {assemble {concat 256}}
    -result {operand does not fit in one byte}
    -returnCodes error
}
test assemble-9.6 {concat} {
    -body {
	assemble {push h; push e; push l; push l; push o; concat 5}
    }
    -result hello
}
test assemble-9.7 {concat} {
    -body {
	assemble {concat 0}
    }
    -result {operand must be positive}
    -errorCode {TCL ASSEM POSITIVE}
}

# assemble-10 -- eval and expr

test assemble-10.1 {eval - wrong # args} {
    -body {
	assemble {eval}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-10.2 {eval - wrong # args} {
    -body {
	assemble {eval too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-10.3 {eval} {
    -body {
	proc x {} {
	    assemble {
		push 3
		store n
		pop
		eval {expr {3*$n + 1}}
		push 1
		add
	    }
	}
	x
    }
    -result 11
    -cleanup {rename x {}}
}
test assemble-10.4 {expr} {
    -body {
	proc x {} {
	    assemble {
		push 3
		store n
		pop
		expr {3*$n + 1}
		push 1
		add
	    }
	}
	x
    }
    -result 11
    -cleanup {rename x {}}
}
test assemble-10.5 {eval and expr - nonsimple} {
    -body {
	proc x {} {
	    assemble {
		eval "s\x65t n 3"
		pop
		expr "\x33*\$n + 1"
		push 1
		add
	    }
	}
	x
    }
    -result 11
    -cleanup {
	rename x {}
    }
}
test assemble-10.6 {eval - noncompilable} {
    -body {
	list [catch {assemble {eval $x}} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}
test assemble-10.7 {expr - noncompilable} {
    -body {
	list [catch {assemble {expr $x}} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}

# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
#			    nsupvar, variable, upvar)

test assemble-11.1 {exist - wrong # args} {
    -body {
	assemble {exist}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-11.2 {exist - wrong # args} {
    -body {
	assemble {exist too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-11.3 {nonlocal var} {
    -body {
	list [catch {assemble {exist ::env}} result] $result $errorCode
    }
    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
    -cleanup {unset result}
}
test assemble-11.4 {exist} {
    -body {
	proc x {} {
	    set y z
	    list [assemble {exist y}] \
		[assemble {exist z}]
	}
	x
    }
    -result {1 0}
    -cleanup {rename x {}}
}
test assemble-11.5 {existArray} {
    -body {
	proc x {} {
	    set a(b) c
	    list [assemble {push b; existArray a}] \
		[assemble {push c; existArray a}] \
		[assemble {push a; existArray b}]
	}
	x
    }
    -result {1 0 0}
    -cleanup {rename x {}}
}
test assemble-11.6 {dictAppend} {
    -body {
	proc x {} {
	    set dict {a 1 b 2 c 3}
	    assemble {push b; push 22; dictAppend dict}
	}
	x
    }
    -result {a 1 b 222 c 3}
    -cleanup {rename x {}}
}
test assemble-11.7 {dictLappend} {
    -body {
	proc x {} {
	    set dict {a 1 b 2 c 3}
	    assemble {push b; push 2; dictLappend dict}
	}
	x
    }
    -result {a 1 b {2 2} c 3}
    -cleanup {rename x {}}
}
test assemble-11.8 {upvar} {
    -body {
	proc x {v} {
	    assemble {push 1; load v; upvar w; pop; load w}
	}
	proc y {} {
	    set z 123
	    x z
	}
	y
    }
    -result 123
    -cleanup {rename x {}; rename y {}}
}
test assemble-11.9 {nsupvar} {
    -body {
	namespace eval q { variable v 123 }
	proc x {} {
	    assemble {push q; push v; nsupvar y; pop; load y}
	}
	x
    }
    -result 123
    -cleanup {namespace delete q; rename x {}}
}
test assemble-11.10 {variable} {
    -body {
	namespace eval q { namespace eval r {variable v 123}}
	proc x {} {
	    assemble {push q::r::v; variable y; load y}
	}
	x
    }
    -result 123
    -cleanup {namespace delete q; rename x {}}
}

# assemble-12 - ASSEM_LVT1 (incr and incrArray)

test assemble-12.1 {incr - wrong # args} {
    -body {
	assemble {incr}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-12.2 {incr - wrong # args} {
    -body {
	assemble {incr too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-12.3 {incr nonlocal var} {
    -body {
	list [catch {assemble {incr ::env}} result] $result $errorCode
    }
    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
    -cleanup {unset result}
}
test assemble-12.4 {incr} {
    -body {
	proc x {} {
	    set y 5
	    assemble {push 3; incr y}
	}
	x
    }
    -result 8
    -cleanup {rename x {}}
}
test assemble-12.5 {incrArray} {
    -body {
	proc x {} {
	    set a(b) 5
	    assemble {push b; push 3; incrArray a}
	}
	x
    }
    -result 8
    -cleanup {rename x {}}
}
test assemble-12.6 {incr, stupid stack restriction} {
    -body {
	proc x {} "
	    [fillTables]
            set y 5
            assemble {push 3; incr y}
        "
	list [catch {x} result] $result $errorCode
    }
    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
    -cleanup {unset result; rename x {}}
}

# assemble-13 -- ASSEM_LVT1_SINT1 - incrImm and incrArrayImm

test assemble-13.1 {incrImm - wrong # args} {
    -body {
	assemble {incrImm x}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-13.2 {incrImm - wrong # args} {
    -body {
	assemble {incrImm too many args}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-13.3 {incrImm nonlocal var} {
    -body {
	list [catch {assemble {incrImm ::env 2}} result] $result $errorCode
    }
    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
    -cleanup {unset result}
}
test assemble-13.4 {incrImm not a number} {
    -body {
	proc x {} {
	    assemble {incrImm x rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-13.5 {incrImm too big} {
    -body {
	proc x {} {
	    assemble {incrImm x 0x80}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
    -cleanup {rename x {}; unset result}
}
test assemble-13.6 {incrImm too small} {
    -body {
	proc x {} {
	    assemble {incrImm x -0x81}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
    -cleanup {rename x {}; unset result}
}
test assemble-13.7 {incrImm} {
    -body {
	proc x {} {
	    set y 1
	    list [assemble {incrImm y -0x80}] [assemble {incrImm y 0x7f}]
	}
	x
    }
    -result {-127 0}
    -cleanup {rename x {}}
}
test assemble-13.8 {incrArrayImm} {
    -body {
	proc x {} {
	    set a(b) 5
	    assemble {push b; incrArrayImm a 3}
	}
	x
    }
    -result 8
    -cleanup {rename x {}}
}
test assemble-13.9 {incrImm, stupid stack restriction} {
    -body {
	proc x {} "
	    [fillTables]
            set y 5
            assemble {incrImm y 3}
        "
	list [catch {x} result] $result $errorCode
    }
    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
    -cleanup {unset result; rename x {}}
}

# assemble-14 -- ASSEM_SINT1 (incrArrayStkImm and incrStkImm)

test assemble-14.1 {incrStkImm - wrong # args} {
    -body {
	assemble {incrStkImm}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-14.2 {incrStkImm - wrong # args} {
    -body {
	assemble {incrStkImm too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-14.3 {incrStkImm not a number} {
    -body {
	proc x {} {
	    assemble {incrStkImm rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-14.4 {incrStkImm too big} {
    -body {
	proc x {} {
	    assemble {incrStkImm 0x80}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
    -cleanup {rename x {}; unset result}
}
test assemble-14.5 {incrStkImm too small} {
    -body {
	proc x {} {
	    assemble {incrStkImm -0x81}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
    -cleanup {rename x {}; unset result}
}
test assemble-14.6 {incrStkImm} {
    -body {
	proc x {} {
	    set y 1
	    list [assemble {push y; incrStkImm -0x80}] \
		[assemble {push y; incrStkImm 0x7f}]
	}
	x
    }
    -result {-127 0}
    -cleanup {rename x {}}
}
test assemble-14.7 {incrArrayStkImm} {
    -body {
	proc x {} {
	    set a(b) 5
	    assemble {push a; push b; incrArrayStkImm 3}
	}
	x
    }
    -result 8
    -cleanup {rename x {}}
}

# assemble-15 - listIndexImm

test assemble-15.1 {listIndexImm - wrong # args} -body {
    assemble {listIndexImm}
} -returnCodes error -match glob -result {wrong # args*}
test assemble-15.2 {listIndexImm - wrong # args} -body {
    assemble {listIndexImm too many}
} -returnCodes error -match glob -result {wrong # args*}
test assemble-15.3 {listIndexImm - bad substitution} -body {
    list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode
} -cleanup {
    unset result
} -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
test assemble-15.4 {listIndexImm - invalid index} -body {
    assemble {listIndexImm rubbish}
} -returnCodes error -match glob -result {bad index "rubbish"*}
test assemble-15.5 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm 2}
} -result c
test assemble-15.6 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm end-1}
} -result b
test assemble-15.7 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm end}
} -result c
test assemble-15.8 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm end+2}
} -result {}
test assemble-15.9 {listIndexImm} -body {
    assemble {push {a b c}; listIndexImm -1-1}
} -result {}

# assemble-16 - invokeStk

test assemble-16.1 {invokeStk - wrong # args} {
    -body {
	assemble {invokeStk}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-16.2 {invokeStk - wrong # args} {
    -body {
	assemble {invokeStk too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-16.3 {invokeStk - not a number} {
    -body {
	proc x {} {
	    assemble {invokeStk rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-16.4 {invokeStk - no operands} {
    -body {
	proc x {} {
	    assemble {invokeStk 0}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-16.5 {invokeStk1} {
    -body {
	tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3}
    }
    -result {1 2}
}
test assemble-16.6 {invokeStk4} {
    -body {
	proc x {n} {
	    set code {push concat}
	    set shouldbe {}
	    for {set i 1} {$i < $n} {incr i} {
		append code \n {push a} $i
		lappend shouldbe a$i
	    }
	    append code \n {invokeStk} { } $n
	    set is [assemble $code]
	    expr {$is eq $shouldbe}
	}
	list [x 254] [x 255] [x 256] [x 257]
    }
    -result {1 1 1 1}
    -cleanup {rename x {}}
}

# assemble-17 -- jumps and labels

test assemble-17.1 {label, wrong # args} {
    -body {
	assemble {label}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-17.2 {label, wrong # args} {
    -body {
	assemble {label too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-17.3 {label, bad subst} {
    -body {
	list [catch {assemble {label $foo}} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
    -cleanup {unset result}
}
test assemble-17.4 {duplicate label} {
    -body {
	list [catch {assemble {label foo; label foo}} result] \
	    $result $::errorCode
    }
    -result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}}
}
test assemble-17.5 {jump, wrong # args} {
    -body {
	assemble {jump}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-17.6 {jump, wrong # args} {
    -body {
	assemble {jump too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-17.7 {jump, bad subst} {
    -body {
	list [catch {assemble {jump $foo}} result] $result $::errorCode
    }
    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
    -cleanup {unset result}
}
test assemble-17.8 {jump - ahead and back} {
    -body {
	assemble {
	    jump three

	    label one
	    push a
	    jump four

	    label two
	    push b
	    jump six

	    label three
	    push c
	    jump five

	    label four
	    push d
	    jump two

	    label five
	    push e
	    jump one

	    label six
	    push f
	    concat 6
	}
    }
    -result ceadbf
}
test assemble-17.9 {jump - resolve a label multiple times} {
    -body {
	proc x {} {
	    set case 0
	    set result {}
	    assemble {
		jump common

		label zero
		pop
		incrImm case 1
		pop
		push a
		append result
		pop
		jump common

		label one
		pop
		incrImm case 1
		pop
		push b
		append result
		pop
		jump common

		label common
		load case
		dup
		push 0
		eq
		jumpTrue zero
		dup
		push 1
		eq
		jumpTrue one
		dup
		push 2
		eq
		jumpTrue two
		dup
		push 3
		eq
		jumpTrue three

		label two
		pop
		incrImm case 1
		pop
		push c
		append result
		pop
		jump common

		label three
		pop
		incrImm case 1
		pop
		push d
		append result
	    }
	}
	x
    }
    -result abcd
    -cleanup {rename x {}}
}
test assemble-17.10 {jump4 needed} {
    -body {
	assemble "push x; jump one; label two; [string repeat {dup; pop;} 128]
	      jump three; label one; jump two; label three"
    }
    -result x
}
test assemble-17.11 {jumpTrue} {
    -body {
	proc x {y} {
	    assemble {
		load y
		jumpTrue then
		push no
		jump else
		label then
		push yes
		label else
	    }
	}
	list [x 0] [x 1]
    }
    -result {no yes}
    -cleanup {rename x {}}
}
test assemble-17.12 {jumpFalse} {
    -body {
	proc x {y} {
	    assemble {
		load y
		jumpFalse then
		push no
		jump else
		label then
		push yes
		label else
	    }
	}
	list [x 0] [x 1]
    }
    -result {yes no}
    -cleanup {rename x {}}
}
test assemble-17.13 {jump to undefined label} {
    -body {
	list [catch {assemble {jump nowhere}} result] $result $::errorCode
    }
    -result {1 {undefined label "nowhere"} {TCL ASSEM NOLABEL nowhere}}
}
test assemble-17.14 {jump to undefined label, line number correct?} {
    -body {
	catch {assemble {#1
	    #2
	    #3
	    jump nowhere
	    #5
	    #6
	}}
	set ::errorInfo
    }
    -match glob
    -result {*"assemble" body, line 4*}
}
test assemble-17.15 {multiple passes of code resizing} {
    -setup {
	set body {
	    push -
	}
	for {set i 0} {$i < 14} {incr i} {
	    append body "label a" $i \
		"; push a; concat 2; nop; nop; jump b" \
		$i \n
	}
	append body {label a14; push a; concat 2; push 1; jumpTrue b14} \n
	append body {label a15; push a; concat 2; push 0; jumpFalse b15} \n
	for {set i 0} {$i < 15} {incr i} {
	    append body "label b" $i \
		"; push b; concat 2; nop; nop; jump a" \
		[expr {$i+1}] \n
	}
	append body {label c; push -; concat 2; nop; nop; nop; jump d} \n
	append body {label b15; push b; concat 2; nop; nop; jump c} \n
	append body {label d}
	proc x {} [list assemble $body]
    }
    -body {
	x
    }
    -cleanup {
	catch {unset body}
	catch {rename x {}}
    }
    -result -abababababababababababababababab-
}

# assemble-18 - lindexMulti

test assemble-18.1 {lindexMulti - wrong # args} {
    -body {
	assemble {lindexMulti}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-18.2 {lindexMulti - wrong # args} {
    -body {
	assemble {lindexMulti too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-18.3 {lindexMulti - bad subst} {
    -body {
	assemble {lindexMulti $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-18.4 {lindexMulti - not a number} {
    -body {
	proc x {} {
	    assemble {lindexMulti rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-18.5 {lindexMulti - bad operand count} {
    -body {
	proc x {} {
	    assemble {lindexMulti 0}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-18.6 {lindexMulti} {
    -body {
	assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1}
    }
    -result {{a b c} {d e f} {g h j}}
}
test assemble-18.7 {lindexMulti} {
    -body {
	assemble {push {{a b c} {d e f} {g h j}}; push 1; lindexMulti 2}
    }
    -result {d e f}
}
test assemble-18.8 {lindexMulti} {
    -body {
	assemble {push {{a b c} {d e f} {g h j}}; push 2; push 1; lindexMulti 3}
    }
    -result h
}

# assemble-19 - list

test assemble-19.1 {list - wrong # args} {
    -body {
	assemble {list}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-19.2 {list - wrong # args} {
    -body {
	assemble {list too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-19.3 {list - bad subst} {
    -body {
	assemble {list $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-19.4 {list - not a number} {
    -body {
	proc x {} {
	    assemble {list rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-19.5 {list - negative operand count} {
    -body {
	proc x {} {
	    assemble {list -1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-19.6 {list - no args} {
    -body {
	assemble {list 0}
    }
    -result {}
}
test assemble-19.7 {list - 1 arg} {
    -body {
	assemble {push hello; list 1}
    }
    -result hello
}
test assemble-19.8 {list - 2 args} {
    -body {
	assemble {push hello; push world; list 2}
    }
    -result {hello world}
}

# assemble-20 - lsetFlat

test assemble-20.1 {lsetFlat - wrong # args} {
    -body {
	assemble {lsetFlat}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-20.2 {lsetFlat - wrong # args} {
    -body {
	assemble {lsetFlat too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-20.3 {lsetFlat - bad subst} {
    -body {
	assemble {lsetFlat $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-20.4 {lsetFlat - not a number} {
    -body {
	proc x {} {
	    assemble {lsetFlat rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-20.5 {lsetFlat - negative operand count} {
    -body {
	proc x {} {
	    assemble {lsetFlat 1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}}
    -cleanup {rename x {}; unset result}
}
test assemble-20.6 {lsetFlat} {
    -body {
	assemble {push b; push a; lsetFlat 2}
    }
    -result b
}
test assemble-20.7 {lsetFlat} {
    -body {
	assemble {push 1; push d; push {a b c}; lsetFlat 3}
    }
    -result {a d c}
}

# assemble-21 - over

test assemble-21.1 {over - wrong # args} {
    -body {
	assemble {over}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-21.2 {over - wrong # args} {
    -body {
	assemble {over too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-21.3 {over - bad subst} {
    -body {
	assemble {over $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-21.4 {over - not a number} {
    -body {
	proc x {} {
	    assemble {over rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-21.5 {over - negative operand count} {
    -body {
	proc x {} {
	    assemble {over -1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-21.6 {over} {
    -body {
	proc x {} {
	    assemble {
		push 1
		push 2
		push 3
		over 0
		store x
		pop
		pop
		pop
		pop
		load x
	    }
	}
	x
    }
    -result 3
    -cleanup {rename x {}}
}
test assemble-21.7 {over} {
    -body {
	proc x {} {
	    assemble {
		push 1
		push 2
		push 3
		over 2
		store x
		pop
		pop
		pop
		pop
		load x
	    }
	}
	x
    }
    -result 1
    -cleanup {rename x {}}
}

# assemble-22 - reverse

test assemble-22.1 {reverse - wrong # args} {
    -body {
	assemble {reverse}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-22.2 {reverse - wrong # args} {
    -body {
	assemble {reverse too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}

test assemble-22.3 {reverse - bad subst} {
    -body {
	assemble {reverse $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}

test assemble-22.4 {reverse - not a number} {
    -body {
	proc x {} {
	    assemble {reverse rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-22.5 {reverse - negative operand count} {
    -body {
	proc x {} {
	    assemble {reverse -1}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-22.6 {reverse - zero operand count} {
    -body {
	proc x {} {
	    assemble {push 1; reverse 0}
	}
	x
    }
    -result 1
    -cleanup {rename x {}}
}
test assemble-22.7 {reverse} {
    -body {
	proc x {} {
	    assemble {
		push 1
		push 2
		push 3
		reverse 1
		store x
		pop
		pop
		pop
		load x
	    }
	}
	x
    }
    -result 3
    -cleanup {rename x {}}
}
test assemble-22.8 {reverse} {
    -body {
	proc x {} {
	    assemble {
		push 1
		push 2
		push 3
		reverse 3
		store x
		pop
		pop
		pop
		load x
	    }
	}
	x
    }
    -result 1
    -cleanup {rename x {}}
}

# assemble-23 - ASSEM_BOOL (strmatch, unsetStk, unsetArrayStk)

test assemble-23.1 {strmatch - wrong # args} {
    -body {
	assemble {strmatch}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-23.2 {strmatch - wrong # args} {
    -body {
	assemble {strmatch too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-23.3 {strmatch - bad subst} {
    -body {
	assemble {strmatch $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-23.4 {strmatch - not a boolean} {
    -body {
	proc x {} {
	    assemble {strmatch rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected boolean value but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-23.5 {strmatch} {
    -body {
	proc x {a b} {
	    list [assemble {load a; load b; strmatch 0}] \
		[assemble {load a; load b; strmatch 1}]
	}
	list [x foo*.grill fengbar.grill] [x foo*.grill foobar.grill] [x foo*.grill FOOBAR.GRILL]
    }
    -result {{0 0} {1 1} {0 1}}
    -cleanup {rename x {}}
}
test assemble-23.6 {unsetStk} {
    -body {
	proc x {} {
	    set a {}
	    assemble {push a; unsetStk false}
	    info exists a
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-23.7 {unsetStk} {
    -body {
	proc x {} {
	    assemble {push a; unsetStk false}
	    info exists a
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-23.8 {unsetStk} {
    -body {
	proc x {} {
	    assemble {push a; unsetStk true}
	    info exists a
	}
	x
    }
    -returnCodes error
    -result {can't unset "a": no such variable}
    -cleanup {rename x {}}
}
test assemble-23.9 {unsetArrayStk} {
    -body {
	proc x {} {
	    set a(b) {}
	    assemble {push a; push b; unsetArrayStk false}
	    info exists a(b)
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-23.10 {unsetArrayStk} {
    -body {
	proc x {} {
	    assemble {push a; push b; unsetArrayStk false}
	    info exists a(b)
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-23.11 {unsetArrayStk} {
    -body {
	proc x {} {
	    assemble {push a; push b; unsetArrayStk true}
	    info exists a(b)
	}
	x
    }
    -returnCodes error
    -result {can't unset "a(b)": no such variable}
    -cleanup {rename x {}}
}

# assemble-24 -- ASSEM_BOOL_LVT4 (unset; unsetArray)

test assemble-24.1 {unset - wrong # args} {
    -body {
	assemble {unset one}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-24.2 {unset - wrong # args} {
    -body {
	assemble {unset too many args}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-24.3 {unset - bad subst -arg 1} {
    -body {
	assemble {unset $foo bar}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-24.4 {unset - not a boolean} {
    -body {
	proc x {} {
	    assemble {unset rubbish trash}
	}
	x
    }
    -returnCodes error
    -result {expected boolean value but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-24.5 {unset - bad subst - arg 2} {
    -body {
	assemble {unset true $bar}
    }
    -returnCodes error
    -result {assembly code may not contain substitutions}
}
test assemble-24.6 {unset - nonlocal var} {
    -body {
	assemble {unset true ::foo::bar}
    }
    -returnCodes error
    -result {variable "::foo::bar" is not local}
}
test assemble-24.7 {unset} {
    -body {
	proc x {} {
	    set a {}
	    assemble {unset false a}
	    info exists a
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-24.8 {unset} {
    -body {
	proc x {} {
	    assemble {unset false a}
	    info exists a
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-24.9 {unset} {
    -body {
	proc x {} {
	    assemble {unset true a}
	    info exists a
	}
	x
    }
    -returnCodes error
    -result {can't unset "a": no such variable}
    -cleanup {rename x {}}
}
test assemble-24.10 {unsetArray} {
    -body {
	proc x {} {
	    set a(b) {}
	    assemble {push b; unsetArray false a}
	    info exists a(b)
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-24.11 {unsetArray} {
    -body {
	proc x {} {
	    assemble {push b; unsetArray false a}
	    info exists a(b)
	}
	x
    }
    -result 0
    -cleanup {rename x {}}
}
test assemble-24.12 {unsetArray} {
    -body {
	proc x {} {
	    assemble {push b; unsetArray true a}
	    info exists a(b)
	}
	x
    }
    -returnCodes error
    -result {can't unset "a(b)": no such variable}
    -cleanup {rename x {}}
}

# assemble-25 - dict get

test assemble-25.1 {dict get - wrong # args} {
    -body {
	assemble {dictGet}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-25.2 {dict get - wrong # args} {
    -body {
	assemble {dictGet too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-25.3 {dictGet - bad subst} {
    -body {
	assemble {dictGet $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-25.4 {dict get - not a number} {
    -body {
	proc x {} {
	    assemble {dictGet rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-25.5 {dictGet - negative operand count} {
    -body {
	proc x {} {
	    assemble {dictGet 0}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-25.6 {dictGet - 1 index} {
    -body {
	assemble {push {a 1 b 2}; push a; dictGet 1}
    }
    -result 1
}

# assemble-26 - dict set

test assemble-26.1 {dict set - wrong # args} {
    -body {
	assemble {dictSet 1}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-26.2 {dict get - wrong # args} {
    -body {
	assemble {dictSet too many args}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-26.3 {dictSet - bad subst} {
    -body {
	assemble {dictSet 1 $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-26.4 {dictSet - not a number} {
    -body {
	proc x {} {
	    assemble {dictSet rubbish foo}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-26.5 {dictSet - zero operand count} {
    -body {
	proc x {} {
	    assemble {dictSet 0 foo}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-26.6 {dictSet - bad local} {
    -body {
	proc x {} {
	    assemble {dictSet 1 ::foo::bar}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
    -cleanup {rename x {}; unset result}
}
test assemble-26.7 {dictSet} {
    -body {
	proc x {} {
	    set dict {a 1 b 2 c 3}
	    assemble {push b; push 4; dictSet 1 dict}
	}
	x
    }
    -result {a 1 b 4 c 3}
    -cleanup {rename x {}}
}

# assemble-27 - dictUnset

test assemble-27.1 {dictUnset - wrong # args} {
    -body {
	assemble {dictUnset 1}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-27.2 {dictUnset - wrong # args} {
    -body {
	assemble {dictUnset too many args}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-27.3 {dictUnset - bad subst} {
    -body {
	assemble {dictUnset 1 $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-27.4 {dictUnset - not a number} {
    -body {
	proc x {} {
	    assemble {dictUnset rubbish foo}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-27.5 {dictUnset - zero operand count} {
    -body {
	proc x {} {
	    assemble {dictUnset 0 foo}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
    -cleanup {rename x {}; unset result}
}
test assemble-27.6 {dictUnset - bad local} {
    -body {
	proc x {} {
	    assemble {dictUnset 1 ::foo::bar}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
    -cleanup {rename x {}; unset result}
}
test assemble-27.7 {dictUnset} {
    -body {
	proc x {} {
	    set dict {a 1 b 2 c 3}
	    assemble {push b; dictUnset 1 dict}
	}
	x
    }
    -result {a 1 c 3}
    -cleanup {rename x {}}
}

# assemble-28 - dictIncrImm

test assemble-28.1 {dictIncrImm - wrong # args} {
    -body {
	assemble {dictIncrImm 1}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-28.2 {dictIncrImm - wrong # args} {
    -body {
	assemble {dictIncrImm too many args}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-28.3 {dictIncrImm - bad subst} {
    -body {
	assemble {dictIncrImm 1 $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-28.4 {dictIncrImm - not a number} {
    -body {
	proc x {} {
	    assemble {dictIncrImm rubbish foo}
	}
	x
    }
    -returnCodes error
    -result {expected integer but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-28.5 {dictIncrImm - bad local} {
    -body {
	proc x {} {
	    assemble {dictIncrImm 1 ::foo::bar}
	}
	list [catch x result] $result $::errorCode
    }
    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
    -cleanup {rename x {}; unset result}
}
test assemble-28.6 {dictIncrImm} {
    -body {
	proc x {} {
	    set dict {a 1 b 2 c 3}
	    assemble {push b; dictIncrImm 42 dict}
	}
	x
    }
    -result {a 1 b 44 c 3}
    -cleanup {rename x {}}
}

# assemble-29 - ASSEM_REGEXP

test assemble-29.1 {regexp - wrong # args} {
    -body {
	assemble {regexp}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-29.2 {regexp - wrong # args} {
    -body {
	assemble {regexp too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-29.3 {regexp - bad subst} {
    -body {
	assemble {regexp $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-29.4 {regexp - not a boolean} {
    -body {
	proc x {} {
	    assemble {regexp rubbish}
	}
	x
    }
    -returnCodes error
    -result {expected boolean value but got "rubbish"}
    -cleanup {rename x {}}
}
test assemble-29.5 {regexp} {
    -body {
	assemble {push br.*br; push abracadabra; regexp false}
    }
    -result 1
}
test assemble-29.6 {regexp} {
    -body {
	assemble {push br.*br; push aBRacadabra; regexp false}
    }
    -result 0
}
test assemble-29.7 {regexp} {
    -body {
	assemble {push br.*br; push aBRacadabra; regexp true}
    }
    -result 1
}

# assemble-30 - Catches

test assemble-30.1 {simplest possible catch} {
    -body {
	proc x {} {
	    assemble {
		beginCatch @bad
		push error
		push testing
		invokeStk 2
		pop
		push 0
		jump @ok
		label @bad
		push 1; # should be pushReturnCode
		label @ok
		endCatch
	    }
	}
	x
    }
    -result 1
    -cleanup {rename x {}}
}
test assemble-30.2 {catch in external catch conntext} {
    -body {
	proc x {} {
	    list [catch {
		assemble {
		    beginCatch @bad
		    push error
		    push testing
		    invokeStk 2
		    pop
		    push 0
		    jump @ok
		    label @bad
		    pushReturnCode
		    label @ok
		    endCatch
		}
	    } result] $result
	}
	x
    }
    -result {0 1}
    -cleanup {rename x {}}
}
test assemble-30.3 {embedded catches} {
    -body {
	proc x {} {
	    list [catch {
		assemble {
		    beginCatch @bad
		    push error
		    eval { list [catch {error whatever} result] $result }
		    invokeStk 2
		    push 0
		    reverse 2
		    jump @done
		    label @bad
		    pushReturnCode
		    pushResult
		    label @done
		    endCatch
		    list 2
		}
	    } result2] $result2
	}
	x
    }
    -result {0 {1 {1 whatever}}}
    -cleanup {rename x {}}
}
test assemble-30.4 {throw in wrong context} {
    -body {
	proc x {} {
	    list [catch {
		assemble {
		    beginCatch @bad
		    push error
		    eval { list [catch {error whatever} result] $result }
		    invokeStk 2
		    push 0
		    reverse 2
		    jump @done

		    label @bad
		    load x
		    pushResult

		    label @done
		    endCatch
		    list 2
		}
	    } result] $result $::errorCode [split $::errorInfo \n]
	}
	x
    }
    -match glob
    -result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {    in assembly code between lines 10 and 15}*}}
    -cleanup {rename x {}}
}
test assemble-30.5 {unclosed catch} {
    -body {
	proc x {} {
	    assemble {
		beginCatch @error
		push 0
		jump @done
		label @error
		push 1
		label @done
		push ""
		pop
	    }
	}
	list [catch {x} result] $result $::errorCode $::errorInfo
    }
    -match glob
    -result {1 {catch still active on exit from assembly code} {TCL ASSEM UNCLOSEDCATCH} {catch still active on exit from assembly code
    ("assemble" body, line 2)*}}
    -cleanup {rename x {}}
}
test assemble-30.6 {inconsistent catch contexts} {
    -body {
	proc x {y} {
	    assemble {
		load y
		jumpTrue @inblock
		beginCatch @error
		label @inblock
		push 0
		jump @done
		label @error
		push 1
		label @done
	    }
	}
	list [catch {x 2} result] $::errorCode $::errorInfo
    }
    -match glob
    -result {1 {TCL ASSEM BADCATCH} {execution reaches an instruction in inconsistent exception contexts
    ("assemble" body, line 5)*}}
    -cleanup {rename x {}}
}

# assemble-31 - Jump tables

test assemble-31.1 {jumpTable, wrong # args} {
    -body {
	assemble {jumpTable}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-31.2 {jumpTable, wrong # args} {
    -body {
	assemble {jumpTable too many}
    }
    -returnCodes error
    -match glob
    -result {wrong # args*}
}
test assemble-31.3 {jumpTable - bad subst} {
    -body {
	assemble {jumpTable $foo}
    }
    -returnCodes error
    -match glob
    -result {assembly code may not contain substitutions}
}
test assemble-31.4 {jumptable - not a list} {
    -body {
	assemble {jumpTable \{rubbish}
    }
    -returnCodes error
    -result {unmatched open brace in list}
}
test assemble-31.5 {jumpTable, badly structured} {
    -body {
	list [catch {assemble {
	    # line 2
	    jumpTable {one two three};# line 3
	}} result] \
	    $result $::errorCode $::errorInfo
    }
    -match glob
    -result {1 {jump table must have an even number of list elements} {TCL ASSEM BADJUMPTABLE} {jump table must have an even number of list elements*("assemble" body, line 3)*}}
}
test assemble-31.6 {jumpTable, missing symbol} {
    -body {
	list [catch {assemble {
	    # line 2
	    jumpTable {1 a};# line 3
	}} result] \
	    $result $::errorCode $::errorInfo
    }
    -match glob
    -result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}}
}
test assemble-31.7 {jumptable, actual example} {
    -setup {
	proc x {} {
	    set result {}
	    for {set i 0} {$i < 5} {incr i} {
		lappend result [assemble {
		    load i
		    jumpTable {1 @one 2 @two 3 @three}
		    push {none of the above}
		    jump @done
		    label @one
		    push one
		    jump @done
		    label @two
		    push two
		    jump @done
		    label @three
		    push three
		    label @done
		}]
	    }
	    set tcl_traceCompile 2
	    set result
	}
    }
    -body x
    -result {{none of the above} one two three {none of the above}}
    -cleanup {set tcl_traceCompile 0; rename x {}}
}

test assemble-40.1 {unbalanced stack} {
    -body {
	list \
	    [catch {
		assemble {
		    push 3
		    dup
		    mult
		    push 4
		    dup
		    mult
		    pop
		    expon
		}
	    } result] $result $::errorInfo
    }
    -result {1 {stack underflow} {stack underflow
    in assembly code between lines 1 and end of assembly code*}}
    -match glob
   -returnCodes ok
}
test assemble-40.2 {unbalanced stack} {*}{
    -body {
	list \
	    [catch {
		assemble {
		    label a
		    push {}
		    label b
		    pop
		    label c
		    pop
		    label d
		    push {}
		}
	    } result] $result $::errorInfo
    }
    -result {1 {stack underflow} {stack underflow
    in assembly code between lines 7 and 9*}}
    -match glob
   -returnCodes ok
}

test assemble-41.1 {Inconsistent stack usage} {*}{
    -body {
	proc x {y} {
	    assemble {
		load y
		jumpFalse else
		push 0
		jump then
	      label else
		push 1
		push 2
	      label then
		pop
	    }
	}
	catch {x 1}
	set errorInfo
    }
    -match glob
    -result {inconsistent stack depths on two execution paths
    ("assemble" body, line 10)*}
}
test assemble-41.2 {Inconsistent stack, jumptable and default} {
    -body {
	proc x {y} {
	    assemble {
		load y
		jumpTable {0 else}
		push 0
	      label else
		pop
	    }
	}
	catch {x 1}
	set errorInfo
    }
    -match glob
    -result {inconsistent stack depths on two execution paths
    ("assemble" body, line 6)*}
}
test assemble-41.3 {Inconsistent stack, two legs of jumptable} {
    -body {
	proc x {y} {
	    assemble {
		load y
		jumpTable {0 no 1 yes}
		label no
		push 0
		label yes
		pop
	    }
	}
	catch {x 1}
	set errorInfo
    }
    -match glob
    -result {inconsistent stack depths on two execution paths
    ("assemble" body, line 7)*}
}

test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
    -body {
	proc ulam {n} {
	    assemble {
		load n;		# max
		dup;		# max n
		jump start;     # max n

		label loop;	# max n
		over 1;         # max n max
		over 1;		# max in max n
		ge;             # man n max>=n
		jumpTrue skip;  # max n

		reverse 2;      # n max
		pop;            # n
		dup;            # n n

		label skip;	# max n
		dup;            # max n n
		push 2;         # max n n 2
		mod;            # max n n%2
		jumpTrue odd;   # max n

		push 2;         # max n 2
		div;            # max n/2 -> max n
		jump start;     # max n

		label odd;	# max n
		push 3;         # max n 3
		mult;           # max 3*n
		push 1;         # max 3*n 1
		add;            # max 3*n+1

		label start;	# max n
		dup;		# max n n
		push 1;		# max n n 1
		neq;		# max n n>1
		jumpTrue loop;	# max n

		pop;		# max
	    }
	}
	set result {}
	for {set i 1} {$i < 30} {incr i} {
	    lappend result [ulam $i]
	}
	set result
    }
    -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
}

test assemble-51.1 {memory leak testing} memory {
    leaktest {
	apply {{} {assemble {push hello}}}
    }
} 0
test assemble-51.2 {memory leak testing} memory {
    leaktest {
	apply {{{x 0}} {assemble {incrImm x 1}}}
    }
} 0
test assemble-51.3 {memory leak testing} memory {
    leaktest {
	apply {{n} {
	    assemble {
		load n;		# max
		dup;		# max n
		jump start;     # max n

		label loop;	# max n
		over 1;         # max n max
		over 1;		# max in max n
		ge;             # man n max>=n
		jumpTrue skip;  # max n

		reverse 2;      # n max
		pop;            # n
		dup;            # n n

		label skip;	# max n
		dup;            # max n n
		push 2;         # max n n 2
		mod;            # max n n%2
		jumpTrue odd;   # max n

		push 2;         # max n 2
		div;            # max n/2 -> max n
		jump start;     # max n

		label odd;	# max n
		push 3;         # max n 3
		mult;           # max 3*n
		push 1;         # max 3*n 1
		add;            # max 3*n+1

		label start;	# max n
		dup;		# max n n
		push 1;		# max n n 1
		neq;		# max n n>1
		jumpTrue loop;	# max n

		pop;		# max
	    }
	}} 1
    }
} 0
test assemble-51.4 {memory leak testing} memory {
    leaktest {
	catch {
	    apply {{} {
		assemble {reverse polish notation}
	    }}
	}
    }
} 0

test assemble-52.1 {Bug 3154ea2759} {
    apply {{} {
	# Needs six exception ranges to force the range allocations to use the
	# malloced store.
	::tcl::unsupported::assemble {
	    beginCatch @badLabel
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel
	    label @badLabel
	    push 1;		# should be pushReturnCode
	    label @okLabel
	    endCatch
	    pop

	    beginCatch @badLabel2
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel2
	    label @badLabel2
	    push 1;		# should be pushReturnCode
	    label @okLabel2
	    endCatch
	    pop

	    beginCatch @badLabel3
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel3
	    label @badLabel3
	    push 1;		# should be pushReturnCode
	    label @okLabel3
	    endCatch
	    pop

	    beginCatch @badLabel4
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel4
	    label @badLabel4
	    push 1;		# should be pushReturnCode
	    label @okLabel4
	    endCatch
	    pop

	    beginCatch @badLabel5
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel5
	    label @badLabel5
	    push 1;		# should be pushReturnCode
	    label @okLabel5
	    endCatch
	    pop

	    beginCatch @badLabel6
	    push error
	    push testing
	    invokeStk 2
	    pop
	    push 0
	    jump @okLabel6
	    label @badLabel6
	    push 1;		# should be pushReturnCode
	    label @okLabel6
	    endCatch
	    pop
	}
    }}
} {};				# must not crash

rename fillTables {}
rename assemble {}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Deleted tests/assemble1.bench.

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




















































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
proc ulam1 {n} {
    set max $n
    while {$n != 1} {
	if {$n > $max} {
	    set max $n
	}
	if {$n % 2} {
	    set n [expr {3 * $n + 1}]
	} else {
	    set n [expr {$n / 2}]
	}
    }
    return $max
}

set tcl_traceCompile 2; ulam1 1; set tcl_traceCompile 0

proc ulam2 {n} {
    tcl::unsupported::assemble {
	load n;		# max
	dup;		# max n
	jump start;     # max n

	label loop;	# max n
	over 1;         # max n max
	over 1;		# max in max n
	ge;             # man n max>=n
	jumpTrue skip;  # max n

	reverse 2;      # n max
	pop;            # n
	dup;            # n n

	label skip;	# max n
	dup;            # max n n
	push 2;         # max n n 2
	mod;            # max n n%2
	jumpTrue odd;   # max n

	push 2;         # max n 2
	div;            # max n/2 -> max n
	jump start;     # max n

	label odd;	# max n
	push 3;         # max n 3
	mult;           # max 3*n
	push 1;         # max 3*n 1
	add;            # max 3*n+1

	label start;	# max n
	dup;		# max n n
	push 1;		# max n n 1
	neq;		# max n n>1
	jumpTrue loop;	# max n

	pop;		# max
    }
}
set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0

proc test1 {n} {
    for {set i 1} {$i <= $n} {incr i} {
	ulam1 $i
    }
}
proc test2 {n} {
    for {set i 1} {$i <= $n} {incr i} {
	ulam2 $i
    }
}

for {set j 0} {$j < 10} {incr j} {
    test1 1
    set before [clock microseconds]
    test1 30000
    set after [clock microseconds]
    puts "compiled: [expr {1e-6 * ($after - $before)}]"

    test2 1
    set before [clock microseconds]
    test2 30000
    set after [clock microseconds]
    puts "assembled: [expr {1e-6 * ($after - $before)}]"
}

Changes to tests/assocd.test.

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
1
2
3
4
5
6
7
8
9
10
11
12
13



14
15




16
17
18
19
20
21
22













-
-
-
+
+
-
-
-
-







# This file tests the AssocData facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testgetassocdata [llength [info commands testgetassocdata]]
testConstraint testsetassocdata [llength [info commands testsetassocdata]]
testConstraint testdelassocdata [llength [info commands testdelassocdata]]

test assocd-1.1 {testing setting assoc data} testsetassocdata {
   testsetassocdata a 1

Changes to tests/async.test.

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
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













-
-
+
+



-
-
-

+
+
+







# Commands covered:  none
#
# This file contains a collection of tests for Tcl_AsyncCreate and related
# library procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]
testConstraint threaded [expr {
    [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)
}]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

proc async1 {result code} {
    global aresult acode
    set aresult $result
    set acode $code
    return "new result"
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
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







-
-
-
-
-
-
-
+
+
+
-
-
+



-
-
+
-
-
-
+
+
-
-


-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-



-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-



-
+



-
-
-
-
-
-
-
-
+

-
-
-













}

test async-3.1 {deleting handlers} testasync {
    set x {}
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}

test async-4.1 {async interrupting bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
    proc nothing {} {
	# empty proc
    }
proc nothing {} {
    # empty proc
}
} -body {
    apply {{handle} {
proc hang1 {handle} {
    global aresult
    set aresult {Async event not delivered}
    testasync marklater $handle
    # allow plenty of time to pass in case valgrind is running
    set start [clock seconds]
    for {set i 0} {
    while {
	[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
    } {
	$i < 2500000  &&  $aresult eq "Async event not delivered"
    } {incr i} {
	# be less busy
	after 100
	nothing
    }
	return $aresult
    }} $hm
    return $aresult
}
proc hang2 {handle} {
    global aresult
    set aresult {Async event not delivered}
    testasync marklater $handle
    for {set i 0} {
	$i < 2500000  &&  $aresult eq "Async event not delivered"
    } {incr i} {}
    return $aresult
}
proc hang3 {handle} [concat {
    global aresult
    set aresult {Async event not delivered}
    testasync marklater $handle
    set i 0
} "[string repeat {;incr i;} 1500000]after 10;" {
    return $aresult
}]

test async-4.1 {async interrupting bytecode sequence} -constraints {
    testasync threaded
} -setup {
    set hm [testasync create async3]
} -body {
    hang1 $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
    testasync
    testasync threaded knownMsvcBug
} -setup {
    set hm [testasync create async3]
} -body {
    apply {{handle} {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
	# allow plenty of time to pass in case valgrind is running
	set start [clock seconds]
	while {
		[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
	} {
		# be less busy
	    after 100
	}
	return $aresult
    }} $hm
    hang2 $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
    testasync knownMsvcBug
    testasync threaded knownMsvcBug
} -setup {
    set hm [testasync create async3]
} -body {
    apply [list {handle} [concat {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
	set i 0
    } "[string repeat {;incr i;} 1500000]after 10;" {
	return $aresult
    }]] $hm
    hang3 $hm
} -result {test pattern} -cleanup {
    # give other threads some time to go way so that valgrind doesn't pick up
    # "still reachable" cases from early thread termination
    after 100
    testasync delete $hm
}

# cleanup
if {[testConstraint testasync]} {
    testasync delete
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/auto-files.zip.

cannot compute difference between binary files

Deleted tests/auto0/auto1/file1.tcl.

1
2
3



-
-
-
proc report1 {args} {
    return ok1
}

Deleted tests/auto0/auto1/package1.tcl.

1
2
3
4
5





-
-
-
-
-
proc HeresPackage1 {args} {
    return OK1
}

package provide SafeTestPackage1 1.2.3

Deleted tests/auto0/auto1/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11











-
-
-
-
-
-
-
-
-
-
-
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded SafeTestPackage1 1.2.3 [list source [file join $dir package1.tcl]]

Deleted tests/auto0/auto1/tclIndex.

1
2
3
4
5
6
7
8
9









-
-
-
-
-
-
-
-
-
# Tcl autoload index file, version 2.0
# This file is generated by the "auto_mkindex" command
# and sourced to set up indexing information for one or
# more commands.  Typically each line is a command that
# sets an element in the auto_index array, where the
# element name is the name of a command and the value is
# a script that loads the command.

set auto_index(report1) [list source [file join $dir file1.tcl]]

Deleted tests/auto0/auto2/file2.tcl.

1
2
3



-
-
-
proc report2 {args} {
    return ok2
}

Deleted tests/auto0/auto2/package2.tcl.

1
2
3
4
5





-
-
-
-
-
proc HeresPackage2 {args} {
    return OK2
}

package provide SafeTestPackage2 2.3.4

Deleted tests/auto0/auto2/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11











-
-
-
-
-
-
-
-
-
-
-
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded SafeTestPackage2 2.3.4 [list source [file join $dir package2.tcl]]

Deleted tests/auto0/auto2/tclIndex.

1
2
3
4
5
6
7
8
9









-
-
-
-
-
-
-
-
-
# Tcl autoload index file, version 2.0
# This file is generated by the "auto_mkindex" command
# and sourced to set up indexing information for one or
# more commands.  Typically each line is a command that
# sets an element in the auto_index array, where the
# element name is the name of a command and the value is
# a script that loads the command.

set auto_index(report2) [list source [file join $dir file2.tcl]]

Deleted tests/auto0/modules/mod1/test1-1.0.tm.

1
2
3
4
5





-
-
-
-
-
namespace eval mod1::test1 {}

proc mod1::test1::try1 args {
    return res1
}

Deleted tests/auto0/modules/mod2/test2-2.0.tm.

1
2
3
4
5





-
-
-
-
-
namespace eval mod2::test2 {}

proc mod2::test2::try2 args {
    return res2
}

Deleted tests/auto0/modules/test0-0.5.tm.

1
2
3
4
5





-
-
-
-
-
namespace eval test0 {}

proc test0::try0 args {
    return res0
}

Changes to tests/autoMkindex.test.

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
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


-
-
+
+




-
-
+
+

-
-
+
+






-
-
-
-
+
+
+
+








-
-
+
+






-
-
+
+





-
-
+
+







# Commands covered:  auto_mkindex auto_import
#
# This file contains tests related to autoloading and generating the
# autoloading index.
# This file contains tests related to autoloading and generating
# the autoloading index.
#
# Copyright (c) 1998  Lucent Technologies, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

makeFile {# Test file for:
#   auto_mkindex
#
# This file provides example cases for testing the Tcl autoloading facility.
# Things are much more complicated with namespaces and classes.  The
# "auto_mkindex" facility can no longer be built on top of a simple regular
# expression parser.  It must recognize constructs like this:
# This file provides example cases for testing the Tcl autoloading
# facility.  Things are much more complicated with namespaces and classes.
# The "auto_mkindex" facility can no longer be built on top of a simple
# regular expression parser.  It must recognize constructs like this:
#
#   namespace eval foo {
#       proc test {x y} { ... }
#       namespace eval bar {
#           proc another {args} { ... }
#       }
#   }
#
# Note that procedures and itcl class definitions can be nested inside of
# namespaces.
# Note that procedures and itcl class definitions can be nested inside
# of namespaces.
#
# Copyright (c) 1993-1998  Lucent Technologies, Inc.

# This shouldn't cause any problems
namespace import -force blt::*

# Should be able to handle "proc" definitions, even if they are preceded by
# white space.
# Should be able to handle "proc" definitions, even if they are
# preceded by white space.

proc normal {x y} {return [expr $x+$y]}
  proc indented {x y} {return [expr $x+$y]}

#
# Should be able to handle proc declarations within namespaces, even if they
# have explicit namespace paths.
# Should be able to handle proc declarations within namespaces,
# even if they have explicit namespace paths.
#
namespace eval buried {
    proc inside {args} {return "inside: $args"}

    namespace export pub_*
    proc pub_one {args} {return "one: $args"}
    proc pub_two {args} {return "two: $args"}
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
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







-
-
+
+



















-
-
+
+





+

+




















-
+




+




+

+
-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
-

-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
+
+
-
-
+
-
-
-
-
-
-
+
-
-







+










-
-
-
-

+

+

+
+
+
+
+
+
+
+
+
-
+
+







    namespace eval ::buried {
        proc relative {args} {return "relative: $args"}
        proc ::top {args} {return "top: $args"}
        proc ::buried::explicit {args} {return "explicit: $args"}
    }
}

# With proper hooks, we should be able to support other commands that create
# procedures
# With proper hooks, we should be able to support other commands
# that create procedures

proc buried::myproc {name body args} {
    ::proc $name $body $args
}
namespace eval ::buried {
    proc mycmd1 args {return "mycmd"}
    myproc mycmd2 args {return "mycmd"}
}
::buried::myproc mycmd3 args {return "another"}

proc {buried::my proc} {name body args} {
    ::proc $name $body $args
}
namespace eval ::buried {
    proc mycmd4 args {return "mycmd"}
    {my proc} mycmd5 args {return "mycmd"}
}
{::buried::my proc} mycmd6 args {return "another"}

# A correctly functioning [auto_import] won't choke when a child namespace
# [namespace import]s from its parent.
# A correctly functioning [auto_import] won't choke when a child
# namespace [namespace import]s from its parent.
#
namespace eval ::parent::child {
    namespace import ::parent::*
}
proc ::parent::child::test {} {}

} autoMkindex.tcl


# Save initial state of auto_mkindex_parser

auto_load auto_mkindex
if {[info exists auto_mkindex_parser::initCommands]} {
    set saveCommands $auto_mkindex_parser::initCommands
}
proc AutoMkindexTestReset {} {
    global saveCommands
    if {[info exists saveCommands]} {
	set auto_mkindex_parser::initCommands $saveCommands
    } elseif {[info exists auto_mkindex_parser::initCommands]} {
	unset auto_mkindex_parser::initCommands
    }
}

set result ""

set origDir [pwd]
cd $::tcltest::temporaryDirectory


test autoMkindex-1.1 {remove any existing tclIndex file} {
    file delete tclIndex
    file exists tclIndex
} {0}

test autoMkindex-1.2 {build tclIndex based on a test file} {
    auto_mkindex . autoMkindex.tcl
    file exists tclIndex
} {1}

set element "{source [file join . autoMkindex.tcl]}"

test autoMkindex-1.3 {examine tclIndex} -setup {
test autoMkindex-1.3 {examine tclIndex} {
    file delete tclIndex
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
        foreach elem [lsort [array names auto_index]] {
            lappend ::result [list $elem $auto_index($elem)]
        }
    }
    namespace delete tcl_autoMkindex_tmp
    set ::result
} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"
} -body {


test autoMkindex-2.1 {commands on the autoload path can be imported} {
    file delete tclIndex
    auto_mkindex . autoMkindex.tcl
    set interp [interp create]
    set final [$interp eval {
        namespace eval blt {}
        set auto_path [linsert $auto_path 0 .]
        set info [list [catch {namespace import buried::*} result] $result]
        foreach name [lsort [info commands pub_*]] {
            lappend info $name [namespace origin $name]
        }
        set info
    }]
    interp delete $interp
    set final
} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"

# Test auto_mkindex hooks

# Slave hook executes interesting code in the interp used to watch code.

test autoMkindex-3.1 {slaveHook} {
    auto_mkindex_parser::slavehook {
	_%@namespace eval ::blt {
	    proc foo {} {}
	    _%@namespace export foo
	}
    }
    auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
    file delete tclIndex
    auto_mkindex . autoMkindex.tcl
     
    # Reset initCommands to avoid trashing other tests

    AutoMkindexTestReset
    file exists tclIndex
} 1 

# The auto_mkindex_parser::command is used to register commands
# that create new commands.

test autoMkindex-3.2 {auto_mkindex_parser::command} {
    auto_mkindex_parser::command buried::myproc {name args} {
	variable index
	variable scriptFile
	append index [list set auto_index([fullname $name])] \
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }
    file delete tclIndex
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
        foreach elem [lsort [array names auto_index]] {
            lappend ::result [list $elem $auto_index($elem)]
        }
    }
    return $result
} -cleanup {
    namespace delete tcl_autoMkindex_tmp
} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"

test autoMkindex-2.1 {commands on the autoload path can be imported} -setup {
    file delete tclIndex
    interp create child
} -body {
    auto_mkindex . autoMkindex.tcl
    child eval {
        namespace eval blt {}
        set auto_path [linsert $auto_path 0 .]
        set info [list [catch {namespace import buried::*} result] $result]
        foreach name [lsort [info commands pub_*]] {
            lappend info $name [namespace origin $name]
        }
        return $info
    }
} -cleanup {
    interp delete child
} -result "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"

# Test auto_mkindex hooks

# Child hook executes interesting code in the interp used to watch code.
test autoMkindex-3.1 {childHook} -setup {
    file delete tclIndex
} -body {
    auto_mkindex_parser::childhook {
	_%@namespace eval ::blt {
	    proc foo {} {}
	    _%@namespace export foo
	}
    }
    auto_mkindex_parser::childhook { _%@namespace import -force ::blt::* }
    auto_mkindex . autoMkindex.tcl
    file exists tclIndex
} -cleanup {
    # Reset initCommands to avoid trashing other tests
    AutoMkindexTestReset
} -result 1
# The auto_mkindex_parser::command is used to register commands that create
# new commands.
test autoMkindex-3.2 {auto_mkindex_parser::command} -setup {
    file delete tclIndex
} -body {
    auto_mkindex_parser::command buried::myproc {name args} {
	variable index
	variable scriptFile
	append index [list set auto_index([fullname $name])] \
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }
    auto_mkindex . autoMkindex.tcl

    AutoMkindexTestReset
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
    set ::result
        foreach elem [lsort [array names auto_index]] {
            lappend ::result [list $elem $auto_index($elem)]
        }
} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"

	return $::result
    }

} -cleanup {
    namespace delete tcl_autoMkindex_tmp
    # Reset initCommands to avoid trashing other tests
    AutoMkindexTestReset
} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
test autoMkindex-3.3 {auto_mkindex_parser::command} -setup {
test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
    file delete tclIndex
} -constraints {knownBug} -body {
    auto_mkindex_parser::command {buried::my proc} {name args} {
	variable index
	variable scriptFile
	puts "my proc $name"
	append index [list set auto_index([fullname $name])] \
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }
    file delete tclIndex
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
        foreach elem [lsort [array names auto_index]] {
            lappend ::result [list $elem $auto_index($elem)]
        }
    }
    list [lsearch -inline $::result *mycmd4*] \
	[lsearch -inline $::result *mycmd5*] \
	[lsearch -inline $::result *mycmd6*]
} -cleanup {
    namespace delete tcl_autoMkindex_tmp

    # Reset initCommands to avoid trashing other tests

    AutoMkindexTestReset
    proc lvalue {list pattern} {
	set ix [lsearch $list $pattern]
	if {$ix >= 0} {
	    return [lindex $list $ix]
	} else {
	    return {}
	}
    }
    list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
} -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"

makeFile {

namespace eval wok {
    namespace ensemble create -subcommands {commands vars}

    proc commands {{pattern *}} {
	puts [join [lsort -dictionary [info commands $pattern]] \n]
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
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













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
-
-
+

















-
-
-
-
-
-
    }
    set result [lsort $dat]
    close $f
    set result
} {{set auto_index(::wok::commands) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source [file join $dir ensemblecommands.tcl]]}}
removeFile ensemblecommands.tcl

test autoMkindex-4.1 {platform independent source commands} -setup {
    file delete tclIndex
    makeDirectory pkg
    makeFile {
	package provide football 1.0
	namespace eval ::pro:: {
	    #
	    # export only public functions.
	    #
	    namespace export {[a-z]*}
	}
	namespace eval ::college:: {
	    #
	    # export only public functions.
	    #
	    namespace export {[a-z]*}
	}
	proc ::pro::team {} {
	    puts "go packers!"
	    return true
	}
	proc ::college::team {} {
	    puts "go badgers!"
	    return true
	}
    } [file join pkg samename.tcl]
} -body {
makeDirectory pkg
makeFile {
package provide football 1.0
    
namespace eval ::pro:: {
    #
    # export only public functions.
    #
    namespace export {[a-z]*}
}
namespace eval ::college:: {
    #
    # export only public functions.
    #
    namespace export {[a-z]*}
}

proc ::pro::team {} {
    puts "go packers!"
    return true
}

proc ::college::team {} {
    puts "go badgers!"
    return true
}

} [file join pkg samename.tcl]


test autoMkindex-4.1 {platform indenpendant source commands} {
    file delete tclIndex
    auto_mkindex . pkg/samename.tcl
    set f [open tclIndex r]
    lsort [lrange [split [string trim [read $f]] "\n"] end-1 end]
} -cleanup {
    catch {close $f}
    removeFile [file join pkg samename.tcl]
    removeDirectory pkg
} -result {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}

    set dat [split [string trim [read $f]] "\n"]
    set len [llength $dat]
    set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]]
    close $f
    set result
} {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}

removeFile [file join pkg samename.tcl]

makeFile {
set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
set dollar2 "this string contains an escaped dollar sign -> \$foo \\\$foo"
set bracket1 "this contains an unescaped bracket [NoSuchProc]"
set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
set bracket3 "this contains nested unescaped brackets [[NoSuchProc]]"
proc testProc {} {}
} [file join pkg magicchar.tcl]

test autoMkindex-5.1 {escape magic tcl chars in general code} {
    file delete tclIndex
    set result {}
    if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } {
	set f [open tclIndex r]
	set dat [split [string trim [read $f]] "\n"]
	set result [lindex $dat end]
	close $f
    }
test autoMkindex-5.1 {escape magic tcl chars in general code} -setup {
    file delete tclIndex
    makeDirectory pkg
    makeFile {
	set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
	set dollar2 \
	    "this string contains an escaped dollar sign -> \$foo \\\$foo"
	set bracket1 "this contains an unescaped bracket [NoSuchProc]"
	set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
	set bracket3 \
	    "this contains nested unescaped brackets [[NoSuchProc]]"
	proc testProc {} {}
    } [file join pkg magicchar.tcl]
    set result {}
    set result
} -body {
    auto_mkindex . pkg/magicchar.tcl
    set f [open tclIndex r]
} {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}

    lindex [split [string trim [read $f]] "\n"] end
} -cleanup {
    catch {close $f}
    removeFile [file join pkg magicchar.tcl]
    removeDirectory pkg
removeFile [file join pkg magicchar.tcl]

} -result {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup {
    file delete tclIndex
    makeDirectory pkg
    makeFile {
	proc {[magic mojo proc]} {} {}
    } [file join pkg magicchar2.tcl]
makeFile {
proc {[magic mojo proc]} {} {}
} [file join pkg magicchar2.tcl]

test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
    file delete tclIndex
    set result {}
    interp create child
} -body {
    auto_mkindex . pkg/magicchar2.tcl
    # Make a child interp to test the autoloading
    child eval {lappend auto_path [pwd]}
    child eval {catch {{[magic mojo proc]}}}
    if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } {
	# Make a slave interp to test the autoloading
	set c [interp create]
	$c eval {lappend auto_path [pwd]}
	set result [$c eval {catch {{[magic mojo proc]}}}]
} -cleanup {
    interp delete child
    removeFile [file join pkg magicchar2.tcl]
    removeDirectory pkg
	interp delete $c
    }
    set result
} 0

removeFile [file join pkg magicchar2.tcl]
removeDirectory pkg
} -result 0


# Clean up.

unset result
AutoMkindexTestReset
if {[info exists saveCommands]} {
    unset saveCommands
}
rename AutoMkindexTestReset ""

removeFile autoMkindex.tcl
if {[file exists tclIndex]} {
    file delete -force tclIndex
}

cd $origDir

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/basic.test.

11
12
13
14
15
16
17
18
19
20


21
22
23
24
25
26
27
28
29
30
31
11
12
13
14
15
16
17



18
19




20
21
22
23
24
25
26







-
-
-
+
+
-
-
-
-







#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testevalex [llength [info commands testevalex]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
testConstraint testcreatecommand [llength [info commands testcreatecommand]]
testConstraint exec [llength [info commands exec]]

catch {namespace delete test_ns_basic}
254
255
256
257
258
259
260
261

262
263
264
265
266
267
268
249
250
251
252
253
254
255

256
257
258
259
260
261
262
263







-
+







    namespace eval test_ns_basic {
        proc p {} {
            return "p in [namespace current]"
        }
    }
    list [test_ns_basic::p] \
         [rename test_ns_basic::p test_ns_basic::q] \
         [test_ns_basic::q]
         [test_ns_basic::q] 
} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
test basic-18.2 {TclRenameCommand, existing cmd must be found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
} {1 {can't rename "test_ns_basic::p": command doesn't exist}}
test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
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
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







-
+



-
+

















-
+



-
+








test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
    #
    # Follow the pure-list branch in a manner that
    #   a - the pure-list internal rep is destroyed by shimmering
    #   b - the command returns an error
    # As the error code in Tcl_EvalObjv accesses the list elements, this will
    # cause a segfault if [Bug 1119369] has not been fixed.
    # cause a segfault if [Bug 1119369] has not been fixed. 
    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
    #

    set SRC [list foo 1] ;# pure-list command
    set SRC [list foo 1] ;# pure-list command 
    proc foo str {
	# Shimmer pure-list to cmdName, cleanup and error
	proc $::SRC {} {}; $::SRC
	error "BAD CALL"
    }
    catch {eval $SRC}
} -result 1 -cleanup {
    rename foo {}
    rename $::SRC {}
    unset ::SRC
}

test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
    #
    # Follow the pure-list branch in a manner that
    #   a - the pure-list internal rep is destroyed by shimmering
    #   b - the command accesses its command line
    # This will cause a segfault if [Bug 1119369] has not been fixed.
    # This will cause a segfault if [Bug 1119369] has not been fixed. 
    # NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
    #

    set SRC [list foo 1] ;# pure-list command
    set SRC [list foo 1] ;# pure-list command 
    proc foo str {
	# Shimmer pure-list to cmdName, cleanup and error
	proc $::SRC {} {}; $::SRC
	info level 0
    }
    catch {eval $SRC}
} -result 0 -cleanup {
605
606
607
608
609
610
611
612

613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629

630
631
632
633
634
635
636
600
601
602
603
604
605
606

607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623

624
625
626
627
628
629
630
631







-
+
















-
+







    exec [interpreter] $fName
} -cleanup {
    removeFile BREAKtest
} -returnCodes error -match glob -result {hello
invoked "break" outside of a loop
    while executing
"break"
    (file "*BREAKtest" line 3)}
    (file "*BREAKtest" line 3)}    

test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup {
    set fName [makeFile {
	interp alias {} patch {} info patchlevel
	patch
	break
    } BREAKtest]
} -constraints {
    exec
} -body {
    exec [interpreter] $fName
} -cleanup {
    removeFile BREAKtest
} -returnCodes error -match glob -result {invoked "break" outside of a loop
    while executing
"break"
    (file "*BREAKtest" line 4)}
    (file "*BREAKtest" line 4)}    

test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup {
    set fName [makeFile {
	foo [set a 1] [break]
    } BREAKtest]
} -constraints {
    exec
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
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







-
+
-
-
-
+










-
+







} -cleanup {
    removeFile BREAKtest
} -returnCodes error -match glob -result {command returned bad code: 2
    while executing
"return -code return"
    (file "*BREAKtest" line 2)}

test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -constraints {
test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -body {
    testevalex
} -body {
    testevalex {a[set b [format cd]}
    subst {a[set b [format cd]}
} -returnCodes error -result {missing close-bracket}

# Some lists for expansion tests to work with
set l1 [list a {b b} c d]
set l2 [list e f {g g} h]
proc l3 {} {
    list i j k {l l}
}

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {
for {set noComp 0} {$noComp <= 1} {incr noComp} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
750
751
752
753
754
755
756
757

758
759
760
761
762
763
764
743
744
745
746
747
748
749

750
751
752
753
754
755
756
757







-
+








test basic-48.1.$noComp {expansion: parsing} $constraints {
	run { # A comment

		# Another comment
		list 1  2\
			3   {*}$::l1

            
		# Comment again
	}
} {1 2 3 a {b b} c d}

test basic-48.2.$noComp {no expansion} $constraints {
        run {list $::l1 $::l2 [l3]}
} {{a {b b} c d} {e f {g g} h} {i j k {l l}}}
823
824
825
826
827
828
829
830

831
832
833
834
835
836
837
816
817
818
819
820
821
822

823
824
825
826
827
828
829
830







-
+







test basic-48.13.$noComp {expansion: odd usage} $constraints {
	run {list {*}$::l1 {*}{hej hopp} {*}$::l2}
} {a {b b} c d hej hopp e f {g g} h}

test basic-48.14.$noComp {expansion: hash command} -setup {
        catch {rename \# ""}
        set cmd "#"
    } -constraints $constraints -body {
    } -constraints $constraints -body { 
           run { {*}$cmd apa bepa }
    } -cleanup {
	unset cmd
} -returnCodes 1 -result {invalid command name "#"}

test basic-48.15.$noComp {expansion: complex words} -setup {
            set a(x) [list a {b c} d e]
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
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







-
+







-
+
+
+
+



-
+





+
-
+







        }
    } -constraints [linsert $constraints 0 memory] -body {
        set end [getbytes]
        for {set i 0} {$i < 5} {incr i} {
            stress
            set tmp $end
            set end [getbytes]
        }
        }    
        set leak [expr {$end - $tmp}]
    } -cleanup {
	unset end i tmp
	rename getbytes {}
	rename stress {}
} -result 0

test basic-48.17.$noComp {expansion: object safety} -constraints $constraints -body {
test basic-48.17.$noComp {expansion: object safety} -setup {
        set old_precision $::tcl_precision
        set ::tcl_precision 4
    } -constraints $constraints -body { 
            set third [expr {1.0/3.0}]
            set l [list $third $third]
            set x [run {list $third {*}$l $third}]
            set res [list]
	    set res [list]
            foreach t $x {
                lappend res [expr {$t * 3.0}]
            }
            set res
    } -cleanup {
        set ::tcl_precision $old_precision
        unset res t l x third
        unset old_precision res t l x third
} -result {1.0 1.0 1.0 1.0}

test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints -body {
        set badcmd {
            list a b
            set apa 10
        }
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
952
953
954
955
956
957
958


















959
960
961
962
963
964
965







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







        lappend res $t

        lappend res [catch { run { {*}{error Hejsan} } } err]
        lappend res $err
    } -cleanup {
	unset res t
} -result {0 10 1 Hejsan}

test basic-48.24.$noComp {expansion: empty not canonical list, regression test, bug [cc1e91552c]} -constraints $constraints -setup {
    unset -nocomplain a
} -body {
    run {list [list {*}{ }] [list {*}[format %c 32]] [list {*}[set a { }]]}
} -result [lrepeat 3 {}] -cleanup {unset -nocomplain a}

test basic-48.25.$noComp {Bug cc191552c: expansion: empty non-canonical list} -constraints $constraints -setup {
    unset -nocomplain ::CRLF
    set ::CRLF "\r\n"
} -body {
    # Force variant that turned up in Bug 2c154a40be as that's externally
    # noticeable in an important downstream project.
    run {scan [list {*}$::CRLF]x %c%c%c}
} -cleanup {
    unset -nocomplain ::CRLF
} -result {120 {} {}}


} ;# End of noComp loop

test basic-49.1 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
    set ::x global
    namespace eval ns {
	variable x namespace
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
975
976
977
978
979
980
981










982
983
984
985
986
987
988







-
-
-
-
-
-
-
-
-
-







	variable x namespace
	testevalex {set ::context $x} global
    }
    namespace delete ns
    set ::context
} {global}

test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup {
    interp create child
    interp alias {} foo child return
} -body {
    list [catch foo m] $m
} -cleanup {
    unset -nocomplain m
    interp delete child
} -result {0 {}}

# Clean up after expand tests
unset noComp l1 l2 constraints
rename l3 {}
rename run {}

 #cleanup
catch {namespace delete {*}[namespace children :: test_ns_*]}

Changes to tests/binary.test.

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

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
-
+

-
-
-
+
+
+




-
-
+
+

-
-
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+







# This file tests the tclBinary.c file and the "binary" Tcl command.
# This file tests the tclBinary.c file and the "binary" Tcl command. 
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]

test binary-0.1 {DupByteArrayInternalRep} {
    set hdr [binary format cc 0 0316]
    set buf hellomatt
    
    set data $hdr
    append data $buf
    
    string length $data
} 11

test binary-1.1 {Tcl_BinaryObjCmd: bad args} {
    list [catch {binary} msg] $msg
} {1 {wrong # args: should be "binary option ?arg arg ...?"}}
test binary-1.2 {Tcl_BinaryObjCmd: bad args} {
    list [catch {binary foo} msg] $msg
} {1 {bad option "foo": must be format or scan}}

test binary-1.3 {Tcl_BinaryObjCmd: format error} {
    list [catch {binary f} msg] $msg
} {1 {wrong # args: should be "binary format formatString ?arg arg ...?"}}
test binary-1.4 {Tcl_BinaryObjCmd: format} {
    binary format ""
} {}


test binary-2.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format a } msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-2.2 {Tcl_BinaryObjCmd: format} {
    binary format a0 foo
} {}
test binary-2.3 {Tcl_BinaryObjCmd: format} {
    binary format a f
} {f}
test binary-2.4 {Tcl_BinaryObjCmd: format} {
    binary format a foo
} {f}
test binary-2.5 {Tcl_BinaryObjCmd: format} {
    binary format a3 foo
} {foo}
test binary-2.6 {Tcl_BinaryObjCmd: format} {
    binary format a5 foo
} foo\x00\x00
test binary-2.7 {Tcl_BinaryObjCmd: format} {
    binary format a*a3 foobarbaz blat
} foobarbazbla
test binary-2.8 {Tcl_BinaryObjCmd: format} {
    binary format a*X3a2 foobar x
} foox\x00r

test binary-3.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format A} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-3.2 {Tcl_BinaryObjCmd: format} {
    binary format A0 f
} {}
test binary-3.3 {Tcl_BinaryObjCmd: format} {
    binary format A f
} {f}
test binary-3.4 {Tcl_BinaryObjCmd: format} {
    binary format A foo
} {f}
test binary-3.5 {Tcl_BinaryObjCmd: format} {
    binary format A3 foo
} {foo}
test binary-3.6 {Tcl_BinaryObjCmd: format} {
    binary format A5 foo
} {foo  }
test binary-3.7 {Tcl_BinaryObjCmd: format} {
    binary format A*A3 foobarbaz blat
} foobarbazbla
test binary-3.8 {Tcl_BinaryObjCmd: format} {
    binary format A*X3A2 foobar x
} {foox r}

test binary-4.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format B} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-4.2 {Tcl_BinaryObjCmd: format} {
    binary format B0 1
} {}
test binary-4.3 {Tcl_BinaryObjCmd: format} {
    binary format B 1
} \x80
test binary-4.4 {Tcl_BinaryObjCmd: format} {
    binary format B* 010011
} \x4c
test binary-4.5 {Tcl_BinaryObjCmd: format} {
    binary format B8 01001101
} \x4d
test binary-4.6 {Tcl_BinaryObjCmd: format} {
    binary format A2X2B9 oo 01001101
} \x4d\x00
test binary-4.7 {Tcl_BinaryObjCmd: format} {
    binary format B9 010011011010
} \x4d\x80
test binary-4.8 {Tcl_BinaryObjCmd: format} {
    binary format B2B3 10 010
} \x80\x40
test binary-4.9 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format B1B5 1 foo} msg] $msg
} {1 {expected binary string but got "foo" instead}}

test binary-5.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format b} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-5.2 {Tcl_BinaryObjCmd: format} {
    binary format b0 1
} {}
test binary-5.3 {Tcl_BinaryObjCmd: format} {
    binary format b 1
} \x01
test binary-5.4 {Tcl_BinaryObjCmd: format} {
    binary format b* 010011
} 2
test binary-5.5 {Tcl_BinaryObjCmd: format} {
    binary format b8 01001101
} \xb2
test binary-5.6 {Tcl_BinaryObjCmd: format} {
    binary format A2X2b9 oo 01001101
} \xb2\x00
test binary-5.7 {Tcl_BinaryObjCmd: format} {
    binary format b9 010011011010
} \xb2\x01
test binary-5.8 {Tcl_BinaryObjCmd: format} {
    binary format b17 1
} \x01\00\00
test binary-5.9 {Tcl_BinaryObjCmd: format} {
    binary format b2b3 10 010
} \x01\x02
test binary-5.10 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format b1b5 1 foo} msg] $msg
} {1 {expected binary string but got "foo" instead}}

test binary-6.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format h} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-6.2 {Tcl_BinaryObjCmd: format} {
    binary format h0 1
} {}
test binary-6.3 {Tcl_BinaryObjCmd: format} {
    binary format h 1
} \x01
test binary-6.4 {Tcl_BinaryObjCmd: format} {
    binary format h c
} \x0c
test binary-6.5 {Tcl_BinaryObjCmd: format} {
    binary format h* baadf00d
} \xab\xda\x0f\xd0
test binary-6.6 {Tcl_BinaryObjCmd: format} {
    binary format h4 c410
} \x4c\x01
test binary-6.7 {Tcl_BinaryObjCmd: format} {
    binary format h6 c4102
} \x4c\x01\x02
test binary-6.8 {Tcl_BinaryObjCmd: format} {
    binary format h5 c41020304
} \x4c\x01\x02
test binary-6.9 {Tcl_BinaryObjCmd: format} {
    binary format a3X3h5 foo 2
} \x02\x00\x00
test binary-6.10 {Tcl_BinaryObjCmd: format} {
    binary format h2h3 23 456
} \x32\x54\x06
test binary-6.11 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format h2 foo} msg] $msg
} {1 {expected hexadecimal string but got "foo" instead}}

test binary-7.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format H} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-7.2 {Tcl_BinaryObjCmd: format} {
    binary format H0 1
} {}
test binary-7.3 {Tcl_BinaryObjCmd: format} {
    binary format H 1
} \x10
test binary-7.4 {Tcl_BinaryObjCmd: format} {
    binary format H c
} \xc0
test binary-7.5 {Tcl_BinaryObjCmd: format} {
    binary format H* baadf00d
} \xba\xad\xf0\x0d
test binary-7.6 {Tcl_BinaryObjCmd: format} {
    binary format H4 c410
} \xc4\x10
test binary-7.7 {Tcl_BinaryObjCmd: format} {
    binary format H6 c4102
} \xc4\x10\x20
test binary-7.8 {Tcl_BinaryObjCmd: format} {
    binary format H5 c41023304
} \xc4\x10\x20
test binary-7.9 {Tcl_BinaryObjCmd: format} {
    binary format a3X3H5 foo 2
} \x20\x00\x00
test binary-7.10 {Tcl_BinaryObjCmd: format} {
    binary format H2H3 23 456
} \x23\x45\x60
test binary-7.11 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format H2 foo} msg] $msg
} {1 {expected hexadecimal string but got "foo" instead}}

test binary-8.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format c} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-8.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format c blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-8.3 {Tcl_BinaryObjCmd: format} {
    binary format c0 0x50
} {}
test binary-8.4 {Tcl_BinaryObjCmd: format} {
    binary format c 0x50
} P
test binary-8.5 {Tcl_BinaryObjCmd: format} {
    binary format c 0x5052
} R
test binary-8.6 {Tcl_BinaryObjCmd: format} {
    binary format c2 {0x50 0x52}
} PR
test binary-8.7 {Tcl_BinaryObjCmd: format} {
    binary format c2 {0x50 0x52 0x53}
} PR
test binary-8.8 {Tcl_BinaryObjCmd: format} {
    binary format c* {0x50 0x52}
} PR
test binary-8.9 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format c2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-8.10 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    list [catch {binary format c $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-8.11 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format c1 $a
} P

test binary-9.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format s} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-9.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format s blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-9.3 {Tcl_BinaryObjCmd: format} {
    binary format s0 0x50
} {}
test binary-9.4 {Tcl_BinaryObjCmd: format} {
    binary format s 0x50
} P\x00
test binary-9.5 {Tcl_BinaryObjCmd: format} {
    binary format s 0x5052
} RP
test binary-9.6 {Tcl_BinaryObjCmd: format} {
    binary format s 0x505251 0x53
} QR
test binary-9.7 {Tcl_BinaryObjCmd: format} {
    binary format s2 {0x50 0x52}
} P\x00R\x00
test binary-9.8 {Tcl_BinaryObjCmd: format} {
    binary format s* {0x5051 0x52}
} QPR\x00
test binary-9.9 {Tcl_BinaryObjCmd: format} {
    binary format s2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
test binary-9.10 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format s2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-9.11 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    list [catch {binary format s $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-9.12 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format s1 $a
} P\x00

test binary-10.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format S} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-10.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format S blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-10.3 {Tcl_BinaryObjCmd: format} {
    binary format S0 0x50
} {}
test binary-10.4 {Tcl_BinaryObjCmd: format} {
    binary format S 0x50
} \x00P
test binary-10.5 {Tcl_BinaryObjCmd: format} {
    binary format S 0x5052
} PR
test binary-10.6 {Tcl_BinaryObjCmd: format} {
    binary format S 0x505251 0x53
} RQ
test binary-10.7 {Tcl_BinaryObjCmd: format} {
    binary format S2 {0x50 0x52}
} \x00P\x00R
test binary-10.8 {Tcl_BinaryObjCmd: format} {
    binary format S* {0x5051 0x52}
} PQ\x00R
test binary-10.9 {Tcl_BinaryObjCmd: format} {
    binary format S2 {0x50 0x52 0x53} 0x54
} \x00P\x00R
test binary-10.10 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format S2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-10.11 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    list [catch {binary format S $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-10.12 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format S1 $a
} \x00P

test binary-11.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format i} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-11.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format i blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-11.3 {Tcl_BinaryObjCmd: format} {
    binary format i0 0x50
} {}
test binary-11.4 {Tcl_BinaryObjCmd: format} {
    binary format i 0x50
} P\x00\x00\x00
test binary-11.5 {Tcl_BinaryObjCmd: format} {
    binary format i 0x5052
} RP\x00\x00
test binary-11.6 {Tcl_BinaryObjCmd: format} {
    binary format i 0x505251 0x53
} QRP\x00
test binary-11.7 {Tcl_BinaryObjCmd: format} {
    binary format i1 {0x505251 0x53}
} QRP\x00
test binary-11.8 {Tcl_BinaryObjCmd: format} {
    binary format i 0x53525150
} PQRS
test binary-11.9 {Tcl_BinaryObjCmd: format} {
    binary format i2 {0x50 0x52}
} P\x00\x00\x00R\x00\x00\x00
test binary-11.10 {Tcl_BinaryObjCmd: format} {
    binary format i* {0x50515253 0x52}
} SRQPR\x00\x00\x00
test binary-11.11 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format i2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-11.12 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    list [catch {binary format i $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-11.13 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format i1 $a
} P\x00\x00\x00

test binary-12.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format I} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-12.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format I blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-12.3 {Tcl_BinaryObjCmd: format} {
    binary format I0 0x50
} {}
test binary-12.4 {Tcl_BinaryObjCmd: format} {
    binary format I 0x50
} \x00\x00\x00P
test binary-12.5 {Tcl_BinaryObjCmd: format} {
    binary format I 0x5052
} \x00\x00PR
test binary-12.6 {Tcl_BinaryObjCmd: format} {
    binary format I 0x505251 0x53
} \x00PRQ
test binary-12.7 {Tcl_BinaryObjCmd: format} {
    binary format I1 {0x505251 0x53}
} \x00PRQ
test binary-12.8 {Tcl_BinaryObjCmd: format} {
    binary format I 0x53525150
} SRQP
test binary-12.9 {Tcl_BinaryObjCmd: format} {
    binary format I2 {0x50 0x52}
} \x00\x00\x00P\x00\x00\x00R
test binary-12.10 {Tcl_BinaryObjCmd: format} {
    binary format I* {0x50515253 0x52}
} PQRS\x00\x00\x00R
test binary-12.11 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format i2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-12.12 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    list [catch {binary format I $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-12.13 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format I1 $a
} \x00\x00\x00P

test binary-13.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format f} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-13.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format f blat} msg] $msg
} {1 {expected floating-point number but got "blat"}}
test binary-13.3 {Tcl_BinaryObjCmd: format} {
    binary format f0 1.6
} {}
test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f 1.6
} \x3f\xcc\xcc\xcd
test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f 1.6
} \xcd\xcc\xcc\x3f
test binary-13.6 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f* {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f* {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.8 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f2 {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f2 {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.10 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f2 {1.6 3.4 5.6}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f2 {1.6 3.4 5.6}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
    binary format f -3.402825e+38
} \xff\x7f\xff\xff
test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
    binary format f -3.402825e+38
} \xff\xff\x7f\xff
test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
    binary format f -3.402825e-100
} \x80\x00\x00\x00
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
    binary format f -3.402825e-100
} \x00\x00\x00\x80
test binary-13.16 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format f2 {1.6}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-13.17 {Tcl_BinaryObjCmd: format} {
    set a {1.6 3.4}
    list [catch {binary format f $a} msg] $msg
} [list 1 "expected floating-point number but got \"1.6 3.4\""]
test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian {
    set a {1.6 3.4}
    binary format f1 $a
} \x3f\xcc\xcc\xcd
test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {1.6 3.4}
    binary format f1 $a
} \xcd\xcc\xcc\x3f

test binary-14.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format d} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-14.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format d blat} msg] $msg
} {1 {expected floating-point number but got "blat"}}
test binary-14.3 {Tcl_BinaryObjCmd: format} {
    binary format d0 1.6
} {}
test binary-14.4 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d 1.6
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-14.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d 1.6
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-14.6 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d* {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-14.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d* {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-14.8 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d2 {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-14.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d2 {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d2 {1.6 3.4 5.6}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-14.14 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format d2 {1.6}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-14.15 {Tcl_BinaryObjCmd: format} {
    set a {1.6 3.4}
    list [catch {binary format d $a} msg] $msg
} [list 1 "expected floating-point number but got \"1.6 3.4\""]
test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian {
    set a {1.6 3.4}
    binary format d1 $a
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {1.6 3.4}
    binary format d1 $a
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-14.18 {FormatNumber: Bug 1116542} {
    binary scan [binary format d 1.25] d w
    set w
} 1.25

test binary-15.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format ax*a "y" "z"} msg] $msg
} {1 {cannot use "*" in format string with "x"}}
test binary-15.2 {Tcl_BinaryObjCmd: format} {
    binary format axa "y" "z"
} y\x00z
test binary-15.3 {Tcl_BinaryObjCmd: format} {
    binary format ax3a "y" "z"
} y\x00\x00\x00z
test binary-15.4 {Tcl_BinaryObjCmd: format} {
    binary format a*X3x3a* "foo" "z"
} \x00\x00\x00z
test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x0s 1
} \x01\x00
test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x0ss 1 1
} \x01\x00\x01\x00
test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x1s 1
} \x00\x01\x00
test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x1ss 1 1
} \x00\x01\x00\x01\x00

test binary-16.1 {Tcl_BinaryObjCmd: format} {
    binary format a*X*a "foo" "z"
} zoo
test binary-16.2 {Tcl_BinaryObjCmd: format} {
    binary format aX3a "y" "z"
} z
test binary-16.3 {Tcl_BinaryObjCmd: format} {
    binary format a*Xa* "foo" "zy"
} fozy
test binary-16.4 {Tcl_BinaryObjCmd: format} {
    binary format a*X3a "foobar" "z"
} foozar
test binary-16.5 {Tcl_BinaryObjCmd: format} {
    binary format a*X3aX2a "foobar" "z" "b"
} fobzar

test binary-17.1 {Tcl_BinaryObjCmd: format} {
    binary format @1
} \x00
test binary-17.2 {Tcl_BinaryObjCmd: format} {
    binary format @5a2 "ab"
} \x00\x00\x00\x00\x00\x61\x62
test binary-17.3 {Tcl_BinaryObjCmd: format} {
    binary format {a*  @0  a2 @* a*} "foobar" "ab" "blat"
} abobarblat

test binary-18.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format u0a3 abc abd} msg] $msg
} {1 {bad field specifier "u"}}


test binary-19.1 {Tcl_BinaryObjCmd: errors} {
    list [catch {binary s} msg] $msg
} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
test binary-19.2 {Tcl_BinaryObjCmd: errors} {
    list [catch {binary scan foo} msg] $msg
} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
test binary-19.3 {Tcl_BinaryObjCmd: scan} {
    binary scan {} {}
} 0

test binary-20.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc a} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-20.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan abc a arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-20.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 abc
    list [binary scan abc a0 arg1] $arg1
} {1 {}}
test binary-20.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc a* arg1] $arg1
} {1 abc}
test binary-20.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc a5 arg1] [info exists arg1]
} {0 0}
test binary-20.6 {Tcl_BinaryObjCmd: scan} {
    set arg1 foo
    list [binary scan abc a2 arg1] $arg1
} {1 ab}
test binary-20.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
} {2 ab cd}
test binary-20.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc a2 arg1(a)] $arg1(a)
} {1 ab}
test binary-20.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc a arg1(a)] $arg1(a)
} {1 a}

test binary-21.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc A} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-21.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan abc A arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-21.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 abc
    list [binary scan abc A0 arg1] $arg1
} {1 {}}
test binary-21.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc A* arg1] $arg1
} {1 abc}
test binary-21.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc A5 arg1] [info exists arg1]
} {0 0}
test binary-21.6 {Tcl_BinaryObjCmd: scan} {
    set arg1 foo
    list [binary scan abc A2 arg1] $arg1
} {1 ab}
test binary-21.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
} {2 ab cd}
test binary-21.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc A2 arg1(a)] $arg1(a)
} {1 ab}
test binary-21.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc A2 arg1(a)] $arg1(a)
} {1 ab}
test binary-21.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc A arg1(a)] $arg1(a)
} {1 a}
test binary-21.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan "abc def \x00  " A* arg1] $arg1
} {1 {abc def}}
test binary-21.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan "abc def \x00ghi  " A* arg1] $arg1
} [list 1 "abc def \x00ghi"]

test binary-22.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc b} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-22.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 b* arg1] $arg1
} {1 0100101011001010}
test binary-22.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x82\x53 b arg1] $arg1
} {1 0}
test binary-22.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x82\x53 b1 arg1] $arg1
} {1 0}
test binary-22.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x82\x53 b0 arg1] $arg1
} {1 {}}
test binary-22.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 b5 arg1] $arg1
} {1 01001}
test binary-22.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 b8 arg1] $arg1
} {1 01001010}
test binary-22.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 b14 arg1] $arg1
} {1 01001010110010}
test binary-22.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 b14 arg1] $arg1
} {0 foo}
test binary-22.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 b1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-22.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
} {2 11100 1110000110100000}


test binary-23.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc B} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-23.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 B* arg1] $arg1
} {1 0101001001010011}
test binary-23.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x82\x53 B arg1] $arg1
} {1 1}
test binary-23.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x82\x53 B1 arg1] $arg1
} {1 1}
test binary-23.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 B0 arg1] $arg1
} {1 {}}
test binary-23.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 B5 arg1] $arg1
} {1 01010}
test binary-23.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 B8 arg1] $arg1
} {1 01010010}
test binary-23.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 B14 arg1] $arg1
} {1 01010010010100}
test binary-23.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 B14 arg1] $arg1
} {0 foo}
test binary-23.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 B1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-23.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
} {2 01110 1000011100000101}

test binary-24.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc h} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-24.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 h* arg1] $arg1
} {1 253a}
test binary-24.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xc2\xa3 h arg1] $arg1
} {1 2}
test binary-24.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x82\x53 h1 arg1] $arg1
} {1 2}
test binary-24.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 h0 arg1] $arg1
} {1 {}}
test binary-24.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xf2\x53 h2 arg1] $arg1
} {1 2f}
test binary-24.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 h3 arg1] $arg1
} {1 253}
test binary-24.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 h3 arg1] $arg1
} {0 foo}
test binary-24.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 h1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-24.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
} {2 07 7850}

test binary-25.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc H} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-25.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 H* arg1] $arg1
} {1 52a3}
test binary-25.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xc2\xa3 H arg1] $arg1
} {1 c}
test binary-25.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x82\x53 H1 arg1] $arg1
} {1 8}
test binary-25.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 H0 arg1] $arg1
} {1 {}}
test binary-25.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xf2\x53 H2 arg1] $arg1
} {1 f2}
test binary-25.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\x53 H3 arg1] $arg1
} {1 525}
test binary-25.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 H3 arg1] $arg1
} {0 foo}
test binary-25.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 H1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-25.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
} {2 70 8705}

test binary-26.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc c} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-26.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 c* arg1] $arg1
} {1 {82 -93}}
test binary-26.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 c arg1] $arg1
} {1 82}
test binary-26.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 c1 arg1] $arg1
} {1 82}
test binary-26.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 c0 arg1] $arg1
} {1 {}}
test binary-26.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-26.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xff c arg1] $arg1
} {1 -1}
test binary-26.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 c3 arg1] $arg1
} {0 foo}
test binary-26.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 c1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-26.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
} {2 {112 -121} 5}
test binary-26.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 cu* arg1] $arg1
} {1 {82 163}}
test binary-26.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 cu arg1] $arg1
} {1 82}
test binary-26.13 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xff cu arg1] $arg1
} {1 255}
test binary-26.14 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
} {2 128 -128}
test binary-26.15 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
} {2 -128 128}

test binary-27.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc s} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-27.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
} {1 {-23726 21587}}
test binary-27.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
} {1 -23726}
test binary-27.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 s1 arg1] $arg1
} {1 -23726}
test binary-27.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 s0 arg1] $arg1
} {1 {}}
test binary-27.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
} {1 {-23726 21587}}
test binary-27.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 s1 arg1] $arg1
} {0 foo}
test binary-27.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 s1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-27.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
} {1 {41810 21587}}
test binary-27.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2
} {2 65535 -1}
test binary-27.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2
} {2 -1 65535}

test binary-28.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc S} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-28.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
} {1 {21155 21332}}
test binary-28.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
} {1 21155}
test binary-28.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 S1 arg1] $arg1
} {1 21155}
test binary-28.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3 S0 arg1] $arg1
} {1 {}}
test binary-28.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
} {1 {21155 21332}}
test binary-28.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 S1 arg1] $arg1
} {0 foo}
test binary-28.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 S1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-28.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
} {1 {21155 21332}}
test binary-28.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
} {1 {41810 21587}}

test binary-29.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc i} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-29.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
} {1 1414767442}
test binary-29.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
} {1 1414767442}
test binary-29.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53 i0 arg1] $arg1
} {1 {}}
test binary-29.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 i1 arg1] $arg1
} {0 foo}
test binary-29.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53\x53\x54 i1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-29.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-29.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-29.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-29.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
} {2 128 2147483648}

test binary-30.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc I} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-30.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
} {1 1386435412}
test binary-30.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
} {1 1386435412}
test binary-30.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53 I0 arg1] $arg1
} {1 {}}
test binary-30.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 I1 arg1] $arg1
} {0 foo}
test binary-30.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53\x53\x54 I1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-30.9 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-30.10 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-30.11 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-30.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1 arg2}
    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
} {2 2147483648 128}
testConstraint testbytestring [llength [info commands testbytestring]]

test binary-31.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc f} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1
} {1 1.600000023841858}
test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1
} {1 1.600000023841858}
test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
} {1 {}}
test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
} {1 {}}
test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 f1 arg1] $arg1
} {0 foo}
test binary-31.13 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x3f\xcc\xcc\xcd f1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}

test binary-32.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc d} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1
} {1 1.6}
test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1
} {1 1.6}
test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1
} {1 1.6}
test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1
} {1 1.6}
test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1
} {1 {}}
test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1
} {1 {}}
test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 d1 arg1] $arg1
} {0 foo}
test binary-32.13 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}

test binary-33.1 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
} {2 ab def}
test binary-33.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    set arg2 foo
    list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    set arg2 foo
    list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    set arg2 foo
    list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x1a1 arg1] $arg1
} {1 b}
test binary-33.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x5a1 arg1] $arg1
} {1 f}
test binary-33.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x0a1 arg1] $arg1
} {1 a}

test binary-34.1 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
} {2 ab bcd}
test binary-34.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    set arg2 foo
    list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    set arg2 foo
    list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abc X20a3 arg1] $arg1
} {1 abc}
test binary-34.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x*X1a1 arg1] $arg1
} {1 f}
test binary-34.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x*X5a1 arg1] $arg1
} {1 b}
test binary-34.7 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x3X0a1 arg1] $arg1
} {1 d}

test binary-35.1 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    list [catch {binary scan abcdefg a2@a3 arg1 arg2} msg] $msg
} {1 {missing count for "@" field specifier}}
test binary-35.2 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    set arg2 foo
    list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.3 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    catch {unset arg2}
    set arg2 foo
    list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.4 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef @2a3 arg1] $arg1
} {1 cde}
test binary-35.5 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x*@1a1 arg1] $arg1
} {1 b}
test binary-35.6 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    list [binary scan abcdef x*@0a1 arg1] $arg1
} {1 a}

test binary-36.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abcdef u0a3} msg] $msg
} {1 {bad field specifier "u"}}

# GetFormatSpec is pretty thoroughly tested above, but there are a few
# cases we should text explicitly

test binary-37.1 {GetFormatSpec: whitespace} {
    binary format "a3 a5     a3" foo barblat baz
} foobarblbaz
test binary-37.2 {GetFormatSpec: whitespace} {
    binary format "      " foo
} {}
test binary-37.3 {GetFormatSpec: whitespace} {
    binary format "     a3" foo
} foo
test binary-37.4 {GetFormatSpec: whitespace} {
    binary format "" foo
} {}
test binary-37.5 {GetFormatSpec: whitespace} {
    binary format "" foo
} {}
test binary-37.6 {GetFormatSpec: whitespace} {
    binary format "     a3   " foo
} foo
test binary-37.7 {GetFormatSpec: numbers} {
    list [catch {binary scan abcdef "x-1" foo} msg] $msg
} {1 {bad field specifier "-"}}
test binary-37.8 {GetFormatSpec: numbers} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan abcdef "a0x3" arg1] $arg1
} {1 {}}
test binary-37.9 {GetFormatSpec: numbers} {
    # test format of neg numbers
    # bug report/fix provided by Harald Kirsch
    set x [binary format f* {1 -1 2 -2 0}]
    binary scan $x f* bla
    set bla
} {1.0 -1.0 2.0 -2.0 0.0}
test binary-37.10 {GetFormatSpec: count overflow} {
    binary scan x a[format %ld 0x7fffffff] r
} 0
test binary-37.11 {GetFormatSpec: count overflow} {
    binary scan x a[format %ld 0x10000000] r
} 0
test binary-37.12 {GetFormatSpec: count overflow} {
    binary scan x a[format %ld 0x100000000] r
} 0
test binary-37.13 {GetFormatSpec: count overflow} {
    binary scan x a[format %lld 0x10000000000000000] r
} 0

test binary-38.1 {FormatNumber: word alignment} {
    set x [binary format c1s1 1 1]
} \x01\x01\x00
test binary-38.2 {FormatNumber: word alignment} {
    set x [binary format c1S1 1 1]
} \x01\x00\x01
test binary-38.3 {FormatNumber: word alignment} {
    set x [binary format c1i1 1 1]
} \x01\x01\x00\x00\x00
test binary-38.4 {FormatNumber: word alignment} {
    set x [binary format c1I1 1 1]
} \x01\x00\x00\x00\x01
test binary-38.5 {FormatNumber: word alignment} bigEndian {
    set x [binary format c1d1 1 1.6]
} \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-38.6 {FormatNumber: word alignment} littleEndian {
    set x [binary format c1d1 1 1.6]
} \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-38.7 {FormatNumber: word alignment} bigEndian {
    set x [binary format c1f1 1 1.6]
} \x01\x3f\xcc\xcc\xcd
test binary-38.8 {FormatNumber: word alignment} littleEndian {
    set x [binary format c1f1 1 1.6]
} \x01\xcd\xcc\xcc\x3f

test binary-39.1 {ScanNumber: sign extension} {
    catch {unset arg1}
    list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-39.2 {ScanNumber: sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
} {1 {513 -32511 386 -32127}}
test binary-39.3 {ScanNumber: sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
} {1 {258 385 -32255 -32382}}
test binary-39.4 {ScanNumber: sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 -2130640639}}
test binary-39.5 {ScanNumber: sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
} {1 {16843010 -2130640639 25297153 16876033 16843137}}
test binary-39.6 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x52\xa3 cu2 arg1] $arg1
} {1 {82 163}}
test binary-39.7 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
} {1 {513 33025 386 33409}}
test binary-39.8 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
} {1 {258 385 33281 33154}}
test binary-39.9 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 2164326657}}
test binary-39.10 {ScanNumber: no sign extension} {
    catch {unset arg1}
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
} {1 {16843010 2164326657 25297153 16876033 16843137}}

test binary-40.3 {ScanNumber: NaN} \
    -body {
	catch {unset arg1}
	list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
    } \
    -match glob \
    -result {1 -NaN*}

test binary-40.4 {ScanNumber: NaN} \
    -body {
	catch {unset arg1}
	list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
    } \
    -match glob \
    -result {1 -NaN*}

test binary-41.1 {ScanNumber: word alignment} {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.2 {ScanNumber: word alignment} {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.3 {ScanNumber: word alignment} {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.4 {ScanNumber: word alignment} {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.5 {ScanNumber: word alignment} bigEndian {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.600000023841858}
test binary-41.6 {ScanNumber: word alignment} littleEndian {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.600000023841858}
test binary-41.7 {ScanNumber: word alignment} bigEndian {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}
test binary-41.8 {ScanNumber: word alignment} littleEndian {
    catch {unset arg1; unset arg2}
    list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}

test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} {
    catch {binary ?} result
    set result
} {bad option "?": must be format or scan}

# Wide int (guaranteed at least 64-bit) handling
test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format w 7810179016327718216
} HelloTcl
test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format W 7810179016327718216
} lcTolleH

test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan HelloTcl W x
    set x
} 5216694956358656876
test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan lcTolleH w x
    set x
} 5216694956358656876
test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944
test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
    catch {unset arg1}
    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
} {1 -9223372036854775808}
test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1}
    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1}
    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1 arg2}
    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    catch {unset arg1 arg2}
    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}

test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sws 16450 -1 19521] c* x
    set x
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
    set x
} {66 64 0 0 0 0 127 -1 -1 -1 65 76}

test binary-46.1 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    binary format a* \u20ac
} \u00ac
test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    list [binary scan [binary format a* \u20ac\u20bd] s x] $x
} {1 -16980}
test binary-46.3 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x {}
    set y {}
    set z {}
    list [binary scan [binary format a* \u20ac\u20bd] aaa x y z] $x $y $z
} "2 \u00ac \u00bd {}"
test binary-46.4 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x [encoding convertto iso8859-15 \u20ac]
    set y [binary format a* $x]
    list $x $y
} "\u00a4 \u00a4"
test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x [binary scan \u00a4 a* y]
    list $x $y [encoding convertfrom iso8859-15 $y]
} "1 \u00a4 \u20ac"

test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
    # This test is only reliable when memory debugging is turned on,
    # but without even memory debugging it should still generate the
    # expected answers and might therefore still pick up memory corruption
    # caused by [Bug 851747].
    list [binary scan aba ccc x x x] $x
} {3 97}

### TIP#129: endian specifiers ----

# format t
test binary-48.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format t} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-48.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format t blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-48.3 {Tcl_BinaryObjCmd: format} {
    binary format S0 0x50
} {}
test binary-48.4 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t 0x50
} \x00P
test binary-48.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t 0x50
} P\x00
test binary-48.6 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t 0x5052
} PR
test binary-48.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t 0x5052
} RP
test binary-48.8 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t 0x505251 0x53
} RQ
test binary-48.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t 0x505251 0x53
} QR
test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t2 {0x50 0x52}
} \x00P\x00R
test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t2 {0x50 0x52}
} P\x00R\x00
test binary-48.12 {Tcl_BinaryObjCmd: format}  bigEndian {
    binary format t* {0x5051 0x52}
} PQ\x00R
test binary-48.13 {Tcl_BinaryObjCmd: format}  littleEndian {
    binary format t* {0x5051 0x52}
} QPR\x00
test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t2 {0x50 0x52 0x53} 0x54
} \x00P\x00R
test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
test binary-48.16 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format t2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-48.17 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    list [catch {binary format t $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian {
    set a {0x50 0x51}
    binary format t1 $a
} \x00P
test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {0x50 0x51}
    binary format t1 $a
} P\x00

# format n
test binary-49.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format n} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-49.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format n blat} msg] $msg
} {1 {expected integer but got "blat"}}
test binary-49.3 {Tcl_BinaryObjCmd: format} {
    binary format n0 0x50
} {}
test binary-49.4 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x50
} P\x00\x00\x00
test binary-49.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x5052
} RP\x00\x00
test binary-49.6 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x505251 0x53
} QRP\x00
test binary-49.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format i1 {0x505251 0x53}
} QRP\x00
test binary-49.8 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x53525150
} PQRS
test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n2 {0x50 0x52}
} P\x00\x00\x00R\x00\x00\x00
test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n* {0x50515253 0x52}
} SRQPR\x00\x00\x00
test binary-49.11 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format n2 {0x50}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-49.12 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    list [catch {binary format n $a} msg] $msg
} [list 1 "expected integer but got \"0x50 0x51\""]
test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {0x50 0x51}
    binary format n1 $a
} P\x00\x00\x00
test binary-49.14 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x50
} \x00\x00\x00P
test binary-49.15 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x5052
} \x00\x00PR
test binary-49.16 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x505251 0x53
} \x00PRQ
test binary-49.17 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format i1 {0x505251 0x53}
} QRP\x00
test binary-49.18 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x53525150
} SRQP
test binary-49.19 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n2 {0x50 0x52}
} \x00\x00\x00P\x00\x00\x00R
test binary-49.20 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n* {0x50515253 0x52}
} PQRS\x00\x00\x00R

# format m
test binary-50.1 {Tcl_BinaryObjCmd: format wide int} littleEndian {
    binary format m 7810179016327718216
} HelloTcl
test binary-50.2 {Tcl_BinaryObjCmd: format wide int} bigEndian {
    binary format m 7810179016327718216
} lcTolleH
test binary-50.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
    binary scan [binary format m [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
    binary scan [binary format m [expr {wide(3) << 31}]] W x
    set x
} 6442450944


# format Q/q
test binary-51.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format Q} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-51.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format q blat} msg] $msg
} {1 {expected floating-point number but got "blat"}}
test binary-51.3 {Tcl_BinaryObjCmd: format} {
    binary format q0 1.6
} {}
test binary-51.4 {Tcl_BinaryObjCmd: format} {} {
    binary format Q 1.6
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-51.5 {Tcl_BinaryObjCmd: format} {} {
    binary format q 1.6
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-51.6 {Tcl_BinaryObjCmd: format} {} {
    binary format Q* {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-51.7 {Tcl_BinaryObjCmd: format} {} {
    binary format q* {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-51.8 {Tcl_BinaryObjCmd: format} {} {
    binary format Q2 {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-51.9 {Tcl_BinaryObjCmd: format} {} {
    binary format q2 {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-51.10 {Tcl_BinaryObjCmd: format} {} {
    binary format Q2 {1.6 3.4 5.6}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-51.11 {Tcl_BinaryObjCmd: format} {} {
    binary format q2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-51.14 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format q2 {1.6}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-51.15 {Tcl_BinaryObjCmd: format} {
    set a {1.6 3.4}
    list [catch {binary format q $a} msg] $msg
} [list 1 "expected floating-point number but got \"1.6 3.4\""]
test binary-51.16 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format Q1 $a
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-51.17 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format q1 $a
} \x9a\x99\x99\x99\x99\x99\xf9\x3f

# format R/r
test binary-53.1 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format r} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-53.2 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format r blat} msg] $msg
} {1 {expected floating-point number but got "blat"}}
test binary-53.3 {Tcl_BinaryObjCmd: format} {
    binary format f0 1.6
} {}
test binary-53.4 {Tcl_BinaryObjCmd: format} {} {
    binary format R 1.6
} \x3f\xcc\xcc\xcd
test binary-53.5 {Tcl_BinaryObjCmd: format} {} {
    binary format r 1.6
} \xcd\xcc\xcc\x3f
test binary-53.6 {Tcl_BinaryObjCmd: format} {} {
    binary format R* {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-53.7 {Tcl_BinaryObjCmd: format} {} {
    binary format r* {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-53.8 {Tcl_BinaryObjCmd: format} {} {
    binary format R2 {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-53.9 {Tcl_BinaryObjCmd: format} {} {
    binary format r2 {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-53.10 {Tcl_BinaryObjCmd: format} {} {
    binary format R2 {1.6 3.4 5.6}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
    binary format r2 {1.6 3.4 5.6}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format R -3.402825e+38
} \xff\x7f\xff\xff
test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format r -3.402825e+38
} \xff\xff\x7f\xff
test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format R -3.402825e-100
} \x80\x00\x00\x00
test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format r -3.402825e-100
} \x00\x00\x00\x80
test binary-53.16 {Tcl_BinaryObjCmd: format} {
    list [catch {binary format r2 {1.6}} msg] $msg
} {1 {number of elements in list does not match count}}
test binary-53.17 {Tcl_BinaryObjCmd: format} {
    set a {1.6 3.4}
    list [catch {binary format r $a} msg] $msg
} [list 1 "expected floating-point number but got \"1.6 3.4\""]
test binary-53.18 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format R1 $a
} \x3f\xcc\xcc\xcd
test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format r1 $a
} \xcd\xcc\xcc\x3f

# scan t (s)
test binary-54.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc t} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {-23726 21587}}
test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 -23726}
test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 -23726}
test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {-23726 21587}}
test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-54.8 {Tcl_BinaryObjCmd: scan} {} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}

# scan t (b)
test binary-55.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc t} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {21155 21332}}
test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 21155}
test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 21155}
test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {21155 21332}}
test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-55.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}

# scan n (s)
test binary-56.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc n} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1414767442}
test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1414767442}
test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-56.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 128 128}
test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}

# scan n (b)
test binary-57.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc n} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1386435412}
test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1386435412}
test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-57.8 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}
test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian  {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 128 128}

# scan Q/q
test binary-58.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc q} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1
} {1 1.6}
test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1
} {1 1.6}
test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1
} {1 1.6}
test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1
} {1 1.6}
test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1
} {1 {}}
test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1
} {1 {}}
test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 q1 arg1] $arg1
} {0 foo}
test binary-58.13 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}

# scan R/r
test binary-59.1 {Tcl_BinaryObjCmd: scan} {
    list [catch {binary scan abc r} msg] $msg
} {1 {not enough arguments for all format specifiers}}
test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1
} {1 1.600000023841858}
test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1
} {1 1.600000023841858}
test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1
} {1 {}}
test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1
} {1 {}}
test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1}
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1}
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.12 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 foo
    list [binary scan \x52 r1 arg1] $arg1
} {0 foo}
test binary-59.13 {Tcl_BinaryObjCmd: scan} {
    catch {unset arg1}
    set arg1 1
    list [catch {binary scan \x3f\xcc\xcc\xcd r1 arg1(a)} msg] $msg
} {1 {can't set "arg1(a)": variable isn't array}}
test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    catch {unset arg1 arg2}
    set arg1 foo
    set arg2 bar
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}

test binary-60.1 {[binary format] with NaN} -body {
    binary scan [binary format dqQfrR NaN NaN NaN NaN NaN NaN] dqQfrR \
	v1 v2 v3 v4 v5 v6
    list $v1 $v2 $v3 $v4 $v5 $v6
} -match regexp -result {NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))?}

# scan m
test binary-61.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian {
    binary scan HelloTcl m x
    set x
} 5216694956358656876
test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian {
    binary scan lcTolleH m x
    set x
} 5216694956358656876
test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set}  littleEndian {
    binary scan [binary format w [expr {wide(3) << 31}]] m x
    set x
} 6442450944
test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
    binary scan [binary format W [expr {wide(3) << 31}]] m x
    set x
} 6442450944

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
	    # little endian
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
2318
2319
2320
2321
2322
2323
2324

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































2325
2326
2327
2328
2329
2330
2331







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]

# ----------------------------------------------------------------------

test binary-0.1 {DupByteArrayInternalRep} {
    set hdr [binary format cc 0 0316]
    set buf hellomatt
    set data $hdr
    append data $buf
    string length $data
} 11

test binary-1.1 {Tcl_BinaryObjCmd: bad args} -body {
    binary
} -returnCodes error -match glob -result {wrong # args: *}
test binary-1.2 {Tcl_BinaryObjCmd: bad args} -returnCodes error -body {
    binary foo
} -match glob -result {unknown or ambiguous subcommand "foo": *}
test binary-1.3 {Tcl_BinaryObjCmd: format error} -returnCodes error -body {
    binary f
} -result {wrong # args: should be "binary format formatString ?arg ...?"}
test binary-1.4 {Tcl_BinaryObjCmd: format} -body {
    binary format ""
} -result {}

test binary-2.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format a
} -result {not enough arguments for all format specifiers}
test binary-2.2 {Tcl_BinaryObjCmd: format} {
    binary format a0 foo
} {}
test binary-2.3 {Tcl_BinaryObjCmd: format} {
    binary format a f
} {f}
test binary-2.4 {Tcl_BinaryObjCmd: format} {
    binary format a foo
} {f}
test binary-2.5 {Tcl_BinaryObjCmd: format} {
    binary format a3 foo
} {foo}
test binary-2.6 {Tcl_BinaryObjCmd: format} {
    binary format a5 foo
} foo\x00\x00
test binary-2.7 {Tcl_BinaryObjCmd: format} {
    binary format a*a3 foobarbaz blat
} foobarbazbla
test binary-2.8 {Tcl_BinaryObjCmd: format} {
    binary format a*X3a2 foobar x
} foox\x00r

test binary-3.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format A
} -result {not enough arguments for all format specifiers}
test binary-3.2 {Tcl_BinaryObjCmd: format} {
    binary format A0 f
} {}
test binary-3.3 {Tcl_BinaryObjCmd: format} {
    binary format A f
} {f}
test binary-3.4 {Tcl_BinaryObjCmd: format} {
    binary format A foo
} {f}
test binary-3.5 {Tcl_BinaryObjCmd: format} {
    binary format A3 foo
} {foo}
test binary-3.6 {Tcl_BinaryObjCmd: format} {
    binary format A5 foo
} {foo  }
test binary-3.7 {Tcl_BinaryObjCmd: format} {
    binary format A*A3 foobarbaz blat
} foobarbazbla
test binary-3.8 {Tcl_BinaryObjCmd: format} {
    binary format A*X3A2 foobar x
} {foox r}

test binary-4.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format B
} -result {not enough arguments for all format specifiers}
test binary-4.2 {Tcl_BinaryObjCmd: format} {
    binary format B0 1
} {}
test binary-4.3 {Tcl_BinaryObjCmd: format} {
    binary format B 1
} \x80
test binary-4.4 {Tcl_BinaryObjCmd: format} {
    binary format B* 010011
} \x4c
test binary-4.5 {Tcl_BinaryObjCmd: format} {
    binary format B8 01001101
} \x4d
test binary-4.6 {Tcl_BinaryObjCmd: format} {
    binary format A2X2B9 oo 01001101
} \x4d\x00
test binary-4.7 {Tcl_BinaryObjCmd: format} {
    binary format B9 010011011010
} \x4d\x80
test binary-4.8 {Tcl_BinaryObjCmd: format} {
    binary format B2B3 10 010
} \x80\x40
test binary-4.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format B1B5 1 foo
} -result {expected binary string but got "foo" instead}

test binary-5.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format b
} -result {not enough arguments for all format specifiers}
test binary-5.2 {Tcl_BinaryObjCmd: format} {
    binary format b0 1
} {}
test binary-5.3 {Tcl_BinaryObjCmd: format} {
    binary format b 1
} \x01
test binary-5.4 {Tcl_BinaryObjCmd: format} {
    binary format b* 010011
} 2
test binary-5.5 {Tcl_BinaryObjCmd: format} {
    binary format b8 01001101
} \xb2
test binary-5.6 {Tcl_BinaryObjCmd: format} {
    binary format A2X2b9 oo 01001101
} \xb2\x00
test binary-5.7 {Tcl_BinaryObjCmd: format} {
    binary format b9 010011011010
} \xb2\x01
test binary-5.8 {Tcl_BinaryObjCmd: format} {
    binary format b17 1
} \x01\00\00
test binary-5.9 {Tcl_BinaryObjCmd: format} {
    binary format b2b3 10 010
} \x01\x02
test binary-5.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format b1b5 1 foo
} -result {expected binary string but got "foo" instead}

test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format h
} -result {not enough arguments for all format specifiers}
test binary-6.2 {Tcl_BinaryObjCmd: format} {
    binary format h0 1
} {}
test binary-6.3 {Tcl_BinaryObjCmd: format} {
    binary format h 1
} \x01
test binary-6.4 {Tcl_BinaryObjCmd: format} {
    binary format h c
} \x0c
test binary-6.5 {Tcl_BinaryObjCmd: format} {
    binary format h* baadf00d
} \xab\xda\x0f\xd0
test binary-6.6 {Tcl_BinaryObjCmd: format} {
    binary format h4 c410
} \x4c\x01
test binary-6.7 {Tcl_BinaryObjCmd: format} {
    binary format h6 c4102
} \x4c\x01\x02
test binary-6.8 {Tcl_BinaryObjCmd: format} {
    binary format h5 c41020304
} \x4c\x01\x02
test binary-6.9 {Tcl_BinaryObjCmd: format} {
    binary format a3X3h5 foo 2
} \x02\x00\x00
test binary-6.10 {Tcl_BinaryObjCmd: format} {
    binary format h2h3 23 456
} \x32\x54\x06
test binary-6.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format h2 foo
} -result {expected hexadecimal string but got "foo" instead}

test binary-7.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format H
} -result {not enough arguments for all format specifiers}
test binary-7.2 {Tcl_BinaryObjCmd: format} {
    binary format H0 1
} {}
test binary-7.3 {Tcl_BinaryObjCmd: format} {
    binary format H 1
} \x10
test binary-7.4 {Tcl_BinaryObjCmd: format} {
    binary format H c
} \xc0
test binary-7.5 {Tcl_BinaryObjCmd: format} {
    binary format H* baadf00d
} \xba\xad\xf0\x0d
test binary-7.6 {Tcl_BinaryObjCmd: format} {
    binary format H4 c410
} \xc4\x10
test binary-7.7 {Tcl_BinaryObjCmd: format} {
    binary format H6 c4102
} \xc4\x10\x20
test binary-7.8 {Tcl_BinaryObjCmd: format} {
    binary format H5 c41023304
} \xc4\x10\x20
test binary-7.9 {Tcl_BinaryObjCmd: format} {
    binary format a3X3H5 foo 2
} \x20\x00\x00
test binary-7.10 {Tcl_BinaryObjCmd: format} {
    binary format H2H3 23 456
} \x23\x45\x60
test binary-7.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format H2 foo
} -result {expected hexadecimal string but got "foo" instead}

test binary-8.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format c
} -result {not enough arguments for all format specifiers}
test binary-8.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format c blat
} -result {expected integer but got "blat"}
test binary-8.3 {Tcl_BinaryObjCmd: format} {
    binary format c0 0x50
} {}
test binary-8.4 {Tcl_BinaryObjCmd: format} {
    binary format c 0x50
} P
test binary-8.5 {Tcl_BinaryObjCmd: format} {
    binary format c 0x5052
} R
test binary-8.6 {Tcl_BinaryObjCmd: format} {
    binary format c2 {0x50 0x52}
} PR
test binary-8.7 {Tcl_BinaryObjCmd: format} {
    binary format c2 {0x50 0x52 0x53}
} PR
test binary-8.8 {Tcl_BinaryObjCmd: format} {
    binary format c* {0x50 0x52}
} PR
test binary-8.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format c2 {0x50}
} -result {number of elements in list does not match count}
test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {0x50 0x51}
    binary format c $a
} -result "expected integer but got \"0x50 0x51\""
test binary-8.11 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format c1 $a
} P

test binary-9.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format s
} -result {not enough arguments for all format specifiers}
test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format s blat
} -result {expected integer but got "blat"}
test binary-9.3 {Tcl_BinaryObjCmd: format} {
    binary format s0 0x50
} {}
test binary-9.4 {Tcl_BinaryObjCmd: format} {
    binary format s 0x50
} P\x00
test binary-9.5 {Tcl_BinaryObjCmd: format} {
    binary format s 0x5052
} RP
test binary-9.6 {Tcl_BinaryObjCmd: format} {
    binary format s 0x505251 0x53
} QR
test binary-9.7 {Tcl_BinaryObjCmd: format} {
    binary format s2 {0x50 0x52}
} P\x00R\x00
test binary-9.8 {Tcl_BinaryObjCmd: format} {
    binary format s* {0x5051 0x52}
} QPR\x00
test binary-9.9 {Tcl_BinaryObjCmd: format} {
    binary format s2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
test binary-9.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format s2 {0x50}
} -result {number of elements in list does not match count}
test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {0x50 0x51}
    binary format s $a
} -result "expected integer but got \"0x50 0x51\""
test binary-9.12 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format s1 $a
} P\x00

test binary-10.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format S
} -result {not enough arguments for all format specifiers}
test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format S blat
} -result {expected integer but got "blat"}
test binary-10.3 {Tcl_BinaryObjCmd: format} {
    binary format S0 0x50
} {}
test binary-10.4 {Tcl_BinaryObjCmd: format} {
    binary format S 0x50
} \x00P
test binary-10.5 {Tcl_BinaryObjCmd: format} {
    binary format S 0x5052
} PR
test binary-10.6 {Tcl_BinaryObjCmd: format} {
    binary format S 0x505251 0x53
} RQ
test binary-10.7 {Tcl_BinaryObjCmd: format} {
    binary format S2 {0x50 0x52}
} \x00P\x00R
test binary-10.8 {Tcl_BinaryObjCmd: format} {
    binary format S* {0x5051 0x52}
} PQ\x00R
test binary-10.9 {Tcl_BinaryObjCmd: format} {
    binary format S2 {0x50 0x52 0x53} 0x54
} \x00P\x00R
test binary-10.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format S2 {0x50}
} -result {number of elements in list does not match count}
test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {0x50 0x51}
    binary format S $a
} -result "expected integer but got \"0x50 0x51\""
test binary-10.12 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format S1 $a
} \x00P

test binary-11.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format i
} -result {not enough arguments for all format specifiers}
test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format i blat
} -result {expected integer but got "blat"}
test binary-11.3 {Tcl_BinaryObjCmd: format} {
    binary format i0 0x50
} {}
test binary-11.4 {Tcl_BinaryObjCmd: format} {
    binary format i 0x50
} P\x00\x00\x00
test binary-11.5 {Tcl_BinaryObjCmd: format} {
    binary format i 0x5052
} RP\x00\x00
test binary-11.6 {Tcl_BinaryObjCmd: format} {
    binary format i 0x505251 0x53
} QRP\x00
test binary-11.7 {Tcl_BinaryObjCmd: format} {
    binary format i1 {0x505251 0x53}
} QRP\x00
test binary-11.8 {Tcl_BinaryObjCmd: format} {
    binary format i 0x53525150
} PQRS
test binary-11.9 {Tcl_BinaryObjCmd: format} {
    binary format i2 {0x50 0x52}
} P\x00\x00\x00R\x00\x00\x00
test binary-11.10 {Tcl_BinaryObjCmd: format} {
    binary format i* {0x50515253 0x52}
} SRQPR\x00\x00\x00
test binary-11.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format i2 {0x50}
} -result {number of elements in list does not match count}
test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {0x50 0x51}
    binary format i $a
} -result "expected integer but got \"0x50 0x51\""
test binary-11.13 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format i1 $a
} P\x00\x00\x00

test binary-12.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format I
} -result {not enough arguments for all format specifiers}
test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format I blat
} -result {expected integer but got "blat"}
test binary-12.3 {Tcl_BinaryObjCmd: format} {
    binary format I0 0x50
} {}
test binary-12.4 {Tcl_BinaryObjCmd: format} {
    binary format I 0x50
} \x00\x00\x00P
test binary-12.5 {Tcl_BinaryObjCmd: format} {
    binary format I 0x5052
} \x00\x00PR
test binary-12.6 {Tcl_BinaryObjCmd: format} {
    binary format I 0x505251 0x53
} \x00PRQ
test binary-12.7 {Tcl_BinaryObjCmd: format} {
    binary format I1 {0x505251 0x53}
} \x00PRQ
test binary-12.8 {Tcl_BinaryObjCmd: format} {
    binary format I 0x53525150
} SRQP
test binary-12.9 {Tcl_BinaryObjCmd: format} {
    binary format I2 {0x50 0x52}
} \x00\x00\x00P\x00\x00\x00R
test binary-12.10 {Tcl_BinaryObjCmd: format} {
    binary format I* {0x50515253 0x52}
} PQRS\x00\x00\x00R
test binary-12.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format i2 {0x50}
} -result {number of elements in list does not match count}
test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {0x50 0x51}
    binary format I $a
} -result "expected integer but got \"0x50 0x51\""
test binary-12.13 {Tcl_BinaryObjCmd: format} {
    set a {0x50 0x51}
    binary format I1 $a
} \x00\x00\x00P

test binary-13.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format f
} -result {not enough arguments for all format specifiers}
test binary-13.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format f blat
} -result {expected floating-point number but got "blat"}
test binary-13.3 {Tcl_BinaryObjCmd: format} {
    binary format f0 1.6
} {}
test binary-13.4 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f 1.6
} \x3f\xcc\xcc\xcd
test binary-13.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f 1.6
} \xcd\xcc\xcc\x3f
test binary-13.6 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f* {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f* {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.8 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f2 {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f2 {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.10 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format f2 {1.6 3.4 5.6}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-13.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format f2 {1.6 3.4 5.6}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-13.12 {Tcl_BinaryObjCmd: float overflow} bigEndian {
    binary format f -3.402825e+38
} \xff\x7f\xff\xff
test binary-13.13 {Tcl_BinaryObjCmd: float overflow} littleEndian {
    binary format f -3.402825e+38
} \xff\xff\x7f\xff
test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
    binary format f -3.402825e-100
} \x80\x00\x00\x00
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
    binary format f -3.402825e-100
} \x00\x00\x00\x80
test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format f2 {1.6}
} -result {number of elements in list does not match count}
test binary-13.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {1.6 3.4}
    binary format f $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian {
    set a {1.6 3.4}
    binary format f1 $a
} \x3f\xcc\xcc\xcd
test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {1.6 3.4}
    binary format f1 $a
} \xcd\xcc\xcc\x3f

test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format d
} -result {not enough arguments for all format specifiers}
test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format d blat
} -result {expected floating-point number but got "blat"}
test binary-14.3 {Tcl_BinaryObjCmd: format} {
    binary format d0 1.6
} {}
test binary-14.4 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d 1.6
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-14.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d 1.6
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-14.6 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d* {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-14.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d* {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-14.8 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d2 {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-14.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d2 {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format d2 {1.6 3.4 5.6}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format d2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-14.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format d2 {1.6}
} -result {number of elements in list does not match count}
test binary-14.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {1.6 3.4}
    binary format d $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian {
    set a {1.6 3.4}
    binary format d1 $a
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {1.6 3.4}
    binary format d1 $a
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-14.18 {FormatNumber: Bug 1116542} {
    binary scan [binary format d 1.25] d w
    set w
} 1.25

test binary-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format ax*a "y" "z"
} -result {cannot use "*" in format string with "x"}
test binary-15.2 {Tcl_BinaryObjCmd: format} {
    binary format axa "y" "z"
} y\x00z
test binary-15.3 {Tcl_BinaryObjCmd: format} {
    binary format ax3a "y" "z"
} y\x00\x00\x00z
test binary-15.4 {Tcl_BinaryObjCmd: format} {
    binary format a*X3x3a* "foo" "z"
} \x00\x00\x00z
test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x0s 1
} \x01\x00
test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x0ss 1 1
} \x01\x00\x01\x00
test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x1s 1
} \x00\x01\x00
test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} {
    binary format x1ss 1 1
} \x00\x01\x00\x01\x00

test binary-16.1 {Tcl_BinaryObjCmd: format} {
    binary format a*X*a "foo" "z"
} zoo
test binary-16.2 {Tcl_BinaryObjCmd: format} {
    binary format aX3a "y" "z"
} z
test binary-16.3 {Tcl_BinaryObjCmd: format} {
    binary format a*Xa* "foo" "zy"
} fozy
test binary-16.4 {Tcl_BinaryObjCmd: format} {
    binary format a*X3a "foobar" "z"
} foozar
test binary-16.5 {Tcl_BinaryObjCmd: format} {
    binary format a*X3aX2a "foobar" "z" "b"
} fobzar

test binary-17.1 {Tcl_BinaryObjCmd: format} {
    binary format @1
} \x00
test binary-17.2 {Tcl_BinaryObjCmd: format} {
    binary format @5a2 "ab"
} \x00\x00\x00\x00\x00\x61\x62
test binary-17.3 {Tcl_BinaryObjCmd: format} {
    binary format {a*  @0  a2 @* a*} "foobar" "ab" "blat"
} abobarblat

test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format u0a3 abc abd
} -result {bad field specifier "u"}

test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
    binary s
} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
    binary scan foo
} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.3 {Tcl_BinaryObjCmd: scan} {
    binary scan {} {}
} 0

test binary-20.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc a
} -result {not enough arguments for all format specifiers}
test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan abc a arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    set arg1 abc
    list [binary scan abc a0 arg1] $arg1
} -result {1 {}}
test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc a* arg1] $arg1
} -result {1 abc}
test binary-20.5 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc a5 arg1] [info exists arg1]
} -result {0 0}
test binary-20.6 {Tcl_BinaryObjCmd: scan} {
    set arg1 foo
    list [binary scan abc a2 arg1] $arg1
} {1 ab}
test binary-20.7 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
    unset -nocomplain arg2
} -body {
    list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
} -result {2 ab cd}
test binary-20.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc a2 arg1(a)] $arg1(a)
} -result {1 ab}
test binary-20.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc a arg1(a)] $arg1(a)
} -result {1 a}

test binary-21.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc A
} -result {not enough arguments for all format specifiers}
test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan abc A arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    set arg1 abc
    list [binary scan abc A0 arg1] $arg1
} -result {1 {}}
test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc A* arg1] $arg1
} -result {1 abc}
test binary-21.5 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc A5 arg1] [info exists arg1]
} -result {0 0}
test binary-21.6 {Tcl_BinaryObjCmd: scan} {
    set arg1 foo
    list [binary scan abc A2 arg1] $arg1
} {1 ab}
test binary-21.7 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
    unset -nocomplain arg2
} -body {
    list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
} -result {2 ab cd}
test binary-21.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc A2 arg1(a)] $arg1(a)
} -result {1 ab}
test binary-21.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc A2 arg1(a)] $arg1(a)
} -result {1 ab}
test binary-21.10 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan abc A arg1(a)] $arg1(a)
} -result {1 a}
test binary-21.11 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan "abc def \x00  " A* arg1] $arg1
} -result {1 {abc def}}
test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -body {
    list [binary scan "abc def \x00ghi  " A* arg1] $arg1
} -result [list 1 "abc def \x00ghi"]

test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc b
} -result {not enough arguments for all format specifiers}
test binary-22.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 b* arg1] $arg1
} {1 0100101011001010}
test binary-22.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x82\x53 b arg1] $arg1
} {1 0}
test binary-22.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x82\x53 b1 arg1] $arg1
} {1 0}
test binary-22.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x82\x53 b0 arg1] $arg1
} {1 {}}
test binary-22.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 b5 arg1] $arg1
} {1 01001}
test binary-22.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 b8 arg1] $arg1
} {1 01001010}
test binary-22.8 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 b14 arg1] $arg1
} {1 01001010110010}
test binary-22.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 b14 arg1] $arg1
} {0 foo}
test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 b1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1 arg2
} -body {
    set arg1 foo
    set arg2 bar
    list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
} -result {2 11100 1110000110100000}

test binary-23.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc B
} -result {not enough arguments for all format specifiers}
test binary-23.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 B* arg1] $arg1
} {1 0101001001010011}
test binary-23.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x82\x53 B arg1] $arg1
} {1 1}
test binary-23.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x82\x53 B1 arg1] $arg1
} {1 1}
test binary-23.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 B0 arg1] $arg1
} {1 {}}
test binary-23.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 B5 arg1] $arg1
} {1 01010}
test binary-23.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 B8 arg1] $arg1
} {1 01010010}
test binary-23.8 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 B14 arg1] $arg1
} {1 01010010010100}
test binary-23.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 B14 arg1] $arg1
} {0 foo}
test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 B1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1 arg2
} -body {
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
} -result {2 01110 1000011100000101}

test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc h
} -result {not enough arguments for all format specifiers}
test binary-24.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 h* arg1] $arg1
} {1 253a}
test binary-24.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \xc2\xa3 h arg1] $arg1
} {1 2}
test binary-24.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x82\x53 h1 arg1] $arg1
} {1 2}
test binary-24.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 h0 arg1] $arg1
} {1 {}}
test binary-24.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \xf2\x53 h2 arg1] $arg1
} {1 2f}
test binary-24.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 h3 arg1] $arg1
} {1 253}
test binary-24.8 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 h3 arg1] $arg1
} {0 foo}
test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 h1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1 arg2
} -body {
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
} -result {2 07 7850}

test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc H
} -result {not enough arguments for all format specifiers}
test binary-25.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 H* arg1] $arg1
} {1 52a3}
test binary-25.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \xc2\xa3 H arg1] $arg1
} {1 c}
test binary-25.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x82\x53 H1 arg1] $arg1
} {1 8}
test binary-25.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 H0 arg1] $arg1
} {1 {}}
test binary-25.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \xf2\x53 H2 arg1] $arg1
} {1 f2}
test binary-25.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\x53 H3 arg1] $arg1
} {1 525}
test binary-25.8 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 H3 arg1] $arg1
} {0 foo}
test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 H1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-25.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
} {2 70 8705}

test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc c
} -result {not enough arguments for all format specifiers}
test binary-26.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 c* arg1] $arg1
} {1 {82 -93}}
test binary-26.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 c arg1] $arg1
} {1 82}
test binary-26.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 c1 arg1] $arg1
} {1 82}
test binary-26.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 c0 arg1] $arg1
} {1 {}}
test binary-26.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-26.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \xff c arg1] $arg1
} {1 -1}
test binary-26.8 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 c3 arg1] $arg1
} {0 foo}
test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 c1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-26.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
} {2 {112 -121} 5}
test binary-26.11 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 cu* arg1] $arg1
} {1 {82 163}}
test binary-26.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 cu arg1] $arg1
} {1 82}
test binary-26.13 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \xff cu arg1] $arg1
} {1 255}
test binary-26.14 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
} {2 128 -128}
test binary-26.15 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
} {2 -128 128}

test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc s
} -result {not enough arguments for all format specifiers}
test binary-27.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
} {1 {-23726 21587}}
test binary-27.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
} {1 -23726}
test binary-27.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 s1 arg1] $arg1
} {1 -23726}
test binary-27.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 s0 arg1] $arg1
} {1 {}}
test binary-27.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
} {1 {-23726 21587}}
test binary-27.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 s1 arg1] $arg1
} {0 foo}
test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 s1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-27.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
} {1 {41810 21587}}
test binary-27.11 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2
} {2 65535 -1}
test binary-27.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2
} {2 -1 65535}

test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc S
} -result {not enough arguments for all format specifiers}
test binary-28.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
} {1 {21155 21332}}
test binary-28.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
} {1 21155}
test binary-28.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 S1 arg1] $arg1
} {1 21155}
test binary-28.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 S0 arg1] $arg1
} {1 {}}
test binary-28.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
} {1 {21155 21332}}
test binary-28.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 S1 arg1] $arg1
} {0 foo}
test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 S1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-28.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
} {1 {21155 21332}}
test binary-28.11 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
} {1 {41810 21587}}

test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc i
} -result {not enough arguments for all format specifiers}
test binary-29.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
} {1 1414767442}
test binary-29.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
} {1 1414767442}
test binary-29.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53 i0 arg1] $arg1
} {1 {}}
test binary-29.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 i1 arg1] $arg1
} {0 foo}
test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 i1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-29.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-29.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-29.11 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-29.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
} {2 128 2147483648}

test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc I
} -result {not enough arguments for all format specifiers}
test binary-30.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
} {1 1386435412}
test binary-30.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
} {1 1386435412}
test binary-30.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53 I0 arg1] $arg1
} {1 {}}
test binary-30.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 I1 arg1] $arg1
} {0 foo}
test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 I1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-30.9 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-30.10 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-30.11 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-30.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1 arg2
    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
} {2 2147483648 128}

test binary-31.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc f
} -result {not enough arguments for all format specifiers}
test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1
} {1 1.600000023841858}
test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1
} {1 1.600000023841858}
test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
} {1 {}}
test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
} {1 {}}
test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 f1 arg1] $arg1
} {0 foo}
test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3f\xcc\xcc\xcd f1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}

test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc d
} -result {not enough arguments for all format specifiers}
test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1
} {1 1.6}
test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1
} {1 1.6}
test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1
} {1 1.6}
test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1
} {1 1.6}
test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1
} {1 {}}
test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1
} {1 {}}
test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 d1 arg1] $arg1
} {0 foo}
test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}

test binary-33.1 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
} {2 ab def}
test binary-33.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    set arg2 foo
    list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    set arg2 foo
    list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    set arg2 foo
    list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x1a1 arg1] $arg1
} {1 b}
test binary-33.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x5a1 arg1] $arg1
} {1 f}
test binary-33.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x0a1 arg1] $arg1
} {1 a}

test binary-34.1 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
} {2 ab bcd}
test binary-34.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    set arg2 foo
    list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    set arg2 foo
    list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abc X20a3 arg1] $arg1
} {1 abc}
test binary-34.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x*X1a1 arg1] $arg1
} {1 f}
test binary-34.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x*X5a1 arg1] $arg1
} {1 b}
test binary-34.7 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x3X0a1 arg1] $arg1
} {1 d}

test binary-35.1 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
    unset -nocomplain arg2
} -returnCodes error -body {
    binary scan abcdefg a2@a3 arg1 arg2
} -result {missing count for "@" field specifier}
test binary-35.2 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    set arg2 foo
    list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.3 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    unset -nocomplain arg2
    set arg2 foo
    list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.4 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef @2a3 arg1] $arg1
} {1 cde}
test binary-35.5 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x*@1a1 arg1] $arg1
} {1 b}
test binary-35.6 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    list [binary scan abcdef x*@0a1 arg1] $arg1
} {1 a}

test binary-36.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abcdef u0a3
} -result {bad field specifier "u"}

# GetFormatSpec is pretty thoroughly tested above, but there are a few cases
# we should text explicitly

test binary-37.1 {GetFormatSpec: whitespace} {
    binary format "a3 a5     a3" foo barblat baz
} foobarblbaz
test binary-37.2 {GetFormatSpec: whitespace} {
    binary format "      " foo
} {}
test binary-37.3 {GetFormatSpec: whitespace} {
    binary format "     a3" foo
} foo
test binary-37.4 {GetFormatSpec: whitespace} {
    binary format "" foo
} {}
test binary-37.5 {GetFormatSpec: whitespace} {
    binary format "" foo
} {}
test binary-37.6 {GetFormatSpec: whitespace} {
    binary format "     a3   " foo
} foo
test binary-37.7 {GetFormatSpec: numbers} -returnCodes error -body {
    binary scan abcdef "x-1" foo
} -result {bad field specifier "-"}
test binary-37.8 {GetFormatSpec: numbers} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan abcdef "a0x3" arg1] $arg1
} {1 {}}
test binary-37.9 {GetFormatSpec: numbers} {
    # test format of neg numbers
    # bug report/fix provided by Harald Kirsch
    set x [binary format f* {1 -1 2 -2 0}]
    binary scan $x f* bla
    set bla
} {1.0 -1.0 2.0 -2.0 0.0}
test binary-37.10 {GetFormatSpec: count overflow} {
    binary scan x a[format %ld 0x7fffffff] r
} 0
test binary-37.11 {GetFormatSpec: count overflow} {
    binary scan x a[format %ld 0x10000000] r
} 0
test binary-37.12 {GetFormatSpec: count overflow} {
    binary scan x a[format %ld 0x100000000] r
} 0
test binary-37.13 {GetFormatSpec: count overflow} {
    binary scan x a[format %lld 0x10000000000000000] r
} 0

test binary-38.1 {FormatNumber: word alignment} {
    set x [binary format c1s1 1 1]
} \x01\x01\x00
test binary-38.2 {FormatNumber: word alignment} {
    set x [binary format c1S1 1 1]
} \x01\x00\x01
test binary-38.3 {FormatNumber: word alignment} {
    set x [binary format c1i1 1 1]
} \x01\x01\x00\x00\x00
test binary-38.4 {FormatNumber: word alignment} {
    set x [binary format c1I1 1 1]
} \x01\x00\x00\x00\x01
test binary-38.5 {FormatNumber: word alignment} bigEndian {
    set x [binary format c1d1 1 1.6]
} \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-38.6 {FormatNumber: word alignment} littleEndian {
    set x [binary format c1d1 1 1.6]
} \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-38.7 {FormatNumber: word alignment} bigEndian {
    set x [binary format c1f1 1 1.6]
} \x01\x3f\xcc\xcc\xcd
test binary-38.8 {FormatNumber: word alignment} littleEndian {
    set x [binary format c1f1 1 1.6]
} \x01\xcd\xcc\xcc\x3f

test binary-39.1 {ScanNumber: sign extension} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-39.2 {ScanNumber: sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
} {1 {513 -32511 386 -32127}}
test binary-39.3 {ScanNumber: sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
} {1 {258 385 -32255 -32382}}
test binary-39.4 {ScanNumber: sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 -2130640639}}
test binary-39.5 {ScanNumber: sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
} {1 {16843010 -2130640639 25297153 16876033 16843137}}
test binary-39.6 {ScanNumber: no sign extension} {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 cu2 arg1] $arg1
} {1 {82 163}}
test binary-39.7 {ScanNumber: no sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
} {1 {513 33025 386 33409}}
test binary-39.8 {ScanNumber: no sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
} {1 {258 385 33281 33154}}
test binary-39.9 {ScanNumber: no sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 2164326657}}
test binary-39.10 {ScanNumber: no sign extension} {
    unset -nocomplain arg1
    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
} {1 {16843010 2164326657 25297153 16876033 16843137}}

test binary-40.3 {ScanNumber: NaN} -body {
    unset -nocomplain arg1
    list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
} -match glob -result {1 -NaN*}
test binary-40.4 {ScanNumber: NaN} -body {
    unset -nocomplain arg1
    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
} -match glob -result {1 -NaN*}

test binary-41.1 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -body {
    list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
} -result {2 1 1}
test binary-41.2 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -body {
    list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
} -result {2 1 1}
test binary-41.3 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -body {
    list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
} -result {2 1 1}
test binary-41.4 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -body {
    list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
} -result {2 1 1}
test binary-41.5 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -constraints bigEndian -body {
    list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.600000023841858}
test binary-41.6 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -constraints littleEndian -body {
    list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.600000023841858}
test binary-41.7 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -constraints bigEndian -body {
    list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.6}
test binary-41.8 {ScanNumber: word alignment} -setup {
    unset -nocomplain arg1 arg2
} -constraints littleEndian -body {
    list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
} -result {2 1 1.6}

test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body {
    binary ?
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "?": *}

# Wide int (guaranteed at least 64-bit) handling
test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format w 7810179016327718216
} HelloTcl
test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
    binary format W 7810179016327718216
} lcTolleH

test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
} {1 -9223372036854775808}
test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1
    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
    unset -nocomplain arg1 arg2
    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}

test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan HelloTcl W x
    set x
} 5216694956358656876
test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
    binary scan lcTolleH w x
    set x
} 5216694956358656876
test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format w [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
    binary scan [binary format W [expr {wide(3) << 31}]] W x
    set x
} 6442450944
test binary-44.5 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
    binary scan [binary format w [expr {(wide(3) << 31) + (wide(3) << 64)}]] w x
    set x
} 6442450944
test binary-44.6 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
    binary scan [binary format W [expr {(wide(3) << 31) + (wide(3) << 64)}]] W x
    set x
} 6442450944

test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sws 16450 -1 19521] c* x
    set x
} {66 64 -1 -1 -1 -1 -1 -1 -1 -1 65 76}
test binary-45.2 {Tcl_BinaryObjCmd: combined wide int handling} {
    binary scan [binary format sWs 16450 0x7fffffff 19521] c* x
    set x
} {66 64 0 0 0 0 127 -1 -1 -1 65 76}

test binary-46.1 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    binary format a* \u20ac
} \u00ac
test binary-46.2 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    list [binary scan [binary format a* \u20ac\u20bd] s x] $x
} {1 -16980}
test binary-46.3 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x {}
    set y {}
    set z {}
    list [binary scan [binary format a* \u20ac\u20bd] aaa x y z] $x $y $z
} "2 \u00ac \u00bd {}"
test binary-46.4 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x [encoding convertto iso8859-15 \u20ac]
    set y [binary format a* $x]
    list $x $y
} "\u00a4 \u00a4"
test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
    set x [binary scan \u00a4 a* y]
    list $x $y [encoding convertfrom iso8859-15 $y]
} "1 \u00a4 \u20ac"

test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
    # This test is only reliable when memory debugging is turned on, but
    # without even memory debugging it should still generate the expected
    # answers and might therefore still pick up memory corruption caused by
    # [Bug 851747].
    list [binary scan aba ccc x x x] $x
} {3 97}

### TIP#129: endian specifiers ----

# format t
test binary-48.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format t
} -result {not enough arguments for all format specifiers}
test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format t blat
} -result {expected integer but got "blat"}
test binary-48.3 {Tcl_BinaryObjCmd: format} {
    binary format S0 0x50
} {}
test binary-48.4 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t 0x50
} \x00P
test binary-48.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t 0x50
} P\x00
test binary-48.6 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t 0x5052
} PR
test binary-48.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t 0x5052
} RP
test binary-48.8 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t 0x505251 0x53
} RQ
test binary-48.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t 0x505251 0x53
} QR
test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t2 {0x50 0x52}
} \x00P\x00R
test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t2 {0x50 0x52}
} P\x00R\x00
test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t* {0x5051 0x52}
} PQ\x00R
test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t* {0x5051 0x52}
} QPR\x00
test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format t2 {0x50 0x52 0x53} 0x54
} \x00P\x00R
test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format t2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
test binary-48.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format t2 {0x50}
} -result {number of elements in list does not match count}
test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {0x50 0x51}
    binary format t $a
} -result "expected integer but got \"0x50 0x51\""
test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian {
    set a {0x50 0x51}
    binary format t1 $a
} \x00P
test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {0x50 0x51}
    binary format t1 $a
} P\x00

# format n
test binary-49.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format n
} -result {not enough arguments for all format specifiers}
test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format n blat
} -result {expected integer but got "blat"}
test binary-49.3 {Tcl_BinaryObjCmd: format} {
    binary format n0 0x50
} {}
test binary-49.4 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x50
} P\x00\x00\x00
test binary-49.5 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x5052
} RP\x00\x00
test binary-49.6 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x505251 0x53
} QRP\x00
test binary-49.7 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format i1 {0x505251 0x53}
} QRP\x00
test binary-49.8 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n 0x53525150
} PQRS
test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n2 {0x50 0x52}
} P\x00\x00\x00R\x00\x00\x00
test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian {
    binary format n* {0x50515253 0x52}
} SRQPR\x00\x00\x00
test binary-49.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format n2 {0x50}
} -result {number of elements in list does not match count}
test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {0x50 0x51}
    binary format n $a
} -result "expected integer but got \"0x50 0x51\""
test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian {
    set a {0x50 0x51}
    binary format n1 $a
} P\x00\x00\x00
test binary-49.14 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x50
} \x00\x00\x00P
test binary-49.15 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x5052
} \x00\x00PR
test binary-49.16 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x505251 0x53
} \x00PRQ
test binary-49.17 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format i1 {0x505251 0x53}
} QRP\x00
test binary-49.18 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n 0x53525150
} SRQP
test binary-49.19 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n2 {0x50 0x52}
} \x00\x00\x00P\x00\x00\x00R
test binary-49.20 {Tcl_BinaryObjCmd: format} bigEndian {
    binary format n* {0x50515253 0x52}
} PQRS\x00\x00\x00R

# format m
test binary-50.1 {Tcl_BinaryObjCmd: format wide int} littleEndian {
    binary format m 7810179016327718216
} HelloTcl
test binary-50.2 {Tcl_BinaryObjCmd: format wide int} bigEndian {
    binary format m 7810179016327718216
} lcTolleH
test binary-50.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
    binary scan [binary format m [expr {wide(3) << 31}]] w x
    set x
} 6442450944
test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
    binary scan [binary format m [expr {wide(3) << 31}]] W x
    set x
} 6442450944

# format Q/q
test binary-51.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format Q
} -result {not enough arguments for all format specifiers}
test binary-51.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format q blat
} -result {expected floating-point number but got "blat"}
test binary-51.3 {Tcl_BinaryObjCmd: format} {
    binary format q0 1.6
} {}
test binary-51.4 {Tcl_BinaryObjCmd: format} {} {
    binary format Q 1.6
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-51.5 {Tcl_BinaryObjCmd: format} {} {
    binary format q 1.6
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
test binary-51.6 {Tcl_BinaryObjCmd: format} {} {
    binary format Q* {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-51.7 {Tcl_BinaryObjCmd: format} {} {
    binary format q* {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-51.8 {Tcl_BinaryObjCmd: format} {} {
    binary format Q2 {1.6 3.4}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-51.9 {Tcl_BinaryObjCmd: format} {} {
    binary format q2 {1.6 3.4}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-51.10 {Tcl_BinaryObjCmd: format} {} {
    binary format Q2 {1.6 3.4 5.6}
} \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33
test binary-51.11 {Tcl_BinaryObjCmd: format} {} {
    binary format q2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
test binary-51.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format q2 {1.6}
} -result {number of elements in list does not match count}
test binary-51.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {1.6 3.4}
    binary format q $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-51.16 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format Q1 $a
} \x3f\xf9\x99\x99\x99\x99\x99\x9a
test binary-51.17 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format q1 $a
} \x9a\x99\x99\x99\x99\x99\xf9\x3f

# format R/r
test binary-53.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format r
} -result {not enough arguments for all format specifiers}
test binary-53.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format r blat
} -result {expected floating-point number but got "blat"}
test binary-53.3 {Tcl_BinaryObjCmd: format} {
    binary format f0 1.6
} {}
test binary-53.4 {Tcl_BinaryObjCmd: format} {} {
    binary format R 1.6
} \x3f\xcc\xcc\xcd
test binary-53.5 {Tcl_BinaryObjCmd: format} {} {
    binary format r 1.6
} \xcd\xcc\xcc\x3f
test binary-53.6 {Tcl_BinaryObjCmd: format} {} {
    binary format R* {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-53.7 {Tcl_BinaryObjCmd: format} {} {
    binary format r* {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-53.8 {Tcl_BinaryObjCmd: format} {} {
    binary format R2 {1.6 3.4}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-53.9 {Tcl_BinaryObjCmd: format} {} {
    binary format r2 {1.6 3.4}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-53.10 {Tcl_BinaryObjCmd: format} {} {
    binary format R2 {1.6 3.4 5.6}
} \x3f\xcc\xcc\xcd\x40\x59\x99\x9a
test binary-53.11 {Tcl_BinaryObjCmd: format} {} {
    binary format r2 {1.6 3.4 5.6}
} \xcd\xcc\xcc\x3f\x9a\x99\x59\x40
test binary-53.12 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format R -3.402825e+38
} \xff\x7f\xff\xff
test binary-53.13 {Tcl_BinaryObjCmd: float overflow} {} {
    binary format r -3.402825e+38
} \xff\xff\x7f\xff
test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format R -3.402825e-100
} \x80\x00\x00\x00
test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
    binary format r -3.402825e-100
} \x00\x00\x00\x80
test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format r2 {1.6}
} -result {number of elements in list does not match count}
test binary-53.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    set a {1.6 3.4}
    binary format r $a
} -result "expected floating-point number but got \"1.6 3.4\""
test binary-53.18 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format R1 $a
} \x3f\xcc\xcc\xcd
test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
    set a {1.6 3.4}
    binary format r1 $a
} \xcd\xcc\xcc\x3f

# scan t (s)
test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc t
} -result {not enough arguments for all format specifiers}
test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {-23726 21587}}
test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 -23726}
test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 -23726}
test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {-23726 21587}}
test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 t1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}

# scan t (b)
test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc t
} -result {not enough arguments for all format specifiers}
test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {21155 21332}}
test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 21155}
test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 21155}
test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {21155 21332}}
test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53 t1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}

# scan n (s)
test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc n
} -result {not enough arguments for all format specifiers}
test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1414767442}
test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1414767442}
test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 n1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 128 128}
test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}

# scan n (b)
test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc n
} -result {not enough arguments for all format specifiers}
test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1386435412}
test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1386435412}
test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x52\x53\x53\x54 n1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}
test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 128 128}

# scan Q/q
test binary-58.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc q
} -result {not enough arguments for all format specifiers}
test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1
} {1 1.6}
test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1
} {1 1.6}
test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1
} {1 1.6}
test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1
} {1 1.6}
test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1
} {1 {}}
test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1
} {1 {}}
test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 q1 arg1] $arg1
} {0 foo}
test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}

# scan R/r
test binary-59.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
    binary scan abc r
} -result {not enough arguments for all format specifiers}
test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1
} {1 1.600000023841858}
test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1
} {1 1.600000023841858}
test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1
} {1 {}}
test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1
} {1 {}}
test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.12 {Tcl_BinaryObjCmd: scan} {
    unset -nocomplain arg1
    set arg1 foo
    list [binary scan \x52 r1 arg1] $arg1
} {0 foo}
test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup {
    unset -nocomplain arg1
} -returnCodes error -body {
    set arg1 1
    binary scan \x3f\xcc\xcc\xcd r1 arg1(a)
} -result {can't set "arg1(a)": variable isn't array}
test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian {
    unset -nocomplain arg1 arg2
    set arg1 foo
    set arg2 bar
    list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}

test binary-60.1 {[binary format] with NaN} -body {
    binary scan [binary format dqQfrR NaN NaN NaN NaN NaN NaN] dqQfrR \
	v1 v2 v3 v4 v5 v6
    list $v1 $v2 $v3 $v4 $v5 $v6
} -match regexp -result {NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))? NaN(\([[:xdigit:]]+\))?}

# scan m
test binary-61.1 {Tcl_BinaryObjCmd: scan wide int} bigEndian {
    binary scan HelloTcl m x
    set x
} 5216694956358656876
test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian {
    binary scan lcTolleH m x
    set x
} 5216694956358656876
test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
    binary scan [binary format w [expr {wide(3) << 31}]] m x
    set x
} 6442450944
test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
    binary scan [binary format W [expr {wide(3) << 31}]] m x
    set x
} 6442450944

# scan/format infinities

test binary-62.1 {infinity} ieeeFloatingPoint {
    binary scan [binary format q Infinity] w w
    format 0x%016lx $w
} 0x7ff0000000000000
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438














2439
2440
2441
2442
2443
2444
2445
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







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+







test binary-63.8 {NaN} -constraints ieeeFloatingPoint -body {
    binary format q Nan(1,2)
} -returnCodes error -match glob -result {expected floating-point number*}
test binary-63.9 {NaN} -constraints ieeeFloatingPoint -body {
    binary format q Nan(1234567890abcd)
} -returnCodes error -match glob -result {expected floating-point number*}

test binary-64.1 {NaN} -constraints ieeeFloatingPoint -body {
    binary scan [binary format w 0x7ff8000000000000] q d
    set d
} -match glob -result NaN*
test binary-64.2 {NaN} -constraints ieeeFloatingPoint -body {
    binary scan [binary format w 0x7ff0123456789aBc] q d
    set d
} -match glob -result NaN(*123456789abc)
test binary-64.1 {NaN} \
    -constraints ieeeFloatingPoint \
    -body {
	binary scan [binary format w 0x7ff8000000000000] q d
	set d
    } \
    -match glob -result NaN*
test binary-64.2 {NaN} \
    -constraints ieeeFloatingPoint \
    -body {
	binary scan [binary format w 0x7ff0123456789aBc] q d
	set d
    } \
    -match glob -result NaN(*123456789abc)

test binary-65.1 {largest significand} ieeeFloatingPoint {
    binary scan [binary format w 0x3fcfffffffffffff] q d
    set d
} 0.24999999999999997
test binary-65.2 {smallest significand} ieeeFloatingPoint {
    binary scan [binary format w 0x3fd0000000000000] q d
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
2434
2435
2436
2437
2438
2439
2440


































































































































































































































































































































































































































































































2441

2442
2443
2444
2445
2446
2447







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-






    set d
} 18014398509481984.0
test binary-65.9 {largest significand} ieeeFloatingPoint {
    binary scan [binary format w 0x4350000000000001] q d
    set d
} 18014398509481988.0

test binary-70.1 {binary encode hex} -body {
    binary encode hex
} -returnCodes error -match glob -result "wrong # args: *"
test binary-70.2 {binary encode hex} -body {
    binary encode hex a
} -result {61}
test binary-70.3 {binary encode hex} -body {
    binary encode hex {}
} -result {}
test binary-70.4 {binary encode hex} -body {
    binary encode hex [string repeat a 20]
} -result [string repeat 61 20]
test binary-70.5 {binary encode hex} -body {
    binary encode hex \0\1\2\3\4\0\1\2\3\4
} -result {00010203040001020304}

test binary-71.1 {binary decode hex} -body {
    binary decode hex
} -returnCodes error -match glob -result "wrong # args: *"
test binary-71.2 {binary decode hex} -body {
    binary decode hex 61
} -result {a}
test binary-71.3 {binary decode hex} -body {
    binary decode hex {}
} -result {}
test binary-71.4 {binary decode hex} -body {
    binary decode hex [string repeat 61 20]
} -result [string repeat a 20]
test binary-71.5 {binary decode hex} -body {
    binary decode hex 00010203040001020304
} -result "\0\1\2\3\4\0\1\2\3\4"
test binary-71.6 {binary decode hex} -body {
    binary decode hex "61 61"
} -result {aa}
test binary-71.7 {binary decode hex} -body {
    binary decode hex "61\n\n\n61"
} -result {aa}
test binary-71.8 {binary decode hex} -match glob -body {
    binary decode hex -strict "61 61"
} -returnCodes error -result {invalid hexadecimal digit " " * at position 2}
test binary-71.9 {binary decode hex} -body {
    set r [binary decode hex "6"]
    list [string length $r] $r
} -result {0 {}}
test binary-71.10 {binary decode hex} -body {
    string length [binary decode hex " "]
} -result 0
test binary-71.11 {binary decode hex: Bug b98fa55285} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {29 38}
test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {28 140}
test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {28 140}
test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body {
    apply {{} {
	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n"
	set decoded [binary decode hex $str]
	list [string length $decoded] [scan [string index $decoded end] %c]
    }}
} -result {28 140}

test binary-72.1 {binary encode base64} -body {
    binary encode base64
} -returnCodes error -match glob -result "wrong # args: *"
test binary-72.2 {binary encode base64} -body {
    binary encode base64 abc
} -result {YWJj}
test binary-72.3 {binary encode base64} -body {
    binary encode base64 {}
} -result {}
test binary-72.4 {binary encode base64} -body {
    binary encode base64 [string repeat abc 20]
} -result [string repeat YWJj 20]
test binary-72.5 {binary encode base64} -body {
    binary encode base64 \0\1\2\3\4\0\1\2\3
} -result {AAECAwQAAQID}
test binary-72.6 {binary encode base64} -body {
    binary encode base64 \0
} -result {AA==}
test binary-72.7 {binary encode base64} -body {
    binary encode base64 \0\0
} -result {AAA=}
test binary-72.8 {binary encode base64} -body {
    binary encode base64 \0\0\0
} -result {AAAA}
test binary-72.9 {binary encode base64} -body {
    binary encode base64 \0\0\0\0
} -result {AAAAAA==}
test binary-72.10 {binary encode base64} -body {
    binary encode base64 -maxlen 0 -wrapchar : abcabcabc
} -result {YWJjYWJjYWJj}
test binary-72.11 {binary encode base64} -body {
    binary encode base64 -maxlen 1 -wrapchar : abcabcabc
} -result {Y:W:J:j:Y:W:J:j:Y:W:J:j}
test binary-72.12 {binary encode base64} -body {
    binary encode base64 -maxlen 2 -wrapchar : abcabcabc
} -result {YW:Jj:YW:Jj:YW:Jj}
test binary-72.13 {binary encode base64} -body {
    binary encode base64 -maxlen 3 -wrapchar : abcabcabc
} -result {YWJ:jYW:JjY:WJj}
test binary-72.14 {binary encode base64} -body {
    binary encode base64 -maxlen 4 -wrapchar : abcabcabc
} -result {YWJj:YWJj:YWJj}
test binary-72.15 {binary encode base64} -body {
    binary encode base64 -maxlen 5 -wrapchar : abcabcabc
} -result {YWJjY:WJjYW:Jj}
test binary-72.16 {binary encode base64} -body {
    binary encode base64 -maxlen 6 -wrapchar : abcabcabc
} -result {YWJjYW:JjYWJj}
test binary-72.17 {binary encode base64} -body {
    binary encode base64 -maxlen 7 -wrapchar : abcabcabc
} -result {YWJjYWJ:jYWJj}
test binary-72.18 {binary encode base64} -body {
    binary encode base64 -maxlen 8 -wrapchar : abcabcabc
} -result {YWJjYWJj:YWJj}
test binary-72.19 {binary encode base64} -body {
    binary encode base64 -maxlen 9 -wrapchar : abcabcabc
} -result {YWJjYWJjY:WJj}
test binary-72.20 {binary encode base64} -body {
    binary encode base64 -maxlen 10 -wrapchar : abcabcabc
} -result {YWJjYWJjYW:Jj}
test binary-72.21 {binary encode base64} -body {
    binary encode base64 -maxlen 11 -wrapchar : abcabcabc
} -result {YWJjYWJjYWJ:j}
test binary-72.22 {binary encode base64} -body {
    binary encode base64 -maxlen 12 -wrapchar : abcabcabc
} -result {YWJjYWJjYWJj}
test binary-72.23 {binary encode base64} -body {
    binary encode base64 -maxlen 13 -wrapchar : abcabcabc
} -result {YWJjYWJjYWJj}
test binary-72.24 {binary encode base64} -body {
    binary encode base64 -maxlen 60 -wrapchar : abcabcabc
} -result {YWJjYWJjYWJj}
test binary-72.25 {binary encode base64} -body {
    binary encode base64 -maxlen 2 -wrapchar * abcabcabc
} -result {YW*Jj*YW*Jj*YW*Jj}
test binary-72.26 {binary encode base64} -body {
    binary encode base64 -maxlen 6 -wrapchar -*- abcabcabc
} -result {YWJjYW-*-JjYWJj}
test binary-72.27 {binary encode base64} -body {
    binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc
} -result {YWJj-*-YWJj-*-YWJj}
test binary-72.28 {binary encode base64} -body {
    binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc
} -result {YWJjYW0123456789JjYWJj}
test binary-72.29 {binary encode base64} {
    string length [binary encode base64 -maxlen 3 -wrapchar \xca abc]
} 5

test binary-73.1 {binary decode base64} -body {
    binary decode base64
} -returnCodes error -match glob -result "wrong # args: *"
test binary-73.2 {binary decode base64} -body {
    binary decode base64 YWJj
} -result {abc}
test binary-73.3 {binary decode base64} -body {
    binary decode base64 {}
} -result {}
test binary-73.4 {binary decode base64} -body {
    binary decode base64 [string repeat YWJj 20]
} -result [string repeat abc 20]
test binary-73.5 {binary decode base64} -body {
    binary decode base64 AAECAwQAAQID
} -result "\0\1\2\3\4\0\1\2\3"
test binary-73.6 {binary decode base64} -body {
    binary decode base64 AA==
} -result "\0"
test binary-73.7 {binary decode base64} -body {
    binary decode base64 AAA=
} -result "\0\0"
test binary-73.8 {binary decode base64} -body {
    binary decode base64 AAAA
} -result "\0\0\0"
test binary-73.9 {binary decode base64} -body {
    binary decode base64 AAAAAA==
} -result "\0\0\0\0"
test binary-73.10 {binary decode base64} -body {
    set s "[string repeat YWJj 10]\n[string repeat YWJj 10]"
    binary decode base64 $s
} -result [string repeat abc 20]
test binary-73.11 {binary decode base64} -body {
    set s "[string repeat YWJj 10]\n    [string repeat YWJj 10]"
    binary decode base64 $s
} -result [string repeat abc 20]
test binary-73.12 {binary decode base64} -body {
    binary decode base64 -strict ":YWJj"
} -returnCodes error -match glob -result {invalid base64 character ":" * at position 0}
test binary-73.13 {binary decode base64} -body {
    set s "[string repeat YWJj 10]:[string repeat YWJj 10]"
    binary decode base64 -strict $s
} -returnCodes error -match glob -result {invalid base64 character ":" * at position 40}
test binary-73.14 {binary decode base64} -body {
    set s "[string repeat YWJj 10]\n    [string repeat YWJj 10]"
    binary decode base64 -strict $s
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.20 {binary decode base64} -body {
    set r [binary decode base64 Y]
    list [string length $r] $r
} -result {0 {}}
test binary-73.21 {binary decode base64} -body {
    set r [binary decode base64 YW]
    list [string length $r] $r
} -result {1 a}
test binary-73.22 {binary decode base64} -body {
    set r [binary decode base64 YWJ]
    list [string length $r] $r
} -result {2 ab}
test binary-73.23 {binary decode base64} -body {
    set r [binary decode base64 YWJj]
    list [string length $r] $r
} -result {3 abc}
test binary-73.24 {binary decode base64} -body {
    string length [binary decode base64 " "]
} -result 0
test binary-73.25 {binary decode base64} -body {
    list [string length [set r [binary decode base64 WA==\n]]] $r
} -result {1 X}
test binary-73.26 {binary decode base64} -body {
    list [string length [set r [binary decode base64 WFk=\n]]] $r
} -result {2 XY}
test binary-73.27 {binary decode base64} -body {
    list [string length [set r [binary decode base64 WFla\n]]] $r
} -result {3 XYZ}
test binary-73.28 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WA==\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.29 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WFk=\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.30 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WFla\n]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.31 {binary decode base64} -body {
    list [string length [set r [binary decode base64 -strict WA==WFla]]] $r
} -returnCodes error -match glob -result {invalid base64 character *}
test binary-73.32 {binary decode base64, bug [00d04c4f12]} -body {
    list \
	[string length [binary decode base64 =]] \
	[string length [binary decode base64 " ="]] \
	[string length [binary decode base64 "   ="]] \
	[string length [binary decode base64 "\r\n\t="]] \
} -result [lrepeat 4 0]
test binary-73.33 {binary decode base64, bug [00d04c4f12]} -body {
    list \
	[string length [binary decode base64 ==]] \
	[string length [binary decode base64 " =="]] \
	[string length [binary decode base64 "  =="]] \
	[string length [binary decode base64 "   =="]] \
} -result [lrepeat 4 0]
test binary-73.34 {binary decode base64, (compatibility) unfulfilled base64 (single char) in non-strict mode} -body {
    list \
	[expr {[binary decode base64 a] eq [binary decode base64 ""]}] \
	[expr {[binary decode base64 abcda] eq [binary decode base64 "abcd"]}]
} -result [lrepeat 2 1]
test binary-73.35 {binary decode base64, bad base64 in strict mode} -body {
    set r {}
    foreach c {a " a" "  a" "   a" "    a" abcda abcdabcda a= a== abcda= abcda==} {
	lappend r \
	    [catch {binary decode base64 $c}] \
	    [catch {binary decode base64 -strict $c}]
    }
    set r
} -result [lrepeat 11 0 1]
test binary-73.36 {binary decode base64: check encoded & decoded equals original} -body {
    set r {}
    for {set i 0} {$i < 255 && [llength $r] < 20} {incr i} {
	foreach c {1 2 3 4 5 6 7 8} {
	    set c [string repeat [format %c $i] $c]
	    if {[set a [binary decode base64 [set x [binary encode base64 $c]]]] ne $c} {
		lappend r "encode & decode is wrong on string `$c` (encoded: $x): `$a` != `$c`"
	    }
	}
    }
    join $r \n
} -result {}
test binary-73.37 {binary decode base64: Bug ffeb2097af} {
    binary decode base64 [binary encode base64 -maxlen 3 -wrapchar : abc]
} abc

test binary-74.1 {binary encode uuencode} -body {
    binary encode uuencode
} -returnCodes error -match glob -result "wrong # args: *"
test binary-74.2 {binary encode uuencode} -body {
    binary encode uuencode abc
} -result {#86)C
}
test binary-74.3 {binary encode uuencode} -body {
    binary encode uuencode {}
} -result {}
test binary-74.4 {binary encode uuencode} -body {
    binary encode uuencode [string repeat abc 20]
} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
test binary-74.5 {binary encode uuencode} -body {
    binary encode uuencode \0\1\2\3\4\0\1\2\3
} -result ")``\$\"`P0``0(#\n"
test binary-74.6 {binary encode uuencode} -body {
    binary encode uuencode \0
} -result {!``
}
test binary-74.7 {binary encode uuencode} -body {
    binary encode uuencode \0\0
} -result "\"```
"
test binary-74.8 {binary encode uuencode} -body {
    binary encode uuencode \0\0\0
} -result {#````
}
test binary-74.9 {binary encode uuencode} -body {
    binary encode uuencode \0\0\0\0
} -result {$``````
}
test binary-74.10 {binary encode uuencode} -returnCodes error -body {
    binary encode uuencode -foo 30 abcabcabc
} -result {bad option "-foo": must be -maxlen or -wrapchar}
test binary-74.11 {binary encode uuencode} -returnCodes error -body {
    binary encode uuencode -maxlen 4 abcabcabc
} -result {line length out of range}
test binary-74.12 {binary encode uuencode} -body {
    binary encode uuencode -maxlen 5 -wrapchar \t abcabcabc
} -result #86)C\t#86)C\t#86)C\t
test binary-74.13 {binary encode uuencode} -body {
    binary encode uuencode -maxlen 85 -wrapchar \t abcabcabc
} -result )86)C86)C86)C\t
test binary-74.14 {binary encode uuencode} -returnCodes error -body {
    binary encode uuencode -maxlen 86 abcabcabc
} -result {line length out of range}

test binary-75.1 {binary decode uuencode} -body {
    binary decode uuencode
} -returnCodes error -match glob -result "wrong # args: *"
test binary-75.2 {binary decode uuencode} -body {
    binary decode uuencode "#86)C\n"
} -result {abc}
test binary-75.3 {binary decode uuencode} -body {
    binary decode uuencode {}
} -result {}
test binary-75.3.1 {binary decode uuencode} -body {
    binary decode uuencode `\n
} -result {}
test binary-75.4 {binary decode uuencode} -body {
    binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
} -result [string repeat abc 20]
test binary-75.5 {binary decode uuencode} -body {
    binary decode uuencode ")``\$\"`P0``0(#"
} -result "\0\1\2\3\4\0\1\2\3"
test binary-75.6 {binary decode uuencode} -body {
    string length [binary decode uuencode "`\n"]
} -result 0
test binary-75.7 {binary decode uuencode} -body {
    string length [binary decode uuencode "!`\n"]
} -result 1
test binary-75.8 {binary decode uuencode} -body {
    string length [binary decode uuencode "\"``\n"]
} -result 2
test binary-75.9 {binary decode uuencode} -body {
    string length [binary decode uuencode "#```\n"]
} -result 3
test binary-75.10 {binary decode uuencode} -body {
    set s ">[string repeat 86)C 10]\n>[string repeat 86)C 10]"
    binary decode uuencode $s
} -result [string repeat abc 20]
test binary-75.11 {binary decode uuencode} -body {
    set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r"
    binary decode uuencode $s
} -result [string repeat abc 20]
test binary-75.12 {binary decode uuencode} -body {
    binary decode uuencode -strict "|86)C"
} -returnCodes error -match glob -result {invalid uuencode character "|" * at position 0}
test binary-75.13 {binary decode uuencode} -body {
    set s ">[string repeat 86)C 10]|[string repeat 86)C 10]"
    binary decode uuencode -strict $s
} -returnCodes error -match glob -result {invalid uuencode character "|" * at position 41}
test binary-75.14 {binary decode uuencode} -body {
    set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]"
    binary decode uuencode -strict $s
} -returnCodes error -match glob -result {invalid uuencode character *}
test binary-75.20 {binary decode uuencode} -body {
    set r [binary decode uuencode " 8"]
    list [string length $r] $r
} -result {0 {}}
test binary-75.21 {binary decode uuencode} -body {
    set r [binary decode uuencode "!86"]
    list [string length $r] $r
} -result {1 a}
test binary-75.22 {binary decode uuencode} -body {
    set r [binary decode uuencode "\"86)"]
    list [string length $r] $r
} -result {2 ab}
test binary-75.23 {binary decode uuencode} -body {
    set r [binary decode uuencode "#86)C"]
    list [string length $r] $r
} -result {3 abc}
test binary-75.24 {binary decode uuencode} -body {
    set s "#04)\# "
    binary decode uuencode $s
} -result ABC
test binary-75.25 {binary decode uuencode} -body {
    set s "#04)\#z"
    binary decode uuencode $s
} -returnCodes error -match glob -result {invalid uuencode character "z" * at position 5}
test binary-75.26 {binary decode uuencode} -body {
    string length [binary decode uuencode " "]
} -result 0

test binary-76.1 {binary string appending growth algorithm} unix {
    # Create zero-length byte array first
    set f [open /dev/null rb]
    chan configure $f -blocking 0
    set str [read $f 2]
    close $f
    # Append to it
    string length [append str [binary format a* foo]]
} 3
test binary-76.2 {binary string appending growth algorithm} win {
    # Create zero-length byte array first
    set f [open NUL rb]
    chan configure $f -blocking 0
    set str [read $f 2]
    close $f
    # Append to it
    string length [append str [binary format a* foo]]
} 3

test binary-77.1 {string cat ops on all bytearrays} {
    apply {{a b} {
	return [binary format H* $a][binary format H* $b]
    }} ab cd
} [binary format H* abcd]
test binary-77.2 {string cat ops on all bytearrays} {
    apply {{a b} {
	set one [binary format H* $a]
	return $one[binary format H* $b]
    }} ab cd
} [binary format H* abcd]

test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678]} -body {
    # just test for BO-segfault (high surrogate w/o advance source pointer for out of BMP char if TCL_UTF_MAX == 3):
    binary encode hex \U0001f415
    binary scan \U0001f415 a* v; set v
    set str {}
} -result {}


testConstraint testsetbytearraylength \
		[expr {"testsetbytearraylength" in [info commands]}]

test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength {
    testsetbytearraylength [string cat A B C] 1
} A
test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength {
    testsetbytearraylength [string cat \u0141 B C] 1
} A

test binary-80.1 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
    testbytestring "\u4E4E"
} -result "expected byte sequence but character 0 was '\u4E4E' (U+004E4E)"
test binary-80.2 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
    testbytestring [testbytestring "\x00\xA0\xA0\xA0\xE4\xB9\x8E"]
} -result "expected byte sequence but character 4 was '\u4E4E' (U+004E4E)"
test binary-80.3 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
    testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xE4\xB9\x8E"]
} -result "expected byte sequence but character 4 was '\u4E4E' (U+004E4E)"
test binary-80.4 {TclGetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
    testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"]
} -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)"

# ----------------------------------------------------------------------
# cleanup

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Added tests/case.test.


























































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Commands covered:  case
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test case-1.1 {simple pattern} {
    case a in a {format 1} b {format 2} c {format 3} default {format 4}
} 1
test case-1.2 {simple pattern} {
    case b a {format 1} b {format 2} c {format 3} default {format 4}
} 2
test case-1.3 {simple pattern} {
    case x in a {format 1} b {format 2} c {format 3} default {format 4}
} 4
test case-1.4 {simple pattern} {
    case x a {format 1} b {format 2} c {format 3}
} {}
test case-1.5 {simple pattern matches many times} {
    case b a {format 1} b {format 2} b {format 3} b {format 4}
} 2
test case-1.6 {fancier pattern} {
    case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
} 3
test case-1.7 {list of patterns} {
    case abc in {a b c} {format 1} {def abc ghi} {format 2}
} 2

test case-2.1 {error in executed command} {
    list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
	    $msg $::errorInfo
} {1 {Just a test} {Just a test
    while executing
"error "Just a test""
    ("a" arm line 1)
    invoked from within
"case a in a {error "Just a test"} default {format 1}"}}
test case-2.2 {error: not enough args} {
    list [catch {case} msg] $msg
} {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
test case-2.3 {error: pattern with no body} {
    list [catch {case a b} msg] $msg
} {1 {extra case pattern with no body}}
test case-2.4 {error: pattern with no body} {
    list [catch {case a in b {format 1} c} msg] $msg
} {1 {extra case pattern with no body}}
test case-2.5 {error in default command} {
    list [catch {case foo in a {error case1} default {error case2} \
	    b {error case 3}} msg] $msg $::errorInfo
} {1 case2 {case2
    while executing
"error case2"
    ("default" arm line 1)
    invoked from within
"case foo in a {error case1} default {error case2}  b {error case 3}"}}

test case-3.1 {single-argument form for pattern/command pairs} {
    case b in {
	a {format 1}
	b {format 2}
	default {format 6}
    }
} {2}
test case-3.2 {single-argument form for pattern/command pairs} {
    case b {
	a {format 1}
	b {format 2}
	default {format 6}
    }
} {2}
test case-3.3 {single-argument form for pattern/command pairs} {
    list [catch {case z in {a 2 b}} msg] $msg
} {1 {extra case pattern with no body}}

# cleanup
::tcltest::cleanupTests
return

Changes to tests/chan.test.

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
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









-
-
+
+










-
+


-
+




+

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+














-
+







# This file contains a collection of tests for the Tcl built-in 'chan'
# command. Sourcing this file into Tcl runs the tests and generates
# output for errors. No output means no errors were found.
#
# Copyright (c) 2005 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

#
# Note: The tests for the chan methods "create" and "postevent"
# currently reside in the file "ioCmd.test".
#

test chan-1.1 {chan command general syntax} -body {
    chan
} -returnCodes error -result "wrong # args: should be \"chan subcommand ?arg ...?\""
} -returnCodes error -result "wrong # args: should be \"chan subcommand ?argument ...?\""
test chan-1.2 {chan command general syntax} -body {
    chan FOOBAR
} -returnCodes error -match glob -result "unknown or ambiguous subcommand \"FOOBAR\": must be *"
} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, pending, postevent, puts, read, seek, tell, or truncate"

test chan-2.1 {chan command: blocked subcommand} -body {
    chan blocked foo bar
} -returnCodes error -result "wrong # args: should be \"chan blocked channelId\""

test chan-3.1 {chan command: close subcommand} -body {
    chan close foo bar zet
} -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\""
test chan-3.2 {chan command: close subcommand} -setup {
    chan close foo bar
} -returnCodes error -result "wrong # args: should be \"chan close channelId\""

    set chan [open [info script] r]
} -body {
    chan close $chan bar
} -cleanup {
    close $chan
} -returnCodes error -result "bad direction \"bar\": must be read or write"
test chan-3.3 {chan command: close subcommand} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan write
} -cleanup {
    close $chan
} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"
test chan-4.1 {chan command: configure subcommand} -body {
    chan configure
} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\""
} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?optionName? ?value? ?optionName value?...\""
test chan-4.2 {chan command: [Bug 800753]} -body {
    chan configure stdout -eofchar \u0100
} -returnCodes error -match glob -result {bad value*}
test chan-4.3 {chan command: [Bug 800753]} -body {
    chan configure stdout -eofchar \u0000
} -returnCodes error -match glob -result {bad value*}
test chan-4.4 {chan command: check valid inValue, no outValue} -body {
    chan configure stdout -eofchar [list \x27 {}]
} -returnCodes ok -result {}
test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
    chan configure stdout -eofchar [list \x27 \x80]
} -returnCodes error -match glob -result {bad value for -eofchar:*}
test chan-4.6 {chan command: check no inValue, valid outValue} -body {
    chan configure stdout -eofchar [list {} \x27]
} -returnCodes ok -result {} -cleanup {chan configure stdout -eofchar [list {} {}]}
} -returnCodes ok -result {}

test chan-5.1 {chan command: copy subcommand} -body {
    chan copy foo
} -returnCodes error -result "wrong # args: should be \"chan copy input output ?-size size? ?-command callback?\""

test chan-6.1 {chan command: eof subcommand} -body {
    chan eof foo bar
131
132
133
134
135
136
137
138

139
140
141
142
143
144
145
119
120
121
122
123
124
125

126
127
128
129
130
131
132
133







-
+







test chan-16.3 {chan command: pending subcommand} -body {
    chan pending stdin stdout stderr
} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
test chan-16.4 {chan command: pending subcommand} -body {
    chan pending {input output} stdout
} -returnCodes error -result "bad mode \"input output\": must be input or output"
test chan-16.5 {chan command: pending input subcommand} -body {
    chan pending input stdout
    chan pending input stdout 
} -result -1
test chan-16.6 {chan command: pending input subcommand} -body {
    chan pending input stdin
} -result 0
test chan-16.7 {chan command: pending input subcommand} -body {
    chan pending input FOOBAR
} -returnCodes error -result "can not find channel named \"FOOBAR\""
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
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







-
+




















-
+







        set l [string length $line]
        set e [chan eof $sock]
        set b [chan blocked $sock]
        set i [chan pending input $sock]

        lappend ::chan-16.9-data $r $l $e $b $i

        if {$r >= 0 || $e || $l || !$b || $i > 128} {
        if {$r != -1 || $e || $l || !$b || $i > 128} {
            set data [read $sock $i]
            lappend ::chan-16.9-data [string range $data 0 2]
            lappend ::chan-16.9-data [string range $data end-2 end]
            set ::chan-16.9-done 1
            chan event $sock readable {}
        } else {
	    after idle chan-16.9-client
	}
    }

    proc chan-16.9-client {} {
        chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
        chan flush $::client
    }

    set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0]
    set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]]
    set ::chan-16.9-data [list]
    set ::chan-16.9-done 0
} -body {
    after idle chan-16.9-client
    after idle chan-16.9-client 
    vwait ::chan-16.9-done
    set ::chan-16.9-data
} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {
    catch {chan close $client}
    catch {chan close $server}
    rename chan-16.9-accept {}
    rename chan-16.9-readable {}
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
217
218
219
220
221
222
223


































224
225
226
227
228
229







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






    lappend result [chan pending output $f]
} -result [list 513 0] -cleanup {
    unset -nocomplain result
    catch {chan close $f}
    catch {removeFile $file}
}

# TIP 304: chan pipe

test chan-17.1 {chan command: pipe subcommand} -body {
    chan pipe foo
} -returnCodes error -result "wrong # args: should be \"chan pipe \""

test chan-17.2 {chan command: pipe subcommand} -body {
    chan pipe foo bar
} -returnCodes error -result "wrong # args: should be \"chan pipe \""

test chan-17.3 {chan command: pipe subcommand} -body {
	set l [chan pipe]
    foreach {pr pw} $l break
    list [llength $l] [fconfigure $pr -blocking] [fconfigure $pw -blocking]
} -result [list 2 1 1] -cleanup {
    close $pw
    close $pr
}

test chan-17.4 {chan command: pipe subcommand} -body {
    set ::done 0
    foreach {::pr ::pw} [chan pipe] break
    after 100 {puts $::pw foo;flush $::pw}
    fileevent $::pr readable {set ::done 1}
    after 500 {set ::done -1}
    vwait ::done
    set out nope
    if {$::done==1} {gets $::pr out}
    list $::done $out
} -result [list 1 foo] -cleanup {
    close $::pw
    close $::pr
}

cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/chanio.test.

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
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







-
-
-
+
+
+

-

-
-
-
-
+
-










-
-
+
+
-
-
-
-
-
-
-
+
+
+



-
+

-







# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
if {[catch {package require tcltest 2}]} {
    chan puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}

namespace eval ::tcl::test::io {

    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    namespace import ::tcltest::*
    }

    variable umaskValue
    variable path
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint exec             [llength [info commands exec]]
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    package require tcltests

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint openpipe         1
    testConstraint fileevent        [llength [info commands fileevent]]
    testConstraint fcopy            [llength [info commands fcopy]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
    testConstraint testmainthread   [llength [info commands testmainthread]]
    testConstraint testservicemode  [llength [info commands testservicemode]]
    testConstraint testthread       [llength [info commands testthread]]
    testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
    testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]

    # You need a *very* special environment to do some tests.  In particular,
    # many file systems do not support large-files...
    testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

    # some tests can only be run is umask is 2 if "umask" cannot be run, the
    # tests will be skipped.
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
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







-
+









-
+







} -cleanup {
    chan close $f
} -result [list 2 "\u4e00\u4e01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
    # if (dst >= dstEnd)
    # if (dst >= dstEnd) 
    set f [open $path(test1) w]
    chan puts $f $a
    chan puts $f hi
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result [list 256 $a]
test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body {
test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body {
    # if (FilterInputBytes(chanPtr, &gs) != 0)
    set f [openpipe w+ $path(cat)]
    chan puts -nonewline $f "hi\nwould"
    chan flush $f
    chan gets $f
    chan configure $f -blocking 0
    chan gets $f line
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
595


596
597
598
599
600
601
602

603
604

605
606


607
608
609
610
611
612
613

614
615

616
617


618
619
620
621
622

623
624

625
626


627
628
629
630
631
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
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

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
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
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
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

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
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
1439


1440

1441
1442
1443
1444
1445
1446
1447

1448
1449

1450
1451


1452

1453
1454
1455
1456
1457
1458
1459

1460
1461

1462
1463


1464
1465
1466
1467
1468
1469


1470

1471



1472



1473

1474
1475
1476

1477
1478
1479
1480

1481
1482

1483
1484


1485

1486
1487
1488
1489
1490
1491
1492

1493
1494

1495
1496


1497

1498
1499
1500
1501
1502
1503
1504

1505
1506

1507
1508


1509
1510
1511
1512
1513
1514
1515

1516
1517

1518
1519


1520

1521
1522
1523
1524
1525
1526
1527

1528
1529

1530
1531


1532

1533
1534
1535
1536
1537
1538
1539

1540
1541

1542
1543


1544

1545
1546
1547
1548
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
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
595
596
597
598
599
600
601

602

603
604


605
606
607
608
609
610

611

612
613


614
615
616
617
618
619
620
621

622

623
624


625
626
627
628
629
630
631
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
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


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

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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446

1447

1448
1449


1450
1451
1452
1453
1454
1455
1456
1457
1458
1459

1460

1461
1462


1463
1464
1465
1466
1467
1468
1469
1470
1471
1472

1473

1474
1475


1476
1477



1478
1479

1480
1481
1482
1483

1484
1485
1486
1487
1488
1489
1490

1491
1492
1493
1494
1495
1496
1497
1498

1499

1500
1501


1502
1503
1504
1505
1506
1507
1508
1509
1510
1511

1512

1513
1514


1515
1516
1517
1518
1519
1520
1521
1522
1523
1524

1525

1526
1527


1528
1529
1530
1531
1532
1533
1534
1535

1536

1537
1538


1539
1540
1541
1542
1543
1544
1545
1546
1547
1548

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
1596
1597
1598

1599
1600

1601




1602
1603
1604

1605
1606

1607
1608

1609
1610
1611
1612
1613
1614
1615
1616







-
+






-
+
-

+
-
-
+
+







-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-
-

+
-
-
+
+




-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+




-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

-
-
+
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+
-
-

-
+
+



-
+

-
+
-
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+




-
+
-

+
-
-
+
+






-
+
-

-
-
+
+
+






-
+
-

-
-
+
+
+






-
+
-

-
-
+
+
+






-
+
-

-
-
+
+
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+
-
-






-
+

-

-
-
-
-
+
+
+

-
+
+



-
+






-

+
-
-
+
+
-
-

-
+
+



-
+






-

+
-
-
+
+
-
-

-
+
+

-
+




-
+



-

+
-
-
+
+
-
-

-
+
+





-
+



-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+





-
+
-

+
-
-
+
+

+





-
+
-

+
-
-
+
+

+





-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+



-
+
-

+
-
-
+
+

+




-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

-
-
-
+



+
-
+
-
-
-
+
-
-




-
+
-
-



-
-

+
-
+

-
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+
-
-






-
+


-

+
-
-
+
+
-
-
-
+



-
+
+
+
+

-
+





-
-

+
-
+

-
+

+








-
+
-

-
-
+
+
+
-
-

-
+
+


+
-
+
+
+

-
-
+
+




-
-

+
-
-
+
+

-
+
+



-
+
-

+
-
+



-
+

+






+
-
-
-
-
+
+
+
+
+
-

-
+
+

-
+

-
+
+




-
+
-

+
-
-
+
+

-
+
+




-
+
-

+
-
-
+
+
-
-

-
+
+



-
+


-

+
-
+







-
+


+



+

-
+
-

+
-
-
+
+


+



+



-
+
-

+
-
-
+
+

+



+


-
+
-

+
-
-
+
+

+



+


-
+
-

+
-
+

-
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
+

-
+

+





-
+
-

+
-
-
+
+

+





-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+
-
-

-
+
+



+
-
+
+
+

+
+
-
+







-
-

+
-
-
+
+
-
-






-
+









+













+
-
+

-
+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+
-
-
-


-
+
+

+
-
+
+
+

+
+
+
-
+



+



-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
-
+
+

+






-
+
-

+
-
+

-
-
-
+
+
+

-
+







-
-
-
-
-
+
+
+
+
+
+

-
+

-
+
-
-
-
-
+
+
+
-

+
-
+

-
+







    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation lf
    list [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {-1 {}}
test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} -body {
test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation lf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {0 {} -1 {}}
test chan-io-6.12 {Tcl_GetsObj: lf mode: lone \r} -body {
} {0 {} -1 {}}
test chan-io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation lf
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 1 "\r" -1 ""]
test chan-io-6.13 {Tcl_GetsObj: lf mode: 1 char} -body {
} [list 1 "\r" -1 ""]
test chan-io-6.13 {Tcl_GetsObj: lf mode: 1 char} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f a
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation lf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} -body {
} {1 a -1 {}}
test chan-io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation lf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.15 {Tcl_GetsObj: lf mode: several chars} -body {
} {1 a -1 {}}
test chan-io-6.15 {Tcl_GetsObj: lf mode: several chars} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation lf
    list [chan gets $f line] $line [chan gets $f line] $line \
    set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
	[chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
    chan close $f
    set x
} -result [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
test chan-io-6.16 {Tcl_GetsObj: cr mode: no chars} -body {
} [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
test chan-io-6.16 {Tcl_GetsObj: cr mode: no chars} {
    set f [open $path(test1) w]
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation cr
    list [chan gets $f line] $line
    set x [list [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {-1 {}}
test chan-io-6.17 {Tcl_GetsObj: cr mode: lone \n} -body {
} {-1 {}}
test chan-io-6.17 {Tcl_GetsObj: cr mode: lone \n} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation cr
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 1 "\n" -1 ""]
test chan-io-6.18 {Tcl_GetsObj: cr mode: lone \r} -body {
} [list 1 "\n" -1 ""]
test chan-io-6.18 {Tcl_GetsObj: cr mode: lone \r} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation cr
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {0 {} -1 {}}
test chan-io-6.19 {Tcl_GetsObj: cr mode: 1 char} -body {
} {0 {} -1 {}}
test chan-io-6.19 {Tcl_GetsObj: cr mode: 1 char} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f a
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation cr
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} -body {
} {1 a -1 {}}
test chan-io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation cr
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.21 {Tcl_GetsObj: cr mode: several chars} -body {
} {1 a -1 {}}
test chan-io-6.21 {Tcl_GetsObj: cr mode: several chars} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation cr
    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
test chan-io-6.22 {Tcl_GetsObj: crlf mode: no chars} -body {
} [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
test chan-io-6.22 {Tcl_GetsObj: crlf mode: no chars} {
    set f [open $path(test1) w]
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line
    set x [list [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {-1 {}}
test chan-io-6.23 {Tcl_GetsObj: crlf mode: lone \n} -body {
} {-1 {}}
test chan-io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 1 "\n" -1 ""]
test chan-io-6.24 {Tcl_GetsObj: crlf mode: lone \r} -body {
} [list 1 "\n" -1 ""]
test chan-io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 1 "\r" -1 ""]
test chan-io-6.25 {Tcl_GetsObj: crlf mode: \r\r} -body {
} [list 1 "\r" -1 ""]
test chan-io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 2 "\r\r" -1 ""]
test chan-io-6.26 {Tcl_GetsObj: crlf mode: \r\n} -body {
} [list 2 "\r\r" -1 ""]
test chan-io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
} -result {0 {} -1 {}}
test chan-io-6.27 {Tcl_GetsObj: crlf mode: 1 char} -body {
    set x
} [list 0 "" -1 ""]
test chan-io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f a
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} -body {
} {1 a -1 {}}
test chan-io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\r\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.29 {Tcl_GetsObj: crlf mode: several chars} -body {
} {1 a -1 {}}
test chan-io-6.29 {Tcl_GetsObj: crlf mode: several chars} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} -constraints {testchannel} -body {
} [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
    # if (eol >= dstEnd)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [testchannel inputbuffered $f]
    set x [list [chan gets $f line] $line [testchannel inputbuffered $f]]
} -cleanup {
    chan close $f
    set x
} -result [list 15 "123456789012345" 15]
test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} -setup {
} [list 15 "123456789012345" 15]
test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} {
    set x ""
} -constraints {stdio testchannel fileevent} -body {
    # (FilterInputBytes() != 0)
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {crlf lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
    chan configure $f -buffersize 16
    lappend x [chan gets $f]
    set x [chan gets $f]
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [chan blocked $f] \
    lappend x [chan gets $f line] $line [chan blocked $f] [testchannel inputbuffered $f]
	[testchannel inputbuffered $f]
} -cleanup {
    chan close $f
    set x
} -result {bbbbbbbbbbbbbb -1 {} 1 16}
test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} -constraints {testchannel} -body {
} [list "bbbbbbbbbbbbbb" -1 "" 1 16]
test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} {
    # not (FilterInputBytes() != 0)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\r\n123"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [chan tell $f] [testchannel inputbuffered $f]
    set x [list [chan gets $f line] $line [chan tell $f] [testchannel inputbuffered $f]]
} -cleanup {
    chan close $f
    set x
} -result {15 123456789012345 17 3}
test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} -body {
} [list 15 "123456789012345" 17 3]
test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
    # eol still equals dstEnd

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [chan eof $f]
    set x [list [chan gets $f line] $line [chan eof $f]]
} -cleanup {
    chan close $f
    set x
} -result [list 16 "123456789012345\r" 1]
test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body {
} [list 16 "123456789012345\r" 1]
test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
    # not (*eol == '\n')

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\rabcd\r\nefg"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf -buffersize 16
    list [chan gets $f line] $line [chan tell $f]
    set x [list [chan gets $f line] $line [chan tell $f]]
} -cleanup {
    chan close $f
    set x
} -result [list 20 "123456789012345\rabcd" 22]
test chan-io-6.35 {Tcl_GetsObj: auto mode: no chars} -body {
} [list 20 "123456789012345\rabcd" 22]
test chan-io-6.35 {Tcl_GetsObj: auto mode: no chars} {
    set f [open $path(test1) w]
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan gets $f line] $line
    set x [list [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {-1 {}}
test chan-io-6.36 {Tcl_GetsObj: auto mode: lone \n} -body {
} {-1 {}}
test chan-io-6.36 {Tcl_GetsObj: auto mode: lone \n} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
} -result {0 {} -1 {}}
test chan-io-6.37 {Tcl_GetsObj: auto mode: lone \r} -body {
    set x
} [list 0 "" -1 ""]
test chan-io-6.37 {Tcl_GetsObj: auto mode: lone \r} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
} -result {0 {} -1 {}}
test chan-io-6.38 {Tcl_GetsObj: auto mode: \r\r} -body {
    set x
} [list 0 "" -1 ""]
test chan-io-6.38 {Tcl_GetsObj: auto mode: \r\r} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
} -result {0 {} 0 {} -1 {}}
test chan-io-6.39 {Tcl_GetsObj: auto mode: \r\n} -body {
    set x
} [list 0 "" 0 "" -1 ""]
test chan-io-6.39 {Tcl_GetsObj: auto mode: \r\n} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
} -result {0 {} -1 {}}
test chan-io-6.40 {Tcl_GetsObj: auto mode: 1 char} -body {
    set x
} [list 0 "" -1 ""]
test chan-io-6.40 {Tcl_GetsObj: auto mode: 1 char} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f a
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} -body {
} {1 a -1 {}}
test chan-io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\r\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result {1 a -1 {}}
test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} -setup {
} {1 a -1 {}}
test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} {
    set x ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    lappend x [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line]
    lappend x [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
    chan close $f
} -result {4 abcd 4 efgh 4 ijkl 4 mnop -1 {}}
test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
    set x ""
} -constraints {stdio testchannel fileevent} -body {
    set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
test chan-io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {
    # if (chanPtr->flags & INPUT_SAW_CR)
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    lappend x [chan gets $f]
    set x [list [chan gets $f]]
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    chan configure $f -blocking 1
    chan puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
    set x
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
    set x ""
} -constraints {stdio testchannel fileevent} -body {
    # not (*eol == '\n')
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    lappend x [chan gets $f]
    set x [list [chan gets $f]]
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    chan configure $f -blocking 1
    chan puts -nonewline $f "abcd\refg\x1a"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
    set x
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup {
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} {
    set x ""
} -constraints {stdio testchannel fileevent} -body {
    # Tcl_ExternalToUtf()
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto lf} -buffering none
    chan configure $f -encoding utf-16
    chan configure $f -encoding unicode
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    chan gets $f
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
    chan configure $f -blocking 1
    chan puts -nonewline $f "\nabcd\refg"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
    chan close $f
    set x
} -result {15 123456789abcdef 1 4 abcd 0}
test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} -setup {
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {
    set x ""
} -constraints {stdio testchannel fileevent} -body {
    # memmove()
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto lf} -buffering none
    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    chan configure $f -buffersize 16
    chan gets $f
    chan configure $f -blocking 0
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
    chan configure $f -blocking 1
    chan puts -nonewline $f "\n\x1a"
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
    chan close $f
    set x
} -result {15 123456789abcdef 1 -1 {} 0}
test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} -constraints {testchannel} -body {
} [list 15 "123456789abcdef" 1 -1 "" 0]
test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} {
    # (eol == dstEnd)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto -buffersize 16
    list [chan gets $f] [testchannel inputbuffered $f]
    set x [list [chan gets $f] [testchannel inputbuffered $f]]
} -cleanup {
    chan close $f
    set x
} -result {123456789012345 15}
test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} -constraints {testchannel} -body {
} [list "123456789012345" 15]
test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
    # PeekAhead() did not get any, so (eol >= dstEnd)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456789012345\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto -buffersize 16
    list [chan gets $f] [testchannel queuedcr $f]
    set x [list [chan gets $f] [testchannel queuedcr $f]]
} -cleanup {
    chan close $f
    set x
} -result {123456789012345 1}
test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} -constraints {testchannel} -body {
} [list "123456789012345" 1]
test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
    # if (*eol == '\n') {skip++}

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456\r\n78901"
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
    set x [list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]]
} -cleanup {
    chan close $f
    set x
} -result {123456 0 8 78901}
test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body {
} [list "123456" 0 8 "78901"]
test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
    # not (*eol == '\n')

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456\r78901"
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
    set x [list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]]
} -cleanup {
    chan close $f
    set x
} -result {123456 0 7 78901}
test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} -body {
} [list "123456" 0 7 "78901"]
test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} {
    # else if (*eol == '\n') {goto gotoeol;}

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456\n78901"
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f] [chan tell $f] [chan gets $f]
    set x [list [chan gets $f] [chan tell $f] [chan gets $f]]
} -cleanup {
    chan close $f
    set x
} -result {123456 7 78901}
test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -body {
} [list "123456" 7 "78901"]
test chan-io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {
    # if (eof != NULL)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "123456\x1ak9012345\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -eofchar \x1a
    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
    set x [list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]]
} -cleanup {
    chan close $f
    set x
} -result {123456 0 6 {}}
test chan-io-6.53 {Tcl_GetsObj: device EOF} -body {
} [list "123456" 0 6 ""]
test chan-io-6.53 {Tcl_GetsObj: device EOF} {
    # didn't produce any bytes

    set f [open $path(test1) w]
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f line] $line [chan eof $f]
    set x [list [chan gets $f line] $line [chan eof $f]]
} -cleanup {
    chan close $f
    set x
} -result {-1 {} 1}
test chan-io-6.54 {Tcl_GetsObj: device EOF} -body {
} {-1 {} 1}
test chan-io-6.54 {Tcl_GetsObj: device EOF} {
    # got some bytes before EOF.

    set f [open $path(test1) w]
    chan puts -nonewline $f abc
    chan close $f
    set f [open $path(test1)]
    list [chan gets $f line] $line [chan eof $f]
    set x [list [chan gets $f line] $line [chan eof $f]]
} -cleanup {
    chan close $f
    set x
} -result {3 abc 1}
test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
} {3 abc 1}
test chan-io-6.55 {Tcl_GetsObj: overconverted} {
    # Tcl_ExternalToUtf(), make sure state updated

    set f [open $path(test1) w]
    chan configure $f -encoding iso2022-jp
    chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding iso2022-jp
    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
    set x [list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line]
} -cleanup {
    chan close $f
    set x
} -result [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} {
    update
    variable x {}
} -constraints {stdio fileevent} -body {
    set f [openpipe w+ $path(cat)]
    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -buffering none
    chan puts -nonewline $f "foobar"
    chan configure $f -blocking 0
    variable x {}
    after 500 [namespace code {
    after 500 [namespace code { lappend x timeout }]
	lappend x timeout
    }]
    chan event $f readable [namespace code {
    chan event $f readable [namespace code { lappend x [chan gets $f] }]
	lappend x [chan gets $f]
    }]
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    chan configure $f -blocking 1
    chan puts -nonewline $f "baz\n"
    after 500 [namespace code {
    after 500 [namespace code { lappend x timeout }]
	lappend x timeout
    }]
    chan configure $f -blocking 0
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
    set x
} -result {{} timeout foobarbaz timeout}
} {{} timeout foobarbaz timeout}

test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body {
test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} {
    # (result == TCL_CONVERT_MULTIBYTE)

    set f [open $path(test1) w]
    chan configure $f -encoding shiftjis
    chan puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis -buffersize 16
    chan gets $f
    set x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result "1234567890123\uff10\uff11\uff12\uff13\uff14"
test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body {
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} {
    # (bufPtr->nextAdded < bufPtr->bufLength)

    set f [open $path(test1) w]
    chan configure $f -encoding binary
    chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis
    list [chan gets $f line] $line [chan eof $f]
    set x [list [chan gets $f line] $line [chan eof $f]]
} -cleanup {
    chan close $f
    set x
} -result {10 1234567890 0}
test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
} [list 10 "1234567890" 0]
test chan-io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
    set x ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -encoding binary
    chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding shiftjis
    lappend x [chan gets $f line] $line
    set x [list [chan gets $f line] $line]
    lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
    set x
} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} {
    variable x ""
} -constraints {stdio fileevent} -body {
    set f [openpipe w+ $path(cat)]
    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -encoding binary -buffering none
    chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
    chan configure $f -encoding shiftjis -blocking 0
    chan event $f read [namespace code {
    chan event $f read [namespace code "ready $f"]
    variable x {}
    proc ready {f} {
	variable x
	lappend x [chan gets $f line] $line [chan blocked $f]
    }]
    }
    vwait [namespace which -variable x]
    chan configure $f -encoding binary -blocking 1
    chan puts $f "\x51\x82\x52"
    chan configure $f -encoding shiftjis
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
    set x
} -result [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]

test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body {
test chan-io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} {
    # (bufPtr->nextPtr == NULL)

    set f [open $path(test1) w]
    chan configure $f -encoding ascii -translation lf
    chan puts -nonewline $f "123456789012345\r\n2345678"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding ascii -translation auto -buffersize 16
    # here
    chan gets $f
    testchannel inputbuffered $f
    set x [testchannel inputbuffered $f]
} -cleanup {
    chan close $f
} -result 7
test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
    set x
} "7"
test chan-io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} {
    variable x {}
} -constraints {stdio testchannel fileevent} -body {
    # not (bufPtr->nextPtr == NULL)
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation lf -encoding ascii -buffering none
    chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
    variable x {}
    chan event $f read [namespace code {
    chan event $f read [namespace code "ready $f"]
    proc ready {f} {
	variable x
	lappend x [chan gets $f line] $line [testchannel inputbuffered $f]
    }]
    chan configure $f -encoding utf-16 -buffersize 16 -blocking 0
    }
    chan configure $f -encoding unicode -buffersize 16 -blocking 0
    vwait [namespace which -variable x]
    chan configure $f -translation auto -encoding ascii -blocking 1
    # here
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
    set x
} -result {-1 {} 42 15 123456789012345 25}
test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel fileevent} -body {
} [list -1 "" 42 15 "123456789012345" 25]
test chan-io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {
    # (bytesLeft == 0)
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto binary}
    chan puts -nonewline $f "abcdefghijklmno\r"
    chan flush $f
    list [chan gets $f line] $line [testchannel queuedcr $f]
    set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
} -cleanup {
    chan close $f
    set x
} -result {15 abcdefghijklmno 1}
} [list 15 "abcdefghijklmno" 1]
set a "123456789012345678901234567890"
append a "123456789012345678901234567890"
append a "1234567890123456789012345678901"
test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body {
test chan-io-8.4 {PeekAhead: cached data available in this buffer} {
    # not (bytesLeft == 0)

    set f [open $path(test1) w+]
    chan configure $f -translation binary
    chan puts $f "${a}\r\nabcdef"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding binary -translation auto

    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE is
    # 30). To check if "\n" follows, calls PeekAhead and determines that
    # cached data is available in buffer w/o having to call driver.
    chan gets $f
    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE
    # is 30).  To check if "\n" follows, calls PeekAhead and determines
    # that cached data is available in buffer w/o having to call driver.

    set x [chan gets $f]
} -cleanup {
    chan close $f
} -result $a
    set x
} $a
unset a
test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel fileevent} -body {
test chan-io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
    # (bufPtr->nextAdded < bufPtr->length)
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto binary}
    chan puts -nonewline $f "abcdefghijklmno\r"
    chan flush $f
    # here
    list [chan gets $f line] $line [testchannel queuedcr $f]
    set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
} -cleanup {
    chan close $f
    set x
} -result {15 abcdefghijklmno 1}
test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel fileevent} -body {
} {15 abcdefghijklmno 1}
test chan-io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto binary} -buffersize 16
    chan puts -nonewline $f "abcdefghijklmno\r"
    chan flush $f
    # here
    list [chan gets $f line] $line [testchannel queuedcr $f]
    set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
} -cleanup {
    chan close $f
    set x
} -result {15 abcdefghijklmno 1}
test chan-io-8.7 {PeekAhead: cleanup} -setup {
} {15 abcdefghijklmno 1}
test chan-io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} {
    set x ""
} -constraints {stdio testchannel fileevent} -body {
    # Make sure bytes are removed from buffer.
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -translation {auto binary} -buffering none
    chan puts -nonewline $f "abcdefghijklmno\r"
    # here
    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
    set x [list [chan gets $f line] $line [testchannel queuedcr $f]]
    chan puts -nonewline $f "\x1a"
    lappend x [chan gets $f line] $line
} -cleanup {
    chan close $f
    set x
} -result {15 abcdefghijklmno 1 -1 {}}
} {15 abcdefghijklmno 1 -1 {}}

test chan-io-9.1 {CommonGetsCleanup} emptyTest {
} {}

test chan-io-10.1 {Tcl_ReadChars: CheckChannelErrors} emptyTest {
    # no test, need to cause an async error.
} {}
test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} -body {
test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} {
    # one time
    # for (copied = 0; (unsigned) toRead > 0; )

    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnop
    chan close $f

    set f [open $path(test1)]
    chan read $f 5
    set x [chan read $f 5]
} -cleanup {
    chan close $f
    set x
} -result {abcde}
test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} -body {
} {abcde}
test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} {
    # multiple times
    # for (copied = 0; (unsigned) toRead > 0; )

    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnopqrstuvwxyz
    chan close $f

    set f [open $path(test1)]
    chan configure $f -buffersize 16
    # here
    chan read $f 19
    set x [chan read $f 19]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijklmnopqrs}
test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} -body {
} {abcdefghijklmnopqrs}
test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} {
    # (copiedNow < 0)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f

    set f [open $path(test1)]
    # here
    chan read $f 1000
    set x [chan read $f 1000]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijkl}
test chan-io-10.5 {Tcl_ReadChars: stop on EOF} -body {
} {abcdefghijkl}
test chan-io-10.5 {Tcl_ReadChars: stop on EOF} {
    # (chanPtr->flags & CHANNEL_EOF)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f

    set f [open $path(test1)]
    # here
    chan read $f 1000
    set x [chan read $f 1000]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijkl}
} {abcdefghijkl}

test chan-io-11.1 {ReadBytes: want to read a lot} -body {
test chan-io-11.1 {ReadBytes: want to read a lot} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding binary
    # here
    chan read $f 1000
    set x [chan read $f 1000]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijkl}
test chan-io-11.2 {ReadBytes: want to read all} -body {
} {abcdefghijkl}
test chan-io-11.2 {ReadBytes: want to read all} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f
    set f [open $path(test1)]
    chan configure $f -encoding binary
    # here
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijkl}
test chan-io-11.3 {ReadBytes: allocate more space} -body {
} {abcdefghijkl}
test chan-io-11.3 {ReadBytes: allocate more space} {
    # (toRead > length - offset - 1)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz
    chan close $f
    set f [open $path(test1)]
    chan configure $f -buffersize 16 -encoding binary
    # here
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijklmnopqrstuvwxyz}
test chan-io-11.4 {ReadBytes: EOF char found} -body {
} {abcdefghijklmnopqrstuvwxyz}
test chan-io-11.4 {ReadBytes: EOF char found} {
    # (TranslateInputEOL() != 0)

    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnopqrstuvwxyz
    chan close $f
    set f [open $path(test1)]
    chan configure $f -eofchar m -encoding binary
    # here
    list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f]
    set x [list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f]]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijkl 1 {} 1}
} [list "abcdefghijkl" 1 "" 1]

test chan-io-12.1 {ReadChars: want to read a lot} -body {
test chan-io-12.1 {ReadChars: want to read a lot} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f
    set f [open $path(test1)]
    # here
    chan read $f 1000
    set x [chan read $f 1000]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijkl}
test chan-io-12.2 {ReadChars: want to read all} -body {
} {abcdefghijkl}
test chan-io-12.2 {ReadChars: want to read all} {
    # ((unsigned) toRead > (unsigned) srcLen)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijkl
    chan close $f
    set f [open $path(test1)]
    # here
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijkl}
test chan-io-12.3 {ReadChars: allocate more space} -body {
} {abcdefghijkl}
test chan-io-12.3 {ReadChars: allocate more space} {
    # (toRead > length - offset - 1)

    set f [open $path(test1) w]
    chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz
    chan close $f
    set f [open $path(test1)]
    chan configure $f -buffersize 16
    # here
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijklmnopqrstuvwxyz}
test chan-io-12.4 {ReadChars: split-up char} -setup {
} {abcdefghijklmnopqrstuvwxyz}
test chan-io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
    variable x {}
} -constraints {stdio testchannel fileevent} -body {
    # (srcRead == 0)
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -encoding binary -buffering none -buffersize 16
    chan puts -nonewline $f "123456789012345\x96"
    chan configure $f -encoding shiftjis -blocking 0

    chan event $f read [namespace code {
    chan event $f read [namespace code "ready $f"]
    proc ready {f} {
	variable x
	lappend x [chan read $f] [testchannel inputbuffered $f]
    }
    variable x {}
    }]

    chan configure $f -encoding shiftjis
    vwait [namespace which -variable x]
    chan configure $f -encoding binary -blocking 1
    chan puts -nonewline $f "\x7b"
    after 500			;# Give the cat process time to catch up
    chan configure $f -encoding shiftjis -blocking 0
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
    set x
} -result [list "123456789012345" 1 "\u672c" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
} [list "123456789012345" 1 "\u672c" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} {stdio openpipe fileevent} {
    variable x {}
} -constraints {stdio fileevent} -body {
    set path(test1) [makeFile {
	chan configure stdout -encoding binary -buffering none
	chan gets stdin; chan puts -nonewline "\xe7"
	chan gets stdin; chan puts -nonewline "\x89"
	chan gets stdin; chan puts -nonewline "\xa6"
    } test1]
    set f [openpipe r+ $path(test1)]
    set f [open "|[list [interpreter] $path(test1)]" r+]
    chan event $f readable [namespace code {
	lappend x [chan read $f]
	if {[chan eof $f]} {
	    lappend x eof
	}
    }]
    chan puts $f "go1"
    chan flush $f
    chan configure $f -blocking 0 -encoding utf-8
    variable x {}
    vwait [namespace which -variable x]
    after 500 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan puts $f "go2"
    chan flush $f
    vwait [namespace which -variable x]
    after 500 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan puts $f "go3"
    chan flush $f
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    lappend x [catch {chan close $f} msg] $msg
    set x
} -result "{} timeout {} timeout \u7266 {} eof 0 {}"
} "{} timeout {} timeout \u7266 {} eof 0 {}"

test chan-io-13.1 {TranslateInputEOL: cr mode} -body {
test chan-io-13.1 {TranslateInputEOL: cr mode} {} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\rdef\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation cr
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef\n"
test chan-io-13.2 {TranslateInputEOL: crlf mode} -body {
} "abcd\ndef\n"
test chan-io-13.2 {TranslateInputEOL: crlf mode} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\r\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef\n"
test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
} "abcd\ndef\n"
test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef\r"
test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
} "abcd\ndef\r"
test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\rfgh"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef\rfgh"
test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
} "abcd\ndef\rfgh"
test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef\nfgh"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation crlf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef\nfgh"
test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
} "abcd\ndef\nfgh"
test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} {
    variable x {}
    variable y {}
} -constraints {stdio testchannel fileevent} -body {
    # (chanPtr->flags & INPUT_SAW_CR)
    # This test may fail on slower machines.
    set f [openpipe w+ $path(cat)]

    set f [open "|[list [interpreter] $path(cat)]" w+]
    chan configure $f -blocking 0 -buffering none -translation {auto lf}

    chan event $f read [namespace code {
    chan event $f read [namespace code "ready $f"]
    proc ready {f} {
	variable x
	lappend x [chan read $f] [testchannel queuedcr $f]
    }
    variable x {}
    variable y {}
    }]

    chan puts -nonewline $f "abcdefghj\r"
    after 500 [namespace code {set y ok}]
    vwait [namespace which -variable y]

    chan puts -nonewline $f "\n01234"
    after 500 [namespace code {set y ok}]
    vwait [namespace which -variable y]
    return $x

} -cleanup {
    chan close $f
    set x
} -result [list "abcdefghj\n" 1 "01234" 0]
test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints testchannel -body {
} [list "abcdefghj\n" 1 "01234" 0]
test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    list [chan read $f] [testchannel queuedcr $f]
    set x [list [chan read $f] [testchannel queuedcr $f]]
} -cleanup {
    chan close $f
    set x
} -result [list "abcd\n" 1]
test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} -body {
} [list "abcd\n" 1]
test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} {
    # (*src == '\n')

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\r\ndef"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef"
test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} -body {
} "abcd\ndef"
test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\rdef"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef"
test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
} "abcd\ndef"
test chan-io-13.10 {TranslateInputEOL: auto mode: \n} {
    # not (*src == '\r')

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\ndef"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\ndef"
test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
} "abcd\ndef"
test chan-io-13.11 {TranslateInputEOL: EOF char} {
    # (*chanPtr->inEofChar != '\0')

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "abcd\ndefgh"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto -eofchar e
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "abcd\nd"
test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body {
} "abcd\nd"
test chan-io-13.12 {TranslateInputEOL: find EOF char in src} {
    # (*chanPtr->inEofChar != '\0')

    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
    chan close $f
    set f [open $path(test1)]
    chan configure $f -translation auto -eofchar e
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "\n\n\nab\n\nd"
} "\n\n\nab\n\nd"

# Test standard handle management. The functions tested are Tcl_SetStdChannel
# and Tcl_GetStdChannel. Incidentally we are also testing channel table
# management.
# Test standard handle management. The functions tested are
# Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are
# also testing channel table management.

if {[testConstraint testchannel]} {
if {[info commands testchannel] != ""} {
    set consoleFileNames [lsort [testchannel open]]
} else {
    # just to avoid an error
    set consoleFileNames [list]
}

test chan-io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} {
    set result ""
    lappend result [chan configure stdin -buffering]
    lappend result [chan configure stdout -buffering]
    lappend result [chan configure stderr -buffering]
    lappend result [lsort [testchannel open]]
    set l ""
    lappend l [chan configure stdin -buffering]
    lappend l [chan configure stdout -buffering]
    lappend l [chan configure stderr -buffering]
    lappend l [lsort [testchannel open]]
    set l
} [list line line none $consoleFileNames]
test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} -setup {
test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
    interp create x
    set result ""
    set l ""
} -body {
    lappend result [x eval {chan configure stdin -buffering}]
    lappend result [x eval {chan configure stdout -buffering}]
    lappend result [x eval {chan configure stderr -buffering}]
    lappend l [x eval {chan configure stdin -buffering}]
    lappend l [x eval {chan configure stdout -buffering}]
    lappend l [x eval {chan configure stderr -buffering}]
} -cleanup {
    interp delete x
    set l
} -result {line line none}
} {line line none}
set path(test3) [makeFile {} test3]
test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints exec -body {
test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
    set f [open $path(test1) w]
    chan puts -nonewline $f {
	chan close stdin
	chan close stdout
	chan close stderr
	set f  [}
    chan puts $f [list open $path(test1) r]]
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
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


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

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
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
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

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
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
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







-


-
+
+



-
-
+
+








-
-
+











-


+
-
+
-
-
+
+


-
+

-




-
+
-

+
-
-
+
+

-




-
+
-

+
-
-
+
+

-




-
+
-

+
-
+

-
+


-














-
-
+
+
-

+
-
-
+
+


-











-
-
+
+
-




-
+


+
-
+







-
-
-
+
+
+

-
-
+
+

-
+
-
-



+
-
+

-
+

-
-
-
+
+
+
+
-
-



+
-
+

-
+

-
-
-
+
+
+
+
-
-



+
-
+

-
+

-
-
+
+
+

-
+


-








+
-
-
-
+
+
+


-















+
-
-
-
+
+
+


-













+
-
-
+
+




-
+

-

-
+
-

+
-
-
-
-
-
+
+
+
+
+

-
-

+







+
-
-
+
+







	chan close $f3
    }
    chan close $f
    set result [exec [interpreter] $path(test1)]
    set f  [open $path(test2) r]
    set f2 [open $path(test3) r]
    lappend result [chan read $f] [chan read $f2]
} -cleanup {
    chan close $f
    chan close $f2
} -result {{
    set result
} {{
out
} {err
}}
# This test relies on the fact that stdout is used before stderr.
test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec} -body {
# This test relies on the fact that the smallest available fd is used first.
test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unix} {
    set f [open $path(test1) w]
    chan puts -nonewline $f { chan close stdin
	chan close stdout
	chan close stderr
	set f  [}
    chan puts $f [list open $path(test1) r]]
    chan puts $f "set f2 \[[list open $path(test2) w]]"
    chan puts $f "set f3 \[[list open $path(test3) w]]"
    chan puts $f {
	chan puts stdout [chan gets stdin]
    chan puts $f {	chan puts stdout [chan gets stdin]
	chan puts stdout $f2
	chan puts stderr $f3
	chan close $f
	chan close $f2
	chan close $f3
    }
    chan close $f
    set result [exec [interpreter] $path(test1)]
    set f  [open $path(test2) r]
    set f2 [open $path(test3) r]
    lappend result [chan read $f] [chan read $f2]
} -cleanup {
    chan close $f
    chan close $f2
    set result
} -result {{ chan close stdin
} {{ chan close stdin
stdout
} {stderr
file1
} {file2
}}
catch {interp delete z}
test chan-io-14.5 {Tcl_GetChannel: stdio name translation} -setup {
test chan-io-14.5 {Tcl_GetChannel: stdio name translation} {
    interp create z
} -body {
    chan eof stdin
    catch {z eval chan flush stdin} msg1
    catch {z eval chan close stdin} msg2
    catch {z eval chan flush stdin} msg3
    list $msg1 $msg2 $msg3
    set result [list $msg1 $msg2 $msg3]
} -cleanup {
    interp delete z
    set result
} -result {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
test chan-io-14.6 {Tcl_GetChannel: stdio name translation} -setup {
} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
test chan-io-14.6 {Tcl_GetChannel: stdio name translation} {
    interp create z
} -body {
    chan eof stdout
    catch {z eval chan flush stdout} msg1
    catch {z eval chan close stdout} msg2
    catch {z eval chan flush stdout} msg3
    list $msg1 $msg2 $msg3
    set result [list $msg1 $msg2 $msg3]
} -cleanup {
    interp delete z
    set result
} -result {{} {} {can not find channel named "stdout"}}
test chan-io-14.7 {Tcl_GetChannel: stdio name translation} -setup {
} {{} {} {can not find channel named "stdout"}}
test chan-io-14.7 {Tcl_GetChannel: stdio name translation} {
    interp create z
} -body {
    chan eof stderr
    catch {z eval chan flush stderr} msg1
    catch {z eval chan close stderr} msg2
    catch {z eval chan flush stderr} msg3
    list $msg1 $msg2 $msg3
    set result [list $msg1 $msg2 $msg3]
} -cleanup {
    interp delete z
    set result
} -result {{} {} {can not find channel named "stderr"}}
} {{} {} {can not find channel named "stderr"}}
set path(script) [makeFile {} script]
test chan-io-14.8 {reuse of stdio special channels} -setup {
test chan-io-14.8 {reuse of stdio special channels} {stdio openpipe} {
    file delete $path(script)
    file delete $path(test1)
} -constraints stdio -body {
    set f [open $path(script) w]
    chan puts -nonewline $f {
	chan close stderr
	set f [}
    chan puts $f [list open $path(test1) w]]
    chan puts -nonewline $f {
	chan puts stderr hello
	chan close $f
	set f [}
    chan puts $f [list open $path(test1) r]]
    chan puts $f {
	chan puts [chan gets $f]
    }
    chan close $f
    set f [openpipe r $path(script)]
    chan gets $f
    set f [open "|[list [interpreter] $path(script)]" r]
    set c [chan gets $f]
} -cleanup {
    chan close $f
    set c
} -result hello
test chan-io-14.9 {reuse of stdio special channels} -setup {
} hello
test chan-io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
    file delete $path(script)
    file delete $path(test1)
} -constraints {stdio fileevent} -body {
    set f [open $path(script) w]
    chan puts $f {
        array set path [lindex $argv 0]
	set f [open $path(test1) w]
	chan puts $f hello
	chan close $f
	chan close stderr
	set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
	chan puts [chan gets $f]
    }
    chan close $f
    set f [openpipe r $path(script) [array get path]]
    chan gets $f
    set f [open "|[list [interpreter] $path(script) [array get path]]" r]
    set c [chan gets $f]
} -cleanup {
    chan close $f
    # Added delay to give Windows time to stop the spawned process and clean
    # up its grip on the file test1. Added delete as proper test cleanup.
    # The failing tests were 18.1 and 18.2 as first re-users of file "test1".
    after [expr {[testConstraint win] ? 10000 : 500}]
    after 10000
    file delete $path(script)
    file delete $path(test1)
    set c
} -result hello
} hello

test chan-io-15.1 {Tcl_CreateChan CloseHandler} emptyTest {
} {}

test chan-io-16.1 {Tcl_DeleteChan CloseHandler} emptyTest {
} {}

# Test channel table management. The functions tested are GetChannelTable,
# DeleteChannelTable, Tcl_RegisterChannel, Tcl_UnregisterChannel,
# Tcl_GetChannel and Tcl_CreateChannel.
# Test channel table management. The functions tested are
# GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel,
# Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel.
#
# These functions use "eof stdin" to ensure that the standard channels are
# added to the channel table of the interpreter.
# These functions use "eof stdin" to ensure that the standard
# channels are added to the channel table of the interpreter.

test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} -setup {
test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l ""
} -constraints {testchannel} -body {
    set l1 [testchannel refcount stdin]
    chan eof stdin
    interp create x
    set l ""
    lappend l [expr {[testchannel refcount stdin] - $l1}]
    lappend l [expr [testchannel refcount stdin] - $l1]
    x eval {chan eof stdin}
    lappend l [expr {[testchannel refcount stdin] - $l1}]
    lappend l [expr [testchannel refcount stdin] - $l1]
    interp delete x
    lappend l [expr {[testchannel refcount stdin] - $l1}]
} -result {0 1 0}
test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} -setup  {
    lappend l [expr [testchannel refcount stdin] - $l1]
    set l
} {0 1 0}
test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l ""
} -constraints {testchannel} -body {
    set l1 [testchannel refcount stdout]
    chan eof stdin
    interp create x
    set l ""
    lappend l [expr {[testchannel refcount stdout] - $l1}]
    lappend l [expr [testchannel refcount stdout] - $l1]
    x eval {chan eof stdout}
    lappend l [expr {[testchannel refcount stdout] - $l1}]
    lappend l [expr [testchannel refcount stdout] - $l1]
    interp delete x
    lappend l [expr {[testchannel refcount stdout] - $l1}]
} -result {0 1 0}
test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} -setup {
    lappend l [expr [testchannel refcount stdout] - $l1]
    set l
} {0 1 0}
test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
    set l ""
} -constraints {testchannel} -body {
    set l1 [testchannel refcount stderr]
    chan eof stdin
    interp create x
    set l ""
    lappend l [expr {[testchannel refcount stderr] - $l1}]
    lappend l [expr [testchannel refcount stderr] - $l1]
    x eval {chan eof stderr}
    lappend l [expr {[testchannel refcount stderr] - $l1}]
    lappend l [expr [testchannel refcount stderr] - $l1]
    interp delete x
    lappend l [expr {[testchannel refcount stderr] - $l1}]
} -result {0 1 0}
    lappend l [expr [testchannel refcount stderr] - $l1]
    set l
} {0 1 0}

test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
    file delete -force $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    lappend l [lindex [testchannel info $f] 15]
    chan close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being chan closed"
    }
    string compare [string tolower $l] \
    string equal $l [list 1 "can not find channel named \"$f\""]
} -result 1
test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
	[list 1 [format "can not find channel named \"%s\"" $f]]
} 0
test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
    file delete -force $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    lappend l [lindex [testchannel info $f] 15]
    interp create x
    interp share "" $f x
    lappend l [lindex [testchannel info $f] 15]
    x eval chan close $f
    lappend l [lindex [testchannel info $f] 15]
    interp delete x
    lappend l [lindex [testchannel info $f] 15]
    chan close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being chan closed"
    }
    string compare [string tolower $l] \
    string equal $l [list 1 2 1 1 "can not find channel named \"$f\""]
} -result 1
test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
} 0
test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    lappend l [lindex [testchannel info $f] 15]
    interp create x
    interp share "" $f x
    lappend l [lindex [testchannel info $f] 15]
    interp delete x
    lappend l [lindex [testchannel info $f] 15]
    chan close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being chan closed"
    }
    string compare [string tolower $l] \
    string equal $l [list 1 2 1 "can not find channel named \"$f\""]
} -result 1
	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
} 0

test chan-io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
    chan eof stdin
} 0
test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} -setup {
test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan eof $f
    set x [chan eof $f]
} -cleanup {
    chan close $f
    set x
} -result 0
test chan-io-19.3 {Tcl_GetChannel, channel not found} -body {
    chan eof file34
} -returnCodes error -result {can not find channel named "file34"}
test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} -setup {
} 0
test chan-io-19.3 {Tcl_GetChannel, channel not found} {
    list [catch {chan eof file34} msg] $msg
} {1 {can not find channel named "file34"}}
test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    set l ""
    lappend l [chan eof $f]
    chan close $f
    if {[catch {lindex [testchannel info $f] 15} msg]} {
	lappend l $msg
    } else {
	lappend l "very broken: $f found after being chan closed"
    }
    string compare [string tolower $l] \
    string equal $l [list 0 "can not find channel named \"$f\""]
} -result 1
	[list 0 [format "can not find channel named \"%s\"" $f]]
} 0

test chan-io-20.1 {Tcl_CreateChannel: initial settings} -setup {
    set old [encoding system]
} -body {
    set a [open $path(test2) w]
    encoding system ascii
    set f [open $path(test1) w]
1882
1883
1884
1885
1886
1887
1888
1889

1890
1891
1892
1893
1894
1895
1896
1899
1900
1901
1902
1903
1904
1905

1906
1907
1908
1909
1910
1911
1912
1913







-
+







    set f [open $path(test1) w+]
    list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
    chan close $f
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
    set path(stdout) [makeFile {} stdout]
} -constraints {stdio knownMsvcBug} -body {
} -constraints {stdio openpipe knownMsvcBug} -body {
    set f [open $path(script) w]
    chan puts -nonewline $f {
	chan close stdout
	set f1 [}
    chan puts $f [list open $path(stdout) w]]
    chan puts $f {
	chan configure $f1 -buffersize 777
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
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
2658
2659

2660
2661
2662
2663
2664







2665
2666
2667


2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717

2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732

2733
2734
2735
2736
2737




2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759

2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773

2774
2775
2776
2777
2778
2779
2780
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
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
2658
2659
2660

2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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







-
+

-


-
-

+
-
+

-
+

-

-
+
-

+
-
+

-
+
-
-






+


-

+
-
-
+
+

-
-



+





-


+
-
+

-
+


-
-
+
+
+
-

-
+



-
+

-


-
+
-

+
-
-
+
+

-
-


+






+
-
-
+
+

-
-


+




+
-
-
+
+

-
-



+







-

+
-
-
+
+
+

-
-


+







+
-
+


-
+
+


-

















-
+













-
+

-
+
-

-
+

-
-



+




-

+
-
-
+
+

-









-
+
-

+
-
-
+
+
+


-


+



+


+















-
+

+












-
-
+
+


-








-
-
-
+
+
+

-






-
+


-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-





-
-
+
+

-





-
-
+
+

-
-



+





-

+
-
-
+
+

-
-



+





-

+
-
-
+
+

-
-



+





-

+
-
-
+
+

-
-



+








-

+
-
-
+
+

-
-



+











-

+
-
-
-
-
-
+
+
+
+
+

-









-
-
+
+

-









-
-
+
+


-








-
+





-
-
+
+


-
-


-
-
+
+
+


-







-
+





-
-
+
+




-
-
+
+

-
-


-
-
+
+
+

-






-
+
-

+
-
-
+
+



-

-
+
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-

+
-
-
+
+
+

-






-
+
-

-
-
+
+
+



-












-

+
-
-
+
+

-














+
-
-
+
+

-














+
-
-
+
+

-





-
+


-
+
-

+
-
-
+
+

-











-
+






-

+
-
-
+
+

-








-
+






-

+
-
-
+
+
-
-




+





-


+
-
-
+
+

-
-
+





-
+
-

+
-
-
+
+



-
+
-

+
-
-
+
+




-
-
+




-
-
-
-
+
+
+
+




+
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

-




-
+
-

-
-
+
+
+

-





-
-
+
+

-





-
-
+
+


-

















-
+














-
+


-
-
-
+
+
+
+


-


















-
+













-
+







# Tcl_GetChannelInstanceData not tested because files do not use the instance
# data.

test chan-io-22.1 {Tcl_GetChannelMode} emptyTest {
    # Not used anywhere in Tcl.
} {}

test chan-io-23.1 {Tcl_GetChannelName} -constraints {testchannel} -setup {
test chan-io-23.1 {Tcl_GetChannelName} {testchannel} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    set n [testchannel name $f]
    expr {$n eq $f ? "ok" : "$n != $f"}
} -cleanup {
    chan close $f
    string compare $n $f
} -result ok
} 0

test chan-io-24.1 {Tcl_GetChannelType} -constraints {testchannel} -setup {
test chan-io-24.1 {Tcl_GetChannelType} {testchannel} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    testchannel type $f
    set t [testchannel type $f]
} -cleanup {
    chan close $f
    string compare $t file
} -result "file"
} 0

test chan-io-25.1 {Tcl_GetChannelHandle, input} -setup {
test chan-io-25.1 {Tcl_GetChannelHandle, input} {testchannel} {
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f "1234567890\n098765432"
    chan close $f
    set f [open $path(test1) r]
    chan gets $f
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [chan tell $f]
} -cleanup {
    chan close $f
    set l
} -result {10 11}
test chan-io-25.2 {Tcl_GetChannelHandle, output} -setup {
} {10 11}
test chan-io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [chan tell $f]
    chan flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [chan tell $f]
} -cleanup {
    chan close $f
    file delete $path(test1)
    set l
} -result {6 6 0 6}
} {6 6 0 6}

test chan-io-26.1 {Tcl_GetChannelInstanceData} -body {
test chan-io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
    # "pid" command uses Tcl_GetChannelInstanceData
    # Don't care what pid is (but must be a number), just want to exercise it.
    set f [openpipe r << exit]
    pid $f

    set f [open "|[list [interpreter] << exit]"]
    expr [pid $f]
} -constraints stdio -cleanup {
    chan close $f
} -match regexp -result {^\d+$}
} {}

# Test flushing. The functions tested here are FlushChannel.

test chan-io-27.1 {FlushChannel, no output buffered} -setup {
test chan-io-27.1 {FlushChannel, no output buffered} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan flush $f
    file size $path(test1)
    set s [file size $path(test1)]
} -cleanup {
    chan close $f
    set s
} -result 0
test chan-io-27.2 {FlushChannel, some output buffered} -setup {
} 0
test chan-io-27.2 {FlushChannel, some output buffered} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    set l ""
    chan puts $f hello
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [file size $path(test1)]
    chan close $f
    lappend l [file size $path(test1)]
    set l
} -result {0 6 6}
test chan-io-27.3 {FlushChannel, implicit flush on chan close} -setup {
} {0 6 6}
test chan-io-27.3 {FlushChannel, implicit flush on chan close} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    set l ""
    chan puts $f hello
    lappend l [file size $path(test1)]
    chan close $f
    lappend l [file size $path(test1)]
    set l
} -result {0 6}
test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} -setup {
} {0 6}
test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan configure $f -buffersize 60
    set l ""
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	chan puts $f hello
    }
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
    set l
} -result {0 60 72}
test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup {
} {0 60 72}
test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} \
	{unixOrWin} {
    file delete $path(test1)
    set l ""
} -constraints {unixOrWin} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffersize 60 -eofchar {}
    set l ""
    lappend l [file size $path(test1)]
    for {set i 0} {$i < 12} {incr i} {
	chan puts $f hello
    }
    lappend l [file size $path(test1)]
    chan close $f
    lappend l [file size $path(test1)]
    set l
} -result {0 60 72}
} {0 60 72}
set path(pipe)   [makeFile {} pipe]
set path(output) [makeFile {} output]
test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup {
test chan-io-27.6 {FlushChannel, async flushing, async chan close} \
	{stdio asyncPipeChan Close openpipe} {
    file delete $path(pipe)
    file delete $path(output)
} -constraints {stdio asyncPipeChan Close} -body {
    set f [open $path(pipe) w]
    chan puts $f "set f \[[list open $path(output) w]]"
    chan puts $f {
	chan configure $f -translation lf -buffering none -eofchar {}
	while {![chan eof stdin]} {
	    after 20
	    chan puts -nonewline $f [chan read stdin 1024]
	}
	chan close $f
    }
    chan close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open $path(output) w]
    chan close $f
    set f [openpipe w $path(pipe)]
    set f [open "|[list [interpreter] $path(pipe)]" w]
    chan configure $f -blocking off
    chan puts -nonewline $f $x
    chan close $f
    set counter 0
    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
        set result "file size only [file size $path(output)]"
    } else {
        set result ok
    }
} -result ok
} ok

# Tests closing a channel. The functions tested are Chan CloseChannel and
# Tests closing a channel. The functions tested are Chan CloseChannel and Tcl_Chan Close.
# Tcl_Chan Close.

test chan-io-28.1 {Chan CloseChannel called when all references are dropped} -setup {
test chan-io-28.1 {Chan CloseChannel called when all references are dropped} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    interp create x
    interp share "" $f x
    set l ""
    lappend l [testchannel refcount $f]
    x eval chan close $f
    interp delete x
    lappend l [testchannel refcount $f]
} -cleanup {
    chan close $f
    set l
} -result {2 1}
test chan-io-28.2 {Chan CloseChannel called when all references are dropped} -setup {
} {2 1}
test chan-io-28.2 {Chan CloseChannel called when all references are dropped} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    interp create x
    interp share "" $f x
    chan puts -nonewline $f abc
    chan close $f
    x eval chan puts $f def
    x eval chan close $f
    interp delete x
    set f [open $path(test1) r]
    chan gets $f
    set l [chan gets $f]
} -cleanup {
    chan close $f
    set l
} -result abcdef
test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} -setup {
} abcdef
test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} \
	{stdio asyncPipeChan Close nonPortable openpipe} {
    file delete $path(pipe)
    file delete $path(output)
} -constraints {stdio asyncPipeChan Close nonPortable} -body {
    set f [open $path(pipe) w]
    chan puts $f {

	# Need to not have eof char appended on chan close, because the other
	# side of the pipe already chan closed, so that writing would cause an
	# error "invalid file".

	chan configure stdout -eofchar {}
	chan configure stderr -eofchar {}

	set f [open $path(output) w]
	chan configure $f -translation lf -buffering none
	for {set x 0} {$x < 20} {incr x} {
	    after 20
	    chan puts -nonewline $f [chan read stdin 1024]
	}
	chan close $f
    }
    chan close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
        set x "$x$x"
    }
    set f [open $path(output) w]
    chan close $f
    set f [openpipe r+ $path(pipe)]
    set f [open "|[list [interpreter] pipe]" r+]
    chan configure $f -blocking off -eofchar {}

    chan puts -nonewline $f $x
    chan close $f
    set counter 0
    while {([file size $path(output)] < 20480) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
        set result probably_broken
    } else {
        set result ok
    }
} -result ok
test chan-io-28.4 {Tcl_Chan Close} -constraints {testchannel} -setup {
} ok
test chan-io-28.4 {Tcl_Chan Close} {testchannel} {
    file delete $path(test1)
    set l ""
} -body {
    lappend l [lsort [testchannel open]]
    set f [open $path(test1) w]
    lappend l [lsort [testchannel open]]
    chan close $f
    lappend l [lsort [testchannel open]]
    set x [list $consoleFileNames \
		[lsort [list {*}$consoleFileNames $f]] \
		$consoleFileNames]
    expr {$l eq $x ? "ok" : "{$l} != {$x}"}
} -result ok
test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
    string compare $l $x
} 0
test chan-io-28.5 {Tcl_Chan Close vs standard handles} {stdio unix testchannel openpipe} {
    file delete $path(script)
} -constraints {stdio unix testchannel} -body {
    set f [open $path(script) w]
    chan puts $f {
	chan close stdin
	chan puts [testchannel open]
    }
    chan close $f
    set f [openpipe r $path(script)]
    set f [open "|[list [interpreter] $path(script)]" r]
    set l [chan gets $f]
    chan close $f
    lsort $l
} -result {file1 file2}
    set l
} {file1 file2}
test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} -setup {
    set cat [makeFile {
	fconfigure stdout -buffering line
	while {[gets stdin line] >= 0} {puts $line}
	puts DONE
	exit 0
    } cat.tcl]
    variable done
} -body {
    set ff [openpipe r+ $cat]
    puts $ff Hey
    close $ff w
    set timer [after 1000 [namespace code {set done Failed}]]
    set acc {}
    fileevent $ff readable [namespace code {
	if {[gets $ff line] < 0} {
	    set done Succeeded
	} else {
	    lappend acc $line
	}

    }]
    vwait [namespace which -variable done]
    after cancel $timer
    close $ff r
    list $done $acc
} -cleanup {
    removeFile cat.tcl
} -result {Succeeded {Hey DONE}}
test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup {
    set echo [makeFile {
	proc accept {s args} {set ::sok $s}
	set s [socket -server accept 0]
	puts [lindex [fconfigure $s -sockname] 2]
	flush stdout
	vwait ::sok
	fconfigure $sok -buffering line
	while {[gets $sok line]>=0} {puts $sok $line}
	puts $sok DONE
	exit 0
    } echo.tcl]
    variable done
    unset -nocomplain done
    set done ""
    set timer ""
    set ff [openpipe r $echo]
    gets $ff port
} -body {
    set s [socket 127.0.0.1 $port]
    puts $s Hey
    close $s w
    set timer [after 1000 [namespace code {set done Failed}]]
    set acc {}
    fileevent $s readable [namespace code {
	if {[gets $s line]<0} {
	    set done Succeeded
	} else {
	    lappend acc $line
	}
    }]
    vwait [namespace which -variable done]
    list $done $acc
} -cleanup {
    catch {close $s}
    close $ff
    after cancel $timer
    removeFile echo.tcl
} -result {Succeeded {Hey DONE}}

test chan-io-29.1 {Tcl_WriteChars, channel not writable} -body {
    chan puts stdin hello
} -returnCodes error -result {channel "stdin" wasn't opened for writing}
test chan-io-29.2 {Tcl_WriteChars, empty string} -setup {
test chan-io-29.1 {Tcl_WriteChars, channel not writable} {
    list [catch {chan puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test chan-io-29.2 {Tcl_WriteChars, empty string} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -eofchar {}
    chan puts -nonewline $f ""
    chan close $f
    file size $path(test1)
} -result 0
test chan-io-29.3 {Tcl_WriteChars, nonempty string} -setup {
} 0
test chan-io-29.3 {Tcl_WriteChars, nonempty string} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -eofchar {}
    chan puts -nonewline $f hello
    chan close $f
    file size $path(test1)
} -result 5
test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} -setup {
} 5
test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering full -eofchar {}
    chan puts $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
    set l
} -result {6 0 0 6}
test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} -setup {
} {6 0 0 6}
test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering line -eofchar {}
    chan puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
    set l
} -result {5 0 0 11}
test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} -setup {
} {5 0 0 11}
test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering none -eofchar {}
    chan puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
    set l
} -result {0 5 0 11}
test chan-io-29.7 {Tcl_Flush, full buffering} -setup {
} {0 5 0 11}
test chan-io-29.7 {Tcl_Flush, full buffering} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering full -eofchar {}
    chan puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
    set l
} -result {5 0 11 0 0 11}
test chan-io-29.8 {Tcl_Flush, full buffering} -setup {
} {5 0 11 0 0 11}
test chan-io-29.8 {Tcl_Flush, full buffering} {testchannel} {
    file delete $path(test1)
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -buffering line
    chan puts -nonewline $f hello
    set l ""
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan puts $f hello
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
    chan flush $f
    lappend l [testchannel outputbuffered $f]
    lappend l [file size $path(test1)]
} -cleanup {
    chan close $f
    set l
} -result {5 0 0 5 0 11 0 11}
test chan-io-29.9 {Tcl_Flush, channel not writable} -body {
    chan flush stdin
} -returnCodes error -result {channel "stdin" wasn't opened for writing}
test chan-io-29.10 {Tcl_WriteChars, looping and buffering} -setup {
} {5 0 0 5 0 11 0 11}
test chan-io-29.9 {Tcl_Flush, channel not writable} {
    list [catch {chan flush stdin} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test chan-io-29.10 {Tcl_WriteChars, looping and buffering} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    set f2 [open $path(longfile) r]
    for {set x 0} {$x < 10} {incr x} {
	chan puts $f1 [chan gets $f2]
    }
    chan close $f2
    chan close $f1
    file size $path(test1)
} -result 387
test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup {
} 387
test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -eofchar {}
    set f2 [open $path(longfile) r]
    for {set x 0} {$x < 10} {incr x} {
	chan puts -nonewline $f1 [chan gets $f2]
    }
    chan close $f1
    chan close $f2
    file size $path(test1)
} -result 377
test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
} 377
test chan-io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
    file delete $path(test1)
    file delete $path(pipe)
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 "set f1 \[[list open $path(longfile) r]]"
    chan puts $f1 {
	for {set x 0} {$x < 10} {incr x} {
	    chan puts [chan gets $f1]
	}
    }
    chan close $f1
    set f1 [openpipe r $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r]
    set f2 [open $path(longfile) r]
    set y ok
    for {set x 0} {$x < 10} {incr x} {
	set l1 [chan gets $f1]
	set l2 [chan gets $f2]
	if {$l1 ne $l2} {
	    set y broken:$x
	if {"$l1" != "$l2"} {
	    set y broken
	}
    }
    return $y
} -cleanup {
    chan close $f1
    chan close $f2
} -result ok
test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} -setup {
    set y
} ok
test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
    file delete $path(test1)
    file delete $path(pipe)
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {
	chan puts [chan gets stdin]
	chan puts [chan gets stdin]
    }
    chan close $f1
    set y ok
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan configure $f1 -buffering line
    set f2 [open $path(longfile) r]
    set line [chan gets $f2]
    chan puts $f1 $line
    set backline [chan gets $f1]
    if {$line ne $backline} {
	set y broken1
    if {"$line" != "$backline"} {
	set y broken
    }
    set line [chan gets $f2]
    chan puts $f1 $line
    set backline [chan gets $f1]
    if {$line ne $backline} {
	set y broken2
    if {"$line" != "$backline"} {
	set y broken
    }
    return $y
} -cleanup {
    chan close $f1
    chan close $f2
} -result ok
test chan-io-29.14 {Tcl_WriteChars, buffering and implicit flush at chan close} -setup {
    set y
} ok
test chan-io-29.14 {Tcl_WriteChars, buffering and implicit flush at chan close} {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan puts -nonewline $f "Text1"
    chan puts -nonewline $f " Text 2"
    chan puts $f " Text 3"
    chan close $f
    set f [open $path(test3) r]
    chan gets $f
    set x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result {Text1 Text 2 Text 3}
test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup {
} {Text1 Text 2 Text 3}
test chan-io-29.15 {Tcl_Flush, channel not open for writing} {
    file delete $path(test1)
    set fd [open $path(test1) w]
    chan close $fd
} -body {
    set fd [open $path(test1) r]
    chan flush $fd
    set x [list [catch {chan flush $fd} msg] $msg]
} -returnCodes error -cleanup {
    catch {chan close $fd}
} -match glob -result {channel "*" wasn't opened for writing}
test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} -setup {
    set fd [openpipe r cat longfile]
    chan close $fd
    string compare $x \
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {
    set fd [open "|[list [interpreter] cat longfile]" r]
} -constraints stdio -body {
    chan flush $fd
    set x [list [catch {chan flush $fd} msg] $msg]
} -returnCodes error -cleanup {
    catch {chan close $fd}
    string compare $x \
} -match glob -result {channel "*" wasn't opened for writing}
test chan-io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} -setup {
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test chan-io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 hello
    chan puts $f1 hello
    chan puts $f1 hello
    chan flush $f1
    file size $path(test1)
    set x [file size $path(test1)]
} -cleanup {
    chan close $f1
} -result 18
test chan-io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} -setup {
    set x
} 18
test chan-io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {
    file delete $path(test1)
    set x ""
    set f1 [open $path(test1) w]
} -body {
    chan configure $f1 -translation lf
    chan puts $f1 hello
    chan puts $f1 hello
    chan puts $f1 hello
    chan flush $f1
    lappend x [file size $path(test1)]
    chan puts $f1 hello
    chan flush $f1
    lappend x [file size $path(test1)]
    chan puts $f1 hello
    chan flush $f1
    lappend x [file size $path(test1)]
} -cleanup {
    chan close $f1
    set x
} -result {18 24 30}
test chan-io-29.19 {Explicit and implicit flushes} -setup {
} {18 24 30}
test chan-io-29.19 {Explicit and implicit flushes} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    set x ""
    chan puts $f1 hello
    chan puts $f1 hello
    chan puts $f1 hello
    chan flush $f1
    lappend x [file size $path(test1)]
    chan puts $f1 hello
    chan flush $f1
    lappend x [file size $path(test1)]
    chan puts $f1 hello
    chan close $f1
    lappend x [file size $path(test1)]
    set x
} -result {18 24 30}
test chan-io-29.20 {Implicit flush when buffer is full} -setup {
} {18 24 30}
test chan-io-29.20 {Implicit flush when buffer is full} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    for {set x 0} {$x < 100} {incr x} {
      chan puts $f1 $line
    }
    set z ""
    lappend z [file size $path(test1)]
    for {set x 0} {$x < 100} {incr x} {
	chan puts $f1 $line
    }
    lappend z [file size $path(test1)]
    chan close $f1
    lappend z [file size $path(test1)]
    set z
} -result {4096 12288 12600}
test chan-io-29.21 {Tcl_Flush to pipe} -setup {
} {4096 12288 12600}
test chan-io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
    file delete $path(pipe)
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {set x [chan read stdin 6]}
    chan puts $f1 {set cnt [string length $x]}
    chan puts $f1 {chan puts "read $cnt characters"}
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan puts $f1 hello
    chan flush $f1
    chan gets $f1
    set x [chan gets $f1]
} -cleanup {
    catch {chan close $f1}
    set x
} -result "read 6 characters"
test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
} "read 6 characters"
test chan-io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
    file delete $path(pipe)
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {
	chan configure stdout -buffering full
	chan puts hello
	chan puts hello
	chan flush stdout
	chan gets stdin
	chan puts bye
	chan flush stdout
    }
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    set x ""
    lappend x [chan gets $f1]
    lappend x [chan gets $f1]
    chan puts $f1 hello
    chan flush $f1
    lappend x [chan gets $f1]
} -cleanup {
    chan close $f1
    set x
} -result {hello hello bye}
test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} -setup {
} {hello hello bye}
test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} {
    file delete $path(pipe)
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {
	chan puts hello
	chan puts hello
	chan gets stdin
	chan puts bye
    }
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    set x ""
    lappend x [chan gets $f1]
    lappend x [chan gets $f1]
    chan puts $f1 hello
    chan flush $f1
    lappend x [chan gets $f1]
} -cleanup {
    chan close $f1
    set x
} -result {hello hello bye}
test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup {
} {hello hello bye}
test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
    variable x {}
} -body {
    set f [open $path(test3) w]
    chan puts $f "Line 1"
    chan puts $f "Line 2"
    set f2 [open $path(test3)]
    set x {}
    lappend x [chan read -nonewline $f2]
    chan close $f2
    chan flush $f
    set f2 [open $path(test3)]
    lappend x [chan read -nonewline $f2]
} -cleanup {
    chan close $f2
    chan close $f
    set x
} -result "{} {Line 1\nLine 2}"
test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
} "{} {Line 1\nLine 2}"
test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} {
    file delete $path(test3)
} -constraints {stdio fileevent} -body {
    set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)]
    set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w]
    chan puts $f "Line 1"
    chan puts $f "Line 2"
    chan close $f
    after 100
    set f [open $path(test3) r]
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "Line 1\nLine 2\n"
test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs} -body {
} "Line 1\nLine 2\n"
test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} {
    set f [open "|[list cat -u]" r+]
    chan puts $f "Line1"
    chan flush $f
    chan gets $f
    set x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result {Line1}
test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup {
} {Line1}
test chan-io-29.27 {Tcl_Flush on chan closed pipeline} {stdio openpipe} {
    file delete $path(pipe)
    set f [open $path(pipe) w]
    chan puts $f {exit}
    chan close $f
} -constraints stdio -body {
    set f [openpipe r+ $path(pipe)]
    set f [open "|[list [interpreter] $path(pipe)]" r+]
    chan gets $f
    chan puts $f output
    after 50
    #
    # The flush below will get a SIGPIPE. This is an expected part of the test
    # and indicates that the test operates correctly. If you run this test
    # under a debugger, the signal will by intercepted unless you disable the
    # debugger's signal interception.
    # The flush below will get a SIGPIPE. This is an expected part of
    # test and indicates that the test operates correctly. If you run
    # this test under a debugger, the signal will by intercepted unless
    # you disable the debugger's signal interception.
    #
    if {[catch {chan flush $f} msg]} {
	set x [list 1 $msg $::errorCode]
	catch {chan close $f}
    } else {
    } elseif {[catch {chan close $f} msg]} {
	set x [list 1 $msg $::errorCode]
    } else {
	set x {this was supposed to fail and did not}
    }
	if {[catch {chan close $f} msg]} {
	    set x [list 1 $msg $::errorCode]
	} else {
	    set x {this was supposed to fail and did not}
	}
    }
    regsub {".*":} $x {"":} x
    string tolower $x
} -match glob -result {1 {error flushing "*": broken pipe} {posix epipe {broken pipe}}}
test chan-io-29.28 {Tcl_WriteChars, lf mode} -setup {
} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
test chan-io-29.28 {Tcl_WriteChars, lf mode} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f hello\nthere\nand\nhere
    chan flush $f
    file size $path(test1)
    set s [file size $path(test1)]
} -cleanup {
    chan close $f
} -result 21
test chan-io-29.29 {Tcl_WriteChars, cr mode} -setup {
    set s
} 21
test chan-io-29.29 {Tcl_WriteChars, cr mode} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    file size $path(test1)
} -result 21
test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup {
} 21
test chan-io-29.30 {Tcl_WriteChars, crlf mode} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    file size $path(test1)
} -result 25
test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
} 25
test chan-io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
    file delete $path(pipe)
    file delete $path(output)
} -constraints stdio -body {
    set f [open $path(pipe) w]
    chan puts $f "set f \[[list open $path(output)  w]]"
    chan puts $f {chan configure $f -translation lf}
    set x [list while {![chan eof stdin]}]
    set x "$x {"
    chan puts $f $x
    chan puts $f {  chan puts -nonewline $f [chan read stdin 4096]}
    chan puts $f {  chan flush $f}
    chan puts $f "}"
    chan puts $f {chan close $f}
    chan close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
	set x "$x$x"
    }
    set f [open $path(output) w]
    chan close $f
    set f [openpipe r+ $path(pipe)]
    set f [open "|[list [interpreter] $path(pipe)]" r+]
    chan configure $f -blocking off
    chan puts -nonewline $f $x
    chan close $f
    set counter 0
    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
	after 10 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
	set result "file size only [file size $path(output)]"
    } else {
	set result ok
    }
    # allow a little time for the background process to chan close.
    # otherwise, the following test fails on the [file delete $path(output)]
    # otherwise, the following test fails on the [file delete $path(output)
    # on Windows because a process still has the file open.
    after 100 set v 1; vwait v
    return $result
} -result ok
test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup {
    set result
} ok
test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} \
	{stdio asyncPipeChan Close openpipe} {
    file delete $path(pipe)
    file delete $path(output)
} -constraints {stdio asyncPipeChan Close} -body {
    set f [open $path(pipe) w]
    chan puts $f "set f \[[list open $path(output) w]]"
    chan puts $f {chan configure $f -translation lf}
    set x [list while {![chan eof stdin]}]
    set x "$x \{"
    chan puts $f $x
    chan puts $f {  after 20}
    chan puts $f {  chan puts -nonewline $f [chan read stdin 1024]}
    chan puts $f {  chan flush $f}
    chan puts $f "\}"
    chan puts $f {chan close $f}
    chan close $f
    set x 01234567890123456789012345678901
    for {set i 0} {$i < 11} {incr i} {
	set x "$x$x"
    }
    set f [open $path(output) w]
    chan close $f
    set f [openpipe r+ $path(pipe)]
    set f [open "|[list [interpreter] $path(pipe)]" r+]
    chan configure $f -blocking off
    chan puts -nonewline $f $x
    chan close $f
    set counter 0
    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
	after 20 [list incr [namespace which -variable counter]]
	vwait [namespace which -variable counter]
    }
    if {$counter == 1000} {
	set result "file size only [file size $path(output)]"
    } else {
	set result ok
    }
} -result ok
} ok
test chan-io-29.33 {Tcl_Flush, implicit flush on exit} -setup {
    set f [open $path(script) w]
    chan puts $f "set f \[[list open $path(test1) w]]"
    chan puts $f {chan configure $f -translation lf
	chan puts $f hello
	chan puts $f bye
	chan puts $f strange
2820
2821
2822
2823
2824
2825
2826
2827




2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751
2752



2753
2754
2755
2756
2757
2758
2759







-
+
+
+
+


-
-
-







    chan configure $cs -blocking off
    writelots $cs $l
    chan close $cs
    chan close $ss
    vwait [namespace which -variable x]
    set c
} -result 2000
test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} -setup {
test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} {socket tempNotMac fileevent} {
    # On Mac, this test screws up sockets such that subsequent tests using port 2828
    # either cause errors or panic().

    catch {interp delete x}
    catch {interp delete y}
} -constraints {socket tempNotMac fileevent} -body {
    # On Mac, this test screws up sockets such that subsequent tests using
    # port 2828 either cause errors or panic().
    interp create x
    interp create y
    set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    proc accept {s a p} {
	chan puts $s hello
	chan close $s
    }
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802

3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893

3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906

3907
3908
3909
3910
3911
3912
3913


3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926

3927
3928
3929
3930
3931
3932

3933
3934
3935
3936
3937
3938



3939
3940
3941
3942

3943
3944
3945

3946
3947

3948
3949


3950
3951
3952



3953

3954
3955


3956
3957
3958
3959



3960

3961

3962
3963
3964
3965
3966
3967
3968
3969
3970

3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982

3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995

3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007

4008
4009
4010
4011

4012
4013
4014
4015
4016
4017

4018
4019
4020

4021
4022

4023
4024


4025
4026

4027
4028
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
2777
2778
2779
2780
2781
2782
2783

2784
2785
2786

2787
2788
2789
2790

2791
2792

2793
2794
2795
2796
2797
2798

2799

2800
2801


2802
2803
2804

2805
2806
2807
2808
2809
2810

2811

2812
2813


2814
2815
2816

2817
2818
2819
2820
2821
2822

2823

2824
2825


2826
2827
2828

2829
2830
2831
2832
2833
2834

2835

2836
2837


2838
2839
2840

2841
2842
2843
2844
2845
2846

2847

2848
2849


2850
2851
2852

2853
2854
2855
2856
2857
2858

2859

2860
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
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

3775




3776

























































































































































































































3777



























































































3778
3779


3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795


3796
3797
3798


3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814

3815
3816
3817
3818



3819
3820
3821
3822
3823
3824

3825
3826


3827

3828
3829


3830
3831
3832


3833
3834
3835
3836
3837


3838
3839
3840
3841


3842
3843
3844
3845
3846

3847
3848
3849
3850
3851
3852
3853
3854
3855

3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867

3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880

3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892

3893
3894
3895
3896

3897
3898

3899
3900
3901

3902
3903
3904

3905

3906
3907


3908
3909
3910

3911


3912
3913
3914

3915
3916
3917
3918
3919
3920
3921
3922

3923
3924

3925
3926
3927

3928
3929

3930
3931
3932
3933
3934

3935

3936
3937

3938
3939

3940
3941

3942
3943
3944
3945
3946
3947


3948
3949

3950
3951

3952
3953

3954
3955
3956
3957
3958

3959

3960
3961

3962
3963
3964

3965
3966

3967
3968
3969
3970
3971

3972

3973
3974

3975
3976
3977

3978
3979

3980
3981
3982
3983
3984

3985

3986
3987

3988
3989
3990
3991
3992

3993
3994

3995
3996

3997
3998
3999


4000
4001
4002
4003
4004
4005

4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018

4019
4020

4021
4022
4023

4024
4025
4026

4027

4028
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







-



-
+



-
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-





+
-
+
-

+
-
+




-
+

-





+
-
+
-

+
-
+




-
+

-





+
-
+
-

+
-
+




-
+

-










-
+
-

+
-
-
+
+

-










-
+
-

+
-
-
+
+

-






-
+
-

+
-
+




-
+

-






-
+
-

+
-
+




-
+

-






-
+
-

+
-
+




-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-

+
-
-
+
+

-


-
+










+
+
+
+
+
+
+
+
+
+
+
+
+

+

+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
-
-
+
+

+
+
+
+
+
+
+

+
+
+
+
+
+
+
-
+
+
+

-
-
+
+
+


-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-

-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-










+





-
-
+
+

-
-










+





-
+



-
-
-
+
+
+



-
+

-
-
+
-

+
-
-
+
+

-
-
+
+
+

+
-
-
+
+


-
-
+
+
+

+
-
+








-
+











-
+












-
+











-
+



-
+

-



-
+


-
+
-

+
-
-
+
+

-
+
-
-



-
+


+




-

+
-
+


-
+

-





-
+
-

+
-
+

-
+

-






-
-

+
-
+

-
+

-





-
+
-

+
-
+


-
+

-





-
+
-

+
-
+


-
+

-





-
+
-

+
-
+




-
+

-

+
-
+


-
-
+
+
+
+
+

-
+
+











-
+

-



-
+


-
+
-

+
-
-
+
+
+
+
+
+

-








-
+
-

+
-
-
+
+
-
-
-
-
-
-
-
-




-
-
+
+

-
-




+






-

+
-
-
+
+





-
-

+
-
+
-

+
-
+







	    }
	}
    }
    x eval "chan event $c readable \{readit $c\}"
    y eval "chan event $c readable \{readit $c\}"
    y eval [list chan close $c]
    update
} -cleanup {
    chan close $s
    interp delete x
    interp delete y
} -result ""
} ""

# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.

test chan-io-30.1 {Tcl_Write lf, Tcl_Read lf} -setup {
test chan-io-30.1 {Tcl_Write lf, Tcl_Read lf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\nthere\nand\nhere\n"
test chan-io-30.2 {Tcl_Write lf, Tcl_Read cr} -setup {
} "hello\nthere\nand\nhere\n"
test chan-io-30.2 {Tcl_Write lf, Tcl_Read cr} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\nthere\nand\nhere\n"
test chan-io-30.3 {Tcl_Write lf, Tcl_Read crlf} -setup {
} "hello\nthere\nand\nhere\n"
test chan-io-30.3 {Tcl_Write lf, Tcl_Read crlf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\nthere\nand\nhere\n"
test chan-io-30.4 {Tcl_Write cr, Tcl_Read cr} -setup {
} "hello\nthere\nand\nhere\n"
test chan-io-30.4 {Tcl_Write cr, Tcl_Read cr} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\nthere\nand\nhere\n"
test chan-io-30.5 {Tcl_Write cr, Tcl_Read lf} -setup {
} "hello\nthere\nand\nhere\n"
test chan-io-30.5 {Tcl_Write cr, Tcl_Read lf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\rthere\rand\rhere\r"
test chan-io-30.6 {Tcl_Write cr, Tcl_Read crlf} -setup {
} "hello\rthere\rand\rhere\r"
test chan-io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\rthere\rand\rhere\r"
test chan-io-30.7 {Tcl_Write crlf, Tcl_Read crlf} -setup {
} "hello\rthere\rand\rhere\r"
test chan-io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\nthere\nand\nhere\n"
test chan-io-30.8 {Tcl_Write crlf, Tcl_Read lf} -setup {
} "hello\nthere\nand\nhere\n"
test chan-io-30.8 {Tcl_Write crlf, Tcl_Read lf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\r\nthere\r\nand\r\nhere\r\n"
test chan-io-30.9 {Tcl_Write crlf, Tcl_Read cr} -setup {
} "hello\r\nthere\r\nand\r\nhere\r\n"
test chan-io-30.9 {Tcl_Write crlf, Tcl_Read cr} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result "hello\n\nthere\n\nand\n\nhere\n\n"
test chan-io-30.10 {Tcl_Write lf, Tcl_Read auto} -setup {
} "hello\n\nthere\n\nand\n\nhere\n\n"
test chan-io-30.10 {Tcl_Write lf, Tcl_Read auto} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    set c [chan read $f]
    list [chan read $f] [chan configure $f -translation]
    set x [chan configure $f -translation]
} -cleanup {
    chan close $f
    list $c $x
} -result {{hello
} {{hello
there
and
here
} auto}
test chan-io-30.11 {Tcl_Write cr, Tcl_Read auto} -setup {
test chan-io-30.11 {Tcl_Write cr, Tcl_Read auto} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    set c [chan read $f]
    list [chan read $f] [chan configure $f -translation]
    set x [chan configure $f -translation]
} -cleanup {
    chan close $f
    list $c $x
} -result {{hello
} {{hello
there
and
here
} auto}
test chan-io-30.12 {Tcl_Write crlf, Tcl_Read auto} -setup {
test chan-io-30.12 {Tcl_Write crlf, Tcl_Read auto} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    set c [chan read $f]
    list [chan read $f] [chan configure $f -translation]
    set x [chan configure $f -translation]
} -cleanup {
    chan close $f
    list $c $x
} -result {{hello
} {{hello
there
and
here
} auto}
test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} -setup {
test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	chan puts $f $line
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    string length [chan read $f]
    set c [chan read $f]
} -cleanup {
    chan close $f
    string length $c
} -result [expr 700*15+1]
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
} [expr 700*15+1]
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	chan puts $f $line
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    string length [chan read $f]
    set c [chan read $f]
} -cleanup {
    chan close $f
    string length $c
} -result [expr 700*15+1]
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
} [expr 700*15+1]
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    chan read $f
    set c [chan read $f]
} -cleanup {
    chan close $f
    set c
} -result {hello
} {hello
there
and
here
}
test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup {
test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f hello\nthere\nand\rhere\n\x1a
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan read $f
    set c [chan read $f]
} -cleanup {
    chan close $f
    set c
} -result {hello
} {hello
there
and
here
}
test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup {
test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} {
    file delete $path(test1)
} -constraints {win} -body {
    set f [open $path(test1) w]
    chan configure $f -eofchar \x1a -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan read $f
    set c [chan read $f]
} -cleanup {
    chan close $f
    set c
} -result {hello
} {hello
there
and
here
}
test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup {
test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
} -body {
    set l
} {abc def 0 {} 1 {} 1}
test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {abc def 0 {} 1 {} 1}
test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar {}
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} "abc def 0 \x1aghi 0 qrs 0 {} 1"
test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar {}
    set l ""
    set x [chan gets $f]
    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {0 1 {} 1}
test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar {}
    set l ""
    set x [chan gets $f]
    lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {0 1 {} 1}
test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    set c [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $e
} {8 1}
test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    set c [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $e
} {8 1}
test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    set c [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $e
} {8 1}
test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1a
    set c [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $e
} {8 1}
test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    set c [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $e
} {8 1}
test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1a
    set c [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $e
} {8 1}

# Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.

test chan-io-31.1 {Tcl_Write lf, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    chan close $f
    set l
} {hello 6 auto there 12 auto}
test chan-io-31.2 {Tcl_Write cr, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    chan close $f
    set l
} {hello 6 auto there 12 auto}
test chan-io-31.3 {Tcl_Write crlf, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    chan close $f
    set l
} {hello 7 auto there 14 auto}
test chan-io-31.4 {Tcl_Write lf, Tcl_Gets lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    set l ""
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    chan close $f
    set l
} {hello 6 lf there 12 lf}
test chan-io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    set l ""
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {21 21 cr 1 {} 21 cr 1}
test chan-io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    set l ""
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {21 21 crlf 1 {} 21 crlf 1}
test chan-io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    set l ""
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello 6 cr 0 there 12 cr 0}
test chan-io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    set l ""
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {21 21 lf 1 {} 21 lf 1}
test chan-io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    set l ""
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {21 21 crlf 1 {} 21 crlf 1}
test chan-io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    set l ""
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello 7 crlf 0 there 14 crlf 0}
test chan-io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    set l ""
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello 6 cr 0 6 13 cr 0}
test chan-io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    set l ""
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    chan close $f
    set l
} {6 7 lf 0 6 14 lf 0}
test chan-io-31.13 {binary mode is synonym of lf mode} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation binary
    set x [chan configure $f -translation]
    chan close $f
    set x
} lf
#
# Test chan-io-9.14 has been removed because "auto" output translation mode is
# not supoprted.
#
test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\rand\r\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello there and here 0 {} 1}
test chan-io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f hello\nthere\rand\r\nhere\r
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello there and here 0 {} 1}
test chan-io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f hello\nthere\rand\r\nhere\n
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello there and here 0 {} 1}
test chan-io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f hello\nthere\rand\r\nhere\r\n
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello there and here 0 {} 1}
test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set s [format "hello\nthere\nand\rhere\n\%c" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello there and here 0 {} 1}
test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -eofchar \x1a -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {hello there and here 0 {} 1}
test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a
    chan configure $f -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result {abc def 0 {} 1 {} 1}
test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup {
} {abc def 0 {} 1}
test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set s [format "abc\ndef\n%cghi\nqrs" 26]
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {abc def 0 {} 1}
test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar {}
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar {}
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar {}
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} -result {abc def 0 {} 1 {} 1}
test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup {
} {abc def 0 {} 1}
test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} -body {
} {abc def 0 {} 1}
test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
    chan configure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar {}
    chan configure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {abc def 0 {} 1}
test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1a
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    chan close $f
    set l
} {abc def 0 {} 1}
test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    set l ""
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result "abc def 0 \x1aghi 0 qrs 0 {} 1"
test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
    file delete $path(test1)
    set l ""
    set l
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar {}
    set x [chan gets $f]
    lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {1 1 {} 1}
} {abc def 0 {} 1}
test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar {}
    set x [chan gets $f]
    lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {1 1 {} 1}
test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format abc\ndef\n%cqrs\ntuv 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {8 1}
test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    list [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {8 1}
test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {8 1}
test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1a
    list [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {8 1}
test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup {
test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    chan configure $f -translation crlf -eofchar {}
    list [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {8 1}
test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set c [format abc\ndef\n%cqrs\ntuv 26]
    set s [format "abc\ndef\n%cqrs\ntuv" 26]
    chan puts $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1a
    list [string length [chan read $f]] [chan eof $f]
} -cleanup {
    chan close $f
} -result {8 1}

# Test end of line translations. Functions tested are Tcl_Write and
# Tcl_Gets.

test chan-io-31.1 {Tcl_Write lf, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
} -cleanup {
    chan close $f
} -result {hello 6 auto there 12 auto}
test chan-io-31.2 {Tcl_Write cr, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
} -cleanup {
    chan close $f
} -result {hello 6 auto there 12 auto}
test chan-io-31.3 {Tcl_Write crlf, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
} -cleanup {
    chan close $f
} -result {hello 7 auto there 14 auto}
test chan-io-31.4 {Tcl_Write lf, Tcl_Gets lf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
} -cleanup {
    chan close $f
} -result {hello 6 lf there 12 lf}
test chan-io-31.5 {Tcl_Write lf, Tcl_Gets cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan puts $f $s
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    chan configure $f -translation crlf -eofchar \x1a
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {21 21 cr 1 {} 21 cr 1}
test chan-io-31.6 {Tcl_Write lf, Tcl_Gets crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {21 21 crlf 1 {} 21 crlf 1}
test chan-io-31.7 {Tcl_Write cr, Tcl_Gets cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello 6 cr 0 there 12 cr 0}
test chan-io-31.8 {Tcl_Write cr, Tcl_Gets lf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {21 21 lf 1 {} 21 lf 1}
test chan-io-31.9 {Tcl_Write cr, Tcl_Gets crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {21 21 crlf 1 {} 21 crlf 1}
test chan-io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello 7 crlf 0 there 14 crlf 0}
test chan-io-31.11 {Tcl_Write crlf, Tcl_Gets cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello 6 cr 0 6 13 cr 0}
test chan-io-31.12 {Tcl_Write crlf, Tcl_Gets lf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts $f hello\nthere\nand\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
    lappend l [string length [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan configure $f -translation]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {6 7 lf 0 6 14 lf 0}
test chan-io-31.13 {binary mode is synonym of lf mode} -setup {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation binary
    chan configure $f -translation
} -cleanup {
    chan close $f
} -result lf
#
# Test chan-io-9.14 has been removed because "auto" output translation mode is
# not supoprted.
#
test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f hello\nthere\rand\r\nhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.15 {Tcl_Write mixed, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
    set l
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f hello\nthere\rand\r\nhere\r
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.16 {Tcl_Write mixed, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f hello\nthere\rand\r\nhere\n
    chan close $f
    set f [open $path(test1) r]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.17 {Tcl_Write mixed, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f hello\nthere\rand\r\nhere\r\n
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -eofchar \x1a -translation lf
    chan puts $f hello\nthere\nand\rhere
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {hello there and here 0 {} 1}
test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a
    chan configure $f -translation auto
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar {}
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar {}
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar {}
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
} {abc def 0 {} 1}
test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1a
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1a
    lappend l [chan gets $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
} -result {abc def 0 {} 1}
test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
    file delete $path(test1)
    set c ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	chan puts $f $line
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf
    set c ""
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr 700*15+1]
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
} [expr 700*15+1]
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
    file delete $path(test1)
    set c ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set line "123456789ABCDE"	;# 14 char plus crlf
    chan puts -nonewline $f x	;# shift crlf across block boundary
    for {set i 0} {$i < 700} {incr i} {
	chan puts $f $line
    }
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto
    set c ""
    while {[chan gets $f line] >= 0} {
	append c $line\n
    }
    chan close $f
    string length $c
} -result [expr 700*15+1]
} [expr 700*15+1]

# Test Tcl_Read and buffering.

test chan-io-32.1 {Tcl_Read, channel not readable} -body {
    read stdout
} -returnCodes error -result {channel "stdout" wasn't opened for reading}
test chan-io-32.1 {Tcl_Read, channel not readable} {
    list [catch {read stdout} msg] $msg
} {1 {channel "stdout" wasn't opened for reading}}
test chan-io-32.2 {Tcl_Read, zero byte count} {
    chan read stdin 0
} ""
test chan-io-32.3 {Tcl_Read, negative byte count} -setup {
test chan-io-32.3 {Tcl_Read, negative byte count} {
    set f [open $path(longfile) r]
} -body {
    chan read $f -1
    set l [list [catch {chan read $f -1} msg] $msg]
} -returnCodes error -cleanup {
    chan close $f
    set l
} -result {expected non-negative integer but got "-1"}
test chan-io-32.4 {Tcl_Read, positive byte count} -body {
} {1 {expected non-negative integer but got "-1"}}
test chan-io-32.4 {Tcl_Read, positive byte count} {
    set f [open $path(longfile) r]
    string length [chan read $f 1024]
} -cleanup {
    set x [chan read $f 1024]
    set s [string length $x]
    unset x
    chan close $f
    set s
} -result 1024
test chan-io-32.5 {Tcl_Read, multiple buffers} -body {
} 1024
test chan-io-32.5 {Tcl_Read, multiple buffers} {
    set f [open $path(longfile) r]
    chan configure $f -buffersize 100
    string length [chan read $f 1024]
} -cleanup {
    set x [chan read $f 1024]
    set s [string length $x]
    unset x
    chan close $f
    set s
} -result 1024
} 1024
test chan-io-32.6 {Tcl_Read, very large read} {
    set f1 [open $path(longfile) r]
    set z [chan read $f1 1000000]
    chan close $f1
    set l [string length $z]
    set x ok
    set z [file size $path(longfile)]
    if {$z != $l} {
	set x "$z != $l"
	set x broken
    }
    set x
} ok
test chan-io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
    set f1 [open $path(longfile) r]
    chan configure $f1 -blocking off
    set z [chan read $f1 20]
    chan close $f1
    set l [string length $z]
    set x ok
    if {$l != 20} {
	set x "$l != 20"
	set x broken
    }
    set x
} ok
test chan-io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
    set f1 [open $path(longfile) r]
    chan configure $f1 -blocking off
    set z [chan read $f1 1000000]
    chan close $f1
    set x ok
    set l [string length $z]
    set z [file size $path(longfile)]
    if {$z != $l} {
	set x "$z != $l"
	set x broken
    }
    set x
} ok
test chan-io-32.9 {Tcl_Read, read to end of file} {
    set f1 [open $path(longfile) r]
    set z [chan read $f1]
    chan close $f1
    set l [string length $z]
    set x ok
    set z [file size $path(longfile)]
    if {$z != $l} {
	set x "$z != $l"
	set x broken
    }
    set x
} ok
test chan-io-32.10 {Tcl_Read from a pipe} -setup {
test chan-io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
    file delete $path(pipe)
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {chan puts [chan gets stdin]}
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan puts $f1 hello
    chan flush $f1
    chan read $f1
    set x [chan read $f1]
} -cleanup {
    chan close $f1
    set x
} -result "hello\n"
test chan-io-32.11 {Tcl_Read from a pipe} -setup {
} "hello\n"
test chan-io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
    file delete $path(pipe)
    set x ""
    set f1 [open $path(pipe) w]
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {chan puts [chan gets stdin]}
    chan puts $f1 {chan puts [chan gets stdin]}
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan puts $f1 hello
    chan flush $f1
    set x ""
    lappend x [chan read $f1 6]
    chan puts $f1 hello
    chan flush $f1
    lappend x [chan read $f1]
} -cleanup {
    chan close $f1
    set x
} -result {{hello
} {{hello
} {hello
}}
test chan-io-32.12 {Tcl_Read, -nonewline} -setup {
test chan-io-32.12 {Tcl_Read, -nonewline} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan puts $f1 hello
    chan puts $f1 bye
    chan close $f1
    set f1 [open $path(test1) r]
    chan read -nonewline $f1
    set c [chan read -nonewline $f1]
} -cleanup {
    chan close $f1
    set c
} -result {hello
} {hello
bye}
test chan-io-32.13 {Tcl_Read, -nonewline} -setup {
test chan-io-32.13 {Tcl_Read, -nonewline} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan puts $f1 hello
    chan puts $f1 bye
    chan close $f1
    set f1 [open $path(test1) r]
    set c [chan read -nonewline $f1]
    list [string length $c] $c
} -cleanup {
    chan close $f1
    list [string length $c] $c
} -result {9 {hello
} {9 {hello
bye}}
test chan-io-32.14 {Tcl_Read, reading in small chunks} -setup {
test chan-io-32.14 {Tcl_Read, reading in small chunks} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan puts $f "Two lines: this one"
    chan puts $f "and this one"
    chan close $f
    set f [open $path(test1)]
    list [chan read $f 1] [chan read $f 2] [chan read $f]
    set x [list [chan read $f 1] [chan read $f 2] [chan read $f]]
} -cleanup {
    chan close $f
    set x
} -result {T wo { lines: this one
} {T wo { lines: this one
and this one
}}
test chan-io-32.15 {Tcl_Read, asking for more input than available} -setup {
test chan-io-32.15 {Tcl_Read, asking for more input than available} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan puts $f "Two lines: this one"
    chan puts $f "and this one"
    chan close $f
    set f [open $path(test1)]
    chan read $f 100
    set x [chan read $f 100]
} -cleanup {
    chan close $f
    set x
} -result {Two lines: this one
} {Two lines: this one
and this one
}
test chan-io-32.16 {Tcl_Read, read to end of file with -nonewline} -setup {
test chan-io-32.16 {Tcl_Read, read to end of file with -nonewline} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan puts $f "Two lines: this one"
    chan puts $f "and this one"
    chan close $f
    set f [open $path(test1)]
    chan read -nonewline $f
    set x [chan read -nonewline $f]
} -cleanup {
    chan close $f
    set x
} -result {Two lines: this one
} {Two lines: this one
and this one}

# Test Tcl_Gets.

test chan-io-33.1 {Tcl_Gets, reading what was written} -setup {
test chan-io-33.1 {Tcl_Gets, reading what was written} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    set y "first line"
    chan puts $f1 "first line"
    chan puts $f1 $y
    chan close $f1
    set f1 [open $path(test1) r]
    chan gets $f1
} -cleanup {
    set x [chan gets $f1]
    set z ok
    if {"$x" != "$y"} {
	set z broken
    }
    chan close $f1
} -result {first line}
    set z
} ok
test chan-io-33.2 {Tcl_Gets into variable} {
    set f1 [open $path(longfile) r]
    set c [chan gets $f1 x]
    set l [string length x]
    set z ok
    if {$l != $l} {
	set z broken
    }
    chan close $f1
    set z
} ok
test chan-io-33.3 {Tcl_Gets from pipe} -setup {
test chan-io-33.3 {Tcl_Gets from pipe} {stdio openpipe} {
    file delete $path(pipe)
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {chan puts [chan gets stdin]}
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan puts $f1 hello
    chan flush $f1
    chan gets $f1
    set x [chan gets $f1]
} -cleanup {
    chan close $f1
    set z ok
} -result hello
test chan-io-33.4 {Tcl_Gets with long line} -setup {
    if {"$x" != "hello"} {
	set z broken
    }
    set z
} ok
test chan-io-33.4 {Tcl_Gets with long line} {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    chan puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    chan close $f
    set f [open $path(test3)]
    chan gets $f
    set x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test chan-io-33.5 {Tcl_Gets with long line} -setup {
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test chan-io-33.5 {Tcl_Gets with long line} {
    set f [open $path(test3) w]
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    close $f
} -body {
    set f [open $path(test3)]
    set x [chan gets $f y]
    chan close $f
    list $x $y
} -result {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test chan-io-33.6 {Tcl_Gets and end of file} -setup {
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test chan-io-33.6 {Tcl_Gets and end of file} {
    file delete $path(test3)
    set x {}
} -body {
    set f [open $path(test3) w]
    chan puts -nonewline $f "Test1\nTest2"
    chan close $f
    set f [open $path(test3)]
    set x {}
    set y {}
    lappend x [chan gets $f y] $y
    set y {}
    lappend x [chan gets $f y] $y
    set y {}
    lappend x [chan gets $f y] $y
} -cleanup {
    chan close $f
    set x
} -result {5 Test1 5 Test2 -1 {}}
test chan-io-33.7 {Tcl_Gets and bad variable} -setup {
} {5 Test1 5 Test2 -1 {}}
test chan-io-33.7 {Tcl_Gets and bad variable} {
    set f [open $path(test3) w]
    chan puts $f "Line 1"
    chan puts $f "Line 2"
    chan close $f
    catch {unset x}
    set f [open $path(test3) r]
} -body {
    set x 24
    set f [open $path(test3) r]
    chan gets $f x(0)
    set result [list [catch {chan gets $f x(0)} msg] $msg]
} -returnCodes error -cleanup {
    chan close $f
    set result
} -result {can't set "x(0)": variable isn't array}
} {1 {can't set "x(0)": variable isn't array}}
test chan-io-33.8 {Tcl_Gets, exercising double buffering} {
    set f [open $path(test3) w]
    chan configure $f -translation lf -eofchar {}
    set x ""
    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
    for {set y 0} {$y < 100} {incr y} {chan puts $f $x}
    chan close $f
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

4328

4329
4330

4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343

4344
4345

4346
4347
4348



4349
4350

4351
4352
4353
4354





4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376

4377

4378
4379
4380
4381
4382
4383
4384
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







-
+


-
+
-

+
-
-
+
+

-







-
+
-

-
-
+
+
+

-







-
+
-

-
-
+
+
+

-







-
+
-

-
-
+
+
+

-








-
+
-

-
-
+
+
+

-







-
-
+
+

+
-
+

-
+

-










-
+
-

+
-
-
-
+
+
+
-
-
+
-
-
-
-
+
+
+
+
+

-


















-

+
-
+







    for {set y 0} {$y < 300} {incr y} {chan gets $f}
    chan close $f
    set y
} 300

# Test Tcl_Seek and Tcl_Tell.

test chan-io-34.1 {Tcl_Seek to current position at start of file} -body {
test chan-io-34.1 {Tcl_Seek to current position at start of file} {
    set f1 [open $path(longfile) r]
    chan seek $f1 0 current
    chan tell $f1
    set c [chan tell $f1]
} -cleanup {
    chan close $f1
    set c
} -result 0
test chan-io-34.2 {Tcl_Seek to offset from start} -setup {
} 0
test chan-io-34.2 {Tcl_Seek to offset from start} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 10 start
    chan tell $f1
    set c [chan tell $f1]
} -cleanup {
    chan close $f1
} -result 10
test chan-io-34.3 {Tcl_Seek to end of file} -setup {
    set c
} 10
test chan-io-34.3 {Tcl_Seek to end of file} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 0 end
    chan tell $f1
    set c [chan tell $f1]
} -cleanup {
    chan close $f1
} -result 54
test chan-io-34.4 {Tcl_Seek to offset from end of file} -setup {
    set c
} 54
test chan-io-34.4 {Tcl_Seek to offset from end of file} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 -10 end
    chan tell $f1
    set c [chan tell $f1]
} -cleanup {
    chan close $f1
} -result 44
test chan-io-34.5 {Tcl_Seek to offset from current position} -setup {
    set c
} 44
test chan-io-34.5 {Tcl_Seek to offset from current position} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 10 current
    chan seek $f1 10 current
    chan tell $f1
    set c [chan tell $f1]
} -cleanup {
    chan close $f1
} -result 20
test chan-io-34.6 {Tcl_Seek to offset from end of file} -setup {
    set c
} 20
test chan-io-34.6 {Tcl_Seek to offset from end of file} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 -10 end
    list [chan tell $f1] [chan read $f1]
} -cleanup {
    set c [chan tell $f1]
    set r [chan read $f1]
    chan close $f1
    list $c $r
} -result {44 {rstuvwxyz
} {44 {rstuvwxyz
}}
test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} -setup {
test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 -10 end
    set c1 [chan tell $f1]
    set r1 [chan read $f1 5]
    chan seek $f1 0 current
    list $c1 $r1 [chan tell $f1]
    set c2 [chan tell $f1]
} -cleanup {
    chan close $f1
    list $c1 $r1 $c2
} -result {44 rstuv 49}
test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup {
    set pipe [openpipe]
} {44 rstuv 49}
test chan-io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
} -constraints stdio -body {
    chan seek $pipe 0 current
    set x [list [catch {chan seek $f1 0 current} msg] $msg]
} -returnCodes error -cleanup {
    chan close $pipe
} -match glob -result {error during seek on "*": invalid argument}
test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} -setup {
    chan close $f1
    regsub {".*":} $x {"":} x
    string tolower $x
} {1 {error during seek on "": invalid argument}}
test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    chan close $f
    set f [open $path(test3) RDWR]
    set x [chan read $f 1]
    chan seek $f 3
    lappend x [chan read $f 1]
    chan seek $f 0 start
    lappend x [chan read $f 1]
    chan seek $f 10 current
    lappend x [chan read $f 1]
    chan seek $f -2 end
    lappend x [chan read $f 1]
    chan seek $f 50 end
    lappend x [chan read $f 1]
    chan seek $f 1
    lappend x [chan read $f 1]
} -cleanup {
    chan close $f
    set x
} -result {a d a l Y {} b}
} {a d a l Y {} b}
set path(test3) [makeFile {} test3]
test chan-io-34.10 {Tcl_Seek testing flushing of buffered input} {
    set f [open $path(test3) w]
    chan configure $f -translation lf
    chan puts $f xyz\n123
    chan close $f
    set f [open $path(test3) r+]
4414
4415
4416
4417
4418
4419
4420
4421

4422
4423
4424
4425

4426
4427

4428
4429


4430
4431
4432
4433
4434
4435
4436
4437
4438
4439

4440
4441

4442
4443


4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455

4456
4457

4458
4459
4460
4461




4462
4463

4464
4465
4466



4467
4468
4469
4470
4471
4472
4473
4474

4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493

4494
4495


4496
4497
4498
4499
4500
4501
4502

4503
4504
4505
4506



4507
4508
4509

4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520

4521
4522


4523
4524
4525
4526
4527

4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542

4543

4544
4545
4546
4547

4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565

4566
4567


4568
4569
4570
4571
4572
4573
4574

4575
4576
4577
4578
4579
4580
4581
4582
4583
4584

4585
4586


4587
4588
4589
4590
4591
4592
4593

4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607

4608
4609


4610
4611

4612
4613

4614
4615

4616
4617
4618
4619

4620
4621


4622
4623
4624
4625
4626
4627
4628
4629
4630


4631
4632
4633
4634

4635
4636


4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647


4648

4649
4650


4651
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
4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024

5025
5026


5027
5028
5029
5030

5031
5032
5033
5034
5035

5036
5037


5038
5039
5040
5041
5042
5043
5044

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
5095
5096
5097
5098

5099
5100


5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111

5112

5113
5114
5115
5116
5117
5118
5119
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
4328



4329
4330
4331
4332
4333
4334
4335
4336
4337
4338

4339
4340

4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355

4356
4357


4358
4359
4360
4361
4362
4363
4364
4365

4366

4367


4368
4369
4370


4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381

4382
4383


4384
4385
4386


4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405

4406
4407
4408
4409

4410
4411

4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425

4426
4427


4428
4429
4430

4431
4432
4433
4434

4435
4436
4437
4438
4439
4440
4441
4442
4443

4444
4445


4446
4447
4448

4449
4450
4451
4452

4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465

4466
4467


4468
4469
4470

4471


4472
4473
4474
4475
4476
4477

4478
4479


4480
4481
4482


4483
4484
4485
4486
4487

4488
4489
4490
4491

4492
4493


4494
4495
4496

4497
4498
4499
4500
4501
4502
4503


4504
4505
4506
4507


4508
4509
4510

4511
4512
4513
4514
4515
4516
4517


4518
4519
4520
4521


4522
4523
4524

4525
4526
4527
4528
4529
4530
4531


4532
4533
4534
4535


4536
4537
4538

4539
4540
4541
4542
4543
4544
4545


4546
4547
4548
4549


4550
4551
4552

4553
4554
4555
4556
4557
4558
4559


4560
4561
4562
4563


4564
4565
4566

4567
4568
4569
4570
4571
4572
4573


4574
4575
4576
4577


4578
4579
4580

4581
4582

4583
4584
4585
4586
4587
4588


4589
4590
4591
4592


4593
4594
4595

4596
4597

4598
4599
4600
4601
4602
4603


4604
4605
4606
4607


4608
4609
4610

4611
4612

4613
4614
4615
4616
4617
4618


4619
4620
4621
4622


4623
4624
4625

4626
4627

4628
4629
4630
4631
4632
4633


4634
4635
4636
4637


4638
4639
4640

4641
4642

4643
4644
4645
4646
4647
4648


4649
4650
4651
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
4955
4956


4957
4958
4959
4960
4961
4962
4963
4964
4965

4966
4967
4968
4969
4970
4971
4972
4973







-
+

-

-
+
-

+
-
-
+
+

-







-
+
-

+
-
-
+
+

-









-
+
-

+
-
-
-
-
+
+
+
+
-

+
-
-
-
+
+
+







-
+

-















-

+
-
-
+
+






-
+
-

-
-
+
+
+
-
-

+









-

+
-
-
+
+

-
-


+















+
-
+



-
+

-














-

+
-
-
+
+

-




-
+








-

+
-
-
+
+

-




-
+












-

+
-
-
+
+

-
+
-
-
+


+


-

+
-
-
+
+

-
-





-
+
+


-

+
-
-
+
+

-







-
-
+
+

+
-
-
+
+

-







-
-
+
+

+
-
-
+
+

-







-
-
+
+

+
-
-
+
+

-







-
-
+
+

+
-
-
+
+

-







-
-
+
+

+
-
-
+
+

-







-
-
+
+

+
-
-
+
+

-


-
+
+




-
-
+
+

+
-
-
+
+

-


-
+
+




-
-
+
+

+
-
-
+
+

-


-
+
+




-
-
+
+

+
-
-
+
+

-


-
+
+




-
-
+
+

+
-
-
+
+

-


-
+
+




-
-
+
+

+
-
-
+
+

-


-
+
+




-
-
+
+

+
-
+



-
+
-
-
-
+





+








-

+
-
-
+
+
-
-
-
+


+






-

+
-
-
+
+

-
-




+






-

+
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+




+
-
+
-
-
+
-

-
-
+
+

-
+

-
-





+






-

+
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+





+
-
+
-
-
+
-

-
-
+
+




-
+
-
-



+


-

+
-
-
+
+
-
-



+





-

+
-
+



-
+

-
+
-

+
-
-
+
+
-
-

+













-

+
-
+


+










-
+

-

-
+
-

+
-
+



-
+

-

-
+
-

+
-
-
+
+

-


-
+
-

+
-
-
+
+

-
-

+









-

+
-
-
+
+

-
-

+



-

+
-
-
+
+

-




-
+
-

-
-
+
+
+

-
-




+




-

+
-
-
+
+

-
-

+














+
-
-
+
+

-
-



+







-

+
-
-
+
+

-
-








+
-
+







    chan seek $f -4 cur
    set y [chan gets $f]
    chan close $f
    list $x [viewFile test3] $y
} {14 {xyz
123
xyzzy} zzy}
test chan-io-34.13 {Tcl_Tell at start of file} -setup {
test chan-io-34.13 {Tcl_Tell at start of file} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan tell $f1
    set p [chan tell $f1]
} -cleanup {
    chan close $f1
    set p
} -result 0
test chan-io-34.14 {Tcl_Tell after seek to end of file} -setup {
} 0
test chan-io-34.14 {Tcl_Tell after seek to end of file} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 0 end
    chan tell $f1
    set c1 [chan tell $f1]
} -cleanup {
    chan close $f1
    set c1
} -result 54
test chan-io-34.15 {Tcl_Tell combined with seeking} -setup {
} 54
test chan-io-34.15 {Tcl_Tell combined with seeking} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -eofchar {}
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
    chan close $f1
    set f1 [open $path(test1) r]
    chan seek $f1 10 start
    set c1 [chan tell $f1]
    chan seek $f1 10 current
    list $c1 [chan tell $f1]
    set c2 [chan tell $f1]
} -cleanup {
    chan close $f1
    list $c1 $c2
} -result {10 20}
test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints stdio -body {
    set f1 [openpipe]
    chan tell $f1
} {10 20}
test chan-io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    set c [chan tell $f1]
} -cleanup {
    chan close $f1
    set c
} -result -1
test chan-io-34.17 {Tcl_Tell on pipe: always -1} stdio {
    set f1 [openpipe]
} -1
test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    chan puts $f1 {chan puts hello}
    chan flush $f1
    set c [chan tell $f1]
    chan gets $f1
    chan close $f1
    set c
} -1
test chan-io-34.18 {Tcl_Tell combined with seeking and reading} -setup {
test chan-io-34.18 {Tcl_Tell combined with seeking and reading} {
    file delete $path(test2)
} -body {
    set f [open $path(test2) w]
    chan configure $f -translation lf -eofchar {}
    chan puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
    chan close $f
    set f [open $path(test2)]
    chan configure $f -translation lf
    set x [chan tell $f]
    chan read $f 3
    lappend x [chan tell $f]
    chan seek $f 2
    lappend x [chan tell $f]
    chan seek $f 10 current
    lappend x [chan tell $f]
    chan seek $f 0 end
    lappend x [chan tell $f]
} -cleanup {
    chan close $f
    set x
} -result {0 3 2 12 30}
test chan-io-34.19 {Tcl_Tell combined with opening in append mode} -body {
} {0 3 2 12 30}
test chan-io-34.19 {Tcl_Tell combined with opening in append mode} {
    set f [open $path(test3) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f "abcdefghijklmnopqrstuvwxyz"
    chan puts $f "abcdefghijklmnopqrstuvwxyz"
    chan close $f
    set f [open $path(test3) a]
    chan tell $f
    set c [chan tell $f]
} -cleanup {
    chan close $f
} -result 54
test chan-io-34.20 {Tcl_Tell combined with writing} -setup {
    set c
} 54
test chan-io-34.20 {Tcl_Tell combined with writing} {
    set l ""
} -body {
    set f [open $path(test3) w]
    set l ""
    chan seek $f 29 start
    lappend l [chan tell $f]
    chan puts -nonewline $f a
    chan seek $f 39 start
    lappend l [chan tell $f]
    chan puts -nonewline $f a
    lappend l [chan tell $f]
    chan seek $f 407 end
    lappend l [chan tell $f]
} -cleanup {
    chan close $f
    set l
} -result {29 39 40 447}
test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} -setup {
} {29 39 40 447}
test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
    file delete $path(test3)
    set l ""
} -constraints {largefileSupport} -body {
    set f [open $path(test3) w]
    chan configure $f -encoding binary
    set l ""
    lappend l [chan tell $f]
    chan puts -nonewline $f abcdef
    lappend l [chan tell $f]
    chan flush $f
    lappend l [chan tell $f]
    # 4GB offset!
    chan seek $f 0x100000000
    lappend l [chan tell $f]
    chan puts -nonewline $f abcdef
    lappend l [chan tell $f]
    chan close $f
    lappend l [file size $path(test3)]
    # truncate...
    chan close [open $path(test3) w]
    lappend l [file size $path(test3)]
    set l
} -result {0 6 6 4294967296 4294967302 4294967302 0}
} {0 6 6 4294967296 4294967302 4294967302 0}

# Test Tcl_Eof

test chan-io-35.1 {Tcl_Eof} -setup {
test chan-io-35.1 {Tcl_Eof} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan puts $f hello
    chan puts $f hello
    chan close $f
    set f [open $path(test1)]
    set x [chan eof $f]
    lappend x [chan eof $f]
    chan gets $f
    lappend x [chan eof $f]
    chan gets $f
    lappend x [chan eof $f]
    chan gets $f
    lappend x [chan eof $f]
    lappend x [chan eof $f]
} -cleanup {
    chan close $f
    set x
} -result {0 0 0 0 1 1}
test chan-io-35.2 {Tcl_Eof with pipe} -constraints stdio -setup {
} {0 0 0 0 1 1}
test chan-io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
    file delete $path(pipe)
} -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {chan gets stdin}
    chan puts $f1 {chan puts hello}
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan puts $f1 hello
    set x [chan eof $f1]
    chan flush $f1
    lappend x [chan eof $f1]
    chan gets $f1
    lappend x [chan eof $f1]
    chan gets $f1
    lappend x [chan eof $f1]
} -cleanup {
    chan close $f1
    set x
} -result {0 0 0 1}
test chan-io-35.3 {Tcl_Eof with pipe} -constraints stdio -setup {
} {0 0 0 1}
test chan-io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
    file delete $path(pipe)
} -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {chan gets stdin}
    chan puts $f1 {chan puts hello}
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan puts $f1 hello
    set x [chan eof $f1]
    chan flush $f1
    lappend x [chan eof $f1]
    chan gets $f1
    lappend x [chan eof $f1]
    chan gets $f1
    lappend x [chan eof $f1]
    chan gets $f1
    lappend x [chan eof $f1]
    chan gets $f1
    lappend x [chan eof $f1]
} -cleanup {
    chan close $f1
    set x
} -result {0 0 0 1 1 1}
test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} -setup {
} {0 0 0 1 1 1}
test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
    file delete $path(test1)
    set l ""
    set f [open $path(test1) w]
} -constraints {nonBlockFiles} -body {
    chan close [open $path(test1) w]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -blocking off
    set l ""
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result {{} 1}
test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup {
} {{} 1}
test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} {
    file delete $path(pipe)
    set l ""
} -constraints stdio -body {
    set f [open $path(pipe) w]
    chan puts $f {
	exit
    }
    chan close $f
    set f [openpipe r $path(pipe)]
    set f [open "|[list [interpreter] $path(pipe)]" r]
    set l ""
    lappend l [chan gets $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result {{} 1}
test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup {
} {{} 1}
test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar \x1a
    chan puts $f abc\ndef
    chan close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $s $l $e
} -result {9 8 1}
test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup {
} {9 8 1}
test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar \x1a
    chan puts $f abc\ndef
    chan close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $s $l $e
} -result {9 8 1}
test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup {
} {9 8 1}
test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar \x1a
    chan puts $f abc\ndef
    chan close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $s $l $e
} -result {9 8 1}
test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup {
} {9 8 1}
test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar \x1a
    chan puts $f abc\ndef
    chan close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1a
    list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $s $l $e
} -result {9 8 1}
test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup {
} {9 8 1}
test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar \x1a
    chan puts $f abc\ndef
    chan close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $s $l $e
} -result {11 8 1}
test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup {
} {11 8 1}
test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar \x1a
    chan puts $f abc\ndef
    chan close $f
    set s [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1a
    list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $s $l $e
} -result {11 8 1}
test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
} {11 8 1}
test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    set i [format abc\ndef\n%cqrs\nuvw 26]
    chan puts $f $i
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $l $e
} -result {17 8 1}
test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup {
} {17 8 1}
test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    set i [format abc\ndef\n%cqrs\nuvw 26]
    chan puts $f $i
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $l $e
} -result {17 8 1}
test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup {
} {17 8 1}
test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    set i [format abc\ndef\n%cqrs\nuvw 26]
    chan puts $f $i
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $l $e
} -result {17 8 1}
test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup {
} {17 8 1}
test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr -eofchar {}
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    set i [format abc\ndef\n%cqrs\nuvw 26]
    chan puts $f $i
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1a
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $l $e
} -result {17 8 1}
test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup {
} {17 8 1}
test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    set i [format abc\ndef\n%cqrs\nuvw 26]
    chan puts $f $i
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $l $e
} -result {21 8 1}
test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
} {21 8 1}
test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf -eofchar {}
    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
    set i [format abc\ndef\n%cqrs\nuvw 26]
    chan puts $f $i
    chan close $f
    set c [file size $path(test1)]
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1a
    list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
    set l [string length [chan read $f]]
    set e [chan eof $f]
    chan close $f
    list $c $l $e
} -result {21 8 1}
} {21 8 1}

# Test Tcl_InputBlocked

test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
    set x ""
} -constraints stdio -body {
    set f1 [openpipe]
    set f1 [open "|[list [interpreter]]" r+]
    chan puts $f1 {chan puts hello_from_pipe}
    chan flush $f1
    chan gets $f1
    chan configure $f1 -blocking off -buffering full
    chan puts $f1 {chan puts hello}
    set x ""
    lappend x [chan gets $f1]
    lappend x [chan blocked $f1]
    chan flush $f1
    after 200
    lappend x [chan gets $f1]
    lappend x [chan blocked $f1]
    lappend x [chan gets $f1]
    lappend x [chan blocked $f1]
} -cleanup {
    chan close $f1
    set x
} -result {{} 1 hello 0 {} 1}
test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup {
} {{} 1 hello 0 {} 1}
test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
    set x ""
} -constraints stdio -body {
    set f1 [openpipe]
    set f1 [open "|[list [interpreter]]" r+]
    chan configure $f1 -buffering line
    chan puts $f1 {chan puts hello_from_pipe}
    set x ""
    lappend x [chan gets $f1]
    lappend x [chan blocked $f1]
    chan puts $f1 {exit}
    lappend x [chan gets $f1]
    lappend x [chan blocked $f1]
    lappend x [chan eof $f1]
} -cleanup {
    chan close $f1
    set x
} -result {hello_from_pipe 0 {} 0 1}
test chan-io-36.3 {Tcl_InputBlocked vs files, short read} -setup {
} {hello_from_pipe 0 {} 0 1}
test chan-io-36.3 {Tcl_InputBlocked vs files, short read} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnop
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [chan blocked $f]
    lappend l [chan read $f 3]
    lappend l [chan blocked $f]
    lappend l [chan read -nonewline $f]
    lappend l [chan blocked $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result {0 abc 0 defghijklmnop 0 1}
test chan-io-36.4 {Tcl_InputBlocked vs files, event driven read} -setup {
    file delete $path(test1)
} {0 abc 0 defghijklmnop 0 1}
test chan-io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} {
    proc in {f} {
        variable l
    set l ""
    variable x
} -constraints {fileevent} -body {
        variable x
	lappend l [chan read $f 3]
	if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
    }
    file delete $path(test1)
    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnop
    chan close $f
    set f [open $path(test1) r]
    set l ""
    chan event $f readable [namespace code {
    chan event $f readable [namespace code [list in $f]]
	lappend l [chan read $f 3]
	if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
    variable x
    }]
    vwait [namespace which -variable x]
    return $l
} -result {abc def ghi jkl mno {p
    set l
} {abc def ghi jkl mno {p
} eof}
test chan-io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} -setup {
test chan-io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
    file delete $path(test1)
    set l ""
} -constraints {nonBlockFiles} -body {
    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnop
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -blocking off
    set l ""
    lappend l [chan blocked $f]
    lappend l [chan read $f 3]
    lappend l [chan blocked $f]
    lappend l [chan read -nonewline $f]
    lappend l [chan blocked $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result {0 abc 0 defghijklmnop 0 1}
test chan-io-36.6 {Tcl_InputBlocked vs files, event driven read} -setup {
    file delete $path(test1)
} {0 abc 0 defghijklmnop 0 1}
test chan-io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} {
    proc in {f} {
        variable l
    set l ""
    variable x
} -constraints {nonBlockFiles fileevent} -body {
        variable x
	lappend l [chan read $f 3]
	if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
    }
    file delete $path(test1)
    set f [open $path(test1) w]
    chan puts $f abcdefghijklmnop
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -blocking off
    set l ""
    chan event $f readable [namespace code {
    chan event $f readable [namespace code [list in $f]]
	lappend l [chan read $f 3]
	if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
    variable x
    }]
    vwait [namespace which -variable x]
    return $l
} -result {abc def ghi jkl mno {p
    set l
} {abc def ghi jkl mno {p
} eof}

# Test Tcl_InputBuffered

test chan-io-37.1 {Tcl_InputBuffered} -setup {
test chan-io-37.1 {Tcl_InputBuffered} {testchannel} {
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(longfile) r]
    chan configure $f -buffersize 4096
    chan read $f 3
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [chan tell $f]
} -cleanup {
    chan close $f
    set l
} -result {4093 3}
test chan-io-37.2 {Tcl_InputBuffered, test input flushing on seek} -setup {
} {4093 3}
test chan-io-37.2 {Tcl_InputBuffered, test input flushing on seek} {testchannel} {
    set l ""
} -constraints {testchannel} -body {
    set f [open $path(longfile) r]
    chan configure $f -buffersize 4096
    chan read $f 3
    set l ""
    lappend l [testchannel inputbuffered $f]
    lappend l [chan tell $f]
    chan seek $f 0 current
    lappend l [testchannel inputbuffered $f]
    lappend l [chan tell $f]
} -cleanup {
    chan close $f
    set l
} -result {4093 3 0 3}
} {4093 3 0 3}

# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize

test chan-io-38.1 {Tcl_GetChannelBufferSize, default buffer size} -body {
test chan-io-38.1 {Tcl_GetChannelBufferSize, default buffer size} {
    set f [open $path(longfile) r]
    chan configure $f -buffersize
    set s [chan configure $f -buffersize]
} -cleanup {
    chan close $f
    set s
} -result 4096
test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup {
} 4096
test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
    set l ""
} -body {
    set f [open $path(longfile) r]
    set l ""
    lappend l [chan configure $f -buffersize]
    chan configure $f -buffersize 10000
    lappend l [chan configure $f -buffersize]
    chan configure $f -buffersize 1
    lappend l [chan configure $f -buffersize]
    chan configure $f -buffersize -1
    lappend l [chan configure $f -buffersize]
    chan configure $f -buffersize 0
    lappend l [chan configure $f -buffersize]
    chan configure $f -buffersize 100000
    lappend l [chan configure $f -buffersize]
    chan configure $f -buffersize 10000000
    lappend l [chan configure $f -buffersize]
} -cleanup {
    chan close $f
    set l
} -result {4096 10000 1 1 1 100000 1048576}
} {4096 10000 1 1 1 100000 1048576}
test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
    # This test crashes the interp if Bug #427196 is not fixed

    set chan [open [info script] r]
    chan configure $chan -buffersize 10
    set var [chan read $chan 2]
    chan configure $chan -buffersize 32
    append var [chan read $chan]
    chan close $chan
} {}

# Test Tcl_SetChannelOption, Tcl_GetChannelOption

test chan-io-39.1 {Tcl_GetChannelOption} -setup {
test chan-io-39.1 {Tcl_GetChannelOption} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -blocking
    set x [chan configure $f1 -blocking]
} -cleanup {
    chan close $f1
    set x
} -result 1
} 1
#
# Test 17.2 was removed.
#
test chan-io-39.2 {Tcl_GetChannelOption} -setup {
test chan-io-39.2 {Tcl_GetChannelOption} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -buffering
    set x [chan configure $f1 -buffering]
} -cleanup {
    chan close $f1
    set x
} -result full
test chan-io-39.3 {Tcl_GetChannelOption} -setup {
} full
test chan-io-39.3 {Tcl_GetChannelOption} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -buffering line
    chan configure $f1 -buffering
    set x [chan configure $f1 -buffering]
} -cleanup {
    chan close $f1
    set x
} -result line
test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} -setup {
} line
test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
    file delete $path(test1)
    set l ""
} -body {
    set f1 [open $path(test1) w]
    set l ""
    lappend l [chan configure $f1 -buffering]
    chan configure $f1 -buffering line
    lappend l [chan configure $f1 -buffering]
    chan configure $f1 -buffering none
    lappend l [chan configure $f1 -buffering]
    chan configure $f1 -buffering line
    lappend l [chan configure $f1 -buffering]
    chan configure $f1 -buffering full
    lappend l [chan configure $f1 -buffering]
} -cleanup {
    chan close $f1
    set l
} -result {full line none line full}
test chan-io-39.5 {Tcl_GetChannelOption, invariance} -setup {
} {full line none line full}
test chan-io-39.5 {Tcl_GetChannelOption, invariance} {
    file delete $path(test1)
    set l ""
} -body {
    set f1 [open $path(test1) w]
    set l ""
    lappend l [chan configure $f1 -buffering]
    lappend l [list [catch {chan configure $f1 -buffering green} msg] $msg]
    lappend l [chan configure $f1 -buffering]
} -cleanup {
    chan close $f1
    set l
} -result {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
test chan-io-39.6 {Tcl_SetChannelOption, multiple options} -setup {
} {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
test chan-io-39.6 {Tcl_SetChannelOption, multiple options} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf -buffering line
    chan puts $f1 hello
    chan puts $f1 bye
    file size $path(test1)
    set x [file size $path(test1)]
} -cleanup {
    chan close $f1
} -result 10
test chan-io-39.7 {Tcl_SetChannelOption, buffering, translation} -setup {
    set x
} 10
test chan-io-39.7 {Tcl_SetChannelOption, buffering, translation} {
    file delete $path(test1)
    set x ""
} -body {
    set f1 [open $path(test1) w]
    chan configure $f1 -translation lf
    chan puts $f1 hello
    chan puts $f1 bye
    set x ""
    chan configure $f1 -buffering line
    lappend x [file size $path(test1)]
    chan puts $f1 really_bye
    lappend x [file size $path(test1)]
} -cleanup {
    chan close $f1
    set x
} -result {0 21}
test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup {
} {0 21}
test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} {
    file delete $path(test1)
    set l ""
} -body {
    set f1 [open $path(test1) w]
    set l ""
    chan configure $f1 -translation lf -buffering none -eofchar {}
    chan puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    chan puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    chan configure $f1 -buffering full
    chan puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    chan configure $f1 -buffering none
    lappend l [file size $path(test1)]
    chan puts -nonewline $f1 hello
    lappend l [file size $path(test1)]
    chan close $f1
    lappend l [file size $path(test1)]
    set l
} -result {5 10 10 10 20 20}
test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} -setup {
} {5 10 10 10 20 20}
test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
    file delete $path(test1)
    set x ""
} -constraints {nonBlockFiles} -body {
    set f1 [open $path(test1) w]
    chan close $f1
    set f1 [open $path(test1) r]
    set x ""
    lappend x [chan configure $f1 -blocking]
    chan configure $f1 -blocking off
    lappend x [chan configure $f1 -blocking]
    lappend x [chan gets $f1]
    lappend x [chan read $f1 1000]
    lappend x [chan blocked $f1]
    lappend x [chan eof $f1]
} -cleanup {
    chan close $f1
    set x
} -result {1 0 {} {} 0 1}
test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup {
} {1 0 {} {} 0 1}
test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
    file delete $path(pipe)
    set x ""
} -constraints stdio -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {
	chan gets stdin
	after 100
	chan puts hi
	chan gets stdin
    }
    chan close $f1
    set x ""
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan configure $f1 -blocking off -buffering line
    lappend x [chan configure $f1 -blocking]
    lappend x [chan gets $f1]
    lappend x [chan blocked $f1]
    chan configure $f1 -blocking on
    chan puts $f1 hello
    chan configure $f1 -blocking off
5127
5128
5129
5130
5131
5132
5133
5134
5135

5136
5137


5138
5139
5140
5141
5142

5143
5144

5145
5146


5147
5148
5149
5150
5151

5152
5153

5154
5155


5156
5157
5158
5159
5160

5161
5162

5163
5164


5165
5166
5167
5168
5169
5170
5171
5172
5173

5174
5175

5176
5177


5178
5179
5180
5181
5182
5183
5184
5185
5186

5187
5188

5189
5190


5191
5192
5193
5194

5195
5196

5197
5198


5199
5200
5201

5202
5203
5204
5205

5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220

5221

5222
5223

5224
5225
5226
5227
5228
5229
5230

5231
5232
5233

5234

5235
5236

5237
5238
5239
5240
5241
5242
5243

5244
5245
5246

5247

5248
5249

5250
5251
5252
5253
5254
5255
5256

5257
5258
5259

5260

5261
5262

5263
5264
5265
5266
5267
5268
5269

5270
5271
5272

5273
5274


5275
5276
5277
5278

5279
5280
5281
5282
5283
5284
5285

5286
5287


5288
5289
5290
5291

5292
5293
5294
5295
5296
5297
5298

5299
5300
5301



5302
5303
5304
5305

5306
5307
5308

5309
5310
5311



5312
5313
5314
5315
5316

5317
5318
5319

5320

5321
5322

5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336

5337
5338


5339
5340
5341
5342
5343

5344
5345
5346
5347
5348
5349

5350
5351


5352
5353
5354

5355


5356
5357
5358
5359



5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371

5372
5373

5374
5375


5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390

5391
5392
5393
5394
5395

5396
5397


5398
5399
5400
5401
5402
5403
5404
5405

5406
5407
5408
5409
5410
5411
5412
5413
5414


5415
5416
5417
5418
5419
5420
5421
5422
5423
5424

5425
5426

5427
5428


5429
5430
5431
5432
5433
5434
5435

5436
5437

5438
5439


5440
5441
5442
5443
5444
5445

5446
5447

5448



5449
5450
5451
5452
5453
5454
5455
5456
5457

5458
5459
5460
5461
5462
5463
5464
5465

5466


5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487

5488
5489
5490
5491

5492
5493

5494

5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510















5511
5512
5513
5514
5515
5516
5517
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
5016

5017
5018
5019
5020
5021
5022

5023

5024
5025


5026
5027
5028

5029
5030
5031
5032
5033
5034

5035

5036
5037


5038
5039
5040
5041


5042

5043
5044


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

5095
5096
5097
5098
5099
5100
5101

5102

5103
5104
5105

5106
5107

5108
5109
5110
5111
5112
5113
5114

5115

5116
5117
5118


5119
5120
5121


5122
5123
5124
5125
5126
5127
5128

5129
5130


5131
5132
5133


5134
5135
5136
5137
5138
5139
5140

5141
5142



5143
5144
5145
5146

5147

5148


5149
5150



5151
5152
5153
5154

5155
5156

5157


5158
5159

5160
5161

5162
5163

5164
5165
5166
5167
5168
5169
5170
5171
5172
5173

5174
5175


5176
5177
5178

5179
5180

5181
5182
5183
5184
5185

5186
5187


5188
5189


5190
5191

5192
5193
5194



5195
5196
5197
5198

5199
5200
5201
5202
5203
5204
5205
5206
5207

5208

5209
5210


5211
5212
5213


5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229

5230
5231


5232
5233
5234

5235
5236
5237
5238
5239

5240
5241

5242
5243
5244
5245
5246


5247
5248
5249

5250
5251
5252
5253
5254
5255
5256

5257

5258
5259


5260
5261
5262

5263
5264
5265
5266

5267

5268
5269


5270
5271
5272
5273
5274
5275
5276

5277

5278
5279

5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290

5291
5292
5293
5294
5295
5296
5297
5298
5299
5300

5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322

5323
5324

5325

5326

5327
5328

5329
5330















5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352







-

+
-
-
+
+

-


-
+
-

+
-
-
+
+

-


-
+
-

+
-
-
+
+

-


-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+

-






-
+
-

+
-
-
+
+


-
-
+
-

+
-
-
+
+
-
-
-
+




+












-
-

+
-
+

-
+






-
+
-


+
-
+

-
+






-
+
-


+
-
+

-
+






-
+
-


+
-
+

-
+






-
+
-


+
-
-
+
+

-
-

+





-

+
-
-
+
+

-
-

+





-

+
-
-
-
+
+
+

-

-
+
-
-

+
-
-
-
+
+
+

-


-
+
-
-

+
-
+

-
+

-










-

+
-
-
+
+

-


-
+




-

+
-
-
+
+
-
-

+
-
+
+

-
-
-
+
+
+

-









-
+
-

+
-
-
+
+

-
-












+



-

+
-
-
+
+

-





-
+

-





-
-
+
+

-







-
+
-

+
-
-
+
+

-




-
+
-

+
-
-
+
+





-
+
-

+
-
+
+
+








-
+








+
-
+
+




















-
+

-

-
+
-

+
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    chan configure $f1 -blocking on
    lappend x [chan configure $f1 -blocking]
    lappend x [chan gets $f1]
    lappend x [chan blocked $f1]
    lappend x [chan eof $f1]
    lappend x [chan gets $f1]
    lappend x [chan eof $f1]
} -cleanup {
    chan close $f1
    set x
} -result {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} -setup {
} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -buffersize -10
    chan configure $f -buffersize
    set x [chan configure $f -buffersize]
} -cleanup {
    chan close $f
    set x
} -result 1
test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} -setup {
} 1
test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -buffersize 10000000
    chan configure $f -buffersize
    set x [chan configure $f -buffersize]
} -cleanup {
    chan close $f
    set x
} -result 1048576
test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} -setup {
} 1048576
test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -buffersize 40000
    chan configure $f -buffersize
    set x [chan configure $f -buffersize]
} -cleanup {
    chan close $f
    set x
} -result 40000
test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
} 40000
test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -encoding {}
    chan puts -nonewline $f \xe7\x89\xa6
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -encoding utf-8
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result \u7266
test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
} \u7266
test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    chan configure $f -encoding binary
    chan puts -nonewline $f \xe7\x89\xa6
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -encoding utf-8
    chan read $f
    set x [chan read $f]
} -cleanup {
    chan close $f
    set x
} -result \u7266
test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
} \u7266
test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
    file delete $path(test1)
    set f [open $path(test1) w]
} -body {
    chan configure $f -encoding foobar
    set result [list [catch {chan configure $f -encoding foobar} msg] $msg]
} -returnCodes error -cleanup {
    chan close $f
    set result
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
} {1 {unknown encoding "foobar"}}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} {
    variable x {}
} -constraints {stdio fileevent} -body {
    set f [openpipe r+ $path(cat)]
    set f [open "|[list [interpreter] $path(cat)]" r+]
    chan configure $f -encoding binary
    chan puts -nonewline $f "\xe7"
    chan flush $f
    chan configure $f -encoding utf-8 -blocking 0
    variable x {}
    chan event $f readable [namespace code { lappend x [chan read $f] }]
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan configure $f -encoding utf-8
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    chan configure $f -encoding binary
    vwait [namespace which -variable x]
    after 300 [namespace code { lappend x timeout }]
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    chan close $f
    set x
} -result "{} timeout {} timeout \xe7 timeout"
} "{} timeout {} timeout \xe7 timeout"
test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
	-constraints {socket} -body {
	{socket} {
    proc accept {s a p} {chan close $s}
    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    set port [lindex [chan configure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    chan configure $s2 -translation {auto lf}
    chan configure $s2 -translation
    set modes [chan configure $s2 -translation]
} -cleanup {
    chan close $s1
    chan close $s2
    set modes
} -result {auto lf}
} {auto lf}
test chan-io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
	-constraints {socket} -body {
	{socket} {
    proc accept {s a p} {chan close $s}
    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    set port [lindex [chan configure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    chan configure $s2 -translation {auto crlf}
    chan configure $s2 -translation
    set modes [chan configure $s2 -translation]
} -cleanup {
    chan close $s1
    chan close $s2
    set modes
} -result {auto crlf}
} {auto crlf}
test chan-io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
	-constraints {socket} -body {
	{socket} {
    proc accept {s a p} {chan close $s}
    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    set port [lindex [chan configure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    chan configure $s2 -translation {auto cr}
    chan configure $s2 -translation
    set modes [chan configure $s2 -translation]
} -cleanup {
    chan close $s1
    chan close $s2
    set modes
} -result {auto cr}
} {auto cr}
test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
	-constraints {socket} -body {
	{socket} {
    proc accept {s a p} {chan close $s}
    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    set port [lindex [chan configure $s1 -sockname] 2]
    set s2 [socket 127.0.0.1 $port]
    update
    chan configure $s2 -translation {auto auto}
    chan configure $s2 -translation
    set modes [chan configure $s2 -translation]
} -cleanup {
    chan close $s1
    chan close $s2
    set modes
} -result {auto crlf}
test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
} {auto crlf}
test chan-io-39.22 {Tcl_SetChannelOption, invariance} {unix} {
    file delete $path(test1)
    set l ""
} -constraints {unix} -body {
    set f1 [open $path(test1) w+]
    set l ""
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar {ON GO}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
    lappend l [chan configure $f1 -eofchar]
} -cleanup {
    chan close $f1
    set l
} -result {{{} {}} {O G} {D D}}
test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
} {{{} {}} {O G} {D D}}
test chan-io-39.22a {Tcl_SetChannelOption, invariance} {
    file delete $path(test1)
    set l [list]
} -body {
    set f1 [open $path(test1) w+]
    set l [list]
    chan configure $f1 -eofchar {ON GO}
    lappend l [chan configure $f1 -eofchar]
    chan configure $f1 -eofchar D
    lappend l [chan configure $f1 -eofchar]
    lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg]
} -cleanup {
    chan close $f1
    set l
} -result {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\
        writeable, it should still have valid -eofchar and -translation options} -setup {
} {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or
        writeable, it should still have valid -eofchar and -translation options } {
    set l [list]
} -body {
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    lappend l [chan configure $sock -eofchar] \
    lappend l [chan configure $sock -eofchar] [chan configure $sock -translation]
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock
    set l
} -result {{{}} auto}
test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\
        writable so we can't change -eofchar or -translation} -setup {
} {{{}} auto}
test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or
        writable so we can't change -eofchar or -translation } {
    set l [list]
} -body {
    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    chan configure $sock -eofchar D -translation lf
    lappend l [chan configure $sock -eofchar] \
    lappend l [chan configure $sock -eofchar] [chan configure $sock -translation]
	[chan configure $sock -translation]
} -cleanup {
    chan close $sock
    set l
} -result {{{}} auto}
} {{{}} auto}

test chan-io-40.1 {POSIX open access modes: RDWR} -setup {
test chan-io-40.1 {POSIX open access modes: RDWR} {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan puts $f xyzzy
    chan close $f
    set f [open $path(test3) RDWR]
    chan puts -nonewline $f "ab"
    chan seek $f 0 current
    set x [chan gets $f]
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
} {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
} -constraints {unix} -body {
    set f [open $path(test3) {WRONLY CREAT} 0600]
    file stat $path(test3) stats
    set x [format "%#o" [expr $stats(mode)&0o777]]
    set x [format "0%o" [expr $stats(mode)&0o777]]
    chan puts $f "line 1"
    chan close $f
    set f [open $path(test3) r]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
} {0600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    file delete $path(test3)
} -constraints {unix umask} -body {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    chan close [open $path(test3) {WRONLY CREAT}]
    set f [open $path(test3) {WRONLY CREAT}]
    chan close $f
    file stat $path(test3) stats
    format "%#o" [expr $stats(mode)&0o777]
} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
    format "0%o" [expr $stats(mode)&0o777]
} [format %04o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan configure $f -eofchar {}
    chan puts $f xyzzy
    chan close $f
    set f [open $path(test3) {WRONLY CREAT}]
    chan configure $f -eofchar {}
    chan puts -nonewline $f "ab"
    chan close $f
    set f [open $path(test3) r]
    chan gets $f
    set x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result abzzy
test chan-io-40.5 {POSIX open access modes: APPEND} -setup {
} abzzy
test chan-io-40.5 {POSIX open access modes: APPEND} {
    file delete $path(test3)
    set x ""
} -body {
    set f [open $path(test3) w]
    chan configure $f -translation lf -eofchar {}
    chan puts $f xyzzy
    chan close $f
    set f [open $path(test3) {WRONLY APPEND}]
    chan configure $f -translation lf
    chan puts $f "new line"
    chan seek $f 0
    chan puts $f "abc"
    chan close $f
    set f [open $path(test3) r]
    chan configure $f -translation lf
    set x ""
    chan seek $f 6 current
    lappend x [chan gets $f]
    lappend x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result {{new line} abc}
test chan-io-40.6 {POSIX open access modes: EXCL} -match regexp -setup {
} {{new line} abc}
test chan-io-40.6 {POSIX open access modes: EXCL} -match regexp -body {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan puts $f xyzzy
    chan close $f
    open $path(test3) {WRONLY CREAT EXCL}
} -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists}
test chan-io-40.7 {POSIX open access modes: EXCL} -setup {
test chan-io-40.7 {POSIX open access modes: EXCL} {
    file delete $path(test3)
} -body {
    set f [open $path(test3) {WRONLY CREAT EXCL}]
    chan configure $f -eofchar {}
    chan puts $f "A test line"
    chan close $f
    viewFile test3
} -result {A test line}
test chan-io-40.8 {POSIX open access modes: TRUNC} -setup {
} {A test line}
test chan-io-40.8 {POSIX open access modes: TRUNC} {
    file delete $path(test3)
} -body {
    set f [open $path(test3) w]
    chan puts $f xyzzy
    chan close $f
    set f [open $path(test3) {WRONLY TRUNC}]
    chan puts $f abc
    chan close $f
    set f [open $path(test3) r]
    chan gets $f
    set x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result abc
test chan-io-40.9 {POSIX open access modes: NONBLOCK} -setup {
} abc
test chan-io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable unix} {
    file delete $path(test3)
} -constraints {nonPortable unix} -body {
    set f [open $path(test3) {WRONLY NONBLOCK CREAT}]
    chan puts $f "NONBLOCK test"
    chan close $f
    set f [open $path(test3) r]
    chan gets $f
    set x [chan gets $f]
} -cleanup {
    chan close $f
    set x
} -result {NONBLOCK test}
test chan-io-40.10 {POSIX open access modes: RDONLY} -body {
} {NONBLOCK test}
test chan-io-40.10 {POSIX open access modes: RDONLY} {
    set f [open $path(test1) w]
    chan puts $f "two lines: this one"
    chan puts $f "and this"
    chan close $f
    set f [open $path(test1) RDONLY]
    list [chan gets $f] [catch {chan puts $f Test} msg] $msg
    set x [list [chan gets $f] [catch {chan puts $f Test} msg] $msg]
} -cleanup {
    chan close $f
    string compare [string tolower $x] \
} -match glob -result {{two lines: this one} 1 {channel "*" wasn't opened for writing}}
	[list {two lines: this one} 1 \
		[format "channel \"%s\" wasn't opened for writing" $f]]
} 0
test chan-io-40.11 {POSIX open access modes: RDONLY} -match regexp -body {
    file delete $path(test3)
    open $path(test3) RDONLY
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test chan-io-40.12 {POSIX open access modes: WRONLY} -match regexp -body {
    file delete $path(test3)
    open $path(test3) WRONLY
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test chan-io-40.13 {POSIX open access modes: WRONLY} -body {
test chan-io-40.13 {POSIX open access modes: WRONLY} {
    makeFile xyzzy test3
    set f [open $path(test3) WRONLY]
    chan configure $f -eofchar {}
    chan puts -nonewline $f "ab"
    chan seek $f 0 current
    set x [list [catch {chan gets $f} msg] $msg]
    chan close $f
    lappend x [viewFile test3]
    string compare [string tolower $x] \
} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
	[list 1 "channel \"$f\" wasn't opened for reading" abzzy]
} 0
test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
    file delete $path(test3)
    open $path(test3) RDWR
} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
test chan-io-40.15 {POSIX open access modes: RDWR} {
    makeFile xyzzy test3
    set f [open $path(test3) RDWR]
    chan puts -nonewline $f "ab"
    chan seek $f 0 current
    set x [chan gets $f]
    chan close $f
    lappend x [viewFile test3]
} {zzy abzzy}
test chan-io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup {
    makeFile {Some text} _test_ ~
} -body {
    file exists [file join $::env(HOME) _test_]
} -cleanup {
    removeFile _test_ ~
} -result 1
test chan-io-40.17 {tilde substitution in open} -setup {
test chan-io-40.17 {tilde substitution in open} {
    set home $::env(HOME)
} -body {
    unset ::env(HOME)
    open ~/foo
    set x [list [catch {open ~/foo} msg] $msg]
} -returnCodes error -cleanup {
    set ::env(HOME) $home
    set x
} -result {couldn't find HOME environment variable to expand path}
} {1 {couldn't find HOME environment variable to expand path}}

test chan-io-41.1 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
    chan event foo
} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"}
test chan-io-41.2 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
    chan event foo bar baz q
} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"}
test chan-io-41.3 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
    chan event gorp readable
} -returnCodes error -result {can not find channel named "gorp"}
test chan-io-41.4 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
    chan event gorp writable
} -returnCodes error -result {can not find channel named "gorp"}
test chan-io-41.5 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
    chan event gorp who-knows
} -returnCodes error -result {bad event name "who-knows": must be readable or writable}
test chan-io-41.1 {Tcl_FileeventCmd: errors} {fileevent} {
    list [catch {chan event foo} msg] $msg
} {1 {wrong # args: should be "chan event channelId event ?script?"}}
test chan-io-41.2 {Tcl_FileeventCmd: errors} {fileevent} {
    list [catch {chan event foo bar baz q} msg] $msg
} {1 {wrong # args: should be "chan event channelId event ?script?"}}
test chan-io-41.3 {Tcl_FileeventCmd: errors} {fileevent} {
    list [catch {chan event gorp readable} msg] $msg
} {1 {can not find channel named "gorp"}}
test chan-io-41.4 {Tcl_FileeventCmd: errors} {fileevent} {
    list [catch {chan event gorp writable} msg] $msg
} {1 {can not find channel named "gorp"}}
test chan-io-41.5 {Tcl_FileeventCmd: errors} {fileevent} {
    list [catch {chan event gorp who-knows} msg] $msg
} {1 {bad event name "who-knows": must be readable or writable}}

#
# Test chan event on a file
#

set path(foo) [makeFile {} foo]
set f [open $path(foo) w+]
5537
5538
5539
5540
5541
5542
5543

5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558

5559
5560
5561
5562
5563
5564
5565
5566
5567
5568
5569
5570
5571
5572
5573
5574
5575
5576
5577
5578
5579
5580

5581
5582
5583
5584
5585
5586
5587

5588
5589
5590
5591
5592



5593
5594
5595
5596
5597
5598
5599
5600

5601
5602
5603
5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614

5615
5616
5617
5618
5619
5620
5621
5622
5623
5624
5625
5626
5627

5628
5629
5630
5631
5632



5633
5634
5635
5636
5637
5638
5639
5640

5641
5642
5643
5644
5645
5646
5647
5648
5649
5650

5651
5652
5653

5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667

5668

5669
5670
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681

5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
5692
5693
5694



5695
5696
5697
5698
5699
5700
5701
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396

5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415

5416
5417
5418
5419
5420
5421
5422

5423
5424
5425
5426
5427

5428
5429
5430
5431
5432
5433
5434
5435
5436
5437

5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451

5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464

5465
5466
5467
5468
5469

5470
5471
5472
5473
5474
5475
5476
5477
5478
5479

5480
5481
5482
5483
5484
5485
5486
5487
5488
5489

5490



5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502


5503
5504

5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517

5518


5519
5520
5521
5522
5523
5524
5525
5526



5527
5528
5529
5530
5531
5532
5533
5534
5535
5536







+















+

-



















-
+






-
+




-
+
+
+







-
+













-
+












-
+




-
+
+
+







-
+









-
+
-
-
-
+











-
-

+
-
+












-
+
-
-








-
-
-
+
+
+







    chan event $f r "new scr\0ipt"
    lappend result [string length [chan event $f readable]]
    chan event $f r "yet ano\0ther"
    lappend result [string length [chan event $f readable]]
    chan event $f r ""
    lappend result [chan event $f readable]
} {13 11 12 {}}


test chan-io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
    set result {}
    chan event $f readable "script 1"
    lappend result [chan event $f readable] [chan event $f writable]
    chan event $f writable "write script"
    lappend result [chan event $f readable] [chan event $f writable]
    chan event $f readable {}
    lappend result [chan event $f readable] [chan event $f writable]
    chan event $f writable {}
    lappend result [chan event $f readable] [chan event $f writable]
} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
} -constraints {stdio unixExecs fileevent openpipe} -body {
    set result {}
} -constraints {stdio unixExecs fileevent} -body {
    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
    chan event $f r "chan read f"
    chan event $f2 r "chan read f2"
    chan event $f3 r "chan read f3"
    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
    chan event $f2 r {}
    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
    chan event $f3 r {}
    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
    chan event $f r {}
    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
} -cleanup {
    catch {chan close $f2}
    catch {chan close $f3}
} -result {{} {} {} {chan read f} {chan read f2} {chan read f3} {chan read f} {} {chan read f3} {chan read f} {} {} {} {} {}}

test chan-io-44.1 {FileEventProc procedure: normal read event} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
} -constraints {stdio unixExecs fileevent} -body {
} -constraints {stdio unixExecs fileevent openpipe} -body {
    chan event $f2 readable [namespace code {
	set x [chan gets $f2]; chan event $f2 readable {}
    }]
    chan puts $f2 text; chan flush $f2
    variable x initial
    vwait [namespace which -variable x]
    return $x
    set x
} -cleanup {
    catch {chan close $f2}
    catch {chan close $f3}
} -result {text}
test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
test chan-io-44.2 {FileEventProc procedure: error in read event} -constraints {
    stdio unixExecs fileevent openpipe
} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
} -constraints {stdio unixExecs fileevent} -body {
} -body {
    chan event $f2 readable {error bogus}
    chan puts $f2 text; chan flush $f2
    variable x initial
    vwait [namespace which -variable x]
    list $x [chan event $f2 readable]
} -cleanup {
    interp bgerror {} $handler
    catch {chan close $f2}
    catch {chan close $f3}
} -result {bogus {}}
test chan-io-44.3 {FileEventProc procedure: normal write event} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
} -constraints {stdio unixExecs fileevent} -body {
} -constraints {stdio unixExecs fileevent openpipe} -body {
    chan event $f2 writable [namespace code {
	lappend x "triggered"
	incr count -1
	if {$count <= 0} {
	    chan event $f2 writable {}
	}
    }]
    variable x initial
    set count 3
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    return $x
    set x
} -cleanup {
    catch {chan close $f2}
    catch {chan close $f3}
} -result {initial triggered triggered triggered}
test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
test chan-io-44.4 {FileEventProc procedure: eror in write event} -constraints {
    stdio unixExecs fileevent openpipe
} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
} -constraints {stdio unixExecs fileevent} -body {
} -body {
    chan event $f2 writable {error bad-write}
    variable x initial
    vwait [namespace which -variable x]
    list $x [chan event $f2 writable]
} -cleanup {
    interp bgerror {} $handler
    catch {chan close $f2}
    catch {chan close $f3}
} -result {bad-write {}}
test chan-io-44.5 {FileEventProc procedure: end of file} -constraints {
test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
    stdio unixExecs fileevent
} -body {
    set f4 [openpipe r $path(cat) << foo]
    set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
    chan event $f4 readable [namespace code {
	if {[chan gets $f4 line] < 0} {
	    lappend x eof
	    chan event $f4 readable {}
	} else {
	    lappend x $line
	}
    }]
    variable x initial
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    set x
} -cleanup {
    chan close $f4
    set x
} -result {initial foo eof}
} {initial foo eof}

chan close $f
makeFile "foo bar" foo

test chan-io-45.1 {DeleteFileEvent, cleanup on chan close} {fileevent} {
    set f [open $path(foo) r]
    chan event $f readable [namespace code {
	lappend x "binding triggered: \"[chan gets $f]\""
	chan event $f readable {}
    }]
    chan close $f
    set x initial
    after 100 [namespace code {
    after 100 [namespace code { set y done }]
	set y done
    }]
    variable y
    vwait [namespace which -variable y]
    set x
} {initial}
test chan-io-45.2 {DeleteFileEvent, cleanup on chan close} {fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    chan event $f readable [namespace code {
	lappend x "f triggered: \"[chan gets $f]\""
	chan event $f readable {}
    }]
	    lappend x "f triggered: \"[chan gets $f]\""
	    chan event $f readable {}
	}]
    chan event $f2 readable [namespace code {
	lappend x "f2 triggered: \"[chan gets $f2]\""
	chan event $f2 readable {}
    }]
    chan close $f
    variable x initial
    vwait [namespace which -variable x]
5722
5723
5724
5725
5726
5727
5728
5729

5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740

5741

5742
5743
5744
5745
5746
5747
5748
5749
5557
5558
5559
5560
5561
5562
5563

5564
5565
5566
5567
5568
5569
5570
5571
5572
5573

5574
5575

5576

5577
5578
5579
5580
5581
5582
5583







-
+









-

+
-
+
-







    lappend x [catch {chan event $f readable}] \
	    [catch {chan event $f2 readable}] \
	    [catch {chan event $f3 readable}]
} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}

# Execute these tests only if the "testfevent" command is present.

test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} {
test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
    testfevent create
    set script "set f \[[list open $path(foo) r]]\n"
    append script {
	set x "no event"
	chan event $f readable [namespace code {
	    set x "f triggered: [chan gets $f]"
	    chan event $f readable {}
	}]
    }
    set timer [after 10 lappend x timeout]
    testfevent cmd $script
    after 1	;# We must delay because Windows takes a little time to notice
    vwait x
    update
    after cancel $timer
    testfevent cmd {chan close $f}
    list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
test chan-io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
    testfevent create
    testfevent cmd {
        variable x 0
5762
5763
5764
5765
5766
5767
5768
5769

5770
5771
5772
5773
5774
5775
5776
5777
5778
5779

5780
5781
5782
5783
5784
5785
5786
5787

5788
5789


5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804


5805
5806
5807
5808
5809

5810
5811


5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826


5827
5828
5829
5830
5831

5832
5833


5834
5835
5836
5837
5838
5839
5840
5841

5842
5843


5844
5845
5846
5847

5848
5849


5850
5851
5852
5853
5854
5855
5856
5857
5858


5859
5860

5861
5862


5863
5864
5865
5866
5867
5868
5869
5870
5871


5872
5873

5874

5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889




5890
5891
5892
5893
5894
5895
5896
5897

5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912





5913
5914
5915
5916
5917
5918
5919
5920
5921

5922
5923
5924
5925
5926
5927
5928

5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950







5951
5952
5953
5954
5955
5956
5957
5958
5959
5960


5961
5962
5963
5964
5965
5966
5967
5968
5969
5970

5971

5972
5973
5974
5975

5976

















5977
5978








5979

5980
5981

5982

5983


































































































5984
5985
5986
















5987
5988
5989
5990
5991
5992
5993
























5994


































































5995
5996
5997
5998
5999


6000
6001
6002
6003
6004
6005
6006



6007
6008
6009
6010




6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024

6025
6026
6027
6028
6029
6030
6031
6032
6033
6034


6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047


6048
6049
6050
6051
6052
6053
6054



6055
6056
6057
6058




6059
6060
6061
6062
6063
6064
6065
6066
6067
6068
6069
6070
6071
6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089

6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103
6104
6105
6106


6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118
6119


6120
6121
6122
6123
6124
6125
6126



6127
6128
6129
6130




6131
6132
6133
6134
6135
6136
6137
6138
6139
6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153
6154
6155
6156
6157
6158
6159
6160
6161

6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173


6174
6175
6176
6177
6178

6179
6180
6181
6182
6183
6184
6185
6186
6187
6188
6189
6190

6191
6192
6193
6194
6195
6196
6197
6198
6199
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209

6210
6211
6212
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240
6241
6242
6243
6244
6245
6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258
6259
6260
6261
6262
6263
6264

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
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
6390
6391
6392




6393
6394
6395
6396
6397
6398
6399



6400

6401
6402


6403

6404
6405
6406




6407
6408
6409
6410
6411
6412
6413
6414

6415
6416
6417
6418

6419
6420
6421

6422
6423

6424
6425
6426

6427

6428
6429





6430
6431
6432
6433
6434
6435
6436
6437
6438
6439
6440
6441
6442
6443

6444
6445
6446
6447

6448
6449
6450

6451
6452
6453

6454
6455
6456

6457
6458
6459
6460
6461
6462
6463





6464
6465
6466
6467
6468
6469
6470
6471

6472
6473
6474
6475
6476
6477
6478

6479
6480
6481
6482




6483
6484
6485
6486
6487



6488
6489
6490
6491
6492
6493
6494
6495

6496
6497
6498
6499
6500
6501
6502
6503
6504
6505

6506
6507
6508
6509
6510
6511
6512
6513
6514
6515
6516
6517
6518
6519
6520
6521
6522

6523
6524
6525
6526
6527





6528
6529
6530

6531


6532
6533
6534
6535

6536
6537
6538
6539
6540

6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551

6552
6553
6554
6555

6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574

6575

6576
6577
6578




6579
6580

6581
6582


6583
6584









6585
6586
6587
6588
6589
6590

6591
6592
6593
6594
6595
6596
6597


6598
6599
6600
6601


6602
6603
6604
6605


6606
6607
6608
6609
6610
6611

6612

6613
6614

6615
6616
6617
6618
6619
6620


6621
6622
6623
6624
6625



6626
6627
6628
6629
6630
6631
6632


6633
6634
6635
6636
6637
6638



6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651

6652
6653
6654
6655
6656



6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668
6669


6670
6671
6672
6673
6674
6675
6676
6677
6678
6679

6680


6681
6682
6683
6684
6685



6686
6687
6688
6689
6690
6691
6692
6693
6694
6695

6696


6697
6698
6699
6700
6701



6702
6703
6704
6705
6706
6707
6708
6709
6710
6711

6712


6713
6714
6715
6716
6717



6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728
6729
6730

6731
6732
6733
6734
6735



6736
6737
6738
6739
6740
6741
6742
6743

6744




6745
6746
6747

6748
6749
6750
6751
6752


6753
6754
6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767

6768
6769
6770
6771
6772
6773
6774
6775
6776
6777
6778

6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789

6790
6791

6792
6793

6794
6795
6796

6797

6798
6799

6800
6801

6802

6803
6804

6805
6806
6807
6808
6809
6810



6811
6812

6813
6814
6815

6816
6817
6818

6819
6820
6821

6822
6823
6824
6825
6826
6827
6828



6829
6830

6831
6832
6833

6834
6835
6836

6837
6838

6839
6840

6841
6842
6843
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853


6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867
6868

6869
6870
6871
6872
6873



6874
6875
6876
6877
6878
6879
6880

6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891

6892
6893
6894
6895
6896
6897
6898
6899
6900
6901
6902
6903
6904

6905
6906


6907
6908
6909
6910
6911
6912
6913
6914
6915
6916
6917
6918
6919
6920
6921
6922
6923
6924
6925
6926

6927
6928
6929
6930
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940

6941
6942
6943
6944


6945
6946
6947
6948
6949
6950
6951
5596
5597
5598
5599
5600
5601
5602

5603
5604
5605
5606


5607
5608
5609
5610
5611
5612
5613
5614
5615
5616

5617
5618
5619
5620


5621
5622
5623
5624
5625
5626

5627
5628
5629
5630
5631
5632
5633
5634


5635
5636

5637
5638
5639
5640
5641


5642
5643
5644
5645
5646
5647

5648
5649
5650
5651
5652
5653
5654
5655


5656
5657

5658
5659
5660
5661
5662


5663
5664
5665
5666

5667
5668
5669
5670
5671
5672


5673
5674

5675
5676
5677
5678


5679
5680
5681

5682
5683
5684
5685
5686


5687
5688
5689
5690
5691


5692
5693
5694

5695
5696
5697
5698
5699


5700
5701
5702
5703
5704

5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717
5718
5719

5720
5721
5722
5723
5724
5725
5726
5727
5728
5729
5730

5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745

5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757


5758
5759
5760
5761
5762
5763
5764

5765


5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783


5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798


5799
5800

5801
5802
5803
5804
5805
5806


5807
5808

5809
5810
5811
5812

5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841

5842
5843
5844
5845

5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898
5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947

5948
5949
5950
5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967
5968
5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994

5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063


6064
6065
6066



6067


6068
6069
6070
6071



6072
6073
6074
6075
6076
6077
6078
6079
6080
6081
6082







6083
6084
6085





6086


6087
6088








6089
6090
6091


6092
6093
6094



6095


6096
6097
6098
6099



6100
6101
6102
6103
6104
6105
6106
6107
6108
6109
6110
























6111







6112
6113





6114


6115
6116








6117
6118
6119


6120
6121
6122



6123


6124
6125
6126
6127



6128
6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
























6139







6140
6141



6142
6143





6144








6145
6146
6147

6148



















6149























































6150
6151


6152
6153
6154
6155
6156
6157
6158
6159
6160
6161
6162
6163
6164
6165
6166
6167
6168
6169
6170
6171
6172
6173
6174

6175
6176

6177
6178

6179
6180


6181
6182
6183
6184
6185
6186
6187
6188
6189
6190
6191
6192
6193
6194
6195
6196
6197
6198

6199
6200


6201
6202
6203


6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
6215
6216
6217
6218
6219

6220
6221


6222
6223
6224


6225
6226
6227
6228
6229
6230
6231
6232
6233
6234
6235
6236
6237
6238
6239
6240

6241
6242


6243
6244
6245


6246
6247
6248
6249
6250
6251
6252
6253
6254
6255
6256
6257
6258

6259
6260

6261
6262

6263
6264

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
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
6390
6391

6392
6393


6394

6395


6396
6397
6398
6399
6400
6401
6402
6403

6404
6405
6406
6407

6408
6409
6410
6411
6412
6413
6414
6415
6416
6417










6418
6419
6420



6421
6422
6423
6424
6425

6426
6427
6428
6429
6430


6431
6432
6433
6434
6435
6436
6437
6438
6439






6440



6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461

6462
6463
6464

6465
6466

6467
6468

6469
6470


6471
6472

6473
6474


6475
6476
6477
6478

6479
6480
6481


6482
6483

6484
6485
6486


6487
6488
6489
6490

6491
6492
6493
6494
6495
6496
6497
6498
6499
6500

6501
6502
6503



6504
6505
6506
6507

6508
6509
6510
6511
6512
6513
6514
6515
6516


6517
6518
6519

6520
6521
6522
6523
6524
6525
6526
6527
6528

6529
6530
6531
6532



6533
6534
6535
6536

6537
6538
6539
6540
6541
6542
6543
6544
6545

6546
6547
6548
6549



6550
6551
6552
6553

6554
6555
6556
6557
6558
6559
6560
6561
6562

6563
6564
6565
6566



6567
6568
6569
6570

6571
6572
6573
6574
6575
6576
6577
6578
6579
6580

6581
6582
6583



6584
6585
6586
6587

6588
6589
6590
6591
6592
6593
6594

6595
6596
6597
6598
6599
6600

6601





6602
6603
6604
6605

6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
6616

6617
6618
6619
6620
6621
6622
6623
6624
6625
6626
6627

6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
6644
6645
6646
6647
6648
6649
6650
6651
6652
6653
6654
6655
6656
6657
6658
6659
6660
6661
6662
6663
6664
6665
6666
6667
6668

6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684

6685







6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696
6697
6698
6699
6700

6701
6702

6703
6704

6705
6706
6707
6708
6709
6710
6711
6712
6713


6714
6715
6716

6717
6718
6719
6720
6721
6722
6723
6724
6725
6726
6727
6728

6729
6730
6731



6732
6733
6734
6735
6736

6737
6738
6739

6740
6741
6742
6743
6744
6745
6746
6747
6748
6749
6750

6751
6752
6753
6754
6755
6756
6757
6758
6759
6760
6761
6762

6763
6764


6765
6766
6767
6768
6769
6770
6771
6772
6773

6774
6775
6776
6777
6778
6779
6780
6781
6782
6783
6784

6785
6786
6787
6788
6789
6790
6791
6792
6793
6794
6795
6796
6797
6798

6799

6800


6801
6802
6803
6804
6805
6806
6807
6808
6809







-
+



-
-





+




-



+
-
-
+
+




-








-
-
+
+
-




+
-
-
+
+




-








-
-
+
+
-




+
-
-
+
+


-





+
-
-
+
+
-



+
-
-
+
+

-





-
-
+
+


+
-
-
+
+

-





-
-
+
+


+
-
+














-
+
+
+
+







-
+














-
+
+
+
+
+







-
-
+






-
+
-
-


















-
-
+
+
+
+
+
+
+








-
-
+
+
-






-
-

+
-
+



-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
-
+


+
-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+

-
-
-

-
-
+
+
+

-
-
-
+
+
+
+







-
-
-
-
-
-
-
+


-
-
-
-
-

-
-
+
+
-
-
-
-
-
-
-
-



-
-
+
+

-
-
-

-
-
+
+
+

-
-
-
+
+
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-


-
-
-
-
-

-
-
+
+
-
-
-
-
-
-
-
-



-
-
+
+

-
-
-

-
-
+
+
+

-
-
-
+
+
+
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-


-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-



-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-





+

















-

+
-
+

-
+

-
-





+












-

+
-
-
+
+

-
-





+










-

+
-
-
+
+

-
-





+










-

+
-
-
+
+

-
-





+







-

+
-
+

-
+

-



-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+

+
-
-
+
+

+
-
-
-
+
+
+
+






-
-
+
-
-
-
-
+
-
-
-
+

-
+
-
-
-
+

+
-
-
+
+
+
+
+












-
-
+
-
-
-
-
+
-
-
-
+


-
+
-
-
-
+



-

-
-
+
+
+
+
+







-
+


-
-
-
-
-
+

-
-
-
+
+
+
+



-
-
+
+
+







-
+







-
-
-
+
-
-





-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
+
+
+
+
+



+
-
+
+



-
+

-
-

-
+
-
-








-
+



-
+









-
-
-
-
-
-
-
-
-
-
+

+
-
-
-
+
+
+
+

-
+


+
+
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
-
-
-




+
+




+
+




+
+



-


+
-
+

-
+

-


-
-
+
+
-


-
-
+
+
+

-



-
-
+
+
-



-
-
+
+
+

-










-
+


-
-
-
+
+
+

-









-
-
+
+

-








+
-
+
+


-
-
-
+
+
+

-








+
-
+
+


-
-
-
+
+
+

-








+
-
+
+


-
-
-
+
+
+

-










-
+


-
-
-
+
+
+

-






+
-
+
+
+
+


-
+
-
-
-
-
-
+
+


-











-
+










-
+











+


+


+



+

+


+


+

+


+





-
+
+
+


+



+



+


-
+
-
-
-
-
-
-
-
+
+
+


+



+



+

-
+

-
+

-









-
-
+
+

-












-
+


-
-
-
+
+
+


-



-
+










-
+











-

+
-
-
+
+







-











-
+













-
+
-

-
-
+
+







        update idletasks
        lappend result $x
        update
        lappend result $x
    }
} {0 0 {0 timer}}

test chan-io-47.1 {chan event vs multiple interpreters} -setup {
test chan-io-47.1 {chan event vs multiple interpreters} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    set x {}
} -constraints {testfevent fileevent} -body {
    chan event $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent cmd "chan event $f2 readable {script 2}"
    chan event $f3 readable {sript 3}
    set x {}
    lappend x [chan event $f2 readable]
    testfevent delete
    lappend x [chan event $f readable] [chan event $f2 readable] \
        [chan event $f3 readable]
} -cleanup {
    chan close $f
    chan close $f2
    chan close $f3
    set x
} -result {{} {script 1} {} {sript 3}}
test chan-io-47.2 {deleting chan event on interpreter delete} -setup {
} {{} {script 1} {} {sript 3}}
test chan-io-47.2 {deleting chan event on interpreter delete} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    set f4 [open $path(foo) r]
} -constraints {testfevent fileevent} -body {
    chan event $f readable {script 1}
    testfevent create
    testfevent share $f2
    testfevent share $f3
    testfevent cmd "chan event $f2 readable {script 2}
        chan event $f3 readable {script 3}"
    chan event $f4 readable {script 4}
    testfevent delete
    list [chan event $f readable] [chan event $f2 readable] \
	[chan event $f3 readable] [chan event $f4 readable]
    set x [list [chan event $f readable] [chan event $f2 readable] \
                [chan event $f3 readable] [chan event $f4 readable]]
} -cleanup {
    chan close $f
    chan close $f2
    chan close $f3
    chan close $f4
    set x
} -result {{script 1} {} {} {script 4}}
test chan-io-47.3 {deleting chan event on interpreter delete} -setup {
} {{script 1} {} {} {script 4}}
test chan-io-47.3 {deleting chan event on interpreter delete} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
    set f3 [open $path(foo) r]
    set f4 [open $path(foo) r]
} -constraints {testfevent fileevent} -body {
    testfevent create
    testfevent share $f3
    testfevent share $f4
    chan event $f readable {script 1}
    chan event $f2 readable {script 2}
    testfevent cmd "chan event $f3 readable {script 3}
      chan event $f4 readable {script 4}"
    testfevent delete
    list [chan event $f readable] [chan event $f2 readable] \
	[chan event $f3 readable] [chan event $f4 readable]
    set x [list [chan event $f readable] [chan event $f2 readable] \
                [chan event $f3 readable] [chan event $f4 readable]]
} -cleanup {
    chan close $f
    chan close $f2
    chan close $f3
    chan close $f4
    set x
} -result {{script 1} {script 2} {} {}}
test chan-io-47.4 {file events on shared files and multiple interpreters} -setup {
} {{script 1} {script 2} {} {}}
test chan-io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent} {
    set f  [open $path(foo) r]
    set f2 [open $path(foo) r]
} -constraints {testfevent fileevent} -body {
    testfevent create
    testfevent share $f
    testfevent cmd "chan event $f readable {script 1}"
    chan event $f readable {script 2}
    chan event $f2 readable {script 3}
    set x [list [chan event $f2 readable] \
    list [chan event $f2 readable] [testfevent cmd "chan event $f readable"] \
	[chan event $f readable]
                [testfevent cmd "chan event $f readable"] \
                [chan event $f readable]]
} -cleanup {
    testfevent delete
    chan close $f
    chan close $f2
    set x
} -result {{script 3} {script 1} {script 2}}
test chan-io-47.5 {file events on shared files, deleting file events} -setup {
} {{script 3} {script 1} {script 2}}
test chan-io-47.5 {file events on shared files, deleting file events} {testfevent fileevent} {
    set f [open $path(foo) r]
} -body {
    testfevent create
    testfevent share $f
    testfevent cmd "chan event $f readable {script 1}"
    chan event $f readable {script 2}
    testfevent cmd "chan event $f readable {}"
    list [testfevent cmd "chan event $f readable"] [chan event $f readable]
} -constraints {testfevent fileevent} -cleanup {
    set x [list [testfevent cmd "chan event $f readable"] \
                [chan event $f readable]]
    testfevent delete
    chan close $f
    set x
} -result {{} {script 2}}
test chan-io-47.6 {file events on shared files, deleting file events} -setup {
} {{} {script 2}}
test chan-io-47.6 {file events on shared files, deleting file events} {testfevent fileevent} {
    set f [open $path(foo) r]
} -body {
    testfevent create
    testfevent share $f
    testfevent cmd "chan event $f readable {script 1}"
    chan event $f readable {script 2}
    chan event $f readable {}
    list [testfevent cmd "chan event $f readable"] [chan event $f readable]
} -constraints {testfevent fileevent} -cleanup {
    set x [list [testfevent cmd "chan event $f readable"] \
                [chan event $f readable]]
    testfevent delete
    chan close $f
    set x
} -result {{script 1} {}}
} {{script 1} {}}
unset path(foo)
removeFile foo

set path(bar) [makeFile {} bar]

test chan-io-48.1 {testing readability conditions} {fileevent} {
    set f [open $path(bar) w]
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan close $f
    set f [open $path(bar) r]
    chan event $f readable [namespace code {
    chan event $f readable [namespace code [list consume $f]]
    proc consume {f} {
	variable l
	variable x
	lappend l called
	if {[chan eof $f]} {
	    chan close $f
	    set x done
	} else {
	    chan gets $f
	}
    }]
    }
    set l ""
    variable x not_done
    vwait [namespace which -variable x]
    list $x $l
} {done {called called called called called called called}}
test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
    set f [open $path(bar) w]
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan close $f
    set f [open $path(bar) r]
    chan event $f readable [namespace code {
    chan event $f readable [namespace code [list consume $f]]
    chan configure $f -blocking off
    proc consume {f} {
	variable x
	variable l
	lappend l called
	if {[chan eof $f]} {
	    chan close $f
	    set x done
	} else {
	    chan gets $f
	}
    }]
    chan configure $f -blocking off
    }
    set l ""
    variable x not_done
    vwait [namespace which -variable x]
    list $x $l
} {done {called called called called called called called}}
set path(my_script) [makeFile {} my_script]
test chan-io-48.3 {testing readability conditions} -setup {
test chan-io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe fileevent} {
    set l ""
} -constraints {stdio unix nonBlockFiles fileevent} -body {
    set f [open $path(bar) w]
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan puts $f abcdefg
    chan close $f
    set f [open $path(my_script) w]
    chan puts $f {
	proc copy_slowly {f} {
	    while {![chan eof $f]} {
		chan puts [chan gets $f]
		after 200
	    }
	    chan close $f
	}
    }
    chan close $f
    set f [openpipe]
    chan event $f readable [namespace code {
    set f [open "|[list [interpreter]]" r+]
    chan event  $f readable [namespace code [list consume $f]]
    chan configure $f -buffering line
    chan configure $f -blocking off
    proc consume {f} {
	variable l
	variable x
	if {[chan eof $f]} {
	    set x done
	} else {
	    chan gets $f
	    lappend l [chan blocked $f]
	    chan gets $f
	    lappend l [chan blocked $f]
	}
    }]
    chan configure $f -buffering line
    }
    set l ""
    chan configure $f -blocking off
    variable x not_done
    chan puts $f [list source $path(my_script)]
    chan puts $f "set f \[[list open $path(bar) r]]"
    chan puts $f {copy_slowly $f}
    chan puts $f {exit}
    vwait [namespace which -variable x]
    list $x $l
} -cleanup {
    chan close $f
    list $x $l
} -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
unset path(bar)
removeFile bar

test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    variable c [format "abc\ndef\n%c" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable c
	variable x
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {fileevent} {
} -constraints {fileevent} -body {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable x
	variable c
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set c [format "abc\ndef\n%c" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable x
	variable c
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable c
	variable x
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set c [format "abc\ndef\n%c" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable x
	variable c
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    chan event $f readable [namespace code {
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable c
	variable x
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable c
	variable x
	if {[chan eof $f]} {
	   set x done
	   chan close $f
    }]
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation lf
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation lf
    set c [format "abc\ndef\n%c" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable x
	variable c
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} {3 {abc def {}}}
test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {fileevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan puts -nonewline $f $c
    chan close $f
    proc consume {f} {
	variable l
	variable x
	variable c
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    set c 0
    set l ""
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation cr
    chan event $f readable [namespace code [list consume $f]]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} -setup {
} {3 {abc def {}}}
test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fileevent} {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan configure $f -translation cr
    set c [format "abc\ndef\n%c" 26]
    chan puts -nonewline $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan event $f readable [namespace code {
    proc consume {f} {
	variable c
	variable x
	variable l
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode} -setup {
    file delete $path(test1)
    }
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    chan event $f readable [namespace code {
    chan configure $f -translation cr -eofchar \x1a
    chan event $f readable [namespace code [list consume $f]]
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} -setup {
} {3 {abc def {}}}
test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {fileevent} {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan configure $f -translation crlf
    set c [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan puts -nonewline $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan event $f readable [namespace code {
    proc consume {f} {
	variable c
	variable x
	variable l
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation auto -eofchar \x1a
    chan event $f readable [namespace code {
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation auto
    chan event $f readable [namespace code {
    chan configure $f -eofchar \x1a -translation crlf
    chan event $f readable [namespace code [list consume $f]]
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} -setup {
} {3 {abc def {}}}
test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {fileevent} {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan configure $f -translation crlf
    set c [format "abc\ndef\n%c" 26]
    chan puts -nonewline $f $c
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation lf
    chan event $f readable [namespace code {
    proc consume {f} {
	variable c
	variable x
	variable l
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation lf -eofchar \x1a
    chan event $f readable [namespace code {
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1a
    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation cr
    chan event $f readable [namespace code {
    chan event $f readable [namespace code [list consume $f]]
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
} {3 {abc def {}}}
test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation cr
    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation cr -eofchar \x1a
    chan event $f readable [namespace code {
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}

    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -eofchar \x1a -translation crlf
    chan event $f readable [namespace code {
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}
test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} -setup {
    file delete $path(test1)
    set c 0
    set l ""
} -constraints {fileevent} -body {
    set f [open $path(test1) w]
    chan configure $f -translation crlf
    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
    chan close $f
    set f [open $path(test1) r]
    chan configure $f -translation crlf -eofchar \x1a
    chan event $f readable [namespace code {
	if {[chan eof $f]} {
	   set x done
	   chan close $f
	} else {
	   lappend l [chan gets $f]
	   incr c
	}
    }]
    variable x
    vwait [namespace which -variable x]
    list $c $l
} -result {3 {abc def {}}}

test chan-io-49.1 {testing crlf reading, leftover cr disgorgment} -setup {
test chan-io-49.1 {testing crlf reading, leftover cr disgorgment} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\rb\rc\r\n"
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [file size $path(test1)]
    chan configure $f -translation crlf
    lappend l [chan read $f 1]
    lappend l [chan tell $f]
    lappend l [chan read $f 1]
    lappend l [chan tell $f]
    lappend l [chan read $f 1]
    lappend l [chan tell $f]
    lappend l [chan read $f 1]
    lappend l [chan tell $f]
    lappend l [chan read $f 1]
    lappend l [chan tell $f]
    lappend l [chan read $f 1]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
    lappend l [chan read $f 1]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
} "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
} 7 0 {} 1"
test chan-io-49.2 {testing crlf reading, leftover cr disgorgment} -setup {
test chan-io-49.2 {testing crlf reading, leftover cr disgorgment} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\rb\rc\r\n"
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [file size $path(test1)]
    chan configure $f -translation crlf
    lappend l [chan read $f 2]
    lappend l [chan tell $f]
    lappend l [chan read $f 2]
    lappend l [chan tell $f]
    lappend l [chan read $f 2]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
    lappend l [chan read $f 2]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
test chan-io-49.3 {testing crlf reading, leftover cr disgorgment} -setup {
} "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
test chan-io-49.3 {testing crlf reading, leftover cr disgorgment} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\rb\rc\r\n"
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [file size $path(test1)]
    chan configure $f -translation crlf
    lappend l [chan read $f 3]
    lappend l [chan tell $f]
    lappend l [chan read $f 3]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
    lappend l [chan read $f 3]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
test chan-io-49.4 {testing crlf reading, leftover cr disgorgment} -setup {
} "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
test chan-io-49.4 {testing crlf reading, leftover cr disgorgment} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\rb\rc\r\n"
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [file size $path(test1)]
    chan configure $f -translation crlf
    lappend l [chan read $f 3]
    lappend l [chan tell $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup {
} "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} {
    file delete $path(test1)
    set l ""
} -body {
    set f [open $path(test1) w]
    chan configure $f -translation lf
    chan puts -nonewline $f "a\rb\rc\r\n"
    chan close $f
    set f [open $path(test1) r]
    set l ""
    lappend l [file size $path(test1)]
    chan configure $f -translation crlf
    lappend l [set x [chan gets $f]]
    lappend l [chan tell $f]
    lappend l [chan gets $f]
    lappend l [chan tell $f]
    lappend l [chan eof $f]
} -cleanup {
    chan close $f
    set l
} -result [list 7 a\rb\rc 7 {} 7 1]
} [list 7 a\rb\rc 7 {} 7 1]

test chan-io-50.1 {testing handler deletion} -setup {
test chan-io-50.1 {testing handler deletion} {testchannelevent} {
    file delete $path(test1)
} -constraints testchannelevent -body {
    set f [open $path(test1) w]
    chan close $f
    set f [open $path(test1) r]
    variable z not_called
    set timer [after 50 lappend z timeout]
    testservicemode 0
    testchannelevent $f add readable [namespace code {
	variable z called
    testchannelevent $f add readable [namespace code [list delhandler $f]]
    proc delhandler {f} {
	variable z
	set z called
	testchannelevent $f delete 0
    }]
    testservicemode 1
    vwait z
    after cancel $timer
    set z
} -cleanup {
    }
    set z not_called
    update
    chan close $f
    set z
} -result called
test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
} called
test chan-io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan close [open $path(test1) w]
    set z ""
} -constraints {testchannelevent testservicemode} -body {
    chan close $f
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delhandler $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    proc delhandler {f i} {
	variable z
	lappend z "called delhandler $f $i"
	testchannelevent $f delete 0
    }
    set z ""
    set timer [after 50 lappend z timeout]
    testservicemode 0
    update
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delhandler $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    testservicemode 1
    chan close $f
    vwait z
    after cancel $timer
    string equal $z \
    string compare [string tolower $z] \
	[list [list called delhandler $f 0] [list called delhandler $f 1]]
} -cleanup {
} 0
    chan close $f
} -result 1
test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
test chan-io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan close [open $path(test1) w]
} -constraints {testchannelevent testservicemode} -body {
    chan close $f
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    set z ""
    proc notcalled {f i} {
	variable z
	lappend z "notcalled was called!! $f $i"
    }
    proc delhandler {f i} {
	variable z
	testchannelevent $f delete 1
	lappend z "delhandler $f $i called"
	testchannelevent $f delete 0
	lappend z "delhandler $f $i deleted myself"
    }
    set z ""
    set timer [after 50 lappend z timeout]
    testservicemode 0
    update
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    testservicemode 1
    chan close $f
    vwait z
    after cancel $timer
    string equal $z \
    string compare [string tolower $z] \
	[list [list delhandler $f 0 called] \
	      [list delhandler $f 0 deleted myself]]
} -cleanup {
} 0
    chan close $f
} -result 1
test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
test chan-io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan close $f
} -constraints testchannelevent -body {
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code {
	if {$u eq "recursive"} {
    testchannelevent $f add readable [namespace code [list delrecursive $f]]
    proc delrecursive {f} {
	variable z
	variable u
	if {"$u" == "recursive"} {
	    testchannelevent $f delete 0
	    lappend z "delrecursive deleting recursive"
	} else {
	    lappend z "delrecursive calling recursive"
	    set u recursive
	    update
	}
    }]
    }
    variable u toplevel
    variable z ""
    set timer [after 50 lappend z timeout]
    vwait z
    after cancel $timer
    set z
} -cleanup {
    update
    chan close $f
    update
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
    string compare [string tolower $z] \
	{{delrecursive calling recursive} {delrecursive deleting recursive}}
} 0
test chan-io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan close $f
    update
} -constraints {testchannelevent testservicemode notOSX} -body {
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f]]
    testchannelevent $f add readable [namespace code [list del $f]]
    proc notcalled {f} {
	variable z
	lappend z "notcalled was called!! $f"
    }
    proc del {f} {
	variable u
	variable z
	if {$u eq "recursive"} {
	if {"$u" == "recursive"} {
	    testchannelevent $f delete 1
	    testchannelevent $f delete 0
	    lappend z "del deleted notcalled"
	    lappend z "del deleted myself"
	} else {
	    set u recursive
	    lappend z "del calling recursive"
	    set timer [after 50 lappend z timeout]
	    set mode [test servicemode 1]
	    vwait z
	    update
	    after cancel $timer
	    test servicemode $mode
	    lappend z "del after update"
	}
    }
    set z ""
    set u toplevel
    set timer [after 50 lappend z timeout]
    testservicemode 0
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f]]
    testchannelevent $f add readable [namespace code [list del $f]]
    testservicemode 1
    vwait z
    after cancel $timer
    set z
} -cleanup {
    update
    chan close $f
    update
} -result [list {del calling recursive} {del deleted notcalled} \
	       {del deleted myself} {del after update}]
test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
    string compare [string tolower $z] \
	[list {del calling recursive} {del deleted notcalled} \
	      {del deleted myself} {del after update}]
} 0
test chan-io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
    file delete $path(test1)
    set f [open $path(test1) w]
    chan close $f
    set f [open $path(test1) r]
} -constraints {testchannelevent testservicemode} -body {
    testchannelevent $f add readable [namespace code [list second $f]]
    testchannelevent $f add readable [namespace code [list first $f]]
    proc first {f} {
	variable u
	variable z
	if {$u eq "toplevel"} {
	if {"$u" == "toplevel"} {
	    lappend z "first called"
	    set mode [testservicemode 1]
	    set timer [after 50 lappend z timeout]
	    set u first
	    vwait z
	    update
	    after cancel $timer
	    testservicemode $mode
	    lappend z "first after update"
	} else {
	    lappend z "first called not toplevel"
	}
    }
    proc second {f} {
	variable u
	variable z
	if {$u eq "first"} {
	if {"$u" == "first"} {
	    lappend z "second called, first time"
	    set u second
	    testchannelevent $f delete 0
	} elseif {$u eq "second"} {
	} elseif {"$u" == "second"} {
	    lappend z "second called, second time"
	    testchannelevent $f delete 0
	} else {
	    lappend z "second called, cannot happen!"
	    testchannelevent $f removeall
	}
    }
    set z ""
    set u toplevel
    set timer [after 50 lappend z timeout]
    testservicemode 0
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list second $f]]
    testchannelevent $f add readable [namespace code [list first $f]]
    testservicemode 1
    vwait z
    after cancel $timer
    set z
} -cleanup {
    update
    chan close $f
    string compare [string tolower $z] \
} -result [list {first called} {first called not toplevel} \
	       {second called, first time} {second called, second time} \
	       {first after update}]
	[list {first called} {first called not toplevel} \
	      {second called, first time} {second called, second time} \
	      {first after update}]
} 0

test chan-io-51.1 {Test old socket deletion on Macintosh} -setup {
test chan-io-51.1 {Test old socket deletion on Macintosh} {socket} {
    set x 0
    set result ""
    proc accept {s a p} {
	variable x
    variable wait ""
} -constraints {socket} -body {
	variable wait
	chan configure $s -blocking off
	chan puts $s "sock[incr x]"
	chan close $s
	set wait done
    }
    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    set port [lindex [chan configure $ss -sockname] 2]

    proc accept {s a p} {
	variable x
	chan configure $s -blocking off
	chan puts $s "sock[incr x]"
	chan close $s
	variable wait done
    variable wait ""
    }
    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
    set port [lindex [chan configure $ss -sockname] 2]
    set cs [socket 127.0.0.1 $port]
    vwait [namespace which -variable wait]
    lappend result [chan gets $cs]
    chan close $cs

    set wait ""
    set cs [socket 127.0.0.1 $port]
    vwait [namespace which -variable wait]
    lappend result [chan gets $cs]
    chan close $cs

    set wait ""
    set cs [socket 127.0.0.1 $port]
    vwait [namespace which -variable wait]
    lappend result [chan gets $cs]
    chan close $cs

    set wait ""
    set cs [socket 127.0.0.1 $port]
    vwait [namespace which -variable wait]
    lappend result [chan gets $cs]
} -cleanup {
    chan close $cs
    chan close $ss
    set result
} -result {sock1 sock2 sock3 sock4}
} {sock1 sock2 sock3 sock4}

test chan-io-52.1 {TclCopyChannel} -constraints {fcopy} -setup {
test chan-io-52.1 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan copy $f1 $f2 -command " # "
    chan copy $f1 $f2
    chan copy $f1 $f2 -command { # }
    catch { chan copy $f1 $f2 } msg
} -returnCodes error -cleanup {
    chan close $f1
    chan close $f2
} -match glob -result {channel "*" is busy}
test chan-io-52.2 {TclCopyChannel} -constraints {fcopy} -setup {
    string compare $msg "channel \"$f1\" is busy"
} {0}
test chan-io-52.2 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    set f3 [open $thisScript]
    chan copy $f1 $f2 -command " # "
    chan copy $f3 $f2
    chan copy $f1 $f2 -command { # }
    catch { chan copy $f3 $f2 } msg
} -returnCodes error -cleanup {
    chan close $f1
    chan close $f2
    chan close $f3
} -match glob -result {channel "*" is busy}
test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup {
    string compare $msg "channel \"$f2\" is busy"
} {0}
test chan-io-52.3 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation cr -blocking 0
    set s0 [chan copy $f1 $f2]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.4 {TclCopyChannel} -constraints {fcopy} -setup {
    set result
} {0 0 ok}
test chan-io-52.4 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation cr -blocking 0
    chan copy $f1 $f2 -size 40
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    lappend result [file size $path(test1)]
} -result {0 0 40}
test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
} {0 0 40}
test chan-io-52.5 {TclCopyChannel, all} {fcopy} {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    if {[file size $thisScript] == [file size $path(test1)]} {
    set s2 [file size $path(test1)]
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup {
    set result
} {0 0 ok}
test chan-io-52.5a {TclCopyChannel, all, other negative value} {fcopy} {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    if {[file size $thisScript] == [file size $path(test1)]} {
    set s2 [file size $path(test1)]
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup {
    set result
} {0 0 ok}
test chan-io-52.5b {TclCopyChannel, all, wrapped to ngative value} {fcopy} {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    if {[file size $thisScript] ==  [file size $path(test1)]} {
    set s2 [file size $path(test1)]
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.6 {TclCopyChannel} -setup {
    set result
} {0 0 ok}
test chan-io-52.6 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    set s0 [chan copy $f1 $f2 -size [expr [file size $thisScript] + 5]]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
    set result
} {0 0 ok}
test chan-io-52.7 {TclCopyChannel} {fcopy} {
    file delete $path(test1)
} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation lf -blocking 0
    chan copy $f1 $f2
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    set s1 [file size $thisScript]
    if {[file size $thisScript] == [file size $path(test1)]} {
    set s2 [file size $path(test1)]
    chan close $f1
    chan close $f2
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    return $result
    set result
} -cleanup {
    chan close $f1
    chan close $f2
} -result {0 0 ok}
test chan-io-52.8 {TclCopyChannel} -setup {
} {0 0 ok}
test chan-io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
} -constraints {stdio fcopy} -body {
    set f1 [open $path(pipe) w]
    chan configure $f1 -translation lf
    chan puts $f1 "
	chan puts ready
	chan gets stdin
	set f1 \[open [list $thisScript] r\]
	chan configure \$f1 -translation lf
	chan puts \[chan read \$f1 100\]
	chan close \$f1
    "
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    chan configure $f1 -translation lf
    chan gets $f1
    chan puts $f1 ready
    chan flush $f1
    set f2 [open $path(test1) w]
    chan configure $f2 -translation lf
    set s0 [chan copy $f1 $f2 -size 40]
    catch {chan close $f1}
    chan close $f2
    list $s0 [file size $path(test1)]
} -result {40 40}
} {40 40}
# Empty files, to register them with the test facility
set path(kyrillic.txt)   [makeFile {} kyrillic.txt]
set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
set path(utf8-rp.txt)    [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
chan configure $out -encoding koi8-r -translation lf
chan puts       $out "\u0410\u0410"
chan close      $out
test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
    # Copy kyrillic to UTF-8, using chan copy.

    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]

    chan configure $in  -encoding koi8-r -translation lf
    chan configure $out -encoding utf-8 -translation lf

    chan copy $in $out
    chan close $in
    chan close $out

    # Do the same again, but differently (read/chan puts).

    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-rp.txt) w]

    chan configure $in  -encoding koi8-r -translation lf
    chan configure $out -encoding utf-8 -translation lf

    chan puts -nonewline $out [chan read $in]

    chan close $in
    chan close $out

    list [file size $path(kyrillic.txt)] \
	    [file size $path(utf8-fcopy.txt)] \
	    [file size $path(utf8-rp.txt)]
} {3 5 5}
test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
    # encoding to binary (=> implies that the internal utf-8 is written)
    # encoding to binary (=> implies that the
    # internal utf-8 is written)

    set in  [open $path(kyrillic.txt) r]
    set out [open $path(utf8-fcopy.txt) w]

    chan configure $in  -encoding koi8-r -translation lf
    # -translation binary is also -encoding binary
    chan configure $out -translation binary

    chan copy $in $out
    chan close $in
    chan close $out

    file size $path(utf8-fcopy.txt)
} 5
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
    set f [open $path(utf8-fcopy.txt) w]
    fconfigure $f -encoding utf-8 -translation lf
    puts $f "\u0410\u0410"
    close $f
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be in utf-8 to make sense to the
    # encoder
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # -translation binary is also -encoding binary
    chan configure $in  -translation binary
    chan configure $out -encoding koi8-r -translation lf

    chan copy $in $out
    chan close $in
    chan close $out

    file size $path(kyrillic.txt)
} -result 3
} 3

test chan-io-53.1 {CopyData} -setup {
test chan-io-53.1 {CopyData} {fcopy} {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation cr -blocking 0
    chan copy $f1 $f2 -size 0
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    chan close $f1
    chan close $f2
    lappend result [file size $path(test1)]
} -result {0 0 0}
test chan-io-53.2 {CopyData} -setup {
} {0 0 0}
test chan-io-53.2 {CopyData} {fcopy} {
    file delete $path(test1)
} -constraints {fcopy} -body {
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    chan configure $f1 -translation lf -blocking 0
    chan configure $f2 -translation cr -blocking 0
    chan copy $f1 $f2 -command [namespace code {set s0}]
    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
    variable s0
    vwait [namespace which -variable s0]
    chan close $f1
    chan close $f2
    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {($s1 == $s2) && ($s0 == $s1)} {
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    return $result
} -result {0 0 ok}
test chan-io-53.3 {CopyData: background read underflow} -setup {
    set result
} {0 0 ok}
test chan-io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
} -constraints {stdio unix fcopy} -body {
    set f1 [open $path(pipe) w]
    chan puts -nonewline $f1 {
	chan puts ready
	chan flush stdout			;# Don't assume line buffered!
	chan flush stdout				;# Don't assume line buffered!
	chan copy stdin stdout -command { set x }
	vwait x
	set f [}
    chan puts $f1 [list open $path(test1) w]]
    chan puts $f1 {
	chan configure $f -translation lf
	chan puts $f "done"
	chan close $f
    }
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    set result [chan gets $f1]
    chan puts $f1 line1
    chan flush $f1
    lappend result [chan gets $f1]
    chan puts $f1 line2
    chan flush $f1
    lappend result [chan gets $f1]
    chan close $f1
    after 500
    set f [open $path(test1)]
    lappend result [chan read $f]
} -cleanup {
    chan close $f
    set result
} -result "ready line1 line2 {done\n}"
test chan-io-53.4 {CopyData: background write overflow} -setup {
} "ready line1 line2 {done\n}"
test chan-io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileevent fcopy} {
    set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
    variable x
    for {set x 0} {$x < 12} {incr x} {
	append big $big
    }
    file delete $path(test1)
    file delete $path(pipe)
} -constraints {stdio unix fileevent fcopy} -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 {
	chan puts ready
	chan copy stdin stdout -command { set x }
	vwait x
	set f [open $path(test1) w]
	chan configure $f -translation lf
	chan puts $f "done"
	chan close $f
    }
    chan close $f1
    set f1 [openpipe r+ $path(pipe)]
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    set result [chan gets $f1]
    chan configure $f1 -blocking 0
    chan puts $f1 $big
    chan flush $f1
    after 500
    set result ""
    chan event $f1 read [namespace code {
	append result [chan read $f1 1024]
	if {[string length $result] >= [string length $big]} {
	    set x done
	}
    }]
    vwait [namespace which -variable x]
    return $x
    chan close $f1
} -cleanup {
    set big {}
    chan close $f1
} -result done
    set x
} done
set result {}
proc FcopyTestAccept {sock args} {
    after 1000 "chan close $sock"
}
proc FcopyTestDone {bytes {error {}}} {
    variable fcopyTestDone
    if {[string length $error]} {
6966
6967
6968
6969
6970
6971
6972
6973

6974
6975
6976
6977
6978
6979
6980
6981
6982

6983
6984
6985
6986
6987
6988
6989
6990
6991
6992

6993

6994
6995
6996
6997
6998
6999
7000
7001
7002
7003
7004
7005
7006
7007
7008
7009
7010
7011
7012

7013
7014
7015
7016
7017
7018
7019
6824
6825
6826
6827
6828
6829
6830

6831
6832
6833
6834
6835

6836
6837
6838

6839
6840
6841
6842
6843
6844
6845


6846
6847
6848

6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864
6865
6866
6867

6868
6869
6870
6871
6872
6873
6874
6875







-
+




-



-
+






-
-


+
-
+


















-
+







    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    chan close $in
    chan close $out
    set fcopyTestDone	;# 1 for error condition
} 1
test chan-io-53.6 {CopyData: error during chan copy} -setup {
test chan-io-53.6 {CopyData: error during chan copy} {stdio openpipe fcopy} {
    variable fcopyTestDone
    file delete $path(pipe)
    file delete $path(test1)
    catch {unset fcopyTestDone}
} -constraints {stdio fcopy} -body {
    set f1 [open $path(pipe) w]
    chan puts $f1 "exit 1"
    chan close $f1
    set in [openpipe r+ $path(pipe)]
    set in [open "|[list [interpreter] $path(pipe)]" r+]
    set out [open $path(test1) w]
    chan copy $in $out -command [namespace code FcopyTestDone]
    variable fcopyTestDone
    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]
    }
    return $fcopyTestDone	;# 0 for plain end of file
} -cleanup {
    catch {chan close $in}
    chan close $out
    set fcopyTestDone	;# 0 for plain end of file
} -result 0
} {0}
proc doFcopy {in out {bytes 0} {error {}}} {
    variable fcopyTestDone
    variable fcopyTestCount
    incr fcopyTestCount $bytes
    if {[string length $error]} {
	set fcopyTestDone 1
    } elseif {[chan eof $in]} {
	set fcopyTestDone 0
    } else {
        # Delay next chan copy to wait for size>0 input bytes
        after 100 [list chan copy $in $out -size 1000 \
		-command [namespace code [list doFcopy $in $out]]]
    }
}
test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
    variable fcopyTestDone
    file delete $path(pipe)
    catch {unset fcopyTestDone}
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    set fcopyTestCount 0
    set f1 [open $path(pipe) w]
    chan puts $f1 {
	# Write  10 bytes / 10 msec
	proc Write {count} {
	    chan puts -nonewline "1234567890"
	    if {[incr count -1]} {
7039
7040
7041
7042
7043
7044
7045
7046

7047
7048
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
6895
6896
6897
6898
6899
6900
6901

6902
6903
6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914
6915
6916
6917

6918
6919
6920
6921

6922
6923
6924
6925


6926
6927
6928
6929
6930
6931
6932
6933
6934
6935
6936
6937
6938
6939
6940
6941
6942
6943
6944
6945
6946


6947
6948
6949
6950
6951
6952
6953
6954
6955
6956
6957
6958

6959
6960
6961
6962
6963

6964
6965
6966
6967
6968
6969
6970
6971
6972
6973
6974
6975

6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989







-
+















-
+



-
+



-
-
+
+













+





-
-
+
+










-
+




-
+











-
+





+







    expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
} -cleanup {
    catch {chan close $in}
    chan close $out
} -result {3450}
test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
    # copy progress callback. errors out intentionally
    proc cmd args {
    proc ::cmd args {
	lappend ::RES "CMD $args"
	error !STOP
    }
    # capture callback error here
    proc ::bgerror args {
	lappend ::RES "bgerror/OK $args"
	set ::forever has-been-reached
	return
    }
    # Files we use for our channels
    set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
    set bar [makeFile {} bar]
    # Channels to copy between
    set f [open $foo r] ; fconfigure $f -translation binary
    set g [open $bar w] ; fconfigure $g -translation binary -buffering none
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    # Record input size, so that result is always defined
    lappend ::RES [file size $bar]
    # Run the copy. Should not invoke -command now.
    chan copy $f $g -size 2 -command [namespace code cmd]
    chan copy $f $g -size 2 -command ::cmd
    # Check that -command was not called synchronously
    set sbs [file size $bar]
    lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs
    # Now let the async part happen. Should capture the error in cmd via
    # bgerror. If not break the event loop via timer.
    # Now let the async part happen. Should capture the error in cmd
    # via bgerror. If not break the event loop via timer.
    set token [after 1000 {
	lappend ::RES {bgerror/FAIL timeout}
	set ::forever has-been-reached
    }]
    vwait ::forever
    catch {after cancel $token}
    # Report
    set ::RES
} -cleanup {
    chan close $f
    chan close $g
    catch {unset ::RES}
    catch {unset ::forever}
    rename ::cmd {}
    rename ::bgerror {}
    removeFile foo
    removeFile bar
} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup {
    # copy progress callback.
    proc cmd args {
    # copy progress callback. errors out intentionally
    proc ::cmd args {
	lappend ::RES "CMD $args"
	set ::forever has-been-reached
	return
    }
    # Files we use for our channels
    set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
    set bar [makeFile {} bar]
    # Channels to copy between
    set f [open $foo r] ; chan configure $f -translation binary
    set g [open $bar w] ; chan configure $g -translation binary -buffering none
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    # Initialize and force eof on the input.
    chan seek $f 0 end ; chan read $f 1
    set ::RES [chan eof $f]
    # Run the copy. Should not invoke -command now.
    chan copy $f $g -size 2 -command [namespace code cmd]
    chan copy $f $g -size 2 -command ::cmd
    # Check that -command was not called synchronously
    lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}]
    # Now let the async part happen. Should capture the eof in cmd
    # If not break the event loop via timer.
    set token [after 1000 {
	lappend ::RES {cmd/FAIL timeout}
	set ::forever has-been-reached
    }]
    vwait ::forever
    catch {after cancel $token}
    # Report
    return $::RES
    set ::RES
} -cleanup {
    chan close $f
    chan close $g
    catch {unset ::RES}
    catch {unset ::forever}
    rename ::cmd {}
    removeFile foo
    removeFile bar
} -result {1 sync/OK {CMD 0}}
test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
    set out [makeFile {} out]
    set err [makeFile {} err]
    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
7153
7154
7155
7156
7157
7158
7159
7160

7161
7162
7163
7164
7165
7166
7167
7168
7169
7170
7171
7172

7173
7174
7175
7176
7177
7178
7179
7180
7181
7182
7011
7012
7013
7014
7015
7016
7017

7018
7019
7020
7021
7022
7023
7024
7025
7026
7027
7028


7029
7030


7031
7032
7033
7034
7035
7036
7037







-
+










-
-
+

-
-







    }
    proc ::done args {
	set ::forever OK
	return
    }
    set ::forever {}
    set out [open $out w]
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    chan copy $pipe $out -size 6 -command ::done
    set token [after 5000 {
	set ::forever {fcopy hangs}
    }]
    vwait ::forever
    catch {after cancel $token}
    set ::forever
} -cleanup {
    chan close $pipe
    rename ::done {}
    if {[testConstraint win]} {
	after 1000;		# Allow Windows time to figure out that the
    after 1000;			# Allow Windows time to figure out that the
                                # process is gone
    }
    catch {close $out}
    catch {removeFile out}
    catch {removeFile err}
    catch {unset ::forever}
} -result OK
test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
    set err [makeFile {} err]
    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
7215
7216
7217
7218
7219
7220
7221
7222

7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233



7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246


7247
7248
7249
7250
7251
7252
7253
7254
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







-
+








-
-
-
+
+
+











-
-
+
+
-







	chan event stdin readable bye
	chan puts OK
	vwait forever
    }
    # wait for OK from server.
    chan gets $pipe
    # Now the two clients.
    proc done {sock} {
    proc ::done {sock} {
	if {[chan eof $sock]} { chan close $sock ; return }
	lappend ::forever [chan gets $sock]
	return
    }
    set a [socket 127.0.0.1 9999]
    set b [socket 127.0.0.1 9999]
    chan configure $a -translation binary -buffering none
    chan configure $b -translation binary -buffering none
    chan event  $a readable [namespace code "done $a"]
    chan event  $b readable [namespace code "done $b"]
} -constraints {stdio fcopy} -body {
    chan event  $a readable [list ::done $a]
    chan event  $b readable [list ::done $b]
} -constraints {stdio openpipe fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}
    chan puts $a AB
    vwait ::forever
    chan puts $b BA
    vwait ::forever
    set ::forever
} -cleanup {
    catch {chan close $a}
    catch {chan close $b}
    chan close $pipe
    if {[testConstraint win]} {
	after 1000		;# Give Windows time to kill the process
    rename ::done {}
    after 1000 ;# Give Windows time to kill the process
    }
    removeFile err
    catch {unset ::forever}
} -result {AB BA}

test chan-io-54.1 {Recursive channel events} {socket fileevent} {
    # This test checks to see if file events are delivered during recursive
    # event loops when there is buffered data on the channel.
7346
7347
7348
7349
7350
7351
7352
7353

7354
7355
7356
7357
7358
7359
7360
7200
7201
7202
7203
7204
7205
7206

7207
7208
7209
7210
7211
7212
7213
7214







-
+







    producer
    vwait [namespace which -variable done]
    chan close $writer
    chan close $s
    after cancel $after
    set counter
} -cleanup {
    if {$accept ne {}} {chan close $accept}
    if {$accept != {}} {chan close $accept}
} -result 1

set path(fooBar) [makeFile {} fooBar]

test chan-io-55.1 {ChannelEventScriptInvoker: deletion} -constraints {
    fileevent
} -setup {
7448
7449
7450
7451
7452
7453
7454
7455

7456
7457
7458
7459
7460
7461
7462
7302
7303
7304
7305
7306
7307
7308

7309
7310
7311
7312
7313
7314
7315
7316







-
+







    set result
} -cleanup {
    chan close $s
    chan close $s2
    chan close $server
} -result {1 readable 234567890 timer}

test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
    set out [open $path(script) w]
    chan puts $out {
	chan puts "normal message from pipe"
	chan puts stderr "error message from pipe"
	exit 1
    }
    proc readit {pipe} {
7486
7487
7488
7489
7490
7491
7492
7493

7494
7495
7496
7497
7498

7499
7500
7501
7502
7503
7504
7505
7340
7341
7342
7343
7344
7345
7346

7347
7348
7349

7350

7351
7352
7353
7354
7355
7356
7357
7358







-
+


-

-
+







    # fully implements the moving of channels between threads, i.e. 'Threads'.
    set f [open $path(longfile) r]
    set result [testchannel mthread $f]
    chan close $f
    string equal $result [testmainthread]
} {1}

test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
    # This test will hang in older revisions of the core.
    set out [open $path(script) w]
    chan puts $out "catch {load $::tcltestlib Tcltest}"
    chan puts $out {
	chan puts [testbytestring \xe2]
	chan puts [encoding convertfrom identity \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result
	if {[chan eof $pipe]} {
	    set x [catch {chan close $pipe} line]
7562
7563
7564
7565
7566
7567
7568



















7569

7570
7571
7572
7573


7574
7575
7576
7577
7578



7579
7580

7581
7582
7583
7584
7585
7586
7587


7588


7589

7590
7591
7592
7593
7594
7595
7596
7415
7416
7417
7418
7419
7420
7421
7422
7423
7424
7425
7426
7427
7428
7429
7430
7431
7432
7433
7434
7435
7436
7437
7438
7439
7440

7441
7442


7443
7444
7445
7446
7447
7448


7449
7450
7451


7452
7453
7454
7455
7456
7457


7458
7459
7460
7461
7462

7463
7464
7465
7466
7467
7468
7469
7470







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

-
-

+
+



-
-
+
+
+
-
-
+





-
-
+
+

+
+
-
+







    testchannel splice $c
    lappend res [catch {chan seek $c 0 start}]
} -cleanup {
    chan close $c
    removeFile cutsplice
} -result {0 1 0}


# Duplicate of code in "thread.test". Find a better way of doing this
# without duplication. Maybe placement into a proc which transforms to
# nop after the first call, and placement of its defintion in a
# central location.

if {[testConstraint testthread]} {
    testthread errorproc ThreadError

    proc ThreadError {id info} {
	global threadError
	set threadError $info
    }

    proc ThreadNullError {id info} {
	# ignore
    }
}

test chan-io-70.1 {Transfer channel} -setup {
test chan-io-70.1 {Transfer channel} {testchannel testthread} {
    set f [makeFile {... dummy ...} cutsplice]
    set res {}
} -constraints {testchannel thread} -body {
    set c [open $f r]

    set     res {}
    lappend res [catch {chan seek $c 0 start}]
    testchannel cut $c
    lappend res [catch {chan seek $c 0 start}]
    set tid [thread::create -preserved]
    thread::send $tid [list set c $c]

    set tid [testthread create]
    testthread send $tid [list set c $c]
    thread::send $tid {load {} Tcltest}
    lappend res [thread::send $tid {
    lappend res [testthread send $tid {
	testchannel splice $c
	set res [catch {chan seek $c 0 start}]
	chan close $c
	set res
    }]
} -cleanup {
    thread::release $tid

    tcltest::threadReap
    removeFile cutsplice

    set res
} -result {0 1 0}
} {0 1 0}

# ### ### ### ######### ######### #########

foreach {n msg expected} {
     0 {}                                 {}
     1 {{message only}}                   {{message only}}
     2 {-options x}                       {-options x}
7747
7748
7749
7750
7751
7752
7753
7754


7755
7756
7757

7758

7759
7760
7761


7762
7763




7764
7765
7766

7767

7768
7769
7770


7771

7772
7773
7774

7775
7776

7777

7778
7779
7780
7781
7782
7783

7784
7785
7786
7787
7788
7621
7622
7623
7624
7625
7626
7627

7628
7629
7630

7631
7632

7633

7634
7635
7636
7637


7638
7639
7640
7641
7642

7643
7644

7645

7646
7647
7648
7649

7650
7651
7652

7653
7654

7655

7656
7657
7658
7659
7660
7661

7662
7663
7664
7665
7666
7667







-
+
+

-

+
-
+
-


+
+
-
-
+
+
+
+

-

+
-
+
-


+
+
-
+


-
+

-
+
-
+





-
+





    e8 {-code boss  -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
    e9 {-code 1     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
    f0 {-code 0     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
    f1 {-code error -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
    f2 {-code ok    -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
    f3 {-code boss  -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
} {
    test chan-io-71.$n {Tcl_SetChannelError} -setup {
    test chan-io-71.$n {Tcl_SetChannelError} {testchannel} {

	set f [makeFile {... dummy ...} cutsplice]
    } -constraints {testchannel} -body {
	set c [open $f r]

	testchannel setchannelerror $c [lrange $msg 0 end]
	set res [testchannel setchannelerror $c [lrange $msg 0 end]]
    } -cleanup {
	chan close $c
	removeFile cutsplice

	set res
    } -result [lrange $expected 0 end]
    test chan-io-72.$n {Tcl_SetChannelErrorInterp} -setup {
    } [lrange $expected 0 end]

    test chan-io-72.$n {Tcl_SetChannelErrorInterp} {testchannel} {

	set f [makeFile {... dummy ...} cutsplice]
    } -constraints {testchannel} -body {
	set c [open $f r]

	testchannel setchannelerrorinterp $c [lrange $msg 0 end]
	set res [testchannel setchannelerrorinterp $c [lrange $msg 0 end]]
    } -cleanup {
	chan close $c
	removeFile cutsplice

	set res
    } -result [lrange $expected 0 end]
    } [lrange $expected 0 end]
}

test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} -body {
test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
    # Test for Bug 1847044 - don't spoil type unless we have a valid channel
    chan close [lreplace [list a] 0 end]
    catch {chan close [lreplace [list a] 0 end]}
} -returnCodes error -match glob -result *
} {1}

# ### ### ### ######### ######### #########

# cleanup
foreach file [list fooBar longfile script output test1 pipe my_script \
	test2 test3 cat kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io

Changes to tests/clock.test.

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
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













-
-
+
+


















+
+
+
+




-
+

-
+







# clock.test --
#
#	This test file covers the 'clock' command that manipulates time.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2004 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

if {[testConstraint win]} {
    if {[catch {
	    ::tcltest::loadTestedCommands
	    package require registry
	}]} {
	namespace eval ::tcl::clock {variable NoRegistry {}}
    }
}

package require msgcat 1.4

testConstraint detroit \
    [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
testConstraint y2038 \
    [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]

if {[namespace which -command ::tcl::unsupported::timerate] ne ""} {
    namespace import ::tcl::unsupported::timerate
}

# TEST PLAN

# clock-1:
#	[clock format] - tests of bad and empty arguments
#	[clock format] - tests of bad and empty arguments 
#
# clock-2
# clock-2 
#	formatting of year, month and day of month
#
# clock-3
#	formatting of fiscal year, fiscal week and day of week.
#
# clock-4
#	formatting of time of day.
191
192
193
194
195
196
197
198

199
200
201
202
203
204
205
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209







-
+







	    x xi xii xiii xiv xv xvi xvii xviii xix
	    xx xxi xxii xxiii xxiv xxv xxvi xxvii xxviii xxix
	    xxx xxxi xxxii xxxiii xxxiv xxxv xxxvi xxxvii xxxviii xxxix
	    xl xli xlii xliii xliv xlv xlvi xlvii xlviii xlix
	    l li lii liii liv lv lvi lvii lviii lix
	    lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix
	    lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix
	    lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii
	    lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii 
	    lxxxix
	    xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix
	    c
	}
	DATE_FORMAT {%m/%d/%Y}
	TIME_FORMAT {%H:%M:%S}
	DATE_TIME_FORMAT {%x %X}
267
268
269
270
271
272
273
274

275
276

277
278
279
280
281
282
283
271
272
273
274
275
276
277

278
279

280
281
282
283
284
285
286
287







-
+

-
+







test clock-1.3 "clock format - empty val" {
    clock format 0 -gmt 1 -format ""
} {}

test clock-1.4 "clock format - bad flag" {*}{
    -body {
    list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
    }
    } 
    -match glob
    -result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
    -result {1 {bad switch "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badSwitch -oops}}
}

test clock-1.5 "clock format - bad timezone" {
    list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
} {1 {time zone ":NOWHERE" not found} {CLOCK badTimeZone :NOWHERE}}

test clock-1.6 "clock format - gmt + timezone" {
35214
35215
35216
35217
35218
35219
35220
35221

35222
35223
35224
35225
35226
35227
35228
35218
35219
35220
35221
35222
35223
35224

35225
35226
35227
35228
35229
35230
35231
35232







-
+







    set f1 [clock add $t 3600 seconds -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}

test clock-31.1 {system locale} \
    -constraints win \
    -setup {
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
35237
35238
35239
35240
35241
35242
35243
35244

35245
35246
35247
35248
35249
35250
35251
35241
35242
35243
35244
35245
35246
35247

35248
35249
35250
35251
35252
35253
35254
35255







-
+







	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%d-%b-%Y}]

test clock-31.2 {system locale} \
    -constraints win \
    -setup {
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
35260
35261
35262
35263
35264
35265
35266
35267

35268
35269
35270
35271
35272
35273
35274
35264
35265
35266
35267
35268
35269
35270

35271
35272
35273
35274
35275
35276
35277
35278







-
+







	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {the %d' day of %B %Y}]

test clock-31.3 {system locale} \
    -constraints win \
    -setup {
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	::tcl::clock::ClearCaches
    } \
35283
35284
35285
35286
35287
35288
35289
35290

35291
35292
35293
35294
35295
35296
35297
35287
35288
35289
35290
35291
35292
35293

35294
35295
35296
35297
35298
35299
35300
35301







-
+







	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -timezone :UTC -locale current \
		 -format {%l:%M:%S %p}]

test clock-31.4 {system locale} \
    -constraints win \
    -setup {
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
35320
35321
35322
35323
35324
35325
35326
35327

35328
35329
35330
35331
35332
35333
35334
35324
35325
35326
35327
35328
35329
35330

35331
35332
35333
35334
35335
35336
35337
35338







-
+







	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {%d-%b-%Y}]

test clock-31.5 {system locale} \
    -constraints win \
    -setup {
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
35357
35358
35359
35360
35361
35362
35363
35364

35365
35366
35367
35368
35369
35370
35371
35361
35362
35363
35364
35365
35366
35367

35368
35369
35370
35371
35372
35373
35374
35375







-
+







	::tcl::clock::ClearCaches
    } \
    -result [clock format 0 -locale current -timezone EST5 \
		 -format {the %d' day of %B %Y}]

test clock-31.6 {system locale} \
    -constraints win \
    -setup {
    -setup { 
	namespace eval ::tcl::clock {
	    namespace import -force ::testClock::registry
	}
	set noreg [info exists ::tcl::clock::NoRegistry]
	if {$noreg} {unset ::tcl::clock::NoRegistry}
	if { [info exists env(TZ)] } {
	    set oldTZ $env(TZ)
35427
35428
35429
35430
35431
35432
35433
35434

35435
35436
35437
35438
35439
35440
35441
35442
35443
35444
35445
35446

35447
35448
35449
35450
35451
35452
35453
35431
35432
35433
35434
35435
35436
35437

35438
35439
35440
35441
35442
35443
35444
35445
35446
35447
35448
35449

35450
35451
35452
35453
35454
35455
35456
35457







-
+











-
+







	if { $t ne $v } {
	    append problems "scanning $u: $t should be $v\n"
	}
	incr t 86400
    }
    set problems
} {}

			 
# Legacy tests

# clock clicks
test clock-33.1 {clock clicks tests} {
    expr [clock clicks]+1
    concat {}
} {}
test clock-33.2 {clock clicks tests} {
    set start [clock clicks]
    after 10
    set end [clock clicks]
    expr {$end > $start}
    expr "$end > $start"
} {1}
test clock-33.3 {clock clicks tests} {
    list [catch {clock clicks foo} msg] $msg
} {1 {bad option "foo": must be -milliseconds or -microseconds}}
test clock-33.4 {clock clicks tests} {
    expr [clock clicks -milliseconds]+1
    concat {}
35465
35466
35467
35468
35469
35470
35471
35472

35473
35474
35475
35476
35477
35478
35479
35480
35481
35482
35483
35484
35485
35486
35487
35488

35489
35490
35491
35492
35493
35494
35495
35469
35470
35471
35472
35473
35474
35475

35476
35477
35478
35479
35480
35481
35482
35483
35484
35485
35486
35487
35488
35489
35490
35491

35492
35493
35494
35495
35496
35497
35498
35499







-
+















-
+







	set end [clock clicks -milli]
    } 1 1] 0] > 60000} {
	::tcltest::Skip "timing issue"
    }
    # 60 msecs seems to be the max time slice under Windows 95/98
    expr {
	  ($end > $start) && (($end - $start) <= 60) ?
	  "ok" :
	  "ok" : 
	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.5a {clock tests, millisecond timing test} {
    # This test can fail on a system that is so heavily loaded that
    # the test takes >60 ms to run.
    if {[lindex [timerate {
	set start [clock milliseconds]
	timerate {} 10; # short but precise busy wait
	set end [clock milliseconds]
    } 1 1] 0] > 60000} {
	::tcltest::Skip "timing issue"
    }
    # 60 msecs seems to be the max time slice under Windows 95/98
    expr {
	  ($end > $start) && (($end - $start) <= 60) ?
	  "ok" :
	  "ok" : 
	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.6 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks ? } msg] $msg
} {1 {bad option "?": must be -milliseconds or -microseconds}}
test clock-33.7 {clock clicks, milli with too much abbreviation} {
    list [catch { clock clicks - } msg] $msg
35616
35617
35618
35619
35620
35621
35622
35623

35624
35625
35626
35627
35628
35629
35630
35631
35632

35633
35634
35635
35636
35637
35638
35639
35620
35621
35622
35623
35624
35625
35626

35627
35628
35629
35630
35631
35632
35633
35634
35635
35636
35637
35638
35639
35640
35641
35642
35643
35644







-
+









+







} {Oct 23,1992 15:00 GMT}
test clock-34.8 {clock scan tests} {
    set time [clock scan "Oct 23,1992 15:00" -gmt true]
    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Oct 23,1992 15:00 GMT}
test clock-34.9 {clock scan tests} {
    list [catch {clock scan "Jan 12" -bad arg} msg] $msg
} {1 {bad option "-bad", must be -base, -format, -gmt, -locale or -timezone}}
} {1 {bad switch "-bad", must be -base, -format, -gmt, -locale or -timezone}}
# The following two two tests test the two year date policy
test clock-34.10 {clock scan tests} {
    set time [clock scan "1/1/71" -gmt true]
    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,1971 00:00 GMT}
test clock-34.11 {clock scan tests} {
    set time [clock scan "1/1/37" -gmt true]
    clock format $time -format {%b %d,%Y %H:%M GMT} -gmt true
} {Jan 01,2037 00:00 GMT}

test clock-34.12 {clock scan, relative times} {
    set time [clock scan "Oct 23, 1992 -1 day"]
    clock format $time -format {%b %d, %Y}
} "Oct 22, 1992"
test clock-34.13 {clock scan, ISO 8601 base date format} {
    set time [clock scan "19921023"]
    clock format $time -format {%b %d, %Y}
35777
35778
35779
35780
35781
35782
35783

35784
35785
35786
35787
35788
35789
35790
35782
35783
35784
35785
35786
35787
35788
35789
35790
35791
35792
35793
35794
35795
35796







+







    foreach i {91 92 93 94 95 96} {
      set dec1th [clock scan 12/1/$i]
      set monday [clock scan "monday 1 week ago" -base $dec1th]
      lappend res [clock format $monday -format %Y-%m-%d]
    }
    set res
} {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25}

test clock-34.44 {2nd monday in november} {
    set res {}
    foreach i {91 92 93 94 95 96} {
      set nov8th [clock scan 11/8/$i -gmt 1]
      set monday [clock scan monday -base $nov8th -gmt 1]
      lappend res [clock format $monday -format %Y-%m-%d -gmt 1]
    }
35809
35810
35811
35812
35813
35814
35815

35816
35817

35818
35819
35820

35821
35822

35823
35824
35825

35826
35827

35828
35829
35830

35831
35832

35833
35834
35835

35836
35837

35838
35839
35840
35841
35842


35843
35844
35845
35846
35847
35848
35849
35850
35851
35852
35853
35854
35855
35856
35857
35858
35859
35860
35861
35862
35863
35864
35865
35866
35867
35868
35869
35870
35871
35872
35873
35874
35875
35876
35877
35878
35879
35880
35881
35882
35883
35884
35885
35886
35887
35888
35889
35890
35891
35892
35893
35894
35895
35896
35897
35898
35899
35900
35901
35902
35903
35904
35905
35906
35907
35908
35909
35910
35911
35912
35913
35914
35915
35916
35917
35918

35919
35920
35921
35922
35923
35924
35925
35815
35816
35817
35818
35819
35820
35821
35822
35823

35824
35825
35826
35827
35828
35829

35830
35831
35832
35833
35834
35835

35836
35837
35838
35839
35840
35841

35842
35843
35844
35845
35846
35847

35848
35849
35850
35851


35852
35853






























































35854
35855
35856
35857
35858
35859
35860
35861
35862
35863
35864
35865
35866

35867
35868
35869
35870
35871
35872
35873
35874







+

-
+



+

-
+



+

-
+



+

-
+



+

-
+



-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
+







    set res
} {1991-11-25 1992-11-30 1993-11-29 1994-11-28 1995-11-27 1996-11-25}
test clock-34.47 {ago with multiple relative units} {
    set base [clock scan "12/31/1999 00:00:00"]
    set res [clock scan "2 days 2 hours ago" -base $base]
    expr {$base - $res}
} 180000

test clock-34.48 {more than one ToD} {*}{
    -body {clock scan {10:00 11:00}}
    -body {clock scan {10:00 11:00}} 
    -returnCodes error
    -result {unable to convert date-time string "10:00 11:00": more than one time of day in string}
}

test clock-34.49 {more than one date} {*}{
    -body {clock scan {1/1/2001 2/2/2002}}
    -body {clock scan {1/1/2001 2/2/2002}} 
    -returnCodes error
    -result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string}
}

test clock-34.50 {more than one time zone} {*}{
    -body {clock scan {10:00 EST CST}}
    -body {clock scan {10:00 EST CST}} 
    -returnCodes error
    -result {unable to convert date-time string "10:00 EST CST": more than one time zone in string}
}

test clock-34.51 {more than one weekday} {*}{
    -body {clock scan {Monday Tuesday}}
    -body {clock scan {Monday Tuesday}} 
    -returnCodes error
    -result {unable to convert date-time string "Monday Tuesday": more than one weekday in string}
}

test clock-34.52 {more than one ordinal month} {*}{
    -body {clock scan {next January next March}}
    -body {clock scan {next January next March}} 
    -returnCodes error
    -result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}
test clock-34.53 {clock scan, ISO 8601 point in time format} {
    set time [clock scan "19921023T00:00:00"]


    clock format $time -format {%b %d, %Y %H:%M:%S}
} "Oct 23, 1992 00:00:00"
test clock-34.54 {clock scan, ISO 8601 point in time format} {
    set time [clock scan "1992-10-23T00:00:00"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} "Oct 23, 1992 00:00:00"
test clock-34.55 {clock scan, ISO 8601 invalid TZ} -body {
    set time [clock scan "19921023MST000000"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} -returnCodes error -match glob -result {unable to convert date-time string*}
test clock-34.56 {clock scan, ISO 8601 invalid TZ} -body {
    set time [clock scan "19921023M000000"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} -returnCodes error -match glob -result {unable to convert date-time string*}
test clock-34.57 {clock scan, ISO 8601 invalid TZ} -body {
    set time [clock scan "1992-10-23M00:00:00"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} -returnCodes error -match glob -result {unable to convert date-time string*}
test clock-34.58 {clock scan, ISO 8601 invalid TZ} -body {
    set time [clock scan "1992-10-23MST00:00:00"]
    clock format $time -format {%b %d, %Y %H:%M:%S}
} -returnCodes error -match glob -result {unable to convert date-time string*}
test clock-34.59 {clock scan tests (-TZ)} {
    set time [clock scan "31 Jan 14 23:59:59 -0100"]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Feb 01,2014 00:59:59 GMT}
test clock-34.60 {clock scan tests (+TZ)} {
    set time [clock scan "31 Jan 14 23:59:59 +0100"]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 31,2014 22:59:59 GMT}
test clock-34.61 {clock scan tests (-TZ)} {
    set time [clock scan "23:59:59 -0100" -base 0 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 02,1970 00:59:59 GMT}
test clock-34.62 {clock scan tests (+TZ)} {
    set time [clock scan "23:59:59 +0100" -base 0 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 01,1970 22:59:59 GMT}
test clock-34.63 {clock scan tests (TZ)} {
    set time [clock scan "Mon, 30 Jun 2014 23:59:59 CEST"]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jun 30,2014 21:59:59 GMT}
test clock-34.64 {clock scan tests (TZ)} {
    set time [clock scan "Fri, 31 Jan 2014 23:59:59 CET"]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 31,2014 22:59:59 GMT}
test clock-34.65 {clock scan tests (relspec, day unit not TZ)} {
    set time [clock scan "23:59:59 +15 day" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Feb 08,1970 23:59:59 GMT}
test clock-34.66 {clock scan tests (relspec, day unit not TZ)} {
    set time [clock scan "23:59:59 -15 day" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 09,1970 23:59:59 GMT}
test clock-34.67 {clock scan tests (merid and TZ)} {
    set time [clock scan "10:59 pm CET" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 24,1970 21:59:00 GMT}
test clock-34.68 {clock scan tests (merid and TZ)} {
    set time [clock scan "10:59 pm +0100" -base 2000000 -gmt true]
    clock format $time -format {%b %d,%Y %H:%M:%S %Z} -gmt true
} {Jan 24,1970 21:59:00 GMT}

# clock seconds
test clock-35.1 {clock seconds tests} {
    expr [clock seconds]+1
    concat {}
} {}
test clock-35.2 {clock seconds tests} {
    list [catch {clock seconds foo} msg] $msg
} {1 {wrong # args: should be "clock seconds"}}
test clock-35.3 {clock seconds tests} {
    set start [clock seconds]
    after 2000
    set end [clock seconds]
    expr {$end > $start}
    expr "$end > $start"
} {1}


test clock-36.1 {clock scan next monthname} {
    clock format [clock scan "next june" -base [clock scan "june 1, 2000"]] \
	    -format %m.%Y
} "06.2001"
35988
35989
35990
35991
35992
35993
35994
35995

35996
35997
35998
35999
36000
36001
36002
35937
35938
35939
35940
35941
35942
35943

35944
35945
35946
35947
35948
35949
35950
35951







-
+







        }
        if { [info exists oldTclTZ] } {
            set env(TCL_TZ) $oldTclTZ
            unset oldTclTZ
        }
    } \
    -result 1

        

test clock-39.1 {regression - synonym timezones} {
    clock format 0 -format {%H:%M:%S} -timezone :US/Eastern
} {19:00:00}

test clock-40.1 {regression - bad month with -timezone :localtime} \
    -setup {
36060
36061
36062
36063
36064
36065
36066
36067

36068
36069
36070
36071
36072
36073
36074
36009
36010
36011
36012
36013
36014
36015

36016
36017
36018
36019
36020
36021
36022
36023







-
+







	    set env(TZ) $oldTZ
	    unset oldTZ
	} else {
	    unset env(TZ)
	}
    } \
    -result {12:34:56-0500}

    
test clock-45.1 {regression test - time zone containing only two digits} \
    -body {
	clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z
    } \
    -result 482134530

test clock-46.1 {regression test - month zero} \
36105
36106
36107
36108
36109
36110
36111
36112

36113
36114
36115
36116
36117
36118
36119
36054
36055
36056
36057
36058
36059
36060

36061
36062
36063
36064
36065
36066
36067
36068







-
+







    }
} -cleanup {
    interp delete child
} -result {0 12345}

test clock-49.1 {regression test - localtime with negative arg (Bug 1237907)} \
    -body {
	list [catch {
	list [catch { 
	    clock format -86400 -timezone :localtime -format %Y
	} result] $result
    } \
    -match regexp \
    -result {0 1969|1 {localtime failed \(clock value may be too large/small to represent\)}}

test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
36344
36345
36346
36347
36348
36349
36350
36351

36352
36353
36354
36355
36356
36357
36358
36293
36294
36295
36296
36297
36298
36299

36300
36301
36302
36303
36304
36305
36306
36307







-
+







    }
    -body {
	clock format 1072940400 -timezone :Test/PhoenixOne \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2004-01-01 00:00:00 MST}
}

	    
test clock-56.2 {use of zoneinfo, version 2} {*}{
    -setup {
	clock format [clock seconds]
	set tzdir [makeDirectory zoneinfo]
	set tzdir2 [makeDirectory Test $tzdir]
	set tzfile [makeFile {} PhoenixTwo $tzdir2]
	set f [open $tzfile wb]
36394
36395
36396
36397
36398
36399
36400
36401

36402
36403
36404
36405
36406
36407
36408
36343
36344
36345
36346
36347
36348
36349

36350
36351
36352
36353
36354
36355
36356
36357







-
+







    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile PhoenixTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    } 
    -body {
	clock format 1072940400 -timezone :Test/PhoenixTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2004-01-01 00:00:00 MST}
}

36604
36605
36606
36607
36608
36609
36610
36611

36612
36613
36614
36615
36616
36617
36618
36553
36554
36555
36556
36557
36558
36559

36560
36561
36562
36563
36564
36565
36566
36567







-
+







    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile TijuanaTwo $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    } 
    -body {
	clock format 2224738800 -timezone :Test/TijuanaTwo \
	    -format {%Y-%m-%d %H:%M:%S %Z}
    }
    -result {2040-07-01 00:00:00 PDT}
}

36756
36757
36758
36759
36760
36761
36762
36763

36764
36765
36766
36767
36768
36769
36770
36771
36772
36773
36774

36775
36776
36777
36778
36779
36780
36781
36705
36706
36707
36708
36709
36710
36711

36712
36713
36714
36715
36716
36717
36718
36719
36720
36721
36722

36723
36724
36725
36726
36727
36728
36729
36730







-
+










-
+







    -cleanup {
	set ::tcl::clock::ZoneinfoPaths \
	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
	::tcl::clock::ClearCaches
	removeFile Windhoek $tzdir2
	removeDirectory Test $tzdir
	removeDirectory zoneinfo
    }
    } 
    -result {Sun Jan 08 22:30:06 WAST 2012}
}

test clock-57.1 {clock scan - abbreviated options} {
    clock scan 1970-01-01 -f %Y-%m-%d -g true
} 0

test clock-58.1 {clock l10n - Japanese localisation} {*}{
    -setup {
	proc backslashify { string } {

	    
	    set retval {}
	    foreach char [split $string {}] {
		scan $char %c ccode
		if { $ccode >= 0x0020 && $ccode < 0x007f
		     && $char ne "\{" && $char ne "\}" && $char ne "\["
		     && $char ne "\]" && $char ne "\\" && $char ne "\$" } {
		    append retval $char
36875
36876
36877
36878
36879
36880
36881
36882

36883
36884
36885

36886
36887
36888

36889
36890
36891

36892
36893
36894

36895
36896
36897

36898
36899
36900

36901
36902
36903

36904
36905
36906

36907
36908
36909

36910
36911
36912

36913
36914
36915

36916
36917
36918
36919
36920

36921
36922
36923
36924
36925
36926
36927

36928
36929
36930
36931
36932
36933
36934
36824
36825
36826
36827
36828
36829
36830

36831
36832
36833

36834
36835
36836

36837
36838
36839

36840
36841
36842

36843
36844
36845

36846
36847
36848

36849
36850
36851

36852
36853
36854

36855
36856
36857

36858
36859
36860

36861
36862
36863

36864
36865
36866
36867
36868

36869
36870
36871
36872
36873
36874
36875

36876
36877
36878
36879
36880
36881
36882
36883







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+




-
+






-
+







    join $trouble \n
} {}

# case-insensitive matching of weekday and month names [Bug 1781282]

test clock-60.1 {case insensitive weekday names} {
    clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
test clock-60.2 {case insensitive weekday names} {
    clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
test clock-60.3 {case insensitive weekday names} {
    clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
test clock-60.4 {case insensitive weekday names} {
    clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
test clock-60.5 {case insensitive weekday names} {
    clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
test clock-60.6 {case insensitive weekday names} {
    clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a"
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
test clock-60.7 {case insensitive month names} {
    clock scan "1 january 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.8 {case insensitive month names} {
    clock scan "1 January 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.9 {case insensitive month names} {
    clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.10 {case insensitive month names} {
    clock scan "1 december 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.11 {case insensitive month names} {
    clock scan "1 December 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
test clock-60.12 {case insensitive month names} {
    clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 

test clock-61.1 {overflow of a wide integer on output} {*}{
    -body {
	clock format 0x8000000000000000 -format %s -gmt true
    }
    } 
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.2 {overflow of a wide integer on output} {*}{
    -body {
	clock format -0x8000000000000001 -format %s -gmt true
    }
    } 
    -result {integer value too large to represent}
    -returnCodes error
}
test clock-61.3 {near-miss overflow of a wide integer on output} {
    clock format 0x7fffffffffffffff -format %s -gmt true
} [expr 0x7fffffffffffffff]
test clock-61.4 {near-miss overflow of a wide integer on output} {
36971
36972
36973
36974
36975
36976
36977
36978
36979

36980

36981
36982
36983
36984
36985
36986
36987
36920
36921
36922
36923
36924
36925
36926

36927
36928

36929
36930
36931
36932
36933
36934
36935
36936







-

+
-
+







    -result 2001-02-03::04:05:06
}

test clock-65.1 {clock add, bad option [Bug 2481670]} {*}{
    -body {
	clock add 0 1 year -foo bar
    }
    -match glob
    -returnCodes error
    -match glob
    -result {bad option "-foo"*}
    -result {bad switch "-foo"*}
}

test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
    -setup {
	::tcl::clock::ClearCaches
    }
    -body {
37001
37002
37003
37004
37005
37006
37007
37008
37009
37010
37011
37012
37013
37014
37015
37016
37017
37018
37019
37020
37021
37022
37023
37024
37025
37026
37027
37028
37029
37030
37031
37032
37033
37034
37035
37036
37037
37038
37039
37040
37041
36950
36951
36952
36953
36954
36955
36956























36957
36958
36959
36960
36961
36962
36963
36964
36965
36966
36967







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











    # error, not segfault
    tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
} -returnCodes error -match glob -result *
test clock-67.3 {Bug d19a30db57} -body {
    # error, not segfault
    tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
} -returnCodes error -match glob -result *
test clock-67.4 {Change format %x output on global locale change [Bug 4a0c163d24]} -setup {
    package require msgcat
    set current [msgcat::mclocale]
} -body {
    msgcat::mclocale de_de
    set res [regexp {^\d{2}\.\d{2}\.\d{4}$} [clock format 1 -locale current -format %x]]
    msgcat::mclocale en_uk
    lappend res [regexp {^\d{2}/\d{2}/\d{4}$} [clock format 1 -locale current -format %x]]
} -cleanup {
    msgcat::mclocale $current
} -result {1 1}
test clock-67.5 {Change scan %x output on global locale change [Bug 4a0c163d24]} -setup {
    package require msgcat
    set current [msgcat::mclocale]
} -body {
    msgcat::mclocale de_de
    set res [clock scan "01.01.1970" -locale current -format %x -gmt 1]
    msgcat::mclocale en_uk
    # This will fail without the bug fix, as still de_de is active
    expr {$res == [clock scan "01/01/1970" -locale current -format %x -gmt 1]}
} -cleanup {
    msgcat::mclocale $current
} -result {1}

# cleanup

namespace delete ::testClock
::tcl::clock::ClearCaches
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/cmdAH.test.

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
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


-
-
-
+
+
+




-
-
+
+

-
-
+
+



-
-
-



+
+
+
+





-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+




+
+
-
-
-
+
+
+



-
-
-
+
+
+







-
-
-
+
+
+

-
+

-
-


-
+
-
-
+

-
-
+
+
+



-
-

+



-
+
-
-


-
-
+
+
+



+

-
-



-
+
-
-


-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
-
-

-
-
-
+










-
-
-
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-

-
+
-

-
-
+
+
+

-

-
+
-

+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-

-
+
-

+
-
-
+
+

-

-
+
-

+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-

-
+
-

+
-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+


+
-
+


-

-
+
-


-
+
+


+
-
-
-
+
+
+
+







# The file tests the tclCmdAH.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint time64bit [expr {
    $::tcl_platform(pointerSize) >= 8 ||
    [llength [info command testsize]] && [testsize st_mtime] >= 8
}]
testConstraint linkDirectory [expr {
    ![testConstraint win] ||
    ($::tcl_platform(osVersion) >= 5.0
     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

global env
set cmdAHwd [pwd]
catch {set platform [testgetplatform]}

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without enough
    # data in its timestamps for even per-second-accurate timings. :^(
    # This procedure based on work by Helmut Giese
    if {
	[testConstraint win] &&
	[lindex [file system [temporaryDirectory]] 1] ne "NTFS"
    } then {
	# Assume non-NTFS means FAT{12,16,32} and hence in need of special
	# help...
	set start [clock seconds]
	while {1} {
	    set now [clock seconds]
	    if {$now!=$start && !($now & 1)} {
		break
	    }
	    after 50
	}
    }
}

test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
    break foo
} -returnCodes error -result {wrong # args: should be "break"}
test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {
    list [catch {break foo} msg] $msg
} {1 {wrong # args: should be "break"}}
test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
    list [catch {break} msg] $msg
} {3 {}}

# Tcl_CaseObjCmd is tested in case.test

test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
    catch
} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {
    list [catch {catch} msg] $msg
} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
    list [catch {catch foo bar baz} msg] $msg
} {0 1}
test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
    catch foo bar baz spaz
} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
test cmdAH-1.3 {Tcl_CatchObjCmd, errors} {
    list [catch {catch foo bar baz spaz} msg] $msg
} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
test cmdAH-1.4 {Bug 3595576} {
    catch {catch {} -> noSuchNs::var}
} 1
test cmdAH-1.5 {Bug 3595576} {
    catch {catch error -> noSuchNs::var}
} 1

test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
    cd foo bar
} -result {wrong # args: should be "cd ?dirName?"}
test cmdAH-2.1 {Tcl_CdObjCmd} {
    list [catch {cd foo bar} msg] $msg
} {1 {wrong # args: should be "cd ?dirName?"}}
set foodir [file join [temporaryDirectory] foo]
test cmdAH-2.2 {Tcl_CdObjCmd} -setup {
test cmdAH-2.2 {Tcl_CdObjCmd} {
    file delete -force $foodir
    set oldpwd [pwd]
} -body {
    file mkdir $foodir
    cd $foodir
    file tail [pwd]
    set result [file tail [pwd]]
} -cleanup {
    cd $oldpwd
    cd ..
    file delete $foodir
} -result foo
test cmdAH-2.3 {Tcl_CdObjCmd} -setup {
    set result
} foo
test cmdAH-2.3 {Tcl_CdObjCmd} {
    global env
    set oldpwd [pwd]
    set temp $env(HOME)
    file delete -force $foodir
} -body {
    set env(HOME) $oldpwd
    file delete -force $foodir
    file mkdir $foodir
    cd $foodir
    cd ~
    string equal [pwd] $oldpwd
    set result [string equal [pwd] $oldpwd]
} -cleanup {
    cd $oldpwd
    file delete $foodir
    set env(HOME) $temp
} -result 1
test cmdAH-2.4 {Tcl_CdObjCmd} -setup {
    set result
} 1
test cmdAH-2.4 {Tcl_CdObjCmd} {
    global env
    set oldpwd [pwd]
    set temp $env(HOME)
    set env(HOME) $oldpwd
    file delete -force $foodir
} -body {
    set env(HOME) $oldpwd
    file mkdir $foodir
    cd $foodir
    cd
    string equal [pwd] $oldpwd
    set result [string equal [pwd] $oldpwd]
} -cleanup {
    cd $oldpwd
    file delete $foodir
    set env(HOME) $temp
} -result 1
test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body {
    cd ~~
} -result {user "~" doesn't exist}
test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body {
    cd _foobar
} -result {couldn't change working directory to "_foobar": no such file or directory}
test cmdAH-2.6.1 {Tcl_CdObjCmd} -returnCodes error -body {
    cd ""
} -result {couldn't change working directory to "": no such file or directory}
test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
    set result
} 1
test cmdAH-2.5 {Tcl_CdObjCmd} {
    list [catch {cd ~~} msg] $msg
} {1 {user "~" doesn't exist}}
test cmdAH-2.6 {Tcl_CdObjCmd} {
    list [catch {cd _foobar} msg] $msg
} {1 {couldn't change working directory to "_foobar": no such file or directory}}
test cmdAH-2.6.1 {Tcl_CdObjCmd} {
    list [catch {cd ""} msg] $msg
} {1 {couldn't change working directory to "": no such file or directory}}

    set dir [pwd]
} -body {
    cd /
    pwd
} -cleanup {
    cd $dir
} -result {/}
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
    set dir [pwd]
} -returnCodes error -body {
    cd .\0
} -cleanup {
    cd $dir
} -match glob -result "couldn't change working directory to \".\0\": *"
} -result "couldn't change working directory to \".\0\": no such file or directory"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
    concat
} {}
test cmdAH-2.8 {Tcl_ConcatObjCmd} {
    concat a
} a
test cmdAH-2.9 {Tcl_ConcatObjCmd} {
    concat a {b c}
} {a b c}

test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body {
    continue foo
} -result {wrong # args: should be "continue"}
test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {
    list [catch {continue foo} msg] $msg
} {1 {wrong # args: should be "continue"}}
test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
    list [catch {continue} msg] $msg
} {4 {}}

test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding foo
} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system}
test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto
} -result {wrong # args: should be "encoding convertto ?encoding? data"}
test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertto foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
test cmdAH-4.1 {Tcl_EncodingObjCmd} {
    list [catch {encoding} msg] $msg
} {1 {wrong # args: should be "encoding option ?arg ...?"}}
test cmdAH-4.2 {Tcl_EncodingObjCmd} {
    list [catch {encoding foo} msg] $msg
} {1 {bad option "foo": must be convertfrom, convertto, dirs, names, or system}}
test cmdAH-4.3 {Tcl_EncodingObjCmd} {
    list [catch {encoding convertto} msg] $msg
} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}
test cmdAH-4.4 {Tcl_EncodingObjCmd} {
    list [catch {encoding convertto foo bar} msg] $msg
} {1 {unknown encoding "foo"}}
test cmdAH-4.5 {Tcl_EncodingObjCmd} {
    set system [encoding system]
} -body {
    encoding system jis0208
    encoding convertto \u4e4e
    set x [encoding convertto \u4e4e]
} -cleanup {
    encoding system $system
} -result 8C
test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
    set x
} 8C
test cmdAH-4.6 {Tcl_EncodingObjCmd} {
    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding convertto jis0208 \u4e4e
    set x [encoding convertto jis0208 \u4e4e]
} -cleanup {
    encoding system $system
    set x
} -result 8C
test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding convertfrom foo bar
} -result {unknown encoding "foo"}
test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
} 8C
test cmdAH-4.7 {Tcl_EncodingObjCmd} {
    list [catch {encoding convertfrom} msg] $msg
} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}
test cmdAH-4.8 {Tcl_EncodingObjCmd} {
    list [catch {encoding convertfrom foo bar} msg] $msg
} {1 {unknown encoding "foo"}}
test cmdAH-4.9 {Tcl_EncodingObjCmd} {
    set system [encoding system]
} -body {
    encoding system jis0208
    encoding convertfrom 8C
    set x [encoding convertfrom 8C]
} -cleanup {
    encoding system $system
    set x
} -result \u4e4e
test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
} \u4e4e
test cmdAH-4.10 {Tcl_EncodingObjCmd} {
    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding convertfrom jis0208 8C
    set x [encoding convertfrom jis0208 8C]
} -cleanup {
    encoding system $system
    set x
} -result \u4e4e
test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding names foo
} -result {wrong # args: should be "encoding names"}
test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body {
    encoding system foo bar
} -result {wrong # args: should be "encoding system ?encoding?"}
test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
} \u4e4e
test cmdAH-4.11 {Tcl_EncodingObjCmd} {
    list [catch {encoding names foo} msg] $msg
} {1 {wrong # args: should be "encoding names"}}
test cmdAH-4.12 {Tcl_EncodingObjCmd} {
    list [catch {encoding system foo bar} msg] $msg
} {1 {wrong # args: should be "encoding system ?encoding?"}}
test cmdAH-4.13 {Tcl_EncodingObjCmd} {
    set system [encoding system]
} -body {
    encoding system iso8859-1
    encoding system
    set x [encoding system]
} -cleanup {
    encoding system $system
    set x
} -result iso8859-1
} iso8859-1

test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
    file
} -result {wrong # args: should be "file subcommand ?arg ...?"}
test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
    file x
} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable}
test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
    file exists
} -result {wrong # args: should be "file exists name"}
test cmdAH-5.1 {Tcl_FileObjCmd} {
    list [catch file msg] $msg
} {1 {wrong # args: should be "file option ?arg ...?"}}
test cmdAH-5.2 {Tcl_FileObjCmd} {
    list [catch {file x} msg] $msg
} {1 {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-5.3 {Tcl_FileObjCmd} {
    list [catch {file exists} msg] $msg
} {1 {wrong # args: should be "file exists name"}}
test cmdAH-5.4 {Tcl_FileObjCmd} {
    file exists ""
} 0
    list [catch {file exists ""} msg] $msg
} {0 0}

# volume
test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body {
    file volumes x
} -result {wrong # args: should be "file volumes"}
test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body {
    lindex [file volumes] 0
} -match glob -result ?*
test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body {
#volume

test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {
    list [catch {file volumes x} msg] $msg
} {1 {wrong # args: should be "file volumes"}}
test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {
	set volumeList [file volumes]
	if { [llength $volumeList] == 0 } {
		set result 0
	} else {
		set result 1
	}
} {1}
test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} {
    set volumeList [file volumes]
    glob -nocomplain [lindex $volumeList 0]*
} -match glob -result *
test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body {
    catch [list glob -nocomplain [lindex $volumeList 0]*]
} {0}
test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win {
    set volumeList [string tolower [file volumes]]
    set element [lsearch -exact $volumeList "c:/"]
    list [expr {$element>=0}] [glob -nocomplain [lindex $volumeList $element]*]
} -match glob -result {1 *}
    list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
} {0 1 0}

test cmdAH-6.5 {cd} {unix nonPortable} {
    set dir [pwd]
    cd /
    set res [pwd]
    cd $dir
    set res
} {/}

# attributes

test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup {
test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {
    set foofile [makeFile abcde foo.file]
    catch {file delete -force $foofile}
} -body {
    close [open $foofile w]
    file attributes $foofile
    set res [catch {file attributes $foofile}]
} -cleanup {
    # We used [makeFile] so we undo with [removeFile]
    removeFile $foofile
} -match glob -result *
    set res
} {0}

# dirname

test cmdAH-8.1 {Tcl_FileObjCmd: dirname} -returnCodes error -body {
    file dirname a b
} -result {wrong # args: should be "file dirname name"}
test cmdAH-8.1 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    list [catch {file dirname a b} msg] $msg
} {1 {wrong # args: should be "file dirname name"}}
test cmdAH-8.2 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname /a/b
} /a
test cmdAH-8.3 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname {}
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
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







-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+


-
-
-
+
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
+
+
+
+
+



+
-
-
-
+
+
+
+







} a/b.c
test cmdAH-8.11 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname /.
} /
test cmdAH-8.12 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname /
} /
    list [catch {file dirname /} msg] $msg
} {0 /}
test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname /foo
} /
    list [catch {file dirname /foo} msg] $msg
} {0 /}
test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname //foo
} /
    list [catch {file dirname //foo} msg] $msg
} {0 /}
test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname //foo/bar
} /foo
    list [catch {file dirname //foo/bar} msg] $msg
} {0 /foo}
test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname {//foo\/bar/baz}
} {/foo\/bar}
    list [catch {file dirname {//foo\/bar/baz}} msg] $msg
} {0 {/foo\/bar}}
test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname {//foo\/bar/baz/blat}
} {/foo\/bar/baz}
    list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg
} {0 {/foo\/bar/baz}}
test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname /foo//
} /
    list [catch {file dirname /foo//} msg] $msg
} {0 /}
test cmdAH-8.19 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname ./a
} .
    list [catch {file dirname ./a} msg] $msg
} {0 .}
test cmdAH-8.20 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname a/.a
} a
    list [catch {file dirname a/.a} msg] $msg
} {0 a}
test cmdAH-8.21 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform windows
    file dirname c:foo
} c:
    list [catch {file dirname c:foo} msg] $msg
} {0 c:}
test cmdAH-8.22 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform windows
    file dirname c:
} c:
    list [catch {file dirname c:} msg] $msg
} {0 c:}
test cmdAH-8.23 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform windows
    file dirname c:/
} c:/
    list [catch {file dirname c:/} msg] $msg
} {0 c:/}
test cmdAH-8.24 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform windows
    file dirname {c:\foo}
} c:/
    list [catch {file dirname {c:\foo}} msg] $msg
} {0 c:/}
test cmdAH-8.25 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform windows
    file dirname {//foo/bar/baz}
} //foo/bar
    list [catch {file dirname {//foo/bar/baz}} msg] $msg
} {0 //foo/bar}
test cmdAH-8.26 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform windows
    file dirname {//foo/bar}
} //foo/bar
    list [catch {file dirname {//foo/bar}} msg] $msg
} {0 //foo/bar}
test cmdAH-8.38 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname ~/foo
} ~
    list [catch {file dirname ~/foo} msg] $msg
} {0 ~}
test cmdAH-8.39 {Tcl_FileObjCmd: dirname} testsetplatform {
    testsetplatform unix
    file dirname ~bar/foo
} ~bar
test cmdAH-8.43 {Tcl_FileObjCmd: dirname} -setup {
    list [catch {file dirname ~bar/foo} msg] $msg
} {0 ~bar}
test cmdAH-8.43 {Tcl_FileObjCmd: dirname} testsetplatform {
    global env
    set temp $env(HOME)
} -constraints testsetplatform -body {
    set env(HOME) "/homewontexist/test"
    testsetplatform unix
    file dirname ~
    set result [list [catch {file dirname ~} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result /homewontexist
test cmdAH-8.44 {Tcl_FileObjCmd: dirname} -setup {
} {0 /homewontexist}
test cmdAH-8.44 {Tcl_FileObjCmd: dirname} testsetplatform {
    global env
    set temp $env(HOME)
} -constraints testsetplatform -body {
    set env(HOME) "~"
    testsetplatform unix
    file dirname ~
    set result [list [catch {file dirname ~} msg] $msg]
} -cleanup {
    set env(HOME) $temp
} -result ~
test cmdAH-8.45 {Tcl_FileObjCmd: dirname} -setup {
    set temp $::env(HOME)
} -constraints {win testsetplatform} -match regexp -body {
    set ::env(HOME) "/homewontexist/test"
    testsetplatform windows
    file dirname ~
} -cleanup {
    set ::env(HOME) $temp
} -result {([a-zA-Z]:?)/homewontexist}
    set result
} {0 ~}
test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {
    -constraints {win testsetplatform}
    -match regexp
    -setup {
	set temp $::env(HOME)
    }
    -body {
	set ::env(HOME) "/homewontexist/test"
	testsetplatform windows
	file dirname ~
    }
    -cleanup {
	set ::env(HOME) $temp
    }
    -result {([a-zA-Z]:?)/homewontexist}
}
test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
    set f [file normalize [info nameof]]
    file exists $f
    set res1 [file dirname [file join $f foo/bar]]
    set res2 [file dirname "${f}/foo/bar"]
    if {$res1 eq $res2} {
	return "ok"
    }
    return "file dirname problem, $res1, $res2 not equal"
	set res "ok"
    } else {
        set res "file dirname problem, $res1, $res2 not equal"
    }
    set res
} {ok}

# tail

test cmdAH-9.1 {Tcl_FileObjCmd: tail} -returnCodes error -body {
    file tail a b
} -result {wrong # args: should be "file tail name"}
test cmdAH-9.1 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform unix
    list [catch {file tail a b} msg] $msg
} {1 {wrong # args: should be "file tail name"}}
test cmdAH-9.2 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform unix
    file tail /a/b
} b
test cmdAH-9.3 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform unix
    file tail {}
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
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







-
+


-


-
+
-

-
-
+
+
+


-


-
+
-

-
-
+
+
+


-


-
+
-

-
+
+







    testsetplatform windows
    file tail {//foo/bar/baz}
} baz
test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform windows
    file tail {//foo/bar}
} {}
test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
test cmdAH-9.42 {Tcl_FileObjCmd: tail} testsetplatform {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) "/home/test"
    testsetplatform unix
    file tail ~
    set result [file tail ~]
} -cleanup {
    set env(HOME) $temp
} -result test
test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
    set result
} test
test cmdAH-9.43 {Tcl_FileObjCmd: tail} testsetplatform {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) "~"
    testsetplatform unix
    file tail ~
    set result [file tail ~]
} -cleanup {
    set env(HOME) $temp
} -result {}
test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
    set result
} {}
test cmdAH-9.44 {Tcl_FileObjCmd: tail} testsetplatform {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) "/home/test"
    testsetplatform windows
    file tail ~
    set result [file tail ~]
} -cleanup {
    set env(HOME) $temp
} -result test
    set result
} test
test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform unix
    file tail {f.oo\bar/baz.bat}
} baz.bat
test cmdAH-9.47 {Tcl_FileObjCmd: tail} testsetplatform {
    testsetplatform windows
    file tail c:foo
570
571
572
573
574
575
576

577
578
579




580
581
582
583
584
585
586
550
551
552
553
554
555
556
557



558
559
560
561
562
563
564
565
566
567
568







+
-
-
-
+
+
+
+







	[file tail {~/~foo}] \
	[file tail {~/test/~foo}] \
	[file tail [file normalize {~/~foo}]] \
	[file tail [file normalize {~/test/~foo}]]
} [lrepeat 4 ./~foo]

# rootname

test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body {
    file rootname a b
} -result {wrong # args: should be "file rootname name"}
test cmdAH-10.1 {Tcl_FileObjCmd: rootname} testsetplatform {
    testsetplatform unix
    list [catch {file rootname a b} msg] $msg
} {1 {wrong # args: should be "file rootname name"}}
test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform {
    testsetplatform unix
    file rootname {}
} {}
test cmdAH-10.3 {Tcl_FileObjCmd: rootname} testsetplatform {
    testsetplatform unix
    file ro foo
670
671
672
673
674
675
676

677
678
679




680
681
682
683
684
685
686
652
653
654
655
656
657
658
659



660
661
662
663
664
665
666
667
668
669
670







+
-
-
-
+
+
+
+







	    [list format %s%s [file rootname $thing] [file ext $thing]]
	" $thing
	incr num
    }
}

# extension

test cmdAH-11.1 {Tcl_FileObjCmd: extension} -returnCodes error -body {
    file extension a b
} -result {wrong # args: should be "file extension name"}
test cmdAH-11.1 {Tcl_FileObjCmd: extension} testsetplatform {
    testsetplatform unix
    list [catch {file extension a b} msg] $msg
} {1 {wrong # args: should be "file extension name"}}
test cmdAH-11.2 {Tcl_FileObjCmd: extension} testsetplatform {
    testsetplatform unix
    file extension {}
} {}
test cmdAH-11.3 {Tcl_FileObjCmd: extension} testsetplatform {
    testsetplatform unix
    file ext foo
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
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

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

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
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
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
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
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







-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

+
-
-
-
+
+
+
+














+
-
-
-
+
+
+
+










+














+
-
+

-
-
+
+




+


+

-
-
-
+
+



-
+





-
-
+
+




+

-
-
-
+
+



-
+





-
+




+

+




+
-
-
-
+
+
+




-
-
-
+
+
+
+


+
-
+

-
+
-
-
-
-
+
+
-
-
+
-
+

+
+
+
-
-
-
-
+
+
+
+
+
+
+
-


+









+
-
-
-
+
+
+















+

-
+

-
-
-
-
-
+
+
+

-
-
-
-
+
+
+



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-



+
-
-
+
+



-
+
+




















+
+








-
-
-
-
-
-
+
+
+
+
+
-



-
+

-
-
-
-
-
+
+
+
+
+
+







-
+


-
+
-
-
-
-
-
+
+
+








-
+
-
-
-
-
-
-
-
-
-
-








+
-
-
-
-
-
+
+
+
+
+
+
+
+
+


+
-
-
-
+
+
+



-
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-


-
-
-
+
+
+
-


-
+

-
-
-
-
-
+
+
+
+
+
-


-
-
+
+
+

+


-
+

-

-
+
-

+
-
-
+
+

-

-
+
-

+
-
-
+
+

-

-
+
-

+
-
-
+
+


-

-
+
-


-
+
-
-
-
-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
















-
-
-
+
+
+
-



-
+

-
-
-
-
-
+
+
+
+
+
+





-
-
-
+
+


-
+
-

+
-
-
-
-
+
+
+
+







-
+

-







-
+
+
+
+
+

-
+
-
-
-
+

-





-
-
+
+


-







-
+
+
+
+
+

-
+
-
-


-
+



-



-
-

+
-
+













-
-
-
-
-
-
-
-
-
-


-
+






-
+








+
-
-
-
+
+
+







    testsetplatform windows
    file extension a\\b.c\\d
} {}
test cmdAH-11.34 {Tcl_FileObjCmd: extension} testsetplatform {
    testsetplatform windows
    file extension a\\b.c\\
} {}
foreach {test onPlatform value result} {
set num 35
    cmdAH-11.35 unix    a..b   .b
    cmdAH-11.36 windows a..b   .b
    cmdAH-11.37 unix    a...b  .b
    cmdAH-11.38 windows a...b  .b
    cmdAH-11.39 unix    a.c..b .b
    cmdAH-11.40 windows a.c..b .b
foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {
    foreach p {unix windows} {
    cmdAH-11.41 unix    ..b    .b
    cmdAH-11.42 windows ..b    .b
} {
    test $test {Tcl_FileObjCmd: extension} testsetplatform "
	testsetplatform $onPlatform
	file extension $value
    " $result
}

	;test cmdAH-11.$num {Tcl_FileObjCmd: extension} testsetplatform "
	    testsetplatform $p
	    file extension $value
	" $result
	incr num
    }
}

# pathtype

test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} -returnCodes error -body {
    file pathtype a b
} -result {wrong # args: should be "file pathtype name"}
test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} testsetplatform {
    testsetplatform unix
    list [catch {file pathtype a b} msg] $msg
} {1 {wrong # args: should be "file pathtype name"}}
test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} testsetplatform {
    testsetplatform unix
    file pathtype /a
} absolute
test cmdAH-12.3 {Tcl_FileObjCmd: pathtype} testsetplatform {
    testsetplatform unix
    file p a
} relative
test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} testsetplatform {
    testsetplatform windows
    file pathtype c:a
} volumerelative

# split

test cmdAH-13.1 {Tcl_FileObjCmd: split} -returnCodes error -body {
    file split a b
} -result {wrong # args: should be "file split name"}
test cmdAH-13.1 {Tcl_FileObjCmd: split} testsetplatform {
    testsetplatform unix
    list [catch {file split a b} msg] $msg
} {1 {wrong # args: should be "file split name"}}
test cmdAH-13.2 {Tcl_FileObjCmd: split} testsetplatform {
    testsetplatform unix
    file split a
} a
test cmdAH-13.3 {Tcl_FileObjCmd: split} testsetplatform {
    testsetplatform unix
    file split a/b
} {a b}

# join

test cmdAH-14.1 {Tcl_FileObjCmd: join} testsetplatform {
    testsetplatform unix
    file join a
} a
test cmdAH-14.2 {Tcl_FileObjCmd: join} testsetplatform {
    testsetplatform unix
    file join a b
} a/b
test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform {
    testsetplatform unix
    file join a b c d
} a/b/c/d

# error handling of Tcl_TranslateFileName

test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body {
test cmdAH-15.1 {Tcl_FileObjCmd} testsetplatform {
    testsetplatform unix
    file atime ~_bad_user
} -returnCodes error -result {user "_bad_user" doesn't exist}
    list [catch {file atime ~_bad_user} msg] $msg
} {1 {user "_bad_user" doesn't exist}}

catch {testsetplatform $platform}

# readable

set gorpfile [makeFile abcde gorp.file]
set dirfile [makeDirectory dir.file]

test cmdAH-16.1 {Tcl_FileObjCmd: readable} {
    -returnCodes error
    -body   {file readable a b}
    -result {wrong # args: should be "file readable name"}
    -body   {list [catch {file readable a b} msg] $msg}
    -result {1 {wrong # args: should be "file readable name"}}
}
test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
    -constraints testchmod
    -setup  	 {testchmod 0o444 $gorpfile}
    -setup  	 {testchmod 0444 $gorpfile}
    -body   	 {file readable $gorpfile}
    -result 	 1
}
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
    -constraints {unix notRoot testchmod}
    -setup  	 {testchmod 0o333 $gorpfile}
    -body   	 {file readable $gorpfile}
    -setup  	 {testchmod 0333 $gorpfile}
    -body   	 {file reada $gorpfile}
    -result 	 0
}

# writable

test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
    -returnCodes error
    -body   {file writable a b}
    -result {wrong # args: should be "file writable name"}
    -body   {list [catch {file writable a b} msg] $msg}
    -result {1 {wrong # args: should be "file writable name"}}
}
test cmdAH-17.2 {Tcl_FileObjCmd: writable} {
    -constraints {notRoot testchmod}
    -setup  	 {testchmod 0o555 $gorpfile}
    -setup  	 {testchmod 0555 $gorpfile}
    -body   	 {file writable $gorpfile}
    -result 	 0
}
test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
    -constraints testchmod
    -setup  	 {testchmod 0o222 $gorpfile}
    -setup  	 {testchmod 0222 $gorpfile}
    -body   	 {file writable $gorpfile}
    -result 	 1
}


# executable

removeFile $gorpfile
removeDirectory $dirfile
set dirfile [makeDirectory dir.file]
set gorpfile [makeFile abcde gorp.file]

test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body {
    file executable a b
} -result {wrong # args: should be "file executable name"}
test cmdAH-18.1 {Tcl_FileObjCmd: executable} {} {
    list [catch {file executable a b} msg] $msg
} {1 {wrong # args: should be "file executable name"}}
test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} {
    file executable $gorpfile
} 0
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
    # Only on unix will setting the execute bit on a regular file cause that
    # file to be executable.
    testchmod 0o775 $gorpfile
    # Only on unix will setting the execute bit on a regular file
    # cause that file to be executable.

    testchmod 0775 $gorpfile
    file exe $gorpfile
} 1

test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win} {
    # On windows, must be a .exe, .com, etc.
    set x {}

    set gorpexes {}
    foreach ext {exe com cmd bat} {
        lappend x [file exe nosuchfile.$ext]
        set gorpexe [makeFile foo gorp.$ext]
    set x [file exe $gorpfile]
    set gorpexe [makeFile foo gorp.exe]
        lappend gorpexes $gorpexe
        lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]
    lappend x [file exe $gorpexe]
    }
    removeFile $gorpexe
    set x
} {0 1}
test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} {win} {
    # On windows, must be a .exe, .com, etc.
} -cleanup {
    foreach gorpexe $gorpexes {
        removeFile $gorpexe
    }

    set x [file exe $gorpfile]
    set gorpexe [makeFile foo gorp.exe]
    lappend x [file exe [string toupper $gorpexe]]
    removeFile $gorpexe
    set x
} {0 1}
} -result {0 1 1 0 1 1 0 1 1 0 1 1}
test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
    # Directories are always executable.

    file exe $dirfile
} 1

removeDirectory $dirfile
removeFile $gorpfile
set linkfile [file join [temporaryDirectory] link.file]
file delete $linkfile

# exists

test cmdAH-19.1 {Tcl_FileObjCmd: exists} -returnCodes error -body {
    file exists a b
} -result {wrong # args: should be "file exists name"}
test cmdAH-19.1 {Tcl_FileObjCmd: exists} {
    list [catch {file exists a b} msg] $msg
} {1 {wrong # args: should be "file exists name"}}
test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0
test cmdAH-19.3 {Tcl_FileObjCmd: exists} {
    file exists [file join [temporaryDirectory] dir.file gorp.file]
} 0
catch {
    set gorpfile [makeFile abcde gorp.file]
    set dirfile [makeDirectory dir.file]
    set subgorp [makeFile 12345 [file join $dirfile gorp.file]]
}
test cmdAH-19.4 {Tcl_FileObjCmd: exists} {
    file exists $gorpfile
} 1
test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
    file exists $subgorp
} 1

# nativename
test cmdAH-19.6 {Tcl_FileObjCmd: nativename} -body {
test cmdAH-19.6 {Tcl_FileObjCmd: nativename} testsetplatform {
    testsetplatform unix
    file nativename a/b
} -constraints testsetplatform -cleanup {
    testsetplatform $platform
} -result a/b
test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body {
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 a/b {}}
test cmdAH-19.7 {Tcl_FileObjCmd: nativename} testsetplatform {
    testsetplatform windows
    file nativename a/b
} -constraints testsetplatform -cleanup {
    testsetplatform $platform
} -result {a\b}
    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
} {0 {a\b} {}}

test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
    file exists ~nOsUcHuSeR
} 0
test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body {
    # should probably be a non-error in fact...
    file nativename ~nOsUcHuSeR
} -returnCodes error -match glob -result *
# The test below has to be done in /tmp rather than the current directory in
# order to guarantee (?) a local file system: some NFS file systems won't do
# the stuff below correctly.
test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup {
test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
    # should probably be 0 in fact...
    catch {file nativename ~nOsUcHuSeR}
} 1

# The test below has to be done in /tmp rather than the current
# directory in order to guarantee (?) a local file system:  some
# NFS file systems won't do the stuff below correctly.

test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unix notRoot} {
    file delete -force /tmp/tcl.foo.dir/file
    file delete -force /tmp/tcl.foo.dir
} -body {
    makeDirectory /tmp/tcl.foo.dir
    makeFile 12345 /tmp/tcl.foo.dir/file
    file attributes /tmp/tcl.foo.dir -permissions 0000

    file exists /tmp/tcl.foo.dir/file
} -cleanup {
    set result [file exists /tmp/tcl.foo.dir/file]

    file attributes /tmp/tcl.foo.dir -permissions 0775
    removeFile /tmp/tcl.foo.dir/file
    removeDirectory /tmp/tcl.foo.dir
} -result 0
    set result
} 0
test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup {
    set newdirfile [makeDirectory newdir.file]
    set cwd [pwd]
    cd $newdirfile
    # Content of file is totally unimportant; name is *not*
    set innocentBystander [makeFile "abc" [file join $newdirfile foo.bar]]
} -body {
    list [file exists foo.bar] [file exists *.bar]
} -cleanup {
    cd $cwd
    removeFile $innocentBystander
    removeDirectory $newdirfile
} -result {1 0}

# Stat related commands

catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}

# atime

# avoid problems with non-local filesystems
if {[testConstraint unix] && [file exists /tmp]} {
    set file [makeFile "data" touch.me /tmp]
} else {
    set file [makeFile "data" touch.me]
}

# atime
test cmdAH-20.1 {Tcl_FileObjCmd: atime} -returnCodes error -body {
    file atime a b c
} -result {wrong # args: should be "file atime name ?time?"}
test cmdAH-20.2 {Tcl_FileObjCmd: atime} -setup {
    unset -nocomplain stat
test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
    list [catch {file atime a b c} msg] $msg
} {1 {wrong # args: should be "file atime name ?time?"}}
test cmdAH-20.2 {Tcl_FileObjCmd: atime} {
    catch {unset stat}
} -body {
    file stat $gorpfile stat
    list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
	    [expr {[file atime $gorpfile] == $stat(atime)}]
} -result {1 1}
} {1 1}
test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
    list [catch {file atime _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-20.4 {Tcl_FileObjCmd: atime} -returnCodes error -body {
    file atime $file notint
} -result {expected integer but got "notint"}
    string tolower [list [catch {file atime _bogus_} msg] \
	    $msg $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
    list [catch {file atime $file notint} msg] $msg
} {1 {expected integer but got "notint"}}
test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} {
    set atime [file atime $file]
    after 1100; # pause a sec to notice change in atime
    set newatime [clock seconds]
    set modatime [file atime $file $newatime]
    expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} 1
test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup {
test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} {
    set old [pwd]
    cd $::tcltest::temporaryDirectory
    set volumetype [testvolumetype]
    if {"NTFS" ne [testvolumetype]} {
    cd $old
} -constraints {win testvolumetype} -body {
    if {"NTFS" ne $volumetype} {
	# Windows FAT doesn't understand atime, but NTFS does. May also fail
	# for Windows on NFS mounted disks.
	# Windows FAT doesn't understand atime, but NTFS does
	# May also fail for Windows on NFS mounted disks
	cd $old
	return 1
    }
    cd $old
    set atime [file atime $file]
    after 1100; # pause a sec to notice change in atime
    set newatime [clock seconds]
    set modatime [file atime $file $newatime]
    expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} -result 1
} 1
test cmdAH-20.7 {
    Tcl_FileObjCmd: atime (built-in Windows names)
} -constraints {win} -body {
    file atime con
} -result "could not get access time for file \"con\"" -returnCodes error
test cmdAH-20.7.1 {
    Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file atime [file join [temporaryDirectory] CON.txt]
} -match regexp -result {could not (?:get access time|read)} -returnCodes error

if {[testConstraint unix] && [file exists /tmp]} {
    removeFile touch.me /tmp
} else {
    removeFile touch.me
}

# isdirectory

test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} -returnCodes error -body {
    file isdirectory a b
} -result {wrong # args: should be "file isdirectory name"}
test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {file isdirectory $gorpfile} 0
test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {file isdirectory $dirfile} 1
test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {
    list [catch {file isdirectory a b} msg] $msg
} {1 {wrong # args: should be "file isdirectory name"}}
test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {
    file isdirectory $gorpfile
} 0
test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
    file isd $dirfile
} 1

# isfile

test cmdAH-22.1 {Tcl_FileObjCmd: isfile} -returnCodes error -body {
    file isfile a b
} -result {wrong # args: should be "file isfile name"}
test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {
    list [catch {file isfile a b} msg] $msg
} {1 {wrong # args: should be "file isfile name"}}
test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile $gorpfile} 1
test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0

# lstat and readlink: don't run these tests everywhere, since not all sites
# will have symbolic links
# lstat and readlink:  don't run these tests everywhere, since not all
# sites will have symbolic links

catch {file link -symbolic $linkfile $gorpfile}
test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
    file lstat a
} -result {wrong # args: should be "file lstat name varName"}
test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
    file lstat a b c
} -result {wrong # args: should be "file lstat name varName"}
test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup {
    unset -nocomplain stat
test cmdAH-23.1 {Tcl_FileObjCmd: lstat} {
    list [catch {file lstat a} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
    list [catch {file lstat a b c} msg] $msg
} {1 {wrong # args: should be "file lstat name varName"}}
test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unix nonPortable} {
    catch {unset stat}
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
    unset -nocomplain stat
} {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unix nonPortable} {
    catch {unset stat}
} -constraints {unix nonPortable} -body {
    file lstat $linkfile stat
    list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
} -result {1 511 link}
} {1 511 link}
test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
    list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \
	$errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
    unset -nocomplain x
    string tolower [list [catch {file lstat _bogus_ stat} msg] \
	    $msg $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {
    catch {unset x}
} -body {
    set x 44
    list [catch {file lstat $gorpfile x} msg] $msg $errorCode
} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}}
unset -nocomplain stat
} {1 {can't set "x(dev)": variable isn't array} NONE}
catch {unset stat}

# mkdir

set dirA [file join [temporaryDirectory] a]
set dirB [file join [temporaryDirectory] a]
test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} -setup {
test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {
    catch {file delete -force $dirA}
} -body {
    file mkdir $dirA
    file isdirectory $dirA
    set res [file isdirectory $dirA]
} -cleanup {
    file delete $dirA
    set res
} -result {1}
test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} -setup {
} {1}
test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {
    catch {file delete -force $dirA}
} -body {
    file mkdir $dirA/b
    file isdirectory $dirA/b
    set res [file isdirectory $dirA/b]
} -cleanup {
    file delete -force $dirA
    set res
} -result {1}
test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} -setup {
} {1}
test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {
    catch {file delete -force $dirA}
} -body {
    file mkdir $dirA/b/c
    file isdirectory $dirA/b/c
    set res [file isdirectory $dirA/b/c]
} -cleanup {
    file delete -force $dirA
    set res
} -result {1}
test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} -setup {
} {1}
test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {
    catch {file delete -force $dirA}
    catch {file delete -force $dirB}
} -body {
    file mkdir $dirA/b $dirB/a/c
    list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]
    set res [list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]]
} -cleanup {
    file delete -force $dirA
    file delete -force $dirB
} -result {1 1}
    set res
test cmdAH-23.11 {Tcl_FileObjCmd: mkdir} {
    # Allow zero arguments (TIP 323)
    file mkdir
} {}
} {1 1}

# mtime

proc waitForEvenSecondForFAT {} {
    # Windows 9x uses filesystems (the FAT* family of FSes) without
    # enough data in its timestamps for even per-second-accurate
    # timings.  :^(
    # This procedure based on work by Helmut Giese

    if {
	[testConstraint win]
	&& [lindex [file system [temporaryDirectory]] 1] ne "NTFS"
    } then {
	# Assume non-NTFS means FAT{12,16,32} and hence in need of special help
	set start [clock seconds]
	while {1} {
	    set now [clock seconds]
	    if {$now!=$start && !($now & 1)} {
		break
	    }
	    after 50
	}
    }
}
set file [makeFile "data" touch.me]
# mtime
test cmdAH-24.1 {Tcl_FileObjCmd: mtime} -returnCodes error -body {
    file mtime a b c
} -result {wrong # args: should be "file mtime name ?time?"}

test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {
    list [catch {file mtime a b c} msg] $msg
} {1 {wrong # args: should be "file mtime name ?time?"}}
test cmdAH-24.2 {Tcl_FileObjCmd: mtime} -setup {
    # Check (allowing for clock-skew and OS interrupts as best we can) that
    # the change in mtime on a file being written is the time elapsed between
    # writes. Note that this can still fail on very busy systems if there are
    # long preemptions between the writes and the reading of the clock, but
    # there's not much you can do about that other than the completely
    # horrible "keep on trying to write until you managed to do it all in less
    # than a second." - DKF
# Check (allowing for clock-skew and OS interrupts as best we can)
# that the change in mtime on a file being written is the time elapsed
# between writes.  Note that this can still fail on very busy systems
# if there are long preemptions between the writes and the reading of
# the clock, but there's not much you can do about that other than the
# completely horrible "keep on trying to write until you managed to do
# it all in less than a second."  - DKF
test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
    waitForEvenSecondForFAT
} -body {
    set f [open $gorpfile w]
    puts $f "More text"
    close $f
    set clockOld [clock seconds]
    set fileOld [file mtime $gorpfile]
    after 2000
    set f [open $gorpfile w]
    puts $f "More text"
    close $f
    set clockNew [clock seconds]
    set fileNew [file mtime $gorpfile]
    expr {
	(($fileNew > $fileOld) && ($clockNew > $clockOld) &&
	(abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" :
	"file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)"
    }
} -result {1}
test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup {
    unset -nocomplain stat
} {1}
test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {
    catch {unset stat}
} -body {
    file stat $gorpfile stat
    list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
	    [expr {[file atime $gorpfile] == $stat(atime)}]
} -result {1 1}
} {1 1}
test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
    list [catch {file mtime _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-24.5 {Tcl_FileObjCmd: mtime} -setup {
    # Under Unix, use a file in /tmp to avoid clock skew due to NFS. On other
    # platforms, just use a file in the local directory.
    string tolower [list [catch {file mtime _bogus_} msg] $msg \
	    $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
    # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
    # On other platforms, just use a file in the local directory.
    if {[testConstraint unix]} {
	set name /tmp/tcl.test.[pid]
    } else {
	set name [file join [temporaryDirectory] tf]
    }
} -body {
    # Make sure that a new file's time is correct. 10 seconds variance is
    # allowed used due to slow networks or clock skew on a network drive.
    # Make sure that a new file's time is correct.  10 seconds variance
    # is allowed used due to slow networks or clock skew on a network drive.
    file delete -force $name
    close [open $name w]
    expr {abs([clock seconds]-[file mtime $name])<10}
    set a [expr abs([clock seconds]-[file mtime $name])<10]
} -cleanup {
    file delete $name
    set a
} -result {1}
test cmdAH-24.7 {Tcl_FileObjCmd: mtime} -returnCodes error -body {
    file mtime $file notint
} -result {expected integer but got "notint"}
} {1}
test cmdAH-24.7 {Tcl_FileObjCmd: mtime} {
    list [catch {file mtime $file notint} msg] $msg
} {1 {expected integer but got "notint"}}
test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix {
    set mtime [file mtime $file]
    after 1100; # pause a sec to notice change in mtime
    set newmtime [clock seconds]
    set modmtime [file mtime $file $newmtime]
    expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} 1
test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} unix {
    set oldfile $file
} -constraints unix -body {
    # introduce some non-ascii characters.
    append file \u2022
    file delete -force $file
    file rename $oldfile $file
    set mtime [file mtime $file]
    after 1100; # pause a sec to notice change in mtime
    set newmtime [clock seconds]
    set modmtime [file mtime $file $newmtime]
    set err [catch {file mtime $file $newmtime} modmtime]
    file rename $file $oldfile
    if {$err} {
	error $modmtime
    }
    expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} -cleanup {
} 1
    file rename $file $oldfile
} -result 1
test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} -constraints win -setup {
test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} win {
    waitForEvenSecondForFAT
} -body {
    set mtime [file mtime $file]
    after 2100; # pause two secs to notice change in mtime on FAT fs'es
    set newmtime [clock seconds]
    set modmtime [file mtime $file $newmtime]
    expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} -result 1
test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
} 1
test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} win {
    waitForEvenSecondForFAT
    set oldfile $file
} -constraints win -body {
    # introduce some non-ascii characters.
    append file \u2022
    file delete -force $file
    file rename $oldfile $file
    set mtime [file mtime $file]
    after 2100; # pause two secs to notice change in mtime on FAT fs'es
    set newmtime [clock seconds]
    set modmtime [file mtime $file $newmtime]
    set err [catch {file mtime $file $newmtime} modmtime]
    file rename $file $oldfile
    if {$err} {
	error $modmtime
    }
    expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
} -cleanup {
} 1
    file rename $file $oldfile
} -result 1
removeFile touch.me
rename waitForEvenSecondForFAT {}
test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} -setup {
test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {
    set name [file join [temporaryDirectory] clockchange]
    file delete -force $name
    close [open $name w]
} -body {
    set time [clock scan "21:00:00 October 30 2004 GMT"]
    file mtime $name $time
    set newmtime [file mtime $name]
    expr {$newmtime == $time ? 1 : "$newmtime != $time"}
} -cleanup {
    file delete $name
    expr {$newmtime == $time ? 1 : "$newmtime != $time"}
} -result {1}
} {1}
# bug 1420432: setting mtime fails for directories on windows.
test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
    set dirname [file join [temporaryDirectory] tmp[pid]]
    file delete -force $dirname
} -constraints tempNotWin -body {
    file mkdir $dirname
    set old [file mtime $dirname]
    file mtime $dirname 0
    set new [file mtime $dirname]
    list $new [expr {$old != $new}]
} -cleanup {
    file delete -force $dirname
} -result {0 1}
test cmdAH-24.14 {
    Tcl_FileObjCmd: mtime (built-in Windows names)
} -constraints {win} -body {
    file mtime con
} -result "could not get modification time for file \"con\"" -returnCodes error
test cmdAH-24.14.1 {
    Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    file mtime [file join [temporaryDirectory] CON.txt]
} -match regexp -result {could not (?:get modification time|read)} -returnCodes error

# 3155760000 is 64-bit unix time, Wed Jan 01 00:00:00 GMT 2070:
test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setup {
test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup {
    set filename [makeFile "" foo.text]
} -body {
    list [file atime $filename 3155760000] [file atime $filename]
} -cleanup {
    removeFile $filename
} -result {3155760000 3155760000}
test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -setup {
test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup {
    set filename [makeFile "" foo.text]
} -body {
    list [file mtime $filename 3155760000] [file mtime $filename]
} -cleanup {
    file delete -force $filename
} -result {3155760000 3155760000}

# owned

test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
    file owned a b
} -result {wrong # args: should be "file owned name"}
test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
    list [catch {file owned a b} msg] $msg
} {1 {wrong # args: should be "file owned name"}}
test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -setup {
    set fn $gorpfile
    # prefer temp file to check owner (try to avoid bug [7de2d722bd]):
    if {
	[info exists ::env(TEMP)] && [file isdirectory $::env(TEMP)] &&
        [file dirname $fn] ne [file normalize $::env(TEMP)]
    } {
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
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





1439
1440
1441
1442
1443



1444
1445
1446


1447
1448

1449
1450

1451

1452
1453
1454




1455
1456
1457
1458
1459
1460

1461
1462
1463
1464
1465
1466
1467



1468
1469
1470
1471
1472

1473
1474
1475


1476

1477

1478
1479

1480
1481
1482

1483
1484
1485
1486




1487
1488
1489
1490
1491
1492
1493
1494
1495

1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507


1508
1509
1510
1511

1512
1513
1514



1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527

1528
1529
1530
1531
1532

1533
1534
1535
1536



1537
1538
1539
1540
1541

1542
1543
1544
1545


1546
1547
1548


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
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
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
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
1772
1333
1334
1335
1336
1337
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
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
1439
1440


1441
1442
1443
1444
1445
1446
1447

1448


1449
1450
1451
1452
1453
1454
1455
1456

1457



1458




1459
1460
1461
1462
1463


1464





1465












1466
1467


1468
1469
1470



1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485

1486
1487

1488
1489

1490

1491


1492
1493
1494
1495

1496
1497

1498

1499
1500

1501
1502
1503


1504
1505















1506
1507
1508





1509
1510
1511
1512
1513



1514
1515
1516



1517
1518
1519






1520
1521
1522
1523
1524
1525



1526
1527
1528




1529
1530
1531
1532
1533
1534


1535
1536
1537
1538
1539


1540
1541
1542



1543
1544
1545
1546
1547
1548

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
1596
1597
1598
1599
1600
1601








































































































1602
1603
1604
1605
1606
1607
1608
1609

1610
1611
1612
1613
1614
1615
1616
1617







-
-
-
-
-
-
-
+
+
-
-
-

-
-
-
-
+
+
+




-
-
+
+
+

-
-
+
+
+


+
-
-
-
+
+
+









-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-






-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-

-
+

-
-
-
+
+
+
-


-
-
-
+
+
+
-

-
-
+
+

-
-
-
-
+
+
+
+
+
-

-
-
-
+
+
+
-
-

+
+

-
+
-

+
-
+

-
-
+
+
+
+






+





-
-
+
+
+




-
+
-
-

+
+

+

+

-
+
-
-
-
+
-
-
-
-
+
+
+
+

-
-

-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-


+
-
-
-
+
+
+












-
+

-


-
+
-

-
-
+
+
+

-


-
+
-


-
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
+
+
+
+


-
-
+
+



-
-
+
+

-
-
-
+
+
+



-
+





-
+
+

+








-
-
-
+
+
+
+


+









-
+


+

+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+







    file owned $tmpfile
} -cleanup {
    removeFile touch.me /tmp
} -result 1
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
    file owned /
} 0
test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints {win notWine} -body {
    if {[info exists env(SystemRoot)]} {
	file owned $env(SystemRoot)
    } else {
	file owned $env(windir)
    }
} -result 0

# readlink
test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {
    file owned nosuchfile
} -result 0

# readlink
test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body {
    file readlink a b
} -result {wrong # args: should be "file readlink name"}
test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {
    list [catch {file readlink a b} msg] $msg
} {1 {wrong # args: should be "file readlink name"}}
test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unix nonPortable} {
    file readlink $linkfile
} $gorpfile
test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unix nonPortable} {
    list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not readlink "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
	    [string tolower $errorCode]
} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {win nonPortable} {
    list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not readlink "_bogus_": invalid argument} {POSIX EINVAL {invalid argument}}}
    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
	    [string tolower $errorCode]
} {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}

# size

test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body {
    file size a b
} -result {wrong # args: should be "file size name"}
test cmdAH-27.1 {Tcl_FileObjCmd: size} {
    list [catch {file size a b} msg] $msg
} {1 {wrong # args: should be "file size name"}}
test cmdAH-27.2 {Tcl_FileObjCmd: size} {
    set oldsize [file size $gorpfile]
    set f [open $gorpfile a]
    fconfigure $f -translation lf -eofchar {}
    puts $f "More text"
    close $f
    expr {[file size $gorpfile] - $oldsize}
} {10}
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
    list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
    string tolower [list [catch {file size _bogus_} msg] $msg \
	    $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-27.4 {
    Tcl_FileObjCmd: size (built-in Windows names)
} -constraints {win} -body {
    file size con
} -result 0
test cmdAH-27.4.1 {
    Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
} -constraints {win} -body {
    try {
	set res [file size [file join [temporaryDirectory] con.txt]]
    } trap {POSIX ENOENT} {} {
	set res 0
    }
    set res

# stat
} -result 0

catch {testsetplatform $platform}
removeFile $gorpfile
set gorpfile [makeFile "Test string" gorp.file]
catch {file attributes $gorpfile -permissions 0765}

# stat
test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat _bogus_
} -result {wrong # args: should be "file stat name varName"}
test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body {
    file stat _bogus_ a b
} -result {wrong # args: should be "file stat name varName"}
test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
test cmdAH-28.1 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_} msg] $msg $errorCode
} {1 {wrong # args: should be "file stat name varName"} NONE}
test cmdAH-28.2 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_ a b} msg] $msg $errorCode
} {1 {wrong # args: should be "file stat name varName"} NONE}
test cmdAH-28.3 {Tcl_FileObjCmd: stat} {
    catch {unset stat}
    set stat(blocks) [set stat(blksize) {}]
} -body {
    file stat $gorpfile stat
    unset stat(blocks) stat(blksize); # Ignore these fields; not always set
    unset stat(blocks) stat(blksize)
    lsort [array names stat]
} -result {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain stat
} {atime ctime dev gid ino mode mtime nlink size type uid}
test cmdAH-28.4 {Tcl_FileObjCmd: stat} {
    catch {unset stat}
} -body {
    file stat $gorpfile stat
    list $stat(nlink) $stat(size) $stat(type)
} -result {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
    unset -nocomplain stat
} {1 12 file}
test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unix} {
    catch {unset stat}
} -body {
    file stat $gorpfile stat
    expr {$stat(mode) & 0o777}
} -result {501}
    expr $stat(mode)&0o777
} {501}
test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
    list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup {
    unset -nocomplain x
    string tolower [list [catch {file stat _bogus_ stat} msg] \
	    $msg $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-28.7 {Tcl_FileObjCmd: stat} {
    catch {unset x}
} -returnCodes error -body {
    set x 44
    file stat $gorpfile x
} -result {can't set "x(dev)": variable isn't array}
test cmdAH-28.8 {Tcl_FileObjCmd: stat} -setup {
    list [catch {file stat $gorpfile x} msg] $msg $errorCode
} {1 {can't set "x(dev)": variable isn't array} NONE}
test cmdAH-28.8 {Tcl_FileObjCmd: stat} {
    set filename [makeFile "" foo.text]
} -body {
    # Sign extension of purported unsigned short to int.

    set filename [makeFile "" foo.text]
    file stat $filename stat
    expr {$stat(mode) > 0}
    set x [expr {$stat(mode) > 0}]
} -cleanup {
    removeFile $filename
    set x
} -result 1
} 1
test cmdAH-28.9 {Tcl_FileObjCmd: stat} win {
    # stat of root directory was failing. Don't care about answer, just that
    # test runs. Relative paths that resolve to root
    # stat of root directory was failing.
    # don't care about answer, just that test runs.

    # relative paths that resolve to root
    set old [pwd]
    cd c:/
    file stat c: stat
    file stat c:. stat
    file stat . stat
    cd $old

    file stat / stat
    file stat c:/ stat
    file stat c:/. stat
} {}
test cmdAH-28.10 {Tcl_FileObjCmd: stat} {win nonPortable} {
    # stat of root directory was failing. Don't care about answer, just that
    # test runs.
    # stat of root directory was failing.
    # don't care about answer, just that test runs.

    file stat //pop/$env(USERNAME) stat
    file stat //pop/$env(USERNAME)/ stat
    file stat //pop/$env(USERNAME)/. stat
} {}
test cmdAH-28.11 {Tcl_FileObjCmd: stat} -setup {
test cmdAH-28.11 {Tcl_FileObjCmd: stat} {win nonPortable} {
    set old [pwd]
} -constraints {win nonPortable} -body {
    # stat of network directory was returning id of current local drive.

    set old [pwd]
    cd c:/

    file stat //pop/$env(USERNAME) stat
    cd $old
    expr {$stat(dev) == 2}
} -cleanup {
} 0
    cd $old
} -result 0
test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
test cmdAH-28.12 {Tcl_FileObjCmd: stat} {
    set filename [makeFile "" foo.test]
} -body {
    # stat(mode) with S_IFREG flag was returned as a negative number if mode_t
    # was a short instead of an unsigned short.
    # stat(mode) with S_IFREG flag was returned as a negative number
    # if mode_t was a short instead of an unsigned short.

    set filename [makeFile "" foo.test]
    file stat $filename stat
    expr {$stat(mode) > 0}
} -cleanup {
    removeFile $filename
} -result 1
test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
    unset -nocomplain stat
} -body {
    file stat con stat
    expr {$stat(mode) > 0}
    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
    unset -nocomplain stat
} -body {
    try {
	file stat [file join [temporaryDirectory] CON.txt] stat
	set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}]
    } trap {POSIX ENOENT} {} {
	set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
    }
    set res
} 1
catch {unset stat}
} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
unset -nocomplain stat

# type

test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
    file type a b
} -result {wrong # args: should be "file type name"}
test cmdAH-29.1 {Tcl_FileObjCmd: type} {
    list [catch {file size a b} msg] $msg
} {1 {wrong # args: should be "file size name"}}
test cmdAH-29.2 {Tcl_FileObjCmd: type} {
    file type $dirfile
} directory
test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unix nonPortable} {
    set exists [list [file exists $linkfile] [file exists $gorpfile]]
    file delete $linkfile
    set exists2	[list [file exists $linkfile] [file exists $gorpfile]]
    list $exists $exists2
} {{1 1} {0 1}}
test cmdAH-29.3 {Tcl_FileObjCmd: type} {
    file type $gorpfile
} file
test cmdAH-29.4 {Tcl_FileObjCmd: type} -constraints {unix} -setup {
test cmdAH-29.4 {Tcl_FileObjCmd: type} {unix} {
    catch {file delete $linkfile}
} -body {
    # Unlike [exec ln -s], [file link] requires an existing target
    file link -symbolic $linkfile $gorpfile
    file type $linkfile
    set result [file type $linkfile]
} -cleanup {
    file delete $linkfile
} -result link
test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory notWine} -setup {
    set result
} link
test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {linkDirectory} {
    set tempdir [makeDirectory temp]
} -body {
    set linkdir [file join [temporaryDirectory] link.dir]
    file link -symbolic $linkdir $tempdir
    file type $linkdir
    set result [file type $linkdir]
} -cleanup {
    file delete $linkdir
    removeDirectory $tempdir
} -result link
    set result
} link
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
    list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
    string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
test cmdAH-29.6 {
    Tcl_FileObjCmd: type (built-in Windows names)
} -constraints {win} -body {
    file type con
} -result "characterSpecial"
test cmdAH-29.6.1 {
    Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
} -constraints {win} -body {
    try {
	set res [file type [file join [temporaryDirectory] CON.txt]]
    } trap {POSIX ENOENT} {} {
	set res {characterSpecial}
    }
    set res
} -result "characterSpecial"

# Error conditions

test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file gorp x
} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempdir, tempfile, type, volumes, or writable}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file ex x
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
    list [catch {file gorp x} msg] $msg
} {1 {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
    list [catch {file ex x} msg] $msg
} -match glob -result {unknown or ambiguous subcommand "ex": must be *}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file is x
} {1 {ambiguous option "ex": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
    list [catch {file is x} msg] $msg
} -match glob -result {unknown or ambiguous subcommand "is": must be *}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file z x
} {1 {ambiguous option "is": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
    list [catch {file z x} msg] $msg
} -match glob -result {unknown or ambiguous subcommand "z": must be *}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file read x
} -match glob -result {unknown or ambiguous subcommand "read": must be *}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file s x
} {1 {bad option "z": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
    list [catch {file read x} msg] $msg
} {1 {ambiguous option "read": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
    list [catch {file s x} msg] $msg
} -match glob -result {unknown or ambiguous subcommand "s": must be *}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file t x
} {1 {ambiguous option "s": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
    list [catch {file t x} msg] $msg
} -match glob -result {unknown or ambiguous subcommand "t": must be *}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
    file dirname ~woohgy
} -result {user "woohgy" doesn't exist}
} {1 {ambiguous option "t": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, type, volumes, or writable}}
test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
    list [catch {file dirname ~woohgy} msg] $msg
} {1 {user "woohgy" doesn't exist}}

# channels
# In testing 'file channels', we need to make sure that a channel created in
# one interp isn't visible in another.
# In testing 'file channels', we need to make sure that a channel
# created in one interp isn't visible in another.

interp create simpleInterp
interp create -safe safeInterp
interp create
catch {safeInterp expose file file}
interp c
safeInterp expose file file

test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body {
    file channels a b
} -returnCodes error -result {wrong # args: should be "file channels ?pattern?"}
test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
    list [catch {file channels a b} msg] $msg
} {1 {wrong # args: should be "file channels ?pattern?"}}
test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
    # Normal interps start out with only the standard channels
    lsort [simpleInterp eval [list file chan]]
} {stderr stdin stdout}
} [lsort {stderr stdout stdin}]
test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
    string equal [file channels] [file channels *]
} {1}
test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
    lsort [file channels std*]
} {stderr stdin stdout}
} [lsort {stdout stderr stdin}]

set newFileId [open $gorpfile w]

test cmdAH-31.5 {Tcl_FileObjCmd: channels} {
    set res [file channels $newFileId]
    string equal $newFileId $res
} {1}
test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {
    # Safe interps start out with no channels
    safeInterp eval [list file channels]
} {}
test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} -body {
    safeInterp eval [list puts $newFileId "hello"]
} -returnCodes error -result "can not find channel named \"$newFileId\""
test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {
    list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg
} [list 1 "can not find channel named \"$newFileId\""]

interp share {} $newFileId safeInterp
interp share {} stdout safeInterp

test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {
    # $newFileId should now be visible in both interps
    list [file channels $newFileId] \
	    [safeInterp eval [list file channels $newFileId]]
} [list $newFileId $newFileId]
test cmdAH-31.9 {Tcl_FileObjCmd: channels in other interp} {
    lsort [safeInterp eval [list file channels]]
} [lsort [list stdout $newFileId]]
test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
    # we can now write to $newFileId from child
    # we can now write to $newFileId from slave
    safeInterp eval [list puts $newFileId "hello"]
} {}

interp transfer {} $newFileId safeInterp

test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {
    # $newFileId should now be visible only in safeInterp
    list [file channels $newFileId] \
	    [safeInterp eval [list file channels $newFileId]]
} [list {} $newFileId]
test cmdAH-31.12 {Tcl_FileObjCmd: channels in other interp} {
    lsort [safeInterp eval [list file channels]]
} [lsort [list stdout $newFileId]]
test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {
    safeInterp eval [list close $newFileId]
    safeInterp eval [list file channels]
} {stdout}

# Temp files (TIP#210)
test cmdAH-32.1 {file tempfile - usage} -returnCodes error -body {
    file tempfile a b c
} -result {wrong # args: should be "file tempfile ?nameVar? ?template?"}
test cmdAH-32.2 {file tempfile - returns a read/write channel} -body {
    set f [file tempfile]
    puts $f ok
    seek $f 0
    gets $f
} -cleanup {
    catch {close $f}
} -result ok
test cmdAH-32.3 {file tempfile - makes filenames} -setup {
    unset -nocomplain name
} -body {
    set result [info exists name]
    set f [file tempfile name]
    lappend result [info exists name] [file exists $name]
    close $f
    lappend result [file exists $name]
} -cleanup {
    catch {close $f}
    catch {file delete $name}
} -result {0 1 1 1}
# We try to obey the template on Unix, but don't (currently) bother on Win
test cmdAH-32.4 {file tempfile - templates} -constraints unix -body {
    close [file tempfile name foo]
    expr {[string match foo* [file tail $name]] ? "ok" : "foo produced $name"}
} -cleanup {
    catch {file delete $name}
} -result ok
test cmdAH-32.5 {file tempfile - templates} -constraints unix -body {
    set template [file join $dirfile foo]
    close [file tempfile name $template]
    expr {[string match $template* $name] ? "ok" : "$template produced $name"}
} -cleanup {
    catch {file delete $name}
} -result ok
# Not portable; not all unix systems have mkstemps()
test cmdAH-32.6 {file tempfile - templates} -body {
    set template [file join $dirfile foo]
    close [file tempfile name $template.bar]
    expr {[string match $template*.bar $name] ? "ok" :
	  "$template.bar produced $name"}
} -constraints {unix nonPortable} -cleanup {
    catch {file delete $name}
} -result ok

test cmdAH-33.1 {file tempdir} -body {
    file tempdir a b
} -returnCodes error -result {wrong # args: should be "file tempdir ?template?"}
test cmdAH-33.2 {file tempdir} -body {
    set d [file tempdir]
    list [file tail $d] [file exists $d] [file type $d] \
	[glob -nocomplain -directory $d *]
} -match glob -result {tcl_* 1 directory {}} -cleanup {
    catch {file delete $d}
}
test cmdAH-33.3 {file tempdir} -body {
    set d [file tempdir gorp]
    list [file tail $d] [file exists $d] [file type $d] \
	[glob -nocomplain -directory $d *]
} -match glob -result {gorp_* 1 directory {}} -cleanup {
    catch {file delete $d}
}
test cmdAH-33.4 {file tempdir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -body {
    set pre [glob -nocomplain -directory $base *]
    set d [file normalize [file tempdir $base/]]
    list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \
	$pre [glob -nocomplain -directory $d *]
} -match glob -result {GORP:/tcl_* 1 directory {} {}} -cleanup {
    catch {file delete -force $base}
}
test cmdAH-33.5 {file tempdir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -body {
    set pre [glob -nocomplain -directory $base *]
    set d [file normalize [file tempdir $base/gorp]]
    list [string map [list $base GORP:] $d] [file exists $d] [file type $d] \
	$pre [glob -nocomplain -directory $d *]
} -match glob -result {GORP:/gorp_* 1 directory {} {}} -cleanup {
    catch {file delete -force $base}
}
test cmdAH-33.6 {file tempdir: missing parent dir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -returnCodes error -body {
    file tempdir $base/quux/
} -cleanup {
    catch {file delete -force $base}
} -result {can't create temporary directory: no such file or directory}
test cmdAH-33.7 {file tempdir: missing parent dir} -setup {
    set base [file join [temporaryDirectory] gorp]
    file mkdir $base
} -returnCodes error -body {
    file tempdir $base/quux/foobar
} -cleanup {
    catch {file delete -force $base}
} -result {can't create temporary directory: no such file or directory}

# This shouldn't work, but just in case a test above failed...
catch {close $newFileId}

interp delete safeInterp
interp delete simpleInterp

# cleanup
catch {testsetplatform $platform}
unset -nocomplain platform
catch {unset platform}

# Tcl_ForObjCmd is tested in for.test

catch {file attributes $dirfile -permissions 0777}
removeDirectory $dirfile
removeFile $gorpfile
# No idea how well [removeFile] copes with links...

Changes to tests/cmdIL.test.

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



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
-
-
-
+
+
+




-
-
+
+

-
-
+
+



-
-
-
-


-


-
-
-
-
-
-
-
+
+
+
+
+
+
+






-
-
-
+
+
+







# This file contains a collection of tests for the procedures in the file
# tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for the procedures in the
# file tclCmdIL.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
testConstraint testobj [llength [info commands testobj]]
source [file join [file dirname [info script]] internals.tcl]
namespace import -force ::tcltest::internals::*

test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
    lsort
} -result {wrong # args: should be "lsort ?-option value ...? list"}
test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
    lsort -foo {1 3 2 5}
} -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique}

test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
    list [catch {lsort} msg] $msg
} {1 {wrong # args: should be "lsort ?options? list"}}
test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
    list [catch {lsort -foo {1 3 2 5}} msg] $msg
} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, or -unique}}
test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
    lsort {d e c b a \{ d35 d300}
} {a b c d d300 d35 e \{}
test cmdIL-1.4 {Tcl_LsortObjCmd procedure, -ascii option} {
    lsort -integer -ascii {d e c b a d35 d300}
} {a b c d d300 d35 e}
test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} -body {
    lsort -command {1 3 2 5}
} -returnCodes error -result {"-command" option must be followed by comparison command}
test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} {
    list [catch {lsort -command {1 3 2 5}} msg] $msg
} {1 {"-command" option must be followed by comparison command}}
test cmdIL-1.6 {Tcl_LsortObjCmd procedure, -command option} -setup {
    proc cmp {a b} {
	expr {[string match x* $b] - [string match x* $a]}
    }
} -body {
    lsort -command cmp {x1 abc x2 def x3 x4}
} -result {x1 x2 x3 x4 abc def} -cleanup {
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
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







-
-
-
-
-
-
+
+
+
+
+
+









-
-
-
+
+
+



-
-
-
+
+
+















-
+


-
+





-
+


-
-
-
+
+
+
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+







} {a b c d d35 d300 e}
test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} {
    lsort -dictionary {1k 0k 10k}
} {0k 1k 10k}
test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} {
    lsort -decreasing -increasing {d e c b a d35 d300}
} {a b c d d300 d35 e}
test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body {
    lsort -index {1 3 2 5}
} -returnCodes error -result {"-index" option must be followed by list index}
test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body {
    lsort -index foo {1 3 2 5}
} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
    list [catch {lsort -index {1 3 2 5}} msg] $msg
} {1 {"-index" option must be followed by list index}}
test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
    list [catch {lsort -index foo {1 3 2 5}} msg] $msg
} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
    lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
} {1 {2 25} {3 16 42} {10 20 50 100}}
test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} {
    lsort -index 1 -integer {{1 25 100} {3 16 42} {10 20 50}}
} {{3 16 42} {10 20 50} {1 25 100}}
test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {
    lsort -integer {24 6 300 18}
} {6 18 24 300}
test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} -body {
    lsort -integer {1 3 2.4}
} -returnCodes error -result {expected integer but got "2.4"}
test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} {
    list [catch {lsort -integer {1 3 2.4}} msg] $msg
} {1 {expected integer but got "2.4"}}
test cmdIL-1.17 {Tcl_LsortObjCmd procedure, -real option} {
    lsort -real {24.2 6e3 150e-1}
} {150e-1 24.2 6e3}
test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} -body {
    lsort "1 2 3 \{ 4"
} -returnCodes error -result {unmatched open brace in list}
test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} {
    list [catch {lsort "1 2 3 \{ 4"} msg] $msg
} {1 {unmatched open brace in list}}
test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} {
    lsort {}
} {}
test cmdIL-1.22 {Tcl_LsortObjCmd procedure, unique sort} {
    lsort -integer -unique {3 1 2 3 1 4 3}
} {1 2 3 4}
test cmdIL-1.23 {Tcl_LsortObjCmd procedure, unique sort with index} {
    # lsort -unique should return the last unique item
    lsort -unique -index 0 {{a b} {c b} {a c} {d a}}
} {{a c} {c b} {d a}}
test cmdIL-1.24 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup {
    catch {rename 1 ""}
    proc testcmp {a b} {return [string compare $a $b]}
} -body {
    set l [list [list a b] [list c d]]
    lsort -command testcmp -index 1 $l
    list [catch {lsort -command testcmp -index 1 $l} msg] $msg
} -cleanup {
    rename testcmp ""
} -result [list [list a b] [list c d]]
} -result [list 0 [list [list a b] [list c d]]]
test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup {
    catch {rename 1 ""}
    proc testcmp {a b} {return [string compare $a $b]}
} -body {
    set l [list [list a b] [list c d]]
    lsort -index 1 -command testcmp $l
    list [catch {lsort -index 1 -command testcmp $l} msg] $msg
} -cleanup {
    rename testcmp ""
} -result [list [list a b] [list c d]]
# Note that the required order only exists in the end-1'th element; indexing
# using the end element or any fixed offset from the start will not work...
} -result [list 0 [list [list a b] [list c d]]]
# Note that the required order only exists in the end-1'th element;
# indexing using the end element or any fixed offset from the start
# will not work...
test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} {
    lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
} {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}}
test cmdIL-1.27 {Tcl_LsortObjCmd procedure, returning indices} {
    lsort -indices {a c b}
} {0 2 1}
test cmdIL-1.28 {Tcl_LsortObjCmd procedure, returning indices} {
    lsort -indices -unique -decreasing -real {1.2 34.5 34.5 5.6}
} {2 3 0}
test cmdIL-1.29 {Tcl_LsortObjCmd procedure, loss of list rep during sorting} {
    set l {1 2 3}
    string length [lsort -command {apply {args {string length $::l}}} $l]
} 5
test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} {
    lsort -stride 2 {f e d c b a}
} {b a d c f e}
test cmdIL-1.31 {Tcl_LsortObjCmd procedure, -stride option} {
    lsort -stride 3 {f e d c b a}
} {c b a f e d}
test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body {
    lsort -stride foo bar
} -result {expected integer but got "foo"}
test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body {
    lsort -stride 1 bar
} -result {stride length must be at least 2}
test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body {
    lsort -stride 2 {a b c}
} -result {list size must be a multiple of the stride length}
test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body {
    lsort -stride 2 -index 3 {a b c d}
} -result {when used with "-stride", the leading "-index" value must be within the group}
test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
    lsort -stride 2 -index {0 1} {
	{{c o d e} 54321} {{b l a h} 94729}
	{{b i g} 12345} {{d e m o} 34512}
    }

} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii [list \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii -nocase [list \0 \x7f \x80 \uffff]
} [list \0 \x7f \x80 \uffff]
test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
    lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff]
} [list \0 \x7f \x80 \uffff \U01ffff]
test cmdIL-1.41 {lsort -stride and -index} -body {
    lsort -stride 2 -index -2 {a 2 b 1}
} -returnCodes error -result {index "-2" out of range}
test cmdIL-1.42 {lsort -stride and-index} -body {
    lsort -stride 2 -index -1-1 {a 2 b 1}
} -returnCodes error -result {index "-1-1" out of range}

# Can't think of any good tests for the MergeSort and MergeLists procedures,
# except a bunch of random lists to sort.
# Can't think of any good tests for the MergeSort and MergeLists
# procedures, except a bunch of random lists to sort.

test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
    set result {}
    set r 1435753299
    proc rand {} {
	global r
	set r [expr {(16807 * $r) % (0x7fffffff)}]
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
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







-
+




-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







	    if {$el < $old} {
		append result "list {$x} sorted to {$y}, element $el out of order\n"
		break
	    }
	    set old $el
	}
    }
    string trim $result
    set result
} -cleanup {
    rename rand ""
} -result {}

test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -body {
test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -setup {
    set ::x 0
    list [catch {
	lsort -integer -command {apply {{a b} {
	    incr ::x
	    error "error #$::x"
	}}} {48 6 28 190 16 2 3 6 1}
    } msg] $msg $::x
    proc cmp {a b} {
	global x
	incr x
	error "error #$x"
    }
} -body {
    set x 0
    list [catch {lsort -integer -command cmp {48 6 28 190 16 2 3 6 1}} msg] \
	    $msg $x
} -cleanup {
    rename cmp ""
} -result {1 {error #1} 1}
test cmdIL-3.2 {SortCompare procedure, -index option} -body {
    lsort -integer -index 2 "\\\{ {30 40 50}"
} -returnCodes error -result {unmatched open brace in list}
test cmdIL-3.3 {SortCompare procedure, -index option} -body {
    lsort -integer -index 2 {{20 10} {15 30 40}}
} -returnCodes error -result {element 2 missing from sublist "20 10"}
test cmdIL-3.4 {SortCompare procedure, -index option} -body {
    lsort -integer -index 2 "{a b c} \\\{"
} -returnCodes error -result {expected integer but got "c"}
test cmdIL-3.4.1 {SortCompare procedure, -index option} -body {
    lsort -integer -index 2 "{1 2 3} \\\{"
} -returnCodes error -result {unmatched open brace in list}
test cmdIL-3.5 {SortCompare procedure, -index option} -body {
    lsort -integer -index 2 {{20 10 13} {15}}
} -returnCodes error -result {element 2 missing from sublist "15"}
test cmdIL-3.2 {SortCompare procedure, -index option} {
    list [catch {lsort -integer -index 2 "\\\{ {30 40 50}"} msg] $msg
} {1 {unmatched open brace in list}}
test cmdIL-3.3 {SortCompare procedure, -index option} {
    list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
} {1 {element 2 missing from sublist "20 10"}}
test cmdIL-3.4 {SortCompare procedure, -index option} {
    list [catch {lsort -integer -index 2 "{a b c} \\\{"} msg] $msg
} {1 {expected integer but got "c"}}
test cmdIL-3.4.1 {SortCompare procedure, -index option} {
    list [catch {lsort -integer -index 2 "{1 2 3} \\\{"} msg] $msg
} {1 {unmatched open brace in list}}
test cmdIL-3.5 {SortCompare procedure, -index option} {
    list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg
} {1 {element 2 missing from sublist "15"}}
test cmdIL-3.5.1 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index 1+3 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {element 4 missing from sublist "1 . c"}
test cmdIL-3.5.2 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index -1-1 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "-1-1" out of range}
test cmdIL-3.5.3 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index -2 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "-2" out of range}
test cmdIL-3.5.4 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end-4 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {element end-4 missing from sublist "1 . c"}
test cmdIL-3.5.5 {SortCompare procedure, -index option} {
    lsort -index {} {a b}
} {a b}
test cmdIL-3.5.6 {SortCompare procedure, -index option} {
    lsort -index {} [list a \{]
} {a \{}
test cmdIL-3.5.7 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end--1 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "end--1" out of range}
test cmdIL-3.5.8 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end+1 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "end+1" out of range}
test cmdIL-3.5.9 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index end+2 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "end+2" out of range}
test cmdIL-3.5.10 {SortCompare procedure, -index option (out of range, calculated index)} -body {
    lsort -index 0 {{}}
} -returnCodes error -result {element 0 missing from sublist ""}
test cmdIL-3.6 {SortCompare procedure, -index option} {
    lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
} {{3 25 20} {2 5 25} {1 15 30}}
test cmdIL-3.7 {SortCompare procedure, -ascii option} {
    lsort -ascii {d e c b a d35 d300 100 20}
} {100 20 a b c d d300 d35 e}
test cmdIL-3.8 {SortCompare procedure, -dictionary option} {
    lsort -dictionary {d e c b a d35 d300 100 20}
} {20 100 a b c d d35 d300 e}
test cmdIL-3.9 {SortCompare procedure, -integer option} -body {
    lsort -integer {x 3}
} -returnCodes error -result {expected integer but got "x"}
test cmdIL-3.10 {SortCompare procedure, -integer option} -body {
    lsort -integer {3 q}
} -returnCodes error -result {expected integer but got "q"}
test cmdIL-3.9 {SortCompare procedure, -integer option} {
    list [catch {lsort -integer {x 3}} msg] $msg
} {1 {expected integer but got "x"}}
test cmdIL-3.10 {SortCompare procedure, -integer option} {
    list [catch {lsort -integer {3 q}} msg] $msg
} {1 {expected integer but got "q"}}
test cmdIL-3.11 {SortCompare procedure, -integer option} {
    lsort -integer {35 21 0x20 0d30 0o23 100 8}
} {8 0o23 21 0d30 0x20 35 100}
test cmdIL-3.12 {SortCompare procedure, -real option} -body {
    lsort -real {6...4 3}
} -returnCodes error -result {expected floating-point number but got "6...4"}
test cmdIL-3.13 {SortCompare procedure, -real option} -body {
    lsort -real {3 1x7}
} -returnCodes error -result {expected floating-point number but got "1x7"}
    lsort -integer {35 21 0x20 30 0o23 100 8}
} {8 0o23 21 30 0x20 35 100}
test cmdIL-3.12 {SortCompare procedure, -real option} {
    list [catch {lsort -real {6...4 3}} msg] $msg
} {1 {expected floating-point number but got "6...4"}}
test cmdIL-3.13 {SortCompare procedure, -real option} {
    list [catch {lsort -real {3 1x7}} msg] $msg
} {1 {expected floating-point number but got "1x7"}}
test cmdIL-3.14 {SortCompare procedure, -real option} {
    lsort -real {24 2.5e01 16.7 85e-1 10.004}
} {85e-1 10.004 16.7 24 2.5e01}
test cmdIL-3.15 {SortCompare procedure, -command option} -body {
    proc cmp {a b} {
	error "comparison error"
    }
305
306
307
308
309
310
311
312
313


314
315

316
317
318
319
320
321
322
233
234
235
236
237
238
239


240
241
242

243
244
245
246
247
248
249
250







-
-
+
+

-
+







} -cleanup {
    rename cmp ""
} -result {{the second element, last but not least, is quite long also, in order to make absolutely sure that space is allocated dynamically for the dstring} {this first element is also long in order to help expand the dstring}}
test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} -body {
    proc cmp {a b} {
	return foow
    }
    lsort -command cmp {48 6}
} -returnCodes error -cleanup {
    list [catch {lsort -command cmp {48 6}} msg] $msg
} -cleanup {
    rename cmp ""
} -result {-compare command returned non-integer result}
} -result {1 {-compare command returned non-integer result}}
test cmdIL-3.18 {SortCompare procedure, -command option} -body {
    proc cmp {a b} {
	expr {$b - $a}
    }
    lsort -command cmp {48 6 18 22 21 35 36}
} -cleanup {
    rename cmp ""
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
611
612
613
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
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







-
-
-

















-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+

-
+

-
-
+
+
+
+
+

-
+


-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+







	lindex [lsort -real -index $l $n] 1 1
    }
    expr srand(1)
    test_lsort 0
} -result 0 -cleanup {
    rename test_lsort ""
}
test cmdIL-5.6 {lsort with multiple list-style index options} {
    lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}}
} {{a b} {b e} {c d}}
test cmdIL-5.7 {lsort memory exhaustion} -constraints {testWithLimit} -body {
    # test it in child process (with limited address space) ca. 80MB extra memory
    # on x64 system it would be not enough to sort 4M items (the half 2M only),
    # warn and skip if no error (enough memory) or error by list creation:
    testWithLimit \
	-warn-on-code 0 -warn-on-alloc-error 1 \
	-addmem [expr {$tcl_platform(pointerSize)*4000000 + $tcl_platform(pointerSize)*3*2000000}] \
    {
	# create list and get length (avoid too long output in interactive shells):
	llength [set l [lrepeat 4000000 ""]]
	# test OOM:
	llength [lsort $l]
    }
    # expecting error no memory by sort
} -returnCodes 1 -result {no enough memory to proccess sort of 4000000 items}

# Compiled version
test cmdIL-6.1 {lassign command syntax} -returnCodes error -body {
    apply {{} { lassign }}
} -result {wrong # args: should be "lassign list ?varName ...?"}
test cmdIL-6.2 {lassign command syntax} {
    apply {{} { lassign x }}
} x
test cmdIL-6.1 {lassign command syntax} -body {
    proc testLassign {} {
	lassign
    }
    testLassign
} -returnCodes 1 -cleanup {
    rename testLassign {}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
test cmdIL-6.2 {lassign command syntax} -body {
    proc testLassign {} {
	lassign x
    }
    testLassign
} -returnCodes 1 -cleanup {
    rename testLassign {}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
test cmdIL-6.3 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set x FAIL
	list [lassign a x] $x
    }}
} -result {{} a}
    }
    testLassign
} -result {{} a} -cleanup {
    rename testLassign {}
}
test cmdIL-6.4 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set x FAIL
	set y FAIL
	list [lassign a x y] $x $y
    }}
} -result {{} a {}}
    }
    testLassign
} -result {{} a {}} -cleanup {
    rename testLassign {}
}
test cmdIL-6.5 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set x FAIL
	set y FAIL
	list [lassign {a b} x y] $x $y
    }}
} -result {{} a b}
    }
    testLassign
} -result {{} a b} -cleanup {
    rename testLassign {}
}
test cmdIL-6.6 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set x FAIL
	set y FAIL
	list [lassign {a b c} x y] $x $y
    }}
} -result {c a b}
    }
    testLassign
} -result {c a b} -cleanup {
    rename testLassign {}
}
test cmdIL-6.7 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set x FAIL
	set y FAIL
	list [lassign {a b c d} x y] $x $y
    }}
} -result {{c d} a b}
    }
    testLassign
} -result {{c d} a b} -cleanup {
    rename testLassign {}
}
test cmdIL-6.8 {lassign command - list format error} -body {
    apply {{} {
    proc testLassign {} {
	set x FAIL
	set y FAIL
	list [catch {lassign {a {b}c d} x y} msg] $msg $x $y
    }}
} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
    }
    testLassign
} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
    rename testLassign {}
}
test cmdIL-6.9 {lassign command - assignment to arrays} -body {
    apply {{} {
    proc testLassign {} {
	list [lassign {a b} x(x)] $x(x)
    }}
} -result {b a}
    }
    testLassign
} -result {b a} -cleanup {
    rename testLassign {}
}
test cmdIL-6.10 {lassign command - variable update error} -body {
    apply {{} {
    proc testLassign {} {
	set x(x) {}
	lassign a x
    }}
} -returnCodes error -result {can't set "x": variable is array}
    }
    testLassign
} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
    rename testLassign {}
}
test cmdIL-6.11 {lassign command - variable update error} -body {
    apply {{} {
    proc testLassign {} {
	set x(x) {}
	set y FAIL
	list [catch {lassign a y x} msg] $msg $y
    }}
} -result {1 {can't set "x": variable is array} a}
    }
    testLassign
} -result {1 {can't set "x": variable is array} a} -cleanup {
    rename testLassign {}
}
test cmdIL-6.12 {lassign command - memory leak testing} -setup {
    unset -nocomplain x y
    set x(x) {}
    set y FAIL
    proc getbytes {} {
        set lines [split [memory info] "\n"]
        lindex [lindex $lines 3] 3
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





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
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
618
619


620
621
622
623
624
625

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
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







-
-
+
+


-
-
-
-
+
+
+
+
+
+
+


-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+

-
+




-
-
+
+
+
+
+

-
+




-
-
+
+
+
+
+

-
+




-
-
+
+
+
+
+

-
+




-
-
+
+
+
+
+

-
+




-
-
+
+
+
+
+

-
+


-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+

-
+




-
-
+
+
+
+
+







    expr {$end - $tmp}
} -result 0 -cleanup {
    unset -nocomplain x y i tmp end
    rename getbytes {}
    rename stress {}
}
# Force non-compiled version
test cmdIL-6.13 {lassign command syntax} -returnCodes error -body {
    apply {{} {
test cmdIL-6.13 {lassign command syntax} -body {
    proc testLassign {} {
	set lassign lassign
	$lassign
    }}
} -result {wrong # args: should be "lassign list ?varName ...?"}
test cmdIL-6.14 {lassign command syntax} {
    apply {{} {
    }
    testLassign
} -returnCodes 1 -cleanup {
    rename testLassign {}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
test cmdIL-6.14 {lassign command syntax} -body {
    proc testLassign {} {
	set lassign lassign
	$lassign x
    }}
} x
    }
    testLassign
} -returnCodes 1 -cleanup {
    rename testLassign {}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
test cmdIL-6.15 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x FAIL
	list [$lassign a x] $x
    }}
} -result {{} a}
    }
    testLassign
} -result {{} a} -cleanup {
    rename testLassign {}
}
test cmdIL-6.16 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x FAIL
	set y FAIL
	list [$lassign a x y] $x $y
    }}
} -result {{} a {}}
    }
    testLassign
} -result {{} a {}} -cleanup {
    rename testLassign {}
}
test cmdIL-6.17 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x FAIL
	set y FAIL
	list [$lassign {a b} x y] $x $y
    }}
} -result {{} a b}
    }
    testLassign
} -result {{} a b} -cleanup {
    rename testLassign {}
}
test cmdIL-6.18 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x FAIL
	set y FAIL
	list [$lassign {a b c} x y] $x $y
    }}
} -result {c a b}
    }
    testLassign
} -result {c a b} -cleanup {
    rename testLassign {}
}
test cmdIL-6.19 {lassign command} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x FAIL
	set y FAIL
	list [$lassign {a b c d} x y] $x $y
    }}
} -result {{c d} a b}
    }
    testLassign
} -result {{c d} a b} -cleanup {
    rename testLassign {}
}
test cmdIL-6.20 {lassign command - list format error} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x FAIL
	set y FAIL
	list [catch {$lassign {a {b}c d} x y} msg] $msg $x $y
    }}
} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
    }
    testLassign
} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
    rename testLassign {}
}
test cmdIL-6.21 {lassign command - assignment to arrays} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	list [$lassign {a b} x(x)] $x(x)
    }}
} -result {b a}
    }
    testLassign
} -result {b a} -cleanup {
    rename testLassign {}
}
test cmdIL-6.22 {lassign command - variable update error} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x(x) {}
	$lassign a x
    }}
} -returnCodes 1 -result {can't set "x": variable is array}
    }
    testLassign
} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
    rename testLassign {}
}
test cmdIL-6.23 {lassign command - variable update error} -body {
    apply {{} {
    proc testLassign {} {
	set lassign lassign
	set x(x) {}
	set y FAIL
	list [catch {$lassign a y x} msg] $msg $y
    }}
} -result {1 {can't set "x": variable is array} a}
    }
    testLassign
} -result {1 {can't set "x": variable is array} a} -cleanup {
    rename testLassign {}
}
test cmdIL-6.24 {lassign command - memory leak testing} -setup {
    set x(x) {}
    set y FAIL
    proc getbytes {} {
        set lines [split [memory info] "\n"]
        lindex [lindex $lines 3] 3
    }
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
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







-
+


-
-
+
+
+
+
+

-
+



-
-
+
+
+
+
+







} -result 0 -cleanup {
    unset -nocomplain x y i tmp end
    rename getbytes {}
    rename stress {}
}
# Assorted shimmering problems
test cmdIL-6.25 {lassign command - shimmering protection} -body {
    apply {{} {
    proc testLassign {} {
	set x {a b c}
	list [lassign $x $x y] $x [set $x] $y
    }}
} -result {c {a b c} a b}
    }
    testLassign
} -result {c {a b c} a b} -cleanup {
    rename testLassign {}
}
test cmdIL-6.26 {lassign command - shimmering protection} -body {
    apply {{} {
    proc testLassign {} {
	set x {a b c}
	set lassign lassign
	list [$lassign $x $x y] $x [set $x] $y
    }}
} -result {c {a b c} a b}
    }
    testLassign
} -result {c {a b c} a b} -cleanup {
    rename testLassign {}
}

test cmdIL-7.1 {lreverse command} -body {
    lreverse
} -returnCodes error -result "wrong # args: should be \"lreverse list\""
test cmdIL-7.2 {lreverse command} -body {
    lreverse a b
} -returnCodes error -result "wrong # args: should be \"lreverse list\""
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
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







+
+
















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+
+







} {f e {c d} b a}
test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
    lreverse [set x {1 2 3}][unset x]
} {3 2 1}
test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
    lreverse [list]
} {}

testConstraint testobj [llength [info commands testobj]]
test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
    teststringobj set 1 {1 2 3}
    testobj convert 1 list
    testobj duplicate 1 2
    variable x [teststringobj get 1]
    variable y [teststringobj get 2]
    testobj freeallvars
    proc K {a b} {return $a}
} -constraints testobj -body {
    lreverse [K $y [unset y]]
    lindex $x 0
} -cleanup {
    unset -nocomplain x y
    rename K {}
} -result 1

test cmdIL-8.1 {lremove command: error path} -returnCodes error -body {
    lremove
} -result {wrong # args: should be "lremove list ?index ...?"}
test cmdIL-8.2 {lremove command: error path} -returnCodes error -body {
    lremove {{}{}}
} -result {list element in braces followed by "{}" instead of space}
test cmdIL-8.3 {lremove command: error path} -returnCodes error -body {
    lremove {a b c} gorp
} -result {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}
test cmdIL-8.4 {lremove command: no indices} -body {
    lremove {a b c}
} -result {a b c}
test cmdIL-8.5 {lremove command: before start} -body {
    lremove {a b c} -1
} -result {a b c}
test cmdIL-8.6 {lremove command: after end} -body {
    lremove {a b c} 3
} -result {a b c}
test cmdIL-8.7 {lremove command} -body {
    lremove {a b c} 0
} -result {b c}
test cmdIL-8.8 {lremove command} -body {
    lremove {a b c} 1
} -result {a c}
test cmdIL-8.9 {lremove command} -body {
    lremove {a b c} end
} -result {a b}
test cmdIL-8.10 {lremove command} -body {
    lremove {a b c} end-1
} -result {a c}
test cmdIL-8.11 {lremove command} -body {
    lremove {a b c d e} 1 3
} -result {a c e}
test cmdIL-8.12 {lremove command} -body {
    lremove {a b c d e} 3 1
} -result {a c e}
test cmdIL-8.13 {lremove command: same index twice} -body {
    lremove {a b c d e} 2 2
} -result {a b d e}
test cmdIL-8.14 {lremove command: same index twice} -body {
    lremove {a b c d e} 3 end-1
} -result {a b c e}
test cmdIL-8.15 {lremove command: many indices} -body {
    lremove {a b c d e} 1 3 1 4 0
} -result {c}

# This belongs in info test, but adding tests there breaks tests
# that compute source file line numbers.
test info-20.6 {Bug 3587651} -setup {
    namespace eval my {namespace eval tcl {namespace eval mathfunc {
        proc demo x {return 42}
    }}}} -body {    namespace eval my {expr {"demo" in [info functions]}}} -cleanup {
    namespace delete my
} -result 1



# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/cmdInfo.test.

9
10
11
12
13
14
15
16
17
18


19
20
21
22
23
24
25
26
27
28
29
9
10
11
12
13
14
15



16
17




18
19
20
21
22
23
24







-
-
-
+
+
-
-
-
-







# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testcmdinfo  [llength [info commands testcmdinfo]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]

test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
    testcmdinfo create x1
    testcmdinfo get x1

Changes to tests/cmdMZ.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
-
+
+
+











-
-
+
+
-
-
+
-
-
-
-
+
-
-
-
-
-


-
-
-
+
+
+



-
-
-
-
-
+
+
+
+
+
+
+



+

-
-
-
-

-
+
-


+
-
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+

-



-
+












-
-
+
+


-
+


-
+


-
+


-
+


-

-
+







# The tests in this file cover the procedures in tclCmdMZ.c.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
if {[catch {package require tcltest 2.1}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
    return
}

namespace eval ::tcl::test::cmdMZ {
    namespace import ::tcltest::cleanupTests
    namespace import ::tcltest::customMatch
    namespace import ::tcltest::makeFile
    namespace import ::tcltest::removeFile
    namespace import ::tcltest::temporaryDirectory
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test

    proc ListGlobMatch {expected actual} {
	if {[llength $expected] != [llength $actual]} {
    if {[namespace which -command ::tcl::unsupported::timerate] ne ""} {
	namespace import ::tcl::unsupported::timerate
	    return 0
	}
    }
	foreach e $expected a $actual {
	    if {![string match $e $a]} {
		return 0
	    }

	}
	return 1
    }
    customMatch listGlob [namespace which ListGlobMatch]

# Tcl_PwdObjCmd

test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body {
    pwd a
} -result {wrong # args: should be "pwd"}
test cmdMZ-1.1 {Tcl_PwdObjCmd} {
    list [catch {pwd a} msg] $msg
} {1 {wrong # args: should be "pwd"}}
test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
    catch pwd
} 0
test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} -body {
    pwd
} -match glob -result {?*}
test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup {
    set cwd [pwd]
test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
    expr [string length pwd]>0
} 1
test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unix nonPortable} {
    # This test fails on various unix platforms (eg Linux) where
    # permissions caching causes this to fail.  The caching is strictly
    # incorrect, but we have no control over that.
    set foodir [file join [temporaryDirectory] foo]
    file delete -force $foodir
    file mkdir $foodir
    set cwd [pwd]
    cd $foodir
} -constraints {unix nonPortable} -body {
    # This test fails on various unix platforms (eg Linux) where permissions
    # caching causes this to fail. The caching is strictly incorrect, but we
    # have no control over that.
    file attr . -permissions 000
    pwd
    set result [list [catch {pwd} msg] $msg]
} -returnCodes error -cleanup {
    cd $cwd
    file delete -force $foodir
    set result
} -result {error getting working directory name: permission denied}
} {1 {error getting working directory name: permission denied}}

# The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test

# Tcl_RenameObjCmd

test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
    rename r1
} -result {wrong # args: should be "rename oldName newName"}
test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
    rename r1 r2 r3
} -result {wrong # args: should be "rename oldName newName"}
test cmdMZ-2.3 {Tcl_RenameObjCmd: success} -setup {
test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
    list [catch {rename r1} msg] $msg $::errorCode
} {1 {wrong # args: should be "rename oldName newName"} NONE}
test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
    list [catch {rename r1 r2 r3} msg] $msg $::errorCode
} {1 {wrong # args: should be "rename oldName newName"} NONE}
test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
    catch {rename r2 {}}
} -body {
    proc r1 {} {return "r1"}
    rename r1 r2
    r2
} -result {r1}
} {r1}
test cmdMZ-2.4 {Tcl_RenameObjCmd: success} {
    proc r1 {} {return "r1"}
    rename r1 {}
    list [catch {r1} msg] $msg
} {1 {invalid command name "r1"}}

# Some tests for Tcl_ReturnObjCmd are in proc-old.test

test cmdMZ-return-1.0 {return checks for bad option values} -body {
    return -options foo
} -returnCodes error -match glob -result {bad -options value:*}
test cmdMZ-return-1.1 {return checks for bad option values} -body {
    return -code err
} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
    return -code foo
} -returnCodes error -match glob -result {bad completion code*}
test cmdMZ-return-1.2 {return checks for bad option values} -body {
    return -code 0x100000000
} -returnCodes error -match glob -result {bad completion code "0x100000000": must be ok, error, return, break, continue*, or an integer}
} -returnCodes error -match glob -result {bad completion code*}
test cmdMZ-return-1.3 {return checks for bad option values} -body {
    return -level foo
} -returnCodes error -match glob -result {bad -level value: *}
} -returnCodes error -match glob -result {bad -level value:*}
test cmdMZ-return-1.4 {return checks for bad option values} -body {
    return -level -1
} -returnCodes error -match glob -result {bad -level value: *}
} -returnCodes error -match glob -result {bad -level value:*}
test cmdMZ-return-1.5 {return checks for bad option values} -body {
    return -level 3.1415926
} -returnCodes error -match glob -result {bad -level value: *}
} -returnCodes error -match glob -result {bad -level value:*}

proc dictSort {d} {
    set result {}
    foreach k [lsort [dict keys $d]] {
	dict set result $k [dict get $d $k]
	lappend result $k [dict get $d $k]
    }
    return $result
}

test cmdMZ-return-2.0 {return option handling} {
    list [catch return -> foo] [dictSort $foo]
} {2 {-code 0 -level 1}}
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
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







-
+

-
+

-
+







-
-
+
+



+
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+

-
+






+









-
-
-
+
+
+


-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+
-

+






-
-
-
+
+
+
-

+
-
+



-
-
-
-
-
-
+
+
+
+
+
+







} -returnCodes continue -result {}
test cmdMZ-return-2.8 {return option handling} -body {
    return -level 0 -code -1
} -returnCodes -1 -result {}
test cmdMZ-return-2.9 {return option handling} -body {
    return -level 0 -code 10
} -returnCodes 10 -result {}
test cmdMZ-return-2.10 {return option handling} -body {
test cmdMZ-return-2.10 {return option handling} {
    list [catch {return -level 0 -code error} -> foo] [dictSort $foo]
} -match glob -result {1 {-code 1 -errorcode NONE -errorinfo {
} {1 {-code 1 -errorcode NONE -errorinfo {
    while executing
"return -level 0 -code error"} -errorline 1 -errorstack * -level 0}}
"return -level 0 -code error"} -errorline 1 -level 0}}
test cmdMZ-return-2.11 {return option handling} {
    list [catch {return -level 0 -code break} -> foo] [dictSort $foo]
} {3 {-code 3 -level 0}}
test cmdMZ-return-2.12 {return option handling} -body {
    return -level 0 -code error -options {-code ok}
} -returnCodes ok -result {}
test cmdMZ-return-2.13 {return option handling} -body {
    return -level 0 -code error -options {-code err}
} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
    return -level 0 -code error -options {-code foo}
} -returnCodes error -match glob -result {bad completion code*}
test cmdMZ-return-2.14 {return option handling} -body {
    return -level 0 -code error -options {-code foo -options {-code break}}
} -returnCodes break -result {}

test cmdMZ-return-2.15 {return opton handling} {
test cmdMZ-return-2.15 {return opton handling} -setup {
    list [catch {
	apply {{} {
	    return -code error -errorcode {a b} c
	}}
    } result] $result $::errorCode
} {1 c {a b}}
test cmdMZ-return-2.16 {return opton handling} {
        proc p {} {
            return -code error -errorcode {a b} c
        }
    } -body {
        list [catch p result] $result $::errorCode
    } -cleanup {
        rename p {}
    } -result {1 c {a b}}

test cmdMZ-return-2.16 {return opton handling} -setup {
    list [catch {
	apply {{} {
	    return -code error -errorcode [list a b] c
	}}
    } result] $result $::errorCode
} {1 c {a b}}
test cmdMZ-return-2.17 {return opton handling} {
        proc p {} {
            return -code error -errorcode [list a b] c
        }
    } -body {
        list [catch p result] $result $::errorCode
    } -cleanup {
        rename p {}
    } -result {1 c {a b}}

test cmdMZ-return-2.17 {return opton handling} -setup {
    list [catch {
	apply {{} {
	    return -code error -errorcode a\ b c
	}}
    } result] $result $::errorCode
} {1 c {a b}}
test cmdMZ-return-2.18 {return option handling} {
        proc p {} {
            return -code error -errorcode a\ b c
        }
    } -body {
        list [catch p result] $result $::errorCode
    } -cleanup {
        rename p {}
    } -result {1 c {a b}}

    list [catch {
	return -code error -errorstack [list CALL a CALL b] yo
    } -> foo] [dictSort $foo] [info errorstack]
} {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}}

# Check that the result of a [return -options $opts $result] is
# indistinguishable from that of the originally caught script, no matter what
# the script is/does. (TIP 90)
foreach {testid script} {
    cmdMZ-return-3.0 {}
    cmdMZ-return-3.1 {format x}
    cmdMZ-return-3.2 {set}
    cmdMZ-return-3.3 {set a 1}
    cmdMZ-return-3.4 {error}
    cmdMZ-return-3.5 {error foo}
    cmdMZ-return-3.6 {error foo bar}
    cmdMZ-return-3.7 {error foo bar baz}
    cmdMZ-return-3.8 {return -level 0}
    cmdMZ-return-3.9 {return -code error}
    cmdMZ-return-3.10 {return -code error -errorinfo foo}
    cmdMZ-return-3.11 {return -code error -errorinfo foo -errorcode bar}
    cmdMZ-return-3.12 {return -code error -errorinfo foo -errorcode bar -errorline 10}
# indistinguishable from that of the originally caught script, no
# matter what the script is/does.  (TIP 90)
set i 0
foreach script {
	{}
	{format x}
	{set}
	{set a 1}
	{error}
	{error foo}
	{error foo bar}
	{error foo bar baz}
	{return -level 0}
	{return -code error}
	{return -code error -errorinfo foo}
	{return -code error -errorinfo foo -errorcode bar}
	{return -code error -errorinfo foo -errorcode bar -errorline 10}
    cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10 -errorstack baz}
    cmdMZ-return-3.13 {return -options {x y z 2}}
    cmdMZ-return-3.14 {return -level 3 -code break sdf}
	{return -options {x y z 2}}
	{return -level 3 -code break sdf}
} {
    test $testid "check that return after a catch is same:\n$script" {
    test cmdMZ-return-3.$i "check that return after a catch is same:\n$script" {
	set one [list [catch $script foo bar] $foo [dictSort $bar] \
		$::errorCode $::errorInfo]
	set two [list [catch {return -options $bar $foo} foo2 bar2] \
		$foo2 [dictSort $bar2] $::errorCode $::errorInfo]
	string equal $one $two
    } 1
    incr i
}

# The tests for Tcl_ScanObjCmd are in scan.test

# Tcl_SourceObjCmd
# More tests of Tcl_SourceObjCmd are in source.test

test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints {
    unixOrWin
} -returnCodes error -body {
    source
} -match glob -result {wrong # args: should be "source*fileName"}
} -body {
    list [catch {source} msg] $msg
} -match glob -result {1 {wrong # args: should be "source*fileName"}}
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints {
    unixOrWin
} -returnCodes error -body {
    source a b c d e f
} -match glob -result {wrong # args: should be "source*fileName"}
} -body {
    list [catch {source a b} msg] $msg
} -match glob -result {1 {wrong # args: should be "source*fileName"}}

proc ListGlobMatch {expected actual} {
    if {[llength $expected] != [llength $actual]} {
        return 0
    }
    foreach e $expected a $actual {
        if {![string match $e $a]} {
            return 0
        }
    }
    return 1
}
customMatch listGlob [namespace which ListGlobMatch]

test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
    set file [makeFile {
	set x 146
	error "error in sourced file"
	set y $x
    } source.file]
    list [catch {source $file} msg] $msg $::errorInfo
    set result [list [catch {source $file} msg] $msg $::errorInfo]
} -cleanup {
    removeFile source.file
    set result
} -match listGlob -result {1 {error in sourced file} {error in sourced file
    while executing
"error "error in sourced file""
    (file "*" line 3)
    invoked from within
"source $file"}}
test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} -body {
    set file [makeFile {list ok} source.file]
    source $file
test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
    set file [makeFile {list result} source.file]
    set result [source $file]
} -cleanup {
    removeFile source.file
    set result
} -result ok
} result

# Tcl_SplitObjCmd

test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
    split
} -result {wrong # args: should be "split string ?splitChars?"}
test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
    split a b c
} -result {wrong # args: should be "split string ?splitChars?"}
test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
    list [catch split msg] $msg $::errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
    list [catch {split a b c} msg] $msg $::errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
    split "a\n b\t\r c\n "
} {a {} b {} {} c {} {}}
test cmdMZ-4.4 {Tcl_SplitObjCmd: basic split commands} {
    split "word 1xyzword 2zword 3" xyz
} {{word 1} {} {} {word 2} {word 3}}
test cmdMZ-4.5 {Tcl_SplitObjCmd: basic split commands} {
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
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







-
+





-
+
+


-
+


-
-
-
+
+
+
+
-







test cmdMZ-4.8 {Tcl_SplitObjCmd: basic split commands} {
    split {}
} {}
test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} {
    split {   }
} {{} {} {} {}}
test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
    apply {{} {
    proc foo {} {
        set x {}
        foreach f [split {]\n} {}] {
            append x $f
        }
        return $x
    }}
    }
    foo
} {]\n}
test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
    apply {{} {
    proc foo {} {
        set x ab\000c
        set y [split $x {}]
	binary scan $y c* z
        return $z
    }}
        return $y
    }
    foo
} "a b \000 c"
} {97 32 98 32 0 32 99}
test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
    split "a0ab1b2bbb3\000c4" ab\000c
} {{} 0 {} 1 2 {} {} 3 {} 4}
test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
    # if not UTF-8 aware, result is "a {} {} b qw\xe5 {} N wq"
    split "a\u4e4eb qw\u5e4e\x4e wq" " \u4e4e"
} "a b qw\u5e4eN wq"
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
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







-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+



-
+
-
-
+
+







    while {abs([clock microseconds] - $stime) < $usec} {
      # don't use after 0 unless it's NRT-capable, so yes - busy-wait (but it's more precise):
      # after 0
    }
}
_nrt_sleep 0; # warm up (clock, compile, etc)

test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
    time
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
    time a b c
} -returnCodes error -result {wrong # args: should be "time command ?count?"}
test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} -body {
    time a b
} -returnCodes error -result {expected integer but got "b"}
test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} {
    list [catch {time} msg] $msg
} {1 {wrong # args: should be "time command ?count?"}}
test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
    list [catch {time a b c} msg] $msg
} {1 {wrong # args: should be "time command ?count?"}}
test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} {
    list [catch {time a b} msg] $msg
} {1 {expected integer but got "b"}}
test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
    time bogusCmd -12456
} {0 microseconds per iteration}
test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} {
    time {format 1}
} -match regexp -result {^\d+ microseconds per iteration}
    regexp {^\d+ microseconds per iteration} [time {format 1}]
} 1
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} -body {
    set m1 [lindex [time {_nrt_sleep 0.01}] 0]
    set m2 [lindex [time {_nrt_sleep 10.0}] 0]
    list \
	[expr {$m1 < $m2}] \
	$m1 $m2; # interesting only in error case.
} -match glob -result [list 1 *]
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
483
484
485
486
487
488
489
490

















491

492
493
494
495
496
497












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+





-
-
-
-
	    if {![string is integer -strict [eval $m1]]} {error unexpected}
	}
	# increase again (no "continue" from nested call):
	incr x
    }
    list [lindex [timerate $m1 1000 5] 2] $x
} {5 20}

test cmdMZ-try-1.0 {

    fix for issue 45b9faf103f2

    [try] interaction with local variable names produces segmentation violation

} -body {
    ::apply {{} {
	set cmd try
	$cmd {
	    lindex 5
	} on ok res {}
	set res
    }}
} -result 5


# The tests for Tcl_WhileObjCmd are in while.test


# cleanup
cleanupTests
}
namespace delete ::tcl::test::cmdMZ
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/compExpr-old.test.

8
9
10
11
12
13
14
15
16


17
18
19




20

21
22
23
24
25
26
27
28
8
9
10
11
12
13
14


15
16
17
18
19
20
21
22
23

24

25
26
27
28
29
30
31







-
-
+
+



+
+
+
+
-
+
-







#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1

}
::tcltest::loadTestedCommands

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
74
75
76
77
78
79
80
81
82


83
84
85
86
87
88
89
77
78
79
80
81
82
83


84
85
86
87
88
89
90
91
92







-
-
+
+







	default {
	    return 0
	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]

# procedures used below

proc put_hello_char {c} {
    global a
    append a [format %c $c]
    return $c
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
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







-
+


-
+




















-
+


-
+







    expr 2***3|6
} -returnCodes error -match glob -result *
test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
    expr 2^x
} -returnCodes error -match glob -result *
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
} {1 {can't use floating-point value as operand of "^"}}
test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
} {1 {can't use non-numeric string as operand of "^"}}

test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test compExpr-old-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test compExpr-old-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test compExpr-old-7.5 {CompileBitAndExpr: error in equality expr} -body {
    expr x==3
} -returnCodes error -match glob -result *
test compExpr-old-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test compExpr-old-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test compExpr-old-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test compExpr-old-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2***3&6
} -returnCodes error -match glob -result *
test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2&x
} -returnCodes error -match glob -result *
test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "&"}}
} {1 {can't use floating-point value as operand of "&"}}
test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
} {1 {can't use non-numeric string as operand of "&"}}

test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
test compExpr-old-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
test compExpr-old-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
test compExpr-old-8.5 {CompileEqualityExpr: error in relational expr} -body {
    expr x>3
327
328
329
330
331
332
333
334





335
336




337
338
339
340
341
342
343
330
331
332
333
334
335
336

337
338
339
340
341
342

343
344
345
346
347
348
349
350
351
352
353







-
+
+
+
+
+

-
+
+
+
+







} -returnCodes error -match glob -result *


test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test compExpr-old-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test compExpr-old-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test compExpr-old-9.5 {CompileRelationalExpr: large shift expr} {

# The following test is different for 32-bit versus 64-bit
# architectures because LONG_MIN is different

test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
    expr {int(1<<63)}
} 9223372036854775808
} -9223372036854775808
test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648

test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
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
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







-
+


-
+


















-
+


-
+







    expr 2***3>>6
} -returnCodes error -match glob -result *
test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
    expr 2<<x
} -returnCodes error -match glob -result *
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
    list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
} {1 {can't use non-numeric string as operand of "<<"}}

test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test compExpr-old-11.5 {CompileAddExpr: error in multiply expr} -body {
    expr x*3
} -returnCodes error -match glob -result *
test compExpr-old-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test compExpr-old-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} -body {
    expr 2***3+6
} -returnCodes error -match glob -result *
test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
    expr 2-x
} -returnCodes error -match glob -result *
test compExpr-old-11.10 {CompileAddExpr: runtime error} {
    list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test compExpr-old-11.11 {CompileAddExpr: runtime error} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test compExpr-old-11.12 {CompileAddExpr: runtime error} {
    list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
test compExpr-old-11.13a {CompileAddExpr: runtime error} ieeeFloatingPoint {
    list [catch {expr {2.3/0.0}} msg] $msg
} {0 Inf}
test compExpr-old-11.13b {CompileAddExpr: runtime error} !ieeeFloatingPoint {
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
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







-
+


-
+

















-
+


-
+







    expr 2*3%%6
} -returnCodes error -match glob -result *
test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
    expr 2*x
} -returnCodes error -match glob -result *
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}

test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test compExpr-old-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test compExpr-old-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test compExpr-old-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test compExpr-old-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
    expr ~x
} -returnCodes error -match glob -result *
test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
    expr !1.x
    set msg
} -returnCodes error -match glob -result *
test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
    list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "~"}}
} {1 {can't use non-numeric string as operand of "~"}}
test compExpr-old-13.11 {CompileUnaryExpr: runtime error} {
    list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
} {1 {can't use floating-point value as operand of "~"}}
test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} {
    set a 27
    expr $a
} 27
test compExpr-old-13.14 {CompileUnaryExpr: just primary expr} {
    expr double(27)
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
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
618
619
620
621
622
623







-
+


-
+


-
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    set ::errorInfo
} -match glob -result {too many arguments for math function*
    while *ing
"expr sin(1,2,3)"}
test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
    catch {expr sin()} msg
    set ::errorInfo
} -match glob -result {not enough arguments for math function*
} -match glob -result {too few arguments for math function*
    while *ing
"expr sin()"}
test compExpr-old-15.5 {CompileMathFuncCall: not enough arguments} -body {
test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
    catch {expr pow(1)} msg
    set ::errorInfo
} -match glob -result {not enough arguments for math function*
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *
test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr 2*T1()
} 246
test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T2()*3
} 1035
test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(21, 37)
} 37
test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(21.2, 37)
} 37.0
test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(-21.2, -17.5)
} -17.5

test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {
        set i {}

Changes to tests/compExpr.test.

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



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
-
-
-
+
+
+




-
-
+
+

-
-
+
+



+
-
+
+
+
+





-
+









+





-
-
+
+
-


-
+







# This file contains a collection of tests for the procedures in the file
# tclCompExpr.c.  Sourcing this file into Tcl runs the tests and generates
# output for errors.  No output means no errors were found.
# This file contains a collection of tests for the procedures in the
# file tclCompExpr.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
::tcltest::loadTestedCommands
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}


test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
    expr 1+2
} 3
test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} -body {
    expr 1+2+
} -returnCodes error -match glob -result *
test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} -body {
    list [catch {expr "foo(123)"} msg] $msg
} -match glob -result {1 {* "*foo"}}

test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} {
    set a {0o00123}
    expr {$a}
} 83

test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} -setup {
    unset -nocomplain a
test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} {
    catch {unset a}
} -body {
    set a 27
    expr {"foo$a" < "bar"}
} -result 0
} 0
test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} -body {
    expr {"00[expr 1+]" + 17}
} -returnCodes error -match glob -result *
test compExpr-2.3 {CompileSubExpr procedure, TCL_TOKEN_TEXT parse token} {
    expr {{12345}}
} 12345
test compExpr-2.4 {CompileSubExpr procedure, empty TCL_TOKEN_TEXT parse token} {
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
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







-
-
+
+
-


-
-
-
-
+
+
+
+
-



-
-
-
-
-
+
+
+
+
+



-
-
+
+
-


-
+







} 1
test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
    expr {[]}
} {}
test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} -body {
    expr {[foo "bar"xxx] + 17}
} -returnCodes error -match glob -result *
test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup {
    unset -nocomplain a
test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
    catch {unset a}
} -body {
    set a 123
    expr {$a*2}
} -result 246
test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup {
    unset -nocomplain a
    unset -nocomplain b
} 246
test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
    catch {unset a}
    catch {unset b}
} -body {
    set a(george) martha
    set b geo
    expr {$a(${b}rge)}
} -result martha
test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} -body {
    unset -nocomplain a
    expr {$a + 17}
} -returnCodes error -result {can't read "a": no such variable}
} martha
test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} {
    catch {unset a}
    list [catch {expr {$a + 17}} msg] $msg
} {1 {can't read "a": no such variable}}
test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} {
    expr {27||3? 3<<(1+4) : 4&&9}
} 96
test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
    unset -nocomplain a
test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
    catch {unset a}
} -body {
    set a 15
    list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
} -result {0 1}
} {0 1}
test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} {
    expr {5*6}
} 30
test compExpr-2.15 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function found} {
    format %.6g [expr {sin(2.0)}]
} 0.909297
test compExpr-2.16 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, math function not found} -body {
142
143
144
145
146
147
148
149
150


151
152
153
154

155
156
157
158
159
160
161
143
144
145
146
147
148
149


150
151

152
153

154
155
156
157
158
159
160
161







-
-
+
+
-


-
+







} 6
test compExpr-2.31 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} {
    expr {!4}
} 0
test compExpr-2.32 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} {
    expr {~4}
} -5
test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} -setup {
    unset -nocomplain a
test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} {
    catch {unset a}
} -body {
    set a 15
    expr {$a==15}  ;# compiled out-of-line to runtime call on Tcl_ExprObjCmd
} -result 1
} 1
test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
    expr {+2}
} 2
test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body {
    expr {+[expr 1+]}
} -returnCodes error -match glob -result *
test compExpr-2.36 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
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
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







-
-
+
+
-


-
-
-
+
+
+
-


-
-
-
+
+
+
-


-
-
-
+
+
+
-


-
-
-
+
+
+
-


-
+

-
-
+
+
-


-
-
-
+
+
+
-


-
+



-
-
-
+
+
+
-



-
-
-
+
+
+
-


-
-
-
+
+
+
-


-
-
-
+
+
+
-


-
-
-
+
+
+
-


-
+









-
-
+
+
-


-
-
-
+
+
+
-


-
+



-
-
+
+
-


-
-
-
+
+
+
-


-
+



-
-
+
+
-


-
-
-
+
+
+
-


-
+








-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







-
-
+
+

-
-
+
+













-
-
-
+
+
+







} -returnCodes error -match glob -result *
test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
    expr {-2}
} -2
test compExpr-2.40 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
    expr {4-2}
} 2
test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
    unset -nocomplain a
test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
    catch {unset a}
} -body {
    set a true
    expr {0||$a}
} -result 1
test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
    unset -nocomplain a
} 1
test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
    catch {unset a}
} -body {
    set a 15
    list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
} -result {0 1}
test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
    unset -nocomplain a
} {0 1}
test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
    catch {unset a}
} -body {
    set a false
    expr {3&&$a}
} -result 0
test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
    unset -nocomplain a
} 0
test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
    catch {unset a}
} -body {
    set a false
    expr {$a||1? 1 : 0}
} -result 1
test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
    unset -nocomplain a
} 1
test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
    catch {unset a}
} -body {
    set a 15
    list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg
} -result {0 54}
} {0 54}

test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} -setup {
    unset -nocomplain a
test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} {
    catch {unset a}
} -body {
    set a 2
    expr {[set a]||0}
} -result 1
test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} -setup {
    unset -nocomplain a
} 1
test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} {
    catch {unset a}
} -body {
    set a no
    expr {$a&&1}
} -result 0
} 0
test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} -body {
    expr {[expr *2]||0}
} -returnCodes error -match glob -result *
test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} -setup {
    unset -nocomplain a
    unset -nocomplain b
test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} {
    catch {unset a}
    catch {unset b}
} -body {
    set a no
    set b true
    expr {$a || $b}
} -result 1
test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup {
    unset -nocomplain a
} 1
test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} {
    catch {unset a}
} -body {
    set a yes
    expr {$a || [exit]}
} -result 1
test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup {
    unset -nocomplain a
} 1
test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} {
    catch {unset a}
} -body {
    set a no
    expr {$a && [exit]}
} -result 0
test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} -setup {
    unset -nocomplain a
} 0
test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} {
    catch {unset a}
} -body {
    set a 2
    expr {0||[set a]}
} -result 1
test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} -setup {
    unset -nocomplain a
} 1
test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} {
    catch {unset a}
} -body {
    set a no
    expr {1&&$a}
} -result 0
} 0
test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} -body {
    expr {0||[expr %2]}
} -returnCodes error -match glob -result *
test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} {
    set a "abcdefghijkl"
    set i 7
    expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
} 1

test compExpr-4.1 {CompileCondExpr procedure, simple test} -setup {
    unset -nocomplain a
test compExpr-4.1 {CompileCondExpr procedure, simple test} {
    catch {unset a}
} -body {
    set a 2
    expr {($a > 1)? "ok" : "nope"}
} -result ok
test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} -setup {
    unset -nocomplain a
} ok
test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} {
    catch {unset a}
} -body {
    set a no
    expr {[set a]? 27 : -54}
} -result -54
} -54
test compExpr-4.3 {CompileCondExpr procedure, error in test} -body {
    expr {[expr *2]? +1 : -1}
} -returnCodes error -match glob -result *
test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} -setup {
    unset -nocomplain a
test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} {
    catch {unset a}
} -body {
    set a no
    expr {1? (27-2) : -54}
} -result 25
test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} -setup {
    unset -nocomplain a
} 25
test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} {
    catch {unset a}
} -body {
    set a no
    expr {1? $a : -54}
} -result no
} no
test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} -body {
    expr {1? [expr *2] : -127}
} -returnCodes error -match glob -result *
test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} -setup {
    unset -nocomplain a
test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} {
    catch {unset a}
} -body {
    set a no
    expr {(2-2)? -3.14159 : "nope"}
} -result nope
test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} -setup {
    unset -nocomplain a
} nope
test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} {
    catch {unset a}
} -body {
    set a 0o0123
    expr {0? 42 : $a}
} -result 83
} 83
test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
    list [catch {expr {1? 15 : [expr *2]}} msg] $msg
} {0 15}

test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
    format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
    expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
test compExpr-5.5 {CompileMathFuncCall procedure, not enough arguments} -body {
    expr {atan2(1.0)}
} -returnCodes error -match glob -result {not enough arguments for math function*}
    list [catch {expr {do_it()}} msg] $msg
} -match glob -result {1 {* "*do_it"}}
test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr 3*T1()-1
} 368
test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T2()*3
} 1035
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
    list [catch {expr {atan2(1.0)}} msg] $msg
} -match glob -result {1 {too few arguments for math function*}}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
    format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
} 9.97424
test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {
    expr {sinh(2.*)}
} -returnCodes error -match glob -result *
test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body {
    expr {sinh(2.0, 3.0)}
} -returnCodes error -match glob -result {too many arguments for math function*}
    list [catch {expr {sinh(2.0, 3.0)}} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} -body {
    expr {0 <= rand(5.2)}
} -returnCodes error -match glob -result {too many arguments for math function*}
    list [catch {expr {0 <= rand(5.2)}} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}

test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -body {
    expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3
} -returnCodes error -match glob -result *

test compExpr-7.1 {Memory Leak} -constraints memory -setup {
    proc getbytes {} {
	set lines [split [memory info] \n]
	lindex $lines 3 3
    }
} -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	interp create child
	child eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
	interp delete child
	interp create slave
	slave eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
	interp delete slave
	set tmp $end
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    unset end i tmp
    rename getbytes {}
366
367
368
369
370
371
372
373

374
375
376
377
378
379
380
381
382
383
354
355
356
357
358
359
360

361
362
363
364
365
366












-
+





-
-
-
-
-
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    unset end i tmp
    rename getbytes {}
} -result 0


# cleanup
catch {unset a}
catch {unset b}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/compile.test.

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
1
2
3
4
5
6
7
8
9
10
11
12
13



14
15





16
17
18
19
20
21
22













-
-
-
+
+
-
-
-
-
-







# This file contains tests for the files tclCompile.c, tclCompCmds.c and
# tclLiteral.c
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint exec       [llength [info commands exec]]
testConstraint memory     [llength [info commands memory]]
testConstraint testevalex [llength [info commands testevalex]]

# The following tests are very incomplete, although the rest of the
# test suite covers this file fairly well.
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
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







-
+








-
+





-
+

-
+

-




-
-
-
+
+
+

-





-
-
+
+

















-
+







-
+







    list [catch {p} msg] $msg
} {1 {wrong # args: should be "p x"}}

test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} -setup {
    catch {unset x}
} -body {
    set x 123
    list $::x [expr {"x" in [info globals]}]
    list $::x [expr {[lsearch -exact [info globals] x] != 0}]
} -result {123 1}
test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} -setup {
    catch {unset y}
} -body {
    proc p {} {
        set ::y 789
        return $::y
    }
    list [p] $::y [expr {"y" in [info globals]}]
    list [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
} -result {789 789 1}
test compile-2.3 {TclCompileDollarVar: global array name with ::s} -setup {
    catch {unset a}
} -body {
    set ::a(1) 2
    list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {"a" in [info globals]}]
    list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {[lsearch -exact [info globals] a] != 0}]
} -result {2 3 3 1}
test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} -setup {
test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
    catch {unset a}
} -body {
    proc p {} {
        set ::a(1) 1
        return $::a($::a(1))
    }
    list [p] $::a(1) [expr {"a" in [info globals]}]
} -result {1 1 1}
test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} -setup {
    list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
} {1 1 1}
test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} {
    catch {unset a}
} -body {
    proc p {} {
	global a
        set a(1) 1
        return ${a(1)}$::a(1)$a(1)
    }
    list [p] $::a(1) [expr {"a" in [info globals]}]
} -result {111 1 1}
    list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
} {111 1 1}

test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} -setup {
    catch {unset a}
} -body {
    set a(1) xyzzyx
    proc p {} {
        global a
        catch {set x 123} a(1)
    }
    list [p] $a(1)
} -result {0 123}
test compile-3.2 {TclCompileCatchCmd: non-local variables} {
    set ::foo 1
    proc catch-test {} {
	catch {set x 3} ::foo
    }
    catch-test
    return $::foo
    set ::foo
} 3
test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} {
    proc catch-test {str} {
	catch [eval $str GOOD]
	error BAD
    }
    catch {catch-test error} ::foo
    return $::foo
    set ::foo
} {GOOD}
test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
    proc foo {} {
	set fail [catch {
	    return 1
	}] ; # {}
	return 2
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
158
159
160
161
162
163
164





























165
166
167
168
169
170
171







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	}
	catchtest::x
    }
    -result {10 {can't set "result1": trace on result1 fails by request}}
    -cleanup {namespace delete catchtest}
}

test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
     -setup {
	 namespace eval catchtest {
	     variable options1 {}
	 }
	 trace add variable catchtest::options1 write catchtest::failtrace
	 proc catchtest::failtrace {n1 n2 op} {
	     return -code error "trace on $n1 fails by request"
	 }
     }
    -body {
	proc catchtest::x {} {
	    variable options1
	    set count 0
	    for {set i 0} {$i < 10} {incr i} {
		set status2 [catch {
		    set status1 [catch {
			return -code error -level 0 "original failure"
		    } result1 options1]
		} result2 options2]
		incr count
	    }
	    list $count $result2
	}
	catchtest::x
    }
    -result {10 {can't set "options1": trace on options1 fails by request}}
    -cleanup {namespace delete catchtest}
}

test compile-4.1 {TclCompileForCmd: command substituted test expression} {
    set i 0
    set j 0
    # Should be "forever"
    for {} [expr $i < 3] {} {
	set j [incr i]
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
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







-
-
-
-
-
-
-
-
-
-
-










-
-
+
+









-
+







    set ::foo 1
    proc foreach-test {} {
	foreach ::foo {1 2 3} {}
    }
    foreach-test
    set ::foo
} 3
test compile-5.3 {TclCompileForeachCmd: [Bug b9b2079e6d]} -setup {
    proc demo {} {
	foreach x y {
	    if 1 break else
	}
    }
} -body {
    demo
} -cleanup {
    rename demo {}
} -returnCodes error -result {wrong # args: no script following "else" argument}

test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} -setup {
    catch {unset x}
    catch {unset y}
} -body {
    set x 123
    proc p {} {
        set ::y 789
        return $::y
    }
    list $::x [expr {"x" in [info globals]}] \
         [p] $::y [expr {"y" in [info globals]}]
    list $::x [expr {[lsearch -exact [info globals] x] != 0}] \
         [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
} -result {123 1 789 789 1}
test compile-6.2 {TclCompileSetCmd: global array names with ::s} -setup {
    catch {unset a}
} -body {
    set ::a(1) 2
    proc p {} {
        set ::a(1) 1
        return $::a($::a(1))
    }
    list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {"a" in [info globals]}]
    list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
} -result {2 1 3 3 1}
test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} -setup {
    catch {namespace delete test_ns_compile}
    catch {unset x}
} -body {
    namespace eval test_ns_compile {
        variable v hello
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
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







-
-
+
+




-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+


-
+
+

-
-
+
+

-
+







    set x {{0}}
    set y 0
    while {$y < 100} {
	if !$x {incr y}
    }
} {}

test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} {
test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
    proc p {} {
	# shared object - Interp result && Var 'r'
	set r [list foobar]
	# command that will add error to result
	lindex a bogus
    }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a bogus }}
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
    }
    list [catch {p} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
    proc p {} { set r [list foobar] ; string index a bogus }
    list [catch {p} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; string index a 0o9 }}
} -returnCodes error -match glob -result {*}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; array set var {one two many} }}
} -returnCodes error -result {list must have an even number of elements}
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; incr foo bar baz}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; incr}}
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
    proc p {} { set r [list foobar] ; string index a 0o9 }
    list [catch {p} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
    proc p {} { set r [list foobar] ; array set var {one two many} }
    list [catch {p} msg] $msg
} {1 {list must have an even number of elements}}
test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
    proc p {} { set r [list foobar] ; incr foo bar baz}
    list [catch {p} msg] $msg
} {1 {wrong # args: should be "incr varName ?increment?"}}
test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
    proc p {} { set r [list foobar] ; incr}
    list [catch {p} msg] $msg
} {1 {wrong # args: should be "incr varName ?increment?"}}
test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr !a }}
    proc p {} { set r [list foobar] ; expr !a }
    p
} -returnCodes error -match glob -result *
test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; expr {!a} }}
    proc p {} { set r [list foobar] ; expr {!a} }
    p
} -returnCodes error -match glob -result *
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
    apply {{} { set r [list foobar] ; llength "\{" }}
test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
    proc p {} { set r [list foobar] ; llength "\{" }
    list [catch {p} msg] $msg
} -returnCodes error -result {unmatched open brace in list}
} {1 {unmatched open brace in list}}

#
# Special section for tests of tclLiteral.c
# The following tests check for incorrect memory handling in
# TclReleaseLiteral. They are only effective when tcl is compiled with
# TCL_MEM_DEBUG
#
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
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







-
+




-
+








-
+







    _ti_gencode
    interp recursionlimit ti [expr {10000+50}]
    ti eval {set result {}}
} -body {
    # Test different compilation variants (instructions evalStk, invokeStk, etc),
    # with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
    # boxes or systems, please don't decrease it (either provide a constraint)
    ti eval {foreach cmd {eval "if 1" try catch} {
    ti eval {foreach cmd {eval "if 1" catch} {
	set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 1000}] $cmd]
	if 1 $c
    }}
    ti eval {set result}
} -result {1 1 1 1}
} -result {1 1 1}
test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup {
    _ti_gencode
    interp recursionlimit ti 100
    ti eval {set result {}}
} -body {
    # Test different compilation variants (instructions evalStk, invokeStk, etc),
    # with 500 nested scripts (bodies). It must generate "too many nested compilations"
    # error for any variant we're testing here:
    ti eval {foreach cmd {eval "if 1" try catch} {
    ti eval {foreach cmd {eval "if 1" catch} {
	set c [gencode 500 $cmd]
	lappend errors [catch $c e] $e
    }}
    #puts $errors
    # all of nested calls exceed the limit, so must end with "too many nested compilations"
    # (or evaluations, depending on compile method/instruction and "mixed" compile within
    # evaliation), so no one succeeds, the result must be empty:
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
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







-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
+
+
+
+


-
-
+







    set a($) 3
    list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0]
} -cleanup {unset a} -result [list 1 2 3 {$}]


# Tests compile-15.* cover Tcl Bug 633204
test compile-15.1 {proper TCL_RETURN code from [return]} {
    apply {{} {catch return}}
    proc p {} {catch return}
    set result [p]
    rename p {}
    set result
} 2
test compile-15.2 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {return foo}}}
    proc p {} {catch {return foo}}
    set result [p]
    rename p {}
    set result
} 2
test compile-15.3 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {return $::tcl_library}}}
    proc p {} {catch {return $::tcl_library}}
    set result [p]
    rename p {}
    set result
} 2
test compile-15.4 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {return [info library]}}}
    proc p {} {catch {return [info library]}}
    set result [p]
    rename p {}
    set result
} 2
test compile-15.5 {proper TCL_RETURN code from [return]} {
    apply {{} {catch {set a 1}; return}}
    proc p {} {catch {set a 1}; return}
    set result [p]
    rename p {}
    set result
} ""

# Do all tests once byte compiled and once with direct string evaluation
foreach noComp {0 1} {
for {set noComp 0} {$noComp <= 1} {incr noComp} {

if $noComp {
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} if 1
    set constraints {}
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
668
669
670
671
672
673
674







675
676
677
678
679
680
681







-
-
-
-
-
-
-







    namespace delete x
} -returnCodes ok -result {syntax {}{}}
test compile-16.24.$noComp {
    Bug 1638414: bad list constant as first expanded term
} -constraints $constraints -body {
    run "{*}\"\{foo bar\""
} -returnCodes error -result {unmatched open brace in list}
test compile-16.25.$noComp {TclCompileScript: word expansion, naked backslashes} $constraints {
    run {list {*}{a \n b}}
} {a {
} b}
test compile-16.26.$noComp {TclCompileScript: word expansion, protected backslashes} $constraints {
    run {list {*}{a {\n} b}}
} {a {\n} b}
}	;# End of noComp loop

# These tests are messy because it wrecks the interpreter it runs in!  They
# demonstrate issues arising from [FRQ 1101710]
test compile-17.1 {Command interpretation binding for compiled code} -constraints knownBug -setup {
    set i [interp create]
} -body {
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
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
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
701
702
703
704
705
706
707
















































































































































































































































































































































































708
709
710
711
712
713
714
715
716
717
718
719
720







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













	    ]
	}
    }
} -cleanup {
    interp delete $i
} -result substituted

# This tests the supported parts of the unsupported [disassemble] command. It
# does not check the format of disassembled bytecode though; that's liable to
# change without warning.

set disassemblables [linsert [join {
    constructor destructor lambda method objmethod proc script
} ", "] end-1 or]
test compile-18.1 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble
} -match glob -result {wrong # args: should be "*"}
test compile-18.2 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble ?
} -result "bad type \"?\": must be $disassemblables"
test compile-18.3 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble lambda
} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
test compile-18.4 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble lambda \{
} -result "can't interpret \"\{\" as a lambda expression"
test compile-18.5 {disassembler - basics} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble lambda {{} {}}
} -match glob -result *
test compile-18.6 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble proc
} -match glob -result {wrong # args: should be "* proc procName"}
test compile-18.7 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble proc nosuchproc
} -result {"nosuchproc" isn't a procedure}
test compile-18.8 {disassembler - basics} -setup {
    proc chewonthis {} {}
} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble proc chewonthis
} -cleanup {
    rename chewonthis {}
} -match glob -result *
test compile-18.9 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble script
} -match glob -result {wrong # args: should be "* script script"}
test compile-18.10 {disassembler - basics} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble script {}
} -match glob -result *
test compile-18.11 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble method
} -match glob -result {wrong # args: should be "* method className methodName"}
test compile-18.12 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble method nosuchclass foo
} -result {nosuchclass does not refer to an object}
test compile-18.13 {disassembler - basics} -returnCodes error -setup {
    oo::object create justanobject
} -body {
    tcl::unsupported::disassemble method justanobject foo
} -cleanup {
    justanobject destroy
} -result {"justanobject" is not a class}
test compile-18.14 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble method oo::object nosuchmethod
} -result {unknown method "nosuchmethod"}
test compile-18.15 {disassembler - basics} -setup {
    oo::class create foo {method bar {} {}}
} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble method foo bar
} -cleanup {
    foo destroy
} -match glob -result *
test compile-18.16 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble objmethod
} -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
test compile-18.17 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble objmethod nosuchobject foo
} -result {nosuchobject does not refer to an object}
test compile-18.18 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble objmethod oo::object nosuchmethod
} -result {unknown method "nosuchmethod"}
test compile-18.19 {disassembler - basics} -setup {
    oo::object create foo
    oo::objdefine foo {method bar {} {}}
} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble objmethod foo bar
} -cleanup {
    foo destroy
} -match glob -result *
# There never was a compile-18.20.
# The keys of the dictionary produced by [getbytecode] are defined.
set bytecodekeys {literals variables exception instructions auxiliary commands script namespace stackdepth exceptdepth}
test compile-18.21 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode
} -match glob -result {wrong # args: should be "*"}
test compile-18.22 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode ?
} -result "bad type \"?\": must be $disassemblables"
test compile-18.23 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode lambda
} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
test compile-18.24 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode lambda \{
} -result "can't interpret \"\{\" as a lambda expression"
test compile-18.25 {disassembler - basics} -body {
    dict keys [tcl::unsupported::getbytecode lambda {{} {}}]
} -result "$bytecodekeys initiallinenumber sourcefile"
test compile-18.26 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode proc
} -match glob -result {wrong # args: should be "* proc procName"}
test compile-18.27 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode proc nosuchproc
} -result {"nosuchproc" isn't a procedure}
test compile-18.28 {disassembler - basics} -setup {
    proc chewonthis {} {}
} -body {
    dict keys [tcl::unsupported::getbytecode proc chewonthis]
} -cleanup {
    rename chewonthis {}
} -result "$bytecodekeys initiallinenumber sourcefile"
test compile-18.28.1 {disassembler - tricky bit} -setup {
    eval [list proc chewonthis {} {}]
} -body {
    dict keys [tcl::unsupported::getbytecode proc chewonthis]
} -cleanup {
    rename chewonthis {}
} -result $bytecodekeys
test compile-18.28.2 {disassembler - tricky bit} -setup {
    eval {proc chewonthis {} {}}
} -body {
    dict keys [tcl::unsupported::getbytecode proc chewonthis]
} -cleanup {
    rename chewonthis {}
} -result "$bytecodekeys initiallinenumber sourcefile"
test compile-18.28.3 {disassembler - tricky bit} -setup {
    proc Proc {n a b} {
	proc $n $a $b
    }
    Proc chewonthis {} {}
} -body {
    dict keys [tcl::unsupported::getbytecode proc chewonthis]
} -cleanup {
    rename Proc {}
    rename chewonthis {}
} -result $bytecodekeys
test compile-18.28.4 {disassembler - tricky bit} -setup {
    proc Proc {n a b} {
	tailcall proc $n $a $b
    }
    Proc chewonthis {} {}
} -body {
    dict keys [tcl::unsupported::getbytecode proc chewonthis]
} -cleanup {
    rename Proc {}
    rename chewonthis {}
} -result "$bytecodekeys initiallinenumber sourcefile"
test compile-18.29 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode script
} -match glob -result {wrong # args: should be "* script script"}
test compile-18.30 {disassembler - basics} -body {
    dict keys [tcl::unsupported::getbytecode script {}]
} -result $bytecodekeys
test compile-18.31 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode method
} -match glob -result {wrong # args: should be "* method className methodName"}
test compile-18.32 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode method nosuchclass foo
} -result {nosuchclass does not refer to an object}
test compile-18.33 {disassembler - basics} -returnCodes error -setup {
    oo::object create justanobject
} -body {
    tcl::unsupported::getbytecode method justanobject foo
} -cleanup {
    justanobject destroy
} -result {"justanobject" is not a class}
test compile-18.34 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode method oo::object nosuchmethod
} -result {unknown method "nosuchmethod"}
test compile-18.35 {disassembler - basics} -setup {
    oo::class create foo {method bar {} {}}
} -body {
    dict keys [tcl::unsupported::getbytecode method foo bar]
} -cleanup {
    foo destroy
} -result "$bytecodekeys initiallinenumber sourcefile"
test compile-18.36 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode objmethod
} -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
test compile-18.37 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode objmethod nosuchobject foo
} -result {nosuchobject does not refer to an object}
test compile-18.38 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode objmethod oo::object nosuchmethod
} -result {unknown method "nosuchmethod"}
test compile-18.39 {disassembler - basics} -setup {
    oo::object create foo
    oo::objdefine foo {method bar {} {}}
} -body {
    dict keys [tcl::unsupported::getbytecode objmethod foo bar]
} -cleanup {
    foo destroy
} -result "$bytecodekeys initiallinenumber sourcefile"
test compile-18.40 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble constructor
} -match glob -result {wrong # args: should be "* constructor className"}
test compile-18.41 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble constructor nosuchclass
} -result {nosuchclass does not refer to an object}
test compile-18.42 {disassembler - basics} -returnCodes error -setup {
    oo::object create justanobject
} -body {
    tcl::unsupported::disassemble constructor justanobject
} -cleanup {
    justanobject destroy
} -result {"justanobject" is not a class}
test compile-18.43 {disassembler - basics} -returnCodes error -setup {
    oo::class create constructorless
} -body {
    tcl::unsupported::disassemble constructor constructorless
} -cleanup {
    constructorless destroy
} -result {"constructorless" has no defined constructor}
test compile-18.44 {disassembler - basics} -setup {
    oo::class create foo {constructor {} {set x 1}}
} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble constructor foo
} -cleanup {
    foo destroy
} -match glob -result *
test compile-18.45 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode constructor
} -match glob -result {wrong # args: should be "* constructor className"}
test compile-18.46 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode constructor nosuchobject
} -result {nosuchobject does not refer to an object}
test compile-18.47 {disassembler - basics} -returnCodes error -setup {
    oo::class create constructorless
} -body {
    tcl::unsupported::getbytecode constructor constructorless
} -cleanup {
    constructorless destroy
} -result {"constructorless" has no defined constructor}
test compile-18.48 {disassembler - basics} -setup {
    oo::class create foo {constructor {} {set x 1}}
} -body {
    dict keys [tcl::unsupported::getbytecode constructor foo]
} -cleanup {
    foo destroy
} -result "$bytecodekeys"
# There is no compile-18.49
test compile-18.50 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble destructor
} -match glob -result {wrong # args: should be "* destructor className"}
test compile-18.51 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::disassemble destructor nosuchclass
} -result {nosuchclass does not refer to an object}
test compile-18.52 {disassembler - basics} -returnCodes error -setup {
    oo::object create justanobject
} -body {
    tcl::unsupported::disassemble destructor justanobject
} -cleanup {
    justanobject destroy
} -result {"justanobject" is not a class}
test compile-18.53 {disassembler - basics} -returnCodes error -setup {
    oo::class create constructorless
} -body {
    tcl::unsupported::disassemble destructor constructorless
} -cleanup {
    constructorless destroy
} -result {"constructorless" has no defined destructor}
test compile-18.54 {disassembler - basics} -setup {
    oo::class create foo {destructor {set x 1}}
} -body {
    # Allow any string: the result format is not defined anywhere!
    tcl::unsupported::disassemble destructor foo
} -cleanup {
    foo destroy
} -match glob -result *
test compile-18.55 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode destructor
} -match glob -result {wrong # args: should be "* destructor className"}
test compile-18.56 {disassembler - basics} -returnCodes error -body {
    tcl::unsupported::getbytecode destructor nosuchobject
} -result {nosuchobject does not refer to an object}
test compile-18.57 {disassembler - basics} -returnCodes error -setup {
    oo::class create constructorless
} -body {
    tcl::unsupported::getbytecode destructor constructorless
} -cleanup {
    constructorless destroy
} -result {"constructorless" has no defined destructor}
test compile-18.58 {disassembler - basics} -setup {
    oo::class create foo {destructor {set x 1}}
} -body {
    dict keys [tcl::unsupported::getbytecode destructor foo]
} -cleanup {
    foo destroy
} -result "$bytecodekeys"

test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
    # This will panic in a --enable-symbols=compile build, unless bug is fixed.
    apply {{} {list [if 1]}}
} -returnCodes error -match glob -result *

test compile-20.1 {ensure there are no infinite loops in optimizing} {
    tcl::unsupported::disassemble script {
	while 1 {
	    return -code continue -level 0
	}
    }
    return
} {}
test compile-20.2 {ensure there are no infinite loops in optimizing} {
    tcl::unsupported::disassemble script {
	while 1 {
	    while 1 {
		return -code break -level 0
	    }
	}
    }
    return
} {}

test compile-21.1 {stack balance management} {
    apply {{} {
	set result {}
	while 1 {
	    lappend result a
	    lappend result [list b [break]]
	    lappend result c
	}
	return $result
    }}
} a
test compile-21.2 {stack balance management} {
    apply {{} {
	set result {}
	while {[incr i] <= 10} {
	    lappend result $i
	    lappend result [list b [continue] c]
	    lappend result c
	}
	return $result
    }}
} {1 2 3 4 5 6 7 8 9 10}
test compile-21.3 {stack balance management} {
    apply {args {
	set result {}
	while 1 {
	    lappend result a
	    lappend result [concat {*}$args [break]]
	    lappend result c
	}
	return $result
    }} P Q R S T
} a
test compile-21.4 {stack balance management} {
    apply {args {
	set result {}
	while {[incr i] <= 10} {
	    lappend result $i
	    lappend result [concat {*}$args [continue] c]
	    lappend result c
	}
	return $result
    }} P Q R S T
} {1 2 3 4 5 6 7 8 9 10}

# TODO sometime - check that bytecode from tbcload is *not* disassembled.

# cleanup
catch {rename p ""}
catch {namespace delete test_ns_compile}
catch {unset x}
catch {unset y}
catch {unset a}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/concat.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+


-
+







# Commands covered:  concat
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


test concat-1.1 {simple concatenation} {
    concat a b c d e f g
} {a b c d e f g}
test concat-1.2 {merging lists together} {
    concat a {b c d} {e f g h}
} {a b c d e f g h}
test concat-1.3 {merge lists, retain sub-lists} {
42
43
44
45
46
47
48
49

50
51
52
53
54
55
56
57
42
43
44
45
46
47
48

49
50
51
52












-
+



-
-
-
-
-
} {a b c}
test concat-4.2 {pruning off extra white space} {
    concat x y "  a b c	\n\t  " "   "  " def "
} {x y a b c def}
test concat-4.3 {pruning off extra white space sets length correctly} {
    llength [concat { {{a}} }]
} 1


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/config.test.

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
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







-
-
+
+





-
+













-
+



















-
+




# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test pkgconfig-1.1 {query keys} {
    lsort [::tcl::pkgconfig list]
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded}
test pkgconfig-1.2 {query keys multiple times} {
    string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
test pkgconfig-1.3 {query value multiple times} {
    string compare \
	    [::tcl::pkgconfig get bindir,install] \
	    [::tcl::pkgconfig get bindir,install]
} 0


test pkgconfig-2.0 {error: missing subcommand} {
    catch {::tcl::pkgconfig} msg
    set msg
} {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"}
} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
test pkgconfig-2.1 {error: illegal subcommand} {
    catch {::tcl::pkgconfig foo} msg
    set msg
} {bad subcommand "foo": must be get or list}
test pkgconfig-2.2 {error: list with arguments} {
    catch {::tcl::pkgconfig list foo} msg
    set msg
} {wrong # args: should be "::tcl::pkgconfig list"}
test pkgconfig-2.3 {error: get without arguments} {
    catch {::tcl::pkgconfig get} msg
    set msg
} {wrong # args: should be "::tcl::pkgconfig get key"}
test pkgconfig-2.4 {error: query unknown key} {
    catch {::tcl::pkgconfig get foo} msg
    set msg
} {key not known}
test pkgconfig-2.5 {error: query with to many arguments} {
    catch {::tcl::pkgconfig get foo bar} msg
    set msg
} {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"}
} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}

# cleanup
::tcltest::cleanupTests
return

Deleted tests/coroutine.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  coroutine, yield, yieldto, [info coroutine]
#
# This file contains a collection of tests for experimental commands that are
# found in ::tcl::unsupported. The tests will migrate to normal test files
# if/when the commands find their way into the core.
#
# Copyright (c) 2008 by Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testnrelevels [llength [info commands testnrelevels]]
testConstraint memory [llength [info commands memory]]

set lambda [list {{start 0} {stop 10}} {
    # init
    set i    $start
    set imax $stop
    yield
    while {$i < $imax} {
	yield [expr {$i*$stop}]
	incr i
    }
}]

test coroutine-1.1 {coroutine basic} -setup {
    coroutine foo ::apply $lambda
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [foo]
    }
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {0 10 20}
test coroutine-1.2 {coroutine basic} -setup {
    coroutine foo ::apply $lambda 2 8
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [foo]
    }
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {16 24 32}
test coroutine-1.3 {yield returns new arg} -setup {
    set body {
	# init
	set i    $start
	set imax $stop
	yield
	while {$i < $imax} {
	    set stop [yield [expr {$i*$stop}]]
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 2} {stop 10}} $body]
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [foo $k]
    }
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {20 6 12}
test coroutine-1.4 {yield in nested proc} -setup {
    proc moo {} {
	upvar 1 i i stop stop
	yield [expr {$i*$stop}]
    }
    set body {
	# init
	set i    $start
	set imax $stop
	yield
	while {$i < $imax} {
	    moo
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [foo $k]
    }
    set res
} -cleanup {
    rename foo {}
    rename moo {}
    unset body res
} -result {0 10 20}
test coroutine-1.5 {just yield} -body {
    coroutine foo yield
    list [foo] [catch foo msg] $msg
} -cleanup {
    unset msg
} -result {{} 1 {invalid command name "foo"}}
test coroutine-1.6 {just yield} -body {
    coroutine foo [list yield]
    list [foo] [catch foo msg] $msg
} -cleanup {
    unset msg
} -result {{} 1 {invalid command name "foo"}}
test coroutine-1.7 {yield in nested uplevel} -setup {
    set body {
	# init
	set i    $start
	set imax $stop
	yield
	while {$i < $imax} {
	    uplevel 0 [list yield [expr {$i*$stop}]]
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [eval foo $k]
    }
    set res
} -cleanup {
    rename foo {}
    unset body res
} -result {0 10 20}
test coroutine-1.8 {yield in nested uplevel} -setup {
    set body {
	# init
	set i    $start
	set imax $stop
	yield
	while {$i < $imax} {
	    uplevel 0 yield [expr {$i*$stop}]
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [eval foo $k]
    }
    set res
} -cleanup {
    rename foo {}
    unset body res
} -result {0 10 20}
test coroutine-1.9 {yield in nested eval} -setup {
    proc moo {} {
	upvar 1 i i stop stop
	yield [expr {$i*$stop}]
    }
    set body {
	# init
	set i    $start
	set imax $stop
	yield
	while {$i < $imax} {
	    eval moo
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [foo $k]
    }
    set res
} -cleanup {
    rename moo {}
    unset body res
} -result {0 10 20}
test coroutine-1.10 {yield in nested eval} -setup {
    set body {
	# init
	set i    $start
	set imax $stop
	yield
	while {$i < $imax} {
	    eval yield [expr {$i*$stop}]
	    incr i
	}
    }
    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
    set res {}
} -body {
    for {set k 1} {$k < 4} {incr k} {
	lappend res [eval foo $k]
    }
    set res
} -cleanup {
    unset body res
} -result {0 10 20}
test coroutine-1.11 {yield outside coroutine} -setup {
    proc moo {} {
	upvar 1 i i stop stop
	yield [expr {$i*$stop}]
    }
} -body {
    variable i 5 stop 6
    moo
} -cleanup {
    rename moo {}
    unset i stop
} -returnCodes error -result {yield can only be called in a coroutine}
test coroutine-1.12 {proc as coroutine} -setup {
    set body {
	# init
	set i    $start
	set imax $stop
	yield
	while {$i < $imax} {
	    uplevel 0 [list yield [expr {$i*$stop}]]
	    incr i
	}
    }
    proc moo {{start 0} {stop 10}} $body
    coroutine foo moo 2 8
} -body {
    list [foo] [foo]
} -cleanup {
    unset body
    rename moo {}
    rename foo {}
} -result {16 24}
test coroutine-1.13 {subst as coroutine: literal} {
    list [coroutine foo eval {subst {>>[yield a],[yield b]<<}}] [foo x] [foo y]
} {a b >>x,y<<}
test coroutine-1.14 {subst as coroutine: in variable} {
    set pattern {>>[yield c],[yield d]<<}
    list [coroutine foo eval {subst $pattern}] [foo p] [foo q]
} {c d >>p,q<<}

test coroutine-2.1 {self deletion on return} -body {
    coroutine foo set x 3
    foo
} -returnCodes error -result {invalid command name "foo"}
test coroutine-2.2 {self deletion on return} -body {
    coroutine foo ::apply [list {} {yield; yield 1; return 2}]
    list [foo] [foo] [catch foo msg] $msg
} -result {1 2 1 {invalid command name "foo"}}
test coroutine-2.3 {self deletion on error return} -body {
    coroutine foo ::apply [list {} {yield;yield 1; error ouch!}]
    list [foo] [catch foo msg] $msg [catch foo msg] $msg
} -result {1 1 ouch! 1 {invalid command name "foo"}}
test coroutine-2.4 {self deletion on other return} -body {
    coroutine foo ::apply [list {} {yield;yield 1; return -code 100 ouch!}]
    list [foo] [catch foo msg] $msg [catch foo msg] $msg
} -result {1 100 ouch! 1 {invalid command name "foo"}}
test coroutine-2.5 {deletion of suspended coroutine} -body {
    coroutine foo ::apply [list {} {yield; yield 1; return 2}]
    list [foo] [rename foo {}] [catch foo msg] $msg
} -result {1 {} 1 {invalid command name "foo"}}
test coroutine-2.6 {deletion of running coroutine} -body {
    coroutine foo ::apply [list {} {yield; rename foo {}; yield 1; return 2}]
    list [foo] [catch foo msg] $msg
} -result {1 1 {invalid command name "foo"}}

test coroutine-3.1 {info level computation} -setup {
    proc a {} {while 1 {yield [info level]}}
    proc b {} foo
} -body {
    # note that coroutines execute in uplevel #0
    set l0 [coroutine foo a]
    set l1 [foo]
    set l2 [b]
    list $l0 $l1 $l2
} -cleanup {
    rename a {}
    rename b {}
} -result {1 1 1}
test coroutine-3.2 {info frame computation} -setup {
    proc a {} {while 1 {yield [info frame]}}
    proc b {} foo
} -body {
    set l0 [coroutine foo a]
    set l1 [foo]
    set l2 [b]
    expr {$l2 - $l1}
} -cleanup {
    rename a {}
    rename b {}
} -result 1
test coroutine-3.3 {info coroutine} -setup {
    proc a {} {info coroutine}
    proc b {} a
} -body {
    b
} -cleanup {
    rename a {}
    rename b {}
} -result {}
test coroutine-3.4 {info coroutine} -setup {
    proc a {} {info coroutine}
    proc b {} a
} -body {
    coroutine foo b
} -cleanup {
    rename a {}
    rename b {}
} -result ::foo
test coroutine-3.5 {info coroutine} -setup {
    proc a {} {info coroutine}
    proc b {} {rename [info coroutine] {}; a}
} -body {
    coroutine foo b
} -cleanup {
    rename a {}
    rename b {}
} -result {}
test coroutine-3.6 {info frame, bug #2910094} -setup {
    proc stack {} {
	set res [list "LEVEL:[set lev [info frame]]"]
	for {set i 1} {$i < $lev} {incr i} {
	    lappend res [info frame $i]
	}
	set res
	# the precise command depends on line numbers and such, is likely not
	# to be stable: just check that the test completes!
	return
    }
    proc a {} stack
} -body {
    coroutine aa a
} -cleanup {
    rename stack {}
    rename a {}
} -result {}
test coroutine-3.7 {bug 0b874c344d} {
    dict get [coroutine X coroutine Y info frame 0] cmd
} {coroutine X coroutine Y info frame 0}

test coroutine-4.1 {bug #2093188} -setup {
    proc foo {} {
	set v 1
	trace add variable v {write unset} bar
	yield
	set v 2
	yield
	set v 3
    }
    proc bar args {lappend ::res $args}
    coroutine a foo
} -body {
    list [a] [a] $::res
} -cleanup {
    rename foo {}
    rename bar {}
    unset ::res
} -result {{} 3 {{v {} write} {v {} write} {v {} unset}}}
test coroutine-4.2 {bug #2093188} -setup {
    proc foo {} {
	set v 1
	trace add variable v {read unset} bar
	yield
	set v 2
	set v
	yield
	set v 3
    }
    proc bar args {lappend ::res $args}
    coroutine a foo
} -body {
    list [a] [a] $::res
} -cleanup {
    rename foo {}
    rename bar {}
    unset ::res
} -result {{} 3 {{v {} read} {v {} unset}}}

test coroutine-4.3 {bug #2093947} -setup {
    proc foo {} {
	set v 1
	trace add variable v {write unset} bar
	yield
	set v 2
	yield
	set v 3
    }
    proc bar args {lappend ::res $args}
} -body {
    coroutine a foo
    a
    a
    coroutine a foo
    a
    rename a {}
    set ::res
} -cleanup {
    rename foo {}
    rename bar {}
    unset ::res
} -result {{v {} write} {v {} write} {v {} unset} {v {} write} {v {} unset}}

test coroutine-4.4 {bug #2917627: cmd resolution} -setup {
    proc a {} {return global}
    namespace eval b {proc a {} {return local}}
} -body {
    namespace eval b {coroutine foo a}
} -cleanup {
    rename a {}
    namespace delete b
} -result local

test coroutine-4.5 {bug #2724403} -constraints {memory} \
-setup {
    proc getbytes {} {
	set lines [split [memory info] "\n"]
	lindex $lines 3 3
    }
} -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	set ns ::y$i
	namespace eval $ns {}
	proc ${ns}::start {} {yield; puts hello}
	coroutine ${ns}::run ${ns}::start
	namespace delete $ns
	set start $end
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $start}]
} -cleanup {
    rename getbytes {}
    unset i ns start end
} -result 0

test coroutine-4.6 {compile context, bug #3282869} -setup {
    unset -nocomplain ::x
    proc f x {
	coroutine D eval {yield X$x;yield Y}
    }
} -body {
    f 12
} -cleanup {
    rename f {}
} -returnCodes error -match glob -result {can't read *}

test coroutine-4.7 {compile context, bug #3282869} -setup {
    proc f x {
	coroutine D eval {yield X$x;yield Y$x}
    }
} -body {
    set ::x 15
    set ::x [f 12]
    D
} -cleanup {
    D
    unset ::x
    rename f {}
} -result YX15

test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
-setup {
    proc nestedYield {{val {}}} {
	yield $val
    }
    proc getNumLevel {} {
	# remove the level for this proc's call
	expr {[lindex [testnrelevels] 1] - 1}
    }
    proc relativeLevel base {
	# remove the level for this proc's call
	expr {[getNumLevel] - $base - 1}
    }
    proc foo {} {
	while 1 {
	    nestedYield
	}
    }
    set res {}
} -body {
    set base [getNumLevel]
    lappend res [relativeLevel $base]
    eval {coroutine a foo}
    # back to base level
    lappend res [relativeLevel $base]
    a
    lappend res [relativeLevel $base]
    eval a
    lappend res [relativeLevel $base]
    eval {eval a}
    lappend res [relativeLevel $base]
    rename a {}
    lappend res [relativeLevel $base]
    set res
} -cleanup {
    rename foo {}
    rename nestedYield {}
    rename getNumLevel {}
    rename relativeLevel {}
    unset res
} -result {0 0 0 0 0 0}
test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \
-setup {
    proc nestedYield {{val {}}} {
	yield $val
    }
    proc getNumLevel {} {
	# remove the level for this proc's call
	expr {[lindex [testnrelevels] 1] - 1}
    }
    proc relativeLevel base {
	# remove the level for this proc's call
	expr {[getNumLevel] - $base - 1}
    }
    proc foo base {
	while 1 {
	    set base [nestedYield [relativeLevel $base]]
	}
    }
    set res {}
} -body {
    lappend res [eval {coroutine a foo [getNumLevel]}]
    lappend res [a [getNumLevel]]
    lappend res [eval {a [getNumLevel]}]
    lappend res [eval {eval {a [getNumLevel]}}]
    set base [lindex $res 0]
    foreach x $res[set res {}] {
	lappend res [expr {$x-$base}]
    }
    set res
} -cleanup {
    rename a {}
    rename foo {}
    rename nestedYield {}
    rename getNumLevel {}
    rename relativeLevel {}
    unset res
} -result {0 0 0 0}

test coroutine-6.1 {coroutine nargs} -body {
    coroutine a ::apply $lambda
    a
} -cleanup {
    rename a {}
} -result 0
test coroutine-6.2 {coroutine nargs} -body {
    coroutine a ::apply $lambda
    a a
} -cleanup {
    rename a {}
} -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} {} {} {}}
test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
    proc foo {a b} {catch yield; return 1}
} -cleanup {
    rename foo {}
} -body {
    coroutine demo lsort -command foo {a b}
} -result {b a}
test coroutine-7.5 {return codes} {
    set result {}
    foreach code {0 1 2 3 4 5} {
	lappend result [catch {coroutine demo return -level 0 -code $code}]
    }
    set result
} {0 1 2 3 4 5}
test coroutine-7.6 {Early yield crashes} -setup {
    set i [interp create]
} -body {
    # Force into a child interpreter [bug 60559fd4a6]
    $i eval {
	proc foo args {}
	trace add execution foo enter {catch yield}
	coroutine demo foo
	rename foo {}
	return ok
    }
} -cleanup {
    interp delete $i
} -result ok
test coroutine-7.7 {Bug 2486550} -setup {
    set i [interp create]
    $i hide yield
} -body {
    # Force into a child interpreter [bug 60559fd4a6]
    $i eval {
	coroutine demo interp invokehidden {} yield ok
    }
} -cleanup {
    $i eval demo
    interp delete $i
} -result ok
test coroutine-7.8 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	lappend ::result a
	yield OUT
	lappend ::result b
	yieldto ::return -level 0 123
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    namespace delete cotest
    namespace eval cotest {}
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	set y ::yieldto
	lappend ::result a
	yield OUT
	lappend ::result b
	$y ::return -level 0 123
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    namespace delete cotest
    namespace eval cotest {}
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	lappend ::result a
	yield OUT
	lappend ::result b
	yieldto ::return -level 0 -cotest [namespace delete ::cotest] 123
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
    namespace eval cotest {}
    set ::result ""
} -body {
    proc cotest::body {} {
	set y ::yieldto
	lappend ::result a
	yield OUT
	lappend ::result b
	$y ::return -level 0 -cotest [namespace delete ::cotest] 123
	lappend ::result c
	return
    }
    lappend ::result [coroutine cotest cotest::body]
    lappend ::result [cotest]
    cotest
    return $result
} -returnCodes error -cleanup {
    catch {namespace delete ::cotest}
    catch {rename cotest ""}
} -result {yieldto called in deleted namespace}
test coroutine-7.12 {coro floor above street level #3008307} -body {
    proc c {} {
	yield
    }
    proc cc {} {
	coroutine C c
    }
    proc boom {} {
	cc ; # coro created at level 2
	C  ; # and called at level 1
    }
    boom   ; # does not crash: the coro floor is a good insulator
    list
} -cleanup {
    rename boom {}; rename cc {}; rename c {}
} -result {}

test coroutine-8.0.0 {coro inject executed} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    demo
    set ::result none
    tcl::unsupported::inject demo set ::result inject-executed
    demo
    set ::result
} -result {inject-executed}
test coroutine-8.0.1 {coro inject after error} -body {
    coroutine demo apply {{} { foreach i {1 2} yield; error test }}
    demo
    set ::result none
    tcl::unsupported::inject demo set ::result inject-executed
    lappend ::result [catch {demo} err] $err
} -result {inject-executed 1 test}
test coroutine-8.1.1 {coro inject, ticket 42202ba1e5ff566e} -body {
    interp create child
    child eval {
	coroutine demo apply {{} { while {1} yield }}
	demo
	tcl::unsupported::inject demo set ::result inject-executed
    }
    interp delete child
} -result {}
test coroutine-8.1.2 {coro inject with result, ticket 42202ba1e5ff566e} -body {
    interp create child
    child eval {
	coroutine demo apply {{} { while {1} yield }}
	demo
	tcl::unsupported::inject demo set ::result inject-executed
    }
    child eval demo
    set result [child eval {set ::result}]

    interp delete child
    set result
} -result {inject-executed}

test coroutine-9.1 {coroprobe with yield} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    list [coroprobe demo set i] [demo] [coroprobe demo set i] [demo]
} -cleanup {
    catch {rename demo {}}
} -result {1 {} 2 {}}
test coroutine-9.2 {coroprobe with yieldto} -body {
    coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }}
    list [coroprobe demo set i] [demo a b] [coroprobe demo set i] [demo c d]
} -cleanup {
    catch {rename demo {}}
} -result {1 {} 2 {{a b} {c d}}}
test coroutine-9.3 {coroprobe errors} -setup {
    catch {rename demo {}}
} -body {
    coroprobe demo set i
} -returnCodes error -result {can only inject a probe command into a coroutine}
test coroutine-9.4 {coroprobe errors} -body {
    proc demo {} { foreach i {1 2} yield }
    coroprobe demo set i
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {can only inject a probe command into a coroutine}
test coroutine-9.5 {coroprobe errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroprobe
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"}
test coroutine-9.6 {coroprobe errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroprobe demo
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroprobe coroName cmd ?arg1 arg2 ...?"}
test coroutine-9.7 {coroprobe errors in probe command} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroprobe demo set
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "set varName ?newValue?"}
test coroutine-9.8 {coroprobe errors in probe command} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    list [catch {coroprobe demo set}] [demo] [coroprobe demo set i]
} -cleanup {
    catch {rename demo {}}
} -result {1 {} 2}
test coroutine-9.9 {coroprobe: advanced features} -setup {
    set i [interp create]
} -body {
    $i eval {
	coroutine demo apply {{} {
	    set f [info level],[info frame]
	    foreach i {1 2} yield
	}}
	coroprobe demo apply {{} {
	    upvar 1 f f
	    list [info coroutine] [info level] [info frame] $f
	}}
    }
} -cleanup {
    interp delete $i
} -result {::demo 2 3 1,2}

test coroutine-10.1 {coroinject with yield} -setup {
    set result {}
} -body {
    coroutine demo apply {{} { lmap i {1 2} yield }}
    coroinject demo apply {{op val} {lappend ::result $op $val}}
    list $result [demo x] [demo y] $result
} -cleanup {
    catch {rename demo {}}
} -result {{} {} {{yield x} y} {yield x}}
test coroutine-10.2 {coroinject stacking} -setup {
    set result {}
} -body {
    coroutine demo apply {{} { lmap i {1 2} yield }}
    coroinject demo apply {{op val} {lappend ::result $op $val A;return $val}}
    coroinject demo apply {{op val} {lappend ::result $op $val B;return $val}}
    list $result [demo x] [demo y] $result
} -cleanup {
    catch {rename demo {}}
} -result {{} {} {x y} {yield x B yield x A}}
test coroutine-10.3 {coroinject with yieldto} -setup {
    set result {}
} -body {
    coroutine demo apply {{} { lmap i {1 2} {yieldto string cat} }}
    coroinject demo apply {{op val} {lappend ::result $op $val;return $val}}
    list $result [demo x mp] [demo y le] $result
} -cleanup {
    catch {rename demo {}}
} -result {{} {} {{x mp} {y le}} {yieldto {x mp}}}
test coroutine-10.4 {coroinject errors} -setup {
    catch {rename demo {}}
} -body {
    coroinject demo set i
} -returnCodes error -result {can only inject a command into a coroutine}
test coroutine-10.5 {coroinject errors} -body {
    proc demo {} { foreach i {1 2} yield }
    coroinject demo set i
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {can only inject a command into a coroutine}
test coroutine-10.6 {coroinject errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroinject
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"}
test coroutine-10.7 {coroinject errors} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroinject demo
} -returnCodes error -cleanup {
    catch {rename demo {}}
} -result {wrong # args: should be "coroinject coroName cmd ?arg1 arg2 ...?"}
test coroutine-10.8 {coroinject errors in injected command} -body {
    coroutine demo apply {{} { foreach i {1 2} yield }}
    coroinject demo apply {args {error "ERR: $args"}}
    list [catch demo msg] $msg [catch demo msg] $msg
} -cleanup {
    catch {rename demo {}}
} -result {1 {ERR: yield {}} 1 {invalid command name "demo"}}
test coroutine-10.9 {coroinject: advanced features} -setup {
    set i [interp create]
} -body {
    $i eval {
	coroutine demo apply {{} {
	    set l [info level]
	    set f [info frame]
	    lmap i {1 2} yield
	}}
	coroinject demo apply {{arg op val} {
	    global result
	    upvar 1 f f l l
	    lappend result [info coroutine] $arg $op $val
	    lappend result [info level] $l [info frame] $f
	    lappend result [yield $arg]
	    return [string toupper $val]
	}} grill
	list [demo ABC] [demo pqr] [demo def] $result
    }
} -cleanup {
    interp delete $i
} -result {grill {} {ABC def} {::demo grill yield ABC 2 1 3 2 pqr}}

test coroutine-11.1 {coro type} {
    coroutine demo eval {
	yield
	yield "PHASE 1"
	yieldto string cat "PHASE 2"
	::tcl::unsupported::corotype [info coroutine]
    }
    list [demo] [::tcl::unsupported::corotype demo] \
	[demo] [::tcl::unsupported::corotype demo] [demo]
} {{PHASE 1} yield {PHASE 2} yieldto active}
test coroutine-11.2 {coro type} -setup {
    catch {rename nosuchcommand ""}
} -returnCodes error -body {
    ::tcl::unsupported::corotype nosuchcommand
} -result {can only get coroutine type of a coroutine}
test coroutine-11.3 {coro type} -returnCodes error -body {
    proc notacoroutine {} {}
    ::tcl::unsupported::corotype notacoroutine
} -returnCodes error -cleanup {
    rename notacoroutine {}
} -result {can only get coroutine type of a coroutine}

test coroutine-12.1 {coroutine general introspection} -setup {
    set i [interp create]
} -body {
    $i eval {
	# Make the introspection code
	namespace path tcl::unsupported
	proc probe {type var} {
	    upvar 1 $var v
	    set f [info frame]
	    incr f -1
	    set result [list $v [dict get [info frame $f] proc]]
	    if {$type eq "yield"} {
		tailcall yield $result
	    } else {
		tailcall yieldto string cat $result
	    }
	}
	proc pokecoro {c var} {
	    inject $c probe [corotype $c] $var
	    $c
	}

	# Coroutine implementations
	proc cbody1 {} {
	    set val [info coroutine]
	    set accum {}
	    while {[set val [yield $val]] ne ""} {
		lappend accum $val
		set val ok
	    }
	    return $accum
	}
	proc cbody2 {} {
	    set val [info coroutine]
	    set accum {}
	    while {[llength [set val [yieldto string cat $val]]]} {
		lappend accum {*}$val
		set val ok
	    }
	    return $accum
	}

	# Make the coroutines
	coroutine c1 cbody1
	coroutine c2 cbody2
	list [c1 abc] [c2 1 2 3] [pokecoro c1 accum] [pokecoro c2 accum] \
	    [c1 def] [c2 4 5 6] [pokecoro c1 accum] [pokecoro c2 accum] \
	    [c1] [c2]
    }
} -cleanup {
    interp delete $i
} -result {ok ok {abc ::cbody1} {{1 2 3} ::cbody2} ok ok {{abc def} ::cbody1} {{1 2 3 4 5 6} ::cbody2} {abc def} {1 2 3 4 5 6}}

# cleanup
unset lambda
::tcltest::cleanupTests

return

# Local Variables:
# mode: tcl
# End:

Changes to tests/dcall.test.

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
1
2
3
4
5
6
7
8
9
10
11
12
13



14
15




16
17
18
19
20
21
22













-
-
-
+
+
-
-
-
-







# Commands covered:  none
#
# This file contains a collection of tests for Tcl_CallWhenDeleted.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testdcall [llength [info commands testdcall]]

test dcall-1.1 {deletion callbacks} testdcall {
    lsort -increasing [testdcall 1 2 3]
} {1 2 3}
test dcall-1.2 {deletion callbacks} testdcall {

Changes to tests/dict.test.

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








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





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
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

611
612
613
614
615
616
617
618
619
620
621



622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443


1444

1445
1446
1447
1448
1449
1450

1451
1452
1453

1454
1455
1456
1457
1458

1459
1460
1461
1462
1463
1464
1465

1466
1467
1468
1469


1470
1471
1472
1473
1474
1475
1476
1477
1478



1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489



1490
1491
1492
1493
1494

1495
1496
1497
1498


1499
1500
1501
1502
1503
1504
1505
1506
1507



1508
1509
1510
1511
1512
1513
1514
1515
1516



1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530


1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
1668
1669
1670
1671
1672
1673
1674
1675
1676

1677
1678
1679
1680
1681
1682
1683

1684
1685
1686
1687
1688
1689
1690


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





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
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
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
611




612
613
614
615




616
617
618
619





620
621
622

623






624
625
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
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
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
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
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
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
-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+
















-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+










-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+






-
+
-
-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
+
+
+




-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+


-
+

-
+

-
+

-
+
-
-
-
-
-
+
+
+










-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
+
+

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+




-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







-
-
-
-
-
-
+
+
+
+
+
+

-
+



+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-




-
-
-
-
-
+
+
+
+
+
+
+
+
+
+




-
+
-
-
-
-
+
+


-
+
-
-
-
-
+
+
-
-
-
-
-
-
-


-
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-
-
-
-
+
+


-
-
-
-
+
+

-
+
-
-
-
-
+
+

-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+

-
+
-
-
-
-
+
+

-
+
-
-
-
-
+
+

-
+
-
-
-
-
-
+
+
+
-

-
+
-
-
-
+
+
+

-
+






-
+
+


-
+


-
+
+


-
+


-
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
-
+
+
+

-
-
-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
-

-
+
-
-
-
+
+
+
-
-
-

-
+


-
-
-
-
+
+



-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
-
+
+
+

-
-
-
-
+
+

-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
-

-
+
-
-
-
-
+
+
+
+


-
-
-

-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
-
-
+





-
+






-
-
-
-
-
+
+
+






-
-
-
-
-
+
+
+







-
-
-
+









-
+
+





-
+
+

-
+










-
-
-
-
-
+
+
+
+

-
-








+
-
+
-
-
-
+

-
+






-
+
+



-
+





-
+
+



-
+


-
+
+





-
+


+
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
-
+
+
+
-

-
-
-
-
-
-
+
+
+
+
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
+

-
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+

-
+
-
-
-
-
+
+

-
+
-
-
-
-
-
+
+
+
-

-
-
-
-
-
-
-
-
+
+
+
+
+
+
-

-
+
-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-
-
+

-
+
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
+
+
-
-
+
+


-
+


-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+


-
-
-
+





-
+

-





-
-
-
-
+
+

-





-
-
-
+

-
+
+





-
+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+



-
-
+
+



+
-
-
-
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
-
+
+


-
+

-
-
+
+


-
+


-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+







-
-
-
-
+
+







-
-
-
-
+
+







-
-
-
-
+
+




-
+
-
-
-
-
+
+



-
+
-
-
-
+






-
-
-
-
-
+
+
+




-
+
-
-
-
-
+
+




-
+
-
-
-
+

-
+








+
-
-
+
+

-
+



+
-
+


-
+



+
-
+

-
+











-
+
-
-

-
+










+
+
-
+
-




-
+


-
+




-
+






-
+
-
-
-
-
+
+




-
-
-
-
-
+
+
+






-
-
-
-
-
+
+
+




-
+
-
-
-
-
+
+




-
-
-
-
-
+
+
+




-
-
-
-
-
+
+
+










-
-
-
-
+
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+











-
+






-
+







# This test file covers the dictionary object type and the dict command used
# to work with values of that type.
# This test file covers the dictionary object type and the dict
# command used to work with values of that type.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003-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.
# Copyright (c) 2003 Donal K. Fellows
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
	set end [lindex [split [memory info] \n] 3 3]
	for {set i 0} {$i < 5} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [lindex [split [memory info] \n] 3 3]
	}
	expr {$end - $tmp}
    }
}

test dict-1.1 {dict command basic syntax} -returnCodes error -body {
    dict
} -result {wrong # args: should be "dict subcommand ?arg ...?"}
test dict-1.2 {dict command basic syntax} -returnCodes error -body {
    dict ?
} -match glob -result {unknown or ambiguous subcommand "?": must be *}

# Procedure to help check the contents of a dictionary.  Note that we
# can't just compare the string version because the order of the
# elements is (deliberately) not defined.  This is because it is
# dependent on the underlying hash table implementation and also
# potentially on the history of the value itself.  Net result: you
# cannot safely assume anything about the ordering of values.
proc getOrder {dictVal args} {
    foreach key $args {
	lappend result $key [dict get $dictVal $key]
    }
    lappend result [dict size $dictVal]
    return $result
}

test dict-1.1 {dict command basic syntax} {
    list [catch {dict} msg] $msg
} {1 {wrong # args: should be "dict subcommand ?argument ...?"}}
test dict-1.2 {dict command basic syntax} {
    list [catch {dict ?} msg] $msg
} {1 {unknown or ambiguous subcommand "?": must be append, create, exists, filter, for, get, incr, info, keys, lappend, merge, remove, replace, set, size, unset, update, values, or with}}

test dict-2.1 {dict create command} {
    dict create
} {}
test dict-2.2 {dict create command} {
    dict create a b
} {a b}
test dict-2.3 {dict create command} -body {
test dict-2.3 {dict create command} {
    set result {}
    set dict [dict create a b c d]
    # Can't compare directly as ordering of values is undefined
    foreach key {a c} {
	set idx [lsearch -exact $dict $key]
	if {$idx & 1} {
	    error "found $key at odd index $idx in $dict"
	}
	lappend result [lindex $dict [expr {$idx+1}]]
    }
    return $result
} -cleanup {
    unset result dict key idx
} -result {b d}
test dict-2.4 {dict create command} -returnCodes error -body {
    dict create a
} -result {wrong # args: should be "dict create ?key value ...?"}
test dict-2.5 {dict create command} -returnCodes error -body {
    dict create a b c
} -result {wrong # args: should be "dict create ?key value ...?"}
test dict-2.6 {dict create command - initialse refcount field!} -body {
    set result
} {b d}
test dict-2.4 {dict create command} {
    list [catch {dict create a} msg] $msg
} {1 {wrong # args: should be "dict create ?key value ...?"}}
test dict-2.5 {dict create command} {
    list [catch {dict create a b c} msg] $msg
} {1 {wrong # args: should be "dict create ?key value ...?"}}
test dict-2.6 {dict create command - initialse refcount field!} {
    # Bug 715751 will show up in memory debuggers like purify
    for {set i 0} {$i<10} {incr i} {
	set dictv [dict create a 0]
	set share [dict values $dictv]
	list [dict incr dictv a]
    }
} -cleanup {
} {}
    unset i dictv share
} -result {}
test dict-2.7 {dict create command - #-quoting in string rep} {
    dict create # #comment
} {{#} #comment}
test dict-2.8 {dict create command - #-quoting in string rep} -body {
    dict create #a x #b x
} -match glob -result {{#?} x #? x}
test dict-2.9 {dict create command: compilation} {
    apply {{} {dict create [format a] b}}
} {a b}
test dict-2.10 {dict create command: compilation} {
    apply {{} {dict create [format a] b c d}}
} {a b c d}
test dict-2.11 {dict create command: compilation} {
    apply {{} {dict create [format a] b c d a x}}
} {a x c d}
test dict-2.12 {dict create command: non-compilation} {
    dict create [format a] b
} {a b}
test dict-2.13 {dict create command: non-compilation} {
    dict create [format a] b c d
} {a b c d}
test dict-2.14 {dict create command: non-compilation} {
    dict create [format a] b c d a x
} {a x c d}

test dict-3.1 {dict get command} {dict get {a b} a} b
test dict-3.2 {dict get command} {dict get {a b c d} a} b
test dict-3.3 {dict get command} {dict get {a b c d} c} d
test dict-3.4 {dict get command} -returnCodes error -body {
    dict get {a b c d} b
} -result {key "b" not known in dictionary}
test dict-3.4 {dict get command} {
    list [catch {dict get {a b c d} b} msg] $msg
} {1 {key "b" not known in dictionary}}
test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q
test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s
test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v
test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y
test dict-3.9 {dict get command} -returnCodes error -body {
    dict get {a {p q r s} b {u v x y}} a z
} -result {key "z" not known in dictionary}
test dict-3.10 {dict get command} -returnCodes error -body {
    dict get {a {p q r s} b {u v x y}} c z
} -result {key "c" not known in dictionary}
test dict-3.9 {dict get command} {
    list [catch {dict get {a {p q r s} b {u v x y}} a z} msg] $msg
} {1 {key "z" not known in dictionary}}
test dict-3.10 {dict get command} {
    list [catch {dict get {a {p q r s} b {u v x y}} c z} msg] $msg
} {1 {key "c" not known in dictionary}}
test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b
test dict-3.12 {dict get command} -returnCodes error -body {
    dict get
} -result {wrong # args: should be "dict get dictionary ?key ...?"}
test dict-3.13 {dict get command} -body {
test dict-3.12 {dict get command} {
    list [catch {dict get} msg] $msg
} {1 {wrong # args: should be "dict get dictionary ?key key ...?"}}
test dict-3.13 {dict get command} {
    set dict [dict get {a b c d}]
    if {$dict eq "a b c d"} {
	return OK
	subst OK
    } elseif {$dict eq "c d a b"} {
	return reordered
	subst OK
    } else {
	return $dict
	set dict
    }
} -cleanup {
} OK
    unset dict
} -result OK
test dict-3.14 {dict get command} -returnCodes error -body {
    dict get {a b c d} a c
} -result {missing value to go with key}
test dict-3.14 {dict get command} {
    list [catch {dict get {a b c d} a c} msg] $msg
} {1 {missing value to go with key}}
test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body {
    apply {{} {
	dict set a(z) b c
	dict get $a(z) d
    }}
} -returnCodes error -result {key "d" not known in dictionary}
test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3}
test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6

test dict-4.1 {dict replace command} {
    dict replace {a b c d}
} {a b c d}
    getOrder [dict replace {a b c d}] a c
} {a b c d 2}
test dict-4.2 {dict replace command} {
    dict replace {a b c d} e f
} {a b c d e f}
    getOrder [dict replace {a b c d} e f] a c e
} {a b c d e f 3}
test dict-4.3 {dict replace command} {
    dict replace {a b c d} c f
} {a b c f}
    getOrder [dict replace {a b c d} c f] a c
} {a b c f 2}
test dict-4.4 {dict replace command} {
    dict replace {a b c d} c x a y
} {a y c x}
test dict-4.5 {dict replace command} -returnCodes error -body {
    dict replace
} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
test dict-4.6 {dict replace command} -returnCodes error -body {
    dict replace {a a} a
} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
test dict-4.7 {dict replace command} -returnCodes error -body {
    dict replace {a a a} a b
} -result {missing value to go with key}
test dict-4.8 {dict replace command} -returnCodes error -body {
    dict replace [list a a a] a b
} -result {missing value to go with key}
    getOrder [dict replace {a b c d} c x a y] a c
} {a y c x 2}
test dict-4.5 {dict replace command} {
    list [catch {dict replace} msg] $msg
} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
test dict-4.6 {dict replace command} {
    list [catch {dict replace {a a} a} msg] $msg
} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
test dict-4.7 {dict replace command} {
    list [catch {dict replace {a a a} a b} msg] $msg
} {1 {missing value to go with key}}
test dict-4.8 {dict replace command} {
    list [catch {dict replace [list a a a] a b} msg] $msg
} {1 {missing value to go with key}}
test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
test dict-4.11 {dict replace command: canonicality is forced} {
    dict replace { a b  c d }
} {a b c d}
test dict-4.12 {dict replace command: canonicality is forced} {
    dict replace {a b c d a e}
} {a e c d}
test dict-4.13 {dict replace command: type check is mandatory} -body {
    dict replace { a b c d e }
} -errorCode {TCL VALUE DICTIONARY} -result {missing value to go with key}
test dict-4.14 {dict replace command: type check is mandatory} -body {
    dict replace { a b {}c d }
} -returnCodes error -result {dict element in braces followed by "c" instead of space}
test dict-4.14a {dict replace command: type check is mandatory} {
    catch {dict replace { a b {}c d }} -> opt
    dict get $opt -errorcode
} {TCL VALUE DICTIONARY JUNK}
test dict-4.15 {dict replace command: type check is mandatory} -body {
    dict replace { a b ""c d }
} -returnCodes error -result {dict element in quotes followed by "c" instead of space}
test dict-4.15a {dict replace command: type check is mandatory} {
    catch {dict replace { a b ""c d }} -> opt
    dict get $opt -errorcode
} {TCL VALUE DICTIONARY JUNK}
test dict-4.16 {dict replace command: type check is mandatory} -body {
    dict replace " a b \"c d "
} -returnCodes error -result {unmatched open quote in dict}
test dict-4.16a {dict replace command: type check is mandatory} {
    catch {dict replace " a b \"c d "} -> opt
    dict get $opt -errorcode
} {TCL VALUE DICTIONARY QUOTE}
test dict-4.17 {dict replace command: type check is mandatory} -body {
    dict replace " a b \{c d "
} -errorCode {TCL VALUE DICTIONARY BRACE} -result {unmatched open brace in dict}
test dict-4.18 {dict replace command: canonicality forcing doesn't leak} {
    set example { a b  c d }
    list $example [dict replace $example]
} {{ a b  c d } {a b c d}}

test dict-5.1 {dict remove command} {dict remove {a b c d} a} {c d}
test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {}
test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {}
test dict-5.5 {dict remove command} {
    dict remove {a b c d}
} {a b c d}
    getOrder [dict remove {a b c d}] a c
} {a b c d 2}
test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
test dict-5.7 {dict remove command} -returnCodes error -body {
    dict remove
} -result {wrong # args: should be "dict remove dictionary ?key ...?"}
test dict-5.7 {dict remove command} {
    list [catch {dict remove} msg] $msg
} {1 {wrong # args: should be "dict remove dictionary ?key ...?"}}
test dict-5.8 {dict remove command: canonicality is forced} {
    dict remove { a b  c d }
} {a b c d}
test dict-5.9 {dict remove command: canonicality is forced} {
    dict remove {a b c d a e}
} {a e c d}
test dict-5.10 {dict remove command: canonicality forced by update} {
    dict remove { a b c d } c
} {a b}
test dict-5.11 {dict remove command: type check is mandatory} -body {
    dict remove { a b c d e }
} -returnCodes error -result {missing value to go with key}
test dict-5.12 {dict remove command: type check is mandatory} -body {
    dict remove { a b {}c d }
} -returnCodes error -result {dict element in braces followed by "c" instead of space}
test dict-5.13 {dict remove command: canonicality forcing doesn't leak} {
    set example { a b  c d }
    list $example [dict remove $example]
} {{ a b  c d } {a b c d}}

test dict-6.1 {dict keys command} {dict keys {a b}} a
test dict-6.2 {dict keys command} {dict keys {c d}} c
test dict-6.3 {dict keys command} {lsort [dict keys {a b c d}]} {a c}
test dict-6.4 {dict keys command} {dict keys {a b c d} a} a
test dict-6.5 {dict keys command} {dict keys {a b c d} c} c
test dict-6.6 {dict keys command} {dict keys {a b c d} e} {}
test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca}
test dict-6.8 {dict keys command} -returnCodes error -body {
    dict keys
} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
test dict-6.9 {dict keys command} -returnCodes error -body {
    dict keys {} a b
} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
test dict-6.10 {dict keys command} -returnCodes error -body {
    dict keys a
} -result {missing value to go with key}
test dict-6.8 {dict keys command} {
    list [catch {dict keys} msg] $msg
} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
test dict-6.9 {dict keys command} {
    list [catch {dict keys {} a b} msg] $msg
} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
test dict-6.10 {dict keys command} {
    list [catch {dict keys a} msg] $msg
} {1 {missing value to go with key}}

test dict-7.1 {dict values command} {dict values {a b}} b
test dict-7.2 {dict values command} {dict values {c d}} d
test dict-7.3 {dict values command} {lsort [dict values {a b c d}]} {b d}
test dict-7.4 {dict values command} {dict values {a b c d} b} b
test dict-7.5 {dict values command} {dict values {a b c d} d} d
test dict-7.6 {dict values command} {dict values {a b c d} e} {}
test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da}
test dict-7.8 {dict values command} -returnCodes error -body {
    dict values
} -result {wrong # args: should be "dict values dictionary ?pattern?"}
test dict-7.9 {dict values command} -returnCodes error -body {
    dict values {} a b
} -result {wrong # args: should be "dict values dictionary ?pattern?"}
test dict-7.10 {dict values command} -returnCodes error -body {
    dict values a
} -result {missing value to go with key}
test dict-7.8 {dict values command} {
    list [catch {dict values} msg] $msg
} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
test dict-7.9 {dict values command} {
    list [catch {dict values {} a b} msg] $msg
} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
test dict-7.10 {dict values command} {
    list [catch {dict values a} msg] $msg
} {1 {missing value to go with key}}

test dict-8.1 {dict size command} {dict size {}} 0
test dict-8.2 {dict size command} {dict size {a b}} 1
test dict-8.3 {dict size command} {dict size {a b c d}} 2
test dict-8.4 {dict size command} -returnCodes error -body {
    dict size
} -result {wrong # args: should be "dict size dictionary"}
test dict-8.5 {dict size command} -returnCodes error -body {
    dict size a b
} -result {wrong # args: should be "dict size dictionary"}
test dict-8.6 {dict size command} -returnCodes error -body {
    dict size a
} -result {missing value to go with key}
test dict-8.4 {dict size command} {
    list [catch {dict size} msg] $msg
} {1 {wrong # args: should be "dict size dictionary"}}
test dict-8.5 {dict size command} {
    list [catch {dict size a b} msg] $msg
} {1 {wrong # args: should be "dict size dictionary"}}
test dict-8.6 {dict size command} {
    list [catch {dict size a} msg] $msg
} {1 {missing value to go with key}}

test dict-9.1 {dict exists command} {dict exists {a b} a} 1
test dict-9.2 {dict exists command} {dict exists {a b} b} 0
test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1
test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0
test dict-9.5 {dict exists command} {dict exists {a {b c}} b c} 0
test dict-9.6 {dict exists command} {dict exists {a {b c d}} a c} 0
test dict-9.7 {dict exists command} -returnCodes error -body {
    dict exists
} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
test dict-9.8 {dict exists command} -returnCodes error -body {
    dict exists {}
} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
test dict-9.7 {dict exists command} {
    list [catch {dict exists} msg] $msg
} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
test dict-9.8 {dict exists command} {
    list [catch {dict exists {}} msg] $msg
} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}

test dict-10.1 {dict info command} -body {
test dict-10.1 {dict info command} {
    # Actual string returned by this command is undefined; it is
    # intended for human consumption and not for use by scripts.
    dict info {}
    subst {}
} -match glob -result *
test dict-10.2 {dict info command} -returnCodes error -body {
    dict info
} -result {wrong # args: should be "dict info dictionary"}
test dict-10.3 {dict info command} -returnCodes error -body {
    dict info {} x
} -result {wrong # args: should be "dict info dictionary"}
test dict-10.4 {dict info command} -returnCodes error -body {
    dict info x
} -result {missing value to go with key}
} {}
test dict-10.2 {dict info command} {
    list [catch {dict info} msg] $msg
} {1 {wrong # args: should be "dict info dictionary"}}
test dict-10.3 {dict info command} {
    list [catch {dict info {} x} msg] $msg
} {1 {wrong # args: should be "dict info dictionary"}}
test dict-10.4 {dict info command} {
    list [catch {dict info x} msg] $msg
} {1 {missing value to go with key}}

test dict-11.1 {dict incr command: unshared value} -body {
test dict-11.1 {dict incr command: unshared value} {
    set dictv [dict create \
	    a [string index "=0=" 1] \
	    b [expr {1+2}] \
	    c [expr {wide(0x80000000)+1}]]
    dict incr dictv a
} -cleanup {
    unset dictv
} -result {a 1 b 3 c 2147483649}
test dict-11.2 {dict incr command: unshared value} -body {
    set dictv [dict create \
	    a [string index "=0=" 1] \
	    b [expr {1+2}] \
	    c [expr {wide(0x80000000)+1}]]
    dict incr dictv b
} -cleanup {
    unset dictv
} -result {a 0 b 4 c 2147483649}
test dict-11.3 {dict incr command: unshared value} -body {
    getOrder [dict incr dictv a] a b c
} {a 1 b 3 c 2147483649 3}
test dict-11.2 {dict incr command: unshared value} {
    set dictv [dict create \
	    a [string index "=0=" 1] \
	    b [expr {1+2}] \
	    c [expr {wide(0x80000000)+1}]]
    getOrder [dict incr dictv b] a b c
} {a 0 b 4 c 2147483649 3}
test dict-11.3 {dict incr command: unshared value} {
    set dictv [dict create \
	    a [string index "=0=" 1] \
	    b [expr {1+2}] \
	    c [expr {wide(0x80000000)+1}]]
    dict incr dictv c
    getOrder [dict incr dictv c] a b c
} -cleanup {
    unset dictv
} -result {a 0 b 3 c 2147483650}
test dict-11.4 {dict incr command: shared value} -body {
} {a 0 b 3 c 2147483650 3}
test dict-11.4 {dict incr command: shared value} {
    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
    set sharing [dict values $dictv]
    dict incr dictv a
    getOrder [dict incr dictv a] a b c
} -cleanup {
    unset dictv sharing
} -result {a 1 b 3 c 2147483649}
test dict-11.5 {dict incr command: shared value} -body {
} {a 1 b 3 c 2147483649 3}
test dict-11.5 {dict incr command: shared value} {
    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
    set sharing [dict values $dictv]
    dict incr dictv b
} -cleanup {
    unset dictv sharing
} -result {a 0 b 4 c 2147483649}
test dict-11.6 {dict incr command: shared value} -body {
    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
    set sharing [dict values $dictv]
    dict incr dictv c
} -cleanup {
    unset dictv sharing
} -result {a 0 b 3 c 2147483650}
test dict-11.7 {dict incr command: unknown values} -body {
    getOrder [dict incr dictv b] a b c
} {a 0 b 4 c 2147483649 3}
test dict-11.6 {dict incr command: shared value} {
    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
    set sharing [dict values $dictv]
    getOrder [dict incr dictv c] a b c
} {a 0 b 3 c 2147483650 3}
test dict-11.7 {dict incr command: unknown values} {
    set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
    dict incr dictv d
    getOrder [dict incr dictv d] a b c d
} -cleanup {
    unset dictv
} -result {a 0 b 3 c 2147483649 d 1}
test dict-11.8 {dict incr command} -body {
} {a 0 b 3 c 2147483649 d 1 4}
test dict-11.8 {dict incr command} {
    set dictv {a 1}
    dict incr dictv a 2
} -cleanup {
    unset dictv
} -result {a 3}
test dict-11.9 {dict incr command} -returnCodes error -body {
} {a 3}
test dict-11.9 {dict incr command} {
    set dictv {a dummy}
    dict incr dictv a
    list [catch {dict incr dictv a} msg] $msg
} -cleanup {
    unset dictv
} -result {expected integer but got "dummy"}
test dict-11.10 {dict incr command} -returnCodes error -body {
} {1 {expected integer but got "dummy"}}
test dict-11.10 {dict incr command} {
    set dictv {a 1}
    dict incr dictv a dummy
    list [catch {dict incr dictv a dummy} msg] $msg
} -cleanup {
    unset dictv
} -result {expected integer but got "dummy"}
test dict-11.11 {dict incr command} -setup {
    unset -nocomplain dictv
} {1 {expected integer but got "dummy"}}
test dict-11.11 {dict incr command} {
    catch {unset dictv}
    dict incr dictv a
} -body {
    dict incr dictv a
} -cleanup {
    unset dictv
} -result {a 1}
test dict-11.12 {dict incr command} -returnCodes error -body {
} {a 1}
test dict-11.12 {dict incr command} {
    set dictv a
    dict incr dictv a
    list [catch {dict incr dictv a} msg] $msg
} -cleanup {
    unset dictv
} -result {missing value to go with key}
test dict-11.13 {dict incr command} -returnCodes error -body {
} {1 {missing value to go with key}}
test dict-11.13 {dict incr command} {
    set dictv a
    dict incr dictv a a a
    list [catch {dict incr dictv a a a} msg] $msg
} -cleanup {
    unset dictv
} -result {wrong # args: should be "dict incr dictVarName key ?increment?"}
test dict-11.14 {dict incr command} -returnCodes error -body {
} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
test dict-11.14 {dict incr command} {
    set dictv a
    dict incr dictv
    list [catch {dict incr dictv} msg] $msg
} -cleanup {
    unset dictv
} -result {wrong # args: should be "dict incr dictVarName key ?increment?"}
test dict-11.15 {dict incr command: write failure} -setup {
    unset -nocomplain dictVar
} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
test dict-11.15 {dict incr command: write failure} {
    catch {unset dictVar}
} -body {
    set dictVar(block) {}
    dict incr dictVar a
    set result [list [catch {dict incr dictVar a} msg] $msg]
} -returnCodes error -cleanup {
    unset dictVar
} -result {can't set "dictVar": variable is array}
    catch {unset dictVar}
    set result
} {1 {can't set "dictVar": variable is array}}
test dict-11.16 {dict incr command: compilation} {
    apply {{} {
    proc dicttest {} {
	set v {a 0 b 0 c 0}
	dict incr v a
	dict incr v b 1
	dict incr v c 2
	dict incr v d 3
	list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d]
    }}
    }
    dicttest
} {1 1 2 3}
test dict-11.17 {dict incr command: compilation} {
    apply {{} {
    proc dicttest {} {
	set dictv {a 1}
	dict incr dictv a 2
    }}
    }
    dicttest
} {a 3}

test dict-12.1 {dict lappend command} -body {
test dict-12.1 {dict lappend command} {
    set dictv {a a}
    dict lappend dictv a
} -cleanup {
    unset dictv
} -result {a a}
test dict-12.2 {dict lappend command} -body {
} {a a}
test dict-12.2 {dict lappend command} {
    set dictv {a a}
    set sharing [dict values $dictv]
    dict lappend dictv a b
} -cleanup {
    unset dictv sharing
} -result {a {a b}}
test dict-12.3 {dict lappend command} -body {
    set dictv {a a}
    set sharing [dict values $dictv]
    dict lappend dictv a b
} {a {a b}}
test dict-12.3 {dict lappend command} {
    set dictv {a a}
    dict lappend dictv a b c
} -cleanup {
    unset dictv
} -result {a {a b c}}
test dict-12.2.1 {dict lappend command} -body {
} {a {a b c}}
test dict-12.2.1 {dict lappend command} {
    set dictv [dict create a [string index =a= 1]]
    dict lappend dictv a b
} -cleanup {
    unset dictv
} -result {a {a b}}
test dict-12.4 {dict lappend command} -body {
} {a {a b}}
test dict-12.4 {dict lappend command} {
    set dictv {}
    dict lappend dictv a x y z
} -cleanup {
    unset dictv
} -result {a {x y z}}
test dict-12.5 {dict lappend command} -body {
    unset -nocomplain dictv
} {a {x y z}}
test dict-12.5 {dict lappend command} {
    catch {unset dictv}
    dict lappend dictv a b
} -cleanup {
    unset dictv
} -result {a b}
test dict-12.6 {dict lappend command} -returnCodes error -body {
} {a b}
test dict-12.6 {dict lappend command} {
    set dictv a
    dict lappend dictv a a
    list [catch {dict lappend dictv a a} msg] $msg
} -cleanup {
    unset dictv
} -result {missing value to go with key}
test dict-12.7 {dict lappend command} -returnCodes error -body {
    dict lappend
} -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"}
test dict-12.8 {dict lappend command} -returnCodes error -body {
    dict lappend dictv
} -result {wrong # args: should be "dict lappend dictVarName key ?value ...?"}
test dict-12.9 {dict lappend command} -returnCodes error -body {
} {1 {missing value to go with key}}
test dict-12.7 {dict lappend command} {
    list [catch {dict lappend} msg] $msg
} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
test dict-12.8 {dict lappend command} {
    list [catch {dict lappend dictv} msg] $msg
} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
test dict-12.9 {dict lappend command} {
    set dictv [dict create a "\{"]
    dict lappend dictv a a
    list [catch {dict lappend dictv a a} msg] $msg
} -cleanup {
    unset dictv
} -result {unmatched open brace in list}
test dict-12.10 {dict lappend command: write failure} -setup {
    unset -nocomplain dictVar
} {1 {unmatched open brace in list}}
test dict-12.10 {dict lappend command: write failure} {
    catch {unset dictVar}
} -body {
    set dictVar(block) {}
    dict lappend dictVar a x
    set result [list [catch {dict lappend dictVar a x} msg] $msg]
} -returnCodes error -cleanup {
    unset dictVar
} -result {can't set "dictVar": variable is array}
    catch {unset dictVar}
    set result
} {1 {can't set "dictVar": variable is array}}
test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} {
    apply {{} {set d {a 1 b 2 c 3}; dict lappend d b 22}}
} {a 1 b {2 22} c 3}

test dict-13.1 {dict append command} -body {
test dict-13.1 {dict append command} {
    set dictv {a a}
    dict append dictv a
} -cleanup {
    unset dictv
} -result {a a}
test dict-13.2 {dict append command} -body {
} {a a}
test dict-13.2 {dict append command} {
    set dictv {a a}
    set sharing [dict values $dictv]
    dict append dictv a b
} -cleanup {
    unset dictv sharing
} -result {a ab}
test dict-13.3 {dict append command} -body {
} {a ab}
test dict-13.3 {dict append command} {
    set dictv {a a}
    dict append dictv a b c
} -cleanup {
    unset dictv
} -result {a abc}
test dict-13.2.1 {dict append command} -body {
} {a abc}
test dict-13.2.1 {dict append command} {
    set dictv [dict create a [string index =a= 1]]
    dict append dictv a b
} -cleanup {
    unset dictv
} -result {a ab}
test dict-13.4 {dict append command} -body {
} {a ab}
test dict-13.4 {dict append command} {
    set dictv {}
    dict append dictv a x y z
} -cleanup {
    unset dictv
} -result {a xyz}
test dict-13.5 {dict append command} -body {
    unset -nocomplain dictv
} {a xyz}
test dict-13.5 {dict append command} {
    catch {unset dictv}
    dict append dictv a b
} -cleanup {
    unset dictv
} -result {a b}
test dict-13.6 {dict append command} -returnCodes error -body {
} {a b}
test dict-13.6 {dict append command} {
    set dictv a
    dict append dictv a a
    list [catch {dict append dictv a a} msg] $msg
} -cleanup {
    unset dictv
} -result {missing value to go with key}
test dict-13.7 {dict append command} -returnCodes error -body {
    dict append
} -result {wrong # args: should be "dict append dictVarName key ?value ...?"}
} {1 {missing value to go with key}}
test dict-13.7 {dict append command} {
    list [catch {dict append} msg] $msg
} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
test dict-13.8 {dict append command} {
    list [catch {dict append dictv} msg] $msg
} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
test dict-13.8 {dict append command} -returnCodes error -body {
    dict append dictv
} -result {wrong # args: should be "dict append dictVarName key ?value ...?"}
test dict-13.9 {dict append command: write failure} -setup {
    unset -nocomplain dictVar
test dict-13.9 {dict append command: write failure} {
    catch {unset dictVar}
} -body {
    set dictVar(block) {}
    dict append dictVar a x
    set result [list [catch {dict append dictVar a x} msg] $msg]
} -returnCodes error -cleanup {
    unset dictVar
} -result {can't set "dictVar": variable is array}
test dict-13.10 {compiled dict append: crash case} {
    catch {unset dictVar}
    set result
} {1 {can't set "dictVar": variable is array}}
test dict-13.10 {compiled dict command: crash case} {
    apply {{} {dict append dictVar a o k}}
} {a ok}
test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} {
    apply {{} {set d {a 1 b 2 c 3}; dict append d b 22}}
} {a 1 b 222 c 3}

test dict-14.1 {dict for command: syntax} -returnCodes error -body {
test dict-14.1 {dict for command: syntax} {
    list [catch {dict for} msg] $msg
} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
test dict-14.2 {dict for command: syntax} {
    dict for
} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
test dict-14.2 {dict for command: syntax} -returnCodes error -body {
    dict for x
} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
test dict-14.3 {dict for command: syntax} -returnCodes error -body {
    dict for x x
} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
test dict-14.4 {dict for command: syntax} -returnCodes error -body {
    dict for x x x x
} -result {wrong # args: should be "dict for {keyVarName valueVarName} dictionary script"}
test dict-14.5 {dict for command: syntax} -returnCodes error -body {
    dict for x x x
} -result {must have exactly two variable names}
test dict-14.6 {dict for command: syntax} -returnCodes error -body {
    dict for {x x x} x x
} -result {must have exactly two variable names}
test dict-14.7 {dict for command: syntax} -returnCodes error -body {
    dict for "\{x" x x
} -result {unmatched open brace in list}
test dict-14.8 {dict for command} -body {
    list [catch {dict for x} msg] $msg
} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
test dict-14.3 {dict for command: syntax} {
    list [catch {dict for x x} msg] $msg
} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
test dict-14.4 {dict for command: syntax} {
    list [catch {dict for x x x x} msg] $msg
} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
test dict-14.5 {dict for command: syntax} {
    list [catch {dict for x x x} msg] $msg
} {1 {must have exactly two variable names}}
test dict-14.6 {dict for command: syntax} {
    list [catch {dict for {x x x} x x} msg] $msg
} {1 {must have exactly two variable names}}
test dict-14.7 {dict for command: syntax} {
    list [catch {dict for "\{x" x x} msg] $msg
} {1 {unmatched open brace in list}}
test dict-14.8 {dict for command} {
    # This test confirms that [dict keys], [dict values] and [dict for]
    # all traverse a dictionary in the same order.
    set dictv {a A b B c C}
    set keys {}
    set values {}
    dict for {k v} $dictv {
	lappend keys $k
	lappend values $v
    }
    set result [expr {
	$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
    }]
    expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
} -cleanup {
    unset result keys values k v dictv
} -result YES
} YES
test dict-14.9 {dict for command} {
    dict for {k v} {} {
	error "unexpected execution of 'dict for' body"
    }
} {}
test dict-14.10 {dict for command: script results} -body {
test dict-14.10 {dict for command: script results} {
    set times 0
    dict for {k v} {a a b b} {
	incr times
	continue
	error "shouldn't get here"
    }
    return $times
} -cleanup {
    unset times k v
} -result 2
test dict-14.11 {dict for command: script results} -body {
    set times
} 2
test dict-14.11 {dict for command: script results} {
    set times 0
    dict for {k v} {a a b b} {
	incr times
	break
	error "shouldn't get here"
    }
    return $times
} -cleanup {
    unset times k v
} -result 1
test dict-14.12 {dict for command: script results} -body {
    set times
} 1
test dict-14.12 {dict for command: script results} {
    set times 0
    list [catch {
	dict for {k v} {a a b b} {
	    incr times
	    error test
	}
    } msg] $msg $times $::errorInfo
} -cleanup {
    unset times k v msg
} -result {1 test 1 {test
} {1 test 1 {test
    while executing
"error test"
    ("dict for" body line 3)
    invoked from within
"dict for {k v} {a a b b} {
	    incr times
	    error test
	}"}}
test dict-14.13 {dict for command: script results} {
    apply {{} {
    proc dicttest {} {
	rename dicttest {}
	dict for {k v} {a b} {
	    return ok,$k,$v
	    error "skipped return completely"
	}
	error "return didn't go far enough"
    }}
    }
    dicttest
} ok,a,b
test dict-14.14 {dict for command: handle representation loss} -body {
test dict-14.14 {dict for command: handle representation loss} {
    set dictVar {a b c d e f g h}
    set keys {}
    set values {}
    dict for {k v} $dictVar {
	if {[llength $dictVar]} {
	    lappend keys $k
	    lappend values $v
	}
    }
    list [lsort $keys] [lsort $values]
} -cleanup {
    unset dictVar keys values k v
} -result {{a c e g} {b d f h}}
test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup {
    unset -nocomplain accum
} {{a c e g} {b d f h}}
test dict-14.15 {dict for command: keys are unique and iterated over once only} {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    catch {unset accum}
    array set accum {}
} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict for {k v} $dictVar {
	append accum($k) $v,
    }
    set result [lsort [array names accum]]
    lappend result :
    foreach k $result {
	catch {lappend result $accum($k)}
    }
    catch {unset accum}
    return $result
    set result
} -cleanup {
    unset dictVar k v result accum
} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
} {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
test dict-14.16 {dict for command in compilation context} {
    apply {{} {
    proc dicttest {} {
	set res {x x x x x x}
	dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
	    lset res $v $k
	    continue
	}
	return $res
    }}
    }
    dicttest
} {a b c d e f}
test dict-14.17 {dict for command in compilation context} {
    # Bug 1379349
    apply {{} {
    proc dicttest {} {
	set d [dict create a 1]		;# Dict must be unshared!
	dict for {k v} $d {
	    dict set d $k 0		;# Any modification will do
	}
	return $d
    }}
    }
    dicttest
} {a 0}
test dict-14.18 {dict for command in compilation context} {
    # Bug 1382528
    apply {{} {
    proc dicttest {} {
	dict for {k v} {} {}		;# Note empty dict
	catch { error foo }		;# Note compiled [catch]
    }}
    }
    dicttest
} 1
test dict-14.19 {dict for and invalid dicts: bug 1531184} -body {
    di[list]ct for {k v} x {}
} -returnCodes 1 -result {missing value to go with key}
test dict-14.20 {dict for stack space compilation: bug 1903325} {
    apply {{x y args} {
    proc dicttest {x y args} {
	dict for {a b} $x {}
	concat "c=$y,$args"
    }
    }} {} 1 2 3
    dicttest {} 1 2 3
} {c=1,2 3}
test dict-14.21 {compiled dict for and break} {
    apply {{} {
	dict for {a b} {c d e f} {
	    lappend result $a,$b
	    break
	}
	return $result
    }}
} c,d
test dict-14.22 {dict for and exception range depths: Bug 3614382} {
    apply {{} {
	dict for {a b} {c d} {
	    dict for {e f} {g h} {
		return 5
	    }
	}
    }}
} 5
# There's probably a lot more tests to add here. Really ought to use a
# coverage tool for this job...

test dict-15.1 {dict set command} -body {
test dict-15.1 {dict set command} {
    set dictVar {}
    dict set dictVar a x
} -cleanup {
    unset dictVar
} -result {a x}
test dict-15.2 {dict set command} -body {
} {a x}
test dict-15.2 {dict set command} {
    set dictvar {a {}}
    dict set dictvar a b x
} -cleanup {
    unset dictvar
} -result {a {b x}}
test dict-15.3 {dict set command} -body {
} {a {b x}}
test dict-15.3 {dict set command} {
    set dictvar {a {b {}}}
    dict set dictvar a b c x
} -cleanup {
    unset dictvar
} -result {a {b {c x}}}
test dict-15.4 {dict set command} -body {
} {a {b {c x}}}
test dict-15.4 {dict set command} {
    set dictVar {a y}
    dict set dictVar a x
} -cleanup {
    unset dictVar
} -result {a x}
test dict-15.5 {dict set command} -body {
} {a x}
test dict-15.5 {dict set command} {
    set dictVar {a {b y}}
    dict set dictVar a b x
} -cleanup {
    unset dictVar
} -result {a {b x}}
test dict-15.6 {dict set command} -body {
} {a {b x}}
test dict-15.6 {dict set command} {
    set dictVar {a {b {c y}}}
    dict set dictVar a b c x
} -cleanup {
    unset dictVar
} -result {a {b {c x}}}
test dict-15.7 {dict set command: path creation} -body {
} {a {b {c x}}}
test dict-15.7 {dict set command: path creation} {
    set dictVar {}
    dict set dictVar a b x
} -cleanup {
    unset dictVar
} -result {a {b x}}
test dict-15.8 {dict set command: creates variables} -setup {
    unset -nocomplain dictVar
} {a {b x}}
test dict-15.8 {dict set command: creates variables} {
    catch {unset dictVar}
} -body {
    dict set dictVar a x
    return $dictVar
} -cleanup {
    unset dictVar
} -result {a x}
test dict-15.9 {dict set command: write failure} -setup {
    unset -nocomplain dictVar
    set dictVar
} {a x}
test dict-15.9 {dict set command: write failure} {
    catch {unset dictVar}
} -body {
    set dictVar(block) {}
    dict set dictVar a x
    set result [list [catch {dict set dictVar a x} msg] $msg]
} -returnCodes error -cleanup {
    unset dictVar
} -result {can't set "dictVar": variable is array}
test dict-15.10 {dict set command: syntax} -returnCodes error -body {
    dict set
} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
test dict-15.11 {dict set command: syntax} -returnCodes error -body {
    dict set a
} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
test dict-15.12 {dict set command: syntax} -returnCodes error -body {
    dict set a a
} -result {wrong # args: should be "dict set dictVarName key ?key ...? value"}
test dict-15.13 {dict set command} -returnCodes error -body {
    catch {unset dictVar}
    set result
} {1 {can't set "dictVar": variable is array}}
test dict-15.10 {dict set command: syntax} {
    list [catch {dict set} msg] $msg
} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
test dict-15.11 {dict set command: syntax} {
    list [catch {dict set a} msg] $msg
} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
test dict-15.12 {dict set command: syntax} {
    list [catch {dict set a a} msg] $msg
} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
test dict-15.13 {dict set command} {
    set dictVar a
    dict set dictVar b c
    list [catch {dict set dictVar b c} msg] $msg
} -cleanup {
    unset dictVar
} -result {missing value to go with key}
} {1 {missing value to go with key}}

test dict-16.1 {dict unset command} -body {
test dict-16.1 {dict unset command} {
    set dictVar {a b c d}
    dict unset dictVar a
} -cleanup {
    unset dictVar
} -result {c d}
test dict-16.2 {dict unset command} -body {
} {c d}
test dict-16.2 {dict unset command} {
    set dictVar {a b c d}
    dict unset dictVar c
} -cleanup {
    unset dictVar
} -result {a b}
test dict-16.3 {dict unset command} -body {
} {a b}
test dict-16.3 {dict unset command} {
    set dictVar {a b}
    dict unset dictVar c
} -cleanup {
    unset dictVar
} -result {a b}
test dict-16.4 {dict unset command} -body {
    set dictVar {a {b c d e}}
    dict unset dictVar a b
} -cleanup {
    unset dictVar
} -result {a {d e}}
test dict-16.5 {dict unset command} -returnCodes error -body {
} {a b}
test dict-16.4 {dict unset command} {
    set dictVar {a {b c d e}}
    dict unset dictVar a b
} {a {d e}}
test dict-16.5 {dict unset command} {
    set dictVar a
    dict unset dictVar a
    list [catch {dict unset dictVar a} msg] $msg
} -cleanup {
    unset dictVar
} -result {missing value to go with key}
test dict-16.6 {dict unset command} -returnCodes error -body {
} {1 {missing value to go with key}}
test dict-16.6 {dict unset command} {
    set dictVar {a b}
    dict unset dictVar c d
    list [catch {dict unset dictVar c d} msg] $msg
} -cleanup {
    unset dictVar
} -result {key "c" not known in dictionary}
test dict-16.7 {dict unset command} -setup {
    unset -nocomplain dictVar
} {1 {key "c" not known in dictionary}}
test dict-16.7 {dict unset command} {
    catch {unset dictVar}
} -body {
    list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]
} -cleanup {
    unset dictVar
} -result {0 {} 1}
test dict-16.8 {dict unset command} -returnCodes error -body {
    dict unset dictVar
} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"}
test dict-16.9 {dict unset command: write failure} -setup {
    unset -nocomplain dictVar
} {0 {} 1}
test dict-16.8 {dict unset command} {
    list [catch {dict unset dictVar} msg] $msg
} {1 {wrong # args: should be "dict unset varName key ?key ...?"}}
test dict-16.9 {dict unset command: write failure} {
    catch {unset dictVar}
} -body {
    set dictVar(block) {}
    dict unset dictVar a
    set result [list [catch {dict unset dictVar a} msg] $msg]
} -returnCodes error -cleanup {
    unset dictVar
} -result {can't set "dictVar": variable is array}
# Now test with an LVT present (i.e., the bytecoded version).
test dict-16.10 {dict unset command} -body {
    catch {unset dictVar}
    set result
} {1 {can't set "dictVar": variable is array}}

test dict-17.1 {dict filter command: key} {
    apply {{} {
	set dictVar {a b c d}
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
	dict unset dictVar a
    }}
} -result {c d}
test dict-16.11 {dict unset command} -body {
    apply {{} {
	set dictVar {a b c d}
    dict filter $dictVar key a2
	dict unset dictVar c
    }}
} -result {a b}
test dict-16.12 {dict unset command} -body {
} {a2 b}
test dict-17.2 {dict filter command: key} {
    apply {{} {
	set dictVar {a b}
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
	dict unset dictVar c
    }}
} -result {a b}
test dict-16.13 {dict unset command} -body {
    apply {{} {
	set dictVar {a {b c d e}}
	dict unset dictVar a b
    }}
} -result {a {d e}}
test dict-16.14 {dict unset command} -returnCodes error -body {
    apply {{} {
	set dictVar a
    dict size [dict filter $dictVar key *]
	dict unset dictVar a
    }}
} 6
} -result {missing value to go with key}
test dict-16.15 {dict unset command} -returnCodes error -body {
test dict-17.3 {dict filter command: key} {
    apply {{} {
	set dictVar {a b}
	dict unset dictVar c d
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    getOrder [dict filter $dictVar key ???] bar foo
    }}
} -result {key "c" not known in dictionary}
test dict-16.16 {dict unset command} -body {
    apply {{} {list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]}}
} -result {0 {} 1}
test dict-16.17 {dict unset command} -returnCodes error -body {
    apply {{} {dict unset dictVar}}
} -result {wrong # args: should be "dict unset dictVarName key ?key ...?"}
test dict-16.18 {dict unset command: write failure} -body {
} {bar foo foo bar 2}
test dict-17.4 {dict filter command: key} {
    list [catch {dict filter {} key} msg] $msg
} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
test dict-17.5 {dict filter command: key} {
    apply {{} {
	set dictVar(block) {}
	dict unset dictVar a
    list [catch {dict filter {} key a a} msg] $msg
    }}
} -returnCodes error -result {can't set "dictVar": variable is array}

test dict-17.1 {dict filter command: key} -body {
} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
test dict-17.6 {dict filter command: value} {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict filter $dictVar key a2
    dict filter $dictVar value c
} -cleanup {
    unset dictVar
} -result {a2 b}
test dict-17.2 {dict filter command: key} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict size [dict filter $dictVar key *]
} -cleanup {
    unset dictVar
} -result 6
test dict-17.3 {dict filter command: key} -body {
} {b1 c}
test dict-17.7 {dict filter command: value} {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict filter $dictVar key ???
} -cleanup {
    unset dictVar
} -result {foo bar bar foo}
test dict-17.4 {dict filter command: key - no patterns} {
    dict filter {a b c d} key
} {}
test dict-17.4.1 {dict filter command: key - many patterns} {
    dict filter {a1 a a2 b b1 c b2 d foo bar bar foo} key a? b?
} {a1 a a2 b b1 c b2 d}
test dict-17.5 {dict filter command: key - bad dict} -returnCodes error -body {
    dict filter {a b c} key
} -result {missing value to go with key}
test dict-17.6 {dict filter command: value} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict filter $dictVar value c
} -cleanup {
    unset dictVar
} -result {b1 c}
test dict-17.7 {dict filter command: value} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict size [dict filter $dictVar value *]
} -cleanup {
} 6
    unset dictVar
} -result 6
test dict-17.8 {dict filter command: value} -body {
test dict-17.8 {dict filter command: value} {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict filter $dictVar value ???
    getOrder [dict filter $dictVar value ???] bar foo
} -cleanup {
    unset dictVar
} -result {foo bar bar foo}
test dict-17.9 {dict filter command: value - no patterns} {
    dict filter {a b c d} value
} {bar foo foo bar 2}
test dict-17.9 {dict filter command: value} {
    list [catch {dict filter {} value} msg] $msg
} {}
test dict-17.9.1 {dict filter command: value - many patterns} {
    dict filter {a a1 b a2 c b1 foo bar bar foo d b2} value a? b?
} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
} {a a1 b a2 c b1 d b2}
test dict-17.10 {dict filter command: value - bad dict} -body {
    dict filter {a b c} value a
test dict-17.10 {dict filter command: value} {
    list [catch {dict filter {} value a a} msg] $msg
} -returnCodes error -result {missing value to go with key}
test dict-17.11 {dict filter command: script} -body {
} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
test dict-17.11 {dict filter command: script} {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    set n 0
    list [dict filter $dictVar script {k v} {
    list [getOrder [dict filter $dictVar script {k v} {
	incr n
	expr {[string length $k] == [string length $v]}
    }] $n
    }] bar foo] $n
} -cleanup {
    unset dictVar n k v
} -result {{foo bar bar foo} 6}
test dict-17.12 {dict filter command: script} -returnCodes error -body {
    dict filter {a b} script {k v} {
} {{bar foo foo bar 2} 6}
test dict-17.12 {dict filter command: script} {
    list [catch {dict filter {a b} script {k v} {concat $k $v}} msg] $msg
	concat $k $v
    }
} -cleanup {
    unset k v
} -result {expected boolean value but got "a b"}
test dict-17.13 {dict filter command: script} -body {
} {1 {expected boolean value but got "a b"}}
test dict-17.13 {dict filter command: script} {
    list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \
	    $::errorInfo
} -cleanup {
    unset k v msg
} -result {1 x {x
} {1 x {x
    while executing
"error x"
    ("dict filter" script line 1)
    invoked from within
"dict filter {a b} script {k v} {error x}"}}
test dict-17.14 {dict filter command: script} -setup {
test dict-17.14 {dict filter command: script} {
    set n 0
} -body {
    list [dict filter {a b c d} script {k v} {
	incr n
	break
	error boom!
    }] $n
} -cleanup {
    unset n k v
} -result {{} 1}
test dict-17.15 {dict filter command: script} -setup {
} {{} 1}
test dict-17.15 {dict filter command: script} {
    set n 0
} -body {
    list [dict filter {a b c d} script {k v} {
	incr n
	continue
	error boom!
    }] $n
} -cleanup {
    unset n k v
} -result {{} 2}
} {{} 2}
test dict-17.16 {dict filter command: script} {
    apply {{} {
    proc dicttest {} {
	rename dicttest {}
	dict filter {a b} script {k v} {
	    return ok,$k,$v
	    error "skipped return completely"
	}
	error "return didn't go far enough"
    }}
    }
    dicttest
} ok,a,b
test dict-17.17 {dict filter command: script} -body {
test dict-17.17 {dict filter command: script} {
    dict filter {a b} script {k k} {continue}
    return $k
} -cleanup {
    unset k
} -result b
test dict-17.18 {dict filter command: script} -returnCodes error -body {
    dict filter {a b} script {k k}
} -result {wrong # args: should be "dict filter dictionary script {keyVarName valueVarName} filterScript"}
test dict-17.19 {dict filter command: script} -returnCodes error -body {
    dict filter {a b} script k {continue}
} -result {must have exactly two variable names}
test dict-17.20 {dict filter command: script} -returnCodes error -body {
    dict filter {a b} script "\{k v" {continue}
} -result {unmatched open brace in list}
test dict-17.21 {dict filter command} -returnCodes error -body {
    dict filter {a b}
} -result {wrong # args: should be "dict filter dictionary filterType ?arg ...?"}
test dict-17.22 {dict filter command} -returnCodes error -body {
    dict filter {a b} JUNK
} -result {bad filterType "JUNK": must be key, script, or value}
test dict-17.23 {dict filter command} -returnCodes error -body {
    dict filter a key *
} -result {missing value to go with key}
    set k
} b
test dict-17.18 {dict filter command: script} {
    list [catch {dict filter {a b} script {k k}} msg] $msg
} {1 {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}}
test dict-17.19 {dict filter command: script} {
    list [catch {dict filter {a b} script k {continue}} msg] $msg
} {1 {must have exactly two variable names}}
test dict-17.20 {dict filter command: script} {
    list [catch {dict filter {a b} script "\{k v" {continue}} msg] $msg
} {1 {unmatched open brace in list}}
test dict-17.21 {dict filter command} {
    list [catch {dict filter {a b}} msg] $msg
} {1 {wrong # args: should be "dict filter dictionary filterType ..."}}
test dict-17.22 {dict filter command} {
    list [catch {dict filter {a b} JUNK} msg] $msg
} {1 {bad filterType "JUNK": must be key, script, or value}}
test dict-17.23 {dict filter command} {
    list [catch {dict filter a key *} msg] $msg
} {1 {missing value to go with key}}

test dict-18.1 {dict-list relationship} -body {
    # Test that any internal conversion between list and dict does not change
    # the object
    set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
    dict values $l
test dict-18.1 {dict-list relationship} {
    -body {
        # Test that any internal conversion between list and dict
        # does not change the object
        set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
        dict values $l
    return $l
} -cleanup {
    unset l
} -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
test dict-18.2 {dict-list relationship} -body {
    # Test that the dictionary is a valid list
    set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
    for {set t 0} {$t < 5} {incr t} {
	llength $d
	dict lappend d "abc def" "\}\{"
	dict append  d "a\{b" "\}"
	dict incr    d "c\}d" 1
    }
    llength $d
        set l
    }
    -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
}
test dict-18.2 {dict-list relationship} {
    -body {
        # Test that the dictionary is a valid list
        set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
        for {set t 0} {$t < 5} {incr t} {
            llength $d
            dict lappend d "abc def" "\}\{"
            dict append  d "a\{b" "\}"
            dict incr    d "c\}d" 1
        }
        llength $d
} -cleanup {
    unset d t
} -result 6
    }
    -result 6
test dict-18.3 {dict-list relationship} -body {
    set ld [list a b c d c e f g]
    list [string length $ld] [dict size $ld] [llength $ld]
} -cleanup {
    unset ld
} -result {15 3 8}
test dict-18.4 {dict-list relationship} -body {
    set ld [list a b c d c e f g]
    list [llength $ld] [dict size $ld] [llength $ld]
} -cleanup {
    unset ld
} -result {8 3 8}
}

# This is a test for a specific bug.
# It shows a bad ref counter when running with memdebug on.
test dict-19.1 {memory bug} {
    apply {{} {
test dict-19.1 {memory bug} -setup {
    proc xxx {} {
        set successors [dict create x {c d}]
        dict set successors x a b
        dict get $successors x
    }
    }}
} [dict create c d a b]
test dict-19.2 {dict: testing for leaks} -constraints memory -body {
} -body {
    xxx
} -cleanup {
    rename xxx {}
} -result [dict create c d a b]
test dict-19.2 {dict: testing for leaks} -setup {
    # This test is made to stress object reference management
    proc stress {} {
        # A shared invalid dictinary
        set apa {a {}b c d}
        set bepa $apa
        catch {dict replace $apa e f}
        catch {dict remove  $apa c d}
        catch {dict incr    apa  a 5}
        catch {dict lappend apa  a 5}
        catch {dict append  apa  a 5}
        catch {dict set     apa  a 5}
        catch {dict unset   apa  a}

        # A shared valid dictionary, invalid incr
        set apa {a b c d}
        set bepa $apa
        catch {dict incr bepa a 5}

        # An error during write to an unshared object, incr
        set apa {a 1 b 2}
        set bepa [lrange $apa 0 end]
        trace add variable bepa write {error hej}
        catch {dict incr bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to a shared object, incr
        set apa {a 1 b 2}
        set bepa $apa
        trace add variable bepa write {error hej}
        catch {dict incr bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # A shared valid dictionary, invalid lappend
        set apa [list a {{}b} c d]
        set bepa $apa
        catch {dict lappend bepa a 5}

        # An error during write to an unshared object, lappend
        set apa {a 1 b 2}
        set bepa [lrange $apa 0 end]
        trace add variable bepa write {error hej}
        catch {dict lappend bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to a shared object, lappend
        set apa {a 1 b 2}
        set bepa $apa
        trace add variable bepa write {error hej}
        catch {dict lappend bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to an unshared object, append
        set apa {a 1 b 2}
        set bepa [lrange $apa 0 end]
        trace add variable bepa write {error hej}
        catch {dict append bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to a shared object, append
        set apa {a 1 b 2}
        set bepa $apa
        trace add variable bepa write {error hej}
        catch {dict append bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to an unshared object, set
        set apa {a 1 b 2}
        set bepa [lrange $apa 0 end]
        trace add variable bepa write {error hej}
        catch {dict set bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to a shared object, set
        set apa {a 1 b 2}
        set bepa $apa
        trace add variable bepa write {error hej}
        catch {dict set bepa a 5}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to an unshared object, unset
        set apa {a 1 b 2}
        set bepa [lrange $apa 0 end]
        trace add variable bepa write {error hej}
        catch {dict unset bepa a}
	trace remove variable bepa write {error hej}
        unset bepa

        # An error during write to a shared object, unset
        set apa {a 1 b 2}
        set bepa $apa
        trace add variable bepa write {error hej}
        catch {dict unset bepa a}
	trace remove variable bepa write {error hej}
        unset bepa
    }
} -constraints memory -body {
    memtest {
	apply {{} {
	    # A shared invalid dictinary
	    set apa {a {}b c d}
	    set bepa $apa
	    catch {dict replace $apa e f}
	    catch {dict remove  $apa c d}
	    catch {dict incr    apa  a 5}
	    catch {dict lappend apa  a 5}
	    catch {dict append  apa  a 5}
	    catch {dict set     apa  a 5}
	    catch {dict unset   apa  a}

	stress
	    # A shared valid dictionary, invalid incr
	    set apa {a b c d}
	    set bepa $apa
	    catch {dict incr bepa a 5}

    }
	    # An error during write to an unshared object, incr
	    set apa {a 1 b 2}
	    set bepa [lrange $apa 0 end]
	    trace add variable bepa write {error hej}
	    catch {dict incr bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

} -cleanup {
	    # An error during write to a shared object, incr
	    set apa {a 1 b 2}
	    set bepa $apa
	    trace add variable bepa write {error hej}
	    catch {dict incr bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

    rename stress {}
	    # A shared valid dictionary, invalid lappend
	    set apa [list a {{}b} c d]
	    set bepa $apa
	    catch {dict lappend bepa a 5}

	    # An error during write to an unshared object, lappend
	    set apa {a 1 b 2}
	    set bepa [lrange $apa 0 end]
	    trace add variable bepa write {error hej}
	    catch {dict lappend bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

	    # An error during write to a shared object, lappend
	    set apa {a 1 b 2}
	    set bepa $apa
	    trace add variable bepa write {error hej}
	    catch {dict lappend bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

	    # An error during write to an unshared object, append
	    set apa {a 1 b 2}
	    set bepa [lrange $apa 0 end]
	    trace add variable bepa write {error hej}
	    catch {dict append bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

	    # An error during write to a shared object, append
	    set apa {a 1 b 2}
	    set bepa $apa
	    trace add variable bepa write {error hej}
	    catch {dict append bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

	    # An error during write to an unshared object, set
	    set apa {a 1 b 2}
	    set bepa [lrange $apa 0 end]
	    trace add variable bepa write {error hej}
	    catch {dict set bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

	    # An error during write to a shared object, set
	    set apa {a 1 b 2}
	    set bepa $apa
	    trace add variable bepa write {error hej}
	    catch {dict set bepa a 5}
	    trace remove variable bepa write {error hej}
	    unset bepa

	    # An error during write to an unshared object, unset
	    set apa {a 1 b 2}
	    set bepa [lrange $apa 0 end]
	    trace add variable bepa write {error hej}
	    catch {dict unset bepa a}
	    trace remove variable bepa write {error hej}
	    unset bepa

	    # An error during write to a shared object, unset
	    set apa {a 1 b 2}
	    set bepa $apa
	    trace add variable bepa write {error hej}
	    catch {dict unset bepa a}
	    trace remove variable bepa write {error hej}
	    unset bepa
	}}
    }
} -result 0
test dict-19.3 {testing for leaks - Bug 2874678} -constraints memory -body {
    set d aDictVar; # Force interpreted [dict incr]
    memtest {
	dict incr $d aKey 0
	unset $d
    }
} -cleanup {
    unset d
} -result 0

test dict-20.1 {dict merge command} {
    dict merge
} {}
test dict-20.2 {dict merge command} {
    dict merge {a b c d e f}
} {a b c d e f}
    getOrder [dict merge {a b c d e f}] a c e
} {a b c d e f 3}
test dict-20.3 {dict merge command} -body {
    dict merge {a b c d e}
} -result {missing value to go with key} -returnCodes error
} -result {missing value to go with key} -returnCodes 1
test dict-20.4 {dict merge command} {
    dict merge {a b c d} {e f g h}
} {a b c d e f g h}
    getOrder [dict merge {a b c d} {e f g h}] a c e g
} {a b c d e f g h 4}
test dict-20.5 {dict merge command} -body {
    dict merge {a b c d e} {e f g h}
} -result {missing value to go with key} -returnCodes error
} -result {missing value to go with key} -returnCodes 1
test dict-20.6 {dict merge command} -body {
    dict merge {a b c d} {e f g h i}
} -result {missing value to go with key} -returnCodes error
} -result {missing value to go with key} -returnCodes 1
test dict-20.7 {dict merge command} {
    dict merge {a b c d e f} {e x g h}
} {a b c d e x g h}
    getOrder [dict merge {a b c d e f} {e x g h}] a c e g
} {a b c d e x g h 4}
test dict-20.8 {dict merge command} {
    dict merge {a b c d} {a x c y}
} {a x c y}
    getOrder [dict merge {a b c d} {a x c y}] a c
} {a x c y 2}
test dict-20.9 {dict merge command} {
    dict merge {a b c d} {c y a x}
} {a x c y}
    getOrder [dict merge {a b c d} {a x c y}] a c
} {a x c y 2}
test dict-20.10 {dict merge command} {
    dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}
} {a - c d e f 1 - 3 4}
    getOrder [dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}] a c e 1 3
} {a - c d e f 1 - 3 4 5}
test dict-20.11 {dict merge command} {
    apply {{} {dict merge}}
} {}
test dict-20.12 {dict merge command} {
    apply {{} {dict merge {a b c d e f}}}
} {a b c d e f}
test dict-20.13 {dict merge command} -body {
    apply {{} {dict merge {a b c d e}}}
} -result {missing value to go with key} -returnCodes error
test dict-20.14 {dict merge command} {
    apply {{} {dict merge {a b c d} {e f g h}}}
} {a b c d e f g h}
test dict-20.15 {dict merge command} -body {
    apply {{} {dict merge {a b c d e} {e f g h}}}
} -result {missing value to go with key} -returnCodes error
test dict-20.16 {dict merge command} -body {
    apply {{} {dict merge {a b c d} {e f g h i}}}
} -result {missing value to go with key} -returnCodes error
test dict-20.17 {dict merge command} {
    apply {{} {dict merge {a b c d e f} {e x g h}}}
} {a b c d e x g h}
test dict-20.18 {dict merge command} {
    apply {{} {dict merge {a b c d} {a x c y}}}
} {a x c y}
test dict-20.19 {dict merge command} {
    apply {{} {dict merge {a b c d} {c y a x}}}
} {a x c y}
test dict-20.20 {dict merge command} {
    apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}}
} {a - c d e f 1 - 3 4}
test dict-20.21 {dict merge command: canonicality not forced} {
    dict merge { a b c d }
} { a b c d }
test dict-20.22 {dict merge command: canonicality not forced} {
    dict merge { a b c d } {}
} { a b c d }
test dict-20.23 {dict merge command: canonicality forced by update} {
    dict merge { a b c d } {a b}
} {a b c d}
test dict-20.24 {dict merge command: type check is mandatory} -body {
    dict merge { a b c d e }
} -returnCodes error -result {missing value to go with key}
test dict-20.25 {dict merge command: type check is mandatory} -body {
    dict merge { a b {}c d }
} -returnCodes error -result {dict element in braces followed by "c" instead of space}

test dict-21.1 {dict update command} -returnCodes 1 -body {
test dict-21.1 {dict update command} -body {
    dict update
} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
test dict-21.2 {dict update command} -returnCodes 1 -body {
} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
test dict-21.2 {dict update command} -body {
    dict update v
} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
test dict-21.3 {dict update command} -returnCodes 1 -body {
} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
test dict-21.3 {dict update command} -body {
    dict update v k
} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
test dict-21.4 {dict update command} -returnCodes 1 -body {
} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
test dict-21.4 {dict update command} -body {
    dict update v k v
} -result {wrong # args: should be "dict update dictVarName key varName ?key varName ...? script"}
test dict-21.5 {dict update command} -body {
} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
test dict-21.5 {dict update command} {
    set a {b c}
    set result {}
    set bb {}
    dict update a b bb {
	lappend result $a $bb
    }
    lappend result $a
} -cleanup {
    unset a result bb
} -result {{b c} c {b c}}
test dict-21.6 {dict update command} -body {
} {{b c} c {b c}}
test dict-21.6 {dict update command} {
    set a {b c}
    set result {}
    set bb {}
    dict update a b bb {
	lappend result $a $bb [set bb d]
    }
    lappend result $a
} -cleanup {
    unset a result bb
} -result {{b c} c d {b d}}
test dict-21.7 {dict update command} -body {
} {{b c} c d {b d}}
test dict-21.7 {dict update command} {
    set a {b c}
    set result {}
    set bb {}
    dict update a b bb {
	lappend result $a $bb [unset bb]
    }
    lappend result $a
} -cleanup {
    unset a result
} -result {{b c} c {} {}}
test dict-21.8 {dict update command} -body {
} {{b c} c {} {}}
test dict-21.8 {dict update command} {
    set a {b c d e}
    dict update a b v1 d v2 {
	lassign "$v1 $v2" v2 v1
    }
    return $a
    getOrder $a b d
} -cleanup {
    unset a v1 v2
} -result {b e d c}
test dict-21.9 {dict update command} -body {
} {b e d c 2}
test dict-21.9 {dict update command} {
    set a {b c d e}
    dict update a b v1 d v2 {unset a}
    info exist a
} -cleanup {
} 0
    unset v1 v2
} -result 0
test dict-21.10 {dict update command} -body {
test dict-21.10 {dict update command} {
    set a {b {c d}}
    dict update a b v1 {
	dict update v1 c v2 {
	    set v2 foo
	}
    }
    return $a
} -cleanup {
    unset a v1 v2
} -result {b {c foo}}
test dict-21.11 {dict update command} -body {
    set a
} {b {c foo}}
test dict-21.11 {dict update command} {
    set a {b c d e}
    dict update a b v1 d v2 {
	dict set a f g
    }
    return $a
    getOrder $a b d f
} -cleanup {
    unset a v1 v2
} -result {b c d e f g}
test dict-21.12 {dict update command} -body {
} {b c d e f g 3}
test dict-21.12 {dict update command} {
    set a {b c d e}
    dict update a b v1 d v2 f v3 {
	set v3 g
    }
    return $a
    getOrder $a b d f
} -cleanup {
    unset a v1 v2 v3
} -result {b c d e f g}
} {b c d e f g 3}
test dict-21.13 {dict update command: compilation} {
    apply {d {
    proc dicttest {d} {
	while 1 {
	    dict update d a alpha b beta {
		set beta $alpha
		unset alpha
		break
	    }
	}
	return $d
    }
    }} {a 1 c 2}
} {c 2 b 1}
    getOrder [dicttest {a 1 c 2}] b c
} {b 1 c 2 2}
test dict-21.14 {dict update command: compilation} {
    apply {x {
    proc dicttest x {
	set indices {2 3}
	trace add variable aa write "string length \$indices ;#"
	dict update x k aa l bb {}
    }
    }} {k 1 l 2}
    dicttest {k 1 l 2}
} {}
test dict-21.15 {dict update command: compilation} {
    apply {x {
    proc dicttest x {
	set indices {2 3}
	trace add variable aa read "string length \$indices ;#"
	dict update x k aa l bb {}
    }
    }} {k 1 l 2}
    dicttest {k 1 l 2}
} {}
test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} -body {
test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} {
    set foo {a {b {c {d {e 1}}}}}
    dict update foo a t {
	dict update t b t {
	    dict update t c t {
		dict update t d t {
		    dict incr t e
		}
	    }
	}
    }
    string range [append foo OK] end-1 end
} -cleanup {
} OK
    unset foo t
} -result OK
test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} {
    apply {{} {
    proc dicttest {} {
	set foo {a {b {c {d {e 1}}}}}
	dict update foo a t {
	    dict update t b t {
		dict update t c t {
		    dict update t d t {
			dict incr t e
		    }
		}
	    }
	}
    }
    dicttest
	string range [append foo OK] end-1 end
    string range [append foo OK] end-1 end
    }}
} OK

test dict-22.1 {dict with command} -body {
    dict with
} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"}
test dict-22.2 {dict with command} -body {
    dict with v
} -returnCodes 1 -result {wrong # args: should be "dict with dictVarName ?key ...? script"}
} -returnCodes 1 -result {wrong # args: should be "dict with dictVar ?key ...? script"}
test dict-22.3 {dict with command} -body {
    unset -nocomplain v
    dict with v {error "in body"}
} -returnCodes 1 -result {can't read "v": no such variable}
test dict-22.4 {dict with command} -body {
test dict-22.4 {dict with command} {
    set a {b c d e}
    unset -nocomplain b d
    set result [list [info exist b] [info exist d]]
    dict with a {
	lappend result [info exist b] [info exist d] $b $d
    }
    return $result
    set result
} -cleanup {
    unset a b d result
} -result {0 0 1 1 c e}
test dict-22.5 {dict with command} -body {
} {0 0 1 1 c e}
test dict-22.5 {dict with command} {
    set a {b c d e}
    dict with a {
	lassign "$b $d" d b
    }
    return $a
} -cleanup {
    unset a b d
} -result {b e d c}
test dict-22.6 {dict with command} -body {
    getOrder $a b d
} {b e d c 2}
test dict-22.6 {dict with command} {
    set a {b c d e}
    dict with a {
	unset b
	# This *won't* go into the dict...
	set f g
    }
    return $a
} -cleanup {
    unset a d f
} -result {d e}
test dict-22.7 {dict with command} -body {
    set a
} {d e}
test dict-22.7 {dict with command} {
    set a {b c d e}
    dict with a {
	dict unset a b
    }
    return $a
    getOrder $a b d
} -cleanup {
    unset a
} -result {d e b c}
test dict-22.8 {dict with command} -body {
} {b c d e 2}
test dict-22.8 {dict with command} {
    set a [dict create b c]
    dict with a {
	set b $a
    }
    return $a
} -cleanup {
    unset a b
} -result {b {b c}}
test dict-22.9 {dict with command} -body {
    set a
} {b {b c}}
test dict-22.9 {dict with command} {
    set a {b {c d}}
    dict with a b {
	set c $c$c
    }
    return $a
} -cleanup {
    unset a c
} -result {b {c dd}}
test dict-22.10 {dict with command: result handling tricky case} -body {
    set a
} {b {c dd}}
test dict-22.10 {dict with command: result handling tricky case} {
    set a {b {c d}}
    foreach i {0 1} {
	if {$i} break
	dict with a b {
	    set a {}
	    # We're checking to see if we lose this break
	    break
	}
    }
    list $i $a
} -cleanup {
    unset a i c
} -result {0 {}}
test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} -body {
} {0 {}}
test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} {
    set foo {t {t {t {inner 1}}}}
    dict with foo {
	dict with t {
	    dict with t {
		dict with t {
		    incr inner
		}
	    }
	}
    }
    string range [append foo OK] end-1 end
} -cleanup {
    unset foo t inner
} -result OK
test dict-22.12 {dict with: compiled} {
    apply {{} {
	set d {a 1 b 2}
	list [dict with d {
	    set a $b
	    unset b
	    dict set d c 3
	    list ok
	}] $d
    }}
} {ok {a 2 c 3}}
test dict-22.13 {dict with: compiled} {
    apply {i {
	set d($i) {a 1 b 2}
	list [dict with d($i) {
	    set a $b
	    unset b
	    dict set d($i) c 3
	    list ok
	}] [array get d]
    }} e
} OK
} {ok {e {a 2 c 3}}}
test dict-22.14 {dict with: compiled} {
    apply {{} {
	set d {a 1 b 2}
	foreach x {1 2 3} {
	    dict with d {
		incr a $b
		if {$x == 2} break
	    }

	    unset a b
	}
	list $a $b $x $d
    }}
} {5 2 2 {a 5 b 2}}
test dict-22.15 {dict with: compiled} {
    apply {i {
	set d($i) {a 1 b 2}
	foreach x {1 2 3} {
	    dict with d($i) {
		incr a $b
		if {$x == 2} break
	    }
	    unset a b
	}
	list $a $b $x [array get d]
    }} e
} {5 2 2 {e {a 5 b 2}}}
test dict-22.16 {dict with: compiled} {
    apply {{} {
	set d {p {q {a 1 b 2}}}
	dict with d p q {
	    set a $b.$a
	}
	return $d
    }}
} {p {q {a 2.1 b 2}}}
test dict-22.17 {dict with: compiled} {
    apply {i {
	set d($i) {p {q {a 1 b 2}}}
	dict with d($i) p q {
	    set a $b.$a
	}
	array get d
    }} e
} {e {p {q {a 2.1 b 2}}}}
test dict-22.18 {dict with: compiled} {
    set ::d {a 1 b 2}
    apply {{} {
	dict with ::d {
	    set a $b.$a
	}
	return $::d
    }}
} {a 2.1 b 2}
test dict-22.19 {dict with: compiled} {
    set ::d {p {q {r {a 1 b 2}}}}
    apply {{} {
	dict with ::d p q r {
	    set a $b.$a
	}
	return $::d
    }}
} {p {q {r {a 2.1 b 2}}}}
test dict-22.20 {dict with: compiled} {
    apply {d {
	dict with d {
	}
	return $a,$b
    }} {a 1 b 2}
} 1,2
test dict-22.21 {dict with: compiled} {
    apply {d {
	dict with d p q {
	}
	return $a,$b
    }} {p {q {a 1 b 2}}}
} 1,2
test dict-22.22 {dict with: compiled} {
    set ::d {a 1 b 2}
    apply {{} {
	dict with ::d {
	}
	return $a,$b
    }}
} 1,2
test dict-22.23 {dict with: compiled} {
    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 {{} {apply {n {
    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]}}
    }} [linenumber]
} 5
test dict-23.2 {dict compilation crash: Bug 3487626} {
    # 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 {{} {apply {n {
    apply {n {
	set e {}
	set k {}
	dict for {a {
b
}} {c {d {e {f g}}}} {
	    ::tcl::dict::for {h {
i
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
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
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
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
1237
1238
1239
1240
1241
1242
1243

1244






































































































































































































































1245
1246
1247
1248
1249
1250
1251







-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







j
} f k {
			return [expr {$n - [linenumber]}]
		    }
		}
	    }
	}
    }} [linenumber]}}
    }} [linenumber]
} 5
rename linenumber {}

test dict-24.1 {dict map command: syntax} -returnCodes error -body {
    dict map
} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
test dict-24.2 {dict map command: syntax} -returnCodes error -body {
    dict map x
} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
test dict-24.3 {dict map command: syntax} -returnCodes error -body {
    dict map x x
} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
test dict-24.4 {dict map command: syntax} -returnCodes error -body {
    dict map x x x x
} -result {wrong # args: should be "dict map {keyVarName valueVarName} dictionary script"}
test dict-24.5 {dict map command: syntax} -returnCodes error -body {
    dict map x x x
} -result {must have exactly two variable names}
test dict-24.6 {dict map command: syntax} -returnCodes error -body {
    dict map {x x x} x x
} -result {must have exactly two variable names}
test dict-24.7 {dict map command: syntax} -returnCodes error -body {
    dict map "\{x" x x
} -result {unmatched open brace in list}
test dict-24.8 {dict map command} -setup {
    set values {}
    set keys {}
} -body {
    # This test confirms that [dict keys], [dict values] and [dict map]
    # all traverse a dictionary in the same order.
    set dictv {a A b B c C}
    dict map {k v} $dictv {
	lappend keys $k
	lappend values $v
    }
    set result [expr {
	$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
    }]
    expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
} -cleanup {
    unset result keys values k v dictv
} -result YES
test dict-24.9 {dict map command} {
    dict map {k v} {} {
	error "unexpected execution of 'dict map' body"
    }
} {}
test dict-24.10 {dict map command: script results} -body {
    set times 0
    dict map {k v} {a a b b} {
	incr times
	continue
	error "shouldn't get here"
    }
    return $times
} -cleanup {
    unset times k v
} -result 2
test dict-24.11 {dict map command: script results} -body {
    set times 0
    dict map {k v} {a a b b} {
	incr times
	break
	error "shouldn't get here"
    }
    return $times
} -cleanup {
    unset times k v
} -result 1
test dict-24.12 {dict map command: script results} -body {
    set times 0
    list [catch {
	dict map {k v} {a a b b} {
	    incr times
	    error test
	}
    } msg] $msg $times $::errorInfo
} -cleanup {
    unset times k v msg
} -result {1 test 1 {test
    while executing
"error test"
    ("dict map" body line 3)
    invoked from within
"dict map {k v} {a a b b} {
	    incr times
	    error test
	}"}}
test dict-24.13 {dict map command: script results} {
    apply {{} {
	dict map {k v} {a b} {
	    return ok,$k,$v
	    error "skipped return completely"
	}
	error "return didn't go far enough"
    }}
} ok,a,b
test dict-24.14 {dict map command: handle representation loss} -setup {
    set keys {}
    set values {}
} -body {
    set dictVar {a b c d e f g h}
    list [dict size [dict map {k v} $dictVar {
	if {[llength $dictVar]} {
	    lappend keys $k
	    lappend values $v
	    return -level 0 $k
	}
    }]] [lsort $keys] [lsort $values]
} -cleanup {
    unset dictVar keys values k v
} -result {4 {a c e g} {b d f h}}
test dict-24.14a {dict map command: handle representation loss} -body {
    apply {{} {
	set dictVar {a b c d e f g h}
	list [dict size [dict map {k v} $dictVar {
	    if {[llength $dictVar]} {
		lappend keys $k
		lappend values $v
		return -level 0 $k
	    }
	}]] [lsort $keys] [lsort $values]
    }}
} -result {4 {a c e g} {b d f h}}
test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
    unset -nocomplain accum
    array set accum {}
} -body {
    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
    dict map {k v} $dictVar {
	append accum($k) $v,
    }
    set result [lsort [array names accum]]
    lappend result :
    foreach k $result {
	catch {lappend result $accum($k)}
    }
    return $result
} -cleanup {
    unset dictVar k v result accum
} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
test dict-24.16 {dict map command in compilation context} {
    apply {{} {
	set res {x x x x x x}
	dict map {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
	    lset res $v $k
	    continue
	}
	return $res
    }}
} {a b c d e f}
test dict-24.17 {dict map command in compilation context} {
    # Bug 1379349 (dict for)
    apply {{} {
	set d [dict create a 1]		;# Dict must be unshared!
	dict map {k v} $d {
	    dict set d $k 0		;# Any modification will do
	}
	return $d
    }}
} {a 0}
test dict-24.17a {dict map command in compilation context} {
    # Bug 1379349 (dict for)
    apply {{} {
	set d [dict create a 1]		;# Dict must be unshared!
	dict map {k v} $d {
	    dict set d $k 0		;# Any modification will do
	}
    }}
} {a {a 0}}
test dict-24.18 {dict map command in compilation context} {
    # Bug 1382528 (dict for)
    apply {{} {
	dict map {k v} {} {}		;# Note empty dict
	catch { error foo }		;# Note compiled [catch]
    }}
} 1
test dict-24.19 {dict map and invalid dicts: 'dict for' bug 1531184} -body {
    di[list]ct map {k v} x {}
} -returnCodes 1 -result {missing value to go with key}
test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} {
    apply {{x y args} {
	dict map {a b} $x {}
	concat "c=$y,$args"
    }} {} 1 2 3
} {c=1,2 3}
proc linenumber {} {
    dict get [info frame -1] line
}
test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
    apply {{} {apply {n {
	set e {}
	set k {}
	dict map {a b} {c {d {e {f g}}}} {
	    ::tcl::dict::map {h i} $b {
		dict update i e j {
		    ::tcl::dict::update j f k {
			return [expr {$n - [linenumber]}]
		    }
		}
	    }
	}
    }} [linenumber]}}
} 5
test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} {
    apply {{} {apply {n {
	set e {}
	set k {}
	dict map {a {
b
}} {c {d {e {f g}}}} {
	    ::tcl::dict::map {h {
i
}} ${
b
} {
		dict update {
i
} e {
j
} {
		    ::tcl::dict::update {
j
} f k {
			return [expr {$n - [linenumber]}]
		    }
		}
	    }
	}
    }} [linenumber]}}
} 5
test dict-23.3 {CompileWord OBOE} {
    # segfault when buggy
    apply {{} {tcl::dict::lappend foo bar \
	[format baz]}}
} {bar baz}
test dict-23.4 {CompileWord OBOE} {
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
1273
1274
1275
1276
1277
1278
1279




































1280
1281




1282













































































































































1283
1284
1285
1286
1287
1288
1289







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







} 2
test dict-23.8 {CompileWord OBOE} {
    apply {n {
	dict update foo {*}{
	} [return [incr n -[linenumber]]] x {}
    }} [linenumber]
} 1
test dict-23.9 {CompileWord OBOE} {
    apply {n {
	dict exists {} {*}{
	} [return [incr n -[linenumber]]]
    }} [linenumber]
} 1
test dict-23.10 {CompileWord OBOE} {
    apply {n {
	dict with foo {*}{
	} [return [incr n -[linenumber]]] {}
    }} [linenumber]
} 1
test dict-23.11 {CompileWord OBOE} {
    apply {n {
	dict with ::foo {*}{
	} [return [incr n -[linenumber]]] {}
    }} [linenumber]
} 1
test dict-23.12 {CompileWord OBOE} {
    apply {n {
	dict with {*}{
	} [return [incr n -[linenumber]]] {}
    }} [linenumber]
} 1
test dict-23.13 {CompileWord OBOE} {
    apply {n {
	dict with {*}{
	} [return [incr n -[linenumber]]] {bar}
    }} [linenumber]
} 1
test dict-23.14 {CompileWord OBOE} {
    apply {n {
	dict with foo {*}{
	} [return [incr n -[linenumber]]] {bar}
    }} [linenumber]
} 1

rename linenumber {}
test dict-24.22 {dict map results (non-compiled)} {
    dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
	return -level 0 "$k,$v"
    }

} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
test dict-24.23 {dict map results (compiled)} {
    apply {{} {
	dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
	    return -level 0 "$k,$v"
	}
    }}
} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
test dict-24.23a {dict map results (compiled)} {
    apply {{list} {
	dict map {k v} [dict map {k v} $list { list $v $k }] {
	    return -level 0 "$k,$v"
	}
    }} {a 1 b 2 c 3 d 4}
} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
test dict-24.24 {dict map with huge dict (non-compiled)} {
    tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat 100000 x] x] {
	expr { $k * $v }
    }]
} 166666666600000
test dict-24.25 {dict map with huge dict (compiled)} {
    apply {{n} {
	tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat $n y] y] {
	    expr { $k * $v }
	}]
    }} 100000
} 166666666600000

test dict-25.1 {compiled dict update with low-refcount values [Bug d553228d9f]} {
    # Test crashes on failure
    apply {{} {
	lassign {} item
	dict update item item item two two {}
    }}
} {}

set dict dict;			# Used to force interpretation, not compilation
test dict-26.1 {dict getdef command} -body {
    dict getdef {a b} a c
} -result b
test dict-26.2 {dict getdef command} -body {
    dict getdef {a b} b c
} -result c
test dict-26.3 {dict getdef command} -body {
    dict getdef {a {b c}} a b d
} -result c
test dict-26.4 {dict getdef command} -body {
    dict getdef {a {b c}} a c d
} -result d
test dict-26.5 {dict getdef command} -body {
    dict getdef {a {b c}} b c d
} -result d
test dict-26.6 {dict getdef command} -returnCodes error -body {
    dict getdef {a {b c d}} a b d
} -result {missing value to go with key}
test dict-26.7 {dict getdef command} -returnCodes error -body {
    dict getdef
} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
test dict-26.8 {dict getdef command} -returnCodes error -body {
    dict getdef {}
} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
test dict-26.9 {dict getdef command} -returnCodes error -body {
    dict getdef {} {}
} -result {wrong # args: should be "dict getdef dictionary ?key ...? key default"}
test dict-26.10 {dict getdef command} -returnCodes error -body {
    dict getdef {a b c} d e
} -result {missing value to go with key}
test dict-26.11 {dict getdef command} -body {
    $dict getdef {a b} a c
} -result b
test dict-26.12 {dict getdef command} -body {
    $dict getdef {a b} b c
} -result c
test dict-26.13 {dict getdef command} -body {
    $dict getdef {a {b c}} a b d
} -result c
test dict-26.14 {dict getdef command} -body {
    $dict getdef {a {b c}} a c d
} -result d
test dict-26.15 {dict getdef command} -body {
    $dict getdef {a {b c}} b c d
} -result d
test dict-26.16 {dict getdef command} -returnCodes error -body {
    $dict getdef {a {b c d}} a b d
} -result {missing value to go with key}
test dict-26.17 {dict getdef command} -returnCodes error -body {
    $dict getdef {a b c} d e
} -result {missing value to go with key}

test dict-27.1 {dict getwithdefault command} -body {
    dict getwithdefault {a b} a c
} -result b
test dict-27.2 {dict getwithdefault command} -body {
    dict getwithdefault {a b} b c
} -result c
test dict-27.3 {dict getwithdefault command} -body {
    dict getwithdefault {a {b c}} a b d
} -result c
test dict-27.4 {dict getwithdefault command} -body {
    dict getwithdefault {a {b c}} a c d
} -result d
test dict-27.5 {dict getwithdefault command} -body {
    dict getwithdefault {a {b c}} b c d
} -result d
test dict-27.6 {dict getwithdefault command} -returnCodes error -body {
    dict getwithdefault {a {b c d}} a b d
} -result {missing value to go with key}
test dict-27.7 {dict getwithdefault command} -returnCodes error -body {
    dict getwithdefault
} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
test dict-27.8 {dict getwithdefault command} -returnCodes error -body {
    dict getwithdefault {}
} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
test dict-27.9 {dict getwithdefault command} -returnCodes error -body {
    dict getwithdefault {} {}
} -result {wrong # args: should be "dict getwithdefault dictionary ?key ...? key default"}
test dict-27.10 {dict getdef command} -returnCodes error -body {
    dict getwithdefault {a b c} d e
} -result {missing value to go with key}
test dict-27.11 {dict getwithdefault command} -body {
    $dict getwithdefault {a b} a c
} -result b
test dict-27.12 {dict getwithdefault command} -body {
    $dict getwithdefault {a b} b c
} -result c
test dict-27.13 {dict getwithdefault command} -body {
    $dict getwithdefault {a {b c}} a b d
} -result c
test dict-27.14 {dict getwithdefault command} -body {
    $dict getwithdefault {a {b c}} a c d
} -result d
test dict-27.15 {dict getwithdefault command} -body {
    $dict getwithdefault {a {b c}} b c d
} -result d
test dict-27.16 {dict getwithdefault command} -returnCodes error -body {
    $dict getwithdefault {a {b c d}} a b d
} -result {missing value to go with key}
test dict-27.17 {dict getdef command} -returnCodes error -body {
    $dict getwithdefault {a b c} d e
} -result {missing value to go with key}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/dstring.test.

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
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
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
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







-
-
-
+
+
+





-
-
+
+

-
-
+
+



-
-
-

-
-
-
+
-
-
+

-


-
-
-
-
+
+

-




-
-
-
-
+
+

-




-
-
-
+

















-
+

-



-
-
-
-
+
+

-




-
-
-
-
+
+

-




-
-
-
-
+
+

-





-
-
-
-
+
+

-



-
-
-
-
+
+

-



-
-
-
-
+
+

-



-
-
-
-
+
+

-



-
-
-
-
+
+

-


-
-
-
-
+
+

-



-
+
+

-
-
-
-



-
-
-
-
+
+

-



-
-
-
-
+
+
-
-


+



-
-
-
-
+
+

-



-
-
-
-
+
+
-
-


-
-
-
+
+
+
-
-
-
+
+

-
+

-






-
-
-
-
+
+

-








-
-
-
-
+
+

-











-
-
-
-
+
+

-







-
-
-
-
+
+

-






-
-
-
-
+
+

-





-
-
-
-
+
+

-






-
-
-
-
+
+

-






-
-
-
-
+
+

-






-
-
-
-
+
+
-
-


+






-
-
-
-
+
+

-






-
-
-
-
+
+
-
-


+






-
-
-
+

-
+

-



-
-
-
-
+
+

-



-
-
-
+

-
+

-


-
-
-
-
+
+

-
+
-






-
-
-
+

















-
+

-

-
-
-
-
+
+

-




-
-
-
-
+
+




-
-
-
+







-
+




-
-
-
-
+
+




-
-
-
-
+
+






-
-
-
-
-
# Commands covered:  none
#
# This file contains a collection of tests for Tcl's dynamic string library
# procedures. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for Tcl's dynamic string
# library procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testdstring [llength [info commands testdstring]]
if {[testConstraint testdstring]} {
    testdstring free
}


test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {
test dstring-1.1 {appending and retrieving} testdstring {
    testdstring free
} -body {
    testdstring append "abc" -1
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {abc 3}
test dstring-1.2 {appending and retrieving} -constraints testdstring -setup {
} {abc 3}
test dstring-1.2 {appending and retrieving} testdstring {
    testdstring free
} -body {
    testdstring append "abc" -1
    testdstring append " xyzzy" 3
    testdstring append " 12345" -1
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {{abc xy 12345} 12}
test dstring-1.3 {appending and retrieving} -constraints testdstring -setup {
} {{abc xy 12345} 12}
test dstring-1.3 {appending and retrieving} testdstring {
    testdstring free
} -body {
    foreach l {a b c d e f g h i j k l m n o p} {
	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
    }
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {{aaaaaaaaaaaaaaaaaaaaa
} {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
eeeeeeeeeeeeeeeeeeeee
fffffffffffffffffffff
ggggggggggggggggggggg
hhhhhhhhhhhhhhhhhhhhh
iiiiiiiiiiiiiiiiiiiii
jjjjjjjjjjjjjjjjjjjjj
kkkkkkkkkkkkkkkkkkkkk
lllllllllllllllllllll
mmmmmmmmmmmmmmmmmmmmm
nnnnnnnnnnnnnnnnnnnnn
ooooooooooooooooooooo
ppppppppppppppppppppp
} 352}

test dstring-2.1 {appending list elements} -constraints testdstring -setup {
test dstring-2.1 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring element "abc"
    testdstring element "d e f"
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {{abc {d e f}} 11}
test dstring-2.2 {appending list elements} -constraints testdstring -setup {
} {{abc {d e f}} 11}
test dstring-2.2 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring element "x"
    testdstring element "\{"
    testdstring element "ab\}"
    testdstring get
} -cleanup {
    testdstring free
} -result {x \{ ab\}}
test dstring-2.3 {appending list elements} -constraints testdstring -setup {
} {x \{ ab\}}
test dstring-2.3 {appending list elements} testdstring {
    testdstring free
} -body {
    foreach l {a b c d e f g h i j k l m n o p} {
	testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l
    }
    testdstring get
} -cleanup {
    testdstring free
} -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
test dstring-2.4 {appending list elements} -constraints testdstring -setup {
} {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
test dstring-2.4 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append "a\{" -1
    testdstring element abc
    testdstring append "	\{" -1
    testdstring element xyzzy
    testdstring get
} -cleanup {
    testdstring free
} -result "a{ abc	{xyzzy"
test dstring-2.5 {appending list elements} -constraints testdstring -setup {
} "a{ abc	{xyzzy"
test dstring-2.5 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append " \{" -1
    testdstring element abc
    testdstring get
} -cleanup {
    testdstring free
} -result " {abc"
test dstring-2.6 {appending list elements} -constraints testdstring -setup {
} " {abc"
test dstring-2.6 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append " " -1
    testdstring element abc
    testdstring get
} -cleanup {
    testdstring free
} -result { abc}
test dstring-2.7 {appending list elements} -constraints testdstring -setup {
} { abc}
test dstring-2.7 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append "\\ " -1
    testdstring element abc
    testdstring get
} -cleanup {
    testdstring free
} -result "\\  abc"
test dstring-2.8 {appending list elements} -constraints testdstring -setup {
} "\\  abc"
test dstring-2.8 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append "x " -1
    testdstring element abc
    testdstring get
} -cleanup {
    testdstring free
} -result {x abc}
test dstring-2.9 {appending list elements} -constraints testdstring -setup {
} {x abc}
test dstring-2.9 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring element #
    testdstring get
} -cleanup {
    testdstring free
} -result {{#}}
test dstring-2.10 {appending list elements} -constraints testdstring -setup {
} {{#}}
test dstring-2.10 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append " " -1
    testdstring element #
    testdstring get
} -cleanup {
} { {#}}
test dstring-2.11 {appending list elements} testdstring {
    testdstring free
} -result { {#}}
test dstring-2.11 {appending list elements} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring append \t -1
    testdstring element #
    testdstring get
} -cleanup {
    testdstring free
} -result \t{#}
test dstring-2.12 {appending list elements} -constraints testdstring -setup {
} \t{#}
test dstring-2.12 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append x -1
    testdstring element #
    testdstring get
} -cleanup {
    testdstring free
} -result {x #}
test dstring-2.13 {appending list elements} -constraints testdstring -setup {
} {x #}
test dstring-2.13 {appending list elements} testdstring {
    testdstring free
} -body {
    # This test checks the sophistication in Tcl_DStringAppendElement's
    # decision about whether #-quoting can be disabled.
    testdstring free
    testdstring append "x " -1
    testdstring element #
    testdstring get
} -cleanup {
    testdstring free
} -result {x #}
test dstring-2.14 {appending list elements} -constraints testdstring -setup {
} {x #}
test dstring-2.14 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append "  " -1
    testdstring element #
    testdstring get
} -cleanup {
    testdstring free
} -result {  {#}}
test dstring-2.15 {appending list elements} -constraints testdstring -setup {
} {  {#}}
test dstring-2.15 {appending list elements} testdstring {
    testdstring free
} -body {
    # This test checks the sophistication in Tcl_DStringAppendElement's
    # decision about whether #-quoting can be disabled.
    testdstring append "x  " -1
    testdstring element #
    testdstring get
    testdstring free
    testdstring append "x  " -1
    testdstring element #
} -cleanup {
    testdstring free
} -result {x  #}
    testdstring get
} {x  #}

test dstring-3.1 {nested sublists} -constraints testdstring -setup {
test dstring-3.1 {nested sublists} testdstring {
    testdstring free
} -body {
    testdstring start
    testdstring element foo
    testdstring element bar
    testdstring end
    testdstring element another
    testdstring get
} -cleanup {
    testdstring free
} -result {{foo bar} another}
test dstring-3.2 {nested sublists} -constraints testdstring -setup {
} {{foo bar} another}
test dstring-3.2 {nested sublists} testdstring {
    testdstring free
} -body {
    testdstring start
    testdstring start
    testdstring element abc
    testdstring element def
    testdstring end
    testdstring end
    testdstring element ghi
    testdstring get
} -cleanup {
    testdstring free
} -result {{{abc def}} ghi}
test dstring-3.3 {nested sublists} -constraints testdstring -setup {
} {{{abc def}} ghi}
test dstring-3.3 {nested sublists} testdstring {
    testdstring free
} -body {
    testdstring start
    testdstring start
    testdstring start
    testdstring element foo
    testdstring element foo2
    testdstring end
    testdstring end
    testdstring element foo3
    testdstring end
    testdstring element foo4
    testdstring get
} -cleanup {
    testdstring free
} -result {{{{foo foo2}} foo3} foo4}
test dstring-3.4 {nested sublists} -constraints testdstring -setup {
} {{{{foo foo2}} foo3} foo4}
test dstring-3.4 {nested sublists} testdstring {
    testdstring free
} -body {
    testdstring element before
    testdstring start
    testdstring element during
    testdstring element more
    testdstring end
    testdstring element last
    testdstring get
} -cleanup {
    testdstring free
} -result {before {during more} last}
test dstring-3.5 {nested sublists} -constraints testdstring -setup {
} {before {during more} last}
test dstring-3.5 {nested sublists} testdstring {
    testdstring free
} -body {
    testdstring element "\{"
    testdstring start
    testdstring element first
    testdstring element second
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result {\{ {first second}}
test dstring-3.6 {appending list elements} -constraints testdstring -setup {
} {\{ {first second}}
test dstring-3.6 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append x -1
    testdstring start
    testdstring element #
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result {x {{#}}}
test dstring-3.7 {appending list elements} -constraints testdstring -setup {
} {x {{#}}}
test dstring-3.7 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append x -1
    testdstring start
    testdstring append " " -1
    testdstring element #
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result {x { {#}}}
test dstring-3.8 {appending list elements} -constraints testdstring -setup {
} {x { {#}}}
test dstring-3.8 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append x -1
    testdstring start
    testdstring append \t -1
    testdstring element #
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result "x {\t{#}}"
test dstring-3.9 {appending list elements} -constraints testdstring -setup {
} "x {\t{#}}"
test dstring-3.9 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append x -1
    testdstring start
    testdstring append x -1
    testdstring element #
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result {x {x #}}
test dstring-3.10 {appending list elements} -constraints testdstring -setup {
} {x {x #}}
test dstring-3.10 {appending list elements} testdstring {
    testdstring free
} -body {
    # This test checks the sophistication in Tcl_DStringAppendElement's
    # decision about whether #-quoting can be disabled.
    testdstring free
    testdstring append x -1
    testdstring start
    testdstring append "x " -1
    testdstring element #
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result {x {x #}}
test dstring-3.11 {appending list elements} -constraints testdstring -setup {
} {x {x #}}
test dstring-3.11 {appending list elements} testdstring {
    testdstring free
} -body {
    testdstring append x -1
    testdstring start
    testdstring append "  " -1
    testdstring element #
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result {x {  {#}}}
test dstring-3.12 {appending list elements} -constraints testdstring -setup {
} {x {  {#}}}
test dstring-3.12 {appending list elements} testdstring {
    testdstring free
} -body {
    # This test checks the sophistication in Tcl_DStringAppendElement's
    # decision about whether #-quoting can be disabled.
    testdstring free
    testdstring append x -1
    testdstring start
    testdstring append "x  " -1
    testdstring element #
    testdstring end
    testdstring get
} -cleanup {
    testdstring free
} -result {x {x  #}}
} {x {x  #}}

test dstring-4.1 {truncation} -constraints testdstring -setup {
test dstring-4.1 {truncation} testdstring {
    testdstring free
} -body {
    testdstring append "abcdefg" -1
    testdstring trunc 3
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {abc 3}
test dstring-4.2 {truncation} -constraints testdstring -setup {
} {abc 3}
test dstring-4.2 {truncation} testdstring {
    testdstring free
} -body {
    testdstring append "xyzzy" -1
    testdstring trunc 0
    list [testdstring get] [testdstring length]
} -cleanup {
    testdstring free
} -result {{} 0}
} {{} 0}

test dstring-5.1 {copying to result} -constraints testdstring -setup {
test dstring-5.1 {copying to result} testdstring {
    testdstring free
} -body {
    testdstring append xyz -1
    testdstring result
} -cleanup {
    testdstring free
} -result xyz
test dstring-5.2 {copying to result} -constraints testdstring -setup {
} xyz
test dstring-5.2 {copying to result} testdstring {
    testdstring free
    unset -nocomplain a
    catch {unset a}
} -body {
    foreach l {a b c d e f g h i j k l m n o p} {
	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
    }
    set a [testdstring result]
    testdstring append abc -1
    list $a [testdstring get]
} -cleanup {
    testdstring free
} -result {{aaaaaaaaaaaaaaaaaaaaa
} {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
eeeeeeeeeeeeeeeeeeeee
fffffffffffffffffffff
ggggggggggggggggggggg
hhhhhhhhhhhhhhhhhhhhh
iiiiiiiiiiiiiiiiiiiii
jjjjjjjjjjjjjjjjjjjjj
kkkkkkkkkkkkkkkkkkkkk
lllllllllllllllllllll
mmmmmmmmmmmmmmmmmmmmm
nnnnnnnnnnnnnnnnnnnnn
ooooooooooooooooooooo
ppppppppppppppppppppp
} abc}

test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup {
test dstring-6.1 {Tcl_DStringGetResult} testdstring {
    testdstring free
} -body {
    list [testdstring gresult staticsmall] [testdstring get]
} -cleanup {
    testdstring free
} -result {{} short}
test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup {
} {{} short}
test dstring-6.2 {Tcl_DStringGetResult} testdstring {
    testdstring free
} -body {
    foreach l {a b c d e f g h i j k l m n o p} {
	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
    }
    list [testdstring gresult staticsmall] [testdstring get]
} -cleanup {
    testdstring free
} -result {{} short}
test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body {
} {{} short}
test dstring-6.3 {Tcl_DStringGetResult} testdstring {
    set result {}
    lappend result [testdstring gresult staticlarge]
    testdstring append x 1
    lappend result [testdstring get]
} -cleanup {
    testdstring free
} -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
} {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
second0 second1 second2 second3 second4 second5 second6 second7 second8 second9
third0 third1 third2 third3 third4 third5 third6 third7 third8 third9
fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9
fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9
sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9
seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9
x}}
test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body {
test dstring-6.4 {Tcl_DStringGetResult} testdstring {
    set result {}
    lappend result [testdstring gresult free]
    testdstring append y 1
    lappend result [testdstring get]
} -cleanup {
    testdstring free
} -result {{} {This is a malloc-ed stringy}}
test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body {
} {{} {This is a malloc-ed stringy}}
test dstring-6.5 {Tcl_DStringGetResult} testdstring {
    set result {}
    lappend result [testdstring gresult special]
    testdstring append z 1
    lappend result [testdstring get]
} -cleanup {
    testdstring free
} -result {{} {This is a specially-allocated stringz}}

} {{} {This is a specially-allocated stringz}}

# cleanup
if {[testConstraint testdstring]} {
    testdstring free
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/encoding.test.

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
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










-
-
+
-
-
-




-
-
+
-
-











+




-
-

-
+




-
+
-
-

+



-
-


+
-
+





-
+









-
+


-


-
+

-
+

-



+
-
+

-
+

-

-
+
-

+
-
-
+
+

-

-
+
-

+
-
+

-
+


+
+




-



-
-






-
-






+
-
+

-
+

-

-
+
-


+
-
+













-
+








-
+







# This file contains a collection of tests for tclEncoding.c
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
package require tcltest 2
    namespace import -force ::tcltest::*
}


namespace eval ::tcl::test::encoding {
    variable x

catch {
    ::tcltest::loadTestedCommands
namespace import -force ::tcltest::*
    package require -exact Tcltest [info patchlevel]
}

proc toutf {args} {
    variable x
    lappend x "toutf $args"
}
proc fromutf {args} {
    variable x
    lappend x "fromutf $args"
}

proc runtests {} {

    variable x

# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint teststringbytes [llength [info commands teststringbytes]]
testConstraint exec [llength [info commands exec]]
testConstraint testgetencpath [llength [info commands testgetencpath]]
testConstraint Uesc [expr {"\U0041" eq "A"}]

# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {
test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
    set old [encoding system]
} -constraints {testencoding} -body {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
    set old [encoding system]
    encoding system foo
    set x {}
    encoding convertto abcd
    return $x
} -cleanup {
    encoding system $old
    testencoding delete foo
    set x
} -result {{fromutf }}
} {{fromutf }}
test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
    set x {}
    encoding convertto foo abcd
    testencoding delete foo
    return $x
    set x
} {{fromutf }}
test encoding-1.3 {Tcl_GetEncoding: load encoding} {
    list [encoding convertto jis0208 \u4e4e] \
	[encoding convertfrom jis0208 8C]
} "8C \u4e4e"

test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
    encoding convertto jis0208 \u4e4e
} {8C}
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]
} -constraints {testencoding} -body {
    encoding system shiftjis		;# incr ref count
    encoding dirs [list [pwd]]
    set x [encoding convertto shiftjis \u4e4e]	;# old one found
    set x [encoding convertto shiftjis \u4E4E]	;# old one found
    encoding system iso8859-1
    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
    llength shiftjis
    lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
} -cleanup {
    encoding system iso8859-1
    encoding dirs $path
    encoding system $system
    set x
} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"

test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
test encoding-3.1 {Tcl_GetEncodingName, NULL} {
    set old [encoding system]
} -body {
    encoding system shiftjis
    encoding system
    set x [encoding system]
} -cleanup {
    encoding system $old
    set x
} -result {shiftjis}
test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup {
} {shiftjis}
test encoding-3.2 {Tcl_GetEncodingName, non-null} {
    set old [fconfigure stdout -encoding]
} -body {
    fconfigure stdout -encoding jis0208
    fconfigure stdout -encoding
    set x [fconfigure stdout -encoding]
} -cleanup {
    fconfigure stdout -encoding $old
    set x
} -result {jis0208}
} {jis0208}

test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup {
test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
    cd [makeDirectory tmp]
    makeDirectory [file join tmp encoding]
    makeFile {} [file join tmp encoding junk.enc]
    makeFile {} [file join tmp encoding junk2.enc]
    set path [encoding dirs]
    encoding dirs {}
    catch {unset encodings}
    catch {unset x}
} -body {
    foreach encoding [encoding names] {
	set encodings($encoding) 1
    }
    makeFile {} [file join tmp encoding junk.enc]
    makeFile {} [file join tmp encoding junk2.enc]
    encoding dirs [list [file join [pwd] encoding]]
    foreach encoding [encoding names] {
	if {![info exists encodings($encoding)]} {
	    lappend x $encoding
	}
    }
    lsort $x
} -cleanup {
    encoding dirs $path
    cd [workingDirectory]
    removeFile [file join tmp encoding junk2.enc]
    removeFile [file join tmp encoding junk.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
    lsort $x
} -result {junk junk2}
} {junk junk2}

test encoding-5.1 {Tcl_SetSystemEncoding} -setup {
test encoding-5.1 {Tcl_SetSystemEncoding} {
    set old [encoding system]
} -body {
    encoding system jis0208
    encoding convertto \u4e4e
    set x [encoding convertto \u4e4e]
} -cleanup {
    encoding system iso8859-1
    encoding system $old
    set x
} -result {8C}
} {8C}
test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
    set old [encoding system]
    encoding system $old
    string compare $old [encoding system]
} {0}

test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
    testencoding create foo [namespace code {toutf 1}] \
	[namespace code {fromutf 2}]
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    return $x
    set x
} {{toutf 1} {fromutf 2}}
test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
    testencoding create foo [namespace code {toutf a}] \
	[namespace code {fromutf b}]
    set x {}
    encoding convertfrom foo abcd
    encoding convertto foo abcd
    testencoding delete foo
    return $x
    set x
} {{toutf a} {fromutf b}}

test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
    encoding convertfrom jis0208 8c8c8c8c
} "\u543e\u543e\u543e\u543e"
test encoding-7.2 {Tcl_UtfToExternalDString: big buffer} {
    set a 8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C8C
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184







-
+







    puts -nonewline $f "ab\x8c\xc1g"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding shiftjis
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
    set x
} "ab\u4e4eg"

test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
    encoding convertto jis0208 "\u543e\u543e\u543e\u543e"
} {8c8c8c8c}
test encoding-9.2 {Tcl_UtfToExternalDString: big buffer} {
    set a \u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e\u4e4e
214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
198
199
200
201
202
203
204

205
206
207
208
209
210
211
212







-
+







    puts -nonewline $f "ab\u4e4eg"
    close $f
    set f [open [file join [temporaryDirectory] dummy] r]
    fconfigure $f -translation binary -encoding iso8859-1
    set x [read $f]
    close $f
    file delete [file join [temporaryDirectory] dummy]
    return $x
    set x
} "ab\x8c\xc1g"

proc viewable {str} {
    set res ""
    foreach c [split $str {}] {
	if {[string is print $c] && [string is ascii $c]} {
	    append res $c
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
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







-
+



-








-
+
-






+
-
+







} "\u4e4e"
test encoding-11.5 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022 \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.5.1 {LoadEncodingFile: escape file} {
    viewable [encoding convertto iso2022-jp \u4e4e]
} [viewable "\x1b\$B8C\x1b(B"]
test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
    set system [encoding system]
    set path [encoding dirs]
    encoding system iso8859-1
} -body {
    cd [temporaryDirectory]
    encoding dirs [file join tmp encoding]
    makeDirectory tmp
    makeDirectory [file join tmp encoding]
    set f [open [file join tmp encoding splat.enc] w]
    fconfigure $f -translation binary
    puts $f "abcdefghijklmnop"
    close $f
    encoding convertto splat \u4e4e
    set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
} -returnCodes error -cleanup {
    file delete [file join [temporaryDirectory] tmp encoding splat.enc]
    removeDirectory [file join tmp encoding]
    removeDirectory tmp
    cd [workingDirectory]
    encoding dirs $path
    encoding system $system
    set x
} -result {invalid encoding file "splat"}
} {1 {invalid encoding file "splat"}}

# OpenEncodingFile is fully tested by the rest of the tests in this file.

test encoding-12.1 {LoadTableEncoding: normal encoding} {
    set x [encoding convertto iso8859-3 \u0120]
    append x [encoding convertto iso8859-3 \xD5]
    append x [encoding convertfrom iso8859-3 \xD5]
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
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







+
+
+




+
+
+
+




+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-





-
-
-
-
-
-

-
+
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
+
-
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
+







    append x [encoding convertfrom jis0208 8C&A]
} "8C&A\u4e4e\u3b1"
test encoding-12.5 {LoadTableEncoding: symbol encoding} {
    set x [encoding convertto symbol \u3b3]
    append x [encoding convertto symbol \u67]
    append x [encoding convertfrom symbol \x67]
} "\x67\x67\u3b3"
test encoding-12.6 {LoadTableEncoding: overflow in char value} Uesc {
    encoding convertto iso8859-3 \U010000
} "?"

test encoding-13.1 {LoadEscapeTable} {
    viewable [set x [encoding convertto iso2022 ab\u4e4e\u68d9g]]
} [viewable "ab\x1b\$B8C\x1b\$\(DD%\x1b(Bg"]

test encoding-14.1 {BinaryProc} {
    encoding convertto identity \x12\x34\x56\xff\x69
} "\x12\x34\x56\xc3\xbf\x69"

test encoding-15.1 {UtfToUtfProc} {
    encoding convertto utf-8 \xa3
} "\xc2\xa3"

test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
test encoding-15.2 {UtfToUtfProc null character output} {
    binary scan [testbytestring [encoding convertto utf-8 \u0000]] H* z
    set z
} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \u0000]]
    binary scan [teststringbytes $y] H* z
    set z
} c080
test encoding-15.4 {UtfToUtfProc emoji character input} -body {
    set x \xED\xA0\xBD\xED\xB8\x82
    set y [encoding convertfrom utf-8 \xED\xA0\xBD\xED\xB8\x82]
    list [string length $x] $y
} -result "6 \U1F602"
test encoding-15.5 {UtfToUtfProc emoji character input} {
    set x \xF0\x9F\x98\x82
    set y [encoding convertfrom utf-8 \xF0\x9F\x98\x82]
    list [string length $x] $y
} "4 \U1F602"
test encoding-15.6 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\uDE02\uD83D
    set y [encoding convertto utf-8 \uDE02\uD83D\uDE02\uD83D]
    binary scan $y H* z
    list [string length $y] $z
} {10 edb882f09f9882eda0bd}
test encoding-15.7 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\uD83D
    set y [encoding convertto utf-8 \uDE02\uD83D\uD83D]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 9 edb882eda0bdeda0bd}
test encoding-15.8 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83D\xE9
    set y [encoding convertto utf-8 \uDE02\uD83D\xE9]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 8 edb882eda0bdc3a9}
test encoding-15.9 {UtfToUtfProc emoji character output} {
    set x \uDE02\uD83DX
    set y [encoding convertto utf-8 \uDE02\uD83DX]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {3 7 edb882eda0bd58}
test encoding-15.10 {UtfToUtfProc high surrogate character output} {
    set x \uDE02\xE9
    set y [encoding convertto utf-8 \uDE02\xE9]
    set x \u0000
    set y [encoding convertto utf-8 \u0000]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 edb882c3a9}
test encoding-15.11 {UtfToUtfProc low surrogate character output} {
    set x \uDA02\xE9
    set y [encoding convertto utf-8 \uDA02\xE9]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 5 eda882c3a9}
test encoding-15.12 {UtfToUtfProc high surrogate character output} {
    set x \uDE02Y
    set y [bytestring $y]
    set y [encoding convertto utf-8 \uDE02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 edb88259}
test encoding-15.13 {UtfToUtfProc low surrogate character output} {
    list [string bytelength $x] [string bytelength $y] $z
} {2 1 00}

    set x \uDA02Y
    set y [encoding convertto utf-8 \uDA02Y]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {2 4 eda88259}
test encoding-15.14 {UtfToUtfProc high surrogate character output} {
    set x \uDE02
    set y [encoding convertto utf-8 \uDE02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 edb882}
test encoding-15.3 {UtfToUtfProc null character input} {
    set x [bytestring \x00]
    set y [encoding convertfrom utf-8 $x]
    binary scan [encoding convertto identity $y] H* z
    list [string bytelength $x] [string bytelength $y] $z
} {1 2 c080}
test encoding-15.15 {UtfToUtfProc low surrogate character output} {
    set x \uDA02
    set y [encoding convertto utf-8 \uDA02]
    binary scan $y H* z
    list [string length $x] [string length $y] $z
} {1 3 eda882}
test encoding-15.16 {UtfToUtfProc: Invalid 4-byte UTF-8, see [ed29806ba]} {
    set x \xF0\xA0\xA1\xC2
    set y [encoding convertfrom utf-8 \xF0\xA0\xA1\xC2]
    list [string length $x] $y
} "4 \xF0\xA0\xA1\xC2"
test encoding-15.17 {UtfToUtfProc emoji character output} {
    set x \U1F602
    set y [encoding convertto utf-8 \U1F602]
    binary scan $y H* z
    list [string length $y] $z
} {4 f09f9882}

test encoding-16.1 {Utf16ToUtfProc} -body {
test encoding-16.1 {UnicodeToUtfProc} {
    set val [encoding convertfrom utf-16 NN]
    list $val [format %x [scan $val %c]]
} -result "\u4E4E 4e4e"
test encoding-16.2 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 "\xD8\xD8\xDC\xDC"]
    set val [encoding convertfrom unicode NN]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"
test encoding-16.3 {Utf16ToUtfProc} -body {
    set val [encoding convertfrom utf-16 "\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\uDCDC dcdc"
test encoding-16.4 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 NN]
    list $val [format %x [scan $val %c]]
} -result "\u4E4E 4e4e"
} "\u4e4e 4e4e"
test encoding-16.4 {Ucs2ToUtfProc} -body {
    set val [encoding convertfrom ucs-2 "\xD8\xD8\xDC\xDC"]
    list $val [format %x [scan $val %c]]
} -result "\U460DC 460dc"

test encoding-17.1 {UtfToUtf16Proc} -body {
test encoding-17.1 {UtfToUnicodeProc} {
    encoding convertto utf-16 "\U460DC"
} -result "\xD8\xD8\xDC\xDC"
test encoding-17.2 {UtfToUtf16Proc} -body {
    encoding convertto utf-16 "\uDCDC"
} -result "\xDC\xDC"
test encoding-17.3 {UtfToUtf16Proc} -body {
    encoding convertto utf-16 "\uD8D8"
} -result "\xD8\xD8"
test encoding-17.4 {UtfToUcs2Proc} -body {
    encoding convertfrom utf-16 [encoding convertto ucs-2 "\U460DC"]
} -result "\uFFFD"
} {}

test encoding-18.1 {TableToUtfProc} {
} {}

test encoding-19.1 {TableFromUtfProc} {
} {}

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
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







-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+



+
+
+
+
+
+
-
+
-
-
+
+
+

-
+



-

+
-
-
+
+
+
+
+
+

-
-
+
+







} [list [string length $iso2022uniData] $iso2022uniData]
test encoding-23.3 {iso2022-jp escape encoding test} {
    # read $fis <size> reads size in chars, not raw bytes.
    set fid [open iso2022.txt r]
    fconfigure $fid -encoding iso2022-jp
    set data [read $fid 50]
    close $fid
    return $data
    set data
} [string range $iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
cd [workingDirectory]

# Code to make the next few tests more intelligible; the code being tested
# should be in the body of the test!
proc runInSubprocess {contents {filename iso2022.tcl}} {
    set theFile [makeFile $contents $filename]
    try {
	exec [interpreter] $theFile
    } finally {
	removeFile $theFile
    }
}

test encoding-24.1 {EscapeFreeProc on open channels} exec {
    runInSubprocess {
test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
	exec
} -setup {
    # Bug #524674 input
    set file [makeFile {
	set f [open [file join [file dirname [info script]] iso2022.txt]]
	fconfigure $f -encoding iso2022-jp
	gets $f
    } iso2022.tcl]
} -body {
    exec [interpreter] $file
} -cleanup {
    removeFile iso2022.tcl
} -result {}
    }

} {}
test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
	exec
} -setup {
    # Bug #524674 output
    viewable [runInSubprocess {
    set file [makeFile {
	encoding system cp1252;	# Bug #2891556 crash revelator
	fconfigure stdout -encoding iso2022-jp
	puts ab\u4e4e\u68d9g
	set env(TCL_FINALIZE_ON_EXIT) 1
	exit
    } iso2022.tcl]
    }]
} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
} -body {
    viewable [exec [interpreter] $file]
} -cleanup {
    removeFile iso2022.tcl
} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"

test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
    # Bug #219314 - if we don't free escape encodings correctly on channel
    # closure, we go boom
    # Bug #219314 - if we don't free escape encodings correctly on
    # channel closure, we go boom
    set file [makeFile {
	encoding system iso2022-jp
	set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
	puts $a
    } iso2022.tcl]
    set f [open "|[list [interpreter] $file]"]
    fconfigure $f -encoding iso2022-jp
602
603
604
605
606
607
608

609

610
611
612
613
614
615
616




617
618
619
620
621
622
623
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







+
-
+






-
+
+
+
+







	{4F21 4F53}

	{50 21 73 7E}
	{7421 7426}
    } {
	if {[llength $range] == 2} {
	    # for adhoc range. simple {first last}. inclusive.
	    set first [scan [lindex $range 0] %x]
	    scan $range %x%x first last
	    set last [scan [lindex $range 1] %x]
	    for {set i $first} {$i <= $last} {incr i} {
		set code $i
		uplevel 1 $command
	    }
	} elseif {[llength $range] == 4} {
	    # for uniform range.
	    scan $range %x%x%x%x h0 l0 hend lend
	    set h0 [scan [lindex $range 0] %x]
	    set l0 [scan [lindex $range 1] %x]
	    set hend [scan [lindex $range 2] %x]
	    set lend [scan [lindex $range 3] %x]
	    for {set hi $h0} {$hi <= $hend} {incr hi} {
		for {set lo $l0} {$lo <= $lend} {incr lo} {
		    set code [expr {$hi << 8 | ($lo & 0xff)}]
		    uplevel 1 $command
		}
	    }
	} else {
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
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
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
618
619
620

621


622
623
624
625
626
627
628
629
630
631

















632
633
634
635
636
637
638
639











-
+


















-
+

-







+

-
-
-
+
+
+
+
+
-
-


-
+
+
+
+



+
+
-
-
+
+

-
-
+
+

-
+

-
+





-
+
-
-
+









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-

	# For more readable (easy to analyze) output.
	set code [lindex $la 0]
	binary scan [lindex $la 1] H* expected
	binary scan [lindex $lb 1] H* got
	lappend diff [list $code $expected $got]
    }
    return $diff
    set diff
}

# Create char tables.
cd [temporaryDirectory]
foreach enc {cp932 euc-jp iso2022-jp} {
    set f [open $enc.chars w]
    fconfigure $f -encoding binary
    foreach-jisx0208 code {
	puts $f [format "%04X %s" $code [gen-jisx0208-$enc $code]]
    }
    close $f
}
# shiftjis == cp932 for jisx0208.
file copy -force cp932.chars shiftjis.chars

set NUM 0
foreach from {cp932 shiftjis euc-jp iso2022-jp} {
    foreach to {cp932 shiftjis euc-jp iso2022-jp} {
	test encoding-25.[incr NUM] "jisx0208 $from => $to" -setup {
	test encoding-25.[incr NUM] "jisx0208 $from => $to" {
	    cd [temporaryDirectory]
	} -body {
	    set f [open $from.chars]
	    fconfigure $f -encoding $from
	    set out [open $from.$to.tcltestout w]
	    fconfigure $out -encoding $to
	    puts -nonewline $out [read $f]
	    close $out
	    close $f

	    # then compare $to.chars <=> $from.to.tcltestout as binary.
	    set fa [open $to.chars rb]
	    set fb [open $from.$to.tcltestout rb]
	    channel-diff $fa $fb
	    set fa [open $to.chars]
	    fconfigure $fa -encoding binary
	    set fb [open $from.$to.tcltestout]
	    fconfigure $fb -encoding binary
	    set diff [channel-diff $fa $fb]
	    # Difference should be empty.
	} -cleanup {
	    close $fa
	    close $fb
	} -result {}

	    # Difference should be empty.
	    set diff
	} {}
    }
}

testConstraint testgetdefenc [llength [info commands testgetdefenc]]

test encoding-26.0 {Tcl_GetEncodingSearchPath} -constraints {
    testgetencpath
test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
    testgetdefenc
} -setup {
    set origPath [testgetencpath]
    testsetencpath slappy
     set origDir [testgetdefenc]
     testsetdefenc slappy
} -body {
    testgetencpath
     testgetdefenc
} -cleanup {
    testsetencpath $origPath
     testsetdefenc $origDir
} -result slappy

file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
# ===> Cut here <===

# EscapeFreeProc, GetTableEncoding, unilen are fully tested by the rest of
# EscapeFreeProc, GetTableEncoding, unilen
# this file.

# are fully tested by the rest of this file

test encoding-27.1 {encoding dirs basic behavior} -returnCodes error -body {
    encoding dirs ? ?
} -result {wrong # args: should be "encoding dirs ?dirList?"}
test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body {
    encoding dirs "\{not a list"
} -result "expected directory list but got \"\{not a list\""

}


test encoding-28.0 {all encodings load} -body {
	set string hello
	foreach name [encoding names] {
		if {$name ne "unicode"} {
		    incr count
		}
		encoding convertto $name $string

		# discard the cached internal representation of Tcl_Encoding
		# Unfortunately, without this, encoding 2-1 fails.
		llength $name
	}
	return $count
} -result 85

runtests

}

# cleanup
namespace delete ::tcl::test::encoding
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/env.test.

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
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
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













-
-
+
+



-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
+

-
+
-










-
+







-
+





-
+
+
+
+
+
+
+



-
+


-
+

-
-
-
-
+
+
+
+
-
-
+
-
-
+
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-


+

-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
+
+
-

-
-
+

-
-
-
-
+
+

-
+

-
-
+
+
-
-
-
-

-
+


-
-
-
-
-
-
-
-
-
+
+

-
-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-



-
-
-
+



-
-
-
-
-
-
-
+
+
+
+
+


-
+
+
+
+
+

-
-
+
-


-
+
-
-
-
-
+
-


-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
-

+
-
+
-
-
-
+
+
-
-
+
-
-
-
-
+
+
+
+
+
+



+
-
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-

-
-
+
+
+
+
+

-
-
-
+
-
-
-
-
+



-
-

-
-
+
+
-
-
+
-
-
-


+
+
-
+



-
-

-
-
+
+
-
-
-
+
-


-
+

-
+





-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
+
+


-
-
-
-
-
-







# Commands covered:  none (tests environment variable implementation)
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# Some tests require the "exec" command.
# Skip them if exec is not defined.
# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
testConstraint exec [llength [info commands exec]]
    if {$out eq "child process exited abnormally"} {
	set out {}
    }

    return $out
}


proc envrestore {} {
#
# These tests will run on any platform (and indeed crashed on the Mac). So put
# them before you test for the existance of exec.
    # Restore the environment variables at the end of the test.
    global env
    variable env2

    foreach name [array names env] {
	unset env($name)
#
test env-1.1 {propagation of env values to child interpreters} {
    catch {interp delete child}
    catch {unset env(test)}
    }
    array set env $env2
    return
    interp create child
}


    set env(test) garbage
    set return [child eval {set env(test)}]
proc envprep {} {
    # Save the current environment variables at the start of the test.
    global env
    variable keep
    variable env2

    interp delete child
    set env2 [array get env]
    foreach name [array names env] {
	# Keep some environment variables that support operation of the tcltest
	# package.
	if {[string toupper $name] ni [string toupper $keep]} {
	    unset env($name)
    unset env(test)
	}
    }
    return
    set return
}


proc encodingrestore {} {
} {garbage}
    variable sysenc
    encoding system $sysenc
    return
}


#
# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
proc encodingswitch encoding {
    variable sysenc
    # Need to run [getenv] in known encoding, so save the current one here...
    set sysenc [encoding system]
    encoding system $encoding
    return
# runs.
}


proc setup1 {} {
    global env
    envprep
#
test env-1.2 {lappend to env value} {
    catch {unset env(test)}
    set env(test) aaaaaaaaaaaaaaaa
    append env(test) bbbbbbbbbbbbbb
    unset env(test)
    encodingswitch iso8859-1
}

} {}
test env-1.3 {reflection of env by "array names"} {
proc setup2 {} {
    global env
    setup1
    set env(NAME1) {test string}
    set env(NAME2) {new value}
    set env(XYZZY) {garbage}
    catch {interp delete child}
    catch {unset env(test)}
    interp create child
    child eval {set env(test) garbage}
    set names [array names env]
}


    interp delete child
    set ix [lsearch $names test]
proc cleanup1 {} {
    encodingrestore
    envrestore
    catch {unset env(test)}
}

    expr {$ix >= 0}
variable keep {
    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
    CommonProgramFiles CommonProgramFiles(x86) ProgramFiles
    ProgramFiles(x86) CommonProgramW6432 ProgramW6432
    WINECONFIGDIR WINEDATADIR WINEDLLDIR0 WINEHOMEDIR
}
} {1}

variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
set printenvScript [makeFile {
    encoding system iso8859-1
    proc lrem {listname name} {
	upvar $listname list
	set i [lsearch -nocase $list $name]
	if {$i >= 0} {
	    set list [lreplace $list $i $i]
	}
	return $list
    }
    proc mangle s {
	regsub -all {\[|\\|\]} $s {\\&} s
	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar {&}]} s
	regsub -all {[\u0000-\u001f\u007f-\uffff]} $s {[manglechar &]} s
	return [subst -novariables $s]
    }
    proc manglechar c {
	return [format {\u%04x} [scan $c %c]]
    }

    set names [lsort [array names env]]
    if {$tcl_platform(platform) eq "windows"} {
    if {$tcl_platform(platform) == "windows"} {
	lrem names HOME
        lrem names COMSPEC
	lrem names ComSpec
	lrem names ""
    }
    foreach name @keep@ {
    foreach name {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
	CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
    } {
	lrem names $name
    }
    foreach p $names {
	puts [mangle $p]=[mangle $env($p)]
	puts "[mangle $p]=[mangle $env($p)]"
    }
    exit
}] printenv]
} printenv]


test env-1.1 {propagation of env values to child interpreters} -setup {
    catch {interp delete child}
    catch {unset env(test)}
# [exec] is required here to see the actual environment received
# by child processes.
proc getenv {} {
    global printenvScript tcltest
} -body {
    interp create child
    catch {exec [interpreter] $printenvScript} out
    set env(test) garbage
    child eval {set env(test)}
    if {$out == "child process exited abnormally"} {
} -cleanup {
    interp delete child
    unset env(test)
	set out {}
} -result {garbage}


    }
    return $out
# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
# runs.
test env-1.2 {lappend to env value} -setup {
    catch {unset env(test)}
} -body {
    set env(test) aaaaaaaaaaaaaaaa
    append env(test) bbbbbbbbbbbbbb
    unset env(test)
}

# Save the current environment variables at the start of the test.

test env-1.3 {reflection of env by "array names"} -setup {
    catch {interp delete child}
    catch {unset env(test)}
set env2 [array get env]
} -body {
    interp create child
    child eval {set env(test) garbage}
    expr {"test" in [array names env]}
} -cleanup {
foreach name [array names env] {
    # Keep some environment variables that support operation of the tcltest
    # package.
    if {[string toupper $name] ni {
	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING MSYSTEM
	SECURITYSESSIONID LANG WINDIR TERM
	CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
    }} {
    interp delete child
    catch {unset env(test)}
	unset env($name)
} -result 1


test env-2.1 {
    adding environment variables
    }
}

test env-2.1 {adding environment variables} {exec} {
} -constraints exec -setup setup1 -body {
    getenv
} -cleanup cleanup1 -result {}

} {}

test env-2.2 {
    adding environment variables
} -constraints exec -setup setup1 -body {
    set env(NAME1) "test string"
set env(NAME1) "test string"
test env-2.2 {adding environment variables} {exec} {
    getenv
} -cleanup cleanup1 -result {NAME1=test string}
} {NAME1=test string}


test env-2.3 {adding environment variables} -constraints exec -setup {
set env(NAME2) "more"
test env-2.3 {adding environment variables} {exec} {
    setup1
    set env(NAME1) "test string"
} -body {
    set env(NAME2) "more"
    getenv
} -cleanup cleanup1 -result {NAME1=test string
} {NAME1=test string
NAME2=more}


test env-2.4 {
    adding environment variables
} -constraints exec -setup {
    setup1
    set env(NAME1) "test string"
    set env(NAME2) "more"
} -body {
    set env(XYZZY) "garbage"
set env(XYZZY) "garbage"
test env-2.4 {adding environment variables} {exec} {
    getenv
} -cleanup { cleanup1
} -result {NAME1=test string
} {NAME1=test string
NAME2=more
XYZZY=garbage}

test env-2.5 {different encoding (wide chars)} -constraints {win exec} -setup {
    # be sure set of (unicode) environment occurs if single-byte encoding is used:
    encodingswitch cp1252
    # german (cp1252) and russian (cp1251) characters together encoded as utf-8:
    set val 2d2dc3a4c3b6c3bcc39f2dd182d0b5d181d1822d2d
    set env(XYZZY) [encoding convertfrom utf-8 [binary decode hex $val]]
    # now switch to utf-8 (to see correct values from test):
    encoding system utf-8
} -body {
    exec [interpreter] << [string map [list \$val $val] {
	encoding system utf-8; fconfigure stdout -encoding utf-8
	set test [encoding convertfrom utf-8 [binary decode hex $val]]
	puts "[expr {$env(XYZZY) eq $test}] \ngot:\t\
	    $env(XYZZY) ([binary encode hex [encoding convertto $env(XYZZY)]]) \nexp:\t\
	    $test ([binary encode hex [encoding convertto $test]])"
    }]
} -cleanup {
    encodingrestore
    unset -nocomplain val f env(XYZZY)
} -match glob -result {1 *}

set env(NAME2) "new value"
test env-3.1 {
    changing environment variables
test env-3.1 {changing environment variables} {exec} {
} -constraints exec -setup setup2 -body {
    set result [getenv]
    unset env(NAME2)
    set result
} -cleanup {
    cleanup1
} -result {NAME1=test string
} {NAME1=test string
NAME2=new value
XYZZY=garbage}


test env-4.1 {
    unsetting environment variables
} -constraints exec -setup setup2 -body {
    unset -nocomplain env(NAME2)
    getenv
} -cleanup cleanup1 -result {NAME1=test string
test env-4.1 {unsetting environment variables} {exec} {
    set result [getenv]
    unset env(NAME1)
    set result
} {NAME1=test string
XYZZY=garbage}

# env-4.2 is deleted
test env-4.2 {unsetting environment variables} {exec} {
    set result [getenv]
    unset env(XYZZY)
    set result
} {XYZZY=garbage}

test env-4.3 {
    setting international environment variables
test env-4.3 {setting international environment variables} {exec} {
} -constraints exec -setup setup1 -body {
    set env(\ua7) \ub6
    getenv
} -cleanup cleanup1 -result {\u00a7=\u00b6}
} {\u00a7=\u00b6}


test env-4.4 {
    changing international environment variables
test env-4.4 {changing international environment variables} {exec} {
} -constraints exec -setup setup1 -body {
    set env(\ua7) \ua7
    getenv
} -cleanup cleanup1 -result {\u00a7=\u00a7}

} {\u00a7=\u00a7}
test env-4.5 {unsetting international environment variables} {exec} {
    set env(\ub6) \ua7
    unset env(\ua7)
    set result [getenv]
    unset env(\ub6)
    set result
} {\u00b6=\u00a7}

test env-4.5 {
    unsetting international environment variables
} -constraints exec -setup {
    setup1
    set env(\ua7) \ua7
} -body {
    set env(\ub6) \ua7
    unset env(\ua7)
    getenv
} -cleanup cleanup1 -result {\u00b6=\u00a7}

test env-5.0 {
    corner cases - set a value, it should exist
test env-5.0 {corner cases - set a value, it should exist} {} {
} -setup setup1 -body {
    set env(temp) a
    set result [set env(temp)]
    set env(temp)
    unset env(temp)
} -cleanup cleanup1 -result a


    set result
} {a}
test env-5.1 {
    corner cases - remove one elem at a time
test env-5.1 {corner cases - remove one elem at a time} {} {
} -setup setup1 -body {
    # When no environment variables exist, the env var will contain no
    # entries. The "array names" call synchs up the C-level environ array with
    # the Tcl level env array. Make sure an empty Tcl array is created.
    # When no environment variables exist, the env var will
    # contain no entries.  The "array names" call synchs up
    # the C-level environ array with the Tcl level env array.
    # Make sure an empty Tcl array is created.

    set x [array get env]
    foreach e [array names env] {
	unset env($e)
    }
    set result [catch {array names env}]
    array size env
    array set env $x
} -cleanup cleanup1 -result 0


test env-5.2 {corner cases - unset the env array} -setup {
    set result
} {0}
test env-5.2 {corner cases - unset the env array} {} {
    interp create i
} -body {
    # Unsetting a variable in an interp detaches the C-level traces from the
    # Tcl "env" variable.
    i eval {
	unset env
	set env(THIS_SHOULDNT_EXIST) a
    # Unsetting a variable in an interp detaches the C-level
    # traces from the Tcl "env" variable.

    interp create i 
    i eval { unset env }
    i eval { set env(THIS_SHOULDNT_EXIST) a}
    }
    info exists env(THIS_SHOULDNT_EXIST)
    set result [info exists env(THIS_SHOULDNT_EXIST)]
} -cleanup {
    interp delete i
} -result {0}

    set result
} {0}
test env-5.3 {corner cases - unset the env in master should unset child} {} {
    # Variables deleted in a master interp should be deleted in
    # child interp too.

test env-5.3 {corner cases: unset the env in parent should unset child} -setup {
    setup1
    interp create i
    interp create i 
} -body {
    # Variables deleted in a parent interp should be deleted in child interp
    # too.
    i eval {set env(THIS_SHOULD_EXIST) a}
    i eval { set env(THIS_SHOULD_EXIST) a}
    set result [set env(THIS_SHOULD_EXIST)]
    unset env(THIS_SHOULD_EXIST)
    lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
} -cleanup {
    cleanup1
    interp delete i
} -result {a 1}

    set result
} {a 1}

test env-5.4 {corner cases - unset the env array} -setup {
test env-5.4 {corner cases - unset the env array} {} {
    setup1
    interp create i
} -body {
    # The info exists command should be in synch with the env array.
    # Know Bug: 1737

    interp create i 
    i eval {set env(THIS_SHOULD_EXIST) a}
    i eval { set env(THIS_SHOULD_EXIST) a}
    set     result [info exists env(THIS_SHOULD_EXIST)]
    lappend result [set env(THIS_SHOULD_EXIST)]
    lappend result [info exists env(THIS_SHOULD_EXIST)]
} -cleanup {
    cleanup1
    interp delete i
} -result {1 a 1}

    set result
} {1 a 1}

test env-5.5 {
    corner cases - cannot have null entries on Windows
test env-5.5 {corner cases - cannot have null entries on Windows} {win} {
} -constraints win -body {
    set env() a
    catch {set env()}
} -cleanup cleanup1 -result 1
} {1}

test env-6.1 {corner cases - add lots of env variables} -setup setup1 -body {
test env-6.1 {corner cases - add lots of env variables} {} {
    set size [array size env]
    for {set i 0} {$i < 100} {incr i} {
	set env(BOGUS$i) $i
    }
    expr {[array size env] - $size}
} -cleanup cleanup1 -result 100

} 100
test env-7.1 {[219226]: whole env array should not be unset by read} -body {
    set n [array size env]
    set s [array startsearch env]
    while {[array anymore env $s]} {
	array nextelement env $s
	incr n -1
    }

    array donesearch env $s
    return $n
} -result 0

test env-7.2 {
    [219226]: links to env elements should not be removed by read
} -setup setup1 -body {
    apply {{} {
	set ::env(test7_2) ok
	upvar env(test7_2) elem
	set ::env(PATH)
	return $elem
    }}
} -cleanup cleanup1 -result ok

test env-7.3 {
    [9b4702]: testing existence of env(some_thing) should not destroy trace
test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body {
} -setup setup1 -body {
    apply {{} {
      catch {unset ::env(test7_3)}
      proc foo args {
        set ::env(test7_3) ok
      }
      trace add variable ::env(not_yet_existent) write foo
      info exists ::env(not_yet_existent)
      set ::env(not_yet_existent) "Now I'm here";
      return [info exists ::env(test7_3)]
    catch {unset ::env(test7_3)}
    proc foo args {
      set ::env(test7_3) ok
    }
    trace add variable ::env(not_yet_existent) write foo
    info exists ::env(not_yet_existent)
    set ::env(not_yet_existent) "Now I'm here";
    info exists ::env(test7_3)
    }}
} -cleanup cleanup1 -result 1

test env-8.0 {
    memory usage - valgrind does not report reachable memory
} -body {
} -cleanup {
  unset ::env(not_yet_existent)
  unset ::env(test7_3)
} -result 1

# Restore the environment variables at the end of the test.

foreach name [array names env] {
    set res [set env(__DUMMY__) {i'm with dummy}]
    unset env(__DUMMY__)
    unset env($name)
    return $res
} -result {i'm with dummy}


}
array set env $env2

# cleanup
rename getenv {}
rename envrestore {}
rename envprep {}
rename encodingrestore {}
rename encodingswitch {}

removeFile $printenvScript
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/error.test.

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

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
-
+

-
-
-
+
+
+





-
-
+
+

-
-
+
+



-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

















+




+



-
-
+
+



+



+




+



+




+

-
-
+
+
+


-
-
+
+
+






-
-
+
+




+




+









+



+




+







# Commands covered:  error, catch, throw, try
# Commands covered:  error, catch
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
customMatch pairwise {apply {{a b} {
    string equal [lindex $b 0] [lindex $b 1]
}}}
namespace eval ::tcl::test::error {
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}

proc foo {} {
    global errorInfo
    set a [catch {format [error glorp2]} b]
    error {Human-generated}
}

proc foo2 {} {
    global errorInfo
    set a [catch {format [error glorp2]} b]
    error {Human-generated} $errorInfo
}

# Catch errors occurring in commands and errors from "error" command

test error-1.1 {simple errors from commands} {
    catch {format [string index]} b
} 1

test error-1.2 {simple errors from commands} {
    catch {format [string index]} b
    set b
} {wrong # args: should be "string index string charIndex"}

test error-1.3 {simple errors from commands} {
    catch {format [string index]} b
    set ::errorInfo
    # This used to return '... while executing ...', but string index is fully
    # compiled as of 8.4a3
    # this used to return '... while executing ...', but
    # string index is fully compiled as of 8.4a3
} {wrong # args: should be "string index string charIndex"
    while executing
"string index"}

test error-1.4 {simple errors from commands} {
    catch {error glorp} b
} 1

test error-1.5 {simple errors from commands} {
    catch {error glorp} b
    set b
} glorp

test error-1.6 {simple errors from commands} {
    catch {catch a b c d} b
} 1

test error-1.7 {simple errors from commands} {
    catch {catch a b c d} b
    set b
} {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}

test error-1.8 {simple errors from commands} {
    # This test is non-portable: it generates a memory fault on machines like
    # DEC Alphas (infinite recursion overflows stack?)
    # This test is non-portable: it generates a memory fault on
    # machines like DEC Alphas (infinite recursion overflows
    # stack?)
    #
    # That claims sounds like a bug to be fixed rather than a portability
    # problem. Anyhow, I believe it's out of date (bug's been fixed) so this
    # test is re-enabled.
    # problem.  Anyhow, I believe it's out of date (bug's been fixed) so
    # this test is re-enabled.

    proc p {} {
        uplevel 1 catch p error
    }
    p
} 0

# Check errors nested in procedures. Also check the optional argument to
# "error" to generate a new error trace.
# Check errors nested in procedures.  Also check the optional argument
# to "error" to generate a new error trace.

test error-2.1 {errors in nested procedures} {
    catch foo b
} 1

test error-2.2 {errors in nested procedures} {
    catch foo b
    set b
} {Human-generated}

test error-2.3 {errors in nested procedures} {
    catch foo b
    set ::errorInfo
} {Human-generated
    while executing
"error {Human-generated}"
    (procedure "foo" line 4)
    invoked from within
"foo"}

test error-2.4 {errors in nested procedures} {
    catch foo2 b
} 1

test error-2.5 {errors in nested procedures} {
    catch foo2 b
    set b
} {Human-generated}

test error-2.6 {errors in nested procedures} {
    catch foo2 b
    set ::errorInfo
} {glorp2
    while executing
"error glorp2"
    (procedure "foo2" line 3)
137
138
139
140
141
142
143
144

145
146
147
148
149
150
151
131
132
133
134
135
136
137

138
139
140
141
142
143
144
145







-
+







test error-3.2 {errors in catch command} {
    list [catch {catch a b c} msg] $msg
} {0 1}
test error-3.3 {errors in catch command} {
    catch {unset a}
    set a(0) 22
    list [catch {catch {format 44} a} msg] $msg
} {1 {can't set "a": variable is array}}
} {1 {couldn't save command result in variable}}
catch {unset a}

# More tests related to errorInfo and errorCode

test error-4.1 {errorInfo and errorCode variables} {
    list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 msg3}
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
160
161
162
163
164
165
166























167
168
169
170
171
172
173







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    while executing
"error msg1"} NONE}
test error-4.5 {errorInfo and errorCode variables} {
    set ::errorCode bogus
    list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode
} {1 msg1 msg2 {}}

test error-4.6 {errorstack via info } -body {
    proc f x {g $x$x}
    proc g x {error G:$x}
    catch {f 12}
    info errorstack
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.7 {errorstack via options dict } -body {
    proc f x {g $x$x}
    proc g x {error G:$x}
    catch {f 12} m d
    dict get $d -errorstack
} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.8 {errorstack from exec traces} -body {
    proc foo args {}
    proc goo {} foo
    trace add execution foo enter {error bar;#}
    catch goo m d
    dict get $d -errorstack
} -cleanup {
    rename goo {}; rename foo {}
    unset -nocomplain m d
} -result {INNER {error bar} CALL goo UP 1}

# Errors in error command itself

test error-5.1 {errors in error command} {
    list [catch {error} msg] $msg
} {1 {wrong # args: should be "error message ?errorInfo? ?errorCode?"}}
test error-5.2 {errors in error command} {
    list [catch {error a b c d} msg] $msg
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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











-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+
-
-
-
-
test error-6.9 {catch must reset error state} {
    proc foo {} {
	return -code error [catch {error foo bar baz}]
    }
    catch foo
    list $::errorCode
} {NONE}
test error-6.10 {catch must reset errorstack} -body {
	proc f x {g $x$x}
	proc g x {error G:$x}
	catch {f 12}
	set e1 [info errorstack]
	catch {f 13}
	set e2 [info errorstack]
	list $e1 $e2
} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}}

test error-7.1 {Bug 1397843} -body {
    variable cmds
    proc EIWrite args {
	variable cmds
	lappend cmds [lindex [info level -2] 0]
    }
    proc BadProc {} {
	set i a
	incr i
    }
    trace add variable ::errorInfo write [namespace code EIWrite]
    catch BadProc
    trace remove variable ::errorInfo write [namespace code EIWrite]
    set cmds
} -match glob -result {*BadProc*}
    test error-7.0 {Bug 1397843} -body {
	variable cmds
	proc EIWrite args {
	    variable cmds
	    lappend cmds [lindex [info level -2] 0]
	}
	proc BadProc {} {
	    set i a
	    incr i
	}
	trace add variable ::errorInfo write [namespace code EIWrite]
	catch BadProc
	trace remove variable ::errorInfo write [namespace code EIWrite]
	set cmds
    } -match glob -result {*BadProc*}

# throw tests

test error-8.1 {throw produces error 1 at level 0} {
    catch { throw FOO bar }
} {1}
test error-8.2 {throw behaves as error does at level 0} {
    catch { throw FOO bar } em1 opts1
    catch { error bar {} FOO } em2 opts2
    dict set opts1 -result $em1
    dict set opts2 -result $em2
    foreach key {-code -level -result -errorcode} {
	if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
	    error "error/throw outcome differs on '$key'"
	}
    }
} {}
test error-8.3 {throw produces error 1 at level > 0} {
    proc throw_foo {} {
	throw FOO bar
    }
    catch { throw_foo }
} {1}
test error-8.4 {throw behaves as error does at level > 0} {
    proc throw_foo {} {
	throw FOO bar
    }
    proc error_foo {} {
	error bar {} FOO
    }
    catch { throw_foo } em1 opts1
    catch { error_foo } em2 opts2
    dict set opts1 -result $em1
    dict set opts2 -result $em2
    foreach key {-code -level -result -errorcode} {
	if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
	    error "error/throw outcome differs on '$key'"
	}
    }
} {}
test error-8.5 {throw syntax checks} -returnCodes error -body {
    throw
} -result {wrong # args: should be "throw type message"}
test error-8.6 {throw syntax checks} -returnCodes error -body {
    throw a
} -result {wrong # args: should be "throw type message"}
test error-8.7 {throw syntax checks} -returnCodes error -body {
    throw a b c
} -result {wrong # args: should be "throw type message"}
test error-8.8 {throw syntax checks} -returnCodes error -body {
    throw "not a \{ list" foo
} -result {unmatched open brace in list}
test error-8.9 {throw syntax checks} -returnCodes error -body {
    throw {} foo
} -result {type must be non-empty list}
test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body {
    apply {code {throw $code foo}} {}
} -result {type must be non-empty list}
test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error  -body {
    throw {not {}a list} x[]y
} -result {list element in braces followed by "a" instead of space}

# simple try tests: body completes with code ok

test error-9.1 {try (ok, empty result) with no handlers} {
    try list
} {}
test error-9.2 {try (ok, non-empty result) with no handlers} {
    try { list a b c }
} {a b c}
test error-9.3 {try (ok, non-empty result) with trap handler} {
    try { list a b c } trap {} {} { list d e f }
} {a b c}
test error-9.4 {try (ok, non-empty result) with on handler} {
    try { list a b c } on break {} { list d e f }
} {a b c}
test error-9.5 {try (ok, non-empty result) with on ok handler} {
    try { list a b c } on ok {} { list d e f }
} {d e f}

# simple try tests - "on" handler matching

test error-10.1 {try with on ok} {
    try { list a b c } on ok {} { list d e f }
} {d e f}
test error-10.2 {try with on 0} {
    try { list a b c } on 0 {} { list d e f }
} {d e f}
test error-10.3 {try with on error (using error)} {
    try { error a b c } on error {} { list d e f }
} {d e f}
test error-10.4 {try with on error (using return -code)} {
    try { return -level 0 -code 1 a } on error {} { list d e f }
} {d e f}
test error-10.5 {try with on error (using throw)} {
    try { throw c a } on error {} { list d e f }
} {d e f}
test error-10.6 {try with on 1 (using error)} {
    try { error a b c } on 1 {} { list d e f }
} {d e f}
test error-10.7 {try with on return} {
    try { return [list a b c] } on return {} { list d e f }
} {d e f}
test error-10.8 {try with on break} {
    try { break } on break {} { list d e f }
} {d e f}
test error-10.9 {try with on continue} {
    try { continue } on continue {} { list d e f }
} {d e f}
test error-10.10 {try with on for arbitrary (decimal) return code} {
    try { return -level 0 -code 123456 } on 123456 {} { list d e f }
} {d e f}
test error-10.11 {try with on for arbitrary (hex) return code} {
    try { return -level 0 -code 0x123456 } on 0x123456 {} { list d e f }
} {d e f}
test error-10.12 {try with on for arbitrary return code (mixed number representations)} {
    try { return -level 0 -code 0x10 } on 16 {} { list d e f }
} {d e f}

# simple try tests - "trap" handler matching

test error-11.1 {try with trap all} {
    try { throw FOO bar  } trap {} {} { list d e f }
} {d e f}
test error-11.2 {try with trap (exact)} {
    try { throw FOO bar  } trap {FOO} {} { list d e f }
} {d e f}
test error-11.3 {try with trap (prefix 1)} {
    try { throw [list FOO A B C D] bar  } trap {FOO} {} { list d e f }
} {d e f}
test error-11.4 {try with trap (prefix 2)} {
    try { throw [list FOO A B C D] bar  } trap {FOO A} {} { list d e f }
} {d e f}
test error-11.5 {try with trap (prefix 3)} {
    try { throw [list FOO A B C D] bar  } trap {FOO A B} {} { list d e f }
} {d e f}
test error-11.6 {try with trap (prefix 4)} {
    try { throw [list FOO A B C D] bar  } trap {FOO A B C} {} { list d e f }
} {d e f}
test error-11.7 {try with trap (exact, 5 elements)} {
    try { throw [list FOO A B C D] bar  } trap {FOO A B C D} {} { list d e f }
} {d e f}

# simple try tests - variable assignment and result handling

test error-12.1 {try with no variable assignment in on handler} {
    try { throw FOO bar } on error {} { list d e f }
} {d e f}
test error-12.2 {try with result variable assignment in on handler} {
    try { throw FOO bar } on error {res} { set res }
} {bar}
test error-12.3 {try with result variable assignment in on handler, var remains in scope} {
    try { throw FOO bar } on error {res} { list d e f }
    set res
} {bar}
test error-12.4 {try with result/opts variable assignment in on handler} {
    try {
	throw FOO bar
    } on error {res opts} {
	set r "$res,[dict get $opts -errorcode]"
    }
} {bar,FOO}
test error-12.5 {try with result/opts variable assignment in on handler, vars remain in scope} {
    try { throw FOO bar } on error {res opts} { list d e f }
    set r "$res,[dict get $opts -errorcode]"
} {bar,FOO}
test error-12.6 {try result is propagated if no matching handler} {
    try { list a b c } on error {} { list d e f }
} {a b c}
test error-12.7 {handler result is propagated if handler executes} {
    try { throw FOO bar } on error {} { list d e f }
} {d e f}

# negative case try tests - bad args to try

test error-13.1 {try with no arguments} -body {
    # warning: error message may change
    try
} -returnCodes error -match glob -result {wrong # args: *}
test error-13.2 {try with body only (ok)} {
    try list
} {}
test error-13.3 {try with missing finally body} -body {
    # warning: error message may change
    try list finally
} -returnCodes error -match glob -result {wrong # args to finally clause: *}
test error-13.4 {try with bad handler keyword} -body {
    # warning: error message may change
    try list then a b c
} -returnCodes error -match glob -result {bad handler *}
test error-13.5 {try with partial handler #1} -body {
    # warning: error message may change
    try list on
} -returnCodes error -match glob -result {wrong # args to on clause: *}
test error-13.6 {try with partial handler #2} -body {
    # warning: error message may change
    try list on error
} -returnCodes error -match glob -result {wrong # args to on clause: *}
test error-13.7 {try with partial handler #3} -body {
    # warning: error message may change
    try list on error {em opts}
} -returnCodes error -match glob -result {wrong # args to on clause: *}
test error-13.8 {try with multiple handlers and finally (ok)} {
    try list on error {} {} trap {} {} {} finally {}
} {}
test error-13.9 {last handler body can't be a fallthrough #1} -body {
    try list on error {} {} on break {} -
} -returnCodes error -result {last non-finally clause must not have a body of "-"}
test error-13.10 {last handler body can't be a fallthrough #2} -body {
    try list on error {} {} on break {} - finally { list d e f }
} -returnCodes error -result {last non-finally clause must not have a body of "-"}

# try tests - multiple handlers (left-to-right matching, only one runs)

test error-14.1 {try with multiple handlers (only one matches) #1} {
    try { throw FOO bar } on ok {} { list a b c } trap FOO {} { list d e f }
} {d e f}
test error-14.2 {try with multiple handlers (only one matches) #2} {
    try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c }
} {d e f}
test error-14.3 {try with multiple handlers (only one matches) #3} {
    try {
	throw FOO bar
    } on break {} {
	list x y z
    } trap FOO {} {
	list d e f
    } on ok {} {
	list a b c
    }
} {d e f}
test error-14.4 {try with multiple matching handlers (only the first in left-to-right order runs) #1} {
    try { throw FOO bar } on error {} { list a b c } trap FOO {} { list d e f }
} {a b c}
test error-14.5 {try with multiple matching handlers (only the first in left-to-right order runs) #2} {
    try { throw FOO bar } trap FOO {} { list d e f } on error {} { list a b c }
} {d e f}
test error-14.6 {try with multiple matching handlers (only the first in left-to-right order runs) #3} {
    try { throw FOO bar } trap {} {} { list d e f } on 1 {} { list a b c }
} {d e f}
test error-14.7 {try with multiple matching handlers (only the first in left-to-right order runs) #4} {
    try { throw FOO bar } on 1 {} { list a b c } trap {} {} { list d e f }
} {a b c}
test error-14.8 {try with handler-of-last-resort "trap {}"} {
    try { throw FOO bar } trap FOX {} { list a b c } trap {} {} { list d e f }
} {d e f}
test error-14.9 {try with handler-of-last-resort "on error"} {
    try { foo } trap FOX {} { list a b c } on error {} { list d e f }
} {d e f}

# try tests - propagation (no matching handlers)

test error-15.1 {try with no handler (ok result propagates)} {
    try { list a b c }
} {a b c}
test error-15.2 {try with no matching handler (ok result propagates)} {
    try { list a b c } on error {} { list d e f }
} {a b c}
test error-15.3 {try with no handler (error result propagates)} -body {
    try { throw FOO bar }
} -returnCodes error -result {bar}
test error-15.4 {try with no matching handler (error result propagates)} -body {
    try { throw FOO bar } trap FOX {} { list a b c }
} -returnCodes error -result {bar}
test error-15.5 {try with no handler (return result propagates)} -body {
    try { return bar }
} -returnCodes 2 -result {bar}
test error-15.6 {try with no matching handler (break result propagates)} -body {
    try { if {1} break } on error {} { list a b c }
} -returnCodes 3 -result {}
test error-15.7 {try with no matching handler (unknown integer result propagates)} -body {
    try { return -level 0 -code 123456 } trap {} {} { list a b c }
} -returnCodes 123456 -result {}

foreach level {0 1 2 3} {
    foreach code {0 1 2 3 4 5} {

	# Following cases have different -errorinfo; avoid false alarms
	# TODO: examine whether these difference are as they ought to be.
	if {$level == 0 && $code == 1} continue

	foreach extras {{} {-bar soom}} {

test error-15.8.$level.$code.[llength $extras] {[try] coverage} {
    set script {return -level $level -code $code {*}$extras foo}
    catch $script m1 o1
    catch {try $script} m2 o2
    set o1 [lsort -stride 2 $o1]
    set o2 [lsort -stride 2 $o2]
    expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
} ok

test error-15.9.$level.$code.[llength $extras] {[try] coverage} {
    set script {return -level $level -code $code {*}$extras foo}
    catch $script m1 o1
    catch {try $script finally {}} m2 o2
    set o1 [lsort -stride 2 $o1]
    set o2 [lsort -stride 2 $o2]
    expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
} ok

test error-15.10.$level.$code.[llength $extras] {[try] coverage} {
    set script {return -level $level -code $code {*}$extras foo}
    catch $script m1 o1
    catch {try $script on $code {x y} {return -options $y $x}} m2 o2
    set o1 [lsort -stride 2 $o1]
    set o2 [lsort -stride 2 $o2]
    expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
} ok

	}
    }
}

# try tests - propagation (exceptions in handlers, exception chaining)

test error-16.1 {try with successfully executed handler} {
    try { throw FOO bar } trap FOO {} { list a b c }
} {a b c}
test error-16.2 {try with exception (error) in handler} -body {
    try { throw FOO bar } trap FOO {} { throw BAR foo }
} -returnCodes error -result {foo}
test error-16.3 {try with exception (return) in handler} -body {
    try { throw FOO bar } trap FOO {} { return BAR }
} -returnCodes 2 -result {BAR}
test error-16.4 {try with exception (break) in handler #1} -body {
    try { throw FOO bar } trap FOO {} { break }
} -returnCodes 3 -result {}
test error-16.5 {try with exception (break) in handler #2} {
    for { set i 5 } { $i < 10 } { incr i } {
	try { throw FOO bar } trap FOO {} { break }
    }
    set i
} {5}
test error-16.6 {try with variable assignment and propagation #1} {
    # Ensure that the handler variables preserve the exception off the
    # try-body, and are not modified by the exception off the handler
    catch {
	try { throw FOO bar } trap FOO {em} { throw BAR baz }
    }
    set em
} {bar}
test error-16.7 {try with variable assignment and propagation #2} {
    catch {
	try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}
test error-16.8 {exception chaining (try=ok, handler=error)} -body {
    #FIXME is the intent of this test correct?
    catch {
	try { list a b c } on ok {em opts} { throw BAR baz }
    } tryem tryopts
    list $opts [dict get $tryopts -during]
} -match pairwise -result equal
test error-16.9 {exception chaining (try=error, handler=error)} -body {
    # The exception off the handler should chain to the exception off the
    # try-body (using the -during option)
    catch {
	try { throw FOO bar } trap {} {em opts} { throw BAR baz }
    } tryem tryopts
    list $opts [dict get $tryopts -during]
} -match pairwise -result equal
test error-16.10 {no exception chaining when handler is successful} {
    catch {
	try { throw FOO bar } trap {} {em opts} { list d e f }
    } tryem tryopts
    dict exists $tryopts -during
} {0}
test error-16.11 {no exception chaining when handler is a non-error exception} {
    catch {
	try { throw FOO bar } trap {} {em opts} { break }
    } tryem tryopts
    dict exists $tryopts -during
} {0}
test error-16.12 {compiled try with successfully executed handler} {
    apply {{} {
	try { throw FOO bar } trap FOO {} { list a b c }
    }}
} {a b c}
test error-16.13 {compiled try with exception (error) in handler} -body {
    apply {{} {
	try { throw FOO bar } trap FOO {} { throw BAR foo }
    }}
} -returnCodes error -result {foo}
test error-16.14 {compiled try with exception (return) in handler} -body {
    apply {{} {
	list [catch {
	    try { throw FOO bar } trap FOO {} { return BAR }
	} msg] $msg
    }}
} -result {2 BAR}
test error-16.15 {compiled try with exception (break) in handler} {
    apply {{} {
	for { set i 5 } { $i < 10 } { incr i } {
	    try { throw FOO bar } trap FOO {} { break }
	}
	return $i
    }}
} {5}
test error-16.16 {compiled try with exception (continue) in handler} {
    apply {{} {
	for { set i 5 } { $i < 10 } { incr i } {
	    try { throw FOO bar } trap FOO {} { continue }
	    incr i 20
	}
	return $i
    }}
} {10}
test error-16.17 {compiled try with variable assignment and propagation #1} {
    # Ensure that the handler variables preserve the exception off the
    # try-body, and are not modified by the exception off the handler
    apply {{} {
	catch {
	    try { throw FOO bar } trap FOO {em} { throw BAR baz }
	}
	return $em
    }}
} {bar}
test error-16.18 {compiled try with variable assignment and propagation #2} {
    apply {{} {
	catch {
	    try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
	}
	list $em [dict get $opts -errorcode]
    }}
} {bar FOO}
test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body {
    #FIXME is the intent of this test correct?
    apply {{} {
	catch {
	    try { list a b c } on ok {em opts} { throw BAR baz }
	} tryem tryopts
	list $opts [dict get $tryopts -during]
    }}
} -match pairwise -result equal
test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body {
    # The exception off the handler should chain to the exception off the
    # try-body (using the -during option)
    apply {{} {
	catch {
	    try { throw FOO bar } trap {} {em opts} { throw BAR baz }
	} tryem tryopts
	list $opts [dict get $tryopts -during]
    }}
} -match pairwise -result equal
test error-16.21 {compiled try exception chaining (try=error, finally=error)} {
    # The exception off the handler should chain to the exception off the
    # try-body (using the -during option)
    apply {{} {
	catch {
	    try { throw FOO bar } finally { throw BAR baz }
	} tryem tryopts
	dict get $tryopts -during -errorcode
    }}
} FOO
test error-16.22 {compiled try: no exception chaining when handler is successful} {
    apply {{} {
	catch {
	    try { throw FOO bar } trap {} {em opts} { list d e f }
	} tryem tryopts
	dict exists $tryopts -during
    }}
} {0}
test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} {
    apply {{} {
	catch {
	    try { throw FOO bar } trap {} {em opts} { break }
	} tryem tryopts
	dict exists $tryopts -during
    }}
} {0}
test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body {
    apply {{} {
	catch {
	    try {
		list a b c
	    } on ok {em opts} {
		throw BAR baz
	    } finally {
		throw DING dong
	    }
	} tryem tryopts
	list $opts [dict get $tryopts -during -during]
    }}
} -match pairwise -result equal
test error-16.25 {compiled try exception chaining (all errors)} -body {
    apply {{} {
	catch {
	    try {
		throw FOO bar
	    } on error {em opts} {
		throw BAR baz
	    } finally {
		throw DING dong
	    }
	} tryem tryopts
	list $opts [dict get $tryopts -during -during]
    }}
} -match pairwise -result equal

# try tests - finally

test error-17.1 {finally always runs (try with ok result)} {
    set RES {}
    try { list a b c } finally { set RES done }
    set RES
} {done}
test error-17.2 {finally always runs (try with error result)} {
    set RES {}
    catch {
	try { throw FOO bar } finally { set RES done }
    }
    set RES
} {done}
test error-17.3 {finally always runs (try with matching handler)} {
    set RES {}
    try { throw FOO bar } trap FOO {} { list a b c } finally { set RES done }
    set RES
} {done}
test error-17.4 {finally always runs (try with exception in handler)} {
    set RES {}
    catch {
	try {
	    throw FOO bar
	} trap FOO {} {
	    throw BAR baz
	} finally {
	    set RES done
	}
    }
    set RES
} {done}
test error-17.5 {successful finally doesn't modify try outcome (try=ok)} {
    try { list a b c } finally { list d e f }
} {a b c}
test error-17.6 {successful finally doesn't modify try outcome (try=return)} -body {
    try { return c } finally { list d e f }
} -returnCodes 2 -result {c}
test error-17.7 {successful finally doesn't modify try outcome (try=error)} -body {
    try { error bar } finally { list d e f }
} -returnCodes 1 -result {bar}
test error-17.8 {successful finally doesn't modify handler outcome (handler=ok)} {
    try { throw FOO bar } trap FOO {} { list a b c } finally { list d e f }
} {a b c}
test error-17.9 {successful finally doesn't modify handler outcome (handler=error)} -body {
    try { throw FOO bar } trap FOO {} { throw BAR baz } finally { list d e f }
} -returnCodes error -result {baz}
test error-17.10 {successful finally doesn't affect variable assignment} {
    catch {
	try { throw FOO bar } trap FOO {em opts} { list d e f } finally { list d e f }
    } result
    list $em $result
} {bar {d e f}}
test error-17.11 {successful finally doesn't affect variable assignment or propagation} {
    catch {
	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f }
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}

# try tests - propagation (exceptions in finally, exception chaining)

test error-18.1 {try (ok) with exception in finally (error)} -body {
    try { list a b c } finally { throw BAR foo }
} -returnCodes error -result {foo}
test error-18.2 {try (error) with exception in finally (break)} -body {
    try { throw FOO bar } finally { break }
} -returnCodes 3 -result {}
test error-18.3 {try (ok) with handler (ok) and exception in finally (error)} -body {
    try { list a b c } on ok {} { list d e f } finally { throw BAR foo }
} -returnCodes error -result {foo}
test error-18.4 {try (error) with exception in handler (error) and in finally (arb code)} -body {
    try { throw FOO bar } on error {} { throw BAR baz } finally { return -level 0 -code 99 zing }
} -returnCodes 99 -result {zing}
test error-18.5 {exception in finally doesn't affect variable assignment} {
    catch {
	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { throw BAZ zing }
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}
test error-18.6 {exception chaining in finally (try=ok)} -body {
    catch {
	list a b c
    } em expopts
    catch {
	try { list a b c } finally { throw BAR foo }
    } em opts
    list $expopts [dict get $opts -during]
} -match pairwise -result equal
test error-18.7 {exception chaining in finally (try=error)} {
    catch {
	try { throw FOO bar } finally { throw BAR baz }
    } em opts
    dict get $opts -during -errorcode
} {FOO}
test error-18.8 {exception chaining in finally (try=ok, handler=ok)} {
    catch {
	try { list a b c } on ok {} { list d e f } finally { throw BAR baz }
    } em opts
    list [dict get $opts -during -code] [dict exists $opts -during -during]
} {0 0}
test error-18.9 {exception chaining in finally (try=error, handler=ok)} {
    catch {
	try {
	    throw FOO bar
	} on error {} {
	    list d e f
	} finally {
	    throw BAR baz
	}
    } em opts
    list [dict get $opts -during -code] [dict exists $opts -during -during]
} {0 0}
test error-18.10 {exception chaining in finally (try=error, handler=error)} {
    catch {
	try {
	    throw FOO bar
	} on error {} {
	    throw BAR baz
	} finally {
	    throw BAR baz
	}
    } em opts
    list [dict get $opts -during -errorcode] [dict get $opts -during -during -errorcode]
} {BAR FOO}
test error-18.11 {no exception chaining if finally produces a non-error exception} {
    catch {
	try { throw FOO bar } on error {} { throw BAR baz } finally { break }
    } em opts
    dict exists $opts -during
} {0}
test error-18.12 {variable assignment unaffected by exception in finally} {
    catch {
	try {
	    throw FOO bar
	} on error {em opts} {
	    list a b c
	} finally {
	    throw BAR baz
	}
    }
    list $em [dict get $opts -errorcode]
} {bar FOO}

# try tests - fallthough body cases

test error-19.1 {try with fallthrough body #1} {
    set RES {}
    try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 }
    set RES
} {1}
test error-19.2 {try with fallthrough body #2} {
    set RES {}
    try {
	throw FOO bar
    } trap BAR {} {
    } trap FOO {} - trap {} {} {
	set RES foo
    } on error {} {
	set RES err
    }
    set RES
} {foo}
test error-19.3 {try with cascade fallthrough} {
    set RES {}
    try {
	throw FOO bar
    } trap FOO {} - trap BAR {} - trap {} {} {
	set RES trap
    } on error {} { set RES err }
    set RES
} {trap}
test error-19.4 {multiple unrelated fallthroughs #1} {
    set RES {}
    try {
	throw FOO bar
    } trap FOO {} - trap BAR {} {
	set RES foo
    } trap {} {} - on error {} {
	set RES err
    }
    set RES
} {foo}
test error-19.5 {multiple unrelated fallthroughs #2} {
    set RES {}
    try {
	throw BAZ zing
    } trap FOO {} - trap BAR {} {
	set RES foo
    } trap {} {} - on error {} {
	set RES err
    }
    set RES
} {err}
proc addmsg msg {
    variable RES
    lappend RES $msg
}
test error-19.6 {compiled try executes all clauses} -setup {
    set RES {}
} -body {
    apply {{} {
	try {
	    addmsg a
	    throw bar hello
	} trap bar {res opt} {
	    addmsg b
	} finally {
	    addmsg c
	}
	addmsg d
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {a b c d}
test error-19.7 {compiled try executes all clauses} -setup {
    set RES {}
} -body {
    apply {{} {
	try {
	    addmsg a
	} on error {res opt} {
	    addmsg b
	} on ok {} {
	    addmsg c
	} finally {
	    addmsg d
	}
	addmsg e
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {a c d e}
test error-19.8 {compiled try executes all clauses} -setup {
    set RES {}
} -body {
    apply {{} {
	try {
	    addmsg a
	    throw bar hello
	} trap bar {res opt} {
	    addmsg b
	}
	addmsg c
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {a b c}
test error-19.9 {compiled try executes all clauses} -setup {
    set RES {}
} -body {
    apply {{} {
	try {
	    addmsg a
	} on error {res opt} {
	    addmsg b
	} on ok {} {
	    addmsg c
	}
	addmsg d
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {a c d}
test error-19.10 {compiled try with chained clauses} -setup {
    set RES {}
} -body {
    list [apply {{} {
	try {
	    return good
	} on return {res} - on ok {res} {
	    addmsg ok
	    addmsg $res
	    return handler
	} finally {
	    addmsg finally
	}
    } ::tcl::test::error}] $RES
} -cleanup {
    unset RES
} -result {handler {ok good finally}}
test error-19.11 {compiled try and errors on variable write} -setup {
    set RES {}
} -body {
    apply {{} {
	array set foo {bar boo}
	set bar unset
	catch {
	    try {
		addmsg body
		return a
	    } on return {bar foo} {
		addmsg handler
		return b
	    } finally {
		addmsg finally,$bar
	    }
	} msg
	addmsg $msg
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {body finally,a {can't set "foo": variable is array}}
test error-19.12 {interpreted try and errors on variable write} -setup {
    set RES {}
} -body {
    apply {try {
	array set foo {bar boo}
	set bar unset
	catch {
	    $try {
		addmsg body
		return a
	    } on return {bar foo} {
		addmsg handler
		return b
	    } finally {
		addmsg finally,$bar
	    }
	} msg
	addmsg $msg
    } ::tcl::test::error} try
} -cleanup {
    unset RES
} -result {body finally,a {can't set "foo": variable is array}}
test error-19.13 {compiled try and errors on variable write} -setup {
    set RES {}
} -body {
    apply {{} {
	array set foo {bar boo}
	set bar unset
	catch {
	    try {
		addmsg body
		return a
	    } on return {bar foo} - on error {bar foo} {
		addmsg handler
		return b
	    } finally {
		addmsg finally,$bar
	    }
	} msg
	addmsg $msg
    } ::tcl::test::error}
} -cleanup {
    unset RES
} -result {body finally,a {can't set "foo": variable is array}}
rename addmsg {}

# FIXME test what vars get set on fallthough ... what is the correct behavior?
# It would seem appropriate to set at least those for the matching handler and
# the executed body; possibly for each handler we fall through as well?

# negative case try tests - bad "on" handler

test error-20.1 {bad code name in on handler} -body {
    try { list a b c } on err {} {}
} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
test error-20.2 {bad code value in on handler} -body {
    try { list a b c } on 34985723094872345 {} {}
} -returnCodes error -match glob -result {bad completion code "34985723094872345": must be ok, error, return, break, continue*, or an integer}

test error-21.1 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {string repeat x 10} on ok {} {}
    }
} 0
test error-21.2 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {error [string repeat x 10]} on error {} {}
    }
} 0
test error-21.3 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {throw FOO [string repeat x 10]} trap FOO {} {}
    }
} 0
test error-21.4 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {string repeat x 10}
    }
} 0
test error-21.5 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {string repeat x 10} on ok {} {} finally {string repeat y 10}
    }
} 0
test error-21.6 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {
	    error [string repeat x 10]
	} on error {} {} finally {
	    string repeat y 10
	}
    }
} 0
test error-21.7 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {
	    throw FOO [string repeat x 10]
	} trap FOO {} {} finally {
	    string repeat y 10
	}
    }
} 0
test error-21.8 {memory leaks in try: Bug 2910044} memory {
    leaktest {
	try {string repeat x 10} finally {string repeat y 10}
    }
} 0

test error-21.9 {Bug cee90e4e88} {
    # Just don't panic.
    apply {{} {try {} on ok {} - on return {} {}}}
} {}


# negative case try tests - bad "trap" handler
# what is the effect if we attempt to trap an errorcode that is not a list?
# nested try
# catch inside try
# no tests for bad varslist?
# -errorcode but code!=1 doesn't trap
# throw negative case tests (no args, too many args, etc)

}
namespace delete ::tcl::test::error

# cleanup
catch {rename p ""}
::tcltest::cleanupTests
return
return 

# Local Variables:
# mode: tcl
# End:

Changes to tests/eval.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+


-
+







# Commands covered:  eval
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


test eval-1.1 {single argument} {
    eval {format 22}
} 22
test eval-1.2 {multiple arguments} {
    set a {$b}
    set b xyzzy
    eval format $a
74
75
76
77
78
79
80
81

82
83
84
85
86
87
88
89
74
75
76
77
78
79
80

81
82
83
84












-
+



-
-
-
-
-
    set cmd2 [list 2 3 4 5]
    # Force existance of utf-8 rep
    set dummy($cmd) $cmd
    set dummy($cmd2) $cmd2
    unset dummy
    eval $cmd $cmd2
} {1 2 3 4 5}


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/event.test.

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
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

-
-
-
+
+
+







-
+

-
-
-
-
-
-
-




-
-

-
+

-
-



+


-




-

+
-
-
+
+
-
-
-
-
-
+
+
+



+







-

+
-
-
+
+

-
-




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-

-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
+


+






-

+
-
+

-
+

-



-
+
-

+
-
+

-
+
+


-
-



+









-

+
-
-
+
+
+


-









-

+
-
+


-
+

-









+
-
-
+
+
-
-
+






-
+

-









-
-

+
-
+







# This file contains a collection of tests for the procedures in the file
# tclEvent.c, which includes the "update", and "vwait" Tcl commands.  Sourcing
# this file into Tcl runs the tests and generates output for errors.  No
# output means no errors were found.
# tclEvent.c, which includes the "update", and "vwait" Tcl
# commands.  Sourcing this file into Tcl runs the tests and generates
# output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# 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.

package require tcltest 2.5
package require tcltest 2
namespace import -force ::tcltest::*

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}


testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [info commands testfilewait]]
testConstraint exec [llength [info commands exec]]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]

test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
    testfilehandler close
    set result ""
} -constraints {testfilehandler notOSX} -body {
    testfilehandler create 0 readable off
    testfilehandler clear 0
    testfilehandler oneevent
    set result ""
    lappend result [testfilehandler counts 0]
    testfilehandler fillpartial 0
    update idletasks
    testfilehandler oneevent
    lappend result [testfilehandler counts 0]
    testfilehandler oneevent
    lappend result [testfilehandler counts 0]
} -cleanup {
    testfilehandler close
    set result
} -result {{0 0} {1 0} {2 0}}
test event-1.2 {Tcl_CreateFileHandler, writing} -setup {
} {{0 0} {1 0} {2 0}}
test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
    testfilehandler close
    set result ""
} -constraints {testfilehandler nonPortable} -body {
    # This test is non-portable because on some systems (e.g., SunOS 4.1.3)
    # pipes seem to be writable always.
    # This test is non-portable because on some systems (e.g.
    # SunOS 4.1.3) pipes seem to be writable always.
    testfilehandler close
    testfilehandler create 0 off writable
    testfilehandler clear 0
    testfilehandler oneevent
    set result ""
    lappend result [testfilehandler counts 0]
    testfilehandler fillpartial 0
    testfilehandler oneevent
    lappend result [testfilehandler counts 0]
    testfilehandler fill 0
    testfilehandler oneevent
    lappend result [testfilehandler counts 0]
} -cleanup {
    testfilehandler close
    set result
} -result {{0 1} {0 2} {0 2}}
test event-1.3 {Tcl_DeleteFileHandler} -setup {
} {{0 1} {0 2} {0 2}}
test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
    testfilehandler close
    set result ""
} -constraints {testfilehandler nonPortable} -body {
    testfilehandler create 2 disabled disabled
    testfilehandler create 1 readable writable
    testfilehandler create 0 disabled disabled
    testfilehandler fillpartial 1
    set result ""
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler create 1 off off
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler close
    set result
} {{0 1} {1 1} {1 2} {0 0}}

test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
    testfilehandler close
    testfilehandler create 2 disabled disabled
    testfilehandler create 1 readable writable
    testfilehandler fillpartial 1
    set result ""
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler create 1 off off
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
} -cleanup {
    testfilehandler close
} -result {{0 1} {1 1} {1 2} {0 0}}

test event-2.1 {Tcl_DeleteFileHandler} -setup {
    testfilehandler close
    set result ""
    set result
} -constraints {testfilehandler nonPortable} -body {
    testfilehandler create 2 disabled disabled
    testfilehandler create 1 readable writable
    testfilehandler fillpartial 1
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler create 1 off off
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
} -cleanup {
    testfilehandler close
} -result {{0 1} {1 1} {1 2} {0 0}}
test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} -setup {
    testfilehandler close
} {{0 1} {1 1} {1 2} {0 0}}
test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
	{testfilehandler nonPortable} {
    set result ""
} -constraints {testfilehandler nonPortable} -body {
    testfilehandler close
    testfilehandler create 0 readable writable
    testfilehandler fillpartial 0
    set result ""
    testfilehandler oneevent
    lappend result [testfilehandler counts 0]
    testfilehandler close
    testfilehandler create 0 readable writable
    testfilehandler oneevent
    lappend result [testfilehandler counts 0]
} -cleanup {
    testfilehandler close
    set result
} -result {{0 1} {0 0}}
} {{0 1} {0 0}}

test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off} -setup {
test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
    testfilehandler close
} -constraints {testfilehandler} -body {
    testfilehandler create 1 readable writable
    testfilehandler fillpartial 1
    testfilehandler windowevent
    testfilehandler counts 1
    set result [testfilehandler counts 1]
} -cleanup {
    testfilehandler close
    set result
} -result {0 0}
} {0 0}

test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup {
test event-4.1 {FileHandlerEventProc, race between event and disabling} \
	{testfilehandler nonPortable} {
    update
    testfilehandler close
    set result ""
} -constraints {testfilehandler nonPortable} -body {
    testfilehandler create 2 disabled disabled
    testfilehandler create 1 readable writable
    testfilehandler fillpartial 1
    set result ""
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
    testfilehandler create 1 disabled disabled
    testfilehandler oneevent
    lappend result [testfilehandler counts 1]
} -cleanup {
    testfilehandler close
    set result
} -result {{0 1} {1 1} {1 2} {0 0}}
test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup {
} {{0 1} {1 1} {1 2} {0 0}}
test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
	{testfilehandler nonPortable} {
    update
    testfilehandler close
} -constraints {testfilehandler nonPortable} -body {
    testfilehandler create 1 readable writable
    testfilehandler create 2 readable writable
    testfilehandler fillpartial 1
    testfilehandler fillpartial 2
    testfilehandler oneevent
    set result ""
    lappend result [testfilehandler counts 1] [testfilehandler counts 2]
    testfilehandler windowevent
    lappend result [testfilehandler counts 1] [testfilehandler counts 2]
} -cleanup {
    testfilehandler close
    set result
} -result {{0 0} {0 1} {0 0} {0 1}}
} {{0 0} {0 1} {0 0} {0 1}}
update

test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
    catch {rename bgerror {}}
} -body {
    proc bgerror msg {
	global errorInfo errorCode x
	lappend x [list $msg $errorInfo $errorCode]
    }
    after idle {error "a simple error"}
    after idle {open non_existent}
    after idle {set errorInfo foobar; set errorCode xyzzy}
    set x {}
    update idletasks
    rename bgerror {}
    regsub -all [file join {} non_existent] $x "non_existent"
} -cleanup {
    regsub -all [file join {} non_existent] $x "non_existent" x
    set x
    rename bgerror {}
} -result {{{a simple error} {a simple error
} {{{a simple error} {a simple error
    while executing
"error "a simple error""
    ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    ("after" script)} {POSIX ENOENT {no such file or directory}}}}
test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
    catch {rename bgerror {}}
} -body {
    proc bgerror msg {
	global x
	lappend x $msg
	return -code break
    }
    after idle {error "a simple error"}
    after idle {open non_existent}
    set x {}
    update idletasks
    return $x
} -cleanup {
    rename bgerror {}
    set x
} -result {{a simple error}}
} {{a simple error}}
test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup {
    variable x
    proc demo args {variable x done}
    variable target [list [namespace which demo] x]
    proc trial args {variable target; string length $target}
    trace add execution demo enter [namespace code trial]
    variable save [interp bgerror {}]
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
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
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
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
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
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
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







-
+



-
-

-
-
+
+
+



-
-

+
-
-
+
+



-
-

+
-
-
+
+



-
-

+
-
-
+
+



-
-

+
-
-
+
+



-
-

+
-
+

-
+



-


















-
-

+
-
+





-
-
+
+


-
-
+
+

+



-
-
+
+





-
+

+



-
-
-
+
+
+





-
+

+
-
+




-
-
+
+


-
-
+
+



-
-

+
-
-
-
+
+
+
+
+
+




-
+
+
+


-
-
+
+
+


-






-
-

-
+
+






+
-
+


-







-
-

-
+
+







+
-
-
-
-
-
+
+
+
+
+
+



+



-





-
+







-






-
+






-






-
-
+
+





-






-
+






-





-
+










-
-
-
-
-
-
-
+
+
+
+
+
+
+

-

-
-
-
+
+
+




-









+
-
-
-
-
-
-
+
+
+
+
+
+

-





-
+

-
+











-
-

+
-
+







} -returnCodes error -match glob -result {*expected integer*}
test event-5.8 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {} {-level 0}
} -returnCodes error -match glob -result {*-code*}
test event-5.9 {Default [interp bgerror] handler} -body {
    ::tcl::Bgerror {} {-level 0 -code ok}
} -returnCodes error -match glob -result {*expected integer*}
test event-5.10 {Default [interp bgerror] handler} -body {
test event-5.10 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror {} {-level 0 -code 0}
    return $::res
} -cleanup {
    rename bgerror {}
} -result {}
test event-5.11 {Default [interp bgerror] handler} -body {
    set ::res
} {}
test event-5.11 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 1}
    return $::res
} -cleanup {
    rename bgerror {}
    set ::res
} -result {msg}
test event-5.12 {Default [interp bgerror] handler} -body {
} {msg}
test event-5.12 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 2}
    return $::res
} -cleanup {
    rename bgerror {}
    set ::res
} -result {command returned bad code: 2}
test event-5.13 {Default [interp bgerror] handler} -body {
} {command returned bad code: 2}
test event-5.13 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 3}
    return $::res
} -cleanup {
    rename bgerror {}
    set ::res
} -result {invoked "break" outside of a loop}
test event-5.14 {Default [interp bgerror] handler} -body {
} {invoked "break" outside of a loop}
test event-5.14 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 4}
    return $::res
} -cleanup {
    rename bgerror {}
    set ::res
} -result {invoked "continue" outside of a loop}
test event-5.15 {Default [interp bgerror] handler} -body {
} {invoked "continue" outside of a loop}
test event-5.15 {Default [interp bgerror] handler} {
    proc bgerror {m} {append ::res $m}
    set ::res {}
    ::tcl::Bgerror msg {-level 0 -code 5}
    return $::res
} -cleanup {
    rename bgerror {}
    set ::res
} -result {command returned bad code: 5}
} {command returned bad code: 5}

test event-6.1 {BgErrorDeleteProc procedure} -setup {
test event-6.1 {BgErrorDeleteProc procedure} {
    catch {interp delete foo}
    interp create foo
    set erroutfile [makeFile Unmodified err.out]
} -body {
    foo eval [list set erroutfile $erroutfile]
    foo eval {
	proc bgerror args {
	    global errorInfo erroutfile
	    set f [open $erroutfile r+]
	    seek $f 0 end
	    puts $f "$args $errorInfo"
	    close $f
	}
	after 100 {error "first error"}
	after 100 {error "second error"}
    }
    after 100 {interp delete foo}
    after 200
    update
    set f [open $erroutfile r]
    set result [read $f]
    close $f
    return $result
} -cleanup {
    removeFile $erroutfile
    set result
} -result {Unmodified
} {Unmodified
}

test event-7.1 {bgerror / regular} {
    set errRes {}
    proc bgerror {err} {
	global errRes
	set errRes $err
	global errRes;
	set errRes $err;
    }
    after 0 {error err1}
    vwait errRes
    return $errRes
    vwait errRes;
    set errRes;
} err1

test event-7.2 {bgerror / accumulation} {
    set errRes {}
    proc bgerror {err} {
	global errRes
	lappend errRes $err
	global errRes;
	lappend errRes $err;
    }
    after 0 {error err1}
    after 0 {error err2}
    after 0 {error err3}
    update
    return $errRes
    set errRes;
} {err1 err2 err3}

test event-7.3 {bgerror / accumulation / break} {
    set errRes {}
    proc bgerror {err} {
	global errRes
	lappend errRes $err
	return -code break "skip!"
	global errRes;
	lappend errRes $err;
	return -code break "skip!";
    }
    after 0 {error err1}
    after 0 {error err2}
    after 0 {error err3}
    update
    return $errRes
    set errRes;
} err1

test event-7.4 {tkerror is nothing special anymore to tcl} -body {
test event-7.4 {tkerror is nothing special anymore to tcl} {
    set errRes {}
    # we don't just rename bgerror to empty because it could then
    # be autoloaded...
    proc bgerror {err} {
	global errRes
	lappend errRes "bg:$err"
	global errRes;
	lappend errRes "bg:$err";
    }
    proc tkerror {err} {
	global errRes
	lappend errRes "tk:$err"
	global errRes;
	lappend errRes "tk:$err";
    }
    after 0 {error err1}
    update
    return $errRes
} -cleanup {
    rename tkerror {}
    set errRes
} -result bg:err1
test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} -body {
    exec [interpreter] << {
} bg:err1

testConstraint exec [llength [info commands exec]]

test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
    set script {
	after 1000 error hello
	after 2000 set a 0
	vwait a
    }
} -constraints {exec} -returnCodes error -result {hello

    list [catch {exec [interpreter] << $script} errMsg] $errMsg
} {1 {hello
    while executing
"error hello"
    ("after" script)}
test event-7.6 {safe hidden bgerror fallback} -setup {
    ("after" script)}}

test event-7.6 {safe hidden bgerror fallback} {
    variable result {}
    interp create -safe safe
} -body {
    safe alias puts puts
    safe alias result ::append [namespace which -variable result]
    safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
    safe hide bgerror
    safe eval after 0 error foo
    update
    return $result
} -cleanup {
    interp delete safe
} -result {foo
    set result
} {foo
NONE
foo
    while executing
"error foo"
    ("after" script)
}

test event-7.7 {safe hidden bgerror fallback} -setup {
test event-7.7 {safe hidden bgerror fallback} {
    variable result {}
    interp create -safe safe
} -body {
    safe alias puts puts
    safe alias result ::append [namespace which -variable result]
    safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
    safe hide bgerror
    safe eval {proc bgerror m {error bar soom baz}}
    safe eval after 0 error foo
    update
    return $result
} -cleanup {
    interp delete safe
} -result {foo
    set result
} {foo
NONE
foo
    while executing
"error foo"
    ("after" script)
}


# someday : add a test checking that when there is no bgerror, an error msg
# goes to stderr ideally one would use sub interp and transfer a fake stderr
# to it, unfortunatly the current interp tcl API does not allow that. The
# other option would be to use fork a test but it then becomes more a
# file/exec test than a bgerror test.
# someday : add a test checking that 
# when there is no bgerror, an error msg goes to stderr
# ideally one would use sub interp and transfer a fake stderr
# to it, unfortunatly the current interp tcl API does not allow
# that. the other option would be to use fork a test but it
# then becomes more a file/exec test than a bgerror test.

# end of bgerror tests
catch {rename bgerror {}}


test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
    set result
} {even 6
even 4
odd 41
}

test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 41"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
    set result
} {even 16
even 6
even 4
}
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 4"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
} {even 16
    set result
    } {even 16
even 6
odd 41
}
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 6"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
    set result
} {even 16
even 4
odd 41
}
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "testexithandler create 41; testexithandler delete 41"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
    set result
} {even 16
}

test event-10.1 {Tcl_Exit procedure} {stdio} {
    set child [open |[list [interpreter]] r+]
    puts $child "exit 3"
    list [catch {close $child} msg] $msg [lindex $::errorCode 0] \
        [lindex $::errorCode 2]
} {1 {child process exited abnormally} CHILDSTATUS 3}

test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body {
    vwait
} -result {wrong # args: should be "vwait name"}
test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body {
    vwait a b
} -result {wrong # args: should be "vwait name"}
test event-11.3 {Tcl_VwaitCmd procedure} -setup {
test event-11.1 {Tcl_VwaitCmd procedure} {
    list [catch {vwait} msg] $msg
} {1 {wrong # args: should be "vwait name"}}
test event-11.2 {Tcl_VwaitCmd procedure} {
    list [catch {vwait a b} msg] $msg
} {1 {wrong # args: should be "vwait name"}}
test event-11.3 {Tcl_VwaitCmd procedure} {
    catch {unset x}
} -body {
    set x 1
    vwait x(1)
} -returnCodes error -result {can't trace "x(1)": variable isn't array}
test event-11.4 {Tcl_VwaitCmd procedure} -setup {
    list [catch {vwait x(1)} msg] $msg
} {1 {can't trace "x(1)": variable isn't array}}
test event-11.4 {Tcl_VwaitCmd procedure} {} {
    foreach i [after info] {
	after cancel $i
    }
    after 10; update; # On Mac make sure update won't take long
} -body {
    after 100 {set x x-done}
    after 200 {set y y-done}
    after 400 {set z z-done}
    after idle {set q q-done}
    set x before
    set y before
    set z before
    set q before
    list [vwait y] $x $y $z $q
} {{} x-done y-done before q-done}
} -cleanup {
    foreach i [after info] {
	after cancel $i
    }
} -result {{} x-done y-done before q-done}
test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup {

foreach i [after info] {
    after cancel $i
}

test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
    set test1file [makeFile "" test1]
} -constraints {socket} -body {
    set f1 [open $test1file w]
    proc accept {s args} {
	puts $s foobar
	close $s
    }
    set s1 [socket -server accept -myaddr 127.0.0.1 0]
    catch {set s1 [socket -server accept -myaddr 127.0.0.1 0]}
    after 1000
    set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]
    catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
    close $s1
    set x 0
    set y 0
    set z 0
    fileevent $s2 readable {incr z}
    vwait z
    fileevent $f1 writable {incr x; if {$y == 3} {set z done}}
    fileevent $s2 readable {incr y; if {$x == 3} {set z done}}
    vwait z
    close $f1
    close $s2
    list $x $y $z
} -cleanup {
    removeFile $test1file
    list $x $y $z
} -result {3 3 done}
} {3 3 done}
test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
    set test1file [makeFile "" test1]
    set test2file [makeFile "" test2]
    set f1 [open $test1file w]
    set f2 [open $test2file w]
    set x 0
    set y 0
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
618
619
620
621
622
623







624
625
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
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
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
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
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
618
619


620
621
622
623
624




625

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
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
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
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











-
-
-

-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+



-








-
+
+



-
-
-
-
-
-










+
-
+
+



-
-
+
-
-
-
-

-
-




+

-
-
+
+



-
-
-
-
+
-

-
-




+

-
-
+
+



-
-
-
-
+
-

-
-





+

-
-
+
+
+



-
-
-
-
+
-

-
-





+

-
-
+
+
+



-
-
-
-
+
-

-
-





+

-
-
+
+



-
-
-
-
+
-

-
-




+

-
-
+
+



-
-
-
-
-
-
-


+




+

-
-
+
-
-
-
+
-






-
+


+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+






-
-
-
-
	set ::t::v 1
	namespace delete ::t
    }
    namespace eval ::t {
	vwait ::t::v
    }
} {}
test event-11.8 {Bug 16828b3744} -setup {
    oo::class create A {
	variable continue

	method start {} {
           after idle [self] destroy

           set continue 0
           vwait [namespace current]::continue
	}
	destructor {
           set continue 1
	}
    }
} -body {
    [A new] start
} -cleanup {
    A destroy
} -result {}

test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body {
    update a b
} -result {wrong # args: should be "update ?idletasks?"}
test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body {
    update bogus
} -result {bad option "bogus": must be idletasks}
test event-12.3 {Tcl_UpdateCmd procedure} -setup {
test event-12.1 {Tcl_UpdateCmd procedure} {
    list [catch {update a b} msg] $msg
} {1 {wrong # args: should be "update ?idletasks?"}}
test event-12.2 {Tcl_UpdateCmd procedure} {
    list [catch {update bogus} msg] $msg
} {1 {bad option "bogus": must be idletasks}}
test event-12.3 {Tcl_UpdateCmd procedure} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    after 500 {set x after}
    after idle {set y after}
    after idle {set z "after, y = $y"}
    set x before
    set y before
    set z before
    update idletasks
    list $x $y $z
} -cleanup {
} {before after {after, y = after}}
test event-12.4 {Tcl_UpdateCmd procedure} {
    foreach i [after info] {
	after cancel $i
    }
} -result {before after {after, y = after}}
test event-12.4 {Tcl_UpdateCmd procedure} -setup {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    after 10; update; # On Mac make sure update won't take long
    after 200 {set x x-done}
    after 600 {set y y-done}
    after idle {set z z-done}
    set x before
    set y before
    set z before
    after 300
    update
    list $x $y $z
} {x-done before z-done}
} -cleanup {

test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
    foreach i [after info] {
	after cancel $i
    }
} -result {x-done before z-done}

    after 100 set x timeout
test event-13.1 {Tcl_WaitForFile procedure, readable} -setup {
    foreach i [after info] {
	after cancel $i
    }
    testfilehandler close
} -constraints {testfilehandler} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 readable 0]
    update
    testfilehandler close
    list $result $x
} -cleanup {
    testfilehandler close
} {{} {no timeout}}
test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
} -result {{} {no timeout}}
test event-13.2 {Tcl_WaitForFile procedure, readable} -setup {
    foreach i [after info] {
	after cancel $i
    after 100 set x timeout
    }
    testfilehandler close
} -constraints testfilehandler -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 readable 100]
    update
    testfilehandler close
    list $result $x
} -cleanup {
    testfilehandler close
} {{} timeout}
test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
} -result {{} timeout}
test event-13.3 {Tcl_WaitForFile procedure, readable} -setup {
    foreach i [after info] {
	after cancel $i
    after 100 set x timeout
    }
    testfilehandler close
} -constraints testfilehandler -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    testfilehandler fillpartial 1
    set x "no timeout"
    set result [testfilehandler wait 1 readable 100]
    update
    testfilehandler close
    list $result $x
} -cleanup {
    testfilehandler close
} {readable {no timeout}}
test event-13.4 {Tcl_WaitForFile procedure, writable} \
	{testfilehandler nonPortable} {
    foreach i [after info] {
	after cancel $i
    }
} -result {readable {no timeout}}
test event-13.4 {Tcl_WaitForFile procedure, writable} -setup {
    foreach i [after info] {
	after cancel $i
    after 100 set x timeout
    }
    testfilehandler close
} -constraints {testfilehandler nonPortable} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    testfilehandler fill 1
    set x "no timeout"
    set result [testfilehandler wait 1 writable 0]
    update
    testfilehandler close
    list $result $x
} -cleanup {
    testfilehandler close
} {{} {no timeout}}
test event-13.5 {Tcl_WaitForFile procedure, writable} \
	{testfilehandler nonPortable} {
    foreach i [after info] {
	after cancel $i
    }
} -result {{} {no timeout}}
test event-13.5 {Tcl_WaitForFile procedure, writable} -setup {
    foreach i [after info] {
	after cancel $i
    after 100 set x timeout
    }
    testfilehandler close
} -constraints {testfilehandler nonPortable} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    testfilehandler fill 1
    set x "no timeout"
    set result [testfilehandler wait 1 writable 100]
    update
    testfilehandler close
    list $result $x
} -cleanup {
    testfilehandler close
} {{} timeout}
test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
} -result {{} timeout}
test event-13.6 {Tcl_WaitForFile procedure, writable} -setup {
    foreach i [after info] {
	after cancel $i
    after 100 set x timeout
    }
    testfilehandler close
} -constraints testfilehandler -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 writable 100]
    update
    testfilehandler close
    list $result $x
} -cleanup {
    testfilehandler close
} {writable {no timeout}}
test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
    foreach i [after info] {
	after cancel $i
    }
} -result {writable {no timeout}}
test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} -setup {
    foreach i [after info] {
	after cancel $i
    }
    testfilehandler close
} -constraints testfilehandler -body {
    after 100 lappend x timeout
    after idle lappend x idle
    testfilehandler close
    testfilehandler create 1 off off
    set x ""
    set result [list [testfilehandler wait 1 readable 200] $x]
    update
    testfilehandler close
    lappend result $x
} -cleanup {
    testfilehandler close
} {{} {} {timeout idle}}
    foreach i [after info] {
	after cancel $i
    }

} -result {{} {} {timeout idle}}
test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
    set f [open "|sleep 2" r]
    set result ""
    lappend result [testfilewait $f readable 100]
    lappend result [testfilewait $f readable -1]
    close $f
    return $result
    set result
} {{} readable}


test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} -setup {
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
    foreach i [after info] {after cancel $i}
    testfilehandler close
test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -body {
	foreach i [after info] {
	    after cancel $i
} -constraints {testfilehandler unix} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 readable 0]
    update
    list $result $x
} -cleanup {
	}
	after 100 set x timeout
	testfilehandler close
	testfilehandler create 1 off off
	set x "no timeout"
	set result [testfilehandler wait 1 readable 0]
	update
	testfilehandler close
	list $result $x
    } \
    -result {{} {no timeout}} \
    -cleanup {
    testfilehandler close
    foreach chan $chanList {close $chan}
    foreach i [after info] {after cancel $i}
	foreach chan $chanList {close $chan}
    }

} -result {{} {no timeout}}
test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} -setup {
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
    foreach i [after info] {after cancel $i}
    testfilehandler close
test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -body {
	foreach i [after info] {
	    after cancel $i
} -constraints {testfilehandler unix} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 readable 100]
    update
    list $result $x
} -cleanup {
	}
	after 100 set x timeout
	testfilehandler close
	testfilehandler create 1 off off
	set x "no timeout"
	set result [testfilehandler wait 1 readable 100]
	update
	testfilehandler close
	list $result $x
    } \
    -result {{} timeout} \
    -cleanup {
    testfilehandler close
    foreach chan $chanList {close $chan}
    foreach i [after info] {after cancel $i}
	foreach chan $chanList {close $chan}
    }

} -result {{} timeout}
test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} -setup {
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
    foreach i [after info] {after cancel $i}
    testfilehandler close
test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -body {
	foreach i [after info] {
	    after cancel $i
} -constraints {testfilehandler unix} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    testfilehandler fillpartial 1
    set x "no timeout"
    set result [testfilehandler wait 1 readable 100]
    update
    list $result $x
} -cleanup {
	}
	after 100 set x timeout
	testfilehandler close
	testfilehandler create 1 off off
	testfilehandler fillpartial 1
	set x "no timeout"
	set result [testfilehandler wait 1 readable 100]
	update
	testfilehandler close
	list $result $x
    } \
    -result {readable {no timeout}} \
    -cleanup {
    testfilehandler close
    foreach chan $chanList {close $chan}
    foreach i [after info] {after cancel $i}
	foreach chan $chanList {close $chan}
    }

} -result {readable {no timeout}}
test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} -setup {
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
    foreach i [after info] {after cancel $i}
    testfilehandler close
test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} \
    -constraints {testfilehandler unix nonPortable} \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -body {
	foreach i [after info] {
	    after cancel $i
} -constraints {testfilehandler unix nonPortable} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    testfilehandler fill 1
    set x "no timeout"
    set result [testfilehandler wait 1 writable 0]
    update
    list $result $x
} -cleanup {
	}
	after 100 set x timeout
	testfilehandler close
	testfilehandler create 1 off off
	testfilehandler fill 1
	set x "no timeout"
	set result [testfilehandler wait 1 writable 0]
	update
	testfilehandler close
	list $result $
    } \
    -result {{} {no timeout}} \
    -cleanup {
    testfilehandler close
    foreach chan $chanList {close $chan}
    foreach i [after info] {after cancel $i}
	foreach chan $chanList {close $chan}
    }

} -result {{} {no timeout}}
test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} -setup {
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
    foreach i [after info] {after cancel $i}
    testfilehandler close
test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} \
    -constraints {testfilehandler unix nonPortable} \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -body {
	foreach i [after info] {
	    after cancel $i
} -constraints {testfilehandler unix nonPortable} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    testfilehandler fill 1
    set x "no timeout"
    set result [testfilehandler wait 1 writable 100]
    update
    list $result $x
} -cleanup {
	}
	after 100 set x timeout
	testfilehandler close
	testfilehandler create 1 off off
	testfilehandler fill 1
	set x "no timeout"
	set result [testfilehandler wait 1 writable 100]
	update
	testfilehandler close
	list $result $x
    } \
    -result {{} timeout} \
    -cleanup {
    testfilehandler close
    foreach chan $chanList {close $chan}
    foreach i [after info] {after cancel $i}
	foreach chan $chanList {close $chan}
    }

} -result {{} timeout}
test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} -setup {
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
    foreach i [after info] {after cancel $i}
    testfilehandler close
test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -body {
	foreach i [after info] {
	    after cancel $i
} -constraints {testfilehandler unix} -body {
    after 100 set x timeout
    testfilehandler create 1 off off
    set x "no timeout"
    set result [testfilehandler wait 1 writable 100]
    update
    list $result $x
} -cleanup {
	}
	after 100 set x timeout
	testfilehandler close
	testfilehandler create 1 off off
	set x "no timeout"
	set result [testfilehandler wait 1 writable 100]
	update
	testfilehandler close
	list $result $x
    } \
    -result {writable {no timeout}} \
    -cleanup {
    testfilehandler close
    foreach chan $chanList {close $chan}
	foreach chan $chanList {close $chan}
    foreach i [after info] {after cancel $i}
} -result {writable {no timeout}}
test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} -setup {
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
    foreach i [after info] {after cancel $i}
    testfilehandler close
} -constraints {testfilehandler unix} -body {
    after 100 lappend x timeout
    after idle lappend x idle
    testfilehandler create 1 off off
    set x ""
    set result [list [testfilehandler wait 1 readable 200] $x]
    update
    lappend result $x
} -cleanup {

test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} \
    -constraints {testfilehandler unix} \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -body {
	foreach i [after info] {
	    after cancel $i
	}
	after 100 lappend x timeout
	after idle lappend x idle
	testfilehandler close
	testfilehandler create 1 off off
	set x ""
	set result [list [testfilehandler wait 1 readable 200] $x]
	update
	testfilehandler close
	lappend result $x
    } \
    -result {{} {} {timeout idle}} \
    -cleanup {
    testfilehandler close
    foreach chan $chanList {close $chan}
    foreach i [after info] {after cancel $i}
} -result {{} {} {timeout idle}}
test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} -setup {
	foreach chan $chanList {close $chan}
    }


test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} \
    set chanList {}
    for {set i 0} {$i < 32} {incr i} {
	lappend chanList [open /dev/null r]
    }
} -constraints {testfilewait unix} -body {
    set f [open "|sleep 2" r]
    set result ""
    lappend result [testfilewait $f readable 100]
    lappend result [testfilewait $f readable -1]
    close $f
    return $result
} -cleanup {
    foreach chan $chanList {close $chan}
    -constraints {testfilewait unix} \
    -body {
	set f [open "|sleep 2" r]
	set result ""
	lappend result [testfilewait $f readable 100]
	lappend result [testfilewait $f readable -1]
	close $f
	set result
    } \
    -setup {
	set chanList {}
	for {set i 0} {$i < 32} {incr i} {
	    lappend chanList [open /dev/null r]
	}
    } \
    -result {{} readable} \
    -cleanup {
	foreach chan $chanList {close $chan}
} -result {{} readable}

    }

# cleanup
foreach i [after info] {
    after cancel $i
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/exec.test.

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
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













-
-
-
-
-
-
+
+
-
-
-
-
-




-
-

















-
+




-
+









-
+














-
+




+

+

-
-
+
+



-
+







-
+




+

+

-
-
+
+







# Commands covered:  exec
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
testConstraint noosx [expr {![info exists ::env(TRAVIS_OSX_IMAGE)] || ![string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]

unset -nocomplain path

# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {
    puts -nonewline [lindex $argv 0]
    foreach str [lrange $argv 1 end] {
	puts -nonewline " $str"
    }
    puts {}
    exit
} echo]
set path(echo2) [makeFile {
    puts stdout [join $argv]
    puts stderr [lindex $argv 1]
    exit
} echo2]
set path(cat) [makeFile {
    if {$argv eq ""} {
    if {$argv == {}} {
	set argv -
    }
    fconfigure stdout -translation binary
    foreach name $argv {
	if {$name eq "-"} {
	if {$name == "-"} {
	    set f stdin
	} elseif {[catch {open $name r} f] != 0} {
	    puts stderr $f
	    continue
	}
	fconfigure $f -translation binary
	while {[eof $f] == 0} {
	    puts -nonewline [read $f]
	}
	if {$f ne "stdin"} {
	if {$f != "stdin"} {
	    close $f
	}
    }
    exit
} cat]
set path(wc) [makeFile {
    set data [read stdin]
    set lines [regsub -all "\n" $data {} dummy]
    set words [regsub -all "\[^ \t\n]+" $data {} dummy]
    set chars [string length $data]
    puts [format "%8.d%8.d%8.d" $lines $words $chars]
    exit
} wc]
set path(sh) [makeFile {
    if {[lindex $argv 0] ne "-c"} {
    if {[lindex $argv 0] != "-c"} {
	error "sh: unexpected arguments $argv"
    }
    set cmd [lindex $argv 1]
    lappend cmd ";"

    set newcmd {}

    foreach arg $cmd {
	if {$arg eq ";"} {
	    exec >@stdout 2>@stderr [info nameofexecutable] {*}$newcmd
	if {$arg == ";"} {
	    eval exec >@stdout 2>@stderr [list [info nameofexecutable]] $newcmd
	    set newcmd {}
	    continue
	}
	if {$arg eq "1>&2"} {
	if {$arg == "1>&2"} {
	    set arg >@stderr
	}
	lappend newcmd $arg
    }
    exit
} sh]
set path(sh2) [makeFile {
    if {[lindex $argv 0] ne "-c"} {
    if {[lindex $argv 0] != "-c"} {
	error "sh: unexpected arguments $argv"
    }
    set cmd [lindex $argv 1]
    lappend cmd ";"

    set newcmd {}

    foreach arg $cmd {
	if {$arg eq ";"} {
	    exec -ignorestderr >@stdout [info nameofexecutable] {*}$newcmd
	if {$arg == ";"} {
	    eval exec -ignorestderr >@stdout [list [info nameofexecutable]] $newcmd
	    set newcmd {}
	    continue
	}
	lappend newcmd $arg
    }
    exit
} sh2]
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
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







-
+



-
+









-
+







# More than 20 arguments to exec.
test exec-8.2 {long input and output} {exec} {
    exec [interpreter] $path(echo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
} {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}

# Commands that return errors.

test exec-9.1 {commands returning errors} {exec notValgrind} {
test exec-9.1 {commands returning errors} {exec} {
    set x [catch {exec gorp456} msg]
    list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.2 {commands returning errors} {exec notValgrind} {
test exec-9.2 {commands returning errors} {exec} {
    string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.3 {commands returning errors} -constraints {exec stdio} -body {
    exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1
} -returnCodes error -result {child process exited abnormally}
test exec-9.4 {commands returning errors} -constraints {exec stdio} -body {
    exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"
} -returnCodes error -result {foo bar
child process exited abnormally}
test exec-9.5 {commands returning errors} -constraints {exec stdio notValgrind} -body {
test exec-9.5 {commands returning errors} -constraints {exec stdio} -body {
    exec gorp456 | [interpreter] echo a b c
} -returnCodes error -result {couldn't execute "gorp456": no such file or directory}
test exec-9.6 {commands returning errors} -constraints {exec} -body {
    exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2"
} -returnCodes error -result {error msg}
test exec-9.7 {commands returning errors} -constraints {exec stdio nonPortable} -body {
    # This test can fail easily on multiprocessor machines
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
450











451
452
453
454
455
456
457
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
450
451
452







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+


-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







    exec [interpreter] $path(err)
} -returnCodes error -result {out
err}

# Errors in executing the Tcl command, as opposed to errors in the processes
# that are invoked.

test exec-10.1 {errors in exec invocation} -constraints {exec} -body {
    exec
} -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"}
test exec-10.2 {errors in exec invocation} -constraints {exec} -body {
    exec | cat
} -returnCodes error -result {illegal use of | or |& in command}
test exec-10.3 {errors in exec invocation} -constraints {exec} -body {
    exec cat |
} -returnCodes error -result {illegal use of | or |& in command}
test exec-10.4 {errors in exec invocation} -constraints {exec} -body {
    exec cat | | cat
} -returnCodes error -result {illegal use of | or |& in command}
test exec-10.5 {errors in exec invocation} -constraints {exec} -body {
    exec cat | |& cat
} -returnCodes error -result {illegal use of | or |& in command}
test exec-10.6 {errors in exec invocation} -constraints {exec} -body {
    exec cat |&
} -returnCodes error -result {illegal use of | or |& in command}
test exec-10.7 {errors in exec invocation} -constraints {exec} -body {
    exec cat <
} -returnCodes error -result {can't specify "<" as last word in command}
test exec-10.8 {errors in exec invocation} -constraints {exec} -body {
    exec cat >
} -returnCodes error -result {can't specify ">" as last word in command}
test exec-10.9 {errors in exec invocation} -constraints {exec} -body {
    exec cat <<
} -returnCodes error -result {can't specify "<<" as last word in command}
test exec-10.10 {errors in exec invocation} -constraints {exec} -body {
    exec cat >>
} -returnCodes error -result {can't specify ">>" as last word in command}
test exec-10.11 {errors in exec invocation} -constraints {exec} -body {
    exec cat >&
} -returnCodes error -result {can't specify ">&" as last word in command}
test exec-10.12 {errors in exec invocation} -constraints {exec} -body {
    exec cat >>&
} -returnCodes error -result {can't specify ">>&" as last word in command}
test exec-10.13 {errors in exec invocation} -constraints {exec} -body {
    exec cat >@
} -returnCodes error -result {can't specify ">@" as last word in command}
test exec-10.14 {errors in exec invocation} -constraints {exec} -body {
    exec cat <@
} -returnCodes error -result {can't specify "<@" as last word in command}
test exec-10.15 {errors in exec invocation} -constraints {exec} -body {
    exec cat < a/b/c
} -returnCodes error -result {couldn't read file "a/b/c": no such file or directory}
test exec-10.16 {errors in exec invocation} -constraints {exec} -body {
    exec cat << foo > a/b/c
} -returnCodes error -result {couldn't write file "a/b/c": no such file or directory}
test exec-10.17 {errors in exec invocation} -constraints {exec} -body {
    exec cat << foo > a/b/c
} -returnCodes error -result {couldn't write file "a/b/c": no such file or directory}
test exec-10.1 {errors in exec invocation} {exec} {
    list [catch {exec} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
test exec-10.2 {errors in exec invocation} {exec} {
    list [catch {exec | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.3 {errors in exec invocation} {exec} {
    list [catch {exec cat |} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.4 {errors in exec invocation} {exec} {
    list [catch {exec cat | | cat} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.5 {errors in exec invocation} {exec} {
    list [catch {exec cat | |& cat} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.6 {errors in exec invocation} {exec} {
    list [catch {exec cat |&} msg] $msg
} {1 {illegal use of | or |& in command}}
test exec-10.7 {errors in exec invocation} {exec} {
    list [catch {exec cat <} msg] $msg
} {1 {can't specify "<" as last word in command}}
test exec-10.8 {errors in exec invocation} {exec} {
    list [catch {exec cat >} msg] $msg
} {1 {can't specify ">" as last word in command}}
test exec-10.9 {errors in exec invocation} {exec} {
    list [catch {exec cat <<} msg] $msg
} {1 {can't specify "<<" as last word in command}}
test exec-10.10 {errors in exec invocation} {exec} {
    list [catch {exec cat >>} msg] $msg
} {1 {can't specify ">>" as last word in command}}
test exec-10.11 {errors in exec invocation} {exec} {
    list [catch {exec cat >&} msg] $msg
} {1 {can't specify ">&" as last word in command}}
test exec-10.12 {errors in exec invocation} {exec} {
    list [catch {exec cat >>&} msg] $msg
} {1 {can't specify ">>&" as last word in command}}
test exec-10.13 {errors in exec invocation} {exec} {
    list [catch {exec cat >@} msg] $msg
} {1 {can't specify ">@" as last word in command}}
test exec-10.14 {errors in exec invocation} {exec} {
    list [catch {exec cat <@} msg] $msg
} {1 {can't specify "<@" as last word in command}}
test exec-10.15 {errors in exec invocation} {exec} {
    list [catch {exec cat < a/b/c} msg] [string tolower $msg]
} {1 {couldn't read file "a/b/c": no such file or directory}}
test exec-10.16 {errors in exec invocation} {exec} {
    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
test exec-10.17 {errors in exec invocation} {exec} {
    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
} {1 {couldn't write file "a/b/c": no such file or directory}}
set f [open $path(gorp.file) w]
test exec-10.18 {errors in exec invocation} -constraints {exec} -body {
    exec cat <@ $f
} -returnCodes error -result "channel \"$f\" wasn't opened for reading"
test exec-10.18 {errors in exec invocation} {exec} {
    list [catch {exec cat <@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for reading}"
close $f
set f [open $path(gorp.file) r]
test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
    exec cat >@ $f
} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
test exec-10.19 {errors in exec invocation} {exec} {
    list [catch {exec cat >@ $f} msg] $msg
} "1 {channel \"$f\" wasn't opened for writing}"
close $f
test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body {
    exec ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body {
    exec [interpreter] true | ~xyzzy_bad_user/x | false
} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist}
test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body {
    exec echo test > ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
test exec-10.20 {errors in exec invocation} {exec} {
    list [catch {exec ~non_existent_user/foo/bar} msg] $msg
} {1 {user "non_existent_user" doesn't exist}}
test exec-10.21 {errors in exec invocation} {exec} {
    list [catch {exec [interpreter] true | ~xyzzy_bad_user/x | false} msg] $msg
} {1 {user "xyzzy_bad_user" doesn't exist}}
test exec-10.22 {errors in exec invocation} \
-constraints exec \
-returnCodes 1 \
-body {exec echo test > ~non_existent_user/foo/bar} \
-result {user "non_existent_user" doesn't exist}
# Commands in background.

test exec-11.1 {commands in background} {exec} {
    set time [time {exec [interpreter] $path(sleep) 2 &}]
    expr {[lindex $time 0] < 1000000}
} 1
test exec-11.2 {commands in background} -constraints {exec} -body {
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
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







-
+




+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+








test exec-13.1 {setting errorCode variable} {exec} {
    list [catch {exec [interpreter] $path(cat) < a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
test exec-13.2 {setting errorCode variable} {exec} {
    list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
test exec-13.3 {setting errorCode variable} {exec notValgrind} {
test exec-13.3 {setting errorCode variable} {exec} {
    set x [catch {exec _weird_cmd_} msg]
    list $x [string tolower $msg] [lindex $errorCode 0] \
	    [string tolower [lrange $errorCode 2 end]]
} {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}}

test exec-13.4 {extended exit result codes} -setup {
    set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4]
} -constraints {win} -body {
    list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
} -cleanup {
    removeFile $tmp
} -result {1 {CHILDSTATUS {} 257}}
test exec-13.5 {extended exit result codes: max value} -setup {
    set tmp [makeFile {exit 0x3fffffff} tmpfile.exec-13.5]
} -constraints {win} -body {
    list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
} -cleanup {
    removeFile $tmp
} -result {1 {CHILDSTATUS {} 1073741823}}
test exec-13.6 {extended exit result codes: signalled} -setup {
    set tmp [makeFile {exit 0xC0000016} tmpfile.exec-13.6]
} -constraints {win} -body {
    list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
} -cleanup {
    removeFile $tmp
} -result {1 {CHILDKILLED {} SIGABRT SIGABRT}}
test exec-13.4 {extended exit result codes} {
    -constraints {win}
    -setup {
        set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4]
    }
    -body {
        list [catch {exec [interpreter] $tmp} err]\
            [lreplace $::errorCode 1 1 {}]
    }
    -cleanup {
        removeFile $tmp
    }
    -result {1 {CHILDSTATUS {} 257}}
}

test exec-13.5 {extended exit result codes: max value} {
    -constraints {win}
    -setup {
        set tmp [makeFile {exit 0x3fffffff} tmpfile.exec-13.5]
    }
    -body {
        list [catch {exec [interpreter] $tmp} err]\
            [lreplace $::errorCode 1 1 {}]
    }
    -cleanup {
        removeFile $tmp
    }
    -result {1 {CHILDSTATUS {} 1073741823}}
}

test exec-13.6 {extended exit result codes: signalled} {
    -constraints {win}
    -setup {
        set tmp [makeFile {exit 0xC0000016} tmpfile.exec-13.6]
    }
    -body {
        list [catch {exec [interpreter] $tmp} err]\
            [lreplace $::errorCode 1 1 {}]
    }
    -cleanup {
        removeFile $tmp
    }
    -result {1 {CHILDKILLED {} SIGABRT SIGABRT}}
}

# Switches before the first argument

test exec-14.1 {-keepnewline switch} {exec} {
    exec -keepnewline [interpreter] $path(echo) foo
} "foo\n"
test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
    exec -keepnewline
} -returnCodes error -result {wrong # args: should be "exec ?-option ...? arg ?arg ...?"}
test exec-14.3 {unknown switch} -constraints {exec} -body {
    exec -gorp
} -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --}
test exec-14.4 {-- switch} -constraints {exec notValgrind} -body {
    exec -- -gorp
} -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
test exec-14.2 {-keepnewline switch} {exec} {
    list [catch {exec -keepnewline} msg] $msg
} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
test exec-14.3 {unknown switch} {exec} {
    list [catch {exec -gorp} msg] $msg
} {1 {bad switch "-gorp": must be -ignorestderr, -keepnewline, or --}}
test exec-14.4 {-- switch} {exec} {
    list [catch {exec -- -gorp} msg] [string tolower $msg]
} {1 {couldn't execute "-gorp": no such file or directory}}
test exec-14.5 {-ignorestderr switch} {exec} {
    # Alas, the use of -ignorestderr is buried here :-(
    exec [interpreter] $path(sh2) -c [list $path(echo2) foo bar] 2>@1
} "foo bar\nbar"

# Redirecting standard error separately from standard output

595
596
597
598
599
600
601
602

603
604
605
606
607
608
609


610
611
612
613
614
615
616
614
615
616
617
618
619
620

621
622
623
624
625
626


627
628
629
630
631
632
633
634
635







-
+





-
-
+
+







    close $f
    readfile $path(gorp.file)
} {Line 1
foo bar
Line 3}
test exec-15.5 {standard error redirection} {exec} {
    exec [interpreter] $path(echo) "First line" > "$path(gorp.file)"
    exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>> "$path(gorp.file)"
    exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" 2>> "$path(gorp.file)"
    readfile $path(gorp.file)
} {First line
foo bar}
test exec-15.6 {standard error redirection} {exec stdio} {
    exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" > "$path(gorp.file2)" 2> "$path(gorp.file)" \
	    >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] $path(echo) biz baz
    list [readfile $path(gorp.file)] [readfile $path(gorp.file2)]
	    >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] "$path(echo)" biz baz
    list [exec [interpreter] "$path(cat)" "$path(gorp.file)"] [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
} {{biz baz} {foo bar}}
test exec-15.7 {standard error redirection 2>@1} {exec stdio} {
    # This redirects stderr output into normal result output from exec
    exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>@1
} {foo bar}

test exec-16.1 {flush output before exec} {exec} {
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
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
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
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







-
-
+
+
+

+
+
+
-
-
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-

-
-
-
-
-
-
-
+


+
-
-
-
-
-
+
+
+
+
+
+
+
+


-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-


-
+










    puts $f "Third line"
    close $f
    readfile $path(gorp.file)
} {First line
Second line
Third line}

test exec-17.1 {inheriting standard I/O} -constraints {exec} -setup {
    set path(script) [makeFile {} script]
set path(script) [makeFile {} script]

test exec-17.1 { inheriting standard I/O } {exec} {
    set f [open $path(script) w]
    puts -nonewline $f {close stdout
	set f [}
    puts $f [list open $path(gorp.file) w]]
    puts $f [list lassign [list \
	    [info nameofexecutable] $path(gorp.file) $path(echo) $path(sleep) \
    puts $f [list catch \
	    [list exec [info nameofexecutable] $path(echo) foobar &]]
        ] exe file echo sleep]
    puts $f {
	close stdout
	set f [open $file w]
    puts $f [list exec [info nameofexecutable] $path(sleep) 2]
    puts $f {close $f}
    close $f
    catch {exec [interpreter] $path(script)} result
    set f [open $path(gorp.file) r]
	catch {exec $exe $echo foobar &}
	exec $exe $sleep 2
	close $f
    }
    lappend result [read $f]
    close $f
    set result
} {{foobar
}}
    close $f
} -body {
    catch {exec [interpreter] $path(script)} result
    list $result [readfile $path(gorp.file)]
} -cleanup {
    removeFile $path(script)
} -result {{} foobar}

test exec-18.1 {exec deals with weird file names} -body {
    set path(fooblah) [makeFile {contents} "foo\[\{blah"]
    exec [interpreter] $path(cat) $path(fooblah)
} -constraints {exec} -cleanup {
    removeFile $path(fooblah)
} -result contents
test exec-18.2 {exec cat deals with weird file names} -body {
test exec-18.1 { exec cat deals with weird file names} {exec tempNotWin} {
    # This is cross-platform, but the cat isn't predictably correct on
    # Windows.
    set f "foo\[\{blah"
    set path(fooblah) [makeFile {contents} "foo\[\{blah"]
    exec cat $path(fooblah)
} -constraints {exec tempNotWin} -cleanup {
    removeFile $path(fooblah)
} -result contents
    set path(fooblah) [makeFile {} $f]
    set fout [open $path(fooblah) w]
    puts $fout "contents"
    close $fout
    set res [list [catch {exec cat $path(fooblah)} msg] $msg]
    removeFile $f
    set res
} {0 contents}

# Note that this test cannot be adapted to work on Windows; that platform has
# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
# no kernel support for an analog of O_APPEND.
# that there is a POSIX shell...
test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind noosx} -setup {
    set tmpfile [makeFile {0} tmpfile.exec-19.1]
} -body {
    # Note that we have to allow for the current contents of the temporary
    # file, which is why the result is 14 and not 12
    exec /bin/sh -c \
test exec-19.1 {exec >> uses O_APPEND} {
    -constraints {exec unix}
    -setup {
	set tmpfile [makeFile {0} tmpfile.exec-19.1]
    }
    -body {
	# Note that we have to allow for the current contents of the
	# temporary file, which is why the result is 14 and not 12
	exec /bin/sh -c \
	    {for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile &
    exec /bin/sh -c \
	exec /bin/sh -c \
	    {for a in 4 5 6; do sleep 1; echo $a >&2; done} 2>>$tmpfile &
    exec /bin/sh -c \
	    {for a in a b c; do sleep 1; echo $a; done} >>$tmpfile &
    exec /bin/sh -c \
	    {for a in d e f; do sleep 1; echo $a >&2; done} 2>>$tmpfile &
    # The above four shell invocations take about 3 seconds to finish, so allow
    # 5s (in case the machine is busy)
    after 5000
    # Check that no bytes have got lost through mixups with overlapping
    # appends, which is only guaranteed to work when we set O_APPEND on the
    # file descriptor in the [exec >>...]
    file size $tmpfile
} -cleanup {
    removeFile $tmpfile
} -result 26

	# The above two shell invokations take about 3 seconds to
	# finish, so allow 5s (in case the machine is busy)
	after 5000
	# Check that no bytes have got lost through mixups with
	# overlapping appends, which is only guaranteed to work when
	# we set O_APPEND on the file descriptor in the [exec >>...]
	file size $tmpfile
    }
    -cleanup {
	removeFile $tmpfile
    }
    -result 14
}
# Tests to ensure batch files and .CMD (Bug 9ece99d58b)
# can be executed on Windows
test exec-20.0 {exec .bat file} -constraints {win} -body {
    set log [makeFile {} exec20.log]
    exec [makeFile "echo %1> $log" exec20.bat] "Testing exec-20.0"
    viewFile $log
} -result "\"Testing exec-20.0\""
test exec-20.1 {exec .CMD file} -constraints {win} -body {
    set log [makeFile {} exec201.log]
    exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1"
    viewFile $log
} -result "\"Testing exec-20.1\""


# ----------------------------------------------------------------------
# cleanup

foreach file {gorp.file gorp.file2 echo echo2 cat wc sh sh2 sleep exit err} {
foreach file {script gorp.file gorp.file2 echo echo2 cat wc sh sh2 sleep exit err} {
    removeFile $file
}
unset -nocomplain path

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/execute.test.

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
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







-
-
+
+



-
-
-












-
+

-
-
-
-
-








+







#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset x}
catch {unset y}
catch {unset msg}

testConstraint testobj [expr {
    [llength [info commands testobj]]
    && [llength [info commands testdoubleobj]]
    && [llength [info commands teststringobj]]
}]

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint testexprlongobj [llength [info commands testexprlongobj]]


if {[namespace which -command testbumpinterpepoch] eq ""} {
  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
}

# Tests for the omnibus TclExecuteByteCode function:

# INST_DONE not tested
# INST_PUSH1 not tested
# INST_PUSH4 not tested
# INST_POP not tested
# INST_DUP not tested
# INST_CONCAT1 not tested
# INST_INVOKE_STK4 not tested
# INST_INVOKE_STK1 not tested
# INST_EVAL_STK not tested
# INST_EXPR_STK not tested

# INST_LOAD_SCALAR1
test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {
79
80
81
82
83
84
85
86

87

88
89
90
91
92
93
94
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89








+

+







    proc foo {} {
	set x 1
	unset x
	return $x
    }
    list [catch {foo} msg] $msg
} {1 {can't read "x": no such variable}}


# INST_LOAD_SCALAR4

test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
    set body {}
    for {set i 0} {$i < 256} {incr i} {
	append body "set x$i x\n"
    }
    append body {
	set y 1
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184







-
+







test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {$x + 1}
} 2.0
test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {$x + 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {1 + $x}
} 2
test execute-3.8 {TclExecuteByteCode, INST_ADD, op2 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {1 + $x}
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
195
196
197
198
199
200
201

202
203
204
205
206
207
208
209







-
+







test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {1 + $x}
} 2.0
test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {1 + $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}

# INST_SUB is partially tested:
test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {$x - 1}
} 0
test execute-3.14 {TclExecuteByteCode, INST_SUB, op1 is double} {testobj} {
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236







-
+







test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {$x - 1}
} 0.0
test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {$x - 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
    set x [testintobj set 0 1]
    expr {1 - $x}
} 0
test execute-3.20 {TclExecuteByteCode, INST_SUB, op2 is double} {testobj} {
    set x [testdoubleobj set 0 1]
    expr {1 - $x}
252
253
254
255
256
257
258
259

260
261
262
263
264
265
266
247
248
249
250
251
252
253

254
255
256
257
258
259
260
261







-
+







test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj} {
    set x [teststringobj set 0 1.0]
    expr {1 - $x}
} 0.0
test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
    set x [teststringobj set 0 foo]
    list [catch {expr {1 - $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}

# INST_MULT is partially tested:
test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x * 1}
} 1
test execute-3.26 {TclExecuteByteCode, INST_MULT, op1 is double} {testobj} {
279
280
281
282
283
284
285
286

287
288
289
290
291
292
293
274
275
276
277
278
279
280

281
282
283
284
285
286
287
288







-
+







test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {$x * 1}
} 1.0
test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {$x * 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {1 * $x}
} 1
test execute-3.32 {TclExecuteByteCode, INST_MULT, op2 is double} {testobj} {
    set x [testdoubleobj set 1 2.0]
    expr {1 * $x}
304
305
306
307
308
309
310
311

312
313
314
315
316
317
318
299
300
301
302
303
304
305

306
307
308
309
310
311
312
313







-
+







test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {1 * $x}
} 1.0
test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {1 * $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}

# INST_DIV is partially tested:
test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x / 1}
} 1
test execute-3.38 {TclExecuteByteCode, INST_DIV, op1 is double} {testobj} {
331
332
333
334
335
336
337
338

339
340
341
342
343
344
345
326
327
328
329
330
331
332

333
334
335
336
337
338
339
340







-
+







test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {$x / 1}
} 1.0
test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {$x / 1}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}
test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
    set x [testintobj set 1 1]
    expr {2 / $x}
} 2
test execute-3.44 {TclExecuteByteCode, INST_DIV, op2 is double} {testobj} {
    set x [testdoubleobj set 1 1.0]
    expr {2 / $x}
356
357
358
359
360
361
362
363

364
365
366
367
368
369
370
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365







-
+







test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {2 / $x}
} 2.0
test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {1 / $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}

# INST_UPLUS is partially tested:
test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {+ $x}
} 1
test execute-3.50 {TclExecuteByteCode, INST_UPLUS, op is double} {testobj} {
383
384
385
386
387
388
389
390

391
392
393
394
395
396
397
378
379
380
381
382
383
384

385
386
387
388
389
390
391
392







-
+







test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {+ $x}
} 1.0
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {+ $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}

# INST_UMINUS is partially tested:
test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {- $x}
} -1
test execute-3.56 {TclExecuteByteCode, INST_UMINUS, op is double} {testobj} {
410
411
412
413
414
415
416
417

418
419
420
421
422
423
424
405
406
407
408
409
410
411

412
413
414
415
416
417
418
419







-
+







test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testobj} {
    set x [teststringobj set 1 1.0]
    expr {- $x}
} -1.0
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {- $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}

# INST_LNOT is partially tested:
test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
    set x [testintobj set 1 2]
    expr {! $x}
} 0
test execute-3.62 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
458
459
460
461
462
463
464
465





466
467
468
469
470
471
472
453
454
455
456
457
458
459

460
461
462
463
464
465
466
467
468
469
470
471







-
+
+
+
+
+







test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj} {
    set x [teststringobj set 1 0.0]
    expr {! $x}
} 1
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
    set x [teststringobj set 1 foo]
    list [catch {expr {! $x}} msg] $msg
} {1 {can't use non-numeric string "foo" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}

# INST_BITNOT not tested
# INST_CALL_BUILTIN_FUNC1 not tested
# INST_CALL_FUNC1 not tested

# INST_TRY_CVT_TO_NUMERIC is partially tested:
test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} {
    set x [testintobj set 1 1]
    expr {$x}
} 1
test execute-3.73 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is double} {testobj} {
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
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







-
+

-
-
+
+
-













-
-
+
+


-
+
-
















+
-
-
+
+


-













-
+

-
+

-
+
-





-
+







# INST_FOREACH_START4 not tested
# INST_FOREACH_STEP4 not tested
# INST_BEGIN_CATCH4 not tested
# INST_END_CATCH not tested
# INST_PUSH_RESULT not tested
# INST_PUSH_RETURN_CODE not tested

test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} -setup {
test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    unset -nocomplain x
    unset -nocomplain y
    catch {unset x}
    catch {unset y}
} -body {
    namespace eval test_ns_1 {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_1::test_ns_2 {
        namespace import ::test_ns_1::*
    }
    set x "test_ns_1::"
    set y "test_ns_2::"
    list [namespace which -command ${x}${y}cmd1] \
         [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
         [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
} -result {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} -setup {
} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename foo ""}
    unset -nocomplain l
    catch {unset l}
} -body {
    proc foo {} {
        return "global foo"
    }
    namespace eval test_ns_1 {
        proc whichFoo {} {
            return [namespace which -command foo]
        }
    }
    set l ""
    lappend l [test_ns_1::whichFoo]
    namespace eval test_ns_1 {
        proc foo {} {
            return "namespace foo"
        }
    }
    lappend l [test_ns_1::whichFoo]
    set l
} -result {::foo ::test_ns_1::foo}
test execute-4.3 {Tcl_GetCommandFromObj, command never found} -setup {
} {::foo ::test_ns_1::foo}
test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename foo ""}
} -body {
    namespace eval test_ns_1 {
        proc foo {} {
            return "namespace foo"
        }
    }
    namespace eval test_ns_1 {
        proc foo {} {
            return "namespace foo"
        }
    }
    list [namespace eval test_ns_1 {namespace which -command foo}] \
         [rename test_ns_1::foo ""] \
         [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
} -result {::test_ns_1::foo {} 0 {}}
} {::test_ns_1::foo {} 0 {}}

test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} -setup {
test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    unset -nocomplain l
    catch {unset l}
} -body {
    proc {} {} {return {}}
    {}
    set l {}
    lindex {} 0
    {}
} -result {}
} {}

test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
    proc {} {} {}
    proc { } {} {}
    proc p {} {
        set x {}
        $x
601
602
603
604
605
606
607
608

609
610
611
612
613
614
615
616
617
618

619
620


621
622
623
624
625
626
627

628
629


630
631
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
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
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
597
598
599
600
601
602
603

604
605
606
607
608
609
610
611

612
613
614


615
616
617
618
619
620
621

622
623


624
625


626
627
628
629
630
631
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
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

756
757
758

759
760
761

762
763
764
765
766
767
768
769







-
+







-


+
-
-
+
+





-

+
-
-
+
+
-
-







-

+
-
-
+
+
-
-







-

+
-
-
+
+
-
-

+
-
+


-
+
-
-
-
-
+
+
+
+

-
+

-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-


+
-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
-
-


+
-
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+







-


+
-
-
+
+
-
-






-
+
-

+
-
-
+
+
-
-


-
+



-
+
-

+
-
-
+
+
-
-

+
-
-
+
+



-
-
-
-
+
+
+
+
+


-



-


+
-
-
+
+
+


-



-


+
-
+







} -body {
    set e { 0+0 }
    if 1 {expr $e}
    if 1 $e
} -cleanup {
    rename 0+0 {}
} -result SCRIPT
test execute-6.5 {TclCompEvalObj: bytecode epoch validation} -body {
test execute-6.5 {TclCompEvalObj: bytecode epoch validation} {
    set script { llength {} }
    set result {}
    lappend result [if 1 $script]
    set origName [namespace which llength]
    rename $origName llength.orig
    proc $origName {args} {return AHA!}
    lappend result [if 1 $script]
} -cleanup {
    rename $origName {}
    rename llength.orig $origName
    set result
} -result {0 AHA!}
test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} -body {
} {0 AHA!}
test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} {
    proc foo {} {set a 1}
    set a untouched
    set result {}
    lappend result [foo] $a
    lappend result [if 1 [info body foo]] $a
} -cleanup {
    rename foo {}
    set result
} -result {1 untouched 1 1}
test execute-6.7 {TclCompEvalObj: bytecode context validation} -setup {
} {1 untouched 1 1}
test execute-6.7 {TclCompEvalObj: bytecode context validation} {
    namespace eval foo {}
} -body {
    set script { llength {} }
    namespace eval foo {
	proc llength {args} {return AHA!}
    }
    set result {}
    lappend result [if 1 $script]
    lappend result [namespace eval foo $script]
} -cleanup {
    namespace delete foo
    set result
} -result {0 AHA!}
test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} -setup {
} {0 AHA!}
test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} {
    namespace eval foo {}
} -body {
    set script { llength {} }
    set result {}
    lappend result [namespace eval foo $script]
    namespace eval foo {
	proc llength {args} {return AHA!}
    }
    lappend result [namespace eval foo $script]
} -cleanup {
    namespace delete foo
    set result
} -result {0 AHA!}
test execute-6.9 {TclCompEvalObj: bytecode interp validation} -setup {
} {0 AHA!}
test execute-6.9 {TclCompEvalObj: bytecode interp validation} {
    interp create child
} -body {
    set script { llength {} }
    interp create slave
    child eval {proc llength args {return AHA!}}
    slave eval {proc llength args {return AHA!}}
    set result {}
    lappend result [if 1 $script]
    lappend result [child eval $script]
    lappend result [slave eval $script]
} -cleanup {
    interp delete child
} -result {0 AHA!}
test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body {
    interp delete slave
    set result
} {0 AHA!}
test execute-6.10 {TclCompEvalObj: bytecode interp validation} {
    set script { llength {} }
    interp create child
    interp create slave
    set result {}
    lappend result [child eval $script]
    interp delete child
    interp create child
    lappend result [child eval $script]
    lappend result [slave eval $script]
    interp delete slave
    interp create slave
    lappend result [slave eval $script]
} -cleanup {
    catch {interp delete child}
} -result {0 0}
test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup {
    interp delete slave
    set result
} {0 0}
test execute-6.11 {Tcl_ExprObj: exprcode interp validation} testexprlongobj {
    interp create child
} -constraints testexprlongobj -body {
    set e { [llength {}]+1 }
    set result {}
    interp create slave
    load {} Tcltest child
    interp alias {} e child testexprlongobj
    load {} Tcltest slave
    interp alias {} e slave testexprlongobj
    lappend result [e $e]
    interp delete child
    interp create child
    load {} Tcltest child
    interp alias {} e child testexprlongobj
    interp delete slave
    interp create slave
    load {} Tcltest slave
    interp alias {} e slave testexprlongobj
    lappend result [e $e]
} -cleanup {
    interp delete child
} -result {{This is a result: 1} {This is a result: 1}}
test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup {
    interp delete slave
    set result
} {{This is a result: 1} {This is a result: 1}}
test execute-6.12 {Tcl_ExprObj: exprcode interp validation} {
    interp create child
} -body {
    set e { [llength {}]+1 }
    set result {}
    interp create slave
    interp alias {} e child expr
    interp alias {} e slave expr
    lappend result [e $e]
    interp delete child
    interp create child
    interp alias {} e child expr
    interp delete slave
    interp create slave
    interp alias {} e slave expr
    lappend result [e $e]
} -cleanup {
    interp delete child
} -result {1 1}
test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
    interp delete slave
    set result
} {1 1}
test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} {
    set e { [llength {}]+1 }
    set result {}
    lappend result [expr $e]
    set origName [namespace which llength]
    rename $origName llength.orig
    proc $origName {args} {return 1}
    lappend result [expr $e]
} -cleanup {
    rename $origName {}
    rename llength.orig $origName
    set result
} -result {1 2}
test execute-6.14 {Tcl_ExprObj: exprcode context validation} -setup {
} {1 2}
test execute-6.14 {Tcl_ExprObj: exprcode context validation} {
    namespace eval foo {}
} -body {
    set e { [llength {}]+1 }
    namespace eval foo {
	proc llength {args} {return 1}
    }
    set result {}
    lappend result [expr $e]
    lappend result [namespace eval foo [list expr $e]]
    lappend result [namespace eval foo {expr $e}]
} -cleanup {
    namespace delete foo
    set result
} -result {1 2}
test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} -setup {
} {1 2}
test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} {
    namespace eval foo {}
} -body {
    set e { [llength {}]+1 }
    set result {}
    lappend result [namespace eval foo [list expr $e]]
    lappend result [namespace eval foo {expr $e}]
    namespace eval foo {
	proc llength {args} {return 1}
    }
    lappend result [namespace eval foo [list expr $e]]
    lappend result [namespace eval foo {expr $e}]
} -cleanup {
    namespace delete foo
    set result
} -result {1 2}
test execute-6.16 {Tcl_ExprObj: exprcode interp validation} -setup {
} {1 2}
test execute-6.16 {Tcl_ExprObj: exprcode interp validation} {
    interp create child
} -body {
    set e { [llength {}]+1 }
    interp create slave
    interp alias {} e child expr
    child eval {proc llength args {return 1}}
    interp alias {} e slave expr
    slave eval {proc llength args {return 1}}
    set result {}
    lappend result [expr $e]
    lappend result [e $e]
} -cleanup {
    interp delete child
} -result {1 2}
test execute-6.17 {Tcl_ExprObj: exprcode context validation} -body {
    interp delete slave
    set result
} {1 2}
test execute-6.17 {Tcl_ExprObj: exprcode context validation} {
    set e { $v }
    proc foo e {set v 0; expr $e}
    proc bar e {set v 1; expr $e}
    set e { $v }
    set result {}
    lappend result [foo $e]
    lappend result [bar $e]
} -cleanup {
    rename foo {}
    rename bar {}
    set result
} -result {0 1}
test execute-6.18 {Tcl_ExprObj: exprcode context validation} -body {
} {0 1}
test execute-6.18 {Tcl_ExprObj: exprcode context validation} {
    set e { [llength $v] }
    proc foo e {set v {}; expr $e}
    proc bar e {set v v; expr $e}
    set e { [llength $v] }
    set result {}
    lappend result [foo $e]
    lappend result [bar $e]
} -cleanup {
    rename foo {}
    rename bar {}
    set result
} -result {0 1}
} {0 1}

test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {
    set x 0x100000000
    expr {$x && 1}
} 1
test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {
    expr {0x100000000 && 1}
802
803
804
805
806
807
808
809
810
811



812
813
814
815
816
817
818
786
787
788
789
790
791
792



793
794
795
796
797
798
799
800
801
802







-
-
-
+
+
+







} 1
# wide ints have more bits of precision than doubles, but we convert anyway
test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
    set x [expr {wide(1)<<62}]
    set y [expr {$x+1}]
    expr {double($x) == double($y)}
} 1
test execute-7.8 {Wide int conversions can change sign} {
    set x 0x8000000000000000
    expr {wide($x) < 0}
test execute-7.8 {Wide int conversions can change sign} longIs32bit {
    set x 0x80000000
    expr {int($x) < wide($x)}
} 1
test execute-7.9 {Wide int handling in INST_MOD} {
    expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
} 316659348800185
test execute-7.10 {Wide int handling in INST_MOD} {
    expr {((wide(1)<<60)-1) % 0x400000000}
} 17179869183
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
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
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
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







-
+

-
-
+
+

-
+















+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+
+











-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
-
-

-
+


-
+





-
+

-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







} 1
test execute-7.31 {Wide int handling in abs()} {
    set x 0xa23456871234568
    incr x
    set y 0x123456871234568
    concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
test execute-7.32 {Wide int handling} {
test execute-7.32 {Wide int handling} longIs32bit {
    expr {int(1024 * 1024 * 1024 * 1024)}
} 1099511627776
test execute-7.33 {Wide int handling} {
} 0
test execute-7.33 {Wide int handling} longIs32bit {
    expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
} 1099511627776
} 0
test execute-7.34 {Wide int handling} {
    expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 1099511627776

test execute-8.1 {Stack protection} -setup {
    # If [Bug #804681] has not been properly taken care of, this should
    # segfault
    proc whatever args {llength $args}
    trace add variable ::errorInfo {write unset} whatever
} -body {
    expr {1+9/0}
} -cleanup {
    trace remove variable ::errorInfo {write unset} whatever
    rename whatever {}
} -returnCodes error -match glob -result *

test execute-8.2 {Stack restoration} -setup {
test execute-8.2 {Stack restoration} -body {
    # Avoid crashes when system stack size is limited (thread-enabled!)
    set limit [interp recursionlimit {}]
    interp recursionlimit {} 100
} -body {
    # Test for [Bug #816641], correct restoration of the stack top after the
    # stack is grown
    proc f {args} { f bee bop }
    catch f msg
    set msg
} -cleanup {
    interp recursionlimit {} $limit
} -result {too many nested evaluations (infinite loop?)}
test execute-8.3 {Stack restoration} -setup {
    # Test for [Bug #816641], correct restoration
    # of the stack top after the stack is grown
     proc f {args} { f bee bop }
     catch f msg
     set msg
 } -setup {
    # Avoid crashes when system stack size is limited (thread-enabled!)
     set limit [interp recursionlimit {}]
     interp recursionlimit {} 100
 } -cleanup {
     interp recursionlimit {} $limit
 } -result {too many nested evaluations (infinite loop?)}

test execute-8.3 {Stack restoration} -body {
    # Avoid crashes when system stack size is limited (thread-enabled!)
    set limit [interp recursionlimit {}]
    interp recursionlimit {} 100
} -body {
    # Test for [Bug #1055676], correct restoration of the stack top after the
    # epoch is bumped and the stack is grown in a call from a nested
    # Test for [Bug #1055676], correct restoration
    # of the stack top after the epoch is bumped and
    # the stack is grown in a call from a nested evaluation
    # evaluation
    set arglst [string repeat "a " 1000]
    proc f {args} "f $arglst"
    proc run {} {
	# bump the interp's epoch
	testbumpinterpepoch
	catch f msg
	set msg
    }
    run
} -cleanup {
    interp recursionlimit {} $limit
} -result {too many nested evaluations (infinite loop?)}
     set arglst [string repeat "a " 1000]
     proc f {args} "f $arglst"
     proc run {} {
	 # bump the interp's epoch
	 rename ::set ::dummy
	 rename ::dummy ::set
	 catch f msg
	 set msg
     }
     run
 } -setup {
    # Avoid crashes when system stack size is limited (thread-enabled!)
     set limit [interp recursionlimit {}]
     interp recursionlimit {} 100
 } -cleanup {
     interp recursionlimit {} $limit
 } -result {too many nested evaluations (infinite loop?)}

test execute-8.4 {Compile epoch bump effect on stack trace} -setup {
    proc foo {} {
	error bar
    }
    proc FOO {} {
	catch {error bar} m o
	testbumpinterpepoch
	rename ::set ::dummy
	rename ::dummy ::set
	return -options $o $m
    }
} -body {
    catch foo m o
    set stack1 [dict get $o -errorinfo]
    catch FOO m o
    set stack2 [string map {FOO foo} [dict get $o -errorinfo]]
    expr {$stack1 eq $stack2 ? {} : "These differ:\n$stack1\n$stack2"}
} -cleanup {
    rename foo {}
    rename FOO {}
    unset -nocomplain m o stack1 stack2
} -result {}
test execute-8.5 {Bug 2038069} -setup {
    proc demo {} {
	catch [list error FOO] m o
	return $o
    }
} -body {
    demo
} -cleanup {
    rename demo {}
} -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO
    while executing
"error FOO"
    invoked from within
"catch \[list error FOO\] m o"} -errorline 2}

test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup {
    interp create child
    child eval {
	package require tcltest 2.5
	catch [list package require -exact Tcltest [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    child eval {
	lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C;
    }
    child eval {
	set i 0; while {[incr i] < 3} {
	    lappend res A; testbumpinterpepoch; lappend res B; return; lappend res C;
	}
    }
    child eval {
	set i 0; while {[incr i] < 3} {
	    lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C;
	}
    }
    child eval {
	catch {
	    lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C;
	}
    }
    child eval {set res}
} -cleanup {
    interp delete child
} -result [lrepeat 4 A B]
test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup {
    interp create child
    child eval {
	package require tcltest 2.5
	catch [list package require -exact Tcltest [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    set res {}
    lappend res [catch {
	child eval {
	   lappend res A; testbumpinterpepoch; lappend res B; return -code error test; lappend res C;
	}
    } e] $e
    lappend res [catch {
	child eval {
	   lappend res A; testbumpinterpepoch; lappend res B; error test; lappend res C;
	}
    } e] $e
    lappend res [catch {
	child eval {
	   lappend res A; testbumpinterpepoch; lappend res B; return -code return test; lappend res C;
	}
    } e] $e
    lappend res [catch {
	child eval {
	   lappend res A; testbumpinterpepoch; lappend res B; break; lappend res C;
	}
    } e] $e
    list $res [child eval {set res}]
} -cleanup {
    interp delete child
} -result [list {1 test 1 test 2 test 3 {}} [lrepeat 4 A B]]

test execute-9.1 {Interp result resetting [Bug 1522803]} {
    set c 0
    catch {
	catch {error foo}
	expr {1/$c}
    }
    if {[string match *foo* $::errorInfo]} {
	set result "Bad errorInfo: $::errorInfo"
    } else {
	set result SUCCESS
    }
    set result
} SUCCESS

test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
    apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130
} {48 {304 304}}
test execute-10.2 {Bug 2802881} -setup {
    interp create child
    interp create slave
} -body {
    # If [Bug 2802881] is not fixed, this will segfault
    child eval {
    slave eval {
	trace add variable ::errorInfo write {expr {$foo} ;#}
	proc demo {} {a {}{}}
	demo
    }
} -cleanup {
    interp delete child
    interp delete slave
} -returnCodes error -match glob -result *
test execute-10.3 {Bug 3072640} -setup {
    proc generate {n} {
	for {set i 0} {$i < $n} {incr i} {
	    yield $i
	}

    }
    proc t {args} {
	incr ::foo
    }
    set ::foo 0
    trace add execution ::generate enterstep ::t
} -body {
    coroutine coro generate 5
    trace remove execution ::generate enterstep ::t
    set ::foo
} -cleanup {
    unset ::foo
    rename generate {}
    rename t {}
    rename coro {}
} -result 4

test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup {
    interp create child
} -body {
    child eval {
	set x [lrepeat 1320 199]
	for {set i 0} {$i < 20} {incr i} {
	    lappend x $i
	    lsort -integer $x
	}
	# Crashes on failure
	return ok
    }
} -cleanup {
    interp delete child
} -result ok

test execute-11.2 {Bug 268b23df11} -setup {
    proc zero {} {return 0}
    proc crash {} {expr {abs([zero])}}
    proc noop args {}
    trace add execution crash enterstep noop
} -body {
    crash
} -cleanup {
    trace remove execution crash enterstep noop
    rename noop {}
    rename crash {}
    rename zero {}
} -result 0
test execute-11.3 {Bug a0ece9d6d4} -setup {
    proc crash {} {expr {rand()}}
    trace add execution crash enterstep {apply {args {info frame -2}}}
} -body {
    string is double [crash]
} -cleanup {
    trace remove execution crash enterstep {apply {args {info frame -2}}}
    rename crash {}
} -result 1

test execute-12.1 {failing multi-lappend to unshared} -setup {
    unset -nocomplain x y
} -body {
    set x 1
    lappend x 2 3
    trace add variable x write {apply {args {error boo}}}
    lappend x 4 5
} -cleanup {
    unset -nocomplain x y
} -returnCodes error -result {can't set "x": boo}
test execute-12.2 {failing multi-lappend to shared} -setup {
    unset -nocomplain x y
} -body {
    set x 1
    lappend x 2 3
    set y $x
    trace add variable x write {apply {args {error boo}}}
    lappend x 4 5
} -cleanup {
    unset -nocomplain x y
} -returnCodes error -result {can't set "x": boo}
test execute-12.3 {failing multi-lappend to unshared: LVT} -body {
    apply {{} {
	set x 1
	lappend x 2 3
	trace add variable x write {apply {args {error boo}}}
	lappend x 4 5
    }}
} -returnCodes error -result {can't set "x": boo}
test execute-12.4 {failing multi-lappend to shared: LVT} -body {
    apply {{} {
	set x 1
	lappend x 2 3
	set y $x
	trace add variable x write {apply {args {error boo}}}
	lappend x 4 5
    }}
} -returnCodes error -result {can't set "x": boo}

# cleanup
if {[info commands testobj] != {}} {
   testobj freeallvars
}
catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {rename p ""}

Changes to tests/expr-old.test.

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
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







-
-
-
+
+
-
-
-
-




-
-
+
+
+
+
+
+
+







# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2.1
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint longIs32bit    [expr {int(0x80000000) < 0}]

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
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
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







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







    list [catch {expr 028.1 + 09.2} msg] $msg
} {0 37.3}

# Operators that aren't legal on floating-point numbers

test expr-old-3.1 {illegal floating-point operations} {
    list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
} {1 {can't use floating-point value as operand of "~"}}
test expr-old-3.2 {illegal floating-point operations} {
    list [catch {expr 27%4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "%"}}
} {1 {can't use floating-point value as operand of "%"}}
test expr-old-3.3 {illegal floating-point operations} {
    list [catch {expr 27.0%4} msg] $msg
} {1 {can't use floating-point value "27.0" as operand of "%"}}
} {1 {can't use floating-point value as operand of "%"}}
test expr-old-3.4 {illegal floating-point operations} {
    list [catch {expr 1.0<<3} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
} {1 {can't use floating-point value as operand of "<<"}}
test expr-old-3.5 {illegal floating-point operations} {
    list [catch {expr 3<<1.0} msg] $msg
} {1 {can't use floating-point value "1.0" as operand of "<<"}}
} {1 {can't use floating-point value as operand of "<<"}}
test expr-old-3.6 {illegal floating-point operations} {
    list [catch {expr 24.0>>3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test expr-old-3.7 {illegal floating-point operations} {
    list [catch {expr 24>>3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test expr-old-3.8 {illegal floating-point operations} {
    list [catch {expr 24&3.0} msg] $msg
} {1 {can't use floating-point value "3.0" as operand of "&"}}
} {1 {can't use floating-point value as operand of "&"}}
test expr-old-3.9 {illegal floating-point operations} {
    list [catch {expr 24.0|3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "|"}}
} {1 {can't use floating-point value as operand of "|"}}
test expr-old-3.10 {illegal floating-point operations} {
    list [catch {expr 24.0^3} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
} {1 {can't use floating-point value as operand of "^"}}

# Check the string operators individually.

test expr-old-4.1 {string operators} {expr {"abc" > "def"}} 0
test expr-old-4.2 {string operators} {expr {"def" > "def"}} 0
test expr-old-4.3 {string operators} {expr {"g" > "def"}} 1
test expr-old-4.4 {string operators} {expr {"abc" < "abd"}} 1
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
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







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







test expr-old-4.31 {string operators} {expr {1?"foo":"bar"}} foo
test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar

# Operators that aren't legal on string operands.

test expr-old-5.1 {illegal string operations} {
    list [catch {expr {-"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test expr-old-5.2 {illegal string operations} {
    list [catch {expr {+"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-5.3 {illegal string operations} {
    list [catch {expr {~"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "~"}}
} {1 {can't use non-numeric string as operand of "~"}}
test expr-old-5.4 {illegal string operations} {
    list [catch {expr {!"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-old-5.5 {illegal string operations} {
    list [catch {expr {"a"*"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test expr-old-5.6 {illegal string operations} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}
test expr-old-5.7 {illegal string operations} {
    list [catch {expr {"a"%"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "%"}}
} {1 {can't use non-numeric string as operand of "%"}}
test expr-old-5.8 {illegal string operations} {
    list [catch {expr {"a"+"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-5.9 {illegal string operations} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test expr-old-5.10 {illegal string operations} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
} {1 {can't use non-numeric string as operand of "<<"}}
test expr-old-5.11 {illegal string operations} {
    list [catch {expr {"a">>"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of ">>"}}
} {1 {can't use non-numeric string as operand of ">>"}}
test expr-old-5.12 {illegal string operations} {
    list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
} {1 {can't use non-numeric string as operand of "&"}}
test expr-old-5.13 {illegal string operations} {
    list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
} {1 {can't use non-numeric string as operand of "^"}}
test expr-old-5.14 {illegal string operations} {
    list [catch {expr {"a"|"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "|"}}
} {1 {can't use non-numeric string as operand of "|"}}
test expr-old-5.15 {illegal string operations} {
    list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.16 {illegal string operations} {
    list [catch {expr {"a"||"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-old-5.17 {illegal string operations} {
413
414
415
416
417
418
419
420
421


422
423
424
425
426

427
428
429
430
431
432
433
413
414
415
416
417
418
419


420
421
422
423
424
425

426
427
428
429
430
431
432
433







-
-
+
+




-
+








test expr-old-21.1 {parenthesization} {expr (2+4)*6} 36
test expr-old-21.2 {parenthesization} {expr (1?0:4)||1} 1
test expr-old-21.3 {parenthesization} {expr +(3-4)} -1

# Embedded commands and variable names.

set a 16
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
set a 16 
test expr-old-22.1 {embedded variables} {expr {2*$a}} 32 
test expr-old-22.2 {embedded variables} {
    set x -5
    set y 10
    expr {$x + $y}
} {5}
} {5} 
test expr-old-22.3 {embedded variables} {
    set x "  -5"
    set y "  +10"
    expr {$x + $y}
} {5}
test expr-old-22.4 {embedded commands and variables} {expr {[set a] - 14}} 2
test expr-old-22.5 {embedded commands and variables} {
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
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







-
+













-
+


-
+







test expr-old-25.19 {type conversions} {expr 2.0e15} 2000000000000000.0
test expr-old-25.20 {type conversions} {expr 10.0} 10.0

# Various error conditions.

test expr-old-26.1 {error conditions} {
    list [catch {expr 2+"a"} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.2 {error conditions} -body {
    expr 2+4*
} -returnCodes error -match glob -result *
test expr-old-26.3 {error conditions} -body {
    expr 2+4*(
} -returnCodes error -match glob -result *
unset -nocomplain _non_existent_
test expr-old-26.4 {error conditions} {
    list [catch {expr 2+$_non_existent_} msg] $msg
} {1 {can't read "_non_existent_": no such variable}}
set a xx
test expr-old-26.5 {error conditions} {
    list [catch {expr {2+$a}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.6 {error conditions} {
    list [catch {expr {2+[set a]}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.7 {error conditions} -body {
    expr {2+(4}
} -returnCodes error -match glob -result *
test expr-old-26.8 {error conditions} {
    list [catch {expr 2/0} msg] $msg $errorCode
} {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
test expr-old-26.9 {error conditions} {
527
528
529
530
531
532
533
534

535
536
537
538
539
540
541
527
528
529
530
531
532
533

534
535
536
537
538
539
540
541







-
+







    expr 2#
} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
    expr a.b
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}
test expr-old-26.14 {error conditions} -body {
    expr 2:3
} -returnCodes error -match glob -result *
test expr-old-26.15 {error conditions} -body {
    expr a@b
} -returnCodes error -match glob -result *
test expr-old-26.16 {error conditions} {
812
813
814
815
816
817
818
819

820
821
822

823
824
825
826
827
828
829
812
813
814
815
816
817
818

819
820
821

822
823
824
825
826
827
828
829







-
+


-
+







    expr int(-1.4)
} {-1}
test expr-old-32.32 {math functions in expressions} {
    expr int(-1.6)
} {-1}
test expr-old-32.33 {math functions in expressions} {
    expr int(1e60)
} 999999999999999949387135297074018866963645011013410073083904
} 0
test expr-old-32.34 {math functions in expressions} {
    expr int(-1e60)
} -999999999999999949387135297074018866963645011013410073083904
} 0
test expr-old-32.35 {math functions in expressions} {
    expr round(1.49)
} {1}
test expr-old-32.36 {math functions in expressions} {
    expr round(1.51)
} {2}
test expr-old-32.37 {math functions in expressions} {
840
841
842
843
844
845
846






847
848
849
850
851
852
853
854
855

856
857
858
859
860
861
862
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







+
+
+
+
+
+








-
+







} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
    list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
    list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
test expr-old-32.43 {math functions in expressions} testmathfunctions {
    expr 2*T1()
} 246
test expr-old-32.44 {math functions in expressions} testmathfunctions {
    expr T2()*3
} 1035
test expr-old-32.45 {math functions in expressions} {
    expr (0 <= rand()) && (rand() < 1)
} {1}
test expr-old-32.46 {math functions in expressions} -body {
    list [catch {expr rand(24)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-32.47 {math functions in expressions} -body {
    list [catch {expr srand()} msg] $msg
} -match glob -result {1 {not enough arguments for math function*}}
} -match glob -result {1 {too few arguments for math function*}}
test expr-old-32.48 {math functions in expressions} -body {
    expr srand(3.79)
} -returnCodes error -match glob -result *
test expr-old-32.49 {math functions in expressions} -body {
    expr srand("")
} -returnCodes error -match glob -result *
test expr-old-32.50 {math functions in expressions} {
905
906
907
908
909
910
911
912

913
914
915
916
917
918
919
911
912
913
914
915
916
917

918
919
920
921
922
923
924
925







-
+







    expr hypot(1.0, 2.0
} -returnCodes error -match glob -result *
test expr-old-34.6 {errors in math functions} -body {
    expr hypot(1.0 ,
} -returnCodes error -match glob -result *
test expr-old-34.7 {errors in math functions} -body {
    list [catch {expr hypot(1.0)} msg] $msg
} -match glob -result {1 {not enough arguments for math function*}}
} -match glob -result {1 {too few arguments for math function*}}
test expr-old-34.8 {errors in math functions} -body {
    list [catch {expr hypot(1.0, 2.0, 3.0)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-34.9 {errors in math functions} {
    list [catch {expr acos(-2.0)} msg] $msg $errorCode
} {1 {domain error: argument not in valid range} {ARITH DOMAIN {domain error: argument not in valid range}}}
test expr-old-34.10 {errors in math functions} {
939
940
941
942
943
944
945




946
947
948
949
950
951
952
953

954
955
956
957
958
959
960
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







+
+
+
+







-
+







} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
    expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
    expr round(-1.0e30)
} -1000000000000000019884624838656
test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \
    -body {
        list [catch {expr T1(4)} msg] $msg
    } -match glob -result {1 {too many arguments for math function*}}

test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
    expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
    set x 0o289
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o289" as operand of "+"}}
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
    list [catch {expr 0289.1} msg] $msg
} {0 289.1}
test expr-old-36.4 {ExprLooksLikeInt procedure} {
    set x 0289.1
    list [catch {expr {$x+1}} msg] $msg
} {0 290.1}
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
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







-
+



-
+







-
+







    expr {$x+1}
} 665802003400000000000001

# tests for [Bug #587140]
test expr-old-36.12 {ExprLooksLikeInt procedure} {
    set x "10;"
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "10;" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-36.13 {ExprLooksLikeInt procedure} {
    set x " +"
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string " +" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
    set x "123456789012345678901234567890 "
    expr {$x+1}
} 123456789012345678901234567891
test expr-old-36.15 {ExprLooksLikeInt procedure} {
    set x "0o99 "
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o99 " as operand of "+"}}
} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
    set x " 0xffffffffffffffffffffffffffffffffffffff  "
    expr {$x+1}
} [expr 0x100000000000000000000000000000000000000]

test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
    testexprlong 4+1
1035
1036
1037
1038
1039
1040
1041
1042
1043


1044
1045
1046
1047
1048
1049
1050
1045
1046
1047
1048
1049
1050
1051


1052
1053
1054
1055
1056
1057
1058
1059
1060







-
-
+
+







	list [catch {testexprlong 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -0x80000000
} {This is a result: -2147483648}
test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
    testexprlong -0x7fffffff
} {This is a result: -2147483647}
    testexprlong -0xffffffff
} {This is a result: 1}
test expr-old-37.10 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
1060
1061
1062
1063
1064
1065
1066
1067
1068


1069
1070
1071
1072
1073

1074
1075
1076
1077
1078
1079
1080
1070
1071
1072
1073
1074
1075
1076


1077
1078





1079
1080
1081
1082
1083
1084
1085
1086







-
-
+
+
-
-
-
-
-
+







    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
    testexprlong -2147483648.
} {This is a result: -2147483648}
test expr-old-37.15 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
    testexprlong -4294967295.
    -match glob \
    -body {
	list [catch {testexprlong -2147483649.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
} {This is a result: 1}
test expr-old-37.16 {Tcl_ExprLong handles overflows} \
    -constraints {testexprlong longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlong 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
1107
1108
1109
1110
1111
1112
1113
1114

1115
1116
1117
1118
1119
1120
1121
1113
1114
1115
1116
1117
1118
1119

1120
1121
1122
1123
1124
1125
1126
1127







-
+







    ieeeFloatingPoint&&testexprdouble {
	testexprdouble 17976931348623165[string repeat 0 292]
    } {This is a result: Inf}
test expr-old-37.25 {Tcl_ExprDouble and NaN} \
    {ieeeFloatingPoint testexprdouble} {
	list [catch {testexprdouble 0.0/0.0} result] $result
    } {1 {domain error: argument not in valid range}}

    
test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
    list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
	    [catch {testexprstring "1+"} msg] $msg
} -match glob -result {5 10.2 1 *}
test expr-old-38.2 {Tcl_ExprString} testexprstring {
    # This one is "magical"
    testexprstring {}
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
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







-
-
+
+









-
-
-
-
-
-








-
-
+
+









-
-
-
-
-
-







test expr-old-40.1 {min math function} -body {
    expr {min(0)}
} -result 0
test expr-old-40.2 {min math function} -body {
    expr {min(0.0)}
} -result 0.0
test expr-old-40.3 {min math function} -body {
    expr {min()}
} -returnCodes error -result {not enough arguments for math function "min"}
    list [catch {expr {min()}} msg] $msg
} -result {1 {too few arguments to math function "min"}}
test expr-old-40.4 {min math function} -body {
    expr {min(wide(-1) << 30, 4.5, -10)}
} -result [expr {wide(-1) << 30}]
test expr-old-40.5 {min math function} -body {
    expr {min("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-40.6 {min math function} -body {
    expr {min(300, "0xFF")}
} -result 255
test expr-old-40.7 {min math function} -body {
    expr min(1[string repeat 0 10000], 1e300)
} -result 1e+300
test expr-old-40.8 {min math function} -body {
    expr {min(0, "a")}
} -returnCodes error -match glob -result *

test expr-old-41.1 {max math function} -body {
    expr {max(0)}
} -result 0
test expr-old-41.2 {max math function} -body {
    expr {max(0.0)}
} -result 0.0
test expr-old-41.3 {max math function} -body {
    expr {max()}
} -returnCodes error -result {not enough arguments for math function "max"}
    list [catch {expr {max()}} msg] $msg
} -result {1 {too few arguments to math function "max"}}
test expr-old-41.4 {max math function} -body {
    expr {max(wide(1) << 30, 4.5, -10)}
} -result [expr {wide(1) << 30}]
test expr-old-41.5 {max math function} -body {
    expr {max("a", 0)}
} -returnCodes error -match glob -result *
test expr-old-41.6 {max math function} -body {
    expr {max(200, "0xFF")}
} -result 255
test expr-old-41.7 {max math function} -body {
    expr max(1[string repeat 0 10000], 1e300)
} -result 1[string repeat 0 10000]
test expr-old-41.8 {max math function} -body {
    expr {max(0, "a")}
} -returnCodes error -match glob -result *

# Special test for Pentium arithmetic bug of 1994:

if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
    puts "Warning: this machine contains a defective Pentium processor"
    puts "that performs arithmetic incorrectly.  I recommend that you"
    puts "call Intel customer service immediately at 1-800-628-8686"

Changes to tests/expr.test.

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
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












-
-
+
+



-
+
+
+




-
-
-
+
+
+
+







# Commands covered: expr
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
testConstraint testmathfunctions [expr {
    ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
}]

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
131
132
133
134
135
136
137

138
139
140
141
142
143
144
145







-
+







    global xxx
    set xxx ""
    12days 1 1 1
    set result [string length $xxx]
    unset xxx
    return $result
}


# start of tests

catch {unset a b i x}

test expr-1.1 {TclCompileExprCmd: no expression} {
    list [catch {expr  } msg] $msg
} {1 {wrong # args: should be "expr arg ?arg ...?"}}
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
250
251
252
253
254
255
256

257
258
259
260
261
262
263
264







-
+







test expr-4.9 {CompileLorExpr: long lor arm} {
    set a "abcdefghijkl"
    set i 7
    expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
} 1
test expr-4.10 {CompileLorExpr: error compiling ! operand} {
    list [catch {expr {!"a"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-4.11 {CompileLorExpr: error compiling land arms} {
    list [catch {expr {"a"||0}} msg] $msg
} {1 {expected boolean value but got "a"}}
test expr-4.12 {CompileLorExpr: error compiling land arms} {
    list [catch {expr {0||"a"}} msg] $msg
} {1 {expected boolean value but got "a"}}

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
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







-
+


-
+




















-
+


-
+







    expr 2***3|6
} -returnCodes error -match glob -result *
test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
    expr 2^x
} -returnCodes error -match glob -result *
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {24.0^3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "^"}}
} {1 {can't use floating-point value as operand of "^"}}
test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
    list [catch {expr {"a"^"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "^"}}
} {1 {can't use non-numeric string as operand of "^"}}

test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
test expr-7.5 {CompileBitAndExpr: error in equality expr} -body {
    expr x==3
} -returnCodes error -match glob -result *
test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2***3&6
} -returnCodes error -match glob -result *
test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
    expr 2&x
} -returnCodes error -match glob -result *
test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {24.0&3}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of "&"}}
} {1 {can't use floating-point value as operand of "&"}}
test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
    list [catch {expr {"a"&"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "&"}}
} {1 {can't use non-numeric string as operand of "&"}}
test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
    expr xne3
} -returnCodes error -match glob -result *

test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
346
347
348
349
350
351
352
353




354
355
356
357
358
359
360
349
350
351
352
353
354
355

356
357
358
359
360
361
362
363
364
365
366







-
+
+
+
+







test expr-8.10 {CompileEqualityExpr: error compiling equality arm} -body {
    expr 2***3==6
} -returnCodes error -match glob -result *
test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
    expr 2!=x
} -returnCodes error -match glob -result *
test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \u00fc]}} 1
test expr-8.13 {CompileBitAndExpr: equality expr} {
    set s \u00fc
    expr {"\374" eq $s}
} 1
test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0
test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1
test expr-8.17 {CompileBitAndExpr: equality expr} {expr 01eq1} 0
test expr-8.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-8.19 {CompileBitAndExpr: equality expr} {expr {"abc" ne "abd"}} 1
test expr-8.20 {CompileBitAndExpr: error in equality expr} -body {
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+

-
+
+
+
+







} -returnCodes error -match glob -result *
test expr-8.34 {expr edge cases} -body {
    expr {1E+}
} -returnCodes error -match glob -result *
test expr-8.35 {expr edge cases} -body {
    expr {1ea}
} -returnCodes error -match glob -result *
test expr-8.36 {CompileEqualtyExpr: string comparison ops} {
    set x 012
    set y 0x0
    list [expr {$x < $y}] [expr {$x lt $y}] [expr {$x lt $x}]
} {0 1 0}
test expr-8.37 {CompileEqualtyExpr: string comparison ops} {
    set x 012
    set y 0x0
    list [expr {$x <= $y}] [expr {$x le $y}] [expr {$x le $x}]
} {0 1 1}
test expr-8.38 {CompileEqualtyExpr: string comparison ops} {
    set x 012
    set y 0x0
    list [expr {$x > $y}] [expr {$x gt $y}] [expr {$x gt $x}]
} {1 0 0}
test expr-8.39 {CompileEqualtyExpr: string comparison ops} {
    set x 012
    set y 0x0
    list [expr {$x >= $y}] [expr {$x ge $y}] [expr {$x ge $x}]
} {1 0 1}

test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
    expr {int(1<<63)}
} 9223372036854775808
} -9223372036854775808
test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
    expr {int(1<<31)}
} -2147483648
test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
    expr x>>3
} -returnCodes error -match glob -result *
test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
    expr 2***3>6
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
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







-
+


-
+


















-
+


-
+







    expr 2***3>>6
} -returnCodes error -match glob -result *
test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
    expr 2<<x
} -returnCodes error -match glob -result *
test expr-10.10 {CompileShiftExpr: runtime error} {
    list [catch {expr {24.0>>43}} msg] $msg
} {1 {can't use floating-point value "24.0" as operand of ">>"}}
} {1 {can't use floating-point value as operand of ">>"}}
test expr-10.11 {CompileShiftExpr: runtime error} {
    list [catch {expr {"a"<<"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "<<"}}
} {1 {can't use non-numeric string as operand of "<<"}}

test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
test expr-11.5 {CompileAddExpr: error in multiply expr} -body {
    expr x*3
} -returnCodes error -match glob -result *
test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
test expr-11.8 {CompileAddExpr: error compiling add arm} -body {
    expr 2***3+6
} -returnCodes error -match glob -result *
test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
    expr 2-x
} -returnCodes error -match glob -result *
test expr-11.10 {CompileAddExpr: runtime error} {
    list [catch {expr {24.0+"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test expr-11.11 {CompileAddExpr: runtime error} {
    list [catch {expr {"a"-"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "-"}}
} {1 {can't use non-numeric string as operand of "-"}}
test expr-11.12 {CompileAddExpr: runtime error} {
    list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
test expr-11.13a {CompileAddExpr: runtime error} !ieeeFloatingPoint {
    list [catch {expr {2.3/0.0}} msg] $msg
} {1 {divide by zero}}
test expr-11.13b {CompileAddExpr: runtime error} ieeeFloatingPoint {
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
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







-
+


-
+
















-
+


-
+







    expr 2*3%%6
} -returnCodes error -match glob -result *
test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
    expr 2*x
} -returnCodes error -match glob -result *
test expr-12.10 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {24.0*"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "*"}}
} {1 {can't use non-numeric string as operand of "*"}}
test expr-12.11 {CompileMultiplyExpr: runtime error} {
    list [catch {expr {"a"/"b"}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "/"}}
} {1 {can't use non-numeric string as operand of "/"}}

test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
test expr-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
    expr ~x
} -returnCodes error -match glob -result *
test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
    expr !1.x
} -returnCodes error -match glob -result *
test expr-13.10 {CompileUnaryExpr: runtime error} {
    list [catch {expr {~"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "~"}}
} {1 {can't use non-numeric string as operand of "~"}}
test expr-13.11 {CompileUnaryExpr: runtime error} {
    list [catch {expr ~4.0} msg] $msg
} {1 {can't use floating-point value "4.0" as operand of "~"}}
} {1 {can't use floating-point value as operand of "~"}}
test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test expr-13.13 {CompileUnaryExpr: just primary expr} {
    set a 27
    expr $a
} 27
test expr-13.14 {CompileUnaryExpr: just primary expr} {
    expr double(27)
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
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







-
+


-
+


-
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    set ::errorInfo
} -match glob -result {too many arguments for math function*
    while *ing
"expr sin(1,2,3)"}
test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
    catch {expr sin()} msg
    set ::errorInfo
} -match glob -result {not enough arguments for math function*
} -match glob -result {too few arguments for math function*
    while *ing
"expr sin()"}
test expr-15.5 {CompileMathFuncCall: not enough arguments} -body {
test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
    catch {expr pow(1)} msg
    set ::errorInfo
} -match glob -result {not enough arguments for math function*
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *
test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr 2*T1()
} 246
test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T2()*3
} 1035
test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(21, 37)
} 37
test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(21.2, 37)
} 37.0
test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(-21.2, -17.5)
} -17.5
test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(21, wide(37))
} 37
test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), 37)
} 37
test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), wide(37))
} 37
test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(21.0, wide(37))
} 37.0
test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), 37.0)
} 37.0
test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints {
    testmathfunctions
} -body {
    expr T3(0,"a")
} -returnCodes error -result {argument to math function didn't have numeric value}


test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {
724
725
726
727
728
729
730
731

732
733
734
735
736
737
738
748
749
750
751
752
753
754

755
756
757
758
759
760
761
762







-
+







# double, convert to double.

test expr-18.1 {expr and conversion of operands to numbers} {
    set x [lindex 11 0]
    catch {expr int($x)}
    expr {$x}
} 11
test expr-18.2 {whitespace strings should not be == 0 (buggy strtol/strtoul)} {
test expr-18.2 {whitespace strings should not be == 0 (buggy strtod)} {
    expr {" "}
} { }

# Check "expr" and interpreter result object resetting before appending
# an error msg during evaluation of exprs not in {}s

test expr-19.1 {expr and interpreter result object resetting} {
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
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







-
+



-
+



-
+



















-
+



-
+




-
+






-
+












-
+







test expr-21.11 {non-numeric boolean literals} {expr !no   } 1
test expr-21.12 {non-numeric boolean literals} {expr !yes  } 0
test expr-21.13 {non-numeric boolean literals} -body {
    expr !truef
} -returnCodes error -match glob -result *
test expr-21.14 {non-numeric boolean literals} {
    list [catch {expr !"truef"} err] $err
} {1 {can't use non-numeric string "truef" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.15 {non-numeric boolean variables} {
    set v truef
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "truef" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.16 {non-numeric boolean variables} {
    set v "true "
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "true " as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.17 {non-numeric boolean variables} {
    set v "tru"
    list [catch {expr {!$v}} err] $err
} {0 0}
test expr-21.18 {non-numeric boolean variables} {
    set v "fal"
    list [catch {expr {!$v}} err] $err
} {0 1}
test expr-21.19 {non-numeric boolean variables} {
    set v "y"
    list [catch {expr {!$v}} err] $err
} {0 0}
test expr-21.20 {non-numeric boolean variables} {
    set v "of"
    list [catch {expr {!$v}} err] $err
} {0 1}
test expr-21.21 {non-numeric boolean variables} {
    set v "o"
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "o" as operand of "!"}}
} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.22 {non-numeric boolean variables} {
    set v ""
    list [catch {expr {!$v}} err] $err
} {1 {can't use non-numeric string "" as operand of "!"}}
} {1 {can't use empty string as operand of "!"}}

# Test for non-numeric float handling.
test expr-22.1 {non-numeric floats} {
    list [catch {expr {NaN + 1}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
} {1 {can't use non-numeric floating-point value as operand of "+"}}
test expr-22.2 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr {Inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.3 {non-numeric floats} {
    set nan NaN
    list [catch {expr {$nan + 1}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
} {1 {can't use non-numeric floating-point value as operand of "+"}}
test expr-22.4 {non-numeric floats} !ieeeFloatingPoint {
    set inf Inf
    list [catch {expr {$inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.5 {non-numeric floats} {
    list [catch {expr NaN} msg] $msg
} {1 {domain error: argument not in valid range}}
test expr-22.6 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr Inf} msg] $msg
} {1 {floating-point value too large to represent}}
test expr-22.7 {non-numeric floats} {
    list [catch {expr {1 / NaN}} msg] $msg
} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}}
} {1 {can't use non-numeric floating-point value as operand of "/"}}
test expr-22.8 {non-numeric floats} !ieeeFloatingPoint {
    list [catch {expr {1 / Inf}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "/"}}
# Make sure [Bug 761471] stays fixed.
test expr-22.9 {non-numeric floats: shared object equality and NaN} {
    set x NaN
    expr {$x == $x}
909
910
911
912
913
914
915
916

917
918
919

920
921
922
923
924
925
926
933
934
935
936
937
938
939

940
941
942

943
944
945
946
947
948
949
950







-
+


-
+







    expr (-3-)**6
} -returnCodes error -match glob -result *
test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
    expr 2**x
} -returnCodes error -match glob -result *
test expr-23.9 {CompileExponentialExpr: runtime error} {
    list [catch {expr {24.0**"xx"}} msg] $msg
} {1 {can't use non-numeric string "xx" as operand of "**"}}
} {1 {can't use non-numeric string as operand of "**"}}
test expr-23.10 {CompileExponentialExpr: runtime error} {
    list [catch {expr {"a"**2}} msg] $msg
} {1 {can't use non-numeric string "a" as operand of "**"}}
} {1 {can't use non-numeric string as operand of "**"}}
test expr-23.11 {CompileExponentialExpr: runtime error} {
    list [catch {expr {0**-1}} msg] $msg
} {1 {exponentiation of zero by negative power}}
test expr-23.12 {CompileExponentialExpr: runtime error} {
    list [catch {expr {0.0**-1.0}} msg] $msg
} {1 {exponentiation of zero by negative power}}
test expr-23.13 {CompileExponentialExpr: runtime error} {
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
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
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
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
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
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
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
1439
1440

1441
1442
1443
1444
1445
1446


1447
1448
1449
1450
1451
1452
1453
1454
1455







-
+














-
+














-
+














-
+














-
+














-
+











-
+











-
+











-
+














-
+














-
+














-
+














-
+














-
+














-
+














-
+














-
+














-
+











-
+











-
+











-
+





-
+





-
-
+
+







test expr-23.54.10 {INST_EXPON: Bug 2798543} {
    expr {3**19 == 3**65555}
} 0
test expr-23.54.11 {INST_EXPON: Bug 2798543} {
    expr {3**9 == 3**131081}
} 0
test expr-23.54.12 {INST_EXPON: Bug 2798543} -body {
    expr {3**268435456}
    expr {3**9 == 3**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.54.13 {INST_EXPON: Bug 2798543} {
    expr {(-3)**9 == (-3)**65545}
} 0
test expr-23.55.0 {INST_EXPON: Bug 2798543} {
    expr {4**9 == 4**65545}
} 0
test expr-23.55.1 {INST_EXPON: Bug 2798543} {
    expr {4**15 == 4**65551}
} 0
test expr-23.55.2 {INST_EXPON: Bug 2798543} {
    expr {4**9 == 4**131081}
} 0
test expr-23.55.3 {INST_EXPON: Bug 2798543} -body {
    expr {4**268435456}
    expr {4**9 == 4**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.55.4 {INST_EXPON: Bug 2798543} {
    expr {(-4)**9 == (-4)**65545}
} 0
test expr-23.56.0 {INST_EXPON: Bug 2798543} {
    expr {5**9 == 5**65545}
} 0
test expr-23.56.1 {INST_EXPON: Bug 2798543} {
    expr {5**13 == 5**65549}
} 0
test expr-23.56.2 {INST_EXPON: Bug 2798543} {
    expr {5**9 == 5**131081}
} 0
test expr-23.56.3 {INST_EXPON: Bug 2798543} -body {
    expr {5**268435456}
    expr {5**9 == 5**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.56.4 {INST_EXPON: Bug 2798543} {
    expr {(-5)**9 == (-5)**65545}
} 0
test expr-23.57.0 {INST_EXPON: Bug 2798543} {
    expr {6**9 == 6**65545}
} 0
test expr-23.57.1 {INST_EXPON: Bug 2798543} {
    expr {6**11 == 6**65547}
} 0
test expr-23.57.2 {INST_EXPON: Bug 2798543} {
    expr {6**9 == 6**131081}
} 0
test expr-23.57.3 {INST_EXPON: Bug 2798543} -body {
    expr {6**268435456}
    expr {6**9 == 6**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.57.4 {INST_EXPON: Bug 2798543} {
    expr {(-6)**9 == (-6)**65545}
} 0
test expr-23.58.0 {INST_EXPON: Bug 2798543} {
    expr {7**9 == 7**65545}
} 0
test expr-23.58.1 {INST_EXPON: Bug 2798543} {
    expr {7**11 == 7**65547}
} 0
test expr-23.58.2 {INST_EXPON: Bug 2798543} {
    expr {7**9 == 7**131081}
} 0
test expr-23.58.3 {INST_EXPON: Bug 2798543} -body {
    expr {7**268435456}
    expr {7**9 == 7**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.58.4 {INST_EXPON: Bug 2798543} {
    expr {(-7)**9 == (-7)**65545}
} 0
test expr-23.59.0 {INST_EXPON: Bug 2798543} {
    expr {8**9 == 8**65545}
} 0
test expr-23.59.1 {INST_EXPON: Bug 2798543} {
    expr {8**10 == 8**65546}
} 0
test expr-23.59.2 {INST_EXPON: Bug 2798543} {
    expr {8**9 == 8**131081}
} 0
test expr-23.59.3 {INST_EXPON: Bug 2798543} -body {
    expr {8**268435456}
    expr {8**9 == 8**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.59.4 {INST_EXPON: Bug 2798543} {
    expr {(-8)**9 == (-8)**65545}
} 0
test expr-23.60.0 {INST_EXPON: Bug 2798543} {
    expr {9**9 == 9**65545}
} 0
test expr-23.60.1 {INST_EXPON: Bug 2798543} {
    expr {9**9 == 9**131081}
} 0
test expr-23.60.2 {INST_EXPON: Bug 2798543} -body {
    expr {9**268435456}
    expr {9**9 == 9**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.60.3 {INST_EXPON: Bug 2798543} {
    expr {(-9)**9 == (-9)**65545}
} 0
test expr-23.61.0 {INST_EXPON: Bug 2798543} {
    expr {10**9 == 10**65545}
} 0
test expr-23.61.1 {INST_EXPON: Bug 2798543} {
    expr {10**9 == 10**131081}
} 0
test expr-23.61.2 {INST_EXPON: Bug 2798543} -body {
    expr {10**268435456}
    expr {10**9 == 10**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.61.3 {INST_EXPON: Bug 2798543} {
    expr {(-10)**9 == (-10)**65545}
} 0
test expr-23.62.0 {INST_EXPON: Bug 2798543} {
    expr {11**9 == 11**65545}
} 0
test expr-23.62.1 {INST_EXPON: Bug 2798543} {
    expr {11**9 == 11**131081}
} 0
test expr-23.62.2 {INST_EXPON: Bug 2798543} -body {
    expr {11**268435456}
    expr {11**9 == 11**268435465}
} -returnCodes error -result {exponent too large}
test expr-23.62.3 {INST_EXPON: Bug 2798543} {
    expr {(-11)**9 == (-11)**65545}
} 0
test expr-23.63.0 {INST_EXPON: Bug 2798543} {
    expr {3**20 == 3**65556}
} 0
test expr-23.63.1 {INST_EXPON: Bug 2798543} {
    expr {3**39 == 3**65575}
} 0
test expr-23.63.2 {INST_EXPON: Bug 2798543} {
    expr {3**20 == 3**131092}
} 0
test expr-23.63.3 {INST_EXPON: Bug 2798543} -body {
    expr {3**268435456}
    expr {3**20 == 3**268435476}
} -returnCodes error -result {exponent too large}
test expr-23.63.4 {INST_EXPON: Bug 2798543} {
    expr {(-3)**20 == (-3)**65556}
} 0
test expr-23.64.0 {INST_EXPON: Bug 2798543} {
    expr {4**17 == 4**65553}
} 0
test expr-23.64.1 {INST_EXPON: Bug 2798543} {
    expr {4**31 == 4**65567}
} 0
test expr-23.64.2 {INST_EXPON: Bug 2798543} {
    expr {4**17 == 4**131089}
} 0
test expr-23.64.3 {INST_EXPON: Bug 2798543} -body {
    expr {4**268435456}
    expr {4**17 == 4**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.64.4 {INST_EXPON: Bug 2798543} {
    expr {(-4)**17 == (-4)**65553}
} 0
test expr-23.65.0 {INST_EXPON: Bug 2798543} {
    expr {5**17 == 5**65553}
} 0
test expr-23.65.1 {INST_EXPON: Bug 2798543} {
    expr {5**27 == 5**65563}
} 0
test expr-23.65.2 {INST_EXPON: Bug 2798543} {
    expr {5**17 == 5**131089}
} 0
test expr-23.65.3 {INST_EXPON: Bug 2798543} -body {
    expr {5**268435456}
    expr {5**17 == 5**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.65.4 {INST_EXPON: Bug 2798543} {
    expr {(-5)**17 == (-5)**65553}
} 0
test expr-23.66.0 {INST_EXPON: Bug 2798543} {
    expr {6**17 == 6**65553}
} 0
test expr-23.66.1 {INST_EXPON: Bug 2798543} {
    expr {6**24 == 6**65560}
} 0
test expr-23.66.2 {INST_EXPON: Bug 2798543} {
    expr {6**17 == 6**131089}
} 0
test expr-23.66.3 {INST_EXPON: Bug 2798543} -body {
    expr {6**268435456}
    expr {6**17 == 6**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.66.4 {INST_EXPON: Bug 2798543} {
    expr {(-6)**17 == (-6)**65553}
} 0
test expr-23.67.0 {INST_EXPON: Bug 2798543} {
    expr {7**17 == 7**65553}
} 0
test expr-23.67.1 {INST_EXPON: Bug 2798543} {
    expr {7**22 == 7**65558}
} 0
test expr-23.67.2 {INST_EXPON: Bug 2798543} {
    expr {7**17 == 7**131089}
} 0
test expr-23.67.3 {INST_EXPON: Bug 2798543} -body {
    expr {7**268435456}
    expr {7**17 == 7**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.67.4 {INST_EXPON: Bug 2798543} {
    expr {(-7)**17 == (-7)**65553}
} 0
test expr-23.68.0 {INST_EXPON: Bug 2798543} {
    expr {8**17 == 8**65553}
} 0
test expr-23.68.1 {INST_EXPON: Bug 2798543} {
    expr {8**20 == 8**65556}
} 0
test expr-23.68.2 {INST_EXPON: Bug 2798543} {
    expr {8**17 == 8**131089}
} 0
test expr-23.68.3 {INST_EXPON: Bug 2798543} -body {
    expr {8**268435456}
    expr {8**17 == 8**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.68.4 {INST_EXPON: Bug 2798543} {
    expr {(-8)**17 == (-8)**65553}
} 0
test expr-23.69.0 {INST_EXPON: Bug 2798543} {
    expr {9**17 == 9**65553}
} 0
test expr-23.69.1 {INST_EXPON: Bug 2798543} {
    expr {9**19 == 9**65555}
} 0
test expr-23.69.2 {INST_EXPON: Bug 2798543} {
    expr {9**17 == 9**131089}
} 0
test expr-23.69.3 {INST_EXPON: Bug 2798543} -body {
    expr {9**268435456}
    expr {9**17 == 9**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.69.4 {INST_EXPON: Bug 2798543} {
    expr {(-9)**17 == (-9)**65553}
} 0
test expr-23.70.0 {INST_EXPON: Bug 2798543} {
    expr {10**17 == 10**65553}
} 0
test expr-23.70.1 {INST_EXPON: Bug 2798543} {
    expr {10**18 == 10**65554}
} 0
test expr-23.70.2 {INST_EXPON: Bug 2798543} {
    expr {10**17 == 10**131089}
} 0
test expr-23.70.3 {INST_EXPON: Bug 2798543} -body {
    expr {10**268435456}
    expr {10**17 == 10**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.70.4 {INST_EXPON: Bug 2798543} {
    expr {(-10)**17 == (-10)**65553}
} 0
test expr-23.71.0 {INST_EXPON: Bug 2798543} {
    expr {11**17 == 11**65553}
} 0
test expr-23.71.1 {INST_EXPON: Bug 2798543} {
    expr {11**18 == 11**65554}
} 0
test expr-23.71.2 {INST_EXPON: Bug 2798543} {
    expr {11**17 == 11**131089}
} 0
test expr-23.71.3 {INST_EXPON: Bug 2798543} -body {
    expr {11**268435456}
    expr {11**17 == 11**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.71.4 {INST_EXPON: Bug 2798543} {
    expr {(-11)**17 == (-11)**65553}
} 0
test expr-23.72.0 {INST_EXPON: Bug 2798543} {
    expr {12**17 == 12**65553}
} 0
test expr-23.72.1 {INST_EXPON: Bug 2798543} {
    expr {12**17 == 12**131089}
} 0
test expr-23.72.2 {INST_EXPON: Bug 2798543} -body {
    expr {12**268435456}
    expr {12**17 == 12**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.72.3 {INST_EXPON: Bug 2798543} {
    expr {(-12)**17 == (-12)**65553}
} 0
test expr-23.73.0 {INST_EXPON: Bug 2798543} {
    expr {13**17 == 13**65553}
} 0
test expr-23.73.1 {INST_EXPON: Bug 2798543} {
    expr {13**17 == 13**131089}
} 0
test expr-23.73.2 {INST_EXPON: Bug 2798543} -body {
    expr {13**268435456}
    expr {13**17 == 13**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.73.3 {INST_EXPON: Bug 2798543} {
    expr {(-13)**17 == (-13)**65553}
} 0
test expr-23.74.0 {INST_EXPON: Bug 2798543} {
    expr {14**17 == 14**65553}
} 0
test expr-23.74.1 {INST_EXPON: Bug 2798543} {
    expr {14**17 == 14**131089}
} 0
test expr-23.74.2 {INST_EXPON: Bug 2798543} -body {
    expr {14**268435456}
    expr {14**17 == 14**268435473}
} -returnCodes error -result {exponent too large}
test expr-23.74.3 {INST_EXPON: Bug 2798543} {
    expr {(-14)**17 == (-14)**65553}
} 0


	
# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
test expr-24.5 {expr edge cases; shifting} {expr int(5<<32)} 21474836480
test expr-24.6 {expr edge cases; shifting} {expr int(5<<63)} 46116860184273879040
test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0

test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000

# List membership tests
5758
5759
5760
5761
5762
5763
5764
5765

5766
5767
5768
5769
5770
5771
5772
5782
5783
5784
5785
5786
5787
5788

5789
5790
5791
5792
5793
5794
5795
5796







-
+







    0 1 1 1 1 \
    0 -1 -2 -3 -4 \
    0 0 2 2 2 \
    0 0 -1 -2 -3 \
    0 1 0 3 3 \
    0 -1 0 -1 -2 \
    ]

        
test expr-32.2 {expr div basics} {
    set mod_nums [list \
        {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
        {-3 -1} {-3 -2} {-3 -3} {-3 -4} {-3 -5} \
        {-2 1} {-2 2} {-2 3} {-2 4} {-2 5} \
        {-2 -1} {-2 -2} {-2 -3} {-2 -4} {-2 -5} \
        {-1 1} {-1 2} {-1 3} {-1 4} {-1 5} \
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827

5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841

5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
5858
5859
5860
5861

5862
5863
5864
5865
5866
5867
5868
5834
5835
5836
5837
5838
5839
5840









5841

5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855

5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875

5876
5877
5878
5879
5880
5881
5882
5883







-
-
-
-
-
-
-
-
-

-
+













-
+



















-
+







} [expr (1<<63)-1]
test expr-32.5 {Bug 1585704} {
    expr (1<<32)%(1<<63)
} [expr 1<<32]
test expr-32.6 {Bug 1585704} {
    expr -(1<<32)%(1<<63)
} [expr (1<<63)-(1<<32)]
test expr-32.7 {bignum regression} {
    expr {0%(1<<63)}
} 0
test expr-32.8 {bignum regression} {
    expr {0%-(1<<63)}
} 0
test expr-32.9 {bignum regression} {
    expr {0%-(1+(1<<63))}
} 0

test expr-33.1 {parse largest long value} {
test expr-33.1 {parse largest long value} longIs32bit {
    set max_long_str 2147483647
    set max_long_hex "0x7FFFFFFF "

    # Convert to integer (long, not wide) internal rep
    set max_long 2147483647
    string is integer $max_long

    list \
        [expr {" $max_long_str "}] \
        [expr {$max_long_str + 0}] \
        [expr {$max_long + 0}] \
        [expr {2147483647 + 0}] \
        [expr {$max_long == $max_long_hex}] \
        [expr {int(2147483647 + 1) > 0}] \
        [expr {int(2147483647 + 1) < 0}] \

} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
    set min_long_str -2147483648
    set min_long_hex "-0x80000000 "

    set min_long -2147483648
    # This will convert to integer (not wide) internal rep
    string is integer $min_long

    # Note: If the final expression returns 0 then the
    # expression literal is being promoted to a wide type
    # when it should be parsed as a long type.
    list \
        [expr {" $min_long_str "}] \
        [expr {$min_long_str + 0}] \
        [expr {$min_long + 0}] \
        [expr {-2147483648 + 0}] \
        [expr {$min_long == $min_long_hex}] \
        [expr {int(-2147483648 - 1) == -0x80000001}] \
        [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \

} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
    set max_wide_str 9223372036854775807
    set max_wide_hex "0x7FFFFFFFFFFFFFFF "

    # Convert to wide integer
5934
5935
5936
5937
5938
5939
5940
5941

5942
5943

5944
5945
5946
5947
5948


5949
5950
5951


5952
5953
5954
5955
5956
5957
5958
5949
5950
5951
5952
5953
5954
5955

5956
5957

5958
5959
5960
5961


5962
5963
5964


5965
5966
5967
5968
5969
5970
5971
5972
5973







-
+

-
+



-
-
+
+

-
-
+
+







} {-2}
test expr-34.11 {expr edge cases} {
    expr {$min / -2}
} {1073741824}
test expr-34.12 {expr edge cases} {
    expr {$min % -2}
} {0}
test expr-34.13 {expr edge cases} {
test expr-34.13 {expr edge cases} longIs32bit {
    expr {int($min / -1)}
} {2147483648}
} {-2147483648}
test expr-34.14 {expr edge cases} {
    expr {$min % -1}
} {0}
test expr-34.15 {expr edge cases} {
    expr {-int($min * -1)}
test expr-34.15 {expr edge cases} longIs32bit {
    expr {int($min * -1)}
} $min
test expr-34.16 {expr edge cases} {
    expr {-int(-$min)}
test expr-34.16 {expr edge cases} longIs32bit {
    expr {int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
    expr {$min / 1}
} $min
test expr-34.18 {expr edge cases} {
    expr {$min % 1}
} {0}
6731
6732
6733
6734
6735
6736
6737
6738
6739


6740
6741
6742
6743
6744
6745
6746
6746
6747
6748
6749
6750
6751
6752


6753
6754
6755
6756
6757
6758
6759
6760
6761







-
-
+
+







	list [catch {testexprlongobj 0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -0x7fffffff
} {This is a result: -2147483647}
    testexprlongobj -0xffffffff
} {This is a result: 1}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj -0x100000000} result] $result
    } \
    -result {1 {integer value too large to represent*}}
6757
6758
6759
6760
6761
6762
6763
6764
6765


6766
6767
6768
6769
6770
6771
6772
6773

6774
6775
6776
6777
6778
6779
6780
6772
6773
6774
6775
6776
6777
6778


6779
6780
6781
6782
6783
6784
6785
6786
6787

6788
6789
6790
6791
6792
6793
6794
6795







-
-
+
+







-
+







	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}
test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
    testexprlongobj -2147483648.
} {This is a result: -2147483648}
    testexprlongobj -4294967295.
} {This is a result: 1}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
    -constraints {testexprlongobj longIs32bit} \
    -match glob \
    -body {
	list [catch {testexprlongobj 4294967296.} result] $result
    } \
    -result {1 {integer value too large to represent*}}

    
test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
    testexprdoubleobj 4.+1.
} {This is a result: 5.0}
#Check for [Bug 1109484]
test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \
    -constraints {testexprdoubleobj} \
    -match glob \
6853
6854
6855
6856
6857
6858
6859
6860

6861
6862
6863

6864
6865
6866

6867
6868
6869
6870
6871
6872

6873
6874
6875
6876
6877
6878
6879
6868
6869
6870
6871
6872
6873
6874

6875
6876
6877

6878
6879
6880

6881
6882
6883
6884
6885
6886

6887
6888
6889
6890
6891
6892
6893
6894







-
+


-
+


-
+





-
+







    expr 1e-2147483649
} 0.0
test expr-41.13 {exponent overflow} {
    expr 100e-2147483650
} 0.0
test expr-41.14 {exponent overflow} {
    expr 100e-2147483651
} 0.0
} 0.0 
test expr-41.15 {exponent overflow} {
    expr 1.0e-2147483648
} 0.0
} 0.0 
test expr-41.16 {exponent overflow} {
    expr 1.0e-2147483649
} 0.0
} 0.0 
test expr-41.17 {exponent overflow} {
    expr 1.23e-2147483646
} 0.0
test expr-41.18 {exponent overflow} {
    expr 1.23e-2147483647
} 0.0
} 0.0 

test expr-41.19 {numSigDigs == 0} {
    expr 0e309
} 0.0
test expr-41.20 {numSigDigs == 0} {
    expr 0e310
} 0.0
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249

7250
7251
7252
7253
7254
7255
7256
7257
7258
7259
7260
7261
7262
7263
7264
7265
7266
7267
7268
7269
7270

7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288
7289
7290
7291
7292
7293
7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346
7347
7348
7349
7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377

7378
7379
7380
7381
7382
7383

7384
7385
7386

7387
7388

7389
7390
7391
7392
7393
7394
7395
7396
7236
7237
7238
7239
7240
7241
7242





7243
7244
7245
7246
7247
7248
7249
7250









7251





















7252











































































































7253






7254



7255


7256


7257
7258
7259
7260
7261
7262







-
-
-
-
-








-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
+
-
-
+
-
-






    set trouble
} {}

test expr-48.1 {Bug 1770224} {
    expr {-0x8000000000000001 >> 0x8000000000000000}
} -1

test expr-49.1 {Bug 2823282} {
    coroutine foo apply {{} {set expr expr; $expr {[yield]}}}
    foo 1
} 1

test expr-50.1 {test sqrt() of bignums with non-Inf answer} {
    expr {sqrt("1[string repeat 0 616]") == 1e308}
} 1

test expr-51.1 {test round-to-even on input} {
    expr 6.9294956446009195e15
} 6929495644600920.0

test expr-52.1 {
	comparison with empty string does not generate string representation
} {
	set a [list one two three]
	list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [
		string match {*no string representation*} [
		::tcl::unsupported::representation $a]]
} {0 0 1 1}

# cleanup
foreach func {isfinite isinf isnan isnormal issubnormal} {
    test expr-53.1.$func {float classification: basic arg handling} -body {
	expr ${func}()
    } -returnCodes error -result "not enough arguments for math function \"$func\""
    test expr-53.2.$func {float classification: basic arg handling} -body {
	expr ${func}(1,2)
    } -returnCodes error -result "too many arguments for math function \"$func\""
    test expr-53.3.$func {float classification: basic arg handling} -body {
	expr ${func}(true)
    } -returnCodes error -result {expected number but got "true"}
    test expr-53.4.$func {float classification: basic arg handling} -body {
	expr ${func}("gorp")
    } -returnCodes error -result {expected number but got "gorp"}
    test expr-53.5.$func {float classification: basic arg handling} -body {
	expr ${func}(1.0)
    } -match glob -result *
    test expr-53.6.$func {float classification: basic arg handling} -body {
	expr ${func}(0x123)
    } -match glob -result *
}

if {[info exists a]} {
test expr-54.0 {float classification: isfinite} {expr {isfinite(1.0)}} 1
test expr-54.1 {float classification: isfinite} {expr {isfinite(-1.0)}} 1
test expr-54.2 {float classification: isfinite} {expr {isfinite(0.0)}} 1
test expr-54.3 {float classification: isfinite} {expr {isfinite(-0.0)}} 1
test expr-54.4 {float classification: isfinite} {expr {isfinite(1/Inf)}} 1
test expr-54.5 {float classification: isfinite} {expr {isfinite(-1/Inf)}} 1
test expr-54.6 {float classification: isfinite} {expr {isfinite(1e-314)}} 1
test expr-54.7 {float classification: isfinite} {expr {isfinite(inf)}} 0
test expr-54.8 {float classification: isfinite} {expr {isfinite(-inf)}} 0
test expr-54.9 {float classification: isfinite} {expr {isfinite(NaN)}} 0

test expr-55.0 {float classification: isinf} {expr {isinf(1.0)}} 0
test expr-55.1 {float classification: isinf} {expr {isinf(-1.0)}} 0
test expr-55.2 {float classification: isinf} {expr {isinf(0.0)}} 0
test expr-55.3 {float classification: isinf} {expr {isinf(-0.0)}} 0
test expr-55.4 {float classification: isinf} {expr {isinf(1/Inf)}} 0
test expr-55.5 {float classification: isinf} {expr {isinf(-1/Inf)}} 0
test expr-55.6 {float classification: isinf} {expr {isinf(1e-314)}} 0
test expr-55.7 {float classification: isinf} {expr {isinf(inf)}} 1
test expr-55.8 {float classification: isinf} {expr {isinf(-inf)}} 1
test expr-55.9 {float classification: isinf} {expr {isinf(NaN)}} 0

test expr-56.0 {float classification: isnan} {expr {isnan(1.0)}} 0
test expr-56.1 {float classification: isnan} {expr {isnan(-1.0)}} 0
test expr-56.2 {float classification: isnan} {expr {isnan(0.0)}} 0
test expr-56.3 {float classification: isnan} {expr {isnan(-0.0)}} 0
test expr-56.4 {float classification: isnan} {expr {isnan(1/Inf)}} 0
test expr-56.5 {float classification: isnan} {expr {isnan(-1/Inf)}} 0
test expr-56.6 {float classification: isnan} {expr {isnan(1e-314)}} 0
test expr-56.7 {float classification: isnan} {expr {isnan(inf)}} 0
test expr-56.8 {float classification: isnan} {expr {isnan(-inf)}} 0
test expr-56.9 {float classification: isnan} {expr {isnan(NaN)}} 1

test expr-57.0 {float classification: isnormal} {expr {isnormal(1.0)}} 1
test expr-57.1 {float classification: isnormal} {expr {isnormal(-1.0)}} 1
test expr-57.2 {float classification: isnormal} {expr {isnormal(0.0)}} 0
test expr-57.3 {float classification: isnormal} {expr {isnormal(-0.0)}} 0
test expr-57.4 {float classification: isnormal} {expr {isnormal(1/Inf)}} 0
test expr-57.5 {float classification: isnormal} {expr {isnormal(-1/Inf)}} 0
test expr-57.6 {float classification: isnormal} {expr {isnormal(1e-314)}} 0
test expr-57.7 {float classification: isnormal} {expr {isnormal(inf)}} 0
test expr-57.8 {float classification: isnormal} {expr {isnormal(-inf)}} 0
test expr-57.9 {float classification: isnormal} {expr {isnormal(NaN)}} 0

test expr-58.0 {float classification: issubnormal} {expr {issubnormal(1.0)}} 0
test expr-58.1 {float classification: issubnormal} {expr {issubnormal(-1.0)}} 0
test expr-58.2 {float classification: issubnormal} {expr {issubnormal(0.0)}} 0
test expr-58.3 {float classification: issubnormal} {expr {issubnormal(-0.0)}} 0
test expr-58.4 {float classification: issubnormal} {expr {issubnormal(1/Inf)}} 0
test expr-58.5 {float classification: issubnormal} {expr {issubnormal(-1/Inf)}} 0
test expr-58.6 {float classification: issubnormal} {expr {issubnormal(1e-314)}} 1
test expr-58.7 {float classification: issubnormal} {expr {issubnormal(inf)}} 0
test expr-58.8 {float classification: issubnormal} {expr {issubnormal(-inf)}} 0
test expr-58.9 {float classification: issubnormal} {expr {issubnormal(NaN)}} 0

test expr-59.0 {float classification: fpclassify} {fpclassify 1.0} normal
test expr-59.1 {float classification: fpclassify} {fpclassify -1.0} normal
test expr-59.2 {float classification: fpclassify} {fpclassify 0.0} zero
test expr-59.3 {float classification: fpclassify} {fpclassify -0.0} zero
test expr-59.4 {float classification: fpclassify} {fpclassify [expr 1/Inf]} zero
test expr-59.5 {float classification: fpclassify} {fpclassify [expr -1/Inf]} zero
test expr-59.6 {float classification: fpclassify} {fpclassify 1e-314} subnormal
test expr-59.7 {float classification: fpclassify} {fpclassify inf} infinite
test expr-59.8 {float classification: fpclassify} {fpclassify -inf} infinite
test expr-59.9 {float classification: fpclassify} {fpclassify NaN} nan
test expr-59.10 {float classification: fpclassify} -returnCodes error -body {
    fpclassify
} -result {wrong # args: should be "fpclassify floatValue"}
test expr-59.11 {float classification: fpclassify} -returnCodes error -body {
    fpclassify a b
} -result {wrong # args: should be "fpclassify floatValue"}
test expr-59.12 {float classification: fpclassify} -returnCodes error -body {
    fpclassify gorp
} -result {expected number but got "gorp"}

test expr-60.1 {float classification: basic arg handling} -body {
    expr isunordered()
} -returnCodes error -result {not enough arguments for math function "isunordered"}
test expr-60.2 {float classification: basic arg handling} -body {
    expr isunordered(1)
} -returnCodes error -result {not enough arguments for math function "isunordered"}
test expr-60.3 {float classification: basic arg handling} -body {
    expr {isunordered(1, 2, 3)}
} -returnCodes error -result {too many arguments for math function "isunordered"}
test expr-60.4 {float classification: basic arg handling} -body {
    expr {isunordered(true, 1.0)}
} -returnCodes error -result {expected number but got "true"}
test expr-60.5 {float classification: basic arg handling} -body {
    expr {isunordered("gorp", 1.0)}
} -returnCodes error -result {expected number but got "gorp"}
test expr-60.6 {float classification: basic arg handling} -body {
    expr {isunordered(0x123, 1.0)}
} -match glob -result *
test expr-60.7 {float classification: basic arg handling} -body {
    expr {isunordered(1.0, true)}
} -returnCodes error -result {expected number but got "true"}
test expr-60.8 {float classification: basic arg handling} -body {
    expr {isunordered(1.0, "gorp")}
} -returnCodes error -result {expected number but got "gorp"}
test expr-60.9 {float classification: basic arg handling} -body {
    expr {isunordered(1.0, 0x123)}
} -match glob -result *

# Big matrix of comparisons, but it's just a binary isinf()
set values {1.0 -1.0 0.0 -0.0 1e-314 Inf -Inf NaN}
set results {0 0 0 0 0 0 0 1}
set ctr 0
    unset a
foreach v1 $values r1 $results {
    foreach v2 $values r2 $results {
	test expr-61.[incr ctr] "float classification: isunordered($v1,$v2)" {
	    expr {isunordered($v1, $v2)}
	} [expr {$r1 || $r2}]
    }
}
}
unset -nocomplain values results ctr

catch {unset min}
# cleanup
unset -nocomplain a
catch {unset max}
unset -nocomplain min
unset -nocomplain max
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/fCmd.test.

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
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












-
-
+
+



-
-
-





-
+
+


+
+


-
+
-
-
-
-
-
-

-
-
+
+



-







# This file tests the tclFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

cd [temporaryDirectory]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint winXP 0
testConstraint win2000orXP 0
testConstraint winOlderThan2000 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
testConstraint 2000orNewer [expr {![testConstraint 95or98]}]
testConstraint reg 0
if {[testConstraint win]} {
    catch {
    if {![catch {
	# Is the registry extension already static to this shell?
	try {
	    load {} Registry
	    set ::reglib {}
	} on error {} {
	    # try the location given to use on the commandline to tcltest
	    ::tcltest::loadTestedCommands
	    load $::reglib Registry
	}
	    set ::regver [package require registry 1.3.5]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
testConstraint foundGroup [expr {![testConstraint unix]}]
if {[testConstraint unix]} {
    catch {
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
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







+
-
-
-
-
+
+
+
+
+
+
+









+







    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
    }
}

# Also used in winFCmd...
if {[testConstraint win]} {
    if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
    if {$::tcl_platform(osVersion) >= 5.0} {
	testConstraint winVista 1
    } else {
	testConstraint winXP 1
        if {$::tcl_platform(osVersion) >= 6.0} {
            testConstraint winVista 1
        } else {
            testConstraint win2000orXP 1
        }
    } else {
        testConstraint winOlderThan2000 1
    }
}

testConstraint darwin9 [expr {
    [testConstraint unix]
    && $tcl_platform(os) eq "Darwin"
    && [package vsatisfies 1.$::tcl_platform(osVersion) 1.9]
}]
testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
testConstraint notContinuousIntegration [expr {![info exists ::env(CI)]}]

testConstraint fileSharing 0
testConstraint notFileSharing 1
testConstraint linkFile 1
testConstraint linkDirectory 1

# Several tests require need to match results against the unix username
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
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







-
+



-
+






-
+







#
# checkcontent --
#
#  Ensures that file "file" contains only the string "matchString" returns 0
#  if the file does not exist, or has a different content
#
proc checkcontent {file matchString} {
    try {
    if {[catch {
	set f [open $file]
	set fileString [read $f]
	close $f
    } on error {} {
    }]} {
	return 0
    }
    return [string match $matchString $fileString]
}

proc openup {path} {
    testchmod 0o777 $path
    testchmod 777 $path
    if {[file isdirectory $path]} {
	catch {
	    foreach p [glob -directory $path *] {
		openup $p
	    }
	}
    }
190
191
192
193
194
195
196
197

198
199
200

201
202
203
204
205
206
207
188
189
190
191
192
193
194

195
196
197

198
199
200
201
202
203
204
205







-
+


-
+







    createfile tf1
    file copy tf1 tf2
    lsort [glob tf*]
} -result {tf1 tf2}

test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
    file rename -xyz
} -returnCodes error -result {bad option "-xyz": must be -force or --}
} -returnCodes error -result {bad option "-xyz": should be -force or --}
test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body {
    file rename xyz
} -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"}
} -returnCodes error -result {wrong # args: should be "file rename ?options? source ?source ...? target"}
test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
    file rename xyz ~_totally_bogus_user
} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    file copy tf1 ~
356
357
358
359
360
361
362
363

364
365
366

367
368
369
370
371
372
373
354
355
356
357
358
359
360

361
362
363

364
365
366
367
368
369
370
371







-
+


-
+







    file mkdir td1
    list $x [file exists td1]
} -result {1 1}
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -returnCodes error -body {
    file mkdir td1/td2/td3
    testchmod 0 td1/td2
    testchmod 000 td1/td2
    file mkdir td1/td2/td3/td4
} -cleanup {
    testchmod 0o755 td1/td2
    testchmod 755 td1/td2
    cleanup
} -result {can't create directory "td1/td2/td3": permission denied}
test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
    cleanup
} -constraints {notRoot} -body {
    set x [file exists td1]
    file mkdir td1
388
389
390
391
392
393
394
395
396


397
398

399
400
401
402
403
404
405
386
387
388
389
390
391
392


393
394
395

396
397
398
399
400
401
402
403







-
-
+
+

-
+







} -constraints {notRoot} -body {
    file mkdir tf1
    file exists tf1
} -result {1}

test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
    file delete -xyz
} -returnCodes error -result {bad option "-xyz": must be -force or --}
test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body {
} -returnCodes error -result {bad option "-xyz": should be -force or --}
test fCmd-5.2 {TclFileDeleteCmd: not enough args} -constraints {notRoot} -body {
    file delete -force -force
} -result {}
} -returnCodes error -result {wrong # args: should be "file delete ?options? file ?file ...?"}
test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup {
    cleanup
} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    file delete tf2
413
414
415
416
417
418
419
420

421
422
423
424
425
426
427
411
412
413
414
415
416
417

418
419
420
421
422
423
424
425







-
+







    file mkdir td1
    set x [list [file exists tf1] [file exists tf2] [file exists td1]]
    file delete tf1 td1 tf2
    lappend x [file exists tf1] [file exists tf2] [file exists tf3]
} -cleanup {cleanup} -result {1 1 1 0 0 0}
test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup {
    cleanup
} -constraints {notRoot unixOrWin notWine} -body {
} -constraints {notRoot unixOrWin} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    catch {file delete tf1 td1 $root tf2}
    list [file exists tf1] [file exists tf2] [file exists td1]
} -cleanup {cleanup} -result {0 1 0}
test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
499
500
501
502
503
504
505
506

507
508
509
510

511






512
513
514
515
516
517
518
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







-
+



-
+

+
+
+
+
+
+







    file rename tf1 tf2
    glob tf*
} -result {tf2}
test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir td1
    testchmod 0 td1
    testchmod 000 td1
    createfile tf1
    file rename tf1 td1
} -returnCodes error -cleanup {
    testchmod 0o755 td1
    testchmod 755 td1
} -result {error renaming "tf1" to "td1/tf1": permission denied}
test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} -setup {
    cleanup
} -constraints {win 95} -returnCodes error -body {
    createfile tf1
    file rename tf1 $long
} -result [subst {error renaming "tf1" to "$long": file name too long}]
test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
    cleanup
} -constraints {unix notRoot} -body {
    createfile tf1
    file rename tf1 tf2
    glob tf*
} -result {tf2}
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
618
619
620
621
622
623
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
618
619

620
621
622
623
624
625
626
627







-
+








-
+




-
+








-
+


















-
+






-
+







    file mkdir td2
    createfile [file join td2 tf1]
    file rename -force td2 td1
    file exists [file join td1 td2 tf1]
} -result 1
test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
} -constraints {notRoot} -body {
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup {
    cleanup
} -constraints {notRoot notWine} -returnCodes error -body {
} -constraints {notRoot} -returnCodes error -body {
    file rename -force $root tf1
} -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}]
test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
} -constraints {notRoot} -body {
    file mkdir [file join td1 td2]
    createfile [file join td1 td2 tf1]
    file mkdir td2
    file rename -force td2 td1
} -returnCodes error -match glob -result \
    [subst {error renaming "td2" to "[file join td1 td2]": file *}]
test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
} -constraints {xdev notRoot} -body {
    createfile tf1
    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf1]
} -result [file join $tmpspace tf1]
test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
    catch {file delete -force c:/tcl8975@ d:/tcl8975@}
} -body {
    file mkdir c:/tcl8975@
    if {[catch {file rename c:/tcl8975@ d:/}]} {
	return d:/tcl8975@
    }
    glob c:/tcl8975@ d:/tcl8975@
} -cleanup {
    file delete -force c:/tcl8975@
    catch {file delete -force d:/tcl8975@}
} -result {d:/tcl8975@}
test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
} -constraints {xdev notRoot} -body {
    file mkdir td1
    file rename td1 $tmpspace
    glob -nocomplain td* [file join $tmpspace td*]
} -result [file join $tmpspace td1]
test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
} -constraints {xdev notRoot} -body {
    createfile tf1
    file rename tf1 $tmpspace
    glob -nocomplain tf* [file join $tmpspace tf*]
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {xdev notRoot} -body {
685
686
687
688
689
690
691
692

693
694
695
696
697
698
699
689
690
691
692
693
694
695

696
697
698
699
700
701
702
703







-
+







} -constraints {notRoot xdev} -body {
    file mkdir td1/td2/td3
    file rename td1 $tmpspace
    glob td* [file join $tmpspace td1 t*]
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
} -constraints {xdev notRoot} -body {
    file mkdir foo/bar
    file attr foo -perm 040555
    file rename foo/bar $tmpspace
} -returnCodes error -cleanup {
    catch {file delete [file join $tmpspace bar]}
    catch {file attr foo -perm 040777}
    catch {file delete -force foo}
730
731
732
733
734
735
736
737

738
739
740
741
742
743
744
734
735
736
737
738
739
740

741
742
743
744
745
746
747
748







-
+







} -result {}
test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
    createfile -tf1
} -body {
    file delete -tf1
} -returnCodes error -cleanup {
    file delete -- -tf1
} -result {bad option "-tf1": must be -force or --}
} -result {bad option "-tf1": should be -force or --}
test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
    cleanup
} -constraints {notRoot} -returnCodes error -body {
    createfile --
    createfile -force
    file delete -force -force -- -- -force
    glob -- -- -force
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
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







-
+






-
+

-
+










-
+








-
+


-
+






-
+


-
+









-
+






-
+










-
-
-
-
+
+
+
+







    file rename tf1 tf2
} -result {error renaming "tf1": no such file or directory}
test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    testchmod 0o444 tf2
    testchmod 444 tf2
    file rename tf1 tf3
    file rename tf2 tf4
    list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
} -result {{tf3 tf4} 1 0}
test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {win winXP testchmod} -body {
} -constraints {win2000orXP testchmod} -body {
    file mkdir td1 td2
    testchmod 0o555 td2
    testchmod 555 td2
    file rename td1 td3
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
} -result {{td3 td4} 1 0}
test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {unix notRoot testchmod notDarwin9} -body {
    file mkdir td1 td2
    testchmod 0o555 td2
    testchmod 555 td2
    file rename td1 td3
    file rename td2 td4
    list [lsort [glob td*]] [file writable td3] [file writable td4]
} -cleanup {
    cleanup
} -result {{td3 td4} 1 0}
test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
} -constraints {notRoot testchmod} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 tf2
    testchmod 444 tf2
    file rename -force tf1 tf1
    file rename -force tf2 tf2
    list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
} -result {tf1 tf2 1 0}
test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
    cleanup
} -constraints {win winXP testchmod} -body {
} -constraints {testchmod win2000orXP} -body {
    file mkdir td1
    file mkdir td2
    testchmod 0o555 td2
    testchmod 555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}
test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir td1
    file mkdir td2
    testchmod 0o555 td2
    testchmod 555 td2
    file rename -force td1 .
    file rename -force td2 .
    list [lsort [glob td*]] [file writable td1] [file writable td2]
} -result {{td1 td2} 1 0}
test fCmd-9.7 {file rename: comprehensive: file to existing file} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
    createfile tfd2
    createfile tfd3
    createfile tfd4
    testchmod 0o444 tfs3
    testchmod 0o444 tfs4
    testchmod 0o444 tfd2
    testchmod 0o444 tfd4
    testchmod 444 tfs3
    testchmod 444 tfs4
    testchmod 444 tfd2
    testchmod 444 tfd4
    set msg [list [catch {file rename tf1 tf2} msg] $msg]
    file rename -force tfs1 tfd1
    file rename -force tfs2 tfd2
    file rename -force tfs3 tfd3
    file rename -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
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
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







-
-
+
+

-
-
+
+


















-
+





-
+

















-
+












-
+















-
+





-
+




-
+






-
+







    file mkdir tds3
    file mkdir tds4
    file mkdir [file join tdd1 tds1]
    file mkdir [file join tdd2 tds2]
    file mkdir [file join tdd3 tds3]
    file mkdir [file join tdd4 tds4]
    if {![testConstraint unix]} {
	testchmod 0o555 tds3
	testchmod 0o555 tds4
	testchmod 555 tds3
	testchmod 555 tds4
    }
    testchmod 0o555 [file join tdd2 tds2]
    testchmod 0o555 [file join tdd4 tds4]
    testchmod 555 [file join tdd2 tds2]
    testchmod 555 [file join tdd4 tds4]
    set msg [list [catch {file rename td1 td2} msg] $msg]
    file rename -force tds1 tdd1
    file rename -force tds2 tdd2
    file rename -force tds3 tdd3
    file rename -force tds4 tdd4
    if {[testConstraint unix]} {
	set w3 0
	set w4 0
    } else {
	set w3 [file writable [file join tdd3 tds3]]
	set w4 [file writable [file join tdd4 tds4]]
    }
    list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
    [file writable [file join tdd2 tds2]] $w3 $w4
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4} {1 {error renaming "td1" to "[file join td2 td1]": file already exists}} 1 1 0 0}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
} -constraints {notRoot testchmod} -body {
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    if {!([testConstraint unix] || [testConstraint winVista])} {
	testchmod 0o555 tds2
	testchmod 555 tds2
    }
    set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
    if {[testConstraint unix] || [testConstraint winVista]} {
	set w2 0
    } else {
	set w2 [file writable tds2]
    }
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
} -match glob -result \
    [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}]
test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    testchmod 0o444 tf2
    testchmod 444 tf2
    file rename tf1 [file join td1 tf3]
    file rename tf2 [file join td1 tf4]
    list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    file mkdir td1
    file mkdir td2
    file mkdir td3
    if {!([testConstraint unix] || [testConstraint winVista])} {
	testchmod 0o555 td2
	testchmod 555 td2
    }
    file rename td1 [file join td3 td3]
    file rename td2 [file join td3 td4]
    if {[testConstraint unix] || [testConstraint winVista]} {
        set w4 0
    } else {
	set w4 [file writable [file join td3 td4]]
    }
    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
    [file writable [file join td3 td3]] $w4
} -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-9.12 {file rename: comprehensive: target exists} -setup {
    cleanup
} -constraints {notRoot testchmod notNetworkFilesystem} -body {
    file mkdir [file join td1 td2] [file join td2 td1]
    testchmod 0o555 [file join td2 td1]
    testchmod 555 [file join td2 td1]
    file mkdir [file join td3 td4] [file join td4 td3]
    file rename -force td3 td4
    list [file exists td3] [file exists [file join td4 td3 td4]] \
	[catch {file rename td1 td2} msg] $msg
} -cleanup {
    testchmod 0o755 [file join td2 td1]
    testchmod 755 [file join td2 td1]
} -result [subst {0 1 1 {error renaming "td1" to "[file join td2 td1]": file already exists}}]
# Test can hit EEXIST or EBUSY, depending on underlying filesystem
test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
} -constraints {notRoot} -body {
    file mkdir [file join td1 td2] [file join td2 td1 td4]
    file rename -force td1 td2
} -returnCodes error -match glob -result \
    [subst {error renaming "td1" to "[file join td2 td1]": file *}]
test fCmd-9.14 {file rename: comprehensive: dir into self} -setup {
    cleanup
} -constraints {notRoot notWine} -body {
} -constraints {notRoot} -body {
    file mkdir td1
    list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
} -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup {
    cleanup
} -constraints {notRoot} -body {
    file mkdir td1
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
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
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

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







-
+









-
+





-
-
+
+



-
+



-
+





-
-
+
+



-
+










-
-
-
-
+
+
+
+




















-
-
-
-
+
+
+
+














-
+










-
+











-
+







-
+




-
+







    file copy tf1 tf2
} -result {error copying "tf1": no such file or directory}
test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0o444 tf2
    testchmod 444 tf2
    file copy tf1 tf3
    file copy tf2 tf4
    list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir [file join td1 tdx]
    file mkdir [file join td2 tdy]
    testchmod 0o555 td2
    testchmod 555 td2
    file copy td1 td3
    file copy td2 td4
    list [lsort [glob td*]] [glob -directory td3 t*] \
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4
    testchmod 755 td2
    testchmod 755 td4
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
    cleanup
} -constraints {win notRoot testchmod} -body {
} -constraints {win notRoot 2000orNewer testchmod} -body {
    # On Windows with ACLs, copying a directory is defined like this
    file mkdir [file join td1 tdx]
    file mkdir [file join td2 tdy]
    testchmod 0o555 td2
    testchmod 555 td2
    file copy td1 td3
    file copy td2 td4
    list [lsort [glob td*]] [glob -directory td3 t*] \
	    [glob -directory td4 t*] [file writable td3] [file writable td4]
} -cleanup {
    testchmod 0o755 td2
    testchmod 0o755 td4
    testchmod 755 td2
    testchmod 755 td4
} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1]
test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
    cleanup
} -constraints {notRoot testchmod notWine} -body {
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    createfile tfs1
    createfile tfs2
    createfile tfs3
    createfile tfs4
    createfile tfd1
    createfile tfd2
    createfile tfd3
    createfile tfd4
    testchmod 0o444 tfs3
    testchmod 0o444 tfs4
    testchmod 0o444 tfd2
    testchmod 0o444 tfd4
    testchmod 444 tfs3
    testchmod 444 tfs4
    testchmod 444 tfd2
    testchmod 444 tfd4
    set msg [list [catch {file copy tf1 tf2} msg] $msg]
    file copy -force tfs1 tfd1
    file copy -force tfs2 tfd2
    file copy -force tfs3 tfd3
    file copy -force tfs4 tfd4
    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    file mkdir td1
    file mkdir [file join td2 td1]
    file mkdir tds1
    file mkdir tds2
    file mkdir tds3
    file mkdir tds4
    file mkdir [file join tdd1 tds1]
    file mkdir [file join tdd2 tds2]
    file mkdir [file join tdd3 tds3]
    file mkdir [file join tdd4 tds4]
    testchmod 0o555 tds3
    testchmod 0o555 tds4
    testchmod 0o555 [file join tdd2 tds2]
    testchmod 0o555 [file join tdd4 tds4]
    testchmod 555 tds3
    testchmod 555 tds4
    testchmod 555 [file join tdd2 tds2]
    testchmod 555 [file join tdd4 tds4]
    set a1 [list [catch {file copy td1 td2} msg] $msg]
    set a2 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a3 [catch {file copy -force tds2 tdd2}]
    set a4 [catch {file copy -force tds3 tdd3}]
    set a5 [catch {file copy -force tds4 tdd4}]
    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
    cleanup
} -constraints {notRoot unixOrWin testchmod} -body {
    file mkdir tds1
    file mkdir tds2
    file mkdir [file join tdd1 tds1 xxx]
    file mkdir [file join tdd2 tds2 xxx]
    testchmod 0o555 tds2
    testchmod 555 tds2
    set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
    set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
    list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
    cleanup
} -constraints {notRoot testchmod} -body {
    createfile tf1
    createfile tf2
    file mkdir td1
    testchmod 0o444 tf2
    testchmod 444 tf2
    file copy tf1 [file join td1 tf3]
    file copy tf2 [file join td1 tf4]
    list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
    [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
    cleanup
} -constraints {unix notRoot testchmod} -body {
    file mkdir td1
    file mkdir td2
    file mkdir td3
    testchmod 0o555 td2
    testchmod 555 td2
    file copy td1 [file join td3 td3]
    file copy td2 [file join td3 td4]
    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup {
    cleanup
} -constraints {win notRoot testchmod} -body {
} -constraints {win notRoot 2000orNewer testchmod} -body {
    # On Windows with ACLs, copying a directory is defined like this
    file mkdir td1
    file mkdir td2
    file mkdir td3
    testchmod 0o555 td2
    testchmod 555 td2
    file copy td1 [file join td3 td3]
    file copy td2 [file join td3 td4]
    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup {
    cleanup
1345
1346
1347
1348
1349
1350
1351
1352

1353
1354
1355
1356
1357
1358
1359
1349
1350
1351
1352
1353
1354
1355

1356
1357
1358
1359
1360
1361
1362
1363







-
+







    catch {file rename tfa/dir tfa2}
} -cleanup {
    catch {file attributes tfa -permissions 0777}
    file delete -force tfa
} -result {1}
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
    cleanup $tmpspace
} -constraints {unix notRoot} -body {
} -constraints {xdev notRoot} -body {
    set s [createfile tfa]
    file rename tfa $tmpspace
    list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
} -cleanup {
    cleanup $tmpspace
} -result {1 0}
test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
1628
1629
1630
1631
1632
1633
1634
1635

1636
1637
1638


1639
1640

1641
1642
1643
1644
1645
1646
1647
1632
1633
1634
1635
1636
1637
1638

1639
1640


1641
1642
1643

1644
1645
1646
1647
1648
1649
1650
1651







-
+

-
-
+
+

-
+







    catch {file delete -force -- tfa}
} -body {
    createfile tfa
    catch {file delete -dog tfa}
} -cleanup {
    file delete tfa
} -result {1}
test fCmd-16.4 {accept zero files (TIP 323)} -body {
test fCmd-16.4 {test not enough args} -constraints {notRoot} -body {
    file delete
} -result {}
test fCmd-16.5 {accept zero files (TIP 323)} -body {
} -returnCodes error -match glob -result "wrong \# args: should be *"
test fCmd-16.5 {test not enough args with options} -constraints {notRoot} -body {
    file delete --
} -result {}
} -returnCodes error -match glob -result "wrong \# args: should be *"
test fCmd-16.6 {delete: source filename translation failing} -setup {
    set temp $::env(HOME)
} -constraints {notRoot} -body {
    global env
    unset env(HOME)
    catch {file delete ~/tfa}
} -cleanup {
1930
1931
1932
1933
1934
1935
1936
1937

1938
1939
1940
1941
1942
1943
1944
1934
1935
1936
1937
1938
1939
1940

1941
1942
1943
1944
1945
1946
1947
1948







-
+







# TclUnixDeleteFile and TraversalDelete are covered by tests from the
# TclDeleteFilesCmd suite
#

#
# Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
#
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } -setup {
    catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
    file mkdir tfa
    file mkdir tfa/a
    file attributes tfa/a -permissions 0000
    catch {file delete -force tfa}
} -cleanup {
2318
2319
2320
2321
2322
2323
2324
2325

2326
2327
2328

2329
2330
2331
2332
2333
2334
2335
2322
2323
2324
2325
2326
2327
2328

2329
2330
2331

2332
2333
2334
2335
2336
2337
2338
2339







-
+


-
+







    file link
} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
test fCmd-28.2 {file link} -returnCodes error -body {
    file link a b c d
} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
test fCmd-28.3 {file link} -returnCodes error -body {
    file link abc b c
} -result {bad option "abc": must be -symbolic or -hard}
} -result {bad switch "abc": must be -symbolic or -hard}
test fCmd-28.4 {file link} -returnCodes error -body {
    file link -abc b c
} -result {bad option "-abc": must be -symbolic or -hard}
} -result {bad switch "-abc": must be -symbolic or -hard}
cd [workingDirectory]
makeDirectory abc.dir
makeDirectory abc2.dir
makeFile contents abc.file
makeFile contents abc2.file
cd [temporaryDirectory]
test fCmd-28.5 {file link: source already exists} -setup {
2398
2399
2400
2401
2402
2403
2404
2405

2406
2407
2408
2409
2410
2411
2412
2413

2414
2415
2416
2417
2418
2419
2420
2402
2403
2404
2405
2406
2407
2408

2409
2410
2411
2412
2413
2414
2415
2416

2417
2418
2419
2420
2421
2422
2423
2424







-
+







-
+







    file link doesnt/abc.link abc.dir
} -returnCodes error -cleanup {
    cd [workingDirectory]
} -result {could not create new link "doesnt/abc.link": no such file or directory}
test fCmd-28.11 {file link: success with directory} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
} -cleanup {
    cd [workingDirectory]
} -result abc.dir
test fCmd-28.12 {file link: cd into a link} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
    set orig [pwd]
    cd abc.link
    set dir [pwd]
    cd ..
    set up [pwd]
    cd $orig
2432
2433
2434
2435
2436
2437
2438
2439

2440
2441
2442
2443
2444
2445
2446
2436
2437
2438
2439
2440
2441
2442

2443
2444
2445
2446
2447
2448
2449
2450







-
+







    } else {
	return "ok"
    }
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result ok
test fCmd-28.13 {file link} -constraints {linkDirectory notWine} -setup {
test fCmd-28.13 {file link} -constraints {linkDirectory} -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -body {
    # duplicate link throws error
    file link abc.link abc.dir
} -returnCodes error -cleanup {
    file delete -force abc.link
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
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







-
+




















-
+









-
+





-
+










-
+







} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {directory abc.dir}
test fCmd-28.15.2 {file link: copies link not dir} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
    file copy abc.link abc2.link
    list [file type abc2.link] [file tail [file link abc2.link]]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {link abc.dir}
cd [temporaryDirectory]
file delete -force abc.link
file delete -force abc2.link
cd abc.dir
file delete -force abc.file
file delete -force abc2.file
cd ..
file copy abc.file abc.dir
file copy abc2.file abc.dir
cd [workingDirectory]
test fCmd-28.16 {file link: glob inside link} -setup {
    cd [temporaryDirectory]
    file delete -force abc.link
} -constraints {linkDirectory notWine} -body {
} -constraints {linkDirectory} -body {
    file link abc.link abc.dir
    lsort [glob -dir abc.link -tails *]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {abc.file abc2.file}
test fCmd-28.17 {file link: glob -type l} -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -constraints {linkDirectory notWine} -body {
} -constraints {linkDirectory} -body {
    glob -dir [pwd] -type l -tails abc*
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result {abc.link}
test fCmd-28.18 {file link: glob -type d} -constraints {linkDirectory notWine} -setup {
test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup {
    cd [temporaryDirectory]
    file link abc.link abc.dir
} -body {
    lsort [glob -dir [pwd] -type d -tails abc*]
} -cleanup {
    file delete -force abc.link
    cd [workingDirectory]
} -result [lsort [list abc.link abc.dir abc2.dir]]
test fCmd-28.19 {file link: relative paths} -setup {
    cd [temporaryDirectory]
} -constraints {win linkDirectory notWine} -body {
} -constraints {win linkDirectory} -body {
    file mkdir d1/d2/d3
    file link d1/l2 d1/d2
} -cleanup {
    catch {file delete -force d1}
    cd [workingDirectory]
} -result d1/d2
test fCmd-28.20 {file link: relative paths} -setup {
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
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







-
-
-
-
-
-
-
-
-
-
-
-




+
+
+
+
+
+




-
+


-
+




+
+
-
+
+
+









+
+
+
+
+













    file mkdir d1/d2/d3
    catch {file delete -force d1/l2}
    file link d1/l2 d2/d3
} -cleanup {
    catch {file delete -force d1}
    cd [workingDirectory]
} -result d2/d3
try {
    cd [temporaryDirectory]
    file delete -force abc.link
    file delete -force d1/d2
    file delete -force d1
} finally {
    cd [workingDirectory]
}
removeFile abc2.file
removeFile abc.file
removeDirectory abc2.dir
removeDirectory abc.dir

test fCmd-29.1 {weird memory corruption fault} -body {
    open [file join ~a_totally_bogus_user_id/foo bar]
} -returnCodes error -match glob -result *

cd [temporaryDirectory]
file delete -force abc.link
file delete -force d1/d2
file delete -force d1
cd [workingDirectory]

test fCmd-30.1 {file writable on 'My Documents'} -setup {
    # Get the localized version of the folder name by looking in the registry.
    set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal]
} -constraints {win reg} -body {
} -constraints {win reg nonPortable} -body {
    file writable $mydocsname
} -result 1
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win notWine} -body {
test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body {
    expr {[info exists env(USERPROFILE)]
          && [file exists $env(USERPROFILE)/NTUSER.DAT]
          && [file readable $env(USERPROFILE)/NTUSER.DAT]}
} -result {1}
# At least one CI environment (GitHub Actions) is set up with the page file in
# an unusual location; skip the test if that is so.
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win notWine} -body {
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {
    win notContinuousIntegration
} -body {
    set r {}
    if {[info exists env(SystemDrive)]} {
        set path $env(SystemDrive)/pagefile.sys
        lappend r exists [file exists $path]
        lappend r readable [file readable $path]
        lappend r stat [catch {file stat $path a} e] $e
    }
    return $r
} -result {exists 1 readable 0 stat 0 {}}

removeFile abc2.file
removeFile abc.file
removeDirectory abc2.dir
removeDirectory abc.dir

# cleanup
cleanup
if {[testConstraint unix]} {
    removeDirectory tcl[pid] /tmp
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/fileName.test.

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
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


-
-
-
+
+
+




-
-
+
+

-
-
+
+



-
-
-
-












-
-
-
-
-
-
-
-

-




-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







# This file tests the filename manipulation routines.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) < 5.0 \
	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
	testConstraint linkDirectory 0
    }
    testConstraint symbolicLinkFile 0
    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]
# This match compares the first two words of the result. If the wanted result
# is "equal", then this is successful if the words are equal. If the wanted
# result is "not equal", then this is successful if the words are different.
customMatch compareWords {apply {{a b} {
    lassign $b w1 w2
    expr {$a eq "equal" ? $w1 eq $w2 : $w1 ne $w2}
}}}

proc touch filename {catch {close [open $filename w]}}
global env
if {[testConstraint testsetplatform]} {
    set platform [testgetplatform]
}

# Caution: when using 'testsetplatform' to test different file name platform
# descriptions in this file, one must be very careful not to combine such
# platform manipulation with commands like 'cd', 'pwd'. That is because the
# latter commands operate on the real filesystem but will potentially have
# their logic routed through the wrong generic code paths if we've used
# 'testsetplatform'. This can lead to serious problems, even crashes.

# Caution: when using 'testsetplatform' to test different file
# name platform descriptions in this file, one must be very
# careful not to combine such platform manipulation with
# commands like 'cd', 'pwd'.  That is because the latter commands
# operate on the real filesystem but will potentially have their
# logic routed through the wrong generic code paths if we've
# used 'testsetplatform'.  This can lead to serious problems,
# even crashes.
test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} {
    testsetplatform unix
    file pathtype /
} absolute
test filename-1.2 {Tcl_GetPathType: unix} {testsetplatform} {
    testsetplatform unix
    file pathtype /foo
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
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







-
+

+
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
+







test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
    testsetplatform unix
    file split foo/bar~/baz
} {foo bar~ baz}
if {[testConstraint testsetplatform]} {
    testsetplatform $platform
}
test filename-4.19 {Tcl_SplitPath} -setup {
test filename-4.19 {Tcl_SplitPath} {
    set oldDir [pwd]
    set res [catch {
    cd [temporaryDirectory]
	cd [temporaryDirectory]
} -body {
    file mkdir tildetmp
    set nastydir [file join tildetmp ./~tilde]
    file mkdir $nastydir
    set norm [file normalize $nastydir]
    cd tildetmp
    cd ./~tilde
    glob -nocomplain *
    set idx [string first tildetmp $norm]
    set norm [string range $norm $idx end]
    # fix path away so all platforms are the same
    regsub {(.*):$} $norm {\1} norm
    regsub -all ":" $norm "/" norm
    # make sure we can delete the directory we created
    cd $oldDir
    file delete -force $nastydir
    return $norm
} -cleanup {
	file mkdir tildetmp
	set nastydir [file join tildetmp ./~tilde]
	file mkdir $nastydir
	set norm [file normalize $nastydir]
	cd tildetmp
	cd ./~tilde
	glob -nocomplain *
	set idx [string first tildetmp $norm]
	set norm [string range $norm $idx end]
	# fix path away so all platforms are the same
	regsub {(.*):$} $norm {\1} norm
	regsub -all ":" $norm "/" norm
	# make sure we can delete the directory we created
	cd $oldDir
	file delete -force $nastydir
	set norm
    } err]
    cd $oldDir
    catch {file delete -force [file join [temporaryDirectory] tildetmp]}
    list $res $err
} -result {tildetmp/~tilde}
} {0 tildetmp/~tilde}

test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} {
    testsetplatform win
    file split /
} {/}
test filename-6.2 {Tcl_SplitPath: win} {testsetplatform} {
    testsetplatform win
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
618
619
620

621
622

623
624


625
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
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
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
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
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
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
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

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
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
618


619
620
621
622

623
624

625

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
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
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
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
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
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
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
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
1439
1440


1441
1442

1443

1444
1445
1446

1447
1448
1449
1450
1451
1452
1453
1454



1455
1456
1457
1458
1459
1460
1461
1462
1463



1464
1465
1466
1467

1468

1469

1470

1471
1472
1473
1474
1475
1476
1477
1478
1479







-
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

+
-
-
+
+


-


-
+
-

-
-
-
+
+
+
+
-
-
-
+
+


-


-
+
-

+
-
-
+
+

-
-
+
+
+



+
-
+

-
-
-
+
+
+

-
-
+
+

+
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+


-

-
+
-

+
-
+
+



+

-
-
+
+
+


-
+






-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+
+





-
-
+
+




-
-
-
-
-
+
+
+
+
+




-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

+
-
-
+
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

+
-
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+

-
-
+
+




-
-
-
-
-
+
+
+
+
+




-
+

+
-
-
+
+




-
-
-
-
-
+
+
+
+
+
+




-
-
-
-
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+
+
-

+
-
-
-
+
+
+
+







-
-
+
+




-
-
-
-
-
+
+
+
+
+




-
+

-
-
+
+




-
-
-
-
-
+
+
+
+
+




-
+

+
-
-
+
+




-
-
-
-
-
+
+
+
+
+
+




-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-
-




+


+

+
+
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+













-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+
+







-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-

+

-
+
-

+
+
+
+
+
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+















-
-
-
+
+
+







-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+

+
-
-
-
-
-
-
+
+
+
+
+
+



-
+


-
+








-
+


-
+


-

-
+
-

+
-
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+










-
-
+
+



-
-
-
-
-
+
+
+
+
+



-
+

-
-
+
+


















-
-
+
+










-
-
-
+
+
+



-
+






-
+
+


+



-
-
+
+
+



-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+



-
-
+
+


-

-
+
-

+
-
+

-
-
-
-
+
+
+
+
+
+
+
+


-
-
+

-
+
-


+
-
+







-
-
-
+
+
+






-
-
-
+
+
+

-

-
+
-

-
+
+







    lappend res \
	[file join {foo/bar}] \
	[file join /x {foo/bar}] \
	[file join /x /x {foo/bar}]
    string map [list /x ""] $res
} {foo/bar /foo/bar /foo/bar}

test filename-10.1 {Tcl_TranslateFileName} -body {
test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform unix
    testtranslatefilename foo
} -result {foo} -constraints {testsetplatform testtranslatefilename}
test filename-10.2 {Tcl_TranslateFileName} -body {
    list [catch {testtranslatefilename foo} msg] $msg
} {0 foo}
test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform windows
    testtranslatefilename {c:/foo}
} -result {c:\foo} -constraints {testsetplatform testtranslatefilename}
test filename-10.3 {Tcl_TranslateFileName} -body {
    list [catch {testtranslatefilename {c:/foo}} msg] $msg
} {0 {c:\foo}}
test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform windows
    testtranslatefilename {c:/\\foo/}
} -result {c:\foo} -constraints {testsetplatform testtranslatefilename}
test filename-10.3.1 {Tcl_TranslateFileName} -body {
    list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
} {0 {c:\foo}}
test filename-10.3.1 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform windows
    testtranslatefilename {c://///}
} -result c:\\ -constraints {testsetplatform testtranslatefilename}
test filename-10.6 {Tcl_TranslateFileName} -setup {
    list [catch {testtranslatefilename {c://///}} msg] $msg
} {0 c:\\}
test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "/home/test"
    testsetplatform unix
    testtranslatefilename ~/foo
    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result {/home/test/foo}
test filename-10.7 {Tcl_TranslateFileName} -setup {
} {0 /home/test/foo}
test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    unset env(HOME)
    testsetplatform unix
    testtranslatefilename ~/foo
    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
} -returnCodes error -cleanup {
    set env(HOME) $temp
    set result
} -result {couldn't find HOME environment variable to expand path}
test filename-10.8 {Tcl_TranslateFileName} -setup {
} {1 {couldn't find HOME environment variable to expand path}}
test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "/home/test"
    testsetplatform unix
    testtranslatefilename ~
    set result [list [catch {testtranslatefilename ~} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result {/home/test}
test filename-10.9 {Tcl_TranslateFileName} -setup {
} {0 /home/test}
test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "/home/test/"
    testsetplatform unix
    testtranslatefilename ~
    set result [list [catch {testtranslatefilename ~} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result {/home/test}
test filename-10.10 {Tcl_TranslateFileName} -setup {
} {0 /home/test}
test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "/home/test/"
    testsetplatform unix
    testtranslatefilename ~/foo
    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result {/home/test/foo}
test filename-10.17 {Tcl_TranslateFileName} -setup {
} {0 /home/test/foo}
test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "\\home\\"
    testsetplatform windows
    testtranslatefilename ~/foo
    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result {\home\foo}
test filename-10.18 {Tcl_TranslateFileName} -setup {
} {0 {\home\foo}}
test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "\\home\\"
    testsetplatform windows
    testtranslatefilename ~/foo\\bar
    set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result {\home\foo\bar}
test filename-10.19 {Tcl_TranslateFileName} -setup {
} {0 {\home\foo\bar}}
test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "c:"
    testsetplatform windows
    testtranslatefilename ~/foo
    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
} -cleanup {
    set env(HOME) $temp
} -result {c:foo}
test filename-10.20 {Tcl_TranslateFileName} -returnCodes error -body {
    testtranslatefilename ~blorp/foo
    set result
} {0 c:foo}
test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} {
    list [catch {testtranslatefilename ~blorp/foo} msg] $msg
} -constraints {testtranslatefilename testtranslatefilename} \
    -result {user "blorp" doesn't exist}
test filename-10.21 {Tcl_TranslateFileName} -setup {
} {1 {user "blorp" doesn't exist}}
test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} {
    global env
    set temp $env(HOME)
} -constraints {testsetplatform testtranslatefilename} -body {
    set env(HOME) "c:\\"
    testsetplatform windows
    testtranslatefilename ~/foo
    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result {c:\foo}
test filename-10.22 {Tcl_TranslateFileName} -body {
} {0 {c:\foo}}
test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} {
    testsetplatform windows
    testtranslatefilename foo//bar
} -constraints {testsetplatform testtranslatefilename} -result {foo\bar}
    list [catch {testtranslatefilename foo//bar} msg] $msg
} {0 {foo\bar}}

if {[testConstraint testsetplatform]} {
    testsetplatform $platform
}

test filename-10.23 {Tcl_TranslateFileName} -body {
test filename-10.23 {Tcl_TranslateFileName} {nonPortable} {
    # this test fails if ~ouster is not /home/ouster
    testtranslatefilename ~ouster
} -constraints {nonPortable testtranslatefilename} -result {/home/ouster}
test filename-10.24 {Tcl_TranslateFileName} -body {
    list [catch {testtranslatefilename ~ouster} msg] $msg
} {0 /home/ouster}
test filename-10.24 {Tcl_TranslateFileName} {nonPortable} {
    # this test fails if ~ouster is not /home/ouster
    testtranslatefilename ~ouster/foo
} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}
    list [catch {testtranslatefilename ~ouster/foo} msg] $msg
} {0 /home/ouster/foo}


test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body {
    glob
test filename-11.1 {Tcl_GlobCmd} {
    list [catch {glob} msg] $msg
} -result {no files matched glob patterns ""}
test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
    glob -gorp
} -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
test filename-11.3 {Tcl_GlobCmd} -body {
    glob -nocomplai
} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
test filename-11.2 {Tcl_GlobCmd} {
    list [catch {glob -gorp} msg] $msg
} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
test filename-11.3 {Tcl_GlobCmd} {
    list [catch {glob -nocomplai} msg] $msg
} -result {}
test filename-11.4 {Tcl_GlobCmd} -body {
    glob -nocomplain
} -result {}
test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body {
    glob -nocomplain * ~xyqrszzz
} -result {user "xyqrszzz" doesn't exist}
test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body {
    glob ~xyqrszzz
} -result {user "xyqrszzz" doesn't exist}
test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body {
    glob -- -nocomplain
} -result {no files matched glob pattern "-nocomplain"}
test filename-11.8 {Tcl_GlobCmd} -body {
    glob -nocomplain -- -nocomplain
} -result {}
test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
test filename-11.4 {Tcl_GlobCmd} {
    list [catch {glob -nocomplain} msg] $msg
} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
test filename-11.5 {Tcl_GlobCmd} {
    list [catch {glob -nocomplain * ~xyqrszzz} msg] $msg
} {1 {user "xyqrszzz" doesn't exist}}
test filename-11.6 {Tcl_GlobCmd} {
    list [catch {glob ~xyqrszzz} msg] $msg
} {1 {user "xyqrszzz" doesn't exist}}
test filename-11.7 {Tcl_GlobCmd} {
    list [catch {glob -- -nocomplain} msg] $msg
} {1 {no files matched glob pattern "-nocomplain"}}
test filename-11.8 {Tcl_GlobCmd} {
    list [catch {glob -nocomplain -- -nocomplain} msg] $msg
} {0 {}}
test filename-11.9 {Tcl_GlobCmd} {testsetplatform} {
    testsetplatform unix
    glob ~\\xyqrszzz/bar
} -returnCodes error -result {user "\xyqrszzz" doesn't exist}
test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
    list [catch {glob ~\\xyqrszzz/bar} msg] $msg
} {1 {user "\xyqrszzz" doesn't exist}}
test filename-11.10 {Tcl_GlobCmd} {testsetplatform} {
    testsetplatform unix
    glob -nocomplain ~\\xyqrszzz/bar
} -returnCodes error -result {user "\xyqrszzz" doesn't exist}
test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
    list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
} {1 {user "\xyqrszzz" doesn't exist}}
test filename-11.11 {Tcl_GlobCmd} {testsetplatform} {
    testsetplatform unix
    glob ~xyqrszzz\\/\\bar
} -returnCodes error -result {user "xyqrszzz" doesn't exist}
test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup {
    list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg
} {1 {user "xyqrszzz" doesn't exist}}
test filename-11.12 {Tcl_GlobCmd} {testsetplatform} {
    testsetplatform unix
    set home $env(HOME)
} -body {
    unset env(HOME)
    glob ~/*
    set x [list [catch {glob ~/*} msg] $msg]
} -returnCodes error -cleanup {
    set env(HOME) $home
    set x
} -result {couldn't find HOME environment variable to expand path}
} {1 {couldn't find HOME environment variable to expand path}}

if {[testConstraint testsetplatform]} {
    testsetplatform $platform
}

test filename-11.13 {Tcl_GlobCmd} {
    file join [lindex [glob ~] 0]
} [file join $env(HOME)]
    list [catch {file join [lindex [glob ~] 0]} msg] $msg
} [list 0 [file join $env(HOME)]]

set oldpwd [pwd]
set oldhome $env(HOME)
catch {cd [makeDirectory tcl[pid]]}
cd [temporaryDirectory]
set env(HOME) [pwd]
file delete -force globTest
file mkdir globTest/a1/b1
file mkdir globTest/a1/b2
file mkdir globTest/a2/b3
file mkdir globTest/a3
touch globTest/x1.c
touch globTest/y1.c
touch globTest/z1.c
touch "globTest/weird name.c"
touch globTest/a1/b1/x2.c
touch globTest/a1/b2/y2.c
touch globTest/.1
touch globTest/x,z1.c
close [open globTest/x1.c w]
close [open globTest/y1.c w]
close [open globTest/z1.c w]
close [open "globTest/weird name.c" w]
close [open globTest/a1/b1/x2.c w]
close [open globTest/a1/b2/y2.c w]

catch {close [open globTest/.1 w]}
catch {close [open globTest/x,z1.c w]}

test filename-11.14 {Tcl_GlobCmd} {
    glob ~/globTest
} [list [file join $env(HOME) globTest]]
    list [catch {glob ~/globTest} msg] $msg
} [list 0 [list [file join $env(HOME) globTest]]]
test filename-11.15 {Tcl_GlobCmd} {
    glob ~\\/globTest
} [list [file join $env(HOME) globTest]]
    list [catch {glob ~\\/globTest} msg] $msg
} [list 0 [list [file join $env(HOME) globTest]]]
test filename-11.16 {Tcl_GlobCmd} {
    glob globTest
} {globTest}
    list [catch {glob globTest} msg] $msg
} {0 globTest}

set globname "globTest"
set horribleglobname "glob\[\{Test"
set tildeglobname "./~test.txt"

test filename-11.17 {Tcl_GlobCmd} {unix} {
    lsort [glob -directory $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
    list [catch {lsort [glob -directory $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.17.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -directory $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.17.1 {Tcl_GlobCmd} {win} {
    list [catch {lsort [glob -directory $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
        [file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.17.2 {Tcl_GlobCmd} -setup {
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
    set dir [pwd]
} -constraints {notRoot linkDirectory notWine} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -join * b1]
} -cleanup {
    cd $dir
    set ret "error in test"
    if {[catch {
	cd $globname
	file link -symbolic link a1
	cd $dir
	set ret [list [catch {
	    lsort [glob -directory $globname -join * b1]
	} msg] $msg]
    }]} {
	cd $dir
    }
    file delete [file join $globname link]
    set ret
} -result [list [file join $globname a1 b1] \
	[file join $globname link b1]]
} [list 0 [lsort [list [file join $globname a1 b1] \
  [file join $globname link b1]]]]
# Simpler version of the above test to illustrate a given bug.
test filename-11.17.3 {Tcl_GlobCmd} -setup {
test filename-11.17.3 {Tcl_GlobCmd} {notRoot linkDirectory} {
    set dir [pwd]
} -constraints {notRoot linkDirectory notWine} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type d *]
} -cleanup {
    cd $dir
    set ret "error in test"
    if {[catch {
	cd $globname
	file link -symbolic link a1
	cd $dir
	set ret [list [catch {
	    lsort [glob -directory $globname -type d *]
	} msg] $msg]
    }]} {
	cd $dir
    }
    file delete [file join $globname link]
    set ret
} -result [list [file join $globname a1] \
	[file join $globname a2] \
	[file join $globname a3] \
	[file join $globname link]]
# Make sure the bugfix isn't too simple. We don't want to break 'glob -type l'
test filename-11.17.4 {Tcl_GlobCmd} -setup {
} [list 0 [lsort [list [file join $globname a1] \
  [file join $globname a2] \
  [file join $globname a3] \
  [file join $globname link]]]]
# Make sure the bugfix isn't too simple.  We don't want
# to break 'glob -type l'.
test filename-11.17.4 {Tcl_GlobCmd} {notRoot linkDirectory} {
    set dir [pwd]
} -constraints {notRoot linkDirectory notWine} -body {
    cd $globname
    file link -symbolic link a1
    cd $dir
    lsort [glob -directory $globname -type l *]
} -cleanup {
    cd $dir
    set ret "error in test"
    if {[catch {
	cd $globname
	file link -symbolic link a1
	cd $dir
	set ret [list [catch {
	    lsort [glob -directory $globname -type l *]
	} msg] $msg]
    }]} {
	cd $dir
    }
    file delete [file join $globname link]
    set ret
} -result [list [file join $globname link]]
} [list 0 [list [file join $globname link]]]
test filename-11.17.5 {Tcl_GlobCmd} {
    lsort [glob -directory $globname -tails *.c]
} [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]
    list [catch {lsort [glob -directory $globname -tails *.c]} msg] $msg
} [list 0 [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
test filename-11.17.6 {Tcl_GlobCmd} {
    lsort [glob -directory $globname -tails *.c *.c]
} [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
	[list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} -setup {
    list [catch {lsort [glob -directory $globname -tails *.c *.c]} msg] $msg
} [list 0 [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
  [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]]
test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} {linkDirectory} {
    set dir [pwd]
} -constraints {linkDirectory notWine} -body {
    cd $globname
    file mkdir nonexistent
    file link -symbolic link nonexistent
    file delete nonexistent
    cd $dir
    lsort [glob -nocomplain -directory $globname -type l *]
} -cleanup {
    cd $dir
    set ret "error in test"
    if {[catch {
	cd $globname
	file mkdir nonexistent
	file link -symbolic link nonexistent
	file delete nonexistent
	cd $dir
	set ret [list [catch {
	    lsort [glob -nocomplain -directory $globname -type l *]
	} msg] $msg]
    }]} {
	cd $dir
    }
    file delete [file join $globname link]
    set ret
} -result [list [file join $globname link]]
test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} -setup {
} [list 0 [list [file join $globname link]]]
test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} {symbolicLinkFile} {
    set dir [pwd]
} -constraints {symbolicLinkFile} -body {
    cd $globname
    touch "nonexistent"
    file link -symbolic link nonexistent
    file delete nonexistent
    cd $dir
    lsort [glob -nocomplain -directory $globname -type l *]
} -cleanup {
    cd $dir
    set ret "error in test"
    if {[catch {
	cd $globname
	close [open "nonexistent" w]
	file link -symbolic link nonexistent
	file delete nonexistent
	cd $dir
	set ret [list [catch {
	    lsort [glob -nocomplain -directory $globname -type l *]
	} msg] $msg]
    }]} {
	cd $dir
    }
    file delete [file join $globname link]
    set ret
} -result [list [file join $globname link]]
} [list 0 [list [file join $globname link]]]
test filename-11.18 {Tcl_GlobCmd} {unix} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
    list [catch {lsort [glob -path $globname/ *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.18.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.18.1 {Tcl_GlobCmd} {win} {
    list [catch {lsort [glob -path $globname/ *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
        [file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.19 {Tcl_GlobCmd} {unix} {
    list [catch {lsort [glob -join -path \
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	    [string range $globname 0 5] * *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.19.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.19.1 {Tcl_GlobCmd} {win} {
    list [catch {lsort [glob -join -path \
	    [string range $globname 0 5] * *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
        [file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.20 {Tcl_GlobCmd} notWine {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.20 {Tcl_GlobCmd} {
    list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
	[file join $globname a3]]]]
test filename-11.21 {Tcl_GlobCmd} {
    lsort [glob -type d -path $globname *]
} [list $globname]
test filename-11.21.1 {Tcl_GlobCmd} -body {
    touch {[tcl].testremains}
    lsort [glob -path {[tcl]} *]
    list [catch {lsort [glob -type d -path $globname *]} msg] $msg
} [list 0 [lsort [list $globname]]]

test filename-11.21.1 {Tcl_GlobCmd} {
    close [open {[tcl].testremains} w]
    set res [list [catch {lsort [glob -path {[tcl]} *]} msg] $msg]
} -cleanup {
    file delete -force {[tcl].testremains}
    set res
} -result {{[tcl].testremains}}
# Get rid of file/dir if it exists, since it will have been left behind by a
# previous failed run.
} [list 0 {{[tcl].testremains}}]

# Get rid of file/dir if it exists, since it will have
# been left behind by a previous failed run.
file delete -force $horribleglobname
file rename globTest $horribleglobname
set globname $horribleglobname
file delete -force $tildeglobname
close [open $tildeglobname w]

test filename-11.22 {Tcl_GlobCmd} {unix} {
    lsort [glob -dir $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
    list [catch {lsort [glob -dir $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.22.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -dir $globname *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.22.1 {Tcl_GlobCmd} {win} {
    list [catch {lsort [glob -dir $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
        [file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.23 {Tcl_GlobCmd} {unix} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
    list [catch {lsort [glob -path $globname/ *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.23.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -path $globname/ *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.23.1 {Tcl_GlobCmd} {win} {
    list [catch {lsort [glob -path $globname/ *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
        [file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.24 {Tcl_GlobCmd} {unix} {
    list [catch {lsort [glob -join -path \
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	    [string range $globname 0 5] * *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.24.1 {Tcl_GlobCmd} {win notWine} {
    lsort [glob -join -path [string range $globname 0 5] * *]
} [lsort [list [file join $globname a1] [file join $globname a2]\
	[file join $globname .1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.24.1 {Tcl_GlobCmd} {win} {
    list [catch {lsort [glob -join -path \
	    [string range $globname 0 5] * *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
        [file join $globname .1]\
	[file join $globname a3]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-11.25 {Tcl_GlobCmd} notWine {
    lsort [glob -type d -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-11.25 {Tcl_GlobCmd} {
    list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.25.1 {Tcl_GlobCmd} notWine {
    lsort [glob -type {d r} -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
test filename-11.25.2 {Tcl_GlobCmd} notWine {
    lsort [glob -type {d r w} -dir $globname *]
} [lsort [list [file join $globname a1]\
	[file join $globname a2]\
	[file join $globname a3]]]
	[file join $globname a3]]]]
test filename-11.25.1 {Tcl_GlobCmd} {
    list [catch {lsort [glob -type {d r} -dir $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1]\
  [file join $globname a2]\
  [file join $globname a3]]]]
test filename-11.25.2 {Tcl_GlobCmd} {
    list [catch {lsort [glob -type {d r w} -dir $globname *]} msg] $msg
} [list 0 [lsort [list [file join $globname a1]\
  [file join $globname a2]\
  [file join $globname a3]]]]
test filename-11.26 {Tcl_GlobCmd} {
    glob -type d -path $globname *
} [list $globname]
test filename-11.27 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types abcde *
} -result {bad argument to "-types": abcde}
test filename-11.28 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types z *
} -result {bad argument to "-types": z}
test filename-11.29 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types {abcd efgh} *
} -result {only one MacOS type or creator argument to "-types" allowed}
test filename-11.30 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types {{macintosh type TEXT} {macintosh creator ALFA} efgh} *
} -result {only one MacOS type or creator argument to "-types" allowed}
test filename-11.31 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types
} -result {missing argument to "-types"}
test filename-11.32 {Tcl_GlobCmd} -returnCodes error -body {
    glob -path hello -dir hello *
} -result {"-directory" cannot be used with "-path"}
test filename-11.33 {Tcl_GlobCmd} -returnCodes error -body {
    glob -path
} -result {missing argument to "-path"}
test filename-11.34 {Tcl_GlobCmd} -returnCodes error -body {
    glob -direct
} -result {missing argument to "-directory"}
test filename-11.35 {Tcl_GlobCmd} -returnCodes error -body {
    glob -paths *
} -result {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
    list [catch {glob -type d -path $globname *} msg] $msg
} [list 0 [list $globname]]
test filename-11.27 {Tcl_GlobCmd} {
    list [catch {glob -types abcde *} msg] $msg
} {1 {bad argument to "-types": abcde}}
test filename-11.28 {Tcl_GlobCmd} {
    list [catch {glob -types z *} msg] $msg
} {1 {bad argument to "-types": z}}
test filename-11.29 {Tcl_GlobCmd} {
    list [catch {glob -types {abcd efgh} *} msg] $msg
} {1 {only one MacOS type or creator argument to "-types" allowed}}
test filename-11.30 {Tcl_GlobCmd} {
    list [catch {glob -types {{macintosh type TEXT} \
	    {macintosh creator ALFA} efgh} *} msg] $msg
} {1 {only one MacOS type or creator argument to "-types" allowed}}
test filename-11.31 {Tcl_GlobCmd} {
    list [catch {glob -types} msg] $msg
} {1 {missing argument to "-types"}}
test filename-11.32 {Tcl_GlobCmd} {
    list [catch {glob -path hello -dir hello *} msg] $msg
} {1 {"-directory" cannot be used with "-path"}}
test filename-11.33 {Tcl_GlobCmd} {
    list [catch {glob -path} msg] $msg
} {1 {missing argument to "-path"}}
test filename-11.34 {Tcl_GlobCmd} {
    list [catch {glob -direct} msg] $msg
} {1 {missing argument to "-directory"}}
test filename-11.35 {Tcl_GlobCmd} {
    list [catch {glob -paths *} msg] $msg
} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
# Test '-tails' flag to glob.
test filename-11.36 {Tcl_GlobCmd} -returnCodes error -body {
    glob -tails *
} -result {"-tails" must be used with either "-directory" or "-path"}
test filename-11.36 {Tcl_GlobCmd} {
    list [catch {glob -tails *} msg] $msg
} {1 {"-tails" must be used with either "-directory" or "-path"}}
test filename-11.37 {Tcl_GlobCmd} {
    glob -type d -tails -path $globname *
} [list $globname]
    list [catch {glob -type d -tails -path $globname *} msg] $msg
} [list 0 [list $globname]]
test filename-11.38 {Tcl_GlobCmd} {
    glob -tails -path $globname *
} [list $globname]
    list [catch {glob -tails -path $globname *} msg] $msg
} [list 0 [list $globname]]
test filename-11.39 {Tcl_GlobCmd} {
    glob -tails -join -path $globname *
} [list $globname]
test filename-11.40 {Tcl_GlobCmd} -body {
    list [glob -dir [pwd] -tails *] [glob *]
} -match compareWords -result equal
test filename-11.41 {Tcl_GlobCmd} -body {
    list [glob -dir [pwd] -tails *] [glob -dir [pwd] *]
} -match compareWords -result "not equal"
test filename-11.42 {Tcl_GlobCmd} -body {
    list [catch {glob -tails -join -path $globname *} msg] $msg
} [list 0 [list $globname]]
test filename-11.40 {Tcl_GlobCmd} {
    expr {[glob -dir [pwd] -tails *] == [glob *]}
} {1}
test filename-11.41 {Tcl_GlobCmd} {
    expr {[glob -dir [pwd] -tails *] != [glob -dir [pwd] *]}
} {1}
test filename-11.42 {Tcl_GlobCmd} {
    set res [list]
    foreach f [glob -dir [pwd] *] {
	set f [file tail $f]
	regsub {^./} $f {} f; # until glob bug [2511011fff] don't fixed (tilde expansion prevention).
	lappend res $f
    }
    list $res [glob *]
} -match compareWords -result equal
test filename-11.43 {Tcl_GlobCmd} -returnCodes error -body {
    glob -t *
} -result {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
test filename-11.44 {Tcl_GlobCmd} -returnCodes error -body {
    glob -tails -path hello -directory hello *
} -result {"-directory" cannot be used with "-path"}
test filename-11.45 {Tcl_GlobCmd on root volume} -setup {
    expr {$res == [glob *]}
} {1}
test filename-11.43 {Tcl_GlobCmd} {
    list [catch {glob -t *} msg] $msg
} {1 {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
test filename-11.44 {Tcl_GlobCmd} {
    list [catch {glob -tails -path hello -directory hello *} msg] $msg
} {1 {"-directory" cannot be used with "-path"}}
test filename-11.45 {Tcl_GlobCmd on root volume} {
    set res1 ""
    set res2 ""
    set tmpd [pwd]
} -body {
    catch {
	set res1 [glob -dir [lindex [file volumes] 0] -tails *]
    }
    catch {
	set tmpd [pwd]
	cd [lindex [file volumes] 0]
	set res2 [glob *]
	cd $tmpd
    }
    set res [expr {$res1 == $res2}]
    if {!$res} {
    list $res1 $res2
} -cleanup {
    cd $tmpd
	lappend res $res1 $res2
    }
    set res
} {1}
} -match compareWords -result equal
test filename-11.46 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types abcde -dir foo *
} -result {bad argument to "-types": abcde}
test filename-11.47 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types abcde -path foo *
} -result {bad argument to "-types": abcde}
test filename-11.48 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types abcde -dir foo -join * *
} -result {bad argument to "-types": abcde}
test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body {
    glob -types abcde -path foo -join * *
} -result {bad argument to "-types": abcde}
test filename-11.46 {Tcl_GlobCmd} {
    list [catch {glob -types abcde -dir foo *} msg] $msg
} {1 {bad argument to "-types": abcde}}
test filename-11.47 {Tcl_GlobCmd} {
    list [catch {glob -types abcde -path foo *} msg] $msg
} {1 {bad argument to "-types": abcde}}
test filename-11.48 {Tcl_GlobCmd} {
    list [catch {glob -types abcde -dir foo -join * *} msg] $msg
} {1 {bad argument to "-types": abcde}}
test filename-11.49 {Tcl_GlobCmd} {
    list [catch {glob -types abcde -path foo -join * *} msg] $msg
} {1 {bad argument to "-types": abcde}}
test filename-11.50 {Tcl_GlobCmd} -returnCodes error -body {
    glob -path hello -path salut *
} -result {"-path" may only be used once}
test filename-11.51 {Tcl_GlobCmd} -returnCodes error -body {
    glob -dir hello -dir salut *
} -result {"-directory" may only be used once}

file rename $horribleglobname globTest
file delete -force $tildeglobname
set globname globTest
unset horribleglobname tildeglobname

test filename-12.1 {simple globbing} {unixOrWin} {
    glob {}
} {.}
test filename-12.1.1 {simple globbing} -constraints {unixOrWin} -body {
    glob -types f {}
} -returnCodes error -result {no files matched glob pattern ""}
    list [catch {glob {}} msg] $msg
} {0 .}
test filename-12.1.1 {simple globbing} {unixOrWin} {
    list [catch {glob -types f {}} msg] $msg
} {1 {no files matched glob pattern ""}}
test filename-12.1.2 {simple globbing} {unixOrWin} {
    glob -types d {}
} {.}
    list [catch {glob -types d {}} msg] $msg
} {0 .}
test filename-12.1.3 {simple globbing} {unix} {
    glob -types hidden {}
} {.}
test filename-12.1.4 {simple globbing} -constraints {win} -body {
    glob -types hidden {}
} -returnCodes error -result {no files matched glob pattern ""}
test filename-12.1.5 {simple globbing} -constraints {win} -body {
    glob -types hidden c:/
} -returnCodes error -result {no files matched glob pattern "c:/"}
    list [catch {glob -types hidden {}} msg] $msg
} {0 .}
test filename-12.1.4 {simple globbing} {win} {
    list [catch {glob -types hidden {}} msg] $msg
} {1 {no files matched glob pattern ""}}
test filename-12.1.5 {simple globbing} {win} {
    list [catch {glob -types hidden c:/} msg] $msg
} {1 {no files matched glob pattern "c:/"}}
test filename-12.1.6 {simple globbing} {win} {
    glob c:/
} {c:/}
    list [catch {glob c:/} msg] $msg
} {0 c:/}
test filename-12.3 {simple globbing} {
    glob -nocomplain \{a1,a2\}
} {}
    list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
} {0 {}}

set globPreResult globTest/
set x1 x1.c
set y1 y1.c
test filename-12.4 {simple globbing} {unixOrWin} {
    lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
} "$globPreResult$x1 $globPreResult$y1"
test filename-12.5 {simple globbing} {
    glob globTest\\/x1.c
} "$globPreResult$x1"
    list [catch {glob globTest\\/x1.c} msg] $msg
} "0 $globPreResult$x1"
test filename-12.6 {simple globbing} {
    glob globTest\\/\\x1.c
} "$globPreResult$x1"
test filename-12.7 {globbing at filesystem root} -constraints {unix} -body {
    list [glob -nocomplain /*] [glob -path / *]
} -match compareWords -result equal
test filename-12.8 {globbing at filesystem root} -constraints {unix} -body {
    set first [string range [lindex [glob -type d /*] 0] 0 1]
    list [glob -nocomplain ${first}*] [glob -path $first *]
} -match compareWords -result equal
test filename-12.9 {globbing at filesystem root} -constraints {win} -body {
    # Can't grab just anything from 'file volumes' because we need a dir that
    # has subdirs - assume that C:/ exists across Windows machines.
    set first [string range [lindex [glob -type d C:/*] 0] 0 3]
    list [glob -nocomplain ${first}*] [glob -path $first *]
} -match compareWords -result equal
test filename-12.10 {globbing with volume relative paths} -setup {
    list [catch {glob globTest\\/\\x1.c} msg] $msg
} "0 $globPreResult$x1"
test filename-12.7 {globbing at filesystem root} {unix} {
    set res1 [glob -nocomplain /*]
    set res2 [glob -path / *]
    set equal [string equal $res1 $res2]
    if {!$equal} {
	lappend equal "not equal" $res1 $res2
    }
    set equal
} {1}
test filename-12.8 {globbing at filesystem root} {unix} {
    set dir [lindex [glob -type d /*] 0]
    set first [string range $dir 0 1]
    set res1 [glob -nocomplain ${first}*]
    set res2 [glob -path $first *]
    set equal [string equal $res1 $res2]
    if {!$equal} {
	lappend equal "not equal" $res1 $res2
    }
    set equal
} {1}
test filename-12.9 {globbing at filesystem root} {win} {
    # Can't grab just anything from 'file volumes' because we need a dir
    # that has subdirs - assume that C:/ exists across Windows machines.
    set dir [lindex [glob -type d C:/*] 0]
    set first [string range $dir 0 3]
    set res1 [glob -nocomplain ${first}*]
    set res2 [glob -path $first *]
    set equal [string equal $res1 $res2]
    if {!$equal} {
	lappend equal "not equal" $res1 $res2
    }
    set equal
} {1}

test filename-12.10 {globbing with volume relative paths} {win} {
    set pwd [pwd]
} -body {
    set dir [lindex [glob -type d C:/*] 0]
    set pwd [pwd]
    cd C:/
    list [glob -nocomplain [string range $dir 2 end]] [list $dir]
    set res1 [glob -nocomplain [string range $dir 2 end]]
} -cleanup {
    cd $pwd
    set res2 [list $dir]
    set equal [string equal $res1 $res2]
    if {!$equal} {
        lappend equal "not equal" $res1 $res2
    }
} -constraints {win} -match compareWords -result equal
    set equal
} {1}

test filename-13.1 {globbing with brace substitution} {
    glob globTest/\{\}
} "$globPreResult"
test filename-13.2 {globbing with brace substitution} -body {
    glob globTest/\{
} -returnCodes error -result {unmatched open-brace in file name}
test filename-13.3 {globbing with brace substitution} -body {
    glob globTest/\{\\\}
} -returnCodes error -result {unmatched open-brace in file name}
test filename-13.4 {globbing with brace substitution} -body {
    glob globTest/\{\\
} -returnCodes error -result {unmatched open-brace in file name}
test filename-13.5 {globbing with brace substitution} -body {
    glob globTest/\}
} -returnCodes error -result {unmatched close-brace in file name}
    list [catch {glob globTest/\{\}} msg] $msg
} "0 $globPreResult"
test filename-13.2 {globbing with brace substitution} {
    list [catch {glob globTest/\{} msg] $msg
} {1 {unmatched open-brace in file name}}
test filename-13.3 {globbing with brace substitution} {
    list [catch {glob globTest/\{\\\}} msg] $msg
} {1 {unmatched open-brace in file name}}
test filename-13.4 {globbing with brace substitution} {
    list [catch {glob globTest/\{\\} msg] $msg
} {1 {unmatched open-brace in file name}}
test filename-13.5 {globbing with brace substitution} {
    list [catch {glob globTest/\}} msg] $msg
} {1 {unmatched close-brace in file name}}
test filename-13.6 {globbing with brace substitution} {
    glob globTest/\{\}x1.c
} "$globPreResult$x1"
    list [catch {glob globTest/\{\}x1.c} msg] $msg
} "0 $globPreResult$x1"
test filename-13.7 {globbing with brace substitution} {
    glob globTest/\{x\}1.c
} "$globPreResult$x1"
    list [catch {glob globTest/\{x\}1.c} msg] $msg
} "0 $globPreResult$x1"
test filename-13.8 {globbing with brace substitution} {
    glob globTest/\{x\{\}\}1.c
} "$globPreResult$x1"
    list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
} "0 $globPreResult$x1"
test filename-13.9 {globbing with brace substitution} {
    lsort [glob globTest/\{x,y\}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
    list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
test filename-13.10 {globbing with brace substitution} {
    lsort [glob globTest/\{x,,y\}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
    list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
test filename-13.11 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/\{x,x\\,z,z\}1.c]
} [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}]
    list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
test filename-13.13 {globbing with brace substitution} {
    lsort [glob globTest/{a,b,x,y}1.c]
} [list $globPreResult$x1 $globPreResult$y1]
test filename-13.14 {globbing with brace substitution} {unixOrWin} {
    lsort [glob {globTest/{x1,y2,weird name}.c}]
} {{globTest/weird name.c} globTest/x1.c}
test filename-13.16 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/{x1.c,a1/*}]
} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
test filename-13.18 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/{x1.c,{a},a1/*}]
} {globTest/a1/b1 globTest/a1/b2 globTest/x1.c}
test filename-13.20 {globbing with brace substitution} {unixOrWin} {
    lsort [glob globTest/{a,x}1/*/{x,y}*]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
test filename-13.22 {globbing with brace substitution} -body {
    glob globTest/\{a,x\}1/*/\{
} -returnCodes error -result {unmatched open-brace in file name}
test filename-13.22 {globbing with brace substitution} {
    list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
} {1 {unmatched open-brace in file name}}

test filename-14.1 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob glo*/*.c]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.3 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/?1.c]
} {globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.5 {asterisks, question marks, and brackets} -setup {
    # The current directory could be anywhere; do this to stop spurious

# The current directory could be anywhere; do this to stop spurious matches
    # matches
    file mkdir globTestContext
    file rename globTest [file join globTestContext globTest]
    set savepwd [pwd]
    cd globTestContext
} -constraints {unixOrWin} -body {
file mkdir globTestContext
file rename globTest [file join globTestContext globTest]
set savepwd [pwd]
cd globTestContext

test filename-14.5 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob */*/*/*.c]
} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
} -cleanup {
    # Reset to where we were
    cd $savepwd
    file rename [file join globTestContext globTest] globTest
    file delete globTestContext
} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}

# Reset to where we were
cd $savepwd
file rename [file join globTestContext globTest] globTest
file delete globTestContext

test filename-14.7 {asterisks, question marks, and brackets} {unix} {
    lsort [glob globTest/*]
} {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.7.1 {asterisks, question marks, and brackets} {win notWine} {
test filename-14.7.1 {asterisks, question marks, and brackets} {win} {
    lsort [glob globTest/*]
} {globTest/.1 globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin notWine} {
test filename-14.9 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/.*]
} {globTest/. globTest/.. globTest/.1}
test filename-14.11 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*/*]
} {globTest/a1/b1 globTest/a1/b2 globTest/a2/b3}
test filename-14.13 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob {globTest/[xyab]1.*}]
} {globTest/x1.c globTest/y1.c}
test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin notWine} {
test filename-14.15 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*/]
} {globTest/a1/ globTest/a2/ globTest/a3/}
test filename-14.17 {asterisks, question marks, and brackets} -setup {
test filename-14.17 {asterisks, question marks, and brackets} {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) [file join $env(HOME) globTest]
    glob ~/z*
    set result [list [catch {glob ~/z*} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result [list [file join $env(HOME) globTest z1.c]]
} [list 0 [list [file join $env(HOME) globTest z1.c]]]
test filename-14.18 {asterisks, question marks, and brackets} {unixOrWin} {
    lsort [glob globTest/*.c goo/*]
} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
    list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
test filename-14.20 {asterisks, question marks, and brackets} {
    glob -nocomplain goo/*
} {}
test filename-14.21 {asterisks, question marks, and brackets} -body {
    glob globTest/*/gorp
} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"}
test filename-14.22 {asterisks, question marks, and brackets} -body {
    glob goo/* x*z foo?q
} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"}
    list [catch {glob -nocomplain goo/*} msg] $msg
} {0 {}}
test filename-14.21 {asterisks, question marks, and brackets} {
    list [catch {glob globTest/*/gorp} msg] $msg
} {1 {no files matched glob pattern "globTest/*/gorp"}}
test filename-14.22 {asterisks, question marks, and brackets} {
    list [catch {glob goo/* x*z foo?q} msg] $msg
} {1 {no files matched glob patterns "goo/* x*z foo?q"}}
test filename-14.23 {slash globbing} {unix} {
    glob /
} /
test filename-14.23.2 {slash globbing} {win} {
    glob /
} [file norm /]
test filename-14.24 {slash globbing} {win} {
    glob {\\}
} [file norm /]
test filename-14.25 {type specific globbing} {unix} {
    lsort [glob -dir globTest -types f *]
} [lsort [list \
    list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
} [list 0 [lsort [list \
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
test filename-14.25.1 {type specific globbing} {win notWine} {
    lsort [glob -dir globTest -types f *]
} [lsort [list \
	[file join $globname .1]\
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-14.25.1 {type specific globbing} {win} {
    list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
} [list 0 [lsort [list \
        [file join $globname .1]\
	[file join $globname "weird name.c"]\
	[file join $globname x,z1.c]\
	[file join $globname x1.c]\
	[file join $globname y1.c] [file join $globname z1.c]]]
	[file join $globname y1.c] [file join $globname z1.c]]]]
test filename-14.26 {type specific globbing} {
    glob -nocomplain -dir globTest -types {readonly} *
} {}
    list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg
} [list 0 {}]
test filename-14.27 {Bug 2710920} {unixOrWin} {
    file tail [lindex [lsort [glob globTest/*/]] 0]
} a1
test filename-14.28 {Bug 2710920} {unixOrWin} {
    file dirname [lindex [lsort [glob globTest/*/]] 0]
} globTest
test filename-14.29 {Bug 2710920} {unixOrWin} {
    file extension [lindex [lsort [glob globTest/*/]] 0]
} {}
test filename-14.30 {Bug 2710920} {unixOrWin} {
    file rootname [lindex [lsort [glob globTest/*/]] 0]
} globTest/a1/

test filename-14.31 {Bug 2918610} -setup {
    set d [makeDirectory foo]
    makeFile {} bar.soom $d
} -body {
    foreach fn [glob $d/bar.soom] {
        set root [file rootname $fn]
        close [open $root {WRONLY CREAT}]
	set root [file rootname $fn]
	close [open $root {WRONLY CREAT}]
    }
    llength [glob -directory $d *]
} -cleanup {
    file delete -force $d/bar
    removeFile bar.soom $d
    removeDirectory foo
} -result 2

unset globname

# The following tests are only valid for Unix systems. On some systems, like
# AFS, "000" protection doesn't prevent access by owner, so the following test
# is not portable.
# The following tests are only valid for Unix systems.
# On some systems, like AFS, "000" protection doesn't prevent
# access by owner, so the following test is not portable.

catch {file attributes globTest/a1 -permissions 0000}
test filename-15.1 {unix specific globbing} {unix nonPortable} {
    string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
    string tolower [list [catch {glob globTest/a1/*} msg]  $msg $errorCode]
} {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} {
    glob -nocomplain globTest/a1/*
} {}
test filename-15.3 {unix specific no complain: no errors, good result} \
	{unix nonPortable} {
    # test fails because if an error occurs, the interp's result is reset...
    # test fails because if an error occur , the interp's result
    # is reset...
    glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
} {globTest/a2 globTest/a3}

catch {file attributes globTest/a1 -permissions 0755}
test filename-15.4 {unix specific no complain: no errors, good result} \
	{unix nonPortable} {
    # test fails because if an error occurs, the interp's result is reset...
    # or you don't run at scriptics where the outser and welch users exists
    # test fails because if an error occurs, the interp's result
    # is reset... or you don't run at scriptics where the
    # outser and welch users exists
    glob -nocomplain ~ouster ~foo ~welch
} {/home/ouster /home/welch}
test filename-15.4.1 {no complain: errors, sequencing} {
    # test used to fail because if an error occurs, the interp's result is
    # reset... But, the sequence means we throw a different error first.
    list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \
	[catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2
    # test used to fail because if an error occurs, the interp's result
    # is reset... But, the sequence means we throw a different error
    # first.
    concat \
      [list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1] \
      [list [catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2]
} {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}}
test filename-15.4.2 {no complain: errors, sequencing} -body {
    # test used to fail because if an error occurs, the interp's result is
    # reset...
    list [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \
	[list [catch {glob -nocomplain * ~wontexist} res2] $res2]
} -match compareWords -result equal
test filename-15.4.2 {no complain: errors, sequencing} {
    # test used to fail because if an error occurs, the interp's result
    # is reset...
    string equal \
      [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \
      [list [catch {glob -nocomplain * ~wontexist} res2] $res2]
} {1}
test filename-15.5 {unix specific globbing} {unix nonPortable} {
    glob ~ouster/.csh*
} "/home/ouster/.cshrc"
touch globTest/odd\\\[\]*?\{\}name
test filename-15.6 {unix specific globbing} -constraints {unix} -setup {
catch {close [open globTest/odd\\\[\]*?\{\}name w]}
test filename-15.6 {unix specific globbing} {unix} {
    global env
    set temp $env(HOME)
} -body {
    set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
    glob ~
    set result [list [catch {glob ~} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    set result
} -result [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]
} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]]
catch {file delete -force globTest/odd\\\[\]*?\{\}name}
test filename-15.7 {win specific globbing} -constraints {win} -body {
    glob ~
} -match regexp -result {[^/]$}
test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup {
test filename-15.7 {win specific globbing} {win} {
    if {[string index [glob ~] end] == "/"} {
	set res "glob ~ is [glob ~] but shouldn't end in a separator"
    } else {
	set res "ok"
    }
} {ok}
test filename-15.8 {win and unix specific globbing} {unixOrWin} {
    global env
    set temp $env(HOME)
} -body {
    touch $env(HOME)/globTest/anyname
    catch {close [open $env(HOME)/globTest/anyname w]} err
    set env(HOME) $env(HOME)/globTest/anyname
    glob ~
    set result [list [catch {glob ~} msg] $msg]
} -cleanup {
    set env(HOME) $temp
    catch {file delete -force $env(HOME)/globTest/anyname}
    set result
} -result [list [lindex [glob ~] 0]/globTest/anyname]
} [list 0 [list [lindex [glob ~] 0]/globTest/anyname]]

# The following tests are only valid for Windows systems.
set oldDir [pwd]
if {[testConstraint win]} {
    cd c:/
    file delete -force globTest
    file mkdir globTest
    touch globTest/x1.BAT
    touch globTest/y1.Bat
    touch globTest/z1.bat
    close [open globTest/x1.BAT w]
    close [open globTest/y1.Bat w]
    close [open globTest/z1.bat w]
}

test filename-16.1 {windows specific globbing} {win} {
    lsort [glob globTest/*.bat]
} {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
test filename-16.2 {windows specific globbing} {win} {
    glob c:
} c:
test filename-16.2.1 {windows specific globbing} -constraints {win} -setup {
    list [catch {glob c:} res] $res
} {0 c:}
test filename-16.2.1 {windows specific globbing} {win} {
    set dir [pwd]
} -body {
    cd C:/
    glob c:
    set res [list [catch {glob c:} err] $err]
} -cleanup {
    cd $dir
} -result c:
    set res
} {0 c:}
test filename-16.3 {windows specific globbing} {win} {
    glob -nocomplain c:\\\\
} c:/
test filename-16.4 {windows specific globbing} {win} {
    glob -nocomplain c:/
} c:/
test filename-16.5 {windows specific globbing} {win} {
1448
1449
1450
1451
1452
1453
1454
1455

1456
1457
1458
1459
1460
1461
1462
1463
1464

1465
1466
1467
1468
1469
1470










1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485

1486

1487
1488
1489


1490
1491
1492
1493
1494




1495
1496

1497

1498
1499
1500
1501
1502
1503
1504
1505
1506
1507

1508

1509
1510
1511
1512
1513
1514
1515
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
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547

1548
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







-
+








-
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+















+
-
+

-
-
+
+
-
-
-
-
-
+
+
+
+
-

+
-
+










+
-
+







} //[info hostname]/c/globTest
test filename-16.13 {windows specific globbing} {win sharedCdrive} {
    cd //[info hostname]/c
    glob "\\\\\\\\[info hostname]\\\\c\\\\*Test"
} //[info hostname]/c/globTest
test filename-16.14 {windows specific globbing} {win} {
    cd [lindex [glob -types d -dir C:/ *] 0]
    expr {".." in [glob {{.,*}*}]}
    expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1}
} {1}
test filename-16.15 {windows specific globbing} {win} {
    cd [lindex [glob -types d -dir C:/ *] 0]
    glob ..
} {..}
test filename-16.16 {windows specific globbing} {win} {
    file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0]
} {..}
test filename-16.17 {windows specific globbing} -constraints {win} -body {
test filename-16.17 {windows specific globbing} {win} {
    cd C:/
    # Ensure correct trimming of tails with absolute and volume relative
    # globbing.
    list [glob -nocomplain -tails -dir C:/ *] \
	[glob -nocomplain -tails -dir C: *]
} -match compareWords -result equal
    # Ensure correct trimming of tails with absolute and
    # volume relative globbing.
    set res1 [glob -nocomplain -tails -dir C:/ *]
    set res2 [glob -nocomplain -tails -dir C: *]
    if {$res1 eq $res2} {
	concat ok
    } else {
        concat $res1 ne $res2
    }
} {ok}

# Put the working directory back now that we're done with globbing in C:/
if {[testConstraint win]} {
    cd $oldDir
}

test filename-17.1 {windows specific special files} {testsetplatform} {
    testsetplatform win
    list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \
	[file pathtype prn] [file pathtype nul] [file pathtype aux] \
	[file pathtype foo]
} {absolute absolute absolute absolute absolute absolute relative}
if {[testConstraint testsetplatform]} {
    testsetplatform $platform
}

test filename-17.2 {windows specific glob with executable} -body {
test filename-17.2 {windows specific glob with executable} {win} {
    makeDirectory execglob
    foreach ext {exe com cmd bat notexecutable} {
        makeFile contents execglob/abc.$ext
    makeFile contents execglob/abc.exe
    makeFile contents execglob/abc.notexecutable
    }
    lsort [glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *]
} -constraints {win} -cleanup {
    foreach ext {exe com cmd bat ps1 notexecutable} {
        removeFile execglob/abc.$ext
    set res [glob -nocomplain -dir [temporaryDirectory]/execglob \
      -tails -types x *]
    removeFile execglob/abc.exe
    removeFile execglob/abc.notexecutable
    }
    removeDirectory execglob
    set res
} -result {abc.bat abc.cmd abc.com abc.exe}
} {abc.exe}
test filename-17.3 {Bug 2571597} win {
    set p /a
    file pathtype $p
    file normalize $p
    file pathtype $p
} volumerelative

test fileName-18.1 {windows - split ADS name correctly} {win} {
    # bug 1194458
    set x [file split c:/c:d]
    set y [eval [linsert $x 0 file join]]
    list $x [file join {*}$x]
    list $x $y
} {{c:/ ./c:d} c:/c:d}

test fileName-19.1 {ensure that [Bug 1325099] stays fixed} {
    # Any non-crashing result is OK
    list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file]
} {0 0}

1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1693
1694
1695
1696
1697
1698
1699

1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711







-












} -result ~/sub/fileName-20.10

# cleanup
catch {file delete -force C:/globTest}
cd [temporaryDirectory]
file delete -force globTest
cd $oldpwd
catch {removeDirectory tcl[pid]}
set env(HOME) $oldhome
if {[testConstraint testsetplatform]} {
    testsetplatform $platform
    catch {unset platform}
}
catch {unset oldhome temp result globPreResult}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/fileSystem.test.

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
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


-
-
-
+
+
+



-
-
+
+

+

-
-
-
-
+
-







-
-
-
-
-
-
-
-
-
-
-




-








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-


-
+
+
+

-















+
+
+
+




-
-










-
+



-
+



-
+



-
+

-
-
+
+




-
+

-
-
+
+

-
+

-



-
+








-
+






-
+







# This file tests the filesystem and vfs internals.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2002 Vincent Darley.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2
namespace eval ::tcl::test::fileSystem {

    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    namespace import ::tcltest::*
    }

    catch {
	file delete -force link.file
	file delete -force dir.link
	file delete -force [file join dir.dir linkinside.file]
    }

testConstraint loaddll 0
catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::ddever [package require dde]
    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
    set ::regver  [package require registry]
    set ::reglib [lindex [package ifneeded registry $::regver] 1]
    testConstraint loaddll 1
}

# Test for commands defined in Tcltest executable
testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

cd [tcltest::temporaryDirectory]
makeFile "test file" gorp.file
makeDirectory dir.dir
makeDirectory [file join dir.dir dirinside.dir]
makeFile "test file in directory" [file join dir.dir inside.file]

testConstraint unusedDrive 0
testConstraint moreThanOneDrive 0
apply {{} {
    # The variables 'drive' and 'drives' will be used below.
    variable drive {} drives {}
    if {[testConstraint win]} {
	set vols [string map [list :/ {}] [file volumes]]
	for {set i 0} {$i < 26} {incr i} {
	    set drive [format %c [expr {$i + 65}]]
	    if {$drive ni $vols} {
		testConstraint unusedDrive 1
		break
	    }
	}

	set dir [pwd]
set drive {}
if {[testConstraint win]} {
    set vols [string map [list :/ {}] [file volumes]]
    for {set i 0} {$i < 26} {incr i} {
	set drive [format %c [expr {$i + 65}]]
	if {[lsearch -exact $vols $drive] == -1} {
	    testConstraint unusedDrive 1
	    break
	}
    }
    unset i vols
    # The variable 'drive' will be used below
}

testConstraint moreThanOneDrive 0
set drives [list]
if {[testConstraint win]} {
    set dir [pwd]
	try {
	    foreach vol [file volumes] {
		if {![catch {cd $vol}]} {
		    lappend drives $vol
		}
	    }
	    testConstraint moreThanOneDrive [llength $drives]
	} finally {
	    cd $dir
	}
    }
    foreach vol [file volumes] {
        if {![catch {cd $vol}]} {
            lappend drives $vol
        }
    }
    if {[llength $drives] > 1} {
        testConstraint moreThanOneDrive 1
    }
    # The variable 'drives' will be used below
    unset vol
    cd $dir
    unset dir
}

} ::tcl::test::fileSystem}

proc testPathEqual {one two} {
    if {$one eq $two} {
	return "ok"
	return 1
    } else {
	return "not equal: $one $two"
    }
    return "not equal: $one $two"
}

testConstraint hasLinks [expr {![catch {
    file link link.file gorp.file
    cd dir.dir
    file link \
	[file join linkinside.file] \
	[file join inside.file]
    cd ..
    file link dir.link dir.dir
    cd dir.dir
    file link [file join dirinside.link] \
	[file join dirinside.dir]
    cd ..
}]}]

testConstraint haveDdeDll [llength \
	[glob -nocomplain -directory [file dirname [info nameof]] \
		*dde*[info sharedlib]]]

if {[testConstraint testsetplatform]} {
    set platform [testgetplatform]
}

# ----------------------------------------------------------------------

test filesystem-1.0 {link normalisation} {hasLinks} {
   string equal [file normalize gorp.file] [file normalize link.file]
} {0}
test filesystem-1.1 {link normalisation} {hasLinks} {
   string equal [file normalize dir.dir] [file normalize dir.link]
} {0}
test filesystem-1.2 {link normalisation} {hasLinks unix} {
    testPathEqual [file normalize [file join gorp.file foo]] \
	[file normalize [file join link.file foo]]
} ok
} {1}
test filesystem-1.3 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir foo]] \
	[file normalize [file join dir.link foo]]
} ok
} {1}
test filesystem-1.4 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir inside.file]] \
	[file normalize [file join dir.link inside.file]]
} ok
} {1}
test filesystem-1.5 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir linkinside.file]] \
	[file normalize [file join dir.dir linkinside.file]]
} ok
} {1}
test filesystem-1.6 {link normalisation} {hasLinks} {
    string equal [file normalize [file join dir.dir linkinside.file]] \
	[file normalize [file join dir.link inside.file]]
   string equal [file normalize [file join dir.dir linkinside.file]] \
     [file normalize [file join dir.link inside.file]]
} {0}
test filesystem-1.7 {link normalisation} {hasLinks unix} {
    testPathEqual [file normalize [file join dir.link linkinside.file foo]] \
	[file normalize [file join dir.dir inside.file foo]]
} ok
} {1}
test filesystem-1.8 {link normalisation} {hasLinks} {
    string equal [file normalize [file join dir.dir linkinside.filefoo]] \
	[file normalize [file join dir.link inside.filefoo]]
   string equal [file normalize [file join dir.dir linkinside.filefoo]] \
       [file normalize [file join dir.link inside.filefoo]]
} {0}
test filesystem-1.9 {link normalisation} -setup {
test filesystem-1.9 {link normalisation} {unix hasLinks} {
    file delete -force dir.link
} -constraints {unix hasLinks} -body {
    file link dir.link [file nativename dir.dir]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir.link inside.file foo]]
} -result ok
} {1}
test filesystem-1.10 {link normalisation: double link} -constraints {
    unix hasLinks
} -body {
    file link dir2.link dir.link
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.link inside.file foo]]
} -cleanup {
    file delete dir2.link
} -result ok
} -result {1}
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
    file link dir2.link dir.link
    file link [file join dir2.file dir2.link] [file join .. dir2.link]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.file dir2.link inside.file foo]]
} ok
} {1}
test filesystem-1.12 {file new native path} {} {
    for {set i 0} {$i < 10} {incr i} {
	foreach f [lsort [glob -nocomplain -type l *]] {
	    catch {file readlink $f}
	}
    }
    # If we reach here we've succeeded. We used to crash above.
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
363
364









365
366
367









368
369
370









371
372
373









374
375
376









377
378
379









380
381
382
383
384
385
386
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
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
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







-
+

-



-
-
-
+
+
+
+
+
+
+
+




-
-
-
-
+
+
+
+
+
+
+
+
+

-




-
-
-
-
+
+
+
+
+
+
+
+
+

-





-
-
+
+
+
+

-
-
+



-
+








-
-
-
+
+
+


















-
-
+
+







-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
-
-
+

+

-
+
-

+
-
-
+
+
-
-

-
-
+
+
+
+
-

+
+
+
-
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+







} "${drive}:/a"
test filesystem-1.25 {file normalisation} {win unusedDrive} {
    file normalize ${drive}:/./.././../../a
} "${drive}:/a"
test filesystem-1.25.1 {file normalisation} {win unusedDrive} {
    file normalize ${drive}:/./.././..\\..\\a\\bb
} "${drive}:/a/bb"
test filesystem-1.26 {link normalisation: link and ..} -setup {
test filesystem-1.26 {link normalisation: link and ..} {hasLinks} {
    file delete -force dir2.link
} -constraints {hasLinks} -body {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    file link dir2.link [file join dir2 foo bar]
    testPathEqual [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]
} -result ok
    set res [list [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]]
    if {![string equal [lindex $res 0] [lindex $res 1]]} {
	set res "$res not equal"
    } else {
	set res "ok"
    }
} {ok}
test filesystem-1.27 {file normalisation: up and down with ..} {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    set dir2 [file join dir2 .. dir2 foo .. foo bar]
    list [testPathEqual [file normalize $dir] [file normalize $dir2]] \
	[file exists $dir] [file exists $dir2]
} {ok 1 1}
test filesystem-1.28 {link normalisation: link with .. and ..} -setup {
    set res [list [file normalize $dir] [file normalize $dir2]]
    set res2 [list [file exists $dir] [file exists $dir2]]
    if {![string equal [lindex $res 0] [lindex $res 1]]} {
	set res "exists: $res2, $res not equal"
    } else {
	set res "ok: $res2"
    }
} {ok: 1 1}
test filesystem-1.28 {link normalisation: link with .. and ..} {hasLinks} {
    file delete -force dir2.link
} -constraints {hasLinks} -body {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    set to [file join dir2 .. dir2 foo .. foo bar]
    file link dir2.link $to
    testPathEqual [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]
} -result ok
test filesystem-1.29 {link normalisation: link with ..} -setup {
    set res [list [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]]
    if {![string equal [lindex $res 0] [lindex $res 1]]} {
	set res "$res not equal"
    } else {
	set res "ok"
    }
} {ok}
test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
    file delete -force dir2.link
} -constraints {hasLinks} -body {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    set to [file join dir2 .. dir2 foo .. foo bar]
    file link dir2.link $to
    set res [file normalize [file join dir2.link x yyy z]]
    if {[string match *..* $res]} {
	return "$res must not contain '..'"
    if {[string first ".." $res] != -1} {
	set res "$res must not contain '..'"
    } else {
	set res "ok"
    }
    return "ok"
} -result {ok}
} {ok}
test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} {
    testPathEqual [file normalize [file join dir.link dirinside.link abc]] \
	[file normalize [file join dir.dir dirinside.dir abc]]
} ok
} {1}
file delete -force dir2.file
file delete -force dir2.link
file delete -force link.file dir.link
file delete -force dir2
file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
test filesystem-1.30 {normalisation of nonexistent user} -body {
    file normalize ~noonewiththisname
} -returnCodes error -result {user "noonewiththisname" doesn't exist}
test filesystem-1.30 {normalisation of nonexistent user} {
    list [catch {file normalize ~noonewiththisname} err] $err
} {1 {user "noonewiththisname" doesn't exist}}
test filesystem-1.30.1 {normalisation of existing user} -body {
    catch {file normalize ~$::tcl_platform(user)}
} -result {0}
test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body {
    file normalize ~nonexistentuser@nonexistentdomain
} -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar
} {/bar}
test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform windows
    set res [file normalize C:/../bar]
    if {[testConstraint unix]} {
	# Some unices go further in normalizing this -- not really a problem
	# since this is a Windows test.
	# Some unices go further in normalizing this -- not really
	# a problem since this is a Windows test
	regexp {C:/bar$} $res res
    }
    set res
} {C:/bar}
if {[testConstraint testsetplatform]} {
    testsetplatform $platform
}
test filesystem-1.34 {file normalisation with '/./'} -body {
    file normalize /foo/bar/anc/./.tml
} -match regexp -result {^(?:(?!/\./).)*$}
test filesystem-1.35a {file normalisation with '/./'} -body {
    file normalize /ffo/bar/anc/./foo/.tml
test filesystem-1.34 {file normalisation with '/./'} {
    set res [file normalize /foo/bar/anc/./.tml]
    if {[string first "/./" $res] != -1} {
	set res "normalization of /foo/bar/anc/./.tml is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.35 {file normalisation with '/./'} {
    set res [file normalize /ffo/bar/anc/./foo/.tml]
} -match regexp -result {^(?:(?!/\./).)*$}
test filesystem-1.35b {file normalisation with '/./'} {
    llength [regexp -all foo [file normalize /ffo/bar/anc/./foo/.tml]]
} 1
test filesystem-1.36a {file normalisation with '/./'} -body {
    file normalize /foo/bar/anc/././asdasd/.tml
    if {[string first "/./" $res] != -1 || ([regsub -all "foo" $res "" reg] == 2)} {
	set res "normalization of /ffo/bar/anc/./foo/.tml is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.36 {file normalisation with '/./'} {
    set res [file normalize /foo/bar/anc/././asdasd/.tml]
} -match regexp -result {^(?:(?!/\./).)*$}
test filesystem-1.36b {file normalisation with '/./'} {
    llength [regexp -all asdasd [file normalize /foo/bar/anc/././asdasd/.tml]]
} 1
test filesystem-1.37 {file normalisation with '/./'} -body {
    if {[string first "/./" $res] != -1 || ([regsub -all "asdasd" $res "" reg] == 2) } {
	set res "normalization of /foo/bar/anc/././asdasd/.tml is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.37 {file normalisation with '/./'} {
    set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....."
    file norm $fname
} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$}
test filesystem-1.38 {file normalisation with volume relative} -setup {
    set res [file norm $fname]
    if {[string first "//" $res] != -1} {
	set res "normalization of $fname is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.38 {file normalisation with volume relative} \
    set dir [pwd]
} -constraints {win moreThanOneDrive knownMsvcBug} -body {
  {win moreThanOneDrive} {
    set path "[string range [lindex $drives 0] 0 1]foo"
    set dir [pwd]
    cd [lindex $drives 1]
    file norm $path
    set res [file norm $path]
} -cleanup {
    cd $dir
    set res
} -result "[lindex $drives 0]foo"
test filesystem-1.39 {file normalisation with volume relative} -setup {
} "[lindex $drives 0]foo"
test filesystem-1.39 {file normalisation with volume relative} {win} {
    set old [pwd]
} -constraints {win} -body {
    set drv C:/
    cd [lindex [glob -type d -dir $drv *] 0]
    file norm [string range $drv 0 1]
    set dir [lindex [glob -type d -dir $drv *] 0]
    set old [pwd]
    cd $dir
    set res [file norm [string range $drv 0 1]]
} -cleanup {
    cd $old
    if {[string index $res end] eq "/"} {
        set res "Bad normalized path: $res"
    } else {
} -match regexp -result {.*[^/]}
        set res "ok"
    }
} {ok}
test filesystem-1.40 {file normalisation with repeated separators} {
    testPathEqual [file norm foo////bar] [file norm foo/bar]
} ok
    set a [file norm foo////bar]
    set b [file norm foo/bar]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.41 {file normalisation with repeated separators} {win} {
    testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar]
} ok
    set a [file norm foo\\\\\\bar]
    set b [file norm foo/bar]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/..] [file norm /]
} ok
    set a [file norm /xxx/..]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/../] [file norm /]
} ok
    set a [file norm /xxx/../]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/foo/../..] [file norm /]
} ok
    set a [file norm /xxx/foo/../..]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/foo/../../] [file norm /]
} ok
    set a [file norm /xxx/foo/../../]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar]
} ok
    set a [file norm /xxx/foo/../../bar]
    set b [file norm /bar]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/../../bar] [file norm /bar]
} ok
    set a [file norm /xxx/../../bar]
    set b [file norm /bar]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/../bar] [file norm /bar]
} ok
    set a [file norm /xxx/../bar]
    set b [file norm /bar]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /..] [file norm /]
} ok
    set a [file norm /..]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /../] [file norm /]
} ok
    set a [file norm /../]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /.] [file norm /]
} ok
    set a [file norm /.]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /./] [file norm /]
} ok
    set a [file norm /./]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /../..] [file norm /]
} ok
    set a [file norm /../..]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /../../] [file norm /]
} ok
    set a [file norm /../../]
    set b [file norm /]

    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.52 {bug f9f390d0fa: file join where strep is not canonical} -constraints unix -body {
    set x //foo
    file normalize $x
    file join $x bar
} -result /foo/bar
test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical} -body {
    set x //foo
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
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
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
611
612
613
614

615
616

617
618

619
620


621
622
623
624
625
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
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
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

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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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



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
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
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
1140
1141
1142


1143
1144
1145
1146

1147


1148
1149
1150
1151
1152
1153

1154
1155
1156
1157











-
-
+
+








+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

















-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
-
-
+

+
-
+
+


-
+

-
-
-

-
-
-
+
-
-
-
-
-
-
-
-
-

-
+
-
-
-
+
+


-



+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
+
+

+
-
-
+
+


-



-
+
-
-
+


+
-
-
+
+


-




-
+
-
-
+


+
-
-
+
+


-



+
+
+
+
+
+
+
-
-
+
+
+
-
-
-
-
-
+


-



-
+
-



+
-
-
+
+
+
+
+
+






-










-
-
+



+
-
-
+
+






-











-




+
-
-
+
+









-











-




+
-
-
+
+









-







-
-
+
+
+




-




+
-
+

-
+





-
-
-
+
+

-
+
-




+
-
+

-
+


-










-
-
+
+


-




+
-
-
+
+


-




-
+
-
-
+



-
+
+















-
+







-
+


-
+


-

-
+
-


+
-
-
+
+


-

-
+
-


+
-
-
+
+


-

-
+
-


+
-
-
+
+


-

-
+
-


+
-
-
+
+


-

-
+
-


+
-
-
+
+


-






-
-


+
-
+







-
+



-








-
-
+


+
-
-
+
+



-








-
-
+


+
-
-
+
+



-








-
-
+


+
-
+
-
-






-
+



-
-
-
-
} -result 1

test filesystem-2.0 {new native path} {unix} {
   foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
       catch {file readlink $f}
   }
   # If we reach here we've succeeded. We used to crash above.
   return ok
} ok
   expr 1
} {1}

# Make sure the testfilesystem hasn't been registered.
if {[testConstraint testfilesystem]} {
  proc resetfs {} {
    while {![catch {testfilesystem 0}]} {}
  }
}

test filesystem-3.0 {Tcl_FSRegister} testfilesystem {
    resetfs
    testfilesystem 1
} {registered}
test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem {
    set result {}
    lappend result [testfilesystem 1]
    lappend result [testfilesystem 0]
    lappend result [catch {testfilesystem 0} msg] $msg
} {registered unregistered 1 failed}
test filesystem-3.1 {Tcl_FSUnregister} testfilesystem {
    resetfs
    testfilesystem 1
    testfilesystem 0
} {unregistered}
test filesystem-3.2 {Tcl_FSUnregister} testfilesystem {
    resetfs
    list [catch {testfilesystem 0} err] $err
} {1 failed}
test filesystem-3.3 {Tcl_FSRegister} testfilesystem {
    testfilesystem 1
    testfilesystem 1
    testfilesystem 0
    testfilesystem 0
} {unregistered}
test filesystem-3.4 {Tcl_FSRegister} -constraints testfilesystem -body {
    testfilesystem 1
    file system bar
} -cleanup {
    testfilesystem 0
} -result {reporting}
test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
    resetfs
    lindex [file system bar] 0
} {native}

test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    file exists foo
    testfilesystem 0
    return $filesystemReport
} -match glob -result {*{access foo}}
test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
test filesystem-4.0 {testfilesystem} {
    -constraints testfilesystem
    -match glob
    -body {
	testfilesystem 1
	set filesystemReport {}
	file exists foo
	testfilesystem 0
	set filesystemReport
    }
    -result {*{access foo}}
}
test filesystem-4.1 {testfilesystem} {
    -constraints testfilesystem
    set filesystemReport {}
    catch {file stat foo bar}
    testfilesystem 0
    return $filesystemReport
} -match glob -result {*{stat foo}}
test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    catch {file lstat foo bar}
    testfilesystem 0
    -match glob
    -body {
	testfilesystem 1
	set filesystemReport {}
	catch {file stat foo bar}
	testfilesystem 0
    return $filesystemReport
} -match glob -result {*{lstat foo}}
test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
	set filesystemReport
    catch {glob *}
    testfilesystem 0
    return $filesystemReport
} -match glob -result {*{matchindirectory *}*}

test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
    }
    -result {*{stat foo}}
}
test filesystem-4.2 {testfilesystem} {
    -constraints testfilesystem
    set orig $::env(HOME)
} -body {
    set ::env(HOME) /foo/bar/blah
    set testdir ~
    set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
    set ::env(HOME) /a/b/c
    set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
    -match glob
    -body {
	testfilesystem 1
	set filesystemReport {}
	catch {file lstat foo bar}
	testfilesystem 0
	set filesystemReport
    }
    -result {*{lstat foo}}
}
test filesystem-4.3 {testfilesystem} {
    -constraints testfilesystem
    -match glob
    -body {
	testfilesystem 1
	set filesystemReport {}
	catch {glob *}
	testfilesystem 0
	set filesystemReport
    }
    -result {*{matchindirectory *}*}
}

test filesystem-5.1 {cache and ~} {
    -constraints testfilesystem
    -match regexp
    -body {
	set orig $::env(HOME)
	set ::env(HOME) /foo/bar/blah
	set testdir ~
	set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
	set ::env(HOME) /a/b/c
	set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
    list $res1 $res2
} -cleanup {
    set ::env(HOME) $orig
} -match regexp -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/cygwin)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/cygwin)?(/a/b|a:b)}}

test filesystem-6.1 {empty file name} -returnCodes error -body {
    open ""
} -result {couldn't open "": no such file or directory}
test filesystem-6.2 {empty file name} -returnCodes error -body {
    file stat "" arr
} -result {could not read "": no such file or directory}
test filesystem-6.3 {empty file name} -returnCodes error -body {
    file atime ""
} -result {could not read "": no such file or directory}
test filesystem-6.4 {empty file name} -returnCodes error -body {
    file attributes ""
} -result {could not read "": no such file or directory}
test filesystem-6.5 {empty file name} -returnCodes error -body {
    file copy "" ""
	set ::env(HOME) $orig
	list $res1 $res2
    }
    -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/a/b|a:b)}}
}

test filesystem-6.1 {empty file name} {
    list [catch {open ""} msg] $msg
} {1 {couldn't open "": no such file or directory}}
test filesystem-6.2 {empty file name} {
    list [catch {file stat "" arr} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.3 {empty file name} {
    list [catch {file atime ""} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.4 {empty file name} {
    list [catch {file attributes ""} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.5 {empty file name} {
    list [catch {file copy "" ""} msg] $msg
} {1 {error copying "": no such file or directory}}
test filesystem-6.6 {empty file name} {
    list [catch {file delete ""} msg] $msg
} {0 {}}
test filesystem-6.7 {empty file name} {
    list [catch {file dirname ""} msg] $msg
} {0 .}
} -result {error copying "": no such file or directory}
test filesystem-6.6 {empty file name} {file delete ""} {}
test filesystem-6.7 {empty file name} {file dirname ""} .
test filesystem-6.8 {empty file name} {file executable ""} 0
test filesystem-6.9 {empty file name} {file exists ""} 0
test filesystem-6.10 {empty file name} {file extension ""} {}
test filesystem-6.11 {empty file name} {file isdirectory ""} 0
test filesystem-6.12 {empty file name} {file isfile ""} 0
test filesystem-6.13 {empty file name} {file join ""} {}
test filesystem-6.14 {empty file name} -returnCodes error -body {
    file link ""
} -result {could not read link "": no such file or directory}
test filesystem-6.15 {empty file name} -returnCodes error -body {
    file lstat "" arr
} -result {could not read "": no such file or directory}
test filesystem-6.16 {empty file name} -returnCodes error -body {
    file mtime ""
} -result {could not read "": no such file or directory}
test filesystem-6.17 {empty file name} -returnCodes error -body {
    file mtime "" 0
} -result {could not read "": no such file or directory}
test filesystem-6.18 {empty file name} -returnCodes error -body {
    file mkdir ""
} -result {can't create directory "": no such file or directory}
test filesystem-6.19 {empty file name} {file nativename ""} {}
test filesystem-6.20 {empty file name} {file normalize ""} {}
test filesystem-6.21 {empty file name} {file owned ""} 0
test filesystem-6.22 {empty file name} {file pathtype ""} relative
test filesystem-6.23 {empty file name} {file readable ""} 0
test filesystem-6.24 {empty file name} -returnCodes error -body {
    file readlink ""
} -result {could not read link "": no such file or directory}
test filesystem-6.25 {empty file name} -returnCodes error -body {
    file rename "" ""
} -result {error renaming "": no such file or directory}
test filesystem-6.26 {empty file name} {file rootname ""} {}
test filesystem-6.27 {empty file name} -returnCodes error -body {
    file separator ""
} -result {unrecognised path}
test filesystem-6.28 {empty file name} -returnCodes error -body {
    file size ""
} -result {could not read "": no such file or directory}
test filesystem-6.29 {empty file name} {file split ""} {}
test filesystem-6.30 {empty file name} -returnCodes error -body {
    file system ""
} -result {unrecognised path}
test filesystem-6.31 {empty file name} {file tail ""} {}
test filesystem-6.32 {empty file name} -returnCodes error -body {
    file type ""
} -result {could not read "": no such file or directory}
test filesystem-6.33 {empty file name} {file writable ""} 0
test filesystem-6.8 {empty file name} {
    list [catch {file executable ""} msg] $msg
} {0 0}
test filesystem-6.9 {empty file name} {
    list [catch {file exists ""} msg] $msg
} {0 0}
test filesystem-6.10 {empty file name} {
    list [catch {file extension ""} msg] $msg
} {0 {}}
test filesystem-6.11 {empty file name} {
    list [catch {file isdirectory ""} msg] $msg
} {0 0}
test filesystem-6.12 {empty file name} {
    list [catch {file isfile ""} msg] $msg
} {0 0}
test filesystem-6.13 {empty file name} {
    list [catch {file join ""} msg] $msg
} {0 {}}
test filesystem-6.14 {empty file name} {
    list [catch {file link ""} msg] $msg
} {1 {could not read link "": no such file or directory}}
test filesystem-6.15 {empty file name} {
    list [catch {file lstat "" arr} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.16 {empty file name} {
    list [catch {file mtime ""} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.17 {empty file name} {
    list [catch {file mtime "" 0} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.18 {empty file name} {
    list [catch {file mkdir ""} msg] $msg
} {1 {can't create directory "": no such file or directory}}
test filesystem-6.19 {empty file name} {
    list [catch {file nativename ""} msg] $msg
} {0 {}}
test filesystem-6.20 {empty file name} {
    list [catch {file normalize ""} msg] $msg
} {0 {}}
test filesystem-6.21 {empty file name} {
    list [catch {file owned ""} msg] $msg
} {0 0}
test filesystem-6.22 {empty file name} {
    list [catch {file pathtype ""} msg] $msg
} {0 relative}
test filesystem-6.23 {empty file name} {
    list [catch {file readable ""} msg] $msg
} {0 0}
test filesystem-6.24 {empty file name} {
    list [catch {file readlink ""} msg] $msg
} {1 {could not readlink "": no such file or directory}}
test filesystem-6.25 {empty file name} {
    list [catch {file rename "" ""} msg] $msg
} {1 {error renaming "": no such file or directory}}
test filesystem-6.26 {empty file name} {
    list [catch {file rootname ""} msg] $msg
} {0 {}}
test filesystem-6.27 {empty file name} {
    list [catch {file separator ""} msg] $msg
} {1 {Unrecognised path}}
test filesystem-6.28 {empty file name} {
    list [catch {file size ""} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.29 {empty file name} {
    list [catch {file split ""} msg] $msg
} {0 {}}
test filesystem-6.30 {empty file name} {
    list [catch {file system ""} msg] $msg
} {1 {Unrecognised path}}
test filesystem-6.31 {empty file name} {
    list [catch {file tail ""} msg] $msg
} {0 {}}
test filesystem-6.32 {empty file name} {
    list [catch {file type ""} msg] $msg
} {1 {could not read "": no such file or directory}}
test filesystem-6.33 {empty file name} {
    list [catch {file writable ""} msg] $msg
} {0 0}
test filesystem-6.34 {file name with (invalid) nul character} {
    list [catch "open foo\x00" msg] $msg
} [list 1 "couldn't open \"foo\x00\": filename is invalid on this platform"]

# Make sure the testfilesystem hasn't been registered.
if {[testConstraint testfilesystem]} {
    while {![catch {testfilesystem 0}]} {}
}

test filesystem-7.1.1 {load from vfs} -setup {
    set dir [pwd]
} -constraints {win testsimplefilesystem loaddll} -body {
test filesystem-7.1 {load from vfs} {win testsimplefilesystem haveDdeDll} {
    # This may cause a crash on exit
    set dir [pwd]
    cd [file dirname $::ddelib]
    cd [file dirname [info nameof]]
    set dde [lindex [glob *dde*[info sharedlib]] 0]
    testsimplefilesystem 1
    # This loads dde via a complex copy-to-temp operation
    load simplefs:/[file tail $::ddelib] dde
    load simplefs:/$dde Dde
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
    cd $dir
} -result ok
test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
    set dir [pwd]
    set res "ok"
} -constraints {win testsimplefilesystem loaddll} -body {
    # This may cause a crash on exit
    cd [file dirname $::reglib]
    testsimplefilesystem 1
    # This loads reg via a complex copy-to-temp operation
    load simplefs:/[file tail $::reglib] Registry
    unload simplefs:/[file tail $::reglib]
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
} {ok}
    cd $dir
} -result ok
test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {
test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \
  {testsimplefilesystem} {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
} -constraints testsimplefilesystem -body {
    # We created this file several tests ago.
    set origtime [file mtime gorp.file]
    set res [file exists gorp.file]
    if {[catch {
    testsimplefilesystem 1
    file delete -force theCopy
    file copy simplefs:/gorp.file theCopy
    testsimplefilesystem 0
    set newtime [file mtime theCopy]
	testsimplefilesystem 1
	file delete -force theCopy
	file copy simplefs:/gorp.file theCopy
	testsimplefilesystem 0
	set newtime [file mtime theCopy]
    lappend res [expr {$origtime == $newtime ? 1 : "$origtime != $newtime"}]
} -cleanup {
    catch {file delete theCopy}
	file delete theCopy
    } err]} {
	lappend res $err
	set newtime ""
    }
    cd $dir
    lappend res [expr {$origtime == $newtime}]
} -result {1 1}
test filesystem-7.3 {glob in simplefs} -setup {
} {1 1}
test filesystem-7.3 {glob in simplefs} testsimplefilesystem {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
} -constraints testsimplefilesystem -body {
    file mkdir simpledir
    close [open [file join simpledir simplefile] w]
    testsimplefilesystem 1
    glob -nocomplain -dir simplefs:/simpledir *
    set res [glob -nocomplain -dir simplefs:/simpledir *]
} -cleanup {
    catch {testsimplefilesystem 0}
    testsimplefilesystem 0
    file delete -force simpledir
    cd $dir
    set res
} -result {simplefs:/simpledir/simplefile}
test filesystem-7.3.1 {glob in simplefs: no path/dir} -setup {
} {simplefs:/simpledir/simplefile}
test filesystem-7.3.1 {glob in simplefs: no path/dir} testsimplefilesystem {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
} -constraints testsimplefilesystem -body {
    file mkdir simpledir
    close [open [file join simpledir simplefile] w]
    testsimplefilesystem 1
    set res [glob -nocomplain simplefs:/simpledir/*]
    lappend res {*}[glob -nocomplain simplefs:/simpledir]
    eval lappend res [glob -nocomplain simplefs:/simpledir]
} -cleanup {
    catch {testsimplefilesystem 0}
    testsimplefilesystem 0
    file delete -force simpledir
    cd $dir
    set res
} -result {simplefs:/simpledir/simplefile simplefs:/simpledir}
test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} -setup {
} {simplefs:/simpledir/simplefile simplefs:/simpledir}
test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} testsimplefilesystem {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
} -constraints testsimplefilesystem -body {
    file mkdir simpledir
    close [open [file join simpledir simplefile] w]
    testsimplefilesystem 1
    set res [glob -nocomplain simplefs:/s*]
    testsimplefilesystem 0
    file delete -force simpledir
    cd $dir
    if {[llength $res] > 0} {
	set res "ok"
    } else {
    glob -nocomplain simplefs:/s*
} -cleanup {
        set res "no files found with 'glob -nocomplain simplefs:/s*'"
    }
} {ok}
    catch {testsimplefilesystem 0}
    file delete -force simpledir
    cd $dir
} -match glob -result ?*
test filesystem-7.3.3 {glob in simplefs: pattern is a volume} -setup {
test filesystem-7.3.3 {glob in simplefs: pattern is a volume} testsimplefilesystem {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
} -constraints testsimplefilesystem -body {
    file mkdir simpledir
    close [open [file join simpledir simplefile] w]
    testsimplefilesystem 1
    glob -nocomplain simplefs:/*
    set res [glob -nocomplain simplefs:/*]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simpledir
    cd $dir
    if {[llength $res] > 0} {
} -match glob -result ?*
test filesystem-7.4 {cross-filesystem file copy with -force} -setup {
	set res "ok"
    } else {
	set res "no files found with 'glob -nocomplain simplefs:/*'"
    }
} {ok}
test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesystem {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    set fout [open [file join simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1
} -constraints testsimplefilesystem -body {
    # First copy should succeed
    set res [catch {file copy simplefs:/simplefile file2} err]
    lappend res $err
    # Second copy should fail (no -force)
    lappend res [catch {file copy simplefs:/simplefile file2} err]
    lappend res $err
    # Third copy should succeed (-force)
    lappend res [catch {file copy -force simplefs:/simplefile file2} err]
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    catch {testsimplefilesystem 0}
    testsimplefilesystem 0
    file delete -force simplefile
    file delete -force file2
    cd $dir
    set res
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
} {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesystem unix} {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    set fout [open [file join simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1
} -constraints {testsimplefilesystem unix} -body {
    # First copy should succeed
    set res [catch {file copy simplefs:/simplefile file2} err]
    lappend res $err
    file attributes file2 -permissions 0000
    # Second copy should fail (no -force)
    lappend res [catch {file copy simplefs:/simplefile file2} err]
    lappend res $err
    # Third copy should succeed (-force)
    lappend res [catch {file copy -force simplefs:/simplefile file2} err]
    lappend res $err
    lappend res [file exists file2]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simplefile
    file delete -force file2
    cd $dir
    set res
} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
} {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1
} -constraints testsimplefilesystem -body {
    # First copy should succeed
    set res [catch {file copy simplefs:/simpledir dir2} err]
    lappend res $err
    # Second copy should fail (no -force)
    lappend res [catch {file copy simplefs:/simpledir dir2} err]
    lappend res $err
    # Third copy should succeed (-force)
    lappend res [catch {file copy -force simplefs:/simpledir dir2} err]
    lappend res $err
    lappend res [file exists [file join dir2 simpledir]] \
	    [file exists [file join dir2 simpledir simplefile]]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simpledir
    file delete -force dir2
    cd $dir
    set res
} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
test filesystem-7.7 {cross-filesystem dir copy with -force} -setup {
} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesystem unix} {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    file mkdir dir2
    set fout [open [file join simpledir simplefile] w]
    puts -nonewline $fout "1234567890"
    close $fout
    testsimplefilesystem 1
} -constraints {testsimplefilesystem unix} -body {
    # First copy should succeed
    set res [catch {file copy simplefs:/simpledir dir2} err]
    lappend res $err
    # Second copy should fail (no -force)
    lappend res [catch {file copy simplefs:/simpledir dir2} err]
    lappend res $err
    # Third copy should succeed (-force)
    # I've noticed on some Unices that this only succeeds intermittently (some
    # runs work, some fail). This needs examining further.
    # I've noticed on some Unices that this only succeeds
    # intermittently (some runs work, some fail).  This needs
    # examining further.
    lappend res [catch {file copy -force simplefs:/simpledir dir2} err]
    lappend res $err
    lappend res [file exists [file join dir2 simpledir]] \
	    [file exists [file join dir2 simpledir simplefile]]
} -cleanup {
    testsimplefilesystem 0
    file delete -force simpledir
    file delete -force dir2
    cd $dir
    set res
} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
removeFile gorp.file
test filesystem-7.8 {vfs cd} -setup {
test filesystem-7.8 {vfs cd} testsimplefilesystem {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
    file delete -force simpledir
    file mkdir simpledir
    testsimplefilesystem 1
} -constraints testsimplefilesystem -body {
    # This can variously cause an infinite loop or simply have no effect at
    # all (before certain bugs were fixed, of course).
    # This can variously cause an infinite loop or simply have
    # no effect at all (before certain bugs were fixed, of course).
    cd simplefs:/simpledir
    pwd
    set res [pwd]
} -cleanup {
    cd [tcltest::temporaryDirectory]
    testsimplefilesystem 0
    file delete -force simpledir
    cd $dir
    set res
} -result {simplefs:/simpledir}
} {simplefs:/simpledir}

test filesystem-8.1 {relative path objects and caching of pwd} -setup {
test filesystem-8.1 {relative path objects and caching of pwd} {
    set dir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    makeDirectory abc
    makeDirectory def
    makeFile "contents" [file join abc foo]
    cd abc
    set f "foo"
    set res {}
    lappend res [file exists $f]
    lappend res [file exists $f]
    cd ..
    cd def
    # If we haven't cleared the object's cwd cache, Tcl will think it still
    # exists.
    # If we haven't cleared the object's cwd cache, Tcl
    # will think it still exists.
    lappend res [file exists $f]
    lappend res [file exists $f]
} -cleanup {
    removeFile [file join abc foo]
    removeDirectory abc
    removeDirectory def
    cd $dir
    set res
} -result {1 1 0 0}
test filesystem-8.2 {relative path objects and use of pwd} -setup {
} {1 1 0 0}
test filesystem-8.2 {relative path objects and use of pwd} {
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    set dir "abc"
    makeDirectory $dir
    makeFile "contents" [file join abc foo]
    cd $dir
    file exists [lindex [glob *] 0]
    set res [file exists [lindex [glob *] 0]]
} -cleanup {
    cd [tcltest::temporaryDirectory]
    cd ..
    removeFile [file join abc foo]
    removeDirectory abc
    cd $origdir
} -result 1
    set res
} {1}
test filesystem-8.3 {path objects and empty string} {
    set anchor ""
    set dst foo
    set res $dst
    set yyy [file split $anchor]
    set dst [file join  $anchor $dst]
    lappend res $dst $yyy
} {foo foo {}}

proc TestFind1 {d f} {
    set r1 [file exists [file join $d $f]]
    lappend res "[file join $d $f] found: $r1"
    lappend res "is dir a dir? [file isdirectory $d]"
    set r2 [file exists [file join $d $f]]
    lappend res "[file join $d $f] found: $r2"
    return $res
    set res
}
proc TestFind2 {d f} {
    set r1 [file exists [file join $d $f]]
    lappend res "[file join $d $f] found: $r1"
    lappend res "is dir a dir? [file isdirectory [file join $d]]"
    set r2 [file exists [file join $d $f]]
    lappend res "[file join $d $f] found: $r2"
    return $res
    set res
}

test filesystem-9.1 {path objects and join and object rep} -setup {
test filesystem-9.1 {path objects and join and object rep} {
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir [file join a b c]
    TestFind1 a [file join b . c]
    set res [TestFind1 a [file join b . c]]
} -cleanup {
    file delete -force a
    cd $origdir
    set res
} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
test filesystem-9.2 {path objects and join and object rep} -setup {
} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
test filesystem-9.2 {path objects and join and object rep} {
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir [file join a b c]
    TestFind2 a [file join b . c]
    set res [TestFind2 a [file join b . c]]
} -cleanup {
    file delete -force a
    cd $origdir
    set res
} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
test filesystem-9.2.1 {path objects and join and object rep} -setup {
} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
test filesystem-9.2.1 {path objects and join and object rep} {
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir [file join a b c]
    TestFind2 a [file join b .]
    set res [TestFind2 a [file join b .]]
} -cleanup {
    file delete -force a
    cd $origdir
    set res
} -result {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
test filesystem-9.3 {path objects and join and object rep} -setup {
} {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
test filesystem-9.3 {path objects and join and object rep} {
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir [file join a b c]
    TestFind1 a [file join b .. b c]
    set res [TestFind1 a [file join b .. b c]]
} -cleanup {
    file delete -force a
    cd $origdir
    set res
} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
test filesystem-9.4 {path objects and join and object rep} -setup {
} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
test filesystem-9.4 {path objects and join and object rep} {
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir [file join a b c]
    TestFind2 a [file join b .. b c]
    set res [TestFind2 a [file join b .. b c]]
} -cleanup {
    file delete -force a
    cd $origdir
    set res
} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
test filesystem-9.5 {path objects and file tail and object rep} -setup {
} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
test filesystem-9.5 {path objects and file tail and object rep} {
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir dgp
    close [open dgp/test w]
    foreach relative [glob -nocomplain [file join * test]] {
	set absolute [file join [pwd] $relative]
	set res [list [file tail $absolute] "test"]
    }
    return $res
} -cleanup {
    file delete -force dgp
    cd $origdir
    set res
} -result {test test}
} {test test}
test filesystem-9.6 {path objects and file tail and object rep} win {
    set res {}
    set p "C:\\toto"
    lappend res [file join $p toto]
    file isdirectory $p
    lappend res [file join $p toto]
} {C:/toto/toto C:/toto/toto}
test filesystem-9.7 {path objects and glob and file tail and tilde} -setup {
test filesystem-9.7 {path objects and glob and file tail and tilde} {
    set res {}
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir tilde
    close [open tilde/~testNotExist w]
    cd tilde
    set file [lindex [glob *test*] 0]
    lappend res [file exists $file] [catch {file tail $file} r] $r
    lappend res $file
    lappend res [file exists $file] [catch {file tail $file} r] $r
    lappend res [catch {file tail $file} r] $r
} -cleanup {
    cd [tcltest::temporaryDirectory]
    cd ..
    file delete -force tilde
    cd $origdir
    set res
} -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
test filesystem-9.8 {path objects and glob and file tail and tilde} -setup {
} {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
test filesystem-9.8 {path objects and glob and file tail and tilde} {
    set res {}
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir tilde
    close [open tilde/~testNotExist w]
    cd tilde
    set file1 [lindex [glob *test*] 0]
    set file2 "~testNotExist"
    lappend res $file1 $file2
    lappend res [catch {file tail $file1} r] $r
    lappend res [catch {file tail $file2} r] $r
} -cleanup {
    cd [tcltest::temporaryDirectory]
    cd ..
    file delete -force tilde
    cd $origdir
    set res
} -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
test filesystem-9.9 {path objects and glob and file tail and tilde} -setup {
} {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
test filesystem-9.9 {path objects and glob and file tail and tilde} {
    set res {}
    set origdir [pwd]
    cd [tcltest::temporaryDirectory]
} -body {
    file mkdir tilde
    close [open tilde/~testNotExist w]
    cd tilde
    set file1 [lindex [glob *test*] 0]
    set file2 "~testNotExist"
    lappend res [catch {file exists $file1} r] $r
    lappend res [catch {file exists $file2} r] $r
    lappend res [string equal $file1 $file2]
} -cleanup {
    cd [tcltest::temporaryDirectory]
    cd ..
    file delete -force tilde
    cd $origdir
    set res
} -result {0 0 0 0 1}
} {0 0 0 0 1}

# ----------------------------------------------------------------------

test filesystem-10.1 {Bug 3414754} {
    string match */ [file join [pwd] foo/]
} 0

cleanupTests
unset -nocomplain drive drives
unset -nocomplain drive
}
namespace delete ::tcl::test::fileSystem
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/fileSystemEncoding.test.

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























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#!  /usr/bin/env tclsh

# Copyright (c) 2019 Poor Yorick

if {[string equal $::tcl_platform(os) "Windows NT"]} {
    return
}

namespace eval ::tcl::test::fileSystemEncoding {

    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    variable fname1 \u767b\u9e1b\u9d72\u6a13

    proc autopath {} {
	global auto_path
	set scriptpath [info script]
	set scriptpathnorm [file dirname [file normalize $scriptpath/...]]
	set dirnorm [file dirname $scriptpathnorm]
	set idx [lsearch -exact $auto_path $dirnorm]
	if {$idx >= 0} {
	    set auto_path [lreplace $auto_path[set auto_path {}] $idx $idx {}]
	}
	set auto_path [linsert $auto_path[set auto_path {}] 0 0 $dirnorm]
    }
    autopath

    package require tcltests

    test filesystemEncoding-1.0 {
	issue bcd100410465
    } -body {
	set dir [tcltests::tempdir]
	set saved [encoding system]
	encoding system iso8859-1
	set fname1a $dir/$fname1
	set utf8name [encoding convertto utf-8 $fname1a]
	makeFile {} $utf8name
	set globbed [lindex [glob -directory $dir *] 0]
	encoding system utf-8
	set res [file exists $globbed]
	encoding system iso8859-1
	lappend res [file exists $globbed]
	return $res
    } -cleanup {
	removeFile $utf8name
	file delete -force $dir
	encoding system $saved
    } -result  {0 1}

    cleanupTests
}

Changes to tests/for-old.test.

8
9
10
11
12
13
14
15
16


17
18
19
20
21
22
23
8
9
10
11
12
13
14


15
16
17
18
19
20
21
22
23







-
-
+
+







#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# Check "for" and its use of continue and break.

catch {unset a i}
test for-old-1.1 {for tests} {

Changes to tests/for.test.

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
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16



17


18
19
20
21
22
23
24











-
-
+
+



-
-
-
+
-
-







# Commands covered:  for, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
testConstraint bug-05489ce335 [testConstraint knownBug]
    proc meminfo {} {lindex [split [memory info] "\n"] 3 3}
}

# Basic "for" operation.

test for-1.1 {TclCompileForCmd: missing initial command} {
    list [catch {for} msg] $msg
} {1 {wrong # args: should be "for start test next command"}}
test for-1.2 {TclCompileForCmd: error in initial command} -body {
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
195
196
197
198
199
200
201













202
203
204
205
206
207
208







-
-
-
-
-
-
-
-
-
-
-
-
-







	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
    }
    set a
} {1 3}
test for-2.7 {continue tests, uncompiled [for]} -body {
    set file [makeFile {
    	set guard 0
	for {set i 20} {$i > 0} {incr i -1} {
	    if {[incr guard]>30} {return BAD}
	    continue
	}
	return GOOD
    } source.file]
    source $file
} -cleanup {
    removeFile source.file
} -result GOOD

# Check "for" and "break".

test for-3.1 {TclCompileBreakCmd: arguments after "break"} {
    catch {break foo} msg
    set msg
} {wrong # args: should be "break"}
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
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







-
+


-
+



-
+



-
+

-
+

-
+


-
+


-
+


-
+



-
+










-
+








+



















+




















+

+







        12 {Date: Wed, 11 Sep 1996 11:14:53 -0700} \
        13 {From: George <george@tcl>} \
        14 {The Tcl 7.6 and Tk 4.2 releases} \
        15 {} \
        16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
        17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
        18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
        19 {so we hope to have only a single beta release and to go final in early October, 1996.} \
        19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
        20 {} \
        21 {} \
        22 {What's new} \
        22 {What's new } \
        23 {} \
        24 {The most important changes in the releases are summarized below. See the README} \
        25 {and changes files in the distributions for more complete information on what has} \
        26 {changed, including both feature changes and bug fixes.} \
        26 {changed, including both feature changes and bug fixes. } \
        27 {} \
        28 {     There are new options to the file command for copying files (file copy),} \
        29 {     deleting files and directories (file delete), creating directories (file} \
        30 {     mkdir), and renaming files (file rename).} \
        30 {     mkdir), and renaming files (file rename). } \
        31 {     The implementation of exec has been improved greatly for Windows 95 and} \
        32 {     Windows NT.} \
        32 {     Windows NT. } \
        33 {     There is a new memory allocator for the Macintosh version, which should be} \
        34 {     more efficient than the old one.} \
        34 {     more efficient than the old one. } \
        35 {     Tk's grid geometry manager has been completely rewritten. The layout} \
        36 {     algorithm produces much better layouts than before, especially where rows or} \
        37 {     columns were stretchable.} \
        37 {     columns were stretchable. } \
        38 {     There are new commands for creating common dialog boxes:} \
        39 {     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
        40 {     tk_messageBox. These use native dialog boxes if they are available.} \
        40 {     tk_messageBox. These use native dialog boxes if they are available. } \
        41 {     There is a new virtual event mechanism for handling events in a more portable} \
        42 {     way. See the new command event. It also allows events (both physical and} \
        43 {     virtual) to be generated dynamically.} \
        43 {     virtual) to be generated dynamically. } \
        44 {} \
        45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
        46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
        47 {should work on these new releases as well.} \
        47 {should work on these new releases as well. } \
        48 {} \
        49 {Obtaining The Releases} \
        50 {} \
        51 {Binary Releases} \
        52 {} \
        53 {Pre-compiled releases are available for the following platforms: } \
        54 {} \
        55 {     Windows 3.1, Windows 95, and Windows NT: Fetch} \
        56 {     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
        57 {     self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
        58 {     tclsh programs, and documentation.} \
        58 {     tclsh programs, and documentation. } \
        59 {     Macintosh (both 68K and PowerPC): Fetch} \
        60 {     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
        61 {     which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
        62 {     unpacked file is a self-installing executable: double-click on it and it will create a} \
        63 {     folder containing all that you need to run Tcl and Tk. } \
        64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
        65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
    }

    set result ""
    set NL "
"
    set tag {level= type=text/plain part=0 sel Charset}
    set ix [lsearch -regexp $tag text/enriched]
    if {$ix < 0} {
	set ranges {}
	set quote 0
    }
    set breakrange {6.42 78.0}
    set F1 [lindex $breakrange 0]
    set F2 [lindex $breakrange 1]
    set breakrange [lrange $breakrange 2 end]
    if {[string length $F1] == 0} {
	set F1 -1
	set break 0
    } else {
	set break 1
    }

    set xmailer 0
    set inheaders 1
    set last [array size lines]
    set plen 2
    for {set L 1} {$L < $last} {incr L} {
	set line $lines($L)
	if {$inheaders} {
	    # Blank or empty line terminates headers
	    # Leading --- terminates headers
	    if {[regexp {^[ 	]*$} $line] || [regexp {^--+} $line]} {
		set inheaders 0
	    }
	    if {[regexp -nocase {^x-mailer:} $line]} {
		continue
	    }
	}
	if $inheaders {
	    set limit 55
	} else {
	    set limit 55

	    # Decide whether or not to break the body line

	    if {$plen > 0} {
		if {[string first {> } $line] == 0} {
		    # This is quoted text from previous message, don't reformat
		    append result $line $NL
		    if {$quote && !$inheaders} {
			# Fix from <sarr@umich.edu> to handle text/enriched
			if {$L > $L1 && $L < $L2 && $line != {}} {
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
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







-
+

















-
+







		}
		continue
	    }
	}
	set climit [expr $limit-1]
	set cutoff 50
	set continuation 0

	
	while {[string length $line] > $limit} {
	    for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
		set char [string index $line $c]
		if {$char == " " || $char == "\t"} {
		    break
		}
		if {$char == ">"} {	;# Hack for enriched formatting
		    break
		}
	    }
	    if {$c < $cutoff} {
		if {! $inheaders} {
		    set c [expr $limit-1]
		} else {
		    set c [string length $line]
		}
	    }
	    set newline [string trimright [string range $line 0 $c]]
	    set newline [string range $line 0 $c]
	    if {! $continuation} {
		append result $newline $NL
	    } else {
		append result \ $newline $NL
	    }
	    incr c
	    set line [string trimright [string range $line $c end]]
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
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







-
+



-
+





-
+

-
+

-
+

-
+


-
-
+
+

-
-
+
+



-
-
+
+


-
+



-
+

-
+

-
+



-
+





-
+



-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+

-
+








This page contains information about Tcl 7.6 and Tk4.2,
 which are the most recent
releases of the Tcl scripting language and the Tk toolk
it. The first beta versions of these
releases were released on August 30, 1996. These releas
es contain only minor changes,
so we hope to have only a single beta release and to
so we hope to have only a single beta release and to 
go final in early October, 1996.


What's new
What's new 

The most important changes in the releases are summariz
ed below. See the README
and changes files in the distributions for more complet
e information on what has
changed, including both feature changes and bug fixes.
changed, including both feature changes and bug fixes. 

     There are new options to the file command for
     There are new options to the file command for 
copying files (file copy),
     deleting files and directories (file delete),
     deleting files and directories (file delete), 
creating directories (file
     mkdir), and renaming files (file rename).
     mkdir), and renaming files (file rename). 
     The implementation of exec has been improved great
ly for Windows 95 and
     Windows NT.
     There is a new memory allocator for the Macintosh
     Windows NT. 
     There is a new memory allocator for the Macintosh 
version, which should be
     more efficient than the old one.
     Tk's grid geometry manager has been completely
     more efficient than the old one. 
     Tk's grid geometry manager has been completely 
rewritten. The layout
     algorithm produces much better layouts than before
, especially where rows or
     columns were stretchable.
     There are new commands for creating common dialog
     columns were stretchable. 
     There are new commands for creating common dialog 
boxes:
     tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
     tk_messageBox. These use native dialog boxes if
     tk_messageBox. These use native dialog boxes if 
they are available.
     There is a new virtual event mechanism for handlin
g events in a more portable
     way. See the new command event. It also allows
     way. See the new command event. It also allows 
events (both physical and
     virtual) to be generated dynamically.
     virtual) to be generated dynamically. 

Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 
7.5 and Tk 4.1 except for
changes in the C APIs for custom channel drivers. Scrip
ts written for earlier releases
should work on these new releases as well.
should work on these new releases as well. 

Obtaining The Releases

Binary Releases

Pre-compiled releases are available for the following
Pre-compiled releases are available for the following 
platforms:

     Windows 3.1, Windows 95, and Windows NT: Fetch
     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
     ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then 
execute it. The file is a
     self-extracting executable. It will install the
     self-extracting executable. It will install the 
Tcl and Tk libraries, the wish and
     tclsh programs, and documentation.
     tclsh programs, and documentation. 
     Macintosh (both 68K and PowerPC): Fetch
     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
     ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. 
The file is in binhex format,
     which is understood by Fetch, StuffIt, and many
     which is understood by Fetch, StuffIt, and many 
other Mac utilities. The
     unpacked file is a self-installing executable:
     unpacked file is a self-installing executable: 
double-click on it and it will create a
     folder containing all that you need to run Tcl
     folder containing all that you need to run Tcl 
and Tk.
        UNIX (Solaris 2.* and SunOS, other systems
        UNIX (Solaris 2.* and SunOS, other systems 
soon to follow). Easy to install
     binary packages are now for sale at the Sun Labs
     binary packages are now for sale at the Sun Labs 
Tcl/Tk Shop. Check it out!
}

# Check that "break" resets the interpreter's result

test for-4.1 {break must reset the interp result} {
    catch {
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
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
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
+












-
+







    1 {invoked "continue" outside of a loop} \
    1 {invoked "break" outside of a loop} \
    1 {invoked "continue" outside of a loop} \
    0 {} \
    1 {invoked "continue" outside of a loop} \
    ]

test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [break] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [continue] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[break] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[continue] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [apply {{} {return -code break}}] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [apply {{} {return -code continue}}] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory {
    apply {{} {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[apply {{} {
		    return -code continue
		}}] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
		    return -code break
		}}] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
		    return -code continue
		}}] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
		    return -code break
		}}] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory {
    apply {{} {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
		    return -code continue
		}}] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [{*}$op] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [{*}$op] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0
test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[{*}$op] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[{*}$op] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0
test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0
test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0

test for-8.0 {Coverity CID 1251203: break vs continue in for-step clause} {
    apply {{} {
	for {set k 0} {$k < 3} {incr k} {
	    set j 0
	    list a [\
	    for {set i 0} {$i < 5} {incr i; list a [eval {}]} {
		incr j
	    }]
	    incr i
	}
	list $i $j $k
    }}
} {6 5 3}
test for-8.1 {Coverity CID 1251203: break vs continue in for-step clause} {
test for-8.1 {Coverity CID 1251203: break vs continue in for-step clause} bug-05489ce335 {
    apply {{} {
	for {set k 0} {$k < 3} {incr k} {
	    set j 0
	    list a [\
	    for {set i 0} {$i < 5} {incr i;list a [eval break]} {
		incr j
	    }]
	    incr i
	}
	list $i $j $k
    }}
} {2 1 3}
test for-8.2 {Coverity CID 1251203: break vs continue in for-step clause} {
test for-8.2 {Coverity CID 1251203: break vs continue in for-step clause} bug-05489ce335 {
    apply {{} {
	for {set k 0} {$k < 3} {incr k} {
	    set j 0
	    list a [\
	    for {set i 0} {$i < 5} {incr i;list a [eval continue]} {
		incr j
	    }]
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
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







-
+












-
+












-
+







		incr j
	    }]
	    incr i
	}
	list $i $j $k
    }}
} {2 1 3}
test for-8.4 {continue in for-step clause} {
test for-8.4 {continue in for-step clause} bug-05489ce335 {
    apply {{} {
	for {set k 0} {$k < 3} {incr k} {
	    set j 0
	    list a [\
	    for {set i 0} {$i < 5} {incr i; continue} {
		incr j
	    }]
	    incr i
	}
	list $i $j $k
    }}
} {1 1 3}
test for-8.5 {break in for-step clause} {
test for-8.5 {break in for-step clause} bug-05489ce335 {
    apply {{} {
	for {set k 0} {$k < 3} {incr k} {
	    set j 0
	    list a [\
	    for {set i 0} {$i < 5} {incr i; list a [break]} {
		incr j
	    }]
	    incr i
	}
	list $i $j $k
    }}
} {2 1 3}
test for-8.6 {continue in for-step clause} {
test for-8.6 {continue in for-step clause} bug-05489ce335 {
    apply {{} {
	for {set k 0} {$k < 3} {incr k} {
	    set j 0
	    list a [\
	    for {set i 0} {$i < 5} {incr i; list a [continue]} {
		incr j
	    }]
1285
1286
1287
1288
1289
1290
1291
1292

1293
1294
1295
1296
1297
1298
1299
913
914
915
916
917
918
919

920
921
922
923
924
925
926
927







-
+







		incr j
	    }]
	    incr i
	}
	list $i $j $k
    }}
} {2 1 3}
test for-8.8 {continue in for-step clause} {
test for-8.8 {continue in for-step clause} bug-05489ce335 {
    apply {{} {
	for {set k 0} {$k < 3} {incr k} {
	    set j 0
	    list a [\
	    for {set i 0} {$i < 5} {incr i;eval continue} {
		incr j
	    }]

Changes to tests/foreach.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14


15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17
18
19
20
21












-
-
+
+







# Commands covered:  foreach, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

catch {unset a}
catch {unset x}

# Basic "foreach" operation.
208
209
210
211
212
213
214
215

216
217
218
219
220
221
222
223
224

225
226
227
228
229
230
231
208
209
210
211
212
213
214

215
216
217
218
219
220
221



222
223
224
225
226
227
228
229







-
+






-
-
-
+







} {a b}
test foreach-6.3 {break tests} {catch {break foo} msg} 1
test foreach-6.4 {break tests} {
    catch {break foo} msg
    set msg
} {wrong # args: should be "break"}
# Check for bug #406709
test foreach-6.5 {break tests} -body {
test foreach-6.5 {break tests} {
    proc a {} {
	set a 1
	foreach b b {list [concat a; break]; incr a}
	incr a
    }
    a
} -cleanup {
    rename a {}
} -result {2}
} {2}

# Test for incorrect "double evaluation" semantics
test foreach-7.1 {delayed substitution of body} {
    proc foo {} {
       set a 0
       foreach a [list 1 2 3] "
           set x $a
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
273
274
275
276
277
278
279









280
281
282

283
284







-
-
-
-
-
-
-
-
-



-


    }
} -body {
    demo
} -cleanup {
    rename demo {}
} -result {}

test foreach-11.1 {error then dereference loop var (dev bug)} {
  catch { foreach a 0 b {1 2 3} { error x } }
  set a
} 0
test foreach-11.2 {error then dereference loop var (dev bug)} {
  catch { foreach a 0 b {1 2 3} { incr a $b; error x } }
  set a
} 1

# cleanup
catch {unset a}
catch {unset x}
catch {rename foo {}}
::tcltest::cleanupTests
return

Changes to tests/format.test.

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
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












-
-
+
+




-
-
-
-
-
+
+
+
+
+
+
+
+
+
+






-
+







# Commands covered:  format
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# %u output depends on word length, so this test is not portable.
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
# MSVC uses a broken libc that gets sprintf("%g") wrong. This is a pain
# particularly in Continuous Integration, and there isn't anything much we can
# do about it.
testConstraint notWinCI [expr {
    ($::tcl_platform(platform) ne "windows") || ![info exists ::env(CI)]}]

test format-1.1 {integer formatting} {
    format "%*d %d %d %d" 6 34 16923 -12 -1
} {    34 16923 -12 -1}
test format-1.2 {integer formatting} {
    format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
} {   6   34 16923  -12 -1 0xe 0xC}
} {   6   34 16923  -12 -1 0xe 0XC}
test format-1.3 {integer formatting} longIs32bit {
    format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} {   6   34 16923 4294967284 -1 0}
test format-1.3.1 {integer formatting} longIs64bit {
    format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} {   6   34 16923 18446744073709551604 -1 0}
test format-1.4 {integer formatting} {
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
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







-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+







test format-1.7 {integer formatting} longIs32bit {
    format "%4x %4x %4x %4x" 6 34 16923 -12 -1
} {   6   22 421b fffffff4}
test format-1.7.1 {integer formatting} longIs64bit {
    format "%4x %4x %4x %4x" 6 34 16923 -12 -1
} {   6   22 421b fffffffffffffff4}
test format-1.8 {integer formatting} longIs32bit {
    format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
} {0 0x6 0x22 0x421B 0xfffffff4}
    format "%#x %#X %#X %#x" 6 34 16923 -12 -1
} {0x6 0X22 0X421B 0xfffffff4}
test format-1.8.1 {integer formatting} longIs64bit {
    format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
} {0 0x6 0x22 0x421B 0xfffffffffffffff4}
    format "%#x %#X %#X %#x" 6 34 16923 -12 -1
} {0x6 0X22 0X421B 0xfffffffffffffff4}
test format-1.9 {integer formatting} longIs32bit {
    format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
} {    0                  0x6                 0x22               0x421b           0xfffffff4}
    format "%#20x %#20x %#20x %#20x" 6 34 16923 -12 -1
} {                 0x6                 0x22               0x421b           0xfffffff4}
test format-1.9.1 {integer formatting} longIs64bit {
    format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
} {    0                  0x6                 0x22               0x421b   0xfffffffffffffff4}
    format "%#20x %#20x %#20x %#20x" 6 34 16923 -12 -1
} {                 0x6                 0x22               0x421b   0xfffffffffffffff4}
test format-1.10 {integer formatting} longIs32bit {
    format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
} {0     0x6                  0x22                 0x421b               0xfffffff4          }
    format "%-#20x %-#20x %-#20x %-#20x" 6 34 16923 -12 -1
} {0x6                  0x22                 0x421b               0xfffffff4          }
test format-1.10.1 {integer formatting} longIs64bit {
    format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
} {0     0x6                  0x22                 0x421b               0xfffffffffffffff4  }
    format "%-#20x %-#20x %-#20x %-#20x" 6 34 16923 -12 -1
} {0x6                  0x22                 0x421b               0xfffffffffffffff4  }
test format-1.11 {integer formatting} longIs32bit {
    format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
} {0     0o6                  0o42                 0o41033              0o37777777764       }
    format "%-#20o %#-20o %#-20o %#-20o" 6 34 16923 -12 -1
} {06                   042                  041033               037777777764        }
test format-1.11.1 {integer formatting} longIs64bit {
    format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
    format "%-#20o %#-20o %#-20o %#-20o" 6 34 16923 -12 -1
} {0     0o6                  0o42                 0o41033              0o1777777777777777777764}
test format-1.12 {integer formatting} {
    format "%b %#b %#b %llb" 5 0 5 [expr {2**100}]
} {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
test format-1.13 {integer formatting} {
    format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1
} {0 6 34 16923 -12}
test format-1.14 {integer formatting} {
    format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1
} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012}
test format-1.15 {integer formatting} {
    format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1
} {00000 00000000000000000006 00000000000000000034 00000000000000016923 -0000000000000000012}

} {06                   042                  041033               01777777777777777777764}

test format-2.1 {string formatting} {
    format "%s %s %c %s" abcd {This is a very long test string.} 120 x
} {abcd This is a very long test string. x x}
test format-2.2 {string formatting} {
    format "%20s %20s %20c %20s" abcd {This is a very long test string.} 120 x
} {                abcd This is a very long test string.                    x                    x}
260
261
262
263
264
265
266
267

268
269
270
271
272
273

274
275
276
277
278
279
280
252
253
254
255
256
257
258

259
260
261
262
263
264

265
266
267
268
269
270
271
272







-
+





-
+








test format-6.1 {floating-point zeroes} {eformat} {
    format "%e %f %g" 0.0 0.0 0.0 0.0
} {0.000000e+00 0.000000 0}
test format-6.2 {floating-point zeroes} {eformat} {
    format "%.4e %.4f %.4g" 0.0 0.0 0.0 0.0
} {0.0000e+00 0.0000 0}
test format-6.3 {floating-point zeroes} {eformat knownMsvcBug} {
test format-6.3 {floating-point zeroes} {eformat notWinCI} {
    format "%#.4e %#.4f %#.4g" 0.0 0.0 0.0 0.0
} {0.0000e+00 0.0000 0.000}
test format-6.4 {floating-point zeroes} {eformat} {
    format "%.0e %.0f %.0g" 0.0 0.0 0.0 0.0
} {0e+00 0 0}
test format-6.5 {floating-point zeroes} {eformat knownMsvcBug} {
test format-6.5 {floating-point zeroes} {eformat notWinCI} {
    format "%#.0e %#.0f %#.0g" 0.0 0.0 0.0 0.0
} {0.e+00 0. 0.}
test format-6.6 {floating-point zeroes} {
    format "%3.0f %3.0f %3.0f %3.0f" 0.0 0.0 0.0 0.0
} {  0   0   0   0}
test format-6.7 {floating-point zeroes} {
    format "%3.0f %3.0f %3.0f %3.0f" 1.0 1.1 1.01 1.001
295
296
297
298
299
300
301
302

303
304
305
306
307
308
309
287
288
289
290
291
292
293

294
295
296
297
298
299
300
301







-
+








test format-8.1 {error conditions} {
    catch format
} 1
test format-8.2 {error conditions} {
    catch format msg
    set msg
} {wrong # args: should be "format formatString ?arg ...?"}
} {wrong # args: should be "format formatString ?arg arg ...?"}
test format-8.3 {error conditions} {
    catch {format %*d}
} 1
test format-8.4 {error conditions} {
    catch {format %*d} msg
    set msg
} {not enough arguments for all format specifiers}
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
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







-
+

-
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    catch {format ab% 12} msg
    set msg
} {format string ended in middle of field specifier}
test format-8.19 {error conditions} {
    catch {format %q x}
} 1
test format-8.20 {error conditions} {
    catch {format %r x} msg
    catch {format %q x} msg
    set msg
} {bad field specifier "r"}
} {bad field specifier "q"}
test format-8.21 {error conditions} {
    catch {format %d}
} 1
test format-8.22 {error conditions} {
    catch {format %d} msg
    set msg
} {not enough arguments for all format specifiers}
test format-8.23 {error conditions} {
    catch {format "%d %d" 24 xyz} msg
    set msg
} {expected integer but got "xyz"}
# Since "%zd" and "%td" are equivalent to "%lld" in 64-bit platforms and
# equivalent to "%d" in 32-bit platforms, they are really not useful in
# scripts, therefore they are not documented. It's intended use is through
# the function Tcl_AppendPrintfToObj (et al).
test format-8.24 {Undocumented formats} -body {
    format "%zd %td %d" [expr 2**30] [expr 2**30] [expr 2**30]
} -result {1073741824 1073741824 1073741824}
test format-8.25 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%zd %td %lld" [expr 2**33] [expr 2**33] [expr 2**33]
} -result {8589934592 8589934592 8589934592}
# Since "%p" is equivalent to "%#llx" in 64-bit platforms and equivalent
# to "%#x" in 32-bit platforms, it are really not useful in scripts,
# therefore they are not documented. It's intended use is through the
# function Tcl_AppendPrintfToObj (et al).
test format-8.26 {Undocumented formats} -body {
    format "%p %#x" [expr 2**31] [expr 2**31]
} -result {0x80000000 0x80000000}
test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body {
    format "%p %#llx" [expr 2**33] [expr 2**33]
} -result {0x200000000 0x200000000}

test format-9.1 {long result} {
    set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    format {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG %s %s} $a $a
} {1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z 1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}

test format-10.1 {"h" format specifier} {
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
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







-
+











-
-
-
-
-
-















-
+





+
-
+
+
+







for {set i 290} {$i < 400} {incr i} {
    test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
        format {%s} $b
    } $b
    append b "x"
}

test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} {
test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
    format %d 7810179016327718216
} 1819043144
test format-17.2 {testing %ld with wide} {wideIs64bit} {
    format %ld 7810179016327718216
} 7810179016327718216
test format-17.3 {testing %ld with non-wide} {wideIs64bit} {
    format %ld 42
} 42
test format-17.4 {testing %l with non-integer} {
    format %lf 1
} 1.000000
test format-17.5 {testing %llu with positive bignum} -body {
    format %llu 0xabcdef0123456789abcdef
} -result 207698809136909011942886895
test format-17.6 {testing %llu with negative number} -body {
    format %llu -1
} -returnCodes 1 -result {unsigned bignum format is invalid}

test format-18.1 {do not demote existing numeric values} {
    set a 0xaaaaaaaa
    # Ensure $a and $b are separate objects
    set b 0xaaaa
    append b aaaa
    set result [expr {$a == $b}]
    format %08lx $b
    lappend result [expr {$a == $b}]
    set b 0xaaaa
    append b aaaa
    lappend result [expr {$a == $b}]
    format %08x $b
    lappend result [expr {$a == $b}]
} {1 1 1 1}
test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} {
test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
    set a [expr {0xaaaaaaaaaa + 1}]
    set b 0xaaaaaaaaab
    list [format %08x $a] [expr {$a == $b}]
} {aaaaaaab 1}

test format-19.1 {
test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
    regression test - tcl-core message by Brian Griffin on
    26 0ctober 2004
} -body {
    set x 0x8fedc654
    list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
test format-19.2 {Bug 1867855} {
    format %llx 0
} 0
test format-19.3 {Bug 2830354} {
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
575
576
577
578
579
580
581











582
583
584
585
586
587
588
589
590
591
592







-
-
-
-
-
-
-
-
-
-
-












test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body {
    # limit should exceeds in any case,
    # and it don't throw an error in case the bug is not fixed (and probably no segfault).
    format %[expr {0xffffffffffffffff - 1}]g 0
} -returnCodes error -result "max size for a Tcl value exceeded"

# Note that this test may fail in future versions
test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
    set x [dict create a b c d]
    format %s $x
    # After this, obj in $x should be a dict
    # We are testing to make sure it has not been shimmered to a
    # different intrep when that is not necessary.
    # Whether or not there is a string rep - we should not care!
    tcl::unsupported::representation $x
} -match glob -result {value is a dict *}

# cleanup
catch {unset a}
catch {unset b}
catch {unset c}
catch {unset d}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/get.test.

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
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












-
-
+
+



-
-
-

-
-
-
-
+
+
+







# Commands covered:  none
#
# This file contains a collection of tests for the procedures in the
# file tclGet.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testgetint [llength [info commands testgetint]]
testConstraint testdoubleobj [llength [info commands testdoubleobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]

test get-1.1 {Tcl_GetInt procedure} testgetint {
    testgetint 44 { 	  22}
} {66}
test get-1.2 {Tcl_GetInt procedure} testgetint {
    testgetint 44 -3
} {41}
test get-1.3 {Tcl_GetInt procedure} testgetint {
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
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







-
-
+
+

-
-
+
+

-
-
+
+











-
+







test get-1.6 {Tcl_GetInt procedure} testgetint {
    list [catch {testgetint 44 {16	 x}} msg] $msg
} {1 {expected integer but got "16	 x"}}
test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint 44 18446744073709551616} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.8 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    testgetint 18446744073709551614
} {-2}
    list [catch {testgetint 18446744073709551614} msg] $msg
} {0 -2}
test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    testgetint +18446744073709551614
} {-2}
    list [catch {testgetint +18446744073709551614} msg] $msg
} {0 -2}
test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} {
    list [catch {testgetint -18446744073709551614} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
    list [catch {testgetint -18446744073709551614} msg] $msg
} {0 2}
test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 44 4294967296} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.12 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint 4294967294} msg] $msg
} {0 -2}
test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint +4294967294} msg] $msg
} {0 -2}
test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
    list [catch {testgetint -4294967294} msg] $msg
} {1 {integer value too large to represent}}
} {0 2}

test get-2.1 {Tcl_GetInt procedure} {
    format %g 1.23
} {1.23}
test get-2.2 {Tcl_GetInt procedure} {
    format %g { 	 1.23 	}
} {1.23}
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
88
89
90
91
92
93
94






95














96
97
98











-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
    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 [catch {format %g $num} msg] $msg
    }
    set result
} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
# Bug 7114ac6141
test get-3.3 {tcl_GetInt with iffy numbers} testgetint {
    lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} {
	catch {testgetint 44 $x} x
	set x
    }

} {44 44 44 44 54 54 52 46}
test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
    lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} {
	catch {testdoubleobj set 1 $x} x
	set x
    }
} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
test get-3.5 {tcl_GetInt with numeric whitespace (i.e. '_')} testgetint {
    lmap x {0_0 " 1_0" "0_2 " " 3_3 " 14__23__32___4 " 0x_a " " 0_07 " " 0o_1_0 " " 0_b1_0 " _33 42_ 0_x15 0_o17 0_d19 } {
	catch {testgetint $x} x
	set x
    }
} {0 10 2 33 1423324 10 7 8 {expected integer but got " 0_b1_0 "} {expected integer but got "_33"} {expected integer but got "42_"} {expected integer but got "0_x15"} {expected integer but got "0_o17"} {expected integer but got "0_d19"}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/history.test.

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
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


-
-
-
+
+
+





-
-
-
-
-
+
+
+
+
+




















-
+







# Commands covered:  history
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# The history command might be autoloaded...
if {[catch {history}]} {
    testConstraint history 0
} else {
    testConstraint history 1
}

if {[testConstraint history]} {
    set num [history nextid]
    history keep 3
    history add {set a 12345}
    history add {set b [format {A test %s} string]}
    history add {Another test}
} else {
    # Dummy value, must be numeric
    set num 0
}


# "history event"

test history-1.1 {event option} history {history event -1} \
	{set b [format {A test %s} string]}
test history-1.2 {event option} history {history event $num} \
	{set a 12345}
test history-1.3 {event option} history {history event [expr $num+2]} \
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
229
230
231
232
233
234
235

236
237
238
239
240
241
242
243
244
245

246
247






















































248
249
250











-










-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
    set num [history n]
    history add "Testing"
    history add "Testing2"
}
test history-8.1 {clear option} history {catch {history clear junk}} 1
test history-8.2 {clear option} history {history clear} {}
if {[testConstraint history]} {
    history clear
    history add "Testing"
}
test history-8.3 {clear option} history {history} {     1  Testing}

# miscellaneous

test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1
test history-9.2 {miscellaneous} history {
    catch {history gorp} msg
    set msg
} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
} {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo}

# History retains references; Bug 1ae12987cb
test history-10.1 {references kept by history} -constraints history -setup {
    interp create histtest
    histtest eval {
	# Trigger any autoloading that might be present
	catch {history}
	proc refcount {x} {
	    set rep [::tcl::unsupported::representation $x]
	    regexp {with a refcount of (\d+)} $rep -> rc
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr rand()]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	history clear
	lappend result [refcount $obj]
    }
} -cleanup {
    interp delete histtest
} -result {1 2 1}
test history-10.2 {references kept by history} -constraints history -setup {
    interp create histtest
    histtest eval {
	# Trigger any autoloading that might be present
	catch {history}
	proc refcount {x} {
	    set rep [::tcl::unsupported::representation $x]
	    regexp {with a refcount of (\d+)} $rep -> rc
	    # Ignore the references due to calling this procedure
	    return [expr {$rc - 3}]
	}
    }
} -body {
    histtest eval {
	# A fresh object, refcount 1 from the variable we write it to
	set obj [expr rand()]
	set baseline [refcount $obj]
	lappend result [refcount $obj]
	history add [list list $obj]
	lappend result [refcount $obj]
	rename history {}
	lappend result [refcount $obj]
    }
} -cleanup {
    interp delete histtest
} -result {1 2 1}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/http.test.

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
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



-
-
+
+





-
-
+
+

-
-
+
+








-
+
















-
-
-
-
-
-
-
+














-
-
-
-
-
-
+
+
+
+
+
+
+
+











-
+

+
+


-
+

-

-
+














-
-
-
-
-
+
+
+
+
+
-
-



-
-
-
+
+
+





-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
-
+




-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+


-
-
-
+





-
+

-
+


-
-

-
-
+
+



-
+


-
-

-
-
+
+



-
+


-
-
-
+



-
-
+
+

-
-
-
+








-
+


-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









+
+
-
-
-
-
+
+
+
+

-
-
+
+
-

-
-
+
+
+

+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+










-

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
+
-

-
-
+
+





+



-
+


-
-
-
+







# Commands covered:  http::config, http::geturl, http::wait, http::reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

if {[catch {package require http 2} version]} {
    if {[info exists http2]} {
	catch {puts "Cannot load http 2.* package"}
	return
    } else {
	catch {puts "Running http 2.* tests in child interp"}
	catch {puts "Running http 2.* tests in slave interp"}
	set interp [interp create http2]
	$interp eval [list set http2 "running"]
	$interp eval [list set argv $argv]
	$interp eval [list source [info script]]
	interp delete $interp
	return
    }
}

proc bgerror {args} {
    global errorInfo
    puts stderr "http.test bgerror"
    puts stderr [join $args]
    puts stderr $errorInfo
}

if {$::tcl_platform(os) eq "Darwin"} {
    # Name resolution often a problem on OSX; not focus of HTTP package anyway
    set HOST localhost
} else {
    set HOST [info hostname]
}

set port 8010
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
catch {unset data}

# Ensure httpd file exists

set origFile [file join [pwd] [file dirname [info script]] httpd]
set httpdFile [file join [temporaryDirectory] httpd_[pid]]
if {![file exists $httpdFile]} {
    makeFile "" $httpdFile
    file delete $httpdFile
    file copy $origFile $httpdFile
    set removeHttpd 1
}

catch {package require Thread 2.7-}
if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
    set httpthread [thread::create -preserved]
    thread::send $httpthread [list source $httpdFile]
    thread::send $httpthread [list set bindata $bindata]
    thread::send $httpthread {httpd_init 0; set port} port
if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
    set httpthread [testthread create -joinable "
	source [list $httpdFile]
	testthread wait
    "]
    testthread send $httpthread [list set port $port]
    testthread send $httpthread [list set bindata $bindata]
    testthread send $httpthread {httpd_init $port}
    puts "Running httpd in thread $httpthread"
} else {
    if {![file exists $httpdFile]} {
	puts "Cannot read $httpdFile script, http test skipped"
	unset port
	return
    }
    source $httpdFile
    # Let the OS pick the port; that's much more flexible
    if {[catch {httpd_init 0} listen]} {
	puts "Cannot start http server, http test skipped"
	catch {unset port}
	unset port
	return
    } else {
	set port [lindex [fconfigure $listen -sockname] 2]
    }
}


test http-1.1 {http::config} {
    http::config -useragent UserAgent
    http::config
} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"]
test http-1.2 {http::config} {
    http::config -proxyfilter
} http::ProxyRequired
test http-1.3 {http::config} {
    catch {http::config -junk}
} 1
test http-1.4 {http::config} {
    set savedconf [http::config]
    http::config -proxyhost nowhere.come -proxyport 8080 \
	-proxyfilter myFilter -useragent "Tcl Test Suite" \
	-urlencoding iso8859-1
    set x [http::config]
    http::config {*}$savedconf
    set x
} {-accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
test http-1.5 {http::config} -returnCodes error -body {
    http::config -proxyhost {} -junk 8080
} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
test http-1.6 {http::config} -setup {
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
test http-1.5 {http::config} {
    list [catch {http::config -proxyhost {} -junk 8080} msg] $msg
} {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}}
test http-1.6 {http::config} {
    set oldenc [http::config -urlencoding]
} -body {
    set enc [list [http::config -urlencoding]]
    http::config -urlencoding iso8859-1
    lappend enc [http::config -urlencoding]
} -cleanup {
    http::config -urlencoding $oldenc
} -result {utf-8 iso8859-1}
    http::config -urlencoding [lindex $enc 0]
    set enc
} {utf-8 iso8859-1}

test http-2.1 {http::reset} {
    catch {http::reset http#1}
} 0

test http-3.1 {http::geturl} -returnCodes error -body {
    http::geturl -bogus flag
} -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
test http-3.2 {http::geturl} -returnCodes error -body {
    http::geturl http:junk
} -result {Unsupported URL: http:junk}
set url //${::HOST}:$port
set badurl //${::HOST}:[expr $port+1]
test http-3.3 {http::geturl} -body {
test http-3.1 {http::geturl} {
    list [catch {http::geturl -bogus flag} msg] $msg
} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}}
test http-3.2 {http::geturl} {
    catch {http::geturl http:junk} err
    set err
} {Unsupported URL: http:junk}
set url //[info hostname]:$port
set badurl //[info hostname]:[expr $port+1]
test http-3.3 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET /</h2>
</body></html>"
set tail /a/b/c
set url //${::HOST}:$port/a/b/c
set fullurl HTTP://user:pass@${::HOST}:$port/a/b/c
set binurl //${::HOST}:$port/binary
set xmlurl //${::HOST}:$port/xml
set posturl //${::HOST}:$port/post
set badposturl //${::HOST}:$port/droppost
set authorityurl //${::HOST}:$port
set url //[info hostname]:$port/a/b/c
set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set xmlurl //[info hostname]:$port/xml
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
set authorityurl //[info hostname]:$port
set ipv6url http://\[::1\]:$port/
test http-3.4 {http::geturl} -body {
test http-3.4 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
proc selfproxy {host} {
    global port
    return [list ${::HOST} $port]
    return [list [info hostname] $port]
}
test http-3.5 {http::geturl} -body {
test http-3.5 {http::geturl} {
    http::config -proxyfilter selfproxy
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::config -proxyfilter http::ProxyRequired
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
    http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http:$url</h2>
</body></html>"
test http-3.6 {http::geturl} -body {
test http-3.6 {http::geturl} {
    http::config -proxyfilter bogus
    set token [http::geturl $url]
    http::data $token
} -cleanup {
    http::config -proxyfilter http::ProxyRequired
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
    http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
test http-3.7 {http::geturl} -body {
test http-3.7 {http::geturl} {
    set token [http::geturl $url -headers {Pragma no-cache}]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
test http-3.8 {http::geturl} -body {
    set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 3000]
test http-3.8 {http::geturl} {
    set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]
    http::data $token
} -cleanup {
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>POST $tail</h2>
<h2>Query</h2>
<dl>
<dt>Name<dd>Value
<dt>Foo<dd>Bar
</dl>
</body></html>"
test http-3.9 {http::geturl} -body {
test http-3.9 {http::geturl} {
    set token [http::geturl $url -validate 1]
    http::code $token
} -cleanup {
    http::cleanup $token
} -result "HTTP/1.0 200 OK"
test http-3.10 {http::geturl queryprogress} -setup {
} "HTTP/1.0 200 OK"
test http-3.10 {http::geturl queryprogress} {
    set query foo=bar
    set sep ""
    set i 0
    # Create about 120K of query data
    while {$i < 14} {
	incr i
	append query $sep$query
	set sep &
    }

    proc postProgress {token x y} {
	global postProgress
	lappend postProgress $y
    }
    set postProgress {}
    set t [http::geturl $posturl -keepalive 0 -query $query \
	    -queryprogress postProgress -queryblocksize 16384]
    http::wait $t
    list [http::status $t] [string length $query] $postProgress [http::data $t]
} {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
test http-3.11 {http::geturl querychannel with -command} {
    set query foo=bar
    set sep ""
    set i 0
    # Create about 120K of query data
    while {$i < 14} {
	incr i
	append query $sep$query
	set sep &
    }
    set file [makeFile $query outdata]
    set fp [open $file]
} -body {
    proc postProgress {token x y} {
	global postProgress
	lappend postProgress $y

    proc asyncCB {token} {
	global postResult
	lappend postResult [http::data $token]
    }
    set postProgress {}
    set t [http::geturl $posturl -keepalive 0 -query $query \
    set postResult [list ]
    set t [http::geturl $posturl -querychannel $fp]
	    -queryprogress postProgress -queryblocksize 16384]
    http::wait $t
    list [http::status $t] [string length $query] $postProgress [http::data $t]
} -cleanup {
    set testRes [list [http::status $t] [string length $query] [http::data $t]]

    # Now do async
    http::cleanup $t
    close $fp
    set fp [open $file]
    set t [http::geturl $posturl -querychannel $fp -command asyncCB]
    set postResult [list PostStart]
    http::wait $t
    close $fp
} -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
test http-3.11 {http::geturl querychannel with -command} -setup {

    lappend testRes [http::status $t] $postResult
    removeFile outdata
    set testRes
} {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
# On Linux platforms when the client and server are on the same host, the
# client is unable to read the server's response one it hits the write error.
# The status is "eof".
# On Windows, the http::wait procedure gets a "connection reset by peer" error
# while reading the reply.
test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
    set query foo=bar
    set sep ""
    set i 0
    # Create about 120K of query data
    while {$i < 14} {
	incr i
	append query $sep$query
	set sep &
    }
    set file [makeFile $query outdata]
} -body {
    set fp [open $file]
    proc asyncCB {token} {
	global postResult
	lappend postResult [http::data $token]
    }

    set postResult [list ]
    set t [http::geturl $posturl -querychannel $fp]
    http::wait $t
    set testRes [list [http::status $t] [string length $query] [http::data $t]]
    # Now do async
    http::cleanup $t
    close $fp
    set fp [open $file]
    set t [http::geturl $posturl -querychannel $fp -command asyncCB]
    set postResult [list PostStart]
    http::wait $t
    close $fp
    lappend testRes [http::status $t] $postResult
} -cleanup {
    removeFile outdata
    http::cleanup $t
} -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
# On Linux platforms when the client and server are on the same host, the
# client is unable to read the server's response one it hits the write error.
# The status is "eof".
# On Windows, the http::wait procedure gets a "connection reset by peer" error
# while reading the reply.
test http-3.12 {http::geturl querychannel with aborted request} -setup {
    set query foo=bar
    set sep ""
    set i 0
    # Create about 120K of query data
    while {$i < 14} {
	incr i
	append query $sep$query
	set sep &
    }
    set file [makeFile $query outdata]
} -constraints {nonPortable} -body {
    set fp [open $file]
    proc asyncCB {token} {
	global postResult
	lappend postResult [http::data $token]
    }
    proc postProgress {token x y} {
	global postProgress
	lappend postProgress $y
    }
    set postProgress {}
    # Now do async
    set postResult [list PostStart]
    if {[catch {
	set t [http::geturl $badposturl -querychannel $fp -command asyncCB \
		-queryprogress postProgress]
	http::wait $t
	upvar #0 $t state
    } err]} {
	puts $::errorInfo
	error $err
    }
    list [http::status $t] [http::code $t]

} -cleanup {
    removeFile outdata
    http::cleanup $t
} -result {ok {HTTP/1.0 200 Data follows}}
    list [http::status $t] [http::code $t]
} {ok {HTTP/1.0 200 Data follows}}
test http-3.13 {http::geturl socket leak test} {
    set chanCount [llength [file channels]]
    for {set i 0} {$i < 3} {incr i} {
	catch {http::geturl $badurl -timeout 5000}
    }

    # No extra channels should be taken
    expr {[llength [file channels]] == $chanCount}
} 1
test http-3.14 "http::geturl $fullurl" -body {
test http-3.14 "http::geturl $fullurl" {
    set token [http::geturl $fullurl -validate 1]
    http::code $token
} -cleanup {
    http::cleanup $token
} -result "HTTP/1.0 200 OK"
} "HTTP/1.0 200 OK"
test http-3.15 {http::geturl parse failures} -body {
    http::geturl "{invalid}:url"
} -returnCodes error -result {Unsupported URL: {invalid}:url}
test http-3.16 {http::geturl parse failures} -body {
    http::geturl http:relative/url
} -returnCodes error -result {Unsupported URL: http:relative/url}
test http-3.17 {http::geturl parse failures} -body {
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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

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
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
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
1140
1141
1142
1143
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
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




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











-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+





-
+
+



-
-

-
+





-
+
+



-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+





-
-
-

-
+




-
+
-
-
-
+




-
+
-
-
-
+


-
-
-
-
+
+

-





-
-
+
-

-
-
+
+



-
+

-





+

-
+
-
-
-
-
+

-





-
+
-
-
+
-

-
-
+
+







+
+
+
-
-
-
-
-
+
+
+
+
+
+

-
+
-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
-
+
+


-
-
-
+



-
-
+
+


-
-
-
+

-
-
+
+


-
-
-
+


-
-
+
+


-
-
-
+









-
-





-
+



-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-



















-
-
+
+


+


-
-
-
-
+












-
+

-


-
+
-

+
-
-
+
+

-



-
+
-

-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






+
+
+
-
+










-
-
-
-
test http-3.21 {http::geturl parse failures} -body {
    http::geturl http://somewhere/{path}
} -returnCodes error -result {Illegal characters in URL path}
test http-3.22 {http::geturl parse failures} -body {
    http::geturl http://somewhere/%path
} -returnCodes error -result {Illegal encoding character usage "%pa" in URL path}
test http-3.23 {http::geturl parse failures} -body {
    http::geturl http://somewhere/path?{query}?
    http::geturl http://somewhere/path?{query}
} -returnCodes error -result {Illegal characters in URL path}
test http-3.24 {http::geturl parse failures} -body {
    http::geturl http://somewhere/path?%query
} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path}
test http-3.25 {http::meta} -setup {
    unset -nocomplain m token
} -body {
    set token [http::geturl $url -timeout 3000]
    array set m [http::meta $token]
    lsort [array names m]
} -cleanup {
    http::cleanup $token
    unset -nocomplain m token
} -result {Content-Length Content-Type Date}
test http-3.26 {http::meta} -setup {
    unset -nocomplain m token
} -body {
    set token [http::geturl $url -headers {X-Check 1} -timeout 3000]
    array set m [http::meta $token]
    lsort [array names m]
} -cleanup {
    http::cleanup $token
    unset -nocomplain m token
} -result {Content-Length Content-Type Date X-Check}
test http-3.27 {http::geturl: -headers override -type} -body {
test http-3.25 {http::geturl: -headers override -type} -body {
    set token [http::geturl $url/headers -type "text/plain" -query dummy \
	    -headers [list "Content-Type" "text/plain;charset=utf-8"]]
    http::data $token
} -cleanup {
    http::cleanup $token
} -match regexp -result {(?n)Host .*
} -match regexp -result {(?n)Accept \*/\*
Host .*
User-Agent .*
Connection close
Content-Type {text/plain;charset=utf-8}
Accept \*/\*
Accept-Encoding .*
Content-Length 5}
test http-3.28 {http::geturl: -headers override -type default} -body {
test http-3.26 {http::geturl: -headers override -type default} -body {
    set token [http::geturl $url/headers -query dummy \
	    -headers [list "Content-Type" "text/plain;charset=utf-8"]]
    http::data $token
} -cleanup {
    http::cleanup $token
} -match regexp -result {(?n)Host .*
} -match regexp -result {(?n)Accept \*/\*
Host .*
User-Agent .*
Connection close
Content-Type {text/plain;charset=utf-8}
Accept \*/\*
Accept-Encoding .*
Content-Length 5}
test http-3.29 {http::geturl IPv6 address} -body {
    # We only want to see if the URL gets parsed correctly. This is
    # the case if http::geturl succeeds or returns a socket related
    # error. If the parsing is wrong, we'll get a parse error.
    # It'd be better to separate the URL parser from http::geturl, so
    # that it can be tested without also trying to make a connection.
    set error [catch {http::geturl $ipv6url -validate 1} token]
    if {$error && [string match "couldn't open socket: *" $token]} {
            set error 0
    }
    set error
} -cleanup {
    catch { http::cleanup $token }
} -result 0
test http-3.30 {http::geturl query without path} -body {
    set token [http::geturl $authorityurl?var=val]
    http::ncode $token
} -cleanup {
    catch { http::cleanup $token }
} -result 200
test http-3.31 {http::geturl fragment without path} -body {
    set token [http::geturl "$authorityurl#fragment42"]
    http::ncode $token
} -cleanup {
    catch { http::cleanup $token }
} -result 200
# Bug c11a51c482
test http-3.32 {http::geturl: -headers override -accept default} -body {
    set token [http::geturl $url/headers -query dummy \
	    -headers [list "Accept" "text/plain,application/tcl-test-value"]]
    http::data $token
} -cleanup {
    http::cleanup $token
} -match regexp -result {(?n)Host .*
User-Agent .*
Connection close
Accept text/plain,application/tcl-test-value
Accept-Encoding .*
Content-Type application/x-www-form-urlencoded
Content-Length 5}
# Bug 838e99a76d
test http-3.33 {http::geturl application/xml is text} -body {
test http-3.32 {http::geturl application/xml is text} -body {
    set token [http::geturl "$xmlurl"]
    scan [http::data $token] "<%\[^>]>%c<%\[^>]>"
} -cleanup {
    catch { http::cleanup $token }
} -result {test 4660 /test}
test http-3.34 {http::geturl -headers not a dict} -returnCodes error -body {
    http::geturl http://test/t -headers NoDict
} -result {Bad value for -headers (NoDict), must be dict}

test http-4.1 {http::Event} -body {
test http-4.1 {http::Event} {
    set token [http::geturl $url -keepalive 0]
    upvar #0 $token data
    array set meta $data(meta)
    expr {($data(totalsize) == $meta(Content-Length))}
} -cleanup {
} 1
    http::cleanup $token
} -result 1
test http-4.2 {http::Event} -body {
test http-4.2 {http::Event} {
    set token [http::geturl $url]
    upvar #0 $token data
    array set meta $data(meta)
    string compare $data(type) [string trim $meta(Content-Type)]
} -cleanup {
} 0
    http::cleanup $token
} -result 0
test http-4.3 {http::Event} -body {
test http-4.3 {http::Event} {
    set token [http::geturl $url]
    http::code $token
} -cleanup {
    http::cleanup $token
} -result {HTTP/1.0 200 Data follows}
test http-4.4 {http::Event} -setup {
} {HTTP/1.0 200 Data follows}
test http-4.4 {http::Event} {
    set testfile [makeFile "" testfile]
} -body {
    set out [open $testfile w]
    set token [http::geturl $url -channel $out]
    close $out
    set in [open $testfile]
    set x [read $in]
} -cleanup {
    catch {close $in}
    close $in
    catch {close $out}
    removeFile $testfile
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
    set x
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"
test http-4.5 {http::Event} -setup {
test http-4.5 {http::Event} {
    set testfile [makeFile "" testfile]
} -body {
    set out [open $testfile w]
    fconfigure $out -translation lf
    set token [http::geturl $url -channel $out]
    close $out
    upvar #0 $token data
    removeFile $testfile
    expr {$data(currentsize) == $data(totalsize)}
} -cleanup {
} 1
    removeFile $testfile
    http::cleanup $token
} -result 1
test http-4.6 {http::Event} -setup {
test http-4.6 {http::Event} {
    set testfile [makeFile "" testfile]
} -body {
    set out [open $testfile w]
    set token [http::geturl $binurl -channel $out]
    close $out
    set in [open $testfile]
    fconfigure $in -translation binary
    read $in
    set x [read $in]
} -cleanup {
    catch {close $in}
    close $in
    catch {close $out}
    removeFile $testfile
    http::cleanup $token
} -result "$bindata[string trimleft $binurl /]"
    set x
} "$bindata[string trimleft $binurl /]"
proc myProgress {token total current} {
    global progress httpLog
    if {[info exists httpLog] && $httpLog} {
	puts "progress $total $current"
    }
    set progress [list $total $current]
}
if 0 {
    # This test hangs on Windows95 because the client never gets EOF
    set httpLog 1
test http-4.6.1 {http::Event} knownBug {
    set token [http::geturl $url -blocksize 50 -progress myProgress]
    return $progress
} {111 111}
test http-4.7 {http::Event} -body {
    test http-4.6.1 {http::Event} knownBug {
	set token [http::geturl $url -blocksize 50 -progress myProgress]
	set progress
    } {111 111}
}
test http-4.7 {http::Event} {
    set token [http::geturl $url -keepalive 0 -progress myProgress]
    return $progress
    set progress
} -cleanup {
    http::cleanup $token
} -result {111 111}
test http-4.8 {http::Event} -body {
} {111 111}
test http-4.8 {http::Event} {
    set token [http::geturl $url]
    http::status $token
} -cleanup {
    http::cleanup $token
} -result {ok}
test http-4.9 {http::Event} -body {
} {ok}
test http-4.9 {http::Event} {
    set token [http::geturl $url -progress myProgress]
    http::code $token
} -cleanup {
    http::cleanup $token
} -result {HTTP/1.0 200 Data follows}
test http-4.10 {http::Event} -body {
} {HTTP/1.0 200 Data follows}
test http-4.10 {http::Event} {
    set token [http::geturl $url -progress myProgress]
    http::size $token
} -cleanup {
    http::cleanup $token
} -result {111}
} {111}
# Timeout cases
#	Short timeout to working server (the test server). This lets us try a
#	reset during the connection.
test http-4.11 {http::Event} -body {
    set token [http::geturl $url -timeout 1 -keepalive 0 -command \#]
test http-4.11 {http::Event} {
    set token [http::geturl $url -timeout 1 -keepalive 0 -command {#}]
    http::reset $token
    http::status $token
} -cleanup {
    http::cleanup $token
} -result {reset}
} {reset}
#	Longer timeout with reset.
test http-4.12 {http::Event} -body {
    set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#]
test http-4.12 {http::Event} {
    set token [http::geturl $url/?timeout=10 -keepalive 0 -command {#}]
    http::reset $token
    http::status $token
} -cleanup {
    http::cleanup $token
} -result {reset}
} {reset}
#	Medium timeout to working server that waits even longer. The timeout
#	hits while waiting for a reply.
test http-4.13 {http::Event} -body {
    set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#]
test http-4.13 {http::Event} {
    set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command {#}]
    http::wait $token
    http::status $token
} -cleanup {
    http::cleanup $token
} -result {timeout}
} {timeout}
#	Longer timeout to good host, bad port, gets an error after the
#	connection "completes" but the socket is bad.
test http-4.14 {http::Event} -body {
    set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#]
    if {$token eq ""} {
	error "bogus return from http::geturl"
    }
    http::wait $token
    lindex [http::error $token] 0
} -cleanup {
    catch {http::cleanup $token}
} -result {connect failed connection refused}
# Bogus host
test http-4.15 {http::Event} -body {
    # This test may fail if you use a proxy server. That is to be
    # expected and is not a problem with Tcl.
    set token [http::geturl //not_a_host.tcl.tk -timeout 3000 -command \#]
    set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#]
    http::wait $token
    http::status $token
    # error codes vary among platforms.
} -cleanup {
    catch {http::cleanup $token}
} -returnCodes 1 -match glob -result "couldn't open socket*"
test http-4.16 {Leak with Close vs Keepalive (bug [6ca52aec14]} -setup {
    proc list-difference {l1 l2} {
	lmap item $l2 {if {$item in $l1} continue; set item}
    }
} -body {
    set before [chan names]
    set token [http::geturl $url -headers {X-Connection keep-alive}]
    http::cleanup $token
    update
    # Compute what channels have been unexpectedly leaked past cleanup
    list-difference $before [chan names]
} -cleanup {
    rename list-difference {}
} -result {}

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 ${::HOST} -proxyport $port
test http-6.1 {http::ProxyRequired} {
    http::config -proxyhost [info hostname] -proxyport $port
    set token [http::geturl $url]
    http::wait $token
    http::config -proxyhost {} -proxyport {}
    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>
} "<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 {
test http-7.3 {http::formatQuery} {
    set enc [http::config -urlencoding]
} -returnCodes error -body {
    # this would be reverting to http <=2.4 behavior
    http::config -urlencoding ""
    http::mapReply "\u2208"
    set res [list [catch {http::mapReply "\u2208"} msg] $msg]
} -cleanup {
    http::config -urlencoding $enc
    set res
} -result "can't read \"formMap(\u2208)\": no such element in array"
test http-7.4 {http::formatQuery} -setup {
} [list 1 "can't read \"formMap(\u2208)\": no such element in array"]
test http-7.4 {http::formatQuery} {
    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"
    set res [http::mapReply "\u2208"]
} -cleanup {
    http::config -urlencoding $enc
} -result {%3F}

    set res
package require tcl::idna 1.0

test http-idna-1.1 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna
} -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"}
test http-idna-1.2 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna ?
} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version}
test http-idna-1.3 {IDNA package: basics} -body {
    ::tcl::idna version
} -result 1.0.1
test http-idna-1.4 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna version what
} -result {wrong # args: should be "::tcl::idna version"}
test http-idna-1.5 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny
} -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"}
test http-idna-1.6 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny ?
} -result {unknown or ambiguous subcommand "?": must be decode, or encode}
test http-idna-1.7 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny encode
} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
test http-idna-1.8 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny encode a b c
} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
test http-idna-1.9 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny decode
} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
test http-idna-1.10 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna puny decode a b c
} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
test http-idna-1.11 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna decode
} -result {wrong # args: should be "::tcl::idna decode hostname"}
test http-idna-1.12 {IDNA package: basics} -returnCodes error -body {
    ::tcl::idna encode
} -result {wrong # args: should be "::tcl::idna encode hostname"}

test http-idna-2.1 {puny encode: functional test} {
    ::tcl::idna puny encode abc
} abc-
test http-idna-2.2 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20acb\u20acc
} abc-k50ab
test http-idna-2.3 {puny encode: functional test} {
    ::tcl::idna puny encode ABC
} ABC-
test http-idna-2.4 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC
} ABC-k50ab
test http-idna-2.5 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 0
} abc-
test http-idna-2.6 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC 0
} abc-k50ab
test http-idna-2.7 {puny encode: functional test} {
    ::tcl::idna puny encode ABC 1
} ABC-
test http-idna-2.8 {puny encode: functional test} {
    ::tcl::idna puny encode A\u20ACB\u20ACC 1
} ABC-k50ab
test http-idna-2.9 {puny encode: functional test} {
    ::tcl::idna puny encode abc 0
} abc-
test http-idna-2.10 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20ACb\u20ACc 0
} abc-k50ab
test http-idna-2.11 {puny encode: functional test} {
    ::tcl::idna puny encode abc 1
} ABC-
test http-idna-2.12 {puny encode: functional test} {
    ::tcl::idna puny encode a\u20ACb\u20ACc 1
} ABC-k50ab
test http-idna-2.13 {puny encode: edge cases} {
    ::tcl::idna puny encode ""
} ""
} {%3F}
test http-idna-2.14-A {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
	u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
    }]] ""]
} egbpdaj6bu4bxfgehfvwxn
test http-idna-2.14-B {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587
    }]] ""]
} ihqwcrb4cv8a8dqg056pqjye
test http-idna-2.14-C {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587
    }]] ""]
} ihqwctvzc91f659drss3x8bo0yb
test http-idna-2.14-D {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
	u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
	u+0065 u+0073 u+006B u+0079
    }]] ""]
} Proprostnemluvesky-uyb24dma41a
test http-idna-2.14-E {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
	u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
	u+05D1 u+05E8 u+05D9 u+05EA
    }]] ""]
} 4dbcagdahymbxekheh6e0a7fei0b
test http-idna-2.14-F {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
	u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
	u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
	u+0939 u+0948 u+0902
    }]] ""]
} i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd
test http-idna-2.14-G {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
	u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
    }]] ""]
} n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa
test http-idna-2.14-H {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
	u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
	u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
    }]] ""]
} 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c
test http-idna-2.14-I {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
	u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
	u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
	u+0438
    }]] ""]
} b1abfaaepdrnnbgefbadotcwatmq2g4l
test http-idna-2.14-J {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
	u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
	u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
	u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
	u+0061 u+00F1 u+006F u+006C
    }]] ""]
} PorqunopuedensimplementehablarenEspaol-fmd56a
test http-idna-2.14-K {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
	u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
	u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
	u+0056 u+0069 u+1EC7 u+0074
    }]] ""]
} TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g
test http-idna-2.14-L {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F
    }]] ""]
} 3B-ww4c5e180e575a65lsy2b
test http-idna-2.14-M {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
	u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
	u+004F u+004E u+004B u+0045 u+0059 u+0053
    }]] ""]
} -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n
test http-idna-2.14-N {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
	u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
	u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
    }]] ""]
} Hello-Another-Way--fc4qua05auwb3674vfr0b
test http-idna-2.14-O {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032
    }]] ""]
} 2-u9tlzr9756bt3uc0v
test http-idna-2.14-P {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
	u+308B u+0035 u+79D2 u+524D
    }]] ""]
} MajiKoi5-783gue6qz075azm5e
test http-idna-2.14-Q {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0
    }]] ""]
} de-jg4avhby1noc0d
test http-idna-2.14-R {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
	u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067
    }]] ""]
} d9juau41awczczp
test http-idna-2.14-S {puny encode: examples from RFC 3492} {
    ::tcl::idna puny encode {-> $1.00 <-}
} {-> $1.00 <--}

test http-idna-3.1 {puny decode: functional test} {
    ::tcl::idna puny decode abc-
} abc
test http-idna-3.2 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab
} a\u20acb\u20acc
test http-idna-3.3 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-
} ABC
test http-idna-3.4 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-k50ab
} A\u20ACB\u20ACC
test http-idna-3.5 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB
} A\u20ACB\u20ACC
test http-idna-3.6 {puny decode: functional test} {
    ::tcl::idna puny decode abc-K50AB
} a\u20ACb\u20ACc
test http-idna-3.7 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 0
} abc
test http-idna-3.8 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 0
} a\u20ACb\u20ACc
test http-idna-3.9 {puny decode: functional test} {
    ::tcl::idna puny decode ABC- 1
} ABC
test http-idna-3.10 {puny decode: functional test} {
    ::tcl::idna puny decode ABC-K50AB 1
} A\u20ACB\u20ACC
test http-idna-3.11 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 0
} abc
test http-idna-3.12 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 0
} a\u20ACb\u20ACc
test http-idna-3.13 {puny decode: functional test} {
    ::tcl::idna puny decode abc- 1
} ABC
test http-idna-3.14 {puny decode: functional test} {
    ::tcl::idna puny decode abc-k50ab 1
} A\u20ACB\u20ACC
test http-idna-3.15 {puny decode: edge cases and errors} {
    # Is this case actually correct?
    binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]]
} c282c281c280
test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body {
    ::tcl::idna puny decode abc!
} -result {bad decode character "!"}
test http-idna-3.17 {puny decode: edge cases and errors} {
    catch {::tcl::idna puny decode abc!} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT CHAR}
test http-idna-3.18 {puny decode: edge cases and errors} {
    ::tcl::idna puny decode ""
} {}
# A helper so we don't get lots of crap in failures
proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}}
test http-idna-3.19-A {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn]
} [list {*}{
    u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
    u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
}]
test http-idna-3.19-B {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye]
} {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587}
test http-idna-3.19-C {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb]
} {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587}
test http-idna-3.19-D {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a]
} [list {*}{
    u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
    u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
    u+0065 u+0073 u+006B u+0079
}]
test http-idna-3.19-E {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b]
} [list {*}{
    u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
    u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
    u+05D1 u+05E8 u+05D9 u+05EA
}]
test http-idna-3.19-F {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd]
} [list {*}{
    u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
    u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
    u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
    u+0939 u+0948 u+0902
}]
test http-idna-3.19-G {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa]
} [list {*}{
    u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
    u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
}]
test http-idna-3.19-H {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c]
} [list {*}{
    u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
    u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
    u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
}]
test http-idna-3.19-I {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l]
} [list {*}{
    u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
    u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
    u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
    u+0438
}]
test http-idna-3.19-J {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	PorqunopuedensimplementehablarenEspaol-fmd56a]
} [list {*}{
    u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
    u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
    u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
    u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
    u+0061 u+00F1 u+006F u+006C
}]
test http-idna-3.19-K {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode \
	TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g]
} [list {*}{
    u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
    u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
    u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
    u+0056 u+0069 u+1EC7 u+0074
}]
test http-idna-3.19-L {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b]
} {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F}
test http-idna-3.19-M {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n]
} [list {*}{
    u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
    u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
    u+004F u+004E u+004B u+0045 u+0059 u+0053
}]
test http-idna-3.19-N {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b]
} [list {*}{
    u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
    u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
    u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
}]
test http-idna-3.19-O {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v]
} {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032}
test http-idna-3.19-P {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e]
} [list {*}{
    u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
    u+308B u+0035 u+79D2 u+524D
}]
test http-idna-3.19-Q {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode de-jg4avhby1noc0d]
} {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0}
test http-idna-3.19-R {puny decode: examples from RFC 3492} {
    hexify [::tcl::idna puny decode d9juau41awczczp]
} {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067}
test http-idna-3.19-S {puny decode: examples from RFC 3492} {
    ::tcl::idna puny decode {-> $1.00 <--}
} {-> $1.00 <-}
rename hexify ""

test http-idna-4.1 {IDNA encoding} {
    ::tcl::idna encode abc.def
} abc.def
test http-idna-4.2 {IDNA encoding} {
    ::tcl::idna encode a\u20acb\u20acc.def
} xn--abc-k50ab.def
test http-idna-4.3 {IDNA encoding} {
    ::tcl::idna encode def.a\u20acb\u20acc
} def.xn--abc-k50ab
test http-idna-4.4 {IDNA encoding} {
    ::tcl::idna encode ABC.DEF
} ABC.DEF
test http-idna-4.5 {IDNA encoding} {
    ::tcl::idna encode A\u20acB\u20acC.def
} xn--ABC-k50ab.def
test http-idna-4.6 {IDNA encoding: invalid edge case} {
    # Should this be an error?
    ::tcl::idna encode abc..def
} abc..def
test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body {
    ::tcl::idna encode abc.$.def
} -result {bad character "$" in DNS name}
test http-idna-4.7.1 {IDNA encoding: invalid char} {
    catch {::tcl::idna encode abc.$.def} -> opt
    dict get $opt -errorcode
} {IDNA INVALID_NAME_CHARACTER {$}}
test http-idna-4.8 {IDNA encoding: empty} {
    ::tcl::idna encode ""
} {}
set overlong www.[join [subst [string map {u+ \\u} {
    u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
    u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
    u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
}]] ""].com
test http-idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body {
    ::tcl::idna encode $overlong
} -returnCodes error -result "hostname part too long"
test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} {
    catch {::tcl::idna encode $overlong} -> opt
    dict get $opt -errorcode
} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c}
unset overlong
test http-idna-4.10 {IDNA encoding: edge cases} {
    ::tcl::idna encode pass\u00e9.example.com
} xn--pass-epa.example.com

test http-idna-5.1 {IDNA decoding} {
    ::tcl::idna decode abc.def
} abc.def
test http-idna-5.2 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode xn--abc-.def
} abc.def
test http-idna-5.3 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode xn--abc-.xn--def-
} abc.def
test http-idna-5.4 {IDNA decoding} {
    # Invalid entry that's just a wrapper
    ::tcl::idna decode XN--abc-.XN--def-
} abc.def
test http-idna-5.5 {IDNA decoding: error cases} -returnCodes error -body {
    ::tcl::idna decode xn--$$$.example.com
} -result {bad decode character "$"}
test http-idna-5.5.1 {IDNA decoding: error cases} {
    catch {::tcl::idna decode xn--$$$.example.com} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT CHAR}
test http-idna-5.6 {IDNA decoding: error cases} -returnCodes error -body {
    ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def
} -result {exceeded input data}
test http-idna-5.6.1 {IDNA decoding: error cases} {
    catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt
    dict get $opt -errorcode
} {PUNYCODE BAD_INPUT LENGTH}

# cleanup
catch {unset url}
catch {unset badurl}
catch {unset port}
catch {unset data}
if {[info exists httpthread]} {
    testthread send -async $httpthread {
	testthread exit
    }
    thread::release $httpthread
    testthread join $httpthread
} else {
    close $listen
}

if {[info exists removeHttpd]} {
    removeFile $httpdFile
}

rename bgerror {}
::tcltest::cleanupTests

# Local variables:
# mode: tcl
# End:

Deleted tests/http11.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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



























































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# http11.test --                                                -*- tcl-*-
#
#	Test HTTP/1.1 features.
#
# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require http 2.9

# start the server
variable httpd_output
proc create_httpd {} {
    proc httpd_read {chan} {
        variable httpd_output
        if {[gets $chan line] >= 0} {
            #puts stderr "read '$line'"
            set httpd_output $line
        }
        if {[eof $chan]} {
            puts stderr "eof from httpd"
            fileevent $chan readable {}
            close $chan
        }
    }
    variable httpd_output
    set httpd_script [file join [pwd] [file dirname [info script]] httpd11.tcl]
    set httpd [open "|[list [interpreter] -encoding utf-8 $httpd_script]" r+]
    fconfigure $httpd -buffering line -blocking 0
    fileevent $httpd readable [list httpd_read $httpd]
    vwait httpd_output
    variable httpd_port [lindex $httpd_output 2]
    return $httpd
}

proc halt_httpd {} {
    variable httpd_output
    variable httpd
    if {[info exists httpd]} {
        puts $httpd "quit"
        vwait httpd_output
        close $httpd
    }
    unset -nocomplain httpd_output httpd
}

proc meta {tok {key ""}} {
    set meta [http::meta $tok]
    if {$key ne ""} {
        if {[dict exists $meta $key]} {
            return [dict get $meta $key]
        } else {
            return ""
        }
    }
    return $meta
}

proc state {tok {key ""}} {
    upvar 1 $tok state
    if {$key ne ""} {
        if {[array names state -exact $key] ne {}} {
            return $state($key)
        } else {
            return ""
        }
    }
    set res [array get state]
    dict set res body <elided>
    return $res
}

proc check_crc {tok args} {
    set crc [meta $tok x-crc32]
    set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
    set chk [format %x [zlib crc32 $data]]
    if {$crc ne $chk} {
        return  "crc32 mismatch: $crc ne $chk"
    }
    return "ok"
}

makeFile "<html><head><title>test</title></head><body><p>this is a test</p>\n[string repeat {<p>This is a tcl test file.</p>} 4192]\n</body></html>" testdoc.html

# -------------------------------------------------------------------------

test http11-1.0 "normal request for document " -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close}

test http11-1.1 "normal,gzip,non-chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -headers {accept-encoding gzip}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok gzip {}}

test http11-1.2 "normal,deflated,non-chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -headers {accept-encoding deflate}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok deflate {}}

test http11-1.3 "normal,compressed,non-chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -headers {accept-encoding compress}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok compress {}}

test http11-1.4 "normal,identity,non-chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -headers {accept-encoding identity}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} {}}

test http11-1.5 "normal request for document, unsupported coding" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 10000 -headers {accept-encoding unsupported}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {}}

test http11-1.6 "normal, specify 1.1 " -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -protocol 1.1 -timeout 10000]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok connection] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close chunked}

test http11-1.7 "normal, 1.1 and keepalive " -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -protocol 1.1 -keepalive 1 -timeout 10000]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok connection] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} chunked}

test http11-1.8 "normal, 1.1 and keepalive, server close" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -protocol 1.1 -keepalive 1 -timeout 10000]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok connection] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close {}}

test http11-1.9 "normal,gzip,chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 10000 -headers {accept-encoding gzip}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok gzip chunked}

test http11-1.10 "normal,deflate,chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 10000 -headers {accept-encoding deflate}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok deflate chunked}

test http11-1.11 "normal,compress,chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 10000 -headers {accept-encoding compress}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok compress chunked}

test http11-1.12 "normal,identity,chunked" -setup {
    variable httpd [create_httpd]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 10000 -headers {accept-encoding identity}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok content-encoding] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} chunked}

test http11-1.13 "normal, 1.1 and keepalive as server default, no zip" -setup {
    variable httpd [create_httpd]
    set zipTmp [http::config -zip]
    http::config -zip 0
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
                 -protocol 1.1 -keepalive 1 -timeout 10000]
    http::wait $tok
    set res1 [list [http::status $tok] [http::code $tok] [check_crc $tok] \
        [meta $tok connection] [meta $tok transfer-encoding] [state $tok reusing] [state $tok connection]]
    set toj [http::geturl http://localhost:$httpd_port/testdoc.html?transfer= \
                 -protocol 1.1 -keepalive 1 -timeout 10000]
    http::wait $toj
    set res2 [list [http::status $toj] [http::code $toj] [check_crc $toj] \
        [meta $toj connection] [meta $toj transfer-encoding] [state $toj reusing] [state $toj connection]]
    concat $res1 -- $res2
} -cleanup {
    http::cleanup $tok
    http::cleanup $toj
    halt_httpd
    http::config -zip $zipTmp
} -result {ok {HTTP/1.1 200 OK} ok {} {} 0 keep-alive -- ok {HTTP/1.1 200 OK} ok {} {} 1 keep-alive}

# -------------------------------------------------------------------------

proc progress {var token total current} {
    upvar #0 $var log
    set log [list $current $total]
    return
}

proc progressPause {var token total current} {
    upvar #0 $var log
    set log [list $current $total]
    after 100 set ::WaitHere 0
    vwait ::WaitHere
    return
}

test http11-2.0 "-channel" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close chunked}

test http11-2.1 "-channel, encoding gzip" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close gzip chunked}

test http11-2.2 "-channel, encoding deflate" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close deflate chunked}

test http11-2.3 "-channel,encoding compress" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan \
                 -headers {accept-encoding compress}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close compress chunked}

test http11-2.4 "-channel,encoding identity" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan \
                 -headers {accept-encoding identity}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}

test http11-2.4.1 "-channel,encoding identity with -progress" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
    set logdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan \
                 -headers {accept-encoding identity} \
                 -progress [namespace code [list progress logdata]]]

    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding] \
        [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
        [expr {[lindex $logdata 0] - [string length $data]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
    unset -nocomplain logdata data
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}

test http11-2.4.2 "-channel,encoding identity with -progress progressPause enters event loop" -constraints knownBug -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
    set logdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan \
                 -headers {accept-encoding identity} \
                 -progress [namespace code [list progressPause logdata]]]

    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding] \
        [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
        [expr {[lindex $logdata 0] - [string length $data]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
    unset -nocomplain logdata data ::WaitHere
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked 0 0}

test http11-2.5 "-channel,encoding unsupported" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan \
                 -headers {accept-encoding unsupported}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}

test http11-2.6 "-channel,encoding gzip,non-chunked" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]\
        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0}

test http11-2.7 "-channel,encoding deflate,non-chunked" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]\
        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0}

test http11-2.8 "-channel,encoding compress,non-chunked" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 5000 -channel $chan -headers {accept-encoding compress}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]\
        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close compress {} 0}

test http11-2.9 "-channel,encoding identity,non-chunked" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 5000 -channel $chan -headers {accept-encoding identity}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]\
        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0}

test http11-2.10 "-channel,deflate,keepalive" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan -keepalive 1 \
		 -headers {accept-encoding deflate}]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]\
        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0}

test http11-2.11 "-channel,identity,keepalive" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -headers {accept-encoding identity} \
                 -timeout 5000 -channel $chan -keepalive 1]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} {} chunked}

test http11-2.12 "-channel,negotiate,keepalive" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 5000 -channel $chan -keepalive 1]
    http::wait $tok
    seek $chan 0
    set data [read $chan]
    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
        [meta $tok connection] [meta $tok content-encoding]\
        [meta $tok transfer-encoding] [meta $tok x-requested-encodings]\
        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok {} gzip chunked gzip,deflate,compress 0}


# -------------------------------------------------------------------------
#
# The following tests for the -handler option will require changes in
# the future. At the moment we cannot handler chunked data with this
# option. Therefore we currently force HTTP/1.0 protocol version.
#
# Once this is solved, these tests should be fixed to assume chunked
# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1

proc handler {var sock token} {
    upvar #0 $var data
    set chunk [read $sock]
    append data $chunk
    #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
    return [string length $chunk]
}

proc handlerPause {var sock token} {
    upvar #0 $var data
    set chunk [read $sock]
    append data $chunk
    #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
    after 100 set ::WaitHere 0
    vwait ::WaitHere
    return [string length $chunk]
}

test http11-3.0 "-handler,close,identity" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -handler [namespace code [list handler testdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}

test http11-3.1 "-handler,protocol1.0" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -protocol 1.0 \
                 -handler [namespace code [list handler testdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}

test http11-3.2 "-handler,close,chunked" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 10000 -keepalive 0 -binary 1\
                 -handler [namespace code [list handler testdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}

test http11-3.3 "-handler,keepalive,chunked" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -timeout 10000 -keepalive 1 -binary 1\
                 -handler [namespace code [list handler testdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}

# http11-3.4
# This test is a blatant attempt to confuse the client by instructing the server
# to send neither "Connection: close" nor "Content-Length" when in non-chunked
# mode.
# The client has no way to know the response-body is complete unless the
# server signals this by closing the connection.
# In an HTTP/1.1 response the absence of "Connection: close" means
# "Connection: keep-alive", i.e. the server will keep the connection
# open.  In HTTP/1.0 this is not the case, and this is a test that
# the Tcl client assumes "Connection: close" by default in HTTP/1.0.
test http11-3.4 "-handler,close,identity; HTTP/1.0 server does not send Connection: close header or Content-Length" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1&nosendclose=any \
                 -timeout 10000 -handler [namespace code [list handler testdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok {} {} {} 0}

# It is not forbidden for a handler to enter the event loop.
test http11-3.5 "-handler,close,identity as http11-3.0 but handlerPause enters event loop" -setup {
    variable httpd [create_httpd]
    set testdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -handler [namespace code [list handlerPause testdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata ::WaitHere
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}

test http11-3.6 "-handler,close,identity as http11-3.0 but with -progress" -setup {
    variable httpd [create_httpd]
    set testdata ""
    set logdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -handler [namespace code [list handler testdata]] \
                 -progress [namespace code [list progress logdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}] \
        [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
        [expr {[lindex $logdata 0] - [string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata logdata ::WaitHere
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}

test http11-3.7 "-handler,close,identity as http11-3.0 but with -progress progressPause enters event loop" -setup {
    variable httpd [create_httpd]
    set testdata ""
    set logdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 -handler [namespace code [list handler testdata]] \
                 -progress [namespace code [list progressPause logdata]]]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length $testdata]}] \
        [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
        [expr {[lindex $logdata 0] - [string length $testdata]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain testdata logdata ::WaitHere
    halt_httpd
} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0 0 0}

test http11-3.8 "close,identity no -handler but with -progress" -setup {
    variable httpd [create_httpd]
    set logdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 \
                 -progress [namespace code [list progress logdata]] \
                 -headers {accept-encoding {}}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
        [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
        [expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain logdata ::WaitHere
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}

test http11-3.9 "close,identity no -handler but with -progress progressPause enters event loop" -setup {
    variable httpd [create_httpd]
    set logdata ""
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
                 -timeout 10000 \
                 -progress [namespace code [list progressPause logdata]] \
                 -headers {accept-encoding {}}]
    http::wait $tok
    list [http::status $tok] [http::code $tok] [check_crc $tok]\
        [meta $tok connection] [meta $tok content-encoding] \
        [meta $tok transfer-encoding] \
        [expr {[file size testdoc.html]-[string length [http::data $tok]]}] \
        [expr {[lindex $logdata 0] - [lindex $logdata 1]}] \
        [expr {[lindex $logdata 0] - [string length [http::data $tok]]}]
} -cleanup {
    http::cleanup $tok
    unset -nocomplain logdata ::WaitHere
    halt_httpd
} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0 0 0}

test http11-4.0 "normal post request" -setup {
    variable httpd [create_httpd]
} -body {
    set query [http::formatQuery q 1 z 2]
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -query $query -timeout 10000]
    http::wait $tok
    list status [http::status $tok] code [http::code $tok]\
        crc [check_crc $tok]\
        connection [meta $tok connection]\
        query-length [meta $tok x-query-length]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}

test http11-4.1 "normal post request, check query length" -setup {
    variable httpd [create_httpd]
} -body {
    set query [http::formatQuery q 1 z 2]
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
                 -headers [list x-check-query yes] \
                 -query $query -timeout 10000]
    http::wait $tok
    list status [http::status $tok] code [http::code $tok]\
        crc [check_crc $tok]\
        connection [meta $tok connection]\
        query-length [meta $tok x-query-length]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}

test http11-4.2 "normal post request, check long query length" -setup {
    variable httpd [create_httpd]
} -body {
    set query [string repeat a 24576]
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
                 -headers [list x-check-query yes]\
                 -query $query -timeout 10000]
    http::wait $tok
    list status [http::status $tok] code [http::code $tok]\
        crc [check_crc $tok]\
        connection [meta $tok connection]\
        query-length [meta $tok x-query-length]
} -cleanup {
    http::cleanup $tok
    halt_httpd
} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576}

test http11-4.3 "normal post request, check channel query length" -setup {
    variable httpd [create_httpd]
    set chan [open [makeFile {} testfile.tmp] wb+]
    puts -nonewline $chan [string repeat [encoding convertto utf-8 "This is a test\n"] 8192]
    flush $chan
    seek $chan 0
} -body {
    set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
                 -headers [list x-check-query yes]\
                 -querychannel $chan -timeout 10000]
    http::wait $tok
    list status [http::status $tok] code [http::code $tok]\
        crc [check_crc $tok]\
        connection [meta $tok connection]\
        query-length [meta $tok x-query-length]
} -cleanup {
    http::cleanup $tok
    close $chan
    removeFile testfile.tmp
    halt_httpd
} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880}

# -------------------------------------------------------------------------

# Eliminate valgrind "still reachable" reports on outstanding "Detached"
# structures in the detached list which stem from PipeClose2Proc not waiting
# around for background processes to complete, meaning that previous calls to
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
after 10
exec [info nameofexecutable] << {}

foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
    if {[llength [info proc $p]]} {rename $p {}}
}
removeFile testdoc.html
unset -nocomplain httpd_port httpd p

::tcltest::cleanupTests

Deleted tests/httpPipeline.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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




































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# httpPipeline.test
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

package require http 2.9

set sourcedir [file normalize [file dirname [info script]]]
source [file join $sourcedir httpTest.tcl]
source [file join $sourcedir httpTestScript.tcl]

# ------------------------------------------------------------------------------
# (1) Define the test scripts that will be used to generate logs for analysis -
#     and also define the "correct" results.
# ------------------------------------------------------------------------------

proc ReturnTestScriptAndResult {ca cb delay te} {

    switch -- $ca {
	1     {set start {
	    START
	    KEEPALIVE 0
	    PIPELINE  0
	}}

	2     {set start {
	    START
	    KEEPALIVE 0
	    PIPELINE  1
	}}

	3     {set start {
	    START
	    KEEPALIVE 1
	    PIPELINE  0
	}}

	4     {set start {
	    START
	    KEEPALIVE 1
	    PIPELINE  1
	}}

	default {
	    return -code error {no matching script}
	}
    }

    set middle "
	    [list DELAY $delay]
    "

    switch -- $cb {
	1     {set end {
	    GET a
	    GET b
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ? ?}
	    set resLong  {1 2 3 4}
	}

	2     {set end {
	    GET a
	    HEAD b
	    GET c
	    HEAD a
	    HEAD c
	    STOP
	    }
	    set resShort {1 ? ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	3     {set end {
	    HEAD a
	    GET b
	    HEAD c
	    HEAD b
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6}
	}

	4     {set end {
	    GET a
	    GET b
	    GET c
	    GET a
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? ? ? 5 ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	5     {set end {
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 6 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	6     {set end {
	    POST a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 ? 3 ? ? 6 7 ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	7     {set end {
	    GET b address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 ? 4 ? ? 7 8 ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	8     {set end {
	    # Telling the server to close the connection.
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	9     {set end {
	    # Telling the server to close the connection.
	    GET a
	    POST b close=y address=home code=brief paid=yes
	    GET c
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 2 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	10     {set end {
	    # Telling the server to close the connection.
	    GET a
	    GET b close=y
	    POST c address=home code=brief paid=yes
	    GET a
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	11    {set end {
	    # Telling the server to close the connection twice.
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b close=y
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 ? 3 ? ? 6 ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	12    {set end {
	    # Telling the server to delay before sending the response.
	    GET a
	    GET b delay=1
	    GET c
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 ? ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	13    {set end {
	    # Making the server close the connection (time out).
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    GET b
	    STOP
	    }
	    set resShort {1 2 ? ? ?}
	    set resLong  {1 2 3 4 5}
	}

	14    {set end {
	    # Making the server close the connection (time out) twice.
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    WAIT 2000
	    GET b
	    GET c
	    GET a
	    GET b
	    GET c
	    STOP
	    }
	    set resShort {1 2 ? ? 5 ? ? ? ?}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	15    {set end {
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes close=y delay=1
	    POST c address=home code=brief paid=yes delay=1
	    POST a address=home code=brief paid=yes close=y
	    WAIT 2000
	    POST b address=home code=brief paid=yes delay=1
	    POST c address=home code=brief paid=yes close=y
	    POST a address=home code=brief paid=yes
	    POST b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 6 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	16    {set end {
	    POST a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes close=y
	    GET a address=home code=brief paid=yes
	    GET b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    WAIT 2000
	    POST a address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes close=y
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 ? 3 4 ? 6 7 ? 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}

	17    {set end {
	    GET b address=home code=brief paid=yes
	    POST a address=home code=brief paid=yes
	    GET a address=home code=brief paid=yes
	    POST c address=home code=brief paid=yes close=y
	    GET b address=home code=brief paid=yes
	    HEAD b address=home code=brief paid=yes close=y
	    POST c address=home code=brief paid=yes
	    WAIT 2000
	    POST a address=home code=brief paid=yes
	    WAIT 2000
	    GET c address=home code=brief paid=yes
	    STOP
	    }
	    set resShort {1 2 3 4 5 ? 7 8 9}
	    set resLong  {1 2 3 4 5 6 7 8 9}
	}


	18    {set end {
	    REPOST 0
	    GET a
	    WAIT 2000
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	    # resShort is overwritten below for the case ($te == 1).
	}


	19    {set end {
	    REPOST 0
	    GET a
	    WAIT 2000
	    GET b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	}


	20    {set end {
	    POSTFRESH 1
	    GET a
	    WAIT 2000
	    POST b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}


	21    {set end {
	    POSTFRESH 1
	    GET a
	    WAIT 2000
	    GET b address=home code=brief paid=yes
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 2 ? ?}
	    set resLong  {1 2 3 4}
	}

	22    {set end {
	    GET a
	    WAIT 2000
	    KEEPALIVE 0
	    POST b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}


	23    {set end {
	    GET a
	    WAIT 2000
	    KEEPALIVE 0
	    GET b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 3 ?}
	    set resLong  {1 3 4}
	}

	24    {set end {
	    GET a
	    KEEPALIVE 0
	    POST b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ?}
	    set resLong  {1 3 4}
	}


	25    {set end {
	    GET a
	    KEEPALIVE 0
	    GET b address=home code=brief paid=yes
	    KEEPALIVE 1
	    GET c
	    GET a
	    STOP
	    }
	    set resShort {1 ? ?}
	    set resLong  {1 3 4}
	}

	default {
	    return -code error {no matching script}
	}
    }


    if {$ca < 3} {
	# Not Keep-Alive.
        set result "Passed all sanity checks."

    } elseif {$ca == 3} {
        # Keep-Alive, not pipelined.
        set result {}
        append result "Passed all sanity checks.\n"
        append result "Have overlaps including response body:\n"

    } else {
        # Keep-Alive, pipelined: ($ca == 4)
        set result {}
        append result "Passed all sanity checks.\n"
        append result "Overlap-free without response body:\n"
        append result "$resShort"
    }

    # - The special case of test *.18*-testEof needs test results to be
    #   individually written.
    # - These test -repost 0 when there is a POST to apply it to, and the server
    #   timeout has not been detected.
    if {($cb == 18) && ($te == 1)} {
        if {$ca < 3} {
	    # Not Keep-Alive.
	    set result "Passed all sanity checks."

	} elseif {$ca == 3 && $delay == 0} {
	    # Keep-Alive, not pipelined.
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|Wrong sequence for token ::http::3 - {A X X}
		|- and error(s) X
		|Wrong sequence for token ::http::4 - {A X X X}
		|- and error(s) X
		|
		|Have overlaps including response body:
		|
	    }]

	} elseif {$ca == 3} {
	    # Keep-Alive, not pipelined.
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|
		|Have overlaps including response body:
		|
	    }]

	} elseif {$delay == 0} {
	    # Keep-Alive, pipelined: ($ca == 4)
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|Wrong sequence for token ::http::3 - {A X X}
		|- and error(s) X
		|Wrong sequence for token ::http::4 - {A X X X}
		|- and error(s) X
		|
		|Overlap-free without response body:
		|
	    }]

	} else {
            set result [MakeMessage {
		|Problems with sanity checks:
		|Wrong sequence for token ::http::2 - {A B C D X X X}
		|- and error(s) X
		|
		|Overlap-free without response body:
		|
	    }]

        }
    }

    return [list "$start$middle$end" $result]
}

# ------------------------------------------------------------------------------
#  Proc MakeMessage
# ------------------------------------------------------------------------------
# WHD's one-line command to generate multi-line strings from readable code.
#
# Example:
#   set blurb [MakeMessage {
#            |This command allows multi-line strings to be created with readable
#            |code, and without breaking the rules for indentation.
#            |
#            |The command shifts the entire block of text to the left, omitting
#            |the pipe character and the spaces to its left.
#   }]
# ------------------------------------------------------------------------------

proc MakeMessage {in} {
    regsub -all -line {^\s*\|} [string trim $in] {}
    # N.B. Implicit Return.
}


proc ReturnTestScript {ca cb delay te} {
    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
    return $script
}

proc ReturnTestResult {ca cb delay te} {
    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
    return $result
}


# ------------------------------------------------------------------------------
# (2) Command to run a test script and use httpTest to analyse the logs.
# ------------------------------------------------------------------------------

namespace import httpTestScript::runHttpTestScript
namespace import httpTestScript::cleanupHttpTestScript
namespace import httpTest::cleanupHttpTest
namespace import httpTest::logAnalyse
namespace import httpTest::setHttpTestOptions

proc RunTest {header footer delay te} {
    set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
    set skipOverlaps 0
    set notPiped    {}
    set notIncluded {}

    # --------------------------------------------------------------------------
    # Custom code for specific tests
    # --------------------------------------------------------------------------
    if {$header < 3} {
        set skipOverlaps 1
        for {set i 1} {$i <= $num} {incr i} {
	    lappend notPiped $i
        }
    } elseif {$header > 2 && $footer == 18 && $te == 1} {
        set skipOverlaps 1
        if {$delay == 0} {
	    # Transaction 1 is conventional.
	    # Check that transactions 2,3,4 are cancelled.
	    set notPiped {1}
	    set notIncluded $notPiped
        } else {
	    # Transaction 1 is conventional.
	    # Check that transaction 2 is cancelled.
	    # The timing of transactions 3 and 4 is uncertain.
	    set notPiped {1 3 4}
	    set notIncluded $notPiped
	}
    } elseif {$footer in {20 22 23 24 25}} {
	# Transaction 2 uses its own socket.
	set notPiped    2
	set notIncluded $notPiped
    } else {
    }
    # --------------------------------------------------------------------------
    # End of custom code for specific tests
    # --------------------------------------------------------------------------


    set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped]
    lassign $Results msg cleanE cleanF dirtyE dirtyF
    if {$msg eq {}} {
        set msg "Passed all sanity checks."
    } else {
        set msg "Problems with sanity checks:\n$msg"
    }

    if 0 {
        puts $msg
        puts "Overlap-free including response body:\n$cleanF"
        puts "Have overlaps including response body:\n$dirtyF"
        puts "Overlap-free without response body:\n$cleanE"
        puts "Have overlaps without response body:\n$dirtyE"
    }

    if {$header < 3} {
        # No ordering, just check that transactions all finish
        set result $msg
    } elseif {$header == 3} {
        # Not pipelined - check overlaps with response body.
        set result "$msg\nHave overlaps including response body:\n$dirtyF"
    } else {
        # Pipelined - check overlaps without response body.  Check that the
        # first request, the first requests after replay, and POSTs are clean.
        set result "$msg\nOverlap-free without response body:\n$cleanE"
    }
    set ::nTokens $num
    return $result
}


# ------------------------------------------------------------------------------
# (3) VERBOSITY CONTROL
# ------------------------------------------------------------------------------
# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
# If still obscure, uncomment #Log and ##Log lines in the http package.
# ------------------------------------------------------------------------------

setHttpTestOptions -verbose 0

# ------------------------------------------------------------------------------
# (4) Define the base URLs used for testing.  Each must have a query string.
# ------------------------------------------------------------------------------
# - A HTTP/1.1 server is required.  It should be configured to provide
#   persistent connections when requested to do so, and to close these
#   connections if they are idle for one second.
# - The resource must be served with status 200 in response to a valid GET or
#   POST.
# - The value of "page" is always specified in the query-string. Different
#   resources for the three values of "page" allow testing of both chunked and
#   unchunked transfer encoding.
# - The variables "close" and "delay" may be specified in the query-string (for
#   a GET) or the request body (for a POST).
#   - "delay" is a numerical value in seconds, and causes the server to delay
#     the response, including headers.
#   - "close", if it has the value "y", instructs the server to close the
#     connection ater the current request.
# - Any other variables should be ignored.
# ------------------------------------------------------------------------------

namespace eval ::httpTestScript {
    variable URL
    array set URL {
        a  http://test-tcl-http.kerlin.org/index.html?page=privacy
        b  http://test-tcl-http.kerlin.org/index.html?page=conditions
        c  http://test-tcl-http.kerlin.org/index.html?page=welcome
    }
}


# ------------------------------------------------------------------------------
# (5) Define the tests
# ------------------------------------------------------------------------------
# Constraints:
# - serverNeeded - the URLs defined at (4) must be available, and must have the
#                  properties specified there.
# - duplicate    - the value of -pipeline does not matter if -keepalive 0
# - timeout1s    - tests that work correctly only if the server closes
#                  persistent connections after one second.
#
# Server timeout of persistent connections should be 1s.  Delays of 2s are
# intended to cause timeout.
# Servers are usually configured to use a longer timeout: this will cause the
# tests to fail.  The "2000" could be replaced with a larger number, but the
# tests will then be inconveniently slow.
# ------------------------------------------------------------------------------

#testConstraint serverNeeded 1
#testConstraint timeout1s 1
#testConstraint duplicate 1

# ------------------------------------------------------------------------------
#  Proc SetTestEof - to edit the command ::http::KeepSocket
# ------------------------------------------------------------------------------
# The usual line in command ::http::KeepSocket is "    set TEST_EOF 0".
# Whether the value set in the file is 0 or 1, change it here to the value
# specified by the argument.
#
# It is worth doing all tests for both values of the argument.
#
# test 0  - ::http::KeepSocket is unchanged, detects server eof where possible
#           and closes the connection.
# test 1  - ::http::KeepSocket is edited, does not detect server eof, so the
#           reaction to finding server eof can be tested without the difficulty
#           of testing in the few milliseconds of an asynchronous close event.
# ------------------------------------------------------------------------------

proc SetTestEof {test} {
    set body [info body ::http::KeepSocket]
    set subs "    set TEST_EOF $test"
    set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
    if {$count != 1} {
        return -code error {proc ::http::KeepSocket has unexpected form}
    }
    proc ::http::KeepSocket {token} $newBody
    return
}

for {set header 1} {$header <= 4} {incr header} {
    if {$header == 4} {
	setHttpTestOptions -dotted 1
	set match glob
    } else {
	setHttpTestOptions -dotted 0
	set match exact
    }

    if {$header == 2} {
        set cons0 {serverNeeded duplicate}
    } else {
        set cons0 serverNeeded
    }

    for {set footer 1} {$footer <= 25} {incr footer} {
        foreach {delay label} {
	       0 a
	       1 b
	       2 c
	       3 d
	       5 e
	       8 f
	      12 g
	     100 h
	     500 i
	    2000 j
	} {
	  foreach te {0 1} {
	    if {$te} {
	        set tag testEof
	    } else {
	        set tag normal
	    }
	    set suffix {}
	    set cons $cons0

	    # ------------------------------------------------------------------
	    # Custom code for individual tests
	    # ------------------------------------------------------------------
	    if {$footer in {18}} {
		# Custom code:
		if {($label eq "j") && ($te == 1)} {
		    continue
		}
		if {$te == 1} {
		    # The test (of REPOST 0) is useful if tag is "testEof"
		    # (server timeout without client reaction).  The same test
		    # has a different result if tag is "normal".

		    set suffix " - extra test for -repost 0 - ::http::2 must be"
		    append suffix " cancelled"
		    if {($delay == 0)} {
			append suffix ", along with  ::http::3  ::http::4 if"
			append suffix " the test creates these before ::http::2"
			append suffix " is cancelled"
		    }
		} else {
		}
	    } elseif {$footer in {19}} {
		set suffix " - extra test for -repost 0"
	    } elseif {$footer in {20 21}} {
		set suffix " - extra test for -postfresh 1"
		if {($footer == 20)} {
		    append suffix " - ::http::2 uses a separate socket"
		    append suffix ", other requests use a persistent connection"
		}
	    } elseif {$footer in {22 23 24 25}} {
		append suffix " - ::http::2 uses a separate socket"
		append suffix ", other requests use a persistent connection"
	    } else {
	    }

	    if {($footer >= 13 && $footer <= 23)} {
		# Test use WAIT and depend on server timeout before this time.
		lappend cons timeout1s
	    }
	    # ------------------------------------------------------------------
	    # End of custom code.
	    # ------------------------------------------------------------------

            set name "pipeline test header $header footer $footer delay $delay $tag$suffix"


	    # Here's the test:
            test httpPipeline-${header}.${footer}${label}-${tag} $name \
            -constraints $cons \
            -setup [string map [list TE $te] {
		# Restore default values for tests:
		http::config -pipeline 1 -postfresh 0 -repost 1
                http::init
                set http::http(uid) 0
		SetTestEof {TE}
	    }] -body [list RunTest $header $footer $delay $te] -cleanup {
		# Restore default values for tests:
		http::config -pipeline 1 -postfresh 0 -repost 1
		cleanupHttpTestScript
		SetTestEof 0
		cleanupHttpTest
		after 2000
		# Wait for persistent sockets on the server to time out.
	    } -result [ReturnTestResult $header $footer $delay $te] -match $match


	  }

	}
    }
}

# ------------------------------------------------------------------------------
# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
# ------------------------------------------------------------------------------
# These tests are a bit awkward because the main test kit analyses whether all
# requests are satisfied, with retries if necessary, and it has result analysis
# for processing retry logs.
# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
#   is a one-off.
# - Tests *.18a-testEof depend on client/server timing - the test needs to call
#   http::geturl for all requests before the POST (request 2) is cancelled.
#   We test that requests 2, 3, 4 are all cancelled.
# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
#   added to the write queue before request 2 is completed. We simply check that
#   request 2 is cancelled.
# - The behaviour is different if all connections are allowed to time out
#   (label "j").  This case is not needed to test -repost 0, and is omitted.
# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
#   effect).
# ------------------------------------------------------------------------------


unset header footer delay label suffix match cons name te
namespace delete ::httpTest
namespace delete ::httpTestScript

::tcltest::cleanupTests

Deleted tests/httpTest.tcl.

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
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
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





























































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# httpTest.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTest for analysis of Log output of http requests.
# ------------------------------------------------------------------------------
# This is a specialised test kit for examining the presence, ordering, and
# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
# connection; and also for testing reconnection in accordance with RFC 7230 when
# the connection is lost.
#
# This kit is probably not useful for other purposes.  It depends on the
# presence of specific Log commands in the http library, and it interprets the
# logs that these commands create.
# ------------------------------------------------------------------------------

package require http

namespace eval ::http {
    variable TestStartTimeInMs [clock milliseconds]
#    catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"}
}

namespace eval ::httpTest {
    variable testResults {}
    variable testOptions
    array set testOptions {
        -verbose 0
        -dotted  1
    }
    # -verbose - 0 quiet 1 write to stdout 2 write more
    # -dotted  - (boolean) use dots for absences in lists of transactions
}

proc httpTest::Puts {txt} {
    variable testOptions
    if {$testOptions(-verbose) > 0} {
        puts stdout $txt
        flush stdout
    }
    return
}

# http::Log
#
# A special-purpose logger used for running tests.
# - Processes Log calls that have "^" in their arguments, and records them in
#   variable ::httpTest::testResults.
# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0).
# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).

proc http::Log {args} {
    variable TestStartTimeInMs
    set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
    set txt [list $time {*}$args]
    if {[string first ^ $txt] >= 0} {
        ::httpTest::LogRecord $txt
        ::httpTest::Puts $txt
    } elseif {$::httpTest::testOptions(-verbose) > 1} {
        ::httpTest::Puts $txt
    }
    return
}
# The http::Log routine above needs the variable ::httpTest::testOptions
# Set up to destroy it when that variable goes away.
trace add variable ::httpTest::testOptions unset {apply {args {
    proc ::http::Log args {}
}}}

# Called by http::Log (the "testing" version) to record logs for later analysis.

proc httpTest::LogRecord {txt} {
    variable testResults

    set pos [string first ^ $txt]
    set len [string length  $txt]
    if {$pos > $len - 3} {
        puts stdout "Logging Error: $txt"
        puts stdout "Fix this call to Log in http-*.tm so it has ^ then\
		a letter then a numeral."
        flush stdout
    } elseif {$pos < 0} {
        # Called by mistake.
    } else {
        set letter [string index $txt [incr pos]]
        set number [string index $txt [incr pos]]
        # Max 9 requests!
        lappend testResults [list $letter $number]
    }

    return
}


# ------------------------------------------------------------------------------
# Commands for analysing the logs recorded when calling http::geturl.
# ------------------------------------------------------------------------------

# httpTest::TestOverlaps --
#
# The main test for correct behaviour of pipelined and sequential
# (non-pipelined) transactions.  Other tests should be run first to detect
# any inconsistencies in the data (e.g. absence of the elements that are
# examined here).
#
# Examine the sequence $someResults for each transaction from 1 to $n,
# ignoring any that are listed in $badTrans.
# Determine whether the elements "B" to $term for one transaction overlap
# elements "B" to $term for the previous and following transactions.
#
# Transactions in the list $badTrans are not included in "clean" or
# "dirty", but their possible overlap with other transactions is noted.
# Transactions in the list $notPiped are a subset of $badTrans, and
# their possible overlap with other transactions is NOT noted.
#
# Arguments:
# someResults - list of results, each of the form {letter numeral}
# n           - number of HTTP transactions
# term        - letter that indicated end of search range. "E" for testing
#               overlaps from start of request to end of response headers.
#               "F" to extend to the end of the response body.
# msg         - the cumulative message from sanity checks.  Append to it only
#               to report a test failure.
# badTrans    - list of transaction numbers not to be assessed as "clean" or
#               "dirty"
# notPiped    - subset of badTrans.  List of transaction numbers that cannot
#               taint another transaction by overlapping with it, because it
#               used a different socket.
#
# Return value: [list $msg $clean $dirty]
# msg   - warning messages: nothing will be appended to argument $msg if there
#         is an error with the test.
# clean - list of transactions that have no overlap with other transactions
# dirty - list of transactions that have YES overlap with other transactions

proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
    variable testOptions

    # Check whether transactions overlap:
    set clean {}
    set dirty {}
    for {set i 1} {$i <= $n} {incr i} {
        if {$i in $badTrans} {
            continue
        }
        set myStart   [lsearch -exact $someResults [list B $i]]
        set myEnd     [lsearch -exact $someResults [list $term $i]]

        if {($myStart < 0 || $myEnd < 0)} {
            set res "Cannot find positions of transaction $i"
	    append msg $res \n
	    Puts $res
        }

	set overlaps {}
	for {set j $myStart} {$j <= $myEnd} {incr j} {
	    lassign [lindex $someResults $j] letter number
	    if {$number != $i && $letter ne "A" && $number ni $notPiped} {
		lappend overlaps $number
	    }
	}

        if {[llength $overlaps] == 0} {
	    set res "Transaction $i has no overlaps"
	    Puts $res
	    lappend clean $i
	    if {$testOptions(-dotted)} {
		# N.B. results from different segments are concatenated.
		lappend dirty .
	    } else {
	    }
        } else {
	    set res "Transaction $i overlaps with [join $overlaps { }]"
	    Puts $res
	    lappend dirty $i
	    if {$testOptions(-dotted)} {
		# N.B. results from different segments are concatenated.
		lappend clean .
	    } else {
	    }
        }
    }
    return [list $msg $clean $dirty]
}

# httpTest::PipelineNext --
#
# Test whether prevPair, pair are valid as consecutive elements of a pipelined
# sequence (Start 1), (End 1), (Start 2), (End 2) ...
# Numbers are integers increasing (by 1 if argument "any" is false), and need
# not begin with 1.
# The first element of the sequence has prevPair {} and is always passed as
# valid.
#
# Arguments;
# Start        - string that labels the start of a segment
# End          - string that labels the end of a segment
# prevPair     - previous "pair" (list of string and number) element of a
#                sequence, or {} if argument "pair" is the first in the
#                sequence.
# pair         - current "pair" (list of string and number) element of a
#                sequence
# any          - (boolean) iff true, accept any increasing sequence of integers.
#                If false, integers must increase by 1.
#
# Return value - boolean, true iff the two pairs are valid consecutive elements.

proc httpTest::PipelineNext {Start End prevPair pair any} {
    if {$prevPair eq {}} {
        return 1
    }

    lassign $prevPair letter number
    lassign $pair newLetter newNumber
    if {$letter eq $Start} {
	return [expr {($newLetter eq $End) && ($newNumber == $number)}]
    } elseif {$any} {
        set nxt [list $Start [expr {$number + 1}]]
	return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
    } else {
        set nxt [list $Start [expr {$number + 1}]]
	return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
    }
}

# httpTest::TestPipeline --
#
# Given a sequence of "pair" elements, check that the elements whose string is
# $Start or $End form a valid pipeline. Ignore other elements.
#
# Return value: {} if valid pipeline, otherwise a non-empty error message.

proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
    set sequence {}
    set prevPair {}
    set ok 1
    set any [llength $badTrans]
    foreach pair $someResults {
        lassign $pair letter number
        if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
            lappend sequence $pair
            if {![PipelineNext $Start $End $prevPair $pair $any]} {
		set ok 0
		break
            }
            set prevPair $pair
        }
    }

    if {!$ok} {
        set res "$desc are not pipelined: {$sequence}"
        append msg $res \n
        Puts $res
    }
    return $msg
}

# httpTest::TestSequence --
#
# Examine each transaction from 1 to $n, ignoring any that are listed
# in $badTrans.
# Check that each transaction has elements A to F, in alphabetical order.

proc httpTest::TestSequence {someResults n msg badTrans} {
    variable testOptions

    for {set i 1} {$i <= $n} {incr i} {
        if {$i in $badTrans} {
	    continue
        }
        set sequence {}
        foreach pair $someResults {
            lassign $pair letter number
            if {$number == $i} {
                lappend sequence $letter
            }
        }
        if {$sequence eq {A B C D E F}} {
        } else {
            set res "Wrong sequence for token ::http::$i - {$sequence}"
	    append msg $res \n
	    Puts $res
            if {"X" in $sequence} {
                set res "- and error(s) X"
		append msg $res \n
		Puts $res
            }
            if {"Y" in $sequence} {
                set res "- and warnings(s) Y"
		append msg $res \n
		Puts $res
            }
        }
    }
    return $msg
}

#
# Arguments:
# someResults  - list of elements, each a list of a letter and a number
# n            - (positive integer) the number of HTTP requests
# msg          - accumulated warning messages
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# badTrans     - list of transaction numbers not to be assessed as "clean" or
#                "dirty" by their overlaps
#   for 1/2 includes all transactions
#   for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled.
# notPiped     - subset of badTrans.  List of transaction numbers that cannot
#                taint another transaction by overlapping with it, because it
#                used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg    - warning messages: nothing will be appended to argument $msg if there
#          is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
#          (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
#          (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
#          (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
#          (including response body)

proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
    variable testOptions

    # Check that stages for "good" transactions are all present and correct:
    set msg [TestSequence $someResults $n $msg $badTrans]

    # Check that requests are pipelined:
    set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]

    # Check that responses are pipelined:
    set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]

    if {$skipOverlaps} {
	set cleanE {}
	set dirtyE {}
	set cleanF {}
	set dirtyF {}
    } else {
	Puts "Overlaps including response body (test for non-pipelined case)"
	lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF

	Puts "Overlaps without response body (test for pipelined case)"
	lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
    }

    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}

# httpTest::ProcessRetries --
#
# Command to examine results for socket-changing records [PQR],
# divide the results into segments for each connection, and analyse each segment
# individually.
# (Could add $sock to the logging to simplify this, but never mind.)
#
# In each segment, identify any transactions that are not included, and
# any that are aborted, to assist subsequent testing.
#
# Prepend A records (socket-independent) to each segment for transactions that
# were scheduled (by A) but not completed (by F).  Pass each segment to
# MostAnalysis for processing.

proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
    variable testOptions

    set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
    if {$nextRetry < 0} {
        return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
    }
    set badTrans $notIncluded
    set tryCount 0
    set try $nextRetry
    incr tryCount
    lassign [lindex $someResults $try] letter number
    Puts "Processing retry [lindex $someResults $try]"
    set beforeTry [lrange $someResults 0 $try-1]
    Puts [join $beforeTry \n]
    set afterTry [lrange $someResults $try+1 end]

    set dummyTry   {}
    for {set i 1} {$i <= $n} {incr i} {
        set first [lsearch -exact $beforeTry [list A $i]]
        set last  [lsearch -exact $beforeTry [list F $i]]
        if {$first < 0} {
	    set res "Transaction $i was not started in connection number $tryCount"
	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
	    # append msg $res \n
	    Puts $res
	    if {$i ni $badTrans} {
		lappend badTrans $i
	    } else {
	    }
        } elseif {$last < 0} {
	    set res "Transaction $i was started but unfinished in connection number $tryCount"
	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
	    # append msg $res \n
	    Puts $res
	    lappend badTrans $i
	    lappend dummyTry [list A $i]
        } else {
	    set res "Transaction $i was started and finished in connection number $tryCount"
	    # So include it in the call below of MostAnalysis.
	    # So lappend it to notIncluded and don't include it in the recursive call of
	    # ProcessRetries which handles the later connections.
	    # append msg $res \n
	    Puts $res
	    lappend notIncluded $i
        }
    }

    # Analyse the part of the results before the first replay:
    set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
    lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1

    # Pass the rest of the results to be processed recursively.
    set afterTry [concat $dummyTry $afterTry]
    set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
    lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2

    set cleanE [concat $cleanE1 $cleanE2]
    set cleanF [concat $cleanF1 $cleanF2]
    set dirtyE [concat $dirtyE1 $dirtyE2]
    set dirtyF [concat $dirtyF1 $dirtyF2]
    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
}

# httpTest::logAnalyse --
#
#	The main command called to analyse logs for a single test.
#
# Arguments:
# n            - (positive integer) the number of HTTP requests
# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
# notIncluded  - list of transaction numbers not to be assessed as "clean" or
#                "dirty" by their overlaps
# notPiped     - subset of notIncluded.  List of transaction numbers that cannot
#                taint another transaction by overlapping with it, because it
#                used a different socket.
#
# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
# msg    - warning messages: {} if there is no error with the test.
# cleanE - list of transactions that have no overlap with other transactions
#          (not considering response body)
# dirtyE - list of transactions that have YES overlap with other transactions
#          (not considering response body)
# cleanF - list of transactions that have no overlap with other transactions
#          (including response body)
# dirtyF - list of transactions that have YES overlap with other transactions
#          (including response body)

proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} {
    variable testResults
    variable testOptions

    # Check that each data item has the correct form {letter numeral}.
    set ii 0
    set ok 1
    foreach pair $testResults {
	lassign $pair letter number
	if {    [string match {[A-Z]} $letter]
	     && [string match {[0-9]} $number]
	} {
	    # OK
	} else {
	    set ok 0
	    set res "Error: testResults has bad element {$pair} at position $ii"
	    append msg $res \n
	    Puts $res
	}
	incr ii
    }

    if {!$ok} {
	return $msg
    }
    set msg {}

    Puts [join $testResults \n]
    ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
    # N.B. Implicit Return.
}

proc httpTest::cleanupHttpTest {} {
    variable testResults
    set testResults {}
    return
}

proc httpTest::setHttpTestOptions {key args} {
    variable testOptions
    if {$key ni {-dotted -verbose}} {
        return -code error {valid options are -dotted, -verbose}
    }
    set testOptions($key) {*}$args
}

namespace eval httpTest {
    namespace export cleanupHttpTest logAnalyse setHttpTestOptions
}

Deleted tests/httpTestScript.tcl.

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
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
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





























































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# httpTestScript.tcl
#
#	Test HTTP/1.1 concurrent requests including
#	queueing, pipelining and retries.
#
# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# ------------------------------------------------------------------------------
# "Package" httpTestScript for executing test scripts written in a convenient
# shorthand.
# ------------------------------------------------------------------------------

# ------------------------------------------------------------------------------
# Documentation for "package" httpTestScript.
# ------------------------------------------------------------------------------
# To use the package:
# (a) define URLs as the values of elements in the array ::httpTestScript
# (b) define a script in terms of the commands
#         START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
#     referring to URLs by the name of the corresponding array element.  The
#     script can include any other Tcl commands, and evaluates in the
#     httpTestScript namespace.
# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
#     command.
# ------------------------------------------------------------------------------
# START
# Must be the first command of the script.
#
# STOP
# Must be present in the script to avoid waiting for client timeout.
# Usually the last command, but can be elsewhere to end a script prematurely.
# Subsequent httpTestScript commands will have no effect.
#
# DELAY ms
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl.  Default 500ms.
#
# KEEPALIVE
# Set the value passed to http::geturl for the -keepalive option.  The command
# applies to subsequent requests in the script. Default 1.
#
# WAIT ms
# Pause for a time in ms before sending subsequent requests.
#
# PIPELINE boolean
# Set the value of -pipeline using http::config.  The last PIPELINE command
# in the script applies to every request. Default 1.
#
# POSTFRESH boolean
# Set the value of -postfresh using http::config.  The last POSTFRESH command
# in the script applies to every request. Default 0.
#
# REPOST boolean
# Set the value of -repost using http::config.  The last REPOST command
# in the script applies to every request. Default 1 for httpTestScript.
# (Default value in http is 0).
#
# GET uriCode ?arg ...?
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and appended to the query
#           string with a preceding "&".
#
# HEAD uriCode ?arg ...?
# Send a HTTP request using the HEAD method.
# Arguments: as for GET
#
# POST uriCode ?arg ...?
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and used as the request body.
# ------------------------------------------------------------------------------

namespace eval ::httpTestScript {
    namespace export runHttpTestScript cleanupHttpTestScript
}

# httpTestScript::START --
# Initialise, and create a long-stop timeout.

proc httpTestScript::START {} {
    variable CountRequestedSoFar
    variable RequestsWhenStopped
    variable KeepAlive
    variable Delay
    variable TimeOutCode
    variable TimeOutDone
    variable StartDone
    variable StopDone
    variable CountFinishedSoFar
    variable RequestList
    variable RequestsMade
    variable ExtraTime
    variable ActualKeepAlive

    if {[info exists StartDone] && ($StartDone == 1)} {
        set msg {START has been called twice without an intervening STOP}
        return -code error $msg
    }

    set StartDone 1
    set StopDone 0
    set TimeOutDone 0
    set CountFinishedSoFar 0
    set CountRequestedSoFar 0
    set RequestList {}
    set RequestsMade {}
    set ExtraTime 0
    set ActualKeepAlive 1

    # Undefined until a STOP command:
    unset -nocomplain RequestsWhenStopped

    # Default values:
    set KeepAlive 1
    set Delay 500

    # Default values for tests:
    KEEPALIVE 1
    PIPELINE  1
    POSTFRESH 0
    REPOST    1

    set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
#    set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
    return
}

# httpTestScript::STOP --
# Do not process any more commands.  The commands will be executed but will
# silently do nothing.

proc httpTestScript::STOP {} {
    variable CountRequestedSoFar
    variable CountFinishedSoFar
    variable RequestsWhenStopped
    variable TimeOutCode
    variable StartDone
    variable StopDone
    variable RequestsMade

    if {$StopDone} {
        # Don't do anything on a second call.
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    set StopDone 1
    set StartDone 0
    set RequestsWhenStopped $CountRequestedSoFar
    unset -nocomplain StartDone

    if {$CountFinishedSoFar == $RequestsWhenStopped} {
        if {[info exists TimeOutCode]} {
            after cancel $TimeOutCode
        }
        set ::httpTestScript::FOREVER 0
    }
    return
}

# httpTestScript::DELAY --
# If there are no WAIT commands, this sets the delay in ms between subsequent
# calls to http::geturl.  Default 500ms.

proc httpTestScript::DELAY {t} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    variable Delay

    set Delay $t
    return
}

# httpTestScript::KEEPALIVE --
# Set the value passed to http::geturl for the -keepalive option.  Default 1.

proc httpTestScript::KEEPALIVE {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    variable KeepAlive
    set KeepAlive $b
    return
}

# httpTestScript::WAIT --
# Pause for a time in ms before processing any more commands.

proc httpTestScript::WAIT {t} {
    variable StartDone
    variable StopDone
    variable ExtraTime

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    if {(![string is integer -strict $t]) || $t < 0} {
        return -code error {argument to WAIT must be a non-negative integer}
    }

    incr ExtraTime $t

    return
}

# httpTestScript::PIPELINE --
# Pass a value to http::config -pipeline.

proc httpTestScript::PIPELINE {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -pipeline $b
    ##::http::Log http(-pipeline) is now [::http::config -pipeline]
    return
}

# httpTestScript::POSTFRESH --
# Pass a value to http::config -postfresh.

proc httpTestScript::POSTFRESH {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -postfresh $b
    ##::http::Log http(-postfresh) is now [::http::config -postfresh]
    return
}

# httpTestScript::REPOST --
# Pass a value to http::config -repost.

proc httpTestScript::REPOST {b} {
    variable StartDone
    variable StopDone

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    ::http::config -repost $b
    ##::http::Log http(-repost) is now [::http::config -repost]
    return
}

# httpTestScript::GET --
# Send a HTTP request using the GET method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will each be preceded by "&" and appended to the query
#           string.

proc httpTestScript::GET {uriCode args} {
    variable RequestList
    lappend RequestList GET
    RequestAfter $uriCode 0 {} {*}$args
    return
}

# httpTestScript::HEAD --
# Send a HTTP request using the HEAD method.
# Arguments: as for GET

proc httpTestScript::HEAD {uriCode args} {
    variable RequestList
    lappend RequestList HEAD
    RequestAfter $uriCode 1 {} {*}$args
    return
}

# httpTestScript::POST --
# Send a HTTP request using the POST method.
# Arguments:
# uriCode - the code for the base URI - the value must be stored in
#           ::httpTestScript::URL($uriCode).
# args    - strings that will be joined by "&" and used as the request body.

proc httpTestScript::POST {uriCode args} {
    variable RequestList
    lappend RequestList POST
    RequestAfter $uriCode 0 {use} {*}$args
    return
}


proc httpTestScript::RequestAfter {uriCode validate query args} {
    variable CountRequestedSoFar
    variable Delay
    variable ExtraTime
    variable StartDone
    variable StopDone
    variable KeepAlive

    if {$StopDone} {
        return
    }

    if {![info exists StartDone]} {
        return -code error {initialise the script by calling command START}
    }

    incr CountRequestedSoFar
    set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]

    # Could pass values of -pipeline, -postfresh, -repost if it were
    # useful to change these mid-script.
    after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
    return
}

proc httpTestScript::Requester {uriCode keepAlive validate query args} {
    variable URL

    ::http::config -accept {*/*}

    set absUrl $URL($uriCode)
    if {$query eq {}} {
	if {$args ne {}} {
	    append absUrl & [join $args &]
	}
	set queryArgs {}
    } elseif {$validate} {
        return -code error {cannot have both -validate (HEAD) and -query (POST)}
    } else {
	set queryArgs [list -query [join $args &]]
    }

    if {[catch {
        ::http::geturl     $absUrl        \
                -validate  $validate      \
                -timeout   10000          \
                {*}$queryArgs             \
                -keepalive $keepAlive     \
                -command   ::httpTestScript::WhenFinished
    } token]} {
        set msg $token
        catch {puts stdout "Error: $msg"}
        return
    } else {
        # Request will begin.
    }

    return

}

proc httpTestScript::TimeOutNow {} {
    variable TimeOutDone

    set TimeOutDone 1
    set ::httpTestScript::FOREVER 0
    return
}

proc httpTestScript::WhenFinished {hToken} {
    variable CountFinishedSoFar
    variable RequestsWhenStopped
    variable TimeOutCode
    variable StopDone
    variable RequestList
    variable RequestsMade
    variable ActualKeepAlive

    upvar #0 $hToken state

    if {[catch {
	if {    [info exists state(transfer)]
	     && ($state(transfer) eq "chunked")
	} {
	    set Trans chunked
	} else {
	    set Trans unchunked
	}

	if {    [info exists ::httpTest::testOptions(-verbose)]
	     && ($::httpTest::testOptions(-verbose) > 0)
	} {
	    puts "Token    $hToken
Response $state(http)
Status   $state(status)
Method   $state(method)
Transfer $Trans
Size     $state(currentsize)
URL      $state(url)
"
	}

	if {!$state(-keepalive)} {
	    set ActualKeepAlive 0
	}

	if {[info exists state(method)]} {
	    lappend RequestsMade $state(method)
	} else {
	    lappend RequestsMade UNKNOWN
	}
	set tk [namespace tail $hToken]

	if {    ($state(http) != {HTTP/1.1 200 OK})
	     || ($state(status) != {ok})
	     || (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
	} {
	    ::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
	}
    } err]} {
	::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
    }

    incr CountFinishedSoFar
    if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
        if {[info exists TimeOutCode]} {
            after cancel $TimeOutCode
        }
        if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
	    ::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
        }
        set ::httpTestScript::FOREVER 0
    }

    return
}


proc httpTestScript::runHttpTestScript {scr} {
    variable TimeOutDone
    variable RequestsWhenStopped

    after idle [list namespace eval ::httpTestScript $scr]
    vwait ::httpTestScript::FOREVER
    # N.B. does not automatically execute in this namespace, unlike some other events.
    # Release when all requests have been served or have timed out.

    if {$TimeOutDone} {
        return -code error {test script timed out}
    }

    return $RequestsWhenStopped
}


proc httpTestScript::cleanupHttpTestScript {} {
    variable TimeOutDone
    variable RequestsWhenStopped

    if {![info exists RequestsWhenStopped]} {
	return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
    }

    for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
        http::cleanup ::http::$i
    }

    return
}

Deleted tests/httpcookie.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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














































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  http::cookiejar
#
# This file contains a collection of tests for the cookiejar package.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2014 Donal K. Fellows.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands

testConstraint notOSXtravis [apply {{} {
    upvar 1 env(TRAVIS_OSX_IMAGE) travis
    return [expr {![info exists travis] || ![string match xcode* $travis]}]
}}]
testConstraint sqlite3 [expr {[testConstraint notOSXtravis] && ![catch {
    package require sqlite3
}]}]
testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch {
    package require cookiejar
}]}]

set COOKIEJAR_VERSION 0.2.0
test http-cookiejar-1.1 "cookie storage: packaging" {cookiejar} {
    package require cookiejar
} $COOKIEJAR_VERSION
test http-cookiejar-1.2 "cookie storage: packaging" {cookiejar} {
    package require cookiejar
    package require cookiejar
} $COOKIEJAR_VERSION

test http-cookiejar-2.1 "cookie storage: basics" -constraints {
    cookiejar
} -returnCodes error -body {
    http::cookiejar
} -result {wrong # args: should be "http::cookiejar method ?arg ...?"}
test http-cookiejar-2.2 "cookie storage: basics" -constraints {
    cookiejar
} -returnCodes error -body {
    http::cookiejar ?
} -result {unknown method "?": must be configure, create, destroy or new}
test http-cookiejar-2.3 "cookie storage: basics" -constraints {
    cookiejar
} -body {
    http::cookiejar configure
} -result {-domainfile -domainlist -domainrefresh -loglevel -offline -purgeold -retain -vacuumtrigger}
test http-cookiejar-2.4 "cookie storage: basics" -constraints {
    cookiejar
} -returnCodes error -body {
    http::cookiejar configure a b c d e
} -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"}
test http-cookiejar-2.5 "cookie storage: basics" -constraints {
    cookiejar
} -returnCodes error -body {
    http::cookiejar configure a
} -result {bad option "a": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger}
test http-cookiejar-2.6 "cookie storage: basics" -constraints {
    cookiejar
} -returnCodes error -body {
    http::cookiejar configure -d
} -result {ambiguous option "-d": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger}
test http-cookiejar-2.7 "cookie storage: basics" -setup {
    set old [http::cookiejar configure -loglevel]
} -constraints {cookiejar} -body {
    list [http::cookiejar configure -loglevel] \
	[http::cookiejar configure -loglevel debug] \
	[http::cookiejar configure -loglevel] \
	[http::cookiejar configure -loglevel error] \
	[http::cookiejar configure -loglevel]
} -cleanup {
    http::cookiejar configure -loglevel $old
} -result {info debug debug error error}
test http-cookiejar-2.8 "cookie storage: basics" -setup {
    set old [http::cookiejar configure -loglevel]
} -constraints {cookiejar} -body {
    list [http::cookiejar configure -loglevel] \
	[http::cookiejar configure -loglevel d] \
	[http::cookiejar configure -loglevel i] \
	[http::cookiejar configure -loglevel w] \
	[http::cookiejar configure -loglevel e]
} -cleanup {
    http::cookiejar configure -loglevel $old
} -result {info debug info warn error}
test http-cookiejar-2.9 "cookie storage: basics" -body {
    http::cookiejar configure -off
} -constraints {cookiejar} -match glob -result *
test http-cookiejar-2.10 "cookie storage: basics" -setup {
    set oldval [http::cookiejar configure -offline]
} -constraints {cookiejar} -body {
    http::cookiejar configure -offline true
} -cleanup {
    catch {http::cookiejar configure -offline $oldval}
} -result 1
test http-cookiejar-2.11 "cookie storage: basics" -setup {
    set oldval [http::cookiejar configure -offline]
} -constraints {cookiejar} -body {
    http::cookiejar configure -offline nonbool
} -cleanup {
    catch {http::cookiejar configure -offline $oldval}
} -returnCodes error -result {expected boolean value but got "nonbool"}
test http-cookiejar-2.12 "cookie storage: basics" -setup {
    set oldval [http::cookiejar configure -purgeold]
} -constraints {cookiejar} -body {
    http::cookiejar configure -purge nonint
} -cleanup {
    catch {http::cookiejar configure -purgeold $oldval}
} -returnCodes error -result {expected positive integer but got "nonint"}
test http-cookiejar-2.13 "cookie storage: basics" -setup {
    set oldval [http::cookiejar configure -domainrefresh]
} -constraints {cookiejar} -body {
    http::cookiejar configure -domainref nonint
} -cleanup {
    catch {http::cookiejar configure -domainrefresh $oldval}
} -returnCodes error -result {expected positive integer but got "nonint"}
test http-cookiejar-2.14 "cookie storage: basics" -setup {
    set oldval [http::cookiejar configure -domainrefresh]
} -constraints {cookiejar} -body {
    http::cookiejar configure -domainref -42
} -cleanup {
    catch {http::cookiejar configure -domainrefresh $oldval}
} -returnCodes error -result {expected positive integer but got "-42"}
test http-cookiejar-2.15 "cookie storage: basics" -setup {
    set oldval [http::cookiejar configure -domainrefresh]
    set result unset
    set tracer [http::cookiejar create tracer]
} -constraints {cookiejar} -body {
    oo::objdefine $tracer method PostponeRefresh {} {
	set ::result set
	next
    }
    http::cookiejar configure -domainref 12345
    return $result
} -cleanup {
    $tracer destroy
    catch {http::cookiejar configure -domainrefresh $oldval}
} -result set

test http-cookiejar-3.1 "cookie storage: class" {cookiejar} {
    info object isa object http::cookiejar
} 1
test http-cookiejar-3.2 "cookie storage: class" {cookiejar} {
    info object isa class http::cookiejar
} 1
test http-cookiejar-3.3 "cookie storage: class" {cookiejar} {
    lsort [info object methods http::cookiejar]
} {configure}
test http-cookiejar-3.4 "cookie storage: class" {cookiejar} {
    lsort [info object methods http::cookiejar -all]
} {configure create destroy new}
test http-cookiejar-3.5 "cookie storage: class" -setup {
    catch {rename ::cookiejar ""}
} -constraints {cookiejar} -body {
    namespace eval :: {http::cookiejar create cookiejar}
} -cleanup {
    catch {rename ::cookiejar ""}
} -result ::cookiejar
test http-cookiejar-3.6 "cookie storage: class" -setup {
    catch {rename ::cookiejar ""}
} -constraints {cookiejar} -body {
    list [http::cookiejar create ::cookiejar] [info commands ::cookiejar] \
	    [::cookiejar destroy] [info commands ::cookiejar]
} -cleanup {
    catch {rename ::cookiejar ""}
} -result {::cookiejar ::cookiejar {} {}}
test http-cookiejar-3.7 "cookie storage: class" -setup {
    catch {rename ::cookiejar ""}
} -constraints {cookiejar} -body {
    http::cookiejar create ::cookiejar foo bar
} -returnCodes error -cleanup {
    catch {rename ::cookiejar ""}
} -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"}
test http-cookiejar-3.8 "cookie storage: class" -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "" cookiejar]
    file delete $f
} -constraints {cookiejar} -body {
    list [file exists $f] [http::cookiejar create ::cookiejar $f] \
	[file exists $f]
} -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -result {0 ::cookiejar 1}
test http-cookiejar-3.9 "cookie storage: class" -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "bogus content for a database" cookiejar]
} -constraints {cookiejar} -body {
    http::cookiejar create ::cookiejar $f
} -returnCodes error -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -match glob -result *
test http-cookiejar-3.10 "cookie storage: class" -setup {
    catch {rename ::cookiejar ""}
    set dir [makeDirectory cookiejar]
} -constraints {cookiejar} -body {
    http::cookiejar create ::cookiejar $dir
} -returnCodes error -cleanup {
    catch {rename ::cookiejar ""}
    removeDirectory $dir
} -match glob -result *

test http-cookiejar-4.1 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar method ?arg ...?"}
test http-cookiejar-4.2 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar ?
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {unknown method "?": must be destroy, forceLoadDomainData, getCookies, lookup, policyAllow or storeCookie}
test http-cookiejar-4.3 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    lsort [info object methods cookiejar -all]
} -cleanup {
    ::cookiejar destroy
} -result {destroy forceLoadDomainData getCookies lookup policyAllow storeCookie}
test http-cookiejar-4.4 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar getCookies
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar getCookies proto host path"}
test http-cookiejar-4.5 "cookie storage" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar getCookies http www.example.com /
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.6 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar storeCookie
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar storeCookie options"}
test http-cookiejar-4.7 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.8 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM sessionCookies}
} -cleanup {
    ::cookiejar destroy
} -result 1
test http-cookiejar-4.9 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM persistentCookies}
} -cleanup {
    ::cookiejar destroy
} -result 0
test http-cookiejar-4.10 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.11 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints {cookiejar} -body {
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM sessionCookies}
} -cleanup {
    ::cookiejar destroy
} -result 0
test http-cookiejar-4.12 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine ::cookiejar export Database
} -constraints {cookiejar} -body {
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    # Poke inside implementation!
    cookiejar Database eval {SELECT count(*) FROM persistentCookies}
} -cleanup {
    ::cookiejar destroy
} -result 1
test http-cookiejar-4.13 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lappend result [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo bar}}
test http-cookiejar-4.14 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo bar}}
test http-cookiejar-4.15 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie [dict replace {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo bar}}
test http-cookiejar-4.16 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    lappend result [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo1
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie [dict replace {
	key foo2
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [lsort -stride 2 [cookiejar getCookies http www.example.com /]]
} -cleanup {
    ::cookiejar destroy
} -result {{} {foo1 bar foo2 bar}}
test http-cookiejar-4.17 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
} -constraints {cookiejar} -body {
    cookiejar lookup a b c d
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar lookup ?host? ?key?"}
test http-cookiejar-4.18 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    lappend result [cookiejar lookup]
    lappend result [cookiejar lookup www.example.com]
    lappend result [catch {cookiejar lookup www.example.com foo} value] $value
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lappend result [cookiejar lookup]
    lappend result [cookiejar lookup www.example.com]
    lappend result [cookiejar lookup www.example.com foo]
} -cleanup {
    ::cookiejar destroy
} -result {{} {} 1 {no such key for that host} www.example.com foo bar}
test http-cookiejar-4.19 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key bar
	value foo
	secure 0
	domain www.example.org
	origin www.example.org
	path /
	hostonly 1
    }
    lappend result [lsort [cookiejar lookup]]
    lappend result [cookiejar lookup www.example.com]
    lappend result [cookiejar lookup www.example.com foo]
    lappend result [cookiejar lookup www.example.org]
    lappend result [cookiejar lookup www.example.org bar]
} -cleanup {
    ::cookiejar destroy
} -result {{www.example.com www.example.org} foo bar bar foo}
test http-cookiejar-4.20 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo1
	value bar1
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie [dict replace {
	key foo2
	value bar2
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+5}]]
    lappend result [cookiejar lookup]
    lappend result [lsort [cookiejar lookup www.example.com]]
    lappend result [cookiejar lookup www.example.com foo1]
    lappend result [cookiejar lookup www.example.com foo2]
} -cleanup {
    ::cookiejar destroy
} -result {www.example.com {foo1 foo2} bar1 bar2}
test http-cookiejar-4.21 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo1
	value bar1
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo2
	value bar2
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lappend result [cookiejar lookup]
    lappend result [lsort [cookiejar lookup www.example.com]]
    lappend result [cookiejar lookup www.example.com foo1]
    lappend result [cookiejar lookup www.example.com foo2]
} -cleanup {
    ::cookiejar destroy
} -result {www.example.com {foo1 foo2} bar1 bar2}
test http-cookiejar-4.22 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    cookiejar forceLoadDomainData x y z
} -returnCodes error -cleanup {
    ::cookiejar destroy
} -result {wrong # args: should be "cookiejar forceLoadDomainData"}
test http-cookiejar-4.23 "cookie storage: instance" -setup {
    http::cookiejar create ::cookiejar
    set result {}
} -constraints {cookiejar} -body {
    cookiejar forceLoadDomainData
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-4.23.a {cookie storage: instance} -setup {
    set off [http::cookiejar configure -offline]
} -constraints {cookiejar} -body {
    http::cookiejar configure -offline 1
    [http::cookiejar create ::cookiejar] destroy
} -cleanup {
    catch {::cookiejar destroy}
    http::cookiejar configure -offline $off
} -result {}
test http-cookiejar-4.23.b {cookie storage: instance} -setup {
    set off [http::cookiejar configure -offline]
} -constraints {cookiejar} -body {
    http::cookiejar configure -offline 0
    [http::cookiejar create ::cookiejar] destroy
} -cleanup {
    catch {::cookiejar destroy}
    http::cookiejar configure -offline $off
} -result {}

test http-cookiejar-5.1 "cookie storage: constraints" -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain com
	origin com
	path /
	hostonly 1
    }
    cookiejar lookup
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-5.2 "cookie storage: constraints" -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo
	value bar
	secure 0
	domain foo.example.com
	origin bar.example.org
	path /
	hostonly 1
    }
    cookiejar lookup
} -cleanup {
    ::cookiejar destroy
} -result {}
test http-cookiejar-5.3 "cookie storage: constraints" -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo1
	value bar
	secure 0
	domain com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo2
	value bar
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar lookup
} -cleanup {
    ::cookiejar destroy
} -result {example.com}
test http-cookiejar-5.4 "cookie storage: constraints" -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo
	value bar1
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo
	value bar2
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 1
    }
    lsort [cookiejar lookup]
} -cleanup {
    ::cookiejar destroy
} -result {example.com www.example.com}
test http-cookiejar-5.5 "cookie storage: constraints" -setup {
    http::cookiejar create ::cookiejar
    cookiejar forceLoadDomainData
} -constraints {cookiejar} -body {
    cookiejar storeCookie {
	key foo1
	value 1
	secure 0
	domain com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo2
	value 2
	secure 0
	domain com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo3
	value 3
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo4
	value 4
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo5
	value 5
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo6
	value 6
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo7
	value 7
	secure 1
	domain www.example.com
	origin www.example.com
	path /
	hostonly 0
    }
    cookiejar storeCookie {
	key foo8
	value 8
	secure 1
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    cookiejar storeCookie {
	key foo9
	value 9
	secure 0
	domain sub.www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    list [cookiejar getCookies http www.example.com /] \
	[cookiejar getCookies http www2.example.com /] \
	[cookiejar getCookies https www.example.com /] \
	[cookiejar getCookies http sub.www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{foo3 3 foo6 6} {foo3 3} {foo3 3 foo6 6 foo8 8} {foo3 3 foo5 5}}

test http-cookiejar-6.1 "cookie storage: expiry and lookup" -setup {
    http::cookiejar create ::cookiejar
    oo::objdefine cookiejar export PurgeCookies
    set result {}
    proc values cookies {
	global result
	lappend result [lsort [lmap {k v} $cookies {set v}]]
    }
} -constraints {cookiejar} -body {
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value session
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    }
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie [dict replace {
	key foo
	value cookie
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+1}]]
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value session-global
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 0
    }
    values [cookiejar getCookies http www.example.com /]
    after 2500
    update
    values [cookiejar getCookies http www.example.com /]
    cookiejar PurgeCookies
    values [cookiejar getCookies http www.example.com /]
    cookiejar storeCookie {
	key foo
	value go-away
	secure 0
	domain example.com
	origin www.example.com
	path /
	hostonly 0
	expires 0
    }
    values [cookiejar getCookies http www.example.com /]
} -cleanup {
    ::cookiejar destroy
} -result {{} session cookie {cookie session-global} {cookie session-global} session-global {}}

test http-cookiejar-7.1 "cookie storage: persistence of persistent cookies" -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "" cookiejar]
    file delete $f
} -constraints {cookiejar} -body {
    http::cookiejar create ::cookiejar $f
    ::cookiejar destroy
    http::cookiejar create ::cookiejar $f
} -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -result ::cookiejar
test http-cookiejar-7.2 "cookie storage: persistence of persistent cookies" -setup {
    catch {rename ::cookiejar ""}
    set f [makeFile "" cookiejar]
    file delete $f
    set result {}
} -constraints {cookiejar} -body {
    http::cookiejar create ::cookiejar $f
    cookiejar storeCookie [dict replace {
	key foo
	value cookie
	secure 0
	domain www.example.com
	origin www.example.com
	path /
	hostonly 1
    } expires [expr {[clock seconds]+1}]]
    lappend result [::cookiejar getCookies http www.example.com /]
    ::cookiejar destroy
    http::cookiejar create ::cookiejar
    lappend result [::cookiejar getCookies http www.example.com /]
    ::cookiejar destroy
    http::cookiejar create ::cookiejar $f
    lappend result [::cookiejar getCookies http www.example.com /]
} -cleanup {
    catch {rename ::cookiejar ""}
    removeFile $f
} -result {{foo cookie} {} {foo cookie}}

::tcltest::cleanupTests

# Local variables:
# mode: tcl
# End:

Changes to tests/httpd.

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
1
2
3
4
5
6
7
8
9
10
11
12







13

14





15
16
17
18
19
20
21












-
-
-
-
-
-
-

-
+
-
-
-
-
-







# -*- tcl -*-
#
# The httpd_ procedures implement a stub http server.
#
# Copyright (c) 1997-1998 Sun Microsystems, Inc.
# Copyright (c) 1999-2000 Scriptics Corporation
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

#set httpLog 1

if {$::tcl_platform(os) eq "Darwin"} {
    # Name resolution often a problem on OSX; not focus of HTTP package anyway
    set HOST localhost
} else {
    set HOST [info hostname]
}

proc httpd_init {{port 8015}} {
    set s [socket -server httpdAccept $port]
    socket -server httpdAccept $port
    # Save the actual port number in a global variable.
    # This is important when we're called with port 0
    # for picking an unused port at random.
    set ::port [lindex [chan configure $s -sockname] 2]
    return $s
}
proc httpd_log {args} {
    global httpLog
    if {[info exists httpLog] && $httpLog} {
	puts stderr "httpd: [join $args { }]"
    }
}
176
177
178
179
180
181
182
183

184
185
186
187
188
189
190
164
165
166
167
168
169
170

171
172
173
174
175
176
177
178







-
+








proc httpdRespond { sock } {
    global httpd bindata port
    upvar #0 httpd$sock data

    switch -glob -- $data(url) {
	*binary* {
	    set html "$bindata${::HOST}:$port$data(url)"
	    set html "$bindata[info hostname]:$port$data(url)"
	    set type application/octet-stream
	}
	*xml* {
	    set html [encoding convertto utf-8 "<test>\u1234</test>"]
	    set type "application/xml;charset=UTF-8"
	}
	*post* {
217
218
219
220
221
222
223
224

225
226
227
228
229
230
231
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219







-
+







		append html </dl>\n
	    }
	    append html </body></html>
	}
    }

    # Catch errors from premature client closes

    
    catch {
	if {$data(proto) == "HEAD"} {
	    puts $sock "HTTP/1.0 200 OK"
	} else {
            # Split the response to test for [Bug 26245326]
	    puts -nonewline $sock "HT"
            flush $sock

Deleted tests/httpd11.tcl.

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








































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# httpd11.tcl --                                                -*- tcl -*-
#
#	A simple httpd for testing HTTP/1.1 client features.
#	Not suitable for use on a internet connected port.
#
# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# 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-

proc ::tcl::dict::get? {dict key} {
    if {[dict exists $dict $key]} {
        return [dict get $dict $key]
    }
    return
}
namespace ensemble configure dict \
    -map [linsert [namespace ensemble configure dict -map] end get? ::tcl::dict::get?]

proc make-chunk-generator {data {size 4096}} {
    variable _chunk_gen_uid
    if {![info exists _chunk_gen_uid]} {set _chunk_gen_uid 0}
    set lambda {{data size} {
        set pos 0
        yield
        while {1} {
            set payload [string range $data $pos [expr {$pos + $size - 1}]]
            incr pos $size
            set chunk [format %x [string length $payload]]\r\n$payload\r\n
            yield $chunk
            if {![string length $payload]} {return}
        }
    }}
    set name chunker[incr _chunk_gen_uid]
    coroutine $name ::apply $lambda $data $size
    return $name
}

proc get-chunks {data {compression gzip}} {
    switch -exact -- $compression {
        gzip     { set data [zlib gzip $data] }
        deflate  { set data [zlib deflate $data] }
        compress { set data [zlib compress $data] }
    }

    set data ""
    set chunker [make-chunk-generator $data 512]
    while {[string length [set chunk [$chunker]]]} {
        append data $chunk
    }
    return $data
}

proc blow-chunks {data {ochan stdout} {compression gzip}} {
    switch -exact -- $compression {
        gzip     { set data [zlib gzip $data] }
        deflate  { set data [zlib deflate $data] }
        compress { set data [zlib compress $data] }
    }

    set chunker [make-chunk-generator $data 512]
    while {[string length [set chunk [$chunker]]]} {
        puts -nonewline $ochan $chunk
    }
    return
}

proc mime-type {filename} {
    switch -exact -- [file extension $filename] {
        .htm - .html { return {text text/html}}
        .png { return {binary image/png} }
        .jpg { return {binary image/jpeg} }
        .gif { return {binary image/gif} }
        .css { return {text   text/css} }
        .xml { return {text   text/xml} }
        .xhtml {return {text  application/xml+html} }
        .svg { return {text image/svg+xml} }
        .txt - .tcl - .c - .h { return {text text/plain}}
    }
    return {binary text/plain}
}

proc Puts {chan s} {puts $chan $s; puts $s}

proc Service {chan addr port} {
    chan event $chan readable [info coroutine]
    while {1} {
        set meta {}
        chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
        chan configure $chan -blocking 0
        yield
        while {[gets $chan line] < 0} {
            if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
            yield
        }
        if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
        foreach {req url protocol} {GET {} HTTP/1.1} break
        regexp {^(\S+)\s+(.*)\s(\S+)?$} $line -> req url protocol

        puts $line
        while {[gets $chan line] > 0} {
            if {[regexp {^([^:]+):(.*)$} $line -> key val]} {
                puts [list $key [string trim $val]]
                lappend meta [string tolower $key] [string trim $val]
            }
            yield
        }

        set encoding identity
        set transfer ""
        set close 1
        set type text/html
        set code "404 Not Found"
        set data "<html><head><title>Error 404</title></head>"
        append data "<body><h1>Not Found</h1><p>Try again.</p></body></html>"

        if {[scan $url {%[^?]?%s} path query] < 2} {
            set query ""
        }

        switch -exact -- $req {
            GET - HEAD {
            }
            POST {
                # Read the query.
                set qlen [dict get? $meta content-length]
                if {[string is integer -strict $qlen]} {
                    chan configure $chan -buffering none -translation binary
                    while {[string length $query] < $qlen} {
                        append query [read $chan $qlen]
                        if {[string length $query] < $qlen} {yield}
                    }
                    # Check for excess query bytes [Bug 2715421]
                    if {[dict get? $meta x-check-query] eq "yes"} {
                        chan configure $chan -blocking 0
                        append query [read $chan]
                    }
                }
            }
            default {
                # invalid request error 5??
            }
        }
        if {$query ne ""} {puts $query}

        set path [string trimleft $path /]
        set path [file join [pwd] $path]
        if {[file exists $path] && [file isfile $path]} {
            foreach {what type} [mime-type $path] break
            set f [open $path r]
            if {$what eq "binary"} {chan configure $f -translation binary}
            set data [read $f]
            close $f
            set code "200 OK"
            set close [expr {[dict get? $meta connection] eq "close"}]
        }

        if {$protocol eq "HTTP/1.1"} {
	    foreach enc [split [dict get? $meta accept-encoding] ,] {
		set enc [string trim $enc]
		if {$enc in {deflate gzip compress}} {
		    set encoding $enc
		    break
		}
	    }
            set transfer chunked
        } else {
            set close 1
        }

        set nosendclose 0
        foreach pair [split $query &] {
            if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""}
            switch -exact -- $key {
                nosendclose  {set nosendclose 1}
                close        {set close 1 ; set transfer 0}
                transfer     {set transfer $val}
                content-type {set type $val}
            }
        }
        if {$protocol eq "HTTP/1.1"} {
            set nosendclose 0
        }

        chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
        Puts $chan "$protocol $code"
        Puts $chan "content-type: $type"
        Puts $chan [format "x-crc32: %08x" [zlib crc32 $data]]
        if {$req eq "POST"} {
            Puts $chan [format "x-query-length: %d" [string length $query]]
        }
        if {$close && (!$nosendclose)} {
            Puts $chan "connection: close"
        }
	Puts $chan "x-requested-encodings: [dict get? $meta accept-encoding]"
        if {$encoding eq "identity" && (!$nosendclose)} {
            Puts $chan "content-length: [string length $data]"
        } elseif {$encoding eq "identity"} {
            # This is a blatant attempt to confuse the client by sending neither
            # "Connection: close" nor "Content-Length" when in non-chunked mode.
            # See test http11-3.4.
        } else {
            Puts $chan "content-encoding: $encoding"
        }
        if {$transfer eq "chunked"} {
            Puts $chan "transfer-encoding: chunked"
        }
        puts $chan ""
        flush $chan

        chan configure $chan -buffering full -translation binary
        if {$transfer eq "chunked"} {
            blow-chunks $data $chan $encoding
        } elseif {$encoding ne "identity"} {
            puts -nonewline $chan [zlib $encoding $data]
        } else {
            puts -nonewline $chan $data
        }

        if {$close} {
            chan event $chan readable {}
            close $chan
            puts "close $chan"
            return
        } else {
            flush $chan
        }
        puts "pipeline $chan"
    }
}

proc Accept {chan addr port} {
    coroutine client$chan Service $chan $addr $port
    return
}

proc Control {chan} {
    if {[gets $chan line] >= 0} {
        if {[string trim $line] eq "quit"} {
            set ::forever 1
        }
    }
    if {[eof $chan]} {
        chan event $chan readable {}
    }
}

proc Main {{port 0}} {
    set server [socket -server Accept -myaddr localhost $port]
    puts [chan configure $server -sockname]
    flush stdout
    chan event stdin readable [list Control stdin]
    vwait ::forever
    close $server
    return "done"
}

if {!$tcl_interactive} {
    set r [catch [linsert $argv 0 Main] err]
    if {$r} {puts stderr $errorInfo} elseif {[string length $err]} {puts $err}
    exit $r
}

Added tests/httpold.test.






































































































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Commands covered:  http_config, http_get, http_wait, http_reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

if {[catch {package require http 1.0}]} {
    if {[info exists httpold]} {
	catch {puts "Cannot load http 1.0 package"}
	::tcltest::cleanupTests
	return
    } else {
	catch {puts "Running http 1.0 tests in slave interp"}
	set interp [interp create httpold]
	$interp eval [list set httpold "running"]
	$interp eval [list set argv $argv]
	$interp eval [list source [info script]]
	interp delete $interp
	::tcltest::cleanupTests
	return
    }
}

set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
catch {unset data}

## 
## The httpd script implement a stub http server
##
source [file join [file dirname [info script]] httpd]

set port 8010
if [catch {httpd_init $port} listen] {
    puts "Cannot start http server, http test skipped"
    unset port
    ::tcltest::cleanupTests
    return
}

test httpold-1.1 {http_config} {
    http_config
} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}

test httpold-1.2 {http_config} {
    http_config -proxyfilter
} httpProxyRequired

test httpold-1.3 {http_config} {
    catch {http_config -junk}
} 1

test httpold-1.4 {http_config} {
    http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"
    set x [http_config]
    http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \
	-useragent "Tcl http client package 1.0"
    set x
} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}

test httpold-1.5 {http_config} {
    catch {http_config -proxyhost {} -junk 8080}
} 1

test httpold-2.1 {http_reset} {
    catch {http_reset http#1}
} 0

test httpold-3.1 {http_get} {
    catch {http_get -bogus flag}
} 1
test httpold-3.2 {http_get} {
    catch {http_get http:junk} err
    set err
} {Unsupported URL: http:junk}

set url [info hostname]:$port
test httpold-3.3 {http_get} {
    set token [http_get $url]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET /</h2>
</body></html>"

set tail /a/b/c
set url [info hostname]:$port/a/b/c
set binurl [info hostname]:$port/binary

test httpold-3.4 {http_get} {
    set token [http_get $url]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

proc selfproxy {host} {
    global port
    return [list [info hostname] $port]
}
test httpold-3.5 {http_get} {
    http_config -proxyfilter selfproxy
    set token [http_get $url]
    http_config -proxyfilter httpProxyRequired
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http://$url</h2>
</body></html>"

test httpold-3.6 {http_get} {
    http_config -proxyfilter bogus
    set token [http_get $url]
    http_config -proxyfilter httpProxyRequired
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

test httpold-3.7 {http_get} {
    set token [http_get $url -headers {Pragma no-cache}]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

test httpold-3.8 {http_get} {
    set token [http_get $url -query Name=Value&Foo=Bar]
    http_data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>POST $tail</h2>
<h2>Query</h2>
<dl>
<dt>Name<dd>Value
<dt>Foo<dd>Bar
</dl>
</body></html>"

test httpold-3.9 {http_get} {
    set token [http_get $url -validate 1]
    http_code $token
} "HTTP/1.0 200 OK"


test httpold-4.1 {httpEvent} {
    set token [http_get $url]
    upvar #0 $token data
    array set meta $data(meta)
    expr ($data(totalsize) == $meta(Content-Length))
} 1

test httpold-4.2 {httpEvent} {
    set token [http_get $url]
    upvar #0 $token data
    array set meta $data(meta)
    string compare $data(type) [string trim $meta(Content-Type)]
} 0

test httpold-4.3 {httpEvent} {
    set token [http_get $url]
    http_code $token
} {HTTP/1.0 200 Data follows}

test httpold-4.4 {httpEvent} {
    set testfile [makeFile "" testfile]
    set out [open $testfile w]
    set token [http_get $url -channel $out]
    close $out
    set in [open $testfile]
    set x [read $in]
    close $in
    removeFile $testfile
    set x
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
</body></html>"

test httpold-4.5 {httpEvent} {
    set testfile [makeFile "" testfile]
    set out [open $testfile w]
    set token [http_get $url -channel $out]
    close $out
    upvar #0 $token data
    removeFile $testfile
    expr $data(currentsize) == $data(totalsize)
} 1

test httpold-4.6 {httpEvent} {
    set testfile [makeFile "" testfile]
    set out [open $testfile w]
    set token [http_get $binurl -channel $out]
    close $out
    set in [open $testfile]
    fconfigure $in -translation binary
    set x [read $in]
    close $in
    removeFile $testfile
    set x
} "$bindata$binurl"

proc myProgress {token total current} {
    global progress httpLog
    if {[info exists httpLog] && $httpLog} {
	puts "progress $total $current"
    }
    set progress [list $total $current]
}
if 0 {
    # This test hangs on Windows95 because the client never gets EOF
    set httpLog 1
    test httpold-4.6 {httpEvent} {
	set token [http_get $url -blocksize 50 -progress myProgress]
	set progress
    } {111 111}
}
test httpold-4.7 {httpEvent} {
    set token [http_get $url -progress myProgress]
    set progress
} {111 111}
test httpold-4.8 {httpEvent} {
    set token [http_get $url]
    http_status $token
} {ok}
test httpold-4.9 {httpEvent} {
    set token [http_get $url -progress myProgress]
    http_code $token
} {HTTP/1.0 200 Data follows}
test httpold-4.10 {httpEvent} {
    set token [http_get $url -progress myProgress]
    http_size $token
} {111}
test httpold-4.11 {httpEvent} {
    set token [http_get $url -timeout 1 -command {#}]
    http_reset $token
    http_status $token
} {reset}
test httpold-4.12 {httpEvent} {
    update
    set x {}
    after 500 {lappend x ok}
    set token [http_get $url -timeout 1 -command {lappend x fail}]
    vwait x
    list [http_status $token] $x
} {timeout ok}

test httpold-5.1 {http_formatQuery} {
    http_formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}

test httpold-5.2 {http_formatQuery} {
    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=%7ebwelch&name2=%a1%a2%a2}

test httpold-5.3 {http_formatQuery} {
    http_formatQuery lines "line1\nline2\nline3"
} {lines=line1%0d%0aline2%0d%0aline3}

test httpold-6.1 {httpProxyRequired} {
    update
    http_config -proxyhost [info hostname] -proxyport $port
    set token [http_get $url]
    http_wait $token
    http_config -proxyhost {} -proxyport {}
    upvar #0 $token data
    set data(body)
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http://$url</h2>
</body></html>"

# cleanup
catch {unset url}
catch {unset port}
catch {unset data}
close $listen
::tcltest::cleanupTests
return

Changes to tests/if-old.test.

9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24







-
-
+
+







# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test if-old-1.1 {taking proper branch} {
    set a {}
    if 0 {set a 1} else {set a 2}
    set a

Changes to tests/if.test.

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
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












-
-
+
+






-
-
-
-
-
-
+
+
+
+
+
+


-
-
-
-
+
+


-
-
-
-
-
+
+
+


-
-
-
-
-
+
+
+

-


-
-
-
-
-
+
+
+


-
-
-
-
-
+
+
+

-
-
+
-
-
-
-
+
+
+

-
-
+
-
-
-
+
+



-
-
-
+


-
-
-
-
+
+
+
+


-
-
-
-
-
+
+
+


-
+




-
-
-
-
-
+
+
+


-
-
-
-
-
+
+
+


-
-
-
-
-
+
+
+


-







# Commands covered:  if
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Basic "if" operation.

catch {unset a}
test if-1.1 {TclCompileIfCmd: missing if/elseif test} -body {
    if
} -returnCodes error -result {wrong # args: no expression after "if" argument}
test if-1.2 {TclCompileIfCmd: error in if/elseif test} -body {
    if {[error "error in condition"]} foo
} -returnCodes error -result {error in condition}
test if-1.1 {TclCompileIfCmd: missing if/elseif test} {
    list [catch {if} msg] $msg
} {1 {wrong # args: no expression after "if" argument}}
test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
    list [catch {if {[error "error in condition"]} foo} msg] $msg
} {1 {error in condition}}
test if-1.3 {TclCompileIfCmd: error in if/elseif test} -body {
    list [catch {if {1+}} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset msg
} -result {1 * {*"if {1+}"}}
test if-1.4 {TclCompileIfCmd: if/elseif test in braces} -body {
} -match glob -result {1 * {*"if {1+}"}}
test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
    set a {}
    if {1<2} {set a 1}
    return $a
} -cleanup {
    unset a
} -result {1}
test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} -body {
    set a
} {1}
test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} {
    set a {}
    if 1<2 {set a 1}
    return $a
} -cleanup {
    unset a
} -result {1}
test if-1.6 {TclCompileIfCmd: multiline test expr} -setup {
    set a
} {1}
test if-1.6 {TclCompileIfCmd: multiline test expr} {
    set a {}
} -body {
    if {($tcl_platform(platform) != "foobar1") && \
	($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
    return $a
} -cleanup {
    unset a
} -result 3
test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} -body {
    set a
} 3
test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} {
    set a {}
    if 4>3 then {set a 1}
    return $a
} -cleanup {
    unset a
} -result {1}
test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} -setup {
    set a
} {1}
test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} {
    set a {}
} -body {
    if 1<2 therefore {set a 1}
    catch {if 1<2 therefore {set a 1}} msg 
} -cleanup {
    unset a
} -returnCodes error -result {invalid command name "therefore"}
test if-1.9 {TclCompileIfCmd: missing "then" body} -setup {
    set msg
} {invalid command name "therefore"}
test if-1.9 {TclCompileIfCmd: missing "then" body} {
    set a {}
} -body {
    if 1<2 then
    catch {if 1<2 then} msg 
} -cleanup {
    unset a
} -returnCodes error -result {wrong # args: no script following "then" argument}
    set msg
} {wrong # args: no script following "then" argument}
test if-1.10 {TclCompileIfCmd: error in "then" body} -body {
    set a {}
    list [catch {if {$a!="xxx"} then {set}} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset a msg
} -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}}
test if-1.11 {TclCompileIfCmd: error in "then" body} -body {
    if 2 then {[error "error in then clause"]}
} -returnCodes error -result {error in then clause}
test if-1.12 {TclCompileIfCmd: "then" body in quotes} -body {
test if-1.11 {TclCompileIfCmd: error in "then" body} {
    list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
} {1 {error in then clause}}
test if-1.12 {TclCompileIfCmd: "then" body in quotes} {
    set a {}
    if 27>17 "append a x"
    return $a
} -cleanup {
    unset a
} -result {x}
test if-1.13 {TclCompileIfCmd: computed "then" body} -setup {
    set a
} {x}
test if-1.13 {TclCompileIfCmd: computed "then" body} {
    catch {unset x1}
    catch {unset x2}
} -body {
    set a {}
    set x1 {append a x1}
    set x2 {; append a x2}
    set a {}
    if 1 $x1$x2
    return $a
} -cleanup {
    unset a x1 x2
} -result {x1x2}
test if-1.14 {TclCompileIfCmd: taking proper branch} -body {
    set a
} {x1x2}
test if-1.14 {TclCompileIfCmd: taking proper branch} {
    set a {}
    if 1<2 {set a 1}
    return $a
} -cleanup {
    unset a
} -result 1
test if-1.15 {TclCompileIfCmd: taking proper branch} -body {
    set a
} 1
test if-1.15 {TclCompileIfCmd: taking proper branch} {
    set a {}
    if 1>2 {set a 1}
    return $a
} -cleanup {
    unset a
} -result {}
test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} -setup {
    set a
} {}
test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} {
    catch {unset i}
    set a {}
} -body {
    if 1<2 {
	set a 1
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
		    set i $i
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
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







-
-
-
+
-
-
-
+
+

-
-
+
-
-
-
+

+
-
+

-

-
-
-
-
+
+


-
+

-
-
+
-
-
-
-
+
+
+

-
-
+
-
-
-
-
+
+
+

-

-
-
-
-
+
+


-







		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a
    set a
    unset -nocomplain i
} -result 3
test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} -setup {
} 3
test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} {
    set a {}
} -body {
    if {"0 < 3"} {set a 1}
    list [catch {if {"0 < 3"} {set a 1}} msg] $msg
} -returnCodes error -cleanup {
    unset a
} -result {expected boolean value but got "0 < 3"}
} {1 {expected boolean value but got "0 < 3"}}


test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} -setup {
test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} {
    set a {}
} -body {
    if 3>4 {set a 1} elseif 1 {set a 2}
    return $a
} -cleanup {
    unset a
} -result {2}
    set a
} {2}
# Since "else" is optional, the "elwood" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} -setup {
test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} {
    set a {}
} -body {
    if 1<2 {set a 1} elwood {set a 2}
    catch {if 1<2 {set a 1} elwood {set a 2}} msg 
} -returnCodes error -cleanup {
    unset a
} -result {wrong # args: extra words after "else" clause in "if" command}
test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} -setup {
    set msg
} {wrong # args: extra words after "else" clause in "if" command}
test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
    set a {}
} -body {
    if 1<2 {set a 1} elseif
    catch {if 1<2 {set a 1} elseif} msg 
} -returnCodes error -cleanup {
    unset a
} -result {wrong # args: no expression after "elseif" argument}
test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -setup {
    set msg
} {wrong # args: no expression after "elseif" argument}
test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -body {
    set a {}
} -body {
    list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset a msg
} -result {1 * {*"if 3>4 {set a 1} elseif {1>}"}}
test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} -setup {
} -match glob -result {1 * {*"if 3>4 {set a 1} elseif {1>}"}}
test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
    catch {unset i}
    set a {}
} -body {
    if 1>2 {
	set a 1
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
		    set i $i
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
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







-
-
-
+
-
-
+

-
+


-
-
-
-
+
+


-
+

-
-
+
-
-
-
-
+
+
+

-
-
+
-
-
-
-
+
+
+

-
-
+

-
-
-
+


-
+

-
-
+
-
-
-
+
+



-
+


-







		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a
    set a
    unset -nocomplain i
} -result 6
} 6

test if-3.1 {TclCompileIfCmd: "else" clause} -body {
test if-3.1 {TclCompileIfCmd: "else" clause} {
    set a {}
    if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
    return $a
} -cleanup {
    unset a
} -result 3
    set a
} 3
# Since "else" is optional, the "elsex" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
test if-3.2 {TclCompileIfCmd: keyword other than "else"} -setup {
test if-3.2 {TclCompileIfCmd: keyword other than "else"} {
    set a {}
} -body {
    if 1<2 then {set a 1} elsex {set a 2}
    catch {if 1<2 then {set a 1} elsex {set a 2}} msg 
} -returnCodes error -cleanup {
    unset a
} -result {wrong # args: extra words after "else" clause in "if" command}
test if-3.3 {TclCompileIfCmd: missing body after "else"} -setup {
    set msg
} {wrong # args: extra words after "else" clause in "if" command}
test if-3.3 {TclCompileIfCmd: missing body after "else"} {
    set a {}
} -body {
    if 2<1 {set a 1} else
    catch {if 2<1 {set a 1} else} msg 
} -returnCodes error -cleanup {
    unset a
} -result {wrong # args: no script following "else" argument}
test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -setup {
    set msg
} {wrong # args: no script following "else" argument}
test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -body {
    set a {}
} -body {
    catch {if 2<1 {set a 1} else {set}}
    catch {if 2<1 {set a 1} else {set}} msg 
    set ::errorInfo
} -match glob -cleanup {
    unset a
} -result {wrong # args: should be "set varName ?newValue?"
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} -setup {
test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} {
    set a {}
} -body {
    if 2<1 {set a 1} else {set a 2} or something
    catch {if 2<1 {set a 1} else {set a 2} or something} msg 
} -returnCodes error -cleanup {
    unset a
} -result {wrong # args: extra words after "else" clause in "if" command}
    set msg
} {wrong # args: extra words after "else" clause in "if" command}
# The following test also checks whether contained loops and other
# commands are properly relocated because a short jump must be replaced
# by a "long distance" one.
test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} -setup {
test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} {
    catch {unset i}
    set a {}
} -body {
    if 1>2 {
	set a 1
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		if {[string compare $a "bar"] < 0} {
		    set i $i
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
595

596
597
598
599
600
601



602

603
604
605
606
607
608
609



610
611
612

613
614
615
616
617
618



619
620
621

622

623
624
625
626



627
628
629

630

631
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
686
687
688
689
690




691
692
693
694
695
696
697
698
699
700
701
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
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







-
-
-
+
-
-
+

-
+

-

-
-
-
+
-
-
-
+
+

-

-
-
-
+
-
-
-
+
+

-

-
-
-
+
-
-
-
+
+

-

-
-
-
-
-
+
+
+

-
-
-
+



+
-
+

-
+
-
-
-
-
+
+
+

-
+
-
-
-
+


-
-
+
+
-
-
-
+
-
-

+

-
-
-
-
-
+
+
+
-
-

+

-
-
-
-
-
+
+
+

+


-
-
-
-
-
+
+
+
-
-

+

-
-
-
-
-
+
+
+
-
-

+
-
+
-
-
-
-
+
+
+
-
-

+
-
+
-
-
-
+
+




-
-
-
+




-
+

-
+
-
-
-
-
+
+
-
-

+

-
-
-
-
-
+
+
+
+


-
-
+




-
-
-
-
-
+
+
+
-
-

+

-
-
-
-
-
+
+
+
-

+

-
-
-
-
-
+
+
+
+


-
-







		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a
    set a
    unset -nocomplain i
} -result 9
} 9

test if-4.1 {TclCompileIfCmd: "if" command result} -setup {
test if-4.1 {TclCompileIfCmd: "if" command result} {
    set a {}
} -body {
    set a [if 3<4 {set i 27}]
    return $a
} -cleanup {
    unset a
    set a
    unset -nocomplain i
} -result 27
test if-4.2 {TclCompileIfCmd: "if" command result} -setup {
} 27
test if-4.2 {TclCompileIfCmd: "if" command result} {
    set a {}
} -body {
    set a [if 3>4 {set i 27}]
    return $a
} -cleanup {
    unset a
    set a
    unset -nocomplain i
} -result {}
test if-4.3 {TclCompileIfCmd: "if" command result} -setup {
} {}
test if-4.3 {TclCompileIfCmd: "if" command result} {
    set a {}
} -body {
    set a [if 0 {set i 1} elseif 1 {set i 2}]
    return $a
} -cleanup {
    unset a
    set a
    unset -nocomplain i
} -result 2
test if-4.4 {TclCompileIfCmd: "if" command result} -setup {
} 2
test if-4.4 {TclCompileIfCmd: "if" command result} {
    set a {}
} -body {
    set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
    return $a
} -cleanup {
    unset a i
} -result 4
test if-4.5 {TclCompileIfCmd: return value} -body {
    set a
} 4
test if-4.5 {TclCompileIfCmd: return value} {
    if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
} -cleanup {
    unset -nocomplain a
} -result def
} def

# Check "if" and computed command names.

catch {unset a}
test if-5.1 {if cmd with computed command names: missing if/elseif test} -body {
test if-5.1 {if cmd with computed command names: missing if/elseif test} {
    set z if
    $z
    list [catch {$z} msg] $msg
} -returnCodes error -cleanup {
    unset z
} -result {wrong # args: no expression after "if" argument}
test if-5.2 {if cmd with computed command names: error in if/elseif test} -body {
} {1 {wrong # args: no expression after "if" argument}}

test if-5.2 {if cmd with computed command names: error in if/elseif test} {
    set z if
    $z {[error "error in condition"]} foo
    list [catch {$z {[error "error in condition"]} foo} msg] $msg
} -returnCodes error -cleanup {
    unset z
} -result {error in condition}
} {1 {error in condition}}
test if-5.3 {if cmd with computed command names: error in if/elseif test} -body {
    set z if
    list [catch {$z {1+}}] $::errorInfo
} -match glob -cleanup {
    list [catch {$z {1+}} msg] $msg $::errorInfo
} -match glob -result {1 * {*"$z {1+}"}}
    unset z
} -result {1 {*"$z {1+}"}}
test if-5.4 {if cmd with computed command names: if/elseif test in braces} -setup {
test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
    set a {}
} -body {
    set z if
    set a {}
    $z {1<2} {set a 1}
    return $a
} -cleanup {
    unset a z
} -result {1}
test if-5.5 {if cmd with computed command names: if/elseif test not in braces} -setup {
    set a
} {1}
test if-5.5 {if cmd with computed command names: if/elseif test not in braces} {
    set a {}
} -body {
    set z if
    set a {}
    $z 1<2 {set a 1}
    return $a
} -cleanup {
    unset a z
} -result {1}
test if-5.6 {if cmd with computed command names: multiline test expr} -body {
    set a
} {1}
test if-5.6 {if cmd with computed command names: multiline test expr} {
    set z if
    set a {}
    $z {($tcl_platform(platform) != "foobar1") && \
	($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
    return $a
} -cleanup {
    unset a z
} -result 3
test if-5.7 {if cmd with computed command names: "then" after if/elseif test} -setup {
    set a
} 3
test if-5.7 {if cmd with computed command names: "then" after if/elseif test} {
    set a {}
} -body {
    set z if
    set a {}
    $z 4>3 then {set a 1}
    return $a
} -cleanup {
    unset a z
} -result {1}
test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} -setup {
    set a
} {1}
test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} {
    set a {}
} -body {
    set z if
    set a {}
    $z 1<2 therefore {set a 1}
    catch {$z 1<2 therefore {set a 1}} msg 
} -returnCodes error -cleanup {
    unset a z
} -result {invalid command name "therefore"}
test if-5.9 {if cmd with computed command names: missing "then" body} -setup {
    set msg
} {invalid command name "therefore"}
test if-5.9 {if cmd with computed command names: missing "then" body} {
    set a {}
} -body {
    set z if
    set a {}
    $z 1<2 then
    catch {$z 1<2 then} msg 
} -returnCodes error -cleanup {
    unset a z
} -result {wrong # args: no script following "then" argument}
    set msg
} {wrong # args: no script following "then" argument}
test if-5.10 {if cmd with computed command names: error in "then" body} -body {
    set z if
    set a {}
    list [catch {$z {$a!="xxx"} then {set}} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset a z msg
} -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"
    invoked from within
"$z {$a!="xxx"} then {set}"}}
test if-5.11 {if cmd with computed command names: error in "then" body} -body {
test if-5.11 {if cmd with computed command names: error in "then" body} {
    set z if
    $z 2 then {[error "error in then clause"]}
    list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg
} -returnCodes error -cleanup {
    unset z
} -result {error in then clause}
test if-5.12 {if cmd with computed command names: "then" body in quotes} -setup {
} {1 {error in then clause}}
test if-5.12 {if cmd with computed command names: "then" body in quotes} {
    set a {}
} -body {
    set z if
    set a {}
    $z 27>17 "append a x"
    return $a
} -cleanup {
    unset a z
} -result {x}
test if-5.13 {if cmd with computed command names: computed "then" body} -setup {
    set a
} {x}
test if-5.13 {if cmd with computed command names: computed "then" body} {
    set z if
    catch {unset x1}
    catch {unset x2}
} -body {
    set z if
    set a {}
    set x1 {append a x1}
    set x2 {; append a x2}
    set a {}
    $z 1 $x1$x2
    return $a
} -cleanup {
    unset a z x1 x2
} -result {x1x2}
test if-5.14 {if cmd with computed command names: taking proper branch} -setup {
    set a
} {x1x2}
test if-5.14 {if cmd with computed command names: taking proper branch} {
    set a {}
} -body {
    set z if
    set a {}
    $z 1<2 {set a 1}
    return $a
} -cleanup {
    unset a z
} -result 1
test if-5.15 {if cmd with computed command names: taking proper branch} -body {
    set a
} 1
test if-5.15 {if cmd with computed command names: taking proper branch} {
    set a {}
    set z if
    set a {}
    $z 1>2 {set a 1}
    return $a
} -cleanup {
    unset a z
} -result {}
test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} -setup {
    set a
} {}
test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} {
    set z if
    catch {unset i}
    set a {}
} -body {
    set z if
    $z 1<2 {
	set a 1
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
		    set i $i
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
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







-
-
-
+
-
-
-
+
+
-
-

-
-
-
-
+
+
+

+
-
+
-
-

+

-
-
-
-
+
+


-
+
-
-

+
-
+
-
-
-
-
+
+
+
-
-

+
-
+
-
-
-
-
+
+
+
-
-

+
-
+
-
-
-
-
+
+
+


-
-







		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 3
    }
    return $a
} -cleanup {
    unset a z
    set a
    unset -nocomplain i
} -result 3
test if-5.17 {if cmd with computed command names: if/elseif test in quotes} -setup {
} 3
test if-5.17 {if cmd with computed command names: if/elseif test in quotes} {
    set a {}
} -body {
    set z if
    $z {"0 < 3"} {set a 1}
} -returnCodes error -cleanup {
    unset a z
} -result {expected boolean value but got "0 < 3"}
    set a {}
    list [catch {$z {"0 < 3"} {set a 1}} msg] $msg
} {1 {expected boolean value but got "0 < 3"}}


test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} -setup {
test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} {
    set a {}
} -body {
    set z if
    set a {}
    $z 3>4 {set a 1} elseif 1 {set a 2}
    return $a
} -cleanup {
    unset a z
} -result {2}
    set a
} {2}
# Since "else" is optional, the "elwood" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
test if-6.2 {if cmd with computed command names: keyword other than "elseif"} -setup {
test if-6.2 {if cmd with computed command names: keyword other than "elseif"} {
    set a {}
} -body {
    set z if
    set a {}
    $z 1<2 {set a 1} elwood {set a 2}
    catch {$z 1<2 {set a 1} elwood {set a 2}} msg 
} -returnCodes error -cleanup {
    unset a z
} -result {wrong # args: extra words after "else" clause in "if" command}
test if-6.3 {if cmd with computed command names: missing expression after "elseif"} -setup {
    set msg
} {wrong # args: extra words after "else" clause in "if" command}
test if-6.3 {if cmd with computed command names: missing expression after "elseif"} {
    set a {}
} -body {
    set z if
    set a {}
    $z 1<2 {set a 1} elseif
    catch {$z 1<2 {set a 1} elseif} msg 
} -returnCodes error -cleanup {
    unset a z
} -result {wrong # args: no expression after "elseif" argument}
test if-6.4 {if cmd with computed command names: error in expression after "elseif"} -setup {
    set msg
} {wrong # args: no expression after "elseif" argument}
test if-6.4 {if cmd with computed command names: error in expression after "elseif"} -body {
    set a {}
} -body {
    set z if
    set a {}
    list [catch {$z 3>4 {set a 1} elseif {1>}}] $::errorInfo
    list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset a z
} -result {1 {*"$z 3>4 {set a 1} elseif {1>}"}}
test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} -setup {
} -match glob -result {1 * {*"$z 3>4 {set a 1} elseif {1>}"}}
test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
    set z if
    catch {unset i}
    set a {}
} -body {
    set z if
    $z 1>2 {
	set a 1
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
		    set i $i
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
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







-
-
-
+
-
-
+

-
+
-
-

+

-
-
-
-
+
+


-
+
-
-

+
-
+
-
-
-
-
+
+
+
-
-

+
-
+
-
-
-
-
+
+
+
-
-

+
-
-
+
+
-
-
-
+




-
+
-
-

+
-
+
-
-
-
+
+



-
+
+


-
-







		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 6
    }
    return $a
} -cleanup {
    unset a z
    set a
    unset -nocomplain i
} -result 6
} 6

test if-7.1 {if cmd with computed command names: "else" clause} -setup {
test if-7.1 {if cmd with computed command names: "else" clause} {
    set a {}
} -body {
    set z if
    set a {}
    $z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
    return $a
} -cleanup {
    unset a z
} -result 3
    set a
} 3
# Since "else" is optional, the "elsex" below is treated as a command.
# But then there shouldn't be any additional argument words for the "if".
test if-7.2 {if cmd with computed command names: keyword other than "else"} -setup {
test if-7.2 {if cmd with computed command names: keyword other than "else"} {
    set a {}
} -body {
    set z if
    set a {}
    $z 1<2 then {set a 1} elsex {set a 2}
    catch {$z 1<2 then {set a 1} elsex {set a 2}} msg 
} -returnCodes error -cleanup {
    unset a z
} -result {wrong # args: extra words after "else" clause in "if" command}
test if-7.3 {if cmd with computed command names: missing body after "else"} -setup {
    set msg
} {wrong # args: extra words after "else" clause in "if" command}
test if-7.3 {if cmd with computed command names: missing body after "else"} {
    set a {}
} -body {
    set z if
    set a {}
    $z 2<1 {set a 1} else
    catch {$z 2<1 {set a 1} else} msg 
} -returnCodes error -cleanup {
    unset a z
} -result {wrong # args: no script following "else" argument}
test if-7.4 {if cmd with computed command names: error compiling body after "else"} -setup {
    set msg
} {wrong # args: no script following "else" argument}
test if-7.4 {if cmd with computed command names: error compiling body after "else"} -body {
    set a {}
} -body {
    set z if
    set a {}
    catch {$z 2<1 {set a 1} else {set}}
    return $::errorInfo
    catch {$z 2<1 {set a 1} else {set}} msg 
    set ::errorInfo
} -match glob -cleanup {
    unset a z
} -result {wrong # args: should be "set varName ?newValue?"
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"
    invoked from within
"$z 2<1 {set a 1} else {set}"}
test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} -setup {
test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} {
    set a {}
} -body {
    set z if
    set a {}
    $z 2<1 {set a 1} else {set a 2} or something
    catch {$z 2<1 {set a 1} else {set a 2} or something} msg 
} -returnCodes error -cleanup {
    unset a z
} -result {wrong # args: extra words after "else" clause in "if" command}
    set msg
} {wrong # args: extra words after "else" clause in "if" command}
# The following test also checks whether contained loops and other
# commands are properly relocated because a short jump must be replaced
# by a "long distance" one.
test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} -setup {
test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} {
    set z if
    catch {unset i}
    set a {}
} -body {
    set z if
    $z 1>2 {
	set a 1
	while {$a != "xxx"} {
	    break;
	    while {$i >= 0} {
		$z {[string compare $a "bar"] < 0} {
		    set i $i
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
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
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







-
-
-
+
-
-
+

-
+
-
-

+

-
-
-
+
-
-
-
+
+
-
-

-
-
-
-
-
-
-
+
+
+
+
+
-
-

+

-
-
-
+
-
-
-
+
+
-
-

+

-
-
-
+
-
-
-
+
+


-
-
-
-
+

-
+

-
+
-
-



-
+















-
-
-
-
-
+
+







		    set i [lindex $s $i]
		}
		set i [expr $i-1]
	    }
	}
	set a 9
    }
    return $a
} -cleanup {
    unset a z
    set a
    unset -nocomplain i
} -result 9
} 9

test if-8.1 {if cmd with computed command names: "if" command result} -setup {
test if-8.1 {if cmd with computed command names: "if" command result} {
    set a {}
} -body {
    set z if
    set a {}
    set a [$z 3<4 {set i 27}]
    return $a
} -cleanup {
    unset a z
    set a
    unset -nocomplain i
} -result 27
test if-8.2 {if cmd with computed command names: "if" command result} -setup {
} 27
test if-8.2 {if cmd with computed command names: "if" command result} {
    set a {}
} -body {
    set z if
    set a [$z 3>4 {set i 27}]
    return $a
} -cleanup {
    unset a z
    unset -nocomplain i
} -result {}
test if-8.3 {if cmd with computed command names: "if" command result} -setup {
    set a {}
    set a [$z 3>4 {set i 27}]
    set a
} {}
test if-8.3 {if cmd with computed command names: "if" command result} {
    set a {}
} -body {
    set z if
    set a {}
    set a [$z 0 {set i 1} elseif 1 {set i 2}]
    return $a
} -cleanup {
    unset a z
    set a
    unset -nocomplain i
} -result 2
test if-8.4 {if cmd with computed command names: "if" command result} -setup {
} 2
test if-8.4 {if cmd with computed command names: "if" command result} {
    set a {}
} -body {
    set z if
    set a {}
    set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
    return $a
} -cleanup {
    unset a z
    set a
    unset -nocomplain i
} -result 4
test if-8.5 {if cmd with computed command names: return value} -body {
} 4
test if-8.5 {if cmd with computed command names: return value} {
    set z if
    $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
} -cleanup {
    unset z
    unset -nocomplain a
} -result def
} def

test if-9.1 {if cmd with namespace qualifiers} -body {
test if-9.1 {if cmd with namespace qualifiers} {
    ::if {1} {set x 4}
} -cleanup {
} 4
    unset x
} -result 4

# Test for incorrect "double evaluation semantics"

test if-10.1 {delayed substitution of then body} -body {
test if-10.1 {delayed substitution of then body} {
    set j 0
    set if if
    # this is not compiled
    $if {[incr j] == 1} "
       set result $j
    "
    # this will be compiled
    proc p {} {
	set j 0
	if {[incr j]} "
	    set result $j
	"
	set result
    }
    append result [p]
} -cleanup {
    unset j if result
    rename p {}
} -result {00}
test if-10.2 {delayed substitution of elseif expression} -body {
} {00}
test if-10.2 {delayed substitution of elseif expression} {
    set j 0
    set if if
    # this is not compiled
    $if {[incr j] == 0} {
       set result badthen
    } elseif "$j == 1" {
       set result badelseif
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
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












-
-
-
-
-
+
+


















-
-
-
-
-
+
+






-
-
-
-
-
+
+
+




-
-
-
+
















-
+
-
-
-
+
+




-
-
-
-
-
	    set result badelseif
	} else {
	    set result 0
	}
	set result
    }
    append result [p]
} -cleanup {
    unset j if result
    rename p {}
} -result {00}
test if-10.3 {delayed substitution of elseif body} -body {
} {00}
test if-10.3 {delayed substitution of elseif body} {
    set j 0
    set if if
    # this is not compiled
    $if {[incr j] == 0} {
       set result badthen
    } elseif {1} "
       set result $j
    "
    # this will be compiled
    proc p {} {
	set j 0
	if {[incr j] == 0} {
	    set result badthen
	} elseif {1} "
	    set result $j
	"
    }
    append result [p]
} -cleanup {
    unset j if result
    rename p {}
} -result {00}
test if-10.4 {delayed substitution of else body} -body {
} {00}
test if-10.4 {delayed substitution of else body} {
    set j 0
    if {[incr j] == 0} {
       set result badthen
    } else "
       set result $j
    "
    return $result
} -cleanup {
    unset j result
} -result {0}
test if-10.5 {substituted control words} -body {
    set result
} {0}
test if-10.5 {substituted control words} {
    set then then; proc then {} {return badthen}
    set else else; proc else {} {return badelse}
    set elseif elseif; proc elseif {} {return badelseif}
    list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
} -cleanup {
    unset then else elseif a
} -result {0 ok}
} {0 ok}
test if-10.6 {double invocation of variable traces} -body {
    set iftracecounter 0
    proc iftraceproc {args} {
       upvar #0 iftracecounter counter
       set argc [llength $args]
       set extraargs [lrange $args 0 [expr {$argc - 4}]]
       set name [lindex $args [expr {$argc - 3}]]
       upvar 1 $name var
       if {[incr counter] % 2 == 1} {
           set var "$counter oops [concat $extraargs]"
       } else {
           set var "$counter + [concat $extraargs]"
       }
    }
    trace variable iftracevar r [list iftraceproc 10]
    list [catch {if "$iftracevar + 20" {}} a] $a \
        [catch {if "$iftracevar + 20" {}} b] $b
        [catch {if "$iftracevar + 20" {}} b] $b \
} -cleanup {
    unset iftracevar iftracecounter a b
} -match glob -result {1 {*} 0 {}}
        [unset iftracevar iftracecounter]
} -match glob -result {1 {*} 0 {} {}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/incr-old.test.

9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24







-
-
+
+







# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

catch {unset x}

test incr-old-1.1 {basic incr operation} {
    set x 23

Changes to tests/incr.test.

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
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


-
-
-
+
+
+




-
-
+
+

-
-
+
+



-
+
-
-
-
-
-
-
-
+
+
+

-
-
-
+
+
+




-
+

-
-
+
+
+




-
-
+
+
-


-
-
-
+
+
+
-


-
+










+








+







# Commands covered:  incr
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

unset -nocomplain x i
# Basic "incr" operation.
proc readonly varName {
    upvar 1 $varName var
    trace add variable var write \
	{apply {{args} {error "variable is read-only"}}}
}

# Basic "incr" operation.

catch {unset x}
catch {unset i}

test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body {
    incr
} -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.1 {TclCompileIncrCmd: missing variable name} {
    list [catch {incr} msg] $msg
} {1 {wrong # args: should be "incr varName ?increment?"}}
test incr-1.2 {TclCompileIncrCmd: simple variable name} {
    set i 10
    list [incr i] $i
} {11 11}
test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body {
test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
    set i 10
    incr "i"xxx
} -returnCodes error -result {extra characters after close-quote}
    catch {incr "i"xxx} msg
    set msg
} {extra characters after close-quote}
test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
    set i 17
    list [incr "i"] $i
} {18 18}
test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup {
    unset -nocomplain {a simple var}
test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
    catch {unset {a simple var}}
} -body {
    set {a simple var} 27
    list [incr {a simple var}] ${a simple var}
} -result {28 28}
test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup {
    unset -nocomplain a
} {28 28}
test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
    catch {unset a}
} -body {
    set a(foo) 37
    list [incr a(foo)] $a(foo)
} -result {38 38}
} {38 38}
test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
    set x "i"
    set i 77
    list [incr $x 2] $i
} {79 79}
test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
    set x "i"
    set i 77
    list [incr [set x] +2] $i
} {79 79}

test incr-1.9 {TclCompileIncrCmd: increment given} {
    set i 10
    list [incr i +07] $i
} {17 17}
test incr-1.10 {TclCompileIncrCmd: no increment given} {
    set i 10
    list [incr i] $i
} {11 11}

test incr-1.11 {TclCompileIncrCmd: simple global name} {
    proc p {} {
        global i
        set i 54
        incr i
    }
    p
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
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







-
-
+
+
-

-
-
-
-
-
-
+
+
+
+
+
+
-


-
-
-
-
+
+
+
+
+










-
-
+
+



















-
+

-
-
-
+
+
+
+
+

-
-
+
+
+
+
+










+

-
+

-
-
-
+



+
-
+

-
-
-
+
+
+
+

-


-
-
+
+


-




-
+

+
+
+
-
+

-
-
+
+





-
+


-
-
+
+
+





-
+
-
-

+


-
-
+
+
-
-

+


-
+












+










+







        set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
        set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
        # now increment the last one (local var index > 255)
        incr z9
    }
    260locals
} {1}
test incr-1.15 {TclCompileIncrCmd: variable is array} -setup {
    unset -nocomplain a
test incr-1.15 {TclCompileIncrCmd: variable is array} {
    catch {unset a}
} -body {
    set a(foo) 27
    incr a(foo) 11
} -cleanup {
    unset -nocomplain a
} -result 38
test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup {
    unset -nocomplain a
    set x [incr a(foo) 11]
    catch {unset a}
    set x
} 38
test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
    catch {unset a}
} -body {
    set i 5
    set a(foo5) 27
    incr a(foo$i) 11
} -cleanup {
    unset -nocomplain a
} -result 38
    set x [incr a(foo$i) 11]
    catch {unset a}
    set x
} 38

test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
    set i 5
    incr i 123
} 128
test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
    set i 5
    incr i -100
} -95
test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
    set i 5
    catch {incr i [set]} -> opts
    dict get $opts -errorinfo
    catch {incr i [set]} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test incr-1.20 {TclCompileIncrCmd: increment given, in quotes} {
    set i 25
    incr i "-100"
} -75
test incr-1.21 {TclCompileIncrCmd: increment given, in braces} {
    set i 24
    incr i {126}
} 150
test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
    set i 5
    incr i 200000
} 200005
test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
    set i 25
    incr i 0o00012345     ;# an octal literal
} 5374
test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body {
test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
    set i 25
    incr i 1a
} -returnCodes error -result {expected integer but got "1a"}
test incr-1.25 {TclCompileIncrCmd: too many arguments} -body {
    catch {incr i 1a} msg
    set msg
} {expected integer but got "1a"}

test incr-1.25 {TclCompileIncrCmd: too many arguments} {
    set i 10
    incr i 10 20
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
    catch {incr i 10 20} msg
    set msg
} {wrong # args: should be "incr varName ?increment?"}


test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
    unset -nocomplain {"foo}
    incr {"foo}
} 1
test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
    list [catch {incr [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}}
test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    readonly x
    trace var x w readonly
    list [catch {incr x 1} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset -nocomplain x
} -result {1 {can't set "x": variable is read-only} {*variable is read-only
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"incr x 1"}}
catch {unset x}
test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
    set x "  -  "
    incr x 1
} -returnCodes error -result {expected integer but got "  -  "}
test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
    list [catch {incr x 1} msg] $msg
} {1 {expected integer but got "  -  "}}

test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
    catch {unset array}
} -body {
    set array(\$foo) 4
    incr {array($foo)}
} -result 5

} 5
    
# Check "incr" and computed command names.

unset -nocomplain x i
test incr-2.0 {incr and computed command names} {
    set i 5
    set z incr
    $z i -1
    return $i
    set i
} 4
catch {unset x}
catch {unset i}

test incr-2.1 {incr command (not compiled): missing variable name} -body {
test incr-2.1 {incr command (not compiled): missing variable name} {
    set z incr
    $z
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
    list [catch {$z} msg] $msg
} {1 {wrong # args: should be "incr varName ?increment?"}}
test incr-2.2 {incr command (not compiled): simple variable name} {
    set z incr
    set i 10
    list [$z i] $i
} {11 11}
test incr-2.3 {incr command (not compiled): error compiling variable name} -body {
test incr-2.3 {incr command (not compiled): error compiling variable name} {
    set z incr
    set i 10
    $z "i"xxx
} -returnCodes error -result {extra characters after close-quote}
    catch {$z "i"xxx} msg
    set msg
} {extra characters after close-quote}
test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
    set z incr
    set i 17
    list [$z "i"] $i
} {18 18}
test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup {
test incr-2.5 {incr command (not compiled): simple variable name in braces} {
    unset -nocomplain {a simple var}
} -body {
    set z incr
    catch {unset {a simple var}}
    set {a simple var} 27
    list [$z {a simple var}] ${a simple var}
} -result {28 28}
test incr-2.6 {incr command (not compiled): simple array variable name} -setup {
} {28 28}
test incr-2.6 {incr command (not compiled): simple array variable name} {
    unset -nocomplain a
} -body {
    set z incr
    catch {unset a}
    set a(foo) 37
    list [$z a(foo)] $a(foo)
} -result {38 38}
} {38 38}
test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
    set z incr
    set x "i"
    set i 77
    list [$z $x 2] $i
} {79 79}
test incr-2.8 {incr command (not compiled): non-simple (computed) variable name} {
    set z incr
    set x "i"
    set i 77
    list [$z [set x] +2] $i
} {79 79}

test incr-2.9 {incr command (not compiled): increment given} {
    set z incr
    set i 10
    list [$z i +07] $i
} {17 17}
test incr-2.10 {incr command (not compiled): no increment given} {
    set z incr
    set i 10
    list [$z i] $i
} {11 11}

test incr-2.11 {incr command (not compiled): simple global name} {
    proc p {} {
	set z incr
        global i
        set i 54
        $z i
    }
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
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







-
+
-
-

+

-
-
-
-
-
+
+
+
+
+
-
-

+


-
-
-
-
+
+
+
+
+













-
-
+
+







        set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
        set z5 0; set z6 0; set z7 0; set z8 0; set z9 0
        # now increment the last one (local var index > 255)
        $z z9
    }
    260locals
} {1}
test incr-2.15 {incr command (not compiled): variable is array} -setup {
test incr-2.15 {incr command (not compiled): variable is array} {
    unset -nocomplain a
} -body {
    set z incr
    catch {unset a}
    set a(foo) 27
    $z a(foo) 11
} -cleanup {
    unset -nocomplain a
} -result 38
test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup {
    set x [$z a(foo) 11]
    catch {unset a}
    set x
} 38
test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
    unset -nocomplain a
} -body {
    set z incr
    catch {unset a}
    set i 5
    set a(foo5) 27
    $z a(foo$i) 11
} -cleanup {
    unset -nocomplain a
} -result 38
    set x [$z a(foo$i) 11]
    catch {unset a}
    set x
} 38

test incr-2.17 {incr command (not compiled): increment given, simple int} {
    set z incr
    set i 5
    $z i 123
} 128
test incr-2.18 {incr command (not compiled): increment given, simple int} {
    set z incr
    set i 5
    $z i -100
} -95
test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body {
    set z incr
    set i 5
    catch {$z i [set]} -> opts
    dict get $opts -errorinfo
    catch {$z i [set]} msg
    set ::errorInfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test incr-2.20 {incr command (not compiled): increment given, in quotes} {
    set z incr
    set i 25
    $z i "-100"
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
524
525
526

527
528
529
530
531
532
533
534
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
524












-
+


-
-
-
+
+
+
+
+


-
-
-
+
+
+
+
+
+

-


-
+








+

-
+

-
-
-
+



+
-
+


-
-
+
+














-
-
-
-
-
-
-
-
-
-
-
-

















-
+



-
-
-
-
-
    $z i 200000
} 200005
test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
    set z incr
    set i 25
    $z i 0o00012345     ;# an octal literal
} 5374
test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body {
test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
    set z incr
    set i 25
    $z i 1a
} -returnCodes error -result {expected integer but got "1a"}
test incr-2.25 {incr command (not compiled): too many arguments} -body {
    catch {$z i 1a} msg
    set msg
} {expected integer but got "1a"}

test incr-2.25 {incr command (not compiled): too many arguments} {
    set z incr
    set i 10
    $z i 10 20
} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup {
    catch {$z i 10 20} msg
    set msg
} {wrong # args: should be "incr varName ?increment?"}


test incr-2.26 {incr command (not compiled): runtime error, bad variable name} {
    unset -nocomplain {"foo}
} -body {
    set z incr
    $z {"foo}
} -result 1
} 1
test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
    set z incr
    list [catch {$z [set]} msg] $msg $::errorInfo
} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}}
test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
    set z incr
    proc readonly args {error "variable is read-only"}
    set x 123
    readonly x
    trace var x w readonly
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -cleanup {
    unset -nocomplain x
} -result {1 {can't set "x": variable is read-only} {*variable is read-only
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
catch {unset x}
test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
    set z incr
    set x "  -  "
    $z x 1
} -returnCodes error -result {expected integer but got "  -  "}
    list [catch {$z x 1} msg] $msg
} {1 {expected integer but got "  -  "}}
test incr-2.30 {incr command (not compiled): bad increment} {
    set z incr
    set x 0
    list [catch {$z x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
    (reading increment)
    invoked from within
"$z x 1a"}}
test incr-2.31 {incr command (compiled): bad increment} {
    list [catch {incr x 1a} msg] $msg $::errorInfo
} {1 {expected integer but got "1a"} {expected integer but got "1a"
    (reading increment)
    invoked from within
"incr x 1a"}}
test incr-2.32 {incr command (compiled): bad pure list increment} {
    list [catch {incr x [list 1 2]} msg] $msg $::errorInfo
} {1 {expected integer but got "1 2"} {expected integer but got "1 2"
    (reading increment)
    invoked from within
"incr x [list 1 2]"}}
test incr-2.33 {incr command (compiled): bad pure dict increment} {
    list [catch {incr x [dict create 1 2]} msg] $msg $::errorInfo
} {1 {expected integer but got "1 2"} {expected integer but got "1 2"
    (reading increment)
    invoked from within
"incr x [dict create 1 2]"}}

test incr-3.1 {increment by wide amount: bytecode route} {
    set x 0
    incr x 123123123123
} 123123123123
test incr-3.2 {increment by wide amount: command route} {
    set z incr
    set x 0
    $z x 123123123123
} 123123123123

test incr-4.1 {increment non-existing array element [Bug 1445454]} -body {
    proc x {} {incr a(1)}
    x
} -cleanup {
    rename x {}
} -result 1


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/indexObj.test.

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
1


2
3
4
5
6
7


8
9
10


11
12
13
14
15



16


17
18
19
20
21
22
23
24

-
-
+
+




-
-
+
+

-
-
+
+



-
-
-

-
-
+







# This file is a Tcl script to test out the the procedures in file
# tkIndexObj.c, which implement indexed table lookups.  The tests here are
# organized in the standard fashion for Tcl tests.
# tkIndexObj.c, which implement indexed table lookups.  The tests here
# are organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testparseargs [llength [info commands testparseargs]]


test indexObj-1.1 {exact match} testindexobj {
    testindexobj 1 1 xyz abc def xyz alm
} {2}
test indexObj-1.2 {exact match} testindexobj {
    testindexobj 1 1 abc abc def xyz alm
} {0}
test indexObj-1.3 {exact match} testindexobj {
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
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







-
-
+
+

















-
+







test indexObj-4.1 {free old internal representation} testindexobj {
    set x {a b}
    lindex $x 1
    testindexobj 1 1 $x abc def {a b} zzz
} {2}

test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj {
    testwrongnumargs 1 "?-switch?" mycmd
} "wrong # args: should be \"mycmd ?-switch?\""
    testwrongnumargs 1 "?option?" mycmd
} "wrong # args: should be \"mycmd ?option?\""
test indexObj-5.2 {Tcl_WrongNumArgs} testindexobj {
    testwrongnumargs 2 "bar" mycmd foo
} "wrong # args: should be \"mycmd foo bar\""
test indexObj-5.3 {Tcl_WrongNumArgs} testindexobj {
    testwrongnumargs 0 "bar" mycmd foo
} "wrong # args: should be \"bar\""
test indexObj-5.4 {Tcl_WrongNumArgs} testindexobj {
    testwrongnumargs 0 "" mycmd foo
} "wrong # args: should be \"\""
test indexObj-5.5 {Tcl_WrongNumArgs} testindexobj {
    testwrongnumargs 1 "" mycmd foo
} "wrong # args: should be \"mycmd\""
test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
    testwrongnumargs 2 "" mycmd foo
} "wrong # args: should be \"mycmd foo\""
# Contrast this with test proc-3.6; they have to be like this because
# of [Bug 1066837] so Itcl won't break.
test indexObj-5.7 {Tcl_WrongNumArgs} {testindexobj obsolete} {
test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj {
    testwrongnumargs 2 "fee fi" "fo fum" foo bar
} "wrong # args: should be \"fo fum foo fee fi\""

test indexObj-6.1 {Tcl_GetIndexFromObjStruct} testindexobj {
    set x a
    testgetindexfromobjstruct $x 0
} "wrong # args: should be \"testgetindexfromobjstruct a 0\""
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
124
125
126
127
128
129
130

























131
132
133
134
135
136
137







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







} "wrong # args: should be \"testgetindexfromobjstruct c 1\""
test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj {
    set x c
    testgetindexfromobjstruct $x 1
    testgetindexfromobjstruct $x 1
} "wrong # args: should be \"testgetindexfromobjstruct c 1\""

test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
    testparseargs
} {0 1 testparseargs}
test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs {
    testparseargs -bool
} {1 1 testparseargs}
test indexObj-7.3 {Tcl_ParseArgsObjv} testparseargs {
    testparseargs -bool bar
} {1 2 {testparseargs bar}}
test indexObj-7.4 {Tcl_ParseArgsObjv} testparseargs {
    testparseargs bar
} {0 2 {testparseargs bar}}
test indexObj-7.5 {Tcl_ParseArgsObjv} -constraints testparseargs -body {
    testparseargs -help
} -returnCodes error -result {Command-specific options:
 -bool: booltest
 --:    Marks the end of the options
 -help: Print summary of command-line options and abort}
test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
    testparseargs -- -bool -help
} {0 3 {testparseargs -bool -help}}
test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs {
    testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/info.test.

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
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







-
-
+
+


-
-
-











-
+







# Copyright (c) 2006      ActiveState
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# DO NOT DELETE THIS LINE

if {{::tcltest} ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]

# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.

catch {namespace delete test_ns_info1 test_ns_info2}

namespace eval test_ns_info1 {
    namespace export *
    proc p {x} {return "x=$x"}
    proc q {{y 27} {z {}}} {return "y=$y"}
}


test info-1.1 {info args option} {
    proc t1 {a bbb c} {return foo}
    info args t1
} {a bbb c}
test info-1.2 {info args option} {
    proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
    info a t1
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
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







-
+








-
-
+
+












-
-
+
+




-
+


-
-
-
-
+
+
+
+




-
+





-
-
+
+


+
-
+
-
-
+







        list [info body p] [info body q]
    }
} {{return "x=$x"} {return "y=$y"}}
# Prior to 8.3.0 this would cause a crash because [info body]
# would return the bytecompiled version of foo, which the catch
# would then try and eval out of the foo context, accessing
# compiled local indices
test info-2.5 {info body option, returning bytecompiled bodies} -body {
test info-2.5 {info body option, returning bytecompiled bodies} {
    catch {unset args}
    proc foo {args} {
	foreach v $args {
	    upvar $v var
	    return "variable $v existence: [info exists var]"
	}
    }
    foo a
    eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
    list [catch [info body foo] msg] $msg
} {1 {can't read "args": no such variable}}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
    proc foo args [list subst bar]
    list [string bytelength [info body foo]] \
	    [foo; string bytelength [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cmdc]
    expr {$z-$x}
    set z [info cm]
    expr $z-$x
}
test info-3.1 {info cmdcount compiled} {
    testinfocmdcount
} 4
test info-3.2 {info cmdcount evaled} -body {
test info-3.2 {info cmdcount evaled} {
    set x [info cmdcount]
    set y 12345
    set z [info cmdc]
    expr {$z-$x}
} -cleanup {unset x y z} -result 4
test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
    set z [info cm]
    expr $z-$x
} 4
test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 4
test info-3.4 {info cmdcount option} -body {
    info cmdcount 1
} -returnCodes error -result {wrong # args: should be "info cmdcount"}

test info-4.1 {info commands option} -body {
test info-4.1 {info commands option} {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info commands] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
            [string match {* set *} $x] [string match {* list *} $x]
} -cleanup {unset x} -result {1 1 1 1}
test info-4.2 {info commands option} -body {
} {1 1 1 1}
test info-4.2 {info commands option} {
    proc t1 {} {}
    rename t1 {}
    set x [info comm]
    string match {* t1 *} \
    string match {* t1 *} $x
	[info comm]
} -result 0
} 0
test info-4.3 {info commands option} {
    proc _t1_ {} {}
    proc _t2_ {} {}
    info commands _t1_
} _t1_
test info-4.4 {info commands option} {
    proc _t1_ {} {}
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
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







-
+



-
-
-
+
+
+


-
-
+
+



-
-
-
+
+
+




-
+












-
+



-
+


-
+



-
+







+

-
+


-
-
-
+
+
+

-
+




-
+





-
+







    info complete {[a [b]}
} 0

test info-6.1 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    info default t1 a value
} 0
test info-6.2 {info default option} -body {
test info-6.2 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    set value 12345
    info d t1 a value
    return $value
} -cleanup {unset value} -result {}
test info-6.3 {info default option} -body {
    set value
} {}
test info-6.3 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    info default t1 c value
} -cleanup {unset value} -result 1
test info-6.4 {info default option} -body {
} 1
test info-6.4 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    set value 12345
    info default t1 c value
    return $value
} -cleanup {unset value} -result d
test info-6.5 {info default option} -body {
    set value
} d
test info-6.5 {info default option} {
    proc t1 {a b {c d} {e "long default value"}} {}
    set value 12345
    set x [info default t1 e value]
    list $x $value
} -cleanup {unset x value} -result {1 {long default value}}
} {1 {long default value}}
test info-6.6 {info default option} -returnCodes error -body {
    info default a b
} -result {wrong # args: should be "info default procname arg varname"}
test info-6.7 {info default option} -returnCodes error -body {
    info default _nonexistent_ a b
} -result {"_nonexistent_" isn't a procedure}
test info-6.8 {info default option} -returnCodes error -body {
    proc t1 {a b} {}
    info default t1 x value
} -result {procedure "t1" doesn't have an argument "x"}
test info-6.9 {info default option} -returnCodes error -setup {
    catch {unset a}
} -cleanup {unset a} -body {
} -body {
    set a(0) 88
    proc t1 {a b} {}
    info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
} -returnCodes error -result {couldn't store default value in variable "a"}
test info-6.10 {info default option} -setup {
    catch {unset a}
} -cleanup {unset a} -body {
} -body {
    set a(0) 88
    proc t1 {{a 18} b} {}
    info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
} -returnCodes error -result {couldn't store default value in variable "a"}
test info-6.11 {info default option} {
    catch {namespace delete test_ns_info2}
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        list [info default p x foo] $foo [info default q y bar] $bar
    }
} {0 {} 1 27}
catch {unset a}

test info-7.1 {info exists option} -body {
test info-7.1 {info exists option} {
    set value foo
    info exists value
} -cleanup {unset value} -result 1

test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body {
} 1
catch {unset _nonexistent_}
test info-7.2 {info exists option} {
    info exists _nonexistent_
} -result 0
} 0
test info-7.3 {info exists option} {
    proc t1 {x} {return [info exists x]}
    t1 2
} 1
test info-7.4 {info exists option} -body {
test info-7.4 {info exists option} {
    proc t1 {x} {
        global _nonexistent_
        return [info exists _nonexistent_]
    }
    t1 2
} -setup {unset -nocomplain _nonexistent_} -result 0
} 0
test info-7.5 {info exists option} {
    proc t1 {x} {
        set y 47
        return [info exists y]
    }
    t1 2
} 1
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
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







-
+






-
-
+
+



-
+



-
+


-
+


-
+







test info-7.8 {info exists option} -body {
    info exists
} -returnCodes error -result {wrong # args: should be "info exists varName"}
test info-7.9 {info exists option} -body {
    info exists 1 2
} -returnCodes error -result {wrong # args: should be "info exists varName"}

test info-8.1 {info globals option} -body {
test info-8.1 {info globals option} {
    set x 1
    set y 2
    set value 23
    set a " [info globals] "
    list [string match {* x *} $a] [string match {* y *} $a] \
            [string match {* value *} $a] [string match {* _foobar_ *} $a]
} -cleanup {unset x y value a} -result {1 1 1 0}
test info-8.2 {info globals option} -body {
} {1 1 1 0}
test info-8.2 {info globals option} {
    set _xxx1 1
    set _xxx2 2
    lsort [info g _xxx*]
} -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2}
} {_xxx1 _xxx2}
test info-8.3 {info globals option} -returnCodes error -body {
    info globals 1 2
} -result {wrong # args: should be "info globals ?pattern?"}
test info-8.4 {info globals option: may have leading namespace qualifiers} -body {
test info-8.4 {info globals option: may have leading namespace qualifiers} {
    set x 0
    list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
} -cleanup {unset x} -result {x {} x x x}
} {x {} x x x}
test info-8.5 {info globals option: only return existing global variables} {
    -setup {
	unset -nocomplain ::NO_SUCH_VAR
	catch {unset ::NO_SUCH_VAR}
	proc evalInProc script {eval $script}
    }
    -body {
	evalInProc {global NO_SUCH_VAR; info globals NO_SUCH_VAR}
    }
    -cleanup {
	rename evalInProc {}
354
355
356
357
358
359
360
361
362


363
364

365

366
367
368
369
370
371
372
352
353
354
355
356
357
358


359
360

361
362

363
364
365
366
367
368
369
370







-
-
+
+
-

+
-
+







    proc t1 {} {info level -1}
    t1
} -returnCodes error -result {bad level "-1"}
test info-9.9 {info level option} -body {
    proc t1 {x} {info level $x}
    t1 -3
} -returnCodes error -result {bad level "-3"}
test info-9.10 {info level option, namespaces} -body {
    namespace eval t {info level 0}
test info-9.10 {info level option, namespaces} {
    set msg [namespace eval t {info level 0}]
} -cleanup {
    namespace delete t
    set msg
} -result {namespace eval t {info level 0}}
} {namespace eval t {info level 0}}
test info-9.11 {info level option, aliases} -constraints knownBug -setup {
    proc w {x y z} {info level 0}
    interp alias {} a {} w a b
} -body {
    a c
} -cleanup {
    rename a {}
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
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







-
+


-
-
-
-
-
+
+
+
+
+

-
+










-
+







    set tcl_library 12345
    info library
} {12345}
test info-10.3 {info library option} -body {
    unset tcl_library
    info library
} -returnCodes error -result {no library has been specified for Tcl}
set tcl_library $savedLibrary; unset savedLibrary
set tcl_library $savedLibrary

test info-11.1 {info loaded option} -body {
    info loaded a b c
} -returnCodes error -result {wrong # args: should be "info loaded ?interp? ?packageName?"}
test info-11.2 {info loaded option} -body {
    info loaded {}; info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
    info loaded a b
} -returnCodes error -result {wrong # args: should be "info loaded ?interp?"}
test info-11.2 {info loaded option} {
    list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
} {0 1 {could not find interpreter "gorp"}}

test info-12.1 {info locals option} -body {
test info-12.1 {info locals option} {
    set a 22
    proc t1 {x y} {
        set b 13
        set c testing
        global a
	global aa
	set aa 23
        return [info locals]
    }
    lsort [t1 23 24]
} -cleanup {unset a aa} -result {b c x y}
} {b c x y}
test info-12.2 {info locals option} {
    proc t1 {x y} {
        set xx1 2
        set xx2 3
        set y 4
        return [info loc x*]
    }
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
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







-
+


-
+









-
+


-
+





-
+
















-
+







    t1
} {a}

test info-13.1 {info nameofexecutable option} -returnCodes error -body {
    info nameofexecutable foo
} -result {wrong # args: should be "info nameofexecutable"}

test info-14.1 {info patchlevel option} -body {
test info-14.1 {info patchlevel option} {
    set a [info patchlevel]
    regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
} -cleanup {unset a} -result 1
} 1
test info-14.2 {info patchlevel option} -returnCodes error -body {
    info patchlevel a
} -result {wrong # args: should be "info patchlevel"}
test info-14.3 {info patchlevel option} -setup {
    set t $tcl_patchLevel
} -body {
    unset tcl_patchLevel
    info patchlevel
} -cleanup {
    set tcl_patchLevel $t; unset t
    set tcl_patchLevel $t
} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}

test info-15.1 {info procs option} -body {
test info-15.1 {info procs option} {
    proc t1 {} {}
    proc t2 {} {}
    set x " [info procs] "
    list [string match {* t1 *} $x] [string match {* t2 *} $x] \
            [string match {* _undefined_ *} $x]
} -cleanup {unset x} -result {1 1 0}
} {1 1 0}
test info-15.2 {info procs option} {
    proc _tt1 {} {}
    proc _tt2 {} {}
    lsort [info pr _tt*]
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
test info-15.3 {info procs option} -body {
    info procs 2 3
} -returnCodes error -result {wrong # args: should be "info procs ?pattern?"}
test info-15.4 {info procs option} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
        namespace import ::test_ns_info1::*
        proc r {} {}
        list [lsort [info procs]] [info procs p*]
        list [info procs] [info procs p*]
    }
} -result {{p q r} p}
test info-15.5 {info procs option with a proc in a namespace} -setup {
    catch {namespace delete test_ns_info2}
} -body {
    namespace eval test_ns_info2 {
	proc p1 { arg } {
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
618
619
620
621
622
623
624
625
626


627
628
629
630
631
632
633
634
635

636
637
638
639
640
641
642
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
618
619
620
621
622


623
624
625
626
627
628
629
630
631
632

633
634
635
636
637
638
639
640







-
+




-
-
+
+




-
+





-
+





-
+

-
+









-
+


-
+








-
-
+
+








-
+







    catch {source ~_nobody_/foo}
    file tail [info script]
} "info.test"
test info-16.5 {resetting "info script" after errors} {
    catch {source _nonexistent_}
    file tail [info script]
} "info.test"
test info-16.6 {info script option} -body {
test info-16.6 {info script option} {
    set script [info script]
    list [file tail [info script]] \
	    [info script newname.txt] \
	    [file tail [info script $script]]
} -result [list info.test newname.txt info.test] -cleanup {unset script}
test info-16.7 {info script option} -body {
} [list info.test newname.txt info.test]
test info-16.7 {info script option} {
    set script [info script]
    info script newname.txt
    list [source $gorpfile] [file tail [info script]] \
	    [file tail [info script $script]]
} -result [list $gorpfile newname.txt info.test] -cleanup {unset script}
} [list $gorpfile newname.txt info.test]
removeFile gorp.info
set gorpfile [makeFile {list [info script] [info script foo.bar]} gorp.info]
test info-16.8 {info script option} {
    list [source $gorpfile] [file tail [info script]]
} [list [list $gorpfile foo.bar] info.test]
removeFile gorp.info; unset gorpfile
removeFile gorp.info

test info-17.1 {info sharedlibextension option} -returnCodes error -body {
    info sharedlibextension foo
} -result {wrong # args: should be "info sharedlibextension"}

test info-18.1 {info tclversion option} -body {
test info-18.1 {info tclversion option} {
    scan [info tclversion] "%d.%d%c" a b c
} -cleanup {unset -nocomplain a b c} -result 2
} 2
test info-18.2 {info tclversion option} -body {
    info t 2
} -returnCodes error -result {wrong # args: should be "info tclversion"}
test info-18.3 {info tclversion option} -body {
    unset tcl_version
    info tclversion
} -returnCodes error -setup {
    set t $tcl_version
} -cleanup {
    set tcl_version $t; unset t
    set tcl_version $t
} -result {can't read "tcl_version": no such variable}

test info-19.1 {info vars option} -body {
test info-19.1 {info vars option} {
    set a 1
    set b 2
    proc t1 {x y} {
        global a b
        set c 33
        return [info vars]
    }
    lsort [t1 18 19]
} -cleanup {unset a b} -result {a b c x y}
test info-19.2 {info vars option} -body {
} {a b c x y}
test info-19.2 {info vars option} {
    set xxx1 1
    set xxx2 2
    proc t1 {xxa y} {
        global xxx1 xxx2
        set c 33
        return [info vars x*]
    }
    lsort [t1 18 19]
} -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2}
} {xxa xxx1 xxx2}
test info-19.3 {info vars option} {
    lsort [info vars]
} [lsort [info globals]]
test info-19.4 {info vars option} -returnCodes error -body {
    info vars a b
} -result {wrong # args: should be "info vars ?pattern?"}
test info-19.5 {info vars with temporary variables} {
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
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
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
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
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
756

757
758
759
760
761
762
763

764
765

766
767
768





769
770
771
772
773
774
775







-
+















-



-
+


-
+


-
+


-
+


-
+




-

-
-
-
-
-
-
+
+
+
+
+
+

-
+
+
+

-
-
+
+

-
-
-
+
+
+
+
+

-
+

-



-















+
+
















-
+


-
+


-
+






-
+

-
+


-
-
-
-
-







    catch {namespace delete x}
} -body {
    namespace eval x info vars foo
} -cleanup {
    namespace delete x
} -result {}

set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isfinite isinf isnan isnormal isqrt issubnormal isunordered log log10 max min pow rand round sin sinh sqrt srand tan tanh wide}
set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide}
# Check whether the extra testing functions are defined...
if {!([catch {expr T1()} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} {
    set functions "T1 T2 T3 $functions"  ;# A lazy way of prepending!
}
test info-20.1 {info functions option} {info functions sin} sin
test info-20.2 {info functions option} {lsort [info functions]} $functions
test info-20.3 {info functions option} {
    lsort [info functions a*]
} {abs acos asin atan atan2}
test info-20.4 {info functions option} {
    lsort [info functions *tan*]
} {atan atan2 tan tanh}
test info-20.5 {info functions option} -returnCodes error -body {
    info functions raise an error
} -result {wrong # args: should be "info functions ?pattern?"}
unset functions msg

test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
    info
} -result {wrong # args: should be "info subcommand ?arg ...?"}
} -result {wrong # args: should be "info subcommand ?argument ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
    info gorp
} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "gorp": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
    info c
} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "c": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
    info l
} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "l": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
    info s
} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
} -result {unknown or ambiguous subcommand "s": must be args, body, cmdcount, commands, complete, default, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}

##
# ### ### ### ######### ######### #########
## info frame

## Helper
# For the more complex results we cut the file name down to remove path
# dependencies, and we use only part of the first line of the reported
# command. The latter is required because otherwise the whole test case may
# appear in some results, but the result is part of the testcase. An infinite
# string would be required to describe that. The cutting-down breaks this.

# For the more complex results we cut the file name down to remove
# path dependencies, and we use only part of the first line of the
# reported command. The latter is required because otherwise the whole
# test case may appear in some results, but the result is part of the
# testcase. An infinite string would be required to describe that. The
# cutting-down breaks this.
proc reduce {frame} {
    set cmd [dict get $frame cmd]
    set  pos [lsearch -exact $frame cmd]
    incr pos
    set  cmd [lindex $frame $pos]
    if {[regexp \n $cmd]} {
	dict set frame cmd \
	    [string range [lindex [split $cmd \n] 0] 0 end-4]
	set first [string range [lindex [split $cmd \n] 0] 0 end-4]
	set frame [lreplace $frame $pos $pos $first]
    }
    if {[dict exists $frame file]} {
	dict set frame file \
	    [file tail [dict get $frame file]]
    set pos [lsearch -exact $frame file]
    if {$pos >=0} {
	incr pos
	set tail  [file tail [lindex $frame $pos]]
	set frame [lreplace $frame $pos $pos $tail]
    }
    return $frame
    set frame
}

proc subinterp {} { interp create sub ; interp debug sub -frame 1;
    interp eval sub [list proc reduce [info args reduce] [info body reduce]]
}

## Helper
# Generate a stacktrace from the current location to top.  This code
# not only depends on the exact location of things, but also on the
# implementation of tcltest. Any changes and these tests will have to
# be updated.

proc etrace {} {
    set res {}
    set level [info frame]
    while {$level} {
	lappend res [list $level [reduce [info frame $level]]]
	incr level -1
    }
    return $res
}

##

test info-22.0 {info frame, levels} {!singleTestInterp} {
    info frame
} 7
test info-22.1 {info frame, bad level relative} {!singleTestInterp} {
    # catch is another level!, i.e. we have 8, not 7
    catch {info frame -8} msg
    set msg
} {bad level "-8"}
test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
    # catch is another level!, i.e. we have 8, not 7
    catch {info frame 9} msg
    set msg
} {bad level "9"}
test info-22.3 {info frame, current, relative} -match glob -body {
    info frame 0
} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
} -result {type source line 750 file * cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.4 {info frame, current, relative, nested} -match glob -body {
    set res [info frame 0]
} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res}
} -result {type source line 753 file * cmd {info frame 0} proc ::tcltest::RunTest}
test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body {
    reduce [info frame 7]
} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest}
} -result {type source line 756 file * cmd {info frame 7} proc ::tcltest::RunTest}
test info-22.6 {info frame, global, relative} {!singleTestInterp} {
    reduce [info frame -6]
} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
    reduce [info frame 1]
} {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
test info-22.8 {info frame, basic trace} -match glob -body {
test info-22.8 {info frame, basic trace} -constraints {!singleTestInterp} -match glob -body {
    join [lrange [etrace] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
unset -nocomplain msg










## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
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
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







-
+



-
+


-
-
+
+


-
+

-
+

+
+
+
+
+
+







    i eval {	set script {info frame}
		eval $script}
} -setup {interp create i} -cleanup {interp delete i} -result 2
test info-23.3 {eval'd info frame, literal} -match glob -body {
    eval {
	info frame 0
    }
} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest}
} -result {type source line 788 file * cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.4 {eval'd info frame, semi-dynamic} {
    eval info frame 0
} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body {
test info-23.5 {eval'd info frame, dynamic} {
    set script {info frame 0}
    eval $script
} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body {
} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
test info-23.6 {eval'd info frame, trace} -constraints {!singleTestInterp} -match glob -body {
    set script {etrace}
    join [lrange [eval $script] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
* {type source line 800 file info.test cmd {eval $script} proc ::tcltest::RunTest}}






## The line 1967 is off by 5 from the true value of 1972. This is a knownBug, see testcase 30.0
# -------------------------------------------------------------------------

# Procedures defined in scripts which are arguments to control
# structures (like 'namespace eval', 'interp eval', 'if', 'while',
# 'switch', 'catch', 'for', 'foreach', etc.) have no absolute
# location. The command implementations execute such scripts through
# Tcl_EvalObjEx. Flag 0 causes it to use the bytecode compiler. This
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
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







-
+













-
+








-
+





-
+












-
+







-
+





-
+













-
+
















-
+














-
+







    proc bar {} {info frame 0}
}

test info-24.0 {info frame, interaction, namespace eval} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 825 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 826 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

set flag 1
if {$flag} {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
}

test info-24.1 {info frame, interaction, if} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 839 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 840 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

set flag 1
while {$flag} {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
    set flag 0
};unset flag
}

test info-24.2 {info frame, interaction, while} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 853 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 854 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

catch {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
}

test info-24.3 {info frame, interaction, catch} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 867 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 868 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

foreach var val {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
    break
}; unset var
}

test info-24.4 {info frame, interaction, foreach} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 880 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 881 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

for {} {1} {} {
    namespace eval foo {}
    proc ::foo::bar {} {info frame 0}
    break
}

test info-24.5 {info frame, interaction, for} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 895 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

namespace eval foo {}
set x foo
switch -exact -- $x {
    foo {
	proc ::foo::bar {} {info frame 0}
    }
}

test info-24.6.0 {info frame, interaction, switch, list body} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
    unset x
} -result {type source line 910 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 911 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

namespace eval foo {}
set x foo
switch -exact -- $x foo {
    proc ::foo::bar {} {info frame 0}
}

test info-24.6.1 {info frame, interaction, switch, multi-body} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
    unset x
} -result {type source line 926 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 927 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

namespace eval foo {}
set x foo
switch -exact -- $x [list foo {
    proc ::foo::bar {} {info frame 0}
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
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
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
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







-
+

-
+











-
+


-
+







-
+



-
+


-
+









-
+






-
+





-
+


-
+

-
+






-
+








-
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
+

-
-
+
+

-
+


-
-
+
+



-
+


-
+

-
+


-
-
+
+

-
+

-
-
+
+











-
+







namespace eval foo {}
dict for {k v} {foo bar} {
    proc ::foo::bar {} {info frame 0}
}

test info-24.7 {info frame, interaction, dict for} {
    reduce [foo::bar]
} {type source line 955 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 956 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo; unset k v
namespace delete foo

# -------------------------------------------------------------------------

namespace eval foo {}
set thedict {foo bar}
dict with thedict {
    proc ::foo::bar {} {info frame 0}
}

test info-24.8 {info frame, interaction, dict with} {
    reduce [foo::bar]
} {type source line 969 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 970 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo
unset thedict foo
unset thedict

# -------------------------------------------------------------------------

namespace eval foo {}
dict filter {foo bar} script {k v} {
    proc ::foo::bar {} {info frame 0}
    set x 1
}; unset k v x
}

test info-24.9 {info frame, interaction, dict filter} {
    reduce [foo::bar]
} {type source line 983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 984 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo
#unset x
unset x

# -------------------------------------------------------------------------

eval {
    proc bar {} {info frame 0}
}

test info-25.0 {info frame, proc in eval} {
    reduce [bar]
} {type source line 997 file info.test cmd {info frame 0} proc ::bar level 0}
} {type source line 998 file info.test cmd {info frame 0} proc ::bar level 0}
# Don't need to clean up yet...

proc bar {} {info frame 0}

test info-25.1 {info frame, regular proc} {
    reduce [bar]
} {type source line 1005 file info.test cmd {info frame 0} proc ::bar level 0}
} {type source line 1006 file info.test cmd {info frame 0} proc ::bar level 0}

rename bar {}

# -------------------------------------------------------------------------
# More info-30.x test cases at the end of the file.
test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body {
test info-30.0 {bs+nl in literal words} {
    if {1} {
	set res \
	    [reduce [info frame 0]];#1018
	    [reduce [info frame 0]];# 1019
    }
    return $res
    set res
    # This was reporting line 3 instead of the correct 4 because the
    # bs+nl combination is subst by the parser before the 'if'
    # command, and the bcc, see the word. Fixed by recording the
    # offsets of all bs+nl sequences in literal words, then using the
    # information in the bcc and other places to bump line numbers when
    # parsing over the location. Also affected: testcases 22.8 and 23.6.
} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} {type source line 1019 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

# -------------------------------------------------------------------------
# See 24.0 - 24.5 for similar situations, using literal scripts.

set body {set flag 0
    set a c
    set res [info frame 0]} ;# line 3!

test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable res {}}
test info-31.0 {ns eval, script in variable} {set res {}
    namespace eval foo $body
    return $foo::res
} -result {type eval line 3 cmd {info frame 0} level 0} -cleanup {
    catch {namespace delete foo}
}
test info-31.1 {if, script in variable} -cleanup {unset res a flag} -body {
    set res
} {type eval line 3 cmd {info frame 0} level 0}
catch {namespace delete foo}

test info-31.1 {if, script in variable} {
    if 1 $body
    return $res
} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
    set res
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}

test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body {
test info-31.1a {if, script in variable} {
    if 1 then $body
    return $res
} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
    set res
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}

test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body {
test info-31.2 {while, script in variable} {
    set flag 1
    while {$flag} $body
    return $res
} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
    set res
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}

# .3 - proc - scoping prevent return of result ...

test info-31.4 {foreach, script in variable} -cleanup {unset var res a flag} -body {
test info-31.4 {foreach, script in variable} {
    foreach var val $body
    set res
} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}

test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body {
test info-31.5 {for, script in variable} {
    set flag 1
    for {} {$flag} {} $body
    return $res
} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
    set res
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}

test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body {
test info-31.6 {eval, script in variable} {
    eval $body
    return $res
} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
    set res
} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}

# -------------------------------------------------------------------------

set body {
    foo {
	proc ::foo::bar {} {info frame 0}
    }
}

namespace eval foo {}
set x foo
switch -exact -- $x $body; unset body
switch -exact -- $x $body

test info-31.7 {info frame, interaction, switch, dynamic} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
    unset x
} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
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
1152
1153
1154
1155
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
1152
1153
1154
1155
1156







-
+















-
+










-
+







    foo
    {proc bar {} {info frame 0}}
}
test info-33.0 {{*}, literal, direct} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 1116 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
    set flag 1
    if {*}{
	{$flag}
	{info frame 0}
    }
}
test info-33.1 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {type source line 1131 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------

namespace {*}"
    eval
    foo
    {proc bar {} {info frame 0}}
"
test info-33.2 {{*}, literal, direct} {
    reduce [foo::bar]
} {type source line 1144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 1145 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo

# -------------------------------------------------------------------------

namespace {*}"eval\nfoo\n{proc bar {} {info frame 0}}\n"

1167
1168
1169
1170
1171
1172
1173
1174

1175
1176
1177
1178
1179
1180
1181
1168
1169
1170
1171
1172
1173
1174

1175
1176
1177
1178
1179
1180
1181
1182







-
+







    if {*}"
	{1}
	{info frame 0}
    "
}
test info-33.3 {{*}, literal, simple, bytecompiled} {
    reduce [foo::bar]
} {type source line 1169 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 1170 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
1229
1230
1231
1232
1233
1234
1235
1236

1237
1238
1239
1240
1241
1242
1243
1230
1231
1232
1233
1234
1235
1236

1237
1238
1239
1240
1241
1242
1243
1244







-
+







    apply {
	{x y}
	{info frame 0}
    } 0 0
}
test info-35.0 {apply, literal} {
    reduce [foo]
} {type source line 1231 file info.test cmd {info frame 0} lambda {
} {type source line 1232 file info.test cmd {info frame 0} lambda {
	{x y}
	{info frame 0}
    } level 0}
rename foo {}

set lambda {
    {x y}
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
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







-
+

-
+














-
+

-
+












-
+

-
+





-
+
















-
-
+
+

-
+







namespace eval foo {}
proc foo::bar {} {
    dict for {k v} {foo bar} {
	set x [info frame 0]
    }
    set x
}
test info-36.0 {info frame, dict for, bcc} -body {
test info-36.0 {info frame, dict for, bcc} {
    reduce [foo::bar]
} -result {type source line 1259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 1260 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
    set x foo
    switch -exact -- $x {
	foo {set y [info frame 0]}
    }
    set y
}

test info-36.1.0 {switch, list literal, bcc} -body {
test info-36.1.0 {switch, list literal, bcc} {
    reduce [foo::bar]
} -result {type source line 1275 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 1276 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo

# -------------------------------------------------------------------------

namespace eval foo {}
proc foo::bar {} {
    set x foo
    switch -exact -- $x foo {set y [info frame 0]}
    set y
}

test info-36.1.1 {switch, multi-body literals, bcc} -body {
test info-36.1.1 {switch, multi-body literals, bcc} {
    reduce [foo::bar]
} -result {type source line 1291 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} {type source line 1292 file info.test cmd {info frame 0} proc ::foo::bar level 0}

namespace delete foo

# -------------------------------------------------------------------------

test info-37.0 {eval pure list, single line} -match glob -body {
test info-37.0 {eval pure list, single line} -constraints {!singleTestInterp} -match glob -body {
    # Basically, counting the newline in the word seen through $foo
    # doesn't really make sense. It makes a bit of sense if the word
    # would have been a string literal in the command list.
    #
    # Problem: At the point where we see the list elements we cannot
    # distinguish the two cases, thus we cannot switch between
    # count/not-count, it is has to be one or the other for all
    # cases. Of the two possibilities miguel convinced me that 'not
    # counting' is the more proper.
    set foo {b
	c}
    set cmd [list foreach $foo {x y} {
	set res [join [lrange [etrace] 0 2] \n]
	break
    }]
    eval $cmd
    return $res
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
    set res
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 2 cmd etrace proc ::tcltest::RunTest}
* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c}
* {type eval line 1 cmd foreac proc ::tcltest::RunTest}}

# -------------------------------------------------------------------------

# 6 cases.
## DV. direct-var          - unchanged
## DPV direct-proc-var     - ditto
## PPV proc-proc-var       - ditto
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


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
1439
1440
1441

1442
1443
1444
1445
1446

1447
1448
1449

1450
1451

1452

1453
1454
1455



1456

1457
1458
1459
1460

1461
1462
1463
1464
1465
1466




1467
1468

1469
1470
1471

1472
1473
1474


1475
1476

1477
1478
1479
1480
1481

1482
1483
1484
1485


1486
1487

1488
1489
1490


1491
1492

1493
1494
1495

1496
1497

1498
1499

1500

1501
1502

1503
1504
1505
1506

1507
1508

1509
1510

1511
1512
1513
1514
1515

1516
1517

1518
1519

1520
1521
1522
1523

1524
1525
1526

1527
1528

1529
1530
1531
1532
1533


1534
1535

1536
1537
1538
1539
1540
1541

1542
1543

1544
1545

1546
1547
1548
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
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
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
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

1439
1440
1441

1442

1443
1444

1445
1446
1447
1448
1449
1450
1451

1452




1453
1454
1455




1456
1457
1458
1459
1460

1461
1462
1463

1464
1465


1466
1467
1468

1469
1470
1471
1472
1473

1474
1475
1476


1477
1478
1479

1480
1481


1482
1483
1484

1485
1486
1487

1488
1489

1490

1491
1492

1493
1494

1495
1496
1497
1498

1499
1500

1501
1502

1503
1504
1505
1506
1507

1508
1509

1510
1511

1512
1513
1514
1515

1516
1517
1518

1519
1520

1521
1522
1523
1524


1525
1526
1527

1528
1529
1530
1531
1532
1533

1534
1535

1536
1537

1538
1539
1540
1541
1542

1543
1544
1545
1546

1547
1548
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
1596

1597
1598
1599
1600
1601
1602
1603
1604
1605

1606
1607
1608
1609
1610
1611
1612
1613







-
+

-
+
















-
+

-
-
+
+













-
+

-
-
-
+
+
+









-
-
-
-
-
-
-
-














-
-
-
+
+
+




-
+




-
+


-
+
-

+
-
+



+
+
+
-
+
-
-
-
-
+


-
-
-
-
+
+
+
+

-
+


-
+

-
-
+
+

-
+




-
+


-
-
+
+

-
+

-
-
+
+

-
+


-
+

-
+
-

+
-
+

-
+



-
+

-
+

-
+




-
+

-
+

-
+



-
+


-
+

-
+



-
-
+
+

-
+





-
+

-
+

-
+




-
+



-
+







-
+



-
+







-
+







-
+




-
-
-
+
+
+






-
-
+
+



-
+


-
+








-
+








test info-38.1 {location information for uplevel, dv, direct-var} -match glob -body {
    set script {
	set y DV.
	etrace
    }
    join [lrange [uplevel \#0 $script] 0 2] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
* {type source line 1362 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}}

# 38.2 moved to bottom to not disturb other tests with the necessary changes to this one.








test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match glob -body {
    set script {
	set y DPV
	etrace
    }
    join [lrange [control y $script] 0 3] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
* {type source line 1339 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1381 file info.test cmd {control y $script} proc ::tcltest::RunTest}}

# 38.4 moved to bottom to not disturb other tests with the necessary changes to this one.









test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body {
    join [lrange [datav] 0 4] \n
} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result {* {type source line 728 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type eval line 3 cmd etrace proc ::control}
* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1}
* {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}}
* {type source line 1339 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1354 file info.test cmd {control y $script} proc ::datav level 1}
* {type source line 1398 file info.test cmd datav proc ::tcltest::RunTest}}

# 38.6 moved to bottom to not disturb other tests with the necessary changes to this one.







testConstraint testevalex [llength [info commands testevalex]]
test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body {
    join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n
} -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0}
* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest}
* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}

# -------------------------------------------------------------------------
# literal sharing

test info-39.0 {location information not confused by literal sharing} -body {
    namespace eval ::foo {}
    proc ::foo::bar {} {
	lappend res {}
	lappend res [reduce [eval {info frame 0}]]
	lappend res [reduce [eval {info frame 0}]]
	return $res
    }
    set res [::foo::bar]
    namespace delete ::foo
    join $res \n
} -cleanup {unset res} -result {
type source line 1427 file info.test cmd {info frame 0} proc ::foo::bar level 0
type source line 1428 file info.test cmd {info frame 0} proc ::foo::bar level 0}
} -result {
type source line 1420 file info.test cmd {info frame 0} proc ::foo::bar level 0
type source line 1421 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
# Additional tests for info-30.*, handling of continuation lines (bs+nl sequences).

test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
test info-30.1 {bs+nl in literal words, procedure body, compiled} {
    proc abra {} {
	if {1} \
	    {
		return \
		    [reduce [info frame 0]];# line 1446
		    [reduce [info frame 0]];# line 1439
	    }
    }
    abra
    set res [abra]
} -cleanup {
    rename abra {}
    set res
} -result {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0}
} {type source line 1439 file info.test cmd {info frame 0} proc ::abra level 0}

test info-30.2 {bs+nl in literal words, namespace script} {
    namespace eval xxx {
	set res \
	    [reduce [info frame 0]];# line 1450
    }
	variable res \
    set res
	    [info frame 0];# line 1457
    }
    return [reduce $xxx::res]
} {type source line 1457 file info.test cmd {info frame 0} level 0}
} {type source line 1450 file info.test cmd {info frame 0} level 0}

test info-30.3 {bs+nl in literal words, namespace multi-word script} {
    namespace eval xxx variable res \
	[list [reduce [info frame 0]]];# line 1464
    return $xxx::res
} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
    namespace eval xxx set res \
	[list [reduce [info frame 0]]];# line 1457
    set res
} {type source line 1457 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body {
test info-30.4 {bs+nl in literal words, eval script} {
    eval {
	set ::res \
	    [reduce [info frame 0]];# line 1471
	    [reduce [info frame 0]];# line 1464
    }
    return $res
} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
    set res
} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.5 {bs+nl in literal words, eval script, with nested words} -body {
test info-30.5 {bs+nl in literal words, eval script, with nested words} {
    eval {
	if {1} \
	    {
		set ::res \
		    [reduce [info frame 0]];# line 1481
		    [reduce [info frame 0]];# line 1474
	    }
    }
    return $res
} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
    set res
} {type source line 1474 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body {
test info-30.6 {bs+nl in computed word} {
    set res "\
[reduce [info frame 0]]";# line 1489
} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
[reduce [info frame 0]]";# line 1482
} { type source line 1482 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.7 {bs+nl in computed word, in proc} -body {
test info-30.7 {bs+nl in computed word, in proc} {
    proc abra {} {
	return "\
[reduce [info frame 0]]";# line 1495
[reduce [info frame 0]]";# line 1488
    }
    abra
    set res [abra]
} -cleanup {
    rename abra {}
    set res
} -result { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0}
} { type source line 1488 file info.test cmd {info frame 0} proc ::abra level 0}

test info-30.8 {bs+nl in computed word, nested eval} -body {
test info-30.8 {bs+nl in computed word, nested eval} {
    eval {
	set \
	    res "\
[reduce [info frame 0]]";# line 1506
[reduce [info frame 0]]";# line 1499
}
} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} { type source line 1499 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.9 {bs+nl in computed word, nested eval} -body {
test info-30.9 {bs+nl in computed word, nested eval} {
    eval {
	set \
	    res "\
[reduce \
     [info frame 0]]";# line 1515
     [info frame 0]]";# line 1508
}
} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} { type source line 1508 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.10 {bs+nl in computed word, key to array} -body {
test info-30.10 {bs+nl in computed word, key to array} {
    set tmp([set \
	    res "\
[reduce \
     [info frame 0]]"]) x ; #1523
     [info frame 0]]"]) x ; #1516
    unset tmp
    set res
} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} { type source line 1516 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.11 {bs+nl in subst arguments} -body {
test info-30.11 {bs+nl in subst arguments, no true counting} {
    subst {[set \
	    res "\
[reduce \
     [info frame 0]]"]} ; #1532
} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
     [info frame 0]]"]}
} { type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.12 {bs+nl in computed word, nested eval} -body {
test info-30.12 {bs+nl in computed word, nested eval} {
    eval {
	set \
	    res "\
[set x {}] \
[reduce \
     [info frame 0]]";# line 1541
     [info frame 0]]";# line 1534
}
} -cleanup {unset res x} -result {   type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} {   type source line 1534 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body {
test info-30.13 {bs+nl in literal words, uplevel script, with nested words} {
    subinterp ; set res [interp eval sub { uplevel #0 {
	if {1} \
	    {
		set ::res \
		    [reduce [info frame 0]];# line 1550
		    [reduce [info frame 0]];# line 1543
	    }
    }
    set res }] ; interp delete sub ; set res
} -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} level 0}
} {type source line 1543 file info.test cmd {info frame 0} level 0}

test info-30.14 {bs+nl, literal word, uplevel through proc} {
    subinterp ; set res [interp eval sub { proc abra {script} {
	uplevel 1 $script
    }
    set res [abra {
	return "\
[reduce [info frame 0]]";# line 1562
 [reduce [info frame 0]]";# line 1555
    }]
    rename abra {}
    set res }] ; interp delete sub ; set res
} { type source line 1562 file info.test cmd {info frame 0} proc ::abra}
} { type source line 1555 file info.test cmd {info frame 0} proc ::abra}

test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
    proc a {} {
	proc b {} {
	    if {1} \
		{
		    return \
			[reduce [info frame 0]];# line 1574
			[reduce [info frame 0]];# line 1567
		}
	}
    }
    a ; set res [b]
    rename a {}
    rename b {}
    set res
} {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0}
} {type source line 1567 file info.test cmd {info frame 0} proc ::b level 0}

test info-30.16 {bs+nl in multi-body switch, compiled} {
    proc a {value} {
	switch -regexp -- $value \
	    ^key     { info frame 0; # 1587 } \
	    \t###    { info frame 0; # 1588 } \
	    {[0-9]*} { info frame 0; # 1589 }
	    ^key     { info frame 0; # 1580 } \
	    \t###    { info frame 0; # 1581 } \
	    {[0-9]*} { info frame 0; # 1582 }
    }
    set res {}
    lappend res [reduce [a {key   }]]
    lappend res [reduce [a {1alpha}]]
    set res "\n[join $res \n]"
} {
type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}
type source line 1580 file info.test cmd {info frame 0} proc ::a level 0
type source line 1582 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.17 {bs+nl in multi-body switch, direct} {
    switch -regexp -- {key    } \
	^key     { reduce [info frame 0] ;# 1601 } \
	^key     { reduce [info frame 0] ;# 1594 } \
        \t###    { } \
        {[0-9]*} { }
} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} {type source line 1594 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
    proc abra {script} {
	append script "\n# end of script"
	uplevel 1 $script
    }
    set res [abra {
	return "\
[reduce [info frame 0]]";# line 1613, still line of 3 appended script
[reduce [info frame 0]]";# line 1606, still line of 3 appended script
    }]
    rename abra {}
    set res
} { type eval line 3 cmd {info frame 0} proc ::abra}
# { type source line 1606 file info.test cmd {info frame 0} proc ::abra}

test info-30.19 {bs+nl in single-body switch, compiled} {
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
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
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
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
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

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







-
-
+
+









-
+





-
+






-
-
+
+






-
+






-
+




-
-
-
+
+
+






-
-
+
+

















-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
+




-
+

















-
-
+
+







	}
    }
    set res {}
    lappend res [a {key   }]
    lappend res [a {1alpha}]
    set res "\n[join $res \n]"
} {
type source line 1624 file info.test cmd {info frame 0} proc ::a level 0
type source line 1628 file info.test cmd {info frame 0} proc ::a level 0}
type source line 1617 file info.test cmd {info frame 0} proc ::a level 0
type source line 1621 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.20 {bs+nl in single-body switch, direct} {
    switch -regexp -- {key    } { \

	^key     { reduce \
		       [info frame 0] }
	\t###    { }
        {[0-9]*} { }
    }
} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
} {type source line 1636 file info.test cmd {info frame 0} proc ::tcltest::RunTest}

test info-30.21 {bs+nl in if, full compiled} {
    proc a {value} {
	if {$value} \
	    {info frame 0} \
	    {info frame 0} ; # 1653
	    {info frame 0}
    }
    set res {}
    lappend res [reduce [a 1]]
    lappend res [reduce [a 0]]
    set res "\n[join $res \n]"
} {
type source line 1652 file info.test cmd {info frame 0} proc ::a level 0
type source line 1653 file info.test cmd {info frame 0} proc ::a level 0}
type source line 1645 file info.test cmd {info frame 0} proc ::a level 0
type source line 1646 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.22 {bs+nl in computed word, key to array, compiled} {
    proc a {} {
	set tmp([set \
		     res "\
[reduce \
     [info frame 0]]"]) x ; #1668
     [info frame 0]]"]) x ; #1661
    unset tmp
    set res
    }
    set res [a]
    rename a {}
    set res
} { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0}
} { type source line 1661 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.23 {bs+nl in multi-body switch, full compiled} {
    proc a {value} {
	switch -exact -- $value \
	    key     { info frame 0; # 1680 } \
	    xxx     { info frame 0; # 1681 } \
	    000     { info frame 0; # 1682 }
	    key     { info frame 0; # 1673 } \
	    xxx     { info frame 0; # 1674 } \
	    000     { info frame 0; # 1675 }
    }
    set res {}
    lappend res [reduce [a key]]
    lappend res [reduce [a 000]]
    set res "\n[join $res \n]"
} {
type source line 1680 file info.test cmd {info frame 0} proc ::a level 0
type source line 1682 file info.test cmd {info frame 0} proc ::a level 0}
type source line 1673 file info.test cmd {info frame 0} proc ::a level 0
type source line 1675 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.24 {bs+nl in single-body switch, full compiled} {
    proc a {value} {
	switch -exact -- $value {
	    key { reduce \
		      [info frame 0] }
	    xxx { reduce \
		      [info frame 0] }
	    000 { reduce \
		      [info frame 0] }
	}
    }
    set res {}
    lappend res [a key]
    lappend res [a 000]
    set res "\n[join $res \n]"
} {
type source line 1696 file info.test cmd {info frame 0} proc ::a level 0
type source line 1700 file info.test cmd {info frame 0} proc ::a level 0}
type source line 1689 file info.test cmd {info frame 0} proc ::a level 0
type source line 1693 file info.test cmd {info frame 0} proc ::a level 0}

test info-30.25 {TIP 280 for compiled [subst]} {
    subst {[reduce [info frame 0]]} ; # 1712
} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.26 {TIP 280 for compiled [subst]} {
    subst \
	    {[reduce [info frame 0]]} ; # 1716
} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.27 {TIP 280 for compiled [subst]} {
    subst {
[reduce [info frame 0]]} ; # 1720
} {
type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.28 {TIP 280 for compiled [subst]} {
    subst {\
[reduce [info frame 0]]} ; # 1725
} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.29 {TIP 280 for compiled [subst]} {
    subst {foo\
[reduce [info frame 0]]} ; # 1729
} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.30 {TIP 280 for compiled [subst]} {
    subst {foo
[reduce [info frame 0]]} ; # 1733
} {foo
type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.31 {TIP 280 for compiled [subst]} {
    subst {[][reduce [info frame 0]]} ; # 1737
} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.32 {TIP 280 for compiled [subst]} {
    subst {[\
][reduce [info frame 0]]} ; # 1741
} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.33 {TIP 280 for compiled [subst]} {
    subst {[
][reduce [info frame 0]]} ; # 1745
} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.34 {TIP 280 for compiled [subst]} {
    subst {[format %s {}
][reduce [info frame 0]]} ; # 1749
} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.35 {TIP 280 for compiled [subst]} {
    subst {[format %s {}
]
[reduce [info frame 0]]} ; # 1754
} {
type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.36 {TIP 280 for compiled [subst]} {
    subst {
[format %s {}][reduce [info frame 0]]} ; # 1759
} {
type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.37 {TIP 280 for compiled [subst]} {
    subst {
[format %s {}]
[reduce [info frame 0]]} ; # 1765
} {

type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.38 {TIP 280 for compiled [subst]} {
    subst {\
[format %s {}][reduce [info frame 0]]} ; # 1771
} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.39 {TIP 280 for compiled [subst]} {
    subst {\
[format %s {}]\
[reduce [info frame 0]]} ; # 1776
} {  type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.40 {TIP 280 for compiled [subst]} -setup {
    unset -nocomplain empty
} -body {
    set empty {}
    subst {$empty[reduce [info frame 0]]} ; # 1782
} -cleanup {
    unset empty
} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.41 {TIP 280 for compiled [subst]} -setup {
    unset -nocomplain empty
} -body {
    set empty {}
    subst {$empty
[reduce [info frame 0]]} ; # 1791
} -cleanup {
    unset empty
} -result {
type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.42 {TIP 280 for compiled [subst]} -setup {
    unset -nocomplain empty
} -body {
    set empty {}; subst {$empty\
[reduce [info frame 0]]} ; # 1800
} -cleanup {
    unset empty
} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.43 {TIP 280 for compiled [subst]} -body {
    unset -nocomplain a\nb
    set a\nb {}
    subst {${a
b}[reduce [info frame 0]]} ; # 1808
} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.44 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(\n) {}
    subst {$a(
)[reduce [info frame 0]]} ; # 1814
} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.45 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a() {}
    subst {$a([
return -level 0])[reduce [info frame 0]]} ; # 1820
} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
test info-30.46 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(1825) YES;  set a(1824) 1824; set a(1826) 1826
    subst {$a([dict get [info frame 0] line])} ; # 1825
} YES
test info-30.47 {TIP 280 for compiled [subst]} {
    unset -nocomplain a
    set a(\n1831) YES;  set a(\n1830) 1830; set a(\n1832) 1832
    subst {$a(
[dict get [info frame 0] line])} ; # 1831
} YES
unset -nocomplain a

test info-30.48 {Bug 2850901} testevalex {
    testevalex {return -level 0 [format %s {}
][reduce [info frame 0]]} ; # line 2 of the eval
} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}


# -------------------------------------------------------------------------
# literal sharing 2, bug 2933089

test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
    set result {}

    proc print_one {} {}
    proc test_info_frame {} {
	set x 1
	set y x

	if "$x != 1" {
	} else {
	    print_one
	} ;#line 1854^
	} ;#line 1717^

	if "$$y != 1" {
	} else {
	    print_one
	} ;#line 1859^
	} ;#line 1722^
	# Do not put the comments listing the line numbers into the
	# branches. We need shared literals, and the comments would
	# make them different, thus unshared.
    }

    proc get_frame_info { cmd_str op } {
	lappend ::result [reduce [eval {info frame -3}]]
    }
    trace add execution print_one enter get_frame_info
} -body {
    test_info_frame;
    join $result \n
} -cleanup {
    trace remove execution print_one enter get_frame_info
    rename get_frame_info {}
    rename test_info_frame {}
    rename print_one {}
} -result {type source line 1854 file info.test cmd print_one proc ::test_info_frame level 1
type source line 1859 file info.test cmd print_one proc ::test_info_frame level 1}
} -result {type source line 1717 file info.test cmd print_one proc ::test_info_frame level 1
type source line 1722 file info.test cmd print_one proc ::test_info_frame level 1}

# -------------------------------------------------------------------------
# Tests moved to the end to not disturb other tests and their locations.

test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -setup {subinterp} -body {
    interp eval sub {
	proc etrace {} {
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911





1912
1913
1914
1915
1916
1917
1918
1763
1764
1765
1766
1767
1768
1769





1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781







-
-
-
-
-
+
+
+
+
+







	    control y {
		set y PPL
		etrace
	    }
	}
	join [lrange [datal] 0 4] \n
    }
} -result {* {type source line 1890 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1902 file info.test cmd etrace proc ::control}
* {type source line 1897 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1900 file info.test cmd control proc ::datal level 1}
* {type source line 1905 file info.test cmd datal level 2}} -cleanup {interp delete sub}
} -result {* {type source line 1753 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1765 file info.test cmd etrace proc ::control}
* {type source line 1760 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1763 file info.test cmd control proc ::datal level 1}
* {type source line 1768 file info.test cmd datal level 2}} -cleanup {interp delete sub}

test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body {
    interp eval sub {
	proc etrace {} {
	    set res {}
	    set level [info frame]
	    while {$level} {
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
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





























































































































































































































































































1820
1821
1822
1823
1824
1825
1826







-
-
-
-
+
+
+
+

















-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	    return [uplevel 1 $script]
	}
	join [lrange [control y {
	    set y DPL
	    etrace
	}] 0 3] \n
    }
} -result {* {type source line 1919 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1930 file info.test cmd etrace proc ::control}
* {type source line 1926 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1928 file info.test cmd control level 1}} -cleanup {interp delete sub}
} -result {* {type source line 1782 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1793 file info.test cmd etrace proc ::control}
* {type source line 1789 file info.test cmd {uplevel 1 $script} proc ::control}
* {type source line 1791 file info.test cmd control level 1}} -cleanup {interp delete sub}

test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body {
    interp eval sub {
	proc etrace {} {
	    set res {}
	    set level [info frame]
	    while {$level} {
		lappend res [list $level [reduce [info frame $level]]]
		incr level -1
	    }
	    return $res
	}
	join [lrange [uplevel \#0 {
	    set y DL.
	    etrace
	}] 0 2] \n
    }
} -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0}
} -result {* {type source line 1807 file info.test cmd {info frame $level} proc ::etrace level 0}
* {type source line 1951 file info.test cmd etrace level 1}
* {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}

# This test at the end of this file _only_ to avoid disturbing above line
# numbers. It _belongs_ after info-9.12
test info-9.13 {info level option, value in global context} -body {
    uplevel #0 {info level 2}
} -returnCodes error -result {bad level "2"}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    catch {*}{
	{info frame 0}
	res
    }
    return $res
}
test info-33.4 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    dict for {a b} {c d} {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.5 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    set d {a b}
    dict update d x y {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.6 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    set d {}
    dict with d {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.7 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{set res [info frame 0]}
	{1} {} {break}
    }
    return $res
}
test info-33.8 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{} {1} {}
	{set res [info frame 0]; break}
    }
    return $res
}
test info-33.9 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{} {1}
	{return [info frame 0]}
	{}
    }
}
test info-33.10 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    for {*}{
	{}
	{[return [info frame 0]]}
	{} {}
    }
}
test info-33.11 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    foreach {*}{
	x
    } [return [info frame 0]] {}
}
test info-33.12 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    foreach {*}{
	x y
	{set res [info frame 0]}
    }
    return $res
}
test info-33.13 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if {*}{
	{[return [info frame 0]]}
	{}
    }
}
test info-33.14 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    if 0 {*}{
	{} else
	{return [info frame 0]}
    }
}
test info-33.15 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    incr {*}{
	x
    } [return [info frame 0]]
}
test info-33.16 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    info level {*}{
    } [return [info frame 0]]
}
test info-33.17 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    string match {*}{
    } [return [info frame 0]] {}
}
test info-33.18 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    string match {*}{
	{}
    } [return [info frame 0]]
}
test info-33.19 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    string length {*}{
    } [return [info frame 0]]
}
test info-33.20 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    while {*}{
	{[return [info frame 0]]}
    } {}
}
test info-33.21 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    switch -- {*}{
    } [return [info frame 0]] {*}{
    } x y
}
test info-33.22 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    }
    return $res
}
test info-33.23 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    } finally {}
    return $res
}
test info-33.24 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    } on ok {} {}
    return $res
}
test info-33.25 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0}

* {type source line 1814 file info.test cmd etrace level 1}
# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {*}{
	{set res [info frame 0]}
    } on ok {} {} finally {}
    return $res
}
test info-33.26 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0}

* {type source line 1812 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}
# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    while 1 {*}{
	{return [info frame 0]}
    }
}
test info-33.27 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} finally {*}{
	{return [info frame 0]}
    }
}
test info-33.28 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} on ok {} {} finally {*}{
	{return [info frame 0]}
    }
}
test info-33.29 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} on ok {} {*}{
	{return [info frame 0]}
    }
}
test info-33.30 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    try {} on ok {} {*}{
	{return [info frame 0]}
    } finally {}
}
test info-33.31 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    binary format {*}{
    } [return [info frame 0]]
}
test info-33.32 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    set format format
    binary $format {*}{
    } [return [info frame 0]]
}
test info-33.33 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    append x {*}{
    } [return [info frame 0]]
}
test info-33.34 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval foo {}
proc foo::bar {} {
    append {*}{
    } x([return [info frame 0]]) {*}{
    } a
}
test info-33.35 {{*}, literal, simple, bytecompiled} -body {
    reduce [foo::bar]
} -cleanup {
    namespace delete foo
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}

# -------------------------------------------------------------------------
namespace eval ::testinfocmdtype {
    apply {cmds {
	foreach c $cmds {rename $c {}}
    } ::testinfocmdtype} [info commands ::testinfocmdtype::*]
}
test info-40.1 {info cmdtype: syntax} -body {
    info cmdtype
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.2 {info cmdtype: syntax} -body {
    info cmdtype foo bar
} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
test info-40.3 {info cmdtype: no such command} -body {
    info cmdtype ::testinfocmdtype::foo
} -returnCodes error -result {unknown command "::testinfocmdtype::foo"}
test info-40.4 {info cmdtype: native commands} -body {
    info cmdtype ::if
} -result native
test info-40.5 {info cmdtype: native commands} -body {
    info cmdtype ::puts
} -result native
test info-40.6 {info cmdtype: native commands} -body {
    info cmdtype ::yield
} -result native
test info-40.7 {info cmdtype: procedures} -setup {
    proc ::testinfocmdtype::someproc {} {}
} -body {
    info cmdtype ::testinfocmdtype::someproc
} -cleanup {
    rename ::testinfocmdtype::someproc {}
} -result proc
test info-40.8 {info cmdtype: aliases} -setup {
    interp alias {} ::testinfocmdtype::somealias {} ::puts
} -body {
    info cmdtype ::testinfocmdtype::somealias
} -cleanup {
    rename ::testinfocmdtype::somealias {}
} -result alias
test info-40.9 {info cmdtype: imports} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval foo {
	    proc bar {} {}
	    namespace export bar
	}
	namespace import foo::bar
    }
} -body {
    info cmdtype ::testinfocmdtype::bar
} -cleanup {
    rename ::testinfocmdtype::bar {}
    namespace delete ::testinfocmdtype::foo
} -result import
test info-40.10 {info cmdtype: interps} -setup {
    apply {i {
	rename $i ::testinfocmdtype::child
	variable ::testinfocmdtype::child $i
    }} [interp create]
} -body {
    info cmdtype ::testinfocmdtype::child
} -cleanup {
    interp delete $::testinfocmdtype::child
} -result interp
test info-40.11 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype ::testinfocmdtype::obj
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result object
test info-40.12 {info cmdtype: objects} -setup {
    apply {{} {
	oo::object create obj
    } ::testinfocmdtype}
} -body {
    info cmdtype [info object namespace ::testinfocmdtype::obj]::my
} -cleanup {
    ::testinfocmdtype::obj destroy
} -result privateObject
test info-40.13 {info cmdtype: ensembles} -setup {
    namespace eval ::testinfocmdtype {
	namespace eval ensmbl {
	    proc bar {} {}
	    namespace export *
	    namespace ensemble create
	}
    }
} -body {
    info cmdtype ::testinfocmdtype::ensmbl
} -cleanup {
    namespace delete ::testinfocmdtype::ensmbl
} -result ensemble
test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup {
    namespace eval ::testinfocmdtype {
	rename [zlib stream gzip] zstream
    }
} -body {
    info cmdtype ::testinfocmdtype::zstream
} -cleanup {
    ::testinfocmdtype::zstream close
} -result zlibStream
test info-40.15 {info cmdtype: coroutines} -setup {
    coroutine ::testinfocmdtype::coro eval yield
} -body {
    info cmdtype ::testinfocmdtype::coro
} -cleanup {
    ::testinfocmdtype::coro
} -result coroutine
test info-40.16 {info cmdtype: dynamic behavior} -setup {
    proc ::testinfocmdtype::foo {} {}
} -body {
    namespace eval ::testinfocmdtype {
	list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \
	    [namespace which foo] [rename foo bar] [namespace which bar] \
	    [catch {info cmdtype foo}] [catch {info cmdtype bar}]
    }
} -cleanup {
    namespace eval ::testinfocmdtype {
	catch {rename foo {}}
	catch {rename bar {}}
    }
} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0}
test info-40.17 {info cmdtype: aliases in child interpreters} -setup {
    set i [interp create]
} -body {
    $i alias foo gorp
    $i eval {
	info cmdtype foo
    }
} -cleanup {
    interp delete $i
} -result alias
test info-40.18 {info cmdtype: aliases in child interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe alias foo gorp
    $safe eval {
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.19 {info cmdtype: aliases in child interpreters} -setup {
    set safe [interp create -safe]
} -body {
    set inner [interp create [list $safe bar]]
    interp alias $inner foo $safe gorp
    $safe eval {
	bar eval {
	    info cmdtype foo
	}
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
test info-40.20 {info cmdtype: aliases in child interpreters} -setup {
    set safe [interp create -safe]
} -body {
    $safe eval {
	interp alias {} foo {} gorp
	info cmdtype foo
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand cmdtype of info}
namespace delete ::testinfocmdtype

# -------------------------------------------------------------------------
unset -nocomplain res

test info-39.2 {Bug 4b61afd660} -setup {
    proc probe {} {
	return [dict get [info frame -1] line]
    }
    set body {
	set cmd probe

Changes to tests/init.test.

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


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




-
-
+
+

-
-
+
+




-
-
+
+

-
-
+
+





-
+


















+



+


-
+
+



+



+



+

+



+




+
-
+






-
-
-
-
-



-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+


-
+
+
+


-
+

+


-
+

+


+

-
-
+
+

+

-
-
+
+

+


+

-
-
+
+

+

-
-
+
+

+
+
+





-
-
-
-
+
+
+
+
+








-
-
-
+
+
+












-
+




-
+







-
+

-



-
-
-
+
+
+
+
+

-






-
-
+
+
+




-
-
-
-
-
-
-
-
-
-











-
-
+
+








-
-
-
-
# Functionality covered: this file contains a collection of tests for the auto
# loading and namespaces.
# Functionality covered: this file contains a collection of tests for the
# auto loading and namespaces.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.3.4
    namespace import -force ::tcltest::*
}

# Clear out any namespaces called test_ns_*
catch {namespace delete {*}[namespace children :: test_ns_*]}


test init-0.1 {no error on initialization phase (init.tcl)} -setup {
    interp create child
} -body {
    child eval {
	list [set v [info exists ::errorInfo]] \
		[if {$v} {set ::errorInfo}] \
	     [set v [info exists ::errorCode]] \
		[if {$v} {set ::errorCode}]
    }
} -cleanup {
    interp delete child
} -result {0 {} 0 {}}

# Six cases - white box testing

test init-1.1 {auto_qualify - absolute cmd - namespace} {
    auto_qualify ::foo::bar ::blue
} ::foo::bar

test init-1.2 {auto_qualify - absolute cmd - global} {
    auto_qualify ::global ::sub
} global

test init-1.3 {auto_qualify - no colons cmd - global} {
    auto_qualify nocolons ::
} nocolons
} nocolons 

test init-1.4 {auto_qualify - no colons cmd - namespace} {
    auto_qualify nocolons ::sub
} {::sub::nocolons nocolons}

test init-1.5 {auto_qualify - colons in cmd - global} {
    auto_qualify foo::bar ::
} ::foo::bar

test init-1.6 {auto_qualify - colons in cmd - namespace} {
    auto_qualify foo::bar ::sub
} {::sub::foo::bar ::foo::bar}

# Some additional tests

test init-1.7 {auto_qualify - multiples colons 1} {
    auto_qualify :::foo::::bar ::blue
} ::foo::bar

test init-1.8 {auto_qualify - multiple colons 2} {
    auto_qualify :::foo ::bar
} foo


# We use a child interp and auto_reset and double the tests because there is 2
# we use a child interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)

set testInterp [interp create]
tcltest::loadIntoChildInterpreter $testInterp {*}$argv
interp eval $testInterp {
    namespace import -force ::tcltest::*
    customMatch pairwise {apply {{mode pair} {
	if {[llength $pair] != 2} {error "need a pair of values to check"}
	string $mode [lindex $pair 0] [lindex $pair 1]
    }}}

    auto_reset
    catch {rename parray {}}

test init-2.0 {load parray - stage 1} -body {
    parray
test init-2.0 {load parray - stage 1} {
    set ret [catch {parray} error]
} -returnCodes error -cleanup {
    rename parray {}  ;# remove it, for the next test - that should not fail.
} -result {wrong # args: should be "parray a ?pattern?"}
test init-2.1 {load parray - stage 2} -body {
    parray
} -returnCodes error -result {wrong # args: should be "parray a ?pattern?"}
    rename parray {} ; # remove it, for the next test - that should not fail.
    list $ret $error
} {1 {wrong # args: should be "parray a ?pattern?"}}


test init-2.1 {load parray - stage 2} {
    set ret [catch {parray} error]
    list $ret $error
} {1 {wrong # args: should be "parray a ?pattern?"}}


auto_reset
catch {rename ::safe::setLogCmd {}}
#unset -nocomplain auto_index(::safe::setLogCmd) auto_oldpath
#unset auto_index(::safe::setLogCmd)
#unset auto_oldpath

test init-2.2 {load ::safe::setLogCmd - stage 1} {
    ::safe::setLogCmd
    rename ::safe::setLogCmd {}  ;# should not fail
    rename ::safe::setLogCmd {} ; # should not fail
} {}

test init-2.3 {load ::safe::setLogCmd - stage 2} {
    ::safe::setLogCmd
    rename ::safe::setLogCmd {}  ;# should not fail
    rename ::safe::setLogCmd {} ; # should not fail
} {}

auto_reset
catch {rename ::safe::setLogCmd {}}

test init-2.4 {load safe:::setLogCmd - stage 1} {
    safe:::setLogCmd  ;# intentionally 3 :
    rename ::safe::setLogCmd {}  ;# should not fail
    safe:::setLogCmd ; # intentionally 3 :
    rename ::safe::setLogCmd {} ; # should not fail
} {}

test init-2.5 {load safe:::setLogCmd - stage 2} {
    safe:::setLogCmd  ;# intentionally 3 :
    rename ::safe::setLogCmd {}  ;# should not fail
    safe:::setLogCmd ; # intentionally 3 :
    rename ::safe::setLogCmd {} ; # should not fail
} {}

auto_reset
catch {rename ::safe::setLogCmd {}}

test init-2.6 {load setLogCmd from safe:: - stage 1} {
    namespace eval safe setLogCmd
    rename ::safe::setLogCmd {}  ;# should not fail
    namespace eval safe setLogCmd 
    rename ::safe::setLogCmd {} ; # should not fail
} {}

test init-2.7 {oad setLogCmd from safe::  - stage 2} {
    namespace eval safe setLogCmd
    rename ::safe::setLogCmd {}  ;# should not fail
    namespace eval safe setLogCmd 
    rename ::safe::setLogCmd {} ; # should not fail
} {}



test init-2.8 {load tcl::HistAdd} -setup {
    auto_reset
    catch {rename ::tcl::HistAdd {}}
} -body {
    # 3 ':' on purpose
    tcl:::HistAdd
} -returnCodes error -cleanup {
    rename ::tcl::HistAdd {}
} -result {wrong # args: should be "tcl:::HistAdd event ?exec?"}
    list [catch {tcl:::HistAdd} error] $error
} -cleanup {
    rename ::tcl::HistAdd {} ; 
} -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}}


test init-3.0 {random stuff in the auto_index, should still work} {
    set auto_index(foo:::bar::blah) {
        namespace eval foo {namespace eval bar {proc blah {} {return 1}}}
    }
    foo:::bar::blah
} 1

# Tests that compare the error stack trace generated when autoloading with
# that generated when no autoloading is necessary.  Ideally they should be the
# same.
# Tests that compare the error stack trace generated when autoloading
# with that generated when no autoloading is necessary.  Ideally they
# should be the same.

set count 0
foreach arg [subst -nocommands -novariables {
    c
    {argument
                which spans
                multiple lines}
    {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
    {argument which spans multiple lines
                and is long enough to be truncated and
"               <- includes a false lead in the prune point search
                and must be longer still to force truncation}
                {contrived example: rare circumstance
                {contrived example: rare circumstance 
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar foo
"}
    {contrived example: rare circumstance
    {contrived example: rare circumstance 
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar
"}
    {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
	}] {    ;# emacs needs -> "

    test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
    test init-4.$count.0 {::errorInfo produced by [unknown]} {
	auto_reset
    } -body {
	catch {parray a b $arg}
	set first $::errorInfo
	catch {parray a b $arg}
	list $first $::errorInfo
    } -match pairwise -result equal
    test init-4.$count.1 {::errorInfo produced by [unknown]} -setup {
	set second $::errorInfo
	string equal $first $second
    } 1

    test init-4.$count.1 {::errorInfo produced by [unknown]} {
	auto_reset
    } -body {
	namespace eval junk [list array set $arg [list 1 2 3 4]]
	trace variable ::junk::$arg r \
		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
	catch {parray ::junk::$arg}
	set first $::errorInfo
	catch {parray ::junk::$arg}
	list $first $::errorInfo
    } -match pairwise -result equal
	set second $::errorInfo
	string equal $first $second
    } 1

    incr count
}

test init-4.$count {[Bug 46f801ed5a]} -setup {
    auto_reset
    array set auto_index {demo {proc demo {} {tailcall error foo}}}
} -body {
    demo
} -cleanup {
    array unset auto_index demo
    rename demo {}
} -returnCodes error -result foo

test init-5.0 {return options passed through ::unknown} -setup {
    catch {rename xxx {}}
    set ::auto_index(::xxx) {proc ::xxx {} {
	return -code error -level 2 xxx
    }}
} -body {
    set code [catch {::xxx} foo bar]
    set code2 [catch {::xxx} foo2 bar2]
    list $code $foo $bar $code2 $foo2 $bar2
} -cleanup {
    unset ::auto_index(::xxx)
} -match glob -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}}

} -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}}

cleanupTests
}	;#  End of [interp eval $testInterp]

# cleanup
interp delete $testInterp
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/internals.tcl.

17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31







-
+








# test-with-limit --
#
# Usage: test-with-limit ?-addmem bytes? ?-maxmem bytes? command
# Options:
#	-addmem - set additional memory limit (in bytes) as difference (extra memory needed to run a test)
#	-maxmem - set absolute maximum address space limit (in bytes)
#
# 
proc testWithLimit args {
    set body [lindex $args end]
    array set in [lrange $args 0 end-1]
    # test in child process (with limits):
    set pipe {}
    if {[catch {
	# start new process:
41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55







-
+







		    # using ps (vsz is in KB):
		    incr in(-addmem) [expr {[lindex [exec ps -hq $ppid -o vsz] end] * 1024}]
		}]} {
		    # ps failed, use default size 20MB:
		    incr in(-addmem) 20000000
		    # + size of locale-archive (may be up to 100MB):
		    incr in(-addmem) [expr {
			[file exists /usr/lib/locale/locale-archive] ?
			[file exists /usr/lib/locale/locale-archive] ? 
			[file size /usr/lib/locale/locale-archive] : 0
		    }]
		}
		if {![info exists in(-maxmem)]} {
		    set in(-maxmem) $in(-addmem)
		}
		set in(-maxmem) [expr { max($in(-addmem), $in(-maxmem)) }]

Changes to tests/interp.test.

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
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












-
-
+
+



-
-
-


-
+

-
+


-
+

-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
-
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
-
+
+
-
-
-
+















-
+
-
-



-
+







# This file tests the multiple interpreter facility of Tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}
set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source unload}

foreach i [interp children] {
foreach i [interp slaves] {
  interp delete $i
}


# Part 0: Check out options for interp command
test interp-1.1 {options for interp command} -returnCodes error -body {
    interp
} -result {wrong # args: should be "interp cmd ?arg ...?"}
test interp-1.2 {options for interp command} -returnCodes error -body {
    interp frobox
} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer}
test interp-1.1 {options for interp command} {
    list [catch {interp} msg] $msg
} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
test interp-1.2 {options for interp command} {
    list [catch {interp frobox} msg] $msg
} {1 {bad option "frobox": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
    interp delete
} ""
test interp-1.4 {options for interp command} -returnCodes error -body {
    interp delete foo bar
} -result {could not find interpreter "foo"}
test interp-1.5 {options for interp command} -returnCodes error -body {
    interp exists foo bar
} -result {wrong # args: should be "interp exists ?path?"}
test interp-1.4 {options for interp command} {
    list [catch {interp delete foo bar} msg] $msg
} {1 {could not find interpreter "foo"}}
test interp-1.5 {options for interp command} {
    list [catch {interp exists foo bar} msg] $msg
} {1 {wrong # args: should be "interp exists ?path?"}}
#
# test interp-0.6 was removed
#
test interp-1.6 {options for interp command} -returnCodes error -body {
    interp children foo bar zop
} -result {wrong # args: should be "interp children ?path?"}
test interp-1.7 {options for interp command} -returnCodes error -body {
    interp hello
} -result {bad option "hello": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer}
test interp-1.8 {options for interp command} -returnCodes error -body {
    interp -froboz
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
    interp -froboz -safe
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, children, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, share, target, or transfer}
test interp-1.10 {options for interp command} -returnCodes error -body {
    interp target
} -result {wrong # args: should be "interp target path alias"}
test interp-1.6 {options for interp command} {
    list [catch {interp slaves foo bar zop} msg] $msg
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-1.7 {options for interp command} {
    list [catch {interp hello} msg] $msg
} {1 {bad option "hello": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.8 {options for interp command} {
    list [catch {interp -froboz} msg] $msg
} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.9 {options for interp command} {
    list [catch {interp -froboz -safe} msg] $msg
} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.10 {options for interp command} {
    list [catch {interp target} msg] $msg
} {1 {wrong # args: should be "interp target path alias"}}


# Part 1: Basic interpreter creation tests:
test interp-2.1 {basic interpreter creation} {
    interp create a
} a
test interp-2.2 {basic interpreter creation} {
    catch {interp create}
} 0
test interp-2.3 {basic interpreter creation} {
    catch {interp create -safe}
} 0
test interp-2.4 {basic interpreter creation} -setup {
    catch {interp create a}
test interp-2.4 {basic interpreter creation} {
    list [catch {interp create a} msg] $msg
} -returnCodes error -body {
    interp create a
} -result {interpreter named "a" already exists, cannot create}
} {1 {interpreter named "a" already exists, cannot create}}
test interp-2.5 {basic interpreter creation} {
    interp create b -safe
} b
test interp-2.6 {basic interpreter creation} {
    interp create d -safe
} d
test interp-2.7 {basic interpreter creation} {
    list [catch {interp create -froboz} msg] $msg
} {1 {bad option "-froboz": must be -safe or --}}
test interp-2.8 {basic interpreter creation} {
    interp create -- -froboz
} -froboz
test interp-2.9 {basic interpreter creation} {
    interp create -safe -- -froboz1
} -froboz1
test interp-2.10 {basic interpreter creation} -setup {
test interp-2.10 {basic interpreter creation} {
    catch {interp create a}
} -body {
    interp create {a x1}
    interp create {a x2}
    interp create {a x3} -safe
} -result {a x3}
} {a x3}
test interp-2.11 {anonymous interps vs existing procs} {
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy thenum
    interp delete $x
    proc interp$thenum {} {}
    set x [interp create]
    regexp "interp(\[0-9]+)" $x dummy anothernum
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
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







-
+



-
-
-
+
+
+

-
+



-
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-

-
-
-
+
+
+
-
-
-

-
+









-
-
-
-
-
-
+
+
+
+
+
+







-
+







-
+


-
-
-
-
-
+
+
+
+
+

-
+






-
+















-
-
-
+
+
+




-



+





-
-
-
-
+
+
+

-
-
-
+
+
+




-
+

-

-
+

-



-
+


-
+



-
-
-
+
+
+




-
+

-
+


-
+

-
-
+
+

-
-
+
+




-
+

-
+


-
-
+
+







    regexp "interp(\[0-9]+)" $x dummy anothernum
    expr $anothernum - $thenum
} 1
test interp-2.13 {correct default when no $path arg is given} -body {
    interp create --
} -match regexp -result {interp[0-9]+}

foreach i [interp children] {
foreach i [interp slaves] {
    interp delete $i
}

# Part 2: Testing "interp children" and "interp exists"
test interp-3.1 {testing interp exists and interp children} {
    interp children
# Part 2: Testing "interp slaves" and "interp exists"
test interp-3.1 {testing interp exists and interp slaves} {
    interp slaves
} ""
test interp-3.2 {testing interp exists and interp children} {
test interp-3.2 {testing interp exists and interp slaves} {
    interp create a
    interp exists a
} 1
test interp-3.3 {testing interp exists and interp children} {
test interp-3.3 {testing interp exists and interp slaves} {
    interp exists nonexistent
} 0
test interp-3.4 {testing interp exists and interp children} -body {
    interp children a b c
} -returnCodes error -result {wrong # args: should be "interp children ?path?"}
test interp-3.5 {testing interp exists and interp children} -body {
    interp exists a b c
} -returnCodes error -result {wrong # args: should be "interp exists ?path?"}
test interp-3.6 {testing interp exists and interp children} {
test interp-3.4 {testing interp exists and interp slaves} {
    list [catch {interp slaves a b c} msg] $msg
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-3.5 {testing interp exists and interp slaves} {
    list [catch {interp exists a b c} msg] $msg
} {1 {wrong # args: should be "interp exists ?path?"}}
test interp-3.6 {testing interp exists and interp slaves} {
    interp exists
} 1
test interp-3.7 {testing interp exists and interp children} -setup {
test interp-3.7 {testing interp exists and interp slaves} {
    catch {interp create a}
} -body {
    interp children
} -result a
test interp-3.8 {testing interp exists and interp children} -body {
    interp children a b c
} -returnCodes error -result {wrong # args: should be "interp children ?path?"}
test interp-3.9 {testing interp exists and interp children} -setup {
    interp slaves
} a
test interp-3.8 {testing interp exists and interp slaves} {
    list [catch {interp slaves a b c} msg] $msg
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-3.9 {testing interp exists and interp slaves} {
    catch {interp create a}
} -body {
    interp create {a a2} -safe
    expr {"a2" in [interp children a]}
} -result 1
test interp-3.10 {testing interp exists and interp children} -setup {
    expr {[lsearch [interp slaves a] a2] >= 0}
} 1
test interp-3.10 {testing interp exists and interp slaves} {
    catch {interp create a}
    catch {interp create {a a2}}
} -body {
    interp exists {a a2}
} -result 1
} 1

# Part 3: Testing "interp delete"
test interp-3.11 {testing interp delete} {
    interp delete
} ""
test interp-4.1 {testing interp delete} {
    catch {interp create a}
    interp delete a
} ""
test interp-4.2 {testing interp delete} -returnCodes error -body {
    interp delete nonexistent
} -result {could not find interpreter "nonexistent"}
test interp-4.3 {testing interp delete} -returnCodes error -body {
    interp delete x y z
} -result {could not find interpreter "x"}
test interp-4.2 {testing interp delete} {
    list [catch {interp delete nonexistent} msg] $msg
} {1 {could not find interpreter "nonexistent"}}
test interp-4.3 {testing interp delete} {
    list [catch {interp delete x y z} msg] $msg
} {1 {could not find interpreter "x"}}
test interp-4.4 {testing interp delete} {
    interp delete
} ""
test interp-4.5 {testing interp delete} {
    interp create a
    interp create {a x1}
    interp delete {a x1}
    expr {"x1" in [interp children a]}
    expr {[lsearch [interp slaves a] x1] >= 0}
} 0
test interp-4.6 {testing interp delete} {
    interp create c1
    interp create c2
    interp create c3
    interp delete c1 c2 c3
} ""
test interp-4.7 {testing interp delete} -returnCodes error -body {
test interp-4.7 {testing interp delete} {
    interp create c1
    interp create c2
    interp delete c1 c2 c3
} -result {could not find interpreter "c3"}
test interp-4.8 {testing interp delete} -returnCodes error -body {
    interp delete {}
} -result {cannot delete the current interpreter}
    list [catch {interp delete c1 c2 c3} msg] $msg
} {1 {could not find interpreter "c3"}}
test interp-4.8 {testing interp delete} {
    list [catch {interp delete {}} msg] $msg
} {1 {cannot delete the current interpreter}}

foreach i [interp children] {
foreach i [interp slaves] {
    interp delete $i
}

# Part 4: Consistency checking - all nondeleted interpreters should be
# there:
test interp-5.1 {testing consistency} {
    interp children
    interp slaves
} ""
test interp-5.2 {testing consistency} {
    interp exists a
} 0
test interp-5.3 {testing consistency} {
    interp exists nonexistent
} 0

# Recreate interpreter "a"
interp create a

# Part 5: Testing eval in interpreter object command and with interp command
test interp-6.1 {testing eval} {
    a eval expr 3 + 5
} 8
test interp-6.2 {testing eval} -returnCodes error -body {
    a eval foo
} -result {invalid command name "foo"}
test interp-6.2 {testing eval} {
    list [catch {a eval foo} msg] $msg
} {1 {invalid command name "foo"}}
test interp-6.3 {testing eval} {
    a eval {proc foo {} {expr 3 + 5}}
    a eval foo
} 8
catch {a eval {proc foo {} {expr 3 + 5}}}
test interp-6.4 {testing eval} {
    interp eval a foo
} 8

test interp-6.5 {testing eval} {
    interp create {a x2}
    interp eval {a x2} {proc frob {} {expr 4 * 9}}
    interp eval {a x2} frob
} 36
catch {interp create {a x2}}
test interp-6.6 {testing eval} -returnCodes error -body {
    interp eval {a x2} foo
} -result {invalid command name "foo"}
test interp-6.6 {testing eval} {
    list [catch {interp eval {a x2} foo} msg] $msg
} {1 {invalid command name "foo"}}

# UTILITY PROCEDURE RUNNING IN PARENT INTERPRETER:
proc in_parent {args} {
     return [list seen in parent: $args]
# UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
proc in_master {args} {
     return [list seen in master: $args]
}

# Part 6: Testing basic alias creation
test interp-7.1 {testing basic alias creation} {
    a alias foo in_parent
    a alias foo in_master
} foo
catch {a alias foo in_parent}
test interp-7.2 {testing basic alias creation} {
    a alias bar in_parent a1 a2 a3
    a alias bar in_master a1 a2 a3
} bar
catch {a alias bar in_parent a1 a2 a3}
# Test 6.3 has been deleted.
test interp-7.3 {testing basic alias creation} {
    a alias foo
} in_parent
} in_master
test interp-7.4 {testing basic alias creation} {
    a alias bar
} {in_parent a1 a2 a3}
} {in_master a1 a2 a3}
test interp-7.5 {testing basic alias creation} {
    lsort [a aliases]
} {bar foo}
test interp-7.6 {testing basic aliases arg checking} -returnCodes error -body {
    a aliases too many args
} -result {wrong # args: should be "a aliases"}
test interp-7.6 {testing basic aliases arg checking} {
    list [catch {a aliases too many args} msg] $msg
} {1 {wrong # args: should be "a aliases"}}

# Part 7: testing basic alias invocation
test interp-8.1 {testing basic alias invocation} {
    catch {interp create a}
    a alias foo in_parent
    a alias foo in_master
    a eval foo s1 s2 s3
} {seen in parent: {s1 s2 s3}}
} {seen in master: {s1 s2 s3}}
test interp-8.2 {testing basic alias invocation} {
    catch {interp create a}
    a alias bar in_parent a1 a2 a3
    a alias bar in_master a1 a2 a3
    a eval bar s1 s2 s3
} {seen in parent: {a1 a2 a3 s1 s2 s3}}
test interp-8.3 {testing basic alias invocation} -returnCodes error -body {
} {seen in master: {a1 a2 a3 s1 s2 s3}}
test interp-8.3 {testing basic alias invocation} {
   catch {interp create a}
   a alias
} -result {wrong # args: should be "a alias aliasName ?targetName? ?arg ...?"}
   list [catch {a alias} msg] $msg
} {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}}

# Part 8: Testing aliases for non-existent or hidden targets
test interp-9.1 {testing aliases for non-existent targets} {
    catch {interp create a}
    a alias zop nonexistent-command-in-parent
    a alias zop nonexistent-command-in-master
    list [catch {a eval zop} msg] $msg
} {1 {invalid command name "nonexistent-command-in-parent"}}
} {1 {invalid command name "nonexistent-command-in-master"}}
test interp-9.2 {testing aliases for non-existent targets} {
    catch {interp create a}
    a alias zop nonexistent-command-in-parent
    proc nonexistent-command-in-parent {} {return i_exist!}
    a alias zop nonexistent-command-in-master
    proc nonexistent-command-in-master {} {return i_exist!}
    a eval zop
} i_exist!
test interp-9.3 {testing aliases for hidden commands} {
    catch {interp create a}
    a eval {proc p {} {return ENTER_A}}
    interp alias {} p a p
    set res {}
325
326
327
328
329
330
331
332
333


334
335
336
337
338
339
340
309
310
311
312
313
314
315


316
317
318
319
320
321
322
323
324







-
-
+
+







    lappend res [namespace eval tst a]
    rename p {}
    rename a {}
    namespace delete tst
    set res
 } {GLOBAL GLOBAL}

if {[info command nonexistent-command-in-parent] != ""} {
    rename nonexistent-command-in-parent {}
if {[info command nonexistent-command-in-master] != ""} {
    rename nonexistent-command-in-master {}
}

# Part 9: Aliasing between interpreters
test interp-10.1 {testing aliasing between interpreters} {
    catch {interp delete a}
    catch {interp delete b}
    interp create a
376
377
378
379
380
381
382
383

384
385

386
387
388
389
390
391
392
360
361
362
363
364
365
366

367
368

369
370
371
372
373
374
375
376







-
+

-
+







} a_alias
test interp-10.6 {testing aliasing between interpreters} {
    catch {interp delete a}
    catch {interp delete b}
    interp create a
    interp create b
    interp alias a a_command b b_command a1 a2 a3
    b alias b_command in_parent b1 b2 b3
    b alias b_command in_master b1 b2 b3
    a eval a_command m1 m2 m3
} {seen in parent: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
} {seen in master: {b1 b2 b3 a1 a2 a3 m1 m2 m3}}
test interp-10.7 {testing aliases between interpreters} {
    catch {interp delete a}
    interp create a
    interp alias "" foo a zoppo
    a eval {proc zoppo {x} {list $x $x $x}}
    set x [foo 33]
    a eval {rename zoppo {}}
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
524
525
526
527
528
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
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







-
+

+


-
-
+
+

+



-
-
+
+

+




-
+


-
+

+


-
-
+
+

+



-
-
+
+

+




-
-
+
+

-
-
+
+


-
+
-
-
-
-
+
+
-
-
-
+

+





-
-
+
+

+




-
-
+
+
-

+
+


-
+







    list [catch {interp target a foo} msg] $msg
} {1 {alias "foo" in path "a" not found}}

# Part 11: testing "interp issafe"
test interp-12.1 {testing interp issafe} {
    interp issafe
} 0
test interp-12.2 {testing interp issafe} {
test interp-12.2 {testing interp issafe} -setup {
    catch {interp delete a}
} -body {
    interp create a
    interp issafe a
} 0
test interp-12.3 {testing interp issafe} {
} -result 0
test interp-12.3 {testing interp issafe} -setup {
    catch {interp delete a}
} -body {
    interp create a
    interp create {a x3} -safe
    interp issafe {a x3}
} 1
test interp-12.4 {testing interp issafe} {
} -result 1
test interp-12.4 {testing interp issafe} -setup {
    catch {interp delete a}
} -body {
    interp create a
    interp create {a x3} -safe
    interp create {a x3 foo}
    interp issafe {a x3 foo}
} 1
} -result 1

# Part 12: testing interpreter object command "issafe" sub-command
test interp-13.1 {testing foo issafe} {
test interp-13.1 {testing foo issafe} -setup {
    catch {interp delete a}
} -body {
    interp create a
    a issafe
} 0
test interp-13.2 {testing foo issafe} {
} -result 0
test interp-13.2 {testing foo issafe} -setup {
    catch {interp delete a}
} -body {
    interp create a
    interp create {a x3} -safe
    a eval x3 issafe
} 1
test interp-13.3 {testing foo issafe} {
} -result 1
test interp-13.3 {testing foo issafe} -setup {
    catch {interp delete a}
} -body {
    interp create a
    interp create {a x3} -safe
    interp create {a x3 foo}
    a eval x3 eval foo issafe
} 1
test interp-13.4 {testing issafe arg checking} {
} -result 1
test interp-13.4 {testing issafe arg checking} -body {
    catch {interp create a}
    list [catch {a issafe too many args} msg] $msg
} {1 {wrong # args: should be "a issafe"}}
    a issafe too many args
} -returnCodes error -result {wrong # args: should be "a issafe"}

# part 14: testing interp aliases
test interp-14.1 {testing interp aliases} -setup {
test interp-14.1 {testing interp aliases} {
    interp create abc
} -body {
    interp eval abc {interp aliases}
} -cleanup {
    interp aliases
} ""
    interp delete abc
} -result ""
test interp-14.2 {testing interp aliases} {
test interp-14.2 {testing interp aliases} -setup {
    catch {interp delete a}
} -body {
    interp create a
    a alias a1 puts
    a alias a2 puts
    a alias a3 puts
    lsort [interp aliases a]
} {a1 a2 a3}
test interp-14.3 {testing interp aliases} {
} -result {a1 a2 a3}
test interp-14.3 {testing interp aliases} -setup {
    catch {interp delete a}
} -body {
    interp create a
    interp create {a x3}
    interp alias {a x3} froboz "" puts
    interp aliases {a x3}
} froboz
test interp-14.4 {testing interp alias - alias over parent} {
} -result froboz
test interp-14.4 {testing interp alias - alias over master} -setup {
    # SF Bug 641195
    catch {interp delete a}
} -body {
    # SF Bug 641195
    interp create a
    list [catch {interp alias "" a a eval} msg] $msg [info commands a]
} {1 {cannot define or rename alias "a": interpreter deleted} {}}
} -result {1 {cannot define or rename alias "a": interpreter deleted} {}}
test interp-14.5 {testing interp-alias: wrong # args} -body {
    proc setx x {set x}
    interp alias {} a {} setx
    catch {a 1 2}
    set ::errorInfo
} -cleanup {
    rename setx {}
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
591
592
593
594
595
596
597












598
599
600
601
602
603
604







-
-
-
-
-
-
-
-
-
-
-
-







} -cleanup {
    rename setx {}
    interp delete a
} -result {x
    invoked from within
"a 1"}

test interp-14.11 {{interp alias} {target named the empty string} {bug 2bf56185}} -setup {
    set interp [interp create [info cmdcount]]
    interp eval $interp {
	proc {} args {return $args}
    }

} -body {
    interp alias {} p1 $interp {}
    p1 one two three
} -cleanup {
    interp delete $interp
} -result {one two three}

# part 15: testing file sharing
test interp-15.1 {testing file sharing} {
    catch {interp delete z}
    interp create z
    z eval close stdout
    list [catch {z eval puts hello} msg] $msg
695
696
697
698
699
700
701

702

703
704
705
706
707
708
709
672
673
674
675
676
677
678
679

680
681
682
683
684
685
686
687







+
-
+







    removeFile file-15.8
} -result 0

#
# Torture tests for interpreter deletion order
#
proc kill {} {interp delete xxx}

test interp-16.0 {testing deletion order} {
test interp-15.9 {testing deletion order} {
    catch {interp delete xxx}
    interp create xxx
    xxx alias kill kill
    list [catch {xxx eval kill} msg] $msg
} {0 {}}
test interp-16.1 {testing deletion order} {
    catch {interp delete xxx}
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
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







-
+




-
+


-
+




-
+





-
+





-
+







-
+







    interp create x
    interp alias x a x b
    x eval rename a c
    list [catch {x eval rename c b} msg] $msg
} {1 {cannot define or rename alias "b": would create a loop}}

#
# Test robustness of Tcl_DeleteInterp when applied to a child interpreter.
# Test robustness of Tcl_DeleteInterp when applied to a slave interpreter.
# If there are bugs in the implementation these tests are likely to expose
# the bugs as a core dump.
#

test interp-18.1 {testing Tcl_DeleteInterp vs children} testinterpdelete {
test interp-18.1 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
    list [catch {testinterpdelete} msg] $msg
} {1 {wrong # args: should be "testinterpdelete path"}}
test interp-18.2 {testing Tcl_DeleteInterp vs children} testinterpdelete {
test interp-18.2 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
    catch {interp delete a}
    interp create a
    testinterpdelete a
} ""
test interp-18.3 {testing Tcl_DeleteInterp vs children} testinterpdelete {
test interp-18.3 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
    catch {interp delete a}
    interp create a
    interp create {a b}
    testinterpdelete {a b}
} ""
test interp-18.4 {testing Tcl_DeleteInterp vs children} testinterpdelete {
test interp-18.4 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
    catch {interp delete a}
    interp create a
    interp create {a b}
    testinterpdelete a
} ""
test interp-18.5 {testing Tcl_DeleteInterp vs children} testinterpdelete {
test interp-18.5 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
    catch {interp delete a}
    interp create a
    interp create {a b}
    interp alias {a b} dodel {} dodel
    proc dodel {x} {testinterpdelete $x}
    list [catch {interp eval {a b} {dodel {a b}}} msg] $msg
} {0 {}}
test interp-18.6 {testing Tcl_DeleteInterp vs children} testinterpdelete {
test interp-18.6 {testing Tcl_DeleteInterp vs slaves} testinterpdelete {
    catch {interp delete a}
    interp create a
    interp create {a b}
    interp alias {a b} dodel {} dodel
    proc dodel {x} {testinterpdelete $x}
    list [catch {interp eval {a b} {dodel a}} msg] $msg
} {0 {}}
1611
1612
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
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
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
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

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
1668
1669

1670
1671

1672
1673
1674
1675
1676
1677
1678
1679







-
+

-
-
+
+

-
+


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+

-





+
-
-
+
+

-

-
+
-

-
-
+
+
+

-

-
+
-

+
-
-
+
+

-
-

+





-

+
-
-
+
+

-

-
+
-

-
-
+
+
+

-

-
+
-

+
-
-
+
+

-
-

+





-

+
-
+







    interp delete a
    set l
} {1 {cannot use namespace qualifiers in hidden command token (rename)}}
test interp-20.49 {interp invokehidden -namespace} -setup {
    set script [makeFile {
	set x [namespace current]
    } script]
    interp create -safe child
    interp create -safe slave
} -body {
    child invokehidden -namespace ::foo source $script
    child eval {set ::foo::x}
    slave invokehidden -namespace ::foo source $script
    slave eval {set ::foo::x}
} -cleanup {
    interp delete child
    interp delete slave
    removeFile script
} -result ::foo
test interp-20.50 {Bug 2486550} -setup {

    interp create child
} -body {
    child hide coroutine
    child invokehidden coroutine
} -cleanup {
    interp delete child
} -returnCodes error -match glob -result *
test interp-20.50.1 {Bug 2486550} -setup {
    interp create child
} -body {
    child hide coroutine
    catch {child invokehidden coroutine} m o
    dict get $o -errorinfo
} -cleanup {
    unset -nocomplain m 0
    interp delete child
} -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?"
    while executing
"coroutine"
    invoked from within
"child invokehidden coroutine"}

test interp-21.1 {interp hidden} {
    interp hidden {}
} ""
test interp-21.2 {interp hidden} {
    interp hidden
} ""
test interp-21.3 {interp hidden vs interp hide, interp expose} -setup {
test interp-21.3 {interp hidden vs interp hide, interp expose} {
    set l ""
} -body {
    lappend l [interp hidden]
    interp hide {} pwd
    lappend l [interp hidden]
    interp expose {} pwd
    lappend l [interp hidden]
    set l
} -result {{} pwd {}}
test interp-21.4 {interp hidden} -setup {
} {{} pwd {}}
test interp-21.4 {interp hidden} {
    catch {interp delete a}
} -body {
    interp create a
    interp hidden a
    set l [interp hidden a]
} -cleanup {
    interp delete a
} -result ""
test interp-21.5 {interp hidden} -setup {
    set l
} ""
test interp-21.5 {interp hidden} {
    catch {interp delete a}
} -body {
    interp create -safe a
    lsort [interp hidden a]
    set l [lsort [interp hidden a]]
} -cleanup {
    interp delete a
    set l
} -result $hidden_cmds
test interp-21.6 {interp hidden vs interp hide, interp expose} -setup {
} $hidden_cmds
test interp-21.6 {interp hidden vs interp hide, interp expose} {
    catch {interp delete a}
    set l ""
} -body {
    interp create a
    set l ""
    lappend l [interp hidden a]
    interp hide a pwd
    lappend l [interp hidden a]
    interp expose a pwd
    lappend l [interp hidden a]
} -cleanup {
    interp delete a
    set l
} -result {{} pwd {}}
test interp-21.7 {interp hidden} -setup {
} {{} pwd {}}
test interp-21.7 {interp hidden} {
    catch {interp delete a}
} -body {
    interp create a
    a hidden
    set l [a hidden]
} -cleanup {
    interp delete a
} -result ""
test interp-21.8 {interp hidden} -setup {
    set l
} ""
test interp-21.8 {interp hidden} {
    catch {interp delete a}
} -body {
    interp create a -safe
    lsort [a hidden]
    set l [lsort [a hidden]]
} -cleanup {
    interp delete a
    set l
} -result $hidden_cmds
test interp-21.9 {interp hidden vs interp hide, interp expose} -setup {
} $hidden_cmds
test interp-21.9 {interp hidden vs interp hide, interp expose} {
    catch {interp delete a}
    set l ""
} -body {
    interp create a
    set l ""
    lappend l [a hidden]
    a hide pwd
    lappend l [a hidden]
    a expose pwd
    lappend l [a hidden]
} -cleanup {
    interp delete a
    set l
} -result {{} pwd {}}
} {{} pwd {}}

test interp-22.1 {testing interp marktrusted} {
    catch {interp delete a}
    interp create a
    set l ""
    lappend l [a issafe]
    lappend l [a marktrusted]
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


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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666

2667
2668

2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732

2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743


2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766


2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781


2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795

2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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

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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712


2713
2714
2715
2716
2717




2718
2719
2720
2721
2722
2723
2724
2725
2726


2727
2728
2729
2730
2731
2732
2733
2734


2735
2736
2737





















2738












2739











2740
2741























2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756


2757
2758
2759
2760












2761































































































2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775

2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789


2790
2791
2792
2793
2794
2795
2796

2797
2798

2799
2800
2801

2802
2803
2804
2805
2806

2807
2808

2809
2810
2811

2812
2813
2814
2815
2816

2817
2818

2819
2820
2821

2822
2823
2824
2825
2826

2827
2828

2829
2830
2831
2832



2833
2834
2835
2836
2837
2838
2839



2840
2841
2842
2843
2844
2845
2846




2847
2848
2849
2850
2851
2852
2853
2854




2855
2856
2857
2858
2859
2860
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







-
+

-
-

+


-
+
+

-
+
+

-
-
+
+

+
-
-
+
+

-
-

+


-
+
+

-
+
+

-
+
-
+

-
+
+

-
+

-

+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-

+
+
-
-
+
+

-

+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-

+
+
-
-
+
+

-






-
-
-
-
+
+
+
+
+
+
+
+
-

+
-
-
+
+

-






-
+
+




+
-
+
-

+
-
-
+
+


-






-
-
-
-
+
+
+
+
+
+
+
+
-

-
-
-
+
+
+


-






-
-
-
-
+
+
+
+
+
+
+
+
-

-
-
-
+
+
+

-
-




+
-
-
+
+
+
-
+

+
-
-
+
+

-
-




+
-
-
+
+
+
-
+

+
-
-
+
+

-
-










+
-
-
+
+
+
-
+

+
-
-
+
+

-
-










+
-
-
+
+
+
-
+

+
-
-
+
+

-







+
-
-
+
+
+
+
+


-
+
-

+
-
-
+
+

-







+
-
-
+
+
+
+
+


-
+
-

+
-
+

+
+
-
+

-



+
-
+







-
-
+
+
+










+
+













+

-
-
-
+
+
+
+













+













+
-
+
+
+
+


-
-
-






-
-

+
-
-
+
+
+
-
-
-
-
+
+
+
+

-
-
+
+



-
-
+
+







-
-
-
-
-
-
+
+
+
+
+
+
+

+
-
-
+
+
-






-
-
+
+
-
-
-
+
+
+





+
-
+
-
-
-
-
-
+
+
+
+
+






-
-
+
+
-
-
-
+
+
+




-
-
+
+
-
-
+

-
-
+
+

-
+

-
-

+
-
-
-
+
+
+
+
-
-
+

-
-
+
+

-
+

-
-

+
-
-
-
+
+
+
+
-
-
+

-
-
+
+


-
+

-
-

+
-
-
-
+
+
+
+
-

-
+

-
-
+
+


-
+

-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+

+
-
-
-
+
+
+
-
-
+



-
+

-
+



-
-
-
-
-
+
+
+
+
+

-
-
-
+


-
+

-
-
+

-
-
+
+
+
+
-

+
-
+












+



+



+






+






+






+






+
-
+





+
-
+





+
-
+





+
-
+





+
-
+





+



+






+






+










+







+







+







+







+










-
+
+










-
+
+










-
+
+

-
-
+
+













-
-
+
+


+

-
-
+
+













-
-
+
+


+

-
-
+
+













-
-
+
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
+
+






-
-
+
+


+
-
-
-
-
+
+
+
+




-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+






-
-
+
+


+
-
-
-
-
+
+
+
+





-
-
+
+






-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+













-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
+
+












-
-
+
+
+




-
+

-
+

+
-
+




-
+

-
+

+
-
+




-
+

-
+

+
-
+




-
+

-
+

+

-
-
-
+
+
+


+

-
-
-
+
+
+


+

-
-
-
-
+
+
+
+


+

-
-
-
-
+
+
+
+


+

-
-
-
-
+
+
+
+


+

-
-
-
-
+
+
+
+


+

-
-
-
-
+
+
+
+


+

-
-
-
+
+
+


+

-
+

-
-
+
+

-
+




-
+


+

-
+

-
-
+
+

-
+




-
+







    lappend l [interp issafe {a b}]
    interp create {a b c}
    lappend l [interp issafe {a b c}]
    interp delete a
    set l
} {1 1 1 0 0}

test interp-23.1 {testing hiding vs aliases: unsafe interp} -setup {
test interp-23.1 {testing hiding vs aliases} {
    catch {interp delete a}
    set l ""
} -body {
    interp create a
    set l ""
    lappend l [interp hidden a]
    a alias bar bar
    lappend l [interp aliases a] [interp hidden a]
    lappend l [interp aliases a]
    lappend l [interp hidden a]
    a hide bar
    lappend l [interp aliases a] [interp hidden a]
    lappend l [interp aliases a]
    lappend l [interp hidden a]
    a alias bar {}
    lappend l [interp aliases a] [interp hidden a]
} -cleanup {
    lappend l [interp aliases a]
    lappend l [interp hidden a]
    interp delete a
    set l
} -result {{} bar {} bar bar {} {}}
test interp-23.2 {testing hiding vs aliases: safe interp} -setup {
} {{} bar {} bar bar {} {}}
test interp-23.2 {testing hiding vs aliases} {unixOrWin} {
    catch {interp delete a}
    set l ""
} -constraints {unixOrWin} -body {
    interp create a -safe
    set l ""
    lappend l [lsort [interp hidden a]]
    a alias bar bar
    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
    lappend l [lsort [interp aliases a]]
    lappend l [lsort [interp hidden a]]
    a hide bar
    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
    lappend l [lsort [interp aliases a]]
    lappend l [lsort [interp hidden a]]
    a alias bar {}
    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
    lappend l [lsort [interp aliases a]]
} -cleanup {
    lappend l [lsort [interp hidden a]]
    interp delete a
} -result [list $hidden_cmds {bar clock} $hidden_cmds {bar clock} [lsort [concat $hidden_cmds bar]] {clock} $hidden_cmds]
    set l
} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}}

test interp-24.1 {result resetting on error} -setup {
test interp-24.1 {result resetting on error} {
    catch {interp delete a}
} -body {
    interp create a
    proc foo args {error $args}
    interp alias a foo {} apply {args {error $args}}
    interp eval a {
	lappend l [catch {foo 1 2 3} msg] $msg
	lappend l [catch {foo 3 4 5} msg] $msg
    }
    interp alias a foo {} foo
    set l [interp eval a {
	set l {}
	lappend l [catch {foo 1 2 3} msg]
	lappend l $msg
	lappend l [catch {foo 3 4 5} msg]
	lappend l $msg
	set l
    }]
} -cleanup {
    interp delete a
    rename foo {}
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.2 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.2 {result resetting on error} {
    catch {interp delete a}
} -body {
    interp create a -safe
    proc foo args {error $args}
    interp alias a foo {} apply {args {error $args}}
    interp eval a {
	lappend l [catch {foo 1 2 3} msg] $msg
	lappend l [catch {foo 3 4 5} msg] $msg
    }
    interp alias a foo {} foo
    set l [interp eval a {
	set l {}
	lappend l [catch {foo 1 2 3} msg]
	lappend l $msg
	lappend l [catch {foo 3 4 5} msg]
	lappend l $msg
	set l
    }]
} -cleanup {
    interp delete a
    rename foo {}
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.3 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.3 {result resetting on error} {
    catch {interp delete a}
} -body {
    interp create a
    interp create {a b}
    interp eval a {
	proc foo args {error $args}
    }
    interp alias {a b} foo a foo
    interp eval {a b} {
	lappend l [catch {foo 1 2 3} msg] $msg
	lappend l [catch {foo 3 4 5} msg] $msg
    }
    set l [interp eval {a b} {
	set l {}
	lappend l [catch {foo 1 2 3} msg]
	lappend l $msg
	lappend l [catch {foo 3 4 5} msg]
	lappend l $msg
	set l
    }]
} -cleanup {
    interp delete a
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.4 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.4 {result resetting on error} {
    catch {interp delete a}
} -body {
    interp create a -safe
    interp create {a b}
    interp eval a {
	proc foo args {error $args}
    }
    interp alias {a b} foo a foo
    interp eval {a b} {
    set l [interp eval {a b} {
	set l {}
	lappend l [catch {foo 1 2 3} msg]
	lappend l $msg
	lappend l [catch {foo 3 4 5} msg]
	lappend l $msg
	set l
    }
    }]
} -cleanup {
    interp delete a
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.5 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.5 {result resetting on error} {
    catch {interp delete a}
    catch {interp delete b}
} -body {
    interp create a
    interp create b
    interp eval a {
	proc foo args {error $args}
    }
    interp alias b foo a foo
    interp eval b {
	lappend l [catch {foo 1 2 3} msg] $msg
	lappend l [catch {foo 3 4 5} msg] $msg
    }
    set l [interp eval b {
	set l {}
	lappend l [catch {foo 1 2 3} msg]
	lappend l $msg
	lappend l [catch {foo 3 4 5} msg]
	lappend l $msg
	set l
    }]
} -cleanup {
    interp delete a
    interp delete b
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.6 {result resetting on error} -setup {
    set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.6 {result resetting on error} {
    catch {interp delete a}
    catch {interp delete b}
} -body {
    interp create a -safe
    interp create b -safe
    interp eval a {
	proc foo args {error $args}
    }
    interp alias b foo a foo
    interp eval b {
	lappend l [catch {foo 1 2 3} msg] $msg
	lappend l [catch {foo 3 4 5} msg] $msg
    }
    set l [interp eval b {
	set l {}
	lappend l [catch {foo 1 2 3} msg]
	lappend l $msg
	lappend l [catch {foo 3 4 5} msg]
	lappend l $msg
	set l
    }]
} -cleanup {
    interp delete a
    interp delete b
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.7 {result resetting on error} -setup {
    set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.7 {result resetting on error} {
    catch {interp delete a}
    set l {}
} -body {
    interp create a
    interp eval a {
	proc foo args {error $args}
    }
    set l {}
    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
    lappend l [catch {interp eval a foo 1 2 3} msg]
    lappend l $msg
    lappend l [catch {interp eval a foo 3 4 5} msg]
} -cleanup {
    lappend l $msg
    interp delete a
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.8 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.8 {result resetting on error} {
    catch {interp delete a}
    set l {}
} -body {
    interp create a -safe
    interp eval a {
	proc foo args {error $args}
    }
    set l {}
    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
    lappend l [catch {interp eval a foo 1 2 3} msg]
    lappend l $msg
    lappend l [catch {interp eval a foo 3 4 5} msg]
} -cleanup {
    lappend l $msg
    interp delete a
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.9 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.9 {result resetting on error} {
    catch {interp delete a}
    set l {}
} -body {
    interp create a
    interp create {a b}
    interp eval {a b} {
	proc foo args {error $args}
    }
    interp eval a {
	proc foo args {
	    eval interp eval b foo $args
	}
    }
    set l {}
    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
    lappend l [catch {interp eval a foo 1 2 3} msg]
    lappend l $msg
    lappend l [catch {interp eval a foo 3 4 5} msg]
} -cleanup {
    lappend l $msg
    interp delete a
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.10 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.10 {result resetting on error} {
    catch {interp delete a}
    set l {}
} -body {
    interp create a -safe
    interp create {a b}
    interp eval {a b} {
	proc foo args {error $args}
    }
    interp eval a {
	proc foo args {
	    eval interp eval b foo $args
	}
    }
    set l {}
    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
    lappend l [catch {interp eval a foo 1 2 3} msg]
    lappend l $msg
    lappend l [catch {interp eval a foo 3 4 5} msg]
} -cleanup {
    lappend l $msg
    interp delete a
    set l
} -result {1 {1 2 3} 1 {3 4 5}}
test interp-24.11 {result resetting on error} -setup {
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.11 {result resetting on error} {
    catch {interp delete a}
} -body {
    interp create a
    interp create {a b}
    interp eval {a b} {
	proc foo args {error $args}
    }
    interp eval a {
	proc foo args {
	    set l {}
	    lappend l [catch {eval interp eval b foo $args} msg] $msg
	    lappend l [catch {eval interp eval b foo $args} msg] $msg
	    lappend l [catch {eval interp eval b foo $args} msg]
	    lappend l $msg
	    lappend l [catch {eval interp eval b foo $args} msg]
	    lappend l $msg
	    set l
	}
    }
    interp eval a foo 1 2 3
    set l [interp eval a foo 1 2 3]
} -cleanup {
    interp delete a
    set l
} -result {1 {1 2 3} 1 {1 2 3}}
test interp-24.12 {result resetting on error} -setup {
} {1 {1 2 3} 1 {1 2 3}}
test interp-24.12 {result resetting on error} {
    catch {interp delete a}
} -body {
    interp create a -safe
    interp create {a b}
    interp eval {a b} {
	proc foo args {error $args}
    }
    interp eval a {
	proc foo args {
	    set l {}
	    lappend l [catch {eval interp eval b foo $args} msg] $msg
	    lappend l [catch {eval interp eval b foo $args} msg] $msg
	    lappend l [catch {eval interp eval b foo $args} msg]
	    lappend l $msg
	    lappend l [catch {eval interp eval b foo $args} msg]
	    lappend l $msg
	    set l
	}
    }
    interp eval a foo 1 2 3
    set l [interp eval a foo 1 2 3]
} -cleanup {
    interp delete a
    set l
} -result {1 {1 2 3} 1 {1 2 3}}
} {1 {1 2 3} 1 {1 2 3}}

unset hidden_cmds

test interp-25.1 {testing aliasing of string commands} -setup {
test interp-25.1 {testing aliasing of string commands} {
    catch {interp delete a}
} -body {
    interp create a
    a alias exec foo		;# Relies on exec being a string command!
    interp delete a
} ""
} -result ""


#
# Interps result transmission
#

test interp-26.1 {result code transmission : interp eval direct} {
    # Test that all the possibles error codes from Tcl get passed up
    # from the child interp's context to the parent, even though the
    # child nominally thinks the command is running at the root level.
    # from the slave interp's context to the master, even though the
    # slave nominally thinks the command is running at the root level.

    catch {interp delete a}
    interp create a
    set res {}
    # use a for so if a return -code break 'escapes' we would notice
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp eval a return -code $code} msg]
    }
    interp delete a
    set res
} {-1 0 1 2 3 4 5}


test interp-26.2 {result code transmission : interp eval indirect} {
    # retcode == 2 == return is special
    catch {interp delete a}
    interp create a
    interp eval a {proc retcode {code} {return -code $code ret$code}}
    set res {}
    # use a for so if a return -code break 'escapes' we would notice
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp eval a retcode $code} msg] $msg
    }
    interp delete a
    set res
} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}

test interp-26.3 {result code transmission : aliases} {
    # Test that all the possibles error codes from Tcl get passed up from the
    # child interp's context to the parent, even though the child nominally
    # thinks the command is running at the root level.
    # Test that all the possibles error codes from Tcl get passed up
    # from the slave interp's context to the master, even though the
    # slave nominally thinks the command is running at the root level.

    catch {interp delete a}
    interp create a
    set res {}
    proc MyTestAlias {code} {
	return -code $code ret$code
    }
    interp alias a Test {} MyTestAlias
    for {set code -1} {$code<=5} {incr code} {
	lappend res [interp eval a [list catch [list Test $code] msg]]
    }
    interp delete a
    set res
} {-1 0 1 2 3 4 5}

test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
	{knownBug} {
    # The known bug is that code 2 is returned, not the -code argument
    catch {interp delete a}
    interp create a
    set res {}
    interp hide a return
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp invokehidden a return -code $code ret$code}]
    }
    interp delete a
    set res
} {-1 0 1 2 3 4 5}

test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} -setup {
test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} \
	{knownBug} {
    # The known bug is that the break and continue should raise errors
    # that they are used outside a loop.
    catch {interp delete a}
    interp create a
} -body {
    # The known bug is that the break and continue should raise errors that
    # they are used outside a loop.
    set res {}
    interp eval a {proc retcode {code} {return -code $code ret$code}}
    interp hide a retcode
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp invokehidden a retcode $code} msg] $msg
    }
    return $res
} -cleanup {
    interp delete a
    set res
} -result {-1 ret-1 0 ret0 1 ret1 2 ret2 3 ret3 4 ret4 5 ret5}
test interp-26.6 {result code transmission: all combined--bug 1637} -setup {
} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}

test interp-26.6 {result code transmission: all combined--bug 1637} \
    set interp [interp create]
} -constraints knownBug -body {
    # Test that all the possibles error codes from Tcl get passed in both
    # directions.  This doesn't work.
	{knownBug} {
    # Test that all the possibles error codes from Tcl get passed
    # In both directions.  This doesn't work.
    set interp [interp create];
    proc MyTestAlias {interp args} {
	global aliasTrace
	lappend aliasTrace $args
	global aliasTrace;
	lappend aliasTrace $args;
	interp invokehidden $interp {*}$args
    }
    foreach c {return} {
	interp hide $interp  $c
        interp alias $interp $c {} MyTestAlias $interp $c
	interp hide $interp  $c;
        interp alias $interp $c {} MyTestAlias $interp $c;
    }
    interp eval $interp {proc ret {code} {return -code $code ret$code}}
    set res {}
    set aliasTrace {}
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp eval $interp ret $code} msg] $msg
    }
    return $res
} -cleanup {
    interp delete $interp
} -result {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
# Some tests might need to be added to check for difference between toplevel
# and non-toplevel evals.
    interp delete $interp;
    set res
} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}

# Some tests might need to be added to check for difference between
# toplevel and non toplevel evals.

# End of return code transmission section

test interp-26.7 {errorInfo transmission: regular interps} -setup {
    set interp [interp create]
test interp-26.7 {errorInfo transmission: regular interps} {
    set interp [interp create];
} -body {
    proc MyError {secret} {
	return -code error "msg"
    }
    proc MyTestAlias {interp args} {
	MyError "some secret"
    }
    interp alias $interp test {} MyTestAlias $interp
    interp eval $interp {catch test;set ::errorInfo}
    interp alias $interp test {} MyTestAlias $interp;
    set res [interp eval $interp {catch test;set ::errorInfo}]
} -cleanup {
    interp delete $interp
} -result {msg
    interp delete $interp;
    set res
} {msg
    while executing
"MyError "some secret""
    (procedure "MyTestAlias" line 2)
    invoked from within
"test"}

test interp-26.8 {errorInfo transmission: safe interps--bug 1637} -setup {
test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
    set interp [interp create -safe]
} -constraints knownBug -body {
    # this test fails because the errorInfo is fully transmitted whether the
    # interp is safe or not.  The errorInfo should never report data from the
    # parent interpreter because it could contain sensitive information.
    # this test fails because the errorInfo is fully transmitted
    # whether the interp is safe or not.  The errorInfo should never
    # report data from the master interpreter because it could
    # contain sensitive information.
    set interp [interp create -safe];
    proc MyError {secret} {
	return -code error "msg"
    }
    proc MyTestAlias {interp args} {
	MyError "some secret"
    }
    interp alias $interp test {} MyTestAlias $interp
    interp eval $interp {catch test;set ::errorInfo}
    interp alias $interp test {} MyTestAlias $interp;
    set res [interp eval $interp {catch test;set ::errorInfo}]
} -cleanup {
    interp delete $interp
} -result {msg
    interp delete $interp;
    set res
} {msg
    while executing
"test"}

# Interps & Namespaces
test interp-27.1 {interp aliases & namespaces} -setup {
    set i [interp create]
test interp-27.1 {interp aliases & namespaces} {
    set i [interp create];
} -body {
    set aliasTrace {}
    set aliasTrace {};
    proc tstAlias {args} {
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
	global aliasTrace;
	lappend aliasTrace [list [namespace current] $args];
    }
    $i alias foo::bar tstAlias foo::bar
    $i alias foo::bar tstAlias foo::bar;
    $i eval foo::bar test
    return $aliasTrace
} -cleanup {
    interp delete $i
    set aliasTrace;
} -result {{:: {foo::bar test}}}
test interp-27.2 {interp aliases & namespaces} -setup {
    set i [interp create]
} {{:: {foo::bar test}}}

test interp-27.2 {interp aliases & namespaces} {
    set i [interp create];
} -body {
    set aliasTrace {}
    set aliasTrace {};
    proc tstAlias {args} {
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
	global aliasTrace;
	lappend aliasTrace [list [namespace current] $args];
    }
    $i alias foo::bar tstAlias foo::bar
    $i alias foo::bar tstAlias foo::bar;
    $i eval namespace eval foo {bar test}
    return $aliasTrace
} -cleanup {
    interp delete $i
    set aliasTrace;
} -result {{:: {foo::bar test}}}
test interp-27.3 {interp aliases & namespaces} -setup {
    set i [interp create]
} {{:: {foo::bar test}}}

test interp-27.3 {interp aliases & namespaces} {
    set i [interp create];
} -body {
    set aliasTrace {}
    set aliasTrace {};
    proc tstAlias {args} {
	global aliasTrace
	lappend aliasTrace [list [namespace current] $args]
	global aliasTrace;
	lappend aliasTrace [list [namespace current] $args];
    }
    interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
    interp alias $i foo::bar {} tstAlias foo::bar
    interp alias $i foo::bar {} tstAlias foo::bar;
    interp eval $i {namespace eval foo {bar test}}
    return $aliasTrace
} -cleanup {
    interp delete $i
    set aliasTrace;
} -result {{:: {foo::bar test}}}
test interp-27.4 {interp aliases & namespaces} -setup {
    set i [interp create]
} {{:: {foo::bar test}}}

test interp-27.4 {interp aliases & namespaces} {
    set i [interp create];
} -body {
    namespace eval foo2 {
	variable aliasTrace {}
	variable aliasTrace {};
	proc bar {args} {
	    variable aliasTrace
	    lappend aliasTrace [list [namespace current] $args]
	    variable aliasTrace;
	    lappend aliasTrace [list [namespace current] $args];
	}
    }
    $i alias foo::bar foo2::bar foo::bar
    $i alias foo::bar foo2::bar foo::bar;
    $i eval namespace eval foo {bar test}
    return $foo2::aliasTrace
    set r $foo2::aliasTrace;
} -cleanup {
    namespace delete foo2
    interp delete $i
} -result {{::foo2 {foo::bar test}}}
test interp-27.5 {interp hidden & namespaces} -setup {
    set i [interp create]
    namespace delete foo2;
    set r
} {{::foo2 {foo::bar test}}}

# the following tests are commented out while we don't support
# hiding in namespaces

# test interp-27.5 {interp hidden & namespaces} {
#    set i [interp create];
} -constraints knownBug -body {
    interp eval $i {
	namespace eval foo {
	    proc bar {args} {
		return "bar called ([namespace current]) ($args)"
#    interp eval $i {
#        namespace eval foo {
#	    proc bar {args} {
#		return "bar called ([namespace current]) ($args)"
	    }
	}
    }
    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
    interp hide $i foo::bar
    lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
#	    }
#	}
#    }
#    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
#    interp hide $i foo::bar;
#    lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
} -cleanup {
    interp delete $i
} -result {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
test interp-27.6 {interp hidden & aliases & namespaces} -setup {
    set i [interp create]
#    interp delete $i;
#    set res;
#} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}

# test interp-27.6 {interp hidden & aliases & namespaces} {
#     set i [interp create];
} -constraints knownBug -body {
    set v root-parent
    namespace eval foo {
	variable v foo-parent
	proc bar {interp args} {
	    variable v
	    list "parent bar called ($v) ([namespace current]) ($args)"\
		[interp invokehidden $interp foo::bar $args]
#     set v root-master;
#     namespace eval foo {
# 	variable v foo-master;
# 	proc bar {interp args} {
# 	    variable v;
# 	    list "master bar called ($v) ([namespace current]) ($args)"\
# 		    [interp invokehidden $interp foo::bar $args];
	}
    }
    interp eval $i {
	namespace eval foo {
	    namespace export *
	    variable v foo-child
	    proc bar {args} {
		variable v
		return "child bar called ($v) ([namespace current]) ($args)"
# 	}
#     }
#     interp eval $i {
#        namespace eval foo {
# 	    namespace export *
# 	    variable v foo-slave;
# 	    proc bar {args} {
# 		variable v;
# 		return "slave bar called ($v) ([namespace current]) ($args)"
	    }
	}
    }
    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
    $i hide foo::bar
    $i alias foo::bar foo::bar $i
    set res [concat $res [interp eval $i {
	set v root-child
	namespace eval test {
	    variable v foo-test
	    namespace import ::foo::*
	    bar test2
# 	    }
# 	}
#     }
#     set res [list [interp eval $i {namespace eval foo {bar test1}}]]
#     $i hide foo::bar;
#     $i alias foo::bar foo::bar $i;
#     set res [concat $res [interp eval $i {
# 	set v root-slave;
#         namespace eval test {
# 	    variable v foo-test;
# 	    namespace import ::foo::*;
# 	    bar test2
	}
    }]]
#         }
#     }]]
} -cleanup {
    namespace delete foo
    interp delete $i
} -result {{child bar called (foo-child) (::foo) (test1)} {parent bar called (foo-parent) (::foo) (test2)} {child bar called (foo-child) (::foo) (test2)}}
test interp-27.7 {interp hidden & aliases & imports & namespaces} -setup {
    set i [interp create]
#     namespace delete foo;
#     interp delete $i;
#     set res
# } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}


# test interp-27.7 {interp hidden & aliases & imports & namespaces} {
#     set i [interp create];
} -constraints knownBug -body {
    set v root-parent
    namespace eval mfoo {
	variable v foo-parent
	proc bar {interp args} {
	    variable v
	    list "parent bar called ($v) ([namespace current]) ($args)"\
		[interp invokehidden $interp test::bar $args]
#     set v root-master;
#     namespace eval mfoo {
# 	variable v foo-master;
# 	proc bar {interp args} {
# 	    variable v;
# 	    list "master bar called ($v) ([namespace current]) ($args)"\
# 		    [interp invokehidden $interp test::bar $args];
	}
    }
    interp eval $i {
	namespace eval foo {
	    namespace export *
	    variable v foo-child
	    proc bar {args} {
		variable v
		return "child bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
# 	}
#     }
#     interp eval $i {
#       namespace eval foo {
# 	    namespace export *
# 	    variable v foo-slave;
# 	    proc bar {args} {
# 		variable v;
# 		return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
	    }
	}
	set v root-child
	namespace eval test {
	    variable v foo-test
	    namespace import ::foo::*
# 	    }
# 	}
# 	set v root-slave;
#       namespace eval test {
# 	    variable v foo-test;
# 	    namespace import ::foo::*;
	}
    }
    set res [list [interp eval $i {namespace eval test {bar test1}}]]
    $i hide test::bar
    $i alias test::bar mfoo::bar $i
    set res [concat $res [interp eval $i {test::bar test2}]]
#         }
#     }
#     set res [list [interp eval $i {namespace eval test {bar test1}}]]
#     $i hide test::bar;
#     $i alias test::bar mfoo::bar $i;
#     set res [concat $res [interp eval $i {test::bar test2}]];
} -cleanup {
    namespace delete mfoo
    interp delete $i
} -result {{child bar called (foo-child) (bar test1) (::tcltest) (::foo) (test1)} {parent bar called (foo-parent) (::mfoo) (test2)} {child bar called (foo-child) (test::bar test2) (::) (::foo) (test2)}}
test interp-27.8 {hiding, namespaces and integrity} knownBug {
    namespace eval foo {
	variable v 3
	proc bar {} {variable v; set v}
	# next command would currently generate an unknown command "bar" error.
	interp hide {} bar
#     namespace delete mfoo;
#     interp delete $i;
#     set res
# } {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}

#test interp-27.8 {hiding, namespaces and integrity} {
#    namespace eval foo {
#	variable v 3;
#	proc bar {} {variable v; set v}
#	# next command would currently generate an unknown command "bar" error.
#	interp hide {} bar;
    }
    namespace delete foo
    list [catch {interp invokehidden {} foo::bar} msg] $msg
} {1 {invalid hidden command name "foo"}}
#    }
#    namespace delete foo;
#    list [catch {interp invokehidden {} foo} msg] $msg;
#} {1 {invalid hidden command name "foo"}}


test interp-28.1 {getting fooled by child's namespace ?} -setup {
    set i [interp create -safe]
    proc parent {interp args} {interp hide $interp list}
test interp-28.1 {getting fooled by slave's namespace ?} {
    set i [interp create -safe];
    proc master {interp args} {interp hide $interp list}
} -body {
    $i alias parent parent $i
    $i alias master master $i;
    set r [interp eval $i {
        namespace eval foo {
	    proc list {args} {
		return "dummy foo::list"
		return "dummy foo::list";
	    }
	    parent
	    master;
	}
	info commands list
    }]
} -cleanup {
    rename parent {}
    interp delete $i
} -result {}
test interp-28.2 {parent's nsName cache should not cross} -setup {
    interp delete $i;
    set r
} {}

test interp-28.2 {master's nsName cache should not cross} {
    set i [interp create]
    $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}}
} -body {
    $i eval {
    set res [$i eval {
	set x {namespace children ::}
	set y [list namespace children ::]
	namespace delete {*}[filter [{*}$y]]
	namespace delete [{*}$y]
	set j [interp create]
	$j alias filter filter
	$j eval {namespace delete {*}[filter [namespace children ::]]}
	$j eval {namespace delete {*}[namespace children ::]}
	namespace eval foo {}
	list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
    }
	set res [list [eval $x] [eval $y] [$j eval $x] [$j eval $y]]
	interp delete $j
	set res
    }]
} -cleanup {
    interp delete $i
    set res
} -result {::foo ::foo {} {}}
} {::foo ::foo {} {}}

# Part 29: recursion limit
#  29.1.*  Argument checking
#  29.2.*  Reading and setting the recursion limit
#  29.3.*  Does the recursion limit work?
#  29.4.*  Recursion limit inheritance by sub-interpreters
#  29.5.*  Confirming the recursionlimit command does not affect the parent
#  29.6.*  Safe interpreter restriction

test interp-29.1.1 {interp recursionlimit argument checking} {
    list [catch {interp recursionlimit} msg] $msg
} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}

test interp-29.1.2 {interp recursionlimit argument checking} {
    list [catch {interp recursionlimit foo bar} msg] $msg
} {1 {could not find interpreter "foo"}}

test interp-29.1.3 {interp recursionlimit argument checking} {
    list [catch {interp recursionlimit foo bar baz} msg] $msg
} {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}

test interp-29.1.4 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo bar} msg]
    interp delete moo
    list $result $msg
} {1 {expected integer but got "bar"}}

test interp-29.1.5 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo 0} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit must be > 0}}

test interp-29.1.6 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo -1} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit must be > 0}}

test interp-29.1.7 {interp recursionlimit argument checking} {
    interp create moo
    set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}

test interp-29.1.8 {child recursionlimit argument checking} {
test interp-29.1.8 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit foo bar} msg]
    interp delete moo
    list $result $msg
} {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}}

test interp-29.1.9 {child recursionlimit argument checking} {
test interp-29.1.9 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit foo} msg]
    interp delete moo
    list $result $msg
} {1 {expected integer but got "foo"}}

test interp-29.1.10 {child recursionlimit argument checking} {
test interp-29.1.10 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit 0} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit must be > 0}}

test interp-29.1.11 {child recursionlimit argument checking} {
test interp-29.1.11 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit -1} msg]
    interp delete moo
    list $result $msg
} {1 {recursion limit must be > 0}}

test interp-29.1.12 {child recursionlimit argument checking} {
test interp-29.1.12 {slave recursionlimit argument checking} {
    interp create moo
    set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
    interp delete moo
    list $result [string range $msg 0 35]
} {1 {integer value too large to represent}}

test interp-29.2.1 {query recursion limit} {
    interp recursionlimit {}
} 1000

test interp-29.2.2 {query recursion limit} {
    set i [interp create]
    set n [interp recursionlimit $i]
    interp delete $i
    set n
} 1000

test interp-29.2.3 {query recursion limit} {
    set i [interp create]
    set n [$i recursionlimit]
    interp delete $i
    set n
} 1000

test interp-29.2.4 {query recursion limit} {
    set i [interp create]
    set r [$i eval {
	set n1 [interp recursionlimit {} 42]
	set n2 [interp recursionlimit {}]
	list $n1 $n2
    }]
    interp delete $i
    set r
} {42 42}

test interp-29.2.5 {query recursion limit} {
    set i [interp create]
    set n1 [interp recursionlimit $i 42]
    set n2 [interp recursionlimit $i]
    interp delete $i
    list $n1 $n2
} {42 42}

test interp-29.2.6 {query recursion limit} {
    set i [interp create]
    set n1 [interp recursionlimit $i 42]
    set n2 [$i recursionlimit]
    interp delete $i
    list $n1 $n2
} {42 42}

test interp-29.2.7 {query recursion limit} {
    set i [interp create]
    set n1 [$i recursionlimit 42]
    set n2 [interp recursionlimit $i]
    interp delete $i
    list $n1 $n2
} {42 42}

test interp-29.2.8 {query recursion limit} {
    set i [interp create]
    set n1 [$i recursionlimit 42]
    set n2 [$i recursionlimit]
    interp delete $i
    list $n1 $n2
} {42 42}

test interp-29.3.1 {recursion limit} {
    set i [interp create]
    set r [interp eval $i {
	interp recursionlimit {} 50
	proc p {} {incr ::i; p}
	set i 0
	list [catch p msg] $msg $i
    }]
    interp delete $i
    set r
} {1 {too many nested evaluations (infinite loop?)} 49}
} {1 {too many nested evaluations (infinite loop?)} 48}

test interp-29.3.2 {recursion limit} {
    set i [interp create]
    interp recursionlimit $i 50
    set r [interp eval $i {
	proc p {} {incr ::i; p}
	set i 0
	list [catch p msg] $msg $i
    }]
   interp delete $i
   set r
} {1 {too many nested evaluations (infinite loop?)} 49}
} {1 {too many nested evaluations (infinite loop?)} 48}

test interp-29.3.3 {recursion limit} {
    set i [interp create]
    $i recursionlimit 50
    set r [interp eval $i {
	proc p {} {incr ::i; p}
	set i 0
	list [catch p msg] $msg $i
    }]
   interp delete $i
   set r
} {1 {too many nested evaluations (infinite loop?)} 49}
} {1 {too many nested evaluations (infinite loop?)} 48}

test interp-29.3.4 {recursion limit error reporting} {
    interp create child
    set r1 [child eval {
    interp create slave
    set r1 [slave eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			     interp recursionlimit {} 5
			     set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {1 {falling back due to new recursion limit}}

test interp-29.3.5 {recursion limit error reporting} {
    interp create child
    set r1 [child eval {
    interp create slave
    set r1 [slave eval {
        catch {			# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    interp recursionlimit {} 4
			    set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {1 {falling back due to new recursion limit}}

test interp-29.3.6 {recursion limit error reporting} {
    interp create child
    set r1 [child eval {
    interp create slave
    set r1 [slave eval {
        catch {			# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    interp recursionlimit {} 6
			    set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {0 ok}
#
# Note that TEBC does not verify the interp's nesting level itself; the nesting
# level will only be verified when it invokes a non-bcc'd command.
#
test interp-29.3.7a {recursion limit error reporting} {
    interp create child
    after 0 {interp recursionlimit child 5}
    set r1 [child eval {

test interp-29.3.7 {recursion limit error reporting} {
    interp create slave
    after 0 {interp recursionlimit slave 5}
    set r1 [slave eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			     update
			     set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}

test interp-29.3.8 {recursion limit error reporting} {
    interp create slave
    after 0 {interp recursionlimit slave 4}
    set r1 [slave eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			     update
			     set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}

test interp-29.3.9 {recursion limit error reporting} {
    interp create slave
    after 0 {interp recursionlimit slave 6}
    set r1 [slave eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			    set x ok
			     update
			     set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {0 ok}

test interp-29.3.7b {recursion limit error reporting} {
    interp create child
    after 0 {interp recursionlimit child 5}
    set r1 [child eval {
test interp-29.3.10 {recursion limit error reporting} {
    interp create slave
    after 0 {slave recursionlimit 4}
    set r1 [slave eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
			update
		        eval {	# 5
			    set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {0 ok}
test interp-29.3.7c {recursion limit error reporting} {
    interp create child
    after 0 {interp recursionlimit child 5}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			     update
			    set set set
			    $set x ok
			     set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}

test interp-29.3.8a {recursion limit error reporting} {
    interp create child
    after 0 {interp recursionlimit child 4}
    set r1 [child eval {
test interp-29.3.11 {recursion limit error reporting} {
    interp create slave
    after 0 {slave recursionlimit 5}
    set r1 [slave eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			    set x ok
			     update
			     set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {0 ok}
test interp-29.3.8b {recursion limit error reporting} {
    interp create child
    after 0 {interp recursionlimit child 4}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
			update
		        eval {	# 5
			    set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
test interp-29.3.9a {recursion limit error reporting} {
    interp create child
    after 0 {interp recursionlimit child 6}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			    set x ok
			}

		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {0 ok}
test interp-29.3.9b {recursion limit error reporting} {
    interp create child
test interp-29.3.12 {recursion limit error reporting} {
    interp create slave
    after 0 {interp recursionlimit child 6}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    set set set
			    $set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {0 ok}
test interp-29.3.10a {recursion limit error reporting} {
    interp create child
    after 0 {child recursionlimit 4}
    set r1 [child eval {
    after 0 {slave recursionlimit 6}
    set r1 [slave eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			     update
			     set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    set r2 [slave eval { set msg }]
    interp delete slave
    list $r1 $r2
} {0 ok}
test interp-29.3.10b {recursion limit error reporting} {
    interp create child
    after 0 {child recursionlimit 4}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
			update
		        eval {	# 5
			    set x ok
			}

		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
test interp-29.3.11a {recursion limit error reporting} {
    interp create child
    after 0 {child recursionlimit 5}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			    set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {0 ok}
test interp-29.3.11b {recursion limit error reporting} {
    interp create child
    after 0 {child recursionlimit 5}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			    set set set
			    $set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {1 {too many nested evaluations (infinite loop?)}}
test interp-29.3.12a {recursion limit error reporting} {
    interp create child
    after 0 {child recursionlimit 6}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			    set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {0 ok}
test interp-29.3.12b {recursion limit error reporting} {
    interp create child
    after 0 {child recursionlimit 6}
    set r1 [child eval {
        catch { 		# nesting level 1
	    eval {		# 2
	        eval {		# 3
		    eval {	# 4
		        eval {	# 5
			    update
			    set set set
			    $set x ok
			}
		    }
		}
	    }
	} msg
    }]
    set r2 [child eval { set msg }]
    interp delete child
    list $r1 $r2
} {0 ok}
test interp-29.4.1 {recursion limit inheritance} {
    set i [interp create]
    set ii [interp eval $i {
	interp recursionlimit {} 50
	interp create
    }]
    set r [interp eval [list $i $ii] {
	proc p {} {incr ::i; p}
	set i 0
	catch p
	set i
    }]
   interp delete $i
   set r
} 50
} 49

test interp-29.4.2 {recursion limit inheritance} {
    set i [interp create]
    $i recursionlimit 50
    set ii [interp eval $i {interp create}]
    set r [interp eval [list $i $ii] {
	proc p {} {incr ::i; p}
	set i 0
	catch p
	set i
    }]
   interp delete $i
   set r
} 50
test interp-29.5.1 {does child recursion limit affect parent?} {
} 49

test interp-29.5.1 {does slave recursion limit affect master?} {
    set before [interp recursionlimit {}]
    set i [interp create]
    interp recursionlimit $i 20000
    set after [interp recursionlimit {}]
    set childlimit [interp recursionlimit $i]
    set slavelimit [interp recursionlimit $i]
    interp delete $i
    list [expr {$before == $after}] $childlimit
    list [expr {$before == $after}] $slavelimit
} {1 20000}

test interp-29.5.2 {does child recursion limit affect parent?} {
test interp-29.5.2 {does slave recursion limit affect master?} {
    set before [interp recursionlimit {}]
    set i [interp create]
    interp recursionlimit $i 20000
    set after [interp recursionlimit {}]
    set childlimit [$i recursionlimit]
    set slavelimit [$i recursionlimit]
    interp delete $i
    list [expr {$before == $after}] $childlimit
    list [expr {$before == $after}] $slavelimit
} {1 20000}

test interp-29.5.3 {does child recursion limit affect parent?} {
test interp-29.5.3 {does slave recursion limit affect master?} {
    set before [interp recursionlimit {}]
    set i [interp create]
    $i recursionlimit 20000
    set after [interp recursionlimit {}]
    set childlimit [interp recursionlimit $i]
    set slavelimit [interp recursionlimit $i]
    interp delete $i
    list [expr {$before == $after}] $childlimit
    list [expr {$before == $after}] $slavelimit
} {1 20000}

test interp-29.5.4 {does child recursion limit affect parent?} {
test interp-29.5.4 {does slave recursion limit affect master?} {
    set before [interp recursionlimit {}]
    set i [interp create]
    $i recursionlimit 20000
    set after [interp recursionlimit {}]
    set childlimit [$i recursionlimit]
    set slavelimit [$i recursionlimit]
    interp delete $i
    list [expr {$before == $after}] $childlimit
    list [expr {$before == $after}] $slavelimit
} {1 20000}

test interp-29.6.1 {safe interpreter recursion limit} {
    interp create child -safe
    set n [interp recursionlimit child]
    interp delete child
    interp create slave -safe
    set n [interp recursionlimit slave]
    interp delete slave
    set n
} 1000

test interp-29.6.2 {safe interpreter recursion limit} {
    interp create child -safe
    set n [child recursionlimit]
    interp delete child
    interp create slave -safe
    set n [slave recursionlimit]
    interp delete slave
    set n
} 1000

test interp-29.6.3 {safe interpreter recursion limit} {
    interp create child -safe
    set n1 [interp recursionlimit child 42]
    set n2 [interp recursionlimit child]
    interp delete child
    interp create slave -safe
    set n1 [interp recursionlimit slave 42]
    set n2 [interp recursionlimit slave]
    interp delete slave
    list $n1 $n2
} {42 42}

test interp-29.6.4 {safe interpreter recursion limit} {
    interp create child -safe
    set n1 [child recursionlimit 42]
    set n2 [interp recursionlimit child]
    interp delete child
    interp create slave -safe
    set n1 [slave recursionlimit 42]
    set n2 [interp recursionlimit slave]
    interp delete slave
    list $n1 $n2
} {42 42}

test interp-29.6.5 {safe interpreter recursion limit} {
    interp create child -safe
    set n1 [interp recursionlimit child 42]
    set n2 [child recursionlimit]
    interp delete child
    interp create slave -safe
    set n1 [interp recursionlimit slave 42]
    set n2 [slave recursionlimit]
    interp delete slave
    list $n1 $n2
} {42 42}

test interp-29.6.6 {safe interpreter recursion limit} {
    interp create child -safe
    set n1 [child recursionlimit 42]
    set n2 [child recursionlimit]
    interp delete child
    interp create slave -safe
    set n1 [slave recursionlimit 42]
    set n2 [slave recursionlimit]
    interp delete slave
    list $n1 $n2
} {42 42}

test interp-29.6.7 {safe interpreter recursion limit} {
    interp create child -safe
    set n1 [child recursionlimit 42]
    set n2 [child recursionlimit]
    interp delete child
    interp create slave -safe
    set n1 [slave recursionlimit 42]
    set n2 [slave recursionlimit]
    interp delete slave
    list $n1 $n2
} {42 42}

test interp-29.6.8 {safe interpreter recursion limit} {
    interp create child -safe
    set n [catch {child eval {interp recursionlimit {} 42}} msg]
    interp delete child
    interp create slave -safe
    set n [catch {slave eval {interp recursionlimit {} 42}} msg]
    interp delete slave
    list $n $msg
} {1 {permission denied: safe interpreters cannot change recursion limit}}

test interp-29.6.9 {safe interpreter recursion limit} {
    interp create child -safe
    interp create slave -safe
    set result [
	child eval {
	    interp create child2 -safe
	slave eval {
	    interp create slave2 -safe
	    set n [catch {
	        interp recursionlimit child2 42
	        interp recursionlimit slave2 42
            } msg]
            list $n $msg
        }
    ]
    interp delete child
    interp delete slave
    set result
} {1 {permission denied: safe interpreters cannot change recursion limit}}

test interp-29.6.10 {safe interpreter recursion limit} {
    interp create child -safe
    interp create slave -safe
    set result [
        child eval {
	    interp create child2 -safe
        slave eval {
	    interp create slave2 -safe
	    set n [catch {
	        child2 recursionlimit 42
	        slave2 recursionlimit 42
            } msg]
            list $n $msg
        }
    ]
    interp delete child
    interp delete slave
    set result
} {1 {permission denied: safe interpreters cannot change recursion limit}}


#    # Deep recursion (into interps when the regular one fails):
#    # still crashes...
#    proc p {} {
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
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







+





-
+







-
+

-












+


-
+
-
-







} {}

test interp-31.1 {alias invocation scope} {
    proc mySet {varName value} {
	upvar 1 $varName localVar
	set localVar $value
    }

    interp alias {} myNewSet {} mySet
    proc testMyNewSet {value} {
	myNewSet a $value
	return $a
    }
    unset -nocomplain a
    catch {unset a}
    set result [testMyNewSet "ok"]
    rename testMyNewSet {}
    rename mySet {}
    rename myNewSet {}
    set result
} ok

test interp-32.1 {parent's working directory should be inherited by a child interp} -setup {
test interp-32.1 {parent's working directory should be inherited by a child interp} {
    cd [temporaryDirectory]
} -body {
    set parent [pwd]
    set i [interp create]
    set child [$i eval pwd]
    interp delete $i
    file mkdir cwd_test
    cd cwd_test
    lappend parent [pwd]
    set i [interp create]
    lappend child [$i eval pwd]
    cd ..
    file delete cwd_test
    interp delete $i
    cd [workingDirectory]
    expr {[string equal $parent $child] ? 1 :
             "\{$parent\} != \{$child\}"}
} -cleanup {
} 1
    cd [workingDirectory]
} -result 1

test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
    # This test will panic if Bug 730244 is not fixed.
    set i [interp create]
    proc testHelper args {rename testHelper {}; return $args}
    # Note: interp names are simple words by default
    trace add execution testHelper enter "interp alias $i alias {} ;#"
3300
3301
3302
3303
3304
3305
3306
3307

3308
3309
3310
3311
3312
3313
3314
3185
3186
3187
3188
3189
3190
3191

3192
3193
3194
3195
3196
3197
3198
3199







-
+







} -result {4 0} -cleanup {
    rename cb3 {}
    rename cb4 {}
}
# Bug 1085023
test interp-34.8 {time limits trigger in vwaits} -body {
    set i [interp create]
    interp limit $i time -seconds [expr {[clock seconds]+1}] -granularity 1
    interp limit $i time -seconds [expr {[clock seconds] + 1}] -granularity 1
    $i eval {
	set x {}
	vwait x
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {limit exceeded}
3348
3349
3350
3351
3352
3353
3354
3355
3356


3357
3358
3359
3360
3361
3362
3363
3233
3234
3235
3236
3237
3238
3239


3240
3241
3242
3243
3244
3245
3246
3247
3248







-
-
+
+







    proc cb2 {} {
	global result
	lappend result cb2
    }
} -body {
    set i [interp create]
    set t0 [clock seconds]
    $i limit time -seconds [expr {$t0+1}] -granularity 1 \
	-command "cb1 $i [expr {$t0+2}]"
    $i limit time -seconds [expr {$t0 + 1}] -granularity 1 \
	-command "cb1 $i [expr {$t0 + 2}]"
    set ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}
3376
3377
3378
3379
3380
3381
3382
3383
3384


3385
3386
3387
3388
3389
3390
3391
3261
3262
3263
3264
3265
3266
3267


3268
3269
3270
3271
3272
3273
3274
3275
3276







-
-
+
+







	lappend result cb1
	set times [lassign $times t]
	$i limit time -seconds $t
    }
} -body {
    set i [interp create]
    set t0 [clock seconds]
    set ::times "[expr {$t0+2}] [expr {$t0+100}]"
    $i limit time -seconds [expr {$t0+1}] -granularity 1 -command "cb1 $i"
    set ::times "[expr {$t0 + 2}] [expr {$t0 + 100}]"
    $i limit time -seconds [expr {$t0 + 1}] -granularity 1 -command "cb1 $i"
    set ::result {}
    lappend ::result [catch {
	$i eval {
	    for {set i 0} {$i<30} {incr i} {
		after 100
	    }
	}
3408
3409
3410
3411
3412
3413
3414
3415

3416
3417
3418

3419
3420
3421
3422
3423
3424
3425
3293
3294
3295
3296
3297
3298
3299

3300
3301
3302

3303
3304
3305
3306
3307
3308
3309
3310







-
+


-
+







    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {limit exceeded}

test interp-35.1 {interp limit syntax} -body {
    interp limit
} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"}
test interp-35.2 {interp limit syntax} -body {
    interp limit {}
} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"}
test interp-35.3 {interp limit syntax} -body {
    interp limit {} foo
} -returnCodes error -result {bad limit type "foo": must be commands or time}
test interp-35.4 {interp limit syntax} -body {
    set i [interp create]
    set dict [interp limit $i commands]
    set result {}
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
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












-
+

-
+

-
-
-
-
+
+
+
+

-
+

-
+

-
-
+
+

-
+

-
+

-
-
+
+

-
+

-
+

+
-
-
-
-
+
+
+
+


-
-
+
+


-
-
-
-
-
+
+
+
+
+




-
-
+
+











-
+




















-
+







-
+


-
+













-
+

-
-
+




-
-
-
-
-
test interp-36.1 {interp bgerror syntax} -body {
    interp bgerror
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.2 {interp bgerror syntax} -body {
    interp bgerror x y z
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.3 {interp bgerror syntax} -setup {
    interp create child
    interp create slave
} -body {
    child bgerror x y
    slave bgerror x y
} -cleanup {
    interp delete child
} -returnCodes error -result {wrong # args: should be "child bgerror ?cmdPrefix?"}
test interp-36.4 {ChildBgerror syntax} -setup {
    interp create child
    interp delete slave
} -returnCodes error -result {wrong # args: should be "slave bgerror ?cmdPrefix?"}
test interp-36.4 {SlaveBgerror syntax} -setup {
    interp create slave
} -body {
    child bgerror \{
    slave bgerror \{
} -cleanup {
    interp delete child
    interp delete slave
} -returnCodes error -result {cmdPrefix must be list of length >= 1}
test interp-36.5 {ChildBgerror syntax} -setup {
    interp create child
test interp-36.5 {SlaveBgerror syntax} -setup {
    interp create slave
} -body {
    child bgerror {}
    slave bgerror {}
} -cleanup {
    interp delete child
    interp delete slave
} -returnCodes error -result {cmdPrefix must be list of length >= 1}
test interp-36.6 {ChildBgerror returns handler} -setup {
    interp create child
test interp-36.6 {SlaveBgerror returns handler} -setup {
    interp create slave
} -body {
    child bgerror {foo bar soom}
    slave bgerror {foo bar soom}
} -cleanup {
    interp delete child
    interp delete slave
} -result {foo bar soom}

test interp-36.7 {ChildBgerror sets error handler of child [1999035]} -setup {
    interp create child
    child alias handler handler
    child bgerror handler
test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
    interp create slave
    slave alias handler handler
    slave bgerror handler
    variable result {untouched}
    proc handler {args} {
        variable result
        set result [lindex $args 0]
	variable result
	set result [lindex $args 0]
    }
} -body {
    child eval {
        variable done {}
        after 0 error foo
        after 10 [list ::set [namespace which -variable done] {}]
        vwait [namespace which -variable done]
    slave eval {
	variable done {}
	after 0 error foo
	after 20 [list ::set [namespace which -variable done] {}]
	vwait [namespace which -variable done]
    }
    set result
} -cleanup {
    variable result {}
    unset -nocomplain result
    interp delete child
    unset result
    interp delete slave
} -result foo

test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
    catch {interp delete a}
    interp create a
    set result {}
} -body {
    interp create {a b} -safe
    lappend result [interp eval a {expr min(5,2,3)*max(7,13,11)}]
    lappend result [interp eval {a b} {expr min(5,2,3)*max(7,13,11)}]
} -cleanup {
    unset -nocomplain result
    unset result
    interp delete a
} -result {26 26}

test interp-38.1 {interp debug one-way switch} -setup {
    catch {interp delete a}
    interp create a
    interp debug a -frame 1
} -body {
    # TIP #3xx interp debug frame is a one-way switch
    interp debug a -frame 0
} -cleanup {
    interp delete a
} -result {1}
test interp-38.2 {interp debug env var} -setup {
    catch {interp delete a}
    set ::env(TCL_INTERP_DEBUG_FRAME) 1
    interp create a
} -body {
    interp debug a
} -cleanup {
    unset -nocomplain ::env(TCL_INTERP_DEBUG_FRAME)
    unset ::env(TCL_INTERP_DEBUG_FRAME)
    interp delete a
} -result {-frame 1}
test interp-38.3 {interp debug wrong args} -body {
    interp debug
} -returnCodes {
    error
} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
test interp-38.4 {interp debug basic setup} -constraints {!singleTestInterp} -body {
test interp-38.4 {interp debug basic setup} -body {
    interp debug {}
} -result {-frame 0}
test interp-38.5 {interp debug basic setup} -constraints {!singleTestInterp} -body {
test interp-38.5 {interp debug basic setup} -body {
    interp debug {} -f
} -result {0}
test interp-38.6 {interp debug basic setup} -body {
    interp debug -frames
} -returnCodes error -result {could not find interpreter "-frames"}
test interp-38.7 {interp debug basic setup} -body {
    interp debug {} -frames
} -returnCodes error -result {bad debug option "-frames": must be -frame}
test interp-38.8 {interp debug basic setup} -body {
    interp debug {} -frame 0 bogus
} -returnCodes {
    error
} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}


# cleanup
unset -nocomplain hidden_cmds
foreach i [interp children] {
foreach i [interp slaves] {
    interp delete $i
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/io.test.

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
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







-
-
+
+
+

-












-
-
+
+
-
-
-
-
-
-
-
+
+
+



+

-

-







# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}

namespace eval ::tcl::test::io {
    namespace import ::tcltest::*

    variable umaskValue
    variable path
    variable f
    variable i
    variable n
    variable v
    variable msg
    variable expected

    catch {
	::tcltest::loadTestedCommands
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint exec             [llength [info commands exec]]
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    package require tcltests

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint openpipe         1
testConstraint fileevent        [llength [info commands fileevent]]
testConstraint fcopy            [llength [info commands fcopy]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint testthread       [llength [info commands testthread]]
testConstraint testobj		[llength [info commands testobj]]
testConstraint testservicemode  [llength [info commands testservicemode]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]

# You need a *very* special environment to do some tests.  In
# particular, many file systems do not support large-files...
testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]

# some tests can only be run is umask is 2
# if "umask" cannot be run, the tests will be skipped.
478
479
480
481
482
483
484
485

486
487
488
489
490
491
492
473
474
475
476
477
478
479

480
481
482
483
484
485
486
487







-
+







    puts $f hi
    close $f
    set f [open $path(test1)]
    set x [list [gets $f line] $line]
    close $f
    set x
} [list 256 $a]
test io-6.7 {Tcl_GetsObj: error in input} stdio {
test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {
    # if (FilterInputBytes(chanPtr, &gs) != 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    puts -nonewline $f "hi\nwould"
    flush $f
    gets $f
    fconfigure $f -blocking 0
738
739
740
741
742
743
744
745

746
747
748
749
750
751
752
733
734
735
736
737
738
739

740
741
742
743
744
745
746
747







-
+







    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf -buffersize 16
    set x [list [gets $f line] $line [testchannel inputbuffered $f]]
    close $f
    set x
} [list 15 "123456789012345" 15]
test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel fileevent} {
test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} {
    # (FilterInputBytes() != 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {crlf lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
    fconfigure $f -buffersize 16
    set x [gets $f]
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
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







-
+
















-
+
















-
+




-
+











-
+







    set f [open $path(test1)]
    fconfigure $f -translation auto
    set x [list [gets $f line] $line [gets $f line] $line]
    lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line
    close $f
    set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel fileevent} {
test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {
    # if (chanPtr->flags & INPUT_SAW_CR)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} {
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
    # not (*eol == '\n')

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    set x [list [gets $f]]
    fconfigure $f -blocking 0
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    fconfigure $f -blocking 1
    puts -nonewline $f "abcd\refg\x1a"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} {
test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} {
    # Tcl_ExternalToUtf()

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    fconfigure $f -encoding utf-16
    fconfigure $f -encoding unicode
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    gets $f
    fconfigure $f -blocking 0
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    fconfigure $f -blocking 1
    puts -nonewline $f "\nabcd\refg"
    lappend x [gets $f line] $line [testchannel queuedcr $f]
    close $f
    set x
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel fileevent} {
test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {
    # memmove()

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto lf} -buffering none
    puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
    fconfigure $f -buffersize 16
    gets $f
1053
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1048
1049
1050
1051
1052
1053
1054

1055
1056
1057
1058
1059
1060
1061
1062







-
+







    close $f
    set f [open $path(test1)]
    fconfigure $f -encoding iso2022-jp
    set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
    close $f
    set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} {
    update
    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -buffering none
    puts -nonewline $f "foobar"
    fconfigure $f -blocking 0
    variable x {}
    after 500 [namespace code { lappend x timeout }]
1113
1114
1115
1116
1117
1118
1119
1120

1121
1122
1123
1124
1125
1126
1127
1108
1109
1110
1111
1112
1113
1114

1115
1116
1117
1118
1119
1120
1121
1122







-
+







    fconfigure $f -encoding shiftjis
    set x [list [gets $f line] $line]
    lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
    lappend x [gets $f line] $line
    close $f
    set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
test io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -encoding binary -buffering none
    puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
    fconfigure $f -encoding shiftjis -blocking 0
    fileevent $f read [namespace code "ready $f"]
    variable x {}
    proc ready {f} {
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
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







-
+











-
+







-
+







    fconfigure $f -encoding ascii -translation auto -buffersize 16
    # here
    gets $f
    set x [testchannel inputbuffered $f]
    close $f
    set x
} "7"
test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel fileevent} {
test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} {
    # not (bufPtr->nextPtr == NULL)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation lf -encoding ascii -buffering none
    puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
    variable x {}
    fileevent $f read [namespace code "ready $f"]
    proc ready {f} {
	variable x
	lappend x [gets $f line] $line [testchannel inputbuffered $f]
    }
    fconfigure $f -encoding utf-16 -buffersize 16 -blocking 0
    fconfigure $f -encoding unicode -buffersize 16 -blocking 0
    vwait [namespace which -variable x]
    fconfigure $f -translation auto -encoding ascii -blocking 1
    # here
    vwait [namespace which -variable x]
    close $f
    set x
} [list -1 "" 42 15 "123456789012345" 25]
test io-8.3 {PeekAhead: no cached data available} {stdio testchannel fileevent} {
test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {
    # (bytesLeft == 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary}
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
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
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







-
+











-
+











-
+







    # that cached data is available in buffer w/o having to call driver.

    set x [gets $f]
    close $f
    set x
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel fileevent} {
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
    # (bufPtr->nextAdded < bufPtr->length)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary}
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    close $f
    set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel fileevent} {
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary} -buffersize 16
    puts -nonewline $f "abcdefghijklmno\r"
    flush $f
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
    close $f
    set x
} {15 abcdefghijklmno 1}
test io-8.7 {PeekAhead: cleanup} {stdio testchannel fileevent} {
test io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} {
    # Make sure bytes are removed from buffer.

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -translation {auto binary} -buffering none
    puts -nonewline $f "abcdefghijklmno\r"
    # here
    set x [list [gets $f line] $line [testchannel queuedcr $f]]
1390
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
1385
1386
1387
1388
1389
1390
1391

1392
1393
1394
1395
1396
1397
1398
1399







-
+







    set f [open $path(test1)]
    fconfigure $f -buffersize 16
    # here
    set x [read $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyz}
test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
    # (srcRead == 0)

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -encoding binary -buffering none -buffersize 16
    puts -nonewline $f "123456789012345\x96"
    fconfigure $f -encoding shiftjis -blocking 0

1415
1416
1417
1418
1419
1420
1421
1422

1423
1424
1425
1426
1427
1428
1429
1410
1411
1412
1413
1414
1415
1416

1417
1418
1419
1420
1421
1422
1423
1424







-
+







    puts -nonewline $f "\x7b"
    after 500			;# Give the cat process time to catch up
    fconfigure $f -encoding shiftjis -blocking 0
    vwait [namespace which -variable x]
    close $f
    set x
} [list "123456789012345" 1 "\u672c" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe fileevent} {
    set path(test1) [makeFile {
	fconfigure stdout -encoding binary -buffering none
	gets stdin; puts -nonewline "\xe7"
	gets stdin; puts -nonewline "\x89"
	gets stdin; puts -nonewline "\xa6"
    } test1]
    set f [open "|[list [interpreter] $path(test1)]" r+]
1609
1610
1611
1612
1613
1614
1615
1616

1617
1618
1619
1620
1621
1622
1623
1604
1605
1606
1607
1608
1609
1610

1611
1612
1613
1614
1615
1616
1617
1618







-
+







    close $f
    set f [open $path(test1)]
    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\nfgh"
test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel fileevent} {
test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} {
    # (chanPtr->flags & INPUT_SAW_CR)
    # This test may fail on slower machines.

    set f [open "|[list [interpreter] $path(cat)]" w+]
    fconfigure $f -blocking 0 -buffering none -translation {auto lf}

    fileevent $f read [namespace code "ready $f"]
1635
1636
1637
1638
1639
1640
1641
1642

1643
1644
1645
1646
1647
1648
1649
1630
1631
1632
1633
1634
1635
1636

1637
1638
1639
1640
1641
1642
1643
1644







-
+







    puts -nonewline $f "\n01234"
    after 500 [namespace code {set y ok}]
    vwait [namespace which -variable y]

    close $f
    set x
} [list "abcdefghj\n" 1 "01234" 0]
test io-13.7 {TranslateInputEOL: auto mode: naked \r} testchannel {
test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {
    # (src >= srcMax)

    set f [open $path(test1) w]
    fconfigure $f -translation lf
    puts -nonewline $f "abcd\r"
    close $f
    set f [open $path(test1)]
1780
1781
1782
1783
1784
1785
1786
1787

1788
1789
1790
1791
1792
1793
1794
1775
1776
1777
1778
1779
1780
1781

1782
1783
1784
1785
1786
1787
1788
1789







-
+







    lappend l [x eval {fconfigure stdin -buffering}]
    lappend l [x eval {fconfigure stdout -buffering}]
    lappend l [x eval {fconfigure stderr -buffering}]
    interp delete x
    set l
} {line line none}
set path(test3) [makeFile {} test3]
test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} exec {
test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
    set f [open $path(test1) w]
    puts -nonewline $f {
	close stdin
	close stdout
	close stderr
	set f  [}
    puts $f [list open $path(test1) r]]
1809
1810
1811
1812
1813
1814
1815
1816
1817


1818
1819
1820
1821
1822
1823
1824
1804
1805
1806
1807
1808
1809
1810


1811
1812
1813
1814
1815
1816
1817
1818
1819







-
-
+
+







    close $f
    close $f2
    set result
} {{
out
} {err
}}
# This test relies on the fact that stdout is used before stderr
test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
# This test relies on the fact that the smallest available fd is used first.
test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unix} {
    set f [open $path(test1) w]
    puts -nonewline $f { close stdin
	close stdout
	close stderr
	set f  [}
    puts $f [list open $path(test1) r]]
    puts $f "set f2 \[[list open $path(test2) w]]"
1835
1836
1837
1838
1839
1840
1841
1842
1843


1844
1845
1846
1847
1848
1849
1850
1830
1831
1832
1833
1834
1835
1836


1837
1838
1839
1840
1841
1842
1843
1844
1845







-
-
+
+







    set f  [open $path(test2) r]
    set f2 [open $path(test3) r]
    lappend result [read $f] [read $f2]
    close $f
    close $f2
    set result
} {{ close stdin
stdout
} {stderr
file1
} {file2
}}
catch {interp delete z}
test io-14.5 {Tcl_GetChannel: stdio name translation} {
    interp create z
    eof stdin
    catch {z eval flush stdin} msg1
    catch {z eval close stdin} msg2
1870
1871
1872
1873
1874
1875
1876
1877

1878
1879
1880
1881
1882
1883
1884
1865
1866
1867
1868
1869
1870
1871

1872
1873
1874
1875
1876
1877
1878
1879







-
+







    catch {z eval close stderr} msg2
    catch {z eval flush stderr} msg3
    set result [list $msg1 $msg2 $msg3]
    interp delete z
    set result
} {{} {} {can not find channel named "stderr"}}
set path(script) [makeFile {} script]
test io-14.8 {reuse of stdio special channels} stdio {
test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
    file delete $path(script)
    file delete $path(test1)
    set f [open $path(script) w]
    puts -nonewline $f {
	close stderr
	set f [}
    puts $f [list open $path(test1) w]]
1892
1893
1894
1895
1896
1897
1898
1899

1900
1901
1902
1903
1904
1905
1906
1887
1888
1889
1890
1891
1892
1893

1894
1895
1896
1897
1898
1899
1900
1901







-
+







    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    set c [gets $f]
    close $f
    set c
} hello
test io-14.9 {reuse of stdio special channels} {stdio fileevent} {
test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
    file delete $path(script)
    file delete $path(test1)
    set f [open $path(script) w]
    puts $f {
        array set path [lindex $argv 0]
	set f [open $path(test1) w]
	puts $f hello
2075
2076
2077
2078
2079
2080
2081
2082

2083
2084
2085
2086
2087
2088
2089
2070
2071
2072
2073
2074
2075
2076

2077
2078
2079
2080
2081
2082
2083
2084







-
+







test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
    set f [open $path(test1) w+]
    set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
    close $f
    set x
} {{{} {}} {auto lf}}
set path(stdout) [makeFile {} stdout]
test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio {
test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {
    set f [open $path(script) w]
    puts -nonewline $f {
	close stdout
	set f1 [}
    puts $f [list open $path(stdout) w]]
    puts $f {
	fconfigure $f1 -buffersize 777
2149
2150
2151
2152
2153
2154
2155
2156

2157
2158
2159
2160
2161
2162
2163
2144
2145
2146
2147
2148
2149
2150

2151
2152
2153
2154
2155
2156
2157
2158







-
+







    lappend l [testchannel outputbuffered $f]
    lappend l [tell $f]
    close $f
    file delete $path(test1)
    set l
} {6 6 0 6}

test io-26.1 {Tcl_GetChannelInstanceData} stdio {
test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
    # "pid" command uses Tcl_GetChannelInstanceData
    # Don't care what pid is (but must be a number), just want to exercise it.

    set f [open "|[list [interpreter] << exit]"]
    expr [pid $f]
    close $f
} {}
2226
2227
2228
2229
2230
2231
2232
2233

2234
2235
2236
2237
2238
2239
2240
2221
2222
2223
2224
2225
2226
2227

2228
2229
2230
2231
2232
2233
2234
2235







-
+







    close $f
    lappend l [file size $path(test1)]
    set l
} {0 60 72}
set path(pipe)   [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
	{stdio asyncPipeClose knownMsvcBug} {
	{stdio asyncPipeClose openpipe knownMsvcBug} {
    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.
    file delete $path(pipe)
    file delete $path(output)
    set f [open $path(pipe) w]
    puts $f "set f \[[list open $path(output) w]]"
    puts $f {
2295
2296
2297
2298
2299
2300
2301
2302

2303
2304
2305
2306
2307
2308
2309
2290
2291
2292
2293
2294
2295
2296

2297
2298
2299
2300
2301
2302
2303
2304







-
+







    interp delete x
    set f [open $path(test1) r]
    set l [gets $f]
    close $f
    set l
} abcdef
test io-28.3 {CloseChannel, not called before output queue is empty} \
	{stdio asyncPipeClose nonPortable} {
	{stdio asyncPipeClose nonPortable openpipe} {
    file delete $path(pipe)
    file delete $path(output)
    set f [open $path(pipe) w]
    puts $f {

	# Need to not have eof char appended on close, because the other
	# side of the pipe already closed, so that writing would cause an
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
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







-
+










-
+







    close $f
    lappend l [lsort [testchannel open]]
    set x [list $consoleFileNames \
		[lsort [list {*}$consoleFileNames $f]] \
		$consoleFileNames]
    string compare $l $x
} 0
test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} {
test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel openpipe} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	close stdin
	puts [testchannel open]
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    set l [gets $f]
    close $f
    lsort $l
    set l
} {file1 file2}

test io-29.1 {Tcl_WriteChars, channel not writable} {
    list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
test io-29.2 {Tcl_WriteChars, empty string} {
    file delete $path(test1)
2491
2492
2493
2494
2495
2496
2497
2498

2499
2500
2501
2502
2503
2504
2505
2486
2487
2488
2489
2490
2491
2492

2493
2494
2495
2496
2497
2498
2499
2500







-
+







    for {set x 0} {$x < 10} {incr x} {
	puts -nonewline $f1 [gets $f2]
    }
    close $f1
    close $f2
    file size $path(test1)
} 377
test io-29.12 {Tcl_WriteChars on a pipe} stdio {
test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 "set f1 \[[list open $path(longfile) r]]"
    puts $f1 {
	for {set x 0} {$x < 10} {incr x} {
	    puts [gets $f1]
2516
2517
2518
2519
2520
2521
2522
2523

2524
2525
2526
2527
2528
2529
2530
2511
2512
2513
2514
2515
2516
2517

2518
2519
2520
2521
2522
2523
2524
2525







-
+







	    set y broken
	}
    }
    close $f1
    close $f2
    set y
} ok
test io-29.13 {Tcl_WriteChars to a pipe, line buffered} stdio {
test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {
	puts [gets stdin]
	puts [gets stdin]
    }
2567
2568
2569
2570
2571
2572
2573
2574

2575
2576
2577
2578
2579
2580
2581
2562
2563
2564
2565
2566
2567
2568

2569
2570
2571
2572
2573
2574
2575
2576







-
+







    close $fd
    set fd [open $path(test1) r]
    set x [list [catch {flush $fd} msg] $msg]
    close $fd
    string compare $x \
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-29.16 {Tcl_Flush on pipe opened only for reading} stdio {
test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {
    set fd [open "|[list [interpreter] cat longfile]" r]
    set x [list [catch {flush $fd} msg] $msg]
    catch {close $fd}
    string compare $x \
	[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {
2641
2642
2643
2644
2645
2646
2647
2648

2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662

2663
2664
2665
2666
2667
2668
2669
2636
2637
2638
2639
2640
2641
2642

2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656

2657
2658
2659
2660
2661
2662
2663
2664







-
+













-
+







	puts $f1 $line
    }
    lappend z [file size $path(test1)]
    close $f1
    lappend z [file size $path(test1)]
    set z
} {4096 12288 12600}
test io-29.21 {Tcl_Flush to pipe} stdio {
test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {set x [read stdin 6]}
    puts $f1 {set cnt [string length $x]}
    puts $f1 {puts "read $cnt characters"}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    puts $f1 hello
    flush $f1
    set x [gets $f1]
    catch {close $f1}
    set x
} "read 6 characters"
test io-29.22 {Tcl_Flush called at other end of pipe} stdio {
test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {
	fconfigure stdout -buffering full
	puts hello
	puts hello
	flush stdout
2678
2679
2680
2681
2682
2683
2684
2685

2686
2687
2688
2689
2690
2691
2692
2673
2674
2675
2676
2677
2678
2679

2680
2681
2682
2683
2684
2685
2686
2687







-
+







    lappend x [gets $f1]
    puts $f1 hello
    flush $f1
    lappend x [gets $f1]
    close $f1
    set x
} {hello hello bye}
test io-29.23 {Tcl_Flush and line buffering at end of pipe} stdio {
test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {
	puts hello
	puts hello
	gets stdin
	puts bye
2713
2714
2715
2716
2717
2718
2719
2720

2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732

2733
2734
2735
2736
2737
2738
2739
2740

2741
2742
2743
2744
2745
2746
2747
2708
2709
2710
2711
2712
2713
2714

2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726

2727
2728
2729
2730
2731
2732
2733
2734

2735
2736
2737
2738
2739
2740
2741
2742







-
+











-
+







-
+







    flush $f
    set f2 [open $path(test3)]
    lappend x [read -nonewline $f2]
    close $f2
    close $f
    set x
} "{} {Line 1\nLine 2}"
test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio fileevent} {
test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} {
    file delete $path(test3)
    set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w]
    puts $f "Line 1"
    puts $f "Line 2"
    close $f
    after 100
    set f [open $path(test3) r]
    set x [read $f]
    close $f
    set x
} "Line 1\nLine 2\n"
test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} {
test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} {
    set f [open "|[list cat -u]" r+]
    puts $f "Line1"
    flush $f
    set x [gets $f]
    close $f
    set x
} {Line1}
test io-29.27 {Tcl_Flush on closed pipeline} stdio {
test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
    file delete $path(pipe)
    set f [open $path(pipe) w]
    puts $f {exit}
    close $f
    set f [open "|[list [interpreter] $path(pipe)]" r+]
    gets $f
    puts $f output
2787
2788
2789
2790
2791
2792
2793
2794

2795
2796
2797
2798
2799
2800
2801
2782
2783
2784
2785
2786
2787
2788

2789
2790
2791
2792
2793
2794
2795
2796







-
+







    file delete $path(test1)
    set f [open $path(test1) w]
    fconfigure $f -translation crlf -eofchar {}
    puts $f hello\nthere\nand\nhere
    close $f
    file size $path(test1)
} 25
test io-29.31 {Tcl_WriteChars, background flush} stdio {
test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.
    file delete $path(pipe)
    file delete $path(output)
    set f [open $path(pipe) w]
    puts $f "set f \[[list open $path(output)  w]]"
    puts $f {fconfigure $f -translation lf}
2824
2825
2826
2827
2828
2829
2830
2831

2832
2833
2834
2835
2836
2837

2838
2839
2840
2841
2842
2843
2844
2819
2820
2821
2822
2823
2824
2825

2826
2827
2828
2829
2830
2831

2832
2833
2834
2835
2836
2837
2838
2839







-
+





-
+







    }
    if {$counter == 1000} {
	set result "file size only [file size $path(output)]"
    } else {
	set result ok
    }
    # allow a little time for the background process to close.
    # otherwise, the following test fails on the [file delete $path(output)]
    # otherwise, the following test fails on the [file delete $path(output)
    # on Windows because a process still has the file open.
    after 100 set v 1; vwait v
    set result
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
	{stdio asyncPipeClose knownMsvcBug} {
	{stdio asyncPipeClose openpipe knownMsvcBug} {
    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.
    file delete $path(pipe)
    file delete $path(output)
    set f [open $path(pipe) w]
    puts $f "set f \[[list open $path(output) w]]"
    puts $f {fconfigure $f -translation lf}
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
2878
2879
2880
2881
2882
2883
2884




















2885
2886
2887
2888
2889
2890
2891







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    close $f
    exec [interpreter] $path(script)
    set f [open $path(test1) r]
    set r [read $f]
    close $f
    set r
} "hello\nbye\nstrange\n"
set path(script2) [makeFile {} script2]
test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} {
    set f [open $path(script) w]
    puts $f {
		fconfigure stdout -blocking 0
		puts -nonewline stdout [string repeat A 655360]
		flush stdout
	}
    close $f
    set f [open $path(script2) w]
    puts $f {after 2000}
    close $f
	set t1 [clock milliseconds]
	set ff [open "|[list [interpreter] $path(script2)]" w]
	catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)}
	exec [interpreter] $path(script) >@ $ff
	set t2 [clock milliseconds]
	close $ff
	expr {($t2-$t1)/2000 ? $t2-$t1 : 0}
} 0
test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
    variable c 0
    variable x running
    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
    proc writelots {s l} {
	for {set i 0} {$i < 9000} {incr i} {
	    puts $s $l
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
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







-
+











-
+


















-
+



















-
+







    set x ok
    set z [file size $path(longfile)]
    if {$z != $l} {
	set x broken
    }
    set x
} ok
test io-32.10 {Tcl_Read from a pipe} stdio {
test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    puts $f1 hello
    flush $f1
    set x [read $f1]
    close $f1
    set x
} "hello\n"
test io-32.11 {Tcl_Read from a pipe} stdio {
test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {puts [gets stdin]}
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    puts $f1 hello
    flush $f1
    set x ""
    lappend x [read $f1 6]
    puts $f1 hello
    flush $f1
    lappend x [read $f1]
    close $f1
    set x
} {{hello
} {hello
}}
test io-32.11.1 {Tcl_Read from a pipe} stdio {
test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {chan configure stdout -translation crlf}
    puts $f1 {puts [gets stdin]}
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    puts $f1 hello
    flush $f1
    set x ""
    lappend x [read $f1 6]
    puts $f1 hello
    flush $f1
    lappend x [read $f1]
    close $f1
    set x
} {{hello
} {hello
}}
test io-32.11.2 {Tcl_Read from a pipe} stdio {
test io-32.11.2 {Tcl_Read from a pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {chan configure stdout -translation crlf}
    puts $f1 {puts [gets stdin]}
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
4252
4253
4254
4255
4256
4257
4258
4259

4260
4261
4262
4263
4264
4265
4266
4227
4228
4229
4230
4231
4232
4233

4234
4235
4236
4237
4238
4239
4240
4241







-
+







    set z ok
    if {$l != $l} {
	set z broken
    }
    close $f1
    set z
} ok
test io-33.3 {Tcl_Gets from pipe} stdio {
test io-33.3 {Tcl_Gets from pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {puts [gets stdin]}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    puts $f1 hello
    flush $f1
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4257
4258
4259
4260
4261
4262
4263







4264
4265
4266
4267
4268
4269
4270







-
-
-
-
-
-
-







    puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
    close $f
    set f [open $path(test3)]
    set x [gets $f]
    close $f
    set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
set f [open $path(test3) w]
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
close $f
test io-33.5 {Tcl_Gets with long line} {
    set f [open $path(test3)]
    set x [gets $f y]
    close $f
    list $x $y
} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test io-33.6 {Tcl_Gets and end of file} {
4560
4561
4562
4563
4564
4565
4566
4567

4568
4569
4570
4571
4572
4573
4574
4528
4529
4530
4531
4532
4533
4534

4535
4536
4537
4538
4539
4540
4541
4542







-
+







    set c1 [tell $f1]
    set r1 [read $f1 5]
    seek $f1 0 current
    set c2 [tell $f1]
    close $f1
    list $c1 $r1 $c2
} {44 rstuv 49}
test io-34.8 {Tcl_Seek on pipes: not supported} stdio {
test io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    set x [list [catch {seek $f1 0 current} msg] $msg]
    close $f1
    regsub {".*":} $x {"":} x
    string tolower $x
} {1 {error during seek on "": invalid argument}}
test io-34.9 {Tcl_Seek, testing buffered input flushing} {
4668
4669
4670
4671
4672
4673
4674
4675

4676
4677
4678
4679
4680
4681

4682
4683
4684
4685
4686
4687
4688
4636
4637
4638
4639
4640
4641
4642

4643
4644
4645
4646
4647
4648

4649
4650
4651
4652
4653
4654
4655
4656







-
+





-
+







    seek $f1 10 start
    set c1 [tell $f1]
    seek $f1 10 current
    set c2 [tell $f1]
    close $f1
    list $c1 $c2
} {10 20}
test io-34.16 {Tcl_Tell on pipe: always -1} stdio {
test io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    set c [tell $f1]
    close $f1
    set c
} -1
test io-34.17 {Tcl_Tell on pipe: always -1} stdio {
test io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    puts $f1 {puts hello}
    flush $f1
    set c [tell $f1]
    gets $f1
    close $f1
    set c
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
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







-
+

















-
+







    lappend x [eof $f]
    gets $f
    lappend x [eof $f]
    lappend x [eof $f]
    close $f
    set x
} {0 0 0 0 1 1}
test io-35.2 {Tcl_Eof with pipe} stdio {
test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {gets stdin}
    puts $f1 {puts hello}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    puts $f1 hello
    set x [eof $f1]
    flush $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    gets $f1
    lappend x [eof $f1]
    close $f1
    set x
} {0 0 0 1}
test io-35.3 {Tcl_Eof with pipe} stdio {
test io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {gets stdin}
    puts $f1 {puts hello}
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    puts $f1 hello
4825
4826
4827
4828
4829
4830
4831
4832

4833
4834
4835
4836
4837
4838
4839
4793
4794
4795
4796
4797
4798
4799

4800
4801
4802
4803
4804
4805
4806
4807







-
+







    fconfigure $f -blocking off
    set l ""
    lappend l [gets $f]
    lappend l [eof $f]
    close $f
    set l
} {{} 1}
test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio {
test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} {
    file delete $path(pipe)
    set f [open $path(pipe) w]
    puts $f {
	exit
    }
    close $f
    set f [open "|[list [interpreter] $path(pipe)]" r]
5102
5103
5104
5105
5106
5107
5108
5109

5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128

5129
5130
5131
5132
5133
5134
5135
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
5095

5096
5097
5098
5099
5100
5101
5102
5103







-
+


















-
+







    set e [eof $f]
    close $f
    list $c $l $e [scan [string index $in end] %c]
} {9 1 1 13}

# Test Tcl_InputBlocked

test io-36.1 {Tcl_InputBlocked on nonblocking pipe} stdio {
test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    puts $f1 {puts hello_from_pipe}
    flush $f1
    gets $f1
    fconfigure $f1 -blocking off -buffering full
    puts $f1 {puts hello}
    set x ""
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    flush $f1
    after 200
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    close $f1
    set x
} {{} 1 hello 0 {} 1}
test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio {
test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    chan configure $f1 -encoding binary -translation lf -eofchar {}
    puts $f1 {
	chan configure stdout -encoding binary -translation lf -eofchar {}
	puts hello_from_pipe
    }
    flush $f1
5144
5145
5146
5147
5148
5149
5150
5151

5152
5153
5154
5155
5156
5157
5158
5112
5113
5114
5115
5116
5117
5118

5119
5120
5121
5122
5123
5124
5125
5126







-
+







    lappend x [gets $f1]
    lappend x [fblocked $f1]
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    close $f1
    set x
} {{} 1 hello 0 {} 1}
test io-36.2 {Tcl_InputBlocked on blocking pipe} stdio {
test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
    set f1 [open "|[list [interpreter]]" r+]
    fconfigure $f1 -buffering line
    puts $f1 {puts hello_from_pipe}
    set x ""
    lappend x [gets $f1]
    lappend x [fblocked $f1]
    puts $f1 {exit}
5408
5409
5410
5411
5412
5413
5414
5415

5416
5417
5418
5419
5420
5421
5422
5376
5377
5378
5379
5380
5381
5382

5383
5384
5385
5386
5387
5388
5389
5390







-
+







    lappend x [gets $f1]
    lappend x [read $f1 1000]
    lappend x [fblocked $f1]
    lappend x [eof $f1]
    close $f1
    set x
} {1 0 {} {} 0 1}
test io-39.10 {Tcl_SetChannelOption, blocking mode} stdio {
test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {
	gets stdin
	after 100
	puts hi
	gets stdin
5499
5500
5501
5502
5503
5504
5505
5506

5507
5508
5509
5510
5511
5512
5513
5467
5468
5469
5470
5471
5472
5473

5474
5475
5476
5477
5478
5479
5480
5481







-
+







test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
    file delete $path(test1)
    set f [open $path(test1) w]
    set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]
    close $f
    set result
} {1 {unknown encoding "foobar"}}
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} {
    set f [open "|[list [interpreter] $path(cat)]" r+]
    fconfigure $f -encoding binary
    puts -nonewline $f "\xe7"
    flush $f
    fconfigure $f -encoding utf-8 -blocking 0
    variable x {}
    fileevent $f readable [namespace code { lappend x [read $f] }]
5634
5635
5636
5637
5638
5639
5640
5641

5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656


5657
5658
5659
5660
5661
5662
5663
5602
5603
5604
5605
5606
5607
5608

5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620
5621
5622


5623
5624
5625
5626
5627
5628
5629
5630
5631







-
+













-
-
+
+







    close $f
    set x
} {zzy abzzy}
test io-40.2 {POSIX open access modes: CREAT} {unix} {
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT} 0o600]
    file stat $path(test3) stats
    set x [format "%#o" [expr $stats(mode)&0o777]]
    set x [format "0o%o" [expr $stats(mode)&0o777]]
    puts $f "line 1"
    close $f
    set f [open $path(test3) r]
    lappend x [gets $f]
    close $f
    set x
} {0o600 {line 1}}
test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
    # This test only works if your umask is 2, like ouster's.
    file delete $path(test3)
    set f [open $path(test3) {WRONLY CREAT}]
    close $f
    file stat $path(test3) stats
    format "%#o" [expr $stats(mode)&0o777]
} [format %#5o [expr {0o666 & ~ $umaskValue}]]
    format "0%o" [expr $stats(mode)&0o777]
} [format %04o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
    file delete $path(test3)
    set f [open $path(test3) w]
    fconfigure $f -eofchar {}
    puts $f xyzzy
    close $f
    set f [open $path(test3) {WRONLY CREAT}]
5848
5849
5850
5851
5852
5853
5854
5855

5856
5857
5858
5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876

5877
5878
5879
5880
5881
5882
5883
5884
5885
5886
5887
5888
5889

5890
5891
5892
5893
5894
5895
5896
5816
5817
5818
5819
5820
5821
5822

5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843

5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856

5857
5858
5859
5860
5861
5862
5863
5864







-
+




















-
+












-
+







    lappend result [fileevent $f readable] [fileevent $f writable]
    fileevent $f writable {}
    lappend result [fileevent $f readable] [fileevent $f writable]
} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
} -constraints {stdio unixExecs fileevent} -body {
} -constraints {stdio unixExecs fileevent openpipe} -body {
    set result {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r "read f"
    fileevent $f2 r "read f2"
    fileevent $f3 r "read f3"
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f2 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f3 r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
    fileevent $f r {}
    lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
} -cleanup {
    catch {close $f2}
    catch {close $f3}
} -result {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}

test io-44.1 {FileEventProc procedure: normal read event} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
} -constraints {stdio unixExecs fileevent} -body {
} -constraints {stdio unixExecs fileevent openpipe} -body {
    fileevent $f2 readable [namespace code {
	set x [gets $f2]; fileevent $f2 readable {}
    }]
    puts $f2 text; flush $f2
    variable x initial
    vwait [namespace which -variable x]
    set x
} -cleanup {
    catch {close $f2}
    catch {close $f3}
} -result {text}
test io-44.2 {FileEventProc procedure: error in read event} -constraints {
    stdio unixExecs fileevent
    stdio unixExecs fileevent openpipe
} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
5905
5906
5907
5908
5909
5910
5911
5912

5913
5914
5915
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931

5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950

5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964
5965
5966
5967

5968

5969
5970
5971
5972
5973
5974
5975
5976
5977
5978
5979
5980
5981
5982
5983
5984
5985
5986
5987
5988
5989
5990
5991
5992
5993
5994
5995
5996
5997
5998
5999
6000
6001
6002
6003
6004
6005
6006
6007
6008
6009
6010
6011
6012
6013
6014
6015
6016
6017
6018
6019
6020
6021
6022
6023
6024
6025
6026
6027
6028
6029
6030
6031
6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
5873
5874
5875
5876
5877
5878
5879

5880
5881
5882
5883
5884
5885
5886
5887
5888
5889
5890
5891
5892
5893
5894
5895
5896
5897
5898

5899
5900
5901
5902
5903
5904
5905
5906
5907
5908
5909
5910
5911
5912
5913
5914
5915
5916
5917

5918


5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930


5931
5932

5933
5934
5935
































































5936
5937
5938
5939
5940
5941
5942







-
+


















-
+


















-
+
-
-












-
-

+
-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    interp bgerror {} $handler
    catch {close $f2}
    catch {close $f3}
} -result {bogus {}}
test io-44.3 {FileEventProc procedure: normal write event} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
} -constraints {stdio unixExecs fileevent} -body {
} -constraints {stdio unixExecs fileevent openpipe} -body {
    fileevent $f2 writable [namespace code {
	lappend x "triggered"
	incr count -1
	if {$count <= 0} {
	    fileevent $f2 writable {}
	}
    }]
    variable x initial
    set count 3
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    set x
} -cleanup {
    catch {close $f2}
    catch {close $f3}
} -result {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
    stdio unixExecs fileevent
    stdio unixExecs fileevent openpipe
} -setup {
    set f2 [open "|[list cat -u]" r+]
    set f3 [open "|[list cat -u]" r+]
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
} -body {
    fileevent $f2 writable {error bad-write}
    variable x initial
    vwait [namespace which -variable x]
    list $x [fileevent $f2 writable]
} -cleanup {
    interp bgerror {} $handler
    catch {close $f2}
    catch {close $f3}
} -result {bad-write {}}
test io-44.5 {FileEventProc procedure: end of file} -constraints {
test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
    stdio unixExecs fileevent
} -body {
    set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
    fileevent $f4 readable [namespace code {
	if {[gets $f4 line] < 0} {
	    lappend x eof
	    fileevent $f4 readable {}
	} else {
	    lappend x $line
	}
    }]
    variable x initial
    vwait [namespace which -variable x]
    vwait [namespace which -variable x]
    set x
} -cleanup {
    close $f4
    set x
} -result {initial foo eof}
} {initial foo eof}

close $f

test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup {
} -constraints {stdio fileevent openpipe} -body {

    namespace eval refchan {
	namespace ensemble create
	namespace export *


	proc finalize {chan args} {
	    namespace delete c_$chan
	}

	proc initialize {chan args} {
	    namespace eval c_$chan {}
	    namespace upvar c_$chan watching watching
	    set watching {}
	    list finalize initialize seek watch write
	}


	proc watch {chan args} {
	    namespace upvar c_$chan watching watching
	    foreach arg $args {
		switch $arg {
		    write {
			if {$arg ni $watching} {
			    lappend watching $arg
			}
			chan postevent $chan $arg
		    }
		}
	    }
	}


	proc write {chan args} {
	    chan postevent $chan write
	    return 1
	}
    }
    set f [chan create w [namespace which refchan]]
    chan configure $f -blocking 0
    set data "some data"
    set x 0
    chan event $f writable [namespace code {
	puts $f $data
	incr count [string length $data]
	if {$count > 262144} {
	    chan event $f writable {}
	    set x done
	}
    }]
    set token [after 10000 [namespace code {
	set x timeout
    }]]
    vwait [namespace which -variable x]
    return $x
} -cleanup {
    after cancel $token
    catch {chan close $f}
} -result done


makeFile "foo bar" foo

test io-45.1 {DeleteFileEvent, cleanup on close} {fileevent} {
    set f [open $path(foo) r]
    fileevent $f readable [namespace code {
	lappend x "binding triggered: \"[gets $f]\""
	fileevent $f readable {}
6084
6085
6086
6087
6088
6089
6090
6091

6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102

6103

6104
6105
6106
6107
6108
6109
6110
6111
5985
5986
5987
5988
5989
5990
5991

5992
5993
5994
5995
5996
5997
5998
5999
6000
6001

6002
6003

6004

6005
6006
6007
6008
6009
6010
6011







-
+









-

+
-
+
-







    lappend x [catch {fileevent $f readable}] \
	    [catch {fileevent $f2 readable}] \
	    [catch {fileevent $f3 readable}]
} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}

# Execute these tests only if the "testfevent" command is present.

test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} {
test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
    testfevent create
    set script "set f \[[list open $path(foo) r]]\n"
    append script {
	set x "no event"
	fileevent $f readable [namespace code {
	    set x "f triggered: [gets $f]"
	    fileevent $f readable {}
	}]
    }
    set timer [after 10 lappend x timeout]
    testfevent cmd $script
    after 1	;# We must delay because Windows takes a little time to notice
    vwait x
    update
    after cancel $timer
    testfevent cmd {close $f}
    list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
    testfevent create
    testfevent cmd {
        variable x 0
6286
6287
6288
6289
6290
6291
6292
6293

6294
6295
6296
6297
6298
6299
6300
6186
6187
6188
6189
6190
6191
6192

6193
6194
6195
6196
6197
6198
6199
6200







-
+







    }
    set l ""
    variable x not_done
    vwait [namespace which -variable x]
    list $x $l
} {done {called called called called called called called}}
set path(my_script) [makeFile {} my_script]
test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles fileevent} {
test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe fileevent} {
    set f [open $path(bar) w]
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    puts $f abcdefg
    close $f
6784
6785
6786
6787
6788
6789
6790
6791

6792
6793
6794
6795
6796


6797
6798
6799
6800
6801
6802
6803
6804

6805
6806
6807

6808
6809
6810
6811
6812
6813
6814


6815
6816
6817
6818



6819
6820
6821

6822
6823
6824
6825
6826
6827
6828
6829
6830
6831
6832
6833
6834

6835

6836
6837



6838
6839
6840
6841



6842
6843
6844
6845
6846
6847
6848
6849
6850

6851
6852

6853
6854
6855
6856
6857
6858
6859
6860
6861
6862
6863
6864

6865


6866
6867



6868
6869
6870
6871
6872
6873


6874
6875
6876
6877
6878
6879
6880
6881
6882
6883
6884
6885
6886
6887
6888
6889
6890
6891
6892
6893
6894
6895
6896

6897

6898
6899



6900
6901
6902
6903



6904
6905
6906
6907
6908
6909
6910
6911
6912
6913
6914

6915
6916
6917
6918
6919
6920

6921
6922

6923
6924
6925
6926
6927
6928
6929
6930
6931
6932
6933
6934
6935
6936

6937

6938
6939
6940




6941
6942
6943
6944



6945
6946
6947
6948
6949
6950
6951
6952
6953

6954
6955

6956
6957
6958
6959
6960
6961
6962
6963
6684
6685
6686
6687
6688
6689
6690

6691
6692

6693
6694

6695
6696
6697
6698
6699
6700
6701
6702


6703



6704


6705




6706
6707
6708

6709
6710
6711
6712
6713
6714
6715

6716
6717
6718
6719










6720
6721
6722


6723
6724
6725
6726

6727
6728
6729
6730
6731
6732
6733
6734
6735
6736
6737
6738
6739

6740
6741

6742
6743
6744










6745
6746
6747
6748


6749
6750
6751
6752


6753
6754

6755
6756
6757
6758
6759
6760
6761
6762
6763
6764
6765
6766
6767
6768
6769
6770









6771
6772
6773


6774
6775
6776
6777

6778
6779
6780
6781
6782
6783
6784
6785
6786
6787
6788
6789
6790
6791

6792
6793
6794
6795
6796
6797


6798


6799
6800
6801
6802
6803










6804
6805
6806



6807
6808
6809
6810
6811

6812
6813
6814
6815
6816
6817
6818
6819

6820
6821
6822


6823


6824

6825
6826
6827
6828
6829
6830
6831







-
+

-


-
+
+






-
-
+
-
-
-
+
-
-

-
-
-
-
+
+

-


+
+
+


-
+



-
-
-
-
-
-
-
-
-
-
+

+
-
-
+
+
+

-


+
+
+








-
+

-
+


-
-
-
-
-
-
-
-
-
-
+

+
+
-
-
+
+
+

-
-


-
+
+














-
-
-
-
-
-
-
-
-
+

+
-
-
+
+
+

-


+
+
+









-

+




-
-
+
-
-
+




-
-
-
-
-
-
-
-
-
-
+

+
-
-
-
+
+
+
+

-


+
+
+



-



-
-
+
-
-
+
-







    lappend l [gets $f]
    lappend l [tell $f]
    lappend l [eof $f]
    close $f
    set l
} [list 7 a\rb\rc 7 {} 7 1]

test io-50.1 {testing handler deletion} -constraints {testchannelevent testservicemode} -setup {
test io-50.1 {testing handler deletion} {testchannelevent} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    close $f
    update
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delhandler $f]]
    proc delhandler {f} {
	variable z
	set z called
	testchannelevent $f delete 0
    }
    set z not_called
    set timer [after 50 lappend z timeout]
    testservicemode 0
    update
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delhandler $f]]
    testservicemode 1
    close $f
    vwait z
    after cancel $timer
    set z
} -cleanup {
    close $f
} -result called
test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
} called
test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delhandler $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    proc delhandler {f i} {
	variable z
	lappend z "called delhandler $i"
	lappend z "called delhandler $f $i"
	testchannelevent $f delete 0
    }
    set z ""
    testservicemode 0
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delhandler $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    testservicemode 1
    set timer [after 50 lappend z timeout]
    vwait z
    after cancel $timer
    set z
} -cleanup {
    update
    close $f
    string compare [string tolower $z] \
} -result {{called delhandler 0} {called delhandler 1}}
test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
	[list [list called delhandler $f 0] [list called delhandler $f 1]]
} 0
test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    set z ""
    proc notcalled {f i} {
	variable z
	lappend z "notcalled was called!! $f $i"
    }
    proc delhandler {f i} {
	variable z
	testchannelevent $f delete 1
	lappend z "delhandler $i called"
	lappend z "delhandler $f $i called"
	testchannelevent $f delete 0
	lappend z "delhandler $i deleted myself"
	lappend z "delhandler $f $i deleted myself"
    }
    set z ""
    testservicemode 0
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f 1]]
    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
    testservicemode 1
    set timer [after 50 lappend z timeout]
    vwait z
    after cancel $timer
    set z
} -cleanup {
    update
    close $f
    string compare [string tolower $z] \
	[list [list delhandler $f 0 called] \
} -result {{delhandler 0 called} {delhandler 0 deleted myself}}
test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
	      [list delhandler $f 0 deleted myself]]
} 0
test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
    file delete $path(test1)
    update
} -body {
    set f [open $path(test1) w]
    close $f
    update
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delrecursive $f]]
    proc delrecursive {f} {
	variable z
	variable u
	if {"$u" == "recursive"} {
	    testchannelevent $f delete 0
	    lappend z "delrecursive deleting recursive"
	} else {
	    lappend z "delrecursive calling recursive"
	    set u recursive
	    update
	}
    }
    variable u toplevel
    variable z ""
    testservicemode 0
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list delrecursive $f]]
    testservicemode 1
    set timer [after 50 lappend z timeout]
    vwait z
    after cancel $timer
    set z
} -cleanup {
    update
    close $f
    string compare [string tolower $z] \
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode notOSX} -setup {
	{{delrecursive calling recursive} {delrecursive deleting recursive}}
} 0
test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f]]
    testchannelevent $f add readable [namespace code [list del $f]]
    proc notcalled {f} {
	variable z
	lappend z "notcalled was called!! $f"
    }
    proc del {f} {
	variable u
	variable z
	if {"$u" == "recursive"} {
	    testchannelevent $f delete 1
	    lappend z "del deleted notcalled"
	    testchannelevent $f delete 0
	    lappend z "del deleted notcalled"
	    lappend z "del deleted myself"
	} else {
	    set u recursive
	    lappend z "del calling recursive"
	    set timer [after 50 lappend z timeout]
	    vwait z
	    update
	    after cancel $timer
	    lappend z "del after recursive"
	    lappend z "del after update"
	}
    }
    set z ""
    set u toplevel
    testservicemode 0
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list notcalled $f]]
    testchannelevent $f add readable [namespace code [list del $f]]
    testservicemode 1
    set timer [after 50 set z timeout]
    vwait z
    after cancel $timer
    set z
} -cleanup {
    update
    close $f
    string compare [string tolower $z] \
} -result [list {del calling recursive} {del deleted notcalled} \
	       {del deleted myself} {del after recursive}]
test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
	[list {del calling recursive} {del deleted notcalled} \
	      {del deleted myself} {del after update}]
} 0
test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
    file delete $path(test1)
} -body {
    set f [open $path(test1) w]
    close $f
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list second $f]]
    testchannelevent $f add readable [namespace code [list first $f]]
    proc first {f} {
	variable u
	variable z
	variable done
	if {"$u" == "toplevel"} {
	    lappend z "first called"
	    set u first
	    set timer [after 50 lappend z timeout]
	    vwait z
	    update
	    after cancel $timer
	    lappend z "first after toplevel"
	    lappend z "first after update"
	    set done 1
	} else {
	    lappend z "first called not toplevel"
	}
    }
    proc second {f} {
	variable u
	variable z
6971
6972
6973
6974
6975
6976
6977
6978
6979
6980
6981
6982
6983
6984
6985
6986
6987
6988
6989
6990
6991
6992

6993
6994
6995





6996
6997
6998
6999
7000
7001
7002
6839
6840
6841
6842
6843
6844
6845






6846







6847
6848



6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859
6860







-
-
-
-
-
-

-
-
-
-
-
-
-

+
-
-
-
+
+
+
+
+







	} else {
	    lappend z "second called, cannot happen!"
	    testchannelevent $f removeall
	}
    }
    set z ""
    set u toplevel
    set done 0
    testservicemode 0
    set f [open $path(test1) r]
    testchannelevent $f add readable [namespace code [list second $f]]
    testchannelevent $f add readable [namespace code [list first $f]]
    testservicemode 1
    update
    if {!$done} {
	set timer2 [after 200 set done 1]
	vwait done
	after cancel $timer2
    }
    set z
} -cleanup {
    close $f
    string compare [string tolower $z] \
} -result [list {first called} {first called not toplevel} \
	{second called, first time} {second called, second time} \
	{first after toplevel}]
	[list {first called} {first called not toplevel} \
	      {second called, first time} {second called, second time} \
	      {first after update}]
} 0

test io-51.1 {Test old socket deletion on Macintosh} {socket} {
    set x 0
    set result ""
    proc accept {s a p} {
	variable x
	variable wait
	fconfigure $s -blocking off
7127
7128
7129
7130
7131
7132
7133
7134

7135
7136
7137
7138
7139
7140
7141
6985
6986
6987
6988
6989
6990
6991

6992
6993
6994
6995
6996
6997
6998
6999







-
+







    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} {
test io-52.5b {TclCopyChannel, all, wrapped to negative value} {fcopy} {
    file delete $path(test1)
    set f1 [open $thisScript]
    set f2 [open $path(test1) w]
    fconfigure $f1 -translation lf -blocking 0
    fconfigure $f2 -translation lf -blocking 0
    fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
7178
7179
7180
7181
7182
7183
7184
7185

7186
7187
7188
7189
7190
7191
7192
7036
7037
7038
7039
7040
7041
7042

7043
7044
7045
7046
7047
7048
7049
7050







-
+







    close $f1
    close $f2
    if {"$s1" == "$s2"} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-52.8 {TclCopyChannel} {stdio fcopy} {
test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    fconfigure $f1 -translation lf
    puts $f1 "
	puts ready
	gets stdin
7260
7261
7262
7263
7264
7265
7266
7267

7268
7269
7270
7271
7272
7273
7274
7275
7276
7277
7278
7279
7280
7281
7282
7283
7284
7285
7286
7287
7288

7289
7290
7291
7292
7293
7294
7295
7118
7119
7120
7121
7122
7123
7124

7125





7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
7137
7138
7139
7140

7141
7142
7143
7144
7145
7146
7147
7148







-
+
-
-
-
-
-















-
+








    fcopy $in $out
    close $in
    close $out

    file size $path(utf8-fcopy.txt)
} 5
test io-52.11 {TclCopyChannel & encodings} -setup {
test io-52.11 {TclCopyChannel & encodings} {fcopy} {
    set out [open $path(utf8-fcopy.txt) w]
    fconfigure $out -encoding utf-8 -translation lf
    puts $out "\u0410\u0410"
    close $out
} -constraints {fcopy} -body {
    # binary to encoding => the input has to be
    # in utf-8 to make sense to the encoder

    set in  [open $path(utf8-fcopy.txt) r]
    set out [open $path(kyrillic.txt) w]

    # -translation binary is also -encoding binary
    fconfigure $in  -translation binary
    fconfigure $out -encoding koi8-r -translation lf

    fcopy $in $out
    close $in
    close $out

    file size $path(kyrillic.txt)
} -result 3
} 3

test io-52.12 {coverage of -translation auto} {
    file delete $path(test1) $path(test2)
    set out [open $path(test1) wb]
    chan configure $out -translation lf
    puts -nonewline $out abcdefg\rhijklmn\nopqrstu\r\nvwxyz
    close $out
7458
7459
7460
7461
7462
7463
7464
7465

7466
7467
7468
7469
7470
7471
7472
7311
7312
7313
7314
7315
7316
7317

7318
7319
7320
7321
7322
7323
7324
7325







-
+







    set s1 [file size $thisScript]
    set s2 [file size $path(test1)]
    if {("$s1" == "$s2") && ($s0 == $s1)} {
        lappend result ok
    }
    set result
} {0 0 ok}
test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} {
test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts -nonewline $f1 {
	puts ready
	flush stdout				;# Don't assume line buffered!
	fcopy stdin stdout -command { set x }
7490
7491
7492
7493
7494
7495
7496
7497

7498
7499
7500
7501
7502

7503
7504
7505
7506
7507
7508




7509
7510
7511
7512
7513
7514
7515

7516
7517
7518
7519
7520
7521
7522
7343
7344
7345
7346
7347
7348
7349

7350
7351
7352
7353
7354
7355
7356
7357
7358
7359
7360
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381







-
+





+






+
+
+
+







+







    close $f1
    after 500
    set f [open $path(test1)]
    lappend result [read $f]
    close $f
    set result
} "ready line1 line2 {done\n}"
test io-53.4 {CopyData: background write overflow} {stdio fileevent fcopy} {
test io-53.4 {CopyData: background write overflow} {stdio openpipe fileevent fcopy} {
    set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
    variable x
    for {set x 0} {$x < 12} {incr x} {
	append big $big
    }
#    file delete $path(test1)
    file delete $path(pipe)
    set f1 [open $path(pipe) w]
    puts $f1 {
	puts ready
	fcopy stdin stdout -command { set x }
	vwait x
#	set f [open $path(test1) w]
#	fconfigure $f -translation lf
#	puts $f "done"
#	close $f
    }
    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    set result [gets $f1]
    fconfigure $f1 -blocking 0
    puts $f1 $big
    flush $f1
    after 500
    set result ""
    fileevent $f1 read [namespace code {
	append result [read $f1 1024]
	if {[string length $result] >= [string length $big]+1} {
	    set x done
	}
    }]
7581
7582
7583
7584
7585
7586
7587
7588

7589
7590
7591
7592
7593
7594
7595
7440
7441
7442
7443
7444
7445
7446

7447
7448
7449
7450
7451
7452
7453
7454







-
+







    if ![info exists fcopyTestDone] {
	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
    }
    close $in
    close $out
    set fcopyTestDone	;# 1 for error condition
} 1
test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} {
    variable fcopyTestDone
    file delete $path(pipe)
    file delete $path(test1)
    catch {unset fcopyTestDone}
    set f1 [open $path(pipe) w]
    puts $f1 "exit 1"
    close $f1
7614
7615
7616
7617
7618
7619
7620
7621

7622
7623
7624
7625
7626
7627
7628
7473
7474
7475
7476
7477
7478
7479

7480
7481
7482
7483
7484
7485
7486
7487







-
+







	set fcopyTestDone 0
    } else {
        # Delay next fcopy to wait for size>0 input bytes
        after 100 [list fcopy $in $out -size 1000 \
		-command [namespace code [list doFcopy $in $out]]]
    }
}
test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
    variable fcopyTestDone
    file delete $path(pipe)
    catch {unset fcopyTestDone}
    set fcopyTestCount 0
    set f1 [open $path(pipe) w]
    puts $f1 {
	# Write  10 bytes / 10 msec
7666
7667
7668
7669
7670
7671
7672
7673

7674
7675
7676
7677
7678
7679
7680
7525
7526
7527
7528
7529
7530
7531

7532
7533
7534
7535
7536
7537
7538
7539







-
+







    }
    # Files we use for our channels
    set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
    set bar [makeFile {} bar]
    # Channels to copy between
    set f [open $foo r] ; fconfigure $f -translation binary
    set g [open $bar w] ; fconfigure $g -translation binary -buffering none
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    # Record input size, so that result is always defined
    lappend ::RES [file size $bar]
    # Run the copy. Should not invoke -command now.
    fcopy $f $g -size 2 -command ::cmd
    # Check that -command was not called synchronously
    set sbs [file size $bar]
    lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs
7707
7708
7709
7710
7711
7712
7713
7714

7715
7716
7717
7718
7719
7720
7721
7566
7567
7568
7569
7570
7571
7572

7573
7574
7575
7576
7577
7578
7579
7580







-
+







    }
    # Files we use for our channels
    set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
    set bar [makeFile {} bar]
    # Channels to copy between
    set f [open $foo r] ; fconfigure $f -translation binary
    set g [open $bar w] ; fconfigure $g -translation binary -buffering none
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    # Initialize and force eof on the input.
    seek $f 0 end ; read $f 1
    set ::RES [eof $f]
    # Run the copy. Should not invoke -command now.
    fcopy $f $g -size 2 -command ::cmd
    # Check that -command was not called synchronously
    lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}]
7747
7748
7749
7750
7751
7752
7753
7754

7755
7756
7757
7758
7759
7760
7761
7606
7607
7608
7609
7610
7611
7612

7613
7614
7615
7616
7617
7618
7619
7620







-
+







    }
    # Files we use for our channels
    set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
    set bar [makeFile {} bar]
    # Channels to copy between
    set f [open $foo r] ; fconfigure $f -translation binary
    set g [open $bar w] ; fconfigure $g -translation binary -buffering none
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
	set ::RES {}
    # Run the copy. Should not invoke -command now.
    fcopy $f $g -size 0 -command ::cmd
    # Check that -command was not called synchronously
    lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}]
    # Now let the async part happen. Should capture the eof in cmd
    # If not break the event loop via timer.
7804
7805
7806
7807
7808
7809
7810
7811

7812
7813
7814
7815
7816
7817
7818
7663
7664
7665
7666
7667
7668
7669

7670
7671
7672
7673
7674
7675
7676
7677







-
+







    }
    proc ::done args {
	set ::forever OK
	return
    }
    set ::forever {}
    set out [open $out w]
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    fcopy $pipe $out -size 6 -command ::done
    set token [after 5000 {
	set ::forever {fcopy hangs}
    }]
    vwait ::forever
    catch {after cancel $token}
    set ::forever
7874
7875
7876
7877
7878
7879
7880
7881

7882
7883
7884
7885
7886
7887
7888
7733
7734
7735
7736
7737
7738
7739

7740
7741
7742
7743
7744
7745
7746
7747







-
+







    }
    set a [socket 127.0.0.1 9999]
    set b [socket 127.0.0.1 9999]
    fconfigure $a -translation binary -buffering none
    fconfigure $b -translation binary -buffering none
    fileevent  $a readable [list ::done $a]
    fileevent  $b readable [list ::done $b]
} -constraints {stdio fcopy} -body {
} -constraints {stdio openpipe fcopy} -body {
    # Now pass data through the server in both directions.
    set ::forever {}
    puts $a AB
    vwait ::forever
    puts $b BA
    vwait ::forever
    set ::forever
7922
7923
7924
7925
7926
7927
7928
7929
7930


7931
7932
7933
7934
7935
7936

7937
7938
7939
7940
7941
7942
7943
7944
7945
7946
7947
7948
7949
7950
7951
7952
7953
7954
7955
7956
7957
7958
7959
7960
7961
7962

7963
7964
7965
7966
7967
7968
7969
7781
7782
7783
7784
7785
7786
7787


7788
7789






7790











7791
7792
7793
7794
7795
7796
7797
7798
7799
7800
7801
7802
7803
7804

7805
7806
7807
7808
7809
7810
7811
7812







-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-














-
+







    set done
} -cleanup {
    close $outChan
    close $inChan
    removeFile out
    removeFile in
} -result {40 bytes copied}
test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
    file delete $path(pipe)

# test io-53.12 not backported.  Tests feature only in 8.6+
    set f1 [open $path(pipe) w]
    puts -nonewline $f1 {
	fconfigure stdin -translation binary -blocking 0
	fconfigure stdout -buffering none -translation binary
	fcopy stdin stdout
    }

    close $f1
    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
    fconfigure $f1 -translation binary -buffering none
    puts -nonewline $f1 A
    after 2000 {set ::done timeout}
    fileevent $f1 readable {set ::done ok}
    vwait ::done
    set ch [read $f1 1]
    close $f1
    list $::done $ch
} {ok A}
test io-53.13 {TclCopyChannel: read error reporting} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                return {initialize finalize watch read}
            }
            finalize {
                return
            }
            watch {}
            read {
		error FAIL
                error FAIL
            }
        }
    }
    set outFile [makeFile {} out]
} -body {
    set in [chan create read [namespace which driver]]
    chan configure $in -translation binary
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
8109
8110
8111
8112
8113
8114
8115
8116
8117
8118
8119
8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130
8131
8132
8133
8134
8135
8136
8137
8138
8139
8140
7888
7889
7890
7891
7892
7893
7894


















































































7895
7896
7897
7898
7899
7900
7901







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







} -body {
    chan copy $c $outChan
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result 100
test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        variable blocked
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        [string repeat a 100]]
                set blocked($chan) 1
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan) blocked($chan)
                return
            }
            watch {}
            read {
                if {$blocked($chan)} {
                    set blocked($chan) [expr {!$blocked($chan)}]
                    return -code error EAGAIN
                }
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -translation lf
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8 -translation lf
} -body {
    chan copy $c $outChan
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result 100
test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup {
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) [encoding convertto utf-8 \
                        line\n[string repeat a 100]line\n]
                return {initialize finalize watch read}
            }
            finalize {
                unset index($chan) buffer($chan)
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                return $result
            }
        }
    }
    set c [chan create read [namespace which driver]]
    chan configure $c -encoding utf-8 -translation lf -buffersize 107
    set out [makeFile {} out]
    set outChan [open $out w]
    chan configure $outChan -encoding utf-8 -translation lf
} -body {
    list [gets $c] [chan copy $c $outChan -size 100] [gets $c]
} -cleanup {
    close $outChan
    close $c
    removeFile out
} -result {line 100 line}

test io-54.1 {Recursive channel events} {socket fileevent knownMsvcBug} {
    # This test checks to see if file events are delivered during recursive
    # event loops when there is buffered data on the channel.

    proc accept {s a p} {
	variable as
8337
8338
8339
8340
8341
8342
8343
8344

8345
8346
8347
8348
8349
8350
8351
8098
8099
8100
8101
8102
8103
8104

8105
8106
8107
8108
8109
8110
8111
8112







-
+







    vwait [namespace which -variable result]
    close $s
    close $s2
    close $server
    set result
} {1 readable 234567890 timer}

test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
    set out [open $path(script) w]
    puts $out {
	puts "normal message from pipe"
	puts stderr "error message from pipe"
	exit 1
    }
    proc readit {pipe} {
8369
8370
8371
8372
8373
8374
8375
8376

8377
8378
8379
8380
8381
8382
8383
8384

8385
8386
8387
8388
8389
8390

8391
8392
8393
8394
8395
8396
8397
8130
8131
8132
8133
8134
8135
8136

8137
8138
8139
8140
8141
8142
8143
8144

8145
8146
8147
8148

8149

8150
8151
8152
8153
8154
8155
8156
8157







-
+







-
+



-

-
+







} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}

test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
    # TIP #10
    # More complicated tests (like that the reference changes as a
    # channel is moved from thread to thread) can be done only in the
    # extension which fully implements the moving of channels between
    # threads, i.e. 'Threads'.
    # threads, i.e. 'Threads'. Or we have to extend [testthread] as well.

    set f [open $path(longfile) r]
    set result [testchannel mthread $f]
    close $f
    string equal $result [testmainthread]
} {1}

test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
test io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
    # This test will hang in older revisions of the core.

    set out [open $path(script) w]
    puts $out "catch {load $::tcltestlib Tcltest}"
    puts $out {
	puts [testbytestring \xe2]
	puts [encoding convertfrom identity \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result
	if {[eof $pipe]} {
	    set x [catch {close $pipe} line]
8462
8463
8464
8465
8466
8467
8468


















8469

8470
8471
8472
8473
8474
8475
8476
8477
8478
8479


8480
8481

8482
8483
8484
8485
8486
8487
8488

8489
8490
8491
8492
8493
8494
8495
8222
8223
8224
8225
8226
8227
8228
8229
8230
8231
8232
8233
8234
8235
8236
8237
8238
8239
8240
8241
8242
8243
8244
8245
8246

8247
8248
8249
8250
8251
8252
8253
8254
8255


8256
8257


8258
8259
8260
8261
8262
8263
8264

8265
8266
8267
8268
8269
8270
8271
8272







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+








-
-
+
+
-
-
+






-
+








    removeFile cutsplice

    set res
} {0 1 0}


# Duplicate of code in "thread.test". Find a better way of doing this
# without duplication. Maybe placement into a proc which transforms to
# nop after the first call, and placement of its defintion in a
# central location.

if {[testConstraint testthread]} {
    testthread errorproc ThreadError

    proc ThreadError {id info} {
	global threadError
	set threadError $info
    }

    proc ThreadNullError {id info} {
	# ignore
    }
}

test io-70.1 {Transfer channel} {testchannel thread} {
test io-70.1 {Transfer channel} {testchannel testthread} {
    set f [makeFile {... dummy ...} cutsplice]
    set c [open $f r]

    set     res {}
    lappend res [catch {seek $c 0 start}]
    testchannel cut $c
    lappend res [catch {seek $c 0 start}]

    set tid [thread::create -preserved]
    thread::send $tid [list set c $c]
    set tid [testthread create]
    testthread send $tid [list set c $c]
    thread::send $tid {load {} Tcltest}
    lappend res [thread::send $tid {
    lappend res [testthread send $tid {
	testchannel splice $c
	set res [catch {seek $c 0 start}]
	close $c
	set res
    }]

    thread::release $tid
    tcltest::threadReap
    removeFile cutsplice

    set res
} {0 1 0}

# ### ### ### ######### ######### #########

8680
8681
8682
8683
8684
8685
8686
8687

8688
8689
8690
8691

8692
8693
8694
8695
8696
8697
8698

8699
8700
8701
8702
8703
8704
8705
8457
8458
8459
8460
8461
8462
8463

8464
8465


8466
8467
8468
8469
8470
8471



8472
8473
8474
8475
8476
8477
8478
8479







-
+

-
-

+




-
-
-
+







}

test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
    # Test for Bug 1847044 - don't spoil type unless we have a valid channel
    catch {close [lreplace [list a] 0 end]}
} {1}

test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} {} {
    # Invalidate intrep of 'channel' Tcl_Obj when transiting between interpreters.
    set f [open [info script] r]
} -body {
    interp create foo
    set f [open [info script] r]
    seek $f 0
    set code [catch {interp eval foo [list seek $f 0]} msg]
    # The string map converts the changing channel handle to a fixed string
    list $code [string map [list $f @@] $msg]
} -cleanup {
    close $f
} -result {1 {can not find channel named "@@"}}
} {1 {can not find channel named "@@"}}

test io-73.3 {[5adc350683] [gets] after EOF} -setup {
    set fn [makeFile {} io-73.3]
    set rfd [open $fn r]
    set wfd [open $fn a]
    chan configure $wfd -buffering line
    read $rfd
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
8529
8530
8531
8532
8533
8534
8535

8536
8537
8538
8539
8540

8541
8542
8543
8544

8545
8546
8547
8548
8549
8550
8551
8552

8553
8554
8555
8556
8557
8558
8559
8560







-
+




-
+



-
+







-
+







    removeFile io-73.5
} -result [list 1 1 more\u00a0data 1]

test io-74.1 {[104f2885bb] improper cache validity check} -setup {
    set fn [makeFile {} io-74.1]
    set rfd [open $fn r]
    testobj freeallvars
    interp create child
    interp create slave
} -constraints testobj -body {
    teststringobj set 1 [string range $rfd 0 end]
    read [teststringobj get 1]
    testobj duplicate 1 2
    interp transfer {} $rfd child
    interp transfer {} $rfd slave
    catch {read [teststringobj get 1]}
    read [teststringobj get 2]
} -cleanup {
    interp delete child
    interp delete slave
    testobj freeallvars
    removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}

# ### ### ### ######### ######### #########

# cleanup
foreach file [list fooBar longfile script script2 output test1 pipe my_script \
foreach file [list fooBar longfile script output test1 pipe my_script \
	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
    removeFile $file
}
cleanupTests
}
namespace delete ::tcl::test::io
return

Changes to tests/ioCmd.test.

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
9
10
11
12
13
14
15


16
17
18
19
20





21
22
23
24
25
26
27
28
29
30
31







-
-
+
+



-
-
-
-
-

+

+







# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

package require tcltests

# Custom constraints used in this file
testConstraint fcopy		[llength [info commands fcopy]]
testConstraint testchannel	[llength [info commands testchannel]]
testConstraint testthread	[llength [info commands testthread]]

#----------------------------------------------------------------------

test iocmd-1.1 {puts command} {
   list [catch {puts} msg] $msg
} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
test iocmd-1.2 {puts command} {
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
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







-
+


-
+











-
+

-
-
+
-

+
-
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+













-
+


-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+

-

-
-
+
+
-
-
-
-
+
+
+
+

-
-


-
+
+


-
-
-
-
+
+
+
+

-



-
+
-
-
-
-
-
-
+
+
+
+
+
+

-
+

-
+
-
-
-
-
+
+
+
+

-
+
-
-
-
-
+
+
+
+

-
+
-
-
-
+
+
+
















-
+







    puts $f "Two lines: this one"
    puts $f "and this one"
    close $f
    set f [open $path(test1)]
    set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode]
    close $f
    set x
} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}}
} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
test iocmd-4.9 {read command} {
    list [catch {read stdin foo} msg] $msg $::errorCode
} {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}}
} {1 {expected integer but got "foo"} {TCL VALUE NUMBER}}
test iocmd-4.10 {read command} {
    list [catch {read file107} msg] $msg $::errorCode
} {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}}
set path(test3) [makeFile {} test3]
test iocmd-4.11 {read command} {
    set f [open $path(test3) w]
    set x [list [catch {read $f} msg] $msg $::errorCode]
    close $f
    string compare [string tolower $x] \
	[list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
} 0
test iocmd-4.12 {read command} -setup {
test iocmd-4.12 {read command} {
    set f [open $path(test1)]
} -body {
    read $f 12z
    set x [list [catch {read $f 12z} msg] $msg $::errorCode]
} -cleanup {
    close $f
    set x
} -result {expected non-negative integer but got "12z"} -errorCode {TCL VALUE NUMBER}
} {1 {expected integer but got "12z"} {TCL VALUE NUMBER}}

test iocmd-5.1 {seek command} -returnCodes error -body {
    seek
} -result {wrong # args: should be "seek channelId offset ?origin?"}
test iocmd-5.2 {seek command} -returnCodes error -body {
    seek a b c d e f g
} -result {wrong # args: should be "seek channelId offset ?origin?"}
test iocmd-5.3 {seek command} -returnCodes error -body {
    seek stdin gugu
} -result {expected integer but got "gugu"}
test iocmd-5.4 {seek command} -returnCodes error -body {
    seek stdin 100 gugu
} -result {bad origin "gugu": must be start, current, or end}
test iocmd-5.1 {seek command} {
    list [catch {seek} msg] $msg
} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
test iocmd-5.2 {seek command} {
    list [catch {seek a b c d e f g} msg] $msg
} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
test iocmd-5.3 {seek command} {
    list [catch {seek stdin gugu} msg] $msg
} {1 {expected integer but got "gugu"}}
test iocmd-5.4 {seek command} {
    list [catch {seek stdin 100 gugu} msg] $msg
} {1 {bad origin "gugu": must be start, current, or end}}

test iocmd-6.1 {tell command} {
    list [catch {tell} msg] $msg
} {1 {wrong # args: should be "tell channelId"}}
test iocmd-6.2 {tell command} {
    list [catch {tell a b c d e} msg] $msg
} {1 {wrong # args: should be "tell channelId"}}
test iocmd-6.3 {tell command} {
    list [catch {tell aaa} msg] $msg
} {1 {can not find channel named "aaa"}}

test iocmd-7.1 {close command} {
    list [catch {close} msg] $msg
} {1 {wrong # args: should be "close channelId ?direction?"}}
} {1 {wrong # args: should be "close channelId"}}
test iocmd-7.2 {close command} {
    list [catch {close a b c d e} msg] $msg
} {1 {wrong # args: should be "close channelId ?direction?"}}
} {1 {wrong # args: should be "close channelId"}}
test iocmd-7.3 {close command} {
    list [catch {close aaa} msg] $msg
} {1 {can not find channel named "aaa"}}
test iocmd-7.4 {close command} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan bar
} -cleanup {
    close $chan
} -returnCodes error -result "bad direction \"bar\": must be read or write"
test iocmd-7.5 {close command} -setup {
    set chan [open [info script] r]
} -body {
    chan close $chan write
} -cleanup {
    close $chan
} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"

proc expectedOpts {got extra} {
    set basicOpts {
	-blocking -buffering -buffersize -encoding -eofchar -translation
    }
    set opts [list {*}$basicOpts {*}$extra]
    lset opts end [string cat "or " [lindex $opts end]]
    return [format {bad option "%s": should be one of %s} $got [join $opts ", "]]
}
test iocmd-8.1 {fconfigure command} -returnCodes error -body {
    fconfigure
} -result {wrong # args: should be "fconfigure channelId ?-option value ...?"}
test iocmd-8.2 {fconfigure command} -returnCodes error -body {
    fconfigure a b c d e f
} -result {wrong # args: should be "fconfigure channelId ?-option value ...?"}
test iocmd-8.3 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}
test iocmd-8.4 {fconfigure command} -setup {
test iocmd-8.1 {fconfigure command} {
    list [catch {fconfigure} msg] $msg
} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
test iocmd-8.2 {fconfigure command} {
    list [catch {fconfigure a b c d e f} msg] $msg
} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
test iocmd-8.3 {fconfigure command} {
    list [catch {fconfigure a b} msg] $msg
} {1 {can not find channel named "a"}}
test iocmd-8.4 {fconfigure command} {
    file delete $path(test1)
    set f1 [open $path(test1) w]
    set x [list [catch {fconfigure $f1 froboz} msg] $msg]
    close $f1
    set x
} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.5 {fconfigure command} {
    list [catch {fconfigure stdin -buffering froboz} msg] $msg
} {1 {bad value for -buffering: must be one of full, line, or none}}
test iocmd-8.6 {fconfigure command} {
    list [catch {fconfigure stdin -translation froboz} msg] $msg
} {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}}
} -body {
    fconfigure $f1 froboz
} -returnCodes error -cleanup {
    close $f1
} -result [expectedOpts "froboz" {}]
test iocmd-8.5 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -buffering froboz
} -result {bad value for -buffering: must be one of full, line, or none}
test iocmd-8.6 {fconfigure command} -returnCodes error -body {
    fconfigure stdin -translation froboz
} -result {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}
test iocmd-8.7 {fconfigure command} -setup {
test iocmd-8.7 {fconfigure command} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -eofchar {} -encoding utf-16
    fconfigure $f1
    fconfigure $f1 -translation lf -eofchar {} -encoding unicode
    set x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering full -buffersize 4096 -encoding utf-16 -eofchar {} -translation lf}
test iocmd-8.8 {fconfigure command} -setup {
    close $f1
    set x
} {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf}
test iocmd-8.8 {fconfigure command} {
    file delete $path(test1)
    set x {}
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
		-eofchar {} -encoding utf-16
		-eofchar {} -encoding unicode
    set x ""
    lappend x [fconfigure $f1 -buffering]
    lappend x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {line {-blocking 1 -buffering line -buffersize 3030 -encoding utf-16 -eofchar {} -translation lf}}
test iocmd-8.9 {fconfigure command} -setup {
    close $f1
    set x
} {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}}
test iocmd-8.9 {fconfigure command} {
    file delete $path(test1)
} -body {
    set f1 [open $path(test1) w]
    fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
		-eofchar {} -encoding binary
    fconfigure $f1
    set x [fconfigure $f1]
} -cleanup {
    catch {close $f1}
} -result {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
test iocmd-8.10 {fconfigure command} -returnCodes error -body {
    fconfigure a b
} -result {can not find channel named "a"}
    close $f1
    set x
} {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
test iocmd-8.10 {fconfigure command} {
    list [catch {fconfigure a b} msg] $msg
} {1 {can not find channel named "a"}}
set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
test iocmd-8.11 {fconfigure command} -body {
test iocmd-8.11 {fconfigure command} {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -froboz blarfo
    set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg]
} -returnCodes error -cleanup {
    catch {close $chan}
} -result [expectedOpts "-froboz" {}]
test iocmd-8.12 {fconfigure command} -body {
    close $chan
    set res
} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.12 {fconfigure command} {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -b blarfo
    set res [list [catch {fconfigure $chan -b blarfo} msg] $msg]
} -returnCodes error -cleanup {
    catch {close $chan}
} -result [expectedOpts "-b" {}]
test iocmd-8.13 {fconfigure command} -body {
    close $chan
    set res
} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
test iocmd-8.13 {fconfigure command} {
    set chan [open $path(fconfigure.dummy) r]
    fconfigure $chan -buffer blarfo
    set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg]
} -returnCodes error -cleanup {
    catch {close $chan}
} -result [expectedOpts "-buffer" {}]
    close $chan
    set res
} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
removeFile fconfigure.dummy
test iocmd-8.14 {fconfigure command} {
    fconfigure stdin -buffers
} 4096
test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup {
    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
    set port [lindex [fconfigure $srv -sockname] 2]
    proc iocmdSRV {sock ip port} {close $sock}
    set cli [socket 127.0.0.1 $port]
} -body {
    fconfigure $cli -blah
} -cleanup {
    close $cli
    close $srv
    unset cli srv port
    rename iocmdSRV {}
} -returnCodes error -result [expectedOpts "-blah" {-connecting -peername -sockname}]
} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}
test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
    set port [lindex [fconfigure $srv -sockname] 2]
    proc iocmdSRV {sock ip port} {close $sock}
    set cli [socket 127.0.0.1 $port]
} -body {
    expr {[lindex [fconfigure $cli -peername] 2] == $port}
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
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







-
+










-
-
-
-
-
-
-
-
+
+




-
+


-
+







    # might fail if /dev/ttya is unavailable
    set tty [open /dev/ttya]
    fconfigure $tty -blah blih
} -cleanup {
    if {$tty ne ""} {
	close $tty
    }
} -returnCodes error -result [expectedOpts "-blah" {-closemode -inputmode -mode -queue -ttystatus -xchar}]
} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}
test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup {
    set tty ""
} -body {
    # might fail early if com1 is unavailable
    set tty [open com1]
    fconfigure $tty -blah blih
} -cleanup {
    if {$tty ne ""} {
	close $tty
    }
} -returnCodes error -result [expectedOpts "-blah" {-closemode -mode -handshake -pollinterval -sysbuffer -timeout -ttycontrol -xchar}]
test iocmd-8.20 {fconfigure command / win console channel} -constraints {nonPortable win} -setup {
    # I don't know how else to open the console, but this is non-portable
    set console stdin
} -body {
    fconfigure $console -blah blih
} -returnCodes error -result [expectedOpts "-blah" {-inputmode}]
# TODO: Test parsing of serial channel options (nonPortable, since requires an
} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar}
# TODO: Test parsing of serial channel options (nonportable, since requires an
# open channel to work with).

test iocmd-9.1 {eof command} {
    list [catch {eof} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
} {1 {wrong # args: should be "eof channelId"} NONE}
test iocmd-9.2 {eof command} {
    list [catch {eof a b} msg] $msg $::errorCode
} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
} {1 {wrong # args: should be "eof channelId"} NONE}
test iocmd-9.3 {eof command} {
    catch {close file100}
    list [catch {eof file100} msg] $msg $::errorCode
} {1 {can not find channel named "file100"} {TCL LOOKUP CHANNEL file100}}

# The tests for Tcl_ExecObjCmd are in exec.test

402
403
404
405
406
407
408
409

410
411
412

413
414
415
416


417
418
419
420
421
422
423
366
367
368
369
370
371
372

373
374
375

376
377
378


379
380
381
382
383
384
385
386
387







-
+


-
+


-
-
+
+







set path(test4) [makeFile {} test4]
set path(test5) [makeFile {} test5]

test iocmd-11.1 {I/O to command pipelines} {unixOrWin unixExecs} {
    set f [open $path(test4) w]
    close $f
    list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
} {1 {can't write input to command: standard input was redirected} NONE}
test iocmd-11.2 {I/O to command pipelines} {unixOrWin unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
} {1 {can't read output from command: standard output was redirected} NONE}
test iocmd-11.3 {I/O to command pipelines} {unixOrWin unixExecs} {
    list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrWin} {
} {1 {can't read output from command: standard output was redirected} NONE}
test iocmd-11.4 {I/O to command pipelines} unixOrWin {
    list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}

test iocmd-12.1 {POSIX open access modes: RDONLY} {
    file delete $path(test1)
    set f [open $path(test1) w]
    puts $f "Two lines: this one"
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
522
523
524
525
526
527
528





















529
530
531
532
533
534
535







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    foreach ch $chans {catch {close $ch}}
    lsort [split [string trim [viewFile out]] \n]
} -cleanup {
    removeFile out
    # Ensure that channels are gone, even if body failed to do so
    foreach ch $chans {catch {close $ch}}
} -result {0 1 2 3 4 5 6 7 8 9}
test ioCmd-13.11 {open ... a+ must not use O_APPEND: Bug 1773127} -setup {
    set f [makeFile {} ioutil41.tmp]
    set fid [open $f wb]
    puts -nonewline $fid 123
    close $fid
} -body {
    set fid [open $f ab+]
    puts -nonewline $fid 456
    seek $fid 2
    set d [read $fid 2]
    seek $fid 4
    puts -nonewline $fid x
    close $fid
    set fid [open $f rb]
    append d [read $fid]
    close $fid
    return $d
} -cleanup {
    removeFile $f
} -result 341234x6


test iocmd-14.1 {file id parsing errors} {
    list [catch {eof gorp} msg] $msg $::errorCode
} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
test iocmd-14.2 {file id parsing errors} {
    list [catch {eof filex} msg] $msg
} {1 {can not find channel named "filex"}}
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
686
595
596
597
598
599
600
601

602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618




619
620
621
622
623
624
625
626
627
628
629
630







-
+
















-
-
-
-
+
+
+
+
+







    list [catch {fcopy $wfile $wfile} msg] $msg
} "1 {channel \"$wfile\" wasn't opened for reading}"
test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $rfile} msg] $msg
} "1 {channel \"$rfile\" wasn't opened for writing}"
test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $wfile foo bar} msg] $msg
} {1 {bad option "foo": must be -size or -command}}
} {1 {bad switch "foo": must be -size or -command}}
test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $wfile -size foo} msg] $msg
} {1 {expected integer but got "foo"}}
test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
    list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg
} {1 {expected integer but got "foo"}}

close $rfile
close $wfile

# ### ### ### ######### ######### #########
## Testing the reflected channel.

test iocmd-20.0 {chan, wrong#args} {
    catch {chan} msg
    set msg
} {wrong # args: should be "chan subcommand ?arg ...?"}
test iocmd-20.1 {chan, unknown method} -body {
    chan foo
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *}
} {wrong # args: should be "chan subcommand ?argument ...?"}
test iocmd-20.1 {chan, unknown method} {
    catch {chan foo} msg
    set msg
} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, pending, postevent, puts, read, seek, tell, or truncate}

# --- --- --- --------- --------- ---------
# chan create, and method "initalize"

test iocmd-21.0 {chan create, wrong#args, not enough} {
    catch {chan create} msg
    set msg
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
870
871
872
873
874
875
876











877
878
879
880
881
882
883







-
-
-
-
-
-
-
-
-
-
-







    return -code return $args
}
proc onfinal {} {
    upvar args hargs
    if {[lindex $hargs 0] ne "finalize"} {return}
    return -code return ""
}

proc onwatch {} {
    upvar args hargs
    lassign $hargs watch chan eventspec
    if {$watch ne "watch"} return
    foreach spec $eventspec {
	chan postevent $chan $spec
    }
    return
}

}

# Set everything up in the main thread.
eval $helperscript

# --- --- --- --------- --------- ---------
# method finalize
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
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







-
-
-
+
+

-
+




-
+




-
-
+
+

-
+




-
+












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-











-
+







    rename foo {}
    set res
} -result {{unmatched open brace in list}}
test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    set tock {}
    note [fileevent $c readable {lappend res TOCK; set tock 1}]
    set stop [after 15000 {lappend res TIMEOUT; set tock 1}]
    note [fileevent $c readable {note TOCK}]
    set stop [after 15000 {note TIMEOUT}]
    after  1000 {note [chan postevent $c r]}
    vwait ::tock
    vwait ::res
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* read} {} {} TOCK {watch rc* {}}}
} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    note [fileevent $c writable {lappend res TOCK; set tock 1}]
    set stop [after 15000 {lappend res TIMEOUT; set tock 1}]
    note [fileevent $c writable {note TOCK}]
    set stop [after 15000 {note TIMEOUT}]
    after  1000 {note [chan postevent $c w]}
    vwait ::tock
    vwait ::res
    catch {after cancel $stop}
    close $c
    rename foo {}
    set res
} -result {{watch rc* write} {} {} TOCK {watch rc* {}}}
} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
    proc foo {args} {oninit; onfinal; track; return}
    proc dummy args { return }
    set c [chan create {r w} foo]
    fileevent $c readable dummy
} -body {
    close $c
    chan postevent $c read
} -cleanup {
    rename foo   {}
    rename dummy {}
} -returnCodes error -result {can not find reflected channel named "rc*"}
test iocmd-31.9 {
    chan postevent

    call to current coroutine

    see 67a5eabbd3d1
} -match glob -body {
    set res {}
    proc foo {args} {oninit; onwatch; onfinal; track; return}
    set c [chan create {r w} foo]
    after 0 [list ::apply [list c {
	coroutine c1 ::apply [list c {
	    chan event $c readable [list [info coroutine]]
	    yield
	    set ::done READING
	} [namespace current]] $c
    } [namespace current]] $c]
    set stop [after 10000 {set done TIMEOUT}]
    vwait ::done
    catch {after cancel $stop}
    lappend res $done
    close $c
    rename foo {}
    set res
} -result {{watch rc* read} READING {watch rc* {}}}

# --- === *** ###########################
# 'Pull the rug' tests. Create channel in a interpreter A, move to
# other interpreter B, destroy the origin interpreter (A) before or
# during access from B. Must not crash, must return proper errors.

test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {

    set ida [interp create];#puts <<$ida>>
    set idb [interp create];#puts <<$idb>>

    # Magic to get the test* commands in the children
    # Magic to get the test* commands in the slaves
    load {} Tcltest $ida
    load {} Tcltest $idb

    # Set up channel in interpreter
    interp eval $ida $helperscript
    set chan [interp eval $ida {
	proc foo {args} {oninit seek; onfinal; track; return}
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
2015
2016
2017
2018
2019
2020
2021


2022
2023
2024
2025
2026
2027
2028
2029

2030
2031
2032
2033
2034
2035
2036
2037







-
-








-
+







    lappend res [catch {interp eval $idb [list puts  $chan shoo]} msg] $msg
    lappend res [catch {interp eval $idb [list tell  $chan]}      msg] $msg
    lappend res [catch {interp eval $idb [list seek  $chan 1]}    msg] $msg
    lappend res [catch {interp eval $idb [list gets  $chan]}      msg] $msg
    lappend res [catch {interp eval $idb [list close $chan]}      msg] $msg
    set res

} -cleanup {
    interp delete $idb
} -constraints {testchannel} \
    -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}

test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body {

    set ida [interp create];#puts <<$ida>>
    set idb [interp create];#puts <<$idb>>

    # Magic to get the test* commands in the children
    # Magic to get the test* commands in the slaves
    load {} Tcltest $ida
    load {} Tcltest $idb

    # Set up channel in thread
    set chan [interp eval $ida $helperscript]
    set chan [interp eval $ida {
	proc foo {args} {
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667

2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715

2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778

2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781

3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792

3793
3794
3795

3796
3797
3798
3799
3800


3801
3802
3803
3804
3805
3806
3807
3808
3809


3810
3811
3812


3813
3814
3815

3816
3817
3818
3819
3820
3821





3822
3823
3824

3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842

3843
3844

3845
3846
3847
3848
3849


3850
3851
3852
3853

3854

3855
3856
3857
3858
3859
3860
3861
3862


3863
3864
3865
3866
3867
3868
3869
3870



3871
3872
3873
3874
3875

3876
3877
3878
3879
3880

3881
3882

3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
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
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

















































































































2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672

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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718

2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734

2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750

2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767

2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784

2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801

2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819

2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837

2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853

2854
2855
2856
2857
2858
2859
2860
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
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







+








-
-






-
-
-
-
-
+
+
+
+
+

-
+













+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+
-








-
-
+
+
-
-
-
+
+






-
+




-
+







-
+


-
+




-
+




















-
+












-
+










-
+










-
+











-
+











-
+











-
+











-
+


















-
+














-
+













-
+















-
+















-
+















-
+















-
+















-
+



















-
+



















-
+



















-
+
















-
+










-
+












-
+












-
+












-
+













-
+













-
+













-
+













-
+













-
+













-
+














-
+


















-
+



















-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
+












-
+















-
+
















-
+















-
+















-
+
















-
+
















-
+
















-
+

















-
+

















-
+















-
+











-
+
















-
+
















-
+
















-
+

















-
+















-
+















-
+
















-
+
















-
+
















-
+

















-
+
















-
+













-
+













-
+













-
+













-
+














-
+












-
+













-
+













-
+













-
+













-
+













-
+













-
+













-
+














-
+













-
+













-
+












-
+

















-
+

















-
+













-
+












-
+













-
+













-
+














-
+













-
+













-
+













-
+














-
+













-
+















-
+












-
+














-
+














-
+



















-
+










-
+
-
-
-
+
-


-
-
+
+







-
-
+
+


-
+
+


-
+

-
-
-
-
-
+
+
+
+
+


-
+


-
-
-
-
-
-
-
-
-
-
-
-



-
+
-
-
+
-


-
-
+
+



-
+
-
+






-
-
+
+





-
-
-
+
+
+




-
+



-
-
+

-
+








-
-
-
-
-
-
-
-
-
-








    interp eval $ida [list testchannel cut    $chan]
    interp eval $idb [list testchannel splice $chan]

    # Run access from interpreter B, this will give us a synchronous
    # response.

    interp eval $idb [list set chan $chan]
    interp eval $idb [list set mid $tcltest::mainThread]
    set res [interp eval $idb {
	# wait a bit, give the main thread the time to start its event
	# loop to wait for the response from B
	after 2000
	catch { puts $chan shoo } res
	set res
    }]
    set res
} -cleanup {
    interp delete $idb
} -constraints {testchannel} -result {Owner lost}

test iocmd-32.2 {delete interp of reflected chan} {
    # Bug 3034840
    # Run this test in an interp with memory debugging to panic
    # on the double free
    interp create child
    child eval {
        proc no-op args {}
        proc driver {sub args} {return {initialize finalize watch read}}
        chan event [chan create read driver] readable no-op
    interp create slave
    slave eval {
	proc no-op args {}
	proc driver {sub args} {return {initialize finalize watch read}}
	chan event [chan create read driver] readable no-op
    }
    interp delete child
    interp delete slave
} {}

# ### ### ### ######### ######### #########
## Same tests as above, but exercising the code forwarding and
## receiving driver operations to the originator thread.

# -*- tcl -*-
# ### ### ### ######### ######### #########
## Testing the reflected channel (Thread forwarding).
#
## The id numbers refer to the original test without thread
## forwarding, and gaps due to tests not applicable to forwarding are
## left to keep this asociation.

# Duplicate of code in "thread.test". Find a better way of doing this
# without duplication. Maybe placement into a proc which transforms to
# nop after the first call, and placement of its defintion in a
# central location.

if {[testConstraint testthread]} {
    testthread errorproc ThreadError

    proc ThreadError {id info} {
	global threadError
	set threadError $info
    }
    proc ThreadNullError {id info} {
	# ignore
    }
}

# ### ### ### ######### ######### #########
## Helper command. Runs a script in a separate thread and returns the
## result. A channel is transfered into the thread as well, and list of
## configuation variables

proc inthread {chan script args} {
    # Test thread.

    set tid [thread::create -preserved]
    set tid [testthread create]
    thread::send $tid {load {} Tcltest}

    # Init thread configuration.
    # - Listed variables
    # - Id of main thread
    # - A number of helper commands

    foreach v $args {
	upvar 1 $v x
	thread::send $tid [list set $v $x]

	testthread send $tid [list set $v $x]
    }
    }
    thread::send $tid [list set mid [thread::id]]
    thread::send $tid {
    testthread send $tid [list set mid $tcltest::mainThread]
    testthread send $tid {
	proc note {item} {global notes; lappend notes $item}
	proc notes {} {global notes; return $notes}
	proc noteOpts opts {global notes; lappend notes [dict merge {
	    -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
	} $opts]}
    }
    thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
    testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*)

    # Transfer channel (cut/splice aka detach/attach)

    testchannel cut $chan
    thread::send $tid [list testchannel splice $chan]
    testthread send $tid [list testchannel splice $chan]

    # Run test script, also run local event loop!
    # The local event loop waits for the result to come back.
    # It is also necessary for the execution of forwarded channel
    # operations.

    set ::tres ""
    thread::send -async $tid {
    testthread send -async $tid {
	after 500
	catch {s} res; # This runs the script, 's' was defined at (*)
	thread::send -async $mid [list set ::tres $res]
	testthread send -async $mid [list set ::tres $res]
    }
    vwait ::tres
    # Remove test thread, and return the captured result.

    thread::release $tid
    tcltest::threadReap
    return $::tres
}

# ### ### ### ######### ######### #########

# ### ### ### ######### ######### #########

test iocmd.tf-22.2 {chan finalize, for close} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; return {}}
    note [set c [chan create {r w} foo]]
    note [inthread $c {
	close $c
	# Close the deleted the channel.
	file channels rc*
    } c]
    # Channel destruction does not kill handler command!
    note [info command foo]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; return -code error 5}
    note [set c [chan create {r w} foo]]
    notes [inthread $c {
	note [catch {close $c} msg]; note $msg
	# Channel is gone despite error.
	note [file channels rc*]
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; error FOO}
    note [set c [chan create {r w} foo]]
    notes [inthread $c {
	note [catch {close $c} msg]; note $msg
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; return SOMETHING}
    note [set c [chan create {r w} foo]]
    notes [inthread $c {
	note [catch {close $c} msg]; note $msg
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; return -code 3}
    note [set c [chan create {r w} foo]]
    notes [inthread $c {
	note [catch {close $c} msg]; note $msg
	notes
    } c]
    rename foo {}
    set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; return -code 4}
    note [set c [chan create {r w} foo]]
    notes [inthread $c {
	note [catch {close $c} msg]; note $msg
	notes
    } c]
    rename foo {}
    set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; return -code 777 BANG}
    note [set c [chan create {r w} foo]]
    notes [inthread $c {
	note [catch {close $c} msg]; note $msg
	notes
    } c]
    rename foo {}
    set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
    set res {}
    proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
    note [set c [chan create {r w} foo]]
    notes [inthread $c {
	note [catch {close $c} msg opt]; note $msg; noteOpts $opt
	notes
    } c]
    rename foo {}
    set res
} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}

# --- === *** ###########################
# method read

test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return snarf
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [read $c 10]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
} -constraints {testchannel testthread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return [string repeat snarf 1000]
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {[read $c 2]} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{read rc* 4096} 1 {read delivered more than requested}}
} -constraints {testchannel testthread} -result {{read rc* 4096} 1 {read delivered more than requested}}
test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track; note MUST_NOT_HAPPEN
    }
    set c [chan create {w} foo]
    notes [inthread $c {
	note [catch {[read $c 2]} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for reading}}
} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for reading}}
test iocmd.tf-23.4 {chan read, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 BOOM!} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code break BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code continue BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -code 777 BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {read $c 2} msg]; note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return -level 55 -code 777 BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return ""
    }
    set c [chan create {r w} foo]
} -body {
    notes [inthread $c {
	note [read $c 2]
	note [eof $c]
	close $c
	notes
    } c]
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {{read rc* 4096} {} 1} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	error EAGAIN
    }
    set c [chan create {r w} foo]
} -body {
    notes [inthread $c {
	note [read $c 2]
	note [eof $c]
	close $c
	notes
    } c]
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {{read rc* 4096} {} 0} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}

# --- === *** ###########################
# method write

test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	set     written [string length [lindex $args 2]]
	note   $written
	return $written
    }
    set c [chan create {r w} foo]
    inthread $c {
	puts -nonewline $c snarf; flush $c
	close $c
    } c
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{write rc* snarf} 5}
} -constraints {testchannel testthread} -result {{write rc* snarf} 5}
test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	set     written [string length [lindex $args 2]]
	if {$written > 10} {set written [expr {$written / 2}]}
	note   $written
	return $written
    }
    set c [chan create {r w} foo]
    inthread $c {
	puts -nonewline $c snarfsnarfsnarf; flush $c
	close $c
    } c
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
test iocmd.tf-24.3 {chan write, failed write} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note -1; return -1}
    set c [chan create {r w} foo]
    inthread $c {
	puts -nonewline $c snarfsnarfsnarf; flush $c
	close $c
    } c
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} -1}
} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} -1}
test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for writing}}
} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for writing}}
test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return 10000}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}}
} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
test iocmd.tf-24.6 {chan write, zero writes} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return 0}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}}
} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}}
test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; error BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return BANG}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
	note $msg
	noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	return 3
    }
    set c [chan create {r w} foo]
} -body {
    notes [inthread $c {
	note [puts -nonewline $c ABC ; flush $c]
	close $c
	notes
    } c]
    set res
} -cleanup {
    rename foo {}
    unset res
} -result {{write rc* ABC} {}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	# Note: The EAGAIN signals that the channel cannot accept
	# write requests right now, this in turn causes the IO core to
	# request the generation of writable events (see expected
	# result below, and compare to case 24.14 above).
	error EAGAIN
    }
    set c [chan create {r w} foo]
} -body {
    notes [inthread $c {
	note [puts -nonewline $c ABC ; flush $c]
	close $c
	notes
    } c]
    set res
} -cleanup {
    proc foo {args} {onfinal; set ::done-24.15 1; return 3}
    after 1000 {set ::done-24.15 2}
    vwait done-24.15
    rename foo {}
    unset res
} -result {{write rc* ABC} {watch rc* write} {}} \
    -constraints {testchannel thread}

test iocmd.tf-24.16 {chan write, note the background flush setup by close due to the EAGAIN leaving data in buffers.} -match glob -setup {
    set res {}
    proc foo {args} {
	oninit; onfinal; track
	# Note: The EAGAIN signals that the channel cannot accept
	# write requests right now, this in turn causes the IO core to
	# request the generation of writable events (see expected
	# result below, and compare to case 24.14 above).
	error EAGAIN
    }
    set c [chan create {r w} foo]
} -body {
    notes [inthread $c {
	note [puts -nonewline $c ABC ; flush $c]
	close $c
	notes
    } c]
    # Replace handler with all-tracking one which doesn't error.
    # This will tell us if a write-due-flush is there.
    proc foo {args} { onfinal; note BG ; track ; set ::endbody-24.16 1}
    # Flush (sic!) the event-queue to capture the write from a
    # BG-flush.
    after 1000 {set ::endbody-24.16 2}
    vwait endbody-24.16
    set res
} -cleanup {
    proc foo {args} {onfinal; set ::done-24.16 1; return 3}
    after 1000 {set ::done-24.16 2}
    vwait done-24.16
    rename foo {}
    unset res
} -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \
    -constraints {testchannel thread}

test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
    -constraints {testchannel thread} -setup {
    -constraints {testchannel testthread}
    # This test exposes how the execution of postevent in the handler thread causes
    # a crash if we are not properly injecting the events into the owning thread instead.
    # With the injection the test will simply complete without crash.

    set beat 10000
    set drive 999
    set data ...---...

    proc LOG {text} {
	#puts stderr "[thread::id]: $text"
	return
    }

    proc POST {hi} {
	LOG "-> [info level 0]"
	chan postevent $hi read
	LOG "<- [info level 0]"

	set ::timer [after $::drive [info level 0]]
	return
    }

    proc HANDLER {op ch args} {
	lappend ::res [lrange [info level 0] 1 end]
	LOG "-> [info level 0]"
	set ret {}
	switch -glob -- $op {
	    init* {set ret {initialize finalize watch read}}
	    watch {
		set l [lindex $args 0]
		catch {after cancel $::timer}
		if {[llength $l]} {
		    set ::timer [after $::drive [list POST $ch]]
		}
	    }
	    finalize {
		catch { after cancel $::timer }
		after 500 {set ::forever now}
	    }
	    read {
		set ret $::data
		set ::data {} ; # Next is EOF.
	    }
	}
	LOG "<- [info level 0] : $ret"
	return $ret
    }
} -body {
    LOG BEGIN
    set ch [chan create {read} HANDLER]

    set tid [thread::create {
	proc LOG {text} {
	    #puts stderr "\t\t\t\t\t\t[thread::id]: $text"
	    return
	}
	LOG THREAD-STARTED
	load {} Tcltest
	proc bgerror s {
	    LOG BGERROR:$s
	}
	vwait forever
	LOG THREAD-DONE
    }]

    testchannel cut $ch
    thread::send $tid [list set thech $ch]
    thread::send $tid [list set beat $beat]
    thread::send -async $tid {
	LOG SPLICE-BEG
	testchannel splice $thech
	LOG SPLICE-END
	proc PROCESS {ch} {
	    LOG "-> [info level 0]"
	    if {[eof $ch]} {
		close $ch
		set ::done 1
		set c <<EOF>>
	    } else {
		set c [read $ch 1]
	    }
	    LOG "GOTCHAR: $c"
	    LOG "<- [info level 0]"
	}
	LOG THREAD-FILEEVENT
	fconfigure $thech -translation binary -blocking 0
	fileevent  $thech readable [list PROCESS $thech]
	LOG THREAD-NOEVENT-LOOP
	set done 0
	while {!$done} {
	    after $beat
	    LOG THREAD-HEARTBEAT
	    update
	}
	LOG THREAD-LOOP-DONE
	#thread::exit
	# Thread exits cause leaks;  Use clean thread shutdown
	set forever yourGirl
    }

    LOG MAIN_WAITING
    vwait forever
    LOG MAIN_DONE

    set res
} -cleanup {
    after cancel $::timer
    rename LOG {}
    rename POST {}
    rename HANDLER {}
    unset beat drive data forever res tid ch timer
} -match glob \
    -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}}

# --- === *** ###########################
# method cgetall

test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
} -constraints {testchannel testthread} \
    -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
    set res {}
    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
} -constraints {testchannel testthread} \
    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar foo -snarf x"
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
} -constraints {testchannel testthread} \
    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "-bar"
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return "\{"
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{cgetall rc*} 1 {unmatched open brace in list}}
} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {unmatched open brace in list}}
test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{cgetall rc*} 1 BOOM!}
} -constraints {testchannel testthread} -result {{cgetall rc*} 1 BOOM!}
test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code break BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cgetall rc*} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code continue BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cgetall rc*} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code 777 BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cgetall rc*} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -level 55 -code 777 BANG
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c} msg opt]
	note $msg
	noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}

# --- === *** ###########################
# method configure

test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -translation lf]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{}}
} -constraints {testchannel testthread} -result {{}}
test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo bar} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} 1 BOOM!}
} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} 1 BOOM!}
test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body {
    set res {}
    proc foo {args} {oninit configure; onfinal; track; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -rc-foo bar]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} {}}
} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} {}}
test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code break BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo bar} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code continue BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo bar} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -code 444 BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo bar} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body {
    set res {}
    proc foo {args} {
	oninit configure; onfinal; track
	return -level 55 -code 444 BANG
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo bar} msg opt]
	note $msg
	noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}

# --- === *** ###########################
# method cget

test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body {
    set res {}
    proc foo {args} {oninit cget cgetall; onfinal; track; return foo}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -rc-foo]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{cget rc* -rc-foo} foo}
} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} foo}
test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{cget rc* -rc-foo} 1 BOOM!}
} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} 1 BOOM!}
test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code error BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cget rc* -rc-foo} 1 BOOM!} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code continue BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cget rc* -rc-foo} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -code 333 BOOM!
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cget rc* -rc-foo} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body {
    set res {}
    proc foo {args} {
	oninit cget cgetall; onfinal; track
	return -level 77 -code 333 BANG
    }
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -rc-foo} msg opt]
	note $msg
	noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}

# --- === *** ###########################
# method seek

test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [tell $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {-1} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.2 {chan tell, error return} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {tell $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 1 BOOM!} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {tell $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {tell $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {tell $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {tell $c} msg opt]
	note $msg
	noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.7 {chan tell, regular return} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return 88}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [tell $c]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 88} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.8 {chan tell, negative return} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -1}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {tell $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.9 {chan tell, string return} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {tell $c} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {1 {error during seek on "rc*": invalid argument}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.11 {chan seek, error return} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 start} 1 BOOM!} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 start} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 start} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 start} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg opt]
	note $msg
	noteOpts $opt
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return -45}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {seek $c 0 start} msg]
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-28.18 {chan seek, ok result} -match glob -body {
    set res {}
    proc foo {args} {oninit seek; onfinal; track; return 23}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [seek $c 0 current]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{seek rc* 0 current} {}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
foreach {testname code} {
    iocmd.tf-28.19.0 start
    iocmd.tf-28.19.1 current
    iocmd.tf-28.19.2 end
} {
    test $testname "chan seek, base conversion, $code" -match glob -body {
	set res {}
	proc foo {args} {oninit seek; onfinal; track; return 0}
	set c [chan create {r w} foo]
	notes [inthread $c {
	    note [seek $c 0 $code]
	    close $c
	    notes
	} c code]
	rename foo {}
	set res
    } -result [list [list seek rc* 0 $code] {}] \
	-constraints {testchannel thread}
	-constraints {testchannel testthread}
}

# --- === *** ###########################
# method blocking

test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -blocking]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {1} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -blocking 0]
	note [fconfigure $c -blocking]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{} 0} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -blocking]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {1} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -blocking 0]
	note [fconfigure $c -blocking]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 0} {} 0} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fconfigure $c -blocking 1]
	note [fconfigure $c -blocking]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 1} {} 1} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.6 {chan blocking, error return} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -blocking 0} msg]
	note $msg
	# Catch the close. It changes blocking mode internally, and runs into the error result.
	catch {close $c}
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 0} 1 BOOM!} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -blocking 0} msg]
	note $msg
	catch {close $c}
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 0} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -blocking 0} msg]
	note $msg
	catch {close $c}
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 0} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -blocking 0} msg]
	note $msg
	catch {close $c}
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 0} 1 *bad code*} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -blocking 0} msg opt]
	note $msg
	noteOpts $opt
	catch {close $c}
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}
test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
    set res {}
    proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [catch {fconfigure $c -blocking 0} msg]
	note $msg
	catch {close $c}
	notes
    } c]
    rename foo {}
    set res
} -result {{blocking rc* 0} 0 {}} \
    -constraints {testchannel thread}
    -constraints {testchannel testthread}

# --- === *** ###########################
# method watch

test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return IGNORED}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fileevent $c readable {set tick $tick}]
	close $c		;# 2nd watch, interest zero.
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{watch rc* read} {watch rc* {}} {}}
} -constraints {testchannel testthread} -result {{watch rc* read} {watch rc* {}} {}}
test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fileevent $c writable {set tick $tick}]
	note [fileevent $c writable {}]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} -result {{watch rc* write} {watch rc* {}} {} {}}
} -constraints {testchannel testthread} -result {{watch rc* write} {watch rc* {}} {} {}}
test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fileevent $c writable {set tick $tick}]
	note [fileevent $c readable {set tick $tick}]
	note [fileevent $c writable {}]
	note [fileevent $c readable {}]
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
} -constraints {testchannel testthread} \
    -result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}}
test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	note [fileevent $c writable {set tick $tick}]
	note [fileevent $c readable {set tick $tick}] ;# Script is changing,
	note [fileevent $c readable {set tock $tock}] ;# interest does not.
	close $c	;# 3rd and 4th watch, removing the event handlers.
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
} -constraints {testchannel testthread} \
    -result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}}

# --- === *** ###########################
# postevent
# Not possible from a thread not containing the command handler.
# Check that this is rejected.

test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
    set res {}
    proc foo {args} {oninit; onfinal; track; return}
    set c [chan create {r w} foo]
    notes [inthread $c {
	catch {chan postevent $c r} msg
	note $msg
	close $c
	notes
    } c]
    rename foo {}
    set res
} -constraints {testchannel thread} \
} -constraints {testchannel testthread} \
    -result {{can not find reflected channel named "rc*"}}

# --- === *** ###########################
# 'Pull the rug' tests. Create channel in a thread A, move to other
# thread B, destroy the origin thread (A) before or during access from
# B. Must not crash, must return proper errors.

test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {

    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];#puts <<$tida>>
    set tida [testthread create];#puts <<$tida>>
    thread::send $tida {load {} Tcltest}

    set tidb [thread::create -preserved];#puts <<$tidb>>
    set tidb [testthread create];#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}

    # Set up channel in thread
    thread::send $tida $helperscript
    set chan [thread::send $tida {
    testthread send $tida $helperscript
    set chan [testthread send $tida {
	proc foo {args} {oninit seek; onfinal; track; return}
	set chan [chan create {r w} foo]
	fconfigure $chan -buffering none
	set chan
    }]

    # Move channel to 2nd thread.
    thread::send $tida [list testchannel cut $chan]
    thread::send $tidb [list testchannel splice $chan]
    testthread send $tida [list testchannel cut    $chan]
    testthread send $tidb [list testchannel splice $chan]

    # Kill origin thread, then access channel from 2nd thread.
    thread::release $tida
    testthread send -async $tida {testthread exit}
    after 100

    set     res {}
    lappend res [catch {thread::send $tidb [list puts  $chan shoo]} msg] $msg
    lappend res [catch {testthread send $tidb [list puts  $chan shoo]} msg] $msg

    lappend res [catch {thread::send $tidb [list tell  $chan]}      msg] $msg
    lappend res [catch {thread::send $tidb [list seek  $chan 1]}    msg] $msg
    lappend res [catch {thread::send $tidb [list gets  $chan]}      msg] $msg
    lappend res [catch {thread::send $tidb [list close $chan]}      msg] $msg
    thread::release $tidb
    lappend res [catch {testthread send $tidb [list tell  $chan]}      msg] $msg
    lappend res [catch {testthread send $tidb [list seek  $chan 1]}    msg] $msg
    lappend res [catch {testthread send $tidb [list gets  $chan]}      msg] $msg
    lappend res [catch {testthread send $tidb [list close $chan]}      msg] $msg
    tcltest::threadReap
    set res

} -constraints {testchannel thread} \
} -constraints {testchannel testthread} \
    -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}


# The test iocmd.tf-32.1 unavoidably exhibits a memory leak.  We are testing
# the ability of the reflected channel system to react to the situation where
# the thread in which the driver routines runs exits during driver operations.
# In this case, thread exit handlers signal back to the owner thread so that the
# channel operation does not hang.  There's no way to test this without actually
# exiting a thread in mid-operation, and that action is unavoidably leaky (which
# is why [thread::exit] is advised against).
#
# Use constraints to skip this test while valgrinding so this expected leak
# doesn't prevent a finding of "leak-free".
#
test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {

    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];#puts <<$tida>>
    set tida [testthread create];#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    set tidb [thread::create -preserved];#puts <<$tidb>>
    set tidb [testthread create];#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}

    # Set up channel in thread
    thread::send $tida $helperscript
    set chan [thread::send $tida {
    set chan [testthread send $tida $helperscript]
    set chan [testthread send $tida {
	proc foo {args} {
	    oninit; onfinal; track;
	    # destroy thread during channel access
	    thread::exit
	    testthread exit
	    }
	    return}
	set chan [chan create {r w} foo]
	fconfigure $chan -buffering none
	set chan
    }]

    # Move channel to 2nd thread.
    thread::send $tida [list testchannel cut    $chan]
    thread::send $tidb [list testchannel splice $chan]
    testthread send $tida [list testchannel cut    $chan]
    testthread send $tidb [list testchannel splice $chan]

    # Run access from thread B, wait for response from A (A is not
    # using event loop at this point, so the event pile up in the
    # queue.

    thread::send $tidb [list set chan $chan]
    thread::send $tidb [list set mid [thread::id]]
    thread::send -async $tidb {
    testthread send $tidb [list set chan $chan]
    testthread send $tidb [list set mid $tcltest::mainThread]
    testthread send -async $tidb {
	# wait a bit, give the main thread the time to start its event
	# loop to wait for the response from B
	after 2000
	catch { puts $chan shoo } res
	thread::send -async $mid [list set ::res $res]
	testthread send -async $mid [list set ::res $res]
    }
    vwait ::res

    catch {thread::release $tida}
    thread::release $tidb
    tcltest::threadReap
    set res
} -constraints {testchannel thread notValgrind} \
} -constraints {testchannel testthread} \
    -result {Owner lost}

# ### ### ### ######### ######### #########

# ### ### ### ######### ######### #########

rename track {}
# cleanup


# Eliminate valgrind "still reachable" reports on outstanding "Detached"
# structures in the detached list which stem from PipeClose2Proc not waiting
# around for background processes to complete, meaning that previous calls to
# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
after 10
exec [info nameofexecutable] << {}


foreach file [list test1 test2 test3 test4] {
    removeFile $file
}
# delay long enough for background processes to finish
after 500
removeFile test5
cleanupTests
return

Deleted tests/ioTrans.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# -*- tcl -*-
# Functionality covered: operation of the reflected transformation
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2007 Andreas Kupries <andreask@activestate.com>
#                                    <akupries@shaw.ca>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Custom constraints used in this file
testConstraint testchannel [llength [info commands testchannel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]

# testchannel cut|splice  Both needed to test the reflection in threads.
# thread::send

#----------------------------------------------------------------------

# ### ### ### ######### ######### #########
## Testing the reflected transformation.

# Helper commands to record the arguments to handler methods.  Stored in a
# script so that the tests needing this code do not need their own copy but
# can access this variable.

set helperscript {
    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    # This forces the return options to be in the order that the test expects!
    variable optorder {
	-code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
	-errorstack !?!
    }
    proc noteOpts opts {
	variable optorder
	lappend ::res [dict merge $optorder $opts]
    }

    # Helper command, canned result for 'initialize' method.  Gets the
    # optional methods as arguments. Use return features to post the result
    # higher up.

    proc handle.initialize {args} {
	upvar args hargs
	if {[lindex $hargs 0] eq "initialize"} {
	    return -code return [list {*}$args initialize finalize read write]
	}
    }
    proc handle.finalize {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "finalize"} {
	    return -code return ""
	}
    }
    proc handle.read {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "read"} {
	    return -code return "@"
	}
    }
    proc handle.drain {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "drain"} {
	    return -code return "<>"
	}
    }
    proc handle.clear {} {
	upvar args hargs
	if {[lindex $hargs 0] eq "clear"} {
	    return -code return ""
	}
    }

    proc tempchan {{mode r+}} {
	global tempchan
	return [set tempchan [open [makeFile {test data} tempchanfile] $mode]]
    }
    proc tempdone {} {
	global tempchan
	catch {close $tempchan}
	removeFile tempchanfile
	return
    }
    proc tempview {} { viewFile tempchanfile }
}

# Set everything up in the main thread.
eval $helperscript

#puts <<[file channels]>>

# ### ### ### ######### ######### #########

test iortrans-1.0 {chan, wrong#args} -returnCodes error -body {
    chan
} -result {wrong # args: should be "chan subcommand ?arg ...?"}
test iortrans-1.1 {chan, unknown method} -returnCodes error -body {
    chan foo
} -match glob -result {unknown or ambiguous subcommand "foo": must be*}

# --- --- --- --------- --------- ---------
# chan push, and method "initalize"

test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body {
    chan push
} -result {wrong # args: should be "chan push channel cmdprefix"}
test iortrans-2.1 {chan push, wrong#args, too many} -returnCodes error -body {
    chan push a b c
} -result {wrong # args: should be "chan push channel cmdprefix"}
test iortrans-2.2 {chan push, invalid channel} -setup {
    proc foo {} {}
} -returnCodes error -body {
    chan push {} foo
} -cleanup {
    rename foo {}
} -result {can not find channel named ""}
test iortrans-2.3 {chan push, bad handler, not a list} -body {
    chan push [tempchan] "foo \{"
} -returnCodes error -cleanup {
    tempdone
} -result {unmatched open brace in list}
test iortrans-2.4 {chan push, bad handler, not a command} -body {
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
} -result {invalid command name "foo"}
test iortrans-2.5 {chan push, initialize failed, bad signature} -body {
    proc foo {} {}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -result {wrong # args: should be "foo"}
test iortrans-2.6 {chan push, initialize failed, bad signature} -body {
    proc foo {} {}
    chan push [tempchan] ::foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -result {wrong # args: should be "::foo"}
test iortrans-2.7 {chan push, initialize failed, bad result, not a list} -body {
    proc foo {args} {return "\{"}
    catch {chan push [tempchan] foo}
    return $::errorInfo
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {chan handler "foo initialize" returned non-list: *}
test iortrans-2.8 {chan push, initialize failed, bad result, not a list} -body {
    proc foo {args} {return \{\{\}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {chan handler "foo initialize" returned non-list: *}
test iortrans-2.9 {chan push, initialize failed, bad result, empty list} -body {
    proc foo {args} {}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*all required methods*}
test iortrans-2.10 {chan push, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return 1}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*bad method "1": must be *}
test iortrans-2.11 {chan push, initialize failed, bad result, bogus method name} -body {
    proc foo {args} {return {a b c}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*bad method "c": must be *}
test iortrans-2.12 {chan push, initialize failed, bad result, required methods missing} -body {
    # Required: initialize, and finalize.
    proc foo {args} {return {initialize}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*all required methods*}
test iortrans-2.13 {chan push, initialize failed, bad result, illegal method name} -body {
    proc foo {args} {return {initialize finalize BOGUS}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*returned bad method "BOGUS": must be clear, drain, finalize, flush, initialize, limit?, read, or write}
test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body {
    proc foo {args} {return {initialize finalize}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*makes the channel inaccessible}
# iortrans-2.15 event/watch methods elimimated, removed these tests.
# iortrans-2.16
test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body {
    proc foo {args} {return {initialize finalize drain write}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*supports "drain" but not "read"}
test iortrans-2.18 {chan push, initialize failed, bad result, flush/write mismatch} -body {
    proc foo {args} {return {initialize finalize flush read}}
    chan push [tempchan] foo
} -returnCodes error -cleanup {
    tempdone
    rename foo {}
} -match glob -result {*supports "flush" but not "write"}
test iortrans-2.19 {chan push, initialize ok, creates channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	global res
	lappend res $args
	if {[lindex $args 0] ne "initialize"} {return}
	return {initialize finalize drain flush read write}
    }
    lappend res [file channel rt*]
    lappend res [chan push [tempchan] foo]
    lappend res [close [lindex $res end]]
    lappend res [file channel rt*]
} -cleanup {
    tempdone
    rename foo {}
} -result {{} {initialize rt* {read write}} file* {drain rt*} {flush rt*} {finalize rt*} {} {}}
test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	global res
	lappend res $args
	return
    }
    lappend res [file channel rt*]
    lappend res [catch {chan push [tempchan] foo} msg] $msg
    lappend res [file channel rt*]
} -cleanup {
    tempdone
    rename foo {}
} -result {{} {initialize rt* {read write}} 1 {*all required methods*} {}}

# --- --- --- --------- --------- ---------
# method finalize (via close)

# General note: file channels rt* finds the transform channel, however the
# name reported will be that of the underlying base driver, fileXX here.  This
# actually allows us to see if the whole channel is gone, or only the
# transformation, but not the base.

test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return
    }
    lappend res [set c [chan push [tempchan] foo]]
    rename foo {}
    lappend res [file channels file*]
    lappend res [file channels rt*]
    lappend res [catch {close $c} msg] $msg
    lappend res [file channels file*]
    lappend res [file channels rt*]
} -cleanup {
    tempdone
} -result {{initialize rt* {read write}} file* file* {} 1 {invalid command name "foo"} {} {}}
test iortrans-3.2 {chan finalize, for close} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return
    }
    lappend res [set c [chan push [tempchan] foo]]
    close $c
    # Close deleted the channel.
    lappend res [file channels rt*]
    # Channel destruction does not kill handler command!
    lappend res [info command foo]
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
test iortrans-3.3 {chan finalize, for close, error, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code error 5
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
    # Channel is gone despite error.
    lappend res [file channels rt*]
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
test iortrans-3.4 {chan finalize, for close, error, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	error FOO
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg $::errorInfo
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO {FOO
*"close $c"}}
test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return SOMETHING
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
test iortrans-3.6 {chan finalize, for close, break, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 3
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans-3.7 {chan finalize, for close, continue, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 4
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans-3.8 {chan finalize, for close, custom code, close error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg] $msg
} -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans-3.9 {chan finalize, for close, ignore level, close error} -setup {
    set res {}
} -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -level 5 -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [catch {close $c} msg opt] $msg
    noteOpts $opt
} -match glob -cleanup {
    rename foo {}
    tempdone
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}

# --- === *** ###########################
# method read (via read)

test iortrans-4.1 {chan read, transform call and return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return snarf
    }
    set c [chan push [tempchan] foo]
    lappend res [read $c 10]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} snarf}
test iortrans-4.2 {chan read, for non-readable channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
    }
    set c [chan push [tempchan w] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {1 {channel "file*" wasn't opened for reading}}
test iortrans-4.3 {chan read, error return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 BOOM!}
test iortrans-4.4 {chan read, break return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code*}
test iortrans-4.5 {chan read, continue return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code*}
test iortrans-4.6 {chan read, custom return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code*}
test iortrans-4.7 {chan read, level is squashed} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {read $c 2} msg opt] $msg
    noteOpts $opt
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
test iortrans-4.8 {chan read, read, bug 2921116} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [read $c]
    #lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {}}
test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    chan configure $c -buffersize 2
    lappend res [read $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* te} {read rt* st} {read rt* { d}} {read rt* at} {read rt* {a
}} {}}
test iortrans-4.8.2 {chan read, bug 721ec69271} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
	return x
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    chan configure $c -buffersize 1
    lappend res [read $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* t} {read rt* e} {read rt* s} {read rt* t} {read rt* { }} {read rt* d} {read rt* a} {read rt* t} {read rt* a} {read rt* {
}} {}}
test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
    set res {}
} -match glob -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [gets $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {}}

# Driver for a base channel that emits several short "files"
# with each terminated by a fleeting EOF
    proc driver {cmd args} {
        variable ::tcl::buffer
        variable ::tcl::index
        set chan [lindex $args 0]
        switch -- $cmd {
            initialize {
                set index($chan) 0
                set buffer($chan) .....
                return {initialize finalize watch read}
            }
            finalize {
                if {![info exists index($chan)]} {return}
                unset index($chan) buffer($chan)
		array unset index
		array unset buffer
                return
            }
            watch {}
            read {
                set n [lindex $args 1]
                if {![info exists index($chan)]} {
                    driver initialize $chan
                }
                set new [expr {$index($chan) + $n}]
                set result [string range $buffer($chan) $index($chan) $new-1]
                set index($chan) $new
                if {[string length $result] == 0} {
                    driver finalize $chan
                }
                return $result
            }
        }
    }

# Channel read transform that is just the identity - pass all through
    proc idxform {cmd handle args} {
      switch -- $cmd {
        initialize {
            return {initialize finalize read}
        }
        finalize {
            return
        }
        read {
            lassign $args buffer
            return $buffer
        }
      }
    }

# Test that all EOFs pass through full xform stack.  Proper data boundaries.
# Check robustness against buffer sizes.
test iortrans-4.10 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] idxform]
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.10.1 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] idxform]
    chan configure $chan -buffersize 3
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.10.2 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] idxform]
    chan configure $chan -buffersize 5
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

rename idxform {}

# Channel read transform that delays the data and always returns something
    proc delayxform {cmd handle args} {
      variable store
      switch -- $cmd {
        initialize {
	    set store($handle) {}
            return {initialize finalize read drain}
        }
        finalize {
	    unset store($handle)
            return
        }
        read {
            lassign $args buffer
	    if {$store($handle) eq {}} {
		set reply [string index $buffer 0]
		set store($handle) [string range $buffer 1 end]
	    } else {
		set reply $store($handle)
		set store($handle) $buffer
	    }
            return $reply
        }
	drain {
	    delayxform read $handle {}
	}
      }
    }

# Test that all EOFs pass through full xform stack.  Proper data boundaries.
# Check robustness against buffer sizes.
test iortrans-4.11 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delayxform]
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.11.1 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delayxform]
    chan configure $chan -buffersize 3
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}
test iortrans-4.11.2 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delayxform]
    chan configure $chan -buffersize 5
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

    rename delayxform {}

# Channel read transform that delays the data and may return {}
    proc delay2xform {cmd handle args} {
      variable store
      switch -- $cmd {
        initialize {
	    set store($handle) {}
            return {initialize finalize read drain}
        }
        finalize {
	    unset store($handle)
            return
        }
        read {
            lassign $args buffer
		set reply $store($handle)
		set store($handle) $buffer
            return $reply
        }
	drain {
	    delay2xform read $handle {}
	}
      }
    }

test iortrans-4.12 {[5adbc350683] chan read, handle fleeting EOF} -body {
    set chan [chan push [chan create read driver] delay2xform]
    list [eof $chan] [read $chan] [eof $chan] [read $chan 0] [eof $chan] \
        [read $chan] [eof $chan]
} -cleanup {
    close $chan
} -result {0 ..... 1 {} 0 ..... 1}

    rename delay2xform {}
    rename driver {}


# --- === *** ###########################
# method write (via puts)

test iortrans-5.1 {chan write, regular write} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return transformresult
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarf
    flush $c
    close $c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarf} transformresult}
test iortrans-5.2 {chan write, no write is ok, no change to file} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarfsnarfsnarf
    flush $c
    close $c
    lappend res [tempview];	# This has to show the original data, as nothing was written
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} {test data}}
test iortrans-5.3 {chan write, failed write} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error FAIL!
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarfsnarfsnarf
    lappend res [catch {flush $c} msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
test iortrans-5.4 {chan write, non-writable channel} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
	return
    }
    set c [chan push [tempchan r] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    close $c
    tempdone
    rename foo {}
} -result {1 {channel "file*" wasn't opened for writing}}
test iortrans-5.5 {chan write, failed write, error return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans-5.6 {chan write, failed write, error return} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans-5.7 {chan write, failed write, break return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans-5.8 {chan write, failed write, continue return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans-5.9 {chan write, failed write, custom return is error} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg] $msg
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans-5.10 {chan write, failed write, level is ignored} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res [catch {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
    } msg opt] $msg
    noteOpts $opt
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}
test iortrans-5.11 {chan write, bug 2921116} -match glob -setup {
    set res {}
    set level 0
} -body {
    proc foo {fd args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	# pop - invokes flush - invokes 'foo write' - infinite recursion - stop it
	global level
	if {$level} {
	    return
	}
	incr level
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    lappend res [puts -nonewline $c abcdef]
    lappend res [flush $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{} {write rt* abcdef} {write rt* abcdef} {}}

# --- === *** ###########################
# method limit?, drain (via read)

test iortrans-6.1 {chan read, read limits} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize limit?
	handle.finalize
	lappend ::res $args
	handle.read
	return 6
    }
    set c [chan push [tempchan] foo]
    lappend res [read $c 10]
} -cleanup {
    tempdone
    rename foo {}
} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
}} {limit? rt*} @@}
test iortrans-6.2 {chan read, read transform drain on eof} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize drain
	handle.finalize
	lappend ::res $args
	handle.read
	handle.drain
	return
    }
    set c [chan push [tempchan] foo]
    lappend res [read $c]
    lappend res [close $c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {drain rt*} @<> {}}

# --- === *** ###########################
# method clear (via puts, seek)

test iortrans-7.1 {chan write, write clears read buffers} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	handle.clear
	return transformresult
    }
    set c [chan push [tempchan] foo]
    puts -nonewline $c snarf
    flush $c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*} {write rt* snarf}}
test iortrans-7.2 {seek clears read buffers} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    seek $c 2
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}
test iortrans-7.3 {clear, any result is ignored} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return -code error "X"
    }
    set c [chan push [tempchan] foo]
    seek $c 2
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}
test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup {
    set res {}
} -body {
    proc foo {fd args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    seek $c 2
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}

# --- === *** ###########################
# method flush (via seek, close)

test iortrans-8.1 {seek flushes write buffers, ignores data} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	handle.finalize
	lappend ::res $args
	return X
    }
    set c [chan push [tempchan] foo]
    # Flush, no writing
    seek $c 2
    # The close flushes again, this modifies the file!
    lappend res |
    lappend res [close $c] | [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} | {flush rt*} {} | {teXt data}}
test iortrans-8.2 {close flushes write buffers, writes data} -setup {
    set res {}
} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	lappend ::res $args
	handle.finalize
	return .flushed.
    }
    set c [chan push [tempchan] foo]
    close $c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} {finalize rt*} .flushed.}
test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
    set res {}
} -body {
    proc foo {fd args} {
	handle.initialize flush
	handle.finalize
	lappend ::res $args
	# Kill and recreate transform while it is operating
	chan pop $fd
	chan push $fd [list foo $fd]
    }
    set c [chan push [set c [tempchan]] [list foo $c]]
    seek $c 2
    set res
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*}}

# --- === *** ###########################
# method watch - removed from TIP (rev 1.12+)

# --- === *** ###########################
# method event - removed from TIP (rev 1.12+)

# --- === *** ###########################
# 'Pull the rug' tests. Create channel in a interpreter A, move to other
# interpreter B, destroy the origin interpreter (A) before or during access
# from B. Must not crash, must return proper errors.
test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
    set ida [interp create];	#puts <<$ida>>
    set idb [interp create];	#puts <<$idb>>
    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
    # Set up channel and transform in interpreter
    interp eval $ida $helperscript
    interp eval $ida [list ::variable tempchan [tempchan]]
    interp transfer {} $::tempchan $ida
    set chan [interp eval $ida {
	variable tempchan
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    return
	}
	set chan [chan push $tempchan foo]
	fconfigure $chan -buffering none
	set chan
    }]
    # Move channel to 2nd interpreter, transform goes with it.
    interp eval $ida [list testchannel cut $chan]
    interp eval $idb [list testchannel splice $chan]
    # Kill origin interpreter, then access channel from 2nd interpreter.
    interp delete $ida
    set res {}
    lappend res \
	[catch {interp eval $idb [list puts $chan shoo]} msg] $msg \
	[catch {interp eval $idb [list tell $chan]} msg] $msg \
	[catch {interp eval $idb [list seek $chan 1]} msg] $msg \
	[catch {interp eval $idb [list gets $chan]} msg] $msg \
	[catch {interp eval $idb [list close $chan]} msg] $msg
    #lappend res [interp eval $ida {set res}]
    # actions: clear|write|clear|write|clear|flush|limit?|drain|flush
    # The 'tell' is ok, as it passed through the transform to the base channel
    # without invoking the transform handler.
} -cleanup {
    tempdone
    interp delete $idb
} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup {
    set ida [interp create];	#puts <<$ida>>
    set idb [interp create];	#puts <<$idb>>
    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
} -constraints {testchannel} -match glob -body {
    # Set up channel in thread
    set chan [interp eval $ida $helperscript]
    interp eval $ida [list ::variable tempchan [tempchan]]
    interp transfer {} $::tempchan $ida
    set chan [interp eval $ida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    # Destroy interpreter during channel access.
	    suicide
	}
	set chan [chan push $tempchan foo]
	fconfigure $chan -buffering none
	set chan
    }]
    interp alias $ida suicide {} interp delete $ida
    # Move channel to 2nd thread, transform goes with it.
    interp eval $ida [list testchannel cut $chan]
    interp eval $idb [list testchannel splice $chan]
    # Run access from interpreter B, this will give us a synchronous response.
    interp eval $idb [list set chan $chan]
    interp eval $idb [list set mid $tcltest::mainThread]
    set res [interp eval $idb {
	# Wait a bit, give the main thread the time to start its event loop to
	# wait for the response from B
	after 50
	catch { puts $chan shoo } res
	set res
    }]
} -cleanup {
    interp delete $idb
    tempdone
} -result {Owner lost}
test iortrans-11.2 {delete interp of reflected transform} -setup {
    interp create child
    # Magic to get the test* commands into the child
    load {} Tcltest child
} -constraints {testchannel} -body {
    # Get base channel into the child
    set c [tempchan]
    testchannel cut $c
    interp eval child [list testchannel splice $c]
    interp eval child [list set c $c]
    child eval {
	proc no-op args {}
	proc driver {c sub args} {
	    return {initialize finalize read write}
	}
	set t [chan push $c [list driver $c]]
	chan event $c readable no-op
    }
    interp delete child
} -cleanup {
    tempdone
} -result {}

# ### ### ### ######### ######### #########
## Same tests as above, but exercising the code forwarding and receiving
## driver operations to the originator thread.

# ### ### ### ######### ######### #########
## Testing the reflected channel (Thread forwarding).
#
## The id numbers refer to the original test without thread forwarding, and
## gaps due to tests not applicable to forwarding are left to keep this
## association.

# ### ### ### ######### ######### #########
## Helper command. Runs a script in a separate thread and returns the result.
## A channel is transfered into the thread as well, and a list of configuation
## variables

proc inthread {chan script args} {
    # Test thread.
    set tid [thread::create -preserved]
    thread::send $tid {load {} Tcltest}

    # Init thread configuration.
    # - Listed variables
    # - Id of main thread
    # - A number of helper commands

    foreach v $args {
	upvar 1 $v x
	thread::send $tid [list set $v $x]
    }
    thread::send $tid [list set mid [thread::id]]
    thread::send $tid {
	proc notes {} {
	    return $::notes
	}
	proc noteOpts opts {
	    lappend ::notes [dict merge {
		-code !?! -level !?! -errorcode !?! -errorline !?!
		-errorinfo !?! -errorstack !?!
	    } $opts]
	}
    }
    thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)

    # Transfer channel (cut/splice aka detach/attach)

    testchannel cut $chan
    thread::send $tid [list testchannel splice $chan]

    # Run test script, also run local event loop!  The local event loop waits
    # for the result to come back.  It is also necessary for the execution of
    # forwarded channel operations.

    set ::tres ""
    thread::send -async $tid {
	after 50
	catch {s} res;	# This runs the script, 's' was defined at (*)
	thread::send -async $mid [list set ::tres $res]
    }
    vwait ::tres
    # Remove test thread, and return the captured result.

    thread::release $tid
    return $::tres
}

# ### ### ### ######### ######### #########

test iortrans.tf-3.2 {chan finalize, for close} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return {}
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res [inthread $c {
	close $c
	# Close the deleted the channel.
	file channels rt*
    } c]
    # Channel destruction does not kill handler command!
    lappend res [info command foo]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
test iortrans.tf-3.3 {chan finalize, for close, error, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code error 5
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	# Channel is gone despite error.
	lappend notes [file channels rt*]
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	error FOO
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -match glob -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO}
test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return SOMETHING
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
test iortrans.tf-3.6 {chan finalize, for close, break, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 3
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 4
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg] $msg
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	lappend ::res $args
	handle.initialize
	return -level 5 -code 777 BANG
    }
    lappend res [set c [chan push [tempchan] foo]]
    lappend res {*}[inthread $c {
	lappend notes [catch {close $c} msg opt] $msg
	noteOpts $opt
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}

# --- === *** ###########################
# method read

test iortrans.tf-4.1 {chan read, transform call and return} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return snarf
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [read $c 10]
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} snarf}
test iortrans.tf-4.2 {chan read, for non-readable channel} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
    }
    set c [chan push [tempchan w] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {[read $c 2]} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {1 {channel "file*" wasn't opened for reading}}
test iortrans.tf-4.3 {chan read, error return} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 BOOM!}
test iortrans.tf-4.4 {chan read, break return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code*}
test iortrans.tf-4.5 {chan read, continue return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code*}
test iortrans.tf-4.6 {chan read, custom return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code*}
test iortrans.tf-4.7 {chan read, level is squashed} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {read $c 2} msg opt] $msg
	noteOpts $opt
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{read rt* {test data
}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}

# --- === *** ###########################
# method write

test iortrans.tf-5.1 {chan write, regular write} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return transformresult
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	puts -nonewline $c snarf
	flush $c
	close $c
    } c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarf} transformresult}
test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	puts -nonewline $c snarfsnarfsnarf
	flush $c
	close $c
    } c
    lappend res [tempview];	# This has to show the original data, as nothing was written
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} {test data}}
test iortrans.tf-5.3 {chan write, failed write} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error FAIL!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	puts -nonewline $c snarfsnarfsnarf
	lappend notes [catch {flush $c} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
test iortrans.tf-5.4 {chan write, non-writable channel} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args MUST_NOT_HAPPEN
	return
    }
    set c [chan push [tempchan r] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {1 {channel "file*" wasn't opened for writing}}
test iortrans.tf-5.5 {chan write, failed write, error return} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans.tf-5.6 {chan write, failed write, error return} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	error BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code break BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans.tf-5.8 {chan write, failed write, continue return is error} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code continue BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans.tf-5.9 {chan write, failed write, custom return is error} -setup {
    set res {}
} -constraints {testchannel thread} -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg] $msg
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -match glob -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
test iortrans.tf-5.10 {chan write, failed write, level is ignored} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize
	handle.finalize
	lappend ::res $args
	return -level 55 -code 777 BOOM!
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [catch {
	    puts -nonewline $c snarfsnarfsnarf
	    flush $c
	} msg opt] $msg
	noteOpts $opt
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}

# --- === *** ###########################
# method limit?, drain (via read)

test iortrans.tf-6.1 {chan read, read limits} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize limit?
	handle.finalize
	lappend ::res $args
	handle.read
	return 6
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [read $c 10]
	close $c
	notes
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
}} {limit? rt*} @@}
test iortrans.tf-6.2 {chan read, read transform drain on eof} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize drain
	handle.finalize
	lappend ::res $args
	handle.read
	handle.drain
	return
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	lappend notes [read $c]
	lappend notes [close $c]
    } c]
} -cleanup {
    tempdone
    rename foo {}
} -result {{read rt* {test data
}} {drain rt*} @<> {}}

# --- === *** ###########################
# method clear (via puts, seek)

test iortrans.tf-7.1 {chan write, write clears read buffers} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	handle.clear
	return transformresult
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	puts -nonewline $c snarf
	flush $c
	close $c
    } c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*} {write rt* snarf}}
test iortrans.tf-7.2 {seek clears read buffers} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	seek $c 2
	close $c
    } c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}
test iortrans.tf-7.3 {clear, any result is ignored} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize clear
	handle.finalize
	lappend ::res $args
	return -code error "X"
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	seek $c 2
	close $c
    } c
    return $res
} -cleanup {
    tempdone
    rename foo {}
} -result {{clear rt*}}

# --- === *** ###########################
# method flush (via seek, close)

test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	handle.finalize
	lappend ::res $args
	return X
    }
    set c [chan push [tempchan] foo]
    lappend res {*}[inthread $c {
	# Flush, no writing
	seek $c 2
	# The close flushes again, this modifies the file!
	lappend notes | [close $c] |
	# NOTE: The flush generated by the close is recorded immediately, the
	# other note's here are defered until after the thread is done. This
	# changes the order of the result a bit from the non-threaded case
	# (The first | moves one to the right). This is an artifact of the
	# 'inthread' framework, not of the transformation itself.
	notes
    } c]
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} {flush rt*} | {} | {teXt data}}
test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup {
    set res {}
} -constraints {testchannel thread} -match glob -body {
    proc foo {args} {
	handle.initialize flush
	lappend ::res $args
	handle.finalize
	return .flushed.
    }
    set c [chan push [tempchan] foo]
    inthread $c {
	close $c
    } c
    lappend res [tempview]
} -cleanup {
    tempdone
    rename foo {}
} -result {{flush rt*} {finalize rt*} .flushed.}

# --- === *** ###########################
# method watch - removed from TIP (rev 1.12+)

# --- === *** ###########################
# method event - removed from TIP (rev 1.12+)

# --- === *** ###########################
# 'Pull the rug' tests. Create channel in a thread A, move to other thread B,
# destroy the origin thread (A) before or during access from B. Must not
# crash, must return proper errors.

test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];	#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    set tidb [thread::create -preserved];	#puts <<$tida>>
    thread::send $tidb {load {} Tcltest}
} -constraints {testchannel thread} -match glob -body {
    # Set up channel in thread
    thread::send $tida $helperscript
    thread::send $tidb $helperscript
    set chan [thread::send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    return
	}
	set chan [chan push [tempchan] foo]
	fconfigure $chan -buffering none
	set chan
    }]

    # Move channel to 2nd thread, transform goes with it.
    thread::send $tida [list testchannel cut $chan]
    thread::send $tidb [list testchannel splice $chan]

    # Kill origin thread, then access channel from 2nd thread.
    thread::release -wait $tida

    set res {}
    lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg
    lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg
    lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg
    lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg
    lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg
    # The 'tell' is ok, as it passed through the transform to the base
    # channel without invoking the transform handler.
} -cleanup {
    thread::send $tidb tempdone
    thread::release $tidb
} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}

testConstraint notValgrind [expr {![testConstraint valgrind]}]

test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];	#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    set tidb [thread::create -preserved];	#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}
} -constraints {testchannel thread notValgrind} -match glob -body {
    # Set up channel in thread
    thread::send $tida $helperscript
    thread::send $tidb $helperscript
    set chan [thread::send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write
	    handle.finalize
	    lappend ::res $args
	    # destroy thread during channel access
	    thread::exit
	}
	set chan [chan push [tempchan] foo]
	fconfigure $chan -buffering none
	set chan
    }]

    # Move channel to 2nd thread, transform goes with it.
    thread::send $tida [list testchannel cut $chan]
    thread::send $tidb [list testchannel splice $chan]

    # Run access from thread B, wait for response from A (A is not using event
    # loop at this point, so the event pile up in the queue.
    thread::send $tidb [list set chan $chan]
    thread::send $tidb [list set mid [thread::id]]
    thread::send -async $tidb {
	# Wait a bit, give the main thread the time to start its event loop to
	# wait for the response from B
	after 50
	catch { puts $chan shoo } res
	catch { close $chan }
	thread::send -async $mid [list set ::res $res]
    }
    vwait ::res
    set res
} -cleanup {
    thread::send $tidb tempdone
    thread::release $tidb
} -result {Owner lost}

# ### ### ### ######### ######### #########

cleanupTests
return

Added tests/ioUtil.test.












































































































































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(),
# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# 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.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint testopenfilechannelproc \
	[llength [info commands testopenfilechannelproc]]
testConstraint testaccessproc [llength [info commands testaccessproc]]
testConstraint teststatproc   [llength [info commands teststatproc]]

set unsetScript {
    catch {unset testStat1(size)}
    catch {unset testStat2(size)}
    catch {unset testStat3(size)}
}

test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} {
    catch {file stat testStat1%.fil testStat1} err1
    catch {file stat testStat2%.fil testStat2} err2
    catch {file stat testStat3%.fil testStat3} err3
    list $err1 $err2 $err3
} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}}

test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} {
    catch {teststatproc insert TclpStat} err1
    teststatproc insert TestStatProc1
    teststatproc insert TestStatProc2
    teststatproc insert TestStatProc3
    set err1
} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}

test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} {
    file stat testStat2%.fil testStat2
    file stat testStat1%.fil testStat1
    file stat testStat3%.fil testStat3

    list $testStat2(size) $testStat1(size) $testStat3(size)
} {2345 1234 3456}

eval $unsetScript

test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} {
    catch {teststatproc delete TclpStat} err2
    set err2
} {"TclpStat": could not be deleteed}

test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} {
    # Delete the 2nd procedure and test that it longer exists but that
    #   the others do actually return a result.

    teststatproc delete TestStatProc2
    file stat testStat1%.fil testStat1
    catch {file stat testStat2%.fil testStat2} err3
    file stat testStat3%.fil testStat3

    list $testStat1(size) $err3 $testStat3(size)
} {1234 {could not read "testStat2%.fil": no such file or directory} 3456}

eval $unsetScript

test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} {
    # Next delete the 1st procedure and test that only the 3rd procedure
    #   is the only one that exists.

    teststatproc delete TestStatProc1
    catch {file stat testStat1%.fil testStat1} err4
    catch {file stat testStat2%.fil testStat2} err5
    file stat testStat3%.fil testStat3

    list $err4 $err5 $testStat3(size)
} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456}

eval $unsetScript

test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} {
    # Finally delete the 3rd procedure and check that none of the
    #   procedures exist.

    teststatproc delete TestStatProc3
    catch {file stat testStat1%.fil testStat1} err6
    catch {file stat testStat2%.fil testStat2} err7
    catch {file stat testStat3%.fil testStat3} err8

    list $err6 $err7 $err8
} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}}

eval $unsetScript

test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} {
    # Attempt to delete all the Stat procs. again to ensure they no longer
    #   exist and an error is returned.

    catch {teststatproc delete TestStatProc1} err9
    catch {teststatproc delete TestStatProc2} err10
    catch {teststatproc delete TestStatProc3} err11

    list $err9 $err10 $err11
} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}

eval $unsetScript

test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} {
    catch {file exists testAccess1%.fil} err1
    catch {file exists testAccess2%.fil} err2
    catch {file exists testAccess3%.fil} err3
    list $err1 $err2 $err3
} {0 0 0}

test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} {
    catch {testaccessproc insert TclpAccess} err1
    testaccessproc insert TestAccessProc1
    testaccessproc insert TestAccessProc2
    testaccessproc insert TestAccessProc3
    set err1
} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}

test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} {
    list [file exists testAccess2%.fil] \
	    [file exists testAccess1%.fil] \
	    [file exists testAccess3%.fil]
} {1 1 1}

test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} {
    catch {testaccessproc delete TclpAccess} err2
    set err2
} {"TclpAccess": could not be deleteed}

test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} {
    # Delete the 2nd procedure and test that it longer exists but that
    # the others do actually return a result.

    testaccessproc delete TestAccessProc2
    set res1 [file exists testAccess1%.fil]
    catch {file exists testAccess2%.fil} err3
    set res2 [file exists testAccess3%.fil]

    list $res1 $err3 $res2
} {1 0 1}

test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} {
    # Next delete the 1st procedure and test that only the 3rd procedure
    #   is the only one that exists.

    testaccessproc delete TestAccessProc1
    catch {file exists testAccess1%.fil} err4
    catch {file exists testAccess2%.fil} err5
    set res3 [file exists testAccess3%.fil]

    list $err4 $err5 $res3
} {0 0 1}

test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} {
    # Finally delete the 3rd procedure and check that none of the
    #   procedures exist.

    testaccessproc delete TestAccessProc3
    catch {file exists testAccess1%.fil} err6
    catch {file exists testAccess2%.fil} err7
    catch {file exists testAccess3%.fil} err8

    list $err6 $err7 $err8
} {0 0 0}

test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} {
    # Attempt to delete all the Access procs. again to ensure they no longer
    #   exist and an error is returned.

    catch {testaccessproc delete TestAccessProc1} err9
    catch {testaccessproc delete TestAccessProc2} err10
    catch {testaccessproc delete TestAccessProc3} err11

    list $err9 $err10 $err11
} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}

# Some of the following tests require a writable current directory
set oldpwd [pwd]
cd [temporaryDirectory]

test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} {
    catch {file delete -force {*}[glob *testOpenFileChannel*]}
    catch {file exists testOpenFileChannel1%.fil} err1
    catch {file exists testOpenFileChannel2%.fil} err2
    catch {file exists testOpenFileChannel3%.fil} err3
    catch {file exists __testOpenFileChannel1%__.fil} err4
    catch {file exists __testOpenFileChannel2%__.fil} err5
    catch {file exists __testOpenFileChannel3%__.fil} err6
    list $err1 $err2 $err3 $err4 $err5 $err6
} {0 0 0 0 0 0}

test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} {
    catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
    testopenfilechannelproc insert TestOpenFileChannelProc1
    testopenfilechannelproc insert TestOpenFileChannelProc2
    testopenfilechannelproc insert TestOpenFileChannelProc3
    set err1
} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}

test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} {
    close [open __testOpenFileChannel1%__.fil w]
    close [open __testOpenFileChannel2%__.fil w]
    close [open __testOpenFileChannel3%__.fil w]

    catch {
	close [open testOpenFileChannel1%.fil r]
	close [open testOpenFileChannel2%.fil r]
	close [open testOpenFileChannel3%.fil r]
    } err

    file delete __testOpenFileChannel1%__.fil
    file delete __testOpenFileChannel2%__.fil
    file delete __testOpenFileChannel3%__.fil

    set err
} {}

test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} {
    catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
    set err2
} {"TclpOpenFileChannel": could not be deleteed}

test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} {
    # Delete the 2nd procedure and test that it longer exists but that
    #   the others do actually return a result.

    testopenfilechannelproc delete TestOpenFileChannelProc2

    close [open __testOpenFileChannel1%__.fil w]
    close [open __testOpenFileChannel3%__.fil w]

    catch {
	close [open testOpenFileChannel1%.fil r]
	catch {close [open testOpenFileChannel2%.fil r]} msg1
	close [open testOpenFileChannel3%.fil r]
    } err3

    file delete __testOpenFileChannel1%__.fil
    file delete __testOpenFileChannel3%__.fil

    list $err3 $msg1
} {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}}

test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} {
    # Next delete the 1st procedure and test that only the 3rd procedure
    #   is the only one that exists.

    testopenfilechannelproc delete TestOpenFileChannelProc1

    close [open __testOpenFileChannel3%__.fil w]

    catch {
	catch {close [open testOpenFileChannel1%.fil r]} msg2
	catch {close [open testOpenFileChannel2%.fil r]} msg3
	close [open testOpenFileChannel3%.fil r]
    } err4

    file delete __testOpenFileChannel3%__.fil

    list $err4 $msg2 $msg3
} [list {} \
	{couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
	{couldn't open "testOpenFileChannel2%.fil": no such file or directory}]

test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} {
    # Finally delete the 3rd procedure and check that none of the
    #   procedures exist.

    testopenfilechannelproc delete TestOpenFileChannelProc3
    catch {
	catch {close [open testOpenFileChannel1%.fil r]} msg4
	catch {close [open testOpenFileChannel2%.fil r]} msg5
	catch {close [open testOpenFileChannel3%.fil r]} msg6
    } err5

    list $err5 $msg4 $msg5 $msg6
} [list 1 \
	{couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
	{couldn't open "testOpenFileChannel2%.fil": no such file or directory}\
	{couldn't open "testOpenFileChannel3%.fil": no such file or directory}]

test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} {

    # Attempt to delete all the OpenFileChannel procs. again to ensure they no
    # longer exist and an error is returned.

    catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9
    catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10
    catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11

    list $err9 $err10 $err11
} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}

test ioUtil-4.1 {open ... a+ must not use O_APPEND: Bug 1773127} -setup {
    set f [tcltest::makeFile {} ioutil41.tmp]
    set fid [open $f wb]
    puts -nonewline $fid 123
    close $fid
} -body {
    set fid [open $f ab+]
    puts -nonewline $fid 456
    seek $fid 2
    set d [read $fid 2]
    seek $fid 4
    puts -nonewline $fid x
    close $fid
    set fid [open $f rb]
    append d [read $fid]
    close $fid
    return $d
} -cleanup {
    tcltest::removeFile $f
} -result 341234x6

cd $oldpwd

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/iogt.test.

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
1
2
3
4
5



6
7
8
9
10
11
12



13
14


15



16
17
18
19
20
21
22
23





-
-
-
+
+
+




-
-
-
+
+
-
-
+
-
-
-
+







# -*- tcl -*-
# Commands covered:  transform, and stacking in general
#
# This file contains a collection of tests for Giot
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# 
# Copyright (c) 2000 Ajuba Solutions.
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
if {[catch {package require tcltest 2.1}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2.1 required."
}

    return
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

}
namespace eval ::tcl::test::iogt {
    namespace import ::tcltest::*

testConstraint testchannel [llength [info commands testchannel]]

set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
} dummy]
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
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







-
+



-
+




-
-
+
+



+


-
-
+
+


-
+





+
-
+





+













+
-
+










+

+







+




















+




-
-
-
+
+
+
+

-
-
-
+


-
+
+
+


-
+

-
-
-
+
+
+
+
+
+




-
+

+

+









-
-
+
+
+
+
+
-
-
+
+
+
+


-
+
-
-








+

-
-
-
+
+
+
+
-
-
+
+
+


-
+


-
+






+

+
-
+




-
+
+
+


-
+
+
+







# echo server
#
# arguments, options: port to listen on for connections.
#                     delay till echo of first block
#                     delay between blocks
#                     blocksize ...

set port [lindex $argv 0]
set port   [lindex $argv 0]
set fdelay [lindex $argv 1]
set idelay [lindex $argv 2]
set bsizes [lrange $argv 3 end]
set c 0
set c      0

proc newconn {sock rhost rport} {
    variable fdelay
    variable c
    incr c
    namespace upvar [namespace current] c$c conn
    incr   c
    variable c$c

    #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout

    upvar 0 c$c conn
    set conn(after) {}
    set conn(state) 0
    set conn(size) 0
    set conn(data) ""
    set conn(size)  0
    set conn(data)  ""
    set conn(delay) $fdelay

    fileevent $sock readable [list echoGet $c $sock]
    fileevent  $sock readable [list echoGet $c $sock]
    fconfigure $sock -translation binary -buffering none -blocking 0
}

proc echoGet {c sock} {
    variable fdelay
    variable c$c
    namespace upvar [namespace current] c$c conn
    upvar 0 c$c conn

    if {[eof $sock]} {
	# one-shot echo
	exit
    }

    append conn(data) [read $sock]

    #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout

    if {$conn(after) == {}} {
	set conn(after) [after $conn(delay) [list echoPut $c $sock]]
    }
}

proc echoPut {c sock} {
    variable idelay
    variable fdelay
    variable bsizes
    variable c$c
    namespace upvar [namespace current] c$c conn
    upvar 0 c$c conn

    if {[string length $conn(data)] == 0} {
	#puts stdout "C $c $sock" ; flush stdout
	# auto terminate
	close $sock
	exit
	#set conn(delay) $fdelay
	return
    }


    set conn(delay) $idelay

    set n [lindex $bsizes $conn(size)]

    #puts stdout "P $c $sock $n >>" ; flush stdout

    #puts __________________________________________
    #parray conn
    #puts n=<$n>


    if {[string length $conn(data)] >= $n} {
	puts -nonewline $sock [string range $conn(data) 0 $n]
	set conn(data) [string range $conn(data) [incr n] end]
    }

    incr conn(size)
    if {$conn(size) >= [llength $bsizes]} {
	set conn(size) [expr {[llength $bsizes]-1}]
    }

    set conn(after) [after $conn(delay) [list echoPut $c $sock]]
}

#fileevent stdin readable {exit ;#cut}

# main
socket -server newconn -myaddr 127.0.0.1 $port
vwait forever
} __echo_srv__.tcl]


########################################################################

proc fevent {fdelay idelay blocks script data} {
    # Start and initialize an echo server, prepare data transmission, then
    # hand over to the test script.  This has to start real transmission via
    # 'flush'.  The server is stopped after completion of the test.
    # start and initialize an echo server, prepare data
    # transmission, then hand over to the test script.
    # this has to start real transmission via 'flush'.
    # The server is stopped after completion of the test.

    upvar 1 sock sk

    # Fixed port, not so good. Lets hope for the best, for now.
    # fixed port, not so good. lets hope for the best, for now.
    set port 4000

    exec tclsh __echo_srv__.tcl $port $fdelay $idelay {*}$blocks >@stdout &
    exec tclsh __echo_srv__.tcl \
	    $port $fdelay $idelay {*}$blocks >@stdout &

    after 500

    #puts stdout "> $port"; flush stdout
    #puts stdout "> $port" ; flush stdout

    set sk [socket localhost $port]
    fconfigure $sk -blocking 0 -buffering full \
	-buffersize [expr {10+[llength $data]}]
    set         sk [socket localhost $port]
    fconfigure $sk           \
	    -blocking   0    \
	    -buffering  full \
	    -buffersize [expr {10+[llength $data]}]

    puts -nonewline $sk $data

    # The channel is prepared to go off.

    #puts stdout ">>>>>"; flush stdout
    #puts stdout ">>>>>" ; flush stdout

    uplevel 1 set sock $sk
    set res [uplevel 1 $script]

    catch {close $sk}
    return $res
}

# --------------------------------------------------------------
# utility transformations ...

proc id {op data} {
    switch -- $op {
	create/write - create/read - delete/write - delete/read - clear_read {
	    #ignore
	create/write -
	create/read  -
	delete/write -
	delete/read  -
	clear_read   {;#ignore}
	}
	flush/write - flush/read - write - read {
	flush/write -
	flush/read  -
	write       -
	read        {
	    return $data
	}
	query/maxRead {
	query/maxRead {return -1}
	    return -1
	}
    }
}

proc id_optrail {var op data} {
    variable $var
    upvar 0 $var trail

    lappend trail $op

    switch -- $op {
	create/write - create/read - delete/write - delete/read -
	flush/read - clear/read {
	    #ignore
	create/write	-	create/read	-
	delete/write	-	delete/read	-
	flush/read	-
	clear/read	{ #ignore }
	}
	flush/write - write - read {
	flush/write	-
	write		-
	read		{
	    return $data
	}
	query/maxRead {
	query/maxRead	{
	    return -1
	}
	default {
	default		{
	    lappend trail "error $op"
	    error $op
	}
    }
}


proc id_fulltrail {var op data} {
    variable $var
    namespace upvar [namespace current] $var trail
    upvar 0 $var trail

    #puts stdout ">> $var $op $data" ; flush stdout

    switch -- $op {
	create/write - create/read - delete/write - delete/read - clear_read {
	create/write -	create/read  -
	delete/write -	delete/read  -
	clear_read   {
	    set res *ignored*
	}
	flush/write - flush/read - write - read {
	flush/write -	flush/read  -
	write       -
	read        {
	    set res $data
	}
	query/maxRead {
	    set res -1
	}
    }

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
450


451



452
453

454

455
456


457

458

459

460

461
462

463
464
465
466
467
468
469
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
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
524
525
526

527
528
529
530
531
532
533
534
535
536
537
538
539
540
541







+
-
+


-
-
+
+
+
-
-
+
-
-



-
+














+

+
+
-
+


-
+
+
+


-
+





-
+

















+

+
+
-
+




-
+
+
+




-
+



-
+


-
+

+

+

+












+







+



+









+
-
+



+

+
-
+



+









+






+


+
-
+


-
+






-
+

+



-
+

+








+
-
-
+
+
+
+

+


+
-
+

-


-
+
+
+
+


+
+
+
-
-
-
+
+
+
+
+

+
-
+

-
-
+
+

-
+


+

+


+
-
+

+
-
-
-
+
+
+


+
+
-
+
+
+

-
+

+
-
-
+
+

+
-
+

+

+


+







	    return $data
	}
	query/maxRead {return -1}
    }
}

proc counter {var op data} {
    variable $var
    namespace upvar [namespace current] $var n
    upvar 0 $var n

    switch -- $op {
	create/write - create/read - delete/write - delete/read - clear_read {
	    #ignore
	create/write -	create/read  -
	delete/write -	delete/read  -
	clear_read   {;#ignore}
	}
	flush/write - flush/read {
	flush/write  -	flush/read   {return {}}
	    return {}
	}
	write {
	    return $data
	}
	read {
	read  {
	    if {$n > 0} {
		incr n -[string length $data]
		if {$n < 0} {
		    set n 0
		}
	    }
	    return $data
	}
	query/maxRead {
	    return $n
	}
    }
}


proc counter_audit {var vtrail op data} {
    variable $var
    variable $vtrail
    namespace upvar [namespace current] $var n $vtrail trail
    upvar 0 $var n $vtrail trail

    switch -- $op {
	create/write - create/read - delete/write - delete/read - clear_read {
	create/write -	create/read  -
	delete/write -	delete/read  -
	clear_read   {
	    set res {}
	}
	flush/write - flush/read {
	flush/write  -	flush/read   {
	    set res {}
	}
	write {
	    set res $data
	}
	read {
	read  {
	    if {$n > 0} {
		incr n -[string length $data]
		if {$n < 0} {
		    set n 0
		}
	    }
	    set res $data
	}
	query/maxRead {
	    set res $n
	}
    }

    lappend trail [list counter:$op $data $res]
    return $res
}


proc rblocks {var vtrail n op data} {
    variable $var
    variable $vtrail
    namespace upvar [namespace current] $var buf $vtrail trail
    upvar 0 $var buf $vtrail trail

    set res {}

    switch -- $op {
	create/write - create/read - delete/write - delete/read - clear_read {
	create/write -	create/read  -
	delete/write -	delete/read  -
	clear_read   {
	    set buf {}
	}
	flush/write {
	}
	flush/read {
	flush/read  {
	    set res $buf
	    set buf {}
	}
	write {
	write       {
	    set data
	}
	read {
	read        {
	    append buf $data

	    set b [expr {$n * ([string length $buf] / $n)}]

	    append op " $n [string length $buf] :- $b"

	    set res [string range $buf 0 [incr b -1]]
	    set buf [string range $buf [incr b] end]
	    #return $res
	}
	query/maxRead {
	    set res -1
	}
    }

    lappend trail [list rblock | $op $data $res | $buf]
    return $res
}


# --------------------------------------------------------------
# ... and convenience procedures to stack them

proc identity {-attach channel} {
    testchannel transform $channel -command [namespace code id]
}

proc audit_ops {var -attach channel} {
    testchannel transform $channel -command [namespace code [list id_optrail $var]]
}

proc audit_flow {var -attach channel} {
    testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
}

proc torture {-attach channel} {
    testchannel transform $channel -command [namespace code [list id_torture $channel]]
}

proc stopafter {var n -attach channel} {
    variable $var
    namespace upvar [namespace current] $var vn
    upvar 0 $var vn
    set vn $n
    testchannel transform $channel -command [namespace code [list counter $var]]
}

proc stopafter_audit {var trail n -attach channel} {
    variable $var
    namespace upvar [namespace current] $var vn
    upvar 0 $var vn
    set vn $n
    testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]
}

proc rblocks_t {var trail n -attach channel} {
    testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]
}

# --------------------------------------------------------------
# serialize an array, with keys in sorted order.

proc array_sget {v} {
    upvar $v a

    set res [list]
    foreach n [lsort [array names a]] {
	lappend res $n $a($n)
    }
    set res
}

proc asort {alist} {
    # sort a list of key/value pairs by key, removes duplicates too.

    array set a $alist
    array set  a $alist
    array_sget a
}


########################################################################

test iogt-1.1 {stack/unstack} testchannel {
    set fh [open $path(dummy) r]
    identity -attach $fh
    testchannel unstack $fh
    close $fh
    close   $fh
} {}

test iogt-1.2 {stack/close} testchannel {
    set fh [open $path(dummy) r]
    identity -attach $fh
    close $fh
    close   $fh
} {}

test iogt-1.3 {stack/unstack, configuration, options} testchannel {
    set fh [open $path(dummy) r]
    set ca [asort [fconfigure $fh]]
    identity -attach $fh
    set cb [asort [fconfigure $fh]]
    testchannel unstack $fh
    set cc [asort [fconfigure $fh]]
    close $fh

    # With this system none of the buffering, translation and encoding option
    # may change their values with channels stacked upon each other or not.
    # With this system none of the buffering, translation and
    # encoding option may change their values with channels
    # stacked upon each other or not.

    # cb == ca == cc

    list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
} {1 1 1}

test iogt-1.4 {stack/unstack, configuration} -setup {
test iogt-1.4 {stack/unstack, configuration} testchannel {
    set fh [open $path(dummy) r]
} -constraints testchannel -body {
    set ca [asort [fconfigure $fh]]
    identity -attach $fh
    fconfigure $fh -buffering line -translation cr -encoding shiftjis
    fconfigure $fh \
	    -buffering   line \
	    -translation cr   \
	    -encoding    shiftjis
    testchannel unstack $fh
    set cc [asort [fconfigure $fh]]

    set res [list \
	    [string equal $ca $cc]   \
    list [string equal $ca $cc] [fconfigure $fh -buffering] \
	[fconfigure $fh -translation] [fconfigure $fh -encoding]
} -cleanup {
	    [fconfigure $fh -buffering]  \
	    [fconfigure $fh -translation] \
	    [fconfigure $fh -encoding]    \
	    ]

    close $fh
    set res
} -result {0 line cr shiftjis}
} {0 line cr shiftjis}

test iogt-2.0 {basic I/O going through transform} -setup {
    set fin [open $path(dummy) r]
test iogt-2.0 {basic I/O going through transform} testchannel {
    set fin  [open $path(dummy)    r]
    set fout [open $path(dummyout) w]
} -constraints testchannel -body {

    identity -attach $fin
    identity -attach $fout

    fcopy $fin $fout

    close $fin
    close $fout

    set fin [open $path(dummy) r]
    set fin  [open $path(dummy)    r]
    set fout [open $path(dummyout) r]

    list [string equal [set in [read $fin]] [set out [read $fout]]] \
	[string length $in] [string length $out]
} -cleanup {
    set res     [string equal [set in [read $fin]] [set out [read $fout]]]
    lappend res [string length $in] [string length $out]

    close $fin
    close $fout

    set res
} -result {1 71 71}
} {1 71 71}


test iogt-2.1 {basic I/O, operation trail} {testchannel unix} {
    set fin [open $path(dummy) r]
    set fin  [open $path(dummy)    r]
    set fout [open $path(dummyout) w]

    set ain [list]; set aout [list]
    audit_ops ain -attach $fin
    set ain [list] ; set aout [list]
    audit_ops ain  -attach $fin
    audit_ops aout -attach $fout

    fconfigure $fin -buffersize 10
    fconfigure $fin  -buffersize 10
    fconfigure $fout -buffersize 10

    fcopy $fin $fout

    close $fin
    close $fout

    set res "[join $ain \n]\n--------\n[join $aout \n]"
} {create/read
query/maxRead
read
query/maxRead
read
query/maxRead
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
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







+

-
+

+
-
-
+
+

+
-
+

+

+


+







write
write
write
write
write
flush/write
delete/write}

test iogt-2.2 {basic I/O, data trail} {testchannel unix} {
    set fin [open $path(dummy) r]
    set fin  [open $path(dummy)    r]
    set fout [open $path(dummyout) w]

    set ain [list]; set aout [list]
    audit_flow ain -attach $fin
    set ain [list] ; set aout [list]
    audit_flow ain  -attach $fin
    audit_flow aout -attach $fout

    fconfigure $fin -buffersize 10
    fconfigure $fin  -buffersize 10
    fconfigure $fout -buffersize 10

    fcopy $fin $fout

    close $fin
    close $fout

    set res "[join $ain \n]\n--------\n[join $aout \n]"
} {create/read {} *ignored*
query/maxRead {} -1
read abcdefghij abcdefghij
query/maxRead {} -1
read klmnopqrst klmnopqrst
query/maxRead {} -1
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
617
618
619
620
621
622
623
624
625
626

627
628
629
630
631
632
633

634
635
636
637
638
639
640
641
642
643
644
645
646
647
648







+
+

-
+

+



+
-
+

+

+


+







write {\}\{`~!@#$} {\}\{`~!@#$}
write %^&*()_+-= %^&*()_+-=
write {
} {
}
flush/write {} {}
delete/write {} *ignored*}


test iogt-2.3 {basic I/O, mixed trail} {testchannel unix} {
    set fin [open $path(dummy) r]
    set fin  [open $path(dummy)    r]
    set fout [open $path(dummyout) w]

    set trail [list]
    audit_flow trail -attach $fin
    audit_flow trail -attach $fout

    fconfigure $fin -buffersize 20
    fconfigure $fin  -buffersize 20
    fconfigure $fout -buffersize 10

    fcopy $fin $fout

    close $fin
    close $fout

    join $trail \n
} {create/read {} *ignored*
create/write {} *ignored*
query/maxRead {} -1
read abcdefghijklmnopqrst abcdefghijklmnopqrst
write abcdefghij abcdefghij
write klmnopqrst klmnopqrst
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585
586
587
588
589
656
657
658
659
660
661
662
663
664
665
666
667

668
669
670
671
672
673
674







+




-







write {\}\{`~!@#$} {\}\{`~!@#$}
query/maxRead {} -1
read {%^&*()_+-=
} {%^&*()_+-=
}
query/maxRead {} -1
flush/read {} {}
query/maxRead {} -1
write %^&*()_+-= %^&*()_+-=
write {
} {
}
query/maxRead {} -1
delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}

test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
    set fh [open $path(dummy) r]
    torture -attach $fh
599
600
601
602
603
604
605
606

607
608
609
610
611
612
613
614





615
616
617
618





619


620
621
622

623
624
625
626






627

628
629



630
631

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


686
687


688

689
690
691
692
693
694
695
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

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







-
+
-
-
-
-
-
-
-
-
+
+
+
+
+




+
+
+
+
+
-
+
+



+
-
-
-
-
+
+
+
+
+
+

+
-
-
+
+
+


+

-
+
+

+
+
+

+
-
+

+

+


+

-
-
-
+

+
-
-
+
+


+

-
+
+

-
+
+

+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


-


-
-
+
+



-
-
-
+
+
+
+


-
-
+
+


+
+
-
+







    torture -attach $fh
    puts -nonewline $fh abcdef
    flush $fh
    testchannel unstack $fh
    close   $fh
} {}

test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
    proc DoneCopy {n {err {}}} {
	variable copy 1
    }
} -constraints {testchannel knownBug} -body {
    # This test to check the validity of acquired Tcl_Channel references is not
    # possible because even a backgrounded fcopy will immediately start to
    # copy data, without waiting for the event loop. This is done only in case
    # of an underflow on the read size!. So stacking transforms after the
	{testchannel knownBug} {
    # This test to check the validity of aquired Tcl_Channel references is
    # not possible because even a backgrounded fcopy will immediately start
    # to copy data, without waiting for the event loop. This is done only in
    # case of an underflow on the read size!. So stacking transforms after the
    # fcopy will miss information, or are not used at all.
    #
    # I was able to circumvent this by using the echo.tcl server with a big
    # delay, causing the fcopy to underflow immediately.

    proc DoneCopy {n {err {}}} {
	variable copy ; set copy 1
    }

    set fin [open $path(dummy) r]
    set fin  [open $path(dummy) r]

    fevent 1000 500 {20 20 20 10 1 1} {
	variable copy
	close $fin

	set fout [open dummyout w]
	flush $sock;	# now, or fcopy will error us out
	# But the 1 second delay should be enough to initialize everything
	# else here.
	set          fout [open dummyout w]

	flush $sock ; # now, or fcopy will error us out
	# But the 1 second delay should be enough to
	# initialize everything else here.

	fcopy $sock $fout -command [namespace code DoneCopy]

	# Transform after fcopy got its handles!  They should be still valid
	# for fcopy.
	# transform after fcopy got its handles !
	# They should be still valid for fcopy.

	set trail [list]
	audit_ops trail -attach $fout

	vwait [namespace which -variable copy]
    } [read $fin];	# {}
    } [read $fin] ; # {}

    close $fout

    rename DoneCopy {}

    # Check result of copy.

    set fin [open $path(dummy) r]
    set fin  [open $path(dummy)    r]
    set fout [open $path(dummyout) r]

    set res [string equal [read $fin] [read $fout]]

    close $fin
    close $fout

    list $res $trail
} -cleanup {
    rename DoneCopy {}
} -result {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}


test iogt-4.0 {fileevent readable, after transform} -setup {
    set fin [open $path(dummy) r]
test iogt-4.0 {fileevent readable, after transform} {testchannel knownBug} {
    set fin  [open $path(dummy) r]
    set data [read $fin]
    close $fin

    set trail [list]
    set got [list]
    set got   [list]

    proc Done {args} {
	variable stop 1
	variable stop
	set    stop 1
    }

    proc Get {sock} {
        variable trail
        variable got
        if {[eof $sock]} {
            Done
            lappend trail "xxxxxxxxxxxxx"
            close $sock
            return
        }
        lappend trail "vvvvvvvvvvvvv"
        lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
        lappend trail "============="
        #puts stdout $__ ; flush stdout
        #read $sock
	variable trail
	variable got
	if {[eof $sock]} {
	    Done
	    lappend trail "xxxxxxxxxxxxx"
	    close $sock
	    return
	}
	lappend trail "vvvvvvvvvvvvv"
	lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
	lappend trail "============="
	#puts stdout $__ ; flush stdout
	#read $sock
    }

} -constraints {testchannel knownBug} -body {
    fevent 1000 500 {20 20 20 10 1} {
	variable stop
	audit_flow trail -attach $sock
	rblocks_t rbuf trail 23 -attach $sock
	audit_flow trail   -attach $sock
	rblocks_t  rbuf trail 23 -attach $sock

	fileevent $sock readable [namespace code [list Get $sock]]

	flush $sock;		# Now, or fcopy will error us out
	# But the 1 second delay should be enough to initialize everything
	# else here.
	flush $sock ; # now, or fcopy will error us out
	# But the 1 second delay should be enough to
	# initialize everything else here.

	vwait [namespace which -variable stop]
    } $data
    join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
} -cleanup {


    rename Done {}
    rename Get {}

    join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
} -result {[[]]
} {[[]]
[[abcdefghijklmnopqrstuvw]]
[[xyz0123456789,./?><;'\|]]
[[]]
[[]]
[[":[]\}\{`~!@#$%^&*()]]
[[]]
~~~~~~~~
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
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







-
+

+
-
-
+
+

+

-
+

-
+

+
-
+

+
-
+

+


+

+


+

-
+







	got: {[[]]} {[[abcdefghijklmnopqrstuvw]]} {[[xyz0123456789,./?><;'\|]]} {[[]]} {[[]]} {[[":[]\}\{`~!@#$%^&*()]]} {[[]]}
xxxxxxxxxxxxx
rblock | flush/write {} {} | {}
rblock | delete/write {} {} | {}
rblock | delete/read {} {} | {}
flush/write {} {}
delete/write {} *ignored*
delete/read {} *ignored*};	# catch unescaped quote "
delete/read {} *ignored*}  ; # catch unescaped quote "


test iogt-5.0 {EOF simulation} -setup {
    set fin [open $path(dummy) r]
test iogt-5.0 {EOF simulation} {testchannel knownBug} {
    set fin  [open $path(dummy)    r]
    set fout [open $path(dummyout) w]

    set trail [list]
} -constraints {testchannel knownBug} -result {

    audit_flow trail -attach $fin
    stopafter_audit d trail 20 -attach $fin
    stopafter_audit d trail 20 -attach   $fin
    audit_flow trail -attach $fout

    fconfigure $fin -buffersize 20
    fconfigure $fin  -buffersize 20
    fconfigure $fout -buffersize 10

    fcopy $fin $fout
    fcopy   $fin $fout
    testchannel unstack $fin

    # now copy the rest in the channel
    lappend trail {**after unstack**}

    fcopy $fin $fout

    close $fin
    close $fout

    join $trail \n
} -result {create/read {} *ignored*
} {create/read {} *ignored*
counter:create/read {} {}
create/write {} *ignored*
counter:query/maxRead {} 20
query/maxRead {} -1
read {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
} {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
}
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
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







-
-
+
+
+
-
-
+
+
+


-
+
-
-
-
-
+
+
+




-
+

+

-
+
+

+
-
-
+
+

-
-
-
-
+
+
+
+
+
+
-

+
-
-
+
+
+










+

-
+
+


+


-

+
-
+
-







delete/read {} *ignored*
flush/write {} {}
delete/write {} *ignored*}

proc constX {op data} {
    # replace anything coming in with a same-length string of x'es.
    switch -- $op {
	create/write - create/read - delete/write - delete/read - clear_read {
	    #ignore
	create/write -	create/read  -
	delete/write -	delete/read  -
	clear_read   {;#ignore}
	}
	flush/write - flush/read - write - read {
	flush/write -	flush/read  -
	write       -
	read        {
	    return [string repeat x [string length $data]]
	}
	query/maxRead {
	query/maxRead {return -1}
	    return -1
	}
    }
}
    }
}

proc constx {-attach channel} {
    testchannel transform $channel -command [namespace code constX]
}

test iogt-6.0 {Push back} -constraints testchannel -body {
test iogt-6.0 {Push back} testchannel {
    set f [open $path(dummy) r]

    # contents of dummy = "abcdefghi..."
    read $f 3;		# skip behind "abc"
    read $f 3 ; # skip behind "abc"

    constx -attach $f

    # expect to get "xxx" from the transform because of unread "def" input to
    # transform which returns "xxx".
    # expect to get "xxx" from the transform because
    # of unread "def" input to transform which returns "xxx".
    #
    # Actually the IO layer pre-read the whole file and will read "def"
    # directly from the buffer without bothering to consult the newly stacked
    # transformation. This is wrong.
    read $f 3
    # Actually the IO layer pre-read the whole file and will
    # read "def" directly from the buffer without bothering
    # to consult the newly stacked transformation. This is
    # wrong.

    set res [read $f 3]
} -cleanup {
    close $f
    set res
} -result {xxx}
test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body {
} {xxx}

test iogt-6.1 {Push back and up} {testchannel knownBug} {

    # This test demonstrates the bug/misfeature in the stacked
    # channel implementation that data can be discarded if it is
    # read into the buffers of one channel in the stack, and then
    # that channel is popped before anything above it reads.
    #
    # This bug can be worked around by always setting -buffersize
    # to 1, but who wants to do that?

    set f [open $path(dummy) r]

    # contents of dummy = "abcdefghi..."
    read $f 3;		# skip behind "abc"
    read $f 3 ; # skip behind "abc"

    constx -attach $f
    set res [read $f 3]

    testchannel unstack $f
    append res [read $f 3]
} -cleanup {
    close $f
    set res
} -result {xxxghi}
} {xxxghi}


# Driver for a base channel that emits several short "files"
# with each terminated by a fleeting EOF
    proc driver {cmd args} {
        variable buffer
        variable index
        set chan [lindex $args 0]

Changes to tests/join.test.

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
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

















-
-
+
+


-
+















-
+


-
+


-
+




+




-
-
-
-
-



-
-
-
-
# Commands covered:  join
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


test join-1.1 {basic join commands} {
    join {a b c} xyz
} axyzbxyzc
test join-1.2 {basic join commands} {
    join {a b c} {}
} abc
test join-1.3 {basic join commands} {
    join {} xyz
} {}
test join-1.4 {basic join commands} {
    join {12 34 56}
} {12 34 56}

test join-2.1 {join errors} {
    list [catch join msg] $msg $errorCode
} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
} {1 {wrong # args: should be "join list ?joinString?"} NONE}
test join-2.2 {join errors} {
    list [catch {join a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
} {1 {wrong # args: should be "join list ?joinString?"} NONE}
test join-2.3 {join errors} {
    list [catch {join "a \{ c" 111} msg] $msg $errorCode
} {1 {unmatched open brace in list} {TCL VALUE LIST BRACE}}
} {1 {unmatched open brace in list} NONE}

test join-3.1 {joinString is binary ok} {
  string length [join {a b c} a\0b]
} 9

test join-3.2 {join is binary ok} {
  string length [join "a\0b a\0b a\0b"]
} 11

test join-4.1 {shimmer segfault prevention} {
    set l {0 0}
    join $l $l
} {00 00}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/lindex.test.

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
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







-
-
+
+



-
-
-







-
+







# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

set minus -
testConstraint testevalex [llength [info commands testevalex]]

# Tests of Tcl_LindexObjCmd, NOT COMPILED

test lindex-1.1 {wrong # args} testevalex {
    list [catch {testevalex lindex} result] $result
} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
} "1 {wrong # args: should be \"lindex list ?index...?\"}"

# Indices that are lists or convertible to lists

test lindex-2.1 {empty index list} testevalex {
    set x {}
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{a b c} {a b c}}
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
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







-
+


-
-
+
+


-
-
+
+


-
-
+
+


-
+



-
+



-
-
+
+


-
+
-
-
-
-
-
-
-
-
-







test lindex-2.4 {malformed index list} testevalex {
    set x \{
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 bad\ index\ \"\{\":\ must\ be\ integer?\[+-\]integer?\ or\ end?\[+-\]integer?}

# Indices that are integers or convertible to integers

test lindex-3.1 {integer -1} -constraints testevalex -body {
test lindex-3.1 {integer -1} testevalex {
    set x ${minus}1
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {{} {}}
test lindex-3.2 {integer 0} -constraints testevalex -body {
} {{} {}}
test lindex-3.2 {integer 0} testevalex {
    set x [string range 00 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {a a}
test lindex-3.3 {integer 2} -constraints testevalex -body {
} {a a}
test lindex-3.3 {integer 2} testevalex {
    set x [string range 22 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {c c}
test lindex-3.4 {integer 3} -constraints testevalex -body {
} {c c}
test lindex-3.4 {integer 3} testevalex {
    set x [string range 33 0 0]
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} -result {{} {}}
} {{} {}}
test lindex-3.5 {bad octal} -constraints testevalex -body {
    set x 0o8
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-3.6 {bad octal} -constraints testevalex -body {
    set x -0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
test lindex-3.7 {indexes don't shimmer wide ints} -body {
} -match glob -result {1 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} {
    set x [expr {(wide(1)<<31) - 2}]
    list $x [lindex {1 2 3} $x] [incr x] [incr x]
} -result {2147483646 {} 2147483647 2147483648}
} {2147483646 {} 2147483647 2147483648}
test lindex-3.8 {compiled with static indices out of range, negative} -body {
    list [lindex {a b c} -1] [lindex {a b c} -2] [lindex {a b c} -3]
} -result [lrepeat 3 {}]
test lindex-3.9 {compiled with calculated indices out of range, negative constant} -body {
    list [lindex {a b c} -1-1] [lindex {a b c} -2+0] [lindex {a b c} -2+1]
} -result [lrepeat 3 {}]
test lindex-3.10 {compiled with calculated indices out of range, after end} -body {
    list [lindex {a b c} end+1] [lindex {a b c} end+2] [lindex {a b c} end+3]
} -result [lrepeat 3 {}]

# Indices relative to end

test lindex-4.1 {index = end} testevalex {
    set x end
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {c c}
110
111
112
113
114
115
116
117

118
119
120
121

122
123
124
125
126
127
128
98
99
100
101
102
103
104

105
106
107
108

109
110
111
112
113
114
115
116







-
+



-
+







test lindex-4.5 {index = end-3} testevalex {
    set x end-3
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
} {{} {}}
test lindex-4.6 {bad octal} -constraints testevalex -body {
    set x end-0o8
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-4.7 {bad octal} -constraints testevalex -body {
    set x end--0o9
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
    set x end-0a2
    list [catch { testevalex {lindex {a b c} $x} } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lindex-4.9 {obsolete test} testevalex {
    set x end
    list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
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
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







-
+


-
-
+
+


-
-
+
+
-
-


-
-
+
+


-
-
+
+


-
-
+
+


-
-
+
+
-
-


-
+







-
+







test lindex-7.3 {quoted elements} testevalex {
    testevalex {lindex {ab "c d \" x" y} 1}
} {c d " x}
test lindex-7.4 {quoted elements} {
    lindex {a b {c d "e} {f g"}} 2
} {c d "e}

test lindex-8.1 {data reuse} -constraints testevalex -body {
test lindex-8.1 {data reuse} testevalex {
    set x 0
    testevalex {lindex $x $x}
} -result 0
test lindex-8.2 {data reuse} -constraints testevalex -body {
} {0}
test lindex-8.2 {data reuse} testevalex {
    set a 0
    testevalex {lindex $a $a $a}
} -result 0
test lindex-8.3 {data reuse} -constraints {
} 0
test lindex-8.3 {data reuse} testevalex {
    testevalex
} -body {
    set a 1
    testevalex {lindex $a $a $a}
} -result {}
test lindex-8.4 {data reuse} -constraints testevalex -body {
} {}
test lindex-8.4 {data reuse} testevalex {
    set x [list 0 0]
    testevalex {lindex $x $x}
} -result 0
test lindex-8.5 {data reuse} -constraints testevalex -body {
} {0}
test lindex-8.5 {data reuse} testevalex {
    set x 0
    testevalex {lindex $x [list $x $x]}
} -result 0
test lindex-8.6 {data reuse} -constraints testevalex -body {
} {0}
test lindex-8.6 {data reuse} testevalex {
    set x [list 1 1]
    testevalex {lindex $x $x}
} -result {}
test lindex-8.7 {data reuse} -constraints {
} {}
test lindex-8.7 {data reuse} testevalex {
    testevalex
} -body {
    set x 1
    testevalex {lindex $x [list $x $x]}
} -result {}
} {}

#----------------------------------------------------------------------

# Compilation tests for lindex

test lindex-9.1 {wrong # args} {
    list [catch {lindex} result] $result
} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
} "1 {wrong # args: should be \"lindex list ?index...?\"}"
test lindex-9.2 {ensure that compilation works in the right order} {
    proc foo {} {
	rename foo {}
	lindex 1 0
    }
    foo
} 1
270
271
272
273
274
275
276
277

278
279
280
281

282
283
284
285
286
287
288
254
255
256
257
258
259
260

261
262
263
264

265
266
267
268
269
270
271
272







-
+



-
+







	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {{} {}}
test lindex-11.5 {bad octal} -body {
    set x 0o8
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-11.6 {bad octal} -body {
    set x -0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}

# Indices relative to end

test lindex-12.1 {index = end} {
    set x end
    catch {
	list [lindex {a b c} $x] [lindex {a b c} $x]
316
317
318
319
320
321
322
323

324
325
326
327

328
329
330
331
332
333
334
300
301
302
303
304
305
306

307
308
309
310

311
312
313
314
315
316
317
318







-
+



-
+







	list [lindex {a b c} $x] [lindex {a b c} $x]
    } result
    set result
} {{} {}}
test lindex-12.6 {bad octal} -body {
    set x end-0o8
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-12.7 {bad octal} -body {
    set x end--0o9
    list [catch { lindex {a b c} $x } result] $result
} -match glob -result {1 {*}}
} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
    set x end-0a2
    list [catch { lindex {a b c} $x } result] $result
} {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lindex-12.9 {obsolete test} {
    set x end
    catch {
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












450
451

452
453
454



455
456
457
458
459
460
461
462
463
464
465
466
467
468
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
450
451
452
453
454
455







-
+




-
+

-
+





-
-
+
+





-
-
+
+





-
-
+
+





-
-
+
+





-
-
+
+





-
-
+
+





-
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
+
+
-
-
-











} {{}}
test lindex-15.3 {quoted elements} {
    catch {
	lindex {ab "c d \" x" y} 1
    } result
    set result
} {c d " x}
test lindex-15.4 {quoted elements} -body {
test lindex-15.4 {quoted elements} {
    catch {
	lindex {a b {c d "e} {f g"}} 2
    } result
    set result
} -result {c d "e}
} {c d "e}

test lindex-16.1 {data reuse} -body {
test lindex-16.1 {data reuse} {
    set x 0
    catch {
	lindex $x $x
    } result
    set result
} -result {0}
test lindex-16.2 {data reuse} -body {
} {0}
test lindex-16.2 {data reuse} {
    set a 0
    catch {
	lindex $a $a $a
    } result
    set result
} -result 0
test lindex-16.3 {data reuse} -body {
} 0
test lindex-16.3 {data reuse} {
    set a 1
    catch {
	lindex $a $a $a
    } result
    set result
} -result {}
test lindex-16.4 {data reuse} -body {
} {}
test lindex-16.4 {data reuse} {
    set x [list 0 0]
    catch {
	lindex $x $x
    } result
    set result
} -result {0}
test lindex-16.5 {data reuse} -body {
} {0}
test lindex-16.5 {data reuse} {
    set x 0
    catch {
	lindex $x [list $x $x]
    } result
    set result
} -result {0}
test lindex-16.6 {data reuse} -body {
} {0}
test lindex-16.6 {data reuse} {
    set x [list 1 1]
    catch {
	lindex $x $x
    } result
    set result
} -result {}
test lindex-16.7 {data reuse} -body {
} {}
test lindex-16.7 {data reuse} {
    set x 1
    catch {
	lindex $x [list $x $x]
    } result
    set result
} -result {}
} {}

test lindex-17.0 {Bug 1718580} -body {
    lindex {} end foo
} -match glob -result {bad index "foo"*} -returnCodes 1
test lindex-17.1 {Bug 1718580} -body {
    lindex a end foo
test lindex-17.0 {Bug 1718580} {*}{
    -body {
        lindex {} end foo
    } 
    -match glob
    -result {bad index "foo"*}
    -returnCodes 1
}

test lindex-17.1 {Bug 1718580} {*}{
    -body {
        lindex a end foo
} -match glob -result {bad index "foo"*} -returnCodes 1

    } 
test lindex-18.0 {nested bytecode execution} -setup {
    proc demo {i} {lindex {a b c} $i}
} -body {
    -match glob
    -result {bad index "foo"*}
    -returnCodes 1
    demo 0+0x10000000000000000
} -cleanup {
    rename demo {}
}

catch { unset minus }

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/link.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+



-
-
-

-


-
+

-
+









-
-
+
+

-



-
-
+
+

-



-
+

-
+

-

















-
-
+
+

-



-
-
+
+

-



-
-
+
+

-



-
-
+
+

-



-
+







# Commands covered:  none
#
# This file contains a collection of tests for Tcl_LinkVar and related library
# procedures. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for Tcl_LinkVar and related
# library procedures.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testlink [llength [info commands testlink]]
testConstraint testlinkarray [llength [info commands testlinkarray]]

foreach i {int real bool string} {
    unset -nocomplain $i
    catch {unset $i}
}


test link-0.1 {leak test} {testlink} {
    interp create i
    load {} Tcltest i
    i eval {
	testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
	namespace delete ::
    }
    interp delete i
} {}

test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup {

test link-1.1 {reading C variables from Tcl} {testlink} {
    testlink delete
} -body {
    testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list $int $real $bool $string $wide
} -result {43 1.23 1 NULL 12341234}
test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup {
} {43 1.23 1 NULL 12341234}
test link-1.2 {reading C variables from Tcl} {testlink} {
    testlink delete
} -body {
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -3 2 0 "A long string with spaces"  43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    list $int $real $bool $string $wide $int $real $bool $string $wide
} -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}

test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
test link-2.1 {writing C variables from Tcl} {testlink} {
    testlink delete
} -body {
    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    set int "0o0721"
    set real -10.5
    set bool true
    set string abcdef
    set wide 135135
    set char 79
    set uchar 161
    set short 8000
    set ushort 40000
    set uint 0xc001babe
    set long 34543
    set ulong 567890
    set float 1.0987654321
    set uwide 357357357357
    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
test link-2.2 {writing bad values into variables} -setup {
} {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
test link-2.2 {writing bad values into variables} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set int 09a} msg] $msg $int
} -result {1 {can't set "int": variable must have integer value} 43}
test link-2.3 {writing bad values into variables} -setup {
} {1 {can't set "int": variable must have integer value} 43}
test link-2.3 {writing bad values into variables} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set real 1.x3} msg] $msg $real
} -result {1 {can't set "real": variable must have real value} 1.23}
test link-2.4 {writing bad values into variables} -setup {
} {1 {can't set "real": variable must have real value} 1.23}
test link-2.4 {writing bad values into variables} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set bool gorp} msg] $msg $bool
} -result {1 {can't set "bool": variable must have boolean value} 1}
test link-2.5 {writing bad values into variables} -setup {
} {1 {can't set "bool": variable must have boolean value} 1}
test link-2.5 {writing bad values into variables} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {set wide gorp} msg] $msg $bool
} -result {1 {can't set "wide": variable must have wide integer value} 1}
} {1 {can't set "wide": variable must have integer value} 1}
test link-2.6 {writing C variables from Tcl} -constraints {testlink} -setup {
    testlink delete
} -body {
    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    set int "+"
    set real "+"
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

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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
897
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
363
364
365























































































































































































































































































































































































































































































366
367
368

369
370
371
372
373
374












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+

-







-
-
+
+

-







-
+

-
+

-






-
-
+
+

-









-
+

-
+

-

















-
-
+
+

-





-
+

-
+

-
+
-

-
+
-
-
-
+
+

-
+
-
-




+




-
-
+
+
-
-




+






-
-
+
+
-
-




+



-
-
+
+
-
-




+



-
-
+
+
-
-




+



-
-
+
+
-
-




+



-
-
+
+
-
-




+



-
+












-
+













-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+





-
-
-
-
-
    set uint 0
    set long 0
    set ulong 0
    set float -60.00e+
    set uwide 0
    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {0 5000.0 0 0 0 0 0 0 0 0 0 0 -60.0 0 | 0 5000e 0 0 0 0 0 0 0 0 0 0 -60.00e+ 0}
test link-2.10 {writing C variables from Tcl} -constraints {testlink} -setup {
    testlink delete
} -body {
    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    set int "0x"
    set real "0b"
    set bool 0
    set string "0"
    set wide "0D"
    set char "0X"
    set uchar "0B"
    set short "0D"
    set ushort "0x"
    set uint "0b"
    set long "0d"
    set ulong "0X"
    set float "0B"
    set uwide "0D"
    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0D 0X 0B 0D 0x 0b 0d 0X 0B 0D}

test link-3.1 {read-only variables} -constraints {testlink} -setup {
test link-3.1 {read-only variables} {testlink} {
    testlink delete
} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
    list [catch {set int 4} msg] $msg $int \
	[catch {set real 10.6} msg] $msg $real \
	[catch {set bool no} msg] $msg $bool \
	[catch {set string "new value"} msg] $msg $string \
	[catch {set wide 12341234} msg] $msg $wide
} -result {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
test link-3.2 {read-only variables} -constraints {testlink} -setup {
} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
test link-3.2 {read-only variables} {testlink} {
    testlink delete
} -body {
    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0
    list [catch {set int 4} msg] $msg $int \
	[catch {set real 10.6} msg] $msg $real \
	[catch {set bool no} msg] $msg $bool \
	[catch {set string "new value"} msg] $msg $string\
	[catch {set wide 12341234} msg] $msg $wide
} -result {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}

test link-4.1 {unsetting linked variables} -constraints {testlink} -setup {
test link-4.1 {unsetting linked variables} {testlink} {
    testlink delete
} -body {
    testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    unset int real bool string wide
    list [catch {set int} msg] $msg [catch {set real} msg] $msg \
	    [catch {set bool} msg] $msg [catch {set string} msg] $msg \
	    [catch {set wide} msg] $msg
} -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
test link-4.2 {unsetting linked variables} -constraints {testlink} -setup {
} {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
test link-4.2 {unsetting linked variables} {testlink} {
    testlink delete
} -body {
    testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    unset int real bool string wide
    set int 102
    set real 16
    set bool true
    set string newValue
    set wide 333555
    lrange [testlink get] 0 4
} -result {102 16.0 1 newValue 333555}
} {102 16.0 1 newValue 333555}

test link-5.1 {unlinking variables} -constraints {testlink} -setup {
test link-5.1 {unlinking variables} {testlink} {
    testlink delete
} -body {
    testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink delete
    set int xx1
    set real qrst
    set bool bogus
    set string 12345
    set wide 875421
    set char skjdf
    set uchar dslfjk
    set short slkf
    set ushort skrh
    set uint sfdkfkh
    set long srkjh
    set ulong sjkg
    set float dskjfbjfd
    set uwide isdfsngs
    testlink get
} -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
test link-5.2 {unlinking variables} -constraints {testlink} -setup {
} {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
test link-5.2 {unlinking variables} {testlink} {
    testlink delete
} -body {
    testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink delete
    testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
} {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}

test link-6.1 {errors in setting up link} -setup {
test link-6.1 {errors in setting up link} {testlink} {
    testlink delete
    unset -nocomplain int
    catch {unset int}
} -constraints {testlink} -body {
    set int(44) 1
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    list [catch {testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1} msg] $msg
} -cleanup {
    unset -nocomplain int
} -returnCodes error -result {can't set "int": variable is array}
} {1 {can't set "int": variable is array}}
catch {unset int}

test link-7.1 {access to linked variables via upvar} -setup {
test link-7.1 {access to linked variables via upvar} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar int y
	unset y
    }
    testlink delete
    testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
    testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {}
    x
    list [catch {set int} msg] $msg
} -result {0 14}
test link-7.2 {access to linked variables via upvar} -setup {
} {0 14}
test link-7.2 {access to linked variables via upvar} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar int y
	return [set y]
    }
    testlink delete
    testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
    testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {}
    set int
    testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {}
    x
    list [x] $int
} -result {23 23}
test link-7.3 {access to linked variables via upvar} -setup {
} {23 23}
test link-7.3 {access to linked variables via upvar} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar int y
	set y 44
    }
    testlink delete
    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $int
} -result {1 {can't set "y": linked variable is read-only} 11}
test link-7.4 {access to linked variables via upvar} -setup {
} {1 {can't set "y": linked variable is read-only} 11}
test link-7.4 {access to linked variables via upvar} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar int y
	set y abc
    }
    testlink delete
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $int
} -result {1 {can't set "y": variable must have integer value} -4}
test link-7.5 {access to linked variables via upvar} -setup {
} {1 {can't set "y": variable must have integer value} -4}
test link-7.5 {access to linked variables via upvar} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar real y
	set y abc
    }
    testlink delete
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $real
} -result {1 {can't set "y": variable must have real value} 16.75}
test link-7.6 {access to linked variables via upvar} -setup {
} {1 {can't set "y": variable must have real value} 16.75}
test link-7.6 {access to linked variables via upvar} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar bool y
	set y abc
    }
    testlink delete
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $bool
} -result {1 {can't set "y": variable must have boolean value} 1}
test link-7.7 {access to linked variables via upvar} -setup {
} {1 {can't set "y": variable must have boolean value} 1}
test link-7.7 {access to linked variables via upvar} {testlink} {
    testlink delete
} -constraints {testlink} -body {
    proc x {} {
	upvar wide y
	set y abc
    }
    testlink delete
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
    list [catch x msg] $msg $wide
} -result {1 {can't set "y": variable must have wide integer value} 778899}
} {1 {can't set "y": variable must have integer value} 778899}

test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    trace var int w x
    testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace vdelete int w x
    return $x
    set x
} {{int {} w} 32 -2.0 0 xyzzy 995511}
test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
    proc x args {
	global x int real bool string wide
	lappend x $args $int $real $bool $string $wide
    }
    set x {}
    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
    testlink delete
    trace var int w x
    testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
    trace vdelete int w x
    return $x
    set x
} {}
test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
    list [catch {
	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
    } msg] $msg $int
} {0 {} 47}

test link-9.1 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
    testlinkarray
} -result {wrong # args: should be "testlinkarray option args"}
test link-9.2 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
    testlinkarray x
} -result {bad option "x": must be update, remove, or create}
test link-9.3 {linkarray usage messages} -constraints testlinkarray -body {
    testlinkarray update
} -result {}
test link-9.4 {linkarray usage messages} -constraints testlinkarray -body {
    testlinkarray remove
} -result {}
test link-9.5 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
    testlinkarray create
} -result {wrong # args: should be "testlinkarray create ?-readonly? type size name ?address?"}
test link-9.6 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
    testlinkarray create xx 1 my
} -result {bad type "xx": must be char, uchar, short, ushort, int, uint, long, ulong, wide, uwide, float, double, string, char*, or binary}
test link-9.7 {linkarray usage messages} -returnCodes error -constraints testlinkarray -body {
    testlinkarray create char* 0 my
} -result {wrong array size given}

test link-10.1 {linkarray char*} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create char* 1 ::my(var)
    lappend mylist [set ::my(var) ""]
    catch {set ::my(var) x} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{} {can't set "::my(var)": wrong size of char* value}}
test link-10.2 {linkarray char*} -constraints testlinkarray -body {
    testlinkarray create char* 4 ::my(var)
    set ::my(var) x
    catch {set ::my(var) xyzz} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": wrong size of char* value}
test link-10.3 {linkarray char*} -constraints testlinkarray -body {
    testlinkarray create -r char* 4 ::my(var)
    catch {set ::my(var) x} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-11.1 {linkarray char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create char 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1234} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have char value} 120 {can't set "::my(var)": variable must have char value}}
test link-11.2 {linkarray char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create char 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-11.3 {linkarray char} -constraints testlinkarray -body {
    testlinkarray create -r char 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-12.1 {linkarray unsigned char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uchar 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1234} msg
    lappend mylist $msg
    catch {set ::my(var) -1} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have unsigned char value} 120 {can't set "::my(var)": variable must have unsigned char value} {can't set "::my(var)": variable must have unsigned char value}}
test link-12.2 {linkarray unsigned char} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uchar 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-12.3 {linkarray unsigned char} -constraints testlinkarray -body {
    testlinkarray create -r uchar 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-13.1 {linkarray short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create short 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 123456} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have short value} 120 {can't set "::my(var)": variable must have short value}}
test link-13.2 {linkarray short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create short 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-13.3 {linkarray short} -constraints testlinkarray -body {
    testlinkarray create -r short 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-14.1 {linkarray unsigned short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ushort 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 123456} msg
    lappend mylist $msg
    catch {set ::my(var) -1} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have unsigned short value} 120 {can't set "::my(var)": variable must have unsigned short value} {can't set "::my(var)": variable must have unsigned short value}}
test link-14.2 {linkarray unsigned short} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ushort 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-14.3 {linkarray unsigned short} -constraints testlinkarray -body {
    testlinkarray create -r ushort 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-15.1 {linkarray int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create int 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e3} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have integer value} 120 {can't set "::my(var)": variable must have integer value}}
test link-15.2 {linkarray int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create int 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-15.3 {linkarray int} -constraints testlinkarray -body {
    testlinkarray create -r int 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-16.1 {linkarray unsigned int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uint 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
    catch {set ::my(var) -1} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain ::my
} -result {{can't set "::my(var)": variable must have unsigned int value} 120 {can't set "::my(var)": variable must have unsigned int value} {can't set "::my(var)": variable must have unsigned int value}}
test link-16.2 {linkarray unsigned int} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uint 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain ::my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-16.3 {linkarray unsigned int} -constraints testlinkarray -body {
    testlinkarray create -r uint 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-17.1 {linkarray long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create long 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
} -match glob -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have * value} 120 {can't set "::my(var)": variable must have * value}}
test link-17.2 {linkarray long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create long 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-17.3 {linkarray long} -constraints testlinkarray -body {
    testlinkarray create -r long 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-18.1 {linkarray unsigned long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ulong 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
} -match glob -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have unsigned * value} 120 {can't set "::my(var)": variable must have unsigned * value}}
test link-18.2 {linkarray unsigned long} -constraints testlinkarray -body {
    testlinkarray create ulong 1 ::my(var)
    set ::my(var) 120
    catch {set ::my(var) -1} msg
    return $msg
} -match glob -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": variable must have unsigned * value}
test link-18.3 {linkarray unsigned long} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create ulong 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-18.4 {linkarray unsigned long} -constraints testlinkarray -body {
    testlinkarray create -r ulong 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-19.1 {linkarray wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create wide 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have wide integer value} 120 {can't set "::my(var)": variable must have wide integer value}}
test link-19.2 {linkarray wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create wide 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-19.3 {linkarray wide} -constraints testlinkarray -body {
    testlinkarray create -r wide 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-20.1 {linkarray unsigned wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uwide 1 ::my(var)
    catch {set ::my(var) x} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 120]
    catch {set ::my(var) 1e33} msg
    lappend mylist $msg
    lappend mylist [set ::my(var) 0xbabed00dbabed00d]
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": variable must have unsigned wide int value} 120 {can't set "::my(var)": variable must have unsigned wide int value} 0xbabed00dbabed00d}
test link-20.2 {linkarray unsigned wide} -constraints testlinkarray -body {
    testlinkarray create uwide 1 ::my(var)
    set ::my(var) 120
    catch {set ::my(var) -1} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": variable must have unsigned wide int value}
test link-20.3 {linkarray unsigned wide} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create uwide 4 ::my(var)
    catch {set ::my(var) {1 2 3}} msg
    lappend mylist $msg
    set ::my(var) {1 2 3 4}
    lappend mylist $my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong dimension} {1 2 3 4}}
test link-20.4 {linkarray unsigned wide} -constraints testlinkarray -body {
    testlinkarray create -r uwide 2 ::my(var)
    catch {set ::my(var) {1 2}} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-21.1 {linkarray string} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create string 1 ::my(var)
    lappend mylist [set ::my(var) ""]
    lappend mylist [set ::my(var) "xyz"]
    lappend mylist $::my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{} xyz xyz}
test link-21.2 {linkarray string} -constraints testlinkarray -body {
    testlinkarray create -r string 4 ::my(var)
    catch {set ::my(var) x} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

test link-22.1 {linkarray binary} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create binary 1 ::my(var)
    set ::my(var) x
    catch {set ::my(var) xy} msg
    lappend mylist $msg
    lappend mylist $::my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong size of binary value} x}
test link-22.2 {linkarray binary} -constraints testlinkarray -setup {
    set mylist [list]
} -body {
    testlinkarray create binary 4 ::my(var)
    catch {set ::my(var) abc} msg
    lappend mylist $msg
    catch {set ::my(var) abcde} msg
    lappend mylist $msg
    set ::my(var) abcd
    lappend mylist $::my(var)
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {{can't set "::my(var)": wrong size of binary value} {can't set "::my(var)": wrong size of binary value} abcd}
test link-22.3 {linkarray binary} -constraints testlinkarray -body {
    testlinkarray create -r binary 4 ::my(var)
    catch {set ::my(var) xyzv} msg
    return $msg
} -cleanup {
    testlinkarray remove ::my(var)
    unset -nocomplain my
} -result {can't set "::my(var)": linked variable is read-only}

catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
catch {testlink delete}
foreach i {int real bool string wide} {
    unset -nocomplain $i
    catch {unset $i}
}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/linsert.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22













-
-
+
+







# Commands covered:  linsert
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

catch {unset lis}
catch {rename p ""}

test linsert-1.1 {linsert command} {
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
78
79
80
81
82
83
84

85
86
87

88
89
90
91
92
93
94






95
96
97
98
99
100
101







-
+


-
+






-
-
-
-
-
-







} {q r}
test linsert-1.20 {linsert command, use of end-int index} {
    linsert {a b c d} end-2 e f
} {a b e f c d}

test linsert-2.1 {linsert errors} {
    list [catch linsert msg] $msg
} {1 {wrong # args: should be "linsert list index ?element ...?"}}
} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
test linsert-2.2 {linsert errors} {
    list [catch {linsert a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
test linsert-2.3 {linsert errors} {
    list [catch {linsert a 12x 2} msg] $msg
} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
test linsert-2.4 {linsert errors} {
    list [catch {linsert \{ 12 2} msg] $msg
} {1 {unmatched open brace in list}}
test linsert-2.5 {syntax (TIP 323)} {
    linsert {a b c} 0
} [list a b c]
test linsert-2.6 {syntax (TIP 323)} {
    linsert "a\nb\nc" 0
} [list a b c]

test linsert-3.1 {linsert won't modify shared argument objects} {
    proc p {} {
        linsert "a b c" 1 "x y"
        return "a b c"
    }
    p

Changes to tests/list.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22













-
-
+
+







# Commands covered:  list
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# First, a bunch of individual tests

test list-1.1 {basic tests} {list a b c} {a b c}
test list-1.2 {basic tests} {list {a b} c} {{a b} c}
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
40
41
42
43
44
45
46




















47
48
49
50
51
52
53







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







test list-1.20 {basic tests} {list \"\}\{} "\\\"\\}\\{"
test list-1.21 {basic tests} {list a b c\\\nd} "a b c\\\\\\nd"
test list-1.22 {basic tests} {list "{ab}\\"} \\{ab\\}\\\\
test list-1.23 {basic tests} {list \{} "\\{"
test list-1.24 {basic tests} {list} {}
test list-1.25 {basic tests} {list # #} {{#} #}
test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{}
test list-1.27 {basic null treatment} {
    set l [list "" "\0" "\0\0"]
    set e "{} \0 \0\0"
    string equal $l $e
} 1
test list-1.28 {basic null treatment} {
    set result "\0a\0b"
    list $result [string length $result]
} "\0a\0b 4"
test list-1.29 {basic null treatment} {
    set result "\0a\0b"
    set srep "$result 4"
    set lrep [list $result [string length $result]]
    string equal $srep $lrep
} 1
test list-1.30 {basic null treatment} {
    set l [list "\0abc" "xyz"]
    set e "\0abc xyz"
    string equal $l $e
} 1

# For the next round of tests create a list and then pick it apart
# with "index" to make sure that we get back exactly what went in.

set num 0
proc lcheck {testid a b c} {
    global num d

Changes to tests/listObj.test.

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
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













-
-
+
+



-
-
-







# Functionality covered: operation of the procedures in tclListObj.c that
# implement the Tcl type manager for the list object type.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]

catch {unset x}
test listobj-1.1 {Tcl_GetListObjType} emptyTest {
    # Test removed; tested an internal detail
    # that's no longer correct, and duplicated test obj-1.1
} {}

Changes to tests/llength.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22













-
-
+
+







# Commands covered:  llength
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test llength-1.1 {length of list} {
    llength {a b c d}
} 4
test llength-1.2 {length of list} {

Deleted tests/lmap.test.

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
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
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471























































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  lmap, continue, break
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 2011 Trevor Davel
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain a b i x

# ----- Non-compiled operation -----------------------------------------------

# Basic "lmap" operation (non-compiled)
test lmap-1.1 {basic lmap tests} {
    set a {}
    lmap i {a b c d} {
	set a [concat $a $i]
    }
} {a {a b} {a b c} {a b c d}}
test lmap-1.2 {basic lmap tests} {
    lmap i {a b {{c d} e} {123 {{x}}}} {
	set i
    }
} {a b {{c d} e} {123 {{x}}}}
test lmap-1.2a {basic lmap tests} {
    lmap i {a b {{c d} e} {123 {{x}}}} {
	return -level 0 $i
    }
} {a b {{c d} e} {123 {{x}}}}
test lmap-1.4 {basic lmap tests} -returnCodes error -body {
    lmap
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-1.6 {basic lmap tests} -returnCodes error -body {
    lmap i
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-1.8 {basic lmap tests} -returnCodes error -body {
    lmap i j
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-1.10 {basic lmap tests} -returnCodes error -body {
    lmap i j k l
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-1.11 {basic lmap tests} {
    lmap i {} {
	set i
    }
} {}
test lmap-1.12 {basic lmap tests} {
    lmap i {} {
	return -level 0 x
    }
} {}
test lmap-1.13 {lmap errors} -returnCodes error -body {
    lmap {{a}{b}} {1 2 3} {}
} -result {list element in braces followed by "{b}" instead of space}
test lmap-1.14 {lmap errors} -returnCodes error -body {
    lmap a {{1 2}3} {}
} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-1.15 {lmap errors} -setup {
    unset -nocomplain a
} -body {
    set a(0) 44
    list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
} -result {1 {can't set "a": variable is array} {can't set "a": variable is array
    (setting lmap loop variable "a")
    invoked from within
"lmap a {1 2 3} {}"}}
test lmap-1.16 {lmap errors} -returnCodes error -body {
    lmap {} {} {}
} -result {lmap varlist is empty}
unset -nocomplain a

# Parallel "lmap" operation (non-compiled)
test lmap-2.1 {parallel lmap tests} {
    lmap {a b} {1 2 3 4} {
	list $b $a
    }
} {{2 1} {4 3}}
test lmap-2.2 {parallel lmap tests} {
    lmap {a b} {1 2 3 4 5} {
	list $b $a
    }
} {{2 1} {4 3} {{} 5}}
test lmap-2.3 {parallel lmap tests} {
    lmap a {1 2 3} b {4 5 6} {
	list $b $a
    }
} {{4 1} {5 2} {6 3}}
test lmap-2.4 {parallel lmap tests} {
    lmap a {1 2 3} b {4 5 6 7 8} {
	list $b $a
    }
} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
test lmap-2.5 {parallel lmap tests} {
    lmap {a b} {a b A B aa bb} c {c C cc CC} {
	list $a $b $c
    }
} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
test lmap-2.6 {parallel lmap tests} {
    lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
	list $a$b$c$d$e
    }
} {11111 22222 33333}
test lmap-2.7 {parallel lmap tests} {
    lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
	set x $a$b$c$d$e
    }
} {{1111 2} 222 33 4}
test lmap-2.8 {parallel lmap tests} {
    lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
	join [list $a $b $c $d $e] .
    }
} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
test lmap-2.9 {lmap only sets vars if repeating loop} {
    namespace eval ::lmap_test {
	set rgb {65535 0 0}
	lmap {r g b} [set rgb] {}
	set ::x "r=$r, g=$g, b=$b"
    }
    namespace delete ::lmap_test
    set x
} {r=65535, g=0, b=0}
test lmap-2.10 {lmap only supports local scalar variables} -setup {
    unset -nocomplain a
} -body {
    lmap {a(3)} {1 2 3 4} {set {a(3)}}
} -result {1 2 3 4}
unset -nocomplain a

# "lmap" with "continue" and "break" (non-compiled)
test lmap-3.1 {continue tests} {
    lmap i {a b c d} {
	if {[string compare $i "b"] == 0} continue
	set i
    }
} {a c d}
test lmap-3.2 {continue tests} {
    set x 0
    list [lmap i {a b c d} {
    	incr x
    	if {[string compare $i "b"] != 0} continue
    	set i
    }] $x
} {b 4}
test lmap-3.3 {break tests} {
    set x 0
    list [lmap i {a b c d} {
	incr x
    	if {[string compare $i "c"] == 0} break
    	set i
    }] $x
} {{a b} 3}
# Check for bug similar to #406709
test lmap-3.4 {break tests} {
    set a 1
    lmap b b {list [concat a; break]; incr a}
    incr a
} {2}

# ----- Compiled operation ---------------------------------------------------

# Basic "lmap" operation (compiled)
test lmap-4.1 {basic lmap tests} {
    apply {{} {
	set a {}
	lmap i {a b c d} {
	    set a [concat $a $i]
	}
    }}
} {a {a b} {a b c} {a b c d}}
test lmap-4.2 {basic lmap tests} {
    apply {{} {
	lmap i {a b {{c d} e} {123 {{x}}}} {
	    set i
	}
    }}
} {a b {{c d} e} {123 {{x}}}}
test lmap-4.2a {basic lmap tests} {
    apply {{} {
	lmap i {a b {{c d} e} {123 {{x}}}} {
	    return -level 0 $i
	}
    }}
} {a b {{c d} e} {123 {{x}}}}
test lmap-4.4 {basic lmap tests} -returnCodes error -body {
    apply {{} { lmap }}
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-4.6 {basic lmap tests} -returnCodes error -body {
    apply {{} { lmap i }}
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-4.8 {basic lmap tests} -returnCodes error -body {
    apply {{} { lmap i j }}
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-4.10 {basic lmap tests} -returnCodes error -body {
    apply {{} { lmap i j k l }}
} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
test lmap-4.11 {basic lmap tests} {
    apply {{} { lmap i {} { set i } }}
} {}
test lmap-4.12 {basic lmap tests} {
    apply {{} { lmap i {} { return -level 0 x } }}
} {}
test lmap-4.13 {lmap errors} -returnCodes error -body {
    apply {{} { lmap {{a}{b}} {1 2 3} {} }}
} -result {list element in braces followed by "{b}" instead of space}
test lmap-4.14 {lmap errors} -returnCodes error -body {
    apply {{} { lmap a {{1 2}3} {} }}
} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-4.15 {lmap errors} {
    apply {{} {
	set a(0) 44
	list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
    }}
} {1 {can't set "a": variable is array} {can't set "a": variable is array
    while executing
"lmap a {1 2 3} {}"}}
test lmap-4.16 {lmap errors} -returnCodes error -body {
    apply {{} {
	lmap {} {} {}
    }}
} -result {lmap varlist is empty}
unset -nocomplain a

# Parallel "lmap" operation (compiled)
test lmap-5.1 {parallel lmap tests} {
    apply {{} {
	lmap {a b} {1 2 3 4} {
	    list $b $a
	}
    }}
} {{2 1} {4 3}}
test lmap-5.2 {parallel lmap tests} {
    apply {{} {
	lmap {a b} {1 2 3 4 5} {
	    list $b $a
	}
    }}
} {{2 1} {4 3} {{} 5}}
test lmap-5.3 {parallel lmap tests} {
    apply {{} {
	lmap a {1 2 3} b {4 5 6} {
	    list $b $a
	}
    }}
} {{4 1} {5 2} {6 3}}
test lmap-5.4 {parallel lmap tests} {
    apply {{} {
	lmap a {1 2 3} b {4 5 6 7 8} {
	    list $b $a
	}
    }}
} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
test lmap-5.5 {parallel lmap tests} {
    apply {{} {
	lmap {a b} {a b A B aa bb} c {c C cc CC} {
	    list $a $b $c
	}
    }}
} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
test lmap-5.6 {parallel lmap tests} {
    apply {{} {
	lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
	    list $a$b$c$d$e
	}
    }}
} {11111 22222 33333}
test lmap-5.7 {parallel lmap tests} {
    apply {{} {
	lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
	    set x $a$b$c$d$e
	}
    }}
} {{1111 2} 222 33 4}
test lmap-5.8 {parallel lmap tests} {
    apply {{} {
	lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
	    join [list $a $b $c $d $e] .
	}
    }}
} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
test lmap-5.9 {lmap only sets vars if repeating loop} {
    apply {{} {
        set rgb {65535 0 0}
        lmap {r g b} [set rgb] {}
        return "r=$r, g=$g, b=$b"
    }}
} {r=65535, g=0, b=0}
test lmap-5.10 {lmap only supports local scalar variables} {
    apply {{} {
        lmap {a(3)} {1 2 3 4} {set {a(3)}}
    }}
} {1 2 3 4}

# "lmap" with "continue" and "break" (compiled)
test lmap-6.1 {continue tests} {
    apply {{} {
	lmap i {a b c d} {
	    if {[string compare $i "b"] == 0} continue
	    set i
	}
    }}
} {a c d}
test lmap-6.2 {continue tests} {
    apply {{} {
	list [lmap i {a b c d} {
	    incr x
	    if {[string compare $i "b"] != 0} continue
	    set i
	}] $x
    }}
} {b 4}
test lmap-6.3 {break tests} {
    apply {{} {
	list [lmap i {a b c d} {
	    incr x
	    if {[string compare $i "c"] == 0} break
	    set i
	}] $x
    }}
} {{a b} 3}
# Check for bug similar to #406709
test lmap-6.4 {break tests} {
    apply {{} {
	set a 1
	lmap b b {list [concat a; break]; incr a}
	incr a
    }}
} {2}

# ----- Special cases and bugs -----------------------------------------------
test lmap-7.1 {compiled lmap backward jump works correctly} -setup {
    unset -nocomplain x
} -body {
    array set x {0 zero 1 one 2 two 3 three}
    lsort [apply {{arrayName} {
        upvar 1 $arrayName a
        lmap member [array names a] {
            list $member [set a($member)]
        }
    }} x]
} -result [lsort {{0 zero} {1 one} {2 two} {3 three}}]
test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup {
    unset -nocomplain x
} -body {
    lmap {12.0} {a b c} {
        set x 12.0
        set x [expr $x + 1]
    }
} -result {13.0 13.0 13.0}
# Test for incorrect "double evaluation" semantics
test lmap-7.3 {delayed substitution of body} {
    apply {{} {
       set a 0
       lmap a [list 1 2 3] "
           set x $a
       "
       return $x
    }}
} {0}
# Related to "foreach" test for [Bug 1189274]; crash on failure
test lmap-7.4 {empty list handling} {
    proc crash {} {
	rename crash {}
	set a "x y z"
	set b ""
	lmap aa $a bb $b { set x "aa = $aa bb = $bb" }
    }
    crash
} {{aa = x bb = } {aa = y bb = } {aa = z bb = }}
# Related to [Bug 1671138]; infinite loop with empty var list in bytecompiled
# version.
test lmap-7.5 {compiled empty var list} -returnCodes error -body {
    proc foo {} {
	lmap {} x {
	    error "reached body"
	}
    }
    foo
} -cleanup {
    catch {rename foo ""}
} -result {lmap varlist is empty}
test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup {
    proc demo {} {
	set vals {1 2 3 4}
	trace add variable x write {string length $vals ;# }
	lmap {x y} $vals {format $y}
    }
} -body {
    demo
} -cleanup {
    rename demo {}
} -result {2 4}
# Huge lists must not overflow the bytecode interpreter (development bug)
test lmap-7.7 {huge list non-compiled} -setup {
    unset -nocomplain a b x
} -body {
    set x [lmap a [lrepeat 1000000 x] { set b y$a }]
    list $b [llength $x] [string length $x]
} -result {yx 1000000 2999999}
test lmap-7.8 {huge list compiled} -setup {
    unset -nocomplain a b x
} -body {
    set x [apply {{times} {
	global b
	lmap a [lrepeat $times x] { set b Y$a }
    }} 1000000]
    list $b [llength $x] [string length $x]
} -result {Yx 1000000 2999999}
test lmap-7.9 {error then dereference loop var (dev bug)} {
    catch { lmap a 0 b {1 2 3} { error x } }
    set a
} 0
test lmap-7.9a {error then dereference loop var (dev bug)} {
    catch { lmap a 0 b {1 2 3} { incr a $b; error x } }
    set a
} 1

# ----- Coroutines -----------------------------------------------------------
test lmap-8.1 {lmap non-compiled with coroutines} -body {
    coroutine coro apply {{} {
	set values [yield [info coroutine]]
	eval lmap i [list $values] {{ yield $i }}
    }} ;# returns 'coro'
    coro {a b c d e f} ;# -> a
    coro 1 ;# -> b
    coro 2 ;# -> c
    coro 3 ;# -> d
    coro 4 ;# -> e
    coro 5 ;# -> f
    list [coro 6] [info commands coro]
} -cleanup {
    catch {rename coro ""}
} -result {{1 2 3 4 5 6} {}}
test lmap-8.2 {lmap compiled with coroutines} -body {
    coroutine coro apply {{} {
	set values [yield [info coroutine]]
	lmap i $values { yield $i }
    }} ;# returns 'coro'
    coro {a b c d e f} ;# -> a
    coro 1 ;# -> b
    coro 2 ;# -> c
    coro 3 ;# -> d
    coro 4 ;# -> e
    coro 5 ;# -> f
    list [coro 6] [info commands coro]
} -cleanup {
    catch {rename coro ""}
} -result {{1 2 3 4 5 6} {}}

# cleanup
unset -nocomplain a x
catch {rename foo {}}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/load.test.

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
1
2
3
4
5
6
7

8
9
10
11
12


13
14
15
16
17



18
19
20
21
22
23
24







-
+




-
-
+
+



-
-
-







# Commands covered:  load
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Figure out what extension is used for shared libraries on this
# platform.
if {![info exists ext]} {
    set ext [info sharedlibextension]
}
# Tests require the existence of one of the DLLs in the dltest directory.
set testDir [file join [file dirname [info nameofexecutable]] dltest]
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
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







-
+


-
+


-
+




-
+


-
+




-
-
-
-
-
-



-
-
+
+




-
+





-
-
+
+
-
-






-
+







-
-
+
+





-
+









-
+


-
+

-
-
+
+
-
-
-
+





-
+








testConstraint teststaticpkg [llength [info commands teststaticpkg]]

# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest

testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]


test load-1.1 {basic errors} {} {
    list [catch {load} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
test load-1.2 {basic errors} {} {
    list [catch {load a b c d} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
test load-1.3 {basic errors} {} {
    list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} {} {
    list [catch {load -global {}} msg] $msg
    list [catch {load {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {} {
    list [catch {load -lazy {} {}} msg] $msg
    list [catch {load {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {} {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
test load-1.7 {basic errors} {} {
    list [catch {load -abc foo} msg] $msg
} "1 {bad option \"-abc\": must be -global, -lazy, or --}"
test load-1.8 {basic errors} {} {
    list [catch {load -global} msg] $msg
} "1 {couldn't figure out package name for -global}"

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
    load [file join $testDir pkga$ext]
    list [pkga_eq abc def] [info commands pkga_*]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    load -lazy [file join $testDir pkgb$ext] pKgB child
    load [file join $testDir pkgb$ext] Pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
    list [catch {load [file join $testDir pkgc$ext] Foo} msg] $msg
} -match glob -result {1 {*couldn't find procedure Foo_Init}}
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir pkge$ext] pkge} msg] \
    list [catch {load [file join $testDir pkge$ext] Pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, child interpreter} \
"load [file join $testDir pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, slave interpreter} \
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x
    set ::errorCode foo
    set ::errorInfo bar
    set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
    set result [list [catch {load [file join $testDir pkge$ext] Pkge x} msg] \
	    $msg $::errorInfo $::errorCode]
    interp delete x
    set result
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
"load [file join $testDir pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}}

test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
    list [catch {load [file join $testDir pkga$ext] Pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] Pkgb} msg] $msg
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir pkga$ext] pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
} [list 1 "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""]

test load-5.1 {file name not specified and no static package: pick default} \
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x
    load -global [file join $testDir pkga$ext] pkga
    load [file join $testDir pkga$ext] Pkga
    load {} pkga x
    set result [info loaded x]
    interp delete x
    set result
} [list [list [file join $testDir pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
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
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











-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+

















-
+









-
-
-
-
-
-




-
-
-
-
} {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg More 0 1
    load {} More
    set x
} {not loaded}
catch {load [file join $testDir pkga$ext] pkga}
catch {load [file join $testDir pkgb$ext] pkgb}
catch {load [file join $testDir pkge$ext] pkge}
set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
    teststaticpkg Test 1 0
    teststaticpkg Another 0 0
    teststaticpkg More 0 1
} -constraints [list teststaticpkg $dll $loaded] -body {
    teststaticpkg Double 0 1
    teststaticpkg Double 0 1
    info loaded
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
    [list teststaticpkg $dll $loaded] {
	teststaticpkg Double 0 1
	teststaticpkg Double 0 1
	info loaded
    } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]

testConstraint teststaticpkg_8.x \
    [if {[testConstraint teststaticpkg]} {
	teststaticpkg Test 1 1
	teststaticpkg Another 0 1
	teststaticpkg More 0 1
	teststaticpkg Double 0 1
	expr 1
    } else {
	expr 0
    }]

test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded {}]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
    info loaded
} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
test load-8.2 {TclGetLoadedPackages procedure} [list teststaticpkg] {
    list [catch {info loaded gorp} msg] $msg
} {1 {could not find interpreter "gorp"}}
test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
    list [info loaded {}] [info loaded child]
} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded child]
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    load [file join $testDir pkgb$ext] pkgb
    list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
    load [file join $testDir pkgb$ext] Pkgb
    list [info loaded {}] [lsort [info commands pkgb_*]]
} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}]
interp delete child

test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
    -constraints {teststaticpkg} \
    -setup {
	interp create child1
	interp create child2
	load {} Tcltest child1
	load {} Tcltest child2
    } \
    -body {
	child1 eval { teststaticpkg Loadninepointone 0 1 }
	child2 eval { teststaticpkg Loadninepointone 0 1 }
	list \
	    [child1 eval { info loaded {} }] \
	    [child2 eval { info loaded {} }]
    } \
    -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \
    -result {{{{} Loadninepointone} {{} Tcltest}} {{{} Loadninepointone} {{} Tcltest}}} \
    -cleanup { interp delete child1 ; interp delete child2 }

test load-10.1 {load from vfs} \
    -constraints [list $dll $loaded testsimplefilesystem] \
    -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \
    -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \
    -result {0 {}} \
    -cleanup {testsimplefilesystem 0; cd $dir; unset dir}

test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
	[list $dll $loaded] {
    load [file join $testDir pkgooa$ext]
    list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
} {1 pkgooa_stubsok}

# cleanup
unset ext
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/lpop.test.

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

















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  lpop
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

unset -nocomplain no; # following tests expecting var "no" does not exists
test lpop-1.1 {error conditions} -returnCodes error -body {
    lpop no
} -result {can't read "no": no such variable}
test lpop-1.2 {error conditions} -returnCodes error -body {
    lpop no 0
} -result {can't read "no": no such variable}
test lpop-1.3 {error conditions} -returnCodes error -body {
    set l "x {}x"
    lpop l
} -result {list element in braces followed by "x" instead of space}
test lpop-1.4 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l -1
} -result {index "-1" out of range}
test lpop-1.4b {error conditions (also check SF on empty list variable, bug [234d6c811d])} -body {
    set l "x y"
    list [lpop l] [lpop l] [catch {lpop l} v] $v [catch {lpop l 0} v] $v $l
} -result {y x 1 {index "end" out of range} 1 {index "0" out of range} {}}
test lpop-1.5 {error conditions} -returnCodes error -body {
    set l "x y z"
    lpop l 3
} -result {index "3" out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX}
test lpop-1.6 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l end+1
} -result {index "end+1" out of range}
test lpop-1.7 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l {}
} -match glob -result {bad index *}
test lpop-1.8 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l 0 0 0 0 1
} -result {index "1" out of range}
test lpop-1.9 {error conditions} -returnCodes error -body {
    set l "x y"
    lpop l {1 0}
} -match glob -result {bad index *}

test lpop-2.1 {basic functionality} -body {
    set l "x y z"
    list [lpop l 0] $l
} -result {x {y z}}
test lpop-2.2 {basic functionality} -body {
    set l "x y z"
    list [lpop l 1] $l
} -result {y {x z}}
test lpop-2.3 {basic functionality} -body {
    set l "x y z"
    list [lpop l] $l
} -result {z {x y}}
test lpop-2.4 {basic functionality} -body {
    set l "x y z"
    set l2 $l
    list [lpop l] $l $l2
} -result {z {x y} {x y z}}

test lpop-3.1 {nested} -body {
    set l "x y"
    set l2 $l
    list [lpop l 0 0 0 0] $l $l2
} -result {x {{{{}}} y} {x y}}
test lpop-3.2 {nested} -body {
    set l "{x y} {a b}"
    list [lpop l 0 1] $l
} -result {y {x {a b}}}
test lpop-3.3 {nested} -body {
    set l "{x y} {a b}"
    list [lpop l 1 0] $l
} -result {a {{x y} b}}





test lpop-99.1 {performance} -constraints perf -body {
    set l [lrepeat 10000 x]
    set l2 $l
    set t1 [time {
        while {[llength $l] >= 2} {
            lpop l end
        }
    }]
    set l [lrepeat 30000 x]
    set l2 $l
    set t2 [time {
        while {[llength $l] >= 2} {
            lpop l end
        }
    }]
    regexp {\d+} $t1 ms1
    regexp {\d+} $t2 ms2
    set ratio [expr {double($ms2)/$ms1}]
    # Deleting from end should have linear performance
    expr {$ratio > 4 ? $ratio : 4}
} -result {4}

test lpop-99.2 {performance} -constraints perf -body {
    set l [lrepeat 10000 x]
    set l2 $l
    set t1 [time {
        while {[llength $l] >= 2} {
            lpop l 1
        }
    }]
    set l [lrepeat 30000 x]
    set l2 $l
    set t2 [time {
        while {[llength $l] >= 2} {
            lpop l 1
        }
    }]
    regexp {\d+} $t1 ms1
    regexp {\d+} $t2 ms2
    set ratio [expr {double($ms2)/$ms1}]
    expr {$ratio > 10 ? $ratio : 10}
} -result {10}


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/lrange.test.

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
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













-
-
+
+



-
-
-
-
-







# Commands covered:  lrange
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]

test lrange-1.1 {range of list elements} {
    lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {
    lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
} {{bcd e {f g {}}}}
test lrange-1.3 {range of list elements} {
62
63
64
65
66
67
68
69
70
71

72
73
74
75
76
77
78
57
58
59
60
61
62
63

64

65
66
67
68
69
70
71
72







-

-
+







} d
test lrange-1.14 {range of list elements} {
    lrange "a b c d" end 2
} {}
test lrange-1.15 {range of list elements} {
    concat \"[lrange {a b \{\   	} 0 2]"
} {"a b \{\ "}
# emacs highlighting bug workaround --> "
test lrange-1.16 {list element quoting} {
    lrange {[append a .b]} 0 end
    lrange {[append a .b]} 0 end    
} {{[append} a .b\]}

test lrange-2.1 {error conditions} {
    list [catch {lrange a b} msg] $msg
} {1 {wrong # args: should be "lrange list first last"}}
test lrange-2.2 {error conditions} {
    list [catch {lrange a b 6 7} msg] $msg
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
80
81
82
83
84
85
86






























































































































































87
88
89











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
test lrange-2.5 {error conditions} {
    list [catch {lrange "a \{b c" 3 4} msg] $msg
} {1 {unmatched open brace in list}}
test lrange-2.6 {error conditions} {
    list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
} {1 {unmatched open brace in list}}

test lrange-3.1 {Bug 3588366: end-offsets before start} {
    apply {l {
	lrange $l 0 end-5
    }} {1 2 3 4 5}
} {}
test lrange-3.2 {compiled with static indices out of range, negative} {
    list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3]
} [lrepeat 4 {}]
test lrange-3.3 {compiled with calculated indices out of range, negative constant} {
    list [lrange {a b c} 0-1 -1-1] [lrange {a b c} -2+0 0-1] [lrange {a b c} -2-1 -2+1] [lrange {a b c} -2+1 -2-1]
} [lrepeat 4 {}]
test lrange-3.4 {compiled with calculated indices out of range, after end} -body {
    list [lrange {a b c} end+1 end+2] [lrange {a b c} end+2 end+1] [lrange {a b c} end+2 end+3] [lrange {a b c} end+3 end+2]
} -result [lrepeat 4 {}]

test lrange-3.5 {compiled with calculated indices, start out of range (negative)} {
    list [lrange {a b c} -1 1] [lrange {a b c} -1+0 end-1] [lrange {a b c} -2 1] [lrange {a b c} -2+0 0+1]
} [lrepeat 4 {a b}]
test lrange-3.6 {compiled with calculated indices, end out of range (after end)} {
    list [lrange {a b c} 1 end+1] [lrange {a b c} 1+0 2+1] [lrange {a b c} 1 end+1] [lrange {a b c} end-1 3+1]
} [lrepeat 4 {b c}]

test lrange-3.7a {compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
    list [lrange { } 0 1] [lrange [format %c 32] 0 1] [lrange [set a { }] 0 1] \
	 [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} -body {
    set cmd lrange
    list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
	 [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]
# following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep
# (as before the fix [58c46e74b931d3a1]):
test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
    list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \
	 [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} -body {
    set cmd lrange
    list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \
	 [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]
test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints {
    testpurebytesobj
} -body {
    list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \
	 [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1]
} -result [lrepeat 6 {}]
test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} -constraints {
    testpurebytesobj
} -body {
    set cmd lrange
    list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \
	 [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1]
} -result [lrepeat 6 {}]

test lrange-4.1 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # Shared
    set ll2 $ll1
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get new pure object
    set x [lrange $ll1 0 end]
    set rep2 [tcl::unsupported::representation $x]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Check for a new clean object
} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0}

test lrange-4.2 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # Shared
    set ll2 $ll1
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get new pure object, not compiled
    set x [[string cat l range] $ll1 0 end]
    set rep2 [tcl::unsupported::representation $x]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Check for a new clean object
} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0}

test lrange-4.3 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get pure object, unshared
    set ll2 [lrange $ll1[set ll1 {}] 0 end]
    set rep2 [tcl::unsupported::representation $ll2]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Internal optimisations should keep the same object
} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1}

test lrange-4.4 {lrange pure promise} -body {
    set ll1 [list $tcl_version 2 3 4]
    # With string rep
    string length $ll1
    set rep1 [tcl::unsupported::representation $ll1]
    # Get pure object, unshared, not compiled
    set ll2 [[string cat l range] $ll1[set ll1 {}] 0 end]
    set rep2 [tcl::unsupported::representation $ll2]
    regexp {object pointer at (\S+)} $rep1 -> obj1
    regexp {object pointer at (\S+)} $rep2 -> obj2
    list $rep1 $rep2 [string equal $obj1 $obj2]
    # Internal optimisations should keep the same object
} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1}

# Testing for compiled vs non-compiled behaviour, and shared vs non-shared.
# Far too many variations to check with spelt-out tests.
# Note that this *just* checks whether the different versions are the same
# not whether any of them is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set lrange  lrange

    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
                # Shared, uncompiled
                set ls2 $ls
                set expected [list [catch {$lrange $ls $a $b} m] $m]
                # Shared, compiled
                set tester [list lrange $ls $a $b]
                set script [list catch $tester m]
                set script "list \[$script\] \$m"
                test lrange-5.[incr n].1 {lrange shared compiled} -body \
			[list apply [list {} $script]] -result $expected
                # Unshared, uncompiled
                set tester [string map [list %l [list $ls] %a $a %b $b] {
                    [string cat l range] [lrange %l 0 end] %a %b
                }]
                set script [list catch $tester m]
                set script "list \[$script\] \$m"
                test lrange-5.$n.2 {lrange unshared uncompiled} -body \
			[list apply [list {} $script]] -result $expected
                # Unshared, compiled
                set tester [string map [list %l [list $ls] %a $a %b $b] {
                    lrange [lrange %l 0 end] %a %b
                }]
                set script [list catch $tester m]
                set script "list \[$script\] \$m"
                test lrange-5.$n.3 {lrange unshared compiled} -body \
			[list apply [list {} $script]] -result $expected
	    }
	}
    }
}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/lrepeat.test.

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
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











-
-
+
+









-
+

-
+



+
-
+













-
+

-
+



+
-
+






-
+

-
-
-
-
-
-
-
-
-







# Commands covered:  lrepeat
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 by Simon Geard.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

## Arg errors
test lrepeat-1.1 {error cases} {
    -body {
	lrepeat
    }
    -returnCodes 1
    -result {wrong # args: should be "lrepeat count ?value ...?"}
    -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
}
test lrepeat-1.2 {Accept zero elements(TIP 323)} {
test lrepeat-1.2 {error cases} {
    -body {
	lrepeat 1
    }
    -returnCodes 1
    -result {}
    -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
}
test lrepeat-1.3 {error cases} {
    -body {
	lrepeat a 1
    }
    -returnCodes 1
    -result {expected integer but got "a"}
}
test lrepeat-1.4 {error cases} {
    -body {
	lrepeat -3 1
    }
    -returnCodes 1
    -result {bad count "-3": must be integer >= 0}
    -result {must have a count of at least 1} 
}
test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
test lrepeat-1.5 {error cases} {
    -body {
	lrepeat 0
    }
    -returnCodes 1
    -result {}
    -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
}
test lrepeat-1.6 {error cases} {
    -body {
	lrepeat 3.5 1
    }
    -returnCodes 1
    -result {expected integer but got "3.5"}
    -result {expected integer but got "3.5"} 
}
test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
    -body {
	lrepeat 0 a b c
    }
    -result {}
}
test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body {
     lrepeat 0x10000000 a b c d e f g h
} -returnCodes error -match glob -result *

## Okay
test lrepeat-2.1 {normal cases} {
    lrepeat 10 a
} {a a a a a a a a a a}
test lrepeat-2.2 {normal cases} {
    lrepeat 3 [lrepeat 3 0]

Changes to tests/lreplace.test.

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
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













-
-
+
+


-
+







# Commands covered:  lreplace
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


test lreplace-1.1 {lreplace command} {
    lreplace {1 2 3 4 5} 0 0 a
} {a 2 3 4 5}
test lreplace-1.2 {lreplace command} {
    lreplace {1 2 3 4 5} 1 1 a
} {1 a 3 4 5}
test lreplace-1.3 {lreplace command} {
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
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







-
+
-
-
-
-
-
-
-
-
-
-
-

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+
-
+







test lreplace-1.26 {lreplace command} {
    catch {unset foo}
    set foo {a b}
    list [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]] \
        [set foo [lreplace $foo end end]]
} {a {} {}}
test lreplace-1.27 {lreplace command} -body {

    lreplace x 1 1
} -result x
test lreplace-1.28 {lreplace command} -body {
    lreplace x 1 1 y
} -result {x y}
test lreplace-1.29 {lreplace command} -body {
    lreplace x 1 1 [error foo]
} -returnCodes 1 -result {foo}
test lreplace-1.30 {lreplace command} -body {
    lreplace {not {}alist} 0 0 [error foo]
} -returnCodes 1 -result {foo}

test lreplace-2.1 {lreplace errors} -body {
test lreplace-2.1 {lreplace errors} {
    list [catch lreplace msg] $msg
} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.2 {lreplace errors} -body {
} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
test lreplace-2.2 {lreplace errors} {
    list [catch {lreplace a b} msg] $msg
} -result {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
test lreplace-2.3 {lreplace errors} -body {
} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
test lreplace-2.3 {lreplace errors} {
    list [catch {lreplace x a 10} msg] $msg
} -result {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.4 {lreplace errors} -body {
} {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.4 {lreplace errors} {
    list [catch {lreplace x 10 x} msg] $msg
} -result {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.5 {lreplace errors} -body {
} {1 {bad index "x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.5 {lreplace errors} {
    list [catch {lreplace x 10 1x} msg] $msg
} -result {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} -body {
} {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
test lreplace-2.6 {lreplace errors} {
    list [catch {lreplace x 3 2} msg] $msg
} -result {0 x}
test lreplace-2.7 {lreplace errors} -body {
    list [catch {lreplace x 2 2} msg] $msg
} {1 {list doesn't contain element 3}}
test lreplace-2.7 {lreplace errors} {
    list [catch {lreplace x 1 1} msg] $msg
} -result {0 x}
} {1 {list doesn't contain element 1}}

test lreplace-3.1 {lreplace won't modify shared argument objects} {
    proc p {} {
        lreplace "a b c" 1 1 "x y"
        return "a b c"
    }
    p
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
177
178
179
180
181
182
183






184





































185
186
187
188











-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
} {0 1 a b c 3 4}
test lreplace-4.11 {lreplace end index first} {
    lreplace {0 1 2 3 4} end-2 1 a b c
} {0 1 a b c 2 3 4}
test lreplace-4.12 {lreplace end index first} {
    lreplace {0 1 2 3 4} end-2 2 a b c
} {0 1 a b c 3 4}
test lreplace-4.13 {lreplace empty list} {
    lreplace {} 1 1 1
} 1
test lreplace-4.14 {lreplace empty list} {
    lreplace {} 2 2 2
} 2

test lreplace-5.1 {compiled lreplace: Bug 47ac84309b} {
    apply {x {
	lreplace $x end 0
    }} {a b c}
} {a b c}
test lreplace-5.2 {compiled lreplace: Bug 47ac84309b} {
    apply {x {
	lreplace $x end 0 A
    }} {a b c}
} {a b A c}

# Testing for compiled behaviour. Far too many variations to check with
# spelt-out tests. Note that this *just* checks whether the compiled version
# and the interpreted version are the same, not whether the interpreted
# version is correct.
apply {{} {
    set lss     {{} {a} {a b c} {a b c d}}
    set ins     {{} A {A B}}
    set idxs    {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
    set lreplace lreplace

    foreach ls $lss {
	foreach a $idxs {
	    foreach b $idxs {
		foreach i $ins {
		    set expected [list [catch {$lreplace $ls $a $b {*}$i} m] $m]
		    set tester [list lreplace $ls $a $b {*}$i]
		    set script [list catch $tester m]
		    set script "list \[$script\] \$m"
		    test lreplace-6.[incr n] {lreplace battery} -body \
			[list apply [list {} $script]] -result $expected
		}
	    }
	}
    }
}}

# cleanup
catch {unset foo}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/lsearch.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+


-
+







# Commands covered:  lsearch
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


set x {abcd bbcd 123 234 345}
test lsearch-1.1 {lsearch command} {
    lsearch $x 123
} 2
test lsearch-1.2 {lsearch command} {
    lsearch $x 3456
} -1
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
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







-
-
-
+
+
+









-
-
-
+
+
+



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







} -1
test lsearch-2.4 {search modes} {
    lsearch -exact {foo bar cat} bart
} -1
test lsearch-2.5 {search modes} {
    lsearch -exact {foo bar cat} bar
} 1
test lsearch-2.6 {search modes} -returnCodes error -body {
    lsearch -regexp {xyz bbcc *bc*} *bc*
} -result {couldn't compile regular expression pattern: quantifier operand invalid}
test lsearch-2.6 {search modes} {
    list [catch {lsearch -regexp {xyz bbcc *bc*} *bc*} msg] $msg
} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
test lsearch-2.7 {search modes} {
    lsearch -regexp {b.x ^bc xy bcx} ^bc
} 3
test lsearch-2.8 {search modes} {
    lsearch -glob {xyz bbcc *bc*} *bc*
} 1
test lsearch-2.9 {search modes} {
    lsearch -glob {b.x ^bc xy bcx} ^bc
} 1
test lsearch-2.10 {search modes} -returnCodes error -body {
    lsearch -glib {b.x bx xy bcx} b.x
} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-2.10 {search modes} {
    list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
test lsearch-2.11 {search modes with -nocase} {
    lsearch -exact -nocase {a b c A B C} A
} 0
test lsearch-2.12 {search modes with -nocase} {
    lsearch -glob -nocase {a b c A B C} A*
} 0
test lsearch-2.13 {search modes with -nocase} {
    lsearch -regexp -nocase {a b c A B C} ^A\$
} 0
test lsearch-2.14 {search modes without -nocase} {
    lsearch -exact {a b c A B C} A
} 3
test lsearch-2.15 {search modes without -nocase} {
    lsearch -glob {a b c A B C} A*
} 3
test lsearch-2.16 {search modes without -nocase} {
    lsearch -regexp {a b c A B C} ^A\$
} 3

test lsearch-3.1 {lsearch errors} -returnCodes error -body {
    lsearch
} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
test lsearch-3.2 {lsearch errors} -returnCodes error -body {
    lsearch a
} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
test lsearch-3.3 {lsearch errors} -returnCodes error -body {
    lsearch a b c
} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-3.4 {lsearch errors} -returnCodes error -body {
    lsearch a b c d
} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-3.5 {lsearch errors} -returnCodes error -body {
    lsearch "\{" b
} -result {unmatched open brace in list}
test lsearch-3.6 {lsearch errors} -returnCodes error -body {
    lsearch -index a b
} -result {"-index" option must be followed by list index}
test lsearch-3.7 {lsearch errors} -returnCodes error -body {
    lsearch -subindices -exact a b
} -result {-subindices cannot be used without -index option}
test lsearch-3.1 {lsearch errors} {
    list [catch lsearch msg] $msg
} {1 {wrong # args: should be "lsearch ?options? list pattern"}}
test lsearch-3.2 {lsearch errors} {
    list [catch {lsearch a} msg] $msg
} {1 {wrong # args: should be "lsearch ?options? list pattern"}}
test lsearch-3.3 {lsearch errors} {
    list [catch {lsearch a b c} msg] $msg
} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
test lsearch-3.4 {lsearch errors} {
    list [catch {lsearch a b c d} msg] $msg
} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
test lsearch-3.5 {lsearch errors} {
    list [catch {lsearch "\{" b} msg] $msg
} {1 {unmatched open brace in list}}
test lsearch-3.6 {lsearch errors} {
    list [catch {lsearch -index a b} msg] $msg
} {1 {"-index" option must be followed by list index}}
test lsearch-3.7 {lsearch errors} {
    list [catch {lsearch -subindices -exact a b} msg] $msg
} {1 {-subindices cannot be used without -index option}}

test lsearch-4.1 {binary data} {
    lsearch -exact [list foo one\000two bar] bar
} 2
test lsearch-4.2 {binary data} {
    set x one
    append x \x00
145
146
147
148
149
150
151
152

153
154
155
156
157
158
159

160
161
162
163
164
165
166
145
146
147
148
149
150
151

152
153
154
155
156
157
158

159
160
161
162
163
164
165
166







-
+






-
+







    set res {}
    for {set i 0} {$i < 100} {incr i} {
	lappend res [lsearch -integer -decreasing -sorted \
		$decreasingIntegers $i]
    }
    set res
} $decreasingIntegers
test lsearch-5.3 {binary search finds leftmost occurrences} {
test lsearch-5.3 {binary search finds leftmost occurances} {
    set res {}
    for {set i 0} {$i < 10} {incr i} {
	lappend res [lsearch -integer -sorted $repeatingIncreasingIntegers $i]
    }
    set res
} [list 0 5 10 15 20 25 30 35 40 45]
test lsearch-5.4 {binary search -decreasing finds leftmost occurrences} {
test lsearch-5.4 {binary search -decreasing finds leftmost occurances} {
    set res {}
    for {set i 9} {$i >= 0} {incr i -1} {
	lappend res [lsearch -sorted -integer -decreasing \
		$repeatingDecreasingIntegers $i]
    }
    set res
} [list 0 5 10 15 20 25 30 35 40 45]
294
295
296
297
298
299
300
301
302
303
304
305
306






307
308
309
310
311
312
313
294
295
296
297
298
299
300






301
302
303
304
305
306
307
308
309
310
311
312
313







-
-
-
-
-
-
+
+
+
+
+
+







} 3
test lsearch-10.2 {offset searching} {
    lsearch -start 2 {a b c d e f} a
} -1
test lsearch-10.3 {offset searching} {
    lsearch -start end-4 {a b c a b c} a
} 3
test lsearch-10.4 {offset searching} -returnCodes error -body {
    lsearch -start foobar {a b c a b c} a
} -result {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}
test lsearch-10.5 {offset searching} -returnCodes error -body {
    lsearch -start 1 2
} -result {missing starting index}
test lsearch-10.4 {offset searching} {
    list [catch {lsearch -start foobar {a b c a b c} a} msg] $msg
} {1 {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}}
test lsearch-10.5 {offset searching} {
    list [catch {lsearch -start 1 2} msg] $msg
} {1 {missing starting index}}
test lsearch-10.6 {binary search with offset} {
    set res {}
    for {set i 0} {$i < 100} {incr i} {
	lappend res [lsearch -integer -start 2 -sorted $increasingIntegers $i]
    }
    set res
} [concat -1 -1 [lrange $increasingIntegers 2 end]]
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
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
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











-
+



-
+




-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+



-
+




-
+


-
+


-
-
+
+

-
+

-
-
+
+


-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
-
-
-
test lsearch-17.1 {lsearch -index option, basic functionality} {
    lsearch -index 1 {{a c} {a b} {a a}} a
} 2
test lsearch-17.2 {lsearch -index option, basic functionality} {
    lsearch -index 1 -exact {{a c} {a b} {a a}} a
} 2
test lsearch-17.3 {lsearch -index option, basic functionality} {
    lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b*
    lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b* 
} 1
test lsearch-17.4 {lsearch -index option, basic functionality} {
    lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
} 0
} 0 
test lsearch-17.5 {lsearch -index option, basic functionality} {
    lsearch -all -index 0 -exact {{a c} {a b} {d a}} a
} {0 1}
test lsearch-17.6 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b*
    lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b* 
} {1 2}
test lsearch-17.7 {lsearch -index option, basic functionality} {
    lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
} {0 1}
test lsearch-17.8 {lsearch -index option, empty argument} {
    lsearch -index {} a a
} 0
test lsearch-17.9 {lsearch -index option, empty argument} {
    lsearch -index {} a a
} [lsearch a a]
test lsearch-17.10 {lsearch -index option, empty argument} {
    lsearch -index {} [list \{] \{
} 0
test lsearch-17.11 {lsearch -index option, empty argument} {
    lsearch -index {} [list \{] \{
} [lsearch [list \{] \{]
test lsearch-17.12 {lsearch -index option, encoding aliasing} -body {
    lsearch -index -2 a a
} -returnCodes error -result {index "-2" out of range}
test lsearch-17.13 {lsearch -index option, encoding aliasing} -body {
    lsearch -index -1-1 a a
} -returnCodes error -result {index "-1-1" out of range}
test lsearch-17.14 {lsearch -index option, encoding aliasing} -body {
    lsearch -index end--1 a a
} -returnCodes error -result {index "end--1" out of range}
test lsearch-17.15 {lsearch -index option, encoding aliasing} -body {
    lsearch -index end+1 a a
} -returnCodes error -result {index "end+1" out of range}
test lsearch-17.16 {lsearch -index option, encoding aliasing} -body {
    lsearch -index end+2 a a
} -returnCodes error -result {index "end+2" out of range}


test lsearch-18.1 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 1
test lsearch-18.2 {lsearch -index option, list as index basic functionality} {
    lsearch -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 0
test lsearch-18.3 {lsearch -index option, list as index basic functionality} {
    lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
    lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* 
} 0
test lsearch-18.4 {lsearch -index option, list as index basic functionality} {
    lsearch -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} 0
} 0 
test lsearch-18.5 {lsearch -index option, list as index basic functionality} {
    lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {0 1}

test lsearch-19.1 {lsearch -subindices option} {
test lsearch-19.1 {lsearch -sunindices option} {
    lsearch -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {1 0 0}
test lsearch-19.2 {lsearch -subindices option} {
test lsearch-19.2 {lsearch -sunindices option} {
    lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {0 2 0}
test lsearch-19.3 {lsearch -subindices option} {
    lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
test lsearch-19.3 {lsearch -sunindices option} {
    lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b* 
} {0 1 1}
test lsearch-19.4 {lsearch -subindices option} {
test lsearch-19.4 {lsearch -sunindices option} {
    lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} {0 0 1}
test lsearch-19.5 {lsearch -subindices option} {
} {0 0 1} 
test lsearch-19.5 {lsearch -sunindices option} {
    lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 0 0} {1 0 0}}
test lsearch-19.6 {lsearch -subindices option} {
    lsearch -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 1 0} {1 1 0}}
test lsearch-19.7 {lsearch -subindices option} {
    lsearch -subindices -index end {{1 a}} a
} {0 1}
test lsearch-19.8 {lsearch -subindices option} {
    lsearch -subindices -all -index end {{1 a}} a
} {{0 1}}

test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
    lsearch -index 2 {{a c} {a b} {a a}} a
} -returnCodes error -result {element 2 missing from sublist "a c"}
test lsearch-20.2 {lsearch -index option, malformed index} -body {
    lsearch -index foo {{a c} {a b} {a a}} a
} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
test lsearch-20.3 {lsearch -index option, malformed index} -body {
    lsearch -index \{ {{a c} {a b} {a a}} a
} -returnCodes error -result {unmatched open brace in list}
test lsearch-20.1 {lsearch -index option, index larger than sublists} {
    list [catch {lsearch -index 2 {{a c} {a b} {a a}} a} msg] $msg
} {1 {element 2 missing from sublist "a c"}}
test lsearch-20.2 {lsearch -index option, malformed index} {
    list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg
} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
test lsearch-20.3 {lsearch -index option, malformed index} {
    list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg
} {1 {unmatched open brace in list}}

test lsearch-21.1 {lsearch shimmering crash} {
    set x 0
    lsearch -exact -integer $x $x
} 0
test lsearch-21.2 {lsearch shimmering crash} {
    set x 0.5
    lsearch -exact -real $x $x
} 0

test lsearch-22.1 {lsearch -bisect} -setup {
    set res {}
} -body {
    foreach i {0 1 5 6 7 8 15 16} {
	lappend res [lsearch -bisect -integer {1 4 5 7 9 15} $i]
    }
    return $res
} -result {-1 0 2 2 3 3 5 5}
test lsearch-22.2 {lsearch -bisect, last of equals} -setup {
    set res {}
} -body {
    foreach i {0 1 2 3} {
	lappend res [lsearch -bisect -integer {0 0 1 1 1 2 2 2 3 3 3} $i]
    }
    return $res
} -result {1 4 7 10}
test lsearch-22.3 {lsearch -bisect decreasing order} -setup {
    set res {}
} -body {
    foreach i {0 1 5 6 7 8 15 16} {
	lappend res [lsearch -bisect -integer -decreasing {15 9 7 5 4 1} $i]
    }
    return $res
} -result {5 5 3 2 2 1 0 -1}
test lsearch-22.4 {lsearch -bisect, last of equals, decreasing} -setup {
    set res {}
} -body {
    foreach i {0 1 2 3} {
	lappend res [lsearch -bisect -integer -decreasing \
		{3 3 3 2 2 2 1 1 1 0 0} $i]
    }
    return $res
} -result {10 8 5 2}
test lsearch-22.5 {lsearch -bisect, all equal} {
    lsearch -bisect -integer {5 5 5 5} 5
} {3}
test lsearch-22.6 {lsearch -sorted, all equal} {
    lsearch -sorted -integer {5 5 5 5} 5
} {0}

test lsearch-23.1 {lsearch -stride option, errors} -body {
    lsearch -stride {a b} a
} -returnCodes error -result {"-stride" option must be followed by stride length}
test lsearch-23.2 {lsearch -stride option, errors} -body {
    lsearch -stride 0 {a b} a
} -returnCodes error -result {stride length must be at least 1}
test lsearch-23.3 {lsearch -stride option, errors} -body {
    lsearch -stride 2 {a b c} a
} -returnCodes error -result {list size must be a multiple of the stride length}
test lsearch-23.4 {lsearch -stride option, errors} -body {
    lsearch -stride 5 {a b c} a
} -returnCodes error -result {list size must be a multiple of the stride length}
test lsearch-23.5 {lsearch -stride option, errors} -body {
    # Stride equal to length is ok
    lsearch -stride 3 {a b c} a
} -result 0

test lsearch-24.1 {lsearch -stride option} -body {
    lsearch -stride 2 {a b c d e f g h} d
} -result -1
test lsearch-24.2 {lsearch -stride option} -body {
    lsearch -stride 2 {a b c d e f g h} e
} -result 4
test lsearch-24.3 {lsearch -stride option} -body {
    lsearch -stride 3 {a b c d e f g h i} e
} -result -1
test lsearch-24.4 {lsearch -stride option} -body {
    # Result points first in group
    lsearch -stride 3 -index 1 {a b c d e f g h i} e
} -result 3
test lsearch-24.5 {lsearch -stride option} -body {
    lsearch -inline -stride 2 {a b c d e f g h} d
} -result {}
test lsearch-24.6 {lsearch -stride option} -body {
    # Inline result is a "single element" strided list
    lsearch -inline -stride 2 {a b c d e f g h} e
} -result "e f"
test lsearch-24.7 {lsearch -stride option} -body {
    lsearch -inline -stride 3 {a b c d e f g h i} e
} -result {}
test lsearch-24.8 {lsearch -stride option} -body {
    lsearch -inline -stride 3 -index 1 {a b c d e f g h i} e
} -result "d e f"
test lsearch-24.9 {lsearch -stride option} -body {
    lsearch -all -inline -stride 3 -index 1 {a b c d e f g e i} e
} -result "d e f g e i"
test lsearch-24.10 {lsearch -stride option} -body {
    lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a
} -result "a b c a e i"
test lsearch-24.11 {lsearch -stride option} -body {
    # Stride 1 is same as no stride
    lsearch -stride 1 {a b c d e f g h} d
} -result 3

# 25* mimics 19* but with -inline added to -subindices
test lsearch-25.1 {lsearch -subindices option} {
    lsearch -inline -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {a}
test lsearch-25.2 {lsearch -subindices option} {
    lsearch -inline -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {a}
test lsearch-25.3 {lsearch -subindices option} {
    lsearch -inline -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} {bb}
test lsearch-25.4 {lsearch -subindices option} {
    lsearch -inline -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
} {cb}
test lsearch-25.5 {lsearch -subindices option} {
    lsearch -inline -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {a a}
test lsearch-25.6 {lsearch -subindices option} {
    lsearch -inline -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {a a}

# 26* mimics 19* but with -stride added
test lsearch-26.1 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {3 0}
test lsearch-26.2 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {2 0}
test lsearch-26.3 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b*
} {1 1}
test lsearch-26.4 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b}
} {0 1}
test lsearch-26.5 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a
} {{0 0} {3 0}}
test lsearch-26.6 {lsearch -stride + -subindices option} {
    lsearch -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a
} {{1 0} {4 0}}

# 27* mimics 25* but with -stride added
test lsearch-27.1 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {a}
test lsearch-27.2 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a
} {a}
test lsearch-27.3 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b*
} {bb}
test lsearch-27.4 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b}
} {cb}
test lsearch-27.5 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a
} {a a}
test lsearch-27.6 {lsearch -stride + -subindices option} {
    lsearch -inline -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a
} {a a}

test lsearch-28.1 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 5
} -result 0
test lsearch-28.2 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 3
} -result -1
test lsearch-28.3 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 7
} -result 2
test lsearch-28.4 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 8
} -result -1
test lsearch-28.5 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 9
} -result 4
test lsearch-28.6 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 {5 3 7 8 9 2} 2
} -result -1
test lsearch-28.7 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 0 -subindices {5 3 7 8 9 2} 9
} -result 4
test lsearch-28.8 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9
} -result 5
test lsearch-28.9 {lsearch -sorted with -stride} -body {
    lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9
} -result 9


# cleanup
catch {unset res}
catch {unset increasingIntegers}
catch {unset decreasingIntegers}
catch {unset increasingDoubles}
catch {unset decreasingDoubles}
catch {unset increasingStrings}
catch {unset decreasingStrings}
catch {unset increasingDictionary}
catch {unset decreasingDictionary}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/lset.test.

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
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













-
-
+
+



-
-
-













-
+







# This file is a -*- tcl -*- test script

# Commands covered: lset
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

proc failTrace {name1 name2 op} {
    error "trace failed"
}

testConstraint testevalex [llength [info commands testevalex]]

set noRead {}
trace add variable noRead read failTrace
set noWrite {a b c}
trace add variable noWrite write failTrace

test lset-1.1 {lset, not compiled, arg count} testevalex {
    list [catch {testevalex lset} msg] $msg
} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
} "1 {wrong \# args: should be \"lset listVar ?index? ?index...? value\"}"
test lset-1.2 {lset, not compiled, no such var} testevalex {
    list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg
} "1 {can't read \"noSuchVar\": no such variable}"
test lset-1.3 {lset, not compiled, var not readable} testevalex {
    list [catch {testevalex {lset noRead 0 {}}} msg] $msg
} "1 {can't read \"noRead\": trace failed}"

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
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







-
+



-
+

-
-
+
+


-
+

-
-
-
-
-
-
-
+





-
+

















-
+



-
+

-
+
-
-
-
-
-
-



-
+

-
+





-
+







    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list -1] w}
    } msg] $msg
} {1 {index "-1" out of range}}
} {1 {list index out of range}}
test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list 4] w}
	testevalex {lset a [list 3] w}
    } msg] $msg
} {1 {index "4" out of range}}
test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex {
} {1 {list index out of range}}
test lset-4.5 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list end--2] w}
	testevalex {lset a [list end--1] w}
    } msg] $msg
} {1 {index "end--2" out of range}}
test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list end+2] w}
    } msg] $msg
} {1 {index "end+2" out of range}}
} {1 {list index out of range}}
test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a [list end-3] w}
    } msg] $msg
} {1 {index "end-3" out of range}}
} {1 {list index out of range}}
test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex {
    set a "x \{"
    list [catch {
	testevalex {lset a 0 y}
    } msg] $msg
} {1 {unmatched open brace in list}}
test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a 2a2 w}
    } msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a -1 w}
    } msg] $msg
} {1 {index "-1" out of range}}
} {1 {list index out of range}}
test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a 4 w}
	testevalex {lset a 3 w}
    } msg] $msg
} {1 {index "4" out of range}}
} {1 {list index out of range}}
test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a end--2 w}
    } msg] $msg
} {1 {index "end--2" out of range}}
test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a end+2 w}
	testevalex {lset a end--1 w}
    } msg] $msg
} {1 {index "end+2" out of range}}
} {1 {list index out of range}}
test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
    set a {x y z}
    list [catch {
	testevalex {lset a end-3 w}
    } msg] $msg
} {1 {index "end-3" out of range}}
} {1 {list index out of range}}

test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex {
    list [catch {
	testevalex {lset noWrite 0 d}
    } msg] $msg $noWrite
} {1 {can't set "noWrite": trace failed} {d b c}}
test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex {
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
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







-
+



-
+


-
-
+
+


-
-
-
+
+
+

-
+
-
-
-
-
-
-
+
+

-
+
-
-
-
-
-
+



-
+



-
+







test lset-8.4 {lset, not compiled, bad second index} testevalex {
    set a {{b c} {d e}}
    list [catch {testevalex {lset a {0 2a2} f}} msg] $msg
} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
test lset-8.5 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 -1 h}} msg] $msg
} {1 {index "-1" out of range}}
} {1 {list index out of range}}
test lset-8.6 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 -1} h}} msg] $msg
} {1 {index "-1" out of range}}
} {1 {list index out of range}}
test lset-8.7 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 3 h}} msg] $msg
} {1 {index "3" out of range}}
    list [catch {testevalex {lset a 2 2 h}} msg] $msg
} {1 {list index out of range}}
test lset-8.8 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 3} h}} msg] $msg
} {1 {index "3" out of range}}
test lset-8.9a {lset, not compiled, second index out of range} testevalex {
    list [catch {testevalex {lset a {2 2} h}} msg] $msg
} {1 {list index out of range}}
test lset-8.9 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 end--2 h}} msg] $msg
    list [catch {testevalex {lset a 2 end--1 h}} msg] $msg
} {1 {index "end--2" out of range}}
test lset-8.9b {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 end+2 h}} msg] $msg
} {1 {index "end+2" out of range}}
test lset-8.10a {lset, not compiled, second index out of range} testevalex {
} {1 {list index out of range}}
test lset-8.10 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 end--2} h}} msg] $msg
    list [catch {testevalex {lset a {2 end--1} h}} msg] $msg
} {1 {index "end--2" out of range}}
test lset-8.10b {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 end+2} h}} msg] $msg
} {1 {index "end+2" out of range}}
} {1 {list index out of range}}
test lset-8.11 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a 2 end-2 h}} msg] $msg
} {1 {index "end-2" out of range}}
} {1 {list index out of range}}
test lset-8.12 {lset, not compiled, second index out of range} testevalex {
    set a {{b c} {d e} {f g}}
    list [catch {testevalex {lset a {2 end-2} h}} msg] $msg
} {1 {index "end-2" out of range}}
} {1 {list index out of range}}

test lset-9.1 {lset, not compiled, entire variable} testevalex {
    set a x
    list [testevalex {lset a y}] $a
} {y y}
test lset-9.2 {lset, not compiled, entire variable} testevalex {
    set a x
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
401
402
403
404
405
406
407










































408
409
410
411
412
413
414
415
416







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









} -constraints testobj -body {
    lset l 0 0 0 5
    lindex $x 0 0
} -cleanup {
    unset -nocomplain x l
} -result 1

test lset-16.1 {lset - grow a variable} testevalex {
    set x {}
    testevalex {lset x 0 {test 1}}
    testevalex {lset x 1 {test 2}}
    set x
} {{test 1} {test 2}}
test lset-16.2 {lset - multiple created sublists} testevalex {
    set x {}
    testevalex {lset x 0 0 {test 1}}
} {{{test 1}}}
test lset-16.3 {lset - sublists 3 deep} testevalex {
    set x {}
    testevalex {lset x 0 0 0 {test 1}}
} {{{{test 1}}}}
test lset-16.4 {lset - append to inner list} testevalex {
    set x {test 1}
    testevalex {lset x 1 1 2}
    testevalex {lset x 1 2 3}
    testevalex {lset x 1 2 1 4}
} {test {1 2 {3 4}}}

test lset-16.5 {lset - grow a variable} testevalex {
    set x {}
    testevalex {lset x end+1 {test 1}}
    testevalex {lset x end+1 {test 2}}
    set x
} {{test 1} {test 2}}
test lset-16.6 {lset - multiple created sublists} testevalex {
    set x {}
    testevalex {lset x end+1 end+1 {test 1}}
} {{{test 1}}}
test lset-16.7 {lset - sublists 3 deep} testevalex {
    set x {}
    testevalex {lset x end+1 end+1 end+1 {test 1}}
} {{{{test 1}}}}
test lset-16.8 {lset - append to inner list} testevalex {
    set x {test 1}
    testevalex {lset x end end+1 2}
    testevalex {lset x end end+1 3}
    testevalex {lset x end end end+1 4}
} {test {1 2 {3 4}}}

catch {unset noRead}
catch {unset noWrite}
catch {rename failTrace {}}
catch {unset ::x}
catch {unset ::y}

# cleanup
::tcltest::cleanupTests
return

Changes to tests/lsetComp.test.

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
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













-
-
+
+









-
+











-
+







# This file is a -*- tcl -*- test script

# Commands covered: lset
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# Procedure to evaluate a script within a proc, to test compilation
# functionality

proc evalInProc { script } {
    proc testProc {} $script
    set status [catch {
	testProc
	testProc 
    } result]
    rename testProc {}
    return [list $status $result]
}

# Tests for the bytecode compilation of the 'lset' command

test lsetComp-1.1 {lset, compiled, wrong \# args} {
    evalInProc {
	lset
    }
} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
} "1 {wrong \# args: should be \"lset listVar ?index? ?index...? value\"}"

test lsetComp-2.1 {lset, compiled, list of args, not a simple var name} {
    evalInProc {
	set y x
	set x {{1 2} {3 4}}
	lset $y {1 1} 5
    }
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	set x {{1 2} {3 4}}
	lset x {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.4 {lset, compiled, list of args, scalar, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set x {{1 2} {3 4}}
	lset x {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.5 {lset, compiled, list of args, array on stack} {
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+







	set y(0) {{1 2} {3 4}}
	lset y(0) {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.7 {lset, compiled, list of args, array, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set y(0) {{1 2} {3 4}}
	lset y(0) {1 1} 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-2.8 {lset, compiled, list of args, error } {
    evalInProc {
	set x { {1 2} {3 4} }
	lset x {1 5} 5
    }
} {1 {index "5" out of range}}
} "1 {list index out of range}"

test lsetComp-2.9 {lset, compiled, list of args, error - is string preserved} {
    set ::x { { 1 2 } { 3 4 } }
    evalInProc {
	lset ::x { 1 5 } 5
    }
    list $::x [lindex $::x 1]
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	set x {{1 2} {3 4}}
	lset x 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.4 {lset, compiled, scalar, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set x {{1 2} {3 4}}
	lset x 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.5 {lset, compiled, flat args, array on stack} {
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+







	set y(0) {{1 2} {3 4}}
	lset y(0) 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.7 {lset, compiled, flat args, array, four-byte offset} {
    evalInProc {
	set x0 0; set x1 0; set x2 0; set x3 0;
	set x4 0; set x5 0; set x6 0; set x7 0;
	set x8 0; set x9 0; set x10 0; set x11 0;
	set x12 0; set x13 0; set x14 0; set x15 0;
	set x16 0; set x17 0; set x18 0; set x19 0;
	set x20 0; set x21 0; set x22 0; set x23 0;
	set x24 0; set x25 0; set x26 0; set x27 0;
	set x28 0; set x29 0; set x30 0; set x31 0;
	set x32 0; set x33 0; set x34 0; set x35 0;
	set x36 0; set x37 0; set x38 0; set x39 0;
	set x40 0; set x41 0; set x42 0; set x43 0;
	set x44 0; set x45 0; set x46 0; set x47 0;
	set x48 0; set x49 0; set x50 0; set x51 0;
	set x52 0; set x53 0; set x54 0; set x55 0;
	set x56 0; set x57 0; set x58 0; set x59 0;
	set x60 0; set x61 0; set x62 0; set x63 0;
	set x64 0; set x65 0; set x66 0; set x67 0;
	set x68 0; set x69 0; set x70 0; set x71 0;
	set x72 0; set x73 0; set x74 0; set x75 0;
	set x76 0; set x77 0; set x78 0; set x79 0;
	set x80 0; set x81 0; set x82 0; set x83 0;
	set x84 0; set x85 0; set x86 0; set x87 0;
	set x88 0; set x89 0; set x90 0; set x91 0;
	set x92 0; set x93 0; set x94 0; set x95 0;
	set x96 0; set x97 0; set x98 0; set x99 0;
	set x100 0; set x101 0; set x102 0; set x103 0;
	set x104 0; set x105 0; set x106 0; set x107 0;
	set x108 0; set x109 0; set x110 0; set x111 0;
	set x112 0; set x113 0; set x114 0; set x115 0;
	set x116 0; set x117 0; set x118 0; set x119 0;
	set x120 0; set x121 0; set x122 0; set x123 0;
	set x124 0; set x125 0; set x126 0; set x127 0;
	set x128 0; set x129 0; set x130 0; set x131 0;
	set x132 0; set x133 0; set x134 0; set x135 0;
	set x136 0; set x137 0; set x138 0; set x139 0;
	set x140 0; set x141 0; set x142 0; set x143 0;
	set x144 0; set x145 0; set x146 0; set x147 0;
	set x148 0; set x149 0; set x150 0; set x151 0;
	set x152 0; set x153 0; set x154 0; set x155 0;
	set x156 0; set x157 0; set x158 0; set x159 0;
	set x160 0; set x161 0; set x162 0; set x163 0;
	set x164 0; set x165 0; set x166 0; set x167 0;
	set x168 0; set x169 0; set x170 0; set x171 0;
	set x172 0; set x173 0; set x174 0; set x175 0;
	set x176 0; set x177 0; set x178 0; set x179 0;
	set x180 0; set x181 0; set x182 0; set x183 0;
	set x184 0; set x185 0; set x186 0; set x187 0;
	set x188 0; set x189 0; set x190 0; set x191 0;
	set x192 0; set x193 0; set x194 0; set x195 0;
	set x196 0; set x197 0; set x198 0; set x199 0;
	set x200 0; set x201 0; set x202 0; set x203 0;
	set x204 0; set x205 0; set x206 0; set x207 0;
	set x208 0; set x209 0; set x210 0; set x211 0;
	set x212 0; set x213 0; set x214 0; set x215 0;
	set x216 0; set x217 0; set x218 0; set x219 0;
	set x220 0; set x221 0; set x222 0; set x223 0;
	set x224 0; set x225 0; set x226 0; set x227 0;
	set x228 0; set x229 0; set x230 0; set x231 0;
	set x232 0; set x233 0; set x234 0; set x235 0;
	set x236 0; set x237 0; set x238 0; set x239 0;
	set x240 0; set x241 0; set x242 0; set x243 0;
	set x244 0; set x245 0; set x246 0; set x247 0;
	set x248 0; set x249 0; set x250 0; set x251 0;
	set x0 0; set x1 0; set x2 0; set x3 0; 
	set x4 0; set x5 0; set x6 0; set x7 0; 
	set x8 0; set x9 0; set x10 0; set x11 0; 
	set x12 0; set x13 0; set x14 0; set x15 0; 
	set x16 0; set x17 0; set x18 0; set x19 0; 
	set x20 0; set x21 0; set x22 0; set x23 0; 
	set x24 0; set x25 0; set x26 0; set x27 0; 
	set x28 0; set x29 0; set x30 0; set x31 0; 
	set x32 0; set x33 0; set x34 0; set x35 0; 
	set x36 0; set x37 0; set x38 0; set x39 0; 
	set x40 0; set x41 0; set x42 0; set x43 0; 
	set x44 0; set x45 0; set x46 0; set x47 0; 
	set x48 0; set x49 0; set x50 0; set x51 0; 
	set x52 0; set x53 0; set x54 0; set x55 0; 
	set x56 0; set x57 0; set x58 0; set x59 0; 
	set x60 0; set x61 0; set x62 0; set x63 0; 
	set x64 0; set x65 0; set x66 0; set x67 0; 
	set x68 0; set x69 0; set x70 0; set x71 0; 
	set x72 0; set x73 0; set x74 0; set x75 0; 
	set x76 0; set x77 0; set x78 0; set x79 0; 
	set x80 0; set x81 0; set x82 0; set x83 0; 
	set x84 0; set x85 0; set x86 0; set x87 0; 
	set x88 0; set x89 0; set x90 0; set x91 0; 
	set x92 0; set x93 0; set x94 0; set x95 0; 
	set x96 0; set x97 0; set x98 0; set x99 0; 
	set x100 0; set x101 0; set x102 0; set x103 0; 
	set x104 0; set x105 0; set x106 0; set x107 0; 
	set x108 0; set x109 0; set x110 0; set x111 0; 
	set x112 0; set x113 0; set x114 0; set x115 0; 
	set x116 0; set x117 0; set x118 0; set x119 0; 
	set x120 0; set x121 0; set x122 0; set x123 0; 
	set x124 0; set x125 0; set x126 0; set x127 0; 
	set x128 0; set x129 0; set x130 0; set x131 0; 
	set x132 0; set x133 0; set x134 0; set x135 0; 
	set x136 0; set x137 0; set x138 0; set x139 0; 
	set x140 0; set x141 0; set x142 0; set x143 0; 
	set x144 0; set x145 0; set x146 0; set x147 0; 
	set x148 0; set x149 0; set x150 0; set x151 0; 
	set x152 0; set x153 0; set x154 0; set x155 0; 
	set x156 0; set x157 0; set x158 0; set x159 0; 
	set x160 0; set x161 0; set x162 0; set x163 0; 
	set x164 0; set x165 0; set x166 0; set x167 0; 
	set x168 0; set x169 0; set x170 0; set x171 0; 
	set x172 0; set x173 0; set x174 0; set x175 0; 
	set x176 0; set x177 0; set x178 0; set x179 0; 
	set x180 0; set x181 0; set x182 0; set x183 0; 
	set x184 0; set x185 0; set x186 0; set x187 0; 
	set x188 0; set x189 0; set x190 0; set x191 0; 
	set x192 0; set x193 0; set x194 0; set x195 0; 
	set x196 0; set x197 0; set x198 0; set x199 0; 
	set x200 0; set x201 0; set x202 0; set x203 0; 
	set x204 0; set x205 0; set x206 0; set x207 0; 
	set x208 0; set x209 0; set x210 0; set x211 0; 
	set x212 0; set x213 0; set x214 0; set x215 0; 
	set x216 0; set x217 0; set x218 0; set x219 0; 
	set x220 0; set x221 0; set x222 0; set x223 0; 
	set x224 0; set x225 0; set x226 0; set x227 0; 
	set x228 0; set x229 0; set x230 0; set x231 0; 
	set x232 0; set x233 0; set x234 0; set x235 0; 
	set x236 0; set x237 0; set x238 0; set x239 0; 
	set x240 0; set x241 0; set x242 0; set x243 0; 
	set x244 0; set x245 0; set x246 0; set x247 0; 
	set x248 0; set x249 0; set x250 0; set x251 0; 
	set x252 0; set x253 0; set x254 0; set x255 0;
	set y(0) {{1 2} {3 4}}
	lset y(0) 1 1 5
    }
} "0 {{1 2} {3 5}}"

test lsetComp-3.8 {lset, compiled, flat args, error } {
    evalInProc {
	set x { {1 2} {3 4} }
	lset x 1 5 5
    }
} {1 {index "5" out of range}}
} "1 {list index out of range}"

test lsetComp-3.9 {lset, compiled, flat args, error - is string preserved} {
    set ::x { { 1 2 } { 3 4 } }
    evalInProc {
	lset ::x 1 5 5
    }
    list $::x [lindex $::x 1]

Changes to tests/macOSXFCmd.test.

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18
19
20











-
-
+
+







# This file tests the tclMacOSXFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 Tcl Core Team.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# These tests really need to be run from a writable directory, which
# it is assumed [temporaryDirectory] is.
set oldcwd [pwd]
cd [temporaryDirectory]

Changes to tests/macOSXLoad.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14


15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17
18
19
20
21












-
-
+
+







# Commands covered:  load unload
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}
set oldTSF $::tcltest::testSingleFile
set ::tcltest::testSingleFile false

if {[testConstraint unix] && $tcl_platform(os) eq "Darwin" &&
	![string match *pkga* [info loaded]]} {

Changes to tests/main.test.

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
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


-
-
-
+
+
+













-
+







# This file contains a collection of tests for generic/tclMain.c.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
if {[catch {package require tcltest 2.0.2}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
    return
}

namespace eval ::tcl::test::main {
    namespace import ::tcltest::*

    # Is [exec] defined?
    testConstraint exec [llength [info commands exec]]

    # Is the Tcltest package loaded?
    #	- that is, the special C-coded testing commands in tclTest.c
    #   - tests use testing commands introduced in Tcltest 8.4
    testConstraint Tcltest [expr {
	[llength [package provide Tcltest]]
	&& [package vsatisfies [package provide Tcltest] 8.5-]}]
	&& [package vsatisfies [package provide Tcltest] 8.4]}]

    # Procedure to simulate interactive typing of commands, line by line
    proc type {chan script} {
	foreach line [split $script \n] {
	    if {[catch {
	        puts $chan $line
	        flush $chan
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
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







+
+














+
+

-
+












+
+

-
+












+
+

-
+







	read $f
    } -cleanup {
	close $f
	removeFile -script
    } -result [list [interpreter] -script 0]\n

    test Tcl_Main-1.3 {
	Tcl_Main: encoding of arguments: done by system encoding
	Note the shortcoming explained in Tcl Feature Request 491789
    } -constraints {
	stdio
    } -setup {
	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
	catch {set f [open "|[list [interpreter] script \u00c0]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile script
    } -result [list script [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u00c0]]] 0]\n

    test Tcl_Main-1.4 {
	Tcl_Main: encoding of arguments: done by system encoding
	Note the shortcoming explained in Tcl Feature Request 491789
    } -constraints {
	stdio
	stdio tempNotWin
    } -setup {
	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
	catch {set f [open "|[list [interpreter] script \u20ac]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile script
    } -result [list script [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u20ac]]] 0]\n

    test Tcl_Main-1.5 {
	Tcl_Main: encoding of script name: system encoding loss
	Note the shortcoming explained in Tcl Feature Request 491789
    } -constraints {
	stdio
	stdio tempNotWin
    } -setup {
	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u00c0
	catch {set f [open "|[list [interpreter] \u00c0]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
	removeFile \u00c0
    } -result [list [list [encoding convertfrom [encoding system] \
	[encoding convertto [encoding system] \u00c0]]] {} 0]\n

    test Tcl_Main-1.6 {
	Tcl_Main: encoding of script name: system encoding loss
	Note the shortcoming explained in Tcl Feature Request 491789
    } -constraints {
	stdio
	stdio tempNotWin
    } -setup {
	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
	catch {set f [open "|[list [interpreter] \u20ac]" r]}
    } -body {
	read $f
    } -cleanup {
	close $f
715
716
717
718
719
720
721
722

723
724
725
726
727
728
729
723
724
725
726
727
728
729

730
731
732
733
734
735
736
737







-
+







	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "Exit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-5.9 {
	Tcl_Main: interactive mode: delete interp
	Tcl_Main: interactive mode: delete interp 
		-> main loop & exit handlers, but no [exit]
    } -constraints {
	exec Tcltest
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {

Changes to tests/mathop.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14


15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17
18
19
20
21












-
-
+
+







# Commands covered: ::tcl::mathop::...
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 2006 Donal K. Fellows
# Copyright (c) 2006 Peter Spjuth
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

# A namespace to test that operators are exported and that they
# work when imported
namespace eval ::testmathop2 {
    namespace import ::tcl::mathop::*
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
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







-
+


















-
+


-
+


-
+


-
+


-
+


-
+







        set res2 [lindex $results $i+1]
        if {$res1 ne $res2} {
            return "$i:($res1 != $res2)"
        }
    }
    return [lindex $results 0]
}


# start of tests

namespace eval ::testmathop {
    namespace path ::tcl::mathop
    variable op ;# stop surprises!

    test mathop-1.1 {compiled +} { + } 0
    test mathop-1.2 {compiled +} { + 1 } 1
    test mathop-1.3 {compiled +} { + 1 2 } 3
    test mathop-1.4 {compiled +} { + 1 2 3 } 6
    test mathop-1.5 {compiled +} { + 1.0 2 3 } 6.0
    test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0
    test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005
    test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003
    test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005
    test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
    test mathop-1.11 {compiled +: errors} -returnCodes error -body {
	+ x 0
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.12 {compiled +: errors} -returnCodes error -body {
	+ nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.13 {compiled +: errors} -returnCodes error -body {
	+ 0 x
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.14 {compiled +: errors} -returnCodes error -body {
	+ 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.15 {compiled +: errors} -returnCodes error -body {
	+ 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.16 {compiled +: errors} -returnCodes error -body {
	+ 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.17 {compiled +: errors} -returnCodes error -body {
	+ 0 [error expectedError]
    } -result expectedError
    test mathop-1.18 {compiled +: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    + [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
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
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







-
+


-
+


-
+


-
+


-
+


-
+







    test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0
    test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005
    test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003
    test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005
    test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
    test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "+"}
    } -result {can't use non-numeric string as operand of "+"}
    test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
    } -result {can't use non-numeric floating-point value as operand of "+"}
    test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "+"}
    } -result {can't use invalid octal number as operand of "+"}
    test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-1.36 {interpreted +: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
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
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







-
+


-
+


-
+


-
+


-
+


-
+







    test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0
    test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000
    test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000
    test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000
    test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
    test mathop-2.11 {compiled *: errors} -returnCodes error -body {
	* x 0
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.12 {compiled *: errors} -returnCodes error -body {
	* nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.13 {compiled *: errors} -returnCodes error -body {
	* 0 x
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.14 {compiled *: errors} -returnCodes error -body {
	* 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.15 {compiled *: errors} -returnCodes error -body {
	* 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.16 {compiled *: errors} -returnCodes error -body {
	* 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.17 {compiled *: errors} -returnCodes error -body {
	* 0 [error expectedError]
    } -result expectedError
    test mathop-2.18 {compiled *: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    * [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
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
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







-
+


-
+


-
+


-
+


-
+


-
+


















-
+
















-
+








-
+


-
+










-
+








-
+


-
+










-
+








-
+


-
+







    test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0
    test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000
    test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000
    test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000
    test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
    test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "*"}
    } -result {can't use non-numeric string as operand of "*"}
    test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
    } -result {can't use non-numeric floating-point value as operand of "*"}
    test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "*"}
    } -result {can't use invalid octal number as operand of "*"}
    test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-2.36 {interpreted *: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}

    test mathop-3.1 {compiled !} {! 0} 1
    test mathop-3.2 {compiled !} {! 1} 0
    test mathop-3.3 {compiled !} {! false} 1
    test mathop-3.4 {compiled !} {! true} 0
    test mathop-3.5 {compiled !} {! 0.0} 1
    test mathop-3.6 {compiled !} {! 10000000000} 0
    test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
    test mathop-3.8 {compiled !: errors} -body {
	! foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
    } -returnCodes error -result {can't use non-numeric string as operand of "!"}
    test mathop-3.9 {compiled !: errors} -body {
	! 0 0
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    test mathop-3.10 {compiled !: errors} -body {
	!
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    set op !
    test mathop-3.11 {interpreted !} {$op 0} 1
    test mathop-3.12 {interpreted !} {$op 1} 0
    test mathop-3.13 {interpreted !} {$op false} 1
    test mathop-3.14 {interpreted !} {$op true} 0
    test mathop-3.15 {interpreted !} {$op 0.0} 1
    test mathop-3.16 {interpreted !} {$op 10000000000} 0
    test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
    test mathop-3.18 {interpreted !: errors} -body {
	$op foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
    } -returnCodes error -result {can't use non-numeric string as operand of "!"}
    test mathop-3.19 {interpreted !: errors} -body {
	$op 0 0
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    test mathop-3.20 {interpreted !: errors} -body {
	$op
    } -returnCodes error -result "wrong # args: should be \"! boolean\""
    test mathop-3.21 {compiled !: error} -returnCodes error -body {
	! NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
    } -result {can't use non-numeric floating-point value as operand of "!"}
    test mathop-3.22 {interpreted !: error} -returnCodes error -body {
	$op NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
    } -result {can't use non-numeric floating-point value as operand of "!"}

    test mathop-4.1 {compiled ~} {~ 0} -1
    test mathop-4.2 {compiled ~} {~ 1} -2
    test mathop-4.3 {compiled ~} {~ 31} -32
    test mathop-4.4 {compiled ~} {~ -127} 126
    test mathop-4.5 {compiled ~} {~ -0} -1
    test mathop-4.6 {compiled ~} {~ 10000000000} -10000000001
    test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
    test mathop-4.8 {compiled ~: errors} -body {
	~ foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
    } -returnCodes error -result {can't use non-numeric string as operand of "~"}
    test mathop-4.9 {compiled ~: errors} -body {
	~ 0 0
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.10 {compiled ~: errors} -body {
	~
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
	~ 0.0
    } -result {can't use floating-point value "0.0" as operand of "~"}
    } -result {can't use floating-point value as operand of "~"}
    test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
	~ NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
    } -result {can't use non-numeric floating-point value as operand of "~"}
    set op ~
    test mathop-4.13 {interpreted ~} {$op 0} -1
    test mathop-4.14 {interpreted ~} {$op 1} -2
    test mathop-4.15 {interpreted ~} {$op 31} -32
    test mathop-4.16 {interpreted ~} {$op -127} 126
    test mathop-4.17 {interpreted ~} {$op -0} -1
    test mathop-4.18 {interpreted ~} {$op 10000000000} -10000000001
    test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
    test mathop-4.20 {interpreted ~: errors} -body {
	$op foobar
    } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
    } -returnCodes error -result {can't use non-numeric string as operand of "~"}
    test mathop-4.21 {interpreted ~: errors} -body {
	$op 0 0
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.22 {interpreted ~: errors} -body {
	$op
    } -returnCodes error -result "wrong # args: should be \"~ integer\""
    test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
	$op 0.0
    } -result {can't use floating-point value "0.0" as operand of "~"}
    } -result {can't use floating-point value as operand of "~"}
    test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
	$op NaN
    } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
    } -result {can't use non-numeric floating-point value as operand of "~"}

    test mathop-5.1 {compiled eq} {eq {} a} 0
    test mathop-5.2 {compiled eq} {eq a a} 1
    test mathop-5.3 {compiled eq} {eq a {}} 0
    test mathop-5.4 {compiled eq} {eq a b} 0
    test mathop-5.5 {compiled eq} { eq } 1
    test mathop-5.6 {compiled eq} {eq a} 1
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
450
451
452
453
454
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
450
451
452
453
454







-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+
















-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+








    test mathop-6.1 {compiled &} { & } -1
    test mathop-6.2 {compiled &} { & 1 } 1
    test mathop-6.3 {compiled &} { & 1 2 } 0
    test mathop-6.4 {compiled &} { & 3 7 6 } 2
    test mathop-6.5 {compiled &} -returnCodes error -body {
	& 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.6 {compiled &} -returnCodes error -body {
	& 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
    test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
    test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
    test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
    test mathop-6.11 {compiled &: errors} -returnCodes error -body {
	& x 0
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.12 {compiled &: errors} -returnCodes error -body {
	& nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.13 {compiled &: errors} -returnCodes error -body {
	& 0 x
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.14 {compiled &: errors} -returnCodes error -body {
	& 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.15 {compiled &: errors} -returnCodes error -body {
	& 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.16 {compiled &: errors} -returnCodes error -body {
	& 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.17 {compiled &: errors} -returnCodes error -body {
	& 0 [error expectedError]
    } -result expectedError
    test mathop-6.18 {compiled &: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    & [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}
    set op &
    test mathop-6.19 {interpreted &} { $op } -1
    test mathop-6.20 {interpreted &} { $op 1 } 1
    test mathop-6.21 {interpreted &} { $op 1 2 } 0
    test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
    test mathop-6.23 {interpreted &} -returnCodes error -body {
	$op 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.24 {interpreted &} -returnCodes error -body {
	$op 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "&"}
    } -result {can't use floating-point value as operand of "&"}
    test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
    test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
    test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
    test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
    test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "&"}
    } -result {can't use non-numeric string as operand of "&"}
    test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
    } -result {can't use non-numeric floating-point value as operand of "&"}
    test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "&"}
    } -result {can't use invalid octal number as operand of "&"}
    test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-6.36 {interpreted &: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
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
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







-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+
















-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+








    test mathop-7.1 {compiled |} { | } 0
    test mathop-7.2 {compiled |} { | 1 } 1
    test mathop-7.3 {compiled |} { | 1 2 } 3
    test mathop-7.4 {compiled |} { | 3 7 6 } 7
    test mathop-7.5 {compiled |} -returnCodes error -body {
	| 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.6 {compiled |} -returnCodes error -body {
	| 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
    test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
    test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
    test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
    test mathop-7.11 {compiled |: errors} -returnCodes error -body {
	| x 0
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.12 {compiled |: errors} -returnCodes error -body {
	| nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.13 {compiled |: errors} -returnCodes error -body {
	| 0 x
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.14 {compiled |: errors} -returnCodes error -body {
	| 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.15 {compiled |: errors} -returnCodes error -body {
	| 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.16 {compiled |: errors} -returnCodes error -body {
	| 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.17 {compiled |: errors} -returnCodes error -body {
	| 0 [error expectedError]
    } -result expectedError
    test mathop-7.18 {compiled |: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    | [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}
    set op |
    test mathop-7.19 {interpreted |} { $op } 0
    test mathop-7.20 {interpreted |} { $op 1 } 1
    test mathop-7.21 {interpreted |} { $op 1 2 } 3
    test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
    test mathop-7.23 {interpreted |} -returnCodes error -body {
	$op 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.24 {interpreted |} -returnCodes error -body {
	$op 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "|"}
    } -result {can't use floating-point value as operand of "|"}
    test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
    test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
    test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
    test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
    test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "|"}
    } -result {can't use non-numeric string as operand of "|"}
    test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
    } -result {can't use non-numeric floating-point value as operand of "|"}
    test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "|"}
    } -result {can't use invalid octal number as operand of "|"}
    test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-7.36 {interpreted |: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
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
618
619

620
621
622

623
624
625

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
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
618

619
620
621

622
623
624

625
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







-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+
















-
+


-
+






-
+


-
+


-
+


-
+


-
+


-
+








    test mathop-8.1 {compiled ^} { ^ } 0
    test mathop-8.2 {compiled ^} { ^ 1 } 1
    test mathop-8.3 {compiled ^} { ^ 1 2 } 3
    test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
    test mathop-8.5 {compiled ^} -returnCodes error -body {
	^ 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.6 {compiled ^} -returnCodes error -body {
	^ 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
    test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
    test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
    test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
    test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
	^ x 0
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
	^ nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
	^ 0 x
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
	^ 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
	^ 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
	^ 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
	^ 0 [error expectedError]
    } -result expectedError
    test mathop-8.18 {compiled ^: argument processing order} -body {
	# Bytecode compilation known hard for 3+ arguments
	list [catch {
	    ^ [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
    } -result {1 expected 2}
    set op ^
    test mathop-8.19 {interpreted ^} { $op } 0
    test mathop-8.20 {interpreted ^} { $op 1 } 1
    test mathop-8.21 {interpreted ^} { $op 1 2 } 3
    test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
    test mathop-8.23 {interpreted ^} -returnCodes error -body {
	$op 1.0 2 3
    } -result {can't use floating-point value "1.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.24 {interpreted ^} -returnCodes error -body {
	$op 1 2 3.0
    } -result {can't use floating-point value "3.0" as operand of "^"}
    } -result {can't use floating-point value as operand of "^"}
    test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
    test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
    test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
    test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
    test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
	$op x 0
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
	$op nan 0
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
	$op 0 x
    } -result {can't use non-numeric string "x" as operand of "^"}
    } -result {can't use non-numeric string as operand of "^"}
    test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
	$op 0 nan
    } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
    } -result {can't use non-numeric floating-point value as operand of "^"}
    test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
	$op 0o8 0
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
	$op 0 0o8
    } -result {can't use non-numeric string "0o8" as operand of "^"}
    } -result {can't use invalid octal number as operand of "^"}
    test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
	$op 0 [error expectedError]
    } -result expectedError
    test mathop-8.36 {interpreted ^: argument processing order} -body {
	list [catch {
	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
	} msg] $msg $x
725
726
727
728
729
730
731
732

733
734
735
736
737
738
739
725
726
727
728
729
730
731

732
733
734
735
736
737
738
739







-
+







    }
    set res
} {0 1 -1 0 0 1 1 1 1 1 1 1}
test mathop-20.2 { zero args, not allowed } {
    set exp {}
    foreach op {~ ! << >> % != ne in ni - /} {
        set res [TestOp $op]
        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
        if {[string match "wrong # args* NONE" $res]} {
            lappend exp 0
        } else {
            lappend exp $res
        }
    }
    set exp
} {0 0 0 0 0 0 0 0 0 0 0}
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
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







-
+














-
+
-




-
+
-







    }
    set res
} [list 23 23 23 -24]
test mathop-20.5 { one arg, not allowed } {
    set exp {}
    foreach op {% != ne in ni << >>} {
        set res [TestOp $op 1]
        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
        if {[string match "wrong # args* NONE" $res]} {
            lappend exp 0
        } else {
            lappend exp $res
        }
    }
    set exp
} {0 0 0 0 0 0 0}
test mathop-20.6 { one arg, error } {
    set res {}
    set exp {}
    foreach vals {x {1 x} {1 1 x} {1 x 1}} {
        # skipping - for now, knownbug...
        foreach op {+ * / & | ^ **} {
            lappend res [TestOp $op {*}$vals]
            lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\
            lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
		ARITH DOMAIN {non-numeric string}"
        }
    }
    foreach op {+ * / & | ^ **} {
	lappend res [TestOp $op NaN 1]
	lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\
	lappend exp "can't use non-numeric floating-point value as operand of \"$op\" ARITH DOMAIN {non-numeric floating-point value}"
	    ARITH DOMAIN {non-numeric floating-point value}"
    }
    expr {$res eq $exp ? 0 : $res}
} 0
test mathop-20.7 { multi arg } {
    set res {}
    foreach vals {{1 2} {3 4 5} {4 3 2 1}} {
        foreach op {+ - * /} {
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
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







-
+

-
+

-
+

-
+

-
+






-
+







    set res
} [list 1.0 0.2 0.17857142857142858 -0.125 \
           2.8196218755553604e-15 8.10000006561e-27]
test mathop-21.5 { unary ops, bad values } {
    set res {}
    set exp {}
    lappend res [TestOp / x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp - x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ~ x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ! x]
    lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ~ 5.0]
    lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}"
    lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
    expr {$res eq $exp ? 0 : $res}
} 0
test mathop-21.6 { unary ops, too many } {
    set exp {}
    foreach op {~ !} {
        set res [TestOp $op 7 8]
        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
        if {[string match "wrong # args* NONE" $res]} {
            lappend exp 0
        } else {
            lappend exp $res
        }
    }
    set exp
} {0 0}
961
962
963
964
965
966
967
968

969
970

971
972
973
974
975
976
977
959
960
961
962
963
964
965

966
967

968
969
970
971
972
973
974
975







-
+

-
+







           70720 \
          ]
test mathop-22.4 { unary ops, bad values } {
    set res {}
    set exp {}
    foreach op {& | ^} {
        lappend res [TestOp $op x 5]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend res [TestOp $op 5 x]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
    }
    expr {$res eq $exp ? 0 : $res}
} 0

test mathop-23.1 { comparison ops, numerical } {
    set res {}
    set todo {5 {1 6} {1 2 2 3} {4 3 2 1} {5.0 5.0} {6 3 3 1} {5.0 5}}
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
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







-
+

-
+



-
+

-
+



-
+







                                              0 \
          ]
test mathop-24.3 { binary ops, bad values } {
    set res {}
    set exp {}
    foreach op {% << >>} {
        lappend res [TestOp $op x 1]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend res [TestOp $op 1 x]
        lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
    }
    foreach op {% << >>} {
        lappend res [TestOp $op 5.0 1]
        lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend res [TestOp $op 1 5.0]
        lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
    }
    foreach op {in ni} {
        lappend res [TestOp $op 5 "a b \{ c"]
        lappend exp "unmatched open brace in list TCL VALUE LIST BRACE"
        lappend exp "unmatched open brace in list NONE"
    }
    lappend res [TestOp % 5 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
    lappend res [TestOp % 9838923468297346238478737647637375 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
    lappend res [TestOp / 5 0]
    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
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
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







-
+
















-
-













-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+



















-
+

-
+







    }
    set res
} [list 1 1 0  0 0 1]
test mathop-24.8 { binary ops, too many } {
    set exp {}
    foreach op {<< >> % != ne in ni ~ !} {
        set res [TestOp $op 7 8 9]
        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
        if {[string match "wrong # args* NONE" $res]} {
            lappend exp 0
        } else {
            lappend exp $res
        }
    }
    set exp
} {0 0 0 0 0 0 0 0 0}

test mathop-25.1  { exp operator } {TestOp **        } 1
test mathop-25.2  { exp operator } {TestOp **   0    } 0
test mathop-25.3  { exp operator } {TestOp **   0   5} 0
test mathop-25.4  { exp operator } {TestOp ** 7.5    } 7.5
test mathop-25.5  { exp operator } {TestOp **   1   5} 1
test mathop-25.6  { exp operator } {TestOp **   5   1} 5
test mathop-25.7  { exp operator } {TestOp ** 4 3 2 1} 262144
test mathop-25.8  { exp operator } {TestOp ** 5.5   4} 915.0625
test mathop-25.8a { exp operator } {TestOp ** 4.0  -1} 0.25
test mathop-25.8b { exp operator } {TestOp ** 2.0  -2} 0.25
test mathop-25.9  { exp operator } {TestOp **  16 3.5} 16384.0
test mathop-25.10 { exp operator } {TestOp ** 3.5   0} 1.0
test mathop-25.11 { exp operator } {TestOp ** 378   0} 1
test mathop-25.12 { exp operator } {TestOp ** 7.8   1} 7.8
test mathop-25.13 { exp operator } {TestOp ** 748   1} 748
test mathop-25.14 { exp operator } {TestOp ** 1.6  -1} 0.625
test mathop-25.15 { exp operator } {TestOp ** 683  -1} 0
test mathop-25.16 { exp operator } {TestOp **   1  -1} 1
test mathop-25.17 { exp operator } {TestOp **  -1  -1} -1
test mathop-25.18 { exp operator } {TestOp **  -1  -2} 1
test mathop-25.19 { exp operator } {TestOp **  -1   3} -1
test mathop-25.20 { exp operator } {TestOp **  -1   4} 1
test mathop-25.21 { exp operator } {TestOp **   2  63} 9223372036854775808
test mathop-25.22 { exp operator } {TestOp **   2 256} 115792089237316195423570985008687907853269984665640564039457584007913129639936
set big 83756485763458746358734658473567847567473
test mathop-25.23 { exp operator } {TestOp ** $big  2} 7015148907444467657897585474493757781161998914521537835809623408157343003287605729
test mathop-25.22 { exp operator } {TestOp ** 83756485763458746358734658473567847567473 2} 7015148907444467657897585474493757781161998914521537835809623408157343003287605729
test mathop-25.24 { exp operator } {TestOp ** $big  0} 1
test mathop-25.25 { exp operator } {TestOp ** $big  1} $big
test mathop-25.26 { exp operator } {TestOp ** $big -1} 0
test mathop-25.27 { exp operator } {TestOp ** $big -2} 0
test mathop-25.28 { exp operator } {TestOp ** $big -$big} 0
test mathop-25.29 { exp operator } {expr {[set res [TestOp **  $big -1.0]]   >  0 && $res < 1.2e-41}} 1
test mathop-25.30 { exp operator } {expr {[set res [TestOp **  $big -1e-18]] >  0 && $res < 1}} 1
test mathop-25.31 { exp operator } {expr {[set res [TestOp ** -$big -1.0]]   > -1 && $res < 0}} 1
test mathop-25.32 { exp operator } {expr {[set res [TestOp ** -$big -2.0]]   >  0 && $res < 1}} 1
test mathop-25.33 { exp operator } {expr {[set res [TestOp ** -$big -3.0]]   > -1 && $res < 0}} 1
test mathop-25.34 { exp operator } {TestOp ** $big -1e-30} 1.0
test mathop-25.35 { exp operator } {TestOp ** $big -1e+30} 0.0
test mathop-25.36 { exp operator } {TestOp **    0  $big}             0
test mathop-25.37 { exp operator } {TestOp **    1  $big}             1
test mathop-25.38 { exp operator } {TestOp **   -1  $big}            -1
test mathop-25.39 { exp operator } {TestOp **   -1  [expr {$big+1}]}  1
test mathop-25.40 { exp operator (small exponent power helper and its boundaries) } {
    set pwr 0
    set res 1
    while {[incr pwr] <= 17 && [set i [TestOp ** 15 $pwr]] == [set res [expr {$res * 15}]]} {}
    list [incr pwr -1] $res
} {17 98526125335693359375}
test mathop-25.41 { exp operator errors } {
test mathop-25.23 { exp operator errors } {
    set res {}
    set exp {}

    set huge     [string repeat 145782 1000]
    set big      12135435435354435435342423948763867876
    set wide                             12345678912345
    set small                                         2

    lappend res [TestOp ** 0 -5]
    lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}"
    lappend res [TestOp ** 0.0 -5.0]
    lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}"
    lappend res [TestOp ** $small $wide]
    lappend exp "exponent too large NONE"
    lappend res [TestOp ** 2 $big]
    lappend exp "exponent too large NONE"
    lappend res [TestOp ** $huge 2.1]
    lappend exp "Inf"
    lappend res [TestOp ** 2 foo]
    lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
    lappend res [TestOp ** foo 2]
    lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"

    expr {$res eq $exp ? 0 : $res}
} 0

test mathop-26.1 { misc ops, size combinations } {
    set big1      12135435435354435435342423948763867876
    set big2       2746237174783836746262564892918327847
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
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397

1398
1399
1400
1401
1402
1403
1404
1405
1406
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
+









    lappend res [TestOp - 0 -9223372036854775808]         ;# -2**63
    lappend res [TestOp / -9223372036854775808 -1]
    lappend res [TestOp * 2147483648 2]
    lappend res [TestOp * 9223372036854775808 2]
    set res
} [list 2147483648 9223372036854775808 9223372036854775808 4294967296 18446744073709551616]

test mathop-27.1 {lt operator} {::tcl::mathop::lt} 1
test mathop-27.2 {lt operator} {::tcl::mathop::lt a} 1
test mathop-27.3 {lt operator} {::tcl::mathop::lt a b} 1
test mathop-27.4 {lt operator} {::tcl::mathop::lt b a} 0
test mathop-27.5 {lt operator} {::tcl::mathop::lt a a} 0
test mathop-27.6 {lt operator} {::tcl::mathop::lt a b c} 1
test mathop-27.7 {lt operator} {::tcl::mathop::lt b a c} 0
test mathop-27.8 {lt operator} {::tcl::mathop::lt a c b} 0
test mathop-27.9 {lt operator} {::tcl::mathop::lt 012 0x0} 1

test mathop-28.1 {le operator} {::tcl::mathop::le} 1
test mathop-28.2 {le operator} {::tcl::mathop::le a} 1
test mathop-28.3 {le operator} {::tcl::mathop::le a b} 1
test mathop-28.4 {le operator} {::tcl::mathop::le b a} 0
test mathop-28.5 {le operator} {::tcl::mathop::le a a} 1
test mathop-28.6 {le operator} {::tcl::mathop::le a b c} 1
test mathop-28.7 {le operator} {::tcl::mathop::le b a c} 0
test mathop-28.8 {le operator} {::tcl::mathop::le a c b} 0
test mathop-28.9 {le operator} {::tcl::mathop::le 012 0x0} 1

test mathop-29.1 {gt operator} {::tcl::mathop::gt} 1
test mathop-29.2 {gt operator} {::tcl::mathop::gt a} 1
test mathop-29.3 {gt operator} {::tcl::mathop::gt a b} 0
test mathop-29.4 {gt operator} {::tcl::mathop::gt b a} 1
test mathop-29.5 {gt operator} {::tcl::mathop::gt a a} 0
test mathop-29.6 {gt operator} {::tcl::mathop::gt c b a} 1
test mathop-29.7 {gt operator} {::tcl::mathop::gt b a c} 0
test mathop-29.8 {gt operator} {::tcl::mathop::gt a c b} 0
test mathop-29.9 {gt operator} {::tcl::mathop::gt 0x0 012} 1

test mathop-30.1 {ge operator} {::tcl::mathop::ge} 1
test mathop-30.2 {ge operator} {::tcl::mathop::ge a} 1
test mathop-30.3 {ge operator} {::tcl::mathop::ge a b} 0
test mathop-30.4 {ge operator} {::tcl::mathop::ge b a} 1
test mathop-30.5 {ge operator} {::tcl::mathop::ge a a} 1
test mathop-30.6 {ge operator} {::tcl::mathop::ge c b a} 1
test mathop-30.7 {ge operator} {::tcl::mathop::ge b a c} 0
test mathop-30.8 {ge operator} {::tcl::mathop::ge a c b} 0
test mathop-30.9 {ge operator} {::tcl::mathop::ge 0x0 012} 1

if 0 {
    # Compare ops to expr bytecodes
    namespace import ::tcl::mathop::*
    proc _X {a b c} {
        set x [+ $a [- $b $c]]
        set y [expr {$a + ($b - $c)}]
        set z [< $a $b $c]
    }
    set ::tcl_traceCompile 2
    _X 3 4 5
    set ::tcl_traceCompile 0
}


# cleanup
namespace delete ::testmathop
namespace delete ::testmathop2
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/misc.test.

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
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







-
-
+
+



-
-
-





-
+
















-
+
















-
+
+
+
+
+
+












# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]

test misc-1.1 {error in variable ref. in command in array reference} {
    proc tstProc {} {
	global a

    
	set tst $a([winfo name $zz])
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
    }
    set msg {}
    list [catch tstProc msg] $msg
} {1 {can't read "zz": no such variable}}
test misc-1.2 {error in variable ref. in command in array reference} {
    proc tstProc {} "
	global a

    
	set tst \$a(\[winfo name \$\{zz)
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
    "
    set msg {}
    join [list [catch tstProc msg] $msg $::errorInfo] \n
} [subst -novariables -nocommands {1
missing close-brace for variable name
missing close-brace for variable name
    while executing
"set tst $a([winfo name $\{"
"set tst $a([winfo name $\{zz)
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a ..."
    (procedure "tstProc" line 4)
    invoked from within
"tstProc"}]

for {set i 1} {$i<300} {incr i} {
    test misc-2.$i {hash table with sys-alloc} testhashsystemhash \
	    "testhashsystemhash $i" OK
}

# cleanup
::tcltest::cleanupTests
return

Changes to tests/msgcat.test.

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
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







-
-
-
+
+
+
+

-
-
+
+













-
-

















-
+



-

-
-
-

-











-







#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Note that after running these tests, entries will be left behind in the
# message catalogs for locales foo, foo_BAR, and foo_BAR_baz.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require Tcl 8.5
if {[catch {package require tcltest 2}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2 required."
    return
}
if {[catch {package require msgcat 1.6}]} {
    puts stderr "Skipping tests in [info script].  No msgcat 1.6 found to test."
if {[catch {package require msgcat 1.5}]} {
    puts stderr "Skipping tests in [info script].  No msgcat 1.5 found to test."
    return
}

namespace eval ::msgcat::test {
    namespace import ::msgcat::*
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests
    namespace import ::tcltest::temporaryDirectory
    namespace import ::tcltest::make*
    namespace import ::tcltest::remove*

    # Tests msgcat-0.*: locale initialization

    # Calculate set of all permutations of a list
    # PowerSet {1 2 3} -> {1 2 3} {2 3} {1 3} 3 {1 2} 2 1 {}
    proc PowerSet {l} {
	if {[llength $l] == 0} {return [list [list]]}
	set element [lindex $l 0]
	set rest [lrange $l 1 end]
	set result [list]
	foreach x [PowerSet $rest] {
	    lappend result [linsert $x 0 $element]
	    lappend result $x
	}
	return $result
    }

    variable envVars {LC_ALL LC_MESSAGES LANG}
    variable count 0
    variable body
    variable result
    variable setVars
    foreach setVars [PowerSet $envVars] {
    foreach setVars [PowerSet $envVars] { 
	set result [string tolower [lindex $setVars 0]]
	if {[string length $result] == 0} {
	    if {[info exists ::tcl::mac::locale]} {
if {[package vsatisfies [package provide msgcat] 1.7]} {
		set result [string tolower \
			[msgcat::mcutil::ConvertLocale $::tcl::mac::locale]]
} else {
		set result [string tolower \
			[msgcat::ConvertLocale $::tcl::mac::locale]]
}
	    } else {
		if {([info sharedlibextension] eq ".dll")
			&& ![catch {package require registry}]} {
		    # Windows and Cygwin have other ways to determine the
		    # locale when the environment variables are missing
		    # and the registry package is present
		    continue
		}
		set result c
	    }
	}

	test msgcat-0.$count [list \
	    locale initialization from environment variables $setVars \
	] -setup {
	    variable var
	    foreach var $envVars {
		catch {variable $var $::env($var)}
		unset -nocomplain ::env($var)
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
87
88
89
90
91
92
93

94
95
96
97
98
99
100
101







-
+







		unset -nocomplain ::env($var)
		catch {set ::env($var) [set [namespace current]::$var]}
	    }
	} -body {i eval msgcat::mclocale} -result $result
	incr count
    }
    unset -nocomplain result

    
    # Could add tests of initialization from Windows registry here.
    # Use a fake registry package.

    # Tests msgcat-1.*: [mclocale], [mcpreferences]

    test msgcat-1.3 {mclocale set, single element} -setup {
	variable locale [mclocale]
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
186
187
188
189
190
191
192






















193
194
195
196
197
198
199







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    test msgcat-1.13 {mclocale set, reject evil input} -setup {
	variable locale [mclocale]
    } -cleanup {
	mclocale $locale
    } -body {
	mclocale looks/ok/../../../../but/is/path/to/evil/code
    } -returnCodes error -match glob -result {invalid newLocale value *}

    test msgcat-1.14 {mcpreferences, custom locale preferences} -setup {
	variable locale [mclocale]
	mclocale en
	mcpreferences fr en {}
    } -cleanup {
	mclocale $locale
    } -body {
	mcpreferences
    } -result {fr en {}}

    test msgcat-1.15 {mcpreferences, overwrite custom locale preferences}\
    -setup {
	variable locale [mclocale]
	mcpreferences fr en {}
	mclocale en
    } -cleanup {
	mclocale $locale
    } -body {
	mcpreferences
    } -result {en {}}


    # Tests msgcat-2.*: [mcset], [mcmset], namespace partitioning

    test msgcat-2.1 {mcset, global scope} {
	namespace eval :: ::msgcat::mcset  foo_BAR text1 text2
    } {text2}

316
317
318
319
320
321
322
323

324
325
326
327



328
329
330
331
332
333
334
287
288
289
290
291
292
293

294
295



296
297
298
299
300
301
302
303
304
305







-
+

-
-
-
+
+
+







    #     ov1 should be resolved in foo
    #     ov1 should resolve to foo in foo_BAR, foo_BAR_baz
    #     ov4 should be resolved in none, and call mcunknown
    #
    variable count 2
    variable result
    array set result {
	foo,ov0 ov0_ROOT foo,ov1 ov1_foo foo,ov2 ov2_foo
	foo,ov0 ov0_ROOT foo,ov1 ov1_foo foo,ov2 ov2_foo 
        foo,ov3 ov3_foo foo,ov4 ov4
	foo_BAR,ov0 ov0_ROOT foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR
        foo_BAR,ov3 ov3_foo_BAR	foo_BAR,ov4 ov4
        foo_BAR_baz,ov0 ov0_ROOT foo_BAR_baz,ov1 ov1_foo
	foo_BAR,ov0 ov0_ROOT foo_BAR,ov1 ov1_foo foo_BAR,ov2 ov2_foo_BAR 
        foo_BAR,ov3 ov3_foo_BAR	foo_BAR,ov4 ov4 
        foo_BAR_baz,ov0 ov0_ROOT foo_BAR_baz,ov1 ov1_foo 
        foo_BAR_baz,ov2 ov2_foo_BAR
	foo_BAR_baz,ov3 ov3_foo_BAR_baz foo_BAR_baz,ov4 ov4
    }
    variable loc
    variable string
    foreach loc {foo foo_BAR foo_BAR_baz} {
	foreach string {ov0 ov1 ov2 ov3 ov4} {
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
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







-
-
-



-
-













-
-









-
-







	}
	makeFile [list ::msgcat::mcset $loc abc abc-$loc] $msg.msg $msgdir
    }
    variable count 1
    foreach loc {foo foo_BAR foo_BAR_baz} {
	test msgcat-5.$count {mcload} -setup {
	    variable locale [mclocale]
	    ::msgcat::mclocale ""
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder
	    mclocale $loc
	} -cleanup {
	    mclocale $locale
	    ::msgcat::mcloadedlocales clear
	    ::msgcat::mcpackageconfig unset mcfolder
	} -body {
	    mcload $msgdir
	} -result [expr { $count+1 }]
	incr count
    }

    # Even though foo_BAR_notexist does not exist,
    # foo_BAR, foo and the root should be loaded.
	test msgcat-5.4 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo_BAR_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -body {
	    mcload $msgdir
	} -result 3

	test msgcat-5.5 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale no_FI_notexist
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -body {
	    mcload $msgdir
	} -result 1

	test msgcat-5.6 {mcload} -setup {
	    variable locale [mclocale]
	    mclocale foo
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
+







	    mclocale $locale
	    rename ::msgcat::mcunknown {}
	    rename SavedMcunknown ::msgcat::mcunknown
	} -body {
	    mc def
	} -result unknown:no_fi_notexist:def

	test msgcat-5.11 {mcpackageconfig mcfolder} -setup {
	    variable locale [mclocale]
	    mclocale ""
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -cleanup {
	    mclocale $locale
	    mcloadedlocales clear
	    mcpackageconfig unset mcfolder
	} -body {
	    mclocale foo
	    mcpackageconfig set mcfolder $msgdir
	} -result 2

    foreach loc $locales {
	if { $loc eq {} } {
	    set msg ROOT
        } else {
	    set msg [string tolower $loc]
	}
	removeFile $msg.msg $msgdir
    }
    removeDirectory msgdir

    # Tests msgcat-6.*: [mcset], [mc] namespace inheritance
#
# Test mcset and mc, ensuring that resolution for messages
# proceeds from the current ns to its parent and so on to the
# proceeds from the current ns to its parent and so on to the 
# global ns.
#
# Do this for the 12 permutations of
#     locales: foo
#     namespaces: foo foo::bar foo::bar::baz
#     strings: {ov1 ov2 ov3 ov4}
#     namespace ::foo            defines ov1, ov2, ov3
602
603
604
605
606
607
608
609

610
611
612
613
614
615
616
550
551
552
553
554
555
556

557
558
559
560
561
562
563
564







-
+







		    namespace eval bar {
			::msgcat::mcset foo ov2 ov2_foo_bar
			::msgcat::mcset foo ov3 ov3_foo_bar
			namespace eval baz {
			    ::msgcat::mcset foo ov3 "ov3_foo_bar_baz"
			}
		    }

		    
		}
		variable locale [mclocale]
		mclocale foo
	    } -cleanup {
		mclocale $locale
		namespace delete foo
	    } -body {
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
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
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
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
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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
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










-
+


-
+






-
-
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-
-
    removeFile l1.msg $msgdir1
    removeDirectory msgdir1

    set msgdir2 [makeDirectory msgdir2]
    set msgdir3 [makeDirectory msgdir3]
    makeFile "::msgcat::mcflset k2 v2 ; ::msgcat::mcload [list $msgdir3]"\
	    l2.msg $msgdir2
    makeFile {::msgcat::mcflset k3 v3 ; ::msgcat::mcflmset {k4 v4 k5 v5}} l2.msg $msgdir3
    makeFile {::msgcat::mcflset k3 v3} l2.msg $msgdir3

	# chained mcload
	test msgcat-8.2 {mcflset/mcflmset} -setup {
	test msgcat-8.2 {mcflset} -setup {
	    variable locale [mclocale]
	    mclocale l2
	    mcload $msgdir2
	} -cleanup {
	    mclocale $locale
	} -body {
	    return [mc k2][mc k3]--[mc k4][mc k5]
	} -result v2v3--v4v5
	    return [mc k2][mc k3]
	} -result v2v3

    removeFile l2.msg $msgdir2
    removeDirectory msgdir2
    removeDirectory msgdir3

    # Tests msgcat-9.*: [mcexists]

	test msgcat-9.1 {mcexists no parameter} -body {
	    mcexists
	} -returnCodes 1\
	-result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? ?-namespace ns? src"}

	test msgcat-9.2 {mcexists unknown option} -body {
	    mcexists -unknown src
	} -returnCodes 1\
	-result {unknown option "-unknown"}

	test msgcat-9.3 {mcexists} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    list [mcexists k1] [mcexists k2]
	} -result {1 0}

	test msgcat-9.4 {mcexists descendent preference} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	} -body {
	    list [mcexists k1] [mcexists -exactlocale k1]
	} -result {1 0}

	test msgcat-9.5 {mcexists parent namespace} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	    namespace delete ::foo
	} -body {
	    namespace eval ::foo {
		list [::msgcat::mcexists k1]\
			[::msgcat::mcexists -namespace ::msgcat::test k1]
	    }
	} -result {0 1}

	test msgcat-9.6 {mcexists -namespace ns parameter} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale foo_bar
	    mcset foo k1 v1
	} -cleanup {
	    mclocale $locale
	    namespace delete ::foo
	} -body {
	    namespace eval ::foo {
		list [::msgcat::mcexists k1]\
			[::msgcat::mcexists -namespace ::msgcat::test k1]
	    }
	} -result {0 1}

	test msgcat-9.7 {mcexists -namespace - ns argument missing} -body {
	    mcexists -namespace src
	} -returnCodes 1\
	-result {Argument missing for switch "-namespace"}


    # Tests msgcat-10.*: [mcloadedlocales]

	test msgcat-10.1 {mcloadedlocales no arg} -body {
	    mcloadedlocales
	} -returnCodes 1\
	-result {wrong # args: should be "mcloadedlocales subcommand"}

	test msgcat-10.2 {mcloadedlocales wrong subcommand} -body {
	    mcloadedlocales junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, or loaded}

	test msgcat-10.3 {mcloadedlocales loaded} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo_bar
	    # The result is position independent so sort
	    set resultlist [lsort [mcloadedlocales loaded]]
	} -result {{} foo foo_bar}

	test msgcat-10.4 {mcloadedlocales clear} -setup {
	    mcforgetpackage
	    variable locale [mclocale]
	    mclocale {}
	    mcloadedlocales clear
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcset foo k1 v1
	    set res [mcexists k1]
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    lappend res [mcexists k1]
	} -result {1 0}

    # Tests msgcat-11.*: [mcforgetpackage]

	test msgcat-11.1 {mcforgetpackage translation} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcset foo k1 v1
	    set res [mcexists k1]
	    mcforgetpackage
	    lappend res [mcexists k1]
	} -result {1 0}

	test msgcat-11.2 {mcforgetpackage locale} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	} -body {
	    mclocale foo
	    mcpackagelocale set bar
	    set res [mcpackagelocale get]
	    mcforgetpackage
	    lappend res [mcpackagelocale get]
	} -result {bar foo}

	test msgcat-11.3 {mcforgetpackage options} -body {
	    mcpackageconfig set loadcmd ""
	    set res [mcpackageconfig isset loadcmd]
	    mcforgetpackage
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {1 0}

    # Tests msgcat-12.*: [mcpackagelocale]

	test msgcat-12.1 {mcpackagelocale no subcommand} -body {
	    mcpackagelocale
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackagelocale subcommand ?arg ...?"}

	test msgcat-12.2 {mclpackagelocale wrong subcommand} -body {
	    mcpackagelocale junk
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset}

	test msgcat-12.2.1 {mclpackagelocale set multiple args} -body {
	    mcpackagelocale set a b
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackagelocale set ?locale?"}

	test msgcat-12.3 {mcpackagelocale set} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    mcpackagelocale set bar
	    list [mcpackagelocale get] [mclocale]
	} -result {bar foo}

	test msgcat-12.4 {mcpackagelocale get} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [mcpackagelocale get]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale get]
	} -result {foo bar}

	test msgcat-12.5 {mcpackagelocale preferences} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [list [mcpackagelocale preferences]]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale preferences]
	} -result {{foo {}} {bar {}}}

	test msgcat-12.6 {mcpackagelocale loaded} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    # The result is position independent so sort
	    set res [list [lsort [mcpackagelocale loaded]]]
	    mcpackagelocale set bar
	    lappend res [lsort [mcpackagelocale loaded]]
	} -result {{{} foo} {{} bar foo}}

	test msgcat-12.7 {mcpackagelocale isset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [mcpackagelocale isset]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale isset]
	} -result {0 1}

	test msgcat-12.8 {mcpackagelocale unset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mcpackagelocale set bar
	    set res [mcpackagelocale isset]
	    mcpackagelocale unset
	    lappend res [mcpackagelocale isset]
	} -result {1 0}

	test msgcat-12.9 {mcpackagelocale present} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    set res [mcpackagelocale present foo]
	    lappend res [mcpackagelocale present bar]
	    mcpackagelocale set bar
	    lappend res [mcpackagelocale present foo]\
		    [mcpackagelocale present bar]
	} -result {1 0 1 1}

	test msgcat-12.10 {mcpackagelocale clear} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale ""
	    mcloadedlocales clear
	    mclocale foo
	    mcpackagelocale set bar
	    mcpackagelocale clear
	    list [mcpackagelocale present foo] [mcpackagelocale present bar]
	} -result {0 1}

	test msgcat-12.11 {mcpackagelocale custom preferences} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    set res [list [mcpackagelocale preferences]]
	    mcpackagelocale preferences bar {}
	    lappend res [mcpackagelocale preferences]
	} -result {{foo {}} {bar {}}}

	test msgcat-12.12 {mcpackagelocale preferences -> no isset} -setup {
	    variable locale [mclocale]
	} -cleanup {
	    mclocale $locale
	    mcforgetpackage
	} -body {
	    mclocale foo
	    mcpackagelocale preferences
	    mcpackagelocale isset
	} -result {0}


    # Tests msgcat-13.*: [mcpackageconfig subcmds]

	test msgcat-13.1 {mcpackageconfig no subcommand} -body {
	    mcpackageconfig
	} -returnCodes 1\
	-result {wrong # args: should be "mcpackageconfig subcommand option ?value?"}

	test msgcat-13.2 {mclpackageconfig wrong subcommand} -body {
	    mcpackageconfig junk mcfolder
	} -returnCodes 1\
	-result {unknown subcommand "junk": must be get, isset, set, or unset}

	test msgcat-13.3 {mclpackageconfig wrong option} -body {
	    mcpackageconfig get junk
	} -returnCodes 1\
	-result {bad option "junk": must be mcfolder, loadcmd, changecmd, or unknowncmd}

	test msgcat-13.4 {mcpackageconfig get} -setup {
	    mcforgetpackage
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd ""
	    mcpackageconfig get loadcmd
	} -result {}

	test msgcat-13.5 {mcpackageconfig (is/un)set} -setup {
	    mcforgetpackage
	} -cleanup {
	    mcforgetpackage
	} -body {
	    set res [mcpackageconfig isset loadcmd]
	    lappend res [mcpackageconfig set loadcmd ""]
	    lappend res [mcpackageconfig isset loadcmd]
	    mcpackageconfig unset loadcmd
	    lappend res [mcpackageconfig isset loadcmd]
	} -result {0 0 1 0}

    # option mcfolder is already tested with 5.11

    # Tests msgcat-14.*: callbacks: loadcmd, changecmd, unknowncmd

    # This routine is used as bgerror and by direct callback invocation
    proc callbackproc args {
	variable resultvariable
	set resultvariable $args
    }
    proc callbackfailproc args {
	return -code error fail
    }
    set bgerrorsaved [interp bgerror {}]
    interp bgerror {} [namespace code callbackproc]

    variable locale
    if {![info exist locale]} { set locale [mclocale] }

	test msgcat-14.1 {invokation loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackproc]
	    mclocale foo_bar
	    lsort $resultvariable
	} -result {foo foo_bar}

	test msgcat-14.2 {invokation failed in loadcmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	} -cleanup {
	    mcforgetpackage
	    after cancel set [namespace current]::resultvariable timeout
	} -body {
	    mcpackageconfig set loadcmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    # let the bgerror run
	    after 100 set [namespace current]::resultvariable timeout
	    vwait [namespace current]::resultvariable
	    lassign $resultvariable err errdict
	    list $err [dict get $errdict -code]
	} -result {fail 1}

	test msgcat-14.3 {invokation changecmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set changecmd [namespace code callbackproc]
	    mclocale foo_bar
	    set resultvariable
	} -result {foo_bar foo {}}

	test msgcat-14.4 {invokation unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set unknowncmd [namespace code callbackproc]
	    mclocale foo_bar
	    mc k1 p1
	    set resultvariable
	} -result {foo_bar k1 p1}

	test msgcat-14.5 {disable global unknowncmd} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	    rename ::msgcat::mcunknown SavedMcunknown
	    proc ::msgcat::mcunknown {dom s} {
		return unknown:$dom:$s
	    }
	} -cleanup {
	    mcforgetpackage
	    rename ::msgcat::mcunknown {}
	    rename SavedMcunknown ::msgcat::mcunknown
	} -body {
	    mcpackageconfig set unknowncmd ""
	    mclocale foo_bar
	    mc k1%s p1
	} -result {k1p1}

	test msgcat-14.6 {unknowncmd failing} -setup {
	    mcforgetpackage
    	    mclocale $locale
	    mclocale ""
	    mcloadedlocales clear
	    set resultvariable ""
	} -cleanup {
	    mcforgetpackage
	} -body {
	    mcpackageconfig set unknowncmd [namespace code callbackfailproc]
	    mclocale foo_bar
	    mc k1
	} -returnCodes 1\
	-result {fail}


    # Tests msgcat-15.*: tcloo coverage

    # There are 4 use-cases, where 3 must be tested now:
    # - namespace defined, in class definition, class defined oo, classless

    test msgcat-15.1 {mc in class setup} -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::class create ClassCur
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace delete bar
    } -body {
	oo::define bar::ClassCur msgcat::mc con2
    } -result con2bar

    test msgcat-15.2 {mc in class} -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::class create ClassCur
	    oo::define ClassCur method method1 {} {::msgcat::mc con2}
	}
	# full namespace is ::msgcat::test:baz
	namespace eval baz {
            set ObjCur [::msgcat::test::bar::ClassCur new]
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace delete bar baz
    } -body {
	$baz::ObjCur method1
    } -result con2bar

    test msgcat-15.3 {mc in classless object} -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {::msgcat::mc con2}
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace delete bar
    } -body {
	bar::ObjCur method1
    } -result con2bar

    test msgcat-15.4 {mc in classless object with explicite namespace eval}\
    -setup {
	# full namespace is ::msgcat::test:bar
	namespace eval bar {
	    ::msgcat::mcset foo_BAR con2 con2bar
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {
		namespace eval ::msgcat::test::baz {
		    ::msgcat::mc con2
		}
	    }
	}
	namespace eval baz {
	    ::msgcat::mcset foo_BAR con2 con2baz
	}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
	namespace eval bar {::msgcat::mcforgetpackage}
	namespace eval baz {::msgcat::mcforgetpackage}
	namespace delete bar baz
    } -body {
	bar::ObjCur method1
    } -result con2baz

    # Test msgcat-16.*: command mcpackagenamespaceget

    test msgcat-16.1 {mcpackagenamespaceget in namespace procedure} -body {
	namespace eval baz {msgcat::mcpackagenamespaceget}
    } -result ::msgcat::test::baz

    test msgcat-16.2 {mcpackagenamespaceget in class setup} -setup {
	namespace eval bar {
	    oo::class create ClassCur
	    oo::define ClassCur variable a
	}
    } -cleanup {
	namespace delete bar
    } -body {
	oo::define bar::ClassCur msgcat::mcpackagenamespaceget
    } -result ::msgcat::test::bar

    test msgcat-16.3 {mcpackagenamespaceget in class} -setup {
	namespace eval bar {
	    oo::class create ClassCur
	    oo::define ClassCur method method1 {} {msgcat::mcpackagenamespaceget}
	}
	namespace eval baz {
            set ObjCur [::msgcat::test::bar::ClassCur new]
	}
    } -cleanup {
	namespace delete bar baz
    } -body {
	$baz::ObjCur method1
    } -result ::msgcat::test::bar

    test msgcat-16.4 {mcpackagenamespaceget in classless object} -setup {
	namespace eval bar {
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {msgcat::mcpackagenamespaceget}
	}
    } -cleanup {
	namespace delete bar
    } -body {
	bar::ObjCur method1
    } -result ::msgcat::test::bar

    test msgcat-16.5\
    {mcpackagenamespaceget in classless object with explicite namespace eval}\
    -setup {
	namespace eval bar {
	    oo::object create ObjCur
	    oo::objdefine ObjCur method method1 {} {
		namespace eval ::msgcat::test::baz {
		    msgcat::mcpackagenamespaceget
		}
	    }
	}
    } -cleanup {
	namespace delete bar baz
    } -body {
	bar::ObjCur method1
    } -result ::msgcat::test::baz


    # Test msgcat-17.*: mcn command

    test msgcat-17.1 {mcn no parameters} -body {
	mcn
    } -returnCodes 1\
    -result {wrong # args: should be "mcn ns src ?arg ...?"}

    test msgcat-17.2 {mcn} -setup {
	namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar}
	variable locale [mclocale]
	mclocale foo_BAR
    } -cleanup {
	mclocale $locale
    } -body {
	::msgcat::mcn [namespace current]::bar con1
    } -result con1bar


    interp bgerror {} $bgerrorsaved

    # Tests msgcat-18.*: [mcutil]

    test msgcat-18.1 {mcutil - no argument} -body {
	mcutil
    } -returnCodes 1\
    -result {wrong # args: should be "mcutil subcommand ?arg ...?"}

    test msgcat-18.2 {mcutil - wrong argument} -body {
	mcutil junk
    } -returnCodes 1\
    -result {unknown subcommand "junk": must be getpreferences, or getsystemlocale}

    test msgcat-18.3 {mcutil - partial argument} -body {
	mcutil getsystem
    } -returnCodes 1\
    -result {unknown subcommand "getsystem": must be getpreferences, or getsystemlocale}

    test msgcat-18.4 {mcutil getpreferences - no argument} -body {
	mcutil getpreferences
    } -returnCodes 1\
    -result {wrong # args: should be "mcutil getpreferences locale"}

    test msgcat-18.5 {mcutil getpreferences - DE_de} -body {
	mcutil getpreferences DE_de
    } -result {de_de de {}}

    test msgcat-18.6 {mcutil getsystemlocale - wrong argument} -body {
	mcutil getsystemlocale DE_de
    } -returnCodes 1\
    -result {wrong # args: should be "mcutil getsystemlocale"}

    # The result is system dependent
    # So just test if it runs
    # The environment variable version was test with test 0.x
    test msgcat-18.7 {mcutil getsystemlocale} -body {
	mcutil getsystemlocale
	set ok ok
    } -result {ok}


    cleanupTests
}
namespace delete ::msgcat::test
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/namespace-old.test.

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
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







-
-
+
+





-
+



+



+



+






+



+



+



+



+








-
-
-
-
-
+
-



+



+



+








-
-
-
-
-
+
-



+






+









+


















+




+






+





+



-
-







+



+



+



+



+



+



+



+










+








+



+







# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.2
    namespace import -force ::tcltest::*
}

# Clear out any namespaces called test_ns_*
catch {namespace delete {*}[namespace children :: test_ns_*]}


test namespace-old-1.1 {usage for "namespace" command} {
    list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}

test namespace-old-1.2 {global namespace's name is "::" or {}} {
    list [namespace current] [namespace eval {} {namespace current}]
} {:: ::}

test namespace-old-1.3 {usage for "namespace eval"} {
    list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

test namespace-old-1.4 {create new namespaces} {
    list [lsort [namespace children :: test_ns_simple*]] \
	 [namespace eval test_ns_simple {}] \
	 [namespace eval test_ns_simple2 {}] \
         [lsort [namespace children :: test_ns_simple*]]
} {{} {} {} {::test_ns_simple ::test_ns_simple2}}

test namespace-old-1.5 {access a new namespace} {
    namespace eval test_ns_simple { namespace current }
} {::test_ns_simple}

test namespace-old-1.6 {usage for "namespace eval"} {
    list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

test namespace-old-1.7 {usage for "namespace eval"} {
    list [catch {namespace eval test_ns_xyzzy} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}

test namespace-old-1.8 {command "namespace eval" concatenates args} {
    namespace eval test_ns_simple namespace current
} {::test_ns_simple}

test namespace-old-1.9 {add elements to a namespace} {
    namespace eval test_ns_simple {
        variable test_ns_x 0
        proc test {test_ns_x} {
            return "test: $test_ns_x"
        }
    }
} {}
namespace eval test_ns_simple {
    variable test_ns_x 0
    proc test {test_ns_x} {
	return "test: $test_ns_x"
    }

}
test namespace-old-1.10 {commands in a namespace} {
    namespace eval test_ns_simple { info commands [namespace current]::*}
} {::test_ns_simple::test}

test namespace-old-1.11 {variables in a namespace} {
    namespace eval test_ns_simple { info vars [namespace current]::* }
} {::test_ns_simple::test_ns_x}

test namespace-old-1.12 {global vars are separate from locals vars} {
    list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
} {{test: 123} 0}

test namespace-old-1.13 {add to an existing namespace} {
    namespace eval test_ns_simple {
        variable test_ns_y 123
        proc _backdoor {cmd} {
            eval $cmd
        }
    }
} ""
namespace eval test_ns_simple {
    variable test_ns_y 123
    proc _backdoor {cmd} {
	eval $cmd
    }

}
test namespace-old-1.14 {commands in a namespace} {
    lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
} {::test_ns_simple::_backdoor ::test_ns_simple::test}

test namespace-old-1.15 {variables in a namespace} {
    lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
test namespace-old-1.16 {variables in a namespace} {
    lsort [info vars test_ns_simple::*]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

test namespace-old-1.17 {commands in a namespace are hidden} {
    list [catch "_backdoor {return yes!}" msg] $msg
} {1 {invalid command name "_backdoor"}}
test namespace-old-1.18 {using namespace qualifiers} {
    list [catch "test_ns_simple::_backdoor {return yes!}" msg] $msg
} {0 yes!}
test namespace-old-1.19 {using absolute namespace qualifiers} {
    list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
} {0 yes!}

test namespace-old-1.20 {variables in a namespace are hidden} {
    list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
} {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
test namespace-old-1.21 {using namespace qualifiers} {
    list [catch "set test_ns_simple::test_ns_x" msg] $msg \
         [catch "set test_ns_simple::test_ns_y" msg] $msg
} {0 0 0 123}
test namespace-old-1.22 {using absolute namespace qualifiers} {
    list [catch "set ::test_ns_simple::test_ns_x" msg] $msg \
         [catch "set ::test_ns_simple::test_ns_y" msg] $msg
} {0 0 0 123}
test namespace-old-1.23 {variables can be accessed within a namespace} {
    test_ns_simple::_backdoor {
        variable test_ns_x
        variable test_ns_y
        return "$test_ns_x $test_ns_y"
    }
} {0 123}

test namespace-old-1.24 {setting global variables} {
    test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}
    namespace eval test_ns_simple {set test_ns_x}
} {new val}

test namespace-old-1.25 {qualified variables don't need a global declaration} {
    namespace eval test_ns_another { variable test_ns_x 456 }
    set cmd {set ::test_ns_another::test_ns_x}
    list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
         [eval $cmd]
} {0 some-value some-value}

test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
    namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
    set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
    list [test_ns_simple::_backdoor $cmd] [eval $cmd]
} {{12 34} {12 34}}

test namespace-old-1.27 {can create commands with null names} {
    proc test_ns_simple:: {args} {return $args}
} {}
# Redeclare; later tests depend on it
proc test_ns_simple:: {args} {return $args}

# -----------------------------------------------------------------------
# TEST: using "info" in namespace contexts
# -----------------------------------------------------------------------
test namespace-old-2.1 {querying:  info commands} {
    lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
} {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}

test namespace-old-2.2 {querying:  info procs} {
    lsort [test_ns_simple::_backdoor {info procs}]
} {{} _backdoor test}

test namespace-old-2.3 {querying:  info vars} {
    lsort [info vars test_ns_simple::*]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

test namespace-old-2.4 {querying:  info vars} {
    lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
} {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}

test namespace-old-2.5 {querying:  info locals} {
    lsort [test_ns_simple::_backdoor {info locals}]
} {cmd}

test namespace-old-2.6 {querying:  info exists} {
    test_ns_simple::_backdoor {info exists test_ns_x}
} {0}

test namespace-old-2.7 {querying:  info exists} {
    test_ns_simple::_backdoor {info exists cmd}
} {1}

test namespace-old-2.8 {querying:  info args} {
    info args test_ns_simple::_backdoor
} {cmd}

test namespace-old-2.9 {querying:  info body} {
    string trim [info body test_ns_simple::test]
} {return "test: $test_ns_x"}

# -----------------------------------------------------------------------
# TEST: namespace qualifiers, namespace tail
# -----------------------------------------------------------------------
test namespace-old-3.1 {usage for "namespace qualifiers"} {
    list [catch "namespace qualifiers" msg] $msg
} {1 {wrong # args: should be "namespace qualifiers string"}}

test namespace-old-3.2 {querying:  namespace qualifiers} {
    list [namespace qualifiers ""] \
         [namespace qualifiers ::] \
         [namespace qualifiers x] \
         [namespace qualifiers ::x] \
         [namespace qualifiers foo::x] \
         [namespace qualifiers ::foo::bar::xyz]
} {{} {} {} {} foo ::foo::bar}

test namespace-old-3.3 {usage for "namespace tail"} {
    list [catch "namespace tail" msg] $msg
} {1 {wrong # args: should be "namespace tail string"}}

test namespace-old-3.4 {querying:  namespace tail} {
    list [namespace tail ""] \
         [namespace tail ::] \
         [namespace tail x] \
         [namespace tail ::x] \
         [namespace tail foo::x] \
         [namespace tail ::foo::bar::xyz]
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
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
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
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
611
612
613
614
615
616
617
618
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
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
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
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
611
612











613
614
615
616
617
618
619







+



+






-
-
-
-
-
+
















+



+


+



+


+



+




+






+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-

-
+

-
+

+
-
+




+




+






+






+



+



+



+



+



+



+



+



+



+



+



+






+










-
-




+
+
+
+
+
+



+





+





-
+





-
-
-
+



+
+
+
+
+



+






-
-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+


















-
-
-
-
-
+
-






-
+



-
-
-
+
+
+






-
+
-


-
+

-
+
-
-
-
-
+
+





-
-
-
-
+
+
+
+





+







+









+



-
+





+











+










-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+







+

-
-
+
+







+



+










-
-
-
-
-
-
-
-
-
-
-







            variable var2 2
            proc cmd2 {} {return "cmd2"}
        }
        namespace eval another {}
        lsort [namespace children]
    }
} {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}

test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
    list [catch {namespace delete} msg] $msg
} {0 {}}

test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
    set cmd {
        namespace eval test_ns_delete {namespace delete ns*}
    }
    list [catch $cmd msg] $msg
} {1 {unknown namespace "ns*" in namespace delete command}}
namespace eval test_ns_delete {
    namespace eval ns1 {}
    namespace eval ns2 {}
    namespace eval another {}
}

test namespace-old-4.4 {command "namespace delete" handles multiple args} {
    set cmd {
        namespace eval test_ns_delete {
            namespace delete \
                {*}[namespace children [namespace current] ns?]
        }
    }
    list [catch $cmd msg] $msg [namespace children test_ns_delete]
} {0 {} ::test_ns_delete::another}

# -----------------------------------------------------------------------
# TEST: namespace hierarchy
# -----------------------------------------------------------------------
test namespace-old-5.1 {define nested namespaces} {
    set test_ns_var_global "var in ::"
    proc test_ns_cmd_global {} {return "cmd in ::"}

    namespace eval test_ns_hier1 {
        set test_ns_var_hier1 "particular to hier1"
        proc test_ns_cmd_hier1 {} {return "particular to hier1"}

        set test_ns_level 1
        proc test_ns_show {} {return "[namespace current]: 1"}

        namespace eval test_ns_hier2 {
            set test_ns_var_hier2 "particular to hier2"
            proc test_ns_cmd_hier2 {} {return "particular to hier2"}

            set test_ns_level 2
            proc test_ns_show {} {return "[namespace current]: 2"}

            namespace eval test_ns_hier3a {}
            namespace eval test_ns_hier3b {}
        }

        namespace eval test_ns_hier2a {}
        namespace eval test_ns_hier2b {}
    }
} {}

test namespace-old-5.2 {namespaces can be nested} {
    list [namespace eval test_ns_hier1 {namespace current}] \
         [namespace eval test_ns_hier1 {
              namespace eval test_ns_hier2 {namespace current}
          }]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

test namespace-old-5.3 {namespace qualifiers work in namespace command} {
    list [namespace eval ::test_ns_hier1 {namespace current}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
         [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
set ::test_ns_var_global "var in ::"
proc test_ns_cmd_global {} {return "cmd in ::"}
namespace eval test_ns_hier1 {
    variable test_ns_var_hier1 "particular to hier1"
    proc test_ns_cmd_hier1 {} {return "particular to hier1"}
    variable test_ns_level 1
    proc test_ns_show {} {return "[namespace current]: 1"}
    namespace eval test_ns_hier2 {
	variable test_ns_var_hier2 "particular to hier2"
	proc test_ns_cmd_hier2 {} {return "particular to hier2"}
	variable test_ns_level 2
        proc test_ns_show {} {return "[namespace current]: 2"}
	namespace eval test_ns_hier3a {}
	namespace eval test_ns_hier3b {}
    }

    namespace eval test_ns_hier2a {}
    namespace eval test_ns_hier2b {}
}
# TIP 278: secondary lookup disabled for vars, tests disabled with #
test namespace-old-5.4 {nested namespaces can access global namespace} {
    list [namespace eval test_ns_hier1 {#set test_ns_var_global}] \
    list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {#set test_ns_var_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
} {{} {cmd in ::} {} {cmd in ::}}

test namespace-old-5.5 {variables in different namespaces don't conflict} {
    list [set test_ns_hier1::test_ns_level] \
         [set test_ns_hier1::test_ns_hier2::test_ns_level]
} {1 2}

test namespace-old-5.6 {commands in different namespaces don't conflict} {
    list [test_ns_hier1::test_ns_show] \
         [test_ns_hier1::test_ns_hier2::test_ns_show]
} {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}

test namespace-old-5.7 {nested namespaces don't see variables in parent} {
    set cmd {
        namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
    }
    list [catch $cmd msg] $msg
} {1 {can't read "test_ns_var_hier1": no such variable}}

test namespace-old-5.8 {nested namespaces don't see commands in parent} {
    set cmd {
        namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
    }
    list [catch $cmd msg] $msg
} {1 {invalid command name "test_ns_cmd_hier1"}}

test namespace-old-5.9 {usage for "namespace children"} {
    list [catch {namespace children test_ns_hier1 y z} msg] $msg
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}

test namespace-old-5.10 {command "namespace children" must get valid namespace} -body {
    namespace children xyzzy
} -returnCodes error -result {namespace "xyzzy" not found in "::"}

test namespace-old-5.11 {querying namespace children} {
    lsort [namespace children :: test_ns_hier*]
} {::test_ns_hier1}

test namespace-old-5.12 {querying namespace children} {
    lsort [namespace children test_ns_hier1]
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}

test namespace-old-5.13 {querying namespace children} {
    lsort [namespace eval test_ns_hier1 {namespace children}]
} {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}

test namespace-old-5.14 {querying namespace children} {
    lsort [namespace children test_ns_hier1::test_ns_hier2]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

test namespace-old-5.15 {querying namespace children} {
    lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

test namespace-old-5.16 {querying namespace children with patterns} {
    lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

test namespace-old-5.17 {querying namespace children with patterns} {
    lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
} {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}

test namespace-old-5.18 {usage for "namespace parent"} {
    list [catch {namespace parent x y} msg] $msg
} {1 {wrong # args: should be "namespace parent ?name?"}}

test namespace-old-5.19 {command "namespace parent" must get valid namespace} -body {
    namespace parent xyzzy
} -returnCodes error -result {namespace "xyzzy" not found in "::"}

test namespace-old-5.20 {querying namespace parent} {
    list [namespace eval :: {namespace parent}] \
        [namespace eval test_ns_hier1 {namespace parent}] \
        [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
        [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

test namespace-old-5.21 {querying namespace parent for explicit namespace} {
    list [namespace parent ::] \
         [namespace parent test_ns_hier1] \
         [namespace parent test_ns_hier1::test_ns_hier2] \
         [namespace parent test_ns_hier1::test_ns_hier2::test_ns_hier3a]
} {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}

# -----------------------------------------------------------------------
# TEST: name resolution and caching
# -----------------------------------------------------------------------
set trigger {namespace eval test_ns_cache2 {namespace current}}
set trigger2 {namespace eval test_ns_cache2::test_ns_cache3 {namespace current}}
test namespace-old-6.1 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1 {}
    namespace eval test_ns_cache2 {}
    namespace eval test_ns_cache2::test_ns_cache3 {}
    set trigger {
        namespace eval test_ns_cache2 {namespace current}
    }
    set trigger2 {
        namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
    }
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}

test namespace-old-6.2 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1::test_ns_cache2 {}
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}

test namespace-old-6.3 {relative ns names only looked up in current ns} {
    namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
namespace eval test_ns_cache1::test_ns_cache2 {}

test namespace-old-6.4 {relative ns names only looked up in current ns} {
    namespace delete test_ns_cache1::test_ns_cache2
    list [namespace eval test_ns_cache1 $trigger] \
         [namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
namespace eval test_ns_cache1 {
    proc trigger {} {test_ns_cache_cmd}
}

test namespace-old-6.5 {define test commands} {
    proc test_ns_cache_cmd {} {
        return "global version"
    }
    namespace eval test_ns_cache1 {
        proc trigger {} {
            test_ns_cache_cmd
        }
    }
    test_ns_cache1::trigger
} {global version}

test namespace-old-6.6 {one-level check for command shadowing} {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"
    }
    test_ns_cache1::trigger
} {cache1 version}
proc test_ns_cache_cmd {} {
    return "global version"
}
test namespace-old-6.7 {renaming commands changes command epoch} -setup {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"

test namespace-old-6.7 {renaming commands changes command epoch} {
    namespace eval test_ns_cache1 {
        rename test_ns_cache_cmd test_ns_new
    }
} -body {
    list [test_ns_cache1::trigger] \
	[namespace eval test_ns_cache1 {rename test_ns_cache_cmd test_ns_new}]\
	[test_ns_cache1::trigger]
} -result {{cache1 version} {} {global version}}
test namespace-old-6.8 {renaming back handles shadowing} -setup {
    proc test_ns_cache1::test_ns_new {} {
        return "cache1 version"
    test_ns_cache1::trigger
} {global version}

test namespace-old-6.8 {renaming back handles shadowing} {
    namespace eval test_ns_cache1 {
        rename test_ns_new test_ns_cache_cmd
    }
} -body {
    list [test_ns_cache1::trigger] \
	[namespace eval test_ns_cache1 {rename test_ns_new test_ns_cache_cmd}]\
	[test_ns_cache1::trigger]
} -result {{global version} {} {cache1 version}}
test namespace-old-6.9 {deleting commands changes command epoch} -setup {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"
    test_ns_cache1::trigger
} {cache1 version}

test namespace-old-6.9 {deleting commands changes command epoch} {
    namespace eval test_ns_cache1 {
        rename test_ns_cache_cmd ""
    }
} -body {
    list [test_ns_cache1::trigger] \
	[namespace eval test_ns_cache1 {rename test_ns_cache_cmd ""}] \
	[test_ns_cache1::trigger]
} -result {{cache1 version} {} {global version}}
    test_ns_cache1::trigger
} {global version}

test namespace-old-6.10 {define test namespaces} {
    namespace eval test_ns_cache2 {
        proc test_ns_cache_cmd {} {
            return "global cache2 version"
        }
    }
    namespace eval test_ns_cache1 {
        proc trigger {} {
            test_ns_cache2::test_ns_cache_cmd
        }
    }
    namespace eval test_ns_cache1::test_ns_cache2 {
        proc trigger {} {
            test_ns_cache_cmd
        }
    }
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{global cache2 version} {global version}}
namespace eval test_ns_cache1 {
    proc trigger {} { test_ns_cache2::test_ns_cache_cmd }
    namespace eval test_ns_cache2 {
	proc trigger {} { test_ns_cache_cmd }
    }

}
test namespace-old-6.11 {commands affect all parent namespaces} {
    proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
        return "cache2 version"
    }
    list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{cache2 version} {cache2 version}}
# TIP 278: secondary lookup disabled, catch added, result changed from {global version}

test namespace-old-6.12 {define test variables} {
    variable test_ns_cache_var "global version"
    set trigger {set test_ns_cache_var}
    list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg
} {1 {can't read "test_ns_cache_var": no such variable}}
    set trigger {set test_ns_cache_var}
    namespace eval test_ns_cache1 $trigger
} {global version}

test namespace-old-6.13 {one-level check for variable shadowing} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
    }
    namespace eval test_ns_cache1 $trigger
} {cache1 version}
variable ::test_ns_cache_var "global version"

# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
test namespace-old-6.14 {deleting variables changes variable epoch} {
    namespace eval test_ns_cache1 {
        variable test_ns_cache_var "cache1 version"
        unset test_ns_cache_var
    }
    list [namespace eval test_ns_cache1 $trigger] \
    namespace eval test_ns_cache1 $trigger
	[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
	[catch {namespace eval test_ns_cache1 $trigger}]
} {{cache1 version} {} 1}
# TIP 278: secondary lookup disabled, catch added, result changed
} {global version}

test namespace-old-6.15 {define test namespaces} {
    namespace eval test_ns_cache2 {
        variable test_ns_cache_var "global cache2 version"
    }
    set trigger2 {set test_ns_cache2::test_ns_cache_var}
    catch {list [namespace eval test_ns_cache1 $trigger2] \
	       [namespace eval test_ns_cache1::test_ns_cache2 $trigger]}
} 1
set trigger2 {set test_ns_cache2::test_ns_cache_var}
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{global cache2 version} {global version}}

test namespace-old-6.16 {public variables affect all parent namespaces} {
    variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
    list [namespace eval test_ns_cache1 $trigger2] \
         [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{cache2 version} {cache2 version}}

test namespace-old-6.17 {usage for "namespace which"} {
    list [catch "namespace which -baz x" msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-old-6.18 {usage for "namespace which"} {
    # Presume no imported command called -command ;^)
    namespace which -command
} {}

test namespace-old-6.19 {querying:  namespace which -command} {
    proc test_ns_cache1::test_ns_cache_cmd {} {
        return "cache1 version"
    }
    list [namespace eval :: {namespace which test_ns_cache_cmd}] \
         [namespace eval test_ns_cache1 {namespace which test_ns_cache_cmd}] \
         [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
         [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
} {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}

test namespace-old-6.20 {command "namespace which" may not find commands} {
    namespace eval test_ns_cache1 {namespace which -command xyzzy}
} {}
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"

test namespace-old-6.21 {querying:  namespace which -variable} {
    namespace eval test_ns_cache1::test_ns_cache2 {
        namespace which -variable test_ns_cache_var
    }
} {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}

test namespace-old-6.22 {command "namespace which" may not find variables} {
    namespace eval test_ns_cache1 {namespace which -variable xyzzy}
} {}

# -----------------------------------------------------------------------
# TEST: uplevel/upvar across namespace boundaries
# -----------------------------------------------------------------------
test namespace-old-7.1 {define test namespace} {
    namespace eval test_ns_uplevel {
        variable x 0
        variable y 1

        proc show_vars {num} {
            return [uplevel $num {info vars}]
        }
        proc test_uplevel {num} {
            set a 0
            set b 1
            namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
        }
    }
} {}
namespace eval test_ns_uplevel {
    variable x 0
    variable y 1
    proc show_vars {num} {
	return [uplevel $num {info vars}]
    }
    proc test_uplevel {num} {
	set a 0
	set b 1
	namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
    }
}
test namespace-old-7.2 {uplevel can access namespace call frame} {
    list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
         [expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
} {1 1}
test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
    lsort [test_ns_uplevel::test_uplevel 2]
} {a b num}
test namespace-old-7.4 {uplevel can go up to global context} {
    expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
} {1}

test namespace-old-7.5 {absolute call frame references work too} {
    list [expr {"x" in [test_ns_uplevel::test_uplevel #2]}] \
         [expr {"y" in [test_ns_uplevel::test_uplevel #2]}]
    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
} {1 1}
test namespace-old-7.6 {absolute call frame references work too} {
    lsort [test_ns_uplevel::test_uplevel #1]
} {a b num}
test namespace-old-7.7 {absolute call frame references work too} {
    expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
} {1}

test namespace-old-7.8 {namespaces are included in the call stack} {
    namespace eval test_ns_upvar {
        variable scope "test_ns_upvar"

        proc show_val {var num} {
            upvar $num $var x
            return $x
        }
        proc test_upvar {num} {
            set scope "test_ns_upvar::test_upvar"
            namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
        }
    }
} {}
namespace eval test_ns_upvar {
    variable scope "test_ns_upvar"
    proc show_val {var num} {
	upvar $num $var x
	return $x
    }
    proc test_upvar {num} {
	set scope "test_ns_upvar::test_upvar"
	namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
    }
}
test namespace-old-7.9 {upvar can access namespace call frame} {
    test_ns_upvar::test_upvar 1
} {test_ns_upvar}
test namespace-old-7.10 {upvar can go beyond namespace call frame} {
    test_ns_upvar::test_upvar 2
} {test_ns_upvar::test_upvar}
test namespace-old-7.11 {absolute call frame references work too} {
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
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
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
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



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
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772







+










+












+












-
-
-
-
-
-
-
-
-
+











-
-
-
-
+

-
-
-
-
+
-
-
-
+
+
-
-
-



+









-
+



+











-
-
-
-
-
-
-
+
-




-
+



+




+





+







+

-




+







+





+







# TEST: variable traces across namespace boundaries
# -----------------------------------------------------------------------
test namespace-old-8.1 {traces work across namespace boundaries} {
    namespace eval test_ns_trace {
        namespace eval foo {
            variable x ""
        }

        variable status ""
        proc monitor {name1 name2 op} {
            variable status
            lappend status "$op: $name1"
        }
        trace variable foo::x rwu [namespace code monitor]
    }
    set test_ns_trace::foo::x "yes!"
    set test_ns_trace::foo::x
    unset test_ns_trace::foo::x

    namespace eval test_ns_trace { set status }
} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}

# -----------------------------------------------------------------------
# TEST: imported commands
# -----------------------------------------------------------------------
test namespace-old-9.1 {empty "namespace export" list} {
    list [catch "namespace export" msg] $msg
} {0 {}}
test namespace-old-9.2 {usage for "namespace export" command} {
    list [catch "namespace export test_ns_trace::zzz" msg] $msg
} {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}

test namespace-old-9.3 {define test namespaces for import} {
    namespace eval test_ns_export {
        namespace export cmd1 cmd2 cmd3
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
        proc cmd5 {args} {return "cmd5: $args"}
        proc cmd6 {args} {return "cmd6: $args"}
    }
    lsort [info commands test_ns_export::*]
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
namespace eval test_ns_export {
    namespace export cmd1 cmd2 cmd3
    proc cmd1 {args} {return "cmd1: $args"}
    proc cmd2 {args} {return "cmd2: $args"}
    proc cmd3 {args} {return "cmd3: $args"}
    proc cmd4 {args} {return "cmd4: $args"}
    proc cmd5 {args} {return "cmd5: $args"}
    proc cmd6 {args} {return "cmd6: $args"}
}

test namespace-old-9.4 {check export status} {
    set x ""
    namespace eval test_ns_import {
        namespace export cmd1 cmd2
        namespace import ::test_ns_export::*
    }
    foreach cmd [lsort [info commands test_ns_import::*]] {
        lappend x $cmd
    }
    set x
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
namespace eval test_ns_import {
    namespace export cmd1 cmd2
    namespace import ::test_ns_export::*
}

test namespace-old-9.5 {empty import list in "namespace import" command} {
    namespace eval test_ns_import_empty {
	namespace import ::test_ns_export::*
	try {
	    lsort [namespace import]
    lsort [namespace import]
	} finally {
	    namespace delete [namespace current]
	}
} {bytestring cleanupTests configure customMatch debug errorChannel errorFile getMatchingFiles interpreter limitConstraints loadFile loadScript loadTestedCommands mainThread makeDirectory makeFile match matchDirectories matchFiles normalizeMsg normalizePath outputChannel outputFile preserveCore removeDirectory removeFile restoreState runAllTests saveState singleProcess skip skipDirectories skipFiles temporaryDirectory test testConstraint testsDirectory threadReap verbose viewFile workingDirectory}

    }
} {cmd1 cmd2 cmd3}
# there is no namespace-old-9.6
test namespace-old-9.7 {empty forget list for "namespace forget" command} {
    namespace forget
} {}

catch {rename cmd1 {}}
catch {rename cmd2 {}}
catch {rename ncmd {}}
catch {rename ncmd1 {}}
catch {rename ncmd2 {}}
test namespace-old-9.8 {only exported commands are imported} {
    namespace import test_ns_import::cmd*
    set x [lsort [info commands cmd*]]
} {cmd1 cmd2}
namespace import test_ns_import::cmd*

test namespace-old-9.9 {imported commands work just the same as original} {
    list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}

test namespace-old-9.10 {commands can be imported from many namespaces} {
    namespace eval test_ns_import2 {
        namespace export ncmd ncmd1 ncmd2
        proc ncmd  {args} {return "ncmd: $args"}
        proc ncmd1 {args} {return "ncmd1: $args"}
        proc ncmd2 {args} {return "ncmd2: $args"}
        proc ncmd3 {args} {return "ncmd3: $args"}
    }
    namespace import test_ns_import2::*
    lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd1 cmd2 ncmd ncmd1 ncmd2}
namespace eval test_ns_import2 {
    namespace export ncmd ncmd1 ncmd2
    proc ncmd  {args} {return "ncmd: $args"}
    proc ncmd1 {args} {return "ncmd1: $args"}
    proc ncmd2 {args} {return "ncmd2: $args"}
    proc ncmd3 {args} {return "ncmd3: $args"}
}

namespace import test_ns_import2::*
test namespace-old-9.11 {imported commands can be removed by deleting them} {
    rename cmd1 ""
    lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd2 ncmd ncmd1 ncmd2}
catch { rename cmd1 "" }

test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
    list [catch {namespace forget xyzzy::*} msg] $msg
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}

test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
    list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
         [lsort [info commands cmd?]]
} {0 {} cmd2}

test namespace-old-9.14 {imported commands can be removed} {
    namespace forget test_ns_import::cmd?
    list [lsort [info commands cmd?]] \
         [catch {cmd1 another test} msg] $msg
} {{} 1 {invalid command name "cmd1"}}

test namespace-old-9.15 {existing commands can't be overwritten} {
    proc cmd1 {x y} {
        return [expr $x+$y]
    }
    list [catch {namespace import test_ns_import::cmd?} msg] $msg \
         [cmd1 3 5]
} {1 {can't import command "cmd1": already exists} 8}

test namespace-old-9.16 {use "-force" option to override existing commands} {
    proc cmd1 {x y} { return [expr $x+$y] }
    list [cmd1 3 5] \
         [namespace import -force test_ns_import::cmd?] \
         [cmd1 3 5]
} {8 {} {cmd1: 3 5}}

test namespace-old-9.17 {commands can be imported into many namespaces} {
    namespace eval test_ns_import_use {
        namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
        lsort [concat [info commands ::test_ns_import_use::cmd*] \
                      [info commands ::test_ns_import_use::ncmd*]]
    }
} {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}

test namespace-old-9.18 {when command is deleted, imported commands go away} {
    namespace eval test_ns_import { rename cmd1 "" }
    list [info commands cmd1] \
         [namespace eval test_ns_import_use {info commands cmd1}]
} {{} {}}

test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
    namespace delete test_ns_import test_ns_import2
    list [info commands cmd*] \
         [info commands ncmd*] \
         [namespace eval test_ns_import_use {info commands cmd*}] \
         [namespace eval test_ns_import_use {info commands ncmd*}] \
} {{} {} {} {}}
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
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







+



+



+





+




+




-
-
-
-
+
-




-
-
-
+






-
+







        }
        proc do {args} {
            return [eval $args]
        }
        list [set x] [show test]
    }
} {x-value {show: test}}

test namespace-old-10.2 {command "namespace code" requires one argument} {
    list [catch {namespace code} msg] $msg
} {1 {wrong # args: should be "namespace code arg"}}

test namespace-old-10.3 {command "namespace code" requires one argument} {
    list [catch {namespace code first "second arg" third} msg] $msg
} {1 {wrong # args: should be "namespace code arg"}}

test namespace-old-10.4 {command "namespace code" gets current namesp context} {
    namespace eval test_ns_inscope {
        namespace code {"1 2 3" "4 5" 6}
    }
} {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}

test namespace-old-10.5 {with one arg, first "scope" sticks} {
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
    namespace code $sval
} {::namespace inscope ::test_ns_inscope {one two}}

test namespace-old-10.6 {with many args, each "scope" adds new args} {
    set sval [namespace eval test_ns_inscope {namespace code {one two}}]
    namespace code "$sval three"
} {::namespace inscope ::test_ns_inscope {one two} three}
namespace eval test_ns_inscope {
    proc show {args} {
	return "show: $args"
    }

}
test namespace-old-10.7 {scoped commands work with eval} {
    set cref [namespace eval test_ns_inscope {namespace code show}]
    list [eval $cref "a" "b c" "d e f"]
} {{show: a b c d e f}}
namespace eval test_ns_inscope {
    variable x "x-value"
}

test namespace-old-10.8 {scoped commands execute in namespace context} {
    set cref [namespace eval test_ns_inscope {
        namespace code {set x "some new value"}
    }]
    list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
} {x-value {some new value} {some new value}}


foreach cmd [info commands test_ns_*] {
    rename $cmd ""
}
catch {rename cmd {}}
catch {rename cmd1 {}}
catch {rename cmd2 {}}
catch {rename ncmd {}}
855
856
857
858
859
860
861
862
863
864
865
841
842
843
844
845
846
847











-
-
-
-
catch {unset test_ns_var_global}
catch {unset cmd}
eval namespace delete [namespace children :: test_ns_*]

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/namespace.test.

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
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

-
-
+
+
-

-
-
+
+




-
-
+
+

-
-
+
+


-
-
-
-








-
+



















-
+

-
+



+




-
+







# Functionality covered: this file contains a collection of tests for the
# procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic
# support for namespaces.  Other namespace-related tests appear in
# procedures in tclNamesp.c that implement Tcl's basic support for
# namespaces. Other namespace-related tests appear in variable.test.
# variable.test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}
testConstraint memory [llength [info commands memory]]

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

#
# REMARK: the tests for 'namespace upvar' are not done here. They are to be
# found in the file 'upvar.test'.
#

# Clear out any namespaces called test_ns_*
catch {namespace delete {*}[namespace children :: test_ns_*]}


proc fq {ns} {
    if {[string match ::* $ns]} {return $ns}
    set current [uplevel 1 {namespace current}]
    return [string trimright $current :]::[string trimleft $ns :]
}

test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
    namespace children :: test_ns_*
} {}

catch {unset l}
test namespace-2.1 {Tcl_GetCurrentNamespace} {
    list [namespace current] [namespace eval {} {namespace current}] \
        [namespace eval {} {namespace current}]
} {:: :: ::}
test namespace-2.2 {Tcl_GetCurrentNamespace} {
    set l {}
    lappend l [namespace current]
    namespace eval test_ns_1 {
        lappend ::l [namespace current]
        lappend l [namespace current]
        namespace eval foo {
            lappend ::l [namespace current]
            lappend l [namespace current]
        }
    }
    lappend l [namespace current]
    set l
} {:: ::test_ns_1 ::test_ns_1::foo ::}

test namespace-3.1 {Tcl_GetGlobalNamespace} {
    namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
    # namespace children uses Tcl_GetGlobalNamespace
    # namespace children uses Tcl_GetGlobalNamespace 
    namespace eval test_ns_1 {namespace children foo b*}
} {::test_ns_1::foo::bar}

test namespace-4.1 {Tcl_PushCallFrame with isProcCallFrame=1} {
    namespace eval test_ns_1 {
        variable v 123
        proc p {} {
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
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







-
+
-
-




-
+


















-
+







        set v}
    test_ns_1::baz::p
} {789}

test namespace-5.1 {Tcl_PopCallFrame, no vars} {
    namespace eval test_ns_1::blodge {}  ;# pushes then pops frame
} {}
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} -setup {
test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
    namespace eval test_ns_1 {}
} -body {
    proc test_ns_1::r {} {
        set a 123
    }
    test_ns_1::r   ;# pushes then pop's r's frame
} -result {123}
} {123}

test namespace-6.1 {Tcl_CreateNamespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [lsort [namespace children :: test_ns_*]] \
        [namespace eval test_ns_1 {namespace current}] \
	[namespace eval test_ns_2 {namespace current}] \
	[namespace eval ::test_ns_3 {namespace current}] \
	[namespace eval ::test_ns_4 \
            {namespace eval foo {namespace current}}] \
	[namespace eval ::test_ns_5 \
            {namespace eval ::test_ns_6 {namespace current}}] \
        [lsort [namespace children :: test_ns_*]]
} {{} ::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4::foo ::test_ns_6 {::test_ns_1 ::test_ns_2 ::test_ns_3 ::test_ns_4 ::test_ns_5 ::test_ns_6}}
test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
    list [namespace eval :::test_ns_1::::foo {namespace current}] \
         [namespace eval test_ns_2:::::foo {namespace current}]
} {::test_ns_1::foo ::test_ns_2::foo}
test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
    list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
} {0 ::test_ns_7}
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1:: {
        namespace eval test_ns_2:: {}
        namespace eval test_ns_3:: {}
    }
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
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







-
+


-
-
-
+
+
+





-
-
+
+

-
+


-
-
-
-
-
-
-
-
-
-
-
-







    namespace eval test_ns_2 {
        proc x {} {}
	trace add command x delete "namespace delete [namespace current];#"
    }
    namespace delete test_ns_2
} {}
test namespace-7.7 {Bug 1655305} -setup {
    interp create child
    interp create slave
    # Can't invoke through the ensemble, since deleting the global namespace
    # (indirectly, via deleting ::tcl) deletes the ensemble.
    child eval {rename ::tcl::info::commands ::infocommands}
    child hide infocommands
    child eval {
    slave eval {rename ::tcl::info::commands ::infocommands}
    slave hide infocommands
    slave eval {
	proc foo {} {
	    namespace delete ::
	}
    }
} -body {
    child eval foo
    child invokehidden infocommands
    slave eval foo
    slave invokehidden infocommands
} -cleanup {
    interp delete child
    interp delete slave
} -result {}

test namespace-7.8 {Bug ba1419303b4c} -setup {
    namespace eval ns1 {
	namespace ensemble create
    }

    trace add command ns1 delete {
	namespace delete ns1
    }
} -body {
    # No segmentation fault given --enable-symbols=mem.
    namespace delete ns1
} -result {}

test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
    catch {interp delete test_interp}
    interp create test_interp
    interp eval test_interp {
        namespace eval test_ns_1 {
            namespace export p
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
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







-
-
-
-
+
+
+
+



-
+

-
-
-
-
+
+
+
+



-
+

-
-
-
-
+
+
+
+







        proc p {} {return foo}
    }
    list [lsort [info commands test_ns_import::*]] \
         [namespace delete test_ns_export] \
         [info commands test_ns_import::*]
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1 ::test_ns_import::cmd2}] {} ::test_ns_import::p]
test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
    interp create child
    child eval {trace add execution error leave {namespace delete :: ;#}}
    catch {child eval error foo bar baz}
    interp delete child
    interp create slave
    slave eval {trace add execution error leave {namespace delete :: ;#}}
    catch {slave eval error foo bar baz}
    interp delete slave
    set ::errorInfo
} {bar
    invoked from within
"child eval error foo bar baz"}
"slave eval error foo bar baz"}
test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
    interp create child
    child eval {trace add variable errorCode write {namespace delete :: ;#}}
    catch {child eval error foo bar baz}
    interp delete child
    interp create slave 
    slave eval {trace add variable errorCode write {namespace delete :: ;#}}
    catch {slave eval error foo bar baz}
    interp delete slave
    set ::errorInfo
} {bar
    invoked from within
"child eval error foo bar baz"}
"slave eval error foo bar baz"}
test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
    interp create child
    child eval {trace add execution error leave {namespace delete :: ;#}}
    catch {child eval error foo bar baz}
    interp delete child
    interp create slave
    slave eval {trace add execution error leave {namespace delete :: ;#}}
    catch {slave eval error foo bar baz}
    interp delete slave
    set ::errorCode
} baz

test namespace-9.1 {Tcl_Import, empty import pattern} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
} {1 {empty import pattern}}
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
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







-
+
-
-
-

-
-
+
+
-
-
-
-
-
-




-
+

















+







    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
    }
    test_ns_import::p
} {cmd1: 123}
test namespace-9.5 {Tcl_Import, RFE 1230597} -setup {
test namespace-9.5 {Tcl_Import, RFE 1230597} {
    namespace eval test_ns_import {}
    namespace eval test_ns_export {}
} -body {
    list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
} -result {0 {}}
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} -setup {
} {0 {}}
test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
    namespace eval test_ns_import {}
    namespace eval ::test_ns_export {
        proc cmd1 {args} {return "cmd1: $args"}
	namespace export cmd1
    }
} -body {
    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
        cmd1 555
    }
} -result {cmd1: 555}
} {cmd1: 555}
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    namespace eval test_ns_import {
        namespace import -force ::test_ns_export::*
    }
    list [test_ns_import::cmd1 a b c] \
         [test_ns_export::cmd1 d e f] \
         [proc test_ns_export::cmd1 {args} {return "new1: $args"}] \
         [namespace origin test_ns_import::cmd1] \
         [namespace origin test_ns_export::cmd1] \
         [test_ns_import::cmd1 g h i] \
         [test_ns_export::cmd1 j k l]
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}

test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
    namespace eval one {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval two {
	namespace export cmd
374
375
376
377
378
379
380

381
382
383
384
385
386
387
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362







+







} -body {
    namespace eval two [list namespace import -force \
	    [namespace current]::three::other]
    namespace origin two::other
} -cleanup {
    namespace delete one two three
} -match glob -result *::one::cmd

test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
    namespace eval one {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval two namespace export cmd
    namespace eval two \
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
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
524
525
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
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







-
+
-
-
-
-
-
-









-
+
+

















+















+
















+




















+




















+







        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_import {
        namespace forget ::test_ns_export::wombat
    }
} {}
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} -setup {
test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
} -body {
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
        proc p {} {return [cmd1 123]}
        set l {}
        lappend l [lsort [info commands ::test_ns_import::*]]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
        lappend l [catch {cmd1 777} msg] $msg
    }
} -result [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]

test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval unrelated {
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::unrelated::cmd]
    my::cmd
} -cleanup {
    namespace delete origin unrelated my
}

test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval my rename cmd newname
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::origin::cmd]
    my::newname
} -cleanup {
    namespace delete origin my
} -returnCodes error -match glob -result *

test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval my \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval your {}
    namespace eval my \
	    [list rename cmd [namespace current]::your::newname]
} -body {
    namespace eval your namespace forget newname
    your::newname
} -cleanup {
    namespace delete origin my your
} -returnCodes error -match glob -result *

test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval link2 namespace export cmd
    namespace eval link2 \
	    [list namespace import [namespace current]::link::cmd]
    namespace eval my \
	    [list namespace import [namespace current]::link2::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::origin::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *

test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
	    [list namespace import [namespace current]::origin::cmd]
    namespace eval link2 namespace export cmd
    namespace eval link2 \
	    [list namespace import [namespace current]::link::cmd]
    namespace eval my \
	    [list namespace import [namespace current]::link2::cmd]
} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::link::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
}

test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
    namespace eval origin {
	namespace export cmd
	proc cmd {} {}
    }
    namespace eval link namespace export cmd
    namespace eval link \
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

611
612
613
614
615
616
617
618
619
620
621

622
623
624
625
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
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
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
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
595
596
597
598
599
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
616
617
618
619
620

621


622


623
624


625

626
627
628
629
630
631
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
686

687
688

689
690
691
692
693


694
695






696

697
698
699
700
701
702
703
704







-
+

-





-
-
+
+
-
-
-
-
-
-






-
-
+
+
-
-
-
-
-
-
-
-
-
-
-





-
+













-
+
-
-
-
-
-
-
-
-
-






-
+










-
+








-




-
-
+
+
-
-
-
-
-
-
-
-
-




-
+
-
-
-
+
-
-
-
-
-
-
-
-
-

-
+
-

-
-
+














-
+

+










-
+
-
-

-
-
+
+
-
-

-
+






-
+
-
-
+

-



-
-
+
+
-


-



-
+
-
-
-
+

-


-
+

-
+
-
-
+
+

-
-
+
-
-
-
-
-
+

-
+

-






-
-
-
-
+
+
+
+















-
+

-





-
-
+
+
-
-
-
-
-
-

-
+







    namespace eval my \
	    [list namespace forget [namespace current]::link2::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *

test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup {
test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    list [namespace origin set] [namespace origin test_ns_export::cmd1]
} -result {::set ::test_ns_export::cmd1}
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} -setup {
} {::set ::test_ns_export::cmd1}
test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
} -body {
    namespace eval test_ns_import1 {
        namespace import ::test_ns_export::*
        namespace export *
        proc p {} {namespace origin cmd1}
    }
    list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
} -result {::test_ns_export::cmd1 ::test_ns_export::cmd1}
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} -setup {
} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
    }
    namespace eval test_ns_import1 {
        namespace import ::test_ns_export::*
        namespace export *
        proc p {} {namespace origin cmd1}
    }
} -body {
    namespace eval test_ns_import2 {
        namespace import ::test_ns_import1::*
        proc q {} {return [cmd1 123]}
    }
    list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
} -result {{cmd1: 123} ::test_ns_export::cmd1}
} {{cmd1: 123} ::test_ns_export::cmd1}

test namespace-12.1 {InvokeImportedCmd} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {namespace current}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
    }
    list [test_ns_import::cmd1]
} {::test_ns_export}

test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} -setup {
test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {namespace current}
    }
    namespace eval test_ns_import {
        namespace import ::test_ns_export::*
    }
} -body {
    namespace eval test_ns_import {
        set l {}
        lappend l [info commands ::test_ns_import::*]
        namespace forget ::test_ns_export::cmd1
        lappend l [info commands ::test_ns_import::*]
    }
} -result {::test_ns_import::cmd1 {}}
} {::test_ns_import::cmd1 {}}
test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
    # Will panic if still buggy
    namespace eval src {namespace export foo; proc foo {} {}}
    namespace eval dst {namespace import [namespace parent]::src::foo}
    trace add command src::foo delete \
        "[list namespace delete [namespace current]::dst] ;#"
    proc src::foo {} {}
    namespace delete src
} {}

test namespace-14.1 {TclGetNamespaceForQualName, absolute names} -setup {
test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
		[lsort [namespace children :: test_ns_*]]
    }
} -result [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup {
} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        list [catch {set ::test_ns_777::v} msg] $msg \
             [catch {namespace children test_ns_777} msg] $msg
    }
} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}

# TIP 278: secondary lookup disabled, results changed from {10 20}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    variable v 10
    namespace eval test_ns_1::test_ns_2 {
        variable v 20
    }
    namespace eval test_ns_2 {
        variable v 30
    }
} -body {
    namespace eval test_ns_1 {
        # list $v $test_ns_2::v
        list $v $test_ns_2::v
        list [catch {set v} msg] $msg  [catch {set test_ns_2::v} msg] $msg
    }
} -result {1 {can't read "v": no such variable} 0 20}

} {10 20}
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval ::test_ns_2 {
        namespace eval bar {}
    }
    namespace eval test_ns_1 {
        list [catch {namespace delete test_ns_2::bar} msg] $msg
        set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
    }
    set l
} {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
    namespace eval test_ns_1::test_ns_2 {
        namespace eval foo {}
    }
    namespace eval test_ns_1 {
        list [namespace children test_ns_2] \
             [catch {namespace children test_ns_1} msg] $msg
    }
} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
    namespace eval test_ns_1::test_ns_2::foo {}
} -body {
    namespace children test_ns_1:::
} -result {::test_ns_1::test_ns_2}
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
} {::test_ns_1::test_ns_2}
test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
    namespace eval test_ns_1::test_ns_2::foo {}
} -body {
    namespace children :::test_ns_1:::::test_ns_2:::
} -result {::test_ns_1::test_ns_2::foo}
} {::test_ns_1::test_ns_2::foo}
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    set l {}
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    namespace eval test_ns_1::test_ns_2 {variable {} 2525}
    lappend l [set test_ns_1::test_ns_2::]
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    namespace eval test_ns_1::test_ns_2::foo {}
    unset -nocomplain test_ns_1::test_ns_2::
    catch {unset test_ns_1::test_ns_2::}
    set l {}
} -body {
    lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
    set test_ns_1::test_ns_2:: 314159
    lappend l [set test_ns_1::test_ns_2::]
} -result {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup {
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
    namespace eval test_ns_1::test_ns_2::foo {}
    catch {rename test_ns_1::test_ns_2:: {}}
    set l {}
} -body {
    lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
    proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
    lappend l [test_ns_1::test_ns_2:: hello]
} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}

# TIP 278: secondary lookup disabled, added catch, result changed from y
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        variable {}
        catch {set test_ns_1::(x) y} ::msg
        set test_ns_1::(x) y
    }
    list $::msg [catch {set test_ns_1::(x)} msg] $msg
    set test_ns_1::(x)
} -result {{can't set "test_ns_1::(x)": parent namespace doesn't exist} 1 {can't read "test_ns_1::(x)": no such variable}}
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
} y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    namespace eval test_ns_1 {
    list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
	proc {} {} {}
	namespace eval {} {}
	{}
    }
} -result {can't create namespace "": only global namespace can have empty name}
} {1 {can't create namespace "": only global namespace can have empty name}}

test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup {
test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        proc cmd {args} {namespace current}
    }
    list [namespace delete ::test_ns_delete::test_ns_delete2] \
         [namespace children ::test_ns_delete]
} -result {{} {}}
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} -body {
    namespace delete ::test_ns_delete::test_ns_delete2
} -returnCodes error -result {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}
} {{} {}}
test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
    list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
    namespace eval test_ns_delete {
        namespace eval test_ns_delete2 {}
        namespace eval test_ns_delete3 {}
        list [namespace delete test_ns_delete2] \
             [namespace children [namespace current]]
    }
} {{} ::test_ns_delete::test_ns_delete3}
test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
    namespace eval test_ns_delete2 {}
    namespace eval test_ns_delete {
        list [catch {namespace delete test_ns_delete2} msg] $msg
    }
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}

test namespace-16.1 {Tcl_FindCommand, absolute name found} -setup {
test namespace-16.1 {Tcl_FindCommand, absolute name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
        variable v "::test_ns_1::cmd"
        eval $v one
    }
} -result {::test_ns_1::cmd: one}
test namespace-16.2 {Tcl_FindCommand, absolute name found} -setup {
} {::test_ns_1::cmd: one}
test namespace-16.2 {Tcl_FindCommand, absolute name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
        variable v "::test_ns_1::cmd"
    }
} -body {
    eval $test_ns_1::v two
} -result {::test_ns_1::cmd: two}
} {::test_ns_1::cmd: two}
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
    namespace eval test_ns_1 {
        variable v2 "::test_ns_1::ladidah"
        list [catch {eval $v2} msg] $msg
    }
} {1 {invalid command name "::test_ns_1::ladidah"}}

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
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
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
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







-
+
-
-
-
-
-



-
-
+
+
+




-
-
-
-
+
+
-








-
-
-
-
+
+

-
+

-
+

-
-
+
+

-




-
+
-














-
+




-
+

-
-
+
+
-
-






-
-
+
+
-
-
-
-



-
+
-
-


-

-
+

-
-
+
+

-
+

-
+






-
-
-
+

-









-
-
+
+





-
+

-













+
-
+



















+




-
+

-


-
-
+
+
-
-
-



-
-
+
+
-
-




-
+
-
-
-











+
-
+







-
+




-
+

-

-
-
-
+
+
+
-
-
-



-
-
+
+
-
-
-

-
-
+
+
-
-
-



-
+









-
+
-
-
-


-
+







test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
    foobar 1 2 3 4 5
} {unknown: foobar 1 2 3 4 5}
# restore the "unknown" proc saved previously
catch {rename unknown {}}
catch {rename unknown.old unknown}

test namespace-16.8 {Tcl_FindCommand, relative name found} -setup {
test namespace-16.8 {Tcl_FindCommand, relative name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd {args} {return "[namespace current]::cmd: $args"}
    }
} -body {
    namespace eval test_ns_1 {
        cmd a b c
    }
} -result {::test_ns_1::cmd: a b c}
test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
} {::test_ns_1::cmd: a b c}
test namespace-16.9 {Tcl_FindCommand, relative name found} {
    catch {rename cmd2 {}}
    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
    namespace eval test_ns_1 {
       cmd2 a b c
    }
} -cleanup {
    catch {rename cmd2 {}}
} -result {::::cmd2: a b c}
test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} -body {
} {::::cmd2: a b c}
test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
    namespace eval test_ns_1 {
        proc cmd2 {args} {
            return "[namespace current]::cmd2 in test_ns_1: $args"
        }
        namespace eval test_ns_12 {
            cmd2 a b c
        }
    }
} -cleanup {
    catch {rename cmd2 {}}
} -result {::::cmd2: a b c}
test namespace-16.11 {Tcl_FindCommand, relative name not found} -body {
} {::::cmd2: a b c}
test namespace-16.11 {Tcl_FindCommand, relative name not found} {
    namespace eval test_ns_1 {
       cmd3 a b c
       list [catch {cmd3 a b c} msg] $msg
    }
} -returnCodes error -result {invalid command name "cmd3"}
} {1 {invalid command name "cmd3"}}

unset -nocomplain x
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup {
catch {unset x}
test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    set x 314159
    namespace eval test_ns_1 {
        set ::x
    }
} -result {314159}
} {314159}
variable ::x 314159
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        variable x 777
        set ::test_ns_1::x
    }
} {777}
test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        set ::test_ns_1::test_ns_2::x
    }
} {1111}
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body {
test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            variable x 1111
        }
        set ::test_ns_1::test_ns_2::y
        list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
    }
} -returnCodes error -result {can't read "::test_ns_1::test_ns_2::y": no such variable}
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup {
} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
    namespace eval ::test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace eval test_ns_3 {
            variable ::test_ns_1::test_ns_2::x 2222
        }
    }
    set ::test_ns_1::test_ns_2::x
} -result {2222}
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
} {2222}
test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
        variable x 777
    }
} -body {
    namespace eval test_ns_1 {
        set x
    }
} -result {777}
} {777}

# TIP 278: secondary lookup disabled, catch added, result changed from 314159
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
    namespace eval test_ns_1 {
	variable x 777
        unset x
        list [catch {set x} msg] $msg  ;# must not be global x now
        set x  ;# must be global x now
    }
} {1 {can't read "x": no such variable}}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
} {314159}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
    namespace eval test_ns_1 {
        set wuzzat
        list [catch {set wuzzat} msg] $msg
    }
} -returnCodes error -result {can't read "wuzzat": no such variable}
} {1 {can't read "wuzzat": no such variable}}
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
    namespace eval test_ns_1 {
        variable a hello
    }
    set test_ns_1::a
} {hello}

# TIP 278: secondary lookup disabled, result changed from 1
test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
    namespace eval test_ns_1 {}
} -body {
    proc test_ns {} {
	set ::test_ns_1::a 0
    }
    test_ns
    rename test_ns {}
    namespace eval test_ns_1 unset a
    set a 0
    namespace eval test_ns_1 set a 1
    namespace delete test_ns_1
    return $a
} -result 0
    set a
} 1
catch {unset a}
catch {unset x}

catch {unset l}
catch {rename foo {}}
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup {
test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    proc foo {} {return "global foo"}
    namespace eval test_ns_1 {
        proc trigger {} {
            return [foo]
        }
    }
    set l ""
    lappend l [test_ns_1::trigger]
    namespace eval test_ns_1 {
        # force invalidation of cached ref to "foo" in proc trigger
        proc foo {} {return "foo in test_ns_1"}
    }
    lappend l [test_ns_1::trigger]
    set l
} -result {{global foo} {foo in test_ns_1}}
} {{global foo} {foo in test_ns_1}}
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
    namespace eval test_ns_2 {
        proc foo {} {return "foo in ::test_ns_2"}
    }
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {}
        proc trigger {} {
            return [test_ns_2::foo]
        }
    }
    set l ""
    lappend l [test_ns_1::trigger]
    namespace eval test_ns_1 {
        namespace eval test_ns_2 {
            # force invalidation of cached ref to "foo" in proc trigger
            proc foo {} {return "foo in ::test_ns_1::test_ns_2"}
        }
    }
    lappend l [test_ns_1::trigger]
    set l
} {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
catch {unset l}
catch {rename foo {}}

test namespace-19.1 {GetNamespaceFromObj, global name found} -setup {
test namespace-19.1 {GetNamespaceFromObj, global name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1::test_ns_2 {}
    namespace children ::test_ns_1
} -result {::test_ns_1::test_ns_2}
test namespace-19.2 {GetNamespaceFromObj, relative name found} -setup {
} {::test_ns_1::test_ns_2}
test namespace-19.2 {GetNamespaceFromObj, relative name found} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} -result {}
test namespace-19.3 {GetNamespaceFromObj, name not found} -setup {
} {}
test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        namespace children test_ns_99
    }
} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} -setup {
test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        proc foo {} {
            return [namespace children test_ns_2]
        }
        list [catch {namespace children test_ns_99} msg] $msg
    }
    set l {}
    lappend l [test_ns_1::foo]
    namespace delete test_ns_1::test_ns_2
    namespace eval test_ns_1::test_ns_2::test_ns_3 {}
    lappend l [test_ns_1::foo]
    set l
} -result {{} ::test_ns_1::test_ns_2::test_ns_3}
} {{} ::test_ns_1::test_ns_2::test_ns_3}

test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace} msg] $msg
} {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
    namespace wombat {}
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *}
} -returnCodes error -match glob -result {bad option "wombat": must be *}
test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
    namespace ch :: test_ns_*
} {}

test namespace-21.1 {NamespaceChildrenCmd, no args} -setup {
test namespace-21.1 {NamespaceChildrenCmd, no args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1::test_ns_2 {}
    expr {"::test_ns_1" in [namespace children]}
} -result {1}
test namespace-21.2 {NamespaceChildrenCmd, no args} -setup {
    expr {[string first ::test_ns_1 [namespace children]] != -1}
} {1}
test namespace-21.2 {NamespaceChildrenCmd, no args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace children
    }
} -result {::test_ns_1::test_ns_2}
test namespace-21.3 {NamespaceChildrenCmd, ns name given} -setup {
} {::test_ns_1::test_ns_2}
test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace children ::test_ns_1
} -result {::test_ns_1::test_ns_2}
test namespace-21.4 {NamespaceChildrenCmd, ns name given} -setup {
} {::test_ns_1::test_ns_2}
test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1 {
        namespace children test_ns_2
    }
} -result {}
} {}
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
    namespace eval test_ns_1 {
        list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
    }
} {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
    namespace eval test_ns_1::test_ns_foo {}
    namespace children test_ns_1 *f*
} {::test_ns_1::test_ns_foo}
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} -setup {
test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    namespace eval test_ns_1::test_ns_2 {}
} -body {
    namespace eval test_ns_1::test_ns_foo {}
    lsort [namespace children test_ns_1 test*]
} -result {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
    namespace eval test_ns_1 {}
    namespace children [namespace current] [fq test_ns_1]
} [fq test_ns_1]

test namespace-22.1 {NamespaceCodeCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
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
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







-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







    namespace code unknown
} {::namespace inscope :: unknown}
test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
    namespace eval test_ns_1 {
        namespace code cmd
    }
} {::namespace inscope ::test_ns_1 cmd}
test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
    namespace eval test_ns_1 {
	variable v 42
    }
    namespace eval test_ns_2 {
	proc namespace args {}
    }
    namespace eval test_ns_2 [namespace eval test_ns_1 {
	namespace code {set v}
    }]
} {42}
test namespace-22.6 {NamespaceCodeCmd, in other namespace} { 
    namespace eval test_ns_1 { 
	variable v 42 
    } 
    namespace eval test_ns_2 { 
	proc namespace args {} 
    } 
    namespace eval test_ns_2 [namespace eval test_ns_1 { 
	namespace code {set v} 
    }] 
} {42} 
test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} {
    namespace eval demo {
	proc namespace args {puts $args}
	::namespace code {namespace inscope foo}
    }
} [list ::namespace inscope [fq demo] {namespace inscope foo}]

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
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







-
+












-
+
-
-
-
-
-
-
-
-




-
-
+
+
-
-

-
+








test namespace-25.1 {NamespaceEvalCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace eval} msg] $msg
} {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
test namespace-25.2 {NamespaceEvalCmd, bad args} -body {
    namespace test_ns_1
} -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": must be *}
} -returnCodes error -match glob -result {bad option "test_ns_1": must be *}
catch {unset v}
test namespace-25.3 {NamespaceEvalCmd, new namespace} {
    set v 123
    namespace eval test_ns_1 {
        variable v 314159
        proc p {} {
            variable v
            return $v
        }
    }
    test_ns_1::p
} {314159}
test namespace-25.4 {NamespaceEvalCmd, existing namespace} -setup {
test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
    namespace eval test_ns_1 {
        variable v 314159
        proc p {} {
            variable v
            return $v
        }
    }
} -body {
    namespace eval test_ns_1 {
        proc q {} {return [expr {[p]+1}]}
    }
    test_ns_1::q
} -result {314160}
test namespace-25.5 {NamespaceEvalCmd, multiple args} -setup {
} {314160}
test namespace-25.5 {NamespaceEvalCmd, multiple args} {
    namespace eval test_ns_1 {variable v 314159}
} -body {
    namespace eval test_ns_1 "set" "v"
} -result {314159}
} {314159}
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
    while executing
"xxxx"
    (in namespace eval "::test_ns_1" script line 1)
    invoked from within
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
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







-
+
-

-
-
-
-


-




-
-
+
+
-

-
-
-
-
-
-
-
-


-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+







        proc cmd4 {args} {return "cmd4: $args"}
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
} {::test_ns_2::cmd1 {cmd1: hello}}
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} -setup {
test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
        namespace export cmd1 cmd3
    }
} -body {
    namespace eval test_ns_2 {
        namespace import -force ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
} -result {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} -setup {
} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
        namespace export cmd1 cmd3
    }
} -body {
    namespace eval test_ns_1 {
        namespace export
    }
} -result {cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} -setup {
} {cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
        proc cmd3 {args} {return "cmd3: $args"}
        proc cmd4 {args} {return "cmd4: $args"}
    }
} -body {
    namespace eval test_ns_1 {
        namespace export cmd1 cmd3
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    namespace eval test_ns_1 {
        namespace export -clear cmd4
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }
    list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
} -result [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
    catch {namespace delete foo}
    namespace eval foo {
	namespace export x
	namespace export -clear
    }
    list [namespace eval foo namespace export] [namespace delete foo]
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
1143
1144
1145
1146
1147
1148
1149

1150
1151











1152




1153
1154
1155
1156
1157
1158
1159
1160







-
+

-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+







    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
        namespace forget ::test_ns_1::cmd1
    }
    info commands ::test_ns_2::*
} {::test_ns_2::cmd2}

test namespace-28.1 {NamespaceImportCmd, no args} -setup {
test namespace-28.1 {NamespaceImportCmd, no args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval ::test_ns_1 {
	proc foo {} {}
	proc bar {} {}
	proc boo {} {}
	proc glorp {} {}
	namespace export foo b*
    }
    namespace eval ::test_ns_2 {
	namespace import ::test_ns_1::*
	lsort [namespace import]
    lsort [namespace import]
    }
} -cleanup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -result {bar boo foo}
} {bytestring cleanupTests configure customMatch debug errorChannel errorFile getMatchingFiles interpreter limitConstraints loadFile loadScript loadTestedCommands mainThread makeDirectory makeFile match matchDirectories matchFiles normalizeMsg normalizePath outputChannel outputFile preserveCore removeDirectory removeFile restoreState runAllTests saveState singleProcess skip skipDirectories skipFiles temporaryDirectory test testConstraint testsDirectory threadReap verbose viewFile workingDirectory}
test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
    namespace import -force
} {}
test namespace-28.3 {NamespaceImportCmd, arg is imported} {
    namespace eval test_ns_1 {
        namespace export cmd2
        proc cmd1 {args} {return "cmd1: $args"}
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
1183
1184
1185
1186
1187
1188
1189

1190








1191
1192


1193
1194


1195

1196
1197
1198
1199
1200
1201
1202
1203
1204







-
+
-
-
-
-
-
-
-
-


-
-
+
+
-
-

-
+
+







        proc cmd {args} {
            variable v
            return "[namespace current]::cmd: v=$v, args=$args"
        }
    }
    namespace inscope test_ns_1 cmd
} {::test_ns_1::cmd: v=747, args=}
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} -setup {
test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
    namespace eval test_ns_1 {
        variable v 747
        proc cmd {args} {
            variable v
            return "[namespace current]::cmd: v=$v, args=$args"
        }
    }
} -body {
    list [namespace inscope test_ns_1 cmd x y z] \
         [namespace eval test_ns_1 [concat cmd [list x y z]]]
} -result {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
test namespace-29.6 {NamespaceInscopeCmd, 1400572} -setup {
} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
test namespace-29.6 {NamespaceInscopeCmd, 1400572} {
    namespace eval test_ns_1 {}
} -body {
    namespace inscope test_ns_1 {info level 0}
} -result {namespace inscope test_ns_1 {info level 0}}
} {namespace inscope test_ns_1 {info level 0}}


test namespace-30.1 {NamespaceOriginCmd, bad args} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    list [catch {namespace origin} msg] $msg
} {1 {wrong # args: should be "namespace origin name"}}
test namespace-30.2 {NamespaceOriginCmd, bad args} {
    list [catch {namespace origin x y} msg] $msg
1513
1514
1515
1516
1517
1518
1519
1520

1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545


1546
1547
1548
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
1596

1597
1598
1599
1600
1601
1602
1603
1604
1605
1606

1607
1608
1609
1610
1611
1612
1613
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

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







-
+
-












-









-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
+




-
+

-
+

-







-
+







} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} {
    namespace which -command
} {}
test namespace-34.4 {NamespaceWhichCmd, bad args} {
    list [catch {namespace which a b} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
test namespace-34.5 {NamespaceWhichCmd, command lookup} -setup {
test namespace-34.5 {NamespaceWhichCmd, command lookup} {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        namespace export cmd*
        variable v1 111
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        variable v2 222
        proc p {} {}
    }
} -body {
    namespace eval test_ns_3 {
        namespace import ::test_ns_2::*
        variable v3 333
        list [namespace which -command foreach] \
             [namespace which -command p] \
             [namespace which -command cmd1] \
             [namespace which -command ::test_ns_2::cmd2] \
             [catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
    }
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup {
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
test namespace-34.6 {NamespaceWhichCmd, -command is default} {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        namespace export cmd*
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        proc p {} {}
    }
    namespace eval test_ns_3 {
        namespace import ::test_ns_2::*
    }
} -body {
    namespace eval test_ns_3 {
        list [namespace which foreach] \
             [namespace which p] \
             [namespace which cmd1] \
             [namespace which ::test_ns_2::cmd2]
    }
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}

# TIP 278: secondary lookup disabled, catch added, result changed
test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
    catch {namespace delete {*}[namespace children test_ns_*]}
    namespace eval test_ns_1 {
        namespace export cmd*
        proc cmd1 {args} {return "cmd1: $args"}
        proc cmd2 {args} {return "cmd2: $args"}
    }
    namespace eval test_ns_2 {
        namespace export *
        namespace import ::test_ns_1::*
        variable v2 222
        proc p {} {}
    }
    namespace eval test_ns_3 {
        variable v3 333
        namespace import ::test_ns_2::*
    }
} -body {
    namespace eval test_ns_3 {
        list [catch {namespace which -variable env } msg] $msg \
        list [namespace which -variable env] \
             [namespace which -variable v3] \
             [namespace which -variable ::test_ns_2::v2] \
             [catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
    }
} -result {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}

test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc p {} {
            namespace delete [namespace current]
            return [namespace current]
        }
    }
    test_ns_1::p
} -result {::test_ns_1}
} {::test_ns_1}
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
    namespace eval test_ns_1 {
        proc q {} {
            return [namespace current]
        }
    }
    list [test_ns_1::q] \
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
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
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490







-
+

-


-
+
-
-
+


+
-
+







-
+









+













+





+





+







test namespace-39.2 {NamespaceExistsCmd error} {
    list [catch {namespace exists} msg] $msg
} {1 {wrong # args: should be "namespace exists name"}}
test namespace-39.3 {NamespaceExistsCmd error} {
    list [catch {namespace exists a b} msg] $msg
} {1 {wrong # args: should be "namespace exists name"}}

test namespace-40.1 {Ignoring namespace proc "unknown"} -setup {
test namespace-40.1 {Ignoring namespace proc "unknown"} {
    rename unknown _unknown
} -body {
    proc unknown args {return global}
    namespace eval ns {proc unknown args {return local}}
    list [namespace eval ns aaa bbb] [namespace eval ns aaa]
    set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
} -cleanup {
    rename unknown {}
    rename unknown {}   
    rename _unknown unknown
    namespace delete ns
    set l
} -result {global global}
} {global global}

test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
    set res {}
    namespace eval ns {
	set res {}
	proc test {} {
	    set ::g 0
	}
	}  
	lappend ::res [test]
	proc set {a b} {
	    ::set a [incr b]
	}
	lappend ::res [test]
    }
    namespace delete ns
    set res
} {0 1}

test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
    set res {}
    namespace eval ns {}
    proc ns::a {i} {
	variable b
	proc set args {return "New proc is called"}
	return [set b $i]
    }
    ns::a 1
    set res [ns::a 2]
    namespace delete ns
    set res
} {New proc is called}

test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} {
    set res {}
    namespace eval ns {
	variable b 0
    }

    proc ns::a {i} {
	variable b
	proc set args {return "New proc is called"}
	return [set b $i]
    }
    
    set res [list [ns::a 1] $ns::b]
    namespace delete ns
    set res
} {{New proc is called} 0}

# Ensembles (TIP#112)

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
1820
1821
1515
1516
1517
1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528

1529

1530
1531


1532
1533
1534
1535
1536
1537
1538
1539
1540

1541

1542
1543


1544
1545
1546
1547
1548
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







-
+






-
+
-

+
-
-
+
+







-
+
-

+
-
-
+
+












-
+
-

+
-
-
+
+












-
+
-

+
-
+







    set result [list [ns x1] [ns x2]]
    lappend result [catch {ns x} msg] $msg
    rename ns {}
    lappend result [info command ns::x1]
    namespace delete ns
    lappend result [info command ns::x1]
} {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}}
test namespace-42.4 {ensembles: basic} -body {
test namespace-42.4 {ensembles: basic} {
    namespace eval ns {
	namespace export y*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	namespace ensemble create
    }
    list [catch {ns x} msg] $msg
    set result [list [catch {ns x} msg] $msg]
} -cleanup {
    namespace delete ns
    set result
} -result {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
test namespace-42.5 {ensembles: basic} -body {
} {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
test namespace-42.5 {ensembles: basic} {
    namespace eval ns {
	namespace export x*
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    list [catch {ns x} msg] $msg
    set result [list [catch {ns x} msg] $msg]
} -cleanup {
    namespace delete ns
    set result
} -result {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
test namespace-42.6 {ensembles: nested} -body {
} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
test namespace-42.6 {ensembles: nested} {
    namespace eval ns {
	namespace export x*
	namespace eval x0 {
	    proc z {} {format 0}
	    namespace export z
	    namespace ensemble create
	}
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    list [ns x0 z] [ns x1] [ns x2] [ns x3]
    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
} -cleanup {
    namespace delete ns
    set result
} -result {0 1 2 3}
test namespace-42.7 {ensembles: nested} -body {
} {0 1 2 3}
test namespace-42.7 {ensembles: nested} {
    namespace eval ns {
	namespace export x*
	namespace eval x0 {
	    proc z {} {list [info level] [info level 1]}
	    namespace export z
	    namespace ensemble create
	}
	proc x1 {} {format 1}
	proc x2 {} {format 2}
	proc x3 {} {format 3}
	namespace ensemble create
    }
    list [ns x0 z] [ns x1] [ns x2] [ns x3]
    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
} -cleanup {
    namespace delete ns
    set result
} -result {{1 ::ns::x0::z} 1 2 3}
} {{1 ::ns::x0::z} 1 2 3}
test namespace-42.8 {
    ensembles: [Bug 1670091], panic due to pointer to a deallocated List
    struct.
} -setup {
    proc demo args {}
    variable target [list [namespace which demo] x]
    proc trial args {variable target; string length $target}
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
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







-
+








-
+
-

+
-
+







	proc x2 {} {format 2}
	namespace ensemble create -map {a x1 b x2}
    }
    set result [list [catch {ns c} msg] $msg [namespace ensemble exists ns]]
    rename ns {}
    lappend result [namespace ensemble exists ns]
} {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0}
test namespace-43.2 {ensembles: dict-driven} -body {
test namespace-43.2 {ensembles: dict-driven} {
    namespace eval ns {
	namespace export x*
	proc x1 {args} {list 1 $args}
	proc x2 {args} {list 2 [llength $args]}
	namespace ensemble create -map {
	    a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .}
	}
    }
    list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]
    set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]]
} -cleanup {
    namespace delete ns
    set result
} -result {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
set SETUP {
    namespace eval ns {
	namespace export a b
	proc a args {format 1,[llength $args]}
	proc b args {format 2,[llength $args]}
	proc c args {format 3,[llength $args]}
	proc d args {format 4,[llength $args]}
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
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
1786
1787







-
+
-
-
-










-
+















+



+



+







} {1 {ensemble subcommand implementations must be non-empty lists}}
test namespace-44.5 {ensemble: errors} -setup {
    namespace ensemble create -command foobar -subcommands {foobarcget foobarconfigure}
} -body {
    foobar foobarcon
} -cleanup {
    rename foobar {}
} -returnCodes error -result {invalid command name "foobarconfigure"}
} -returnCodes error -result {invalid command name "::foobarconfigure"}
test namespace-44.6 {ensemble: errors} -returnCodes error -body {
    namespace ensemble create gorp
} -result {wrong # args: should be "namespace ensemble create ?option value ...?"}

test namespace-45.1 {ensemble: introspection} {
    namespace eval ns {
	namespace export x
	proc x {} {}
	namespace ensemble create
	set ::result [namespace ensemble configure ::ns]
    }
    namespace delete ns
    set result
} {-map {} -namespace ::ns -parameters {} -prefixes 1 -subcommands {} -unknown {}}
} {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}}
test namespace-45.2 {ensemble: introspection} {
    namespace eval ns {
	namespace export x
	proc x {} {}
	namespace ensemble create -map {A x}
	set ::result [namespace ensemble configure ::ns -map]
    }
    namespace delete ns
    set result
} {A ::ns::x}

test namespace-46.1 {ensemble: modification} {
    namespace eval ns {
	namespace export x
	proc x {} {format 123}

	# Ensemble maps A->x
	namespace ensemble create -command ns -map {A ::ns::x}
	set ::result [list [namespace ensemble configure ns -map] [ns A]]

	# Ensemble maps B->x
	namespace ensemble configure ns -map {B ::ns::x}
	lappend ::result [namespace ensemble configure ns -map] [ns B]

	# Ensemble maps x->x
	namespace ensemble configure ns -map {}
	lappend ::result [namespace ensemble configure ns -map] [ns x]
    }
    namespace delete ns
    set result
} {{A ::ns::x} 123 {B ::ns::x} 123 {} 123}
2049
2050
2051
2052
2053
2054
2055
2056

2057
2058
2059
2060
2061
2062
2063
1813
1814
1815
1816
1817
1818
1819

1820
1821
1822
1823
1824
1825
1826
1827







-
+







    ns a [ns b 10]
    catch {rename p {}}
    rename ns p
    p a [p b 3000]
    lappend result $ns::count
    namespace delete ns
    lappend result [info command p]
} {1 {wrong # args: should be "ns subcommand ?arg ...?"} 10 3010 3010 {}}
} {1 {wrong # args: should be "ns subcommand ?argument ...?"} 10 3010 3010 {}}
test namespace-46.4 {ensemble: implementation errors} {
    namespace eval ns {
	namespace ensemble create
    }
    set result [info command ns]
    lappend result [catch {ns ?} msg] $msg
    namespace delete ns
2199
2200
2201
2202
2203
2204
2205
2206

2207
2208
2209
2210
2211
2212
2213
1963
1964
1965
1966
1967
1968
1969

1970
1971
1972
1973
1974
1975
1976
1977







-
+







    set result {}
    set target {}
    lappend result [catch {foo bar} msg] $msg
    set target {lappend result boo hoo}
    lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo]
    rename foo {}
    set result
} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -parameters {} -prefixes 1 -subcommands {} -unknown bar}}
} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -prefixes 1 -subcommands {} -unknown bar}}
test namespace-47.6 {ensemble: unknown handler} {
    namespace ensemble create -command foo -unknown bar
    proc bar {args} {
	return "\{"
    }
    set result [list [catch {foo bar} msg] $msg $::errorInfo]
    rename foo {}
2266
2267
2268
2269
2270
2271
2272
2273

2274
2275
2276
2277
2278
2279
2280
2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043
2044







-
+







    set result [list [namespace ensemble config bar]]
    bar x 123
    bar y 456
    namespace ensemble config bar -unknown ::foo::u2
    bar z 789
    namespace delete foo
    set result
} {{-map {} -namespace ::foo -parameters {} -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
} {{-map {} -namespace ::foo -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
test namespace-48.2 {ensembles and namespace import: exists} {
    namespace eval foo {
	namespace ensemble create -command ::foo::bar
	namespace export bar
    }
    set result     [namespace ensemble exist foo::bar]
    lappend result [namespace ensemble exist bar]
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
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







-
+
















-








-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    rename DeleteTrace ""
}

test namespace-50.1 {ensembles affect proc arguments error messages} -body {
    namespace ens cre -command a -map {b {bb foo}}
    proc bb {c d {e f} args} {list $c $args}
    a b
} -returnCodes error -result "wrong # args: should be \"a b d ?e? ?arg ...?\"" -cleanup {
} -returnCodes error -result "wrong # args: should be \"a b d ?e? ...\"" -cleanup {
    rename a {}
    rename bb {}
}
test namespace-50.2 {ensembles affect WrongNumArgs error messages} -body {
    namespace ens cre -command a -map {b {string is}}
    a b boolean
} -returnCodes error -result "wrong # args: should be \"a b class ?-strict? ?-failindex var? str\"" -cleanup {
    rename a {}
}
test namespace-50.3 {chained ensembles affect error messages} -body {
    namespace ens cre -command a -map {b c}
    namespace ens cre -command c -map {d e}
    proc e f {}
    a b d
} -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup {
    rename a {}
    rename c {}
}
test namespace-50.4 {chained ensembles affect error messages} -body {
    namespace ens cre -command a -map {b {c d}}
    namespace ens cre -command c -map {d {e f}}
    proc e f {}
    a b d
} -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup {
    rename a {}
    rename c {}
}
test namespace-50.5 {[4402cfa58c]} -setup {
    proc bar {ev} {}
    proc bingo {xx} {}
    namespace ensemble create -command launch -map {foo bar event bingo}
    set result {}
} -body {
    catch {launch foo} m; lappend result $m
    catch {launch ev} m; lappend result $m
    catch {launch foo} m; lappend result $m
} -cleanup {
    rename launch {}
    rename bingo {}
    rename bar {}
} -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}}
test namespace-50.6 {[4402cfa58c]} -setup {
    proc target {x y} {}
    namespace ensemble create -command e2 -map {s2 target}
    namespace ensemble create -command e1 -map {s1 e2}
    set result {}
} -body {
    set s s
    catch {e1 s1 s2 a} m; lappend result $m
    catch {e1 $s s2 a} m; lappend result $m
    catch {e1 s1 $s a} m; lappend result $m
    catch {e1 $s $s a} m; lappend result $m
} -cleanup {
    rename e1 {}
    rename e2 {}
    rename target {}
} -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}}
test namespace-50.7 {[4402cfa58c]} -setup {
    proc target {x y} {}
    namespace ensemble create -command e2 -map {s2 target}
    namespace ensemble create -command e1 -map {s1 e2} -parameters foo
    set result {}
} -body {
    set s s
    catch {e1 s2 s1 a} m; lappend result $m
    catch {e1 $s s1 a} m; lappend result $m
    catch {e1 s2 $s a} m; lappend result $m
    catch {e1 $s $s a} m; lappend result $m
} -cleanup {
    rename e1 {}
    rename e2 {}
    rename target {}
} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}}
test namespace-50.8 {[f961d7d1dd]} -setup {
    proc target {} {}
    namespace ensemble create -command e -map {s target} -parameters {{a b}}
} -body {
    e
} -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup {
    rename e {}
    rename target {}
}
test namespace-50.9 {[cea0344a51]} -body {
    namespace eval foo {
	namespace eval bar {
	    namespace delete foo
	}
    }
} -returnCodes error -result {unknown namespace "foo" in namespace delete command}

test namespace-51.1 {name resolution path control} -body {
    namespace eval ::test_ns_1 {
	namespace eval test_ns_2 {
	    proc pathtestA {} {
		::return [pathtestB],[pathtestC],[pathtestD],[namespace path]
	    }
2731
2732
2733
2734
2735
2736
2737

2738
2739
2740
2741
2742
2743
2744
2745

2746
2747
2748
2749
2750
2751
2752
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445

2446
2447
2448
2449
2450
2451
2452
2453







+







-
+







    }
} -result {2 {} 2} -cleanup {
    catch {namespace delete ::test_ns_1}
    catch {namespace delete ::test_ns_2}
    catch {namespace delete ::test_ns_3}
    catch {namespace delete ::test_ns_4}
}

test namespace-51.13 {name resolution path control} -body {
    set ::result {}
    namespace eval ::test_ns_1 {
	proc foo {} {lappend ::result 1}
    }
    namespace eval ::test_ns_2 {
	proc foo {} {lappend ::result 2}
	trace add command foo delete "namespace eval ::test_ns_3 foo;#"
	trace add command foo delete {namespace eval ::test_ns_3 foo;#}
    }
    namespace eval ::test_ns_3 {
	proc foo {} {
	    lappend ::result 3
	    namespace delete [namespace current]
	    ::test_ns_4::bar
	}
2761
2762
2763
2764
2765
2766
2767
2768

2769
2770
2771

2772
2773
2774




2775
2776

2777
2778

2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791

2792
2793
2794
2795

2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816



2817
2818

2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
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







-
+



+
-
-
-
+
+
+
+
-
-
+
-
-
+












-
+



-
+


















-
-
-
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    # Should the result be "2 {} {2 3 2 1}" instead?
} -result {2 {} {2 3 1 1}} -cleanup {
    catch {namespace delete ::test_ns_1}
    catch {namespace delete ::test_ns_2}
    catch {namespace delete ::test_ns_3}
    catch {namespace delete ::test_ns_4}
}
test namespace-51.14 {name resolution path control} -setup {
test namespace-51.14 {name resolution path control} -body {
    foreach cmd [info commands foo*] {
	rename $cmd {}
    }
    proc foo0 {} {}
    namespace eval ::test_ns_1 {}
    namespace eval ::test_ns_2 {}
    namespace eval ::test_ns_3 {}
    namespace eval ::test_ns_1 {
	proc foo1 {} {}
    }
    namespace eval ::test_ns_2 {
} -body {
    proc foo0 {} {}
	proc foo2 {} {}
    proc ::test_ns_1::foo1 {} {}
    proc ::test_ns_2::foo2 {} {}
    }
    namespace eval ::test_ns_3 {
	variable result {}
	lappend result [info commands foo*]
	namespace path {::test_ns_1 ::test_ns_2}
	lappend result [info commands foo*]
	proc foo2 {} {}
	lappend result [info commands foo*]
	rename foo2 {}
	lappend result [info commands foo*]
	namespace delete ::test_ns_1
	lappend result [info commands foo*]
    }
} -cleanup {
} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} -cleanup {
    catch {namespace delete ::test_ns_1}
    catch {namespace delete ::test_ns_2}
    catch {namespace delete ::test_ns_3}
} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}}
}
test namespace-51.15 {namespace resolution path control} -body {
    namespace eval ::test_ns_2 {
	proc foo {} {return 2}
    }
    namespace eval ::test_ns_1 {
	namespace eval test_ns_2 {
	    proc foo {} {return 1_2}
	}
	namespace eval test_ns_3 {
	    namespace path ::test_ns_1
	    test_ns_2::foo
	}
    }
} -result 1_2 -cleanup {
    namespace delete ::test_ns_1
    namespace delete ::test_ns_2
}
test namespace-51.16 {Bug 1566526} {
    interp create child
    child eval namespace eval demo namespace path ::
    interp delete child
    interp create slave
    slave eval namespace eval demo namespace path ::
    interp delete slave
} {}
test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup {
test namespace-51.17 {Bug 3185407} -setup {
    set result {}
    catch {namespace delete ::a}
} -body {
    namespace eval ::a {
	proc c {} {lappend ::result A}
	c
	namespace eval b {
	    variable d c
	    lappend ::result [catch { $d }]
	}
	lappend ::result .
	namespace eval b {
	    namespace path [namespace parent]
	    $d;[format %c 99]
	}
	lappend ::result .
	namespace eval b {
	    proc c {} {lappend ::result B}
	    $d;[format %c 99]
	}
	lappend ::result .
    }
    namespace eval ::a::b {
	$d;[format %c 99]
	lappend ::result .
	proc ::c {} {lappend ::result G}
	$d;[format %c 99]
	lappend ::result .
	rename ::a::c {}
	$d;[format %c 99]
	lappend ::result .
	rename ::a::b::c {}
	$d;[format %c 99]
    }
} -cleanup {
    namespace delete ::a
    catch {rename ::c {}}
    unset result
} -result {A 1 . A A . B B . B B . B B . B B . G G}
test namespace-51.18 {Bug 3185407} -setup {
    namespace eval ::test_ns_1 {}
} -body {
    namespace eval ::test_ns_1 {
	variable result {}
	namespace eval ns {proc foo {} {}}
	namespace eval ns2 {proc foo {} {}}
	namespace path {ns ns2}
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
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
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717







-
+

-
+





-
+


-
-
+
+














-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












    rename ::unknown unknown.save
    namespace eval :: {
	proc unknown args {
	    return SUCCESS
	}
    }
    catch {rename ::noSuchCommand {}}
    set ::child [interp create]
    set ::slave [interp create]
} -body {
    $::child alias bar noSuchCommand
    $::slave alias bar noSuchCommand
    namespace eval test_ns_1 {
	namespace unknown unknown
	proc unknown args {
	    return FAIL
	}
	$::child eval bar
	$::slave eval bar
    }
} -cleanup {
    interp delete $::child
    unset ::child
    interp delete $::slave
    unset ::slave
    namespace delete test_ns_1
    rename ::unknown {}
    rename unknown.save ::unknown
    namespace eval :: [list namespace unknown $handler]
} -result SUCCESS
test namespace-52.12 {unknown: error case must not reset handler} -body {
    namespace eval foo {
	namespace unknown ok
	catch {namespace unknown {{}{}{}}}
	namespace unknown
    }
} -cleanup {
    namespace delete foo
} -result ok

    
# TIP 314 - ensembles with parameters
test namespace-53.1 {ensembles: parameters} {
    namespace eval ns {
	namespace export x
	proc x {para} {list 1 $para}
	namespace ensemble create -parameters {para1}
    }
    list [info command ns] [ns bar x] [namespace delete ns] [info command ns]
} {ns {1 bar} {} {}}
test namespace-53.2 {ensembles: parameters} -setup {
    namespace eval ns {
	namespace export x
	proc x {para} {list 1 $para}
	namespace ensemble create
    }
} -body {
    namespace ensemble configure ns -parameters {para1}
    rename ns foo
    list [info command foo] [foo bar x] [namespace delete ns] [info command foo]
} -result {foo {1 bar} {} {}}
test namespace-53.3 {ensembles: parameters} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {para} {list 1 $para}
	proc x2 {para} {list 2 $para}
	namespace ensemble create -parameters param1
    }
} -body {
    set result [list [ns x2 x1] [ns x1 x2]]
    lappend result [catch {ns x} msg] $msg
    lappend result [catch {ns x x} msg] $msg
    rename ns {}
    lappend result [info command ns::x1]
    namespace delete ns
    lappend result [info command ns::x1]
} -result\
   {{1 x2} {2 x1}\
    1 {wrong # args: should be "ns param1 subcommand ?arg ...?"}\
    1 {unknown or ambiguous subcommand "x": must be x1, or x2}\
    ::ns::x1 {}}
test namespace-53.4 {ensembles: parameters} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {a1 a2} {list 1 $a1 $a2}
	proc x2 {a1 a2} {list 2 $a1 $a2}
	proc x3 {a1 a2} {list 3 $a1 $a2}
	namespace ensemble create
    }
} -body {
    set result {}
    lappend result [ns x1 x2 x3]
    namespace ensemble configure ns -parameters p1
    lappend result [ns x1 x2 x3]
    namespace ensemble configure ns -parameters {p1 p2}
    lappend result [ns x1 x2 x3]
} -cleanup {
    namespace delete ns
} -result {{1 x2 x3} {2 x1 x3} {3 x1 x2}}
test namespace-53.5 {ensembles: parameters} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {para} {list 1 $para}
	proc x2 {para} {list 2 $para}
	proc x3 {para} {list 3 $para}
	namespace ensemble create
    }
} -body {
    set result [list [catch {ns x x1} msg] $msg]
    lappend result [catch {ns x1 x} msg] $msg
    namespace ensemble configure ns -parameters p1
    lappend result [catch {ns x1 x} msg] $msg
    lappend result [catch {ns x x1} msg] $msg
} -cleanup {
    namespace delete ns
} -result\
   {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
    0 {1 x}\
    1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
    0 {1 x}}
test namespace-53.6 {ensembles: nested} -setup {
    namespace eval ns {
	namespace export x*
	namespace eval x0 {
	    proc z {args} {list 0 $args}
	    namespace export z
	    namespace ensemble create
	}
	proc x1 {args} {list 1 $args}
	proc x2 {args} {list 2 $args}
	proc x3 {args} {list 3 $args}
	namespace ensemble create -parameters p
    }
} -body {
    list [ns z x0] [ns z x1] [ns z x2] [ns z x3]
} -cleanup {
    namespace delete ns
} -result {{0 {}} {1 z} {2 z} {3 z}}
test namespace-53.7 {ensembles: parameters & wrong # args} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {a1 a2 a3 a4} {list x1 $a1 $a2 $a3 $a4}
	namespace ensemble create -parameters p1
    }
} -body {
    set result {}
    lappend result [catch {ns} msg] $msg
    lappend result [catch {ns x1} msg] $msg
    lappend result [catch {ns x1 x1} msg] $msg
    lappend result [catch {ns x1 x1 x1} msg] $msg
    lappend result [catch {ns x1 x1 x1 x1} msg] $msg
    lappend result [catch {ns x1 x1 x1 x1 x1} msg] $msg
} -cleanup {
    namespace delete ns
} -result\
   {1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
    1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
    1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
    1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
    1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
    0 {x1 x1 x1 x1 x1}}
test namespace-53.8 {ensemble: unknown handler changing -parameters} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {a1} {list 1 $a1}
	proc Magic {ensemble subcmd args} {
	    namespace ensemble configure $ensemble\
              -parameters [lrange p1 [llength [
                namespace ensemble configure $ensemble -parameters
              ]] 0]
            list
	}
	namespace ensemble create -unknown ::ns::Magic
    }
} -body {
    set result {}
    lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
    lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
    lappend result [catch {ns x2 x3} msg] $msg [namespace ensemble configure ns -parameters]
} -cleanup {
    namespace delete ns
} -result\
   {0 {1 x2} {}\
    0 {1 x2} p1\
    1 {unknown or ambiguous subcommand "x2": must be x1} {}}
test namespace-53.9 {ensemble: unknown handler changing -parameters,\
  thereby eating all args} -setup {
    namespace eval ns {
	namespace export x*
	proc x1 {args} {list 1 $args}
	proc Magic {ensemble subcmd args} {
	    namespace ensemble configure $ensemble\
              -parameters {p1 p2 p3 p4 p5}
            list
	}
	namespace ensemble create -unknown ::ns::Magic
    }
} -body {
    set result {}
    lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
    lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
    lappend result [catch {ns a1 a2 a3 a4 a5 x1} msg] $msg [namespace ensemble configure ns -parameters]
} -cleanup {
    namespace delete ns
} -result\
   {0 {1 x2} {}\
    1 {wrong # args: should be "ns p1 p2 p3 p4 p5 subcommand ?arg ...?"} {p1 p2 p3 p4 p5}\
    0 {1 {a1 a2 a3 a4 a5}} {p1 p2 p3 p4 p5}}
test namespace-53.10 {ensembles: nested rewrite} -setup {
    namespace eval ns {
	namespace export x
	namespace eval x {
	    proc z0 {} {list 0}
	    proc z1 {a1} {list 1 $a1}
	    proc z2 {a1 a2} {list 2 $a1 $a2}
	    proc z3 {a1 a2 a3} {list 3 $a1 $a2 $a3}
	    namespace export z*
	    namespace ensemble create
	}
	namespace ensemble create -parameters p
    }
} -body {
    set result {}
    # In these cases, parsing the subensemble does not grab a new word.
    lappend result [catch {ns z0 x} msg] $msg
    lappend result [catch {ns z1 x} msg] $msg
    lappend result [catch {ns z2 x} msg] $msg
    lappend result [catch {ns z2 x v} msg] $msg
    namespace ensemble configure ns::x -parameters q1
    # In these cases, parsing the subensemble grabs a new word.
    lappend result [catch {ns v x z0} msg] $msg
    lappend result [catch {ns v x z1} msg] $msg
    lappend result [catch {ns v x z2} msg] $msg
    lappend result [catch {ns v x z2 v2} msg] $msg
} -cleanup {
    namespace delete ns
} -result\
   {0 0\
    1 {wrong # args: should be "ns z1 x a1"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "ns z2 x a1 a2"}\
    1 {wrong # args: should be "::ns::x::z0"}\
    0 {1 v}\
    1 {wrong # args: should be "ns v x z2 a2"}\
    0 {2 v v2}}
test namespace-53.11 {ensembles: nested rewrite} -setup {
    namespace eval ns {
	namespace export x
	namespace eval x {
	    proc z2 {a1 a2} {list 2 $a1 $a2}
	    namespace export z*
	    namespace ensemble create -parameter p
	}
	namespace ensemble create
    }
} -body {
    list [catch {ns x 1 z2} msg] $msg
} -cleanup {
    namespace delete ns
    unset -nocomplain msg
} -result {1 {wrong # args: should be "ns x 1 z2 a2"}}

test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
-setup {
    proc getbytes {} {
	set lines [split [memory info] "\n"]
	lindex $lines 3 3
    }
} -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	set ns ::y$i
	namespace eval $ns {}
	namespace delete $ns
	set start $end
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $start}]
} -cleanup {
    rename getbytes {}
    unset i ns start end
} -result 0

test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} {
    info class [format %s constructor] oo::object
} ""

test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	proc abc {} {}
	proc def {} {}
	trace add command abc delete "rename ::testing::def {}; #"
	trace add command def delete "rename ::testing::abc {}; #"
    }
    namespace delete ::testing
} {}
test namespace-56.2 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	namespace eval abc {proc xyz {} {}}
	namespace eval def {proc xyz {} {}}
	trace add command abc::xyz delete "namespace delete ::testing::def {}; #"
	trace add command def::xyz delete "namespace delete ::testing::abc {}; #"
    }
    namespace delete ::testing
} {}
test namespace-56.3 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	variable gone {}
	oo::class create CB {
	    variable cmd
	    constructor other {set cmd $other}
	    destructor {rename $cmd {}; lappend ::testing::gone $cmd}
	}
	namespace eval abc {
	    ::testing::CB create def ::testing::abc::ghi
	    ::testing::CB create ghi ::testing::abc::def
	}
	namespace delete abc
	try {
	    return [lsort $gone]
	} finally {
	    namespace delete ::testing
	}
    }
} {::testing::abc::def ::testing::abc::ghi}

test namespace-56.4 {bug 16fe1b5807: names starting with ":"} knownBug {
namespace eval : {
    namespace ensemble create
    namespace export *
    proc p1 {} {
	    return 16fe1b5807
    }
}

: p1
} 16fe1b5807

test namespace-56.5 {Bug 8b9854c3d8} -setup {
    namespace eval namespace-56.5 {
	proc cmd {} {string match ::* [lindex [[string cat info] level 0] 0]}
	namespace export *
	namespace ensemble create
    }
} -body {
    namespace-56.5 cmd
} -cleanup {
    namespace delete namespace-56.5
} -result 1



test namespace-57.0 {
    an imported alias should be usable in the deletion trace for the alias

    see 29e8848eb976
} -body {
    variable res {}
    namespace eval ns2 {
	namespace export *
	proc p1 {oldname newname op} {
	    return success
	}

	interp alias {} [namespace current]::p2 {} [namespace which p1]
    }


    namespace eval ns3 {
	namespace import ::ns2::p2
    }


    set ondelete [list apply [list {oldname newname op} {
	variable res
	catch {
		ns3::p2 $oldname $newname $op
	} cres
	lappend res $cres
    } [namespace current]]]


    trace add command ::ns2::p2 delete $ondelete
    rename ns2::p2 {}
    return $res
} -cleanup {
    unset res
    namespace delete ns2
    namespace delete ns3
} -result success




# cleanup
catch {rename cmd1 {}}
catch {unset l}
catch {unset msg}
catch {unset trigger}
namespace delete {*}[namespace children :: test_ns_*]
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/notify.test.

9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
25
26
27
28
29
30
9
10
11
12
13
14
15


16
17
18
19
20



21
22
23
24
25
26
27







-
-
+
+



-
-
-







# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testevent [llength [info commands testevent]]

test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \
    -constraints {testevent} \
    -body {
	set delivered {}
	after 10 set done 1

Deleted tests/nre.test.

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
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
450
451
452
453





































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  proc, apply, [interp alias], [namespce import]
#
# This file contains a collection of tests for the non-recursive executor that
# avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the
# actual command functionality is tested in the specific test file.
#
# Copyright (c) 2008 by Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testnrelevels [llength [info commands testnrelevels]]

#
# The tests that risked blowing the C stack on failure have been removed: we
# can now actually measure using testnrelevels.
#

if {[testConstraint testnrelevels]} {
    namespace eval testnre {
	namespace path ::tcl::mathop
	#
	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
	# cmdFrame level, callFrame level, tosPtr and callback depth
	#
	variable last [testnrelevels]
	proc depthDiff {} {
	    variable last
	    set depth [testnrelevels]
	    set res {}
	    foreach t $depth l $last {
		lappend res [expr {$t-$l}]
	    }
	    set last $depth
	    return $res
	}
	proc setabs {} {
	    variable abs [- [lindex [testnrelevels] 0]]
	}

	variable body0 {
	    set x [depthDiff]
	    if {[incr i] > 10} {
		namespace upvar [namespace qualifiers \
			[namespace origin depthDiff]] abs abs
		incr abs [lindex [testnrelevels] 0]
		return [list [lrange $x 0 3] $abs]
	    }
	}
	proc makebody txt {
	    variable body0
	    return "$body0; $txt"
	}
	namespace export *
    }
    namespace import testnre::*
}

test nre-0.1 {levels while unwinding} -body {
    testnreunwind
} -constraints {
    testnrelevels
} -result {0 0 0}

test nre-1.1 {self-recursive procs} -setup {
    proc a i [makebody {a $i}]
} -body {
    setabs
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 1 1 1} 0}
test nre-1.2 {self-recursive lambdas} -setup {
    set a [list i [makebody {apply $::a $i}]]
} -body {
    setabs
    apply $a 0
} -cleanup {
    unset a
} -constraints {
    testnrelevels
} -result {{0 1 1 1} 0}
test nre-1.3 {mutually recursive procs and lambdas} -setup {
    proc a i {
	apply $::b [incr i]
    }
    set b [list i [makebody {a $i}]]
} -body {
    setabs
    a 0
} -cleanup {
    rename a {}
    unset b
} -constraints {
    testnrelevels
} -result {{0 2 2 2} 0}

#
# Test that aliases are non-recursive
#

test nre-2.1 {alias is not recursive} -setup {
    proc a i [makebody {b $i}]
    interp alias {} b {} a
} -body {
    setabs
    a 0
} -cleanup {
    rename a {}
    rename b {}
} -constraints {
    testnrelevels
} -result {{0 2 1 1} 0}

#
# Test that imports are non-recursive
#

test nre-3.1 {imports are not recursive} -setup {
    namespace eval foo {
	setabs
	namespace export a
    }
    proc foo::a i [makebody {::a $i}]
    namespace import foo::a
} -body {
    a 0
} -cleanup {
    rename a {}
    namespace delete ::foo
} -constraints {
    testnrelevels
} -result {{0 2 1 1} 0}

test nre-4.1 {ensembles are not recursive} -setup {
    proc a i [makebody {b foo $i}]
    namespace ensemble create \
	-command b \
	-map [list foo a]
} -body {
    setabs
    a 0
} -cleanup {
    rename a {}
    rename b {}
} -constraints {
    testnrelevels
} -result {{0 2 1 1} 0}

test nre-4.2 {(compiled) ensembles do not break tailcall} -setup {
    # Fix Bug d87cb18205
    proc b {} {
	tailcall append result first
    }
    set map [namespace ensemble configure ::dict -map]
    dict set map a b
    namespace ensemble configure ::dict -map $map
    proc demo {} {
	dict a
	append result second
    }
} -body {
    demo
} -cleanup {
    rename demo {}
    namespace ensemble configure ::dict -map [dict remove $map a]
    unset map
    rename b {}
} -result firstsecond

test nre-5.1 {[namespace eval] is not recursive} -setup {
    namespace eval ::foo {
	setabs
    }
    proc foo::a i [makebody {namespace eval ::foo [list a $i]}]
} -body {
    ::foo::a 0
} -cleanup {
    namespace delete ::foo
} -constraints {
    testnrelevels
} -result {{0 2 2 2} 0}
test nre-5.2 {[namespace eval] is not recursive} -setup {
    namespace eval ::foo {
	setabs
    }
    proc foo::a i [makebody {namespace eval ::foo "set x $i; a $i"}]
} -body {
    foo::a 0
} -cleanup {
    namespace delete ::foo
} -constraints {
    testnrelevels
} -result {{0 2 2 2} 0}

test nre-6.1 {[uplevel] is not recursive} -setup {
    proc a i [makebody {uplevel 1 [list a $i]}]
} -body {
    setabs
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 2 2 0} 0}
test nre-6.2 {[uplevel] is not recursive} -setup {
    setabs
    proc a i [makebody {uplevel 1 "set x $i; a $i"}]
} -body {
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 2 2 0} 0}

test nre-7.1 {[catch] is not recursive} -setup {
    setabs
    proc a i [makebody {uplevel 1 "catch {a $i} msg; set msg"}]
} -body {
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 3 3 0} 0}
test nre-7.2 {[if] is not recursive} -setup {
    setabs
    proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
} -body {
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 2 2 0} 0}
test nre-7.3 {[while] is not recursive} -setup {
    setabs
    proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
} -body {
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 2 2 0} 0}
test nre-7.4 {[for] is not recursive} -setup {
    setabs
    proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
} -body {
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 2 2 0} 0}
test nre-7.5 {[foreach] is not recursive} -setup {
    #
    # Enable once [foreach] is NR-enabled
    #
    setabs
    proc a i [makebody {uplevel 1 "foreach j {1 2 3 4 5 6} {set res \[a $i\]; break}; set res"}]
} -body {
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 3 3 0} 0}
test nre-7.6 {[eval] is not recursive} -setup {
    proc a i [makebody {eval [list a $i]}]
} -body {
    setabs
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 2 2 1} 0}
test nre-7.7 {[eval] is not recursive} -setup {
    proc a i [makebody {eval "a $i"}]
} -body {
    setabs
    a 0
} -cleanup {
    rename a {}
} -constraints {
    testnrelevels
} -result {{0 2 2 1} 0}
test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
    proc foo args {}
    foo
    coroutine bar apply {{} {
	yield
	proc foo args {return ok}
	while 1 {
	    yield [incr i]
	    foo
	}
    }}
} -body {
    # if switching to plain eval is not nre aware, this will cause a "cannot
    # yield" error
    list [bar] [bar] [bar]
} -cleanup {
    rename bar {}
    rename foo {}
} -result {1 2 3}

test nre-8.1 {nre and {*}} -body {
    # force an expansion that grows the evaluation stack, check that nre
    # adapts the TEBCdataPtr. This crashes on failure.
    proc inner {} {
	set long [lrepeat 1000000 1]
	list {*}$long
    }
    proc outer {} inner
    lrange [outer] 0 2
} -cleanup {
    rename inner {}
    rename outer {}
} -result {1 1 1}
test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
    # force an expansion that grows the evaluation stack, check that nre
    # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
    # done properly.
    proc nop {} {}
    proc crash {} {
	foreach val [list {*}[lrepeat 100000 x]] {
	    nop
	}
    }
    crash
} -cleanup {
    rename nop {}
    rename crash {}
}

#
#  Basic TclOO tests
#

test nre-oo.1 {really deep calls in oo - direct} -setup {
    oo::object create foo
    oo::objdefine foo method bar i [makebody {foo bar $i}]
} -body {
    setabs
    foo bar 0
} -cleanup {
    foo destroy
} -constraints {
    testnrelevels
} -result {{0 1 1 1} 0}
test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
    oo::object create foo
    oo::objdefine foo method bar i [makebody {[self] bar $i}]
} -body {
    setabs
    foo bar 0
} -cleanup {
    foo destroy
} -constraints {
    testnrelevels
} -result {{0 1 1 1} 0}
test nre-oo.3 {really deep calls in oo - private calls} -setup {
    oo::object create foo
    oo::objdefine foo method bar i [makebody {my bar $i}]
} -body {
    setabs
    foo bar 0
} -cleanup {
    foo destroy
} -constraints {
    testnrelevels
} -result {{0 1 1 1} 0}
test nre-oo.4 {really deep calls in oo - overriding} -setup {
    oo::class create foo {
	method bar i [makebody {my bar $i}]
    }
    oo::class create boo {
	superclass foo
	method bar i [makebody {next $i}]
    }
} -body {
    setabs
    [boo new] bar 0
} -cleanup {
    foo destroy
} -constraints {
    testnrelevels
} -result {{0 1 1 1} 0}
test nre-oo.5 {really deep calls in oo - forwards} -setup {
    oo::object create foo
    set body [makebody {my boo $i}]
    oo::objdefine foo "
	method bar i {$body}
	forward boo ::foo bar
    "
} -body {
    setabs
    foo bar 0
} -cleanup {
    foo destroy
} -constraints {
    testnrelevels
} -result {{0 2 1 1} 0}

#
# NASTY BUG found by tcllib's interp package
#

test nre-X.1 {eval in wrong interp} -setup {
    set i [interp create]
    $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}}
} -body {
    $i eval {
	set x {namespace children ::}
	set y [list namespace children ::]
	namespace delete {*}[filter [{*}$y]]
	set j [interp create]
	$j alias filter filter
	$j eval {namespace delete {*}[filter [namespace children ::]]}
	namespace eval foo {}
	list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
    }
} -cleanup {
    interp delete $i
} -result {::foo ::foo {} {}}

# cleanup
::tcltest::cleanupTests

if {[testConstraint testnrelevels]} {
    namespace forget testnre::*
    namespace delete testnre
}

return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/obj.test.

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
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













-
-
+
+



-
-
-

-
-
+
+




+




+




-
+
















+
+
+
+
+
+
+
+
+




















-
+








-
+







# Functionality covered: this file contains a collection of tests for the
# procedures in tclObj.c that implement Tcl's basic type support and the
# type managers for the types boolean, double, and integer.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1
    foreach {t} {
	{array search} 
	bytearray
	bytecode
	cmdName
	dict
	end-offset
	regexp
	string
    } {
        set first [string first $t [testobj types]]
        set r [expr {$r && ($first >= 0)}]
        set r [expr {$r && ($first != -1)}]
    }
    set result $r
} {1}

test obj-2.1 {Tcl_GetObjType error} testobj {
    list [testintobj set 1 0] [catch {testobj convert 1 foo} msg] $msg
} {0 1 {no type foo found}}
test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 12]
    lappend result [testobj convert 1 bytearray]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12 12 bytearray 3}

test obj-3.1 {Tcl_ConvertToType error} testobj {
    list [testdoubleobj set 1 12.34] \
	[catch {testobj convert 1 end-offset} msg] \
	 $msg
} {12.34 1 {bad index "12.34": must be end?[+-]integer?}}
test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
    list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
} {{} 1 {bad index "": must be end?[+-]integer?}}

test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} string 2}

test obj-5.1 {Tcl_FreeObj} testobj {
    set result ""
    lappend result [testintobj set 1 12345]
    lappend result [testobj freeallvars]
    lappend result [catch {testintobj get 1} msg]
    lappend result $msg
} {12345 {} 1 {variable 1 is unset (NULL)}}

test obj-6.1 {Tcl_DuplicateObj, object has internal rep} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 47]
    lappend result [testobj duplicate 1 2]
    lappend result [testobj duplicate 1 2]    
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} 47 47 47 2 3}
test obj-6.2 {Tcl_DuplicateObj, "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testobj duplicate 1 2]
    lappend result [testobj duplicate 1 2]    
    lappend result [testintobj get 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} {} {} {} 2 3}

# We assume that testobj is an indicator for test*obj as well

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
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
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
595
596

597
598
599
600

601
602
603
604

605
606
607


608
609
610
611
612

613
614
615
616

617
618
619
620

621
622
623

624
625
626
627
628
629
630
631







-
+


-
-
+
+








-
+







-
+




-
+

-
-
+
+

-
+

-
+



-
+


-
+


-
+


-
+

















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+



-
+



-
+


-
-
+
+



-
+



-
+



-
+


-
+







test obj-26.1 {UpdateStringOfInt} testobj {
    set result ""
    lappend result [testintobj set 1 512]
    lappend result [testintobj mult10 1]
    lappend result [testintobj get 1]       ;# must update string rep
} {512 5120 5120}

test obj-27.1 {Tcl_NewWideObj} testobj {
test obj-27.1 {Tcl_NewLongObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    testintobj setmax 1
    lappend result [testintobj ismax 1]
    testintobj setmaxlong 1
    lappend result [testintobj ismaxlong 1]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 1 int 1}

test obj-28.1 {Tcl_SetLongObj, existing "empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testobj newobj 1]
    lappend result [testintobj setint 1 77]  ;# makes existing obj int
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} {} 77 int 2}
test obj-28.2 {Tcl_SetLongObj, existing non-"empty string" object} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testdoubleobj set 1 12.34]
    lappend result [testintobj setint 1 77]  ;# makes existing obj int
    lappend result [testintobj setlong 1 77]  ;# makes existing obj long int
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
} {{} 12.34 77 int 2}

test obj-29.1 {Tcl_GetWideIntFromObj, existing int object} testobj {
test obj-29.1 {Tcl_GetLongFromObj, existing long integer object} testobj {
    set result ""
    lappend result [testintobj setint 1 22]
    lappend result [testintobj mult10 1]   ;# gets existingint rep
    lappend result [testintobj setlong 1 22]
    lappend result [testintobj mult10 1]   ;# gets existing long int rep
} {22 220}
test obj-29.2 {Tcl_GetWideIntFromObj, convert to int} testobj {
test obj-29.2 {Tcl_GetLongFromObj, convert to long} testobj {
    set result ""
    lappend result [testintobj setint 1 477]
    lappend result [testintobj setlong 1 477]
    lappend result [testintobj div10 1]    ;# must convert to bool
    lappend result [testobj type 1]
} {477 47 int}
test obj-29.3 {Tcl_GetWideIntFromObj, error converting to int} testobj {
test obj-29.3 {Tcl_GetLongFromObj, error converting to long integer} testobj {
    set result ""
    lappend result [teststringobj set 1 abc]
    lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
    lappend result $msg
} {abc 1 {expected integer but got "abc"}}
test obj-29.4 {Tcl_GetWideIntFromObj, error converting from "empty string"} testobj {
test obj-29.4 {Tcl_GetLongFromObj, error converting from "empty string"} testobj {
    set result ""
    lappend result [testobj newobj 1]
    lappend result [catch {testintobj ismax 1} msg] ;# cvts to long int
    lappend result [catch {testintobj ismaxlong 1} msg] ;# cvts to long int
    lappend result $msg
} {{} 1 {expected integer but got ""}}

test obj-30.1 {Ref counting and object deletion, simple types} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [testintobj set 1 1024]
    lappend result [testobj assign 1 2]     ;# vars 1 and 2 share the int obj
    lappend result [testobj type 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
    lappend result [testbooleanobj set 2 0] ;# must copy on write, now 2 objs
    lappend result [testobj type 2]
    lappend result [testobj refcount 1]
    lappend result [testobj refcount 2]
} {{} 1024 1024 int 4 4 0 int 3 2}


test obj-31.1 {regenerate string rep of "end"} testobj {
    testobj freeallvars
    teststringobj set 1 end
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end
test obj-31.2 {regenerate string rep of "end-1"} testobj {
    testobj freeallvars
    teststringobj set 1 end-0x1
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end-1
test obj-31.3 {regenerate string rep of "end--1"} testobj {
    testobj freeallvars
    teststringobj set 1 end--0x1
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end--1
test obj-31.4 {regenerate string rep of "end-bigInteger"} testobj {
    testobj freeallvars
    teststringobj set 1 end-0x7fffffff
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end-2147483647
test obj-31.5 {regenerate string rep of "end--bigInteger"} testobj {
    testobj freeallvars
    teststringobj set 1 end--0x7fffffff
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end--2147483647
test obj-31.6 {regenerate string rep of "end--bigInteger"} {testobj longIs32bit} {
    testobj freeallvars
    teststringobj set 1 end--0x80000000
    testobj convert 1 end-offset
    testobj invalidateStringRep 1
} end--2147483648

test obj-32.1 {freeing very large object trees} {
    set x {}
    for {set i 0} {$i<100000} {incr i} {
	set x [list $x {}]
    }
    unset x
} {}

test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} {
test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x 0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 2147483648}
test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} {
test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x 0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
test obj-33.3 {integer overflow on input} {
test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x 0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 4294967296}
test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} {
} {0 4294967296}
test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x -0x8000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483648}
test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} {
test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x -0x8000; append x 0001
    list [string is integer $x] [expr { wide($x) }]
} {1 -2147483649}
test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} {
test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x -0xffff; append x ffff
    list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
test obj-33.7 {integer overflow on input} {
test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
    set x -0x10000; append x 0000
    list [string is integer $x] [expr { wide($x) }]
} {1 -4294967296}
} {0 -4294967296}

test obj-34.1 {mp_iseven} testobj {
    set result ""
    lappend result [testbignumobj set 1 0]
    lappend result [testbignumobj iseven 1]    ;
    lappend result [testobj type 1]
} {0 1 int}

Deleted tests/oo.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
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
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615
4616
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
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
4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
5029
5030
5031
5032
5033
5034
5035
5036
5037
5038
5039
5040
5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156
5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251
5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265
5266
5267
5268
5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290
5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315
5316
5317
5318
5319
5320
5321
5322
5323
5324
5325
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2006-2013 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# The foundational objects oo::object and oo::class are sensitive to reference
# counting errors and are deallocated only when an interp is deleted, so in
# this test suite, interp creation and interp deletion are often used in
# leaktests in order to leverage this sensitivity.

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}

test oo-0.1 {basic test of OO's ability to clean up its initial state} {
    interp create t
    t eval {
	package require TclOO
    }
    interp delete t
} {}
test oo-0.2 {basic test of OO's ability to clean up its initial state} {
    set i [interp create]
    interp eval $i {
	package require TclOO
	namespace delete ::
    }
    interp delete $i
} {}
test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
        [oo::object new] destroy
    }
} -constraints memory -result 0
test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
	oo::class create foo
	foo new
	foo destroy
    }
} -constraints memory -result 0
test oo-0.5.1 {testing object foundation cleanup} memory {
    leaktest {
	interp create foo
	interp delete foo
    }
} 0
test oo-0.5.2 {testing literal leak on interp delete} memory {
    leaktest {
	interp create foo
	foo eval {oo::object new}
	interp delete foo
    }
} 0
test oo-0.6 {cleaning the core class pair; way #1} -setup {
    interp create t
} -body {
    t eval {
	package require TclOO
	namespace path oo
	list [catch {class destroy} m] $m [catch {object destroy} m] $m
    }
} -cleanup {
    interp delete t
} -result {0 {} 1 {invalid command name "object"}}
test oo-0.7 {cleaning the core class pair; way #2} -setup {
    interp create t
} -body {
    t eval {
	package require TclOO
	namespace path oo
	list [catch {object destroy} m] $m [catch {class destroy} m] $m
    }
} -cleanup {
    interp delete t
} -result {0 {} 1 {invalid command name "class"}}
test oo-0.8 {leak in variable management} -setup {
    oo::class create foo
} -constraints memory -body {
    oo::define foo {
	constructor {} {
	    variable v 0
	}
    }
    leaktest {[foo new] destroy}
} -cleanup {
    foo destroy
} -result 0
test oo-0.9 {various types of presence of the TclOO package} {
    list [lsearch -nocase -all -inline [package names] tcloo] \
	[package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}]
} [list TclOO $::oo::patchlevel 1]

test oo-1.1 {basic test of OO functionality: no classes} {
    set result {}
    lappend result [oo::object create foo]
    lappend result [oo::objdefine foo {
	method bar args {
	    global result
	    lappend result {*}$args
	    return [llength $args]
	}
    }]
    lappend result [foo bar a b c]
    lappend result [foo destroy] [info commands foo]
} {::foo {} a b c 3 {} {}}
test oo-1.2 {basic test of OO functionality: no classes} -body {
    oo::define oo::object method missingArgs
} -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name ?option? args body\""
test oo-1.3 {basic test of OO functionality: no classes} {
    catch {oo::define oo::object method missingArgs}
    set errorInfo
} "wrong # args: should be \"oo::define oo::object method name ?option? args body\"
    while executing
\"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.4.1 {fully-qualified nested name} -body {
    oo::object create ::one::two::three
} -result {::one::two::three}
test oo-1.4.2 {automatic command name has same name as namespace} -body {
    set obj [oo::object new]
    expr {[info object namespace $obj] == $obj}
} -result 1
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 {}
} -returnCodes 1 -result {object "::aninstance" has no visible methods}
test oo-1.7 {basic test of OO functionality} -setup {
    oo::object create aninstance
} -body {
    oo::objdefine aninstance {
	# Do not do this in real code! Ever! This is *not* supported!
	::oo::define::method ha ha ha
    }
} -returnCodes error -cleanup {
    aninstance destroy
} -result {attempt to misuse API}
test oo-1.8 {basic test of OO functionality} -setup {
    oo::object create obj
    set result {}
} -cleanup {
    obj destroy
} -body {
    oo::objdefine obj method foo {} {return bar}
    lappend result [obj foo]
    oo::objdefine obj method foo {} {}
    lappend result [obj foo]
} -result {bar {}}
test oo-1.9 {basic test of OO functionality} -setup {
    oo::object create a
    oo::object create b
} -cleanup {
    catch {a destroy}
    b destroy
} -body {
    oo::objdefine a method foo {} { return A }
    oo::objdefine b method foo {} { return B }
    apply {{} {
	set m foo
	return [a $m],[a destroy],[b $m]
    }}
} -result A,,B
test oo-1.10 {basic test of OO functionality} -body {
    namespace eval foo {
	namespace eval bar {
	    oo::object create o
	    namespace export o
	}
	namespace import bar::o
    }
    list [info object isa object foo::bar::o] [info object isa object foo::o]
} -cleanup {
    namespace delete foo
} -result {1 1}
test oo-1.11 {basic test of OO functionality: abbreviating} -setup {
    oo::class create c
} -cleanup {
    c destroy
} -body {
    oo::define c super oo::class
    info class super c
} -result ::oo::class
test oo-1.12 {basic test of OO functionality: abbreviating} -setup {
    oo::class create c
} -cleanup {
    c destroy
} -body {
    oo::define c {super oo::class}
    info class super c
} -result ::oo::class
test oo-1.13 {basic test of OO functionality: abbreviating} -setup {
    oo::class create c
} -cleanup {
    c destroy
} -body {
    oo::define c self {forw a b}
    info object forw c a
} -result b
test oo-1.14 {basic test of OO functionality: abbreviating} -setup {
    oo::class create c
} -cleanup {
    c destroy
} -body {
    oo::define c self forw a b
    info object forw c a
} -result b
test oo-1.15 {basic test of OO functionality: abbreviating} -setup {
    oo::object create o
} -cleanup {
    o destroy
} -body {
    oo::objdefine o {forw a b}
    info object forw o a
} -result b
test oo-1.16 {basic test of OO functionality: abbreviating} -setup {
    oo::object create o
} -cleanup {
    o destroy
} -body {
    oo::objdefine o forw a b
    info object forw o a
} -result b
test oo-1.17 {basic test of OO functionality: Bug 2481109} -body {
    namespace eval ::foo {oo::object create lreplace}
} -cleanup {
    namespace delete ::foo
} -result ::foo::lreplace
# Check for Bug 2519474; problem in tclNamesp.c, but tested here...
test oo-1.18 {OO: create object in NS with same name as global cmd} -setup {
    proc test-oo-1.18 {} return
    oo::class create A
    oo::class create B {superclass A}
} -body {
    oo::define B constructor {} {A create test-oo-1.18}
    B create C
} -cleanup {
    rename test-oo-1.18 {}
    A destroy
} -result ::C
test oo-1.18.1 {no memory leak: superclass} -setup {
} -constraints memory -body {

    leaktest {
	interp create t
	t eval {
	    oo::class create A {
		superclass oo::class
	    }
	}
	interp delete t
    }
} -cleanup {
} -result 0
test oo-1.18.2 {Bug 75b8433707: memory leak in oo-1.18} -setup {
    proc test-oo-1.18 {} return
} -constraints memory -body {
    leaktest {
	oo::class create A
	oo::class create B {superclass A}
	oo::define B constructor {} {A create test-oo-1.18}
	B create C
	A destroy
    }
} -cleanup {
    rename test-oo-1.18 {}
} -result 0
test oo-1.18.3 {Bug 21c144f0f5} -setup {
    interp create child
} -body {
    child eval {
	oo::define [oo::class create foo] superclass oo::class
	oo::class destroy
    }
} -cleanup {
    interp delete child
}
test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup {
    interp create child
} -body {
    child eval {
	oo::class create A
	oo::class create B {
	    superclass oo::class
	    constructor {} {
		next {superclass A}
		next {superclass -append A}
	    }
	}
	[B create C] create d
    }
} -returnCodes error -cleanup {
    interp delete child
} -result {class should only be a direct superclass once}
test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup {
    interp create child
} -body {
    child eval {
	oo::class create A
	oo::class create B {
	    superclass oo::class
	    constructor {c} {
		next {superclass A}
		next [list superclass -append {*}$c]
	    }
	}
	[B create C {B C}] create d
    }
} -returnCodes error -cleanup {
    interp delete child
} -result {attempt to form circular dependency graph}
test oo-1.19 {basic test of OO functionality: teardown order} -body {
    oo::object create o
    namespace delete [info object namespace o]
    o destroy
    # Crashes on error
} -returnCodes error -result {invalid command name "o"}
test oo-1.20 {basic test of OO functionality: my teardown post rename} -body {
    oo::object create obj
    rename [info object namespace obj]::my ::AGlobalName
    obj destroy
    info commands ::AGlobalName
} -result {}
test oo-1.21 {basic test of OO functionality: default relations} -setup {
    set fresh [interp create]
} -body {
    lmap x [$fresh eval {
	set initials {::oo::object ::oo::class ::oo::Slot}
	foreach cmd {instances subclasses mixins superclass} {
	    foreach initial $initials {
		lappend x [info class $cmd $initial]
	    }
	}
	foreach initial $initials {
	    lappend x [info object class $initial]
	}
	return $x
    }] {lsort [lsearch -all -not -inline $x *::delegate]}
} -cleanup {
    interp delete $fresh
} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}

test oo-2.1 {basic test of OO functionality: constructor} -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
    }
} -body {
    subinterp eval {
	oo::define oo::object constructor {} {
	    lappend ::result [info level 0]
	}
	lappend result 1
	lappend result 2 [oo::object create foo]
    }
} -cleanup {
    interp delete subinterp
} -result {1 {oo::object create foo} 2 ::foo}
test oo-2.2 {basic test of OO functionality: constructor} {
    oo::class create testClass {
	constructor {} {
	    global result
	    lappend result "[self]->construct"
	}
	method bar {} {
	    global result
	    lappend result "[self]->bar"
	}
    }
    set result {}
    [testClass create foo] bar
    testClass destroy
    return $result
} {::foo->construct ::foo->bar}
test oo-2.4 {OO constructor - Bug 2531577} -setup {
    oo::class create foo
} -body {
    oo::define foo constructor {} return
    [foo new] destroy
    oo::define foo constructor {} {}
    llength [info command [foo new]]
} -cleanup {
    foo destroy
} -result 1
test oo-2.5 {OO constructor - Bug 2531577} -setup {
    oo::class create foo
    set result {}
} -body {
    oo::define foo constructor {} {error x}
    lappend result [catch {foo new}]
    oo::define foo constructor {} {}
    lappend result [llength [info command [foo new]]]
} -cleanup {
    foo destroy
} -result {1 1}
test oo-2.6 {OO constructor and tailcall - Bug 2414858} -setup {
    oo::class create foo
} -body {
    oo::define foo {
	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-2.9 {construction failures and self creation} -setup {
    set ::result {}
    oo::class create Root
} -body {
    oo::class create A {
	superclass Root
	constructor {} {
	    lappend ::result "in A"
	    error "failure in A"
	}
	destructor {lappend ::result [self]}
    }
    oo::class create B {
	superclass Root
	constructor {} {
	    lappend ::result "in B [self]"
	    error "failure in B"
	}
	destructor {lappend ::result [self]}
    }
    lappend ::result [catch {A create a} msg] $msg
    lappend ::result [catch {B create b} msg] $msg
} -cleanup {
    Root destroy
} -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}}

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
    }
} -body {
    subinterp eval {
	oo::define oo::object destructor {
	    lappend ::result died
	}
	lappend result 1 [oo::object create foo]
	lappend result 2 [rename foo {}]
	oo::define oo::object destructor {}
	return $result
    }
} -cleanup {
    interp delete subinterp
} -result {1 ::foo died 2 {}}
test oo-3.2 {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
    }
} -body {
    subinterp eval {
	oo::define oo::object destructor {
	    lappend ::result died
	}
	lappend result 1 [oo::object create foo]
	lappend result 2 [rename foo {}]
    }
} -cleanup {
    interp delete subinterp
} -result {1 ::foo died 2 {}}
test oo-3.3 {basic test of OO functionality: destructor} -setup {
    oo::class create foo
    set result {}
} -cleanup {
    foo destroy
} -body {
    oo::define foo {
	constructor {} {lappend ::result made}
	destructor {lappend ::result died}
    }
    namespace delete [info object namespace [foo new]]
    return $result
} -result {made died}
test oo-3.4 {basic test of OO functionality: my exists in destructor} -setup {
    oo::class create cls
    set result {}
} -cleanup {
    cls destroy
} -body {
    oo::define cls {
	variable state
	constructor {} {
	    proc localcmdexists {} {}
	    set state ok
	}
	forward Report lappend ::result
	destructor {
	    objmy Report [catch {set state} msg] $msg
	    objmy Report [namespace which -var state]
	    objmy Report [info commands localcmdexists]
	}
    }
    cls create obj
    rename [info object namespace obj]::my ::objmy
    obj destroy
    lappend result [info commands ::objmy]
} -match glob -result {0 ok *::state localcmdexists {}}
test oo-3.4a {basic test of OO functionality: my exists in destructor} -setup {
    oo::class create cls
    set result {}
} -cleanup {
    cls destroy
} -body {
    oo::define cls {
	variable state
	constructor {} {
	    proc localcmdexists {} {}
	    set state ok
	}
	forward Report lappend ::result
	destructor {
	    objmy Report [catch {set state} msg] $msg
	    objmy Report [namespace which -var state]
	    objmy Report [info commands localcmdexists]
	}
    }
    cls create obj
    rename [info object namespace obj]::my ::objmy
    rename obj {}
    lappend result [info commands ::objmy]
} -match glob -result {0 ok *::state localcmdexists {}}
test oo-3.5 {basic test of OO functionality: destructor: evil case for Itcl} -setup {
    oo::class create cls
    set result {}
} -cleanup {
    cls destroy
} -body {
    oo::define cls {
	variable state
	constructor {} {
	    proc localcmdexists {} {}
	    set state ok
	}
	forward Report lappend ::result
	destructor {
	    objmy Report [catch {set state} msg] $msg
	    objmy Report [namespace which -var state]
	    objmy Report [info commands localcmdexists]
	}
    }
    cls create obj
    rename [info object namespace obj]::my ::objmy
    namespace delete [info object namespace obj]
    lappend result [info commands ::objmy]
} -match glob -result {0 ok *::state localcmdexists {}}
test oo-3.5a {basic test of OO functionality: destructor: evil case for Itcl} -setup {
    oo::class create cls
    set result {}
} -cleanup {
    cls destroy
} -body {
    oo::define cls {
	variable state result
	constructor {} {
	    proc localcmdexists {} {}
	    set state ok
	    my eval {upvar 0 ::result result}
	}
	method nuke {} {
	    namespace delete [namespace current]
	    return $result
	}
	destructor {
	    lappend result [self] $state [info commands localcmdexists]
	}
    }
    cls create obj
    namespace delete [info object namespace obj]
    [cls create obj2] nuke
} -match glob -result {::obj ok localcmdexists ::obj2 ok localcmdexists}
test oo-3.6 {basic test of OO functionality: errors in destructor} -setup {
    oo::class create cls
} -cleanup {
    cls destroy
} -body {
    oo::define cls destructor {error foo}
    list [catch {[cls create obj] destroy} msg] $msg [info commands obj]
} -result {1 foo {}}
test oo-3.7 {basic test of OO functionality: errors in destructor} -setup {
    oo::class create cls
    set result {}
    proc bgerror msg {lappend ::result $msg}
} -cleanup {
    cls destroy
    rename bgerror {}
} -body {
    oo::define cls destructor {error foo}
    list [rename [cls create obj] {}] \
	[update idletasks] $result [info commands obj]
} -result {{} {} foo {}}
test oo-3.8 {basic test of OO functionality: errors in destructor} -setup {
    oo::class create cls
    set result {}
    proc bgerror msg {lappend ::result $msg}
} -cleanup {
    cls destroy
    rename bgerror {}
} -body {
    oo::define cls destructor {error foo}
    list [namespace delete [info object namespace [cls create obj]]] \
	[update idletasks] $result [info commands obj]
} -result {{} {} foo {}}
test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup {
    oo::class create cls
    set result {}
} -body {
    oo::define cls {
	destructor {
	    lappend ::result in destructor
	    [self] destroy
	}
    }
    # This used to crash
    [cls new] destroy
    return $result
} -cleanup {
    cls destroy
} -result {in destructor}
test oo-3.10 {Bug 3d96b7076e: killing the object's class in a method call} -setup {
    oo::class create Super
} -body {
    # Only reliably failed in a memdebug build
    oo::class create Cls {
	superclass Super
	method mthd {} {
	    [self class] destroy
	    return ok
	}
    }
    [Cls new] mthd
} -cleanup {
    Super destroy
} -result ok
test oo-3.11 {Bug 3d96b7076e: killing the object's class in a method call} -setup {
    oo::class create Super
    oo::class create Sub {
	superclass Super
    }
} -body {
    # Only reliably failed in a memdebug build
    oo::class create Cls {
	superclass Super
	method mthd {} {
	    oo::objdefine [self] class Sub
	    Cls destroy
	    return ok
	}
    }
    [Cls new] mthd
} -cleanup {
    Super destroy
} -result ok
test oo-3.12 {Bug 3d96b7076e: killing the object's class in a method call} -setup {
    oo::class create Super
} -body {
    # Only reliably failed in a memdebug build
    oo::class create Cls {
	superclass Super
	method mthd {} {
	    [self class] destroy
	    return ok
	}
    }
    set o [Super new]
    oo::objdefine $o mixin Cls
    $o mthd
} -cleanup {
    Super destroy
} -result ok

test oo-4.1 {basic test of OO functionality: export} {
    set o [oo::object new]
    set result {}
    oo::objdefine $o method Foo {} {lappend ::result Foo; return}
    lappend result [catch {$o Foo} msg] $msg
    oo::objdefine $o export Foo
    lappend result [$o Foo] [$o destroy]
} {1 {unknown method "Foo": must be destroy} Foo {} {}}
test oo-4.2 {basic test of OO functionality: unexport} {
    set o [oo::object new]
    set result {}
    oo::objdefine $o method foo {} {lappend ::result foo; return}
    lappend result [$o foo]
    oo::objdefine $o unexport foo
    lappend result [catch {$o foo} msg] $msg [$o destroy]
} {foo {} 1 {unknown method "foo": must be destroy} {}}
test oo-4.3 {exporting and error messages, Bug 1824958} -setup {
    oo::class create testClass
} -cleanup {
    testClass destroy
} -body {
    oo::define testClass self export Bad
    testClass Bad
} -returnCodes 1 -result {unknown method "Bad": must be create, destroy or new}
test oo-4.4 {exporting a class method from an object} -setup {
    oo::class create testClass
    testClass create testObject
} -cleanup {
    testClass destroy
} -body {
    oo::define testClass method Good {} { return ok }
    oo::objdefine testObject export Good
    testObject Good
} -result ok
test oo-4.5 {export creates proper method entries} -setup {
    oo::class create testClass
} -body {
    oo::define testClass {
	export foo
	method foo {} {return ok}
    }
    [testClass new] foo
} -cleanup {
    testClass destroy
} -result ok
test oo-4.6 {export creates proper method entries} -setup {
    oo::class create testClass
} -body {
    oo::define testClass {
	unexport foo
	method foo {} {return ok}
    }
    [testClass new] foo
} -cleanup {
    testClass destroy
} -result ok
test oo-4.7 {basic test of OO functionality: method -export flag} -setup {
    set o [oo::object new]
    unset -nocomplain result
} -body {
    oo::objdefine $o {
	method Foo {} {
	    lappend ::result Foo
	    return foo
	}
	method Bar -export {} {
	    lappend ::result Bar
	    return bar
	}
    }
    lappend result [catch {$o Foo} msg] $msg
    lappend result [$o Bar]
} -cleanup {
    $o destroy
} -result {1 {unknown method "Foo": must be Bar or destroy} Bar bar}
test oo-4.8 {basic test of OO functionality: method -unexport flag} -setup {
    set o [oo::object new]
    unset -nocomplain result
} -body {
    oo::objdefine $o {
	method foo {} {
	    lappend ::result foo
	    return Foo
	}
	method bar -unexport {} {
	    lappend ::result bar
	    return Bar
	}
    }
    lappend result [$o foo]
    lappend result [catch {$o bar} msg] $msg
} -cleanup {
    $o destroy
} -result {foo Foo 1 {unknown method "bar": must be destroy or foo}}
test oo-4.9 {basic test of OO functionality: method -private flag} -setup {
    set o [oo::object new]
    unset -nocomplain result
} -body {
    oo::objdefine $o {
	method foo {} {
	    lappend ::result foo
	    return Foo
	}
	method bar -private {} {
	    lappend ::result bar
	    return Bar
	}
	export eval
	method gorp {} {
	    my bar
	}
    }
    lappend result [$o foo]
    lappend result [catch {$o bar} msg] $msg
    lappend result [catch {$o eval my bar} msg] $msg
    lappend result [$o gorp]
} -cleanup {
    $o destroy
} -result {foo Foo 1 {unknown method "bar": must be destroy, eval, foo or gorp} 1 {unknown method "bar": must be <cloned>, destroy, eval, foo, gorp, unknown, variable or varname} bar Bar}
test oo-4.10 {basic test of OO functionality: method flag parsing} -setup {
    set o [oo::object new]
} -body {
    oo::objdefine $o method foo -gorp xyz {return Foo}
} -returnCodes error -cleanup {
    $o destroy
} -result {bad export flag "-gorp": must be -export, -private, or -unexport}

test oo-5.1 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::objdefine oo::object method foo {} { return "in object" }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": must be destroy} {in object}}
test oo-5.2 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::define oo::object self method foo {} { return "in object" }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": must be destroy} {in object}}
test oo-5.3 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::objdefine oo::object {
	method foo {} { return "in object" }
    }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": must be destroy} {in object}}
test oo-5.4 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::define oo::object {
	self method foo {} { return "in object" }
    }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": must be destroy} {in object}}
test oo-5.5 {OO: manipulation of classes as objects} -setup {
    set obj [oo::object new]
} -body {
    oo::define oo::object {
	self {
	    method foo {} { return "in object" }
	}
    }
    catch {$obj foo} result
    list [catch {$obj foo} result] $result [oo::object foo]
} -cleanup {
    oo::objdefine oo::object deletemethod foo
    $obj destroy
} -result {1 {unknown method "foo": must be destroy} {in object}}

test oo-6.1 {OO: forward} {
    oo::object create foo
    oo::objdefine foo {
	forward a lappend
	forward b lappend result
    }
    set result {}
    foo a result 1
    foo b 2
    foo destroy
    return $result
} {1 2}
test oo-6.2 {OO: forward resolution scope} -setup {
    oo::class create fooClass
} -body {
    proc foo {} {return bad}
    oo::define fooClass {
	constructor {} {
	    proc foo {} {return good}
	}
	forward bar foo
    }
    [fooClass new] bar
} -cleanup {
    fooClass destroy
    rename foo {}
} -result good
test oo-6.3 {OO: forward resolution scope} -setup {
    oo::class create fooClass
} -body {
    proc foo {} {return bad}
    oo::define fooClass {
	constructor {} {
	    proc foo {} {return good}
	}
    }
    oo::define fooClass forward bar foo
    [fooClass new] bar
} -cleanup {
    fooClass destroy
    rename foo {}
} -result good
test oo-6.4 {OO: forward resolution scope} -setup {
    oo::class create fooClass
} -body {
    proc foo {} {return good}
    oo::define fooClass {
	constructor {} {
	    proc foo {} {return bad}
	}
	forward bar ::foo
    }
    [fooClass new] bar
} -cleanup {
    fooClass destroy
    rename foo {}
} -result good
test oo-6.5 {OO: forward resolution scope} -setup {
    oo::class create fooClass
    namespace eval foo {}
} -body {
    proc foo::foo {} {return good}
    oo::define fooClass {
	constructor {} {
	    proc foo {} {return bad}
	}
	forward bar foo::foo
    }
    [fooClass new] bar
} -cleanup {
    fooClass destroy
    namespace delete foo
} -result good
test oo-6.6 {OO: forward resolution scope} -setup {
    oo::class create fooClass
    namespace eval foo {}
} -body {
    proc foo::foo {} {return bad}
    oo::define fooClass {
	constructor {} {
	    namespace eval foo {
		proc foo {} {return good}
	    }
	}
	forward bar foo::foo
    }
    [fooClass new] bar
} -cleanup {
    fooClass destroy
    namespace delete foo
} -result good
test oo-6.7 {OO: forward resolution scope is per-object} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	constructor {} {
	    proc curns {} {namespace current}
	}
	forward ns curns
    }
    expr {[[fooClass new] ns] ne [[fooClass new] ns]}
} -cleanup {
    fooClass destroy
} -result 1
test oo-6.8 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test my handler
	method handler {a b c} {}
    }
    fooClass create ::foo
    foo test
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.9 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    fooClass create ::foo
    foo test 1 2 3
} -cleanup {
    fooClass destroy
} -result 1,2,3
test oo-6.10 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    fooClass create ::foo
    foo test 1 2
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.11 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo {
	forward test my handler
	method handler {a b c} {}
    }
    foo test
} -returnCodes error -cleanup {
    foo destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.12 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    foo test 1 2 3
} -cleanup {
    foo destroy
} -result 1,2,3
test oo-6.13 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    foo test 1 2
} -returnCodes error -cleanup {
    foo destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.14 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test my handler1 p
	forward handler1 my handler q
	method handler {a b c} {}
    }
    fooClass create ::foo
    foo test
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test c"}
test oo-6.15 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test my handler1 p
	forward handler1 my handler q
	method handler {a b c} {list $a,$b,$c}
    }
    fooClass create ::foo
    foo test 1
} -cleanup {
    fooClass destroy
} -result q,p,1
test oo-6.16 {Bug 3400658: forwarding and wrongargs rewriting - via alias} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test handler1 foo bar
	forward handler2 my handler x
	method handler {a b c d} {list $a,$b,$c,$d}
	export eval
    }
    fooClass create ::foo
    foo eval {
	interp alias {} [namespace current]::handler1 \
	    {} [namespace current]::my handler2
    }
    foo test 1 2 3
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test d"}
test oo-6.17 {Bug 3400658: forwarding and wrongargs rewriting - via ensemble} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test handler1 foo bar boo
	forward handler2 my handler
	method handler {a b c d} {list $a,$b,$c,$d}
	export eval
    }
    fooClass create ::foo
    foo eval {
	namespace ensemble create \
	    -command [namespace current]::handler1 -parameters {p q} \
	    -map [list boo [list [namespace current]::my handler2]]
    }
    foo test 1 2 3
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test c d"}
test oo-6.18 {Bug 3408830: more forwarding cases} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward len  string length
    }
    [fooClass create foo] len a b
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "::foo len string"}
test oo-6.19 {Bug 3610404: forwarding resolution + traces} -setup {
    oo::object create foo
    unset -nocomplain ::result
    set ::result {}
} -body {
    proc ::my {method} {lappend ::result global}
    oo::objdefine foo {
	method target {} {lappend ::result instance}
	forward bar my target
	method bump {} {
	    set ns [info object namespace ::foo]
	    rename ${ns}::my ${ns}::
	    rename ${ns}:: ${ns}::my
	}
    }
    proc harness {} {
	foo target
	foo bar
	foo target
    }
    trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
    foo target
    foo bar
    foo bump
    foo bar
    harness
} -cleanup {
    catch {rename harness {}}
    catch {rename ::my {}}
    foo destroy
} -result {instance instance instance instance instance instance}
test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup {
    oo::class create fooClass
    fooClass create foo
    unset -nocomplain ::result
    set ::result {}
} -body {
    proc ::my {method} {lappend ::result global}
    oo::define fooClass {
	method target {} {lappend ::result class}
	forward bar my target
	method bump {} {
	    set ns [info object namespace [self]]
	    rename ${ns}::my ${ns}::
	    rename ${ns}:: ${ns}::my
	}
    }
    proc harness {} {
	foo target
	foo bar
	foo target
    }
    trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
    foo target
    foo bar
    foo bump
    foo bar
    harness
} -cleanup {
    catch {rename harness {}}
    catch {rename ::my {}}
    fooClass destroy
} -result {class class class class class class}

test oo-7.1 {OO: inheritance 101} -setup {
    oo::class create superClass
    oo::class create subClass
    subClass create instance
} -body {
    oo::define superClass method doit x {lappend ::result $x}
    oo::define subClass superclass superClass
    set result [list [catch {subClass doit bad} msg] $msg]
    instance doit ok
    return $result
} -cleanup {
    subClass destroy
    superClass destroy
} -result {1 {unknown method "doit": must be create, destroy or new} ok}
test oo-7.2 {OO: inheritance 101} -setup {
    oo::class create superClass
    oo::class create subClass
    subClass create instance
} -body {
    oo::define superClass method doit x {
	lappend ::result |$x|
    }
    oo::define subClass superclass superClass
    oo::objdefine instance method doit x {
	lappend ::result =$x=
	next [incr x]
    }
    set result {}
    instance doit 1
    return $result
} -cleanup {
    subClass destroy
    superClass destroy
} -result {=1= |2|}
test oo-7.3 {OO: inheritance 101} -setup {
    oo::class create superClass
    oo::class create subClass
    subClass create instance
} -body {
    oo::define superClass method doit x {
	lappend ::result |$x|
    }
    oo::define subClass {
	superclass superClass
	method doit x {lappend ::result -$x-; next [incr x]}
    }
    oo::objdefine instance method doit x {
	lappend ::result =$x=;
	next [incr x]
    }
    set result {}
    instance doit 1
    return $result
} -cleanup {
    subClass destroy
    superClass destroy
} -result {=1= -2- |3|}
test oo-7.4 {OO: inheritance from oo::class} -body {
    oo::class create meta {
	superclass oo::class
	self {
	    unexport create new
	    method make {x {definitions {}}} {
		if {![string match ::* $x]} {
		    set ns [uplevel 1 {::namespace current}]
		    set x ${ns}::$x
		}
		set o [my create $x]
		lappend ::result "made $o"
		oo::define $o $definitions
		return $o
	    }
	}
    }
    set result [list [catch {meta create foo} msg] $msg]
    lappend result [meta make classinstance {
	lappend ::result "in definition script in [namespace current]"
    }]
    lappend result [classinstance create instance]
} -cleanup {
    catch {classinstance destroy}
    catch {meta destroy}
} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
test oo-7.5 {OO: inheritance from oo::class in the secondary chain} -body {
    oo::class create other
    oo::class create meta {
	superclass other oo::class
	self {
	    unexport create new
	    method make {x {definitions {}}} {
		if {![string match ::* $x]} {
		    set ns [uplevel 1 {::namespace current}]
		    set x ${ns}::$x
		}
		set o [my create $x]
		lappend ::result "made $o"
		oo::define $o $definitions
		return $o
	    }
	}
    }
    set result [list [catch {meta create foo} msg] $msg]
    lappend result [meta make classinstance {
	lappend ::result "in definition script in [namespace current]"
    }]
    lappend result [classinstance create instance]
} -cleanup {
    catch {classinstance destroy}
    catch {meta destroy}
    catch {other destroy}
} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
test oo-7.6 {OO: inheritance 101 - overridden methods should be oblivious} -setup {
    oo::class create Aclass
    oo::class create Bclass
    Bclass create Binstance
} -body {
    oo::define Aclass {
	method incr {var step} {
	    upvar 1 $var v
	    ::incr v $step
	}
    }
    oo::define Bclass {
	superclass Aclass
	method incr {var {step 1}} {
	    global result
	    lappend result $var $step
	    set r [next $var $step]
	    lappend result returning:$r
	    return $r
	}
    }
    set result {}
    set x 10
    lappend result x=$x
    lappend result [Binstance incr x]
    lappend result x=$x
} -result {x=10 x 1 returning:11 11 x=11} -cleanup {
    unset -nocomplain x
    Aclass destroy
}
test oo-7.7 {OO: inheritance and errorInfo} -setup {
    oo::class create A
    oo::class create B
    B create c
} -body {
    oo::define A method foo {} {error foo!}
    oo::define B {
	superclass A
	method foo {} { next }
    }
    oo::objdefine c method foo {} { next }
    catch {c ?} msg
    set result [list $msg]
    catch {c foo} msg
    lappend result $msg $errorInfo
} -cleanup {
    A destroy
} -result {{unknown method "?": must be destroy or foo} foo! {foo!
    while executing
"error foo!"
    (class "::A" method "foo" line 1)
    invoked from within
"next "
    (class "::B" method "foo" line 1)
    invoked from within
"next "
    (object "::c" method "foo" line 1)
    invoked from within
"c foo"}}
test oo-7.8 {OO: next at the end of the method chain} -setup {
    set ::result ""
} -cleanup {
    foo destroy
} -body {
    oo::class create foo {
	method bar {} {lappend ::result foo; lappend ::result [next] foo}
    }
    oo::class create foo2 {
	superclass foo
	method bar {} {lappend ::result foo2; lappend ::result [next] foo2}
    }
    lappend result [catch {[foo2 new] bar} msg] $msg
} -result {foo2 foo 1 {no next method implementation}}
test oo-7.9 {OO: defining inheritance in namespaces} -setup {
    set ::result {}
    oo::class create ::parent
    namespace eval ::foo {
	oo::class create mixin {superclass ::parent}
    }
} -cleanup {
    ::parent destroy
    namespace delete ::foo
} -body {
    namespace eval ::foo {
	oo::class create bar {superclass parent}
	oo::class create boo
	oo::define boo {superclass bar}
	oo::define boo {mixin mixin}
	oo::class create spong {superclass boo}
	return
    }
} -result {}
test oo-7.10 {OO: next after object deletion, bug [135804138e]} -setup {
    set ::result ""
    oo::class create c1 {
        method m1 {} {
           lappend ::result c1::m1
        }
    }
    oo::class create c2 {
        superclass c1
        destructor {
            lappend ::result c2::destructor
            my m1
            lappend ::result /c2::destructor
        }
        method m1 {} {
            lappend ::result c2::m1
            rename [self] {}
            lappend ::result no-self
            next
            lappend ::result /c2::m1
        }
    }
} -body {
    c2 create o
    lappend ::result [catch {o m1} msg] $msg
} -cleanup {
    c1 destroy
    unset ::result
} -result {c2::m1 c2::destructor c2::m1 no-self c1::m1 /c2::m1 /c2::destructor no-self 1 {no next method implementation}}

test oo-8.1 {OO: global must work in methods} {
    oo::object create foo
    oo::objdefine foo method bar x {global result; lappend result $x}
    set result {}
    foo bar this
    foo bar is
    lappend result a
    foo bar test
    foo destroy
    return $result
} {this is a test}

test oo-9.1 {OO: multiple inheritance} -setup {
    oo::class create A
    oo::class create B
    oo::class create C
    oo::class create D
    D create foo
} -body {
    oo::define A method test {} {lappend ::result A; return ok}
    oo::define B {
	superclass A
	method test {} {lappend ::result B; next}
    }
    oo::define C {
	superclass A
	method test {} {lappend ::result C; next}
    }
    oo::define D {
	superclass B C
	method test {} {lappend ::result D; next}
    }
    set result {}
    lappend result [foo test]
} -cleanup {
    D destroy
    C destroy
    B destroy
    A destroy
} -result {D B C A ok}
test oo-9.2 {OO: multiple inheritance} -setup {
    oo::class create A
    oo::class create B
    oo::class create C
    oo::class create D
    D create foo
} -body {
    oo::define A method test {} {lappend ::result A; return ok}
    oo::define B {
	superclass A
	method test {} {lappend ::result B; next}
    }
    oo::define C {
	superclass A
	method test {} {lappend ::result C; next}
    }
    oo::define D {
	superclass B C
	method test {} {lappend ::result D; next}
    }
    set result {}
    lappend result [foo test]
} -cleanup {
    A destroy
} -result {D B C A ok}

test oo-10.1 {OO: recursive invoke and modify} -setup {
    [oo::class create C] create O
} -cleanup {
    C destroy
} -body {
    oo::define C method foo x {
	lappend ::result $x
	if {$x} {
	    [self object] foo [incr x -1]
	}
    }
    oo::objdefine O method foo x {
	lappend ::result -$x-
	if {$x == 1} {
	    oo::objdefine O deletemethod foo
	}
	next $x
    }
    set result {}
    O foo 2
    return $result
} -result {-2- 2 -1- 1 0}
test oo-10.2 {OO: recursive invoke and modify} -setup {
    oo::object create O
} -cleanup {
    O destroy
} -body {
    oo::objdefine O method foo {} {
	oo::objdefine [self] method foo {} {
	    error "not called"
	}
	return [format %s%s call ed]
    }
    O foo
} -result called
test oo-10.3 {OO: invoke and modify} -setup {
    oo::class create A {
	method a {} {return A.a}
	method b {} {return A.b}
	method c {} {return A.c}
    }
    oo::class create B {
	superclass A
	method a {} {return [next],B.a}
	method b {} {return [next],B.b}
	method c {} {return [next],B.c}
    }
    B create C
    set result {}
} -cleanup {
    A destroy
} -body {
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b
    lappend result [C a] [C b] [C c] -
    oo::define B renamemethod a b
    lappend result [C a] [C b] [C c] -
    oo::define B deletemethod b c
    lappend result [C a] [C b] [C c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
test oo-10.4 {OO: invoke and modify} -setup {
    oo::class create A {
	method a {} {return A.a}
	method b {} {return A.b}
	method c {} {return A.c}
    }
    A create B
    oo::objdefine B {
	method a {} {return [next],B.a}
	method b {} {return [next],B.b}
	method c {} {return [next],B.c}
    }
    set result {}
} -cleanup {
    A destroy
} -body {
    lappend result [B a] [B b] [B c] -
    oo::objdefine B deletemethod b
    lappend result [B a] [B b] [B c] -
    oo::objdefine B renamemethod a b
    lappend result [B a] [B b] [B c] -
    oo::objdefine B deletemethod b c
    lappend result [B a] [B b] [B c]
} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}

test oo-11.1 {OO: cleanup} {
    oo::object create foo
    set result [list [catch {oo::object create foo} msg] $msg]
    lappend result [foo destroy] [oo::object create foo] [foo destroy]
} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
test oo-11.2 {OO: cleanup} {
    oo::class create bar
    bar create foo
    set result [list [catch {bar create foo} msg] $msg]
    lappend result [bar destroy] [oo::object create foo] [foo destroy]
} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
test oo-11.3 {OO: cleanup} {
    oo::class create bar0
    oo::class create bar
    oo::define bar superclass bar0
    bar create foo
    set result [list [catch {bar create foo} msg] $msg]
    lappend result [bar0 destroy] [oo::object create foo] [foo destroy]
} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
test oo-11.4 {OO: cleanup} {
    oo::class create bar0
    oo::class create bar1
    oo::define bar1 superclass bar0
    oo::class create bar2
    oo::define bar2 {
	superclass bar0
	destructor {lappend ::result destroyed}
    }
    oo::class create bar
    oo::define bar superclass bar1 bar2
    bar create foo
    set result [list [catch {bar create foo} msg] $msg]
    lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
	[oo::object create bar2] [bar2 destroy]
} {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
test oo-11.5 {OO: cleanup} {
    oo::class create obj1

    trace add command obj1 delete {apply {{name1 name2 action} {
	set namespace [info object namespace $name1]
	namespace delete $namespace
    }}}

    rename obj1 {}
    # No segmentation fault
    return done
} done

test oo-11.6.1 {
    OO: cleanup of when an class is mixed into itself
} -constraints memory -body {
    leaktest {
	interp create interp1
	oo::class create obj1
	::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}
	rename obj1 {}
	interp delete interp1
    }
} -result 0 -cleanup {
}

test oo-11.6.2 {
    OO: cleanup ReleaseClassContents() where class is mixed into one of its
    instances
} -constraints memory -body {
    leaktest {
	interp create interp1
	interp1 eval {
	    oo::class create obj1
	    ::oo::copy obj1 obj2
	    rename obj2 {}
	    rename obj1 {}
	}
	interp delete interp1
    }
} -result 0 -cleanup {
}

test oo-11.6.3 {
    OO: cleanup ReleaseClassContents() where class is mixed into one of its
    instances
} -constraints memory -body {
    leaktest {
	interp create interp1
	interp1 eval {
	    oo::class create obj1
	    ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}

	    ::oo::copy obj1 obj2
	    rename obj2 {}
	    rename obj1 {}
	}
	interp delete interp1
    }
} -result 0 -cleanup {
}

test oo-11.6.4 {
    OO: cleanup ReleaseClassContents() where class is mixed into one of its
    instances
} -body {
    oo::class create obj1
    ::oo::define obj1 {self mixin [self]}

    ::oo::copy obj1 obj2
    ::oo::objdefine obj2 {mixin [self]}

    ::oo::copy obj2 obj3
    rename obj3 {}
    rename obj2 {}

    # No segmentation fault
    return done
} -result done -cleanup {
    rename obj1 {}
}

test oo-12.1 {OO: filters} {
    oo::class create Aclass
    Aclass create Aobject
    oo::define Aclass {
	method concatenate args {
	    global result
	    lappend result {*}$args
	    join $args {}
	}
	method logFilter args {
	    global result
	    lappend result "calling [self object]->[self method] $args"
	    set r [next {*}$args]
	    lappend result "result=$r"
	    return $r
	}
    }
    oo::objdefine Aobject filter logFilter
    set result {}
    lappend result [Aobject concatenate 1 2 3 4 5]
    Aclass destroy
    return $result
} {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345}
test oo-12.2 {OO: filters} -setup {
    oo::class create Aclass
    Aclass create Aobject
} -body {
    oo::define Aclass {
	method concatenate args {
	    global result
	    lappend result {*}$args
	    join $args {}
	}
	method logFilter args {
	    global result
	    lappend result "calling [self object]->[self method] $args"
	    set r [next {*}$args]
	    lappend result "result=$r"
	    return $r
	}
    }
    oo::objdefine Aobject filter logFilter
    set result {}
    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
} -cleanup {
    Aclass destroy
} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
test oo-12.3 {OO: filters} -setup {
    oo::class create Aclass
    Aclass create Aobject
} -body {
    oo::define Aclass {
	method concatenate args {
	    global result
	    lappend result {*}$args
	    join $args {}
	}
	method logFilter args {
	    global result
	    lappend result "calling [self object]->[self method] $args"
	    set r [next {*}$args]
	    lappend result "result=$r"
	    return $r
	}
	filter logFilter
    }
    set result {}
    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
} -cleanup {
    Aclass destroy
} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
test oo-12.4 {OO: filters} -setup {
    oo::class create Aclass
    Aclass create Aobject
} -body {
    oo::define Aclass {
	method foo {} { return foo }
	method Bar {} { return 1 }
	method boo {} { if {[my Bar]} { next } { error forbidden } }
	filter boo
    }
    Aobject foo
} -cleanup {
    Aclass destroy
} -result foo
test oo-12.5 {OO: filters} -setup {
    oo::class create Aclass
    Aclass create Aobject
} -body {
    oo::define Aclass {
	method foo {} { return foo }
	method Bar {} { return [my Bar2] }
	method Bar2 {} { return 1 }
	method boo {} { if {[my Bar]} { next } { error forbidden } }
	filter boo
    }
    Aobject foo
} -cleanup {
    Aclass destroy
} -result foo
test oo-12.6 {OO: filters} -setup {
    oo::class create Aclass
    Aclass create Aobject
} -body {
    oo::define Aclass {
	method foo {} { return foo }
	method Bar {} { return [my Bar2] }
	method Bar2 {} { return [my Bar3] }
	method Bar3 {} { return 1 }
	method boo {} { if {[my Bar]} { next } { error forbidden } }
	filter boo
    }
    Aobject foo
} -cleanup {
    Aclass destroy
} -result foo
test oo-12.7 {OO: filters} -setup {
    oo::class create Aclass
    Aclass create Aobject
} -body {
    oo::define Aclass {
	method outerfoo {} { return [my InnerFoo] }
	method InnerFoo {} { return foo }
	method Bar {} { return [my Bar2] }
	method Bar2 {} { return [my Bar3] }
	method Bar3 {} { return 1 }
	method boo {} {
	    lappend ::log [self target]
	    if {[my Bar]} { next } else { error forbidden }
	}
	filter boo
    }
    set log {}
    list [Aobject outerfoo] $log
} -cleanup {
    Aclass destroy
} -result {foo {{::Aclass outerfoo} {::Aclass InnerFoo}}}
test oo-12.8 {OO: filters and destructors} -setup {
    oo::class create Aclass
    Aclass create Aobject
    set ::log {}
} -body {
    oo::define Aclass {
	constructor {} {
	    lappend ::log "in constructor"
	}
	destructor {
	    lappend ::log "in destructor"
	}
	method bar {} {
	    lappend ::log "in method"
	}
	method Boo args {
	    lappend ::log [self target]
	    next {*}$args
	}
	filter Boo
    }
    set obj [Aclass new]
    $obj bar
    $obj destroy
    return $::log
} -cleanup {
    Aclass destroy
} -result {{in constructor} {::Aclass bar} {in method} {::oo::object destroy} {in destructor}}

test oo-13.1 {OO: changing an object's class} {
    oo::class create Aclass
    oo::define Aclass {method bar {} {lappend ::result "in A [self object]"}}
    oo::class create Bclass
    oo::define Bclass {method bar {} {lappend ::result "in B [self object]"}}
    set result [Aclass create foo]
    foo bar
    oo::objdefine foo class Bclass
    foo bar
    Aclass destroy
    lappend result [info command foo]
    Bclass destroy
    return $result
} {::foo {in A ::foo} {in B ::foo} foo}
test oo-13.2 {OO: changing an object's class} -body {
    oo::object create foo
    oo::objdefine foo class oo::class
} -cleanup {
    foo destroy
} -result {}
test oo-13.3 {OO: changing an object's class} -body {
    oo::class create foo
    oo::objdefine foo class oo::object
} -cleanup {
    foo destroy
} -result {}
test oo-13.4 {OO: changing an object's class} -body {
    oo::class create foo {
	method m {} {
	    set result [list [self class] [info object class [self]]]
	    oo::objdefine [self] class ::bar
	    lappend result [self class] [info object class [self]]
	}
    }
    oo::class create bar
    [foo new] m
} -cleanup {
    foo destroy
    bar destroy
} -result {::foo ::foo ::foo ::bar}
test oo-13.5 {OO: changing an object's class: non-class to class} -setup {
    oo::object create fooObj
} -body {
    oo::objdefine fooObj {
	class oo::class
    }
    oo::define fooObj {
	method x {} {expr 1+2+3}
    }
    [fooObj new] x
} -cleanup {
    fooObj destroy
} -result 6
test oo-13.6 {OO: changing an object's class: class to non-class} -setup {
    oo::class create foo
    unset -nocomplain ::result
} -body {
    set result dangling
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::class create boo {
	superclass foo
	destructor {set ::result "ok"}
    }
    boo new
    foo create bar
    oo::objdefine foo {
	class oo::object
    }
    list $result [catch {bar x} msg] $msg
} -cleanup {
    catch {bar destroy}
    foo destroy
} -result {ok 1 {invalid command name "bar"}}
test oo-13.7 {OO: changing an object's class} -setup {
    oo::class create foo
    oo::class create bar
    unset -nocomplain result
} -body {
    oo::define bar method x {} {return ok}
    oo::define foo {
	method x {} {expr 1+2+3}
	self mixin foo
    }
    lappend result [foo x]
    oo::objdefine foo class bar
    lappend result [foo x]
} -cleanup {
    foo destroy
    bar destroy
} -result {6 ok}
test oo-13.8 {OO: changing an object's class to itself} -setup {
    oo::class create foo
} -body {
    oo::define foo {
	method x {} {expr 1+2+3}
    }
    oo::objdefine foo class foo
} -cleanup {
    foo destroy
} -returnCodes error -result {may not change classes into an instance of themselves}
test oo-13.9 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]
} -body {
    $i eval {
	oo::objdefine oo::object {
	    class oo::class
	}
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {may not modify the class of the root object class}
test oo-13.10 {OO: changing an object's class: roots are special} -setup {
    set i [interp create]
} -body {
    $i eval {
	oo::objdefine oo::class {
	    class oo::object
	}
    }
} -cleanup {
    interp delete $i
} -returnCodes error -result {may not modify the class of the class of classes}
test oo-13.11 {OO: changing an object's class in a tricky place} -setup {
    oo::class create cls
    unset -nocomplain result
} -body {
    set result gorp
    list [catch {
	oo::define cls {
	    method x {} {return}
	    self class oo::object
	    ::set ::result ok
	    method y {} {return}; # I'm sorry, Dave. I'm afraid I can't do that.
	}
    } msg] $msg $result
} -cleanup {
    cls destroy
} -result {1 {attempt to misuse API} ok}
# todo: changing a class subtype (metaclass) to another class subtype

test oo-14.1 {OO: mixins} {
    oo::class create Aclass
    oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
    oo::class create Bclass
    oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}
    oo::objdefine [Aclass create fooTest] mixin Bclass
    oo::objdefine [Aclass create fooTest2] mixin Bclass
    set result [list [catch {fooTest ?} msg] $msg]
    fooTest bar
    fooTest boo
    fooTest2 bar
    fooTest2 boo
    oo::objdefine fooTest2 mixin
    lappend result [Bclass destroy] [info command fooTest*] [Aclass destroy]
} {1 {unknown method "?": must be bar, boo or destroy} {::fooTest in bar} {::fooTest in boo} {::fooTest2 in bar} {::fooTest2 in boo} {} fooTest2 {}}
test oo-14.2 {OO: mixins} {
    oo::class create Aclass {
	method bar {} {return "[self object] in bar"}
    }
    oo::class create Bclass {
	method boo {} {return "[self object] in boo"}
    }
    oo::define Aclass mixin Bclass
    Aclass create fooTest
    set result [list [catch {fooTest ?} msg] $msg]
    lappend result [catch {fooTest bar} msg] $msg
    lappend result [catch {fooTest boo} msg] $msg
    lappend result [Bclass destroy] [info commands Aclass]
} {1 {unknown method "?": must be bar, boo or destroy} 0 {::fooTest in bar} 0 {::fooTest in boo} {} {}}
test oo-14.3 {OO and mixins and filters - advanced case} -setup {
    oo::class create mix
    oo::class create c {
	mixin mix
    }
    c create i
} -body {
    oo::define mix {
	method foo {} {return >>[next]<<}
	filter foo
    }
    oo::objdefine i method bar {} {return foobar}
    i bar
} -cleanup {
    mix destroy
    if {[info object isa object i]} {
	error "mixin deletion failed to destroy dependent instance"
    }
} -result >>foobar<<
test oo-14.4 {OO: mixin error case} -setup {
    oo::class create c
} -body {
    oo::define c mixin c
} -returnCodes error -cleanup {
    c destroy
} -result {may not mix a class into itself}
test oo-14.5 {OO and mixins and filters - advanced case} -setup {
    oo::class create mix
    oo::class create c {
	mixin mix
    }
    c create i
} -body {
    oo::define mix {
	method foo {} {return >>[next]<<}
	filter foo
    }
    oo::objdefine i method bar {} {return foobar}
    i bar
} -cleanup {
    c destroy
    mix destroy
} -result >>foobar<<
test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create A {
	superclass parent
	method egg {} {
	    return chicken
	}
    }
    oo::class create B {
	superclass parent
	mixin A
	method bar {} {
	    # mixin from A
	    my egg
	}
    }
    oo::class create C {
	superclass parent
	mixin B
	method foo {} {
	    # mixin from B
	    my bar
	}
    }
    [C new] foo
} -result chicken
test oo-14.7 {OO and filters from mixins of mixins} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create A {
	superclass parent
	method egg {} {
	    return chicken
	}
	filter f
	method f args {
	    set m [lindex [self target] 1]
	    return "($m) [next {*}$args] ($m)"
	}
    }
    oo::class create B {
	superclass parent
	mixin A
	filter f
	method bar {} {
	    # mixin from A
	    my egg
	}
    }
    oo::class create C {
	superclass parent
	mixin B
	filter f
	method foo {} {
	    # mixin from B
	    my bar
	}
    }
    [C new] foo
} -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)}
test oo-14.8 {OO: class mixin order - Bug 1998221} -setup {
    set ::result {}
    oo::class create parent {
	method test {} {}
    }
} -cleanup {
    parent destroy
} -body {
    oo::class create mix {
	superclass parent
	method test {} {lappend ::result mix; next; return $::result}
    }
    oo::class create cls {
	superclass parent
	mixin mix
	method test {} {lappend ::result cls; next; return $::result}
    }
    [cls new] test
} -result {mix cls}

test oo-15.1 {OO: object cloning} {
    oo::class create Aclass
    oo::define Aclass method test {} {lappend ::result [self object]->test}
    Aclass create Ainstance
    set result {}
    Ainstance test
    oo::copy Ainstance Binstance
    Binstance test
    Ainstance test
    Ainstance destroy
    namespace eval foo {
	oo::copy Binstance Cinstance
	Cinstance test
    }
    Aclass destroy
    namespace delete foo
    lappend result [info commands Binstance]
} {::Ainstance->test ::Binstance->test ::Ainstance->test ::foo::Cinstance->test {}}
test oo-15.2 {OO: object cloning} {
    oo::object create foo
    oo::objdefine foo {
	method m x {lappend ::result [self object] >$x<}
	forward f ::lappend ::result fwd
    }
    set result {}
    foo m 1
    foo f 2
    lappend result [oo::copy foo bar]
    foo m 3
    foo f 4
    bar m 5
    bar f 6
    lappend result [foo destroy]
    bar m 7
    bar f 8
    lappend result [bar destroy]
} {::foo >1< fwd 2 ::bar ::foo >3< fwd 4 ::bar >5< fwd 6 {} ::bar >7< fwd 8 {}}
catch {foo destroy}
catch {bar destroy}
test oo-15.3 {OO: class cloning} {
    oo::class create foo {
	method testme {} {lappend ::result [self class]->[self object]}
    }
    set result {}
    foo create baseline
    baseline testme
    oo::copy foo bar
    baseline testme
    bar create tester
    tester testme
    foo destroy
    tester testme
    bar destroy
    return $result
} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}
test oo-15.4 {OO: object cloning - Bug 3474460} -setup {
    oo::class create ArbitraryClass
} -body {
    ArbitraryClass create foo
    oo::objdefine foo variable a b c
    oo::copy foo bar
    info object variable bar
} -cleanup {
    ArbitraryClass destroy
} -result {a b c}
test oo-15.5 {OO: class cloning - Bug 3474460} -setup {
    oo::class create ArbitraryClass
} -body {
    oo::class create Foo {
	superclass ArbitraryClass
	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-15.10 {variable binding must not bleed through oo::copy} -setup {
    oo::class create FooClass
    set result {}
} -body {
    set obj1 [FooClass new]
    oo::objdefine $obj1 {
	variable var
	method m {} {
	    set var foo
	}
	method get {} {
	    return $var
	}
	export eval
    }

    $obj1 m
    lappend result [$obj1 get]
    set obj2 [oo::copy $obj1]
    $obj2 eval {
	set var bar
    }
    lappend result [$obj2 get]
    $obj1 eval {
	set var grill
    }
    lappend result [$obj1 get] [$obj2 get]
} -cleanup {
    FooClass destroy
} -result {foo bar grill bar}
test oo-15.11 {OO: object cloning} -returnCodes error -body {
    oo::copy
} -result {wrong # args: should be "oo::copy sourceName ?targetName? ?targetNamespace?"}
test oo-15.12 {OO: object cloning with target NS} -setup {
    oo::class create Super
    oo::class create Cls {superclass Super}
} -body {
    namespace eval ::existing {}
    oo::copy Cls {} ::existing
} -returnCodes error -cleanup {
    Super destroy
    catch {namespace delete ::existing}
} -result {::existing refers to an existing namespace}
test oo-15.13.1 {
    OO: object cloning with target NS
    Valgrind will report a leak if the reference count of the namespace isn't
    properly incremented.
} -setup {
    oo::class create Cls {}
} -body {
    oo::copy Cls Cls2 ::dupens
    return done
} -cleanup {
    Cls destroy
    Cls2 destroy
} -result done
test oo-15.13.2 {OO: object cloning with target NS} -setup {
    oo::class create Super
    oo::class create Cls {superclass Super}
} -body {
    list [namespace exist ::dupens] [oo::copy Cls Cls2 ::dupens] [namespace exist ::dupens]
} -cleanup {
    Super destroy
} -result {0 ::Cls2 1}
test oo-15.14 {OO: object cloning with target NS} -setup {
    oo::class create Cls {export eval}
    set result {}
} -body {
    Cls create obj
    obj eval {
	proc test-15.14 {} {}
    }
    lappend result [info commands ::dupens::t*]
    oo::copy obj obj2 ::dupens
    lappend result [info commands ::dupens::t*]
} -cleanup {
    Cls destroy
} -result {{} ::dupens::test-15.14}
test oo-15.15 {method cloning must ensure that there is a string representation of bodies} -setup {
    oo::class create cls
} -body {
    cls create foo
    oo::objdefine foo {
	method m1 {} [string map {a b} {return hello}]
    }
    [oo::copy foo] m1
} -cleanup {
    cls destroy
} -result hello

test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
test oo-16.1.1 {OO: object introspection} -body {
    catch {info object} m o
    dict get $o -errorinfo
} -result "wrong \# args: should be \"info object subcommand ?arg ...?\"
    while executing
\"info object\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
    info object gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
    oo::class create meta { superclass oo::class }
    [meta create instance1] create instance2
} -body {
    list [list [info object class oo::object] \
	      [info object class oo::class] \
	      [info object class meta] \
	      [info object class instance1] \
	      [info object class instance2]] \
	[list [info object isa class oo::object] \
	     [info object isa class meta] \
	     [info object isa class instance1] \
	     [info object isa class instance2]] \
	[list [info object isa metaclass oo::object] \
	     [info object isa metaclass oo::class] \
	     [info object isa metaclass meta] \
	     [info object isa metaclass instance1] \
	     [info object isa metaclass instance2]] \
	[list [info object isa object oo::object] \
	     [info object isa object oo::class] \
	     [info object isa object meta] \
	     [info object isa object instance1] \
	     [info object isa object instance2] \
	     [info object isa object oo::define] \
	     [info object isa object NOTANOBJECT]]
} -cleanup {
    meta destroy
} -result {{::oo::class ::oo::class ::oo::class ::meta ::instance1} {1 1 1 0} {0 1 1 0 0} {1 1 1 1 1 0 0}}
test oo-16.5 {OO: object introspection} {info object methods oo::object} {}
test oo-16.6 {OO: object introspection} {
    oo::object create foo
    set result [list [info object methods foo]]
    oo::objdefine foo method bar {} {...}
    lappend result [info object methods foo] [foo destroy]
} {{} bar {}}
test oo-16.7 {OO: object introspection} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo method bar {a {b c} args} {the body}
    set result [info object methods foo]
    lappend result [info object methodtype foo bar] \
	[info object definition foo bar]
} -cleanup {
    foo destroy
} -result {bar method {{a {b c} args} {the body}}}
test oo-16.8 {OO: object introspection} {
    oo::object create foo
    oo::class create bar
    oo::objdefine foo mixin bar
    set result [list [info object mixins foo] \
		    [info object isa mixin foo bar] \
		    [info object isa mixin foo oo::class]]
    foo destroy
    bar destroy
    return $result
} {::bar 1 0}
test oo-16.9 {OO: object introspection} -body {
    oo::class create Ac
    oo::class create Bc; oo::define Bc superclass Ac
    oo::class create Cc; oo::define Cc superclass Bc
    oo::class create Dc; oo::define Dc mixin Cc
    Cc create E
    Dc create F
    list [info object isa    typeof E oo::class] \
	    [info object isa typeof E Ac] \
	    [info object isa typeof F Bc] \
	    [info object isa typeof F Cc]
} -cleanup {
    catch {Ac destroy}
} -result {0 1 1 1}
test oo-16.10 {OO: object introspection} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo export eval
    foo eval {variable c 3 a 1 b 2 ddd 4 e}
    lsort [info object vars foo ?]
} -cleanup {
    foo destroy
} -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
} -result {}
test oo-16.13 {OO: object introspection} -setup {
    oo::object create foo
} -cleanup {
    rename foo {}
} -body {
    oo::objdefine foo method Bar {} {return "ok in foo"}
    [info object namespace foo]::my Bar
} -result "ok in foo"
test oo-16.14 {OO: object introspection: TIP #436} -setup {
    oo::class create meta { superclass oo::class }
    [meta create instance1] create instance2
} -body {
    list class [list [info object isa class NOTANOBJECT] \
		    [info object isa class list]] \
	meta [list [info object isa metaclass NOTANOBJECT] \
		  [info object isa metaclass list] \
		  [info object isa metaclass oo::object]] \
	type [list [info object isa typeof oo::object NOTANOBJECT] \
		  [info object isa typeof NOTANOBJECT oo::object] \
		  [info object isa typeof list NOTANOBJECT] \
		  [info object isa typeof NOTANOBJECT list] \
		  [info object isa typeof oo::object list] \
		  [info object isa typeof list oo::object]] \
	mix [list [info object isa mixin oo::object NOTANOBJECT] \
		 [info object isa mixin NOTANOBJECT oo::object] \
		 [info object isa mixin list NOTANOBJECT] \
		 [info object isa mixin NOTANOBJECT list] \
		 [info object isa mixin oo::object list] \
		 [info object isa mixin list oo::object]]
} -cleanup {
    meta destroy
} -result {class {0 0} meta {0 0 0} type {0 0 0 0 0 0} mix {0 0 0 0 0 0}}
test oo-16.15 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    info object creationid [cls new]
} -cleanup {
    cls destroy
} -result {^\d+$} -match regexp
test oo-16.16 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set obj [cls new]
    set id [info object creationid $obj]
    rename $obj gorp
    set id2 [info object creationid gorp]
    list $id $id2
} -cleanup {
    cls destroy
} -result {^(\d+) \1$} -match regexp
test oo-16.17 {OO: object introspection: creationid #500} -body {
    info object creationid nosuchobject
} -returnCodes error -result {nosuchobject does not refer to an object}
test oo-16.18 {OO: object introspection: creationid #500} -body {
    info object creationid
} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
test oo-16.18.1 {OO: object introspection: creationid #500} -body {
    info object creationid oo::object gorp
} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
test oo-16.19 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    set id2 [info object creationid [set o2 [cls new]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal
test oo-16.20 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    $o1 destroy
    set id2 [info object creationid [set o2 [cls new]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal
test oo-16.21 {OO: object introspection: creationid #500} -setup {
    oo::class create cls
} -body {
    set id1 [info object creationid [set o1 [cls new]]]
    set id2 [info object creationid [set o2 [oo::copy $o1]]]
    if {$id1 == $id2} {
	format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
    } else {
	string cat not-equal
    }
} -cleanup {
    cls destroy
} -result not-equal

test oo-17.1 {OO: class introspection} -body {
    info class
} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
test oo-17.1.1 {OO: class introspection} -body {
    catch {info class} m o
    dict get $o -errorinfo
} -result "wrong \# args: should be \"info class subcommand ?arg ...?\"
    while executing
\"info class\""
test oo-17.2 {OO: class introspection} -body {
    info class superclass NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-17.3 {OO: class introspection} -setup {
    oo::object create foo
} -body {
    info class superclass foo
} -returnCodes 1 -cleanup {
    foo destroy
} -result {"foo" is not a class}
test oo-17.4 {OO: class introspection} -body {
    info class gorp oo::object
} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
test oo-17.5 {OO: class introspection} -setup {
    oo::class create testClass
} -body {
    testClass create foo
    testClass create bar
    testClass create spong
    lsort [info class instances testClass]
} -cleanup {
    testClass destroy
} -result {::bar ::foo ::spong}
test oo-17.6 {OO: class introspection} -setup {
    oo::class create foo
} -body {
    oo::define foo method bar {a {b c} args} {the body}
    set result [info class methods foo]
    lappend result [info class methodtype foo bar] \
	[info class definition foo bar]
} -cleanup {
    foo destroy
} -result {bar method {{a {b c} args} {the body}}}
test oo-17.7 {OO: class introspection} {
    info class superclasses oo::class
} ::oo::object
test oo-17.8 {OO: class introspection} -setup {
    oo::class create testClass
    oo::class create superClass1
    oo::class create superClass2
} -body {
    oo::define testClass superclass superClass1 superClass2
    list [info class superclasses testClass] \
	[lsort [info class subclass oo::object ::superClass?]]
} -cleanup {
    testClass destroy
    superClass1 destroy
    superClass2 destroy
} -result {{::superClass1 ::superClass2} {::superClass1 ::superClass2}}
test oo-17.9 {OO: class introspection} -setup {
    oo::class create foo
    oo::class create subfoo {superclass foo}
} -body {
    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
} -result {}
set stdmethods {<cloned> destroy eval unknown variable varname}
test oo-17.11 {OO: object method unexport (bug 900cb0284bc)} -setup {
    oo::object create o
    oo::objdefine o unexport m
} -body {
    lsort [info object methods o -all -private]
} -cleanup {
    o destroy
} -result $stdmethods
test oo-17.12 {OO: instance method unexport (bug 900cb0284bc)} -setup {
    oo::class create c
    c create o
    oo::objdefine o unexport m
} -body {
    lsort [info object methods o -all -private]
} -cleanup {
    o destroy
    c destroy
} -result $stdmethods
test oo-17.13 {OO: class method unexport (bug 900cb0284bc)} -setup {
    oo::class create c
    oo::define c unexport m
} -body {
    lsort [info class methods c -all -private]
} -cleanup {
    c destroy
} -result $stdmethods
test oo-17.14 {OO: instance method unexport (bug 900cb0284bc)} -setup {
    oo::class create c
    oo::define c unexport m
    c create o
} -body {
    lsort [info object methods o -all -private]
} -cleanup {
    o destroy
    c destroy
} -result $stdmethods


test oo-18.1 {OO: define command support} {
    list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
} {1 foo {foo
    while executing
"error foo"
    (in definition script for class "::oo::object" line 1)
    invoked from within
"oo::define oo::object {error foo}"}}
test oo-18.2 {OO: define command support} {
    list [catch {oo::define oo::object error foo} msg] $msg $errorInfo
} {1 foo {foo
    while executing
"oo::define oo::object error foo"}}
test oo-18.3 {OO: define command support} {
    list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo
} {1 bar {bar
    while executing
"error bar"
    (in definition script for class "::foo" line 1)
    invoked from within
"oo::class create foo {error bar}"}}
test oo-18.3a {OO: define command support} {
    list [catch {oo::class create foo {
    error bar
}} msg] $msg $errorInfo
} {1 bar {bar
    while executing
"error bar"
    (in definition script for class "::foo" line 2)
    invoked from within
"oo::class create foo {
    error bar
}"}}
test oo-18.3b {OO: define command support} {
    list [catch {oo::class create foo {
    eval eval error bar
}} msg] $msg $errorInfo
} {1 bar {bar
    while executing
"error bar"
    ("eval" body line 1)
    invoked from within
"eval error bar"
    ("eval" body line 1)
    invoked from within
"eval eval error bar"
    (in definition script for class "::foo" line 2)
    invoked from within
"oo::class create foo {
    eval eval error bar
}"}}
test oo-18.4 {OO: more error traces from the guts} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj method bar {} {my eval {error foo}}
    list [catch {obj bar} msg] $msg $errorInfo
} -cleanup {
    obj destroy
} -result {1 foo {foo
    while executing
"error foo"
    (in "my eval" script line 1)
    invoked from within
"my eval {error foo}"
    (object "::obj" method "bar" line 1)
    invoked from within
"obj bar"}}
test oo-18.5 {OO: more error traces from the guts} -setup {
    [oo::class create cls] create obj
    set errorInfo {}
} -body {
    oo::define cls {
	method eval script {next $script}
	export eval
    }
    oo::objdefine obj method bar {} {my eval {error foo}}
    set result {}
    lappend result [catch {obj bar} msg] $msg $errorInfo
    lappend result [catch {obj eval {error bar}} msg] $msg $errorInfo
} -cleanup {
    cls destroy
} -result {1 foo {foo
    while executing
"error foo"
    (in "my eval" script line 1)
    invoked from within
"next $script"
    (class "::cls" method "eval" line 1)
    invoked from within
"my eval {error foo}"
    (object "::obj" method "bar" line 1)
    invoked from within
"obj bar"} 1 bar {bar
    while executing
"error bar"
    (in "::obj eval" script line 1)
    invoked from within
"next $script"
    (class "::cls" method "eval" line 1)
    invoked from within
"obj eval {error bar}"}}
test oo-18.6 {class construction reference management and errors} -setup {
    oo::class create super_abc
} -body {
    catch {
oo::class create abc {
    superclass super_abc
    ::rename abc ::def
    ::error foo
}
    } msg opt
    dict get $opt -errorinfo
} -cleanup {
    super_abc destroy
} -result {foo
    while executing
"::error foo"
    (in definition script for class "::def" line 4)
    invoked from within
"oo::class create abc {
    superclass super_abc
    ::rename abc ::def
    ::error foo
}"}
test oo-18.7 {OO: objdefine command support} -setup {
    oo::object create ::inst
} -body {
    list [catch {oo::objdefine inst {rename ::inst ::INST;error foo}} msg] $msg $errorInfo
} -cleanup {
    catch {::inst destroy}
    catch {::INST destroy}
} -result {1 foo {foo
    while executing
"error foo"
    (in definition script for object "::INST" line 1)
    invoked from within
"oo::objdefine inst {rename ::inst ::INST;error foo}"}}
test oo-18.8 {OO: define/self command support} -setup {
    oo::class create parent
    oo::class create ::foo {superclass parent}
} -body {
    catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    parent destroy
} -result {foobar
    while executing
"error foobar"
    (in definition script for class object "::bar" line 1)
    invoked from within
"self {error foobar}"
    (in definition script for class "::bar" line 1)
    invoked from within
"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
test oo-18.9 {OO: define/self command support} -setup {
    oo::class create parent
    set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
        superclass parent
    }]
} -body {
    catch {oo::define $c {error err}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    parent destroy
} -result {err
    while executing
"error err"
    (in definition script for class "::now_this_is_a_very_very_long..." line 1)
    invoked from within
"oo::define $c {error err}"}
test oo-18.10 {OO: define/self command support} -setup {
    oo::class create parent
    oo::class create ::foo {superclass parent}
} -body {
    catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    parent destroy
} -result {foobar
    while executing
"error foobar"
    (in definition script for class object "::foo" line 1)
    invoked from within
"self {rename ::foo {}; error foobar}"
    (in definition script for class "::foo" line 1)
    invoked from within
"oo::define foo {self {rename ::foo {}; error foobar}}"}
test oo-18.11 {OO: define/self command support} -setup {
    oo::class create parent
    oo::class create ::foo {superclass parent}
} -body {
    catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
    dict get $opt -errorinfo
} -cleanup {
    parent destroy
} -result {this command cannot be called when the object has been deleted
    while executing
"self {error foobar}"
    (in definition script for class "::foo" line 1)
    invoked from within
"oo::define foo {rename ::foo {}; self {error foobar}}"}

test oo-19.1 {OO: varname method} -setup {
    oo::object create inst
    oo::objdefine inst export eval
    set result {}
    inst eval { variable x }
} -body {
    inst eval {trace add variable x write foo}
    set ns [inst eval namespace current]
    proc foo args {
	global ns result
	set context [uplevel 1 namespace current]
	lappend result $args [expr {
	    $ns eq $context ? "ok" : [list $ns ne $context]
	}] [expr {
	    "${ns}::x" eq [uplevel 1 my varname x] ? "ok" : [list ${ns}::x ne [uplevel 1 my varname x]]
	}]
    }
    lappend result [inst eval set x 0]
} -cleanup {
    inst destroy
    rename foo {}
} -result {{x {} write} ok ok 0}
test oo-19.2 {OO: varname method: Bug 2883857} -setup {
    oo::class create SpecialClass
    oo::objdefine SpecialClass export createWithNamespace
    SpecialClass createWithNamespace inst ::oo_test
    oo::objdefine inst export varname eval
} -body {
    inst eval { variable x; array set x {y z} }
    inst varname x(y)
} -cleanup {
    SpecialClass destroy
} -result ::oo_test::x(y)
test oo-19.3 {OO: varname method and variable decl: Bug 3603695} -setup {
    oo::class create testClass {
	variable foo
	export varname
	constructor {} {
	    variable foo x
	}
	method bar {obj} {
	    my varname foo
	    $obj varname foo
	}
    }
} -body {
    testClass create A
    testClass create B
    lsearch [list [A varname foo] [B varname foo]] [B bar A]
} -cleanup {
    testClass destroy
} -result 0

test oo-20.1 {OO: variable method} -body {
    oo::class create testClass {
	constructor {} {
	    my variable ok
	    set ok {}
	}
    }
    lsort [info object vars [testClass new]]
} -cleanup {
    catch {testClass destroy}
} -result ok
test oo-20.2 {OO: variable method} -body {
    oo::class create testClass {
	constructor {} {
	    my variable a b c
	    set a [set b [set c {}]]
	}
    }
    lsort [info object vars [testClass new]]
} -cleanup {
    catch {testClass destroy}
} -result {a b c}
test oo-20.3 {OO: variable method} -body {
    oo::class create testClass {
	export varname
	method bar {} {
	    my variable a(b)
	}
    }
    testClass create foo
    array set [foo varname a] {b c}
    foo bar
} -returnCodes 1 -cleanup {
    catch {testClass destroy}
} -result {can't define "a(b)": name refers to an element in an array}
test oo-20.4 {OO: variable method} -body {
    oo::class create testClass {
	export varname
	method bar {} {
	    my variable a(b)
	}
    }
    testClass create foo
    set [foo varname a] b
    foo bar
} -returnCodes 1 -cleanup {
    catch {testClass destroy}
} -result {can't define "a(b)": name refers to an element in an array}
test oo-20.5 {OO: variable method} -body {
    oo::class create testClass {
	method bar {} {
	    my variable a::b
	}
    }
    testClass create foo
    foo bar
} -returnCodes 1 -cleanup {
    catch {testClass destroy}
} -result {variable name "a::b" illegal: must not contain namespace separator}
test oo-20.6 {OO: variable method} -setup {
    oo::class create testClass {
	export varname
	self export eval
    }
} -body {
    testClass eval variable a 0
    oo::objdefine [testClass create foo] method bar {other} {
	$other variable a
	set a 3
    }
    oo::objdefine [testClass create boo] export variable
    set [foo varname a] 1
    set [boo varname a] 2
    foo bar boo
    list [testClass eval set a] [set [foo varname a]] [set [boo varname a]]
} -cleanup {
    testClass destroy
} -result {0 1 3}
test oo-20.7 {OO: variable method} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	method a {} {
	    my variable d b
	    lappend b $d
	}
	method e {} {
	    my variable b d
	    return [list $b $d]
	}
	method f {x y} {
	    my variable b d
	    set b $x
	    set d $y
	}
    }
    cls create obj
    obj f p q
    obj a
    obj a
    obj e
} -cleanup {
    cls destroy
} -result {{p q q} q}
# oo-20.8 tested explicitly for functionality removed due to [Bug 1959457]
test oo-20.9 {OO: variable method} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	method a {} {
	    my variable ::b
	}
    }
    obj a
} -returnCodes 1 -cleanup {
    obj destroy
} -result {variable name "::b" illegal: must not contain namespace separator}
test oo-20.10 {OO: variable and varname methods refer to same things} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	method a {} {
	    my variable b
	    set b [self]
	    return [my varname b]
	}
    }
    list [set [obj a]] [namespace tail [obj a]]
} -cleanup {
    obj destroy
} -result {::obj b}
test oo-20.11 {OO: variable mustn't crash when recursing} -body {
    oo::class create A {
	constructor {name} {
	    my variable np_name
	    set np_name $name
	}
	method copy {nm} {
	    set cpy [[info object class [self]] new $nm]
	    foreach var [info object vars [self]] {
		my variable $var
		set val [set $var]
		if {[string match o_* $var]} {
		    set objs {}
		    foreach ref $val {
			# call to "copy" crashes
			lappend objs [$ref copy {}]
		    }
		    $cpy prop $var $objs
		} else {
		    $cpy prop $var $val
		}
	    }
	    return $cpy
	}
	method prop {name val} {
	    my variable $name
	    set $name $val
	}
    }
    set o1 [A new {}]
    set o2 [A new {}]
    $o1 prop o_object $o2
    $o1 copy aa
} -cleanup {
    catch {A destroy}
} -match glob -result *
test oo-20.12 {OO: variable method accept zero args (TIP 323)} -setup {
    oo::object create foo
} -cleanup {
    foo destroy
} -body {
    oo::objdefine foo method demo {} {
	my variable
    }
    foo demo
} -result {}
test oo-20.13 {OO: variable method use in non-methods [Bug 2903811]} -setup {
    oo::object create fooObj
    oo::objdefine fooObj export variable
} -cleanup {
    fooObj destroy
} -body {
    apply {{} {fooObj variable x; set x ok; return}}
    apply {{} {fooObj variable x; return $x}}
} -result ok
test oo-20.14 {OO: variable method use in non-methods [Bug 2903811]} -setup {
    oo::object create fooObj
    oo::objdefine fooObj export variable
    namespace eval ns1 {}
    namespace eval ns2 {}
    set x bad
} -cleanup {
    fooObj destroy
    namespace delete ns1 ns2
    unset x
} -body {
    namespace eval ns1 {fooObj variable x; set x ok; subst ""}
    set x bad
    namespace eval ns2 {fooObj variable x; return $x}
} -result ok
test oo-20.15 {OO: variable method use in non-methods [Bug 2903811]} -setup {
    oo::object create fooObj
    oo::objdefine fooObj export variable varname
} -cleanup {
    fooObj destroy
} -body {
    apply {{} {fooObj variable x; set x ok; return}}
    return [set [fooObj varname x]]
} -result ok
test oo-20.16 {variable method: leak per instance} -setup {
    oo::class create foo
} -constraints memory -body {
    oo::define foo {
	constructor {} {
	    set [my variable v] 0
	}
    }
    leaktest {[foo new] destroy}
} -cleanup {
    foo destroy
} -result 0

test oo-21.1 {OO: inheritance ordering} -setup {
    oo::class create A
} -body {
    oo::define A method m {} {lappend ::result A}
    oo::class create B {
	superclass A
	method m {} {lappend ::result B;next}
    }
    oo::class create C {
	superclass A
	method m {} {lappend ::result C;next}
    }
    oo::class create D {
	superclass B C
	method m {} {lappend ::result D;next}
    }
    D create o
    oo::objdefine o method m {} {lappend ::result o;next}
    set result {}
    o m
    return $result
} -cleanup {
    A destroy
} -result {o D B C A}
test oo-21.2 {OO: inheritance ordering} -setup {
    oo::class create A
} -body {
    oo::define A method m {} {lappend ::result A}
    oo::class create B {
	superclass A
	method m {} {lappend ::result B;next}
    }
    oo::class create C {
	superclass A
	method m {} {lappend ::result C;next}
    }
    oo::class create D {
	superclass B C
	method m {} {lappend ::result D;next}
    }
    oo::class create Emix {
	superclass C
	method m {} {lappend ::result Emix;next}
    }
    oo::class create Fmix {
	superclass Emix
	method m {} {lappend ::result Fmix;next}
    }
    D create o
    oo::objdefine o {
	method m {} {lappend ::result o;next}
	mixin Fmix
    }
    set result {}
    o m
    return $result
} -cleanup {
    A destroy
} -result {Fmix Emix o D B C A}
test oo-21.3 {OO: inheritance ordering} -setup {
    oo::class create A
} -body {
    oo::define A method m {} {lappend ::result A}
    oo::class create B {
	superclass A
	method m {} {lappend ::result B;next}
	method f {} {lappend ::result B-filt;next}
    }
    oo::class create C {
	superclass A
	method m {} {lappend ::result C;next}
    }
    oo::class create D {
	superclass B C
	method m {} {lappend ::result D;next}
    }
    oo::class create Emix {
	superclass C
	method m {} {lappend ::result Emix;next}
	method f {} {lappend ::result Emix-filt;next}
    }
    oo::class create Fmix {
	superclass Emix
	method m {} {lappend ::result Fmix;next}
    }
    D create o
    oo::objdefine o {
	method m {} {lappend ::result o;next}
	mixin Fmix
	filter f
    }
    set result {}
    o m
    return $result
} -cleanup {
    A destroy
} -result {Emix-filt B-filt Fmix Emix o D B C A}
test oo-21.4 {OO: inheritance ordering} -setup {
    oo::class create A
} -body {
    oo::define A method m {} {lappend ::result A}
    oo::class create B {
	superclass A
	method m {} {lappend ::result B;next}
	method f {} {lappend ::result B-filt;next}
	method g {} {lappend ::result B-cfilt;next}
    }
    oo::class create C {
	superclass A
	method m {} {lappend ::result C;next}
    }
    oo::class create D {
	superclass B C
	method m {} {lappend ::result D;next}
	method g {} {lappend ::result D-cfilt;next}
	filter g
    }
    oo::class create Emix {
	superclass C
	method m {} {lappend ::result Emix;next}
	method f {} {lappend ::result Emix-filt;next}
    }
    oo::class create Fmix {
	superclass Emix
	method m {} {lappend ::result Fmix;next}
    }
    D create o
    oo::objdefine o {
	method m {} {lappend ::result o;next}
	mixin Fmix
	filter f
    }
    set result {}
    o m
    return $result
} -cleanup {
    A destroy
} -result {Emix-filt B-filt D-cfilt B-cfilt Fmix Emix o D B C A}

test oo-22.1 {OO and info frame} -setup {
    oo::class create c
    c create i
} -match glob -body {
    oo::define c self method frame {} {
	info frame 0
    }
    oo::define c {
	method frames {} {
	    info frame 0
	}
	method level {} {
	    info frame
	}
    }
    oo::objdefine i {
	method frames {} {
	    list [next] [info frame 0]
	}
	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
    }
    [c new] test
} -match glob -cleanup {
    c destroy
} -result {* cmd {info frame 0} method test class ::c level 0}

# Prove that the issue in [Bug 1865054] isn't an issue any more
test oo-23.1 {Self-like derivation; complex case!} -setup {
    oo::class create SELF {
	superclass oo::class
	unexport create new
	# Next is just a convenience
	method method args {oo::define [self] method {*}$args}
	method derive {name} {
	    set o [my new [list superclass [self]]]
	    oo::objdefine $o mixin $o
	    uplevel 1 [list rename $o $name]\;[list namespace which $name]
	}
	self mixin SELF
    }
    set result {}
} -body {
    [SELF derive foo1] method bar1 {} {return 1}
    lappend result [foo1 bar1]
    [foo1 derive foo2] method bar2 {} {return [my bar1],2}
    lappend result [foo2 bar2]
    [foo2 derive foo3] method bar3 {} {return [my bar2],3}
    lappend result [foo3 bar3]
    [foo3 derive foo4] method bar4 {} {return [my bar3],4}
    lappend result [foo4 bar4]
    foo2 method bar2 {} {return [my bar1],x}
    lappend result [foo4 bar4]
} -cleanup {
    SELF destroy
} -result {1 1,2 1,2,3 1,2,3,4 1,x,3,4}

test oo-24.1 {unknown method method - Bug 1965063} -setup {
    oo::class create cls
} -cleanup {
    cls destroy
} -returnCodes error -body {
    oo::define cls {
	method dummy {} {}
	method unknown args {next {*}$args}
    }
    [cls new] foo bar
} -result {unknown method "foo": must be destroy, dummy or unknown}
test oo-24.2 {unknown method method - Bug 1965063} -setup {
    oo::class create cls
} -cleanup {
    cls destroy
} -returnCodes error -body {
    oo::define cls {
	method dummy {} {}
	method unknown args {next {*}$args}
    }
    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 {}
} -cleanup {
    cls destroy
} -body {
    cls create foo
    cls create bar
    set m1 ab
    set m2 a; append m2 b ;# different object!
    lappend result [foo $m1] [foo $m1] [bar $m1] [foo $m1]
    lappend result [foo $m2] [bar $m2]
    oo::objdefine foo method ab {} {return good}
    lappend result [foo $m1] [bar $m2]
} -result {ok ok ok ok ok ok good ok}
test oo-25.2 {call chain caching - Bug #2120903} -setup {
    set c [oo::class create MyClass]
    set o [$c new]
} -body {
    oo::define MyClass {
	method name {} {return ok}
	method isa o {MyClass name $o}
	self method name o {$o name}
    }
    list [$o name] [$c name $o] [$o isa $o]
} -cleanup {
    $c destroy
} -result {ok ok ok}

test oo-26.1 {Bug 2037727} -setup {
    proc succeed args {}
    oo::object create example
} -body {
    oo::objdefine example method foo {} {succeed}
    example foo
    proc succeed {} {return succeed}
    example foo
} -cleanup {
    example destroy
    rename succeed {}
} -result succeed
test oo-26.2 {Bug 2037727} -setup {
    oo::class create example {
	method localProc {args body} {proc called $args $body}
	method run {} { called }
    }
    example create i1
    example create i2
} -body {
    i1 localProc args {}
    i2 localProc args {return nonempty}
    list [i1 run] [i2 run]
} -cleanup {
    example destroy
} -result {{} nonempty}
test oo-26.3 {Bug 2037727} -setup {
    oo::class create example {
	method subProc {args body} {
	    namespace eval subns [list proc called $args $body]
	}
	method run {} { subns::called }
    }
    example create i1
    example create i2
} -body {
    i1 subProc args {}
    i2 subProc args {return nonempty}
    list [i1 run] [i2 run]
} -cleanup {
    example destroy
} -result {{} nonempty}

test oo-27.1 {variables declaration - class introspection} -setup {
    oo::class create foo
} -cleanup {
    foo destroy
} -body {
    oo::define foo variable a b c
    info class variables foo
} -result {a b c}
test oo-27.2 {variables declaration - object introspection} -setup {
    oo::object create foo
} -cleanup {
    foo destroy
} -body {
    oo::objdefine foo variable a b c
    info object variables foo
} -result {a b c}
test oo-27.3 {variables declaration - basic behaviour} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	variable x!
	constructor {} {set x! 1}
	method y {} {incr x!}
    }
    foo create bar
    bar y
    bar y
} -result 3
test oo-27.4 {variables declaration - destructors too} -setup {
    oo::class create parent
    set result bad!
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	variable x!
	constructor {} {set x! 1}
	method y {} {incr x!}
	destructor {set ::result ${x!}}
    }
    foo create bar
    bar y
    bar y
    bar destroy
    return $result
} -result 3
test oo-27.5 {variables declaration - object-bound variables} -setup {
    oo::object create foo
} -cleanup {
    foo destroy
} -body {
    oo::objdefine foo {
	variable x!
	method y {} {incr x!}
    }
    foo y
    foo y
} -result 2
test oo-27.6 {variables declaration - non-interference of levels} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	variable x!
	constructor {} {set x! 1}
	method y {} {incr x!}
    }
    foo create bar
    oo::objdefine bar {
	variable y!
	method y {} {list [next] [incr y!] [info var] [info local]}
	export eval
    }
    bar y
    list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
} -result {{3 2 y! {}} {x! y!} {x! y!}}
test oo-27.7 {variables declaration - one underlying variable space} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	variable x!
	constructor {} {set x! 1}
	method y {} {incr x!}
    }
    oo::class create foo2 {
	superclass foo
	variable y!
	constructor {} {set y! 42; next}
	method x {} {incr y! -1}
    }
    foo2 create bar
    oo::objdefine bar {
	variable x! y!
	method z {} {list ${x!} ${y!}}
    }
    bar y
    bar x
    list [bar y] [bar x] [bar z]
} -result {3 40 {3 40}}
test oo-27.8 {variables declaration - error cases - ns separators} -body {
    oo::define oo::object variable bad::var
} -returnCodes error -result {invalid declared variable name "bad::var": must not contain namespace separators}
test oo-27.9 {variables declaration - error cases - arrays} -body {
    oo::define oo::object variable bad(var)
} -returnCodes error -result {invalid declared variable name "bad(var)": must not refer to an array element}
test oo-27.10 {variables declaration - no instance var leaks with class resolvers} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	variable clsvar
	constructor {} {
	    set clsvar 0
	}
	method step {} {
	    incr clsvar
	    return
	}
	method value {} {
	    return $clsvar
	}
    }
    foo create inst1
    inst1 step
    foo create inst2
    inst2 step
    inst1 step
    inst2 step
    inst1 step
    list [inst1 value] [inst2 value]
} -result {3 2}
test oo-27.11 {variables declaration - no instance var leaks with class resolvers} -setup {
    oo::class create parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	variable clsvar
	constructor {} {
	    set clsvar 0
	}
	method step {} {
	    incr clsvar
	    return
	}
	method value {} {
	    return $clsvar
	}
    }
    foo create inst1
    oo::objdefine inst1 {
	variable clsvar
	method reinit {} {
	    set clsvar 0
	}
    }
    foo create inst2
    oo::objdefine inst2 {
	variable clsvar
	method reinit {} {
	    set clsvar 0
	}
    }
    inst1 step
    inst2 step
    inst1 reinit
    inst2 reinit
    inst1 step
    inst2 step
    inst1 step
    inst2 step
    inst1 step
    list [inst1 value] [inst2 value]
} -result {3 2}
test oo-27.12 {variables declaration: leak per instance} -setup {
    oo::class create foo
} -constraints memory -body {
    oo::define foo {
	variable v
	constructor {} {
	    set v 0
	}
    }
    leaktest {[foo new] destroy}
} -cleanup {
    foo destroy
} -result 0
# This test will actually (normally) crash if it fails!
test oo-27.13 {variables declaration: Bug 3185009: require refcount management} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo {
	variable x
	method set v {set x $v}
	method unset {} {unset x}
	method exists {} {info exists x}
	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 parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	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 parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	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 parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	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 parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	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 parent
} -cleanup {
    parent destroy
} -body {
    oo::class create foo {
	superclass parent
	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}
test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup {
    oo::class create Super
    oo::class create Parent {
	superclass Super
	variable member1 member2
	constructor {} {
	    set member1 parent1
	    set member2 parent2
	}
	method getChild {} {
	    Child new [self]
	}
    }
    oo::class create Child {
	superclass Super
	variable member1 result
	constructor {m} {
	    set [namespace current]::member1 child1
	    set ns [info object namespace $m]
	    namespace upvar $ns member1 l1 member2 l2
	    upvar 1 member1 l3 member2 l4
	    [format namespace] upvar $ns member1 l5 member2 l6
	    [format upvar] 1 member1 l7 member2 l8
	    set result [list $l1 $l2 $l3 $l4 $l5 $l6 $l7 $l8]
	}
	method result {} {return $result}
    }
} -body {
    [[Parent new] getChild] result
} -cleanup {
    Super destroy
} -result {parent1 parent2 parent1 parent2 parent1 parent2 parent1 parent2}

# 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 {
    interp delete foo
} -body {
    foo eval {
	proc oo::define::privateMethod {name arguments body} {
	    uplevel 1 [list method $name $arguments $body]
	    uplevel 1 [list unexport $name]
	}
	oo::define cls privateMethod m {x y} {return $x,$y}
	cls create obj
	list [catch {obj m 1 2}] [obj eval my m 3 4]
    }
} -result {1 3,4}

test oo-29.1 {self class with object-defined methods} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj method demo {} {
	self class
    }
    obj demo
} -returnCodes error -cleanup {
    obj destroy
} -result {method not defined by a class}

test oo-30.1 {Bug 2903011: deleting an object in a constructor} -setup {
    oo::class create cls
} -body {
    oo::define cls {constructor {} {[self] destroy}}
    cls new
} -returnCodes error -cleanup {
    cls destroy
} -result {object deleted in constructor}
test oo-30.2 {Bug 2903011: deleting an object in a constructor} -setup {
    oo::class create cls
} -body {
    oo::define cls {constructor {} {my destroy}}
    cls new
} -returnCodes error -cleanup {
    cls destroy
} -result {object deleted in constructor}

test oo-31.1 {Bug 3111059: when objects and coroutines entangle} -setup {
    oo::class create cls
} -constraints memory -body {
    oo::define cls {
	method justyield {} {
	    yield
	}
	constructor {} {
	    coroutine coro my justyield
	}
    }
    list [leaktest {[cls new] destroy}] [info class instances cls]
} -cleanup {
    cls destroy
} -result {0 {}}
test oo-31.2 {Bug 3111059: when objects and coroutines entangle} -setup {
    oo::class create cls
} -constraints memory -body {
    oo::define cls {
	method justyield {} {
	    yield
	}
	constructor {} {
	    coroutine coro my justyield
	}
	destructor {
	    rename coro {}
	}
    }
    list [leaktest {[cls new] destroy}] [info class instances cls]
} -cleanup {
    cls destroy
} -result {0 {}}

proc SampleSlotSetup script {
    set script0 {
	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
	    }
	    method Resolve {lst} {
		variable ops
		lappend ops [info level] Resolve $lst
		return $lst
	    }
	}
    }
    append script0 \n$script
}

proc SampleSlotCleanup script {
    set script0 {
	SampleSlot destroy
    }
    append script \n$script0
}

test oo-32.1 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {a b c} {}}
test oo-32.2 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -clear] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {} {1 Set {}}}
test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {a b c g h i} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {a b c g h i}}}
test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -set d e f] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {d e f} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f}}}
test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {} {d e f g h i} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f} 1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {d e f g h i}}}
test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -prepend g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} {g h i a b c} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {g h i a b c}}}
test oo-32.7 {TIP 516: slots - class test} -setup [SampleSlotSetup {
    SampleSlot create sampleSlot
}] -body {
    list [info level] [sampleSlot -remove c a] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
    rename sampleSlot {}
}] -result {0 {} b {1 Resolve c 1 Resolve a 1 Get 1 Set b}}

test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    list [$s x y] [$s contents]
} -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result {{} {a b c x y}}
test oo-33.2 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    list [$s destroy; $s unknown] [$s contents]
} -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result {{} {a b c destroy unknown}}
test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    oo::objdefine $s forward --default-operation  my -set
    list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result {{} unknown {1 Resolve destroy 1 Set destroy 1 Resolve unknown 1 Set unknown}}
test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
    set s [SampleSlot new]
}] -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup [SampleSlotCleanup {
    rename $s {}
}] -result \
    {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}

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 -prepend -remove -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
    getMethods oo::define::mixin
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.5 {TIP 380: slots - presence} {
    getMethods oo::define::superclass
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.6 {TIP 380: slots - presence} {
    getMethods oo::define::variable
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
    getMethods oo::objdefine::filter
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
    getMethods oo::objdefine::mixin
} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.9 {TIP 380: slots - presence} {
    getMethods oo::objdefine::variable
} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.10 {TIP 516: slots - resolution} -setup {
    oo::class create parent
    set result {}
    oo::class create 516a { superclass parent }
    oo::class create 516b { superclass parent }
    oo::class create 516c { superclass parent }
    namespace eval 516test {
	oo::class create 516a { superclass parent }
	oo::class create 516b { superclass parent }
	oo::class create 516c { superclass parent }
    }
} -body {
    # Must find the right classes when making the mixin
    namespace eval 516test {
	oo::define 516a {
	    mixin 516b 516c
	}
    }
    lappend result [info class mixin 516test::516a]
    # Must not remove class with just simple name match
    oo::define 516test::516a {
	mixin -remove 516b
    }
    lappend result [info class mixin 516test::516a]
    # Must remove class with resolved name match
    oo::define 516test::516a {
	mixin -remove 516test::516c
    }
    lappend result [info class mixin 516test::516a]
    # Must remove class with resolved name match even after renaming, but only
    # with the renamed name; it is a slot of classes, not strings!
    rename 516test::516b 516test::516d
    oo::define 516test::516a {
	mixin -remove 516test::516b
    }
    lappend result [info class mixin 516test::516a]
    oo::define 516test::516a {
	mixin -remove 516test::516d
    }
    lappend result [info class mixin 516test::516a]
} -cleanup {
    parent destroy
} -result {{::516test::516b ::516test::516c} {::516test::516b ::516test::516c} ::516test::516b ::516test::516d {}}

test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
    oo::class create fruit {
	method eat {} {}
    }
    set result {}
} -body {
    lappend result [fruit create ::apple] [info class superclasses fruit]
    oo::define fruit superclass
    lappend result [info class superclasses fruit] \
	[info object class apple oo::object] \
	[info class call fruit destroy] \
	[catch { apple }]
} -cleanup {
    unset -nocomplain result
    fruit destroy
} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
    oo::class create fruitMetaclass {
	superclass oo::class
	method eat {} {}
    }
    set result {}
} -body {
    lappend result [fruitMetaclass create ::appleClass] \
	[appleClass create orange] \
	[info class superclasses fruitMetaclass]
    oo::define fruitMetaclass superclass
    lappend result [info class superclasses fruitMetaclass] \
	[info object class appleClass oo::class] \
	[catch { orange }] [info object class orange] \
	[appleClass create pear]
} -cleanup {
    unset -nocomplain result
    fruitMetaclass destroy
} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
test oo-35.3 {Bug 593baa032c: superclass list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {superclass B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}
test oo-35.4 {Bug 593baa032c: mixins list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {mixin B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}
test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly} -setup {
    oo::class create base {
	unexport destroy
    }
} -body {
    oo::class create C {
	superclass base
	method c {} {}
    }
    oo::class create D {
	superclass base
	mixin C
	method d {} {}
    }
    oo::class create E {
	superclass D
	method e {} {}
    }
    E create e1
    list [lsort [info class methods E -all]] [lsort [info object methods e1 -all]]
} -cleanup {
    base destroy
} -result {{c d e} {c d e}}
test oo-35.6 {
    Bug : teardown of an object that is a class that is an instance of itself
} -setup {
    oo::class create obj

    oo::copy obj obj1 obj1
    oo::objdefine obj1 {
	mixin obj1 obj
    }
    oo::copy obj1 obj2
    oo::objdefine obj2 {
	mixin obj2 obj1
    }
} -body {
    rename obj2 {}
    rename obj1 {}
    # doesn't crash
    return done
} -cleanup {
    rename obj {}
} -result done

test oo-36.1 {TIP #470: introspection within oo::define} {
    oo::define oo::object self
} ::oo::object
test oo-36.2 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
} -body {
    oo::define Cls self
} -cleanup {
    Cls destroy
} -result ::Cls
test oo-36.3 {TIP #470: introspection within oo::define} -setup {
    oo::class create Super
    set result uncalled
} -body {
    oo::class create Sub {
	superclass Super
	::set ::result [self]
    }
    return $result
} -cleanup {
    Super destroy
} -result ::Sub
test oo-36.4 {TIP #470: introspection within oo::define} -setup {
    oo::class create Super
    set result uncalled
} -body {
    oo::class create Sub {
	superclass Super
	::set ::result [self {}]
    }
    return $result
} -cleanup {
    Super destroy
} -result {}
test oo-36.5 {TIP #470: introspection within oo::define} -setup {
    oo::class create Super
    set result uncalled
} -body {
    oo::class create Sub {
	superclass Super
	::set ::result [self self]
    }
} -cleanup {
    Super destroy
} -result ::Sub
test oo-36.6 {TIP #470: introspection within oo::objdefine} -setup {
    oo::class create Cls
    set result uncalled
} -body {
    Cls create obj
    oo::objdefine obj {
	::set ::result [self]
    }
} -cleanup {
    Cls destroy
} -result ::obj
test oo-36.7 {TIP #470: introspection within oo::objdefine} -setup {
    oo::class create Cls
} -body {
    Cls create obj
    oo::objdefine obj {
	self
    }
} -cleanup {
    Cls destroy
} -result ::obj
test oo-36.8 {TIP #470: introspection within oo::objdefine} -setup {
    oo::class create Cls
} -body {
    Cls create obj
    oo::objdefine obj {
	self anything
    }
} -returnCodes error -cleanup {
    Cls destroy
} -result {wrong # args: should be "self"}
test oo-36.9 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
    set result uncalled
} -body {
    proc oo::define::testself {} {
	global result
	set result [list [catch {self} msg] $msg \
			[catch {uplevel 1 self} msg] $msg]
	return
    }
    list [oo::define Cls testself] $result
} -cleanup {
    Cls destroy
    catch {rename oo::define::testself {}}
} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::Cls}}
test oo-36.10 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
    set result uncalled
} -body {
    proc oo::objdefine::testself {} {
	global result
	set result [list [catch {self} msg] $msg \
			[catch {uplevel 1 self} msg] $msg]
	return
    }
    Cls create obj
    list [oo::objdefine obj testself] $result
} -cleanup {
    Cls destroy
    catch {rename oo::objdefine::testself {}}
} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::obj}}

test oo-37.1 {TIP 500: private command propagates errors} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private ::error "this is an error"
    }
} -cleanup {
    cls destroy
} -returnCodes error -result {this is an error}
test oo-37.2 {TIP 500: private command propagates errors} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private {
	    ::error "this is an error"
	}
    }
} -cleanup {
    cls destroy
} -returnCodes error -result {this is an error}
test oo-37.3 {TIP 500: private command propagates errors} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	private ::error "this is an error"
    }
} -cleanup {
    obj destroy
} -returnCodes error -result {this is an error}
test oo-37.4 {TIP 500: private command propagates errors} -setup {
    oo::object create obj
} -body {
    oo::objdefine obj {
	private {
	    ::error "this is an error"
	}
    }
} -cleanup {
    obj destroy
} -returnCodes error -result {this is an error}
test oo-37.5 {TIP 500: private command can't be used outside definitions} -body {
    oo::define::private error "xyz"
} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}
test oo-37.6 {TIP 500: private command can't be used outside definitions} -body {
    oo::objdefine::private error "xyz"
} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}

test oo-38.1 {TIP 500: private variables don't cross-interfere with each other or normal ones} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	private variable x
	constructor {} {
	    set x 1
	}
	method getA {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	private {
	    variable x
	}
	constructor {} {
	    set x 2
	    next
	}
	method getB {} {
	    return $x
	}
    }
    oo::class create clsC {
	superclass clsB
	variable x
	constructor {} {
	    set x 3
	    next
	}
	method getC {} {
	    return $x
	}
    }
    clsC create obj
    oo::objdefine obj {
	private {
	    variable x
	}
	method setup {} {
	    set x 4
	}
	method getO {} {
	    return $x
	}
    }
    obj setup
    list [obj getA] [obj getB] [obj getC] [obj getO] \
	[lsort [string map [list [info object creationid clsA] CLASS-A \
				[info object creationid clsB] CLASS-B \
				[info object creationid obj] OBJ] \
		    [info object vars obj]]]
} -cleanup {
    parent destroy
} -result {1 2 3 4 {{CLASS-A : x} {CLASS-B : x} {OBJ : x} x}}
test oo-38.2 {TIP 500: private variables introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	private {
	    variable x1
	    variable x2
	}
	variable y1 y2
    }
    cls create obj
    oo::objdefine obj {
	private variable a1 a2
	variable b1 b2
    }
    list [lsort [info class variables cls]] \
	[lsort [info class variables cls -private]] \
	[lsort [info object variables obj]] \
	[lsort [info object variables obj -private]]
} -cleanup {
    parent destroy
} -result {{y1 y2} {x1 x2} {b1 b2} {a1 a2}}
test oo-38.3 {TIP 500: private variables and oo::object·varname} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	private {
	    variable x
	}
	method getx {} {
	    set x 1
	    my varname x
	}
	method readx {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method gety {} {
	    set x 1
	    my varname x
	}
	method ready {} {
	    return $x
	}
    }
    clsB create obj
    set [obj getx] 2
    set [obj gety] 3
    list [obj readx] [obj ready]
} -cleanup {
    parent destroy
} -result {2 3}
test oo-38.4 {TIP 500: private variables introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	private {
	    variable x1 x2
	}
	variable y1 y2
	constructor {} {
	    variable z boo
	    set x1 a
	    set y1 c
	}
	method list {} {
	    variable z
	    set ok 1
	    list [info locals] [lsort [info vars]] [info exist x2]
	}
    }
    cls create obj
    oo::objdefine obj {
	private variable a1 a2
	variable b1 b2
	method init {} {
	    # Because we don't have a constructor to do this setup for us
	    set a1 p
	    set b1 r
	}
	method list {} {
	    variable z
	    set yes 1
	    list {*}[next] [info locals] [lsort [info vars]] [info exist a2]
	}
    }
    obj init
    obj list
} -cleanup {
    parent destroy
} -result {ok {ok x1 x2 y1 y2 z} 0 yes {a1 a2 b1 b2 yes z} 0}
test oo-38.5 {TIP 500: private variables and oo::object·variable} -setup {
    oo::class create parent
} -body {
    oo::class create cls1 {
	superclass parent
	private variable x
	method abc val {
	    my variable x
	    set x $val
	}
	method def val {
	    my variable y
	    set y $val
	}
	method get1 {} {
	    my variable x y
	    return [list $x $y]
	}
    }
    oo::class create cls2 {
	superclass cls1
	private variable x
	method x-exists {} {
	    return [info exists x],[uplevel 1 {info exists x}]
	}
	method ghi x {
	    # Additional instrumentation to show that we're not using the
	    # resolved variable until we ask for it; the argument nixed that
	    # happening by default.
	    set val $x
	    set before [my x-exists]
	    unset x
	    set x $val
	    set mid [my x-exists]
	    unset x
	    set mid2 [my x-exists]
	    my variable x
	    set x $val
	    set after [my x-exists]
	    return "$before;$mid;$mid2;$after"
	}
	method jkl val {
	    my variable y
	    set y $val
	}
	method get2 {} {
	    my variable x y
	    return [list $x $y]
	}
    }
    cls2 create a
    a abc 123
    a def 234
    set tmp [a ghi 345]
    a jkl 456
    list $tmp [a get1] [a get2]
} -cleanup {
    parent destroy
} -result {{0,1;0,1;0,0;1,1} {123 456} {345 456}}

test oo-39.1 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    my step
	    my step
	    return
	}
	private {
	    method step {} {
		incr x 2
	    }
	}
	method x {} {
	    return $x
	}
    }
    clsA create obj
    obj act
    list [obj x] [catch {obj step} msg] $msg
} -cleanup {
    parent destroy
} -result {7 1 {unknown method "step": must be act, destroy or x}}
test oo-39.2 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    my step
	    my step
	    return
	}
	private {
	    method step {} {
		incr x 2
	    }
	}
	method x {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method step {} {
	    incr x 5
	}
    }
    clsB create obj
    obj act
    list [obj x] [obj step]
} -cleanup {
    parent destroy
} -result {7 12}
test oo-39.3 {TIP 500: private methods internal call; class private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my Step
	    my Step
	    my Step
	    return
	}
	method x {} {
	    return $x
	}
    }
    oo::class create clsB {
	superclass clsA
	variable x
	method Step {} {
	    incr x 5
	}
    }
    clsB create obj
    obj act
    set result [obj x]
    oo::define clsA {
	private {
	    method Step {} {
		incr x 2
	    }
	}
    }
    obj act
    lappend result [obj x]
} -cleanup {
    parent destroy
} -result {16 22}
test oo-39.4 {TIP 500: private methods internal call; instance private} -setup {
    oo::class create parent
} -body {
    oo::class create clsA {
	superclass parent
	variable x
	constructor {} {
	    set x 1
	}
	method act {} {
	    my step
	    return
	}
	method step {} {
	    incr x
	}
	method x {} {
	    return $x
	}
    }
    clsA create obj
    obj act
    set result [obj x]
    oo::objdefine obj {
	variable x
	private {
	    method step {} {
		incr x 2
	    }
	}
    }
    obj act
    lappend result [obj x]
    oo::objdefine obj {
	method act {} {
	    my step
	    next
	}
    }
    obj act
    lappend result [obj x]
} -cleanup {
    parent destroy
} -result {2 3 6}
test oo-39.5 {TIP 500: private methods internal call; cross object} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {$x == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    cls create c 1
    list [a equal b] [b equal c] [c equal a] [catch {a x} msg] $msg
} -cleanup {
    parent destroy
} -result {0 0 1 1 {unknown method "x": must be destroy or equal}}
test oo-39.6 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {$x == [$other y]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be destroy, equal or x}
test oo-39.7 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {[[self] y] == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be destroy, equal or x}
test oo-39.8 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
	method equal {other} {
	    expr {[my y] == [$other x]}
	}
    }
    cls create a 1
    cls create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable, varname or x}
test oo-39.9 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
    }
    oo::class create cls2 {
	superclass cls
	method equal {other} {
	    expr {[my y] == [$other x]}
	}
    }
    cls2 create a 1
    cls2 create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
test oo-39.10 {TIP 500: private methods internal call; error reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	variable x
	constructor {val} {
	    set x $val
	}
	private method x {} {
	    return $x
	}
    }
    oo::class create cls2 {
	superclass cls
	method equal {other} {
	    expr {[my x] == [$other x]}
	}
    }
    cls2 create a 1
    cls2 create b 2
    a equal b
} -returnCodes error -cleanup {
    parent destroy
} -result {unknown method "x": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
test oo-39.11 {TIP 500: private methods; call chain caching and reporting} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method chain {} {
	    return [self call]
	}
    }
    oo::class create cls2 {
	superclass cls
	private method chain {} {
	    next
	}
	method chain2 {} {
	    my chain
	}
	method chain3 {} {
	    [self] chain
	}
    }
    cls create a
    cls2 create b
    list [a chain] [b chain] [b chain2] [b chain3]
} -cleanup {
    parent destroy
} -result {{{{method chain ::cls method}} 0} {{{method chain ::cls method}} 0} {{{private chain ::cls2 method} {method chain ::cls method}} 1} {{{private chain ::cls2 method} {method chain ::cls method}} 1}}
test oo-39.12 {TIP 500: private methods; introspection} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method chain {} {
	    return [self call]
	}
	private method abc {} {}
    }
    oo::class create cls2 {
	superclass cls
	method chain2 {} {
	    my chain
	}
	method chain3 {} {
	    [self] chain
	}
	private method def {} {}
	unexport chain3
    }
    cls create a
    cls2 create b
    oo::objdefine b {
	private method ghi {} {}
	method ABC {} {}
	method foo {} {}
    }
    set scopes {public unexported private}
    list a: [lmap s $scopes {info object methods a -scope $s}] \
	b: [lmap s $scopes {info object methods b -scope $s}] \
	cls: [lmap s $scopes {info class methods cls -scope $s}] \
	cls2: [lmap s $scopes {info class methods cls2 -scope $s}] \
} -cleanup {
    parent destroy
} -result {a: {{} {} {}} b: {foo ABC ghi} cls: {chain {} abc} cls2: {chain2 chain3 def}}

test oo-40.1 {TIP 500: private and self} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	self {
	    private {
		variable a
	    }
	    variable b
	}
	private {
	    self {
		variable c
	    }
	    variable d
	}
	variable e
    }
    list \
	[lsort [info class variables cls]] \
	[lsort [info class variables cls -private]] \
	[lsort [info object variables cls]] \
	[lsort [info object variables cls -private]]
} -cleanup {
    cls destroy
} -result {e d b {a c}}
test oo-40.2 {TIP 500: private and export} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private method foo {} {}
    }
    set result [lmap s {public unexported private} {
	info class methods cls -scope $s}]
    oo::define cls {
	export foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo foo {} {}}
test oo-40.3 {TIP 500: private and unexport} -setup {
    oo::class create cls
} -body {
    oo::define cls {
	private method foo {} {}
    }
    set result [lmap s {public unexported private} {
	info class methods cls -scope $s}]
    oo::define cls {
	unexport foo
    }
    lappend result {*}[lmap s {public unexported private} {
	info class methods cls -scope $s}]
} -cleanup {
    cls destroy
} -result {{} {} foo {} foo {}}

test oo-41.1 {TIP 478: myclass command, including class morphing} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method count {} {
	    my variable c
	    incr c
	}
	method act {} {
	    myclass count
	}
    }
    cls1 create x
    lappend result [x act] [x act]
    cls1 create y
    lappend result [y act] [y act] [x act]
    oo::class create cls2 {
	superclass cls1
	self method count {} {
	    my variable d
	    expr {1.0 * [incr d]}
	}
    }
    oo::objdefine x {class cls2}
    lappend result [x act] [y act] [x act] [y act]
} -cleanup {
    parent destroy
} -result {1 2 3 4 5 1.0 6 2.0 7}
test oo-41.2 {TIP 478: myclass command cleanup} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method hi {} {
	    return "this is [self]"
	}
	method hi {} {
	    return "this is [self]"
	}
    }
    cls1 create x
    rename [info object namespace x]::my foo
    rename [info object namespace x]::myclass bar
    lappend result [cls1 hi] [x hi] [foo hi] [bar hi]
    x destroy
    lappend result [catch {foo hi}] [catch {bar hi}]
} -cleanup {
    parent destroy
} -result {{this is ::cls1} {this is ::x} {this is ::x} {this is ::cls1} 1 1}
test oo-41.3 {TIP 478: myclass command calls unexported methods, via forward} -setup {
    oo::class create parent
    set result {}
} -body {
    oo::class create cls1 {
	superclass parent
	self method Hi {} {
	    return "this is [self]"
	}
	forward poke myclass Hi
    }
    cls1 create x
    lappend result [catch {cls1 Hi}] [x poke]
} -cleanup {
    parent destroy
} -result {1 {this is ::cls1}}

test oo-42.1 {TIP 524: definition namespace control: introspection} {
    info class definitionnamespace oo::object
} {}
test oo-42.2 {TIP 524: definition namespace control: introspection} {
    info class definitionnamespace oo::object -class
} {}
test oo-42.3 {TIP 524: definition namespace control: introspection} {
    info class definitionnamespace oo::object -instance
} ::oo::objdefine
test oo-42.4 {TIP 524: definition namespace control: introspection} -body {
    info class definitionnamespace oo::object -gorp
} -returnCodes error -result {bad kind "-gorp": must be -class or -instance}
test oo-42.5 {TIP 524: definition namespace control: introspection} -body {
    info class definitionnamespace oo::object -class x
} -returnCodes error -result {wrong # args: should be "info class definitionnamespace className ?kind?"}
test oo-42.6 {TIP 524: definition namespace control: introspection} {
    info class definitionnamespace oo::class
} ::oo::define
test oo-42.7 {TIP 524: definition namespace control: introspection} {
    info class definitionnamespace oo::class -class
} ::oo::define
test oo-42.8 {TIP 524: definition namespace control: introspection} {
    info class definitionnamespace oo::class -instance
} {}

test oo-43.1 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
} -body {
    namespace eval foodef {
	proc sparkle {} {return ok}
    }
    oo::class create foocls {
	superclass oo::class parent
	definitionnamespace foodef
    }
    oo::class create foo {
	superclass parent
	self class foocls
    }
    oo::define foo {
	sparkle
    }
} -cleanup {
    parent destroy
    namespace delete foodef
} -result ok
test oo-43.2 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
    unset -nocomplain ::result
} -body {
    namespace eval foodef {
	namespace path ::oo::define
	proc sparkle {} {return ok}
    }
    oo::class create foocls {
	superclass oo::class parent
	definitionnamespace foodef
    }
    foocls create foo {
	superclass parent
	lappend ::result [sparkle]
    }
    return $result
} -cleanup {
    parent destroy
    namespace delete foodef
} -result ok
test oo-43.3 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
    unset -nocomplain ::result
} -body {
    namespace eval foodef {
	namespace path ::oo::define
	proc sparkle {} {return ok}
    }
    oo::class create foocls {
	superclass oo::class parent
	definitionnamespace -class foodef
    }
    foocls create foo {
	superclass parent
	lappend ::result [sparkle]
    }
    return $result
} -cleanup {
    parent destroy
    namespace delete foodef
} -result ok
test oo-43.4 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
} -body {
    namespace eval foodef {
	namespace path ::oo::objdefine
	proc sparkle {} {return ok}
    }
    oo::class create foocls {
	superclass oo::class parent
	definitionnamespace -instance foodef
    }
    foocls create foo {
	sparkle
    }
} -returnCodes error -cleanup {
    parent destroy
    namespace delete foodef
} -result {invalid command name "sparkle"}
test oo-43.5 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
} -body {
    namespace eval foodef {
	namespace path ::oo::objdefine
	proc sparkle {} {return ok}
    }
    oo::class create foocls {
	superclass oo::class parent
	definitionnamespace foodef
    }
    namespace delete foodef
    foocls create foo {
	sparkle
    }
} -returnCodes error -cleanup {
    parent destroy
    catch {namespace delete foodef}
} -result {invalid command name "sparkle"}
test oo-43.6 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
    unset -nocomplain result
} -body {
    namespace eval foodef {
	namespace path ::oo::objdefine
	proc sparkle {} {return ok}
    }
    oo::class create foocls {
	superclass oo::class parent
	definitionnamespace foodef
    }
    foocls create foo
    lappend result [catch {oo::define foo sparkle} msg] $msg
    namespace delete foodef
    lappend result [catch {oo::define foo sparkle} msg] $msg
    namespace eval foodef {
	namespace path ::oo::objdefine
	proc sparkle {} {return ok}
    }
    lappend result [catch {oo::define foo sparkle} msg] $msg
} -cleanup {
    parent destroy
    catch {namespace delete foodef}
} -result {0 ok 1 {invalid command name "sparkle"} 0 ok}
test oo-43.7 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
} -body {
    namespace eval foodef {
	namespace path ::oo::define
	proc sparkle {x} {return ok}
    }
    oo::class create foocls {
	superclass oo::class parent
	definitionnamespace foodef
    }
    foocls create foo {
	superclass parent
    }
    oo::define foo spar gorp
} -cleanup {
    parent destroy
    namespace delete foodef
} -result ok
test oo-43.8 {TIP 524: definition namespace control: semantics} -setup {
    oo::class create parent
    namespace eval foodef {}
} -body {
    namespace eval foodef {
	namespace path ::oo::objdefine
	proc sparkle {} {return ok}
    }
    oo::class create foo {
	superclass parent
	definitionnamespace -instance foodef
    }
    oo::objdefine [foo new] {
	method x y z
	sparkle
    }
} -cleanup {
    parent destroy
    namespace delete foodef
} -result ok
test oo-43.9 {TIP 524: definition namespace control: syntax} -body {
    oo::class create foo {
	definitionnamespace -gorp foodef
    }
} -returnCodes error -result {bad kind "-gorp": must be -class or -instance}
test oo-43.10 {TIP 524: definition namespace control: syntax} -body {
    oo::class create foo {
	definitionnamespace -class foodef x
    }
} -returnCodes error -result {wrong # args: should be "definitionnamespace ?kind? namespace"}
test oo-43.11 {TIP 524: definition namespace control: syntax} -setup {
    catch {namespace delete ::no_such_ns}
} -body {
    oo::class create foo {
	definitionnamespace -class ::no_such_ns
    }
} -returnCodes error -result {namespace "::no_such_ns" not found}
test oo-43.12 {TIP 524: definition namespace control: user-level introspection} -setup {
    oo::class create parent
    namespace eval foodef {}
} -body {
    namespace eval foodef {}
    oo::class create foo {
	superclass oo::class parent
    }
    list [info class definitionnamespace foo] \
	[oo::define foo definitionnamespace foodef] \
	[info class definitionnamespace foo] \
	[oo::define foo definitionnamespace {}] \
	[info class definitionnamespace foo]
} -cleanup {
    parent destroy
    namespace delete foodef
} -result {{} {} ::foodef {} {}}
test oo-43.13 {TIP 524: definition namespace control: user-level introspection} -setup {
    oo::class create parent
    namespace eval foodef {}
} -body {
    namespace eval foodef {}
    oo::class create foo {
	superclass parent
    }
    list [info class definitionnamespace foo -instance] \
	[oo::define foo definitionnamespace -instance foodef] \
	[info class definitionnamespace foo -instance] \
	[oo::define foo definitionnamespace -instance {}] \
	[info class definitionnamespace foo -instance]
} -cleanup {
    parent destroy
    namespace delete foodef
} -result {{} {} ::foodef {} {}}

cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/ooNext2.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
1065









































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2006-2011 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
	set lines [split [memory info] \n]
	return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
	set end [getbytes]
	for {set i 0} {$i < $iterations} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [getbytes]
	}
	return [expr {$end - $tmp}]
    }
}

test oo-nextto-1.1 {basic nextto functionality} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x args {
	    lappend ::result ==A== $args
	}
    }
    oo::class create B {
	superclass A
	method x args {
	    lappend ::result ==B== $args
	    nextto A B -> A {*}$args
	}
    }
    oo::class create C {
	superclass A
	method x args {
	    lappend ::result ==C== $args
	    nextto A C -> A {*}$args
	}
    }
    oo::class create D {
	superclass B C
	method x args {
	    lappend ::result ==D== $args
	    next foo
	    nextto C bar
	}
    }
    set ::result {}
    [D new] x
    return $::result
} -cleanup {
    root destroy
} -result {==D== {} ==B== foo ==A== {B -> A foo} ==C== bar ==A== {C -> A bar}}
test oo-nextto-1.2 {basic nextto functionality} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x args {
	    lappend ::result ==A== $args
	}
    }
    oo::class create B {
	superclass A
	method x args {
	    lappend ::result ==B== $args
	    nextto A B -> A {*}$args
	}
    }
    oo::class create C {
	superclass A
	method x args {
	    lappend ::result ==C== $args
	    nextto A C -> A {*}$args
	}
    }
    oo::class create D {
	superclass B C
	method x args {
	    lappend ::result ==D== $args
	    nextto B foo {*}$args
	    nextto C bar {*}$args
	}
    }
    set ::result {}
    [D new] x 123
    return $::result
} -cleanup {
    root destroy
} -result {==D== 123 ==B== {foo 123} ==A== {B -> A foo 123} ==C== {bar 123} ==A== {C -> A bar 123}}
test oo-nextto-1.3 {basic nextto functionality: constructors} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	variable result
	constructor {a c} {
	    lappend result ==A== a=$a,c=$c
	}
    }
    oo::class create B {
	superclass root
	variable result
	constructor {b} {
	    lappend result ==B== b=$b
	}
    }
    oo::class create C {
	superclass A B
	variable result
	constructor {p q r} {
	    lappend result ==C== p=$p,q=$q,r=$r
	    # Route arguments to superclasses, in non-trival pattern
	    nextto B $q
	    nextto A $p $r
	}
	method result {} {return $result}
    }
    [C new x y z] result
} -cleanup {
    root destroy
} -result {==C== p=x,q=y,r=z ==B== b=y ==A== a=x,c=z}
test oo-nextto-1.4 {basic nextto functionality: destructors} -setup {
    oo::class create root {destructor return}
} -body {
    oo::class create A {
	superclass root
	destructor {
	    lappend ::result ==A==
	    next
	}
    }
    oo::class create B {
	superclass root
	destructor {
	    lappend ::result ==B==
	    next
	}
    }
    oo::class create C {
	superclass A B
	destructor {
	    lappend ::result ==C==
	    lappend ::result |
	    nextto B
	    lappend ::result |
	    nextto A
	    lappend ::result |
	    next
	}
    }
    set ::result ""
    [C new] destroy
    return $::result
} -cleanup {
    root destroy
} -result {==C== | ==B== | ==A== ==B== | ==A== ==B==}

test oo-nextto-2.1 {errors in nextto} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x y {error $y}
    }
    oo::class create B {
	superclass A
	method x y {nextto A $y}
    }
    [B new] x boom
} -cleanup {
    root destroy
} -result boom -returnCodes error
test oo-nextto-2.2 {errors in nextto} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x y {error $y}
    }
    oo::class create B {
	superclass root
	method x y {nextto A $y}
    }
    [B new] x boom
} -returnCodes error -cleanup {
    root destroy
} -result {method has no non-filter implementation by "A"}
test oo-nextto-2.3 {errors in nextto} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x y {nextto $y}
    }
    oo::class create B {
	superclass A
	method x y {nextto A $y}
    }
    [B new] x B
} -returnCodes error -cleanup {
    root destroy
} -result {method implementation by "B" not reachable from here}
test oo-nextto-2.4 {errors in nextto} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x y {nextto $y}
    }
    oo::class create B {
	superclass A
	method x y {nextto}
    }
    [B new] x B
} -returnCodes error -cleanup {
    root destroy
} -result {wrong # args: should be "nextto class ?arg...?"}
test oo-nextto-2.5 {errors in nextto} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x y {nextto $y}
    }
    oo::class create B {
	superclass A
	method x y {nextto $y $y $y}
    }
    [B new] x A
} -cleanup {
    root destroy
} -result {wrong # args: should be "nextto A y"} -returnCodes error
test oo-nextto-2.6 {errors in nextto} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x y {nextto $y}
    }
    oo::class create B {
	superclass A
	method x y {nextto $y $y $y}
    }
    [B new] x [root create notAClass]
} -cleanup {
    root destroy
} -result {"::notAClass" is not a class} -returnCodes error
test oo-nextto-2.7 {errors in nextto} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x y {nextto $y}
    }
    oo::class create B {
	superclass A
	filter Y
	method Y args {next {*}$args}
    }
    oo::class create C {
	superclass B
	method x y {nextto $y $y $y}
    }
    [C new] x B
} -returnCodes error -cleanup {
    root destroy
} -result {method has no non-filter implementation by "B"}

test oo-call-1.1 {object call introspection} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    A create y
    info object call y x
} -cleanup {
    root destroy
} -result {{method x ::A method}}
test oo-call-1.2 {object call introspection} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
    }
    B create y
    info object call y x
} -cleanup {
    root destroy
} -result {{method x ::B method} {method x ::A method}}
test oo-call-1.3 {object call introspection} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    A create y
    oo::objdefine y method x {} {}
    info object call y x
} -cleanup {
    root destroy
} -result {{method x object method} {method x ::A method}}
test oo-call-1.4 {object object call introspection - unknown} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    A create y
    info object call y z
} -cleanup {
    root destroy
} -result {{unknown unknown ::oo::object {core method: "unknown"}}}
test oo-call-1.5 {object call introspection - filters} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
	method y {} {}
	filter y
    }
    A create y
    info object call y x
} -cleanup {
    root destroy
} -result {{filter y ::A method} {method x ::A method}}
test oo-call-1.6 {object call introspection - filters} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
	method y {} {}
	filter y
    }
    oo::class create ::B {
	superclass A
	method x {} {}
    }
    B create y
    info object call y x
} -cleanup {
    root destroy
} -result {{filter y ::A method} {method x ::B method} {method x ::A method}}
test oo-call-1.7 {object call introspection - filters} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
	method y {} {}
	filter y
    }
    oo::class create ::B {
	superclass A
	method x {} {}
	method y {} {}
    }
    B create y
    info object call y x
} -cleanup {
    root destroy
} -result {{filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}}
test oo-call-1.8 {object call introspection - filters} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
	method y {} {}
	filter y
    }
    oo::class create ::B {
	superclass A
	method x {} {}
	method y {} {}
	method z {} {}
	filter z
    }
    B create y
    info object call y x
} -cleanup {
    root destroy
} -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}}
test oo-call-1.9 {object call introspection - filters} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
	method y {} {}
	filter y
    }
    oo::class create ::B {
	superclass A
	method x {} {}
	method y {} {}
	method z {} {}
	filter z
    }
    B create y
    info object call y y
} -cleanup {
    root destroy
} -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method y ::B method} {method y ::A method}}
test oo-call-1.10 {object call introspection - filters + unknown} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method y {} {}
	filter y
    }
    oo::class create ::B {
	superclass A
	method y {} {}
	method unknown {} {}
    }
    B create y
    info object call y x
} -cleanup {
    root destroy
} -result {{filter y ::B method} {filter y ::A method} {unknown unknown ::B method} {unknown unknown ::oo::object {core method: "unknown"}}}
test oo-call-1.11 {object call introspection - filters + unknown} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method y {} {}
	filter y
    }
    A create y
    oo::objdefine y method unknown {} {}
    info object call y x
} -cleanup {
    root destroy
} -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}}
test oo-call-1.12 {object call introspection - filters + unknown} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method y {} {}
    }
    A create y
    oo::objdefine y {
	method unknown {} {}
	filter y
    }
    info object call y x
} -cleanup {
    root destroy
} -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}}
test oo-call-1.13 {object call introspection - filters + unknown} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method y {} {}
    }
    A create y
    oo::objdefine y {
	method unknown {} {}
	method x {} {}
	filter y
    }
    info object call y x
} -cleanup {
    root destroy
} -result {{filter y ::A method} {method x object method}}
test oo-call-1.14 {object call introspection - errors} -body {
    info object call
} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
test oo-call-1.15 {object call introspection - errors} -body {
    info object call a
} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
test oo-call-1.16 {object call introspection - errors} -body {
    info object call a b c
} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
test oo-call-1.17 {object call introspection - errors} -body {
    info object call notanobject x
} -returnCodes error -result {notanobject does not refer to an object}
test oo-call-1.18 {object call introspection - memory leaks} -body {
    leaktest {
	info object call oo::object destroy
    }
} -constraints memory -result 0
test oo-call-1.19 {object call introspection - memory leaks} -setup {
    oo::class create leaktester { method foo {} {dummy} }
} -body {
    leaktest {
	set lt [leaktester new]
	oo::objdefine $lt method foobar {} {dummy}
	list [info object call $lt destroy] \
	    [info object call $lt foo] \
	    [info object call $lt bar] \
	    [info object call $lt foobar] \
	    [$lt destroy]
    }
} -cleanup {
    leaktester destroy
} -constraints memory -result 0
test oo-call-1.20 {object call introspection - complex case} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
    }
    oo::class create ::C {
	superclass root
	method x {} {}
	mixin B
    }
    oo::class create ::D {
	superclass C
	method x {} {}
    }
    oo::class create ::E {
	superclass root
	method x {} {}
    }
    oo::class create ::F {
	superclass E
	method x {} {}
    }
    oo::class create ::G {
	superclass root
	method x {} {}
    }
    oo::class create ::H {
	superclass G
	method x {} {}
    }
    oo::define F mixin H
    F create y
    oo::objdefine y {
	method x {} {}
	mixin D
    }
    info object call y x
} -cleanup {
    root destroy
} -result {{method x ::D method} {method x ::B method} {method x ::A method} {method x ::C method} {method x ::H method} {method x ::G method} {method x object method} {method x ::F method} {method x ::E method}}
test oo-call-1.21 {object call introspection - complex case} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method y {} {}
	filter y
    }
    oo::class create ::B {
	superclass A
	method y {} {}
    }
    oo::class create ::C {
	superclass root
	method x {} {}
	mixin B
    }
    oo::class create ::D {
	superclass C
	filter x
    }
    oo::class create ::E {
	superclass root
	method y {} {}
	method x {} {}
    }
    oo::class create ::F {
	superclass E
	method z {} {}
	method q {} {}
    }
    F create y
    oo::objdefine y {
	method unknown {} {}
	mixin D
	filter q
    }
    info object call y z
} -cleanup {
    root destroy
} -result {{filter x ::C method} {filter x ::E method} {filter y ::B method} {filter y ::A method} {filter y ::E method} {filter q ::F method} {method z ::F method}}

test oo-call-2.1 {class call introspection} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    info class call A x
} -cleanup {
    root destroy
} -result {{method x ::A method}}
test oo-call-2.2 {class call introspection} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
    }
    list [info class call A x] [info class call B x]
} -cleanup {
    root destroy
} -result {{{method x ::A method}} {{method x ::B method} {method x ::A method}}}
test oo-call-2.3 {class call introspection} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
    }
    oo::class create ::C {
	superclass A
	method x {} {}
    }
    oo::class create ::D {
	superclass C B
	method x {} {}
    }
    info class call D x
} -cleanup {
    root destroy
} -result {{method x ::D method} {method x ::C method} {method x ::B method} {method x ::A method}}
test oo-call-2.4 {class call introspection - mixin} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
    }
    oo::class create ::C {
	superclass A
	method x {} {}
    }
    oo::class create ::D {
	superclass C
	mixin B
	method x {} {}
    }
    info class call D x
} -cleanup {
    root destroy
} -result {{method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}}
test oo-call-2.5 {class call introspection - mixin + filter} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
	method y {} {}
	filter y
    }
    oo::class create ::C {
	superclass A
	method x {} {}
	method y {} {}
    }
    oo::class create ::D {
	superclass C
	mixin B
	method x {} {}
    }
    info class call D x
} -cleanup {
    root destroy
} -result {{filter y ::B method} {filter y ::C method} {method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}}
test oo-call-2.6 {class call introspection - mixin + filter + unknown} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
	method unknown {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
	method y {} {}
	filter y
    }
    oo::class create ::C {
	superclass A
	method x {} {}
	method y {} {}
    }
    oo::class create ::D {
	superclass C
	mixin B
	method x {} {}
	method unknown {} {}
    }
    info class call D z
} -cleanup {
    root destroy
} -result {{filter y ::B method} {filter y ::C method} {unknown unknown ::D method} {unknown unknown ::A method} {unknown unknown ::oo::object {core method: "unknown"}}}
test oo-call-2.7 {class call introspection - mixin + filter + unknown} -setup {
    oo::class create root
} -body {
    oo::class create ::A {
	superclass root
	method x {} {}
    }
    oo::class create ::B {
	superclass A
	method x {} {}
	filter x
    }
    info class call B x
} -cleanup {
    root destroy
} -result {{filter x ::B method} {filter x ::A method} {method x ::B method} {method x ::A method}}
test oo-call-2.8 {class call introspection - errors} -body {
    info class call
} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
test oo-call-2.9 {class call introspection - errors} -body {
    info class call a
} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
test oo-call-2.10 {class call introspection - errors} -body {
    info class call a b c
} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
test oo-call-2.11 {class call introspection - errors} -body {
    info class call notaclass x
} -returnCodes error -result {notaclass does not refer to an object}
test oo-call-2.12 {class call introspection - errors} -setup {
    oo::class create root
} -body {
    root create notaclass
    info class call notaclass x
} -returnCodes error -cleanup {
    root destroy
} -result {"notaclass" is not a class}
test oo-call-2.13 {class call introspection - memory leaks} -body {
    leaktest {
	info class call oo::class destroy
    }
} -constraints memory -result 0
test oo-call-2.14 {class call introspection - memory leaks} -body {
    leaktest {
	oo::class create leaktester { method foo {} {dummy} }
	[leaktester new] destroy
	list [info class call leaktester destroy] \
	    [info class call leaktester foo] \
	    [info class call leaktester bar] \
	    [leaktester destroy]
    }
} -constraints memory -result 0

test oo-call-3.1 {current call introspection} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	method x {} {lappend ::result [self call]}
    }
    oo::class create B {
	superclass A
	method x {} {lappend ::result [self call];next}
    }
    B create y
    oo::objdefine y method x {} {lappend ::result [self call];next}
    set ::result {}
    y x
} -cleanup {
    root destroy
} -result {{{{method x object method} {method x ::B method} {method x ::A method}} 0} {{{method x object method} {method x ::B method} {method x ::A method}} 1} {{{method x object method} {method x ::B method} {method x ::A method}} 2}}
test oo-call-3.2 {current call introspection} -setup {
    oo::class create root
} -constraints memory -body {
    oo::class create A {
	superclass root
	method x {} {self call}
    }
    oo::class create B {
	superclass A
	method x {} {self call;next}
    }
    B create y
    oo::objdefine y method x {} {self call;next}
    leaktest {
	y x
    }
} -cleanup {
    root destroy
} -result 0
test oo-call-3.3 {current call introspection: in constructors} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	constructor {} {lappend ::result [self call]}
    }
    oo::class create B {
	superclass A
	constructor {} {lappend ::result [self call]; next}
    }
    set ::result {}
    [B new] destroy
    return $::result
} -cleanup {
    root destroy
} -result {{{{method <constructor> ::B method} {method <constructor> ::A method}} 0} {{{method <constructor> ::B method} {method <constructor> ::A method}} 1}}
test oo-call-3.4 {current call introspection: in destructors} -setup {
    oo::class create root
} -body {
    oo::class create A {
	superclass root
	destructor {lappend ::result [self call]}
    }
    oo::class create B {
	superclass A
	destructor {lappend ::result [self call]; next}
    }
    set ::result {}
    [B new] destroy
    return $::result
} -cleanup {
    root destroy
} -result {{{{method <destructor> ::B method} {method <destructor> ::A method}} 0} {{{method <destructor> ::B method} {method <destructor> ::A method}} 1}}

# Contributed tests from aspect, related to [0f42ff7871]
#
# dkf's "Principles Leading to a Fix"
#
#   A method ought to work "the same" whether or not it has been overridden by
#   a subclass. A tailcalled command ought to have as parent stack the same
#   thing you'd get with uplevel 1. A subclass will often expect the
#   superclass's result to be the result that would be returned if the
#   subclass was not there.

# Common setup:
#	any invocation of bar should emit "abc\nhi\n" then return to its
#	caller
set testopts {
    -setup {
	oo::class create Parent
	oo::class create Foo {
	    superclass Parent
	    method bar {} {
		puts abc
		tailcall puts hi
		puts xyz
	    }
	}
	oo::class create Foo2 {
	    superclass Parent
	}
    }
    -cleanup {
	Parent destroy
    }
}

# these succeed, showing that without [next] the bug doesn't fire
test next-tailcall-simple-1 "trivial case with one method" {*}$testopts -body {
    [Foo create foo] bar
} -output [join {abc hi} \n]\n
test next-tailcall-simple-2 "my bar" {*}$testopts -body {
    oo::define Foo method baz {} {
	puts a
	my bar
	puts b
    }
    [Foo create foo] baz
} -output [join {a abc hi b} \n]\n
test next-tailcall-simple-3 "\[self\] bar" {*}$testopts -body {
    oo::define Foo method baz {} {
	puts a
	[self] bar
	puts b
    }
    [Foo create foo] baz
} -output [join {a abc hi b} \n]\n
test next-tailcall-simple-4 "foo bar" {*}$testopts -body {
    oo::define Foo method baz {} {
	puts a
	foo bar
	puts b
    }
    [Foo create foo] baz
} -output [join {a abc hi b} \n]\n

# everything from here on uses [next], and fails on 8.6.4 with compilation
test next-tailcall-superclass-1 "next superclass" {*}$testopts -body {
    oo::define Foo2 {
	superclass Foo
	method bar {} {
	    puts a
	    next
	    puts b
	}
    }
    [Foo2 create foo] bar
} -output [join {a abc hi b} \n]\n
test next-tailcall-superclass-2 "nextto superclass" {*}$testopts -body {
    oo::define Foo2 {
	superclass Foo
	method bar {} {
	    puts a
	    nextto Foo
	    puts b
	}
    }
    [Foo2 create foo] bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-mixin-1 "class mixin" {*}$testopts -body {
    oo::define Foo2 {
	method Bar {} {
	    puts a
	    next
	    puts b
	}
	filter Bar
    }
    oo::define Foo mixin Foo2
    Foo create foo
    foo bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-objmixin-1 "object mixin" {*}$testopts -body {
    oo::define Foo2 {
	method Bar {} {
	    puts a
	    next
	    puts b
	}
	filter Bar
    }
    Foo create foo
    oo::objdefine foo mixin Foo2
    foo bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-filter-1 "filter method" {*}$testopts -body {
    oo::define Foo method Filter {} {
	puts a
	next
	puts b
    }
    oo::define Foo filter Filter
    [Foo new] bar
} -output [join {a abc hi b} \n]\n

test next-tailcall-forward-1 "forward method" {*}$testopts -body {
    proc foobar {} {
	puts "abc"
	tailcall puts "hi"
	puts "xyz"
    }
    oo::define Foo forward foobar foobar
    oo::define Foo2 {
	superclass Foo
	method foobar {} {
	    puts a
	    next
	    puts b
	}
    }
    [Foo2 new] foobar
} -output [join {a abc hi b} \n]\n

test next-tailcall-constructor-1 "next in constructor" -body {
    oo::class create Foo {
	constructor {} {
	    puts abc
	    tailcall puts hi
	    puts xyz
	}
    }
    oo::class create Foo2 {
	superclass Foo
	constructor {} {
	    puts a
	    next
	    puts b
	}
    }
    list [Foo new] [Foo2 new]
    return ""
} -cleanup {
    Foo destroy
} -output [join {abc hi a abc hi b} \n]\n

test next-tailcall-destructor-1 "next in destructor" -body {
    oo::class create Foo {
	destructor {
	    puts abc
	    tailcall puts hi
	    puts xyz
	}
    }
    oo::class create Foo2 {
	superclass Foo
	destructor {
	    puts a
	    next
	    puts b
	}
    }
    Foo create foo
    Foo2 create foo2
    foo destroy
    foo2 destroy
} -output [join {abc hi a abc hi b} \n]\n -cleanup {
    Foo destroy
}

unset testopts

cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/ooUtil.test.

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
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
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
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



















































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# This file contains a collection of tests for functionality originally
# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
# the tests and generates output for errors. No output means no errors were
# found.
#
# Copyright (c) 2014-2016 Andreas Kupries
# Copyright (c) 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test ooUtil-1.1 {TIP 478: classmethod} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
        superclass ActiveRecord
    }
    Table find foo bar
} -cleanup {
    parent destroy
} -result {::Table called with arguments: foo bar}
test ooUtil-1.2 {TIP 478: classmethod in namespace} -setup {
    namespace eval ::testns {}
} -body {
    namespace eval ::testns {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
    }
    testns::Table find foo bar
} -cleanup {
    namespace delete ::testns
} -result {::testns::Table called with arguments: foo bar}
test ooUtil-1.3 {TIP 478: classmethod must not interfere with constructor signatures} -setup {
    oo::class create parent
} -body {
    oo::class create TestClass {
        superclass oo::class parent
        self method create {name ignore body} {
            next $name $body
        }
    }
    TestClass create okay {} {}
} -cleanup {
    parent destroy
} -result {::okay}
test ooUtil-1.4 {TIP 478: classmethod with several inheritance levels} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
        superclass ActiveRecord
    }
    oo::class create SubTable {
        superclass Table
    }
    SubTable find foo bar
} -cleanup {
    parent destroy
} -result {::SubTable called with arguments: foo bar}
test ooUtil-1.5 {TIP 478: classmethod and instances} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
	superclass ActiveRecord
    }
    set t [Table new]
    $t find 1 2 3
} -cleanup {
    parent destroy
} -result {::Table called with arguments: 1 2 3}
test ooUtil-1.6 {TIP 478: classmethod and instances} -setup {
    oo::class create parent
} -body {
    oo::class create ActiveRecord {
	superclass parent
        classmethod find args {
	    return "[self] called with arguments: $args"
	}
    }
    oo::class create Table {
	superclass ActiveRecord
	unexport find
    }
    set t [Table new]
    $t find 1 2 3
} -returnCodes error -cleanup {
    parent destroy
} -match glob -result {unknown method "find": must be *}
test ooUtil-1.7 {} -setup {
    oo::class create parent
} -body {
    oo::class create Foo {
	superclass parent
        classmethod bar {} {
            puts "This is in the class; self is [self]"
            my meee
        }
        classmethod meee {} {
            puts "This is meee"
        }
    }
    oo::class create Grill {
        superclass Foo
        classmethod meee {} {
            puts "This is meee 2"
        }
    }
    list [Foo bar] [Grill bar] [[Foo new] bar] [[Grill new] bar]
} -cleanup {
    parent destroy
} -result {{} {} {} {}} -output "This is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\nThis is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\n"
# Two tests to confirm that we correctly initialise the scripted part of TclOO
# in child interpreters. This is slightly tricky at the implementation level
# because we cannot count on either [source] or [open] being available.
test ooUtil-1.8 {TIP 478: classmethod in child interp} -setup {
    set childinterp [interp create]
} -body {
    $childinterp eval {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
	# This is confirming that this is not the parent interpreter
	list [Table find foo bar] [info globals childinterp]
    }
} -cleanup {
    interp delete $childinterp
} -result {{::Table called with arguments: foo bar} {}}
test ooUtil-1.9 {TIP 478: classmethod in safe child interp} -setup {
    set safeinterp [interp create -safe]
} -body {
    $safeinterp eval {
	oo::class create ActiveRecord {
	    classmethod find args {
		return "[self] called with arguments: $args"
	    }
	}
	oo::class create Table {
	    superclass ActiveRecord
	}
	# This is confirming that this is a (basic) safe interpreter
	list [Table find foo bar] [info commands source]
    }
} -cleanup {
    interp delete $safeinterp
} -result {{::Table called with arguments: foo bar} {}}

test ooUtil-2.1 {TIP 478: callback generation} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {} { return ok,[self] }
	method makeCall {} {
	    return [callback CallMe]
	}
    }
    c create ::context
    set cb [context makeCall]
    {*}$cb
} -cleanup {
    parent destroy
} -result {ok,::context}
test ooUtil-2.2 {TIP 478: callback generation} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
	method makeCall {b} {
	    return [callback CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    {*}$cb PQR
} -cleanup {
    parent destroy
} -result {ok,::context,123,a b c,PQR}
test ooUtil-2.3 {TIP 478: callback generation, alternate name} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {} { return ok,[self] }
	method makeCall {} {
	    return [mymethod CallMe]
	}
    }
    c create ::context
    set cb [context makeCall]
    {*}$cb
} -cleanup {
    parent destroy
} -result {ok,::context}
test ooUtil-2.4 {TIP 478: callback generation, alternate name} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
	method makeCall {b} {
	    return [mymethod CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    {*}$cb PQR
} -cleanup {
    parent destroy
} -result {ok,::context,123,a b c,PQR}
test ooUtil-2.5 {TIP 478: callbacks and method lifetime} -setup {
    oo::class create parent
} -body {
    oo::class create c {
	superclass parent
	method makeCall {b} {
	    return [callback CallMe 123 $b]
	}
    }
    c create ::context
    set cb [context makeCall "a b c"]
    set result [list [catch {{*}$cb PQR} msg] $msg]
    oo::objdefine context {
	method CallMe {a b c} { return ok,[self],$a,$b,$c }
    }
    lappend result [{*}$cb PQR]
} -cleanup {
    parent destroy
} -result {1 {unknown method "CallMe": must be <cloned>, destroy, eval, makeCall, unknown, variable or varname} {ok,::context,123,a b c,PQR}}
test ooUtil-2.6 {TIP 478: callback use case} -setup {
    oo::class create parent
    unset -nocomplain x
} -body {
    oo::class create c {
	superclass parent
	variable count
	constructor {var} {
	    set count 0
	    upvar 1 $var v
	    trace add variable v write [callback TraceCallback]
	}
	method count {} {return $count}
	method TraceCallback {name1 name2 op} {
	    incr count
	}
    }
    set o [c new x]
    for {set x 0} {$x < 5} {incr x} {}
    $o count
} -cleanup {
    unset -nocomplain x
    parent destroy
} -result 6

test ooUtil-3.1 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::foobar-3.1 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialise {
	    proc foobar-3.1 {} {return ok}
	}
	method calls {} {
	    list [catch foobar-3.1 msg] $msg \
		[namespace eval [info object namespace [self class]] foobar-3.1]
	}
    }
    [cls new] calls
} -cleanup {
    parent destroy
} -result {1 {invalid command name "foobar-3.1"} ok}
test ooUtil-3.2 {TIP 478: class variables} -setup {
    oo::class create parent
    catch {rename ::foobar-3.1 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialise {
	    variable x 123
	}
	method call {} {
	    classvariable x
	    incr x
	}
    }
    cls create a
    cls create b
    cls create c
    list [a call] [b call] [c call] [a call] [b call] [c call]
} -cleanup {
    parent destroy
} -result {124 125 126 127 128 129}
test ooUtil-3.3 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::foobar-3.3 {}}
} -body {
    oo::class create ::cls {
	superclass parent
	initialize {
	    proc foobar-3.3 {} {return ok}
	}
	method calls {} {
	    list [catch foobar-3.3 msg] $msg \
		[namespace eval [info object namespace [self class]] foobar-3.3]
	}
    }
    [cls new] calls
} -cleanup {
    parent destroy
} -result {1 {invalid command name "foobar-3.3"} ok}
test ooUtil-3.4 {TIP 478: class initialisation} -setup {
    oo::class create parent
    catch {rename ::appendToResultVar {}}
    proc ::appendToResultVar args {
	lappend ::result {*}$args
    }
    set result {}
} -body {
    trace add execution oo::define::initialise enter appendToResultVar
    oo::class create ::cls {
	superclass parent
	initialize {proc xyzzy {} {}}
    }
    return $result
} -cleanup {
    catch {
	trace remove execution oo::define::initialise enter appendToResultVar
    }
    rename ::appendToResultVar {}
    parent destroy
} -result {{initialize {proc xyzzy {} {}}} enter}
test ooUtil-3.5 {TIP 478: class initialisation} -body {
    oo::define oo::object {
	::list [::namespace which initialise] [::namespace which initialize] \
	     [::namespace origin initialise] [::namespace origin initialize]
    }
} -result {::oo::define::initialise ::oo::define::initialize ::oo::define::initialise ::oo::define::initialise}

test ooUtil-4.1 {TIP 478: singleton} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    set x [xyz new]
    set y [xyz new]
    set z [xyz new]
    set code [catch {$x destroy} msg]
    set p [xyz new]
    lappend code [catch {rename $x ""}]
    set q [xyz new]
    string map [list $x ONE $q TWO] [list {*}$code $x $y $z $p $q [xyz new]]
} -cleanup {
    parent destroy
} -result {1 0 ONE ONE ONE ONE TWO TWO}
test ooUtil-4.2 {TIP 478: singleton errors} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    [xyz new] destroy
} -returnCodes error -cleanup {
    parent destroy
} -result {may not destroy a singleton object}
test ooUtil-4.3 {TIP 478: singleton errors} -setup {
    oo::class create parent
} -body {
    oo::singleton create xyz {
	superclass parent
    }
    oo::copy [xyz new]
} -returnCodes error -cleanup {
    parent destroy
} -result {may not clone a singleton object}


test ooUtil-5.1 {TIP 478: abstract} -setup {
    oo::class create parent
} -body {
    oo::abstract create xyz {
	superclass parent
	method foo {} {return 123}
    }
    oo::class create pqr {
	superclass xyz
	method bar {} {return 456}
    }
    set codes [list [catch {xyz new}] [catch {xyz create x}] [catch {xyz createWithNamespace x y}]]
    set x [pqr new]
    set y [pqr create ::y]
    lappend codes [$x foo] [$x bar] $y
} -cleanup {
    parent destroy
} -result {1 1 1 123 456 ::y}

test ooUtil-6.1 {TIP 478: classvarable} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	initialise {
	    variable x 1 y 2
	}
	method a {} {
	    classvariable x
	    incr x
	}
	method b {} {
	    classvariable y
	    incr y
	}
	method c {} {
	    classvariable x y
	    list $x $y
	}
    }
    set p [xyz new]
    set q [xyz new]
    set result [list [$p c] [$q c]]
    $p a
    $q b
    lappend result [[xyz new] c]
} -cleanup {
    parent destroy
} -result {{1 2} {1 2} {2 3}}
test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable x(1)
	    incr x(1)
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
test ooUtil-6.3 {TIP 478: classvarable error case} -setup {
    oo::class create parent
} -body {
    oo::class create xyz {
	superclass parent
	method a {} {
	    classvariable ::x
	    incr x
	}
    }
    set p [xyz new]
    set q [xyz new]
    list [$p a] [$q a]
} -returnCodes error -cleanup {
    parent destroy
} -result {bad variable name "::x": can't create a local variable with a namespace separator in it}

test ooUtil-7.1 {TIP 478: link calling pattern} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method foo {} {return "in foo of [self]"}
	method Bar {} {return "in bar of [self]"}
	method Grill {} {return "in grill of [self]"}
	export eval
	constructor {} {
	    link foo
	    link {bar Bar} {grill Grill}
	}
    }
    cls create o
    o eval {list [foo] [bar] [grill]}
} -cleanup {
    parent destroy
} -result {{in foo of ::o} {in bar of ::o} {in grill of ::o}}
test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup {
    oo::class create parent
} -body {
    oo::class create cls {
	superclass parent
	method foo {} {return "in foo of [self]"}
	constructor {cmd} {
	    link [list ::$cmd foo]
	}
    }
    cls create o pqr
    list [o foo] [pqr] [rename [info object namespace o]::my {}] [catch pqr msg] $msg
} -cleanup {
    parent destroy
} -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}}

# Tests that verify issues detected with the tcllib version of the code
test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup {
    oo::class create animal {}
    namespace eval ::ooutiltest {
	oo::class create pet { superclass animal }
    }
} -body {
    namespace eval ::ooutiltest {
	oo::class create dog { superclass pet }
    }
} -cleanup {
    namespace delete ooutiltest
    rename animal {}
} -result {::ooutiltest::dog}
test ooUtil-tcllib-ticket-fe7a0e0a3a {classmethod must not interfere with constructor signatures} -setup {
    oo::class create TestClass {
        superclass oo::class
        self method create {name ignore body} {
            next $name $body
        }
    }
} -body {
    TestClass create okay {} {}
} -cleanup {
    rename TestClass {}
} -result {::okay}

cleanupTests
return

# Local Variables:
# fill-column: 78
# mode: tcl
# End:

Changes to tests/opt.test.

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
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













-
-
+
+




-
+







# Package covered:  opt1.0/optparse.tcl
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# the package we are going to test
package require opt 0.4.8
package require opt 0.4.1

# we are using implementation specifics to test the package


#### functions tests #####

set n $::tcl::OptDescN
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
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







-
+















-
+







    catch {::tcl::OptKeyDelete $n}
    list [catch {::tcl::OptParse {{-foo}} {-blah}}] \
	    [info exists ::tcl::OptDesc($n)]
} {1 0}

test opt-4.1 {OptProc} {
    ::tcl::OptProc optTest {} {}
    optTest
    optTest ;
    ::tcl::OptKeyDelete optTest
} {}

test opt-5.1 {OptProcArgGiven} {
    ::tcl::OptProc optTest {{-foo}} {
	if {[::tcl::OptProcArgGiven "-foo"]} {
	    return 1
	} else {
	    return 0
	}
    }
    list [optTest] [optTest -f] [optTest -F] [optTest -fOO]
} {0 1 1 1}

test opt-6.1 {OptKeyParse} {
    ::tcl::OptKeyRegister {} test
    ::tcl::OptKeyRegister {} test;
    list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
} {1 {Usage information:
    Var/FlagName Type Value Help
    ------------ ---- ----- ----
    (-help                  gives this help)}}

test opt-7.1 {OptCheckType} {

Changes to tests/package.test.

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

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
-
+



-
-
+
+

-

-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-
+







# This file contains tests for the package and ::pkg::* commands.
# This file contains tests for the ::package::* commands.
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2011 Donal K. Fellows
#
# All rights reserved.

# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Do all this in a child interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoChildInterpreter $i {*}$argv
catch [list load {} Tcltest $i]
interp eval $i {
namespace import -force ::tcltest::*
    namespace import -force ::tcltest::*
#package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""

}
testConstraint testpreferstable [llength [info commands testpreferstable]]

test package-1.1 {pkg::create gives error on insufficient args} -body {
    ::pkg::create

test package-1.1 {pkg::create gives error on insufficient args} {
    catch {::pkg::create}
} -returnCodes error -match glob -result {wrong # args: should be "*"}
test package-1.2 {pkg::create gives error on bad args} -body {
    ::pkg::create -foo bar -bar baz -baz boo
} 1
test package-1.2 {pkg::create gives error on bad args} {
    catch {::pkg::create -foo bar -bar baz -baz boo}
} -returnCodes error -match glob -result {unknown option "bar": *}
test package-1.3 {pkg::create gives error on no value given} -body {
    ::pkg::create -name foo -version 1.0 -source test.tcl -load
} 1
test package-1.3 {pkg::create gives error on no value given} {
    catch {::pkg::create -name foo -version 1.0 -source test.tcl -load}
} -returnCodes error -match glob -result {value for "-load" missing: *}
test package-1.4 {pkg::create gives error on no name given} -body {
    ::pkg::create -version 1.0 -source test.tcl -load foo.so
} 1
test package-1.4 {pkg::create gives error on no name given} {
    catch {::pkg::create -version 1.0 -source test.tcl -load foo.so}
} -returnCodes error -match glob -result {value for "-name" missing: *}
test package-1.5 {pkg::create gives error on no version given} -body {
    ::pkg::create -name foo -source test.tcl -load foo.so
} 1
test package-1.5 {pkg::create gives error on no version given} {
    catch {::pkg::create -name foo -source test.tcl -load foo.so}
} -returnCodes error -match glob -result {value for "-version" missing: *}
test package-1.6 {pkg::create gives error on no source or load options} -body {
    ::pkg::create -name foo -version 1.0 -version 2.0
} 1
test package-1.6 {pkg::create gives error on no source or load options} {
    catch {::pkg::create -name foo -version 1.0 -version 2.0}
} -returnCodes error -result {at least one of -load and -source must be given}
} 1
test package-1.7 {pkg::create gives correct output for 1 direct source} {
    ::pkg::create -name foo -version 1.0 -source test.tcl
} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]}
test package-1.8 {pkg::create gives correct output for 2 direct sources} {
    ::pkg::create -name foo -version 1.0 -source test.tcl -source test2.tcl
} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list source [file join $dir test2.tcl]]}
test package-1.9 {pkg::create gives correct output for 1 direct load} {
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
61
62
63
64
65
66
67





















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































68
69












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
    ::pkg::create -name foo -version 1.0 -source test.tcl -load test2.so
} {package ifneeded foo 1.0 [list load [file join $dir test2.so]]\n[list source [file join $dir test.tcl]]}
test package-1.16 {pkg::create gives correct output for 1 direct, 1 lazy} {
    ::pkg::create -name foo -version 1.0 -source test.tcl \
	    -source {test2.tcl {foo bar}}
} {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list tclPkgSetup $dir foo 1.0 {{test2.tcl source {foo bar}}}]}

test package-2.1 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
} {}
test package-2.2 {Tcl_PkgProvide procedure} -returnCodes error -setup {
    package forget t
} -body {
    package provide t 2.3
    package provide t 2.2
} -result {conflicting versions provided for package "t": 2.3, then 2.2}
test package-2.3 {Tcl_PkgProvide procedure} -returnCodes error -setup {
    package forget t
} -body {
    package provide t 2.3
    package provide t 2.4
} -result {conflicting versions provided for package "t": 2.3, then 2.4}
test package-2.4 {Tcl_PkgProvide procedure} -returnCodes error -setup {
    package forget t
} -body {
    package provide t 2.3
    package provide t 3.3
} -result {conflicting versions provided for package "t": 2.3, then 3.3}
test package-2.5 {Tcl_PkgProvide procedure} -setup {
    package forget t
} -body {
    package provide t 2.3
    package provide t 2.3
} -result {}
test package-2.6 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3a1
} {}

set n 0
foreach v {
    2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
    2b4a1 2b3b2
} {
    test package-2.7.$n {Tcl_PkgProvide procedure} -setup {
	package forget t
    } -returnCodes error -body "
	package provide t $v
    " -result "expected version number but got \"$v\""
    incr n
}

test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
} -result {3.4}
test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
} -result {3.5}
test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {3.5 2.1 2.3} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t 2.2
    set x
} -result {2.3}
test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require -exact t 2.3
    set x
} -result {2.3}
test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t 2.1
    set x
} -result {2.4}
test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package require t 2.5
} -result {can't find package t 2.5}
test package-3.7 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package require t 4.1
} -result {can't find package t 4.1}
test package-3.8 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package require -exact t 1.3
} -result {can't find package t exactly 1.3}
test package-3.9 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
    package forget t
} -returnCodes error -body {
    package unknown {}
    package require t
} -result {can't find package t}
test package-3.10 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
    package forget t
} -body {
    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
    list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {ifneeded test
    while executing
"error "ifneeded test""
    ("package ifneeded*" script)
    invoked from within
"package require t 2.1"}}
test package-3.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -setup {
    package forget t
    set x xxx
} -body {
    package ifneeded t 2.1 "set x invoked"
    list [catch {package require t 2.1} msg] $msg $x
} -match glob -result {1 * invoked}
test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup {
    package forget t
    set x xxx
} -body {
    package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
    package require t 1.2
    set x
} -result {1.2}
test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
    package forget t
    set x xxx
} -body {
    proc pkgUnknown args {
	# args = name requirement
	# requirement = v-v (for exact version)
	global x
	set x $args
	package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
    }
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    package require -exact t 1.5
    set x
} -cleanup {
    package unknown {}
} -result {t 1.5-1.5}
test package-3.14 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
    package forget t
    set x xxx
} -body {
    proc pkgUnknown args {
	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
    }
    package unknown pkgUnknown
    list [package require t] $x
} -cleanup {
    package unknown {}
} -result {1.2 loaded}
test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
    package forget {a b}
    package unknown pkgUnknown
    set x xxx
} -body {
    proc pkgUnknown args {
	global x
	set x $args
	package provide [lindex $args 0] 2.0
    }
    package require {a b}
    set x
} -cleanup {
    package unknown {}
} -result {{a b} 0-}
test package-3.16 {Tcl_PkgRequire procedure, "package unknown" error} -setup {
    package forget t
} -body {
    proc pkgUnknown args {
	error "testing package unknown"
    }
    package unknown pkgUnknown
    list [catch {package require t} msg] $msg $::errorInfo
} -cleanup {
    package unknown {}
} -result {1 {testing package unknown} {testing package unknown
    while executing
"error "testing package unknown""
    (procedure "pkgUnknown" line 2)
    invoked from within
"pkgUnknown t 0-"
    ("package unknown" script)
    invoked from within
"package require t"}}
test package-3.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} -setup {
    package forget t
    set x xxx
} -body {
    proc pkgUnknown args {
	global x
	set x $args
    }
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    list [catch {package require -exact t 1.5} msg] $msg $x
} -cleanup {
    package unknown {}
} -result {1 {can't find package t exactly 1.5} {t 1.5-1.5}}
test package-3.18 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -body {
    package provide t 2.3
    package require t
} -result {2.3}
test package-3.19 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -body {
    package provide t 2.3
    package require t 2.1
} -result {2.3}
test package-3.20 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -body {
    package provide t 2.3
    package require t 2.3
} -result {2.3}
test package-3.21 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -returnCodes error -body {
    package provide t 2.3
    package require t 2.4
} -result {version conflict for package "t": have 2.3, need 2.4}
test package-3.22 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -returnCodes error -body {
    package provide t 2.3
    package require t 1.2
} -result {version conflict for package "t": have 2.3, need 1.2}
test package-3.23 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -body {
    package provide t 2.3
    package require -exact t 2.3
} -result {2.3}
test package-3.24 {Tcl_PkgRequire procedure, version checks} -setup {
    package forget t
} -returnCodes error -body {
    package provide t 2.3
    package require -exact t 2.2
} -result {version conflict for package "t": have 2.3, need exactly 2.2}
test package-3.25 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
    package forget t
} -body {
    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
    list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {EI
    ("package ifneeded*" script)
    invoked from within
"package require t 2.1"}}
test package-3.26 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
    package forget t
} -body {
    package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
    list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {EI
    ("foreach" body line 1)
    invoked from within
"foreach x 1 {error "ifneeded test" EI}"
    ("package ifneeded*" script)
    invoked from within
"package require t 2.1"}}
test package-3.27 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package require foo 1}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {circular package dependency:*}
test package-3.28 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package require foo 2}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {circular package dependency:*}
test package-3.29 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
    package forget bar
} -body {
    package ifneeded foo 1 {package require bar 1; package provide foo 1}
    package ifneeded bar 1 {package require foo 1; package provide bar 1}
    package require foo 1
} -cleanup {
    package forget foo
    package forget bar
} -returnCodes error -match glob -result {circular package dependency:*}
test package-3.30 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
    package forget bar
} -body {
    package ifneeded foo 1 {package require bar 1; package provide foo 1}
    package ifneeded foo 2 {package provide foo 2}
    package ifneeded bar 1 {package require foo 2; package provide bar 1}
    package require foo 1
} -cleanup {
    package forget foo
    package forget bar
} -returnCodes error -match glob -result {circular package dependency:*}
test package-3.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 1; error foo}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result foo
test package-3.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 1; error foo}
    catch {package require foo 1}
    package provide foo
} -cleanup {
    package forget foo
} -result {}
test package-3.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 2}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test package-3.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 1.1}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test package-3.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1.1 {package provide foo 1}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test package-3.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1.1 {package provide foo 1}
    package require foo 1.1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test package-3.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test package-3.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {break}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test package-3.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {continue}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test package-3.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {return}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test package-3.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {return -level 0 -code 10}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test package-3.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {package provide foo 2 ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result *
test package-3.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {break ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test package-3.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {continue ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test package-3.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {return ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test package-3.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {return -level 0 -code 10 ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
    package provide demo 1.2.3
} -body {
    package require -exact demo 1.2
} -returnCodes error -cleanup {
    package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
    interp create child
    load {} Tcltest child
    child eval {
    testpreferstable
    package forget t
    set x xxx
    }
} -body {
    child eval {
    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
    }
} -cleanup {
    interp delete child
} -result {3.4}
test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.2 1.3a2 1.3} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
} -result {1.3}
test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup {
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.2 1.3 1.3a2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
} -result {1.3}
test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
    testpreferstable
    package forget t
    set x xxx
} -body {
    foreach i {1.2b1 1.1} {
        package ifneeded t $i "set x $i; package provide t $i"
    }
    package require t
    set x
} -result {1.1}
test package-3.54 {Tcl_PkgRequire procedure, coroutine support} -setup {
    package forget t
} -body {
    coroutine coro1 apply {{} {
	package ifneeded t 2.1 {
	    yield
	    package provide t 2.1
	}
	package require t 2.1
    }}
    list [catch {coro1} msg] $msg
} -match glob -result {0 2.1}


test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
    package
} -result {wrong # args: should be "package option ?arg ...?"}
test package-4.2 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package names
    }
} -cleanup {
    interp delete child
} -result {}
test package-4.3 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package forget foo
    }
} -cleanup {
    interp delete child
} -result {}
test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    set result {}
    }
} -body {
    child eval {
    package ifneeded t 1.1 {first script}
    package ifneeded t 2.3 {second script}
    package ifneeded x 1.4 {x's script}
    lappend result [lsort [package names]] [package versions t]
    package forget t
    lappend result [lsort [package names]] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{t x} {1.1 2.3} x {}}
test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded a 1.1 {first script}
    package ifneeded b 2.3 {second script}
    package ifneeded c 1.4 {third script}
    package forget
    set result [list [lsort [package names]]]
    package forget a c
    lappend result [lsort [package names]]
    }
} -cleanup {
    interp delete child
} -result {{a b c} b}
test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
    # Test for Bug 415273
    package ifneeded a 1 "I should have been forgotten"
    package forget no-such-package a
    package ifneeded a 1
} -cleanup {
    package forget a
} -result {}
test package-4.6 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded a
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded a b c d
} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
    package ifneeded t xyz
} -returnCodes error -result {expected version number but got "xyz"}
test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    list [package ifneeded foo 1.1] [package names]
    }
} -cleanup {
    interp delete child
} -result {{} {}}
test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    list [package names] [package ifneeded t 1.4] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {t {script for t 1.4} 1.4}
test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    list [package ifneeded t 1.5] [package names] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{} t 1.4}
test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.4 "second script for t 1.4"
    list [package ifneeded t 1.4] [package names] [package versions t]
    }
} -cleanup {
    interp delete child
} -result {{second script for t 1.4} t 1.4}
test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
    package forget t
} -body {
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.2 "second script"
    package ifneeded t 3.1 "last script"
    list [package ifneeded t 1.2] [package versions t]
} -result {{second script} {1.4 1.2 3.1}}
test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
    package names a
} -returnCodes error -result {wrong # args: should be "package names"}
test package-4.15 {Tcl_PackageCmd procedure, "names" option} -setup {
    interp create child
} -body {
    child eval {
    package forget {*}[package names]
    package names
    }
} -cleanup {
    interp delete child
} -result {}
test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {
    interp create child
    child eval {
    package forget {*}[package names]
    }
} -body {
    child eval {
    package ifneeded x 1.2 {dummy}
    package provide x 1.3
    package provide y 2.4
    catch {package require z 47.16}
    lsort [package names]
    }
} -cleanup {
    interp delete child
} -result {x y}
test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body {
    package provide a b c
} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
test package-4.19 {Tcl_PackageCmd procedure, "provide" option} -setup {
    package forget t
} -body {
    package provide t
} -result {}
test package-4.20 {Tcl_PackageCmd procedure, "provide" option} -setup {
    package forget t
} -body {
    package provide t 2.3
    package provide t
} -result {2.3}
test package-4.21 {Tcl_PackageCmd procedure, "provide" option} -setup {
    package forget t
} -returnCodes error -body {
    package provide t a.b
} -result {expected version number but got "a.b"}
test package-4.22 {Tcl_PackageCmd procedure, "require" option} -returnCodes error -body {
    package require
} -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
test package-4.24 {Tcl_PackageCmd procedure, "require" option} -body {
    package require -exact a b c
    # Exact syntax: -exact name version
    #              name ?requirement ...?
} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
test package-4.26 {Tcl_PackageCmd procedure, "require" option} -body {
    package require x a.b
} -returnCodes error -result {expected version number but got "a.b"}
test package-4.27 {Tcl_PackageCmd procedure, "require" option} -body {
    package require -exact x a.b
} -returnCodes error -result {expected version number but got "a.b"}
test package-4.28 {Tcl_PackageCmd procedure, "require" option} -body {
    package require -exact x
} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
test package-4.29 {Tcl_PackageCmd procedure, "require" option} -body {
    package require -exact
} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
test package-4.30 {Tcl_PackageCmd procedure, "require" option} -setup {
    package forget t
} -body {
    package provide t 2.3
    package require t 2.1
} -result {2.3}
test package-4.31 {Tcl_PackageCmd procedure, "require" option} -setup {
    package forget t
} -body {
    package require t
} -returnCodes error -result {can't find package t}
test package-4.32 {Tcl_PackageCmd procedure, "require" option} -setup {
    package forget t
} -body {
    package ifneeded t 2.3 "error {synthetic error}"
    package require t 2.3
} -returnCodes error -result {synthetic error}
test package-4.33 {Tcl_PackageCmd procedure, "unknown" option} -body {
    package unknown a b
} -returnCodes error -result {wrong # args: should be "package unknown ?command?"}
test package-4.34 {Tcl_PackageCmd procedure, "unknown" option} {
    package unknown "test script"
    package unknown
} {test script}
test package-4.35 {Tcl_PackageCmd procedure, "unknown" option} {
    package unknown "test script"
    package unknown {}
    package unknown
} {}
test package-4.36 {Tcl_PackageCmd procedure, "vcompare" option} -body {
    package vcompare a
} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"}
test package-4.37 {Tcl_PackageCmd procedure, "vcompare" option} -body {
    package vcompare a b c
} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"}
test package-4.38 {Tcl_PackageCmd procedure, "vcompare" option} -body {
    package vcompare x.y 3.4
} -returnCodes error -result {expected version number but got "x.y"}
test package-4.39 {Tcl_PackageCmd procedure, "vcompare" option} -body {
    package vcompare 2.1 a.b
} -returnCodes error -result {expected version number but got "a.b"}
test package-4.40 {Tcl_PackageCmd procedure, "vcompare" option} {
    package vc 2.1 2.3
} {-1}
test package-4.41 {Tcl_PackageCmd procedure, "vcompare" option} {
    package vc 2.2.4 2.2.4
} {0}
test package-4.42 {Tcl_PackageCmd procedure, "versions" option} -body {
    package versions
} -returnCodes error -result {wrong # args: should be "package versions package"}
test package-4.43 {Tcl_PackageCmd procedure, "versions" option} -body {
    package versions a b
} -returnCodes error -result {wrong # args: should be "package versions package"}
test package-4.44 {Tcl_PackageCmd procedure, "versions" option} -body {
    package forget t
    package versions t
} -result {}
test package-4.45 {Tcl_PackageCmd procedure, "versions" option} -setup {
    package forget t
} -body {
    package provide t 2.3
    package versions t
} -result {}
test package-4.46 {Tcl_PackageCmd procedure, "versions" option} -setup {
    package forget t
} -body {
    package ifneeded t 2.3 x
    package ifneeded t 2.4 y
    package versions t
} -result {2.3 2.4}
test package-4.47 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vsatisfies a
} -returnCodes error -result {wrong # args: should be "package vsatisfies version ?requirement ...?"}
test package-4.49 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vsatisfies x.y 3.4
} -returnCodes error -result {expected version number but got "x.y"}
test package-4.50 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vcompare 2.1 a.b
} -returnCodes error -result {expected version number but got "a.b"}
test package-4.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    package vs 2.3 2.1
} {1}
test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    package vs 2.3 1.2
} {0}
test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body {
    package foo
} -returnCodes error -result {bad option "foo": must be files, forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vsatisfies 2.1 2.1-3.2-4.5
} -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"}
test package-4.55 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vsatisfies 2.1 3.2-x.y
} -returnCodes error -result {expected version number but got "x.y"}
test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
    package vsatisfies 2.1 x.y-3.2
} -returnCodes error -result {expected version number but got "x.y"}

# No tests for FindPackage; can't think up anything detectable errors.

test package-5.1 {TclFreePackageInfo procedure} {
    interp create child
    child eval {
	package ifneeded t 2.3 x
	package ifneeded t 2.4 y
	package ifneeded x 3.1 z
	package provide q 4.3
	package unknown "will this get freed?"
    }
    interp delete child
} {}
test package-5.2 {TclFreePackageInfo procedure} -body {
    interp create foo
    foo eval {
	package ifneeded t 2.3 x
	package ifneeded t 2.4 y
	package ifneeded x 3.1 z
	package provide q 4.3
    }
    foo alias z kill
    proc kill {} {
	interp delete foo
    }
    foo eval package require x 3.1
} -returnCodes error -match glob -result *

test package-6.1 {CheckVersion procedure} {
    package vcompare 1 2.1
} -1
test package-6.2 {CheckVersion procedure} -body {
    package vcompare .1 2.1
} -returnCodes error -result {expected version number but got ".1"}
test package-6.3 {CheckVersion procedure} -body {
    package vcompare 111.2a.3 2.1
} -returnCodes error -result {expected version number but got "111.2a.3"}
test package-6.4 {CheckVersion procedure} -body {
    package vcompare 1.2.3. 2.1
} -returnCodes error -result {expected version number but got "1.2.3."}
test package-6.5 {CheckVersion procedure} -body {
    package vcompare 1.2..3 2.1
} -returnCodes error -result {expected version number but got "1.2..3"}

test package-7.1 {ComparePkgVersions procedure} {
    package vcompare 1.23 1.22
} {1}
test package-7.2 {ComparePkgVersions procedure} {
    package vcompare 1.22.1.2.3 1.22.1.2.3
} {0}
test package-7.3 {ComparePkgVersions procedure} {
    package vcompare 1.21 1.22
} {-1}
test package-7.4 {ComparePkgVersions procedure} {
    package vcompare 1.21 1.21.2
} {-1}
test package-7.5 {ComparePkgVersions procedure} {
    package vcompare 1.21.1 1.21
} {1}
test package-7.6 {ComparePkgVersions procedure} {
    package vsatisfies 1.21.1 1.21
} {1}
test package-7.7 {ComparePkgVersions procedure} {
    package vsatisfies 2.22.3 1.21
} {0}
test package-7.8 {ComparePkgVersions procedure} {
    package vsatisfies 1 1
} {1}
test package-7.9 {ComparePkgVersions procedure} {
    package vsatisfies 2 1
} {0}

test package-8.1 {Tcl_PkgPresent procedure, any version} -setup {
    package forget t
} -body {
    package provide t 2.4
    package present t
} -result {2.4}
test package-8.2 {Tcl_PkgPresent procedure, correct version} -setup {
    package forget t
} -body {
    package provide t 2.4
    package present t 2.4
} -result {2.4}
test package-8.3 {Tcl_PkgPresent procedure, satisfying version} -setup {
    package forget t
} -body {
    package provide t 2.4
    package present t 2.0
} -result {2.4}
test package-8.4 {Tcl_PkgPresent procedure, not satisfying version} -setup {
    package forget t
} -returnCodes error -body {
    package provide t 2.4
    package present t 2.6
} -result {version conflict for package "t": have 2.4, need 2.6}
test package-8.5 {Tcl_PkgPresent procedure, not satisfying version} -setup {
    package forget t
} -returnCodes error -body {
    package provide t 2.4
    package present t 1.0
} -result {version conflict for package "t": have 2.4, need 1.0}
test package-8.6 {Tcl_PkgPresent procedure, exact version} -setup {
    package forget t
} -body {
    package provide t 2.4
    package present -exact t 2.4
} -result {2.4}
test package-8.7 {Tcl_PkgPresent procedure, not exact version} -setup {
    package forget t
} -returnCodes error -body {
    package provide t 2.4
    package present -exact t 2.3
} -result {version conflict for package "t": have 2.4, need exactly 2.3}
test package-8.8 {Tcl_PkgPresent procedure, unknown package} -body {
    package forget t
    package present t
} -returnCodes error -result {package t is not present}
test package-8.9 {Tcl_PkgPresent procedure, unknown package} -body {
    package forget t
    package present t 2.4
} -returnCodes error -result {package t 2.4 is not present}
test package-8.10 {Tcl_PkgPresent procedure, unknown package} -body {
    package forget t
    package present -exact t 2.4
} -returnCodes error -result {package t 2.4 is not present}
test package-8.11 {Tcl_PackageCmd procedure, "present" option} -body {
    package present
} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
test package-8.12 {Tcl_PackageCmd procedure, "present" option} -body {
    package present a b c
} -returnCodes error -result {expected version number but got "b"}
test package-8.13 {Tcl_PackageCmd procedure, "present" option} -body {
    package present -exact a b c
} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
test package-8.14 {Tcl_PackageCmd procedure, "present" option} -body {
    package present -bs a b
} -returnCodes error -result {expected version number but got "a"}
test package-8.15 {Tcl_PackageCmd procedure, "present" option} -body {
    package present x a.b
} -returnCodes error -result {expected version number but got "a.b"}
test package-8.16 {Tcl_PackageCmd procedure, "present" option} -body {
    package present -exact x a.b
} -returnCodes error -result {expected version number but got "a.b"}
test package-8.17 {Tcl_PackageCmd procedure, "present" option} -body {
    package present -exact x
} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
test package-8.18 {Tcl_PackageCmd procedure, "present" option} -body {
    package present -exact
} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}

set n 0
foreach {r p vs vc} {
    8.5a0    8.5a5    1          -1
    8.5a0    8.5b1    1          -1
    8.5a0    8.5.1    1          -1
    8.5a0    8.6a0    1          -1
    8.5a0    8.6b0    1          -1
    8.5a0    8.6.0    1          -1
    8.5a6    8.5a5    0          1
    8.5a6    8.5b1    1          -1
    8.5a6    8.5.1    1          -1
    8.5a6    8.6a0    1          -1
    8.5a6    8.6b0    1          -1
    8.5a6    8.6.0    1          -1
    8.5b0    8.5a5    0          1
    8.5b0    8.5b1    1          -1
    8.5b0    8.5.1    1          -1
    8.5b0    8.6a0    1          -1
    8.5b0    8.6b0    1          -1
    8.5b0    8.6.0    1          -1
    8.5b2    8.5a5    0          1
    8.5b2    8.5b1    0          1
    8.5b2    8.5.1    1          -1
    8.5b2    8.6a0    1          -1
    8.5b2    8.6b0    1          -1
    8.5b2    8.6.0    1          -1
    8.5      8.5a5    1          1
    8.5      8.5b1    1          1
    8.5      8.5.1    1          -1
    8.5      8.6a0    1          -1
    8.5      8.6b0    1          -1
    8.5      8.6.0    1          -1
    8.5.0    8.5a5    0          1
    8.5.0    8.5b1    0          1
    8.5.0    8.5.1    1          -1
    8.5.0    8.6a0    1          -1
    8.5.0    8.6b0    1          -1
    8.5.0    8.6.0    1          -1
    10       8        0          1
    8        10       0          -1
    0.0.1.2  0.1.2    1          -1
} {
    test package-9.$n {package vsatisfies} {
	package vsatisfies $p $r
    } $vs
    test package-10.$n {package vcompare} {
	package vcompare $r $p
    } $vc
    incr n
}

test package-11.0.0 {package vcompare at 32bit boundary} {
    package vcompare [expr {1<<31}] [expr {(1<<31)-1}]
} 1

# Note: It is correct that the result of the very first test, i.e. "5.0 5.0a0"
# is 1, i.e. that version 5.0a0 satisfies a 5.0 requirement.

# The requirement "5.0" internally translates first to "5.0-6", and then to
# its final form of "5.0a0-6a0". These translations are explicitly specified
# by the TIP (Search for "padded/extended internally with 'a0'"). This was
# done intentionally for exactly the tested case, that an alpha package can
# satisfy a requirement for the regular package. An example would be a package
# FOO requiring Tcl 8.X for its operation. It can be used with Tcl 8.Xa0.
# Without our translation that would not be possible.

set n 0
foreach {required provided satisfied} {
    5.0 5.0a0 1
    5.0a0 5.0 1

    8.5a0-   8.5a5    1
    8.5a0-   8.5b1    1
    8.5a0-   8.5.1    1
    8.5a0-   8.6a0    1
    8.5a0-   8.6b0    1
    8.5a0-   8.6.0    1
    8.5a6-   8.5a5    0
    8.5a6-   8.5b1    1
    8.5a6-   8.5.1    1
    8.5a6-   8.6a0    1
    8.5a6-   8.6b0    1
    8.5a6-   8.6.0    1
    8.5b0-   8.5a5    0
    8.5b0-   8.5b1    1
    8.5b0-   8.5.1    1
    8.5b0-   8.6a0    1
    8.5b0-   8.6b0    1
    8.5b0-   8.6.0    1
    8.5b2-   8.5a5    0
    8.5b2-   8.5b1    0
    8.5b2-   8.5.1    1
    8.5b2-   8.6a0    1
    8.5b2-   8.6b0    1
    8.5b2-   8.6.0    1
    8.5-     8.5a5    1
    8.5-     8.5b1    1
    8.5-     8.5.1    1
    8.5-     8.6a0    1
    8.5-     8.6b0    1
    8.5-     8.6.0    1
    8.5.0-   8.5a5    0
    8.5.0-   8.5b1    0
    8.5.0-   8.5.1    1
    8.5.0-   8.6a0    1
    8.5.0-   8.6b0    1
    8.5.0-   8.6.0    1
    8.5a0-7  8.5a5    0
    8.5a0-7  8.5b1    0
    8.5a0-7  8.5.1    0
    8.5a0-7  8.6a0    0
    8.5a0-7  8.6b0    0
    8.5a0-7  8.6.0    0
    8.5a6-7  8.5a5    0
    8.5a6-7  8.5b1    0
    8.5a6-7  8.5.1    0
    8.5a6-7  8.6a0    0
    8.5a6-7  8.6b0    0
    8.5a6-7  8.6.0    0
    8.5b0-7  8.5a5    0
    8.5b0-7  8.5b1    0
    8.5b0-7  8.5.1    0
    8.5b0-7  8.6a0    0
    8.5b0-7  8.6b0    0
    8.5b0-7  8.6.0    0
    8.5b2-7  8.5a5    0
    8.5b2-7  8.5b1    0
    8.5b2-7  8.5.1    0
    8.5b2-7  8.6a0    0
    8.5b2-7  8.6b0    0
    8.5b2-7  8.6.0    0
    8.5-7    8.5a5    0
    8.5-7    8.5b1    0
    8.5-7    8.5.1    0
    8.5-7    8.6a0    0
    8.5-7    8.6b0    0
    8.5-7    8.6.0    0
    8.5.0-7  8.5a5    0
    8.5.0-7  8.5b1    0
    8.5.0-7  8.5.1    0
    8.5.0-7  8.6a0    0
    8.5.0-7  8.6b0    0
    8.5.0-7  8.6.0    0
    8.5a0-8.6.1 8.5a5    1
    8.5a0-8.6.1 8.5b1    1
    8.5a0-8.6.1 8.5.1    1
    8.5a0-8.6.1 8.6a0    1
    8.5a0-8.6.1 8.6b0    1
    8.5a0-8.6.1 8.6.0    1
    8.5a6-8.6.1 8.5a5    0
    8.5a6-8.6.1 8.5b1    1
    8.5a6-8.6.1 8.5.1    1
    8.5a6-8.6.1 8.6a0    1
    8.5a6-8.6.1 8.6b0    1
    8.5a6-8.6.1 8.6.0    1
    8.5b0-8.6.1 8.5a5    0
    8.5b0-8.6.1 8.5b1    1
    8.5b0-8.6.1 8.5.1    1
    8.5b0-8.6.1 8.6a0    1
    8.5b0-8.6.1 8.6b0    1
    8.5b0-8.6.1 8.6.0    1
    8.5b2-8.6.1 8.5a5    0
    8.5b2-8.6.1 8.5b1    0
    8.5b2-8.6.1 8.5.1    1
    8.5b2-8.6.1 8.6a0    1
    8.5b2-8.6.1 8.6b0    1
    8.5b2-8.6.1 8.6.0    1
    8.5-8.6.1 8.5a5    1
    8.5-8.6.1 8.5b1    1
    8.5-8.6.1 8.5.1    1
    8.5-8.6.1 8.6a0    1
    8.5-8.6.1 8.6b0    1
    8.5-8.6.1 8.6.0    1
    8.5.0-8.6.1 8.5a5    0
    8.5.0-8.6.1 8.5b1    0
    8.5.0-8.6.1 8.5.1    1
    8.5.0-8.6.1 8.6a0    1
    8.5.0-8.6.1 8.6b0    1
    8.5.0-8.6.1 8.6.0    1
    8.5a0-8.5a0 8.5a0    1
    8.5a0-8.5a0 8.5b1    0
    8.5a0-8.5a0 8.4      0
    8.5b0-8.5b0 8.5a5    0
    8.5b0-8.5b0 8.5b0    1
    8.5b0-8.5b0 8.5.1    0
    8.5-8.5  8.5a5    0
    8.5-8.5  8.5b1    0
    8.5-8.5  8.5      1
    8.5-8.5  8.5.1    0
    8.5.0-8.5.0 8.5a5    0
    8.5.0-8.5.0 8.5b1    0
    8.5.0-8.5.0 8.5.0    1
    8.5.0-8.5.0 8.5.1    0
    8.5.0-8.5.0 8.6a0    0
    8.5.0-8.5.0 8.6b0    0
    8.5.0-8.5.0 8.6.0    0
    8.2      9        0
    8.2-     9        1
    8.2-8.5  9        0
    8.2-9.1  9        1

    8.5-8.5     8.5b1 0
    8.5a0-8.5   8.5b1 0
    8.5a0-8.5.1 8.5b1 1

    8.5-8.5     8.5 1
    8.5.0-8.5.0 8.5 1
    8.5a0-8.5.0 8.5 0
} {
    test package-11.$n "package vsatisfies $provided $required" {
	package vsatisfies $provided $required
    } $satisfied
    incr n
}

test package-12.0 "package vsatisfies multiple" {
    #                      yes no
    package vsatisfies 8.4 8.4 7.3
} 1
test package-12.1 "package vsatisfies multiple" {
    #                      no  yes
    package vsatisfies 8.4 7.3 8.4
} 1
test package-12.2 "package vsatisfies multiple" {
    #                        yes  yes
    package vsatisfies 8.4.2 8.4  8.4.1
} 1
test package-12.3 "package vsatisfies multiple" {
    #                      no  no
    package vsatisfies 8.4 7.3 6.1
} 0

proc prefer {args} {
    set ip [interp create]
    try {
	lappend res [$ip eval {package prefer}]
	foreach mode $args {
	    lappend res [$ip eval [list package prefer $mode]]
	}
	return $res
    } finally {
	interp delete $ip
    }
}

test package-13.0 {package prefer defaults} -body {
    prefer
} -result [expr {[string match {*[ab]*} [package provide Tcl]] ? "latest" : "stable"}]
test package-13.1 {package prefer defaults} -body {
    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
    prefer
} -cleanup {
    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
} -result latest

test package-14.0 {wrong\#args} -returnCodes error -body {
    package prefer foo bar
} -result {wrong # args: should be "package prefer ?latest|stable?"}
test package-14.1 {bogus argument} -returnCodes error -body {
    package prefer foo
} -result {bad preference "foo": must be latest or stable}

test package-15.0 {set, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer} -result stable
test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer stable} -result stable
test package-15.2 {set latest, change} -constraints testpreferstable -setup {
    testpreferstable
} -body {package prefer latest} -result latest
test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    package prefer latest
    package prefer latest
} -result latest
test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
    testpreferstable
} -body {
    package prefer latest
    package prefer stable
} -result latest

rename prefer {}

set auto_path $oldPath
package unknown $oldPkgUnknown

cleanupTests
}

# cleanup
interp delete $i
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/parse.test.

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
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










-
-
-
+
+
+





-
-
-

-






-


-
-
+
+







# This file contains a collection of tests for the procedures in the
# file tclParse.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
if {[catch {package require tcltest 2.0.2}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
    return
}

namespace eval ::tcl::test::parse {
    namespace import ::tcltest::*

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testparser [llength [info commands testparser]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testevalobjv [llength [info commands testevalobjv]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testparsevarname [llength [info commands testparsevarname]]
testConstraint testparsevar [llength [info commands testparsevar]]
testConstraint testasync [llength [info commands testasync]]
testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevent [llength [info commands testevent]]
testConstraint memory [llength [info commands memory]]

test parse-1.1 {Tcl_ParseCommand procedure, computing string length} {testparser testbytestring} {
    testparser [testbytestring "foo\0 bar"] -1
test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-1.2 {Tcl_ParseCommand procedure, computing string length} testparser {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-1.3 {Tcl_ParseCommand procedure, leading space} testparser {
    testparser "  \n\t   foo" 0
} {- foo 1 simple foo 1 text foo 0 {}}
298
299
300
301
302
303
304
305
306
307



308
309
310
311
312
313
314
315
316
293
294
295
296
297
298
299



300
301
302


303
304
305
306
307
308
309







-
-
-
+
+
+
-
-







} {- b\\\nc 2 simple b 1 text b 0 simple c 1 text c 0 {}}
test parse-6.15 {ParseTokens procedure, backslash-newline} testparser {
    testparser "\"b\\\nc\"" 0
} {- \"b\\\nc\" 1 word \"b\\\nc\" 3 text b 0 backslash \\\n 0 text c 0 {}}
test parse-6.16 {ParseTokens procedure, backslash substitution} testparser {
    testparser {\n\a\x7f} 0
} {- {\n\a\x7f} 1 word {\n\a\x7f} 3 backslash {\n} 0 backslash {\a} 0 backslash {\x7f} 0 {}}
test parse-6.17 {ParseTokens procedure, null characters} {testparser testbytestring} {
    expr {[testparser [testbytestring "foo\0zz"] 0] eq
"- [testbytestring foo\0zz] 1 word [testbytestring foo\0zz] 3 text foo 0 text [testbytestring \0] 0 text zz 0 {}"
test parse-6.17 {ParseTokens procedure, null characters} testparser {
    testparser [bytestring "foo\0zz"] 0
} "- [bytestring foo\0zz] 1 word [bytestring foo\0zz] 3 text foo 0 text [bytestring \0] 0 text zz 0 {}"
	}
} 1
test parse-6.18 {ParseTokens procedure, seek past numBytes for close-bracket} testparser {
    # Test for Bug 681841
    list [catch {testparser {[a]} 2} msg] $msg
} {1 {missing close-bracket}}

test parse-7.1 {Tcl_FreeParse and ExpandTokenArray procedures} testparser {
    testparser {$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) } 0
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
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







-
+






-
-
+
+



-
+







} -result {16 23}
test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints {
    testevalobjv testasync
} -setup {
    variable ::aresult
    variable ::acode
    proc async1 {result code} {
	variable ::aresult
	variable ::aresult 
	variable ::acode
	set aresult $result
	set acode $code
	return "new result"
    }
    set handler1 [testasync create async1]
    set ::aresult xxx
    set ::acode yyy
    set aresult xxx
    set acode yyy
} -cleanup {
    testasync delete
} -body {
    list [testevalobjv 0 testasync mark $handler1 original 0] $::acode $::aresult
    list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult
} -result {{new result} 0 original}
test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
    list [catch {testevalobjv 0 error message} msg] $msg
} {1 message}
test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv {
    rename ::unknown unknown.save
    proc ::unknown args {lappend ::info [info level]}
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
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







-
-
+
+



-
-
-
+
+
+
















-
-
+
+


-
+


-
+







    set ::info
} {1 1}
test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv {
    rename ::unknown unknown.save
    proc ::unknown args {lappend ::info [info level]; uplevel 1 foo}
    proc ::foo args {lappend ::info global}
    catch {rename ::noSuchCommand {}}
    set ::child [interp create]
    $::child alias bar noSuchCommand
    set ::slave [interp create]
    $::slave alias bar noSuchCommand
    set ::info {}
    namespace eval test_ns_1 {
       proc foo args {lappend ::info namespace}
       $::child eval bar
       testevalobjv 1 [list $::child eval bar]
       uplevel #0 [list $::child eval bar]
       $::slave eval bar
       testevalobjv 1 [list $::slave eval bar]
       uplevel #0 [list $::slave eval bar]
    }
    namespace delete test_ns_1
    rename ::foo {}
    rename ::unknown {}
    rename unknown.save ::unknown
    set ::info
} [subst {[set level 2; incr level [info level]] global 1 global 1 global}]
test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} {
    set ::auto_index(noSuchCommand) {
        proc noSuchCommand {} {lappend ::info global}
    }
    set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \
        proc [namespace current]::test_ns_1::noSuchCommand {} {
            lappend ::info ns
        }]
    catch {rename ::noSuchCommand {}}
    set ::child [interp create]
    $::child alias bar noSuchCommand
    set ::slave [interp create]
    $::slave alias bar noSuchCommand
    set ::info {}
    namespace eval test_ns_1 {
        $::child eval bar
        $::slave eval bar
    }
    namespace delete test_ns_1
    interp delete $::child
    interp delete $::slave
    catch {rename ::noSuchCommand {}}
    set ::info
} global


test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
    unset -nocomplain x
702
703
704
705
706
707
708
709
710


711
712
713
714
715
716
717
695
696
697
698
699
700
701


702
703
704
705
706
707
708
709
710







-
-
+
+







    }
    expr {$end - $tmp}
} -cleanup {
    unset -nocomplain a end i vn res tmp
    rename getbytes {}
} -result 0

test parse-14.1 {Tcl_ParseBraces procedure, computing string length} {testparser testbytestring} {
    testparser [testbytestring "foo\0 bar"] -1
test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-14.2 {Tcl_ParseBraces procedure, computing string length} testparser {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-14.3 {Tcl_ParseBraces procedure, words in braces} testparser {
    testparser {foo {a $b [concat foo]} {c d}} 0
} {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
739
740
741
742
743
744
745
746
747


748
749
750
751
752
753
754
732
733
734
735
736
737
738


739
740
741
742
743
744
745
746
747







-
-
+
+







test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} testparser {
    testparser {foo {}} 0
} {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}}
test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser {
    list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo
} {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"}

test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} {testparser testbytestring} {
    testparser [testbytestring "foo\0 bar"] -1
test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} testparser {
    testparser [bytestring "foo\0 bar"] -1
} {- foo 1 simple foo 1 text foo 0 {}}
test parse-15.2 {Tcl_ParseQuotedString procedure, computing string length} testparser {
    testparser "foo bar" -1
} {- {foo bar} 2 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} testparser {
    testparser {foo "a b c" d "efg";} 0
} {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
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
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







-
-
+
+

-
-
+
+







-
+

-
+






-
+







} 1
test parse-15.53 {CommandComplete procedure} "
    info complete \" # \{\"
" 1
test parse-15.54 {CommandComplete procedure} "
    info complete \"foo bar;# \{\"
" 1
test parse-15.55 {CommandComplete procedure} testbytestring {
    info complete "set x [testbytestring \0]; puts hi"
test parse-15.55 {CommandComplete procedure} {
    info complete "set x [bytestring \0]; puts hi"
} 1
test parse-15.56 {CommandComplete procedure} testbytestring {
    info complete "set x [testbytestring \0]; \{"
test parse-15.56 {CommandComplete procedure} {
    info complete "set x [bytestring \0]; \{"
} 0
test parse-15.57 {CommandComplete procedure} {
    info complete "# Comment should be complete command"
} 1
test parse-15.58 {CommandComplete procedure, memory leaks} {
    info complete "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22"
} 1
test parse-15.59 {CommandComplete procedure} testbytestring {
test parse-15.59 {CommandComplete procedure} {
    # Test for Tcl Bug 684744
    info complete [testbytestring "\x00;if 1 \{"]
    info complete [bytestring "\x00;if 1 \{"]
} 0
test parse-15.60 {CommandComplete procedure} {
    # Test for Tcl Bug 1968882
    info complete \\\n
} 0

test parse-16.1 {Bug 218885 (Scriptics bug 2535)} {
test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} {
    subst {[eval {return foo}]bar}
} foobar

test parse-17.1 {Correct return codes from errors during substitution} {
    catch {eval {w[continue]}}
} 4

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
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







-
+






-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
    testevalex
} -setup {
    interp create i
    load {} Tcltest i
    i eval {proc {} args {}}
    interp recursionlimit i 2
    interp recursionlimit i 3
} -body {
    i eval {testevalex {[[]]}}
} -cleanup {
    interp delete i
} -returnCodes error -match glob -result {too many nested*}

test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest {
    # Test no longer valid in Tcl 8.6
} {}
test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest {
    # Test no longer valid in Tcl 8.6
} {}
test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
    interp create i
    i eval {proc {} args {}}
    interp recursionlimit i 3
} -body {
    i eval {subst {[]}}
} -cleanup {
    interp delete i
}

test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
    interp create i
    i eval {proc {} args {}}
    interp recursionlimit i 3
} -body {
    i eval {subst {[[]]}}
} -cleanup {
    interp delete i
} -returnCodes error -match glob -result {too many nested*}

test parse-20.1 {TclParseBackslash: truncated escape} testparser {
    testparser {\u12345} 1
} {- \\ 1 simple \\ 1 text \\ 0 u12345}
test parse-20.2 {TclParseBackslash: truncated escape} testparser {
    testparser {\u12345} 2
} {- {\u} 1 word {\u} 1 backslash {\u} 0 12345}
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
1120
1121
1122
1123
1124
1125
1126













1127
1128
1129
1130
1131







-
-
-
-
-
-
-
-
-
-
-
-
-





test parse-20.11 {TclParseBackslash: truncated escape} testparser {
    testparser {\x12X} 4
} {- {\x12} 1 word {\x12} 1 backslash {\x12} 0 X}
test parse-20.12 {TclParseBackslash: truncated escape} testparser {
    testparser {\x12X} 5
} {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}}

test parse-21.0 {Bug 1884496} testevent {
    set ::script {testevent delete a; set a [p]; set ::done $a}
    proc ::p {} {string first s $::script}
    testevent queue a head $::script
    vwait done
} {}
test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent {
    testevent queue a head {testevent delete a; \
	set ::done [dict get [info frame 0] line]}
    vwait done
    set ::done
} 2

cleanupTests
}

namespace delete ::tcl::test::parse
return

Changes to tests/parseExpr.test.

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
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










-
-
-
+
+
-
-
-
-







-







# This file contains a collection of tests for the procedures in the
# file tclCompExpr.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Note that the Tcl expression parser (tclCompExpr.c) does not check
# the semantic validity of the expressions it parses. It does not check,
# for example, that a math function actually exists, or that the operands
# of "<<" are integers.

testConstraint testexprparser [llength [info commands testexprparser]]
testConstraint testbytestring [llength [info commands testbytestring]]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
80
81
82
83
84
85
86
87
88


89
90
91
92
93
94
95
74
75
76
77
78
79
80


81
82
83
84
85
86
87
88
89







-
-
+
+







	}
    }
}
testConstraint ieeeFloatingPoint [testIEEE]

######################################################################

test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} {testexprparser testbytestring} {
    testexprparser [testbytestring "1+2\0 +3"] -1
test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} testexprparser {
    testexprparser [bytestring "1+2\0 +3"] -1
} {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} testexprparser {
    testexprparser "1  + 2" -1
} {- {} 0 subexpr {1  + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} testexprparser {
    testexprparser 12345678901234567890 -1
} {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
766
767
768
769
770
771
772
773

774
775
776
777

778
779
780
781
782
783
784
760
761
762
763
764
765
766

767
768
769
770

771
772
773
774
775
776
777
778







-
+



-
+







test parseExpr-21.7 {error messages} -body {
    expr {0o8}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.8 {error messages} -body {
    expr {0o8x}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.9 {error messages} -body {
    expr {"}
    expr {"} 
} -returnCodes error -result {missing "
in expression """}
test parseExpr-21.10 {error messages} -body {
    expr \{
    expr \{ 
} -returnCodes error -result "missing close-brace
in expression \"\{\""
test parseExpr-21.11 {error messages} -body {
    expr $
} -returnCodes error -result {invalid character "$"
in expression "$"}
test parseExpr-21.12 {error messages} -body {
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
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







-
+
-
-
+




-
+
-
-
+

-
+
-
-
+

-
+
-
-
+





-
-
+
+

-
-
+
+
-

-
+
-
-
+

-
+
-
-
+

-
+
-
-
+







test parseExpr-22.6 {Bug 3401704} -constraints testexprparser -body {
    testexprparser 2_() -1
} -result {- {} 0 subexpr 2_() 1 operator 2_ 0 {}}
test parseExpr-22.7 {Bug 3401704} -constraints testexprparser -body {
    testexprparser nan_() -1
} -result {- {} 0 subexpr nan_() 1 operator nan_ 0 {}}
test parseExpr-22.8 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser nan!() -1} m o
    testexprparser nan!() -1
    dict get $o -errorcode
} -result {TCL PARSE EXPR MISSING}
} -returnCodes error -match glob -result *
test parseExpr-22.9 {Bug 3401704} -constraints testexprparser -body {
    testexprparser 1e3_() -1
} -result {- {} 0 subexpr 1e3_() 1 operator 1e3_ 0 {}}
test parseExpr-22.10 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser 1.3_() -1} m o
    testexprparser 1.3_() -1
    dict get $o -errorcode
} -result {TCL PARSE EXPR BADCHAR}
} -returnCodes error -match glob -result *
test parseExpr-22.11 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser 1e-3_() -1} m o
    testexprparser 1e-3_() -1
    dict get $o -errorcode
} -result {TCL PARSE EXPR BADCHAR}
} -returnCodes error -match glob -result *
test parseExpr-22.12 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser naneq() -1} m o
    testexprparser naneq() -1
    dict get $o -errorcode
} -result {TCL PARSE EXPR EMPTY}
} -returnCodes error -match glob -result *
test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
    testexprparser naner() -1
} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}

test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
    testexprparser 07 -1
} -result {- {} 0 subexpr 07 1 text 07 0 {}}
    testexprparser 08 -1
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser 0o8 -1} m o
    dict get $o -errorcode
    testexprparser 0o8 -1
} -returnCodes error -match glob -result {*invalid octal number*}
} -result {TCL PARSE EXPR BADNUMBER OCTAL}
test parseExpr-22.16 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser 0o08 -1} m o
    testexprparser 0o08 -1
    dict get $o -errorcode
} -result {TCL PARSE EXPR BADNUMBER OCTAL}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-22.17 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser 0b2 -1} m o
    testexprparser 0b2 -1
    dict get $o -errorcode
} -result {TCL PARSE EXPR BADNUMBER BINARY}
} -returnCodes error -match glob -result {*invalid binary number*}
test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
    catch {testexprparser 0b02 -1} m o
    testexprparser 0b02 -1
    dict get $o -errorcode
} -result {TCL PARSE EXPR BADNUMBER BINARY}
} -returnCodes error -match glob -result {*invalid binary number*}

test parseExpr-22.19 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser \u0433 -1
} -returnCodes error -match glob -result {*invalid character*}
test parseExpr-22.20 {Bug d2ffcca163} -constraints testexprparser -body {
    testexprparser \u043f -1
} -returnCodes error -match glob -result {*invalid character*}

Changes to tests/parseOld.test.

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
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) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
package require tcltest
namespace import ::tcltest::*


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testwordend [llength [info commands testwordend]]
testConstraint testbytestring [llength [info commands testbytestring]]

# Save the argv value for restoration later
set savedArgv $argv

proc fourArgs {a b c d} {
    global arg1 arg2 arg3 arg4
    set arg1 $a
    set arg2 $b
    set arg3 $c
    set arg4 $d
}

proc getArgs args {
    global argv
    set argv $args
}


# Basic argument parsing.

test parseOld-1.1 {basic argument parsing} {
    set arg1 {}
    fourArgs a b	c 		 d
    list $arg1 $arg2 $arg3 $arg4
} {a b c d}
260
261
262
263
264
265
266
267
268



269
270
271



272
273
274



275
276
277
278
279
280
281
282
254
255
256
257
258
259
260


261
262
263



264
265
266



267
268
269

270
271
272
273
274
275
276







-
-
+
+
+
-
-
-
+
+
+
-
-
-
+
+
+
-







} "x"
test parseOld-7.10 {backslash substitution} {
    eval "list a b\\\nc d"
} {a b c d}
test parseOld-7.11 {backslash substitution} {
    eval "list a \"b c\"\\\nd e"
} {a {b c} d e}
test parseOld-7.12 {backslash substitution} testbytestring {
    expr {[list \ua2] eq [testbytestring "\xc2\xa2"]}
test parseOld-7.12 {backslash substitution} {
    list \ua2
} [bytestring "\xc2\xa2"]
} 1
test parseOld-7.13 {backslash substitution} testbytestring {
    expr {[list \u4e21] eq [testbytestring "\xe4\xb8\xa1"]}
test parseOld-7.13 {backslash substitution} {
    list \u4e21
} [bytestring "\xe4\xb8\xa1"]
} 1
test parseOld-7.14 {backslash substitution} testbytestring {
    expr {[list \u4e2k] eq [testbytestring "\xd3\xa2k"]}
test parseOld-7.14 {backslash substitution} {
    list \u4e2k
} [bytestring "\xd3\xa2k"]
} 1

# Semi-colon.

test parseOld-8.1 {semi-colons} {
    set b 0
    getArgs a;set b 2
    set argv
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
288
289
290
291
292
293
294

295
296
297
298
299
300
301







-







    getArgs a b ; set b 1
    set b
} 1

# The following checks are to ensure that the interpreter's result
# gets re-initialized by Tcl_Eval in all the right places.

set a 22
test parseOld-9.1 {result initialization} {concat abc} abc
test parseOld-9.2 {result initialization} {concat abc; proc foo {} {}} {}
test parseOld-9.3 {result initialization} {concat abc; proc foo {} $a} {}
test parseOld-9.4 {result initialization} {proc foo {} [concat abc]} {}
test parseOld-9.5 {result initialization} {concat abc; } abc
test parseOld-9.6 {result initialization} {
    eval {
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
400
401
402
403
404
405
406


407
408
409
410
411
412
413







-
-







    set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
    string length $b
} 214
test parseOld-11.7 {long values} {
    set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
    llength $b
} 43
# Duplicate action of previous test
llength [set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]]
test parseOld-11.8 {long values} {
    set b
} $a
test parseOld-11.9 {long values} {
    set a [concat 0000 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH IIII JJJJ KKKK LLLL MMMM NNNN OOOO PPPP QQQQ RRRR SSSS TTTT UUUU VVVV WWWW XXXX YYYY ZZZZ]
    llength $a
} 62
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
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
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











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

















-
+




-
-
-
-
test parseOld-13.1 {comments at the end of a bracketed script} {
    set x "[
expr 1+1
# skip this!
]"
} {2}

test parseOld-14.1 {TclWordEnd procedure} {testwordend} {
    testwordend " 	\n abc"
} {c}
test parseOld-14.2 {TclWordEnd procedure} {testwordend} {
    testwordend "   \\\n"
} {}
test parseOld-14.3 {TclWordEnd procedure} {testwordend} {
    testwordend "   \\\n "
} { }
test parseOld-14.4 {TclWordEnd procedure} {testwordend} {
    testwordend {"abc"}
} {"}
#" Emacs formatting :^(
test parseOld-14.5 {TclWordEnd procedure} {testwordend} {
    testwordend {{xyz}}
} \}
test parseOld-14.6 {TclWordEnd procedure} {testwordend} {
    testwordend {{a{}b{}\}} xyz}
} "\} xyz"
test parseOld-14.7 {TclWordEnd procedure} {testwordend} {
    testwordend {abc[this is a]def ghi}
} {f ghi}
test parseOld-14.8 {TclWordEnd procedure} {testwordend} {
    testwordend "puts\\\n\n  "
} "s\\\n\n  "
test parseOld-14.9 {TclWordEnd procedure} {testwordend} {
    testwordend "puts\\\n   	"
} "s\\\n   	"
test parseOld-14.10 {TclWordEnd procedure} {testwordend} {
    testwordend "puts\\\n   	xyz"
} "s\\\n   	xyz"
test parseOld-14.11 {TclWordEnd procedure} {testwordend} {
    testwordend {a$x.$y(a long index) foo}
} ") foo"
test parseOld-14.12 {TclWordEnd procedure} {testwordend} {
    testwordend {abc; def}
} {; def}
test parseOld-14.13 {TclWordEnd procedure} {testwordend} {
    testwordend {abc def}
} {c def}
test parseOld-14.14 {TclWordEnd procedure} {testwordend} {
    testwordend {abc	def}
} {c	def}
test parseOld-14.15 {TclWordEnd procedure} {testwordend} {
    testwordend "abc\ndef"
} "c\ndef"
test parseOld-14.16 {TclWordEnd procedure} {testwordend} {
    testwordend "abc"
} {c}
test parseOld-14.17 {TclWordEnd procedure} {testwordend} {
    testwordend "a\000bc"
} {c}
test parseOld-14.18 {TclWordEnd procedure} {testwordend} {
    testwordend \[a\000\]
} {]}
test parseOld-14.19 {TclWordEnd procedure} {testwordend} {
    testwordend \"a\000\"
} {"}
#" Emacs formatting :^(
test parseOld-14.20 {TclWordEnd procedure} {testwordend} {
    testwordend a{\000}b
} {b}
test parseOld-14.21 {TclWordEnd procedure} {testwordend} {
    testwordend "   \000b"
} {b}

test parseOld-15.1 {TclScriptEnd procedure} {
    info complete {puts [
	expr 1+1
	#this is a comment ]}
} {0}
test parseOld-15.2 {TclScriptEnd procedure} {
    info complete "abc\\\n"
} {0}
test parseOld-15.3 {TclScriptEnd procedure} {
    info complete "abc\\\\\n"
} {1}
test parseOld-15.4 {TclScriptEnd procedure} {
    info complete "xyz \[abc \{abc\]"
} {0}
test parseOld-15.5 {TclScriptEnd procedure} {
    info complete "xyz \[abc"
} {0}


# cleanup
set argv $savedArgv
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/pid.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22













-
-
+
+







# Commands covered:  pid
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint pidDefined [llength [info commands pid]]

test pid-1.1 {pid command} pidDefined {
    regexp {(^[0-9]+$)|(^0x[0-9a-fA-F]+$)} [pid]

Added tests/pkg.test.














































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# -*- tcl -*-
# Commands covered:  pkg
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.3.4
    namespace import -force ::tcltest::*
}

# Do all this in a child interp to avoid garbaging the
# package list
set i [interp create]
tcltest::loadIntoChildInterpreter $i {*}$argv

interp eval $i {
namespace import -force ::tcltest::*
package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""

test pkg-1.1 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
} {}
test pkg-1.2 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    list [catch {package provide t 2.2} msg] $msg
} {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
test pkg-1.3 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    list [catch {package provide t 2.4} msg] $msg
} {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
test pkg-1.4 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    list [catch {package provide t 3.3} msg] $msg
} {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
test pkg-1.5 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3
    package provide t 2.3
} {}

test pkg-1.6 {Tcl_PkgProvide procedure} {
    package forget t
    package provide t 2.3a1
} {}

set n 0
foreach v {
    2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
    2b4a1 2b3b2
} {
    test pkg-1.7.$n {Tcl_PkgProvide procedure} {
	package forget t
	list [catch {package provide t $v} msg] $msg
    } [list 1 "expected version number but got \"$v\""]
    incr n
}

test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {3.4}
test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {3.5}
test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {3.5 2.1 2.3} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t 2.2
    set x
} {2.3}
test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require -exact t 2.3
    set x
} {2.3}
test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t 2.1
    set x
} {2.4}
test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    list [catch {package require t 2.5} msg] $msg
} {1 {can't find package t 2.5}}
test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    list [catch {package require t 4.1} msg] $msg
} {1 {can't find package t 4.1}}
test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    list [catch {package require -exact t 1.3} msg] $msg
} {1 {can't find package t exactly 1.3}}
test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
    package forget t
    package unknown {}
    list [catch {package require t} msg] $msg
} {1 {can't find package t}}
test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
    package forget t
    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
    list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {ifneeded test
    while executing
"error "ifneeded test""
    ("package ifneeded*" script)
    invoked from within
"package require t 2.1"}}
test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -body {
    package forget t
    package ifneeded t 2.1 "set x invoked"
    set x xxx
    list [catch {package require t 2.1} msg] $msg $x
} -match glob -result {1 * invoked}
test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
    package forget t
    package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
    set x xxx
    package require t 1.2
    set x
} {1.2}
test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
    proc pkgUnknown args {
	# args = name requirement
	# requirement = v-v (for exact version)
	global x
	set x $args
	package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
    }
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    set x xxx
    package require -exact t 1.5
    package unknown {}
    set x
} {t 1.5-1.5}
test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
    proc pkgUnknown args {
	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
    }
    package forget t
    package unknown pkgUnknown
    set x xxx
    set result [list [package require t] $x]
    package unknown {}
    set result
} {1.2 loaded}
test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
    proc pkgUnknown args {
	global x
	set x $args
	package provide [lindex $args 0] 2.0
    }
    package forget {a b}
    package unknown pkgUnknown
    set x xxx
    package require {a b}
    package unknown {}
    set x
} {{a b} 0-}
test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
    proc pkgUnknown args {
	error "testing package unknown"
    }
    package forget t 
    package unknown pkgUnknown
    set result [list [catch {package require t} msg] $msg $::errorInfo]
    package unknown {}
    set result
} {1 {testing package unknown} {testing package unknown
    while executing
"error "testing package unknown""
    (procedure "pkgUnknown" line 2)
    invoked from within
"pkgUnknown t 0-"
    ("package unknown" script)
    invoked from within
"package require t"}}
test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} {
    proc pkgUnknown args {
	global x
	set x $args
    }
    package forget t
    foreach i {1.4 3.4 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i"
    }
    package unknown pkgUnknown
    set x xxx
    set result [list [catch {package require -exact t 1.5} msg] $msg $x]
    package unknown {}
    set result
} {1 {can't find package t exactly 1.5} {t 1.5-1.5}}
test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require t
} {2.3}
test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require t 2.1
} {2.3}
test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require t 2.3
} {2.3}
test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    list [catch {package require t 2.4} msg] $msg
} {1 {version conflict for package "t": have 2.3, need 2.4}}
test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    list [catch {package require t 1.2} msg] $msg
} {1 {version conflict for package "t": have 2.3, need 1.2}}
test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    package require -exact t 2.3
} {2.3}
test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
    package forget t
    package provide t 2.3
    list [catch {package require -exact t 2.2} msg] $msg
} {1 {version conflict for package "t": have 2.3, need exactly 2.2}}
test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
    package forget t
    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
    list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {EI
    ("package ifneeded*" script)
    invoked from within
"package require t 2.1"}}
test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} -body {
    package forget t
    package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
    list [catch {package require t 2.1} msg] $msg $::errorInfo
} -match glob -result {1 {ifneeded test} {EI
    ("foreach" body line 1)
    invoked from within
"foreach x 1 {error "ifneeded test" EI}"
    ("package ifneeded*" script)
    invoked from within
"package require t 2.1"}}
test pkg-2.27 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package require foo 1}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {circular package dependency:*}
test pkg-2.28 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package require foo 2}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {circular package dependency:*}
test pkg-2.29 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
    package forget bar
} -body {
    package ifneeded foo 1 {package require bar 1; package provide foo 1}
    package ifneeded bar 1 {package require foo 1; package provide bar 1}
    package require foo 1
} -cleanup {
    package forget foo
    package forget bar
} -returnCodes error -match glob -result {circular package dependency:*}
test pkg-2.30 {Tcl_PkgRequire: circular dependency} -setup {
    package forget foo
    package forget bar
} -body {
    package ifneeded foo 1 {package require bar 1; package provide foo 1}
    package ifneeded foo 2 {package provide foo 2}
    package ifneeded bar 1 {package require foo 2; package provide bar 1}
    package require foo 1
} -cleanup {
    package forget foo
    package forget bar
} -returnCodes error -match glob -result {circular package dependency:*}
test pkg-2.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 1; error foo}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result foo
test pkg-2.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 1; error foo}
    catch {package require foo 1}
    package provide foo
} -cleanup {
    package forget foo
} -result {}
test pkg-2.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 2}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test pkg-2.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {package provide foo 1.1}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test pkg-2.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1.1 {package provide foo 1}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test pkg-2.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1.1 {package provide foo 1}
    package require foo 1.1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test pkg-2.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob -result {attempt to provide package * failed:*}
test pkg-2.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {break}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test pkg-2.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {continue}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test pkg-2.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {return}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test pkg-2.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
} -body {
    package ifneeded foo 1 {return -level 0 -code 10}
    package require foo 1
} -cleanup {
    package forget foo
} -returnCodes error -match glob \
-result {attempt to provide package * failed: bad return code:*}
test pkg-2.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {package provide foo 2 ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result *
test pkg-2.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {break ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test pkg-2.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {continue ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test pkg-2.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {return ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test pkg-2.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
    package forget foo
    set saveUnknown [package unknown]
    package unknown {return -level 0 -code 10 ;#}
} -body {
    package require foo 1
} -cleanup {
    package forget foo
    package unknown $saveUnknown
} -returnCodes error -match glob -result {bad return code:*}
test pkg-2.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
    package provide demo 1.2.3
} -body {
    package require -exact demo 1.2
} -cleanup {
    package forget demo
} -returnCodes error -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}


test pkg-2.50 {Tcl_PkgRequire procedure, picking best stable version} {
    package forget t
    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {3.4}

test pkg-2.51 {Tcl_PkgRequire procedure, picking best stable version} {
    package forget t
    foreach i {1.2b1 1.2 1.3a2 1.3} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {1.3}

test pkg-2.52 {Tcl_PkgRequire procedure, picking best stable version} {
    package forget t
    foreach i {1.2b1 1.2 1.3 1.3a2} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {1.3}

test pkg-2.53 {Tcl_PkgRequire procedure, picking best stable version} {
    package forget t
    foreach i {1.2b1 1.1} {
	package ifneeded t $i "set x $i; package provide t $i"
    }
    set x xxx
    package require t
    set x
} {1.1}



test pkg-3.1 {Tcl_PackageCmd procedure} {
    list [catch {package} msg] $msg
} {1 {wrong # args: should be "package option ?arg arg ...?"}}
test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
    foreach i [package names] {
	package forget $i
    }
    package names
} {}
test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
    foreach i [package names] {
	package forget $i
    }
    package forget foo
} {}
test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
    foreach i [package names] {
	package forget $i
    }
    package ifneeded t 1.1 {first script}
    package ifneeded t 2.3 {second script}
    package ifneeded x 1.4 {x's script}
    set result {}
    lappend result [lsort [package names]] [package versions t]
    package forget t
    lappend result [lsort [package names]] [package versions t]
} {{t x} {1.1 2.3} x {}}
test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
    foreach i [package names] {
	package forget $i
    }
    package ifneeded a 1.1 {first script}
    package ifneeded b 2.3 {second script}
    package ifneeded c 1.4 {third script}
    package forget
    set result [list [lsort [package names]]]
    package forget a c
    lappend result [lsort [package names]]
} {{a b c} b}
test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} {
    # Test for Bug 415273
    package ifneeded a 1 "I should have been forgotten"
    package forget no-such-package a
    set x [package ifneeded a 1]
    package forget a
    set x
} {}
test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
    list [catch {package ifneeded a} msg] $msg
} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} {
    list [catch {package ifneeded a b c d} msg] $msg
} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} {
    list [catch {package ifneeded t xyz} msg] $msg
} {1 {expected version number but got "xyz"}}
test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
    foreach i [package names] {
	package forget $i
    }
    list [package ifneeded foo 1.1] [package names]
} {{} {}}
test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} {
    package forget t
    package ifneeded t 1.4 "script for t 1.4"
    list [package names] [package ifneeded t 1.4] [package versions t]
} {t {script for t 1.4} 1.4}
test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} {
    package forget t
    package ifneeded t 1.4 "script for t 1.4"
    list [package ifneeded t 1.5] [package names] [package versions t]
} {{} t 1.4}
test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
    package forget t
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.4 "second script for t 1.4"
    list [package ifneeded t 1.4] [package names] [package versions t]
} {{second script for t 1.4} t 1.4}
test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
    package forget t
    package ifneeded t 1.4 "script for t 1.4"
    package ifneeded t 1.2 "second script"
    package ifneeded t 3.1 "last script"
    list [package ifneeded t 1.2] [package versions t]
} {{second script} {1.4 1.2 3.1}}
test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
    list [catch {package names a} msg] $msg
} {1 {wrong # args: should be "package names"}}
test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
    foreach i [package names] {
	package forget $i
    }
    package names
} {}
test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
    foreach i [package names] {
	package forget $i
    }
    package ifneeded x 1.2 {dummy}
    package provide x 1.3
    package provide y 2.4
    catch {package require z 47.16}
    lsort [package names]
} {x y}
test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
    list [catch {package provide} msg] $msg
} {1 {wrong # args: should be "package provide package ?version?"}}
test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
    list [catch {package provide a b c} msg] $msg
} {1 {wrong # args: should be "package provide package ?version?"}}
test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
    package forget t
    package provide t
} {}
test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
    package forget t
    package provide t 2.3
    package provide t
} {2.3}
test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
    package forget t
    list [catch {package provide t a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}

test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact a b c} msg] $msg
    # Exact syntax: -exact name version
    #              name ?requirement...?
} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}

test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact x} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
    list [catch {package require -exact} msg] $msg
} {1 {wrong # args: should be "package require ?-exact? package ?requirement...?"}}
test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
    package forget t
    package provide t 2.3
    package require t 2.1
} {2.3}
test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
    package forget t
    list [catch {package require t} msg] $msg
} {1 {can't find package t}}
test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
    package forget t
    package ifneeded t 2.3 "error {synthetic error}"
    list [catch {package require t 2.3} msg] $msg
} {1 {synthetic error}}
test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
    list [catch {package unknown a b} msg] $msg
} {1 {wrong # args: should be "package unknown ?command?"}}
test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
    package unknown "test script"
    package unknown
} {test script}
test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
    package unknown "test script"
    package unknown {}
    package unknown
} {}
test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare a} msg] $msg
} {1 {wrong # args: should be "package vcompare version1 version2"}}
test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare a b c} msg] $msg
} {1 {wrong # args: should be "package vcompare version1 version2"}}
test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare x.y 3.4} msg] $msg
} {1 {expected version number but got "x.y"}}
test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
    list [catch {package vcompare 2.1 a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
    package vc 2.1 2.3
} {-1}
test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
    package vc 2.2.4 2.2.4
} {0}
test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
    list [catch {package versions} msg] $msg
} {1 {wrong # args: should be "package versions package"}}
test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
    list [catch {package versions a b} msg] $msg
} {1 {wrong # args: should be "package versions package"}}
test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
    package forget t
    package versions t
} {}
test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
    package forget t
    package provide t 2.3
    package versions t
} {}
test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
    package forget t
    package ifneeded t 2.3 x
    package ifneeded t 2.4 y
    package versions t
} {2.3 2.4}
test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies a} msg] $msg
} {1 {wrong # args: should be "package vsatisfies version requirement requirement..."}}

test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies x.y 3.4} msg] $msg
} {1 {expected version number but got "x.y"}}
test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vcompare 2.1 a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    package vs 2.3 2.1
} {1}
test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    package vs 2.3 1.2
} {0}
test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
    list [catch {package foo} msg] $msg
} {1 {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}}

test pkg-3.54 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies 2.1 2.1-3.2-4.5} msg] $msg
} {1 {expected versionMin-versionMax but got "2.1-3.2-4.5"}}

test pkg-3.55 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies 2.1 3.2-x.y} msg] $msg
} {1 {expected version number but got "x.y"}}

test pkg-3.56 {Tcl_PackageCmd procedure, "vsatisfies" option} {
    list [catch {package vsatisfies 2.1 x.y-3.2} msg] $msg
} {1 {expected version number but got "x.y"}}


# No tests for FindPackage;  can't think up anything detectable
# errors.

test pkg-4.1 {TclFreePackageInfo procedure} {
    interp create foo
    foo eval {
	package ifneeded t 2.3 x
	package ifneeded t 2.4 y
	package ifneeded x 3.1 z
	package provide q 4.3
	package unknown "will this get freed?"
    }
    interp delete foo
} {}
test pkg-4.2 {TclFreePackageInfo procedure} -body {
    interp create foo
    foo eval {
	package ifneeded t 2.3 x
	package ifneeded t 2.4 y
	package ifneeded x 3.1 z
	package provide q 4.3
    }
    foo alias z kill
    proc kill {} {
	interp delete foo
    }
    foo eval package require x 3.1
} -returnCodes error -match glob -result *

test pkg-5.1 {CheckVersion procedure} {
    list [catch {package vcompare 1 2.1} msg] $msg
} {0 -1}
test pkg-5.2 {CheckVersion procedure} {
    list [catch {package vcompare .1 2.1} msg] $msg
} {1 {expected version number but got ".1"}}
test pkg-5.3 {CheckVersion procedure} {
    list [catch {package vcompare 111.2a.3 2.1} msg] $msg
} {1 {expected version number but got "111.2a.3"}}
test pkg-5.4 {CheckVersion procedure} {
    list [catch {package vcompare 1.2.3. 2.1} msg] $msg
} {1 {expected version number but got "1.2.3."}}
test pkg-5.5 {CheckVersion procedure} {
    list [catch {package vcompare 1.2..3 2.1} msg] $msg
} {1 {expected version number but got "1.2..3"}}

test pkg-6.1 {ComparePkgVersions procedure} {
    package vcompare 1.23 1.22
} {1}
test pkg-6.2 {ComparePkgVersions procedure} {
    package vcompare 1.22.1.2.3 1.22.1.2.3
} {0}
test pkg-6.3 {ComparePkgVersions procedure} {
    package vcompare 1.21 1.22
} {-1}
test pkg-6.4 {ComparePkgVersions procedure} {
    package vcompare 1.21 1.21.2
} {-1}
test pkg-6.5 {ComparePkgVersions procedure} {
    package vcompare 1.21.1 1.21
} {1}
test pkg-6.6 {ComparePkgVersions procedure} {
    package vsatisfies 1.21.1 1.21
} {1}
test pkg-6.7 {ComparePkgVersions procedure} {
    package vsatisfies 2.22.3 1.21
} {0}
test pkg-6.8 {ComparePkgVersions procedure} {
    package vsatisfies 1 1
} {1}
test pkg-6.9 {ComparePkgVersions procedure} {
    package vsatisfies 2 1
} {0}

test pkg-7.1 {Tcl_PkgPresent procedure, any version} {
    package forget t
    package provide t 2.4
    package present t
} {2.4}
test pkg-7.2 {Tcl_PkgPresent procedure, correct version} {
    package forget t
    package provide t 2.4
    package present t 2.4
} {2.4}
test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} {
    package forget t
    package provide t 2.4
    package present t 2.0
} {2.4}
test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} {
    package forget t
    package provide t 2.4
    list [catch {package present t 2.6} msg] $msg
} {1 {version conflict for package "t": have 2.4, need 2.6}}
test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} {
    package forget t
    package provide t 2.4
    list [catch {package present t 1.0} msg] $msg
} {1 {version conflict for package "t": have 2.4, need 1.0}}
test pkg-7.6 {Tcl_PkgPresent procedure, exact version} {
    package forget t
    package provide t 2.4
    package present -exact t 2.4
} {2.4}
test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
    package forget t
    package provide t 2.4
    list [catch {package present -exact t 2.3} msg] $msg
} {1 {version conflict for package "t": have 2.4, need exactly 2.3}}
test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
    package forget t
    list [catch {package present t} msg] $msg
} {1 {package t is not present}}
test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} {
    package forget t
    list [catch {package present t 2.4} msg] $msg
} {1 {package t 2.4 is not present}}
test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
    package forget t
    list [catch {package present -exact t 2.4} msg] $msg
} {1 {package t 2.4 is not present}}
test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}
test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present a b c} msg] $msg
} {1 {expected version number but got "b"}}
test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact a b c} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}
test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -bs a b} msg] $msg
} {1 {expected version number but got "a"}}
test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact x a.b} msg] $msg
} {1 {expected version number but got "a.b"}}
test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact x} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}
test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} {
    list [catch {package present -exact} msg] $msg
} {1 {wrong # args: should be "package present ?-exact? package ?requirement...?"}}




set n 0
foreach {r p vs vc} {
    8.5a0    8.5a5    1          -1
    8.5a0    8.5b1    1          -1
    8.5a0    8.5.1    1          -1
    8.5a0    8.6a0    1          -1
    8.5a0    8.6b0    1          -1
    8.5a0    8.6.0    1          -1
    8.5a6    8.5a5    0          1
    8.5a6    8.5b1    1          -1
    8.5a6    8.5.1    1          -1
    8.5a6    8.6a0    1          -1
    8.5a6    8.6b0    1          -1
    8.5a6    8.6.0    1          -1
    8.5b0    8.5a5    0          1
    8.5b0    8.5b1    1          -1
    8.5b0    8.5.1    1          -1
    8.5b0    8.6a0    1          -1
    8.5b0    8.6b0    1          -1
    8.5b0    8.6.0    1          -1
    8.5b2    8.5a5    0          1
    8.5b2    8.5b1    0          1
    8.5b2    8.5.1    1          -1
    8.5b2    8.6a0    1          -1
    8.5b2    8.6b0    1          -1
    8.5b2    8.6.0    1          -1
    8.5      8.5a5    1          1
    8.5      8.5b1    1          1
    8.5      8.5.1    1          -1
    8.5      8.6a0    1          -1
    8.5      8.6b0    1          -1
    8.5      8.6.0    1          -1
    8.5.0    8.5a5    0          1
    8.5.0    8.5b1    0          1
    8.5.0    8.5.1    1          -1
    8.5.0    8.6a0    1          -1
    8.5.0    8.6b0    1          -1
    8.5.0    8.6.0    1          -1
    10       8        0          1
    8        10       0          -1
    0.0.1.2  0.1.2    1          -1
} {
    test package-vsatisfies-1.$n {package vsatisfies} {
	package vsatisfies $p $r
    } $vs

    test package-vcompare-1.$n {package vcompare} {
	package vcompare $r $p
    } $vc

    incr n
}

test package-vcompare-2.0 {package vcompare at 32bit boundary} {
    package vcompare [expr {1<<31}] [expr {(1<<31)-1}]
} 1

# Note: It is correct that the result of the very first test,
# i.e. "5.0 5.0a0" is 1, i.e. that version 5.0a0 satisfies a 5.0
# requirement.

# The requirement "5.0" internally translates first to "5.0-6", and
# then to its final form of "5.0a0-6a0". These translations are
# explicitly specified by the TIP (Search for "padded/extended
# internally with 'a0'"). This was done intentionally for exactly the
# tested case, that an alpha package can satisfy a requirement for the
# regular package. An example would be a package FOO requiring Tcl 8.X
# for its operation. It can be used with Tcl 8.Xa0. Without our
# translation that would not be possible.

set n 0
foreach {required provided satisfied} {
    5.0 5.0a0 1
    5.0a0 5.0 1

    8.5a0-   8.5a5    1
    8.5a0-   8.5b1    1
    8.5a0-   8.5.1    1
    8.5a0-   8.6a0    1
    8.5a0-   8.6b0    1
    8.5a0-   8.6.0    1
    8.5a6-   8.5a5    0
    8.5a6-   8.5b1    1
    8.5a6-   8.5.1    1
    8.5a6-   8.6a0    1
    8.5a6-   8.6b0    1
    8.5a6-   8.6.0    1
    8.5b0-   8.5a5    0
    8.5b0-   8.5b1    1
    8.5b0-   8.5.1    1
    8.5b0-   8.6a0    1
    8.5b0-   8.6b0    1
    8.5b0-   8.6.0    1
    8.5b2-   8.5a5    0
    8.5b2-   8.5b1    0
    8.5b2-   8.5.1    1
    8.5b2-   8.6a0    1
    8.5b2-   8.6b0    1
    8.5b2-   8.6.0    1
    8.5-     8.5a5    1
    8.5-     8.5b1    1
    8.5-     8.5.1    1
    8.5-     8.6a0    1
    8.5-     8.6b0    1
    8.5-     8.6.0    1
    8.5.0-   8.5a5    0
    8.5.0-   8.5b1    0
    8.5.0-   8.5.1    1
    8.5.0-   8.6a0    1
    8.5.0-   8.6b0    1
    8.5.0-   8.6.0    1
    8.5a0-7  8.5a5    0
    8.5a0-7  8.5b1    0
    8.5a0-7  8.5.1    0
    8.5a0-7  8.6a0    0
    8.5a0-7  8.6b0    0
    8.5a0-7  8.6.0    0
    8.5a6-7  8.5a5    0
    8.5a6-7  8.5b1    0
    8.5a6-7  8.5.1    0
    8.5a6-7  8.6a0    0
    8.5a6-7  8.6b0    0
    8.5a6-7  8.6.0    0
    8.5b0-7  8.5a5    0
    8.5b0-7  8.5b1    0
    8.5b0-7  8.5.1    0
    8.5b0-7  8.6a0    0
    8.5b0-7  8.6b0    0
    8.5b0-7  8.6.0    0
    8.5b2-7  8.5a5    0
    8.5b2-7  8.5b1    0
    8.5b2-7  8.5.1    0
    8.5b2-7  8.6a0    0
    8.5b2-7  8.6b0    0
    8.5b2-7  8.6.0    0
    8.5-7    8.5a5    0
    8.5-7    8.5b1    0
    8.5-7    8.5.1    0
    8.5-7    8.6a0    0
    8.5-7    8.6b0    0
    8.5-7    8.6.0    0
    8.5.0-7  8.5a5    0
    8.5.0-7  8.5b1    0
    8.5.0-7  8.5.1    0
    8.5.0-7  8.6a0    0
    8.5.0-7  8.6b0    0
    8.5.0-7  8.6.0    0
    8.5a0-8.6.1 8.5a5    1
    8.5a0-8.6.1 8.5b1    1
    8.5a0-8.6.1 8.5.1    1
    8.5a0-8.6.1 8.6a0    1
    8.5a0-8.6.1 8.6b0    1
    8.5a0-8.6.1 8.6.0    1
    8.5a6-8.6.1 8.5a5    0
    8.5a6-8.6.1 8.5b1    1
    8.5a6-8.6.1 8.5.1    1
    8.5a6-8.6.1 8.6a0    1
    8.5a6-8.6.1 8.6b0    1
    8.5a6-8.6.1 8.6.0    1
    8.5b0-8.6.1 8.5a5    0
    8.5b0-8.6.1 8.5b1    1
    8.5b0-8.6.1 8.5.1    1
    8.5b0-8.6.1 8.6a0    1
    8.5b0-8.6.1 8.6b0    1
    8.5b0-8.6.1 8.6.0    1
    8.5b2-8.6.1 8.5a5    0
    8.5b2-8.6.1 8.5b1    0
    8.5b2-8.6.1 8.5.1    1
    8.5b2-8.6.1 8.6a0    1
    8.5b2-8.6.1 8.6b0    1
    8.5b2-8.6.1 8.6.0    1
    8.5-8.6.1 8.5a5    1
    8.5-8.6.1 8.5b1    1
    8.5-8.6.1 8.5.1    1
    8.5-8.6.1 8.6a0    1
    8.5-8.6.1 8.6b0    1
    8.5-8.6.1 8.6.0    1
    8.5.0-8.6.1 8.5a5    0
    8.5.0-8.6.1 8.5b1    0
    8.5.0-8.6.1 8.5.1    1
    8.5.0-8.6.1 8.6a0    1
    8.5.0-8.6.1 8.6b0    1
    8.5.0-8.6.1 8.6.0    1
    8.5a0-8.5a0 8.5a0    1
    8.5a0-8.5a0 8.5b1    0
    8.5a0-8.5a0 8.4      0
    8.5b0-8.5b0 8.5a5    0
    8.5b0-8.5b0 8.5b0    1
    8.5b0-8.5b0 8.5.1    0
    8.5-8.5  8.5a5    0
    8.5-8.5  8.5b1    0
    8.5-8.5  8.5      1
    8.5-8.5  8.5.1    0
    8.5.0-8.5.0 8.5a5    0
    8.5.0-8.5.0 8.5b1    0
    8.5.0-8.5.0 8.5.0    1
    8.5.0-8.5.0 8.5.1    0
    8.5.0-8.5.0 8.6a0    0
    8.5.0-8.5.0 8.6b0    0
    8.5.0-8.5.0 8.6.0    0
    8.2      9        0
    8.2-     9        1
    8.2-8.5  9        0
    8.2-9.1  9        1

    8.5-8.5     8.5b1 0
    8.5a0-8.5   8.5b1 0
    8.5a0-8.5.1 8.5b1 1

    8.5-8.5     8.5 1
    8.5.0-8.5.0 8.5 1
    8.5a0-8.5.0 8.5 0

} {
    test package-vsatisfies-2.$n "package vsatisfies $provided $required" {
	package vsatisfies $provided $required
    } $satisfied
    incr n
}

test package-vsatisfies-3.0 "package vsatisfies multiple" {
    #                      yes no
    package vsatisfies 8.4 8.4 7.3
} 1

test package-vsatisfies-3.1 "package vsatisfies multiple" {
    #                      no  yes
    package vsatisfies 8.4 7.3 8.4
} 1

test package-vsatisfies-3.2 "package vsatisfies multiple" {
    #                        yes  yes
    package vsatisfies 8.4.2 8.4  8.4.1
} 1

test package-vsatisfies-3.3 "package vsatisfies multiple" {
    #                      no  no
    package vsatisfies 8.4 7.3 6.1
} 0


proc prefer {args} {
    set ip [interp create]
    lappend res [$ip eval {package prefer}]
    foreach mode $args {
	lappend res [$ip eval [list package prefer $mode]]
    }
    interp delete $ip
    return $res
}

test package-prefer-1.0 {default} {
    prefer
} stable

test package-prefer-1.1 {default} {
    set   ::env(TCL_PKG_PREFER_LATEST) stable ; # value not relevant!
    set res [prefer]
    unset ::env(TCL_PKG_PREFER_LATEST)
    set res
} latest

test package-prefer-2.0 {wrong\#args} {
    catch {package prefer foo bar} msg
    set msg
} {wrong # args: should be "package prefer ?latest|stable?"}

test package-prefer-2.1 {bogus argument} {
    catch {package prefer foo} msg
    set msg
} {bad preference "foo": must be latest or stable}

test package-prefer-3.0 {set, keep} {
    package prefer stable
} stable

test package-prefer-3.1 {set stable, keep} {
    prefer stable
} {stable stable}

test package-prefer-3.2 {set latest, change} {
    prefer latest
} {stable latest}

test package-prefer-3.3 {set latest, keep} {
    prefer  latest latest
} {stable latest latest}

test package-prefer-3.4 {set stable, rejected} {
    prefer latest stable
} {stable latest latest}

rename prefer {}


set auto_path $oldPath
package unknown $oldPkgUnknown
concat

cleanupTests
}

# cleanup
interp delete $i
::tcltest::cleanupTests
return

Deleted tests/pkgIndex.tcl.

1
2
3



-
-
-
#! /usr/bin/env tclsh

package ifneeded tcltests 0.1 [list source $dir/tcltests.tcl]

Changes to tests/pkgMkIndex.test.

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
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




-
-
+
+

-
+


-
-
-
-
+
+
+
-

+










-
-
+
+







# This file contains tests for the pkg_mkIndex command.
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
package require tcltest 2
namespace import ::tcltest::*


set fullPkgPath [makeDirectory pkg]


namespace eval pkgtest {
    # Namespace for procs we can discard
}

# pkgtest::parseArgs --
#
#  Parse an argument list.
#
# Arguments:
#  <flags>	(optional) arguments starting with a dash are collected as
#		options to pkg_mkIndex and passed to pkg_mkIndex.
#  <flags>	(optional) arguments starting with a dash are collected
#		as options to pkg_mkIndex and passed to pkg_mkIndex.
#  dirPath	the directory to index
#  pattern0	pattern to index
#  ...		pattern to index
#  patternN	pattern to index
#
# Results:
#  Returns a three element list:
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
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







-
+

-
+

-
+














-
-
-
-
-
+
+
+
+
+





-
+











-
+




-
+






-
-
-
+
+
+


-
-
+
+







#
# Results:
#  Returns a list, in "array set/get" format, where the keys are the package
#  name and version (in the form "$name:$version"), and the values the rest
#  of the command line.

proc pkgtest::parseIndex { filePath } {
    # create a child interpreter, where we override "package ifneeded"
    # create a slave interpreter, where we override "package ifneeded"

    set child [interp create]
    set slave [interp create]
    if {[catch {
	$child eval {
	$slave eval {
	    rename package package_original
	    proc package { args } {
		if {[lindex $args 0] eq "ifneeded"} {
		    set pkg [lindex $args 1]
		    set ver [lindex $args 2]
		    set ::PKGS($pkg:$ver) [lindex $args 3]
		} else {
		    return [package_original {*}$args]
		}
	    }
	    array set ::PKGS {}
	}

	set dir [file dirname $filePath]
	$child eval {set curdir [pwd]}
	$child eval [list cd $dir]
	$child eval [list set dir $dir]
	$child eval [list source [file tail $filePath]]
	$child eval {cd $curdir}
	$slave eval {set curdir [pwd]}
	$slave eval [list cd $dir]
	$slave eval [list set dir $dir]
	$slave eval [list source [file tail $filePath]]
	$slave eval {cd $curdir}

	# Create the list in sorted order, so that we don't get spurious
	# errors because the order has changed.

	array set P {}
	foreach {k v} [$child eval {array get ::PKGS}] {
	foreach {k v} [$slave eval {array get ::PKGS}] {
	    set P($k) $v
	}

	set PKGS ""
	foreach k [lsort [array names P]] {
	    lappend PKGS $k $P($k)
	}
    } err opts]} {
	set ei [dict get $opts -errorinfo]
	set ec [dict get $opts -errorcode]

	catch {interp delete $child}
	catch {interp delete $slave}

	error $ei $ec
    }

    interp delete $child
    interp delete $slave

    return $PKGS
}

# pkgtest::createIndex --
#
#  Runs pkg_mkIndex for the given directory and set of patterns.  This
#  procedure deletes any pkgIndex.tcl file in the target directory, then runs
#  pkg_mkIndex.
#  Runs pkg_mkIndex for the given directory and set of patterns.
#  This procedure deletes any pkgIndex.tcl file in the target directory,
#  then runs pkg_mkIndex.
#
# Arguments:
#  <flags>	(optional) arguments starting with a dash are collected as
#		options to pkg_mkIndex and passed to pkg_mkIndex.
#  <flags>	(optional) arguments starting with a dash are collected
#		as options to pkg_mkIndex and passed to pkg_mkIndex.
#  dirPath	the directory to index
#  pattern0	pattern to index
#  ...		pattern to index
#  patternN	pattern to index
#
# Results:
#  Returns a two element list:
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
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







+



+
















-
-
+
+









-
+
+











-
+











-
-
-
+
+
+







	switch [lindex $v 0] {
	    tclPkgSetup {
		set l tclPkgSetup
		foreach s [lindex $v 4] {
		    lappend l $s
		}
	    }

	    source {
		set l $v
	    }

	    default {
		error "can't handle $k $v"
	    }
	}

	lappend pkgList [list $k $l]
    }

    return $pkgList
}

# pkgtest::runIndex --
#
#  Runs pkg_mkIndex, parses the generated index file.
#
# Arguments:
#  <flags>	(optional) arguments starting with a dash are collected as
#		options to pkg_mkIndex and passed to pkg_mkIndex.
#  <flags>	(optional) arguments starting with a dash are collected
#		as options to pkg_mkIndex and passed to pkg_mkIndex.
#  dirPath	the directory to index
#  pattern0	pattern to index
#  ...		pattern to index
#  patternN	pattern to index
#
# Results:
#  Returns a two element list:
#    0: 1 if the procedure encountered an error, 0 otherwise.
#    1: if no error, this is the parsed generated index file, in the format
#	returned by pkgtest::parseIndex.  If error, this is the error result.
#	returned by pkgtest::parseIndex.
#	If error, this is the error result.

proc pkgtest::runCreatedIndex {rv args} {
    if {[lindex $rv 0] == 0} {
	set parsed [parseArgs {*}$args]
	set dirPath [lindex $parsed 1]
	set idxFile [file join $dirPath pkgIndex.tcl]

	if {[catch {
	    set result [list 0 [makePkgList [parseIndex $idxFile]]]
	} err]} {
	    set result [list 1 $err]
	}
	} 
	file delete $idxFile
    } else {
	set result $rv
    }

    return $result
}
proc pkgtest::runIndex { args } {
    set rv [createIndex {*}$args]
    return [runCreatedIndex $rv {*}$args]
}

# If there is no match to the patterns, make sure the directory hasn't changed
# on us

# If there is no match to the patterns, make sure the directory hasn't
# changed on us

test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
    list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd]
} [list {1 {no files matched glob pattern "nomatch.tcl"}} [pwd]]

makeFile {
#  This is a simple package, just to check basic functionality.
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
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







-
-
+
+











-
-
+
+


















-
-
+
+


















-
-
-
+
+
+







    pkgtest::runIndex -lazy $fullPkgPath global.tcl
} {0 {{global:1.0 {tclPkgSetup {global.tcl source {global_lower global_upper}}}}}}

removeFile [file join pkg global.tcl]

makeFile {
#  This package is required by pkg1.
#  This package is split into two files, to test packages that are split over
#  multiple files.
#  This package is split into two files, to test packages that are split
#  over multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
    namespace export p2-1
}
proc pkg2::p2-1 { num } {
    return [expr $num * 2]
}
} [file join pkg pkg2_a.tcl]

makeFile {
#  This package is required by pkg1.
#  This package is split into two files, to test packages that are split over
#  multiple files.
#  This package is split into two files, to test packages that are split
#  over multiple files.
package provide pkg2 1.0
namespace eval pkg2 {
    namespace export p2-2
}
proc pkg2::p2-2 { num } {
    return [expr $num * 3]
}
} [file join pkg pkg2_b.tcl]

test pkgMkIndex-4.1 {split package} {
    pkgtest::runIndex -lazy $fullPkgPath pkg2_a.tcl pkg2_b.tcl
} {0 {{pkg2:1.0 {tclPkgSetup {pkg2_a.tcl source ::pkg2::p2-1} {pkg2_b.tcl source ::pkg2::p2-2}}}}}

test pkgMkIndex-4.2 {split package - direct loading} {
    pkgtest::runIndex -direct $fullPkgPath pkg2_a.tcl pkg2_b.tcl
} "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]]
[list source [file join $fullPkgPath pkg2_b.tcl]]}}}"

# Add the direct1 directory to auto_path, so that the direct1 package can be
# found.
# Add the direct1 directory to auto_path, so that the direct1 package 
# can be found.
set direct1 [makeDirectory direct1]
lappend auto_path $direct1
makeFile {
#  This is referenced by pkgIndex.tcl as a -direct script.
package provide direct1 1.0
namespace eval direct1 {
    namespace export pd1 pd2
}
proc direct1::pd1 { stg } {
    return [string tolower $stg]
}
proc direct1::pd2 { stg } {
    return [string toupper $stg]
}
} [file join direct1 direct1.tcl]
pkg_mkIndex -direct $direct1 direct1.tcl

makeFile {
#  Does a package require of direct1, whose pkgIndex.tcl entry is created
#  above with option -direct.  This tests that pkg_mkIndex can handle code
#  that is sourced in pkgIndex.tcl files.
#  Does a package require of direct1, whose pkgIndex.tcl entry
#  is created above with option -direct.  This tests that pkg_mkIndex
#  can handle code that is sourced in pkgIndex.tcl files.
package require direct1
package provide std 1.0
namespace eval std {
    namespace export p1 p2
}
proc std::p1 { stg } {
    return [string tolower $stg]
383
384
385
386
387
388
389
390
391
392



393
394
395
396
397
398
399
385
386
387
388
389
390
391



392
393
394
395
396
397
398
399
400
401







-
-
-
+
+
+








removeFile [file join direct1 direct1.tcl]
file delete [file join $direct1 pkgIndex.tcl]
removeDirectory direct1
removeFile [file join pkg std.tcl]

makeFile {
#  This package requires pkg3, but it does not use any of pkg3's procs in the
#  code that is executed by the file (i.e. references to pkg3's procs are in
#  the proc bodies only).
#  This package requires pkg3, but it does
#  not use any of pkg3's procs in the code that is executed by the file
#  (i.e. references to pkg3's procs are in the proc bodies only).
package require pkg3 1.0
package provide pkg1 1.0
namespace eval pkg1 {
    namespace export p1-1 p1-2
}
proc pkg1::p1-1 { num } {
    return [pkg3::p3-1 $num]
423
424
425
426
427
428
429
430
431


432
433
434
435
436
437
438
425
426
427
428
429
430
431


432
433
434
435
436
437
438
439
440







-
-
+
+







test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
    pkgtest::runIndex -direct $fullPkgPath pkg1.tcl pkg3.tcl
} "0 {{pkg1:1.0 {[list source [file join $fullPkgPath pkg1.tcl]]}} {pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}}}"

removeFile [file join pkg pkg1.tcl]

makeFile {
#  This package requires pkg3, and it calls a pkg3 proc in the code that is
#  executed by the file
#  This package requires pkg3, and it calls
#  a pkg3 proc in the code that is executed by the file
package require pkg3 1.0
package provide pkg4 1.0
namespace eval pkg4 {
    namespace export p4-1 p4-2
    variable m2 [pkg3::p3-1 10]
}
proc pkg4::p4-1 { num } {
452
453
454
455
456
457
458
459
460



461
462
463
464
465
466
467
454
455
456
457
458
459
460


461
462
463
464
465
466
467
468
469
470







-
-
+
+
+







    pkgtest::runIndex -direct $fullPkgPath pkg4.tcl pkg3.tcl
} "0 {{pkg3:1.0 {[list source [file join $fullPkgPath pkg3.tcl]]}} {pkg4:1.0 {[list source [file join $fullPkgPath pkg4.tcl]]}}}"

removeFile [file join pkg pkg4.tcl]
removeFile [file join pkg pkg3.tcl]

makeFile {
#  This package requires pkg2, and it calls a pkg2 proc in the code that is
#  executed by the file.  Pkg2 is a split package.
#  This package requires pkg2, and it calls
#  a pkg2 proc in the code that is executed by the file.
#  Pkg2 is a split package.
package require pkg2 1.0
package provide pkg5 1.0
namespace eval pkg5 {
    namespace export p5-1 p5-2
    variable m2 [pkg2::p2-1 10]
    variable m3 [pkg2::p2-2 10]
}
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
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







-
-
+
+
+
-




















-
-
+
+














-
-
+
+







[list source [file join $fullPkgPath pkg2_b.tcl]]}} {pkg5:1.0 {[list source [file join $fullPkgPath pkg5.tcl]]}}}"

removeFile [file join pkg pkg5.tcl]
removeFile [file join pkg pkg2_a.tcl]
removeFile [file join pkg pkg2_b.tcl]

makeFile {
#  This package requires circ2, and circ2 requires circ3, which in turn
#  requires circ1.  In case of cirularities, pkg_mkIndex should give up when
#  This package requires circ2, and circ2
#  requires circ3, which in turn requires circ1.
#  In case of cirularities, pkg_mkIndex should give up when it gets stuck.
#  it gets stuck.
package require circ2 1.0
package provide circ1 1.0
namespace eval circ1 {
    namespace export c1-1 c1-2 c1-3 c1-4
}
proc circ1::c1-1 { num } {
    return [circ2::c2-1 $num]
}
proc circ1::c1-2 { num } {
    return [circ2::c2-2 $num]
}
proc circ1::c1-3 {} {
    return 10
}
proc circ1::c1-4 {} {
    return 20
}
} [file join pkg circ1.tcl]

makeFile {
#  This package is required by circ1, and requires circ3. Circ3, in turn,
#  requires circ1 to give us a circularity.
#  This package is required by circ1, and
#  requires circ3. Circ3, in turn, requires circ1 to give us a circularity.
package require circ3 1.0
package provide circ2 1.0
namespace eval circ2 {
    namespace export c2-1 c2-2
}
proc circ2::c2-1 { num } {
    return [expr $num * [circ3::c3-1]]
}
proc circ2::c2-2 { num } {
    return [expr $num * [circ3::c3-2]]
}
} [file join pkg circ2.tcl]

makeFile {
#  This package is required by circ2, and in turn requires circ1. This closes
#  the circularity.
#  This package is required by circ2, and in
#  turn requires circ1. This closes the circularity.
package require circ1 1.0
package provide circ3 1.0
namespace eval circ3 {
    namespace export c3-1 c3-4
}
proc circ3::c3-1 {} {
    return [circ1::c1-3]
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
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







-
-
+
+









-
-
-
+
+
+



-
+

-
-
-
+
+
+


-
-
-
-
+
+
+







set x [file join [file dirname [info nameofexecutable]] dltest \
	pkga[info sharedlibextension]]
set dll "[file tail $x]Required"
testConstraint $dll [file exists $x]

if {[testConstraint $dll]} {
    makeFile {
#  This package provides Pkga, which is also provided by a DLL.
package provide Pkga 1.0
#  This package provides pkga, which is also provided by a DLL.
package provide pkga 1.0
proc pkga_neq { x } {
    return [expr {! [pkgq_eq $x]}]
}
} [file join pkg pkga.tcl]
    file copy -force $x $fullPkgPath
}
testConstraint exec [llength [info commands ::exec]]

test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
    # Do all [load]ing of shared libraries in another process, so we can
    # delete the file and not get stuck because we're holding a reference to
    # it.
    # Do all [load]ing of shared libraries in another process, so 
    # we can delete the file and not get stuck because we're holding
    # a reference to it.
    set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
    exec [interpreter] << $cmd
    pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
    # Do all [load]ing of shared libraries in another process, so we can
    # delete the file and not get stuck because we're holding a reference to
    # it.
    # Do all [load]ing of shared libraries in another process, so 
    # we can delete the file and not get stuck because we're holding
    # a reference to it.
    #
    # This test depends on context from prior test, so repeat it.
    set script \
	"[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]"
    append script \n \
	"[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
    set script "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]\n"
    append script \
	    "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
    exec [interpreter] << $script
    pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
} {0 {}}

if {[testConstraint $dll]} {
    file delete -force [file join $fullPkgPath [file tail $x]]
    removeFile [file join pkg pkga.tcl]
615
616
617
618
619
620
621
622
623



624
625
626
627
628
629
630
617
618
619
620
621
622
623


624
625
626
627
628
629
630
631
632
633







-
-
+
+
+








test pkgMkIndex-11.1 {conflicting namespace imports} {
    pkgtest::runIndex -lazy $fullPkgPath import.tcl
} {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}}

removeFile [file join pkg import.tcl]

# Verify that the auto load list generated is correct even when there is a
# proc name conflict between two namespaces (ie, ::foo::baz and ::bar::baz)
# Verify that the auto load list generated is correct even when there
# is a proc name conflict between two namespaces (ie, ::foo::baz and
# ::bar::baz)

makeFile {
package provide football 1.0
namespace eval ::pro:: {
    #
    # export only public functions.
    #
681
682
683
684
685
686
687
688

689
690
691
692
693
694
695
696
697
698
699
700
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698
699











-
+








-
-
-
-
} 1
test pkgMkIndex-14.5 {tcl::Pkg::CompareExtension} {unix} {
    tcl::Pkg::CompareExtension foo .so
} 0
test pkgMkIndex-14.6 {tcl::Pkg::CompareExtension} {unix} {
    tcl::Pkg::CompareExtension foo.so.1.2.bar .so
} 0


# cleanup

removeDirectory pkg

namespace delete pkgtest
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/platform.test.

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
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











-
+






-
-
+
-

-
-
-
-

-












-
+

+
+
+
+
-
-
-
+
+
+
+
+
+





-
+




-
+








-
+
-
-
-







# The file tests the tcl_platform variable and platform package.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 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.

package require tcltest 2.5
package require tcltest 2

namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]

test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)
} {Tcl}

test platform-1.1 {TclpSetVariables: tcl_platform} {
    interp create i
    i eval {catch {unset tcl_platform(debug)}}
    i eval {catch {unset tcl_platform(threaded)}}
    set result [i eval {lsort [array names tcl_platform]}]
    interp delete i
    set result
} {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize}
} {byteOrder engine machine os osVersion platform pointerSize user wordSize}

# Test assumes twos-complement arithmetic, which is true of virtually
# everything these days.  Note that this does *not* use wide(), and
# this is intentional since that could make Tcl's numbers wider than
# the machine-integer on some platforms...
test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize {
    expr {$tcl_platform(wordSize) == [testlongsize]}
} {1}
test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
    set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}]
    # Result must be the largest bit in a machine word, which this checks
    # without assuming how wide the word really is
    list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
} {1 -1}

# On Windows/UNIX, test that the CPU ID works

test platform-3.1 {CPU ID on Windows/UNIX} \
    -constraints testCPUID \
    -body {
    -body {		
	set cpudata [testcpuid 0]
	binary format iii \
	    [lindex $cpudata 1] \
	    [lindex $cpudata 3] \
	    [lindex $cpudata 2]
	    [lindex $cpudata 2] 
    } \
    -match regexp \
    -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}

# The platform package makes very few promises, but does promise that the
# format of string it produces consists of two non-empty words separated by a
# hyphen.
package require platform
test platform-4.1 {format of platform::identify result} -constraints notValgrind -match regexp -body {
test platform-4.1 {format of platform::identify result} -match regexp -body {
    # [identify] may attempt to [exec] dpkg-architecture, which may not exist,
    # in which case fork will not be followed by exec, and valgrind will issue
    # "still reachable" reports.
    platform::identify
} -result {^([^-]+-)+[^-]+$}
test platform-4.2 {format of platform::generic result} -match regexp -body {
    platform::generic
} -result {^([^-]+-)+[^-]+$}

# cleanup

Changes to tests/proc-old.test.

10
11
12
13
14
15
16
17
18


19
20
21
22
23
24
25
10
11
12
13
14
15
16


17
18
19
20
21
22
23
24
25







-
-
+
+







# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

catch {rename t1 ""}
catch {rename foo ""}

proc tproc {} {return a; return b}
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241
227
228
229
230
231
232
233

234
235
236
237
238
239
240
241







-
+







    tproc 2
} {2 y-default {}}
test proc-old-30.12 {arguments and defaults} {
    proc tproc {x {y y-default} args} {
	return [list $x $y $args]
    }
    list [catch {tproc} msg] $msg
} {1 {wrong # args: should be "tproc x ?y? ?arg ...?"}}
} {1 {wrong # args: should be "tproc x ?y? ..."}}

test proc-old-4.1 {variable numbers of arguments} {
    proc tproc args {return $args}
    tproc
} {}
test proc-old-4.2 {variable numbers of arguments} {
    proc tproc args {return $args}
252
253
254
255
256
257
258
259

260
261
262
263
264
265
266
252
253
254
255
256
257
258

259
260
261
262
263
264
265
266







-
+







test proc-old-4.5 {variable numbers of arguments} {
    proc tproc {x y args} {return $args}
    tproc 1 2
} {}
test proc-old-4.6 {variable numbers of arguments} {
    proc tproc {x missing args} {return $args}
    list [catch {tproc 1} msg] $msg
} {1 {wrong # args: should be "tproc x missing ?arg ...?"}}
} {1 {wrong # args: should be "tproc x missing ..."}}

test proc-old-5.1 {error conditions} {
    list [catch {proc} msg] $msg
} {1 {wrong # args: should be "proc name args body"}}
test proc-old-5.2 {error conditions} {
    list [catch {proc tproc b} msg] $msg
} {1 {wrong # args: should be "proc name args body"}}
278
279
280
281
282
283
284



285
286
287
288
289
290
291
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294







+
+
+







} {1 {argument with no name}}
test proc-old-5.7 {error conditions} {
    list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg
} {1 {too many fields in argument specifier "x 1 2"}}
test proc-old-5.8 {error conditions} {
    catch {return}
} 2
test proc-old-5.9 {error conditions} {
    list [catch {global} msg] $msg
} {1 {wrong # args: should be "global varName ?varName ...?"}}
proc tproc {} {
    set a 22
    global a
}
test proc-old-5.10 {error conditions} {
    list [catch {tproc} msg] $msg
} {1 {variable "a" already exists}}
402
403
404
405
406
407
408
409
410
411
412
413
414






415
416
417
418
419
420
421
405
406
407
408
409
410
411






412
413
414
415
416
417
418
419
420
421
422
423
424







-
-
-
-
-
-
+
+
+
+
+
+







} {3 abc}
test proc-old-7.5 {return with special completion code} {
    list [catch {tproc continue} msg] $msg
} {4 abc}
test proc-old-7.6 {return with special completion code} {
    list [catch {tproc -14} msg] $msg
} {-14 abc}
test proc-old-7.7 {return with special completion code} -body {
    tproc err
} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
test proc-old-7.8 {return with special completion code} -body {
    tproc 10b
} -returnCodes error -match glob -result {bad completion code "10b": must be ok, error, return, break, continue*, or an integer}
test proc-old-7.7 {return with special completion code} {
    list [catch {tproc gorp} msg] $msg
} {1 {bad completion code "gorp": must be ok, error, return, break, continue, or an integer}}
test proc-old-7.8 {return with special completion code} {
    list [catch {tproc 10b} msg] $msg
} {1 {bad completion code "10b": must be ok, error, return, break, continue, or an integer}}
test proc-old-7.9 {return with special completion code} {
    proc tproc2 {} {
	tproc return
    }
    list [catch tproc2 msg] $msg
} {0 abc}
test proc-old-7.10 {return with special completion code} {

Changes to tests/proc.test.

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

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





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
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





-
-
-
-
-
+
+
+
+
+

-
-
+
+




-
-
+
+

-
-
+
+



+
-
-
+
+
+
+
+
+





-
-
+
+

-









-
-
+
+

-
-
-
-
+
+
+

-





-
+


-
+

-









-
-
+
+

-









-
-
+
+

-











-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
-
-
-
-
-
+
-
-
-
-
-
+


-


-
-
+
+

-






-
-
+
+

-





-
-
+
+


-


-
+

-
+

-


-
-
+
+

-




-
-
+
+


-




-
-
+
+


-





-
-
+
+

+
+
-
+
-
-
+

-
-
+
+
















-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+


+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
+
+


+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
+
+


+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+


+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
+
+


+
-
+











+


+

+








-
-
-

-
+










-
+
-


+
-
+

-
+


-
+
-


-
+
+









+
-
+





-
+
-

+
+
-
-
+
+











-
+
-

-
+
+




-
-
-
+
+
+



-
-
-
-
-
-

-





-
-
-
-
-
# This file contains tests for the tclProc.c source file. Tests appear in the
# same order as the C code that they test. The set of tests is currently
# incomplete since it includes only new tests, in particular tests for code
# changed for the addition of Tcl namespaces. Other procedure-related tests
# appear in other test files such as proc-old.test.
# This file contains tests for the tclProc.c source file. Tests appear in
# the same order as the C code that they test. The set of tests is
# currently incomplete since it includes only new tests, in particular
# tests for code changed for the addition of Tcl namespaces. Other
# procedure-related tests appear in other test files such as proc-old.test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

if {[catch {package require procbodytest}]} {
testConstraint procbodytest [expr {![catch {package require procbodytest}]}]
testConstraint memory	    [llength [info commands memory]]
    testConstraint procbodytest 0
} else {
    testConstraint procbodytest 1
}

testConstraint memory     [llength [info commands memory]]

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}
catch {unset msg}

test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} -setup {

test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        namespace eval baz {}
    }
    proc test_ns_1::baz::p {} {
        return "p in [namespace current]"
    }
    list [test_ns_1::baz::p] \
         [namespace eval test_ns_1 {baz::p}] \
         [info commands test_ns_1::baz::*]
} -result {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} -setup {
} {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
    proc test_ns_1::baz::p {} {}
} -result {can't create procedure "test_ns_1::baz::p": unknown namespace}
test proc-1.3 {Tcl_ProcObjCmd, empty proc name} -setup {
    list [catch {proc test_ns_1::baz::p {} {}} msg] $msg
} {1 {can't create procedure "test_ns_1::baz::p": unknown namespace}}
test proc-1.3 {Tcl_ProcObjCmd, empty proc name} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    proc :: {} {
        return "empty called"
    }
    list [::] \
         [info body {}]
} -result {{empty called} {
} {{empty called} {
        return "empty called"
    }}
test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} -setup {
test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        namespace eval baz {
            proc p {} {
                return "p in [namespace current]"
            }
        }
    }
    list [test_ns_1::baz::p] \
         [info commands test_ns_1::baz::*]
} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} -setup {
} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1::baz {}
    namespace eval test_ns_1 {
        proc baz::p {} {
            return "p in [namespace current]"
        }
    }
    list [test_ns_1::baz::p] \
         [info commands test_ns_1::baz::*] \
         [namespace eval test_ns_1::baz {namespace which p}]
} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} -setup {
} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        proc q: {} {return "q:"}
        proc value:at: {} {return "value:at:"}
    }
    list [namespace eval test_ns_1 {q:}] \
         [namespace eval test_ns_1 {value:at:}] \
         [test_ns_1::q:] \
         [test_ns_1::value:at:] \
         [lsort [info commands test_ns_1::*]] \
         [namespace eval test_ns_1 {namespace which q:}] \
         [namespace eval test_ns_1 {namespace which value:at:}]
} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
} {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} {
    catch {rename p ""}
} -returnCodes error -body {
    proc p {a(1) a(2)} {
	set z [expr $a(1)+$a(2)]
	puts "$z=z, $a(1)=$a(1)"
    }
} -result {formal parameter "a(1)" is an array element}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
    list [catch {proc p {a(1) a(2)} { 
            set z [expr $a(1)+$a(2)]
            puts "$z=z, $a(1)=$a(1)"
        }} msg] $msg
} {1 {formal parameter "a(1)" is an array element}}
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} {
    catch {rename p ""}
} -body {
    proc p {b:a b::a} {
    }
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
    list [catch {proc p {b:a b::a} { 
    }} msg] $msg
} {1 {formal parameter "b::a" is not a simple name}}
test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body {
    set v 2
    binary scan AB cc a b
    proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}}
    p

} -result [expr {65+66+4}] -cleanup {
   rename p {}
}

test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "p in [namespace current]"}
    info body p
} -result {return "p in [namespace current]"}
test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} -setup {
} {return "p in [namespace current]"}
test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1 {
        namespace eval baz {
            proc p {} {return "p in [namespace current]"}
        }
    }
    namespace eval test_ns_1::baz {info body p}
} -result {return "p in [namespace current]"}
test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} -setup {
} {return "p in [namespace current]"}
test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1::baz {}
    namespace eval test_ns_1 {
        proc baz::p {} {return "p in [namespace current]"}
    }
    namespace eval test_ns_1 {info body baz::p}
} -result {return "p in [namespace current]"}
test proc-2.4 {TclFindProc, global proc and executing in namespace} -setup {
} {return "p in [namespace current]"}
test proc-2.4 {TclFindProc, global proc and executing in namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "global p"}
    namespace eval test_ns_1::baz {info body p}
} -result {return "global p"}
} {return "global p"}

test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} -setup {
test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    proc p {} {return "p in [namespace current]"}
    p
} -result {p in ::}
test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} -setup {
} {p in ::}
test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_1::baz {
        proc p {} {return "p in [namespace current]"}
        p
    }
} -result {p in ::test_ns_1::baz}
test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} -setup {
} {p in ::test_ns_1::baz}
test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    proc p {} {return "p in [namespace current]"}
    namespace eval test_ns_1::baz {
        p
    }
} -result {p in ::}
test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} -setup {
} {p in ::}
test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename p ""}
} -body {
    namespace eval test_ns_1::baz {
        proc p {} {return "p in [namespace current]"}
        rename ::test_ns_1::baz::p ::p
        list [p] [namespace which p]
    }
} -result {{p in ::} ::p}
test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} -body {
} {{p in ::} ::p}
test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} {
    proc p {x} {info commands 3m}
    list [catch {p} msg] $msg
} {1 {wrong # args: should be "p x"}}
    p

} -returnCodes error -result {wrong # args: should be "p x"}
test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} -body {
test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} {
    proc {a b  c} {x} {info commands 3m}
    {a b  c}
} -returnCodes error -result {wrong # args: should be "{a b  c} x"}
    list [catch {{a b  c}} msg] $msg
} {1 {wrong # args: should be "{a b  c} x"}}

test proc-3.7 {TclObjInterpProc, wrong num args, Bug 3366265} {
    proc {} {x} {}
    list [catch {{}} msg] $msg
} {1 {wrong # args: should be "{} x"}}

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}
catch {rename {a b  c} {}}
catch {unset msg}

catch {rename p ""}
catch {rename t ""}

# Note that the test require that procedures whose body is used to create
# procbody objects must be executed before the procbodytest::proc command is
# executed, so that the Proc struct is populated correctly (CompiledLocals are
# added at compile time).
# procbody objects must be executed before the procbodytest::proc command
# is executed, so that the Proc struct is populated correctly (CompiledLocals
# are added at compile time).

test proc-4.1 {TclCreateProc, procbody obj} -constraints procbodytest -body {
    proc p x {return "$x:$x"}
    set rv [p P]
    procbodytest::proc t x p
    lappend rv [t T]
} -cleanup {
test proc-4.1 {TclCreateProc, procbody obj} procbodytest {
    catch {
	proc p x {return "$x:$x"}
	set rv [p P]
	procbodytest::proc t x p
	lappend rv [t T]
	set rv
    } result
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {P:P T:T}
test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body {
    proc p x {
	set y [string tolower $x]
	return "$x:$y"
    }
    set rv [p P]
    procbodytest::proc t x p
    lappend rv [t T]
} -constraints procbodytest -cleanup {
} {P:P T:T}
test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} procbodytest {
    catch {
	proc p x {
	    set y [string tolower $x]
	    return "$x:$y"
	}
	set rv [p P]
	procbodytest::proc t x p
	lappend rv [t T]
	set rv
    } result
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {P:p T:t}
test proc-4.3 {TclCreateProc, procbody obj, too many args} -body {
    proc p x {
	set y [string tolower $x]
	return "$x:$y"
    }
    set rv [p P]
    procbodytest::proc t {x x1 x2} p
    lappend rv [t T]
} {P:p T:t}
test proc-4.3 {TclCreateProc, procbody obj, too many args} procbodytest {
    catch {
	proc p x {
	    set y [string tolower $x]
	    return "$x:$y"
	}
	set rv [p P]
	procbodytest::proc t {x x1 x2} p
	lappend rv [t T]
} -constraints procbodytest -returnCodes error -cleanup {
	set rv
    } result
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {procedure "t": arg list contains 3 entries, precompiled header expects 1}
test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body {
    proc p {x y z} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x x1 z} p
    lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
} {procedure "t": arg list contains 3 entries, precompiled header expects 1}
test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} procbodytest {
    catch {
	proc p {x y z} {
	    set v [join [list $x $y $z]]
	    set w [string tolower $v]
	    return "$v:$w"
	}
	set rv [p P Q R]
	procbodytest::proc t {x x1 z} p
	lappend rv [t S T U]
	set rv
    } result
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {procedure "t": formal parameter 1 is inconsistent with precompiled body}
test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
    proc p {x y {z Z}} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x y z} p
    lappend rv [t S T U]
} {procedure "t": formal parameter 1 is inconsistent with precompiled body}
test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} procbodytest {
    catch {
	proc p {x y {z Z}} {
	    set v [join [list $x $y $z]]
	    set w [string tolower $v]
	    return "$v:$w"
	}
	set rv [p P Q R]
	procbodytest::proc t {x y z} p
	lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
	set rv
    } result
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
    proc p {x y z} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x y {z Z}} p
    lappend rv [t S T U]
} -returnCodes error -constraints procbodytest -cleanup {
} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} procbodytest {
    catch {
	proc p {x y z} {
	    set v [join [list $x $y $z]]
	    set w [string tolower $v]
	    return "$v:$w"
	}
	set rv [p P Q R]
	procbodytest::proc t {x y {z Z}} p
	lappend rv [t S T U]
	set rv
    } result
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -body {
    proc p {x y {z Z}} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x y {z ZZ}} p
    lappend rv [t S T U]
} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} procbodytest {
    catch {
	proc p {x y {z Z}} {
	    set v [join [list $x $y $z]]
	    set w [string tolower $v]
	    return "$v:$w"
	}
	set rv [p P Q R]
	procbodytest::proc t {x y {z ZZ}} p
	lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
	set rv
    } result
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -setup {
    proc getbytes {} {
	set lines [split [memory info] "\n"]
	lindex $lines 3 3
    }
    proc px x {
	set y [string tolower $x]
	return "$x:$y"
    }
    px x
} -constraints {procbodytest memory} -body {

    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {

	procbodytest::proc tx x px

	set tmp $end
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    rename getbytes {}
    unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} procbodytest {
    procbodytest::check
} 1

test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} {
    proc p args {} ; # this will be bytecompiled into t
    proc t {} {
	set res {}
	set a 0
	set b 0
	trace add variable a read {append res a ;#}
	trace add variable b write {append res b ;#}
	p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello
	set res
    }
    t
    set result [t]
} -cleanup {
    catch {rename p ""}
    catch {rename t ""}
    set result
} -result {aba}
} {aba}    

test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body {
test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} {
    proc a {} {return -code -5}
    proc b {} a
    catch b
    set result [catch b]
} -cleanup {
    rename a {}
    rename b {}
} -result -5
    set result
} -5

test proc-7.1 {Redefining a compiled cmd: Bug 729692} {
    proc bar args {}
    proc foo {} {
	proc bar args {return bar}
	bar
    }
    foo
} bar

test proc-7.2 {Shadowing a compiled cmd: Bug 729692} -body {
test proc-7.2 {Shadowing a compiled cmd: Bug 729692} {
    namespace eval ugly {}
    proc ugly::foo {} {
	proc set args {return bar}
	set x 1
    }
    ugly::foo
    set res [list [catch {ugly::foo} msg] $msg]
} -cleanup {
    namespace delete ugly
    set res
} {0 bar}
} -result bar
test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body {

test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} {
    namespace eval ugly {}
    proc ugly::foo {} {
	set i 0
	while { 1 } {
	    if { [incr i] > 3 } {
		proc continue {} {return -code break}
	    }
	    continue
	}
	return $i
    }
    ugly::foo
    set res [list [catch {ugly::foo} msg] $msg]
} -cleanup {
    namespace delete ugly
} -result 4
    set res
} {0 4}

test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
    set lambda x
    lappend lambda {set a 1}
    interp create child
    child eval [list apply $lambda foo]
    interp delete child
    interp create slave
    slave eval [list apply $lambda foo]
    interp delete slave
    unset lambda
} {}

test proc-7.5 {[631b4c45df] Crash in argument processing} {
    binary scan A c val
    proc foo [list  [list from $val]] {}
    rename foo {}
    unset -nocomplain val
} {}


# cleanup
catch {rename p ""}
catch {rename t ""}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Deleted tests/process.test.

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





















































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# process.test --
#
# This file contains a collection of tests for the tcl::process ensemble.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 2017 Frederic Bonnet
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# Utilities
file delete [set path(test-signalfile)  [makeFile {} test-signalfile]]
set path(test-signalfile2) [makeFile {} test-signalfile2]
# $path(sleep) time ?filename? -- sleep for time (in ms) and stop if it gets signaled (file gets deleted)
set path(sleep) [makeFile {
    after [expr {[lindex $argv 0]*1000}] {set stop 1}
    if {[set fn [lindex $::argv 1]] ne ""} {
	close [open $fn w]
	proc check {} {
	    if {![file exists $::fn]} { # exit signaled
		after 10 {set ::stop 2}
	    }
	    after 10 check
	}
	after 10 check
    }
    vwait stop
    exit
} sleep]

proc wait_for_file {fn {timeout 10000}} {
    if {![file exists $fn]} {
	set toev [after $timeout {set found 0}]
	proc check {fn} {
	    if {[file exists $fn]} {
		set ::found 1
		return
	    }
	    after 10 [list check $fn]
	}
	after 10 [list check $fn]
	vwait ::found
	after cancel $toev
	unset ::found
    }
    file exists $fn
}
proc signal_exit {fn {wait 1}} {
    # wait for until file created if expected:
    if {!$wait || [wait_for_file $fn]} {
	# delete file to signal exit for child-process:
	while {1} {
	    if {![catch { file delete $fn } msg opt]
		|| [lrange [dict get $opt -errorcode] 0 1] ne {POSIX EACCES}
	    } break
	}
    }
}

set path(exit) [makeFile {
    exit [lindex $argv 0]
} exit]

# Basic syntax checking
test process-1.1 {tcl::process command basic syntax} -returnCodes error -body {
    tcl::process
} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"}
test process-1.2 {tcl::process subcommands} -returnCodes error -body {
    tcl::process ?
} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status}

# Autopurge flag
# - Default state
test process-2.1 {autopurge default} -body {
    tcl::process autopurge
} -result {1}
# - Enabling autopurge
test process-2.2 {enable autopurge} -body {
    tcl::process autopurge true
    tcl::process autopurge
} -result {1}
# - Disabling autopurge
test process-2.3 {disable autopurge} -body {
    tcl::process autopurge false
    tcl::process autopurge
} -result {0} -cleanup {tcl::process autopurge true}

# Subprocess list & status
test process-3.1 {empty subprocess list} -body {
    llength [tcl::process list]
} -result {0}
test process-3.2 {empty subprocess status} -body {
    dict size [tcl::process status]
} -result {0}

# Spawn subprocesses using [exec]
# - One child
test process-4.1 {exec one child} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 0 &]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status [lindex [tcl::process status $pid] 1]
    expr {
           [llength $list] eq 1
        && [lindex $list 0] eq $pid
        && [dict size $statuses] eq 1
        && [dict get $statuses $pid] eq $status
        && $status eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
# - Two children
test process-4.2 {exec two children in parallel} -body {
    tcl::process autopurge 0
    set pid1 [exec [interpreter] $path(exit) 0 &]
    set pid2 [exec [interpreter] $path(exit) 0 &]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    expr {
           [llength $list] eq 2
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [dict size $statuses] eq 2
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && $status1 eq 0
        && $status2 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
# - 3-stage pipe
test process-4.3 {exec 3-stage pipe} -body {
    tcl::process autopurge 0
    set pids [exec \
          [interpreter] $path(exit) 0 \
        | [interpreter] $path(exit) 0 \
        | [interpreter] $path(exit) 0 \
    &]
    lassign $pids pid1 pid2 pid3
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    set status3 [lindex [tcl::process status $pid3] 1]
    expr {
           [llength $pids] eq 3
        && [llength $list] eq 3
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [lsearch $list $pid3] >= 0
        && [dict size $statuses] eq 3
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && [dict get $statuses $pid3] eq $status3
        && $status1 eq 0
        && $status2 eq 0
        && $status3 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

# Spawn subprocesses using [open "|"]
# - One child
test process-5.1 {exec one child} -body {
    tcl::process autopurge 0
    set f [open "|\"[interpreter]\" \"$path(exit)\" 0"]
    set pid [pid $f]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status [lindex [tcl::process status $pid] 1]
    expr {
           [llength $list] eq 1
        && [lindex $list 0] eq $pid
        && [dict size $statuses] eq 1
        && [dict get $statuses $pid] eq $status
        && $status eq 0
    }
} -result {1} -cleanup {
    close $f
    tcl::process purge
    tcl::process autopurge 1
}
# - Two children
test process-5.2 {exec two children in parallel} -body {
    tcl::process autopurge 0
    set f1 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
    set f2 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
    set pid1 [pid $f1]
    set pid2 [pid $f2]
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    expr {
           [llength $list] eq 2
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [dict size $statuses] eq 2
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && $status1 eq 0
        && $status2 eq 0
    }
} -result {1} -cleanup {
    close $f1
    close $f2
    tcl::process purge
    tcl::process autopurge 1
}
# - 3-stage pipe
test process-5.3 {exec 3-stage pipe} -body {
    tcl::process autopurge 0
    set f [open "|
          \"[interpreter]\" \"$path(exit)\" 0
        | \"[interpreter]\" \"$path(exit)\" 0
        | \"[interpreter]\" \"$path(exit)\" 0
    "]
    set pids [pid $f]
    lassign $pids pid1 pid2 pid3
    set list [tcl::process list]
    set statuses [tcl::process status -wait]
    set status1 [lindex [tcl::process status $pid1] 1]
    set status2 [lindex [tcl::process status $pid2] 1]
    set status3 [lindex [tcl::process status $pid3] 1]
    expr {
           [llength $pids] eq 3
        && [llength $list] eq 3
        && [lsearch $list $pid1] >= 0
        && [lsearch $list $pid2] >= 0
        && [lsearch $list $pid3] >= 0
        && [dict size $statuses] eq 3
        && [dict get $statuses $pid1] eq $status1
        && [dict get $statuses $pid2] eq $status2
        && [dict get $statuses $pid3] eq $status3
        && $status1 eq 0
        && $status2 eq 0
        && $status3 eq 0
    }
} -result {1} -cleanup {
    close $f
    tcl::process purge
    tcl::process autopurge 1
}

# Async child status
test process-6.1 {async status} -setup {
    signal_exit $path(test-signalfile) 0; # clean signal-file
} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(sleep) 1 $path(test-signalfile) &]
    set status1 [lindex [tcl::process status $pid] 1]
    signal_exit $path(test-signalfile); # signal exit (stop sleep)
    set status2 [lindex [tcl::process status -wait $pid] 1]
    expr {
           $status1 eq {}
        && $status2 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-6.2 {selective wait} -setup {
    signal_exit $path(test-signalfile)  0; # clean signal-files
    signal_exit $path(test-signalfile2) 0;
} -body {
    tcl::process autopurge 0
    # Child 1 sleeps 1s
    set pid1 [exec [interpreter] $path(sleep) 1 $path(test-signalfile) &]
    # Child 2 sleeps 1s
    set pid2 [exec [interpreter] $path(sleep) 2 $path(test-signalfile2) &]
    # Initial status
    set status1_1 [lindex [tcl::process status $pid1] 1]
    set status1_2 [lindex [tcl::process status $pid2] 1]
    # Wait until child 1 termination
    signal_exit $path(test-signalfile); # signal exit for pid1 (stop sleep)
    set status2_1 [lindex [tcl::process status -wait $pid1] 1]
    set status2_2 [lindex [tcl::process status $pid2] 1]
    # Wait until child 2 termination
    signal_exit $path(test-signalfile2); # signal exit for pid2 (stop sleep)
    set status3_2 [lindex [tcl::process status -wait $pid2] 1]
    set status3_1 [lindex [tcl::process status $pid1] 1]
    expr {
           $status1_1 eq {}
        && $status1_2 eq {}
        && $status2_1 eq 0
        && $status2_2 eq {}
        && $status3_1 eq 0
        && $status3_2 eq 0
    }
} -result {1} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

# Error codes
test process-7.1 {normal exit} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 0 &]
    lindex [tcl::process status -wait $pid] 1
} -result {0} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-7.2 {abnormal exit} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child process exited abnormally} {CHILDSTATUS * 1}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-7.3 {child killed} -constraints {win} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) -1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child killed: unknown signal} {CHILDKILLED * {unknown signal} {unknown signal}}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

removeFile $path(exit)
removeFile $path(sleep)

rename wait_for_file {}
rename signal_exit {}
::tcltest::cleanupTests
return

Changes to tests/pwd.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15


16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
22













-
-
+
+







# Commands covered:  pwd
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

test pwd-1.1 {simple pwd} {
    catch pwd
} 0
test pwd-1.2 {simple pwd} {

Changes to tests/reg.test.

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
1
2
3
4
5
6
7
8
9
10
11


12
13

14
15



16
17
18
19
20
21
22











-
-
+
+
-


-
-
-







# reg.test --
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
# (Don't panic if you are seeing this as part of the reg distribution
# and aren't using Tcl -- reg's own regression tester also knows how
# to read this file, ignoring the Tcl-isms.)
#
# Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# All tests require the testregexp command, return if this
# command doesn't exist

::tcltest::testConstraint testregexp [llength [info commands testregexp]]
::tcltest::testConstraint localeRegexp 0

# This file uses some custom procedures, defined below, for regexp regression
46
47
48
49
50
51
52
53

54
55

56
57
58
59
60
61
62
42
43
44
45
46
47
48

49
50

51
52
53
54
55
56
57
58







-
+

-
+







# expectNomatch, these arguments are optional, and if present are
# ignored except that they indicate how many subexpressions should be
# present in the RE.)  It is an error for the number of subexpression
# arguments to be wrong.  Cases involving nonparticipating
# subexpressions, checking where empty substrings are located,
# etc. should be done using expectIndices and expectPartial.

# The flag characters are complex and a bit eclectic.  Generally speaking,
# The flag characters are complex and a bit eclectic.  Generally speaking, 
# lowercase letters are compile options, uppercase are expected re_info
# bits, and nonalphabetics are match options, controls for how the test is
# bits, and nonalphabetics are match options, controls for how the test is 
# run, or testing options.  The one small surprise is that AREs are the
# default, and you must explicitly request lesser flavors of RE.  The flags
# are as follows.  It is admitted that some are not very mnemonic.
# There are some others which are purely debugging tools and are not
# useful in this file.
#
#	-	no-op (placeholder)
284
285
286
287
288
289
290
291

292
293
294
295
296
297
298
280
281
282
283
284
285
286

287
288
289
290
291
292
293
294







-
+








	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 < 0} {
	if {$nsub == -1} {
	    # didn't tell us number of subexps
	    set ccmd "lreplace \[$ccmd\] 0 0"
	    set info [list $infoflags]
	} else {
	    set info [list $nsub $infoflags]
	}
	set ecmd [list testregexp {*}$f $re $target]
308
309
310
311
312
313
314
315

316
317
318
319
320
321
322
304
305
306
307
308
309
310

311
312
313
314
315
316
317
318







-
+







    proc expectMatch {args} {
	MatchExpected {} {*}$args
    }

    # match expected (full fanciness)
    # expectIndices testno flags re target mat submat ...
    proc expectIndices {args} {
	MatchExpected -indices {*}$args
	MatchExpected -indices {*}$args 
    }

    # partial match expected
    # expectPartial testno flags re target mat "" ...
    # Quirk:  number of ""s must be one more than number of subREs.
    proc expectPartial {args} {
	lset args 1 ![lindex $args 1]	;# add ! flag
622
623
624
625
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
618
619
620
621
622
623
624


625
626
627

628
629
630
631

632
633
634








635
636
637
638
639
640
641







-
-
+


-
+



-
+


-
-
-
-
-
-
-
-







expectMatch	13.10 MP	"a\\cHb"	"a\bb"	"a\bb"
expectMatch	13.11 LMP	"a\\e"		"a\033"	"a\033"
expectMatch	13.12 P		"a\\fb"		"a\fb"	"a\fb"
expectMatch	13.13 P		"a\\nb"		"a\nb"	"a\nb"
expectMatch	13.14 P		"a\\rb"		"a\rb"	"a\rb"
expectMatch	13.15 P		"a\\tb"		"a\tb"	"a\tb"
expectMatch	13.16 P		"a\\u0008x"	"a\bx"	"a\bx"
expectMatch	13.17 P		{a\u008x}	"a\bx"	"a\bx"
expectError	13.17.1 -	{a\ux}		EESCAPE
expectError	13.17 -		{a\u008x}	EESCAPE
expectMatch	13.18 P		"a\\u00088x"	"a\b8x"	"a\b8x"
expectMatch	13.19 P		"a\\U00000008x"	"a\bx"	"a\bx"
expectMatch	13.20 P		{a\U0000008x}	"a\bx"	"a\bx"
expectError	13.20 -		{a\U0000008x}	EESCAPE
expectMatch	13.21 P		"a\\vb"		"a\vb"	"a\vb"
expectMatch	13.22 MP	"a\\x08x"	"a\bx"	"a\bx"
expectError	13.23 -		{a\xq}		EESCAPE
expectMatch	13.24 MP	"a\\x08x"	"a\bx"	"a\bx"
expectMatch	13.24 MP	"a\\x0008x"	"a\bx"	"a\bx"
expectError	13.25 -		{a\z}		EESCAPE
expectMatch	13.26 MP	"a\\010b"	"a\bb"	"a\bb"
expectMatch	13.27 P		"a\\U00001234x"	"a\u1234x"	"a\u1234x"
expectMatch	13.28 P		{a\U00001234x}	"a\u1234x"	"a\u1234x"
expectMatch	13.29 P		"a\\U0001234x"	"a\u1234x"	"a\u1234x"
expectMatch	13.30 P		{a\U0001234x}	"a\u1234x"	"a\u1234x"
expectMatch	13.31 P		"a\\U000012345x"	"a\u12345x"	"a\u12345x"
expectMatch	13.32 P		{a\U000012345x}	"a\u12345x"	"a\u12345x"
expectMatch	13.33 P		"a\\U1000000x"	"a\ufffd0x"	"a\ufffd0x"
expectMatch	13.34 P		{a\U1000000x}	"a\ufffd0x"	"a\ufffd0x"


doing 14 "back references"
# ugh
expectMatch	14.1  RP	{a(b*)c\1}	abbcbb	abbcbb	bb
expectMatch	14.2  RP	{a(b*)c\1}	ac	ac	""
expectNomatch	14.3  RP	{a(b*)c\1}	abbcb
667
668
669
670
671
672
673
674

675
676
677
678
679
680
681
682
683
684
685
686
687
654
655
656
657
658
659
660

661






662
663
664
665
666
667
668







-
+
-
-
-
-
-
-







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
expectNomatch	14.23 RP	{^([bc])\1*$}	bcb
knownBug expectNomatch 14.23 R	{^([bc])\1*$}	bcb
expectMatch	14.24 LRP	{^(\w+)( \1)+$}	{abc abc abc} {abc abc abc} abc { abc}
expectNomatch	14.25 LRP	{^(\w+)( \1)+$}	{abc abd abc}
expectNomatch	14.26 LRP	{^(\w+)( \1)+$}	{abc abc abd}
expectMatch	14.27 RP	{^(.+)( \1)+$}	{abc abc abc} {abc abc abc} abc { abc}
expectNomatch	14.28 RP	{^(.+)( \1)+$}	{abc abd abc}
expectNomatch	14.29 RP	{^(.+)( \1)+$}	{abc abc abd}


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"
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
677
678
679
680
681
682
683

684
685
686
687
688
689
690







-







	"abbbbbbbbbbbc" abbbbbbbbbbbc b b b b b b b b b b
# but we're fussy about border cases -- guys who want octal should use the zero
expectError	15.9  -	{a((((((((((b\10))))))))))c}	ESUBREG
# BREs don't have octal, EREs don't have backrefs
expectMatch	15.10 MP	"a\\12b"	"a\nb"	"a\nb"
expectError	15.11 b		{a\12b}		ESUBREG
expectMatch	15.12 eAS	{a\12b}		a12b	a12b
expectMatch	15.13 MP	{a\701b}	a\u00381b	a\u00381b


doing 16 "expanded syntax"
expectMatch	16.1 xP		"a b c"		"abc"	"abc"
expectMatch	16.2 xP		"a b #oops\nc\td"	"abcd"	"abcd"
expectMatch	16.3 x		"a\\ b\\\tc"	"a b\tc"	"a b\tc"
expectMatch	16.4 xP		"a b\\#c"	"ab#c"	"ab#c"
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
780
781
782
783
784
785
786

787
788
789
790
791
792
793







-







expectIndices	21.28 Q		"a(b){2,3}c"	xabbbcy	{1 5}	{4 4}
expectIndices	21.29 Q		"a(b){2,3}c"	xabbcy	{1 4}	{3 3}
expectNomatch	21.30 Q		"a(b){2,3}c"	xabcy
expectMatch	21.31 LP	"\\y(\\w+)\\y"	"-- abc-"	"abc"	"abc"
expectMatch	21.32 -		a((b|c)d+)+	abacdbd	acdbd	bd	b
expectMatch	21.33 N		(.*).*		abc	abc	abc
expectMatch	21.34 N		(a*)*		bc	""	""
expectMatch	21.35 M		{ TO (([a-z0-9._]+|"([^"]+|"")+")+)}	{asd TO foo}	{ TO foo} foo o {}


doing 22 "multicharacter collating elements"
# again ugh
expectMatch	22.1  &+L	{a[c]e}		ace	ace
expectNomatch	22.2  &+IL	{a[c]h}		ach
expectMatch	22.3  &+L	{a[[.ch.]]}	ach	ach
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
832
833
834
835
836
837
838

839
840
841
842
843
844
845







-







expectMatch	24.6  PT	ab??c		abc	abc
expectMatch	24.7  PQT	"ab{2,4}?"	abbbb	abb
expectMatch	24.8  PQT	"ab{2,4}?c"	abbbbc	abbbbc
expectMatch	24.9  -		3z*		123zzzz456	3zzzz
expectMatch	24.10 PT	3z*?		123zzzz456	3
expectMatch	24.11 -		z*4		123zzzz456	zzzz4
expectMatch	24.12 PT	z*?4		123zzzz456	zzzz4
expectMatch	24.13 PT	{^([^/]+?)(?:/([^/]+?))(?:/([^/]+?))?$}	{foo/bar/baz}	{foo/bar/baz} {foo} {bar} {baz}


doing 25 "mixed quantifiers"
# this is very incomplete as yet
# should include |
expectMatch	25.1 PNT	{^(.*?)(a*)$}	"xyza"	xyza	xyz	a
expectMatch	25.2 PNT	{^(.*?)(a*)$}	"xyzaa"	xyzaa	xyz	aa
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
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
1065
1066
1067
1068
1069
1070
1071















































































1072
1073
1074
1075
1076
1077
1078







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    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

test reg-33.15.1 {Bug 3603557 - an "in the wild" RE} {
    lindex [regexp -expanded -about {
	^TETRA_MODE_CMD				# Message Type
	([[:blank:]]+)				# Pad
	(ETS_1_1|ETS_1_2|ETS_2_2)		# SystemCode
	([[:blank:]]+)				# Pad
	(CONTINUOUS|CARRIER|MCCH|TRAFFIC)	# SharingMode
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,2})			# ColourCode
	([[:blank:]]+)				# Pad
	(1|2|3|4|6|9|12|18)			# TSReservedFrames
	([[:blank:]]+)				# Pad
	(PASS|TRUE|FAIL|FALSE)			# UPlaneDTX
	([[:blank:]]+)				# Pad
	(PASS|TRUE|FAIL|FALSE)			# Frame18Extension
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,4})			# MCC
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,5})			# MNC
	([[:blank:]]+)				# Pad
	(BOTH|BCAST|ENQRY|NONE)			# NbrCellBcast
	([[:blank:]]+)				# Pad
	(UNKNOWN|LOW|MEDIUM|HIGH)		# CellServiceLevel
	([[:blank:]]+)				# Pad
	(PASS|TRUE|FAIL|FALSE)			# LateEntryInfo
	([[:blank:]]+)				# Pad
	(300|400)				# FrequencyBand
	([[:blank:]]+)				# Pad
	(NORMAL|REVERSE)			# ReverseOperation
	([[:blank:]]+)				# Pad
	(NONE|\+6\.25|\-6\.25|\+12\.5)		# Offset
	([[:blank:]]+)				# Pad
	(10)					# DuplexSpacing
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,4})			# MainCarrierNr
	([[:blank:]]+)				# Pad
	(0|1|2|3)				# NrCSCCH
	([[:blank:]]+)				# Pad
	(15|20|25|30|35|40|45)			# MSTxPwrMax
	([[:blank:]]+)				# Pad
	(\-125|\-120|\-115|\-110|\-105|\-100|\-95|\-90|\-85|\-80|\-75|\-70|\-65|\-60|\-55|\-50)
						# RxLevAccessMin
	([[:blank:]]+)				# Pad
	(\-53|\-51|\-49|\-47|\-45|\-43|\-41|\-39|\-37|\-35|\-33|\-31|\-29|\-27|\-25|\-23)
						# AccessParameter
	([[:blank:]]+)				# Pad
	(DISABLE|[[:digit:]]{3,4})		# RadioDLTimeout
	([[:blank:]]+)				# Pad
	(\-[[:digit:]]{2,3})			# RSSIThreshold
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,5})			# CCKIdSCKVerNr
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,5})			# LocationArea
	([[:blank:]]+)				# Pad
	([(1|0)]{16})				# SubscriberClass
	([[:blank:]]+)				# Pad
	([(1|0)]{12})				# BSServiceDetails
	([[:blank:]]+)				# Pad
	(RANDOMIZE|IMMEDIATE|[[:digit:]]{1,2})	# IMM
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,2})			# WT
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,2})			# Nu
	([[:blank:]]+)				# Pad
	([0-1])					# FrameLngFctr
	([[:blank:]]+)				# Pad
	([[:digit:]]{1,2})			# TSPtr
	([[:blank:]]+)				# Pad
	([0-7])					# MinPriority
	([[:blank:]]+)				# Pad
	(PASS|TRUE|FAIL|FALSE)			# ExtdSrvcsEnabled
	([[:blank:]]+)				# Pad
	(.*)					# ConditionalFields
    }] 0
} 68
test reg-33.16.1 {Bug [8d2c0da36d]- another "in the wild" RE} {
    lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:kelly@hotbox.com 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 16Hkelly@hotbox.com 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0
} 1

test reg-33.15 {constraint fixes} {
    regexp {(^)+^} x
} 1
test reg-33.16 {constraint fixes} {
    regexp {($^)+} x
} 0
test reg-33.17 {constraint fixes} {
1217
1218
1219
1220
1221
1222
1223



1224


1225
1226
1227
1228
1229
1230
1231
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135







+
+
+

+
+







    # This is near the limits of the RE engine
    regexp [string repeat x*y*z* 480] x
} 1

test reg-33.30 {Bug 1080042} {
    regexp {(\Y)+} foo
} 1
test reg-33.31 {Bug 7c64aa5e1a} {
    regexp -inline {(?b).\{1,10\}} {abcdef}
} abcdef



# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/regexp.test.

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
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













-
-
+
+



-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
+







# Commands covered:  regexp, regsub
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1998 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

unset -nocomplain foo

testConstraint exec [llength [info commands exec]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc memtest script {
	set end [lindex [split [memory info] \n] 3 3]
	for {set i 0} {$i < 5} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [lindex [split [memory info] \n] 3 3]
	}
	expr {$end - $tmp}
    }
}

catch {unset foo}
test regexp-1.1 {basic regexp operation} {
    regexp ab*c abbbc
} 1
test regexp-1.2 {basic regexp operation} {
    regexp ab*c ac
} 1
test regexp-1.3 {basic regexp operation} {
54
55
56
57
58
59
60

61
62
63
64
65
66
67
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53







+







} {0 1}
test regexp-1.7 {regexp utf compliance} {
    # if not UTF-8 aware, result is "0 1"
    set foo "\u4e4eb q"
    regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar
    list [string compare $foo $bar] [regexp 4 $bar]
} {0 0}

test regexp-1.8 {regexp ***= metasyntax} {
    regexp -- "***=o" "aeiou"
} 1
test regexp-1.9 {regexp ***= metasyntax} {
    set string "aeiou"
    regexp -- "***=o" $string
} 1
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
115
116
117
118
119
120
121






















122
123
124
125
126
127
128







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    list [regexp f\352te(b*)c f\352tebbbbc foo f2] $foo $f2
} [list 1 f\352tebbbbc bbbb]
test regexp-2.10 {getting substrings back from regexp} {
    set foo {}
    set f2 {}
    list [regexp f\352te(b*)c eff\352tebbbbc foo f2] $foo $f2
} [list 1 f\352tebbbbc bbbb]
test regexp-2.11 {non-capturing subgroup} {
    set foo {}
    set f2 {}
    list [regexp {str(?:a+)} straa foo f2] $foo $f2
} [list 1 straa {}]
test regexp-2.12 {non-capturing subgroup with -inline} {
    regexp -inline {str(?:a+)} straa
} {straa}
test regexp-2.13 {non-capturing and capturing subgroups} {
    set foo {}
    set f2 {}
    set f3 {}
    list [regexp {str(?:a+)(c+)} straacc foo f2 f3] $foo $f2 $f3
} [list 1 straacc cc {}]
test regexp-2.14 {non-capturing and capturing subgroups} {
    regexp -inline {str(?:a+)(c+)} straacc
} {straacc cc}
test regexp-2.15 {getting substrings back from regexp} {
    set foo NA
    set f2 NA
    list [regexp {str(?:a+)} straa foo f2] $foo $f2
} [list 1 straa {}]

test regexp-3.1 {-indices option to regexp} {
    set foo {}
    list [regexp -indices ab*c abbbbc foo] $foo
} {1 {0 5}}
test regexp-3.2 {-indices option to regexp} {
    set foo {}
217
218
219
220
221
222
223
224

225
226
227
228
229
230
231
181
182
183
184
185
186
187

188
189
190
191
192
193
194
195







-
+







    regexp -nocase FOo abcFOo
} 1
set x abcdefghijklmnopqrstuvwxyz1234567890
set x $x$x$x$x$x$x$x$x$x$x$x$x
test regexp-4.4 {case conversion in regexp} {
    list [regexp -nocase $x $x foo] $foo
} "1 $x"
unset -nocomplain x
catch {unset x}

test regexp-5.1 {exercise cache of compiled expressions} {
    regexp .*a b
    regexp .*b c
    regexp .*c d
    regexp .*d e
    regexp .*e f
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
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







-
+


-
+


-
+












-
-
+
+
-

-
-
+
+



-
-
-







    regexp .*d e
    regexp .*e f
    regexp .*e xe
} 1

test regexp-6.1 {regexp errors} {
    list [catch {regexp a} msg] $msg
} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
test regexp-6.2 {regexp errors} {
    list [catch {regexp -nocase a} msg] $msg
} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
test regexp-6.3 {regexp errors} {
    list [catch {regexp -gorp a} msg] $msg
} {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
} {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
test regexp-6.4 {regexp errors} {
    list [catch {regexp a( b} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-6.5 {regexp errors} {
    list [catch {regexp a( b} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-6.6 {regexp errors} {
    list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
} {0 1}
test regexp-6.7 {regexp errors} {
    list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
} {0 0}
test regexp-6.8 {regexp errors} -setup {
    unset -nocomplain f1
test regexp-6.8 {regexp errors} {
    catch {unset f1}
} -body {
    set f1 44
    regexp abc abc f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
    list [catch {regexp abc abc f1(f2)} msg] $msg
} {1 {couldn't set variable "f1(f2)"}}
test regexp-6.9 {regexp errors, -start bad int check} {
    list [catch {regexp -start bogus {^$} {}} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
test regexp-6.10 {regexp errors} {
    list [catch {regexp {a[} b} msg] $msg
} {1 {couldn't compile regular expression pattern: brackets [] not balanced}}

test regexp-7.1 {basic regsub operation} {
    list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
} {1 xax111aaa222xaa}
test regexp-7.2 {basic regsub operation} {
    list [regsub aa+ aaaxaa &111 foo] $foo
} {1 aaa111xaa}
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
312
313
314
315
316
317
318




































319
320
321
322
323
324
325







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







} {0 {}}
test regexp-7.17 {regsub utf compliance} {
    # if not UTF-8 aware, result is "0 1"
    set foo "xyz555ijka\u4e4ebpqr"
    regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar
    list [string compare $foo $bar] [regexp 4 $bar]
} {0 0}
test regexp-7.18 {basic regsub replacement} {
    list [regsub a+ aaa {&} foo] $foo
} {1 aaa}
test regexp-7.19 {basic regsub replacement} {
    list [regsub a+ aaa {\&} foo] $foo
} {1 &}
test regexp-7.20 {basic regsub replacement} {
    list [regsub a+ aaa {\\&} foo] $foo
} {1 {\aaa}}
test regexp-7.21 {basic regsub replacement} {
    list [regsub a+ aaa {\\\&} foo] $foo
} {1 {\&}}
test regexp-7.22 {basic regsub replacement} {
    list [regsub a+ aaa {\0} foo] $foo
} {1 aaa}
test regexp-7.23 {basic regsub replacement} {
    list [regsub a+ aaa {\\0} foo] $foo
} {1 {\0}}
test regexp-7.24 {basic regsub replacement} {
    list [regsub a+ aaa {\\\0} foo] $foo
} {1 {\aaa}}
test regexp-7.25 {basic regsub replacement} {
    list [regsub a+ aaa {\\\\0} foo] $foo
} {1 {\\0}}
test regexp-7.26 {dollar zero is not a backslash replacement} {
    list [regsub a+ aaa {$0} foo] $foo
} {1 {$0}}
test regexp-7.27 {dollar zero is not a backslash replacement} {
    list [regsub a+ aaa {\0$0} foo] $foo
} {1 {aaa$0}}
test regexp-7.28 {dollar zero is not a backslash replacement} {
    list [regsub a+ aaa {\$0} foo] $foo
} {1 {\$0}}
test regexp-7.29 {dollar zero is not a backslash replacement} {
    list [regsub a+ aaa {\\} foo] $foo
} {1 \\}

test regexp-8.1 {case conversion in regsub} {
    list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
} {1 xaAAaAAay}
test regexp-8.2 {case conversion in regsub} {
    list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
} {1 xaAAaAAay}
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
524
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







-
+


-
+


-
+


-
+


-
+



-
-
+
+
-

-
-
+
+

















-
+







-
-
+
+
+
+







test regexp-10.5 {inverse partial newline sensitivity in regsub} {
    set foo xxx
    list [regsub -linestop {a.*b} "da\nbaxyb\nxb" 123 foo] $foo
} "1 {da\nb123\nxb}"

test regexp-11.1 {regsub errors} {
    list [catch {regsub a b} msg] $msg
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.2 {regsub errors} {
    list [catch {regsub -nocase a b} msg] $msg
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.3 {regsub errors} {
    list [catch {regsub -nocase -all a b} msg] $msg
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.4 {regsub errors} {
    list [catch {regsub a b c d e f} msg] $msg
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexp-11.5 {regsub errors} {
    list [catch {regsub -gorp a b c} msg] $msg
} {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
test regexp-11.6 {regsub errors} {
    list [catch {regsub -nocase a( b c d} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-11.7 {regsub errors} -setup {
    unset -nocomplain f1
test regexp-11.7 {regsub errors} {
    catch {unset f1}
} -body {
    set f1 44
    regsub -nocase aaa aaa xxx f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
    list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
} {1 {couldn't set variable "f1(f2)"}}
test regexp-11.8 {regsub errors, -start bad int check} {
    list [catch {regsub -start bogus pattern string rep var} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
test regexp-11.9 {regsub without final variable name returns value} {
    regsub b abaca X
} {aXaca}
test regexp-11.10 {regsub without final variable name returns value} {
    regsub -all a abaca X
} {XbXcX}
test regexp-11.11 {regsub without final variable name returns value} {
    regsub b(.*?)d abcdeabcfde {,&,\1,}
} {a,bcd,c,eabcfde}
test regexp-11.12 {regsub without final variable name returns value} {
    regsub -all b(.*?)d abcdeabcfde {,&,\1,}
} {a,bcd,c,ea,bcfd,cf,e}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want...
# Meg.  This is probably bigger than most users want... 
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}

test regexp-13.1 {regsub of a very large string} {
    # This test is designed to stress the memory subsystem in order to catch
    # Bug #933.  It only fails if the Tcl memory allocator is in use.
    # This test is designed to stress the memory subsystem in order
    # to catch Bug #933.  It only fails if the Tcl memory allocator
    # is in use.

    set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
    set filedata [string repeat $line 200]
    for {set i 1} {$i<10} {incr i} {
	regsub -all "BEGIN_TABLE " $filedata "" newfiledata
    }
    set x done
} {done}
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


611
612
613
614
615


616
617
618


619
620
621


622
623
624


625
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
686
687
688
689
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
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







-
+








-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
+
-
-
-
-

-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+



-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    regexp .*d e
    regexp .*e f
    set x .
    append x *a
    regexp -nocase $x bbba
} 1
test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints {
    exec
	exec
} -setup {
    set junk [makeFile {puts [regexp {} foo]} junk.tcl]
} -body {
    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexp-15.1 {regexp -start} -body {
    unset -nocomplain x
test regexp-15.1 {regexp -start} {
    catch {unset x}
    list [regexp -start -10 {\d} 1abc2de3 x] $x
} -result {1 1}
test regexp-15.2 {regexp -start} -body {
    unset -nocomplain x
} {1 1}
test regexp-15.2 {regexp -start} {
    catch {unset x}
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexp-15.3 {regexp -start} -body {
    unset -nocomplain x
} {1 2}
test regexp-15.3 {regexp -start} {
    catch {unset x}
    list [regexp -start 4 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexp-15.4 {regexp -start} -body {
    unset -nocomplain x
} {1 2}
test regexp-15.4 {regexp -start} {
    catch {unset x}
    list [regexp -start 5 {\d} 1abc2de3 x] $x
} -result {1 3}
test regexp-15.5 {regexp -start, over end of string} -body {
    unset -nocomplain x
} {1 3}
test regexp-15.5 {regexp -start, over end of string} {
    catch {unset x}
    list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
} -result {0 0}
test regexp-15.6 {regexp -start, loss of ^$ behavior} -body {
} {0 0}
test regexp-15.6 {regexp -start, loss of ^$ behavior} {
    list [regexp -start 2 {^$} {}]
} -result {0}
test regexp-15.7 {regexp -start, double option} -body {
} {0}
test regexp-15.7 {regexp -start, double option} {
    regexp -start 2 -start 0 a abc
} -result 1
test regexp-15.8 {regexp -start, double option} -body {
} 1
test regexp-15.8 {regexp -start, double option} {
    regexp -start 0 -start 2 a abc
} -result 0
test regexp-15.9 {regexp -start, end relative index} -body {
    unset -nocomplain x
} 0
test regexp-15.9 {regexp -start, end relative index} {
    catch {unset x}
    list [regexp -start end {\d} 1abc2de3 x] [info exists x]
} -result {0 0}
test regexp-15.10 {regexp -start, end relative index} -body {
    unset -nocomplain x
} {0 0}
test regexp-15.10 {regexp -start, end relative index} {
    catch {unset x}
    list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x
} -result {1 1 3}
} {1 1 3}
test regexp-15.11 {regexp -start, over end of string} -body {
    set x NA
    list [regexp -start 2 {.*} ab x] $x
} -result {1 {}}

test regexp-16.1 {regsub -start} -body {
    unset -nocomplain x
test regexp-16.1 {regsub -start} {
    catch {unset x}
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexp-16.2 {regsub -start} -body {
    unset -nocomplain x
} {4 a1b/2c/3d/4e/5}
test regexp-16.2 {regsub -start} {
    catch {unset x}
    list [regsub -all -start -25 {z} hello {/&} x] $x
} -result {0 hello}
test regexp-16.3 {regsub -start} -body {
    unset -nocomplain x
} {0 hello}
test regexp-16.3 {regsub -start} {
    catch {unset x}
    list [regsub -all -start 3 {z} hello {/&} x] $x
} -result {0 hello}
test regexp-16.4 {regsub -start, \A behavior} -body {
} {0 hello}
test regexp-16.4 {regsub -start, \A behavior} {
    set out {}
    lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
    lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
} -result {5 /a/b/c/d/e 3 ab/c/d/e}
test regexp-16.5 {regsub -start, double option} -body {
} {5 /a/b/c/d/e 3 ab/c/d/e}
test regexp-16.5 {regsub -start, double option} {
    list [regsub -start 2 -start 0 a abc c x] $x
} -result {1 cbc}
test regexp-16.6 {regsub -start, double option} -body {
} {1 cbc}
test regexp-16.6 {regsub -start, double option} {
    list [regsub -start 0 -start 2 a abc c x] $x
} -result {0 abc}
test regexp-16.7 {regexp -start, end relative index} -body {
} {0 abc}
test regexp-16.7 {regexp -start, end relative index} {
    list [regsub -start end a aaa b x] $x
} -result {0 aaa}
test regexp-16.8 {regexp -start, end relative index} -body {
} {0 aaa}
test regexp-16.8 {regexp -start, end relative index} {
    list [regsub -start end-1 a aaa b x] $x
} -result {1 aab}
} {1 aab}
test regexp-16.9 {regsub -start and -all} -body {
    set foo {}
    list [regsub -start 0 -all x+ axxxbxx |&| foo] $foo
} -result {2 a|xxx|b|xx|}
test regexp-16.10 {regsub -start and -all} -body {
    set foo {}
    list [regsub -start 1 -all x+ axxxbxx |&| foo] $foo
} -result {2 a|xxx|b|xx|}
test regexp-16.11 {regsub -start and -all} -body {
    set foo {}
    list [regsub -start 4 -all x+ axxxbxx |&| foo] $foo
} -result {1 axxxb|xx|}
test regexp-16.12 {regsub -start} -body {
    set foo {}
    list [regsub -start 4 x+ axxxbxx |&| foo] $foo
} -result {1 axxxb|xx|}
test regexp-16.13 {regsub -start and -all} -body {
    set foo {}
    list [regsub -start 1 -all a+ "" & foo] $foo
} -result {0 {}}
test regexp-16.14 {regsub -start} -body {
    set foo {}
    list [regsub -start 1 a+ "" & foo] $foo
} -result {0 {}}
test regexp-16.15 {regsub -start and -all} -body {
    set foo {}
    list [regsub -start 2 -all a+ "xy" & foo] $foo
} -result {0 xy}
test regexp-16.16 {regsub -start} -body {
    set foo {}
    list [regsub -start 2 a+ "xy" & foo] $foo
} -result {0 xy}
test regexp-16.17 {regsub -start and -all} -body {
    set foo {}
    list [regsub -start 1 -all y+ "xy" & foo] $foo
} -result {1 xy}
test regexp-16.18 {regsub -start} -body {
    set foo {}
    list [regsub -start 1 y+ "xy" & foo] $foo
} -result {1 xy}
test regexp-16.19 {regsub -start} -body {
    set foo {}
    list [regsub -start -1 a+ "" & foo] $foo
} -result {0 {}}
test regexp-16.20 {regsub -start, loss of ^$ behavior} -body {
    set foo NA
    list [regsub -start 1 {^$} {} & foo] $foo
} -result {0 {}}
test regexp-16.21 {regsub -start, loss of ^$ behavior} -body {
    set foo NA
    list [regsub -start 1 {^.*$} abc & foo] $foo
} -result {0 abc}
test regexp-16.22 {regsub -start, loss of ^$ behavior} -body {
    set foo NA
    list [regsub -all -start 1 {^.*$} abc & foo] $foo
} -result {0 abc}

test regexp-17.1 {regexp -inline} {
    regexp -inline b ababa
} {b}
test regexp-17.2 {regexp -inline} {
    regexp -inline (b) ababa
} {b b}
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
620
621
622
623
624
625
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







-
-
-
-
-
-
-
+

-
-
-
-
+
+
+
+

-
-
+
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







} {{0 4} {1 3} {2 2} {-1 -1} {5 9} {6 8} {-1 -1} {7 7}}

test regexp-19.1 {regsub null replacement} {
    regsub -all {@} {@hel@lo@} "\0a\0" result
    list $result [string length $result]
} "\0a\0hel\0a\0lo\0a\0 14"

test regexp-19.2 {regsub null replacement} {
    regsub -all {@} {@hel@lo@} "\0a\0" result
    set expected "\0a\0hel\0a\0lo\0a\0"
    string equal $result $expected
} 1

test regexp-20.1 {regsub shared object shimmering} -body {
test regexp-20.1 {regsub shared object shimmering} {
    # Bug #461322
    set a abcdefghijklmnopqurstuvwxyz
    set b $a
    set c abcdefghijklmnopqurstuvwxyz0123456789
    regsub $a $c $b d
    set a abcdefghijklmnopqurstuvwxyz 
    set b $a 
    set c abcdefghijklmnopqurstuvwxyz0123456789 
    regsub $a $c $b d 
    list $d [string length $d] [string bytelength $d]
} -result [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexp-20.2 {regsub shared object shimmering with -about} -body {
} {abcdefghijklmnopqurstuvwxyz0123456789 37 37}
test regexp-20.2 {regsub shared object shimmering with -about} {
    eval regexp -about abc
} -result {0 {}}
} {0 {}}

test regexp-21.1 {regsub works with empty string} -body {
test regexp-21.1 {regsub works with empty string} {
    regsub -- ^ {} foo
} -result {foo}
test regexp-21.2 {regsub works with empty string} -body {
} {foo}
test regexp-21.2 {regsub works with empty string} {
    regsub -- \$ {} foo
} -result {foo}
test regexp-21.3 {regsub works with empty string offset} -body {
} {foo}
test regexp-21.3 {regsub works with empty string offset} {
    regsub -start 0 -- ^ {} foo
} -result {foo}
test regexp-21.4 {regsub works with empty string offset} -body {
} {foo}
test regexp-21.4 {regsub works with empty string offset} {
    regsub -start 0 -- \$ {} foo
} -result {foo}
test regexp-21.5 {regsub works with empty string offset} -body {
} {foo}
test regexp-21.5 {regsub works with empty string offset} {
    regsub -start 3 -- \$ {123} foo
} -result {123foo}
test regexp-21.6 {regexp works with empty string} -body {
} {123foo}
test regexp-21.6 {regexp works with empty string} {
    regexp -- ^ {}
} -result {1}
test regexp-21.7 {regexp works with empty string} -body {
} {1}
test regexp-21.7 {regexp works with empty string} {
    regexp -start 0 -- ^ {}
} -result {1}
test regexp-21.8 {regexp works with empty string offset} -body {
} {1}
test regexp-21.8 {regexp works with empty string offset} {
    regexp -start 3 -- ^ {123}
} -result {0}
test regexp-21.9 {regexp works with empty string offset} -body {
} {0}
test regexp-21.9 {regexp works with empty string offset} {
    regexp -start 3 -- \$ {123}
} -result {1}
} {1}
test regexp-21.10 {multiple matches handle newlines} {
    regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n
} "foo\nfoo\nfoo\n"
test regexp-21.11 {multiple matches handle newlines} {
    regsub -all -line -- ^ "a\nb\nc" \#
} "\#a\n\#b\n\#c"
test regexp-21.12 {multiple matches handle newlines} {
    regsub -all -line -- ^ "\n\n" \#
} "\#\n\#\n\#"
test regexp-21.13 {multiple matches handle newlines} {
    regexp -all -inline -indices -line -- ^ "a\nb\nc"
} {{0 -1} {2 1} {4 3}}
test regexp-21.14 {regsub works with empty string} {
    regsub -- ^ {} &
} {}
test regexp-21.15 {regsub works with empty string} {
    regsub -- ^ {} foo&
} {foo}
test regexp-21.16 {regsub works with empty string} {
    regsub -all -- ^ {} foo&
} {foo}
test regexp-21.17 {regsub works with empty string} {
    regsub -- ^ {} {foo\0}
} {foo}
test regexp-21.18 {regsub works with empty string} {
    regsub -- ^.* {} {foo$0}
} {foo$0}
test regexp-21.19 {regsub works with empty string} {
    regsub -- ^ {input} {}
} {input}
test regexp-21.20 {regsub works with empty string} {
    regsub -- x {} {foo}
} {}

test regexp-22.1 {Bug 1810038} {
    regexp ($|^X)* {}
} 1
test regexp-22.2 {regexp compile and backrefs, Bug 1857126} {
    regexp -- {([bc])\1} bb
} 1
885
886
887
888
889
890
891
892

893
894
895
896
897
898
899
723
724
725
726
727
728
729

730
731
732
733
734
735
736
737







-
+







	[a 667]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \
	[a 671]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
	[a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
	[a 668]([a 55])[a 710]([a 55])[a 668]([a 55])[a 668]([a 55]) \
	[a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 511]] {}] a
} -cleanup {
    rename a {}
} -returnCodes 1 -match glob -result {couldn't compile regular expression pattern: *}
} -returnCodes 1 -result {couldn't compile regular expression pattern: nfa has too many states}
test regexp-22.5 {Bug 3610026} -setup {
    set e {}
    set cp 99
    while {$cp < 32864} {
	append e [format %c [incr cp]]
    }
} -body {
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
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
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







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







-
+







test regexp-24.2 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "\n"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 2 "<>\n<>" 2 "<>\n<>" 2 "<>\n<>"]
} "2 {<>\n<>} 2 {<>\n<>} 2 {<>\n<>}"
test regexp-24.3 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "\n\n"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 3 "<>\n<>\n<>" 3 "<>\n<>\n<>" 3 "<>\n<>\n<>"]
} "3 {<>\n<>\n<>} 3 {<>\n<>\n<>} 3 {<>\n<>\n<>}"
test regexp-24.4 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "a"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 1 "<>a" 1 "<a>" 1 "a<>"]
} {1 <>a 1 <a> 1 a<>}
test regexp-24.5 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "a\n"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 2 "<>a\n<>" 2 "<a>\n<>" 2 "a<>\n<>"]
} "2 {<>a\n<>} 2 {<a>\n<>} 2 {a<>\n<>}"
test regexp-24.6 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "\na"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 2 "<>\n<>a" 2 "<>\n<a>" 2 "<>\na<>"]
} "2 {<>\n<>a} 2 {<>\n<a>} 2 {<>\na<>}"
test regexp-24.7 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "ab\n"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 2 "<>ab\n<>" 2 "<ab>\n<>" 2 "ab<>\n<>"]
} "2 {<>ab\n<>} 2 {<ab>\n<>} 2 {ab<>\n<>}"
test regexp-24.8 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "a\nb"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 2 "<>a\n<>b" 2 "<a>\n<b>" 2 "a<>\nb<>"]
} "2 {<>a\n<>b} 2 {<a>\n<b>} 2 {a<>\nb<>}"
test regexp-24.9 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "a\nb\n"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 3 "<>a\n<>b\n<>" 3 "<a>\n<b>\n<>" 3 "a<>\nb<>\n<>"]
} "3 {<>a\n<>b\n<>} 3 {<a>\n<b>\n<>} 3 {a<>\nb<>\n<>}"
test regexp-24.10 {regsub -all and -line} {
    foreach {v1 v2 v3} {{} {} {}} {}
    set string "a\nb\nc"
    list \
	[regsub -line -all {^} $string {<&>} v1] $v1 \
	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
	[regsub -line -all {$} $string {<&>} v3] $v3
} [list 3 "<>a\n<>b\n<>c" 3 "<a>\n<b>\n<c>" 3 "a<>\nb<>\nc<>"]
} "3 {<>a\n<>b\n<>c} 3 {<a>\n<b>\n<c>} 3 {a<>\nb<>\nc<>}"
test regexp-24.11 {regsub -all and -line} {
    regsub -line -all {b} "abb\nb" {<&>}
} "a<b><b>\n<b>"

test regexp-25.1 {regexp without -line option} {
    set foo ""
    list [regexp {a.*b} "dabc\naxyb\n" foo] $foo
} [list 1 abc\naxyb]
} "1 {abc\naxyb}"
test regexp-25.2 {regexp without -line option} {
    set foo ""
    list [regexp {^a.*b$} "dabc\naxyb\n" foo] $foo
} {0 {}}
test regexp-25.3 {regexp with -line option} {
    set foo ""
    list [regexp -line {^a.*b$} "dabc\naxyb\n" foo] $foo
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
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
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











-
+





-
+
-
















-
+



-
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-

test regexp-26.1 {matches start of line 1 time} {
    regexp -all -inline -- {^a+} "aab\naaa"
} {aa}
test regexp-26.2 {matches start of line(s) 2 times} {
    regexp -all -inline -line -- {^a+} "aab\naaa"
} {aa aaa}
test regexp-26.3 {effect of -line -all and -start} -body {
test regexp-26.3 {effect of -line -all and -start} {
    list \
	[regexp -all -inline -line -start 0 -- {^a+} "aab\naaa"] \
	[regexp -all -inline -line -start 1 -- {^a+} "aab\naaa"] \
	[regexp -all -inline -line -start 3 -- {^a+} "aab\naaa"] \
	[regexp -all -inline -line -start 4 -- {^a+} "aab\naaa"] \
} -result {{aa aaa} aaa aaa aaa}
} {{aa aaa} aaa aaa aaa}
# No regexp-26.4
test regexp-26.5 {match length 0, match length 1} {
    regexp -all -inline -line -- {^b*} "a\nb"
} {{} b}
test regexp-26.6 {non reporting capture group} {
    regexp -all -inline -line -- {^(?:a+|b)} "aab\naaa"
} {aa aaa}
test regexp-26.7 {Tcl bug 2826551: -line sensitive regexp and -start} {
    set match1 {}
    set match2 {}
    list \
	[regexp -start 0 -indices -line {^a} "\nab" match1] $match1 \
	[regexp -start 1 -indices -line {^a} "\nab" match2] $match2
} {1 {1 1} 1 {1 1}}
test regexp-26.8 {Tcl bug 2826551: diff regexp with -line option} {
    set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n"
    regexp -all -inline -line {^@.*\n(?:[^@].*\n?)*} $data
} [list "@1\n2\n+3\n" "@4\n-5\n+6\n7\n" "@8\n9\n"]
} "{@1\n2\n+3\n} {@4\n-5\n+6\n7\n} {@8\n9\n}"
test regexp-26.9 {Tcl bug 2826551: diff regexp with embedded -line option} {
    set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n"
    regexp -all -inline {(?n)^@.*\n(?:[^@].*\n?)*} $data
} [list "@1\n2\n+3\n" "@4\n-5\n+6\n7\n" "@8\n9\n"]
} "{@1\n2\n+3\n} {@4\n-5\n+6\n7\n} {@8\n9\n}"
test regexp-26.10 {regexp with -line option} {
    regexp -all -inline -line -- {a*} "a\n"
} {a {}}
test regexp-26.11 {regexp without -line option} {
    regexp -all -inline -- {a*} "a\n"
} {a {}}
test regexp-26.12 {regexp with -line option} {
    regexp -all -inline -line -- {a*} "b\n"
} {{} {}}
test regexp-26.13 {regexp without -line option} {
    regexp -all -inline -- {a*} "b\n"
} {{} {}}

test regexp-27.1 {regsub -command} {
    regsub -command {.x.} {abcxdef} {string length}
} ab3ef
test regexp-27.2 {regsub -command} {
    regsub -command {.x.} {abcxdefxghi} {string length}
} ab3efxghi
test regexp-27.3 {regsub -command} {
    set x 0
    regsub -all -command {(?=.)} abcde {apply {args {incr ::x}}}
} 1a2b3c4d5e
test regexp-27.4 {regsub -command} -body {
    regsub -command {.x.} {abcxdef} error
} -returnCodes error -result cxd
test regexp-27.5 {regsub -command} {
    regsub -command {(.)(.)} {abcdef} {list ,}
} {, ab a bcdef}
test regexp-27.6 {regsub -command} {
    regsub -command -all {(.)(.)} {abcdef} {list ,}
} {, ab a b, cd c d, ef e f}
test regexp-27.7 {regsub -command representation smash} {
    set ::s {123=456 789}
    regsub -command -all {\d+} $::s {apply {n {
	expr {[llength $::s] + $n}
    }}}
} {125=458 791}
test regexp-27.8 {regsub -command representation smash} {
    set ::t {apply {n {
	expr {[llength [lindex $::t 1 1 1]] + $n}
    }}}
    regsub -command -all {\d+} "123=456 789" $::t
} {131=464 797}
test regexp-27.9 {regsub -command memory leak testing} memory {
    set ::s "123=456 789"
    set ::t {apply {n {
	expr {[llength [lindex $::t 1 1 1]] + [llength $::s] + $n}
    }}}
    memtest {
	regsub -command -all {\d+} $::s $::t
    }
} 0
test regexp-27.10 {regsub -command error cases} -returnCodes error -body {
    regsub -command . abc "def \{ghi"
} -result {unmatched open brace in list}
test regexp-27.11 {regsub -command error cases} -returnCodes error -body {
    regsub -command . abc {}
} -result {command prefix must be a list of at least one element}
test regexp-27.12 {regsub -command representation smash} {
    set s {list (.+)}
    regsub -command $s {list list} $s
} {(.+) {list list} list}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/regexpComp.test.

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
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













-
-
+
+









-
+






-
-
+







# Commands covered:  regexp, regsub
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1998 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Procedure to evaluate a script within a proc, to test compilation
# functionality

proc evalInProc { script } {
    proc testProc {} $script
    set status [catch {
	testProc
	testProc 
    } result]
    rename testProc {}
    return $result
    #return [list $status $result]
}

unset -nocomplain foo

catch {unset foo}
test regexpComp-1.1 {basic regexp operation} {
    evalInProc {
	regexp ab*c abbbc
    }
} 1
test regexpComp-1.2 {basic regexp operation} {
    evalInProc {
255
256
257
258
259
260
261
262

263
264
265
266
267
268
269
254
255
256
257
258
259
260

261
262
263
264
265
266
267
268







-
+







set ::x abcdefghijklmnopqrstuvwxyz1234567890
set ::x $x$x$x$x$x$x$x$x$x$x$x$x
test regexpComp-4.4 {case conversion in regexp} {
    evalInProc {
	list [regexp -nocase $::x $::x foo] $foo
    }
} "1 $x"
unset -nocomplain ::x
catch {unset ::x}

test regexpComp-5.1 {exercise cache of compiled expressions} {
    evalInProc {
	regexp .*a b
	regexp .*b c
	regexp .*c d
	regexp .*d e
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
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







-
+




-
+




-
+







    }
} 1

test regexpComp-6.1 {regexp errors} {
    evalInProc {
	list [catch {regexp a} msg] $msg
    }
} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
test regexpComp-6.2 {regexp errors} {
    evalInProc {
	list [catch {regexp -nocase a} msg] $msg
    }
} {1 {wrong # args: should be "regexp ?-option ...? exp string ?matchVar? ?subMatchVar ...?"}}
} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
test regexpComp-6.3 {regexp errors} {
    evalInProc {
	list [catch {regexp -gorp a} msg] $msg
    }
} {1 {bad option "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
} {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
test regexpComp-6.4 {regexp errors} {
    evalInProc {
	list [catch {regexp a( b} msg] $msg
    }
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexpComp-6.5 {regexp errors} {
    evalInProc {
345
346
347
348
349
350
351
352

353
354
355
356

357
358
359
360
361
362
363
344
345
346
347
348
349
350

351
352
353
354

355
356
357
358
359
360
361
362







-
+



-
+







test regexpComp-6.7 {regexp errors} {
    evalInProc {
	list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
    }
} {0 0}
test regexpComp-6.8 {regexp errors} {
    evalInProc {
	unset -nocomplain f1
	catch {unset f1}
	set f1 44
	list [catch {regexp abc abc f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
} {1 {couldn't set variable "f1(f2)"}}
test regexpComp-6.9 {regexp errors, -start bad int check} {
    evalInProc {
	list [catch {regexp -start bogus {^$} {}} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}

test regexpComp-7.1 {basic regsub operation} {
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
521
522
523
524
525
526
527





528
529
530
531
532
533
534







-
-
-
-
-







} {2 {yy yy more}}
test regexpComp-9.6 {-all option to regsub} {
    evalInProc {
	set foo xxx
	list [regsub -all ^ xxx 123 foo] $foo
    }
} {1 123xxx}
test regexpComp-9.7 {Bug 84af1192f5: -all option to regsub} {
    evalInProc {
	regsub -all {\(.*} 123(qwe) ""
    }
} 123

test regexpComp-10.1 {expanded syntax in regsub} {
    evalInProc {
	set foo xxx
	list [regsub -expanded ". \#comment\n  . \#comment2" abc def foo] $foo
    }
} {1 defc}
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
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







-
+




-
+




-
+




-
+




-
+







-
+



-
+







-
+







    }
} "1 {da\nb123\nxb}"

test regexpComp-11.1 {regsub errors} {
    evalInProc {
	list [catch {regsub a b} msg] $msg
    }
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexpComp-11.2 {regsub errors} {
    evalInProc {
	list [catch {regsub -nocase a b} msg] $msg
    }
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexpComp-11.3 {regsub errors} {
    evalInProc {
	list [catch {regsub -nocase -all a b} msg] $msg
    }
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexpComp-11.4 {regsub errors} {
    evalInProc {
	list [catch {regsub a b c d e f} msg] $msg
    }
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
test regexpComp-11.5 {regsub errors} {
    evalInProc {
	list [catch {regsub -gorp a b c} msg] $msg
    }
} {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
test regexpComp-11.6 {regsub errors} {
    evalInProc {
	list [catch {regsub -nocase a( b c d} msg] $msg
    }
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexpComp-11.7 {regsub errors} {
    evalInProc {
	unset -nocomplain f1
	catch {unset f1}
	set f1 44
	list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
} {1 {couldn't set variable "f1(f2)"}}
test regexpComp-11.8 {regsub errors, -start bad int check} {
    evalInProc {
	list [catch {regsub -start bogus pattern string rep var} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}

# This test crashes on the Mac unless you increase the Stack Space to about 1
# Meg.  This is probably bigger than most users want...
# Meg.  This is probably bigger than most users want... 
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
    evalInProc {
	list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z
    }
} {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
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
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


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







-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+

-
+

-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+



-
+

-
+

-
-
+
+

-
+







    set junk [makeFile {puts [regexp {} foo]} junk.tcl]
} -body {
    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexpComp-15.1 {regexp -start} -body {
    unset -nocomplain x
test regexpComp-15.1 {regexp -start} {
    catch {unset x}
    list [regexp -start -10 {\d} 1abc2de3 x] $x
} -result {1 1}
test regexpComp-15.2 {regexp -start} -body {
    unset -nocomplain x
} {1 1}
test regexpComp-15.2 {regexp -start} {
    catch {unset x}
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexpComp-15.3 {regexp -start} -body {
    unset -nocomplain x
} {1 2}
test regexpComp-15.3 {regexp -start} {
    catch {unset x}
    list [regexp -start 4 {\d} 1abc2de3 x] $x
} -result {1 2}
test regexpComp-15.4 {regexp -start} -body {
    unset -nocomplain x
} {1 2}
test regexpComp-15.4 {regexp -start} {
    catch {unset x}
    list [regexp -start 5 {\d} 1abc2de3 x] $x
} -result {1 3}
test regexpComp-15.5 {regexp -start, over end of string} -body {
    unset -nocomplain x
} {1 3}
test regexpComp-15.5 {regexp -start, over end of string} {
    catch {unset x}
    list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
} -result {0 0}
test regexpComp-15.6 {regexp -start, loss of ^$ behavior} -body {
} {0 0}
test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
    list [regexp -start 2 {^$} {}]
} -result {0}
} {0}

test regexpComp-16.1 {regsub -start} -body {
    unset -nocomplain x
test regexpComp-16.1 {regsub -start} {
    catch {unset x}
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} -result {4 a1b/2c/3d/4e/5}
test regexpComp-16.2 {regsub -start} -body {
    unset -nocomplain x
} {4 a1b/2c/3d/4e/5}
test regexpComp-16.2 {regsub -start} {
    catch {unset x}
    list [regsub -all -start -25 {z} hello {/&} x] $x
} -result {0 hello}
test regexpComp-16.3 {regsub -start} -body {
    unset -nocomplain x
} {0 hello}
test regexpComp-16.3 {regsub -start} {
    catch {unset x}
    list [regsub -all -start 3 {z} hello {/&} x] $x
} -result {0 hello}
test regexpComp-16.4 {regsub -start, \A behavior} -body {
} {0 hello}
test regexpComp-16.4 {regsub -start, \A behavior} {
    set out {}
    lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
    lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
} -result {5 /a/b/c/d/e 3 ab/c/d/e}
} {5 /a/b/c/d/e 3 ab/c/d/e}

test regexpComp-17.1 {regexp -inline} -body {
test regexpComp-17.1 {regexp -inline} {
    regexp -inline b ababa
} -result {b}
test regexpComp-17.2 {regexp -inline} -body {
} {b}
test regexpComp-17.2 {regexp -inline} {
    regexp -inline (b) ababa
} -result {b b}
} {b b}
test regexpComp-17.3 {regexp -inline -indices} {
    regexp -inline -indices (b) ababa
} {{1 1} {1 1}}
test regexpComp-17.4 {regexp -inline} {
    regexp -inline {\w(\d+)\w} "   hello 23 there456def "
} {e456d 456}
test regexpComp-17.5 {regexp -inline no matches} {
790
791
792
793
794
795
796
797
798
799
800




801
802
803
804
805
806
807
784
785
786
787
788
789
790




791
792
793
794
795
796
797
798
799
800
801







-
-
-
-
+
+
+
+







	list $result [string length $result]
    }
} "\0a\0hel\0a\0lo\0a\0 14"

test regexpComp-20.1 {regsub shared object shimmering} {
    evalInProc {
	# Bug #461322
	set a abcdefghijklmnopqurstuvwxyz
	set b $a
	set c abcdefghijklmnopqurstuvwxyz0123456789
	regsub $a $c $b d
	set a abcdefghijklmnopqurstuvwxyz 
	set b $a 
	set c abcdefghijklmnopqurstuvwxyz0123456789 
	regsub $a $c $b d 
	list $d [string length $d] [string bytelength $d]
    }
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
    evalInProc {
	eval regexp -about abc
    }
983
984
985
986
987
988
989
990

991
992
993
994
995
996
997
977
978
979
980
981
982
983

984
985
986
987











-
+



-
-
-
-
    # Bug 1902436 - last * escaped
    evalInProc {
	set text {this is *bold* !}
	set re {\*bold\*.*!}
	regexp -- $re $text
    }
} 1


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/registry.test.

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
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












-
-
+
+












-







# registry.test --
#
# This file contains a collection of tests for the registry command.
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# In order for these tests to run, the registry package must be on the
# auto_path or the registry package must have been loaded already.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
# Copyright (c) 1998-1999 by Scriptics Corporation.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::regver [package require registry 1.3.5]
	}]} {
	testConstraint reg 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# determine the current locale
testConstraint english [expr {
    [llength [info commands testlocale]]
    && [string match "English*" [testlocale all ""]]
}]

670
671
672
673
674
675
676
677

678
679
680

681
682
683
684
685
686
687
688
689
690
691
692
669
670
671
672
673
674
675

676
677
678

679
680
681
682
683
684
685
686
687
688
689
690
691







-
+


-
+












} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.2 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast "" -time
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.3 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast "" - 500
} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
test registry-12.4 {BroadcastValue} -constraints {win reg notWine} -body {
test registry-12.4 {BroadcastValue} -constraints {win reg} -body {
    registry broadcast {Environment}
} -result {1 0}
test registry-12.5 {BroadcastValue} -constraints {win reg notWine} -body {
test registry-12.5 {BroadcastValue} -constraints {win reg} -body {
    registry b {}
} -result {1 0}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# tcl-indent-level: 4
# fill-column: 78
# End:

Changes to tests/remote.tcl.

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
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







-
-
-
+
+
+
+
+







-
+
+
+

-











+
+
+
+
+
+





-
-

-



-
+




-
+

-








    if {$VERBOSE} {
	puts "--- Server executing the following for socket $s:"
	puts $l
	puts "---"
    }
    set callerSocket $s
    set ::errorInfo ""
    set code [catch {uplevel "#0" $l} msg]
    return [list $code $::errorInfo $msg]
    if {[catch {uplevel #0 $l} msg]} {
	list error $msg
    } else {
	list success $msg
    }
}

proc __readAndExecute__ {s} {
    global command VERBOSE

    set l [gets $s]
    if {[string compare $l "--Marker--Marker--Marker--"] == 0} {
        puts $s [__doCommands__ $command($s) $s]
	if {[info exists command($s)]} {
	    puts $s [list error incomplete_command]
	}
	puts $s "--Marker--Marker--Marker--"
        set command($s) ""
	return
    }
    if {[string compare $l ""] == 0} {
	if {[eof $s]} {
	    if {$VERBOSE} {
		puts "Server closing $s, eof from client"
	    }
	    close $s
	}
	return
    }
    append command($s) $l "\n"
    if {[info complete $command($s)]} {
	set cmds $command($s)
	unset command($s)
	puts $s [__doCommands__ $cmds $s]
    }
    if {[eof $s]} {
	if {$VERBOSE} {
	    puts "Server closing $s, eof from client"
	}
	close $s
        unset command($s)
        return
    }
    append command($s) $l "\n"
}

proc __accept__ {s a p} {
    global command VERBOSE
    global VERBOSE

    if {$VERBOSE} {
	puts "Server accepts new connection from $a:$p on $s"
    }
    set command($s) ""
    fileevent $s readable [list __readAndExecute__ $s]
    fconfigure $s -buffering line -translation crlf
    fileevent $s readable [list __readAndExecute__ $s]
}

set serverIsSilent 0
for {set i 0} {$i < $argc} {incr i} {
    if {[string compare -serverIsSilent [lindex $argv $i]] == 0} {
	set serverIsSilent 1
	break
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159











147
148
149
150
151
152
153




154
155
156
157

158
159
160
161
162
163
164
165
166
167
168
169
170







-
-
-
-




-


+
+
+
+
+
+
+
+
+
+
+
    puts "from the shell. The tests will not work properly if you set"
    puts "remoteServerIP to \"localhost\" or 127.0.0.1."
    puts ""
    puts -nonewline "Type Ctrl-C to terminate--> "
    flush stdout
}

proc getPort sock {
    lindex [fconfigure $sock -sockname] 2
}

if {[catch {set serverSocket \
	[socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} {
    puts "Server on $serverAddress:$serverPort cannot start: $msg"
} else {
    puts ready
    vwait __server_wait_variable__
}











Changes to tests/rename.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+



-
-
-


-
-
-
+
+
+
+

-
+



-











-
-
-
+
+
+
+












-
+


-
-
+
+


-
-
-
-
+
+
+


-
-
-
-
+
+
+

-
-
-
+
+







# Commands covered:  rename
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testdel [llength [info commands testdel]]

# Must eliminate the "unknown" command while the test is running, especially
# if the test is being run in a program with its own special-purpose unknown
# command.
# Must eliminate the "unknown" command while the test is running,
# especially if the test is being run in a program with its
# own special-purpose unknown command.

catch {rename unknown unknown.old}


catch {rename r2 {}}
proc r1 {} {return "procedure r1"}
rename r1 r2

test rename-1.1 {simple renaming} {
    r2
} {procedure r1}
test rename-1.2 {simple renaming} {
    list [catch r1 msg] $msg
} {1 {invalid command name "r1"}}
rename r2 {}
test rename-1.3 {simple renaming} {
    list [catch r2 msg] $msg
} {1 {invalid command name "r2"}}

# The test below is tricky because it renames a built-in command. It's
# possible that the test procedure uses this command, so must restore the
# command before calling test again.
# The test below is tricky because it renames a built-in command.
# It's possible that the test procedure uses this command, so must
# restore the command before calling test again.

rename list l.new
set a [catch list msg1]
set b [l.new a b c]
rename l.new list
set c [catch l.new msg2]
set d [list 111 222]
test rename-2.1 {renaming built-in command} {
    list $a $msg1 $b $c $msg2 $d
} {1 {invalid command name "list"} {a b c} 1 {invalid command name "l.new"} {111 222}}

test rename-3.1 {error conditions} {
    list [catch {rename r1} msg] $msg $errorCode
} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
} {1 {wrong # args: should be "rename oldName newName"} NONE}
test rename-3.2 {error conditions} {
    list [catch {rename r1 r2 r3} msg] $msg $errorCode
} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
test rename-3.3 {error conditions} -setup {
} {1 {wrong # args: should be "rename oldName newName"} NONE}
test rename-3.3 {error conditions} {
    proc r1 {} {}
    proc r2 {} {}
} -returnCodes error -body {
    rename r1 r2
} -result {can't rename to "r2": command already exists}
test rename-3.4 {error conditions} -setup {
    list [catch {rename r1 r2} msg] $msg
} {1 {can't rename to "r2": command already exists}}
test rename-3.4 {error conditions} {
    catch {rename r1 {}}
    catch {rename r2 {}}
} -returnCodes error -body {
    rename r1 r2
} -result {can't rename "r1": command doesn't exist}
test rename-3.5 {error conditions} -setup {
    list [catch {rename r1 r2} msg] $msg
} {1 {can't rename "r1": command doesn't exist}}
test rename-3.5 {error conditions} {
    catch {rename _non_existent_command {}}
} -returnCodes error -body {
    rename _non_existent_command {}
} -result {can't delete "_non_existent_command": command doesn't exist}
    list [catch {rename _non_existent_command {}} msg] $msg
} {1 {can't delete "_non_existent_command": command doesn't exist}}

catch {rename unknown {}}
catch {rename unknown.old unknown}
catch {rename bar {}}

test rename-4.1 {reentrancy issues with command deletion and renaming} testdel {
    set x {}
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
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











+
-
-
-
+
+
+
+











+
-
-
+
+






-
-
+


+
-
-
+
+






-
-
-
-
    return -level 0 $x[unset x]
} ok

# Save the unknown procedure which is modified by the following test.

catch {rename unknown unknown.old}

test rename-5.1 {repeated rename deletion and redefinition of same command} {
set SAVED_UNKNOWN "proc unknown "
append SAVED_UNKNOWN [list [info args unknown.old] [info body unknown.old]]
test rename-5.1 {repeated rename deletion and redefinition of same command} {
    set SAVED_UNKNOWN "proc unknown "
    append SAVED_UNKNOWN "\{[info args unknown.old]\} "
    append SAVED_UNKNOWN "\{[info body unknown.old]\}"

    for {set i 0} {$i < 10} {incr i} {
        eval $SAVED_UNKNOWN
        tcl_wordBreakBefore "" 0
        rename tcl_wordBreakBefore {}
        rename unknown {}
    }
} {}

catch {rename unknown {}}
catch {rename unknown.old unknown}


test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed} -body {
    proc x {} {
test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
     proc x {} {
        set a 123
        set b [incr a]
    }
    x
    rename incr incr.old
    proc incr {} {puts "new incr called!"}
    x
} -cleanup {
    catch {x} msg
    rename incr {}
    rename incr.old incr
    set msg
} -returnCodes error -result {wrong # args: should be "incr"}

} {wrong # args: should be "incr"}

if {[info commands incr.old] != {}} {
    catch {rename incr {}}
    catch {rename incr.old incr}
}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/resolver.test.

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






























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# This test collection covers some unwanted interactions between command
# literal sharing and the use of command resolvers (per-interp) which cause
# command literals to be re-used with their command references being invalid
# in the reusing context.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2011 Gustaf Neumann <gustaf.neumann@wu.ac.at>
# Copyright (c) 2011 Stefan Sobernig <stefan.sobernig@wu.ac.at>
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testinterpresolver [llength [info commands testinterpresolver]]

test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup {
    testinterpresolver up
    namespace eval ::ns1 {
	proc z {} { return Z }
	namespace export z
    }
    proc ::y {} { return Y }
    proc ::x {} {
	z
    }
} -constraints testinterpresolver -body {
    # 1) Have the proc body compiled: During compilation or, alternatively,
    # the first evaluation of the compiled body, the InterpCmdResolver (see
    # tclTest.c) maps the cmd token "z" to "::y"; this mapping is saved in the
    # resulting CmdName Tcl_Obj with the print string "z". The CmdName Tcl_Obj
    # is turned into a command literal shared for a given (here: the global)
    # namespace.
    set r0 [x];			# --> The result of [x] is "Y"
    # 2) After having requested cmd resolution above, we can now use the
    # globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is
    # certainly questionable, but defensible
    set r1 [z];			# --> The result of [z] is "Y"
    # 3) We import from the namespace ns1 another z. [namespace import] takes
    # care "shadowed" cmd references, however, till now cmd literals have not
    # been touched. This is, however, necessary since the BC compiler (used in
    # the [namespace eval]) seems to be eager to reuse CmdName Tcl_Objs as cmd
    # literals for a given NS scope. We expect, that r2 is "Z", the result of
    # the namespace imported cmd.
    namespace eval :: {
	namespace import ::ns1::z
	set r2 [z]
    }
    list $r0 $r1 $::r2
} -cleanup {
    testinterpresolver down
    rename ::x ""
    rename ::y ""
    namespace delete ::ns1
} -result {Y Y Z}
test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
    testinterpresolver up
    proc ::y {} { return Y }
    proc ::x {} {
	z
    }
} -constraints testinterpresolver -body {
    set r0 [x]
    set r1 [z]
    proc ::foo {} {
	proc ::z {} { return Z }
	return [z]
    }
    list $r0 $r1 [::foo]
} -cleanup {
    testinterpresolver down
    rename ::x ""
    rename ::y ""
    rename ::foo ""
    rename ::z ""
} -result {Y Y Z}
test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
    testinterpresolver up
    proc ::Z {} { return Z }
    proc ::y {} { return Y }
    proc ::x {} {
	z
    }
} -constraints testinterpresolver -body {
    set r0 [x]
    set r1 [z]
    namespace eval :: {
	rename ::Z ::z
	set r2 [z]
    }
    list $r0 $r1 $r2
} -cleanup {
    testinterpresolver down
    rename ::x ""
    rename ::y ""
    rename ::z ""
} -result {Y Y Z}
test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
    testinterpresolver up
    proc ::Z {} { return Z }
    interp hide {} Z
    proc ::y {} { return Y }
    proc ::x {} {
	z
    }
} -constraints testinterpresolver -body {
    set r0 [x]
    set r1 [z]
    interp expose {} Z z
    namespace eval :: {
	set r2 [z]
    }
    list $r0 $r1 $r2
} -cleanup {
    testinterpresolver down
    rename ::x ""
    rename ::y ""
    rename ::z ""
} -result {Y Y Z}
test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup {
    testinterpresolver up
    namespace eval ::ns1 {
	proc z {} { return Z }
	namespace export z
    }
    proc ::y {} { return Y }
    namespace eval ::ns2 {
	proc x {} {
	    z
	}
    }
    namespace eval :: {
	variable r2 ""
    }
} -constraints testinterpresolver -body {
    list [namespace eval ::ns2 {x}] [namespace eval ::ns2 {z}] [namespace eval ::ns2 {
	namespace import ::ns1::z
	z
    }]
} -cleanup {
    testinterpresolver down
    namespace delete ::ns2
    namespace delete ::ns1
} -result {Y Y Z}
test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup {
    testinterpresolver up
    proc ::Z {} { return Z }
    proc ::y {} { return Y }
    proc ::x {} {
	z
    }
} -constraints testinterpresolver -body {
    set r0 [x]
    set r1 [z]
    namespace eval :: {
	interp alias {} ::z {} ::Z
	set r2 [z]
    }
    list $r0 $r1 $r2
} -cleanup {
    testinterpresolver down
    rename ::x ""
    rename ::y ""
    rename ::Z ""
} -result {Y Y Z}

test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
    testinterpresolver up
    # The compiled var resolver fetches just variables starting with a capital
    # "T" and stores some test information in the resolver-specific resolver
    # var info.
    proc ::x {} {
	set T1 100
	return $T1
    }
} -constraints testinterpresolver -body {
    # Call "x" the first time, causing a byte code compilation of the body.
    # During the compilation the compiled var resolver, the resolve-specific
    # var info is allocated, during the execution of the body, the variable is
    # fetched and cached.
    x
    # During later calls, the cached variable is reused.
    x
    # When the proc is freed, the resolver-specific resolver var info is
    # freed. This did not happen before fix #3383616.
    rename ::x ""
} -cleanup {
    testinterpresolver down
} -result {}


#
# The test resolver-3.1* test bad interactions of resolvers on the "global"
# (per interp) literal pools. A resolver might resolve a cmd literal depending
# on a context differently, whereas the cmd literal sharing assumed that the
# namespace containing the literal solely determines the resolved cmd (and is
# resolver-agnostic).
#
# In order to make the test cases for the per-interpreter cmd literal pool
# reproducable and to minimize interactions between test cases, we use a child
# interpreter per test-case.
#
#
# Testing resolver in namespace-based context "ctx1"
#
test resolver-3.1a {
    interp command resolver,
    resolve literal "z" in proc "x1" in context "ctx1"
} -setup {

    interp create i0
    testinterpresolver up i0
    i0 eval {
	proc y {} { return yy }
	namespace eval ::ns {
	    proc x1 {} { z }
	}
    }
} -constraints testinterpresolver -body {

    set r [i0 eval {namespace eval ::ctx1 {
	::ns::x1
    }}]

    return $r
} -cleanup {
    testinterpresolver down i0
    interp delete i0
} -result {yy}

#
# Testing resolver in namespace-based context "ctx2"
#
test resolver-3.1b {
    interp command resolver,
    resolve literal "z" in proc "x2" in context "ctx2"
} -setup {

    interp create i0
    testinterpresolver up i0
    i0 eval {
	proc Y {} { return YY }
	namespace eval ::ns {
	    proc x2 {} { z }
	}
    }
} -constraints testinterpresolver -body {

    set r [i0 eval {namespace eval ::ctx2 {
	::ns::x2
    }}]

    return $r
} -cleanup {
    testinterpresolver down i0
    interp delete i0
} -result {YY}

#
# Testing resolver in namespace-based context "ctx1" and "ctx2" in the same
# interpreter.
#

test resolver-3.1c {
    interp command resolver,
    resolve literal "z" in proc "x1" in context "ctx1",
    resolve literal "z" in proc "x2" in context "ctx2"

    Test, whether the shared cmd literal created by the first byte-code
    compilation interacts with the second one.
} -setup {

    interp create i0
    testinterpresolver up i0

    i0 eval {
	proc y {} { return yy }
	proc Y {} { return YY }
	namespace eval ::ns {
	    proc x1 {} { z }
	    proc x2 {} { z }
	}
    }

} -constraints testinterpresolver -body {

    set r1 [i0 eval {namespace eval ::ctx1 {
	::ns::x1
    }}]

    set r2 [i0 eval {namespace eval ::ctx2 {
	::ns::x2
    }}]

    set r3 [i0 eval {namespace eval ::ctx1 {
	::ns::x1
    }}]

    return [list $r1 $r2 $r3]
} -cleanup {
    testinterpresolver down i0
    interp delete i0
} -result {yy YY yy}


cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/result.test.

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
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












-
-
-
+
+
-
-
-
-
















-
+











-
+



+











-
-
-
+
+
+







# This file tests the routines in tclResult.c.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testsaveresult command

testConstraint testsaveresult      [llength [info commands testsaveresult]]
testConstraint testsetobjerrorcode [llength [info commands testsetobjerrorcode]]
testConstraint testseterrorcode    [llength [info commands testseterrorcode]]
testConstraint testreturn          [llength [info commands testreturn]]

test result-1.1 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult small {set x 42} 0
} {small result}
test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult append {set x 42} 0
} {append result}
test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult dynamic {set x 42} 0
} {dynamic result freed}
} {dynamic result notCalled present}
test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult object {set x 42} 0
} {object result same}
test result-1.5 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult small {set x 42} 1
} {42}
test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult append {set x 42} 1
} {42}
test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult dynamic {set x 42} 1
} {42 freed}
} {42 called missing}
test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} {
    testsaveresult object {set x 42} 1
} {42 different}


# Tcl_RestoreInterpResult is mostly tested by the previous tests except
# for the following case

test result-2.1 {Tcl_RestoreInterpResult} {testsaveresult} {
    testsaveresult append {cd _foobar} 0
} {append result}

# Tcl_DiscardInterpResult is mostly tested by the previous tests except
# for the following cases

test result-3.1 {Tcl_DiscardInterpResult} -constraints testsaveresult -body {
    testsaveresult append {cd _foobar} 1
} -returnCodes error -result {couldn't change working directory to "_foobar": no such file or directory}
test result-3.1 {Tcl_DiscardInterpResult} {testsaveresult} {
    list [catch {testsaveresult append {cd _foobar} 1} msg] $msg
} {1 {couldn't change working directory to "_foobar": no such file or directory}}
test result-3.2 {Tcl_DiscardInterpResult} {testsaveresult} {
    testsaveresult free {set x 42} 1
} {42}

test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsetobjerrorcode} {
    catch {testsetobjerrorcode 1}
    list [set errorCode]
129
130
131
132
133
134
135
136
137


138
139
140
141
142
143
144
145
146
147
148
149
125
126
127
128
129
130
131


132
133
134








135
136
137







-
-
+
+

-
-
-
-
-
-
-
-



    set ::errorCode {}
} -body {
    foo
} -cleanup {
    rename foo {}
} -result {foo {} {}}
test result-6.3 {Bug 2383005} {
     catch {return -code error -errorcode {{}a} eek} m
     set m
    catch {return -code error -errorcode {{}a} eek} m
    set m
} {bad -errorcode value: expected a list but got "{}a"}
test result-6.4 {non-list -errorstack} -body {
     catch {return -code error -errorstack {{}a} eek} m o
     list $m [dict get $o -errorcode] [dict get $o -errorstack]
} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}}
test result-6.5 {odd-sized-list -errorstack} -body {
     catch {return -code error -errorstack a eek} m o
     list $m [dict get $o -errorcode] [dict get $o -errorstack]
} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}}
# cleanup
cleanupTests
return

Deleted tests/safe-stock.test.

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
























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# safe-stock.test --
#
# This file contains tests for safe Tcl that were previously in the file
# safe.test, and use files and packages of stock Tcl 8.7 to perform the tests.
# These files may be changed or disappear in future revisions of Tcl, for
# example package opt will eventually be removed.
#
# The tests are replaced in safe.tcl with tests that use files provided in the
# tests directory.  Test numbering is for comparison with similar tests in
# safe.test.
#
# Sourcing this file into tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# The defunct package http 1.0 was convenient for testing package loading.
# - This file, safe-stock.test, uses packages opt and (from cookiejar)
#   tcl::idna to provide alternative tests based on stock Tcl packages.
#   - These are tests 7.1 7.2 7.4 9.11 9.13
#   - Tests 7.[124], 9.1[13] use "package require opt".
#   - Tests 9.1[13] also use "package require tcl::idna".
# - The corresponding tests in safe.test use example packages provided in
#   subdirectory auto0 of the tests directory, which are independent of any
#   changes made to the packages provided with Tcl.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

foreach i [interp children] {
    interp delete $i
}

# When using package opt for testing positive/negative package search:
# - The directory location and the error message depend on whether
#   and how the package is installed.

# Error message for test 7.2 for "package require opt".
if {[string match *zipfs:/* [info library]]} {
    # pkgIndex.tcl is in [info library]
    # file to be sourced is in [info library]/opt*
    set pkgOptErrMsg {permission denied}
} else {
    # pkgIndex.tcl and file to be sourced are
    # both in [info library]/opt*
    set pkgOptErrMsg {can't find package opt}
}

# Directory of opt for tests 7.4, 9.10, 9.12 for "package require opt".
if {[file exists [file join [info library] opt0.4]]} {
    # Installed files in lib8.7/opt0.4
    set pkgOptDir opt0.4
} elseif {[file exists [file join [info library] opt]]} {
    # Installed files in zipfs, or source files used by "make test"
    set pkgOptDir opt
} else {
    error {cannot find opt library}
}

# Directory of cookiejar for tests 9.10, 9.12 for "package require tcl::idna".
if {[file exists [file join [info library] cookiejar0.2]]} {
    # Installed files in lib8.7/cookiejar0.2
    set pkgJarDir cookiejar0.2
} elseif {[file exists [file join [info library] cookiejar]]} {
    # Installed files in zipfs, or source files used by "make test"
    set pkgJarDir cookiejar
} else {
    error {cannot find cookiejar library}
}

set SaveAutoPath $::auto_path
set ::auto_path [info library]
set TestsDir [file normalize [file dirname [info script]]]
set PathMapp {}
lappend PathMapp [file join [info library] $pkgOptDir] TCLLIB/OPTDIR
lappend PathMapp [file join [info library] $pkgJarDir] TCLLIB/JARDIR
lappend PathMapp $tcl_library TCLLIB $TestsDir TESTSDIR

proc mapList {map listIn} {
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    return $listOut
}
proc mapAndSortList {map listIn} {
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    lsort $listOut
}

# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}

# high level general test
test safe-stock-7.1 {tests that everything works at high level, uses pkg opt} -setup {
    set i [safe::interpCreate]
} -body {
    # no error shall occur:
    # (because the default access_path shall include 1st level sub dirs so
    #  package require in a child works like in the parent)
    set v [interp eval $i {package require opt}]
    # no error shall occur:
    interp eval $i {::tcl::Lempty {a list}}
    set v
} -cleanup {
    safe::interpDelete $i
} -match glob -result 0.4.*
test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses pkg opt} -setup {
} -body {
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
    # should not add anything (p0)
    set token1 [safe::interpAddToAccessPath $i [info library]]
    # should add as p* (not p1 if parent has a module path)
    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
    # an error shall occur (opt is not anymore in the secure 0-level
    # provided deep path)
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    list $token1 $token2 -- \
	    [catch {interp eval $i {package require opt}} msg] $msg -- \
	    $mappA -- [safe::interpDelete $i]
} -cleanup {
} -match glob -result "{\$p(:0:)} {\$p(:*:)} -- 1 {$pkgOptErrMsg} --\
        {TCLLIB */dummy/unixlike/test/path} -- {}"
test safe-stock-7.4 {tests specific path and positive search, uses pkg opt} -setup {
} -body {
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
    # should not add anything (p0)
    set token1 [safe::interpAddToAccessPath $i [info library]]
    # should add as p* (not p1 if parent has a module path)
    set token2 [safe::interpAddToAccessPath $i [file join [info library] $pkgOptDir]]
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    # this time, unlike test safe-stock-7.2, opt should be found
    list $token1 $token2 -- \
            [catch {interp eval $i {package require opt}} msg] $msg -- \
            $mappA -- [safe::interpDelete $i]
    # Note that the glob match elides directories (those from the module path)
    # other than the first and last in the access path.
} -cleanup {
} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 0.4.* --\
        {TCLLIB * TCLLIB/OPTDIR} -- {}}

# The following test checks whether the definition of tcl_endOfWord can be
# obtained from auto_loading.  It was previously test "safe-5.1".
test safe-stock-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setup {
    catch {safe::interpDelete a}
    safe::interpCreate a
} -body {
    interp eval a {tcl_endOfWord "" 0}
} -cleanup {
    safe::interpDelete a
} -result -1
test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, uses pkg opt and tcl::idna} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $tcl_library $pkgOptDir] \
                                            [file join $tcl_library $pkgJarDir]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]]
    set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]]

    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
    # This has no effect because the records in Pkg of these directories were from access as children of {$p(:0:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $tcl_library $pkgJarDir] \
                                           [file join $tcl_library $pkgOptDir]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]]
    set path4 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]]

    # Try to load the packages and run a command from each one.
    set code3 [catch {interp eval $i {package require tcl::idna}} msg3]
    set code4 [catch {interp eval $i {package require opt}} msg4]
    set code5 [catch {interp eval $i {::tcl::Lempty {a list}}} msg5]
    set code6 [catch {interp eval $i {::tcl::idna::IDNAencode example.com}} msg6]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
         $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.* 0 0.4.* --\
        {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} --\
        {TCLLIB TCLLIB/JARDIR TCLLIB/OPTDIR*} --\
        0 0 0 example.com}
test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, uses pkg opt and tcl::idna} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $tcl_library $pkgOptDir] \
                                            [file join $tcl_library $pkgJarDir]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]]
    set path2 [::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]]

    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Limit access path.  Remove tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library]

    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set code4 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgOptDir]} path4]
    set code5 [catch {::safe::interpFindInAccessPath $i [file join $tcl_library $pkgJarDir]} path5]

    # Try to load the packages.
    set code3 [catch {interp eval $i {package require opt}} msg3]
    set code6 [catch {interp eval $i {package require tcl::idna}} msg6]

    list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
            $mappA -- $mappB
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
        1 {* not found in access path} -- 1 1 --\
        {TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} -- {TCLLIB*}}

set ::auto_path $SaveAutoPath
unset pkgOptErrMsg pkgOptDir pkgJarDir SaveAutoPath TestsDir PathMapp
rename mapList {}
rename mapAndSortList {}
# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/safe-zipfs.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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

























































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# safe-zipfs.test --
#
# This file contains tests for safe Tcl that test its compatibility with the
# zipfs facilities introduced in Tcl 8.7.  Test numbering is for comparison
# with similar tests in safe.test that do not use the zipfs file system.
#
# Sourcing this file into tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.

package require Tcl 8.5-

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

foreach i [interp children] {
    interp delete $i
}

set SaveAutoPath $::auto_path
set ::auto_path [info library]
set TestsDir [file normalize [file dirname [info script]]]

set ZipMountPoint [zipfs root]auto-files
zipfs mount $ZipMountPoint [file join $TestsDir auto-files.zip]

set PathMapp {}
lappend PathMapp $tcl_library TCLLIB $TestsDir TESTSDIR $ZipMountPoint ZIPDIR

proc mapList {map listIn} {
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    return $listOut
}
proc mapAndSortList {map listIn} {
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    lsort $listOut
}

# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}

# testing that nested and statics do what is advertised (we use a static
# package - Tcltest - but it might be absent if we're in standard tclsh)

testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]

# Tests 5.* test the example files before using them to test safe interpreters.

test safe-zipfs-5.1 {example tclIndex commands, test in parent interpreter; zipfs} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]
} -body {
    # Try to load the commands.
    set code3 [catch report1 msg3]
    set code4 [catch report2 msg4]
    list $code3 $msg3 $code4 $msg4
} -cleanup {
    catch {rename report1 {}}
    catch {rename report2 {}}
    set ::auto_path $tmpAutoPath
    auto_reset
} -match glob -result {0 ok1 0 ok2}
test safe-zipfs-5.2 {example tclIndex commands, negative test in parent interpreter; zipfs} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $ZipMountPoint auto0]
} -body {
    # Try to load the commands.
    set code3 [catch report1 msg3]
    set code4 [catch report2 msg4]
    list $code3 $msg3 $code4 $msg4
} -cleanup {
    catch {rename report1 {}}
    catch {rename report2 {}}
    set ::auto_path $tmpAutoPath
    auto_reset
} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
test safe-zipfs-5.3 {example pkgIndex.tcl packages, test in parent interpreter, child directories; zipfs} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $ZipMountPoint auto0]
} -body {
    # Try to load the packages and run a command from each one.
    set code3 [catch {package require SafeTestPackage1} msg3]
    set code4 [catch {package require SafeTestPackage2} msg4]
    set code5 [catch HeresPackage1 msg5]
    set code6 [catch HeresPackage2 msg6]
    list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
    set ::auto_path $tmpAutoPath
    catch {package forget SafeTestPackage1}
    catch {package forget SafeTestPackage2}
    catch {rename HeresPackage1 {}}
    catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
test safe-zipfs-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories; zipfs} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $ZipMountPoint auto0 auto1] \
                        [file join $ZipMountPoint auto0 auto2]
} -body {
    # Try to load the packages and run a command from each one.
    set code3 [catch {package require SafeTestPackage1} msg3]
    set code4 [catch {package require SafeTestPackage2} msg4]
    set code5 [catch HeresPackage1 msg5]
    set code6 [catch HeresPackage2 msg6]
    list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
    set ::auto_path $tmpAutoPath
    catch {package forget SafeTestPackage1}
    catch {package forget SafeTestPackage2}
    catch {rename HeresPackage1 {}}
    catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
test safe-zipfs-5.5 {example modules packages, test in parent interpreter, replace path; zipfs} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
    # Try to load the modules and run a command from each one.
    set code0 [catch {package require test0} msg0]
    set code1 [catch {package require mod1::test1} msg1]
    set code2 [catch {package require mod2::test2} msg2]
    set out0  [test0::try0]
    set out1  [mod1::test1::try1]
    set out2  [mod2::test2::try2]
    list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    catch {package forget test0}
    catch {package forget mod1::test1}
    catch {package forget mod2::test2}
    catch {namespace delete ::test0}
    catch {namespace delete ::mod1}
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
test safe-zipfs-5.6 {example modules packages, test in parent interpreter, append to path; zipfs} -setup {
    tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
    # Try to load the modules and run a command from each one.
    set code0 [catch {package require test0} msg0]
    set code1 [catch {package require mod1::test1} msg1]
    set code2 [catch {package require mod2::test2} msg2]
    set out0  [test0::try0]
    set out1  [mod1::test1::try1]
    set out2  [mod2::test2::try2]
    list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
    catch {package forget test0}
    catch {package forget mod1::test1}
    catch {package forget mod2::test2}
    catch {namespace delete ::test0}
    catch {namespace delete ::mod1}
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}

# high level general test
# Use zipped example packages not http1.0 etc
test safe-zipfs-7.1 {tests that everything works at high level; zipfs} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $ZipMountPoint auto0]
    set i [safe::interpCreate]
    set ::auto_path $tmpAutoPath
} -body {
    # no error shall occur:
    # (because the default access_path shall include 1st level sub dirs so
    #  package require in a child works like in the parent)
    set v [interp eval $i {package require SafeTestPackage1}]
    # no error shall occur:
    interp eval $i {HeresPackage1}
    set v
} -cleanup {
    safe::interpDelete $i
} -match glob -result 1.2.3
test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath; zipfs} -setup {
} -body {
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
    # should not add anything (p0)
    set token1 [safe::interpAddToAccessPath $i [info library]]
    # should add as p* (not p1 if parent has a module path)
    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
    # should add as p* (not p2 if parent has a module path)
    set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]]
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
    # provided deep path)
    list $token1 $token2 $token3 -- \
            [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
            $mappA -- [safe::interpDelete $i]
} -cleanup {
} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
        1 {can't find package SafeTestPackage1} --\
        {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}}
test safe-zipfs-7.4 {tests specific path and positive search; zipfs} -setup {
} -body {
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
    # should not add anything (p0)
    set token1 [safe::interpAddToAccessPath $i [info library]]
    # should add as p* (not p1 if parent has a module path)
    set token2 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    # this time, unlike test safe-zipfs-7.2, SafeTestPackage1 should be found
    list $token1 $token2 -- \
	    [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
	    $mappA -- [safe::interpDelete $i]
    # Note that the glob match elides directories (those from the module path)
    # other than the first and last in the access path.
} -cleanup {
} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
        {TCLLIB * ZIPDIR/auto0/auto1} -- {}}

test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset); zipfs} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $ZipMountPoint auto0 auto1] \
                                            [file join $ZipMountPoint auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Load auto_load data.
    interp eval $i {catch nonExistentCommand}

    # Load and run the commands.
    # This guarantees the test will pass even if the tokens are swapped.
    set code1 [catch {interp eval $i {report1}} msg1]
    set code2 [catch {interp eval $i {report2}} msg2]

    # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $ZipMountPoint auto0 auto2] \
                                           [file join $ZipMountPoint auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Run the commands.
    set code3 [catch {interp eval $i {report1}} msg3]
    set code4 [catch {interp eval $i {report2}} msg4]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
        {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
test safe-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset); zipfs} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $ZipMountPoint auto0 auto1] \
                                            [file join $ZipMountPoint auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Load auto_load data.
    interp eval $i {catch nonExistentCommand}

    # Do not load the commands.  With the tokens swapped, the test
    # will pass only if the Safe Base has called auto_reset.

    # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $ZipMountPoint auto0 auto2] \
                                           [file join $ZipMountPoint auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Load and run the commands.
    set code3 [catch {interp eval $i {report1}} msg3]
    set code4 [catch {interp eval $i {report2}} msg4]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
        0 ok1 0 ok2 --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
        {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
test safe-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement; zipfs} -setup {
} -body {
    # For complete correspondence to safe-stock87-9.11, include auto0 in access path.
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $ZipMountPoint auto0] \
                                            [file join $ZipMountPoint auto0 auto1] \
                                            [file join $ZipMountPoint auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Rearrange access path.  Swap tokens {$p(:2:)} and {$p(:3:)}.
    # This would have no effect because the records in Pkg of these directories
    # were from access as children of {$p(:1:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $ZipMountPoint auto0] \
                                           [file join $ZipMountPoint auto0 auto2] \
                                           [file join $ZipMountPoint auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Try to load the packages and run a command from each one.
    set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
    set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
    set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
    set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
         $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
        {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
        {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
        0 OK1 0 OK2}
test safe-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0; zipfs} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $ZipMountPoint auto0 auto1] \
                                            [file join $ZipMountPoint auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $ZipMountPoint auto0 auto2] \
                                           [file join $ZipMountPoint auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Try to load the packages and run a command from each one.
    set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
    set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
    set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
    set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
            $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
        0 1.2.3 0 2.3.4 --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
        {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
        0 OK1 0 OK2}
test safe-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed; zipfs} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $ZipMountPoint auto0 auto1] \
                                            [file join $ZipMountPoint auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]]

    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Limit access path.  Remove tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library]

    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set code4 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto1]} path4]
    set code5 [catch {::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 auto2]} path5]

    # Try to load the packages.
    set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
    set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]

    list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
            $mappA -- $mappB
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
        1 {* not found in access path} -- 1 1 --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}}
test safe-zipfs-9.20 {check module loading; zipfs} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
         ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
# - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in
#   tokenized form to the child's access path, and then adds all the
#   descendants, discovered recursively by using glob.
# - The order of the directories in the list returned by glob is system-dependent,
#   and therefore this is true also for (a) the order of token assignment to
#   descendants of the [tcl::tm::list] roots; and (b) the order of those same
#   directories in the access path.  Both those things must be sorted before
#   comparing with expected results.  The test is therefore not totally strict,
#   but will notice missing or surplus directories.
test safe-zipfs-9.21 {interpConfigure change the access path; check module loading; stale data case 1; zipfs} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $ZipMountPoint auto0 auto1] \
                                           [file join $ZipMountPoint auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Load pkg data.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
    catch {interp eval $i {package require mod2::NOEXIST}}

    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
         ZIPDIR/auto0/modules/mod2} --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
         ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
test safe-zipfs-9.22 {interpConfigure change the access path; check module loading; stale data case 0; zipfs} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                          [file join $ZipMountPoint auto0 auto1] \
                                          [file join $ZipMountPoint auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
         ZIPDIR/auto0/modules/mod2} --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
         ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
test safe-zipfs-9.23 {interpConfigure change the access path; check module loading; stale data case 3; zipfs} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Force the interpreter to acquire pkg data which will soon become stale.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
    catch {interp eval $i {package require mod2::NOEXIST}}

    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $ZipMountPoint auto0 auto1] \
                                           [file join $ZipMountPoint auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Refresh stale pkg data.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
    catch {interp eval $i {package require mod2::NOEXIST}}

    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
         ZIPDIR/auto0/modules/mod2} --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
         ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
test safe-zipfs-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case); zipfs} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $ZipMountPoint auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Force the interpreter to acquire pkg data which will soon become stale.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
    catch {interp eval $i {package require mod2::NOEXIST}}

    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $ZipMountPoint auto0 auto1] \
                                           [file join $ZipMountPoint auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set path3 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $ZipMountPoint auto0 modules mod2]]

    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
         ZIPDIR/auto0/modules/mod2} --\
        {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
         ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.

# cleanup
set ::auto_path $SaveAutoPath
zipfs unmount ${ZipMountPoint}
unset SaveAutoPath TestsDir ZipMountPoint PathMapp
rename mapList {}
rename mapAndSortList {}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/safe.test.

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
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
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
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
611
612
613
614
615

616
617

618
619
620
621

622
623
624
625
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
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
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
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

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

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
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
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
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


-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-




-
-
+
+

+
+
-
-
+
+



-
+



-
+

-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+


-
-
-
+
-

-
-
-
-
-
-
-
+
+
+
+
+
+
+



-
-
+
+




-
-
-
-
-
+
+
+
+
+
+





-
+

-

-
+
-

-
-
-
-
+
+
+

-

-
+
-

-
+
+

-
+


-

-
+
-

+
-
-
+
+

-

-
+
-

+
-
-
+
+

-

-
+
-

-
-
+
+
+

-

+
-
+
-

+
-
+

-
+

-


-
-
-
-
+
+

-



-
-
+
+
-
-
+

-

-
+
-
-
-
-
+
+
+

-


-
+

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-


















-
+

-
-
+
+

-
-
-
+
+
+
+
+
+

-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
+


-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+


-
-
+
+

-
-
-
+
+
-
-
+
+
-
-
-
-
+
+
+

-
-
-
+
+
-
-
+
+
-
-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+

+
-
+

-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+

+
-
+

-
+
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+

+
-
+

-
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+

+
-
+

-
+
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+





-









-


-












-


-
-
+
+


-

-
+



-
+

-
+

-
-
-
-
-
-
+
+
+


+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+




-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+





-
+

-
+

-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
-
-
-
-
+
+
+
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
+

-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-







# safe.test --
#
# This file contains a collection of tests for safe Tcl, packages loading, and
# using safe interpreters. Sourcing this file into tcl runs the tests and
# generates output for errors. No output means no errors were found.
# This file contains a collection of tests for safe Tcl, packages loading,
# and using safe interpreters. Sourcing this file into tcl runs the tests
# and generates output for errors.  No output means no errors were found.
#
# The defunct package http 1.0 was convenient for testing package loading.
# - Tests that used http are replaced here with tests that use example packages
#   provided in subdirectory auto0 of the tests directory, which are independent
#   of any changes made to the packages provided with Tcl itself.
#   - These are tests 7.1 7.2 7.4 9.11 9.13
#   - Tests 5.* test the example packages themselves before they
#     are used to test Safe Base interpreters.
# - Alternative tests using stock packages of Tcl 8.7 are in file
#   safe-stock.test.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# 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.
# 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.5

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

foreach i [interp children] {
foreach i [interp slaves] {
    interp delete $i
}

set SaveAutoPath $::auto_path
set saveAutoPath $::auto_path
set ::auto_path [info library]
set TestsDir [file normalize [file dirname [info script]]]
set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR]

proc mapList {map listIn} {
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    return $listOut
}
proc mapAndSortList {map listIn} {
    set listOut {}
    foreach element $listIn {
        lappend listOut [string map $map $element]
    }
    lsort $listOut
}

# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
# Force actual loading of the safe package
# because we use un exported (and thus un-autoindexed) APIs
# in this test result arguments:
catch {safe::interpConfigure}

# testing that nested and statics do what is advertised (we use a static
# package - Tcltest - but it might be absent if we're in standard tclsh)

proc equiv {x} {return $x}
testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]

test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
    safe::interpConfigure
} -result {no value given for parameter "child" (use -help for full usage) :
    child name () name of the child}
test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
    safe::interpCreate -help
} -result {Usage information:
test safe-1.1 {safe::interpConfigure syntax} {
    list [catch {safe::interpConfigure} msg] $msg;
} {1 {no value given for parameter "slave" (use -help for full usage) :
    slave name () name of the slave}}
test safe-1.2 {safe::interpCreate syntax} {
    list [catch {safe::interpCreate -help} msg] $msg;
} {1 {Usage information:
    Var/FlagName  Type     Value   Help
    ------------  ----     -----   ----
    (-help                         gives this help)
    ?child?       name     ()      name of the child (optional)
    -accessPath   list     ()      access path for the child
    ?slave?       name     ()      name of the slave (optional)
    -accessPath   list     ()      access path for the slave
    -noStatics    boolflag (false) prevent loading of statically linked pkgs
    -statics      boolean  (true)  loading of statically linked pkgs
    -nestedLoadOk boolflag (false) allow nested loading
    -nested       boolean  (false) nested loading
    -deleteHook   script   ()      delete hook}
test safe-1.3 {safe::interpInit syntax} -returnCodes error -body {
    safe::interpInit -noStatics
} -result {bad value "-noStatics" for parameter
    child name () name of the child}
    -deleteHook   script   ()      delete hook}}
test safe-1.3 {safe::interpInit syntax} {
    list [catch {safe::interpInit -noStatics} msg] $msg;
} {1 {bad value "-noStatics" for parameter
    slave name () name of the slave}}


test safe-2.1 {creating interpreters, should have no aliases} emptyTest {
    # Disabled this test.  It tests nothing sensible.  [Bug 999612]
    # interp aliases
} ""
test safe-2.2 {creating interpreters, should have no aliases} -setup {
test safe-2.2 {creating interpreters, should have no aliases} {
    catch {safe::interpDelete a}
} -body {
    interp create a
    a aliases
    set l [a aliases]
} -cleanup {
    safe::interpDelete a
    # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
    # is regrettable and should be removed at the next major revision.
} -result ""
test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup {
    set l
} ""
test safe-2.3 {creating safe interpreters, should have no unexpected aliases} {
    catch {safe::interpDelete a}
} -body {
    interp create a -safe
    lsort [a aliases]
    set l [a aliases]
} -cleanup {
    interp delete a
} -result {clock}
    lsort $l
} {::tcl::mathfunc::max ::tcl::mathfunc::min clock}

test safe-3.1 {calling safe::interpInit is safe} -setup {
test safe-3.1 {calling safe::interpInit is safe} {
    catch {safe::interpDelete a}
    interp create a -safe
} -body {
    safe::interpInit a
    interp eval a exec ls
    catch {interp eval a exec ls} msg
} -returnCodes error -cleanup {
    safe::interpDelete a
    set msg
} -result {invalid command name "exec"}
test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
} {invalid command name "exec"}
test safe-3.2 {calling safe::interpCreate on trusted interp} {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    lsort [a aliases]
    set l [lsort [a aliases]]
} -cleanup {
    safe::interpDelete a
    set l
} -result {::tcl::encoding::system ::tcl::file::dirname ::tcl::file::extension ::tcl::file::rootname ::tcl::file::tail ::tcl::info::nameofexecutable clock encoding exit file glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
} {::tcl::info::nameofexecutable clock encoding exit file glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    interp eval a {source [file join $tcl_library init.tcl]}
    set x [interp eval a {source [file join $tcl_library init.tcl]}]
} -cleanup {
    safe::interpDelete a
} -result ""
test safe-3.4 {calling safe::interpCreate on trusted interp} -setup {
    set x
} ""
test safe-3.4 {calling safe::interpCreate on trusted interp} {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    catch {set x \
    interp eval a {source [file join $tcl_library init.tcl]}
		[interp eval a {source [file join $tcl_library init.tcl]}]} msg
} -cleanup {
    safe::interpDelete a
    list $x $msg
} -result {}
} {{} {}}

test safe-4.1 {safe::interpDelete} -setup {
test safe-4.1 {safe::interpDelete} {
    catch {safe::interpDelete a}
} -body {
    interp create a
    safe::interpDelete a
    # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
    # is regrettable and should be removed at the next major revision.
} -result ""
test safe-4.2 {safe::interpDelete, indirectly} -setup {
} ""
test safe-4.2 {safe::interpDelete, indirectly} {
    catch {safe::interpDelete a}
} -body {
    interp create a
    a alias exit safe::interpDelete a
    a eval exit
    # This (ab)use of safe::interpDelete to delete non-Safe-Base interpreters
    # is regrettable and should be removed at the next major revision.
} ""

} -result ""
test safe-4.5 {safe::interpDelete} -setup {
test safe-4.5 {safe::interpDelete} {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    safe::interpCreate a
    catch {safe::interpCreate a} msg
} -returnCodes error -cleanup {
    safe::interpDelete a
} -result {interpreter named "a" already exists, cannot create}
test safe-4.6 {safe::interpDelete, indirectly} -setup {
    set msg
} {interpreter named "a" already exists, cannot create}
test safe-4.6 {safe::interpDelete, indirectly} {
    catch {safe::interpDelete a}
} -body {
    safe::interpCreate a
    a eval exit
} -result ""
} ""

# The old test "safe-5.1" has been moved to "safe-stock-9.8".
# A replacement test using example files is "safe-9.8".
# Tests 5.* test the example files before using them to test safe interpreters.

# The following test checks whether the definition of tcl_endOfWord can be
test safe-5.1 {example tclIndex commands, test in parent interpreter} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $TestsDir auto0 auto1] [file join $TestsDir auto0 auto2]
} -body {
    # Try to load the commands.
    set code3 [catch report1 msg3]
    set code4 [catch report2 msg4]
    list $code3 $msg3 $code4 $msg4
} -cleanup {
    catch {rename report1 {}}
    catch {rename report2 {}}
    set ::auto_path $tmpAutoPath
    auto_reset
# obtained from auto_loading.
} -match glob -result {0 ok1 0 ok2}
test safe-5.2 {example tclIndex commands, negative test in parent interpreter} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $TestsDir auto0]
} -body {
    # Try to load the commands.
    set code3 [catch report1 msg3]
    set code4 [catch report2 msg4]
    list $code3 $msg3 $code4 $msg4
} -cleanup {
    catch {rename report1 {}}
    catch {rename report2 {}}
    set ::auto_path $tmpAutoPath
    auto_reset
} -match glob -result {1 {invalid command name "report1"} 1 {invalid command name "report2"}}
test safe-5.3 {example pkgIndex.tcl packages, test in parent interpreter, child directories} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $TestsDir auto0]
} -body {
    # Try to load the packages and run a command from each one.
    set code3 [catch {package require SafeTestPackage1} msg3]
    set code4 [catch {package require SafeTestPackage2} msg4]
    set code5 [catch HeresPackage1 msg5]
    set code6 [catch HeresPackage2 msg6]
    list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
    set ::auto_path $tmpAutoPath
    catch {package forget SafeTestPackage1}
    catch {package forget SafeTestPackage2}
    catch {rename HeresPackage1 {}}
    catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
test safe-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $TestsDir auto0 auto1] \
                        [file join $TestsDir auto0 auto2]
} -body {
    # Try to load the packages and run a command from each one.
    set code3 [catch {package require SafeTestPackage1} msg3]
    set code4 [catch {package require SafeTestPackage2} msg4]
    set code5 [catch HeresPackage1 msg5]
    set code6 [catch HeresPackage2 msg6]
    list $code3 $msg3 $code4 $msg4 $code5 $msg5 $code6 $msg6
} -cleanup {
    set ::auto_path $tmpAutoPath
    catch {package forget SafeTestPackage1}
    catch {package forget SafeTestPackage2}
    catch {rename HeresPackage1 {}}
    catch {rename HeresPackage2 {}}
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
test safe-5.5 {example modules packages, test in parent interpreter, replace path} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }

    tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
    # Try to load the modules and run a command from each one.
    set code0 [catch {package require test0} msg0]
    set code1 [catch {package require mod1::test1} msg1]
    set code2 [catch {package require mod2::test2} msg2]
    set out0  [test0::try0]
test safe-5.1 {test auto-loading in safe interpreters} {
    set out1  [mod1::test1::try1]
    set out2  [mod2::test2::try2]
    list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $TestsDir auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    catch {package forget test0}
    catch {safe::interpDelete a}
    catch {package forget mod1::test1}
    catch {package forget mod2::test2}
    catch {namespace delete ::test0}
    catch {namespace delete ::mod1}
    safe::interpCreate a
    set r [catch {interp eval a {tcl_endOfWord "" 0}} msg]
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
test safe-5.6 {example modules packages, test in parent interpreter, append to path} -setup {
    safe::interpDelete a
    tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
    # Try to load the modules and run a command from each one.
    set code0 [catch {package require test0} msg0]
    set code1 [catch {package require mod1::test1} msg1]
    set code2 [catch {package require mod2::test2} msg2]
    set out0  [test0::try0]
    set out1  [mod1::test1::try1]
    set out2  [mod2::test2::try2]
    list $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $out0 $out1 $out2
} -cleanup {
    list $r $msg
} {0 -1}
    tcl::tm::path remove [file join $TestsDir auto0 modules]
    catch {package forget test0}
    catch {package forget mod1::test1}
    catch {package forget mod2::test2}
    catch {namespace delete ::test0}
    catch {namespace delete ::mod1}
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}

# test safe interps 'information leak'
proc SafeEval {script} {
    # Helper procedure that ensures the safe interp is cleaned up even if
    # there is a failure in the script.
    set SafeInterp [interp create -safe]
    catch {$SafeInterp eval $script} msg opts
    interp delete $SafeInterp
    return -options $opts $msg
}

test safe-6.1 {test safe interpreters knowledge of the world} {
    lsort [SafeEval {info globals}]
} {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
test safe-6.2 {test safe interpreters knowledge of the world} {
    SafeEval {info script}
} {}
test safe-6.3 {test safe interpreters knowledge of the world} {
    set r [SafeEval {array names tcl_platform}]
    set r [lsort [SafeEval {array names tcl_platform}]]
    # If running a windows-debug shell, remove the "debug" element from r.
    if {[testConstraint win]} {
	set r [lsearch -all -inline -not -exact $r "debug"]
    if {[testConstraint win] && ("debug" in $r)} {
	set r [lreplace $r 1 1]
    }
    set r [lsearch -all -inline -not -exact $r "threaded"]
    lsort $r
} {byteOrder engine pathSeparator platform pointerSize wordSize}
    set threaded [lsearch $r "threaded"]
    if {$threaded != -1} {
	set r [lreplace $r $threaded $threaded]
    }
    set r
} {byteOrder engine platform pointerSize wordSize}

rename SafeEval {}
# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...
# more test should be added to check that hostname, nameofexecutable,
# aren't leaking infos, but they still do...

# high level general test
# Use example packages not http1.0 etc
test safe-7.1 {tests that everything works at high level} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $TestsDir auto0]
    set i [safe::interpCreate]
    set ::auto_path $tmpAutoPath
} -body {
    # no error shall occur:
    # (because the default access_path shall include 1st level sub dirs so
    #  package require in a child works like in the parent)
    set v [interp eval $i {package require SafeTestPackage1}]
    # no error shall occur:
    interp eval $i {HeresPackage1}
    set v
} -cleanup {
    safe::interpDelete $i
} -match glob -result 1.2.3
test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup {
} -body {
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
    # should not add anything (p0)
    set token1 [safe::interpAddToAccessPath $i [info library]]
    # should add as p* (not p1 if parent has a module path)
    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
    # should add as p* (not p2 if parent has a module path)
    set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]]
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
    # provided deep path)
    list $token1 $token2 $token3 -- \
	    [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
	    $mappA -- [safe::interpDelete $i]
} -cleanup {
} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
        1 {can't find package SafeTestPackage1} --\
        {TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}}
test safe-7.3 {check that safe subinterpreters work} {
    set g [interp children]
    if {$g ne {}} {
        append g { -- residue of an earlier test}
    }

    set h [info vars ::safe::S*]
    if {$h ne {}} {
        append h { -- residue of an earlier test}
# high level general test
    }
    set i [safe::interpCreate]
    set j [safe::interpCreate [list $i x]]
    list $g $h [interp eval $j {join {o k} ""}] [safe::interpDelete $i] \
            [interp exists $j] [info vars ::safe::S*]
} {{} {} ok {} 0 {}}
test safe-7.3.1 {check that safe subinterpreters work with namespace names} -setup {
} -body {
test safe-7.1 {tests that everything works at high level} -body {
    set g [interp children]
    if {$g ne {}} {
        append g { -- residue of an earlier test}
    }
    set h [info vars ::safe::S*]
    if {$h ne {}} {
        append h { -- residue of an earlier test}
    }
    set i [safe::interpCreate foo::bar]
    set j [safe::interpCreate [list $i hello::world]]
    list $g $h [interp eval $j {join {o k} ""}] \
            [foo::bar eval {hello::world eval {join {o k} ""}}] \
            [safe::interpDelete $i] \
    set i [safe::interpCreate];
    # no error shall occur:
    # (because the default access_path shall include 1st level sub dirs
    #  so package require in a slave works like in the master)
    set v [interp eval $i {package require http 2}]
    # no error shall occur:
    interp eval $i {http::config}
    safe::interpDelete $i
            [interp exists $j] [info vars ::safe::S*]
} -match glob -result {{} {} ok ok {} 0 {}}
test safe-7.4 {tests specific path and positive search} -setup {
    set v
} -match glob -result 2.*
test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
} -body {
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
    # should not add anything (p0)
    set token1 [safe::interpAddToAccessPath $i [info library]]
    # should add as p* (not p1 if parent has a module path)
    set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]]
    # should add as p1
    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"];
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    # this time, unlike test safe-7.2, SafeTestPackage1 should be found
    list $token1 $token2 -- \
	    [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
	    $mappA -- [safe::interpDelete $i]
    # an error shall occur (http is not anymore in the secure 0-level
    # provided deep path)
    list $token1 $token2 \
	    [catch {interp eval $i {package require http 1}} msg] $msg \
	    [safe::interpConfigure $i]\
	    [safe::interpDelete $i]
    # Note that the glob match elides directories (those from the module path)
    # other than the first and last in the access path.
} -cleanup {
} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
        {TCLLIB * TESTSDIR/auto0/auto1} -- {}}
} -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"


# test source control on file name
test safe-8.1 {safe source control on file} -setup {
    set i "a"
test safe-8.1 {safe source control on file} {
    set i "a";
    catch {safe::interpDelete $i}
} -body {
    safe::interpCreate $i
    $i eval {source}
    safe::interpCreate $i;
    list  [catch {$i eval {source}} msg] \
} -returnCodes error -cleanup {
    safe::interpDelete $i
	    $msg \
	    [safe::interpDelete $i] ;
    unset i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.2 {safe source control on file} -setup {
    set i "a"
} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}}
test safe-8.2 {safe source control on file} {
    set i "a";
    catch {safe::interpDelete $i}
} -body {
    safe::interpCreate $i
    $i eval {source a b c d e}
    safe::interpCreate $i;
    list  [catch {$i eval {source}} msg] \
} -returnCodes error -cleanup {
    safe::interpDelete $i
	    $msg \
	    [safe::interpDelete $i] ;
    unset i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.3 {safe source control on file} -setup {
    set i "a"
} {1 {wrong # args: should be "source ?-encoding E? fileName"} {}}
test safe-8.3 {safe source control on file} {
    set i "a";
    catch {safe::interpDelete $i}
    set log {}
    proc safe-test-log {str} {lappend ::log $str}
    set prevlog [safe::setLogCmd]
} -body {
    safe::interpCreate $i
    safe::setLogCmd safe-test-log
    list [catch {$i eval {source .}} msg] $msg $log
} -cleanup {
    safe::setLogCmd $prevlog
    safe::interpDelete $i
    safe::interpCreate $i;
    set log {};
    proc safe-test-log {str} {global log; lappend log $str}
    set prevlog [safe::setLogCmd];
    safe::setLogCmd safe-test-log;
    list  [catch {$i eval {source .}} msg] \
	    $msg \
	    $log \
	    [safe::setLogCmd $prevlog; unset log] \
	    [safe::interpDelete $i] ;
    rename safe-test-log {}
    unset i log
} -result {1 {permission denied} {{ERROR for child a : ".": is a directory}}}
test safe-8.4 {safe source control on file} -setup {
    set i "a"
} {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}}
test safe-8.4 {safe source control on file} {
    set i "a";
    catch {safe::interpDelete $i}
    safe::interpCreate $i;
    set log {}
    set log {};
    proc safe-test-log {str} {global log; lappend log $str}
    set prevlog [safe::setLogCmd]
    set prevlog [safe::setLogCmd];
} -body {
    safe::interpCreate $i
    safe::setLogCmd safe-test-log
    list [catch {$i eval {source /abc/def}} msg] $msg $log
} -cleanup {
    safe::setLogCmd $prevlog
    safe::interpDelete $i
    safe::setLogCmd safe-test-log;
    list  [catch {$i eval {source /abc/def}} msg] \
	    $msg \
	    $log \
	    [safe::setLogCmd $prevlog; unset log] \
	    [safe::interpDelete $i] ;
    rename safe-test-log {}
    unset i log
} -result {1 {permission denied} {{ERROR for child a : "/abc/def": not in access_path}}}
test safe-8.5 {safe source control on file} -setup {
    set i "a"
} {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}}
test safe-8.5 {safe source control on file} {
    # This tested filename == *.tcl or tclIndex, but that restriction
    # was removed in 8.4a4 - hobbs
    set i "a";
    catch {safe::interpDelete $i}
    safe::interpCreate $i;
    set log {}
    set log {};
    proc safe-test-log {str} {global log; lappend log $str}
    set prevlog [safe::setLogCmd]
    set prevlog [safe::setLogCmd];
} -body {
    # This tested filename == *.tcl or tclIndex, but that restriction was
    # removed in 8.4a4 - hobbs
    safe::interpCreate $i
    safe::setLogCmd safe-test-log
    safe::setLogCmd safe-test-log;
    list [catch {
	$i eval {source [file join [info lib] blah]}
    } msg] $msg $log
} -cleanup {
    safe::setLogCmd $prevlog
    safe::interpDelete $i
    list  [catch {$i eval {source [file join [info lib] blah]}} msg] \
	    $msg \
	    $log \
	    [safe::setLogCmd $prevlog; unset log] \
	    [safe::interpDelete $i] ;
    rename safe-test-log {}
    unset i log
} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] blah]:no such file or directory"]]
test safe-8.6 {safe source control on file} -setup {
    set i "a"
} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"] {} {}]
test safe-8.6 {safe source control on file} {
    set i "a";
    catch {safe::interpDelete $i}
    safe::interpCreate $i;
    set log {}
    set log {};
    proc safe-test-log {str} {global log; lappend log $str}
    set prevlog [safe::setLogCmd]
    set prevlog [safe::setLogCmd];
} -body {
    safe::interpCreate $i
    safe::setLogCmd safe-test-log
    safe::setLogCmd safe-test-log;
    list [catch {
	$i eval {source [file join [info lib] blah.tcl]}
    } msg] $msg $log
} -cleanup {
    safe::setLogCmd $prevlog
    safe::interpDelete $i
    list  [catch {$i eval {source [file join [info lib] blah.tcl]}} msg] \
	    $msg \
	    $log \
	    [safe::setLogCmd $prevlog; unset log] \
	    [safe::interpDelete $i] ;
    rename safe-test-log {}
    unset i log
} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] blah.tcl]:no such file or directory"]]
test safe-8.7 {safe source control on file} -setup {
    set i "a"
} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"] {} {}]
test safe-8.7 {safe source control on file} {
    # This tested length of filename, but that restriction
    # was removed in 8.4a4 - hobbs
    set i "a";
    catch {safe::interpDelete $i}
    safe::interpCreate $i;
    set log {}
    set log {};
    proc safe-test-log {str} {global log; lappend log $str}
    set prevlog [safe::setLogCmd]
    set prevlog [safe::setLogCmd];
} -body {
    safe::interpCreate $i
    # This tested length of filename, but that restriction was removed in
    # 8.4a4 - hobbs
    safe::setLogCmd safe-test-log
    safe::setLogCmd safe-test-log;
    list [catch {
	$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}
    } msg] $msg $log
} -cleanup {
    safe::setLogCmd $prevlog
    safe::interpDelete $i
    list  [catch {$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}}\
		 msg] \
	    $msg \
	    $log \
	    [safe::setLogCmd $prevlog; unset log] \
	    [safe::interpDelete $i] ;
    rename safe-test-log {}
    unset i log
} -result [list 1 {no such file or directory} [list "ERROR for child a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"] {} {}]
test safe-8.8 {safe source forbids -rsrc} emptyTest {
    # Disabled this test.  It was only useful for long unsupported
    # Mac OS 9 systems. [Bug 860a9f1945]
} {}
test safe-8.9 {safe source and return} -setup {
    set i "a"
    set returnScript [makeFile {return "ok"} return.tcl]
    catch {safe::interpDelete $i}
} -body {
    safe::interpCreate $i
    set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
    $i eval [list source $token/[file tail $returnScript]]
} -cleanup {
    catch {safe::interpDelete $i}
    removeFile $returnScript
    unset i
} -result ok
test safe-8.10 {safe source and return} -setup {
    set i "a"
    set returnScript [makeFile {return -level 2 "ok"} return.tcl]
    catch {safe::interpDelete $i}
} -body {
    safe::interpCreate $i
    set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
    $i eval [list apply {filename {
	source $filename
	error boom
    }} $token/[file tail $returnScript]]
} -cleanup {
    catch {safe::interpDelete $i}
    removeFile $returnScript
    unset i
} -result ok

test safe-9.1 {safe interps' deleteHook} -setup {
    set i "a"
test safe-9.1 {safe interps' deleteHook} {
    set i "a";
    catch {safe::interpDelete $i}
    set res {}
} -body {
    proc testDelHook {args} {
	global res
	global res;
	# the interp still exists at that point
	interp eval a {set delete 1}
	# mark that we've been here (successfully)
	set res $args
	set res $args;
    }
    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
    list [interp eval $i exit] $res
} -cleanup {
    catch {rename testDelHook {}}
    unset i res
} -result {{} {arg1 arg2 a}}
test safe-9.2 {safe interps' error in deleteHook} -setup {
    set i "a"
} {{} {arg1 arg2 a}}
test safe-9.2 {safe interps' error in deleteHook} {
    set i "a";
    catch {safe::interpDelete $i}
    set res {}
    proc testDelHook {args} {
	global res;
	# the interp still exists at that point
	interp eval a {set delete 1}
	# mark that we've been here (successfully)
	set res $args;
	# create an exception
	error "being catched";
    }
    set log {}
    proc safe-test-log {str} {lappend ::log $str}
    set log {};
    proc safe-test-log {str} {global log; lappend log $str}
    set prevlog [safe::setLogCmd]
} -body {
    proc testDelHook {args} {
	global res
	# the interp still exists at that point
	interp eval a {set delete 1}
	# mark that we've been here (successfully)
	set res $args
	# create an exception
	error "being catched"
    }
    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
    safe::setLogCmd safe-test-log
    list [safe::interpDelete $i] $res $log
} -cleanup {
    safe::setLogCmd $prevlog
    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
    set prevlog [safe::setLogCmd];
    safe::setLogCmd safe-test-log;
    list  [safe::interpDelete $i] $res \
	    $log \
	    [safe::setLogCmd $prevlog; unset log];
    catch {rename testDelHook {}}
    rename safe-test-log {}
    unset i log res
} -result {{} {arg1 arg2 a} {{NOTICE for child a : About to delete} {ERROR for child a : Delete hook error (being catched)} {NOTICE for child a : Deleted}}}
test safe-9.3 {dual specification of statics} -returnCodes error -body {
    safe::interpCreate -stat true -nostat
} -result {conflicting values given for -statics and -noStatics}
} {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}}
test safe-9.3 {dual specification of statics} {
    list [catch {safe::interpCreate -stat true -nostat} msg] $msg
} {1 {conflicting values given for -statics and -noStatics}}
test safe-9.4 {dual specification of statics} {
    # no error shall occur
    safe::interpDelete [safe::interpCreate -stat false -nostat]
} {}
test safe-9.5 {dual specification of nested} -returnCodes error -body {
    safe::interpCreate -nested 0 -nestedload
} -result {conflicting values given for -nested and -nestedLoadOk}
test safe-9.5 {dual specification of nested} {
    list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg
} {1 {conflicting values given for -nested and -nestedLoadOk}}

test safe-9.6 {interpConfigure widget like behaviour} -body {
   # this test shall work, don't try to "fix it" unless you *really* know what
   # you are doing (ie you are me :p) -- dl
   # this test shall work, don't try to "fix it" unless
   # you *really* know what you are doing (ie you are me :p) -- dl
   list [set i [safe::interpCreate \
		    -noStatics \
		    -nestedLoadOk \
		    -deleteHook {foo bar}]
         safe::interpConfigure $i -accessPath /foo/bar
	                           -noStatics \
                                   -nestedLoadOk \
	                           -deleteHook {foo bar}];
         safe::interpConfigure $i -accessPath /foo/bar ;
         safe::interpConfigure $i]\
	[safe::interpConfigure $i -aCCess]\
	[safe::interpConfigure $i -nested]\
	[safe::interpConfigure $i -statics]\
	[safe::interpConfigure $i -DEL]\
	[safe::interpConfigure $i -accessPath /blah -statics 1
	[safe::interpConfigure $i -accessPath /blah -statics 1;
	 safe::interpConfigure $i]\
	[safe::interpConfigure $i -deleteHook toto -nosta -nested 0
	[safe::interpConfigure $i -deleteHook toto -nosta -nested 0;
	 safe::interpConfigure $i]
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
        {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
        {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
        {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body {
   # this test shall work, believed equivalent to 9.6
    set i [safe::interpCreate \
	    -noStatics \
	    -nestedLoadOk \
	    -deleteHook {foo bar}]
	   safe::interpConfigure $i -accessPath /foo/bar
    set a [safe::interpConfigure $i]
    set b [safe::interpConfigure $i -aCCess]
    set c [safe::interpConfigure $i -nested]
    set d [safe::interpConfigure $i -statics]
    set e [safe::interpConfigure $i -DEL]
	   safe::interpConfigure $i -accessPath /blah -statics 1
    set f [safe::interpConfigure $i]
	   safe::interpConfigure $i -deleteHook toto -nosta -nested 0
    set g [safe::interpConfigure $i]

    list $a $b $c $d $e $f $g
} -cleanup {
    safe::interpDelete $i
    unset -nocomplain a b c d e f g i
} -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}}\
        {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
        {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
        {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $TestsDir auto0 auto1] \
                                            [file join $TestsDir auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

# testing that nested and statics do what is advertised
    # Load and run the commands.
    set code1 [catch {interp eval $i {report1}} msg1]
    set code2 [catch {interp eval $i {report2}} msg2]

# (we use a static package : Tcltest)
    list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}}
test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $TestsDir auto0 auto1] \
                                            [file join $TestsDir auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

    # Load auto_load data.
    interp eval $i {catch nonExistentCommand}

    # Load and run the commands.
    # This guarantees the test will pass even if the tokens are swapped.
    set code1 [catch {interp eval $i {report1}} msg1]
    set code2 [catch {interp eval $i {report2}} msg2]

    # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $TestsDir auto0 auto2] \
                                           [file join $TestsDir auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

    # Run the commands.
    set code3 [catch {interp eval $i {report1}} msg3]
    set code4 [catch {interp eval $i {report2}} msg4]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
        {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $TestsDir auto0 auto1] \
                                            [file join $TestsDir auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

if {[catch {package require Tcltest} msg]} {
    # Load auto_load data.
    interp eval $i {catch nonExistentCommand}

    testConstraint TcltestPackage 0
    # Do not load the commands.  With the tokens swapped, the test
    # will pass only if the Safe Base has called auto_reset.

} else {
    # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $TestsDir auto0 auto2] \
                                           [file join $TestsDir auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

    testConstraint TcltestPackage 1
    # Load and run the commands.
    set code3 [catch {interp eval $i {report1}} msg3]
    set code4 [catch {interp eval $i {report2}} msg4]

    # we use the Tcltest package , which has no Safe_Init
    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
        0 ok1 0 ok2 --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
        {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup {
} -body {
    # For complete correspondence to safe-9.10opt, include auto0 in access path.
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $TestsDir auto0] \
                                            [file join $TestsDir auto0 auto1] \
                                            [file join $TestsDir auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

}
    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Rearrange access path.  Swap tokens {$p(:2:)} and {$p(:3:)}.
    # This would have no effect because the records in Pkg of these directories
    # were from access as children of {$p(:1:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $TestsDir auto0] \
                                           [file join $TestsDir auto0 auto2] \
                                           [file join $TestsDir auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

    # Try to load the packages and run a command from each one.
    set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
    set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
    set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
    set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
         $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
        {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
        {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
        0 OK1 0 OK2}
test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $TestsDir auto0 auto1] \
                                            [file join $TestsDir auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Rearrange access path.  Swap tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $TestsDir auto0 auto2] \
                                           [file join $TestsDir auto0 auto1]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

    # Try to load the packages and run a command from each one.
    set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
    set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
    set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
    set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]

    list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
            $mappA -- $mappB -- \
            $code5 $msg5 $code6 $msg6
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
        0 1.2.3 0 2.3.4 --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
        {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
        0 OK1 0 OK2}
test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup {
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library \
                                            [file join $TestsDir auto0 auto1] \
                                            [file join $TestsDir auto0 auto2]]]
    # Inspect.
    set confA [safe::interpConfigure $i]
    set mappA [mapList $PathMapp [dict get $confA -accessPath]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]

    # Load pkgIndex.tcl data.
    catch {interp eval $i {package require NOEXIST}}

    # Limit access path.  Remove tokens {$p(:1:)} and {$p(:2:)}.
    safe::interpConfigure $i -accessPath [list $tcl_library]

    # Inspect.
    set confB [safe::interpConfigure $i]
    set mappB [mapList $PathMapp [dict get $confB -accessPath]]
    set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4]
    set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5]

    # Try to load the packages.
    set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
    set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]

    list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
            $mappA -- $mappB
} -cleanup {
    safe::interpDelete $i
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
        1 {* not found in access path} -- 1 1 --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}}
test safe-9.20 {check module loading} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $TestsDir auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
         TESTSDIR/auto0/modules/mod2} -- res0 res1 res2}
# - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in
#   tokenized form to the child's access path, and then adds all the
#   descendants, discovered recursively by using glob.
# - The order of the directories in the list returned by glob is system-dependent,
#   and therefore this is true also for (a) the order of token assignment to
#   descendants of the [tcl::tm::list] roots; and (b) the order of those same
#   directories in the access path.  Both those things must be sorted before
#   comparing with expected results.  The test is therefore not totally strict,
#   but will notice missing or surplus directories.
test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]

test safe-10.1 {testing statics loading} TcltestPackage {
    set i [safe::interpCreate]
    list \
	    [catch {interp eval $i {load {} Tcltest}} msg] \
	    $msg \
            [safe::interpDelete $i];
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
    set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

test safe-10.2 {testing statics loading / -nostatics} TcltestPackage {
    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $TestsDir auto0 auto1] \
                                           [file join $TestsDir auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set i [safe::interpCreate -nostatics]
    list \
	    [catch {interp eval $i {load {} Tcltest}} msg] \
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

	    $msg \
            [safe::interpDelete $i];
} {1 {permission denied (static package)} {}}
test safe-10.3 {testing nested statics loading / no nested by default} TcltestPackage {
    set i [safe::interpCreate]
    list \
    # Load pkg data.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
	    $msg \
            [safe::interpDelete $i];
    catch {interp eval $i {package require mod2::NOEXIST}}

} {1 {permission denied (nested load)} {}}
    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

test safe-10.4 {testing nested statics loading / -nestedloadok} TcltestPackage {
    set i [safe::interpCreate -nestedloadok]
    list \
	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
	    $msg \
            [safe::interpDelete $i];
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $TestsDir auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
         TESTSDIR/auto0/modules/mod2} --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
         TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-9.20.
test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                          [file join $TestsDir auto0 auto1] \
                                          [file join $TestsDir auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $TestsDir auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
         TESTSDIR/auto0/modules/mod2} --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
         TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-9.20.
test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

    # Force the interpreter to acquire pkg data which will soon become stale.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
    catch {interp eval $i {package require mod2::NOEXIST}}

test safe-11.1 {testing safe encoding} {
    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
                                           [file join $TestsDir auto0 auto1] \
                                           [file join $TestsDir auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
    set i [safe::interpCreate]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

    list \
    # Refresh stale pkg data.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
	    [catch {interp eval $i encoding} msg] \
	    $msg \
	    [safe::interpDelete $i];
    catch {interp eval $i {package require mod2::NOEXIST}}

} {1 {wrong # args: should be "encoding option ..."} {}}
    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

test safe-11.2 {testing safe encoding} {
    set i [safe::interpCreate]
    list \
	    [catch {interp eval $i encoding system cp775} msg] \
	    $msg \
    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $TestsDir auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
	    [safe::interpDelete $i];
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
} {1 {wrong # args: should be "encoding system"} {}}
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
         TESTSDIR/auto0/modules/mod2} --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
         TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-9.20.
test safe-11.3 {testing safe encoding} {
test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup {
    set oldTm [tcl::tm::path list]
    foreach path $oldTm {
        tcl::tm::path remove $path
    }
    tcl::tm::path add [file join $TestsDir auto0 modules]
} -body {
    set i [safe::interpCreate -accessPath [list $tcl_library]]

    # Inspect.
    set confA [safe::interpConfigure $i]
    set i [safe::interpCreate]
    set result [catch {
	string match [encoding system] [interp eval $i encoding system]
    } msg]
    list $result $msg [safe::interpDelete $i]
    set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
    set modsA [interp eval $i {tcl::tm::path list}]
    set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

} {0 1 {}}
    # Force the interpreter to acquire pkg data which will soon become stale.
    catch {interp eval $i {package require NOEXIST}}
    catch {interp eval $i {package require mod1::NOEXIST}}
    catch {interp eval $i {package require mod2::NOEXIST}}

test safe-11.4 {testing safe encoding} {
    set i [safe::interpCreate]
    set result [catch {
	string match [encoding names] [interp eval $i encoding names]
    } msg]
    # Add to access path.
    # This injects more tokens, pushing modules to higher token numbers.
    safe::interpConfigure $i -accessPath [list $tcl_library \
    list $result $msg  [safe::interpDelete $i]
                                           [file join $TestsDir auto0 auto1] \
                                           [file join $TestsDir auto0 auto2]]
    # Inspect.
    set confB [safe::interpConfigure $i]
} {0 1 {}}
test safe-11.5 {testing safe encoding} {
    set i [safe::interpCreate]
    set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
    set modsB [interp eval $i {tcl::tm::path list}]
    set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
    set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
    set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]

    list \
    # Try to load the packages and run a command from each one.
    set code0 [catch {interp eval $i {package require test0}} msg0]
	    [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \
    set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
    set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
    set out0  [interp eval $i {test0::try0}]
    set out1  [interp eval $i {mod1::test1::try1}]
    set out2  [interp eval $i {mod2::test2::try2}]

	    $msg \
    list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
            [lsort [list $path3 $path4 $path5]] -- $modsB -- \
            $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
            $out0 $out1 $out2
} -cleanup {
    tcl::tm::path remove [file join $TestsDir auto0 modules]
    foreach path [lreverse $oldTm] {
        tcl::tm::path add $path
    }
    safe::interpDelete $i
	    [safe::interpDelete $i];
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
        {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
        0 0.5 0 1.0 0 2.0 --\
        {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
         TESTSDIR/auto0/modules/mod2} --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
         TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-9.20.

} {0 foobar {}}
catch {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
test safe-11.6 {testing safe encoding} {
    set i [safe::interpCreate]
} -body {
    interp eval $i {load {} Safepkg1}
    list \
	    [catch {interp eval $i encoding convertto cp1258 foobar} msg] \
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
    set i [safe::interpCreate]
} -body {
	    $msg \
    catch {interp eval $i {load {} Safepkg1}} m o
    dict get $o -errorinfo
} -returnCodes ok -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
    invoked from within
"load {} Safepkg1"
    invoked from within
"interp eval $i {load {} Safepkg1}"}
test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
    set i [safe::interpCreate -nostatics]
    interp eval $i {load {} Safepkg1}
} -returnCodes error -cleanup {
    safe::interpDelete $i
	    [safe::interpDelete $i];
} -result {permission denied (static package)}
test safe-10.3 {testing nested statics loading / no nested by default} -setup {
    set i [safe::interpCreate]
} -constraints TcltestPackage -body {
    interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied (nested load)}
test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
    set i [safe::interpCreate -nestedloadok]
    interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
    set i [safe::interpCreate -nestedloadok]
    catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
    dict get $o -errorinfo
} -returnCodes ok -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
    invoked from within
"load {} Safepkg1 x"
    invoked from within
"interp eval $i {interp create x; load {} Safepkg1 x}"}

test safe-11.1 {testing safe encoding} -setup {
} {0 foobar {}}
test safe-11.7 {testing safe encoding} {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding
    list \
	    [catch {interp eval $i encoding convertfrom} msg] \
} -returnCodes error -cleanup {
    safe::interpDelete $i
	    $msg \
	    [safe::interpDelete $i];
} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test safe-11.1a {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding foobar
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -match glob -result {unknown or ambiguous subcommand "foobar": must be *}
test safe-11.2 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding system cp775
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding system"}
test safe-11.3 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding system
} -cleanup {
    safe::interpDelete $i
} -result [encoding system]
test safe-11.4 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding names
} -cleanup {
    safe::interpDelete $i
} -result [encoding names]
test safe-11.5 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertfrom cp1258 foobar
} -cleanup {
    safe::interpDelete $i
} -result foobar
test safe-11.6 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto cp1258 foobar
} -cleanup {
    safe::interpDelete $i
} -result foobar
test safe-11.7 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertfrom
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}}
test safe-11.7.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i encoding convertfrom} m o
    dict get $o -errorinfo
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
    while executing
"encoding convertfrom"
    invoked from within
"encoding convertfrom"
    invoked from within
"interp eval $i encoding convertfrom"}
test safe-11.8 {testing safe encoding} -setup {
test safe-11.8 {testing safe encoding} {
    set i [safe::interpCreate]
} -body {
    interp eval $i encoding convertto
    list \
	    [catch {interp eval $i encoding convertto} msg] \
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?encoding? data"}
test safe-11.8.1 {testing safe encoding} -setup {
    set i [safe::interpCreate]
} -body {
	    $msg \
    catch {interp eval $i encoding convertto} m o
    dict get $o -errorinfo
} -returnCodes ok -match glob -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?encoding? data"
	    [safe::interpDelete $i];
} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}}
    while executing
"encoding convertto"
    invoked from within
"encoding convertto"
    invoked from within
"interp eval $i encoding convertto"}

test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
    set i [safe::interpCreate]
} -body {
    $i eval glob ../*
} -returnCodes error -cleanup {
    safe::interpDelete $i
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
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
1439
1440
1441

1442
1443

1444


1445



1446
1447
1448
1449

1450
1451
1452
1453
1454
1455





1456
1457
1458
1459
1460
1461




1462
1463
1464
1465
1466

1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478

1479
1480
1481


1482



1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494

1495
1496
1497


1498



1499
1500
1501
1502
1503
1504

1505
1506

1507
1508
1509
1510

1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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

611
612
613
614
615
616
617
618
619

620
621

622
623
624
625

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
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











-
-
-
-
-
-
-

-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-











+
+
-
+
+
+










-
+



+
+
-
+
+
+




-
+



+
+
-
+
+
+












-
+



+
+
-
+
+
+






-
+



+
+
-
+
+
+






-
+

-
+

+
+
-
+
+
+



-
+



-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-






-
+



+
+
-
+
+
+











-
+



+
+
-
+
+
+





-
+

-
+
-


-
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+



-
+


+
-
+




-
-
-
+
+


-
+




-
-
-
+
+
-
-

-
+

-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-

-

-
+


-
-
+
+
+
-
-
-
+
-
-
-
-
-
-


-


+

-
-
-
-


-
-
-
-
test safe-12.6 {glob is restricted [Bug 2906841]} -setup {
    set i [safe::interpCreate]
} -body {
    $i eval glob -nocomplain -join .. *
} -cleanup {
    safe::interpDelete $i
} -result {}
test safe-12.7 {glob is restricted} -setup {
    set i [safe::interpCreate]
} -body {
    $i eval glob *
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied}

proc buildEnvironment {filename} {
proc mkfile {filename} {
    upvar 1 testdir testdir testdir2 testdir2 testfile testfile
    set testdir [makeDirectory deletethisdir]
    set testdir2 [makeDirectory deletemetoo $testdir]
    set testfile [makeFile {} $filename $testdir2]
    close [open $filename w]
}
proc buildEnvironment2 {filename} {
    upvar 1 testdir testdir testdir2 testdir2 testfile testfile
    upvar 1 testdir3 testdir3 testfile2 testfile2
    set testdir [makeDirectory deletethisdir]
    set testdir2 [makeDirectory deletemetoo $testdir]
    set testfile [makeFile {} $filename $testdir2]
    set testdir3 [makeDirectory deleteme $testdir]
    set testfile2 [makeFile {} $filename $testdir3]
}
#### New tests for Safe base glob, with patches @ Bug 2964715
test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
    set i [safe::interpCreate]
} -body {
    $i eval glob *
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied}
test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment deleteme.tm
    set testfile [file join $testdir2 deleteme.tm]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    ::safe::interpAddToAccessPath $i $testdir2
    set result [$i eval glob -nocomplain -directory $testdir2 *.tm]
    if {$result eq [list $testfile]} {
        return "glob match"
    } else {
        return "no match: $result"
    }
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {glob match}
test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment deleteme.tm
    set testfile [file join $testdir2 deleteme.tm]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    $i eval glob -directory $testdir2 *.tm
} -returnCodes error -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {permission denied}
test safe-13.4 {another valid glob call [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment deleteme.tm
    set testfile [file join $testdir2 deleteme.tm]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    ::safe::interpAddToAccessPath $i $testdir
    ::safe::interpAddToAccessPath $i $testdir2
    set result [$i eval \
	    glob -nocomplain -directory $testdir [file join deletemetoo *.tm]]
    if {$result eq [list $testfile]} {
        return "glob match"
    } else {
        return "no match: $result"
    }
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {glob match}
test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment deleteme.tm
    set testfile [file join $testdir2 deleteme.tm]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    ::safe::interpAddToAccessPath $i $testdir2
    $i eval \
	glob -directory $testdir [file join deletemetoo *.tm]
} -returnCodes error -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {permission denied}
test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment deleteme.tm
    set testfile [file join $testdir2 deleteme.tm]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    ::safe::interpAddToAccessPath $i $testdir
    $i eval \
	glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {}
test safe-13.7 {mimic the glob call by tclPkgUnknown in a safe interpreter [Bug 2964715]} -setup {
test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment pkgIndex.tcl
    set testfile [file join $testdir2 pkgIndex.tcl]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    set safeTD [::safe::interpAddToAccessPath $i $testdir]
    ::safe::interpAddToAccessPath $i $testdir2
    mapList [list $safeTD EXPECTED] [$i eval [list \
    string map [list $safeTD EXPECTED] [$i eval [list \
	glob -directory $safeTD -join * pkgIndex.tcl]]
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
} -result {EXPECTED/deletemetoo/pkgIndex.tcl}
test safe-13.7.1 {mimic the glob call by tclPkgUnknown in a safe interpreter with multiple subdirectories} -setup {
    file delete -force $testdir
} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}}
# Note the extra {} around the result above; that's *expected* because of the
# format of virtual path roots.
test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment2 pkgIndex.tcl
} -body {
    set safeTD [::safe::interpAddToAccessPath $i $testdir]
    ::safe::interpAddToAccessPath $i $testdir2
    ::safe::interpAddToAccessPath $i $testdir3
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    set testfile [file join $testdir2 notIndex.tcl]
    file mkdir $testdir2
    mapAndSortList [list $safeTD EXPECTED] [$i eval [list \
	glob -directory $safeTD -join * pkgIndex.tcl]]
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    mkfile $testfile
} -result {EXPECTED/deleteme/pkgIndex.tcl EXPECTED/deletemetoo/pkgIndex.tcl}
# See comments on lsort after test safe-9.20.
test safe-13.8 {mimic the glob call by tclPkgUnknown without the special treatment that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    buildEnvironment notIndex.tcl
} -body {
    set safeTD [::safe::interpAddToAccessPath $i $testdir]
    ::safe::interpAddToAccessPath $i $testdir2
    $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl]
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {}
test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment notIndex.tcl
    set testfile [file join $testdir2 notIndex.tcl]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    ::safe::interpAddToAccessPath $i $testdir2
    set result [$i eval \
	    glob -directory $testdir -join -nocomplain * notIndex.tcl]
    if {$result eq [list $testfile]} {
        return {glob match}
    } else {
        return "no match: $result"
    }
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {no match: }
test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
    set i [safe::interpCreate]
    set testdir  [file join [temporaryDirectory] deletethisdir]
    set testdir2 [file join $testdir deletemetoo]
    buildEnvironment notIndex.tcl
    set testfile [file join $testdir2 notIndex.tcl]
    file mkdir $testdir2
    mkfile $testfile
} -body {
    ::safe::interpAddToAccessPath $i $testdir
    $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl
} -cleanup {
    safe::interpDelete $i
    removeDirectory $testdir
    file delete -force $testdir
} -result {}
rename buildEnvironment {}
rename mkfile {}
rename buildEnvironment2 {}

#### Test for the module path
test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup {
test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
    set i [safe::interpCreate]
} -body {
    set tm {}
    foreach token [$i eval ::tcl::tm::path list] {
        lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token]
    }
    return $tm
} -cleanup {
    safe::interpDelete $i
} -result [::tcl::tm::path list]

test safe-15.1 {safe file ensemble does not surprise code} -setup {
    set i [interp create -safe]
} -body {
    set result [expr {"file" in [interp hidden $i]}]
    lappend result [interp eval $i {tcl::file::split a/b/c}]
    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
    lappend result [interp invokehidden $i file split a/b/c]
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp invokehidden $i file isdirectory .}]
    interp expose $i file
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
} -cleanup {
    unset -nocomplain msg
    interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
test safe-15.2 {safe file ensemble does not surprise code} -setup {
    set i [interp create -safe]
} -body {
    set result [expr {"file" in [interp hidden $i]}]
    lappend result [interp eval $i {tcl::file::split a/b/c}]
    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
    lappend result [interp invokehidden $i file split a/b/c]
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp invokehidden $i file isdirectory .}]
    interp expose $i file
    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
    lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo]
} -cleanup {
    unset -nocomplain msg o
    interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file
    while executing
"file isdirectory ."
    invoked from within
"interp eval $i {file isdirectory .}"}}

### ~ should have no special meaning in paths in safe interpreters
test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
test safe-15.1 {Bug 2913625: defang ~ in paths} -setup {
    set savedHOME $env(HOME)
    set env(HOME) /foo/bar
    set i [safe::interpCreate]
} -body {
} -constraints knownBug -body {
    $i eval {
	set d [format %c 126]
	list [file dirname $d] [file tail $d] \
	list [file join [file dirname $d] [file tail $d]]
	    [file join [file dirname $d] [file tail $d]]
    }
} -cleanup {
    safe::interpDelete $i
    set env(HOME) $savedHOME
    unset savedHOME
} -result {./~}
test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
} -result {~}
test safe-15.2 {Bug 2913625: defang ~user in paths} -setup {
    set i [safe::interpCreate]
    set user $tcl_platform(user)
} -body {
} -constraints knownBug -body {
    string map [list $user USER] [$i eval \
	    "file join \[file dirname ~$user\] \[file tail ~$user\]"]
} -cleanup {
    safe::interpDelete $i
    unset user
} -result {./~USER}
test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
} -result {~USER}
test safe-15.3 {Bug 2913625: defang ~ in globs} -setup {
    set syntheticHOME [makeDirectory foo]
    makeFile {} bar $syntheticHOME
    set savedHOME $env(HOME)
    set env(HOME) $syntheticHOME
    set env(HOME) /
    set i [safe::interpCreate]
} -body {
} -constraints knownBug -body {
    ::safe::interpAddToAccessPath $i $syntheticHOME
    $i eval {glob -nocomplain ~/*}
    $i expose glob realglob
} -cleanup {
    safe::interpDelete $i
    set env(HOME) $savedHOME
    removeDirectory $syntheticHOME
    unset savedHOME syntheticHOME
} -result {}
test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
    set i [safe::interpCreate]
} -body {
    ::safe::interpAddToAccessPath $i $~$tcl_platform(user)
    $i eval [list glob -nocomplain ~$tcl_platform(user)/*]
} -cleanup {
    safe::interpDelete $i
} -result {}
test safe-16.5 {Bug 3529949: defang ~ in paths used by AliasGlob (1)} -setup {
    set savedHOME $env(HOME)
    set env(HOME) /foo/bar
    set i [safe::interpCreate]
} -body {
    $i eval {
    $i eval {realglob -nocomplain [join {~ / *} ""]}
	set d [format %c 126]
	file join {$p(:0:)} $d
    }
} -cleanup {
    safe::interpDelete $i
    set env(HOME) $savedHOME
    unset savedHOME
} -result {~}
test safe-16.6 {Bug 3529949: defang ~ in paths used by AliasGlob (2)} -setup {
    set savedHOME $env(HOME)
    set env(HOME) /foo/bar
    set i [safe::interpCreate]
} -body {
    $i eval {
	set d [format %c 126]
	file join {$p(:0:)/foo/bar} $d
    }
} -cleanup {
    safe::interpDelete $i
    set env(HOME) $savedHOME
    unset savedHOME
} -result {~}
test safe-16.7 {Bug 3529949: defang ~user in paths used by AliasGlob (1)} -setup {
test safe-15.4 {Bug 2913625: defang ~user in globs} -setup {
    set i [safe::interpCreate]
    set user $tcl_platform(user)
} -body {
    string map [list $user USER] [$i eval [list file join {$p(:0:)} ~$user]]
} -constraints knownBug -body {
    $i expose glob realglob
    string map [list $user USER] [$i eval [list\
} -cleanup {
    safe::interpDelete $i
    unset user
	realglob -directory ~$user *]]
} -result {~USER}
test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup {
    set i [safe::interpCreate]
    set user $tcl_platform(user)
} -body {
    string map [list $user USER] [$i eval [list file join {$p(:0:)/foo/bar} ~$user]]
} -cleanup {
    safe::interpDelete $i
    unset user
} -result {~USER}

set ::auto_path $saveAutoPath
# cleanup
set ::auto_path $SaveAutoPath
unset SaveAutoPath TestsDir PathMapp
rename mapList {}
rename mapAndSortList {}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/scan.test.

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
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


-
-
-
+
+
+








-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+







# Commands covered:  scan
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# procedure that returns the range of integers

proc int_range {} {
    set MAX_INT [expr {[format %u -2]/2}]
    set MIN_INT [expr { ~ $MAX_INT }]
    return [list $MIN_INT $MAX_INT]
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
	    # little endian
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
		ieeeValues(-Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
		ieeeValues(-Subnormal)
	    binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
		ieeeValues(-0)
	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+0)
	    binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
		ieeeValues(+Subnormal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
		ieeeValues(NaN)
	    set ieeeValues(littleEndian) 1
	    return 1
	}
	{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
	    binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Normal)
	    binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Subnormal)
	    binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-0)
	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+0)
	    binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Subnormal)
	    binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(NaN)
	    set ieeeValues(littleEndian) 0
	    return 1
	}
	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]

test scan-1.1 {BuildCharSet, CharInSet} {
    list [scan foo {%[^o]} x] $x
} {1 f}
test scan-1.2 {BuildCharSet, CharInSet} {
    list [scan \]foo {%[]f]} x] $x
} {1 \]f}
test scan-1.3 {BuildCharSet, CharInSet} {
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
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







-
-
+
+
-

-
+








-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+







} {1 -a}
test scan-1.7 {BuildCharSet, CharInSet} {
    list [scan abc-def {%[c-a]} x] $x
} {1 abc}
test scan-1.8 {BuildCharSet, CharInSet} {
    list [scan def-abc {%[^c-a]} x] $x
} {1 def-}
test scan-1.9 {BuildCharSet, CharInSet no match} -setup {
    unset -nocomplain x
test scan-1.9 {BuildCharSet, CharInSet no match} {
    catch {unset x}
} -body {
    list [scan {= f} {= %[TF]} x] [info exists x]
} -result {0 0}
} {0 0}

test scan-2.1 {ReleaseCharSet} {
    list [scan abcde {%[abc]} x] $x
} {1 abc}
test scan-2.2 {ReleaseCharSet} {
    list [scan abcde {%[a-c]} x] $x
} {1 abc}

test scan-3.1 {ValidateFormat} -returnCodes error -body {
    scan {} {%d%1$d} x
} -result {cannot mix "%" and "%n$" conversion specifiers}
test scan-3.2 {ValidateFormat} -returnCodes error -body {
    scan {} {%d%1$d} x
} -result {cannot mix "%" and "%n$" conversion specifiers}
test scan-3.3 {ValidateFormat} -returnCodes error -body {
    scan {} {%2$d%d} x
} -result {"%n$" argument index out of range}
test scan-3.1 {ValidateFormat} {
    list [catch {scan {} {%d%1$d} x} msg] $msg
} {1 {cannot mix "%" and "%n$" conversion specifiers}}
test scan-3.2 {ValidateFormat} {
    list [catch {scan {} {%d%1$d} x} msg] $msg
} {1 {cannot mix "%" and "%n$" conversion specifiers}}
test scan-3.3 {ValidateFormat} {
    list [catch {scan {} {%2$d%d} x} msg] $msg
} {1 {"%n$" argument index out of range}}
test scan-3.4 {ValidateFormat} {
    # degenerate case, before changed from 8.2 to 8.3
    list [catch {scan {} %d} msg] $msg
} {0 {}}
test scan-3.5 {ValidateFormat} -returnCodes error -body {
    scan {} {%10c} a
} -result {field width may not be specified in %c conversion}
test scan-3.6 {ValidateFormat} -returnCodes error -body {
    scan {} {%*1$d} a
} -result {bad scan conversion character "$"}
test scan-3.7 {ValidateFormat} -returnCodes error -body {
    scan {} {%1$d%1$d} a
} -result {variable is assigned by multiple "%n$" conversion specifiers}
test scan-3.8 {ValidateFormat} -returnCodes error -body {
    scan {} a x
} -result {variable is not assigned by any conversion specifiers}
test scan-3.9 {ValidateFormat} -returnCodes error -body {
    scan {} {%2$s} x y
} -result {variable is not assigned by any conversion specifiers}
test scan-3.10 {ValidateFormat} -returnCodes error -body {
    scan {} {%[a} x
} -result {unmatched [ in format string}
test scan-3.11 {ValidateFormat} -returnCodes error -body {
    scan {} {%[^a} x
} -result {unmatched [ in format string}
test scan-3.12 {ValidateFormat} -returnCodes error -body {
    scan {} {%[]a} x
} -result {unmatched [ in format string}
test scan-3.13 {ValidateFormat} -returnCodes error -body {
    scan {} {%[^]a} x
} -result {unmatched [ in format string}
test scan-3.5 {ValidateFormat} {
    list [catch {scan {} {%10c} a} msg] $msg
} {1 {field width may not be specified in %c conversion}}
test scan-3.6 {ValidateFormat} {
    list [catch {scan {} {%*1$d} a} msg] $msg
} {1 {bad scan conversion character "$"}}
test scan-3.7 {ValidateFormat} {
    list [catch {scan {} {%1$d%1$d} a} msg] $msg
} {1 {variable is assigned by multiple "%n$" conversion specifiers}}
test scan-3.8 {ValidateFormat} {
    list [catch {scan {} a x} msg] $msg
} {1 {variable is not assigned by any conversion specifiers}}
test scan-3.9 {ValidateFormat} {
    list [catch {scan {} {%2$s} x y} msg] $msg
} {1 {variable is not assigned by any conversion specifiers}}
test scan-3.10 {ValidateFormat} {
    list [catch {scan {} {%[a} x} msg] $msg
} {1 {unmatched [ in format string}}
test scan-3.11 {ValidateFormat} {
    list [catch {scan {} {%[^a} x} msg] $msg
} {1 {unmatched [ in format string}}
test scan-3.12 {ValidateFormat} {
    list [catch {scan {} {%[]a} x} msg] $msg
} {1 {unmatched [ in format string}}
test scan-3.13 {ValidateFormat} {
    list [catch {scan {} {%[^]a} x} msg] $msg
} {1 {unmatched [ in format string}}

test scan-4.1 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body {
    scan
} -result {wrong # args: should be "scan string format ?varName ...?"}
test scan-4.2 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body {
    scan string
} -result {wrong # args: should be "scan string format ?varName ...?"}
test scan-4.1 {Tcl_ScanObjCmd, argument checks} {
    list [catch {scan} msg] $msg
} {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
test scan-4.2 {Tcl_ScanObjCmd, argument checks} {
    list [catch {scan string} msg] $msg
} {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
test scan-4.3 {Tcl_ScanObjCmd, argument checks} {
    # degenerate case, before changed from 8.2 to 8.3
    list [catch {scan string format} msg] $msg
} {0 {}}
test scan-4.4 {Tcl_ScanObjCmd, whitespace} {
    list [scan {   abc   def   } {%s%s} x y] $x $y
} {2 abc def}
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
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







-
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+
-
-



+

-
-
+
+

-

-
-
-
+
+
+
-

-
+
-
-
-
-
-
-
+

-
-
-
-
+
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
+







test scan-4.28 {Tcl_ScanObjCmd, character scanning} {
    list [scan {abcdef} {%c} x] $x
} {1 97}
test scan-4.29 {Tcl_ScanObjCmd, character scanning} {
    list [scan {abcdef} {%*c%n} x] $x
} {1 1}

test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} {
    set x {}
} -body {
    list [scan {1234567890a} {%3d} x] $x
} -result {1 123}
test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
} {1 123}
test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} {
    set x {}
} -body {
    list [scan {1234567890a} {%d} x] $x
} -result {1 1234567890}
test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
} {1 1234567890}
test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} {
    set x {}
} -body {
    list [scan {01234567890a} {%d} x] $x
} -result {1 1234567890}
test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
} {1 1234567890}
test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} {
    set x {}
} -body {
    list [scan {+01234} {%d} x] $x
} -result {1 1234}
test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
} {1 1234}
test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} {
    set x {}
} -body {
    list [scan {-01234} {%d} x] $x
} -result {1 -1234}
test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
} {1 -1234}
test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} {
    set x {}
} -body {
    list [scan {a01234} {%d} x] $x
} -result {0 {}}
test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
} {0 {}}
test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} {
    set x {}
} -body {
    list [scan {0x10} {%d} x] $x
} -result {1 0}
test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} -setup {
} {1 0}
test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} {
    set x {}
} -body {
    list [scan {012345678} {%o} x] $x
} -result {1 342391}
test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} -setup {
} {1 342391}
test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} {
    set x {}
} -body {
    list [scan {+1238 -1239 123a} {%o%*s%o%*s%o} x y z] $x $y $z
} -result {3 83 -83 83}
test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
} {3 83 -83 83}
test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} {
    set x {}
} -body {
    list [scan {+1238 -123a 0123} {%x%x%x} x y z] $x $y $z
} -result {3 4664 -4666 291}
test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
} {3 4664 -4666 291}
test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} {
    set x {}
} -body {
    # The behavior changed in 8.4a4/8.3.4cvs (6 Feb) to correctly
    # return '1' for 0x1 scanned via %x, to comply with 8.0 and C scanf.
    # Bug #495213
    set x {}
    list [scan {aBcDeF AbCdEf 0x1} {%x%x%x} x y z] $x $y $z
} -result {3 11259375 11259375 1}
test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
} {3 11259375 11259375 1}
test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} {
    set x {}
} -body {
    list [scan {0xF 0x00A0B 0X0XF} {%x %x %x} x y z] $x $y $z
} -result {3 15 2571 0}
test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
    unset -nocomplain x
} {3 15 2571 0}
test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} {
    catch {unset x}
} -body {
    list [scan {xF} {%x} x] [info exists x]
} -result {0 0}
} {0 0}
test scan-4.40.3 {Tcl_ScanObjCmd, base-2 integer scanning} -setup {
    set x {}
} -body {
    list [scan {1001 0b101 100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} {%b %b %llb} x y z] $x $y $z
} -result {3 9 5 340282366920938463463374607431768211456}
test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup {
test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
    set x {}
} -body {
    list [scan {10 010 0x10 0b10} {%i%i%i%i} x y z t] $x $y $z $t
} -result {4 10 8 16 0}
test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup {
    list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
} {3 10 8 16}
test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} {
    set x {}
} -body {
    list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z
} -result {3 10 8 16}
test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
} {3 10 8 16}
test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} {
    set x {}
} -body {
    list [scan {+ } {%i} x] $x
} -result {0 {}}
test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
} {0 {}}
test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} {
    set x {}
} -body {
    list [scan {+} {%i} x] $x
} -result {-1 {}}
test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
} {-1 {}}
test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} {
    set x {}
} -body {
    list [scan {0x} {%i%s} x y] $x $y
} -result {2 0 x}
test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
} {2 0 x}
test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} {
    set x {}
} -body {
    list [scan {0X} {%i%s} x y] $x $y
} -result {2 0 X}
test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} -setup {
} {2 0 X}
test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} {
    set x {}
} -body {
    list [scan {123def} {%*i%s} x] $x
} -result {1 def}
} {1 def}
test scan-4.48 {Tcl_ScanObjCmd, float scanning} {
    list [scan {1 2 3} {%e %f %g} x y z] $x $y $z
} {3 1.0 2.0 3.0}
test scan-4.49 {Tcl_ScanObjCmd, float scanning} {
    list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z
} {3 0.1 0.2 3.0}
test scan-4.49-uc-1 {Tcl_ScanObjCmd, float scanning} {
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
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
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
611

612
613
614


615
616
617
618
619
620
621
622
623
624


625
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
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
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
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
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
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
611

612


613
614
615

616



617
618
619

620
621

622
623
624
625
626
627
628
629







-
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+


-

-
+




-
+


-
-
-
-
+
+
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+

-
+





-
+








+
+
+
+
+
+
-
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-


-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
-
+
+
+
-

-
-
+
+

-

-
+

-
-
+
+
+

-
-
+
+
-


-
-
+
+

-


-
+











-
+
-
-
-
-
+
+
-
-
-
+
-
-
-
+
+
+
-
-
+
-
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-

-
-
+
+

-

-
-
-
+
+
+
+
-
-
+
-
-
-
+
+

-
-
-
-
-
-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-

-
-
+
+

-

-
-
-
-
+
+
+

-
+
-
-
-
-
-
+
+
+
-

-
+
-
-
-
-
-
+
+
+
-

-
+
-
-
-
-
-
+
+
+
-

-
+
-
-
-
-
-
+
+
+
-

-
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+

-

-
-
+
+

-

-
-
+
+

-

-
-
+
+

-

-
-
-
+
+
+
-


-
+







} {1 -123.0}
test scan-4.53 {Tcl_ScanObjCmd, float scanning} {
    list [scan {1.0e1} %f x] $x
} {1 10.0}
test scan-4.54 {Tcl_ScanObjCmd, float scanning} {
    list [scan {1.0e-1} %f x] $x
} {1 0.1}
test scan-4.55 {Tcl_ScanObjCmd, odd cases} -setup {
test scan-4.55 {Tcl_ScanObjCmd, odd cases} {
    set x {}
} -body {
    list [scan {+} %f x] $x
} -result {-1 {}}
test scan-4.56 {Tcl_ScanObjCmd, odd cases} -setup {
} {-1 {}}
test scan-4.56 {Tcl_ScanObjCmd, odd cases} {
    set x {}
} -body {
    list [scan {1.0e} %f%s x y] $x $y
} -result {2 1.0 e}
test scan-4.57 {Tcl_ScanObjCmd, odd cases} -setup {
} {2 1.0 e}
test scan-4.57 {Tcl_ScanObjCmd, odd cases} {
    set x {}
} -body {
    list [scan {1.0e+} %f%s x y] $x $y
} -result {2 1.0 e+}
test scan-4.58 {Tcl_ScanObjCmd, odd cases} -setup {
} {2 1.0 e+}
test scan-4.58 {Tcl_ScanObjCmd, odd cases} {
    set x {}
    set y {}
} -body {
    list [scan {e1} %f%s x y] $x $y
} -result {0 {} {}}
} {0 {} {}}
test scan-4.59 {Tcl_ScanObjCmd, float scanning} {
    list [scan {1.0e-1x} %*f%n x] $x
} {1 6}

test scan-4.60 {Tcl_ScanObjCmd, set errors} -setup {
test scan-4.60 {Tcl_ScanObjCmd, set errors} {
    set x {}
    set y {}
    unset -nocomplain z
} -body {
    array set z {}
    list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x $y
    catch {unset z}; array set z {}
    set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
} -cleanup {
    unset -nocomplain z
} -result {1 {can't set "z": variable is array} abc ghi}
test scan-4.61 {Tcl_ScanObjCmd, set errors} -setup {
	    $msg $x $y]
    unset z
    set result
} {1 {couldn't set variable "z"} abc ghi}
test scan-4.61 {Tcl_ScanObjCmd, set errors} {
    set x {}
    unset -nocomplain y
    unset -nocomplain z
} -body {
    array set y {}
    array set z {}
    list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x
} -cleanup {
    unset -nocomplain y
    unset -nocomplain z
} -result {1 {can't set "z": variable is array} abc}
    catch {unset y}; array set y {}
    catch {unset z}; array set z {}
    set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
	    $msg $x]
    unset y
    unset z
    set result
} {1 {couldn't set variable "z"couldn't set variable "y"} abc}

# procedure that returns the range of integers

proc int_range {} {
    for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} {
	set MIN_INT [expr { $MIN_INT << 1 }]
    }
    set MIN_INT [expr {int($MIN_INT)}]
    set MAX_INT [expr { ~ $MIN_INT }]
    return [list $MIN_INT $MAX_INT]
}

test scan-4.62 {scanning of large and negative octal integers} {
    lassign [int_range] MIN_INT MAX_INT
    foreach { MIN_INT MAX_INT } [int_range] {}
    set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
    list [scan $scanstring {%o %o %o} a b c] \
	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
} {3 1 1 1}
test scan-4.63 {scanning of large and negative hex integers} {
    lassign [int_range] MIN_INT MAX_INT
    foreach { MIN_INT MAX_INT } [int_range] {}
    set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT]
    list [scan $scanstring {%x %x %x} a b c] \
	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
} {3 1 1 1}
test scan-4.64 {scanning of hex with %X} {
    scan "123 abc f78" %X%X%X
} {291 2748 3960}

# clean up from last two tests

catch {
    rename int_range {}
}

test scan-5.1 {integer scanning} -setup {
test scan-5.1 {integer scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
} -result {4 -20 1476 33 0}
test scan-5.2 {integer scanning} -setup {
} {4 -20 1476 33 0}
test scan-5.2 {integer scanning} {
    set a {}; set b {}; set c {}
} -body {
    list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c
} -result {3 -4 16 7890}
test scan-5.3 {integer scanning} -setup {
} {3 -4 16 7890}
test scan-5.3 {integer scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d
} -result {4 -45 16 10 987}
test scan-5.4 {integer scanning} -setup {
} {4 -45 16 10 987}
test scan-5.4 {integer scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d
} -result {4 14 427 50 16}
test scan-5.5 {integer scanning} -setup {
} {4 14 427 50 16}
test scan-5.5 {integer scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "12345670 1234567890ab cdefg" "%o	 %o %x %lx" a b c d] \
	    $a $b $c $d
} -result {4 2739128 342391 561323 52719}
test scan-5.6 {integer scanning} -setup {
} {4 2739128 342391 561323 52719}
test scan-5.6 {integer scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d
} -result {4 171 291 -20 52}
test scan-5.7 {integer scanning} -setup {
} {4 171 291 -20 52}
test scan-5.7 {integer scanning} {
    set a {}; set b {}
} -body {
    list [scan "1234567 234 567  " "%*3x %x %*o %4o" a b] $a $b
} -result {2 17767 375}
test scan-5.8 {integer scanning} -setup {
} {2 17767 375}
test scan-5.8 {integer scanning} {
    set a {}; set b {}
} -body {
    list [scan "a	1234" "%d %d" a b] $a $b
} -result {0 {} {}}
test scan-5.9 {integer scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} {0 {} {}}
test scan-5.9 {integer scanning} {
    set a {}; set b {}; set c {}; set d {};
} -body {
    list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d
} -result {4 12 34 56 78}
test scan-5.10 {integer scanning} -setup {
} {4 12 34 56 78}
test scan-5.10 {integer scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
} -result {2 1 2 {} {}}
} {2 1 2 {} {}}
#
# The behavior for scaning intergers larger than MAX_INT is not defined by the
# ANSI spec.  Some implementations wrap the input (-16) some return MAX_INT.
# The behavior for scaning intergers larger than MAX_INT is
# not defined by the ANSI spec.  Some implementations wrap the
# input (-16) some return MAX_INT.
#
test scan-5.11 {integer scanning} -constraints {nonPortable} -setup {
    set a {}; set b {}
test scan-5.11 {integer scanning} {nonPortable} {
    set a {}; set b {};
} -body {
    list [scan "4294967280 4294967280" "%u %d" a b] $a \
	    [expr {$b == -16 || $b == 0x7fffffff}]
} -result {2 4294967280 1}
test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup {
} {2 4294967280 1}
test scan-5.12 {integer scanning} {wideIs64bit} {
    set a {}; set b {}; set c {}
} -body {
    list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \
	    %ld,%lx,%lo a b c] $a $b $c
} -result {3 7810179016327718216 7810179016327718216 7810179016327718216}
} {3 7810179016327718216 7810179016327718216 7810179016327718216}
test scan-5.13 {integer scanning and overflow} {
    # This test used to fail on some 64-bit systems. [Bug 1011860]
    scan {300000000 3000000000 30000000000} {%ld %ld %ld}
} {300000000 3000000000 30000000000}

test scan-5.14 {integer scanning} {
    scan 0xff %u
} 0
test scan-5.15 {Bug be003d570f} {
    scan 0x40 %o
} 0
test scan-5.16 {Bug be003d570f} {

    scan 0x40 %b
} 0
test scan-5.17 {bigint scanning} -setup {
    set a {}; set b {}; set c {}
test scan-6.1 {floating-point scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "207698809136909011942886895,abcdef0123456789abcdef,125715736004432126361152746757" \
	    %lld,%llx,%llo a b c] $a $b $c
    list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
} -result {3 207698809136909011942886895 207698809136909011942886895 207698809136909011942886895}
test scan-5.18 {bigint scanning underflow} -setup {
    set a {};
} {3 2.1 -300000000.0 0.99962 {}}
test scan-6.2 {floating-point scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "-207698809136909011942886895" \
    list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
	    %llu a] $a
} -returnCodes 1 -result {unsigned bignum scans are invalid}
test scan-5.19 {bigint scanning invalid} -setup {
    set a {};
} {4 -1.0 234.0 5.0 8.2}
} -body {
    list [scan "207698809136909011942886895" \
           %llu a] $a
} -result {1 207698809136909011942886895}
test scan-5.20 {ignore digit separators} -setup {
    set a {}; set b {}; set c {};
test scan-6.3 {floating-point scanning} {
    set a {}; set b {}; set c {}
} -body {
    list [scan "10_23_45" %d_%d_%d a b c] $a $b $c
} -result {3 10 23 45}

test scan-6.1 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
    list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c
} {3 10000.0 30000.0}
#
# Some libc implementations consider 3.e- bad input.  The ANSI
# spec states that digits must follow the - sign.
#
test scan-6.4 {floating-point scanning} {
    set a {}; set b {}; set c {}
} -body {
    list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
} -result {3 2.1 -300000000.0 0.99962 {}}
test scan-6.2 {floating-point scanning} -setup {
    list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c
} {3 1.0 200.0 3.0}
test scan-6.5 {floating-point scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
} -result {4 -1.0 234.0 5.0 8.2}
test scan-6.3 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}
    list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
} {4 4.6 99999.7 87.643 118.0}
test scan-6.6 {floating-point scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c
    list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
} -result {3 10000.0 30000.0}
#
# Some libc implementations consider 3.e- bad input.  The ANSI spec states
# that digits must follow the - sign.
#
test scan-6.4 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}
} -body {
} {4 1.2345 0.697 124.0 5e-5}
    list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c
} -result {3 1.0 200.0 3.0}
test scan-6.5 {floating-point scanning} -setup {
test scan-6.7 {floating-point scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
} -result {4 4.6 99999.7 87.643 118.0}
test scan-6.6 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
} -result {4 1.2345 0.697 124.0 5e-5}
test scan-6.7 {floating-point scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d
} -result {1 4.6 {} {} {}}
test scan-6.8 {floating-point scanning} -setup {
} {1 4.6 {} {} {}}
test scan-6.8 {floating-point scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
} -result {2 4.6 5.2 {} {}}
test scan-6.8 {disallow diget separator in floating-point} -setup {
    set a {}; set b {}; set c {};
} {2 4.6 5.2 {} {}}

test scan-7.1 {string and character scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "3.14_2.35_98.6" %f_%f_%f a b c ] $a $b $c
    list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
} -result {3 3.14 2.35 98.6}

test scan-7.1 {string and character scanning} -setup {
} {4 abc def ghijk dum}
test scan-7.2 {string and character scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
} -result {4 abc def ghijk dum}
test scan-7.2 {string and character scanning} -setup {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "a       bcdef" "%c%c%1s %s" a b c d] $a $b $c $d
} -result {4 97 32 b cdef}
test scan-7.3 {string and character scanning} -setup {
} {4 97 32 b cdef}
test scan-7.3 {string and character scanning} {
    set a {}; set b {}; set c {}
} -body {
    list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c
} -result {1 test {} {}}
test scan-7.4 {string and character scanning} -setup {
} {1 test {} {}}
test scan-7.4 {string and character scanning} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "ababcd01234  f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d
} -result {4 abab cd {01234  } {f 12345}}
test scan-7.5 {string and character scanning} -setup {
} {4 abab cd {01234  } {f 12345}}
test scan-7.5 {string and character scanning} {
    set a {}; set b {}; set c {}
} -body {
    list [scan "aaaaaabc aaabcdefg  + +  XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
} -result {3 aabc bcdefg 43}
test scan-7.6 {string and character scanning, unicode} -setup {
} {3 aabc bcdefg 43}
test scan-7.6 {string and character scanning, unicode} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
} -result "4 abc d\u00c7f ghijk dum"
test scan-7.7 {string and character scanning, unicode} -setup {
} "4 abc d\u00c7f ghijk dum"
test scan-7.7 {string and character scanning, unicode} {
    set a {}; set b {}
} -body {
    list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b
} -result "2 199 99"
test scan-7.8 {string and character scanning, unicode} -setup {
} "2 199 99"
test scan-7.8 {string and character scanning, unicode} {
    set a {}; set b {}
} -body {
    list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a
} -result "1 ab\ufeff"
} "1 ab\ufeff"

test scan-8.1 {error conditions} -body {
    scan a
test scan-8.1 {error conditions} {
    catch {scan a}
} -returnCodes error -match glob -result *
test scan-8.2 {error conditions} -returnCodes error -body {
    scan a
} -result {wrong # args: should be "scan string format ?varName ...?"}
test scan-8.3 {error conditions} -returnCodes error -body {
    scan a %D x
} -result {bad scan conversion character "D"}
test scan-8.4 {error conditions} -returnCodes error -body {
    scan a %O x
} -result {bad scan conversion character "O"}
test scan-8.5 {error conditions} -returnCodes error -body {
    scan a %B x
} -result {bad scan conversion character "B"}
test scan-8.6 {error conditions} -returnCodes error -body {
    scan a %F x
} -result {bad scan conversion character "F"}
test scan-8.7 {error conditions} -returnCodes error -body {
    scan a %p x
} -result {bad scan conversion character "p"}
test scan-8.8 {error conditions} -returnCodes error -body {
    scan a "%d %d" a
} -result {different numbers of variable names and field specifiers}
test scan-8.9 {error conditions} -returnCodes error -body {
    scan a "%d %d" a b c
} -result {variable is not assigned by any conversion specifiers}
test scan-8.10 {error conditions} -setup {
} 1
test scan-8.2 {error conditions} {
    catch {scan a} msg
    set msg
} {wrong # args: should be "scan string format ?varName varName ...?"}
test scan-8.3 {error conditions} {
    list [catch {scan a %D x} msg] $msg
} {1 {bad scan conversion character "D"}}
test scan-8.4 {error conditions} {
    list [catch {scan a %O x} msg] $msg
} {1 {bad scan conversion character "O"}}
test scan-8.5 {error conditions} {
    list [catch {scan a %B x} msg] $msg
} {1 {bad scan conversion character "B"}}
test scan-8.6 {error conditions} {
    list [catch {scan a %F x} msg] $msg
} {1 {bad scan conversion character "F"}}
test scan-8.7 {error conditions} {
    list [catch {scan a %p x} msg] $msg
} {1 {bad scan conversion character "p"}}
test scan-8.8 {error conditions} {
    list [catch {scan a "%d %d" a} msg] $msg
} {1 {different numbers of variable names and field specifiers}}
test scan-8.9 {error conditions} {
    list [catch {scan a "%d %d" a b c} msg] $msg
} {1 {variable is not assigned by any conversion specifiers}}
test scan-8.10 {error conditions} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [expr {[scan "  a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d
} -result {1 {} {} {} {}}
test scan-8.11 {error conditions} -setup {
} {1 {} {} {} {}}
test scan-8.11 {error conditions} {
    set a {}; set b {}; set c {}; set d {}
} -body {
    list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d
} -result {2 1 2 {} {}}
test scan-8.12 {error conditions} -setup {
    unset -nocomplain a
} -body {
} {2 1 2 {} {}}
test scan-8.12 {error conditions} {
    catch {unset a}
    set a(0) 44
    scan 44 %d a
    list [catch {scan 44 %d a} msg] $msg
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {can't set "a": variable is array}
test scan-8.13 {error conditions} -setup {
    unset -nocomplain a
} {1 {couldn't set variable "a"}}
test scan-8.13 {error conditions} {
    catch {unset a}
} -body {
    set a(0) 44
    scan 44 %c a
    list [catch {scan 44 %c a} msg] $msg
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {can't set "a": variable is array}
test scan-8.14 {error conditions} -setup {
    unset -nocomplain a
} {1 {couldn't set variable "a"}}
test scan-8.14 {error conditions} {
    catch {unset a}
} -body {
    set a(0) 44
    scan 44 %s a
    list [catch {scan 44 %s a} msg] $msg
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {can't set "a": variable is array}
test scan-8.15 {error conditions} -setup {
    unset -nocomplain a
} {1 {couldn't set variable "a"}}
test scan-8.15 {error conditions} {
    catch {unset a}
} -body {
    set a(0) 44
    scan 44 %f a
    list [catch {scan 44 %f a} msg] $msg
} -returnCodes error -cleanup {
    unset -nocomplain a
} -result {can't set "a": variable is array}
test scan-8.16 {error conditions} -setup {
    unset -nocomplain a
} {1 {couldn't set variable "a"}}
test scan-8.16 {error conditions} {
    catch {unset a}
} -body {
    set a(0) 44
    scan 44 %f a
    list [catch {scan 44 %f a} msg] $msg
} -returnCodes error -cleanup {
    unset -nocomplain a
} {1 {couldn't set variable "a"}}
catch {unset a}
} -result {can't set "a": variable is array}
test scan-8.17 {error conditions} -returnCodes error -body {
    scan 44 %2c a
} -result {field width may not be specified in %c conversion}
test scan-8.18 {error conditions} -returnCodes error -body {
    scan abc {%[} x
} -result {unmatched [ in format string}
test scan-8.19 {error conditions} -returnCodes error -body {
    scan abc {%[^a} x
} -result {unmatched [ in format string}
test scan-8.20 {error conditions} -returnCodes error -body {
    scan abc {%[^]a} x
} -result {unmatched [ in format string}
test scan-8.21 {error conditions} -returnCodes error -body {
    scan abc {%[]a} x
} -result {unmatched [ in format string}
test scan-8.17 {error conditions} {
    list [catch {scan 44 %2c a} msg] $msg
} {1 {field width may not be specified in %c conversion}}
test scan-8.18 {error conditions} {
    list [catch {scan abc {%[} x} msg] $msg
} {1 {unmatched [ in format string}}
test scan-8.19 {error conditions} {
    list [catch {scan abc {%[^a} x} msg] $msg
} {1 {unmatched [ in format string}}
test scan-8.20 {error conditions} {
    list [catch {scan abc {%[^]a} x} msg] $msg
} {1 {unmatched [ in format string}}
test scan-8.21 {error conditions} {
    list [catch {scan abc {%[]a} x} msg] $msg
} {1 {unmatched [ in format string}}

test scan-9.1 {lots of arguments} {
    scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
} 20
test scan-9.2 {lots of arguments} {
    scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
    set a20
} 200

test scan-10.1 {miscellaneous tests} -setup {
test scan-10.1 {miscellaneous tests} {
    set a {}
} -body {
    list [scan ab16c ab%dc a] $a
} -result {1 16}
test scan-10.2 {miscellaneous tests} -setup {
} {1 16}
test scan-10.2 {miscellaneous tests} {
    set a {}
} -body {
    list [scan ax16c ab%dc a] $a
} -result {0 {}}
test scan-10.3 {miscellaneous tests} -setup {
} {0 {}}
test scan-10.3 {miscellaneous tests} {
    set a {}
} -body {
    list [catch {scan ab%c114 ab%%c%d a} msg] $msg $a
} -result {0 1 114}
test scan-10.4 {miscellaneous tests} -setup {
} {0 1 114}
test scan-10.4 {miscellaneous tests} {
    set a {}
} -body {
    list [catch {scan ab%c14 ab%%c%d a} msg] $msg $a
} -result {0 1 14}
test scan-10.5 {miscellaneous tests} -setup {
    unset -nocomplain arr
} {0 1 14}
test scan-10.5 {miscellaneous tests} {
    catch {unset arr}
} -body {
    set arr(2) {}
    list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2)
} -result {0 1 14}
} {0 1 14}
test scan-10.6 {miscellaneous tests} {
    scan 5a {%i%[a]}
} {5 a}
test scan-10.7 {miscellaneous tests} {
    scan {5 a} {%i%[a]}
} {5 {}}

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
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
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







-
-
-
+
+
+


















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+

-
+

-
+



-
-









test scan-13.1 {Tcl_ScanObjCmd, inline XPG case} {
    scan a {%1$c}
} 97
test scan-13.2 {Tcl_ScanObjCmd, inline XPG case} {
    scan abc {%1$c%2$c%3$c%4$c}
} {97 98 99 {}}
test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} -returnCodes error -body {
    scan abc {%1$c%1$c}
} -result {variable is assigned by multiple "%n$" conversion specifiers}
test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} {
    list [catch {scan abc {%1$c%1$c}} msg] $msg
} {1 {variable is assigned by multiple "%n$" conversion specifiers}}
test scan-13.4 {Tcl_ScanObjCmd, inline XPG case} {
    scan abc {%2$s%1$c}
} {{} abc}
test scan-13.5 {Tcl_ScanObjCmd, inline XPG case, underflow} {
    scan abc {abc%5$c}
} {}
test scan-13.6 {Tcl_ScanObjCmd, inline XPG case} {
    catch {scan abc {bogus%1$c%5$c%10$c}} msg
    list [llength $msg] $msg
} {10 {{} {} {} {} {} {} {} {} {} {}}}
test scan-13.7 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
    scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" {%20$d %18$d %17$d %16$d %15$d %14$d %13$d %12$d %11$d %10$d %9$d %8$d %7$d %6$d %5$d %4$d %3$d %2$d %1$d}
} {190 180 170 160 150 140 130 120 110 100 90 80 70 60 50 40 30 20 {} 10}
test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
    set msg [scan "10 20 30" {%100$d %5$d %200$d}]
    list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
} {200 10 20 30}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
	    # little endian
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
		ieeeValues(-Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
		ieeeValues(-Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
		ieeeValues(-Subnormal)
	    binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
		ieeeValues(-0)
	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+0)
	    binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
		ieeeValues(+Subnormal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
		ieeeValues(+Normal)
	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
		ieeeValues(+Infinity)
	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
		ieeeValues(NaN)
	    set ieeeValues(littleEndian) 1
	    return 1
	}
	{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
	    binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Infinity)
	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Normal)
	    binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-Subnormal)
	    binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(-0)
	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+0)
	    binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Subnormal)
	    binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Normal)
	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(+Infinity)
	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
		ieeeValues(NaN)
	    set ieeeValues(littleEndian) 0
	    return 1
	}
	default {
	    return 0
	}
    }
}

testConstraint ieeeFloatingPoint [testIEEE]

# scan infinities - not working

test scan-14.1 {positive infinity} {
test scan-14.1 {infinity} {
    scan Inf %g d
    return $d
    set d
} Inf
test scan-14.2 {negative infinity} {
test scan-14.2 {infinity} {
    scan -Inf %g d
    return $d
    set d
} -Inf

# TODO - also need to scan NaN's

catch {rename int_range {}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/security.test.

1
2
3
4


5
6
7


8
9
10
11
12
13
14


15
16
17
18
19
20
21
1
2


3
4
5


6
7
8
9
10
11
12


13
14
15
16
17
18
19
20
21


-
-
+
+

-
-
+
+





-
-
+
+







# security.test --
#
# Functionality covered: this file contains a collection of tests for the auto
# loading and namespaces.
# Functionality covered: this file contains a collection of tests for the
# auto loading and namespaces.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# If this proc becomes invoked, then there is a bug

proc BUG {args} {
    set ::BUG 1
35
36
37
38
39
40
41
42
43
44
45
35
36
37
38
39
40
41











-
-
-
-
    catch {tcl_startOfPreviousWord x {[BUG]}}
    CB
} 0

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/set-old.test.

9
10
11
12
13
14
15
16
17


18
19
20
21
22

23
24
25
26
27
28
29
9
10
11
12
13
14
15


16
17
18
19
20
21

22
23
24
25
26
27
28
29







-
-
+
+




-
+







# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

proc ignore args {}


# Simple variable operations.

catch {unset a}
test set-old-1.1 {basic variable setting and unsetting} {
    set a 22
} 22
test set-old-1.2 {basic variable setting and unsetting} {
200
201
202
203
204
205
206
207

208
209
210
211
212
213
214
200
201
202
203
204
205
206

207
208
209
210
211
212
213
214







-
+







    list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
	    [catch {set d(0) 0}]
} {0 0 0 1}
test set-old-7.2 {unset command} {
    list [catch {unset} msg] $msg
} {0 {}}
# Used to return:
#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName ...?"}}
#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName varName ...?"}}
test set-old-7.3 {unset command} {
    catch {unset a}
    list [catch {unset a} msg] $msg
} {1 {can't unset "a": no such variable}}
test set-old-7.4 {unset command} {
    catch {unset a}
    set a 44
311
312
313
314
315
316
317
318

319
320
321

322
323
324
325
326
327
328
311
312
313
314
315
316
317

318
319
320

321
322
323
324
325
326
327
328







-
+


-
+







	[catch {unset -nocomplain -- --}] [info exists --]
} {1 0 1 0 0}

# Array command.

test set-old-8.1 {array command} {
    list [catch {array} msg] $msg
} {1 {wrong # args: should be "array subcommand ?arg ...?"}}
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
test set-old-8.2 {array command} {
    list [catch {array a} msg] $msg
} {1 {wrong # args: should be "array anymore arrayName searchId"}}
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
test set-old-8.3 {array command} {
    catch {unset a}
    list [catch {array anymore a b} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.4 {array command} {
    catch {unset a}
    set a 44
336
337
338
339
340
341
342
343

344
345
346
347
348
349
350
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350







-
+







    }
    foo
} {1 {"x" isn't an array}}
test set-old-8.6 {array command} {
    catch {unset a}
    set a(22) 3
    list [catch {array gorp a} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
test set-old-8.7 {array command, anymore option} {
    catch {unset a}
    list [catch {array anymore a x} msg] $msg
} {1 {"a" isn't an array}}
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
    proc foo {x} {
        if {$x==1} {
386
387
388
389
390
391
392
393

394
395
396
397
398
399
400
386
387
388
389
390
391
392

393
394
395
396
397
398
399
400







-
+







        }
        set a(x) 123
    }
    list [catch {foo 1} msg] $msg
} {0 0}
test set-old-8.15 {array command, get option} {
    list [catch {array get} msg] $msg
} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
test set-old-8.16 {array command, get option} {
    list [catch {array get a b c} msg] $msg
} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
test set-old-8.17 {array command, get option} {
    catch {unset a}
    array get a
} {}
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
648
649
650
651
652
653
654







655
656
657
658
659
660
661







-
-
-
-
-
-
-







test set-old-8.52 {array command, array names -regexp on regexp pattern} {
    catch {unset a}
    set a(1*2) 1
    set a(12) 1
    set a(11) 1
    list [catch {lsort [array names a -regexp ^1]} msg] $msg
} {0 {1*2 11 12}}
test set-old-8.52.1 {array command, array names -regexp, backrefs} {
    catch {unset a}
    set a(1*2) 1
    set a(12) 1
    set a(11) 1
    list [catch {lsort [array names a -regexp {^(.)\1}]} msg] $msg
} {0 11}
test set-old-8.53 {array command, array names -regexp} {
    catch {unset a}
    set a(-glob) 1
    set a(-regexp) 1
    set a(-exact) 1
    list [catch {array names a -regexp} msg] $msg
} {0 -regexp}
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
670
671
672
673
674
675
676


677
678
679











680
681
682
683
684

685
686
687
688
689
690
691
692







-
-
+
+

-
-
-
-
-
-
-
-
-
-
-





-
+







    catch {unset a}
    set a(-glob) 1
    set a(-regexp) 1
    set a(-exact) 1
    list [catch {array names a -glob} msg] $msg
} {0 -glob}
test set-old-8.56 {array command, array statistics on a non-array} {
    catch {unset a}
    list [catch {array statistics a} msg] $msg
	catch {unset a}
	list [catch {array statistics a} msg] $msg
} [list 1 "\"a\" isn't an array"]
test set-old-8.57 {array command, array get with trivial pattern} {
    catch {unset a}
    set a(x) 1
    set a(y) 2
    array get a x
} {x 1}
test set-old-8.58 {array command, array set with LVT and odd length literal} {
    list [catch {apply {{} {
	array set a {b c d}
    }}} msg] $msg
} {1 {list must have an even number of elements}}

test set-old-9.1 {ids for array enumeration} {
    catch {unset a}
    set a(a) 1
    list [array star a] [array star a] [array done a s-1-a; array star a] \
	    [array done a s-2-a; array do a s-3-a; array start a]
	    [array done a s-2-a; array d a s-3-a; array start a]
} {s-1-a s-2-a s-3-a s-1-a}
test set-old-9.2 {array enumeration} {
    catch {unset a}
    set a(a) 1
    set a(b) 1
    set a(c) 1
    set x [array startsearch a]
805
806
807
808
809
810
811
812

813
814
815
816
817
818
819
787
788
789
790
791
792
793

794
795
796
797
798
799
800
801







-
+







    trace var a(b) r {}
    set x [array startsearch a]
    lsort [list [array next a $x] [array next a $x]]
} {{} a}

test set-old-10.1 {array enumeration errors} {
    list [catch {array start} msg] $msg
} {1 {wrong # args: should be "array startsearch arrayName"}}
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
test set-old-10.2 {array enumeration errors} {
    list [catch {array start a b} msg] $msg
} {1 {wrong # args: should be "array startsearch arrayName"}}
test set-old-10.3 {array enumeration errors} {
    catch {unset a}
    list [catch {array start a} msg] $msg
} {1 {"a" isn't an array}}
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
850
851
852
853
854
855
856


857
858
859
860
861
862
863







-
-







test set-old-10.12 {array enumeration errors} {
    list [catch {array done a} msg] $msg
} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
test set-old-10.13 {array enumeration errors} {
    list [catch {array done a b c} msg] $msg
} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
test set-old-10.14 {array enumeration errors} {
    catch {unset a}
    set a(a) a
    list [catch {array done a b} msg] $msg
} {1 {illegal search identifier "b"}}
test set-old-10.15 {array enumeration errors} {
    list [catch {array anymore a} msg] $msg
} {1 {wrong # args: should be "array anymore arrayName searchId"}}
test set-old-10.16 {array enumeration errors} {
    list [catch {array any a b c} msg] $msg
925
926
927
928
929
930
931
932

933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
905
906
907
908
909
910
911

912
913
914
915
916
917
918

919
920
921
922











-
+






-




-
-
-
-
} 12345
test set-old-12.2 {cleanup on procedure return} {
    proc foo {} {
	set x(1) 23456
    }
    foo
} 23456


# Must delete variables when done, since these arrays get used as
# scalars by other tests.
catch {unset a}
catch {unset b}
catch {unset c}
catch {unset aVaRnAmE}
catch {rename foo {}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/set.test.

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
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












-
-
+
+



-
-
-




-
+
















-
+

-


-
-
+
+

-


-
+







# Commands covered:  set
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testset2 [llength [info commands testset2]]

catch {unset x}
catch {unset i}


test set-1.1 {TclCompileSetCmd: missing variable name} {
    list [catch {set} msg] $msg
} {1 {wrong # args: should be "set varName ?newValue?"}}
test set-1.2 {TclCompileSetCmd: simple variable name} {
    set i 10
    list [set i] $i
} {10 10}
test set-1.3 {TclCompileSetCmd: error compiling variable name} {
    set i 10
    catch {set "i"xxx} msg
    set msg
} {extra characters after close-quote}
test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
    set i 17
    list [set "i"] $i
} {17 17}
test set-1.5 {TclCompileSetCmd: simple variable name in braces} -setup {
test set-1.5 {TclCompileSetCmd: simple variable name in braces} {
    catch {unset {a simple var}}
} -body {
    set {a simple var} 27
    list [set {a simple var}] ${a simple var}
} -result {27 27}
test set-1.6 {TclCompileSetCmd: simple array variable name} -setup {
} {27 27}
test set-1.6 {TclCompileSetCmd: simple array variable name} {
    catch {unset a}
} -body {
    set a(foo) 37
    list [set a(foo)] $a(foo)
} -result {37 37}
} {37 37}
test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
    set x "i"
    set i 77
    list [set $x] $i
} {77 77}
test set-1.8 {TclCompileSetCmd: non-simple (computed) variable name} {
    set x "i"
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
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







-
+

-




-
-
+
+

-






-
+







        set y0 0; set y1 0; set y2 0; set y3 0; set y4 0
        set y5 0; set y6 0; set y7 0; set y8 0; set y9 0
        set z0 0; set z1 0; set z2 0; set z3 0; set z4 0
        set z5 0; set z6 0; set z7 0; set z8 0; set z9 1234
    }
    260locals
} {1234}
test set-1.15 {TclCompileSetCmd: variable is array} -setup {
test set-1.15 {TclCompileSetCmd: variable is array} {
    catch {unset a}
} -body {
    set x 27
    set x [set a(foo) 11]
    catch {unset a}
    set x
} -result 11
test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} -setup {
} 11
test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} {
    catch {unset a}
} -body {
    set i 5
    set x 789
    set a(foo5) 27
    set x [set a(foo$i)]
    catch {unset a}
    set x
} -result 27
} 27

test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
    set i 5
    set i 123
} 123
test set-1.18 {TclCompileSetCmd: doing assignment, simple int} {
    set i 5
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
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







-
+


















-
+
+



-
+

-

-
+


-
-
-
+
+
-


-
-
-
+
+
+
-


-
-
+
+
-
-








-
+
-
-
-

-
-
+
+
-
-
-

-
+







    # This was a known error in 8.1a* - 8.2.1
    catch {unset array}
    set {array($foo)} 5
} 5
test set-1.26 {TclCompileSetCmd: various array constructs} {
    # Test all kinds of array constructs that TclCompileSetCmd
    # may feel inclined to tamper with.
    apply {{} {
    proc p {} {
	set a x
	set be(hej) 1					; # hej
	set be($a) 1					; # x
	set {be($a)} 1					; # $a
	set be($a,hej) 1				; # x,hej
	set be($a,$a) 5					; # x,x
	set be(c($a) 1					; # c(x
	set be(\w\w) 1					; # ww
	set be(a:$a) [set be(x,$a)]			; # a:x
	set be(hej,$be($a,hej),hej) 1			; # hej,1,hej
	set be([string range hugge 0 2]) 1		; # hug
	set be(a\ a) 1					; # a a
	set be($a\ ,[string range hugge 1 3],hej) 1	; # x ,ugg,hej
	set be($a,h"ej) 1				; # x,h"ej
	set be([string range "a b c" 2 end]) 1		; # b c
	set [string range bet 0 1](foo) 1		; # foo
	set be([set be(a:$a)][set b\e($a)]) 1		; # 51
	return [lsort [array names be]]
    }}
    }
    p
} [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej
{b c} foo 51}]; # " just a matching end quote

test set-2.1 {set command: runtime error, bad variable name} -setup {
test set-2.1 {set command: runtime error, bad variable name} {
    unset -nocomplain {"foo}
} -body {
    list [catch {set {"foo}} msg] $msg $::errorInfo
} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
    while executing
"set {"foo}"}}
# Stop my editor highlighter " from being confused
test set-2.2 {set command: runtime error, not array variable} -setup {
    unset -nocomplain b
test set-2.2 {set command: runtime error, not array variable} {
    catch {unset b}
} -body {
    set b 44
    list [catch {set b(123)} msg] $msg
} -result {1 {can't read "b(123)": variable isn't array}}
test set-2.3 {set command: runtime error, errors in reading variables} -setup {
    unset -nocomplain a
} {1 {can't read "b(123)": variable isn't array}}
test set-2.3 {set command: runtime error, errors in reading variables} {
    catch {unset a}
} -body {
    set a(6) 44
    list [catch {set a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
test set-2.4 {set command: runtime error, readonly variable} -setup {
} {1 {can't read "a(18)": no such element in array}}
test set-2.4 {set command: runtime error, readonly variable} -body {
    unset -nocomplain x
} -body {
    proc readonly args {error "variable is read-only"}
    set x 123
    trace var x w readonly
    list [catch {set x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"set x 1"}}
test set-2.5 {set command: runtime error, basic array operations} -setup {
test set-2.5 {set command: runtime error, basic array operations} {
    unset -nocomplain a
} -body {
    array set a {}
    list [catch {set a(other)} msg] $msg
} -result {1 {can't read "a(other)": no such element in array}}
test set-2.6 {set command: runtime error, basic array operations} -setup {
} {1 {can't read "a(other)": no such element in array}}
test set-2.6 {set command: runtime error, basic array operations} {
    unset -nocomplain a
} -body {
    array set a {}
    list [catch {set a} msg] $msg
} -result {1 {can't read "a": variable is array}}
} {1 {can't read "a": variable is array}}

# Test the uncompiled version of set

catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}
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
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











-
+

-


-
+


-
-
+
-
-

+


-
-
+
+
-
-
-
+
+


-
+










-
+
-
-
-


-
-
+
+
-
-
-


-
+

-
+

-



-
+
+




-
+








-
-
-
-
test set-3.24 {uncompiled set command: too many arguments} {
    set z set
    $z i 10
    catch {$z i 20 30} msg
    $z msg
} {wrong # args: should be "set varName ?newValue?"}

test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup {
test set-4.1 {uncompiled set command: runtime error, bad variable name} {
    unset -nocomplain {"foo}
} -body {
    set z set
    list [catch {$z {"foo}} msg] $msg $::errorInfo
} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
    while executing
"$z {"foo}"}}
# Stop my editor highlighter " from being confused
test set-4.2 {uncompiled set command: runtime error, not array variable} -setup {
test set-4.2 {uncompiled set command: runtime error, not array variable} {
    catch {unset b}
} -body {
    set z set
    catch {unset b}
    $z b 44
    list [catch {$z b(123)} msg] $msg
} -result {1 {can't read "b(123)": variable isn't array}}
test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup {
} {1 {can't read "b(123)": variable isn't array}}
test set-4.3 {uncompiled set command: runtime error, errors in reading variables} {
    catch {unset a}
} -body {
    set z set
     set z set
   catch {unset a}
    $z a(6) 44
    list [catch {$z a(18)} msg] $msg
} -result {1 {can't read "a(18)": no such element in array}}
} {1 {can't read "a(18)": no such element in array}}
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
    set z set
    proc readonly args {error "variable is read-only"}
    $z x 123
    trace var x w readonly
    list [catch {$z x 1} msg] $msg $::errorInfo
} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
    while executing
*
"$z x 1"}}
test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
test set-4.5 {uncompiled set command: runtime error, basic array operations} {
    unset -nocomplain a
    array set a {}
} -body {
    set z set
    list [catch {$z a(other)} msg] $msg
} -result {1 {can't read "a(other)": no such element in array}}
test set-4.6 {set command: runtime error, basic array operations} -setup {
} {1 {can't read "a(other)": no such element in array}}
test set-4.6 {set command: runtime error, basic array operations} {
    unset -nocomplain a
    array set a {}
} -body {
    set z set
    list [catch {$z a} msg] $msg
} -result {1 {can't read "a": variable is array}}
} {1 {can't read "a": variable is array}}

test set-5.1 {error on malformed array name} -constraints testset2 -setup {
test set-5.1 {error on malformed array name} testset2 {
    unset -nocomplain z
} -body {
    catch {testset2 z(a) b} msg
    catch {testset2 z(b) a} msg1
    list $msg $msg1
} -result {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
} {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}

# In a mem-debug build, this test will crash unless Bug 3602706 is fixed.
test set-5.2 {Bug 3602706} -body {
    testset2 ::tcl_platform not-in-there
} -returnCodes error -result * -match glob


# cleanup
catch {unset a}
catch {unset b}
catch {unset i}
catch {unset x}
catch {unset z}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/socket.test.

1
2
3
4
5



6
7
8
9
10
11


12
13
14
15
16
17
18
1
2



3
4
5
6
7
8
9


10
11
12
13
14
15
16
17
18


-
-
-
+
+
+




-
-
+
+







# Commands tested in this file: socket.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

# Running socket tests with a remote server:
# ------------------------------------------
#
# Some tests in socket.test depend on the existence of a remote server to
# which they connect. The remote server must be an instance of tcltest and it
# must run the script found in the file "remote.tcl" in this directory. You
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
363
364

365
366
367
368
369
370
371
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







-
-
+
+

















-
-
-
+
+
-
-
-
-
-




-

-
-
+
+

-



-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+








-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+


-
+


-
-
-
-
-
-
+
+
+
+
+
+













-
+









-
+


















-
+







-
+
+
















+





-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
+







#
#     tcltest remote.tcl
#
# to have it listen on port 2048 on the interface your.machine.com.
#
# When the server starts, it prints out a detailed message containing its
# configuration information, and it will block until killed with a Ctrl-C.
# Once the remote server exists, you can run the tests in socket.test with the
# server by setting two Tcl variables:
# Once the remote server exists, you can run the tests in socket.test with
# the server by setting two Tcl variables:
#
#     % set remoteServerIP <name or address of machine on which server runs>
#     % set remoteServerPort 2048
#
# These variables are also settable from the environment. On Unix, you can:
#
#     shell% setenv remoteServerIP machine.where.server.runs
#     shell% senetv remoteServerPort 2048
#
# The preamble of the socket.test file checks to see if the variables are set
# either in Tcl or in the environment; if they are, it attempts to connect to
# the server. If the connection is successful, the tests using the remote
# server will be performed; otherwise, it will attempt to start the remote
# server (via exec) on platforms that support this, on the local host,
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
::tcltest::loadTestedCommands

if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
    return
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

# Some tests require the Thread package or exec command
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# Some tests require the testthread and exec commands
testConstraint testthread [llength [info commands testthread]]
testConstraint exec [llength [info commands exec]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

# Produce a random port number in the Dynamic/Private range
# from 49152 through 65535.
proc randport {} {
proc randport {} { expr {int(rand()*16383+49152)} }
    # firstly try dynamic port via server-socket(0):
    set port 0x7fffffff
    catch {
	set port [lindex [fconfigure [set s [socket -server {} 0]] -sockname] 2]
	close $s
    }

    while {[catch {
	close [socket -server {} $port]
    } msg]} {
	if {[incr i] > 1000} {return -code error "too many iterations to get free random port: $msg"}
	# try random port:
	set port [expr {int(rand()*16383+49152)}]
    }
    return $port
}

# Check if testsocket testflags is available
testConstraint testsocket_testflags [expr {![catch {
        set h [socket -async localhost [randport]]
        testsocket testflags $h 0
        close $h
    }]}]


# Test the latency of tcp connections over the loopback interface. Some OSes
# (e.g. NetBSD) seem to use the Nagle algorithm and delayed ACKs, so it takes
# up to 200ms for a packet sent to localhost to arrive. We're measuring this
# here, so that OSes that don't have this problem can run the tests at full
# speed.
set server [socket -server {apply {{s a p} {set ::s1 $s}}} 0]
set s2 [socket localhost [lindex [fconfigure $server -sockname] 2]]
vwait s1; close $server
fconfigure $s1 -buffering line
fconfigure $s2 -buffering line
set t1 [clock milliseconds]
puts $s2 test1; gets $s1
puts $s2 test2; gets $s1
close $s1; close $s2
set t2 [clock milliseconds]
set lat1 [expr {($t2-$t1)*2}]; # doubled as a safety margin

# Test the latency of failed connection attempts over the loopback
# interface. They can take more than a second under Windowos and requres
# additional [after]s in some tests that are not needed on systems that fail
# immediately.
set t1 [clock milliseconds]
catch {socket 127.0.0.1 [randport]}
set t2 [clock milliseconds]
set lat2 [expr {($t2-$t1)*3}]

# Use the maximum of the two latency calculations, but at least 200ms
set latency [expr {$lat1 > $lat2 ? $lat1 : $lat2}]
set latency [expr {$latency > 200 ? $latency : 200}]
unset t1 t2 s1 s2 lat1 lat2 server

# If remoteServerIP or remoteServerPort are not set, check in the environment
# variables for externally set values.
# If remoteServerIP or remoteServerPort are not set, check in the
# environment variables for externally set values.
#

if {![info exists remoteServerIP]} {
    if {[info exists env(remoteServerIP)]} {
	set remoteServerIP $env(remoteServerIP)
    }
}
if {![info exists remoteServerPort]} {
    if {[info exists env(remoteServerPort)]} {
    if {[info exists env(remoteServerIP)]} {
	set remoteServerPort $env(remoteServerPort)
    } else {
        if {[info exists remoteServerIP]} {
	    set remoteServerPort 2048
        }
    }
}

if 0 {
    # activate this to time the tests
    proc test {args} {
        set name [lindex $args 0]
        puts "[lindex [time {uplevel [linsert $args 0 tcltest::test]}] 0] @@@ $name"
    }
}

foreach {af localhost} {
    inet 127.0.0.1
    inet6 ::1
} {
    # Check if the family is supported and set the constraint accordingly
    testConstraint supported_$af [expr {![catch {socket -server foo -myaddr $localhost 0} sock]}]
    catch {close $sock}
}

set sock [socket -server foo -myaddr localhost 0]
set sockname [fconfigure $sock -sockname]
close $sock
testConstraint localhost_v4 [expr {"127.0.0.1" in $sockname}]
testConstraint localhost_v6 [expr {"::1" in $sockname}]


foreach {af localhost} {
    any 127.0.0.1
    inet 127.0.0.1
    inet6 ::1
} {
    if {![testConstraint supported_$af]} {
        continue
    }
    set ::tcl::unsupported::socketAF $af
#
# Check if we're supposed to do tests against the remote server
#

set doTestsWithRemoteServer 1
if {![info exists remoteServerIP]} {
    set remoteServerIP $localhost
    set remoteServerIP 127.0.0.1
}
if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
    set remoteServerPort [randport]
    set remoteServerPort 2048
}

# Attempt to connect to a remote server if one is already running. If it is
# not running or for some other reason the connect fails, attempt to start the
# remote server on the local host listening on port 2048. This is only done on
# platforms that support exec (i.e. not on the Mac). On platforms that do not
# support exec, the remote server must be started by the user before running
# the tests.
# Attempt to connect to a remote server if one is already running. If it
# is not running or for some other reason the connect fails, attempt to
# start the remote server on the local host listening on port 2048. This
# is only done on platforms that support exec (i.e. not on the Mac). On
# platforms that do not support exec, the remote server must be started
# by the user before running the tests.

set remoteProcChan ""
set commandSocket ""
if {$doTestsWithRemoteServer} {
    catch {close $commandSocket}
    if {![catch {
	set commandSocket [socket $remoteServerIP $remoteServerPort]
    }]} then {
	fconfigure $commandSocket -translation crlf -buffering line
    } elseif {![testConstraint exec]} {
	set noRemoteTestReason "can't exec"
	set doTestsWithRemoteServer 0
    } else {
	set remoteServerIP $localhost
	set remoteServerIP 127.0.0.1
	# Be *extra* careful in case this file is sourced from
	# a directory other than the current one...
	set remoteFile [file join [pwd] [file dirname [info script]] \
		remote.tcl]
	if {![catch {
	    set remoteProcChan [open "|[list \
		    [interpreter] $remoteFile -serverIsSilent \
		    -port $remoteServerPort -address $remoteServerIP]" w+]
	} msg]} then {
	    gets $remoteProcChan
	    after 1000
	    if {[catch {
		set commandSocket [socket $remoteServerIP $remoteServerPort]
	    } msg] == 0} then {
		fconfigure $commandSocket -translation crlf -buffering line
	    } else {
		set noRemoteTestReason $msg
		set doTestsWithRemoteServer 0
	    }
	} else {
	    set noRemoteTestReason "$msg [interpreter]"
	    set doTestsWithRemoteServer 0
	}
    }
}

# Some tests are run only if we are doing testing against a remote server.
testConstraint doTestsWithRemoteServer $doTestsWithRemoteServer
if {!$doTestsWithRemoteServer} {
    if {[string first s $::tcltest::verbose] >= 0} {
    if {[string first s $::tcltest::verbose] != -1} {
    	puts "Skipping tests with remote server. See tests/socket.test for"
	puts "information on how to run remote server."
	puts "Reason for not doing remote tests: $noRemoteTestReason"
    }
}

#
# If we do the tests, define a command to send a command to the remote server.
# If we do the tests, define a command to send a command to the
# remote server.
#

if {[testConstraint doTestsWithRemoteServer]} {
    proc sendCommand {c} {
	global commandSocket

	if {[eof $commandSocket]} {
	    error "remote server disappeared"
	}
	if {[catch {puts $commandSocket $c} msg]} {
	    error "remote server disappaered: $msg"
	}
	if {[catch {puts $commandSocket "--Marker--Marker--Marker--"} msg]} {
	    error "remote server disappeared: $msg"
	}

	set resp ""
	while {1} {
	    set line [gets $commandSocket]
	    if {[eof $commandSocket]} {
		error "remote server disappaered"
	    }
	    if {$line eq "--Marker--Marker--Marker--"} {
		lassign $result code info value
                return -code $code -errorinfo $info $value
	    }
            append result $line "\n"
	}
    }
}

	    if {[string compare $line "--Marker--Marker--Marker--"] == 0} {
		if {[string compare [lindex $resp 0] error] == 0} {
		    error [lindex $resp 1]
		} else {
		    return [lindex $resp 1]
		}
	    } else {
		append resp $line "\n"
	    }
	}
    }
}
proc getPort sock {
    lindex [fconfigure $sock -sockname] 2
}


# Some tests in this file are known to hang *occasionally* on OSX; stop the
# worst offenders.
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]

testConstraint notOSX [string compare $::tcl_platform(os) Darwin]

# ----------------------------------------------------------------------

test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server
} -returnCodes error -result {no argument given for -server option}
test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server foo
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myaddr
} -returnCodes error -result {no argument given for -myaddr option}
test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myaddr $localhost
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myport
} -returnCodes error -result {no argument given for -myport option}
test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myport xxxx
} -returnCodes error -result {expected integer but got "xxxx"}
test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -myport 2522
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -froboz
} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, -reuseaddr, -reuseport, or -server}
test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server foo -myport 2521 3333
} -returnCodes error -result {option -myport is not valid for servers}
test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket host 2528 -junk
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server callback 2520 --
} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket foo badport
} -returnCodes error -result {expected integer but got "badport"}
test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -async -server
} -returnCodes error -result {cannot set -async option for server sockets}
test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -server foo -async
} -returnCodes error -result {cannot set -async option for server sockets}
test socket-1.1 {arg parsing for socket command} {socket} {
    list [catch {socket -server} msg] $msg
} {1 {no argument given for -server option}}
test socket-1.2 {arg parsing for socket command} {socket} {
    list [catch {socket -server foo} msg] $msg
} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.3 {arg parsing for socket command} {socket} {
    list [catch {socket -myaddr} msg] $msg
} {1 {no argument given for -myaddr option}}
test socket-1.4 {arg parsing for socket command} {socket} {
    list [catch {socket -myaddr 127.0.0.1} msg] $msg
} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.5 {arg parsing for socket command} {socket} {
    list [catch {socket -myport} msg] $msg
} {1 {no argument given for -myport option}}
test socket-1.6 {arg parsing for socket command} {socket} {
    list [catch {socket -myport xxxx} msg] $msg
} {1 {expected integer but got "xxxx"}}
test socket-1.7 {arg parsing for socket command} {socket} {
    list [catch {socket -myport 2522} msg] $msg
} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.8 {arg parsing for socket command} {socket} {
    list [catch {socket -froboz} msg] $msg
} {1 {bad option "-froboz": must be -async, -myaddr, -myport, or -server}}
test socket-1.9 {arg parsing for socket command} {socket} {
    list [catch {socket -server foo -myport 2521 3333} msg] $msg
} {1 {option -myport is not valid for servers}}
test socket-1.10 {arg parsing for socket command} {socket} {
    list [catch {socket host 2528 -junk} msg] $msg
} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.11 {arg parsing for socket command} {socket} {
    list [catch {socket -server callback 2520 --} msg] $msg
} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
test socket-1.12 {arg parsing for socket command} {socket} {
    list [catch {socket foo badport} msg] $msg
} {1 {expected integer but got "badport"}}
test socket-1.13 {arg parsing for socket command} {socket} {
list [catch {socket -async -server} msg] $msg
} {1 {cannot set -async option for server sockets}}
test socket-1.14 {arg parsing for socket command} {socket} {
list [catch {socket -server foo -async} msg] $msg
} {1 {cannot set -async option for server sockets}}
test socket_$af-1.15 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseaddr yes 4242
} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
test socket_$af-1.16 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseaddr no 4242
} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
test socket_$af-1.17 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseaddr
} -returnCodes error -result {no argument given for -reuseaddr option}
test socket_$af-1.18 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseport yes 4242
} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
test socket_$af-1.19 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseport no 4242
} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
test socket_$af-1.20 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
    socket -reuseport
} -returnCodes error -result {no argument given for -reuseport option}

set path(script) [makeFile {} script]

test socket_$af-2.1 {tcp connection} -constraints [list socket supported_$af stdio] -setup {
test socket-2.1 {tcp connection} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set timer [after 10000 "set x timed_out"]
	set f [socket -server accept 0]
	proc accept {file addr port} {
	    global x
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
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







-
-
-
-
-
+
+
+
+
+
+

-

+
-
-
-
+
+
+
+
+
+
+
+







	close $f
	puts $x
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f x
    gets $f listen
} -body {
    # $x == "ready" at this point
    set sock [socket $localhost $listen]
    lappend x [gets $f]
    close $sock
    if {[catch {socket 127.0.0.1 $listen} msg]} {
        set x $msg
    } else {
        lappend x [gets $f]
        close $msg
    }
    lappend x [gets $f]
} -cleanup {
    close $f
    set x
} -result {ready done {}}
test socket_$af-2.2 {tcp connection with client port specified} -setup {
    set port [randport]
} {ready done {}}

if [info exists port] {
    incr port
} else {
    set port [expr 2048 + [pid]%1024]
}
test socket-2.2 {tcp connection with client port specified} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set timer [after 10000 "set x timeout"]
        set f [socket -server accept 0]
	proc accept {file addr port} {
            global x
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
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
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







-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
+

+
-
-
+
+




-
+






-







-

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+

+
-
-
+
+


-


-
+
















-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+

+
-
-
+
+







	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f x
    gets $f listen
} -constraints [list socket supported_$af stdio] -body {
    # $x == "ready" at this point
    set sock [socket -myport $port $localhost $listen]
    puts $sock hello
    flush $sock
    lappend x [expr {[gets $f] eq "hello $port"}]
    close $sock
    global port
    if {[catch {socket -myport $port 127.0.0.1 $listen} sock]} {
        set x $sock
	close [socket 127.0.0.1 $listen]
	puts stderr $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    return $x
} -cleanup {
    catch {close [socket $localhost $listen]}
    }
    close $f
    set x
} -result {ready 1}
test socket_$af-2.3 {tcp connection with client interface specified} -setup {
} [list ready "hello $port"]
test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set timer [after 2000 "set x done"]
        set f [socket  -server accept 0]
        set f [socket  -server accept 2830]
	proc accept {file addr port} {
            global x
            puts "[gets $file] $addr"
            close $file
            set x done
	}
	puts [lindex [fconfigure $f -sockname] 2]
	puts ready
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f listen
    gets $f x
} -constraints [list socket supported_$af stdio] -body {
    # $x == "ready" at this point
    set sock [socket -myaddr $localhost $localhost $listen]
    puts $sock hello
    flush $sock
    lappend x [gets $f]
    close $sock
    if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    return $x
} -cleanup {
    }
    close $f
    set x
} -result [list ready [list hello $localhost]]
test socket_$af-2.4 {tcp connection with server interface specified} -setup {
} {ready {hello 127.0.0.1}}
test socket-2.4 {tcp connection with server interface specified} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f [list set localhost $localhost]
    puts $f {
	set timer [after 2000 "set x done"]
        set f [socket -server accept -myaddr $localhost 0]
        set f [socket -server accept -myaddr 127.0.0.1 0]
	proc accept {file addr port} {
            global x
            puts "[gets $file]"
            close $file
            set x done
	}
	puts ready
	puts [lindex [fconfigure $f -sockname] 2]
	vwait x
	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f x
    gets $f listen
} -constraints [list socket supported_$af stdio] -body {
    # $x == "ready" at this point
    set sock [socket $localhost $listen]
    puts $sock hello
    flush $sock
    lappend x [gets $f]
    close $sock
    if {[catch {socket 127.0.0.1 $listen} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    return $x
} -cleanup {
    }
    close $f
    set x
} -result {ready hello}
test socket_$af-2.5 {tcp connection with redundant server port} -setup {
} {ready hello}
test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set timer [after 10000 "set x timeout"]
        set f [socket -server accept 0]
	proc accept {file addr port} {
            global x
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
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







-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+

+
-
-
+
+

-
+






-
-
+
+







	after cancel $timer
	close $f
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f x
    gets $f listen
} -constraints [list socket supported_$af stdio] -body {
    # $x == "ready" at this point
    set sock [socket $localhost $listen]
    puts $sock hello
    flush $sock
    lappend x [gets $f]
    close $sock
    if {[catch {socket 127.0.0.1 $listen} sock]} {
        set x $sock
    } else {
        puts $sock hello
	flush $sock
        lappend x [gets $f]
        close $sock
    return $x
} -cleanup {
    }
    close $f
    set x
} -result {ready hello}
test socket_$af-2.6 {tcp connection} -constraints [list socket supported_$af] -body {
} {ready hello}
test socket-2.6 {tcp connection} {socket} {
    set status ok
    if {![catch {set sock [socket $localhost [randport]]}]} {
    if {![catch {set sock [socket 127.0.0.1 2833]}]} {
	if {![catch {gets $sock}]} {
	    set status broken
	}
	close $sock
    }
    set status
} -result ok
test socket_$af-2.7 {echo server, one line} -constraints [list socket supported_$af stdio] -setup {
} ok
test socket-2.7 {echo server, one line} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set timer [after 10000 "set x timeout"]
	set f [socket -server accept 0]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
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
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







-
-
+


+


-
+
-

+
-
+

-
+







	close $f
	puts $x
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f
    gets $f listen
} -body {
    set s [socket $localhost $listen]
    set s [socket 127.0.0.1 $listen]
    fconfigure $s -buffering line -translation lf
    puts $s "hello abcdefghijklmnop"
    after 1000
    set x [gets $s]
    close $s
    list $x [gets $f]
    set y [gets $f]
} -cleanup {
    close $f
    list $x $y
} -result {{hello abcdefghijklmnop} done}
} {{hello abcdefghijklmnop} done}
removeFile script
test socket_$af-2.8 {echo server, loop 50 times, single connection} -setup {
test socket-2.8 {echo server, loop 50 times, single connection} -constraints {socket stdio} -setup {
    set path(script) [makeFile {
	set f [socket -server accept 0]
	proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
	proc echo {s} {
603
604
605
606
607
608
609

610
611
612
613
614

615
616
617
618
619
620
621
622
623

624

625
626
627
628
629
630

631
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
686
687
688
689

690
691
692
693
694
695
696
697

698
699


700
701
702
703
704
705
706
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







+



-
-
+









+
-
+

-



-
+



-
-
+




-
-
+
+
+

+
-
-
+
+


-













-
+



-
-

+
-
-
+
+




+


-
-
+



-
+
-






-
+
-


-




+
-
-
+
+







	puts [lindex [fconfigure $f -sockname] 2]
	set timer [after 20000 "set x done"]
	vwait x
	after cancel $timer
	close $f
	puts "done $i"
    } script]
} -body {
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f
    gets $f listen
} -constraints [list socket supported_$af stdio] -body {
    set s [socket $localhost $listen]
    set s [socket 127.0.0.1 $listen]
    fconfigure $s -buffering line
    catch {
	for {set x 0} {$x < 50} {incr x} {
	    puts $s "hello abcdefghijklmnop"
	    gets $s
	}
    }
    close $s
    catch {set x [gets $f]}
    close $f
    return $x
    set x
} -cleanup {
    close $f
    removeFile script
} -result {done 50}
set path(script) [makeFile {} script]
test socket_$af-2.9 {socket conflict} -constraints [list socket supported_$af stdio] -body {
test socket-2.9 {socket conflict} {socket stdio} {
    set s [socket -server accept 0]
    file delete $path(script)
    set f [open $path(script) w]
    puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
    puts $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
    puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f
    after 100
    close $f
} -returnCodes error -cleanup {
    set x [list [catch {close $f} msg]]
    regsub "\n.*$" $msg {} msg ; # cut part of the error message containing the port number
    lappend x $msg
    close $s
    set x
} -match glob -result {couldn't open socket: address already in use*}
test socket_$af-2.10 {close on accept, accepted socket lives} -setup {
} {1 {couldn't open socket: address already in use}}
test socket-2.10 {close on accept, accepted socket lives} {socket} {
    set done 0
    set timer [after 20000 "set done timed_out"]
} -constraints [list socket supported_$af] -body {
    set ss [socket -server accept 0]
    proc accept {s a p} {
	global ss
	close $ss
	fileevent $s readable "readit $s"
	fconfigure $s -trans lf
    }
    proc readit {s} {
	global done
	gets $s
	close $s
	set done 1
    }
    set cs [socket $localhost [lindex [fconfigure $ss -sockname] 2]]
    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
    puts $cs hello
    close $cs
    vwait done
    return $done
} -cleanup {
    after cancel $timer
    set done
} -result 1
test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$af] -setup {
} 1
test socket-2.11 {detecting new data} {socket} {
    proc accept {s a p} {
	global sock
	set sock $s
    }

    set s [socket -server accept 0]
    set sock ""
} -body {
    set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]]
    set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
    vwait sock
    puts $s2 one
    flush $s2
    after $latency {set x 1}; # Spurious failures in Travis CI, if we do [after idle]
    after 500
    vwait x
    fconfigure $sock -blocking 0
    set result a:[gets $sock]
    lappend result b:[gets $sock]
    fconfigure $sock -blocking 1
    puts $s2 two
    flush $s2
    after $latency {set x 1}; # NetBSD fails here if we do [after idle]
    after 500
    vwait x
    fconfigure $sock -blocking 0
    lappend result c:[gets $sock]
} -cleanup {
    fconfigure $sock -blocking 1
    close $s2
    close $s
    close $sock
    set result
} -result {a:one b: c:two}
test socket_$af-2.12 {} [list socket stdio supported_$af] {
} {a:one b: c:two}
test socket-2.12 {} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set server [socket -server accept_client 0]
	puts [lindex [chan configure $server -sockname] 2]
	proc accept_client { client host port } {
	    chan configure $client -blocking  0 -buffering line
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
604
605
606
607
608
609
610

611
612
613
614
615
616
617
618
619
620
621
622
623
624

625
626
627
628
629
630
631
632







-
+













-
+







	chan event stdin readable {set forever now}
	vwait forever
	exit
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r+]
    gets $f port
    set sock [socket $localhost $port]
    set sock [socket 127.0.0.1 $port]
    chan event $sock readable [list read_lines $sock $f]
    proc read_lines { sock pipe } {
	gets $pipe
	chan close $sock
	chan event $pipe readable [list readpipe $pipe]
    }
    proc readpipe {pipe} {
	while {![string is integer [set ::done [gets $pipe]]]} {}
    }
    vwait ::done
    close $f
    set ::done
} 0
test socket_$af-2.13 {Bug 1758a0b603} {socket stdio notWine} {
test socket-2.13 {Bug 1758a0b603} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set server [socket -server accept 0]
	puts [lindex [chan configure $server -sockname] 2]
	proc accept { client host port } {
	    chan configure $client -blocking  0 -buffering line -buffersize 1
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
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


686
687
688
689

690
691
692
693
694

695
696
697
698
699
700
701
702







-
+



















-
+


-

-
+









-
-
+
-
+


+
-
-
+
+


-





-
+







	}
	vwait forever
	puts $forever
    }
    close $f
    set pipe [open |[list [interpreter] $path(script)] r]
    gets $pipe port
    set sock [socket $localhost $port]
    set sock [socket localhost $port]
    chan configure $sock -blocking  0 -buffering line
    chan event $sock readable [list read_lines $sock $pipe ]
    proc read_lines { sock pipe } {
	gets $pipe
	gets $sock line
	after idle [list stop $sock $pipe]
	chan event $sock readable {}
    }
    proc stop {sock pipe} {
	variable done
	close $sock
	set done [gets $pipe]
    }
    variable done
    vwait [namespace which -variable done]
    close $pipe
    set done
} write

test socket_$af-3.1 {socket conflict} -constraints [list socket supported_$af stdio] -setup {
test socket-3.1 {socket conflict} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f [list set localhost $localhost]
    puts $f {
	set f [socket -server accept -myaddr $localhost 0]
	set f [socket -server accept -myaddr 127.0.0.1 0]
	puts ready
	puts [lindex [fconfigure $f -sockname] 2]
	gets stdin
	close $f
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r+]
    gets $f
    gets $f listen
} -body {
    socket -server accept -myaddr $localhost $listen
    set x [list [catch {socket -server accept -myaddr 127.0.0.1 $listen} msg] \
} -cleanup {
		$msg]
    puts $f bye
    close $f
    set x
} -returnCodes error -result {couldn't open socket: address already in use}
test socket_$af-3.2 {server with several clients} -setup {
} {1 {couldn't open socket: address already in use}}
test socket-3.2 {server with several clients} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f [list set localhost $localhost]
    puts $f {
	set t1 [after 30000 "set x timed_out"]
	set t2 [after 31000 "set x timed_out"]
	set t3 [after 32000 "set x timed_out"]
	set counter 0
	set s [socket -server accept -myaddr $localhost 0]
	set s [socket -server accept -myaddr 127.0.0.1 0]
	proc accept {s a p} {
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line
	}
	proc echo {s} {
	     global x
             set l [gets $s]
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



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

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
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
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
1439








1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450






1451
1452
1453
1454
1455
1456
1457
1458
1459
1460

1461
1462




1463
1464
1465
1466
1467
1468
1469
1470
1471


1472
1473

1474
1475
1476

1477
1478
1479

1480
1481
1482

1483


1484

1485
1486
1487
1488
1489
1490
1491
1492



1493
1494
1495
1496
1497


1498
1499

1500

1501
1502
1503
1504
1505
1506
1507






1508
1509
1510

1511
1512
1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539

1540

1541
1542
1543
1544
1545
1546
1547




1548
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
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
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
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
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
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
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
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
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
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

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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472

1473
1474
1475
1476
1477
1478
1479


1480
1481
1482

1483
1484
1485
1486
1487

1488
1489
1490
1491


1492
1493
1494
1495
1496

1497
1498
1499
1500
1501


1502
1503
1504
1505
1506
1507




1508
1509
1510
1511
1512
1513


1514
1515
1516
1517

1518
1519
1520
1521

1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532


1533
1534
1535
1536
1537

1538
1539




1540
1541
1542
1543
1544
1545
1546
1547


1548
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
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
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
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
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












-
-
-
+

-
+

-
+













-

+
-
+

-
+


-


-
+
















-

















-
+















-






+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-

-
+
+
+

+

-

+
-
+
-
-
+
+

+

-

+
-
+
-
-
+
+
+

+

-

+
-
+
-

-
+








-


-
+




-
+






-
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


















-
-
-
+


+
+
-
+


-
-
-
-
+
+


-

-
+














-
-
+


+

-
+

-
-
-
-
-
+
+
+




-
-
+
+
-
-
-
-
+






-
+
+

-
-



-
-
-

+
+
-
+







-
+
+

-
-



-
+
+
+

-
-
-
+
+
+








-
-
-
-
-
+
+
+
+
+






-
+

-
+
-


+
-
+

-
+



-
-


















-
-
+
+


+

+


-
-
-
-
+
+






-
-
+








-
+




-
+






-
-
+













+

+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+










-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


-
+

-
-

-
-
+
+



-
-
+
+
+







-
+

-
+



-
+




-
-
-
+
+
+




-
-
-
-
-
+
+
+
-

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+




-
-
-
-
+
+

-
-

-
-
-
+
+
+
+
+
+
+
+
+

-
+





-
-
-
-
-
+
+
+
+
+












-
-
-
-
+
+


-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+












-
-
-
-
+
+



-
+



-
-

-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
+
+
-
+

+
-
-
-
-
+
+
+
+












-
-
-
-
+
+

-
+

-
+









-
-



-
-
-
-
-
-
-
+
+
+
+
+
+
+
+




-
-
-
-
-
-
-
+
+
+
+
+
+

-








+
-
-
+
+
+
+





-

-
-
+
+
-
-
+
-

-
+

-
-
+



+

+
+
-
+

-
-


-
-
-
+
+
+

-
-
-
-
+
+


+
-
+
-

-
-
-
-
-
+
+
+
+
+
+


-
+







-
-
+



-
-














-
+

+

-
-

-
-
-
+
+
+
+


+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
+





-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
+

+

-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+




+

-
-


+
-
+




-
+


+
-
-
+
+
+


-




+
-
-
+
+
+
+


-
-
-
-
+
+
+



-
-
+
+
+

-
+
+


-
+

+


+
+
+
+
+

-
-
+
+
+

+
-
+

-
-
-
-
+
+
+
+
+


+
-
-
+
+
+


-




+
-
-
-
+
+
+
+


-
-
-
+

-
-
+
+
+
+


-
+
+


-
+
-
-
-
-

+
-
+






-
+




+


-
-
+
+
+


+
+
+
-
+
+
+

-
+
+

+

+
+
+
+
+
+
+


+


+

-
-
+
+
-
-
+
+
-
-
-
-
+
+
+


+


-




+


-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+
+
+

-
+
+



-
-
-
+
+
+
+



+
+
+
+
-
+


+
-
-
+
+
+

+
-
+






-
+
+



+
+
+
-
+
+
+

-
+
+



+

-
+
-
-
-
+
-
-
-
+
+

-
-
+
+
+
-
-
+
+




















+
+
-
-
-
+
+
+
+
+
+
+
+
+
+

+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
-





-
-
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
















-
+
-













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
	close $s
	puts $x
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r+]
    set x [gets $f]
    gets $f listen
} -constraints [list socket supported_$af stdio] -body {
    # $x == "ready" here
    set s1 [socket $localhost $listen]
    set s1 [socket 127.0.0.1 $listen]
    fconfigure $s1 -buffering line
    set s2 [socket $localhost $listen]
    set s2 [socket 127.0.0.1 $listen]
    fconfigure $s2 -buffering line
    set s3 [socket $localhost $listen]
    set s3 [socket 127.0.0.1 $listen]
    fconfigure $s3 -buffering line
    for {set i 0} {$i < 100} {incr i} {
	puts $s1 hello,s1
	gets $s1
	puts $s2 hello,s2
	gets $s2
	puts $s3 hello,s3
	gets $s3
    }
    close $s1
    close $s2
    close $s3
    lappend x [gets $f]
} -cleanup {
    close $f
    set x
} -result {ready done}
} {ready done}

test socket_$af-4.1 {server with several clients} -setup {
test socket-4.1 {server with several clients} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f [list set localhost $localhost]
    puts $f {
	set port [gets stdin]
	set s [socket $localhost $port]
	set s [socket 127.0.0.1 $port]
	fconfigure $s -buffering line
	for {set i 0} {$i < 100} {incr i} {
	    puts $s hello
	    gets $s
	}
	close $s
	puts bye
	gets stdin
    }
    close $f
    set p1 [open "|[list [interpreter] $path(script)]" r+]
    fconfigure $p1 -buffering line
    set p2 [open "|[list [interpreter] $path(script)]" r+]
    fconfigure $p2 -buffering line
    set p3 [open "|[list [interpreter] $path(script)]" r+]
    fconfigure $p3 -buffering line
} -constraints [list socket supported_$af stdio] -body {
    proc accept {s a p} {
	fconfigure $s -buffering line
	fileevent $s readable [list echo $s]
    }
    proc echo {s} {
	global x
        set l [gets $s]
        if {[eof $s]} {
            close $s
            set x done
        } else {
            puts $s $l
        }
    }
    set t1 [after 30000 "set x timed_out"]
    set t2 [after 31000 "set x timed_out"]
    set t3 [after 32000 "set x timed_out"]
    set s [socket -server accept -myaddr $localhost 0]
    set s [socket -server accept -myaddr 127.0.0.1 0]
    set listen [lindex [fconfigure $s -sockname] 2]
    puts $p1 $listen
    puts $p2 $listen
    puts $p3 $listen
    vwait x
    vwait x
    vwait x
    after cancel $t1
    after cancel $t2
    after cancel $t3
    close $s
    set l ""
    lappend l [list p1 [gets $p1] $x]
    lappend l [list p2 [gets $p2] $x]
    lappend l [list p3 [gets $p3] $x]
} -cleanup {
    puts $p1 bye
    puts $p2 bye
    puts $p3 bye
    close $p1
    close $p2
    close $p3
    set l
} -result {{p1 bye done} {p2 bye done} {p3 bye done}}
test socket_$af-4.2 {byte order problems, socket numbers, htons} -body {
    close [socket -server dodo -myaddr $localhost 0x3000]
    return ok
} {{p1 bye done} {p2 bye done} {p3 bye done}}
test socket-4.2 {byte order problems, socket numbers, htons} {socket} {
    set x ok
    if {[catch {socket -server dodo -myaddr 127.0.0.1 0x3000} msg]} {
	set x $msg
    } else {
	close $msg
    }
    set x
} ok
} -constraints [list socket supported_$af] -result ok

test socket_$af-5.1 {byte order problems, socket numbers, htons} -body {
test socket-5.1 {byte order problems, socket numbers, htons} \
	{socket unix notRoot notOSX} {
    set x {couldn't open socket: not owner}
    if {![catch {socket -server dodo 0x1} msg]} {
        set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
        return {htons problem, should be disallowed, are you running as SU?}
    }
    set x
    return {couldn't open socket: not owner}
} {couldn't open socket: not owner}
} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}
test socket_$af-5.2 {byte order problems, socket numbers, htons} -body {
test socket-5.2 {byte order problems, socket numbers, htons} {socket} {
    set x {couldn't open socket: port number too high}
    if {![catch {socket -server dodo 0x10000} msg]} {
	set x {port resolution problem, should be disallowed}
	close $msg
	return {port resolution problem, should be disallowed}
    }
    set x
    return {couldn't open socket: port number too high}
} {couldn't open socket: port number too high}
} -constraints [list socket supported_$af] -result {couldn't open socket: port number too high}
test socket_$af-5.3 {byte order problems, socket numbers, htons} -body {
test socket-5.3 {byte order problems, socket numbers, htons} \
	{socket unix notRoot notOSX} {
    set x {couldn't open socket: not owner}
    if {![catch {socket -server dodo 21} msg]} {
	set x {htons problem, should be disallowed, are you running as SU?}
	close $msg
	return {htons problem, should be disallowed, are you running as SU?}
    }
    set x
    return {couldn't open socket: not owner}
} {couldn't open socket: not owner}
} -constraints [list socket supported_$af unix notRoot notOSX] -result {couldn't open socket: not owner}

test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup {
test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
    file delete $path(script)
} -body {
    set f [open $path(script) w]
    puts $f [list set localhost $localhost]
    puts $f {
	gets stdin port
	socket $localhost $port
	socket 127.0.0.1 $port
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r+]
    proc accept {s a p} {expr 10 / 0}
    set s [socket -server accept -myaddr $localhost 0]
    set s [socket -server accept -myaddr 127.0.0.1 0]
    puts $f [lindex [fconfigure $s -sockname] 2]
    close $f
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    return $x
    set x
} -cleanup {
    interp bgerror {} $handler
} -result {divide by zero}

test socket_$af-6.2 {
    readable fileevent on server socket
} -setup {
    set sock [socket -server dummy 0]
} -constraints [list socket supported_$af] -body {
    fileevent $sock readable dummy
} -cleanup {
    close $sock
} -returnCodes 1 -result "channel is not readable"

test socket_$af-6.3 {writable fileevent on server socket} -setup {
    set sock [socket -server dummy 0]
} -constraints [list socket supported_$af] -body {
    fileevent $sock writable dummy
} -cleanup {
    close $sock
} -returnCodes 1 -result "channel is not writable"

test socket_$af-7.1 {testing socket specific options} -setup {
test socket-7.1 {testing socket specific options} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f {
	set ss [socket -server accept 0]
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	puts [lindex [fconfigure $ss -sockname] 2]
	set timer [after 10000 "set x timed_out"]
	vwait x
	after cancel $timer
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f
    gets $f listen
    set l ""
} -constraints [list socket supported_$af stdio] -body {
    set s [socket $localhost $listen]
    set s [socket 127.0.0.1 $listen]
    set p [fconfigure $s -peername]
    close $s
    close $f
    set l ""
    lappend l [string compare [lindex $p 0] $localhost]
    lappend l [string compare [lindex $p 0] 127.0.0.1]
    lappend l [string compare [lindex $p 2] $listen]
    lappend l [llength $p]
} -cleanup {
    close $f
} -result {0 0 3}
test socket_$af-7.2 {testing socket specific options} -setup {
} {0 0 3}
test socket-7.2 {testing socket specific options} {socket stdio} {
    file delete $path(script)
    set f [open $path(script) w]
    puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
    puts $f {
	set ss [socket -server accept 0]
	set ss [socket -server accept 2821]
	proc accept args {
	    global x
	    set x done
	}
	puts ready
	puts [lindex [fconfigure $ss -sockname] 2]
	set timer [after 10000 "set x timed_out"]
	vwait x
	after cancel $timer
    }
    close $f
    set f [open "|[list [interpreter] $path(script)]" r]
    gets $f
    gets $f listen
} -constraints [list socket supported_$af stdio] -body {
    set s [socket $localhost $listen]
    set s [socket 127.0.0.1 $listen]
    set p [fconfigure $s -sockname]
    close $s
    close $f
    list [llength $p] \
	    [regexp {^(127\.0\.0\.1|0\.0\.0\.0|::1)$} [lindex $p 0]] \
	    [regexp {^(127\.0\.0\.1|0\.0\.0\.0)$} [lindex $p 0]] \
	    [expr {[lindex $p 2] == $listen}]
} -cleanup {
    close $f
} -result {3 1 0}
test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
    set s [socket -server accept -myaddr $localhost 0]
} {3 1 0}
test socket-7.3 {testing socket specific options} {socket} {
    set s [socket -server accept -myaddr 127.0.0.1 0]
    set l [fconfigure $s]
    close $s
    update
    llength $l
} -result 14
test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
} 14
test socket-7.4 {testing socket specific options} {socket} {
    set timer [after 10000 "set x timed_out"]
    set l ""
} -body {
    set s [socket -server accept -myaddr $localhost 0]
    set s [socket -server accept -myaddr 127.0.0.1 0]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set listen [lindex [fconfigure $s -sockname] 2]
    set s1 [socket $localhost $listen]
    set s1 [socket 127.0.0.1 $listen]
    set timer [after 10000 "set x timed_out"]
    vwait x
    lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
} -cleanup {
    after cancel $timer
    close $s
    close $s1
} -result {1 3}
test socket_$af-7.5 {testing socket specific options} -setup {
    set timer [after 10000 "set x timed_out"]
    set l ""
    lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
} {1 3}
} -constraints [list socket supported_$af unixOrWin] -body {
test socket-7.5 {testing socket specific options} {socket unixOrWin} {
    set s [socket -server accept 0]
    proc accept {s a p} {
	global x
	set x [fconfigure $s -sockname]
	close $s
    }
    set listen [lindex [fconfigure $s -sockname] 2]
    set s1 [socket $localhost $listen]
    set s1 [socket 127.0.0.1 $listen]
    set timer [after 10000 "set x timed_out"]
    vwait x
    lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
} -cleanup {
    after cancel $timer
    close $s
    close $s1
} -result [list $localhost 1 3]
    set l ""
    lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
} {127.0.0.1 1 3}

test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body {
    # NOTE: This test may fail on some Solaris 2.4 systems. If it does, check
    # that you have these patches installed (using showrev -p):
test socket-8.1 {testing -async flag on sockets} {socket} {
    # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
    # check that you have these patches installed (using showrev -p):
    #
    # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
    # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
    # 102011-02, 102024-01, 102039-01, 102044-01, 102048-01, 102062-03,
    # 102066-04, 102070-01, 102105-01, 102153-03, 102216-01, 102232-01,
    # 101878-03, 101879-01, 101880-03, 101933-01, 101950-01, 102030-01,
    # 102057-08, 102140-01, 101920-02, 101921-09, 101922-07, 101923-03
    #
    # If after installing these patches you are still experiencing a problem,
    # please email jyl@eng.sun.com. We have not observed this failure on
    # Solaris 2.5, so another option (instead of installing these patches) is
    # to upgrade to Solaris 2.5.
    set s [socket -server accept -myaddr $localhost 0]
    # If after installing these patches you are still experiencing a
    # problem, please email jyl@eng.sun.com. We have not observed this
    # failure on Solaris 2.5, so another option (instead of installing
    # these patches) is to upgrade to Solaris 2.5.
    set s [socket -server accept -myaddr 127.0.0.1 0]
    proc accept {s a p} {
	global x
	puts $s bye
	close $s
	set x done
    }
    set s1 [socket -async $localhost [lindex [fconfigure $s -sockname] 2]]
    set s1 [socket -async 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
    vwait x
    gets $s1
    set z [gets $s1]
} -cleanup {
    close $s
    close $s1
    set z
} -result bye
} bye

test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
test socket-9.1 {testing spurious events} {socket} {
    set len 0
    set spurious 0
    set done 0
    set timer [after 10000 "set done timed_out"]
} -body {
    proc readlittle {s} {
	global spurious done len
	set l [read $s 1]
	if {[string length $l] == 0} {
	    if {![eof $s]} {
		incr spurious
	    } else {
		close $s
		set done 1
	    }
	} else {
	    incr len [string length $l]
	}
    }
    proc accept {s a p} {
	fconfigure $s -buffering none -blocking off
	fileevent $s readable [list readlittle $s]
    }
    set s [socket -server accept -myaddr $localhost 0]
    set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
    set s [socket -server accept -myaddr 127.0.0.1 0]
    set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
    puts -nonewline $c 01234567890123456789012345678901234567890123456789
    close $c
    set timer [after 10000 "set done timed_out"]
    vwait done
    after cancel $timer
    close $s
    list $spurious $len
} -cleanup {
    after cancel $timer
} -result {0 50}
test socket_$af-9.2 {testing async write, fileevents, flush on close} -constraints [list socket supported_$af] -setup {
} {0 50}
test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
    set firstblock ""
    for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
    set secondblock ""
    for {set i 0} {$i < 16} {incr i} {
	set secondblock "b$secondblock$secondblock"
    }
    set timer [after 10000 "set done timed_out"]
    set l [socket -server accept -myaddr $localhost 0]
    set l [socket -server accept -myaddr 127.0.0.1 0]
    proc accept {s a p} {
	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
		-buffering line
	fileevent $s readable "readable $s"
    }
    proc readable {s} {
	set l [gets $s]
	fileevent $s readable {}
	after idle respond $s
	after 1000 respond $s
    }
    proc respond {s} {
	global firstblock
	puts -nonewline $s $firstblock
	after idle writedata $s
	after 1000 writedata $s
    }
    proc writedata {s} {
	global secondblock
	puts -nonewline $s $secondblock
	close $s
    }
} -body {
    set s [socket $localhost [lindex [fconfigure $l -sockname] 2]]
    set s [socket 127.0.0.1 [lindex [fconfigure $l -sockname] 2]]
    fconfigure $s -blocking 0 -trans lf -buffering line
    set count 0
    puts $s hello
    proc readit {s} {
	global count done
	set l [read $s]
	incr count [string length $l]
	if {[eof $s]} {
	    close $s
	    set done 1
	}
    }
    fileevent $s readable "readit $s"
    set timer [after 10000 "set done timed_out"]
    vwait done
    after cancel $timer
    close $l
    return $count
} -cleanup {
    close $l
    after cancel $timer
} -result 65566
    set count
} 65566
test socket-9.3 {testing EOF stickyness} {socket} {
    proc count_to_eof {s} {
	global count done timer
	set l [gets $s]
	if {[eof $s]} {
	    incr count
	    if {$count > 9} {
		close $s
		set done true
		set count {eof is sticky}
		after cancel $timer
	    }
	}
    }
    proc timerproc {} {
	global done count c
	set done true
test socket_$af-9.3 {testing EOF stickyness} -constraints [list socket supported_$af] -setup {
	set count {timer went off, eof is not sticky}
	close $c
    }
    set count 0
    set done false
    proc write_then_close {s} {
	puts $s bye
	close $s
    }
    proc accept {s a p} {
	fconfigure $s -buffering line -translation lf
	fileevent $s writable "write_then_close $s"
    }
    set s [socket -server accept -myaddr $localhost 0]
    set s [socket -server accept -myaddr 127.0.0.1 0]
} -body {
    proc count_to_eof {s} {
	global count done
	set l [gets $s]
	if {[eof $s]} {
	    incr count
	    if {$count > 9} {
		close $s
		set done true
		set count {eof is sticky}
	    }
	}
    }
    proc timerproc {s} {
	global done count
	set done true
	set count {timer went off, eof is not sticky}
	close $s
    }
    set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
    set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
    fconfigure $c -blocking off -buffering line -translation lf
    fileevent $c readable "count_to_eof $c"
    set timer [after 1000 timerproc $c]
    set timer [after 1000 timerproc]
    vwait done
    return $count
} -cleanup {
    close $s
    after cancel $timer
} -result {eof is sticky}
    set count
} {eof is sticky}

removeFile script

test socket_$af-10.1 {testing socket accept callback error handling} \
    -constraints [list socket supported_$af] -setup {
test socket-10.1 {testing socket accept callback error handling} -constraints {
    socket
} -setup {
    variable goterror 0
    proc myHandler {msg options} {
	variable goterror 1
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
} -body {
    set s [socket -server accept -myaddr $localhost 0]
    set s [socket -server accept -myaddr 127.0.0.1 0]
    proc accept {s a p} {close $s; error}
    set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
    set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
    vwait goterror
    close $s
    close $c
    return $goterror
    set goterror
} -cleanup {
    interp bgerror {} $handler
} -result 1

test socket_$af-11.1 {tcp connection} -setup {
    set port [sendCommand {
	set server [socket -server accept 0]
test socket-11.1 {tcp connection} {socket doTestsWithRemoteServer} {
    sendCommand {
	set socket9_1_test_server [socket -server accept 2834]
	proc accept {s a p} {
	    puts $s done
	    close $s
	}
	getPort $server
    }]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set s [socket $remoteServerIP $port]
    gets $s
    }
    set s [socket $remoteServerIP 2834]
    set r [gets $s]
} -cleanup {
    close $s
    sendCommand {close $server}
} -result done
test socket_$af-11.2 {client specifies its port} -setup {
    set lport [randport]
    set rport [sendCommand {
	set server [socket -server accept 0]
    sendCommand {close $socket9_1_test_server}
    set r
} done
test socket-11.2 {client specifies its port} {socket doTestsWithRemoteServer} {
    if {[info exists port]} {
	incr port
    } else {
	set port [expr 2048 + [pid]%1024]
    }
    sendCommand {
	set socket9_2_test_server [socket -server accept 2835]
	proc accept {s a p} {
	    puts $s $p
	    close $s
	}
	getPort $server
    }]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set s [socket -myport $lport $remoteServerIP $rport]
    }
    set s [socket -myport $port $remoteServerIP 2835]
    set r [gets $s]
    expr {$r==$lport ? "ok" : "broken: $r != $port"}
} -cleanup {
    close $s
    sendCommand {close $server}
} -result ok
test socket_$af-11.3 {trying to connect, no server} -body {
    sendCommand {close $socket9_2_test_server}
    if {$r == $port} {
	set result ok
    } else {
	set result broken
    }
    set result
} ok
test socket-11.3 {trying to connect, no server} {socket doTestsWithRemoteServer} {
    set status ok
    if {![catch {set s [socket $remoteServerIp [randport]]}]} {
    if {![catch {set s [socket $remoteServerIp 2836]}]} {
	if {![catch {gets $s}]} {
	    set status broken
	}
	close $s
    }
    return $status
} -constraints [list socket supported_$af doTestsWithRemoteServer] -result ok
test socket_$af-11.4 {remote echo, one line} -setup {
    set port [sendCommand {
	set server [socket -server accept 0]
    set status
} ok
test socket-11.4 {remote echo, one line} {socket doTestsWithRemoteServer} {
    sendCommand {
	set socket10_6_test_server [socket -server accept 2836]
	proc accept {s a p} {
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line -translation crlf
	}
	proc echo {s} {
	    set l [gets $s]
	    if {[eof $s]} {
		close $s
	    } else {
		puts $s $l
	    }
	}
	getPort $server
    }]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set f [socket $remoteServerIP $port]
    }
    set f [socket $remoteServerIP 2836]
    fconfigure $f -translation crlf -buffering line
    puts $f hello
    gets $f
    set r [gets $f]
} -cleanup {
    catch {close $f}
    sendCommand {close $server}
} -result hello
test socket_$af-11.5 {remote echo, 50 lines} -setup {
    set port [sendCommand {
	set server [socket -server accept 0]
    close $f
    sendCommand {close $socket10_6_test_server}
    set r
} hello
test socket-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
    sendCommand {
	set socket10_7_test_server [socket -server accept 2836]
	proc accept {s a p} {
	    fileevent $s readable [list echo $s]
	    fconfigure $s -buffering line -translation crlf
	}
	proc echo {s} {
	    set l [gets $s]
	    if {[eof $s]} {
		close $s
	    } else {
		puts $s $l
	    }
	}
	getPort $server
    }]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set f [socket $remoteServerIP $port]
    }
    set f [socket $remoteServerIP 2836]
    fconfigure $f -translation crlf -buffering line
    for {set cnt 0} {$cnt < 50} {incr cnt} {
	puts $f "hello, $cnt"
	if {[gets $f] != "hello, $cnt"} {
	if {[string compare [gets $f] "hello, $cnt"] != 0} {
	    break
	}
    }
    return $cnt
} -cleanup {
    close $f
    sendCommand {close $server}
} -result 50
test socket_$af-11.6 {socket conflict} -setup {
    set s1 [socket -server accept -myaddr $localhost 0]
    sendCommand {close $socket10_7_test_server}
    set cnt
} 50
test socket-11.6 {socket conflict} {socket doTestsWithRemoteServer} {
    set s1 [socket -server accept -myaddr 127.0.0.1 2836]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set s2 [socket -server accept -myaddr $localhost [getPort $s1]]
    list [getPort $s2] [close $s2]
    if {[catch {set s2 [socket -server accept -myaddr 127.0.0.1 2836]} msg]} {
	set result [list 1 $msg]
    } else {
	set result [list 0 [lindex [fconfigure $s2 -sockname] 2]]
	close $s2
} -cleanup {
    }
    close $s1
    set result
} -returnCodes error -result {couldn't open socket: address already in use}
test socket_$af-11.7 {server with several clients} -setup {
    set port [sendCommand {
	set server [socket -server accept 0]
} {1 {couldn't open socket: address already in use}}
test socket-11.7 {server with several clients} {socket doTestsWithRemoteServer} {
    sendCommand {
	set socket10_9_test_server [socket -server accept 2836]
	proc accept {s a p} {
	    fconfigure $s -buffering line
	    fileevent $s readable [list echo $s]
	}
	proc echo {s} {
	    set l [gets $s]
	    if {[eof $s]} {
		close $s
	    } else {
		puts $s $l
	    }
	}
	getPort $server
    }]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set s1 [socket $remoteServerIP $port]
    }
    set s1 [socket $remoteServerIP 2836]
    fconfigure $s1 -buffering line
    set s2 [socket $remoteServerIP $port]
    set s2 [socket $remoteServerIP 2836]
    fconfigure $s2 -buffering line
    set s3 [socket $remoteServerIP $port]
    set s3 [socket $remoteServerIP 2836]
    fconfigure $s3 -buffering line
    for {set i 0} {$i < 100} {incr i} {
	puts $s1 hello,s1
	gets $s1
	puts $s2 hello,s2
	gets $s2
	puts $s3 hello,s3
	gets $s3
    }
    return $i
} -cleanup {
    close $s1
    close $s2
    close $s3
    sendCommand {close $server}
} -result 100
test socket_$af-11.8 {client with several servers} -setup {
    lassign [sendCommand {
	set s1 [socket -server "accept server1" 0]
	set s2 [socket -server "accept server2" 0]
	set s3 [socket -server "accept server3" 0]
    sendCommand {close $socket10_9_test_server}
    set i
} 100
test socket-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
    sendCommand {
	set s1 [socket -server "accept 4003" 4003]
	set s2 [socket -server "accept 4004" 4004]
	set s3 [socket -server "accept 4005" 4005]
	proc accept {mp s a p} {
	    puts $s $mp
	    close $s
	}
	list [getPort $s1] [getPort $s2] [getPort $s3]
    }] p1 p2 p3
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set s1 [socket $remoteServerIP $p1]
    set s2 [socket $remoteServerIP $p2]
    set s3 [socket $remoteServerIP $p3]
    list [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
    }
    set s1 [socket $remoteServerIP 4003]
    set s2 [socket $remoteServerIP 4004]
    set s3 [socket $remoteServerIP 4005]
    set l ""
    lappend l [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
	[gets $s3] [gets $s3] [eof $s3]
} -cleanup {
    close $s1
    close $s2
    close $s3
    sendCommand {
	close $s1
	close $s2
	close $s3
    }
    set l
} -result {server1 {} 1 server2 {} 1 server3 {} 1}
test socket_$af-11.9 {accept callback error} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup {
} {4003 {} 1 4004 {} 1 4005 {} 1}
test socket-11.9 {accept callback error} -constraints {
    socket doTestsWithRemoteServer
} -setup {
    proc myHandler {msg options} {
	variable x $msg
    }
    set handler [interp bgerror {}]
    interp bgerror {} [namespace which myHandler]
    set timer [after 10000 "set x timed_out"]
} -body {
    set s [socket -server accept 0]
    proc accept {s a p} {expr {10 / 0}}
    set s [socket -server accept 2836]
    proc accept {s a p} {expr 10 / 0}
    sendCommand "set port [getPort $s]"
    if {[catch {
    if {[catch {sendCommand {
	sendCommand {
	    set peername [fconfigure $callerSocket -peername]
	    set s [socket [lindex $peername 0] $port]
	    set s [socket [lindex $peername 0] 2836]
	    close $s
    	 }
    } msg]} then {
    	 }} msg]} {
	close $s
	error $msg
    }
    set timer [after 10000 "set x timed_out"]
    vwait x
    after cancel $timer
    close $s
    return $x
    set x
} -cleanup {
    close $s
    after cancel $timer
    interp bgerror {} $handler
} -result {divide by zero}
test socket_$af-11.10 {testing socket specific options} -setup {
    set port [sendCommand {
	set server [socket -server accept 0]
test socket-11.10 {testing socket specific options} {socket doTestsWithRemoteServer} {
    sendCommand {
	set socket10_12_test_server [socket -server accept 2836]
	proc accept {s a p} {close $s}
	getPort $server
    }]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    set s [socket $remoteServerIP $port]
    }
    set s [socket $remoteServerIP 2836]
    set p [fconfigure $s -peername]
    set n [fconfigure $s -sockname]
    set l ""
    list [expr {[lindex $p 2] == $port}] [llength $p] [llength $n]
    lappend l [lindex $p 2] [llength $p] [llength $p]
} -cleanup {
    close $s
    sendCommand {close $server}
} -result {1 3 3}
test socket_$af-11.11 {testing spurious events} -setup {
    set port [sendCommand {
	set server [socket -server accept 0]
    sendCommand {close $socket10_12_test_server}
    set l
} {2836 3 3}
test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
    sendCommand {
	set socket10_13_test_server [socket -server accept 2836]
	proc accept {s a p} {
	    fconfigure $s -translation "auto lf"
	    after idle writesome $s
	    after 100 writesome $s
	}
	proc writesome {s} {
	    for {set i 0} {$i < 100} {incr i} {
		puts $s "line $i from remote server"
	    }
	    close $s
	}
	getPort $server
    }]
    }
    set len 0
    set spurious 0
    set done 0
    set timer [after 40000 "set done timed_out"]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
    proc readlittle {s} {
	global spurious done len
	set l [read $s 1]
	if {[string length $l] == 0} {
	    if {![eof $s]} {
		incr spurious
	    } else {
		close $s
		set done 1
	    }
	} else {
	    incr len [string length $l]
	}
    }
    set c [socket $remoteServerIP $port]
    set c [socket $remoteServerIP 2836]
    fileevent $c readable "readlittle $c"
    set timer [after 40000 "set done timed_out"]
    vwait done
    list $spurious $len $done
} -cleanup {
    after cancel $timer
    sendCommand {close $server}
} -result {0 2690 1}
test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer notWine] -setup {
    sendCommand {close $socket10_13_test_server}
    list $spurious $len $done
} {0 2690 1}
test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
    set counter 0
    set done 0
    proc count_up {s} {
	global counter done after_id
    set port [sendCommand {
	set server [socket -server accept 0]
	proc accept {s a p} {
	    after idle close $s
	}
	set l [gets $s]
	if {[eof $s]} {
	    incr counter
	    if {$counter > 9} {
		set done {EOF is sticky}
		after cancel $after_id
		close $s
	    }
	getPort $server
    }]
	}
    }
    proc timed_out {} {
	global c done
	set done {timed_out, EOF is not sticky}
	close $c
    }
    set after_id [after 1000 timed_out]
} -body {
    proc count_up {s} {
    sendCommand {
	set socket10_14_test_server [socket -server accept 2836]
	proc accept {s a p} {
	global counter done
	set l [gets $s]
	if {[eof $s]} {
	    incr counter
	    if {$counter > 9} {
		set done {EOF is sticky}
		close $s
	    }
	}
	    after 100 close $s
	}
    }
    }
    set c [socket $remoteServerIP $port]
    set c [socket $remoteServerIP 2836]
    fileevent $c readable [list count_up $c]
    set after_id [after 1000 timed_out]
    vwait done
    return $done
} -cleanup {
    after cancel $after_id
    sendCommand {close $server}
} -result {EOF is sticky}
test socket_$af-11.13 {testing async write, async flush, async close} -setup {
    sendCommand {close $socket10_14_test_server}
    set done
} {EOF is sticky}
test socket-11.13 {testing async write, async flush, async close} \
    set port [sendCommand {
	set firstblock ""
	for {set i 0} {$i < 5} {incr i} {
		set firstblock "a$firstblock$firstblock"
	}
	set secondblock ""
	for {set i 0} {$i < 16} {incr i} {
	    set secondblock "b$secondblock$secondblock"
	}
	set l [socket -server accept 0]
	proc accept {s a p} {
	    fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
		-buffering line
	    fileevent $s readable "readable $s"
	}
	proc readable {s} {
	    set l [gets $s]
	    fileevent $s readable {}
	    after idle respond $s
	}
	proc respond {s} {
	    global firstblock
	    puts -nonewline $s $firstblock
	    after idle writedata $s
	}
	proc writedata {s} {
	    global secondblock
	    puts -nonewline $s $secondblock
	    close $s
	}
	getPort $l
    }]
    set timer [after 10000 "set done timed_out"]
} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
	{socket doTestsWithRemoteServer} {
    proc readit {s} {
	global count done
	set l [read $s]
	incr count [string length $l]
	if {[eof $s]} {
	    close $s
	    set done 1
	}
    }
    sendCommand {
	set firstblock ""
	for {set i 0} {$i < 5} {incr i} {
		set firstblock "a$firstblock$firstblock"
	}
	set secondblock ""
	for {set i 0} {$i < 16} {incr i} {
	    set secondblock "b$secondblock$secondblock"
	}
	set l [socket -server accept 2845]
	proc accept {s a p} {
	    fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
		-buffering line
	    fileevent $s readable "readable $s"
	}
	proc readable {s} {
	    set l [gets $s]
	    fileevent $s readable {}
	    after 1000 respond $s
	}
	proc respond {s} {
	    global firstblock
	    puts -nonewline $s $firstblock
	    after 1000 writedata $s
	}
	proc writedata {s} {
	    global secondblock
	    puts -nonewline $s $secondblock
	    close $s
	}
    }
    set s [socket $remoteServerIP $port]
    set s [socket $remoteServerIP 2845]
    fconfigure $s -blocking 0 -trans lf -buffering line
    set count 0
    puts $s hello
    fileevent $s readable "readit $s"
    set timer [after 10000 "set done timed_out"]
    vwait done
    return $count
} -cleanup {
    after cancel $timer
    sendCommand {close $l}
    set count
} -result 65566
} 65566

set path(script1) [makeFile {} script1]
set path(script2) [makeFile {} script2]

test socket_$af-12.1 {testing inheritance of server sockets} -setup {
test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
    file delete $path(script1)
    file delete $path(script2)

    # Script1 is just a 10 second delay. If the server socket is inherited, it
    # will be held open for 10 seconds
    # Script1 is just a 10 second delay.  If the server socket
    # is inherited, it will be held open for 10 seconds

    set f [open $path(script1) w]
    puts $f {
	fileevent stdin readable exit
	after 10000 exit
	vwait forever
    }
    close $f

    # Script2 creates the server socket, launches script1, and exits.
    # The server socket will now be closed unless script1 inherited it.
    # Script2 creates the server socket, launches script1,
    # waits a second, and exits.  The server socket will now
    # be closed unless script1 inherited it.

    set f [open $path(script2) w]
    puts $f [list set tcltest [interpreter]]
    puts $f [list set delay $path(script1)]
    puts $f [list set localhost $localhost]
    puts $f {
	set f [socket -server accept -myaddr $localhost 0]
    puts -nonewline $f {
	set f [socket -server accept -myaddr 127.0.0.1 0]
	puts [lindex [fconfigure $f -sockname] 2]
	proc accept { file addr port } {
	    close $file
	}
	exec $tcltest $delay &
	puts [lindex [fconfigure $f -sockname] 2]
	exec $tcltest }
    puts $f [list $path(script1) &]
    puts $f {
	close $f
        exit
	after 1000 exit
	vwait forever
    }
    close $f
} -constraints [list socket supported_$af stdio exec] -body {

    # Launch script2 and wait 5 seconds

    ### exec [interpreter] script2 &
    set p [open "|[list [interpreter] $path(script2)]" r]
    gets $p listen

    after 5000 { set ok_to_proceed 1 }
    vwait ok_to_proceed

    # If we can still connect to the server, the socket got inherited.
    if {[catch {close [socket $localhost $listen]}]} {
	return {server socket was not inherited}

    if {[catch {socket 127.0.0.1 $listen} msg]} {
	set x {server socket was not inherited}
    } else {
	close $msg
	return {server socket was inherited}
	set x {server socket was inherited}
    }
} -cleanup {
    catch {close $p}
} -result {server socket was not inherited}
test socket_$af-12.2 {testing inheritance of client sockets} -setup {

    close $p
    set x
} {server socket was not inherited}
test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
    file delete $path(script1)
    file delete $path(script2)

    # Script1 is just a 20 second delay. If the server socket is inherited, it
    # will be held open for 20 seconds
    # Script1 is just a 20 second delay.  If the server socket
    # is inherited, it will be held open for 10 seconds

    set f [open $path(script1) w]
    puts $f {
	fileevent stdin readable exit
	after 20000 exit
	vwait forever
    }
    close $f

    # Script2 opens the client socket and writes to it. It then launches
    # script1 and exits. If the child process inherited the client socket, the
    # socket will still be open.
    # Script2 opens the client socket and writes to it.  It then
    # launches script1 and exits.  If the child process inherited the
    # client socket, the socket will still be open.

    set f [open $path(script2) w]
    puts $f [list set tcltest [interpreter]]
    puts $f [list set delay $path(script1)]
    puts $f [list set localhost $localhost]
    puts $f {
    puts -nonewline $f {
        gets stdin port
	set f [socket $localhost $port]
        exec $tcltest $delay &
	set f [socket 127.0.0.1 $port]
        exec $tcltest }
    puts $f [list $path(script1) &]
    puts $f {
	puts $f testing
	flush $f
        exit
	after 1000 exit
	vwait forever
    }
    close $f
    # If the socket doesn't hit end-of-file in 10 seconds, the script1 process

    # must have inherited the client.
    set timeout 0
    set after [after 10000 {set x "client socket was inherited"}]
} -constraints [list socket supported_$af stdio exec] -body {
    # Create the server socket

    set server [socket -server accept -myaddr $localhost 0]
    set server [socket -server accept -myaddr 127.0.0.1 0]
    proc accept { file host port } {
	# When the client connects, establish the read handler
	global server
	close $server
	fileevent $file readable [list getdata $file]
	fconfigure $file -buffering line -blocking 0
        set ::f $file
	return
    }
    proc getdata { file } {
	# Read handler on the accepted socket.
	global x
	global failed
	set status [catch {read $file} data]
	if {$status != 0} {
	    set x "read failed, error was $data"
	} elseif {$data ne ""} {
	    set x {read failed, error was $data}
	    catch { close $file }
	} elseif {[string compare {} $data]} {
	} elseif {[fblocked $file]} {
	} elseif {[eof $file]} {
	    if {$failed} {
		set x {client socket was inherited}
	    } else {
            set x "client socket was not inherited"
		set x {client socket was not inherited}
	    }
	    catch { close $file }
	} else {
	    set x "impossible case"
	    set x {impossible case}
	    catch { close $file }
	}
	return
    }

    # If the socket doesn't hit end-of-file in 10 seconds, the
    # script1 process must have inherited the client.

    set failed 0
    after 10000 [list set failed 1]

    # Launch the script2 process
    ### exec [interpreter] script2 &

    set p [open "|[list [interpreter] $path(script2)]" w]
    puts $p [lindex [fconfigure $server -sockname] 2] ; flush $p

    vwait x
    return $x
} -cleanup {
    if {!$failed} {
	vwait failed
    fconfigure $f -blocking 1
    close $f
    }
    close $p
    after cancel $after
    close $p
} -result {client socket was not inherited}
test socket_$af-12.3 {testing inheritance of accepted sockets} -setup {
    set x
} {client socket was not inherited}
test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
    file delete $path(script1)
    file delete $path(script2)

    set f [open $path(script1) w]
    puts $f {
	fileevent stdin readable exit
	after 10000 exit
	vwait forever
    }
    close $f

    set f [open $path(script2) w]
    puts $f [list set tcltest [interpreter]]
    puts $f [list set delay $path(script1)]
    puts $f [list set localhost $localhost]
    puts $f {
	set server [socket -server accept -myaddr $localhost 0]
	proc accept { file host port } {
	    global tcltest delay
    puts -nonewline $f {
	set server [socket -server accept -myaddr 127.0.0.1 0]
	puts stdout [lindex [fconfigure $server -sockname] 2]
	proc accept { file host port } }
    puts $f \{
    puts -nonewline $f {
	    global tcltest
	    puts $file {test data on socket}
	    exec $tcltest $delay &
            after idle exit
	    exec $tcltest }
    puts $f [list $path(script1) &]
    puts $f {
	    after 1000 exit
	}
	puts stdout [lindex [fconfigure $server -sockname] 2]
    puts $f \}
    puts $f {
	vwait forever
    }
    close $f
} -constraints [list socket supported_$af stdio exec] -body {
    # Launch the script2 process and connect to it. See how long the socket
    # stays open

    # Launch the script2 process and connect to it.  See how long
    # the socket stays open

    ## exec [interpreter] script2 &
    set p [open "|[list [interpreter] $path(script2)]" r]
    gets $p listen

    after 1000 set ok_to_proceed 1
    vwait ok_to_proceed

    set f [socket $localhost $listen]
    set f [socket 127.0.0.1 $listen]
    fconfigure $f -buffering full -blocking 0
    fileevent $f readable [list getdata $f]

    # If the socket is still open after 5 seconds, the script1 process must
    # have inherited the accepted socket.
    # If the socket is still open after 5 seconds, the script1 process
    # must have inherited the accepted socket.

    set failed 0
    after 5000 set failed 1
    set after [after 5000 [list set x "accepted socket was inherited"]]

    proc getdata { file } {
	# Read handler on the client socket.
	global x
	global failed
	set status [catch {read $file} data]
	if {$status != 0} {
	    set x "read failed, error was $data"
	    set x {read failed, error was $data}
	    catch { close $file }
	} elseif {[string compare {} $data]} {
	} elseif {[fblocked $file]} {
	} elseif {[eof $file]} {
	    if {$failed} {
		set x {accepted socket was inherited}
	    } else {
            set x "accepted socket was not inherited"
		set x {accepted socket was not inherited}
	    }
	    catch { close $file }
	} else {
	    set x "impossible case"
	    set x {impossible case}
	    catch { close $file }
	}
	return
    }

    vwait x
    set x

} -cleanup {
    fconfigure $f -blocking 1
    close $f
    close $p
    after cancel $after
    close $p
} -result {accepted socket was not inherited}
    set x
} {accepted socket was not inherited}

test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
    # create a thread
test socket-13.1 {Testing use of shared socket between two threads} \
        -constraints {socket testthread} -setup {
    threadReap
    set serverthread [thread::create -preserved [string map [list @localhost@ $localhost] {
        set f [socket -server accept -myaddr @localhost@ 0]
    set path(script) [makeFile {
        set f [socket -server accept -myaddr 127.0.0.1 0]
        set listen [lindex [fconfigure $f -sockname] 2]
        proc accept {s a p} {
            fileevent $s readable [list echo $s]
            fconfigure $s -buffering line
        }
        proc echo {s} {
             global i
             set l [gets $s]
             if {[eof $s]} {
                 global x
                 close $s
                 set x done
             } else {
                 incr i
                 puts $s $l
             }
        }
        set i 0
        vwait x
        close $f
        # thread cleans itself up.
        testthread exit
    }]]
    set port [thread::send $serverthread {set listen}]
    set s [socket $localhost $port]
    } script]
} -body {
    # create a thread
    set serverthread [testthread create [list source $path(script) ] ]
    update
    set port [testthread send $serverthread {set listen}]
    update

    after 1000
    set s [socket 127.0.0.1 $port]
    fconfigure $s -buffering line

    catch {
        puts $s "hello"
        gets $s result
    }
    close $s
    thread::release $serverthread
    append result " " [llength [thread::names]]
} -result {hello 1} -constraints [list socket supported_$af thread]

proc transf_test {{testmode transfer} {maxIter 1000} {maxTime 10000}} {
  try {
    set ::count 0
    set ::testmode $testmode
    set port 0
    set srvsock {}
    # if binding on port 0 is not possible (system related, blocked on ISPs etc):
    if {[catch {close [socket -async $::localhost $port]}]} {
      # simplest server on random port (immediatelly closing a connect):
      set port [randport]
      set srvsock [socket -server {apply {{ch args} {close $ch}}} -myaddr $::localhost $port]
      # socket on windows has some issues yet (e. g. bug [b6d0d8cc2c]), so we simply decrease iteration count (to 1/4):
      if {$::tcl_platform(platform) eq "windows" && $maxIter > 50} {
      	set ::count [expr {$maxIter / 4 * 3 - 1}]; # bypass 3/4 iterations
      }
    }
    tcltest::DebugPuts 1 "== test \[$::localhost\]:$port $testmode =="
    set ::parent [thread::id]
    # helper thread creating async connection and initiating transfer (detach) to parent:
    set ::helper [thread::create]
    thread::send -async $::helper [list \
      lassign [list $::parent $::localhost $port $testmode] \
                     ::parent ::localhost ::port ::testmode
    ]
    thread::send -async $::helper {
      set ::helper [thread::id]
      proc iteration {args} {
        set fd [socket -async $::localhost $::port]
        if {"helper-writable" in $::testmode} {;# to test both sides during connect
          fileevent $fd writable [list apply {{fd} {
            if {[thread::id] ne $::helper} {
              thread::send -async $::parent {set ::count "ERROR: invalid thread, $::helper is expecting"}
              close $fd
              return
            }
          }} $fd]
        };#
        thread::detach $fd
        thread::send -async $::parent [list transf_parent $fd {*}$args]
      }
      iteration first
    }
    # parent proc commiting transfer attempt (attach) and checking acquire was successful:
    proc transf_parent {fd args} {
      tcltest::DebugPuts 1 "** trma / $::count ** $args **"
      thread::attach $fd
      if {"parent-close" in $::testmode} {;# to test close during connect
        set ::count $::count
        close $fd
        return
      };#
      fileevent $fd writable [list apply {{fd} {
        if {[thread::id] ne $::parent} {
          thread::send -async $::parent {set ::count "ERROR: invalid thread, $::parent is expecting"}
          close $fd
          return
        }
        set ::count $::count
        close $fd
      }} $fd]
    }
    # repeat maxIter times (up to maxTime ms as timeout):
    set tout [after $maxTime {set ::count "TIMEOUT"}]
    while 1 {
      vwait ::count
      if {![string is integer $::count]} {
        # if timeout just skip (test was successful until now):
      	if {$::count eq "TIMEOUT"} {::tcltest::Skip "timing issue"}
        break
      }
      if {[incr ::count] >= $maxIter} break
      tcltest::DebugPuts 1 "** iter / $::count **"
      thread::send -async $::helper [list iteration nr $::count]
    }
    update
    set ::count
  } finally {
    catch {after cancel $tout}
    if {$srvsock ne {}} {close $srvsock}
    if {[info exists ::helper]} {thread::release -wait $::helper}
    tcltest::DebugPuts 1 "== stop / $::count =="
    unset -nocomplain ::count ::testmode ::parent ::helper
  }

}
test socket_$af-13.2.tr1 {Testing socket transfer between threads during async connect} -body {
    transf_test {transfer} 1000
} -result 1000 -constraints [list socket supported_$af thread]
    after 2000
    lappend result [threadReap]
test socket_$af-13.2.tr2 {Testing socket transfer between threads during async connect} -body {
    transf_test {transfer helper-writable} 100
} -result 100 -constraints [list socket supported_$af thread]
test socket_$af-13.2.cl1 {Testing socket transfer between threads during async connect} -body {
    transf_test {parent-close} 100
} -cleanup {
} -result 100 -constraints [list socket supported_$af thread]
test socket_$af-13.2.cl2 {Testing socket transfer between threads during async connect} -body {
    transf_test {parent-close helper-writable} 100
} -result 100 -constraints [list socket supported_$af thread]
catch {rename transf_parent {}}
rename transf_test {}

    removeFile script
} -result {hello 1}
# ----------------------------------------------------------------------

removeFile script1
removeFile script2

# cleanup
if {$remoteProcChan ne ""} {
    catch {sendCommand exit}
if {[string match sock* $commandSocket] == 1} {
   puts $commandSocket exit
   flush $commandSocket
}
catch {close $commandSocket}
catch {close $remoteProcChan}
}
unset ::tcl::unsupported::socketAF
test socket-14.0.0 {[socket -async] when server only listens on IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        proc accept {s a p} {
            global x
            puts $s bye
            close $s
            set x ok
        }
        set server [socket -server accept -myaddr 127.0.0.1 0]
        set port [lindex [fconfigure $server -sockname] 2]
    } -body {
        set client [socket -async localhost $port]
        set after [after $latency {set x [fconfigure $client -error]}]
        vwait x
        set x
    } -cleanup {
        after cancel $after
        close $server
        close $client
        unset x
    } -result ok
test socket-14.0.1 {[socket -async] when server only listens on IPv6} \
    -constraints {socket supported_inet6 localhost_v6} \
    -setup {
        proc accept {s a p} {
            global x
            puts $s bye
            close $s
            set x ok
        }
        set server [socket -server accept -myaddr ::1 0]
        set port [lindex [fconfigure $server -sockname] 2]
    } -body {
        set client [socket -async localhost $port]
        set after [after $latency {set x [fconfigure $client -error]}]
        vwait x
        set x
    } -cleanup {
        after cancel $after
        close $server
        close $client
        unset x
    } -result ok
test socket-14.1 {[socket -async] fileevent while still connecting} \
    -constraints {socket} \
    -setup {
        proc accept {s a p} {
            global x
            puts $s bye
            close $s
	    lappend x ok
        }
        set server [socket -server accept -myaddr localhost 0]
        set port [lindex [fconfigure $server -sockname] 2]
        set x ""
    } -body {
        set client [socket -async localhost $port]
        fileevent $client writable {
            lappend x [fconfigure $client -error]
	    fileevent $client writable {}
        }
        set after [after $latency {lappend x timeout}]
        while {[llength $x] < 2 && "timeout" ni $x} {
            vwait x
        }
        lsort $x; # we only want to see both events, the order doesn't matter
    } -cleanup {
        after cancel $after
        close $server
        close $client
        unset x
    } -result {{} ok}
test socket-14.2 {[socket -async] fileevent connection refused} \
    -constraints {socket} \
    -body {
        set client [socket -async localhost [randport]]
        fileevent $client writable {set x ok}
        set after [after $latency {set x timeout}]
        vwait x
        after cancel $after
        lappend x [fconfigure $client -error]
    } -cleanup {
        after cancel $after
        close $client
        unset x after client
    } -result {ok {connection refused}}
test socket-14.3 {[socket -async] when server only listens on IPv6} \
    -constraints {socket supported_inet6 localhost_v6} \
    -setup {
        proc accept {s a p} {
            global x
            puts $s bye
            close $s
            set x ok
        }
        set server [socket -server accept -myaddr ::1 0]
        set port [lindex [fconfigure $server -sockname] 2]
    } -body {
        set client [socket -async localhost $port]
        set after [after $latency {set x [fconfigure $client -error]}]
        vwait x
        set x
    } -cleanup {
        after cancel $after
        close $server
        close $client
        unset x
    } -result ok
test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
    -constraints {socket} \
    -setup {
        proc accept {s a p} {
            puts $s bye
            close $s
        }
        set server [socket -server accept -myaddr localhost 0]
        set port [lindex [fconfigure $server -sockname] 2]
        set x ""
    } -body {
        set client [socket -async localhost $port]
        fileevent $client writable {
            lappend x [fconfigure $client -error]
            fileevent $client writable {}
        }
        fileevent $client readable {lappend x [gets $client]}
        set after [after $latency {lappend x timeout}]
        while {[llength $x] < 2 && "timeout" ni $x} {
            vwait x
        }
        lsort $x
    } -cleanup {
        after cancel $after
        close $client
        close $server
        unset x
    } -result {{} bye}
# FIXME: we should also have an IPv6 counterpart of this
test socket-14.5 {[socket -async] which fails before any connect() can be made} \
    -constraints {socket supported_inet notWine} \
    -body {
        # address from rfc5737
        socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
    } \
    -returnCodes 1 \
    -result {couldn't open socket: cannot assign requested address}
test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        proc accept {s a p} {
            global x
            puts $s bye
            close $s
            set x ok
        }
        set server [socket -server accept -myaddr 127.0.0.1 0]
        set port [lindex [fconfigure $server -sockname] 2]
        set x ""
    } \
    -body {
        set client [socket -async localhost $port]
        for {set i 0} {$i < 50} {incr i } {
            update
            if {$x ne ""} {
                lappend x [gets $client]
                break
            }
            after 100
        }
        set x
    } \
    -cleanup {
        close $server
        close $client
        unset x
    } \
    -result {ok bye}
test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} \
    -constraints {socket supported_inet6 localhost_v6} \
    -setup {
        proc accept {s a p} {
            global x
            puts $s bye
            close $s
            set x ok
        }
        set server [socket -server accept -myaddr ::1 0]
        set port [lindex [fconfigure $server -sockname] 2]
        set x ""
    } \
    -body {
        set client [socket -async localhost $port]
        for {set i 0} {$i < 50} {incr i } {
            update
            if {$x ne ""} {
                lappend x [gets $client]
                break
            }
            after 100
        }
        set x
    } \
    -cleanup {
        close $server
        close $client
        unset x
    } \
    -result {ok bye}
test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {{} ok {}}
test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \
    -constraints {socket supported_inet6 localhost_v6} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr ::1 0]
            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {{} ok {}}
test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \
    -constraints {socket} \
    -body {
        set sock [socket -async localhost [randport]]
        catch {gets $sock} x
        list $x [fconfigure $sock -error] [fconfigure $sock -error]
    } -cleanup {
        close $sock
    } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        fconfigure $sock -blocking 0
        for {set i 0} {$i < 50} {incr i } {
            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
            after 200
        }
        set x
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {ok}
test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} \
    -constraints {socket supported_inet6 localhost_v6} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr ::1 0]
            proc accept {s h p} {puts $s ok; close $s; set ::x 1}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        fconfigure $sock -blocking 0
        for {set i 0} {$i < 50} {incr i } {
            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
            after 200
        }
        set x
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {ok}
test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} \
    -constraints {socket} \
    -body {
        set sock [socket -async localhost [randport]]
        fconfigure $sock -blocking 0
        for {set i 0} {$i < 50} {incr i } {
            if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
            after 200
        }
        list $x [fconfigure $sock -error] [fconfigure $sock -error]
    } -cleanup {
        close $sock
    } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {set ::x $s}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
            puts [gets $x]
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        puts $sock ok
        flush $sock
        list [fconfigure $sock -error] [gets $fd]
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {{} ok}
test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} \
    -constraints {socket supported_inet6 localhost_v6} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr ::1 0]
            proc accept {s h p} {set ::x $s}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
            puts [gets $x]
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        puts $sock ok
        flush $sock
        list [fconfigure $sock -error] [gets $fd]
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {{} ok}
test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} \
    -constraints {socket supported_inet localhost_v4} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr 127.0.0.1 0]
            proc accept {s h p} {set ::x $s}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
            puts [gets $x]
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        fconfigure $sock -blocking 0
        puts $sock ok
        flush $sock
        fileevent $fd readable {set x 1}
        vwait x
        list [fconfigure $sock -error] [gets $fd]
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {{} ok}
test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} \
    -constraints {socket supported_inet6 localhost_v6} \
    -setup {
        makeFile {
            fileevent stdin readable exit
            set server [socket -server accept -myaddr ::1 0]
            proc accept {s h p} {set ::x $s}
            puts [lindex [fconfigure $server -sockname] 2]
            flush stdout
            vwait x
            puts [gets $x]
        } script
        set fd [open |[list [interpreter] script] RDWR]
        set port [gets $fd]
    } -body {
        set sock [socket -async localhost $port]
        fconfigure $sock -blocking 0
        puts $sock ok
        flush $sock
        fileevent $fd readable {set x 1}
        vwait x
        list [fconfigure $sock -error] [gets $fd]
    } -cleanup {
        close $fd
        close $sock
	removeFile script
    } -result {{} ok}
test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \
    -constraints {socket knownMsvcBug} \
    -body {
        set sock [socket -async localhost [randport]]
        fconfigure $sock -blocking 0
        puts $sock ok
        fileevent $sock writable {set x 1}
        vwait x
        close $sock
    } -cleanup {
        catch {close $sock}
        unset x
    } -result {socket is not connected} -returnCodes 1
test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \
    -constraints {socket testsocket_testflags} \
    -body {
        set sock [socket -async localhost [randport]]
        # Set the socket in async test mode.
        # The async connect will not be continued on the following fconfigure
        # and puts/flush. Thus, the connect will fail after them.
        testsocket testflags $sock 1
        fconfigure $sock -blocking 0
        puts $sock ok
        flush $sock
        testsocket testflags $sock 0
        fileevent $sock writable {set x 1}
        vwait x
        close $sock
    } -cleanup {
        catch {close $sock}
        catch {unset x}
    } -result {socket is not connected} -returnCodes 1
test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
    -constraints {socket} \
    -body {
        set s [socket -async localhost [randport]]
        for {set i 0} {$i < 50} {incr i} {
            set x [fconfigure $s -error]
            if {$x != ""} break
            after 200
        }
        set x
    } -cleanup {
        close $s
        unset x s
    } -result {connection refused}

test socket-14.13 {testing writable event when quick failure} \
test socket-14.13 {testing writable event when quick failure} -constraints {socket win supported_inet} -body {
    -constraints {socket win supported_inet notWine} \
    -body {
    # Test for bug 336441ed59 where a quick background fail was ignored

    # Test only for windows as socket -async 255.255.255.255 fails
    # directly on unix

    # The following connect should fail very quickly
    set a1 [after 2000 {set x timeout}]
    set s [socket -async 255.255.255.255 43434]
    fileevent $s writable {set x writable}
    vwait x
    set x
} -cleanup {
    catch {close $s}
    after cancel $a1
} -result writable

test socket-14.14 {testing fileevent readable on failed async socket connect} \
test socket-14.14 {testing fileevent readable on failed async socket connect} -constraints [list socket] -body {
    -constraints {socket} -body {
    # Test for bug 581937ab1e

    set a1 [after 5000 {set x timeout}]
    # This connect should fail
    set s [socket -async localhost [randport]]
    fileevent $s readable {set x readable}
    vwait x
    set x
} -cleanup {
    catch {close $s}
    after cancel $a1
} -result readable

test socket-14.15 {blocking read on async socket should not trigger event handlers} \
    -constraints socket -body {
        set s [socket -async localhost [randport]]
        set x ok
        fileevent $s writable {set x fail}
        catch {read $s}
	close $s
        set x
    } -result ok

# v4 and v6 is required to prevent that the async connect does not terminate
# before the fconfigure command. There is always an additional ip to try.
test socket-14.16 {empty -peername while [socket -async] connecting} \
    -constraints {socket localhost_v4 localhost_v6} \
    -body {
        set client [socket -async localhost [randport]]
        fconfigure $client -peername
    } -cleanup {
        catch {close $client}
    } -result {}

# v4 and v6 is required to prevent that the async connect does not terminate
# before the fconfigure command. There is always an additional ip to try.
test socket-14.17 {empty -sockname while [socket -async] connecting} \
    -constraints {socket localhost_v4 localhost_v6} \
    -body {
        set client [socket -async localhost [randport]]
        fconfigure $client -sockname
    } -cleanup {
        catch {close $client}
    } -result {}

# test for bug c6ed4acfd8: running async socket connect with other connect
# established will block tcl as it goes in an infinite loop in vwait
test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} \
    -constraints {socket} \
    -body {
        proc accept {channel address port} {}
        set port [randport]
        set ssock [socket -server accept $port]
        set csock1 [socket -async localhost [randport]]
        set csock2 [socket localhost $port]
        after 1000 {set done ok}
        vwait done
} -cleanup {
        catch {close $ssock}
        catch {close $csock1}
        catch {close $csock2}
    } -result {}

test socket-14.19 {tip 456 -- introduce the -reuseport option} \
    -constraints {socket notWine} \
    -body {
        proc accept {channel address port} {}
        set port [randport]
        set ssock1 [socket -server accept -reuseport yes $port]
        set ssock2 [socket -server accept -reuseport yes $port]
        return ok
} -cleanup {
    catch {close $ssock1}
    catch {close $ssock2}
    } -result ok

set num 0

set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}}
set resultok {-result "sock*" -match glob}
set resulterr {
    -result {couldn't open socket: connection refused}
    -returnCodes 1
}
foreach {servip sc} $x {
    foreach {cliip cc} $x {
        set constraints socket
        lappend constraints $sc $cc
        set result $resulterr
        switch -- [lsort -unique [list $servip $cliip]] {
            localhost - 127.0.0.1 - ::1 {
                set result $resultok
            }
            {127.0.0.1 localhost} {
                if {[testConstraint localhost_v4]} {
                    set result $resultok
                }
            }
            {::1 localhost} {
                if {[testConstraint localhost_v6]} {
                    set result $resultok
                }
            }
        }
        test socket-15.1.$num "Connect to $servip from $cliip" \
            -constraints $constraints -setup {
                set server [socket -server accept -myaddr $servip 0]
                proc accept {s h p} { close $s }
                set port [lindex [fconfigure $server -sockname] 2]
            } -body {
                set s [socket $cliip $port]
            } -cleanup {
                close $server
                catch {close $s}
            } {*}$result
        incr num
    }
}

::tcltest::cleanupTests
flush stdout
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/source.test.

8
9
10
11
12
13
14
15
16


17
18
19
20
21
22

23
24
25
26
27
28
29
8
9
10
11
12
13
14


15
16
17
18
19
20
21

22
23
24
25
26
27
28
29







-
-
+
+





-
+







# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 by Scriptics Corporation.
# Contributions from Don Porter, NIST, 2003.  (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.

if {[catch {package require tcltest 2.5}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.5 required."
if {[catch {package require tcltest 2.1}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
    return
}

namespace eval ::tcl::test::source {
    namespace import ::tcltest::*


test source-1.1 {source command} -setup {
    set x "old x value"
    set y "old y value"
    set z "old z value"
    set sourcefile [makeFile {
	set x 22
	set y 33
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
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







-
-
-
+
+
+
+








-
+







} -cleanup {
    removeFile source.file
} -returnCodes continue
test source-2.6 {source error conditions} -setup {
    set sourcefile [makeFile {} _non_existent_]
    removeFile _non_existent_
} -body {
    source $sourcefile
} -match glob -result {couldn't read file "*_non_existent_": no such file or directory} \
	-errorCode {POSIX ENOENT {no such file or directory}}
    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 $sourcefile
    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 {
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
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







-
+













-
+




-
+







    file delete $sourcefile
    set f [open $sourcefile w]
    fconfigure $f -encoding utf-8
    puts $f "set symbol(square-root) \u221A; set x correct"
    close $f
} -body {
    set x unset
    source $sourcefile
    source -encoding utf-8 $sourcefile
    set x
} -cleanup {
    removeFile source.file
} -result correct
test source-7.2 {source -encoding test} -setup {
    # This tests for bad interactions between [source -encoding]
    # and use of the Control-Z character (\u001A) as a cross-platform
    # EOF character by [source].  Here we write out and the [source] a
    # file that contains the byte \x1A, although not the character \u001A in
    # the indicated encoding.
    set sourcefile [makeFile {} source.file]
    file delete $sourcefile
    set f [open $sourcefile w]
    fconfigure $f -encoding utf-16
    fconfigure $f -encoding unicode
    puts $f "set symbol(square-root) \u221A; set x correct"
    close $f
} -body {
    set x unset
    source -encoding utf-16 $sourcefile
    source -encoding unicode $sourcefile
    set x
} -cleanup {
    removeFile source.file
} -result correct
test source-7.3 {source -encoding: syntax} -body {
    # Have to spell out the -encoding option
    source -e utf-8 no_file
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
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











-
+



















-
-
-
-
-
-
-
-
-
-
-
-




-
-
-
-
    set sourcefile [makeFile {} source.file]
    file delete $sourcefile
    set f [open $sourcefile w]
    fconfigure $f -encoding utf-8
    puts $f "proc \u20ac {} {return foo}"
    close $f
} -body {
    source $sourcefile
    source -encoding utf-8 $sourcefile
    \u20ac
} -cleanup {
    removeFile source.file
    rename \u20ac {}
} -result foo
test source-7.6 {source -encoding: mismatch encoding error} -setup {
    set sourcefile [makeFile {} source.file]
    file delete $sourcefile
    set f [open $sourcefile w]
    fconfigure $f -encoding utf-8
    puts $f "proc \u20ac {} {return foo}"
    close $f
} -body {
    source -encoding ascii $sourcefile
    \u20ac
} -cleanup {
    removeFile source.file
} -returnCodes error -match glob -result {invalid command name*}

test source-8.1 {source and coroutine/yield} -setup {
    set sourcefile [makeFile {} source.file]
    file delete $sourcefile
} -body {
    makeFile {yield 1; yield 2; return 3;} $sourcefile
    coroutine coro apply {f {yield;source $f}} $sourcefile
    list [coro] [coro] [coro] [info exist coro]
} -cleanup {
    catch {rename coro {}}
    removeFile source.file
} -result {1 2 3 0}

cleanupTests
}
namespace delete ::tcl::test::source
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/split.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+


-
+







# Commands covered:  split
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


test split-1.1 {basic split commands} {
    split "a\n b\t\r c\n "
} {a {} b {} {} c {} {}}
test split-1.2 {basic split commands} {
    split "word 1xyzword 2zword 3" xyz
} {{word 1} {} {} {word 2} {word 3}}
test split-1.3 {basic split commands} {
39
40
41
42
43
44
45
46

47
48
49
50
51
52
53
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53







-
+







} {{} {} {} {}}
test split-1.8 {basic split commands} {
    proc foo {} {
        set x {}
        foreach f [split {]\n} {}] {
            append x $f
        }
        return $x
        return $x	
    }
    foo
} {]\n}
test split-1.9 {basic split commands} {
    proc foo {} {
        set x ab\000c
        set y [split $x {}]
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
66
67
68
69
70
71
72






73
74
75

76
77
78


79
80
81
82
83
84











-
-
-
-
-
-



-
+


-
-
+
+




-
-
-
-
} {{} ab cd {} ef {}}
test split-1.13 {basic split commands} {
    split "12,34,56," {,}
} {12 34 56 {}}
test split-1.14 {basic split commands} {
    split ",12,,,34,56," {,}
} {{} 12 {} {} 34 56 {}}
test split-1.15 {basic split commands} -body {
    split "a\U1F4A9b" {}
} -result "a \U1F4A9 b"
test split-1.16 {basic split commands} -body {
    split "a\U1F4A9b" \U1F4A9
} -result "a b"

test split-2.1 {split errors} {
    list [catch split msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
test split-2.2 {split errors} {
    list [catch {split a b c} msg] $msg $errorCode
} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}

} {1 {wrong # args: should be "split string ?splitChars?"} NONE}

# cleanup
catch {rename foo {}}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/stack.test.

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
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











-
-
-
-
+
+
+
+

-
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+






-
+

-
+
+
+






-
-
+
+


-
+







# Tests that the stack size is big enough for the application.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
package require tcltest 2
namespace import ::tcltest::*

testConstraint noOsx [expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]

# Note that a failure in this test may result in a crash of the executable.
# Note that a failure in this test results in a crash of the executable.
# In order to avoid that, we do a basic check of the current stacksize.
# This size can be changed with ulimit (ksh/bash/sh) or limit (csh/tcsh).

# This doesn't catch all cases, for example threads of lower stacksize
# can still squeak through.  A core check is really needed. -- JH

testConstraint minStack2034 1
if {[testConstraint unix]} {
    set stackSize [exec /bin/sh -c "ulimit -s"]
    if {[string is integer $stackSize] && ($stackSize < 2034)} {
        puts stderr "WARNING: the default application stacksize of $stackSize\
                may cause Tcl to\ncrash due to stack overflow before the\
                recursion limit is reached.\nA minimum stacksize of 2034\
                kbytes is recommended.\nSkipping infinite recursion test."
        testConstraint minStack2034 0
    }
}

#
# Custom match to detect a stack overflow independently of the mechanism that
# triggered the error.
#

customMatch stackOverflow StackOverflow
proc StackOverflow {- res} {
    set msgList [list \
            "too many nested evaluations (infinite loop?)"\
	    "out of stack space (infinite loop?)"]
    expr {$res in $msgList}
}

test stack-1.1 {maxNestingDepth reached on infinite recursion} -body {
test stack-1.1 {maxNestingDepth reached on infinite recursion} -constraints {
    minStack2034
} -body {
    # do this in a sub process in case it segfaults
    exec [interpreter] << {
	proc recurse {} { recurse }
	catch { recurse } rv
	puts $rv
    }
} -result {too many nested evaluations (infinite loop?)}
} -match stackOverflow

test stack-2.1 {maxNestingDepth reached on infinite recursion} -body {
test stack-2.1 {maxNestingDepth reached on infinite recursion} -constraints {
    minStack2034
} -body {
    # do this in a sub process in case it segfaults
    exec [interpreter] << {
	interp alias {} unknown {} notaknownproc
	catch { unknown } msg
	puts $msg
    }
} -result {too many nested evaluations (infinite loop?)}

} -match stackOverflow 
    
# Make sure that there is enough stack to run regexp even if we're
# close to the recursion limit. [Bug 947070] [Patch 746378]
test stack-3.1 {enough room for regexp near recursion limit} -body {
test stack-3.1 {enough room for regexp near recursion limit} -constraints noOsx -body {
    # do this in a sub process in case it segfaults
    exec [interpreter] << {
	interp recursionlimit {} 10000
	set depth 0
	proc a { max } {
	    if { [info level] < $max } {
		set ::depth [info level]

Changes to tests/string.test.

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
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
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
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


611
612
613


614
615
616


617
618
619


620
621
622


623
624
625


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


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
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
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
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
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
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
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


1439
1440
1441


1442
1443
1444


1445
1446
1447


1448
1449
1450


1451
1452
1453


1454
1455
1456


1457
1458
1459


1460
1461
1462


1463
1464
1465


1466
1467
1468


1469
1470
1471


1472
1473
1474


1475
1476

1477
1478
1479
1480



1481
1482
1483
1484



1485
1486

1487
1488
1489
1490
1491
1492

1493
1494
1495

1496
1497
1498
1499
1500
1501

1502
1503
1504

1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525


1526
1527
1528


1529
1530
1531


1532
1533
1534


1535
1536
1537


1538
1539
1540


1541
1542
1543


1544
1545
1546


1547
1548
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
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
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
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
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
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
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
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
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
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


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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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


1439
1440
1441


1442
1443
1444


1445
1446
1447



1448
1449
1450



1451


1452
1453
1454


1455
1456
1457



1458


1459
1460
1461





1462
1463
1464
1465
1466
1467


1468
1469
1470


1471
1472
1473




1474
1475
1476
1477
1478

1479
1480



1481
1482
1483
1484
1485
1486


1487


1488

1489

1490
1491

1492
1493

1494
1495








1496
1497
1498
1499
1500
1501
1502
1503
1504
1505










































1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547






1548



















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
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
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



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







-
-
+
+



-
-
-
-
-
-
-
-
-


-
-
+
+
-
-
-

-
+
-
-
-
-
-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+


-
-
+
+



-
-
+
+

-
-
+
-
-
-
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+


-
+

-
-
+
+
+

-
-
+
+
+

-
-
+
+
+

-
-
+
+
+

-
-
+
+
+

-
-
+
+
+




-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
+

-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+



-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
+

-
-
-
+
+
+

-
+


-
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-











-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+






-
+


-
+






-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+

-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
+

-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+

-
+
-
-
+
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+




-
+

-
+

-
+
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-

-
-
+
-
-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
-
-
-
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

+
+
+
+
-
-
-
-
-
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


+
+
+
-
+
-
-
-
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
-
-
-
-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

+
+
+
-
+
-
-
-
-
+

-
-
+
+

-
-
+
+

-
+

-
+


-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+


-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+

-
+


-
-
+
+



-
+


-
-
-
-
-
+
+
+
+
+

-
+



-
+


-
+

-
-
+
+
-
-
-
-
-
+
+
+
+
+

-
+



-
-
-
+
-
-
-
+
-

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
-
-
+
+
+

-
-
-
+
+
+

-
+





-
+


-
+





-
+


-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+


-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+
-
-
-

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+
-
-
-

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
+
+
+
-
-
-

-
-
+
+

-
-
+
+

-
-
-

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
+

-
-
-
+
+
+
+
+
+
-
-
+
-
-
+
-

-
+

-
+

-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
-
-
-
-
-
-

-
+


-
+

-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+

-
-
+
+

-
+

-
+

-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
+
+
+
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
+
+
-
-
+
-
-
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-

-
+
-
-
+

-
+
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-

-
+

-
+

-
-
-
-
-
+

-
+

-
-
-
+
+
+

-
-
-
-
-
+

-
+

-
+

-
+

-
+

-
-
-
-
-
-
-
-
-

-
-

-
-
-
-
-
-






# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] ne {}}]
testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint fullutf [expr {[string length \U010000] == 1}]
testConstraint testbytestring   [llength [info commands testbytestring]]

# Used for constraining memory leak tests
test string-1.1 {error conditions} {
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
        set lines [split [memory info] \n]
        return [lindex $lines 3 3]
    }
    proc leaktest {script {iterations 3}} {
    list [catch {string gorp a b} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2 {error conditions} {
        set end [getbytes]
        for {set i 0} {$i < $iterations} {incr i} {
            uplevel 1 $script
            set tmp $end
    list [catch {string} msg] $msg
            set end [getbytes]
        }
        return [expr {$end - $tmp}]
    }
}

} {1 {wrong # args: should be "string subcommand ?argument ...?"}}
proc representationpoke s {
    set r [::tcl::unsupported::representation $s]
    list [lindex $r 3] [string match {*, string representation "*"} $r]
}

foreach noComp {0 1} {


test string-2.1 {string compare, too few args} {
    list [catch {string compare a} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
if {$noComp} {
    if {[info commands testevalex] eq {}} {
	test string-0.1.$noComp "show testevalex availability" {testevalex} {list} {}
test string-2.2 {string compare, bad args} {
	continue
    }
    interp alias {} run {} testevalex
    set constraints testevalex
} else {
    interp alias {} run {} try
    set constraints {}
}


test string-1.1.$noComp {error conditions} {
    list [catch {run {string gorp a b}} msg] $msg
    list [catch {string compare a b c} msg] $msg
} {1 {bad option "a": must be -nocase or -length}}
test string-2.3 {string compare, bad args} {
    list [catch {string compare -length -nocase str1 str2} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-1.2.$noComp {error conditions} {
    list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
} {1 {expected integer but got "-nocase"}}
test string-2.4 {string compare, too many args} {
    list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test stringComp-1.3.$noComp {error condition - undefined method during compile} {
    # We don't want this to complain about 'never' because it may never
    # be called, or string may get redefined.  This must compile OK.
    proc foo {str i} {
        if {"yes" == "no"} { string never called but complains here }
        string index $str $i
    }
    foo abc 0
} a

test string-2.1.$noComp {string compare, not enough args} {
    list [catch {run {string compare a}} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.2.$noComp {string compare, bad args} {
    list [catch {run {string compare a b c}} msg] $msg
} {1 {bad option "a": must be -nocase or -length}}
test string-2.3.$noComp {string compare, bad args} {
    list [catch {run {string compare -length -nocase str1 str2}} msg] $msg
} {1 {expected integer but got "-nocase"}}
test string-2.4.$noComp {string compare, too many args} {
    list [catch {run {string compare -length 10 -nocase str1 str2 str3}} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.5.$noComp {string compare with length unspecified} {
    list [catch {run {string compare -length 10 10}} msg] $msg
test string-2.5 {string compare with length unspecified} {
    list [catch {string compare -length 10 10} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test string-2.6.$noComp {string compare} {
    run {string compare abcde abdef}
test string-2.6 {string compare} {
    string compare abcde abdef
} -1
test string-2.7.$noComp {string compare, shortest method name} {
    run {string co abcde ABCDE}
test string-2.7 {string compare, shortest method name} {
    string c abcde ABCDE
} 1
test string-2.8.$noComp {string compare} {
    run {string compare abcde abcde}
test string-2.8 {string compare} {
    string compare abcde abcde
} 0
test string-2.9.$noComp {string compare with length} {
    run {string compare -length 2 abcde abxyz}
test string-2.9 {string compare with length} {
    string compare -length 2 abcde abxyz
} 0
test string-2.10.$noComp {string compare with special index} {
    list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg
test string-2.10 {string compare with special index} {
    list [catch {string compare -length end-3 abcde abxyz} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-2.11.$noComp {string compare, unicode} {
    run {string compare ab\u7266 ab\u7267}
test string-2.11 {string compare, unicode} {
    string compare ab\u7266 ab\u7267
} -1
test string-2.11.1.$noComp {string compare, unicode} {
    run {string compare \334 \xDC}
} 0
test string-2.11.2.$noComp {string compare, unicode} {
    run {string compare \334 \xFC}
} -1
test string-2.11.3.$noComp {string compare, unicode} {
    run {string compare \334\334\334\374\374 \334\334\334\334\334}
} 1
test string-2.12.$noComp {string compare, high bit} {
    # This test will fail if the underlying comparison
test string-2.12 {string compare, high bit} {
    # This test will fail if the underlying comparaison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    run {string compare "\x80" "@"}
    # Nb this tests works also in utf-8 space because \x80 is
    string compare "\x80" "@"
    # Nb this tests works also in utf8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 1
test string-2.13.$noComp {string compare -nocase} {
    run {string compare -nocase abcde abdef}
test string-2.13 {string compare -nocase} {
    string compare -nocase abcde abdef
} -1
test string-2.13.1.$noComp {string compare -nocase} {
    run {string compare -nocase abcde Abdef}
test string-2.14 {string compare -nocase} {
} -1
test string-2.14.$noComp {string compare -nocase} {
    run {string compare -nocase abcde ABCDE}
    string c -nocase abcde ABCDE
} 0
test string-2.15.$noComp {string compare -nocase} {
    run {string compare -nocase abcde abcde}
test string-2.15 {string compare -nocase} {
    string compare -nocase abcde abcde
} 0
test string-2.15.1.$noComp {string compare -nocase} {
    run {string compare -nocase \334 \xDC}
} 0
test string-2.15.2.$noComp {string compare -nocase} {
    run {string compare -nocase \334\334\334\374\xFC \334\334\334\334\334}
} 0
test string-2.16.$noComp {string compare -nocase with length} {
    run {string compare -length 2 -nocase abcde Abxyz}
test string-2.16 {string compare -nocase with length} {
    string compare -length 2 -nocase abcde Abxyz
} 0
test string-2.17.$noComp {string compare -nocase with length} {
    run {string compare -nocase -length 3 abcde Abxyz}
test string-2.17 {string compare -nocase with length} {
    string compare -nocase -length 3 abcde Abxyz
} -1
test string-2.18.$noComp {string compare -nocase with length <= 0} {
    run {string compare -nocase -length -1 abcde AbCdEf}
test string-2.18 {string compare -nocase with length <= 0} {
    string compare -nocase -length -1 abcde AbCdEf
} -1
test string-2.19.$noComp {string compare -nocase with excessive length} {
    run {string compare -nocase -length 50 AbCdEf abcde}
test string-2.19 {string compare -nocase with excessive length} {
    string compare -nocase -length 50 AbCdEf abcde
} 1
test string-2.20.$noComp {string compare -len unicode} {
test string-2.20 {string compare -len unicode} {
    # These are strings that are 6 BYTELENGTH long, but the length
    # shouldn't make a different because there are actually 3 CHARS long
    run {string compare -len 5 \334\334\334 \334\334\374}
    string compare -len 5 \334\334\334 \334\334\374
} -1
test string-2.21.$noComp {string compare -nocase with special index} {
    list [catch {run {string compare -nocase -length end-3 Abcde abxyz}} msg] $msg
test string-2.21 {string compare -nocase with special index} {
    list [catch {string compare -nocase -length end-3 Abcde abxyz} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-2.22.$noComp {string compare, null strings} {
    run {string compare "" ""}
test string-2.22 {string compare, null strings} {
    string compare "" ""
} 0
test string-2.23.$noComp {string compare, null strings} {
    run {string compare "" foo}
test string-2.23 {string compare, null strings} {
    string compare "" foo
} -1
test string-2.24.$noComp {string compare, null strings} {
    run {string compare foo ""}
test string-2.24 {string compare, null strings} {
    string compare foo ""
} 1
test string-2.25.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase "" ""}
test string-2.25 {string compare -nocase, null strings} {
    string compare -nocase "" ""
} 0
test string-2.26.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase "" foo}
test string-2.26 {string compare -nocase, null strings} {
    string compare -nocase "" foo
} -1
test string-2.27.$noComp {string compare -nocase, null strings} {
    run {string compare -nocase foo ""}
test string-2.27 {string compare -nocase, null strings} {
    string compare -nocase foo ""
} 1
test string-2.28.$noComp {string compare with length, unequal strings} {
    run {string compare -length 2 abc abde}
test string-2.28 {string compare with length, unequal strings} {
    string compare -length 2 abc abde
} 0
test string-2.29.$noComp {string compare with length, unequal strings} {
    run {string compare -length 2 ab abde}
test string-2.29 {string compare with length, unequal strings} {
    string compare -length 2 ab abde
} 0
test string-2.30.$noComp {string compare with NUL character vs. other ASCII} {
test string-2.30 {string compare with NUL character vs. other ASCII} {
    # Be careful here, since UTF-8 rep comparison with memcmp() of
    # these puts chars in the wrong order
    run {string compare \x00 \x01}
    string compare \x00 \x01
} -1
test string-2.31.$noComp {string compare, high bit} {
    run {string compare "a\x80" "a@"}
test string-2.31 {string compare, high bit} {
    proc foo {} {string compare "a\x80" "a@"}
    foo
} 1
test string-2.32.$noComp {string compare, high bit} {
    run {string compare "a\x00" "a\x01"}
test string-2.32 {string compare, high bit} {
    proc foo {} {string compare "a\x00" "a\x01"}
    foo
} -1
test string-2.33.$noComp {string compare, high bit} {
    run {string compare "\x00\x00" "\x00\x01"}
test string-2.33 {string compare, high bit} {
    proc foo {} {string compare "\x00\x00" "\x00\x01"}
    foo
} -1
test string-2.34.$noComp {string compare, binary equal} {
    run {string compare [binary format a100 0] [binary format a100 0]}
test string-2.34 {string compare, binary equal} {
    proc foo {} {string compare [binary format a100 0] [binary format a100 0]}
   foo
} 0
test string-2.35.$noComp {string compare, binary neq} {
    run {string compare [binary format a100a 0 1] [binary format a100a 0 0]}
test string-2.35 {string compare, binary neq} {
    proc foo {} {string compare [binary format a100a 0 1] [binary format a100a 0 0]}
    foo
} 1
test string-2.36.$noComp {string compare, binary neq unequal length} {
    run {string compare [binary format a20a 0 1] [binary format a100a 0 0]}
test string-2.36 {string compare, binary neq unequal length} {
    proc foo {} {string compare [binary format a20a 0 1] [binary format a100a 0 0]}
    foo
} 1

# only need a few tests on equal, since it uses the same code as
# string compare, but just modifies the return output
test string-3.1.$noComp {string equal} {
    run {string equal abcde abdef}
test string-3.1 {string equal} {
    string equal abcde abdef
} 0
test string-3.2.$noComp {string equal} {
    run {string e abcde ABCDE}
test string-3.2 {string equal} {
    string eq abcde ABCDE
} 0
test string-3.3.$noComp {string equal} {
    run {string equal abcde abcde}
test string-3.3 {string equal} {
    string equal abcde abcde
} 1
test string-3.4.$noComp {string equal -nocase} {
    run {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
test string-3.4 {string equal -nocase} {
    string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334
} 1
test string-3.5.$noComp {string equal -nocase} {
    run {string equal -nocase abcde abdef}
test string-3.5 {string equal -nocase} {
    string equal -nocase abcde abdef
} 0
test string-3.6.$noComp {string equal -nocase} {
    run {string eq -nocase abcde ABCDE}
test string-3.6 {string equal -nocase} {
    string eq -nocase abcde ABCDE
} 1
test string-3.7.$noComp {string equal -nocase} {
    run {string equal -nocase abcde abcde}
test string-3.7 {string equal -nocase} {
    string equal -nocase abcde abcde
} 1
test string-3.8.$noComp {string equal with length, unequal strings} {
    run {string equal -length 2 abc abde}
test string-3.8 {string equal with length, unequal strings} {
    string equal -length 2 abc abde
} 1
test string-3.9.$noComp {string equal, not enough args} {
    list [catch {run {string equal a}} msg] $msg
} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
test string-3.10.$noComp {string equal, bad args} {
    list [catch {run {string equal a b c}} msg] $msg
} {1 {bad option "a": must be -nocase or -length}}
test string-3.11.$noComp {string equal, bad args} {
    list [catch {run {string equal -length -nocase str1 str2}} msg] $msg
} {1 {expected integer but got "-nocase"}}
test string-3.12.$noComp {string equal, too many args} {
    list [catch {run {string equal -length 10 -nocase str1 str2 str3}} msg] $msg
} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
test string-3.13.$noComp {string equal with length unspecified} {
    list [catch {run {string equal -length 10 10}} msg] $msg
} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
test string-3.14.$noComp {string equal with length} {
    run {string equal -length 2 abcde abxyz}
} 1
test string-3.15.$noComp {string equal with special index} {
    list [catch {run {string equal -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}

test string-3.16.$noComp {string equal, unicode} {
    run {string equal ab\u7266 ab\u7267}
} 0
test string-3.17.$noComp {string equal, unicode} {
    run {string equal \334 \xDC}
} 1
test string-3.18.$noComp {string equal, unicode} {
    run {string equal \334 \xFC}
test string-4.1 {string first, too few args} {
    list [catch {string first a} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.2 {string first, bad args} {
    list [catch {string first a b c} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-4.3 {string first, too many args} {
    list [catch {string first a b 5 d} msg] $msg
} 0
test string-3.19.$noComp {string equal, unicode} {
    run {string equal \334\334\334\374\374 \334\334\334\334\334}
} 0
test string-3.20.$noComp {string equal, high bit} {
    # This test will fail if the underlying comparaison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    run {string equal "\x80" "@"}
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
    # Nb this tests works also in utf8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 0
test string-3.21.$noComp {string equal -nocase} {
    run {string equal -nocase abcde Abdef}
} 0
test string-3.22.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase \334 \xDC}
} 1
test string-3.23.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase \334\334\334\374\xFC \334\334\334\334\334}
} 1
test string-3.24.$noComp {string equal -nocase with length} {
    run {string equal -length 2 -nocase abcde Abxyz}
} 1
test string-3.25.$noComp {string equal -nocase with length} {
    run {string equal -nocase -length 3 abcde Abxyz}
} 0
test string-3.26.$noComp {string equal -nocase with length <= 0} {
    run {string equal -nocase -length -1 abcde AbCdEf}
} 0
test string-3.27.$noComp {string equal -nocase with excessive length} {
    run {string equal -nocase -length 50 AbCdEf abcde}
} 0
test string-3.28.$noComp {string equal -len unicode} {
    # These are strings that are 6 BYTELENGTH long, but the length
    # shouldn't make a different because there are actually 3 CHARS long
    run {string equal -len 5 \334\334\334 \334\334\374}
} 0
test string-3.29.$noComp {string equal -nocase with special index} {
    list [catch {run {string equal -nocase -length end-3 Abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-3.30.$noComp {string equal, null strings} {
    run {string equal "" ""}
} 1
test string-3.31.$noComp {string equal, null strings} {
    run {string equal "" foo}
} 0
test string-4.4 {string first} {
    string first bq abcdefgbcefgbqrs
} 12
test string-4.5 {string first} {
    string fir bcd abcdefgbcefgbqrs
} 1
test string-3.32.$noComp {string equal, null strings} {
    run {string equal foo ""}
test string-4.6 {string first} {
} 0
test string-3.33.$noComp {string equal -nocase, null strings} {
    run {string equal -nocase "" ""}
    string f b abcdefgbcefgbqrs
} 1
test string-3.34.$noComp {string equal -nocase, null strings} {
    run {string equal -nocase "" foo}
test string-4.7 {string first} {
} 0
test string-3.35.$noComp {string equal -nocase, null strings} {
    run {string equal -nocase foo ""}
} 0
test string-3.36.$noComp {string equal with NUL character vs. other ASCII} {
    # Be careful here, since UTF-8 rep comparison with memcmp() of
    # these puts chars in the wrong order
    run {string equal \x00 \x01}
} 0
test string-3.37.$noComp {string equal, high bit} {
    run {string equal "a\x80" "a@"}
} 0
test string-3.38.$noComp {string equal, high bit} {
    run {string equal "a\x00" "a\x01"}
    string first xxx x123xx345xxx789xxx012
} 9
test string-4.8 {string first} {
    string first "" x123xx345xxx789xxx012
} -1
test string-4.9 {string first, unicode} {
    string first x abc\u7266x
} 0
test string-3.39.$noComp {string equal, high bit} {
    run {string equal "a\x00\x00" "a\x00\x01"}
} 0
test string-3.40.$noComp {string equal, binary equal} {
    run {string equal [binary format a100 0] [binary format a100 0]}
} 1
test string-3.41.$noComp {string equal, binary neq} {
    run {string equal [binary format a100a 0 1] [binary format a100a 0 0]}
} 0
test string-3.42.$noComp {string equal, binary neq inequal length} {
    run {string equal [binary format a20a 0 1] [binary format a100a 0 0]}
} 0


test string-4.1.$noComp {string first, not enough args} {
    list [catch {run {string first a}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.2.$noComp {string first, bad args} {
    list [catch {run {string first a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-4.3.$noComp {string first, too many args} {
    list [catch {run {string first a b 5 d}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test string-4.4.$noComp {string first} {
    run {string first bq abcdefgbcefgbqrs}
} 12
test string-4.5.$noComp {string first} {
    run {string fir bcd abcdefgbcefgbqrs}
} 1
test string-4.6.$noComp {string first} {
    run {string f b abcdefgbcefgbqrs}
} 1
test string-4.7.$noComp {string first} {
    run {string first xxx x123xx345xxx789xxx012}
} 9
test string-4.8.$noComp {string first} {
    run {string first "" x123xx345xxx789xxx012}
} -1
test string-4.9.$noComp {string first, unicode} {
    run {string first x abc\u7266x}
} 4
test string-4.10.$noComp {string first, unicode} {
    run {string first \u7266 abc\u7266x}
test string-4.10 {string first, unicode} {
    string first \u7266 abc\u7266x
} 3
test string-4.11.$noComp {string first, start index} {
    run {string first \u7266 abc\u7266x 3}
test string-4.11 {string first, start index} {
    string first \u7266 abc\u7266x 3
} 3
test string-4.12.$noComp {string first, start index} -body {
    run {string first \u7266 abc\u7266x 4}
} -result -1
test string-4.13.$noComp {string first, start index} -body {
    run {string first \u7266 abc\u7266x end-2}
} -result 3
test string-4.14.$noComp {string first, negative start index} -body {
    run {string first b abc -1}
} -result 1
test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} -body {
test string-4.12 {string first, start index} {
    string first \u7266 abc\u7266x 4
} -1
test string-4.13 {string first, start index} {
    string first \u7266 abc\u7266x end-2
} 3
test string-4.14 {string first, negative start index} {
    string first b abc -1
} 1
test string-4.15 {string first, ability to two-byte encoded utf-8 chars} {
    # Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
    # strings was incorrect, leading to an index returned by [string first]
    # which pointed past the end of the string.
    set uchar \u057E    ;# character with two-byte encoding in utf-8
    run {string first % %#$uchar$uchar#$uchar$uchar#% 3}
} -result 8
    set uchar \u057e    ;# character with two-byte encoding in utf-8
    string first % %#$uchar$uchar#$uchar$uchar#% 3
} 8
test string-4.16.$noComp {string first, normal string vs pure unicode string} -body {
    set s hello
    regexp ll $s m
    # Representation checks are canaries
    run {list [representationpoke $s] [representationpoke $m] \
	[string first $m $s]}
} -result {{string 1} {string 0} 2}
test string-4.17.$noComp {string first, corner case} -body {
    run {string first a aaa 4294967295}
} -result {-1}
test string-4.18.$noComp {string first, corner case} -body {
    run {string first a aaa -1}
} -result {0}
test string-4.19.$noComp {string first, corner case} -body {
    run {string first a aaa end-5}
} -result {0}
test string-4.20.$noComp {string last, corner case} -body {
    run {string last a aaa 4294967295}
} -result {2}
test string-4.21.$noComp {string last, corner case} -body {
    run {string last a aaa -1}
} -result {-1}
test string-4.22.$noComp {string last, corner case} {
    run {string last a aaa end-5}
test string-4.17 {string first, corner case} {
    string first a aaa 4294967295
} {0}
test string-4.18 {string first, corner case} {
    string first a aaa -1
} {0}
test string-4.19 {string first, corner case} {
    string first a aaa end-5
} {0}
test string-4.20 {string last, corner case} {
    string last a aaa 4294967295
} {-1}
test string-4.21 {string last, corner case} {
    string last a aaa -1
} {-1}
test string-4.22 {string last, corner case} {
    string last a aaa end-5
} {-1}

test string-5.1.$noComp {string index} {
    list [catch {run {string index}} msg] $msg
test string-5.1 {string index} {
    list [catch {string index} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test string-5.2.$noComp {string index} {
    list [catch {run {string index a b c}} msg] $msg
test string-5.2 {string index} {
    list [catch {string index a b c} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test string-5.3.$noComp {string index} {
    run {string index abcde 0}
test string-5.3 {string index} {
    string index abcde 0
} a
test string-5.4.$noComp {string index} {
    run {string ind abcde 4}
test string-5.4 {string index} {
    string in abcde 4
} e
test string-5.5.$noComp {string index} {
    run {string index abcde 5}
test string-5.5 {string index} {
    string index abcde 5
} {}
test string-5.6.$noComp {string index} {
    list [catch {run {string index abcde -10}} msg] $msg
test string-5.6 {string index} {
    list [catch {string index abcde -10} msg] $msg
} {0 {}}
test string-5.7.$noComp {string index} {
    list [catch {run {string index a xyz}} msg] $msg
test string-5.7 {string index} {
    list [catch {string index a xyz} msg] $msg
} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
test string-5.8.$noComp {string index} {
    run {string index abc end}
test string-5.8 {string index} {
    string index abc end
} c
test string-5.9.$noComp {string index} {
    run {string index abc end-1}
test string-5.9 {string index} {
    string index abc end-1
} b
test string-5.10.$noComp {string index, unicode} {
    run {string index abc\u7266d 4}
test string-5.10 {string index, unicode} {
    string index abc\u7266d 4
} d
test string-5.11.$noComp {string index, unicode} {
    run {string index abc\u7266d 3}
test string-5.11 {string index, unicode} {
    string index abc\u7266d 3
} \u7266
test string-5.12.$noComp {string index, unicode over char length, under byte length} -body {
    run {string index \334\374\334\374 6}
} -result {}
test string-5.13.$noComp {string index, bytearray object} {
    run {string index [binary format a5 fuz] 0}
test string-5.12 {string index, unicode over char length, under byte length} {
    string index \334\374\334\374 6
} {}
test string-5.13 {string index, bytearray object} {
    string index [binary format a5 fuz] 0
} f
test string-5.14.$noComp {string index, bytearray object} {
    run {string index [binary format I* {0x50515253 0x52}] 3}
test string-5.14 {string index, bytearray object} {
    string index [binary format I* {0x50515253 0x52}] 3
} S
test string-5.15.$noComp {string index, bytearray object} {
test string-5.15 {string index, bytearray object} {
    set b [binary format I* {0x50515253 0x52}]
    set i1 [run {string index $b end-6}]
    set i2 [run {string index $b 1}]
    run {string compare $i1 $i2}
    set i1 [string index $b end-6]
    set i2 [string index $b 1]
    string compare $i1 $i2
} 0
test string-5.16.$noComp {string index, bytearray object with string obj shimmering} {
test string-5.16 {string index, bytearray object with string obj shimmering} {
    set str "0123456789\x00 abcdedfghi"
    binary scan $str H* dump
    run {string compare [run {string index $str 10}] \x00}
    string compare [string index $str 10] \x00
} 0
test string-5.17.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" 0o8}} msg] $msg
} -match glob -result {1 {*}}
test string-5.18.$noComp {string index, bad integer} -body {
    list [catch {run {string index "abc" end-0o0289}} msg] $msg
} -match glob -result {1 {*}}
test string-5.19.$noComp {string index, bytearray object out of bounds} -body {
    run {string index [binary format I* {0x50515253 0x52}] -1}
} -result {}
test string-5.20.$noComp {string index, bytearray object out of bounds} -body {
    run {string index [binary format I* {0x50515253 0x52}] 20}
} -result {}
test string-5.17 {string index, bad integer} -body {
    list [catch {string index "abc" 0o8} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.18 {string index, bad integer} -body {
    list [catch {string index "abc" end-0o0289} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test string-5.19 {string index, bytearray object out of bounds} {
    string index [binary format I* {0x50515253 0x52}] -1
} {}
test string-5.20 {string index, bytearray object out of bounds} {
    string index [binary format I* {0x50515253 0x52}] 20
} {}
test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} -constraints fullutf -body {
    run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} -result [list \U100000 b {}]


proc largest_int {} {
    # This will give us what the largest valid int on this machine is,
    # so we can test for overflow properly below on >32 bit systems
    set int 1
    set exp 7; # assume we get at least 8 bits
    while {wide($int) > 0} { set int [expr {wide(1) << [incr exp]}] }
    return [expr {$int-1}]
}

test string-6.1.$noComp {string is, not enough args} {
    list [catch {run {string is}} msg] $msg
test string-6.1 {string is, too few args} {
    list [catch {string is} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.2.$noComp {string is, not enough args} {
    list [catch {run {string is alpha}} msg] $msg
test string-6.2 {string is, too few args} {
    list [catch {string is alpha} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.3.$noComp {string is, bad args} {
    list [catch {run {string is alpha -failin str}} msg] $msg
test string-6.3 {string is, bad args} {
    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.$noComp {string is, too many args} {
    list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
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.$noComp {string is, class check} {
    list [catch {run {string is bogus str}} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.6.$noComp {string is, ambiguous class} {
    list [catch {run {string is al str}} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.7.$noComp {string is alpha, all ok} {
    run {string is alpha -strict -failindex var abc}
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.$noComp {string is, error in var} {
    list [run {string is alpha -failindex var abc5def}] $var
test string-6.8 {string is, error in var} {
    list [string is alpha -failindex var abc5def] $var
} {0 3}
test string-6.9.$noComp {string is, var shouldn't get set} {
test string-6.9 {string is, var shouldn't get set} {
    catch {unset var}
    list [catch {run {string is alpha -failindex var abc; set var}} msg] $msg
    list [catch {string is alpha -failindex var abc; set var} msg] $msg
} {1 {can't read "var": no such variable}}
test string-6.10.$noComp {string is, ok on empty} {
    run {string is alpha {}}
test string-6.10 {string is, ok on empty} {
    string is alpha {}
} 1
test string-6.11.$noComp {string is, -strict check against empty} {
    run {string is alpha -strict {}}
test string-6.11 {string is, -strict check against empty} {
    string is alpha -strict {}
} 0
test string-6.12.$noComp {string is alnum, true} {
    run {string is alnum abc123}
test string-6.12 {string is alnum, true} {
    string is alnum abc123
} 1
test string-6.13.$noComp {string is alnum, false} {
    list [run {string is alnum -failindex var abc1.23}] $var
test string-6.13 {string is alnum, false} {
    list [string is alnum -failindex var abc1.23] $var
} {0 4}
test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xFC}" 1
test string-6.15.$noComp {string is alpha, true} {
    run {string is alpha abc}
test string-6.14 {string is alnum, unicode} {
    string is alnum abc\u00fc
} 1
test string-6.15 {string is alpha, true} {
    string is alpha abc
} 1
test string-6.16.$noComp {string is alpha, false} {
    list [run {string is alpha -fail var a1bcde}] $var
test string-6.16 {string is alpha, false} {
    list [string is alpha -fail var a1bcde] $var
} {0 1}
test string-6.17.$noComp {string is alpha, unicode} {
    run {string is alpha abc\374}
test string-6.17 {string is alpha, unicode} {
    string is alpha abc\374
} 1
test string-6.18.$noComp {string is ascii, true} {
    run {string is ascii abc\x7Fend\x00}
test string-6.18 {string is ascii, true} {
    string is ascii abc\u007Fend\u0000
} 1
test string-6.19.$noComp {string is ascii, false} {
    list [run {string is ascii -fail var abc\x00def\x80more}] $var
test string-6.19 {string is ascii, false} {
    list [string is ascii -fail var abc\u0000def\u0080more] $var
} {0 7}
test string-6.20.$noComp {string is boolean, true} {
    run {string is boolean true}
test string-6.20 {string is boolean, true} {
    string is boolean true
} 1
test string-6.21.$noComp {string is boolean, true} {
    run {string is boolean f}
test string-6.21 {string is boolean, true} {
    string is boolean f
} 1
test string-6.22.$noComp {string is boolean, true based on type} {
    run {string is bool [run {string compare a a}]}
test string-6.22 {string is boolean, true based on type} {
    string is bool [string compare a a]
} 1
test string-6.23.$noComp {string is boolean, false} {
    list [run {string is bool -fail var yada}] $var
test string-6.23 {string is boolean, false} {
    list [string is bool -fail var yada] $var
} {0 0}
test string-6.24.$noComp {string is digit, true} {
    run {string is digit 0123456789}
test string-6.24 {string is digit, true} {
    string is digit 0123456789
} 1
test string-6.25.$noComp {string is digit, false} {
    list [run {string is digit -fail var 0123\xDC567}] $var
test string-6.25 {string is digit, false} {
    list [string is digit -fail var 0123\u00dc567] $var
} {0 4}
test string-6.26.$noComp {string is digit, false} {
    list [run {string is digit -fail var +123567}] $var
test string-6.26 {string is digit, false} {
    list [string is digit -fail var +123567] $var
} {0 0}
test string-6.27.$noComp {string is double, true} {
    run {string is double 1}
test string-6.27 {string is double, true} {
    string is double 1
} 1
test string-6.28.$noComp {string is double, true} {
    run {string is double [expr double(1)]}
test string-6.28 {string is double, true} {
    string is double [expr double(1)]
} 1
test string-6.29.$noComp {string is double, true} {
    run {string is double 1.0}
test string-6.29 {string is double, true} {
    string is double 1.0
} 1
test string-6.30.$noComp {string is double, true} {
    run {string is double [run {string compare a a}]}
test string-6.30 {string is double, true} {
    string is double [string compare a a]
} 1
test string-6.31.$noComp {string is double, true} {
    run {string is double "   +1.0e-1  "}
test string-6.31 {string is double, true} {
    string is double "   +1.0e-1  "
} 1
test string-6.32.$noComp {string is double, true} {
    run {string is double "\n1.0\v"}
test string-6.32 {string is double, true} {
    string is double "\n1.0\v"
} 1
test string-6.33.$noComp {string is double, false} {
    list [run {string is double -fail var 1abc}] $var
test string-6.33 {string is double, false} {
    list [string is double -fail var 1abc] $var
} {0 1}
test string-6.34.$noComp {string is double, false} {
    list [run {string is double -fail var abc}] $var
test string-6.34 {string is double, false} {
    list [string is double -fail var abc] $var
} {0 0}
test string-6.35.$noComp {string is double, false} {
    list [run {string is double -fail var "   1.0e4e4  "}] $var
test string-6.35 {string is double, false} {
    list [string is double -fail var "   1.0e4e4  "] $var
} {0 8}
test string-6.36.$noComp {string is double, false} {
    list [run {string is double -fail var "\n"}] $var
test string-6.36 {string is double, false} {
    list [string is double -fail var "\n"] $var
} {0 0}
test string-6.37.$noComp {string is double, false on int overflow} -setup {
test string-6.37 {string is double, false on int overflow} -setup {
    set var priorValue
} -body {
    # Make it the largest int recognizable, with one more digit for overflow
    # Since bignums arrived in Tcl 8.5, the sense of this test changed.
    # Now integer values that exceed native limits become bignums, and
    # bignums can convert to doubles without error.
    list [run {string is double -fail var [largest_int]0}] $var
    list [string is double -fail var [largest_int]0] $var
} -result {1 priorValue}
# string-6.38 removed, underflow on input is no longer an error.
test string-6.39.$noComp {string is double, false} {
test string-6.39 {string is double, false} {
    # This test is non-portable because IRIX thinks
    # that .e1 is a valid double - this is really a bug
    # on IRIX as .e1 should NOT be a valid double
    #
    # Portable now. Tcl 8.5 does its own double parsing.

    list [run {string is double -fail var .e1}] $var
    list [string is double -fail var .e1] $var
} {0 0}
test string-6.40.$noComp {string is false, true} {
    run {string is false false}
test string-6.40 {string is false, true} {
    string is false false
} 1
test string-6.41.$noComp {string is false, true} {
    run {string is false FaLsE}
test string-6.41 {string is false, true} {
    string is false FaLsE
} 1
test string-6.42.$noComp {string is false, true} {
    run {string is false N}
test string-6.42 {string is false, true} {
    string is false N
} 1
test string-6.43.$noComp {string is false, true} {
    run {string is false 0}
test string-6.43 {string is false, true} {
    string is false 0
} 1
test string-6.44.$noComp {string is false, true} {
    run {string is false off}
test string-6.44 {string is false, true} {
    string is false off
} 1
test string-6.45.$noComp {string is false, false} {
    list [run {string is false -fail var abc}] $var
test string-6.45 {string is false, false} {
    list [string is false -fail var abc] $var
} {0 0}
test string-6.46.$noComp {string is false, false} {
test string-6.46 {string is false, false} {
    catch {unset var}
    list [run {string is false -fail var Y}] $var
    list [string is false -fail var Y] $var
} {0 0}
test string-6.47.$noComp {string is false, false} {
test string-6.47 {string is false, false} {
    catch {unset var}
    list [run {string is false -fail var offensive}] $var
    list [string is false -fail var offensive] $var
} {0 0}
test string-6.48.$noComp {string is integer, true} {
    run {string is integer +1234567890}
test string-6.48 {string is integer, true} {
    string is integer +1234567890
} 1
test string-6.49.$noComp {string is integer, true on type} {
    run {string is integer [expr int(50.0)]}
test string-6.49 {string is integer, true on type} {
    string is integer [expr int(50.0)]
} 1
test string-6.50.$noComp {string is integer, true} {
    run {string is integer [list -10]}
test string-6.50 {string is integer, true} {
    string is integer [list -10]
} 1
test string-6.51.$noComp {string is integer, true as hex} {
    run {string is integer 0xabcdef}
test string-6.51 {string is integer, true as hex} {
    string is integer 0xabcdef
} 1
test string-6.52.$noComp {string is integer, true as octal} {
    run {string is integer 012345}
test string-6.52 {string is integer, true as octal} {
    string is integer 012345
} 1
test string-6.53.$noComp {string is integer, true with whitespace} {
    run {string is integer "  \n1234\v"}
test string-6.53 {string is integer, true with whitespace} {
    string is integer "  \n1234\v"
} 1
test string-6.54.$noComp {string is integer, false} {
    list [run {string is integer -fail var 123abc}] $var
} {0 3}
test string-6.55.$noComp {string is integer, no overflow possible} {
    run {string is integer +[largest_int]0}
} 1
test string-6.56.$noComp {string is integer, false} {
    list [run {string is integer -fail var [expr double(1)]}] $var
test string-6.54 {string is integer, false} {
    list [string is integer -fail var 123abc] $var
} {0 3}
test string-6.55 {string is integer, false on overflow} {
    list [string is integer -fail var +[largest_int]0] $var
} {0 -1}
test string-6.56 {string is integer, false} {
    list [string is integer -fail var [expr double(1)]] $var
} {0 1}
test string-6.57.$noComp {string is integer, false} {
    list [run {string is integer -fail var "    "}] $var
test string-6.57 {string is integer, false} {
    list [string is integer -fail var "    "] $var
} {0 0}
test string-6.58.$noComp {string is integer, false on bad octal} {
    list [run {string is integer -fail var 0o36963}] $var
test string-6.58 {string is integer, false on bad octal} {
    list [string is integer -fail var 0o36963] $var
} {0 4}
test string-6.58.1.$noComp {string is integer, false on bad octal} {
    list [run {string is integer -fail var 0o36963}] $var
test string-6.58.1 {string is integer, false on bad octal} {
    list [string is integer -fail var 0o36963] $var
} {0 4}
test string-6.59.$noComp {string is integer, false on bad hex} {
    list [run {string is integer -fail var 0X345XYZ}] $var
test string-6.59 {string is integer, false on bad hex} {
    list [string is integer -fail var 0X345XYZ] $var
} {0 5}
test string-6.60.$noComp {string is lower, true} {
    run {string is lower abc}
test string-6.60 {string is lower, true} {
    string is lower abc
} 1
test string-6.61.$noComp {string is lower, unicode true} {
    run {string is lower abc\xFCue}
test string-6.61 {string is lower, unicode true} {
    string is lower abc\u00fcue
} 1
test string-6.62.$noComp {string is lower, false} {
    list [run {string is lower -fail var aBc}] $var
test string-6.62 {string is lower, false} {
    list [string is lower -fail var aBc] $var
} {0 1}
test string-6.63.$noComp {string is lower, false} {
    list [run {string is lower -fail var abc1}] $var
test string-6.63 {string is lower, false} {
    list [string is lower -fail var abc1] $var
} {0 3}
test string-6.64.$noComp {string is lower, unicode false} {
    list [run {string is lower -fail var ab\xDCUE}] $var
test string-6.64 {string is lower, unicode false} {
    list [string is lower -fail var ab\u00dcUE] $var
} {0 2}
test string-6.65.$noComp {string is space, true} {
    run {string is space " \t\n\v\f"}
test string-6.65 {string is space, true} {
    string is space " \t\n\v\f"
} 1
test string-6.66.$noComp {string is space, false} {
    list [run {string is space -fail var " \t\n\v1\f"}] $var
test string-6.66 {string is space, false} {
    list [string is space -fail var " \t\n\v1\f"] $var
} {0 4}
test string-6.67.$noComp {string is true, true} {
    run {string is true true}
} 1
test string-6.68.$noComp {string is true, true} {
    run {string is true TrU}
} 1
test string-6.69.$noComp {string is true, true} {
    run {string is true ye}
} 1
test string-6.70.$noComp {string is true, true} {
    run {string is true 1}
} 1
test string-6.71.$noComp {string is true, true} {
    run {string is true on}
} 1
test string-6.72.$noComp {string is true, false} {
    list [run {string is true -fail var onto}] $var
} {0 0}
test string-6.73.$noComp {string is true, false} {
} {0 4}
test string-6.67 {string is true, true} {
    catch {unset var}
    list [run {string is true -fail var 25}] $var
} {0 0}
test string-6.74.$noComp {string is true, false} {
    string is true true
} 1
test string-6.68 {string is true, true} {
    catch {unset var}
    list [run {string is true -fail var no}] $var
} {0 0}
test string-6.75.$noComp {string is upper, true} {
    run {string is upper ABC}
    string is true TrU
} 1
test string-6.69 {string is true, true} {
    string is true ye
} 1
test string-6.76.$noComp {string is upper, unicode true} {
    run {string is upper ABC\xDCUE}
test string-6.70 {string is true, true} {
    string is true 1
} 1
test string-6.77.$noComp {string is upper, false} {
test string-6.71 {string is true, true} {
    list [run {string is upper -fail var AbC}] $var
} {0 1}
test string-6.78.$noComp {string is upper, false} {
    list [run {string is upper -fail var AB2C}] $var
} {0 2}
test string-6.79.$noComp {string is upper, unicode false} {
    list [run {string is upper -fail var ABC\xFCue}] $var
} {0 3}
test string-6.80.$noComp {string is wordchar, true} {
    run {string is wordchar abc_123}
    string is true on
} 1
test string-6.81.$noComp {string is wordchar, unicode true} {
    run {string is wordchar abc\xFCab\xDCAB\u5001\U1D7CA}
} 1
test string-6.82.$noComp {string is wordchar, false} {
    list [run {string is wordchar -fail var abcd.ef}] $var
} {0 4}
test string-6.83.$noComp {string is wordchar, unicode false} {
    list [run {string is wordchar -fail var abc\x80def}] $var
} {0 3}
test string-6.84.$noComp {string is control} {
test string-6.72 {string is true, false} {
    list [string is true -fail var onto] $var
} {0 0}
test string-6.73 {string is true, false} {
    catch {unset var}
    list [string is true -fail var 25] $var
} {0 0}
test string-6.74 {string is true, false} {
    catch {unset var}
    list [string is true -fail var no] $var
} {0 0}
test string-6.75 {string is upper, true} {
    ## Control chars are in the ranges
    ## 00..1F && 7F..9F
    list [run {string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60}] $var
} {0 7}
test string-6.85.$noComp {string is control} {
    run {string is control \u0100}
} 0
test string-6.86.$noComp {string is graph} {
    string is upper ABC
} 1
test string-6.76 {string is upper, unicode true} {
    string is upper ABC\u00dcUE
} 1
test string-6.77 {string is upper, false} {
    ## graph is any print char, except space
    list [run {string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "}] $var
} {0 14}
test string-6.87.$noComp {string is print} {
    ## basically any printable char
    list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\x10"}] $var
} {0 15}
test string-6.88.$noComp {string is punct} {
    ## any graph char that isn't alnum
    list [run {string is punct -fail var "_!@#\xBEq0"}] $var
} {0 4}
test string-6.89.$noComp {string is xdigit} {
    list [run {string is xdigit -fail var 0123456789\x61bcdefABCDEFg}] $var
} {0 22}

    list [string is upper -fail var AbC] $var
} {0 1}
test string-6.78 {string is upper, false} {
    list [string is upper -fail var AB2C] $var
} {0 2}
test string-6.79 {string is upper, unicode false} {
    list [string is upper -fail var ABC\u00fcue] $var
} {0 3}
test string-6.80 {string is wordchar, true} {
    string is wordchar abc_123
} 1
test string-6.81 {string is wordchar, unicode true} {
    string is wordchar abc\u00fcab\u00dcAB\u5001
} 1
test string-6.82 {string is wordchar, false} {
    list [string is wordchar -fail var abcd.ef] $var
} {0 4}
test string-6.83 {string is wordchar, unicode false} {
test string-6.90.$noComp {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 [run {string is int -strict $num}]
    }
    list [string is wordchar -fail var abc\u0080def] $var
} {0 3}
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.91.$noComp {string is double, bad doubles} {
test string-6.84 {string is control} {
    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 [run {string is double -strict $num}]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.92.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    set x 0x10000000000000000
    run {string is integer $x}
} 1
test string-6.93.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    ## Control chars are in the ranges
    ## 00..1F && 7F..9F
    list [string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60] $var
} {0 7}
test string-6.85 {string is control} {
    string is control \u0100
} 0
test string-6.86 {string is graph} {
    ## graph is any print char, except space
    set x 0x10000000000000000
    append x ""
    run {string is integer $x}
} 1
test string-6.94.$noComp {string is integer, no 64-bit overflow} {
    # Bug 718878
    list [string is gra -fail var "0123abc!@#\$\u0100 "] $var
} {0 12}
test string-6.87 {string is print} {
    ## basically any printable char
    set x 0x10000000000000000
    run {string is integer [expr {$x}]}
} 1
test string-6.95.$noComp {string is wideinteger, true} {
    run {string is wideinteger +1234567890}
} 1
test string-6.96.$noComp {string is wideinteger, true on type} {
    run {string is wideinteger [expr wide(50.0)]}
} 1
test string-6.97.$noComp {string is wideinteger, true} {
    run {string is wideinteger [list -10]}
} 1
test string-6.98.$noComp {string is wideinteger, true as hex} {
    run {string is wideinteger 0xabcdef}
} 1
    list [string is print -fail var "0123abc!@#\$\u0100 \u0010"] $var
} {0 13}
test string-6.88 {string is punct} {
    ## any graph char that isn't alnum
    list [string is punct -fail var "_!@#\u00beq0"] $var
} {0 4}
test string-6.89 {string is xdigit} {
    list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var
} {0 22}

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.99.$noComp {string is wideinteger, true as octal} {
    run {string is wideinteger 0123456}
} 1
test string-6.100.$noComp {string is wideinteger, true with whitespace} {
    run {string is wideinteger "  \n1234\v"}
} 1
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
test string-6.101.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var 123abc}] $var
} {0 3}
test string-6.102.$noComp {string is wideinteger, false on overflow} {
    list [run {string is wideinteger -fail var +[largest_int]0}] $var
} {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.103.$noComp {string is wideinteger, false} {
test string-6.93 {string is integer, 32-bit overflow} {
    list [run {string is wideinteger -fail var [expr double(1)]}] $var
} {0 1}
    # Bug 718878
test string-6.104.$noComp {string is wideinteger, false} {
    list [run {string is wideinteger -fail var "    "}] $var
} {0 0}
    set x 0x100000000
test string-6.105.$noComp {string is wideinteger, false on bad octal} {
    list [run {string is wideinteger -fail var 0o36963}] $var
} {0 4}
    append x ""
test string-6.105.1.$noComp {string is wideinteger, false on bad octal} {
    list [run {string is wideinteger -fail var 0o36963}] $var
    list [string is integer -failindex var $x] $var
} {0 4}
test string-6.106.$noComp {string is wideinteger, false on bad hex} {
    list [run {string is wideinteger -fail var 0X345XYZ}] $var
} {0 5}
test string-6.107.$noComp {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 [run {string is wideinteger -strict $num}]
    }
} {0 -1}
test string-6.94 {string is integer, 32-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [string is integer -failindex var [expr {$x}]] $var
} {0 -1}
test string-6.95 {string is wideinteger, true} {
    string is wideinteger +1234567890
} 1
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.108.$noComp {string is double, Bug 1382287} {
    set x 2turtledoves
    run {string is double $x}
    run {string is double $x}
} 0
test string-6.109.$noComp {string is double, Bug 1360532} {
    run {string is double 1\xA0}
} 0
test string-6.110.$noComp {string is entier, true} {
    run {string is entier +1234567890}
test string-6.96 {string is wideinteger, true on type} {
    string is wideinteger [expr wide(50.0)]
} 1
test string-6.97 {string is wideinteger, true} {
    string is wideinteger [list -10]
} 1
test string-6.98 {string is wideinteger, true as hex} {
    string is wideinteger 0xabcdef
} 1
test string-6.111.$noComp {string is entier, true on type} {
    run {string is entier [expr wide(50.0)]}
test string-6.99 {string is wideinteger, true as octal} {
    string is wideinteger 0123456
} 1
test string-6.112.$noComp {string is entier, true} {
    run {string is entier [list -10]}
test string-6.100 {string is wideinteger, true with whitespace} {
    string is wideinteger "  \n1234\v"
} 1
test string-6.113.$noComp {string is entier, true as hex} {
    run {string is entier 0xabcdef}
test string-6.101 {string is wideinteger, false} {
} 1
test string-6.114.$noComp {string is entier, true as octal} {
    run {string is entier 0123456}
} 1
test string-6.115.$noComp {string is entier, true with whitespace} {
    run {string is entier "  \n1234\v"}
} 1
test string-6.116.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123abc}] $var
    list [string is wideinteger -fail var 123abc] $var
} {0 3}
test string-6.117.$noComp {string is entier, false} {
    list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var
} {0 84}
test string-6.118.$noComp {string is entier, false} {
    list [run {string is entier -fail var [expr double(1)]}] $var
test string-6.102 {string is wideinteger, false on overflow} {
    list [string is wideinteger -fail var +[largest_int]0] $var
} {0 -1}
test string-6.103 {string is wideinteger, false} {
    list [string is wideinteger -fail var [expr double(1)]] $var
} {0 1}
test string-6.119.$noComp {string is entier, false} {
    list [run {string is entier -fail var "    "}] $var
test string-6.104 {string is wideinteger, false} {
    list [string is wideinteger -fail var "    "] $var
} {0 0}
test string-6.120.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o36963}] $var
test string-6.105 {string is wideinteger, false on bad octal} {
    list [string is wideinteger -fail var 0o36963] $var
} {0 4}
test string-6.121.1.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o36963}] $var
test string-6.105.1 {string is wideinteger, false on bad octal} {
    list [string is wideinteger -fail var 0o36963] $var
} {0 4}
test string-6.122.$noComp {string is entier, false on bad hex} {
    list [run {string is entier -fail var 0X345XYZ}] $var
test string-6.106 {string is wideinteger, false on bad hex} {
    list [string is wideinteger -fail var 0X345XYZ] $var
} {0 5}
test string-6.123.$noComp {string is entier, bad integers} {
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 [run {string is entier -strict $num}]
	lappend result [string is wideinteger -strict $num]
    }
    return $result
    set result
} {1 1 0 0 0 1 0 0}
test string-6.124.$noComp {string is entier, true} {
test string-6.108 {string is double, Bug 1382287} {
    run {string is entier +1234567890123456789012345678901234567890}
} 1
test string-6.125.$noComp {string is entier, true} {
    set x 2turtledoves
    string is double $x
    run {string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]}
} 1
test string-6.126.$noComp {string is entier, true as hex} {
    string is double $x
    run {string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef}
} 1
test string-6.127.$noComp {string is entier, true as octal} {
    run {string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456}
} 1
test string-6.128.$noComp {string is entier, true with whitespace} {
} 0
test string-6.109 {string is double, Bug 1360532} {
    string is double 1\u00a0
} 0

catch {rename largest_int {}}
    run {string is entier "  \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"}
} 1
test string-6.129.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.130.1.$noComp {string is entier, false on bad octal} {
    list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
test string-6.131.$noComp {string is entier, false on bad hex} {
    list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
} {0 88}

catch {rename largest_int {}}

test string-7.1 {string last, too few args} {
test string-7.1.$noComp {string last, not enough args} {
    list [catch {run {string last a}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.2.$noComp {string last, bad args} {
    list [catch {run {string last a b c}} msg] $msg
    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} {
    list [catch {string last a b c} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test string-7.3.$noComp {string last, too many args} {
    list [catch {run {string last a b c d}} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
test string-7.4.$noComp {string last} {
    run {string la xxx xxxx123xx345x678}
test string-7.3 {string last, too many args} {
    list [catch {string last a b c d} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.4 {string last} {
    string la xxx xxxx123xx345x678
} 1
test string-7.5 {string last} {
    string last xx xxxx123xx345x678
} 7
test string-7.6 {string last} {
    string las x xxxx123xx345x678
} 12
test string-7.7 {string last, unicode} {
    string las x xxxx12\u7266xx345x678
} 12
test string-7.5.$noComp {string last} {
    run {string last xx xxxx123xx345x678}
} 7
test string-7.6.$noComp {string last} {
    run {string las x xxxx123xx345x678}
} 12
test string-7.7.$noComp {string last, unicode} {
test string-7.8 {string last, unicode} {
    run {string las x xxxx12\u7266xx345x678}
} 12
test string-7.8.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
    string las \u7266 xxxx12\u7266xx345x678
} 6
test string-7.9.$noComp {string last, stop index} {
    run {string las \u7266 xxxx12\u7266xx345x678}
test string-7.9 {string last, stop index} {
    string las \u7266 xxxx12\u7266xx345x678
} 6
test string-7.10.$noComp {string last, unicode} {
    run {string las \u7266 xxxx12\u7266xx345x678}
test string-7.10 {string last, unicode} {
    string las \u7266 xxxx12\u7266xx345x678
} 6
test string-7.11.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 3}
test string-7.11 {string last, start index} {
    string last \u7266 abc\u7266x 3
} 3
test string-7.12.$noComp {string last, start index} {
    run {string last \u7266 abc\u7266x 2}
test string-7.12 {string last, start index} {
    string last \u7266 abc\u7266x 2
} -1
test string-7.13.$noComp {string last, start index} {
test string-7.13 {string last, start index} {
    ## Constrain to last 'a' should work
    string last ba badbad end-1
} 3
test string-7.14 {string last, start index} {
    ## Constrain to last 'b' should skip last 'ba'
    run {string last ba badbad end-1}
} 3
test string-7.14.$noComp {string last, start index} {
    ## Constrain to last 'b' should skip last 'ba'
    run {string last ba badbad end-2}
    string last ba badbad end-2
} 0
test string-7.15.$noComp {string last, start index} {
    run {string last \334a \334ad\334ad 0}
test string-7.15 {string last, start index} {
    string last \334a \334ad\334ad 0
} -1
test string-7.16.$noComp {string last, start index} {
    run {string last \334a \334ad\334ad end-1}
test string-7.16 {string last, start index} {
    string last \334a \334ad\334ad end-1
} 3

test string-8.1.$noComp {string bytelength} {
    list [catch {run {string bytelength}} msg] $msg
test string-8.1 {string bytelength} {
    list [catch {string bytelength} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.2.$noComp {string bytelength} {
    list [catch {run {string bytelength a b}} msg] $msg
test string-8.2 {string bytelength} {
    list [catch {string bytelength a b} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test string-8.3.$noComp {string bytelength} {
    run {string bytelength "\xC7"}
test string-8.3 {string bytelength} {
    string bytelength "\u00c7"
} 2
test string-8.4.$noComp {string bytelength} {
    run {string b ""}
test string-8.4 {string bytelength} {
    string b ""
} 0

test string-9.1 {string length} {
    list [catch {string length} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.1.$noComp {string length} {
test string-9.2 {string length} {
    list [catch {run {string length}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.2.$noComp {string length} {
    list [catch {run {string length a b}} msg] $msg
    list [catch {string length a b} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test string-9.3.$noComp {string length} {
    run {string length "a little string"}
test string-9.3 {string length} {
    string length "a little string"
} 15
test string-9.4.$noComp {string length} {
    run {string le ""}
test string-9.4 {string length} {
    string le ""
} 0
test string-9.5.$noComp {string length, unicode} {
    run {string le "abcd\u7266"}
test string-9.5 {string length, unicode} {
    string le "abcd\u7266"
} 5
test string-9.6.$noComp {string length, bytearray object} {
    run {string length [binary format a5 foo]}
test string-9.6 {string length, bytearray object} {
    string length [binary format a5 foo]
} 5
test string-9.7.$noComp {string length, bytearray object} {
    run {string length [binary format I* {0x50515253 0x52}]}
test string-9.7 {string length, bytearray object} {
    string length [binary format I* {0x50515253 0x52}]
} 8

test string-10.1.$noComp {string map, not enough args} {
    list [catch {run {string map}} msg] $msg
test string-10.1 {string map, too few args} {
    list [catch {string map} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
test string-10.2.$noComp {string map, bad args} {
    list [catch {run {string map {a b} abba oops}} msg] $msg
test string-10.2 {string map, bad args} {
    list [catch {string map {a b} abba oops} msg] $msg
} {1 {bad option "a b": must be -nocase}}
test string-10.3.$noComp {string map, too many args} {
    list [catch {run {string map -nocase {a b} str1 str2}} msg] $msg
test string-10.3 {string map, too many args} {
    list [catch {string map -nocase {a b} str1 str2} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
test string-10.4.$noComp {string map} {
    run {string map {a b} abba}
test string-10.4 {string map} {
    string map {a b} abba
} {bbbb}
test string-10.5.$noComp {string map} {
    run {string map {a b} a}
test string-10.5 {string map} {
    string map {a b} a
} {b}
test string-10.6.$noComp {string map -nocase} {
    run {string map -nocase {a b} Abba}
test string-10.6 {string map -nocase} {
    string map -nocase {a b} Abba
} {bbbb}
test string-10.7.$noComp {string map} {
    run {string map {abc 321 ab * a A} aabcabaababcab}
test string-10.7 {string map} {
    string map {abc 321 ab * a A} aabcabaababcab
} {A321*A*321*}
test string-10.8.$noComp {string map -nocase} {
    run {string map -nocase {aBc 321 Ab * a A} aabcabaababcab}
test string-10.8 {string map -nocase} {
    string map -nocase {aBc 321 Ab * a A} aabcabaababcab
} {A321*A*321*}
test string-10.9.$noComp {string map -nocase} {
    run {string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb}
test string-10.9 {string map -nocase} {
    string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb
} {A321*A*321*}
test string-10.10.$noComp {string map} {
    list [catch {run {string map {a b c} abba}} msg] $msg
test string-10.10 {string map} {
    list [catch {string map {a b c} abba} msg] $msg
} {1 {char map list unbalanced}}
test string-10.11.$noComp {string map, nulls} {
    run {string map {\x00 NULL blah \x00nix} {qwerty}}
test string-10.11 {string map, nulls} {
    string map {\x00 NULL blah \x00nix} {qwerty}
} {qwerty}
test string-10.12.$noComp {string map, unicode} {
    run {string map [list \374 ue UE \334] "a\374ueUE\000EU"}
test string-10.12 {string map, unicode} {
    string map [list \374 ue UE \334] "a\374ueUE\000EU"
} aueue\334\0EU
test string-10.13.$noComp {string map, -nocase unicode} {
    run {string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"}
test string-10.13 {string map, -nocase unicode} {
    string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
} aue\334\334\0EU
test string-10.14.$noComp {string map, -nocase null arguments} {
    run {string map -nocase {{} abc} foo}
test string-10.14 {string map, -nocase null arguments} {
    string map -nocase {{} abc} foo
} foo
test string-10.15.$noComp {string map, one pair case} {
    run {string map -nocase {abc 32} aAbCaBaAbAbcAb}
test string-10.15 {string map, one pair case} {
    string map -nocase {abc 32} aAbCaBaAbAbcAb
} {a32aBaAb32Ab}
test string-10.16.$noComp {string map, one pair case} {
    run {string map -nocase {ab 4321} aAbCaBaAbAbcAb}
test string-10.16 {string map, one pair case} {
    string map -nocase {ab 4321} aAbCaBaAbAbcAb
} {a4321C4321a43214321c4321}
test string-10.17.$noComp {string map, one pair case} {
    run {string map {Ab 4321} aAbCaBaAbAbcAb}
test string-10.17 {string map, one pair case} {
    string map {Ab 4321} aAbCaBaAbAbcAb
} {a4321CaBa43214321c4321}
test string-10.18.$noComp {string map, empty argument} {
    run {string map -nocase {{} abc} foo}
test string-10.18 {string map, empty argument} {
    string map -nocase {{} abc} foo
} foo
test string-10.19.$noComp {string map, empty arguments} {
    run {string map -nocase {{} abc f bar {} def} foo}
test string-10.19 {string map, empty arguments} {
    string map -nocase {{} abc f bar {} def} foo
} baroo
test string-10.20.$noComp {string map, dictionaries don't alter map ordering} {
test string-10.20 {string map, dictionaries don't alter map ordering} {
    set map {aa X a Y}
    list [run {string map [dict create aa X a Y] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}]
    list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
} {XY XY 2 XY}
test string-10.20.1.$noComp {string map, dictionaries don't alter map ordering} {
    set map {a X b Y a Z}
    list [run {string map [dict create a X b Y a Z] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}]
} {ZZZ XXX 2 XXX}
test string-10.21.$noComp {string map, ABR checks} {
    run {string map {longstring foob} long}
test string-10.21 {string map, ABR checks} {
    string map {longstring foob} long
} long
test string-10.22.$noComp {string map, ABR checks} {
    run {string map {long foob} long}
test string-10.22 {string map, ABR checks} {
    string map {long foob} long
} foob
test string-10.23.$noComp {string map, ABR checks} {
    run {string map {lon foob} long}
test string-10.23 {string map, ABR checks} {
    string map {lon foob} long
} foobg
test string-10.24.$noComp {string map, ABR checks} {
    run {string map {lon foob} longlo}
test string-10.24 {string map, ABR checks} {
    string map {lon foob} longlo
} foobglo
test string-10.25.$noComp {string map, ABR checks} {
    run {string map {lon foob} longlon}
test string-10.25 {string map, ABR checks} {
    string map {lon foob} longlon
} foobgfoob
test string-10.26.$noComp {string map, ABR checks} {
    run {string map {longstring foob longstring bar} long}
test string-10.26 {string map, ABR checks} {
    string map {longstring foob longstring bar} long
} long
test string-10.27 {string map, ABR checks} {
    string map {long foob longstring bar} long
} foob
test string-10.27.$noComp {string map, ABR checks} {
test string-10.28 {string map, ABR checks} {
    run {string map {long foob longstring bar} long}
} foob
test string-10.28.$noComp {string map, ABR checks} {
    run {string map {lon foob longstring bar} long}
    string map {lon foob longstring bar} long
} foobg
test string-10.29.$noComp {string map, ABR checks} {
    run {string map {lon foob longstring bar} longlo}
test string-10.29 {string map, ABR checks} {
    string map {lon foob longstring bar} longlo
} foobglo
test string-10.30.$noComp {string map, ABR checks} {
    run {string map {lon foob longstring bar} longlon}
test string-10.30 {string map, ABR checks} {
    string map {lon foob longstring bar} longlon
} foobgfoob
test string-10.31.$noComp {string map, nasty sharing crash from [Bug 1018562]} {
test string-10.31 {string map, nasty sharing crash from [Bug 1018562]} {
    set a {a b}
    run {string map $a $a}
    string map $a $a
} {b b}

test string-11.1.$noComp {string match, not enough args} {
    list [catch {run {string match a}} msg] $msg
test string-11.1 {string match, too few args} {
    list [catch {string match a} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.2.$noComp {string match, too many args} {
    list [catch {run {string match a b c d}} msg] $msg
test string-11.2 {string match, too many args} {
    list [catch {string match a b c d} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test string-11.3.$noComp {string match} {
    run {string match abc abc}
test string-11.3 {string match} {
    string match abc abc
} 1
test string-11.4.$noComp {string match} {
    run {string mat abc abd}
test string-11.4 {string match} {
    string mat abc abd
} 0
test string-11.5.$noComp {string match} {
    run {string match ab*c abc}
test string-11.5 {string match} {
    string match ab*c abc
} 1
test string-11.6.$noComp {string match} {
    run {string match ab**c abc}
test string-11.6 {string match} {
    string match ab**c abc
} 1
test string-11.7.$noComp {string match} {
    run {string match ab* abcdef}
test string-11.7 {string match} {
    string match ab* abcdef
} 1
test string-11.8.$noComp {string match} {
    run {string match *c abc}
test string-11.8 {string match} {
    string match *c abc
} 1
test string-11.9.$noComp {string match} {
    run {string match *3*6*9 0123456789}
test string-11.9 {string match} {
    string match *3*6*9 0123456789
} 1
test string-11.9.1.$noComp {string match} {
    run {string match *3*6*89 0123456789}
test string-11.9.1 {string match} {
    string match *3*6*89 0123456789
} 1
test string-11.9.2.$noComp {string match} {
    run {string match *3*456*89 0123456789}
test string-11.9.2 {string match} {
    string match *3*456*89 0123456789
} 1
test string-11.9.3.$noComp {string match} {
    run {string match *3*6* 0123456789}
test string-11.9.3 {string match} {
    string match *3*6* 0123456789
} 1
test string-11.9.4.$noComp {string match} {
    run {string match *3*56* 0123456789}
test string-11.9.4 {string match} {
    string match *3*56* 0123456789
} 1
test string-11.9.5.$noComp {string match} {
    run {string match *3*456*** 0123456789}
test string-11.9.5 {string match} {
    string match *3*456*** 0123456789
} 1
test string-11.9.6.$noComp {string match} {
    run {string match **3*456** 0123456789}
test string-11.9.6 {string match} {
    string match **3*456** 0123456789
} 1
test string-11.9.7.$noComp {string match} {
    run {string match *3***456* 0123456789}
test string-11.9.7 {string match} {
    string match *3***456* 0123456789
} 1
test string-11.9.8.$noComp {string match} {
    run {string match *3***\[456]* 0123456789}
test string-11.9.8 {string match} {
    string match *3***\[456]* 0123456789
} 1
test string-11.9.9.$noComp {string match} {
    run {string match *3***\[4-6]* 0123456789}
test string-11.9.9 {string match} {
    string match *3***\[4-6]* 0123456789
} 1
test string-11.9.10.$noComp {string match} {
    run {string match *3***\[4-6] 0123456789}
test string-11.9.10 {string match} {
    string match *3***\[4-6] 0123456789
} 0
test string-11.9.11.$noComp {string match} {
    run {string match *3***\[4-6] 0123456}
test string-11.9.11 {string match} {
    string match *3***\[4-6] 0123456
} 1
test string-11.10.$noComp {string match} {
    run {string match *3*6*9 01234567890}
test string-11.10 {string match} {
    string match *3*6*9 01234567890
} 0
test string-11.10.1.$noComp {string match} {
    run {string match *3*6*89 01234567890}
test string-11.10.1 {string match} {
    string match *3*6*89 01234567890
} 0
test string-11.10.2.$noComp {string match} {
    run {string match *3*456*89 01234567890}
test string-11.10.2 {string match} {
    string match *3*456*89 01234567890
} 0
test string-11.10.3.$noComp {string match} {
    run {string match **3*456*89 01234567890}
test string-11.10.3 {string match} {
    string match **3*456*89 01234567890
} 0
test string-11.10.4.$noComp {string match} {
    run {string match *3*456***89 01234567890}
test string-11.10.4 {string match} {
    string match *3*456***89 01234567890
} 0
test string-11.11.$noComp {string match} {
    run {string match a?c abc}
test string-11.11 {string match} {
    string match a?c abc
} 1
test string-11.12.$noComp {string match} {
    run {string match a??c abc}
test string-11.12 {string match} {
    string match a??c abc
} 0
test string-11.13.$noComp {string match} {
    run {string match ?1??4???8? 0123456789}
test string-11.13 {string match} {
    string match ?1??4???8? 0123456789
} 1
test string-11.14.$noComp {string match} {
    run {string match {[abc]bc} abc}
test string-11.14 {string match} {
    string match {[abc]bc} abc
} 1
test string-11.15.$noComp {string match} {
    run {string match {a[abc]c} abc}
test string-11.15 {string match} {
    string match {a[abc]c} abc
} 1
test string-11.16.$noComp {string match} {
    run {string match {a[xyz]c} abc}
test string-11.16 {string match} {
    string match {a[xyz]c} abc
} 0
test string-11.17.$noComp {string match} {
    run {string match {12[2-7]45} 12345}
test string-11.17 {string match} {
    string match {12[2-7]45} 12345
} 1
test string-11.18.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12345}
test string-11.18 {string match} {
    string match {12[ab2-4cd]45} 12345
} 1
test string-11.19.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12b45}
test string-11.19 {string match} {
    string match {12[ab2-4cd]45} 12b45
} 1
test string-11.20.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12d45}
test string-11.20 {string match} {
    string match {12[ab2-4cd]45} 12d45
} 1
test string-11.21.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12145}
test string-11.21 {string match} {
    string match {12[ab2-4cd]45} 12145
} 0
test string-11.22.$noComp {string match} {
    run {string match {12[ab2-4cd]45} 12545}
test string-11.22 {string match} {
    string match {12[ab2-4cd]45} 12545
} 0
test string-11.23.$noComp {string match} {
    run {string match {a\*b} a*b}
test string-11.23 {string match} {
    string match {a\*b} a*b
} 1
test string-11.24.$noComp {string match} {
    run {string match {a\*b} ab}
test string-11.24 {string match} {
    string match {a\*b} ab
} 0
test string-11.25.$noComp {string match} {
    run {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
test string-11.25 {string match} {
    string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
} 1
test string-11.26.$noComp {string match} {
    run {string match ** ""}
test string-11.26 {string match} {
    string match ** ""
} 1
test string-11.27.$noComp {string match} {
    run {string match *. ""}
test string-11.27 {string match} {
    string match *. ""
} 0
test string-11.28.$noComp {string match} {
    run {string match "" ""}
test string-11.28 {string match} {
    string match "" ""
} 1
test string-11.29.$noComp {string match} {
    run {string match \[a a}
test string-11.29 {string match} {
    string match \[a a
} 1
test string-11.30.$noComp {string match, bad args} {
    list [catch {run {string match - b c}} msg] $msg
test string-11.30 {string match, bad args} {
    list [catch {string match - b c} msg] $msg
} {1 {bad option "-": must be -nocase}}
test string-11.31.$noComp {string match case} {
    run {string match a A}
test string-11.31 {string match case} {
    string match a A
} 0
test string-11.32.$noComp {string match nocase} {
    run {string match -n a A}
test string-11.32 {string match nocase} {
    string match -n a A
} 1
test string-11.33.$noComp {string match nocase} {
    run {string match -nocase a\334 A\374}
test string-11.33 {string match nocase} {
    string match -nocase a\334 A\374
} 1
test string-11.34.$noComp {string match nocase} {
    run {string match -nocase a*f ABCDEf}
test string-11.34 {string match nocase} {
    string match -nocase a*f ABCDEf
} 1
test string-11.35.$noComp {string match case, false hope} {
test string-11.35 {string match case, false hope} {
    # This is true because '_' lies between the A-Z and a-z ranges
    run {string match {[A-z]} _}
    string match {[A-z]} _
} 1
test string-11.36.$noComp {string match nocase range} {
test string-11.36 {string match nocase range} {
    # This is false because although '_' lies between the A-Z and a-z ranges,
    # we lower case the end points before checking the ranges.
    run {string match -nocase {[A-z]} _}
    string match -nocase {[A-z]} _
} 0
test string-11.37.$noComp {string match nocase} {
    run {string match -nocase {[A-fh-Z]} g}
test string-11.37 {string match nocase} {
    string match -nocase {[A-fh-Z]} g
} 0
test string-11.38.$noComp {string match case, reverse range} {
    run {string match {[A-fh-Z]} g}
test string-11.38 {string match case, reverse range} {
    string match {[A-fh-Z]} g
} 1
test string-11.39.$noComp {string match, *\ case} {
    run {string match {*\abc} abc}
test string-11.39 {string match, *\ case} {
    string match {*\abc} abc
} 1
test string-11.39.1.$noComp {string match, *\ case} {
    run {string match {*ab\c} abc}
test string-11.39.1 {string match, *\ case} {
    string match {*ab\c} abc
} 1
test string-11.39.2.$noComp {string match, *\ case} {
    run {string match {*ab\*} ab*}
test string-11.39.2 {string match, *\ case} {
    string match {*ab\*} ab*
} 1
test string-11.39.3.$noComp {string match, *\ case} {
    run {string match {*ab\*} abc}
test string-11.39.3 {string match, *\ case} {
    string match {*ab\*} abc
} 0
test string-11.39.4.$noComp {string match, *\ case} {
    run {string match {*ab\\*} {ab\c}}
test string-11.39.4 {string match, *\ case} {
    string match {*ab\\*} {ab\c}
} 1
test string-11.39.5.$noComp {string match, *\ case} {
    run {string match {*ab\\*} {ab\*}}
test string-11.39.5 {string match, *\ case} {
    string match {*ab\\*} {ab\*}
} 1
test string-11.40.$noComp {string match, *special case} {
    run {string match {*[ab]} abc}
test string-11.40 {string match, *special case} {
    string match {*[ab]} abc
} 0
test string-11.41.$noComp {string match, *special case} {
    run {string match {*[ab]*} abc}
test string-11.41 {string match, *special case} {
    string match {*[ab]*} abc
} 1
test string-11.42.$noComp {string match, *special case} {
    run {string match "*\\" "\\"}
test string-11.42 {string match, *special case} {
    string match "*\\" "\\"
} 0
test string-11.43.$noComp {string match, *special case} {
    run {string match "*\\\\" "\\"}
test string-11.43 {string match, *special case} {
    string match "*\\\\" "\\"
} 1
test string-11.44.$noComp {string match, *special case} {
    run {string match "*???" "12345"}
test string-11.44 {string match, *special case} {
    string match "*???" "12345"
} 1
test string-11.45.$noComp {string match, *special case} {
    run {string match "*???" "12"}
test string-11.45 {string match, *special case} {
    string match "*???" "12"
} 0
test string-11.46.$noComp {string match, *special case} {
    run {string match "*\\*" "abc*"}
test string-11.46 {string match, *special case} {
    string match "*\\*" "abc*"
} 1
test string-11.47.$noComp {string match, *special case} {
    run {string match "*\\*" "*"}
test string-11.47 {string match, *special case} {
    string match "*\\*" "*"
} 1
test string-11.48.$noComp {string match, *special case} {
    run {string match "*\\*" "*abc"}
test string-11.48 {string match, *special case} {
    string match "*\\*" "*abc"
} 0
test string-11.49.$noComp {string match, *special case} {
    run {string match "?\\*" "a*"}
test string-11.49 {string match, *special case} {
    string match "?\\*" "a*"
} 1
test string-11.50.$noComp {string match, *special case} {
    run {string match "\\" "\\"}
test string-11.50 {string match, *special case} {
    string match "\\" "\\"
} 0
test string-11.51.$noComp {string match; *, -nocase and UTF-8} {
    run {string match -nocase [binary format I 717316707] \
	    [binary format I 2028036707]}
test string-11.51 {string match; *, -nocase and UTF-8} {
    string match -nocase [binary format I 717316707] \
	    [binary format I 2028036707]
} 1
test string-11.52.$noComp {string match, null char in string} {
test string-11.52 {string match, null char in string} {
    set out ""
    set ptn "*abc*"
    foreach elem [list "\x00@abc" "@abc" "\x00@abc\x00" "blahabcblah"] {
	lappend out [run {string match $ptn $elem}]
    foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] {
	lappend out [string match $ptn $elem]
    }
    set out
} {1 1 1 1}
test string-11.53.$noComp {string match, null char in pattern} {
test string-11.53 {string match, null char in pattern} {
    set out ""
    foreach {ptn elem} [list \
	    "*\x00abc\x00"  "\x00abc\x00" \
	    "*\x00abc\x00"  "\x00abc\x00ef" \
	    "*\x00abc\x00*" "\x00abc\x00ef" \
	    "*\x00abc\x00"  "@\x00abc\x00ef" \
	    "*\x00abc\x00*"  "@\x00abc\x00ef" \
	    "*\u0000abc\u0000"  "\u0000abc\u0000" \
	    "*\u0000abc\u0000"  "\u0000abc\u0000ef" \
	    "*\u0000abc\u0000*" "\u0000abc\u0000ef" \
	    "*\u0000abc\u0000"  "@\u0000abc\u0000ef" \
	    "*\u0000abc\u0000*"  "@\u0000abc\u0000ef" \
	    ] {
	lappend out [run {string match $ptn $elem}]
	lappend out [string match $ptn $elem]
    }
    set out
} {1 0 1 0 1}
test string-11.54.$noComp {string match, failure} {
test string-11.54 {string match, failure} {
    set longString ""
    for {set i 0} {$i < 10} {incr i} {
	append longString "abcdefghijklmnopqrstuvwxy\x00z01234567890123"
	append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123"
    }
    run {string first $longString 123}
    list [run {string match *cba* $longString}] \
    string first $longString 123
    list [string match *cba* $longString] \
	    [run {string match *a*l*\x00* $longString}] \
	    [run {string match *a*l*\x00*123 $longString}] \
	    [run {string match *a*l*\x00*123* $longString}] \
	    [run {string match *a*l*\x00*cba* $longString}] \
	    [run {string match *===* $longString}]
	    [string match *a*l*\u0000* $longString] \
	    [string match *a*l*\u0000*123 $longString] \
	    [string match *a*l*\u0000*123* $longString] \
	    [string match *a*l*\u0000*cba* $longString] \
	    [string match *===* $longString]
} {0 1 1 1 0 0}
test string-11.55.$noComp {string match, invalid binary optimization} {
test string-11.55 {string match, invalid binary optimization} {
    [format string] match \u0141 [binary format c 65]
} 0

test stringComp-12.1.0.$noComp {Bug 3588366: end-offsets before start} {
    apply {s {
        string range $s 0 end-5
test string-12.1 {string range} {
    }} 12345
} {}
test string-12.1.$noComp {string range} {
    list [catch {string range} msg] $msg
    list [catch {run {string range}} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
test string-12.2.$noComp {string range} {
    list [catch {run {string range a 1}} msg] $msg
test string-12.2 {string range} {
    list [catch {string range a 1} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
test string-12.3.$noComp {string range} {
    list [catch {run {string range a 1 2 3}} msg] $msg
test string-12.3 {string range} {
    list [catch {string range a 1 2 3} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
test string-12.4.$noComp {string range} {
    run {string range abcdefghijklmnop 2 14}
test string-12.4 {string range} {
    string range abcdefghijklmnop 2 14
} {cdefghijklmno}
test string-12.5.$noComp {string range, last > length} {
    run {string range abcdefghijklmnop 7 1000}
test string-12.5 {string range, last > length} {
    string range abcdefghijklmnop 7 1000
} {hijklmnop}
test string-12.6.$noComp {string range} {
    run {string range abcdefghijklmnop 10 end}
test string-12.6 {string range} {
    string range abcdefghijklmnop 10 end
} {klmnop}
test string-12.7.$noComp {string range, last < first} {
    run {string range abcdefghijklmnop 10 9}
test string-12.7 {string range, last < first} {
    string range abcdefghijklmnop 10 9
} {}
test string-12.8.$noComp {string range, first < 0} {
    run {string range abcdefghijklmnop -3 2}
test string-12.8 {string range, first < 0} {
    string range abcdefghijklmnop -3 2
} {abc}
test string-12.9.$noComp {string range} {
    run {string range abcdefghijklmnop -3 -2}
test string-12.9 {string range} {
    string range abcdefghijklmnop -3 -2
} {}
test string-12.10.$noComp {string range} {
    run {string range abcdefghijklmnop 1000 1010}
test string-12.10 {string range} {
    string range abcdefghijklmnop 1000 1010
} {}
test string-12.11.$noComp {string range} {
    run {string range abcdefghijklmnop -100 end}
test string-12.11 {string range} {
    string range abcdefghijklmnop -100 end
} {abcdefghijklmnop}
test string-12.12.$noComp {string range} {
    list [catch {run {string range abc abc 1}} msg] $msg
test string-12.12 {string range} {
    list [catch {string range abc abc 1} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
test string-12.13.$noComp {string range} {
    list [catch {run {string range abc 1 eof}} msg] $msg
test string-12.13 {string range} {
    list [catch {string range abc 1 eof} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
test string-12.14.$noComp {string range} {
    run {string range abcdefghijklmnop end-1 end}
test string-12.14 {string range} {
    string range abcdefghijklmnop end-1 end
} {op}
test string-12.15.$noComp {string range} {
    run {string range abcdefghijklmnop end 1000}
test string-12.15 {string range} {
    string range abcdefghijklmnop end 1000
} {p}
test string-12.16.$noComp {string range} {
    run {string range abcdefghijklmnop end end-1}
test string-12.16 {string range} {
    string range abcdefghijklmnop end end-1
} {}
test string-12.17.$noComp {string range, unicode} {
    run {string range ab\u7266cdefghijklmnop 5 5}
test string-12.17 {string range, unicode} {
    string range ab\u7266cdefghijklmnop 5 5
} e
test string-12.18.$noComp {string range, unicode} {
    run {string range ab\u7266cdefghijklmnop 2 3}
test string-12.18 {string range, unicode} {
    string range ab\u7266cdefghijklmnop 2 3
} \u7266c
test string-12.19.$noComp {string range, bytearray object} {
test string-12.19 {string range, bytearray object} {
    set b [binary format I* {0x50515253 0x52}]
    set r1 [run {string range $b 1 end-1}]
    set r2 [run {string range $b 1 6}]
    run {string equal $r1 $r2}
    set r1 [string range $b 1 end-1]
    set r2 [string range $b 1 6]
    string equal $r1 $r2
} 1
test string-12.20.$noComp {string range, out of bounds indices} {
    run {string range \xFF 0 1}
} \xFF
test string-12.20 {string range, out of bounds indices} {
    string range \u00ff 0 1
} \u00ff
# Bug 1410553
test string-12.21.$noComp {string range, regenerates correct reps, bug 1410553} {
test string-12.21 {string range, regenerates correct reps, bug 1410553} {
    set bytes "\x00 \x03 \x41"
    set rxBuffer {}
    foreach ch $bytes {
	append rxBuffer $ch
	if {$ch eq "\x03"} {
	    run {string length $rxBuffer}
	    string length $rxBuffer
	}
    }
    set rxCRC [run {string range $rxBuffer end-1 end}]
    set rxCRC [string range $rxBuffer end-1 end]
    binary scan [join $bytes {}] "H*" input_hex
    binary scan $rxBuffer "H*" rxBuffer_hex
    binary scan $rxCRC "H*" rxCRC_hex
    list $input_hex $rxBuffer_hex $rxCRC_hex
} {000341 000341 0341}
test string-12.22.$noComp {string range, shimmering binary/index} {
test string-12.22 {string range, shimmering binary/index} {
    set s 0000000001
    binary scan $s a* x
    run {string range $s $s end}
    string range $s $s end
} 000000001
test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} fullutf {
    run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]}
} [list \U100000 b {}]
test string-12.24.$noComp {bignum index arithmetic} -setup {
    proc demo {i j} {string range fubar $i $j}
} -cleanup {
    rename demo {}
} -body {
    demo 2 0+0x10000000000000000
} -result bar
test string-12.25.$noComp {bignum index arithmetic} -setup {
    proc demo {i j} {string range fubar $i $j}
} -cleanup {
    rename demo {}
} -body {
    demo 0x10000000000000000-0xffffffffffffffff 3
} -result uba

test string-13.1.$noComp {string repeat} {
    list [catch {run {string repeat}} msg] $msg
test string-13.1 {string repeat} {
    list [catch {string repeat} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
test string-13.2.$noComp {string repeat} {
    list [catch {run {string repeat abc 10 oops}} msg] $msg
test string-13.2 {string repeat} {
    list [catch {string repeat abc 10 oops} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
test string-13.3.$noComp {string repeat} {
    run {string repeat {} 100}
test string-13.3 {string repeat} {
    string repeat {} 100
} {}
test string-13.4.$noComp {string repeat} {
    run {string repeat { } 5}
test string-13.4 {string repeat} {
    string repeat { } 5
} {     }
test string-13.5.$noComp {string repeat} {
    run {string repeat abc 3}
test string-13.5 {string repeat} {
    string repeat abc 3
} {abcabcabc}
test string-13.6.$noComp {string repeat} {
    run {string repeat abc -1}
test string-13.6 {string repeat} {
    string repeat abc -1
} {}
test string-13.7.$noComp {string repeat} {
    list [catch {run {string repeat abc end}} msg] $msg
test string-13.7 {string repeat} {
    list [catch {string repeat abc end} msg] $msg
} {1 {expected integer but got "end"}}
test string-13.8.$noComp {string repeat} {
    run {string repeat {} -1000}
test string-13.8 {string repeat} {
    string repeat {} -1000
} {}
test string-13.9.$noComp {string repeat} {
    run {string repeat {} 0}
test string-13.9 {string repeat} {
    string repeat {} 0
} {}
test string-13.10.$noComp {string repeat} {
    run {string repeat def 0}
test string-13.10 {string repeat} {
    string repeat def 0
} {}
test string-13.11.$noComp {string repeat} {
    run {string repeat def 1}
test string-13.11 {string repeat} {
    string repeat def 1
} def
test string-13.12.$noComp {string repeat} {
    run {string repeat ab\u7266cd 3}
test string-13.12 {string repeat} {
    string repeat ab\u7266cd 3
} ab\u7266cdab\u7266cdab\u7266cd
test string-13.13.$noComp {string repeat} {
    run {string repeat \x00 3}
test string-13.13 {string repeat} {
    string repeat \x00 3
} \x00\x00\x00
test string-13.14.$noComp {string repeat} {
test string-13.14 {string repeat} {
    # The string range will ensure us that string repeat gets a unicode string
    run {string repeat [run {string range ab\u7266cd 2 3}] 3}
    string repeat [string range ab\u7266cd 2 3] 3
} \u7266c\u7266c\u7266c

test string-14.1.$noComp {string replace} {
    list [catch {run {string replace}} msg] $msg
test string-14.1 {string replace} {
    list [catch {string replace} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.2.$noComp {string replace} {
    list [catch {run {string replace a 1}} msg] $msg
test string-14.2 {string replace} {
    list [catch {string replace a 1} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.3.$noComp {string replace} {
    list [catch {run {string replace a 1 2 3 4}} msg] $msg
test string-14.3 {string replace} {
    list [catch {string replace a 1 2 3 4} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
test string-14.4.$noComp {string replace} {
test string-14.4 {string replace} {
} {}
test string-14.5.$noComp {string replace} {
    run {string replace abcdefghijklmnop 2 14}
test string-14.5 {string replace} {
    string replace abcdefghijklmnop 2 14
} {abp}
test string-14.6.$noComp {string replace} -body {
    run {string replace abcdefghijklmnop 7 1000}
} -result {abcdefg}
test string-14.7.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 end}
test string-14.6 {string replace} {
    string replace abcdefghijklmnop 7 1000
} {abcdefg}
test string-14.7 {string replace} {
    string replace abcdefghijklmnop 10 end
} {abcdefghij}
test string-14.8.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 9}
test string-14.8 {string replace} {
    string replace abcdefghijklmnop 10 9
} {abcdefghijklmnop}
test string-14.9.$noComp {string replace} {
    run {string replace abcdefghijklmnop -3 2}
test string-14.9 {string replace} {
    string replace abcdefghijklmnop -3 2
} {defghijklmnop}
test string-14.10.$noComp {string replace} {
    run {string replace abcdefghijklmnop -3 -2}
} {abcdefghijklmnop}
test string-14.11.$noComp {string replace} -body {
    run {string replace abcdefghijklmnop 1000 1010}
} -result {abcdefghijklmnop}
test string-14.12.$noComp {string replace} {
test string-14.10 {string replace} {
    run {string replace abcdefghijklmnop -100 end}
} {}
test string-14.13.$noComp {string replace} {
    list [catch {run {string replace abc abc 1}} msg] $msg
    string replace abcdefghijklmnop -3 -2
} {abcdefghijklmnop}
test string-14.11 {string replace} {
    string replace abcdefghijklmnop 1000 1010
} {abcdefghijklmnop}
test string-14.12 {string replace} {
    string replace abcdefghijklmnop -100 end
} {}
test string-14.13 {string replace} {
    list [catch {string replace abc abc 1} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
test string-14.14.$noComp {string replace} {
    list [catch {run {string replace abc 1 eof}} msg] $msg
test string-14.14 {string replace} {
    list [catch {string replace abc 1 eof} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
test string-14.15.$noComp {string replace} {
    run {string replace abcdefghijklmnop end-10 end-2 NEW}
test string-14.15 {string replace} {
    string replace abcdefghijklmnop end-10 end-2 NEW
} {abcdeNEWop}
test string-14.16.$noComp {string replace} {
    run {string replace abcdefghijklmnop 0 end foo}
test string-14.16 {string replace} {
    string replace abcdefghijklmnop 0 end foo
} {foo}
test string-14.17.$noComp {string replace} {
    run {string replace abcdefghijklmnop end end-1}
test string-14.17 {string replace} {
    string replace abcdefghijklmnop end end-1
} {abcdefghijklmnop}
test string-14.18.$noComp {string replace} {
    run {string replace abcdefghijklmnop 10 9 XXX}
test string-14.18 {string replace} {
    string replace abcdefghijklmnop 10 9 XXX
} {abcdefghijklmnop}
test string-14.19.$noComp {string replace} {
    run {string replace {} -1 0 A}
test string-14.19 {string replace} {
    string replace {} -1 0 A
} A
test string-14.20.$noComp {string replace} {
    run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\
	    [makeByteArray NEW]}
} {abcdeNEWop}


test stringComp-14.21.$noComp {Bug 82e7f67325} {
    apply {x {
        set a [join $x {}]
        lappend b [string length [string replace ___! 0 2 $a]]
        lappend b [string length [string replace ___! 0 2 $a[unset a]]]
    }} {a b}
} {3 3}
test stringComp-14.22.$noComp {Bug 82e7f67325} memory {
    # As in stringComp-14.1, but make sure we don't retain too many refs
    leaktest {
        apply {x {
            set a [join $x {}]
            lappend b [string length [string replace ___! 0 2 $a]]
            lappend b [string length [string replace ___! 0 2 $a[unset a]]]
        }} {a b}
    }

} {0}
test stringComp-14.23.$noComp {Bug 0dca3bfa8f} {
    apply {arg {
        set argCopy $arg
        set arg [string replace $arg 1 2 aa]
        # Crashes in comparison before fix
        expr {$arg ne $argCopy}
    }} abcde
} 1
test stringComp-14.24.$noComp {Bug 1af8de570511} {
    apply {{x y} {
        # Generate an unshared string value
        set val ""
        for { set i 0 } { $i < $x } { incr i } {
            set val [format "0%s" $val]
        }
        string replace $val[unset val] 1 1 $y
    }} 4 x
} 0x00
test stringComp-14.25.$noComp {} {
    string length [string replace [string repeat a\xFE 2] 3 end {}]
} 3
test stringComp-14.26.$noComp {} {
    run {string replace abcd 0x10000000000000000-0xffffffffffffffff 2 e}
} aed

test string-15.1 {string tolower too few args} {
test string-15.1.$noComp {string tolower not enough args} {
    list [catch {run {string tolower}} msg] $msg
    list [catch {string tolower} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.2.$noComp {string tolower bad args} {
    list [catch {run {string tolower a b}} msg] $msg
test string-15.2 {string tolower bad args} {
    list [catch {string tolower a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test string-15.3.$noComp {string tolower too many args} {
    list [catch {run {string tolower ABC 1 end oops}} msg] $msg
test string-15.3 {string tolower too many args} {
    list [catch {string tolower ABC 1 end oops} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
test string-15.4.$noComp {string tolower} {
    run {string tolower ABCDeF}
test string-15.4 {string tolower} {
    string tolower ABCDeF
} {abcdef}
test string-15.5.$noComp {string tolower} {
    run {string tolower "ABC  XyZ"}
test string-15.5 {string tolower} {
    string tolower "ABC  XyZ"
} {abc  xyz}
test string-15.6.$noComp {string tolower} {
    run {string tolower {123#$&*()}}
test string-15.6 {string tolower} {
    string tolower {123#$&*()}
} {123#$&*()}
test string-15.7.$noComp {string tolower} {
    run {string tolower ABC 1}
test string-15.7 {string tolower} {
    string tolower ABC 1
} AbC
test string-15.8.$noComp {string tolower} {
    run {string tolower ABC 1 end}
test string-15.8 {string tolower} {
    string tolower ABC 1 end
} Abc
test string-15.9.$noComp {string tolower} {
    run {string tolower ABC 0 end-1}
test string-15.9 {string tolower} {
    string tolower ABC 0 end-1
} abC
test string-15.10.$noComp {string tolower, unicode} {
     run {string tolower ABCabc\xC7\xE7}
} "abcabc\xE7\xE7"
test string-15.10 {string tolower, unicode} {
     string tolower ABCabc\xc7\xe7
} "abcabc\xe7\xe7"
test string-15.11.$noComp {string tolower, compiled} {
    lindex [run {string tolower [list A B [list C]]}] 1
} b

test string-16.1.$noComp {string toupper} {
    list [catch {run {string toupper}} msg] $msg
test string-16.1 {string toupper} {
    list [catch {string toupper} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.2.$noComp {string toupper} {
    list [catch {run {string toupper a b}} msg] $msg
test string-16.2 {string toupper} {
    list [catch {string toupper a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test string-16.3.$noComp {string toupper} {
    list [catch {run {string toupper a 1 end oops}} msg] $msg
test string-16.3 {string toupper} {
    list [catch {string toupper a 1 end oops} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
test string-16.4.$noComp {string toupper} {
    run {string toupper abCDEf}
test string-16.4 {string toupper} {
    string toupper abCDEf
} {ABCDEF}
test string-16.5.$noComp {string toupper} {
    run {string toupper "abc xYz"}
test string-16.5 {string toupper} {
    string toupper "abc xYz"
} {ABC XYZ}
test string-16.6.$noComp {string toupper} {
    run {string toupper {123#$&*()}}
test string-16.6 {string toupper} {
    string toupper {123#$&*()}
} {123#$&*()}
test string-16.7.$noComp {string toupper} {
    run {string toupper abc 1}
test string-16.7 {string toupper} {
    string toupper abc 1
} aBc
test string-16.8.$noComp {string toupper} {
    run {string toupper abc 1 end}
test string-16.8 {string toupper} {
    string toupper abc 1 end
} aBC
test string-16.9.$noComp {string toupper} {
    run {string toupper abc 0 end-1}
test string-16.9 {string toupper} {
    string toupper abc 0 end-1
} ABc
test string-16.10.$noComp {string toupper, unicode} {
    run {string toupper ABCabc\xC7\xE7}
} "ABCABC\xC7\xC7"
test string-16.10 {string toupper, unicode} {
    string toupper ABCabc\xc7\xe7
} "ABCABC\xc7\xc7"
test string-16.11.$noComp {string toupper, compiled} {
    lindex [run {string toupper [list a b [list c]]}] 1
} B

test string-17.1.$noComp {string totitle} {
    list [catch {run {string totitle}} msg] $msg
test string-17.1 {string totitle} {
    list [catch {string totitle} msg] $msg
} {1 {wrong # args: should be "string totitle string ?first? ?last?"}}
test string-17.2.$noComp {string totitle} {
    list [catch {run {string totitle a b}} msg] $msg
test string-17.2 {string totitle} {
    list [catch {string totitle a b} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
test string-17.3.$noComp {string totitle} {
    run {string totitle abCDEf}
test string-17.3 {string totitle} {
    string totitle abCDEf
} {Abcdef}
test string-17.4.$noComp {string totitle} {
    run {string totitle "abc xYz"}
test string-17.4 {string totitle} {
    string totitle "abc xYz"
} {Abc xyz}
test string-17.5.$noComp {string totitle} {
    run {string totitle {123#$&*()}}
test string-17.5 {string totitle} {
    string totitle {123#$&*()}
} {123#$&*()}
test string-17.6.$noComp {string totitle, unicode} {
    run {string totitle ABCabc\xC7\xE7}
} "Abcabc\xE7\xE7"
test string-17.7.$noComp {string totitle, unicode} {
    run {string totitle \u01F3BCabc\xC7\xE7}
} "\u01F2bcabc\xE7\xE7"
test string-17.6 {string totitle, unicode} {
    string totitle ABCabc\xc7\xe7
} "Abcabc\xe7\xe7"
test string-17.7 {string totitle, unicode} {
    string totitle \u01f3BCabc\xc7\xe7
} "\u01f2bcabc\xe7\xe7"
test string-17.8.$noComp {string totitle, compiled} {
    lindex [run {string totitle [list aa bb [list cc]]}] 0
} Aa
test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} fullutf {
    run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \
	[string totitle a\U118c0c 3 3]}
} [list a\U118a0c a\U118c0C a\U118c0c]

test string-18.1.$noComp {string trim} {
    list [catch {run {string trim}} msg] $msg
test string-18.1 {string trim} {
    list [catch {string trim} msg] $msg
} {1 {wrong # args: should be "string trim string ?chars?"}}
test string-18.2.$noComp {string trim} {
    list [catch {run {string trim a b c}} msg] $msg
test string-18.2 {string trim} {
    list [catch {string trim a b c} msg] $msg
} {1 {wrong # args: should be "string trim string ?chars?"}}
test string-18.3.$noComp {string trim} {
    run {string trim "    XYZ      "}
test string-18.3 {string trim} {
    string trim "    XYZ      "
} {XYZ}
test string-18.4.$noComp {string trim} {
    run {string trim "\t\nXYZ\t\n\r\n"}
test string-18.4 {string trim} {
    string trim "\t\nXYZ\t\n\r\n"
} {XYZ}
test string-18.5.$noComp {string trim} {
    run {string trim "  A XYZ A    "}
test string-18.5 {string trim} {
    string trim "  A XYZ A    "
} {A XYZ A}
test string-18.6.$noComp {string trim} {
    run {string trim "XXYYZZABC XXYYZZ" ZYX}
test string-18.6 {string trim} {
    string trim "XXYYZZABC XXYYZZ" ZYX
} {ABC }
test string-18.7.$noComp {string trim} {
    run {string trim "    \t\r      "}
test string-18.7 {string trim} {
    string trim "    \t\r      "
} {}
test string-18.8.$noComp {string trim} {
    run {string trim {abcdefg} {}}
test string-18.8 {string trim} {
    string trim {abcdefg} {}
} {abcdefg}
test string-18.9.$noComp {string trim} {
    run {string trim {}}
test string-18.9 {string trim} {
    string trim {}
} {}
test string-18.10.$noComp {string trim} {
    run {string trim ABC DEF}
test string-18.10 {string trim} {
    string trim ABC DEF
} {ABC}
test string-18.11.$noComp {string trim, unicode} {
    run {string trim "\xE7\xE8 AB\xE7C \xE8\xE7" \xE7\xE8}
} " AB\xE7C "
test string-18.11 {string trim, unicode} {
    string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
} " AB\xe7C "
test string-18.12.$noComp {string trim, unicode default} {
    run {string trim \uFEFF\x00\x85\xA0\u1680\u180EABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000}
} ABC\u1361

test string-19.1.$noComp {string trimleft} {
    list [catch {run {string trimleft}} msg] $msg
test string-19.1 {string trimleft} {
    list [catch {string trimleft} msg] $msg
} {1 {wrong # args: should be "string trimleft string ?chars?"}}
test string-19.2.$noComp {string trimleft} {
    run {string trimleft "    XYZ      "}
test string-19.2 {string trimleft} {
    string trimleft "    XYZ      "
} {XYZ      }
test string-19.3.$noComp {string trimleft, unicode default} {
    run {string trimleft \uFEFF\x85\xA0\x00\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000\u1361ABC}
} \u1361ABC

test string-20.1.$noComp {string trimright errors} {
    list [catch {run {string trimright}} msg] $msg
test string-20.1 {string trimright errors} {
    list [catch {string trimright} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
test string-20.2.$noComp {string trimright errors} {
    list [catch {run {string trimg a}} msg] $msg
} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3.$noComp {string trimright} {
    run {string trimright "    XYZ      "}
test string-20.2 {string trimright errors} {
    list [catch {string trimg a} msg] $msg
} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-20.3 {string trimright} {
    string trimright "    XYZ      "
} {    XYZ}
test string-20.4.$noComp {string trimright} {
    run {string trimright "   "}
test string-20.4 {string trimright} {
    string trimright "   "
} {}
test string-20.5.$noComp {string trimright} {
    run {string trimright ""}
test string-20.5 {string trimright} {
    string trimright ""
} {}
test string-20.6.$noComp {string trimright, unicode default} {
    run {string trimright ABC\u1361\x85\x00\xA0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u2028\u2029\u202F\u205F\u3000}
} ABC\u1361
test string-20.7.$noComp {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} {testbytestring} {
test string-20.6 {string trimright, unicode default} {
    # Reserve test number for Tcl 8.6 (TIP 413)
} {}
test string-20.7 {string trim on not valid utf-8 sequence (consider NTS as continuation char), bug [c61818e4c9]} {
    set result {}
    set a [testbytestring \xC0\x80\xA0]
    set a [bytestring \xc0\x80\xA0]
    set b foo$a
    set m [list \x00 U \xA0 V [testbytestring \xA0] W]
    lappend result [string map $m $b]
    lappend result [string map $m [run {string trimright $b x}]]
    set m [list \u0000 U \xA0 V [bytestring \xA0] W]
    lappend result [string map $m $b]
    lappend result [string map $m [string trimright $b x]]
    lappend result [string map $m [string trimright $b \u0000]]
    lappend result [string map $m [string trimleft $b fox]]
    lappend result [string map $m [string trimleft $b fo\u0000]]
    lappend result [string map $m [run {string trimright $b \x00}]]
    lappend result [string map $m [run {string trimleft $b fox}]]
    lappend result [string map $m [string trim $b fox]]
    lappend result [string map $m [run {string trimleft $b fo\x00}]]
    lappend result [string map $m [run {string trim $b fox}]]
    lappend result [string map $m [string trim $b fo\u0000]]
    lappend result [string map $m [run {string trim $b fo\x00}]]
} [list {*}[lrepeat 3 fooUV] {*}[lrepeat 2 UV V]]
test string-20.8.$noComp {[c61818e4c9] [string trimright] fails when UtfPrev is ok} {testbytestring} {
test string-20.8 {[c61818e4c9] [string trimright] fails when UtfPrev is ok} {
    set result {}
    set a [testbytestring \xE8\xA0]
    set a [bytestring \xE8\xA0]
    set b foo$a
    set m [list \xE8 U \xA0 V [testbytestring \xE8] W [testbytestring \xA0] X]]
    set m [list \xE8 U \xA0 V [bytestring \xE8] W [bytestring \xA0] X]]
    lappend result [string map $m $b]
    lappend result [string map $m [run {string trimright $b x}]]
    lappend result [string map $m [run {string trimright $b \xE8}]]
    lappend result [string map $m [run {string trimright $b [testbytestring \xE8]}]]
    lappend result [string map $m [run {string trimright $b \xA0}]]
    lappend result [string map $m [run {string trimright $b [testbytestring \xA0]}]]
    lappend result [string map $m [run {string trimright $b \xE8\xA0}]]
    lappend result [string map $m [run {string trimright $b [testbytestring \xE8\xA0]}]]
    lappend result [string map $m [run {string trimright $b \u0000}]]
    lappend result [string map $m [string trimright $b x]]
    lappend result [string map $m [string trimright $b \xE8]]
    lappend result [string map $m [string trimright $b [bytestring \xE8]]]
    lappend result [string map $m [string trimright $b \xA0]]
    lappend result [string map $m [string trimright $b [bytestring \xA0]]]
    lappend result [string map $m [string trimright $b \xE8\xA0]]
    lappend result [string map $m [string trimright $b [bytestring \xE8\xA0]]]
    lappend result [string map $m [string trimright $b \u0000]]
} [list {*}[lrepeat 4 fooUV] {*}[lrepeat 2 fooU] {*}[lrepeat 2 foo] fooUV]

test string-21.1.$noComp {string wordend} -body {
    list [catch {run {string wordend a}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.2.$noComp {string wordend} -body {
    list [catch {run {string wordend a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordend string index"}}
test string-21.3.$noComp {string wordend} -body {
    list [catch {run {string wordend a gorp}} msg] $msg
} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
test string-21.4.$noComp {string wordend} -body {
    run {string wordend abc. -1}
} -result 3
test string-21.5.$noComp {string wordend} -body {
    run {string wordend abc. 100}
} -result 4
test string-21.6.$noComp {string wordend} -body {
    run {string wordend "word_one two three" 2}
} -result 8
test string-21.7.$noComp {string wordend} -body {
    run {string wordend "one .&# three" 5}
} -result 6
test string-21.8.$noComp {string wordend} -body {
    run {string worde "x.y" 0}
} -result 1
test string-21.9.$noComp {string wordend} -body {
    run {string worde "x.y" end-1}
} -result 2
test string-21.10.$noComp {string wordend, unicode} -body {
    run {string wordend "xyz\xC7de fg" 0}
} -result 6
test string-21.11.$noComp {string wordend, unicode} -body {
    run {string wordend "xyz\uC700de fg" 0}
} -result 6
test string-21.12.$noComp {string wordend, unicode} -body {
    run {string wordend "xyz\u203Fde fg" 0}
} -result 6
test string-21.13.$noComp {string wordend, unicode} -body {
    run {string wordend "xyz\u2045de fg" 0}
} -result 3
test string-21.14.$noComp {string wordend, unicode} -body {
    run {string wordend "\uC700\uC700 abc" 8}
} -result 6
test string-21.1 {string wordend} {
    list [catch {string wordend a} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
test string-21.2 {string wordend} {
    list [catch {string wordend a b c} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
test string-21.3 {string wordend} {
    list [catch {string wordend a gorp} msg] $msg
} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
test string-21.4 {string wordend} {
    string wordend abc. -1
} 3
test string-21.5 {string wordend} {
    string wordend abc. 100
} 4
test string-21.6 {string wordend} {
    string wordend "word_one two three" 2
} 8
test string-21.7 {string wordend} {
    string wordend "one .&# three" 5
} 6
test string-21.8 {string wordend} {
    string worde "x.y" 0
} 1
test string-21.9 {string wordend} {
    string worde "x.y" end-1
} 2
test string-21.10 {string wordend, unicode} {
    string wordend "xyz\u00c7de fg" 0
} 6
test string-21.11 {string wordend, unicode} {
    string wordend "xyz\uc700de fg" 0
} 6
test string-21.12 {string wordend, unicode} {
    string wordend "xyz\u203fde fg" 0
} 6
test string-21.13 {string wordend, unicode} {
    string wordend "xyz\u2045de fg" 0
} 3
test string-21.14 {string wordend, unicode} {
    string wordend "\uc700\uc700 abc" 8
} 6
test string-21.15.$noComp {string wordend, unicode} -body {
    run {string wordend "\U1D7CA\U1D7CA abc" 0}
} -result 2
test string-21.16.$noComp {string wordend, unicode} -constraints fullutf -body {
    run {string wordend "\U1D7CA\U1D7CA abc" 10}
} -result 6

test string-22.1.$noComp {string wordstart} -body {
    list [catch {run {string word a}} msg] $msg
} -result {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, insert, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2.$noComp {string wordstart} -body {
    list [catch {run {string wordstart a}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3.$noComp {string wordstart} -body {
    list [catch {run {string wordstart a b c}} msg] $msg
} -result {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4.$noComp {string wordstart} -body {
    list [catch {run {string wordstart a gorp}} msg] $msg
} -result {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
test string-22.5.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" 400}
} -result 8
test string-22.6.$noComp {string wordstart} -body {
    run {string wordstart "one two three_words" 2}
} -result 0
test string-22.7.$noComp {string wordstart} -body {
test string-22.1 {string wordstart} {
    list [catch {string word a} msg] $msg
} {1 {unknown or ambiguous subcommand "word": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test string-22.2 {string wordstart} {
    list [catch {string wordstart a} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.3 {string wordstart} {
    list [catch {string wordstart a b c} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
test string-22.4 {string wordstart} {
    list [catch {string wordstart a gorp} msg] $msg
} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
test string-22.5 {string wordstart} {
    string wordstart "one two three_words" 400
} 8
test string-22.6 {string wordstart} {
    string wordstart "one two three_words" 2
} 0
test string-22.7 {string wordstart} {
    string wordstart "one two three_words" -2
} 0
test string-22.8 {string wordstart} {
    run {string wordstart "one two three_words" -2}
} -result 0
test string-22.8.$noComp {string wordstart} -body {
    run {string wordstart "one .*&^ three" 6}
} -result 6
test string-22.9.$noComp {string wordstart} -body {
    run {string wordstart "one two three" 4}
} -result 4
test string-22.10.$noComp {string wordstart} -body {
    run {string wordstart "one two three" end-5}
} -result 7
test string-22.11.$noComp {string wordstart, unicode} -body {
    run {string wordstart "one tw\xC7o three" 7}
} -result 4
test string-22.12.$noComp {string wordstart, unicode} -body {
    run {string wordstart "ab\uC700\uC700 cdef ghi" 12}
} -result 10
test string-22.13.$noComp {string wordstart, unicode} -body {
    run {string wordstart "\uC700\uC700 abc" 8}
} -result 3
test string-22.14.$noComp {string wordstart, invalid UTF-8} -constraints testbytestring -body {
    string wordstart "one .*&^ three" 6
} 6
test string-22.9 {string wordstart} {
    string wordstart "one two three" 4
} 4
test string-22.10 {string wordstart} {
    string wordstart "one two three" end-5
} 7
test string-22.11 {string wordstart, unicode} {
    string wordstart "one tw\u00c7o three" 7
} 4
test string-22.12 {string wordstart, unicode} {
    string wordstart "ab\uc700\uc700 cdef ghi" 12
} 10
test string-22.13 {string wordstart, unicode} {
    string wordstart "\uc700\uc700 abc" 8
} 3
test string-22.14 {string wordstart, invalid UTF-8} {
    # See Bug c61818e4c9
    set demo [testbytestring "abc def\xE0\xA9ghi"]
    run {string index $demo [string wordstart $demo 10]}
} -result g
    set demo [bytestring "abc def\xE0\xA9ghi"]
    string index $demo [string wordstart $demo 10]
} g
test string-22.15.$noComp {string wordstart, unicode} -body {
    run {string wordstart "\U1D7CA\U1D7CA abc" 0}
} -result 0
test string-22.16.$noComp {string wordstart, unicode} -constraints fullutf -body {
    run {string wordstart "\U1D7CA\U1D7CA abc" 10}
} -result 3

test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj {
test string-23.0 {string is boolean, Bug 1187123} testindexobj {
    set x 5
    catch {testindexobj $x foo bar soom}
    run {string is boolean $x}
    string is boolean $x
} 0
test string-23.1.$noComp {string is command with empty string} {
test string-23.1 {string is command with empty string} {
    set s ""
    list \
        [run {string is alnum $s}] \
        [run {string is alpha $s}] \
        [run {string is ascii $s}] \
        [run {string is control $s}] \
        [run {string is boolean $s}] \
        [run {string is digit $s}] \
        [run {string is double $s}] \
        [run {string is false $s}] \
        [run {string is graph $s}] \
        [run {string is integer $s}] \
        [run {string is lower $s}] \
        [run {string is print $s}] \
        [run {string is punct $s}] \
        [run {string is space $s}] \
        [run {string is true $s}] \
        [run {string is upper $s}] \
        [run {string is wordchar $s}] \
        [run {string is xdigit $s}] \
        [string is alnum $s] \
        [string is alpha $s] \
        [string is ascii $s] \
        [string is control $s] \
        [string is boolean $s] \
        [string is digit $s] \
        [string is double $s] \
        [string is false $s] \
        [string is graph $s] \
        [string is integer $s] \
        [string is lower $s] \
        [string is print $s] \
        [string is punct $s] \
        [string is space $s] \
        [string is true $s] \
        [string is upper $s] \
        [string is wordchar $s] \
        [string is xdigit $s] \

} {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1}
test string-23.2.$noComp {string is command with empty string} {
test string-23.2 {string is command with empty string} {
    set s ""
    list \
        [run {string is alnum -strict $s}] \
        [run {string is alpha -strict $s}] \
        [run {string is ascii -strict $s}] \
        [run {string is control -strict $s}] \
        [run {string is boolean -strict $s}] \
        [run {string is digit -strict $s}] \
        [run {string is double -strict $s}] \
        [run {string is false -strict $s}] \
        [run {string is graph -strict $s}] \
        [run {string is integer -strict $s}] \
        [run {string is lower -strict $s}] \
        [run {string is print -strict $s}] \
        [run {string is punct -strict $s}] \
        [run {string is space -strict $s}] \
        [run {string is true -strict $s}] \
        [run {string is upper -strict $s}] \
        [run {string is wordchar -strict $s}] \
        [run {string is xdigit -strict $s}] \
        [string is alnum -strict $s] \
        [string is alpha -strict $s] \
        [string is ascii -strict $s] \
        [string is control -strict $s] \
        [string is boolean -strict $s] \
        [string is digit -strict $s] \
        [string is double -strict $s] \
        [string is false -strict $s] \
        [string is graph -strict $s] \
        [string is integer -strict $s] \
        [string is lower -strict $s] \
        [string is print -strict $s] \
        [string is punct -strict $s] \
        [string is space -strict $s] \
        [string is true -strict $s] \
        [string is upper -strict $s] \
        [string is wordchar -strict $s] \
        [string is xdigit -strict $s] \

} {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}

test string-24.1.$noComp {string reverse command} -body {
    run {string reverse}
test string-24.1 {string reverse command} -body {
    string reverse
} -returnCodes error -result "wrong # args: should be \"string reverse string\""
test string-24.2.$noComp {string reverse command} -body {
    run {string reverse a b}
test string-24.2 {string reverse command} -body {
    string reverse a b
} -returnCodes error -result "wrong # args: should be \"string reverse string\""
test string-24.3.$noComp {string reverse command - shared string} {
test string-24.3 {string reverse command - shared string} {
    set x abcde
    run {string reverse $x}
    string reverse $x
} edcba
test string-24.4.$noComp {string reverse command - unshared string} {
test string-24.4 {string reverse command - unshared string} {
    set x abc
    set y de
    run {string reverse $x$y}
} edcba
test string-24.5.$noComp {string reverse command - shared unicode string} {
    set x abcde\uD0AD
    run {string reverse $x}
} \uD0ADedcba
test string-24.6.$noComp {string reverse command - unshared string} {
    set x abc
    set y de\uD0AD
    run {string reverse $x$y}
} \uD0ADedcba
test string-24.7.$noComp {string reverse command - simple case} {
    run {string reverse a}
} a
test string-24.8.$noComp {string reverse command - simple case} {
    run {string reverse \uD0AD}
} \uD0AD
test string-24.9.$noComp {string reverse command - simple case} {
    run {string reverse {}}
} {}
test string-24.10.$noComp {string reverse command - corner case} {
    set x \uBEEF\uD0AD
    run {string reverse $x}
} \uD0AD\uBEEF
test string-24.11.$noComp {string reverse command - corner case} {
    set x \uBEEF
    set y \uD0AD
    run {string reverse $x$y}
} \uD0AD\uBEEF
test string-24.12.$noComp {string reverse command - corner case} {
    set x \uBEEF
    set y \uD0AD
    run {string is ascii [run {string reverse $x$y}]}
} 0
test string-24.13.$noComp {string reverse command - pure Unicode string} {
    run {string reverse [run {string range \uBEEF\uD0AD\uBEEF\uD0AD\uBEEF\uD0AD 1 5}]}
} \uD0AD\uBEEF\uD0AD\uBEEF\uD0AD
test string-24.14.$noComp {string reverse command - pure bytearray} {
    binary scan [run {string reverse [binary format H* 010203]}] H* x
    set x
} 030201
test string-24.15.$noComp {string reverse command - pure bytearray} {
    binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x
    set x
} 030201

test string-25.1.$noComp {string is list} {
    run {string is list {a b c}}
} 1
test string-25.2.$noComp {string is list} {
    run {string is list "a \{b c"}
} 0
test string-25.3.$noComp {string is list} {
    run {string is list {a {b c}d e}}
} 0
test string-25.4.$noComp {string is list} {
    run {string is list {}}
} 1
test string-25.5.$noComp {string is list} {
    string reverse $x$y
} edcba
test string-24.5 {string reverse command - shared unicode string} {
    run {string is list -strict {a b c}}
} 1
test string-25.6.$noComp {string is list} {
    run {string is list -strict "a \{b c"}
} 0
test string-25.7.$noComp {string is list} {
    run {string is list -strict {a {b c}d e}}
} 0
test string-25.8.$noComp {string is list} {
    run {string is list -strict {}}
} 1
test string-25.9.$noComp {string is list} {
    set x {}
    set x abcde\udead
    list [run {string is list -failindex x {a b c}}] $x
} {1 {}}
test string-25.10.$noComp {string is list} {
    string reverse $x
    set x {}
    list [run {string is list -failindex x "a \{b c"}] $x
} {0 2}
test string-25.11.$noComp {string is list} {
    set x {}
} \udeadedcba
test string-24.6 {string reverse command - unshared string} {
    set x abc
    list [run {string is list -failindex x {a b {b c}d e}}] $x
} {0 4}
test string-25.12.$noComp {string is list} {
    set x {}
    set y de\udead
    list [run {string is list -failindex x {}}] $x
} {1 {}}
test string-25.13.$noComp {string is list} {
    string reverse $x$y
    set x {}
    list [run {string is list -failindex x {  {b c}d e}}] $x
} {0 2}
test string-25.14.$noComp {string is list} {
    set x {}
    list [run {string is list -failindex x "\uABCD {b c}d e"}] $x
} {0 2}

} \udeadedcba
test string-26.1.$noComp {tcl::prefix, not enough args} -body {
    tcl::prefix match a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"}
test string-26.2.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match a b c
} -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message}
test string-26.2.1.$noComp {tcl::prefix, empty table} -body {
    tcl::prefix match {} foo
} -returnCodes 1 -result {bad option "foo": no valid options}
test string-26.3.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -error "{}x" -exact str1 str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test string-26.3.1.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -error "x" -exact str1 str2
} -returnCodes 1 -result {error options must have an even number of elements}
test string-26.3.2.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -error str1 str2
} -returnCodes 1 -result {missing value for -error}
test string-26.4.$noComp {tcl::prefix, bad args} -body {
    tcl::prefix match -message str1 str2
} -returnCodes 1 -result {missing value for -message}
test string-26.5.$noComp {tcl::prefix} {
    tcl::prefix match {apa bepa cepa depa} cepa
} cepa
test string-26.6.$noComp {tcl::prefix} {
    tcl::prefix match {apa bepa cepa depa} be
} bepa
test string-26.7.$noComp {tcl::prefix} -body {
    tcl::prefix match -exact {apa bepa cepa depa} be
} -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
test string-26.8.$noComp {tcl::prefix} -body {
test string-24.7 {string reverse command - simple case} {
    tcl::prefix match -message wombat {apa bepa bear depa} be
} -returnCodes 1 -result {ambiguous wombat "be": must be apa, bepa, bear, or depa}
test string-26.9.$noComp {tcl::prefix} -body {
    string reverse a
    tcl::prefix match -error {} {apa bepa bear depa} be
} -returnCodes 0 -result {}
test string-26.10.$noComp {tcl::prefix} -body {
    tcl::prefix match -error {-level 1} {apa bepa bear depa} be
} -returnCodes 2 -result {ambiguous option "be": must be apa, bepa, bear, or depa}
test string-26.10.1.$noComp {tcl::prefix} -setup {
    proc _testprefix {args} {
        array set opts {-a x -b y -c y}
        foreach {opt val} $args {
            set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt]
            set opts($opt) $val
        }
} a
        array get opts
    }
} -body {
    set a [catch {_testprefix -x u} result options]
    dict get $options -errorinfo
} -cleanup {
test string-24.8 {string reverse command - simple case} {
    string reverse \udead
} \udead
    rename _testprefix {}
} -result {bad option "-x": must be -a, -b, or -c
    while executing
"_testprefix -x u"}

test string-24.9 {string reverse command - simple case} {
# Helper for memory stress tests
# Repeat each body in a local space checking that memory does not increase
proc MemStress {args} {
    set res {}
    string reverse {}
    foreach body $args {
        set end 0
        for {set i 0} {$i < 5} {incr i} {
            proc MemStress_Body {} $body
            uplevel 1 MemStress_Body
} {}
test string-24.10 {string reverse command - corner case} {
            rename MemStress_Body {}
            set tmp $end
    set x \ubeef\udead
            set end [lindex [lindex [split [memory info] "\n"] 3] 3]
        }
        lappend res [expr {$end - $tmp}]
    }
    return $res
    string reverse $x
}

test string-26.11.$noComp {tcl::prefix: testing for leaks} -body {
} \udead\ubeef
test string-24.11 {string reverse command - corner case} {
    # This test is made to stress object reference management
    MemStress {
        set table {hejj miff gurk}
        set item [lindex $table 1]
    set x \ubeef
    set y \udead
        # If not careful, this can cause a circular reference
        # that will cause a leak.
    string reverse $x$y
        tcl::prefix match $table $item
    } {
} \udead\ubeef
        # A similar case with nested lists
        set table2 {hejj {miff maff} gurk}
        set item [lindex [lindex $table2 1] 0]
test string-24.12 {string reverse command - corner case} {
    set x \ubeef
    set y \udead
        tcl::prefix match $table2 $item
    } {
    string is ascii [string reverse $x$y]
} 0
        # A similar case with dict
        set table3 {hejj {miff maff} gurk2}
        set item [lindex [dict keys [lindex $table3 1]] 0]
        tcl::prefix match $table3 $item
    }
} -constraints memory -result {0 0 0}

test string-26.12.$noComp {tcl::prefix: testing for leaks} -body {
    # This is a memory leak test in a form that might actually happen
    # in real code.  The shared literal "miff" causes a connection
    # between the item and the table.
    MemStress {
        proc stress1 {item} {
            set table [list hejj miff gurk]
            tcl::prefix match $table $item
        }

        proc stress2 {} {
            stress1 miff
        }
        stress2
        rename stress1 {}
        rename stress2 {}
    }
} -constraints memory -result 0

test string-25.1 {string is list} {
test string-26.13.$noComp {tcl::prefix: testing for leaks} -body {
    # This test is made to stress object reference management
    MemStress {
        set table [list hejj miff]
        set item $table
        set error $table
        # Use the same objects in all places
        catch {
            tcl::prefix match -error $error $table $item
        }
    }
} -constraints memory -result {0}

    string is list {a b c}
test string-27.1.$noComp {tcl::prefix all, not enough args} -body {
    tcl::prefix all a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
test string-27.2.$noComp {tcl::prefix all, bad args} -body {
    tcl::prefix all a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
test string-27.3.$noComp {tcl::prefix all, bad args} -body {
    tcl::prefix all "{}x" str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test string-27.4.$noComp {tcl::prefix all} {
    tcl::prefix all {apa bepa cepa depa} c
} cepa
test string-27.5.$noComp {tcl::prefix all} {
    tcl::prefix all {apa bepa cepa depa} cepa
} cepa
test string-27.6.$noComp {tcl::prefix all} {
    tcl::prefix all {apa bepa cepa depa} cepax
} {}
test string-27.7.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} a
} {apa aska appa}
test string-27.8.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} ap
} {apa appa}
test string-27.9.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} p
} {}
test string-27.10.$noComp {tcl::prefix all} {
    tcl::prefix all {apa aska appa} {}
} {apa aska appa}

test string-28.1.$noComp {tcl::prefix longest, not enough args} -body {
    tcl::prefix longest a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
test string-28.2.$noComp {tcl::prefix longest, bad args} -body {
    tcl::prefix longest a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
test string-28.3.$noComp {tcl::prefix longest, bad args} -body {
    tcl::prefix longest "{}x" str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
test string-28.4.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bepa cepa depa} c
} cepa
test string-28.5.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bepa cepa depa} cepa
} cepa
test string-28.6.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bepa cepa depa} cepax
} {}
} 1
test string-28.7.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa aska appa} a
} a
test string-28.8.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa aska appa} ap
} ap
test string-28.9.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bska appa} a
} ap
test string-28.10.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa bska appa} {}
} {}
test string-28.11.$noComp {tcl::prefix longest} {
    tcl::prefix longest {{} bska appa} {}
} {}
test string-28.12.$noComp {tcl::prefix longest} {
    tcl::prefix longest {apa {} appa} {}
} {}
test string-28.13.$noComp {tcl::prefix longest} {
    # Test utf-8 handling
    tcl::prefix longest {ax\x90 bep ax\x91} a
} ax

test string-25.2 {string is list} {
test string-29.1.$noComp {string cat, no arg} {
    run {string cat}
    string is list "a \{b c"
} ""
test string-29.2.$noComp {string cat, single arg} {
    set x FOO
    run {string compare $x [run {string cat $x}]}
} 0
test string-29.3.$noComp {string cat, two args} {
test string-25.3 {string is list} {
    set x FOO
    run {string compare $x$x [run {string cat $x $x}]}
    string is list {a {b c}d e}
} 0
test string-29.4.$noComp {string cat, many args} {
test string-25.4 {string is list} {
    set x FOO
    set n 260
    set xx [run {string repeat $x $n}]
    set vv [run {string repeat {$x} $n}]
    set vvs [run {string repeat {$x } $n}]
    set r1 [run {string compare $xx [subst $vv]}]
    set r2 [run {string compare $xx [eval "run {string cat $vvs}"]}]
    list $r1 $r2
} {0 0}
    string is list {}
} 1
if {$noComp} {
test string-29.5.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list x] [list]}]
} -match glob -result {*no string representation}
test string-29.6.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list] [list x]}]
} -match glob -result {*no string representation}
test string-29.7.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list x] [list] [list]}]
} -match glob -result {*no string representation}
test string-29.8.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list] [list x] [list]}]
} -match glob -result {*no string representation}
test string-29.9.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list] [list] [list x]}]
} -match glob -result {*no string representation}
test string-29.10.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat [list x] [list x]}]
} -match glob -result {*, string representation "xx"}
test string-29.11.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[run {string cat [list x] [encoding convertto utf-8 {}]}]
} -match glob -result {*no string representation}
test string-29.12.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation \
	[run {string cat [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, string representation "x"}
test string-29.13.$noComp {string cat, efficiency} -body {
    tcl::unsupported::representation [run {string cat \
	[encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}]
} -match glob -result {*, string representation "x"}
test string-29.14.$noComp {string cat, efficiency} -setup {
    set e [encoding convertto utf-8 {}]
} -cleanup {
    unset e
} -body {
    tcl::unsupported::representation [run {string cat $e $e [list x]}]
} -match glob -result {*no string representation}
test string-29.15.$noComp {string cat, efficiency} -setup {
    set e [encoding convertto utf-8 {}]
    set f [encoding convertto utf-8 {}]
} -cleanup {
    unset e f
} -body {
    tcl::unsupported::representation [run {string cat $e $f $e $f [list x]}]
} -match glob -result {*no string representation}
}

test string-25.5 {string is list} {
test string-30.1.1.$noComp {[Bug ba921a8d98]: string cat} {
    run {string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]}
} hellohello
test string-30.1.2.$noComp {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} {
    run {set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"}
} hellohello

    string is list -strict {a b c}
# Note: string-31.* tests use [tcl::string::insert] rather than [string insert]
# to dodge ticket [3397978fff] which would cause all arguments to be shared,
# thereby preventing the optimizations from being tested.
test string-31.1.$noComp {string insert, start of string} {
    run {tcl::string::insert 0123 0 _}
} _0123
test string-31.2.$noComp {string insert, middle of string} {
    run {tcl::string::insert 0123 2 _}
} 01_23
test string-31.3.$noComp {string insert, end of string} {
    run {tcl::string::insert 0123 4 _}
} 0123_
test string-31.4.$noComp {string insert, start of string, end-relative} {
    run {tcl::string::insert 0123 end-4 _}
} _0123
test string-31.5.$noComp {string insert, middle of string, end-relative} {
    run {tcl::string::insert 0123 end-2 _}
} 01_23
test string-31.6.$noComp {string insert, end of string, end-relative} {
    run {tcl::string::insert 0123 end _}
} 0123_
test string-31.7.$noComp {string insert, empty target string} {
    run {tcl::string::insert {} 0 _}
} _
test string-31.8.$noComp {string insert, empty insert string} {
    run {tcl::string::insert 0123 0 {}}
} 0123
test string-31.9.$noComp {string insert, empty strings} {
    run {tcl::string::insert {} 0 {}}
} {}
test string-31.10.$noComp {string insert, negative index} {
    run {tcl::string::insert 0123 -1 _}
} 1
test string-25.6 {string is list} {
    string is list -strict "a \{b c"
} 0
test string-25.7 {string is list} {
    string is list -strict {a {b c}d e}
} 0
test string-25.8 {string is list} {
    string is list -strict {}
} _0123
test string-31.11.$noComp {string insert, index beyond end} {
    run {tcl::string::insert 0123 5 _}
} 0123_
test string-31.12.$noComp {string insert, start of string, pure byte array} {
    run {tcl::string::insert [makeByteArray 0123] 0 [makeByteArray _]}
} _0123
test string-31.13.$noComp {string insert, middle of string, pure byte array} {
    run {tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]}
} 01_23
test string-31.14.$noComp {string insert, end of string, pure byte array} {
    run {tcl::string::insert [makeByteArray 0123] 4 [makeByteArray _]}
} 0123_
test string-31.15.$noComp {string insert, pure byte array, neither shared} {
    run {tcl::string::insert [makeByteArray 0123] 2 [makeByteArray _]}
} 01_23
test string-31.16.$noComp {string insert, pure byte array, first shared} {
    run {tcl::string::insert [makeShared [makeByteArray 0123]] 2\
            [makeByteArray _]}
} 01_23
test string-31.17.$noComp {string insert, pure byte array, second shared} {
    run {tcl::string::insert [makeByteArray 0123] 2\
            [makeShared [makeByteArray _]]}
} 01_23
test string-31.18.$noComp {string insert, pure byte array, both shared} {
    run {tcl::string::insert [makeShared [makeByteArray 0123]] 2\
            [makeShared [makeByteArray _]]}
} 01_23
test string-31.19.$noComp {string insert, start of string, pure Unicode} {
    run {tcl::string::insert [makeUnicode 0123] 0 [makeUnicode _]}
} _0123
test string-31.20.$noComp {string insert, middle of string, pure Unicode} {
    run {tcl::string::insert [makeUnicode 0123] 2 [makeUnicode _]}
} 01_23
test string-31.21.$noComp {string insert, end of string, pure Unicode} {
    run {tcl::string::insert [makeUnicode 0123] 4 [makeUnicode _]}
} 0123_
test string-31.22.$noComp {string insert, str start, pure Uni, first shared} {
    run {tcl::string::insert [makeShared [makeUnicode 0123]] 0 [makeUnicode _]}
} _0123
test string-31.23.$noComp {string insert, string mid, pure Uni, 2nd shared} {
    run {tcl::string::insert [makeUnicode 0123] 2 [makeShared [makeUnicode _]]}
} 01_23
test string-31.24.$noComp {string insert, string end, pure Uni, both shared} {
    run {tcl::string::insert [makeShared [makeUnicode 0123]] 4\
            [makeShared [makeUnicode _]]}
} 0123_
test string-31.25.$noComp {string insert, neither byte array nor Unicode} {
    run {tcl::string::insert [makeList a b c] 1 zzzzzz}
} {azzzzzz b c}
test string-31.26.$noComp {[11229bad5f] string insert, compiler} -setup {
    set i 2
} -body {
    run {tcl::string::insert abcd $i xyz}
} -cleanup {
    unset i
} -result abxyzcd

test string-32.1.$noComp {string is dict} {
    string is dict {a b c d}
} 1
test string-32.1a.$noComp {string is dict} {
    string is dict {a b c}
} 0
test string-32.2.$noComp {string is dict} {
    string is dict "a \{b c"
} 0
test string-32.3.$noComp {string is dict} {
    string is dict {a {b c}d e}
} 0
test string-32.4.$noComp {string is dict} {
    string is dict {}
} 1
test string-32.5.$noComp {string is dict} {
    string is dict -strict {a b c d}
} 1
test string-32.5a.$noComp {string is dict} {
    string is dict -strict {a b c}
} 0
test string-32.6.$noComp {string is dict} {
    string is dict -strict "a \{b c"
} 0
test string-32.7.$noComp {string is dict} {
    string is dict -strict {a {b c}d e}
} 0
test string-32.8.$noComp {string is dict} {
    string is dict -strict {}
test string-25.9 {string is list} {
} 1
test string-32.9.$noComp {string is dict} {
    set x {}
    list [string is dict -failindex x {a b c d}] $x
    list [string is list -failindex x {a b c}] $x
} {1 {}}
test string-32.9a.$noComp {string is dict} {
test string-25.10 {string is list} {
    set x {}
    list [string is dict -failindex x {a b c}] $x
} {0 -1}
test string-32.10.$noComp {string is dict} {
    set x {}
    list [string is dict -failindex x "a \{b c d"] $x
    list [string is list -failindex x "a \{b c"] $x
} {0 2}
test string-32.10a.$noComp {string is dict} {
test string-25.11 {string is list} {
    set x {}
    list [string is dict -failindex x "a \{b c"] $x
} {0 2}
test string-32.11.$noComp {string is dict} {
    list [string is list -failindex x {a b {b c}d e}] $x
} {0 4}
test string-25.12 {string is list} {
    set x {}
    list [string is dict -failindex x {a b {b c}d e}] $x
} {0 4}
test string-32.12.$noComp {string is dict} {
    set x {}
    list [string is dict -failindex x {}] $x
    list [string is list -failindex x {}] $x
} {1 {}}
test string-32.13.$noComp {string is dict} {
test string-25.13 {string is list} {
    set x {}
    list [string is dict -failindex x {  {b c}d e}] $x
    list [string is list -failindex x {  {b c}d e}] $x
} {0 2}
test string-32.14.$noComp {string is dict} {
test string-25.14 {string is list} {
    set x {}
    list [string is dict -failindex x "\uABCD {b c}d e"] $x
    list [string is list -failindex x "\uabcd {b c}d e"] $x
} {0 2}
test string-32.15.$noComp {string is dict, valid dict} {
    string is dict {a b c d e f}
} 1
test string-32.16.$noComp {string is dict, invalid dict} {
    string is dict a
} 0
test string-32.17.$noComp {string is dict, valid dict packed in invalid dict} {
    string is dict {{a b c d e f g h}}
} 0

};				# foreach noComp {0 1}

# cleanup
rename MemStress {}
rename makeByteArray {}
rename makeUnicode {}
rename makeList {}
rename makeShared {}
catch {rename foo {}}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Added tests/stringComp.test.













































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# Commands covered:  string
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# This differs from the original string tests in that the tests call
# things in procs, which uses the compiled string code instead of
# the runtime parse string code.  The tests of import should match
# their equivalent number in string.test.
#
# Copyright (c) 2001 by ActiveState Corporation.
# 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.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

# Some tests require the testobj command

testConstraint testobj [expr {[info commands testobj] != {}}]

test stringComp-1.1 {error conditions} {
    proc foo {} {string gorp a b}
    list [catch {foo} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
test stringComp-1.2 {error conditions} {
    proc foo {} {string}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string subcommand ?argument ...?"}}
test stringComp-1.3 {error condition - undefined method during compile} {
    # We don't want this to complain about 'never' because it may never
    # be called, or string may get redefined.  This must compile OK.
    proc foo {str i} {
        if {"yes" == "no"} { string never called but complains here }
        string index $str $i
    }
    foo abc 0
} a

test stringComp-2.1 {string compare, too few args} {
    proc foo {} {string compare a}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test stringComp-2.2 {string compare, bad args} {
    proc foo {} {string compare a b c}
    list [catch {foo} msg] $msg
} {1 {bad option "a": must be -nocase or -length}}
test stringComp-2.3 {string compare, bad args} {
    list [catch {string compare -length -nocase str1 str2} msg] $msg
} {1 {expected integer but got "-nocase"}}
test stringComp-2.4 {string compare, too many args} {
    list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test stringComp-2.5 {string compare with length unspecified} {
    list [catch {string compare -length 10 10} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
test stringComp-2.6 {string compare} {
    proc foo {} {string compare abcde abdef}
    foo
} -1
test stringComp-2.7 {string compare, shortest method name} {
    proc foo {} {string c abcde ABCDE}
    foo
} 1
test stringComp-2.8 {string compare} {
    proc foo {} {string compare abcde abcde}
    foo
} 0
test stringComp-2.9 {string compare with length} {
    proc foo {} {string compare -length 2 abcde abxyz}
    foo
} 0
test stringComp-2.10 {string compare with special index} {
    proc foo {} {string compare -length end-3 abcde abxyz}
    list [catch {foo} msg] $msg
} {1 {expected integer but got "end-3"}}
test stringComp-2.11 {string compare, unicode} {
    proc foo {} {string compare ab\u7266 ab\u7267}
    foo
} -1
test stringComp-2.12 {string compare, high bit} {
    # This test will fail if the underlying comparaison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    proc foo {} {string compare "\x80" "@"}
    foo
    # Nb this tests works also in utf8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 1
test stringComp-2.13 {string compare -nocase} {
    proc foo {} {string compare -nocase abcde abdef}
    foo
} -1
test stringComp-2.14 {string compare -nocase} {
    proc foo {} {string c -nocase abcde ABCDE}
    foo
} 0
test stringComp-2.15 {string compare -nocase} {
    proc foo {} {string compare -nocase abcde abcde}
    foo
} 0
test stringComp-2.16 {string compare -nocase with length} {
    proc foo {} {string compare -length 2 -nocase abcde Abxyz}
    foo
} 0
test stringComp-2.17 {string compare -nocase with length} {
    proc foo {} {string compare -nocase -length 3 abcde Abxyz}
    foo
} -1
test stringComp-2.18 {string compare -nocase with length <= 0} {
    proc foo {} {string compare -nocase -length -1 abcde AbCdEf}
    foo
} -1
test stringComp-2.19 {string compare -nocase with excessive length} {
    proc foo {} {string compare -nocase -length 50 AbCdEf abcde}
    foo
} 1
test stringComp-2.20 {string compare -len unicode} {
    # These are strings that are 6 BYTELENGTH long, but the length
    # shouldn't make a different because there are actually 3 CHARS long
    proc foo {} {string compare -len 5 \334\334\334 \334\334\374}
    foo
} -1
test stringComp-2.21 {string compare -nocase with special index} {
    proc foo {} {string compare -nocase -length end-3 Abcde abxyz}
    list [catch {foo} msg] $msg
} {1 {expected integer but got "end-3"}}
test stringComp-2.22 {string compare, null strings} {
    proc foo {} {string compare "" ""}
    foo
} 0
test stringComp-2.23 {string compare, null strings} {
    proc foo {} {string compare "" foo}
    foo
} -1
test stringComp-2.24 {string compare, null strings} {
    proc foo {} {string compare foo ""}
    foo
} 1
test stringComp-2.25 {string compare -nocase, null strings} {
    proc foo {} {string compare -nocase "" ""}
    foo
} 0
test stringComp-2.26 {string compare -nocase, null strings} {
    proc foo {} {string compare -nocase "" foo}
    foo
} -1
test stringComp-2.27 {string compare -nocase, null strings} {
    proc foo {} {string compare -nocase foo ""}
    foo
} 1
test stringComp-2.28 {string compare with length, unequal strings} {
    proc foo {} {string compare -length 2 abc abde}
    foo
} 0
test stringComp-2.29 {string compare with length, unequal strings} {
    proc foo {} {string compare -length 2 ab abde}
    foo
} 0
test stringComp-2.30 {string compare with NUL character vs. other ASCII} {
    # Be careful here, since UTF-8 rep comparison with memcmp() of
    # these puts chars in the wrong order
    proc foo {} {string compare \x00 \x01}
    foo
} -1
test stringComp-2.31 {string compare, high bit} {
    proc foo {} {string compare "a\x80" "a@"}
    foo
} 1
test stringComp-2.32 {string compare, high bit} {
    proc foo {} {string compare "a\x00" "a\x01"}
    foo
} -1
test stringComp-2.33 {string compare, high bit} {
    proc foo {} {string compare "\x00\x00" "\x00\x01"}
    foo
} -1

# only need a few tests on equal, since it uses the same code as
# string compare, but just modifies the return output
test stringComp-3.1 {string equal} {
    proc foo {} {string equal abcde abdef}
    foo
} 0
test stringComp-3.2 {string equal} {
    proc foo {} {string eq abcde ABCDE}
    foo
} 0
test stringComp-3.3 {string equal} {
    proc foo {} {string equal abcde abcde}
    foo
} 1
test stringComp-3.4 {string equal -nocase} {
    proc foo {} {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
    foo
} 1
test stringComp-3.5 {string equal -nocase} {
    proc foo {} {string equal -nocase abcde abdef}
    foo
} 0
test stringComp-3.6 {string equal -nocase} {
    proc foo {} {string eq -nocase abcde ABCDE}
    foo
} 1
test stringComp-3.7 {string equal -nocase} {
    proc foo {} {string equal -nocase abcde abcde}
    foo
} 1
test stringComp-3.8 {string equal with length, unequal strings} {
    proc foo {} {string equal -length 2 abc abde}
    foo
} 1

test stringComp-4.1 {string first, too few args} {
    proc foo {} {string first a}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test stringComp-4.2 {string first, bad args} {
    proc foo {} {string first a b c}
    list [catch {foo} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
test stringComp-4.3 {string first, too many args} {
    proc foo {} {string first a b 5 d}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
test stringComp-4.4 {string first} {
    proc foo {} {string first bq abcdefgbcefgbqrs}
    foo
} 12
test stringComp-4.5 {string first} {
    proc foo {} {string fir bcd abcdefgbcefgbqrs}
    foo
} 1
test stringComp-4.6 {string first} {
    proc foo {} {string f b abcdefgbcefgbqrs}
    foo
} 1
test stringComp-4.7 {string first} {
    proc foo {} {string first xxx x123xx345xxx789xxx012}
    foo
} 9
test stringComp-4.8 {string first} {
    proc foo {} {string first "" x123xx345xxx789xxx012}
    foo
} -1
test stringComp-4.9 {string first, unicode} {
    proc foo {} {string first x abc\u7266x}
    foo
} 4
test stringComp-4.10 {string first, unicode} {
    proc foo {} {string first \u7266 abc\u7266x}
    foo
} 3
test stringComp-4.11 {string first, start index} {
    proc foo {} {string first \u7266 abc\u7266x 3}
    foo
} 3
test stringComp-4.12 {string first, start index} {
    proc foo {} {string first \u7266 abc\u7266x 4}
    foo
} -1
test stringComp-4.13 {string first, start index} {
    proc foo {} {string first \u7266 abc\u7266x end-2}
    foo
} 3
test stringComp-4.14 {string first, negative start index} {
    proc foo {} {string first b abc -1}
    foo
} 1

test stringComp-5.1 {string index} {
    proc foo {} {string index}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test stringComp-5.2 {string index} {
    proc foo {} {string index a b c}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
test stringComp-5.3 {string index} {
    proc foo {} {string index abcde 0}
    foo
} a
test stringComp-5.4 {string index} {
    proc foo {} {string in abcde 4}
    foo
} e
test stringComp-5.5 {string index} {
    proc foo {} {string index abcde 5}
    foo
} {}
test stringComp-5.6 {string index} {
    proc foo {} {string index abcde -10}
    list [catch {foo} msg] $msg
} {0 {}}
test stringComp-5.7 {string index} {
    proc foo {} {string index a xyz}
    list [catch {foo} msg] $msg
} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
test stringComp-5.8 {string index} {
    proc foo {} {string index abc end}
    foo
} c
test stringComp-5.9 {string index} {
    proc foo {} {string index abc end-1}
    foo
} b
test stringComp-5.10 {string index, unicode} {
    proc foo {} {string index abc\u7266d 4}
    foo
} d
test stringComp-5.11 {string index, unicode} {
    proc foo {} {string index abc\u7266d 3}
    foo
} \u7266
test stringComp-5.12 {string index, unicode over char length, under byte length} {
    proc foo {} {string index \334\374\334\374 6}
    foo
} {}
test stringComp-5.13 {string index, bytearray object} {
    proc foo {} {string index [binary format a5 fuz] 0}
    foo
} f
test stringComp-5.14 {string index, bytearray object} {
    proc foo {} {string index [binary format I* {0x50515253 0x52}] 3}
    foo
} S
test stringComp-5.15 {string index, bytearray object} {
    proc foo {} {
	set b [binary format I* {0x50515253 0x52}]
	set i1 [string index $b end-6]
	set i2 [string index $b 1]
	string compare $i1 $i2
    }
    foo
} 0
test stringComp-5.16 {string index, bytearray object with string obj shimmering} {
    proc foo {} {
	set str "0123456789\x00 abcdedfghi"
	binary scan $str H* dump
	string compare [string index $str 10] \x00
    }
    foo
} 0
test stringComp-5.17 {string index, bad integer} -body {
    proc foo {} {string index "abc" 0o8}
    list [catch {foo} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test stringComp-5.18 {string index, bad integer} -body {
    proc foo {} {string index "abc" end-0o0289}
    list [catch {foo} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
test stringComp-5.19 {string index, bytearray object out of bounds} {
    proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
    foo
} {}
test stringComp-5.20 {string index, bytearray object out of bounds} {
    proc foo {} {string index [binary format I* {0x50515253 0x52}] 20}
    foo
} {}


proc largest_int {} {
    # This will give us what the largest valid int on this machine is,
    # so we can test for overflow properly below on >32 bit systems
    set int 1
    set exp 7; # assume we get at least 8 bits
    while {$int > 0} { set int [expr {1 << [incr exp]}] }
    return [expr {$int-1}]
}

## string is
## not yet bc

catch {rename largest_int {}}

## string last
## not yet bc

## string length
## not yet bc
test stringComp-8.1 {string bytelength} {
    proc foo {} {string bytelength}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test stringComp-8.2 {string bytelength} {
    proc foo {} {string bytelength a b}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
test stringComp-8.3 {string bytelength} {
    proc foo {} {string bytelength "\u00c7"}
    foo
} 2
test stringComp-8.4 {string bytelength} {
    proc foo {} {string b ""}
    foo
} 0

## string length
##
test stringComp-9.1 {string length} {
    proc foo {} {string length}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test stringComp-9.2 {string length} {
    proc foo {} {string length a b}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string length string"}}
test stringComp-9.3 {string length} {
    proc foo {} {string length "a little string"}
    foo
} 15
test stringComp-9.4 {string length} {
    proc foo {} {string le ""}
    foo
} 0
test stringComp-9.5 {string length, unicode} {
    proc foo {} {string le "abcd\u7266"}
    foo
} 5
test stringComp-9.6 {string length, bytearray object} {
    proc foo {} {string length [binary format a5 foo]}
    foo
} 5
test stringComp-9.7 {string length, bytearray object} {
    proc foo {} {string length [binary format I* {0x50515253 0x52}]}
    foo
} 8

## string map
## not yet bc

## string match
##
test stringComp-11.1 {string match, too few args} {
    proc foo {} {string match a}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test stringComp-11.2 {string match, too many args} {
    proc foo {} {string match a b c d}
    list [catch {foo} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
test stringComp-11.3 {string match} {
    proc foo {} {string match abc abc}
    foo
} 1
test stringComp-11.4 {string match} {
    proc foo {} {string mat abc abd}
    foo
} 0
test stringComp-11.5 {string match} {
    proc foo {} {string match ab*c abc}
    foo
} 1
test stringComp-11.6 {string match} {
    proc foo {} {string match ab**c abc}
    foo
} 1
test stringComp-11.7 {string match} {
    proc foo {} {string match ab* abcdef}
    foo
} 1
test stringComp-11.8 {string match} {
    proc foo {} {string match *c abc}
    foo
} 1
test stringComp-11.9 {string match} {
    proc foo {} {string match *3*6*9 0123456789}
    foo
} 1
test stringComp-11.10 {string match} {
    proc foo {} {string match *3*6*9 01234567890}
    foo
} 0
test stringComp-11.11 {string match} {
    proc foo {} {string match a?c abc}
    foo
} 1
test stringComp-11.12 {string match} {
    proc foo {} {string match a??c abc}
    foo
} 0
test stringComp-11.13 {string match} {
    proc foo {} {string match ?1??4???8? 0123456789}
    foo
} 1
test stringComp-11.14 {string match} {
    proc foo {} {string match {[abc]bc} abc}
    foo
} 1
test stringComp-11.15 {string match} {
    proc foo {} {string match {a[abc]c} abc}
    foo
} 1
test stringComp-11.16 {string match} {
    proc foo {} {string match {a[xyz]c} abc}
    foo
} 0
test stringComp-11.17 {string match} {
    proc foo {} {string match {12[2-7]45} 12345}
    foo
} 1
test stringComp-11.18 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12345}
    foo
} 1
test stringComp-11.19 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12b45}
    foo
} 1
test stringComp-11.20 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12d45}
    foo
} 1
test stringComp-11.21 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12145}
    foo
} 0
test stringComp-11.22 {string match} {
    proc foo {} {string match {12[ab2-4cd]45} 12545}
    foo
} 0
test stringComp-11.23 {string match} {
    proc foo {} {string match {a\*b} a*b}
    foo
} 1
test stringComp-11.24 {string match} {
    proc foo {} {string match {a\*b} ab}
    foo
} 0
test stringComp-11.25 {string match} {
    proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
    foo
} 1
test stringComp-11.26 {string match} {
    proc foo {} {string match ** ""}
    foo
} 1
test stringComp-11.27 {string match} {
    proc foo {} {string match *. ""}
    foo
} 0
test stringComp-11.28 {string match} {
    proc foo {} {string match "" ""}
    foo
} 1
test stringComp-11.29 {string match} {
    proc foo {} {string match \[a a}
    foo
} 1
test stringComp-11.30 {string match, bad args} {
    proc foo {} {string match - b c}
    list [catch {foo} msg] $msg
} {1 {bad option "-": must be -nocase}}
test stringComp-11.31 {string match case} {
    proc foo {} {string match a A}
    foo
} 0
test stringComp-11.32 {string match nocase} {
    proc foo {} {string match -n a A}
    foo
} 1
test stringComp-11.33 {string match nocase} {
    proc foo {} {string match -nocase a\334 A\374}
    foo
} 1
test stringComp-11.34 {string match nocase} {
    proc foo {} {string match -nocase a*f ABCDEf}
    foo
} 1
test stringComp-11.35 {string match case, false hope} {
    # This is true because '_' lies between the A-Z and a-z ranges
    proc foo {} {string match {[A-z]} _}
    foo
} 1
test stringComp-11.36 {string match nocase range} {
    # This is false because although '_' lies between the A-Z and a-z ranges,
    # we lower case the end points before checking the ranges.
    proc foo {} {string match -nocase {[A-z]} _}
    foo
} 0
test stringComp-11.37 {string match nocase} {
    proc foo {} {string match -nocase {[A-fh-Z]} g}
    foo
} 0
test stringComp-11.38 {string match case, reverse range} {
    proc foo {} {string match {[A-fh-Z]} g}
    foo
} 1
test stringComp-11.39 {string match, *\ case} {
    proc foo {} {string match {*\abc} abc}
    foo
} 1
test stringComp-11.40 {string match, *special case} {
    proc foo {} {string match {*[ab]} abc}
    foo
} 0
test stringComp-11.41 {string match, *special case} {
    proc foo {} {string match {*[ab]*} abc}
    foo
} 1
test stringComp-11.42 {string match, *special case} {
    proc foo {} {string match "*\\" "\\"}
    foo
} 0
test stringComp-11.43 {string match, *special case} {
    proc foo {} {string match "*\\\\" "\\"}
    foo
} 1
test stringComp-11.44 {string match, *special case} {
    proc foo {} {string match "*???" "12345"}
    foo
} 1
test stringComp-11.45 {string match, *special case} {
    proc foo {} {string match "*???" "12"}
    foo
} 0
test stringComp-11.46 {string match, *special case} {
    proc foo {} {string match "*\\*" "abc*"}
    foo
} 1
test stringComp-11.47 {string match, *special case} {
    proc foo {} {string match "*\\*" "*"}
    foo
} 1
test stringComp-11.48 {string match, *special case} {
    proc foo {} {string match "*\\*" "*abc"}
    foo
} 0
test stringComp-11.49 {string match, *special case} {
    proc foo {} {string match "?\\*" "a*"}
    foo
} 1
test stringComp-11.50 {string match, *special case} {
    proc foo {} {string match "\\" "\\"}
    foo
} 0
test stringComp-11.51 {string match; *, -nocase and UTF-8} {
    proc foo {} {string match -nocase [binary format I 717316707] \
	    [binary format I 2028036707]}
    foo
} 1
test stringComp-11.52 {string match, null char in string} {
    proc foo {} {
	set ptn "*abc*"
	foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] {
	    lappend out [string match $ptn $elem]
	}
	set out
    }
    foo
} {1 1 1 1}
test stringComp-11.53 {string match, null char in pattern} {
    proc foo {} {
	set out ""
	foreach {ptn elem} [list \
		"*\u0000abc\u0000"  "\u0000abc\u0000" \
		"*\u0000abc\u0000"  "\u0000abc\u0000ef" \
		"*\u0000abc\u0000*" "\u0000abc\u0000ef" \
		"*\u0000abc\u0000"  "@\u0000abc\u0000ef" \
		"*\u0000abc\u0000*"  "@\u0000abc\u0000ef" \
		] {
	    lappend out [string match $ptn $elem]
	}
	set out
    }
    foo
} {1 0 1 0 1}
test stringComp-11.54 {string match, failure} {
    proc foo {} {
	set longString ""
	for {set i 0} {$i < 10} {incr i} {
	    append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123"
	}
	list [string match *cba* $longString] \
		[string match *a*l*\u0000* $longString] \
		[string match *a*l*\u0000*123 $longString] \
		[string match *a*l*\u0000*123* $longString] \
		[string match *a*l*\u0000*cba* $longString] \
		[string match *===* $longString]
    }
    foo
} {0 1 1 1 0 0}

## string range
## not yet bc

## string repeat
## not yet bc

## string replace
## not yet bc

## string tolower
## not yet bc

## string toupper
## not yet bc

## string totitle
## not yet bc

## string trim*
## not yet bc

## string word*
## not yet bc

# cleanup
::tcltest::cleanupTests
return

Changes to tests/stringObj.test.

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
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







-
-
+
+



-
-
-

-

-




-
-
+
+







#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint fullutf [expr {[string length \U010000] == 1}]

test stringObj-1.1 {string type registration} testobj {
    set t [testobj types]
    set first [string first "string" $t]
    set result [expr {$first >= 0}]
} 1
    set result [expr {$first != -1}]
} {1}

test stringObj-2.1 {Tcl_NewStringObj} testobj {
    set result ""
    lappend result [testobj freeallvars]
    lappend result [teststringobj set 1 abcd]
    lappend result [testobj type 1]
    lappend result [testobj refcount 1]
135
136
137
138
139
140
141
142

143
144
145
146
147
148
149
130
131
132
133
134
135
136

137
138
139
140
141
142
143
144







-
+







    list [teststringobj length 1] [teststringobj get 1]
} {15 {abc 123 abcdefg}}
test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if initial string empty} testobj {
    testobj freeallvars
    testobj newobj 1
    teststringobj appendstrings 1 123 abcdefg
    list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
} {10 20 123abcdefg}
} {10 10 123abcdefg}
test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
    testobj freeallvars
    teststringobj set 1 abc
    teststringobj setlength 1 10
    teststringobj setlength 1 2
    teststringobj appendstrings 1 34567890
    list [teststringobj length 1] [teststringobj length2 1] \
198
199
200
201
202
203
204
205

206
207

208
209
210
211
212
213
214
193
194
195
196
197
198
199

200
201

202
203
204
205
206
207
208
209







-
+

-
+








test stringObj-8.1 {DupStringInternalRep procedure} testobj {
    testobj freeallvars
    teststringobj set 1 {}
    teststringobj append 1 abcde -1
    testobj duplicate 1 2
    list [teststringobj length 1] [teststringobj length2 1] \
	    [teststringobj maxchars 1] [teststringobj get 1] \
	    [teststringobj ualloc 1] [teststringobj get 1] \
	    [teststringobj length 2] [teststringobj length2 2] \
	    [teststringobj maxchars 2] [teststringobj get 2]
	    [teststringobj ualloc 2] [teststringobj get 2]
} {5 10 0 abcde 5 5 0 abcde}
test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
    set x abc\u00ef\u00bf\u00aeghi
    string length $x
    set y $x
    list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
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
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







-
+
















-
+








-
+















-
+







test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {testobj testdstring} {
    set x abc\u00ef\u00bf\u00aeghi
    testdstring free
    testdstring append \u00ae\u00bf\u00ef -1
    set y [testdstring get]
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
            [set y] [testobj objtype $x] [testobj objtype $y]
} "string none abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none"
test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj {
    set x abc\u00ef\u00bf\u00aeghi
    string length $x
    list [testobj objtype $x] [append x $x] [testobj objtype $x] \
	    [append x $x] [testobj objtype $x]
} "string abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\
abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\
string"
test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} {
    set x abcdefghi
    testdstring free
    testdstring append \u00ae\u00bf\u00ef -1
    set y [testdstring get]
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
            [set y] [testobj objtype $x] [testobj objtype $y]
} "string none abcdefghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none"
test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj testdstring} {
    set x abcdefghi
    testdstring free
    testdstring append jkl -1
    set y [testdstring get]
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
            [set y] [testobj objtype $x] [testobj objtype $y]
} {string none abcdefghijkl jkl string none}
test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj {
    set x abcdefghi
    string length $x
    list [testobj objtype $x] [append x $x] [testobj objtype $x] \
	    [append x $x] [testobj objtype $x]
} {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
string}
test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj testdstring} {
    set x abc\u00ef\u00bf\u00aeghi
    testdstring free
    testdstring append jkl -1
    set y [testdstring get]
    string length $x
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
	    [set y] [testobj objtype $x] [testobj objtype $y]
            [set y] [testobj objtype $x] [testobj objtype $y]
} "string none abc\u00ef\u00bf\u00aeghijkl jkl string none"
test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj {
    set x [expr {4 * 5}]
    set y [expr {4 + 5}]
    list [testobj objtype $x] [testobj objtype $y] [append x $y] \
	    [testobj objtype $x] [append x $y] [testobj objtype $x] \
	    [testobj objtype $y]
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
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







-
+











-
+







} "a b c d e f a \u00fc b \u00e5 c \u00ef"

test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring} {
    testdstring free
    testdstring append abcdef -1
    set x [testdstring get]
    list [testobj objtype $x] [set y [string range $x 1 end-1]] \
	    [testobj objtype $x] [testobj objtype $y]
            [testobj objtype $x] [testobj objtype $y]
} [list none bcde string string]
test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstring} {
    # Because this test does not use \uXXXX notation below instead of
    # hardcoding the values, it may fail in multibyte locales. However, we
    # need to test that the parser produces untyped objects even when there
    # are high-ASCII characters in the input (like "ï"). I don't know what
    # else to do but inline those characters here.
    testdstring free
    testdstring append "abc\u00ef\u00efdef" -1
    set x [testdstring get]
    list [testobj objtype $x] [set y [string range $x 1 end-1]] \
	    [testobj objtype $x] [testobj objtype $y]
            [testobj objtype $x] [testobj objtype $y]
} [list none "bc\u00EF\u00EFde" string string]
test stringObj-10.3 {Tcl_GetRange with some mixed width chars} testobj {
    # set x "abcïïdef"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise
    # the test will fail in multibyte locales.
    set x "abc\u00EF\u00EFdef"
    string length $x
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
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







-
+

-
+

-
-
+
+




-
+

-
+







test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} testobj {
    # set a "ïa¿b®cï¿d®"
    # Use \uXXXX notation below instead of hardcoding the values, otherwise
    # the test will fail in multibyte locales.
    set a "\u00EFa\u00BFb\u00AEc\u00EF\u00BFd\u00AE"
    list [string length $a] [string length $a]
} {10 10}
test stringObj-13.7 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} {
test stringObj-13.7 {Tcl_GetCharLength with identity nulls} testobj {
    # SF bug #684699
    string length [testbytestring \x00]
    string length [bytestring \x00]
} 1
test stringObj-13.8 {Tcl_GetCharLength with identity nulls} {testobj testbytestring} {
    string length [testbytestring \x01\x00\x02]
test stringObj-13.8 {Tcl_GetCharLength with identity nulls} testobj {
    string length [bytestring \x01\x00\x02]
} 3

test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj {
    teststringobj set 1 foo
    teststringobj maxchars 1
    teststringobj getunicode 1
    teststringobj append 1 bar -1
    teststringobj maxchars 1
    teststringobj getunicode 1
    teststringobj append 1 bar -1
    teststringobj setlength 1 0
    teststringobj append 1 bar -1
    teststringobj get 1
} {bar}

test stringObj-15.1 {Tcl_Append*ToObj: self appends} testobj {
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
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











-
+



-
+



-
+



-
+



-
+







-
-
-
-
    teststringobj set 1 foo
    teststringobj appendself 1 2
} fooo
test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
    teststringobj set 1 foo
    teststringobj appendself 1 3
} foo
test stringObj-15.5 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
test stringObj-15.5 {Tcl_Append*ToObj: self appends} testobj {
    teststringobj set 1 foo
    teststringobj appendself2 1 0
} foofoo
test stringObj-15.6 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
test stringObj-15.6 {Tcl_Append*ToObj: self appends} testobj {
    teststringobj set 1 foo
    teststringobj appendself2 1 1
} foooo
test stringObj-15.7 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
test stringObj-15.7 {Tcl_Append*ToObj: self appends} testobj {
    teststringobj set 1 foo
    teststringobj appendself2 1 2
} fooo
test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj fullutf} {
test stringObj-15.8 {Tcl_Append*ToObj: self appends} testobj {
    teststringobj set 1 foo
    teststringobj appendself2 1 3
} foo


if {[testConstraint testobj]} {
    testobj freeallvars
}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/subst.test.

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
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













-
-
+
+


-
-

-
-
-
-
-
-
-
-
+
+
+
+
+
+










-
+

-
-
+
+


















-
+

-



-
+








-
-
-
+
+
+







# Commands covered:  subst
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

test subst-1.1 {basics} -returnCodes error -body {
    subst
} -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}
test subst-1.2 {basics} -returnCodes error -body {
    subst a b c
} -result {bad option "a": must be -nobackslashes, -nocommands, or -novariables}
test subst-1.1 {basics} {
    list [catch {subst} msg] $msg
} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
test subst-1.2 {basics} {
    list [catch {subst a b c} msg] $msg
} {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}

test subst-2.1 {simple strings} {
    subst {}
} {}
test subst-2.2 {simple strings} {
    subst a
} a
test subst-2.3 {simple strings} {
    subst abcdefg
} abcdefg
test subst-2.4 {simple strings} testbytestring {
test subst-2.4 {simple strings} {
    # Tcl Bug 685106
    expr {[subst [testbytestring bar\x00soom]] eq [testbytestring bar\x00soom]}
} 1
    subst [bytestring bar\x00soom]
} [bytestring bar\x00soom]

test subst-3.1 {backslash substitutions} {
    subst {\x\$x\[foo bar]\\}
} "x\$x\[foo bar]\\"
test subst-3.2 {backslash substitutions with utf chars} {
    # 'j' is just a char that doesn't mean anything, and \344 is 'ä'
    # that also doesn't mean anything, but is multi-byte in UTF-8.
    list [subst \j] [subst \\j] [subst \\344] [subst \\\344]
} "j j \344 \344"

test subst-4.1 {variable substitutions} {
    set a 44
    subst {$a}
} {44}
test subst-4.2 {variable substitutions} {
    set a 44
    subst {x$a.y{$a}.z}
} {x44.y{44}.z}
test subst-4.3 {variable substitutions} -setup {
test subst-4.3 {variable substitutions} {
    catch {unset a}
} -body {
    set a(13) 82
    set i 13
    subst {x.$a($i)}
} -result {x.82}
} {x.82}
catch {unset a}
set long {This is a very long string, intentionally made so long that it
	will overflow the static character size for dstrings, so that
	additional memory will have to be allocated by subst.  That way,
	if the subst procedure forgets to free up memory while returning
	an error, there will be memory that isn't freed (this will be
	detected when the tests are run under a checking memory allocator
	such as Purify).}
test subst-4.4 {variable substitutions} -returnCodes error -body {
    subst {$long $a}
} -result {can't read "a": no such variable}
test subst-4.4 {variable substitutions} {
    list [catch {subst {$long $a}} msg] $msg
} {1 {can't read "a": no such variable}}

test subst-5.1 {command substitutions} {
    subst {[concat {}]}
} {}
test subst-5.2 {command substitutions} {
    subst {[concat A test string]}
} {A test string}
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
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







-
+

-
-
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







    list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}
test subst-5.10 {command substitutions} {
    set script {[subst {0[set a 1; set a 2}]}
    list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}

test subst-6.1 {clear the result after command substitution} -body {
test subst-6.1 {clear the result after command substitution} {
    catch {unset a}
    subst {[concat foo] $a}
} -returnCodes error -result {can't read "a": no such variable}
    list [catch {subst {[concat foo] $a}} msg] $msg
} {1 {can't read "a": no such variable}}

test subst-7.1 {switches} -returnCodes error -body {
    subst foo bar
} -result {bad option "foo": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.2 {switches} -returnCodes error -body {
    subst -no bar
} -result {ambiguous option "-no": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.3 {switches} -returnCodes error -body {
    subst -bogus bar
} -result {bad option "-bogus": must be -nobackslashes, -nocommands, or -novariables}
test subst-7.1 {switches} {
    list [catch {subst foo bar} msg] $msg
} {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}
test subst-7.2 {switches} {
    list [catch {subst -no bar} msg] $msg
} {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
test subst-7.3 {switches} {
    list [catch {subst -bogus bar} msg] $msg
} {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
test subst-7.4 {switches} {
    set x 123
    subst -nobackslashes {abc $x [expr 1+2] \\\x41}
} {abc 123 3 \\\x41}
test subst-7.5 {switches} {
    set x 123
    subst -nocommands {abc $x [expr 1+2] \\\x41}
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
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







-
-
-
+
+
+

-
+


-
+





-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
+
+







} {foo x bar}
test subst-8.4 {return in a subst} {
    subst {[eval {return hi}] there}
} {hi there}
test subst-8.5 {return in a subst} {
    subst {foo [return {]}; bogus code] bar}
} {foo ] bar}
test subst-8.6 {return in a subst} -returnCodes error -body {
    subst "foo \[return {x}; bogus code bar"
} -result {missing close-bracket}
test subst-8.6 {return in a subst} {
    list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg
} {1 {missing close-bracket}}
test subst-8.7 {return in a subst, parse error} -body {
    subst {foo [return {x} ; set a {}"" ; stuff] bar}
    subst {foo [return {x} ; set a {}" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.8 {return in a subst, parse error} -body {
    subst {foo [return {x} ; set bar baz ; set a {}"" ; stuff] bar}
    subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.9 {return in a variable subst} {
    subst {foo $var([return {x}]) bar}
} {foo x bar}

test subst-9.1 {error in a subst} -body {
    subst {[error foo; bogus code]bar}
} -returnCodes error -result foo
test subst-9.2 {error in a subst} -body {
    subst {[if 1 { error foo; bogus code}]bar}
} -returnCodes error -result foo
test subst-9.3 {error in a variable subst} -setup {
test subst-9.1 {error in a subst} {
    list [catch {subst {[error foo; bogus code]bar}} msg] $msg
} {1 foo}
test subst-9.2 {error in a subst} {
    list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
} {1 foo}
test subst-9.3 {error in a variable subst} {
    catch {unset var}
} -body {
    subst {foo $var([error foo]) bar}
} -returnCodes error -result foo
    list [catch {subst {foo $var([error foo]) bar}} msg] $msg
} {1 foo}

test subst-10.1 {break in a subst} {
    subst {foo [break; bogus code] bar}
} {foo }
test subst-10.2 {break in a subst} {
    subst {foo [break; return x; bogus code] bar}
} {foo }
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
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











-
+






-
+







-
-
+
+






-
-
+
+






-
-
+
+
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
} {foo  bar}

test subst-12.1 {nasty case, Bug 1036649} {
    for {set i 0} {$i < 10} {incr i} {
	set res [list [catch {subst "\[subst {};"} msg] $msg]
	if {$msg ne "missing close-bracket"} break
    }
    return $res
    set res
} {1 {missing close-bracket}}
test subst-12.2 {nasty case, Bug 1036649} {
    for {set i 0} {$i < 10} {incr i} {
	set res [list [catch {subst "\[subst {}; "} msg] $msg]
	if {$msg ne "missing close-bracket"} break
    }
    return $res
    set res
} {1 {missing close-bracket}}
test subst-12.3 {nasty case, Bug 1036649} {
    set x 0
    for {set i 0} {$i < 10} {incr i} {
	set res [list [catch {subst "\[incr x;"} msg] $msg]
	if {$msg ne "missing close-bracket"} break
    }
    lappend res $x
} {1 {missing close-bracket} 10}
    list $res $x
} {{1 {missing close-bracket}} 10}
test subst-12.4 {nasty case, Bug 1036649} {
    set x 0
    for {set i 0} {$i < 10} {incr i} {
	set res [list [catch {subst "\[incr x; "} msg] $msg]
	if {$msg ne "missing close-bracket"} break
    }
    lappend res $x
} {1 {missing close-bracket} 10}
    list $res $x
} {{1 {missing close-bracket}} 10}
test subst-12.5 {nasty case, Bug 1036649} {
    set x 0
    for {set i 0} {$i < 10} {incr i} {
	set res [list [catch {subst "\[incr x"} msg] $msg]
	if {$msg ne "missing close-bracket"} break
    }
    lappend res $x
} {1 {missing close-bracket} 0}
    list $res $x
} {{1 {missing close-bracket}} 0}
test subst-12.6 {nasty case with compilation} {
    set x unset
    set y unset
    list [eval [list subst {[set x 1;break;incr x][set y $x]}]] $x $y
} {{} 1 unset}
test subst-12.7 {nasty case with compilation} {
    set x unset
    set y unset
    list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y
} {1 1 1}

test subst-13.1 {Bug 3081065} -setup {
    set script [makeFile {
	proc demo {string} {
	    subst $string
	}
	demo name2
    } subst13.tcl]
} -body {
    interp create child
    child eval [list source $script]
    interp delete child
    interp create child
    child eval {
	set count 400
	while {[incr count -1]} {
	    lappend bloat [expr {rand()}]
	}
    }
    child eval [list source $script]
    interp delete child
} -cleanup {
    removeFile subst13.tcl
}
test subst-13.2 {Test for segfault} -body {
    subst {[}
} -returnCodes error -result * -match glob


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/switch.test.

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
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













-
-
+
+


-
+







# Commands covered:  switch
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}


test switch-1.1 {simple patterns} {
    switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 1
test switch-1.2 {simple patterns} {
    switch b a {subst 1} b {subst 2} c {subst 3} default {subst 4}
} 2
test switch-1.3 {simple patterns} {
165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
165
166
167
168
169
170
171

172
173
174
175
176
177
178
179







-
+







    while executing
"error "Just a test""
    ("a" arm line 1)
    invoked from within
"switch a a {error "Just a test"} default {subst 1}"}}
test switch-4.2 {error: not enough args} -returnCodes error -body {
    switch
} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"}
} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}
test switch-4.3 {error: pattern with no body} -body {
    switch a b
} -returnCodes error -result {extra switch pattern with no body}
test switch-4.4 {error: pattern with no body} -body {
    switch a b {subst 1} c
} -returnCodes error -result {extra switch pattern with no body}
test switch-4.5 {error in default command} {
265
266
267
268
269
270
271
272

273
274
275
276
277
278

279
280
281

282
283
284
285
286
287
288
265
266
267
268
269
270
271

272
273
274
275
276
277

278
279
280

281
282
283
284
285
286
287
288







-
+





-
+


-
+







    switch Foo {
    	Foo {$cmd}
    }
} {INVOKED}

test switch-9.1 {empty pattern/body list} -returnCodes error -body {
    switch x
} -result {wrong # args: should be "switch ?-option ...? string ?pattern body ...? ?default body?"}
} -result {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}
test switch-9.2 {unpaired pattern} -returnCodes error -body {
    switch -- x
} -result {extra switch pattern with no body}
test switch-9.3 {empty pattern/body list} -body {
    switch x {}
} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"}
} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}
test switch-9.4 {empty pattern/body list} -body {
    switch -- x {}
} -returnCodes error -result {wrong # args: should be "switch ?-option ...? string {?pattern body ...? ?default body?}"}
} -returnCodes error -result {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}
test switch-9.5 {unpaired pattern} -body {
    switch x a {} b
} -returnCodes error -result {extra switch pattern with no body}
test switch-9.6 {unpaired pattern} -body {
    switch x {a {} b}
} -returnCodes error -result {extra switch pattern with no body}
test switch-9.7 {unpaired pattern} -body {
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
742
743
744
745
746
747
748
















749

750
751
752
753
754
755







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-






	    {[012]} {return yes}
	    .+ {return yes2}
	    default {return no}
	}
    }}
} no

test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{
    -body {
	proc coro {} {
	    switch -glob a {
		a {yield ok1}
	    }
	    return ok2
	}
	list [coroutine c coro] [c]
    }
    -result {ok1 ok2}
    -cleanup {
	rename coro {}
    }
}

# cleanup
catch {rename foo {}}
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/tailcall.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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












































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Commands covered:  tailcall
#
# This file contains a collection of tests for experimental commands that are
# found in ::tcl::unsupported. The tests will migrate to normal test files
# if/when the commands find their way into the core.
#
# Copyright (c) 2008 by Miguel Sofer.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testnrelevels [llength [info commands testnrelevels]]

#
# The tests that risked blowing the C stack on failure have been removed: we
# can now actually measure using testnrelevels.
#

if {[testConstraint testnrelevels]} {
    namespace eval testnre {
	#
	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
	# cmdFrame level, callFrame level, tosPtr and callback depth
	#
	variable last [testnrelevels]
	proc depthDiff {} {
	    variable last
	    set depth [testnrelevels]
	    set res {}
	    foreach t $depth l $last {
		lappend res [expr {$t-$l}]
	    }
	    set last $depth
	    return $res
	}
	namespace export *
    }
    namespace import testnre::*
}

proc errorcode options {
    dict get [dict merge {-errorcode NONE} $options] -errorcode
}

test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup {
    proc a i {
	#
	# NOTE: there may be a diff in callback depth with the first call
	# ($i==0) due to the fact that the first is from an eval. Successive
	# calls should add nothing to any stack depths.
	#
	if {$i == 1} {
	    depthDiff
	}
	if {[incr i] > 10} {
	    return [depthDiff]
	}
	tailcall a $i
    }
} -body {
    a 0
} -cleanup {
    rename a {}
} -result {0 0 0 0 0 0}

test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup {
    set a { i {
	if {$i == 1} {
	    depthDiff
	}
	if {[incr i] > 10} {
	    return [depthDiff]
	}
	upvar 1 a a
	tailcall apply $a $i
    }}
} -body {
    apply $a 0
} -cleanup {
    unset a
} -result {0 0 0 0 0 0}

test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup {
    proc a i {
	if {$i == 1} {
	    depthDiff
	}
	if {[incr i] > 10} {
	    return [depthDiff]
	}
	tailcall b $i
    }
    interp alias {} b {} a
} -body {
    b 0
} -cleanup {
    rename a {}
    rename b {}
} -result {0 0 0 0 0 0}

test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup {
    namespace eval ::ns {
	namespace export *
    }
    proc ::ns::a i {
	if {$i == 1} {
	    depthDiff
	}
	if {[incr i] > 10} {
	    return [depthDiff]
	}
	set b [uplevel 1 [list namespace which b]]
	tailcall $b $i
    }
    namespace import ::ns::a
    rename a b
} -body {
    b 0
} -cleanup {
    rename b {}
    namespace delete ::ns
} -result {0 0 0 0 0 0}

test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup {
    proc b i {
	if {$i == 1} {
	    depthDiff
	}
	if {[incr i] > 10} {
	    return [depthDiff]
	}
	tailcall a b $i
    }
    namespace ensemble create -command a -map {b b}
} -body {
    a b 0
} -cleanup {
    rename a {}
    rename b {}
} -result {0 0 0 0 0 0}

test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup {
    #
    # This test is related to [bug d87cb182053fd79b3]: the fix to that bug was
    # to remove a call to TclSkipTailcall, which caused a violation of the
    # constant-space property of tailcall in that particular
    # configuration. This test was added to detect that, and insure that the
    # problem is fixed.
    #

    proc b i {
	if {$i == 1} {
	    depthDiff
	}
	if {[incr i] > 10} {
	    return [depthDiff]
	}
	tailcall dict b $i
    }
    set map0 [namespace ensemble configure dict -map]
    set map $map0
    dict set map b b
    namespace ensemble configure dict -map $map
} -body {
    dict b 0
} -cleanup {
    rename b {}
    namespace ensemble configure dict -map $map0
    unset map map0
} -result {0 0 0 0 0 0}

test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup {
    #
    # This test fails because ns-unknown is not NR-enabled
    #
    proc c i {
	if {$i == 1} {
	    depthDiff
	}
	if {[incr i] > 10} {
	    return [depthDiff]
	}
	tailcall a b $i
    }
    proc d {ens sub args} {
	return [list $ens c]
    }
    namespace ensemble create -command a -unknown d
} -body {
    a b 0
} -cleanup {
    rename a {}
    rename c {}
    rename d {}
} -result {0 0 0 0 0 0}

test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup {
    catch {rename foo {}}
    oo::class create foo {
	method b i {
	    if {$i == 1} {
		depthDiff
	    }
	    if {[incr i] > 10} {
		return [depthDiff]
	    }
	    tailcall [self] b $i
	}
    }
} -body {
    foo create a
    a b 0
} -cleanup {
    rename a {}
    rename foo {}
} -result {0 0 0 0 0 0}

test tailcall-1 {tailcall} -body {
    namespace eval a {
	variable x *::a
	proc xset {} {
	    set tmp {}
	    set ns {[namespace current]}
	    set level [info level]
	    for {set i 0} {$i <= [info level]} {incr i} {
		uplevel #$i "set x $i$ns"
		lappend tmp "$i [info level $i]"
	    }
	    lrange $tmp 1 end
	}
	proc foo {} {tailcall xset; set x noreach}
    }
    namespace eval b {
	variable x *::b
	proc xset args {error b::xset}
	proc moo {} {set x 0; variable y [::a::foo]; set x}
    }
    variable x *::
    proc xset args {error ::xset}
    list [::b::moo] | $x $a::x $b::x | $::b::y
} -cleanup {
    unset x
    rename xset {}
    namespace delete a b
} -result {1::b | 0:: *::a *::b | {{1 ::b::moo} {2 xset}}}


test tailcall-2 {tailcall in non-proc} -body {
    namespace eval a [list tailcall set x 1]
} -match glob -result *tailcall* -returnCodes error

test tailcall-3 {tailcall falls off tebc} -body {
    unset -nocomplain x
    proc foo {} {tailcall set x 1}
    list [catch foo msg] $msg [set x]
} -cleanup {
    rename foo {}
    unset x
} -result {0 1 1}

test tailcall-4 {tailcall falls off tebc} -body {
    set x 2
    proc foo {} {tailcall set x 1}
    foo
    set x
} -cleanup {
    rename foo {}
    unset x
} -result 1

test tailcall-5 {tailcall falls off tebc} -body {
    set x 2
    namespace eval bar {
	variable x 3
	proc foo {} {tailcall set x 1}
    }
    bar::foo
    list $x $bar::x
} -cleanup {
    unset x
    namespace delete bar
} -result {1 3}

test tailcall-6 {tailcall does remove callframes} -body {
    proc foo {} {info level}
    proc moo {} {tailcall foo}
    proc boo {} {expr {[moo] - [info level]}}
    boo
} -cleanup {
    rename foo {}
    rename moo {}
    rename boo {}
} -result 1

test tailcall-7 {tailcall does return} -setup {
    namespace eval ::foo {
	variable res {}
	proc a {} {
	    variable res
	    append res a
	    tailcall set x 1
	    append res a
	}
	proc b {} {
	    variable res
	    append res b
	    a
	    append res b
	}
	proc c {} {
	    variable res
	    append res c
	    b
	    append res c
	}
    }
} -body {
    namespace eval ::foo c
} -cleanup {
    namespace delete ::foo
} -result cbabc

test tailcall-8 {tailcall tailcall} -setup {
    namespace eval ::foo {
	variable res {}
	proc a {} {
	    variable res
	    append res a
	    tailcall tailcall set x 1
	    append res a
	}
	proc b {} {
	    variable res
	    append res b
	    a
	    append res b
	}
	proc c {} {
	    variable res
	    append res c
	    b
	    append res c
	}
    }
} -body {
    namespace eval ::foo c
} -cleanup {
    namespace delete ::foo
} -result cbac

test tailcall-9 {tailcall factorial} -setup {
    proc fact {n {b 1}} {
	if {$n == 1} {
	    return $b
	}
	tailcall fact [expr {$n-1}] [expr {$n*$b}]
    }
} -body {
    list [fact 1] [fact 5] [fact 10] [fact 15]
} -cleanup {
    rename fact {}
} -result {1 120 3628800 1307674368000}

test tailcall-10a {tailcall and eval} -setup {
    set ::x 0
    proc a {} {
	eval [list tailcall lappend ::x 2]
	set ::x 1
    }
} -body {
    list [a] $::x
} -cleanup {
    unset -nocomplain ::x
} -result {{0 2} {0 2}}

test tailcall-10b {tailcall and eval} -setup {
    set ::x 0
    proc a {} {
	eval {tailcall lappend ::x 2}
	set ::x 1
    }
} -body {
    list [a] $::x
} -cleanup {
    unset -nocomplain ::x
} -result {{0 2} {0 2}}

test tailcall-11a {tailcall and uplevel} -setup {
    proc a {} {
	uplevel 1 [list tailcall set ::x 2]
	set ::x 1
    }
} -body {
    list [a] $::x
} -cleanup {
    unset -nocomplain ::x
} -match glob -result *tailcall* -returnCodes error

test tailcall-11b {tailcall and uplevel} -setup {
    proc a {} {
	uplevel 1 {tailcall set ::x 2}
	set ::x 1
    }
} -body {
    list [a] $::x
} -cleanup {
    unset -nocomplain ::x
} -match glob -result *tailcall* -returnCodes error

test tailcall-11c {tailcall and uplevel} -setup {
    proc a {} {
	uplevel 1 {tailcall lappend ::x 2}
	set ::x 1
    }
    proc b {} {set ::x 0; a; lappend ::x 3}
} -body {
    list [b] $::x
} -cleanup {
    rename a {}
    rename b {}
    unset -nocomplain ::x
} -result {{0 3 2} {0 3 2}}

test tailcall-12.1 {[Bug 2649975]} -setup {
    proc dump {{text {}}} {
	set text [uplevel 1 [list subst $text]]
	set l [expr {[info level] -1}]
	if {$text eq {}} {
	    set text [info level $l]
	}
	puts "$l: $text"
    }
    # proc dump args {}
    proc bravo {} {
	upvar 1 v w
	dump {inside bravo, v -> $w}
	set v "procedure bravo"
	#uplevel 1 [list delta ::betty]
	uplevel 1 {delta ::betty}
	return $::resolution
    }
    proc delta name {
	upvar 1 v w
	dump {inside delta, v -> $w}
	set v "procedure delta"
	tailcall foxtrot
    }
    proc foxtrot {} {
	upvar 1 v w
	dump {inside foxtrot, v -> $w}
	global resolution
	set ::resolution $w
    }
    set v "global level"
} -body {
    set result [bravo]
    if {$result ne $v} {
	puts "v should have been found at $v but was found in $result"
    }
} -cleanup {
    unset v
    rename dump {}
    rename bravo {}
    rename delta {}
    rename foxtrot {}
} -output {1: inside bravo, v -> global level
1: inside delta, v -> global level
1: inside foxtrot, v -> global level
}

test tailcall-12.2 {[Bug 2649975]} -setup {
    proc dump {{text {}}} {
	set text [uplevel 1 [list subst $text]]
	set l [expr {[info level] -1}]
	if {$text eq {}} {
	    set text [info level $l]
	}
	puts "$l: $text"
    }
    # proc dump args {}
    set v "global level"
    oo::class create foo { # like connection
	method alpha {} {  # like connections 'tables' method
	    dump
	    upvar 1 v w
	    dump {inside foo's alpha, v resolves to $w}
	    set v "foo's method alpha"
	    dump {foo's alpha is calling [self] bravo - v should resolve at global level}
	    set result [uplevel 1 [list [self] bravo]]
	    dump {exiting from foo's alpha}
	    return $result
	}
	method bravo {} {  # like connections 'foreach' method
	    dump
	    upvar 1 v w
	    dump {inside foo's bravo, v resolves to $w}
	    set v "foo's method bravo"
	    dump {foo's bravo is calling charlie to create barney}
	    set barney [my charlie ::barney]
	    dump {foo's bravo is calling bravo on $barney}
	    dump {v should resolve at global scope there}
	    set result [uplevel 1 [list $barney bravo]]
	    dump {exiting from foo's bravo}
	    return $result
	}
	method charlie {name} {  # like tdbc prepare
	    dump
	    set v "foo's method charlie"
	    dump {tailcalling bar's constructor}
	    tailcall ::bar create $name
	}
    }
    oo::class create bar { # like statement
	method  bravo {} {   # like statement foreach method
	    dump
	    upvar 1 v w
	    dump {inside bar's bravo, v is resolving to $w}
	    set v "bar's method bravo"
	    dump {calling delta to construct betty - v should resolve global there}
	    uplevel 1 [list [self] delta ::betty]
	    dump {exiting from bar's bravo}
	    return [::betty whathappened]
	}
	method delta {name} {    # like statement execute method
	    dump
	    upvar 1 v w
	    dump {inside bar's delta, v is resolving to $w}
	    set v "bar's method delta"
	    dump {tailcalling to construct $name as instance of grill}
	    dump {v should resolve at global level in grill's constructor}
	    dump {grill's constructor should run at level [info level]}
	    tailcall grill create $name
	}
    }
    oo::class create grill {
	variable resolution
	constructor {} {
	    dump
	    upvar 1 v w
	    dump "in grill's constructor, v resolves to $w"
	    set resolution $w
	}
	method whathappened {} {
	    return $resolution
	}
    }
    foo create fred
} -body {
    set result [fred alpha]
    if {$result ne "global level"} {
	puts "v should have been found at global level but was found in $result"
    }
} -cleanup {
    unset result
    rename fred {}
    rename dump {}
    rename foo {}
    rename bar {}
    rename grill {}
} -output {1: fred alpha
1: inside foo's alpha, v resolves to global level
1: foo's alpha is calling ::fred bravo - v should resolve at global level
1: ::fred bravo
1: inside foo's bravo, v resolves to global level
1: foo's bravo is calling charlie to create barney
2: my charlie ::barney
2: tailcalling bar's constructor
1: foo's bravo is calling bravo on ::barney
1: v should resolve at global scope there
1: ::barney bravo
1: inside bar's bravo, v is resolving to global level
1: calling delta to construct betty - v should resolve global there
1: ::barney delta ::betty
1: inside bar's delta, v is resolving to global level
1: tailcalling to construct ::betty as instance of grill
1: v should resolve at global level in grill's constructor
1: grill's constructor should run at level 1
1: grill create ::betty
1: in grill's constructor, v resolves to global level
1: exiting from bar's bravo
1: exiting from foo's bravo
1: exiting from foo's alpha
}

test tailcall-12.3a0 {[Bug 2695587]} -body {
    apply {{} {
	catch [list tailcall foo]
    }}
} -returnCodes 1 -result {invalid command name "foo"}

test tailcall-12.3a1 {[Bug 2695587]} -body {
    apply {{} {
	catch [list tailcall foo]
	tailcall
    }}
} -result {}

test tailcall-12.3a2 {[Bug 2695587]} -body {
    apply {{} {
	catch [list tailcall foo]
	tailcall moo
    }}
} -returnCodes 1 -result {invalid command name "moo"}

test tailcall-12.3a3 {[Bug 2695587]} -body {
    set x 0
    apply {{} {
	catch [list tailcall foo]
	tailcall lappend x 1
    }}
    set x
} -cleanup {
    unset x
} -result {0 1}

test tailcall-12.3b0 {[Bug 2695587]} -body {
    apply {{} {
	set catch catch
	$catch [list tailcall foo]
    }}
} -returnCodes 1 -result {invalid command name "foo"}

test tailcall-12.3b1 {[Bug 2695587]} -body {
    apply {{} {
	set catch catch
	$catch [list tailcall foo]
	tailcall
    }}
} -result {}

test tailcall-12.3b2 {[Bug 2695587]} -body {
    apply {{} {
	set catch catch
	$catch [list tailcall foo]
	tailcall moo
    }}
} -returnCodes 1 -result {invalid command name "moo"}

test tailcall-12.3b3 {[Bug 2695587]} -body {
    set x 0
    apply {{} {
	set catch catch
	$catch [list tailcall foo]
	tailcall lappend x 1
    }}
    set x
} -cleanup {
    unset x
} -result {0 1}

# MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed)
# catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that
# standard catch behaviour is required.

test tailcall-13.1 {directly tailcalling the tailcall command is ok} {
    list [catch {
	apply {{} {
	    apply {{} {
		tailcall tailcall subst ok
		subst b
	    }}
	    subst c
	}}
    } msg opt] $msg [errorcode $opt]
} {0 ok NONE}
test tailcall-13.2 {indirectly tailcalling the tailcall command is ok} {
    list [catch {
	apply {{} {
	    apply {{} {
		tailcall eval tailcall subst ok
		subst b
	    }}
	    subst c
	}}
    } msg opt] $msg [errorcode $opt]
} {0 ok NONE}

if {[testConstraint testnrelevels]} {
    namespace forget testnre::*
    namespace delete testnre
}

test tailcall-14.1 {in a deleted namespace} -body {
    namespace eval ns {
	proc p args {
	    tailcall [namespace current] $args
	}
	namespace delete [namespace current]
	p
    }
} -returnCodes 1 -result {namespace "::ns" not found}

test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body {
    namespace eval ns {
	proc p args {
	    tailcall [namespace current] {*}$args
	}
	namespace delete [namespace current]
	p
    }
} -returnCodes 1 -result {namespace "::ns" not found}

# cleanup
::tcltest::cleanupTests

# Local Variables:
# mode: tcl
# End:

Changes to tests/tcltest.test.

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
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







-
+



-
-
-
+
+
+







-
+







# Note that there are several places where the value of
# tcltest::currentFailure is stored/reset in the -setup/-cleanup
# of a test that has a body that runs [test] that will fail.
# This is a workaround of using the same tcltest code that we are
# testing to run the test itself.  Ditto on things like [verbose].
#
# It would be better to have the -body of the tests run the tcltest
# commands in a child interp so the [test] being tested would not
# commands in a slave interp so the [test] being tested would not
# interfere with the [test] doing the testing.
#

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
if {[catch {package require tcltest 2.1}]} {
    puts stderr "Skipping tests in [info script].  tcltest 2.1 required."
    return
}

namespace eval ::tcltest::test {

namespace import ::tcltest::*

makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import ::tcltest::test
    test a-1.0 {test a} {
	list 0
    } {0}
    test b-1.0 {test b} {
	list 1
    } {0}
59
60
61
62
63
64
65
66

67
68
69
70

71
72
73
74
75
76
77
59
60
61
62
63
64
65

66
67
68
69

70
71
72
73
74
75
76
77







-
+



-
+







} {1 1}
test tcltest-1.3 {tcltest -h} {exec} {
    set result [catch {exec [interpreter] test.tcl -h} msg]
    list $result [regexp Usage $msg]
} {1 0}

# -verbose, implicit & explicit testing of [verbose]
proc child {msgVar args} {
proc slave {msgVar args} {
    upvar 1 $msgVar msg

    interp create [namespace current]::i
    # Fake the child interp into dumping output to a file
    # Fake the slave interp into dumping output to a file
    i eval {namespace eval ::tcltest {}}
    i eval "set tcltest::outputChannel\
	    \[[list open [set of [makeFile {} output]] w]]"
    i eval "set tcltest::errorChannel\
	    \[[list open [set ef [makeFile {} error]] w]]"
    i eval [list set argv0 [lindex $args 0]]
    i eval [list set argv [lrange $args 1 end]]
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
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







-
+





-
+





-
+





-
+





-
+





-
+






-
+








-
+









-
+







    if {[string length $err]} {
	set code 1
	append msg \n$err
    }
    return $code
}
test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrWin} {
    set result [child msg test.tcl]
    set result [slave msg test.tcl]
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.1 {tcltest -verbose 'b'} {unixOrWin} {
    set result [child msg test.tcl -verbose 'b']
    set result [slave msg test.tcl -verbose 'b']
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 0 0 1}
test tcltest-2.2 {tcltest -verbose 'p'} {unixOrWin} {
    set result [child msg test.tcl -verbose 'p']
    set result [slave msg test.tcl -verbose 'p']
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 0 1}
test tcltest-2.3 {tcltest -verbose 's'} {unixOrWin} {
    set result [child msg test.tcl -verbose 's']
    set result [slave msg test.tcl -verbose 's']
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 0 1 1}
test tcltest-2.4 {tcltest -verbose 'ps'} {unixOrWin} {
    set result [child msg test.tcl -verbose 'ps']
    set result [slave msg test.tcl -verbose 'ps']
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 0 1 1 1}
test tcltest-2.5 {tcltest -verbose 'psb'} {unixOrWin} {
    set result [child msg test.tcl -verbose 'psb']
    set result [slave msg test.tcl -verbose 'psb']
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 1 1}

test tcltest-2.5a {tcltest -verbose 'pass skip body'} {unixOrWin} {
    set result [child msg test.tcl -verbose "pass skip body"]
    set result [slave msg test.tcl -verbose "pass skip body"]
    list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \
	    [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 1 1}

test tcltest-2.6 {tcltest -verbose 't'}  {
    -constraints {unixOrWin}
    -body {
	set result [child msg test.tcl -verbose 't']
	set result [slave msg test.tcl -verbose 't']
	list $result $msg
    }
    -result {^0 .*a-1.0 start.*b-1.0 start}
    -match regexp
}

test tcltest-2.6a {tcltest -verbose 'start'}  {
    -constraints {unixOrWin}
    -body {
	set result [child msg test.tcl -verbose start]
	set result [slave msg test.tcl -verbose start]
	list $result $msg
    }
    -result {^0 .*a-1.0 start.*b-1.0 start}
    -match regexp
}

test tcltest-2.7 {tcltest::verbose}  {
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
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







-
+







-
+




-
+




-
+




-
+



















-
+




-
+




-
+




-
+




-
+




















-
+




-
+







    }
    -result {body {}}
}

test tcltest-2.8 {tcltest -verbose 'error'} {
    -constraints {unixOrWin}
    -body {
	set result [child msg test.tcl -verbose error]
	set result [slave msg test.tcl -verbose error]
	list $result $msg
    }
    -result {errorInfo: foo.*errorCode: 9}
    -match regexp
}
# -match, [match]
test tcltest-3.1 {tcltest -match 'a*'} {unixOrWin} {
    set result [child msg test.tcl -match a* -verbose 'ps']
    set result [slave msg test.tcl -match a* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}
test tcltest-3.2 {tcltest -match 'b*'} {unixOrWin} {
    set result [child msg test.tcl -match b* -verbose 'ps']
    set result [slave msg test.tcl -match b* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 1 0 1}
test tcltest-3.3 {tcltest -match 'c*'} {unixOrWin} {
    set result [child msg test.tcl -match c* -verbose 'ps']
    set result [slave msg test.tcl -match c* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+4.+Failed.+0" $msg]
} {0 0 0 1 1}
test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrWin} {
    set result [child msg test.tcl -match {a* b*} -verbose 'ps']
    set result [slave msg test.tcl -match {a* b*} -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 1 0 1}

test tcltest-3.5 {tcltest::match}  {
    -body {
	set oldMatch [match]
	match foo
	set currentMatch [match]
	match bar
	set newMatch [match]
	match $oldMatch
	list $currentMatch $newMatch
    }
    -result {foo bar}
}

# -skip, [skip]
test tcltest-4.1 {tcltest -skip 'a*'} {unixOrWin} {
    set result [child msg test.tcl -skip a* -verbose 'ps']
    set result [slave msg test.tcl -skip a* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+2.+Failed.+1" $msg]
} {0 0 1 1 1}
test tcltest-4.2 {tcltest -skip 'b*'} {unixOrWin} {
    set result [child msg test.tcl -skip b* -verbose 'ps']
    set result [slave msg test.tcl -skip b* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+2.+Failed.+1" $msg]
} {0 1 0 1 1}
test tcltest-4.3 {tcltest -skip 'c*'} {unixOrWin} {
    set result [child msg test.tcl -skip c* -verbose 'ps']
    set result [slave msg test.tcl -skip c* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg]
} {0 1 1 0 1}
test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrWin} {
    set result [child msg test.tcl -skip {a* b*} -verbose 'ps']
    set result [slave msg test.tcl -skip {a* b*} -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+0.+Skipped.+3.+Failed.+1" $msg]
} {0 0 0 1 1}
test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrWin} {
    set result [child msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
    set result [slave msg test.tcl -match {a* b*} -skip b* -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 1 0 0 1}

test tcltest-4.6 {tcltest::skip} {
    -body {
	set oldSkip [skip]
	skip foo
	set currentSkip [skip]
	skip bar
	set newSkip [skip]
	skip $oldSkip
	list $currentSkip $newSkip
    }
    -result {foo bar}
}

# -constraints, -limitconstraints, [testConstraint],
# $constraintsSpecified, [limitConstraints]
test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrWin} {
    set result [child msg test.tcl -constraints knownBug -verbose 'ps']
    set result [slave msg test.tcl -constraints knownBug -verbose 'ps']
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+2.+Skipped.+0.+Failed.+2" $msg]
} {0 1 1 1 1}
test tcltest-5.2 {tcltest -constraints 'knownBug' -limitconstraints 1} {unixOrWin} {
    set result [child msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
    set result [slave msg test.tcl -constraints knownBug -verbose 'p' -limitconstraints 1]
    list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \
	    [regexp "Total.+4.+Passed.+1.+Skipped.+3.+Failed.+0" $msg]
} {0 0 0 1 1}

test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)}  {
    -body {
	set r1 [testConstraint tcltestFakeConstraint]
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
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







-
+
















-
+






-
+






-
+






-
+







#        testConstraint knownBug $keepkb
#    }
#    -result {false knownBug knownBug}
#}

# -outfile, -errfile, [outputChannel], [outputFile], [errorChannel], [errorFile]
set printerror [makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import ::tcltest::*
    puts [outputChannel] "a test"
    ::tcltest::PrintError "a really short string"
    ::tcltest::PrintError "a really really really really really really long \
	    string containing \"quotes\" and other bad bad stuff"
    ::tcltest::PrintError "a really really long string containing a \
	    \"Path/that/is/really/long/and/contains/no/spaces\""
    ::tcltest::PrintError "a really really long string containing a \
	    \"Really/Long/Path/that/contains/no/spaces/and/is/longer/than/eighty/characters/to/see/what/happens\""
    ::tcltest::PrintError "Problem renaming file: error renaming \"Z:/ws/tcl8.2/win32-ix86/tests/core\" to \"Z:/ws/tcl8.2/win32-ix86/tests/movecore-core\""
    exit
} printerror.tcl]

test tcltest-6.1 {tcltest -outfile, -errfile defaults} {
    -constraints unixOrWin
    -body {
	child msg $printerror
	slave msg $printerror
	return $msg
    }
    -result {a test.*a really}
    -match regexp
}
test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrWin unixExecs} {
    child msg $printerror -outfile a.tmp
    slave msg $printerror -outfile a.tmp
    set result1 [catch {exec grep "a test" a.tmp}]
    set result2 [catch {exec grep "a really" a.tmp}]
    list [regexp "a test" $msg] [regexp "a really" $msg] \
	    $result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {0 1 0 1 1 {}}
test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrWin unixExecs} {
    child msg $printerror -errfile a.tmp
    slave msg $printerror -errfile a.tmp
    set result1 [catch {exec grep "a test" a.tmp}]
    set result2 [catch {exec grep "a really" a.tmp}]
    list [regexp "a test" $msg] [regexp "a really" $msg] \
	    $result1 $result2 [file exists a.tmp] [file delete a.tmp]
} {1 0 1 0 1 {}}
test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrWin unixExecs} {
    child msg $printerror -outfile a.tmp -errfile b.tmp
    slave msg $printerror -outfile a.tmp -errfile b.tmp
    set result1 [catch {exec grep "a test" a.tmp}]
    set result2 [catch {exec grep "a really" b.tmp}]
    list [regexp "a test" $msg] [regexp "a really" $msg] \
	    $result1 $result2 \
	    [file exists a.tmp] [file delete a.tmp] \
	    [file exists b.tmp] [file delete b.tmp]
} {0 0 0 0 1 {} 1 {}}
459
460
461
462
463
464
465
466

467
468
469
470
471
472
473
459
460
461
462
463
464
465

466
467
468
469
470
471
472
473







-
+







	removeFile efile
    }
}

# -debug, [debug]
# Must use child processes to test -debug because it always writes
# messages to stdout, and we have no way to capture stdout of a
# child interp
# slave interp
test tcltest-7.1 {tcltest test.tcl -debug 0} {unixOrWin} {
    catch {exec [interpreter] test.tcl -debug 0} msg
    regexp "Flags passed into tcltest" $msg
} {0}
test tcltest-7.2 {tcltest test.tcl -debug 1} {unixOrWin} {
    catch {exec [interpreter] test.tcl -debug 1 -skip b*} msg
    list [regexp userSpecifiedSkip $msg] \
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
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







-
+














-
+







-
+










-














-
+















-
+








-
+







    }
}
removeFile test.tcl

# directory tests

set a [makeFile {
    package require tcltest 2.5
    package require tcltest
    tcltest::makeFile {} a.tmp
    puts [tcltest::outputChannel] "testdir: [tcltest::testsDirectory]"
    exit
} a.tcl]

set tdiaf [makeFile {} thisdirectoryisafile]

set normaldirectory [makeDirectory normaldirectory]
normalizePath normaldirectory

# -tmpdir, [temporaryDirectory]
test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrWin -setup {
    file delete -force thisdirectorydoesnotexist
} -body {
    child msg $a -tmpdir thisdirectorydoesnotexist
    slave msg $a -tmpdir thisdirectorydoesnotexist
    file exists [file join thisdirectorydoesnotexist a.tmp]
} -cleanup {
    file delete -force thisdirectorydoesnotexist
} -result 1
test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
    -constraints unixOrWin
    -body {
	child msg $a -tmpdir $tdiaf
	slave msg $a -tmpdir $tdiaf
	return $msg
    }
    -result {*not a directory*}
    -match glob
}
# Test non-writeable directories, non-readable directories with directory flags
set notReadableDir [file join [temporaryDirectory] notreadable]
set notWriteableDir [file join [temporaryDirectory] notwriteable]
makeDirectory notreadable
makeDirectory notwriteable

switch -- $::tcl_platform(platform) {
    unix {
	file attributes $notReadableDir -permissions 00333
	file attributes $notWriteableDir -permissions 00555
    }
    default {
	# note in FAT/NTFS we won't be able to protect directory with read-only attribute...
	catch {file attributes $notWriteableDir -readonly 1}
	catch {testchmod 0 $notWriteableDir}
    }
}
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
    -constraints {unix notRoot}
    -body {
	child msg $a -tmpdir $notReadableDir
	slave msg $a -tmpdir $notReadableDir
	return $msg
    }
    -result {*not readable*}
    -match glob
}
# This constraint doesn't go at the top of the file so that it doesn't
# interfere with tcltest-5.5
testConstraint notFAT [expr {
       ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]]
    || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]]
}]
# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
    -constraints {unixOrWin notRoot notFAT}
    -body {
	child msg $a -tmpdir $notWriteableDir
	slave msg $a -tmpdir $notWriteableDir
	return $msg
    }
    -result {*not writeable*}
    -match glob
}
test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
    -constraints unixOrWin
    -body {
	child msg $a -tmpdir $normaldirectory
	slave msg $a -tmpdir $normaldirectory
	# The join is necessary because the message can be split on multiple
	# lines
	file exists [file join $normaldirectory a.tmp]
    }
    -cleanup {
	catch {file delete [file join $normaldirectory a.tmp]}
    }
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
625
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







-
+








-
+








-
+








-
+







# -testdir, [testsDirectory]
test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
    -constraints unixOrWin
    -setup {
	file delete -force thisdirectorydoesnotexist
    }
    -body {
	child msg $a -testdir thisdirectorydoesnotexist
	slave msg $a -testdir thisdirectorydoesnotexist
	return $msg
    }
    -match glob
    -result {*does not exist*}
}
test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
    -constraints unixOrWin
    -body {
	child msg $a -testdir $tdiaf
	slave msg $a -testdir $tdiaf
	return $msg
    }
    -match glob
    -result {*not a directory*}
}
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
    -constraints {unix notRoot}
    -body {
	child msg $a -testdir $notReadableDir
	slave msg $a -testdir $notReadableDir
	return $msg
    }
    -match glob
    -result {*not readable*}
}
test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {
    -constraints unixOrWin
    -body {
	child msg $a -testdir $normaldirectory
	slave msg $a -testdir $normaldirectory
	# The join is necessary because the message can be split on multiple
	# lines
	list [string first "testdir: $normaldirectory" [join $msg]] \
	    [file exists [file join [temporaryDirectory] a.tmp]]
    }
    -cleanup {
	file delete [file join [temporaryDirectory] a.tmp]
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
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







-
+









-
+







removeDirectory normaldirectory

# -file, -notfile, [matchFiles], [skipFiles]
test tcltest-9.1 {-file d*.tcl} -constraints {unixOrWin} -setup {
    set old [testsDirectory]
    testsDirectory [file dirname [info script]]
} -body {
    child msg [file join [testsDirectory] all.tcl] -file d*.test
    slave msg [file join [testsDirectory] all.tcl] -file d*.test
    return $msg
} -cleanup {
    testsDirectory $old
} -match regexp -result {dstring\.test}

test tcltest-9.2 {-file d*.tcl} -constraints {unixOrWin} -setup {
    set old [testsDirectory]
    testsDirectory [file dirname [info script]]
} -body {
    child msg [file join [testsDirectory] all.tcl] \
    slave msg [file join [testsDirectory] all.tcl] \
	    -file d*.test -notfile dstring*
    regexp {dstring\.test} $msg
} -cleanup {
    testsDirectory $old
} -result 0

test tcltest-9.3 {matchFiles}  {
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
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







-
+










-
+











-
+




-
+




-
+





-
+








test tcltest-9.5 {GetMatchingFiles: Bug 1119798} -setup {
    set d [makeDirectory tmp]
    makeDirectory foo $d
    makeFile {} fee $d
    file copy [file join [file dirname [info script]] all.tcl] $d
} -body {
    child msg [file join [temporaryDirectory] all.tcl] -file f*
    slave msg [file join [temporaryDirectory] all.tcl] -file f*
    regexp {exiting with errors:} $msg
} -cleanup {
    file delete [file join $d all.tcl]
    removeFile fee $d
    removeDirectory foo $d
    removeDirectory tmp
} -result 0

# -preservecore, [preserveCore]
set mc [makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import ::tcltest::test
    test makecore {make a core file} {
	set f [open core w]
	close $f
    } {}
    ::tcltest::cleanupTests
    return
} makecore.tcl]

cd [temporaryDirectory]
test tcltest-10.1 {-preservecore 0} {unixOrWin} {
    child msg $mc -preservecore 0
    slave msg $mc -preservecore 0
    file delete core
    regexp "Core file produced" $msg
} {0}
test tcltest-10.2 {-preservecore 1} {unixOrWin} {
    child msg $mc -preservecore 1
    slave msg $mc -preservecore 1
    file delete core
    regexp "Core file produced" $msg
} {1}
test tcltest-10.3 {-preservecore 2} {unixOrWin} {
    child msg $mc -preservecore 2
    slave msg $mc -preservecore 2
    file delete core
    list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
	    [regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}
test tcltest-10.4 {-preservecore 3} {unixOrWin} {
    child msg $mc -preservecore 3
    slave msg $mc -preservecore 3
    file delete core
    list [regexp "Core file produced" $msg] [regexp "Moving file to" $msg] \
	    [regexp "core-" $msg] [file delete core-makecore]
} {1 1 1 {}}

# Removing this test.  It makes no sense to test the ability of
# [preserveCore] to accept an invalid value that will cause errors
843
844
845
846
847
848
849
850

851
852
853
854
855
856
857
858

859
860
861
862
863
864
865
842
843
844
845
846
847
848

849
850
851
852
853
854
855
856

857
858
859
860
861
862
863
864







-
+







-
+







#    }
#    -result {foo foo}
#}
removeFile makecore.tcl

# -load, -loadfile, [loadScript], [loadFile]
set contents {
    package require tcltest 2.5
    package require tcltest
    namespace import tcltest::*
    puts [outputChannel] $::tcltest::loadScript
    exit
}
set loadfile [makeFile $contents load.tcl]

test tcltest-12.1 {-load xxx} {unixOrWin} {
    child msg $loadfile -load xxx
    slave msg $loadfile -load xxx
    return $msg
} {xxx}

# Using child process because of -debug usage.
test tcltest-12.2 {-loadfile load.tcl} {unixOrWin} {
    catch {exec [interpreter] $loadfile -debug 2 -loadfile $loadfile} msg
    list \
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
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







-
+









-
+









-
+







} single1.test $spd

makeFile {
    unset foo
} single2.test $spd

set allfile [makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import tcltest::*
    testsDirectory [file join [temporaryDirectory] singleprocdir]
    runAllTests
} all-single.tcl $spd]
cd [workingDirectory]

test tcltest-14.1 {-singleproc - single process} {
    -constraints {unixOrWin}
    -body {
	child msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
	slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
	return $msg
    }
    -result {Test file error: can't unset .foo.: no such variable}
    -match regexp
}

test tcltest-14.2 {-singleproc - multiple process} {
    -constraints {unixOrWin}
    -body {
	child msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
	slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
	return $msg
    }
    -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
    -match regexp
}

test tcltest-14.3 {singleProcess} {
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
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
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
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







-
+





-
+





-
+





-
+








-
+













-
+

















-
+














-
+












-
+







# all.tcl files.

set dtd [makeDirectory dirtestdir]
set dtd1 [makeDirectory dirtestdir2.1 $dtd]
set dtd2 [makeDirectory dirtestdir2.2 $dtd]
set dtd3 [makeDirectory dirtestdir2.3 $dtd]
makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import -force tcltest::*
    testsDirectory [file join [temporaryDirectory] dirtestdir]
    runAllTests
} all.tcl $dtd
makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import -force tcltest::*
    testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.1]
    runAllTests
} all.tcl $dtd1
makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import -force tcltest::*
    testsDirectory [file join [temporaryDirectory]  dirtestdir dirtestdir2.2]
    runAllTests
} all.tcl $dtd2
makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import -force tcltest::*
    testsDirectory [file join [temporaryDirectory] dirtestdir dirtestdir2.3]
    runAllTests
} all.tcl $dtd3

test tcltest-15.1 {basic directory walking} {
    -constraints {unixOrWin}
    -body {
	if {[child msg \
	if {[slave msg \
		[file join $dtd all.tcl] \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -match regexp
    -returnCodes 1
    -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123].*Tests located in:.*dirtestdir2.[123]}
}

test tcltest-15.2 {-asidefromdir} {
    -constraints {unixOrWin}
    -body {
	if {[child msg \
	if {[slave msg \
		[file join $dtd all.tcl] \
		-asidefromdir dirtestdir2.3 \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -match regexp
    -returnCodes 1
    -result {Tests located in:.*dirtestdir.*Tests located in:.*dirtestdir2.[12].*Tests located in:.*dirtestdir2.[12].*dirtestdir2.[12] test ended at .*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error:  No test files remain after applying your match and skip patterns!
Error:  No test files remain after applying your match and skip patterns!
Error:  No test files remain after applying your match and skip patterns!$}
}

test tcltest-15.3 {-relateddir, non-existent dir} {
    -constraints {unixOrWin}
    -body {
	if {[child msg \
	if {[slave msg \
		[file join $dtd all.tcl] \
		-relateddir [file join [temporaryDirectory] dirtestdir0] \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -returnCodes 1
    -match regexp
    -result {[^~]|dirtestdir[^2]}
}

test tcltest-15.4 {-relateddir, subdir} {
    -constraints {unixOrWin}
    -body {
	if {[child msg \
	if {[slave msg \
		[file join $dtd all.tcl] \
		-relateddir dirtestdir2.1 -tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
    -returnCodes 1
    -match regexp
    -result {Tests located in:.*dirtestdir2.[^23]}
}
test tcltest-15.5 {-relateddir, -asidefromdir} {
    -constraints {unixOrWin}
    -body {
	if {[child msg \
	if {[slave msg \
		[file join $dtd all.tcl] \
		-relateddir "dirtestdir2.1 dirtestdir2.2" \
		-asidefromdir dirtestdir2.2 \
		-tmpdir [temporaryDirectory]] == 1} {
	    error $msg
	}
    }
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
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







-
-
-
-
-
+
+
+
+
+

-
-
+
+






-
-
+
+

-
-
+
+








-
+







	    set oldoptions $::env(TCLTEST_OPTIONS)
	} else {
	    set oldoptions none
	}
	# set this to { } instead of just {} to get around quirk in
	# Windows env handling that removes empty elements from env array.
	set ::env(TCLTEST_OPTIONS) { }
	interp create child1
	child1 eval [list set argv {-debug 2}]
	child1 alias puts puts
	interp create child2
	child2 alias puts puts
	interp create slave1
	slave1 eval [list set argv {-debug 2}]
	slave1 alias puts puts
	interp create slave2
	slave2 alias puts puts
    } -cleanup {
	interp delete child2
	interp delete child1
	interp delete slave2
	interp delete slave1
	if {$oldoptions eq "none"} {
	    unset ::env(TCLTEST_OPTIONS)
	} else {
	    set ::env(TCLTEST_OPTIONS) $oldoptions
	}
    } -body {
	child1 eval [package ifneeded tcltest [package provide tcltest]]
	child1 eval tcltest::debug
	slave1 eval [package ifneeded tcltest [package provide tcltest]]
	slave1 eval tcltest::debug
	set ::env(TCLTEST_OPTIONS) "-debug 3"
	child2 eval [package ifneeded tcltest [package provide tcltest]]
	child2 eval tcltest::debug
	slave2 eval [package ifneeded tcltest [package provide tcltest]]
	slave2 eval tcltest::debug
    } -result {^3$} -match regexp -output\
{tcltest::debug\s+= 2.*tcltest::debug\s+= 3}

# Begin testing of tcltest procs ...

cd [temporaryDirectory]
# PrintError
test tcltest-20.1 {PrintError} {unixOrWin} {
    set result [child msg $printerror]
    set result [slave msg $printerror]
    list $result [regexp "Error:  a really short string" $msg] \
	    [regexp "     \"quotes\"" $msg] [regexp "    \"Path" $msg] \
	    [regexp "    \"Really" $msg] [regexp Problem $msg]
} {1 1 1 1 1 1}
cd [workingDirectory]
removeFile printerror.tcl

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
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







-
+











-
+









-
+







} -result {^$} -output {foo is 2} -match regexp

# test all.tcl usage (runAllTests); simulate .test file failure, as well as
# crashes to determine whether or not these errors are logged.

set atd [makeDirectory alltestdir]
makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import -force tcltest::*
    testsDirectory [file join [temporaryDirectory] alltestdir]
    runAllTests
} all.tcl $atd
makeFile {
    exit 1
} exit.test $atd
makeFile {
    error "throw an error"
} error.test $atd
makeFile {
    package require tcltest 2.5
    package require tcltest
    namespace import -force tcltest::*
    test foo-1.1 {foo} {
	-body { return 1 }
	-result {1}
    }
    cleanupTests
} test.test $atd

# Must use a child process because stdout/stderr parsing can't be
# duplicated in child interp.
# duplicated in slave interp.
test tcltest-22.1 {runAllTests} {
    -constraints {unixOrWin}
    -body {
	exec [interpreter] \
		[file join $atd all.tcl] \
		-verbose t -tmpdir [temporaryDirectory]
    }
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
1820

1821
1822
1823
1824
1825
1826
1827
1828
1829
1830

1831
1832
1833
1834
1835
1836
1837
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
1820
1821
1822
1823
1824
1825
1826
1827
1828

1829
1830
1831
1832
1833
1834
1835
1836







-
+









-
+









-
+









-
+







} -cleanup {
	set ::tcltest::currentFailure $fail
	verbose $v
} -match glob -output {*generated error; Return code was: 1*}

test tcltest-26.1 {Bug/RFE 1017151} -setup {
    makeFile {
	package require tcltest 2.5
	package require tcltest
	set ::errorInfo "Should never see this"
	tcltest::test tcltest-26.1.0 {
	    no errorInfo when only return code mismatch
	} -body {
	    set x 1
	} -returnCodes error -result 1
	tcltest::cleanupTests
    } test.tcl
} -body {
    child msg [file join [temporaryDirectory] test.tcl]
    slave msg [file join [temporaryDirectory] test.tcl]
    return $msg
} -cleanup {
    removeFile test.tcl
} -match glob -result {*
---- Return code should have been one of: 1
==== tcltest-26.1.0 FAILED*}

test tcltest-26.2 {Bug/RFE 1017151} -setup {
    makeFile {
	package require tcltest 2.5
	package require tcltest
	set ::errorInfo "Should never see this"
	tcltest::test tcltest-26.2.0 {do not mask body errorInfo} -body {
	    error "body error"
	} -cleanup {
	    error "cleanup error"
	} -result 1
	tcltest::cleanupTests
    } test.tcl
} -body {
    child msg [file join [temporaryDirectory] test.tcl]
    slave msg [file join [temporaryDirectory] test.tcl]
    return $msg
} -cleanup {
    removeFile test.tcl
} -match glob -result {*
---- errorInfo: body error
*
---- errorInfo(cleanup): cleanup error*}

Deleted tests/tcltests.tcl.

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














































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#! /usr/bin/env tclsh

package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec          [llength [info commands exec]]
testConstraint fcopy         [llength [info commands fcopy]]
testConstraint fileevent     [llength [info commands fileevent]]
testConstraint thread        [
    expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint notValgrind   [expr {![testConstraint valgrind]}]


namespace eval ::tcltests {


    proc init {} {
	if {[namespace which ::tcl::file::tempdir] eq {}} {
	    interp alias {} [namespace current]::tempdir {} [
		namespace current]::tempdir_alternate
	} else {
	    interp alias {} [namespace current]::tempdir {} ::tcl::file::tempdir
	}
    }


    proc tempdir_alternate {} {
	close [file tempfile tempfile]
	set tmpdir [file dirname $tempfile]
	set execname [info nameofexecutable]
	regsub -all {[^[:alpha:][:digit:]]} $execname _ execname
	for {set i 0} {$i < 10000} {incr i} {
	    set time [clock milliseconds]
	    set name $tmpdir/${execname}_${time}_$i
	    if {![file exists $name]} {
		file mkdir $name
		return $name
	    }
	}
	error [list {could not create temporary directory}]
    }

    init

    package provide tcltests 0.1
}

Changes to tests/thread.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
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








-




-
-
+
+



-
+
-

-
+
-
-

+
-
+

+
-
-
+
+
+

-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+
+
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+


-
-
-
-
+
+
+
+
+
+
+
-
-
+






-
+
+



-
+

-
-
-
+
-
-


-
+
+

-
+


-
+

-
-
-
-
+
+
+
+
+
+
-



-
+

-
+




-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+

+
-
+

-
-
-
-
+
+
+
+
+

-
+





-
-
-
-
+
+
+
+
+

-
+

-
+


-
-
-
+
+
+
+
+

-
+




-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+
+

-
+
+
+

-
-
-
-
-
+
+
+
+
+
+
-
-



-
+

+
-
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







# Commands covered:  (test)thread
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

#  when thread::release is used, -wait is passed in order allow the thread to
# Some tests require the testthread command
#  be fully finalized, which avoids valgrind "still reachable" reports.

::tcltest::loadTestedCommands
testConstraint testthread [expr {[info commands testthread] != {}}]
catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests

if {[testConstraint testthread]} {
# Some tests require the testthread command
    testthread errorproc ThreadError

    proc ThreadError {id info} {
testConstraint testthread [expr {[info commands testthread] ne {}}]

	global threadError
	set threadError $info
    }

set threadSuperKillScript {
    rename catch ""
    proc ThreadNullError {id info} {
	# ignore
    rename while ""
    rename unknown ""
    rename update ""
    thread::release
}

    }
}
proc getThreadErrorFromInfo { info } {
    set list [split $info \n]
    set idx [lsearch -glob $list "*eval*unwound*"]
    if {$idx >= 0} then {
        return [lindex $list $idx]
    }

    set idx [lsearch -glob $list "*eval*canceled*"]
    if {$idx >= 0} then {
        return [lindex $list $idx]
    }

    return ""; # some other error we do not care about.
}

proc findThreadError { info } {
test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
    list [catch {testthread} msg] $msg
    foreach error [lreverse $info] {
        set error [getThreadErrorFromInfo $error]
        if {[string length $error] > 0} then {
} {1 {wrong # args: should be "testthread option ?args?"}}
test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
    list [catch {testthread foo} msg] $msg
} {1 {bad option "foo": must be create, exit, id, join, names, send, wait, or errorproc}}
test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} {
    list [threadReap] [llength [testthread names]]
            return $error
        }
} {1 1}
    }
    return ""; # some other error we do not care about.
}

test thread-1.4 {Tcl_ThreadObjCmd: thread create } {testthread} {
proc ThreadError {id info} {
    global threadSawError
    if {[string length [getThreadErrorFromInfo $info]] > 0} then {
        global threadId threadError
        set threadId $id
        lappend threadError($id) $info
    }
    set threadSawError($id) true; # signal main thread to exit [vwait].
}

proc threadSuperKill id {
    threadReap
    set serverthread [testthread create]
    update
    set numthreads [llength [testthread names]]
    threadReap
    set numthreads
} {2}
test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} {
    threadReap
    testthread create {set x 5}
    foreach try {0 1 2 4 5 6} {
	# Try various ways to yield
	update
	after 10
	set l [llength [testthread names]]
	if {$l == 1} {
	    break
	}
    }
    threadReap
    variable threadSuperKillScript
    try {
	thread::send $id $::threadSuperKillScript
    set l
} {1}
test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {testthread} {
    } on error {tres topts} {
	if {$tres ne {target thread died}} {
	    return -options $topts $tres
    threadReap
    testthread create {testthread exit}
	}
    }
}

if {[testConstraint thread]} {
    thread::errorproc ThreadError
}

if {[testConstraint testthread]} {
    update
    after 10
    set result [llength [testthread names]]
    threadReap
    set result
} {1}
test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} {
    set x [catch {testthread id x} msg]
    proc drainEventQueue {} {
	while {[set x [testthread event]]} {
	    #puts "WARNING: drained $x event(s) on main thread"
	}
    list $x $msg
} {1 {wrong # args: should be "testthread id"}}
test thread-1.8 {Tcl_ThreadObjCmd: thread id} {testthread} {
    string compare [testthread id] $::tcltest::mainThread
} {0}
    }

    testthread errorproc ThreadError
}

test thread-1.9 {Tcl_ThreadObjCmd: thread names args} {testthread} {
    set x [catch {testthread names x} msg]
    list $x $msg
} {1 {wrong # args: should be "testthread names"}}
test thread-1.10 {Tcl_ThreadObjCmd: thread id} {testthread} {
    string compare [testthread names] $::tcltest::mainThread
} {0}
test thread-1.11 {Tcl_ThreadObjCmd: send args} {testthread} {
# Some tests require manual draining of the event queue

    set x [catch {testthread send} msg]
testConstraint drainEventQueue [expr {[info commands drainEventQueue] != {}}]

test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} {
    llength [thread::names]
} 1
test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} {
    set serverthread [thread::create -preserved]
    set numthreads [llength [thread::names]]
    thread::release -wait $serverthread
    set numthreads
} 2
test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} {
    thread::create {set x 5}
    list $x $msg
} {1 {wrong # args: should be "testthread send ?-async? id script"}}
test thread-1.12 {Tcl_ThreadObjCmd: send nonint} {testthread} {
    set x [catch {testthread send abc command} msg]
    list $x $msg
} {1 {expected integer but got "abc"}}
test thread-1.13 {Tcl_ThreadObjCmd: send args} {testthread} {
    threadReap
    set serverthread [testthread create]
    set five [testthread send $serverthread {set x 5}]
    threadReap
    set five
} 5
test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} {
    set tid [expr $::tcltest::mainThread + 10]
    foreach try {0 1 2 4 5 6} {
        # Try various ways to yield
        update
        after 10
        set l [llength [thread::names]]
        if {$l == 1} {
            break
    set x [catch {testthread send $tid {set x 5}} msg]
        }
    }
    set l
} 1
test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
    thread::create {{*}{}}
    list $x $msg
} {1 {invalid thread id}}
test thread-1.15 {Tcl_ThreadObjCmd: wait} {testthread} {
    threadReap
    update
    after 10
    llength [thread::names]
} {1}
test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
    set serverthread [thread::create -preserved]
    set five [thread::send $serverthread {set x 5}]
    thread::release -wait $serverthread
    set serverthread [testthread create {set z 5 ; testthread wait}]
    set five [testthread send $serverthread {set z}]
    threadReap
    set five
} 5
test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
    set serverthread [thread::create -preserved {set z 5 ; thread::wait}]
    set five [thread::send $serverthread {set z}]
    thread::release -wait $serverthread
test thread-1.16 {Tcl_ThreadObjCmd: errorproc args} {testthread} {
    set x [catch {testthread errorproc foo bar} msg]
    list $x $msg
} {1 {wrong # args: should be "testthread errorproc proc"}}
test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} {
    testthread errorproc foo
    testthread errorproc ThreadError
    set five
} 5
} {}

# The tests above also cover:
# TclCreateThread, except when pthread_create fails
# NewThread, safe and regular
# ThreadErrorProc, except for printing to standard error

test thread-2.1 {ListUpdateInner and ListRemove} {thread} {
test thread-2.1 {ListUpdateInner and ListRemove} {testthread} {
    threadReap
    catch {unset tid}
    foreach t {0 1 2} {
	upvar #0 t$t tid
	set tid [thread::create -preserved]
	set tid [testthread create]
    }
    foreach t {0 1 2} {
	upvar #0 t$t tid
	thread::release $tid
    threadReap
    }
    llength [thread::names]
} 1

test thread-3.1 {TclThreadList} {thread} {
test thread-3.1 {TclThreadList} {testthread} {
    threadReap
    catch {unset tid}
    set len [llength [thread::names]]
    set len [llength [testthread names]]
    set l1  {}
    foreach t {0 1 2} {
	lappend l1 [thread::create -preserved]
	lappend l1 [testthread create]
    }
    set l2 [thread::names]
    set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]]
    foreach t $l1 {
	thread::release -wait $t
    set l2 [testthread names]
    list $l1 $l2
    set c [string compare \
	    [lsort -integer [concat $::tcltest::mainThread $l1]] \
	    [lsort -integer $l2]]
    threadReap
    }
    list $len $c
} {1 0}

test thread-4.1 {TclThreadSend to self} {thread} {
test thread-4.1 {TclThreadSend to self} {testthread} {
    catch {unset x}
    thread::send [thread::id] {
    testthread send [testthread id] {
	set x 4
    }
    set x
} {4}
test thread-4.2 {TclThreadSend -async} {thread} {
    set len [llength [thread::names]]
    set serverthread [thread::create -preserved]
    thread::send -async $serverthread {
	after 1 {thread::release}
test thread-4.2 {TclThreadSend -async} {testthread} {
    threadReap
    set len [llength [testthread names]]
    set serverthread [testthread create]
    testthread send -async $serverthread {
	after 1000
	testthread exit
    }
    set two [llength [thread::names]]
    after 100 {set done 1}
    set two [llength [testthread names]]
    after 1500 {set done 1}
    vwait done
    threadReap
    list $len [llength [thread::names]] $two
    list $len [llength [testthread names]] $two
} {1 1 2}
test thread-4.3 {TclThreadSend preserve errorInfo} {thread} {
    set len [llength [thread::names]]
    set serverthread [thread::create -preserved]
    set x [catch {thread::send $serverthread {set undef}} msg]
test thread-4.3 {TclThreadSend preserve errorInfo} {testthread} {
    threadReap
    set len [llength [testthread names]]
    set serverthread [testthread create]
    set x [catch {testthread send $serverthread {set undef}} msg]
    set savedErrorInfo $::errorInfo
    thread::release $serverthread
    threadReap
    list $len $x $msg $savedErrorInfo
} {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable
    while executing
"set undef"
    invoked from within
"thread::send $serverthread {set undef}"}}
test thread-4.4 {TclThreadSend preserve code} {thread} {
    set len [llength [thread::names]]
    set serverthread [thread::create -preserved]
"testthread send $serverthread {set undef}"}}
test thread-4.4 {TclThreadSend preserve code} {testthread} {
    threadReap
    set len [llength [testthread names]]
    set serverthread [testthread create]
    set ::errorInfo {}
    set x [catch {thread::send $serverthread {set ::errorInfo {}; break}} msg]
    set x [catch {testthread send $serverthread {set ::errorInfo {}; break}} msg]
    set savedErrorInfo $::errorInfo
    thread::release $serverthread
    threadReap
    list $len $x $msg $savedErrorInfo
} {1 3 {} {}}
test thread-4.5 {TclThreadSend preserve errorCode} {thread} {
    set serverthread [thread::create]
    set x [catch {thread::send $serverthread {error ERR INFO CODE}} msg]
test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
    threadReap
    set ::tcltest::mainThread [testthread names]
    set serverthread [testthread create]
    set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg]
    set savedErrorCode $::errorCode
    thread::release $serverthread
    threadReap
    list $x $msg $savedErrorCode
} {1 ERR CODE}


test thread-5.0 {Joining threads} {thread} {
    set serverthread [thread::create -joinable -preserved]
    thread::send -async $serverthread {after 1000 ; thread::release}
    thread::join $serverthread
test thread-5.0 {Joining threads} {testthread} {
    threadReap
    set serverthread [testthread create -joinable]
    testthread send -async $serverthread {after 1000 ; testthread exit}
    set res [testthread join $serverthread]
    threadReap
    set res
} {0}
test thread-5.1 {Joining threads after the fact} {thread} {
    set serverthread [thread::create -joinable -preserved]
    thread::send -async $serverthread {thread::release}
test thread-5.1 {Joining threads after the fact} {testthread} {
    threadReap
    set serverthread [testthread create -joinable]
    testthread send -async $serverthread {testthread exit}
    after 2000
    thread::join $serverthread
    set res [testthread join $serverthread]
    threadReap
    set res
} {0}
test thread-5.2 {Try to join a detached thread} {thread} {
    set serverthread [thread::create -preserved]
    thread::send -async $serverthread {after 1000 ; thread::release}
    catch {set res [thread::join $serverthread]} msg
    while {[llength [thread::names]] > 1} {
test thread-5.2 {Try to join a detached thread} {testthread} {
    threadReap
    set serverthread [testthread create]
    testthread send -async $serverthread {after 1000 ; testthread exit}
    catch {set res [testthread join $serverthread]} msg
    threadReap
	after 20
    }
    lrange $msg 0 2
} {cannot join thread}

test thread-6.1 {freeing very large object trees in a thread} thread {
test thread-6.1 {freeing very large object trees in a thread} testthread {
    # conceptual duplicate of obj-32.1
    threadReap
    set serverthread [thread::create -preserved]
    thread::send -async $serverthread {
    set serverthread [testthread create -joinable]
    testthread send -async $serverthread {
	set x {}
	for {set i 0} {$i<100000} {incr i} {
	    set x [list $x {}]
	}
	unset x
    }
    thread::release -wait $serverthread
} 0

# TIP #285: Script cancellation support
test thread-7.4 {cancel: pure bytecode loop} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.5 {cancel: pure inside-command loop} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.8 {cancel: pure bytecode loop custom result} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread "the eval was canceled"]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was canceled}}
test thread-7.9 {cancel: pure inside-command loop custom result} -constraints {
    thread
	testthread exit
    drainEventQueue
} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
    }
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread "the eval was canceled"]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    catch {set res [testthread join $serverthread]} msg
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was canceled}}
test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints {
    thread
    drainEventQueue
} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread "the eval was unwound"]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was unwound}}
test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -constraints {
    thread
    drainEventQueue
} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    set while while
	    $while {1} {
		# No bytecode at all here...
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread "the eval was unwound"]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was unwound}}
test thread-7.12 {cancel: after} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	if {![info exists foo]} then {
	    # signal the primary thread that we are ready
	    # to be canceled now (we are running).
	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
	    set foo 1
	}
	after 30000
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.13 {cancel: after -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	if {![info exists foo]} then {
	    # signal the primary thread that we are ready
	    # to be canceled now (we are running).
	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
	    set foo 1
	}
	after 30000
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    threadReap
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.14 {cancel: vwait} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	if {![info exists foo]} then {
	    # signal the primary thread that we are ready
	    # to be canceled now (we are running).
	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
	    set foo 1
	}
	vwait forever
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.15 {cancel: vwait -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	if {![info exists foo]} then {
	    # signal the primary thread that we are ready
	    # to be canceled now (we are running).
	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
	    set foo 1
	}
	vwait forever
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.16 {cancel: expr} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
	$i eval {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).

		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    expr {[while {1} {incr x}]}
	}
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.17 {cancel: expr -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
	$i eval {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    expr {[while {1} {incr x}]}
	}
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.18 {cancel: expr bignum} {thread drainEventQueue knownBug} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
        set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
        $i eval {
            if {![info exists foo]} then {
                # signal the primary thread that we are ready
                # to be canceled now (we are running).
                thread::send %ID% [list set ::threadIdStarted [thread::id]]
                set foo 1
            }
            #
            # BUGBUG: This will not cancel because libtommath
            #         does not check Tcl_Canceled.
            #
            expr {2**99999}
        }
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
    thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
    list $res [expr {[info exists ::threadIdStarted] ? \
                  $::threadIdStarted == $serverthread : 0}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
test thread-7.19 {cancel: expr bignum -unwind} {thread drainEventQueue knownBug} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
        set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
        $i eval {
            if {![info exists foo]} then {
                # signal the primary thread that we are ready
                # to be canceled now (we are running).
                thread::send %ID% [list set ::threadIdStarted [thread::id]]
                set foo 1
            }
            #
            # BUGBUG: This will not cancel because libtommath
            #         does not check Tcl_Canceled.
            #
            expr {2**99999}
        }
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
    thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
    list $res [expr {[info exists ::threadIdStarted] ? \
                  $::threadIdStarted == $serverthread : 0}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
test thread-7.20 {cancel: subst} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
	$i eval {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    subst {[while {1} {incr x}]}
	}
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
	$i eval {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    subst {[while {1} {incr x}]}
	}
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.22 {cancel: child interp} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
	$i eval {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
	    }
	    while {1} {}
	}
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.23 {cancel: child interp -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	set i [interp create]
	$i eval "package require -exact Thread [package present Thread]"
	$i eval {
	    if {![info exists foo]} then {
		# signal the primary thread that we are ready
		# to be canceled now (we are running).
		thread::send %ID% [list set ::threadIdStarted [thread::id]]
		set foo 1
    set res
	    }
	    set while while; $while {1} {}
	}
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainEventQueue} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    while {1} {
} {0}
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		catch {
		    while {1} {
			catch {
			    while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread drainEventQueue} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		$catch {
		    $while {1} {
			$catch {
			    $while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 0 {}}
test thread-7.26 {cancel: send async cancel bad interp path} {thread drainEventQueue} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	[string map [list %ID% [thread::id]] {
	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		update
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    catch {thread::send $serverthread {interp cancel -- bad}} msg
    thread::send -async $serverthread {interp cancel -unwind}
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list [expr {$::threadIdStarted == $serverthread}] $msg
} {1 {could not find interpreter "bad"}}
test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	set i [interp create -- -unwind]
	$i eval "package require -exact Thread [package present Thread]"
	$i eval {
	    proc foobar {} {
		while {1} {
		    if {![info exists foo]} then {
			# signal the primary thread that we are ready
			# to be canceled now (we are running).
			thread::send %ID% [list set ::threadIdStarted [thread::id]]
			set foo 1
		    }
		    update
		}
	    }
	    foobar
	}
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::send -async $serverthread {interp cancel -- -unwind}]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		catch {
		    while {1} {
			catch {
			    while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 1 {eval canceled}}
test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {thread drainEventQueue} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		$catch {
		    $while {1} {
			$catch {
			    $while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 1 {eval canceled}}
test thread-7.30 {cancel: send async thread cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		catch {
		    while {1} {
			catch {
			    while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 1 {eval canceled}}
test thread-7.31 {cancel: send async thread cancel nested catch pure inside-command loop} {thread drainEventQueue} {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		$catch {
		    $while {1} {
			$catch {
			    $while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
    threadSuperKill $serverthread
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [findThreadError $::threadError($serverthread)] : ""}]
} {{} 1 1 {eval canceled}}
test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		catch {
		    while {1} {
			catch {
			    while {1} {
				# No bytecode at all here...
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		$catch {
		    $while {1} {
			$catch {
			    $while {1} {
				# No bytecode at all here...
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::cancel -unwind $serverthread]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		catch {
		    while {1} {
			catch {
			    while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::send -async $serverthread {interp cancel -unwind}]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		$catch {
		    $while {1} {
			$catch {
			    $while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::send -async $serverthread {interp cancel -unwind}]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.36 {cancel: send async thread cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		catch {
		    while {1} {
			catch {
			    while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
test thread-7.37 {cancel: send async thread cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -body {
    set serverthread [thread::create -joinable \
	    [string map [list %ID% [thread::id]] {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		$catch {
		    $while {1} {
			$catch {
			    $while {1} {
				# we must call update here because otherwise
				# the thread cannot even be forced to exit.
				update
			    }
			}
		    }
		}
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted
    set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
    vwait ::threadSawError($serverthread)
    thread::join $serverthread; drainEventQueue
    list $res [expr {$::threadIdStarted == $serverthread}] \
              [expr {[info exists ::threadId] ? \
                  $::threadId == $serverthread : 0}] \
              [expr {[info exists ::threadError($serverthread)] ? \
                  [findThreadError $::threadError($serverthread)] : ""}]
} -cleanup {
    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}

test thread-8.1 {threaded fork stress} -constraints {thread} -setup {
    unset -nocomplain ::threadCount ::execCount ::threads ::thread
    set ::threadCount 10
    set ::execCount 10
} -body {
    set ::threads [list]

Changes to tests/timer.test.

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
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
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
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
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







-
-
+
+



-
+



-






-
-
+
+
+
+



-
-
-
-
-
-
-








-
-
+
+













-
+



-














-
-
+
+



-






-
-
-
+
+
+



-






-
-
-
+
+
+



-




-
-
-
+
+
+



-







-
+




-
+



-








-
-
-
+
+
+



-








-
-
+
+

-
+



-








-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+




















-
-
-
+
+
+






-
+



-





-
-
-
+
+
+



-





-
-
-
+
+
+



-











-
-
+
+



-







-
-
-
+
+
+



-







-
-
-
+
+
+



-







-
-
+
+



-











-

+
-
-
-
-
+
+
+
+














-







-
-
-
-
-
-
+
+
+
+
+
+



+




-
+



-





-
-
+
+



-





-
-
+
+



-



-
+
-



+
-
-
+
+



-



-
+
-



+
-
-
+
+



-




-
-
+
+



-




-
-
+
+



-




-
+
-



+
+
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup {
test timer-1.1 {Tcl_CreateTimerHandler procedure} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x ""
    foreach i {100 200 1000 50 150} {
	after $i lappend x $i
    }
    after 200 set done 1
    vwait done
    return $x
} -cleanup {
    set x
} {50 100 150 200}

test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
    foreach i [after info] {
	after cancel $i
    }
} -result {50 100 150 200}

test timer-2.1 {Tcl_DeleteTimerHandler procedure} -setup {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x ""
    foreach i {100 200 1000 50 150} {
	after $i lappend x $i
    }
    after cancel lappend x 150
    after cancel lappend x 50
    after 200 set done 1
    vwait done
    return $x
} -result {100 200}
    set x
} {100 200}

# No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested
# above.

test timer-3.1 {TimerHandlerEventProc procedure: event masks} {
    set x start
    after 100 { set x fired }
    update idletasks
    set result $x
    after 200
    update
    lappend result $x
} {start fired}
test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} -setup {
test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    foreach i {200 600 1000} {
	after $i lappend x $i
    }
    after 200
    set result ""
    set x ""
    update
    lappend result $x
    after 400
    update
    lappend result $x
    after 400
    update
    lappend result $x
} -result {200 {200 600} {200 600 1000}}
test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} -setup {
} {200 {200 600} {200 600 1000}}
test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x {}
    after 100 lappend x 100
    set i [after 300 lappend x 300]
    after 200 after cancel $i
    after 400
    update
    return $x
} -result 100
test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} -setup {
    set x
} 100
test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x {}
    after 100 lappend x a
    after 200 lappend x b
    after 300 lappend x c
    after 300
    vwait x
    return $x
} -result {a b c}
test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup {
    set x
} {a b c}
test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x {}
    after 100 {lappend x a; after 0 lappend x b}
    after 100
    vwait x
    return $x
} -result a
test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup {
    set x
} a
test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x {}
    after 100 {lappend x a; after 100 lappend x b; after 100}
    after 100
    vwait x
    set result $x
    vwait x
    lappend result $x
} -result {a {a b}}
} {a {a b}}

# No tests for Tcl_DoWhenIdle:  it's already tested by other tests
# below.

test timer-4.1 {Tcl_CancelIdleCall procedure} -setup {
test timer-4.1 {Tcl_CancelIdleCall procedure} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x before
    set y before
    set z before
    after idle set x after1
    after idle set y after2
    after idle set z after3
    after cancel set y after2
    update idletasks
    list $x $y $z
} -result {after1 before after3}
test timer-4.2 {Tcl_CancelIdleCall procedure} -setup {
    concat $x $y $z
} {after1 before after3}
test timer-4.2 {Tcl_CancelIdleCall procedure} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x before
    set y before
    set z before
    after idle set x after1
    after idle set y after2
    after idle set z after3
    after cancel set x after1
    update idletasks
    list $x $y $z
} -result {before after2 after3}
    concat $x $y $z
} {before after2 after3}

test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} -setup {
test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x 1
    set y 23
    after idle {incr x; after idle {incr x; after idle {incr x}}}
    after idle {incr y}
    vwait x
    set result "$x $y"
    update idletasks
    lappend result $x
} -result {2 24 4}
} {2 24 4}

test timer-6.1 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
    after
} -result {wrong # args: should be "after option ?arg ...?"}
test timer-6.2 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
    after 2x
} -result {bad argument "2x": must be cancel, idle, info, or an integer}
test timer-6.3 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
    after gorp
} -result {bad argument "gorp": must be cancel, idle, info, or an integer}
test timer-6.1 {Tcl_AfterCmd procedure, basics} {
    list [catch {after} msg] $msg
} {1 {wrong # args: should be "after option ?arg arg ...?"}}
test timer-6.2 {Tcl_AfterCmd procedure, basics} {
    list [catch {after 2x} msg] $msg
} {1 {bad argument "2x": must be cancel, idle, info, or an integer}}
test timer-6.3 {Tcl_AfterCmd procedure, basics} {
    list [catch {after gorp} msg] $msg
} {1 {bad argument "gorp": must be cancel, idle, info, or an integer}}
test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
    set x before
    after 400 {set x after}
    after 200
    update
    set y $x
    after 400
    update
    list $y $x
} {before after}
test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
    set x before
    after 400 set x after
    after 200
    update
    set y $x
    after 400
    update
    list $y $x
} {before after}
test timer-6.6 {Tcl_AfterCmd procedure, cancel option} -body {
    after cancel
} -returnCodes error -result {wrong # args: should be "after cancel id|command"}
test timer-6.6 {Tcl_AfterCmd procedure, cancel option} {
    list [catch {after cancel} msg] $msg
} {1 {wrong # args: should be "after cancel id|command"}}
test timer-6.7 {Tcl_AfterCmd procedure, cancel option} {
    after cancel after#1
} {}
test timer-6.8 {Tcl_AfterCmd procedure, cancel option} {
    after cancel {foo bar}
} {}
test timer-6.9 {Tcl_AfterCmd procedure, cancel option} -setup {
test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x before
    set y [after 100 set x after]
    after cancel $y
    after 200
    update
    return $x
} -result {before}
test timer-6.10 {Tcl_AfterCmd procedure, cancel option} -setup {
    set x
} {before}
test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x before
    after 100 set x after
    after cancel {set x after}
    after 200
    update
    return $x
} -result {before}
test timer-6.11 {Tcl_AfterCmd procedure, cancel option} -setup {
    set x
} {before}
test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x before
    after 100 set x after
    set id [after 300 set x after]
    after cancel $id
    after 200
    update
    set y $x
    set x cleared
    after 200
    update
    list $y $x
} -result {after cleared}
test timer-6.12 {Tcl_AfterCmd procedure, cancel option} -setup {
} {after cleared}
test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x first
    after idle lappend x second
    after idle lappend x third
    set i [after idle lappend x fourth]
    after cancel {lappend x second}
    after cancel $i
    update idletasks
    return $x
} -result {first third}
test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} -setup {
    set x
} {first third}
test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x first
    after idle lappend x second
    after idle lappend x third
    set i [after idle lappend x fourth]
    after cancel lappend x second
    after cancel $i
    update idletasks
    return $x
} -result {first third}
test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} -setup {
    set x
} {first third}
test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set id [
	after 100 {
	    set x done
	    after cancel $id
	}
    ]
    vwait x
} -result {}
test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} -setup {
} {}
test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    interp create x
    x eval {set a before; set b before; after idle {set a a-after};
	    after idle {set b b-after}}
    set result [llength [x eval after info]]
    lappend result [llength [after info]]
    after cancel {set b b-after}
    set a aaa
    set b bbb
    x eval {after cancel set a a-after}
    update idletasks
    lappend result $a $b [x eval {list $a $b}]
} -cleanup {
    interp delete x
    set result
} -result {2 0 aaa bbb {before b-after}}
test timer-6.16 {Tcl_AfterCmd procedure, idle option} -body {
    after idle
} -returnCodes error -result {wrong # args: should be "after idle script ?script ...?"}
} {2 0 aaa bbb {before b-after}}
test timer-6.16 {Tcl_AfterCmd procedure, idle option} {
    list [catch {after idle} msg] $msg
} {1 {wrong # args: should be "after idle script script ..."}}
test timer-6.17 {Tcl_AfterCmd procedure, idle option} {
    set x before
    after idle {set x after}
    set y $x
    update idletasks
    list $y $x
} {before after}
test timer-6.18 {Tcl_AfterCmd procedure, idle option} {
    set x before
    after idle set x after
    set y $x
    update idletasks
    list $y $x
} {before after}

set event1 [after idle event 1]
set event2 [after 1000 event 2]
interp create x
set childEvent [x eval {after idle event in child}]
test timer-6.19 {Tcl_AfterCmd, info option} {
    lsort [after info]
} [lsort "$event1 $event2"]
test timer-6.20 {Tcl_AfterCmd, info option} -returnCodes error -body {
    after info a b
} -result {wrong # args: should be "after info ?id?"}
test timer-6.21 {Tcl_AfterCmd, info option} -returnCodes error -body {
    after info $childEvent
} -result "event \"$childEvent\" doesn't exist"
test timer-6.20 {Tcl_AfterCmd, info option} {
    list [catch {after info a b} msg] $msg
} {1 {wrong # args: should be "after info ?id?"}}
test timer-6.21 {Tcl_AfterCmd, info option} {
    list [catch {after info $childEvent} msg] $msg
} "1 {event \"$childEvent\" doesn't exist}"
test timer-6.22 {Tcl_AfterCmd, info option} {
    list [after info $event1] [after info $event2]
} {{{event 1} idle} {{event 2} timer}}

after cancel $event1
after cancel $event2
interp delete x

test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x "hello world"
    after 1 "set x ab\0cd"
    after 10
    update
    string length $x
} -result {5}
test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
} {5}
test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x "hello world"
    after 1 set x ab\0cd
    after 10
    update
    string length $x
} -result {5}
test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
} {5}
test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x "hello world"
    after 1 set x ab\0cd
    after cancel "set x ab\0ef"
    llength [after info]
    set x [llength [after info]]
} -cleanup {
    foreach i [after info] {
	after cancel $i
    }
    set x
} -result {1}
test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
} {1}
test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x "hello world"
    after 1 set x ab\0cd
    after cancel set x ab\0ef
    llength [after info]
    set y [llength [after info]]
} -cleanup {
    foreach i [after info] {
	after cancel $i
    }
    set y
} -result {1}
test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
} {1}
test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x "hello world"
    after idle "set x ab\0cd"
    update
    string length $x
} -result {5}
test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
} {5}
test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x "hello world"
    after idle set x ab\0cd
    update
    string length $x
} -result {5}
test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NUL} -setup {
} {5}
test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    set x "hello world"
    set id junk
    set id [after 10 set x ab\0cd]
    update
    string length [lindex [lindex [after info $id] 0] 2]
    set y [string length [lindex [lindex [after info $id] 0] 2]]
} -cleanup {
    foreach i [after info] {
	after cancel $i
    }
    set y
} {5}
} -result 5

set event [after idle foo bar]
scan $event after#%d lastId
test timer-7.1 {GetAfterEvent procedure} -returnCodes error -body {
    after info xfter#$lastId
} -result "event \"xfter#$lastId\" doesn't exist"
test timer-7.2 {GetAfterEvent procedure} -returnCodes error -body {
    after info afterx$lastId
} -result "event \"afterx$lastId\" doesn't exist"
test timer-7.3 {GetAfterEvent procedure} -returnCodes error -body {
    after info after#ab
} -result {event "after#ab" doesn't exist}
test timer-7.4 {GetAfterEvent procedure} -returnCodes error -body {
    after info after#
} -result {event "after#" doesn't exist}
test timer-7.5 {GetAfterEvent procedure} -returnCodes error -body {
    after info after#${lastId}x
} -result "event \"after#${lastId}x\" doesn't exist"
test timer-7.6 {GetAfterEvent procedure} -returnCodes error -body {
    after info afterx[expr {$lastId+1}]
} -result "event \"afterx[expr {$lastId+1}]\" doesn't exist"
scan $event after#%d id

test timer-7.1 {GetAfterEvent procedure} {
    list [catch {after info xfter#$id} msg] $msg
} "1 {event \"xfter#$id\" doesn't exist}"
test timer-7.2 {GetAfterEvent procedure} {
    list [catch {after info afterx$id} msg] $msg
} "1 {event \"afterx$id\" doesn't exist}"
test timer-7.3 {GetAfterEvent procedure} {
    list [catch {after info after#ab} msg] $msg
} {1 {event "after#ab" doesn't exist}}
test timer-7.4 {GetAfterEvent procedure} {
    list [catch {after info after#} msg] $msg
} {1 {event "after#" doesn't exist}}
test timer-7.5 {GetAfterEvent procedure} {
    list [catch {after info after#${id}x} msg] $msg
} "1 {event \"after#${id}x\" doesn't exist}"
test timer-7.6 {GetAfterEvent procedure} {
    list [catch {after info afterx[expr $id+1]} msg] $msg
} "1 {event \"afterx[expr $id+1]\" doesn't exist}"
after cancel $event

test timer-8.1 {AfterProc procedure} {
    set x before
    proc foo {} {
	set x untouched
	after 100 {set x after}
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
595
596
597























598
599
600
601
602
603
604
605
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
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







-
+



-











-
-
-
+
+
+



-











-
-
+
+







+
-
+

-



















-
-
+
+


-
-
-
+
+
+

-
-
+
+


-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    list $y $x
} -cleanup {
    interp bgerror {} $handler
} -result {empty {{After error} {After error
    while executing
"error "After error""
    ("after" script)}}}
test timer-8.3 {AfterProc procedure, deleting handler from itself} -setup {
test timer-8.3 {AfterProc procedure, deleting handler from itself} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    proc foo {} {
	global x
	set x {}
	foreach i [after info] {
	    lappend x [after info $i]
	}
	after cancel foo
    }
    after idle foo
    after 1000 {error "I shouldn't ever have executed"}
    update idletasks
    return $x
} -result {{{error "I shouldn't ever have executed"} timer}}
test timer-8.4 {AfterProc procedure, deleting handler from itself} -setup {
    set x
} {{{error "I shouldn't ever have executed"} timer}}
test timer-8.4 {AfterProc procedure, deleting handler from itself} {
    foreach i [after info] {
	after cancel $i
    }
} -body {
    proc foo {} {
	global x
	set x {}
	foreach i [after info] {
	    lappend x [after info $i]
	}
	after cancel foo
    }
    after 1000 {error "I shouldn't ever have executed"}
    after idle foo
    update idletasks
    return $x
} -result {{{error "I shouldn't ever have executed"} timer}}
    set x
} {{{error "I shouldn't ever have executed"} timer}}

foreach i [after info] {
    after cancel $i
}

# No test for FreeAfterPtr, since it is already tested above.


test timer-9.1 {AfterCleanupProc procedure} -setup {
test timer-9.1 {AfterCleanupProc procedure} {
    catch {interp delete x}
} -body {
    interp create x
    x eval {after 200 {
	lappend x after
	puts "part 1: this message should not appear"
    }}
    after 200 {lappend x after2}
    x eval {after 200 {
	lappend x after3
	puts "part 2: this message should not appear"
    }}
    after 200 {lappend x after4}
    x eval {after 200 {
	lappend x after5
	puts "part 3: this message should not appear"
    }}
    interp delete x
    set x before
    after 300
    update
    return $x
} -result {before after2 after4}
    set x
} {before after2 after4}

test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
    interp create child
    child eval namespace export after
    child eval namespace eval foo namespace import ::after
    interp create slave
    slave eval namespace export after
    slave eval namespace eval foo namespace import ::after
} -body {
    child eval foo::after 1
    child eval namespace origin foo::after
    slave eval foo::after 1
    slave eval namespace origin foo::after
} -cleanup {
    # Bug will cause crash here; would cause failure otherwise
    interp delete child
    interp delete slave
} -result ::after

test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} -body {
    set b ok
    set a [after 0x100000001 {set b "after fired early"}]
    after 100 set done 1
    vwait done
    return $b
} -cleanup {
    catch {after cancel $a}
} -result ok
test timer-11.2 {Bug 1350293: [after] negative argument} -body {
    set l {}
    after 100 {lappend l 100; set done 1}
    after -1 {lappend l -1}
    vwait done
    return $l
} -result {-1 100}
test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} \
    -body {
	set b ok
	set a [after 0x100000001 {set b "after fired early"}]
	after 100 set done 1
	vwait done
	set b
    } \
    -cleanup {
	catch {after cancel $a}
    } \
    -result ok

test timer-11.2 {Bug 1350293: [after] negative argument} \
    -body {
	set l {}
	after 100 {lappend l 100; set done 1}
	after -1 {lappend l -1}
	vwait done
	set l
    } \
    -result {-1 100}


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/tm.test.

1
2
3
4
5
6
7
8

9
10

11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10

11
12
13
14
15
16
17
18








+

-
+







# This file contains tests for the ::tcl::tm::* commands.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 2004 by Donal K. Fellows.
# All rights reserved.

package require Tcl 8.5-
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    package require tcltest 2
    namespace import -force ::tcltest::*
}

test tm-1.1 {tm: path command exists} {
    catch { ::tcl::tm::path }
    info commands ::tcl::tm::path
} ::tcl::tm::path

Changes to tests/trace.test.

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
1
2
3
4
5
6
7
8
9
10
11
12
13



14
15




16
17
18
19
20
21
22













-
-
-
+
+
-
-
-
-







# Commands covered:  trace
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest
namespace import ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevalobjv [llength [info commands testevalobjv]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]

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
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







-
-
-
+
+
+




-
-
-
+
+
+




-
-
-
+
+
+




-
-
-
+
+
+







    set info {}
    trace add variable x read traceScalar
    unset x
    set info
} {}
test trace-1.11 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x(bar) ;#}
    set x(bar) 0 
    trace variable x r {set x(foo) 1 ;#} 
    trace variable x r {unset -nocomplain x(bar) ;#} 
    array get x
} {}
test trace-1.12 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x(bar) ;#}
    trace variable x r {set x(foo) 1 ;#}
    set x(bar) 0 
    trace variable x r {unset -nocomplain x(bar) ;#} 
    trace variable x r {set x(foo) 1 ;#} 
    array get x
} {}
test trace-1.13 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {set x(foo) 1 ;#}
    trace variable x r {unset -nocomplain x;#}
    set x(bar) 0 
    trace variable x r {set x(foo) 1 ;#} 
    trace variable x r {unset -nocomplain x;#} 
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}
test trace-1.14 {read traces that modify the array structure} {
    unset -nocomplain x
    set x(bar) 0
    trace variable x r {unset -nocomplain x;#}
    trace variable x r {set x(foo) 1 ;#}
    set x(bar) 0 
    trace variable x r {unset -nocomplain x;#} 
    trace variable x r {set x(foo) 1 ;#} 
    list [catch {array get x} res] $res
} {1 {can't read "x(bar)": no such variable}}

# Basic write-tracing on variables

test trace-2.1 {trace variable writes} {
    unset -nocomplain x
417
418
419
420
421
422
423
424

425
426
427
428
429
430
431
412
413
414
415
416
417
418

419
420
421
422
423
424
425
426







-
+







    set ::info
} {x {} array}
test trace-5.8 {array traces fire for undefined variables} {
    unset -nocomplain x
    trace add variable x array {set x(foo) 1 ;#}
    set res "names: [array names x]"
} {names: foo}

    
# Trace multiple trace types at once.

test trace-6.1 {multiple ops traced at once} {
    unset -nocomplain x
    set info {}
    trace add variable x {read write unset} traceProc
    catch {set x}
765
766
767
768
769
770
771
772

773
774
775
776
777
778
779
760
761
762
763
764
765
766

767
768
769
770
771
772
773
774







-
+







    unset -nocomplain x
    set x 44
    set info {}
    trace add variable x read {traceTag 1}
    trace add variable x read {traceTag 2}
    trace add variable x read {traceTag 3}
    trace add variable x read {traceTag 4}
    trace add variable x read delTraces
    trace add variable x read delTraces 
    trace add variable x read {traceTag 5}
    set x
    set info
} {5 1}

test trace-13.2 {leak when unsetting traced variable} \
    -constraints memory -body {
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
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







-
+


-
+


-
+









-
+







    test trace-14.0.[incr i] "trace command, wrong # args errors" {
	list [catch {trace info $type} msg] $msg
    } [list 1 "$start should be \"trace info $type name\""]
}

test trace-14.1 "trace command, wrong # args errors" {
    list [catch {trace} msg] $msg
} [list 1 "wrong # args: should be \"trace option ?arg ...?\""]
} [list 1 "wrong # args: should be \"trace option ?arg arg ...?\""]
test trace-14.2 "trace command, wrong # args errors" {
    list [catch {trace add} msg] $msg
} [list 1 "wrong # args: should be \"trace add type ?arg ...?\""]
} [list 1 "wrong # args: should be \"trace add type ?arg arg ...?\""]
test trace-14.3 "trace command, wrong # args errors" {
    list [catch {trace remove} msg] $msg
} [list 1 "wrong # args: should be \"trace remove type ?arg ...?\""]
} [list 1 "wrong # args: should be \"trace remove type ?arg arg ...?\""]
test trace-14.4 "trace command, wrong # args errors" {
    list [catch {trace info} msg] $msg
} [list 1 "wrong # args: should be \"trace info type name\""]

test trace-14.5 {trace command, invalid option} {
    list [catch {trace gorp} msg] $msg
} [list 1 "bad option \"gorp\": must be add, info, remove, variable, vdelete, or vinfo"]

# Again, [trace ... command] and [trace ... variable] share syntax and
# error message styles for their opList options; these loops test those
# error message styles for their opList options; these loops test those 
# error messages.

set i 0
set errs [list "array, read, unset, or write" "delete or rename" "enter, leave, enterstep, or leavestep"]
set abbvs [list {a r u w} {d r} {}]
proc x {} {}
foreach type {variable command execution} err $errs abbvlist $abbvs {
2102
2103
2104
2105
2106
2107
2108
2109

2110
2111
2112
2113
2114
2115
2116
2097
2098
2099
2100
2101
2102
2103

2104
2105
2106
2107
2108
2109
2110
2111







-
+







foo {set b 1} enterstep
foo {set b 1} 0 1 leavestep
foo foo 0 1 leave}

test trace-28.2 {exec traces with 'error'} {
    set info {}
    set res {}

    
    proc foo {} {
	if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}
    }
2124
2125
2126
2127
2128
2129
2130
2131

2132
2133
2134
2135
2136
2137
2138
2119
2120
2121
2122
2123
2124
2125

2126
2127
2128
2129
2130
2131
2132
2133







-
+








    # With the trace active

    lappend res [foo]

    trace remove execution foo {enter enterstep leave leavestep} \
      [list traceExecute foo]

    
    list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}} enterstep
2150
2151
2152
2153
2154
2155
2156
2157

2158
2159
2160
2161
2162
2163
2164
2145
2146
2147
2148
2149
2150
2151

2152
2153
2154
2155
2156
2157
2158
2159







-
+







	    return "ok"
	}} 2 error leavestep
foo foo 0 error leave}}

test trace-28.3 {exec traces with 'return -code error'} {
    set info {}
    set res {}

    
    proc foo {} {
	if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}
    }
2172
2173
2174
2175
2176
2177
2178
2179

2180
2181
2182
2183
2184
2185
2186
2167
2168
2169
2170
2171
2172
2173

2174
2175
2176
2177
2178
2179
2180
2181







-
+








    # With the trace active

    lappend res [foo]

    trace remove execution foo {enter enterstep leave leavestep} \
      [list traceExecute foo]

    
    list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}} enterstep
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
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







-
-
-
+
+
+

-
+


-
+







-
+

-
+

-
+


-
+

-
+

-
+


-
+


-
+







foo {if {[catch {bar}]} {
	    return "error"
	} else {
	    return "ok"
	}} 2 error leavestep
foo foo 0 error leave}}

test trace-28.4 {exec traces in child with 'return -code error'} {
    interp create child
    interp alias child traceExecute {} traceExecute
test trace-28.4 {exec traces in slave with 'return -code error'} {
    interp create slave
    interp alias slave traceExecute {} traceExecute
    set info {}
    set res [interp eval child {
    set res [interp eval slave {
	set info {}
	set res {}

	
	proc foo {} {
	    if {[catch {bar}]} {
		return "error"
	    } else {
		return "ok"
	    }
	}

	
	proc bar {} { return -code error "msg" }

	
	lappend res [foo]

	
	trace add execution foo {enter enterstep leave leavestep} \
	  [list traceExecute foo]

	
	# With the trace active

	
	lappend res [foo]

	
	trace remove execution foo {enter enterstep leave leavestep} \
	  [list traceExecute foo]

	
	list $res
    }]
    interp delete child
    interp delete slave
    lappend res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
		return "error"
	    } else {
		return "ok"
	    }} enterstep
2608
2609
2610
2611
2612
2613
2614
2615

2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636

2637
2638
2639
2640
2641
2642
2643
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

2631
2632
2633
2634
2635
2636
2637
2638







-
+




















-
+







    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
	# 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
    }
2666
2667
2668
2669
2670
2671
2672
2673

2674
2675
2676
2677
2678
2679
2680
2661
2662
2663
2664
2665
2666
2667

2668
2669
2670
2671
2672
2673
2674
2675







-
+








test trace-40.1 {execution trace errors become command errors} {
    proc foo args {}
    trace add execution foo enter {rename foo {}; error bar;#}
    catch foo m
    return -level 0 $m[unset m]
} bar

    
# 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/unixFCmd.test.

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
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16



17
18
19
20
21
22
23











-
-
+
+



-
-
-







# This file tests the tclUnixFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testchmod [llength [info commands testchmod]]

# These tests really need to be run from a writable directory, which
# it is assumed [temporaryDirectory] is.
set oldcwd [pwd]
cd [temporaryDirectory]

55
56
57
58
59
60
61
62

63
64
65
66
67
68
69
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66







-
+







	file attributes $f -readonly
	testConstraint readonlyAttr 1
    }
    removeFile probe
}

proc openup {path} {
    testchmod 0o777 $path
    testchmod 777 $path
    if {[file isdirectory $path]} {
	catch {
	    foreach p [glob -directory $path *] {
		openup $p
	    }
	}
    }
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
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







-
-
-
-
-
-
+

-


-
+
-

-
-
-
+
+
+

-


-
+
-
-
-
-
+
+

-

-
+
-
-
-
+



-
+

-

-
+
-
-
-
+



-
+

-


-
+
-
+



+
-
+

-
+



-
+








-
-
+




-
-
-
+

-
+
+

-



-
+
-
-
-
+
-
-

+




-
-
-
-
+
+
-
-

+




-
-
-
-
+
+

-





-
-
+
+

-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+

-

-
+


-
-
-
+







		openup $file
		file delete -force -- $file
	    }
	}
    }
}

if {[testConstraint unix] && [testConstraint notRoot]} {
    testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}]
    cleanup
}

test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup {
test unixFCmd-1.1 {TclpRenameFile: EACCES} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1/td2/td3
    file attributes td1/td2 -permissions 0000
    file rename td1/td2/td3 td2
    set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
} -returnCodes error -cleanup {
    file attributes td1/td2 -permissions 0755
    cleanup
} -result {error renaming "td1/td2/td3": permission denied}
test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup {
    set msg
} {1 {error renaming "td1/td2/td3": permission denied}}
test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1/td2
    file mkdir td2
    file rename td2 td1
    list [catch {file rename td2 td1} msg] $msg
} -returnCodes error -cleanup {
    cleanup
} -result {error renaming "td2" to "td1/td2": file already exists}
test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup {
} {1 {error renaming "td2" to "td1/td2": file already exists}}
test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1
    file rename td1 td1
    list [catch {file rename td1 td1} msg] $msg
} -returnCodes error -cleanup {
    cleanup
} -result {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}
} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unix notRoot} {
    # can't make it happen
} {}
test unixFCmd-1.5 {TclpRenameFile: ENOENT} -setup {
test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir td1
    file rename td2 td1
    list [catch {file rename td2 td1} msg] $msg
} -returnCodes error -cleanup {
    cleanup
} -result {error renaming "td2": no such file or directory}
} {1 {error renaming "td2": no such file or directory}}
test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} {
    # can't make it happen
} {}
test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup {
test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    file mkdir foo/bar
    file attr foo -perm 040555
    file rename foo/bar /tmp
    set catchResult [catch {file rename foo/bar /tmp} msg]
} -returnCodes error -cleanup {
    set msg [lindex [split $msg :] end]
    catch {file delete /tmp/bar}
    catch {file attr foo -perm 040777}
    catch {file delete -force foo}
    list $catchResult $msg
} -match glob -result {*: permission denied}
} {1 { permission denied}}
test unixFCmd-1.8 {Checking EINTR Bug} {unix notRoot nonPortable} {
    testalarm
    testalarm 
    after 2000
    list [testgotsig] [testgotsig]
} {1 0}
test unixFCmd-1.9 {Checking EINTR Bug} -constraints {unix notRoot nonPortable} -setup {
test unixFCmd-1.9 {Checking EINTR Bug} {unix notRoot nonPortable} {
    cleanup
    set f [open tfalarm w]
    puts $f {
	after 2000
	puts "hello world"
	exit 0
    }
    close $f
} -body {
    testalarm
    testalarm 
    set pipe [open "|[info nameofexecutable] tfalarm" r+]
    set line [read $pipe 1]
    catch {close $pipe}
    list $line [testgotsig]
} -cleanup {
    cleanup
} -result {h 1}
} {h 1}

test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} -setup {
test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
	{unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    close [open tf1 a]
    close [open tf2 a]
    file copy -force tf1 tf2
} -cleanup {
} {}
    cleanup
} -result {}
test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} -setup {
test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unix notRoot dontCopyLinks} {
    cleanup
} -constraints {unix notRoot dontCopyLinks} -body {
    # copying links should end up with real files
    cleanup
    close [open tf1 a]
    file link -symbolic tf2 tf1
    file copy tf2 tf3
    file type tf3
} -cleanup {
    cleanup
} -result file
test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} -setup {
} {file}
test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    # copying links should end up with the links copied
    cleanup
    close [open tf1 a]
    file link -symbolic tf2 tf1
    file copy tf2 tf3
    file type tf3
} -cleanup {
    cleanup
} -result link
test unixFCmd-2.3 {TclpCopyFile: src is block} -setup {
} {link}
test unixFCmd-2.3 {TclpCopyFile: src is block} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    set null "/dev/null"
    while {[file type $null] != "characterSpecial"} {
	set null [file join [file dirname $null] [file readlink $null]]
    }
    # file copy $null tf1
} -result {}
test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup {
} {}
test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unix notRoot} {
    cleanup
} -constraints {unix notRoot execMknod} -body {
    exec mknod tf1 p
    file copy tf1 tf2
    list [file type tf1] [file type tf2]
} -cleanup {
    if [catch {exec mknod tf1 p}] {
	list 1
    } else {
	file copy tf1 tf2
	expr {"[file type tf1]" == "[file type tf2]"}
    }
} {1}
    cleanup
} -result {fifo fifo}
test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unix notRoot} {
    cleanup
} -constraints {unix notRoot} -body {
    close [open tf1 a]
    file attributes tf1 -permissions 0o472
    file attributes tf1 -permissions 0472
    file copy tf1 tf2
    file attributes tf2 -permissions
} -cleanup {
    cleanup
} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
} 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-

test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} {
} {}

test unixFCmd-4.1 {TclpDeleteFile not done} {emptyTest unix notRoot} {
} {}

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
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




363
364
365
366



367
368
369
370
371
372
373
374
375
376
377
378







-
+

-
-
-
-
+
+
+

-

-
-
+
+
-
-

-
+

-
-
-
-
+
+
+

-

-
+
-
-
-
+
+

-
+

-
-
-
-
+
+
+

-

-
+
-
-
-
+
+


-
+

-
-
+
-
-
-
-
+
+
+
+

-
-
-
+
+


-
+

-

-
-
+
+
-
-
-
-
+
+
+

-
-
-
-
+
+
+

-
-
-
+
+

+
-
+

-

-
-
+
+
-
-
-
-
+
+
+

-
-
-
-
+
+
+

-

-
+
-
-
-
-
+
+
+

-

-
+
-
-
-
+
+













-
-
-
-
-
+
+
+
+
+


-
+
-
-
-
+

+




-
+
-
-
+


+
-
+

-
+

-
-
-
-
+
+
+

-

-
+
-
-
-
+
+

-
+

-





-
+
-
-
-
-
+
+
+

-
-
-
+
+











test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unix notRoot} {
} {}

test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unix notRoot} {
} {}

test unixFCmd-12.1 {GetGroupAttribute - file not found} -setup {
test unixFCmd-12.1 {GetGroupAttribute - file not found} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    file attributes foo.test -group
} -result {could not read "foo.test": no such file or directory}
test unixFCmd-12.2 {GetGroupAttribute - file found} -setup {
    list [catch {file attributes foo.test -group} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}
test unixFCmd-12.2 {GetGroupAttribute - file found} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    file attributes foo.test -group
} -cleanup {
    list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
} {0 {}}
    file delete -force -- foo.test
} -match glob -result *

test unixFCmd-13.1 {GetOwnerAttribute - file not found} -setup {
test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    file attributes foo.test -group
} -result {could not read "foo.test": no such file or directory}
test unixFCmd-13.2 {GetOwnerAttribute} -setup {
    list [catch {file attributes foo.test -group} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}
test unixFCmd-13.2 {GetOwnerAttribute} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    file attributes foo.test -owner
    list [catch {file attributes foo.test -owner} msg] \
} -cleanup {
    file delete -force -- foo.test
} -result $user
	    [string compare $msg $user] [file delete -force -- foo.test]
} {0 0 {}}

test unixFCmd-14.1 {GetPermissionsAttribute - file not found} -setup {
test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    file attributes foo.test -permissions
} -result {could not read "foo.test": no such file or directory}
test unixFCmd-14.2 {GetPermissionsAttribute} -setup {
    list [catch {file attributes foo.test -permissions} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}
test unixFCmd-14.2 {GetPermissionsAttribute} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    file attribute foo.test -permissions
    list [catch {file attribute foo.test -permissions}] \
} -cleanup {
    file delete -force -- foo.test
} -match glob -result *
	    [file delete -force -- foo.test]
} {0 {}}

#groups hard to test
test unixFCmd-15.1 {SetGroupAttribute - invalid group} -setup {
test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    file attributes foo.test -group foozzz
    list [catch {file attributes foo.test -group foozzz} msg] \
} -returnCodes error -cleanup {
    file delete -force -- foo.test
} -result {could not set group for file "foo.test": group "foozzz" does not exist}
test unixFCmd-15.2 {SetGroupAttribute - invalid file} -setup {
	    $msg [file delete -force -- foo.test]
} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
	{unix notRoot foundGroup} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot foundGroup} -returnCodes error -body {
    file attributes foo.test -group $group
} -result {could not set group for file "foo.test": no such file or directory}
    list [catch {file attributes foo.test -group $group} msg] $msg
} {1 {could not set group for file "foo.test": no such file or directory}}

#changing owners hard to do
test unixFCmd-16.1 {SetOwnerAttribute - current owner} -setup {
test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    list [file attributes foo.test -owner $user] \
	[file attributes foo.test -owner]
    list [catch {file attributes foo.test -owner $user} msg] \
	    $msg [string compare [file attributes foo.test -owner] $user] \
} -cleanup {
    file delete -force -- foo.test
} -result [list {} $user]
test unixFCmd-16.2 {SetOwnerAttribute - invalid file} -setup {
	    [file delete -force -- foo.test]
} {0 {} 0 {}}
test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    file attributes foo.test -owner $user
} -result {could not set owner for file "foo.test": no such file or directory}
test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup {
    list [catch {file attributes foo.test -owner $user} msg] $msg
} {1 {could not set owner for file "foo.test": no such file or directory}}
test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    file attributes foo.test -owner foozzz
} -result {could not set owner for file "foo.test": user "foozzz" does not exist}
    list [catch {file attributes foo.test -owner foozzz} msg] $msg
} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}


test unixFCmd-17.1 {SetPermissionsAttribute} -setup {
test unixFCmd-17.1 {SetPermissionsAttribute} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    list [file attributes foo.test -permissions 0000] \
	[file attributes foo.test -permissions]
    list [catch {file attributes foo.test -permissions 0000} msg] \
	    $msg [file attributes foo.test -permissions] \
} -cleanup {
    file delete -force -- foo.test
} -result {{} 00000}
test unixFCmd-17.2 {SetPermissionsAttribute} -setup {
	    [file delete -force -- foo.test]
} {0 {} 00000 {}}
test unixFCmd-17.2 {SetPermissionsAttribute} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -returnCodes error -body {
    file attributes foo.test -permissions 0000
} -result {could not set permissions for file "foo.test": no such file or directory}
test unixFCmd-17.3 {SetPermissionsAttribute} -setup {
    list [catch {file attributes foo.test -permissions 0000} msg] $msg
} {1 {could not set permissions for file "foo.test": no such file or directory}}
test unixFCmd-17.3 {SetPermissionsAttribute} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    file attributes foo.test -permissions foo
    list [catch {file attributes foo.test -permissions foo} msg] $msg \
} -cleanup {
    file delete -force -- foo.test
} -returnCodes error -result {unknown permission string format "foo"}
test unixFCmd-17.4 {SetPermissionsAttribute} -setup {
	    [file delete -force -- foo.test]
} {1 {unknown permission string format "foo"} {}}
test unixFCmd-17.4 {SetPermissionsAttribute} {unix notRoot} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot} -body {
    close [open foo.test w]
    file attributes foo.test -permissions ---rwx
    list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \
} -cleanup {
    file delete -force -- foo.test
} -returnCodes error -result {unknown permission string format "---rwx"}
	    [file delete -force -- foo.test]
} {1 {unknown permission string format "---rwx"} {}}

close [open foo.test w]
set ::i 4
proc permcheck {testnum permList expected} {
    test $testnum {SetPermissionsAttribute} {unix notRoot} {
      set result {}
      foreach permstr $permList {
	file attributes foo.test -permissions $permstr
	lappend result [file attributes foo.test -permissions]
      }
      set result
    } $expected
}
permcheck unixFCmd-17.5   rwxrwxrwx	0o777
permcheck unixFCmd-17.6   r--r---w-	0o442
permcheck unixFCmd-17.7   {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547}
permcheck unixFCmd-17.11  --x--x--x	0o111
permcheck unixFCmd-17.12  {0 a+rwx} {00000 0o777}
permcheck unixFCmd-17.5   rwxrwxrwx	00777
permcheck unixFCmd-17.6   r--r---w-	00442
permcheck unixFCmd-17.7   {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547}
permcheck unixFCmd-17.11  --x--x--x	00111
permcheck unixFCmd-17.12  {0 a+rwx} {00000 00777}
file delete -force -- foo.test

test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
test unixFCmd-18.1 {Unix pwd} {nonPortable unix notRoot} {
    set cd [pwd]
} -body {
    # This test is nonPortable because SunOS generates a weird error
    # This test is nonportable because SunOS generates a weird error
    # message when the current directory isn't readable.
    set cd [pwd]
    set nd $cd/tstdir
    file mkdir $nd
    cd $nd
    file attributes $nd -permissions 0000
    pwd
    set r [list [catch {pwd} res] [string range $res 0 36]];
} -returnCodes error -cleanup {
    cd $cd
    cd $cd;
    file attributes $nd -permissions 0755
    file delete $nd
    set r
} -match glob -result {error getting working directory name:*}
} {1 {error getting working directory name:}}

test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} -setup {
test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} {unix notRoot readonlyAttr} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot readonlyAttr} -returnCodes error -body {
    file attributes foo.test -readonly
} -result {could not read "foo.test": no such file or directory}
test unixFCmd-19.2 {GetReadOnlyAttribute} -setup {
    list [catch {file attributes foo.test -readonly} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}
test unixFCmd-19.2 {GetReadOnlyAttribute} {unix notRoot readonlyAttr} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot readonlyAttr} -body {
    close [open foo.test w]
    file attribute foo.test -readonly
    list [catch {file attribute foo.test -readonly} msg] $msg \
} -cleanup {
    file delete -force -- foo.test
} -result 0
	    [file delete -force -- foo.test]
} {0 0 {}}

test unixFCmd-20.1 {SetReadOnlyAttribute} -setup {
test unixFCmd-20.1 {SetReadOnlyAttribute} {unix notRoot readonlyAttr} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot readonlyAttr} -body {
    close [open foo.test w]
    list [catch {file attributes foo.test -readonly 1} msg] $msg \
	    [catch {file attribute foo.test -readonly} msg] $msg \
	    [catch {file delete -force -- foo.test}] \
	    [catch {file attributes foo.test -readonly 0} msg] $msg \
	    [catch {file attribute foo.test -readonly} msg] $msg
	    [catch {file attribute foo.test -readonly} msg] $msg \
} -cleanup {
    file delete -force -- foo.test
} -result {0 {} 0 1 1 0 {} 0 0}
test unixFCmd-20.2 {SetReadOnlyAttribute} -setup {
	    [file delete -force -- foo.test]
} {0 {} 0 1 1 0 {} 0 0 {}}
test unixFCmd-20.2 {SetReadOnlyAttribute} {unix notRoot readonlyAttr} {
    catch {file delete -force -- foo.test}
} -constraints {unix notRoot readonlyAttr} -returnCodes error -body {
    file attributes foo.test -readonly 1
} -result {could not read "foo.test": no such file or directory}
    list [catch {file attributes foo.test -readonly 1} msg] $msg
} {1 {could not read "foo.test": no such file or directory}}

# cleanup
cleanup
cd $oldcwd
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/unixFile.test.

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
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16



17
18
19
20
21
22
23











-
-
+
+



-
-
-







# This file contains tests for the routines in the file tclUnixFile.c
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testfindexecutable [llength [info commands testfindexecutable]]

set oldpwd [pwd]
cd [temporaryDirectory]

catch {
    set oldPath $env(PATH)

Changes to tests/unixForkEvent.test.

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10



11
12

13
14
15
16
17
18
19










-
-
-
+
+
-







# This file contains a collection of tests for the procedures in the file
# tclUnixNotify.c.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import -force ::tcltest::*
}

testConstraint testfork [llength [info commands testfork]]

# Test if the notifier thread is well initialized in a forked interpreter
# by Tcl_InitNotifier
test unixforkevent-1.1 {fork and test writeable event} \
    -constraints {testfork nonPortable} \
35
36
37
38
39
40
41
42

43
44
45
46
47
33
34
35
36
37
38
39

40
41
42
43
44
45







-
+





	    exit
	}
	# we are the original process
	while {![file readable [file join $myFolder result.txt]]} {}
	viewFile result.txt $myFolder
    } \
    -result {writable} \
    -cleanup {
    -cleanup { 
	catch { removeFolder $myFolder }
    }

::tcltest::cleanupTests
return

Changes to tests/unixInit.test.

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
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


-
-
-
+
+
+




-
-
+
+

-
-
-
+
+
-




-
-
-


















-
-
-
+
+
+

-
-
-
+
+
+










-
-
+
+



-
-
-
-
-
+
+
+
+
+












+
-
+








-
-
+
+



-
-
+
+
-
-
-
-
-
+
+
+

-
+











+
-
-
+
+
+





-
+








-
+
+
+

-













-
+
+
+

-












-
+
+
+
+

-







# The file tests the functions in the tclUnixInit.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2.2
namespace import ::tcltest::*
}
unset -nocomplain path
catch {set oldlang $env(LANG)}
set env(LANG) C

# Some tests require the testgetencpath command
testConstraint testgetencpath [llength [info commands testgetencpath]]

test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} {
    set x {}
    # Watch out for a race condition here.  If tcltest is too slow to start
    # then we'll kill it before it has a chance to set up its signal handler.
    set f [open "|[list [interpreter]]" w+]
    puts $f "puts hi"
    flush $f
    gets $f
    exec kill -PIPE [pid $f]
    lappend x [catch {close $f}]
    set f [open "|[list [interpreter]]" w+]
    puts $f "puts hi"
    flush $f
    gets $f
    exec kill [pid $f]
    lappend x [catch {close $f}]
    set x
} {0 1}
# This test is really a test of code in tclUnixChan.c, but the channels are
# set up as part of initialisation of the interpreter so the test seems to me
# to fit here as well as anywhere else.
# This test is really a test of code in tclUnixChan.c, but the
# channels are set up as part of initialisation of the interpreter so
# the test seems to me to fit here as well as anywhere else.
test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} {
    # pipe1 is a connection to a server that reports what port it starts on,
    # and delivers a constant string to the first client to connect to that
    # port before exiting.
    # pipe1 is a connection to a server that reports what port it
    # starts on, and delivers a constant string to the first client to
    # connect to that port before exiting.
    set pipe1 [open "|[list [interpreter]]" r+]
    puts $pipe1 {
	proc accept {channel host port} {
	    puts $channel {puts [chan configure stdin -peername]; exit}
	    close $channel
	    exit
	}
	puts [chan configure [socket -server accept -myaddr 127.0.0.1 0] -sockname]
	vwait forever \
	    }
    # Note the backslash above; this is important to make sure that the whole
    # string is read before an [exit] can happen...
    # Note the backslash above; this is important to make sure that the
    # whole string is read before an [exit] can happen...
    flush $pipe1
    set port [lindex [gets $pipe1] 2]
    set sock [socket localhost $port]
    # pipe2 is a connection to a Tcl interpreter that takes its orders from
    # the socket we hand it (i.e. the server we create above.)  These orders
    # will tell it to print out the details about the socket it is taking
    # instructions from, hopefully identifying it as a socket.  Which is what
    # this test is all about.
    # pipe2 is a connection to a Tcl interpreter that takes its orders
    # from the socket we hand it (i.e. the server we create above.)
    # These orders will tell it to print out the details about the
    # socket it is taking instructions from, hopefully identifying it
    # as a socket.  Which is what this test is all about.
    set pipe2 [open "|[list [interpreter] <@$sock]" r]
    set result [gets $pipe2]
    # Clear any pending data; stops certain kinds of (non-important) errors
    chan configure $pipe1 -blocking 0; gets $pipe1
    chan configure $pipe2 -blocking 0; gets $pipe2
    # Close the pipes and the socket.
    close $pipe2
    close $pipe1
    catch {close $sock}
    # Can't use normal comparison, as hostname varies due to some
    # installations having a messed up /etc/hosts file.
    if {
	[string equal 127.0.0.1 [lindex $result 0]] &&
	"127.0.0.1" eq [lindex $result 0] && $port == [lindex $result 2]
	[string equal $port     [lindex $result 2]]
    } then {
	subst "OK"
    } else {
	subst "Expected: `[list 127.0.0.1 localhost $port]', Got `$result'"
    }
} {OK}

# The unixInit-2.* tests were written to test the internal routine,
# TclpInitLibraryPath.  That routine no longer does the things it used to do
# so those tests are obsolete.  Skip them.
# TclpInitLibraryPath.  That routine no longer does the things it used
# to do so those tests are obsolete.  Skip them.

skip [concat [skip] unixInit-2.*]

test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} -constraints {
    testgetencpath
test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} {
    set origDir [testgetdefenc]
} -body {
    set origPath [testgetencpath]
    testsetencpath slappy
    set path [testgetencpath]
    testsetencpath $origPath
    testsetdefenc slappy
    set path [testgetdefenc]
    testsetdefenc $origDir
    set path
} -result {slappy}
} {slappy}
test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup {
    unset -nocomplain oldlibrary
    if {[info exists env(TCL_LIBRARY)]} {
	set oldlibrary $env(TCL_LIBRARY)
	unset env(TCL_LIBRARY)
    }
} -body {
    set path [getlibpath]
    set installLib lib/tcl[info tclversion]
    set developLib tcl[info patchlevel]/library
    set prefix [file dirname [file dirname [interpreter]]]
    set x {}
    list [string equal [lindex $path 0] $prefix/$installLib] \
	[string equal [lindex $path 4] [file dirname $prefix]/$developLib]
    lappend x [string compare [lindex $path 0] $prefix/$installLib]
    lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
    set x
} -cleanup {
    if {[info exists oldlibrary]} {
	set env(TCL_LIBRARY) $oldlibrary
	unset oldlibrary
    }
} -result {1 1}
} -result {0 0}
test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
    unset -nocomplain oldlibrary
    if {[info exists env(TCL_LIBRARY)]} {
	set oldlibrary $env(TCL_LIBRARY)
    }
} -body {
    # ((str != NULL) && (str[0] != '\0'))
    set env(TCL_LIBRARY) sparkly
    lindex [getlibpath] 0
    set path [getlibpath]
    unset env(TCL_LIBRARY)
    lindex $path 0
} -cleanup {
    unset -nocomplain env(TCL_LIBRARY)
    if {[info exists oldlibrary]} {
	set env(TCL_LIBRARY) $oldlibrary
	unset oldlibrary
    }
} -result "sparkly"
test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
    unset -nocomplain oldlibrary
    if {[info exists env(TCL_LIBRARY)]} {
	set oldlibrary $env(TCL_LIBRARY)
    }
} -body {
    # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
    set env(TCL_LIBRARY) /a/b/tcl1.7
    lrange [getlibpath] 0 1
    set path [getlibpath]
    unset env(TCL_LIBRARY)
    lrange $path 0 1
} -cleanup {
    unset -nocomplain env(TCL_LIBRARY)
    if {[info exists oldlibrary]} {
	set env(TCL_LIBRARY) $oldlibrary
	unset oldlibrary
    }
} -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
    if {[info exists env(TCL_LIBRARY)]} {
	set oldlibrary $env(TCL_LIBRARY)
    }
} -body {
    # Child process translates env variable from native encoding.
    set env(TCL_LIBRARY) "\xa7"
    lindex [getlibpath] 0
    set x [lindex [getlibpath] 0]
    unset env(TCL_LIBRARY)
    unset env(LANG)
    set x
} -cleanup {
    unset -nocomplain env(TCL_LIBRARY) env(LANG)
    if {[info exists oldlibrary]} {
	set env(TCL_LIBRARY) $oldlibrary
	unset oldlibrary
    }
} -result "\xa7"
test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} {
    # cannot test
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
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







-
-
-
+
+
+
+








-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
+
+







    }
} -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} {
    # would need test command to get defaultLibDir and compare it to
    # [lindex $auto_path end]
} {}
#
# The following two tests write to the directory /tmp/sparkly instead of to
# [temporaryDirectory].  This is because the failures tested by these tests
# need paths near the "root" of the file system to present themselves.
# The following two tests write to the directory /tmp/sparkly instead
# of to [temporaryDirectory].  This is because the failures tested by
# these tests need paths near the "root" of the file system to present
# themselves.
#
test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
    unset -nocomplain oldlibrary
    if {[info exists env(TCL_LIBRARY)]} {
	set oldlibrary $env(TCL_LIBRARY)
    }
    set env(TCL_LIBRARY) [info library]
    # Checking for Bug 219416
    # When a program that embeds the Tcl library, like tcltest, is installed
    # near the "root" of the file system, there was a problem constructing
    # directories relative to the executable.  When a relative ".." went past
    # the root, relative path names were created rather than absolute
    # pathnames.  In some cases, accessing past the root caused memory access
    # violations too.
    # When a program that embeds the Tcl library, like tcltest, is
    # installed near the "root" of the file system, there was a problem
    # constructing directories relative to the executable.  When a 
    # relative ".." went past the root, relative path names were created
    # rather than absolute pathnames.  In some cases, accessing past the
    # root caused memory access violations too.
    #
    # The bug is now fixed, but here we check for it by making sure that the
    # directories constructed relative to the executable are all absolute
    # pathnames, even when the executable is installed near the root of the
    # filesystem.
    # The bug is now fixed, but here we check for it by making sure that
    # the directories constructed relative to the executable are all
    # absolute pathnames, even when the executable is installed near
    # the root of the filesystem.
    #
    # The only directory near the root we are likely to have write access to
    # is /tmp.
    # The only directory near the root we are likely to have write access
    # to is /tmp.
    file delete -force /tmp/sparkly
    file delete -force /tmp/lib/tcl[info tclversion]
    file mkdir /tmp/sparkly
    file copy [interpreter] /tmp/sparkly/tcltest
    # Keep any existing /tmp/lib directory
    set deletelib 1
    if {[file exists /tmp/lib]} {
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
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







+

+

+

+


+

+

-
-
+
+
















+

-
-

-
+
-
-

+






+
+
+


-
-
+
+
+


-
-
+
+
-
-
-







    set x [lrange [getlibpath [file join .. bin tcltest]] 3 4]
    foreach p $x {
	lappend y [file normalize $p]
    }
    set y
} -cleanup {
    cd $saveDir
    unset saveDir
    removeFile init.tcl $scriptDir
    unset scriptDir
    removeDirectory tcl[info tclversion] $libDir
    unset libDir
    file delete $execPath
    unset execPath
    removeDirectory bin $sparklyDir
    removeDirectory lib $sparklyDir
    unset sparklyDir
    removeDirectory sparkly $tmpDir
    unset tmpDir
    removeDirectory tmp
    unset -nocomplain saveDir scriptDir libDir execPath sparklyDir tmpDir
    unset -nocomplain x p y env(TCL_LIBRARY)
    unset x p y
    unset env(TCL_LIBRARY)
    if {[info exists oldlibrary]} {
	set env(TCL_LIBRARY) $oldlibrary
	unset oldlibrary
    }
} -result [list [file join [temporaryDirectory] tmp sparkly library] \
	[file join [temporaryDirectory] tmp library] ]

test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
	unix stdio
} -body {
    set env(LANG) C
    set f [open "|[list [interpreter]]" w+]
    chan configure $f -buffering none
    puts $f {puts [encoding system]; exit}
    set enc [gets $f]
    close $f
    unset env(LANG)
    set enc
} -cleanup {
    unset -nocomplain env(LANG)
} -match regexp -result {^(iso8859-15?|utf-8)$}
test unixInit-3.2 {TclpSetInitialEncodings} -setup {
test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} {
    catch {set oldlc_all $env(LC_ALL)}
} -constraints {unix stdio} -body {
    set env(LANG) japanese
    catch {set oldlc_all $env(LC_ALL)}
    set env(LC_ALL) japanese
    set f [open "|[list [interpreter]]" w+]
    chan configure $f -buffering none
    puts $f {puts [encoding system]; exit}
    set enc [gets $f]
    close $f
    unset env(LANG)
    unset env(LC_ALL)
    catch {set env(LC_ALL) $oldlc_all}
    set validEncodings [list euc-jp]
    if {[string match HP-UX $tcl_platform(os)]} {
	# Some older HP-UX systems need us to accept this as valid Bug 453883
	# reports that newer HP-UX systems report euc-jp like everybody else.
	# Some older HP-UX systems need us to accept this as valid
	# Bug 453883 reports that newer HP-UX systems report euc-jp
	# like everybody else.
	lappend validEncodings shiftjis
    }
    expr {$enc ni $validEncodings}
} -cleanup {
    expr {[lsearch -exact $validEncodings $enc] < 0}
} 0
    unset -nocomplain env(LANG) env(LC_ALL)
    catch {set env(LC_ALL) $oldlc_all}
} -result 0

test unixInit-4.1 {TclpSetVariables} {unix} {
    # just make sure they exist
    set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
    set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
    set tcl_platform(platform)
} "unix"
390
391
392
393
394
395
396
397

398
399
400
401
402
403
404
405
406
407
408
396
397
398
399
400
401
402

403
404
405
406
407
408
409
410











-
+







-
-
-
-
	[list exec $tclsh $crash]
    " crashtest.tcl]
    exec $tclsh $crashtest
} -cleanup {
    removeFile crash.tcl
    removeFile crashtest.tcl
} -returnCodes 0


# cleanup
unset -nocomplain env(LANG)
catch {set env(LANG) $oldlang}
unset -nocomplain path
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/unixNotfy.test.

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
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












+
+
+
+
-
-
+
+




-
-
+
+
+
+
+
+
+




-
+






-
+



-
+


















-
+






-
+

+








-
+










-
+

+



-
+









# This file contains tests for tclUnixNotfy.c.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# 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.

# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
# the "testthread" command indicates that this is the case.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# When run in a Tk shell, these tests hang.
testConstraint noTk [expr {0 != [catch {package present Tk}]}]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint noTk       [expr {![info exists tk_version]}]
testConstraint testthread [expr {[info commands testthread] != {}}]
# 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 nonPortable -body {
test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f [open [makeFile "" foo] w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup { 
    catch { close $f }
    catch { removeFile foo }
}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f1 [open [makeFile "" foo] w]
    set f2 [open [makeFile "" foo2] w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1
    vwait y
    close $f2
    list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
    catch { close $f1 }
    catch { close $f2 }
    catch { removeFile foo }
    catch { removeFile foo2 }
}

test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
    -constraints {noTk unix thread} \
    -constraints {noTk unix testthread} \
    -body {
	update
	set f [open [makeFile "" foo] w]
	fileevent $f writable {set x 1}
	vwait x
	close $f
   	thread::create "thread::send [thread::id] {set x ok}"
   	testthread create "testthread send [testthread id] {set x ok}"
	vwait x
	threadReap
	set x
    } \
    -result {ok} \
    -cleanup {
	catch { close $f }
	catch { removeFile foo }
    }
test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
    -constraints {noTk unix thread} \
    -constraints {noTk unix testthread} \
    -body {
	update
	set f1 [open [makeFile "" foo] w]
	set f2 [open [makeFile "" foo2] w]
	fileevent $f1 writable {set x 1}
	fileevent $f2 writable {set y 1}
	vwait x
	close $f1
	vwait y
	close $f2
   	thread::create "thread::send [thread::id] {set x ok}"
   	testthread create "testthread send [testthread id] {set x ok}"
	vwait x
	threadReap
	set x
    } \
    -result {ok} \
    -cleanup {
    -cleanup { 
	catch { close $f1 }
	catch { close $f2 }
	catch { removeFile foo }
	catch { removeFile foo2 }
    }

# cleanup
::tcltest::cleanupTests
return

Changes to tests/unknown.test.

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
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













-
-
-
+
+
-



-
+








+







# Commands covered:  unknown
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest 2
namespace import ::tcltest::*
}

unset -nocomplain x
catch {rename unknown unknown.old}


test unknown-1.1 {non-existent "unknown" command} {
    list [catch {_non-existent_ foo bar} msg] $msg
} {1 {invalid command name "_non-existent_"}}

proc unknown {args} {
    global x
    set x $args
}

test unknown-2.1 {calling "unknown" command} {
    foobar x y z
    set x
} {foobar x y z}
test unknown-2.2 {calling "unknown" command with lots of args} {
    foobar 1 2 3 4 5 6 7
    set x
48
49
50
51
52
53
54

55
56
57
58

59
60
61
62
63
64
65
66
67
47
48
49
50
51
52
53
54
55
56
57

58
59
60
61
62
63











+



-
+





-
-
-
-
    foobar \{ \} a\{b \; "\\" \$a a\[b \]
    set x
} "foobar \\{ \\} a\\{b {;} \\\\ {\$a} {a\[b} \\]"

proc unknown args {
    error "unknown failed"
}

test unknown-4.1 {errors in "unknown" procedure} {
    list [catch {non-existent a b} msg] $msg $errorCode
} {1 {unknown failed} NONE}


# cleanup
catch {rename unknown {}}
catch {rename unknown.old unknown}
cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/unload.test.

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
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







-
-
+
+




-
-
+
+



-
-
-







# Commands covered:  unload
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2003-2004 by Georgios Petasis
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2003-2004 Georgios Petasis
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Figure out what extension is used for shared libraries on this
# platform.
if {![info exists ext]} {
    set ext [info sharedlibextension]
}

# Tests require the existence of one of the DLLs in the dltest directory.
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
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







-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+








-
+
-
-
-
-
-
+
+
+
+
-
-




-
-
+
+
-
-
-
-
-




-
-
+
+
-
-
-
-
-
-
-




-
+











-
+






-
+




-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
+




-
-
+
+
-
-
-
-
-
+





-
-
+
+
-
-
-
-
-
-
+

-
+


-
+








-

-
+
-
-
-
-
-
+




-
+

-
+
-
-
-
-
-
-
-
+

-
+



-
+

-
+
-
-
+

-
+



-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
+




-
+

-
+
-
-
-
-
-
-
-
-
+




-
+

-
+
-
-
-
-
+




-
+

-
-
-
-
-
-
-
-
-
-
-
-
-










testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]

set alreadyTotalLoaded [info loaded]

# Certain tests require the 'teststaticpkg' command from tcltest
testConstraint teststaticpkg [llength [info commands teststaticpkg]]

# Certain tests need the 'testsimplefilsystem' in tcltest
testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]

proc loadIfNotPresent {pkg args} {
    global testDir ext
    set loaded [lmap x [info loaded {*}$args] {lindex $x 1}]
    if {[string totitle $pkg] ni $loaded} {
	load [file join $testDir $pkg$ext]
    }
}

# Basic tests: parameter testing...
test unload-1.1 {basic errors} -returnCodes error -body {
    unload
} -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"}
test unload-1.2 {basic errors} -returnCodes error -body {
    unload a b c d
} -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"}
test unload-1.3 {basic errors} -returnCodes error -body {
    unload a b foobar
} -result {could not find interpreter "foobar"}
test unload-1.4 {basic errors} -returnCodes error -body {
    unload {}
} -result {must specify either file name or package name}
test unload-1.5 {basic errors} -returnCodes error -body {
    unload {} {}
} -result {must specify either file name or package name}
test unload-1.6 {basic errors} -returnCodes error -body {
    unload {} Unknown
} -result {package "Unknown" is loaded statically and cannot be unloaded}
test unload-1.7 {-nocomplain switch} {
    unload -nocomplain {} Unknown
} {}
test unload-1.1 {basic errors} {} {
    list [catch {unload} msg] $msg
} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}"
test unload-1.2 {basic errors} {} {
    list [catch {unload a b c d} msg] $msg
} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}"
test unload-1.3 {basic errors} {} {
    list [catch {unload a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test unload-1.4 {basic errors} {} {
    list [catch {unload {}} msg] $msg
} {1 {must specify either file name or package name}}
test unload-1.5 {basic errors} {} {
    list [catch {unload {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test unload-1.6 {basic errors} {} {
    list [catch {unload {} Unknown} msg] $msg
} {1 {package "Unknown" is loaded statically and cannot be unloaded}}
test unload-1.7 {-nocomplain switch} {} {
    list [unload -nocomplain {} Unknown]
} {{}}

set pkgua_loaded {}
set pkgua_detached {}
set pkgua_unloaded {}
# Tests for loading/unloading in trusted (non-safe) interpreters...
test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] {
    loadIfNotPresent pkga
    load [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [load [file join $testDir pkgua$ext]] \
	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} -setup {
test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} [list $dll $loaded] {
    loadIfNotPresent pkga
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir pkga$ext]
} -result {file "*" cannot be unloaded under a trusted interpreter}
test unload-2.4 {basic unloading of unloadable package, with guess for package name} -setup {
    list [catch {unload [file join $testDir pkga$ext]} msg] \
	    [string map [list [file join $testDir pkga$ext] file] $msg]
} {1 {file "file" cannot be unloaded under a trusted interpreter}}
test unload-2.4 {basic unloading of unloadable package, with guess for package name} [list $dll $loaded] {
    loadIfNotPresent pkgua
} -constraints [list $dll $loaded] -body {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [unload [file join $testDir pkgua$ext]] \
	    [info commands pkgua_*] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} -result {. {} {} {} {} . . .}
test unload-2.5 {reloading of unloaded package, with guess for package name} -setup {
} {. {} {} {} {} . . .}
test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] {
    if {$pkgua_loaded eq ""} {
	loadIfNotPresent pkgua
	unload [file join $testDir pkgua$ext]
    }
} -constraints [list $dll $loaded] -body {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [load [file join $testDir pkgua$ext]] \
	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
test unload-2.6 {basic unloading of re-loaded package, with guess for package name} -setup {
} {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] {
    # Establish expected state
    if {$pkgua_loaded eq ""} {
	loadIfNotPresent pkgua
	unload [file join $testDir pkgua$ext]
	load [file join $testDir pkgua$ext]
    }
} -constraints [list $dll $loaded] -body {
    list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
	    [unload [file join $testDir pkgua$ext]] \
	    [info commands pkgua_*] \
	    $pkgua_loaded $pkgua_detached $pkgua_unloaded
} -result {.. . . {} {} .. .. ..}
} {.. . . {} {} .. .. ..}

# Tests for loading/unloading in safe interpreters...
interp create -safe child
child eval {
    set pkgua_loaded {}
    set pkgua_detached {}
    set pkgua_unloaded {}
}
test unload-3.1 {basic loading of non-unloadable package in a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    catch {rename pkgb_sub {}}
    load [file join $testDir pkgb$ext] pKgB child
    load [file join $testDir pkgb$ext] Pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
         [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test unload-3.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir pkgua$ext] pKgUA child] \
	    [load [file join $testDir pkgua$ext] Pkgua child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup {
test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} \
    loadIfNotPresent pkga
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir pkga$ext] {} child
} -result {file "*" has never been loaded in this interpreter}
test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup {
    if {[lsearch -index 1 [info loaded child] Pkgb] < 0} {
	load [file join $testDir pkgb$ext] pKgB child
	[list $dll $loaded] {
    list [catch {unload [file join $testDir pkga$ext] {} child} msg] \
         [string map [list [file join $testDir pkga$ext] file] $msg]
} {1 {file "file" has never been loaded in this interpreter}}
test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} \
	[list $dll $loaded] {
    list [catch {unload [file join $testDir pkgb$ext] {} child} msg] \
    }
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir pkgb$ext] {} child
} -result {file "*" cannot be unloaded under a safe interpreter}
test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup {
         [string map [list [file join $testDir pkgb$ext] file] $msg]
} {1 {file "file" cannot be unloaded under a safe interpreter}}
test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} \
    if {[lsearch -index 1 [info loaded child] Pkgua] < 0} {
	load [file join $testDir pkgua$ext] pkgua child
    }
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir pkgua$ext] {} child] \
	    [child eval info commands pkgua_*] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. {} {}} {} {} {. . .}}
test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} -setup {
} {{. {} {}} {} {} {. . .}}
test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} \
    if {[child eval set pkgua_loaded] eq ""} {
	load [file join $testDir pkgua$ext] {} child
	unload [file join $testDir pkgua$ext] {} child
    }
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir pkgua$ext] {} child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} -setup {
} {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} \
    if {[child eval set pkgua_loaded] eq ""} {
	load [file join $testDir pkgua$ext] {} child
	unload [file join $testDir pkgua$ext] {} child
	load [file join $testDir pkgua$ext] {} child
    }
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir pkgua$ext] pKgUa child] \
	    [unload [file join $testDir pkgua$ext] Pkgua child] \
	    [child eval info commands pkgua_*] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{.. . .} {} {} {.. .. ..}}
} {{.. . .} {} {} {.. .. ..}}

# Tests for loading/unloading of a package among multiple interpreters...
interp create child-trusted
child-trusted eval {
    set pkgua_loaded {}
    set pkgua_detached {}
    set pkgua_unloaded {}
}
array set load {M 0 C 0 T 0}
## Load package in main trusted interpreter...
test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} -setup {
test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \
    set pkgua_loaded ""
    set pkgua_detached ""
    set pkgua_unloaded ""
    incr load(M)
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
	    [load [file join $testDir pkgua$ext]] \
	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
## Load package in child-safe interpreter...
test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} -setup {
test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
    child eval {
	set pkgua_loaded ""
	set pkgua_detached ""
	set pkgua_unloaded ""
    }
    incr load(C)
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir pkgua$ext] pKgUA child] \
	    [load [file join $testDir pkgua$ext] Pkgua child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
## Load package in child-trusted interpreter...
test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} -setup {
test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} \
    incr load(T)
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir pkgua$ext] pkguA child-trusted] \
	    [load [file join $testDir pkgua$ext] Pkgua child-trusted] \
	    [child-trusted eval pkgua_eq abc def] \
	    [lsort [child-trusted eval info commands pkgua_*]] \
	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Unload the package from the main trusted interpreter...
test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} -setup {
test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} \
    if {!$load(M)} {
	load [file join $testDir pkgua$ext]
    }
    if {!$load(C)} {
	load [file join $testDir pkgua$ext] {} child
	incr load(C)
    }
    if {!$load(T)} {
	load [file join $testDir pkgua$ext] {} child-trusted
	incr load(T)
    }
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
	    [unload [file join $testDir pkgua$ext]] \
	    [info commands pkgua_*] \
	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
} -result {{. {} {}} {} {} {. . {}}}
} {{... .. ..} {} {} {... ... ..}}
## Unload the package from the child safe interpreter...
test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
    if {!$load(C)} {
	load [file join $testDir pkgua$ext] {} child
    }
    if {!$load(T)} {
	load [file join $testDir pkgua$ext] {} child-trusted
	incr load(T)
    }
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir pkgua$ext] {} child] \
	    [child eval info commands pkgua_*] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. {} {}} {} {} {. . {}}}
} {{... .. ..} {} {} {... ... ..}}
## Unload the package from the child trusted interpreter...
test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
    if {!$load(T)} {
	load [file join $testDir pkgua$ext] {} child-trusted
    }
} -constraints [list $dll $loaded] -body {
	[list $dll $loaded] {
    list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [unload [file join $testDir pkgua$ext] {} child-trusted] \
	    [child-trusted eval info commands pkgua_*] \
	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{. {} {}} {} {} {. . .}}
} {{. {} {}} {} {} {. . .}}

test unload-5.1 {unload a module loaded from vfs} \
     -constraints [list $dll $loaded testsimplefilesystem] \
     -setup {
	 set dir [pwd]
	 cd $testDir
	 testsimplefilesystem 1
	 load simplefs:/pkgua$ext pkgua
     } \
    -body {
	list [catch {unload simplefs:/pkgua$ext} msg] $msg
    } \
    -result {0 {}}

# cleanup
interp delete child
interp delete child-trusted
unset ext
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/uplevel.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+











-
+







# Commands covered:  uplevel
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

proc a {x y} {
    newset z [expr $x+$y]
    return $z
}
proc newset {name value} {
    uplevel set $name $value
    uplevel 1 {uplevel 1 {set xyz 22}}
}


test uplevel-1.1 {simple operation} {
    set xyz 0
    a 22 33
} 55
test uplevel-1.2 {command is another uplevel command} {
    set xyz 0
    a 22 33
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
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







-
-
+
+
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-







test uplevel-4.0.2 {error: non-existent level} -setup {
    interp create i
} -body {
    i eval { uplevel { set y 222 } }
} -returnCodes error -result {bad level "1"} -cleanup {
    interp delete i
}
test uplevel-4.1 {error: non-existent level} -returnCodes error -body {
    apply {{} {
test uplevel-4.1 {error: non-existent level} {
    list [catch c1 msg] $msg
	uplevel #2 {set y 222}
    }}
} -result {bad level "#2"}
test uplevel-4.2 {error: non-existent level} -returnCodes error -body {
} {1 {bad level "#2"}}
test uplevel-4.2 {error: non-existent level} {
    apply {{} {
	uplevel 3 {set a b}
    proc c2 {} {uplevel 3 {set a b}}
    }}
} -result {bad level "3"}
test uplevel-4.3 {error: not enough args} -returnCodes error -body {
    uplevel
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.4 {error: not enough args} -returnCodes error -body {
    list [catch c2 msg] $msg
} {1 {bad level "3"}}
test uplevel-4.3 {error: not enough args} {
    list [catch uplevel msg] $msg
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
test uplevel-4.4 {error: not enough args} {
    apply {{} {
	uplevel 1
    }}
} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test uplevel-4.5 {level parsing} {
    apply {{} {uplevel 0 {}}}
} {}
test uplevel-4.6 {level parsing} {
    apply {{} {uplevel #0 {}}}
} {}
test uplevel-4.7 {level parsing} {
    apply {{} {uplevel [expr 0] {}}}
} {}
test uplevel-4.8 {level parsing} {
    apply {{} {uplevel #[expr 0] {}}}
} {}
test uplevel-4.9 {level parsing} {
    apply {{} {uplevel -0 {}}}
} {}
test uplevel-4.10 {level parsing} {
    apply {{} {uplevel #-0 {}}}
} {}
test uplevel-4.11 {level parsing} {
    apply {{} {uplevel [expr -0] {}}}
} {}
test uplevel-4.12 {level parsing} {
    apply {{} {uplevel #[expr -0] {}}}
} {}
test uplevel-4.13 {level parsing} {
    apply {{} {uplevel 1 {}}}
} {}
test uplevel-4.14 {level parsing} {
    apply {{} {uplevel #1 {}}}
} {}
test uplevel-4.15 {level parsing} {
    apply {{} {uplevel [expr 1] {}}}
} {}
test uplevel-4.16 {level parsing} {
    apply {{} {uplevel #[expr 1] {}}}
} {}
test uplevel-4.17 {level parsing} -returnCodes error -body {
    apply {{} {uplevel -0xffffffff {}}}
} -result {bad level "-0xffffffff"}
test uplevel-4.18 {level parsing} -returnCodes error -body {
    apply {{} {uplevel #-0xffffffff {}}}
} -result {bad level "#-0xffffffff"}
test uplevel-4.19 {level parsing} -returnCodes error -body {
    apply {{} {uplevel [expr -0xffffffff] {}}}
} -result {bad level "-4294967295"}
test uplevel-4.20 {level parsing} -returnCodes error -body {
    apply {{} {uplevel #[expr -0xffffffff] {}}}
} -result {bad level "#-4294967295"}
test uplevel-4.21 {level parsing} -body {
    apply {{} {uplevel -1 {}}}
    proc upBug {} {uplevel 1}
} -returnCodes error -result {bad level "-1"}
test uplevel-4.22 {level parsing} -body {
    apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {
    apply {{} {uplevel [expr -1] {}}}
} -returnCodes error -result {bad level "-1"}
test uplevel-4.24 {level parsing} -body {
    apply {{} {uplevel #[expr -1] {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.25 {level parsing} -body {
    apply {{} {uplevel 0xffffffff {}}}
} -returnCodes error -result {bad level "0xffffffff"}
test uplevel-4.26 {level parsing} -body {
    apply {{} {uplevel #0xffffffff {}}}
} -returnCodes error -result {bad level "#0xffffffff"}
test uplevel-4.27 {level parsing} -body {
    apply {{} {uplevel [expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "4294967295"}
test uplevel-4.28 {level parsing} -body {
    apply {{} {uplevel #[expr 0xffffffff] {}}}
} -returnCodes error -result {bad level "#4294967295"}
test uplevel-4.29 {level parsing} -body {
    apply {{} {uplevel 0.2 {}}}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.30 {level parsing} -body {
    apply {{} {uplevel #0.2 {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.31 {level parsing} -body {
    apply {{} {uplevel [expr 0.2] {}}}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.32 {level parsing} -body {
    apply {{} {uplevel #[expr 0.2] {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.33 {level parsing} -body {
    apply {{} {uplevel .2 {}}}
} -returnCodes error -result {invalid command name ".2"}
test uplevel-4.34 {level parsing} -body {
    apply {{} {uplevel #.2 {}}}
} -returnCodes error -result {bad level "#.2"}
test uplevel-4.35 {level parsing} -body {
    apply {{} {uplevel [expr .2] {}}}
} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.36 {level parsing} -body {
    apply {{} {uplevel #[expr .2] {}}}
} -returnCodes error -result {bad level "#0.2"}


    list [catch upBug msg] $msg
} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}


proc a2 {} {
    uplevel a3
}
proc a3 {} {
    global x y
    set x [info level]
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
130
131
132
133
134
135
136

137




















































































138
139
140












-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
-
    set res [namespace eval ns1 a2]
    lappend res [namespace eval ns2 a2]
    lappend res [namespace eval ns1 a2]
    namespace eval ns1 {rename set {}}
    lappend res [namespace eval ns1 a2]
} {::ns1 :: ::ns1 ::}

#

# These tests verify that upleveled scripts run in the correct level and access
# the proper variables.
#

test uplevel-7.1 {var access, no LVT in either level} -setup {
    set x 1
    unset -nocomplain y z
} -body {
    namespace eval foo {
	set x 2
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }
    list $x $y $z
} -cleanup {
    namespace delete foo
    unset -nocomplain x y z
} -result {3 3 3}

test uplevel-7.2 {var access, no LVT in upper level} -setup {
    set x 1
    unset -nocomplain y z
} -body {
    proc foo {} {
	set x 2
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }
    foo
    list $x $y $z
} -cleanup {
    rename foo {}
    unset -nocomplain x y z
} -result {3 3 3}

test uplevel-7.3 {var access, LVT in upper level} -setup {
    proc moo {} {
	set x 1; #var in LVT
	unset -nocomplain y z
	foo
	list $x $y $z
    }
} -body {
    proc foo {} {
	set x 2
	set y 2
	uplevel 1 {
	    set x 3
	    set y 3
	    set z 3
	}
    }
    foo
    moo
} -cleanup {
    rename foo {}
    rename moo {}
} -result {3 3 3}


test uplevel-8.0 {
    string representation isn't generated when there is only one argument
} -body {
    set res {}
    set script [list lindex 5]
    lappend res [apply {script {
	uplevel $script
    }} $script]
    lappend res [string match {value is a list *no string representation*} [
	::tcl::unsupported::representation $script]]
} -cleanup {
    unset script
    unset res
} -result {5 1}


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/upvar.test.

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
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


-
-
-
+
+
+





-
-
+
+

-
-
+
+



-
-
-







# Commands covered:  'upvar', 'namespace upvar'
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testupvar [llength [info commands testupvar]]

test upvar-1.1 {reading variables with upvar} {
    proc p1 {a b} {set c 22; set d 33; p2}
    proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
    p1 foo bar
} {foo bar 22 33 abc}
145
146
147
148
149
150
151
152

153
154
155
156
157
158
159
160

161
162
163
164
165
166
167
142
143
144
145
146
147
148

149
150
151
152
153
154
155
156

157
158
159
160
161
162
163
164







-
+







-
+







	set a(0) zeroth
	set a(1) first
	set a(2) second
	p2
	array names a
    }
    proc p2 {} {upvar a(0) x; unset x}
    lsort [p1]
    p1
} {1 2}
test upvar-3.6 {unsetting then resetting array elements with upvar} {
    proc p1 {} {
	set a(0) zeroth
	set a(1) first
	set a(2) second
	p2
	list [lsort [array names a]] [catch {set a(0)} msg] $msg
	list [array names a] [catch {set a(0)} msg] $msg
    }
    proc p2 {} {upvar a(0) x; unset x; set x 12345}
    p1
} {{0 1 2} 0 12345}

test upvar-4.1 {nested upvars} {
    set x1 88
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
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







-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+

-
+
-
+











-
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+



-
-
+
+

-
-
+
+



-

-
+

-
-
+
+

-
-
-
+
+
+

-


-
-
+
+

-







-
-
-
-







    proc leak {} {
	array set foo {1 2 3 4}
	upvar 0 foo(1) bar
    }
    leak
} {}

test upvar-8.1 {errors in upvar command} -returnCodes error -body {
    upvar
} -result {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}
test upvar-8.2 {errors in upvar command} -returnCodes error -body {
    upvar 1
} -result {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}
test upvar-8.1 {errors in upvar command} {
    list [catch upvar msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
test upvar-8.2 {errors in upvar command} {
    list [catch {upvar 1} msg] $msg
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
test upvar-8.2.1 {upvar with numeric first argument} {
    apply {{} {set 0 ok; apply {{} {upvar 0 x; return $x}}}}
} ok
test upvar-8.3 {errors in upvar command} -returnCodes error -body {
test upvar-8.3 {errors in upvar command} {
    proc p1 {} {upvar a b c}
    p1
    list [catch p1 msg] $msg
} -result {bad level "a"}
} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
test upvar-8.3.1 {bad level for upvar (upvar at top-level, bug [775ee88560])} -body {
    proc p1 {} { uplevel { upvar b b; lappend b UNEXPECTED } }
    uplevel #0 { p1 }
} -returnCodes error -result {bad level "1"}
test upvar-8.3.2 {bad level for upvar (upvar at top-level, bug [775ee88560])} -setup {
    interp create i
} -body {
    i eval { upvar b b; lappend b UNEXPECTED }
} -returnCodes error -result {bad level "1"} -cleanup {
    interp delete i
}
test upvar-8.4 {errors in upvar command} -returnCodes error -body {
test upvar-8.4 {errors in upvar command} {
    proc p1 {} {upvar 0 b b}
    p1
} -result {can't upvar from variable to itself}
test upvar-8.5 {errors in upvar command} -returnCodes error -body {
    list [catch p1 msg] $msg
} {1 {can't upvar from variable to itself}}
test upvar-8.5 {errors in upvar command} {
    proc p1 {} {upvar 0 a b; upvar 0 b a}
    p1
} -result {can't upvar from variable to itself}
test upvar-8.6 {errors in upvar command} -returnCodes error -body {
    list [catch p1 msg] $msg
} {1 {can't upvar from variable to itself}}
test upvar-8.6 {errors in upvar command} {
    proc p1 {} {set a 33; upvar b a}
    p1
} -result {variable "a" already exists}
test upvar-8.7 {errors in upvar command} -returnCodes error -body {
    list [catch p1 msg] $msg
} {1 {variable "a" already exists}}
test upvar-8.7 {errors in upvar command} {
    proc p1 {} {trace variable a w foo; upvar b a}
    p1
} -result {variable "a" has traces: can't use for upvar}
    list [catch p1 msg] $msg
} {1 {variable "a" has traces: can't use for upvar}}
test upvar-8.8 {create nested array with upvar} -body {
    proc p1 {} {upvar x(a) b; set b(2) 44}
    catch {unset x}
    p1
} -returnCodes error -cleanup {
    list [catch p1 msg] $msg
} -cleanup {
    unset x
} -result {can't set "b(2)": variable isn't array}
test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} -setup {
} -result {1 {can't set "b(2)": variable isn't array}}
test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
    catch {rename MakeLink ""}
    namespace eval ::test_ns_1 {}
} -returnCodes error -body {
    proc MakeLink {a} {
	namespace eval ::test_ns_1 {
        namespace eval ::test_ns_1 {
	    upvar a a
	}
	unset ::test_ns_1::a
        }
        unset ::test_ns_1::a
    }
    MakeLink 1
} -result {bad variable name "a": can't create namespace variable that refers to procedure variable}
test upvar-8.10 {upvar will create element alias for new array element} -setup {
    list [catch {MakeLink 1} msg] $msg
} {1 {bad variable name "a": can't create namespace variable that refers to procedure variable}}
test upvar-8.10 {upvar will create element alias for new array element} {
    catch {unset upvarArray}
} -body {
    array set upvarArray {}
    catch {upvar 0 upvarArray(elem) upvarArrayElemAlias}
} -result {0}
test upvar-8.11 {upvar will not create a variable that looks like an array} -setup {
} {0}
test upvar-8.11 {upvar will not create a variable that looks like an array} -body {
    catch {unset upvarArray}
} -body {
    array set upvarArray {}
    upvar 0 upvarArray(elem) upvarArrayElemAlias(elem)
} -returnCodes 1 -match glob -result *

test upvar-9.1 {Tcl_UpVar2 procedure} testupvar {
    list [catch {testupvar xyz a {} x global} msg] $msg
} {1 {bad level "1"}}
test upvar-9.1.1 {TclGetFrame, via Tcl_UpVar2} testupvar {
    apply {{} {testupvar xyz a {} x local; set x foo}}
    set a
} foo
test upvar-9.2 {Tcl_UpVar2 procedure} testupvar {
    catch {unset a}
    catch {unset x}
    set a 44
    list [catch "testupvar #0 a 1 x global" msg] $msg
} {1 {can't access "a(1)": variable isn't array}}
test upvar-9.3 {Tcl_UpVar2 procedure} testupvar {
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
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
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
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







+



-
+


+




+



+
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
+
-







    apply {n {
        upvar 1 {*}{
        } [return [incr n -[linenumber]]] x
    }} [linenumber]
} -cleanup {
    rename linenumber {}
} -result 1


#
# Tests for 'namespace upvar'. As the implementation is essentially the same as
# for 'upvar', we only test that the variables are linked correctly, i.e., we
# for 'upvar', we only test that the variables are linked correctly. Ie, we
# assume that the behaviour of variables once the link is established has
# already been tested above.
#
#

# Clear out any namespaces called test_ns_*
catch {namespace delete {*}[namespace children :: test_ns_*]}

namespace eval test_ns_0 {
    variable x test_ns_0
}

set ::x test_global
set x test_global

test upvar-NS-1.1 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace upvar ::test_ns_0 x w
	set w
    }
} -result {test_ns_0} -cleanup {
    namespace delete test_ns_1
}
test upvar-NS-1.2 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	proc a {} {
	    namespace upvar ::test_ns_0 x w
	    set w
	}
	return [a]
    }
} -result {test_ns_0} -cleanup {
    namespace delete test_ns_1
}
test upvar-NS-1.3 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace upvar test_ns_0 x w
	set w
    }
} -returnCodes error -cleanup {
    namespace delete test_ns_1
} -result {namespace "test_ns_0" not found in "::test_ns_1"}
test upvar-NS-1.4 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	proc a {} {
	    namespace upvar test_ns_0 x w
	    set w
	}
	return [a]
    }
} -returnCodes error -cleanup {
    namespace delete test_ns_1
test upvar-NS-1.1 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace upvar ::test_ns_0 x w
	    set w
	}
    } \
    -result {test_ns_0} \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.2 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    proc a {} {
		namespace upvar ::test_ns_0 x w
		set w
	    }
	    return [a]
	}
    } \
    -result {test_ns_0} \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.3 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace upvar test_ns_0 x w
	    set w
	}
    } \
    -result {namespace "test_ns_0" not found in "::test_ns_1"} \
    -returnCodes error \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.4 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    proc a {} {
		namespace upvar test_ns_0 x w
		set w
	    }
	    return [a]
	}
    } \
    -result {namespace "test_ns_0" not found in "::test_ns_1"} \
    -returnCodes error \
    -cleanup {namespace delete test_ns_1}
} -result {namespace "test_ns_0" not found in "::test_ns_1"}

test upvar-NS-1.5 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {}
	namespace upvar test_ns_0 x w
	set w
    }
} -cleanup {
    namespace delete test_ns_1
} -result {can't read "w": no such variable} -returnCodes error
test upvar-NS-1.6 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {}
	proc a {} {
	    namespace upvar test_ns_0 x w
	    set w
	}
	return [a]
    }
} -cleanup {
    namespace delete test_ns_1
} -result {can't read "w": no such variable} -returnCodes error
test upvar-NS-1.7 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {
	    variable x test_ns_1::test_ns_0
	}
	namespace upvar test_ns_0 x w
	set w
    }
} -cleanup {
    namespace delete test_ns_1
} -result {test_ns_1::test_ns_0}
test upvar-NS-1.8 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	namespace eval test_ns_0 {
	    variable x test_ns_1::test_ns_0
	}
	proc a {} {
	    namespace upvar test_ns_0 x w
	    set w
	}
	return [a]
    }
} -cleanup {
    namespace delete test_ns_1
} -result {test_ns_1::test_ns_0}
test upvar-NS-1.9 {nsupvar links to correct variable} -body {
    namespace eval test_ns_1 {
	variable x test_ns_1
	proc a {} {
	    namespace upvar test_ns_0 x w
	    set w
	}
	return [a]
    }
} -returnCodes error -cleanup {
test upvar-NS-1.5 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace eval test_ns_0 {}
	    namespace upvar test_ns_0 x w
	    set w
	}
    } \
    -result {can't read "w": no such variable} \
    -returnCodes error \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.6 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace eval test_ns_0 {}
	    proc a {} {
		namespace upvar test_ns_0 x w
		set w
	    }
	    return [a]
	}
    } \
    -result {can't read "w": no such variable} \
    -returnCodes error \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.7 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace eval test_ns_0 {
		variable x test_ns_1::test_ns_0
	    }
	    namespace upvar test_ns_0 x w
	    set w
	}
    } \
    -result {test_ns_1::test_ns_0} \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.8 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    namespace eval test_ns_0 {
		variable x test_ns_1::test_ns_0
	    }
	    proc a {} {
		namespace upvar test_ns_0 x w
		set w
	    }
	    return [a]
	}
    } \
    -result {test_ns_1::test_ns_0} \
    -cleanup {namespace delete test_ns_1}

test upvar-NS-1.9 {nsupvar links to correct variable} \
    -body {
	namespace eval test_ns_1 {
	    variable x test_ns_1
	    proc a {} {
		namespace upvar test_ns_0 x w
		set w
	    }
	    return [a]
	}
    } \
    namespace delete test_ns_1
} -result {namespace "test_ns_0" not found in "::test_ns_1"}
    -result {namespace "test_ns_0" not found in "::test_ns_1"} \

test upvar-NS-2.1 {TIP 323} -returnCodes error -body {
    -returnCodes error \
    namespace upvar
} -result {wrong # args: should be "namespace upvar ns ?otherVar myVar ...?"}
test upvar-NS-2.2 {TIP 323} -setup {
    namespace eval test_ns_1 {}
} -body {
    namespace upvar test_ns_1
} -cleanup {
    namespace delete test_ns_1
    -cleanup {namespace delete test_ns_1}
} -result {}

test upvar-NS-3.1 {CompileWord OBOE} -setup {
    proc linenumber {} {dict get [info frame -1] line}
} -body {
    apply {n {
        namespace upvar {*}{
        } [return [incr n -[linenumber]]] x y

Changes to tests/utf.test.

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
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





-
+

















-







# This file contains a collection of tests for tclUtf.c
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}]
testConstraint ucs4 [expr {[testConstraint fullutf]
		&& [string length [format %c 0x10000]] == 1}]
testConstraint ucs2_utf16 [expr {![testConstraint ucs4]}]

testConstraint Uesc [expr {"\U0041" eq "A"}]
testConstraint pre388 [expr {"\x741" eq "A"}]
testConstraint pairsTo4bytes [expr {[llength [info commands teststringbytes]]
		&& [string length [teststringbytes \uD83D\uDCA9]] == 4}]

testConstraint testbytestring [llength [info commands testbytestring]]
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
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







-
+


-
+

















-
+
+
+
+







} 1
test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
    expr {[format %c 0x110000] eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
    expr {[format %c -1] eq [testbytestring \xEF\xBF\xBD]}
} 1
test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf Uesc testbytestring} {
test utf-1.7.0 {Tcl_UniCharToUtf: 4 byte sequences} {fullutf testbytestring} {
    expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 1
test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {ucs2 Uesc testbytestring} {
test utf-1.7.1 {Tcl_UniCharToUtf: 4 byte sequences} {Uesc ucs2 testbytestring} {
    expr {"\U014E4E" eq [testbytestring \xF0\x94\xB9\x8E]}
} 0
test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
    expr {"\uD842" eq [testbytestring \xED\xA1\x82]}
} 1
test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
    expr {"\uDC42" eq [testbytestring \xED\xB1\x82]}
} 1
test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
    expr {[format %c 0xD842] eq [testbytestring \xED\xA1\x82]}
} 1
test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
    expr {[format %c 0xDC42] eq [testbytestring \xED\xB1\x82]}
} 1
test utf-1.12 {Tcl_UniCharToUtf: 4 byte sequence, high/low surrogate} {pairsTo4bytes testbytestring} {
    expr {"\uD842\uDC42" eq [testbytestring \xF0\xA0\xA1\x82]}
} 1
test utf-1.13 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc testbytestring} {
test utf-1.13.0 {Tcl_UniCharToUtf: Invalid surrogate} {Uesc ucs2} {
    expr {"\UD842" eq "\uD842"}
} 1
test utf-1.13.1 {Tcl_UniCharToUtf: Invalid surrogate} {fullutf testbytestring} {
    expr {"\UD842" eq [testbytestring \xEF\xBF\xBD]}
} 1

test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
    string length "abc"
} 3
test utf-2.2 {Tcl_UtfToUniChar: naked trail bytes} testbytestring {
100
101
102
103
104
105
106
107

108



109
110
111


112
113

114



115
116

117
118
119
120
121
122
123
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







-
+

+
+
+

-
-
+
+

-
+

+
+
+

-
+







} 1
test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestring {
    string length [testbytestring \xE2\xA2]
} 2
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
    string length [testbytestring \xE4\xB9\x8E]
} 1
test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2_utf16} {
test utf-2.8.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} {
    string length [testbytestring \xF0\x90\x80\x80]
} 4
test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 {
    string length \U010000
} 2
test utf-2.8.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs4} {
    string length [testbytestring \xF0\x90\x80\x80]
test utf-2.8.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 {
    string length \U010000
} 1
test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {testbytestring ucs2} {
test utf-2.9.0 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {ucs2 testbytestring} {
    string length [testbytestring \xF4\x8F\xBF\xBF]
} 4
test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} utf16 {
    string length \U10FFFF
} 2
test utf-2.9.1 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} {Uesc ucs4} {
test utf-2.9.2 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} ucs4 {
    string length \U10FFFF
} 1
test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
    string length [testbytestring \xF0\x8F\xBF\xBF]
} 4
test utf-2.11 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, overflow} testbytestring {
    # Would decode to U+110000 but that is outside the Unicode range.
162
163
164
165
166
167
168
169

170
171
172
173
174
175
176
170
171
172
173
174
175
176

177
178
179
180
181
182
183
184







-
+







    testnumutfchars [testbytestring \x00] end+1
} 2
test utf-4.11 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} {
    testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end-1
} 3
test utf-4.12.0 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs2} {
    testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end
} 2
} 4
test utf-4.12.1 {Tcl_NumUtfChars: #4-byte UTF-8 character} {testnumutfchars testbytestring ucs4} {
    testnumutfchars [testbytestring \xF0\x9F\x92\xA9] end
} 1
test utf-4.13 {Tcl_NumUtfChars: end of string} {testnumutfchars testbytestring} {
    testnumutfchars foobar[testbytestring \xF2\xC2\xA0] end
} 8
test utf-4.14 {Tcl_NumUtfChars: 3 bytes of 4-byte UTF-8 characater} {testnumutfchars testbytestring} {
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
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







-
+













-
-
+
+




-
+
+
+
+







test utf-6.2 {Tcl_UtfNext} testutfnext {
    testutfnext A
} 1
test utf-6.3 {Tcl_UtfNext} testutfnext {
    testutfnext AA
} 1
test utf-6.4 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext A[testbytestring \xA0]
    testutfnext [testbytestring A\xA0]
} 1
test utf-6.5 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext A[testbytestring \xD0]
} 1
test utf-6.6 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext A[testbytestring \xE8]
} 1
test utf-6.7 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext A[testbytestring \xF2]
} 1
test utf-6.8 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext A[testbytestring \xF8]
} 1
test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0\x00]
test utf-6.9 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0]
} 1
test utf-6.10 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0]G
} 1
test utf-6.11 {Tcl_UtfNext} {testutfnext testbytestring} {
test utf-6.11.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\x00]
} 1
test utf-6.11.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\x00]
} 2
test utf-6.12 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0\xD0]
} 1
test utf-6.13 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0\xE8]
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
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







-
-
+
+


















-
+


-
-
-
+
+
+



-
+


-
-
-
+
+
+







test utf-6.21 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xD0\xF2]
} 1
test utf-6.22 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xD0\xF8]
} 1
test utf-6.23 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE8]
} -1
    testutfnext [testbytestring \xE8\x00]
} 1
test utf-6.24 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE8]G
} 1
test utf-6.25 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE8\xA0\x00]
} 1
test utf-6.26 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE8\xD0]
} 1
test utf-6.27 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE8\xE8]
} 1
test utf-6.28 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE8\xF2]
} 1
test utf-6.29 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE8\xF8]
} 1
test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.30.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2]
} 1
test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2]
} -1
test utf-6.30.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\x00]
} 1
test utf-6.31 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2]G
} 1
test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.32.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0]
} 1
test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
    testutfnext [testbytestring \xF2\xA0]
} -1
test utf-6.32.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\x00]
} 1
test utf-6.33 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xD0]
} 1
test utf-6.34 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xE8]
} 1
test utf-6.35 {Tcl_UtfNext} {testutfnext testbytestring} {
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
450

451
452
453
454
455
456
457
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
450
451

452
453
454

455
456
457

458
459
460

461
462
463
464
465
466
467
468







-
+
















-
+


-
+














-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+







test utf-6.61 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xA0\xF8]
} 1
test utf-6.62 {Tcl_UtfNext} testutfnext {
    testutfnext \u8820G
} 3
test utf-6.63 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xA0]
    testutfnext [testbytestring \xE8\xA0\xA0\xA0]
} 3
test utf-6.64 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xD0]
} 3
test utf-6.65 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xE8]
} 3
test utf-6.66 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xF2]
} 3
test utf-6.67 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xF8]
} 3
test utf-6.68 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xA0\xA0]G
} 1
test utf-6.69.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.69.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]
} 1
test utf-6.69.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
test utf-6.69.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]
} 4
test utf-6.70 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xA0\xA0\xD0]
} 1
test utf-6.71 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xA0\xA0\xE8]
} 1
test utf-6.72 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xA0\xA0\xF2]
} 1
test utf-6.73 {Tcl_UtfNext} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF2\xA0\xA0\xF8]
} 1
test utf-6.74.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.74.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G
} 1
test utf-6.74.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
test utf-6.74.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G
} 4
test utf-6.75.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.75.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0]
} 1
test utf-6.75.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
test utf-6.75.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0]
} 4
test utf-6.76.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.76.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0]
} 1
test utf-6.76.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
test utf-6.76.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xD0]
} 4
test utf-6.77.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.77.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8]
} 1
test utf-6.77.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
test utf-6.77.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xE8]
} 4
test utf-6.78.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.78.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2]
} 1
test utf-6.78.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
test utf-6.78.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xF2]
} 4
test utf-6.79.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2_utf16} {
test utf-6.79.0 {Tcl_UtfNext} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8]
} 1
test utf-6.79.1 {Tcl_UtfNext} {testutfnext testbytestring ucs4} {
test utf-6.79.1 {Tcl_UtfNext} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0G\xF8]
} 4
test utf-6.80 {Tcl_UtfNext - overlong sequences} testutfnext {
    testutfnext \x00
} 2
test utf-6.81 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
    testutfnext [testbytestring \xC0\x81]
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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







-
+


-
+


-
+

+
+
+

-
+

+
+
+

-
+


-
+





-
+

+
+
+

-
+

+
+
+

-
+

+
+
+

-
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







} 1
test utf-6.85 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
    testutfnext [testbytestring \xE0\xA0\x80]
} 3
test utf-6.86 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF0\x80\x80\x80]
} 1
test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs2_utf16} {
test utf-6.87.0 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF0\x90\x80\x80]
} 1
test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring ucs4} {
test utf-6.87.1 {Tcl_UtfNext - overlong sequences} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF0\x90\x80\x80]
} 4
test utf-6.88 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring} {
test utf-6.88.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\x00]
} 1
test utf-6.88.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte valid sequence} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\x00]
} 2
test utf-6.89 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.89.0 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \x80\x80\x00]
} 1
test utf-6.89.1 {Tcl_UtfNext, pointing to 2th byte of 3-byte invalid sequence} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \x80\x80\x00]
} 2
test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2_utf16} {
test utf-6.90.0 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF4\x8F\xBF\xBF]
} 1
test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring ucs4} {
test utf-6.90.1 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF4\x8F\xBF\xBF]
} 4
test utf-6.91 {Tcl_UtfNext, validity check [493dccc2de]} {testutfnext testbytestring} {
    testutfnext [testbytestring \xF4\x90\x80\x80]
} 1
test utf-6.92 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring} {
test utf-6.92.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\xA0]
} 1
test utf-6.92.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte valid sequence} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\xA0]
} 3
test utf-6.93 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.93.0 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \x80\x80\x80]
} 1
test utf-6.93.1 {Tcl_UtfNext, pointing to 2th byte of 4-byte invalid sequence} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \x80\x80\x80]
} 3
test utf-6.94 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.94.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0]
} 1
test utf-6.94.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0]
} 3
test utf-6.95 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring} {
test utf-6.95.0 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \x80\x80\x80\x80]
} 1
test utf-6.95.1 {Tcl_UtfNext, pointing to 2th byte of 5-byte invalid sequence} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \x80\x80\x80\x80]
} 3
test utf-6.96 {Tcl_UtfNext, read limits} testutfnext {
    testutfnext G 0
} 0
test utf-6.97 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0] 0
} 0
test utf-6.98 {Tcl_UtfNext, read limits} testutfnext {
    testutfnext AG 1
} 1
test utf-6.99 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext A[testbytestring \xA0] 1
} 1
test utf-6.100 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext [testbytestring \xD0\xA0]G 1
} 0
test utf-6.101 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext [testbytestring \xD0\xA0]G 2
} 2
test utf-6.102 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext [testbytestring \xD0\xA0\xA0] 1
} 0
test utf-6.103 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext [testbytestring \xD0\xA0\xA0] 2
} 2
test utf-6.104 {Tcl_UtfNext, read limits} testutfnext {
    testutfnext \u8820G 1
} 0
test utf-6.105 {Tcl_UtfNext, read limits} testutfnext {
    testutfnext \u8820G 2
} 0
test utf-6.106 {Tcl_UtfNext, read limits} testutfnext {
    testutfnext \u8820G 3
} 3
test utf-6.107 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xA0] 1
} 0
test utf-6.108 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xA0] 2
} 0
test utf-6.109 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext \u8820[testbytestring \xA0] 3
} 3
test utf-6.110 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 1
} 1
test utf-6.111 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 2
} 1
test utf-6.112.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 3
} 1
test utf-6.112.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 3
} 0
test utf-6.113.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 4
} 1
test utf-6.113.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0]G 4
} 4
test utf-6.114 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 1
} 1
test utf-6.115 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 2
} 1
test utf-6.116.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 3
} 1
test utf-6.116.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 3
} 0
test utf-6.117.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 4
} 1
test utf-6.117.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xF2\xA0\xA0\xA0\xA0] 4
} 4
test utf-6.118 {Tcl_UtfNext, read limits} {testutfnext testbytestring} {
    testutfnext [testbytestring \xA0]G 0
} 0
test utf-6.119 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0]G 1
} 1
test utf-6.120 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0] 1
} 1
test utf-6.121 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0]G 2
} 1
test utf-6.122 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\xA0] 2
} 1
test utf-6.123.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\xA0]G 3
} 1
test utf-6.123.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\xA0]G 3
} 3
test utf-6.124.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0] 3
} 1
test utf-6.124.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0] 3
} 3
test utf-6.125.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0]G 4
} 1
test utf-6.125.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0]G 4
} 3
test utf-6.126.0 {Tcl_UtfNext, read limits} {testutfnext testbytestring ucs2} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0\xA0] 4
} 1
test utf-6.126.1 {Tcl_UtfNext, read limits} {testutfnext testbytestring fullutf} {
    testutfnext [testbytestring \xA0\xA0\xA0\xA0\xA0] 4
} 3

test utf-7.1 {Tcl_UtfPrev} testutfprev {
    testutfprev {}
} 0
test utf-7.2 {Tcl_UtfPrev} testutfprev {
    testutfprev A
} 0
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
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







-
+














-
+


-
+


-
+







test utf-7.5.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF2\xF8\xA0\xA0] 2
} 1
test utf-7.6 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE8]
} 1
test utf-7.6.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[testbytestring \xA0] 2
    testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 2
} 1
test utf-7.6.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE8\xF8\xA0\xA0] 2
} 1
test utf-7.7 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0]
} 1
test utf-7.7.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 2
} 1
test utf-7.7.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xF8\xA0\xA0] 2
} 1
test utf-7.8 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0]
    testutfprev [testbytestring A\xA0]
} 1
test utf-7.8.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 2
    testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 2
} 1
test utf-7.8.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xF8\xA0\xA0] 2
    testutfprev [testbytestring A\xA0\xF8\xA0\xA0] 2
} 1
test utf-7.9 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF8\xA0]
} 2
test utf-7.9.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 3
} 2
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

618
619
620
621
622
623
624
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







-
+

















-
+


-
+


-
+







test utf-7.10.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF2\xA0\xF8\xA0] 3
} 1
test utf-7.11 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE8\xA0]
} 1
test utf-7.11.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[testbytestring \xA0] 3
    testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 3
} 1
test utf-7.11.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE8\xA0\xF8\xA0] 3
} 1
test utf-7.11.3 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE8\xA0\xF8] 3
} 1
test utf-7.12 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0]
} 1
test utf-7.12.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 3
} 1
test utf-7.12.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0\xF8\xA0] 3
} 1
test utf-7.13 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0]
    testutfprev [testbytestring A\xA0\xA0]
} 2
test utf-7.13.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 3
    testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 3
} 2
test utf-7.13.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xA0\xA0\xF8\xA0] 3
    testutfprev [testbytestring A\xA0\xA0\xF8\xA0] 3
} 2
test utf-7.14 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF8\xA0\xA0]
} 3
test utf-7.14.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF8\xA0\xA0\xA0] 4
} 3
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
686
687




688
689
690
691
692
693
694
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







-
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+







test utf-7.15.5 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF2\xA0\xA0\xF8] 4
} 1
test utf-7.16 {Tcl_UtfPrev} testutfprev {
    testutfprev A\u8820
} 1
test utf-7.16.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[testbytestring \xA0] 4
    testutfprev A[testbytestring \xE8\xA0\xA0\xA0] 4
} 1
test utf-7.16.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A\u8820[testbytestring \xF8] 4
} 1
test utf-7.17 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0\xA0]
} 3
test utf-7.17.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0\xA0\xA0] 4
} 3
test utf-7.17.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0\xA0\xF8] 4
} 3
test utf-7.18.0 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0]
} 1
test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0] 4
} 1
test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xF8] 4
} 1
test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xF8\xA0\xA0\xA0]
} 2
test utf-7.20 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xF2\xA0\xA0\xA0]
} 2
test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A\u8820[testbytestring \xA0]
} 2
test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
test utf-7.18.0 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev [testbytestring A\xA0\xA0\xA0]
} 3
test utf-7.18.1 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev [testbytestring A\xA0\xA0\xA0\xA0] 4
} 3
test utf-7.18.2 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev [testbytestring A\xA0\xA0\xA0\xF8] 4
} 3
test utf-7.19 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev [testbytestring A\xF8\xA0\xA0\xA0]
} 4
test utf-7.20.0 {Tcl_UtfPrev} {testutfprev testbytestring ucs2} {
    testutfprev [testbytestring A\xF2\xA0\xA0\xA0]
} 4
test utf-7.20.1 {Tcl_UtfPrev} {testutfprev testbytestring fullutf} {
    testutfprev [testbytestring A\xF2\xA0\xA0\xA0]
} 1
test utf-7.21 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE8\xA0\xA0\xA0]
} 4
test utf-7.22 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xD0\xA0\xA0\xA0]
} 2
test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring utf16} {
    testutfprev A[testbytestring \xA0\xA0\xA0\xA0]
} 2
} 4
test utf-7.23 {Tcl_UtfPrev} {testutfprev testbytestring} {
    testutfprev [testbytestring A\xA0\xA0\xA0\xA0]
} 4
test utf-7.24 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xC0\x81]
} 2
test utf-7.25 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xC0\x81] 2
} 1
test utf-7.26 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
702
703
704
705
706
707
708
709

710
711

712
713
714
715
716
717
718
851
852
853
854
855
856
857

858
859

860
861
862
863
864
865
866
867







-
+

-
+







} 2
test utf-7.28 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE0]
} 1
test utf-7.28.1 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE0\x80\x80] 2
} 1
test utf-7.29 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring utf16} {
test utf-7.29 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF0\x80\x80\x80]
} 2
} 4
test utf-7.30 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF0\x80\x80\x80] 4
} 3
test utf-7.31 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF0\x80\x80\x80] 3
} 2
test utf-7.32 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
732
733
734
735
736
737
738
739

740
741




742
743
744
745
746
747
748
881
882
883
884
885
886
887

888
889

890
891
892
893
894
895
896
897
898
899
900







-
+

-
+
+
+
+







} 1
test utf-7.37 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE0\xA0\x80] 3
} 1
test utf-7.38 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring} {
    testutfprev A[testbytestring \xE0\xA0\x80] 2
} 1
test utf-7.39 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring utf16} {
test utf-7.39.0 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF0\x90\x80\x80]
} 2
} 4
test utf-7.39.1 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF0\x90\x80\x80]
} 1
test utf-7.40.0 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF0\x90\x80\x80] 4
} 3
test utf-7.40.1 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF0\x90\x80\x80] 4
} 1
test utf-7.41.0 {Tcl_UtfPrev -- overlong sequence}  {testutfprev testbytestring ucs2} {
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
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







-
+

-
+









-
+

-
-
+
+
+
+
+


-
+


-
+


-
+


-
+


-
+

-
+







} 0
test utf-7.44 {Tcl_UtfPrev -- no lead byte at start}  {testutfprev testbytestring} {
    testutfprev [testbytestring \xA0\xA0]
} 1
test utf-7.45 {Tcl_UtfPrev -- no lead byte at start}  {testutfprev testbytestring} {
    testutfprev [testbytestring \xA0\xA0\xA0]
} 2
test utf-7.46 {Tcl_UtfPrev -- no lead byte at start}  {testutfprev testbytestring utf16} {
test utf-7.46 {Tcl_UtfPrev -- no lead byte at start}  {testutfprev testbytestring} {
    testutfprev [testbytestring \xA0\xA0\xA0\xA0]
} 1
} 3
test utf-7.47 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} {testutfprev testbytestring} {
    testutfprev [testbytestring \xE8\xA0]
} 0
test utf-7.47.1 {Tcl_UtfPrev, pointing to 3th byte of 3-byte valid sequence} testutfprev {
    testutfprev \u8820 2
} 0
test utf-7.47.2 {Tcl_UtfPrev, pointing to 3th byte of 3-byte invalid sequence} {testutfprev testbytestring} {
    testutfprev [testbytestring \xE8\xA0\x00] 2
} 0
test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} {
test utf-7.48.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
} 2
test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
} 4
test utf-7.48.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF]
} 1
test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
} 3
test utf-7.48.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 4
} 1
test utf-7.48.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring ucs2} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
} 2
test utf-7.48.4 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring fullutf} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 3
} 1
test utf-7.48.5 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
test utf-7.48.6 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF4\x8F\xBF\xBF] 2
} 1
test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring utf16} {
test utf-7.49.0 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF4\x90\x80\x80]
} 2
} 4
test utf-7.49.1 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF4\x90\x80\x80] 4
} 3
test utf-7.49.2 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
    testutfprev A[testbytestring \xF4\x90\x80\x80] 3
} 2
test utf-7.49.3 {Tcl_UtfPrev, validity check [493dccc2de]} {testutfprev testbytestring} {
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
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

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







-
+


-
+





-
+


-
+





-
+


-
+




-
+


-
+





-
+


-
+





-
+


-
+













-
+


-
+


-
+





-
+





-
+


-
+


-
+

-
-
+
+

-
-
+
+


-
+

-
-
+
+

-
-
+
+


-
+

-
-
+
+

-
-
+
+


















-
+


-
+







test utf-8.6 {Tcl_UniCharAtIndex: low surrogate} {
    string index \uDC42 0
} \uDC42
test utf-8.7.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
    string index \uD83D\uDE00G 0
} \uD83D
test utf-8.7.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index \uD83D\uDE00G 0
    string index \U1F600G 0
} \U1F600
test utf-8.7.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 0
    string index \U1F600G 0
} \U1F600
test utf-8.8.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
    string index \uD83D\uDE00G 1
} \uDE00
test utf-8.8.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index \uD83D\uDE00G 1
    string index \U1F600G 1
} G
test utf-8.8.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 1
    string index \U1F600G 1
} {}
test utf-8.9.0 {Tcl_UniCharAtIndex: Emoji} ucs2 {
    string index \uD83D\uDE00G 2
} G
test utf-8.9.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index \uD83D\uDE00G 2
    string index \U1F600G 2
} {}
test utf-8.9.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \uD83D\uDE00G 2
    string index \U1F600G 2
} G
test utf-8.10.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 0
} \uFFFD
test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
test utf-8.10.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index \U1F600G 0
} \U1F600
test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
test utf-8.10.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \U1F600G 0
} \U1F600
test utf-8.11.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 1
} G
test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
test utf-8.11.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index \U1F600G 1
} G
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
test utf-8.11.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \U1F600G 1
} {}
test utf-8.12.0 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs2} {
    string index \U1F600G 2
} {}
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} {Uesc ucs4} {
test utf-8.12.1 {Tcl_UniCharAtIndex: Emoji} ucs4 {
    string index \U1F600G 2
} {}
test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} {Uesc utf16} {
test utf-8.12.2 {Tcl_UniCharAtIndex: Emoji} utf16 {
    string index \U1F600G 2
} G

test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
    string range abcd 0 2
} abc
test utf-9.2 {Tcl_UtfAtIndex: index > 0} {
    string range \u4E4E\u25A\xFF\u543klmnop 1 5
} \u25A\xFF\u543kl
test utf-9.3.0 {Tcl_UtfAtIndex: index = 0, Emoji} ucs2 {
    string range \uD83D\uDE00G 0 0
} \uD83D
test utf-9.3.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
    string range \uD83D\uDE00G 0 0
    string range \U1F600G 0 0
} \U1F600
test utf-9.3.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
    string range \uD83D\uDE00G 0 0
    string range \U1F600G 0 0
} \U1F600
test utf-9.4.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
    string range \U1F600G 1 1
    string range \uD83D\uDE00G 1 1
} \uDE00
test utf-9.4.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
    string range \U1F600G 1 1
} G
test utf-9.4.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \uD83D\uDE00G 1 1
    string range \U1F600G 1 1
} {}
test utf-9.5.0 {Tcl_UtfAtIndex: index > 0, Emoji} ucs2 {
    string range \uD83D\uDE00G 2 2
} G
test utf-9.5.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
    string range \uD83D\uDE00G 2 2
    string range \U1F600G 2 2
} {}
test utf-9.5.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \uD83D\uDE00G 2 2
    string range \U1F600G 2 2
} G
test utf-9.6.0 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs2} {
    string range \U1f600G 0 0
    string range \U1F600G 0 0
} \uFFFD
test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc ucs4} {
    string range \U1f600G 0 0
test utf-9.6.1 {Tcl_UtfAtIndex: index = 0, Emoji} ucs4 {
    string range \U1F600G 0 0
} \U1F600
test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} {Uesc utf16} {
    string range \U1f600G 0 0
test utf-9.6.2 {Tcl_UtfAtIndex: index = 0, Emoji} utf16 {
    string range \U1F600G 0 0
} \U1F600
test utf-9.7.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
    string range \U1f600G 1 1
    string range \U1F600G 1 1
} G
test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
    string range \U1f600G 1 1
test utf-9.7.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
    string range \U1F600G 1 1
} G
test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
    string range \U1f600G 1 1
test utf-9.7.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \U1F600G 1 1
} {}
test utf-9.8.0 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs2} {
    string range \U1f600G 2 2
    string range \U1F600G 2 2
} {}
test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc ucs4} {
    string range \U1f600G 2 2
test utf-9.8.1 {Tcl_UtfAtIndex: index > 0, Emoji} ucs4 {
    string range \U1F600G 2 2
} {}
test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} {Uesc utf16} {
    string range \U1f600G 2 2
test utf-9.8.2 {Tcl_UtfAtIndex: index > 0, Emoji} utf16 {
    string range \U1F600G 2 2
} G

test utf-10.1 {Tcl_UtfBackslash: dst == NULL} {
    set x \n
} {
}
test utf-10.2 {Tcl_UtfBackslash: \u subst} testbytestring {
    expr {"\uA2" eq [testbytestring \xC2\xA2]}
} 1
test utf-10.3 {Tcl_UtfBackslash: longer \u subst} testbytestring {
    expr {"\u4E21" eq [testbytestring \xE4\xB8\xA1]}
} 1
test utf-10.4 {Tcl_UtfBackslash: stops at first non-hex} testbytestring {
    expr {"\u4E2k" eq "[testbytestring \xD3\xA2]k"}
} 1
test utf-10.5 {Tcl_UtfBackslash: stops after 4 hex chars} testbytestring {
    expr {"\u4E216" eq "[testbytestring \xE4\xB8\xA1]6"}
} 1
test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {Uesc fullutf testbytestring} {
test utf-10.6 {Tcl_UtfBackslash: stops after 5 hex chars} {fullutf testbytestring} {
    expr {"\U1E2165" eq "[testbytestring \xF0\x9E\x88\x96]5"}
} 1
test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {Uesc fullutf testbytestring} {
test utf-10.7 {Tcl_UtfBackslash: stops after 6 hex chars} {fullutf testbytestring} {
    expr {"\U10E2165" eq "[testbytestring \xF4\x8E\x88\x96]5"}
} 1

proc bsCheck {char num {constraints {}}} {
    global errNum
    test utf-10.$errNum {backslash substitution} $constraints {
	scan $char %c value
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
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







-
-
-
-
-
-
-
+
+
+
+
+
+
+
















-
+







bsCheck \Ua     10			Uesc
bsCheck \UA     10			Uesc
bsCheck \UA1    161			Uesc
bsCheck \U4E21  20001			Uesc
bsCheck \U004E21        20001		Uesc
bsCheck \U00004E21      20001		Uesc
bsCheck \U0000004E21    78		Uesc
bsCheck \U00110000      69632		{Uesc fullutf}
bsCheck \U01100000      69632		{Uesc fullutf}
bsCheck \U11000000      69632		{Uesc fullutf}
bsCheck \U0010FFFF      1114111		{Uesc fullutf}
bsCheck \U010FFFF0      1114111		{Uesc fullutf}
bsCheck \U10FFFF00      1114111		{Uesc fullutf}
bsCheck \UFFFFFFFF      1048575		{Uesc fullutf}
bsCheck \U00110000      69632		fullutf
bsCheck \U01100000      69632		fullutf
bsCheck \U11000000      69632		fullutf
bsCheck \U0010FFFF      1114111		fullutf
bsCheck \U010FFFF0      1114111		fullutf
bsCheck \U10FFFF00      1114111		fullutf
bsCheck \UFFFFFFFF      1048575		fullutf

test utf-11.1 {Tcl_UtfToUpper} {
    string toupper {}
} {}
test utf-11.2 {Tcl_UtfToUpper} {
    string toupper abc
} ABC
test utf-11.3 {Tcl_UtfToUpper} {
    string toupper \xE3gh
} \xC3GH
test utf-11.4 {Tcl_UtfToUpper} {
    string toupper \u01E3gh
} \u01E2GH
test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
    string toupper \u10D0\u1C90
} \u1C90\u1C90
test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} {Uesc fullutf} {
test utf-11.6 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
    string toupper \U10428
} \U10400
test utf-11.7 {Tcl_UtfToUpper beyond U+FFFF} fullutf {
    string toupper \uD801\uDC28
} \uD801\uDC00
test utf-11.8 {Tcl_UtfToUpper low/high surrogate)} {
    string toupper \uDC24\uD824
1075
1076
1077
1078
1079
1080
1081
1082

1083
1084
1085
1086
1087
1088
1089
1230
1231
1232
1233
1234
1235
1236

1237
1238
1239
1240
1241
1242
1243
1244







-
+







} \u01E3gh
test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
    string tolower \u10D0\u1C90
} \u10D0\u10D0
test utf-12.6 {Tcl_UtfToLower low/high surrogate)} {
    string tolower \uDC24\uD824
} \uDC24\uD824
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} {Uesc fullutf} {
test utf-12.7 {Tcl_UtfToLower beyond U+FFFF} fullutf {
    string tolower \U10400
} \U10428
test utf-12.8 {Tcl_UtfToLower beyond U+FFFF} fullutf {
    string tolower \uD801\uDC00
} \uD801\uDC28

test utf-13.1 {Tcl_UtfToTitle} {
1103
1104
1105
1106
1107
1108
1109
1110

1111
1112
1113
1114
1115
1116
1117
1258
1259
1260
1261
1262
1263
1264

1265
1266
1267
1268
1269
1270
1271
1272







-
+







} \u10D0\u1C90
test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
    string totitle \u1C90\u10D0
} \u1C90\u10D0
test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
    string totitle \uDC24\uD824
} \uDC24\uD824
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} {Uesc fullutf} {
test utf-13.8 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
    string totitle \U10428\U10400
} \U10400\U10428
test utf-13.9 {Tcl_UtfToTitle beyond U+FFFF} fullutf {
    string totitle \uD801\uDC28\uD801\uDC00
} \uD801\uDC00\uD801\uDC28

test utf-14.1 {Tcl_UtfNcasecmp} {
1169
1170
1171
1172
1173
1174
1175
1176

1177
1178
1179
1180
1181
1182
1183
1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334
1335
1336
1337
1338







-
+







} -cleanup {
    unset -nocomplain foo
} -result {1 4}

test utf-20.1 {TclUniCharNcmp} ucs4 {
    string compare [string range [format %c 0xFFFF] 0 0] [string range [format %c 0x10000] 0 0]
} -1
test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} knownBug {
test utf-20.2 {[4c591fa487] TclUniCharNcmp/TclUtfNcmp} {
    set one [format %c 0xFFFF]
    set two [format %c 0x10000]
    set first [string compare $one $two]
    string range $one 0 0
    string range $two 0 0
    set second [string compare $one $two]
    expr {($first == $second) ? "agree" : "disagree"}
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
1434
1435
1436
1437
1438
1439
1440


1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458

1459
1460

1461
1462
1463
1464
1465
1466
1467
1468
1469

1470
1471
1472
1473
1474
1475
1476
1477







-
-
+
+
















-
+

-
+








-
+







    test utf-25.$count {Tcl_UniCharNcasecmp} -setup {
	testobj freeallvars
    } -constraints [linsert $constraints 0 teststringobj] -cleanup {
	testobj freeallvars
    } -body {
	teststringobj set 1 $one
	teststringobj set 2 $two
	teststringobj maxchars 1
	teststringobj maxchars 2
	teststringobj getunicode 1
	teststringobj getunicode 2
	set result [string compare -nocase [teststringobj get 1] [teststringobj get 2]]
	if {$result eq [string map {< -1 = 0 > 1} $order]} {
	    set result ok
	} else {
	    set result "'$one' should be $order '$two' (no case)"
	}
	set result
    } -result ok
    incr count
}
variable count 1
UniCharCaseCmpTest < a b
UniCharCaseCmpTest > b a
UniCharCaseCmpTest > B a
UniCharCaseCmpTest > aBcB abca
UniCharCaseCmpTest < \uFFFF [format %c 0x10000] ucs4
UniCharCaseCmpTest < \uFFFF \U10000		{Uesc ucs4}
UniCharCaseCmpTest < \uFFFF \U10000		ucs4
UniCharCaseCmpTest > [format %c 0x10000] \uFFFF	ucs4
UniCharCaseCmpTest > \U10000 \uFFFF		{Uesc ucs4}
UniCharCaseCmpTest > \U10000 \uFFFF		ucs4


test utf-26.1 {Tcl_UniCharDString} -setup {
    testobj freeallvars
} -constraints {teststringobj testbytestring} -cleanup {
    testobj freeallvars
} -body {
    teststringobj set 1 foo
    teststringobj maxchars 1
    teststringobj getunicode 1
    teststringobj append 1 [testbytestring barsoom\xF2\xC2\x80] 10
    scan [string index [teststringobj get 1] 11] %c
} -result 128


unset count
rename UniCharCaseCmpTest {}

Changes to tests/util.test.

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
1
2
3
4
5
6
7
8
9


10
11
12
13
14





15
16
17

18
19
20
21
22
23
24









-
-
+
+



-
-
-
-
-



-







# This file is a Tcl script to test the code in the file tclUtil.c.
# This file is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1998 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint controversialNaN 1
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
testConstraint testdoubledigits [llength [info commands testdoubledigits]]
testConstraint testprint [llength [info commands testprint]]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
208
209
210
211
212
213
214



215
216
217
218
219
220
221
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218







+
+
+







    concat \xe0
} \xe0
test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj {
    # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the
    # symptoms was Bug #2055782.
    testconcatobj
} {}
test util-4.8 {Tcl_ConcatObj - [Bug 26649439c7]} {
    concat [list foo] [list #]
} {foo {#}}

proc Wrapper_Tcl_StringMatch {pattern string} {
    # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
    switch -glob -- $string $pattern {return 1} default {return 0}
}
test util-5.1 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch ab*c abc
272
273
274
275
276
277
278
279

280
281
282

283
284
285
286
287
288
289
269
270
271
272
273
274
275

276
277
278

279
280
281
282
283
284
285
286







-
+


-
+







    Wrapper_Tcl_StringMatch {a[abc]c} abc
} 1
test util-5.17 {Tcl_StringMatch: UTF-8} {
    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
    # get 1 UTF-8 character
    Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"
} 1
test util-5.18 {Tcl_StringMatch: UTF-8} testbytestring {
test util-5.18 {Tcl_StringMatch: UTF-8} {
    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
    # proper advance: wrong answer would match on UTF trail byte of \u4e4f
    Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [testbytestring a\x8Fc]
    Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc]
} 0
test util-5.19 {Tcl_StringMatch: UTF-8} {
    # pattern += Tcl_UtfToUniChar(pattern, &endChar);
    # proper advance.
    Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"
} 1
test util-5.20 {Tcl_StringMatch} {
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
450
451
452
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
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
524
525







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+













-
+









-
+






-
+







-
+





-
+







    Wrapper_Tcl_StringMatch "" ""
} 1
test util-5.52 {Tcl_StringMatch} {
    Wrapper_Tcl_StringMatch \[a\u0000 a\x80
} 0


test util-6.1 {Tcl_PrintDouble - using tcl_precision} -setup {
    set old_precision $::tcl_precision
    set ::tcl_precision 12
} -body {
    concat x[expr 1.4]
} -cleanup {
    set ::tcl_precision $old_precision
} -result {x1.4}
test util-6.2 {Tcl_PrintDouble - using tcl_precision} -setup {
    set old_precision $::tcl_precision
    set ::tcl_precision 12
} -body {
    concat x[expr 1.39999999999]
} -cleanup {
    set ::tcl_precision $old_precision
} -result {x1.39999999999}
test util-6.3 {Tcl_PrintDouble - using tcl_precision} -setup {
    set old_precision $::tcl_precision
    set ::tcl_precision 12
} -body {
    concat x[expr 1.399999999999]
} -cleanup {
    set ::tcl_precision $old_precision
} -result {x1.4}
test util-6.4 {Tcl_PrintDouble - using tcl_precision} -setup {
    set old_precision $::tcl_precision
    set ::tcl_precision 5
} -body {
    concat x[expr 1.123412341234]
} -cleanup {
    set tcl_precision $old_precision
} -result {x1.1234}
test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
    concat x[expr 2.0]
} {x2.0}
test util-6.6 {Tcl_PrintDouble - make sure there's a decimal point} {
    concat x[expr 3.0e98]
} {x3e+98}

test util-7.1 {TclPrecTraceProc - unset callbacks} -setup {
    set old_precision $::tcl_precision
} -body {
    set tcl_precision 7
    set x $tcl_precision
    unset tcl_precision
    list $x $tcl_precision
} -cleanup {
    set ::tcl_precision $old_precision
} -result {7 7}
test util-7.2 {TclPrecTraceProc - read traces, sharing among interpreters}  -setup {
    set old_precision $::tcl_precision
} -body {
    set tcl_precision 12
    interp create child
    set x [child eval set tcl_precision]
    child eval {set tcl_precision 6}
    interp delete child
    list $x $tcl_precision
} -cleanup {
    set ::tcl_precision $old_precision
} -result {12 6}
test util-7.3 {TclPrecTraceProc - write traces, safe interpreters} -setup {
    set old_precision $::tcl_precision
} -body {
    set tcl_precision 12
    interp create -safe child
    set x [child eval {
	list [catch {set tcl_precision 8} msg] $msg
    }]
    interp delete child
    list $x $tcl_precision
} -cleanup {
    set ::tcl_precision $old_precision
} -result {{1 {can't set "tcl_precision": can't modify precision from a safe interpreter}} 12}
test util-7.4 {TclPrecTraceProc - write traces, bogus values} -setup {
    set old_precision $::tcl_precision
} -body {
    set tcl_precision 12
    list [catch {set tcl_precision abc} msg] $msg $tcl_precision
} -cleanup {
    set ::tcl_precision $old_precision
} -result {1 {can't set "tcl_precision": improper value for precision} 12}

# This test always succeeded in the C locale anyway...
test util-8.1 {TclNeedSpace - correct utf-8 handling} {
test util-8.1 {TclNeedSpace - correct UTF8 handling} {
    # Bug 411825
    # Note that this test relies on the fact that
    # [interp target] calls on Tcl_AppendElement()
    # which calls on TclNeedSpace().  If [interp target]
    # is ever updated, this test will no longer test
    # TclNeedSpace.
    interp create \u5420
    interp create [list \u5420 foo]
    interp alias {} fooset [list \u5420 foo] set
    set result [interp target {} fooset]
    interp delete \u5420
    set result
} "\u5420 foo"
test util-8.2 {TclNeedSpace - correct utf-8 handling} testdstring {
test util-8.2 {TclNeedSpace - correct UTF8 handling} testdstring {
    # Bug 411825
    # This tests the same bug as the previous test, but
    # should be more future-proof, as the DString
    # operations will likely continue to call TclNeedSpace
    testdstring free
    testdstring append \u5420 -1
    testdstring element foo
    llength [testdstring get]
} 2
test util-8.3 {TclNeedSpace - correct utf-8 handling} testdstring {
test util-8.3 {TclNeedSpace - correct UTF8 handling} testdstring {
    # Bug 411825 - new variant reported by Dossy Shiobara
    testdstring free
    testdstring append \u00A0 -1
    testdstring element foo
    llength [testdstring get]
} 2
test util-8.4 {TclNeedSpace - correct utf-8 handling} testdstring {
test util-8.4 {TclNeedSpace - correct UTF8 handling} testdstring {
    # Another bug uncovered while fixing 411825
    testdstring free
    testdstring append {\ } -1
    testdstring append \{ -1
    testdstring element foo
    llength [testdstring get]
} 2
test util-8.5 {TclNeedSpace - correct utf-8 handling} testdstring {
test util-8.5 {TclNeedSpace - correct UTF8 handling} testdstring {
    testdstring free
    testdstring append {\\ } -1
    testdstring element foo
    list [llength [testdstring get]] [string length [testdstring get]]
} {2 6}
test util-8.6 {TclNeedSpace - correct utf-8 handling} testdstring {
test util-8.6 {TclNeedSpace - correct UTF8 handling} testdstring {
    testdstring free
    testdstring append {\\ } -1
    testdstring append \{ -1
    testdstring element foo
    testdstring append \} -1
    list [llength [testdstring get]] [string length [testdstring get]]
} {2 8}
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

595
596
597

598
599
600

601
602
603

604
605
606

607
608
609

610
611
612

613
614
615

616
617
618

619
620
621

622
623
624

625
626
627

628
629
630

631
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


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
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
618
619


620
621
622
623


624
625
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
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
756
757
758
759
760







-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
-
-
-
-
-
-
+


-
+


-
+


-
+


-
-
-
-
-
-
-
+


-
+


-
+


-
+


-
-
+
+


-
-
+
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+
-
-
-
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
-
-
-







    testdstring start
    testdstring end

    # Should make {\\\\\\\\ {}}
    list [llength [testdstring get]] [string index [testdstring get] 9]
} {2 \{}

test util-9.0.0 {Tcl_GetIntForIndex} {
test util-9.0.0 {TclGetIntForIndex} {
    string index abcd 0
} a
test util-9.0.1 {Tcl_GetIntForIndex} {
test util-9.0.1 {TclGetIntForIndex} {
    string index abcd 0x0
} a
test util-9.0.2 {Tcl_GetIntForIndex} {
test util-9.0.2 {TclGetIntForIndex} {
    string index abcd -0x0
} a
test util-9.0.3 {Tcl_GetIntForIndex} {
test util-9.0.3 {TclGetIntForIndex} {
    string index abcd { 0 }
} a
test util-9.0.4 {Tcl_GetIntForIndex} {
test util-9.0.4 {TclGetIntForIndex} {
    string index abcd { 0x0 }
} a
test util-9.0.5 {Tcl_GetIntForIndex} {
test util-9.0.5 {TclGetIntForIndex} {
    string index abcd { -0x0 }
} a
test util-9.0.6 {Tcl_GetIntForIndex} {
test util-9.0.6 {TclGetIntForIndex} {
    string index abcd 01
} b
test util-9.0.7 {Tcl_GetIntForIndex} {
test util-9.0.7 {TclGetIntForIndex} {
    string index abcd { 01 }
} b
test util-9.0.8 {Tcl_GetIntForIndex} {
    string index abcd { 0d0 }
} a
test util-9.0.9 {Tcl_GetIntForIndex} {
    string index abcd { -0d0 }
} a
test util-9.1.0 {Tcl_GetIntForIndex} {
test util-9.1.0 {TclGetIntForIndex} {
    string index abcd 3
} d
test util-9.1.1 {Tcl_GetIntForIndex} {
test util-9.1.1 {TclGetIntForIndex} {
    string index abcd { 3 }
} d
test util-9.1.2 {Tcl_GetIntForIndex} {
test util-9.1.2 {TclGetIntForIndex} {
    string index abcdefghijk 0xa
} k
test util-9.1.3 {Tcl_GetIntForIndex} {
test util-9.1.3 {TclGetIntForIndex} {
    string index abcdefghijk { 0xa }
} k
test util-9.1.4 {Tcl_GetIntForIndex} {
    string index abcdefghijk 0d10
} k
test util-9.1.5 {Tcl_GetIntForIndex} {
    string index abcdefghijk { 0d10 }
} k
test util-9.2.0 {Tcl_GetIntForIndex} {
test util-9.2.0 {TclGetIntForIndex} {
    string index abcd end
} d
test util-9.2.1 {Tcl_GetIntForIndex} -body {
test util-9.2.1 {TclGetIntForIndex} -body {
    string index abcd { end}
} -returnCodes error -match glob -result *
test util-9.2.2 {Tcl_GetIntForIndex} -body {
test util-9.2.2 {TclGetIntForIndex} -body {
    string index abcd {end }
} -returnCodes error -match glob -result *
test util-9.3 {Tcl_GetIntForIndex} -body {
test util-9.3 {TclGetIntForIndex} {
    # Deprecated
    string index abcd en
} -returnCodes error -match glob -result *
test util-9.4 {Tcl_GetIntForIndex} -body {
} d
test util-9.4 {TclGetIntForIndex} {
    # Deprecated
    string index abcd e
} -returnCodes error -match glob -result *
test util-9.5.0 {Tcl_GetIntForIndex} {
} d
test util-9.5.0 {TclGetIntForIndex} {
    string index abcd end-1
} c
test util-9.5.1 {Tcl_GetIntForIndex} {
test util-9.5.1 {TclGetIntForIndex} {
    string index abcd {end-1 }
} c
test util-9.5.2 {Tcl_GetIntForIndex} -body {
test util-9.5.2 {TclGetIntForIndex} -body {
    string index abcd { end-1}
} -returnCodes error -match glob -result *
test util-9.6 {Tcl_GetIntForIndex} {
test util-9.6 {TclGetIntForIndex} {
    string index abcd end+-1
} c
test util-9.7 {Tcl_GetIntForIndex} {
test util-9.7 {TclGetIntForIndex} {
    string index abcd end+1
} {}
test util-9.8 {Tcl_GetIntForIndex} {
test util-9.8 {TclGetIntForIndex} {
    string index abcd end--1
} {}
test util-9.9.0 {Tcl_GetIntForIndex} {
test util-9.9.0 {TclGetIntForIndex} {
    string index abcd 0+0
} a
test util-9.9.1 {Tcl_GetIntForIndex} {
test util-9.9.1 {TclGetIntForIndex} {
    string index abcd { 0+0 }
} a
test util-9.10 {Tcl_GetIntForIndex} {
test util-9.10 {TclGetIntForIndex} {
    string index abcd 0-0
} a
test util-9.11 {Tcl_GetIntForIndex} {
test util-9.11 {TclGetIntForIndex} {
    string index abcd 1+0
} b
test util-9.12 {Tcl_GetIntForIndex} {
test util-9.12 {TclGetIntForIndex} {
    string index abcd 1-0
} b
test util-9.13 {Tcl_GetIntForIndex} {
test util-9.13 {TclGetIntForIndex} {
    string index abcd 1+1
} c
test util-9.14 {Tcl_GetIntForIndex} {
test util-9.14 {TclGetIntForIndex} {
    string index abcd 1-1
} a
test util-9.15 {Tcl_GetIntForIndex} {
test util-9.15 {TclGetIntForIndex} {
    string index abcd -1+2
} b
test util-9.16 {Tcl_GetIntForIndex} {
test util-9.16 {TclGetIntForIndex} {
    string index abcd -1--2
} b
test util-9.17 {Tcl_GetIntForIndex} {
test util-9.17 {TclGetIntForIndex} {
    string index abcd { -1+2 }
} b
test util-9.18 {Tcl_GetIntForIndex} {
test util-9.18 {TclGetIntForIndex} {
    string index abcd { -1--2 }
} b
test util-9.19 {Tcl_GetIntForIndex} -body {
test util-9.19 {TclGetIntForIndex} -body {
    string index a {}
} -returnCodes error -match glob -result *
test util-9.20 {Tcl_GetIntForIndex} -body {
test util-9.20 {TclGetIntForIndex} -body {
    string index a { }
} -returnCodes error -match glob -result *
test util-9.21 {Tcl_GetIntForIndex} -body {
test util-9.21 {TclGetIntForIndex} -body {
    string index a " \r\t\n"
} -returnCodes error -match glob -result *
test util-9.22 {Tcl_GetIntForIndex} -body {
test util-9.22 {TclGetIntForIndex} -body {
    string index a +
} -returnCodes error -match glob -result *
test util-9.23 {Tcl_GetIntForIndex} -body {
test util-9.23 {TclGetIntForIndex} -body {
    string index a -
} -returnCodes error -match glob -result *
test util-9.24 {Tcl_GetIntForIndex} -body {
test util-9.24 {TclGetIntForIndex} -body {
    string index a x
} -returnCodes error -match glob -result *
test util-9.25 {Tcl_GetIntForIndex} -body {
test util-9.25 {TclGetIntForIndex} -body {
    string index a +x
} -returnCodes error -match glob -result *
test util-9.26 {Tcl_GetIntForIndex} -body {
test util-9.26 {TclGetIntForIndex} -body {
    string index a -x
} -returnCodes error -match glob -result *
test util-9.27 {Tcl_GetIntForIndex} -body {
    string index a 0y
} -returnCodes error -match glob -result *
test util-9.28 {Tcl_GetIntForIndex} -body {
    string index a 1*
} -returnCodes error -match glob -result *
test util-9.29 {Tcl_GetIntForIndex} -body {
    string index a 0+
} -returnCodes error -match glob -result *
test util-9.30 {Tcl_GetIntForIndex} -body {
    string index a {0+ }
} -returnCodes error -match glob -result *
test util-9.31 {Tcl_GetIntForIndex} -body {
    string index a 0x
} -returnCodes error -match glob -result *
test util-9.31.1 {Tcl_GetIntForIndex} -body {
    string index a 0d
test util-9.27 {TclGetIntForIndex} -body {
    string index a 0y
} -returnCodes error -match glob -result *
test util-9.32 {Tcl_GetIntForIndex} -body {
test util-9.28 {TclGetIntForIndex} -body {
    string index a 0x1FFFFFFFF+0
} -result {}
test util-9.33 {Tcl_GetIntForIndex} -body {
    string index a 100000000000+0
} -result {}
test util-9.33.1 {Tcl_GetIntForIndex} -body {
    string index a 0d100000000000+0
} -result {}
test util-9.34 {Tcl_GetIntForIndex} -body {
    string index a 1.0
    string index a 1*
} -returnCodes error -match glob -result *
test util-9.35 {Tcl_GetIntForIndex} -body {
    string index a 1e23
test util-9.29 {TclGetIntForIndex} -body {
    string index a 0+
} -returnCodes error -match glob -result *
test util-9.36 {Tcl_GetIntForIndex} -body {
    string index a 1.5e2
test util-9.30 {TclGetIntForIndex} -body {
    string index a {0+ }
} -returnCodes error -match glob -result *
test util-9.37 {Tcl_GetIntForIndex} -body {
    string index a 0+x
test util-9.31 {TclGetIntForIndex} -body {
    string index a 0x
} -returnCodes error -match glob -result *
test util-9.38 {Tcl_GetIntForIndex} -body {
test util-9.32 {TclGetIntForIndex} -body {
    string index a 0+0x
} -returnCodes error -match glob -result *
test util-9.39 {Tcl_GetIntForIndex} -body {
    string index a 0+0xg
    string index a 0x1FFFFFFFF+0
} -returnCodes error -match glob -result *
test util-9.40 {Tcl_GetIntForIndex} -body {
    string index a 0+0xg
test util-9.33 {TclGetIntForIndex} -body {
    string index a 100000000000+0
} -returnCodes error -match glob -result *
test util-9.41 {Tcl_GetIntForIndex} -body {
    string index a 0+1.0
test util-9.34 {TclGetIntForIndex} -body {
    string index a 1.0
} -returnCodes error -match glob -result *
test util-9.42 {Tcl_GetIntForIndex} -body {
    string index a 0+1e2
test util-9.35 {TclGetIntForIndex} -body {
    string index a 1e23
} -returnCodes error -match glob -result *
test util-9.43 {Tcl_GetIntForIndex} -body {
    string index a 0+1.5e1
test util-9.36 {TclGetIntForIndex} -body {
    string index a 1.5e2
} -returnCodes error -match glob -result *
test util-9.44 {Tcl_GetIntForIndex} -body {
    string index a 0+1000000000000
} -result {}
test util-9.45 {Tcl_GetIntForIndex} -body {
test util-9.37 {TclGetIntForIndex} -body {
    string index a 0+x
} -returnCodes error -match glob -result *
test util-9.38 {TclGetIntForIndex} -body {
    string index abcd end+2305843009213693950
} -result {}
test util-9.46 {Tcl_GetIntForIndex} -body {
    string index abcd end+4294967294
} -result {}
# TIP 502
test util-9.47 {Tcl_GetIntForIndex} -body {
    string index abcd 0x10000000000000000
} -result {}
test util-9.48 {Tcl_GetIntForIndex} {
    string index abcd -0x10000000000000000
} {}
test util-9.49 {Tcl_GetIntForIndex} -body {
    string index abcd end*1
    string index a 0+0x
} -returnCodes error -match glob -result *
test util-9.50 {Tcl_GetIntForIndex} -body {
    string index abcd {end- 1}
test util-9.39 {TclGetIntForIndex} -body {
    string index a 0+0xg
} -returnCodes error -match glob -result *
test util-9.51 {Tcl_GetIntForIndex} -body {
    string index abcd end-end
test util-9.40 {TclGetIntForIndex} -body {
    string index a 0+0xg
} -returnCodes error -match glob -result *
test util-9.52 {Tcl_GetIntForIndex} -body {
    string index abcd end-x
test util-9.41 {TclGetIntForIndex} -body {
    string index a 0+1.0
} -returnCodes error -match glob -result *
test util-9.53 {Tcl_GetIntForIndex} -body {
    string index abcd end-0.1
test util-9.42 {TclGetIntForIndex} -body {
    string index a 0+1e2
} -returnCodes error -match glob -result *
test util-9.54 {Tcl_GetIntForIndex} {
    string index abcd end-0x10000000000000000
} {}
test util-9.55 {Tcl_GetIntForIndex} -body {
    string index abcd end+0x10000000000000000
} -result {}
test util-9.56 {Tcl_GetIntForIndex} -body {
test util-9.43 {TclGetIntForIndex} -body {
    string index a 0+1.5e1
} -returnCodes error -match glob -result *
test util-9.44 {TclGetIntForIndex} -body {
    string index abcd end--0x10000000000000000
} -result {}
test util-9.57 {Tcl_GetIntForIndex} {
    string index abcd end+-0x10000000000000000
} {}
test util-9.58 {Tcl_GetIntForIndex} -body {
    string index abcd end--0x8000000000000000
} -result {}
    string index a 0+1000000000000
} -returnCodes error -match glob -result *
test util-9.59 {Tcl_GetIntForIndex} {
    string index abcd 0-0x10000000000000000
} {}

test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x0000000000000000
} {0.0}
test util-10.2 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
    convertDouble 0x8000000000000000
} {-0.0}
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
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







-
+


-
+


-
+


-
-
+
-
-
+
-
-
+
-
-
+


-
+







test util-11.22 {Tcl_PrintDouble - scaling} {
    expr 1.1e16
} {11000000000000000.0}
test util-11.23 {Tcl_PrintDouble - scaling} {
    expr 1.1e17
} {1.1e+17}

test util-12.1 {TclDoubleDigits - Inf} {testdoubledigits ieeeFloatingPoint} {
test util-12.1 {Tcl_DoubleDigits - Inf} {testdoubledigits ieeeFloatingPoint} {
     testdoubledigits Inf -1 shortest
} {Infinity 9999 +}
test util-12.2 {TclDoubleDigits - -Inf} {testdoubledigits ieeeFloatingPoint} {
test util-12.2 {Tcl_DoubleDigits - -Inf} {testdoubledigits ieeeFloatingPoint} {
     testdoubledigits -Inf -1 shortest
} {Infinity 9999 -}
test util-12.3 {TclDoubleDigits - NaN} {testdoubledigits ieeeFloatingPoint} {
test util-12.3 {Tcl_DoubleDigits - NaN} {testdoubledigits ieeeFloatingPoint} {
     testdoubledigits $ieeeValues(NaN) -1 shortest
} {NaN 9999 +}
test util-12.4 {TclDoubleDigits - NaN} {*}{
     -constraints {testdoubledigits ieeeFloatingPoint controversialNaN}
test util-12.4 {Tcl_DoubleDigits - NaN} {testdoubledigits ieeeFloatingPoint} {
     -body {
	 testdoubledigits -NaN -1 shortest
     testdoubledigits -NaN -1 shortest
     }
    -result {NaN 9999 -}
} {NaN 9999 -}
}
test util-12.5 {TclDoubleDigits - 0} testdoubledigits {
test util-12.5 {Tcl_DoubleDigits - 0} testdoubledigits {
     testdoubledigits 0.0 -1 shortest
} {0 0 +}
test util-12.6 {TclDoubleDigits - -0} testdoubledigits {
test util-12.6 {Tcl_DoubleDigits - -0} testdoubledigits {
     testdoubledigits -0.0 -1 shortest
} {0 0 -}

# Verdonk test vectors

test util-13.1 {just over exact - 1 digits} {*}{
    -constraints testdoubledigits
2044
2045
2046
2047
2048
2049
2050
2051

2052
2053
2054
2055
2056
2057
2058
2059

2060
2061
2062
2063
2064
2065
2066
2049
2050
2051
2052
2053
2054
2055

2056
2057
2058
2059
2060
2061
2062
2063

2064
2065
2066
2067
2068
2069
2070
2071







-
+







-
+







    -body {
        verdonk_test 1f58ac4db68c90 E+121 +52083105905_49999999999999999& E+26
    }
    -result {}
}

test util-14.1 {funky NaN} {*}{
    -constraints {ieeeFloatingPoint controversialNaN}
    -constraints ieeeFloatingPoint
    -body {
	set ieeeValues(-NaN)
    }
    -result -NaN
}

test util-14.2 {funky NaN} {*}{
    -constraints {ieeeFloatingPoint controversialNaN}
    -constraints ieeeFloatingPoint
    -body {
	set ieeeValues(-NaN(3456789abcdef))
    }
    -result -NaN(3456789abcdef)
}

test util-15.1 {largest subnormal} {*}{
2146
2147
2148
2149
2150
2151
2152













































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































2153
2154
2155
2156
2157
2158
2159
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	format %#lx $x
    }
    -result 0x8010000000000000
    -cleanup {
	unset x
    }
}

set saved_precision $::tcl_precision
foreach ::tcl_precision {0 12} {
    for {set e -312} {$e < -9} {incr e} {
	test util-16.1.$::tcl_precision.$e {shortening of numbers} \
	    "expr 1.1e$e" 1.1e$e
    }
}
set tcl_precision 0
for {set e -9} {$e < -4} {incr e} {
    test util-16.1.$::tcl_precision.$e {shortening of numbers} \
	"expr 1.1e$e" 1.1e$e
}
set tcl_precision 12
for {set e -9} {$e < -4} {incr e} {
    test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} \
	"expr 1.1e$e" 1.1e[format %+03d $e]
}
foreach ::tcl_precision {0 12} {
    test util-16.1.$::tcl_precision.-4 {shortening of numbers} \
	{expr 1.1e-4} \
	0.00011
    test util-16.1.$::tcl_precision.-3 {shortening of numbers} \
	{expr 1.1e-3} \
	0.0011
    test util-16.1.$::tcl_precision.-2 {shortening of numbers} \
	{expr 1.1e-2} \
	0.011
    test util-16.1.$::tcl_precision.-1 {shortening of numbers} \
	{expr 1.1e-1} \
	0.11
    test util-16.1.$::tcl_precision.0 {shortening of numbers} \
	{expr 1.1} \
	1.1
    for {set e 1} {$e < 17} {incr e} {
	test util-16.1.$::tcl_precision.$e {shortening of numbers} \
	    "expr 11[string repeat 0 [expr {$e-1}]].0" \
	    11[string repeat 0 [expr {$e-1}]].0
    }
    for {set e 17} {$e < 309} {incr e} {
	test util-16.1.$::tcl_precision.$e {shortening of numbers} \
	    "expr 1.1e$e" 1.1e+$e
    }
}
set tcl_precision 17
test util-16.1.17.-300 {8.4 compatible formatting of doubles} \
    {expr 1e-300} \
    1e-300
test util-16.1.17.-299 {8.4 compatible formatting of doubles} \
    {expr 1e-299} \
    9.9999999999999999e-300
test util-16.1.17.-298 {8.4 compatible formatting of doubles} \
    {expr 1e-298} \
    9.9999999999999991e-299
test util-16.1.17.-297 {8.4 compatible formatting of doubles} \
    {expr 1e-297} \
    1e-297
test util-16.1.17.-296 {8.4 compatible formatting of doubles} \
    {expr 1e-296} \
    1e-296
test util-16.1.17.-295 {8.4 compatible formatting of doubles} \
    {expr 1e-295} \
    1.0000000000000001e-295
test util-16.1.17.-294 {8.4 compatible formatting of doubles} \
    {expr 1e-294} \
    1e-294
test util-16.1.17.-293 {8.4 compatible formatting of doubles} \
    {expr 1e-293} \
    1.0000000000000001e-293
test util-16.1.17.-292 {8.4 compatible formatting of doubles} \
    {expr 1e-292} \
    1.0000000000000001e-292
test util-16.1.17.-291 {8.4 compatible formatting of doubles} \
    {expr 1e-291} \
    9.9999999999999996e-292
test util-16.1.17.-290 {8.4 compatible formatting of doubles} \
    {expr 1e-290} \
    1.0000000000000001e-290
test util-16.1.17.-289 {8.4 compatible formatting of doubles} \
    {expr 1e-289} \
    1e-289
test util-16.1.17.-288 {8.4 compatible formatting of doubles} \
    {expr 1e-288} \
    1.0000000000000001e-288
test util-16.1.17.-287 {8.4 compatible formatting of doubles} \
    {expr 1e-287} \
    1e-287
test util-16.1.17.-286 {8.4 compatible formatting of doubles} \
    {expr 1e-286} \
    1.0000000000000001e-286
test util-16.1.17.-285 {8.4 compatible formatting of doubles} \
    {expr 1e-285} \
    1.0000000000000001e-285
test util-16.1.17.-284 {8.4 compatible formatting of doubles} \
    {expr 1e-284} \
    1e-284
test util-16.1.17.-283 {8.4 compatible formatting of doubles} \
    {expr 1e-283} \
    9.9999999999999995e-284
test util-16.1.17.-282 {8.4 compatible formatting of doubles} \
    {expr 1e-282} \
    1e-282
test util-16.1.17.-281 {8.4 compatible formatting of doubles} \
    {expr 1e-281} \
    1e-281
test util-16.1.17.-280 {8.4 compatible formatting of doubles} \
    {expr 1e-280} \
    9.9999999999999996e-281
test util-16.1.17.-279 {8.4 compatible formatting of doubles} \
    {expr 1e-279} \
    1.0000000000000001e-279
test util-16.1.17.-278 {8.4 compatible formatting of doubles} \
    {expr 1e-278} \
    9.9999999999999994e-279
test util-16.1.17.-277 {8.4 compatible formatting of doubles} \
    {expr 1e-277} \
    9.9999999999999997e-278
test util-16.1.17.-276 {8.4 compatible formatting of doubles} \
    {expr 1e-276} \
    1.0000000000000001e-276
test util-16.1.17.-275 {8.4 compatible formatting of doubles} \
    {expr 1e-275} \
    9.9999999999999993e-276
test util-16.1.17.-274 {8.4 compatible formatting of doubles} \
    {expr 1e-274} \
    9.9999999999999997e-275
test util-16.1.17.-273 {8.4 compatible formatting of doubles} \
    {expr 1e-273} \
    1.0000000000000001e-273
test util-16.1.17.-272 {8.4 compatible formatting of doubles} \
    {expr 1e-272} \
    9.9999999999999993e-273
test util-16.1.17.-271 {8.4 compatible formatting of doubles} \
    {expr 1e-271} \
    9.9999999999999996e-272
test util-16.1.17.-270 {8.4 compatible formatting of doubles} \
    {expr 1e-270} \
    1e-270
test util-16.1.17.-269 {8.4 compatible formatting of doubles} \
    {expr 1e-269} \
    9.9999999999999996e-270
test util-16.1.17.-268 {8.4 compatible formatting of doubles} \
    {expr 1e-268} \
    9.9999999999999996e-269
test util-16.1.17.-267 {8.4 compatible formatting of doubles} \
    {expr 1e-267} \
    9.9999999999999998e-268
test util-16.1.17.-266 {8.4 compatible formatting of doubles} \
    {expr 1e-266} \
    9.9999999999999998e-267
test util-16.1.17.-265 {8.4 compatible formatting of doubles} \
    {expr 1e-265} \
    9.9999999999999998e-266
test util-16.1.17.-264 {8.4 compatible formatting of doubles} \
    {expr 1e-264} \
    1e-264
test util-16.1.17.-263 {8.4 compatible formatting of doubles} \
    {expr 1e-263} \
    1e-263
test util-16.1.17.-262 {8.4 compatible formatting of doubles} \
    {expr 1e-262} \
    1e-262
test util-16.1.17.-261 {8.4 compatible formatting of doubles} \
    {expr 1e-261} \
    9.9999999999999998e-262
test util-16.1.17.-260 {8.4 compatible formatting of doubles} \
    {expr 1e-260} \
    9.9999999999999996e-261
test util-16.1.17.-259 {8.4 compatible formatting of doubles} \
    {expr 1e-259} \
    1.0000000000000001e-259
test util-16.1.17.-258 {8.4 compatible formatting of doubles} \
    {expr 1e-258} \
    9.9999999999999995e-259
test util-16.1.17.-257 {8.4 compatible formatting of doubles} \
    {expr 1e-257} \
    9.9999999999999998e-258
test util-16.1.17.-256 {8.4 compatible formatting of doubles} \
    {expr 1e-256} \
    9.9999999999999998e-257
test util-16.1.17.-255 {8.4 compatible formatting of doubles} \
    {expr 1e-255} \
    1e-255
test util-16.1.17.-254 {8.4 compatible formatting of doubles} \
    {expr 1e-254} \
    9.9999999999999991e-255
test util-16.1.17.-253 {8.4 compatible formatting of doubles} \
    {expr 1e-253} \
    1.0000000000000001e-253
test util-16.1.17.-252 {8.4 compatible formatting of doubles} \
    {expr 1e-252} \
    9.9999999999999994e-253
test util-16.1.17.-251 {8.4 compatible formatting of doubles} \
    {expr 1e-251} \
    1e-251
test util-16.1.17.-250 {8.4 compatible formatting of doubles} \
    {expr 1e-250} \
    1.0000000000000001e-250
test util-16.1.17.-249 {8.4 compatible formatting of doubles} \
    {expr 1e-249} \
    1.0000000000000001e-249
test util-16.1.17.-248 {8.4 compatible formatting of doubles} \
    {expr 1e-248} \
    9.9999999999999998e-249
test util-16.1.17.-247 {8.4 compatible formatting of doubles} \
    {expr 1e-247} \
    1e-247
test util-16.1.17.-246 {8.4 compatible formatting of doubles} \
    {expr 1e-246} \
    9.9999999999999996e-247
test util-16.1.17.-245 {8.4 compatible formatting of doubles} \
    {expr 1e-245} \
    9.9999999999999993e-246
test util-16.1.17.-244 {8.4 compatible formatting of doubles} \
    {expr 1e-244} \
    9.9999999999999993e-245
test util-16.1.17.-243 {8.4 compatible formatting of doubles} \
    {expr 1e-243} \
    1e-243
test util-16.1.17.-242 {8.4 compatible formatting of doubles} \
    {expr 1e-242} \
    9.9999999999999997e-243
test util-16.1.17.-241 {8.4 compatible formatting of doubles} \
    {expr 1e-241} \
    9.9999999999999997e-242
test util-16.1.17.-240 {8.4 compatible formatting of doubles} \
    {expr 1e-240} \
    9.9999999999999997e-241
test util-16.1.17.-239 {8.4 compatible formatting of doubles} \
    {expr 1e-239} \
    1.0000000000000001e-239
test util-16.1.17.-238 {8.4 compatible formatting of doubles} \
    {expr 1e-238} \
    9.9999999999999999e-239
test util-16.1.17.-237 {8.4 compatible formatting of doubles} \
    {expr 1e-237} \
    9.9999999999999999e-238
test util-16.1.17.-236 {8.4 compatible formatting of doubles} \
    {expr 1e-236} \
    1e-236
test util-16.1.17.-235 {8.4 compatible formatting of doubles} \
    {expr 1e-235} \
    9.9999999999999996e-236
test util-16.1.17.-234 {8.4 compatible formatting of doubles} \
    {expr 1e-234} \
    9.9999999999999996e-235
test util-16.1.17.-233 {8.4 compatible formatting of doubles} \
    {expr 1e-233} \
    9.9999999999999996e-234
test util-16.1.17.-232 {8.4 compatible formatting of doubles} \
    {expr 1e-232} \
    1e-232
test util-16.1.17.-231 {8.4 compatible formatting of doubles} \
    {expr 1e-231} \
    9.9999999999999999e-232
test util-16.1.17.-230 {8.4 compatible formatting of doubles} \
    {expr 1e-230} \
    1e-230
test util-16.1.17.-229 {8.4 compatible formatting of doubles} \
    {expr 1e-229} \
    1.0000000000000001e-229
test util-16.1.17.-228 {8.4 compatible formatting of doubles} \
    {expr 1e-228} \
    1e-228
test util-16.1.17.-227 {8.4 compatible formatting of doubles} \
    {expr 1e-227} \
    9.9999999999999994e-228
test util-16.1.17.-226 {8.4 compatible formatting of doubles} \
    {expr 1e-226} \
    9.9999999999999992e-227
test util-16.1.17.-225 {8.4 compatible formatting of doubles} \
    {expr 1e-225} \
    9.9999999999999996e-226
test util-16.1.17.-224 {8.4 compatible formatting of doubles} \
    {expr 1e-224} \
    1e-224
test util-16.1.17.-223 {8.4 compatible formatting of doubles} \
    {expr 1e-223} \
    9.9999999999999997e-224
test util-16.1.17.-222 {8.4 compatible formatting of doubles} \
    {expr 1e-222} \
    1e-222
test util-16.1.17.-221 {8.4 compatible formatting of doubles} \
    {expr 1e-221} \
    1e-221
test util-16.1.17.-220 {8.4 compatible formatting of doubles} \
    {expr 1e-220} \
    9.9999999999999999e-221
test util-16.1.17.-219 {8.4 compatible formatting of doubles} \
    {expr 1e-219} \
    1e-219
test util-16.1.17.-218 {8.4 compatible formatting of doubles} \
    {expr 1e-218} \
    1e-218
test util-16.1.17.-217 {8.4 compatible formatting of doubles} \
    {expr 1e-217} \
    1.0000000000000001e-217
test util-16.1.17.-216 {8.4 compatible formatting of doubles} \
    {expr 1e-216} \
    1e-216
test util-16.1.17.-215 {8.4 compatible formatting of doubles} \
    {expr 1e-215} \
    1e-215
test util-16.1.17.-214 {8.4 compatible formatting of doubles} \
    {expr 1e-214} \
    9.9999999999999991e-215
test util-16.1.17.-213 {8.4 compatible formatting of doubles} \
    {expr 1e-213} \
    9.9999999999999995e-214
test util-16.1.17.-212 {8.4 compatible formatting of doubles} \
    {expr 1e-212} \
    9.9999999999999995e-213
test util-16.1.17.-211 {8.4 compatible formatting of doubles} \
    {expr 1e-211} \
    1.0000000000000001e-211
test util-16.1.17.-210 {8.4 compatible formatting of doubles} \
    {expr 1e-210} \
    1e-210
test util-16.1.17.-209 {8.4 compatible formatting of doubles} \
    {expr 1e-209} \
    1e-209
test util-16.1.17.-208 {8.4 compatible formatting of doubles} \
    {expr 1e-208} \
    1.0000000000000001e-208
test util-16.1.17.-207 {8.4 compatible formatting of doubles} \
    {expr 1e-207} \
    9.9999999999999993e-208
test util-16.1.17.-206 {8.4 compatible formatting of doubles} \
    {expr 1e-206} \
    1e-206
test util-16.1.17.-205 {8.4 compatible formatting of doubles} \
    {expr 1e-205} \
    1e-205
test util-16.1.17.-204 {8.4 compatible formatting of doubles} \
    {expr 1e-204} \
    1e-204
test util-16.1.17.-203 {8.4 compatible formatting of doubles} \
    {expr 1e-203} \
    1e-203
test util-16.1.17.-202 {8.4 compatible formatting of doubles} \
    {expr 1e-202} \
    1e-202
test util-16.1.17.-201 {8.4 compatible formatting of doubles} \
    {expr 1e-201} \
    9.9999999999999995e-202
test util-16.1.17.-200 {8.4 compatible formatting of doubles} \
    {expr 1e-200} \
    9.9999999999999998e-201
test util-16.1.17.-199 {8.4 compatible formatting of doubles} \
    {expr 1e-199} \
    9.9999999999999998e-200
test util-16.1.17.-198 {8.4 compatible formatting of doubles} \
    {expr 1e-198} \
    9.9999999999999991e-199
test util-16.1.17.-197 {8.4 compatible formatting of doubles} \
    {expr 1e-197} \
    9.9999999999999999e-198
test util-16.1.17.-196 {8.4 compatible formatting of doubles} \
    {expr 1e-196} \
    1e-196
test util-16.1.17.-195 {8.4 compatible formatting of doubles} \
    {expr 1e-195} \
    1.0000000000000001e-195
test util-16.1.17.-194 {8.4 compatible formatting of doubles} \
    {expr 1e-194} \
    1e-194
test util-16.1.17.-193 {8.4 compatible formatting of doubles} \
    {expr 1e-193} \
    1e-193
test util-16.1.17.-192 {8.4 compatible formatting of doubles} \
    {expr 1e-192} \
    1.0000000000000001e-192
test util-16.1.17.-191 {8.4 compatible formatting of doubles} \
    {expr 1e-191} \
    1e-191
test util-16.1.17.-190 {8.4 compatible formatting of doubles} \
    {expr 1e-190} \
    1e-190
test util-16.1.17.-189 {8.4 compatible formatting of doubles} \
    {expr 1e-189} \
    1.0000000000000001e-189
test util-16.1.17.-188 {8.4 compatible formatting of doubles} \
    {expr 1e-188} \
    9.9999999999999995e-189
test util-16.1.17.-187 {8.4 compatible formatting of doubles} \
    {expr 1e-187} \
    1e-187
test util-16.1.17.-186 {8.4 compatible formatting of doubles} \
    {expr 1e-186} \
    9.9999999999999991e-187
test util-16.1.17.-185 {8.4 compatible formatting of doubles} \
    {expr 1e-185} \
    9.9999999999999999e-186
test util-16.1.17.-184 {8.4 compatible formatting of doubles} \
    {expr 1e-184} \
    1.0000000000000001e-184
test util-16.1.17.-183 {8.4 compatible formatting of doubles} \
    {expr 1e-183} \
    1e-183
test util-16.1.17.-182 {8.4 compatible formatting of doubles} \
    {expr 1e-182} \
    1e-182
test util-16.1.17.-181 {8.4 compatible formatting of doubles} \
    {expr 1e-181} \
    1e-181
test util-16.1.17.-180 {8.4 compatible formatting of doubles} \
    {expr 1e-180} \
    1e-180
test util-16.1.17.-179 {8.4 compatible formatting of doubles} \
    {expr 1e-179} \
    1e-179
test util-16.1.17.-178 {8.4 compatible formatting of doubles} \
    {expr 1e-178} \
    9.9999999999999995e-179
test util-16.1.17.-177 {8.4 compatible formatting of doubles} \
    {expr 1e-177} \
    9.9999999999999995e-178
test util-16.1.17.-176 {8.4 compatible formatting of doubles} \
    {expr 1e-176} \
    1e-176
test util-16.1.17.-175 {8.4 compatible formatting of doubles} \
    {expr 1e-175} \
    1e-175
test util-16.1.17.-174 {8.4 compatible formatting of doubles} \
    {expr 1e-174} \
    1e-174
test util-16.1.17.-173 {8.4 compatible formatting of doubles} \
    {expr 1e-173} \
    1e-173
test util-16.1.17.-172 {8.4 compatible formatting of doubles} \
    {expr 1e-172} \
    1e-172
test util-16.1.17.-171 {8.4 compatible formatting of doubles} \
    {expr 1e-171} \
    9.9999999999999998e-172
test util-16.1.17.-170 {8.4 compatible formatting of doubles} \
    {expr 1e-170} \
    9.9999999999999998e-171
test util-16.1.17.-169 {8.4 compatible formatting of doubles} \
    {expr 1e-169} \
    1e-169
test util-16.1.17.-168 {8.4 compatible formatting of doubles} \
    {expr 1e-168} \
    1e-168
test util-16.1.17.-167 {8.4 compatible formatting of doubles} \
    {expr 1e-167} \
    1e-167
test util-16.1.17.-166 {8.4 compatible formatting of doubles} \
    {expr 1e-166} \
    1e-166
test util-16.1.17.-165 {8.4 compatible formatting of doubles} \
    {expr 1e-165} \
    1e-165
test util-16.1.17.-164 {8.4 compatible formatting of doubles} \
    {expr 1e-164} \
    9.9999999999999996e-165
test util-16.1.17.-163 {8.4 compatible formatting of doubles} \
    {expr 1e-163} \
    9.9999999999999992e-164
test util-16.1.17.-162 {8.4 compatible formatting of doubles} \
    {expr 1e-162} \
    9.9999999999999995e-163
test util-16.1.17.-161 {8.4 compatible formatting of doubles} \
    {expr 1e-161} \
    1e-161
test util-16.1.17.-160 {8.4 compatible formatting of doubles} \
    {expr 1e-160} \
    9.9999999999999999e-161
test util-16.1.17.-159 {8.4 compatible formatting of doubles} \
    {expr 1e-159} \
    9.9999999999999999e-160
test util-16.1.17.-158 {8.4 compatible formatting of doubles} \
    {expr 1e-158} \
    1.0000000000000001e-158
test util-16.1.17.-157 {8.4 compatible formatting of doubles} \
    {expr 1e-157} \
    9.9999999999999994e-158
test util-16.1.17.-156 {8.4 compatible formatting of doubles} \
    {expr 1e-156} \
    1e-156
test util-16.1.17.-155 {8.4 compatible formatting of doubles} \
    {expr 1e-155} \
    1e-155
test util-16.1.17.-154 {8.4 compatible formatting of doubles} \
    {expr 1e-154} \
    9.9999999999999997e-155
test util-16.1.17.-153 {8.4 compatible formatting of doubles} \
    {expr 1e-153} \
    1e-153
test util-16.1.17.-152 {8.4 compatible formatting of doubles} \
    {expr 1e-152} \
    1.0000000000000001e-152
test util-16.1.17.-151 {8.4 compatible formatting of doubles} \
    {expr 1e-151} \
    9.9999999999999994e-152
test util-16.1.17.-150 {8.4 compatible formatting of doubles} \
    {expr 1e-150} \
    1e-150
test util-16.1.17.-149 {8.4 compatible formatting of doubles} \
    {expr 1e-149} \
    9.9999999999999998e-150
test util-16.1.17.-148 {8.4 compatible formatting of doubles} \
    {expr 1e-148} \
    9.9999999999999994e-149
test util-16.1.17.-147 {8.4 compatible formatting of doubles} \
    {expr 1e-147} \
    9.9999999999999997e-148
test util-16.1.17.-146 {8.4 compatible formatting of doubles} \
    {expr 1e-146} \
    1e-146
test util-16.1.17.-145 {8.4 compatible formatting of doubles} \
    {expr 1e-145} \
    9.9999999999999991e-146
test util-16.1.17.-144 {8.4 compatible formatting of doubles} \
    {expr 1e-144} \
    9.9999999999999995e-145
test util-16.1.17.-143 {8.4 compatible formatting of doubles} \
    {expr 1e-143} \
    9.9999999999999995e-144
test util-16.1.17.-142 {8.4 compatible formatting of doubles} \
    {expr 1e-142} \
    1e-142
test util-16.1.17.-141 {8.4 compatible formatting of doubles} \
    {expr 1e-141} \
    1e-141
test util-16.1.17.-140 {8.4 compatible formatting of doubles} \
    {expr 1e-140} \
    9.9999999999999998e-141
test util-16.1.17.-139 {8.4 compatible formatting of doubles} \
    {expr 1e-139} \
    1e-139
test util-16.1.17.-138 {8.4 compatible formatting of doubles} \
    {expr 1e-138} \
    1.0000000000000001e-138
test util-16.1.17.-137 {8.4 compatible formatting of doubles} \
    {expr 1e-137} \
    9.9999999999999998e-138
test util-16.1.17.-136 {8.4 compatible formatting of doubles} \
    {expr 1e-136} \
    1e-136
test util-16.1.17.-135 {8.4 compatible formatting of doubles} \
    {expr 1e-135} \
    1e-135
test util-16.1.17.-134 {8.4 compatible formatting of doubles} \
    {expr 1e-134} \
    1e-134
test util-16.1.17.-133 {8.4 compatible formatting of doubles} \
    {expr 1e-133} \
    1.0000000000000001e-133
test util-16.1.17.-132 {8.4 compatible formatting of doubles} \
    {expr 1e-132} \
    9.9999999999999999e-133
test util-16.1.17.-131 {8.4 compatible formatting of doubles} \
    {expr 1e-131} \
    9.9999999999999999e-132
test util-16.1.17.-130 {8.4 compatible formatting of doubles} \
    {expr 1e-130} \
    1.0000000000000001e-130
test util-16.1.17.-129 {8.4 compatible formatting of doubles} \
    {expr 1e-129} \
    9.9999999999999993e-130
test util-16.1.17.-128 {8.4 compatible formatting of doubles} \
    {expr 1e-128} \
    1.0000000000000001e-128
test util-16.1.17.-127 {8.4 compatible formatting of doubles} \
    {expr 1e-127} \
    1e-127
test util-16.1.17.-126 {8.4 compatible formatting of doubles} \
    {expr 1e-126} \
    9.9999999999999995e-127
test util-16.1.17.-125 {8.4 compatible formatting of doubles} \
    {expr 1e-125} \
    1e-125
test util-16.1.17.-124 {8.4 compatible formatting of doubles} \
    {expr 1e-124} \
    9.9999999999999993e-125
test util-16.1.17.-123 {8.4 compatible formatting of doubles} \
    {expr 1e-123} \
    1.0000000000000001e-123
test util-16.1.17.-122 {8.4 compatible formatting of doubles} \
    {expr 1e-122} \
    1.0000000000000001e-122
test util-16.1.17.-121 {8.4 compatible formatting of doubles} \
    {expr 1e-121} \
    9.9999999999999998e-122
test util-16.1.17.-120 {8.4 compatible formatting of doubles} \
    {expr 1e-120} \
    9.9999999999999998e-121
test util-16.1.17.-119 {8.4 compatible formatting of doubles} \
    {expr 1e-119} \
    1e-119
test util-16.1.17.-118 {8.4 compatible formatting of doubles} \
    {expr 1e-118} \
    9.9999999999999999e-119
test util-16.1.17.-117 {8.4 compatible formatting of doubles} \
    {expr 1e-117} \
    1e-117
test util-16.1.17.-116 {8.4 compatible formatting of doubles} \
    {expr 1e-116} \
    9.9999999999999999e-117
test util-16.1.17.-115 {8.4 compatible formatting of doubles} \
    {expr 1e-115} \
    1.0000000000000001e-115
test util-16.1.17.-114 {8.4 compatible formatting of doubles} \
    {expr 1e-114} \
    1.0000000000000001e-114
test util-16.1.17.-113 {8.4 compatible formatting of doubles} \
    {expr 1e-113} \
    9.9999999999999998e-114
test util-16.1.17.-112 {8.4 compatible formatting of doubles} \
    {expr 1e-112} \
    9.9999999999999995e-113
test util-16.1.17.-111 {8.4 compatible formatting of doubles} \
    {expr 1e-111} \
    1.0000000000000001e-111
test util-16.1.17.-110 {8.4 compatible formatting of doubles} \
    {expr 1e-110} \
    1.0000000000000001e-110
test util-16.1.17.-109 {8.4 compatible formatting of doubles} \
    {expr 1e-109} \
    9.9999999999999999e-110
test util-16.1.17.-108 {8.4 compatible formatting of doubles} \
    {expr 1e-108} \
    1e-108
test util-16.1.17.-107 {8.4 compatible formatting of doubles} \
    {expr 1e-107} \
    1e-107
test util-16.1.17.-106 {8.4 compatible formatting of doubles} \
    {expr 1e-106} \
    9.9999999999999994e-107
test util-16.1.17.-105 {8.4 compatible formatting of doubles} \
    {expr 1e-105} \
    9.9999999999999997e-106
test util-16.1.17.-104 {8.4 compatible formatting of doubles} \
    {expr 1e-104} \
    9.9999999999999993e-105
test util-16.1.17.-103 {8.4 compatible formatting of doubles} \
    {expr 1e-103} \
    9.9999999999999996e-104
test util-16.1.17.-102 {8.4 compatible formatting of doubles} \
    {expr 1e-102} \
    9.9999999999999993e-103
test util-16.1.17.-101 {8.4 compatible formatting of doubles} \
    {expr 1e-101} \
    1.0000000000000001e-101
test util-16.1.17.-100 {8.4 compatible formatting of doubles} \
    {expr 1e-100} \
    1e-100
test util-16.1.17.-99 {8.4 compatible formatting of doubles} \
    {expr 1e-99} \
    1e-99
test util-16.1.17.-98 {8.4 compatible formatting of doubles} \
    {expr 1e-98} \
    9.9999999999999994e-99
test util-16.1.17.-97 {8.4 compatible formatting of doubles} \
    {expr 1e-97} \
    1e-97
test util-16.1.17.-96 {8.4 compatible formatting of doubles} \
    {expr 1e-96} \
    9.9999999999999991e-97
test util-16.1.17.-95 {8.4 compatible formatting of doubles} \
    {expr 1e-95} \
    9.9999999999999999e-96
test util-16.1.17.-94 {8.4 compatible formatting of doubles} \
    {expr 1e-94} \
    9.9999999999999996e-95
test util-16.1.17.-93 {8.4 compatible formatting of doubles} \
    {expr 1e-93} \
    9.999999999999999e-94
test util-16.1.17.-92 {8.4 compatible formatting of doubles} \
    {expr 1e-92} \
    9.9999999999999999e-93
test util-16.1.17.-91 {8.4 compatible formatting of doubles} \
    {expr 1e-91} \
    1e-91
test util-16.1.17.-90 {8.4 compatible formatting of doubles} \
    {expr 1e-90} \
    9.9999999999999999e-91
test util-16.1.17.-89 {8.4 compatible formatting of doubles} \
    {expr 1e-89} \
    1e-89
test util-16.1.17.-88 {8.4 compatible formatting of doubles} \
    {expr 1e-88} \
    9.9999999999999993e-89
test util-16.1.17.-87 {8.4 compatible formatting of doubles} \
    {expr 1e-87} \
    1e-87
test util-16.1.17.-86 {8.4 compatible formatting of doubles} \
    {expr 1e-86} \
    1.0000000000000001e-86
test util-16.1.17.-85 {8.4 compatible formatting of doubles} \
    {expr 1e-85} \
    9.9999999999999998e-86
test util-16.1.17.-84 {8.4 compatible formatting of doubles} \
    {expr 1e-84} \
    1e-84
test util-16.1.17.-83 {8.4 compatible formatting of doubles} \
    {expr 1e-83} \
    1e-83
test util-16.1.17.-82 {8.4 compatible formatting of doubles} \
    {expr 1e-82} \
    9.9999999999999996e-83
test util-16.1.17.-81 {8.4 compatible formatting of doubles} \
    {expr 1e-81} \
    9.9999999999999996e-82
test util-16.1.17.-80 {8.4 compatible formatting of doubles} \
    {expr 1e-80} \
    9.9999999999999996e-81
test util-16.1.17.-79 {8.4 compatible formatting of doubles} \
    {expr 1e-79} \
    1e-79
test util-16.1.17.-78 {8.4 compatible formatting of doubles} \
    {expr 1e-78} \
    1e-78
test util-16.1.17.-77 {8.4 compatible formatting of doubles} \
    {expr 1e-77} \
    9.9999999999999993e-78
test util-16.1.17.-76 {8.4 compatible formatting of doubles} \
    {expr 1e-76} \
    9.9999999999999993e-77
test util-16.1.17.-75 {8.4 compatible formatting of doubles} \
    {expr 1e-75} \
    9.9999999999999996e-76
test util-16.1.17.-74 {8.4 compatible formatting of doubles} \
    {expr 1e-74} \
    9.9999999999999996e-75
test util-16.1.17.-73 {8.4 compatible formatting of doubles} \
    {expr 1e-73} \
    1e-73
test util-16.1.17.-72 {8.4 compatible formatting of doubles} \
    {expr 1e-72} \
    9.9999999999999997e-73
test util-16.1.17.-71 {8.4 compatible formatting of doubles} \
    {expr 1e-71} \
    9.9999999999999992e-72
test util-16.1.17.-70 {8.4 compatible formatting of doubles} \
    {expr 1e-70} \
    1e-70
test util-16.1.17.-69 {8.4 compatible formatting of doubles} \
    {expr 1e-69} \
    9.9999999999999996e-70
test util-16.1.17.-68 {8.4 compatible formatting of doubles} \
    {expr 1e-68} \
    1.0000000000000001e-68
test util-16.1.17.-67 {8.4 compatible formatting of doubles} \
    {expr 1e-67} \
    9.9999999999999994e-68
test util-16.1.17.-66 {8.4 compatible formatting of doubles} \
    {expr 1e-66} \
    9.9999999999999998e-67
test util-16.1.17.-65 {8.4 compatible formatting of doubles} \
    {expr 1e-65} \
    9.9999999999999992e-66
test util-16.1.17.-64 {8.4 compatible formatting of doubles} \
    {expr 1e-64} \
    9.9999999999999997e-65
test util-16.1.17.-63 {8.4 compatible formatting of doubles} \
    {expr 1e-63} \
    1.0000000000000001e-63
test util-16.1.17.-62 {8.4 compatible formatting of doubles} \
    {expr 1e-62} \
    1e-62
test util-16.1.17.-61 {8.4 compatible formatting of doubles} \
    {expr 1e-61} \
    1e-61
test util-16.1.17.-60 {8.4 compatible formatting of doubles} \
    {expr 1e-60} \
    9.9999999999999997e-61
test util-16.1.17.-59 {8.4 compatible formatting of doubles} \
    {expr 1e-59} \
    1e-59
test util-16.1.17.-58 {8.4 compatible formatting of doubles} \
    {expr 1e-58} \
    1e-58
test util-16.1.17.-57 {8.4 compatible formatting of doubles} \
    {expr 1e-57} \
    9.9999999999999995e-58
test util-16.1.17.-56 {8.4 compatible formatting of doubles} \
    {expr 1e-56} \
    1e-56
test util-16.1.17.-55 {8.4 compatible formatting of doubles} \
    {expr 1e-55} \
    9.9999999999999999e-56
test util-16.1.17.-54 {8.4 compatible formatting of doubles} \
    {expr 1e-54} \
    1e-54
test util-16.1.17.-53 {8.4 compatible formatting of doubles} \
    {expr 1e-53} \
    1e-53
test util-16.1.17.-52 {8.4 compatible formatting of doubles} \
    {expr 1e-52} \
    1e-52
test util-16.1.17.-51 {8.4 compatible formatting of doubles} \
    {expr 1e-51} \
    1e-51
test util-16.1.17.-50 {8.4 compatible formatting of doubles} \
    {expr 1e-50} \
    1e-50
test util-16.1.17.-49 {8.4 compatible formatting of doubles} \
    {expr 1e-49} \
    9.9999999999999994e-50
test util-16.1.17.-48 {8.4 compatible formatting of doubles} \
    {expr 1e-48} \
    9.9999999999999997e-49
test util-16.1.17.-47 {8.4 compatible formatting of doubles} \
    {expr 1e-47} \
    9.9999999999999997e-48
test util-16.1.17.-46 {8.4 compatible formatting of doubles} \
    {expr 1e-46} \
    1e-46
test util-16.1.17.-45 {8.4 compatible formatting of doubles} \
    {expr 1e-45} \
    9.9999999999999998e-46
test util-16.1.17.-44 {8.4 compatible formatting of doubles} \
    {expr 1e-44} \
    9.9999999999999995e-45
test util-16.1.17.-43 {8.4 compatible formatting of doubles} \
    {expr 1e-43} \
    1.0000000000000001e-43
test util-16.1.17.-42 {8.4 compatible formatting of doubles} \
    {expr 1e-42} \
    1e-42
test util-16.1.17.-41 {8.4 compatible formatting of doubles} \
    {expr 1e-41} \
    1e-41
test util-16.1.17.-40 {8.4 compatible formatting of doubles} \
    {expr 1e-40} \
    9.9999999999999993e-41
test util-16.1.17.-39 {8.4 compatible formatting of doubles} \
    {expr 1e-39} \
    9.9999999999999993e-40
test util-16.1.17.-38 {8.4 compatible formatting of doubles} \
    {expr 1e-38} \
    9.9999999999999996e-39
test util-16.1.17.-37 {8.4 compatible formatting of doubles} \
    {expr 1e-37} \
    1.0000000000000001e-37
test util-16.1.17.-36 {8.4 compatible formatting of doubles} \
    {expr 1e-36} \
    9.9999999999999994e-37
test util-16.1.17.-35 {8.4 compatible formatting of doubles} \
    {expr 1e-35} \
    1e-35
test util-16.1.17.-34 {8.4 compatible formatting of doubles} \
    {expr 1e-34} \
    9.9999999999999993e-35
test util-16.1.17.-33 {8.4 compatible formatting of doubles} \
    {expr 1e-33} \
    1.0000000000000001e-33
test util-16.1.17.-32 {8.4 compatible formatting of doubles} \
    {expr 1e-32} \
    1.0000000000000001e-32
test util-16.1.17.-31 {8.4 compatible formatting of doubles} \
    {expr 1e-31} \
    1.0000000000000001e-31
test util-16.1.17.-30 {8.4 compatible formatting of doubles} \
    {expr 1e-30} \
    1.0000000000000001e-30
test util-16.1.17.-29 {8.4 compatible formatting of doubles} \
    {expr 1e-29} \
    9.9999999999999994e-30
test util-16.1.17.-28 {8.4 compatible formatting of doubles} \
    {expr 1e-28} \
    9.9999999999999997e-29
test util-16.1.17.-27 {8.4 compatible formatting of doubles} \
    {expr 1e-27} \
    1e-27
test util-16.1.17.-26 {8.4 compatible formatting of doubles} \
    {expr 1e-26} \
    1e-26
test util-16.1.17.-25 {8.4 compatible formatting of doubles} \
    {expr 1e-25} \
    1e-25
test util-16.1.17.-24 {8.4 compatible formatting of doubles} \
    {expr 1e-24} \
    9.9999999999999992e-25
test util-16.1.17.-23 {8.4 compatible formatting of doubles} \
    {expr 1e-23} \
    9.9999999999999996e-24
test util-16.1.17.-22 {8.4 compatible formatting of doubles} \
    {expr 1e-22} \
    1e-22
test util-16.1.17.-21 {8.4 compatible formatting of doubles} \
    {expr 1e-21} \
    9.9999999999999991e-22
test util-16.1.17.-20 {8.4 compatible formatting of doubles} \
    {expr 1e-20} \
    9.9999999999999995e-21
test util-16.1.17.-19 {8.4 compatible formatting of doubles} \
    {expr 1e-19} \
    9.9999999999999998e-20
test util-16.1.17.-18 {8.4 compatible formatting of doubles} \
    {expr 1e-18} \
    1.0000000000000001e-18
test util-16.1.17.-17 {8.4 compatible formatting of doubles} \
    {expr 1e-17} \
    1.0000000000000001e-17
test util-16.1.17.-16 {8.4 compatible formatting of doubles} \
    {expr 1e-16} \
    9.9999999999999998e-17
test util-16.1.17.-15 {8.4 compatible formatting of doubles} \
    {expr 1e-15} \
    1.0000000000000001e-15
test util-16.1.17.-14 {8.4 compatible formatting of doubles} \
    {expr 1e-14} \
    1e-14
test util-16.1.17.-13 {8.4 compatible formatting of doubles} \
    {expr 1e-13} \
    1e-13
test util-16.1.17.-12 {8.4 compatible formatting of doubles} \
    {expr 1e-12} \
    9.9999999999999998e-13
test util-16.1.17.-11 {8.4 compatible formatting of doubles} \
    {expr 1e-11} \
    9.9999999999999994e-12
test util-16.1.17.-10 {8.4 compatible formatting of doubles} \
    {expr 1e-10} \
    1e-10
test util-16.1.17.-9 {8.4 compatible formatting of doubles} \
    {expr 1e-9} \
    1.0000000000000001e-09
test util-16.1.17.-8 {8.4 compatible formatting of doubles} \
    {expr 1e-8} \
    1e-08
test util-16.1.17.-7 {8.4 compatible formatting of doubles} \
    {expr 1e-7} \
    9.9999999999999995e-08
test util-16.1.17.-6 {8.4 compatible formatting of doubles} \
    {expr 1e-6} \
    9.9999999999999995e-07
test util-16.1.17.-5 {8.4 compatible formatting of doubles} \
    {expr 1e-5} \
    1.0000000000000001e-05
test util-16.1.17.-4 {8.4 compatible formatting of doubles} \
    {expr 1e-4} \
    0.0001
test util-16.1.17.-3 {8.4 compatible formatting of doubles} \
    {expr 1e-3} \
    0.001
test util-16.1.17.-2 {8.4 compatible formatting of doubles} \
    {expr 1e-2} \
    0.01
test util-16.1.17.-1 {8.4 compatible formatting of doubles} \
    {expr 1e-1} \
    0.10000000000000001
test util-16.1.17.0 {8.4 compatible formatting of doubles} \
    {expr 1e0} \
    1.0
test util-16.1.17.1 {8.4 compatible formatting of doubles} \
    {expr 1e1} \
    10.0
test util-16.1.17.2 {8.4 compatible formatting of doubles} \
    {expr 1e2} \
    100.0
test util-16.1.17.3 {8.4 compatible formatting of doubles} \
    {expr 1e3} \
    1000.0
test util-16.1.17.4 {8.4 compatible formatting of doubles} \
    {expr 1e4} \
    10000.0
test util-16.1.17.5 {8.4 compatible formatting of doubles} \
    {expr 1e5} \
    100000.0
test util-16.1.17.6 {8.4 compatible formatting of doubles} \
    {expr 1e6} \
    1000000.0
test util-16.1.17.7 {8.4 compatible formatting of doubles} \
    {expr 1e7} \
    10000000.0
test util-16.1.17.8 {8.4 compatible formatting of doubles} \
    {expr 1e8} \
    100000000.0
test util-16.1.17.9 {8.4 compatible formatting of doubles} \
    {expr 1e9} \
    1000000000.0
test util-16.1.17.10 {8.4 compatible formatting of doubles} \
    {expr 1e10} \
    10000000000.0
test util-16.1.17.11 {8.4 compatible formatting of doubles} \
    {expr 1e11} \
    100000000000.0
test util-16.1.17.12 {8.4 compatible formatting of doubles} \
    {expr 1e12} \
    1000000000000.0
test util-16.1.17.13 {8.4 compatible formatting of doubles} \
    {expr 1e13} \
    10000000000000.0
test util-16.1.17.14 {8.4 compatible formatting of doubles} \
    {expr 1e14} \
    100000000000000.0
test util-16.1.17.15 {8.4 compatible formatting of doubles} \
    {expr 1e15} \
    1000000000000000.0
test util-16.1.17.16 {8.4 compatible formatting of doubles} \
    {expr 1e16} \
    10000000000000000.0
test util-16.1.17.17 {8.4 compatible formatting of doubles} \
    {expr 1e17} \
    1e+17
test util-16.1.17.18 {8.4 compatible formatting of doubles} \
    {expr 1e18} \
    1e+18
test util-16.1.17.19 {8.4 compatible formatting of doubles} \
    {expr 1e19} \
    1e+19
test util-16.1.17.20 {8.4 compatible formatting of doubles} \
    {expr 1e20} \
    1e+20
test util-16.1.17.21 {8.4 compatible formatting of doubles} \
    {expr 1e21} \
    1e+21
test util-16.1.17.22 {8.4 compatible formatting of doubles} \
    {expr 1e22} \
    1e+22
test util-16.1.17.23 {8.4 compatible formatting of doubles} \
    {expr 1e23} \
    9.9999999999999992e+22
test util-16.1.17.24 {8.4 compatible formatting of doubles} \
    {expr 1e24} \
    9.9999999999999998e+23
test util-16.1.17.25 {8.4 compatible formatting of doubles} \
    {expr 1e25} \
    1.0000000000000001e+25
test util-16.1.17.26 {8.4 compatible formatting of doubles} \
    {expr 1e26} \
    1e+26
test util-16.1.17.27 {8.4 compatible formatting of doubles} \
    {expr 1e27} \
    1e+27
test util-16.1.17.28 {8.4 compatible formatting of doubles} \
    {expr 1e28} \
    9.9999999999999996e+27
test util-16.1.17.29 {8.4 compatible formatting of doubles} \
    {expr 1e29} \
    9.9999999999999991e+28
test util-16.1.17.30 {8.4 compatible formatting of doubles} \
    {expr 1e30} \
    1e+30
test util-16.1.17.31 {8.4 compatible formatting of doubles} \
    {expr 1e31} \
    9.9999999999999996e+30
test util-16.1.17.32 {8.4 compatible formatting of doubles} \
    {expr 1e32} \
    1.0000000000000001e+32
test util-16.1.17.33 {8.4 compatible formatting of doubles} \
    {expr 1e33} \
    9.9999999999999995e+32
test util-16.1.17.34 {8.4 compatible formatting of doubles} \
    {expr 1e34} \
    9.9999999999999995e+33
test util-16.1.17.35 {8.4 compatible formatting of doubles} \
    {expr 1e35} \
    9.9999999999999997e+34
test util-16.1.17.36 {8.4 compatible formatting of doubles} \
    {expr 1e36} \
    1e+36
test util-16.1.17.37 {8.4 compatible formatting of doubles} \
    {expr 1e37} \
    9.9999999999999995e+36
test util-16.1.17.38 {8.4 compatible formatting of doubles} \
    {expr 1e38} \
    9.9999999999999998e+37
test util-16.1.17.39 {8.4 compatible formatting of doubles} \
    {expr 1e39} \
    9.9999999999999994e+38
test util-16.1.17.40 {8.4 compatible formatting of doubles} \
    {expr 1e40} \
    1e+40
test util-16.1.17.41 {8.4 compatible formatting of doubles} \
    {expr 1e41} \
    1e+41
test util-16.1.17.42 {8.4 compatible formatting of doubles} \
    {expr 1e42} \
    1e+42
test util-16.1.17.43 {8.4 compatible formatting of doubles} \
    {expr 1e43} \
    1e+43
test util-16.1.17.44 {8.4 compatible formatting of doubles} \
    {expr 1e44} \
    1.0000000000000001e+44
test util-16.1.17.45 {8.4 compatible formatting of doubles} \
    {expr 1e45} \
    9.9999999999999993e+44
test util-16.1.17.46 {8.4 compatible formatting of doubles} \
    {expr 1e46} \
    9.9999999999999999e+45
test util-16.1.17.47 {8.4 compatible formatting of doubles} \
    {expr 1e47} \
    1e+47
test util-16.1.17.48 {8.4 compatible formatting of doubles} \
    {expr 1e48} \
    1e+48
test util-16.1.17.49 {8.4 compatible formatting of doubles} \
    {expr 1e49} \
    9.9999999999999995e+48
test util-16.1.17.50 {8.4 compatible formatting of doubles} \
    {expr 1e50} \
    1.0000000000000001e+50
test util-16.1.17.51 {8.4 compatible formatting of doubles} \
    {expr 1e51} \
    9.9999999999999999e+50
test util-16.1.17.52 {8.4 compatible formatting of doubles} \
    {expr 1e52} \
    9.9999999999999999e+51
test util-16.1.17.53 {8.4 compatible formatting of doubles} \
    {expr 1e53} \
    9.9999999999999999e+52
test util-16.1.17.54 {8.4 compatible formatting of doubles} \
    {expr 1e54} \
    1.0000000000000001e+54
test util-16.1.17.55 {8.4 compatible formatting of doubles} \
    {expr 1e55} \
    1e+55
test util-16.1.17.56 {8.4 compatible formatting of doubles} \
    {expr 1e56} \
    1.0000000000000001e+56
test util-16.1.17.57 {8.4 compatible formatting of doubles} \
    {expr 1e57} \
    1e+57
test util-16.1.17.58 {8.4 compatible formatting of doubles} \
    {expr 1e58} \
    9.9999999999999994e+57
test util-16.1.17.59 {8.4 compatible formatting of doubles} \
    {expr 1e59} \
    9.9999999999999997e+58
test util-16.1.17.60 {8.4 compatible formatting of doubles} \
    {expr 1e60} \
    9.9999999999999995e+59
test util-16.1.17.61 {8.4 compatible formatting of doubles} \
    {expr 1e61} \
    9.9999999999999995e+60
test util-16.1.17.62 {8.4 compatible formatting of doubles} \
    {expr 1e62} \
    1e+62
test util-16.1.17.63 {8.4 compatible formatting of doubles} \
    {expr 1e63} \
    1.0000000000000001e+63
test util-16.1.17.64 {8.4 compatible formatting of doubles} \
    {expr 1e64} \
    1e+64
test util-16.1.17.65 {8.4 compatible formatting of doubles} \
    {expr 1e65} \
    9.9999999999999999e+64
test util-16.1.17.66 {8.4 compatible formatting of doubles} \
    {expr 1e66} \
    9.9999999999999995e+65
test util-16.1.17.67 {8.4 compatible formatting of doubles} \
    {expr 1e67} \
    9.9999999999999998e+66
test util-16.1.17.68 {8.4 compatible formatting of doubles} \
    {expr 1e68} \
    9.9999999999999995e+67
test util-16.1.17.69 {8.4 compatible formatting of doubles} \
    {expr 1e69} \
    1.0000000000000001e+69
test util-16.1.17.70 {8.4 compatible formatting of doubles} \
    {expr 1e70} \
    1.0000000000000001e+70
test util-16.1.17.71 {8.4 compatible formatting of doubles} \
    {expr 1e71} \
    1e+71
test util-16.1.17.72 {8.4 compatible formatting of doubles} \
    {expr 1e72} \
    9.9999999999999994e+71
test util-16.1.17.73 {8.4 compatible formatting of doubles} \
    {expr 1e73} \
    9.9999999999999998e+72
test util-16.1.17.74 {8.4 compatible formatting of doubles} \
    {expr 1e74} \
    9.9999999999999995e+73
test util-16.1.17.75 {8.4 compatible formatting of doubles} \
    {expr 1e75} \
    9.9999999999999993e+74
test util-16.1.17.76 {8.4 compatible formatting of doubles} \
    {expr 1e76} \
    1e+76
test util-16.1.17.77 {8.4 compatible formatting of doubles} \
    {expr 1e77} \
    9.9999999999999998e+76
test util-16.1.17.78 {8.4 compatible formatting of doubles} \
    {expr 1e78} \
    1e+78
test util-16.1.17.79 {8.4 compatible formatting of doubles} \
    {expr 1e79} \
    9.9999999999999997e+78
test util-16.1.17.80 {8.4 compatible formatting of doubles} \
    {expr 1e80} \
    1e+80
test util-16.1.17.81 {8.4 compatible formatting of doubles} \
    {expr 1e81} \
    9.9999999999999992e+80
test util-16.1.17.82 {8.4 compatible formatting of doubles} \
    {expr 1e82} \
    9.9999999999999996e+81
test util-16.1.17.83 {8.4 compatible formatting of doubles} \
    {expr 1e83} \
    1e+83
test util-16.1.17.84 {8.4 compatible formatting of doubles} \
    {expr 1e84} \
    1.0000000000000001e+84
test util-16.1.17.85 {8.4 compatible formatting of doubles} \
    {expr 1e85} \
    1e+85
test util-16.1.17.86 {8.4 compatible formatting of doubles} \
    {expr 1e86} \
    1e+86
test util-16.1.17.87 {8.4 compatible formatting of doubles} \
    {expr 1e87} \
    9.9999999999999996e+86
test util-16.1.17.88 {8.4 compatible formatting of doubles} \
    {expr 1e88} \
    9.9999999999999996e+87
test util-16.1.17.89 {8.4 compatible formatting of doubles} \
    {expr 1e89} \
    9.9999999999999999e+88
test util-16.1.17.90 {8.4 compatible formatting of doubles} \
    {expr 1e90} \
    9.9999999999999997e+89
test util-16.1.17.91 {8.4 compatible formatting of doubles} \
    {expr 1e91} \
    1.0000000000000001e+91
test util-16.1.17.92 {8.4 compatible formatting of doubles} \
    {expr 1e92} \
    1e+92
test util-16.1.17.93 {8.4 compatible formatting of doubles} \
    {expr 1e93} \
    1e+93
test util-16.1.17.94 {8.4 compatible formatting of doubles} \
    {expr 1e94} \
    1e+94
test util-16.1.17.95 {8.4 compatible formatting of doubles} \
    {expr 1e95} \
    1e+95
test util-16.1.17.96 {8.4 compatible formatting of doubles} \
    {expr 1e96} \
    1e+96
test util-16.1.17.97 {8.4 compatible formatting of doubles} \
    {expr 1e97} \
    1.0000000000000001e+97
test util-16.1.17.98 {8.4 compatible formatting of doubles} \
    {expr 1e98} \
    1e+98
test util-16.1.17.99 {8.4 compatible formatting of doubles} \
    {expr 1e99} \
    9.9999999999999997e+98
test util-16.1.17.100 {8.4 compatible formatting of doubles} \
    {expr 1e100} \
    1e+100
test util-16.1.17.101 {8.4 compatible formatting of doubles} \
    {expr 1e101} \
    9.9999999999999998e+100
test util-16.1.17.102 {8.4 compatible formatting of doubles} \
    {expr 1e102} \
    9.9999999999999998e+101
test util-16.1.17.103 {8.4 compatible formatting of doubles} \
    {expr 1e103} \
    1e+103
test util-16.1.17.104 {8.4 compatible formatting of doubles} \
    {expr 1e104} \
    1e+104
test util-16.1.17.105 {8.4 compatible formatting of doubles} \
    {expr 1e105} \
    9.9999999999999994e+104
test util-16.1.17.106 {8.4 compatible formatting of doubles} \
    {expr 1e106} \
    1.0000000000000001e+106
test util-16.1.17.107 {8.4 compatible formatting of doubles} \
    {expr 1e107} \
    9.9999999999999997e+106
test util-16.1.17.108 {8.4 compatible formatting of doubles} \
    {expr 1e108} \
    1e+108
test util-16.1.17.109 {8.4 compatible formatting of doubles} \
    {expr 1e109} \
    9.9999999999999998e+108
test util-16.1.17.110 {8.4 compatible formatting of doubles} \
    {expr 1e110} \
    1e+110
test util-16.1.17.111 {8.4 compatible formatting of doubles} \
    {expr 1e111} \
    9.9999999999999996e+110
test util-16.1.17.112 {8.4 compatible formatting of doubles} \
    {expr 1e112} \
    9.9999999999999993e+111
test util-16.1.17.113 {8.4 compatible formatting of doubles} \
    {expr 1e113} \
    1e+113
test util-16.1.17.114 {8.4 compatible formatting of doubles} \
    {expr 1e114} \
    1e+114
test util-16.1.17.115 {8.4 compatible formatting of doubles} \
    {expr 1e115} \
    1e+115
test util-16.1.17.116 {8.4 compatible formatting of doubles} \
    {expr 1e116} \
    1e+116
test util-16.1.17.117 {8.4 compatible formatting of doubles} \
    {expr 1e117} \
    1.0000000000000001e+117
test util-16.1.17.118 {8.4 compatible formatting of doubles} \
    {expr 1e118} \
    9.9999999999999997e+117
test util-16.1.17.119 {8.4 compatible formatting of doubles} \
    {expr 1e119} \
    9.9999999999999994e+118
test util-16.1.17.120 {8.4 compatible formatting of doubles} \
    {expr 1e120} \
    9.9999999999999998e+119
test util-16.1.17.121 {8.4 compatible formatting of doubles} \
    {expr 1e121} \
    1e+121
test util-16.1.17.122 {8.4 compatible formatting of doubles} \
    {expr 1e122} \
    1e+122
test util-16.1.17.123 {8.4 compatible formatting of doubles} \
    {expr 1e123} \
    9.9999999999999998e+122
test util-16.1.17.124 {8.4 compatible formatting of doubles} \
    {expr 1e124} \
    9.9999999999999995e+123
test util-16.1.17.125 {8.4 compatible formatting of doubles} \
    {expr 1e125} \
    9.9999999999999992e+124
test util-16.1.17.126 {8.4 compatible formatting of doubles} \
    {expr 1e126} \
    9.9999999999999992e+125
test util-16.1.17.127 {8.4 compatible formatting of doubles} \
    {expr 1e127} \
    9.9999999999999995e+126
test util-16.1.17.128 {8.4 compatible formatting of doubles} \
    {expr 1e128} \
    1.0000000000000001e+128
test util-16.1.17.129 {8.4 compatible formatting of doubles} \
    {expr 1e129} \
    1e+129
test util-16.1.17.130 {8.4 compatible formatting of doubles} \
    {expr 1e130} \
    1.0000000000000001e+130
test util-16.1.17.131 {8.4 compatible formatting of doubles} \
    {expr 1e131} \
    9.9999999999999991e+130
test util-16.1.17.132 {8.4 compatible formatting of doubles} \
    {expr 1e132} \
    9.9999999999999999e+131
test util-16.1.17.133 {8.4 compatible formatting of doubles} \
    {expr 1e133} \
    1e+133
test util-16.1.17.134 {8.4 compatible formatting of doubles} \
    {expr 1e134} \
    9.9999999999999992e+133
test util-16.1.17.135 {8.4 compatible formatting of doubles} \
    {expr 1e135} \
    9.9999999999999996e+134
test util-16.1.17.136 {8.4 compatible formatting of doubles} \
    {expr 1e136} \
    1.0000000000000001e+136
test util-16.1.17.137 {8.4 compatible formatting of doubles} \
    {expr 1e137} \
    1e+137
test util-16.1.17.138 {8.4 compatible formatting of doubles} \
    {expr 1e138} \
    1e+138
test util-16.1.17.139 {8.4 compatible formatting of doubles} \
    {expr 1e139} \
    1e+139
test util-16.1.17.140 {8.4 compatible formatting of doubles} \
    {expr 1e140} \
    1.0000000000000001e+140
test util-16.1.17.141 {8.4 compatible formatting of doubles} \
    {expr 1e141} \
    1e+141
test util-16.1.17.142 {8.4 compatible formatting of doubles} \
    {expr 1e142} \
    1.0000000000000001e+142
test util-16.1.17.143 {8.4 compatible formatting of doubles} \
    {expr 1e143} \
    1e+143
test util-16.1.17.144 {8.4 compatible formatting of doubles} \
    {expr 1e144} \
    1e+144
test util-16.1.17.145 {8.4 compatible formatting of doubles} \
    {expr 1e145} \
    9.9999999999999999e+144
test util-16.1.17.146 {8.4 compatible formatting of doubles} \
    {expr 1e146} \
    9.9999999999999993e+145
test util-16.1.17.147 {8.4 compatible formatting of doubles} \
    {expr 1e147} \
    9.9999999999999998e+146
test util-16.1.17.148 {8.4 compatible formatting of doubles} \
    {expr 1e148} \
    1e+148
test util-16.1.17.149 {8.4 compatible formatting of doubles} \
    {expr 1e149} \
    1e+149
test util-16.1.17.150 {8.4 compatible formatting of doubles} \
    {expr 1e150} \
    9.9999999999999998e+149
test util-16.1.17.151 {8.4 compatible formatting of doubles} \
    {expr 1e151} \
    1e+151
test util-16.1.17.152 {8.4 compatible formatting of doubles} \
    {expr 1e152} \
    1e+152
test util-16.1.17.153 {8.4 compatible formatting of doubles} \
    {expr 1e153} \
    1e+153
test util-16.1.17.154 {8.4 compatible formatting of doubles} \
    {expr 1e154} \
    1e+154
test util-16.1.17.155 {8.4 compatible formatting of doubles} \
    {expr 1e155} \
    1e+155
test util-16.1.17.156 {8.4 compatible formatting of doubles} \
    {expr 1e156} \
    9.9999999999999998e+155
test util-16.1.17.157 {8.4 compatible formatting of doubles} \
    {expr 1e157} \
    9.9999999999999998e+156
test util-16.1.17.158 {8.4 compatible formatting of doubles} \
    {expr 1e158} \
    9.9999999999999995e+157
test util-16.1.17.159 {8.4 compatible formatting of doubles} \
    {expr 1e159} \
    9.9999999999999993e+158
test util-16.1.17.160 {8.4 compatible formatting of doubles} \
    {expr 1e160} \
    1e+160
test util-16.1.17.161 {8.4 compatible formatting of doubles} \
    {expr 1e161} \
    1e+161
test util-16.1.17.162 {8.4 compatible formatting of doubles} \
    {expr 1e162} \
    9.9999999999999994e+161
test util-16.1.17.163 {8.4 compatible formatting of doubles} \
    {expr 1e163} \
    9.9999999999999994e+162
test util-16.1.17.164 {8.4 compatible formatting of doubles} \
    {expr 1e164} \
    1e+164
test util-16.1.17.165 {8.4 compatible formatting of doubles} \
    {expr 1e165} \
    9.999999999999999e+164
test util-16.1.17.166 {8.4 compatible formatting of doubles} \
    {expr 1e166} \
    9.9999999999999994e+165
test util-16.1.17.167 {8.4 compatible formatting of doubles} \
    {expr 1e167} \
    1e+167
test util-16.1.17.168 {8.4 compatible formatting of doubles} \
    {expr 1e168} \
    9.9999999999999993e+167
test util-16.1.17.169 {8.4 compatible formatting of doubles} \
    {expr 1e169} \
    9.9999999999999993e+168
test util-16.1.17.170 {8.4 compatible formatting of doubles} \
    {expr 1e170} \
    1e+170
test util-16.1.17.171 {8.4 compatible formatting of doubles} \
    {expr 1e171} \
    9.9999999999999995e+170
test util-16.1.17.172 {8.4 compatible formatting of doubles} \
    {expr 1e172} \
    1.0000000000000001e+172
test util-16.1.17.173 {8.4 compatible formatting of doubles} \
    {expr 1e173} \
    1e+173
test util-16.1.17.174 {8.4 compatible formatting of doubles} \
    {expr 1e174} \
    1.0000000000000001e+174
test util-16.1.17.175 {8.4 compatible formatting of doubles} \
    {expr 1e175} \
    9.9999999999999994e+174
test util-16.1.17.176 {8.4 compatible formatting of doubles} \
    {expr 1e176} \
    1e+176
test util-16.1.17.177 {8.4 compatible formatting of doubles} \
    {expr 1e177} \
    1e+177
test util-16.1.17.178 {8.4 compatible formatting of doubles} \
    {expr 1e178} \
    1.0000000000000001e+178
test util-16.1.17.179 {8.4 compatible formatting of doubles} \
    {expr 1e179} \
    9.9999999999999998e+178
test util-16.1.17.180 {8.4 compatible formatting of doubles} \
    {expr 1e180} \
    1e+180
test util-16.1.17.181 {8.4 compatible formatting of doubles} \
    {expr 1e181} \
    9.9999999999999992e+180
test util-16.1.17.182 {8.4 compatible formatting of doubles} \
    {expr 1e182} \
    1.0000000000000001e+182
test util-16.1.17.183 {8.4 compatible formatting of doubles} \
    {expr 1e183} \
    9.9999999999999995e+182
test util-16.1.17.184 {8.4 compatible formatting of doubles} \
    {expr 1e184} \
    1e+184
test util-16.1.17.185 {8.4 compatible formatting of doubles} \
    {expr 1e185} \
    9.9999999999999998e+184
test util-16.1.17.186 {8.4 compatible formatting of doubles} \
    {expr 1e186} \
    9.9999999999999998e+185
test util-16.1.17.187 {8.4 compatible formatting of doubles} \
    {expr 1e187} \
    9.9999999999999991e+186
test util-16.1.17.188 {8.4 compatible formatting of doubles} \
    {expr 1e188} \
    1e+188
test util-16.1.17.189 {8.4 compatible formatting of doubles} \
    {expr 1e189} \
    1e+189
test util-16.1.17.190 {8.4 compatible formatting of doubles} \
    {expr 1e190} \
    1.0000000000000001e+190
test util-16.1.17.191 {8.4 compatible formatting of doubles} \
    {expr 1e191} \
    1.0000000000000001e+191
test util-16.1.17.192 {8.4 compatible formatting of doubles} \
    {expr 1e192} \
    1e+192
test util-16.1.17.193 {8.4 compatible formatting of doubles} \
    {expr 1e193} \
    1.0000000000000001e+193
test util-16.1.17.194 {8.4 compatible formatting of doubles} \
    {expr 1e194} \
    9.9999999999999994e+193
test util-16.1.17.195 {8.4 compatible formatting of doubles} \
    {expr 1e195} \
    9.9999999999999998e+194
test util-16.1.17.196 {8.4 compatible formatting of doubles} \
    {expr 1e196} \
    9.9999999999999995e+195
test util-16.1.17.197 {8.4 compatible formatting of doubles} \
    {expr 1e197} \
    9.9999999999999995e+196
test util-16.1.17.198 {8.4 compatible formatting of doubles} \
    {expr 1e198} \
    1e+198
test util-16.1.17.199 {8.4 compatible formatting of doubles} \
    {expr 1e199} \
    1.0000000000000001e+199
test util-16.1.17.200 {8.4 compatible formatting of doubles} \
    {expr 1e200} \
    9.9999999999999997e+199
test util-16.1.17.201 {8.4 compatible formatting of doubles} \
    {expr 1e201} \
    1e+201
test util-16.1.17.202 {8.4 compatible formatting of doubles} \
    {expr 1e202} \
    9.999999999999999e+201
test util-16.1.17.203 {8.4 compatible formatting of doubles} \
    {expr 1e203} \
    9.9999999999999999e+202
test util-16.1.17.204 {8.4 compatible formatting of doubles} \
    {expr 1e204} \
    9.9999999999999999e+203
test util-16.1.17.205 {8.4 compatible formatting of doubles} \
    {expr 1e205} \
    1e+205
test util-16.1.17.206 {8.4 compatible formatting of doubles} \
    {expr 1e206} \
    1e+206
test util-16.1.17.207 {8.4 compatible formatting of doubles} \
    {expr 1e207} \
    1e+207
test util-16.1.17.208 {8.4 compatible formatting of doubles} \
    {expr 1e208} \
    9.9999999999999998e+207
test util-16.1.17.209 {8.4 compatible formatting of doubles} \
    {expr 1e209} \
    1.0000000000000001e+209
test util-16.1.17.210 {8.4 compatible formatting of doubles} \
    {expr 1e210} \
    9.9999999999999993e+209
test util-16.1.17.211 {8.4 compatible formatting of doubles} \
    {expr 1e211} \
    9.9999999999999996e+210
test util-16.1.17.212 {8.4 compatible formatting of doubles} \
    {expr 1e212} \
    9.9999999999999991e+211
test util-16.1.17.213 {8.4 compatible formatting of doubles} \
    {expr 1e213} \
    9.9999999999999998e+212
test util-16.1.17.214 {8.4 compatible formatting of doubles} \
    {expr 1e214} \
    9.9999999999999995e+213
test util-16.1.17.215 {8.4 compatible formatting of doubles} \
    {expr 1e215} \
    9.9999999999999991e+214
test util-16.1.17.216 {8.4 compatible formatting of doubles} \
    {expr 1e216} \
    1e+216
test util-16.1.17.217 {8.4 compatible formatting of doubles} \
    {expr 1e217} \
    9.9999999999999996e+216
test util-16.1.17.218 {8.4 compatible formatting of doubles} \
    {expr 1e218} \
    1.0000000000000001e+218
test util-16.1.17.219 {8.4 compatible formatting of doubles} \
    {expr 1e219} \
    9.9999999999999997e+218
test util-16.1.17.220 {8.4 compatible formatting of doubles} \
    {expr 1e220} \
    1e+220
test util-16.1.17.221 {8.4 compatible formatting of doubles} \
    {expr 1e221} \
    1e+221
test util-16.1.17.222 {8.4 compatible formatting of doubles} \
    {expr 1e222} \
    1e+222
test util-16.1.17.223 {8.4 compatible formatting of doubles} \
    {expr 1e223} \
    1e+223
test util-16.1.17.224 {8.4 compatible formatting of doubles} \
    {expr 1e224} \
    9.9999999999999997e+223
test util-16.1.17.225 {8.4 compatible formatting of doubles} \
    {expr 1e225} \
    9.9999999999999993e+224
test util-16.1.17.226 {8.4 compatible formatting of doubles} \
    {expr 1e226} \
    9.9999999999999996e+225
test util-16.1.17.227 {8.4 compatible formatting of doubles} \
    {expr 1e227} \
    1.0000000000000001e+227
test util-16.1.17.228 {8.4 compatible formatting of doubles} \
    {expr 1e228} \
    9.9999999999999992e+227
test util-16.1.17.229 {8.4 compatible formatting of doubles} \
    {expr 1e229} \
    9.9999999999999999e+228
test util-16.1.17.230 {8.4 compatible formatting of doubles} \
    {expr 1e230} \
    1.0000000000000001e+230
test util-16.1.17.231 {8.4 compatible formatting of doubles} \
    {expr 1e231} \
    1.0000000000000001e+231
test util-16.1.17.232 {8.4 compatible formatting of doubles} \
    {expr 1e232} \
    1.0000000000000001e+232
test util-16.1.17.233 {8.4 compatible formatting of doubles} \
    {expr 1e233} \
    9.9999999999999997e+232
test util-16.1.17.234 {8.4 compatible formatting of doubles} \
    {expr 1e234} \
    1e+234
test util-16.1.17.235 {8.4 compatible formatting of doubles} \
    {expr 1e235} \
    1.0000000000000001e+235
test util-16.1.17.236 {8.4 compatible formatting of doubles} \
    {expr 1e236} \
    1.0000000000000001e+236
test util-16.1.17.237 {8.4 compatible formatting of doubles} \
    {expr 1e237} \
    9.9999999999999994e+236
test util-16.1.17.238 {8.4 compatible formatting of doubles} \
    {expr 1e238} \
    1e+238
test util-16.1.17.239 {8.4 compatible formatting of doubles} \
    {expr 1e239} \
    9.9999999999999999e+238
test util-16.1.17.240 {8.4 compatible formatting of doubles} \
    {expr 1e240} \
    1e+240
test util-16.1.17.241 {8.4 compatible formatting of doubles} \
    {expr 1e241} \
    1.0000000000000001e+241
test util-16.1.17.242 {8.4 compatible formatting of doubles} \
    {expr 1e242} \
    1.0000000000000001e+242
test util-16.1.17.243 {8.4 compatible formatting of doubles} \
    {expr 1e243} \
    1.0000000000000001e+243
test util-16.1.17.244 {8.4 compatible formatting of doubles} \
    {expr 1e244} \
    1.0000000000000001e+244
test util-16.1.17.245 {8.4 compatible formatting of doubles} \
    {expr 1e245} \
    1e+245
test util-16.1.17.246 {8.4 compatible formatting of doubles} \
    {expr 1e246} \
    1.0000000000000001e+246
test util-16.1.17.247 {8.4 compatible formatting of doubles} \
    {expr 1e247} \
    9.9999999999999995e+246
test util-16.1.17.248 {8.4 compatible formatting of doubles} \
    {expr 1e248} \
    1e+248
test util-16.1.17.249 {8.4 compatible formatting of doubles} \
    {expr 1e249} \
    9.9999999999999992e+248
test util-16.1.17.250 {8.4 compatible formatting of doubles} \
    {expr 1e250} \
    9.9999999999999992e+249
test util-16.1.17.251 {8.4 compatible formatting of doubles} \
    {expr 1e251} \
    1e+251
test util-16.1.17.252 {8.4 compatible formatting of doubles} \
    {expr 1e252} \
    1.0000000000000001e+252
test util-16.1.17.253 {8.4 compatible formatting of doubles} \
    {expr 1e253} \
    9.9999999999999994e+252
test util-16.1.17.254 {8.4 compatible formatting of doubles} \
    {expr 1e254} \
    9.9999999999999994e+253
test util-16.1.17.255 {8.4 compatible formatting of doubles} \
    {expr 1e255} \
    9.9999999999999999e+254
test util-16.1.17.256 {8.4 compatible formatting of doubles} \
    {expr 1e256} \
    1e+256
test util-16.1.17.257 {8.4 compatible formatting of doubles} \
    {expr 1e257} \
    1e+257
test util-16.1.17.258 {8.4 compatible formatting of doubles} \
    {expr 1e258} \
    1.0000000000000001e+258
test util-16.1.17.259 {8.4 compatible formatting of doubles} \
    {expr 1e259} \
    9.9999999999999993e+258
test util-16.1.17.260 {8.4 compatible formatting of doubles} \
    {expr 1e260} \
    1.0000000000000001e+260
test util-16.1.17.261 {8.4 compatible formatting of doubles} \
    {expr 1e261} \
    9.9999999999999993e+260
test util-16.1.17.262 {8.4 compatible formatting of doubles} \
    {expr 1e262} \
    1e+262
test util-16.1.17.263 {8.4 compatible formatting of doubles} \
    {expr 1e263} \
    1e+263
test util-16.1.17.264 {8.4 compatible formatting of doubles} \
    {expr 1e264} \
    1e+264
test util-16.1.17.265 {8.4 compatible formatting of doubles} \
    {expr 1e265} \
    1.0000000000000001e+265
test util-16.1.17.266 {8.4 compatible formatting of doubles} \
    {expr 1e266} \
    1e+266
test util-16.1.17.267 {8.4 compatible formatting of doubles} \
    {expr 1e267} \
    9.9999999999999997e+266
test util-16.1.17.268 {8.4 compatible formatting of doubles} \
    {expr 1e268} \
    9.9999999999999997e+267
test util-16.1.17.269 {8.4 compatible formatting of doubles} \
    {expr 1e269} \
    1e+269
test util-16.1.17.270 {8.4 compatible formatting of doubles} \
    {expr 1e270} \
    1e+270
test util-16.1.17.271 {8.4 compatible formatting of doubles} \
    {expr 1e271} \
    9.9999999999999995e+270
test util-16.1.17.272 {8.4 compatible formatting of doubles} \
    {expr 1e272} \
    1.0000000000000001e+272
test util-16.1.17.273 {8.4 compatible formatting of doubles} \
    {expr 1e273} \
    9.9999999999999995e+272
test util-16.1.17.274 {8.4 compatible formatting of doubles} \
    {expr 1e274} \
    9.9999999999999992e+273
test util-16.1.17.275 {8.4 compatible formatting of doubles} \
    {expr 1e275} \
    9.9999999999999996e+274
test util-16.1.17.276 {8.4 compatible formatting of doubles} \
    {expr 1e276} \
    1.0000000000000001e+276
test util-16.1.17.277 {8.4 compatible formatting of doubles} \
    {expr 1e277} \
    1e+277
test util-16.1.17.278 {8.4 compatible formatting of doubles} \
    {expr 1e278} \
    9.9999999999999996e+277
test util-16.1.17.279 {8.4 compatible formatting of doubles} \
    {expr 1e279} \
    1.0000000000000001e+279
test util-16.1.17.280 {8.4 compatible formatting of doubles} \
    {expr 1e280} \
    1e+280
test util-16.1.17.281 {8.4 compatible formatting of doubles} \
    {expr 1e281} \
    1e+281
test util-16.1.17.282 {8.4 compatible formatting of doubles} \
    {expr 1e282} \
    1e+282
test util-16.1.17.283 {8.4 compatible formatting of doubles} \
    {expr 1e283} \
    9.9999999999999996e+282
test util-16.1.17.284 {8.4 compatible formatting of doubles} \
    {expr 1e284} \
    1.0000000000000001e+284
test util-16.1.17.285 {8.4 compatible formatting of doubles} \
    {expr 1e285} \
    9.9999999999999998e+284
test util-16.1.17.286 {8.4 compatible formatting of doubles} \
    {expr 1e286} \
    1e+286
test util-16.1.17.287 {8.4 compatible formatting of doubles} \
    {expr 1e287} \
    1.0000000000000001e+287
test util-16.1.17.288 {8.4 compatible formatting of doubles} \
    {expr 1e288} \
    1e+288
test util-16.1.17.289 {8.4 compatible formatting of doubles} \
    {expr 1e289} \
    1.0000000000000001e+289
test util-16.1.17.290 {8.4 compatible formatting of doubles} \
    {expr 1e290} \
    1.0000000000000001e+290
test util-16.1.17.291 {8.4 compatible formatting of doubles} \
    {expr 1e291} \
    9.9999999999999996e+290
test util-16.1.17.292 {8.4 compatible formatting of doubles} \
    {expr 1e292} \
    1e+292
test util-16.1.17.293 {8.4 compatible formatting of doubles} \
    {expr 1e293} \
    9.9999999999999992e+292
test util-16.1.17.294 {8.4 compatible formatting of doubles} \
    {expr 1e294} \
    1.0000000000000001e+294
test util-16.1.17.295 {8.4 compatible formatting of doubles} \
    {expr 1e295} \
    9.9999999999999998e+294
test util-16.1.17.296 {8.4 compatible formatting of doubles} \
    {expr 1e296} \
    9.9999999999999998e+295
test util-16.1.17.297 {8.4 compatible formatting of doubles} \
    {expr 1e297} \
    1e+297
test util-16.1.17.298 {8.4 compatible formatting of doubles} \
    {expr 1e298} \
    9.9999999999999996e+297
test util-16.1.17.299 {8.4 compatible formatting of doubles} \
    {expr 1e299} \
    1.0000000000000001e+299
test util-16.1.17.300 {8.4 compatible formatting of doubles} \
    {expr 1e300} \
    1.0000000000000001e+300
test util-16.1.17.301 {8.4 compatible formatting of doubles} \
    {expr 1e301} \
    1.0000000000000001e+301
test util-16.1.17.302 {8.4 compatible formatting of doubles} \
    {expr 1e302} \
    1.0000000000000001e+302
test util-16.1.17.303 {8.4 compatible formatting of doubles} \
    {expr 1e303} \
    1e+303
test util-16.1.17.304 {8.4 compatible formatting of doubles} \
    {expr 1e304} \
    9.9999999999999994e+303
test util-16.1.17.305 {8.4 compatible formatting of doubles} \
    {expr 1e305} \
    9.9999999999999994e+304
test util-16.1.17.306 {8.4 compatible formatting of doubles} \
    {expr 1e306} \
    1e+306
test util-16.1.17.307 {8.4 compatible formatting of doubles} \
    {expr 1e307} \
    9.9999999999999999e+306

test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
    set r {}
    foreach {input} {
	0x1ffffffffffffc000
	0x1ffffffffffffc800
	0x1ffffffffffffd000
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
4050
4051
4052
4053
4054
4055
4056




4057












































4058
4059
4060
4061
4062
4063
4064







-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43fffffffffffffe 0xc3fffffffffffffe
    0x43ffffffffffffff 0xc3ffffffffffffff
    0x4400000000000000 0xc400000000000000
}]

test util-18.1 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr 2**63-1]
} {9223372036854775807}

set ::tcl_precision $saved_precision
test util-18.2 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr 2**63-1]
} {9223372036854775807}

test util-18.3 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr 2**63-1]
} {9223372036854775807}

test util-18.4 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr 2**63-1]
} {9223372036854775807}

test util-18.5 {Tcl_ObjPrintf} {testprint} {
    testprint %lld [expr -2**63]
} {-9223372036854775808}

test util-18.6 {Tcl_ObjPrintf} {testprint} {
    testprint %I64d [expr -2**63]
} {-9223372036854775808}

test util-18.7 {Tcl_ObjPrintf} {testprint} {
    testprint %qd [expr -2**63]
} {-9223372036854775808}

test util-18.8 {Tcl_ObjPrintf} {testprint} {
    testprint %jd [expr -2**63]
} {-9223372036854775808}

test util-18.9 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %I32d" [expr -2**63+2]
} {-9223372036854775806 2}

test util-18.10 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %p" 65535
} {65535 0xffff}

test util-18.11 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %td" 65536
} {65536 65536}

test util-18.12 {Tcl_ObjPrintf} {testprint} {
    testprint "%I64d %Id" 65537
} {65537 65537}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/var.test.

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






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
-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+




-
-
+
+

-
-
+
+



-
-
-



















-









-
+

-
-
+



-
-
-
-
+
+
+
+
+
-
-
-







# This file contains tests for the tclVar.c source file. Tests appear in the
# same order as the C code that they test. The set of tests is currently
# incomplete since it currently includes only new tests for code changed for
# the addition of Tcl namespaces. Other variable-related tests appear in
# several other test files including namespace.test, set.test, trace.test, and
# upvar.test.
# This file contains tests for the tclVar.c source file. Tests appear in
# the same order as the C code that they test. The set of tests is
# currently incomplete since it currently includes only new tests for
# code changed for the addition of Tcl namespaces. Other variable-
# related tests appear in several other test files including
# namespace.test, set.test, trace.test, and upvar.test.
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
# Sourcing this file into Tcl runs the tests and generates output for
# errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2.2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testupvar [llength [info commands testupvar]]
testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
testConstraint testsetnoerr [llength [info commands testsetnoerr]]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {
        return [lindex [split [memory info] \n] 3 3]
    }
    proc leaktest {script {iterations 3}} {
        set end [getbytes]
        for {set i 0} {$i < $iterations} {incr i} {
            uplevel 1 $script
            set tmp $end
            set end [getbytes]
        }
        return [expr {$end - $tmp}]
    }
}


catch {rename p ""}
catch {namespace delete test_ns_var}
catch {unset xx}
catch {unset x}
catch {unset y}
catch {unset i}
catch {unset a}
catch {unset arr}

test var-1.1 {TclLookupVar, Array handling} -setup {
test var-1.1 {TclLookupVar, Array handling} {
    catch {unset a}
} -body {
    set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd
    set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd 
    set i 10
    set arr(foo) 37
    list [$x i] $i [$x arr(foo)] $arr(foo)
} -result {11 11 38 38}
set ::x "global value"
namespace eval test_ns_var {
    variable x "namespace value"
} {11 11 38 38}
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
    set x "global value"
    namespace eval test_ns_var {
        variable x "namespace value"
}
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
    namespace eval test_ns_var {
        proc p {} {
            global x  ;# specifies TCL_GLOBAL_ONLY to get global x
            return $x
        }
    }
    test_ns_var::p
} {global value}
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
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







-
-
-
-
-
-
+
+
+
+
+
+





-
+

-




-
-
+
+

-
+

-
-
+
+

-
+

-
+

















-
-
-
+
+
+







} {global value}
test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies namespace var} {
    namespace eval test_ns_var {set x}
} {namespace value}
test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
    namespace eval test_ns_var {set ::x}
} {global value}
test var-1.7 {TclLookupVar, error finding namespace var} -body {
    set a:::b
} -returnCodes error -result {can't read "a:::b": no such variable}
test var-1.8 {TclLookupVar, error finding namespace var} -body {
    set ::foobarfoo
} -returnCodes error -result {can't read "::foobarfoo": no such variable}
test var-1.7 {TclLookupVar, error finding namespace var} {
    list [catch {set a:::b} msg] $msg
} {1 {can't read "a:::b": no such variable}}
test var-1.8 {TclLookupVar, error finding namespace var} {
    list [catch {set ::foobarfoo} msg] $msg
} {1 {can't read "::foobarfoo": no such variable}}
test var-1.9 {TclLookupVar, create new namespace var} {
    namespace eval test_ns_var {
        set v hello
    }
} {hello}
test var-1.10 {TclLookupVar, create new namespace var} -setup {
test var-1.10 {TclLookupVar, create new namespace var} {
    catch {unset y}
} -body {
    namespace eval test_ns_var {
        set ::y 789
    }
    set y
} -result {789}
test var-1.11 {TclLookupVar, error creating new namespace var} -body {
} {789}
test var-1.11 {TclLookupVar, error creating new namespace var} {
    namespace eval test_ns_var {
        set ::test_ns_var::foo::bar 314159
        list [catch {set ::test_ns_var::foo::bar 314159} msg] $msg
    }
} -returnCodes error -result {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}
test var-1.12 {TclLookupVar, error creating new namespace var} -body {
} {1 {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}}
test var-1.12 {TclLookupVar, error creating new namespace var} {
    namespace eval test_ns_var {
        set ::test_ns_var::foo:: 1997
        list [catch {set ::test_ns_var::foo:: 1997} msg] $msg
    }
} -returnCodes error -result {can't set "::test_ns_var::foo::": parent namespace doesn't exist}
} {1 {can't set "::test_ns_var::foo::": parent namespace doesn't exist}}
test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
    catch {unset aNeWnAmEiNnS}
    namespace eval test_ns_var {
        namespace eval test_ns_var2::test_ns_var3 {
            set aNeWnAmEiNnS 77777
        }
        # namespace which builds a name by traversing nsPtr chain to ::
        namespace which -variable test_ns_var2::test_ns_var3::aNeWnAmEiNnS
    }
} {::test_ns_var::test_ns_var2::test_ns_var3::aNeWnAmEiNnS}
test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of var names} {
    namespace eval test_ns_var {
        set : 123
        set v: 456
        set x:y: 789
        list [set :] [set v:] [set x:y:] \
             ${:} ${v:} ${x:y:} \
             [expr {":" in [info vars]}] \
             [expr {"v:" in [info vars]}] \
             [expr {"x:y:" in [info vars]}]
             [expr {[lsearch [info vars] :] != -1}] \
             [expr {[lsearch [info vars] v:] != -1}] \
             [expr {[lsearch [info vars] x:y:] != -1}]
    }
} {123 456 789 123 456 789 1 1 1}
test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
    namespace eval test_ns_var {
	variable foo 2
    }
    proc p {} {
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
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
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

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
611
612
613

614
615
616

617
618

619
620
621
622
623
624
625
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




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
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
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
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
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
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
611

612




613
614
615
616
617


618
619




620
621
622
623
624

625
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
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







-
+
-
-











-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+

-






-
+











-
+

-



-
+


-
-
+
+

-





-
+



-

-
-
+
+


-



-
-
+
+

-





-
-
+
+

-





-
-
+
+
-


-




-
-
+
+

-

-
+
-
-
-
-
+
+

-
+


-
+
+
+

-
-
+
+

-


-
+












-
+

-

-
-
+
+

-
+

-


-
+






-
+
-
-

-
+





-
+


-
+
+














-

-
+


-
+
+











-
-
-
-
-
-
-
+
-
-
-
-
+

-




-
+







-
+
-
-
-





-
-
+
+
-
-
-





-
-
+
+



-





-
+



-


+
-
+
-
-
+
-
+



-
-
-
+
+
+
-
-
+

-
+

-
+




-
+

-
+



-
+

-



















+
-
+







-
+
-
-







-
-
+
+
-
-





-
+




















-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+

-
+

-
+

-
+


-



+




+



-
-
+
+
+


-





+



+

-
+

















-
-
+
+
-
-

-
-
-
-
-
-
+
+
+
+
+
+

-


-
-
-
-
-
-
+
+
+
+
+
+

-

-
-
-
-
+
+
+
+

-


-
-
-
-
+
+
+
+

-

-
-
-
-
+
+
+
+

-

-
-
-
-
+
+
+
+

-
-
+

-
-
-
-
+
+
+
+

-


-
-
-
-
+
+
+
+
-
-
-

+




-
-
-
+
+
+





-
-
+
+

-
+
-
-
-

+




-
-
-
+
+
+





-
-
+
+


-
+

-
-
-
-
+
+
+

-
-
-
+
+

-
+

-



-
-
+
+

-



-
-
+
+

-

-
-
+
+
















-
+

-










-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




+


-
+







-
+






-
+
-
-







	    lappend result [catch {set foo 3} msg] $msg
	}
	set result [p]
        namespace delete [namespace current]
	set result
    }
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
    unset -nocomplain test_ns_var::x
} -body {
    namespace eval test_ns_var {
	variable result {}
	variable x
	array set x {1 2 3 4}
	upvar 0 x(1) foo
	lappend result [catch {set foo} msg] $msg
	unset x
	lappend result [catch {set foo 3} msg] $msg
        namespace delete [namespace current]
	set result
    }
} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
    [format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} {
    list [catch {[format set] thisvar(doesntexist)} msg] $msg
} {1 {can't read "thisvar(doesntexist)": no such variable}}
test var-1.20 {TclLookupVar, regression on utf-8 variable names} -setup {
    proc p [list \u20ac \xe4] {info vars}
} -body {
    # test variable with non-ascii name is available (euro and a-uml chars here):
    list \
	[p 1 2] \
	[apply [list [list \u20ac \xe4] {info vars}] 1 2] \
	[apply [list [list [list \u20ac \u20ac] [list \xe4 \xe4]] {info vars}]] \
} -cleanup {
    rename p {}
} -result [lrepeat 3 [list \u20ac \xe4]]
test var-1.21 {TclLookupVar, regression on utf-8 variable names} -setup {
    proc p [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]}
} -body {
    # test variable with non-ascii name (and default) is resolvable (euro and a-uml chars here):
    list \
	[p] \
	[apply [list [list \u20ac \xe4] {list [set \u20ac] [set \xe4]}] v\u20ac v\xe4] \
	[apply [list [list [list \u20ac v\u20ac] [list \xe4 v\xe4]] {list [set \u20ac] [set \xe4]}]] \
} -cleanup {
    rename p {}
} -result [lrepeat 3 [list v\u20ac v\xe4]]

test var-2.1 {Tcl_LappendObjCmd, create var if new} {
    catch {unset x}
    lappend x 1 2
} {1 2}

test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} -setup {
test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} {
    catch {unset x}
} -body {
    set x 1997
    proc p {} {
        global x  ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
        return $x
    }
    p
} -result {1997}
} {1997}
test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
    namespace eval test_ns_var {
        catch {unset v}
        variable v 1998
        proc p {} {
            variable v  ;# TCL_NAMESPACE_ONLY specified for other var x
            return $v
        }
        p
    }
} {1998}
test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} testupvar {
    catch {unset a}
} -constraints testupvar -body {
    set a 123321
    proc p {} {
	# create global xx linked to global a
	testupvar 1 a {} xx global
	testupvar 1 a {} xx global 
    }
    list [p] $xx [set xx 789] $a
} -result {{} 123321 789 789}
test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
} {{} 123321 789 789}
test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} testupvar {
    catch {unset a}
} -constraints testupvar -body {
    set a 456
    namespace eval test_ns_var {
	catch {unset ::test_ns_var::vv}
	proc p {} {
	    # create namespace var vv linked to global a
	    testupvar 2 a {} vv namespace
	    testupvar 1 a {} vv namespace 
	}
	p
    }
    # Modified: that should create a global var according to the docs!
    list $test_ns_var::vv [set test_ns_var::vv 123] $a
} -result {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
} {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
    catch {unset aaaaa}
    catch {unset xxxxx}
} -body {
    set aaaaa 77777
    upvar #0 aaaaa xxxxx
    list [set xxxxx] [set aaaaa]
} -result {77777 77777}
test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} -setup {
} {77777 77777}
test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} {
    catch {unset a}
} -body {
    set a 121212
    namespace eval test_ns_var {
        upvar ::a vvv
        set vvv
    }
} -result {121212}
test var-3.7 {MakeUpvar, my var has ::s} -setup {
} {121212}
test var-3.7 {MakeUpvar, my var has ::s} {
    catch {unset a}
} -body {
    set a 789789
    upvar #0 a test_ns_var::lnk
    namespace eval test_ns_var {
        set lnk
    }
} -result {789789}
test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
} {789789}
test var-3.8 {MakeUpvar, my var already exists in global ns} {
    upvar #0 aaaaa xxxxx
    catch {unset aaaaa}
    catch {unset xxxxx}
} -body {
    set aaaaa 456654
    set xxxxx hello
    upvar #0 aaaaa xxxxx
    set xxxxx
} -result {hello}
test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
} {hello}
test var-3.9 {MakeUpvar, my var has invalid ns name} {
    catch {unset aaaaa}
} -returnCodes error -body {
    set aaaaa 789789
    upvar #0 aaaaa test_ns_fred::lnk
    list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg
} -cleanup {
    unset ::aaaaa
} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
test var-3.10 {MakeUpvar, between namespaces} -body {
} {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}}
test var-3.10 {MakeUpvar, } {
    namespace eval {} {
	variable bar 0
	set bar 0
	namespace eval foo upvar bar bar
	set foo::bar 1
	list $bar $foo::bar
	catch {list $bar $foo::bar} msg
	unset ::aaaaa
	set msg
    }
} -result {1 1}
test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
} {1 1}
test var-3.11 {MakeUpvar, my var looks like array elem} -body {
    catch {unset aaaaa}
} -returnCodes error -body {
    set aaaaa 789789
    upvar #0 aaaaa foo(bar)
} -result {bad variable name "foo(bar)": can't create a scalar variable that looks like an array element}
} -returnCodes 1 -result {bad variable name "foo(bar)": can't create a scalar variable that looks like an array element}

test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
    catch {unset a}
    set a 123
    testgetvarfullname a global
} ::a
test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
    namespace eval test_ns_var {
	variable george
	testgetvarfullname george namespace
    }
} ::test_ns_var::george
test var-4.3 {Tcl_GetVariableName, variable can't be array element} -setup {
test var-4.3 {Tcl_GetVariableName, variable can't be array element} testgetvarfullname {
    catch {unset a}
} -constraints testgetvarfullname -body {
    set a(1) foo
    testgetvarfullname a(1) global
} -returnCodes error -result {unknown variable "a(1)"}
    list [catch {testgetvarfullname a(1) global} msg] $msg
} {1 {unknown variable "a(1)"}}

test var-5.1 {Tcl_GetVariableFullName, global variable} -setup {
test var-5.1 {Tcl_GetVariableFullName, global variable} {
    catch {unset a}
} -body {
    set a bar
    namespace which -variable a
} -result {::a}
} {::a}
test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
    namespace eval test_ns_var {
        variable martha
        namespace which -variable martha
    }
} {::test_ns_var::martha}
test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup {
test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
    namespace eval test_ns_var {variable martha}
} -body {
    namespace which -variable test_ns_var::martha
} -result {::test_ns_var::martha}
} {::test_ns_var::martha}

test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
    namespace eval test_ns_var {
        variable boeing 777
    }
    apply {{} {
    proc p {} {
        global ::test_ns_var::boeing
        set boeing
    }}
    }
    p
} {777}
test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
    namespace eval test_ns_var {
        namespace eval test_ns_nested {
            variable java java
        }
        proc p {} {
            global ::test_ns_var::test_ns_nested::java
            set java
        }
    }
    test_ns_var::p
} {java}
test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
    namespace eval ::test_ns_var::test_ns_nested {}
    set ::test_ns_var::test_ns_nested:: 24
    apply {{} {
    proc p {} {
        global ::test_ns_var::test_ns_nested::
        set {}
    }}
    }
    p
} {24}
test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
    # Test for Tcl Bug 480176
    set :v broken
    proc p {} {
	global :v
	set :v fixed
    }
    p
    set :v
} {fixed}
test var-6.5 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
    global
} {}
test var-6.6 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
    proc p {} {
	global
    }

    p
} {}

test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} -setup {
test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
    catch {namespace delete test_ns_var}
} -body {
    namespace eval test_ns_var {
        variable one 1
    }
    list [info vars test_ns_var::*] [set test_ns_var::one]
} -result {::test_ns_var::one 1}
} {::test_ns_var::one 1}
test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
    set two 2222222
    namespace eval test_ns_var {
        variable two
    }
    list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
} {0 1 {can't read "test_ns_var::two": no such variable}}
test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
    catch {namespace delete test_ns_var}
    namespace eval test_ns_var {variable one 1}
} -body {
    namespace eval test_ns_var {
        variable two 2
    }
    list [lsort [info vars test_ns_var::*]] \
         [namespace eval test_ns_var {set two}]
} -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
test var-7.4 {Tcl_VariableObjCmd, list of vars} {
    catch {namespace delete test_ns_var}
    namespace eval test_ns_var {variable one 1; variable two 2}
} -body {
    namespace eval test_ns_var {
        variable three 3 four 4
    }
    list [lsort [info vars test_ns_var::*]] \
         [namespace eval test_ns_var {expr $three+$four}]
} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
    catch {unset a}
    catch {unset five}
    catch {unset six}
} -body {
    set a ""
    set five 555
    set six  666
    namespace eval test_ns_var {
        variable five 5 six
        lappend ::a $five
        lappend a $five
    }
    lappend a $test_ns_var::five \
        [set test_ns_var::six 6] [set test_ns_var::six] $six
} -cleanup {
    catch {unset five}
    catch {unset six}
    set a
} -result {5 5 6 6 666}
} {5 5 6 6 666}
test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} -setup {
    catch {unset newvar}
catch {unset newvar}
} -body {
test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} {
    namespace eval test_ns_var {
        variable ::newvar cheers!
    }
    return $newvar
} -cleanup {
    catch {unset newvar}
    set newvar
} {cheers!}
catch {unset newvar}
} -result {cheers!}
test var-7.7 {Tcl_VariableObjCmd, bad var name} -returnCodes error -body {
test var-7.7 {Tcl_VariableObjCmd, bad var name} {
    namespace eval test_ns_var {
        variable sev:::en 7
        list [catch {variable sev:::en 7} msg] $msg
    }
} -result {can't define "sev:::en": parent namespace doesn't exist}
} {1 {can't define "sev:::en": parent namespace doesn't exist}}
test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
    set a ""
    namespace eval test_ns_var {
        variable eight 8
        lappend ::a $eight
        lappend a $eight
        variable eight
        lappend ::a $eight
        lappend a $eight
    }
    set a
} {8 8}
test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup {
test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} {
    catch {namespace delete test_ns_var2}
} -body {
    set a ""
    namespace eval test_ns_var2 {
        variable x 123
        variable y
        variable z
    }
    lappend a [lsort [info vars test_ns_var2::*]]
    lappend a [info exists test_ns_var2::x] [info exists test_ns_var2::y] \
        [info exists test_ns_var2::z]
    lappend a [list [catch {set test_ns_var2::y} msg] $msg]
    lappend a [lsort [info vars test_ns_var2::*]]
    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [set test_ns_var2::y hello]
    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [list [catch {unset test_ns_var2::y} msg] $msg]
    lappend a [lsort [info vars test_ns_var2::*]]
    lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
    lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
    lappend a [namespace delete test_ns_var2]
    set a
} -result [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
} [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
	{1 {can't read "test_ns_var2::y": no such variable}}\
	[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
	hello 1 0\
	{0 {}}\
	[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
	{1 {can't unset "test_ns_var2::z": no such variable}}\
	{}]
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
    namespace eval test_ns_var { variable eight 8 }
} -body {
    namespace eval test_ns_var {
        proc p {} {
            variable eight
            list [set eight] [info vars]
        }
        p
    }
} -result {8 eight}
test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
} {8 eight}
test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
    namespace eval test_ns_var { variable eight 8 }
} -body {
    proc p {} {   ;# note this proc is at global :: scope
        variable test_ns_var::eight
        list [set eight] [info vars]
    }
    p
} -result {8 eight}
} {8 eight}
test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
    namespace eval test_ns_var {
        variable {} {My name is empty}
    }
    proc p {} {   ;# note this proc is at global :: scope
        variable test_ns_var::
        list [set {}] [info vars]
    }
    p
} {{My name is empty} {{}}}
test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
    namespace eval test_ns_var {
        variable : {My name is ":"}
	proc p {} {
	    variable :
	    list [set :] [info vars]
	}
	p
    }
} {{My name is ":"} :}
test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var { variable arrayvar(1) }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
    namespace eval test_ns_var {
	variable arrayvar
	set arrayvar(1) x
	variable arrayvar(1) y
    }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
    variable
test var-7.14 {Tcl_VariableObjCmd, array element parameter} {
    catch {namespace eval test_ns_var { variable arrayvar(1) }} res
    set res
} "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.15 {Tcl_VariableObjCmd, array element parameter} {
    catch {
	namespace eval test_ns_var { 
	    variable arrayvar
	    set arrayvar(1) x
	    variable arrayvar(1) y
	}   
    } res
    set res
} "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args} {
    list [catch {variable} msg] $msg
} {}
test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
test var-7.17 {Tcl_VariableObjCmd, no args} {
    namespace eval test_ns_var {
	variable
	list [catch {variable} msg] $msg
    }
} {}
} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}

test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} -setup {
test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
    catch {namespace delete test_ns_var}
    catch {unset a}
} -body {
    namespace eval test_ns_var {
        variable v 123
        variable info ""

        proc traceUnset {name1 name2 op} {
            variable info
            set info [concat $info [list $name1 $name2 $op]]
        }

        trace var v u [namespace code traceUnset]
    }
    list [unset test_ns_var::v] $test_ns_var::info
} -result {{} {test_ns_var::v {} u}}
test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup {
} {{} {test_ns_var::v {} u}}

test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} {
    catch {namespace delete test_ns_var}
    catch {unset a}
} -body {
    set info ""
    namespace eval test_ns_var {
        variable v 123 1
        trace var v u ::traceUnset
    }

    proc traceUnset {name1 name2 op} {
	set ::info [concat $::info [list $name1 $name2 $op]]
    }

    list [namespace delete test_ns_var] $::info
} -result {{} {::test_ns_var::v {} u}}
} {{} {::test_ns_var::v {} u}}

test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup {
    proc ::t {a i o} {
	set $a 321
    }
} -body {
    leaktest {
	namespace eval n {
	    variable v 123
	    trace variable v u ::t
	}
	namespace delete n
    }
} -cleanup {
    rename ::t {}
} -result 0

test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup {
    catch {unset u}
test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr {
    catch {unset u}; catch {unset v}
    catch {unset v}
} -constraints testsetnoerr -body {
    list \
	[set u a; testsetnoerr u] \
	[testsetnoerr v b] \
	[testseterr u] \
	[unset v; testseterr v b]
} -result [list {before get a} {before set b} {before get a} {before set b}]
test var-9.2 {behaviour of TclGet/SetVar namespace get/set} -setup {
       [set u a; testsetnoerr u] \
       [testsetnoerr v b] \
       [testseterr u] \
       [unset v; testseterr v b]
} [list {before get a} {before set b} {before get a} {before set b}]
test var-9.2 {behaviour of TclGet/SetVar namespace get/set} testsetnoerr {
    catch {namespace delete ns}
} -constraints testsetnoerr -body {
    namespace eval ns {variable u a; variable v}
    list \
	[testsetnoerr ns::u] \
	[testsetnoerr ns::v b] \
	[testseterr ns::u] \
	[unset ns::v; testseterr ns::v b]
} -result [list {before get a} {before set b} {before get a} {before set b}]
test var-9.3 {behaviour of TclGetVar no variable} -setup {
       [testsetnoerr ns::u] \
       [testsetnoerr ns::v b] \
       [testseterr ns::u] \
       [unset ns::v; testseterr ns::v b]
} [list {before get a} {before set b} {before get a} {before set b}]
test var-9.3 {behaviour of TclGetVar no variable} testsetnoerr {
    catch {unset u}
} -constraints testsetnoerr -body {
    list \
	[catch {testsetnoerr u} res] $res \
	[catch {testseterr u} res] $res
} -result {1 {before get} 1 {can't read "u": no such variable}}
test var-9.4 {behaviour of TclGetVar no namespace variable} -setup {
       [catch {testsetnoerr u} res] $res \
       [catch {testseterr u} res] $res
} {1 {before get} 1 {can't read "u": no such variable}}
test var-9.4 {behaviour of TclGetVar no namespace variable} testsetnoerr {
    catch {namespace delete ns}
} -constraints testsetnoerr -body {
    namespace eval ns {}
    list \
	[catch {testsetnoerr ns::w} res] $res \
	[catch {testseterr ns::w} res] $res
} -result {1 {before get} 1 {can't read "ns::w": no such variable}}
test var-9.5 {behaviour of TclGetVar no namespace} -setup {
       [catch {testsetnoerr ns::w} res] $res \
       [catch {testseterr ns::w} res] $res
} {1 {before get} 1 {can't read "ns::w": no such variable}}
test var-9.5 {behaviour of TclGetVar no namespace} testsetnoerr {
    catch {namespace delete ns}
} -constraints testsetnoerr -body {
    list \
	[catch {testsetnoerr ns::u} res] $res \
	[catch {testseterr ns::v} res] $res
} -result {1 {before get} 1 {can't read "ns::v": no such variable}}
test var-9.6 {behaviour of TclSetVar no namespace} -setup {
       [catch {testsetnoerr ns::u} res] $res \
       [catch {testseterr ns::v} res] $res
} {1 {before get} 1 {can't read "ns::v": no such variable}}
test var-9.6 {behaviour of TclSetVar no namespace} testsetnoerr {
    catch {namespace delete ns}
} -constraints testsetnoerr -body {
    list \
	[catch {testsetnoerr ns::v 1} res] $res \
	[catch {testseterr ns::v 1} res] $res
} -result {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
test var-9.7 {behaviour of TclGetVar array variable} -setup {
       [catch {testsetnoerr ns::v 1} res] $res \
       [catch {testseterr ns::v 1} res] $res
} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
test var-9.7 {behaviour of TclGetVar array variable} testsetnoerr {
    catch {unset arr}
} -constraints testsetnoerr -body {
    set arr(1) 1
    set arr(1) 1;
    list \
	[catch {testsetnoerr arr} res] $res \
	[catch {testseterr arr} res] $res
} -result {1 {before get} 1 {can't read "arr": variable is array}}
test var-9.8 {behaviour of TclSetVar array variable} -setup {
       [catch {testsetnoerr arr} res] $res \
       [catch {testseterr arr} res] $res
} {1 {before get} 1 {can't read "arr": variable is array}}
test var-9.8 {behaviour of TclSetVar array variable} testsetnoerr {
    catch {unset arr}
} -constraints testsetnoerr -body {
    set arr(1) 1
    list \
	[catch {testsetnoerr arr 2} res] $res \
	[catch {testseterr arr 2} res] $res
} -result {1 {before set} 1 {can't set "arr": variable is array}}
test var-9.9 {behaviour of TclGetVar read trace success} -setup {
       [catch {testsetnoerr arr 2} res] $res \
       [catch {testseterr arr 2} res] $res
} {1 {before set} 1 {can't set "arr": variable is array}}
test var-9.9 {behaviour of TclGetVar read trace success} testsetnoerr {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
    catch {unset u}; catch {unset v}
    set u 10
    trace var u r [list resetvar 1]
    trace var v r [list resetvar 2]
    list \
	[testsetnoerr u] \
	[testseterr v]
} -result {{before get 1} {before get 2}}
       [testsetnoerr u] \
       [testseterr v]
} {{before get 1} {before get 2}}
test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr {
    proc writeonly args {error "write-only"}
    set v 456
    trace var v r writeonly
    list \
	[catch {testsetnoerr v} msg] $msg \
	[catch {testseterr v} msg] $msg
       [catch {testsetnoerr v} msg] $msg \
       [catch {testseterr v} msg] $msg
} {1 {before get} 1 {can't read "v": write-only}}
test var-9.11 {behaviour of TclSetVar write trace success} -setup {
test var-9.11 {behaviour of TclSetVar write trace success} testsetnoerr {
    catch {unset u}
    catch {unset v}
} -constraints testsetnoerr -body {
    proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
    catch {unset u}; catch {unset v}
    set v 1
    trace var v w doubleval
    trace var u w doubleval
    list \
	[testsetnoerr u 2] \
	[testseterr v 3]
} -result {{before set 4} {before set 6}}
       [testsetnoerr u 2] \
       [testseterr v 3]
} {{before set 4} {before set 6}}
test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr {
    proc readonly args {error "read-only"}
    set v 456
    trace var v w readonly
    list \
	[catch {testsetnoerr v 2} msg] $msg $v \
	[catch {testseterr v 3} msg] $msg $v
       [catch {testsetnoerr v 2} msg] $msg $v \
       [catch {testseterr v 3} msg] $msg $v
} {1 {before set} 2 1 {can't set "v": read-only} 3}

test var-10.1 {can't nest arrays with array set} -setup {
test var-10.1 {can't nest arrays with array set} {
   catch {unset arr}
} -returnCodes error -body {
   array set arr(x) {a 1 b 2}
} -result {can't set "arr(x)": variable isn't array}
test var-10.2 {can't nest arrays with array set} -setup {
   list [catch {array set arr(x) {a 1 b 2}} res] $res
} {1 {can't set "arr(x)": variable isn't array}}
test var-10.2 {can't nest arrays with array set} {
   catch {unset arr}
} -returnCodes error -body {
   array set arr(x) {}
} -result {can't set "arr(x)": variable isn't array}
   list [catch {array set arr(x) {}} res] $res
} {1 {can't set "arr(x)": variable isn't array}}

test var-11.1 {array unset} -setup {
test var-11.1 {array unset} {
    catch {unset a}
} -body {
    array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
    array unset a 1,*
    lsort -dict [array names a]
} -result {2,1 2,3}
test var-11.2 {array unset} -setup {
} {2,1 2,3}
test var-11.2 {array unset} {
    catch {unset a}
} -body {
    array set a { 1,1 a 1,2 b }
    array unset a
    array exists a
} -result 0
test var-11.3 {array unset errors} -setup {
} 0
test var-11.3 {array unset errors} {
    catch {unset a}
} -returnCodes error -body {
    array set a { 1,1 a 1,2 b }
    array unset a pattern too
} -result {wrong # args: should be "array unset arrayName ?pattern?"}
    list [catch {array unset a pattern too} msg] $msg
} {1 {wrong # args: should be "array unset arrayName ?pattern?"}}

test var-12.1 {TclFindCompiledLocals, {} array name} {
    namespace eval n {
	proc p {} {
	    variable {}
	    set (0) 0
	    set (1) 1
	    set n 2
	    set ($n) 2
	    set ($n,foo) 2
	}
	p
	lsort -dictionary [array names {}]
    }
} {0 1 2 2,foo}

test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup {
test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
    catch {unset t}
} -body {
    proc foo {var ind op} {
	global t
	set foo bar
    }
    namespace eval :: {
	set t(1) 1
	trace variable t(1) u foo
	unset t
    }
    set x "If you see this, it worked"
} -result "If you see this, it worked"
} "If you see this, it worked"
test var-13.2 {unset array with search, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
	unset a([array nextelement a $s])
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}
test var-13.3 {unset array with search, SIGSEGV, bug 46a2410650} -body {
    apply {{} {
	array set a {aa 11 bb 22 cc 33 dd 44 ee 55 ff 66}
	set s [array startsearch a]
        unset a(ff)
	array nextelement a $s
    }}
} -returnCodes error -result {couldn't find search "s-1-a"}

test var-14.1 {array names syntax} -body {
    array names foo bar baz snafu
} -returnCodes 1 -match glob -result *

test var-14.2 {array names -glob} -body {
    array names tcl_platform -glob os
} -result os
} -returnCodes 0 -match exact -result os

test var-15.1 {segfault in [unset], [Bug 735335]} {
    proc A { name } {
	upvar $name var
	set var $name
    }
    #
    # Note that the variable name has to be
    # Note that the variable name has to be 
    # unused previously for the segfault to
    # be triggered.
    #
    namespace eval test A useSomeUnlikelyNameHere
    namespace eval test unset useSomeUnlikelyNameHere
} {}
test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {

    apply {{} {unset foo [return ok]}}
} ok

test var-16.1 {CallVarTraces: save/restore interp error state} {
    trace add variable ::errorCode write " ;#"
    catch {error foo bar baz}
    trace remove variable ::errorCode write " ;#"
    set ::errorInfo
} bar
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
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







-
+
















+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-







    set foo
} -cleanup {
    unset -nocomplain a d foo
} -result 2

test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
    set already 0
    unset -nocomplain x
    unset x
} -body {
    array set x {e 1 i 1}
    trace add variable x unset {apply {args {
	global already x
	if {!$already} {
	    set already 1
	    unset x(i)
	}
    }}}
    # The next command would crash reliably with memory debugging prior to the
    # bug fix.
    array unset x *
    array size x
} -cleanup {
    unset x already
} -result 0


test var-19.1 {crash when freeing locals hashtable: Bug 3037525} {
    proc foo {} { catch {upvar 0 dummy \$index} }
    foo ; # This crashes without the fix for the bug
    rename foo {}
} {}

test var-20.1 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	global x
	array set x {a 1}
    }}
    array size x
} -result 1
test var-20.2 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	global x
	array set x {}
    }}
    array size x
} -result 0
test var-20.3 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	array set ::x {a 1}
    }}
    array size x
} -result 1
test var-20.4 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	array set ::x {}
    }}
    array size x
} -result 0
test var-20.5 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	global x
	eval {array set x {a 1}}
    }}
    array size x
} -result 1
test var-20.6 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	global x
	eval {array set x {}}
    }}
    array size x
} -result 0
test var-20.7 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	eval {array set ::x {a 1}}
    }}
    array size x
} -result 1
test var-20.8 {array set compilation correctness: Bug 3603163} -setup {
    unset -nocomplain x
} -body {
    apply {{} {
	eval {array set ::x {}}
    }}
    array size x
} -result 0
test var-20.9 {[bc1a96407a] array set compiled w/ trace} -setup {
    variable foo
    variable lambda
    unset -nocomplain lambda foo
    array set foo {}
    lappend lambda {}
    lappend lambda [list array set [namespace which -variable foo] {a 1}]
} -body {
    after 0 [list apply $lambda]
    vwait [namespace which -variable foo]
} -cleanup {
    unset -nocomplain lambda foo
} -result {}
test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body {
    apply {{} {set name foo(bar); array set $name {a 1}}}
} -returnCodes error -match glob -result *
test var-20.11 {array set don't compile bad initializer} -setup {
    unset -nocomplain foo
    trace add variable foo array {set foo(bar) baz;#}
} -body {
    catch {array set foo bad}
    set foo(bar)
} -cleanup {
    unset -nocomplain foo
} -result baz
test var-20.12 {array set don't compile bad initializer} -setup {
    unset -nocomplain ::foo
    trace add variable ::foo array {set ::foo(bar) baz;#}
} -body {
    catch {apply {{} {
	set value bad
	array set ::foo $value

    }}}
    set ::foo(bar)
} -cleanup {
    unset -nocomplain ::foo
} -result baz

test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
    proc linenumber {} {dict get [info frame -1] line}
} -body {
    apply {n {
	set foo bar
        unset foo {*}{
        } [return [incr n -[linenumber]]]
    }} [linenumber]
} -cleanup {
    rename linenumber {}
} -result 1

test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
    proc doit k {
	variable A
	set A($k) {}
	foreach n [array names A] {
	    if {$n <= $k-1} {
		unset A($n)
	    }
	}
    }
} -constraints memory -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	doit $i
        set tmp $end
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    array unset A
    rename doit {}
} -result 0
test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
    proc doit {} {
	interp create child
	child eval {
	    proc doit script {
		eval $script
		set foo bar
	    }
	    doit {foreach foo baz {}}
	}
	interp delete child
    }
} -constraints memory -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	doit
        set tmp $end
        set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    array unset A
    rename doit {}
} -result 0
test var-22.2 {leak in parsedVarName} -constraints memory -body {
    set i 0
    leaktest {lappend x($i)}
} -cleanup {
    unset -nocomplain i x
} -result 0

unset -nocomplain a k v
test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
    array for {k v} c d e {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
    array for {k v} {}
} -result {wrong # args: should be "array for {key value} arrayName script"}
test var-23.3 {array command, for loop, too many list args} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v w} a {}
} -result {must have two variable names}
test var-23.4 {array command, for loop, not enough list args} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k} a {}
} -result {must have two variable names}
test var-23.5 {array command, for loop, no array} -setup {
    unset -nocomplain a
} -returnCodes error -body {
    array for {k v} a {}
} -result {"a" isn't an array}
test var-23.6 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
    catch {rename p ""}
} -returnCodes error -body {
    apply {{x} {
        if {$x==1} {
            return [array for {k v} a {}]
        }
        set a(x) 123
    }} 1
} -result {"a" isn't an array}
test var-23.7 {array enumeration} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	lappend reslist $k $v
    }
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 b 2 c 3}
test var-23.9 {array enumeration, nested} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k1 v1} a {
	lappend reslist $k1 $v1
	set r2 {}
	array for {k2 v2} a {
	    lappend r2 $k2 $v2
	}
	lappend reslist [lsort -stride 2 -index 0 $r2]
    }
    # there is no guarantee in which order the array contents will be
    # returned.
    lsort -stride 3 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}}
test var-23.10 {array enumeration, delete key} -match glob -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    set retval {}
    try {
      array set a {a 1 b 2 c 3 d 4}
      array for {k v} a {
  	lappend reslist $k $v
          if { $k eq "a" } {
            unset a(c)
          }
      }
      lsort -stride 2 -index 0 $reslist
    } on error {err res} {
      set retval [dict get $res -errorinfo]
    }
    set retval
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
    unset -nocomplain retval
} -result {array changed during iteration*}
test var-23.11 {array enumeration, insert key} -match glob -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    set retval {}
    try {
      array set a {a 1 b 2 c 3 d 4}
      array for {k v} a {
  	lappend reslist $k $v
          if { $k eq "a" } {
            set a(e) 5
          }
      }
      lsort -stride 2 -index 0 $reslist
    } on error {err res} {
      set retval [dict get $res -errorinfo]
    }
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {array changed during iteration*}
test var-23.12 {array enumeration, change value} -setup {
    unset -nocomplain a
    set reslist [list]
} -body {
    array set a {a 1 b 2 c 3}
    array for {k v} a {
	lappend reslist $k $v
        if { $k eq "a" } {
          set a(c) 9
        }
    }
    lsort -stride 2 -index 0 $reslist
} -cleanup {
    unset -nocomplain a
    unset -nocomplain reslist
} -result {a 1 b 2 c 9}
test var-23.13 {array enumeration, number of traces} -setup {
    set ::countarrayfor 0
    proc ::tracearrayfor { args } {
      incr ::countarrayfor
    }
    unset -nocomplain ::a
    set reslist [list]
} -body {
    array set ::a {a 1 b 2 c 3}
    foreach {k} [array names a] {
      trace add variable ::a($k) read ::tracearrayfor
    }
    array for {k v} ::a {
	lappend reslist $k $v
    }
    set ::countarrayfor
} -cleanup {
    unset -nocomplain ::countarrayfor
    unset -nocomplain ::a
    unset -nocomplain reslist
} -result 3
test var-23.14 {array for, shared arguments} -setup {
    set vn {k v}
    unset -nocomplain $vn
} -body {
    array set $vn {a 1 b 2 c 3}
    array for $vn $vn {}
} -cleanup {
    unset -nocomplain $vn vn
} -result {}

test var-24.1 {array default set and get: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	[array default get ary]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 1 0 7}
test var-24.2 {array default set and get: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
	    [array default get ary]
    }}
} {3 7 1 0 7}
test var-24.3 {array default unset: interpreted} -setup {
    unset -nocomplain ary
} -body {
    array set ary {a 3}
    array default set ary 7
    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
} -cleanup {
    unset -nocomplain ary
} -result {3 7 {} 3 1}
test var-24.4 {array default unset: compiled} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
	    [catch {set ary(b)}]
    }}
} {3 7 {} 3 1}
test var-24.5 {array default exists: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array set ary {a 3}
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 7
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    unset ary
    lappend result [info exists ary],[array exists ary],[array default exists ary]
    array default set ary 11
    lappend result [info exists ary],[array exists ary],[array default exists ary]
} -cleanup {
    unset -nocomplain ary result
} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.6 {array default exists: compiled} {
    apply {{} {
	array set ary {a 3}
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 7
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	unset ary
	lappend result [info exists ary],[array exists ary],[array default exists ary]
	array default set ary 11
	lappend result [info exists ary],[array exists ary],[array default exists ary]
    }}
} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
test var-24.7 {array default and append: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    append ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    append ary(x) def
    append ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.8 {array default and append: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	append ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	append ary(x) def
	append ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 grillabc 2 grillabcdef ghi}
test var-24.9 {array default and lappend: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary grill
    lappend result [array size ary] [info exist ary(x)]
    lappend ary(x) abc
    lappend result [array size ary] $ary(x)
    array default unset ary
    lappend ary(x) def
    lappend ary(y) ghi
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.10 {array default and lappend: compiled} {
    apply {{} {
	array default set ary grill
	lappend result [array size ary] [info exist ary(x)]
	lappend ary(x) abc
	lappend result [array size ary] $ary(x)
	array default unset ary
	lappend ary(x) def
	lappend ary(y) ghi
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 {grill abc} 2 {grill abc def} ghi}
test var-24.11 {array default and incr: interpreted} -setup {
    unset -nocomplain ary result
    set result {}
} -body {
    array default set ary 7
    lappend result [array size ary] [info exist ary(x)]
    incr ary(x) 11
    lappend result [array size ary] $ary(x)
    array default unset ary
    incr ary(x)
    incr ary(y)
    lappend result [array size ary] $ary(x) $ary(y)
} -cleanup {
    unset -nocomplain ary result
} -result {0 0 1 18 2 19 1}
test var-24.12 {array default and incr: compiled} {
    apply {{} {
	array default set ary 7
	lappend result [array size ary] [info exist ary(x)]
	incr ary(x) 11
	lappend result [array size ary] $ary(x)
	array default unset ary
	incr ary(x)
	incr ary(y)
	lappend result [array size ary] $ary(x) $ary(y)
    }}
} {0 0 1 18 2 19 1}
test var-24.13 {array default and dict: interpreted} -setup {
    unset -nocomplain ary x y z
} -body {
    array default set ary {x y}
    dict lappend ary(p) x z
    dict update ary(q) x y {
	set y z
    }
    dict with ary(r) {
	set x 123
    }
    lsort -stride 2 -index 0 [array get ary]
} -cleanup {
    unset -nocomplain ary x y z
} -result {p {x {y z}} q {x z} r {x 123}}
test var-24.14 {array default and dict: compiled} {
    lsort -stride 2 -index 0 [apply {{} {
	array default set ary {x y}
	dict lappend ary(p) x z
	dict update ary(q) x y {
	    set y z
	}
	dict with ary(r) {
	    set x 123
	}
	array get ary
    }}]
} {p {x {y z}} q {x z} r {x 123}}
test var-24.15 {array default set and get: two-level} {
    apply {{} {
	array set ary {a 3}
	array default set ary 7
	apply {{} {
	    upvar 1 ary ary ary(c) c
	    lappend result $ary(a) $ary(b) $c
	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
	    lappend result [array default get ary]
	}}
    }}
} {3 7 7 1 0 0 7}
test var-24.16 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default set ary 7
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {can't array default set "ary": variable isn't array}
test var-24.17 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.18 {array default set: errors} -setup {
    unset -nocomplain ary
} -body {
    array default set ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.19 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default get ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.20 {array default get: errors} -setup {
    unset -nocomplain ary
} -body {
    array default get ary x y
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.21 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default exists ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.22 {array default exists: errors} -setup {
    unset -nocomplain ary
} -body {
    array default exists ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob
test var-24.23 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    set ary not-an-array
    array default unset ary
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result {"ary" isn't an array}
test var-24.24 {array default unset: errors} -setup {
    unset -nocomplain ary
} -body {
    array default unset ary x
} -returnCodes error -cleanup {
    unset -nocomplain ary
} -result * -match glob

catch {namespace delete ns}
catch {unset arr}
catch {unset v}

catch {rename getbytes ""}
catch {rename p ""}
catch {namespace delete test_ns_var}
catch {namespace delete test_ns_var2}
catch {unset xx}
catch {unset x}
catch {unset y}
catch {unset i}

Changes to tests/while-old.test.

9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
9
10
11
12
13
14
15


16
17
18
19
20
21
22
23
24







-
-
+
+







# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test while-old-1.1 {basic while loops} {
    set count 0
    while {$count < 10} {set count [expr $count+1]}
    set count
88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102







-
+







test while-old-4.3 {errors in while loops} {
    set err [catch {while 1 2 3} msg]
    list $err $msg
} {1 {wrong # args: should be "while test command"}}
test while-old-4.4 {errors in while loops} {
    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
    list $err $msg
} {1 {can't use non-numeric string "a" as operand of "+"}}
} {1 {can't use non-numeric string as operand of "+"}}
test while-old-4.5 {errors in while loops} {
    catch {unset x}
    set x 1
    set err [catch {while {$x} {set x foo}} msg]
    list $err $msg
} {1 {expected boolean value but got "foo"}}
test while-old-4.6 {errors in while loops} {

Changes to tests/while.test.

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
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


-
-
-
+
+
+




-
-
+
+

-
-
+
+








-
-
-
+
+
+
+


-
-
+
+
-
-

-
-
-
-
+
+
+
+
+






-
-
-
-
-
+
+
+







-
-
-
-
+
+




-
+

-
-
+
+
+


-
-
+
+
-
-
-
+


-
+







-
-
-
-
-
+
+
+



-
-
-
-
-
+
+
+



-






-
-
-
-
-
+
+
+







# Commands covered:  while
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands.  Sourcing this file into Tcl runs the tests and generates output
# for errors.  No output means no errors were found.
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Basic "while" operation.

catch {unset i}
catch {unset a}

test while-1.1 {TclCompileWhileCmd: missing test expression} -body {
    while
} -returnCodes error -result {wrong # args: should be "while test command"}
test while-1.1 {TclCompileWhileCmd: missing test expression} {
    catch {while } msg
    set msg
} {wrong # args: should be "while test command"}
test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
    set i 0
    catch {while {$i<} break}
    return $::errorInfo
    catch {while {$i<} break} msg
    set ::errorInfo
} -cleanup {
    unset i
} -match glob -result {*"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
    while {"a"+"b"} {error "loop aborted"}
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
test while-1.3 {TclCompileWhileCmd: error in test expression} {
    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
    list $err $msg
} {1 {can't use non-numeric string as operand of "+"}}
test while-1.4 {TclCompileWhileCmd: multiline test expr} {
    set value 1
    while {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break
    }
    return $value
} -cleanup {
    unset value
} -result {2}
test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} -body {
    set value
} {2}
test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
    set value 1
    while {"true"} {
	incr value;
	if {$value > 5} {
	    break;
	}
    }
    return $value
} -cleanup {
    unset value
} -result 6
    set value
} 6
test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {
    set i 0
    while "$i > 5" {}
} {}
test while-1.7 {TclCompileWhileCmd: missing command body} -body {
test while-1.7 {TclCompileWhileCmd: missing command body} {
    set i 0
    while {$i < 5}
} -returnCodes error -result {wrong # args: should be "while test command"}
    catch {while {$i < 5} } msg
    set msg
} {wrong # args: should be "while test command"}
test while-1.8 {TclCompileWhileCmd: error compiling command body} -body {
    set i 0
    catch {while {$i < 5} {set}}
    return $::errorInfo
    catch {while {$i < 5} {set}} msg
    set ::errorInfo
} -match glob -cleanup {
    unset i
} -result {wrong # args: should be "set varName ?newValue?"
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"*}
test while-1.9 {TclCompileWhileCmd: simple command body} -body {
test while-1.9 {TclCompileWhileCmd: simple command body} {
    set a {}
    set i 1
    while {$i<6} {
	if $i==4 break
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i
} -result {1 2 3}
test while-1.10 {TclCompileWhileCmd: command body in quotes} -body {
    set a
} {1 2 3}
test while-1.10 {TclCompileWhileCmd: command body in quotes} {
    set a {}
    set i 1
    while {$i<6} "append a x; incr i"
    return $a
} -cleanup {
    unset a i
} -result {xxxxx}
test while-1.11 {TclCompileWhileCmd: computed command body} -setup {
    set a
} {xxxxx}
test while-1.11 {TclCompileWhileCmd: computed command body} {
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
} -body {
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2; incr i}
    set a {}
    set i 1
    while {$i<6} $x1$bb$x2
    return $a
} -cleanup {
    unset x1 bb x2 a i
} -result {x1}
test while-1.12 {TclCompileWhileCmd: long command body} -body {
    set a
} {x1}
test while-1.12 {TclCompileWhileCmd: long command body} {
    set a {}
    set i 1
    while {$i<6} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
	    catch {set a $a} msg
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
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







-
-
-
-
-
+
+
+


-
-
-
-
-
+
+
+


-
-
-
-
+
+



-
+







-
-
-
-
-
+
+
+







-
-
-
-
-
+
+
+











-
-
-
-
-
+
+
+







	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i
} -result {1 2 3}
test while-1.13 {TclCompileWhileCmd: while command result} -body {
    set a
} {1 2 3}
test while-1.13 {TclCompileWhileCmd: while command result} {
    set i 0
    set a [while {$i < 5} {incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}
test while-1.14 {TclCompileWhileCmd: while command result} -body {
    set a
} {}
test while-1.14 {TclCompileWhileCmd: while command result} {
    set i 0
    set a [while {$i < 5} {if $i==3 break; incr i}]
    return $a
} -cleanup {
    unset a i
} -result {}
    set a
} {}

# Check "while" and "continue".

test while-2.1 {continue tests} -body {
test while-2.1 {continue tests} {
    set a {}
    set i 1
    while {$i <= 4} {
        incr i
	if {$i == 3} continue
	set a [concat $a $i]
    }
    return $a
} -cleanup {
    unset a i
} -result {2 4 5}
test while-2.2 {continue tests} -body {
    set a
} {2 4 5}
test while-2.2 {continue tests} {
    set a {}
    set i 1
    while {$i <= 4} {
        incr i
	if {$i != 2} continue
	set a [concat $a $i]
    }
    return $a
} -cleanup {
    unset a i
} -result {2}
test while-2.3 {continue tests, nested loops} -body {
    set a
} {2}
test while-2.3 {continue tests, nested loops} {
    set msg {}
    set i 1
    while {$i <= 4} {
        incr i
        set a 1
	while {$a <= 2} {
            incr a
            if {$i>=3 && $a>=3} continue
            set msg [concat $msg "$i.$a"]
        }
    }
    return $msg
} -cleanup {
    unset a i msg
} -result {2.2 2.3 3.2 4.2 5.2}
test while-2.4 {continue tests, long command body} -body {
    set msg
} {2.2 2.3 3.2 4.2 5.2}
test while-2.4 {continue tests, long command body} {
    set a {}
    set i 1
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
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
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







-
-
-
-
+
+



-
+







-
-
-
-
-
+
+
+











-
-
-
-
-
+
+
+







	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i
} -result {1 3}
    set a
} {1 3}

# Check "while" and "break".

test while-3.1 {break tests} -body {
test while-3.1 {break tests} {
    set a {}
    set i 1
    while {$i <= 4} {
	if {$i == 3} break
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i
} -result {1 2}
test while-3.2 {break tests, nested loops} -body {
    set a
} {1 2}
test while-3.2 {break tests, nested loops} {
    set msg {}
    set i 1
    while {$i <= 4} {
        set a 1
	while {$a <= 2} {
            if {$i>=2 && $a>=2} break
            set msg [concat $msg "$i.$a"]
            incr a
        }
        incr i
    }
    return $msg
} -cleanup {
    unset a i msg
} -result {1.1 1.2 2.1 3.1 4.1}
test while-3.3 {break tests, long command body} -body {
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test while-3.3 {break tests, long command body} {
    set a {}
    set i 1
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==5 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
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
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







-
-
-
-
+
+



-
+





-
-
-
-
-
+
+
+

-
+
-
-
-
+
+



-
-
+
+
-
-
-
-
+
+

-
-
-
+
+
+
+







-
-
-
-
-
+
+
+








-
-
-
-
-
+
+
+



-
+
-
-
-
+


-
+
-
-
-
+
+



-
+

-
-
-
+





-
+








-
-
-
-
-
+
+
+




-
-
-
-
-
+
+
+
+



-
-






-
-
-
-
-
+
+
+







	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i
} -result {1 3}
    set a
} {1 3}

# Check "while" with computed command names.

test while-4.1 {while and computed command names} -body {
test while-4.1 {while and computed command names} {
    set i 0
    set z while
    $z {$i < 10} {
        incr i
    }
    return $i
} -cleanup {
    unset i z
} -result 10
test while-4.2 {while (not compiled): missing test expression} -body {
    set i
} 10
test while-4.2 {while (not compiled): missing test expression} {
    set z while
    $z
    catch {$z } msg
} -returnCodes error -cleanup {
    unset z
} -result {wrong # args: should be "while test command"}
    set msg
} {wrong # args: should be "while test command"}
test while-4.3 {while (not compiled): error in test expression} -body {
    set i 0
    set z while
    catch {$z {$i<} {set x 1}}
    return $::errorInfo
    catch {$z {$i<} {set x 1}} msg
    set ::errorInfo
} -match glob -cleanup {
    unset i z
} -result {*"$z {$i<} {set x 1}"}
test while-4.4 {while (not compiled): error in test expression} -body {
} -match glob -result {*"$z {$i<} {set x 1}"}
test while-4.4 {while (not compiled): error in test expression} {
    set z while
    $z {"a"+"b"} {error "loop aborted"}
} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
test while-4.5 {while (not compiled): multiline test expr} -body {
    set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg]
    list $err $msg
} {1 {can't use non-numeric string as operand of "+"}}
test while-4.5 {while (not compiled): multiline test expr} {
    set value 1
    set z while
    $z {($tcl_platform(platform) != "foobar1") && \
	    ($tcl_platform(platform) != "foobar2")} {
        incr value
        break
    }
    return $value
} -cleanup {
    unset value z
} -result {2}
test while-4.6 {while (not compiled): non-numeric boolean test expr} -body {
    set value
} {2}
test while-4.6 {while (not compiled): non-numeric boolean test expr} {
    set value 1
    set z while
    $z {"true"} {
	incr value;
	if {$value > 5} {
	    break;
	}
    }
    return $value
} -cleanup {
    unset value z
} -result 6
test while-4.7 {while (not compiled): test expr is enclosed in quotes} -body {
    set value
} 6
test while-4.7 {while (not compiled): test expr is enclosed in quotes} {
    set i 0
    set z while
    $z "$i > 5" {}
} -cleanup {
} {}
    unset i z
} -result {}
test while-4.8 {while (not compiled): missing command body} -body {
test while-4.8 {while (not compiled): missing command body} {
    set i 0
    set z while
    $z {$i < 5}
    catch {$z {$i < 5} } msg
} -returnCodes error -cleanup {
    unset i z
} -result {wrong # args: should be "while test command"}
    set msg
} {wrong # args: should be "while test command"}
test while-4.9 {while (not compiled): error compiling command body} -body {
    set i 0
    set z while
    catch {$z {$i < 5} {set}}
    catch {$z {$i < 5} {set}} msg
    set ::errorInfo
} -match glob -cleanup {
    unset i z
} -result {wrong # args: should be "set varName ?newValue?"
} -match glob -result {wrong # args: should be "set varName ?newValue?"
    while *ing
"set"
    ("while" body line 1)
    invoked from within
"$z {$i < 5} {set}"}
test while-4.10 {while (not compiled): simple command body} -body {
test while-4.10 {while (not compiled): simple command body} {
    set a {}
    set i 1
    set z while
    $z {$i<6} {
	if $i==4 break
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i z
} -result {1 2 3}
test while-4.11 {while (not compiled): command body in quotes} -body {
    set a
} {1 2 3}
test while-4.11 {while (not compiled): command body in quotes} {
    set a {}
    set i 1
    set z while
    $z {$i<6} "append a x; incr i"
    return $a
} -cleanup {
    unset a i z
} -result {xxxxx}
test while-4.12 {while (not compiled): computed command body} -setup {
    set a
} {xxxxx}
test while-4.12 {while (not compiled): computed command body} {
    set z while
    catch {unset x1}
    catch {unset bb}
    catch {unset x2}
} -body {
    set z while
    set x1 {append a x1; }
    set bb {break}
    set x2 {; append a x2; incr i}
    set a {}
    set i 1
    $z {$i<6} $x1$bb$x2
    return $a
} -cleanup {
    unset z x1 bb x2 a i
} -result {x1}
test while-4.13 {while (not compiled): long command body} -body {
    set a
} {x1}
test while-4.13 {while (not compiled): long command body} {
    set a {}
    set z while
    set i 1
    $z {$i<6} {
	if $i==4 break
	if $i>5 continue
	if {$i>6 && $tcl_platform(machine)=="xxx"} {
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
524
525
526
527
528
529
530
531
532
533
534
535
536



537
538
539
540
541
542
543
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
457
458
459
460
461
462
463
464
465
466
467
468
469





470
471
472
473
474
475
476
477
478
479







-
-
-
-
-
+
+
+



-
-
-
-
-
+
+
+



-
-
-
-
+
+



-
+






-
-
-
-
-
+
+
+








-
-
-
-
-
+
+
+












-
-
-
-
-
+
+
+







	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i z
} -result {1 2 3}
test while-4.14 {while (not compiled): while command result} -body {
    set a
} {1 2 3}
test while-4.14 {while (not compiled): while command result} {
    set i 0
    set z while
    set a [$z {$i < 5} {incr i}]
    return $a
} -cleanup {
    unset a i z
} -result {}
test while-4.15 {while (not compiled): while command result} -body {
    set a
} {}
test while-4.15 {while (not compiled): while command result} {
    set i 0
    set z while
    set a [$z {$i < 5} {if $i==3 break; incr i}]
    return $a
} -cleanup {
    unset a i z
} -result {}
    set a
} {}

# Check "break" with computed command names.

test while-5.1 {break and computed command names} -body {
test while-5.1 {break and computed command names} {
    set i 0
    set z break
    while 1 {
        if {$i > 10} $z
        incr i
    }
    return $i
} -cleanup {
    unset i z
} -result 11
test while-5.2 {break tests with computed command names} -body {
    set i
} 11
test while-5.2 {break tests with computed command names} {
    set a {}
    set i 1
    set z break
    while {$i <= 4} {
	if {$i == 3} $z
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i z
} -result {1 2}
test while-5.3 {break tests, nested loops with computed command names} -body {
    set a
} {1 2}
test while-5.3 {break tests, nested loops with computed command names} {
    set msg {}
    set i 1
    set z break
    while {$i <= 4} {
        set a 1
	while {$a <= 2} {
            if {$i>=2 && $a>=2} $z
            set msg [concat $msg "$i.$a"]
            incr a
        }
        incr i
    }
    return $msg
} -cleanup {
    unset a i z msg
} -result {1.1 1.2 2.1 3.1 4.1}
test while-5.4 {break tests, long command body with computed command names} -body {
    set msg
} {1.1 1.2 2.1 3.1 4.1}
test while-5.4 {break tests, long command body with computed command names} {
    set a {}
    set i 1
    set z break
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==5 $z
	if $i>5 continue
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
618



619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635



636
637
638
639
640
641
642
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







-
-
-
-
+
+



-
+







-
-
-
-
-
+
+
+








-
-
-
-
-
+
+
+








-
-
-
-
-
+
+
+












-
-
-
-
-
+
+
+







	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i z
} -result {1 3}
    set a
} {1 3}

# Check "continue" with computed command names.

test while-6.1 {continue and computed command names} -body {
test while-6.1 {continue and computed command names} {
    set i 0
    set z continue
    while 1 {
        incr i
        if {$i < 10} $z
        break
    }
    return $i
} -cleanup {
    unset i z
} -result 10
test while-6.2 {continue tests} -body {
    set i
} 10
test while-6.2 {continue tests} {
    set a {}
    set i 1
    set z continue
    while {$i <= 4} {
        incr i
	if {$i == 3} $z
	set a [concat $a $i]
    }
    return $a
} -cleanup {
    unset a i z
} -result {2 4 5}
test while-6.3 {continue tests with computed command names} -body {
    set a
} {2 4 5}
test while-6.3 {continue tests with computed command names} {
    set a {}
    set i 1
    set z continue
    while {$i <= 4} {
        incr i
	if {$i != 2} $z
	set a [concat $a $i]
    }
    return $a
} -cleanup {
    unset a i z
} -result {2}
test while-6.4 {continue tests, nested loops with computed command names} -body {
    set a
} {2}
test while-6.4 {continue tests, nested loops with computed command names} {
    set msg {}
    set i 1
    set z continue
    while {$i <= 4} {
        incr i
        set a 1
	while {$a <= 2} {
            incr a
            if {$i>=3 && $a>=3} $z
            set msg [concat $msg "$i.$a"]
        }
    }
    return $msg
} -cleanup {
    unset a i z msg
} -result {2.2 2.3 3.2 4.2 5.2}
test while-6.5 {continue tests, long command body with computed command names} -body {
    set msg
} {2.2 2.3 3.2 4.2 5.2}
test while-6.5 {continue tests, long command body with computed command names} {
    set a {}
    set i 1
    set z continue
    while {$i<6} {
	if $i==2 {incr i; continue}
	if $i==4 break
	if $i>5 $z
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
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
618
619












-
-
-
-
+
+



-
+









-
+


-
-
-
+




-
-
-
-
-
	    catch {set a $a} msg
	    catch {incr i 5} msg
	    catch {incr i -5} msg
	}
	set a [concat $a $i]
        incr i
    }
    return $a
} -cleanup {
    unset a i z
} -result {1 3}
    set a
} {1 3}

# Test for incorrect "double evaluation" semantics

test while-7.1 {delayed substitution of body} -body {
test while-7.1 {delayed substitution of body} {
    set i 0
    while {[incr i] < 10} "
       set result $i
    "
    proc p {} {
	set i 0
	while {[incr i] < 10} "
	    set result $i
	"
	return $result
	set result
    }
    append result [p]
} -cleanup {
    unset result i
} -result {00}
} {00}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End:

Changes to tests/winConsole.test.

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18
19
20











-
-
+
+







# This file tests the tclWinConsole.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}


test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive} {
    set oldmode [fconfigure stdin]

Changes to tests/winDde.test.

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
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













+









-
+



-













-
+







# This file tests the tclWinDde.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    #tcltest::configure -verbose {pass start}
    namespace import -force ::tcltest::*
}

testConstraint debug [::tcl::pkgconfig get debug]
testConstraint dde 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.3]
	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
	    set ::ddelib [info loaded "" Dde]}]} {
	testConstraint dde 1
    }
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]


# -------------------------------------------------------------------------
# Setup a script for a test server
#

set scriptName [makeFile {} script1.tcl]

proc createChildProcess {ddeServerName args} {
    file delete -force $::scriptName

    set f [open $::scriptName w+]
    puts $f [list set ddeServerName $ddeServerName]
    puts $f [list load $::ddelib dde]
    puts $f [list load $::ddelib Dde]
    puts $f {
        # DDE child server -
        #
	if {"::tcltest" ni [namespace children]} {
	    package require tcltest 2.5
	    namespace import -force ::tcltest::*
	}
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
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







-
+







-
+



-
+







} {1.4.3}

test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
    list [dde servername foobar] [dde servername] [dde servername self]
} -result {foobar foobar self}

test winDde-2.1 {Checking for other services} -constraints dde -body {
    expr [llength [dde services {} {}]] >= 0
    expr {[llength [dde services {} {}]] >= 0}
} -result 1
test winDde-2.2 {Checking for existence, with service and topic specified} \
	-constraints dde -body {
    llength [dde services TclEval self]
} -result 1
test winDde-2.3 {Checking for existence, with only the service specified} \
	-constraints dde -body {
    expr [llength [dde services TclEval {}]] >= 1
    expr {[llength [dde services TclEval {}]] >= 1}
} -result 1
test winDde-2.4 {Checking for existence, with only the topic specified} \
	-constraints dde -body {
    expr [llength [dde services {} self]] >= 1
    expr {[llength [dde services {} self]] >= 1}
} -result 1

# -------------------------------------------------------------------------

test winDde-3.1 {DDE execute locally} -constraints dde -body {
    set \xe1 ""
    dde execute TclEval self [list set \xe1 foo]
158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
158
159
160
161
162
163
164

165
166
167
168
169
170
171
172







-
+







test winDde-3.6 {DDE request utf-8} -constraints dde -body {
    set \xe1 "not set"
    dde execute TclEval self "set \xe1 \xc4"
    scan [set \xe1] %c
} -result 196
# Set variable a to A with diaeresis (unicode C4) using binary execute
# and compose utf-8 (e.g. "c3 84" ) manualy
test winDde-3.7 {DDE request binary} -constraints {dde notWine} -body {
test winDde-3.7 {DDE request binary} -constraints dde -body {
    set \xe1 "not set"
    dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00]
    scan [set \xe1] %c
} -result 196
test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
    set \xe1 ""
    dde poke TclEval self \xe1 \xc4
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
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







-
-
+
+

-
-
+
+

-
+

-
-
-
-
-
+
+
+
+
+








-
-
-
-
+
+
+
+



-
+


-
-
-
+
+
+



-
+


-
-
-
+
+
+



-
+





-
-
+
+

-
+

-
+


-
-
+
+

-
-
+
+

-
-
-
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
+


-
-
-
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+


-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+







} -cleanup {
    dde execute TclEval $name {set done 1}
    update
} -result "ch\xEDld-6.6"

# -------------------------------------------------------------------------

test winDde-7.1 {Load DDE in child interpreter} -constraints dde -setup {
    interp create child
test winDde-7.1 {Load DDE in slave interpreter} -constraints dde -setup {
    interp create slave
} -body {
    child eval [list load $::ddelib Dde]
    child eval [list dde servername -- dde-interp-7.1]
    slave eval [list load $::ddelib Dde]
    slave eval [list dde servername -- dde-interp-7.1]
} -cleanup {
    interp delete child
    interp delete slave
} -result {dde-interp-7.1}
test winDde-7.2 {DDE child cleanup} -constraints dde -setup {
    interp create child
    child eval [list load $::ddelib Dde]
    child eval [list dde servername -- dde-interp-7.5]
    interp delete child
test winDde-7.2 {DDE slave cleanup} -constraints dde -setup {
    interp create slave
    slave eval [list load $::ddelib Dde]
    slave eval [list dde servername -- dde-interp-7.5]
    interp delete slave
} -body {
    dde services TclEval {}
    set s [dde services TclEval {}]
    set m [list [list TclEval dde-interp-7.5]]
    if {$m in $s} {
	set s
    }
} -result {}
test winDde-7.3 {DDE present in child interp} -constraints dde -setup {
    interp create child
    child eval [list load $::ddelib Dde]
    child eval [list dde servername -- dde-interp-7.3]
test winDde-7.3 {DDE present in slave interp} -constraints dde -setup {
    interp create slave
    slave eval [list load $::ddelib Dde]
    slave eval [list dde servername -- dde-interp-7.3]
} -body {
    dde services TclEval dde-interp-7.3
} -cleanup {
    interp delete child
    interp delete slave
} -result {{TclEval dde-interp-7.3}}
test winDde-7.4 {interp name collision with -force} -constraints dde -setup {
    interp create child
    child eval [list load $::ddelib Dde]
    child eval [list dde servername -- dde-interp-7.4]
    interp create slave
    slave eval [list load $::ddelib Dde]
    slave eval [list dde servername -- dde-interp-7.4]
} -body {
    dde servername -force -- dde-interp-7.4
} -cleanup {
    interp delete child
    interp delete slave
} -result {dde-interp-7.4}
test winDde-7.5 {interp name collision without -force} -constraints dde -setup {
    interp create child
    child eval [list load $::ddelib Dde]
    child eval [list dde servername -- dde-interp-7.5]
    interp create slave
    slave eval [list load $::ddelib Dde]
    slave eval [list dde servername -- dde-interp-7.5]
} -body {
    dde servername -- dde-interp-7.5
} -cleanup {
    interp delete child
    interp delete slave
} -result "dde-interp-7.5 #2"

# -------------------------------------------------------------------------

test winDde-8.1 {Safe DDE load} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
} -body {
    child eval dde servername child
    slave eval dde servername slave
} -cleanup {
    interp delete child
    interp delete slave
} -returnCodes error -result {invalid command name "dde"}
test winDde-8.2 {Safe DDE set servername} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
} -body {
    child invokehidden dde servername child
} -cleanup {interp delete child} -result {child}
    slave invokehidden dde servername slave
} -cleanup {interp delete slave} -result {slave}
test winDde-8.3 {Safe DDE check handler required for eval} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child invokehidden dde servername child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave invokehidden dde servername slave
} -body {
    catch {dde eval child set a 1} msg
} -cleanup {interp delete child} -result {1}
    catch {dde eval slave set a 1} msg
} -cleanup {interp delete slave} -result {1}
test winDde-8.4 {Safe DDE check that execute is denied} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child invokehidden dde servername child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave invokehidden dde servername slave
} -body {
    child eval set a 1
    dde execute TclEval child {set a 2}
    child eval set a
} -cleanup {interp delete child} -result 1
    slave eval set a 1
    dde execute TclEval slave {set a 2}
    slave eval set a
} -cleanup {interp delete slave} -result 1
test winDde-8.5 {Safe DDE check that request is denied} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child invokehidden dde servername child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave invokehidden dde servername slave
} -body {
    child eval set a 1
    dde request TclEval child a
    slave eval set a 1
    dde request TclEval slave a
} -cleanup {
    interp delete child
    interp delete slave
} -returnCodes error -result {remote server cannot handle this command}
test winDde-8.6 {Safe DDE assign handler procedure} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
} -body {
    child invokehidden dde servername -handler DDEACCEPT child
} -cleanup {interp delete child} -result child
    slave invokehidden dde servername -handler DDEACCEPT slave
} -cleanup {interp delete slave} -result slave
test winDde-8.7 {Safe DDE check simple command} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
    child invokehidden dde servername -handler DDEACCEPT child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
    slave invokehidden dde servername -handler DDEACCEPT slave
} -body {
    dde eval child set x 1
} -cleanup {interp delete child} -result {set x 1}
    dde eval slave set x 1
} -cleanup {interp delete slave} -result {set x 1}
test winDde-8.8 {Safe DDE check non-list command} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
    child invokehidden dde servername -handler DDEACCEPT child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
    slave invokehidden dde servername -handler DDEACCEPT slave
} -body {
    set s "c:\\Program Files\\Microsoft Visual Studio\\"
    dde eval child $s
    string equal [child eval set DDECMD] $s
} -cleanup {interp delete child} -result 1
    dde eval slave $s
    string equal [slave eval set DDECMD] $s
} -cleanup {interp delete slave} -result 1
test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    child invokehidden dde servername -handler DDEACCEPT child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    slave invokehidden dde servername -handler DDEACCEPT slave
} -body {
    dde eval child set \xe1 1
    child eval set \xe1
} -cleanup {interp delete child} -result 1
    dde eval slave set \xe1 1
    slave eval set \xe1
} -cleanup {interp delete slave} -result 1
test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    child invokehidden dde servername -handler DDEACCEPT child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    slave invokehidden dde servername -handler DDEACCEPT slave
} -body {
    dde eval child [list set x 1]
    child eval set x
} -cleanup {interp delete child} -result 1
    dde eval slave [list set x 1]
    slave eval set x
} -cleanup {interp delete slave} -result 1
test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints dde -setup {
    interp create -safe child
    child invokehidden load $::ddelib Dde
    child eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    child invokehidden dde servername -handler DDEACCEPT child
    interp create -safe slave
    slave invokehidden load $::ddelib Dde
    slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
    slave invokehidden dde servername -handler DDEACCEPT slave
} -body {
    dde eval child [list [list set x 1]]
    child eval set x
} -cleanup {interp delete child} -returnCodes error -result {invalid command name "set x 1"}
    dde eval slave [list [list set x 1]]
    slave eval set x
} -cleanup {interp delete slave} -returnCodes error -result {invalid command name "set x 1"}

# -------------------------------------------------------------------------

test winDde-9.1 {External safe DDE check string passing} -constraints {dde stdio} -setup {
    set name ch\xEDld-9.1
    set child [createChildProcess $name -handler Handler1]
    file copy -force script1.tcl dde-script.tcl
477
478
479
480
481
482
483
484

485
486
487
488
489
490
491
477
478
479
480
481
482
483

484
485
486
487
488
489
490
491







-
+







    update
    file delete -force -- dde-script.tcl
} -result {null data}

# -------------------------------------------------------------------------

#cleanup
#catch {interp delete $child};           # ensure we clean up the child.
#catch {interp delete $slave};           # ensure we clean up the slave.
file delete -force $::scriptName
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/winFCmd.test.

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
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












-
-
+
+



-
-
-










-
-







# This file tests the tclWinFCmd.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Initialise the test constraints

testConstraint winVista 0
testConstraint winXP 0
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile       [llength [info commands testfile]]
testConstraint testchmod      [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}
56
57
58
59
60
61
62
63

64
65
66
67
68
69
70
51
52
53
54
55
56
57

58
59
60
61
62
63
64
65







-
+







	}
    }
}

if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) >= 5.0} {
	testConstraint winVista 1
    } else {
    } elseif {$::tcl_platform(osVersion) >= 4.0} {
	testConstraint winXP 1
    }
}

# find a CD-ROM so we can test read-only filesystems.

proc findfile {dir} {
90
91
92
93
94
95
96
97

98
99
100
101
102
103

104
105
106
107
108
109
110
85
86
87
88
89
90
91

92






93
94
95
96
97
98
99
100







-
+
-
-
-
-
-
-
+







        }
    }
}

# NB: filename is chosen to be short but unlikely to clash with other apps
if {[file exists c:/] && [file exists d:/]} {
    catch {file delete d:/TclTmpF.1}
    catch {file delete d:/TclTmpD.1}
    if {[catch {close [open d:/TclTmpF.1 w]}] == 0} {
    catch {file delete c:/TclTmpC.1}
    if {![catch {createfile d:/TclTmpF.1 {}}] && [file isfile d:/TclTmpF.1]
	&& ![catch {file mkdir d:/TclTmpD.1}] && [file isdirectory d:/TclTmpD.1]
	&& ![catch {file mkdir c:/TclTmpC.1}] && [file isdirectory c:/TclTmpC.1]
    } {
	file delete d:/TclTmpF.1 d:/TclTmpD.1 c:/TclTmpC.1
	file delete d:/TclTmpF.1
	testConstraint exdev 1
    }
}

file delete -force -- td1
if {![catch {open td1 w} testfile]} {
    close $testfile
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
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
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
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
611
612

613
614
615
616

617
618
619

620
621
622
623
624
625





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
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
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
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


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
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
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
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
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


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
611
612


613


614


615
616

617
618


619
620
621

622



623
624
625
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
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
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
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







-
-
-
-
+
+
+
+

-


-
-
-
+
+
+

-
-
-
-
+
+
+

-

-
-
-
+
+
+

-


-
-
-
+
+
+

-
-
-
-
+
+
+

-
-
-
-
+
+
+

-

-
-
-
+
+
+

-


-
-
-
-
+
+
+
+
-
-
-
+
+
-
-
-
-
+
+
+
+

-

-
+
-
-
-
-
+
+
+
+

-


-
+
-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+

-

-
-
-
+
+
+

-



-
-
+
+

-
-
-
-
+
+
+

-
-
-
-
+
+
+

-
-
-
-
+
+
+
-
-
-
-
-
-
+
+

+
+
+
-
-
-
-
+
+
+
+
+

-

-
-
-
+
+
+

-

-
-
-
+
+
+

-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-

-
+
-
-
-
-
+
+
+
+

-




-
-
+
+

-
-
-
-
-
-
-
-

+
+
+
+
+
+

-
-
-
+
+
+

-


-
-
-
+
+
+

-




-
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-


-
+
-
-
-
-
+
+
-
-


-
+
-
-
-
-
+
+
-
-




-
-
-
+

-
+



-
-
+
+
-
-
+
-
-
-
-
+
+
+
-
-
-
+
-
-
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
+
+
-
-
+
+
-
-
-
-
+
+
+

-
-
+
+
+
-
-
-
-

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
-
-
-
-
+
+

-
-
+
-
-
-
+
+
+
-
-
-
+

-
-
+
-
-
-
+
-
-
+
-
-
+
+
+

-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
+
+

-
-
-
+
+
+
-
-
+
+

+
-
-
+
+
+

-
-
+
-
-
+
-
-
+
+

-
-
+
+
+
+
+

-

+
-
+

-
+
-
-
+
-
-
-
+

-

-
-
-
-
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
+
+
-
-
-
+

-

-
-
+
+
+

-
-
+
+
+

-
-
-
-
-
+
+
+

+
+
+
-
-
+
+
+

-
-
+
+
-
-
+
-
-
-
-

-
-
+
-
-
-
-
+
+
+
+

-

-
+
-
-
-
-
+
+

-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+

-

+
-
+
-

-
-
-
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
+
+

-

-
-
+
+
+

-
-
+
+
+

-
-
-
+
-
-
+
-
-
+
+
+

-
-
+
-
-
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
-
-
-
-
+
-
-
-
+

-
-
-
-
-
+
+
+
+
+
-
-
+
-
-
-
-
+
+

-
-
-
+
+
-
-
+

-
-
-
+
+
+

-
-
+
-
-
+
-
-
-
+
+

-
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
-
-
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
+

-

-
-
-
+
+
+
+
+
+

-

-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
+
+
+
+
+
+
-
-
-
+
+
+
-
-
+
-
-
+
-
-
+

-


-
-
+
+

-

-
-
-
+
+
+

-



-
+

-
+

-



-
-
+
+

-



-
-
-
-
+
+

-
-
-
-
+
+
+

-




-
-
-
-
+
+

-




-
-
-
-
+
+

-




-
-
+
+

-




-
-
-
-
-
+
+
+
+
+
+
+
-
-
+




-
+

-


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-




-
-
+
+
-
-
-
-
-
-
-

+
+
+
+
-
-
+
+

-

-
+
-
-
-
-
-
+
+

-


-
+
-
-
-
+

-




-
-
-
-
+
+
+

-








-
-
-
-
+
+

-


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-




-
-
+
+

-
-
-
+
+

-
+

-

-
-
-
+
+
+

-

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-


-
+
-
-

-
+

-



-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
-
-
+
-
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+

+
+
-
-
-
-
+
+
+
+
+
+
+

+
+
-
-
+
+

-
-
-
-
+
+
+
+

+
+
-
-
+
+

-
-
-
+
+
-
-
-
-
+
+

-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-

+
+
+
+
+
+
+
+
+
+
+
-
+

-
-
-
+
+
-
-
-
-
+
+

-

-
-
+
+
-
-
-
-
+
+

-


+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+

-
-
+
+









-
+

-
-
+
+

-
-
-
+
+
-
-
-
-
+
+

-
-
-
-
+
+
+
-
-
-
+

-
-
-
+
+
-
-
-
+

-
+

-
-
-
+
+
-
-
-
+

-
+

-
-
-
+
+
-
-
-
+

-
+

-
-
-
-
+
+
+

-
-
-
+
+
-
-
-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
-
-
+
-
-
-
-
+
+

-
-
-
+
+
-
-
-
-
+
+

-
-
-
+
+
-
-
-
-
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
-
-
-
-
+
+

-
-
-
+
+
-
-
-
-
+
+

-
-
+
-
-
-
+
+

-
-
-
-
+
+
+
+
-

+
-
+
+


+
-
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
+

-
+

-
+







append longname $longname

# Uses the "testfile" command instead of the "file" command.  The "file"
# command provides several layers of sanity checks on the arguments and
# it can be difficult to actually forward "insane" arguments to the
# low-level posix emulation layer.

test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body {
    testfile mv $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup {
test winFCmd-1.1 {TclpRenameFile: errno: EACCES} {win cdrom testfile} {
    list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
} {1 EACCES}
test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1/td2/td3
    file mkdir td2
    testfile mv td2 td1/td2
} -returnCodes error -result EEXIST
test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} -setup {
    list [catch {testfile mv td2 td1/td2} msg] $msg
} {1 EEXIST} 
test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    testfile mv / td1
} -returnCodes error -result EINVAL
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
    list [catch {testfile mv / td1} msg] $msg
} {1 EINVAL}
test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    testfile mv td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup {
    list [catch {testfile mv td1 td1/td2} msg] $msg
} {1 EINVAL}
test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
} -returnCodes error -result EISDIR
test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup {
    list [catch {testfile mv tf1 td1} msg] $msg
} {1 EISDIR}
test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile mv tf1 tf2
} -returnCodes error -result ENOENT
test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} -setup {
    list [catch {testfile mv tf1 tf2} msg] $msg
} {1 ENOENT}
test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile mv "" tf2
} -returnCodes error -result ENOENT
test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} -setup {
    list [catch {testfile mv "" tf2} msg] $msg
} {1 ENOENT}
test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile mv tf1 ""
} -returnCodes error -result ENOENT
test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} -setup {
    list [catch {testfile mv tf1 ""} msg] $msg
} {1 ENOENT}
test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv td1 tf1
} -returnCodes error -result ENOTDIR
test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} -setup {
    file delete -force d:/TclTmpD.1
    list [catch {testfile mv td1 tf1} msg] $msg
} {1 ENOTDIR}
test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} {win exdev testfile} {
    file delete -force d:/tf1
} -constraints {win exdev testfile} -body {
    file mkdir c:/TclTmpC.1
    testfile mv c:/TclTmpC.1 d:/TclTmpD.1
    file mkdir c:/tf1
    set msg [list [catch {testfile mv c:/tf1 d:/tf1} msg] $msg]
} -cleanup {
    file delete -force c:/TclTmpC.1
} -returnCodes error -result EXDEV
test winFCmd-1.11 {TclpRenameFile: errno: EACCES} -setup {
    file delete -force c:/tf1
    set msg
} {1 EXDEV}
test winFCmd-1.11 {TclpRenameFile: errno: EACCES} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    set fd [open tf1 w]
    testfile mv tf1 tf2
    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
} -cleanup {
    catch {close $fd}
} -returnCodes error -result EACCES
test winFCmd-1.12 {TclpRenameFile: errno: EACCES} -setup {
    close $fd
    set msg
} {1 EACCES}
test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    set fd [open tf2 w]
    testfile mv tf1 tf2
    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
} -cleanup {
    catch {close $fd}
} -returnCodes error -result EACCES
test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
    close $fd
    set msg
} {1 EACCES}
test winFCmd-1.13 {TclpRenameFile: errno: EINVAL|EACCES|ENOENT} -constraints {win testfile} -body {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
    list [catch {testfile mv nul tf1} msg] $msg
} -match regexp -result {1 (EINVAL|EACCES|ENOENT)}
test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {win 95 testfile} {
    cleanup
    createfile tf1
    list [catch {testfile mv tf1 nul} msg] $msg
} {1 EACCES}
test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {win nt testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile mv tf1 nul
} -returnCodes error -result EEXIST
test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} -setup {
    list [catch {testfile mv tf1 nul} msg] $msg
} {1 EEXIST}
test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    testfile mv tf1 tf2
    list [file exists tf1] [contents tf2]
} -result {0 tf1}
test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} -setup {
} {0 tf1}
test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile mv tf1 tf2
} -returnCodes error -result ENOENT
test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup {
    list [catch {testfile mv tf1 tf2} msg] $msg
} {1 ENOENT} 
test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile mv tf1 tf2
} -returnCodes error -result ENOENT
test winFCmd-1.19 {TclpRenameFile: errno == EACCES} -setup {
    list [catch {testfile mv tf1 tf2} msg] $msg
} {1 ENOENT} 
test winFCmd-1.19 {TclpRenameFile: errno == EINVAL|EACCES|ENOENT} -constraints {win testfile} -body {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile mv nul tf1
} -returnCodes error -result EINVAL
test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
    list [catch {testfile mv nul tf1} msg] $msg
} -match regexp -result {1 (EINVAL|EACCES|ENOENT)}
test winFCmd-1.20 {TclpRenameFile: src is dir} {win nt testfile} {
    cleanup
} -constraints {win testfile} -body {
    file delete /tf1
    testfile mv [pwd] /tf1
} -returnCodes error -result EACCES
test winFCmd-1.21 {TclpRenameFile: long src} -setup {
    # under 95, this would actually succeed and move the current dir out from 
    # under the current process!
    cleanup
    file delete /tf1
    list [catch {testfile mv [pwd] /tf1} msg] $msg
} {1 EACCES}
} -constraints {win testfile} -body {
    testfile mv $longname tf1
} -returnCodes error -result ENAMETOOLONG
test winFCmd-1.22 {TclpRenameFile: long dst} -setup {
test winFCmd-1.21 {TclpRenameFile: long src} {win testfile} {
    cleanup
    list [catch {testfile mv $longname tf1} msg] $msg
} {1 ENAMETOOLONG}
test winFCmd-1.22 {TclpRenameFile: long dst} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile mv tf1 $longname
} -returnCodes error -result ENAMETOOLONG
test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup {
    list [catch {testfile mv tf1 $longname} msg] $msg
} {1 ENAMETOOLONG}
test winFCmd-1.23 {TclpRenameFile: move dir into self} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    testfile mv [pwd]/td1 td1/td2
} -returnCodes error -result EINVAL
test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup {
    list [catch {testfile mv [pwd]/td1 td1/td2} msg] $msg
} {1 EINVAL}
test winFCmd-1.24 {TclpRenameFile: move a root dir} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile mv / c:/
} -returnCodes error -result EINVAL
    list [catch {testfile mv / c:/} msg] $msg
} {1 EINVAL}
test winFCmd-1.25 {TclpRenameFile: cross file systems} -setup {
    cleanup
} -constraints {win cdrom testfile} -body {
    file mkdir td1
    testfile mv td1 $cdrom/td1
} -returnCodes error -result EXDEV
test winFCmd-1.26 {TclpRenameFile: readonly fs} -setup {
    cleanup
} -constraints {win cdrom testfile} -body {
    testfile mv $cdfile $cdrom/dummy~~.fil
} -returnCodes error -result EACCES
test winFCmd-1.27 {TclpRenameFile: open file} -setup {
test winFCmd-1.25 {TclpRenameFile: cross file systems} {win cdrom testfile} {
    cleanup
    file mkdir td1
    list [catch {testfile mv td1 $cdrom/td1} msg] $msg
} {1 EXDEV} 
test winFCmd-1.26 {TclpRenameFile: readonly fs} {win cdrom testfile} {
    cleanup
    list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
} {1 EACCES}
test winFCmd-1.27 {TclpRenameFile: open file} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    set fd [open tf1 w]
    testfile mv tf1 tf2
    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
} -cleanup {
    catch {close $fd}
} -returnCodes error -result EACCES
test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} -setup {
    close $fd
    set msg
} {1 EACCES}    
test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    createfile tf2
    testfile mv tf1 tf2
    list [file exists tf1] [file exists tf2]
} -result {0 1}
test winFCmd-1.29 {TclpRenameFile: src is dir} -setup {
} {0 1}
test winFCmd-1.29 {TclpRenameFile: src is dir} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv td1 tf1
} -returnCodes error -result ENOTDIR
test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    createfile tf1
    list [catch {testfile mv td1 tf1} msg] $msg
} {1 ENOTDIR} 
test winFCmd-1.30 {TclpRenameFile: dst is dir} {win testfile} {
    cleanup
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup {
    list [catch {testfile mv td1 td2} msg] $msg
} {1 EEXIST}
test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    file mkdir td2/td2
    testfile mv td1 td2
} -returnCodes error -result EEXIST
test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup {
    list [catch {testfile mv td1 td2} msg] $msg
} {1 EEXIST}
test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1/td2
    file mkdir td2
    testfile mv td1 td2
    list [file exists td1] [file exists td2] [file exists td2/td2]
} -result {0 1 1}
} {0 1 1}
test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
	-constraints {win exdev testfile testchmod} -body {
    file mkdir d:/TclTmpD.1
    testchmod 0 d:/TclTmpD.1
    file mkdir c:/TclTmpC.1
    catch {testfile mv c:/TclTmpC.1 d:/TclTmpD.1} msg
    list $msg [file writable d:/TclTmpD.1]
	{win exdev testfile testchmod} {
    file mkdir d:/td1
    testchmod 000 d:/td1
    file mkdir c:/tf1
    set msg [list [catch {testfile mv c:/tf1 d:/td1} msg] $msg]
    set msg "$msg [file writable d:/td1]"
} -cleanup {
    catch {testchmod 0o666 d:/TclTmpD.1}
    file delete d:/TclTmpD.1
    file delete -force c:/TclTmpC.1
} -result {EXDEV 0}
test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} -setup {
    file delete d:/td1
    file delete -force c:/tf1
    set msg
} {1 EXDEV 0}
test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile tf1
    testfile mv td1 tf1
    list [catch {testfile mv td1 tf1} msg] $msg
} -cleanup {
    cleanup
} -returnCodes error -result ENOTDIR
test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup {
} {1 ENOTDIR}
test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} {win testfile} {
    cleanup
} -constraints {win testfile notWine} -body {
    file mkdir td1
    createfile tf1
    testfile mv tf1 td1
    list [catch {testfile mv tf1 td1} msg] $msg
} -cleanup {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup {
} {1 EISDIR}
test winFCmd-1.36 {TclpRenameFile: src and dst not dir} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testfile mv tf1 tf2
    contents tf2
} -cleanup {
    cleanup
} -result {tf1}
} {tf1}
test winFCmd-1.37 {TclpRenameFile: need to restore temp file} {win emptyTest} {
    # Can't figure out how to cause this.
    # Can't figure out how to cause this. 
    # Need a file that can't be copied.
} {}

# If the native filesystem produces 0 for inodes numbers there is no point
# doing the following test.
test winFCmd-2.1 {TclpCopyFile: errno: EACCES} {win cdrom testfile} {
    cleanup
testConstraint winNonZeroInodes [eval {
    file stat [info nameofexecutable] statExe
    list [catch {testfile cp $cdfile $cdrom/dummy~~.fil} msg] $msg
    expr {$statExe(ino) != 0}
}]

proc MakeFiles {dirname} {
} {1 EACCES}
test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} {win testfile} {
    cleanup
    set inodes {}
    set ndx -1
    while {1} {
    file mkdir td1
        # upped to 50K for 64bit Server 2008
        if {$ndx > 50000} {
    list [catch {testfile cp td1 tf1} msg] $msg
} {1 EISDIR}
            return -code error "limit reached without finding a collistion."
        }
        set filename [file join $dirname Test[incr ndx]]
        set f [open $filename w]
        close $f
        file stat $filename stat
test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} {win testfile} {
    cleanup
    createfile tf1
    file mkdir td1
        if {[set n [lsearch -exact -integer $inodes $stat(ino)]] >= 0} {
            return [list [file join $dirname Test$n] $filename]
        }
    list [catch {testfile cp tf1 td1} msg] $msg
} {1 EISDIR}
        lappend inodes $stat(ino)
        unset stat
test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} {win testfile} {
    cleanup
    }
}

test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
    list [catch {testfile cp tf1 tf2} msg] $msg
} {1 ENOENT}
test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} {win testfile} {
    cleanup
} -constraints {win winNonZeroInodes knownMsvcBug notWine} -body {
    file mkdir td1
    list [catch {testfile cp "" tf2} msg] $msg
} {1 ENOENT}
test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {win testfile} {
    foreach {a b} [MakeFiles td1] break
    file rename -force $a $b
    file exists $a
} -cleanup {
    cleanup
} -result {0}


test winFCmd-2.1 {TclpCopyFile: errno: EACCES} -setup {
    createfile tf1
    list [catch {testfile cp tf1 ""} msg] $msg
} {1 ENOENT}
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {win 95 testfile} {
    cleanup
} -constraints {win cdrom testfile} -body {
    testfile cp $cdfile $cdrom/dummy~~.fil
} -returnCodes error -result EACCES
test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} -setup {
    createfile tf1
    set fd [open tf2 w]
    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
    close $fd
    set msg
} {1 EACCES}
test winFCmd-2.8 {TclpCopyFile: errno: EINVAL|EACCES|ENOENT} -constraints {win testfile} -body {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cp td1 tf1
    list [catch {testfile cp nul tf1} msg] $msg
} -cleanup {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} -setup {
} -match regexp -result {1 (EINVAL|EACCES|ENOENT)}
test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    createfile tf1 tf1
    file mkdir td1
    testfile cp tf1 td1
} -cleanup {
    testfile cp tf1 tf2
    list [contents tf1] [contents tf2]
} {tf1 tf1}
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} -setup {
test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile cp tf1 tf2
    createfile tf1 tf1
} -returnCodes error -result ENOENT
test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} -setup {
    cleanup
    createfile tf2 tf2
} -constraints {win testfile} -body {
    testfile cp "" tf2
    testfile cp tf1 tf2
} -returnCodes error -result ENOENT
test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup {
    list [contents tf1] [contents tf2]
} {tf1 tf1}
test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile cp tf1 ""
    createfile tf1 tf1
    testchmod 000 tf1
} -cleanup {
    cleanup
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
    cleanup
} -constraints {win winXP testfile} -body {
    testfile cp nul tf1
    testfile cp tf1 tf2
} -returnCodes error -result EINVAL
test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
    list [contents tf2] [file writable tf2]
} {tf1 0}
test winFCmd-2.13 {TclpCopyFile: CopyFile fails} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    testfile cp tf1 tf2
    createfile tf1
    file mkdir td1
    list [catch {testfile cp tf1 td1} msg] $msg
    list [contents tf1] [contents tf2]
} -cleanup {
} {1 EISDIR} 
test winFCmd-2.14 {TclpCopyFile: errno == EACCES} {win testfile} {
    cleanup
    file mkdir td1
} -result {tf1 tf1}
test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} -setup {
    list [catch {testfile cp td1 tf1} msg] $msg
} {1 EISDIR}
test winFCmd-2.15 {TclpCopyFile: src is directory} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    file mkdir td1
    createfile tf2 tf2
    testfile cp tf1 tf2
    list [catch {testfile cp td1 tf1} msg] $msg
    list [contents tf1] [contents tf2]
} -cleanup {
} {1 EISDIR}
test winFCmd-2.16 {TclpCopyFile: dst is directory} {win testfile} {
    cleanup
} -result {tf1 tf1}
test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup {
    createfile tf1
    file mkdir td1
    list [catch {testfile cp tf1 td1} msg] $msg
} {1 EISDIR}
test winFCmd-2.17 {TclpCopyFile: dst is readonly} {win testfile testchmod} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1 tf1
    createfile tf2 tf2
    testchmod 0 tf1
    testchmod 000 tf2
    testfile cp tf1 tf2
    list [contents tf2] [file writable tf2]
    list [file writable tf2] [contents tf2]
} -cleanup {
    catch {testchmod 0o666 tf1}
} {1 tf1}
    cleanup
} -result {tf1 0}
test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup {
test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {win 95 testfile testchmod} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    file mkdir td1
    testfile cp tf1 td1
} -cleanup {
    cleanup
    createfile tf2
    testchmod 000 tf2
    set fd [open tf2]
    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
    close $fd
    set msg "$msg [file writable tf2]"
} -returnCodes error -result EISDIR
test winFCmd-2.14 {TclpCopyFile: errno == EACCES} -setup {
} {1 EACCES 0}    
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cp td1 tf1
} -cleanup {

test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} {win cdrom testfile} {
    list [catch {testfile rm $cdfile $cdrom/dummy~~.fil} msg] $msg
} {1 EACCES}
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-2.15 {TclpCopyFile: src is directory} -setup {
test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cp td1 tf1
} -cleanup {
    list [catch {testfile rm td1} msg] $msg
} {1 EISDIR} 
test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} {win testfile} {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-2.16 {TclpCopyFile: dst is directory} -setup {
    list [catch {testfile rm tf1} msg] $msg
} {1 ENOENT}
test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    file mkdir td1
    testfile cp tf1 td1
} -cleanup {
    list [catch {testfile rm ""} msg] $msg
} {1 ENOENT}
test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} {win testfile} {
    cleanup
    set fd [open tf1 w]
    set msg [list [catch {testfile rm tf1} msg] $msg]
    close $fd
} -returnCodes error -result EISDIR
test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
    set msg
} {1 EACCES}
test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} {win testfile} {
    cleanup
} -constraints {win testfile testchmod} -body {
    createfile tf1 tf1
    list [catch {testfile rm nul} msg] $msg
} {1 EACCES}
    createfile tf2 tf2
    testchmod 0 tf2
test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} {win testfile} {
    testfile cp tf1 tf2
    list [file writable tf2] [contents tf2]
} -cleanup {
    catch {testchmod 0o666 tf2}
    cleanup
} -result {1 tf1}

    createfile tf1
test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
    testfile rm $cdfile $cdrom/dummy~~.fil
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup {
    testfile rm tf1
    file exists tf1
} {0}
test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile rm td1
    list [catch {testfile rm td1} msg] $msg
} -cleanup {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} -setup {
} {1 EISDIR}
test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile rm tf1
} -returnCodes error -result ENOENT
test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} -setup {
    set fd [open tf1 w]
    set msg [list [catch {testfile rm tf1} msg] $msg]
    close $fd
    set msg
} {1 EACCES}
test winFCmd-3.10 {TclpDeleteFile: path is readonly} {win testfile testchmod} {
    cleanup
} -constraints {win testfile} -body {
    testfile rm ""
} -returnCodes error -result ENOENT
test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} -setup {
    createfile tf1
    testchmod 000 tf1
    testfile rm tf1
    file exists tf1
} {0}
test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {win testfile testchmod} {
    cleanup
} -constraints {win testfile} -body {
    set fd [open tf1 w]
    testchmod 000 tf1
    testfile rm tf1
    set msg [list [catch {testfile rm tf1} msg] $msg]
} -cleanup {
    close $fd
    cleanup
} -returnCodes error -result EACCES
test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} -setup {
    set msg
} {1 EACCES}

    cleanup
} -constraints {win testfile} -body {
    testfile rm nul
} -returnCodes error -result EACCES
test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} -setup {
test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {win nt cdrom testfile} {
    list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
} {1 EACCES}
test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {win 95 cdrom testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile rm tf1
    list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
    file exists tf1
} -result {0}
test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} -setup {
} {1 ENOSPC}
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile rm td1
} -cleanup {
    list [catch {testfile mkdir td1} msg] $msg
} {1 EEXIST}
test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} {win testfile} {
    cleanup
} -returnCodes error -result EISDIR
test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} -setup {
    list [catch {testfile mkdir td1/td2} msg] $msg
} {1 ENOENT}
test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    set fd [open tf1 w]
    testfile rm tf1
    testfile mkdir td1
} -cleanup {
    close $fd
    file type td1
} -returnCodes error -result EACCES
test winFCmd-3.10 {TclpDeleteFile: path is readonly} -setup {
} {directory}

test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} {win testfile} {
    cleanup
} -constraints {win testfile testchmod} -body {
    createfile tf1
    file mkdir td1
    testchmod 0 tf1
    testfile rm tf1
    file exists tf1
} -result {0}
test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {
    testfile cpdir td1 td2
    list [file type td1] [file type td2]
} {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {win testfile testchmod} {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1
    set fd [open tf1 w]
    testchmod 0 tf1
    testfile rm tf1
} -cleanup {
    close $fd
    catch {testchmod 0o666 tf1}
    cleanup
    testchmod 000 td1
    catch {
        testfile rmdir td1
        file exists td1
    } r
    catch {
        testchmod 777 td1
        cleanup
} -returnCodes error -result EACCES

    }
test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
    testfile mkdir $cdrom/dummy~~.dir
} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
    cleanup
    set r
} -constraints {win testfile} -body {
    file mkdir td1
    testfile mkdir td1
} -cleanup {
} {0}
    cleanup
} -returnCodes error -result EEXIST
test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} -setup {
test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile mkdir td1/td2
} -returnCodes error -result ENOENT
test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} -setup {
    cleanup
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} {1 {td1 EEXIST}}
test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest} {
    # can't test this w/o removing everything on your hard disk first!
} -constraints {win testfile} -body {
    testfile mkdir td1
    # testfile rmdir /
    file type td1
} -cleanup cleanup -result directory

test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup {
} {}
test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} {1 {td1 ENOENT}}
    list [file type td1] [file type td2]
} -cleanup {
test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {win testfile} {
    cleanup
} -result {directory directory}

test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
    list [catch {testfile rmdir ""} msg] $msg
} {1 ENOENT}
test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {win testfile} {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    createfile tf1
    testchmod 0 td1
    testfile rmdir td1
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
} {1 {tf1 ENOTDIR}}
test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {win testfile} {
    cleanup
} -result {td1 EACCES}
# This next test has a very hokey way of matching...
test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    file mkdir td1
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}
test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest} {
    # can't test this w/o removing everything on your hard disk first!
    # testfile rmdir /
} {}
    testfile rmdir td1
    file exists td1
} {0}
# This next test has a very hokey way of matching...
test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} -setup {
test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 ENOENT}}
test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} -setup {
    createfile tf1
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
} {1 {tf1 ENOTDIR}}
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {win testfile testchmod} {
    cleanup
} -constraints {win testfile} -body {
    testfile rmdir ""
} -returnCodes error -result ENOENT
# This next test has a very hokey way of matching...
test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} -setup {
    cleanup
    file mkdir td1
    testchmod 000 td1
    catch {
        testfile rmdir td1
        file exists td1
    } r
    catch {
        testchmod 777 td1
        cleanup
} -constraints {win testfile} -body {
    createfile tf1
    }
    set r
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} -setup {
} {0}
test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {win 95 testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile rmdir td1
    file exists td1
    list [catch {testfile rmdir nul} msg] $msg
} {1 {nul EACCES}}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {win nt testfile} {
    cleanup
    set res [list [catch {testfile rmdir /} msg] $msg]
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
    regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST"
} [list 1 [list / EACCES or EEXIST]]
} -result {0}
# This next test has a very hokey way of matching...
test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup {
test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {win 95 testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    list [catch {testfile rmdir tf1} msg] [file tail $msg]
} -result {1 {tf1 ENOTDIR}}
test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
    set res [catch {testfile rmdir tf1} msg]
    # get rid of path
    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
    list $res $msg
} {1 {tf1 ENOTDIR}}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {win testfile testchmod} {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
} -returnCodes error -cleanup {
    catch {testchmod 0o666 td1}
    testchmod 000 td1
    catch {
        testfile rmdir td1
        file exists td1
    } r
    catch {
    cleanup
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
    cleanup
} -constraints {win testfile notWine} -body {
    testfile rmdir /
        testchmod 777 td1
    # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
    # decision has been made as to which is correct.
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
    cleanup
        cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1
    }
    set r
} {0}
test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {win 95 testfile} {
    cleanup
    file mkdir td1/td2
    testchmod 0 td1
    testfile rmdir td1
    file exists td1
    set res [catch {testfile rmdir td1} msg]
    # get rid of path
    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
} -cleanup {
    catch {testchmod 0o666 td1}
    list $res $msg
    cleanup
} -returnCodes error -result {td1 EACCES}
} {1 {td1 EEXIST}}
# This next test has a very hokey way of matching...
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    list [catch {testfile rmdir td1} msg] [file tail $msg]
} -result {1 {td1 EEXIST}}
test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} -setup {
} {1 {td1 EEXIST}}
test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    createfile tf1
    testfile rmdir -force tf1
} -returnCodes error -result {tf1 ENOTDIR}
test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} -setup {
    list [catch {testfile rmdir -force tf1} msg] $msg
} {1 {tf1 ENOTDIR}}
test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2
    testfile rmdir -force td1
    file exists td1
} -result {0}
} {0}

test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} -setup {
test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2/td3
    testfile rmdir -force td1
    file exists td1
} -result {0}
test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} -setup {
} {0}
test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td2/td3
    testfile cpdir td1 td2
    list [file exists td1] [file exists td2]
} -cleanup {
    cleanup
} -result {1 1}
test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} -setup {
} {1 1}
test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile cpdir td1 td2
} -returnCodes error -result {td1 ENOENT}
test winFCmd-7.4 {TraverseWinTree: source isn't directory} -setup {
    list [catch {testfile cpdir td1 td2} msg] $msg
} {1 {td1 ENOENT}}
test winFCmd-7.4 {TraverseWinTree: source isn't directory} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} -setup {
} {tf1}
test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} -setup {
} {tf1}
test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testfile rmdir -force td1
    file exists td1
} -result {0}
test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup {
} {0}
test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
} -result {tf1}
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
    testfile rmdir $cdrom/
} {tf1}    
test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {win 95 cdrom testfile} {
    # cdrom can return either d:\ or D:/, but we only care about the errcode
    list [catch {testfile rmdir $cdrom/} msg] [lindex $msg 1]
} {1 EACCES} ; # was EEXIST, but changed for win98.
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {win nt cdrom testfile} {
    list [catch {testfile rmdir $cdrom/} msg]  [lindex $msg 1]
} -constraints {win cdrom testfile} -returnCodes error -match glob \
    -result {* EACCES}
} {1 EACCES}
test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
	{win emptyTest} {
    # can't make it happen
} {}
test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup {
test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {win testfile testchmod} {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testchmod 0 td1
    testfile cpdir td1 td2
    list [file exists td2] [file writable td2]
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {1 1}
test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup {
    testchmod 000 td1
    catch {
        testfile cpdir td1 td2
        list [file exists td2] [file writable td2]
    } r
    catch {
        testchmod 777 td1
        cleanup
    }
    set r
} {1 1}
test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testfile rmdir -force td1
    file exists td1
} -result {0}
test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup {
} {0}
test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -cleanup {
    cleanup
    file mkdir td1
    createfile td1/tf1 tf1
    testfile cpdir td1 td2
    contents td2/tf1
} -result {tf1}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
} {tf1}
test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} -constraints {win testfile} -body {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 /
    list [catch {testfile cpdir td1 /} msg] $msg
} -cleanup {
    cleanup
    # Windows7 returns EEXIST, XP returns EACCES
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} -setup {
} -match regexp -result {1 \{/ (EEXIST|EACCES)\}}
test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 td2
} -cleanup {
} {}
    cleanup
} -result {}
test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} -setup {
test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/td2
    testfile cpdir td1 td2
    glob td2/*
} -cleanup {
    cleanup
} -result {td2/td2}
test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} -setup {
} {td2/td2}
test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \
	{win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    createfile td1/tf2
    file mkdir td1/td2/td3
    createfile td1/tf3
    createfile td1/tf4
    testfile cpdir td1 td2
    lsort [glob td2/*]
} -cleanup {
    cleanup
} -result {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup {
} {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {win testfile testchmod} {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testchmod 0 td1
    testfile cpdir td1 td2
    list [file exists td2] [file writable td2]
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {1 1}
test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup {
    testchmod 000 td1
    catch {
        testfile cpdir td1 td2
        list [file exists td2] [file writable td2]
    } r
    catch {
        testchmod 777 td1
        cleanup
    }
    set r
} {1 1}
test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \
	{win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1 tf1
    testfile rmdir -force td1
    file exists td1
} -result {0}
test winFCmd-7.21 {TraverseWinTree: fill errorPtr} -setup {
} {0}
test winFCmd-7.21 {TraverseWinTree: fill errorPtr} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    testfile cpdir td1 td2
} -returnCodes error -result {td1 ENOENT}
    list [catch {testfile cpdir td1 td2} msg] $msg
} {1 {td1 ENOENT}}

test winFCmd-8.1 {TraversalCopy: DOTREE_F} -setup {
test winFCmd-8.1 {TraversalCopy: DOTREE_F} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 td1
} -returnCodes error -result {td1 EEXIST}
test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup {
    list [catch {testfile cpdir td1 td1} msg] $msg
} {1 {td1 EEXIST}}
test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} {win testfile testchmod} {
    cleanup
} -constraints {win testfile testchmod} -body {
    file mkdir td1/td2
    testchmod 0 td1
    testfile cpdir td1 td2
    list [file writable td1] [file writable td1/td2]
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -result {0 1}
test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup {
    testchmod 000 td1
    catch {
        testfile cpdir td1 td2
        list [file writable td1] [file writable td1/td2]
    } r
    catch {
        testchmod 777 td1
        cleanup
    }
    set r
} {0 1}
test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    testfile cpdir td1 td2
} -cleanup {
} {}
    cleanup
} -result {}

test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
test winFCmd-9.1 {TraversalDelete: DOTREE_F} {win testfile} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1
    createfile td1/tf1
    testfile rmdir -force td1
} -result {}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
} {}
test winFCmd-9.2 {TraversalDelete: DOTREE_F} {win 95 testfile} {
    cleanup
} -constraints {winVista testfile testchmod knownMsvcBug notWine} -body {
    file mkdir td1/td2
    testchmod 0 td1
    testfile rmdir -force td1
    file exists td1
} -cleanup {
    catch {testchmod 0o666 td1}
    cleanup
} -returnCodes error -result {td1 EACCES}
test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup {
    cleanup
    file mkdir td1
    set fd [open td1/tf1 w]
    set msg [list [catch {testfile rmdir -force td1} msg] $msg]
    close $fd
    set msg
} {1 {td1\tf1 EACCES}}
test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} {win testfile testchmod} {
    cleanup
} -constraints {win testfile} -body {
    file mkdir td1/td1/td3/td4/td5
    testfile rmdir -force td1
    file mkdir td1/td2
    testchmod 000 td1
    catch {
        testfile rmdir -force td1
} -result {}

        file exists td1
test winFCmd-10.1 {AttributesPosixError - get} -constraints {win} -setup {
    cleanup
} -body {
    file attributes td1 -archive
    } r
    catch {
} -returnCodes error -result {could not read "td1": no such file or directory}
test winFCmd-10.2 {AttributesPosixError - set} -constraints {win} -setup {
    cleanup
        testchmod 777 td1
        cleanup
} -body {
    file attributes td1 -archive 0
} -returnCodes error -result {could not read "td1": no such file or directory}

test winFCmd-11.1 {GetWinFileAttributes} -constraints {win} -setup {
    }
    set r
} {0}
test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} {win testfile} {
    cleanup
    file mkdir td1/td1/td3/td4/td5
    testfile rmdir -force td1
} -body {
    createfile td1 {}
    file attributes td1 -archive
} -cleanup {
} {}

test winFCmd-10.1 {AttributesPosixError - get} {win} {
    cleanup
    list [catch {file attributes td1 -archive} msg] $msg
} {1 {could not read "td1": no such file or directory}}
test winFCmd-10.2 {AttributesPosixError - set} {win} {
    cleanup
    list [catch {file attributes td1 -archive 0} msg] $msg
} {1 {could not read "td1": no such file or directory}}
} -result 1
test winFCmd-11.2 {GetWinFileAttributes} -constraints {win} -setup {

test winFCmd-11.1 {GetWinFileAttributes} {win} {
    cleanup
} -body {
    createfile td1 {}
    file attributes td1 -readonly
} -cleanup {
    close [open td1 w]
    list [catch {file attributes td1 -archive} msg] $msg [cleanup]
} {0 1 {}}
test winFCmd-11.2 {GetWinFileAttributes} {win} {
    cleanup
    close [open td1 w]
    list [catch {file attributes td1 -readonly} msg] $msg [cleanup]
} -result 0
test winFCmd-11.3 {GetWinFileAttributes} -constraints {win} -setup {
} {0 0 {}}
test winFCmd-11.3 {GetWinFileAttributes} {win} {
    cleanup
} -body {
    createfile td1 {}
    file attributes td1 -hidden
    close [open td1 w]
    list [catch {file attributes td1 -hidden} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result 0
test winFCmd-11.4 {GetWinFileAttributes} -constraints {win} -setup {
} {0 0 {}}
test winFCmd-11.4 {GetWinFileAttributes} {win} {
    cleanup
} -body {
    createfile td1 {}
    file attributes td1 -system
    close [open td1 w]
    list [catch {file attributes td1 -system} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result 0
test winFCmd-11.5 {GetWinFileAttributes} -constraints {win} -setup {
} {0 0 {}}
test winFCmd-11.5 {GetWinFileAttributes} {win} {
    set old [pwd]
} -body {
    # Attr of relative paths that resolve to root was failing don't care about
    # answer, just that test runs.
    # attr of relative paths that resolve to root was failing
    # don't care about answer, just that test runs.
    cd c:/
    file attr c:
    file attr c:.
    file attr .
} -cleanup {
    cd $old
} -match glob -result *
test winFCmd-11.6 {GetWinFileAttributes} -constraints {win} -body {
    file attr c:/ -hidden
} -result {0}

    set old [pwd]
    cd c:/
    file attr c:	    
    file attr c:.
    file attr . 
    cd $old
} {}
test winFCmd-11.6 {GetWinFileAttributes} {win} {
    file attr c:/ -hidden
} {0}

test winFCmd-12.1 {ConvertFileNameFormat} -constraints {win} -setup {
test winFCmd-12.1 {ConvertFileNameFormat} {win} {
    cleanup
} -body {
    createfile td1 {}
    string tolower [file attributes td1 -longname]
    close [open td1 w]
    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result {td1}
test winFCmd-12.2 {ConvertFileNameFormat} -constraints {win} -setup {
} {0 td1 {}}
test winFCmd-12.2 {ConvertFileNameFormat} {win} {
    cleanup
} -body {
    file mkdir td1
    createfile td1/td1 {}
    string tolower [file attributes td1/td1 -longname]
    close [open td1/td1 w]
    list [catch {string tolower [file attributes td1/td1 -longname]} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result {td1/td1}
test winFCmd-12.3 {ConvertFileNameFormat} -constraints {win} -setup {
} {0 td1/td1 {}}
test winFCmd-12.3 {ConvertFileNameFormat} {win} {
    cleanup
} -body {
    file mkdir td1
    file mkdir td1/td2
    close [open td1/td3 w]
    list [catch {string tolower [file attributes td1/td2/../td3 -longname]} msg] $msg [cleanup]
} {0 td1/td2/../td3 {}}
test winFCmd-12.4 {ConvertFileNameFormat} {win} {
    cleanup
    close [open td1 w]
    list [catch {string tolower [file attributes ./td1 -longname]} msg] $msg [cleanup]
} {0 ./td1 {}}
test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {win} {
    list [file attributes / -longname] [file attributes \\ -longname]
} {/ /}
test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
    catch {file delete -force -- c:/td1}
} -constraints {win winXP} -body {
    createfile td1/td3 {}
    string tolower [file attributes td1/td2/../td3 -longname]
} -cleanup {
    cleanup
} -result {td1/td2/../td3}
test winFCmd-12.4 {ConvertFileNameFormat} -constraints {win} -setup {
    cleanup
} -body {
    createfile td1 {}
    string tolower [file attributes ./td1 -longname]
} -cleanup {
    cleanup
} -result {./td1}
test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body {
    list [file attributes / -longname] [file attributes \\ -longname]
} -constraints {win} -result {/ /}
test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
    catch {file delete -force -- c:/TclTmpC.1}
} -constraints {win winXP} -body {
    createfile c:/TclTmpC.1 {}
    string tolower [file attributes c:/TclTmpC.1 -longname]
    createfile c:/td1 {}
    string tolower [file attributes c:/td1 -longname]
} -cleanup {
    file delete -force -- c:/TclTmpC.1
} -result [string tolower {c:/TclTmpC.1}]
    file delete -force -- c:/td1
} -result {c:/td1}
test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup {
    catch {file delete -force -- $::env(TEMP)/td1}
} -constraints {win} -body {
    createfile $::env(TEMP)/td1 {}
    string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \
	    [string tolower [file normalize $::env(TEMP)]/td1]
} -cleanup {
    file delete -force -- $::env(TEMP)/td1
} -result 1
test winFCmd-12.7 {ConvertFileNameFormat} -body {
test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable win} {
    string tolower [file attributes //bisque/tcl/ws -longname]
} -constraints {nonPortable win} -result {//bisque/tcl/ws}
test winFCmd-12.8 {ConvertFileNameFormat} -setup {
} {//bisque/tcl/ws}
test winFCmd-12.8 {ConvertFileNameFormat} {win longFileNames} {
    cleanup
} -constraints {win longFileNames} -body {
    createfile td1 {}
    string tolower [file attributes td1 -longname]
    close [open td1 w]
    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result {td1}
test winFCmd-12.10 {ConvertFileNameFormat} -setup {
} {0 td1 {}}
test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames win} {
    cleanup
} -constraints {longFileNames win} -body {
    createfile td1td1td1 {}
    file attributes td1td1td1 -shortname
} -cleanup {
    close [open td1td1td1 w]
    list [catch {file attributes td1td1td1 -shortname}] [cleanup]
} {0 {}}
    cleanup
} -match glob -result *
test winFCmd-12.11 {ConvertFileNameFormat} -setup {
test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames win} {
    cleanup
} -constraints {longFileNames win} -body {
    createfile td1 {}
    string tolower [file attributes td1 -shortname]
    close [open td1 w]
    list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result {td1}
} {0 td1 {}}

test winFCmd-13.1 {GetWinFileLongName} -constraints {win} -setup {
test winFCmd-13.1 {GetWinFileLongName} {win} {
    cleanup
} -body {
    createfile td1 {}
    string tolower [file attributes td1 -longname]
    close [open td1 w]
    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result td1
} {0 td1 {}}

test winFCmd-14.1 {GetWinFileShortName} -constraints {win} -setup {
test winFCmd-14.1 {GetWinFileShortName} {win} {
    cleanup
} -body {
    createfile td1 {}
    string tolower [file attributes td1 -shortname]
    close [open td1 w]
    list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
} -cleanup {
    cleanup
} -result td1
} {0 td1 {}}

test winFCmd-15.1 {SetWinFileAttributes} -constraints {win} -setup {
test winFCmd-15.1 {SetWinFileAttributes} {win} {
    cleanup
} -body {
    file attributes td1 -archive 0
} -returnCodes error -result {could not read "td1": no such file or directory}
test winFCmd-15.2 {SetWinFileAttributes - archive} -constraints {win} -setup {
    list [catch {file attributes td1 -archive 0} msg] $msg
} {1 {could not read "td1": no such file or directory}}
test winFCmd-15.2 {SetWinFileAttributes - archive} {win} {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 1] [file attributes td1 -archive]
    close [open td1 w]
    list [catch {file attributes td1 -archive 1} msg] $msg [file attributes td1 -archive] [cleanup]
} -cleanup {
    cleanup
} -result {{} 1}
test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win notWine} -setup {
} {0 {} 1 {}}
test winFCmd-15.3 {SetWinFileAttributes - archive} {win} {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -archive 0] [file attributes td1 -archive]
} -cleanup {
    close [open td1 w]
    list [catch {file attributes td1 -archive 0} msg] $msg [file attributes td1 -archive] [cleanup]
} {0 {} 0 {}}
test winFCmd-15.4 {SetWinFileAttributes - hidden} {win} {
    cleanup
} -result {{} 0}
test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win notWine} -setup {
    cleanup
} -body {
    createfile td1 {}
    close [open td1 w]
    list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \
	[file attributes td1 -hidden 0]
    list [catch {file attributes td1 -hidden 1} msg] $msg [file attributes td1 -hidden] [file attributes td1 -hidden 0] [cleanup]
} -cleanup {
    cleanup
} -result {{} 1 {}}
test winFCmd-15.5 {SetWinFileAttributes - hidden} -constraints {win} -setup {
} {0 {} 1 {} {}}
test winFCmd-15.5 {SetWinFileAttributes - hidden} {win} {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -hidden 0] [file attributes td1 -hidden]
    close [open td1 w]
    list [catch {file attributes td1 -hidden 0} msg] $msg [file attributes td1 -hidden] [cleanup]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.6 {SetWinFileAttributes - readonly} -setup {
} {0 {} 0 {}}
test winFCmd-15.6 {SetWinFileAttributes - readonly} {win} {
    cleanup
} -constraints {win} -body {
    createfile td1 {}
    list [file attributes td1 -readonly 1] [file attributes td1 -readonly]
    close [open td1 w]
    list [catch {file attributes td1 -readonly 1} msg] $msg [file attributes td1 -readonly] [cleanup]
} -cleanup {
    cleanup
} -result {{} 1}
test winFCmd-15.7 {SetWinFileAttributes - readonly} -setup {
} {0 {} 1 {}}
test winFCmd-15.7 {SetWinFileAttributes - readonly} {win} {
    cleanup
} -constraints {win} -body {
    createfile td1 {}
    list [file attributes td1 -readonly 0] [file attributes td1 -readonly]
} -cleanup {
    close [open td1 w]
    list [catch {file attributes td1 -readonly 0} msg] $msg [file attributes td1 -readonly] [cleanup]
} {0 {} 0 {}}
test winFCmd-15.8 {SetWinFileAttributes - system} {win} {
    cleanup
} -result {{} 0}
test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win notWine} -setup {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -system 1] [file attributes td1 -system]
    close [open td1 w]
    list [catch {file attributes td1 -system 1} msg] $msg [file attributes td1 -system] [cleanup]
} -cleanup {
    cleanup
} -result {{} 1}
test winFCmd-15.9 {SetWinFileAttributes - system} -constraints {win} -setup {
} {0 {} 1 {}}
test winFCmd-15.9 {SetWinFileAttributes - system} {win} {
    cleanup
} -body {
    createfile td1 {}
    list [file attributes td1 -system 0] [file attributes td1 -system]
    close [open td1 w]
    list [catch {file attributes td1 -system 0} msg] $msg [file attributes td1 -system] [cleanup]
} -cleanup {
    cleanup
} -result {{} 0}
test winFCmd-15.10 {SetWinFileAttributes - failing} -setup {
} {0 {} 0 {}}
test winFCmd-15.10 {SetWinFileAttributes - failing} {win cdrom} {
    cleanup
} -constraints {win cdrom} -body {
    file attributes $cdfile -archive 1
    catch {file attributes $cdfile -archive 1}
} -returnCodes error -match glob -result *

test winFCmd-16.1 {Windows file normalization} -constraints {win} -body {
} {1}
test winFCmd-16.1 {Windows file normalization} {win} {
    list [file normalize c:/] [file normalize C:/]
} -result {C:/ C:/}
test winFCmd-16.2 {Windows file normalization} -constraints {win} -body {
    createfile td1... {}
    file tail [file normalize td1]
} {C:/ C:/}
test winFCmd-16.2 {Windows file normalization} {win} {
    close [open td1... w]
    set res [file tail [file normalize td1]]
} -cleanup {
    file delete td1...
    set res
} -result {td1}
} {td1}

set pwd [pwd]
set d [string index $pwd 0]

test winFCmd-16.3 {Windows file normalization} -constraints {win} -body {
test winFCmd-16.3 {Windows file normalization} {win} {
    file norm ${d}:foo
} -result [file join $pwd foo]
test winFCmd-16.4 {Windows file normalization} -constraints {win} -body {
} [file join $pwd foo]
test winFCmd-16.4 {Windows file normalization} {win} {
    file norm [string tolower ${d}]:foo
} -result [file join $pwd foo]
test winFCmd-16.5 {Windows file normalization} -constraints {win} -body {
} [file join $pwd foo]
test winFCmd-16.5 {Windows file normalization} {win} {
    file norm ${d}:foo/bar
} -result [file join $pwd foo/bar]
test winFCmd-16.6 {Windows file normalization} -constraints {win} -body {
} [file join $pwd foo/bar]
test winFCmd-16.6 {Windows file normalization} {win} {
    file norm ${d}:foo\\bar
} -result [file join $pwd foo/bar]
test winFCmd-16.7 {Windows file normalization} -constraints {win} -body {
} [file join $pwd foo/bar]
test winFCmd-16.7 {Windows file normalization} {win} {
    file norm /bar
} -result "${d}:/bar"
test winFCmd-16.8 {Windows file normalization} -constraints {win} -body {
} "${d}:/bar"
test winFCmd-16.8 {Windows file normalization} {win} {
    file norm ///bar
} -result "${d}:/bar"
test winFCmd-16.9 {Windows file normalization} -constraints {win} -body {
} "${d}:/bar"
test winFCmd-16.9 {Windows file normalization} {win} {
    file norm /bar/foo
} -result "${d}:/bar/foo"
} "${d}:/bar/foo"
if {$d eq "C"} { set dd "D" } else { set dd "C" }
test winFCmd-16.10 {Windows file normalization} -constraints {win} -body {
test winFCmd-16.10 {Windows file normalization} {win} {
    file norm ${dd}:foo
} -result "${dd}:/foo"
} "${dd}:/foo"
test winFCmd-16.11 {Windows file normalization} -body {
    cd ${d}:
    cd $cdrom
    cd ${d}:
    cd $cdrom
    # Must not crash
    set result "no crash"
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
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







-
+


-
+

+


-
+
+
+
+
+
+



-
-
+
+
+


-
+



-
+
+
+
+
+
+



-
+







    # At one point this led to an infinite recursion in Tcl
    set result [pwd]; # <- Must not crash
    set result "no crash"
} -cleanup {
    set ::env(HOME) $oldhome
    cd $pwd
} -result {no crash}
test winFCmd-16.13 {Windows file normalization - absolute HOME} -setup {
test winFCmd-16.13 {Windows file normalization} -constraints win -setup {
    set oldhome ""
    catch {set oldhome $::env(HOME)}
} -constraints win -body {
} -body {
    # Test 'cd' normalization when HOME is absolute
    set expectedResult [file normalize ${d}:/]
    set ::env(HOME) ${d}:/
    cd
    pwd
    set result [pwd]
    if { [string equal $result $expectedResult] } {
	concat ok
    } else {
	list $result != $expectedResult
    }
} -cleanup {
    set ::env(HOME) $oldhome
    cd $pwd
} -result [file normalize ${d}:/]
test winFCmd-16.14 {Windows file normalization - relative HOME} -setup {
} -result ok

test winFCmd-16.14 {Windows file normalization} -constraints win -setup {
    set oldhome ""
    catch {set oldhome $::env(HOME)}
} -constraints win -body {
} -body {
    # Test 'cd' normalization when HOME is relative
    set ::env(HOME) ${d}:
    cd
    pwd
    set result [pwd]
    if { [string equal $result $pwd] } {
	concat ok
    } else {
	list $result != $pwd
    }
} -cleanup {
    set ::env(HOME) $oldhome
    cd $pwd
} -result $pwd
} -result ok

test winFCmd-17.1 {Windows bad permissions cd} -constraints win -body {
    set d {}
    foreach dd {c:/ d:/ e:/} {
	eval lappend d [glob -nocomplain \
	  -types hidden -dir $dd "System Volume Information"]
    }
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
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
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







-
+


-
+


-
+










-
+










-
-
+
+









-
+










-
+










-
+











-
+







test winFCmd-18.7 {Windows reserved path names} -constraints win -body {
    file normalize cOm1
} -result COM1
test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
    file normalize cOm1:
} -result COM1

test winFCmd-19.1 {Windows extended path names} -constraints win -body {
test winFCmd-19.1 {Windows extended path names} -constraints nt -body {
    file normalize //?/c:/windows/win.ini
} -result //?/c:/windows/win.ini
test winFCmd-19.2 {Windows extended path names} -constraints win -body {
test winFCmd-19.2 {Windows extended path names} -constraints nt -body {
    file normalize //?/c:/windows/../windows/win.ini
} -result //?/c:/windows/win.ini
test winFCmd-19.3 {Windows extended path names} -constraints win -setup {
test winFCmd-19.3 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.4 {Windows extended path names} -constraints win -setup {
test winFCmd-19.4 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.5 {Windows extended path names} -constraints win -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
test winFCmd-19.5 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 200].tmp]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.6 {Windows extended path names} -constraints win -setup {
test winFCmd-19.6 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {}]
test winFCmd-19.7 {Windows extended path names} -constraints win -setup {
test winFCmd-19.7 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile [file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {} [list tcl[pid].tmp]]
test winFCmd-19.8 {Windows extended path names} -constraints win -setup {
test winFCmd-19.8 {Windows extended path names} -constraints nt -setup {
    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
    set tmpfile //?/[file normalize $tmpfile]
} -body {
    list [catch {
        set f [open $tmpfile [list WRONLY CREAT]]
        close $f
    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
} -cleanup {
    catch {file delete $tmpfile}
} -result [list 0 {} [list "tcl[pid].tmp "]]

test winFCmd-19.9 {Windows devices path names} -constraints win -body {
test winFCmd-19.9 {Windows devices path names} -constraints nt -body {
    file normalize //./com1
} -result //./com1


# This block of code used to occur after the "return" call, so I'm
# commenting it out and assuming that this code is still under construction.
#foreach source {tef ted tnf tnd "" nul com1} {

Changes to tests/winFile.test.

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
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












-
-
-
+
+
+

-
-
+
-



+




+
-
-
-
-
-
-
+
+
+
+
+
+
+

+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+


-
+

+
-
-
+
+


-
+
-

+
-
+

-
-
+
+
-




-
-
-
+
+
+
+




-
+



















-
+








-
+
+





-
+






-
+







-
+
















-
-
+
+
+
+

-















-
+














-
+










-
+











-
+












-
+







# This file tests the tclWinFile.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
if {[catch {package require tcltest 2.0.2}]} {
    puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
    return
}

::tcltest::loadTestedCommands
namespace import -force ::tcltest::*
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0
testConstraint win2000 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
    glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
    testConstraint win2000 1
}

test winFile-1.1 {TclpGetUserHome} {win} {
    list [catch {glob ~nosuchuser} msg] $msg
} {1 {user "nosuchuser" doesn't exist}}
test winFile-1.2 {TclpGetUserHome} {win nt nonPortable} {
    # The administrator account should always exist.

    glob ~administrator
} -match glob -result *
test winFile-1.4 {TclpGetUserHome} {win nonPortable} {
    catch {glob ~administrator}
} {0}
test winFile-1.3 {TclpGetUserHome} {win 95} {
    # Find some user in system.ini and then see if they have a home.

    set f [open $::env(windir)/system.ini]
    set x 0
    while {![eof $f]} {
	set line [gets $f]
	if {$line == "\[Password Lists]"} {
	    gets $f
	    set name [lindex [split [gets $f] =] 0]
	    if {$name != ""} {
		set x [catch {glob ~$name}]
		break
	    }
	}
    }
    close $f
    set x
} {0}
test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
    catch {glob ~stanton@workgroup}
} {0}

test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} {
    makeFile {} GlobCapS
    set args [list -nocomplain -tails -directory [temporaryDirectory]]
    list [glob {*}$args GlobC*] [glob {*}$args globc*]} -cleanup {
    set result [list [glob {*}$args GlobC*] [glob {*}$args globc*]]
    removeFile GlobCapS
    set result
} -result {GlobCapS GlobCapS}
test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
} {GlobCapS GlobCapS}
test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} {
    makeFile {} globlower
    set args [list -nocomplain -tails -directory [temporaryDirectory]]
    list [glob {*}$args globl*] [glob {*}$args gLOBl*]
    set result [list [glob {*}$args globl*] [glob {*}$args gLOBl*]]
} -cleanup {
    removeFile globlower
    set result
} -result {globlower globlower}
} {globlower globlower}

test winFile-3.1 {file system} -constraints {win testvolumetype} -setup {
    set res ""
test winFile-3.1 {file system} {win testvolumetype} {
    set res "volume types ok"
} -body {
    foreach vol [file volumes] {
	# Have to catch in case there is a removable drive (CDROM, floppy)
	# with nothing in it.
	catch {
	    if {[lindex [file system $vol] 1] ne [testvolumetype $vol]} {
		append res "For $vol, we found [file system $vol]\
			and [testvolumetype $vol] are different\n"
	    if {![string equal [lindex [file system $vol] 1] [testvolumetype $vol]]} {
		set res "For $vol, we found [file system $vol]\
		  and [testvolumetype $vol] are different"
		break
	    }
	}
    }
    set res
} -result {}
} {volume types ok}

proc cacls {fname args} {
    string trim [eval [list exec cacls [file nativename $fname]] $args <<y]
}

# dir/q output:
# 2003-11-03  20:36                  598 OCTAVIAN\benny         filename.txt
# Note this output from a german win2k machine:
# 14.12.2007  14:26                   30 VORDEFINIERT\Administratest.dat
#
# Modified to cope with Msys environment and use ls -l.
proc getuser {fname} {
    global env
    set tryname $fname
    if {[file isdirectory $fname]} {
	set tryname [file dirname $fname]
    }
    set owner ""
    set tail [file tail $tryname]
    if {[info exists env(OSTYPE)] && $env(OSTYPE) eq "msys"} {
    if {[info exists env(OSTYPE)] && [string equal $env(OSTYPE) "msys"]} {
        set dirtext [exec ls -l $fname]
        foreach line [split $dirtext "\n"] {
            set owner [lindex $line 2]
        }
    } else {
        set dirtext [exec cmd /c dir /q [file nativename $fname]]
        foreach line [split $dirtext "\n"] {
            if {[string match -nocase "*$tail" $line]} {
                set attrs [string range $line 0 end-[string length $tail]]
                set attrs [string range $line \
                               0 end-[string length $tail]]
                regexp { [^ \\]+\\.*$} $attrs owner
                set owner [string trim $owner]
            }
        }
    }
    if {$owner eq ""} {
    if {[string length $owner] == 0} {
	error "getuser: Owner not found in output of dir/q"
    }
    return $owner
}

proc test_read {fname} {
    if {[catch {open $fname r} ifs]} {
    if {[catch {set ifs [open $fname r]}]} {
	return 0
    }
    set readfailed [catch {read $ifs}]
    return [expr {![catch {close $ifs}] && !$readfailed}]
}

proc test_writ {fname} {
    if {[catch {open $fname w} ofs]} {
    if {[catch {set ofs [open $fname w]}]} {
	return 0
    }
    set writefailed [catch {puts $ofs "Hello"}]
    return [expr {![catch {close $ofs}] && !$writefailed}]
}

proc test_access {fname read writ} {
    set problem {}
    foreach type {read writ} {
	if {[set $type] != [file ${type}able $fname]} {
	    lappend problem "[set $type] != \[file ${type}able $fname\]"
	}
	if {[set $type] != [test_${type} $fname]} {
	    lappend problem "[set $type] != \[test_${type} $fname\]"
	}
    }
    if {![llength $problem]} {
	return
    if {[llength $problem]} {
	return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
    } else {
	return ""
    }
    return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
}

if {[testConstraint win]} {
    # Create the test file
    # NOTE: [tcltest::makeFile] not used.  Presumably to force file
    # creation in a particular filesystem?  If not, try [makeFile]
    # in a -setup script.
    set fname test.dat
    file delete $fname
    close [open $fname w]
}

test winFile-4.0 {
    Enhanced NTFS user/group permissions: test no acccess
} -constraints {
    win notNTFS notWine
    win nt notNTFS win2000
} -setup {
    set owner [getuser $fname]
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    # Clean out all well-known ACLs
    catch {cacls $fname /E /R "Everyone"} result
    catch {cacls $fname /E /R $user} result
    catch {cacls $fname /E /R $owner} result
    cacls $fname /E /P $user:N
    test_access $fname 0 0
} -result {}
test winFile-4.1 {
    Enhanced NTFS user/group permissions: test readable only
} -constraints {
    win notNTFS notWine
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    test_access $fname 1 0
} -result {}
test winFile-4.2 {
    Enhanced NTFS user/group permissions: test writable only
} -constraints {
    win notNTFS notWine
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:W
    test_access $fname 0 1
} -result {}
test winFile-4.3 {
    Enhanced NTFS user/group permissions: test read+write
} -constraints {
    win notNTFS
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:R
    cacls $fname /E /G $user:W
    test_access $fname 1 1
} -result {}
test winFile-4.4 {
    Enhanced NTFS user/group permissions: test full access
} -constraints {
    win notNTFS
    win nt notNTFS
} -setup {
    set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
    catch {cacls $fname /E /R $user} result
    cacls $fname /E /P $user:N
    cacls $fname /E /G $user:F
    test_access $fname 1 1

Changes to tests/winNotify.test.

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
1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17



18
19
20
21
22
23
24












-
-
+
+



-
-
-







# This file tests the tclWinNotify.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 by Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testeventloop [expr {[info commands testeventloop] != {}}]

# There is no explicit test for InitNotifier or NotifierExitHandler

test winNotify-1.1 {Tcl_SetTimer: positive timeout} {win} {
    set done 0
    after 1000 { set done 1 }

Changes to tests/winPipe.test.

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
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











-
-
+
+

-
-
-
+
+
-


-
-
-
-
-




-
-
-





+



-
-
-



-
+






-
+







#
# winPipe.test --
#
# This file contains a collection of tests for tclWinPipe.c
#
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output (except for one message) means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# 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.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
package require tcltest
namespace import -force ::tcltest::*
}
unset -nocomplain path

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}

set org_pwd [pwd]
set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]

testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]


# several test-cases here expect current directory == [temporaryDirectory]:
cd [temporaryDirectory]

testConstraint exec         [llength [info commands exec]]
testConstraint testexcept   [llength [info commands testexcept]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
testConstraint testexcept   [llength [info commands testexcept]]
testConstraint slowTest     0


set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big
append big $big	
append big $big
append big $big
append big $big
append big $big

set path(little) [makeFile {} little]
set f [open $path(little) w]
set f [open $path(little) w] 
puts -nonewline $f "little"
close $f

set path(big) [makeFile {} big]
set f [open $path(big) w]
puts -nonewline $f $big
close $f
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
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







-
+








-
-
+
+


-
-
+
+
+
+
+
+







    while {[eof stdin] == 0} {
	puts -nonewline [read stdin]
    }
} more]

set path(stdout) [makeFile {} stdout]
set path(stderr) [makeFile {} stderr]


test winpipe-1.1 {32 bit comprehensive tests: from little file} {win exec cat32} {
    exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} {
    exec $cat32 < $path(big) > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win exec cat32} {
    exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} {
    exec [interpreter] more < little | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win exec cat32} {
    exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
    exec [interpreter] more < big | $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
    exec command /c type big |& $cat32 > $path(stdout) 2> $path(stderr)
    list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
test winpipe-1.6 {32 bit comprehensive tests: from console} \
	{win cat32 AllocConsole} {
    # would block waiting for human input
} {}
test winpipe-1.7 {32 bit comprehensive tests: from NUL} {win exec cat32} {
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
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







+
+
+
+
+

-
+










+
-
+







-
+


-




-
+


-




-
+


-




-
+


-

















-
+

-
+










-
+








-
+









-
+







    puts $f $big
    puts $f \032
    flush $f
    set r [read $f 64]
    catch {close $f}
    set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
    exec command.com /c dir /b
    set result 1
} 1
file delete more

test winpipe-4.1 {Tcl_WaitPid} {win exec cat32} {
test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
    proc readResults {f} {
	global x result
	if { [eof $f] } {
	    close $f
	    set x 1
	} else {
	    set line [read $f ]
	    set result "$result$line"
	}
    }

    set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r]
    set f [open "|[list $cat32] < big 2> $path(stderr)" r]
    fconfigure $f  -buffering none -blocking 0
    fileevent $f readable "readResults $f"
    set x 0
    set result ""
    vwait x
    list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept notWine} {
test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept float_underflow"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGFPE}
test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept notWine} {
test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept access_violation"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGSEGV}
test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept notWine} {
test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept illegal_instruction"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGILL}
test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept notWine} {
test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "testexcept ctrl+c"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGINT}

set path(nothing) [makeFile {} nothing]
close [open $path(nothing) w]

catch {set env_tmp $env(TMP)}
catch {set env_temp $env(TEMP)}

set env(TMP) c:/
set env(TEMP) c:/

test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {win exec} {
    set x {}
    set existing [glob -nocomplain c:/tcl*.tmp]
    exec [interpreter] < $path(nothing)
    exec [interpreter] < nothing 
    foreach p [glob -nocomplain c:/tcl*.tmp] {
	if {$p ni $existing} {
	if {[lsearch $existing $p] == -1} {
	    lappend x $p
	}
    }
    set x
} {}
test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {win exec} {
    set tmp $env(TMP)
    set temp $env(TEMP)
    unset env(TMP)
    unset env(TEMP)
    exec [interpreter] < $path(nothing)
    exec [interpreter] < nothing
    set env(TMP) $tmp
    set env(TEMP) $temp
    set x {}
} {}
test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
	{win exec } {
    set tmp $env(TMP)
    set env(TMP) snarky
    exec [interpreter] < $path(nothing)
    exec [interpreter] < nothing
    set env(TMP) $tmp
    set x {}
} {}
test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
	{win exec} {
    set tmp $env(TMP)
    set temp $env(TEMP)
    unset env(TMP)
    set env(TEMP) snarky
    exec [interpreter] < $path(nothing)
    exec [interpreter] < nothing
    set env(TMP) $tmp
    set env(TEMP) $temp
    set x {}
} {}

test winpipe-6.1 {PipeSetupProc & PipeCheckProc: read threads} \
	{win exec cat32} {
329
330
331
332
333
334
335
336
337
338



339
340
341
342
343
344
345

346
347
348
349
350
351
352
323
324
325
326
327
328
329



330
331
332
333
334
335
336
337
338

339
340
341
342
343
344
345
346







-
-
-
+
+
+






-
+







	set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"]
    }
    set cmds [list [list [interpreter] $path(echoArgs.tcl)]]
    if {!($single & 2)} {
	lappend cmds [list $path(echoArgs.bat)]
    } else {
	if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} {
	    set path(echoArgs2.bat) [makeFile \
		"@[file native [interpreter]] $path(echoArgs.tcl) %*" \
		"echo(Cmd)Test Args & Batch.bat" [makeDirectory test(Dir)Check]]
	    file mkdir [file join [temporaryDirectory] test(Dir)Check]
	    set path(echoArgs2.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" \
		"test(Dir)Check/echo(Cmd)Test Args & Batch.bat"]
	}
	lappend cmds [list $path(echoArgs2.bat)]
    }
    set broken {}
    foreach args $args {
	if {$single & 1} {
	    # enclose single test-arg between 1st/3rd to be sure nothing is truncated
	    # enclose single test-arg between 1st/3rd to be sure nothing is truncated 
	    # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined):
	    set args [list "1st" $args "3rd"]
	}
	set args [list {*}$args]; # normalized canonical list
	foreach cmd $cmds {
	    set e [linsert $args 0 [file tail $path(echoArgs.tcl)]]
	    tcltest::DebugPuts 4 "  ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n  ##   $args"
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
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







-
+








-
+








-
+








test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
-constraints {win exec slowTest} -body {
    _testExecArgs 1 {*}$injectList
} -result {}

test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \
-constraints {win exec notWine} -body {
-constraints {win exec} -body {
    _testExecArgs 0 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \
-constraints {win exec notWine} -body {
-constraints {win exec} -body {
    _testExecArgs 2 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
-constraints {win exec notWine} -body {
-constraints {win exec} -body {
    set lst {}
    set maps {
	{\&|^<>!()%}
	{\&|^<>!()% }
	{"\&|^<>!()%}
	{"\&|^<>!()% }
	{"""""\\\\\&|^<>!()%}
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
618

619
620
621
622
623
624
625
626
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











-
+
















-
+










-
-
-
-
-
-
-
+
-
-
+




-
-
-
-
    "test;\n&echo \""    "\"test;\n&echo \""
    "test\";\n&echo \""  "\"test\";\n&echo \""
    "\"\"test\";\n&echo \""
}

test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \
-constraints {win exec} -body {
    # test exe only, because currently there is no proper way to escape a new-line char resp.
    # test exe only, because currently there is no proper way to escape a new-line char resp. 
    # to supply a new-line to the batch-files within arguments (command line is truncated).
    _testExecArgs 8 \
	[list START     {*}$injectList END] \
	[list "START\"" {*}$injectList END] \
	[list START     {*}$injectList "\"END"] \
	[list "START\"" {*}$injectList "\"END"]
} -result {}

test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args (batch)} \
-constraints {win exec knownBug} -body {
    # this will fail if executed batch-file, because currently there is no proper way to escape a new-line char.
    _testExecArgs 0 $injectList
} -result {}


rename _testExecArgs {}


# restore old values for env(TMP) and env(TEMP)

if {[catch {set env(TMP) $env_tmp}]} {
    unset env(TMP)
}
if {[catch {set env(TEMP) $env_temp}]} {
    unset env(TEMP)
}

# cleanup
removeFile little
removeFile big
removeFile more
removeFile stdout
removeFile stderr
removeFile nothing
if {[info exists path(echoArgs.tcl)]} { removeFile echoArgs.tcl }
file delete big little stdout stderr nothing echoArgs.tcl echoArgs.bat 
if {[info exists path(echoArgs.bat)]} { removeFile echoArgs.bat }
if {[info exists path(echoArgs2.bat)]} { removeDirectory test(Dir)Check }
file delete -force [file join [temporaryDirectory] test(Dir)Check]
::tcltest::cleanupTests
# back to original directory:
cd $org_pwd; unset org_pwd
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/winTime.test.

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
1
2
3
4
5
6
7
8
9
10
11
12


13
14
15
16
17



18
19
20
21
22
23
24












-
-
+
+



-
-
-







# This file tests the tclWinTime.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testwinclock [llength [info commands testwinclock]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

# The next two tests will crash on Windows if the check for negative
# clock values is not done properly.

test winTime-1.1 {TclpGetDate} {win} {

Deleted tests/zipfs.test.

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




























































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# The file tests the tclZlib.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint zipfs [expr {
    [llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]
}]
testConstraint zipfslib 1

# Removed in tip430 - zipfs is no longer a static package
#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
#    load {} zipfs
#} -result {}

set ziproot [zipfs root]
set CWD [pwd]
set tmpdir  [file join $CWD tmp]
file mkdir $tmpdir

test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
    package require zipfs
} -result {2.0}
test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
    expr {${ziproot} in [file volumes]}
} -result 1

if {![string match ${ziproot}* $tcl_library]} {
    ###
    # "make test" does not map tcl_library from the dynamic library on Unix
    #
    # Hack the environment to pretend we did pull tcl_library from a zip
    # archive
    ###
    set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]]
    testConstraint zipfslib [file isfile $tclzip]
    if {[testConstraint zipfslib]} {
        zipfs mount /lib/tcl $tclzip
        set ::tcl_library ${ziproot}lib/tcl/tcl_library
    }
}

test zipfs-0.2 {zipfs basics} -constraints zipfslib -body {
    string match ${ziproot}* $tcl_library
} -result 1
test zipfs-0.3 {zipfs basics: glob} -constraints zipfslib -setup {
    set pwd [pwd]
} -body {
    cd $tcl_library
    expr { [file join . http] in [glob -dir . http*] }
} -cleanup {
    cd $pwd
} -result 1
test zipfs-0.4 {zipfs basics: glob} -constraints zipfslib -setup {
    set pwd [pwd]
} -body {
    cd $tcl_library
    expr { [file join $tcl_library http] in [glob -dir [pwd] http*] }
} -cleanup {
    cd $pwd
} -result 1
test zipfs-0.5 {zipfs basics: glob} -constraints zipfslib -body {
    expr { [file join $tcl_library http] in [glob -dir $tcl_library http*] }
} -result 1
test zipfs-0.6 {zipfs basics: glob} -constraints zipfslib -body {
    expr { [file join $tcl_library http] in [glob [file join $tcl_library http*]] }
} -result 1
test zipfs-0.7 {zipfs basics: glob} -constraints zipfslib -body {
    expr { "http" in [glob -tails -dir $tcl_library http*] }
} -result 1
test zipfs-0.8 {zipfs basics: glob} -constraints zipfslib -body {
    expr { "http" in [glob -nocomplain -tails -types d -dir $tcl_library http*] }
} -result 1
test zipfs-0.9 {zipfs basics: glob} -constraints zipfslib -body {
    glob -nocomplain -tails -types f -dir $tcl_library http*
} -result {}
test zipfs-0.10 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file join [zipfs root] bar baz
} -result "[zipfs root]bar/baz"
test zipfs-0.11 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file normalize [zipfs root]
} -result "[zipfs root]"
test zipfs-0.12 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
    file normalize [zipfs root]//bar/baz//qux/../
} -result "[zipfs root]bar/baz"

test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mount a b c d e f
} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"}
test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs unmount a b c d e f
} -result {wrong # args: should be "zipfs unmount zipfile"}
test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkkey a b c d e f
} -result {wrong # args: should be "zipfs mkkey password"}
test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkimg a b c d e f
} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}
test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs mkzip a b c d e f
} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs exists a b c d e f
} -result {wrong # args: should be "zipfs exists filename"}
test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs info a b c d e f
} -result {wrong # args: should be "zipfs info filename"}
test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body {
    zipfs list a b c d e f
} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}

file mkdir tmp
test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
    zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx
} -result {empty archive}
###
# The next series of tests operate within a zipfile created a temporary
# directory.
###
set zipfile [file join $tmpdir abc.zip]
if {[file exists $zipfile]} {
   file delete $zipfile
}
test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body {
    cd $tcl_library/encoding
    zipfs mkzip $zipfile .
    zipfs mount ${ziproot}abc $zipfile
    zipfs list -glob ${ziproot}abc/cp850.*
} -cleanup {
    cd $CWD
} -result "[zipfs root]abc/cp850.enc"
testConstraint zipfsenc [zipfs exists /abc/cp850.enc]
test zipfs-2.3 {zipfs info} -constraints {zipfs zipfsenc} -body {
    set r [zipfs info ${ziproot}abc/cp850.enc]
    lrange $r 0 2
} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable
test zipfs-2.4 {zipfs data} -constraints {zipfs zipfsenc} -body {
    set zipfd [open ${ziproot}/abc/cp850.enc]	;# FIXME: leave open - see later test
    read $zipfd
} -result {# Encoding file: cp850, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
2591259225932502252400C100C200C000A9256325512557255D00A200A52510
25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
} ;# FIXME: result depends on content of encodings dir
test zipfs-2.5 {zipfs exists} -constraints {zipfs zipfsenc} -body {
    zipfs exists /abc/cp850.enc
} -result 1
test zipfs-2.6 {zipfs unmount while busy} -constraints {zipfs zipfsenc} -body {
    zipfs unmount /abc
} -returnCodes error -result {filesystem is busy}
test zipfs-2.7 {zipfs unmount} -constraints {zipfs zipfsenc} -body {
    close $zipfd
    zipfs unmount /abc
    zipfs exists /abc/cp850.enc
} -result 0
###
# Repeat the tests for a buffer mounted archive
###
test zipfs-2.8 {zipfs mkzip} -constraints zipfs -body {
    cd $tcl_library/encoding
    zipfs mkzip $zipfile .
    set fin [open $zipfile r]
    fconfigure $fin -translation binary
    set dat [read $fin]
    close $fin
    zipfs mount_data def $dat
    zipfs list -glob ${ziproot}def/cp850.*
} -cleanup {
    cd $CWD
} -result "[zipfs root]def/cp850.enc"
testConstraint zipfsencbuf [zipfs exists /def/cp850.enc]
test zipfs-2.9 {zipfs info} -constraints {zipfs zipfsencbuf} -body {
    set r [zipfs info ${ziproot}def/cp850.enc]
    lrange $r 0 2
} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable
test zipfs-2.10 {zipfs data} -constraints {zipfs zipfsencbuf} -body {
    set zipfd [open ${ziproot}/def/cp850.enc]	;# FIXME: leave open - see later test
    read $zipfd
} -result {# Encoding file: cp850, single-byte
S
003F 0 1
00
0000000100020003000400050006000700080009000A000B000C000D000E000F
0010001100120013001400150016001700180019001A001B001C001D001E001F
0020002100220023002400250026002700280029002A002B002C002D002E002F
0030003100320033003400350036003700380039003A003B003C003D003E003F
0040004100420043004400450046004700480049004A004B004C004D004E004F
0050005100520053005400550056005700580059005A005B005C005D005E005F
0060006100620063006400650066006700680069006A006B006C006D006E006F
0070007100720073007400750076007700780079007A007B007C007D007E007F
00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
2591259225932502252400C100C200C000A9256325512557255D00A200A52510
25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
} ;# FIXME: result depends on content of encodings dir
test zipfs-2.11 {zipfs exists} -constraints {zipfs zipfsencbuf} -body {
    zipfs exists /def/cp850.enc
} -result 1
test zipfs-2.12 {zipfs unmount while busy} -constraints {zipfs zipfsencbuf} -body {
    zipfs unmount /def
} -returnCodes error -result {filesystem is busy}
test zipfs-2.13 {zipfs unmount} -constraints {zipfs zipfsencbuf} -body {
    close $zipfd
    zipfs unmount /def
    zipfs exists /def/cp850.enc
} -result 0

catch {file delete -force $tmpdir}

test zipfs-3.1 {zipfs in child interpreters} -constraints zipfs -setup {
    set interp [interp create]
} -body {
    interp eval $interp {
	zipfs ?
    }
} -returnCodes error -cleanup {
    interp delete $interp
} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
test zipfs-3.2 {zipfs in child interpreters} -constraints zipfs -setup {
    set interp [interp create]
} -body {
    interp eval $interp {
	zipfs mkzip
    }
} -returnCodes error -cleanup {
    interp delete $interp
} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup {
    set safe [interp create -safe]
} -body {
    interp eval $safe {
	zipfs ?
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup {
    set safe [interp create -safe]
} -body {
    interp eval $safe {
	zipfs mkzip
    }
} -returnCodes error -cleanup {
    interp delete $safe
} -result {not allowed to invoke subcommand mkzip of zipfs}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Deleted tests/zlib.test.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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






































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# The file tests the tclZlib.c file.
#
# This file contains a collection of tests for one or more of the Tcl built-in
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
# 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.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint zlib [llength [info commands zlib]]
testConstraint recentZlib 0
catch {
    # Work around a bug in some versions of zlib; known to manifest on at
    # least Mac OS X Mountain Lion...
    testConstraint recentZlib \
	    [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6]
}

test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
    zlib
} -result {wrong # args: should be "zlib command arg ?...?"}
test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
    zlib ? {}
} -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
test zlib-1.3 {zlib basics} -constraints zlib -body {
    zlib::pkgconfig list
} -result zlibVersion
test zlib-1.4 {zlib basics} -constraints zlib -body {
    package present zlib
} -result 2.0.1

test zlib-2.1 {zlib compress/decompress} zlib {
    zlib decompress [zlib compress abcdefghijklm]
} abcdefghijklm

test zlib-3.1 {zlib deflate/inflate} zlib {
    zlib inflate [zlib deflate abcdefghijklm]
} abcdefghijklm

test zlib-4.1 {zlib gzip/gunzip} zlib {
    zlib gunzip [zlib gzip abcdefghijklm]
} abcdefghijklm
test zlib-4.2 {zlib gzip/gunzip} zlib {
    set s [string repeat abcdef 5]
    list [zlib gunzip [zlib gzip $s -header {comment gorp}] -header head] \
	[dict get $head comment] [dict get $head size]
} {abcdefabcdefabcdefabcdefabcdef gorp 30}

test zlib-5.1 {zlib adler32} zlib {
    format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}]
} b3b50b9b
test zlib-5.2 {zlib adler32} zlib {
    format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}]
} b8830bc4
test zlib-5.3 {zlib adler32} -constraints zlib -returnCodes error -body {
    zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42 x
} -result {wrong # args: should be "zlib adler32 data ?startValue?"}

test zlib-6.1 {zlib crc32} zlib {
    format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}]
} 6f73e901
test zlib-6.2 {zlib crc32} zlib {
    format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}]
} ce1c4914
test zlib-6.3 {zlib crc32} -constraints zlib -returnCodes error -body {
    zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42 x
} -result {wrong # args: should be "zlib crc32 data ?startValue?"}
test zlib-6.4 {zlib crc32: bug 2662434} -constraints zlib -body {
    zlib crc32 "dabale arroz a la zorra el abad"
} -result 3842832571

test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
    set s [zlib stream compress]
} -body {
    $s ?
} -cleanup {
    $s close
} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
test zlib-7.1 {zlib stream} zlib {
    set s [zlib stream compress]
    $s put -finalize abcdeEDCBA
    set data [$s get]
    set result [list [$s get] [format %x [$s checksum]]]
    $s close
    lappend result [zlib decompress $data]
} {{} 136f033f abcdeEDCBA}
test zlib-7.2 {zlib stream} zlib {
    set s [zlib stream decompress]
    $s put -finalize [zlib compress abcdeEDCBA]
    set data [$s get]
    set result [list [$s get] [format %x [$s checksum]]]
    $s close
    lappend result $data
} {{} 136f033f abcdeEDCBA}
test zlib-7.3 {zlib stream} zlib {
    set s [zlib stream deflate]
    $s put -finalize abcdeEDCBA
    set data [$s get]
    set result [list [$s get] [format %x [$s checksum]]]
    $s close
    lappend result [zlib inflate $data]
} {{} 1 abcdeEDCBA}
test zlib-7.4 {zlib stream} zlib {
    set s [zlib stream inflate]
    $s put -finalize [zlib deflate abcdeEDCBA]
    set data [$s get]
    set result [list [$s get] [format %x [$s checksum]]]
    $s close
    lappend result $data
} {{} 1 abcdeEDCBA}
test zlib-7.5 {zlib stream} zlib {
    set s [zlib stream gzip]
    $s put -finalize abcdeEDCBA..
    set data [$s get]
    set result [list [$s get] [format %x [$s checksum]]]
    $s close
    lappend result [zlib gunzip $data]
} {{} 69f34b6a abcdeEDCBA..}
test zlib-7.6 {zlib stream} zlib {
    set s [zlib stream gunzip]
    $s put -finalize [zlib gzip abcdeEDCBA..]
    set data [$s get]
    set result [list [$s get] [format %x [$s checksum]]]
    $s close
    lappend result $data
} {{} 69f34b6a abcdeEDCBA..}
test zlib-7.7 {zlib stream: Bug 25842c161} -constraints zlib -body {
    set s [zlib stream deflate]
    $s put {}
} -cleanup {
    catch {$s close}
} -result ""
# Also causes Tk Bug 10f2e7872b
test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup {
    expr srand(12345)
    set randdata {}
    for {set i 0} {$i<6001} {incr i} {
	append randdata [binary format c [expr {int(256*rand())}]]
    }
} -body {
    set strm [zlib stream compress]
    for {set i 1} {$i<3000} {incr i} {
	$strm put $randdata
    }
    $strm put -finalize $randdata
    set data [$strm get]
    list [string length $data] [string length [zlib decompress $data]]
} -cleanup {
    catch {$strm close}
    unset -nocomplain randdata data
} -result {120185 18003000}
test zlib-7.9 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup {
    set z1 [zlib stream gzip]
    set z2 [zlib stream gzip]
} -body {
    $z1 put ABCDEedbca..
    $z1 finalize
    zlib gunzip [$z1 get]
} -cleanup {
    $z1 close
} -result ABCDEedbca..
test zlib-7.10 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup {
    set z2 [zlib stream gzip]
} -body {
    $z2 put -finalize ABCDEedbca..
    zlib gunzip [$z2 get]
} -cleanup {
    $z2 close
} -result ABCDEedbca..
test zlib-7.11 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup {
    set c [zlib stream gzip]
    set d [zlib stream gunzip]
} -body {
    $c put abcdeEDCBA..
    $c finalize
    $d put [$c get]
    $d finalize
    $d get
} -cleanup {
    $c close
    $d close
} -result abcdeEDCBA..
test zlib-7.12 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup {
    set c [zlib stream gzip]
    set d [zlib stream gunzip]
} -body {
    $c put -finalize abcdeEDCBA..
    $d put -finalize [$c get]
    $d get
} -cleanup {
    $c close
    $d close
} -result abcdeEDCBA..

test zlib-8.1 {zlib transformation} -constraints zlib -setup {
    set file [makeFile {} test.gz]
} -body {
    set f [zlib push gzip [open $file w] -header {comment gorp}]
    puts $f "ok"
    close $f
    set f [zlib push gunzip [open $file]]
    list [gets $f] [dict get [chan configure $f -header] comment]
} -cleanup {
    close $f
    removeFile $file
} -result {ok gorp}
test zlib-8.2 {zlib transformation} -constraints zlib -setup {
    set file [makeFile {} test.z]
} -body {
    set f [zlib push compress [open $file w]]
    puts $f "ok"
    close $f
    set f [zlib push decompress [open $file]]
    gets $f
} -cleanup {
    close $f
    removeFile $file
} -result ok
test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        fconfigure $c -translation binary -buffering none -blocking 0
        puts -nonewline $c [zlib gzip [string repeat a 81920]]
        close $c
    }}} 0]
    set port [lindex [fconfigure $srv -sockname] 2]
    set file [makeFile {} test.gz]
    set fout [open $file wb]
} -body {
    set sin [socket localhost $port]
    try {
	fconfigure $sin -translation binary
	zlib push gunzip $sin
	after 1000 {set total timeout}
	fcopy $sin $fout -command {apply {{c {e {}}} {
	    set ::total [expr {$e eq {} ? $c : $e}]
	}}}
	vwait total
	after cancel {set total timeout}
    } finally {
	close $sin
    }
    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-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup {
    foreach {r w} [chan pipe] break
} -constraints zlib -body {
    set ::res {}
    fconfigure $w -buffering none
    zlib push compress $w
    puts -nonewline $w qwertyuiop
    chan configure $w -flush sync
    after 500 {puts -nonewline $w asdfghjkl;close $w}
    fconfigure $r -blocking 0 -buffering none
    zlib push decompress $r
    fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}}
    after 250 {lappend ::res MIDDLE}
    vwait ::done
    set ::res
} -cleanup {
    catch {close $r}
} -result {qwertyuiop MIDDLE asdfghjkl {}}
test zlib-8.6 {transformation and fconfigure} -setup {
    set file [makeFile {} test.z]
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
test zlib-8.7 {transformation and fconfigure} -setup {
    set file [makeFile {} test.gz]
    set fd [open $file wb]
} -constraints zlib -body {
    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
	[chan pop $fd; fconfigure $fd]
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
# Input is headers from fetching SPDY draft
# Dictionary is that which is proposed _in_ SPDY draft
set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
test zlib-8.8 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
    zlib push compress $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 1 -translation binary -buffering none
    fconfigure $inSide -blocking 1 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    chan close $outSide
    set compressed [read $inSide]
    catch {zlib decompress $compressed} err opt
    list [string length [zlib compress $spdyHeaders]] \
	[string length $compressed] \
	$err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
test zlib-8.9 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream decompress]
} -constraints zlib -body {
    zlib push compress $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 1 -translation binary -buffering none
    fconfigure $inSide -blocking 1 -translation binary
    puts -nonewline $outSide $spdyHeaders
    set result [fconfigure $outSide -checksum]
    chan pop $outSide
    chan close $outSide
    $strm put -dictionary $spdyDict [read $inSide]
    lappend result [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {3064818174 358 358}
test zlib-8.10 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints {zlib recentZlib} -body {
    zlib push deflate $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 1 -translation binary -buffering none
    fconfigure $inSide -blocking 1 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    chan close $outSide
    set compressed [read $inSide]
    catch {
	zlib inflate $compressed
	throw UNREACHABLE "should be unreachable"
    } err opt
    list [string length [zlib deflate $spdyHeaders]] \
	[string length $compressed] \
	$err [dict get $opt -errorcode]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
} -result {254 212 {data error} {TCL ZLIB DATA}}
test zlib-8.11 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream inflate]
} -constraints zlib -body {
    zlib push deflate $outSide -dictionary $spdyDict
    fconfigure $outSide -blocking 1 -translation binary -buffering none
    fconfigure $inSide -blocking 1 -translation binary
    puts -nonewline $outSide $spdyHeaders
    chan pop $outSide
    chan close $outSide
    $strm put -dictionary $spdyDict [read $inSide]
    list [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.12 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream compress]
} -constraints zlib -body {
    $strm put -dictionary $spdyDict -finalize $spdyHeaders
    zlib push decompress $inSide
    fconfigure $outSide -blocking 1 -translation binary
    fconfigure $inSide -translation binary -dictionary $spdyDict
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]] \
	[fconfigure $inSide -checksum]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358 3064818174}
test zlib-8.13 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream compress]
} -constraints zlib -body {
    $strm put -dictionary $spdyDict -finalize $spdyHeaders
    zlib push decompress $inSide -dictionary $spdyDict
    fconfigure $outSide -blocking 1 -translation binary
    fconfigure $inSide -translation binary
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]] \
	[fconfigure $inSide -checksum]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358 3064818174}
test zlib-8.14 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream deflate]
} -constraints zlib -body {
    $strm put -finalize -dictionary $spdyDict $spdyHeaders
    zlib push inflate $inSide
    fconfigure $outSide -blocking 1 -buffering none -translation binary
    fconfigure $inSide -translation binary -dictionary $spdyDict
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.15 {transformation and fconfigure} -setup {
    lassign [chan pipe] inSide outSide
    set strm [zlib stream deflate]
} -constraints zlib -body {
    $strm put -finalize -dictionary $spdyDict $spdyHeaders
    zlib push inflate $inSide -dictionary $spdyDict
    fconfigure $outSide -blocking 1 -buffering none -translation binary
    fconfigure $inSide -translation binary
    puts -nonewline $outSide [$strm get]
    close $outSide
    list [string length $spdyHeaders] [string length [read $inSide]]
} -cleanup {
    catch {close $outSide}
    catch {close $inSide}
    catch {$strm close}
} -result {358 358}
test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup {
    # Actual data isn't very important; needs to be substantially larger than
    # the internal buffer (32kB) and incompressible.
    set largeData {}
    for {set i 0;expr srand(1)} {$i < 100000} {incr i} {
	append largeData [lindex "a b c d e f g h i j k l m n o p" \
		[expr {int(16*rand())}]]
    }
    set file [makeFile {} test.gz]
} -constraints zlib -body {
    set f [open $file wb]
    fconfigure $f -buffering none
    zlib push gzip $f
    puts -nonewline $f $largeData
    close $f
    file size $file
} -cleanup {
    removeFile $file
} -result 57647
test zlib-8.17 {Bug dd260aaf: fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
    zlib push inflate $inSide
    zlib push deflate $outSide
    list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
} -cleanup {
    catch {close $inSide}
    catch {close $outSide}
} -result {{} {}}
test zlib-8.18 {Bug dd260aaf: fconfigure} -setup {
    lassign [chan pipe] inSide outSide
} -constraints zlib -body {
    zlib push inflate $inSide -dictionary "one two"
    zlib push deflate $outSide -dictionary "one two"
    list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
} -cleanup {
    catch {close $inSide}
    catch {close $outSide}
} -result {{one two} {one two}}

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
} -body {
    set fin [zlib push gunzip [open $sfile rb]]
    set fout [open $file wb]
    set total [fcopy $fin $fout]
    close $fin ; close $fout
    list copied $total size [file size $file]
} -cleanup {
    removeFile $file
    removeFile $sfile
} -result {copied 81920 size 81920}
test zlib-9.2 "socket fcopy with push" -constraints zlib -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        puts -nonewline $c [zlib gzip [string repeat a 81920]]
        close $c
        set ::total -1
    }}} 0]
    set file [makeFile {} test.gz]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    set sin [socket $addr $port]
    chan configure $sin -translation binary
    zlib push gunzip $sin
    after 1000 {set ::total timeout}
    vwait ::total
    after cancel {set ::total timeout}
    if {$::total != -1} {error "unexpected value $::total of ::total"}
    set total [fcopy $sin [set fout [open $file wb]]]
    close $sin
    close $fout
    list read $total size [file size $file]
} -cleanup {
    close $srv
    removeFile $file
} -result {read 81920 size 81920}
test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        #puts "connection from $a:$p on $c"
        chan configure $c -translation binary -buffering none -blocking 0
        puts -nonewline $c [string repeat a 81920]
        close $c
    }}} 0]
    set file [makeFile {} test.gz]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    #puts "listening for connections on $addr $port"
    set sin [socket localhost $port]
    chan configure $sin -translation binary
    update
    set fout [open $file wb]
    after 1000 {set ::total timeout}
    fcopy $sin $fout -command {apply {{c {e {}}} {
        set ::total [expr {$e eq {} ? $c : $e}]
    }}}
    vwait ::total
    after cancel {set ::total timeout}
    close $sin; close $fout
    list read $::total size [file size $file]
} -cleanup {
    close $srv
    removeFile $file
} -returnCodes {ok error} -result {read 81920 size 81920}
test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        puts -nonewline $c [zlib gzip [string repeat a 81920]]
        close $c
    }}} 0]
    set file [makeFile {} test.gz]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    set sin [socket $addr $port]
    chan configure $sin -translation binary
    zlib push gunzip $sin
    update
    set fout [open $file wb]
    after 1000 {set ::total timeout}
    fcopy $sin $fout -command {apply {{c {e {}}} {
        set ::total [expr {$e eq {} ? $c : $e}]
    }}}
    vwait ::total
    after cancel {set ::total timeout}
    close $sin; close $fout
    list read $::total size [file size $file]
} -cleanup {
    close $srv
    removeFile $file
} -result {read 81920 size 81920}
test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        puts -nonewline $c [zlib gzip [string repeat a 81920]]
        close $c
    }}} 0]
    proc zlib95copy {i o t c {e {}}} {
        incr t $c
        if {$e ne {}} {
            set ::total [list error $e]
        } elseif {[eof $i]} {
            set ::total [list eof $t]
        } else {
            fcopy $i $o -size 8192 -command [list zlib95copy $i $o $t]
        }
    }
    set file [makeFile {} test.gz]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    set sin [socket $addr $port]
    chan configure $sin -translation binary
    zlib push gunzip $sin
    update
    set fout [open $file wb]
    after 1000 {set ::total timeout}
    fcopy $sin $fout -size 8192 -command [list zlib95copy $sin $fout 0]
    vwait ::total
    after cancel {set ::total timeout}
    close $sin; close $fout
    list $::total size [file size $file]
} -cleanup {
    close $srv
    rename zlib95copy {}
    removeFile $file
} -result {{eof 81920} size 81920}
test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        zlib push gzip $c
        puts -nonewline $c [string repeat hello 100]
        close $c
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    chan configure $s -translation binary
    zlib push gunzip $s
    chan event $s readable [list apply {{s} {
        set d [read $s]
        if {[eof $s]} {
            chan event $s readable {}
            set ::total [list eof [string length $d]]
        }
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    close $s
    set ::total
} -cleanup {
    close $srv
    unset -nocomplain total
} -result {eof 500}
test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        zlib push compress $c
        puts -nonewline $c [string repeat hello 100]
        close $c
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    chan configure $s -translation binary
    zlib push decompress $s
    chan event $s readable [list apply {{s} {
        set d [read $s]
        if {[eof $s]} {
            chan event $s readable {}
            set ::total [list eof [string length $d]]
        }
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    close $s
    set ::total
} -cleanup {
    close $srv
    unset -nocomplain total
} -result {eof 500}
test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        zlib push deflate $c
        puts -nonewline $c [string repeat hello 100]
        close $c
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    chan configure $s -translation binary
    zlib push inflate $s
    chan event $s readable [list apply {{s} {
        set d [read $s]
        if {[eof $s]} {
            chan event $s readable {}
            set ::total [list eof [string length $d]]
        }
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    close $s
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
} -result {eof 500}
test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {
    proc bgerror {s} {set ::total [list error $s]}
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        zlib push gzip $c
        puts -nonewline $c [string repeat hello 100]
        close $c
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    try {
        chan configure $s -translation binary
        zlib push inflate $s
        chan event $s readable [list apply {{s} {
            set d [read $s]
            if {[eof $s]} {
                chan event $s readable {}
                set ::total [list eof [string length $d]]
            }
        }} $s]
        vwait ::total
    } finally {
	after cancel {set ::total timeout}
        close $s
    }
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
    rename bgerror {}
} -result {error {invalid block type}}
test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup {
    proc bgerror {s} {set ::total [list error $s]}
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        zlib push compress $c
        puts -nonewline $c [string repeat hello 100]
        close $c
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    try {
        chan configure $s -translation binary
        zlib push inflate $s
        chan event $s readable [list apply {{s} {
            set d [read $s]
            if {[eof $s]} {
                chan event $s readable {}
                set ::total [list eof [string length $d]]
            }
        }} $s]
        vwait ::total
    } finally {
	after cancel {set ::total timeout}
        close $s
    }
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
    rename bgerror {}
} -result {error {invalid stored block lengths}}
test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup {
    proc bgerror {s} {set ::total [list error $s]}
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary -buffering none -blocking 0
        zlib push deflate $c
        puts -nonewline $c [string repeat hello 100]
        close $c
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    try {
        chan configure $s -translation binary
        zlib push gunzip $s
        chan event $s readable [list apply {{s} {
            set d [read $s]
            if {[eof $s]} {
                chan event $s readable {}
                set ::total [list eof [string length $d]]
            }
        }} $s]
        vwait ::total
    } finally {
	after cancel {set ::total timeout}
        close $s
    }
    set ::total
} -cleanup {
    unset -nocomplain total
    close $srv
    rename bgerror {}
} -result {error {incorrect header check}}

test zlib-10.0 "bug #2818131 (close with null interp)" -constraints {
    zlib
} -setup {
    proc bgerror {s} {set ::total [list error $s]}
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary
        zlib push inflate $c
        chan event $c readable [list apply {{c} {
            set d [read $c]
            if {[eof $c]} {
                chan event $c readable {}
                close $c
                set ::total [list eof [string length $d]]
            }
        }} $c]
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    chan configure $s -translation binary -buffering none -blocking 0
    zlib push gzip $s
    chan event $s xyzzy [list apply {{s} {
        if {[gets $s line] < 0} {
            chan close $s
        }
    }} $s]
    after idle [list apply {{s} {
        puts $s test
        chan close $s
        after 100 {set ::total done}
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    after cancel {set ::total done}
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
} -returnCodes error \
  -result {bad event name "xyzzy": must be readable or writable}
test zlib-10.1 "bug #2818131 (mismatch read)" -constraints {
    zlib
} -setup {
    proc bgerror {s} {set ::total [list error $s]}
    proc zlibRead {c} {
        set d [read $c]
        if {[eof $c]} {
            chan event $c readable {}
            close $c
            set ::total [list eof [string length $d]]
        }
    }
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary
        zlib push inflate $c
        chan event $c readable [list zlibRead $c]
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    chan configure $s -translation binary -buffering none -blocking 0
    zlib push gzip $s
    chan event $s readable [list zlibRead $s]
    after idle [list apply {{s} {
        puts $s test
        chan close $s
        after 100 {set ::total done}
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    after cancel {set ::total done}
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
    rename zlibRead {}
} -result {error {invalid block type}}
test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
    zlib
} -setup {
    proc bgerror {s} {set ::total [list error $s]}
    proc zlibRead {c} {
        if {[gets $c line] < 0} {
            close $c
            set ::total [list error -1]
        } elseif {[eof $c]} {
            chan event $c readable {}
            close $c
            set ::total [list eof 0]
        }
    }
    set srv [socket -myaddr localhost -server {apply {{c a p} {
        chan configure $c -translation binary
        zlib push inflate $c
        chan event $c readable [list zlibRead $c]
    }}} 0]
} -body {
    lassign [chan configure $srv -sockname] addr name port
    after 1000 {set ::total timeout}
    set s [socket $addr $port]
    chan configure $s -translation binary -buffering none -blocking 0
    zlib push gzip $s
    chan event $s readable [list zlibRead $s]
    after idle [list apply {{s} {
        puts $s test
        chan close $s
        after 100 {set ::total done}
    }} $s]
    vwait ::total
    after cancel {set ::total timeout}
    after cancel {set ::total done}
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
    rename zlibRead {}
} -result {error {invalid block type}}

test zlib-11.1 "Bug #3390073: mis-applied gzip filtering" -setup {
    set file [makeFile {} test.input]
} -constraints zlib -body {
    set f [open $file wb]
    puts -nonewline [zlib push gzip $f] [string repeat "hello" 1000]
    close $f
    set f [open $file rb]
    set d [read $f]
    close $f
    set d [zlib gunzip $d]
    list [regexp -all "hello" $d] [string length [regsub -all "hello" $d {}]]
} -cleanup {
    removeFile $file
} -result {1000 0}
test zlib-11.2 "Bug #3390073: mis-applied gzip filtering" -setup {
    set file [makeFile {} test.input]
} -constraints zlib -body {
    set f [open $file wb]
    puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
	[string repeat "hello" 1000]
    close $f
    set f [open $file rb]
    set d [read $f]
    close $f
    set d [zlib gunzip $d -header h]
    list [regexp -all "hello" $d] [dict get $h filename] \
	[string length [regsub -all "hello" $d {}]]
} -cleanup {
    removeFile $file
} -result {1000 /foo/bar 0}
test zlib-11.3 {Bug 3595576 variant} -setup {
    set file [makeFile {} test.input]
} -constraints zlib -body {
    set f [open $file wb]
    puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
	[string repeat "hello" 1000]
    close $f
    set f [open $file rb]
    set d [read $f]
    close $f
    zlib gunzip $d -header noSuchNs::foo
} -cleanup {
    removeFile $file
} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}

test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup {
    set stream [zlib stream compress]
} -body {
    for {set opts {};set y 0} {$y < 60} {incr y} {
	for {set line {};set x 0} {$x < 100} {incr x} {
	    append line [binary format ccc $x $y 128]
	}
	if {$y == 59} {
	    set opts -finalize
	}
	$stream put {*}$opts $line
    }
    set data [$stream get]
    list [string length $data] [string length [zlib decompress $data]]
} -cleanup {
    $stream close
} -result {12026 18000}
test zlib-12.2 {Patrick Dunnigan's issue} -constraints zlib -setup {
    set filesrc [makeFile {} test.input]
    set filedst [makeFile {} test.output]
    set f [open $filesrc "wb"]
    for {set i 0} {$i < 10000} {incr i} {
	puts -nonewline $f "x"
    }
    close $f
} -body {
    set fin [open $filesrc "rb"]
    set fout [open $filedst "wb"]
    set header [dict create filename "test.input" time 0]
    try {
	fcopy $fin [zlib push gzip $fout -header $header]
    } finally {
	close $fin
	close $fout
    }
    file size $filedst
} -cleanup {
    removeFile $filesrc
    removeFile $filedst
} -result 56

set zlibbinf ""
proc _zlibbinf {} {
  # inlined zlib.bin file creator:
  variable zlibbinf
  if {$zlibbinf eq ""} {
    set zlibbinf [makeFile {} test-zlib-13.bin]
    set f [open $zlibbinf wb]
    puts -nonewline $f [zlib decompress [binary decode base64 {
      eJx7e+6s1+EAgYaLjK3ratptGmOck0vT/y/ZujHAd0qJelDBXfUPJ3tfrtLbpX+wOOFHmtn03/tizm
      /+tXROXU3d203b79p5X6/0cvUyFzTsqOj4sa9r8SrZI5zT7265e2Xzq595Fb9LbpgffVy7cZaJ/d15
      4U9L7LLM2vdqut8+aSU/r6q9Ltv6+T9mBhTgIK97bH33m/O1C1eBwf9FDKNgaIDaj9wA+5hToA==
    }]]
    close $f
  }
  return $zlibbinf
}
test zlib-13.1 {Ticket [8af92dfb66] - zlib stream mis-expansion} -constraints zlib -setup {
    set pathin  [_zlibbinf]
    set chanin  [open $pathin rb]
    set pathout [makeFile {} test-zlib-13.deflated]
    set chanout [open $pathout wb]
    zlib push inflate $chanin
    fcopy $chanin $chanout
    close $chanin
    close $chanout
} -body {
    file size $pathout
} -cleanup {
    removeFile $pathout
    unset chanin pathin chanout pathout
} -result 458752

test zlib-13.2 {Ticket [f70ce1fead] - zlib multi-stream expansion} -constraints zlib -setup {
    # Start from the basic asset
    set pathin  [_zlibbinf]
    set chanin  [open $pathin rb]
    # Create a multi-stream by copying the asset twice into it.
    set pathout [makeFile {} test-zlib-13.multi]
    set chanout [open $pathout wb]
    fcopy $chanin $chanout
    seek  $chanin 0 start
    fcopy $chanin $chanout
    close $chanin
    close $chanout
    # The multi-stream file shall be our input
    set pathin $pathout
    set chanin [open $pathin rb]
    # And our destinations
    set pathout1 [makeFile {} test-zlib-13.multi-1]
    set pathout2 [makeFile {} test-zlib-13.multi-2]
} -body {
    # Decode first stream
    set chanout [open $pathout1 wb]
    zlib push inflate $chanin
    fcopy $chanin $chanout
    chan pop $chanin
    close $chanout
    # Decode second stream
    set chanout [open $pathout2 wb]
    zlib push inflate $chanin
    fcopy $chanin $chanout
    chan pop $chanin
    close $chanout
    #
    list [file size $pathout1] [file size $pathout2]
} -cleanup {
    close $chanin
    removeFile $pathout
    removeFile $pathout1
    removeFile $pathout2
    unset chanin pathin chanout pathout pathout1 pathout2
} -result {458752 458752}

if {$zlibbinf ne ""} {
   removeFile $zlibbinf
}
unset zlibbinf
rename _zlibbinf {}


::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tools/README.

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25



8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
26
27
28







-
+










+
+
+
uniClass.tcl -- Script for generating regexp class tables from the Tcl
	"string is" classes

Generating HTML files.
The tcl-tk-man-html.tcl script from Robert Critchlow
generates a nice set of HTML with good cross references.
Use it like
    tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0
    tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2
This script is very picky about the organization of man pages,
effectively acting as a style enforcer.

Generating Windows Help Files:
1) Build tcl in the ../unix directory
2) On UNIX, (after autoconf and configure), do
	make
    this converts the Nroff to RTF files.
2) On Windows, convert the RTF to a Help doc, do
	nmake helpfile

Generating Windows binary distribution.
Update and compile the WYSE tcl.wse configuration.

Changes to tools/checkLibraryDoc.tcl.

1
2
3
4
5
6

7
8
9
10
11
12
13
1
2
3
4
5

6
7
8
9
10
11
12
13





-
+







# checkLibraryDoc.tcl --
#
# This script attempts to determine what APIs exist in the source base that
# have not been documented.  By grepping through all of the doc/*.3 man
# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
# against the list of Pkg_ APIs found in the source (e.g., tcl9.0/*/*.[ch])
# against the list of Pkg_ APIs found in the source (e.g., tcl8.5/*/*.[ch])
# we create six lists:
#      1) APIs in Source not in Docs.
#      2) APIs in Docs not in Source.
#      3) Internal APIs and structs.
#      4) Misc APIs and structs that we are not documenting.
#      5) Command APIs (e.g., Tcl_ArrayObjCmd.)
#      6) Proc pointers (e.g., Tcl_CloseProc.)
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
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







+
+

















-







    Tcl_SavedResult \
    Tcl_ThreadDataKey \
    Tcl_ThreadId \
    Tcl_Time \
    Tcl_TimerToken \
    Tcl_Token \
    Tcl_Trace \
    Tcl_Value \
    Tcl_ValueType \
    Tcl_Var \
    Tk_3DBorder \
    Tk_ArgvInfo \
    Tk_BindingTable \
    Tk_Canvas \
    Tk_CanvasTextInfo \
    Tk_ConfigSpec \
    Tk_ConfigTypes \
    Tk_Cursor \
    Tk_CustomOption \
    Tk_ErrorHandler \
    Tk_FakeWin \
    Tk_Font \
    Tk_FontMetrics \
    Tk_GeomMgr \
    Tk_Image \
    Tk_ImageMaster \
    Tk_ImageModel \
    Tk_ImageType \
    Tk_Item \
    Tk_ItemType \
    Tk_OptionSpec\
    Tk_OptionTable \
    Tk_OptionType \
    Tk_PhotoHandle \

Changes to tools/configure.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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


-
+

-
-
+
-
-


-
-
-
+
+
+

-
+
-
-
+


-
+


-
-
-
+
-
-
+
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-

-
+
-
-
-

-
-
+
-
-
-
+
-
-
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
+
-
-
-
+
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-





-
+





-
-
-
-
-

+
-
+


-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
+







+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
+
+
+
+
+
-
-
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+

-
-
+
+
+

-
-
-
-


-
-
+
+




-
+
-
-
-
+
-
-
+
-
-
+
-
-
-
+
+


-
-
+
-
+

-
-
+

+
+
-
-
+
+
-
-
+
-
-
+
-
-
-
+
+
+
-
-

-
+

+
+

-
+

-
+
-


-
+





-
-
+








+
+
+
+
+
-
-
+
+
+
+


-
+


+
+





-

-




+
+
+
+
+
+







-


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-




-
-







#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69.
# Generated by GNU Autoconf 2.59.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
# Copyright (C) 2003 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##
## --------------------- ##
## M4sh Initialization.  ##
## --------------------- ##

# Be more Bourne compatible
# Be Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
  *posix*) :
    set -o posix ;; #(
  set -o posix
  *) :
     ;;
esac
fi

DUALCASE=1; export DUALCASE # for MKS sh

as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '
    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi
  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'
fi

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  PATH_SEPARATOR=:
  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
      PATH_SEPARATOR=';'
  }

fi


# Support unset when possible.
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

  as_unset=unset
# Find who we are.  Look in the path if we contain no directory separator.
as_myself=
else
case $0 in #((
  *[\\/]* ) as_myself=$0 ;;
  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
  done
IFS=$as_save_IFS

  as_unset=false
     ;;
esac
# We did not find ourselves, most probably we were run as `sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
  as_myself=$0
fi
if test ! -f "$as_myself"; then

  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# Work around bugs in pre-3.0 UWIN ksh.
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
$as_unset ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH

# Use a proper internal environment variable to ensure we don't fall
  # into an infinite loop, continuously re-executing ourselves.
  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
    _as_can_reexec=no; export _as_can_reexec;
    # We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
  *v*x* | *x*v* ) as_opts=-vx ;;
  *v* ) as_opts=-v ;;
  *x* ) as_opts=-x ;;
  * ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '\${1+\"\$@\"}'='\"\$@\"'
  setopt NO_GLOB_SUBST
else
  case \`(set -o) 2>/dev/null\` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi
"
  as_required="as_fn_return () { (exit \$1); }
as_fn_success () { as_fn_return 0; }
as_fn_failure () { as_fn_return 1; }
as_fn_ret_success () { return 0; }
as_fn_ret_failure () { return 1; }

exitcode=0
as_fn_success || { exitcode=1; echo as_fn_success failed.; }
as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :

else
  exitcode=1; echo positional parameters were not saved.
fi
test x\$exitcode = x0 || exit 1
test -x / || exit 1"
  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"
  if (eval "$as_required") 2>/dev/null; then :
  as_have_required=yes
for as_var in \
else
  as_have_required=no
  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :

  LC_TELEPHONE LC_TIME
else
  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
as_found=false
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  as_found=:
  case $as_dir in #(
	 /*)
	   for as_base in sh bash ksh sh5; do
	     # Try only shells that exist, to save several forks.
	     as_shell=$as_dir/$as_base
	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
  CONFIG_SHELL=$as_shell as_have_required=yes
		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
  break 2
fi
fi
	   done;;
       esac
  as_found=false
done
$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
  CONFIG_SHELL=$SHELL as_have_required=yes
fi; }
IFS=$as_save_IFS


  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
    eval $as_var=C; export $as_var
      if test "x$CONFIG_SHELL" != x; then :
  export CONFIG_SHELL
             # We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
  *v*x* | *x*v* ) as_opts=-vx ;;
  *v* ) as_opts=-v ;;
  *x* ) as_opts=-x ;;
  * ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi

    if test x$as_have_required = xno; then :
  $as_echo "$0: This script requires a shell more modern than all"
  $as_echo "$0: the shells that I found on your system."
  if test x${ZSH_VERSION+set} = xset ; then
    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
  else
    $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
$0: including any error possibly output before this
$0: message. Then install a modern shell, or manually run
$0: the script under such a shell if you do have one."
  fi
  exit 1
    $as_unset $as_var
fi
fi
  fi
fi
SHELL=${CONFIG_SHELL-/bin/sh}
export SHELL
# Unset more variables known to interfere with behavior of common tools.
CLICOLOR_FORCE= GREP_OPTIONS=
unset CLICOLOR_FORCE GREP_OPTIONS

## --------------------- ##
## M4sh Shell Functions. ##
## --------------------- ##
# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset

# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *) as_qdir=$as_dir;;
      esac
      as_dirs="'$as_qdir' $as_dirs"
      as_dir=`$as_dirname -- "$as_dir" ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"


# Required to use basename.
} # as_fn_mkdir_p

# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else
  as_fn_append ()
  {
    eval $1=\$$1\$2
  }
fi # as_fn_append

# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
  as_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith


# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
  as_status=$1; test $as_status -eq 0 && as_status=1
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error

if expr a : '\(a\)' >/dev/null 2>&1 &&
if expr a : '\(a\)' >/dev/null 2>&1; then
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

# Name of the executable.
as_me=`$as_basename -- "$0" ||
as_me=`$as_basename "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	 X"$0" : 'X\(/\)$' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
  	  /^X\/\(\/\/\)$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
  	  /^X\/\(\/\).*/{ s//\1/; q; }
  	  s/.*/./; q'`


	  s/.*/./; q'`

# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  echo "#! /bin/sh" >conf$$.sh
  echo  "exit 0"   >>conf$$.sh
  chmod +x conf$$.sh
  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
    PATH_SEPARATOR=';'
  else
    PATH_SEPARATOR=:
  fi
  rm -f conf$$.sh
fi


  as_lineno_1=$LINENO as_lineno_1a=$LINENO
  as_lineno_2=$LINENO as_lineno_2a=$LINENO
  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2"  || {
  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
  sed -n '
  # Find who we are.  Look in the path if we contain no path at all
  # relative or not.
  case $0 in
    p
    /[$]LINENO/=
  ' <$as_myself |
    sed '
    *[\\/]* ) as_myself=$0 ;;
    *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
      s/[$]LINENO.*/&-/
      t lineno
      b
      :lineno
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
done

       ;;
  esac
      N
      :loop
      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
  # We did not find ourselves, most probably we were run as `sh COMMAND'
  # in which case we are not to be found in the path.
  if test "x$as_myself" = x; then
    as_myself=$0
  fi
  if test ! -f "$as_myself"; then
    { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
   { (exit 1); exit 1; }; }
  fi
  case $CONFIG_SHELL in
  '')
    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  for as_base in sh bash ksh sh5; do
	 case $as_dir in
	 /*)
	   if ("$as_dir/$as_base" -c '
  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then
	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
	     CONFIG_SHELL=$as_dir/$as_base
	     export CONFIG_SHELL
	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}
	   fi;;
	 esac
       done
done
;;
  esac

  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
  # uniformly replaced by the line number.  The first 'sed' inserts a
  # line-number line before each line; the second 'sed' does the real
  # work.  The second script uses 'N' to pair each line-number line
  # with the numbered line, and appends trailing '-' during
  # substitution so that $LINENO is not a special case at line end.
  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
  # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)
  sed '=' <$as_myself |
    sed '
      N
      s,$,-,
      : loop
      s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
      t loop
      s/-\n.*//
      s,-$,,
      s,^['$as_cr_digits']*\n,,
    ' >$as_me.lineno &&
  chmod +x "$as_me.lineno" ||
    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
  chmod +x $as_me.lineno ||
    { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
   { (exit 1); exit 1; }; }

  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
  # already done that, so ensure we don't try to do so again and fall
  # in an infinite loop.  This has already happened in practice.
  _as_can_reexec=no; export _as_can_reexec
  # Don't try to exec as it changes $[0], causing all sort of problems
  # (the dirname of $[0] is not the place where we might find the
  # original and so on.  Autoconf is especially sensitive to this).
  . "./$as_me.lineno"
  # original and so on.  Autoconf is especially sensible to this).
  . ./$as_me.lineno
  # Exit status is that of the last command.
  exit
}

ECHO_C= ECHO_N= ECHO_T=

case `echo -n x` in #(((((
-n*)
  case `echo 'xy\c'` in
case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
  xy)  ECHO_C='\c';;
  *c*,-n*) ECHO_N= ECHO_C='
  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
       ECHO_T='	';;
' ECHO_T='	' ;;
  esac;;
*)
  ECHO_N='-n';;
  *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;
  *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;
esac

rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
if expr a : '\(a\)' >/dev/null 2>&1; then
  rm -f conf$$.dir/conf$$.file
  as_expr=expr
else
  rm -f conf$$.dir
  mkdir conf$$.dir 2>/dev/null
  as_expr=false
fi

rm -f conf$$ conf$$.exe conf$$.file
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
echo >conf$$.file
if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
  # We could just check for DJGPP; but this test a) works b) is more generic
    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
  # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
    # In both cases, we have to default to `cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
      as_ln_s='cp -pR'
  if test -f conf$$.exe; then
    # Don't use ln at all; we don't have any links
    as_ln_s='cp -p'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
    as_ln_s='ln -s'
  fi
elif ln conf$$.file conf$$ 2>/dev/null; then
  as_ln_s=ln
else
  as_ln_s='cp -pR'
  as_ln_s='cp -p'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rm -f conf$$ conf$$.exe conf$$.file
rmdir conf$$.dir 2>/dev/null

if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
  as_mkdir_p=:
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi

as_test_x='test -x'
as_executable_p=as_fn_executable_p
as_executable_p="test -f"

# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"

# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"


# IFS
# We need space, tab and new line, in precisely that order.
as_nl='
'
IFS=" 	$as_nl"
test -n "$DJDIR" || exec 7<&0 </dev/null
exec 6>&1

# CDPATH.
$as_unset CDPATH


# Name of the host.
# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`

exec 6>&1

#
# Initializations.
#
ac_default_prefix=/usr/local
ac_clean_files=
ac_config_libobj_dir=.
LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}

# Maximum number of lines to put in a shell here document.
# This variable seems obsolete.  It should probably be removed, and
# only ac_max_sed_lines should be used.
: ${ac_max_here_lines=38}

# Identity of this package.
PACKAGE_NAME=
PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
PACKAGE_URL=

ac_unique_file="man2tcl.c"
ac_subst_vars='LTLIBOBJS
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_WIN_VERSION CC TCL_VERSION TCL_PATCH_LEVEL TCL_SRC_DIR TCL_BIN_DIR LIBOBJS LTLIBOBJS'
LIBOBJS
TCL_BIN_DIR
TCL_SRC_DIR
TCL_PATCH_LEVEL
TCL_VERSION
CC
TCL_WIN_VERSION
target_alias
host_alias
build_alias
LIBS
ECHO_T
ECHO_N
ECHO_C
DEFS
mandir
localedir
libdir
psdir
pdfdir
dvidir
htmldir
infodir
docdir
oldincludedir
includedir
localstatedir
sharedstatedir
sysconfdir
datadir
datarootdir
libexecdir
sbindir
bindir
program_transform_name
prefix
exec_prefix
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_tcl
'
      ac_precious_vars='build_alias
host_alias
target_alias'


# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
ac_unrecognized_opts=
ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
exec_prefix=NONE
no_create=
no_recursion=
prefix=NONE
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
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







-



-
+
-



+


-
-
+
-
-
-
-
-
-
-
+


-




-
+




-
-
+
-
-
-



-
+
-
-







x_libraries=NONE

# Installation directory options.
# These are left unexpanded so users can "make install exec_prefix=/foo"
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datarootdir='${prefix}/share'
datadir='${prefix}/share'
datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE}'
infodir='${datarootdir}/info'
infodir='${prefix}/info'
htmldir='${docdir}'
dvidir='${docdir}'
pdfdir='${docdir}'
psdir='${docdir}'
libdir='${exec_prefix}/lib'
localedir='${datarootdir}/locale'
mandir='${datarootdir}/man'
mandir='${prefix}/man'

ac_prev=
ac_dashdash=
for ac_option
do
  # If the previous option needs an argument, assign it.
  if test -n "$ac_prev"; then
    eval $ac_prev=\$ac_option
    eval "$ac_prev=\$ac_option"
    ac_prev=
    continue
  fi

  case $ac_option in
  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
  ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
  *=)   ac_optarg= ;;
  *)    ac_optarg=yes ;;
  esac

  # Accept the important Cygnus configure options, so we can diagnose typos.

  case $ac_dashdash$ac_option in
  case $ac_option in
  --)
    ac_dashdash=yes ;;

  -bindir | --bindir | --bindi | --bind | --bin | --bi)
    ac_prev=bindir ;;
  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
    bindir=$ac_optarg ;;

  -build | --build | --buil | --bui | --bu)
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
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







-
+

-
+
-
-
-
-
+
-
-
-
-
+


-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
+


-
+

-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-

-
+







  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
    cache_file=$ac_optarg ;;

  --config-cache | -C)
    cache_file=config.cache ;;

  -datadir | --datadir | --datadi | --datad)
  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
    ac_prev=datadir ;;
  -datadir=* | --datadir=* | --datadi=* | --datad=*)
  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
    datadir=$ac_optarg ;;

  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
  | --dataroo | --dataro | --datar)
  | --da=*)
    ac_prev=datarootdir ;;
  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
    datarootdir=$ac_optarg ;;
    datadir=$ac_optarg ;;

  -disable-* | --disable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
    ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: $ac_useropt"
    expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid feature name: $ac_feature" >&2
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"enable_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=no ;;

   { (exit 1); exit 1; }; }
  -docdir | --docdir | --docdi | --doc | --do)
    ac_prev=docdir ;;
  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
    docdir=$ac_optarg ;;

    ac_feature=`echo $ac_feature | sed 's/-/_/g'`
  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
    ac_prev=dvidir ;;
  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
    dvidir=$ac_optarg ;;
    eval "enable_$ac_feature=no" ;;

  -enable-* | --enable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
    ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: $ac_useropt"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
    expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid feature name: $ac_feature" >&2
   { (exit 1); exit 1; }; }
    ac_feature=`echo $ac_feature | sed 's/-/_/g'`
    case $ac_option in
      *"
"enable_$ac_useropt"
"*) ;;
      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
      *) ac_optarg=yes ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=\$ac_optarg ;;
    eval "enable_$ac_feature='$ac_optarg'" ;;

  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
  | --exec | --exe | --ex)
    ac_prev=exec_prefix ;;
  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
398
399
400
401
402
403
404






405
406
407
408
409
410
411







-
-
-
-
-
-







    ac_init_help=short ;;

  -host | --host | --hos | --ho)
    ac_prev=host_alias ;;
  -host=* | --host=* | --hos=* | --ho=*)
    host_alias=$ac_optarg ;;

  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
    ac_prev=htmldir ;;
  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
  | --ht=*)
    htmldir=$ac_optarg ;;

  -includedir | --includedir | --includedi | --included | --include \
  | --includ | --inclu | --incl | --inc)
    ac_prev=includedir ;;
  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
  | --includ=* | --inclu=* | --incl=* | --inc=*)
    includedir=$ac_optarg ;;

834
835
836
837
838
839
840
841
842
843
844
845
846
847


848
849
850


851
852
853
854
855
856
857
422
423
424
425
426
427
428





429

430
431
432
433

434
435
436
437
438
439
440
441
442







-
-
-
-
-

-
+
+


-
+
+







  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
  | --libexe | --libex | --libe)
    ac_prev=libexecdir ;;
  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
  | --libexe=* | --libex=* | --libe=*)
    libexecdir=$ac_optarg ;;

  -localedir | --localedir | --localedi | --localed | --locale)
    ac_prev=localedir ;;
  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
    localedir=$ac_optarg ;;

  -localstatedir | --localstatedir | --localstatedi | --localstated \
  | --localstate | --localstat | --localsta | --localst | --locals)
  | --localstate | --localstat | --localsta | --localst \
  | --locals | --local | --loca | --loc | --lo)
    ac_prev=localstatedir ;;
  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
    localstatedir=$ac_optarg ;;

  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
    ac_prev=mandir ;;
  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
    mandir=$ac_optarg ;;

908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
493
494
495
496
497
498
499










500
501
502
503
504
505
506







-
-
-
-
-
-
-
-
-
-







  | --program-transform-n=* | --program-transform-=* \
  | --program-transform=* | --program-transfor=* \
  | --program-transfo=* | --program-transf=* \
  | --program-trans=* | --program-tran=* \
  | --progr-tra=* | --program-tr=* | --program-t=*)
    program_transform_name=$ac_optarg ;;

  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
    ac_prev=pdfdir ;;
  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
    pdfdir=$ac_optarg ;;

  -psdir | --psdir | --psdi | --psd | --ps)
    ac_prev=psdir ;;
  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
    psdir=$ac_optarg ;;

  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil)
    silent=yes ;;

  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
    ac_prev=sbindir ;;
  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
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
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

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
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
611
612
613
614
615
616

617


618






619
620


621
622



623

624

625

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
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







-
+

-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-

-
+


-
+

-
-
+
+
-
-
+
+
-
-
-
+
-
-
-
-
-



















-
-
+
+
+





-
-
-
-
-
+
+
+
+
+




-
+

-
-
+
+







-
+
-
-
+
-
-
-
-
-
-


-
-
+
+
-
-
-

-
+
-

-
+
-
-
+
+

+
+
-
+
+
+
+
+

-
-
+
+
+

-













+
+











-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+

-
+





-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







  -v | -verbose | --verbose | --verbos | --verbo | --verb)
    verbose=yes ;;

  -version | --version | --versio | --versi | --vers | -V)
    ac_init_version=: ;;

  -with-* | --with-*)
    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
    ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid package name: $ac_useropt"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
    expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid package name: $ac_package" >&2
   { (exit 1); exit 1; }; }
    ac_package=`echo $ac_package| sed 's/-/_/g'`
    case $ac_option in
      *"
"with_$ac_useropt"
"*) ;;
      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
      *) ac_optarg=yes ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval with_$ac_useropt=\$ac_optarg ;;
    eval "with_$ac_package='$ac_optarg'" ;;

  -without-* | --without-*)
    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
    ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid package name: $ac_useropt"
    expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid package name: $ac_package" >&2
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
   { (exit 1); exit 1; }; }
    ac_package=`echo $ac_package | sed 's/-/_/g'`
    case $ac_user_opts in
      *"
"with_$ac_useropt"
    eval "with_$ac_package=no" ;;
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval with_$ac_useropt=no ;;

  --x)
    # Obsolete; use --with-x.
    with_x=yes ;;

  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
  | --x-incl | --x-inc | --x-in | --x-i)
    ac_prev=x_includes ;;
  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
    x_includes=$ac_optarg ;;

  -x-libraries | --x-libraries | --x-librarie | --x-librari \
  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
    ac_prev=x_libraries ;;
  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
    x_libraries=$ac_optarg ;;

  -*) as_fn_error $? "unrecognized option: \`$ac_option'
Try \`$0 --help' for more information"
  -*) { echo "$as_me: error: unrecognized option: $ac_option
Try \`$0 --help' for more information." >&2
   { (exit 1); exit 1; }; }
    ;;

  *=*)
    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
    # Reject names that are not valid shell variable names.
    case $ac_envvar in #(
      '' | [0-9]* | *[!_$as_cr_alnum]* )
      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
    esac
    eval $ac_envvar=\$ac_optarg
    expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
   { (exit 1); exit 1; }; }
    ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
    eval "$ac_envvar='$ac_optarg'"
    export $ac_envvar ;;

  *)
    # FIXME: should be removed in autoconf 3.0.
    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
      echo "$as_me: WARNING: invalid host type: $ac_option" >&2
    : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
    ;;

  esac
done

if test -n "$ac_prev"; then
  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
  as_fn_error $? "missing argument to $ac_option"
  { echo "$as_me: error: missing argument to $ac_option" >&2
fi

   { (exit 1); exit 1; }; }
if test -n "$ac_unrecognized_opts"; then
  case $enable_option_checking in
    no) ;;
    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
  esac
fi

# Check all directory arguments for consistency.
for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
# Be sure to have absolute paths.
for ac_var in exec_prefix prefix
		datadir sysconfdir sharedstatedir localstatedir includedir \
		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
		libdir localedir mandir
do
  eval ac_val=\$$ac_var
  eval ac_val=$`echo $ac_var`
  # Remove trailing slashes.
  case $ac_val in
    */ )
    [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
      eval $ac_var=\$ac_val;;
    *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
   { (exit 1); exit 1; }; };;
  esac
done

  # Be sure to have absolute directory names.
# Be sure to have absolute paths.
for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
	      localstatedir libdir includedir oldincludedir infodir mandir
do
  eval ac_val=$`echo $ac_var`
  case $ac_val in
    [\\/$]* | ?:[\\/]* )  continue;;
    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
    [\\/$]* | ?:[\\/]* ) ;;
    *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
   { (exit 1); exit 1; }; };;
  esac
  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done

# There might be people who depend on the old broken behavior: `$host'
# used to hold the argument of --host etc.
# FIXME: To remove some day.
build=$build_alias
host=$host_alias
target=$target_alias

# FIXME: To remove some day.
if test "x$host_alias" != x; then
  if test "x$build_alias" = x; then
    cross_compiling=maybe
    echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
    If a cross compiler is detected then cross compile mode will be used." >&2
  elif test "x$build_alias" != "x$host_alias"; then
    cross_compiling=yes
  fi
fi

ac_tool_prefix=
test -n "$host_alias" && ac_tool_prefix=$host_alias-

test "$silent" = yes && exec 6>/dev/null


ac_pwd=`pwd` && test -n "$ac_pwd" &&
ac_ls_di=`ls -di .` &&
ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
  as_fn_error $? "working directory cannot be determined"
test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
  as_fn_error $? "pwd does not report name of working directory"


# Find the source files, if location was not specified.
if test -z "$srcdir"; then
  ac_srcdir_defaulted=yes
  # Try the directory containing this script, then the parent directory.
  ac_confdir=`$as_dirname -- "$as_myself" ||
$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_myself" : 'X\(//\)[^/]' \| \
	 X"$as_myself" : 'X\(//\)$' \| \
	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_myself" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
  # Try the directory containing this script, then its parent.
  ac_confdir=`(dirname "$0") 2>/dev/null ||
$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$0" : 'X\(//\)[^/]' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X"$0" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
  	  /^X\(\/\/\)$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
  	  /^X\(\/\).*/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  	  s/.*/./; q'`
  srcdir=$ac_confdir
  if test ! -r "$srcdir/$ac_unique_file"; then
  if test ! -r $srcdir/$ac_unique_file; then
    srcdir=..
  fi
else
  ac_srcdir_defaulted=no
fi
if test ! -r "$srcdir/$ac_unique_file"; then
  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
fi
if test ! -r $srcdir/$ac_unique_file; then
  if test "$ac_srcdir_defaulted" = yes; then
    { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
   { (exit 1); exit 1; }; }
  else
    { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
   { (exit 1); exit 1; }; }
  fi
ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
ac_abs_confdir=`(
	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
	pwd)`
# When building in place, set srcdir=.
if test "$ac_abs_confdir" = "$ac_pwd"; then
  srcdir=.
fi
# Remove unnecessary trailing slashes from srcdir.
# Double slashes in file names in object file debugging info
# mess up M-x gdb in Emacs.
case $srcdir in
*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
esac
for ac_var in $ac_precious_vars; do
  eval ac_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_env_${ac_var}_value=\$${ac_var}
  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_cv_env_${ac_var}_value=\$${ac_var}
done
(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
  { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
   { (exit 1); exit 1; }; }
srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
ac_env_build_alias_set=${build_alias+set}
ac_env_build_alias_value=$build_alias
ac_cv_env_build_alias_set=${build_alias+set}
ac_cv_env_build_alias_value=$build_alias
ac_env_host_alias_set=${host_alias+set}
ac_env_host_alias_value=$host_alias
ac_cv_env_host_alias_set=${host_alias+set}
ac_cv_env_host_alias_value=$host_alias
ac_env_target_alias_set=${target_alias+set}
ac_env_target_alias_value=$target_alias
ac_cv_env_target_alias_set=${target_alias+set}
ac_cv_env_target_alias_value=$target_alias

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
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
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
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
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







-
+





+
+
+


-
+

-
+









-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
+
-
-
-
-
-















-

-




+

-
-
-
+


-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
+


-
+

+
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+



-
+


-
-

-
+



-
+

-
+
-
-
-
-
+




-
+




-


















-
+











-
-
+
+
-







Defaults for the options are specified in brackets.

Configuration:
  -h, --help              display this help and exit
      --help=short        display options specific to this package
      --help=recursive    display the short help of all the included packages
  -V, --version           display version information and exit
  -q, --quiet, --silent   do not print \`checking ...' messages
  -q, --quiet, --silent   do not print \`checking...' messages
      --cache-file=FILE   cache test results in FILE [disabled]
  -C, --config-cache      alias for \`--cache-file=config.cache'
  -n, --no-create         do not create output files
      --srcdir=DIR        find the sources in DIR [configure dir or \`..']

_ACEOF

  cat <<_ACEOF
Installation directories:
  --prefix=PREFIX         install architecture-independent files in PREFIX
                          [$ac_default_prefix]
			  [$ac_default_prefix]
  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
                          [PREFIX]
			  [PREFIX]

By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
an installation prefix other than \`$ac_default_prefix' using \`--prefix',
for instance \`--prefix=\$HOME'.

For better control, use the options below.

Fine tuning of the installation directories:
  --bindir=DIR            user executables [EPREFIX/bin]
  --sbindir=DIR           system admin executables [EPREFIX/sbin]
  --libexecdir=DIR        program executables [EPREFIX/libexec]
  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
  --libdir=DIR            object code libraries [EPREFIX/lib]
  --includedir=DIR        C header files [PREFIX/include]
  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
  --bindir=DIR           user executables [EPREFIX/bin]
  --sbindir=DIR          system admin executables [EPREFIX/sbin]
  --libexecdir=DIR       program executables [EPREFIX/libexec]
  --datadir=DIR          read-only architecture-independent data [PREFIX/share]
  --sysconfdir=DIR       read-only single-machine data [PREFIX/etc]
  --sharedstatedir=DIR   modifiable architecture-independent data [PREFIX/com]
  --localstatedir=DIR    modifiable single-machine data [PREFIX/var]
  --libdir=DIR           object code libraries [EPREFIX/lib]
  --includedir=DIR       C header files [PREFIX/include]
  --oldincludedir=DIR    C header files for non-gcc [/usr/include]
  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
  --infodir=DIR           info documentation [DATAROOTDIR/info]
  --infodir=DIR          info documentation [PREFIX/info]
  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
  --mandir=DIR            man documentation [DATAROOTDIR/man]
  --mandir=DIR           man documentation [PREFIX/man]
  --docdir=DIR            documentation root [DATAROOTDIR/doc/PACKAGE]
  --htmldir=DIR           html documentation [DOCDIR]
  --dvidir=DIR            dvi documentation [DOCDIR]
  --pdfdir=DIR            pdf documentation [DOCDIR]
  --psdir=DIR             ps documentation [DOCDIR]
_ACEOF

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then

  cat <<\_ACEOF

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-tcl=DIR          use Tcl $DEF_VER binaries from DIR

Report bugs to the package provider.
_ACEOF
ac_status=$?
fi

if test "$ac_init_help" = "recursive"; then
  # If there are subdirs, report their specific --help.
  ac_popdir=`pwd`
  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
    test -d "$ac_dir" ||
      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
      continue
    test -d $ac_dir || continue
    ac_builddir=.

case "$ac_dir" in
if test "$ac_dir" != .; then
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
  # A "../" for each directory in $ac_dir_suffix.
  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
else
  ac_dir_suffix= ac_top_builddir=
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix
fi

case $srcdir in
  .)  # We are building in place.
  .)  # No --srcdir option.  We are building in place.
    ac_srcdir=.
    if test -z "$ac_top_builddir"; then
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
       ac_top_srcdir=.
    else
       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
    fi ;;
  [\\/]* | ?:[\\/]* )  # Absolute path.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_top_srcdir=$srcdir ;;
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
  *) # Relative path.
    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_builddir$srcdir ;;
esac

# Do not use `cd foo && pwd` to compute absolute paths, because
# the directories may not exist.
case `pwd` in
.) ac_abs_builddir="$ac_dir";;
*)
  case "$ac_dir" in
  .) ac_abs_builddir=`pwd`;;
  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
  *) ac_abs_builddir=`pwd`/"$ac_dir";;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_builddir=${ac_top_builddir}.;;
*)
  case ${ac_top_builddir}. in
  .) ac_abs_top_builddir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_srcdir=$ac_srcdir;;
*)
  case $ac_srcdir in
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
  .) ac_abs_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_srcdir=$ac_top_srcdir;;
*)
  case $ac_top_srcdir in
  .) ac_abs_top_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
  esac;;
esac

    cd "$ac_dir" || { ac_status=$?; continue; }
    # Check for guested configure.
    if test -f "$ac_srcdir/configure.gnu"; then
      echo &&
      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
    elif test -f "$ac_srcdir/configure"; then
      echo &&
      $SHELL "$ac_srcdir/configure" --help=recursive
    cd $ac_dir
    # Check for guested configure; otherwise get Cygnus style configure.
    if test -f $ac_srcdir/configure.gnu; then
      echo
      $SHELL $ac_srcdir/configure.gnu  --help=recursive
    elif test -f $ac_srcdir/configure; then
      echo
      $SHELL $ac_srcdir/configure  --help=recursive
    elif test -f $ac_srcdir/configure.ac ||
	   test -f $ac_srcdir/configure.in; then
      echo
      $ac_configure --help
    else
      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
    fi || ac_status=$?
    cd "$ac_pwd" || { ac_status=$?; break; }
      echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
    fi
    cd $ac_popdir
  done
fi

test -n "$ac_init_help" && exit $ac_status
test -n "$ac_init_help" && exit 0
if $ac_init_version; then
  cat <<\_ACEOF
configure
generated by GNU Autoconf 2.69

Copyright (C) 2012 Free Software Foundation, Inc.
Copyright (C) 2003 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
  exit 0
fi

exec 5>config.log
## ------------------------ ##
## Autoconf initialization. ##
## ------------------------ ##
cat >config.log <<_ACEOF
cat >&5 <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
## Platform. ##
## --------- ##

hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
uname -m = `(uname -m) 2>/dev/null || echo unknown`
uname -r = `(uname -r) 2>/dev/null || echo unknown`
uname -s = `(uname -s) 2>/dev/null || echo unknown`
uname -v = `(uname -v) 2>/dev/null || echo unknown`

/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`

/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
hostinfo               = `(hostinfo) 2>/dev/null               || echo unknown`
/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`

_ASUNAME

as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    $as_echo "PATH: $as_dir"
  done
  echo "PATH: $as_dir"
done
IFS=$as_save_IFS

} >&5

cat >&5 <<_ACEOF


## ----------- ##
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

1439
1440


1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458

1459
1460
1461


1462
1463
1464
1465



1466

1467

1468
1469

1470
1471

1472
1473

1474

1475
1476


1477
1478
1479
1480

1481
1482
1483
1484

1485
1486
1487
1488

1489
1490
1491




1492
1493
1494
1495

1496
1497
1498
1499

1500
1501
1502
1503
1504

1505

1506
1507


1508
1509

1510
1511
1512
1513
1514


1515
1516
1517


1518
1519

1520
1521

1522
1523
1524
1525
1526
1527
1528



1529
1530
1531
1532
1533
1534

1535
1536
1537
1538

1539
1540
1541
1542

1543
1544
1545
1546

1547
1548
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





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
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
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

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
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
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


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
2658
2659
2660
2661

2662
2663

2664
2665
2666
2667
2668

2669
2670
2671


2672
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

2709
2710
2711
2712
2713







2714
2715
2716

2717
2718
2719
2720
2721



2722
2723
2724
2725
2726
2727


2728
2729
2730

2731
2732
2733

2734

2735
2736
2737





2738
2739

2740
2741
2742
2743
2744










































2745
2746

2747
2748




















2749
2750


2751
2752


2753
2754

2755
2756
2757
2758
2759
2760







2761
2762

2763
2764
2765
2766
2767


2768
2769

2770
2771
2772
2773
2774
2775



2776
2777
2778
2779
2780
2781
2782
2783
2784
2785




2786
2787
2788
2789
2790
2791
2792


2793
2794
2795

2796
2797
2798

2799
2800
2801
2802
2803
2804
2805
2806
2807







2808
2809
2810
2811
2812

2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823



2824
2825
2826


2827
2828
2829
2830
2831



2832
2833
2834


2835

2836
2837

2838

2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863

2864
2865
2866
2867
2868
2869
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

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
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


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
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
1439
1440
1441
1442




1443
1444






1445


1446



1447




1448
1449








1450























































1451

1452
1453
1454
1455
1456

1457
1458
1459
1460
1461
1462





1463
1464

1465
1466
1467



1468
1469
1470
1471




1472







1473
1474
1475
1476


1477
1478
1479
1480
1481
1482
1483
1484


1485
1486
1487







1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516




1517
1518
1519


1520


1521



1522








1523





1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535



1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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

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
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
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



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







+










-
-
+
+


-
+

-
+















-
+
+
+




-
-
+
+




-
-
+
+





+
-
+

-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+

-
-
-
+
+
+

+
-
+

-
+
-
-
+


+
-
+

-
+
+



-
+
-
-
-
-
+




+
-
-
-
+
+
+
+



-
+
-
-
-
-
+





+
-
+

-
+
+

-
+



-
-
+
+

-
-
+
+

-
+

-
+




-
-
-
+
+
+






+




+




+




+





-
-
-

-

-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+

-
+
-
-
-
-




-
-
-
-
-
+
+
+
+
+

-
-
+
+



-
-
+
+






-
+
+


-
-
+
+


-
-
+
+


-
-
+
+




-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+





+
-
+




-
+




-
-
-
-
-
+
+
+
+
+

-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+











-
+


-
-
-
+
+
+
+


-
+
-

+
-
+
+


+
-
+
+













-
+
-


















-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
+
+
+
+



-
+


+
-
+

-
+
-
-
+

-

-
+


-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+

-
+
-
-
-
-
-
-

-
-
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
+
+
+
+
+
+




-


+
-
+
-
-
+
-
-
-
+
+







-
+
-


-
-
+
+
-
-
+









-

-
-
-
-
-
-
+
+
+
+
+
+

-
+
-
-
+


-
+


-
-
-
+
-
-
+
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-

-
+
-
-
-

-
-
+
-
-
-
+
-
-
-





-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
+
-
-
-

-
-
-
-
+

-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-





-
+





-
-
-
-
-

+
-
+


-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
+







-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+

+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
+
-
-

-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+

-

-
+





-
-
-
-
-
-
-
-
-
-
+








-
-
-
-
-
-
+
+
+
+
+
+
+
+

+
-
-
+
+

-
-
+
+
+
+
+
+
+
+
+
+

-
+







+
-
+
-
-
+


+
-
-
+
+
-
+

+
+
+

+
+
+

+
-
+
-
-
+

-
+

-

-
-
+
+
-

-
+


-
+
-
-
-
+


-
-
+
+




-
+
-

+
-
+
-


-
-
+
+

-
+


-
-
-
+
-


-
-
+
+
+




-
-
-
-
-
-
-
-
+
+
+


-
+




+
+
+
+




+
+


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+

-
-





+
+
-
-
+
+
+

-
+
-













-
+

+
-
+
-
-
-
-
-



-
-
-
+
+
+
-
-
-
-
-
-

-
-
-

-
+
-
-


-
-
-
-
-
+
+
+
+
+
+
+


-










-
+

-
+
-
-


-
-
+
-
-
-
-
+

+



-
-
+
+


-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-

-


-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
+

-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
-
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
-
-
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
+
-
-
+
-
-
-
+
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
-
-
+
-
-
-
-
+
-
-
+
+
-
-
+
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-


-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
+
+



-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+


-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
+


-
+

+
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+


-
+


-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
-

-
+
+

+

-
+

+

-
-
-




















-
+

-
-
-
-

# Strip out --no-create and --no-recursion so they do not pile up.
# Strip out --silent because we don't want to record it for future runs.
# Also quote any args containing shell meta-characters.
# Make two passes to allow for proper duplicate-argument suppression.
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
ac_sep=
ac_must_keep_next=false
for ac_pass in 1 2
do
  for ac_arg
  do
    case $ac_arg in
    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
    | -silent | --silent | --silen | --sile | --sil)
      continue ;;
    *\'*)
      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
    *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
      ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
    esac
    case $ac_pass in
    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
    1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
    2)
      as_fn_append ac_configure_args1 " '$ac_arg'"
      ac_configure_args1="$ac_configure_args1 '$ac_arg'"
      if test $ac_must_keep_next = true; then
	ac_must_keep_next=false # Got value, back to normal.
      else
	case $ac_arg in
	  *=* | --config-cache | -C | -disable-* | --disable-* \
	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
	  | -with-* | --with-* | -without-* | --without-* | --x)
	    case "$ac_configure_args0 " in
	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
	    esac
	    ;;
	  -* ) ac_must_keep_next=true ;;
	esac
      fi
      as_fn_append ac_configure_args " '$ac_arg'"
      ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
      # Get rid of the leading space.
      ac_sep=" "
      ;;
    esac
  done
done
{ ac_configure_args0=; unset ac_configure_args0;}
{ ac_configure_args1=; unset ac_configure_args1;}
$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }

# When interrupted or exit'd, cleanup temporary files, and complete
# config.log.  We remove comments because anyway the quotes in there
# would cause problems or look ugly.
# WARNING: Use '\'' to represent an apostrophe within the trap.
# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
# WARNING: Be sure not to use single quotes in there, as some shells,
# such as our DU 5.0 friend, will then `close' the trap.
trap 'exit_status=$?
  # Save into config.log some information that might help in debugging.
  {
    echo

    cat <<\_ASBOX
    $as_echo "## ---------------- ##
## ---------------- ##
## Cache variables. ##
## ---------------- ##"
## ---------------- ##
_ASBOX
    echo
    # The following way of writing the cache mishandles newlines in values,
(
  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
    eval ac_val=\$$ac_var
    case $ac_val in #(
    *${as_nl}*)
      case $ac_var in #(
      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done
{
  (set) 2>&1 |
    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
    case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
    *ac_space=\ *)
      sed -n \
	"s/'\''/'\''\\\\'\'''\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
      ;; #(
	"s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
      ;;
    *)
      sed -n \
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
      ;;
    esac |
    esac;
    sort
)
}
    echo

    cat <<\_ASBOX
    $as_echo "## ----------------- ##
## ----------------- ##
## Output variables. ##
## ----------------- ##"
## ----------------- ##
_ASBOX
    echo
    for ac_var in $ac_subst_vars
    do
      eval ac_val=\$$ac_var
      eval ac_val=$`echo $ac_var`
      case $ac_val in
      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      $as_echo "$ac_var='\''$ac_val'\''"
      echo "$ac_var='"'"'$ac_val'"'"'"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      cat <<\_ASBOX
      $as_echo "## ------------------- ##
## File substitutions. ##
## ------------------- ##"
## ------------- ##
## Output files. ##
## ------------- ##
_ASBOX
      echo
      for ac_var in $ac_subst_files
      do
	eval ac_val=\$$ac_var
	eval ac_val=$`echo $ac_var`
	case $ac_val in
	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	$as_echo "$ac_var='\''$ac_val'\''"
	echo "$ac_var='"'"'$ac_val'"'"'"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      cat <<\_ASBOX
      $as_echo "## ----------- ##
## ----------- ##
## confdefs.h. ##
## ----------- ##"
## ----------- ##
_ASBOX
      echo
      cat confdefs.h
      sed "/^$/d" confdefs.h | sort
      echo
    fi
    test "$ac_signal" != 0 &&
      $as_echo "$as_me: caught signal $ac_signal"
    $as_echo "$as_me: exit $exit_status"
      echo "$as_me: caught signal $ac_signal"
    echo "$as_me: exit $exit_status"
  } >&5
  rm -f core *.core core.conftest.* &&
    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
  rm -f core *.core &&
  rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
    exit $exit_status
' 0
     ' 0
for ac_signal in 1 2 13 15; do
  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
  trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
done
ac_signal=0

# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -f -r conftest* confdefs.h

$as_echo "/* confdefs.h */" > confdefs.h
rm -rf conftest* confdefs.h
# AIX cpp loses on an empty file, so make sure it contains at least a newline.
echo >confdefs.h

# Predefined preprocessor variables.

cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
_ACEOF


# Let the site file select an alternate cache file if it wants to.
# Prefer an explicitly selected file to automatically selected ones.
# Prefer explicitly selected file to automatically selected ones.
ac_site_file1=NONE
ac_site_file2=NONE
if test -n "$CONFIG_SITE"; then
if test -z "$CONFIG_SITE"; then
  # We do not want a PATH search for config.site.
  case $CONFIG_SITE in #((
    -*)  ac_site_file1=./$CONFIG_SITE;;
    */*) ac_site_file1=$CONFIG_SITE;;
    *)   ac_site_file1=./$CONFIG_SITE;;
  esac
elif test "x$prefix" != xNONE; then
  ac_site_file1=$prefix/share/config.site
  if test "x$prefix" != xNONE; then
    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
  ac_site_file2=$prefix/etc/config.site
else
  ac_site_file1=$ac_default_prefix/share/config.site
  else
    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
  ac_site_file2=$ac_default_prefix/etc/config.site
fi
for ac_site_file in "$ac_site_file1" "$ac_site_file2"
  fi
fi
for ac_site_file in $CONFIG_SITE; do
do
  test "x$ac_site_file" = xNONE && continue
  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
$as_echo "$as_me: loading site script $ac_site_file" >&6;}
  if test -r "$ac_site_file"; then
    { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
echo "$as_me: loading site script $ac_site_file" >&6;}
    sed 's/^/| /' "$ac_site_file" >&5
    . "$ac_site_file" \
    . "$ac_site_file"
      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "failed to load site script $ac_site_file
See \`config.log' for more details" "$LINENO" 5; }
  fi
done

if test -r "$cache_file"; then
  # Some versions of bash will fail to source /dev/null (special files
  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.
  if test /dev/null != "$cache_file" && test -f "$cache_file"; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
  # Some versions of bash will fail to source /dev/null (special
  # files actually), so we avoid doing that.
  if test -f "$cache_file"; then
    { echo "$as_me:$LINENO: loading cache $cache_file" >&5
echo "$as_me: loading cache $cache_file" >&6;}
    case $cache_file in
      [\\/]* | ?:[\\/]* ) . "$cache_file";;
      *)                      . "./$cache_file";;
      [\\/]* | ?:[\\/]* ) . $cache_file;;
      *)                      . ./$cache_file;;
    esac
  fi
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
  { echo "$as_me:$LINENO: creating cache $cache_file" >&5
echo "$as_me: creating cache $cache_file" >&6;}
  >$cache_file
fi

# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
for ac_var in $ac_precious_vars; do
for ac_var in `(set) 2>&1 |
	       sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
  eval ac_old_set=\$ac_cv_env_${ac_var}_set
  eval ac_new_set=\$ac_env_${ac_var}_set
  eval ac_old_val=\$ac_cv_env_${ac_var}_value
  eval ac_new_val=\$ac_env_${ac_var}_value
  eval ac_old_val="\$ac_cv_env_${ac_var}_value"
  eval ac_new_val="\$ac_env_${ac_var}_value"
  case $ac_old_set,$ac_new_set in
    set,)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
      { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,set)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
      { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,);;
    *)
      if test "x$ac_old_val" != "x$ac_new_val"; then
	# differences in whitespace do not lead to failure.
	ac_old_val_w=`echo x $ac_old_val`
	ac_new_val_w=`echo x $ac_new_val`
	if test "$ac_old_val_w" != "$ac_new_val_w"; then
	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
	{ echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
	  ac_cache_corrupted=:
	else
	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
	  eval $ac_var=\$ac_old_val
	fi
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}
	{ echo "$as_me:$LINENO:   former value:  $ac_old_val" >&5
echo "$as_me:   former value:  $ac_old_val" >&2;}
	{ echo "$as_me:$LINENO:   current value: $ac_new_val" >&5
echo "$as_me:   current value: $ac_new_val" >&2;}
	ac_cache_corrupted=:
      fi;;
  esac
  # Pass precious variables to config.status.
  if test "$ac_new_set" = set; then
    case $ac_new_val in
    *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
      ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
    *) ac_arg=$ac_var=$ac_new_val ;;
    esac
    case " $ac_configure_args " in
      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
      *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
    esac
  fi
done
if $ac_cache_corrupted; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
  { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
echo "$as_me: error: changes in the environment can compromise the build" >&2;}
  { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
   { (exit 1); exit 1; }; }
fi
## -------------------- ##
## Main body of script. ##
## -------------------- ##

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu





















# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

DEF_VER=9.0
DEF_VER=8.5


# Check whether --with-tcl was given.
if test "${with_tcl+set}" = set; then :
  withval=$with_tcl; TCL_BIN_DIR=$withval
# Check whether --with-tcl or --without-tcl was given.
if test "${with_tcl+set}" = set; then
  withval="$with_tcl"
  TCL_BIN_DIR=$withval
else
  TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`
fi
fi;

if test ! -d $TCL_BIN_DIR; then
    { { echo "$as_me:$LINENO: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&5
    as_fn_error $? "Tcl directory $TCL_BIN_DIR doesn't exist" "$LINENO" 5
echo "$as_me: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&2;}
   { (exit 1); exit 1; }; }
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
    { { echo "$as_me:$LINENO: error: There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&5
    as_fn_error $? "There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" "$LINENO" 5
echo "$as_me: error: There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&2;}
   { (exit 1); exit 1; }; }
fi

. $TCL_BIN_DIR/tclConfig.sh

TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

CC=$TCL_CC






ac_config_files="$ac_config_files Makefile tcl.hpj"
                    ac_config_files="$ac_config_files Makefile tcl.hpj"

cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs, see configure's option --config-cache.
# It is not useful on other systems.  If it contains results you don't
# want to keep, you may remove or edit it.
#
# config.status only pays attention to the cache file if you give it
# the --recheck option to rerun configure.
#
# `ac_cv_env_foo' variables (set or unset) will be overridden when
# loading this file, other *unset* `ac_cv_foo' will be assigned the
# following values.

_ACEOF

# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, we kill variables containing newlines.
# So, don't put newlines in cache variables' values.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(
  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
    eval ac_val=\$$ac_var
    case $ac_val in #(
    *${as_nl}*)
      case $ac_var in #(
      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done

{
  (set) 2>&1 |
    case $as_nl`(ac_space=' '; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
      # `set' does not quote correctly, so add quotes: double-quote
      # substitution turns \\\\ into \\, and sed turns \\ into \.
    case `(ac_space=' '; set | grep ac_space) 2>&1` in
    *ac_space=\ *)
      # `set' does not quote correctly, so add quotes (double-quote
      # substitution turns \\\\ into \\, and sed turns \\ into \).
      sed -n \
	"s/'/'\\\\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
      ;; #(
      ;;
    *)
      # `set' quotes correctly as required by POSIX, so do not add quotes.
      sed -n \
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
      ;;
    esac |
    esac;
    sort
) |
} |
  sed '
     /^ac_cv_env_/b end
     t clear
     :clear
     : clear
     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
     t end
     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
     :end' >>confcache
if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
  if test -w "$cache_file"; then
    if test "x$cache_file" != "x/dev/null"; then
     /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
     : end' >>confcache
if diff $cache_file confcache >/dev/null 2>&1; then :; else
  if test -w $cache_file; then
    test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$as_me: updating cache $cache_file" >&6;}
      if test ! -f "$cache_file" || test -h "$cache_file"; then
	cat confcache >"$cache_file"
      else
    cat confcache >$cache_file
  else
        case $cache_file in #(
        */* | ?:*)
	  mv -f confcache "$cache_file"$$ &&
	  mv -f "$cache_file"$$ "$cache_file" ;; #(
        *)
	  mv -f confcache "$cache_file" ;;
	esac
      fi
    fi
  else
    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
    echo "not updating unwritable cache $cache_file"
  fi
fi
rm -f confcache

test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'

# VPATH may cause trouble with some makes, so we remove $(srcdir),
# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
  ac_vpsub='/^[	 ]*VPATH[	 ]*=/{
s/:*\$(srcdir):*/:/;
s/:*\${srcdir}:*/:/;
s/:*@srcdir@:*/:/;
s/^\([^=]*=[	 ]*\):*/\1/;
s/:*$//;
s/^[^=]*=[	 ]*$//;
}'
fi

# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
# take arguments), then branch to the quote section.  Otherwise,
# take arguments), then we branch to the quote section.  Otherwise,
# look for a macro that doesn't take arguments.
ac_script='
cat >confdef2opt.sed <<\_ACEOF
:mline
/\\$/{
 N
 s,\\\n,,
 b mline
}
t clear
:clear
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\)/-D\1=\2/g
: clear
s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\),-D\1=\2,g
t quote
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\)/-D\1=\2/g
s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\),-D\1=\2,g
t quote
b any
:quote
s/[	 `~#$^&*(){}\\|;'\''"<>?]/\\&/g
s/\[/\\&/g
s/\]/\\&/g
s/\$/$$/g
d
: quote
s,[	 `~#$^&*(){}\\|;'"<>?],\\&,g
s,\[,\\&,g
s,\],\\&,g
s,\$,$$,g
H
:any
${
	g
	s/^\n//
	s/\n/ /g
	p
p
}
'
DEFS=`sed -n "$ac_script" confdefs.h`
_ACEOF
# We use echo to avoid assuming a particular line-breaking character.
# The extra dot is to prevent the shell from consuming trailing
# line-breaks from the sub-command output.  A line-break within
# single-quotes doesn't work because, if this script is created in a
# platform that uses two characters for line-breaks (e.g., DOS), tr
# would break.
ac_LF_and_DOT=`echo; echo .`
DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
rm -f confdef2opt.sed


ac_libobjs=
ac_ltlibobjs=
U=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
  # 1. Remove the extension, and $U if already installed.
  ac_i=`echo "$ac_i" |
  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
	 sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
  # 2. Add them.
  #    will be set to the directory where LIBOBJS objects are built.
  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
  ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
  ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs

LTLIBOBJS=$ac_ltlibobjs



: "${CONFIG_STATUS=./config.status}"
: ${CONFIG_STATUS=./config.status}
ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
echo "$as_me: creating $CONFIG_STATUS" >&6;}
as_write_fail=0
cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
cat >$CONFIG_STATUS <<_ACEOF
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
# Compiler output produced by configure, useful for debugging
# configure, is in config.log if it exists.

debug=false
ac_cs_recheck=false
ac_cs_silent=false

SHELL=\${CONFIG_SHELL-$SHELL}
export SHELL
_ASEOF
cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF
## --------------------- ##
## M4sh Initialization.  ##
## --------------------- ##

# Be more Bourne compatible
# Be Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
  *posix*) :
    set -o posix ;; #(
  set -o posix
  *) :
     ;;
esac
fi

DUALCASE=1; export DUALCASE # for MKS sh

as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '
    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi
  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'
fi

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  PATH_SEPARATOR=:
  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
      PATH_SEPARATOR=';'
  }

fi


# Support unset when possible.
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

  as_unset=unset
# Find who we are.  Look in the path if we contain no directory separator.
as_myself=
else
case $0 in #((
  *[\\/]* ) as_myself=$0 ;;
  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
  done
IFS=$as_save_IFS

  as_unset=false
     ;;
esac
# We did not find ourselves, most probably we were run as `sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
  as_myself=$0
fi
if test ! -f "$as_myself"; then

  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# Work around bugs in pre-3.0 UWIN ksh.
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
$as_unset ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

for as_var in \
  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
  LC_TELEPHONE LC_TIME
do
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH


  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
    eval $as_var=C; export $as_var
# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
  else
{
  as_status=$1; test $as_status -eq 0 && as_status=1
    $as_unset $as_var
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error

done

# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# Required to use basename.
# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else
  as_fn_append ()
  {
    eval $1=\$$1\$2
  }
fi # as_fn_append

# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
  as_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith


if expr a : '\(a\)' >/dev/null 2>&1 &&
if expr a : '\(a\)' >/dev/null 2>&1; then
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

# Name of the executable.
as_me=`$as_basename -- "$0" ||
as_me=`$as_basename "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	 X"$0" : 'X\(/\)$' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
  	  /^X\/\(\/\/\)$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
  	  /^X\/\(\/\).*/{ s//\1/; q; }
  	  s/.*/./; q'`


	  s/.*/./; q'`

# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits

ECHO_C= ECHO_N= ECHO_T=
case `echo -n x` in #(((((
# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  echo "#! /bin/sh" >conf$$.sh
-n*)
  case `echo 'xy\c'` in
  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
  xy)  ECHO_C='\c';;
  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
       ECHO_T='	';;
  esac;;
  echo  "exit 0"   >>conf$$.sh
  chmod +x conf$$.sh
  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
    PATH_SEPARATOR=';'
  else
    PATH_SEPARATOR=:
  fi
  rm -f conf$$.sh
fi


  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2"  || {
  # Find who we are.  Look in the path if we contain no path at all
  # relative or not.
  case $0 in
    *[\\/]* ) as_myself=$0 ;;
    *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
done

       ;;
*)
  ECHO_N='-n';;
esac

  esac
  # We did not find ourselves, most probably we were run as `sh COMMAND'
  # in which case we are not to be found in the path.
rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
  if test "x$as_myself" = x; then
  rm -f conf$$.dir/conf$$.file
else
    as_myself=$0
  rm -f conf$$.dir
  mkdir conf$$.dir 2>/dev/null
fi
  fi
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
    # In both cases, we have to default to `cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
  if test ! -f "$as_myself"; then
      as_ln_s='cp -pR'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
    { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
   { (exit 1); exit 1; }; }
  fi
  case $CONFIG_SHELL in
  '')
    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  for as_base in sh bash ksh sh5; do
else
  as_ln_s='cp -pR'
fi
	 case $as_dir in
	 /*)
	   if ("$as_dir/$as_base" -c '
  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then
	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
	     CONFIG_SHELL=$as_dir/$as_base
	     export CONFIG_SHELL
	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}
	   fi;;
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null


# as_fn_mkdir_p
	 esac
       done
done
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

;;
  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(

  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
  # uniformly replaced by the line number.  The first 'sed' inserts a
  # line-number line before each line; the second 'sed' does the real
  # work.  The second script uses 'N' to pair each line-number line
  # with the numbered line, and appends trailing '-' during
  # substitution so that $LINENO is not a special case at line end.
      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *) as_qdir=$as_dir;;
      esac
      as_dirs="'$as_qdir' $as_dirs"
      as_dir=`$as_dirname -- "$as_dir" ||
  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
  # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)
  sed '=' <$as_myself |
    sed '
      N
      s,$,-,
      : loop
      s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
      t loop
      s,-$,,
      s,^['$as_cr_digits']*\n,,
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_dir" |
    ' >$as_me.lineno &&
  chmod +x $as_me.lineno ||
    { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
   { (exit 1); exit 1; }; }

  # Don't try to exec as it changes $[0], causing all sort of problems
  # (the dirname of $[0] is not the place where we might find the
  # original and so on.  Autoconf is especially sensible to this).
  . ./$as_me.lineno
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
  # Exit status is that of the last command.
  exit
}


case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
  *c*,-n*) ECHO_N= ECHO_C='
' ECHO_T='	' ;;
  *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;
  *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;
esac

	  }
	  /^X\(\/\/\)$/{
	    s//\1/
if expr a : '\(a\)' >/dev/null 2>&1; then
  as_expr=expr
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
else
  as_expr=false
fi

	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
rm -f conf$$ conf$$.exe conf$$.file
echo >conf$$.file
if ln -s conf$$.file conf$$ 2>/dev/null; then
  # We could just check for DJGPP; but this test a) works b) is more generic
  # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
  if test -f conf$$.exe; then
    # Don't use ln at all; we don't have any links
    as_ln_s='cp -p'
  else
    as_ln_s='ln -s'
  fi
elif ln conf$$.file conf$$ 2>/dev/null; then
  as_ln_s=ln
else
  as_ln_s='cp -p'
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"

fi
rm -f conf$$ conf$$.exe conf$$.file

} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
  as_mkdir_p=:
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi


# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
as_test_x='test -x'
as_executable_p=as_fn_executable_p
as_executable_p="test -f"

# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"

# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"


exec 6>&1
## ----------------------------------- ##
## Main body of $CONFIG_STATUS script. ##
## ----------------------------------- ##
_ASEOF
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
# IFS
# We need space, tab and new line, in precisely that order.
as_nl='
'
IFS=" 	$as_nl"

# CDPATH.
$as_unset CDPATH

exec 6>&1
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to

# Open the log real soon, to keep \$[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
# values after options handling.  Logging --version etc. is OK.
exec 5>>config.log
{
  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
} >&5
cat >&5 <<_CSEOF

This file was extended by $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was
generated by GNU Autoconf 2.59.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

_CSEOF
on `(hostname || uname -n) 2>/dev/null | sed 1q`
echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
"

echo >&5
_ACEOF

# Files that config.status was made for.
case $ac_config_files in *"
"*) set x $ac_config_files; shift; ac_config_files=$*;;
if test -n "$ac_config_files"; then
  echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
esac
fi

if test -n "$ac_config_headers"; then
  echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
fi

if test -n "$ac_config_links"; then
  echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
fi

if test -n "$ac_config_commands"; then
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
  echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
# Files that config.status was made for.
config_files="$ac_config_files"
fi

_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
\`$as_me' instantiates files and other configuration actions
from templates according to the current configuration.  Unless the files
\`$as_me' instantiates files from templates according to the
current configuration.
and actions are specified as TAGs, all are instantiated by default.

Usage: $0 [OPTION]... [TAG]...
Usage: $0 [OPTIONS] [FILE]...

  -h, --help       print this help, then exit
  -V, --version    print version number and configuration settings, then exit
  -V, --version    print version number, then exit
      --config     print configuration, then exit
  -q, --quiet, --silent
                   do not print progress messages
  -q, --quiet      do not print progress messages
  -d, --debug      don't remove temporary files
      --recheck    update $as_me by reconfiguring in the same conditions
      --file=FILE[:TEMPLATE]
                   instantiate the configuration file FILE
  --file=FILE[:TEMPLATE]
		   instantiate the configuration file FILE

Configuration files:
$config_files

Report bugs to the package provider."
Report bugs to <bug-autoconf@gnu.org>."

_ACEOF

cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
config.status
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"
configured by $0, generated by GNU Autoconf 2.59,
  with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2012 Free Software Foundation, Inc.
Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

ac_pwd='$ac_pwd'
srcdir='$srcdir'
srcdir=$srcdir
test -n "\$AWK" || AWK=awk
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# The default lists apply if the user does not specify any file.
cat >>$CONFIG_STATUS <<\_ACEOF
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.
ac_need_defaults=:
while test $# != 0
do
  case $1 in
  --*=?*)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
    ac_shift=:
    ;;
  --*=)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=
  --*=*)
    ac_option=`expr "x$1" : 'x\([^=]*\)='`
    ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
    ac_shift=:
    ;;
  *)
  -*)
    ac_option=$1
    ac_optarg=$2
    ac_shift=shift
    ;;
  *) # This is not an option, so the user has probably given explicit
     # arguments.
     ac_option=$1
     ac_need_defaults=false;;
  esac

  case $ac_option in
  # Handling of the options.
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
    ac_cs_recheck=: ;;
  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
    $as_echo "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    $as_echo "$ac_cs_config"; exit ;;
  --debug | --debu | --deb | --de | --d | -d )
  --version | --vers* | -V )
    echo "$ac_cs_version"; exit 0 ;;
  --he | --h)
    # Conflict between --help and --header
    { { echo "$as_me:$LINENO: error: ambiguous option: $1
Try \`$0 --help' for more information." >&5
echo "$as_me: error: ambiguous option: $1
Try \`$0 --help' for more information." >&2;}
   { (exit 1); exit 1; }; };;
  --help | --hel | -h )
    echo "$ac_cs_usage"; exit 0 ;;
  --debug | --d* | -d )
    debug=: ;;
  --file | --fil | --fi | --f )
    $ac_shift
    case $ac_optarg in
    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
    '') as_fn_error $? "missing file argument" ;;
    esac
    as_fn_append CONFIG_FILES " '$ac_optarg'"
    CONFIG_FILES="$CONFIG_FILES $ac_optarg"
    ac_need_defaults=false;;
  --header | --heade | --head | --hea )
    $ac_shift
    CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
    ac_need_defaults=false;;
  --he | --h |  --help | --hel | -h )
    $as_echo "$ac_cs_usage"; exit ;;
  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil | --si | --s)
    ac_cs_silent=: ;;

  # This is an error.
  -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
Try \`$0 --help' for more information." >&5
  -*) as_fn_error $? "unrecognized option: \`$1'
Try \`$0 --help' for more information." ;;
echo "$as_me: error: unrecognized option: $1
Try \`$0 --help' for more information." >&2;}
   { (exit 1); exit 1; }; } ;;

  *) as_fn_append ac_config_targets " $1"
  *) ac_config_targets="$ac_config_targets $1" ;;
     ac_need_defaults=false ;;

  esac
  shift
done

ac_configure_extra_args=

if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<_ACEOF
if \$ac_cs_recheck; then
  echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
  exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
  shift
  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
  CONFIG_SHELL='$SHELL'
  export CONFIG_SHELL
  exec "\$@"
fi

_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
exec 5>>config.log
{



  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
  $as_echo "$ac_log"
} >&5

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<\_ACEOF

# Handling of arguments.
for ac_config_target in $ac_config_targets
do
  case $ac_config_target in
    "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
    "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;

  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
  "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
  *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
   { (exit 1); exit 1; }; };;
  esac
done


# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used.  Set only those that are not.
# We use the long form for the default assignment because of an extremely
# bizarre bug on SunOS 4.1.3.
if $ac_need_defaults; then
  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
fi

# Have a temporary directory for convenience.  Make it in the build tree
# simply because there is no reason against having it here, and in addition,
# simply because there is no reason to put it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
# Hook for its removal unless debugging.
# Create a temporary directory, and hook for its removal unless debugging.
# Note that there is a small window in which the directory will not be cleaned:
# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
  tmp= ac_tmp=
  trap 'exit_status=$?
  trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
  : "${ac_tmp:=$tmp}"
  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
' 0
  trap 'as_fn_exit 1' 1 2 13 15
  trap '{ (exit 1); exit 1; }' 1 2 13 15
}

# Create a (secure) tmp directory for tmp files.

{
  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
  test -d "$tmp"
  tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
  test -n "$tmp" && test -d "$tmp"
}  ||
{
  tmp=./conf$$-$RANDOM
  (umask 077 && mkdir "$tmp")
} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
  tmp=./confstat$$-$RANDOM
  (umask 077 && mkdir $tmp)
} ||
ac_tmp=$tmp

{
# Set up the scripts for CONFIG_FILES section.
# No need to generate them if there are no CONFIG_FILES.
# This happens for instance with `./config.status config.h'.
if test -n "$CONFIG_FILES"; then


   echo "$me: cannot create a temporary directory in ." >&2
   { (exit 1); exit 1; }
}
ac_cr=`echo X | tr X '\015'`
# On cygwin, bash can eat \r inside `` if the user requested igncr.
# But we know of no other shell where ac_cr would be empty at this
# point, so we can use a bashism as a fallback.
if test "x$ac_cr" = x; then
  eval ac_cr=\$\'\\r\'
fi
ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
  ac_cs_awk_cr='\\r'
else
  ac_cs_awk_cr=$ac_cr
fi

echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
_ACEOF


{
cat >>$CONFIG_STATUS <<_ACEOF

  echo "cat >conf$$subs.awk <<_ACEOF" &&
  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
  echo "_ACEOF"
} >conf$$subs.sh ||
  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
#
# CONFIG_FILES section.
ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
ac_delim='%!_!# '
for ac_last_try in false false false false false :; do
  . ./conf$$subs.sh ||
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
#

  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
  if test $ac_delim_n = $ac_delim_num; then
# No need to generate the scripts if there are no CONFIG_FILES.
# This happens for instance when ./config.status config.h
    break
  elif $ac_last_try; then
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
  else
    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
  fi
if test -n "\$CONFIG_FILES"; then
  # Protect against being on the right side of a sed subst in config.status.
  sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
   s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
s,@SHELL@,$SHELL,;t t
s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
s,@exec_prefix@,$exec_prefix,;t t
s,@prefix@,$prefix,;t t
done
rm -f conf$$subs.sh

cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
s,@program_transform_name@,$program_transform_name,;t t
s,@bindir@,$bindir,;t t
s,@sbindir@,$sbindir,;t t
s,@libexecdir@,$libexecdir,;t t
s,@datadir@,$datadir,;t t
s,@sysconfdir@,$sysconfdir,;t t
s,@sharedstatedir@,$sharedstatedir,;t t
s,@localstatedir@,$localstatedir,;t t
s,@libdir@,$libdir,;t t
s,@includedir@,$includedir,;t t
_ACEOF
sed -n '
s,@oldincludedir@,$oldincludedir,;t t
s,@infodir@,$infodir,;t t
h
s/^/S["/; s/!.*/"]=/
s,@mandir@,$mandir,;t t
s,@build_alias@,$build_alias,;t t
p
g
s/^[^!]*!//
s,@host_alias@,$host_alias,;t t
s,@target_alias@,$target_alias,;t t
s,@DEFS@,$DEFS,;t t
:repl
t repl
s/'"$ac_delim"'$//
t delim
s,@ECHO_C@,$ECHO_C,;t t
s,@ECHO_N@,$ECHO_N,;t t
s,@ECHO_T@,$ECHO_T,;t t
s,@LIBS@,$LIBS,;t t
:nl
h
s/\(.\{148\}\)..*/\1/
t more1
s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t
s,@CC@,$CC,;t t
s,@TCL_VERSION@,$TCL_VERSION,;t t
s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t
p
n
b repl
:more1
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t nl
s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
:delim
h
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
CEOF

s/\(.\{148\}\)..*/\1/
t more2
s/["\\]/\\&/g; s/^/"/; s/$/"/
p
_ACEOF

b
:more2
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
p
g
s/.\{148\}//
t delim
' <conf$$subs.awk | sed '
/^[^""]/{
  N
  s/\n//
}
' >>$CONFIG_STATUS || ac_write_fail=1
rm -f conf$$subs.awk
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
  cat >>$CONFIG_STATUS <<\_ACEOF
_ACAWK
cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
  for (key in S) S_is_set[key] = 1
  # Split the substitutions into bite-sized pieces for seds with
  # small command number limits, like on Digital OSF/1 and HP-UX.
  ac_max_sed_lines=48
  ac_sed_frag=1 # Number of current file.
  ac_beg=1 # First line for current file.
  FS = ""

  ac_end=$ac_max_sed_lines # Line after last line for current file.
}
{
  line = $ 0
  ac_more_lines=:
  nfields = split(line, field, "@")
  substed = 0
  ac_sed_cmds=
  len = length(field[1])
  for (i = 2; i < nfields; i++) {
  while $ac_more_lines; do
    key = field[i]
    keylen = length(key)
    if (S_is_set[key]) {
    if test $ac_beg -gt 1; then
      value = S[key]
      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
      len += length(value) + length(field[++i])
      substed = 1
    } else
      len += 1 + keylen
      sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
    else
      sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
    fi
    if test ! -s $tmp/subs.frag; then
      ac_more_lines=false
    else
  }

  print line
      # The purpose of the label and of the branching condition is to
      # speed up the sed processing (if there are no `@' at all, there
      # is no need to browse any of the substitutions).
      # These are the two extra sed commands mentioned above.
      (echo ':t
}

  /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
_ACAWK
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
      if test -z "$ac_sed_cmds"; then
  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
else
	ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
      else
  cat
fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
	ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF

      fi
      ac_sed_frag=`expr $ac_sed_frag + 1`
      ac_beg=$ac_end
      ac_end=`expr $ac_end + $ac_max_sed_lines`
# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{
    fi
  done
  if test -z "$ac_sed_cmds"; then
    ac_sed_cmds=cat
h
s///
s/^/:/
s/[	 ]*$/:/
s/:\$(srcdir):/:/g
s/:\${srcdir}:/:/g
s/:@srcdir@:/:/g
s/^:*//
s/:*$//
x
s/\(=[	 ]*\).*/\1/
G
s/\n//
s/^[^=]*=[	 ]*$//
}'
fi
  fi

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
fi # test -n "$CONFIG_FILES"


eval set X "  :F $CONFIG_FILES      "
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
shift
for ac_tag
for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
do
  case $ac_tag in
  :[FHLC]) ac_mode=$ac_tag; continue;;
  esac
  case $ac_mode$ac_tag in
  :[FHL]*:*);;
  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
  :[FH]-) ac_tag=-:-;;
  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
  esac
  ac_save_IFS=$IFS
  IFS=:
  set x $ac_tag
  IFS=$ac_save_IFS
  shift
  ac_file=$1
  shift

  case $ac_mode in
  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
  case $ac_file in
  :L) ac_source=$1;;
  :[FH])
    ac_file_inputs=
  - | *:- | *:-:* ) # input from stdin
    for ac_f
    do
      case $ac_f in
      -) ac_f="$ac_tmp/stdin";;
	cat >$tmp/stdin
      *) # Look for the file first in the build tree, then in the source tree
	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
	 # because $ac_f cannot contain `:'.
	 test -f "$ac_f" ||
	   case $ac_f in
	   [\\/$]*) false;;
	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
	   esac ||
	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
      esac
      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
      as_fn_append ac_file_inputs " '$ac_f'"
	ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
    done

	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
    # Let's still pretend it is `configure' which instantiates (i.e., don't
    # use $as_me), people would be surprised to read:
    #    /* config.h.  Generated by config.status.  */
    configure_input='Generated from '`
	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
  *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
	`' by configure.'
    if test x"$ac_file" != x-; then
      configure_input="$ac_file.  $configure_input"
	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
  * )   ac_file_in=$ac_file.in ;;
      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
$as_echo "$as_me: creating $ac_file" >&6;}
    fi
    # Neutralize special characters interpreted by sed in replacement strings.
    case $configure_input in #(
    *\&* | *\|* | *\\* )
       ac_sed_conf_input=`$as_echo "$configure_input" |
       sed 's/[\\\\&|]/\\\\&/g'`;; #(
    *) ac_sed_conf_input=$configure_input;;
    esac
  esac

    case $ac_tag in
    *:-:* | *:-) cat >"$ac_tmp/stdin" \
      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
    esac
    ;;
  esac

  ac_dir=`$as_dirname -- "$ac_file" ||
  # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
  ac_dir=`(dirname "$ac_file") 2>/dev/null ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$ac_file" : 'X\(//\)[^/]' \| \
	 X"$ac_file" : 'X\(//\)$' \| \
	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	 X"$ac_file" : 'X\(/\)' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
  	  /^X\(\/\/\)$/{ s//\1/; q; }
  	  /^X\(\/\).*/{ s//\1/; q; }
  	  s/.*/./; q'`
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
  { if $as_mkdir_p; then
    mkdir -p "$ac_dir"
  else
    as_dir="$ac_dir"
    as_dirs=
    while test ! -d "$as_dir"; do
      as_dirs="$as_dir $as_dirs"
      as_dir=`(dirname "$as_dir") 2>/dev/null ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
  	  /^X\(\/\/\)$/{ s//\1/; q; }
	    q
	  }
	  /^X\(\/\).*/{
  	  /^X\(\/\).*/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  as_dir="$ac_dir"; as_fn_mkdir_p
  	  s/.*/./; q'`
    done
    test ! -n "$as_dirs" || mkdir $as_dirs
  fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
   { (exit 1); exit 1; }; }; }

  ac_builddir=.

case "$ac_dir" in
if test "$ac_dir" != .; then
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
  # A "../" for each directory in $ac_dir_suffix.
  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
else
  ac_dir_suffix= ac_top_builddir=
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix
fi

case $srcdir in
  .)  # We are building in place.
  .)  # No --srcdir option.  We are building in place.
    ac_srcdir=.
    if test -z "$ac_top_builddir"; then
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
       ac_top_srcdir=.
    else
       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
    fi ;;
  [\\/]* | ?:[\\/]* )  # Absolute path.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_top_srcdir=$srcdir ;;
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
  *) # Relative path.
    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_builddir$srcdir ;;
esac

# Do not use `cd foo && pwd` to compute absolute paths, because
# the directories may not exist.
case `pwd` in
.) ac_abs_builddir="$ac_dir";;
*)
  case "$ac_dir" in
  .) ac_abs_builddir=`pwd`;;
  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
  *) ac_abs_builddir=`pwd`/"$ac_dir";;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_builddir=${ac_top_builddir}.;;
*)
  case ${ac_top_builddir}. in
  .) ac_abs_top_builddir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_srcdir=$ac_srcdir;;
*)
  case $ac_srcdir in
  .) ac_abs_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_srcdir=$ac_top_srcdir;;
*)
  case $ac_top_srcdir in
  .) ac_abs_top_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
  esac;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix



  if test x"$ac_file" != x-; then
    { echo "$as_me:$LINENO: creating $ac_file" >&5
echo "$as_me: creating $ac_file" >&6;}
    rm -f "$ac_file"
  fi
  # Let's still pretend it is `configure' which instantiates (i.e., don't
  # use $as_me), people would be surprised to read:
  #    /* config.h.  Generated by config.status.  */
  if test x"$ac_file" = x-; then
    configure_input=
  else
    configure_input="$ac_file.  "
  fi
  configure_input=$configure_input"Generated from `echo $ac_file_in |
				     sed 's,.*/,,'` by configure."

  # First look for the input files in the build tree, otherwise in the
  # src tree.
  ac_file_inputs=`IFS=:
    for f in $ac_file_in; do
  case $ac_mode in
  :F)
      case $f in
      -) echo $tmp/stdin ;;
  #
  # CONFIG_FILE
      [\\/$]*)
	 # Absolute (can't be DOS-style, as IFS=:)
  #

	 test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# If the template does not know about datarootdir, expand it.
# FIXME: This hack should be removed a few years after 2.60.
ac_datarootdir_hack=; ac_datarootdir_seen=
echo "$as_me: error: cannot find input file: $f" >&2;}
   { (exit 1); exit 1; }; }
	 echo "$f";;
      *) # Relative
	 if test -f "$f"; then
	   # Build tree
	   echo "$f"
ac_sed_dataroot='
/datarootdir/ {
	 elif test -f "$srcdir/$f"; then
  p
  q
}
/@datadir@/p
/@docdir@/p
	   # Source tree
	   echo "$srcdir/$f"
/@infodir@/p
/@localedir@/p
	 else
/@mandir@/p'
case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
*datarootdir*) ac_datarootdir_seen=yes;;
*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
	   # /dev/null tree
	   { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
echo "$as_me: error: cannot find input file: $f" >&2;}
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
  ac_datarootdir_hack='
  s&@datadir@&$datadir&g
  s&@docdir@&$docdir&g
  s&@infodir@&$infodir&g
  s&@localedir@&$localedir&g
  s&@mandir@&$mandir&g
  s&\\\${datarootdir}&$datarootdir&g' ;;
esac
   { (exit 1); exit 1; }; }
	 fi;;
      esac
    done` || { (exit 1); exit 1; }
_ACEOF

# Neutralize VPATH when `$srcdir' = `.'.
# Shell code in configure.ac might set extrasub.
# FIXME: do we really want to maintain this feature?
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_sed_extra="$ac_vpsub
cat >>$CONFIG_STATUS <<_ACEOF
  sed "$ac_vpsub
$extrasub
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<\_ACEOF
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
s|@configure_input@|$ac_sed_conf_input|;t t
s,@configure_input@,$configure_input,;t t
s&@top_builddir@&$ac_top_builddir_sub&;t t
s&@top_build_prefix@&$ac_top_build_prefix&;t t
s&@srcdir@&$ac_srcdir&;t t
s&@abs_srcdir@&$ac_abs_srcdir&;t t
s&@top_srcdir@&$ac_top_srcdir&;t t
s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
s&@builddir@&$ac_builddir&;t t
s&@abs_builddir@&$ac_abs_builddir&;t t
s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
s,@srcdir@,$ac_srcdir,;t t
s,@abs_srcdir@,$ac_abs_srcdir,;t t
s,@top_srcdir@,$ac_top_srcdir,;t t
s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
s,@builddir@,$ac_builddir,;t t
s,@abs_builddir@,$ac_abs_builddir,;t t
s,@top_builddir@,$ac_top_builddir,;t t
$ac_datarootdir_hack
"
eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5

s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \
      "$ac_tmp/out"`; test -z "$ac_out"; } &&
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined.  Please make sure it is defined" >&5
$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined.  Please make sure it is defined" >&2;}

  rm -f "$ac_tmp/stdin"
  case $ac_file in
" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
  rm -f $tmp/stdin
  if test x"$ac_file" != x-; then
  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
  esac \
    mv $tmp/out $ac_file
  else
  || as_fn_error $? "could not create $ac_file" "$LINENO" 5
 ;;



    cat $tmp/out
    rm -f $tmp/out
  fi
  esac

done # for ac_tag
done
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF

as_fn_exit 0
{ (exit 0); exit 0; }
_ACEOF
chmod +x $CONFIG_STATUS
ac_clean_files=$ac_clean_files_save

test $ac_write_fail = 0 ||
  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5


# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
# Unfortunately, on DOS this fails, as config.log is still kept open
# by configure, so config.status won't be able to write to it; its
# output is simply discarded.  So we exec the FD to /dev/null,
# effectively closing config.log, so it can be properly (re)opened and
# appended to by config.status.  When coming back to configure, we
# need to make the FD available again.
if test "$no_create" != yes; then
  ac_cs_success=:
  ac_config_status_args=
  test "$silent" = yes &&
    ac_config_status_args="$ac_config_status_args --quiet"
  exec 5>/dev/null
  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
  exec 5>>config.log
  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
  # would make configure fail if this is the last instruction.
  $ac_cs_success || as_fn_exit 1
  $ac_cs_success || { (exit 1); exit 1; }
fi
if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi

Deleted tools/configure.ac.

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



































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run to configure the
dnl	Makefile in this directory.
AC_INIT(man2tcl.c)
AC_PREREQ(2.69)

# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

DEF_VER=9.0

AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
    AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
fi

. $TCL_BIN_DIR/tclConfig.sh

TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
AC_SUBST(TCL_WIN_VERSION)
CC=$TCL_CC
AC_SUBST(CC)
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)

AC_OUTPUT(Makefile tcl.hpj)

Added tools/configure.in.





































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run to configure the
dnl	Makefile in this directory.
AC_INIT
AC_CONFIG_SRCDIR([man2tcl.c])
AC_PREREQ([2.59])

# Recover information that Tcl computed with its configure script.

#--------------------------------------------------------------------
#       See if there was a command-line option for where Tcl is;  if
#       not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------

DEF_VER=8.5

AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
    AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR doesn't exist)
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
    AC_MSG_ERROR(There's no tclConfig.sh in $TCL_BIN_DIR;  perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
fi

. $TCL_BIN_DIR/tclConfig.sh

TCL_WIN_VERSION=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
AC_SUBST(TCL_WIN_VERSION)
CC=$TCL_CC
AC_SUBST(CC)
AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)

AC_OUTPUT(Makefile tcl.hpj)

Changes to tools/encoding/big5.txt.

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




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
-
-
-
-
+
+
+
+
-

-
-
-
-
-
-
-


-
+

-
+
-
-

-
+

-
-
-
-
-
+
-
-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+







# big5.txt --
#
#	BIG5 to Unicode table (modified)
#
# BIG5.TXT
# Date: 2015-12-02 23:52:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
# 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.
#
# NOTE: this table has been modified to include the 7-bit ASCII
# characters that are allowed in BIG5 files.
#
#
#	Name:             BIG5 to Unicode table (complete)
#	Unicode version:  1.1
#	Table version:    0.0d3
#	Table version:    2.0
#	Table format:     Format A
#	Date:             11 February 1994
#	Date:             2011 October 14 (header updated: 2015 December 02)
#	Authors:          Glenn Adams <glenn@metis.com>
#                     John H. Jenkins <John_Jenkins@taligent.com>
#
#	Copyright (c) 1991-1994 Unicode, Inc.  All Rights reserved.
#	General notes:
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on magnetic media by Unicode, Inc., the sole
# NOTE: this table has been modified to include the 7-bit ASCII
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
# characters that are allowed in BIG5 files.
#
#	Recipient is granted the right to make copies in any form for
#	internal distribution and to freely use the information supplied
#	in the creation of products supporting Unicode.  Unicode, Inc.
#	specifically excludes the right to re-distribute this file directly
#	to third parties or other organizations whether for profit or not.
#
#	General notes:
#
#	This table contains the data Metis and Taligent currently have on how
#       BIG5 characters map into Unicode.
# This table contains one set of mappings from BIG5 into Unicode.
# Note that these data are *possible* mappings only and may not be the
# same as those used by actual products, nor may they be the best suited
# for all uses.  For more information on the mappings between various code
# pages incorporating the repertoire of BIG5 and Unicode, consult the
# VENDORS mapping data.
#
#	WARNING!  It is currently impossible to provide round-trip compatibility
#		between BIG5 and Unicode.
#
#	A number of characters are not currently mapped because
#		of conflicts with other mappings.  They are as follows:
#
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
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







-
-
-
+
+
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-





-
-
-
-
-
-
-
+
+
+
+
+
+
+



+
+
+
+
+
+
+
+
-
+
+

+
+
+
+
+







#		It is also possible to map these characters to their duplicates, or to
#		the user zone.
#
#	Notes:
#
#	1. In addition to the above, there is some uncertainty about the
#       mappings in the range C6A1 - C8FE, and F9DD - F9FE.  The ETEN
#		version of BIG5 organizes the former range differently, and adds
#		additional characters in the latter range.  The correct mappings
#		these ranges need to be determined.
#	version of BIG5 organizes the former range differently, and adds
#	additional characters in the latter range.  The correct mappings
#	these ranges need to be determined.
#
#	2.  There is an uncertainty in the mapping of the Big Five character
#		0xA3BC.  This character occurs within the Big Five block of tone marks
#		for bopomofo and is intended to be the tone mark for the first tone in
#		Mandarin Chinese.  We have selected the mapping U+02C9 MODIFIER LETTER
#		MACRON (Mandarin Chinese first tone) to reflect this semantic.
#		However, because bopomofo uses the absense of a tone mark to indicate
#		the first Mandarin tone, most implementations of Big Five represent
#		this character with a blank space, and so a mapping such as U+2003 EM SPACE
#		might be preferred.
#	0xA3BC.  This character occurs within the Big Five block of tone marks
#	for bopomofo and is intended to be the tone mark for the first tone in
#	Mandarin Chinese.  We have selected the mapping U+02C9 MODIFIER LETTER
#	MACRON (Mandarin Chinese first tone) to reflect this semantic.
#	However, because bopomofo uses the absense of a tone mark to indicate
#	the first Mandarin tone, most implementations of Big Five represent
#	this character with a blank space, and so a mapping such as U+2003 EM
#	SPACE might be preferred.
#
#
#
#	Format:  Three tab-separated columns
#		 Column #1 is the BIG5 code (in hex as 0xXXXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3  is the Unicode name (follows a comment sign, '#')
#					The official names for Unicode characters U+4E00
#					to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#					where XXXX is the code point.  Including all these
#					names in this file increases its size substantially
#					and needlessly.  The token "<CJK>" is used for the
#					name of these characters.  If necessary, it can be
#					expanded algorithmically by a parser or editor.
#			The official names for Unicode characters U+4E00
#			to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#			where XXXX is the code point.  Including all these
#			names in this file increases its size substantially
#			and needlessly.  The token "<CJK>" is used for the
#			name of these characters.  If necessary, it can be
#			expanded algorithmically by a parser or editor.
#
#	The entries are in BIG5 order
#
#  Revision History:
#
#    [v2.0, 2015 December 02]
#    updates to copyright notice and terms of use
#    no changes to character mappings
#
#    [v1.0, 2011 October 14]
#    Updated terms of use to current wording.
#	Any comments or problems, contact <John_Jenkins@taligent.com>
#    Updated contact information.
#    No changes to the mapping data.
#
#    [v0.0d3, 11 February 1994]
#    First release.
#
#  Use the Unicode reporting form <http://www.unicode.org/reporting.html>
#    for any questions or comments or to report errors in the data.
#
0x20	0x0020	# SPACE
0x21	0x0021	# EXCLAMATION MARK
0x22	0x0022	# QUOTATION MARK
0x23	0x0023	# NUMBER SIGN
0x24	0x0024	# DOLLAR SIGN
0x25	0x0025	# PERCENT SIGN

Added tools/encoding/cns11643.txt.

more than 10,000 changes

Changes to tools/encoding/cp1250.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1250 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1250 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1251.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1251 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1251 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1252.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1252 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1252 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1253.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1253 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1253 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1254.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1254 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1254 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1255.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1255 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          1/7/2000
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1255 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1256.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1256 to Unicode table
#    Unicode version: 2.1
#    Table version: 2.01
#    Table format:  Format A
#    Date:          01/5/99
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1256 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1257.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1257 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1257 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp1258.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp1258 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp1258 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp874.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp874 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          02/28/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp874 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp932.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp932 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          04/15/98
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp932 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp936.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp936 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          1/7/2000
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp936 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp949.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp949 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          1/7/2000
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp949 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/cp950.txt.

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
1
2
3
4
5
6
7

8
9
10
11
12
13
14
15







-
+







#
#    Name:     cp950 to Unicode table
#    Unicode version: 2.0
#    Table version: 2.01
#    Table format:  Format A
#    Date:          1/7/2000
#
#    Contact:       cpxlate@microsoft.com
#    Contact:       Shawn.Steele@microsoft.com
#
#    General notes: none
#
#    Format: Three tab-separated columns
#        Column #1 is the cp950 code (in hex)
#        Column #2 is the Unicode (in hex as 0xXXXX)
#        Column #3 is the Unicode name (follows a comment sign, '#')

Changes to tools/encoding/gb2312.txt.

1
2
3
4
5

6
7
8
9
10
11
12
1
2
3
4

5
6
7
8
9
10
11
12




-
+







# gb2312.txt --
#
#	GB2312 to Unicode table (modified)
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# NOTE: this table has been modified to include the 7-bit ASCII
# characters that are allowed in GB2312 files.
#

Changes to tools/encoding/iso8859-1.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
+
+
+
+


-
+

-
-
+
+
-







# 8859-1.TXT
# Date: 2015-12-02 20:19:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-1:1998 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-1:1998 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-1 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-1 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#   1.0 version: updates 0.1 version by adding mappings for all
#       control characters.
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-10.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















-
+
+
+


-
+

-
-
+
+
-







# 8859-10.TXT
# Date: 2015-12-02 21:53:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-10:1998 to Unicode
#	Unicode version:  3.0
#	Table version:    1.1
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 October 11
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 October 11 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-10:1998 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-10 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-10 order.
#
#	Version history
#	1.0 version new.
#       1.1 corrected mistake in mapping of 0xA4
#   1.1 corrected mistake in mapping of 0xA4
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Added tools/encoding/iso8859-11.txt.































































































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# 8859-11.TXT
# Date: 2015-12-02 21:55:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-11:2001 to Unicode
#	Unicode version:  3.2
#	Table version:    2.0
#	Table format:     Format A
#	Date:             2002 October 7 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-11:2001 characters map into Unicode.
#
#	ISO/IEC 8859-11:2001 is equivalent to TIS 620-2533 (1990) with
#	the addition of 0xA0 NO-BREAK SPACE.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-11 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-11 order.
#
#	Version history:
#		2002 October 7  Created
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY
0x06	0x0006	#	ACKNOWLEDGE
0x07	0x0007	#	BELL
0x08	0x0008	#	BACKSPACE
0x09	0x0009	#	HORIZONTAL TABULATION
0x0A	0x000A	#	LINE FEED
0x0B	0x000B	#	VERTICAL TABULATION
0x0C	0x000C	#	FORM FEED
0x0D	0x000D	#	CARRIAGE RETURN
0x0E	0x000E	#	SHIFT OUT
0x0F	0x000F	#	SHIFT IN
0x10	0x0010	#	DATA LINK ESCAPE
0x11	0x0011	#	DEVICE CONTROL ONE
0x12	0x0012	#	DEVICE CONTROL TWO
0x13	0x0013	#	DEVICE CONTROL THREE
0x14	0x0014	#	DEVICE CONTROL FOUR
0x15	0x0015	#	NEGATIVE ACKNOWLEDGE
0x16	0x0016	#	SYNCHRONOUS IDLE
0x17	0x0017	#	END OF TRANSMISSION BLOCK
0x18	0x0018	#	CANCEL
0x19	0x0019	#	END OF MEDIUM
0x1A	0x001A	#	SUBSTITUTE
0x1B	0x001B	#	ESCAPE
0x1C	0x001C	#	FILE SEPARATOR
0x1D	0x001D	#	GROUP SEPARATOR
0x1E	0x001E	#	RECORD SEPARATOR
0x1F	0x001F	#	UNIT SEPARATOR
0x20	0x0020	#	SPACE
0x21	0x0021	#	EXCLAMATION MARK
0x22	0x0022	#	QUOTATION MARK
0x23	0x0023	#	NUMBER SIGN
0x24	0x0024	#	DOLLAR SIGN
0x25	0x0025	#	PERCENT SIGN
0x26	0x0026	#	AMPERSAND
0x27	0x0027	#	APOSTROPHE
0x28	0x0028	#	LEFT PARENTHESIS
0x29	0x0029	#	RIGHT PARENTHESIS
0x2A	0x002A	#	ASTERISK
0x2B	0x002B	#	PLUS SIGN
0x2C	0x002C	#	COMMA
0x2D	0x002D	#	HYPHEN-MINUS
0x2E	0x002E	#	FULL STOP
0x2F	0x002F	#	SOLIDUS
0x30	0x0030	#	DIGIT ZERO
0x31	0x0031	#	DIGIT ONE
0x32	0x0032	#	DIGIT TWO
0x33	0x0033	#	DIGIT THREE
0x34	0x0034	#	DIGIT FOUR
0x35	0x0035	#	DIGIT FIVE
0x36	0x0036	#	DIGIT SIX
0x37	0x0037	#	DIGIT SEVEN
0x38	0x0038	#	DIGIT EIGHT
0x39	0x0039	#	DIGIT NINE
0x3A	0x003A	#	COLON
0x3B	0x003B	#	SEMICOLON
0x3C	0x003C	#	LESS-THAN SIGN
0x3D	0x003D	#	EQUALS SIGN
0x3E	0x003E	#	GREATER-THAN SIGN
0x3F	0x003F	#	QUESTION MARK
0x40	0x0040	#	COMMERCIAL AT
0x41	0x0041	#	LATIN CAPITAL LETTER A
0x42	0x0042	#	LATIN CAPITAL LETTER B
0x43	0x0043	#	LATIN CAPITAL LETTER C
0x44	0x0044	#	LATIN CAPITAL LETTER D
0x45	0x0045	#	LATIN CAPITAL LETTER E
0x46	0x0046	#	LATIN CAPITAL LETTER F
0x47	0x0047	#	LATIN CAPITAL LETTER G
0x48	0x0048	#	LATIN CAPITAL LETTER H
0x49	0x0049	#	LATIN CAPITAL LETTER I
0x4A	0x004A	#	LATIN CAPITAL LETTER J
0x4B	0x004B	#	LATIN CAPITAL LETTER K
0x4C	0x004C	#	LATIN CAPITAL LETTER L
0x4D	0x004D	#	LATIN CAPITAL LETTER M
0x4E	0x004E	#	LATIN CAPITAL LETTER N
0x4F	0x004F	#	LATIN CAPITAL LETTER O
0x50	0x0050	#	LATIN CAPITAL LETTER P
0x51	0x0051	#	LATIN CAPITAL LETTER Q
0x52	0x0052	#	LATIN CAPITAL LETTER R
0x53	0x0053	#	LATIN CAPITAL LETTER S
0x54	0x0054	#	LATIN CAPITAL LETTER T
0x55	0x0055	#	LATIN CAPITAL LETTER U
0x56	0x0056	#	LATIN CAPITAL LETTER V
0x57	0x0057	#	LATIN CAPITAL LETTER W
0x58	0x0058	#	LATIN CAPITAL LETTER X
0x59	0x0059	#	LATIN CAPITAL LETTER Y
0x5A	0x005A	#	LATIN CAPITAL LETTER Z
0x5B	0x005B	#	LEFT SQUARE BRACKET
0x5C	0x005C	#	REVERSE SOLIDUS
0x5D	0x005D	#	RIGHT SQUARE BRACKET
0x5E	0x005E	#	CIRCUMFLEX ACCENT
0x5F	0x005F	#	LOW LINE
0x60	0x0060	#	GRAVE ACCENT
0x61	0x0061	#	LATIN SMALL LETTER A
0x62	0x0062	#	LATIN SMALL LETTER B
0x63	0x0063	#	LATIN SMALL LETTER C
0x64	0x0064	#	LATIN SMALL LETTER D
0x65	0x0065	#	LATIN SMALL LETTER E
0x66	0x0066	#	LATIN SMALL LETTER F
0x67	0x0067	#	LATIN SMALL LETTER G
0x68	0x0068	#	LATIN SMALL LETTER H
0x69	0x0069	#	LATIN SMALL LETTER I
0x6A	0x006A	#	LATIN SMALL LETTER J
0x6B	0x006B	#	LATIN SMALL LETTER K
0x6C	0x006C	#	LATIN SMALL LETTER L
0x6D	0x006D	#	LATIN SMALL LETTER M
0x6E	0x006E	#	LATIN SMALL LETTER N
0x6F	0x006F	#	LATIN SMALL LETTER O
0x70	0x0070	#	LATIN SMALL LETTER P
0x71	0x0071	#	LATIN SMALL LETTER Q
0x72	0x0072	#	LATIN SMALL LETTER R
0x73	0x0073	#	LATIN SMALL LETTER S
0x74	0x0074	#	LATIN SMALL LETTER T
0x75	0x0075	#	LATIN SMALL LETTER U
0x76	0x0076	#	LATIN SMALL LETTER V
0x77	0x0077	#	LATIN SMALL LETTER W
0x78	0x0078	#	LATIN SMALL LETTER X
0x79	0x0079	#	LATIN SMALL LETTER Y
0x7A	0x007A	#	LATIN SMALL LETTER Z
0x7B	0x007B	#	LEFT CURLY BRACKET
0x7C	0x007C	#	VERTICAL LINE
0x7D	0x007D	#	RIGHT CURLY BRACKET
0x7E	0x007E	#	TILDE
0x7F	0x007F	#	DELETE
0x80	0x0080	#	<control>
0x81	0x0081	#	<control>
0x82	0x0082	#	<control>
0x83	0x0083	#	<control>
0x84	0x0084	#	<control>
0x85	0x0085	#	<control>
0x86	0x0086	#	<control>
0x87	0x0087	#	<control>
0x88	0x0088	#	<control>
0x89	0x0089	#	<control>
0x8A	0x008A	#	<control>
0x8B	0x008B	#	<control>
0x8C	0x008C	#	<control>
0x8D	0x008D	#	<control>
0x8E	0x008E	#	<control>
0x8F	0x008F	#	<control>
0x90	0x0090	#	<control>
0x91	0x0091	#	<control>
0x92	0x0092	#	<control>
0x93	0x0093	#	<control>
0x94	0x0094	#	<control>
0x95	0x0095	#	<control>
0x96	0x0096	#	<control>
0x97	0x0097	#	<control>
0x98	0x0098	#	<control>
0x99	0x0099	#	<control>
0x9A	0x009A	#	<control>
0x9B	0x009B	#	<control>
0x9C	0x009C	#	<control>
0x9D	0x009D	#	<control>
0x9E	0x009E	#	<control>
0x9F	0x009F	#	<control>
0xA0	0x00A0	#	NO-BREAK SPACE
0xA1	0x0E01	#	THAI CHARACTER KO KAI
0xA2	0x0E02	#	THAI CHARACTER KHO KHAI
0xA3	0x0E03	#	THAI CHARACTER KHO KHUAT
0xA4	0x0E04	#	THAI CHARACTER KHO KHWAI
0xA5	0x0E05	#	THAI CHARACTER KHO KHON
0xA6	0x0E06	#	THAI CHARACTER KHO RAKHANG
0xA7	0x0E07	#	THAI CHARACTER NGO NGU
0xA8	0x0E08	#	THAI CHARACTER CHO CHAN
0xA9	0x0E09	#	THAI CHARACTER CHO CHING
0xAA	0x0E0A	#	THAI CHARACTER CHO CHANG
0xAB	0x0E0B	#	THAI CHARACTER SO SO
0xAC	0x0E0C	#	THAI CHARACTER CHO CHOE
0xAD	0x0E0D	#	THAI CHARACTER YO YING
0xAE	0x0E0E	#	THAI CHARACTER DO CHADA
0xAF	0x0E0F	#	THAI CHARACTER TO PATAK
0xB0	0x0E10	#	THAI CHARACTER THO THAN
0xB1	0x0E11	#	THAI CHARACTER THO NANGMONTHO
0xB2	0x0E12	#	THAI CHARACTER THO PHUTHAO
0xB3	0x0E13	#	THAI CHARACTER NO NEN
0xB4	0x0E14	#	THAI CHARACTER DO DEK
0xB5	0x0E15	#	THAI CHARACTER TO TAO
0xB6	0x0E16	#	THAI CHARACTER THO THUNG
0xB7	0x0E17	#	THAI CHARACTER THO THAHAN
0xB8	0x0E18	#	THAI CHARACTER THO THONG
0xB9	0x0E19	#	THAI CHARACTER NO NU
0xBA	0x0E1A	#	THAI CHARACTER BO BAIMAI
0xBB	0x0E1B	#	THAI CHARACTER PO PLA
0xBC	0x0E1C	#	THAI CHARACTER PHO PHUNG
0xBD	0x0E1D	#	THAI CHARACTER FO FA
0xBE	0x0E1E	#	THAI CHARACTER PHO PHAN
0xBF	0x0E1F	#	THAI CHARACTER FO FAN
0xC0	0x0E20	#	THAI CHARACTER PHO SAMPHAO
0xC1	0x0E21	#	THAI CHARACTER MO MA
0xC2	0x0E22	#	THAI CHARACTER YO YAK
0xC3	0x0E23	#	THAI CHARACTER RO RUA
0xC4	0x0E24	#	THAI CHARACTER RU
0xC5	0x0E25	#	THAI CHARACTER LO LING
0xC6	0x0E26	#	THAI CHARACTER LU
0xC7	0x0E27	#	THAI CHARACTER WO WAEN
0xC8	0x0E28	#	THAI CHARACTER SO SALA
0xC9	0x0E29	#	THAI CHARACTER SO RUSI
0xCA	0x0E2A	#	THAI CHARACTER SO SUA
0xCB	0x0E2B	#	THAI CHARACTER HO HIP
0xCC	0x0E2C	#	THAI CHARACTER LO CHULA
0xCD	0x0E2D	#	THAI CHARACTER O ANG
0xCE	0x0E2E	#	THAI CHARACTER HO NOKHUK
0xCF	0x0E2F	#	THAI CHARACTER PAIYANNOI
0xD0	0x0E30	#	THAI CHARACTER SARA A
0xD1	0x0E31	#	THAI CHARACTER MAI HAN-AKAT
0xD2	0x0E32	#	THAI CHARACTER SARA AA
0xD3	0x0E33	#	THAI CHARACTER SARA AM
0xD4	0x0E34	#	THAI CHARACTER SARA I
0xD5	0x0E35	#	THAI CHARACTER SARA II
0xD6	0x0E36	#	THAI CHARACTER SARA UE
0xD7	0x0E37	#	THAI CHARACTER SARA UEE
0xD8	0x0E38	#	THAI CHARACTER SARA U
0xD9	0x0E39	#	THAI CHARACTER SARA UU
0xDA	0x0E3A	#	THAI CHARACTER PHINTHU
0xDF	0x0E3F	#	THAI CURRENCY SYMBOL BAHT
0xE0	0x0E40	#	THAI CHARACTER SARA E
0xE1	0x0E41	#	THAI CHARACTER SARA AE
0xE2	0x0E42	#	THAI CHARACTER SARA O
0xE3	0x0E43	#	THAI CHARACTER SARA AI MAIMUAN
0xE4	0x0E44	#	THAI CHARACTER SARA AI MAIMALAI
0xE5	0x0E45	#	THAI CHARACTER LAKKHANGYAO
0xE6	0x0E46	#	THAI CHARACTER MAIYAMOK
0xE7	0x0E47	#	THAI CHARACTER MAITAIKHU
0xE8	0x0E48	#	THAI CHARACTER MAI EK
0xE9	0x0E49	#	THAI CHARACTER MAI THO
0xEA	0x0E4A	#	THAI CHARACTER MAI TRI
0xEB	0x0E4B	#	THAI CHARACTER MAI CHATTAWA
0xEC	0x0E4C	#	THAI CHARACTER THANTHAKHAT
0xED	0x0E4D	#	THAI CHARACTER NIKHAHIT
0xEE	0x0E4E	#	THAI CHARACTER YAMAKKAN
0xEF	0x0E4F	#	THAI CHARACTER FONGMAN
0xF0	0x0E50	#	THAI DIGIT ZERO
0xF1	0x0E51	#	THAI DIGIT ONE
0xF2	0x0E52	#	THAI DIGIT TWO
0xF3	0x0E53	#	THAI DIGIT THREE
0xF4	0x0E54	#	THAI DIGIT FOUR
0xF5	0x0E55	#	THAI DIGIT FIVE
0xF6	0x0E56	#	THAI DIGIT SIX
0xF7	0x0E57	#	THAI DIGIT SEVEN
0xF8	0x0E58	#	THAI DIGIT EIGHT
0xF9	0x0E59	#	THAI DIGIT NINE
0xFA	0x0E5A	#	THAI CHARACTER ANGKHANKHU
0xFB	0x0E5B	#	THAI CHARACTER KHOMUT

Changes to tools/encoding/iso8859-13.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













+
+
+
+
+

-
+

-
-
+
+
-







# 8859-13.TXT
# Date: 2015-12-02 22:03:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-13:1998  to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1998 - 1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-13:1998 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-13 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-13 order.
#
#	Version history
#   1.0 version: created
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-14.txt.





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
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
+
+
+
+



-
+

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













+
+
+
+
+

-
+

-
-
+
+
-







# 8859-14.TXT
# Date: 2015-12-02 22:05:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-14:1998 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Markus Kuhn <mkuhn@acm.org>
#			  Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Markus Kuhn <http://www.cl.cam.ac.uk/~mgk25/>
#			  Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1998 - 1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-14:1998 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-14 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-14 order.
#
#	Version history
#   1.0 version: created
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY
294
295
296
297
298
299
300
301
286
287
288
289
290
291
292








-
0xF9	0x00F9	#	LATIN SMALL LETTER U WITH GRAVE
0xFA	0x00FA	#	LATIN SMALL LETTER U WITH ACUTE
0xFB	0x00FB	#	LATIN SMALL LETTER U WITH CIRCUMFLEX
0xFC	0x00FC	#	LATIN SMALL LETTER U WITH DIAERESIS
0xFD	0x00FD	#	LATIN SMALL LETTER Y WITH ACUTE
0xFE	0x0177	#	LATIN SMALL LETTER Y WITH CIRCUMFLEX
0xFF	0x00FF	#	LATIN SMALL LETTER Y WITH DIAERESIS

Changes to tools/encoding/iso8859-15.txt.





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
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
+
+
+
+



-
+

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-















+
+
+
+
+

-
+

-
-
+
+
-







# 8859-15.TXT
# Date: 2015-12-02 22:06:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-15:1999 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Markus Kuhn <mkuhn@acm.org>
#			  Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Markus Kuhn <http://www.cl.cam.ac.uk/~mgk25/>
#			  Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1998 - 1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-15:1999 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-15 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-15 order.
#
#	Version history
#
#	Version history
#   1.0 version: created
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY
296
297
298
299
300
301
302
303
288
289
290
291
292
293
294








-
0xF9	0x00F9	#	LATIN SMALL LETTER U WITH GRAVE
0xFA	0x00FA	#	LATIN SMALL LETTER U WITH ACUTE
0xFB	0x00FB	#	LATIN SMALL LETTER U WITH CIRCUMFLEX
0xFC	0x00FC	#	LATIN SMALL LETTER U WITH DIAERESIS
0xFD	0x00FD	#	LATIN SMALL LETTER Y WITH ACUTE
0xFE	0x00FE	#	LATIN SMALL LETTER THORN
0xFF	0x00FF	#	LATIN SMALL LETTER Y WITH DIAERESIS

Changes to tools/encoding/iso8859-16.txt.





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
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
+
+
+
+



-
+

-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-












+
+
+
+
+

-
+

-
-
+
+
-







# 8859-16.TXT
# Date: 2015-12-02 22:08:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-16:2001 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             2001 July 26
#	Authors:          Markus Kuhn <mkuhn@acm.org>
#	Date:             2001 July 26 (header updated: 2015 December 02)
#	Authors:          Markus Kuhn <http://www.cl.cam.ac.uk/~mgk25/>
#
#	Copyright (c) 1999-2001 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-16:2001 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-16 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-16 order.
#
#	Version history
#   1.0 version: created
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-2.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
+
+
+
+


-
+

-
-
+
+
-







# 8859-2.TXT
# Date: 2015-12-02 21:34:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO 8859-2:1999 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-2:1999 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-2 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-2 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#   1.0 version: updates 0.1 version by adding mappings for all
#       control characters.
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-3.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
+
+
+
+


-
+

-
-
+
+
-







# 8859-3.TXT
# Date: 2015-12-02 21:39:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-3:1999 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-3:1999 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-3 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-3 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#   1.0 version: updates 0.1 version by adding mappings for all
#       control characters.
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-4.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
+
+
+
+


-
+

-
-
+
+
-







# 8859-4.TXT
# Date: 2015-12-02 21:41:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-4:1998 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-4:1998 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-4 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-4 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#   1.0 version: updates 0.1 version by adding mappings for all
#       control characters.
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-5.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
+
+
+
+


-
+

-
-
+
+
-







# 8859-5.TXT
# Date: 2015-12-02 21:43:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO 8859-5:1999 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-5:1999 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-5 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-5 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#   1.0 version: updates 0.1 version by adding mappings for all
#       control characters.
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-6.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-














-
-
-
-
+
+
+
+
+
+


-
+

-
-
+
+
-







# 8859-6.TXT
# Date: 2015-12-02 21:44:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO 8859-6:1999 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-6:1999 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-6 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-6 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#	0x30..0x39 remapped to the ASCII digits (U+0030..U+0039) instead
#	of the Arabic digits (U+0660..U+0669).
#   1.0 version: updates 0.1 version by adding mappings for all
#       control characters.
#       0x30..0x39 remapped to the ASCII digits (U+0030..U+0039) instead
#       of the Arabic digits (U+0660..U+0669).
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY

Changes to tools/encoding/iso8859-7.txt.





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
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
+
+
+
+

-
-
-
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+


-
+
+














+
+
+
+
+
+

-
+

-
-
+
+
-







# 8859-7.TXT
# Date: 2015-12-02 21:47:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO 8859-7:1987 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Name:             ISO 8859-7:2003 to Unicode
#	Unicode version:  4.0
#	Table version:    3.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             2003-Nov-12 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO 8859-7:1987 characters map into Unicode.
#       ISO 8859-7:2003 characters map into Unicode.
#
#	ISO 8859-7:1987 is equivalent to ISO-IR-126, ELOT 928,
#	and ECMA 118.
#	and ECMA 118. ISO 8859-7:2003 adds two currency signs
#	and one other character not in the earlier standard.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO 8859-7 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO 8859-7 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#	Remap 0xA1 to U+2018 (instead of 0x02BD) to match text of 8859-7
#	Remap 0xA2 to U+2019 (instead of 0x02BC) to match text of 8859-7
#
#	2.0 version updates 1.0 version by adding mappings for the
#	three newly added characters 0xA4, 0xA5, 0xAA.
#
#   3.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY
210
211
212
213
214
215
216


217
218
219
220

221
222
223
224
225
226
227
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224







+
+




+







0x9D	0x009D	#	<control>
0x9E	0x009E	#	<control>
0x9F	0x009F	#	<control>
0xA0	0x00A0	#	NO-BREAK SPACE
0xA1	0x2018	#	LEFT SINGLE QUOTATION MARK
0xA2	0x2019	#	RIGHT SINGLE QUOTATION MARK
0xA3	0x00A3	#	POUND SIGN
0xA4	0x20AC	#	EURO SIGN
0xA5	0x20AF	#	DRACHMA SIGN
0xA6	0x00A6	#	BROKEN BAR
0xA7	0x00A7	#	SECTION SIGN
0xA8	0x00A8	#	DIAERESIS
0xA9	0x00A9	#	COPYRIGHT SIGN
0xAA	0x037A	#	GREEK YPOGEGRAMMENI
0xAB	0x00AB	#	LEFT-POINTING DOUBLE ANGLE QUOTATION MARK
0xAC	0x00AC	#	NOT SIGN
0xAD	0x00AD	#	SOFT HYPHEN
0xAF	0x2015	#	HORIZONTAL BAR
0xB0	0x00B0	#	DEGREE SIGN
0xB1	0x00B1	#	PLUS-MINUS SIGN
0xB2	0x00B2	#	SUPERSCRIPT TWO

Changes to tools/encoding/iso8859-8.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















-
+

+
+


-
+

-
-
+
+
-







# 8859-8.TXT
# Date: 2015-12-02 21:50:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-8:1999 to Unicode
#	Unicode version:  3.0
#	Table version:    1.1
#	Table version:    2.0
#	Table format:     Format A
#	Date:             2000-Jan-03
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             2000-Jan-03 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on optical media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-8:1999 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-8 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-8 order.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#       1.1 version updates to the published 8859-8:1999, correcting
#   1.1 version updates to the published 8859-8:1999, correcting
#          the mapping of 0xAF and adding mappings for LRM and RLM.
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY
263
264
265
266
267
268
269
270
252
253
254
255
256
257
258








-
0xF6	0x05E6	#	HEBREW LETTER TSADI
0xF7	0x05E7	#	HEBREW LETTER QOF
0xF8	0x05E8	#	HEBREW LETTER RESH
0xF9	0x05E9	#	HEBREW LETTER SHIN
0xFA	0x05EA	#	HEBREW LETTER TAV
0xFD	0x200E	#	LEFT-TO-RIGHT MARK
0xFE	0x200F	#	RIGHT-TO-LEFT MARK

Changes to tools/encoding/iso8859-9.txt.





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
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
+
+
+
+



-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
















-
-
+
+
+
+


-
+

-
-
+
+
-







# 8859-9.TXT
# Date: 2015-12-02 21:51:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             ISO/IEC 8859-9:1999 to Unicode
#	Unicode version:  3.0
#	Table version:    1.0
#	Table version:    2.0
#	Table format:     Format A
#	Date:             1999 July 27
#	Authors:          Ken Whistler <kenw@sybase.com>
#	Date:             1999 July 27 (header updated: 2015 December 02)
#	Authors:          Ken Whistler <ken@unicode.org>
#
#	Copyright (c) 1991-1999 Unicode, Inc.  All Rights reserved.
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on magnetic media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Unicode, Inc. hereby grants the right to freely use the information
#	supplied in this file in the creation of products supporting the
#	Unicode Standard, and to make copies of this file in any form for
#	internal or external distribution as long as this notice remains
#	attached.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       ISO/IEC 8859-9:1999 characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the ISO/IEC 8859-9 code (in hex as 0xXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#
#	The entries are in ISO/IEC 8859-9 order.
#
#	ISO/IEC 8859-9 is also equivalent to ISO-IR-148.
#
#	Version history
#	1.0 version updates 0.1 version by adding mappings for all
#	control characters.
#   1.0 version: updates 0.1 version by adding mappings for all
#       control characters.
#   2.0 version: updates to copyright notice and terms of use; no
#       changes to character mappings
#
#	Updated versions of this file may be found in:
#		<ftp://ftp.unicode.org/Public/MAPPINGS/>
#		http://www.unicode.org/Public/MAPPINGS/
#
#	Any comments or problems, contact <errata@unicode.org>
#	Please note that <errata@unicode.org> is an archival address;
#	Any comments or problems, contact us at:
#       http://www.unicode.org/reporting.html
#	notices will be checked, but do not expect an immediate response.
#
0x00	0x0000	#	NULL
0x01	0x0001	#	START OF HEADING
0x02	0x0002	#	START OF TEXT
0x03	0x0003	#	END OF TEXT
0x04	0x0004	#	END OF TRANSMISSION
0x05	0x0005	#	ENQUIRY
299
300
301
302
303
304
305
306
307
288
289
290
291
292
293
294
295









-
0xF9	0x00F9	#	LATIN SMALL LETTER U WITH GRAVE
0xFA	0x00FA	#	LATIN SMALL LETTER U WITH ACUTE
0xFB	0x00FB	#	LATIN SMALL LETTER U WITH CIRCUMFLEX
0xFC	0x00FC	#	LATIN SMALL LETTER U WITH DIAERESIS
0xFD	0x0131	#	LATIN SMALL LETTER DOTLESS I
0xFE	0x015F	#	LATIN SMALL LETTER S WITH CEDILLA
0xFF	0x00FF	#	LATIN SMALL LETTER Y WITH DIAERESIS


Changes to tools/encoding/jis0201.txt.





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
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
+
+
+
+



-
+

-
+
-
-

-
+

-
-
-
-
-
-
-

-
-
-
+
+
+
+
+
-
-
+

-
-
-
-
-








-
-
+
+
+
+
+

+
+
-
+
+

+
+
+
+
+







# JIS0201.TXT
# Date: 2015-12-02 23:49:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             JIS X 0201 (1976) to Unicode 1.1 Table
#	Unicode version:  1.1
#	Table version:    0.9
#	Table version:    2.0
#	Table format:     Format A
#	Date:             8 March 1994
#	Date:             2011 October 14 (header updated: 2015 December 02)
#	Authors:          Glenn Adams <glenn@metis.com>
#                     John H. Jenkins <John_Jenkins@taligent.com>
#
#	Copyright (c) 1991-1994 Unicode, Inc.  All Rights reserved.
#	General notes:
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on magnetic media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Recipient is granted the right to make copies in any form for
#	internal distribution and to freely use the information supplied
#	in the creation of products supporting Unicode.  Unicode, Inc.
# This table contains one set of mappings from JIS X 0201 into Unicode.
# Note that these data are *possible* mappings only and may not be the
# same as those used by actual products, nor may they be the best suited
# for all uses.  For more information on the mappings between various code
# pages incorporating the repertoire of JIS X 0201 and Unicode, consult the
#	specifically excludes the right to re-distribute this file directly
#	to third parties or other organizations whether for profit or not.
# VENDORS mapping data.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#	single-byte JIS X 0201 characters map into Unicode 1.1
#	(ISO/IEC 10646:1-1993 UCS-2).
#
#	Format:  Three tab-separated columns
#		Column #1 is the shift JIS code (in hex as 0xXX)
#		Column #2 is the Unicode (in hex as 0xXXXX)
#		Column #3 the Unicode (ISO 10646) name (follows a comment sign)
#
#	The entries are in JIS order
#
#   These mappings are provisional, pending definition of
#       official mappings by Japanese standards bodies.
#  Revision History:
#
#    [v2.0, 2015 December 02]
#    updates to copyright notice and terms of use
#    no changes to character mappings
#
#    [v1.0, 2011 October 14]
#    Updated terms of use to current wording.
#	Any comments or problems, contact <John_Jenkins@taligent.com>
#    Updated contact information.
#    No changes to the mapping data.
#
#    [v0.9, 8 March 1994]
#    First release.
#
#  Use the Unicode reporting form <http://www.unicode.org/reporting.html>
#    for any questions or comments or to report errors in the data.
#
0x20	0x0020	# SPACE
0x21	0x0021	# EXCLAMATION MARK
0x22	0x0022	# QUOTATION MARK
0x23	0x0023	# NUMBER SIGN
0x24	0x0024	# DOLLAR SIGN
0x25	0x0025	# PERCENT SIGN

Changes to tools/encoding/jis0208.txt.





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
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
+
+
+
+



-
+

-
+
-
-

-
+

-
-
-
-
-
-
-

-
-
-
+
+
+
+
+
-
-
+

-
-
-
-






-
-
-
-
-
-
-
+
+
+
+
+
+
+












-
-
-
+
+
+
+
+

+
+
-
+
+

+
+
+
+
+







# JIS0208.TXT
# Date: 2015-12-02 23:50:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             JIS X 0208 (1990) to Unicode
#	Unicode version:  1.1
#	Table version:    0.9
#	Table version:    2.0
#	Table format:     Format A
#	Date:             8 March 1994
#	Date:             2011 October 14 (header updated: 2015 December 02)
#	Authors:          Glenn Adams <glenn@metis.com>
#                     John H. Jenkins <John_Jenkins@taligent.com>
#
#	Copyright (c) 1991-1994 Unicode, Inc.  All Rights reserved.
#	General notes:
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on magnetic media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Recipient is granted the right to make copies in any form for
#	internal distribution and to freely use the information supplied
#	in the creation of products supporting Unicode.  Unicode, Inc.
# This table contains one set of mappings from JIS X 0208 (1990) into Unicode.
# Note that these data are *possible* mappings only and may not be the
# same as those used by actual products, nor may they be the best suited
# for all uses.  For more information on the mappings between various code
# pages incorporating the repertoire of JIS X 0208 (1990) and Unicode, consult the
#	specifically excludes the right to re-distribute this file directly
#	to third parties or other organizations whether for profit or not.
# VENDORS mapping data.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       JIS X 0208 (1983) characters map into Unicode.
#
#	Format:  Four tab-separated columns
#		 Column #1 is the shift-JIS code (in hex)
#		 Column #2 is the JIS X 0208 code (in hex as 0xXXXX)
#		 Column #3 is the Unicode (in hex as 0xXXXX)
#		 Column #4 the Unicode name (follows a comment sign, '#')
#					The official names for Unicode characters U+4E00
#					to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#					where XXXX is the code point.  Including all these
#					names in this file increases its size substantially
#					and needlessly.  The token "<CJK>" is used for the
#					name of these characters.  If necessary, it can be
#					expanded algorithmically by a parser or editor.
#			The official names for Unicode characters U+4E00
#			to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#			where XXXX is the code point.  Including all these
#			names in this file increases its size substantially
#			and needlessly.  The token "<CJK>" is used for the
#			name of these characters.  If necessary, it can be
#			expanded algorithmically by a parser or editor.
#
#	The entries are in JIS X 0208 order
#
#	The following algorithms can be used to change the hex form
#		of JIS 0208 to other standard forms:
#
#		To change hex to EUC form, add 0x8080
#		To change hex to kuten form, first subtract 0x2020.  Then
#			the high and low bytes correspond to the ku and ten of
#			the kuten form.  For example, 0x2121 -> 0x0101 -> 0101;
#			0x7426 -> 0x5406 -> 8406
#
#   The kanji mappings are a normative part of ISO/IEC 10646.  The
#       non-kanji mappings are provisional, pending definition of
#       official mappings by Japanese standards bodies
#  Revision History:
#
#    [v2.0, 2015 December 02]
#    updates to copyright notice and terms of use
#    no changes to character mappings
#
#    [v1.0, 2011 October 14]
#    Updated terms of use to current wording.
#	Any comments or problems, contact <John_Jenkins@taligent.com>
#    Updated contact information.
#    No changes to the mapping data.
#
#    [v0.9, 8 March 1994]
#    First release.
#
#  Use the Unicode reporting form <http://www.unicode.org/reporting.html>
#    for any questions or comments or to report errors in the data.
#
0x8140	0x2121	0x3000	# IDEOGRAPHIC SPACE
0x8141	0x2122	0x3001	# IDEOGRAPHIC COMMA
0x8142	0x2123	0x3002	# IDEOGRAPHIC FULL STOP
0x8143	0x2124	0xFF0C	# FULLWIDTH COMMA
0x8144	0x2125	0xFF0E	# FULLWIDTH FULL STOP
0x8145	0x2126	0x30FB	# KATAKANA MIDDLE DOT

Changes to tools/encoding/jis0212.txt.





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
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
+
+
+
+



-
+

-
+
-
-

-
+

-
-
-
-
-
-
-

-
-
-
+
+
+
+
+
-
-
+

-
-
-
-





-
-
-
-
-
-
-
+
+
+
+
+
+
+












-
-
-
-
-
-















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







# JIS0212.TXT
# Date: 2015-12-02 23:51:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             JIS X 0212 (1990) to Unicode
#	Unicode version:  1.1
#	Table version:    0.9
#	Table version:    2.0
#	Table format:     Format A
#	Date:             8 March 1994
#	Date:             2011 October 14 (header updated: 2015 December 02)
#	Authors:          Glenn Adams <glenn@metis.com>
#                     John H. Jenkins <John_Jenkins@taligent.com>
#
#	Copyright (c) 1991-1994 Unicode, Inc.  All Rights reserved.
#	General notes:
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on magnetic media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Recipient is granted the right to make copies in any form for
#	internal distribution and to freely use the information supplied
#	in the creation of products supporting Unicode.  Unicode, Inc.
# This table contains one set of mappings from JIS X 0212 into Unicode.
# Note that these data are *possible* mappings only and may not be the
# same as those used by actual products, nor may they be the best suited
# for all uses.  For more information on the mappings between various code
# pages incorporating the repertoire of JIS X 0212 and Unicode, consult the
#	specifically excludes the right to re-distribute this file directly
#	to third parties or other organizations whether for profit or not.
# VENDORS mapping data.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       JIS X 0212 (1983) characters map into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the JIS X 0212 code (in hex as 0xXXXX)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#					The official names for Unicode characters U+4E00
#					to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#					where XXXX is the code point.  Including all these
#					names in this file increases its size substantially
#					and needlessly.  The token "<CJK>" is used for the
#					name of these characters.  If necessary, it can be
#					expanded algorithmically by a parser or editor.
#			The official names for Unicode characters U+4E00
#			to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#			where XXXX is the code point.  Including all these
#			names in this file increases its size substantially
#			and needlessly.  The token "<CJK>" is used for the
#			name of these characters.  If necessary, it can be
#			expanded algorithmically by a parser or editor.
#
#	The entries are in JIS X 0212 order
#
#	The following algorithms can be used to change the hex form
#		of JIS 0212 to other standard forms:
#
#		To change hex to EUC form, add 0x8080
#		To change hex to kuten form, first subtract 0x2020.  Then
#			the high and low bytes correspond to the ku and ten of
#			the kuten form.  For example, 0x2121 -> 0x0101 -> 0101;
#			0x6D63 -> 0x4D43 -> 7767
#
#   The kanji mappings are a normative part of ISO/IEC 10646.  The
#       non-kanji mappings are provisional, pending definition of
#       official mappings by Japanese standards bodies
#
#	Any comments or problems, contact <John_Jenkins@taligent.com>
#
#	Notes:
#
#	1. JIS X 0212 apparently unified the following two symbols
#	   into a single character at 0x2922:
#
#	   LATIN CAPITAL LETTER D WITH STROKE
#	   LATIN CAPITAL LETTER ETH
#
#	   However, JIS X 0212 maintains the distinction between
#	   the lowercase forms of these two elements at 0x2942 and 0x2943.
#	   Given the structre of these JIS encodings, it is clear that
#	   0x2922 and 0x2942 are intended to be a capital/small pair.
#	   Consequently, in the Unicode mapping, 0x2922 is treated as
#	   LATIN CAPITAL LETTER D WITH STROKE.
#
#  Revision History:
#
#    [v2.0, 2015 December 02]
#    updates to copyright notice and terms of use
#    no changes to character mappings
#
#    [v1.0, 2011 October 14]
#    Updated terms of use to current wording.
#    Updated contact information.
#    No changes to the mapping data.
#
#    [v0.9, 8 March 1994]
#    First release.
#
#  Use the Unicode reporting form <http://www.unicode.org/reporting.html>
#    for any questions or comments or to report errors in the data.
#
0x222F	0x02D8	# BREVE
0x2230	0x02C7	# CARON (Mandarin Chinese third tone)
0x2231	0x00B8	# CEDILLA
0x2232	0x02D9	# DOT ABOVE (Mandarin Chinese light tone)
0x2233	0x02DD	# DOUBLE ACUTE ACCENT
0x2234	0x00AF	# MACRON
0x2235	0x02DB	# OGONEK

Changes to tools/encoding/shiftjis.txt.





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
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
+
+
+
+



-
+

-
+
-
-

-
+

-
-
-
-
-
-
-

-
-
-
+
+
+
+
+
-
-
+

-
-
-
-





-
-
-
-
-
-
-
+
+
+
+
+
+
+










-
-
-
+
+
+
+
+

+
+
-
+
+

+
+
+
+
+







# SHIFTJIS.TXT
# Date: 2015-12-02 23:52:00 GMT [KW]
# © 2015 Unicode®, Inc.
# For terms of use, see http://www.unicode.org/terms_of_use.html
#
#	Name:             Shift-JIS to Unicode
#	Unicode version:  1.1
#	Table version:    0.9
#	Table version:    2.0
#	Table format:     Format A
#	Date:             8 March 1994
#	Date:             2011 October 14 (header updated: 2015 December 02)
#	Authors:          Glenn Adams <glenn@metis.com>
#                     John H. Jenkins <John_Jenkins@taligent.com>
#
#	Copyright (c) 1991-1994 Unicode, Inc.  All Rights reserved.
#	General notes:
#
#	This file is provided as-is by Unicode, Inc. (The Unicode Consortium).
#	No claims are made as to fitness for any particular purpose.  No
#	warranties of any kind are expressed or implied.  The recipient
#	agrees to determine applicability of information provided.  If this
#	file has been provided on magnetic media by Unicode, Inc., the sole
#	remedy for any claim will be exchange of defective media within 90
#	days of receipt.
#
#	Recipient is granted the right to make copies in any form for
#	internal distribution and to freely use the information supplied
#	in the creation of products supporting Unicode.  Unicode, Inc.
# This table contains one set of mappings from Shift-JIS into Unicode.
# Note that these data are *possible* mappings only and may not be the
# same as those used by actual products, nor may they be the best suited
# for all uses.  For more information on the mappings between various code
# pages incorporating the repertoire of Shift-JIS and Unicode, consult the
#	specifically excludes the right to re-distribute this file directly
#	to third parties or other organizations whether for profit or not.
# VENDORS mapping data.
#
#	General notes:
#
#	This table contains the data the Unicode Consortium has on how
#       Shift-JIS (a combination of JIS 0201 and JIS 0208) maps into Unicode.
#
#	Format:  Three tab-separated columns
#		 Column #1 is the shift-JIS code (in hex)
#		 Column #2 is the Unicode (in hex as 0xXXXX)
#		 Column #3 the Unicode name (follows a comment sign, '#')
#					The official names for Unicode characters U+4E00
#					to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#					where XXXX is the code point.  Including all these
#					names in this file increases its size substantially
#					and needlessly.  The token "<CJK>" is used for the
#					name of these characters.  If necessary, it can be
#					expanded algorithmically by a parser or editor.
#			The official names for Unicode characters U+4E00
#			to U+9FA5, inclusive, is "CJK UNIFIED IDEOGRAPH-XXXX",
#			where XXXX is the code point.  Including all these
#			names in this file increases its size substantially
#			and needlessly.  The token "<CJK>" is used for the
#			name of these characters.  If necessary, it can be
#			expanded algorithmically by a parser or editor.
#
#	The entries are ordered by their Shift-JIS codes as follows:
#		Single-byte characters precede double-byte characters
#		The single-byte and double-byte blocks are in ascending
#		hexadecimal order
#	There is an alternative order some people might be preferred,
#		where all the entries are in order of the top (or only) byte.
#		This alternate order can be generated from the one given here
#		by a simple sort.
#
#   The kanji mappings are a normative part of ISO/IEC 10646.  The
#       non-kanji mappings are provisional, pending definition of
#       official mappings by Japanese standards bodies
#  Revision History:
#
#    [v2.0, 2015 December 02]
#    updates to copyright notice and terms of use
#    no changes to character mappings
#
#    [v1.0, 2011 October 14]
#    Updated terms of use to current wording.
#	Any comments or problems, contact <John_Jenkins@taligent.com>
#    Updated contact information.
#    No changes to the mapping data.
#
#    [v0.9, 8 March 1994]
#    First release.
#
#  Use the Unicode reporting form <http://www.unicode.org/reporting.html>
#    for any questions or comments or to report errors in the data.
#
0x20	0x0020	# SPACE
0x21	0x0021	# EXCLAMATION MARK
0x22	0x0022	# QUOTATION MARK
0x23	0x0023	# NUMBER SIGN
0x24	0x0024	# DOLLAR SIGN
0x25	0x0025	# PERCENT SIGN

Changes to tools/encoding/txt2enc.c.

172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
172
173
174
175
176
177
178

179
180
181
182
183
184
185
186







-
+







	    str = rest;
	}
	if (enc < 32 || uni < 32) {
	    continue;
	}

	hi = enc >> 8;
	lo = enc & 0xFF;
	lo = enc & 0xff;
	if (toUnicode[hi] == NULL) {
	    toUnicode[hi] = (Rune *) malloc(256 * sizeof(Rune));
	    memset(toUnicode[hi], 0, 256 * sizeof(Rune));
	}
	toUnicode[hi][lo] = uni;
    }

204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
204
205
206
207
208
209
210

211
212
213
214
215
216
217
218







-
+







	    toUnicode[0] = (Rune *) malloc(256 * sizeof(Rune));
	    memset(toUnicode[0], 0, 256 * sizeof(Rune));
	}
	for (i = 0; i < 0x20; i++) {
	    toUnicode[0][i] = i;
	}
	if (fixmissing) {
	    for (i = 0x7F; i < 0xA0; i++) {
	    for (i = 0x7F; i < 0xa0; i++) {
		if (toUnicode[i] == NULL && toUnicode[0][i] == 0) {
		    toUnicode[0][i] = i;
		}
	    }
	}
    }

230
231
232
233
234
235
236
237

238
239
240
241
242
243
244
230
231
232
233
234
235
236

237
238
239
240
241
242
243
244







-
+







    printf("%c\n%04X %d %d\n", "SDM"[type], fallbackChar, symbol, used);

    for (hi = 0; hi < 256; hi++) {
	if (toUnicode[hi] != NULL) {
	    printf("%02X\n", hi);
	    for (lo = 0; lo < 256; lo++) {
		printf("%04X", toUnicode[hi][lo]);
		if ((lo & 0x0F) == 0x0F) {
		if ((lo & 0x0f) == 0x0f) {
		    putchar('\n');
		}
	    }
	}
    }

    for (hi = 0; hi < 256; hi++) {

Added tools/fix_tommath_h.tcl.



































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
# fixtommath.tcl --
#
#	Changes to 'tommath.h' to make it conform with Tcl's linking
#	conventions.
#
# Copyright (c) 2005 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.
#----------------------------------------------------------------------

set f [open [lindex $argv 0] r]
set data [read $f]
close $f

set eat_endif 0
set eat_semi 0
set def_count 0
foreach line [split $data \n] {
    if { !$eat_semi && !$eat_endif } {
	switch -regexp -- $line {
	    {#define BN_H_} {
		puts $line
		puts {}
		puts "\#include <tclTomMathDecls.h>"
		puts "\#ifndef MODULE_SCOPE"
		puts "\#define MODULE_SCOPE extern"
		puts "\#endif"
	    }
	    {typedef\s+unsigned long\s+mp_digit;} {
		# change the second 'typedef unsigned long mp
		incr def_count
		puts "\#ifndef MP_DIGIT_DECLARED"
		if {$def_count == 2} {
		    puts [string map {long int} $line]
		} else {
		    puts $line
		}
		puts "\#define MP_DIGIT_DECLARED"
		puts "\#endif"
	    }
	    {typedef.*mp_digit;} {
		puts "\#ifndef MP_DIGIT_DECLARED"
		puts $line
		puts "\#define MP_DIGIT_DECLARED"
		puts "\#endif"
	    }
	    {typedef struct} {
		puts "\#ifndef MP_INT_DECLARED"
		puts "\#define MP_INT_DECLARED"
		puts "typedef struct mp_int mp_int;"
		puts "\#endif"
		puts "struct mp_int \{"
	    }
	    \}\ mp_int\; {
		puts "\};"
	    }
	    {^(char|int|void)} {
		puts "/*"
		puts $line
		set eat_semi 1
		set after_semi "*/"
	    }
	    {^extern (int|const)} {
		puts "\#if defined(BUILD_tcl) || !defined(_WIN32)"
		puts [regsub {^extern} $line "MODULE_SCOPE"]
		set eat_semi 1
		set after_semi "\#endif"
	    }
	    {define heap macros} {
		puts $line
		puts "\#if 0 /* these are macros in tclTomMathDecls.h */"
		set eat_endif 1
	    }
	    {__x86_64__} {
		puts "[string map {__x86_64__ NEVER} $line]\
                      /* 128-bit ints fail in too many places */"
	    }
	    default {
		puts $line
	    }
	}
    } else {
	puts $line
    }
    if {$eat_semi} {
	if {[regexp {; *$} $line]} {
	    puts $after_semi
	    set eat_semi 0
	}
    }
    if {$eat_endif} {
	if {[regexp {^\#endif} $line]} {
	    puts "\#endif"
	    set eat_endif 0
	}
    }
}

Changes to tools/genStubs.tcl.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
1
2
3
4
5
6

7
8
9
10
11
12
13
14






-
+







# genStubs.tcl --
#
#	This script generates a set of stub files for a given
#	interface.
#
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
# Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

namespace eval genStubs {
    # libraryName --
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
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







+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-







    # bump the lastNum counter if necessary.

    foreach platform $platformList {
	if {[info exists stubs($curName,$platform,$index)]} {
	    puts stderr "Duplicate entry: declare $args"
	}
    }
    regsub -all const $decl CONST decl
    regsub -all _XCONST $decl _Xconst decl
    regsub -all "\[ \t\n\]+" [string trim $decl] " " decl
    set decl [parseDecl $decl]

    if {([lindex $platformList 0] eq "deprecated")} {
	set stubs($curName,deprecated,$index) [lindex $platformList 1]
	set stubs($curName,generic,$index) $decl
	if {![info exists stubs($curName,generic,lastNum)] \
		|| ($index > $stubs($curName,generic,lastNum))} {
	    set stubs($curName,generic,lastNum) $index
	}
    } elseif {([lindex $platformList 0] eq "nostub")} {
	set stubs($curName,nostub,$index) [lindex $platformList 1]
	set stubs($curName,generic,$index) $decl
	if {![info exists stubs($curName,generic,lastNum)] \
		|| ($index > $stubs($curName,generic,lastNum))} {
	    set stubs($curName,generic,lastNum) $index
	}
    } else {
	foreach platform $platformList {
	    if {$decl ne ""} {
		set stubs($curName,$platform,$index) $decl
		    if {![info exists stubs($curName,$platform,lastNum)] \
			    || ($index > $stubs($curName,$platform,lastNum))} {
			set stubs($curName,$platform,lastNum) $index
    foreach platform $platformList {
	if {$decl ne ""} {
	    set stubs($curName,$platform,$index) $decl
	    if {![info exists stubs($curName,$platform,lastNum)] \
		    || ($index > $stubs($curName,$platform,lastNum))} {
		set stubs($curName,$platform,lastNum) $index
		}
	    }
	}
    }
    return
}

# genStubs::export --
253
254
255
256
257
258
259

260
261

262
263
264
265
266
267
268
239
240
241
242
243
244
245
246
247

248
249
250
251
252
253
254
255







+

-
+








proc genStubs::rewriteFile {file text} {
    if {![file exists $file]} {
	puts stderr "Cannot find file: $file"
	return
    }
    set in [open ${file} r]
    fconfigure $in -eofchar "\032 {}" -encoding utf-8
    set out [open ${file}.new w]
    fconfigure $out -translation lf
    fconfigure $out -translation lf -encoding utf-8

    while {![eof $in]} {
	set line [gets $in]
	if {[string match "*!BEGIN!*" $line]} {
	    break
	}
	puts $out $line
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
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







-
+










-
+







# Results:
#	Returns the original text inside an appropriate #ifdef.

proc genStubs::addPlatformGuard {plat iftxt {eltxt {}} {withCygwin 0}} {
    set text ""
    switch $plat {
	win {
	    append text "#if defined(_WIN32)"
	    append text "#if defined(__WIN32__)"
	    if {$withCygwin} {
		append text " || defined(__CYGWIN__)"
	    }
	    append text " /* WIN */\n${iftxt}"
	    if {$eltxt ne ""} {
		append text "#else /* WIN */\n${eltxt}"
	    }
	    append text "#endif /* WIN */\n"
	}
	unix {
	    append text "#if !defined(_WIN32)"
	    append text "#if !defined(__WIN32__)"
	    if {$withCygwin} {
		append text " && !defined(__CYGWIN__)"
	    }
	    append text " && !defined(MAC_OSX_TCL)\
		    /* UNIX */\n${iftxt}"
	    if {$eltxt ne ""} {
		append text "#else /* UNIX */\n${eltxt}"
330
331
332
333
334
335
336
337

338
339
340
341
342
343
344
317
318
319
320
321
322
323

324
325
326
327
328
329
330
331







-
+







	    append text "#ifdef MAC_OSX_TK /* AQUA */\n${iftxt}"
	    if {$eltxt ne ""} {
		append text "#else /* AQUA */\n${eltxt}"
	    }
	    append text "#endif /* AQUA */\n"
	}
	x11 {
	    append text "#if !(defined(_WIN32)"
	    append text "#if !(defined(__WIN32__)"
	    if {$withCygwin} {
		append text " || defined(__CYGWIN__)"
	    }
	    append text " || defined(MAC_OSX_TK))\
		    /* X11 */\n${iftxt}"
	    if {$eltxt ne ""} {
		append text "#else /* X11 */\n${eltxt}"
364
365
366
367
368
369
370
371

372
373
374
375
376
377
378
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365







-
+







#
# Results:
#	None.

proc genStubs::emitSlots {name textVar} {
    upvar $textVar text

    forAllStubs $name makeSlot 1 text {"    void (*reserved$i)(void);\n"}
    forAllStubs $name makeSlot 1 text {"    VOID *reserved$i;\n"}
    return
}

# genStubs::parseDecl --
#
#	Parse a C function declaration into its component parts.
#
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
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







-
-



-
-
-
+
-
-
-
-
+

+

















+


-
+







#	index	The slot index for this function.
#
# Results:
#	Returns the formatted declaration string.

proc genStubs::makeDecl {name decl index} {
    variable scspec
    variable stubs
    variable libraryName
    lassign $decl rtype fname args

    append text "/* $index */\n"
    if {[info exists stubs($name,deprecated,$index)]} {
	append text "[string toupper $libraryName]_DEPRECATED(\"$stubs($name,deprecated,$index)\")\n"
	set line "$rtype"
    if {$rtype ne "void"} {
    } elseif {[string range $rtype end-5 end] eq "MP_WUR"} {
	set line "$scspec [string trim [string range $rtype 0 end-6]]"
    } else {
	set line "$scspec $rtype"
	regsub -all void $rtype VOID rtype
    }
    set line "$scspec $rtype"
    set count [expr {2 - ([string length $line] / 8)}]
    if {$count >= 0} {
	append line [string range "\t\t\t" 0 $count]
    }
    set pad [expr {24 - [string length $line]}]
    if {$pad <= 0} {
	append line " "
	set pad 0
    }
    if {$args eq ""} {
	append line $fname
	append text $line
	append text ";\n"
	return $text
    }
    append line $fname

    regsub -all void $args VOID args
    set arg1 [lindex $args 0]
    switch -exact $arg1 {
	void {
	VOID {
	    append line "(void)"
	}
	TCL_VARARGS {
	    set sep "("
	    foreach arg [lrange $args 1 end] {
		append line $sep
		set next {}
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
504
505
506
507
508
509
510



511
512
513
514
515
516
517







-
-
-







		    set line "\t\t\t\t"
		    set pad 28
		}
		append line $next
		set sep ", "
	    }
	    append line ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append line " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append line $sep
		set next {}
		append next [lindex $arg 0]
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
611
612
613
614
615
616



617
618
619
620
621
622
623
624
625

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
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
611
612
613



614
615
616
617
618
619
620
621
622
623
624
625
626
627
628



629
630
631
632
633
634
635







-
-
+
-
-
+
+




















-
+




-
+

















-





-
-
-
-
-




+
+
+


-
-
-
-



+


-
+













-
-
-















-
-
-







		}
		append line $next
		set sep ", "
	    }
	    append line ")"
	}
    }
    if {[string range $rtype end-5 end] eq "MP_WUR"} {
	append line " MP_WUR"
    append text $line ";"
    }
    return "$text$line;\n"
    format "#ifndef %s_TCL_DECLARED\n#define %s_TCL_DECLARED\n%s\n#endif\n" \
	    $fname $fname $text
}

# genStubs::makeMacro --
#
#	Generate the inline macro for a function.
#
# Arguments:
#	name	The interface name.
#	decl	The function declaration.
#	index	The slot index for this function.
#
# Results:
#	Returns the formatted macro definition.

proc genStubs::makeMacro {name decl index} {
    lassign $decl rtype fname args

    set lfname [string tolower [string index $fname 0]]
    append lfname [string range $fname 1 end]

    set text "#define $fname \\\n\t("
    set text "#ifndef $fname\n#define $fname \\\n\t("
    if {$args eq ""} {
	append text "*"
    }
    append text "${name}StubsPtr->$lfname)"
    append text " /* $index */\n"
    append text " /* $index */\n#endif\n"
    return $text
}

# genStubs::makeSlot --
#
#	Generate the stub table entry for a function.
#
# Arguments:
#	name	The interface name.
#	decl	The function declaration.
#	index	The slot index for this function.
#
# Results:
#	Returns the formatted table entry.

proc genStubs::makeSlot {name decl index} {
    lassign $decl rtype fname args
    variable stubs

    set lfname [string tolower [string index $fname 0]]
    append lfname [string range $fname 1 end]

    set text "    "
    if {[info exists stubs($name,deprecated,$index)]} {
	append text "TCL_DEPRECATED_API(\"$stubs($name,deprecated,$index)\") "
    } elseif {[info exists stubs($name,nostub,$index)]} {
	append text "TCL_DEPRECATED_API(\"$stubs($name,nostub,$index)\") "
    }
    if {$args eq ""} {
	append text $rtype " *" $lfname "; /* $index */\n"
	return $text
    }
    if {$rtype ne "void"} {
	regsub -all void $rtype VOID rtype
    }
    if {[string range $rtype end-8 end] eq "__stdcall"} {
	append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
    } elseif {[string range $rtype 0 11] eq "TCL_NORETURN"} {
	append text "TCL_NORETURN1 " [string trim [string range $rtype 12 end]] " (*" $lfname ") "
    } elseif {[string range $rtype end-5 end] eq "MP_WUR"} {
	append text [string trim [string range $rtype 0 end-6]] " (*" $lfname ") "
    } else {
	append text $rtype " (*" $lfname ") "
    }
    regsub -all void $args VOID args
    set arg1 [lindex $args 0]
    switch -exact $arg1 {
	void {
	VOID {
	    append text "(void)"
	}
	TCL_VARARGS {
	    set sep "("
	    foreach arg [lrange $args 1 end] {
		append text $sep [lindex $arg 0]
		if {[string index $text end] ne "*"} {
		    append text " "
		}
		append text [lindex $arg 1] [lindex $arg 2]
		set sep ", "
	    }
	    append text ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append text " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append text $sep [lindex $arg 0]
		if {[string index $text end] ne "*"} {
		    append text " "
		}
		append text [lindex $arg 1] [lindex $arg 2]
		set sep ", "
	    }
	    append text ")"
	}
    }

    if {[string range $rtype end-5 end] eq "MP_WUR"} {
	append text " MP_WUR"
    }
    append text "; /* $index */\n"
    return $text
}

# genStubs::makeInit --
#
#	Generate the prototype for a function.
719
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734
735
736
737
738
739
685
686
687
688
689
690
691

692






693
694
695
696
697
698
699







-
+
-
-
-
-
-
-







	    if {$stubs($plat) > $lastNum} {
		set lastNum $stubs($plat)
	    }
	}
	for {set i 0} {$i <= $lastNum} {incr i} {
	    set slots [array names stubs $name,*,$i]
	    set emit 0
	    if {[info exists stubs($name,deprecated,$i)]} {
	    if {[info exists stubs($name,generic,$i)]} {
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
	    } elseif {[info exists stubs($name,nostub,$i)]} {
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
	    } elseif {[info exists stubs($name,generic,$i)]} {
		if {[llength $slots] > 1} {
		    puts stderr "conflicting generic and platform entries:\
			    $name $i"
		}
		append text [$slotProc $name $stubs($name,generic,$i) $i]
		set emit 1
	    } elseif {[llength $slots] > 0} {
990
991
992
993
994
995
996
997


998
999
1000
1001
1002


1003
1004
1005
1006
1007
1008
1009
950
951
952
953
954
955
956

957
958
959
960
961
962

963
964
965
966
967
968
969
970
971







-
+
+




-
+
+







#	None.

proc genStubs::emitMacros {name textVar} {
    variable libraryName
    upvar $textVar text

    set upName [string toupper $libraryName]
    append text "\n#if defined(USE_${upName}_STUBS)\n"
    append text "\n#if defined(USE_${upName}_STUBS) &&\
	    !defined(USE_${upName}_STUB_PROCS)\n"
    append text "\n/*\n * Inline function declarations:\n */\n\n"

    forAllStubs $name makeMacro 0 text

    append text "\n#endif /* defined(USE_${upName}_STUBS) */\n"
    append text "\n#endif /* defined(USE_${upName}_STUBS) &&\
	    !defined(USE_${upName}_STUB_PROCS) */\n"
    return
}

# genStubs::emitHeader --
#
#	This function emits the body of the <name>Decls.h file for
#	the specified interface.
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
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







-
+



-
+









-
-
+
-
-
-





-
+







    }

    append text "\n#ifdef __cplusplus\nextern \"C\" {\n#endif\n"

    emitDeclarations $name text

    if {[info exists hooks($name)]} {
	append text "\ntypedef struct {\n"
	append text "\ntypedef struct ${capName}StubHooks {\n"
	foreach hook $hooks($name) {
	    set capHook [string toupper [string index $hook 0]]
	    append capHook [string range $hook 1 end]
	    append text "    const struct ${capHook}Stubs *${hook}Stubs;\n"
	    append text "    struct ${capHook}Stubs *${hook}Stubs;\n"
	}
	append text "} ${capName}StubHooks;\n"
    }
    append text "\ntypedef struct ${capName}Stubs {\n"
    append text "    int magic;\n"
    if {$epoch ne ""} {
	append text "    int epoch;\n"
	append text "    int revision;\n"
    }
    if {[info exists hooks($name)]} {
	append text "    const ${capName}StubHooks *hooks;\n\n"
    append text "    struct ${capName}StubHooks *hooks;\n\n"
    } else {
	append text "    void *hooks;\n\n"
    }

    emitSlots $name text

    append text "} ${capName}Stubs;\n\n"

    append text "extern const ${capName}Stubs *${name}StubsPtr;\n\n"
    append text "extern ${capName}Stubs *${name}StubsPtr;\n\n"
    append text "#ifdef __cplusplus\n}\n#endif\n"

    emitMacros $name text

    rewriteFile [file join $outDir ${name}Decls.h] $text
    return
}
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
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







-


-





-
+







-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-








-
+


-
+







#	textVar		The variable to use for output.
#
# Results:
#	Returns the formatted output.

proc genStubs::emitInit {name textVar} {
    variable hooks
    variable interfaces
    variable epoch
    upvar $textVar text
    set root 1

    set capName [string toupper [string index $name 0]]
    append capName [string range $name 1 end]

    if {[info exists hooks($name)]} {
	append text "\nstatic const ${capName}StubHooks ${name}StubHooks = \{\n"
	append text "\nstatic ${capName}StubHooks ${name}StubHooks = \{\n"
	set sep "    "
	foreach sub $hooks($name) {
	    append text $sep "&${sub}Stubs"
	    set sep ",\n    "
	}
	append text "\n\};\n"
    }
    foreach intf [array names interfaces] {
	if {[info exists hooks($intf)]} {
	    if {[lsearch -exact $hooks($intf) $name] >= 0} {
		set root 0
		break
	    }
	}
    }

    append text "\n"
    append text "\n${capName}Stubs ${name}Stubs = \{\n"
    if {!$root} {
	append text "static "
    append text "    TCL_STUB_MAGIC,\n"
    }
    append text "const ${capName}Stubs ${name}Stubs = \{\n    TCL_STUB_MAGIC,\n"
    if {$epoch ne ""} {
	set CAPName [string toupper $name]
	append text "    ${CAPName}_STUBS_EPOCH,\n"
	append text "    ${CAPName}_STUBS_REVISION,\n"
    }
    if {[info exists hooks($name)]} {
	append text "    &${name}StubHooks,\n"
    } else {
	append text "    0,\n"
	append text "    NULL,\n"
    }

    forAllStubs $name makeInit 1 text {"    0, /* $i */\n"}
    forAllStubs $name makeInit 1 text {"    NULL, /* $i */\n"}

    append text "\};\n"
    return
}

# genStubs::emitInits --
#
1187
1188
1189
1190
1191
1192
1193
1194

1195
1196
1197
1198
1199
1200
1201
1131
1132
1133
1134
1135
1136
1137

1138
1139
1140
1141
1142
1143
1144
1145







-
+







	puts stderr "usage: $argv0 outDir declFile ?declFile...?"
	exit 1
    }

    set outDir [lindex $argv 0]

    foreach file [lrange $argv 1 end] {
	source $file
	source -encoding utf-8 $file
    }

    foreach name [lsort [array names interfaces]] {
	puts "Emitting $name"
	emitHeader $name
    }

1209
1210
1211
1212
1213
1214
1215
1216

1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1153
1154
1155
1156
1157
1158
1159

1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170







-
+










# Arguments:
#	valueList	A list containing the values to be assigned.
#	args		The list of variables to be assigned.
#
# Results:
#	Returns any values that were not assigned to variables.

if {[string length [namespace which lassign]] == 0} {
if {[namespace which lassign] ne ""} {
    proc lassign {valueList args} {
	if {[llength $args] == 0} {
	    error "wrong # args: should be \"lassign list varName ?varName ...?\""
	}
	uplevel [list foreach $args $valueList {break}]
	return [lrange $valueList [llength $args] end]
    }
}

genStubs::init

Deleted tools/installVfs.tcl.

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






















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#!/bin/sh
#\
exec tclsh "$0" ${1+"$@"}

#----------------------------------------------------------------------
#
# installVfs.tcl --
#
#        This file wraps the /library file system around a binary
#
#----------------------------------------------------------------------
#
# Copyright (c) 2018 by Sean Woods.  All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------

proc mapDir {resultvar prefix filepath} {
    upvar 1 $resultvar result
    if {![info exists result]} {
      set result {}
    }
    set queue [list $prefix $filepath]
    while {[llength $queue]} {
      set queue [lassign $queue qprefix qpath]
      foreach ftail [glob -directory $qpath -nocomplain -tails *] {
          set f [file join $qpath $ftail]
          if {[file isdirectory $f]} {
            if {$ftail eq "CVS"} continue
            lappend queue [file join $qprefix $ftail] $f
          } elseif {[file isfile $f]} {
              if {$ftail eq "pkgIndex.tcl"} continue
              if {$ftail eq "manifest.txt"} {
                lappend result $f [file join $qprefix pkgIndex.tcl]
              } else {
                lappend result $f [file join $qprefix $ftail]
              }
          }
       }
    }
}
if {[llength $argv]<4} {
  error "Usage: [file tail [info script]] IMG_OUTPUT IMG_INPUT PREFIX FILE_SYSTEM ?PREFIX FILE_SYSTEM?..."
}

set paths [lassign $argv DLL_OUTPUT DLL_INPUT]
foreach {prefix fpath} $paths {
  mapDir files $prefix [file normalize $fpath]
}
if {$DLL_INPUT != {}} {
  zipfs lmkzip $DLL_OUTPUT $files
} else {
  zipfs lmkimg $DLL_OUTPUT $files {} $DLL_INPUT
}

Changes to tools/loadICU.tcl.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
23
24
25
26
27
28
29



30
31
32
33
34
35
36







-
-
-







#----------------------------------------------------------------------
#
# Copyright (c) 2004 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.
#----------------------------------------------------------------------

puts stdout "TODO: output in UTF-8 in stead of using \\uhhhh sequences"
exit; # Remove those two lines after modifying this tool.

# Calculate the Chinese numerals from zero to ninety-nine.

set zhDigits [list {} \u4e00 \u4e8c \u4e09 \u56db \
		  \u4e94 \u516d \u4e03 \u516b \u4e5d]
set t 0
foreach zt $zhDigits {
    if { $t == 0 } {

Deleted tools/makeHeader.tcl.

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






















































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# makeHeader.tcl --
#
#	This script generates embeddable C source (in a .h file) from a .tcl
#	script.
#
# Copyright (c) 2018 Donal K. Fellows
#
# 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

namespace eval makeHeader {

    ####################################################################
    #
    # mapSpecial --
    #	Transform a single line so that it is able to be put in a C string.
    #
    proc mapSpecial {str} {
	# All Tcl metacharacters and key C backslash sequences
	set MAP {
	    \" \\\\\" \\ \\\\\\\\ $ \\$ [ \\[ ] \\] ' \\\\' ? \\\\?
	    \a \\\\a \b \\\\b \f \\\\f \n \\\\n \r \\\\r \t \\\\t \v \\\\v
	}
	set XFORM {[format \\\\\\\\u%04x {*}[scan & %c]]}

	subst [regsub -all {[^\u0020-\u007e]} [string map $MAP $str] $XFORM]
    }

    ####################################################################
    #
    # compactLeadingSpaces --
    #	Converts the leading whitespace on a line into a more compact form.
    #
    proc compactLeadingSpaces {line} {
	set line [string map {\t {        }} [string trimright $line]]
	if {[regexp {^[ ]+} $line spaces]} {
	    regsub -all {[ ]{4}} $spaces \t replace
	    set len [expr {[string length $spaces] - 1}]
	    set line [string replace $line 0 $len $replace]
	}
	return $line
    }

    ####################################################################
    #
    # processScript --
    #	Transform a whole sequence of lines with [mapSpecial].
    #
    proc processScript {scriptLines} {
	lmap line $scriptLines {
	    # Skip blank and comment lines; they're there in the original
	    # sources so we don't need to copy them over.
	    if {[regexp {^\s*(?:#|$)} $line]} continue
	    format {"%s"} [mapSpecial [compactLeadingSpaces $line]\n]
	}
    }

    ####################################################################
    #
    # updateTemplate --
    #	Rewrite a template to contain the content from the input script.
    #
    proc updateTemplate {dataVar scriptLines} {
	set BEGIN "*!BEGIN!: Do not edit below this line.*"
	set END "*!END!: Do not edit above this line.*"

	upvar 1 $dataVar data

	set from [lsearch -glob $data $BEGIN]
	set to [lsearch -glob $data $END]
	if {$from < 0 || $to < 0 || $from >= $to} {
	    throw BAD "not a template"
	}

	set data [lreplace $data $from+1 $to-1 {*}[processScript $scriptLines]]
    }

    ####################################################################
    #
    # stripSurround --
    #	Removes the header and footer comments from a (line-split list of
    #	lines of) Tcl script code.
    #
    proc stripSurround {lines} {
	set RE {^\s*$|^#}
	set state 0
	set lines [lmap line [lreverse $lines] {
	    if {!$state && [regexp $RE $line]} continue {
		set state 1
		set line
	    }
	}]
	return [lmap line [lreverse $lines] {
	    if {$state && [regexp $RE $line]} continue {
		set state 0
		set line
	    }
	}]
    }

    ####################################################################
    #
    # updateTemplateFile --
    #	Rewrites a template file with the lines of the given script.
    #
    proc updateTemplateFile {headerFile scriptLines} {
	set f [open $headerFile "r+"]
	try {
	    set content [split [chan read -nonewline $f] "\n"]
	    updateTemplate content [stripSurround $scriptLines]
	    chan seek $f 0
	    chan puts $f [join $content \n]
	    chan truncate $f
	} trap BAD msg {
	    # Add the filename to the message
	    throw BAD "${headerFile}: $msg"
	} finally {
	    chan close $f
	}
    }

    ####################################################################
    #
    # readScript --
    #	Read a script from a file and return its lines.
    #
    proc readScript {script} {
	set f [open $script]
	try {
	    chan configure $f -encoding utf-8
	    return [split [string trim [chan read $f]] "\n"]
	} finally {
	    chan close $f
	}
    }

    ####################################################################
    #
    # run --
    #	The main program of this script.
    #
    proc run {args} {
	try {
	    if {[llength $args] != 2} {
		throw ARGS "inputTclScript templateFile"
	    }
	    lassign $args inputTclScript templateFile

	    puts "Inserting $inputTclScript into $templateFile"
	    set scriptLines [readScript $inputTclScript]
	    updateTemplateFile $templateFile $scriptLines
	    exit 0
	} trap ARGS msg {
	    puts stderr "wrong # args: should be \"[file tail $::argv0] $msg\""
	    exit 2
	} trap BAD msg {
	    puts stderr $msg
	    exit 1
	} trap POSIX msg {
	    puts stderr $msg
	    exit 1
	} on error {- opts} {
	    puts stderr [dict get $opts -errorinfo]
	    exit 3
	}
    }
}

########################################################################
#
# Launch the main program
#
if {[info script] eq $::argv0} {
    makeHeader::run {*}$::argv
}

# Local-Variables:
# mode: tcl
# fill-column: 78
# End:

Deleted tools/mkVfs.tcl.

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



































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
proc cat fname {
    set fname [open $fname r]
    set data [read $fname]
    close $fname
    return $data
}

proc pkgIndexDir {root fout d1} {

    puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \
	      [file tail $d1]]
    set idx [string length $root]
    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
        set f [file join $d1 $ftail]
        if {[file isdirectory $f] && [string compare CVS $ftail]} {
            pkgIndexDir $root $fout $f
        } elseif {[file tail $f] eq "pkgIndex.tcl"} {
      	    puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]"
	          puts $fout [cat $f]
	      }
    }
}

###
# Script to build the VFS file system
###
proc copyDir {d1 d2} {

    puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
	      [file tail $d2]]

    file delete -force -- $d2
    file mkdir $d2

    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
        set f [file join $d1 $ftail]
        if {[file isdirectory $f] && [string compare CVS $ftail]} {
            copyDir $f [file join $d2 $ftail]
        } elseif {[file isfile $f]} {
      	    file copy -force $f [file join $d2 $ftail]
	          if {$::tcl_platform(platform) eq {unix}} {
            		file attributes [file join $d2 $ftail] -permissions 0644
      	    } else {
            		file attributes [file join $d2 $ftail] -readonly 1
	          }
	      }
    }

    if {$::tcl_platform(platform) eq {unix}} {
      	file attributes $d2 -permissions 0755
    } else {
	      file attributes $d2 -readonly 1
    }
}

if {[llength $argv] < 3} {
    puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"
    exit 1
}
set TCL_SCRIPT_DIR [lindex $argv 0]
set TCLSRC_ROOT    [lindex $argv 1]
set PLATFORM       [lindex $argv 2]
set TKDLL          [lindex $argv 3]
set TKVER          [lindex $argv 4]

puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM"
copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR}

if {$PLATFORM == "windows"} {
    set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
    puts "DDE DLL $ddedll"
    if {$ddedll != {}} {
      	file copy $ddedll ${TCL_SCRIPT_DIR}/dde
    }
    set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
    puts "REG DLL $ddedll"
    if {$regdll != {}} {
      	file copy $regdll ${TCL_SCRIPT_DIR}/reg
    }
} else {
    # Remove the dde and reg package paths
    file delete -force ${TCL_SCRIPT_DIR}/dde
    file delete -force ${TCL_SCRIPT_DIR}/reg
}

# For the following packages, cat their pkgIndex files to tclIndex
file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0
set fout [open ${TCL_SCRIPT_DIR}/tclIndex a]
puts $fout {#
# MANIFEST OF INCLUDED PACKAGES
#
set VFSROOT $dir
}
if {$TKDLL ne {} && [file exists $TKDLL]} {
  file copy $TKDLL ${TCL_SCRIPT_DIR}
  puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"]
}
pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR}
close $fout

Changes to tools/str2c.

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
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







-
+


-
+








-
+







 * Single part writeable string generated by str2c
 */
static char data\[\]=\"[translate $r]\";"
} else {
    puts "/*
 * Multi parts read only string generated by str2c
 */
static const char * const data\[\]= {"
static CONST char * CONST data\[\]= {"
    set n 1
    for {set i 0} {$i<$lg} {incr i $MAX} {
	set part [string range $r $i [expr {$i+$MAX-1}]]
	set part [string range $r $i [expr $i+$MAX-1]]
	set len  [string length $part];
	puts "\t/* Start of part $n ($len characters) */"
	puts "\t\"[translate $part]\","
	puts "\t/* End of part $n */\n"
	incr n
    }
    puts "\tNULL\t/* End of data marker */\n};"
    puts "\n/* use for instance with:
    const char * const *chunk;
    CONST char * CONST *chunk;
    for (chunk=data; *chunk; chunk++) {
        Tcl_AppendResult(interp, *chunk, (char *) NULL);
    }
*/"
}


Changes to tools/tcl.hpj.in.

1
2
3
4
5
6
7
8

9
10

11
12
13
14
15
16
17
1
2
3
4
5
6
7

8
9

10
11
12
13
14
15
16
17







-
+

-
+







; This file is maintained by HCW. Do not modify this file directly.

[OPTIONS]
HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
CNT=tcl90.cnt
CNT=tcl85.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
HLP=tcl90.hlp
HLP=tcl85.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

Added tools/tcl.wse.in.









































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Document Type: WSE
item: Global
  Version=6.01
  Title=Tcl 8.5 for Windows Installation
  Flags=00010100
  Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
  Japanese Font Name=MS Gothic
  Japanese Font Size=10
  Start Gradient=0 0 255
  End Gradient=0 0 0
  Windows Flags=00000000000000010010110000001000
  Log Pathname=%MAINDIR%\INSTALL.LOG
  Message Font=MS Sans Serif
  Font Size=8
  Disk Label=tcl8.5.19
  Disk Filename=setup
  Patch Flags=0000000000000001
  Patch Threshold=85
  Patch Memory=4000
  Variable Name1=_SYS_
  Variable Default1=C:\WINDOWS\SYSTEM
  Variable Flags1=00001000
  Variable Name2=_ODBC16_
  Variable Default2=C:\WINDOWS\SYSTEM
  Variable Flags2=00001000
  Variable Name3=_WISE_
  Variable Default3=${__WISE__}
  Variable Flags3=00001000
end
item: Open/Close INSTALL.LOG
  Flags=00000001
end
item: Check if File/Dir Exists
  Pathname=%SYS%
  Flags=10000100
end
item: Set Variable
  Variable=SYS
  Value=%WIN%
end
item: End Block
end
item: Set Variable
  Variable=VER
  Value=8.5
end
item: Set Variable
  Variable=PATCHLEVEL
  Value=${__TCL_PATCH_LEVEL__}
end
item: Set Variable
  Variable=APPTITLE
  Value=Tcl/Tk %PATCHLEVEL% for Windows
end
item: Set Variable
  Variable=URL
  Value=http://www.tcl.tk/
end
item: Set Variable
  Variable=GROUP
  Value=Tcl
end
item: Set Variable
  Variable=DISABLED
  Value=!
end
item: Set Variable
  Variable=MAINDIR
  Value=Tcl
end
item: Check Configuration
  Flags=10111011
end
item: Get Registry Key Value
  Variable=PROGRAM_FILES
  Key=SOFTWARE\Microsoft\Windows\CurrentVersion
  Default=C:\Program Files
  Value Name=ProgramFilesDir
  Flags=00000100
end
item: Set Variable
  Variable=MAINDIR
  Value=%PROGRAM_FILES%\%MAINDIR%
end
item: Set Variable
  Variable=EXPLORER
  Value=1
end
item: Else Statement
end
item: Set Variable
  Variable=MAINDIR
  Value=C:\%MAINDIR%
end
item: End Block
end
item: Set Variable
  Variable=BACKUP
  Value=%MAINDIR%\BACKUP
end
item: Set Variable
  Variable=DOBACKUP
  Value=B
end
item: Set Variable
  Variable=BRANDING
  Value=0
end
remarked item: If/While Statement
  Variable=BRANDING
  Value=1
end
remarked item: Read INI Value
  Variable=NAME
  Pathname=%INST%\CUSTDATA.INI
  Section=Registration
  Item=Name
end
remarked item: Read INI Value
  Variable=COMPANY
  Pathname=%INST%\CUSTDATA.INI
  Section=Registration
  Item=Company
end
remarked item: If/While Statement
  Variable=NAME
end
remarked item: Set Variable
  Variable=DOBRAND
  Value=1
end
remarked item: End Block
end
remarked item: End Block
end
item: Set Variable
  Variable=TYPE
  Value=C
end
item: Set Variable
  Variable=COMPONENTS
  Value=ABC
end
item: Wizard Block
  Direction Variable=DIRECTION
  Display Variable=DISPLAY
  X Position=0
  Y Position=0
  Filler Color=8421440
  Flags=00000001
end
item: Custom Dialog Set
  Name=Splash
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Bienvenue
    Title German=Willkommen
    Title Portuguese=Bem-vindo
    Title Spanish=Bienvenido
    Title Italian=Benvenuto
    Title Danish=Velkommen
    Title Dutch=Welkom
    Title Norwegian=Velkommen
    Title Swedish=Välkommen
    Width=273
    Height=250
    Font Name=Helv
    Font Size=8
    item: Push Button
      Rectangle=166 214 208 228
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Next >
    end
    item: Push Button
      Rectangle=212 214 254 228
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=Cancel
    end
    item: Static
      Rectangle=0 0 268 233
      Action=2
      Enabled Color=00000000000000001111111111111111
      Create Flags=01010000000000000000000000001011
      Pathname=${__TCLBASEDIR__}\tools\white.bmp
    end
    item: Static
      Rectangle=5 5 268 215
      Destination Dialog=1
      Action=2
      Enabled Color=00000000000000001111111111111111
      Create Flags=01010000000000000000000000001011
      Pathname=${__TCLBASEDIR__}\tools\tclSplash.bmp
    end
  end
end
item: End Block
end
item: Wizard Block
  Direction Variable=DIRECTION
  Display Variable=DISPLAY
  Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
  X Position=9
  Y Position=10
  Filler Color=8421440
  Dialog=Welcome
  Dialog=Select Destination Directory
  Dialog=Select Installation Type
  Dialog=Select Components
  Dialog=Select Program Manager Group
  Variable=
  Variable=
  Variable=
  Variable=TYPE
  Variable=EXPLORER
  Value=
  Value=
  Value=
  Value=C
  Value=1
  Compare=0
  Compare=0
  Compare=0
  Compare=1
  Compare=0
  Flags=00000011
end
item: Custom Dialog Set
  Name=Welcome
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Installation de %APPTITLE%
    Title German=Installation von %APPTITLE%
    Title Spanish=Instalación de %APPTITLE%
    Title Italian=Installazione di %APPTITLE%
    Width=271
    Height=224
    Font Name=Helv
    Font Size=8
    item: Static
      Rectangle=86 8 258 42
      Create Flags=01010000000000000000000000000000
      Flags=0000000000000001
      Name=Times New Roman
      Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
      Text=Welcome!
      Text French=Bienvenue !
      Text German=Willkommen!
      Text Spanish=¡Bienvenido!
      Text Italian=Benvenuti!
    end
    item: Push Button
      Rectangle=150 187 195 202
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Next >
      Text French=&Suite >
      Text German=&Weiter >
      Text Spanish=&Siguiente >
      Text Italian=&Avanti >
    end
    item: Push Button
      Rectangle=105 187 150 202
      Variable=DISABLED
      Value=!
      Create Flags=01010000000000010000000000000000
      Text=< &Back
      Text French=< &Retour
      Text German=< &Zurück
      Text Spanish=< &Atrás
      Text Italian=< &Indietro
    end
    item: Push Button
      Rectangle=211 187 256 202
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=&Cancel
      Text French=&Annuler
      Text German=&Abbrechen
      Text Spanish=&Cancelar
      Text Italian=&Annulla
    end
    item: Static
      Rectangle=85 41 255 130
      Create Flags=01010000000000000000000000000000
      Text=This installation program will install %APPTITLE%.
      Text=
      Text=Press the Next button to start the installation. You can press the Exit Setup button now if you do not want to install %APPTITLE% at this time.
      Text=
      Text=It is strongly recommended that you exit all Windows programs before running this installation program.
      Text French=Ce programme d'installation va installer %APPTITLE%.
      Text French=
      Text French=Cliquez sur le bouton Suite pour démarrer l'installation. Vous pouvez cliquer sur le bouton Quitter l'installation si vous ne voulez pas installer %APPTITLE% tout de suite.
      Text German=Mit diesem Installationsprogramm wird %APPTITLE% installiert.
      Text German=
      Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Abbrechen", um die Installation von %APPTITLE% abzubrechen.
      Text Spanish=Este programa de instalación instalará %APPTITLE%.
      Text Spanish=
      Text Spanish=Presione el botón Siguiente para iniciar la instalación. Puede presionar el botón Salir de instalación si no desea instalar %APPTITLE% en este momento.
      Text Italian=Questo programma installerà %APPTITLE%.
      Text Italian=
      Text Italian=Per avvviare l'installazione premere il pulsante Avanti. Se non si desidera installare %APPTITLE% ora, premere il pulsante Esci dall'installazione.
    end
    item: Static
      Rectangle=8 180 256 181
      Action=3
      Create Flags=01010000000000000000000000000111
    end
  end
end
item: Custom Dialog Set
  Name=Select Destination Directory
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Installation de %APPTITLE%
    Title German=Installation von %APPTITLE%
    Title Spanish=Instalación de %APPTITLE%
    Title Italian=Installazione di %APPTITLE%
    Width=271
    Height=224
    Font Name=Helv
    Font Size=8
    item: Push Button
      Rectangle=150 187 195 202
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Next >
      Text French=&Suite >
      Text German=&Weiter >
      Text Spanish=&Siguiente >
      Text Italian=&Avanti >
    end
    item: Push Button
      Rectangle=105 187 150 202
      Variable=DIRECTION
      Value=B
      Create Flags=01010000000000010000000000000000
      Flags=0000000000000001
      Text=< &Back
      Text French=< &Retour
      Text German=< &Zurück
      Text Spanish=< &Atrás
      Text Italian=< &Indietro
    end
    item: Push Button
      Rectangle=211 187 256 202
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=&Cancel
      Text French=&Annuler
      Text German=&Abbrechen
      Text Spanish=&Cancelar
      Text Italian=&Annulla
    end
    item: Static
      Rectangle=8 180 256 181
      Action=3
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 8 258 42
      Create Flags=01010000000000000000000000000000
      Flags=0000000000000001
      Name=Times New Roman
      Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
      Text=Select Destination Directory
      Text French=Sélectionner le répertoire de destination
      Text German=Zielverzeichnis wählen
      Text Spanish=Seleccione el directorio de destino
      Text Italian=Selezionare Directory di destinazione
    end
    item: Static
      Rectangle=86 39 256 114
      Create Flags=01010000000000000000000000000000
      Text=Please select the directory where the %APPTITLE% files are to be installed.
      Text=
      Text=To install in the default directory below, click Next.
      Text=
      Text=To install in a different directory, click Browse and select another directory.
      Text French=Veuillez sélectionner le répertoire dans lequel les fichiers %APPTITLE% doivent être installés.
      Text German=Geben Sie an, in welchem Verzeichnis die %APPTITLE%-Dateien installiert werden sollen.
      Text Spanish=Por favor seleccione el directorio donde desee instalar los archivos de %APPTITLE%.
      Text Italian=Selezionare la directory dove verranno installati i file %APPTITLE%.
    end
    item: Static
      Rectangle=86 130 256 157
      Action=1
      Create Flags=01010000000000000000000000000111
    end
    item: Push Button
      Rectangle=205 138 250 153
      Variable=MAINDIR_SAVE
      Value=%MAINDIR%
      Destination Dialog=1
      Action=2
      Create Flags=01010000000000010000000000000000
      Text=Browse
      Text French=Parcourir
      Text German=Durchsuchen
      Text Spanish=Buscar
      Text Italian=Sfoglie
    end
    item: Static
      Rectangle=91 140 198 151
      Create Flags=01010000000000000000000000000000
      Text=%MAINDIR%
      Text French=%MAINDIR%
      Text German=%MAINDIR%
      Text Spanish=%MAINDIR%
      Text Italian=%MAINDIR%
    end
  end
  item: Dialog
    Title=Select Destination Directory
    Title French=Sélectionner le répertoire de destination
    Title German=Zielverzeichnis wählen
    Title Spanish=Seleccione el directorio de destino
    Title Italian=Selezionare Directory di destinazione
    Width=221
    Height=173
    Font Name=Helv
    Font Size=8
    item: Listbox
      Rectangle=5 5 163 149
      Variable=MAINDIR
      Create Flags=01010000100000010000000101000000
      Flags=0000110000100010
      Text=%MAINDIR%
      Text French=%MAINDIR%
      Text German=%MAINDIR%
      Text Spanish=%MAINDIR%
      Text Italian=%MAINDIR%
    end
    item: Push Button
      Rectangle=167 6 212 21
      Create Flags=01010000000000010000000000000001
      Text=OK
      Text French=OK
      Text German=OK
      Text Spanish=Aceptar
      Text Italian=OK
    end
    item: Push Button
      Rectangle=167 25 212 40
      Variable=MAINDIR
      Value=%MAINDIR_SAVE%
      Create Flags=01010000000000010000000000000000
      Flags=0000000000000001
      Text=Cancel
      Text French=Annuler
      Text German=Abbrechen
      Text Spanish=Cancelar
      Text Italian=Annulla
    end
  end
end
remarked item: Custom Dialog Set
  Name=Select Installation Type
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Installation de %APPTITLE%
    Title German=Installation von %APPTITLE%
    Title Spanish=Instalación de %APPTITLE%
    Title Italian=Installazione di %APPTITLE%
    Width=271
    Height=224
    Font Name=Helv
    Font Size=8
    item: Push Button
      Rectangle=150 187 195 202
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Next >
      Text French=&Suite >
      Text German=&Weiter >
      Text Spanish=&Siguiente >
      Text Italian=&Avanti >
    end
    item: Push Button
      Rectangle=105 187 150 202
      Variable=DIRECTION
      Value=B
      Create Flags=01010000000000010000000000000000
      Text=< &Back
      Text French=< &Retour
      Text German=< &Zurück
      Text Spanish=< &Atrás
      Text Italian=< &Indietro
    end
    item: Push Button
      Rectangle=211 187 256 202
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=&Cancel
      Text French=&Annuler
      Text German=&Abbrechen
      Text Spanish=&Cancelar
      Text Italian=&Annulla
    end
    item: Static
      Rectangle=8 180 256 181
      Action=3
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 8 258 42
      Create Flags=01010000000000000000000000000000
      Flags=0000000000000001
      Name=Times New Roman
      Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
      Text=Select Installation Type
      Text French=Sélectionner les composants
      Text German=Komponenten auswählen
      Text Spanish=Seleccione componentes
      Text Italian=Selezionare i componenti
    end
    item: Static
      Rectangle=194 162 242 172
      Variable=COMPONENTS
      Value=MAINDIR
      Create Flags=01010000000000000000000000000010
    end
    item: Static
      Rectangle=194 153 242 162
      Variable=COMPONENTS
      Create Flags=01010000000000000000000000000010
    end
    item: Static
      Rectangle=107 153 196 164
      Create Flags=01010000000000000000000000000000
      Text=Disk Space Required:
      Text French=Espace disque requis :
      Text German=Notwendiger Speicherplatz:
      Text Spanish=Espacio requerido en el disco:
      Text Italian=Spazio su disco necessario:
    end
    item: Static
      Rectangle=107 162 196 172
      Create Flags=01010000000000000000000000000000
      Text=Disk Space Remaining:
      Text French=Espace disque disponible :
      Text German=Verbleibender Speicherplatz:
      Text Spanish=Espacio en disco disponible:
      Text Italian=Spazio su disco disponibile:
    end
    item: Static
      Rectangle=86 145 256 175
      Action=1
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 42 256 61
      Create Flags=01010000000000000000000000000000
      Text=Choose which type of installation to perform by selecting one of the buttons below.
      Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
      Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
      Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
      Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
    end
    item: Radio Button
      Rectangle=86 74 256 128
      Variable=TYPE
      Create Flags=01010000000000010000000000001001
      Text=&Full Installation (Recommended)
      Text=&Minimal Installation
      Text=C&ustom Installation
      Text=
    end
  end
end
item: Custom Dialog Set
  Name=Select Components
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Installation de %APPTITLE%
    Title German=Installation von %APPTITLE%
    Title Spanish=Instalación de %APPTITLE%
    Title Italian=Installazione di %APPTITLE%
    Width=271
    Height=224
    Font Name=Helv
    Font Size=8
    item: Push Button
      Rectangle=150 187 195 202
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Next >
      Text French=&Suite >
      Text German=&Weiter >
      Text Spanish=&Siguiente >
      Text Italian=&Avanti >
    end
    item: Push Button
      Rectangle=105 187 150 202
      Variable=DIRECTION
      Value=B
      Create Flags=01010000000000010000000000000000
      Text=< &Back
      Text French=< &Retour
      Text German=< &Zurück
      Text Spanish=< &Atrás
      Text Italian=< &Indietro
    end
    item: Push Button
      Rectangle=211 187 256 202
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=&Cancel
      Text French=&Annuler
      Text German=&Abbrechen
      Text Spanish=&Cancelar
      Text Italian=&Annulla
    end
    item: Static
      Rectangle=8 180 256 181
      Action=3
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 8 258 42
      Create Flags=01010000000000000000000000000000
      Flags=0000000000000001
      Name=Times New Roman
      Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
      Text=Select Components
      Text French=Sélectionner les composants
      Text German=Komponenten auswählen
      Text Spanish=Seleccione componentes
      Text Italian=Selezionare i componenti
    end
    item: Checkbox
      Rectangle=86 75 256 129
      Variable=COMPONENTS
      Create Flags=01010000000000010000000000000011
      Flags=0000000000000110
      Text=Tcl Run-Time Files
      Text=Example Scripts
      Text=Help Files
      Text=Header and Library Files
      Text=
      Text French=Tcl Run-Time Files
      Text French=Example Scripts
      Text French=Help Files
      Text French=Header and Library Files
      Text French=
      Text German=Tcl Run-Time Files
      Text German=Example Scripts
      Text German=Help Files
      Text German=Header and Library Files
      Text German=
      Text Spanish=Tcl Run-Time Files
      Text Spanish=Example Scripts
      Text Spanish=Help Files
      Text Spanish=Header and Library Files
      Text Spanish=
      Text Italian=Tcl Run-Time Files
      Text Italian=Example Scripts
      Text Italian=Help Files
      Text Italian=Header and Library Files
      Text Italian=
    end
    item: Static
      Rectangle=194 162 242 172
      Variable=COMPONENTS
      Value=MAINDIR
      Create Flags=01010000000000000000000000000010
    end
    item: Static
      Rectangle=194 153 242 162
      Variable=COMPONENTS
      Create Flags=01010000000000000000000000000010
    end
    item: Static
      Rectangle=107 153 196 164
      Create Flags=01010000000000000000000000000000
      Text=Disk Space Required:
      Text French=Espace disque requis :
      Text German=Notwendiger Speicherplatz:
      Text Spanish=Espacio requerido en el disco:
      Text Italian=Spazio su disco necessario:
    end
    item: Static
      Rectangle=107 162 196 172
      Create Flags=01010000000000000000000000000000
      Text=Disk Space Remaining:
      Text French=Espace disque disponible :
      Text German=Verbleibender Speicherplatz:
      Text Spanish=Espacio en disco disponible:
      Text Italian=Spazio su disco disponibile:
    end
    item: Static
      Rectangle=86 145 256 175
      Action=1
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 42 256 61
      Create Flags=01010000000000000000000000000000
      Text=Choose which components to install by checking the boxes below.
      Text French=Choisissez les composants que vous voulez installer en cochant les cases ci-dessous.
      Text German=Wählen Sie die zu installierenden Komponenten, indem Sie in die entsprechenden Kästchen klicken.
      Text Spanish=Elija los componentes que desee instalar marcando los cuadros de abajo.
      Text Italian=Scegliere quali componenti installare selezionando le caselle sottostanti.
    end
  end
end
item: Custom Dialog Set
  Name=Select Program Manager Group
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Installation de %APPTITLE%
    Title German=Installation von %APPTITLE%
    Title Spanish=Instalación de %APPTITLE%
    Title Italian=Installazione di %APPTITLE%
    Width=271
    Height=224
    Font Name=Helv
    Font Size=8
    item: Push Button
      Rectangle=150 187 195 202
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Next >
      Text French=&Suite >
      Text German=&Weiter >
      Text Spanish=&Siguiente >
      Text Italian=&Avanti >
    end
    item: Push Button
      Rectangle=105 187 150 202
      Variable=DIRECTION
      Value=B
      Create Flags=01010000000000010000000000000000
      Flags=0000000000000001
      Text=< &Back
      Text French=< &Retour
      Text German=< &Zurück
      Text Spanish=< &Atrás
      Text Italian=< &Indietro
    end
    item: Push Button
      Rectangle=211 187 256 202
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=&Cancel
      Text French=&Annuler
      Text German=&Abbrechen
      Text Spanish=&Cancelar
      Text Italian=&Annulla
    end
    item: Static
      Rectangle=8 180 256 181
      Action=3
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 8 258 42
      Create Flags=01010000000000000000000000000000
      Flags=0000000000000001
      Name=Times New Roman
      Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
      Text=Select ProgMan Group
      Text French=Sélectionner le groupe du Gestionnaire de programme
      Text German=Bestimmung der Programm-Managergruppe
      Text Spanish=Seleccione grupo del Administrador de programas
      Text Italian=Selezionare il gruppo ProgMan
    end
    item: Static
      Rectangle=86 44 256 68
      Create Flags=01010000000000000000000000000000
      Text=Enter the name of the Program Manager group to add the %APPTITLE% icons to:
      Text French=Entrez le nom du groupe du Gestionnaire de programme dans lequel vous souhaitez ajouter les icônes de %APPTITLE% :
      Text German=Geben Sie den Namen der Programmgruppe ein, der das Symbol %APPTITLE% hinzugefügt werden soll:
      Text Spanish=Escriba el nombre del grupo del Administrador de programas en el que desea agregar los iconos de %APPTITLE%:
      Text Italian=Inserire il nome del gruppo Program Manager per aggiungere le icone %APPTITLE% a:
    end
    item: Combobox
      Rectangle=86 69 256 175
      Variable=GROUP
      Create Flags=01010000000000010000001000000001
      Flags=0000000000000001
      Text=%GROUP%
      Text French=%GROUP%
      Text German=%GROUP%
      Text Spanish=%GROUP%
      Text Italian=%GROUP%
    end
  end
end
item: Custom Dialog Set
  Name=Start Installation
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Installation de %APPTITLE%
    Title German=Installation von %APPTITLE%
    Title Spanish=Instalación de %APPTITLE%
    Title Italian=Installazione di %APPTITLE%
    Width=271
    Height=224
    Font Name=Helv
    Font Size=8
    item: Push Button
      Rectangle=150 187 195 202
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Next >
      Text French=&Suite >
      Text German=&Weiter >
      Text Spanish=&Siguiente >
      Text Italian=&Avanti >
    end
    item: Push Button
      Rectangle=105 187 150 202
      Variable=DIRECTION
      Value=B
      Create Flags=01010000000000010000000000000000
      Text=< &Back
      Text French=< &Retour
      Text German=< &Zurück
      Text Spanish=< &Atrás
      Text Italian=< &Indietro
    end
    item: Push Button
      Rectangle=211 187 256 202
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=&Cancel
      Text French=&Annuler
      Text German=&Abbrechen
      Text Spanish=&Cancelar
      Text Italian=&Annulla
    end
    item: Static
      Rectangle=8 180 256 181
      Action=3
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 8 258 42
      Create Flags=01010000000000000000000000000000
      Flags=0000000000000001
      Name=Times New Roman
      Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
      Text=Ready to Install!
      Text French=Prêt à installer !
      Text German=Installationsbereit!
      Text Spanish=¡Preparado para la instalación!
      Text Italian=Pronto per l'installazione!
    end
    item: Static
      Rectangle=86 42 256 102
      Create Flags=01010000000000000000000000000000
      Text=You are now ready to install %APPTITLE%.
      Text=
      Text=Press the Next button to begin the installation or the Back button to reenter the installation information.
      Text French=Vous êtes maintenant prêt à installer les fichiers %APPTITLE%.
      Text French=
      Text French=Cliquez sur le bouton Suite pour commencer l'installation ou sur le bouton Retour pour entrer les informations d'installation à nouveau.
      Text German=Sie können %APPTITLE% nun installieren.
      Text German=
      Text German=Klicken Sie auf "Weiter", um mit der Installation zu beginnen. Klicken Sie auf "Zurück", um die Installationsinformationen neu einzugeben.
      Text Spanish=Ya está listo para instalar %APPTITLE%.
      Text Spanish=
      Text Spanish=Presione el botón Siguiente para comenzar la instalación o presione Atrás para volver a ingresar la información para la instalación.
      Text Italian=Ora è possibile installare %APPTITLE%.
      Text Italian=
      Text Italian=Premere il pulsante Avanti per avviare l'installazione o il pulsante Indietro per reinserire le informazioni di installazione.
    end
  end
end
item: If/While Statement
  Variable=DISPLAY
  Value=Select Destination Directory
end
item: Set Variable
  Variable=BACKUP
  Value=%MAINDIR%\BACKUP
end
item: End Block
end
item: End Block
end
item: If/While Statement
  Variable=TYPE
  Value=B
end
item: Set Variable
  Variable=COMPONENTS
  Value=A
end
item: End Block
end
item: If/While Statement
  Variable=DOBACKUP
  Value=A
end
item: Set Variable
  Variable=BACKUPDIR
  Value=%BACKUP%
end
item: End Block
end
remarked item: If/While Statement
  Variable=BRANDING
  Value=1
end
remarked item: If/While Statement
  Variable=DOBRAND
  Value=1
end
remarked item: Edit INI File
  Pathname=%INST%\CUSTDATA.INI
  Settings=[Registration]
  Settings=NAME=%NAME%
  Settings=COMPANY=%COMPANY%
  Settings=
end
remarked item: End Block
end
remarked item: End Block
end
item: Set Variable
  Variable=MAINDIRSHORT
  Value=%MAINDIR%
  Flags=00010100
end
item: Open/Close INSTALL.LOG
end
item: Check Disk Space
  Component=COMPONENTS
end
item: Install File
  Source=${__TCLBASEDIR__}\license.txt
  Destination=%MAINDIR%\license.txt
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\Readme.txt
  Destination=%MAINDIR%\Readme.txt
  Flags=0000000000000010
end
item: If/While Statement
  Variable=COMPONENTS
  Value=D
  Flags=00001010
end
item: Install File
  Source=${__TKBASEDIR__}\win\release\tk85.lib
  Destination=%MAINDIR%\lib\tk85.lib
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\win\release\tkstub85.lib
  Destination=%MAINDIR%\lib\tkstub85.lib
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\release\tcl85.lib
  Destination=%MAINDIR%\lib\tcl85.lib
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\release\tclstub85.lib
  Destination=%MAINDIR%\lib\tclstub85.lib
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\Xutil.h
  Destination=%MAINDIR%\include\X11\Xutil.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\Xlib.h
  Destination=%MAINDIR%\include\X11\Xlib.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\Xfuncproto.h
  Destination=%MAINDIR%\include\X11\Xfuncproto.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\Xatom.h
  Destination=%MAINDIR%\include\X11\Xatom.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\X.h
  Destination=%MAINDIR%\include\X11\X.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\keysymdef.h
  Destination=%MAINDIR%\include\X11\keysymdef.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\keysym.h
  Destination=%MAINDIR%\include\X11\keysym.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\xlib\X11\cursorfont.h
  Destination=%MAINDIR%\include\X11\cursorfont.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\generic\tk.h
  Destination=%MAINDIR%\include\tk.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\generic\tkDecls.h
  Destination=%MAINDIR%\include\tkDecls.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\generic\tkPlatDecls.h
  Destination=%MAINDIR%\include\tkPlatDecls.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\generic\tkIntXlibDecls.h
  Destination=%MAINDIR%\include\tkIntXlibDecls.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\generic\tcl.h
  Destination=%MAINDIR%\include\tcl.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\generic\tclDecls.h
  Destination=%MAINDIR%\include\tclDecls.h
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\generic\tclPlatDecls.h
  Destination=%MAINDIR%\include\tclPlatDecls.h
  Flags=0000000000000010
end
item: End Block
end
item: If/While Statement
  Variable=COMPONENTS
  Value=A
  Flags=00001010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\msgcat\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.5\pkgIndex.tcl
  Flags=0000000010000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\msgcat\msgcat.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\msgcat1.5\msgcat.tcl
  Flags=0000000010000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\tcltest\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\tcltest\tcltest.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\tcltest2.0\tcltest.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\symbol.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\symbol.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\shiftjis.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\shiftjis.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macUkraine.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macUkraine.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macTurkish.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macTurkish.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macThai.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macThai.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macRomania.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRomania.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macRoman.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macRoman.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macJapan.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macJapan.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macIceland.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macIceland.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macGreek.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macGreek.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macDingbats.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macDingbats.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macCyrillic.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCyrillic.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macCroatian.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCroatian.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\macCentEuro.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\macCentEuro.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\ksc5601.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\ksc5601.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\koi8-r.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\koi8-r.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\jis0212.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0212.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\jis0208.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0208.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\jis0201.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\jis0201.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-15.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-15.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-9.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-9.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-8.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-8.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-7.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-7.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-6.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-6.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-5.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-5.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-4.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-4.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-3.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-3.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-2.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-2.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso8859-1.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso8859-1.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso2022.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso2022-kr.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-kr.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\iso2022-jp.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\iso2022-jp.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\gb2312.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb2312.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\gb1988.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb1988.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\gb12345.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\gb12345.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\euc-cn.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-cn.enc
  Flags=0000000010000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\euc-jp.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-jp.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\euc-kr.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\euc-kr.enc
  Flags=0000000010000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\dingbats.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\dingbats.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp950.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp950.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp949.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp949.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp936.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp936.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp932.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp932.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp874.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp874.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp869.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp869.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp866.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp866.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp865.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp865.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp864.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp864.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp863.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp863.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp862.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp862.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp861.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp861.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp860.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp860.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp857.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp857.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp855.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp855.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp852.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp852.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp850.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp850.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp775.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp775.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp737.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp737.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp437.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp437.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1258.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1258.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1257.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1257.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1256.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1256.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1255.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1255.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1254.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1254.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1253.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1253.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1252.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1252.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1251.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1251.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\cp1250.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\cp1250.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\ascii.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\ascii.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\encoding\big5.enc
  Destination=%MAINDIR%\lib\tcl%VER%\encoding\big5.enc
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\opt\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\opt\optparse.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\http\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\http\http.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\msgbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\optMenu.tcl
  Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\clrpick.tcl
  Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\entry.tcl
  Destination=%MAINDIR%\lib\tk%VER%\entry.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\spinbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\spinbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\comdlg.tcl
  Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\bgerror.tcl
  Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\obsolete.tcl
  Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\button.tcl
  Destination=%MAINDIR%\lib\tk%VER%\button.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\xmfbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\console.tcl
  Destination=%MAINDIR%\lib\tk%VER%\console.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\listbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\menu.tcl
  Destination=%MAINDIR%\lib\tk%VER%\menu.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\dialog.tcl
  Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\focus.tcl
  Destination=%MAINDIR%\lib\tk%VER%\focus.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\palette.tcl
  Destination=%MAINDIR%\lib\tk%VER%\palette.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\tkfbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\tk.tcl
  Destination=%MAINDIR%\lib\tk%VER%\tk.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\text.tcl
  Destination=%MAINDIR%\lib\tk%VER%\text.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\tearoff.tcl
  Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\tclIndex
  Destination=%MAINDIR%\lib\tk%VER%\tclIndex
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\scrlbar.tcl
  Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\scale.tcl
  Destination=%MAINDIR%\lib\tk%VER%\scale.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\safetk.tcl
  Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\http1.0\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\http1.0\http.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\reg\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\release\tclreg10.dll
  Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg10.dll
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\dde\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\release\tcldde12.dll
  Destination=%MAINDIR%\lib\tcl%VER%\dde1.2\tcldde12.dll
  Flags=0000000000000010
end
item: Install File
  Source=C:\WINNT\SYSTEM32\Msvcrt.dll
  Destination=%MAINDIR%\bin\msvcrt.dll
  Flags=0010001000000011
end
item: Install File
  Source=${__TKBASEDIR__}\win\release\wish85.exe
  Destination=%MAINDIR%\bin\wish85.exe
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\release\tclsh85.exe
  Destination=%MAINDIR%\bin\tclsh85.exe
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\release\tclpip85.dll
  Destination=%MAINDIR%\bin\tclpip85.dll
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\win\release\tcl85.dll
  Destination=%MAINDIR%\bin\tcl85.dll
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\win\release\tk85.dll
  Destination=%MAINDIR%\bin\tk85.dll
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\auto.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\auto.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\history.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\history.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\init.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\init.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\package.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\package.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\parray.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\safe.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\tclIndex
  Destination=%MAINDIR%\lib\tcl%VER%\tclIndex
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\library\word.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\word.tcl
  Flags=0000000000000010
end
item: End Block
end
item: If/While Statement
  Variable=COMPONENTS
  Value=B
  Flags=00001010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\tai-ku.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\tai-ku.gif
  Flags=0000000010000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\teapot.ppm
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\teapot.ppm
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\tcllogo.gif
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\tcllogo.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\pattern.bmp
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\pattern.bmp
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\noletter.bmp
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\noletter.bmp
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\letters.bmp
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\letters.bmp
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\gray25.bmp
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\gray25.bmp
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\flagup.bmp
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagup.bmp
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\flagdown.bmp
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\flagdown.bmp
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\face.bmp
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\face.bmp
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\earthris.gif
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\earthris.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\images\earth.gif
  Destination=%MAINDIR%\lib\tk%VER%\demos\images\earth.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\vscale.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\vscale.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\twind.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\twind.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\text.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\text.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\style.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\style.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\states.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\states.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\search.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\search.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\sayings.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\sayings.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\ruler.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\ruler.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\radio.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\radio.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\puzzle.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\puzzle.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\plot.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\plot.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\msgbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\msgbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\menubu.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\menubu.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\menu.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\menu.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\label.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\label.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\items.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\items.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\image2.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\image2.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\image1.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\image1.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\icon.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\icon.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\hscale.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\hscale.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\form.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\form.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\ixset
  Destination=%MAINDIR%\lib\tk%VER%\demos\ixset.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\rolodex
  Destination=%MAINDIR%\lib\tk%VER%\demos\rolodex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\square
  Destination=%MAINDIR%\lib\tk%VER%\demos\square.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\Readme
  Destination=%MAINDIR%\lib\tk%VER%\demos\Readme
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\hello
  Destination=%MAINDIR%\lib\tk%VER%\demos\hello.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\tclIndex
  Destination=%MAINDIR%\lib\tk%VER%\demos\tclIndex
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\browse
  Destination=%MAINDIR%\lib\tk%VER%\demos\browse.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\timer
  Destination=%MAINDIR%\lib\tk%VER%\demos\timer.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\widget
  Destination=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\tcolor
  Destination=%MAINDIR%\lib\tk%VER%\demos\tcolor.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\rmt
  Destination=%MAINDIR%\lib\tk%VER%\demos\rmt.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\floor.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\floor.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\filebox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\filebox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\pwrdLogo75.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo75.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\pwrdLogo200.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo200.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\pwrdLogo175.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo175.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\pwrdLogo150.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo150.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\pwrdLogo100.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\pwrdLogo100.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\logoMed.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\logoMed.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\logoLarge.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\logoLarge.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\logo64.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\logo64.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\logo100.gif
  Destination=%MAINDIR%\lib\tk%VER%\images\logo100.gif
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\images\Readme
  Destination=%MAINDIR%\lib\tk%VER%\images\Readme
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\arrow.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\arrow.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\bind.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\bind.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\bitmap.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\bitmap.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\button.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\button.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\check.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\check.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\clrpick.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\clrpick.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\colors.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\colors.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\cscroll.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\cscroll.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\ctext.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\ctext.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\dialog1.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\dialog1.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\dialog2.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\dialog2.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\entry1.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\entry1.tcl
  Flags=0000000000000010
end
item: Install File
  Source=${__TKBASEDIR__}\library\demos\entry2.tcl
  Destination=%MAINDIR%\lib\tk%VER%\demos\entry2.tcl
  Flags=0000000000000010
end
item: End Block
end
item: If/While Statement
  Variable=COMPONENTS
  Value=C
  Flags=00001010
end
item: Install File
  Source=${__TCLBASEDIR__}\tools\tcl85.cnt
  Destination=%MAINDIR%\doc\tcl85.cnt
  Flags=0000000000000010
end
item: Install File
  Source=${__TCLBASEDIR__}\tools\tcl85.hlp
  Destination=%MAINDIR%\doc\tcl85.hlp
  Flags=0000000000000010
end
item: End Block
end
item: Set Variable
  Variable=MAINDIR
  Value=%MAINDIR%
  Flags=00010100
end
item: Include Script
  Pathname=\\pop\tools\1.2\win32-ix86\wise\INCLUDE\uninstal.wse
end
item: Check Configuration
  Flags=10111011
end
item: Get Registry Key Value
  Variable=GROUPDIR
  Key=Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders
  Default=%WIN%\Start Menu\Programs
  Value Name=Programs
  Flags=00000010
end
item: Set Variable
  Variable=GROUP
  Value=%GROUPDIR%\%GROUP%
end
item: If/While Statement
  Variable=COMPONENTS
  Value=A
  Flags=00001010
end
item: Create Shortcut
  Source=%MAINDIR%\bin\wish85.exe
  Destination=%GROUP%\Wish.lnk
  Working Directory=%MAINDIR%
end
item: End Block
end
item: If/While Statement
  Variable=COMPONENTS
  Value=A
  Flags=00001010
end
item: Create Shortcut
  Source=%MAINDIR%\bin\tclsh85.exe
  Destination=%GROUP%\Tclsh.lnk
  Working Directory=%MAINDIR%
  Key Type=1536
  Flags=00000001
end
item: End Block
end
item: If/While Statement
  Variable=COMPONENTS
  Value=C
  Flags=00001010
end
item: Create Shortcut
  Source=%MAINDIR%\doc\tcl85.hlp
  Destination=%GROUP%\Tcl Help.lnk
  Working Directory=%MAINDIR%
end
item: End Block
end
item: Create Shortcut
  Source=%MAINDIR%\Readme.txt
  Destination=%GROUP%\Readme.lnk
  Working Directory=%MAINDIR%
end
item: If/While Statement
  Variable=COMPONENTS
  Value=B
  Flags=00001010
end
item: Create Shortcut
  Source=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
  Destination=%GROUP%\Widget Tour.lnk
  Working Directory=%MAINDIR%
  Key Type=1536
  Flags=00000001
end
item: End Block
end
item: Else Statement
end
item: If/While Statement
  Variable=COMPONENTS
  Value=B
  Flags=00001010
end
item: Add ProgMan Icon
  Group=%GROUP%
  Icon Name=Widget Tour
  Command Line=%MAINDIR%\lib\tk%VER%\demos\widget.tcl
  Icon Pathname=%MAINDIR%\bin\wish85.exe
  Default Directory=%MAINDIR%
end
item: End Block
end
item: If/While Statement
  Variable=COMPONENTS
  Value=C
  Flags=00001010
end
item: Add ProgMan Icon
  Group=%GROUP%
  Icon Name=Tcl Help
  Command Line=%MAINDIR%\doc\tcl85.hlp
  Default Directory=%MAINDIR%
end
item: End Block
end
item: Add ProgMan Icon
  Group=%GROUP%
  Icon Name=Readme
  Command Line=%MAINDIR%\Readme.txt
  Default Directory=%MAINDIR%
end
item: If/While Statement
  Variable=COMPONENTS
  Value=A
  Flags=00001010
end
item: Add ProgMan Icon
  Group=%GROUP%
  Icon Name=Wish
  Command Line=%MAINDIR%\bin\wish85.exe
  Default Directory=%MAINDIR%
end
item: End Block
end
item: If/While Statement
  Variable=COMPONENTS
  Value=A
  Flags=00001010
end
item: Add ProgMan Icon
  Group=%GROUP%
  Icon Name=Tclsh
  Command Line=%MAINDIR%\bin\tclsh85.exe
  Default Directory=%MAINDIR%
end
item: End Block
end
item: End Block
end
item: Self-Register OCXs/DLLs
  Description=Updating System Configuration, Please Wait...
end
item: Edit Registry
  Total Keys=1
  Key=SOFTWARE\Scriptics\Tcl\%VER%
  New Value=%MAINDIR%
  Value Name=Root
  Root=2
end
item: Edit Registry
  Total Keys=1
  Key=TclScript\DefaultIcon
  New Value=%MAINDIR%\bin\tk85.dll
end
item: Edit Registry
  Total Keys=1
  Key=.tcl
  New Value=TclScript
end
item: Edit Registry
  Total Keys=1
  Key=TclScript
  New Value=TclScript
end
item: Edit Registry
  Total Keys=1
  Key=TclScript\shell\open\command
  New Value=%MAINDIRSHORT%\bin\wish85.exe "%%1" %%*
end
item: Edit Registry
  Total Keys=1
  Key=TclScript\shell\edit
  New Value=&Edit
end
item: Edit Registry
  Total Keys=1
  Key=TclScript\shell\edit\command
  New Value=notepad "%%1"
end
item: Add Directory to Path
  Directory=%MAINDIR%\bin
end
item: Check Configuration
  Flags=10111011
end
item: Set Variable
  Variable=TO_SCRIPTICS
  Value=A
end
item: Else Statement
end
item: Set Variable
  Variable=TO_SCRIPTICS
end
item: End Block
end
item: Wizard Block
  Direction Variable=DIRECTION
  Display Variable=DISPLAY
  Bitmap Pathname=%_WISE_%\DIALOGS\TEMPLATE\WIZARD.BMP
  X Position=9
  Y Position=10
  Filler Color=8421440
  Flags=00000011
end
item: Custom Dialog Set
  Name=Finished
  Display Variable=DISPLAY
  item: Dialog
    Title=%APPTITLE% Installation
    Title French=Installation de %APPTITLE%
    Title German=Installation von %APPTITLE%
    Title Spanish=Instalación de %APPTITLE%
    Title Italian=Installazione di %APPTITLE%
    Width=271
    Height=224
    Font Name=Helv
    Font Size=8
    item: Push Button
      Rectangle=150 187 195 202
      Variable=DIRECTION
      Value=N
      Create Flags=01010000000000010000000000000001
      Text=&Finish
      Text French=&Fin
      Text German=&Weiter
      Text Spanish=&Terminar
      Text Italian=&Fine
    end
    item: Push Button
      Rectangle=105 187 150 202
      Variable=DISABLED
      Value=!
      Create Flags=01010000000000010000000000000000
      Text=< &Back
      Text French=< &Retour
      Text German=< &Zurück
      Text Spanish=< &Atrás
      Text Italian=< &Indietro
    end
    item: Push Button
      Rectangle=211 187 256 202
      Variable=DISABLED
      Value=!
      Action=3
      Create Flags=01010000000000010000000000000000
      Text=&Cancel
      Text French=&Annuler
      Text German=&Abbrechen
      Text Spanish=&Cancelar
      Text Italian=&Annulla
    end
    item: Static
      Rectangle=8 180 256 181
      Action=3
      Create Flags=01010000000000000000000000000111
    end
    item: Static
      Rectangle=86 8 258 42
      Create Flags=01010000000000000000000000000000
      Flags=0000000000000001
      Name=Times New Roman
      Font Style=-24 0 0 0 700 255 0 0 0 3 2 1 18
      Text=Installation Completed!
      Text French=Installation terminée !
      Text German=Die Installation ist abgeschlossen!
      Text Spanish=¡Instalación terminada!
      Text Italian=Installazione completata!
    end
    item: Static
      Rectangle=86 42 256 153
      Create Flags=01010000000000000000000000000000
      Text=%APPTITLE% has been successfully installed.
      Text=
      Text=Click the Finish button to exit this installation.
      Text=
      Text=You can learn more about Tcl/Tk %VER%, including release notes, updates, tutorials, and more at %URL%.  Check the box below to start your web browser and go there now.
      Text=
      Text=The installer may ask you to reboot your computer, this is to update your PATH and is not necessary to do immediately.
      Text French=%APPTITLE% est maintenant installé.
      Text French=
      Text French=Cliquez sur le bouton Fin pour quitter l'installation.
      Text German=%APPTITLE% wurde erfolgreich installiert.
      Text German=
      Text German=Klicken Sie auf "Weiter", um die Installation zu beenden.
      Text Spanish=%APPTITLE% se ha instalado con éxito.
      Text Spanish=
      Text Spanish=Presione el botón Terminar para salir de esta instalación.
      Text Italian=L'installazione %APPTITLE% è stata portata a termine con successo.
      Text Italian=
      Text Italian=Premere il pulsante Fine per uscire dall'installazione.
    end
    item: Checkbox
      Rectangle=88 143 245 157
      Variable=TO_SCRIPTICS
      Enabled Color=00000000000000001111111111111111
      Create Flags=01010000000000010000000000000011
      Text=Show me important information about
      Text=
    end
    item: Static
      Rectangle=99 156 245 170
      Enabled Color=00000000000000001111111111111111
      Create Flags=01010000000000000000000000000000
      Text=Tcl/Tk %VER% and TclPro
    end
  end
end
item: End Block
end
item: Check Configuration
  Flags=10111011
end
item: If/While Statement
  Variable=TO_SCRIPTICS
  Value=A
  Flags=00000010
end
item: Execute Program
  Command Line=%URL%
end
item: End Block
end
item: Execute Program
  Pathname=explorer
  Command Line=%GROUP%
end
item: End Block
end

Deleted tools/tclOOScript.tcl.

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
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
450
451
452
453
454
455
456








































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# tclOOScript.h --
#
# 	This file contains support scripts for TclOO. They are defined here so
# 	that the code can be definitely run even in safe interpreters; TclOO's
# 	core setup is safe.
#
# Copyright (c) 2012-2018 Donal K. Fellows
# Copyright (c) 2013 Andreas Kupries
# Copyright (c) 2017 Gerald Lester
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

::namespace eval ::oo {
    ::namespace path {}

    #
    # Commands that are made available to objects by default.
    #
    namespace eval Helpers {
	::namespace path {}

	# ------------------------------------------------------------------
	#
	# callback, mymethod --
	#
	#	Create a script prefix that calls a method on the current
	#	object. Same operation, two names.
	#
	# ------------------------------------------------------------------

	proc callback {method args} {
	    list [uplevel 1 {::namespace which my}] $method {*}$args
	}

	# Make the [callback] command appear as [mymethod] too.
	namespace export callback
	namespace eval tmp {namespace import ::oo::Helpers::callback}
	namespace export -clear
	rename tmp::callback mymethod
	namespace delete tmp

	# ------------------------------------------------------------------
	#
	# classvariable --
	#
	#	Link to a variable in the class of the current object.
	#
	# ------------------------------------------------------------------

	proc classvariable {name args} {
	    # Get a reference to the class's namespace
	    set ns [info object namespace [uplevel 1 {self class}]]
	    # Double up the list of variable names
	    foreach v [list $name {*}$args] {
		if {[string match *(*) $v]} {
		    set reason "can't create a scalar variable that looks like an array element"
		    return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
			[format {bad variable name "%s": %s} $v $reason]
		}
		if {[string match *::* $v]} {
		    set reason "can't create a local variable with a namespace separator in it"
		    return -code error -errorcode {TCL UPVAR INVERTED} \
			[format {bad variable name "%s": %s} $v $reason]
		}
		lappend vs $v $v
	    }
	    # Lastly, link the caller's local variables to the class's variables
	    tailcall namespace upvar $ns {*}$vs
	}

	# ------------------------------------------------------------------
	#
	# link --
	#
	#	Make a command that invokes a method on the current object.
	#	The name of the command and the name of the method match by
	#	default.
	#
	# ------------------------------------------------------------------

	proc link {args} {
	    set ns [uplevel 1 {::namespace current}]
	    foreach link $args {
		if {[llength $link] == 2} {
		    lassign $link src dst
		} elseif {[llength $link] == 1} {
		    lassign $link src
		    set dst $src
		} else {
		    return -code error -errorcode {TCLOO CMDLINK FORMAT} \
			"bad link description; must only have one or two elements"
		}
		if {![string match ::* $src]} {
		    set src [string cat $ns :: $src]
		}
		interp alias {} $src {} ${ns}::my $dst
		trace add command ${ns}::my delete [list \
		    ::oo::UnlinkLinkedCommand $src]
	    }
	    return
	}
    }

    # ----------------------------------------------------------------------
    #
    # UnlinkLinkedCommand --
    #
    #	Callback used to remove linked command when the underlying mechanism
    #	that supports it is deleted.
    #
    # ----------------------------------------------------------------------

    proc UnlinkLinkedCommand {cmd args} {
	if {[namespace which $cmd] ne {}} {
	    rename $cmd {}
	}
    }

    # ----------------------------------------------------------------------
    #
    # DelegateName --
    #
    #	Utility that gets the name of the class delegate for a class. It's
    #	trivial, but makes working with them much easier as delegate names are
    #	intentionally hard to create by accident.
    #
    # ----------------------------------------------------------------------

    proc DelegateName {class} {
	string cat [info object namespace $class] {:: oo ::delegate}
    }

    # ----------------------------------------------------------------------
    #
    # MixinClassDelegates --
    #
    #	Support code called *after* [oo::define] inside the constructor of a
    #	class that patches in the appropriate class delegates.
    #
    # ----------------------------------------------------------------------

    proc MixinClassDelegates {class} {
	if {![info object isa class $class]} {
	    return
	}
	set delegate [DelegateName $class]
	if {![info object isa class $delegate]} {
	    return
	}
	foreach c [info class superclass $class] {
	    set d [DelegateName $c]
	    if {![info object isa class $d]} {
		continue
	    }
	    define $delegate ::oo::define::superclass -append $d
	}
	objdefine $class ::oo::objdefine::mixin -append $delegate
    }

    # ----------------------------------------------------------------------
    #
    # UpdateClassDelegatesAfterClone --
    #
    #	Support code that is like [MixinClassDelegates] except for when a
    #	class is cloned.
    #
    # ----------------------------------------------------------------------

    proc UpdateClassDelegatesAfterClone {originObject targetObject} {
	# Rebuild the class inheritance delegation class
	set originDelegate [DelegateName $originObject]
	set targetDelegate [DelegateName $targetObject]
	if {
	    [info object isa class $originDelegate]
	    && ![info object isa class $targetDelegate]
	} then {
	    copy $originDelegate $targetDelegate
	    objdefine $targetObject ::oo::objdefine::mixin -set \
		{*}[lmap c [info object mixin $targetObject] {
		    if {$c eq $originDelegate} {set targetDelegate} {set c}
		}]
	}
    }

    # ----------------------------------------------------------------------
    #
    # oo::define::classmethod --
    #
    #	Defines a class method. See define(n) for details.
    #
    # Note that the ::oo::define namespace is semi-public and a bit weird
    # anyway, so we don't regard the namespace path as being under control:
    # fully qualified names are used for everything.
    #
    # ----------------------------------------------------------------------

    proc define::classmethod {name {args {}} {body {}}} {
        # Create the method on the class if the caller gave arguments and body
        ::set argc [::llength [::info level 0]]
        ::if {$argc == 3} {
            ::return -code error -errorcode {TCL WRONGARGS} [::format \
		{wrong # args: should be "%s name ?args body?"} \
                [::lindex [::info level 0] 0]]
        }
        ::set cls [::uplevel 1 self]
        ::if {$argc == 4} {
            ::oo::define [::oo::DelegateName $cls] method $name $args $body
        }
        # Make the connection by forwarding
        ::tailcall forward $name myclass $name
    }

    # ----------------------------------------------------------------------
    #
    # oo::define::initialise, oo::define::initialize --
    #
    #	Do specific initialisation for a class. See define(n) for details.
    #
    # Note that the ::oo::define namespace is semi-public and a bit weird
    # anyway, so we don't regard the namespace path as being under control:
    # fully qualified names are used for everything.
    #
    # ----------------------------------------------------------------------

    proc define::initialise {body} {
        ::set clsns [::info object namespace [::uplevel 1 self]]
        ::tailcall apply [::list {} $body $clsns]
    }

    # Make the [initialise] definition appear as [initialize] too
    namespace eval define {
	::namespace export initialise
	::namespace eval tmp {::namespace import ::oo::define::initialise}
	::namespace export -clear
	::rename tmp::initialise initialize
	::namespace delete tmp
    }

    # ----------------------------------------------------------------------
    #
    # Slot --
    #
    #	The class of slot operations, which are basically lists at the low
    #	level of TclOO; this provides a more consistent interface to them.
    #
    # ----------------------------------------------------------------------

    define Slot {
	# ------------------------------------------------------------------
	#
	# Slot Get --
	#
	#	Basic slot getter. Retrieves the contents of the slot.
	#	Particular slots must provide concrete non-erroring
	#	implementation.
	#
	# ------------------------------------------------------------------

	method Get {} {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Set --
	#
	#	Basic slot setter. Sets the contents of the slot.  Particular
	#	slots must provide concrete non-erroring implementation.
	#
	# ------------------------------------------------------------------

	method Set list {
	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
	}

	# ------------------------------------------------------------------
	#
	# Slot Resolve --
	#
	#	Helper that lets a slot convert a list of arguments of a
	#	particular type to their canonical forms. Defaults to doing
	#	nothing (suitable for simple strings).
	#
	# ------------------------------------------------------------------

	method Resolve list {
	    return $list
	}

	# ------------------------------------------------------------------
	#
	# Slot -set, -append, -clear, --default-operation --
	#
	#	Standard public slot operations. If a slot can't figure out
	#	what method to call directly, it uses --default-operation.
	#
	# ------------------------------------------------------------------

	method -set args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    tailcall my Set $args
	}
	method -append args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$current {*}$args]
	}
	method -clear {} {tailcall my Set {}}
	method -prepend args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [list {*}$args {*}$current]
	}
	method -remove args {
	    set my [namespace which my]
	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
	    set current [uplevel 1 [list $my Get]]
	    tailcall my Set [lmap val $current {
		if {$val in $args} continue else {set val}
	    }]
	}

	# Default handling
	forward --default-operation my -append
	method unknown {args} {
	    set def --default-operation
	    if {[llength $args] == 0} {
		tailcall my $def
	    } elseif {![string match -* [lindex $args 0]]} {
		tailcall my $def {*}$args
	    }
	    next {*}$args
	}

	# Set up what is exported and what isn't
	export -set -append -clear -prepend -remove
	unexport unknown destroy
    }

    # Set the default operation differently for these slots
    objdefine define::superclass forward --default-operation my -set
    objdefine define::mixin forward --default-operation my -set
    objdefine objdefine::mixin forward --default-operation my -set

    # ----------------------------------------------------------------------
    #
    # oo::object <cloned> --
    #
    #	Handler for cloning objects that clones basic bits (only!) of the
    #	object's namespace. Non-procedures, traces, sub-namespaces, etc. need
    #	more complex (and class-specific) handling.
    #
    # ----------------------------------------------------------------------

    define object method <cloned> {originObject} {
	# Copy over the procedures from the original namespace
	foreach p [info procs [info object namespace $originObject]::*] {
	    set args [info args $p]
	    set idx -1
	    foreach a $args {
		if {[info default $p $a d]} {
		    lset args [incr idx] [list $a $d]
		} else {
		    lset args [incr idx] [list $a]
		}
	    }
	    set b [info body $p]
	    set p [namespace tail $p]
	    proc $p $args $b
	}
	# Copy over the variables from the original namespace
	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
		}
	    }
	}
	# General commands, sub-namespaces and advancd variable config (traces,
	# etc) are *not* copied over. Classes that want that should do it
	# themselves.
    }

    # ----------------------------------------------------------------------
    #
    # oo::class <cloned> --
    #
    #	Handler for cloning classes, which fixes up the delegates.
    #
    # ----------------------------------------------------------------------

    define class method <cloned> {originObject} {
	next $originObject
	# Rebuild the class inheritance delegation class
	::oo::UpdateClassDelegatesAfterClone $originObject [self]
    }

    # ----------------------------------------------------------------------
    #
    # oo::singleton --
    #
    #	A metaclass that is used to make classes that only permit one instance
    #	of them to exist. See singleton(n).
    #
    # ----------------------------------------------------------------------

    class create singleton {
	superclass class
	variable object
	unexport create createWithNamespace
	method new args {
	    if {![info exists object] || ![info object isa object $object]} {
		set object [next {*}$args]
		::oo::objdefine $object {
		    method destroy {} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not destroy a singleton object"
		    }
		    method <cloned> {originObject} {
			::return -code error -errorcode {TCLOO SINGLETON} \
			    "may not clone a singleton object"
		    }
		}
	    }
	    return $object
	}
    }

    # ----------------------------------------------------------------------
    #
    # oo::abstract --
    #
    #	A metaclass that is used to make classes that can't be directly
    #	instantiated. See abstract(n).
    #
    # ----------------------------------------------------------------------

    class create abstract {
	superclass class
	unexport create createWithNamespace new
    }
}

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# fill-column: 78
# End:

Added tools/tclSplash.bmp.

cannot compute difference between binary files

Changes to tools/tclZIC.tcl.

1
2
3
4
5
6

7
8
9
10
11
12
13

14
15
16
17
18
19
20
1
2
3
4
5

6
7
8
9
10
11
12

13
14
15
16
17
18
19
20





-
+






-
+







#----------------------------------------------------------------------
#
# tclZIC.tcl --
#
#	Take the time zone data source files from Arthur Olson's
#	repository at elsie.nci.nih.gov, and prepare time zone
#	repository at https://www.iana.org/time-zones, and prepare time zone
#	information files for Tcl.
#
# Usage:
#	tclsh tclZIC.tcl inputDir outputDir
#
# Parameters:
#	inputDir - Directory (e.g., tzdata2003e) where Olson's source
#	inputDir - Directory (e.g., tzdata2022a) where Olson's source
#		   files are to be found.
#	outputDir - Directory (e.g., ../library/tzdata) where
#		    the time zone information files are to be placed.
#
# Results:
#	May produce error messages on the standard error.  An exit
#	code of zero denotes success; any other exit code is failure.
32
33
34
35
36
37
38
39

40
41
42
43
44
45
46
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46







-
+








# Define the names of the Olson files that we need to load.
# We avoid the solar time files and the leap seconds.

set olsonFiles {
    africa antarctica asia australasia
    backward etcetera europe northamerica
    southamerica
    pacificnew southamerica systemv
}

# Define the year at which the DST information will stop.

set maxyear 2100

# Determine how big a wide integer is.

Added tools/tclmin.wse.
























































































































































































































































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Document Type: WSE
item: Global
  Version=5.0
  Flags=00000100
  Split=1420
  Languages=65 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
  Japanese Font Name=MS Gothic
  Japanese Font Size=10
  Start Gradient=0 0 255
  End Gradient=0 0 0
  Windows Flags=00000000000000010010110000001000
  Message Font=MS Sans Serif
  Font Size=8
  Disk Filename=SETUP
  Patch Flags=0000000000000001
  Patch Threshold=85
  Patch Memory=4000
end
item: Remark
  Text=-------
end
item: Remark
  Text=Tcl 8.0 Minimal Installation
end
item: Remark
  Text=-------
end
item: Install File
  Source=n:\dist\tcl8.0\library\opt0.4\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\opt0.4\optparse.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\opt0.4\optparse.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\http\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http2.4\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\http\http.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http2.4\http.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\safe.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\safe.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\history.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\history.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\msgbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\msgbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\optMenu.tcl
  Destination=%MAINDIR%\lib\tk%VER%\optMenu.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\clrpick.tcl
  Destination=%MAINDIR%\lib\tk%VER%\clrpick.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\entry.tcl
  Destination=%MAINDIR%\lib\tk%VER%\entry.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\comdlg.tcl
  Destination=%MAINDIR%\lib\tk%VER%\comdlg.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\bgerror.tcl
  Destination=%MAINDIR%\lib\tk%VER%\bgerror.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\obsolete.tcl
  Destination=%MAINDIR%\lib\tk%VER%\obsolete.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\button.tcl
  Destination=%MAINDIR%\lib\tk%VER%\button.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\xmfbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\xmfbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\console.tcl
  Destination=%MAINDIR%\lib\tk%VER%\console.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\listbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\listbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\menu.tcl
  Destination=%MAINDIR%\lib\tk%VER%\menu.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\dialog.tcl
  Destination=%MAINDIR%\lib\tk%VER%\dialog.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\focus.tcl
  Destination=%MAINDIR%\lib\tk%VER%\focus.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\palette.tcl
  Destination=%MAINDIR%\lib\tk%VER%\palette.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\tkfbox.tcl
  Destination=%MAINDIR%\lib\tk%VER%\tkfbox.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\tk.tcl
  Destination=%MAINDIR%\lib\tk%VER%\tk.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\text.tcl
  Destination=%MAINDIR%\lib\tk%VER%\text.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\tearoff.tcl
  Destination=%MAINDIR%\lib\tk%VER%\tearoff.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\tclIndex
  Destination=%MAINDIR%\lib\tk%VER%\tclIndex
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\scrlbar.tcl
  Destination=%MAINDIR%\lib\tk%VER%\scrlbar.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\scale.tcl
  Destination=%MAINDIR%\lib\tk%VER%\scale.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tk8.0\library\safetk.tcl
  Destination=%MAINDIR%\lib\tk%VER%\safetk.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\http1.0\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http1.0\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\http1.0\http.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\http1.0\http.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\win\pkgIndex.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\pkgIndex.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\win\tclreg80.dll
  Destination=%MAINDIR%\lib\tcl%VER%\reg1.0\tclreg80.dll
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\win\Tcl1680.dll
  Destination=%SYS32%\Tcl1680.dll
  Flags=0000001000000010
end
item: Install File
  Source=n:\dist\tcl8.0\win\tcl80.dll
  Destination=%SYS32%\tcl80.dll
  Flags=0000001000000010
end
item: Install File
  Source=n:\dist\tcl8.0\win\tclpip80.dll
  Destination=%SYS32%\tclpip80.dll
  Flags=0000001000000010
end
item: Install File
  Source=n:\dist\Bc45\Bin\cw3215.dll
  Destination=%SYS32%\cw3215.dll
  Flags=0000001000000010
end
item: Install File
  Source=n:\dist\tk8.0\win\tk80.dll
  Destination=%SYS32%\tk80.dll
  Flags=0000001000000010
end
item: Install File
  Source=n:\dist\tk8.0\win\wish80.exe
  Destination=%MAINDIR%\bin\wish80.exe
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\win\tclsh80.exe
  Destination=%MAINDIR%\bin\tclsh80.exe
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\tclIndex
  Destination=%MAINDIR%\lib\tcl%VER%\tclIndex
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\init.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\init.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\parray.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\parray.tcl
  Flags=0000000000000010
end
item: Install File
  Source=n:\dist\tcl8.0\library\word.tcl
  Destination=%MAINDIR%\lib\tcl%VER%\word.tcl
  Flags=0000000000000010
end

Deleted tools/tclsh.svg.

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



































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<svg
   xmlns:dc="http://purl.org/dc/elements/1.1/"
   xmlns:cc="http://creativecommons.org/ns#"
   xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
   xmlns:svg="http://www.w3.org/2000/svg"
   xmlns="http://www.w3.org/2000/svg"
   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
   width="256"
   height="256"
   id="svg2309"
   sodipodi:version="0.32"
   inkscape:version="0.46"
   sodipodi:modified="true"
   version="1.0"
   sodipodi:docname="tcl.svg"
   inkscape:output_extension="org.inkscape.output.svg.inkscape"
   inkscape:export-filename="tcl.png"
   inkscape:export-xdpi="8.4399996"
   inkscape:export-ydpi="8.4399996">
  <defs
     id="defs2311" />
  <sodipodi:namedview
     id="base"
     pagecolor="#ffffff"
     bordercolor="#666666"
     borderopacity="1.0"
     gridtolerance="10000"
     guidetolerance="10"
     objecttolerance="10"
     inkscape:pageopacity="0.0"
     inkscape:pageshadow="2"
     inkscape:zoom="1.8096812"
     inkscape:cx="110.83011"
     inkscape:cy="132.34375"
     inkscape:document-units="px"
     inkscape:current-layer="layer1"
     inkscape:window-width="993"
     inkscape:window-height="669"
     inkscape:window-x="5"
     inkscape:window-y="49"
     showgrid="false" />
  <g
     inkscape:label="Layer 1"
     inkscape:groupmode="layer"
     id="layer1"
     transform="translate(-311.79308,-365.73272)">
    <g
       id="g2392"
       transform="matrix(0.9671783,0,0,0.9671783,10.08245,12.003966)">
      <path
         id="path4426"
         d="M 499.58925,374.01397 C 499.97085,397.34606 499.27848,420.4264 479.08925,442.35772 L 478.33925,443.20147 L 479.46425,443.20147 L 487.71425,443.32647 C 474.30875,471.21288 465.58677,499.02017 446.308,526.79522 L 445.6205,527.79522 L 446.808,527.57647 L 456.9955,525.63897 C 449.7786,543.94928 437.43792,556.07176 424.058,560.13897 C 420.3754,508.57034 446.11026,463.05191 467.96425,417.67022 C 467.98435,417.62848 468.00666,417.58696 468.02675,417.54522 L 467.21425,416.98272 C 431.42858,456.99623 415.30305,513.43153 409.21425,559.98272 C 397.08579,553.13549 393.04346,544.06962 388.933,531.73272 L 397.40175,535.29522 L 398.27675,535.67022 L 398.08925,534.73272 C 391.65291,506.11299 401.64573,485.57026 411.33925,458.57647 L 418.308,463.23272 L 419.1205,463.79522 L 419.08925,462.82647 C 418.54325,440.89528 433.31028,418.87866 452.90175,399.23272 L 455.6205,406.51397 L 455.9955,407.48272 L 456.52675,406.57647 L 462.4955,396.63897 L 462.52675,396.57647 C 472.37862,383.00695 482.79421,378.58965 499.58925,374.01397 z"
         style="opacity:1;fill:#3465a4;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" />
      <path
         sodipodi:nodetypes="ccccccccccccccccccccccc"
         id="path7600"
         d="M 499.59927,374.00103 C 482.86154,378.56724 472.31963,383.0333 462.48689,396.57647 L 462.45564,396.63897 L 456.48689,406.57647 L 455.95564,407.48272 L 455.58064,406.51397 L 452.86189,399.23272 C 433.27042,418.87866 418.50339,440.89528 419.04939,462.82647 L 419.08064,463.79522 L 418.26814,463.23272 L 411.29939,458.57647 C 401.60587,485.57026 391.61305,506.11299 398.04939,534.73272 L 398.23689,535.67022 L 397.36189,535.29522 L 388.98689,531.76397 C 389.01386,531.93545 389.0525,532.09443 389.08064,532.26397 C 393.12974,544.32172 397.22634,553.23735 409.17439,559.98272 C 409.64601,556.37703 410.17162,552.69478 410.76814,548.98272 C 396.17755,514.81858 408.84232,489.70162 414.61189,467.10772 L 423.48689,472.23272 C 422.26097,451.07724 434.68113,428.26233 450.83064,408.35772 L 455.51814,416.60772 C 467.52689,391.90688 477.02451,381.99197 499.59927,374.00103 z"
         style="opacity:1;fill:#eeeeec;fill-opacity:1;fill-rule:evenodd;stroke:#eff1cb;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline" />
      <path
         style="opacity:1;fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;display:inline"
         d="M 505.90485,365.73272 L 505.3736,365.82647 C 485.689,369.25998 466.41815,376.49266 457.96735,393.79522 L 454.40485,387.57647 L 454.09235,387.01397 L 453.6236,387.48272 C 443.92989,396.7586 433.52309,408.77328 425.84235,420.57647 C 418.63263,431.65584 413.85062,442.49956 414.3736,450.79522 L 409.34235,444.51397 L 408.84235,443.88897 L 408.4986,444.60772 C 402.37467,457.83671 396.19429,474.11179 392.4986,489.04522 C 388.9946,503.20407 387.73979,516.09228 390.9986,524.20147 L 382.71735,519.38897 L 382.02985,518.98272 L 381.96735,519.79522 C 380.40824,543.41224 390.00555,554.68855 401.02985,565.57647 L 391.84235,567.85772 L 389.9986,568.32647 L 391.84235,568.82647 C 397.11688,570.2558 402.11758,571.86507 405.59235,574.54522 C 409.06712,577.22537 411.06333,580.91104 410.46735,586.79522 L 410.46735,586.82647 L 410.46735,612.32647 L 410.46735,612.48272 L 410.5611,612.60772 L 422.0611,629.10772 L 422.96735,630.42022 L 422.96735,628.82647 L 422.96735,589.95147 C 424.48916,583.40757 426.27542,578.90352 428.84235,575.92022 C 431.40928,572.93692 434.74946,571.40505 439.52985,570.82647 L 441.2486,570.60772 L 439.6861,569.88897 L 433.6236,567.01397 C 448.07909,558.31023 464.26865,536.97467 468.52985,516.70147 L 468.71735,515.88897 L 467.9361,516.10772 L 460.4361,518.13897 C 467.09909,511.88271 473.81127,499.48743 480.1861,485.04522 C 486.94715,469.72802 493.25982,452.38054 498.4361,438.51397 L 498.71735,437.76397 L 497.9361,437.82647 L 492.15485,438.23272 C 499.30195,430.64691 503.27438,418.11982 505.21735,404.88897 C 507.23962,391.11815 507.0977,376.61792 505.96735,366.26397 L 505.90485,365.73272 z M 500.46735,374.01397 C 500.84895,397.34606 500.15658,420.4264 479.96735,442.35772 L 479.21735,443.20147 L 480.34235,443.20147 L 488.59235,443.32647 C 475.18685,471.21288 466.46487,499.02017 447.1861,526.79522 L 446.4986,527.79522 L 447.6861,527.57647 L 457.8736,525.63897 C 450.6567,543.94928 438.31602,556.07176 424.9361,560.13897 C 421.2535,508.57034 446.98836,463.05191 468.84235,417.67022 C 468.86245,417.62848 468.88476,417.58696 468.90485,417.54522 L 468.09235,416.98272 C 432.30668,456.99623 416.18115,513.43153 410.09235,559.98272 C 397.96389,553.13549 393.92156,544.06962 389.8111,531.73272 L 398.27985,535.29522 L 399.15485,535.67022 L 398.96735,534.73272 C 392.53101,506.11299 402.52383,485.57026 412.21735,458.57647 L 419.1861,463.23272 L 419.9986,463.79522 L 419.96735,462.82647 C 419.42135,440.89528 434.18838,418.87866 453.77985,399.23272 L 456.4986,406.51397 L 456.8736,407.48272 L 457.40485,406.57647 L 463.3736,396.63897 L 463.40485,396.57647 C 473.25672,383.00695 483.67231,378.58965 500.46735,374.01397 z"
         id="path2177" />
    </g>
  </g>
</svg>

Deleted tools/tcltk-man2html-utils.tcl.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646














































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
##
## Utility functions for Man->HTML converter. Note that these
## functions are specifically intended to work with the format as used
## by Tcl and Tk; they do not cope with arbitrary nroff markup.
##
## Copyright (c) 1995-1997 Roger E. Critchlow Jr
## Copyright (c) 2004-2011 Donal K. Fellows

set ::manual(report-level) 1

proc manerror {msg} {
    global manual
    set name {}
    set subj {}
    set procname [lindex [info level -1] 0]
    if {[info exists manual(name)]} {
	set name $manual(name)
    }
    if {[info exists manual(section)] && [string length $manual(section)]} {
	puts stderr "$name: $manual(section): $procname: $msg"
    } else {
	puts stderr "$name: $procname: $msg"
    }
}

proc manreport {level msg} {
    global manual
    if {$level < $manual(report-level)} {
	uplevel 1 [list manerror $msg]
    }
}

proc fatal {msg} {
    global manual
    uplevel 1 [list manerror $msg]
    exit 1
}

##
## templating
##
proc indexfile {} {
    if {[info exists ::TARGET] && $::TARGET eq "devsite"} {
	return "index.tml"
    } else {
	return "contents.htm"
    }
}

proc copyright {copyright {level {}}} {
    # We don't actually generate a separate copyright page anymore
    #set page "${level}copyright.htm"
    #return "<A HREF=\"$page\">Copyright</A> &#169; [htmlize-text [lrange $copyright 2 end]]"
    # obfuscate any email addresses that may appear in name
    set who [string map {@ (at)} [lrange $copyright 2 end]]
    return "Copyright &copy; [htmlize-text $who]"
}

proc copyout {copyrights {level {}}} {
    set count 0
    set out "<div class=\"copy\">"
    foreach c $copyrights {
	if {$count > 0} {
	    append out <BR>
	}
	append out "[copyright $c $level]\n"
	incr count
    }
    append out "</div>"
    return $out
}

proc CSS {{level ""}} {
    return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n"
}

proc DOCTYPE {} {
    return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
}

proc htmlhead {title header args} {
    set level ""
    if {[lindex $args end] eq "../[indexfile]"} {
	# XXX hack - assume same level for CSS file
	set level "../"
    }
    set out "[DOCTYPE]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n"
    foreach {uptitle url} $args {
	set header "<a href=\"$url\">$uptitle</a> <small>&gt;</small> $header"
    }
    append out "<BODY><H2>$header</H2>"
    global manual
    if {[info exists manual(subheader)]} {
	set subs {}
	foreach {name subdir} $manual(subheader) {
	    if {$name eq $title} {
		lappend subs $name
	    } else {
		lappend subs "<A HREF=\"${level}$subdir/[indexfile]\">$name</A>"
	    }
	}
	append out "\n<H3>[join $subs { | }]</H3>"
    }
    return $out
}

##
## parsing
##
proc unquote arg {
    return [string map [list \" {}] $arg]
}

proc parse-directive {line codename restname} {
    upvar 1 $codename code $restname rest
    return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
}

proc htmlize-text {text {charmap {}}} {
    # contains some extras for use in nroff->html processing
    # build on the list passed in, if any
    lappend charmap \
	"&ndash;" "&ndash;" \
	{&}	{&amp;} \
	{\\}	"&#92;" \
	{\e}	"&#92;" \
	{\ }	{&nbsp;} \
	{\|}	{&nbsp;} \
	{\0}	{ } \
	\"	{&quot;} \
	{<}	{&lt;} \
	{>}	{&gt;} \
	\u201c "&#8220;" \
	\u201d "&#8221;"

    return [string map $charmap $text]
}

proc process-text {text} {
    global manual
    # preprocess text; note that this is an incomplete map, and will probably
    # need to have things added to it as the manuals expand to use them.
    set charmap [list \
	    {\&}	"\t" \
	    {\%}	{} \
	    "\\\n"	"\n" \
	    {\(+-}	"&#177;" \
	    {\(co}	"&copy;" \
	    {\(em}	"&#8212;" \
	    {\(en}	"&#8211;" \
	    {\(fm}	"&#8242;" \
	    {\(mc}	"&#181;" \
	    {\(mu}	"&#215;" \
	    {\(mi}	"&#8722;" \
	    {\(->}	"<font size=\"+1\">&#8594;</font>" \
	    {\fP}	{\fR} \
	    {\.}	. \
	    {\(bu}	"&#8226;" \
	    ]
    # This might make a few invalid mappings, but we don't use them
    foreach c {a e i o u y A E I O U Y} {
	foreach {prefix suffix} {
	    o ring / slash : uml ' acute ^ circ ` grave
	} {
	    lappend charmap "\\\[${prefix}${c}\]" "&${c}${suffix};"
	}
    }
    lappend charmap {\-\|\-} --        ; # two hyphens
    lappend charmap {\-} -             ; # a hyphen

    set text [htmlize-text $text $charmap]
    # General quoted entity
    regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text
    while {[string first "\\" $text] >= 0} {
	# C R
	if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
		{\1<TT>\2</TT>\3} text]} continue
	# B R
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
		{\1<B>\2</B>\3} text]} continue
	# B I
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
		{\1<B>\2</B>\\fI\3} text]} continue
	# I R
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
		{\1<I>\2</I>\3} text]} continue
	# I B
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
		{\1<I>\2</I>\\fB\3} text]} continue
	# B B, I I, R R
	if {
	    [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
		{\1\\fB\2\3} ntext]
	    || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
		    {\1\\fI\2\3} ntext]
	    || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
		    {\1\\fR\2\3} ntext]
	} {
	    manerror "impotent font change: $text"
	    set text $ntext
	    continue
	}
	# unrecognized
	manerror "uncaught backslash: $text"
	set text [string map [list "\\" "&#92;"] $text]
    }
    return $text
}

##
## pass 2 text input and matching
##
proc open-text {} {
    global manual
    set manual(text-length) [llength $manual(text)]
    set manual(text-pointer) 0
}

proc more-text {} {
    global manual
    return [expr {$manual(text-pointer) < $manual(text-length)}]
}

proc next-text {} {
    global manual
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	incr manual(text-pointer)
	return $text
    }
    manerror "read past end of text"
    error "fatal"
}

proc is-a-directive {line} {
    return [string match .* $line]
}

proc split-directive {line opname restname} {
    upvar 1 $opname op $restname rest
    set op [string range $line 0 2]
    set rest [string trim [string range $line 3 end]]
}

proc next-op-is {op restname} {
    global manual
    upvar 1 $restname rest
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	if {[string equal -length 3 $text $op]} {
	    set rest [string range $text 4 end]
	    incr manual(text-pointer)
	    return 1
	}
    }
    return 0
}

proc backup-text {n} {
    global manual
    if {$manual(text-pointer)-$n >= 0} {
	incr manual(text-pointer) -$n
    }
}

proc match-text args {
    global manual
    set nargs [llength $args]
    if {$manual(text-pointer) + $nargs > $manual(text-length)} {
	return 0
    }
    set nback 0
    foreach arg $args {
	if {![more-text]} {
	    backup-text $nback
	    return 0
	}
	set arg [string trim $arg]
	set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
	if {$arg eq $targ} {
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp {^@(\w+)$} $arg all name]} {
	    upvar 1 $name var
	    set var $targ
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
		&& [string equal $op [lindex $targ 0]]} {
	    upvar 1 $name var
	    set var [lrange $targ 1 end]
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	backup-text $nback
	return 0
    }
    return 1
}

proc expand-next-text {n} {
    global manual
    return [join [lrange $manual(text) $manual(text-pointer) \
	    [expr {$manual(text-pointer)+$n-1}]] \n\n]
}

##
## pass 2 output
##
proc man-puts {text} {
    global manual
    lappend manual(output-$manual(wing-file)-$manual(name)) $text
}

##
## build hypertext links to tables of contents
##
proc long-toc {text} {
    global manual
    set here M[incr manual(section-toc-n)]
    set manual($manual(name)-id-$text) $here
    set there L[incr manual(long-toc-n)]
    lappend manual(section-toc) \
	    "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
    return "<A NAME=\"$here\">$text</A>"
}

proc option-toc {name class switch} {
    global manual
    # Special case handling, oh we hate it but must do it
    if {[string match "*OPTIONS" $manual(section)]} {
	if {$manual(name) ne "ttk_widget" && ($manual(name) ne "ttk_entry" ||
		![string match validate* $name])} {
	    # link the defined option into the long table of contents
	    set link [long-toc "$switch, $name, $class"]
	    regsub -- "$switch, $name, $class" $link "$switch" link
	    return $link
	}
    } elseif {"$manual(name):$manual(section)" ne "options:DESCRIPTION"} {
	error "option-toc in $manual(name) section $manual(section)"
    }

    # link the defined standard option to the long table of contents and make
    # a target for the standard option references from other man pages.

    set first [lindex $switch 0]
    set here M$first
    set there L[incr manual(long-toc-n)]
    set manual(standard-option-$manual(name)-$first) \
	"<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
    lappend manual(section-toc) \
	"<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
    return "<A NAME=\"$here\">$switch</A>"
}

proc std-option-toc {name page} {
    global manual
    if {[info exists manual(standard-option-$page-$name)]} {
	lappend manual(section-toc) <DD>$manual(standard-option-$page-$name)
	return $manual(standard-option-$page-$name)
    }
    manerror "missing reference to \"$name\" in $page.n"
    set here M[incr manual(section-toc-n)]
    set there L[incr manual(long-toc-n)]
    set other M$name
    lappend manual(section-toc) "<DD><A HREF=\"$page.htm#$other\">$name</A>"
    return "<A HREF=\"$page.htm#$other\">$name</A>"
}

##
## process the widget option section
## in widget and options man pages
##
proc output-widget-options {rest} {
    global manual
    man-puts <DL>
    lappend manual(section-toc) <DL>
    backup-text 1
    set para {}
    while {[next-op-is .OP rest]} {
	switch -exact -- [llength $rest] {
	    3 {
		lassign $rest switch name class
	    }
	    5 {
		set switch [lrange $rest 0 2]
		set name [lindex $rest 3]
		set class [lindex $rest 4]
	    }
	    default {
		fatal "bad .OP $rest"
	    }
	}
	if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch \
		all oswitch switch cswitch]} {
	    if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch \
		    all oswitch switch1 switch2 cswitch]} {
		error "not Switch: $switch"
	    }
	    set switch "$switch1$cswitch or $oswitch$switch2"
	}
	if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
	    error "not Name: $name"
	}
	if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
	    error "not Class: $class"
	}
	man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
	man-puts "<DT>Database Name: $oname$name$cname"
	man-puts "<DT>Database Class: $oclass$class$cclass"
	man-puts <DD>[next-text]
	set para <P>

	if {[next-op-is .RS rest]} {
	    while {[more-text]} {
		set line [next-text]
		if {[is-a-directive $line]} {
		    split-directive $line code rest
		    switch -exact -- $code {
			.RE {
			    break
			}
			.SH - .SS {
			    manerror "unbalanced .RS at section end"
			    backup-text 1
			    break
			}
			default {
			    output-directive $line
			}
		    }
		} else {
		    man-puts $line
		}
	    }
	}
    }
    man-puts </DL>
    lappend manual(section-toc) </DL>
}

##
## process .RS lists
##
proc output-RS-list {} {
    global manual
    if {[next-op-is .IP rest]} {
	output-IP-list .RS .IP $rest
	if {[match-text .RE .sp .RS @rest .IP @rest2]} {
	    man-puts <P>$rest
	    output-IP-list .RS .IP $rest2
	}
	if {[match-text .RE .sp .RS @rest .RE]} {
	    man-puts <P>$rest
	    return
	}
	if {[next-op-is .RE rest]} {
	    return
	}
    }
    man-puts <DL><DD>
    while {[more-text]} {
	set line [next-text]
	if {[is-a-directive $line]} {
	    split-directive $line code rest
	    switch -exact -- $code {
		.RE {
		    break
		}
		.SH - .SS {
		    manerror "unbalanced .RS at section end"
		    backup-text 1
		    break
		}
		default {
		    output-directive $line
		}
	    }
	} else {
	    man-puts $line
	}
    }
    man-puts </DL>
}

##
## process .IP lists which may be plain indents,
## numeric lists, or definition lists
##
proc output-IP-list {context code rest} {
    global manual
    if {![string length $rest]} {
	# blank label, plain indent, no contents entry
	man-puts <DL><DD>
	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		if {$code eq ".IP" && $rest eq {}} {
		    man-puts "<P>"
		    continue
		}
		if {$code in {.br .DS .RS}} {
		    output-directive $line
		} else {
		    backup-text 1
		    break
		}
	    } else {
		man-puts $line
	    }
	}
	man-puts </DL>
    } else {
	# labelled list, make contents
	if {$context ne ".SH" && $context ne ".SS"} {
	    man-puts <P>
	}
	set dl "<DL class=\"[string tolower $manual(section)]\">"
	set enddl "</DL>"
	if {$code eq ".IP"} {
	    if {[regexp {^\[[\da-f]+\]|\(?[\da-f]+\)$} $rest]} {
		set dl "<OL class=\"[string tolower $manual(section)]\">"
		set enddl "</OL>"
	    } elseif {"&#8226;" eq $rest} {
		set dl "<UL class=\"[string tolower $manual(section)]\">"
		set enddl "</UL>"
	    }
	}
	man-puts $dl
	lappend manual(section-toc) $dl
	backup-text 1
	set accept_RE 0
	set para {}
	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		switch -exact -- $code {
		    .IP {
			if {$accept_RE} {
			    output-IP-list .IP $code $rest
			    continue
			}
			if {$manual(section) eq "ARGUMENTS"} {
			    man-puts "$para<DT>$rest<DD>"
			} elseif {[regexp {^\[([\da-f]+)\]$} $rest -> value]} {
			    man-puts "$para<LI value=\"$value\">"
			} elseif {[regexp {^\(?([\da-f]+)\)$} $rest -> value]} {
			    man-puts "$para<LI value=\"$value\">"
			} elseif {"&#8226;" eq $rest} {
			    man-puts "$para<LI>"
			} else {
			    man-puts "$para<DT>[long-toc $rest]<DD>"
			}
		    }
		    .sp - .br - .DS - .CS {
			output-directive $line
		    }
		    .RS {
			if {[match-text .RS]} {
			    output-directive $line
			    incr accept_RE 1
			} elseif {[match-text .CS]} {
			    output-directive .CS
			    incr accept_RE 1
			} elseif {[match-text .PP]} {
			    output-directive .PP
			    incr accept_RE 1
			} elseif {[match-text .DS]} {
			    output-directive .DS
			    incr accept_RE 1
			} else {
			    output-directive $line
			}
		    }
		    .PP {
			if {[match-text @rest1 .br @rest2 .RS]} {
			    # yet another nroff kludge as above
			    man-puts "$para<DT>[long-toc $rest1]"
			    man-puts "<DT>[long-toc $rest2]<DD>"
			    incr accept_RE 1
			} elseif {[match-text @rest .RE]} {
			    # gad, this is getting ridiculous
			    if {!$accept_RE} {
				man-puts "$enddl<P>$rest$dl"
				backup-text 1
				set para {}
				break
			    }
			    man-puts "<P>$rest"
			    incr accept_RE -1
			} elseif {$accept_RE} {
			    output-directive $line
			} else {
			    backup-text 1
			    break
			}
		    }
		    .RE {
			if {!$accept_RE} {
			    backup-text 1
			    break
			}
			incr accept_RE -1
		    }
		    default {
			backup-text 1
			break
		    }
		}
	    } else {
		man-puts $line
	    }
	    set para <P>
	}
	man-puts "$para$enddl"
	lappend manual(section-toc) $enddl
	if {$accept_RE} {
	    manerror "missing .RE in output-IP-list"
	}
    }
}

##
## handle the NAME section lines
## there's only one line in the NAME section,
## consisting of a comma separated list of names,
## followed by a hyphen and a short description.
##
proc output-name {line} {
    global manual
    # split name line into pieces
    regexp {^([^-]+) - (.*)$} [regsub -all {[ \n\r\t]+} $line " "] -> head tail
    # output line to manual page untouched
    man-puts "$head &mdash; $tail"
    # output line to long table of contents
    lappend manual(section-toc) "<DL><DD>$head &mdash; $tail</DD></DL>"
    # separate out the names for future reference
    foreach name [split $head ,] {
	set name [string trim $name]
	if {[llength $name] > 1} {
	    manerror "name has a space: {$name}\nfrom: $line"
	}
	lappend manual(wing-toc) $name
	lappend manual(name-$name) $manual(wing-file)/$manual(name)
    }
    set manual(tooltip-$manual(wing-file)/$manual(name).htm) $line
}

##
## build a cross-reference link if appropriate
##
proc cross-reference {ref} {
    global manual remap_link_target
    global ensemble_commands exclude_refs_map exclude_when_followed_by_map
    set manname $manual(name)
    set mantail $manual(tail)
    if {[string match "Tcl_*" $ref] || [string match "Tk_*" $ref] || [string match "Ttk_*" $ref] || [string match "Itcl_*" $ref] || [string match "Tdbc_*" $ref]} {
	regexp {^\w+} $ref lref
	##
	## apply a link remapping if available
	##
	if {[info exists remap_link_target($lref)]} {
	    set lref $remap_link_target($lref)
	}
    } elseif {$ref eq "Tcl"} {
	set lref $ref
    } elseif {
	[regexp {^[A-Z0-9 ?!]+$} $ref]
	&& [info exists manual($manname-id-$ref)]
    } {
	return "<A HREF=\"#$manual($manname-id-$ref)\">$ref</A>"
    } else {
	set lref [string tolower $ref]
	##
	## apply a link remapping if available
	##
	if {[info exists remap_link_target($lref)]} {
	    set lref $remap_link_target($lref)
	}
    }
    ##
    ## nothing to reference
    ##
    if {![info exists manual(name-$lref)]} {
	foreach name $ensemble_commands {
	    if {
		[regexp "^$name \[a-z0-9]*\$" $lref] &&
		[info exists manual(name-$name)] &&
		$mantail ne "$name.n" &&
		(![info exists exclude_refs_map($mantail)] ||
		$manual(name-$name) ni $exclude_refs_map($mantail))
	    } {
		return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
	    }
	}
	if {$lref in {end}} {
	    # no good place to send this tcl token?
	}
	return $ref
    }
    set manref $manual(name-$lref)
    ##
    ## would be a self reference
    ##
    foreach name $manref {
	if {"$manual(wing-file)/$manname" in $name} {
	    return $ref
	}
    }
    ##
    ## multiple choices for reference
    ##
    if {[llength $manref] > 1} {
	set tcl_i [lsearch -glob $manref *TclCmd*]
	if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd"
		|| $manual(wing-file) eq "TclLib"} {
	    set tcl_ref [lindex $manref $tcl_i]
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	set tk_i [lsearch -glob $manref *TkCmd*]
	if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd"
		|| $manual(wing-file) eq "TkLib"} {
	    set tk_ref [lindex $manref $tk_i]
	    return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
	}
	if {$lref eq "exit" && $mantail eq "tclsh.1" && $tcl_i >= 0} {
	    set tcl_ref [lindex $manref $tcl_i]
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	puts stderr "multiple cross reference to $ref in $manref from $manual(wing-file)/$mantail"
	return $ref
    }
    ##
    ## exceptions, sigh, to the rule
    ##
    if {[info exists exclude_when_followed_by_map($mantail)]} {
	upvar 1 text tail
	set following_word [lindex [regexp -inline {\S+} $tail] 0]
	foreach {this that} $exclude_when_followed_by_map($mantail) {
	    # only a ref if $this is not followed by $that
	    if {$lref eq $this && [string match $that* $following_word]} {
		return $ref
	    }
	}
    }
    if {
	[info exists exclude_refs_map($mantail)]
	&& $lref in $exclude_refs_map($mantail)
    } {
	return $ref
    }
    ##
    ## return the cross reference
    ##
    return "<A HREF=\"../$manref.htm\">$ref</A>"
}

##
## reference generation errors
##
proc reference-error {msg text} {
    global manual
    puts stderr "$manual(tail): $msg: {$text}"
    return $text
}

##
## insert as many cross references into this text string as are appropriate
##
proc insert-cross-references {text} {
    global manual
    set result ""

    while 1 {
	##
	## we identify cross references by:
	##     ``quotation''
	##    <B>emboldening</B>
	##    Tcl_ prefix
	##    Tk_ prefix
	##	  [a-zA-Z0-9]+ manual entry
	## and we avoid messing with already anchored text
	##
	##
	## find where each item lives - EXPENSIVE - and accumulate a list
	##
	unset -nocomplain offsets
	foreach {name pattern} {
	    anchor     {<A }	end-anchor {</A>}
	    quote      {``}	end-quote  {''}
	    bold       {<B>}	end-bold   {</B>}
	    c.tcl      {Tcl_}
	    c.tk       {Tk_}
	    c.ttk      {Ttk_}
	    c.tdbc     {Tdbc_}
	    c.itcl     {Itcl_}
	    Tcl1       {Tcl manual entry}
	    Tcl2       {Tcl overview manual entry}
	    url	       {http://}
	} {
	    set o [string first $pattern $text]
	    if {[set offset($name) $o] >= 0} {
		set invert($o) $name
		lappend offsets $o
	    }
	}
	##
	## if nothing, then we're done.
	##
	if {![info exists offsets]} {
	    return [append result $text]
	}
	##
	## sort the offsets
	##
	set offsets [lsort -integer $offsets]
	##
	## see which we want to use
	##
	switch -exact -- $invert([lindex $offsets 0]) {
	    anchor {
		if {$offset(end-anchor) < 0} {
		    return [reference-error {Missing end anchor} $text]
		}
		append result [string range $text 0 $offset(end-anchor)]
		set text [string range $text[set text ""] \
			      [expr {$offset(end-anchor)+1}] end]
		continue
	    }
	    quote {
		if {$offset(end-quote) < 0} {
		    return [reference-error "Missing end quote" $text]
		}
		if {$invert([lindex $offsets 1]) in {tcl tk ttk}} {
		    set offsets [lreplace $offsets 1 1]
		}
		switch -exact -- $invert([lindex $offsets 1]) {
		    end-quote {
			append result [string range $text 0 [expr {$offset(quote)-1}]]
			set body [string range $text [expr {$offset(quote)+2}] \
				      [expr {$offset(end-quote)-1}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-quote)+2}] end]
			append result `` [cross-reference $body] ''
			continue
		    }
		    bold - anchor {
			append result [string range $text \
				      0 [expr {$offset(end-quote)+1}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-quote)+2}] end]
			continue
		    }
		}
		return [reference-error "Uncaught quote case" $text]
	    }
	    bold {
		if {$offset(end-bold) < 0} {
		    return [append result $text]
		}
		if {[string match "c.*" $invert([lindex $offsets 1])]} {
		    set offsets [lreplace $offsets 1 1]
		}
		switch -exact -- $invert([lindex $offsets 1]) {
		    url - end-bold {
			append result \
			    [string range $text 0 [expr {$offset(bold)-1}]]
			set body [string range $text [expr {$offset(bold)+3}] \
				      [expr {$offset(end-bold)-1}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-bold)+4}] end]
			regsub {http://[\w/.-]+} $body {<A HREF="&">&</A>} body
			append result <B> [cross-reference $body] </B>
			continue
		    }
		    anchor {
			append result \
			    [string range $text 0 [expr {$offset(end-bold)+3}]]
			set text [string range $text[set text ""] \
				      [expr {$offset(end-bold)+4}] end]
			continue
		    }
		    default {
			return [reference-error "Uncaught bold case" $text]
		    }
		}
	    }
	    c.tk - c.ttk - c.tcl - c.tdbc - c.itcl {
		append result [string range $text 0 \
				   [expr {[lindex $offsets 0]-1}]]
		regexp -indices -start [lindex $offsets 0] {\w+} $text range
		set body [string range $text {*}$range]
		set text [string range $text[set text ""] \
			      [expr {[lindex $range 1]+1}] end]
		append result [cross-reference $body]
		continue
	    }
	    Tcl1 - Tcl2 {
		set off [lindex $offsets 0]
		append result [string range $text 0 [expr {$off-1}]]
		set text [string range $text[set text ""] [expr {$off+3}] end]
		append result [cross-reference Tcl]
		continue
	    }
	    url {
		set off [lindex $offsets 0]
		append result [string range $text 0 [expr {$off-1}]]
		regexp -indices -start $off {http://[\w/.-]+} $text range
		set url [string range $text {*}$range]
		append result "<A HREF=\"[string trimright $url .]\">$url</A>"
		set text [string range $text[set text ""] \
			      [expr {[lindex $range 1]+1}] end]
		continue
	    }
	    end-anchor - end-bold - end-quote {
		return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
	    }
	}
    }
}

##
## process formatting directives
##
proc output-directive {line} {
    global manual
    # process format directive
    split-directive $line code rest
    switch -exact -- $code {
	.BS - .BE {
	    # man-puts <HR>
	}
	.SH - .SS {
	    # drain any open lists
	    # announce the subject
	    set manual(section) $rest
	    # start our own stack of stuff
	    set manual($manual(name)-$manual(section)) {}
	    lappend manual(has-$manual(section)) $manual(name)
	    if {$code ne ".SS"} {
		man-puts "<H3>[long-toc $manual(section)]</H3>"
	    } else {
		man-puts "<H4>[long-toc $manual(section)]</H4>"
	    }
	    # some sections can simply free wheel their way through the text
	    # some sections can be processed in their own loops
	    switch -exact -- [string index $code end]:$manual(section) {
		H:NAME {
		    set names {}
		    while {1} {
			set line [next-text]
			if {[is-a-directive $line]} {
			    backup-text 1
			    if {[llength $names]} {
				output-name [join $names { }]
			    }
			    return
			}
			lappend names [string trim $line]
		    }
		}
		H:SYNOPSIS {
		    lappend manual(section-toc) <DL>
		    while {1} {
			if {
			    [next-op-is .nf rest]
			    || [next-op-is .br rest]
			    || [next-op-is .fi rest]
			} {
			    continue
			}
			if {
			    [next-op-is .SH rest]
			    || [next-op-is .SS rest]
			    || [next-op-is .BE rest]
			    || [next-op-is .SO rest]
			} {
			    backup-text 1
			    break
			}
			if {[next-op-is .sp rest]} {
			    #man-puts <P>
			    continue
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "in SYNOPSIS found $more"
			    backup-text 1
			    break
			}
			foreach more [split $more \n] {
			    regexp {^(\s*)(.*)} $more -> spaces more
			    set spaces [string map {" " "&nbsp;"} $spaces]
			    if {[string length $spaces]} {
				set spaces <TT>$spaces</TT>
			    }
			    man-puts $spaces$more<BR>
			    if {$manual(wing-file) in {TclLib TkLib}} {
				lappend manual(section-toc) <DD>$more
			    }
			}
		    }
		    lappend manual(section-toc) </DL>
		    return
		}
		{H:SEE ALSO} {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set nmore {}
			foreach cr [split $more ,] {
			    set cr [string trim $cr]
			    if {![regexp {^<B>.*</B>$} $cr]} {
				set cr <B>$cr</B>
			    }
			    if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
				set cr <B>$name</B>
			    }
			    lappend nmore $cr
			}
			man-puts [join $nmore {, }]
		    }
		    return
		}
		H:KEYWORDS {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set keys {}
			foreach key [split $more ,] {
			    set key [string trim $key]
			    lappend manual(keyword-$key) [list $manual(name) \
				    $manual(wing-file)/$manual(name).htm]
			    set initial [string toupper [string index $key 0]]
			    lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
			}
			man-puts [join $keys {, }]
		    }
		    return
		}
	    }
	    if {[next-op-is .IP rest]} {
		output-IP-list $code .IP $rest
		return
	    }
	    if {[next-op-is .PP rest]} {
		return
	    }
	    return
	}
	.SO {
	    # When there's a sequence of multiple .SO chunks, process into one
	    set optslist {}
	    while 1 {
		if {[match-text @stuff .SE]} {
		    foreach opt [split $stuff \n\t] {
			lappend optslist [list $opt $rest]
		    }
		} else {
		    manerror "unexpected .SO format:\n[expand-next-text 2]"
		}
		if {![next-op-is .SO rest]} {
		    break
		}
	    }
	    output-directive {.SH STANDARD OPTIONS}
	    man-puts <DL>
	    lappend manual(section-toc) <DL>
	    foreach optionpair [lsort -dictionary -index 0 $optslist] {
		lassign $optionpair option targetPage
		man-puts "<DT><B>[std-option-toc $option $targetPage]</B>"
	    }
	    man-puts </DL>
	    lappend manual(section-toc) </DL>
	}
	.OP {
	    output-widget-options $rest
	    return
	}
	.IP {
	    output-IP-list .IP .IP $rest
	    return
	}
	.PP - .sp {
	    man-puts <P>
	}
	.RS {
	    output-RS-list
	    return
	}
	.br {
	    man-puts <BR>
	    return
	}
	.DS {
	    if {[next-op-is .ta rest]} {
		# skip the leading .ta directive if it is there
	    }
	    if {[match-text @stuff .DE]} {
		set td "<td><p class=\"tablecell\">"
		set bodyText [string map [list \n <tr>$td \t $td] \n$stuff]
		man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>"
		#man-puts <PRE>$stuff</PRE>
	    } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
		man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
	    } else {
		manerror "unexpected .DS format:\n[expand-next-text 2]"
	    }
	    return
	}
	.CS {
	    if {[next-op-is .ta rest]} {
		# ???
	    }
	    if {[match-text @stuff .CE]} {
		man-puts <PRE>$stuff</PRE>
	    } else {
		manerror "unexpected .CS format:\n[expand-next-text 2]"
	    }
	    return
	}
	.nf {
	    if {[match-text @more .fi]} {
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
	    } elseif {[match-text .RS @more .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts </DL>
	    } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL></DL>
	    } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL><DD>
		foreach more3 [split $more3 \n] {
		    man-puts $more3<BR>
		}
		man-puts </DL>
	    } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
		man-puts <P><DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL></DL><P>
	    } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
		man-puts <P><DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts </DL><P>
	    } else {
		manerror "ignoring $line"
	    }
	}
	.RE - .DE - .CE {
	    manerror "unexpected $code"
	    return
	}
	.ta - .fi - .na - .ad - .UL - .ie - .el - .ne {
	    manerror "ignoring $line"
	}
	default {
	    manerror "unrecognized format directive: $line"
	}
    }
}

##
## merge copyright listings
##
proc merge-copyrights {l1 l2} {
    set merge {}
    set re1 {^Copyright +(?:\(c\)|\\\(co|&copy;) +(\w.*?)(?:all rights reserved)?(?:\. )*$}
    set re2 {^(\d+) +(?:by +)?(\w.*)$}         ;# date who
    set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$}   ;# from to who
    set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who
    foreach copyright [concat $l1 $l2] {
	if {[regexp -nocase -- $re1 $copyright -> info]} {
	    set info [string trimright $info ". "] ; # remove extra period
	    if {[regexp -- $re2 $info -> date who]} {
		lappend dates($who) $date
		continue
	    } elseif {[regexp -- $re3 $info -> from to who]} {
		for {set date $from} {$date <= $to} {incr date} {
		    lappend dates($who) $date
		}
		continue
	    } elseif {[regexp -- $re3 $info -> date1 date2 who]} {
		lappend dates($who) $date1 $date2
		continue
	    }
	}
	puts "oops: $copyright"
    }
    foreach who [array names dates] {
	set list [lsort -dictionary $dates($who)]
	if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} {
	    lappend merge "Copyright &copy; [lindex $list 0] $who"
	} else {
	    lappend merge "Copyright &copy; [lindex $list 0]-[lrange $list end end] $who"
	}
    }
    return [lsort -dictionary $merge]
}

##
## foreach of the man pages in the section specified by
## sectionDescriptor, convert manpages into hypertext in
## the directory specified by outputDir.
##
proc make-manpage-section {outputDir sectionDescriptor} {
    global manual overall_title tcltkdesc verbose
    global excluded_pages forced_index_pages process_first_patterns

    set LQ \u201c
    set RQ \u201d

    lassign $sectionDescriptor \
	manual(wing-glob) \
	manual(wing-name) \
	manual(wing-file) \
	manual(wing-description)
    set manual(wing-copyrights) {}
    makedirhier $outputDir/$manual(wing-file)
    set manual(wing-toc-fp) [open $outputDir/$manual(wing-file)/[indexfile] w]
    # whistle
    puts stderr "scanning section $manual(wing-name)"
    # put the entry for this section into the short table of contents
    if {[regexp {^(.+), version (.+)$} $manual(wing-name) -> name version]} {
	puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\" TITLE=\"version $version\">$name</A></DT><DD>$manual(wing-description)</DD>"
    } else {
	puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>"
    }
    # initialize the wing table of contents
    puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \
	    $manual(wing-name) $overall_title "../[indexfile]"]
    # initialize the short table of contents for this section
    set manual(wing-toc) {}
    # initialize the man directory for this section
    makedirhier $outputDir/$manual(wing-file)
    # initialize the long table of contents for this section
    set manual(long-toc-n) 1
    # get the manual pages for this section
    set manual(pages) [lsort -dictionary [glob -nocomplain $manual(wing-glob)]]
    # Some pages have to go first so that their links override others
    foreach pat $process_first_patterns {
	set n [lsearch -glob $manual(pages) $pat]
	if {$n >= 0} {
	    set f [lindex $manual(pages) $n]
	    puts stderr "shuffling [file tail $f] to front of processing queue"
	    set manual(pages) \
		[linsert [lreplace $manual(pages) $n $n] 0 $f]
	}
    }
    # set manual(pages) [lrange $manual(pages) 0 5]
    foreach manual_page $manual(pages) {
	set manual(page) [file normalize $manual_page]
	# whistle
	if {$verbose} {
	    puts stderr "scanning page $manual(page)"
	} else {
	    puts -nonewline stderr .
	}
	set manual(tail) [file tail $manual(page)]
	set manual(name) [file root $manual(tail)]
	set manual(section) {}
	if {$manual(name) in $excluded_pages} {
	    # obsolete
	    if {!$verbose} {
		puts stderr ""
	    }
	    manerror "discarding $manual(name)"
	    continue
	}
	set manual(infp) [open $manual(page)]
	set manual(text) {}
	set manual(partial-text) {}
	foreach p {.RS .DS .CS .SO} {
	    set manual($p) 0
	}
	set manual(stack) {}
	set manual(section) {}
	set manual(section-toc) {}
	set manual(section-toc-n) 1
	set manual(copyrights) {}
	lappend manual(all-pages) $manual(wing-file)/$manual(tail)
	lappend manual(all-page-domains) $manual(wing-name)
	manreport 100 $manual(name)
	while {[gets $manual(infp) line] >= 0} {
	    manreport 100 $line
	    if {[regexp {^[`'][/\\]} $line]} {
		if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} {
		    lappend manual(copyrights) $copyright
		}
		# comment
		continue
	    }
	    if {"$line" eq {'}} {
		# comment
		continue
	    }
	    if {![parse-directive $line code rest]} {
		addbuffer $line
		continue
	    }
	    switch -exact -- $code {
		.if - .nr - .ti - .in - .ie - .el -
		.ad - .na - .so - .ne - .AS - .HS - .VE - .VS - . {
		    # ignore
		    continue
		}
	    }
	    switch -exact -- $code {
		.SH - .SS {
		    flushbuffer
		    if {[llength $rest] == 0} {
			gets $manual(infp) rest
		    }
		    lappend manual(text) "$code [unquote $rest]"
		}
		.TH {
		    flushbuffer
		    lappend manual(text) "$code [unquote $rest]"
		}
		.QW {
		    lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
			inQuote afterwards
		    addbuffer $LQ [unquote $inQuote] $RQ [unquote $afterwards]
		}
		.PQ {
		    lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
			inQuote punctuation afterwards
		    addbuffer ( $LQ [unquote $inQuote] $RQ \
			    [unquote $punctuation] ) [unquote $afterwards]
		}
		.QR {
		    lassign [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest] \
			rangeFrom rangeTo afterwards
		    addbuffer $LQ [unquote $rangeFrom] "&ndash;" \
			    [unquote $rangeTo] $RQ [unquote $afterwards]
		}
		.MT {
		    addbuffer $LQ$RQ
		}
		.HS - .UL - .ta {
		    flushbuffer
		    lappend manual(text) "$code [unquote $rest]"
		}
		.BS - .BE - .br - .fi - .sp - .nf {
		    flushbuffer
		    if {$rest ne ""} {
			if {!$verbose} {
			    puts stderr ""
			}
			manerror "unexpected argument: $line"
		    }
		    lappend manual(text) $code
		}
		.AP {
		    flushbuffer
		    lappend manual(text) [concat .IP [process-text \
			    "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
		}
		.IP {
		    flushbuffer
		    regexp {^(.*) +\d+$} $rest all rest
		    lappend manual(text) ".IP [process-text \
			    [unquote [string trim $rest]]]"
		}
		.TP {
		    flushbuffer
		    while {[is-a-directive [set next [gets $manual(infp)]]]} {
			if {!$verbose} {
			    puts stderr ""
			}
			manerror "ignoring $next after .TP"
		    }
		    if {"$next" ne {'}} {
			lappend manual(text) ".IP [process-text $next]"
		    }
		}
		.OP {
		    flushbuffer
		    lassign $rest cmdName dbName dbClass
		    lappend manual(text) [concat .OP [process-text \
			    "\\fB$cmdName\\fR \\fB$dbName\\fR \\fB$dbClass\\fR"]]
		}
		.PP - .LP {
		    flushbuffer
		    lappend manual(text) {.PP}
		}
		.RS {
		    flushbuffer
		    incr manual(.RS)
		    lappend manual(text) $code
		}
		.RE {
		    flushbuffer
		    incr manual(.RS) -1
		    lappend manual(text) $code
		}
		.SO {
		    flushbuffer
		    incr manual(.SO)
		    if {[llength $rest] == 0} {
			lappend manual(text) "$code options"
		    } else {
			lappend manual(text) "$code [unquote $rest]"
		    }
		}
		.SE {
		    flushbuffer
		    incr manual(.SO) -1
		    lappend manual(text) $code
		}
		.DS {
		    flushbuffer
		    incr manual(.DS)
		    lappend manual(text) $code
		}
		.DE {
		    flushbuffer
		    incr manual(.DS) -1
		    lappend manual(text) $code
		}
		.CS {
		    flushbuffer
		    incr manual(.CS)
		    lappend manual(text) $code
		}
		.CE {
		    flushbuffer
		    incr manual(.CS) -1
		    lappend manual(text) $code
		}
		.de {
		    while {[gets $manual(infp) line] >= 0} {
			if {[string match "..*" $line]} {
			    break
			}
		    }
		}
		.. {
		    if {!$verbose} {
			puts stderr ""
		    }
		    error "found .. outside of .de"
		}
		default {
		    if {!$verbose} {
			puts stderr ""
		    }
		    flushbuffer
		    manerror "unrecognized format directive: $line"
		}
	    }
	}
	flushbuffer
	close $manual(infp)
	# fixups
	if {$manual(.RS) != 0} {
	    if {!$verbose} {
		puts stderr ""
	    }
	    puts "unbalanced .RS .RE"
	}
	if {$manual(.DS) != 0} {
	    if {!$verbose} {
		puts stderr ""
	    }
	    puts "unbalanced .DS .DE"
	}
	if {$manual(.CS) != 0} {
	    if {!$verbose} {
		puts stderr ""
	    }
	    puts "unbalanced .CS .CE"
	}
	if {$manual(.SO) != 0} {
	    if {!$verbose} {
		puts stderr ""
	    }
	    puts "unbalanced .SO .SE"
	}
	# output conversion
	open-text
	set haserror 0
	if {[next-op-is .HS rest]} {
	    set manual($manual(wing-file)-$manual(name)-title) \
		"[join [lrange $rest 1 end] { }] [lindex $rest 0] manual page"
	} elseif {[next-op-is .TH rest]} {
	    set manual($manual(wing-file)-$manual(name)-title) \
		"[lindex $rest 0] manual page - [join [lrange $rest 4 end] { }]"
	} else {
	    set haserror 1
	    if {!$verbose} {
		puts stderr ""
	    }
	    manerror "no .HS or .TH record found"
	}
	if {!$haserror} {
	    while {[more-text]} {
		set line [next-text]
		if {[is-a-directive $line]} {
		    output-directive $line
		} else {
		    man-puts $line
		}
	    }
	    man-puts [copyout $manual(copyrights) "../"]
	    set manual(wing-copyrights) [merge-copyrights \
		    $manual(wing-copyrights) $manual(copyrights)]
	}
	#
	# make the long table of contents for this page
	#
	set manual(toc-$manual(wing-file)-$manual(name)) \
	    [concat <DL> $manual(section-toc) </DL>]
    }
    if {!$verbose} {
	puts stderr ""
    }

    if {![llength $manual(wing-toc)]} {
	fatal "not table of contents."
    }

    #
    # make the wing table of contents for the section
    #
    set width 0
    foreach name $manual(wing-toc) {
	if {[string length $name] > $width} {
	    set width [string length $name]
	}
    }
    set perline [expr {118 / $width}]
    set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
    set n 0
    catch {unset rows}
    foreach name [lsort -dictionary $manual(wing-toc)] {
	set tail $manual(name-$name)
	if {[llength $tail] > 1} {
	    manerror "$name is defined in more than one file: $tail"
	    set tail [lindex $tail [expr {[llength $tail]-1}]]
	}
	set tail [file tail $tail]
	if {[info exists manual(tooltip-$manual(wing-file)/$tail.htm)]} {
	    set tooltip $manual(tooltip-$manual(wing-file)/$tail.htm)
	    set tooltip [string map {[ {\[} ] {\]} $ {\$} \\ \\\\} $tooltip]
	    regsub {^[^-]+-\s*(.)} $tooltip {[string totitle \1]} tooltip
	    append rows([expr {$n%$nrows}]) \
		"<td> <a href=\"$tail.htm\" title=\"[subst $tooltip]\">$name</a> </td>"
	} else {
	    append rows([expr {$n%$nrows}]) \
		"<td> <a href=\"$tail.htm\">$name</a> </td>"
	}
	incr n
    }
    puts $manual(wing-toc-fp) <table>
    foreach row [lsort -integer [array names rows]] {
	puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
    }
    puts $manual(wing-toc-fp) </table>

    #
    # insert wing copyrights
    #
    puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"]
    puts $manual(wing-toc-fp) "</BODY></HTML>"
    close $manual(wing-toc-fp)
    set manual(merge-copyrights) \
	[merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
}

proc makedirhier {dir} {
    try {
	if {![file isdirectory $dir]} {
	    file mkdir $dir
	}
    } on error msg {
	return -code error "cannot create directory $dir: $msg"
    }
}

proc addbuffer {args} {
    global manual
    if {$manual(partial-text) ne ""} {
	append manual(partial-text) \n
    }
    append manual(partial-text) [join $args ""]
}
proc flushbuffer {} {
    global manual
    if {$manual(partial-text) ne ""} {
	lappend manual(text) [process-text $manual(partial-text)]
	set manual(partial-text) ""
    }
}

return

Changes to tools/tcltk-man2html.tcl.

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


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
-
-
+
+
-
-
-
-
-
+
-
-













-

-
+
-

-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
+







-

-
-







#!/usr/bin/env tclsh

#!/bin/sh
# The next line is executed by /bin/sh, but not tcl \
if {[catch {package require Tcl 8.6-} msg]} {
    puts stderr "ERROR: $msg"
    puts stderr "If running this script from 'make html', set the\
	NATIVE_TCLSH environment\nvariable to point to an installed\
	tclsh9.0 (or the equivalent tclsh90.exe\non Windows)."
exec tclsh "$0" ${1+"$@"}
    exit 1
}

# Convert Ousterhout format man pages into highly crosslinked hypertext.
#
# Along the way detect many unmatched font changes and other odd things.
#
# Note well, this program is a hack rather than a piece of software
# engineering.  In that sense it's probably a good example of things
# that a scripting language, like Tcl, can do well.  It is offered as
# an example of how someone might convert a specific set of man pages
# into hypertext, not as a general solution to the problem.  If you
# try to use this, you'll be very much on your own.
#
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
# Copyright (c) 2004-2010 Donal K. Fellows

set ::Version "50/9.0"
set Version "0.40"
set ::CSSFILE "docs.css"

##
## Source the utility functions that provide most of the
## implementation of the transformation from nroff to html.
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]

set ::CSSFILE "docs.css"
proc getversion {tclh {name {}}} {
    if {[file exists $tclh]} {
	set chan [open $tclh]
	set data [read $chan]
	close $chan
	if {$name eq ""} {
	    set name [string toupper [file root [file tail $tclh]]]
	}

	# backslash isn't required in front of quote, but it keeps syntax
	# highlighting straight in some editors
	if {[regexp -lineanchor \
	    [string map [list @name@ $name] \
		{^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \
	    $data -> major minor]} {
		return [list $major $minor]
	}
    }
}
proc findversion {top name useversion} {
    # Default search version is a glob pattern, switch it for string match:
    if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} {
	set useversion {[8-9].[0-9]}
    }
    # Search:
    set upper [string toupper $name]
    foreach top1 [list $top $top/..] sub {{} generic} {
	foreach dirname [
	    glob -nocomplain -tails -type d -directory $top1 *] {

	    set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /]
	    set v [getversion $tclh $upper]
	    if {[llength $v]} {
		lassign $v major minor
		# to do
		#     use glob matching instead of string matching or add
		#     brace handling to [string matcch]
		if {$useversion eq {} || [string match $useversion $major.$minor]} {
		    set top [file dirname [file dirname $tclh]]
		    set prefix [file dirname $top]
		    return [list $prefix [file tail $top] $major $minor]
		}
	    }
	}
    }
}

proc parse_command_line {} {
    global argv Version

    # These variables determine where the man pages come from and where
    # the converted pages go to.
    global tcltkdir tkdir tcldir webdir build_tcl build_tk verbose
    global tcltkdir tkdir tcldir webdir build_tcl build_tk

    # Set defaults based on original code.
    set tcltkdir ../..
    set tkdir {}
    set tcldir {}
    set webdir ../html
    set build_tcl 0
    set opt_build_tcl 0
    set build_tk 0
    set opt_build_tk 0
    set verbose 0
    # Default search version is a glob pattern
    set useversion {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}

    # Handle arguments a la GNU:
    #   --version
    #   --useversion=<version>
    #   --help
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
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
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493

1494


1495
1496

1497
1498
1499
1500
1501
1502
1503

1504
1505
1506
1507
1508



1509


1510

1511
1512





1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832

1833
1834
1835
1836
1837
1838
1839
1840







-




















-




-


-
-
-
-












-
-
-

-
+


-
+
-
-
-
-
-
-



-
+


-

-
+

-
-
+
+
-
-
-
-
-
-
-
-






-
-




-
-
+
-
-
-













-
+

-
+

+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+
-
-


-
+






-





-
-
-
+
-
-
+
-


-
-
-
-
-

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-

















-
+







		puts "  --help              print this help, then exit"
		puts "  --version           print version number, then exit"
		puts "  --srcdir=DIR        find tcl and tk source below DIR"
		puts "  --htmldir=DIR       put generated HTML in DIR"
		puts "  --tcl               build tcl help"
		puts "  --tk                build tk help"
		puts "  --useversion        version of tcl/tk to search for"
		puts "  --verbose           whether to print longer messages"
		exit 0
	    }

	    --srcdir=* {
		# length of "--srcdir=" is 9.
		set tcltkdir [string range $option 9 end]
	    }

	    --htmldir=* {
		# length of "--htmldir=" is 10
		set webdir [string range $option 10 end]
	    }

	    --useversion=* {
		# length of "--useversion=" is 13
		set useversion [string range $option 13 end]
	    }

	    --tcl {
		set build_tcl 1
		set opt_build_tcl 1
	    }

	    --tk {
		set build_tk 1
		set opt_build_tk 1
	    }

	    --verbose=* {
		set verbose [string range $option \
				 [string length --verbose=] end]
	    }
	    default {
		puts stderr "tcltk-man-html: unrecognized option -- `$option'"
		exit 1
	    }
	}
    }

    if {!$build_tcl && !$build_tk} {
	set build_tcl 1;
	set build_tk 1
    }

    set major ""
    set minor ""

    if {$build_tcl} {
	# Find Tcl (firstly using glob pattern / backwards compatible way)
	# Find Tcl.
	set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
		-directory $tcltkdir tcl$useversion]] end]
	if {$tcldir ne {}} {
	if {$tcldir eq ""} {
	    # obtain version from generic header if we can:
	    lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor
	} else {
	    lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor
	}
	if {$tcldir eq {} && $opt_build_tcl} {
	    puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
	    exit 1
	}
	puts "using Tcl source directory $tcltkdir $tcldir"
	puts "using Tcl source directory $tcldir"
    }


    if {$build_tk} {
	# Find Tk (firstly using glob pattern / backwards compatible way)
	# Find Tk.
	set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
		-directory $tcltkdir tk$useversion]] end]
	if {$tkdir ne {}} {
				      -directory $tcltkdir tk$useversion]] end]
	if {$tkdir eq ""} {
	    if {$major eq ""} {
		# obtain version from generic header if we can:
		lassign [getversion [file join $tcltkdir $tcldir generic tk.h]] major minor
	    }
	} else {
	    lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor
	}
	if {$tkdir eq {} && $opt_build_tk} {
	    puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
	    exit 1
	}
	puts "using Tk source directory $tkdir"
    }

    puts "verbose messages are [expr {$verbose ? {on} : {off}}]"

    # the title for the man pages overall
    global overall_title
    set overall_title ""
    if {$build_tcl} {
	if {$major ne ""} {
	    append overall_title "Tcl $major.$minor"
	append overall_title "[capitalize $tcldir]"
	} else {
	    append overall_title "Tcl [capitalize $tcldir]"
	}
    }
    if {$build_tcl && $build_tk} {
	append overall_title "/"
    }
    if {$build_tk} {
	append overall_title "[capitalize $tkdir]"
    }
    append overall_title " Documentation"
}

proc capitalize {string} {
    return [string toupper $string 0]
}


##
## Returns the style sheet.
##
##
set manual(report-level) 1
proc css-style args {
    upvar 1 style style
    set body [uplevel 1 [list subst [lindex $args end]]]
    set tokens [join [lrange $args 0 end-1] ", "]
    append style $tokens " \{" $body "\}\n"
}
proc css-stylesheet {} {
    set hBd "1px dotted #11577b"

    css-style body div p th td li dd ul ol dl dt blockquote {
	font-family: Verdana, sans-serif;
    }
    css-style pre code {
	font-family: 'Courier New', Courier, monospace;
    }
    css-style pre {
	background-color:  #f6fcec;
	border-top:        1px solid #6A6A6A;
	border-bottom:     1px solid #6A6A6A;
	padding:           1em;
	overflow:          auto;
    }
    css-style body {
	background-color:  #FFFFFF;
	font-size:         12px;
	line-height:       1.25;
	letter-spacing:    .2px;
	padding-left:      .5em;
    }
    css-style h1 h2 h3 h4 {
	font-family:       Georgia, serif;
	padding-left:      1em;
	margin-top:        1em;
    }
    css-style h1 {
	font-size:         18px;
	color:             #11577b;
	border-bottom:     $hBd;
	margin-top:        0px;
    }
    css-style h2 {
	font-size:         14px;
	color:             #11577b;
	background-color:  #c5dce8;
	padding-left:      1em;
	border:            1px solid #6A6A6A;
    }
    css-style h3 h4 {
	color:             #1674A4;
	background-color:  #e8f2f6;
	border-bottom:     $hBd;
	border-top:        $hBd;
    }
    css-style h3 {
	font-size: 12px;

proc manerror {msg} {
    global manual
    set name {}
    set subj {}
    set procname [lindex [info level -1] 0]
    if {[info exists manual(name)]} {
	set name $manual(name)
    }
    if {[info exists manual(section)] && [string length $manual(section)]} {
	puts stderr "$name: $manual(section): $procname: $msg"
    } else {
	puts stderr "$name: $procname: $msg"
    }
}

proc manreport {level msg} {
    global manual
    if {$level < $manual(report-level)} {
	uplevel 1 [list manerror $msg]
    }
}

proc fatal {msg} {
    global manual
    uplevel 1 [list manerror $msg]
    exit 1
}

##
## templating
##
proc indexfile {} {
    if {[info exists ::TARGET] && $::TARGET eq "devsite"} {
	return "index.tml"
    } else {
	return "contents.htm"
    }
}
proc copyright {copyright {level {}}} {
    # We don't actually generate a separate copyright page anymore
    #set page "${level}copyright.htm"
    #return "<A HREF=\"$page\">Copyright</A> &#169; [htmlize-text [lrange $copyright 2 end]]"
    # obfuscate any email addresses that may appear in name
    set who [string map {@ (at)} [lrange $copyright 2 end]]
    return "Copyright &copy; [htmlize-text $who]"
}
proc copyout {copyrights {level {}}} {
    set out "<div class=\"copy\">"
    foreach c $copyrights {
	append out "[copyright $c $level]\n"
    }
    append out "</div>"
    return $out
}
proc CSS {{level ""}} {
    return "<link rel=\"stylesheet\" href=\"${level}$::CSSFILE\" type=\"text/css\" media=\"all\">\n"
}
proc DOCTYPE {} {
    return "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">"
}
proc htmlhead {title header args} {
    set level ""
    if {[lindex $args end] eq "../[indexfile]"} {
	# XXX hack - assume same level for CSS file
	set level "../"
    }
    set out "[DOCTYPE]\n<HTML>\n<HEAD><TITLE>$title</TITLE>\n[CSS $level]</HEAD>\n"
    foreach {uptitle url} $args {
	set header "<a href=\"$url\">$uptitle</a> <small>&gt;</small> $header"
    }
    append out "<BODY><H2>$header</H2>"
    global manual
    if {[info exists manual(subheader)]} {
	set subs {}
	foreach {name subdir} $manual(subheader) {
	    if {$name eq $title} {
		lappend subs $name
	    } else {
		lappend subs "<A HREF=\"${level}$subdir/[indexfile]\">$name</A>"
	    }
	}
	append out "\n<H3>[join $subs { | }]</H3>"
    }
    return $out
}
proc gencss {} {
    set hBd "1px dotted #11577b"
    return "
body, div, p, th, td, li, dd, ul, ol, dl, dt, blockquote {
    font-family: Verdana, sans-serif;
}

pre, code { font-family: 'Courier New', Courier, monospace; }

pre {
    background-color:  #f6fcec;
    border-top:        1px solid #6A6A6A;
    border-bottom:     1px solid #6A6A6A;
    padding:           1em;
    overflow:          auto;
}

body {
    background-color:  #FFFFFF;
    font-size:         12px;
    line-height:       1.25;
    letter-spacing:    .2px;
    padding-left:      .5em;
}

h1, h2, h3, h4 {
    font-family:       Georgia, serif;
    padding-left:      1em;
    margin-top:        1em;
}

h1 {
    font-size:         18px;
    color:             #11577b;
    border-bottom:     $hBd;
    margin-top:        0px;
}

h2 {
    font-size:         14px;
    color:             #11577b;
    background-color:  #c5dce8;
    padding-left:      1em;
    border:            1px solid #6A6A6A;
}

h3, h4 {
    color:             #1674A4;
    background-color:  #e8f2f6;
    border-bottom:     $hBd;
    border-top:        $hBd;
}

h3 { font-size: 12px; }
    }
    css-style h4 {
	font-size: 11px;
    }
    css-style ".keylist dt" ".arguments dt" {
	width: 20em;
	float: left;
	padding: 2px;
	border-top: 1px solid #999;
    }
    css-style ".keylist dt" { font-weight: bold; }
    css-style ".keylist dd" ".arguments dd" {
	margin-left: 20em;
	padding: 2px;
	border-top: 1px solid #999;
    }
    css-style .copy {
	background-color:  #f6fcfc;
	white-space:       pre;
	font-size:         80%;
	border-top:        1px solid #6A6A6A;
	margin-top:        2em;
    }
    css-style .tablecell {
	font-size:	   12px;
	padding-left:	   .5em;
	padding-right:	   .5em;
    }
}

h4 { font-size: 11px; }

.keylist dt, .arguments dt {
  width: 20em;
  float: left;
  padding: 2px;
  border-top: 1px solid #999;
}

.keylist dt { font-weight: bold; }

.keylist dd, .arguments dd {
  margin-left: 20em;
  padding: 2px;
  border-top: 1px solid #999;
}

.copy {
    background-color:  #f6fcfc;
    white-space:       pre;
    font-size:         80%;
    border-top:        1px solid #6A6A6A;
    margin-top:        2em;
}
"
}

##
## parsing
##
proc unquote arg {
    return [string map [list \" {}] $arg]
}

proc parse-directive {line codename restname} {
    upvar 1 $codename code $restname rest
    return [regexp {^(\.[.a-zA-Z0-9]*) *(.*)} $line all code rest]
}

proc htmlize-text {text {charmap {}}} {
    # contains some extras for use in nroff->html processing
    # build on the list passed in, if any
    lappend charmap \
	{&}	{&amp;} \
	{\\}	"&#92;" \
	{\e}	"&#92;" \
	{\ }	{&nbsp;} \
	{\|}	{&nbsp;} \
	{\0}	{ } \
	\"	{&quot;} \
	{<}	{&lt;} \
	{>}	{&gt;} \
	\u201c "&#8220;" \
	\u201d "&#8221;"

    return [string map $charmap $text]
}

proc process-text {text} {
    global manual
    # preprocess text
    set charmap [list \
		     {\&}	"\t" \
		     {\%}	{} \
		     "\\\n"	"\n" \
		     {\(+-}	"&#177;" \
		     {\(co}	"&copy;" \
		     {\(em}	"&#8212;" \
		     {\(fm}	"&#8242;" \
		     {\(mc}	"&#181;" \
		     {\(mu}	"&#215;" \
		     {\(->}	"<font size=\"+1\">&#8594;</font>" \
		     {\fP}	{\fR} \
		     {\.}	. \
		     {\(bu}	"&#8226;" \
		    ]
    lappend charmap {\o'o^'} {&ocirc;} ; # o-circumflex in re_syntax.n
    lappend charmap {\-\|\-} --        ; # two hyphens
    lappend charmap {\-} -             ; # a hyphen

    set text [htmlize-text $text $charmap]
    # General quoted entity
    regsub -all {\\N'(\d+)'} $text "\\&#\\1;" text
    while {[string first "\\" $text] >= 0} {
	# C R
	if {[regsub {^([^\\]*)\\fC([^\\]*)\\fR(.*)$} $text \
		{\1<TT>\2</TT>\3} text]} continue
	# B R
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fR(.*)$} $text \
		{\1<B>\2</B>\3} text]} continue
	# B I
	if {[regsub {^([^\\]*)\\fB([^\\]*)\\fI(.*)$} $text \
		{\1<B>\2</B>\\fI\3} text]} continue
	# I R
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fR(.*)$} $text \
		{\1<I>\2</I>\3} text]} continue
	# I B
	if {[regsub {^([^\\]*)\\fI([^\\]*)\\fB(.*)$} $text \
		{\1<I>\2</I>\\fB\3} text]} continue
	# B B, I I, R R
	if {
	    [regsub {^([^\\]*)\\fB([^\\]*)\\fB(.*)$} $text \
		{\1\\fB\2\3} ntext]
	    || [regsub {^([^\\]*)\\fI([^\\]*)\\fI(.*)$} $text \
		    {\1\\fI\2\3} ntext]
	    || [regsub {^([^\\]*)\\fR([^\\]*)\\fR(.*)$} $text \
		    {\1\\fR\2\3} ntext]
	} then {
	    manerror "impotent font change: $text"
	    set text $ntext
	    continue
	}
	# unrecognized
	manerror "uncaught backslash: $text"
	set text [string map [list "\\" "&#92;"] $text]
    }
    return $text
}
##
## pass 2 text input and matching
##
proc open-text {} {
    global manual
    set manual(text-length) [llength $manual(text)]
    set manual(text-pointer) 0
}
proc more-text {} {
    global manual
    return [expr {$manual(text-pointer) < $manual(text-length)}]
}
proc next-text {} {
    global manual
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	incr manual(text-pointer)
	return $text
    }
    manerror "read past end of text"
    error "fatal"
}
proc is-a-directive {line} {
    return [string match .* $line]
}
proc split-directive {line opname restname} {
    upvar 1 $opname op $restname rest
    set op [string range $line 0 2]
    set rest [string trim [string range $line 3 end]]
}
proc next-op-is {op restname} {
    global manual
    upvar 1 $restname rest
    if {[more-text]} {
	set text [lindex $manual(text) $manual(text-pointer)]
	if {[string equal -length 3 $text $op]} {
	    set rest [string range $text 4 end]
	    incr manual(text-pointer)
	    return 1
	}
    }
    return 0
}
proc backup-text {n} {
    global manual
    if {$manual(text-pointer)-$n >= 0} {
	incr manual(text-pointer) -$n
    }
}
proc match-text args {
    global manual
    set nargs [llength $args]
    if {$manual(text-pointer) + $nargs > $manual(text-length)} {
	return 0
    }
    set nback 0
    foreach arg $args {
	if {![more-text]} {
	    backup-text $nback
	    return 0
	}
	set arg [string trim $arg]
	set targ [string trim [lindex $manual(text) $manual(text-pointer)]]
	if {$arg eq $targ} {
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp {^@(\w+)$} $arg all name]} {
	    upvar 1 $name var
	    set var $targ
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	if {[regexp -nocase {^(\.[A-Z][A-Z])@(\w+)$} $arg all op name]\
		&& [string equal $op [lindex $targ 0]]} {
	    upvar 1 $name var
	    set var [lrange $targ 1 end]
	    incr nback
	    incr manual(text-pointer)
	    continue
	}
	backup-text $nback
	return 0
    }
    return 1
}
proc expand-next-text {n} {
    global manual
    return [join [lrange $manual(text) $manual(text-pointer) \
	    [expr {$manual(text-pointer)+$n-1}]] \n\n]
}
##
## pass 2 output
##
proc man-puts {text} {
    global manual
    lappend manual(output-$manual(wing-file)-$manual(name)) $text
}

##
## build hypertext links to tables of contents
##
proc long-toc {text} {
    global manual
    set here M[incr manual(section-toc-n)]
    set there L[incr manual(long-toc-n)]
    lappend manual(section-toc) \
	    "<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$text</A>"
    return "<A NAME=\"$here\">$text</A>"
}
proc option-toc {name class switch} {
    global manual
    if {[string match "*OPTIONS" $manual(section)]} {
	if {
	    $manual(name) ne "ttk_widget"
	    && $manual(section) ne "WIDGET-SPECIFIC OPTIONS"
	} then {
	    # link the defined option into the long table of contents
	    set link [long-toc "$switch, $name, $class"]
	    regsub -- "$switch, $name, $class" $link "$switch" link
	    return $link
	}
    } elseif {"$manual(name):$manual(section)" ne "options:DESCRIPTION"} {
	error "option-toc in $manual(name) section $manual(section)"
    }

    # link the defined standard option to the long table of contents and make
    # a target for the standard option references from other man pages.

    set first [lindex $switch 0]
    set here M$first
    set there L[incr manual(long-toc-n)]
    set manual(standard-option-$manual(name)-$first) \
	"<A HREF=\"$manual(name).htm#$here\">$switch, $name, $class</A>"
    lappend manual(section-toc) \
	"<DD><A HREF=\"$manual(name).htm#$here\" NAME=\"$there\">$switch, $name, $class</A>"
    return "<A NAME=\"$here\">$switch</A>"
}
proc std-option-toc {name page} {
    global manual
    if {[info exists manual(standard-option-$page-$name)]} {
	lappend manual(section-toc) <DD>$manual(standard-option-$page-$name)
	return $manual(standard-option-$page-$name)
    }
    manerror "missing reference to \"$name\" in $page.n"
    set here M[incr manual(section-toc-n)]
    set there L[incr manual(long-toc-n)]
    set other M$name
    lappend manual(section-toc) "<DD><A HREF=\"$page.htm#$other\">$name</A>"
    return "<A HREF=\"$page.htm#$other\">$name</A>"
}
##
## process the widget option section
## in widget and options man pages
##
proc output-widget-options {rest} {
    global manual
    man-puts <DL>
    lappend manual(section-toc) <DL>
    backup-text 1
    set para {}
    while {[next-op-is .OP rest]} {
	switch -exact -- [llength $rest] {
	    3 {
		lassign $rest switch name class
	    }
	    5 {
		set switch [lrange $rest 0 2]
		set name [lindex $rest 3]
		set class [lindex $rest 4]
	    }
	    default {
		fatal "bad .OP $rest"
	    }
	}
	if {![regexp {^(<.>)([-\w ]+)(</.>)$} $switch \
		all oswitch switch cswitch]} {
	    if {![regexp {^(<.>)([-\w ]+) or ([-\w ]+)(</.>)$} $switch \
		    all oswitch switch1 switch2 cswitch]} {
		error "not Switch: $switch"
	    }
	    set switch "$switch1$cswitch or $oswitch$switch2"
	}
	if {![regexp {^(<.>)([\w]*)(</.>)$} $name all oname name cname]} {
	    error "not Name: $name"
	}
	if {![regexp {^(<.>)([\w]*)(</.>)$} $class all oclass class cclass]} {
	    error "not Class: $class"
	}
	man-puts "$para<DT>Command-Line Name: $oswitch[option-toc $name $class $switch]$cswitch"
	man-puts "<DT>Database Name: $oname$name$cname"
	man-puts "<DT>Database Class: $oclass$class$cclass"
	man-puts <DD>[next-text]
	set para <P>

	if {[next-op-is .RS rest]} {
	    while {[more-text]} {
		set line [next-text]
		if {[is-a-directive $line]} {
		    split-directive $line code rest
		    switch -exact -- $code {
			.RE {
			    break
			}
			.SH - .SS {
			    manerror "unbalanced .RS at section end"
			    backup-text 1
			    break
			}
			default {
			    output-directive $line
			}
		    }
		} else {
		    man-puts $line
		}
	    }
	}
    }
    man-puts </DL>
    lappend manual(section-toc) </DL>
}

##
## process .RS lists
##
proc output-RS-list {} {
    global manual
    if {[next-op-is .IP rest]} {
	output-IP-list .RS .IP $rest
	if {[match-text .RE .sp .RS @rest .IP @rest2]} {
	    man-puts <P>$rest
	    output-IP-list .RS .IP $rest2
	}
	if {[match-text .RE .sp .RS @rest .RE]} {
	    man-puts <P>$rest
	    return
	}
	if {[next-op-is .RE rest]} {
	    return
	}
    }
    man-puts <DL><DD>
    while {[more-text]} {
	set line [next-text]
	if {[is-a-directive $line]} {
	    split-directive $line code rest
	    switch -exact -- $code {
		.RE {
		    break
		}
		.SH - .SS {
		    manerror "unbalanced .RS at section end"
		    backup-text 1
		    break
		}
		default {
		    output-directive $line
		}
	    }
	} else {
	    man-puts $line
	}
    }
    man-puts </DL>
}

##
## process .IP lists which may be plain indents,
## numeric lists, or definition lists
##
proc output-IP-list {context code rest} {
    global manual
    if {![string length $rest]} {
	# blank label, plain indent, no contents entry
	man-puts <DL><DD>
	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		if {$code eq ".IP" && $rest eq {}} {
		    man-puts "<P>"
		    continue
		}
		if {$code in {.br .DS .RS}} {
		    output-directive $line
		} else {
		    backup-text 1
		    break
		}
	    } else {
		man-puts $line
	    }
	}
	man-puts </DL>
    } else {
	# labelled list, make contents
	if {$context ne ".SH" && $context ne ".SS"} {
	    man-puts <P>
	}
	set dl "<DL class=\"[string tolower $manual(section)]\">"
	man-puts $dl
	lappend manual(section-toc) $dl
	backup-text 1
	set accept_RE 0
	set para {}
	while {[more-text]} {
	    set line [next-text]
	    if {[is-a-directive $line]} {
		split-directive $line code rest
		switch -exact -- $code {
		    .IP {
			if {$accept_RE} {
			    output-IP-list .IP $code $rest
			    continue
			}
			if {$manual(section) eq "ARGUMENTS" || \
				[regexp {^\[\d+\]$} $rest]} {
			    man-puts "$para<DT>$rest<DD>"
			} elseif {"&#8226;" eq $rest} {
			    man-puts "$para<DT><DD>$rest&nbsp;"
			} else {
			    man-puts "$para<DT>[long-toc $rest]<DD>"
			}
			if {"$manual(name):$manual(section)" eq \
				"selection:DESCRIPTION"} {
			    if {[match-text .RE @rest .RS .RS]} {
				man-puts <DT>[long-toc $rest]<DD>
			    }
			}
		    }
		    .sp - .br - .DS - .CS {
			output-directive $line
		    }
		    .RS {
			if {[match-text .RS]} {
			    output-directive $line
			    incr accept_RE 1
			} elseif {[match-text .CS]} {
			    output-directive .CS
			    incr accept_RE 1
			} elseif {[match-text .PP]} {
			    output-directive .PP
			    incr accept_RE 1
			} elseif {[match-text .DS]} {
			    output-directive .DS
			    incr accept_RE 1
			} else {
			    output-directive $line
			}
		    }
		    .PP {
			if {[match-text @rest1 .br @rest2 .RS]} {
			    # yet another nroff kludge as above
			    man-puts "$para<DT>[long-toc $rest1]"
			    man-puts "<DT>[long-toc $rest2]<DD>"
			    incr accept_RE 1
			} elseif {[match-text @rest .RE]} {
			    # gad, this is getting ridiculous
			    if {!$accept_RE} {
				man-puts "</DL><P>$rest<DL>"
				backup-text 1
				set para {}
				break
			    } else {
				man-puts "<P>$rest"
				incr accept_RE -1
			    }
			} elseif {$accept_RE} {
			    output-directive $line
			} else {
			    backup-text 1
			    break
			}
		    }
		    .RE {
			if {!$accept_RE} {
			    backup-text 1
			    break
			}
			incr accept_RE -1
		    }
		    default {
			backup-text 1
			break
		    }
		}
	    } else {
		man-puts $line
	    }
	    set para <P>
	}
	man-puts "$para</DL>"
	lappend manual(section-toc) </DL>
	if {$accept_RE} {
	    manerror "missing .RE in output-IP-list"
	}
    }
}
##
## handle the NAME section lines
## there's only one line in the NAME section,
## consisting of a comma separated list of names,
## followed by a hyphen and a short description.
##
proc output-name {line} {
    global manual
    # split name line into pieces
    regexp {^([^-]+) - (.*)$} $line all head tail
    # output line to manual page untouched
    man-puts $line
    # output line to long table of contents
    lappend manual(section-toc) <DL><DD>$line</DD></DL>
    # separate out the names for future reference
    foreach name [split $head ,] {
	set name [string trim $name]
	if {[llength $name] > 1} {
	    manerror "name has a space: {$name}\nfrom: $line"
	}
	lappend manual(wing-toc) $name
	lappend manual(name-$name) $manual(wing-file)/$manual(name)
    }
}
##
## build a cross-reference link if appropriate
##
proc cross-reference {ref} {
    global manual
    if {[string match "Tcl_*" $ref]} {
	set lref $ref
    } elseif {[string match "Tk_*" $ref]} {
	set lref $ref
    } elseif {$ref eq "Tcl"} {
	set lref $ref
    } else {
	set lref [string tolower $ref]
    }
    ##
    ## nothing to reference
    ##
    if {![info exists manual(name-$lref)]} {
	foreach name {
	    array file history info interp string trace after clipboard grab
	    image option pack place selection tk tkwait update winfo wm
	} {
	    if {[regexp "^$name \[a-z0-9]*\$" $lref] && \
		    [info exists manual(name-$name)] && \
		    $manual(tail) ne "$name.n"} {
		return "<A HREF=\"../$manual(name-$name).htm\">$ref</A>"
	    }
	}
	if {$lref in {stdin stdout stderr end}} {
	    # no good place to send these
	    # tcl tokens?
	    # also end
	}
	return $ref
    }
    ##
    ## would be a self reference
    ##
    foreach name $manual(name-$lref) {
	if {"$manual(wing-file)/$manual(name)" in $name} {
	    return $ref
	}
    }
    ##
    ## multiple choices for reference
    ##
    if {[llength $manual(name-$lref)] > 1} {
	set tcl_i [lsearch -glob $manual(name-$lref) *TclCmd*]
	set tcl_ref [lindex $manual(name-$lref) $tcl_i]
	set tk_i [lsearch -glob $manual(name-$lref) *TkCmd*]
	set tk_ref [lindex $manual(name-$lref) $tk_i]
	if {$tcl_i >= 0 && $manual(wing-file) eq "TclCmd"
		|| $manual(wing-file) eq "TclLib"} {
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	if {$tk_i >= 0 && $manual(wing-file) eq "TkCmd"
		|| $manual(wing-file) eq "TkLib"} {
	    return "<A HREF=\"../$tk_ref.htm\">$ref</A>"
	}
	if {$lref eq "exit" && $manual(tail) eq "tclsh.1" && $tcl_i >= 0} {
	    return "<A HREF=\"../$tcl_ref.htm\">$ref</A>"
	}
	puts stderr "multiple cross reference to $ref in $manual(name-$lref) from $manual(wing-file)/$manual(tail)"
	return $ref
    }
    ##
    ## exceptions, sigh, to the rule
    ##
    switch -exact -- $manual(tail) {
	canvas.n {
	    if {$lref eq "focus"} {
		upvar 1 tail tail
		set clue [string first command $tail]
		if {$clue < 0 ||  $clue > 5} {
		    return $ref
		}
	    }
	    if {$lref in {bitmap image text}} {
		return $ref
	    }
	}
	checkbutton.n - radiobutton.n {
	    if {$lref in {image}} {
		return $ref
	    }
	}
	menu.n {
	    if {$lref in {checkbutton radiobutton}} {
		return $ref
	    }
	}
	options.n {
	    if {$lref in {bitmap image set}} {
		return $ref
	    }
	}
	regexp.n {
	    if {$lref in {string}} {
		return $ref
	    }
	}
	source.n {
	    if {$lref in {text}} {
		return $ref
	    }
	}
	history.n {
	    if {$lref in {exec}} {
		return $ref
	    }
	}
	return.n {
	    if {$lref in {error continue break}} {
		return $ref
	    }
	}
	scrollbar.n {
	    if {$lref in {set}} {
		return $ref
	    }
	}
	safe.n {
	    if {$lref in {options}} {
		return $ref
	    }
	}
    }
    ##
    ## return the cross reference
    ##
    return "<A HREF=\"../$manual(name-$lref).htm\">$ref</A>"
}
##
## reference generation errors
##
proc reference-error {msg text} {
    global manual
    puts stderr "$manual(tail): $msg: {$text}"
    return $text
}
##
## insert as many cross references into this text string as are appropriate
##
proc insert-cross-references {text} {
    global manual
    ##
    ## we identify cross references by:
    ##     ``quotation''
    ##    <B>emboldening</B>
    ##    Tcl_ prefix
    ##    Tk_ prefix
    ##	  [a-zA-Z0-9]+ manual entry
    ## and we avoid messing with already anchored text
    ##
    ##
    ## find where each item lives
    ##
    array set offset [list \
	    anchor [string first {<A } $text] \
	    end-anchor [string first {</A>} $text] \
	    quote [string first {``} $text] \
	    end-quote [string first {''} $text] \
	    bold [string first {<B>} $text] \
	    end-bold [string first {</B>} $text] \
	    tcl [string first {Tcl_} $text] \
	    tk [string first {Tk_} $text] \
	    Tcl1 [string first {Tcl manual entry} $text] \
	    Tcl2 [string first {Tcl overview manual entry} $text] \
	    ]
    ##
    ## accumulate a list
    ##
    foreach name [array names offset] {
	if {$offset($name) >= 0} {
	    set invert($offset($name)) $name
	    lappend offsets $offset($name)
	}
    }
    ##
    ## if nothing, then we're done.
    ##
    if {![info exists offsets]} {
	return $text
    }
    ##
    ## sort the offsets
    ##
    set offsets [lsort -integer $offsets]
    ##
    ## see which we want to use
    ##
    switch -exact -- $invert([lindex $offsets 0]) {
	anchor {
	    if {$offset(end-anchor) < 0} {
		return [reference-error {Missing end anchor} $text]
	    }
	    set head [string range $text 0 $offset(end-anchor)]
	    set tail [string range $text [expr {$offset(end-anchor)+1}] end]
	    return $head[insert-cross-references $tail]
	}
	quote {
	    if {$offset(end-quote) < 0} {
		return [reference-error "Missing end quote" $text]
	    }
	    if {$invert([lindex $offsets 1]) eq "tk"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    if {$invert([lindex $offsets 1]) eq "tcl"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    switch -exact -- $invert([lindex $offsets 1]) {
		end-quote {
		    set head [string range $text 0 [expr {$offset(quote)-1}]]
		    set body [string range $text [expr {$offset(quote)+2}] \
			    [expr {$offset(end-quote)-1}]]
		    set tail [string range $text \
			    [expr {$offset(end-quote)+2}] end]
		    return "$head``[cross-reference $body]''[insert-cross-references $tail]"
		}
		bold -
		anchor {
		    set head [string range $text \
			    0 [expr {$offset(end-quote)+1}]]
		    set tail [string range $text \
			    [expr {$offset(end-quote)+2}] end]
		    return "$head[insert-cross-references $tail]"
		}
	    }
	    return [reference-error "Uncaught quote case" $text]
	}
	bold {
	    if {$offset(end-bold) < 0} {
		return $text
	    }
	    if {$invert([lindex $offsets 1]) eq "tk"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    if {$invert([lindex $offsets 1]) eq "tcl"} {
		set offsets [lreplace $offsets 1 1]
	    }
	    switch -exact -- $invert([lindex $offsets 1]) {
		end-bold {
		    set head [string range $text 0 [expr {$offset(bold)-1}]]
		    set body [string range $text [expr {$offset(bold)+3}] \
			    [expr {$offset(end-bold)-1}]]
		    set tail [string range $text \
			    [expr {$offset(end-bold)+4}] end]
		    return "$head<B>[cross-reference $body]</B>[insert-cross-references $tail]"
		}
		anchor {
		    set head [string range $text \
			    0 [expr {$offset(end-bold)+3}]]
		    set tail [string range $text \
			    [expr {$offset(end-bold)+4}] end]
		    return "$head[insert-cross-references $tail]"
		}
	    }
	    return [reference-error "Uncaught bold case" $text]
	}
	tk {
	    set head [string range $text 0 [expr {$offset(tk)-1}]]
	    set tail [string range $text $offset(tk) end]
	    if {![regexp {^(Tk_\w+)(.*)$} $tail all body tail]} {
		return [reference-error "Tk regexp failed" $text]
	    }
	    return $head[cross-reference $body][insert-cross-references $tail]
	}
	tcl {
	    set head [string range $text 0 [expr {$offset(tcl)-1}]]
	    set tail [string range $text $offset(tcl) end]
	    if {![regexp {^(Tcl_\w+)(.*)$} $tail all body tail]} {
		return [reference-error {Tcl regexp failed} $text]
	    }
	    return $head[cross-reference $body][insert-cross-references $tail]
	}
	Tcl1 -
	Tcl2 {
	    set off [lindex $offsets 0]
	    set head [string range $text 0 [expr {$off-1}]]
	    set body Tcl
	    set tail [string range $text [expr {$off+3}] end]
	    return $head[cross-reference $body][insert-cross-references $tail]
	}
	end-anchor -
	end-bold -
	end-quote {
	    return [reference-error "Out of place $invert([lindex $offsets 0])" $text]
	}
    }
}
##
## process formatting directives
##
proc output-directive {line} {
    global manual
    # process format directive
    split-directive $line code rest
    switch -exact -- $code {
	.BS - .BE {
	    # man-puts <HR>
	}
	.SH - .SS {
	    # drain any open lists
	    # announce the subject
	    set manual(section) $rest
	    # start our own stack of stuff
	    set manual($manual(name)-$manual(section)) {}
	    lappend manual(has-$manual(section)) $manual(name)
	    if {$code ne ".SS"} {
		man-puts "<H3>[long-toc $manual(section)]</H3>"
	    } else {
		man-puts "<H4>[long-toc $manual(section)]</H4>"
	    }
	    # some sections can simply free wheel their way through the text
	    # some sections can be processed in their own loops
	    switch -exact -- $manual(section) {
		NAME {
		    if {$manual(tail) in {CrtImgType.3 CrtItemType.3 CrtPhImgFmt.3}} {
			# these manual pages have two NAME sections
			if {[info exists manual($manual(tail)-NAME)]} {
			    return
			}
			set manual($manual(tail)-NAME) 1
		    }
		    set names {}
		    while {1} {
			set line [next-text]
			if {[is-a-directive $line]} {
			    backup-text 1
			    output-name [join $names { }]
			    return
			} else {
			    lappend names [string trim $line]
			}
		    }
		}
		SYNOPSIS {
		    lappend manual(section-toc) <DL>
		    while {1} {
			if {
			    [next-op-is .nf rest]
			    || [next-op-is .br rest]
			    || [next-op-is .fi rest]
			} then {
			    continue
			}
			if {
			    [next-op-is .SH rest]
			    || [next-op-is .SS rest]
			    || [next-op-is .BE rest]
			    || [next-op-is .SO rest]
			} then {
			    backup-text 1
			    break
			}
			if {[next-op-is .sp rest]} {
			    #man-puts <P>
			    continue
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "in SYNOPSIS found $more"
			    backup-text 1
			    break
			}
			foreach more [split $more \n] {
			    man-puts $more<BR>
			    if {$manual(wing-file) in {TclLib TkLib}} {
				lappend manual(section-toc) <DD>$more
			    }
			}
		    }
		    lappend manual(section-toc) </DL>
		    return
		}
		{SEE ALSO} {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set nmore {}
			foreach cr [split $more ,] {
			    set cr [string trim $cr]
			    if {![regexp {^<B>.*</B>$} $cr]} {
				set cr <B>$cr</B>
			    }
			    if {[regexp {^<B>(.*)\([13n]\)</B>$} $cr all name]} {
				set cr <B>$name</B>
			    }
			    lappend nmore $cr
			}
			man-puts [join $nmore {, }]
		    }
		    return
		}
		KEYWORDS {
		    while {[more-text]} {
			if {[next-op-is .SH rest] || [next-op-is .SS rest]} {
			    backup-text 1
			    return
			}
			set more [next-text]
			if {[is-a-directive $more]} {
			    manerror "$more"
			    backup-text 1
			    return
			}
			set keys {}
			foreach key [split $more ,] {
			    set key [string trim $key]
			    lappend manual(keyword-$key) [list $manual(name) $manual(wing-file)/$manual(name).htm]
			    set initial [string toupper [string index $key 0]]
			    lappend keys "<A href=\"../Keywords/$initial.htm\#$key\">$key</A>"
			}
			man-puts [join $keys {, }]
		    }
		    return
		}
	    }
	    if {[next-op-is .IP rest]} {
		output-IP-list $code .IP $rest
		return
	    }
	    if {[next-op-is .PP rest]} {
		return
	    }
	    return
	}
	.SO {
	    set targetPage $rest
	    if {[match-text @stuff .SE]} {
		output-directive {.SH STANDARD OPTIONS}
		set opts [split $stuff \n\t]
		man-puts <DL>
		lappend manual(section-toc) <DL>
		foreach option [lsort -dictionary $opts] {
		    man-puts "<DT><B>[std-option-toc $option $targetPage]</B>"
		}
		man-puts </DL>
		lappend manual(section-toc) </DL>
	    } else {
		manerror "unexpected .SO format:\n[expand-next-text 2]"
	    }
	}
	.OP {
	    output-widget-options $rest
	    return
	}
	.IP {
	    output-IP-list .IP .IP $rest
	    return
	}
	.PP {
	    man-puts <P>
	}
	.RS {
	    output-RS-list
	    return
	}
	.RE {
	    manerror "unexpected .RE"
	    return
	}
	.br {
	    man-puts <BR>
	    return
	}
	.DE {
	    manerror "unexpected .DE"
	    return
	}
	.DS {
	    if {[next-op-is .ta rest]} {
		# skip the leading .ta directive if it is there
	    }
	    if {[match-text @stuff .DE]} {
		set td "<td><p style=\"font-size:12px;padding-left:.5em;padding-right:.5em;\">"
		set bodyText [string map [list \n <tr>$td \t $td] \n$stuff]
		man-puts "<dl><dd><table border=\"0\">$bodyText</table></dl>"
		#man-puts <PRE>$stuff</PRE>
	    } elseif {[match-text .fi @ul1 @ul2 .nf @stuff .DE]} {
		man-puts "<PRE>[lindex $ul1 1][lindex $ul2 1]\n$stuff</PRE>"
	    } else {
		manerror "unexpected .DS format:\n[expand-next-text 2]"
	    }
	    return
	}
	.CS {
	    if {[next-op-is .ta rest]} {
		# ???
	    }
	    if {[match-text @stuff .CE]} {
		man-puts <PRE>$stuff</PRE>
	    } else {
		manerror "unexpected .CS format:\n[expand-next-text 2]"
	    }
	    return
	}
	.CE {
	    manerror "unexpected .CE"
	    return
	}
	.sp {
	    man-puts <P>
	}
	.ta {
	    # these are tab stop settings for short tables
	    switch -exact -- $manual(name):$manual(section) {
		{bind:MODIFIERS} -
		{bind:EVENT TYPES} -
		{bind:BINDING SCRIPTS AND SUBSTITUTIONS} -
		{expr:OPERANDS} -
		{expr:MATH FUNCTIONS} -
		{history:DESCRIPTION} -
		{history:HISTORY REVISION} -
		{switch:DESCRIPTION} -
		{upvar:DESCRIPTION} {
		    return;			# fix.me
		}
		default {
		    manerror "ignoring $line"
		}
	    }
	}
	.nf {
	    if {[match-text @more .fi]} {
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
	    } elseif {[match-text .RS @more .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts </DL>
	    } elseif {[match-text .RS @more .RS @more2 .RE .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL></DL>
	    } elseif {[match-text .RS @more .RS @more2 .RE @more3 .RE .fi]} {
		man-puts <DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL><DD>
		foreach more3 [split $more3 \n] {
		    man-puts $more3<BR>
		}
		man-puts </DL>
	    } elseif {[match-text .sp .RS @more .RS @more2 .sp .RE .RE .fi]} {
		man-puts <P><DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts <DL><DD>
		foreach more2 [split $more2 \n] {
		    man-puts $more2<BR>
		}
		man-puts </DL></DL><P>
	    } elseif {[match-text .RS .sp @more .sp .RE .fi]} {
		man-puts <P><DL><DD>
		foreach more [split $more \n] {
		    man-puts $more<BR>
		}
		man-puts </DL><P>
	    } else {
		manerror "ignoring $line"
	    }
	}
	.fi {
	    manerror "ignoring $line"
	}
	.na -
	.ad -
	.UL -
	.ne {
	    manerror "ignoring $line"
	}
	default {
	    manerror "unrecognized format directive: $line"
	}
    }
}
##
## merge copyright listings
##
proc merge-copyrights {l1 l2} {
    set merge {}
    set re1 {^Copyright +(?:\(c\)|\\\(co|&copy;) +(\w.*?)(?:all rights reserved)?(?:\. )*$}
    set re2 {^(\d+) +(?:by +)?(\w.*)$}         ;# date who
    set re3 {^(\d+)-(\d+) +(?:by +)?(\w.*)$}   ;# from to who
    set re4 {^(\d+), *(\d+) +(?:by +)?(\w.*)$} ;# date1 date2 who
    foreach copyright [concat $l1 $l2] {
	if {[regexp -nocase -- $re1 $copyright -> info]} {
	    set info [string trimright $info ". "] ; # remove extra period
	    if {[regexp -- $re2 $info -> date who]} {
		lappend dates($who) $date
		continue
	    } elseif {[regexp -- $re3 $info -> from to who]} {
		for {set date $from} {$date <= $to} {incr date} {
		    lappend dates($who) $date
		}
		continue
	    } elseif {[regexp -- $re3 $info -> date1 date2 who]} {
		lappend dates($who) $date1 $date2
		continue
	    }
	}
	puts "oops: $copyright"
    }
    foreach who [array names dates] {
	set list [lsort -dictionary $dates($who)]
	if {[llength $list] == 1 || [lindex $list 0] eq [lrange $list end end]} {
	    lappend merge "Copyright &copy; [lindex $list 0] $who"
	} else {
	    lappend merge "Copyright &copy; [lindex $list 0]-[lrange $list end end] $who"
	}
    }
    return [lsort -dictionary $merge]
}

proc makedirhier {dir} {
    if {![file isdirectory $dir] && \
	    [catch {file mkdir $dir} error]} {
	return -code error "cannot create directory $dir: $error"
    }
}

proc addbuffer {args} {
    global manual
    if {$manual(partial-text) ne ""} {
	append manual(partial-text) \n
    }
    append manual(partial-text) [join $args ""]
}
proc flushbuffer {} {
    global manual
    if {$manual(partial-text) ne ""} {
	lappend manual(text) [process-text $manual(partial-text)]
	set manual(partial-text) ""
    }
}

##
## foreach of the man directories specified by args
## convert manpages into hypertext in the directory
## specified by html.
##
proc make-man-pages {html args} {
    global manual overall_title tcltkdesc verbose
    global manual overall_title tcltkdesc
    global excluded_pages forced_index_pages process_first_patterns

    makedirhier $html
    set cssfd [open $html/$::CSSFILE w]
    puts $cssfd [css-stylesheet]
    puts $cssfd [gencss]
    close $cssfd
    set manual(short-toc-n) 1
    set manual(short-toc-fp) [open $html/[indexfile] w]
    puts $manual(short-toc-fp) [htmlhead $overall_title $overall_title]
    puts $manual(short-toc-fp) "<DL class=\"keylist\">"
    set manual(merge-copyrights) {}

    foreach arg $args {
	# preprocess to set up subheader for the rest of the files
	if {![llength $arg]} {
	    continue
	}
	lassign $arg -> name file
	if {[regexp {(.*)(?: Package)? Commands(?:, version .*)?} $name -> pkg]} {
	    set name "$pkg Commands"
	set name [lindex $arg 1]
	} elseif {[regexp {(.*)(?: Package)? C API(?:, version .*)?} $name -> pkg]} {
	    set name "$pkg C API"
	set file [lindex $arg 2]
	}
	lappend manual(subheader) $name $file
    }

    ##
    ## parse the manpages in a section of the docs (split by
    ## package) and construct formatted manpages
    ##
    foreach arg $args {
	if {![llength $arg]} {
	    continue
	}
	set manual(wing-glob) [lindex $arg 0]
	set manual(wing-name) [lindex $arg 1]
	set manual(wing-file) [lindex $arg 2]
	set manual(wing-description) [lindex $arg 3]
	set manual(wing-copyrights) {}
	makedirhier $html/$manual(wing-file)
	set manual(wing-toc-fp) [open $html/$manual(wing-file)/[indexfile] w]
	# whistle
	puts stderr "scanning section $manual(wing-name)"
	# put the entry for this section into the short table of contents
	puts $manual(short-toc-fp) "<DT><A HREF=\"$manual(wing-file)/[indexfile]\">$manual(wing-name)</A></DT><DD>$manual(wing-description)</DD>"
	# initialize the wing table of contents
	puts $manual(wing-toc-fp) [htmlhead $manual(wing-name) \
		$manual(wing-name) $overall_title "../[indexfile]"]
	# initialize the short table of contents for this section
	set manual(wing-toc) {}
	# initialize the man directory for this section
	makedirhier $html/$manual(wing-file)
	# initialize the long table of contents for this section
	set manual(long-toc-n) 1
	# get the manual pages for this section
	set manual(pages) [lsort -dictionary [glob $manual(wing-glob)]]
	set n [lsearch -glob $manual(pages) */ttk_widget.n]
	if {$n >= 0} {
	    set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
	}
	set n [lsearch -glob $manual(pages) */options.n]
	if {$n >= 0} {
	    set manual(pages) "[lindex $manual(pages) $n] [lreplace $manual(pages) $n $n]"
	}
	# set manual(pages) [lrange $manual(pages) 0 5]
	set LQ \u201c
	set RQ \u201d
	foreach manual_page $manual(pages) {
	    set manual(page) $manual_page
	    # whistle
	    puts stderr "scanning page $manual(page)"
	    set manual(tail) [file tail $manual(page)]
	    set manual(name) [file root $manual(tail)]
	    set manual(section) {}
	    if {$manual(name) in {case pack-old menubar}} {
		# obsolete
		manerror "discarding $manual(name)"
		continue
	    }
	    set manual(infp) [open $manual(page)]
	    set manual(text) {}
	    set manual(partial-text) {}
	    foreach p {.RS .DS .CS .SO} {
		set manual($p) 0
	    }
	    set manual(stack) {}
	    set manual(section) {}
	    set manual(section-toc) {}
	    set manual(section-toc-n) 1
	    set manual(copyrights) {}
	    lappend manual(copyrights) "Copyright &copy; 1995-1997 Roger E. Critchlow Jr."
	    lappend manual(all-pages) $manual(wing-file)/$manual(tail)
	    manreport 100 $manual(name)
	    while {[gets $manual(infp) line] >= 0} {
		manreport 100 $line
		if {[regexp {^[`'][/\\]} $line]} {
		    if {[regexp {Copyright (?:\(c\)|\\\(co).*$} $line copyright]} {
			lappend manual(copyrights) $copyright
		    }
		    # comment
		    continue
		}
		if {"$line" eq {'}} {
		    # comment
		    continue
		}
		if {![parse-directive $line code rest]} {
		    addbuffer $line
		    continue
		}
		switch -exact -- $code {
		    .ad - .na - .so - .ne - .AS - .VE - .VS - . {
			# ignore
			continue
		    }
		}
		switch -exact -- $code {
		    .SH - .SS {
			flushbuffer
	if {[llength $arg]} {
	    make-manpage-section $html $arg
	}
			if {[llength $rest] == 0} {
			    gets $manual(infp) rest
			}
			lappend manual(text) "$code [unquote $rest]"
		    }
		    .TH {
			flushbuffer
			lappend manual(text) "$code [unquote $rest]"
		    }
		    .QW {
			set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
			addbuffer $LQ [unquote [lindex $rest 0]] $RQ \
			    [unquote [lindex $rest 1]]
		    }
		    .PQ {
			set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
			addbuffer ( $LQ [unquote [lindex $rest 0]] $RQ \
			    [unquote [lindex $rest 1]] ) \
			    [unquote [lindex $rest 2]]
		    }
		    .QR {
			set rest [regexp -all -inline {\"(?:[^""]+)\"|\S+} $rest]
			addbuffer $LQ [unquote [lindex $rest 0]] - \
			    [unquote [lindex $rest 1]] $RQ \
			    [unquote [lindex $rest 2]]
		    }
		    .MT {
			addbuffer $LQ$RQ
		    }
		    .HS - .UL - .ta {
			flushbuffer
			lappend manual(text) "$code [unquote $rest]"
		    }
		    .BS - .BE - .br - .fi - .sp - .nf {
			flushbuffer
			if {"$rest" ne {}} {
			    manerror "unexpected argument: $line"
			}
			lappend manual(text) $code
		    }
		    .AP {
			flushbuffer
			lappend manual(text) [concat .IP [process-text "[lindex $rest 0] \\fB[lindex $rest 1]\\fR ([lindex $rest 2])"]]
		    }
		    .IP {
			flushbuffer
			regexp {^(.*) +\d+$} $rest all rest
			lappend manual(text) ".IP [process-text [unquote [string trim $rest]]]"
		    }
		    .TP {
			flushbuffer
			while {[is-a-directive [set next [gets $manual(infp)]]]} {
			    manerror "ignoring $next after .TP"
			}
			if {"$next" ne {'}} {
			    lappend manual(text) ".IP [process-text $next]"
			}
		    }
		    .OP {
			flushbuffer
			lappend manual(text) [concat .OP [process-text \
				"\\fB[lindex $rest 0]\\fR \\fB[lindex $rest 1]\\fR \\fB[lindex $rest 2]\\fR"]]
		    }
		    .PP - .LP {
			flushbuffer
			lappend manual(text) {.PP}
		    }
		    .RS {
			flushbuffer
			incr manual(.RS)
			lappend manual(text) $code
		    }
		    .RE {
			flushbuffer
			incr manual(.RS) -1
			lappend manual(text) $code
		    }
		    .SO {
			flushbuffer
			incr manual(.SO)
			if {[llength $rest] == 0} {
			    lappend manual(text) "$code options"
			} else {
			    lappend manual(text) "$code [unquote $rest]"
			}
		    }
		    .SE {
			flushbuffer
			incr manual(.SO) -1
			lappend manual(text) $code
		    }
		    .DS {
			flushbuffer
			incr manual(.DS)
			lappend manual(text) $code
		    }
		    .DE {
			flushbuffer
			incr manual(.DS) -1
			lappend manual(text) $code
		    }
		    .CS {
			flushbuffer
			incr manual(.CS)
			lappend manual(text) $code
		    }
		    .CE {
			flushbuffer
			incr manual(.CS) -1
			lappend manual(text) $code
		    }
		    .de {
			while {[gets $manual(infp) line] >= 0} {
			    if {[string match "..*" $line]} {
				break
			    }
			}
		    }
		    .. {
			error "found .. outside of .de"
		    }
		    default {
			flushbuffer
			manerror "unrecognized format directive: $line"
		    }
		}
	    }
	    flushbuffer
	    close $manual(infp)
	    # fixups
	    if {$manual(.RS) != 0} {
		puts "unbalanced .RS .RE"
	    }
	    if {$manual(.DS) != 0} {
		puts "unbalanced .DS .DE"
	    }
	    if {$manual(.CS) != 0} {
		puts "unbalanced .CS .CE"
	    }
	    if {$manual(.SO) != 0} {
		puts "unbalanced .SO .SE"
	    }
	    # output conversion
	    open-text
	    set haserror 0
	    if {[next-op-is .HS rest]} {
		set manual($manual(name)-title) \
			"[lrange $rest 1 end] [lindex $rest 0] manual page"
	    } elseif {[next-op-is .TH rest]} {
		set manual($manual(name)-title) "[lindex $rest 0] manual page - [lrange $rest 4 end]"
	    } else {
		set haserror 1
		manerror "no .HS or .TH record found"
	    }
	    if {!$haserror} {
		while {[more-text]} {
		    set line [next-text]
		    if {[is-a-directive $line]} {
			output-directive $line
		    } else {
			man-puts $line
		    }
		}
		man-puts [copyout $manual(copyrights) "../"]
		set manual(wing-copyrights) [merge-copyrights $manual(wing-copyrights) $manual(copyrights)]
	    }
	    #
	    # make the long table of contents for this page
	    #
	    set manual(toc-$manual(wing-file)-$manual(name)) [concat <DL> $manual(section-toc) </DL>]
	}

	#
	# make the wing table of contents for the section
	#
	set width 0
	foreach name $manual(wing-toc) {
	    if {[string length $name] > $width} {
		set width [string length $name]
	    }
	}
	set perline [expr {120 / $width}]
	set nrows [expr {([llength $manual(wing-toc)]+$perline)/$perline}]
	set n 0
        catch {unset rows}
	foreach name [lsort -dictionary $manual(wing-toc)] {
	    set tail $manual(name-$name)
	    if {[llength $tail] > 1} {
		manerror "$name is defined in more than one file: $tail"
		set tail [lindex $tail [expr {[llength $tail]-1}]]
	    }
	    set tail [file tail $tail]
	    append rows([expr {$n%$nrows}]) \
		    "<td> <a href=\"$tail.htm\">$name</a>"
	    incr n
	}
	puts $manual(wing-toc-fp) <table>
        foreach row [lsort -integer [array names rows]] {
	    puts $manual(wing-toc-fp) <tr>$rows($row)</tr>
	}
	puts $manual(wing-toc-fp) </table>

	#
	# insert wing copyrights
	#
	puts $manual(wing-toc-fp) [copyout $manual(wing-copyrights) "../"]
	puts $manual(wing-toc-fp) "</BODY></HTML>"
	close $manual(wing-toc-fp)
	set manual(merge-copyrights) [merge-copyrights $manual(merge-copyrights) $manual(wing-copyrights)]
    }

    ##
    ## build the keyword index.
    ##
    if {!$verbose} {
	puts stderr "Assembling index"
    }
    file delete -force -- $html/Keywords
    makedirhier $html/Keywords
    set keyfp [open $html/Keywords/[indexfile] w]
    puts $keyfp [htmlhead "$tcltkdesc Keywords" "$tcltkdesc Keywords" \
		     $overall_title "../[indexfile]"]
    set letters {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
    # Create header first
    set keyheader {}
    foreach a $letters {
	set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
	if {[llength $keys]} {
	    lappend keyheader "<A HREF=\"$a.htm\">$a</A>"
	} else {
	    # No keywords for this letter
	    lappend keyheader $a
	}
    }
    set keyheader <H3>[join $keyheader " |\n"]</H3>
    set keyheader "<H3>[join $keyheader " |\n"]</H3>"
    puts $keyfp $keyheader
    foreach a $letters {
	set keys [array names manual "keyword-\[[string totitle $a$a]\]*"]
	if {![llength $keys]} {
	    continue
	}
	# Per-keyword page
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
1848
1849
1850
1851
1852
1853
1854








1855

1856
1857
1858
1859
1860
1861
1862







-
-
-
-
-
-
-
-
+
-







	    set k [string range $k 8 end]
	    puts $afp "<DT><A NAME=\"$k\">$k</A></DT>"
	    puts $afp "<DD>"
	    set refs {}
	    foreach man $manual(keyword-$k) {
		set name [lindex $man 0]
		set file [lindex $man 1]
		if {[info exists manual(tooltip-$file)]} {
		    set tooltip $manual(tooltip-$file)
		    if {[string match {*[<>""]*} $tooltip]} {
			manerror "bad tooltip for $file: \"$tooltip\""
		    }
		    lappend refs "<A HREF=\"../$file\" TITLE=\"$tooltip\">$name</A>"
		} else {
		    lappend refs "<A HREF=\"../$file\">$name</A>"
		lappend refs "<A HREF=\"../$file\">$name</A>"
		}
	    }
	    puts $afp "[join $refs {, }]</DD>"
	}
	puts $afp "</DL>"
	# insert merged copyrights
	puts $afp [copyout $manual(merge-copyrights)]
	puts $afp "</BODY></HTML>"
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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

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
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










-
-
-
-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
-
-
-
-



-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
-
-
+
-
-
+
-
-
-
+
-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
+
-
-
-
    puts $manual(short-toc-fp) "</BODY></HTML>"
    close $manual(short-toc-fp)

    ##
    ## output man pages
    ##
    unset manual(section)
    if {!$verbose} {
	puts stderr "Rescanning [llength $manual(all-pages)] pages to build cross links and write out"
    }
    foreach path $manual(all-pages) wing_name $manual(all-page-domains) {
    foreach path $manual(all-pages) {
	set manual(wing-file) [file dirname $path]
	set manual(tail) [file tail $path]
	set manual(name) [file root $manual(tail)]
	try {
	    set text $manual(output-$manual(wing-file)-$manual(name))
	    set ntext 0
	    foreach item $text {
		incr ntext [llength [split $item \n]]
		incr ntext
	    }
	    set toc $manual(toc-$manual(wing-file)-$manual(name))
	    set ntoc 0
	    foreach item $toc {
		incr ntoc [llength [split $item \n]]
		incr ntoc
	    }
	set text $manual(output-$manual(wing-file)-$manual(name))
	set ntext 0
	foreach item $text {
	    incr ntext [llength [split $item \n]]
	    incr ntext
	}
	set toc $manual(toc-$manual(wing-file)-$manual(name))
	set ntoc 0
	foreach item $toc {
	    incr ntoc [llength [split $item \n]]
	    incr ntoc
	}
	    if {$verbose} {
		puts stderr "rescanning page $manual(name) $ntoc/$ntext"
	puts stderr "rescanning page $manual(name) $ntoc/$ntext"
	    } else {
		puts -nonewline stderr .
	    }
	    set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
	    puts $outfd [htmlhead "$manual($manual(wing-file)-$manual(name)-title)" \
		    $manual(name) $wing_name "[indexfile]" \
		    $overall_title "../[indexfile]"]
	    if {($ntext > 60) && ($ntoc > 32)} {
	set outfd [open $html/$manual(wing-file)/$manual(name).htm w]
	puts $outfd [htmlhead "$manual($manual(name)-title)" \
		$manual(name) $manual(wing-file) "[indexfile]" \
		$overall_title "../[indexfile]"]
	if {
	    (($ntext > 60) && ($ntoc > 32)) || $manual(tail) in {
		foreach item $toc {
		    puts $outfd $item
		}
		Hash LinkVar SetVar TraceVar ConfigWidg CrtImgType CrtItemType
		CrtPhImgFmt DoOneEvent GetBitmap GetColor GetCursor GetDash
		GetJustify GetPixels GetVisual ParseArgv QueueEvent
	    }
	    } elseif {$manual(name) in $forced_index_pages} {
		if {!$verbose} {puts stderr ""}
	} then {
		manerror "forcing index generation"
		foreach item $toc {
		    puts $outfd $item
		}
	    }
	    foreach item $text {
		puts $outfd [insert-cross-references $item]
	    }
	    puts $outfd "</BODY></HTML>"
	    foreach item $toc {
		puts $outfd $item
	    }
	}
	foreach item $text {
	    puts $outfd [insert-cross-references $item]
	}
	puts $outfd "</BODY></HTML>"
	} on error msg {
	    if {$verbose} {
		puts stderr $msg
	    } else {
		puts stderr "\nError when processing $manual(name): $msg"
	    }
	} finally {
	    catch {close $outfd}
	close $outfd
	}
    }
    if {!$verbose} {
	puts stderr "\nDone"
    }
    return {}
}


##
## Helper for assembling the descriptions of base packages (i.e., Tcl and Tk).
##
proc plus-base {var root glob name dir desc} {
    global tcltkdir
    if {$var} {
	if {[file exists $tcltkdir/$root/README]} {
	    set f [open $tcltkdir/$root/README]
	    set d [read $f]
	    close $f
	    if {[regexp {This is the \w+ (\S+) source distribution} $d -> version]} {
	       append name ", version $version"
	    }
	}
	set glob $root/$glob
	return [list $tcltkdir/$glob $name $dir $desc]
    }
}

##
## Helper for assembling the descriptions of contributed packages.
##
proc plus-pkgs {type args} {
    global build_tcl tcltkdir tcldir
    if {$type ni {n 3}} {
	error "unknown type \"$type\": must be 3 or n"
    }
    if {!$build_tcl} return
    set result {}
    set pkgsdir $tcltkdir/$tcldir/pkgs
    foreach {dir name version} $args {
	set globpat $pkgsdir/$dir/doc/*.$type
	if {![llength [glob -type f -nocomplain $globpat]]} {
	    # Fallback for manpages generated using doctools
	    set globpat $pkgsdir/$dir/doc/man/*.$type
	    if {![llength [glob -type f -nocomplain $globpat]]} {
		continue
	    }
	}
	set dir [string trimright $dir "0123456789-."]
	switch $type {
	    n {
		set title "$name Package Commands"
		if {$version ne ""} {
		    append title ", version $version"
		}
		set dir [string totitle $dir]Cmd
		set desc \
		    "The additional commands provided by the $name package."
	    }
	    3 {
		set title "$name Package C API"
		if {$version ne ""} {
		    append title ", version $version"
		}
		set dir [string totitle $dir]Lib
		set desc \
		    "The additional C functions provided by the $name package."
	    }
	}
	lappend result [list $globpat $title $dir $desc]
    }
    return $result
}

##
## Set up some special cases. It would be nice if we didn't have them,
## but we do...
##
set excluded_pages {case menubar pack-old}
set forced_index_pages {GetDash}
set process_first_patterns {*/ttk_widget.n */options.n}
set ensemble_commands {
    after array binary chan clock dde dict encoding file history info interp
    memory namespace package registry self string trace update zlib
    clipboard console font grab grid image option pack place selection tk
    tkwait ttk::style winfo wm itcl::delete itcl::find itcl::is
}
array set remap_link_target {
    stdin  Tcl_GetStdChannel
    stdout Tcl_GetStdChannel
    stderr Tcl_GetStdChannel
    style  ttk::style
    {style map} ttk::style
    {tk busy}   busy
    library     auto_execok
    safe-tcl    safe
    tclvars     env
    tcl_break   catch
    tcl_continue catch
    tcl_error   catch
    tcl_ok      catch
    tcl_return  catch
    int()       mathfunc
    wide()      mathfunc
    packagens   pkg::create
    pkgMkIndex  pkg_mkIndex
    pkg_mkIndex pkg_mkIndex
    Tcl_Obj     Tcl_NewObj
    Tcl_ObjType Tcl_RegisterObjType
    Tcl_OpenFileChannelProc Tcl_FSOpenFileChannel
    errorinfo 	env
    errorcode 	env
    tcl_pkgpath env
    Tcl_Command Tcl_CreateObjCommand
    Tcl_CmdProc Tcl_CreateObjCommand
    Tcl_CmdDeleteProc Tcl_CreateObjCommand
    Tcl_ObjCmdProc Tcl_CreateObjCommand
    Tcl_Channel Tcl_OpenFileChannel
    Tcl_WideInt Tcl_NewIntObj
    Tcl_ChannelType Tcl_CreateChannel
    Tcl_DString Tcl_DStringInit
    Tcl_Namespace Tcl_AppendExportList
    Tcl_Object  Tcl_NewObjectInstance
    Tcl_Class   Tcl_GetObjectAsClass
    Tcl_Event   Tcl_QueueEvent
    Tcl_Time	Tcl_GetTime
    Tcl_ThreadId Tcl_CreateThread
    Tk_Window	Tk_WindowId
    Tk_3DBorder Tk_Get3DBorder
    Tk_Anchor	Tk_GetAnchor
    Tk_Cursor	Tk_GetCursor
    Tk_Dash	Tk_GetDash
    Tk_Font	Tk_GetFont
    Tk_Image	Tk_GetImage
    Tk_ImageMaster Tk_GetImage
    Tk_ImageModel Tk_GetImage
    Tk_ItemType Tk_CreateItemType
    Tk_Justify	Tk_GetJustify
    Ttk_Theme	Ttk_GetTheme
}
array set exclude_refs_map {
    bind.n		{button destroy option}
    clock.n		{next}
    history.n		{exec}
    next.n		{unknown}
    zlib.n		{binary close filename text}
    canvas.n		{bitmap text}
    console.n		{eval}
    checkbutton.n	{image}
    clipboard.n		{string}
    entry.n		{string}
    event.n		{return}
    font.n		{menu}
    getOpenFile.n	{file open text}
    grab.n		{global}
    interp.n		{time}
    menu.n		{checkbutton radiobutton}
    messageBox.n	{error info}
    options.n		{bitmap image set}
    radiobutton.n	{image}
    safe.n		{join split}
    scale.n		{label variable}
    scrollbar.n		{set}
    selection.n		{string}
    tcltest.n		{error}
    text.n		{bind image lower raise}
    tkvars.n		{tk}
    tkwait.n		{variable}
    tm.n		{exec}
    ttk_checkbutton.n	{variable}
    ttk_combobox.n	{selection}
    ttk_entry.n		{focus variable}
    ttk_intro.n		{focus text}
    ttk_label.n		{font text}
    ttk_labelframe.n	{text}
    ttk_menubutton.n	{flush}
    ttk_notebook.n	{image text}
    ttk_progressbar.n	{variable}
    ttk_radiobutton.n	{variable}
    ttk_scale.n		{variable}
    ttk_scrollbar.n	{set}
    ttk_spinbox.n	{format}
    ttk_treeview.n	{text open}
    ttk_widget.n	{image text variable}
    TclZlib.3		{binary flush filename text}
}
array set exclude_when_followed_by_map {
    canvas.n {
	bind widget
	focus widget
	image are
	lower widget
	raise widget
    }
    selection.n {
	clipboard selection
	clipboard ;
    }
    ttk_image.n {
	image imageSpec
    }
    fontchooser.n {
	tk fontchooser
    }
}

try {
    # Parse what the user told us to do
    parse_command_line
parse_command_line

    # Some strings depend on what options are specified
    set tcltkdesc ""; set cmdesc ""; set appdir ""
    if {$build_tcl} {
	append tcltkdesc "Tcl"
	append cmdesc "Tcl"
	append appdir "$tcldir"
    }
    if {$build_tcl && $build_tk} {
	append tcltkdesc "/"
	append cmdesc " and "
	append appdir ","
    }
    if {$build_tk} {
	append tcltkdesc "Tk"
	append cmdesc "Tk"
	append appdir "$tkdir"
    }
set tcltkdesc ""; set cmdesc ""; set appdir ""
if {$build_tcl} {
    append tcltkdesc "Tcl"
    append cmdesc "Tcl"
    append appdir "$tcldir"
}
if {$build_tcl && $build_tk} {
    append tcltkdesc "/"
    append cmdesc " and "
    append appdir ","
}
if {$build_tk} {
    append tcltkdesc "Tk"
    append cmdesc "Tk"
    append appdir "$tkdir"
}

    apply {{} {
    global packageBuildList tcltkdir tcldir build_tcl

set usercmddesc "The interpreters which implement $cmdesc."
    # When building docs for Tcl, try to build docs for bundled packages too
    set packageBuildList {}
    if {$build_tcl} {
	set pkgsDir [file join $tcltkdir $tcldir pkgs]
	set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *]

set tclcmddesc {The commands which the <B>tclsh</B> interpreter implements.}
	foreach dir [lsort $subdirs] {
	    # Parse the subdir name into (name, version) as fallback...
	    set description [split $dir -]
	    if {2 != [llength $description]} {
		regexp {([^0-9]*)(.*)} $dir -> n v
		set description [list $n $v]
	    }

set tkcmddesc {The additional commands which the <B>wish</B> interpreter implements.}
	    # ... but try to extract (name, version) from subdir contents
	    try {
		set f [open [file join $pkgsDir $dir configure.ac]]
		foreach line [split [read $f] \n] {
		    if {2 == [scan $line \
			    { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
			set description [list $n $v]
			break
		    }
		}
	    } finally {
		catch {close $f; unset f}
	    }

set tcllibdesc {The C functions which a Tcl extended C program may use.}
	    if {[file exists [file join $pkgsDir $dir configure]]} {
		# Looks like a package, record our best extraction attempt
		lappend packageBuildList $dir {*}$description
	    }
	}
    }

set tklibdesc {The additional C functions which a Tk extended C program may use.}
    # Get the list of packages to try, and what their human-readable names
    # are. Note that the package directory list should be version-less.
    try {
	set packageDirNameMap {}
	if {$build_tcl} {
	    set f [open $tcltkdir/$tcldir/pkgs/package.list.txt]
	    try {
		foreach line [split [read $f] \n] {
		    if {[string trim $line] eq ""} continue
		    if {[string match #* $line]} continue
		    lassign $line dir name
		    lappend packageDirNameMap $dir $name
		}

	    } finally {
		close $f
	    }
	}
    } trap {POSIX ENOENT} {} {
	set packageDirNameMap {
	    itcl {[incr Tcl]}
	    tdbc {TDBC}
	    thread Thread
	}
    }

if {1} {
    # Convert to human readable names, if applicable
    for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} {
	lassign [lrange $packageBuildList $idx $idx+2] d n v
	if {[dict exists $packageDirNameMap $n]} {
	    lset packageBuildList $idx+1 [dict get $packageDirNameMap $n]
	}
    }
    }}

    if {[catch {
    #
    # Invoke the scraper/converter engine.
    #
    make-man-pages $webdir \
	[list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \
	make-man-pages $webdir \
	    "$tcltkdir/{$appdir}/doc/*.1 \"$tcltkdesc Applications\" UserCmd {$usercmddesc}" \
	     "The interpreters which implement $cmdesc."] \
	[plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \
	    [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.n {Tcl Commands} TclCmd {$tclcmddesc}" : ""}] \
	     "The commands which the <B>tclsh</B> interpreter implements."] \
	[plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \
	    [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.n {Tk Commands} TkCmd {$tkcmddesc}" : ""}] \
	     "The additional commands which the <B>wish</B> interpreter implements."] \
	{*}[plus-pkgs n {*}$packageBuildList] \
	[plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \
	    [expr {$build_tcl ? "$tcltkdir/$tcldir/doc/*.3 {Tcl Library} TclLib {$tcllibdesc}" : ""}] \
	     "The C functions which a Tcl extended C program may use."] \
	[plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \
	    [expr {$build_tk ? "$tcltkdir/$tkdir/doc/*.3 {Tk Library} TkLib {$tklibdesc}" : ""}]
	     "The additional C functions which a Tk extended C program may use."] \
	{*}[plus-pkgs 3 {*}$packageBuildList]
} on error {msg opts} {
    } error]} {
    # On failure make sure we show what went wrong. We're not supposed
    # to get here though; it represents a bug in the script.
    puts $msg\n[dict get $opts -errorinfo]
	puts $error\n$errorInfo
    exit 1
}

    }
}
# Local-Variables:
# mode: tcl
# End:

Deleted tools/tsdPerf.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59



























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#include <tcl.h>

extern DLLEXPORT Tcl_PackageInitProc Tsdperf_Init;

static Tcl_ThreadDataKey key;

typedef struct {
    Tcl_WideInt value;
} TsdPerf;


static int
tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
    Tcl_WideInt i;

    if (2 != objc) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }

    if (TCL_OK != Tcl_GetWideIntFromObj(interp, objv[1], &i)) {
	return TCL_ERROR;
    }

    perf->value = i;

    return TCL_OK;
}

static int
tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
    TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));


    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(perf->value));

    return TCL_OK;
}

int
Tsdperf_Init(Tcl_Interp *interp) {
    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "tsdPerfSet", tsdPerfSetObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "tsdPerfGet", tsdPerfGetObjCmd, NULL, NULL);

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted tools/tsdPerf.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

package require Thread

set ::tids [list]
for {set i 0} {$i < 4} {incr i} {
    lappend ::tids [thread::create [string map [list IVALUE $i] {
	set curdir [file dirname [info script]]
	load [file join $curdir tsdPerf[info sharedlibextension]]

	while 1 {
	    tsdPerfSet IVALUE
	}
    }]]
}

puts TIDS:$::tids

set curdir [file dirname [info script]]
load [file join $curdir tsdPerf[info sharedlibextension]]

tsdPerfSet 1234
while 1 {
    puts "TIME:[time {set value [tsdPerfGet]} 1000] VALUE:$value"
}

Changes to tools/uniParse.tcl.

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16
1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16








-
+







# uniParse.tcl --
#
#	This program parses the UnicodeData file and generates the
#	corresponding tclUniData.c file with compressed character
#	data tables.  The input to this program should be the latest
#	UnicodeData file from:
#	    ftp://ftp.unicode.org/Public/UNIDATA/UnicodeData.txt
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 Scriptics Corporation.
# All rights reserved.


namespace eval uni {
    set shift 5;		# number of bits of data within a page
				# This value can be adjusted to find the
				# best split to minimize table size
173
174
175
176
177
178
179
180

181
182
183
184
185
186
187
188

189
190
191
192
193
194
195
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187

188
189
190
191
192
193
194
195







-
+







-
+








    buildTables $data
    puts "X = [llength $pMap]  Y= [llength $pages]  A= [llength $groups]"
    set size [expr {[llength $pMap]*2 + ([llength $pages]<<$shift)}]
    puts "shift = $shift, space = $size"

    set f [open [file join [lindex $argv 1] tclUniData.c] w]
    fconfigure $f -translation lf
    fconfigure $f -translation lf -encoding utf-8
    puts $f "/*
 * tclUniData.c --
 *
 *	Declarations of Unicode character information tables.  This file is
 *	automatically generated by the tools/uniParse.tcl script.  Do not
 *	modify this file by hand.
 *
 * Copyright (c) 1998 by Scriptics Corporation.
 * Copyright (c) 1998 Scriptics Corporation.
 * All rights reserved.
 */

/*
 * A 16-bit Unicode character is split into two parts in order to index
 * into the following tables.  The lower OFFSET_BITS comprise an offset
 * into a page of characters.  The upper bits comprise the page number.

Deleted tools/valgrind_suppress.

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






























































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
{
   TclCreatesocketAddress/getaddrinfo/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclCreatesocketAddress/getaddrinfo/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:getaddrinfo
   fun:TclCreateSocketAddress
}

{
   TclpDlopen/load
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:dlopen
   fun:TclpDlopen
}

{
   TclpDlopen/load
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:dlopen
   fun:TclpDlopen
}

{
   TclpGetGrNam/__nss_next2/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetGrNam
}

{
   TclpGetGrNam/__nss_next2/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetGrNam
}

{
   TclpGetGrNam/__nss_systemd_getfrname_r/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:_nss_systemd_getgrnam_r
   ...
   fun:TclpGetGrNam
}

{
   TclpGetPwNam/getpwname_r/__nss_next2/calloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:calloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetPwNam
}

{
   TclpGetPwNam/getpwname_r/__nss_next2/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:__nss_next2
   ...
   fun:TclpGetPwNam
}

{
   TclpGetPwNam/getpwname_r/_nss_systemd_getpwnam_r/malloc
   Memcheck:Leak
   match-leak-kinds: reachable
   fun:malloc
   ...
   fun:_nss_systemd_getpwnam_r
   ...
   fun:TclpGetPwNam
}

{
	TclpThreadExit/pthread_exit/calloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:calloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

{
	TclpThreadExit/pthread_exit/malloc
    Memcheck:Leak
    match-leak-kinds: reachable
	fun:malloc
	...
	fun:pthread_exit
	fun:TclpThreadExit
}

Changes to unix/Makefile.in.

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
49
50
51
52
53
54
55



56
57
58
59
60
61
62







-
-
-







# Directory in which to install libtcl.so or libtcl.a:
LIB_INSTALL_DIR		= $(INSTALL_ROOT)$(libdir)
DLL_INSTALL_DIR		= @DLL_INSTALL_DIR@

# Path name to use when installing library scripts.
SCRIPT_INSTALL_DIR	= $(INSTALL_ROOT)$(TCL_LIBRARY)

# Path name to use when installing Tcl modules.
MODULE_INSTALL_DIR	= $(SCRIPT_INSTALL_DIR)/../tcl9

# Directory in which to install the include file tcl.h:
INCLUDE_INSTALL_DIR	= $(INSTALL_ROOT)$(includedir)

# Path to the private tcl header dir:
PRIVATE_INCLUDE_DIR	= @PRIVATE_INCLUDE_DIR@

# Directory in which to (optionally) install the private tcl headers:
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
79
80
81
82
83
84
85



86
87
88
89
90
91
92







-
-
-








# Directory in which to install html documentation:
HTML_INSTALL_DIR	= $(INSTALL_ROOT)$(HTML_DIR)

# Directory in which to install the configuration file tclConfig.sh
CONFIG_INSTALL_DIR	= $(INSTALL_ROOT)$(libdir)

# Directory in which to install bundled packages:
PACKAGE_DIR		= @PACKAGE_DIR@

# Package search path.
TCL_PACKAGE_PATH	= @TCL_PACKAGE_PATH@

# Tcl Module default path roots (TIP189).
TCL_MODULE_PATH		= @TCL_MODULE_PATH@

# warning flags
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
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







+
+
+
+
+











-
+







#CFLAGS			= $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@

# Flags to pass to the linker
LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

# To disable ANSI-C procedure prototypes reverse the comment characters on the
# following lines:
PROTO_FLAGS		=
#PROTO_FLAGS		= -DNO_PROTOTYPE

# If you use the setenv, putenv, or unsetenv procedures to modify environment
# variables in your application and you'd like those modifications to appear
# in the "env" Tcl variable, switch the comments on the two lines below so
# that Tcl provides these procedures instead of your standard C library.

ENV_FLAGS =
#ENV_FLAGS = -DTclSetEnv=setenv -DTcl_PutEnv=putenv -DTclUnsetEnv=unsetenv

# To enable memory debugging, call configure with --enable-symbols=mem
# Warning: if you enable memory debugging, you must do it *everywhere*,
# including all the code that calls Tcl, and you must use Tcl_Alloc and Tcl_Free
# including all the code that calls Tcl, and you must use ckalloc and ckfree
# everywhere instead of malloc and free.

TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
#TCL_STUB_LIB_FILE	= libtclstub.a

# Generic stub lib name used in rules that apply to tcl and tk
STUB_LIB_FILE		= ${TCL_STUB_LIB_FILE}
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
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







-
-
-
-
+
+
+
+
-
-
-
+
-
-


-
+





-
+








INSTALL			= $(SHELL) $(UNIX_DIR)/install-sh -c
INSTALL_PROGRAM		= ${INSTALL}
INSTALL_LIBRARY		= ${INSTALL}
INSTALL_DATA		= ${INSTALL} -m 644
INSTALL_DATA_DIR	= ${INSTALL} -d -m 755

# NATIVE_TCLSH is the name of a tclsh executable that is available *BEFORE*
# running make for the first time. Certain build targets (make genstubs) need
# it to be available on the PATH. This executable should *NOT* be required
# just to do a normal build although it can be required to run make dist.
# TCL_EXE is the name of a tclsh executable that is available *BEFORE* running
# make for the first time. Certain build targets (make genstubs) need it to be
# available on the PATH. This executable should *NOT* be required just to do a
# normal build although it can be required to run make dist.
# Do not use SHELL_ENV for NATIVE_TCLSH unless it is the tclsh being built.
EXE_SUFFIX		= @EXEEXT@
TCL_EXE			= tclsh${EXE_SUFFIX}
TCL_EXE			= tclsh@EXEEXT@
TCLTEST_EXE		= tcltest${EXE_SUFFIX}
NATIVE_TCLSH		= @TCLSH_PROG@

# The symbols below provide support for dynamic loading and shared libraries.
# See configure.ac for a description of what the symbols mean. The values of
# See configure.in for a description of what the symbols mean. The values of
# the symbols are normally set by the configure script. You shouldn't normally
# need to modify any of these definitions by hand.

STLIB_LD		= @STLIB_LD@
SHLIB_LD		= @SHLIB_LD@
SHLIB_CFLAGS		= @SHLIB_CFLAGS@ -DBUILD_tcl
SHLIB_CFLAGS		= @SHLIB_CFLAGS@
SHLIB_LD_LIBS		= @SHLIB_LD_LIBS@
SHLIB_LD_FLAGS		= @SHLIB_LD_FLAGS@
TCL_SHLIB_LD_EXTRAS	= @TCL_SHLIB_LD_EXTRAS@

SHLIB_SUFFIX		= @SHLIB_SUFFIX@

DLTEST_TARGETS		= dltest.marker
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
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

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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625






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
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
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
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
1065
1066
1067
1068
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
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
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
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


611
612
613
614


615
616
617







618


619
620
621
622
623
624
625


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
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
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







-
+














-
+


+




-





-
-
-
-
-

-
-




-
+












-
-
-
-
-
-
-






+
-
+
-
-
+
-

-
+






-
+










-
-
+
+
-
-
+
-


-
+
-

-
+

-
+



-
-
+
+

-
-
-
+
-
-
-
-
+
+
+


-
+
-
-
+

-
+
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+

-
+
-
-
-






-
+



-
-


-
-
-

-
+

-
+




-










-
-
-
-











-









-
-





-

-
















-








-
-
+







-





+












-
-
-
-
-
-
-
-
-
-
+
-
-
-


-
+
-
-


-
-
-
-
+
+
+
+


-







-
-
+
+
-

-
-
+
+



-
-
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-


-
-
-
-


-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
-



-
-
-
-




-


-
-
-
-
-
-
-
-
-
-


-

-
-
-
-
-
-
-
-
-

-

-
+
-
-
-
-
-
-
-
-

-

-

-


-
-
-
-
-
-
+
+
+
+
+
+


-

-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-

-
+
-
-
-




















-
+
-
-
















-
-
-




-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+


-
-
-
-
-


-
-
+
+














+
-
-
+
+
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-
-

-
+



-
+
-
-
+









-
+

-
-
+
+
+
+

-
-
+
+


-
-
+
+

-
-
-
-
-
-
-

-
-
+
+
+
+



-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-







+
+
+
+












-
-
+
+


-
-
-






-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+




+
-
-
-
-
+
+
+
+
+

-
+



+
-
+
+
+
+

+
+
-
-
-
-
-
-
+

-
+
+

-
-
-
+
+
+
-
-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+







# Generic lib name used in rules that apply to tcl and tk
LIB_FILE		= ${TCL_LIB_FILE}

TCL_LIB_FLAG		= @TCL_LIB_FLAG@
#TCL_LIB_FLAG		= -ltcl

# support for embedded libraries on Darwin / Mac OS X
DYLIB_INSTALL_DIR	= ${LIB_RUNTIME_DIR}
DYLIB_INSTALL_DIR	= $(libdir)

#--------------------------------------------------------------------------
# The information below is modified by the configure script when Makefile is
# generated from Makefile.in. You shouldn't normally modify any of this stuff
# by hand.
#--------------------------------------------------------------------------

COMPAT_OBJS		= @LIBOBJS@

AC_FLAGS		= @DEFS@
AR			= @AR@
RANLIB			= @RANLIB@
DTRACE			= @DTRACE@
SRC_DIR			= @srcdir@
TOP_DIR			= @TCL_SRC_DIR@
TOP_DIR			= $(SRC_DIR)/..
BUILD_DIR		= @builddir@
GENERIC_DIR		= $(TOP_DIR)/generic
TOMMATH_DIR		= $(TOP_DIR)/libtommath
COMPAT_DIR		= $(TOP_DIR)/compat
TOOL_DIR		= $(TOP_DIR)/tools
UNIX_DIR		= $(TOP_DIR)/unix
MAC_OSX_DIR		= $(TOP_DIR)/macosx
PKGS_DIR		= $(TOP_DIR)/pkgs
# Must be absolute because of the cd dltest $(DLTEST_DIR)/configure below.
DLTEST_DIR		= @TCL_SRC_DIR@/unix/dltest
# Must be absolute to so the corresponding tcltest's tcl_library is absolute.
TCL_BUILDTIME_LIBRARY	= @TCL_SRC_DIR@/library

ZLIB_DIR		= ${COMPAT_DIR}/zlib
ZLIB_INCLUDE		= @ZLIB_INCLUDE@
TOMMATH_DIR		= $(TOP_DIR)/libtommath
TOMMATH_INCLUDE		= @TOMMATH_INCLUDE@

CC			= @CC@
OBJEXT			= @OBJEXT@

#CC			= purify -best-effort @CC@ -DPURIFY

# Flags to be passed to installManPage to control how the manpages should be
# installed (symlinks, compression, package name suffix).
MAN_FLAGS		= @MAN_FLAGS@
MAN_FLAGS               = @MAN_FLAGS@

# If non-empty, install the timezone files that are included with Tcl,
# otherwise use the ones that ship with the OS.
INSTALL_TZDATA		= @INSTALL_TZDATA@

#--------------------------------------------------------------------------
# The information below is usually usable as is. The configure script won't
# modify it and it only exists to make working around selected rare system
# configurations easier.
#--------------------------------------------------------------------------

GDB			= gdb
LLDB			= lldb
TRACE			= strace
TRACE_OPTS		=
VALGRIND		= valgrind
VALGRINDARGS		= --tool=memcheck --num-callers=24 \
	--leak-resolution=high --leak-check=yes --show-reachable=yes -v \
	--suppressions=$(TOOL_DIR)/valgrind_suppress

#--------------------------------------------------------------------------
# The information below should be usable as is. The configure script won't
# modify it and you shouldn't need to modify it either.
#--------------------------------------------------------------------------

STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
STUB_CC_SWITCHES = -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
-I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
	${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
	${AC_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
	@EXTRA_CC_SWITCHES@

CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS} -DMP_FIXED_CUTOFFS -DMP_NO_STDINT
CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS}

APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@

LIBS		= @TCL_LIBS@

DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
	${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@

TCLSH_OBJS = tclAppInit.o

TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o

XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
	tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o

GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
	tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
	tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
	tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o tclClock.o \
	tclCmdAH.o tclCmdIL.o tclCmdMZ.o tclCompCmds.o tclCompExpr.o \
	tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclEncoding.o \
	tclEncoding.o tclEnsemble.o \
	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
	tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \
	tclIORChan.o tclIOGT.o tclIOSock.o tclIOUtil.o tclLink.o tclListObj.o \
	tclLink.o tclListObj.o \
	tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
	tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
	tclObj.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
	tclPkg.o tclPkgConfig.o tclPosixStr.o \
	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
	tclPreserve.o tclProc.o tclRegexp.o \
	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
	tclStrToD.o tclThread.o \
	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
	tclTomMathInterface.o tclZipfs.o
	tclStubLib.o tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o \
	tclTomMathInterface.o

OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
	tclOOMethod.o tclOOStubInit.o

TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \
	bn_s_mp_sqr_fast.o bn_mp_add.o bn_mp_and.o \
	bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
	bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
        bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
        bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
	bn_mp_cnt_lsb.o bn_mp_copy.o \
	bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
	bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o bn_mp_expt_u32.o \
	bn_mp_div_2d.o bn_mp_div_3.o \
	bn_mp_get_mag_u64.o \
	bn_mp_grow.o bn_mp_init.o \
        bn_mp_exch.o bn_mp_expt_d.o bn_mp_grow.o bn_mp_init.o \
	bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
	bn_mp_init_size.o bn_s_mp_karatsuba_mul.o \
	bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
	bn_mp_init_i64.o bn_mp_init_u64.o \
	bn_s_mp_karatsuba_sqr.o bn_s_mp_balance_mul.o \
	bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
	bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o bn_mp_set_i64.o  \
	bn_mp_read_radix.o bn_mp_rshd.o \
	bn_mp_set_u64.o bn_mp_shrink.o \
	bn_mp_karatsuba_sqr.o \
        bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
        bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
	bn_mp_radix_size.o bn_mp_radix_smap.o \
        bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
	bn_mp_shrink.o \
	bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
	bn_mp_signed_rsh.o \
	bn_mp_to_ubin.o \
	bn_s_mp_toom_mul.o bn_s_mp_toom_sqr.o bn_mp_to_radix.o \
	bn_mp_ubin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
	bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
        bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
	bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
	bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
        bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o

STUB_LIB_OBJS = tclStubLib.o \
STUB_LIB_OBJS = tclStubLib.o ${COMPAT_OBJS}
	tclTomMathStubLib.o \
	tclOOStubLib.o \
	${COMPAT_OBJS}

UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
	tclUnixFile.o tclUnixPipe.o tclUnixSock.o \
	tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
	tclUnixCompat.o

NOTIFY_OBJS = tclEpollNotfy.o tclKqueueNotfy.o tclSelectNotfy.o
NOTIFY_OBJS = tclUnixNotfy.o

MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o

CYGWIN_OBJS = tclWinError.o

DTRACE_OBJ = tclDTrace.o

ZLIB_OBJS = Zadler32.o Zcompress.o Zcrc32.o Zdeflate.o Zinfback.o \
	Zinffast.o Zinflate.o Zinftrees.o Ztrees.o Zuncompr.o Zzutil.o

TCL_OBJS = ${GENERIC_OBJS} ${UNIX_OBJS} ${NOTIFY_OBJS} ${COMPAT_OBJS} \
	${OO_OBJS} @DL_OBJS@ @PLAT_OBJS@
	@DL_OBJS@ @PLAT_OBJS@

OBJS = ${TCL_OBJS} @DTRACE_OBJ@ @ZLIB_OBJS@ @TOMMATH_OBJS@
OBJS = ${TCL_OBJS} ${TOMMATH_OBJS} @DTRACE_OBJ@

TCL_DECLS = \
	$(GENERIC_DIR)/tcl.decls \
	$(GENERIC_DIR)/tclInt.decls \
	$(GENERIC_DIR)/tclOO.decls \
	$(GENERIC_DIR)/tclTomMath.decls

GENERIC_HDRS = \
	$(GENERIC_DIR)/tcl.h \
	$(GENERIC_DIR)/tclDecls.h \
	$(GENERIC_DIR)/tclInt.h \
	$(GENERIC_DIR)/tclIntDecls.h \
	$(GENERIC_DIR)/tclIntPlatDecls.h \
	$(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h \
	$(GENERIC_DIR)/tclOO.h \
	$(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclOOInt.h \
	$(GENERIC_DIR)/tclOOIntDecls.h \
	$(GENERIC_DIR)/tclPatch.h \
	$(GENERIC_DIR)/tclPlatDecls.h \
	$(GENERIC_DIR)/tclPort.h \
	$(GENERIC_DIR)/tclRegexp.h

GENERIC_SRCS = \
	$(GENERIC_DIR)/regcomp.c \
	$(GENERIC_DIR)/regexec.c \
	$(GENERIC_DIR)/regfree.c \
	$(GENERIC_DIR)/regerror.c \
	$(GENERIC_DIR)/tclAlloc.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclAsync.c \
	$(GENERIC_DIR)/tclBasic.c \
	$(GENERIC_DIR)/tclBinary.c \
	$(GENERIC_DIR)/tclCkalloc.c \
	$(GENERIC_DIR)/tclClock.c \
	$(GENERIC_DIR)/tclCmdAH.c \
	$(GENERIC_DIR)/tclCmdIL.c \
	$(GENERIC_DIR)/tclCmdMZ.c \
	$(GENERIC_DIR)/tclCompCmds.c \
	$(GENERIC_DIR)/tclCompCmdsGR.c \
	$(GENERIC_DIR)/tclCompCmdsSZ.c \
	$(GENERIC_DIR)/tclCompExpr.c \
	$(GENERIC_DIR)/tclCompile.c \
	$(GENERIC_DIR)/tclConfig.c \
	$(GENERIC_DIR)/tclDate.c \
	$(GENERIC_DIR)/tclDictObj.c \
	$(GENERIC_DIR)/tclDisassemble.c \
	$(GENERIC_DIR)/tclEncoding.c \
	$(GENERIC_DIR)/tclEnsemble.c \
	$(GENERIC_DIR)/tclEnv.c \
	$(GENERIC_DIR)/tclEvent.c \
	$(GENERIC_DIR)/tclExecute.c \
	$(GENERIC_DIR)/tclFCmd.c \
	$(GENERIC_DIR)/tclFileName.c \
	$(GENERIC_DIR)/tclGet.c \
	$(GENERIC_DIR)/tclHash.c \
	$(GENERIC_DIR)/tclHistory.c \
	$(GENERIC_DIR)/tclIndexObj.c \
	$(GENERIC_DIR)/tclInterp.c \
	$(GENERIC_DIR)/tclIO.c \
	$(GENERIC_DIR)/tclIOCmd.c \
	$(GENERIC_DIR)/tclIOGT.c \
	$(GENERIC_DIR)/tclIOSock.c \
	$(GENERIC_DIR)/tclIOUtil.c \
	$(GENERIC_DIR)/tclIORChan.c \
	$(GENERIC_DIR)/tclIORTrans.c \
	$(GENERIC_DIR)/tclLink.c \
	$(GENERIC_DIR)/tclListObj.c \
	$(GENERIC_DIR)/tclLiteral.c \
	$(GENERIC_DIR)/tclLoad.c \
	$(GENERIC_DIR)/tclMain.c \
	$(GENERIC_DIR)/tclNamesp.c \
	$(GENERIC_DIR)/tclNotify.c \
	$(GENERIC_DIR)/tclObj.c \
	$(GENERIC_DIR)/tclOptimize.c \
	$(GENERIC_DIR)/tclParse.c \
        $(GENERIC_DIR)/tclParse.c \
	$(GENERIC_DIR)/tclPathObj.c \
	$(GENERIC_DIR)/tclPipe.c \
	$(GENERIC_DIR)/tclPkg.c \
	$(GENERIC_DIR)/tclPkgConfig.c \
	$(GENERIC_DIR)/tclPosixStr.c \
	$(GENERIC_DIR)/tclPreserve.c \
	$(GENERIC_DIR)/tclProc.c \
	$(GENERIC_DIR)/tclProcess.c \
	$(GENERIC_DIR)/tclRegexp.c \
	$(GENERIC_DIR)/tclResolve.c \
	$(GENERIC_DIR)/tclResult.c \
	$(GENERIC_DIR)/tclScan.c \
	$(GENERIC_DIR)/tclStubInit.c \
	$(GENERIC_DIR)/tclStubLib.c \
	$(GENERIC_DIR)/tclStringObj.c \
	$(GENERIC_DIR)/tclStrToD.c \
	$(GENERIC_DIR)/tclTest.c \
	$(GENERIC_DIR)/tclTestObj.c \
	$(GENERIC_DIR)/tclTestProcBodyObj.c \
	$(GENERIC_DIR)/tclThread.c \
	$(GENERIC_DIR)/tclThreadAlloc.c \
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \
	$(GENERIC_DIR)/tclTrace.c \
	$(GENERIC_DIR)/tclUtil.c \
	$(GENERIC_DIR)/tclVar.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclZlib.c \
	$(GENERIC_DIR)/tclZipfs.c

OO_SRCS = \
	$(GENERIC_DIR)/tclOO.c \
	$(GENERIC_DIR)/tclOOBasic.c \
	$(GENERIC_DIR)/tclOOCall.c \
	$(GENERIC_DIR)/tclOODefineCmds.c \
	$(GENERIC_DIR)/tclVar.c
	$(GENERIC_DIR)/tclOOInfo.c \
	$(GENERIC_DIR)/tclOOMethod.c \
	$(GENERIC_DIR)/tclOOStubInit.c

STUB_SRCS = \
	$(GENERIC_DIR)/tclStubLib.c \
	$(GENERIC_DIR)/tclStubLib.c
	$(GENERIC_DIR)/tclTomMathStubLib.c \
	$(GENERIC_DIR)/tclOOStubLib.c

TOMMATH_SRCS = \
	$(TOMMATH_DIR)/bn_cutoffs.c \
	$(TOMMATH_DIR)/bn_deprecated.c \
	$(TOMMATH_DIR)/bn_mp_2expt.c \
	$(TOMMATH_DIR)/bn_mp_abs.c \
	$(TOMMATH_DIR)/bncore.c \
	$(TOMMATH_DIR)/bn_reverse.c \
	$(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c \
	$(TOMMATH_DIR)/bn_fast_s_mp_sqr.c \
	$(TOMMATH_DIR)/bn_mp_add.c \
	$(TOMMATH_DIR)/bn_mp_add_d.c \
	$(TOMMATH_DIR)/bn_mp_addmod.c \
	$(TOMMATH_DIR)/bn_mp_and.c \
	$(TOMMATH_DIR)/bn_mp_clamp.c \
	$(TOMMATH_DIR)/bn_mp_clear.c \
	$(TOMMATH_DIR)/bn_mp_clear_multi.c \
	$(TOMMATH_DIR)/bn_mp_cmp.c \
	$(TOMMATH_DIR)/bn_mp_cmp_d.c \
	$(TOMMATH_DIR)/bn_mp_cmp_mag.c \
	$(TOMMATH_DIR)/bn_mp_cnt_lsb.c \
	$(TOMMATH_DIR)/bn_mp_complement.c \
	$(TOMMATH_DIR)/bn_mp_copy.c \
	$(TOMMATH_DIR)/bn_mp_cnt_lsb.c \
	$(TOMMATH_DIR)/bn_mp_copy.c \
	$(TOMMATH_DIR)/bn_mp_count_bits.c \
	$(TOMMATH_DIR)/bn_mp_decr.c \
	$(TOMMATH_DIR)/bn_mp_div.c \
	$(TOMMATH_DIR)/bn_mp_div.c \
	$(TOMMATH_DIR)/bn_mp_div_d.c \
	$(TOMMATH_DIR)/bn_mp_div_2.c \
	$(TOMMATH_DIR)/bn_mp_div_2d.c \
	$(TOMMATH_DIR)/bn_mp_div_3.c \
	$(TOMMATH_DIR)/bn_mp_div_d.c \
	$(TOMMATH_DIR)/bn_mp_dr_is_modulus.c \
	$(TOMMATH_DIR)/bn_mp_dr_reduce.c \
	$(TOMMATH_DIR)/bn_mp_dr_setup.c \
	$(TOMMATH_DIR)/bn_mp_error_to_string.c \
	$(TOMMATH_DIR)/bn_mp_exch.c \
	$(TOMMATH_DIR)/bn_mp_expt_u32.c \
	$(TOMMATH_DIR)/bn_mp_expt_d.c \
	$(TOMMATH_DIR)/bn_mp_exptmod.c \
	$(TOMMATH_DIR)/bn_mp_exteuclid.c \
	$(TOMMATH_DIR)/bn_mp_fread.c \
	$(TOMMATH_DIR)/bn_mp_from_sbin.c \
	$(TOMMATH_DIR)/bn_mp_from_ubin.c \
	$(TOMMATH_DIR)/bn_mp_fwrite.c \
	$(TOMMATH_DIR)/bn_mp_gcd.c \
	$(TOMMATH_DIR)/bn_mp_get_double.c \
	$(TOMMATH_DIR)/bn_mp_get_i32.c \
	$(TOMMATH_DIR)/bn_mp_get_i64.c \
	$(TOMMATH_DIR)/bn_mp_get_l.c \
	$(TOMMATH_DIR)/bn_mp_get_ll.c \
	$(TOMMATH_DIR)/bn_mp_get_mag_u32.c \
	$(TOMMATH_DIR)/bn_mp_get_mag_u64.c \
	$(TOMMATH_DIR)/bn_mp_get_mag_ul.c \
	$(TOMMATH_DIR)/bn_mp_get_mag_ull.c \
	$(TOMMATH_DIR)/bn_mp_grow.c \
	$(TOMMATH_DIR)/bn_mp_incr.c \
	$(TOMMATH_DIR)/bn_mp_init.c \
	$(TOMMATH_DIR)/bn_mp_init_copy.c \
	$(TOMMATH_DIR)/bn_mp_init_i32.c \
	$(TOMMATH_DIR)/bn_mp_init_i64.c \
	$(TOMMATH_DIR)/bn_mp_init_l.c \
	$(TOMMATH_DIR)/bn_mp_init_ll.c \
	$(TOMMATH_DIR)/bn_mp_init_multi.c \
	$(TOMMATH_DIR)/bn_mp_init_set.c \
	$(TOMMATH_DIR)/bn_mp_init_size.c \
	$(TOMMATH_DIR)/bn_mp_init_u32.c \
	$(TOMMATH_DIR)/bn_mp_init_set_int.c \
	$(TOMMATH_DIR)/bn_mp_init_size.c \
	$(TOMMATH_DIR)/bn_mp_init_u64.c \
	$(TOMMATH_DIR)/bn_mp_init_ul.c \
	$(TOMMATH_DIR)/bn_mp_init_ull.c \
	$(TOMMATH_DIR)/bn_mp_invmod.c \
	$(TOMMATH_DIR)/bn_mp_is_square.c \
	$(TOMMATH_DIR)/bn_mp_iseven.c \
	$(TOMMATH_DIR)/bn_mp_isodd.c \
	$(TOMMATH_DIR)/bn_mp_kronecker.c \
	$(TOMMATH_DIR)/bn_mp_lcm.c \
	$(TOMMATH_DIR)/bn_mp_karatsuba_mul.c \
	$(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c \
	$(TOMMATH_DIR)/bn_mp_log_u32.c \
	$(TOMMATH_DIR)/bn_mp_lshd.c \
	$(TOMMATH_DIR)/bn_mp_mod.c \
	$(TOMMATH_DIR)/bn_mp_mod_2d.c \
	$(TOMMATH_DIR)/bn_mp_mod_d.c \
	$(TOMMATH_DIR)/bn_mp_montgomery_calc_normalization.c \
	$(TOMMATH_DIR)/bn_mp_montgomery_reduce.c \
	$(TOMMATH_DIR)/bn_mp_montgomery_setup.c \
	$(TOMMATH_DIR)/bn_mp_mul.c \
	$(TOMMATH_DIR)/bn_mp_mul_2.c \
	$(TOMMATH_DIR)/bn_mp_mul_2d.c \
	$(TOMMATH_DIR)/bn_mp_mul_d.c \
	$(TOMMATH_DIR)/bn_mp_mulmod.c \
	$(TOMMATH_DIR)/bn_mp_neg.c \
	$(TOMMATH_DIR)/bn_mp_or.c \
	$(TOMMATH_DIR)/bn_mp_pack.c \
	$(TOMMATH_DIR)/bn_mp_pack_count.c \
	$(TOMMATH_DIR)/bn_mp_prime_fermat.c \
	$(TOMMATH_DIR)/bn_mp_prime_frobenius_underwood.c \
	$(TOMMATH_DIR)/bn_mp_prime_is_prime.c \
	$(TOMMATH_DIR)/bn_mp_prime_miller_rabin.c \
	$(TOMMATH_DIR)/bn_mp_prime_next_prime.c \
	$(TOMMATH_DIR)/bn_mp_prime_rabin_miller_trials.c \
	$(TOMMATH_DIR)/bn_mp_prime_rand.c \
	$(TOMMATH_DIR)/bn_mp_prime_strong_lucas_selfridge.c \
	$(TOMMATH_DIR)/bn_mp_radix_size.c \
	$(TOMMATH_DIR)/bn_mp_radix_smap.c \
	$(TOMMATH_DIR)/bn_mp_rand.c \
	$(TOMMATH_DIR)/bn_mp_read_radix.c \
	$(TOMMATH_DIR)/bn_mp_reduce.c \
	$(TOMMATH_DIR)/bn_mp_reduce_2k.c \
	$(TOMMATH_DIR)/bn_mp_reduce_2k_l.c \
	$(TOMMATH_DIR)/bn_mp_reduce_2k_setup.c \
	$(TOMMATH_DIR)/bn_mp_reduce_2k_setup_l.c \
	$(TOMMATH_DIR)/bn_mp_reduce_is_2k.c \
	$(TOMMATH_DIR)/bn_mp_reduce_is_2k_l.c \
	$(TOMMATH_DIR)/bn_mp_reduce_setup.c \
	$(TOMMATH_DIR)/bn_mp_root_u32.c \
	$(TOMMATH_DIR)/bn_mp_rshd.c \
	$(TOMMATH_DIR)/bn_mp_sbin_size.c \
	$(TOMMATH_DIR)/bn_mp_set.c \
	$(TOMMATH_DIR)/bn_mp_set_double.c \
	$(TOMMATH_DIR)/bn_mp_set_int.c \
	$(TOMMATH_DIR)/bn_mp_set_i32.c \
	$(TOMMATH_DIR)/bn_mp_set_i64.c \
	$(TOMMATH_DIR)/bn_mp_set_l.c \
	$(TOMMATH_DIR)/bn_mp_set_ll.c \
	$(TOMMATH_DIR)/bn_mp_set_u32.c \
	$(TOMMATH_DIR)/bn_mp_set_u64.c \
	$(TOMMATH_DIR)/bn_mp_set_ul.c \
	$(TOMMATH_DIR)/bn_mp_set_ull.c \
	$(TOMMATH_DIR)/bn_mp_shrink.c \
	$(TOMMATH_DIR)/bn_mp_signed_rsh.c \
	$(TOMMATH_DIR)/bn_mp_sqr.c \
	$(TOMMATH_DIR)/bn_mp_sqrmod.c \
	$(TOMMATH_DIR)/bn_mp_sqrt.c \
	$(TOMMATH_DIR)/bn_mp_sqrtmod_prime.c \
	$(TOMMATH_DIR)/bn_mp_sub.c \
	$(TOMMATH_DIR)/bn_mp_sub_d.c \
	$(TOMMATH_DIR)/bn_mp_submod.c \
	$(TOMMATH_DIR)/bn_mp_to_radix.c \
	$(TOMMATH_DIR)/bn_mp_to_sbin.c \
	$(TOMMATH_DIR)/bn_mp_to_ubin.c \
	$(TOMMATH_DIR)/bn_mp_ubin_size.c \
	$(TOMMATH_DIR)/bn_mp_unpack.c \
	$(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c \
	$(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c \
	$(TOMMATH_DIR)/bn_mp_toom_mul.c \
	$(TOMMATH_DIR)/bn_mp_toom_sqr.c \
	$(TOMMATH_DIR)/bn_mp_toradix_n.c \
	$(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c \
	$(TOMMATH_DIR)/bn_mp_xor.c \
	$(TOMMATH_DIR)/bn_mp_zero.c \
	$(TOMMATH_DIR)/bn_prime_tab.c \
	$(TOMMATH_DIR)/bn_s_mp_add.c \
	$(TOMMATH_DIR)/bn_s_mp_balance_mul.c \
	$(TOMMATH_DIR)/bn_s_mp_exptmod.c \
	$(TOMMATH_DIR)/bn_s_mp_exptmod_fast.c \
	$(TOMMATH_DIR)/bn_s_mp_get_bit.c \
	$(TOMMATH_DIR)/bn_s_mp_invmod_fast.c \
	$(TOMMATH_DIR)/bn_s_mp_invmod_slow.c \
	$(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c \
	$(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c \
	$(TOMMATH_DIR)/bn_s_mp_montgomery_reduce_fast.c \
	$(TOMMATH_DIR)/bn_s_mp_mul_digs.c \
	$(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c \
	$(TOMMATH_DIR)/bn_s_mp_mul_high_digs.c \
	$(TOMMATH_DIR)/bn_s_mp_mul_high_digs_fast.c \
	$(TOMMATH_DIR)/bn_s_mp_prime_is_divisible.c \
	$(TOMMATH_DIR)/bn_s_mp_rand_jenkins.c \
	$(TOMMATH_DIR)/bn_s_mp_rand_platform.c \
	$(TOMMATH_DIR)/bn_s_mp_reverse.c \
	$(TOMMATH_DIR)/bn_s_mp_sqr.c \
	$(TOMMATH_DIR)/bn_s_mp_sqr_fast.c \
	$(TOMMATH_DIR)/bn_s_mp_sub.c
	$(TOMMATH_DIR)/bn_s_mp_sub.c \
	$(TOMMATH_DIR)/bn_s_mp_toom_mul.c \
	$(TOMMATH_DIR)/bn_s_mp_toom_sqr.c

UNIX_HDRS = \
	$(UNIX_DIR)/tclUnixPort.h
#	$(UNIX_DIR)/tclConfig.h

UNIX_SRCS = \
	$(UNIX_DIR)/tclAppInit.c \
	$(UNIX_DIR)/tclUnixChan.c \
	$(UNIX_DIR)/tclUnixEvent.c \
	$(UNIX_DIR)/tclUnixFCmd.c \
	$(UNIX_DIR)/tclUnixFile.c \
	$(UNIX_DIR)/tclUnixPipe.c \
	$(UNIX_DIR)/tclUnixSock.c \
	$(UNIX_DIR)/tclUnixTest.c \
	$(UNIX_DIR)/tclUnixThrd.c \
	$(UNIX_DIR)/tclUnixTime.c \
	$(UNIX_DIR)/tclUnixInit.c \
	$(UNIX_DIR)/tclUnixCompat.c

NOTIFY_SRCS = \
	$(UNIX_DIR)/tclEpollNotfy.c \
	$(UNIX_DIR)/tclUnixNotfy.c
	$(UNIX_DIR)/tclKqueueNotfy.c \
	$(UNIX_DIR)/tclSelectNotfy.c

DL_SRCS = \
	$(UNIX_DIR)/tclLoadAix.c \
	$(UNIX_DIR)/tclLoadDl.c \
	$(UNIX_DIR)/tclLoadDl2.c \
	$(UNIX_DIR)/tclLoadDld.c \
	$(UNIX_DIR)/tclLoadDyld.c \
	$(GENERIC_DIR)/tclLoadNone.c \
	$(UNIX_DIR)/tclLoadOSF.c \
	$(UNIX_DIR)/tclLoadShl.c

MAC_OSX_SRCS = \
	$(MAC_OSX_DIR)/tclMacOSXBundle.c \
	$(MAC_OSX_DIR)/tclMacOSXFCmd.c \
	$(MAC_OSX_DIR)/tclMacOSXNotify.c

CYGWIN_SRCS = \
	$(TOP_DIR)/win/tclWinError.c

DTRACE_HDR = tclDTrace.h

DTRACE_SRC = $(GENERIC_DIR)/tclDTrace.d

ZLIB_SRCS = \
	$(ZLIB_DIR)/adler32.c \
	$(ZLIB_DIR)/compress.c \
	$(ZLIB_DIR)/crc32.c \
	$(ZLIB_DIR)/deflate.c \
	$(ZLIB_DIR)/infback.c \
	$(ZLIB_DIR)/inffast.c \
	$(ZLIB_DIR)/inflate.c \
	$(ZLIB_DIR)/inftrees.c \
	$(ZLIB_DIR)/trees.c \
	$(ZLIB_DIR)/uncompr.c \
	$(ZLIB_DIR)/zutil.c

# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those files
# won't compile on the current machine, and they will cause problems for
# things like "make depend".

SRCS = $(GENERIC_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
	$(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@ @TOMMATH_SRCS@
SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
	$(STUB_SRCS) @PLAT_SRCS@

###
# Tip 430 - ZipFS Modifications
###

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_ROOT		= libtcl.vfs
TCL_VFS_PATH		= ${TCL_VFS_ROOT}/tcl_library

HOST_CC			= @CC_FOR_BUILD@
HOST_EXEEXT		= @EXEEXT_FOR_BUILD@
HOST_OBJEXT		= @OBJEXT_FOR_BUILD@
ZIPFS_BUILD		= @ZIPFS_BUILD@
NATIVE_ZIP		= @ZIP_PROG@
ZIP_PROG_OPTIONS	= @ZIP_PROG_OPTIONS@
ZIP_PROG_VFSSEARCH	= @ZIP_PROG_VFSSEARCH@
SHARED_BUILD		= @SHARED_BUILD@
INSTALL_LIBRARIES	= @INSTALL_LIBRARIES@
INSTALL_MSGS		= @INSTALL_MSGS@

# Minizip
MINIZIP_OBJS = \
	adler32.$(HOST_OBJEXT) \
	compress.$(HOST_OBJEXT) \
	crc32.$(HOST_OBJEXT) \
	deflate.$(HOST_OBJEXT) \
	infback.$(HOST_OBJEXT) \
	inffast.$(HOST_OBJEXT) \
	inflate.$(HOST_OBJEXT) \
	inftrees.$(HOST_OBJEXT) \
	ioapi.$(HOST_OBJEXT) \
	trees.$(HOST_OBJEXT) \
	uncompr.$(HOST_OBJEXT) \
	zip.$(HOST_OBJEXT) \
	zutil.$(HOST_OBJEXT) \
	minizip.$(HOST_OBJEXT)

ZIP_INSTALL_OBJS	= @ZIP_INSTALL_OBJS@

#--------------------------------------------------------------------------
# Start of rules
#--------------------------------------------------------------------------

all: binaries libraries doc packages
all: binaries libraries doc

binaries: ${LIB_FILE} ${TCL_EXE}

libraries:

doc:

tclzipfile: ${TCL_ZIP_FILE}

${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS}
	@rm -rf ${TCL_VFS_ROOT}
	@mkdir -p ${TCL_VFS_PATH}
	@echo "creating ${TCL_VFS_PATH} (prepare compression)"
	@if \
	    ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/; \
	then : ; else \
	    cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \
	fi
	mv ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl
	rm -rf ${TCL_VFS_PATH}/dde ${TCL_VFS_PATH}/reg
	@find ${TCL_VFS_ROOT} -type d -empty -delete
	@echo "creating ${TCL_ZIP_FILE} from ${TCL_VFS_PATH}"
	@(zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}' || \
	    echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")  2>/dev/null`; \
	    echo 'cd ${TCL_VFS_ROOT} &&' $$zip '${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH}'; \
	    cd ${TCL_VFS_ROOT} && \
	    $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null)

# The following target is configured by autoconf to generate either a shared
# library or non-shared library for Tcl.
${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE}
${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS}
	rm -f $@
	@MAKE_LIB@
	@if test "${ZIPFS_BUILD}" = "1" ; then \
	    cat ${TCL_ZIP_FILE} >> ${LIB_FILE}; \
	    ${NATIVE_ZIP} -A ${LIB_FILE} \
	    || echo 'ignore zip-error by adjust sfx process (not executable?)'; \
	fi

${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
	@if [ "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll" ] ; then \
	    ( cd ${TOP_DIR}/win; ${MAKE} winextensions ); \
	@if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \
	    (cd ${TOP_DIR}/win; ${MAKE} winextensions); \
	fi
	rm -f $@
	@MAKE_STUB_LIB@

# Make target which outputs the list of the .o contained in the Tcl lib useful
# to build a single big shared library containing Tcl and other extensions.
# Used for the Tcl Plugin.  -- dl
# The dependency on OBJS is not there because we just want the list of objects
# here, not actually building them
tclLibObjs:
	@echo ${OBJS}
# This targets actually build the objects needed for the lib in the above case
objs: ${OBJS}


${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE}
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \
${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE}
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
		${CC_SEARCH_FLAGS} -o ${TCL_EXE}

# Must be empty so it doesn't conflict with rule for ${TCL_EXE} above
${NATIVE_TCLSH}:

Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
	$(SHELL) config.status
#tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
#	$(SHELL) config.status

clean: clean-packages
	rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \
		minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs
	(cd dltest ; $(MAKE) clean)

distclean: distclean-packages clean
	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
		tclConfig.h *.plist Tcl.framework tcl.pc
	(cd dltest ; $(MAKE) distclean)

depend:
	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)

#--------------------------------------------------------------------------
# The following target outputs the name of the top-level source directory for
# Tcl (it is used by Tk's configure script, for example). The .NO_PARALLEL
# line is needed to avoid problems under Sun's "pmake". Note: this target is
# now obsolete (use the autoconf variable TCL_SRC_DIR from tclConfig.sh
# instead).
#--------------------------------------------------------------------------

.NO_PARALLEL: topDirName
topDirName:
	@cd $(TOP_DIR); pwd

#--------------------------------------------------------------------------
# Rules for testing
#--------------------------------------------------------------------------

# Resetting the LIB_RUNTIME_DIR below is required so that the generated
# tcltest executable gets the build directory burned into its ld search path.
# This keeps tcltest from picking up an already installed version of the Tcl
# library.
SHELL_ENV =	@LD_LIBRARY_PATH_VAR@=`pwd`:${@LD_LIBRARY_PATH_VAR@} \
		TCLLIBPATH="@abs_builddir@/pkgs" \
		TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"

${TCLTEST_EXE}: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST}
tcltest@EXEEXT@: ${TCLTEST_OBJS} ${TCL_LIB_FILE} ${BUILD_DLTEST}
	$(MAKE) tcltest-real LIB_RUNTIME_DIR="`pwd`"

tcltest-real:
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} \
	${CC} ${CFLAGS} ${LDFLAGS} ${TCLTEST_OBJS} @TCL_BUILD_LIB_SPEC@ ${LIBS} @EXTRA_TCLSH_LIBS@ \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
		${CC_SEARCH_FLAGS} -o ${TCLTEST_EXE}
		${CC_SEARCH_FLAGS} -o tcltest@EXEEXT@

# Note, in the targets below TCL_LIBRARY needs to be set or else "make test"
# won't work in the case where the compilation directory isn't the same as the
# source directory.
#
# Specifying TESTFLAGS on the command line is the standard way to pass args to
# tcltest, ie:
#	% make test TESTFLAGS="-verbose bps -file fileName.test"

test: test-tcl test-packages
test: test-tcl

test-tcl: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)
test-tcl: tcltest@EXEEXT@
	@LD_LIBRARY_PATH_VAR@="`pwd`:$${@LD_LIBRARY_PATH_VAR@}"; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	./tcltest@EXEEXT@ $(TOP_DIR)/tests/all.tcl $(TESTFLAGS)

gdb-test: ${TCLTEST_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run
gdb-test: tcltest@EXEEXT@
	@echo "set env @LD_LIBRARY_PATH_VAR@=\"`pwd`:$${@LD_LIBRARY_PATH_VAR@}\"" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
	@rm gdb.run
	$(GDB) ./tcltest@EXEEXT@ --command=gdb.run
	rm gdb.run

lldb-test: ${TCLTEST_EXE}
	@echo "settings set target.env-vars @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > lldb.run
	@echo "settings set target.env-vars TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> lldb.run
	$(LLDB) --source lldb.run ./${TCLTEST_EXE} -- $(TOP_DIR)/tests/all.tcl \
		$(TESTFLAGS) -singleproc 1
	@rm lldb.run

# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}
	$(SHELL_ENV) ./${TCLTEST_EXE}
runtest: tcltest@EXEEXT@
	@LD_LIBRARY_PATH_VAR@="`pwd`:$${@LD_LIBRARY_PATH_VAR@}"; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	./tcltest@EXEEXT@

# Useful target for running the test suite with an unwritable current
# directory...
ro-test: ${TCLTEST_EXE}
	echo 'exec chmod -w .;package require tcltest;tcltest::temporaryDirectory /tmp;source ../tests/all.tcl;exec chmod +w .' | $(SHELL_ENV) ./${TCLTEST_EXE}
ro-test: tcltest@EXEEXT@
	@LD_LIBRARY_PATH_VAR@="`pwd`:$${@LD_LIBRARY_PATH_VAR@}"; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	echo 'exec chmod -w .;package require tcltest;tcltest::temporaryDirectory /tmp;source ../tests/all.tcl;exec chmod +w .' | ./tcltest@EXEEXT@

# This target can be used to run tclsh from the build directory
# via `make shell SCRIPT=/tmp/foo.tcl`
shell: ${TCL_EXE}
	@LD_LIBRARY_PATH_VAR@="`pwd`:$${@LD_LIBRARY_PATH_VAR@}"; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	./${TCL_EXE} $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: ${TCL_EXE}
	@echo "set env @LD_LIBRARY_PATH_VAR@=\"`pwd`:$${@LD_LIBRARY_PATH_VAR@}\"" > gdb.run
	@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
	$(GDB) ./${TCL_EXE} --command=gdb.run
	rm gdb.run

VALGRINDARGS=--tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v

valgrind: ${TCL_EXE} tcltest@EXEEXT@
	@LD_LIBRARY_PATH_VAR@="`pwd`:$${@LD_LIBRARY_PATH_VAR@}"; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	valgrind $(VALGRINDARGS) ./tcltest@EXEEXT@ $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS)

valgrindshell: ${TCL_EXE}
	@LD_LIBRARY_PATH_VAR@="`pwd`:$${@LD_LIBRARY_PATH_VAR@}"; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	valgrind $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)

# The following target outputs the name of the top-level source directory for
# Tcl (it is used by Tk's configure script, for example). The .NO_PARALLEL
# line is needed to avoid problems under Sun's "pmake". Note: this target is
# now obsolete (use the autoconf variable TCL_SRC_DIR from tclConfig.sh
# instead).

.NO_PARALLEL: topDirName
topDirName:
	@cd $(TOP_DIR); pwd

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
	--no-lines \
	--name-prefix=TclDate \
	$(GENERIC_DIR)/tclGetDate.y

#	yacc -l $(GENERIC_DIR)/tclGetDate.y
#	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
#	    -e 's?SCCSID?RCS: @(#) ?' \
#	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
#	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
#	    -e '/#include <inttypes.h>/d' -e 's/const /CONST /g' \
#           -e '/#define YYNEW/s/malloc/TclDateAlloc/g' \
#	    -e '/#define YYENLARGE/,/realloc/s/realloc/TclDateRealloc/g' \
#	    <y.tab.c >$(GENERIC_DIR)/tclDate.c
#	rm y.tab.c

# The following target generates the file generic/tclTomMath.h. It needs to be
# run (and the results checked) after updating to a new release of libtommath.

gentommath_h:
	$(TCL_EXE) "$(TOOL_DIR)/fix_tommath_h.tcl" \
		"$(TOMMATH_DIR)/tommath.h" \
		> "$(GENERIC_DIR)/tclTomMath.h"

# The following target generates the shared libraries in dltest/ that are used
# for testing; they are included as part of the "tcltest" target (via the
# BUILD_DLTEST variable) if dynamic loading is supported on this platform. The
# Makefile in the dltest subdirectory creates the dltest.marker file in this
# directory after a successful build.

dltest.marker: ${STUB_LIB_FILE}
	cd dltest ; $(MAKE)

#--------------------------------------------------------------------------
# Rules for running a shell before installation
#--------------------------------------------------------------------------

# This target can be used to run tclsh from the build directory
# via `make shell SCRIPT=/tmp/foo.tcl`
shell: ${TCL_EXE}
	$(SHELL_ENV) ./${TCL_EXE} $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: ${TCL_EXE}
	$(SHELL_ENV) $(GDB) ./${TCL_EXE}

valgrind: ${TCL_EXE} ${TCLTEST_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \
		$(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \
		$(TESTFLAGS)

valgrindshell: ${TCL_EXE}
	$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)

trace-shell: ${TCL_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCL_EXE} $(SCRIPT)

trace-test: ${TCLTEST_EXE}
	$(SHELL_ENV) ${TRACE} $(TRACE_OPTS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 $(TESTFLAGS)

#--------------------------------------------------------------------------
# Installation rules
#--------------------------------------------------------------------------

INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_TARGETS = install-binaries install-libraries install-doc @EXTRA_INSTALL@
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
INSTALL_EXTRA_TARGETS = @EXTRA_INSTALL@
INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)

install: $(INSTALL_TARGETS)

install-strip:
	$(MAKE) $(INSTALL_TARGETS) \
		INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \
		INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}"

# Note: before running ranlib below, must cd to target directory because some
# ranlibs write to current directory, and this might not always be possible
# (e.g. if installing as root).

install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \
		"$(CONFIG_INSTALL_DIR)" ; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
	    fi; \
	done
	@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
	@@INSTALL_LIB@
	@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
	@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)${EXE_SUFFIX}"
	@echo "Installing ${TCL_EXE} as $(BIN_INSTALL_DIR)/tclsh$(VERSION)@EXEEXT@"
	@$(INSTALL_PROGRAM) ${TCL_EXE} "$(BIN_INSTALL_DIR)/tclsh$(VERSION)@EXEEXT@"
	@echo "Installing tclConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) tclConfig.sh "$(CONFIG_INSTALL_DIR)/tclConfig.sh"
	@echo "Installing tclooConfig.sh to $(CONFIG_INSTALL_DIR)/"
	@$(INSTALL_DATA) $(UNIX_DIR)/tclooConfig.sh \
		"$(CONFIG_INSTALL_DIR)/tclooConfig.sh"
	@if test "$(STUB_LIB_FILE)" != "" ; then \
	    echo "Installing $(STUB_LIB_FILE) to $(LIB_INSTALL_DIR)/"; \
	    @INSTALL_STUB_LIB@ ; \
	fi
	@EXTRA_INSTALL_BINARIES@
	@echo "Installing pkg-config file to $(LIB_INSTALL_DIR)/pkgconfig/"
	@$(INSTALL_DATA_DIR) "$(LIB_INSTALL_DIR)/pkgconfig"
	@$(INSTALL_DATA) tcl.pc "$(LIB_INSTALL_DIR)/pkgconfig/tcl.pc"
	@mkdir -p $(LIB_INSTALL_DIR)/pkgconfig
	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc

install-libraries-zipfs-shared: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)"; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
	    fi; \
	done
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
	@for i in $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	done

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

install-libraries: libraries
	@for i in "$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \
install-libraries: libraries $(INSTALL_TZDATA) install-msgs
	@for i in "$(INCLUDE_INSTALL_DIR)" "$(SCRIPT_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
	    fi; \
	done
	@for i in opt0.4 cookiejar0.2 encoding; do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \
		fi; \
	    done;
	@for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5; \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in 9.0 9.0/platform; \
	@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
		$(GENERIC_DIR)/tclPlatDecls.h \
		$(GENERIC_DIR)/tclTomMath.h \
		$(GENERIC_DIR)/tclTomMathDecls.h ; \
	    do \
	    $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
	    done;
	    if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \
		$(INSTALL_DATA_DIR) "$(MODULE_INSTALL_DIR)/$$i"; \
	    fi; \
	done
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
		$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \
		$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	done
	@echo "Installing package cookiejar 0.2 files to $(SCRIPT_INSTALL_DIR)/cookiejar0.2/"
	@for i in $(TOP_DIR)/library/cookiejar/*.tcl; do \
	    done;
	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	done
	    do \
	@for i in $(TOP_DIR)/library/cookiejar/*.gz; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	done
	@echo "Installing package http 2.10.0a1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
	    done;
	@echo "Installing package http 2.7.15 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.15.tm;
		"$(MODULE_INSTALL_DIR)/9.0/http-2.10.0a1.tm"
	@echo "Installing package opt 0.4.7"
	@for i in $(TOP_DIR)/library/opt/*.tcl; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	done
	@echo "Installing package msgcat 1.7.1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
	@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.5.2 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.5.2.tm;
		"$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm"
	@echo "Installing package tcltest 2.5.3 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.3.tm"
	@echo "Installing package platform 1.0.14 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
	@echo "Installing package tcltest 2.5.3 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.3.tm;

	@echo "Installing package platform 1.0.18 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.18.tm;
		"$(MODULE_INSTALL_DIR)/9.0/platform-1.0.14.tm"
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \
		"$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm"
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"
	@for i in $(TOP_DIR)/library/encoding/*.enc; do \
		$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/encoding"; \
	done
	@if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \
	    echo "Customizing tcl module path"; \
	    echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+
+



+



-
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
+



-
+



-
+





-
+



-
+



-
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-







	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \
	done
	@echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/";
	@for i in $(TOP_DIR)/doc/*.n; do \
	    $(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \
	done

# Public headers that define Tcl's API
TCL_PUBLIC_HEADERS = $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
	$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
	$(GENERIC_DIR)/tclPlatDecls.h $(GENERIC_DIR)/tclTomMath.h \
	$(GENERIC_DIR)/tclTomMathDecls.h
# Private headers that define Tcl's internal API
TCL_PRIVATE_HEADERS = $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
	$(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
	$(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
	$(UNIX_DIR)/tclUnixPort.h
# Any other headers you find in the Tcl sources are purely part of Tcl's
# implementation, and aren't to be installed.

install-headers:
	@for i in "$(INCLUDE_INSTALL_DIR)"; do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
	    fi; \
	done
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in $(TCL_PUBLIC_HEADERS); do \
	    $(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
	done

# Optional target to install private headers
install-private-headers:
	@for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; do \
install-private-headers: libraries
	@for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(INSTALL_DATA_DIR) "$$i"; \
		else true; \
	    fi; \
	done
	@echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/";
	@for i in $(TCL_PRIVATE_HEADERS); do \
	@for i in $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
		$(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
		$(UNIX_DIR)/tclUnixPort.h; \
	    do \
	    $(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	done
	@if test -f tclConfig.h; then\
	    $(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	fi

Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
	$(SHELL) config.status
#tclConfig.h: $(UNIX_DIR)/tclConfig.h.in
#	$(SHELL) config.status

clean:
	rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
		errors ${TCL_EXE} tcltest@EXEEXT@ lib.exp Tcl @DTRACE_HDR@ \
		*.zip *.vfs
	cd dltest ; $(MAKE) clean

distclean: clean
	rm -rf Makefile config.status config.cache config.log tclConfig.sh \
		$(PACKAGE).* prototype tclConfig.h *.plist Tcl.framework \
		tcl.pc
	cd dltest ; $(MAKE) distclean

depend:
	makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)

#--------------------------------------------------------------------------
# Rules for how to compile C files
#--------------------------------------------------------------------------

# Test binaries. The rules for tclTestInit.o and xtTestInit.o are complicated
# because they are compiled from tclAppInit.c. Can't use the "-o" option
# because this doesn't work on some strange compilers (e.g. UnixWare).
#
# To enable concurrent parallel make of tclsh and tcltest resp xttest, these
# targets have to depend on tclsh, this ensures that linking of tclsh with
# tclAppInit.o does not execute concurrently with the renaming and recompiling
# of that same object file in the targets below.

tclTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi
	fi;
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST $(UNIX_DIR)/tclAppInit.c
	@rm -f tclTestInit.o
	rm -f tclTestInit.o
	mv tclAppInit.o tclTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi
	fi;

xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
	@if test -f tclAppInit.o ; then \
	    rm -f tclAppInit.sav; \
	    mv tclAppInit.o tclAppInit.sav; \
	fi
	fi;
	$(CC) -c $(APP_CC_SWITCHES) \
		-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
		-DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
	@rm -f xtTestInit.o
	rm -f xtTestInit.o
	mv tclAppInit.o xtTestInit.o
	@if test -f tclAppInit.sav ; then \
	    mv tclAppInit.sav tclAppInit.o; \
	fi
	fi;

# Object files used on all Unix systems:

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)/tclTomMath.h $(GENERIC_DIR)/tclTomMathDecls.h
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
TRIMHDR		= $(GENERIC_DIR)/tclStringTrim.h

TCL_LOCATIONS	= -DTCL_LIBRARY="\"${TCL_LIBRARY}\"" \
	-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""

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

regexec.o: $(REGHDRS) $(GENERIC_DIR)/regexec.c $(GENERIC_DIR)/rege_dfa.c
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
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







-
-
-



-
+

















-
+








-
-
-
-
-
-












-
-
-



-
-
-






-
+








tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
	$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c

tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c

tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c

tclAsync.o: $(GENERIC_DIR)/tclAsync.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c

tclBasic.o: $(GENERIC_DIR)/tclBasic.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR)
tclBasic.o: $(GENERIC_DIR)/tclBasic.c $(COMPILEHDR) $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBasic.c

tclBinary.o: $(GENERIC_DIR)/tclBinary.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclBinary.c

tclCkalloc.o: $(GENERIC_DIR)/tclCkalloc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCkalloc.c

tclClock.o: $(GENERIC_DIR)/tclClock.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclClock.c

tclCmdAH.o: $(GENERIC_DIR)/tclCmdAH.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdAH.c

tclCmdIL.o: $(GENERIC_DIR)/tclCmdIL.c $(TCLREHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdIL.c

tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS) $(TRIMHDR)
tclCmdMZ.o: $(GENERIC_DIR)/tclCmdMZ.c $(TCLREHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCmdMZ.c

tclDate.o: $(GENERIC_DIR)/tclDate.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDate.c

tclCompCmds.o: $(GENERIC_DIR)/tclCompCmds.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmds.c

tclCompCmdsGR.o: $(GENERIC_DIR)/tclCompCmdsGR.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsGR.c

tclCompCmdsSZ.o: $(GENERIC_DIR)/tclCompCmdsSZ.c $(COMPILEHDR) $(TRIMHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompCmdsSZ.c

tclCompExpr.o: $(GENERIC_DIR)/tclCompExpr.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompExpr.c

tclCompile.o: $(GENERIC_DIR)/tclCompile.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclCompile.c

tclConfig.o: $(GENERIC_DIR)/tclConfig.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclConfig.c

tclDictObj.o: $(GENERIC_DIR)/tclDictObj.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDictObj.c

tclDisassemble.o: $(GENERIC_DIR)/tclDisassemble.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDisassemble.c

tclEncoding.o: $(GENERIC_DIR)/tclEncoding.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEncoding.c

tclEnsemble.o: $(GENERIC_DIR)/tclEnsemble.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnsemble.c

tclEnv.o: $(GENERIC_DIR)/tclEnv.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEnv.c

tclEvent.o: $(GENERIC_DIR)/tclEvent.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEvent.c

tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR)
tclExecute.o: $(GENERIC_DIR)/tclExecute.c $(COMPILEHDR) $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclExecute.c

tclFCmd.o: $(GENERIC_DIR)/tclFCmd.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFCmd.c

tclFileName.o: $(GENERIC_DIR)/tclFileName.c $(FSHDR) $(TCLREHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclFileName.c
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
1385
1386
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







-
-
-












-
-
-








tclIOUtil.o: $(GENERIC_DIR)/tclIOUtil.c $(FSHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIOUtil.c

tclIORChan.o: $(GENERIC_DIR)/tclIORChan.c $(IOHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIORChan.c

tclIORTrans.o: $(GENERIC_DIR)/tclIORTrans.c $(IOHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclIORTrans.c

tclLink.o: $(GENERIC_DIR)/tclLink.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLink.c

tclListObj.o: $(GENERIC_DIR)/tclListObj.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclListObj.c

tclLiteral.o: $(GENERIC_DIR)/tclLiteral.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLiteral.c

tclObj.o: $(GENERIC_DIR)/tclObj.c $(COMPILEHDR) $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclObj.c

tclOptimize.o: $(GENERIC_DIR)/tclOptimize.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOptimize.c

tclLoad.o: $(GENERIC_DIR)/tclLoad.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclLoad.c

tclLoadAix.o: $(UNIX_DIR)/tclLoadAix.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadAix.c

tclLoadDl.o: $(UNIX_DIR)/tclLoadDl.c
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
1439
1440
1441
1442
1443
1444
1111
1112
1113
1114
1115
1116
1117

1118
1119
1120
1121
1122
1123






















1124
1125
1126
1127
1128
1129
1130
1131







-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+








tclLoadShl.o: $(UNIX_DIR)/tclLoadShl.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclLoadShl.c

tclMain.o: $(GENERIC_DIR)/tclMain.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclMain.c

tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(COMPILEHDR)
tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNamesp.c

tclNotify.o: $(GENERIC_DIR)/tclNotify.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c

tclOO.o: $(GENERIC_DIR)/tclOO.c $(GENERIC_DIR)/tclOOScript.h
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c

tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOBasic.c

tclOOCall.o: $(GENERIC_DIR)/tclOOCall.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOCall.c

tclOODefineCmds.o: $(GENERIC_DIR)/tclOODefineCmds.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOODefineCmds.c

tclOOInfo.o: $(GENERIC_DIR)/tclOOInfo.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOOInfo.c

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)
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
1454
1455
1456
1457
1458
1459
1460
1461

1462
1463
1464
1465
1466

1467
1468
1469
1470
1471
1472
1473

1474
1475
1476
1477
1478
1479
1480
1481
1482

1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
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







-
+





+





-
-
+








-
+


-
-
-







# 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) \
	$(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)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		-DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		\
		$(GENERIC_DIR)/tclPkgConfig.c

tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPosixStr.c

tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPreserve.c

tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(NREHDR)
tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c

tclProcess.o: $(GENERIC_DIR)/tclProcess.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProcess.c

tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c $(TCLREHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclRegexp.c

tclResolve.o: $(GENERIC_DIR)/tclResolve.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclResolve.c

tclResult.o: $(GENERIC_DIR)/tclResult.c
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
1531
1532
1533
1534
1535
1536
1537
1538
1539
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203
1204












1205
1206
1207
1208
1209
1210
1211







-
+








-
-
-
-
-
-
-
-
-
-
-
-








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) $(TRIMHDR)
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 $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c

tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
	$(CC) -c $(CC_SWITCHES) \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
		-I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \
		$(GENERIC_DIR)/tclZipfs.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

tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
1556
1557
1558
1559
1560
1561
1562



1563
1564


1565
1566
1567


1568
1569
1570


1571
1572
1573
1574
1575
1576
1577
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







+
+
+
-
-
+
+

-
-
+
+

-
-
+
+








tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c

tclTomMathInterface.o: $(GENERIC_DIR)/tclTomMathInterface.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTomMathInterface.c

bncore.o: $(TOMMATH_DIR)/bncore.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bncore.c

bn_s_mp_reverse.o: $(TOMMATH_DIR)/bn_s_mp_reverse.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_reverse.c
bn_reverse.o: $(TOMMATH_DIR)/bn_reverse.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_reverse.c

bn_s_mp_mul_digs_fast.o: $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_mul_digs_fast.c
bn_fast_s_mp_mul_digs.o: $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c

bn_s_mp_sqr_fast.o: $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_sqr_fast.c
bn_fast_s_mp_sqr.o: $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c

bn_mp_add.o: $(TOMMATH_DIR)/bn_mp_add.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_add.c

bn_mp_add_d.o: $(TOMMATH_DIR)/bn_mp_add_d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_add_d.c

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
1668
1669
1670
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







-
-
+
+
-
-
-










-
-
-





+
+
+




-
-
-
-
-
+
+

-
-
+
+
-
-
-








bn_mp_div_3.o: $(TOMMATH_DIR)/bn_mp_div_3.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_3.c

bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_exch.c

bn_mp_expt_u32.o: $(TOMMATH_DIR)/bn_mp_expt_u32.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_u32.c
bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d.c

bn_mp_get_mag_u64.o: $(TOMMATH_DIR)/bn_mp_get_mag_u64.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_mag_u64.c

bn_mp_grow.o: $(TOMMATH_DIR)/bn_mp_grow.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_grow.c

bn_mp_init.o: $(TOMMATH_DIR)/bn_mp_init.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init.c

bn_mp_init_copy.o: $(TOMMATH_DIR)/bn_mp_init_copy.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_copy.c

bn_mp_init_i64.o:$(TOMMATH_DIR)/bn_mp_init_i64.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_i64.c

bn_mp_init_multi.o: $(TOMMATH_DIR)/bn_mp_init_multi.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_multi.c

bn_mp_init_set.o: $(TOMMATH_DIR)/bn_mp_init_set.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set.c

bn_mp_init_set_int.o: $(TOMMATH_DIR)/bn_mp_init_set_int.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set_int.c

bn_mp_init_size.o:$(TOMMATH_DIR)/bn_mp_init_size.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_size.c

bn_mp_init_u64.o:$(TOMMATH_DIR)/bn_mp_init_u64.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_u64.c

bn_s_mp_karatsuba_mul.o: $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_karatsuba_mul.c
bn_mp_karatsuba_mul.o: $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c

bn_s_mp_karatsuba_sqr.o: $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_karatsuba_sqr.c
bn_mp_karatsuba_sqr.o: $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c

bn_s_mp_balance_mul.o: $(TOMMATH_DIR)/bn_s_mp_balance_mul.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_balance_mul.c

bn_mp_lshd.o: $(TOMMATH_DIR)/bn_mp_lshd.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_lshd.c

bn_mp_mod.o: $(TOMMATH_DIR)/bn_mp_mod.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mod.c

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
1363
1364
1365
1366
1367
1368
1369


1370
1371
1372


1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390


1391
1392
1393


1394
1395
1396


1397
1398
1399


1400
1401
1402


1403
1404
1405


1406
1407
1408
1409
1410
1411
1412
1413
1414







-
-
+
+

-
-
+
+
















-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+

-
-
+
+








bn_mp_read_radix.o: $(TOMMATH_DIR)/bn_mp_read_radix.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_read_radix.c

bn_mp_rshd.o: $(TOMMATH_DIR)/bn_mp_rshd.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_rshd.c

bn_mp_set_i64.o: $(TOMMATH_DIR)/bn_mp_set_i64.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_i64.c
bn_mp_set.o: $(TOMMATH_DIR)/bn_mp_set.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set.c

bn_mp_set_u64.o: $(TOMMATH_DIR)/bn_mp_set_u64.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_u64.c
bn_mp_set_int.o: $(TOMMATH_DIR)/bn_mp_set_int.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_int.c

bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_shrink.c

bn_mp_sqr.o: $(TOMMATH_DIR)/bn_mp_sqr.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqr.c

bn_mp_sqrt.o: $(TOMMATH_DIR)/bn_mp_sqrt.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqrt.c

bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c

bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c

bn_mp_signed_rsh.o: $(TOMMATH_DIR)/bn_mp_signed_rsh.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_signed_rsh.c
bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c

bn_mp_to_ubin.o: $(TOMMATH_DIR)/bn_mp_to_ubin.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_ubin.c
bn_mp_to_unsigned_bin_n.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c

bn_s_mp_toom_mul.o: $(TOMMATH_DIR)/bn_s_mp_toom_mul.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_toom_mul.c
bn_mp_toom_mul.o: $(TOMMATH_DIR)/bn_mp_toom_mul.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toom_mul.c

bn_s_mp_toom_sqr.o: $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_toom_sqr.c
bn_mp_toom_sqr.o: $(TOMMATH_DIR)/bn_mp_toom_sqr.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toom_sqr.c

bn_mp_to_radix.o: $(TOMMATH_DIR)/bn_mp_to_radix.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_radix.c
bn_mp_toradix_n.o: $(TOMMATH_DIR)/bn_mp_toradix_n.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toradix_n.c

bn_mp_ubin_size.o: $(TOMMATH_DIR)/bn_mp_ubin_size.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_ubin_size.c
bn_mp_unsigned_bin_size.o: $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c

bn_mp_xor.o: $(TOMMATH_DIR)/bn_mp_xor.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_xor.c

bn_mp_zero.o: $(TOMMATH_DIR)/bn_mp_zero.c $(MATHHDRS)
	$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_zero.c

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
1432
1433
1434
1435
1436
1437
1438


1439
1440






1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459

1460
1461
1462
1463
1464
1465
1466
1467







-
-
+
+
-
-
-
-
-
-

















+
+
-
+








tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFCmd.c

tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c $(FSHDR)
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c

tclEpollNotfy.o: $(UNIX_DIR)/tclEpollNotfy.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclEpollNotfy.c
tclUnixNotfy.o: $(UNIX_DIR)/tclUnixNotfy.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixNotfy.c

tclKqueueNotfy.o: $(UNIX_DIR)/tclKqueueNotfy.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclKqueueNotfy.c

tclSelectNotfy.o: $(UNIX_DIR)/tclSelectNotfy.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclSelectNotfy.c

tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixPipe.c

tclUnixSock.o: $(UNIX_DIR)/tclUnixSock.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixSock.c

tclUnixTest.o: $(UNIX_DIR)/tclUnixTest.c
	$(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclUnixTest.c

tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixThrd.c

tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c

tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
	$(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \
		-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \
	$(CC) -c $(CC_SWITCHES) $(TCL_LOCATIONS) $(UNIX_DIR)/tclUnixInit.c
		$(UNIX_DIR)/tclUnixInit.c

tclUnixCompat.o: $(UNIX_DIR)/tclUnixCompat.c
	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixCompat.c

# The following are Mac OS X only sources:
tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c
	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c
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
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
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
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542



























1543
1544
1545
1546
1547
1548
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







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
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
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
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
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







-
-
-
+
+
+
+

















+
+
+



-
-
-









+
+
+









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
-
-
-
-
-
-

-
+


-
-
-
-
-
-









-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-









-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-







-
+



















-

-
+



-
-
-
-
+
+
+
-
-
+


-
-
-
+
+
+






-
-
-
-
-
-
-


-
-





-
+
-

-
-
-
-
-
+
+
+
+
+
+

-
+
-
-
+


+
-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
+
+
-

+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+

-
+
+


-
-
+
+

-
-
+
+

-
-
-
-
-
-
-
-
+
+
+


-
-
-
-
+
+
+
+



-
-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

+
-
+

-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-



-
-
-
+
+
-




-
+

-
-
-
-
-
-
-
-


-
+


-
-
+


-
-
+




+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








#--------------------------------------------------------------------------
# The following targets are not completely general. They are provide purely
# for documentation purposes so people who are interested in the Xt based
# notifier can modify them to suit their own installation.
#--------------------------------------------------------------------------

xttest:	${XTTEST_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE} ${BUILD_DLTEST}
	${CC} ${CFLAGS} ${LDFLAGS} ${XTTEST_OBJS} \
		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
xttest:	${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
	@DL_OBJS@ ${BUILD_DLTEST}
	${CC} ${XTTEST_OBJS} ${GENERIC_OBJS} ${UNIX_OBJS} ${COMPAT_OBJS} \
		@DL_OBJS@ @TCL_BUILD_LIB_SPEC@ ${LIBS} \
		${CC_SEARCH_FLAGS} -L/usr/openwin/lib -lXt -o xttest

tclXtNotify.o: $(UNIX_DIR)/tclXtNotify.c
	$(CC) -c $(APP_CC_SWITCHES) -I/usr/openwin/include \
		$(UNIX_DIR)/tclXtNotify.c

tclXtTest.o: $(UNIX_DIR)/tclXtTest.c
	$(CC) -c $(APP_CC_SWITCHES) -I/usr/openwin/include \
		$(UNIX_DIR)/tclXtTest.c

#--------------------------------------------------------------------------
# Compat binaries, these must be compiled for use in a shared library even
# though they may be placed in a static executable or library. Since they are
# included in both the tcl library and the stub library, they need to be
# relocatable.
#--------------------------------------------------------------------------

fixstrtod.o: $(COMPAT_DIR)/fixstrtod.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fixstrtod.c

opendir.o: $(COMPAT_DIR)/opendir.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/opendir.c

mkstemp.o: $(COMPAT_DIR)/mkstemp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/mkstemp.c

memcmp.o: $(COMPAT_DIR)/memcmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/memcmp.c

strncasecmp.o: $(COMPAT_DIR)/strncasecmp.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strncasecmp.c

strstr.o: $(COMPAT_DIR)/strstr.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strstr.c

strtod.o: $(COMPAT_DIR)/strtod.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtod.c

strtol.o: $(COMPAT_DIR)/strtol.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtol.c

strtoul.o: $(COMPAT_DIR)/strtoul.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/strtoul.c

waitpid.o: $(COMPAT_DIR)/waitpid.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/waitpid.c

fake-rfc2553.o: $(COMPAT_DIR)/fake-rfc2553.c
	$(CC) -c $(STUB_CC_SWITCHES) $(COMPAT_DIR)/fake-rfc2553.c

# For building zlib, only used in some build configurations
Zadler32.o: $(ZLIB_DIR)/adler32.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/adler32.c
Zcompress.o: $(ZLIB_DIR)/compress.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/compress.c
Zcrc32.o:    $(ZLIB_DIR)/crc32.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/crc32.c
Zdeflate.o:  $(ZLIB_DIR)/deflate.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/deflate.c
Zinfback.o:  $(ZLIB_DIR)/infback.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/infback.c
Zinffast.o:  $(ZLIB_DIR)/inffast.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/inffast.c
Zinflate.o:  $(ZLIB_DIR)/inflate.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/inflate.c
Zinftrees.o: $(ZLIB_DIR)/inftrees.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/inftrees.c
Ztrees.o:    $(ZLIB_DIR)/trees.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/trees.c
Zuncompr.o:  $(ZLIB_DIR)/uncompr.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/uncompr.c
Zzutil.o:    $(ZLIB_DIR)/zutil.c
	$(CC) -c -o $@ $(CC_SWITCHES) -I$(ZLIB_DIR) $(ZLIB_DIR)/zutil.c

#--------------------------------------------------------------------------
# Stub library binaries, these must be compiled for use in a shared library
# even though they will be placed in a static archive
#--------------------------------------------------------------------------

tclStubLib.o: $(GENERIC_DIR)/tclStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) -DSTATIC_BUILD $(GENERIC_DIR)/tclStubLib.c

tclTomMathStubLib.o: $(GENERIC_DIR)/tclTomMathStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclTomMathStubLib.c

tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c
	$(CC) -c $(STUB_CC_SWITCHES) $(GENERIC_DIR)/tclOOStubLib.c

.c.o:
	$(CC) -c $(CC_SWITCHES) $<

#--------------------------------------------------------------------------
# Minizip implementation
#--------------------------------------------------------------------------
adler32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c

compress.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c

crc32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c

deflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c

ioapi.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/ioapi.c

infback.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c

inffast.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c

inflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c

inftrees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c

trees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c

uncompr.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c

zip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/zip.c

zutil.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c

minizip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
		$(ZLIB_DIR)/contrib/minizip/minizip.c

minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
	$(HOST_CC) -o $@ $(MINIZIP_OBJS)

#--------------------------------------------------------------------------
# Bundled Package targets
#--------------------------------------------------------------------------

# Propagate configure args like --enable-64bit to package configure
PKG_CFG_ARGS		= @PKG_CFG_ARGS@
# If PKG_DIR is changed to a different relative depth to the build dir, need
# to adapt the ../.. relative paths below and at the top of configure.ac (we
# cannot use absolute paths due to issues in nested configure when path to
# build dir contains spaces).
PKG_DIR			= ./pkgs

configure-packages:
	@for i in $(PKGS_DIR)/*; do \
	    if [ -d $$i ] ; then \
		if [ -x $$i/configure ] ; then \
		    pkg=`basename $$i`; \
		    echo "Configuring package '$$pkg'"; \
		    mkdir -p $(PKG_DIR)/$$pkg; \
		    if [ ! -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
			( cd $(PKG_DIR)/$$pkg; \
			  $$i/configure --with-tcl=../.. \
			      --with-tclinclude=$(GENERIC_DIR) \
			      $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
			      --enable-shared; ) || exit $$?; \
		    fi; \
		fi; \
	    fi; \
	done

packages: configure-packages ${STUB_LIB_FILE}
	@for i in $(PKGS_DIR)/*; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Building package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
		fi; \
	    fi; \
	done

install-packages: packages
	@for i in $(PKGS_DIR)/*; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Installing package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
			  "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
		fi; \
	    fi; \
	done

test-packages: ${TCLTEST_EXE} packages
	@for i in $(PKGS_DIR)/*; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    echo "Testing package '$$pkg'"; \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
			  "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
			  "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
			  "TCLLIBPATH=../../pkgs" test \
			  "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \
		fi; \
	    fi; \
	done

clean-packages:
	@for i in $(PKGS_DIR)/*; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
		fi; \
	    fi; \
	done

distclean-packages:
	@for i in $(PKGS_DIR)/*; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
		fi; \
		rm -rf $(PKG_DIR)/$$pkg; \
	    fi; \
	done; \
	rm -rf $(PKG_DIR)

dist-packages: configure-packages
	@rm -rf $(DISTROOT)/pkgs; \
	mkdir -p $(DISTROOT)/pkgs; \
	for i in $(PKGS_DIR)/*; do \
	    if [ -d $$i ] ; then \
		pkg=`basename $$i`; \
		if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
		    ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
			  "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
		fi; \
	    fi; \
	done

#--------------------------------------------------------------------------
# Maintainer-only targets
#--------------------------------------------------------------------------

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
		--no-lines \
		--name-prefix=TclDate \
		$(GENERIC_DIR)/tclGetDate.y

#	yacc -l $(GENERIC_DIR)/tclGetDate.y
#	sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
#	    -e 's?SCCSID?RCS: @(#) ?' \
#	    -e '/#ifdef __STDC__/,/#endif/d' -e '/TclDateerrlab:/d' \
#	    -e '/TclDatenewstate:/d' -e '/#pragma/d' \
#	    -e '/#include <inttypes.h>/d' \
#           -e '/#define YYNEW/s/malloc/TclDateAlloc/g' \
#	    -e '/#define YYENLARGE/,/realloc/s/realloc/TclDateRealloc/g' \
#	    <y.tab.c >$(GENERIC_DIR)/tclDate.c
#	rm y.tab.c

#
# Target to regenerate header files and stub files from the *.decls tables.
#

$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
		$(GENERIC_DIR)/tclInt.decls $(GENERIC_DIR)/tclTomMath.decls
	@echo "Warning: tclStubInit.c may be out of date."
	@echo "Developers may want to run \"make genstubs\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

$(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls
	@echo "Warning: tclOOStubInit.c may be out of date."
	@echo "Developers may want to run \"make genstubs\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

$(GENERIC_DIR)/tclOOScript.h: $(TOOL_DIR)/tclOOScript.tcl
	@echo "Warning: tclOOScript.h may be out of date."
	@echo "Developers may want to run \"make genscript\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

genstubs:
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
	$(TCL_EXE) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \
		$(GENERIC_DIR)/tclTomMath.decls
	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
		$(GENERIC_DIR)/tclOO.decls

genscript:
	$(NATIVE_TCLSH) $(TOOL_DIR)/makeHeader.tcl \
		$(TOOL_DIR)/tclOOScript.tcl $(GENERIC_DIR)/tclOOScript.h

#
# Target to check that all exported functions have an entry in the stubs
# tables.
#

checkstubs: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) \
		| awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \
		| sort -n` ; do \
	    match=0; \
	    for j in $(TCL_DECLS); do \
		if [ `grep -c "$$i *(" $$j` -gt 0 ] ; then \
		    match=1; \
		fi; \
	    done; \
	    if [ $$match -eq 0 ] ; then \
		| sort -n`; do \
		match=0; \
		for j in $(TCL_DECLS); do \
		    if [ `grep -c "$$i *(" $$j` -gt 0 ]; then \
			match=1; \
		    fi; \
		done; \
		if [ $$match -eq 0 ]; then echo $$i; fi \
		echo $$i; \
	    fi; \
	done

#
# Target to check that all public APIs which are not command implementations
# have an entry in section three of the distributed manpages.
#

checkdoc: $(TCL_LIB_FILE)
	-@for i in `nm -p $(TCL_LIB_FILE) | awk '$$3 ~ /Tcl_/ { print $$3 }' \
		| grep -Fv . | grep -v 'Cmd$$' | sort -n`; do \
	    match=0; \
		| grep -v 'Cmd$$' | sort -n`; do \
		match=0; \
	    i=`echo $$i | sed 's/^_//'`; \
	    for j in $(TOP_DIR)/doc/*.3; do \
		if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \
		    match=1; \
		fi; \
	    done; \
	    if [ $$match -eq 0 ]; then \
		for j in $(TOP_DIR)/doc/*.3; do \
		    if [ `grep '\-' $$j | grep -c $$i` -gt 0 ]; then \
			match=1; \
		    fi; \
		done; \
		if [ $$match -eq 0 ]; then echo $$i; fi \
		echo $$i; \
	    fi; \
	done

#
# Target to check for proper usage of UCHAR macro.
#

checkuchar:
	-@egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR
	-egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR

#
# Target to make sure that only symbols with "Tcl" prefixes are exported.
#

checkexports: $(TCL_LIB_FILE)
	-@nm -p $(TCL_LIB_FILE) \
	| awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \
	| sort -n | grep -E -v '^[Tt]cl' || true

#--------------------------------------------------------------------------
# Distribution building rules
#--------------------------------------------------------------------------

#
# Target to create a Tcl RPM for Linux. Requires that you be on a Linux
# system.
#

RPM_PLATFORMS = i386
rpm: all
	-@rm -f THIS.TCL.SPEC
	rm -f THIS.TCL.SPEC
	echo "%define _builddir `pwd`" > THIS.TCL.SPEC
	echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
	cat tcl.spec >> THIS.TCL.SPEC
	for platform in $(RPM_PLATFORMS); do \
	    mkdir -p RPMS/$$platform && \
	    rpmbuild -bb THIS.TCL.SPEC && \
	    mv RPMS/$$platform/*.rpm .; \
	mkdir -p RPMS/i386
	rpmbuild -bb THIS.TCL.SPEC
	mv RPMS/i386/*.rpm .
	done
	-rm -rf RPMS THIS.TCL.SPEC
	rm -rf RPMS THIS.TCL.SPEC

#
# Target to create a proper Tcl distribution from information in the
# source directory. DISTDIR must be defined to indicate where to put
# the distribution. DISTDIR must be an absolute path name.
# Target to create a proper Tcl distribution from information in the master
# source directory. DISTDIR must be defined to indicate where to put the
# distribution. DISTDIR must be an absolute path name.
#

DISTROOT = /tmp/dist
DISTNAME = tcl${VERSION}${PATCH_LEVEL}
ZIPNAME	 = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip
DISTDIR	 = $(DISTROOT)/$(DISTNAME)
DIST_INSTALL_DATA   = CPPROG='cp -p' $(INSTALL) -m 644
DIST_INSTALL_SCRIPT = CPPROG='cp -p' $(INSTALL) -m 755
BUILTIN_PACKAGE_LIST = cookiejar http opt msgcat reg dde tcltest platform

$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \
		$(UNIX_DIR)/aclocal.m4
	cd $(UNIX_DIR); autoconf
$(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
	cd $(MAC_OSX_DIR); autoconf
$(UNIX_DIR)/tclConfig.h.in: $(MAC_OSX_DIR)/configure
	cd $(MAC_OSX_DIR); autoheader; touch $@

$(TOP_DIR)/manifest.uuid:
	printf "git." >$(TOP_DIR)/manifest.uuid
	git rev-parse HEAD >>$(TOP_DIR)/manifest.uuid

dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in genstubs \
dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid genstubs
		$(MAC_OSX_DIR)/configure $(TOP_DIR)/manifest.uuid dist-packages ${NATIVE_TCLSH}
	rm -rf $(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/unix
	$(DIST_INSTALL_DATA) $(TOP_DIR)/manifest.uuid $(DISTDIR)
	$(DIST_INSTALL_DATA) $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
	$(DIST_INSTALL_DATA) $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
	$(DIST_INSTALL_DATA) $(UNIX_DIR)/configure.ac \
	mkdir -p $(DISTDIR)/unix
	cp -p $(TOP_DIR)/manifest.uuid $(DISTDIR)
	cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
	cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
	chmod 664 $(DISTDIR)/unix/Makefile.in
	cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
		$(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \
		$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \
		$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/install-sh \
		$(UNIX_DIR)/install-sh \
		$(UNIX_DIR)/README $(UNIX_DIR)/tcl.spec \
		$(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
		$(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \
		$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
	chmod 775 $(DISTDIR)/unix/configure
	$(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix
	$(INSTALL_DATA_DIR) $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	$(DIST_INSTALL_DATA) $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \
	chmod 775 $(DISTDIR)/unix/ldAix
	@mkdir $(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/*.decls $(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/README $(DISTDIR)/generic
	cp -p $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic
	cp -p $(TOP_DIR)/changes $(TOP_DIR)/ChangeLog $(TOP_DIR)/README.md \
		$(TOP_DIR)/ChangeLog.[12]??? $(TOP_DIR)/license.terms \
		$(DISTDIR)
	$(INSTALL_DATA_DIR) $(DISTDIR)/library
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
	@mkdir $(DISTDIR)/library
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
		$(TOP_DIR)/library/manifest.txt \
		$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
	for i in http1.0 http opt msgcat reg dde tcltest platform; \
	@for i in $(BUILTIN_PACKAGE_LIST); do \
	    $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\
	    $(DIST_INSTALL_DATA) $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	done
	    do \
		mkdir $(DISTDIR)/library/$$i ;\
		cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
	    done;
	$(DIST_INSTALL_DATA) $(TOP_DIR)/library/cookiejar/*.txt.gz $(DISTDIR)/library/cookiejar
	$(INSTALL_DATA_DIR) $(DISTDIR)/library/encoding
	$(DIST_INSTALL_DATA) $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
	$(INSTALL_DATA_DIR) $(DISTDIR)/library/msgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs
	@mkdir $(DISTDIR)/library/encoding
	cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
	@mkdir $(DISTDIR)/library/msgs
	cp -p $(TOP_DIR)/library/msgs/*.msg $(DISTDIR)/library/msgs
	@echo cp -r $(TOP_DIR)/library/tzdata $(DISTDIR)/library/tzdata
	@( cd $(TOP_DIR); find library/tzdata -type f -print ) \
	@( cd $(TOP_DIR); \
	  find library/tzdata -name CVS -prune -o -type f -print ) \
	    | ( cd $(TOP_DIR) ; xargs tar cf - ) \
	    | ( cd $(DISTDIR) ; tar xfp - )
	$(INSTALL_DATA_DIR) $(DISTDIR)/doc
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
	@mkdir $(DISTDIR)/doc
	cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/doc/*.[13n] \
		$(TOP_DIR)/doc/man.macros $(DISTDIR)/doc
	$(INSTALL_DATA_DIR) $(DISTDIR)/compat
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \
	@mkdir $(DISTDIR)/compat
	cp -p $(TOP_DIR)/license.terms $(COMPAT_DIR)/*.[ch] \
		$(COMPAT_DIR)/README $(DISTDIR)/compat
	$(INSTALL_DATA_DIR) $(DISTDIR)/compat/zlib
	@echo cp -r $(COMPAT_DIR)/zlib $(DISTDIR)/compat/zlib
	@( cd $(COMPAT_DIR)/zlib; find . -type f -print ) \
	    | ( cd $(COMPAT_DIR)/zlib ; xargs tar cf - ) \
	    | ( cd $(DISTDIR)/compat/zlib ; tar xfp - )
	$(INSTALL_DATA_DIR) $(DISTDIR)/tests
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/tests
	$(DIST_INSTALL_DATA) $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
	@mkdir $(DISTDIR)/tests
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/tests
	cp -p $(TOP_DIR)/tests/*.test $(TOP_DIR)/tests/README \
		$(TOP_DIR)/tests/httpd $(TOP_DIR)/tests/*.tcl \
		$(DISTDIR)/tests
	$(INSTALL_DATA_DIR) $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/configure.ac \
		$(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \
	@mkdir $(DISTDIR)/win
	cp $(TOP_DIR)/win/Makefile.in $(DISTDIR)/win
	cp $(TOP_DIR)/win/configure.in $(TOP_DIR)/win/configure \
		$(TOP_DIR)/win/tclConfig.sh.in \
		$(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
		$(TOP_DIR)/win/tclsh.exe.manifest.in \
		$(DISTDIR)/win
	$(DIST_INSTALL_SCRIPT) $(TOP_DIR)/win/configure $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
	cp -p $(TOP_DIR)/win/*.[ch] $(TOP_DIR)/win/*.ico $(TOP_DIR)/win/*.rc \
		$(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.bat $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/*.vc $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/win/README $(DISTDIR)/win
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/win
	$(INSTALL_DATA_DIR) $(DISTDIR)/macosx
	$(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \
	cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/makefile.* $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/rules.vc $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
	cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/win
	@mkdir $(DISTDIR)/macosx
	cp -p $(MAC_OSX_DIR)/GNUmakefile $(MAC_OSX_DIR)/README \
		$(MAC_OSX_DIR)/*.c $(MAC_OSX_DIR)/*.in \
		$(MAC_OSX_DIR)/*.ac $(MAC_OSX_DIR)/*.xcconfig \
		$(DISTDIR)/macosx
	$(DIST_INSTALL_SCRIPT) $(MAC_OSX_DIR)/configure $(DISTDIR)/macosx
	$(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(DISTDIR)/macosx
	$(INSTALL_DATA_DIR) $(DISTDIR)/macosx/Tcl.xcode
		$(MAC_OSX_DIR)/configure $(DISTDIR)/macosx
	cp -p $(TOP_DIR)/license.terms $(DISTDIR)/macosx
	@mkdir $(DISTDIR)/macosx/Tcl.pbproj
	$(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcode/project.pbxproj \
		$(MAC_OSX_DIR)/Tcl.xcode/default.pbxuser \
		$(DISTDIR)/macosx/Tcl.xcode
	cp -p $(MAC_OSX_DIR)/Tcl.pbproj/*.pbx* $(DISTDIR)/macosx/Tcl.pbproj
	@mkdir $(DISTDIR)/macosx/Tcl.xcode
	$(INSTALL_DATA_DIR) $(DISTDIR)/macosx/Tcl.xcodeproj
	$(DIST_INSTALL_DATA) $(MAC_OSX_DIR)/Tcl.xcodeproj/project.pbxproj \
		$(MAC_OSX_DIR)/Tcl.xcodeproj/default.pbxuser \
		$(DISTDIR)/macosx/Tcl.xcodeproj
	$(INSTALL_DATA_DIR) $(DISTDIR)/unix/dltest
	$(DIST_INSTALL_DATA) $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
		$(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest
	$(INSTALL_DATA_DIR) $(DISTDIR)/tools
	$(DIST_INSTALL_DATA) $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \
		$(TOOL_DIR)/configure $(TOOL_DIR)/configure.ac \
	cp -p $(MAC_OSX_DIR)/Tcl.xcode/*.pbx* $(DISTDIR)/macosx/Tcl.xcode
	@mkdir $(DISTDIR)/macosx/Tcl.xcodeproj
	cp -p $(TOP_DIR)/macosx/Tcl.xcodeproj/*.pbx* $(DISTDIR)/macosx/Tcl.xcodeproj
	@mkdir $(DISTDIR)/unix/dltest
	cp -p $(UNIX_DIR)/dltest/*.c $(UNIX_DIR)/dltest/Makefile.in \
		$(UNIX_DIR)/dltest/README \
		$(DISTDIR)/unix/dltest
	@mkdir $(DISTDIR)/tools
	cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \
		$(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \
		$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
		$(TOOL_DIR)/tcl.wse.in $(TOOL_DIR)/*.bmp \
		$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
		$(TOOL_DIR)/tcl.hpj.in \
		$(DISTDIR)/tools
	chmod 755 $(DISTDIR)/tools/checkLibraryDoc.tcl \
		$(DISTDIR)/tools/configure $(DISTDIR)/tools/findBadExternals.tcl \
		$(DISTDIR)/tools/loadICU.tcl \
		$(DISTDIR)/tools/makeTestCases.tcl $(DISTDIR)/tools/tclZIC.tcl \
		$(DISTDIR)/tools/tcltk-man2html.tcl
	$(INSTALL_DATA_DIR) $(DISTDIR)/libtommath
	$(DIST_INSTALL_DATA) $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h $(DISTDIR)/libtommath
	$(INSTALL_DATA_DIR) $(DISTDIR)/pkgs
	@mkdir $(DISTDIR)/libtommath
	cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \
		$(DISTDIR)/libtommath
	$(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs
	$(DIST_INSTALL_DATA) $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs
	for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \
	    tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
	done

alldist: dist
	rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)
	( cd $(DISTROOT); \
		tar cf $(DISTNAME)-src.tar $(DISTNAME); \
		gzip -9 $(DISTNAME)-src.tar; \
	cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \
		gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME)
		zip -qr8 $(ZIPNAME) $(DISTNAME) )

#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#
# Note that for platforms where this is important, it is more common to use a
# build of this HTML documentation that has already been placed online. As
# such, this rule is not guaranteed to work well on all systems; it only needs
# to function on those of the Tcl/Tk maintainers.
#
# Also note that the 8.6 tool build requires an installed 8.6 native Tcl
# interpreter in order to be able to run.
#--------------------------------------------------------------------------

html: ${NATIVE_TCLSH}
html: ${TCL_EXE}
	$(BUILD_HTML)
	@EXTRA_BUILD_HTML@

html-tcl: ${NATIVE_TCLSH}
html-tcl: ${TCL_EXE}
	$(BUILD_HTML) --tcl
	@EXTRA_BUILD_HTML@

html-tk: ${NATIVE_TCLSH}
html-tk: ${TCL_EXE}
	$(BUILD_HTML) --tk
	@EXTRA_BUILD_HTML@

BUILD_HTML = \
	@@LD_LIBRARY_PATH_VAR@="`pwd`:$${@LD_LIBRARY_PATH_VAR@}"; export @LD_LIBRARY_PATH_VAR@; \
	TCL_LIBRARY="${TCL_BUILDTIME_LIBRARY}"; export TCL_LIBRARY; \
	@${NATIVE_TCLSH} $(TOOL_DIR)/tcltk-man2html.tcl \
		--tcl --useversion=$(MAJOR_VERSION).$(MINOR_VERSION) --htmldir="$(HTML_INSTALL_DIR)" \
		--srcdir=$(TOP_DIR) $(BUILD_HTML_FLAGS)
	./${TCL_EXE} $(TOOL_DIR)/tcltk-man2html.tcl --htmldir="$(HTML_INSTALL_DIR)" \
		--srcdir=$(TOP_DIR)/.. $(BUILD_HTML_FLAGS)

#
# Targets to build Solaris package of the distribution for the current
# architecture. To build stream packages for both sun4 and i86pc
# architectures:
#
#   On the sun4 machine, execute the following:
#     make distclean; ./configure
#     make DISTDIR=<distdir> package
#
#   Once the build is complete, execute the following on the i86pc machine:
#     make DISTDIR=<distdir> package-quick
#
# <distdir> is the absolute path to a directory where the build should take
# place. These steps will generate the $(PACKAGE).sun4 and $(PACKAGE).i86pc
# stream packages. It is important that the packages be built in this fashion
# in order to ensure that the architecture independent files are exactly the
# same, including timestamps, in both packages.
#

PACKAGE=SCRPtcl

package: dist package-config package-common package-binaries package-generate
package-quick: package-config package-binaries package-generate

#
# Configure for the current architecture in the dist directory.
#
package-config:
	mkdir -p $(DISTDIR)/unix/`arch`
	cd $(DISTDIR)/unix/`arch`; \
        ../configure --prefix=/opt/$(PACKAGE)/$(VERSION) \
		--exec_prefix=/opt/$(PACKAGE)/$(VERSION)/`arch` \
		--enable-shared
	mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)
	mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`

#
# Build and install the architecture independent files in the dist directory.
#

package-common:
	cd $(DISTDIR)/unix/`arch`;\
	$(MAKE); \
	$(MAKE) prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION) \
		exec_prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch` \
		install-libraries install-man
	mkdir -p $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin
	sed -e "s/TCLVERSION/$(VERSION)/g" < $(UNIX_DIR)/tclsh.sh \
		> $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin/tclsh$(VERSION)
	chmod 755 $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin/tclsh$(VERSION)

#
# Build and install the architecture specific files in the dist directory.
#

package-binaries:
	cd $(DISTDIR)/unix/`arch`; \
	$(MAKE); \
	$(MAKE) install-binaries prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION) \
		exec_prefix=$(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`

#
# Generate a package from the installed files in the dist directory for the
# current architecture.
#

package-generate:
	pkgproto $(DISTDIR)/$(PACKAGE)/$(VERSION)/bin=bin \
		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/include=include \
		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/lib=lib \
		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/man=man \
		 $(DISTDIR)/$(PACKAGE)/$(VERSION)/`arch`=`arch` \
	| $(TCL_EXE) $(UNIX_DIR)/mkProto.tcl \
		$(VERSION) $(UNIX_DIR) > prototype
	pkgmk -o -d . -f prototype -a `arch`
	pkgtrans -s . $(PACKAGE).`arch` $(PACKAGE)
	rm -rf $(PACKAGE)

#--------------------------------------------------------------------------
# The list of all the targets that do not correspond to real files. This stops
# 'make' from getting confused when someone makes an error in a rule.
#--------------------------------------------------------------------------

.PHONY: all binaries libraries objs doc html html-tcl html-tk test runtest

Changes to unix/README.

41
42
43
44
45
46
47


48
49
50
51
52
53
54
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56







+
+







(c) Type "./configure". This runs a configuration script created by GNU
    autoconf, which configures Tcl for your system and creates a Makefile. The
    configure script allows you to customize the Tcl configuration for your
    site; for details on how you can do this, type "./configure --help" or
    refer to the autoconf documentation (not included here). Tcl's "configure"
    supports the following special switches in addition to the standard ones:

	--enable-threads	If this switch is set, Tcl will compile itself
				with multithreading support.
	--disable-load		If this switch is specified then Tcl will
				configure itself not to allow dynamic loading,
				even if your system appears to support it.
				Normally you can leave this switch out and Tcl
				will build itself for dynamic loading if your
				system supports it.
	--disable-dll-unloading	Disables support for the [unload] command even
87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
89
90
91
92
93
94
95

96
97
98
99
100
101
102
103







-
+







	--enable-man-compression=PROG
				Compress the manpages using PROG.
	--enable-dtrace		Enable tcl DTrace provider (if DTrace is
				available on the platform), c.f. tclDTrace.d
				for descriptions of the probes made available,
				see http://wiki.tcl.tk/DTrace for more details
	--with-encoding=ENCODING Specifies the encoding for compile-time
				configuration values. Defaults to utf-8,
				configuration values. Defaults to iso8859-1,
				which is also sufficient for ASCII.
	--with-tzdata=FLAG	Specifies whether to install timezone data. By
				default, the configure script tries to detect
				whether a usable timezone database is present
				on the system already.

    Mac OS X only (i.e. completely unsupported on other platforms):

Changes to unix/configure.

more than 10,000 changes

Deleted unix/configure.ac.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
1065
1066
1067
1068












































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

AC_INIT([tcl],[9.0])
AC_PREREQ(2.69)

dnl This is only used when included from macosx/configure.ac
m4_ifdef([SC_USE_CONFIG_HEADERS], [
    AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in])
    AC_CONFIG_COMMANDS_PRE([DEFS="-DHAVE_TCL_CONFIG_H  -imacros tclConfig.h"])
    AH_TOP([
    #ifndef _TCLCONFIG
    #define _TCLCONFIG])
    AH_BOTTOM([
    /* Undef unused package specific autoheader defines so that we can
     * include both tclConfig.h and tkConfig.h at the same time: */
    /* override */ #undef PACKAGE_NAME
    /* override */ #undef PACKAGE_STRING
    /* override */ #undef PACKAGE_TARNAME
    #endif /* _TCLCONFIG */])
])

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}

EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
EXTRA_BUILD_HTML=${EXTRA_BUILD_HTML:-"@:"}

#------------------------------------------------------------------------
# Setup configure arguments for bundled packages
#------------------------------------------------------------------------

PKG_CFG_ARGS="$ac_configure_args ${PKG_CFG_ARGS}"

if test -r "$cache_file" -a -f "$cache_file"; then
    case $cache_file in
	[[\\/]]* | ?:[[\\/]]* ) pkg_cache_file=$cache_file ;;
	*) pkg_cache_file=../../$cache_file ;;
    esac
    PKG_CFG_ARGS="${PKG_CFG_ARGS} --cache-file=$pkg_cache_file"
fi

#------------------------------------------------------------------------
# Empty slate for bundled packages, to avoid stale configuration
#------------------------------------------------------------------------
#rm -Rf pkgs
if test -f Makefile; then
    make distclean-packages
fi

#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix
fi
# Make sure srcdir is fully qualified!
srcdir="`cd "$srcdir" ; pwd`"
TCL_SRC_DIR="`cd "$srcdir"/..; pwd`"

#------------------------------------------------------------------------
# Compress and/or soft link the manpages?
#------------------------------------------------------------------------

SC_CONFIG_MANPAGES

#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------

# If the user did not set CFLAGS, set it now to keep
# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi

AC_PROG_CC
AC_C_INLINE


#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol or strtoul in some versions
#	  of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr
# Do this early, otherwise an autoconf bug throws errors on configure
#--------------------------------------------------------------------

SC_MISSING_POSIX_HEADERS

#--------------------------------------------------------------------
# Determines the correct executable file extension (.exe)
#--------------------------------------------------------------------

AC_EXEEXT

#------------------------------------------------------------------------
# If we're using GCC, see if the compiler understands -pipe.  If so, use it.
# It makes compiling go faster.  (This is only a performance feature.)
#------------------------------------------------------------------------

if test -z "$no_pipe" && test -n "$GCC"; then
    AC_CACHE_CHECK([if the compiler understands -pipe],
	tcl_cv_cc_pipe, [
	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe"
	AC_TRY_COMPILE(,, tcl_cv_cc_pipe=yes, tcl_cv_cc_pipe=no)
	CFLAGS=$hold_cflags])
    if test $tcl_cv_cc_pipe = yes; then
	CFLAGS="$CFLAGS -pipe"
    fi
fi

#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING

#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------

SC_TCL_LINK_LIBS

# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"

SC_ENABLE_SHARED

#--------------------------------------------------------------------
# Look for a native installed tclsh binary (if available)
# If one cannot be found then use the binary we build (fails for
# cross compiling). This is used for NATIVE_TCLSH in Makefile.
#--------------------------------------------------------------------

SC_PROG_TCLSH
if test "$TCLSH_PROG" = ""; then
  TCLSH_PROG='./${TCL_EXE}'
fi

#------------------------------------------------------------------------
#	Add stuff for zlib
#------------------------------------------------------------------------

zlib_ok=yes
AC_CHECK_HEADER([zlib.h],[
  AC_CHECK_TYPE([gz_header],[],[zlib_ok=no],[#include <zlib.h>])],[
  zlib_ok=no])
AS_IF([test $zlib_ok = yes], [
  AC_SEARCH_LIBS([deflateSetHeader],[z],[],[
    zlib_ok=no
  ])])
AS_IF([test $zlib_ok = no], [
  AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
  AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}])
  AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}])
])
AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])

#------------------------------------------------------------------------
#	Add stuff for libtommath

libtommath_ok=yes
AC_ARG_WITH(system-libtommath,
AC_HELP_STRING([--with-system-libtommath],
	[use external libtommath (default: true if available, false otherwise)]),
	libtommath_ok=${withval})
if test x"${libtommath_ok}" = x -o x"${libtommath_ok}" != xno; then
    AC_CHECK_HEADER([tommath.h],[
	AC_CHECK_TYPE([mp_int],[],[libtommath_ok=no],[#include <tommath.h>])],[
	libtommath_ok=no])
    AS_IF([test $libtommath_ok = yes], [
	AC_CHECK_LIB([tommath],[mp_log_u32],[MATH_LIBS="$MATH_LIBS -ltommath"],[
    libtommath_ok=no])])
fi
AS_IF([test $libtommath_ok = yes], [
  AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath])
], [
  AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}])
  AC_SUBST(TOMMATH_SRCS,[\${TOMMATH_SRCS}])
  AC_SUBST(TOMMATH_INCLUDE,[-I\${TOMMATH_DIR}])
])

#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

SC_CONFIG_CFLAGS

SC_ENABLE_SYMBOLS(bccdebug)

AC_DEFINE(MP_PREC, 4, [Default libtommath precision.])

#--------------------------------------------------------------------
#	Detect what compiler flags to set for 64-bit support.
#--------------------------------------------------------------------

SC_TCL_EARLY_FLAGS

SC_TCL_64BIT_FLAGS

#--------------------------------------------------------------------
#	Check endianness because we can optimize comparisons of
#	Tcl_UniChar strings to memcmp on big-endian systems.
#--------------------------------------------------------------------

AC_C_BIGENDIAN

#--------------------------------------------------------------------
#	Supply substitutes for missing POSIX library procedures, or
#	set flags so Tcl uses alternate procedures.
#--------------------------------------------------------------------

# Check if Posix compliant getcwd exists, if not we'll use getwd.
AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD, 1, [Is getcwd Posix-compliant?])])
# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
# define USEGETWD even if the posix getcwd exists. Add a test ?

AC_REPLACE_FUNCS(mkstemp opendir strtol waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])])

SC_TCL_IPV6

#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------

SC_TCL_GETPWUID_R
SC_TCL_GETPWNAM_R
SC_TCL_GETGRGID_R
SC_TCL_GETGRNAM_R
if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
    # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
	    [Do we have MT-safe gethostbyname() ?])
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
	    [Do we have MT-safe gethostbyaddr() ?])

elif test "`uname -s`" = "HP-UX" && \
	test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
    # Starting with HPUX 11.00 (we believe), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
	    [Do we have MT-safe gethostbyname() ?])
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
	    [Do we have MT-safe gethostbyaddr() ?])

else
    SC_TCL_GETHOSTBYNAME_R
    SC_TCL_GETHOSTBYADDR_R
fi

#---------------------------------------------------------------------------
#	Check for serial port interface.
#
#	termios.h is present on all POSIX systems.
#	sys/ioctl.h is almost always present, though what it contains
#	is system-specific.
#	sys/modem.h is needed on HP-UX.
#---------------------------------------------------------------------------

AC_CHECK_HEADERS(termios.h)
AC_CHECK_HEADERS(sys/ioctl.h)
AC_CHECK_HEADERS(sys/modem.h)

#--------------------------------------------------------------------
#	Include sys/select.h if it exists and if it supplies things
#	that appear to be useful and aren't already in sys/types.h.
#	This appears to be true only on the RS/6000 under AIX.  Some
#	systems like OSF/1 have a sys/select.h that's of no use, and
#	other systems like SCO UNIX have a sys/select.h that's
#	pernicious.  If "fd_set" isn't defined anywhere then set a
#	special flag.
#--------------------------------------------------------------------

AC_CACHE_CHECK([for fd_set in sys/types], tcl_cv_type_fd_set, [
    AC_TRY_COMPILE([#include <sys/types.h>],[fd_set readMask, writeMask;],
	tcl_cv_type_fd_set=yes, tcl_cv_type_fd_set=no)])
tcl_ok=$tcl_cv_type_fd_set
if test $tcl_ok = no; then
    AC_CACHE_CHECK([for fd_mask in sys/select], tcl_cv_grep_fd_mask, [
	AC_EGREP_HEADER(fd_mask, sys/select.h,
	     tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)])
    if test $tcl_cv_grep_fd_mask = present; then
	AC_DEFINE(HAVE_SYS_SELECT_H, 1, [Should we include <sys/select.h>?])
	tcl_ok=yes
    fi
fi
if test $tcl_ok = no; then
    AC_DEFINE(NO_FD_SET, 1, [Do we have fd_set?])
fi

#------------------------------------------------------------------------
#	Options for the notifier. Checks for epoll(7) on Linux, and
#	kqueue(2) on {DragonFly,Free,Net,Open}BSD
#------------------------------------------------------------------------

AC_MSG_CHECKING([for advanced notifier support])
case x`uname -s` in
  xLinux)
	AC_MSG_RESULT([epoll(7)])
	AC_CHECK_HEADERS([sys/epoll.h],
	    [AC_DEFINE(NOTIFIER_EPOLL, [1], [Is epoll(7) supported?])])
	AC_CHECK_HEADERS([sys/eventfd.h],
	    [AC_DEFINE(HAVE_EVENTFD, [1], [Is eventfd(2) supported?])]);;
  xDragonFlyBSD|xFreeBSD|xNetBSD|xOpenBSD)
	AC_MSG_RESULT([kqueue(2)])
	# Messy because we want to check if *all* the headers are present, and not
	# just *any*
	tcl_kqueue_headers=x
	AC_CHECK_HEADERS([sys/types.h sys/event.h sys/time.h],
	    [tcl_kqueue_headers=${tcl_kqueue_headers}y])
	AS_IF([test $tcl_kqueue_headers = xyyy], [
	    AC_DEFINE(NOTIFIER_KQUEUE, [1], [Is kqueue(2) supported?])]);;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	AC_MSG_RESULT([OSX]);;
  *)
	AC_MSG_RESULT([none]);;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------

SC_TIME_HANDLER

#--------------------------------------------------------------------
#	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
#--------------------------------------------------------------------

AC_FUNC_MEMCMP

#--------------------------------------------------------------------
#       Some system like SunOS 4 and other BSD like systems have no memmove
#       (we assume they have bcopy instead). {The replacement define is in
#       compat/string.h}
#--------------------------------------------------------------------

AC_CHECK_FUNC(memmove, , [
    AC_DEFINE(NO_MEMMOVE, 1, [Do we have memmove()?])
    AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) ])

#--------------------------------------------------------------------
#	On some systems strstr is broken: it returns a pointer even even if
#	the original string is empty.
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strstr, [
    exit(strstr("\0test", "test") ? 1 : 0);
])

#--------------------------------------------------------------------
#	Check for strtoul function.  This is tricky because under some
#	versions of AIX strtoul returns an incorrect terminator
#	pointer for the string "0".
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
    char *term, *string = "0";
    exit(strtoul(string,&term,0) != 0 || term != string+1);
])

#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------

AC_TYPE_MODE_T
AC_TYPE_PID_T
AC_TYPE_SIZE_T
AC_TYPE_UID_T

AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [
    AC_TRY_COMPILE([
	#include <sys/types.h>
	#include <sys/socket.h>
    ],[
    	socklen_t foo;
    ],[tcl_cv_type_socklen_t=yes],[tcl_cv_type_socklen_t=no])])
if test $tcl_cv_type_socklen_t = no; then
    AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available])
fi

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_intptr_t" != none; then
	AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
	   type wide enough to hold a pointer.])
    fi
])
AC_CHECK_TYPE([uintptr_t], [
    AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    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
])

#--------------------------------------------------------------------
#	If a system doesn't have an opendir function (man, that's old!)
#	then we have to supply a different version of dirent.h which
#	is compatible with the substitute version of opendir that's
#	provided.  This version only works with V7-style directories.
#--------------------------------------------------------------------

AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H, 1, [May we include <dirent2.h>?])])

#--------------------------------------------------------------------
#	The check below checks whether <sys/wait.h> defines the type
#	"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'?])
fi

#--------------------------------------------------------------------
#	Check whether there is an strncasecmp function on this system.
#	This is a bit tricky because under SCO it's in -lsocket and
#	under Sequent Dynix it's in -linet.
#--------------------------------------------------------------------

AC_CHECK_FUNC(strncasecmp, tcl_ok=1, tcl_ok=0)
if test "$tcl_ok" = 0; then
    AC_CHECK_LIB(socket, strncasecmp, tcl_ok=1, tcl_ok=0)
fi
if test "$tcl_ok" = 0; then
    AC_CHECK_LIB(inet, strncasecmp, tcl_ok=1, tcl_ok=0)
fi
if test "$tcl_ok" = 0; then
    AC_LIBOBJ([strncasecmp])
    USE_COMPAT=1
fi

#--------------------------------------------------------------------
#	The code below deals with several issues related to gettimeofday:
#	1. Some systems don't provide a gettimeofday function at all
#	   (set NO_GETTOD if this is the case).
#	2. See if gettimeofday is declared in the <sys/time.h> header file.
#	   if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
#	   declare it.
#--------------------------------------------------------------------

AC_CHECK_FUNC(gettimeofday,[],[
    AC_DEFINE(NO_GETTOD, 1, [Do we have gettimeofday()?])
])
AC_CACHE_CHECK([for gettimeofday declaration], tcl_cv_grep_gettimeofday, [
    AC_EGREP_HEADER(gettimeofday, sys/time.h,
	tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing)])
if test $tcl_cv_grep_gettimeofday = missing ; then
    AC_DEFINE(GETTOD_NOT_DECLARED, 1, [Is gettimeofday() actually declared in <sys/time.h>?])
fi

#--------------------------------------------------------------------
#	The following code checks to see whether it is possible to get
#	signed chars on this platform.  This is needed in order to
#	properly generate sign-extended ints from character values.
#--------------------------------------------------------------------

AC_C_CHAR_UNSIGNED
AC_CACHE_CHECK([signed char declarations], tcl_cv_char_signed, [
    AC_TRY_COMPILE(, [
	signed char *p;
	p = 0;
	], tcl_cv_char_signed=yes, tcl_cv_char_signed=no)])
if test $tcl_cv_char_signed = yes; then
    AC_DEFINE(HAVE_SIGNED_CHAR, 1, [Are characters signed?])
fi

#--------------------------------------------------------------------
#  Does putenv() copy or not?  We need to know to avoid memory leaks.
#--------------------------------------------------------------------

AC_CACHE_CHECK([for a putenv() that copies the buffer], tcl_cv_putenv_copy, [
    AC_TRY_RUN([
	#include <stdlib.h>
	#include <string.h>
	#define OURVAR "havecopy=yes"
	int main (int argc, char *argv[])
	{
	    char *foo, *bar;
	    foo = (char *)strdup(OURVAR);
	    putenv(foo);
	    strcpy((char *)(strchr(foo, '=') + 1), "no");
	    bar = getenv("havecopy");
	    if (!strcmp(bar, "no")) {
		/* doesnt copy */
		return 0;
	    } else {
		/* does copy */
		return 1;
	    }
	}
    ],
    tcl_cv_putenv_copy=no,
    tcl_cv_putenv_copy=yes,
    tcl_cv_putenv_copy=no)])
if test $tcl_cv_putenv_copy = yes; then
    AC_DEFINE(HAVE_PUTENV_THAT_COPIES, 1,
	[Does putenv() copy strings or incorporate them by reference?])
fi

#--------------------------------------------------------------------
# Check for support of nl_langinfo function
#--------------------------------------------------------------------

SC_ENABLE_LANGINFO

#--------------------------------------------------------------------
# Check for support of cfmakeraw, chflags and mkstemps functions
#--------------------------------------------------------------------

AC_CHECK_FUNCS(cfmakeraw chflags mkstemps)

#--------------------------------------------------------------------
# Check for support of isnan() function or macro
#--------------------------------------------------------------------

AC_CACHE_CHECK([isnan], tcl_cv_isnan, [
    AC_TRY_LINK([#include <math.h>], [
isnan(0.0);			/* Generates an error if isnan is missing */
], tcl_cv_isnan=yes, tcl_cv_isnan=no)])
if test $tcl_cv_isnan = no; then
    AC_DEFINE(NO_ISNAN, 1, [Do we have a usable 'isnan'?])
fi

#--------------------------------------------------------------------
# Darwin specific API checks and defines
#--------------------------------------------------------------------

if test "`uname -s`" = "Darwin" ; then
    AC_CHECK_FUNCS(getattrlist)
    AC_CHECK_HEADERS(copyfile.h)
    AC_CHECK_FUNCS(copyfile)
    if test $tcl_corefoundation = yes; then
	AC_CHECK_HEADERS(libkern/OSAtomic.h)
	AC_CHECK_FUNCS(OSSpinLockLock)
    fi
    AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?])
    AC_DEFINE(TCL_LOAD_FROM_MEMORY, 1,
	[Can this platform load code from memory?])
    AC_DEFINE(TCL_WIDE_CLICKS, 1,
	[Does this platform have wide high-resolution clicks?])
    AC_CHECK_HEADERS(AvailabilityMacros.h)
    if test "$ac_cv_header_AvailabilityMacros_h" = yes; then
	AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
	    AC_TRY_LINK([
		    #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
		    #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020
		    #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020
		    #endif
		    #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020
		    #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020
		    #endif
		    int rand(void) __attribute__((weak_import));
		], [rand();],
		tcl_cv_cc_weak_import=yes, tcl_cv_cc_weak_import=no)
	    CFLAGS=$hold_cflags])
	if test $tcl_cv_cc_weak_import = yes; then
	    AC_DEFINE(HAVE_WEAK_IMPORT, 1, [Is weak import available?])
	fi
	AC_CACHE_CHECK([if Darwin SUSv3 extensions are available],
	    tcl_cv_cc_darwin_c_source, [
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
	    AC_TRY_COMPILE([
		    #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
		    #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050
		    #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050
		    #endif
		    #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050
		    #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050
		    #endif
		    #define _DARWIN_C_SOURCE 1
		    #include <sys/cdefs.h>
		],,tcl_cv_cc_darwin_c_source=yes, tcl_cv_cc_darwin_c_source=no)
	    CFLAGS=$hold_cflags])
	if test $tcl_cv_cc_darwin_c_source = yes; then
	    AC_DEFINE(_DARWIN_C_SOURCE, 1,
		    [Are Darwin SUSv3 extensions available?])
	fi
    fi
    # Build .bundle dltest binaries in addition to .dylib
    DLTEST_LD='${CC} -bundle -Wl,-w ${CFLAGS} ${LDFLAGS}'
    DLTEST_SUFFIX=".bundle"
else
    DLTEST_LD='${SHLIB_LD}'
    DLTEST_SUFFIX=""
fi

#--------------------------------------------------------------------
#	Check for support of fts functions (readdir replacement)
#--------------------------------------------------------------------

AC_CACHE_CHECK([for fts], tcl_cv_api_fts, [
    AC_TRY_LINK([
	    #include <sys/param.h>
	    #include <sys/stat.h>
	    #include <fts.h>
	], [
	    char*const p[2] = {"/", NULL};
	    FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL);
	    FTSENT *e = fts_read(f); fts_close(f);
	], tcl_cv_api_fts=yes, tcl_cv_api_fts=no)])
if test $tcl_cv_api_fts = yes; then
    AC_DEFINE(HAVE_FTS, 1, [Do we have fts functions?])
fi

#--------------------------------------------------------------------
#	The statements below check for systems where POSIX-style non-blocking
#	I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems
#	(mostly older ones), use the old BSD-style FIONBIO approach instead.
#--------------------------------------------------------------------

SC_BLOCKING_STYLE

#------------------------------------------------------------------------

AC_MSG_CHECKING([whether to use dll unloading])
AC_ARG_ENABLE(dll-unloading,
    AC_HELP_STRING([--enable-dll-unloading],
	[enable the 'unload' command (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test $tcl_ok = yes; then
    AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?])
fi
AC_MSG_RESULT([$tcl_ok])

#------------------------------------------------------------------------
#	Check whether the timezone data is supplied by the OS or has
#	to be installed by Tcl. The default is autodetection, but can
#	be overridden on the configure command line either way.
#------------------------------------------------------------------------

AC_MSG_CHECKING([for timezone data])
AC_ARG_WITH(tzdata,
    AC_HELP_STRING([--with-tzdata],
	[install timezone data (default: autodetect)]),
    [tcl_ok=$withval], [tcl_ok=auto])
#
# Any directories that get added here must also be added to the
# search path in ::tcl::clock::Initialize (library/clock.tcl).
#
case $tcl_ok in
    no)
	AC_MSG_RESULT([supplied by OS vendor])
    ;;
    yes)
	# nothing to do here
    ;;
    auto*)
	AC_CACHE_VAL([tcl_cv_dir_zoneinfo], [
	for dir in /usr/share/zoneinfo \
		/usr/share/lib/zoneinfo \
		/usr/lib/zoneinfo
	do
		if test -f $dir/UTC -o -f $dir/GMT
		then
			tcl_cv_dir_zoneinfo="$dir"
			break
		fi
	done])
	if test -n "$tcl_cv_dir_zoneinfo"; then
	    tcl_ok=no
	    AC_MSG_RESULT([$dir])
	else
	    tcl_ok=yes
	fi
    ;;
    *)
	AC_MSG_ERROR([invalid argument: $tcl_ok])
    ;;
esac
if test $tcl_ok = yes
then
    AC_MSG_RESULT([supplied by Tcl])
    INSTALL_TZDATA=install-tzdata
fi

#--------------------------------------------------------------------
#	DTrace support
#--------------------------------------------------------------------

AC_ARG_ENABLE(dtrace,
    AC_HELP_STRING([--enable-dtrace],
	[build with DTrace support (default: off)]),
    [tcl_ok=$enableval], [tcl_ok=no])
if test $tcl_ok = yes; then
    AC_CHECK_HEADER(sys/sdt.h, [tcl_ok=yes], [tcl_ok=no])
fi
if test $tcl_ok = yes; then
    AC_PATH_PROG(DTRACE, dtrace,, [$PATH:/usr/sbin])
    test -z "$ac_cv_path_DTRACE" && tcl_ok=no
fi
AC_MSG_CHECKING([whether to enable DTrace support])
MAKEFILE_SHELL='/bin/sh'
if test $tcl_ok = yes; then
    AC_DEFINE(USE_DTRACE, 1, [Are we building with DTrace support?])
    DTRACE_SRC="\${DTRACE_SRC}"
    DTRACE_HDR="\${DTRACE_HDR}"
    if test "`uname -s`" != "Darwin" ; then
	DTRACE_OBJ="\${DTRACE_OBJ}"
	if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then
	    # Need to create an intermediate object file to ensure tclDTrace.o
	    # gets included when linking against the static tcl library.
	    STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld'
	    MAKEFILE_SHELL='/bin/bash'
	    # Force use of Sun ar and ranlib, the GNU versions choke on
	    # tclDTrace.o and the combined object file above.
	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
AC_MSG_RESULT([$tcl_ok])

#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_HELP_STRING([--enable-zipfs],
	[build with Zipfs support (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    AX_CC_FOR_BUILD
    #
    # Find a native zip implementation
    #
    SC_ZIPFS_SUPPORT
	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
AC_MSG_CHECKING([for building with zipfs])
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;
       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi
else
AC_MSG_RESULT([no])
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi
AC_SUBST(ZIPFS_BUILD)
AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(INSTALL_LIBRARIES)
AC_SUBST(INSTALL_MSGS)


#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
    AC_TRY_LINK(, [
	int index,regsPtr[4];
    __asm__ __volatile__("mov %%ebx, %%edi     \n\t"
                 "cpuid            \n\t"
                 "mov %%ebx, %%esi   \n\t"
                 "mov %%edi, %%ebx  \n\t"
                 : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
                 : "a"(index) : "edi");
    ], tcl_cv_cpuid=yes, tcl_cv_cpuid=no)])
if test $tcl_cv_cpuid = yes; then
    AC_DEFINE(HAVE_CPUID, 1, [Is the cpuid instruction usable?])
fi

#--------------------------------------------------------------------
#	The statements below define a collection of symbols related to
#	building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------

TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"

# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
# since on some platforms TCL_LIB_FILE contains shell escapes.
# (See also: TCL_TRIM_DOTS).

eval "TCL_LIB_FILE=${TCL_LIB_FILE}"

test -z "$TCL_LIBRARY" && TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)'
PRIVATE_INCLUDE_DIR='$(includedir)'
HTML_DIR='$(DISTDIR)/html'

# Note:  in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..":  this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.

if test "`uname -s`" = "Darwin" ; then
    SC_ENABLE_FRAMEWORK
    TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`"
    TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}'
    echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000'
    TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist'
    EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist'
    EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic'
    AC_CONFIG_FILES([Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in])
    TCL_YEAR="`date +%Y`"
fi

if test "$FRAMEWORK_BUILD" = "1" ; then
    AC_DEFINE(TCL_FRAMEWORK, 1, [Is Tcl built as a framework?])
    # Construct a fake local framework structure to make linking with
    # '-framework Tcl' and running of tcltest work
    AC_CONFIG_COMMANDS([Tcl.framework], [n=Tcl &&
        f=$n.framework && v=Versions/$VERSION &&
        rm -rf $f && mkdir -p $f/$v/Resources &&
        ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v &&
        ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist &&
        unset n f v
    ], VERSION=${TCL_VERSION})
    LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH"
    # default install directory for bundled packages
    if test "${libdir}" = '${exec_prefix}/lib' -o "`basename ${libdir}`" = 'Frameworks'; then
        PACKAGE_DIR="/Library/Tcl"
    else
        PACKAGE_DIR="$libdir"
    fi
    if test "${libdir}" = '${exec_prefix}/lib'; then
        # override libdir default
        libdir="/Library/Frameworks"
    fi
    TCL_LIB_FILE="Tcl"
    TCL_LIB_FLAG="-framework Tcl"
    TCL_BUILD_LIB_SPEC="-F`pwd | sed -e 's/ /\\\\ /g'` -framework Tcl"
    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/" && $(INSTALL_DATA_DIR) "$(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
    PACKAGE_DIR="$libdir"
    if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
        TCL_LIB_FLAG="-ltcl${TCL_VERSION}"
    else
        TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`"
    fi
    TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}"
    TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}"
fi
VERSION='${VERSION}'
eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
VERSION=${TCL_VERSION}

#--------------------------------------------------------------------
#	The statements below define the symbol TCL_PACKAGE_PATH, which
#	gives a list of directories that may contain packages.  The list
#	consists of one directory for machine-dependent binaries and
#	another for platform-independent scripts.
#--------------------------------------------------------------------

if test "$FRAMEWORK_BUILD" = "1" ; then
    test -z "$TCL_PACKAGE_PATH" && \
	TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl ~/Library/Frameworks /Library/Frameworks"
    test -z "$TCL_MODULE_PATH"  && \
	TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl"
elif test "$prefix/lib" != "$libdir"; then
    test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib} ${TCL_PACKAGE_PATH}"
else
    test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="{${prefix}/lib} ${TCL_PACKAGE_PATH}"
fi

#--------------------------------------------------------------------
#       The statements below define various symbols relating to Tcl
#       stub support.
#--------------------------------------------------------------------

# Replace ${VERSION} with contents of ${TCL_VERSION}
# double-eval to account for TCL_TRIM_DOTS.
#
eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_DIR=\"${libdir}\""

if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
    TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}"
else
    TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`"
fi

TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}"
TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}"
TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}"
TCL_STUB_LIB_PATH="${TCL_STUB_LIB_DIR}/${TCL_STUB_LIB_FILE}"

# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}

AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_YEAR)
AC_SUBST(PKG_CFG_ARGS)

AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_PATH)
AC_SUBST(TCL_INCLUDE_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_PATH)

AC_SUBST(TCL_SRC_DIR)
AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)

AC_SUBST(TCL_SHARED_BUILD)
AC_SUBST(LD_LIBRARY_PATH_VAR)

AC_SUBST(TCL_BUILD_LIB_SPEC)

AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_SHARED_LIB_SUFFIX)
AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)

AC_SUBST(TCL_HAS_LONGLONG)

AC_SUBST(INSTALL_TZDATA)

AC_SUBST(DTRACE_SRC)
AC_SUBST(DTRACE_HDR)
AC_SUBST(DTRACE_OBJ)
AC_SUBST(MAKEFILE_SHELL)

AC_SUBST(BUILD_DLTEST)
AC_SUBST(TCL_PACKAGE_PATH)
AC_SUBST(TCL_MODULE_PATH)

AC_SUBST(TCL_LIBRARY)
AC_SUBST(PRIVATE_INCLUDE_DIR)
AC_SUBST(HTML_DIR)
AC_SUBST(PACKAGE_DIR)

AC_SUBST(EXTRA_CC_SWITCHES)
AC_SUBST(EXTRA_APP_CC_SWITCHES)
AC_SUBST(EXTRA_INSTALL)
AC_SUBST(EXTRA_INSTALL_BINARIES)
AC_SUBST(EXTRA_BUILD_HTML)
AC_SUBST(EXTRA_TCLSH_LIBS)

AC_SUBST(DLTEST_LD)
AC_SUBST(DLTEST_SUFFIX)

dnl	Disable the automake-friendly normalization of LIBOBJS
dnl	performed by autoconf 2.53 and later.  It's not correct for us.
define([_AC_LIBOBJS_NORMALIZE],[])
AC_CONFIG_FILES([
    Makefile:../unix/Makefile.in
    dltest/Makefile:../unix/dltest/Makefile.in
    tclConfig.sh:../unix/tclConfig.sh.in
    tcl.pc:../unix/tcl.pc.in
])
AC_OUTPUT

dnl Local Variables:
dnl mode: autoconf
dnl End:

Added unix/configure.in.




























































































































































































































































































































































































































































































































































































































































































































































































































































































































































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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#! /bin/bash -norc
dnl	This file is an input file used by the GNU "autoconf" program to
dnl	generate the file "configure", which is run during Tcl installation
dnl	to configure the system for the local environment.

AC_INIT([tcl],[8.5])
AC_PREREQ([2.59])

dnl This is only used when included from macosx/configure.ac
m4_ifdef([SC_USE_CONFIG_HEADERS], [
    AC_CONFIG_HEADERS([tclConfig.h:../unix/tclConfig.h.in])
    AC_CONFIG_COMMANDS_PRE([DEFS="-DHAVE_TCL_CONFIG_H  -imacros tclConfig.h"])
    AH_TOP([
    #ifndef _TCLCONFIG
    #define _TCLCONFIG])
    AH_BOTTOM([
    /* Undef unused package specific autoheader defines so that we can
     * include both tclConfig.h and tkConfig.h at the same time: */
    /* override */ #undef PACKAGE_NAME
    /* override */ #undef PACKAGE_TARNAME
    /* override */ #undef PACKAGE_VERSION
    /* override */ #undef PACKAGE_STRING
    #endif /* _TCLCONFIG */])
])

TCL_VERSION=8.5
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=5
TCL_PATCH_LEVEL=".19"
VERSION=${TCL_VERSION}

#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix
fi
# Make sure srcdir is fully qualified!
srcdir="`cd "$srcdir" ; pwd`"
TCL_SRC_DIR="`cd "$srcdir"/..; pwd`"

#------------------------------------------------------------------------
# Compress and/or soft link the manpages?
#------------------------------------------------------------------------

SC_CONFIG_MANPAGES

#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------

# If the user did not set CFLAGS, set it now to keep
# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi

AC_PROG_CC
AC_C_INLINE


#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files.  Special notes:
#	- stdlib.h doesn't define strtol, strtoul, or
#	  strtod insome versions of SunOS
#	- some versions of string.h don't declare procedures such
#	  as strstr
# Do this early, otherwise an autoconf bug throws errors on configure
#--------------------------------------------------------------------

SC_MISSING_POSIX_HEADERS

#------------------------------------------------------------------------
# If we're using GCC, see if the compiler understands -pipe.  If so, use it.
# It makes compiling go faster.  (This is only a performance feature.)
#------------------------------------------------------------------------

if test -z "$no_pipe" && test -n "$GCC"; then
    AC_CACHE_CHECK([if the compiler understands -pipe],
	tcl_cv_cc_pipe, [
	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe"
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_pipe=yes],[tcl_cv_cc_pipe=no])
	CFLAGS=$hold_cflags])
    if test $tcl_cv_cc_pipe = yes; then
	CFLAGS="$CFLAGS -pipe"
    fi
fi

#------------------------------------------------------------------------
# Threads support
#------------------------------------------------------------------------

SC_ENABLE_THREADS

#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING

#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------

SC_TCL_LINK_LIBS

# Add the threads support libraries
LIBS="$LIBS$THREADS_LIBS"

SC_ENABLE_SHARED

#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

SC_CONFIG_CFLAGS

SC_ENABLE_SYMBOLS(bccdebug)

AC_DEFINE(TCL_TOMMATH, 1, [Build libtommath?])
AC_DEFINE(MP_PREC, 4, [Default libtommath precision.])

#--------------------------------------------------------------------
#	Detect what compiler flags to set for 64-bit support.
#--------------------------------------------------------------------

SC_TCL_EARLY_FLAGS

SC_TCL_64BIT_FLAGS

#--------------------------------------------------------------------
#	Check endianness because we can optimize comparisons of
#	Tcl_UniChar strings to memcmp on big-endian systems.
#--------------------------------------------------------------------

AC_C_BIGENDIAN

#--------------------------------------------------------------------
#	Supply substitutes for missing POSIX library procedures, or
#	set flags so Tcl uses alternate procedures.
#--------------------------------------------------------------------

# Check if Posix compliant getcwd exists, if not we'll use getwd.
AC_CHECK_FUNCS(getcwd, , [AC_DEFINE(USEGETWD, 1, [Is getcwd Posix-compliant?])])
# Nb: if getcwd uses popen and pwd(1) (like SunOS 4) we should really
# define USEGETWD even if the posix getcwd exists. Add a test ?

AC_REPLACE_FUNCS(opendir strtol waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
	test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])])

SC_TCL_GETADDRINFO

#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------

if test "${TCL_THREADS}" = 1; then
    SC_TCL_GETPWUID_R
    SC_TCL_GETPWNAM_R
    SC_TCL_GETGRGID_R
    SC_TCL_GETGRNAM_R
    if test "`uname -s`" = "Darwin" && \
	    test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
	# Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
	# are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
		[Do we have MT-safe gethostbyname() ?])
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
		[Do we have MT-safe gethostbyaddr() ?])

    elif test "`uname -s`" = "HP-UX" && \
	      test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
        # Starting with HPUX 11.00 (we believe), gethostbyX
        # are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
		[Do we have MT-safe gethostbyname() ?])
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
		[Do we have MT-safe gethostbyaddr() ?])

    else
	SC_TCL_GETHOSTBYNAME_R
	SC_TCL_GETHOSTBYADDR_R
    fi
fi

#---------------------------------------------------------------------------
#	Determine which interface to use to talk to the serial port.
#	Note that #include lines must begin in leftmost column for
#	some compilers to recognize them as preprocessor directives.
#---------------------------------------------------------------------------

SC_SERIAL_PORT

#--------------------------------------------------------------------
#	Include sys/select.h if it exists and if it supplies things
#	that appear to be useful and aren't already in sys/types.h.
#	This appears to be true only on the RS/6000 under AIX.  Some
#	systems like OSF/1 have a sys/select.h that's of no use, and
#	other systems like SCO UNIX have a sys/select.h that's
#	pernicious.  If "fd_set" isn't defined anywhere then set a
#	special flag.
#--------------------------------------------------------------------

AC_CACHE_CHECK([for fd_set in sys/types], tcl_cv_type_fd_set, [
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>]], [[fd_set readMask, writeMask;]])],
	[tcl_cv_type_fd_set=yes],
	[tcl_cv_type_fd_set=no])])
tcl_ok=$tcl_cv_type_fd_set
if test $tcl_ok = no; then
    AC_CACHE_CHECK([for fd_mask in sys/select], tcl_cv_grep_fd_mask, [
	AC_EGREP_HEADER(fd_mask, sys/select.h,
	     tcl_cv_grep_fd_mask=present, tcl_cv_grep_fd_mask=missing)])
    if test $tcl_cv_grep_fd_mask = present; then
	AC_DEFINE(HAVE_SYS_SELECT_H, 1, [Should we include <sys/select.h>?])
	tcl_ok=yes
    fi
fi
if test $tcl_ok = no; then
    AC_DEFINE(NO_FD_SET, 1, [Do we have fd_set?])
fi

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------

SC_TIME_HANDLER

#--------------------------------------------------------------------
#	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
#--------------------------------------------------------------------

AC_FUNC_MEMCMP

#--------------------------------------------------------------------
#       Some system like SunOS 4 and other BSD like systems have no memmove
#       (we assume they have bcopy instead). {The replacement define is in
#       compat/string.h}
#--------------------------------------------------------------------

AC_CHECK_FUNC(memmove, , [
    AC_DEFINE(NO_MEMMOVE, 1, [Do we have memmove()?])
    AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?]) ])

#--------------------------------------------------------------------
#	On some systems strstr is broken: it returns a pointer even even if
#	the original string is empty.
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strstr, [
    extern char *strstr(const char *, const char *);
    exit(strstr("\0test", "test") ? 1 : 0);
])

#--------------------------------------------------------------------
#	Check for strtoul function.  This is tricky because under some
#	versions of AIX strtoul returns an incorrect terminator
#	pointer for the string "0".
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strtoul, [
    extern unsigned long strtoul(const char *, char **, int);
    char *term, *string = "0";
    exit(strtoul(string,&term,0) != 0 || term != string+1);
])

#--------------------------------------------------------------------
#	Check for the strtod function.  This is tricky because in some
#	versions of Linux strtod mis-parses strings starting with "+".
#--------------------------------------------------------------------

SC_TCL_CHECK_BROKEN_FUNC(strtod, [
    extern double strtod(const char *, char **);
    char *term, *string = " +69";
    exit(strtod(string,&term) != 69 || term != string+4);
])

#--------------------------------------------------------------------
#	Under Solaris 2.4, strtod returns the wrong value for the
#	terminating character under some conditions.  Check for this
#	and if the problem exists use a substitute procedure
#	"fixstrtod" that corrects the error.
#--------------------------------------------------------------------

SC_BUGGY_STRTOD

#--------------------------------------------------------------------
#	Check for various typedefs and provide substitutes if
#	they don't exist.
#--------------------------------------------------------------------

AC_TYPE_MODE_T
AC_TYPE_PID_T
AC_TYPE_SIZE_T
AC_TYPE_UID_T

AC_CACHE_CHECK([for socklen_t], tcl_cv_type_socklen_t, [
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <sys/types.h>
	#include <sys/socket.h>
    ]], [[
    	socklen_t foo;
    ]])],[tcl_cv_type_socklen_t=yes],[tcl_cv_type_socklen_t=no])])
if test $tcl_cv_type_socklen_t = no; then
    AC_DEFINE(socklen_t, int, [Define as int if socklen_t is not available])
fi

AC_CHECK_TYPES([intptr_t, uintptr_t],,,[[
#include <stdint.h>
]])

#--------------------------------------------------------------------
#	If a system doesn't have an opendir function (man, that's old!)
#	then we have to supply a different version of dirent.h which
#	is compatible with the substitute version of opendir that's
#	provided.  This version only works with V7-style directories.
#--------------------------------------------------------------------

AC_CHECK_FUNC(opendir, , [AC_DEFINE(USE_DIRENT2_H, 1, [May we include <dirent2.h>?])])

#--------------------------------------------------------------------
#	The check below checks whether <sys/wait.h> defines the type
#	"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_LINK_IFELSE([AC_LANG_PROGRAM([[#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'?])
fi

#--------------------------------------------------------------------
#	Check whether there is an strncasecmp function on this system.
#	This is a bit tricky because under SCO it's in -lsocket and
#	under Sequent Dynix it's in -linet.
#--------------------------------------------------------------------

AC_CHECK_FUNC(strncasecmp, tcl_ok=1, tcl_ok=0)
if test "$tcl_ok" = 0; then
    AC_CHECK_LIB(socket, strncasecmp, tcl_ok=1, tcl_ok=0)
fi
if test "$tcl_ok" = 0; then
    AC_CHECK_LIB(inet, strncasecmp, tcl_ok=1, tcl_ok=0)
fi
if test "$tcl_ok" = 0; then
    AC_LIBOBJ([strncasecmp])
    USE_COMPAT=1
fi

#--------------------------------------------------------------------
#	The code below deals with several issues related to gettimeofday:
#	1. Some systems don't provide a gettimeofday function at all
#	   (set NO_GETTOD if this is the case).
#	2. See if gettimeofday is declared in the <sys/time.h> header file.
#	   if not, set the GETTOD_NOT_DECLARED flag so that tclPort.h can
#	   declare it.
#--------------------------------------------------------------------

AC_CHECK_FUNC(gettimeofday,[],[
    AC_DEFINE(NO_GETTOD, 1, [Do we have gettimeofday()?])
])
AC_CACHE_CHECK([for gettimeofday declaration], tcl_cv_grep_gettimeofday, [
    AC_EGREP_HEADER(gettimeofday, sys/time.h,
	tcl_cv_grep_gettimeofday=present, tcl_cv_grep_gettimeofday=missing)])
if test $tcl_cv_grep_gettimeofday = missing ; then
    AC_DEFINE(GETTOD_NOT_DECLARED, 1, [Is gettimeofday() actually declared in <sys/time.h>?])
fi

#--------------------------------------------------------------------
#	The following code checks to see whether it is possible to get
#	signed chars on this platform.  This is needed in order to
#	properly generate sign-extended ints from character values.
#--------------------------------------------------------------------

AC_C_CHAR_UNSIGNED
AC_CACHE_CHECK([signed char declarations], tcl_cv_char_signed, [
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[
	signed char *p;
	p = 0;
	]])],[tcl_cv_char_signed=yes],[tcl_cv_char_signed=no])])
if test $tcl_cv_char_signed = yes; then
    AC_DEFINE(HAVE_SIGNED_CHAR, 1, [Are characters signed?])
fi

#--------------------------------------------------------------------
#  Does putenv() copy or not?  We need to know to avoid memory leaks.
#--------------------------------------------------------------------

AC_CACHE_CHECK([for a putenv() that copies the buffer], tcl_cv_putenv_copy, [
    AC_RUN_IFELSE([AC_LANG_SOURCE([[
	#include <stdlib.h>
	#include <string.h>
	#define OURVAR "havecopy=yes"
	int main (int argc, char *argv[])
	{
	    char *foo, *bar;
	    foo = (char *)strdup(OURVAR);
	    putenv(foo);
	    strcpy((char *)(strchr(foo, '=') + 1), "no");
	    bar = getenv("havecopy");
	    if (!strcmp(bar, "no")) {
		/* doesnt copy */
		return 0;
	    } else {
		/* does copy */
		return 1;
	    }
	}
    ]])],
    [tcl_cv_putenv_copy=no],
    [tcl_cv_putenv_copy=yes],
    [tcl_cv_putenv_copy=no])])
if test $tcl_cv_putenv_copy = yes; then
    AC_DEFINE(HAVE_PUTENV_THAT_COPIES, 1,
	[Does putenv() copy strings or incorporate them by reference?])
fi

#--------------------------------------------------------------------
# Check for support of nl_langinfo function
#--------------------------------------------------------------------

SC_ENABLE_LANGINFO

#--------------------------------------------------------------------
# Check for support of chflags function
#--------------------------------------------------------------------

AC_CHECK_FUNCS(chflags)

#--------------------------------------------------------------------
# Check for support of isnan() function or macro
#--------------------------------------------------------------------

AC_CACHE_CHECK([isnan], tcl_cv_isnan, [
    AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <math.h>]], [[
isnan(0.0);			/* Generates an error if isnan is missing */
]])],[tcl_cv_isnan=yes],[tcl_cv_isnan=no])])
if test $tcl_cv_isnan = no; then
    AC_DEFINE(NO_ISNAN, 1, [Do we have a usable 'isnan'?])
fi

#--------------------------------------------------------------------
# Darwin specific API checks and defines
#--------------------------------------------------------------------

if test "`uname -s`" = "Darwin" ; then
    AC_CHECK_FUNCS(getattrlist)
    AC_CHECK_HEADERS(copyfile.h)
    AC_CHECK_FUNCS(copyfile)
    if test $tcl_corefoundation = yes; then
	AC_CHECK_HEADERS(libkern/OSAtomic.h)
	AC_CHECK_FUNCS(OSSpinLockLock)
    fi
    AC_DEFINE(USE_VFORK, 1, [Should we use vfork() instead of fork()?])
    AC_DEFINE(TCL_DEFAULT_ENCODING, "utf-8",
	[Are we to override what our default encoding is?])
    AC_DEFINE(TCL_LOAD_FROM_MEMORY, 1,
	[Can this platform load code from memory?])
    AC_DEFINE(TCL_WIDE_CLICKS, 1,
	[Does this platform have wide high-resolution clicks?])
    AC_CHECK_HEADERS(AvailabilityMacros.h)
    if test "$ac_cv_header_AvailabilityMacros_h" = yes; then
	AC_CACHE_CHECK([if weak import is available], tcl_cv_cc_weak_import, [
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
	    AC_LINK_IFELSE([AC_LANG_PROGRAM([[
		    #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
		    #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020
		    #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1020
		    #endif
		    #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1020
		    #error MAC_OS_X_VERSION_MIN_REQUIRED < 1020
		    #endif
		    int rand(void) __attribute__((weak_import));
		]], [[rand();]])],[tcl_cv_cc_weak_import=yes],[tcl_cv_cc_weak_import=no])
	    CFLAGS=$hold_cflags])
	if test $tcl_cv_cc_weak_import = yes; then
	    AC_DEFINE(HAVE_WEAK_IMPORT, 1, [Is weak import available?])
	fi
	AC_CACHE_CHECK([if Darwin SUSv3 extensions are available],
	    tcl_cv_cc_darwin_c_source, [
	    hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		    #ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
		    #if __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050
		    #error __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__ < 1050
		    #endif
		    #elif MAC_OS_X_VERSION_MIN_REQUIRED < 1050
		    #error MAC_OS_X_VERSION_MIN_REQUIRED < 1050
		    #endif
		    #define _DARWIN_C_SOURCE 1
		    #include <sys/cdefs.h>
		]], [[]])],[tcl_cv_cc_darwin_c_source=yes],[tcl_cv_cc_darwin_c_source=no])
	    CFLAGS=$hold_cflags])
	if test $tcl_cv_cc_darwin_c_source = yes; then
	    AC_DEFINE(_DARWIN_C_SOURCE, 1,
		    [Are Darwin SUSv3 extensions available?])
	fi
    fi
    # Build .bundle dltest binaries in addition to .dylib
    DLTEST_LD='${CC} -bundle -Wl,-w ${CFLAGS} ${LDFLAGS}'
    DLTEST_SUFFIX=".bundle"
else
    DLTEST_LD='${SHLIB_LD}'
    DLTEST_SUFFIX=""
fi

#--------------------------------------------------------------------
#	Check for support of fts functions (readdir replacement)
#--------------------------------------------------------------------

AC_CACHE_CHECK([for fts], tcl_cv_api_fts, [
    AC_LINK_IFELSE([AC_LANG_PROGRAM([[
	    #include <sys/param.h>
	    #include <sys/stat.h>
	    #include <fts.h>
	]], [[
	    char*const p[2] = {"/", NULL};
	    FTS *f = fts_open(p, FTS_PHYSICAL|FTS_NOCHDIR|FTS_NOSTAT, NULL);
	    FTSENT *e = fts_read(f); fts_close(f);
	]])],[tcl_cv_api_fts=yes],[tcl_cv_api_fts=no])])
if test $tcl_cv_api_fts = yes; then
    AC_DEFINE(HAVE_FTS, 1, [Do we have fts functions?])
fi

#--------------------------------------------------------------------
#	The statements below check for systems where POSIX-style non-blocking
#	I/O (O_NONBLOCK) doesn't work or is unimplemented. On these systems
#	(mostly older ones), use the old BSD-style FIONBIO approach instead.
#--------------------------------------------------------------------

SC_BLOCKING_STYLE

#------------------------------------------------------------------------

AC_MSG_CHECKING([whether to use dll unloading])
AC_ARG_ENABLE(dll-unloading,
    AS_HELP_STRING([--enable-dll-unloading],
	[enable the 'unload' command (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test $tcl_ok = yes; then
    AC_DEFINE(TCL_UNLOAD_DLLS, 1, [Do we allow unloading of shared libraries?])
fi
AC_MSG_RESULT([$tcl_ok])

#------------------------------------------------------------------------
#	Check whether the timezone data is supplied by the OS or has
#	to be installed by Tcl. The default is autodetection, but can
#	be overridden on the configure command line either way.
#------------------------------------------------------------------------

AC_MSG_CHECKING([for timezone data])
AC_ARG_WITH(tzdata,
    AS_HELP_STRING([--with-tzdata],
	[install timezone data (default: autodetect)]),
    [tcl_ok=$withval], [tcl_ok=auto])
#
# Any directories that get added here must also be added to the
# search path in ::tcl::clock::Initialize (library/clock.tcl).
#
case $tcl_ok in
    no)
	AC_MSG_RESULT([supplied by OS vendor])
    ;;
    yes)
	# nothing to do here
    ;;
    auto*)
	AC_CACHE_VAL([tcl_cv_dir_zoneinfo], [
	for dir in /usr/share/zoneinfo \
		/usr/share/lib/zoneinfo \
		/usr/lib/zoneinfo
	do
		if test -f $dir/UTC -o -f $dir/GMT
		then
			tcl_cv_dir_zoneinfo="$dir"
			break
		fi
	done])
	if test -n "$tcl_cv_dir_zoneinfo"; then
	    tcl_ok=no
	    AC_MSG_RESULT([$dir])
	else
	    tcl_ok=yes
	fi
    ;;
    *)
	AC_MSG_ERROR([invalid argument: $tcl_ok])
    ;;
esac
if test $tcl_ok = yes
then
    AC_MSG_RESULT([supplied by Tcl])
    INSTALL_TZDATA=install-tzdata
fi

#--------------------------------------------------------------------
#	DTrace support
#--------------------------------------------------------------------

AC_ARG_ENABLE(dtrace,
    AS_HELP_STRING([--enable-dtrace],
	[build with DTrace support (default: off)]),
    [tcl_ok=$enableval], [tcl_ok=no])
if test $tcl_ok = yes; then
    AC_CHECK_HEADER(sys/sdt.h, [tcl_ok=yes], [tcl_ok=no])
fi
if test $tcl_ok = yes; then
    AC_PATH_PROG(DTRACE, dtrace,, [$PATH:/usr/sbin])
    test -z "$ac_cv_path_DTRACE" && tcl_ok=no
fi
AC_MSG_CHECKING([whether to enable DTrace support])
MAKEFILE_SHELL='/bin/sh'
if test $tcl_ok = yes; then
    AC_DEFINE(USE_DTRACE, 1, [Are we building with DTrace support?])
    DTRACE_SRC="\${DTRACE_SRC}"
    DTRACE_HDR="\${DTRACE_HDR}"
    if test "`uname -s`" != "Darwin" ; then
	DTRACE_OBJ="\${DTRACE_OBJ}"
	if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then
	    # Need to create an intermediate object file to ensure tclDTrace.o
	    # gets included when linking against the static tcl library.
	    STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld'
	    MAKEFILE_SHELL='/bin/bash'
	    # Force use of Sun ar and ranlib, the GNU versions choke on
	    # tclDTrace.o and the combined object file above.
	    AR='/usr/ccs/bin/ar'
	    RANLIB='/usr/ccs/bin/ranlib'
	fi
    fi
fi
AC_MSG_RESULT([$tcl_ok])

#--------------------------------------------------------------------
#  Does the C stack grow upwards or downwards? Or cross-compiling?
#--------------------------------------------------------------------

AC_CACHE_CHECK([if the C stack grows upwards in memory], tcl_cv_stack_grows_up, [
    AC_RUN_IFELSE([AC_LANG_SOURCE([[
	int StackGrowsUp(int *parent) {
	    int here;
	    volatile int result;
	    if (parent)
		result = (&here < parent);
	    else
		result = StackGrowsUp(&here);
	    return result;
	}
	int main (int argc, char *argv[]) {
	    return StackGrowsUp(0);
	}
    ]])],[tcl_cv_stack_grows_up=yes],[tcl_cv_stack_grows_up=no],
    [tcl_cv_stack_grows_up=unknown])])
if test $tcl_cv_stack_grows_up = unknown; then
    AC_DEFINE(TCL_CROSS_COMPILE, 1, [Are we cross-compiling?])
elif test $tcl_cv_stack_grows_up = yes; then
    AC_DEFINE(TCL_STACK_GROWS_UP, 1, [The C stack grows upwards in memory.])
fi

#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------

AC_CACHE_CHECK([whether the cpuid instruction is usable], tcl_cv_cpuid, [
    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[
	int index,regsPtr[4];
    __asm__ __volatile__("mov %%ebx, %%edi     \n\t"
                 "cpuid            \n\t"
                 "mov %%ebx, %%esi   \n\t"
                 "mov %%edi, %%ebx  \n\t"
                 : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
                 : "a"(index) : "edi");
    ]])],[tcl_cv_cpuid=yes],[tcl_cv_cpuid=no])])
if test $tcl_cv_cpuid = yes; then
    AC_DEFINE(HAVE_CPUID, 1, [Is the cpuid instruction usable?])
fi

#--------------------------------------------------------------------
#	The statements below define a collection of symbols related to
#	building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------

TCL_UNSHARED_LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
TCL_SHARED_LIB_SUFFIX=${SHARED_LIB_SUFFIX}
eval "TCL_LIB_FILE=libtcl${LIB_SUFFIX}"

# tclConfig.sh needs a version of the _LIB_SUFFIX that has been eval'ed
# since on some platforms TCL_LIB_FILE contains shell escapes.
# (See also: TCL_TRIM_DOTS).

eval "TCL_LIB_FILE=${TCL_LIB_FILE}"

test -z "$TCL_LIBRARY" && TCL_LIBRARY='$(prefix)/lib/tcl$(VERSION)'
PRIVATE_INCLUDE_DIR='$(includedir)'
HTML_DIR='$(DISTDIR)/html'

# Note:  in the following variable, it's important to use the absolute
# path name of the Tcl directory rather than "..":  this is because
# AIX remembers this path and will attempt to use it at run-time to look
# up the Tcl library.

if test "`uname -s`" = "Darwin" ; then
    SC_ENABLE_FRAMEWORK
    TCL_SHLIB_LD_EXTRAS="-compatibility_version ${TCL_VERSION} -current_version ${TCL_VERSION}`echo ${TCL_PATCH_LEVEL} | awk ['{match($0, "\\\.[0-9]+"); print substr($0,RSTART,RLENGTH)}']`"
    TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -install_name "${DYLIB_INSTALL_DIR}"/${TCL_LIB_FILE}'
    echo "$LDFLAGS " | grep -q -- '-prebind ' && TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -seg1addr 0xA000000'
    TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist'
    EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist'
    EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic'
    AC_CONFIG_FILES([Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in])
    TCL_YEAR="`date +%Y`"
fi

if test "$FRAMEWORK_BUILD" = "1" ; then
    AC_DEFINE(TCL_FRAMEWORK, 1, [Is Tcl built as a framework?])
    # Construct a fake local framework structure to make linking with
    # '-framework Tcl' and running of tcltest work
    AC_CONFIG_COMMANDS([Tcl.framework], [n=Tcl &&
        f=$n.framework && v=Versions/$VERSION &&
        rm -rf $f && mkdir -p $f/$v/Resources &&
        ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v &&
        ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist &&
        unset n f v
    ], VERSION=${TCL_VERSION})
    LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH"
    if test "${libdir}" = '${exec_prefix}/lib'; then
        # override libdir default
        libdir="/Library/Frameworks"
    fi
    TCL_LIB_FILE="Tcl"
    TCL_LIB_FLAG="-framework Tcl"
    TCL_BUILD_LIB_SPEC="-F`pwd | sed -e 's/ /\\\\ /g'` -framework Tcl"
    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/" && $(INSTALL_DATA_DIR) "$(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"
    if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
        TCL_LIB_FLAG="-ltcl${TCL_VERSION}"
    else
        TCL_LIB_FLAG="-ltcl`echo ${TCL_VERSION} | tr -d .`"
    fi
    TCL_BUILD_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_LIB_FLAG}"
    TCL_LIB_SPEC="-L${libdir} ${TCL_LIB_FLAG}"
fi
VERSION='${VERSION}'
eval "CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}"
eval "CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}"
VERSION=${TCL_VERSION}

#--------------------------------------------------------------------
#	The statements below define the symbol TCL_PACKAGE_PATH, which
#	gives a list of directories that may contain packages.  The list
#	consists of one directory for machine-dependent binaries and
#	another for platform-independent scripts.
#--------------------------------------------------------------------

if test "$FRAMEWORK_BUILD" = "1" ; then
    test -z "$TCL_PACKAGE_PATH" && \
	TCL_PACKAGE_PATH="~/Library/Tcl /Library/Tcl /System/Library/Tcl ~/Library/Frameworks /Library/Frameworks /System/Library/Frameworks"
    test -z "$TCL_MODULE_PATH"  && \
	TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /System/Library/Tcl"
elif test "$prefix/lib" != "$libdir"; then
    test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="${libdir} ${prefix}/lib ${TCL_PACKAGE_PATH}"
else
    test -z "$TCL_PACKAGE_PATH" && TCL_PACKAGE_PATH="${prefix}/lib ${TCL_PACKAGE_PATH}"
fi

#--------------------------------------------------------------------
#       The statements below define various symbols relating to Tcl
#       stub support.
#--------------------------------------------------------------------

# Replace ${VERSION} with contents of ${TCL_VERSION}
# double-eval to account for TCL_TRIM_DOTS.
#
eval "TCL_STUB_LIB_FILE=libtclstub${TCL_UNSHARED_LIB_SUFFIX}"
eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_DIR=${libdir}"

if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
    TCL_STUB_LIB_FLAG="-ltclstub${TCL_VERSION}"
else
    TCL_STUB_LIB_FLAG="-ltclstub`echo ${TCL_VERSION} | tr -d .`"
fi

TCL_BUILD_STUB_LIB_SPEC="-L`pwd | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}"
TCL_STUB_LIB_SPEC="-L${TCL_STUB_LIB_DIR} ${TCL_STUB_LIB_FLAG}"
TCL_BUILD_STUB_LIB_PATH="`pwd`/${TCL_STUB_LIB_FILE}"
TCL_STUB_LIB_PATH="${TCL_STUB_LIB_DIR}/${TCL_STUB_LIB_FILE}"

# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}

AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_YEAR)

AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_PATH)
AC_SUBST(TCL_INCLUDE_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_PATH)

AC_SUBST(TCL_SRC_DIR)
AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)

AC_SUBST(TCL_SHARED_BUILD)
AC_SUBST(LD_LIBRARY_PATH_VAR)

AC_SUBST(TCL_BUILD_LIB_SPEC)

AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_SHARED_LIB_SUFFIX)
AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)

AC_SUBST(TCL_HAS_LONGLONG)

AC_SUBST(INSTALL_TZDATA)

AC_SUBST(DTRACE_SRC)
AC_SUBST(DTRACE_HDR)
AC_SUBST(DTRACE_OBJ)
AC_SUBST(MAKEFILE_SHELL)

AC_SUBST(BUILD_DLTEST)
AC_SUBST(TCL_PACKAGE_PATH)
AC_SUBST(TCL_MODULE_PATH)

AC_SUBST(TCL_LIBRARY)
AC_SUBST(PRIVATE_INCLUDE_DIR)
AC_SUBST(HTML_DIR)

AC_SUBST(EXTRA_CC_SWITCHES)
AC_SUBST(EXTRA_APP_CC_SWITCHES)
AC_SUBST(EXTRA_INSTALL)
AC_SUBST(EXTRA_INSTALL_BINARIES)
AC_SUBST(EXTRA_BUILD_HTML)
AC_SUBST(EXTRA_TCLSH_LIBS)

AC_SUBST(DLTEST_LD)
AC_SUBST(DLTEST_SUFFIX)

dnl	Disable the automake-friendly normalization of LIBOBJS
dnl	performed by autoconf 2.53 and later.  It's not correct for us.
define([_AC_LIBOBJS_NORMALIZE],[])
AC_CONFIG_FILES([
    Makefile:../unix/Makefile.in
    dltest/Makefile:../unix/dltest/Makefile.in
    tclConfig.sh:../unix/tclConfig.sh.in
    tcl.pc:../unix/tcl.pc.in
])
AC_OUTPUT

dnl Local Variables:
dnl mode: autoconf
dnl End:

Changes to unix/dltest/Makefile.in.

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
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







-
+




-
+


-
+



-
+




















-
-
-


















-
-
-


















-
-
-













DLTEST_SUFFIX =		@DLTEST_SUFFIX@
SRC_DIR =		@TCL_SRC_DIR@/unix/dltest
BUILD_DIR =		@builddir@
TCL_VERSION=		@TCL_VERSION@

CFLAGS_DEBUG		= @CFLAGS_DEBUG@
CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@
LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -I${BUILD_DIR}/.. -DTCL_MEM_DEBUG \
	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}

all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX} pkgooa${SHLIB_SUFFIX}
all: pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX} pkgd${SHLIB_SUFFIX} pkge${SHLIB_SUFFIX} pkgua${SHLIB_SUFFIX}
	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
	@touch ../dltest.marker

dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX} pkgooa${DLTEST_SUFFIX}
dltest_suffix: pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgd${DLTEST_SUFFIX} pkge${DLTEST_SUFFIX} pkgua${DLTEST_SUFFIX}
	@touch ../dltest.marker

pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c

pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c

pkgc.o: $(SRC_DIR)/pkgc.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgc.c

pkgd.o: $(SRC_DIR)/pkgd.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c

pkge.o: $(SRC_DIR)/pkge.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkge.c

pkgua.o: $(SRC_DIR)/pkgua.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c

pkgooa.o: $(SRC_DIR)/pkgooa.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c

pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o pkga${SHLIB_SUFFIX} pkga.o ${SHLIB_LD_LIBS}

pkgb${SHLIB_SUFFIX}: pkgb.o
	${SHLIB_LD} -o pkgb${SHLIB_SUFFIX} pkgb.o ${SHLIB_LD_LIBS}

pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o pkgc${SHLIB_SUFFIX} pkgc.o ${SHLIB_LD_LIBS}

pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o pkgd${SHLIB_SUFFIX} pkgd.o ${SHLIB_LD_LIBS}

pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o pkge${SHLIB_SUFFIX} pkge.o ${SHLIB_LD_LIBS}

pkgua${SHLIB_SUFFIX}: pkgua.o
	${SHLIB_LD} -o pkgua${SHLIB_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}

pkgooa${SHLIB_SUFFIX}: pkgooa.o
	${SHLIB_LD} -o pkgooa${SHLIB_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}

pkga${DLTEST_SUFFIX}: pkga.o
	${DLTEST_LD} -o pkga${DLTEST_SUFFIX} pkga.o ${SHLIB_LD_LIBS}

pkgb${DLTEST_SUFFIX}: pkgb.o
	${DLTEST_LD} -o pkgb${DLTEST_SUFFIX} pkgb.o ${SHLIB_LD_LIBS}

pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o pkgc${DLTEST_SUFFIX} pkgc.o ${SHLIB_LD_LIBS}

pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o pkgd${DLTEST_SUFFIX} pkgd.o ${SHLIB_LD_LIBS}

pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o pkge${DLTEST_SUFFIX} pkge.o ${SHLIB_LD_LIBS}

pkgua${DLTEST_SUFFIX}: pkgua.o
	${DLTEST_LD} -o pkgua${DLTEST_SUFFIX} pkgua.o ${SHLIB_LD_LIBS}

pkgooa${DLTEST_SUFFIX}: pkgooa.o
	${DLTEST_LD} -o pkgooa${DLTEST_SUFFIX} pkgooa.o ${SHLIB_LD_LIBS}

clean:
	rm -f *.o lib.exp ../dltest.marker
	@if test "$(SHLIB_SUFFIX)" != ""; then \
	    echo "rm -f *${SHLIB_SUFFIX}" ; \
	    rm -f *${SHLIB_SUFFIX} ; \
	fi
	@if test "$(DLTEST_SUFFIX)" != ""; then \
	    echo "rm -f *${DLTEST_SUFFIX}" ; \
	    rm -f *${DLTEST_SUFFIX} ; \
	fi

distclean: clean
	rm -f Makefile

Changes to unix/dltest/pkga.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19












-







/*
 * pkga.c --
 *
 *	This file contains a simple Tcl package "pkga" that is intended for
 *	testing the Tcl dynamic loading facilities.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"

/*
 * Prototypes for procedures defined later in this file:
 */

static int    Pkga_EqObjCmd(ClientData clientData,
122
123
124
125
126
127
128
129

130
131
132

133
134
135
136
137
138
139
140
121
122
123
124
125
126
127

128
129
130

131
132
133
134
135
136
137
138
139







-
+


-
+








DLLEXPORT int
Pkga_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkga", "1.0");
    code = Tcl_PkgProvide(interp, "pkga", "1.0");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL,
	    NULL);
    return TCL_OK;
}

Changes to unix/dltest/pkgb.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
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













-









-
-







/*
 * pkgb.c --
 *
 *	This file contains a simple Tcl package "pkgb" that is intended for
 *	testing the Tcl dynamic loading facilities. It can be used in both
 *	safe and unsafe interpreters.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"

/*
 * Prototypes for procedures defined later in this file:
 */

static int    Pkgb_SubObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int    Pkgb_UnsafeObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int    Pkgb_DemoObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------------
 *
 * Pkgb_SubObjCmd --
 *
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
95
96
97
98
99
100
101























102
103
104
105
106
107
108







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    (void)dummy;
    (void)objc;
    (void)objv;

    return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL);
}

static int
Pkgb_DemoObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
#if (TCL_MAJOR_VERSION > 8) || (TCL_MINOR_VERSION > 4)
    Tcl_Obj *first;
    (void)dummy;
    (void)objc;
    (void)objv;

    if (Tcl_ListObjIndex(NULL, Tcl_GetEncodingSearchPath(), 0, &first)
	    == TCL_OK) {
	Tcl_SetObjResult(interp, first);
    }
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1));
#endif
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgb_Init --
 *
 *	This is a package initialization procedure, which is called by Tcl
 *	when this package is to be added to an interpreter.
145
146
147
148
149
150
151
152

153
154
155

156
157
158
159
160
161
162
163
164
165
166
167
168
119
120
121
122
123
124
125

126
127
128

129
130
131
132
133
134

135
136
137
138
139
140
141







-
+


-
+





-







DLLEXPORT int
Pkgb_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    code = Tcl_PkgProvide(interp, "pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgb_SafeInit --
182
183
184
185
186
187
188
189

190
191
192

193
194
195
196
197
198
155
156
157
158
159
160
161

162
163
164

165
166
167
168
169
170
171







-
+


-
+






DLLEXPORT int
Pkgb_SafeInit(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    code = Tcl_PkgProvide(interp, "pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
    return TCL_OK;
}

Changes to unix/dltest/pkgc.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20













-







/*
 * pkgc.c --
 *
 *	This file contains a simple Tcl package "pkgc" that is intended for
 *	testing the Tcl dynamic loading facilities. It can be used in both
 *	safe and unsafe interpreters.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"

/*
 * Prototypes for procedures defined later in this file:
 */

static int    Pkgc_SubObjCmd(ClientData clientData,
114
115
116
117
118
119
120
121

122
123
124

125
126
127
128
129
130
131
113
114
115
116
117
118
119

120
121
122

123
124
125
126
127
128
129
130







-
+


-
+







DLLEXPORT int
Pkgc_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
    code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL,
	    NULL);
    return TCL_OK;
151
152
153
154
155
156
157
158

159
160
161

162
163
164
165
166
167
150
151
152
153
154
155
156

157
158
159

160
161
162
163
164
165
166







-
+


-
+






DLLEXPORT int
Pkgc_SafeInit(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
    code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
    return TCL_OK;
}

Changes to unix/dltest/pkgd.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20













-







/*
 * pkgd.c --
 *
 *	This file contains a simple Tcl package "pkgd" that is intended for
 *	testing the Tcl dynamic loading facilities. It can be used in both
 *	safe and unsafe interpreters.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"

/*
 * Prototypes for procedures defined later in this file:
 */

static int    Pkgd_SubObjCmd(ClientData clientData,
114
115
116
117
118
119
120
121

122
123
124

125
126
127
128
129
130
131
113
114
115
116
117
118
119

120
121
122

123
124
125
126
127
128
129
130







-
+


-
+







DLLEXPORT int
Pkgd_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
    code = Tcl_PkgProvide(interp, "pkgd", "7.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL,
	    NULL);
    return TCL_OK;
151
152
153
154
155
156
157
158

159
160
161

162
163
164
165
166
167
150
151
152
153
154
155
156

157
158
159

160
161
162
163
164
165
166







-
+


-
+






DLLEXPORT int
Pkgd_SafeInit(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
    code = Tcl_PkgProvide(interp, "pkgd", "7.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
    return TCL_OK;
}

Changes to unix/dltest/pkge.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20













-







/*
 * pkge.c --
 *
 *	This file contains a simple Tcl package "pkge" that is intended for
 *	testing the Tcl dynamic loading facilities. Its Init procedure returns
 *	an error in order to test how this is handled.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"

/*
 *----------------------------------------------------------------------
 *
 * Pkge_Init --
 *
34
35
36
37
38
39
40
41

42
43
44
45
33
34
35
36
37
38
39

40
41
42
43
44







-
+




DLLEXPORT int
Pkge_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    static const char script[] = "if 44 {open non_existent}";

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    return Tcl_EvalEx(interp, script, -1, 0);
}

Deleted unix/dltest/pkgooa.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147



















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * pkgooa.c --
 *
 *	This file contains a simple Tcl package "pkgooa" that is intended for
 *	testing the Tcl dynamic loading facilities.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tclOO.h"
#include <string.h>

/*
 *----------------------------------------------------------------------
 *
 * Pkgooa_StubsOKObjCmd --
 *
 *	This procedure is invoked to process the "pkgooa_stubsok" Tcl command.
 *	It gives 1 if stubs are used correctly, 0 if stubs are not OK.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
Pkgooa_StubsOKObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    (void)dummy;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, "");
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(
	    Tcl_CopyObjectInstance == tclOOStubsPtr->tcl_CopyObjectInstance));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgooa_Init --
 *
 *	This is a package initialization procedure, which is called by Tcl
 *	when this package is to be added to an interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

extern void *tclOOIntStubsPtr;

static TclOOStubs stubsCopy = {
    TCL_STUB_MAGIC,
    NULL,
    /* It doesn't really matter what implementation of
     * Tcl_CopyObjectInstance is put in the "pseudo"
     * stub table, since the test-case never actually
     * calls this function. All that matters is that it's
     * a function with a different memory address than
     * the real Tcl_CopyObjectInstance function in Tcl. */
    (Tcl_Object (*) (Tcl_Interp *, Tcl_Object, const char *,
	    const char *t))(void *)Pkgooa_StubsOKObjCmd,
    /* More entries could be here, but those are not used
     * for this test-case. So, being NULL is OK. */
    NULL, NULL, NULL, NULL, NULL, NULL, NULL,
    NULL, NULL, NULL, NULL, NULL, NULL, NULL,
    NULL, NULL, NULL, NULL, NULL, NULL, NULL,
    NULL, NULL, NULL, NULL, NULL, NULL, NULL,
};

extern DLLEXPORT int
Pkgooa_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    /* Any TclOO extension which uses stubs, calls
     * both Tcl_InitStubs and Tcl_OOInitStubs() and
     * does not use any Tcl 8.6 features should be
     * loadable in Tcl 8.5 as well, provided the
     * TclOO extension (for Tcl 8.5) is installed.
     * This worked in Tcl 8.6.0, and is expected
     * to keep working in all future Tcl 8.x releases.
     */
    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    if (tclStubsPtr == NULL) {
	Tcl_AppendResult(interp, "Tcl stubs are not inialized, "
		"did you compile using -DUSE_TCL_STUBS? ");
	return TCL_ERROR;
    }
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }
    if (tclOOStubsPtr == NULL) {
	Tcl_AppendResult(interp, "TclOO stubs are not inialized");
	return TCL_ERROR;
    }
    if (tclOOIntStubsPtr == NULL) {
	Tcl_AppendResult(interp, "TclOO internal stubs are not inialized");
	return TCL_ERROR;
    }

    /* Test case for Bug [f51efe99a7].
     *
     * Let tclOOStubsPtr point to an alternate stub table
     * (with only a single function, that's enough for
     * this test). This way, the function "pkgooa_stubsok"
     * can check whether the TclOO function calls really
     * use the stub table, or only pretend to.
     *
     * On platforms without backlinking (Windows, Cygwin,
     * AIX), this code doesn't even compile without using
     * stubs, but on UNIX ELF systems, the problem is
     * less visible.
     */

    tclOOStubsPtr = &stubsCopy;

    code = Tcl_PkgProvide(interp, "Pkgooa", "1.0");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL);
    return TCL_OK;
}

Changes to unix/dltest/pkgua.c.

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
34
35
36
37
38
39
40

41
42
43
44
45
46
47







-







 * Note that this code is utterly single-threaded.
 */

static Tcl_HashTable interpTokenMap;
static int interpTokenMapInitialised = 0;
#define MAX_REGISTERED_COMMANDS 2


static void
PkguaInitTokensHashTable(void)
{
    if (interpTokenMapInitialised) {
	return;
    }
    Tcl_InitHashTable(&interpTokenMap, TCL_ONE_WORD_KEYS);
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
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







-
+



-
-
+
+


-
+











-
+







static Tcl_Command *
PkguaInterpToTokens(
    Tcl_Interp *interp)
{
    int newEntry;
    Tcl_Command *cmdTokens;
    Tcl_HashEntry *entryPtr =
	    Tcl_CreateHashEntry(&interpTokenMap, interp, &newEntry);
	    Tcl_CreateHashEntry(&interpTokenMap, (char *) interp, &newEntry);

    if (newEntry) {
	cmdTokens = (Tcl_Command *)
		Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS+1));
	for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS+1 ; ++newEntry) {
		Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS));
	for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS ; ++newEntry) {
	    cmdTokens[newEntry] = NULL;
	}
	Tcl_SetHashValue(entryPtr, cmdTokens);
	Tcl_SetHashValue(entryPtr, (ClientData) cmdTokens);
    } else {
	cmdTokens = (Tcl_Command *) Tcl_GetHashValue(entryPtr);
    }
    return cmdTokens;
}

static void
PkguaDeleteTokens(
    Tcl_Interp *interp)
{
    Tcl_HashEntry *entryPtr =
	    Tcl_FindHashEntry(&interpTokenMap, interp);
	    Tcl_FindHashEntry(&interpTokenMap, (char *) interp);

    if (entryPtr) {
	Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
	Tcl_DeleteHashEntry(entryPtr);
    }
}

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
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







-
+


-
+




-
+





-
+







-
-
-
-
+
+
+
+







 */

DLLEXPORT int
Pkgua_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code, cmdIndex = 0;
    int code;
    Tcl_Command *cmdTokens;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }

    /*
     * Initialise our Hash table, where we store the registered command tokens
     * Initialize our Hash table, where we store the registered command tokens
     * for each interpreter.
     */

    PkguaInitTokensHashTable();

    code = Tcl_PkgProvide(interp, "Pkgua", "1.0");
    code = Tcl_PkgProvide(interp, "pkgua", "1.0");
    if (code != TCL_OK) {
	return code;
    }

    Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);

    cmdTokens = PkguaInterpToTokens(interp);
    cmdTokens[cmdIndex++] =
	    Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, NULL,
		    NULL);
    cmdTokens[cmdIndex++] =
    cmdTokens[0] =
	    Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd,
		    NULL, NULL);
    cmdTokens[1] =
	    Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd,
		    NULL, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------

Changes to unix/install-sh.

1
2
3
4

5
6
7
8
9
10
11
1
2
3

4
5
6
7
8
9
10
11



-
+







#!/bin/sh
# install - install a program, script, or datafile

scriptversion=2020-07-26.22; # UTC
scriptversion=2011-04-20.01; # UTC

# This originates from X11R5 (mit/util/scripts/install.sh), which was
# later released in X11R6 (xc/config/util/install.sh) with the
# following copyright and license.
#
# Copyright (C) 1994 X Consortium
#
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
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







-
+





-


-
+

-
+

+

+
-
+
+
+
+













+
+
+
+
+
+
+
+
+
+
+






-
-
-
-













-
+







# ings in this Software without prior written authorization from the X Consor-
# tium.
#
#
# FSF changes to this file are in the public domain.
#
# Calling this script install-sh is preferred over install.sh, to prevent
# 'make' implicit rules from creating a file called install from it
# `make' implicit rules from creating a file called install from it
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.

tab='	'
nl='
'
IFS=" $tab$nl"
IFS=" ""	$nl"

# Set DOITPROG to "echo" to test this script.
# set DOITPROG to echo to test this script

# Don't use :- since 4.3BSD and earlier shells don't like it.
doit=${DOITPROG-}
if test -z "$doit"; then
doit_exec=${doit:-exec}
  doit_exec=exec
else
  doit_exec=$doit
fi

# Put in absolute file names if you don't have them in your path;
# or use environment vars.

chgrpprog=${CHGRPPROG-chgrp}
chmodprog=${CHMODPROG-chmod}
chownprog=${CHOWNPROG-chown}
cmpprog=${CMPPROG-cmp}
cpprog=${CPPROG-cp}
mkdirprog=${MKDIRPROG-mkdir}
mvprog=${MVPROG-mv}
rmprog=${RMPROG-rm}
stripprog=${STRIPPROG-strip}

posix_glob='?'
initialize_posix_glob='
  test "$posix_glob" != "?" || {
    if (set -f) 2>/dev/null; then
      posix_glob=
    else
      posix_glob=:
    fi
  }
'

posix_mkdir=

# Desired mode of installed file.
mode=0755

# Create dirs (including intermediate dirs) using mode 755.
# This is like GNU 'install' as of coreutils 8.32 (2020).
mkdir_umask=22

chgrpcmd=
chmodcmd=$chmodprog
chowncmd=
mvcmd=$mvprog
rmcmd="$rmprog -f"
stripcmd=

src=
dst=
dir_arg=
dst_arg=

copy_on_change=false
is_target_a_directory=possibly
no_target_directory=

usage="\
Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE
   or: $0 [OPTION]... SRCFILES... DIRECTORY
   or: $0 [OPTION]... -t DIRECTORY SRCFILES...
   or: $0 [OPTION]... -d DIRECTORIES...

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
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







-
+

















-
+




-
-
-
-
-
-
+
+
+
+
+
+
+


-
+




-
+

-
-
-
+
-
-
-
-
-
+

-
+



-
-
+
+

-
-
+
+






-
-
-
-
-
-
-
-
-
-













-
-
-
-








-
+




-
-
-
-
-
-
-
-
-
















-
+

-
+




-
+

-
+







-
+

-
+







  -c            (ignored)
  -C            install only if different (preserve the last data modification time)
  -d            create directories instead of installing files.
  -g GROUP      $chgrpprog installed files to GROUP.
  -m MODE       $chmodprog installed files to MODE.
  -o USER       $chownprog installed files to USER.
  -s            $stripprog installed files.
  -S OPTION     $stripprog installed files using OPTION.
  -S            $stripprog installed files.
  -t DIRECTORY  install into DIRECTORY.
  -T            report an error if DSTFILE is a directory.

Environment variables override the default commands:
  CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG
  RMPROG STRIPPROG
"

while test $# -ne 0; do
  case $1 in
    -c) ;;

    -C) copy_on_change=true;;

    -d) dir_arg=true;;

    -g) chgrpcmd="$chgrpprog $2"
        shift;;
	shift;;

    --help) echo "$usage"; exit $?;;

    -m) mode=$2
        case $mode in
          *' '* | *"$tab"* | *"$nl"* | *'*'* | *'?'* | *'['*)
            echo "$0: invalid mode: $mode" >&2
            exit 1;;
        esac
        shift;;
	case $mode in
	  *' '* | *'	'* | *'
'*	  | *'*'* | *'?'* | *'['*)
	    echo "$0: invalid mode: $mode" >&2
	    exit 1;;
	esac
	shift;;

    -o) chowncmd="$chownprog $2"
        shift;;
	shift;;

    -s) stripcmd=$stripprog;;

    -S) stripcmd="$stripprog $2"
        shift;;
	shift;;

    -t)
        is_target_a_directory=always
        dst_arg=$2
    -t) dst_arg=$2
        # Protect names problematic for 'test' and other utilities.
        case $dst_arg in
          -* | [=\(\)!]) dst_arg=./$dst_arg;;
        esac
        shift;;
	shift;;

    -T) is_target_a_directory=never;;
    -T) no_target_directory=true;;

    --version) echo "$0 $scriptversion"; exit $?;;

    --) shift
        break;;
    --)	shift
	break;;

    -*) echo "$0: invalid option: $1" >&2
        exit 1;;
    -*)	echo "$0: invalid option: $1" >&2
	exit 1;;

    *)  break;;
  esac
  shift
done

# We allow the use of options -d and -T together, by making -d
# take the precedence; this is for compatibility with GNU install.

if test -n "$dir_arg"; then
  if test -n "$dst_arg"; then
    echo "$0: target directory not allowed when installing a directory." >&2
    exit 1
  fi
fi

if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then
  # When -d is used, all remaining arguments are directories to create.
  # When -t is used, the destination is already specified.
  # Otherwise, the last argument is the destination.  Remove it from $@.
  for arg
  do
    if test -n "$dst_arg"; then
      # $@ is not empty: it contains at least $arg.
      set fnord "$@" "$dst_arg"
      shift # fnord
    fi
    shift # arg
    dst_arg=$arg
    # Protect names problematic for 'test' and other utilities.
    case $dst_arg in
      -* | [=\(\)!]) dst_arg=./$dst_arg;;
    esac
  done
fi

if test $# -eq 0; then
  if test -z "$dir_arg"; then
    echo "$0: no input file specified." >&2
    exit 1
  fi
  # It's OK to call 'install-sh -d' without argument.
  # It's OK to call `install-sh -d' without argument.
  # This can happen when creating conditional directories.
  exit 0
fi

if test -z "$dir_arg"; then
  if test $# -gt 1 || test "$is_target_a_directory" = always; then
    if test ! -d "$dst_arg"; then
      echo "$0: $dst_arg: Is not a directory." >&2
      exit 1
    fi
  fi
fi

if test -z "$dir_arg"; then
  do_exit='(exit $ret); exit $ret'
  trap "ret=129; $do_exit" 1
  trap "ret=130; $do_exit" 2
  trap "ret=141; $do_exit" 13
  trap "ret=143; $do_exit" 15

  # Set umask so as not to create temps with too-generous modes.
  # However, 'strip' requires both read and write access to temps.
  case $mode in
    # Optimize common cases.
    *644) cp_umask=133;;
    *755) cp_umask=22;;

    *[0-7])
      if test -z "$stripcmd"; then
        u_plus_rw=
	u_plus_rw=
      else
        u_plus_rw='% 200'
	u_plus_rw='% 200'
      fi
      cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;;
    *)
      if test -z "$stripcmd"; then
        u_plus_rw=
	u_plus_rw=
      else
        u_plus_rw=,u+rw
	u_plus_rw=,u+rw
      fi
      cp_umask=$mode$u_plus_rw;;
  esac
fi

for src
do
  # Protect names problematic for 'test' and other utilities.
  # Protect names starting with `-'.
  case $src in
    -* | [=\(\)!]) src=./$src;;
    -*) src=./$src;;
  esac

  if test -n "$dir_arg"; then
    dst=$src
    dstdir=$dst
    test -d "$dstdir"
    dstdir_status=$?
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
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
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
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
524
525

526
527
528







+

+
+
+
+

-
+
+

-
-
-
+
+
+


-
+
-
-
-
-


+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
+
+
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-

-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
+
+




-
+




-
-
-
+
+
+

+
+



-
+


-
+






-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+












-
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
+














-
-
-
+
+
+
+
+


-
+
+












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+








-
+


-
+


      exit 1
    fi

    if test -z "$dst_arg"; then
      echo "$0: no destination specified." >&2
      exit 1
    fi

    dst=$dst_arg
    # Protect names starting with `-'.
    case $dst in
      -*) dst=./$dst;;
    esac

    # If destination is a directory, append the input filename.
    # If destination is a directory, append the input filename; won't work
    # if double slashes aren't ignored.
    if test -d "$dst"; then
      if test "$is_target_a_directory" = never; then
        echo "$0: $dst_arg: Is a directory" >&2
        exit 1
      if test -n "$no_target_directory"; then
	echo "$0: $dst_arg: Is a directory" >&2
	exit 1
      fi
      dstdir=$dst
      dstbase=`basename "$src"`
      dst=$dstdir/`basename "$src"`
      case $dst in
	*/) dst=$dst$dstbase;;
	*)  dst=$dst/$dstbase;;
      esac
      dstdir_status=0
    else
      # Prefer dirname, but fall back on a substitute if dirname fails.
      dstdir=`dirname "$dst"`
      dstdir=`
	(dirname "$dst") 2>/dev/null ||
	expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	     X"$dst" : 'X\(//\)[^/]' \| \
	     X"$dst" : 'X\(//\)$' \| \
	     X"$dst" : 'X\(/\)' \| . 2>/dev/null ||
	echo X"$dst" |
	    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
		   s//\1/
		   q
		 }
		 /^X\(\/\/\)[^/].*/{
		   s//\1/
		   q
		 }
		 /^X\(\/\/\)$/{
		   s//\1/
		   q
		 }
		 /^X\(\/\).*/{
		   s//\1/
		   q
		 }
		 s/.*/./; q'
      `

      test -d "$dstdir"
      dstdir_status=$?
    fi
  fi

  case $dstdir in
    */) dstdirslash=$dstdir;;
    *)  dstdirslash=$dstdir/;;
  esac

  obsolete_mkdir_used=false

  if test $dstdir_status != 0; then
    case $posix_mkdir in
      '')
	# Create intermediate dirs using mode 755 as modified by the umask.
	# This is like FreeBSD 'install' as of 1997-10-28.
	umask=`umask`
	case $stripcmd.$umask in
	  # Optimize common cases.
	  *[2367][2367]) mkdir_umask=$umask;;
	  .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;;

	  *[0-7])
	    mkdir_umask=`expr $umask + 22 \
	      - $umask % 100 % 40 + $umask % 20 \
	      - $umask % 10 % 4 + $umask % 2
	    `;;
	  *) mkdir_umask=$umask,go-w;;
	esac

        # With -d, create the new directory with the user-specified mode.
        # Otherwise, rely on $mkdir_umask.
        if test -n "$dir_arg"; then
          mkdir_mode=-m$mode
        else
          mkdir_mode=
        fi
	# With -d, create the new directory with the user-specified mode.
	# Otherwise, rely on $mkdir_umask.
	if test -n "$dir_arg"; then
	  mkdir_mode=-m$mode
	else
	  mkdir_mode=
	fi

        posix_mkdir=false
	# The $RANDOM variable is not portable (e.g., dash).  Use it
	posix_mkdir=false
	case $umask in
	# here however when possible just to lower collision chance.
	tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$

	  *[123567][0-7][0-7])
	    # POSIX mkdir -p sets u+wx bits regardless of umask, which
	    # is incompatible with FreeBSD 'install' when (umask & 300) != 0.
	    ;;
	  *)
	    tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$
	    trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0
	trap '
	  ret=$?
	  rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir" 2>/dev/null
	  exit $ret
	' 0

	# Because "mkdir -p" follows existing symlinks and we likely work
	# directly in world-writeable /tmp, make sure that the '$tmpdir'
	# directory is successfully created first before we actually test
	# 'mkdir -p'.
	if (umask $mkdir_umask &&
	    if (umask $mkdir_umask &&
	    $mkdirprog $mkdir_mode "$tmpdir" &&
	    exec $mkdirprog $mkdir_mode -p -- "$tmpdir/a/b") >/dev/null 2>&1
	then
	  if test -z "$dir_arg" || {
	       # Check for POSIX incompatibilities with -m.
	       # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
	       # other-writable bit of parent directory when it shouldn't.
	       # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
		exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1
	    then
	      if test -z "$dir_arg" || {
		   # Check for POSIX incompatibilities with -m.
		   # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or
		   # other-writeable bit of parent directory when it shouldn't.
		   # FreeBSD 6.1 mkdir -m -p sets mode of existing directory.
	       test_tmpdir="$tmpdir/a"
	       ls_ld_tmpdir=`ls -ld "$test_tmpdir"`
	       case $ls_ld_tmpdir in
		 d????-?r-*) different_mode=700;;
		 d????-?--*) different_mode=755;;
		 *) false;;
	       esac &&
	       $mkdirprog -m$different_mode -p -- "$test_tmpdir" && {
		 ls_ld_tmpdir_1=`ls -ld "$test_tmpdir"`
		 test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
	       }
	     }
	  then posix_mkdir=:
	  fi
	  rmdir "$tmpdir/a/b" "$tmpdir/a" "$tmpdir"
	else
	  # Remove any dirs left behind by ancient mkdir implementations.
	  rmdir ./$mkdir_mode ./-p ./-- "$tmpdir" 2>/dev/null
	fi
	trap '' 0;;
		   ls_ld_tmpdir=`ls -ld "$tmpdir"`
		   case $ls_ld_tmpdir in
		     d????-?r-*) different_mode=700;;
		     d????-?--*) different_mode=755;;
		     *) false;;
		   esac &&
		   $mkdirprog -m$different_mode -p -- "$tmpdir" && {
		     ls_ld_tmpdir_1=`ls -ld "$tmpdir"`
		     test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1"
		   }
		 }
	      then posix_mkdir=:
	      fi
	      rmdir "$tmpdir/d" "$tmpdir"
	    else
	      # Remove any dirs left behind by ancient mkdir implementations.
	      rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null
	    fi
	    trap '' 0;;
	esac;;
    esac

    if
      $posix_mkdir && (
        umask $mkdir_umask &&
        $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
	umask $mkdir_umask &&
	$doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir"
      )
    then :
    else

      # mkdir does not conform to POSIX,
      # The umask is ridiculous, or mkdir does not conform to POSIX,
      # or it failed possibly due to a race condition.  Create the
      # directory the slow way, step by step, checking for races as we go.

      case $dstdir in
        /*) prefix='/';;
        [-=\(\)!]*) prefix='./';;
        *)  prefix='';;
	/*) prefix='/';;
	-*) prefix='./';;
	*)  prefix='';;
      esac

      eval "$initialize_posix_glob"

      oIFS=$IFS
      IFS=/
      set -f
      $posix_glob set -f
      set fnord $dstdir
      shift
      set +f
      $posix_glob set +f
      IFS=$oIFS

      prefixes=

      for d
      do
        test X"$d" = X && continue
	test -z "$d" && continue

        prefix=$prefix$d
        if test -d "$prefix"; then
          prefixes=
        else
          if $posix_mkdir; then
            (umask $mkdir_umask &&
             $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
            # Don't fail if two instances are running concurrently.
            test -d "$prefix" || exit 1
          else
            case $prefix in
              *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
              *) qprefix=$prefix;;
            esac
            prefixes="$prefixes '$qprefix'"
          fi
        fi
        prefix=$prefix/
	prefix=$prefix$d
	if test -d "$prefix"; then
	  prefixes=
	else
	  if $posix_mkdir; then
	    (umask=$mkdir_umask &&
	     $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break
	    # Don't fail if two instances are running concurrently.
	    test -d "$prefix" || exit 1
	  else
	    case $prefix in
	      *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;;
	      *) qprefix=$prefix;;
	    esac
	    prefixes="$prefixes '$qprefix'"
	  fi
	fi
	prefix=$prefix/
      done

      if test -n "$prefixes"; then
        # Don't fail if two instances are running concurrently.
        (umask $mkdir_umask &&
         eval "\$doit_exec \$mkdirprog $prefixes") ||
          test -d "$dstdir" || exit 1
        obsolete_mkdir_used=true
	# Don't fail if two instances are running concurrently.
	(umask $mkdir_umask &&
	 eval "\$doit_exec \$mkdirprog $prefixes") ||
	  test -d "$dstdir" || exit 1
	obsolete_mkdir_used=true
      fi
    fi
  fi

  if test -n "$dir_arg"; then
    { test -z "$chowncmd" || $doit $chowncmd "$dst"; } &&
    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } &&
    { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false ||
      test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1
  else

    # Make a couple of temp file names in the proper directory.
    dsttmp=${dstdirslash}_inst.$$_
    rmtmp=${dstdirslash}_rm.$$_
    dsttmp=$dstdir/_inst.$$_
    rmtmp=$dstdir/_rm.$$_

    # Trap to clean up those temp files at exit.
    trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0

    # Copy the file name to the temp name.
    (umask $cp_umask &&
     { test -z "$stripcmd" || {
	 # Create $dsttmp read-write so that cp doesn't create it read-only,
	 # which would cause strip to fail.
	 if test -z "$doit"; then
	   : >"$dsttmp" # No need to fork-exec 'touch'.
	 else
	   $doit touch "$dsttmp"
	 fi
       }
     } &&
     $doit_exec $cpprog "$src" "$dsttmp") &&
    (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") &&

    # and set any options; do chmod last to preserve setuid bits.
    #
    # If any of these fail, we abort the whole thing.  If we want to
    # ignore errors from any of these, just make sure not to ignore
    # errors from the above "$doit $cpprog $src $dsttmp" command.
    #
    { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } &&
    { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } &&
    { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } &&
    { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } &&

    # If -C, don't bother to copy if it wouldn't change the file.
    if $copy_on_change &&
       old=`LC_ALL=C ls -dlL "$dst"     2>/dev/null` &&
       new=`LC_ALL=C ls -dlL "$dsttmp"  2>/dev/null` &&
       set -f &&
       old=`LC_ALL=C ls -dlL "$dst"	2>/dev/null` &&
       new=`LC_ALL=C ls -dlL "$dsttmp"	2>/dev/null` &&

       eval "$initialize_posix_glob" &&
       $posix_glob set -f &&
       set X $old && old=:$2:$4:$5:$6 &&
       set X $new && new=:$2:$4:$5:$6 &&
       set +f &&
       $posix_glob set +f &&

       test "$old" = "$new" &&
       $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1
    then
      rm -f "$dsttmp"
    else
      # Rename the file to the real destination.
      $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null ||

      # The rename failed, perhaps because mv can't rename something else
      # to itself, or perhaps because mv is so ancient that it does not
      # support -f.
      {
        # Now remove or move aside any old file at destination location.
        # We try this two ways since rm can't unlink itself on some
        # systems and the destination file might be busy for other
        # reasons.  In this case, the final cleanup might fail but the new
        # file should still install successfully.
        {
          test ! -f "$dst" ||
          $doit $rmcmd -f "$dst" 2>/dev/null ||
          { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
            { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
          } ||
          { echo "$0: cannot unlink or rename $dst" >&2
            (exit 1); exit 1
          }
        } &&
	# Now remove or move aside any old file at destination location.
	# We try this two ways since rm can't unlink itself on some
	# systems and the destination file might be busy for other
	# reasons.  In this case, the final cleanup might fail but the new
	# file should still install successfully.
	{
	  test ! -f "$dst" ||
	  $doit $rmcmd -f "$dst" 2>/dev/null ||
	  { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null &&
	    { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; }
	  } ||
	  { echo "$0: cannot unlink or rename $dst" >&2
	    (exit 1); exit 1
	  }
	} &&

        # Now rename the file to the real destination.
        $doit $mvcmd "$dsttmp" "$dst"
	# Now rename the file to the real destination.
	$doit $mvcmd "$dsttmp" "$dst"
      }
    fi || exit 1

    trap '' 0
  fi
done

# Local variables:
# eval: (add-hook 'before-save-hook 'time-stamp)
# eval: (add-hook 'write-file-hooks 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC0"
# time-stamp-time-zone: "UTC"
# time-stamp-end: "; # UTC"
# End:

Changes to unix/installManPage.

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
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







-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-








# A sed script to parse the alternative names out of a man page.
#
# Backslashes are trippled in the sed script, because it is in
# backticks which doesn't pass backslashes literally.
#
Names=`sed -n '
#                               Look for a line that starts with .SH NAME
    /^\.SH NAME/,/^\./{


#                               Look for a line, that starts with .SH NAME
#                               optionally allow NAME to be surrounded
#                               by quotes.
    /^\.SH NAME/{
#                               Read next line
	n
	/^\./!{

	    # Remove all commas...
	    s/,//g
#                               Remove all commas ...
	s/,//g

	    # ... and backslash-escaped spaces.
	    s/\\\ //g
#                               ... and backslash-escaped spaces.
	s/\\\ //g

	    /\\\-.*/{
		# Delete from \- to the end of line
		s/ \\\-.*//
#                               Delete from \- to the end of line
	s/ \\\-.*//
		h
		s/.*/./
		x
	    }

#                               print the result and exit
	    # Convert all non-space non-alphanum sequences
	    # to single underscores.
	    s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
	    p
	p;q
	    g
	    /^\./{
		q
	    }
    }

    }' $ManPage`

if test -z "$Names" ; then
    echo "warning: no target names found in $ManPage"
fi

########################################################################
128
129
130
131
132
133
134
135

136
137
138
139
140
112
113
114
115
116
117
118

119
120
121
122
123
124







-
+





    if test -z "$First" ; then
	First=$Target
	sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \
	    $ManPage > "$Dir/$First"
	chmod 644 "$Dir/$First"
	$Gzip "$Dir/$First"
    else
	ln "$SymOrLoc$First$Gz" "$Dir/$Target$Gz"
	ln $SymOrLoc"$First$Gz" "$Dir/$Target$Gz"
    fi
done

########################################################################
exit 0

Changes to unix/ldAix.

1
2

3
4
5
6
7
8
9
1

2
3
4
5
6
7
8
9

-
+







#!/bin/sh
#
# 
# ldAix ldCmd ldArg ldArg ...
#
# This shell script provides a wrapper for ld under AIX in order to
# create the .exp file required for linking.  Its arguments consist
# of the name and arguments that would normally be provided to the
# ld command.  This script extracts the names of the object files
# from the argument list, creates a .exp file describing all of the
36
37
38
39
40
41
42
43
44


45
46
47
48
49
50
51
36
37
38
39
40
41
42


43
44
45
46
47
48
49
50
51







-
-
+
+







#   left with just the symbol name

nmopts="-g -C -h -X32_64"
rm -f lib.exp
echo "#! $outputFile" >lib.exp
/usr/ccs/bin/nm $nmopts $ofiles | sed -e '/:$/d' -e '/ U /d' -e 's/^\.//' -e 's/[ 	|].*//' | sort | uniq >>lib.exp

# If we're linking a .a file, then link all the objects together into a
# single file "shr.o" and then put that into the archive.  Otherwise link
# If we're linking a .a file, then link all the objects together into a 
# single file "shr.o" and then put that into the archive.  Otherwise link 
# the object files directly into the .a file.

noDotA=`echo $outputFile | sed -e '/\.a$/d'`
echo "noDotA=\"$noDotA\""
if test "$noDotA" = "" ; then
    linkArgs=`echo $args | sed -e 's/-o .*\.a /-o shr.o /'`
    echo $linkArgs

Changes to unix/tcl.m4.

24
25
26
27
28
29
30
31

32
33

34
35
36
37
38
39
40
24
25
26
27
28
29
30

31
32

33
34
35
36
37
38
39
40







-
+

-
+







    # the alternative search directory is invoked by --with-tcl
    #

    if test x"${no_tcl}" = x ; then
	# we reset no_tcl in case something fails here
	no_tcl=true
	AC_ARG_WITH(tcl,
	    AC_HELP_STRING([--with-tcl],
	    AS_HELP_STRING([--with-tcl],
		[directory containing tcl configuration (tclConfig.sh)]),
	    with_tclconfig="${withval}")
	    [with_tclconfig="${withval}"])
	AC_MSG_CHECKING([for Tcl configuration])
	AC_CACHE_VAL(ac_cv_c_tclconfig,[

	    # First check to see if --with-tcl was specified.
	    if test x"${with_tclconfig}" != x ; then
		case "${with_tclconfig}" in
		    */tclConfig.sh )
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
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







+
















-
+


-
-
+
+
















-
-
-
+
+
+







	    fi

	    # on Darwin, check in Framework installation locations
	    if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tclconfig}" = x ; then
		for i in `ls -d ~/Library/Frameworks 2>/dev/null` \
			`ls -d /Library/Frameworks 2>/dev/null` \
			`ls -d /Network/Library/Frameworks 2>/dev/null` \
			`ls -d /System/Library/Frameworks 2>/dev/null` \
			; do
		    if test -f "$i/Tcl.framework/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i/Tcl.framework; pwd)`"
			break
		    fi
		done
	    fi

	    # check in a few common install locations
	    if test x"${ac_cv_c_tclconfig}" = x ; then
		for i in `ls -d ${libdir} 2>/dev/null` \
			`ls -d ${exec_prefix}/lib 2>/dev/null` \
			`ls -d ${prefix}/lib 2>/dev/null` \
			`ls -d /usr/local/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/pkg/lib 2>/dev/null` \
			`ls -d /usr/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/lib/tcl8.5 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/local/lib/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \
			`ls -d /usr/local/lib/tcl8.5 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tcl8.5 2>/dev/null` \
			; do
		    if test -f "$i/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i; pwd)`"
			break
		    fi
		done
	    fi

	    # check in a few other private locations
	    if test x"${ac_cv_c_tclconfig}" = x ; then
		for i in \
			${srcdir}/../tcl \
			`ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]].[[0-9]]* 2>/dev/null` \
			`ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]] 2>/dev/null` \
			`ls -dr ${srcdir}/../tcl[[8-9]].[[0-9]]* 2>/dev/null` ; do
		    if test -f "$i/unix/tclConfig.sh" ; then
			ac_cv_c_tclconfig="`(cd $i/unix; pwd)`"
			break
		    fi
		    ac_cv_c_tclconfig="`(cd $i/unix; pwd)`"
		    break
		fi
		done
	    fi
	])

	if test x"${ac_cv_c_tclconfig}" = x ; then
	    TCL_BIN_DIR="# no Tcl configs found"
	    AC_MSG_ERROR([Can't find Tcl configuration definitions. Use --with-tcl to specify a directory containing tclConfig.sh])
157
158
159
160
161
162
163
164

165
166

167
168
169
170
171
172
173
158
159
160
161
162
163
164

165
166

167
168
169
170
171
172
173
174







-
+

-
+







    # the alternative search directory is invoked by --with-tk
    #

    if test x"${no_tk}" = x ; then
	# we reset no_tk in case something fails here
	no_tk=true
	AC_ARG_WITH(tk,
	    AC_HELP_STRING([--with-tk],
	    AS_HELP_STRING([--with-tk],
		[directory containing tk configuration (tkConfig.sh)]),
	    with_tkconfig="${withval}")
	    [with_tkconfig="${withval}"])
	AC_MSG_CHECKING([for Tk configuration])
	AC_CACHE_VAL(ac_cv_c_tkconfig,[

	    # First check to see if --with-tkconfig was specified.
	    if test x"${with_tkconfig}" != x ; then
		case "${with_tkconfig}" in
		    */tkConfig.sh )
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
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







+
















-
+


-
-
+
+







	    fi

	    # on Darwin, check in Framework installation locations
	    if test "`uname -s`" = "Darwin" -a x"${ac_cv_c_tkconfig}" = x ; then
		for i in `ls -d ~/Library/Frameworks 2>/dev/null` \
			`ls -d /Library/Frameworks 2>/dev/null` \
			`ls -d /Network/Library/Frameworks 2>/dev/null` \
			`ls -d /System/Library/Frameworks 2>/dev/null` \
			; do
		    if test -f "$i/Tk.framework/tkConfig.sh" ; then
			ac_cv_c_tkconfig="`(cd $i/Tk.framework; pwd)`"
			break
		    fi
		done
	    fi

	    # check in a few common install locations
	    if test x"${ac_cv_c_tkconfig}" = x ; then
		for i in `ls -d ${libdir} 2>/dev/null` \
			`ls -d ${exec_prefix}/lib 2>/dev/null` \
			`ls -d ${prefix}/lib 2>/dev/null` \
			`ls -d /usr/local/lib 2>/dev/null` \
			`ls -d /usr/contrib/lib 2>/dev/null` \
			`ls -d /usr/pkg/lib 2>/dev/null` \
			`ls -d /usr/lib/tk8.7 2>/dev/null` \
			`ls -d /usr/lib/tk8.5 2>/dev/null` \
			`ls -d /usr/lib 2>/dev/null` \
			`ls -d /usr/lib64 2>/dev/null` \
			`ls -d /usr/local/lib/tk8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \
			`ls -d /usr/local/lib/tk8.5 2>/dev/null` \
			`ls -d /usr/local/lib/tcl/tk8.5 2>/dev/null` \
			; do
		    if test -f "$i/tkConfig.sh" ; then
			ac_cv_c_tkconfig="`(cd $i; pwd)`"
			break
		    fi
		done
	    fi
288
289
290
291
292
293
294




295
296
297
298
299
300
301
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307







+
+
+
+








    if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then
        AC_MSG_RESULT([loading])
	. "${TCL_BIN_DIR}/tclConfig.sh"
    else
        AC_MSG_RESULT([could not find ${TCL_BIN_DIR}/tclConfig.sh])
    fi

    # eval is required to do the TCL_DBGX substitution
    eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
    eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""

    # If the TCL_BIN_DIR is the build directory (not the install directory),
    # then set the common variable name to the value of the build variables.
    # For example, the variable TCL_LIB_SPEC will be set to the value
    # of TCL_BUILD_LIB_SPEC. An extension should make use of TCL_LIB_SPEC
    # instead of TCL_BUILD_LIB_SPEC since it will work with both an
    # installed and uninstalled version of Tcl.
321
322
323
324
325
326
327






328
329
330
331
332
333
334
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346







+
+
+
+
+
+







		if test -f "${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"; then
		    TCL_STUB_LIB_SPEC="-L`echo "${TCL_BIN_DIR}"  | sed -e 's/ /\\\\ /g'` ${TCL_STUB_LIB_FLAG}"
		    TCL_STUB_LIB_PATH="${TCL_BIN_DIR}/${TCL_STUB_LIB_FILE}"
		fi
		;;
	esac
    fi

    # eval is required to do the TCL_DBGX substitution
    eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
    eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
    eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
    eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""

    AC_SUBST(TCL_VERSION)
    AC_SUBST(TCL_PATCH_LEVEL)
    AC_SUBST(TCL_BIN_DIR)
    AC_SUBST(TCL_SRC_DIR)

    AC_SUBST(TCL_LIB_FILE)
361
362
363
364
365
366
367




368
369
370
371
372
373
374
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390







+
+
+
+








    if test -f "${TK_BIN_DIR}/tkConfig.sh" ; then
        AC_MSG_RESULT([loading])
	. "${TK_BIN_DIR}/tkConfig.sh"
    else
        AC_MSG_RESULT([could not find ${TK_BIN_DIR}/tkConfig.sh])
    fi

    # eval is required to do the TK_DBGX substitution
    eval "TK_LIB_FILE=\"${TK_LIB_FILE}\""
    eval "TK_STUB_LIB_FILE=\"${TK_STUB_LIB_FILE}\""

    # If the TK_BIN_DIR is the build directory (not the install directory),
    # then set the common variable name to the value of the build variables.
    # For example, the variable TK_LIB_SPEC will be set to the value
    # of TK_BUILD_LIB_SPEC. An extension should make use of TK_LIB_SPEC
    # instead of TK_BUILD_LIB_SPEC since it will work with both an
    # installed and uninstalled version of Tcl.
394
395
396
397
398
399
400






401
402
403
404
405
406
407
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429







+
+
+
+
+
+







		if test -f "${TK_BIN_DIR}/${TK_STUB_LIB_FILE}"; then
		    TK_STUB_LIB_SPEC="-L` echo "${TK_BIN_DIR}"  | sed -e 's/ /\\\\ /g'` ${TK_STUB_LIB_FLAG}"
		    TK_STUB_LIB_PATH="${TK_BIN_DIR}/${TK_STUB_LIB_FILE}"
		fi
		;;
	esac
    fi

    # eval is required to do the TK_DBGX substitution
    eval "TK_LIB_FLAG=\"${TK_LIB_FLAG}\""
    eval "TK_LIB_SPEC=\"${TK_LIB_SPEC}\""
    eval "TK_STUB_LIB_FLAG=\"${TK_STUB_LIB_FLAG}\""
    eval "TK_STUB_LIB_SPEC=\"${TK_STUB_LIB_SPEC}\""

    AC_SUBST(TK_VERSION)
    AC_SUBST(TK_BIN_DIR)
    AC_SUBST(TK_SRC_DIR)

    AC_SUBST(TK_LIB_FILE)
    AC_SUBST(TK_LIB_FLAG)
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
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







-
+


-
-
-
-
-
-
-
-








-







#	Sets the following vars:
#		SHARED_BUILD	Value of 1 or 0
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_SHARED], [
    AC_MSG_CHECKING([how to build libraries])
    AC_ARG_ENABLE(shared,
	AC_HELP_STRING([--enable-shared],
	AS_HELP_STRING([--enable-shared],
	    [build and link with shared libraries (default: on)]),
	[tcl_ok=$enableval], [tcl_ok=yes])

    if test "${enable_shared+set}" = set; then
	enableval="$enable_shared"
	tcl_ok=$enableval
    else
	tcl_ok=yes
    fi

    if test "$tcl_ok" = "yes" ; then
	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi
    AC_SUBST(SHARED_BUILD)
])

#------------------------------------------------------------------------
# SC_ENABLE_FRAMEWORK --
#
#	Allows the building of shared libraries into frameworks
#
547
548
549
550
551
552
553
554

555
556
557
558
559
560
561
560
561
562
563
564
565
566

567
568
569
570
571
572
573
574







-
+







#		FRAMEWORK_BUILD	Value of 1 or 0
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_FRAMEWORK], [
    if test "`uname -s`" = "Darwin" ; then
	AC_MSG_CHECKING([how to package libraries])
	AC_ARG_ENABLE(framework,
	    AC_HELP_STRING([--enable-framework],
	    AS_HELP_STRING([--enable-framework],
		[package shared libraries in MacOSX frameworks (default: off)]),
	    [enable_framework=$enableval], [enable_framework=no])
	if test $enable_framework = yes; then
	    if test $SHARED_BUILD = 0; then
		AC_MSG_WARN([Frameworks can only be built if --enable-shared is yes])
		enable_framework=no
	    fi
573
574
575
576
577
578
579













































































































































580
581
582
583
584
585
586
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
618
619
620
621
622
623
624
625
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    else
		AC_MSG_RESULT([static library])
	    fi
	    FRAMEWORK_BUILD=0
	fi
    fi
])

#------------------------------------------------------------------------
# SC_ENABLE_THREADS --
#
#	Specify if thread support should be enabled
#
# Arguments:
#	none
#
# Results:
#
#	Adds the following arguments to configure:
#		--enable-threads
#
#	Sets the following vars:
#		THREADS_LIBS	Thread library(s)
#
#	Defines the following vars:
#		TCL_THREADS
#		_REENTRANT
#		_THREAD_SAFE
#
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_THREADS], [
    AC_ARG_ENABLE(threads,
	AS_HELP_STRING([--enable-threads],
	    [build with threads (default: off)]),
	[tcl_ok=$enableval], [tcl_ok=no])

    if test "${TCL_THREADS}" = 1; then
	tcl_threaded_core=1;
    fi

    if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then
	TCL_THREADS=1
	# USE_THREAD_ALLOC tells us to try the special thread-based
	# allocator that significantly reduces lock contention
	AC_DEFINE(USE_THREAD_ALLOC, 1,
	    [Do we want to use the threaded memory allocator?])
	AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
	if test "`uname -s`" = "SunOS" ; then
	    AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1,
		    [Do we really want to follow the standard? Yes we do!])
	fi
	AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?])
	AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
	if test "$tcl_ok" = "no"; then
	    # Check a little harder for __pthread_mutex_init in the same
	    # library, as some systems hide it there until pthread.h is
	    # defined.  We could alternatively do an AC_TRY_COMPILE with
	    # pthread.h, but that will work with libpthread really doesn't
	    # exist, like AIX 4.2.  [Bug: 4359]
	    AC_CHECK_LIB(pthread, __pthread_mutex_init,
		tcl_ok=yes, tcl_ok=no)
	fi

	if test "$tcl_ok" = "yes"; then
	    # The space is needed
	    THREADS_LIBS=" -lpthread"
	else
	    AC_CHECK_LIB(pthreads, pthread_mutex_init,
		tcl_ok=yes, tcl_ok=no)
	    if test "$tcl_ok" = "yes"; then
		# The space is needed
		THREADS_LIBS=" -lpthreads"
	    else
		AC_CHECK_LIB(c, pthread_mutex_init,
		    tcl_ok=yes, tcl_ok=no)
		if test "$tcl_ok" = "no"; then
		    AC_CHECK_LIB(c_r, pthread_mutex_init,
			tcl_ok=yes, tcl_ok=no)
		    if test "$tcl_ok" = "yes"; then
			# The space is needed
			THREADS_LIBS=" -pthread"
		    else
			TCL_THREADS=0
			AC_MSG_WARN([Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile...])
		    fi
		fi
	    fi
	fi

	# Does the pthread-implementation provide
	# 'pthread_attr_setstacksize' ?

	ac_saved_libs=$LIBS
	LIBS="$LIBS $THREADS_LIBS"
	AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
	AC_CHECK_FUNC(pthread_attr_get_np,tcl_ok=yes,tcl_ok=no)
	if test $tcl_ok = yes ; then
	    AC_DEFINE(HAVE_PTHREAD_ATTR_GET_NP, 1,
		[Do we want a BSD-like thread-attribute interface?])
	    AC_CACHE_CHECK([for pthread_attr_get_np declaration],
		tcl_cv_grep_pthread_attr_get_np, [
		AC_EGREP_HEADER(pthread_attr_get_np, pthread.h,
		    tcl_cv_grep_pthread_attr_get_np=present,
		    tcl_cv_grep_pthread_attr_get_np=missing)])
	    if test $tcl_cv_grep_pthread_attr_get_np = missing ; then
		AC_DEFINE(ATTRGETNP_NOT_DECLARED, 1,
		    [Is pthread_attr_get_np() declared in <pthread.h>?])
	    fi
	else
	    AC_CHECK_FUNC(pthread_getattr_np,tcl_ok=yes,tcl_ok=no)
	    if test $tcl_ok = yes ; then
		AC_DEFINE(HAVE_PTHREAD_GETATTR_NP, 1,
		    [Do we want a Linux-like thread-attribute interface?])
		AC_CACHE_CHECK([for pthread_getattr_np declaration],
		    tcl_cv_grep_pthread_getattr_np, [
		    AC_EGREP_HEADER(pthread_getattr_np, pthread.h,
			tcl_cv_grep_pthread_getattr_np=present,
			tcl_cv_grep_pthread_getattr_np=missing)])
		if test $tcl_cv_grep_pthread_getattr_np = missing ; then
		    AC_DEFINE(GETATTRNP_NOT_DECLARED, 1,
			[Is pthread_getattr_np declared in <pthread.h>?])
		fi
	    fi
	fi
	if test $tcl_ok = no; then
	    # Darwin thread stacksize API
	    AC_CHECK_FUNCS(pthread_get_stacksize_np)
	fi
	LIBS=$ac_saved_libs
    else
	TCL_THREADS=0
    fi
    # Do checking message here to not mess up interleaved configure output
    AC_MSG_CHECKING([for building with threads])
    if test "${TCL_THREADS}" = 1; then
	AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?])
	if test "${tcl_threaded_core}" = 1; then
	    AC_MSG_RESULT([yes (threaded core)])
	else
	    AC_MSG_RESULT([yes])
	fi
    else
	AC_MSG_RESULT([no (default)])
    fi

    AC_SUBST(TCL_THREADS)
])

#------------------------------------------------------------------------
# SC_ENABLE_SYMBOLS --
#
#	Specify if debugging symbols should be used.
#	Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging
#	can also be enabled.
600
601
602
603
604
605
606



607
608
609
610
611
612

613
614
615

616
617
618
619
620
621
622
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







+
+
+





-
+



+







#		--enable-symbols
#
#	Defines the following vars:
#		CFLAGS_DEFAULT	Sets to $(CFLAGS_DEBUG) if true
#				Sets to $(CFLAGS_OPTIMIZE) if false
#		LDFLAGS_DEFAULT	Sets to $(LDFLAGS_DEBUG) if true
#				Sets to $(LDFLAGS_OPTIMIZE) if false
#		DBGX		Formerly used as debug library extension;
#				always blank now.
#
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_SYMBOLS], [
    AC_MSG_CHECKING([for build with symbols])
    AC_ARG_ENABLE(symbols,
	AC_HELP_STRING([--enable-symbols],
	AS_HELP_STRING([--enable-symbols],
	    [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
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
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







-
+










-
-
+







#
#	Defines the following vars:
#		HAVE_LANGINFO	Triggers use of nl_langinfo if defined.
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_LANGINFO], [
    AC_ARG_ENABLE(langinfo,
	AC_HELP_STRING([--enable-langinfo],
	AS_HELP_STRING([--enable-langinfo],
	    [use nl_langinfo if possible to determine encoding at startup, otherwise use old heuristic (default: on)]),
	[langinfo_ok=$enableval], [langinfo_ok=yes])

    HAVE_LANGINFO=0
    if test "$langinfo_ok" = "yes"; then
	AC_CHECK_HEADER(langinfo.h,[langinfo_ok=yes],[langinfo_ok=no])
    fi
    AC_MSG_CHECKING([whether to use nl_langinfo])
    if test "$langinfo_ok" = "yes"; then
	AC_CACHE_VAL(tcl_cv_langinfo_h, [
	    AC_TRY_COMPILE([#include <langinfo.h>], [nl_langinfo(CODESET);],
		    [tcl_cv_langinfo_h=yes],[tcl_cv_langinfo_h=no])])
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <langinfo.h>]], [[nl_langinfo(CODESET);]])],[tcl_cv_langinfo_h=yes],[tcl_cv_langinfo_h=no])])
	AC_MSG_RESULT([$tcl_cv_langinfo_h])
	if test $tcl_cv_langinfo_h = yes; then
	    AC_DEFINE(HAVE_LANGINFO, 1, [Do we have nl_langinfo()?])
	fi
    else
	AC_MSG_RESULT([$langinfo_ok])
    fi
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
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







-
+

-
-
+
+




-
+






-
+













-
+






-
+










-
+
+








+




-
-
+
+






+
+
+
+
+
+







#			according to the user's selection.
#
#--------------------------------------------------------------------

AC_DEFUN([SC_CONFIG_MANPAGES], [
    AC_MSG_CHECKING([whether to use symlinks for manpages])
    AC_ARG_ENABLE(man-symlinks,
	AC_HELP_STRING([--enable-man-symlinks],
	AS_HELP_STRING([--enable-man-symlinks],
	    [use symlinks for the manpages (default: off)]),
	test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks",
	enableval="no")
	[test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks"],
	[enableval="no"])
    AC_MSG_RESULT([$enableval])

    AC_MSG_CHECKING([whether to compress the manpages])
    AC_ARG_ENABLE(man-compression,
	AC_HELP_STRING([--enable-man-compression=PROG],
	AS_HELP_STRING([--enable-man-compression=PROG],
	    [compress the manpages with PROG (default: off)]),
	[case $enableval in
	    yes) AC_MSG_ERROR([missing argument to --enable-man-compression]);;
	    no)  ;;
	    *)   MAN_FLAGS="$MAN_FLAGS --compress $enableval";;
	esac],
	enableval="no")
	[enableval="no"])
    AC_MSG_RESULT([$enableval])
    if test "$enableval" != "no"; then
	AC_MSG_CHECKING([for compressed file suffix])
	touch TeST
	$enableval TeST
	Z=`ls TeST* | sed 's/^....//'`
	rm -f TeST*
	MAN_FLAGS="$MAN_FLAGS --extension $Z"
	AC_MSG_RESULT([$Z])
    fi

    AC_MSG_CHECKING([whether to add a package name suffix for the manpages])
    AC_ARG_ENABLE(man-suffix,
	AC_HELP_STRING([--enable-man-suffix=STRING],
	AS_HELP_STRING([--enable-man-suffix=STRING],
	    [use STRING as a suffix to manpage file names (default: no, AC_PACKAGE_NAME if enabled without specifying STRING)]),
	[case $enableval in
	    yes) enableval="AC_PACKAGE_NAME" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";;
	    no)  ;;
	    *)   MAN_FLAGS="$MAN_FLAGS --suffix $enableval";;
	esac],
	enableval="no")
	[enableval="no"])
    AC_MSG_RESULT([$enableval])

    AC_SUBST(MAN_FLAGS)
])

#--------------------------------------------------------------------
# SC_CONFIG_SYSTEM
#
#	Determine what the system is (some things cannot be easily checked
#	on a feature-driven basis, alas). This can usually be done via the
#	"uname" command.
#	"uname" command, but there are a few systems, like Next, where
#	this doesn't work.
#
# Arguments:
#	none
#
# Results:
#	Defines the following var:
#
#	system -	System/platform/version identification code.
#
#--------------------------------------------------------------------

AC_DEFUN([SC_CONFIG_SYSTEM], [
    AC_CACHE_CHECK([system version], tcl_cv_sys_version, [
	if test "${TEA_PLATFORM}" = "windows" ; then
	    tcl_cv_sys_version=windows
	if test -f /usr/lib/NextStep/software_version; then
	    tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
	else
	    tcl_cv_sys_version=`uname -s`-`uname -r`
	    if test "$?" -ne 0 ; then
		AC_MSG_WARN([can't find uname command])
		tcl_cv_sys_version=unknown
	    else
		# Special check for weird MP-RAS system (uname returns weird
		# results, and the version is kept in special file).

		if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
		    tcl_cv_sys_version=MP-RAS-`awk '{print $[3]}' /etc/.relid`
		fi
		if test "`uname -s`" = "AIX" ; then
		    tcl_cv_sys_version=AIX-`uname -v`.`uname -r`
		fi
		if test "`uname -s`" = "NetBSD" -a -f /etc/debian_version ; then
		    tcl_cv_sys_version=NetBSD-Debian
		fi
	    fi
843
844
845
846
847
848
849
850

851
852
853
854


855
856
857
858
859
860
861
1008
1009
1010
1011
1012
1013
1014

1015
1016
1017


1018
1019
1020
1021
1022
1023
1024
1025
1026







-
+


-
-
+
+







#                       of a shared library (may request position-independent
#                       code, among other things).
#       SHLIB_LD -      Base command to use for combining object files
#                       into a shared library.
#       SHLIB_LD_LIBS - Dependent libraries for the linker to scan when
#                       creating shared libraries.  This symbol typically
#                       goes at the end of the "ld" commands that build
#                       shared libraries. The value of the symbol defaults to
#                       shared libraries. The value of the symbol is
#                       "${LIBS}" if all of the dependent libraries should
#                       be specified when creating a shared library.  If
#                       dependent libraries should not be specified (as on some
#                       SunOS systems, where they cause the link to fail, or in
#                       dependent libraries should not be specified (as on
#                       SunOS 4.x, where they cause the link to fail, or in
#                       general if Tcl and Tk aren't themselves shared
#                       libraries), then this symbol has an empty string
#                       as its value.
#       SHLIB_SUFFIX -  Suffix to use for the names of dynamically loadable
#                       extensions.  An empty string means we don't know how
#                       to use shared libraries on this platform.
# TCL_SHLIB_LD_EXTRAS - Additional element which are added to SHLIB_LD_LIBS
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
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
1140
1141
1142

1143
1144

1145
1146
1147
1148
1149
1150
1151
1152







-
+








-
+












-
+

+
-
-
+
+





-






-
+















+


















+

-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-






-


-
+








AC_DEFUN([SC_CONFIG_CFLAGS], [

    # Step 0.a: Enable 64 bit support?

    AC_MSG_CHECKING([if 64bit support is requested])
    AC_ARG_ENABLE(64bit,
	AC_HELP_STRING([--enable-64bit],
	AS_HELP_STRING([--enable-64bit],
	    [enable 64bit support (default: off)]),
	[do64bit=$enableval], [do64bit=no])
    AC_MSG_RESULT([$do64bit])

    # Step 0.b: Enable Solaris 64 bit VIS support?

    AC_MSG_CHECKING([if 64bit Sparc VIS support is requested])
    AC_ARG_ENABLE(64bit-vis,
	AC_HELP_STRING([--enable-64bit-vis],
	AS_HELP_STRING([--enable-64bit-vis],
	    [enable 64bit Sparc VIS support (default: off)]),
	[do64bitVIS=$enableval], [do64bitVIS=no])
    AC_MSG_RESULT([$do64bitVIS])
    # Force 64bit on with VIS
    AS_IF([test "$do64bitVIS" = "yes"], [do64bit=yes])

    # Step 0.c: Check if visibility support is available. Do this here so
    # that platform specific alternatives can be used below if this fails.

    AC_CACHE_CHECK([if compiler supports visibility "hidden"],
	tcl_cv_cc_visibility_hidden, [
	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
	AC_TRY_LINK([
	AC_LINK_IFELSE([AC_LANG_PROGRAM([[
	    extern __attribute__((__visibility__("hidden"))) void f(void);
	    void f(void) {}]], [[f();]])],
	    void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes,
	    tcl_cv_cc_visibility_hidden=no)
	    [tcl_cv_cc_visibility_hidden=yes],
	    [tcl_cv_cc_visibility_hidden=no])
	CFLAGS=$hold_cflags])
    AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [
	AC_DEFINE(MODULE_SCOPE,
	    [extern __attribute__((__visibility__("hidden")))],
	    [Compiler support for module scope symbols])
	AC_DEFINE(HAVE_HIDDEN, [1], [Compiler support for module scope symbols])
    ])

    # Step 0.d: Disable -rpath support?

    AC_MSG_CHECKING([if rpath support is requested])
    AC_ARG_ENABLE(rpath,
	AC_HELP_STRING([--disable-rpath],
	AS_HELP_STRING([--disable-rpath],
	    [disable rpath support (default: on)]),
	[doRpath=$enableval], [doRpath=yes])
    AC_MSG_RESULT([$doRpath])

    # Step 1: set the variable "system" to hold the name and version number
    # for the system.

    SC_CONFIG_SYSTEM

    # Step 2: check for existence of -ldl library.  This is needed because
    # Linux can use either -ldl or -ldld for dynamic loading.

    AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)

    # Require ranlib early so we can override it in special cases below.
    AS_IF([test x"${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])

    AC_REQUIRE([AC_PROG_RANLIB])

    # Step 3: set configuration options based on system name and version.

    do64bit_ok=no
    # default to '{$LIBS}' and set to "" on per-platform necessary basis
    SHLIB_LD_LIBS='${LIBS}'
    LDFLAGS_ORIG="$LDFLAGS"
    # When ld needs options to work in 64-bit mode, put them in
    # LDFLAGS_ARCH so they eventually end up in LDFLAGS even if [load]
    # is disabled by the user. [Bug 1016796]
    LDFLAGS_ARCH=""
    UNSHARED_LIB_SUFFIX=""
    TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
    ECHO_VERSION='`echo ${VERSION}`'
    TCL_LIB_VERSIONS_OK=ok
    CFLAGS_DEBUG=-g
    CFLAGS_OPTIMIZE=-O
    AS_IF([test "$GCC" = yes], [
	CFLAGS_OPTIMIZE=-O2
	CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith"
	CFLAGS_WARNING="-Wall -Wpointer-arith"
	case "${CC}" in
	    *++|*++-*)
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac

    ], [
	CFLAGS_OPTIMIZE=-O
	CFLAGS_WARNING=""
    ], [CFLAGS_WARNING=""])
    ])
    AC_CHECK_TOOL(AR, ar)
    STLIB_LD='${AR} cr'
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
    PLAT_OBJS=""
    PLAT_SRCS=""
    LDAIX_SRC=""
    AS_IF([test "x${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])
    case $system in
	AIX-*)
	    AS_IF([test "$GCC" != "yes"], [
	    AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [
		# AIX requires the _r compiler when gcc isn't being used
		case "${CC}" in
		    *_r|*_r\ *)
			# ok ...
			;;
		    *)
			# Make sure only first arg gets _r
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
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







-
-
+
+


-
+
-
-




-
+



-
+



-
-
-
+
+
+




+
+
+


-
+

-
+







	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*)
	    SHLIB_CFLAGS="-fno-common"
	CYGWIN_*|MINGW32_*|MSYS_*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    DL_OBJS="tclLoadDl.o tclWinError.o"
	    PLAT_OBJS='${CYGWIN_OBJS}'
	    PLAT_SRCS='${CYGWIN_SRCS}'
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}.dll.a'
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$[@].a"
	    AC_CACHE_CHECK(for Cygwin version of gcc,
		ac_cv_cygwin,
		AC_TRY_COMPILE([
		AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#ifdef __CYGWIN__
		    #error cygwin
		#endif
		], [],
		ac_cv_cygwin=no,
		ac_cv_cygwin=yes)
		]], [[]])],
		[ac_cv_cygwin=no],
		[ac_cv_cygwin=yes])
	    )
	    if test "$ac_cv_cygwin" = "no"; then
		AC_MSG_ERROR([${CC} is not a cygwin compiler.])
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
	    fi
	    do64bit_ok=yes
	    if test "x${SHARED_BUILD}" = "x1"; then
		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		echo "running cd ${TCL_SRC_DIR}/win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		# The eval makes quoting arguments work.
		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		if cd ${TCL_SRC_DIR}/win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		then :
		else
		    { echo "configure: error: configure failed for ../win" 1>&2; exit 1; }
		fi
	    fi
	    ;;
	dgux*)
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
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







-
-














-
+







		CC_SEARCH_FLAGS='-Wl,+s,+b,${LIB_RUNTIME_DIR}:.'
		LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.'
		LD_LIBRARY_PATH_VAR="SHLIB_PATH"
	    ])
	    AS_IF([test "$GCC" = yes], [
		SHLIB_LD='${CC} -shared'
		LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    ], [
		CFLAGS="$CFLAGS -z"
	    ])

	    # Users may want PA-RISC 1.1/2.0 portable code - needs HP cc
	    #CFLAGS="$CFLAGS +DAportable"

	    # Check to enable 64-bit flags for compiler/linker
	    AS_IF([test "$do64bit" = "yes"], [
		AS_IF([test "$GCC" = yes], [
		    case `${CC} -dumpmachine` in
			hppa64*)
			    # 64-bit gcc in use.  Fix flags for GNU ld.
			    do64bit_ok=yes
			    SHLIB_LD='${CC} -shared'
			    AS_IF([test $doRpath = yes], [
				CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
				CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
			    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
			    ;;
			*)
			    AC_MSG_WARN([64bit mode not supported with GCC on $system])
			    ;;
		    esac
		], [
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
1362
1363
1364
1365
1366
1367
1368

1369

1370
1371
1372
1373
1374
1375
1376
1377
1378

1379

1380
1381
1382
1383
1384
1385
1386
1387







-

-
+








-

-
+







	    ]) ;;
	IRIX-5.*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD="ld -shared -rdata_shared"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    AC_LIBOBJ(mkstemp)
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
	    ;;
	IRIX-6.*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD="ld -n32 -shared -rdata_shared"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    AC_LIBOBJ(mkstemp)
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
	    AS_IF([test "$GCC" = yes], [
		CFLAGS="$CFLAGS -mabi=n32"
		LDFLAGS="$LDFLAGS -mabi=n32"
	    ], [
		case $system in
		    IRIX-6.3)
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
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
1385
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
1439
1440
1441
1442

1443
1444
1445
1446
1447
1448
1449
1450
1451

1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477


1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502





1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531





1532









1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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







-

-
+
















-
+













-
+






-
+








-
+















+
+
+
+
+
+
+
+
+
+
-
-
+
+

+
+
+
+
+
+
+
+
+
+
+



+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+













-
+

+
-
-
-
-
+
+
+
+
+



+






-
-
-
-
-
-
+
+
+
+
+
+
+







	    ;;
	IRIX64-6.*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD="ld -n32 -shared -rdata_shared"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    AC_LIBOBJ(mkstemp)
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])

	    # Check to enable 64-bit flags for compiler/linker

	    AS_IF([test "$do64bit" = yes], [
	        AS_IF([test "$GCC" = yes], [
	            AC_MSG_WARN([64bit mode not supported by gcc])
	        ], [
	            do64bit_ok=yes
	            SHLIB_LD="ld -64 -shared -rdata_shared"
	            CFLAGS="$CFLAGS -64"
	            LDFLAGS_ARCH="-64"
	        ])
	    ])
	    ;;
	Linux*|GNU*|NetBSD-Debian)
	    SHLIB_CFLAGS="-fPIC -fno-common"
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_SUFFIX=".so"

	    CFLAGS_OPTIMIZE="-O2"
	    # egcs-2.91.66 on Redhat Linux 6.0 generates lots of warnings
	    # when you inline the string and math operations.  Turn this off to
	    # get rid of the warnings.
	    #CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"

	    SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"])
	    AS_IF([test $do64bit = yes], [
		AC_CACHE_CHECK([if compiler accepts -m64 flag], tcl_cv_cc_m64, [
		    hold_cflags=$CFLAGS
		    CFLAGS="$CFLAGS -m64"
		    AC_TRY_LINK(,, tcl_cv_cc_m64=yes, tcl_cv_cc_m64=no)
		    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],[tcl_cv_cc_m64=yes],[tcl_cv_cc_m64=no])
		    CFLAGS=$hold_cflags])
		AS_IF([test $tcl_cv_cc_m64 = yes], [
		    CFLAGS="$CFLAGS -m64"
		    do64bit_ok=yes
		])
	   ])

	    # The combo of gcc + glibc has a bug related to inlining of
	    # functions like strtol()/strtoul(). The -fno-builtin flag should address
	    # functions like strtod(). The -fno-builtin flag should address
	    # this problem but it does not work. The -fno-inline flag is kind
	    # of overkill but it works. Disable inlining only when one of the
	    # files in compat/*.c is being linked in.

	    AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"])
	    ;;
	Lynx*)
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_SUFFIX=".so"
	    CFLAGS_OPTIMIZE=-02
	    SHLIB_LD='${CC} -shared'
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-mshared -ldl"
	    LD_FLAGS="-Wl,--export-dynamic"
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    ;;
	MP-RAS-02*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
		LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	MP-RAS-*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -Wl,-Bexport"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	OpenBSD-*)
	    arch=`arch -s`
	    case "$arch" in
	    vax)
		# Equivalent using configure option --disable-load
		# Step 4 will set the necessary variables
		DL_OBJS=""
		SHLIB_LD_LIBS=""
		;;
	    *)
		case "$arch" in
	    alpha|sparc64)
		SHLIB_CFLAGS="-fPIC"
		;;
	    *)
		SHLIB_CFLAGS="-fpic"
		alpha|sparc|sparc64)
		    SHLIB_CFLAGS="-fPIC"
		    ;;
		*)
		    SHLIB_CFLAGS="-fpic"
		    ;;
		esac
		SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
		SHLIB_SUFFIX=".so"
		DL_OBJS="tclLoadDl.o"
		DL_LIBS=""
		AS_IF([test $doRpath = yes], [
		    CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
		LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
		LDFLAGS="$LDFLAGS -Wl,-export-dynamic"
		;;
	    esac
	    case "$arch" in
	    vax)
		CFLAGS_OPTIMIZE="-O1"
		;;
	    sh)
		CFLAGS_OPTIMIZE="-O0"
		;;
	    *)
		CFLAGS_OPTIMIZE="-O2"
		;;
	    esac
	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    LDFLAGS="-Wl,-export-dynamic"
	    CFLAGS_OPTIMIZE="-O2"
	    # On OpenBSD:	Compile with -pthread
	    #		Don't link with -lpthread
	    LIBS=`echo $LIBS | sed s/-lpthread//`
	    CFLAGS="$CFLAGS -pthread"
		# On OpenBSD:	Compile with -pthread
		#		Don't link with -lpthread
		LIBS=`echo $LIBS | sed s/-lpthread//`
		CFLAGS="$CFLAGS -pthread"
	    ])
	    # OpenBSD doesn't do version numbers with dots.
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	NetBSD-*)
	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD='${CC} ${SHLIB_CFLAGS} -shared'
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    AS_IF([test "${TCL_THREADS}" = "1"], [
	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"
		# The -pthread needs to go in the CFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS -pthread"
	    	LDFLAGS="$LDFLAGS -pthread"
	    ])
	    ;;
	DragonFly-*|FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
		LD_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'])
	    # The -pthread needs to go in the LDFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
	    LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		# The -pthread needs to go in the LDFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"])
	    case $system in
	    FreeBSD-3.*)
		# Version numbers are dot-stripped by system policy.
		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
		TCL_LIB_VERSIONS_OK=nodots
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
1439
1440

1441
1442
1443
1444
1445
1446
1447




1448
1449
1450
1451
1452

1453
1454


1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472

1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492




1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512




1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523










1524
1525
1526
1527
1528

























1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542

1543
1544
1545
1546

1547
1548
1549
1550
1551
1552
1553
1554









1555
1556
1557
1558
1559

1560
1561
1562
1563
1564
1565
1566
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
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
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
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







+
-
-
+
+










+
-
-
+
+


















-
+







+
+
+
+





+
-
-
+
+







-









-
+
















-
-
-
-
+
+
+
+
















-
-
-
-
+
+
+
+











+
+
+
+
+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
+




+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+





+







	    AS_IF([test $do64bit = yes], [
		case `arch` in
		    ppc)
			AC_CACHE_CHECK([if compiler accepts -arch ppc64 flag],
				tcl_cv_cc_arch_ppc64, [
			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5"
			    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
			    AC_TRY_LINK(,, tcl_cv_cc_arch_ppc64=yes,
				    tcl_cv_cc_arch_ppc64=no)
				    [tcl_cv_cc_arch_ppc64=yes],
				    [tcl_cv_cc_arch_ppc64=no])
			    CFLAGS=$hold_cflags])
			AS_IF([test $tcl_cv_cc_arch_ppc64 = yes], [
			    CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5"
			    do64bit_ok=yes
			]);;
		    i386)
			AC_CACHE_CHECK([if compiler accepts -arch x86_64 flag],
				tcl_cv_cc_arch_x86_64, [
			    hold_cflags=$CFLAGS
			    CFLAGS="$CFLAGS -arch x86_64"
			    AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[]])],
			    AC_TRY_LINK(,, tcl_cv_cc_arch_x86_64=yes,
				    tcl_cv_cc_arch_x86_64=no)
				    [tcl_cv_cc_arch_x86_64=yes],
				    [tcl_cv_cc_arch_x86_64=no])
			    CFLAGS=$hold_cflags])
			AS_IF([test $tcl_cv_cc_arch_x86_64 = yes], [
			    CFLAGS="$CFLAGS -arch x86_64"
			    do64bit_ok=yes
			]);;
		    *)
			AC_MSG_WARN([Don't know how enable 64-bit on architecture `arch`]);;
		esac
	    ], [
		# Check for combined 32-bit and 64-bit fat build
		AS_IF([echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \
		    && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '], [
		    fat_32_64=yes])
	    ])
	    SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}'
	    AC_CACHE_CHECK([if ld accepts -single_module flag], tcl_cv_ld_single_module, [
		hold_ldflags=$LDFLAGS
		LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module"
		AC_TRY_LINK(, [int i;], tcl_cv_ld_single_module=yes, tcl_cv_ld_single_module=no)
		AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])],[tcl_cv_ld_single_module=yes],[tcl_cv_ld_single_module=no])
		LDFLAGS=$hold_ldflags])
	    AS_IF([test $tcl_cv_ld_single_module = yes], [
		SHLIB_LD="${SHLIB_LD} -Wl,-single_module"
	    ])
	    SHLIB_SUFFIX=".dylib"
	    DL_OBJS="tclLoadDyld.o"
	    DL_LIBS=""
	    # Don't use -prebind when building for Mac OS X 10.4 or later only:
	    AS_IF([test "`echo "${MACOSX_DEPLOYMENT_TARGET}" | awk -F '10\\.' '{print int([$]2)}'`" -lt 4 -a \
		"`echo "${CPPFLAGS}" | awk -F '-mmacosx-version-min=10\\.' '{print int([$]2)}'`" -lt 4], [
		LDFLAGS="$LDFLAGS -prebind"])
	    LDFLAGS="$LDFLAGS -headerpad_max_install_names"
	    AC_CACHE_CHECK([if ld accepts -search_paths_first flag],
		    tcl_cv_ld_search_paths_first, [
		hold_ldflags=$LDFLAGS
		LDFLAGS="$LDFLAGS -Wl,-search_paths_first"
		AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])],
		AC_TRY_LINK(, [int i;], tcl_cv_ld_search_paths_first=yes,
			tcl_cv_ld_search_paths_first=no)
			[tcl_cv_ld_search_paths_first=yes],
			[tcl_cv_ld_search_paths_first=no])
		LDFLAGS=$hold_ldflags])
	    AS_IF([test $tcl_cv_ld_search_paths_first = yes], [
		LDFLAGS="$LDFLAGS -Wl,-search_paths_first"
	    ])
	    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
		AC_DEFINE(MODULE_SCOPE, [__private_extern__],
		    [Compiler support for module scope symbols])
		tcl_cv_cc_visibility_hidden=yes
	    ])
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"
	    AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?])
	    PLAT_OBJS='${MAC_OSX_OBJS}'
	    PLAT_SRCS='${MAC_OSX_SRCS}'
	    AC_MSG_CHECKING([whether to use CoreFoundation])
	    AC_ARG_ENABLE(corefoundation,
		AC_HELP_STRING([--enable-corefoundation],
		AS_HELP_STRING([--enable-corefoundation],
		    [use CoreFoundation API on MacOSX (default: on)]),
		[tcl_corefoundation=$enableval], [tcl_corefoundation=yes])
	    AC_MSG_RESULT([$tcl_corefoundation])
	    AS_IF([test $tcl_corefoundation = yes], [
		AC_CACHE_CHECK([for CoreFoundation.framework],
			tcl_cv_lib_corefoundation, [
		    hold_libs=$LIBS
		    AS_IF([test "$fat_32_64" = yes], [
			for v in CFLAGS CPPFLAGS LDFLAGS; do
			    # On Tiger there is no 64-bit CF, so remove 64-bit
			    # archs from CFLAGS et al. while testing for
			    # presence of CF. 64-bit CF is disabled in
			    # tclUnixPort.h if necessary.
			    eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"'
			done])
		    LIBS="$LIBS -framework CoreFoundation"
		    AC_TRY_LINK([#include <CoreFoundation/CoreFoundation.h>],
			[CFBundleRef b = CFBundleGetMainBundle();],
			tcl_cv_lib_corefoundation=yes,
			tcl_cv_lib_corefoundation=no)
		    AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <CoreFoundation/CoreFoundation.h>]],
			[[CFBundleRef b = CFBundleGetMainBundle();]])],
			[tcl_cv_lib_corefoundation=yes],
			[tcl_cv_lib_corefoundation=no])
		    AS_IF([test "$fat_32_64" = yes], [
			for v in CFLAGS CPPFLAGS LDFLAGS; do
			    eval $v'="$hold_'$v'"'
		        done])
		    LIBS=$hold_libs])
		AS_IF([test $tcl_cv_lib_corefoundation = yes], [
		    LIBS="$LIBS -framework CoreFoundation"
		    AC_DEFINE(HAVE_COREFOUNDATION, 1,
			[Do we have access to Darwin CoreFoundation.framework?])
		], [tcl_corefoundation=no])
		AS_IF([test "$fat_32_64" = yes -a $tcl_corefoundation = yes],[
		    AC_CACHE_CHECK([for 64-bit CoreFoundation],
			    tcl_cv_lib_corefoundation_64, [
			for v in CFLAGS CPPFLAGS LDFLAGS; do
			    eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"'
			done
			AC_TRY_LINK([#include <CoreFoundation/CoreFoundation.h>],
			    [CFBundleRef b = CFBundleGetMainBundle();],
			    tcl_cv_lib_corefoundation_64=yes,
			    tcl_cv_lib_corefoundation_64=no)
			AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <CoreFoundation/CoreFoundation.h>]],
			    [[CFBundleRef b = CFBundleGetMainBundle();]])],
			    [tcl_cv_lib_corefoundation_64=yes],
			    [tcl_cv_lib_corefoundation_64=no])
			for v in CFLAGS CPPFLAGS LDFLAGS; do
			    eval $v'="$hold_'$v'"'
			done])
		    AS_IF([test $tcl_cv_lib_corefoundation_64 = no], [
			AC_DEFINE(NO_COREFOUNDATION_64, 1,
			    [Is Darwin CoreFoundation unavailable for 64-bit?])
                        LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings"
		    ])
		])
	    ])
	    ;;
	NEXTSTEP-*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -nostdlib -r'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadNext.o"
	    DL_LIBS=""
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	OS/390-*)
	    SHLIB_LD_LIBS=""
	    CFLAGS_OPTIMIZE=""		# Optimizer is buggy
	    AC_DEFINE(_OE_SOCKETS, 1,	# needed in sys/socket.h
		[Should OS/390 do the right thing with sockets?])
	    ;;
	OSF1-1.0|OSF1-1.1|OSF1-1.2)
	    # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
	    SHLIB_CFLAGS=""
	    # Hack: make package name same as library name
	    SHLIB_LD='ld -R -export $@:'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadOSF.o"
	    DL_LIBS=""
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	OSF1-1.*)
	    # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
	    SHLIB_CFLAGS="-fPIC"
	    AS_IF([test "$SHARED_BUILD" = 1], [SHLIB_LD="ld -shared"], [
	        SHLIB_LD="ld -non_shared"
	    ])
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	OSF1-V*)
	    # Digital OSF/1
	    SHLIB_CFLAGS=""
	    AS_IF([test "$SHARED_BUILD" = 1], [
	        SHLIB_LD='ld -shared -expect_unresolved "*"'
	    ], [
	        SHLIB_LD='ld -non_shared -expect_unresolved "*"'
	    ])
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='"-Wl,-rpath,${LIB_RUNTIME_DIR}"'
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
	    AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [
		CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"])
	    # see pthread_intro(3) for pthread support on osf1, k.furukawa
	    AS_IF([test "${TCL_THREADS}" = 1], [
	    CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
	    CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
	    LIBS=`echo $LIBS | sed s/-lpthreads//`
	    AS_IF([test "$GCC" = yes], [
		LIBS="$LIBS -lpthread -lmach -lexc"
	    ], [
		CFLAGS="$CFLAGS -pthread"
		LDFLAGS="$LDFLAGS -pthread"
		CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
		CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
		LIBS=`echo $LIBS | sed s/-lpthreads//`
		AS_IF([test "$GCC" = yes], [
		    LIBS="$LIBS -lpthread -lmach -lexc"
		], [
		    CFLAGS="$CFLAGS -pthread"
		    LDFLAGS="$LDFLAGS -pthread"
		])
	    ])
	    ;;
	QNX-6*)
	    # QNX RTP
	    # This may work for all QNX, but it was only reported for v6.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="ld -Bshareable -x"
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    # dlopen is in -lc on QNX
	    DL_LIBS=""
	    CC_SEARCH_FLAGS=""
1581
1582
1583
1584
1585
1586
1587





























1588
1589
1590
1591
1592
1593
1594
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	SINIX*5.4*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	SunOS-4*)
	    SHLIB_CFLAGS="-PIC"
	    SHLIB_LD="ld"
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}

	    # SunOS can't handle version numbers with dots in them in library
	    # specs, like -ltcl7.5, so use -ltcl75 instead.  Also, it
	    # requires an extra version number at the end of .so file names.
	    # So, the library has to have a name like libtcl75.so.1.0

	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	SunOS-5.[[0-6]])
	    # Careful to not let 5.10+ fall into this case

	    # Note: If _REENTRANT isn't defined, then Solaris
	    # won't define thread-safe library routines.

	    AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
1725
1726
1727
1728
1729
1730
1731
1732

1733
1734
1735
1736
1737
1738
1739
1995
1996
1997
1998
1999
2000
2001

2002
2003
2004
2005
2006
2007
2008
2009







-
+







	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    # Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
	    # that don't grok the -Bexport option.  Test that it does.
	    AC_CACHE_CHECK([for ld accepts -Bexport flag], tcl_cv_ld_Bexport, [
		hold_ldflags=$LDFLAGS
		LDFLAGS="$LDFLAGS -Wl,-Bexport"
		AC_TRY_LINK(, [int i;], tcl_cv_ld_Bexport=yes, tcl_cv_ld_Bexport=no)
		AC_LINK_IFELSE([AC_LANG_PROGRAM([[]], [[int i;]])],[tcl_cv_ld_Bexport=yes],[tcl_cv_ld_Bexport=no])
	        LDFLAGS=$hold_ldflags])
	    AS_IF([test $tcl_cv_ld_Bexport = yes], [
		LDFLAGS="$LDFLAGS -Wl,-Bexport"
	    ])
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
1752
1753
1754
1755
1756
1757
1758
1759

1760
1761
1762
1763
1764
1765
1766
2022
2023
2024
2025
2026
2027
2028

2029
2030
2031
2032
2033
2034
2035
2036







-
+







dnl # both CPPFLAGS and CFLAGS (unlike our compile and link) but configure's
dnl # preprocessing tests use only CPPFLAGS.
    AC_CONFIG_COMMANDS_PRE([CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""])

    # Step 4: disable dynamic loading if requested via a command-line switch.

    AC_ARG_ENABLE(load,
	AC_HELP_STRING([--enable-load],
	AS_HELP_STRING([--enable-load],
	    [allow dynamic loading and "load" command (default: on)]),
	[tcl_ok=$enableval], [tcl_ok=yes])
    AS_IF([test "$tcl_ok" = no], [DL_OBJS=""])

    AS_IF([test "x$DL_OBJS" != x], [BUILD_DLTEST="\$(DLTEST_TARGETS)"], [
	AC_MSG_WARN([Can't figure out how to do dynamic loading or shared libraries on this system.])
	SHLIB_CFLAGS=""
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
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
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







-
+
-
-

-
-
-
+
+




-
-
-
-
-








-
+











+


+

-





+


+

-














-
+
-


-
-
-
+
+
+






-
-







    # 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_*) ;;
	    CYGWIN_*|MINGW32_*|MSYS_*) ;;
	    HP_UX*) ;;
	    Darwin-*) ;;
	    IRIX*) ;;
	    Linux*|GNU*) ;;
	    NetBSD-*|OpenBSD-*) ;;
	    OSF1-V*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac])

    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
	AC_DEFINE(MODULE_SCOPE, [extern],
	    [No Compiler support for module scope symbols])
    ])

    AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [
	SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'])
    AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [
	UNSHARED_LIB_SUFFIX='${VERSION}.a'])
    DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"

    AS_IF([test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""], [
        LIB_SUFFIX=${SHARED_LIB_SUFFIX}
        MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${LDFLAGS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
        MAKE_LIB='${SHLIB_LD} -o [$]@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
        AS_IF([test "${SHLIB_SUFFIX}" = ".dll"], [
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
            DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
        ], [
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
        ])
    ], [
        LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}

        AS_IF([test "$RANLIB" = ""], [
            MAKE_LIB='$(STLIB_LD) [$]@ ${OBJS}'
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
        ], [
            MAKE_LIB='${STLIB_LD} [$]@ ${OBJS} ; ${RANLIB} [$]@'
            INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(LIB_FILE))'
        ])
        INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
    ])

    # Stub lib does not depend on shared/static configuration
    AS_IF([test "$RANLIB" = ""], [
        MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS}'
        INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"'
    ], [
        MAKE_STUB_LIB='${STLIB_LD} [$]@ ${STUB_LIB_OBJS} ; ${RANLIB} [$]@'
        INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)" ; (cd "$(LIB_INSTALL_DIR)" ; $(RANLIB) $(STUB_LIB_FILE))'
    ])
    INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"'

    # 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([],
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[
	    [
		  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)
	    ]])],
	    [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

    AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],)

    # 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)
    AC_SUBST(PLAT_OBJS)
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
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









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
+
+










+
+











-
-
+
+

















-
+





+
+
+
+
+



+


















-
+







    AC_SUBST(MAKE_LIB)
    AC_SUBST(MAKE_STUB_LIB)
    AC_SUBST(INSTALL_LIB)
    AC_SUBST(DLL_INSTALL_DIR)
    AC_SUBST(INSTALL_STUB_LIB)
    AC_SUBST(RANLIB)
])

#--------------------------------------------------------------------
# SC_SERIAL_PORT
#
#	Determine which interface to use to talk to the serial port.
#	Note that #include lines must begin in leftmost column for
#	some compilers to recognize them as preprocessor directives,
#	and some build environments have stdin not pointing at a
#	pseudo-terminal (usually /dev/null instead.)
#
# Arguments:
#	none
#
# Results:
#
#	Defines only one of the following vars:
#		HAVE_SYS_MODEM_H
#		USE_TERMIOS
#		USE_TERMIO
#		USE_SGTTY
#
#--------------------------------------------------------------------

AC_DEFUN([SC_SERIAL_PORT], [
    AC_CHECK_HEADERS(sys/modem.h)
    AC_CACHE_CHECK([termios vs. termio vs. sgtty], tcl_cv_api_serial, [
    AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <termios.h>

int main() {
    struct termios t;
    if (tcgetattr(0, &t) == 0) {
	cfsetospeed(&t, 0);
	t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
	return 0;
    }
    return 1;
}]])],[tcl_cv_api_serial=termios],[tcl_cv_api_serial=no],[tcl_cv_api_serial=no])
    if test $tcl_cv_api_serial = no ; then
	AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <termio.h>

int main() {
    struct termio t;
    if (ioctl(0, TCGETA, &t) == 0) {
	t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
	return 0;
    }
    return 1;
}]])],[tcl_cv_api_serial=termio],[tcl_cv_api_serial=no],[tcl_cv_api_serial=no])
    fi
    if test $tcl_cv_api_serial = no ; then
	AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <sgtty.h>

int main() {
    struct sgttyb t;
    if (ioctl(0, TIOCGETP, &t) == 0) {
	t.sg_ospeed = 0;
	t.sg_flags |= ODDP | EVENP | RAW;
	return 0;
    }
    return 1;
}]])],[tcl_cv_api_serial=sgtty],[tcl_cv_api_serial=no],[tcl_cv_api_serial=no])
    fi
    if test $tcl_cv_api_serial = no ; then
	AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <termios.h>
#include <errno.h>

int main() {
    struct termios t;
    if (tcgetattr(0, &t) == 0
	|| errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
	cfsetospeed(&t, 0);
	t.c_cflag |= PARENB | PARODD | CSIZE | CSTOPB;
	return 0;
    }
    return 1;
}]])],[tcl_cv_api_serial=termios],[tcl_cv_api_serial=no],[tcl_cv_api_serial=no])
    fi
    if test $tcl_cv_api_serial = no; then
	AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <termio.h>
#include <errno.h>

int main() {
    struct termio t;
    if (ioctl(0, TCGETA, &t) == 0
	|| errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
	t.c_cflag |= CBAUD | PARENB | PARODD | CSIZE | CSTOPB;
	return 0;
    }
    return 1;
    }]])],[tcl_cv_api_serial=termio],[tcl_cv_api_serial=no],[tcl_cv_api_serial=no])
    fi
    if test $tcl_cv_api_serial = no; then
	AC_RUN_IFELSE([AC_LANG_SOURCE([[
#include <sgtty.h>
#include <errno.h>

int main() {
    struct sgttyb t;
    if (ioctl(0, TIOCGETP, &t) == 0
	|| errno == ENOTTY || errno == ENXIO || errno == EINVAL) {
	t.sg_ospeed = 0;
	t.sg_flags |= ODDP | EVENP | RAW;
	return 0;
    }
    return 1;
}]])],[tcl_cv_api_serial=sgtty],[tcl_cv_api_serial=none],[tcl_cv_api_serial=none])
    fi])
    case $tcl_cv_api_serial in
	termios) AC_DEFINE(USE_TERMIOS, 1, [Use the termios API for serial lines]);;
	termio)  AC_DEFINE(USE_TERMIO, 1, [Use the termio API for serial lines]);;
	sgtty)   AC_DEFINE(USE_SGTTY, 1, [Use the sgtty API for serial lines]);;
    esac
])

#--------------------------------------------------------------------
# SC_MISSING_POSIX_HEADERS
#
#	Supply substitutes for missing POSIX header files.  Special
#	notes:
#	    - stdlib.h doesn't define strtol or strtoul in some
#	      versions of SunOS
#	    - stdlib.h doesn't define strtol, strtoul, or
#	      strtod insome versions of SunOS
#	    - some versions of string.h don't declare procedures such
#	      as strstr
#
# Arguments:
#	none
#
# Results:
#
#	Defines some of the following vars:
#		NO_DIRENT_H
#		NO_VALUES_H
#		HAVE_LIMITS_H or NO_LIMITS_H
#		NO_STDLIB_H
#		NO_STRING_H
#		NO_SYS_WAIT_H
#		NO_DLFCN_H
#		HAVE_SYS_PARAM_H
#		HAVE_STRING_H ?
#
#--------------------------------------------------------------------

AC_DEFUN([SC_MISSING_POSIX_HEADERS], [
    AC_CACHE_CHECK([dirent.h], tcl_cv_dirent_h, [
    AC_TRY_LINK([#include <sys/types.h>
#include <dirent.h>], [
    AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]], [[
#ifndef _POSIX_SOURCE
#   ifdef __Lynx__
	/*
	 * Generate compilation error to make the test fail:  Lynx headers
	 * are only valid if really in the POSIX environment.
	 */

	missing_procedure();
#   endif
#endif
DIR *d;
struct dirent *entryPtr;
char *p;
d = opendir("foobar");
entryPtr = readdir(d);
p = entryPtr->d_name;
closedir(d);
], tcl_cv_dirent_h=yes, tcl_cv_dirent_h=no)])
]])],[tcl_cv_dirent_h=yes],[tcl_cv_dirent_h=no])])

    if test $tcl_cv_dirent_h = no; then
	AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?])
    fi

    AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have <float.h>?])])
    AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have <values.h>?])])
    AC_CHECK_HEADER(limits.h,
	[AC_DEFINE(HAVE_LIMITS_H, 1, [Do we have <limits.h>?])],
	[AC_DEFINE(NO_LIMITS_H, 1, [Do we have <limits.h>?])])
    AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
    AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
    AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
    if test $tcl_ok = 0; then
	AC_DEFINE(NO_STDLIB_H, 1, [Do we have <stdlib.h>?])
    fi
    AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
    AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
    AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)

    # See also memmove check below for a place where NO_STRING_H can be
    # set and why.

    if test $tcl_ok = 0; then
	AC_DEFINE(NO_STRING_H, 1, [Do we have <string.h>?])
    fi

    AC_CHECK_HEADER(sys/wait.h, , [AC_DEFINE(NO_SYS_WAIT_H, 1, [Do we have <sys/wait.h>?])])
    AC_CHECK_HEADER(dlfcn.h, , [AC_DEFINE(NO_DLFCN_H, 1, [Do we have <dlfcn.h>?])])

    # OS/390 lacks sys/param.h (and doesn't need it, by chance).
    AC_HAVE_HEADERS(sys/param.h)
    AC_CHECK_HEADERS([sys/param.h])
])

#--------------------------------------------------------------------
# SC_PATH_X
#
#	Locate the X11 header files and the X11 library archive.  Try
#	the ac_path_x macro first, but if it doesn't find the X stuff
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
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







-
+









-
+







#--------------------------------------------------------------------

AC_DEFUN([SC_PATH_X], [
    AC_PATH_X
    not_really_there=""
    if test "$no_x" = ""; then
	if test "$x_includes" = ""; then
	    AC_TRY_CPP([#include <X11/Xlib.h>], , not_really_there="yes")
	    AC_PREPROC_IFELSE([AC_LANG_SOURCE([[#include <X11/Xlib.h>]])],[],[not_really_there="yes"])
	else
	    if test ! -r $x_includes/X11/Xlib.h; then
		not_really_there="yes"
	    fi
	fi
    fi
    if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
	AC_MSG_CHECKING([for X11 header files])
	found_xincludes="no"
	AC_TRY_CPP([#include <X11/Xlib.h>], found_xincludes="yes", found_xincludes="no")
	AC_PREPROC_IFELSE([AC_LANG_SOURCE([[#include <X11/Xlib.h>]])],[found_xincludes="yes"],[found_xincludes="no"])
	if test "$found_xincludes" = "no"; then
	    dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
	    for i in $dirs ; do
		if test -r $i/X11/Xlib.h; then
		    AC_MSG_RESULT([$i])
		    XINCLUDES=" -I$i"
		    found_xincludes="yes"
2085
2086
2087
2088
2089
2090
2091





2092




2093
2094
2095
2096
2097
2098
2099
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495







+
+
+
+
+

+
+
+
+








AC_DEFUN([SC_BLOCKING_STYLE], [
    AC_CHECK_HEADERS(sys/ioctl.h)
    AC_CHECK_HEADERS(sys/filio.h)
    SC_CONFIG_SYSTEM
    AC_MSG_CHECKING([FIONBIO vs. O_NONBLOCK for nonblocking I/O])
    case $system in
	# There used to be code here to use FIONBIO under AIX.  However, it
	# was reported that FIONBIO doesn't work under AIX 3.2.5.  Since
	# using O_NONBLOCK seems fine under AIX 4.*, I removed the FIONBIO
	# code (JO, 5/31/97).

	OSF*)
	    AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?])
	    AC_MSG_RESULT([FIONBIO])
	    ;;
	SunOS-4*)
	    AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?])
	    AC_MSG_RESULT([FIONBIO])
	    ;;
	*)
	    AC_MSG_RESULT([O_NONBLOCK])
	    ;;
    esac
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
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
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
2658
2659
2660







-
-
+
+
+





-
-
+
+
+









-
-
+
+

-
-
+
+







-
-
+
+

-
-
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+






-
-
-
-
-
-
-













+
+



+







AC_DEFUN([SC_TIME_HANDLER], [
    AC_CHECK_HEADERS(sys/time.h)
    AC_HEADER_TIME

    AC_CHECK_FUNCS(gmtime_r localtime_r mktime)

    AC_CACHE_CHECK([tm_tzadj in struct tm], tcl_cv_member_tm_tzadj, [
	AC_TRY_COMPILE([#include <time.h>], [struct tm tm; tm.tm_tzadj;],
	    tcl_cv_member_tm_tzadj=yes, tcl_cv_member_tm_tzadj=no)])
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]], [[struct tm tm; tm.tm_tzadj;]])],
	    [tcl_cv_member_tm_tzadj=yes],
	    [tcl_cv_member_tm_tzadj=no])])
    if test $tcl_cv_member_tm_tzadj = yes ; then
	AC_DEFINE(HAVE_TM_TZADJ, 1, [Should we use the tm_tzadj field of struct tm?])
    fi

    AC_CACHE_CHECK([tm_gmtoff in struct tm], tcl_cv_member_tm_gmtoff, [
	AC_TRY_COMPILE([#include <time.h>], [struct tm tm; (void)tm.tm_gmtoff;],
	    tcl_cv_member_tm_gmtoff=yes, tcl_cv_member_tm_gmtoff=no)])
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]], [[struct tm tm; tm.tm_gmtoff;]])],
	    [tcl_cv_member_tm_gmtoff=yes],
	    [tcl_cv_member_tm_gmtoff=no])])
    if test $tcl_cv_member_tm_gmtoff = yes ; then
	AC_DEFINE(HAVE_TM_GMTOFF, 1, [Should we use the tm_gmtoff field of struct tm?])
    fi

    #
    # Its important to include time.h in this check, as some systems
    # (like convex) have timezone functions, etc.
    #
    AC_CACHE_CHECK([long timezone variable], tcl_cv_timezone_long, [
	AC_TRY_COMPILE([#include <time.h>],
	    [extern long timezone;
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]],
	    [[extern long timezone;
	    timezone += 1;
	    exit (0);],
	    tcl_cv_timezone_long=yes, tcl_cv_timezone_long=no)])
	    exit (0);]])],
	    [tcl_cv_timezone_long=yes],[tcl_cv_timezone_long=no])])
    if test $tcl_cv_timezone_long = yes ; then
	AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?])
    else
	#
	# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
	#
	AC_CACHE_CHECK([time_t timezone variable], tcl_cv_timezone_time, [
	    AC_TRY_COMPILE([#include <time.h>],
		[extern time_t timezone;
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <time.h>]],
		[[extern time_t timezone;
		timezone += 1;
		exit (0);],
		tcl_cv_timezone_time=yes, tcl_cv_timezone_time=no)])
		exit (0);]])],
		[tcl_cv_timezone_time=yes],[tcl_cv_timezone_time=no])])
	if test $tcl_cv_timezone_time = yes ; then
	    AC_DEFINE(HAVE_TIMEZONE_VAR, 1, [Should we use the global timezone variable?])
	fi
    fi
])

#--------------------------------------------------------------------
# SC_BUGGY_STRTOD
#
#	Under Solaris 2.4, strtod returns the wrong value for the
#	terminating character under some conditions.  Check for this
#	and if the problem exists use a substitute procedure
#	"fixstrtod" (provided by Tcl) that corrects the error.
#	Also, on Compaq's Tru64 Unix 5.0,
#	strtod(" ") returns 0.0 instead of a failure to convert.
#
# Arguments:
#	none
#
# Results:
#
#	Might defines some of the following vars:
#		strtod (=fixstrtod)
#
#--------------------------------------------------------------------

AC_DEFUN([SC_BUGGY_STRTOD], [
    AC_CHECK_FUNC(strtod, tcl_strtod=1, tcl_strtod=0)
    if test "$tcl_strtod" = 1; then
	AC_CACHE_CHECK([for Solaris2.4/Tru64 strtod bugs], tcl_cv_strtod_buggy,[
	    AC_RUN_IFELSE([AC_LANG_SOURCE([[
		#include <stdlib.h>
		extern double strtod();
		int main() {
		    char *infString="Inf", *nanString="NaN", *spaceString=" ";
		    char *term;
		    double value;
		    value = strtod(infString, &term);
		    if ((term != infString) && (term[-1] == 0)) {
			exit(1);
		    }
		    value = strtod(nanString, &term);
		    if ((term != nanString) && (term[-1] == 0)) {
			exit(1);
		    }
		    value = strtod(spaceString, &term);
		    if (term == (spaceString+1)) {
			exit(1);
		    }
		    exit(0);
		}]])],
		[tcl_cv_strtod_buggy=ok],
		[tcl_cv_strtod_buggy=buggy],
		[tcl_cv_strtod_buggy=buggy])])
	if test "$tcl_cv_strtod_buggy" = buggy; then
	    AC_LIBOBJ([fixstrtod])
	    USE_COMPAT=1
	    AC_DEFINE(strtod, fixstrtod, [Do we want to use the strtod() in compat?])
	fi
    fi
])

#--------------------------------------------------------------------
# SC_TCL_LINK_LIBS
#
#	Search for the libraries needed to link the Tcl shell.
#	Things like the math library (-lm) and socket stuff (-lsocket vs.
#	-lnsl) or thread library (-lpthread) are dealt with here.
#	-lnsl) are dealt with here.
#
# Arguments:
#	None.
#
# Results:
#
#	Sets the following vars:
#		THREADS_LIBS	Thread library(s)
#
#	Defines the following vars:
#		_REENTRANT
#		_THREAD_SAFE
#
#	Might append to the following vars:
#		LIBS
#		MATH_LIBS
#
#	Might define the following vars:
#		HAVE_NET_ERRNO_H
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_LINK_LIBS], [
    #--------------------------------------------------------------------
    # On a few very rare systems, all of the libm.a stuff is
    # already in libc.a.  Set compiler flags accordingly.
    # Also, Linux requires the "ieee" library for math to work
    # right (and it must appear before "-lm").
    #--------------------------------------------------------------------

    AC_CHECK_FUNC(sin, MATH_LIBS="", MATH_LIBS="-lm")
    AC_CHECK_LIB(ieee, main, [MATH_LIBS="-lieee $MATH_LIBS"])

    #--------------------------------------------------------------------
    # Interactive UNIX requires -linet instead of -lsocket, plus it
    # needs net/errno.h to define the socket-related error codes.
    #--------------------------------------------------------------------

    AC_CHECK_LIB(inet, main, [LIBS="$LIBS -linet"])
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
2688
2689
2690
2691
2692
2693
2694

















































2695
2696
2697
2698
2699
2700
2701







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    if test "$tcl_checkBoth" = 1; then
	tk_oldLibs=$LIBS
	LIBS="$LIBS -lsocket -lnsl"
	AC_CHECK_FUNC(accept, tcl_checkNsl=0, [LIBS=$tk_oldLibs])
    fi
    AC_CHECK_FUNC(gethostbyname, , [AC_CHECK_LIB(nsl, gethostbyname,
	    [LIBS="$LIBS -lnsl"])])

    AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
    AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?])
    AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
    if test "$tcl_ok" = "no"; then
	# Check a little harder for __pthread_mutex_init in the same
	# library, as some systems hide it there until pthread.h is
	# defined.  We could alternatively do an AC_TRY_COMPILE with
	# pthread.h, but that will work with libpthread really doesn't
	# exist, like AIX 4.2.  [Bug: 4359]
	AC_CHECK_LIB(pthread, __pthread_mutex_init,
		tcl_ok=yes, tcl_ok=no)
    fi

    if test "$tcl_ok" = "yes"; then
	# The space is needed
	THREADS_LIBS=" -lpthread"
    else
	AC_CHECK_LIB(pthreads, pthread_mutex_init,
	_ok=yes, tcl_ok=no)
	if test "$tcl_ok" = "yes"; then
	    # The space is needed
	    THREADS_LIBS=" -lpthreads"
	else
	    AC_CHECK_LIB(c, pthread_mutex_init,
		    tcl_ok=yes, tcl_ok=no)
	    if test "$tcl_ok" = "no"; then
		AC_CHECK_LIB(c_r, pthread_mutex_init,
			tcl_ok=yes, tcl_ok=no)
		if test "$tcl_ok" = "yes"; then
		    # The space is needed
		    THREADS_LIBS=" -pthread"
		else
		    AC_MSG_WARN([Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile...])
		fi
	    fi
	fi
    fi

    # Does the pthread-implementation provide
    # 'pthread_attr_setstacksize' ?

    ac_saved_libs=$LIBS
    LIBS="$LIBS $THREADS_LIBS"
    AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
    LIBS=$ac_saved_libs

    # TIP #509
    AC_CHECK_DECLS([PTHREAD_MUTEX_RECURSIVE],tcl_ok=yes,tcl_ok=no, [[#include <pthread.h>]])
])

#--------------------------------------------------------------------
# SC_TCL_EARLY_FLAGS
#
#	Check for what flags are needed to be passed so the correct OS
#	features are available.
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318



2319
2320

2321
2322
2323
2324
2325
2326
2327
2710
2711
2712
2713
2714
2715
2716



2717
2718
2719
2720

2721
2722
2723
2724
2725
2726
2727
2728







-
-
-
+
+
+

-
+







#		_LARGEFILE64_SOURCE
#		_LARGEFILE_SOURCE64
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_EARLY_FLAG],[
    AC_CACHE_VAL([tcl_cv_flag_]translit($1,[A-Z],[a-z]),
	AC_TRY_COMPILE([$2], $3, [tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,
	    AC_TRY_COMPILE([[#define ]$1[ 1
]$2], $3,
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[$2]], [[$3]])],[tcl_cv_flag_]translit($1,[A-Z],[a-z])=no,
	    [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#define $1 1
$2]], [[$3]])],
		[tcl_cv_flag_]translit($1,[A-Z],[a-z])=yes,
		[tcl_cv_flag_]translit($1,[A-Z],[a-z])=no)))
		[tcl_cv_flag_]translit($1,[A-Z],[a-z])=no)]))
    if test ["x${tcl_cv_flag_]translit($1,[A-Z],[a-z])[}" = "xyes"] ; then
	AC_DEFINE($1, 1, [Add the ]$1[ flag when building])
	tcl_flags="$tcl_flags $1"
    fi
])

AC_DEFUN([SC_TCL_EARLY_FLAGS],[
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
2761
2762
2763
2764
2765
2766
2767



2768
2769
2770
2771
2772



2773
2774
2775
2776


2777
2778
2779
2780
2781
2782
2783
2784
2785



2786
2787
2788
2789
2790
2791
2792
2793




2794
2795
2796
2797
2798
2799
2800
2801
2802



2803
2804
2805
2806
2807
2808
2809
2810
2811
2812



2813
2814
2815
2816
2817
2818
2819
2820
2821
2822







-
-
-
+
+
+


-
-
-
+
+
+

-
-
+
+







-
-
-
+
+
+





-
-
-
-
+
+
+
+





-
-
-
+
+
+







-
-
-
+
+
+







#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_64BIT_FLAGS], [
    AC_MSG_CHECKING([for 64-bit integer type])
    AC_CACHE_VAL(tcl_cv_type_64bit,[
	tcl_cv_type_64bit=none
	# See if the compiler knows natively about __int64
	AC_TRY_COMPILE(,[__int64 value = (__int64) 0;],
	    tcl_type_64bit=__int64, tcl_type_64bit="long long")
	# See if we could use long anyway  Note that we substitute in the
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[__int64 value = (__int64) 0;]])],
	    [tcl_type_64bit=__int64],[tcl_type_64bit="long long"])
	# See if we should use long anyway  Note that we substitute in the
	# type that is our current guess for a 64-bit type inside this check
	# program, so it should be modified only carefully...
        AC_TRY_COMPILE(,[switch (0) {
            case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ;
        }],tcl_cv_type_64bit=${tcl_type_64bit})])
        AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[switch (0) {
            case 1: case (sizeof(${tcl_type_64bit})==sizeof(long)): ;
        }]])],[tcl_cv_type_64bit=${tcl_type_64bit}],[])])
    if test "${tcl_cv_type_64bit}" = none ; then
	AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?])
	AC_MSG_RESULT([yes])
	AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?])
	AC_MSG_RESULT([using long])
    else
	AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit},
	    [What type should be used to define wide integers?])
	AC_MSG_RESULT([${tcl_cv_type_64bit}])

	# Now check for auxiliary declarations
	AC_CACHE_CHECK([for struct dirent64], tcl_cv_struct_dirent64,[
	    AC_TRY_COMPILE([#include <sys/types.h>
#include <dirent.h>],[struct dirent64 p;],
		tcl_cv_struct_dirent64=yes,tcl_cv_struct_dirent64=no)])
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]],
		[[struct dirent64 p;]])],[tcl_cv_struct_dirent64=yes],[tcl_cv_struct_dirent64=no])])
	if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then
	    AC_DEFINE(HAVE_STRUCT_DIRENT64, 1, [Is 'struct dirent64' in <sys/types.h>?])
	fi

	AC_CACHE_CHECK([for DIR64], tcl_cv_DIR64,[
	    AC_TRY_COMPILE([#include <sys/types.h>
#include <dirent.h>],[struct dirent64 *p; DIR64 d = opendir64(".");
            p = readdir64(d); rewinddir64(d); closedir64(d);],
		tcl_cv_DIR64=yes,tcl_cv_DIR64=no)])
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>
#include <dirent.h>]], [[struct dirent64 *p; DIR64 d = opendir64(".");
            p = readdir64(d); rewinddir64(d); closedir64(d);]])],
		[tcl_cv_DIR64=yes],[tcl_cv_DIR64=no])])
	if test "x${tcl_cv_DIR64}" = "xyes" ; then
	    AC_DEFINE(HAVE_DIR64, 1, [Is 'DIR64' in <sys/types.h>?])
	fi

	AC_CACHE_CHECK([for struct stat64], tcl_cv_struct_stat64,[
	    AC_TRY_COMPILE([#include <sys/stat.h>],[struct stat64 p;
],
		tcl_cv_struct_stat64=yes,tcl_cv_struct_stat64=no)])
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/stat.h>]], [[struct stat64 p;
]])],
		[tcl_cv_struct_stat64=yes],[tcl_cv_struct_stat64=no])])
	if test "x${tcl_cv_struct_stat64}" = "xyes" ; then
	    AC_DEFINE(HAVE_STRUCT_STAT64, 1, [Is 'struct stat64' in <sys/stat.h>?])
	fi

	AC_CHECK_FUNCS(open64 lseek64)
	AC_MSG_CHECKING([for off64_t])
	AC_CACHE_VAL(tcl_cv_type_off64_t,[
	    AC_TRY_COMPILE([#include <sys/types.h>],[off64_t offset;
],
		tcl_cv_type_off64_t=yes,tcl_cv_type_off64_t=no)])
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include <sys/types.h>]], [[off64_t offset;
]])],
		[tcl_cv_type_off64_t=yes],[tcl_cv_type_off64_t=no])])
	dnl Define HAVE_TYPE_OFF64_T only when the off64_t type and the
	dnl functions lseek64 and open64 are defined.
	if test "x${tcl_cv_type_off64_t}" = "xyes" && \
	        test "x${ac_cv_func_lseek64}" = "xyes" && \
	        test "x${ac_cv_func_open64}" = "xyes" ; then
	    AC_DEFINE(HAVE_TYPE_OFF64_T, 1, [Is off64_t in <sys/types.h>?])
	    AC_MSG_RESULT([yes])
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449



2450
2451
2452
2453
2454
2455

2456
2457
2458
2459
2460
2461
2462
2841
2842
2843
2844
2845
2846
2847



2848
2849
2850
2851
2852
2853
2854
2855

2856
2857
2858
2859
2860
2861
2862
2863







-
-
-
+
+
+





-
+







#	Will define the following vars:
#		TCL_CFGVAL_ENCODING
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_CFG_ENCODING], [
    AC_ARG_WITH(encoding,
	AC_HELP_STRING([--with-encoding],
	    [encoding for configuration values (default: utf-8)]),
	with_tcencoding=${withval})
	AS_HELP_STRING([--with-encoding],
	    [encoding for configuration values (default: iso8859-1)]),
	[with_tcencoding=${withval}])

    if test x"${with_tcencoding}" != x ; then
	AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}",
	    [What encoding should be used for embedded configuration info?])
    else
	AC_DEFINE(TCL_CFGVAL_ENCODING,"utf-8",
	AC_DEFINE(TCL_CFGVAL_ENCODING,"iso8859-1",
	    [What encoding should be used for embedded configuration info?])
    fi
])

#--------------------------------------------------------------------
# SC_TCL_CHECK_BROKEN_FUNC
#
2473
2474
2475
2476
2477
2478
2479
2480

2481
2482
2483

2484
2485
2486
2487
2488
2489
2490
2491
2874
2875
2876
2877
2878
2879
2880

2881
2882
2883

2884

2885
2886
2887
2888
2889
2890
2891







-
+


-
+
-







#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_CHECK_BROKEN_FUNC],[
    AC_CHECK_FUNC($1, tcl_ok=1, tcl_ok=0)
    if test ["$tcl_ok"] = 1; then
	AC_CACHE_CHECK([proper ]$1[ implementation], [tcl_cv_]$1[_unbroken],
	    AC_TRY_RUN([[
	    AC_RUN_IFELSE([AC_LANG_SOURCE([[[
#include <stdlib.h>
#include <string.h>
int main() {]$2[}]],[tcl_cv_]$1[_unbroken]=ok,
int main() {]$2[}]]])],[tcl_cv_$1_unbroken=ok],[tcl_cv_$1_unbroken=broken],[tcl_cv_$1_unbroken=unknown]))
		[tcl_cv_]$1[_unbroken]=broken,[tcl_cv_]$1[_unbroken]=unknown))
	if test ["$tcl_cv_]$1[_unbroken"] = "ok"; then
	    tcl_ok=1
	else
	    tcl_ok=0
	fi
    fi
    if test ["$tcl_ok"] = 0; then
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
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







-
+

-
+










-
+






-
+

-
+










-
+








AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_DECL], [AC_CHECK_DECLS(gethostbyaddr_r, [
    tcl_cv_api_gethostbyaddr_r=yes],[tcl_cv_api_gethostbyaddr_r=no],[#include <netdb.h>])
])

AC_DEFUN([SC_TCL_GETHOSTBYADDR_R_TYPE], [AC_CHECK_FUNC(gethostbyaddr_r, [
    AC_CACHE_CHECK([for gethostbyaddr_r with 7 args], tcl_cv_api_gethostbyaddr_r_7, [
    AC_TRY_COMPILE([
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <netdb.h>
    ], [
    ]], [[
	char *addr;
	int length;
	int type;
	struct hostent *result;
	char buffer[2048];
	int buflen = 2048;
	int h_errnop;

	(void) gethostbyaddr_r(addr, length, type, result, buffer, buflen,
			       &h_errnop);
    ], tcl_cv_api_gethostbyaddr_r_7=yes, tcl_cv_api_gethostbyaddr_r_7=no)])
    ]])],[tcl_cv_api_gethostbyaddr_r_7=yes],[tcl_cv_api_gethostbyaddr_r_7=no])])
    tcl_ok=$tcl_cv_api_gethostbyaddr_r_7
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETHOSTBYADDR_R_7, 1,
	    [Define to 1 if gethostbyaddr_r takes 7 args.])
    else
	AC_CACHE_CHECK([for gethostbyaddr_r with 8 args], tcl_cv_api_gethostbyaddr_r_8, [
	AC_TRY_COMPILE([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #include <netdb.h>
	], [
	]], [[
	    char *addr;
	    int length;
	    int type;
	    struct hostent *result, *resultp;
	    char buffer[2048];
	    int buflen = 2048;
	    int h_errnop;

	    (void) gethostbyaddr_r(addr, length, type, result, buffer, buflen,
				   &resultp, &h_errnop);
	], tcl_cv_api_gethostbyaddr_r_8=yes, tcl_cv_api_gethostbyaddr_r_8=no)])
	]])],[tcl_cv_api_gethostbyaddr_r_8=yes],[tcl_cv_api_gethostbyaddr_r_8=no])])
	tcl_ok=$tcl_cv_api_gethostbyaddr_r_8
	if test "$tcl_ok" = yes; then
	    AC_DEFINE(HAVE_GETHOSTBYADDR_R_8, 1,
		[Define to 1 if gethostbyaddr_r takes 8 args.])
	fi
    fi
    if test "$tcl_ok" = yes; then
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
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
2658
2659
2660
2661
2662
2663
2664































2665
2666
2667
2668
2669
2670
2671
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
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







-
+

-
+







-
+






-
+

-
+







-
+






-
+

-
+





-
+












+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_DECL], [AC_CHECK_DECLS(gethostbyname_r, [
    tcl_cv_api_gethostbyname_r=yes],[tcl_cv_api_gethostbyname_r=no],[#include <netdb.h>])
])

AC_DEFUN([SC_TCL_GETHOSTBYNAME_R_TYPE], [AC_CHECK_FUNC(gethostbyname_r, [
    AC_CACHE_CHECK([for gethostbyname_r with 6 args], tcl_cv_api_gethostbyname_r_6, [
    AC_TRY_COMPILE([
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <netdb.h>
    ], [
    ]], [[
	char *name;
	struct hostent *he, *res;
	char buffer[2048];
	int buflen = 2048;
	int h_errnop;

	(void) gethostbyname_r(name, he, buffer, buflen, &res, &h_errnop);
    ], tcl_cv_api_gethostbyname_r_6=yes, tcl_cv_api_gethostbyname_r_6=no)])
    ]])],[tcl_cv_api_gethostbyname_r_6=yes],[tcl_cv_api_gethostbyname_r_6=no])])
    tcl_ok=$tcl_cv_api_gethostbyname_r_6
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETHOSTBYNAME_R_6, 1,
	    [Define to 1 if gethostbyname_r takes 6 args.])
    else
	AC_CACHE_CHECK([for gethostbyname_r with 5 args], tcl_cv_api_gethostbyname_r_5, [
	AC_TRY_COMPILE([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #include <netdb.h>
	], [
	]], [[
	    char *name;
	    struct hostent *he;
	    char buffer[2048];
	    int buflen = 2048;
	    int h_errnop;

	    (void) gethostbyname_r(name, he, buffer, buflen, &h_errnop);
	], tcl_cv_api_gethostbyname_r_5=yes, tcl_cv_api_gethostbyname_r_5=no)])
	]])],[tcl_cv_api_gethostbyname_r_5=yes],[tcl_cv_api_gethostbyname_r_5=no])])
	tcl_ok=$tcl_cv_api_gethostbyname_r_5
	if test "$tcl_ok" = yes; then
	    AC_DEFINE(HAVE_GETHOSTBYNAME_R_5, 1,
		[Define to 1 if gethostbyname_r takes 5 args.])
	else
	    AC_CACHE_CHECK([for gethostbyname_r with 3 args], tcl_cv_api_gethostbyname_r_3, [
	    AC_TRY_COMPILE([
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#include <netdb.h>
	    ], [
	    ]], [[
		char *name;
		struct hostent *he;
		struct hostent_data data;

		(void) gethostbyname_r(name, he, &data);
	    ], tcl_cv_api_gethostbyname_r_3=yes, tcl_cv_api_gethostbyname_r_3=no)])
	    ]])],[tcl_cv_api_gethostbyname_r_3=yes],[tcl_cv_api_gethostbyname_r_3=no])])
	    tcl_ok=$tcl_cv_api_gethostbyname_r_3
	    if test "$tcl_ok" = yes; then
		AC_DEFINE(HAVE_GETHOSTBYNAME_R_3, 1,
		    [Define to 1 if gethostbyname_r takes 3 args.])
	    fi
	fi
    fi
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETHOSTBYNAME_R, 1,
	    [Define to 1 if gethostbyname_r is available.])
    fi
])])

#--------------------------------------------------------------------
# SC_TCL_GETADDRINFO
#
#	Check if we have 'getaddrinfo'
#
# Arguments:
#	None
#
# Results:
#	Might define the following vars:
#		HAVE_GETADDRINFO
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_GETADDRINFO], [AC_CHECK_FUNC(getaddrinfo, [
    AC_CACHE_CHECK([for working getaddrinfo], tcl_cv_api_getaddrinfo, [
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <netdb.h>
    ]], [[
	const char *name, *port;
	struct addrinfo *aiPtr, hints;
	(void)getaddrinfo(name,port, &hints, &aiPtr);
	(void)freeaddrinfo(aiPtr);
    ]])],[tcl_cv_api_getaddrinfo=yes],[tcl_cv_getaddrinfo=no])])
    tcl_ok=$tcl_cv_api_getaddrinfo
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETADDRINFO, 1,
	    [Define to 1 if getaddrinfo is available.])
    fi
])])

#--------------------------------------------------------------------
# SC_TCL_GETPWUID_R
#
#	Check if we have MT-safe variant of getpwuid() and if yes,
#	which one exactly.
#
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
2709
2710
2711
2712
2713

2714
2715
2716
2717
2718
2719
2720
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







-
+


-
+






-
+






-
+


-
+






-
+







#		HAVE_GETPWUID_R_4
#		HAVE_GETPWUID_R_5
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_GETPWUID_R], [AC_CHECK_FUNC(getpwuid_r, [
    AC_CACHE_CHECK([for getpwuid_r with 5 args], tcl_cv_api_getpwuid_r_5, [
    AC_TRY_COMPILE([
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <sys/types.h>
	#include <pwd.h>
    ], [
    ]], [[
	uid_t uid;
	struct passwd pw, *pwp;
	char buf[512];
	int buflen = 512;

	(void) getpwuid_r(uid, &pw, buf, buflen, &pwp);
    ], tcl_cv_api_getpwuid_r_5=yes, tcl_cv_api_getpwuid_r_5=no)])
    ]])],[tcl_cv_api_getpwuid_r_5=yes],[tcl_cv_api_getpwuid_r_5=no])])
    tcl_ok=$tcl_cv_api_getpwuid_r_5
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETPWUID_R_5, 1,
	    [Define to 1 if getpwuid_r takes 5 args.])
    else
	AC_CACHE_CHECK([for getpwuid_r with 4 args], tcl_cv_api_getpwuid_r_4, [
	AC_TRY_COMPILE([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #include <sys/types.h>
	    #include <pwd.h>
	], [
	]], [[
	    uid_t uid;
	    struct passwd pw;
	    char buf[512];
	    int buflen = 512;

	    (void)getpwnam_r(uid, &pw, buf, buflen);
	], tcl_cv_api_getpwuid_r_4=yes, tcl_cv_api_getpwuid_r_4=no)])
	]])],[tcl_cv_api_getpwuid_r_4=yes],[tcl_cv_api_getpwuid_r_4=no])])
	tcl_ok=$tcl_cv_api_getpwuid_r_4
	if test "$tcl_ok" = yes; then
	    AC_DEFINE(HAVE_GETPWUID_R_4, 1,
		[Define to 1 if getpwuid_r takes 4 args.])
	fi
    fi
    if test "$tcl_ok" = yes; then
2739
2740
2741
2742
2743
2744
2745
2746

2747
2748
2749

2750
2751
2752
2753
2754
2755
2756

2757
2758
2759
2760
2761
2762
2763

2764
2765
2766

2767
2768
2769
2770
2771
2772
2773

2774
2775
2776
2777
2778
2779
2780
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







-
+


-
+






-
+






-
+


-
+






-
+







#		HAVE_GETPWNAM_R_4
#		HAVE_GETPWNAM_R_5
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_GETPWNAM_R], [AC_CHECK_FUNC(getpwnam_r, [
    AC_CACHE_CHECK([for getpwnam_r with 5 args], tcl_cv_api_getpwnam_r_5, [
    AC_TRY_COMPILE([
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <sys/types.h>
	#include <pwd.h>
    ], [
    ]], [[
	char *name;
	struct passwd pw, *pwp;
	char buf[512];
	int buflen = 512;

	(void) getpwnam_r(name, &pw, buf, buflen, &pwp);
    ], tcl_cv_api_getpwnam_r_5=yes, tcl_cv_api_getpwnam_r_5=no)])
    ]])],[tcl_cv_api_getpwnam_r_5=yes],[tcl_cv_api_getpwnam_r_5=no])])
    tcl_ok=$tcl_cv_api_getpwnam_r_5
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETPWNAM_R_5, 1,
	    [Define to 1 if getpwnam_r takes 5 args.])
    else
	AC_CACHE_CHECK([for getpwnam_r with 4 args], tcl_cv_api_getpwnam_r_4, [
	AC_TRY_COMPILE([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #include <sys/types.h>
	    #include <pwd.h>
	], [
	]], [[
	    char *name;
	    struct passwd pw;
	    char buf[512];
	    int buflen = 512;

	    (void)getpwnam_r(name, &pw, buf, buflen);
	], tcl_cv_api_getpwnam_r_4=yes, tcl_cv_api_getpwnam_r_4=no)])
	]])],[tcl_cv_api_getpwnam_r_4=yes],[tcl_cv_api_getpwnam_r_4=no])])
	tcl_ok=$tcl_cv_api_getpwnam_r_4
	if test "$tcl_ok" = yes; then
	    AC_DEFINE(HAVE_GETPWNAM_R_4, 1,
		[Define to 1 if getpwnam_r takes 4 args.])
	fi
    fi
    if test "$tcl_ok" = yes; then
2799
2800
2801
2802
2803
2804
2805
2806

2807
2808
2809

2810
2811
2812
2813
2814
2815
2816

2817
2818
2819
2820
2821
2822
2823

2824
2825
2826

2827
2828
2829
2830
2831
2832
2833

2834
2835
2836
2837
2838
2839
2840
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







-
+


-
+






-
+






-
+


-
+






-
+







#		HAVE_GETGRGID_R_4
#		HAVE_GETGRGID_R_5
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_GETGRGID_R], [AC_CHECK_FUNC(getgrgid_r, [
    AC_CACHE_CHECK([for getgrgid_r with 5 args], tcl_cv_api_getgrgid_r_5, [
    AC_TRY_COMPILE([
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <sys/types.h>
	#include <grp.h>
    ], [
    ]], [[
	gid_t gid;
	struct group gr, *grp;
	char buf[512];
	int buflen = 512;

	(void) getgrgid_r(gid, &gr, buf, buflen, &grp);
    ], tcl_cv_api_getgrgid_r_5=yes, tcl_cv_api_getgrgid_r_5=no)])
    ]])],[tcl_cv_api_getgrgid_r_5=yes],[tcl_cv_api_getgrgid_r_5=no])])
    tcl_ok=$tcl_cv_api_getgrgid_r_5
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETGRGID_R_5, 1,
	    [Define to 1 if getgrgid_r takes 5 args.])
    else
	AC_CACHE_CHECK([for getgrgid_r with 4 args], tcl_cv_api_getgrgid_r_4, [
	AC_TRY_COMPILE([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #include <sys/types.h>
	    #include <grp.h>
	], [
	]], [[
	    gid_t gid;
	    struct group gr;
	    char buf[512];
	    int buflen = 512;

	    (void)getgrgid_r(gid, &gr, buf, buflen);
	], tcl_cv_api_getgrgid_r_4=yes, tcl_cv_api_getgrgid_r_4=no)])
	]])],[tcl_cv_api_getgrgid_r_4=yes],[tcl_cv_api_getgrgid_r_4=no])])
	tcl_ok=$tcl_cv_api_getgrgid_r_4
	if test "$tcl_ok" = yes; then
	    AC_DEFINE(HAVE_GETGRGID_R_4, 1,
		[Define to 1 if getgrgid_r takes 4 args.])
	fi
    fi
    if test "$tcl_ok" = yes; then
2859
2860
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
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
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







-
+


-
+






-
+






-
+


-
+






-
+












-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



#		HAVE_GETGRNAM_R_4
#		HAVE_GETGRNAM_R_5
#
#--------------------------------------------------------------------

AC_DEFUN([SC_TCL_GETGRNAM_R], [AC_CHECK_FUNC(getgrnam_r, [
    AC_CACHE_CHECK([for getgrnam_r with 5 args], tcl_cv_api_getgrnam_r_5, [
    AC_TRY_COMPILE([
    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	#include <sys/types.h>
	#include <grp.h>
    ], [
    ]], [[
	char *name;
	struct group gr, *grp;
	char buf[512];
	int buflen = 512;

	(void) getgrnam_r(name, &gr, buf, buflen, &grp);
    ], tcl_cv_api_getgrnam_r_5=yes, tcl_cv_api_getgrnam_r_5=no)])
    ]])],[tcl_cv_api_getgrnam_r_5=yes],[tcl_cv_api_getgrnam_r_5=no])])
    tcl_ok=$tcl_cv_api_getgrnam_r_5
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETGRNAM_R_5, 1,
	    [Define to 1 if getgrnam_r takes 5 args.])
    else
	AC_CACHE_CHECK([for getgrnam_r with 4 args], tcl_cv_api_getgrnam_r_4, [
	AC_TRY_COMPILE([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #include <sys/types.h>
	    #include <grp.h>
	], [
	]], [[
	    char *name;
	    struct group gr;
	    char buf[512];
	    int buflen = 512;

	    (void)getgrnam_r(name, &gr, buf, buflen);
	], tcl_cv_api_getgrnam_r_4=yes, tcl_cv_api_getgrnam_r_4=no)])
	]])],[tcl_cv_api_getgrnam_r_4=yes],[tcl_cv_api_getgrnam_r_4=no])])
	tcl_ok=$tcl_cv_api_getgrnam_r_4
	if test "$tcl_ok" = yes; then
	    AC_DEFINE(HAVE_GETGRNAM_R_4, 1,
		[Define to 1 if getgrnam_r takes 4 args.])
	fi
    fi
    if test "$tcl_ok" = yes; then
	AC_DEFINE(HAVE_GETGRNAM_R, 1,
	    [Define to 1 if getgrnam_r is available.])
    fi
])])

AC_DEFUN([SC_TCL_IPV6],[
	NEED_FAKE_RFC2553=0
	AC_CHECK_FUNCS(getnameinfo getaddrinfo freeaddrinfo gai_strerror,,[NEED_FAKE_RFC2553=1])
	AC_CHECK_TYPES([
		struct addrinfo,
		struct in6_addr,
		struct sockaddr_in6,
		struct sockaddr_storage],,[NEED_FAKE_RFC2553=1],[[
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
]])
if test "x$NEED_FAKE_RFC2553" = "x1"; then
   AC_DEFINE([NEED_FAKE_RFC2553], 1,
        [Use compat implementation of getaddrinfo() and friends])
   AC_LIBOBJ([fake-rfc2553])
   AC_CHECK_FUNC(strlcpy)
fi
])

#------------------------------------------------------------------------
# SC_CC_FOR_BUILD
#	For cross compiles, locate a C compiler that can generate native binaries.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		CC_FOR_BUILD
#		EXEEXT_FOR_BUILD
#------------------------------------------------------------------------

dnl Get a default for CC_FOR_BUILD to put into Makefile.
AC_DEFUN([AX_CC_FOR_BUILD],[# Put a plausible default for CC_FOR_BUILD in Makefile.
    if test -z "$CC_FOR_BUILD"; then
      if test "x$cross_compiling" = "xno"; then
        CC_FOR_BUILD='$(CC)'
      else
        AC_MSG_CHECKING([for gcc])
        AC_CACHE_VAL(ac_cv_path_cc, [
            search_path=`echo ${PATH} | sed -e 's/:/ /g'`
            for dir in $search_path ; do
                for j in `ls -r $dir/gcc 2> /dev/null` \
                        `ls -r $dir/gcc 2> /dev/null` ; do
                    if test x"$ac_cv_path_cc" = x ; then
                        if test -f "$j" ; then
                            ac_cv_path_cc=$j
                            break
                        fi
                    fi
                done
            done
        ])
      fi
    fi
    AC_SUBST(CC_FOR_BUILD)
    # Also set EXEEXT_FOR_BUILD.
    if test "x$cross_compiling" = "xno"; then
      EXEEXT_FOR_BUILD='$(EXEEXT)'
      OBJEXT_FOR_BUILD='$(OBJEXT)'
    else
      OBJEXT_FOR_BUILD='.no'
      AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
        [rm -f conftest*
         echo 'int main () { return 0; }' > conftest.c
         bfd_cv_build_exeext=
         ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
         for file in conftest.*; do
           case $file in
           *.c | *.o | *.obj | *.ilk | *.pdb) ;;
           *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
           esac
         done
         rm -f conftest*
         test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
      EXEEXT_FOR_BUILD=""
      test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
    fi
    AC_SUBST(EXEEXT_FOR_BUILD)])dnl
    AC_SUBST(OBJEXT_FOR_BUILD)])dnl
])


#------------------------------------------------------------------------
# SC_ZIPFS_SUPPORT
#	Locate a zip encoder installed on the system path, or none.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		ZIP_PROG
#       ZIP_PROG_OPTIONS
#       ZIP_PROG_VFSSEARCH
#       ZIP_INSTALL_OBJS
#------------------------------------------------------------------------

AC_DEFUN([SC_ZIPFS_SUPPORT], [
    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    AC_MSG_CHECKING([for zip])
    AC_CACHE_VAL(ac_cv_path_zip, [
    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done
    ])
    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip"
        AC_MSG_RESULT([$ZIP_PROG])
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="*"
        AC_MSG_RESULT([Found INFO Zip in environment])
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="*"
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        AC_MSG_RESULT([No zip found on PATH. Building minizip])
    fi
    AC_SUBST(ZIP_PROG)
    AC_SUBST(ZIP_PROG_OPTIONS)
    AC_SUBST(ZIP_PROG_VFSSEARCH)
    AC_SUBST(ZIP_INSTALL_OBJS)
])

# Local Variables:
# mode: autoconf
# End:

Changes to unix/tcl.pc.in.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

16
17
1
2
3
4
5
6


7
8
9
10
11


12
13
14






-
-





-
-
+


# tcl pkg-config source file

prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
libfile=@TCL_LIB_FILE@
zipfile=@TCL_ZIP_FILE@

Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
URL: http://www.tcl.tk/
Version: @TCL_VERSION@@TCL_PATCH_LEVEL@
Requires.private: zlib >= 1.2.3, libtommath >= 1.2.0
Libs: -L${libdir} @TCL_LIB_FLAG@ @TCL_STUB_LIB_FLAG@
Libs: -L${libdir} @TCL_LIB_FLAG@
Libs.private: @TCL_LIBS@
Cflags: -I${includedir}

Changes to unix/tcl.spec.

1
2
3
4
5
6
7

8
9
10
11
12
13
14
1
2
3
4
5
6

7
8
9
10
11
12
13
14






-
+







# This file is the basis for a binary Tcl RPM for Linux.

%{!?directory:%define directory /usr/local}

Name:          tcl
Summary:       Tcl scripting language development environment
Version:       9.0a1
Version:       8.5.19
Release:       2
License:       BSD
Group:         Development/Languages
Source:        http://prdownloads.sourceforge.net/tcl/tcl%{version}-src.tar.gz
URL:           http://www.tcl.tk/
Buildroot:     /var/tmp/%{name}%{version}

Changes to unix/tclAppInit.c.

1
2
3
4
5

6
7
8
9

10
11
12
13
14
15
16
17
18
19



20
21


22
23

24
25
26

27
28
29
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44
45
46
47
48
49
50

51


52
53
54
55
56
57
58
59
60
61
62

63
64
65
66

67
68
69
70
71
72
73
74

75






















76
77
78
79
80
81
82
83
84
85
86

87
88
89
90
91
92
93
94
95

96
97

98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

114
115
116

117
118
119
120
121
122
123
124
125
126
127










128
129
130
131

132
133
134
135
136
137
138
139
140
141
142
143
144

145
146
147
148
149
150
151


152
153
154
155
156

157
158
159

160
161
162
163
164
165
166
167
168
169
170
171
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




-
+



-
+





-
-



+
+
+
-
-
+
+
-
-
+
-
-
-
+
-

-
-
-
-
-
-
-
-
-
+
-
-
-
-
-

-
-
-
-
-
-
-
+
-
+
+










-
+



-
+







-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-



+








-
+

-
+















-
+



+





-
-



-
+
+
+
+
+
+
+
+
+
+



-
+












-
+





-
-
+
+



-
-
+

-
-
+












/*
 * tclAppInit.c --
 *
 *	Provides a default version of the main program and Tcl_AppInit
 *	procedure for tclsh and other Tcl-based applications (without Tk).
 *	function for Tcl applications (without Tk).
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 * 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.
 */

#undef BUILD_tcl
#undef STATIC_BUILD
#include "tcl.h"

#ifdef TCL_TEST

#include "tclInt.h"

extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
extern Tcl_PackageInitProc	Procbodytest_Init;
extern Tcl_PackageInitProc	Procbodytest_SafeInit;
#endif /* TCL_TEST */

extern Tcl_PackageInitProc	TclObjTest_Init;
#ifdef TCL_XT_TEST
extern void                XtToolkitInitialize(void);
extern Tcl_PackageInitProc Tclxttest_Init;
extern Tcl_PackageInitProc	Tcltest_Init;
#endif /* TCL_XT_TEST */

/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
 */

#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
#endif /* TCL_TEST */
#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif
MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);
MODULE_SCOPE int main(int, char **);

/*
 * The following #if block allows you to change how Tcl finds the startup
 * script, prime the library or encoding paths, fiddle with the argv, etc.,
 * without needing to rewrite Tcl_Main()
 */

#ifdef TCL_LOCAL_MAIN_HOOK
#ifdef TCL_XT_TEST
MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, char ***argv);
extern void		XtToolkitInitialize (void);
extern int		Tclxttest_Init (Tcl_Interp *interp);
#endif

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.
 *
 * Results:
 *	None: Tcl_Main never returns here, so this procedure never returns
 *	None: Tcl_Main never returns here, so this function never returns
 *	either.
 *
 * Side effects:
 *	Just about anything, since from here we call arbitrary Tcl code.
 *	Whatever the application does.
 *
 *----------------------------------------------------------------------
 */

int
main(
    int argc,			/* Number of command-line arguments. */
    char *argv[])		/* Values of command-line arguments. */
    char **argv)		/* Values of command-line arguments. */
{
    /*
     * The following #if block allows you to change the AppInit function by
     * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire
     * file. The #if checks for that #define and uses Tcl_AppInit if it does
     * not exist.
     */

#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
    extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp);

    /*
     * The following #if block allows you to change how Tcl finds the startup
     * script, prime the library or encoding paths, fiddle with the argv,
     * etc., without needing to rewrite Tcl_Main()
     */

#ifdef TCL_LOCAL_MAIN_HOOK
    extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv);
#endif

#ifdef TCL_XT_TEST
    XtToolkitInitialize();
#endif

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#else
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);

    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization. Most
 *	This function performs application-specific initialization. Most
 *	applications, especially those that incorporate additional packages,
 *	will have their own version of this procedure.
 *	will have their own version of this function.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error message in
 *	the interp's result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AppInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if ((Tcl_Init)(interp) == TCL_ERROR) {
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

#ifdef TCL_TEST
#ifdef TCL_XT_TEST
    if (Tclxttest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
#endif

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
	    (Tcl_PackageInitProc *) NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
	    Procbodytest_SafeInit);
#endif /* TCL_TEST */

    /*
     * Call the init procedures for included packages. Each call should look
     * Call the init functions for included packages. Each call should look
     * like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module. (Dynamically-loadable packages
     * should have the same entry-point name.)
     */

    /*
     * Call Tcl_CreateCommand for application-specific commands, if they
     * weren't already created by the init procedures called above.
     * weren't already created by the init functions called above.
     */

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.
     * is the name of the application. If this line is deleted then no user-
     * specific startup file will be run under any conditions.
     */

#ifdef DJGPP
    (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
	    Tcl_NewStringObj("~/tclsh.rc", -1), TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
#else
    (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
	    Tcl_NewStringObj("~/.tclshrc", -1), TCL_GLOBAL_ONLY);
    Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
#endif

    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclConfig.h.in.

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
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






+
+
-
-
+
+
+













-
-
-







/* ../unix/tclConfig.h.in.  Generated from configure.ac by autoheader.  */


    #ifndef _TCLCONFIG
    #define _TCLCONFIG

/* Is pthread_attr_get_np() declared in <pthread.h>? */
#undef ATTRGETNP_NOT_DECLARED
/* Define if building universal (internal helper macro) */
#undef AC_APPLE_UNIVERSAL_BUILD

/* Is pthread_getattr_np declared in <pthread.h>? */
#undef GETATTRNP_NOT_DECLARED

/* Is gettimeofday() actually declared in <sys/time.h>? */
#undef GETTOD_NOT_DECLARED

/* Define to 1 if you have the <AvailabilityMacros.h> header file. */
#undef HAVE_AVAILABILITYMACROS_H

/* Define to 1 if the system has the type `blkcnt_t'. */
#undef HAVE_BLKCNT_T

/* Defined when compiler supports casting to union type. */
#undef HAVE_CAST_TO_UNION

/* Define to 1 if you have the `cfmakeraw' function. */
#undef HAVE_CFMAKERAW

/* Define to 1 if you have the `chflags' function. */
#undef HAVE_CHFLAGS

/* Define to 1 if you have the `copyfile' function. */
#undef HAVE_COPYFILE

/* Define to 1 if you have the <copyfile.h> header file. */
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
41
42
43
44
45
46
47




48
49
50






51
52
53




54
55
56
57
58
59
60
61







-
-
-
-



-
-
-
-
-
-



-
-
-
-
+







   you don't. */
#undef HAVE_DECL_GETHOSTBYADDR_R

/* Define to 1 if you have the declaration of `gethostbyname_r', and to 0 if
   you don't. */
#undef HAVE_DECL_GETHOSTBYNAME_R

/* Define to 1 if you have the declaration of `PTHREAD_MUTEX_RECURSIVE', and
   to 0 if you don't. */
#undef HAVE_DECL_PTHREAD_MUTEX_RECURSIVE

/* Is 'DIR64' in <sys/types.h>? */
#undef HAVE_DIR64

/* Is eventfd(2) supported? */
#undef HAVE_EVENTFD

/* Define to 1 if you have the `freeaddrinfo' function. */
#undef HAVE_FREEADDRINFO

/* Do we have fts functions? */
#undef HAVE_FTS

/* Define to 1 if you have the `gai_strerror' function. */
#undef HAVE_GAI_STRERROR

/* Define to 1 if you have the `getaddrinfo' function. */
/* Define to 1 if getaddrinfo is available. */
#undef HAVE_GETADDRINFO

/* Define to 1 if you have the `getattrlist' function. */
#undef HAVE_GETATTRLIST

/* Define to 1 if you have the `getcwd' function. */
#undef HAVE_GETCWD
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
95
96
97
98
99
100
101



102
103
104
105
106
107
108







-
-
-








/* Define to 1 if gethostbyname_r takes 5 args. */
#undef HAVE_GETHOSTBYNAME_R_5

/* Define to 1 if gethostbyname_r takes 6 args. */
#undef HAVE_GETHOSTBYNAME_R_6

/* Define to 1 if you have the `getnameinfo' function. */
#undef HAVE_GETNAMEINFO

/* Define to 1 if getpwnam_r is available. */
#undef HAVE_GETPWNAM_R

/* Define to 1 if getpwnam_r takes 4 args. */
#undef HAVE_GETPWNAM_R_4

/* Define to 1 if getpwnam_r takes 5 args. */
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
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







-
-
-
+
-










+
+
+










-
-
-
-
-
-








/* Define to 1 if getpwuid_r takes 5 args. */
#undef HAVE_GETPWUID_R_5

/* Define to 1 if you have the `gmtime_r' function. */
#undef HAVE_GMTIME_R

/* Compiler support for module scope symbols */
#undef HAVE_HIDDEN

/* Define to 1 if the system has the type `intptr_t'. */
/* Do we have the intptr_t type? */
#undef HAVE_INTPTR_T

/* Define to 1 if you have the <inttypes.h> header file. */
#undef HAVE_INTTYPES_H

/* Do we have nl_langinfo()? */
#undef HAVE_LANGINFO

/* Define to 1 if you have the <libkern/OSAtomic.h> header file. */
#undef HAVE_LIBKERN_OSATOMIC_H

/* Do we have <limits.h>? */
#undef HAVE_LIMITS_H

/* Define to 1 if you have the `localtime_r' function. */
#undef HAVE_LOCALTIME_R

/* Define to 1 if you have the `lseek64' function. */
#undef HAVE_LSEEK64

/* Define to 1 if you have the <memory.h> header file. */
#undef HAVE_MEMORY_H

/* Define to 1 if you have the `mkstemp' function. */
#undef HAVE_MKSTEMP

/* Define to 1 if you have the `mkstemps' function. */
#undef HAVE_MKSTEMPS

/* Define to 1 if you have the `mktime' function. */
#undef HAVE_MKTIME

/* Do we have MT-safe gethostbyaddr() ? */
#undef HAVE_MTSAFE_GETHOSTBYADDR

/* Do we have MT-safe gethostbyname() ? */
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
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







+
+
+



+
+
+
+
+
+







-
-
-















-
-
-



-
-
-
-
-
-
-
-
-



-
+


-
+


-
-
-
-
-
-
-
-
-







#undef HAVE_OPENDIR

/* Define to 1 if you have the `OSSpinLockLock' function. */
#undef HAVE_OSSPINLOCKLOCK

/* Define to 1 if you have the `pthread_atfork' function. */
#undef HAVE_PTHREAD_ATFORK

/* Do we want a BSD-like thread-attribute interface? */
#undef HAVE_PTHREAD_ATTR_GET_NP

/* Define to 1 if you have the `pthread_attr_setstacksize' function. */
#undef HAVE_PTHREAD_ATTR_SETSTACKSIZE

/* Do we want a Linux-like thread-attribute interface? */
#undef HAVE_PTHREAD_GETATTR_NP

/* Define to 1 if you have the `pthread_get_stacksize_np' function. */
#undef HAVE_PTHREAD_GET_STACKSIZE_NP

/* Does putenv() copy strings or incorporate them by reference? */
#undef HAVE_PUTENV_THAT_COPIES

/* Are characters signed? */
#undef HAVE_SIGNED_CHAR

/* Do we have <stdbool.h>? */
#undef HAVE_STDBOOL_H

/* Define to 1 if you have the <stdint.h> header file. */
#undef HAVE_STDINT_H

/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H

/* Define to 1 if you have the <strings.h> header file. */
#undef HAVE_STRINGS_H

/* Define to 1 if you have the <string.h> header file. */
#undef HAVE_STRING_H

/* Define to 1 if you have the `strtol' function. */
#undef HAVE_STRTOL

/* Define to 1 if the system has the type `struct addrinfo'. */
#undef HAVE_STRUCT_ADDRINFO

/* Is 'struct dirent64' in <sys/types.h>? */
#undef HAVE_STRUCT_DIRENT64

/* Define to 1 if the system has the type `struct in6_addr'. */
#undef HAVE_STRUCT_IN6_ADDR

/* Define to 1 if the system has the type `struct sockaddr_in6'. */
#undef HAVE_STRUCT_SOCKADDR_IN6

/* Define to 1 if the system has the type `struct sockaddr_storage'. */
#undef HAVE_STRUCT_SOCKADDR_STORAGE

/* Is 'struct stat64' in <sys/stat.h>? */
#undef HAVE_STRUCT_STAT64

/* Define to 1 if `st_blksize' is a member of `struct stat'. */
/* Define to 1 if `st_blksize' is member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLKSIZE

/* Define to 1 if `st_blocks' is a member of `struct stat'. */
/* Define to 1 if `st_blocks' is member of `struct stat'. */
#undef HAVE_STRUCT_STAT_ST_BLOCKS

/* Define to 1 if you have the <sys/epoll.h> header file. */
#undef HAVE_SYS_EPOLL_H

/* Define to 1 if you have the <sys/eventfd.h> header file. */
#undef HAVE_SYS_EVENTFD_H

/* Define to 1 if you have the <sys/event.h> header file. */
#undef HAVE_SYS_EVENT_H

/* Define to 1 if you have the <sys/filio.h> header file. */
#undef HAVE_SYS_FILIO_H

/* Define to 1 if you have the <sys/ioctl.h> header file. */
#undef HAVE_SYS_IOCTL_H

/* Define to 1 if you have the <sys/modem.h> header file. */
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
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







-
-
-












-
+











-
-
-



-
+








-
-
-
-
-
-
-
-
-











+
+
+












+
+
+








/* Define to 1 if you have the <sys/time.h> header file. */
#undef HAVE_SYS_TIME_H

/* Define to 1 if you have the <sys/types.h> header file. */
#undef HAVE_SYS_TYPES_H

/* Define to 1 if you have the <termios.h> header file. */
#undef HAVE_TERMIOS_H

/* Should we use the global timezone variable? */
#undef HAVE_TIMEZONE_VAR

/* Should we use the tm_gmtoff field of struct tm? */
#undef HAVE_TM_GMTOFF

/* Should we use the tm_tzadj field of struct tm? */
#undef HAVE_TM_TZADJ

/* Is off64_t in <sys/types.h>? */
#undef HAVE_TYPE_OFF64_T

/* Do we have the uintptr_t type? */
/* Define to 1 if the system has the type `uintptr_t'. */
#undef HAVE_UINTPTR_T

/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H

/* Define to 1 if you have the `waitpid' function. */
#undef HAVE_WAITPID

/* Is weak import available? */
#undef HAVE_WEAK_IMPORT

/* Is there an installed zlib? */
#undef HAVE_ZLIB

/* Is this a Mac I see before me? */
#undef MAC_OSX_TCL

/* No Compiler support for module scope symbols */
/* Compiler support for module scope symbols */
#undef MODULE_SCOPE

/* Default libtommath precision. */
#undef MP_PREC

/* Is no debugging enabled? */
#undef NDEBUG

/* Use compat implementation of getaddrinfo() and friends */
#undef NEED_FAKE_RFC2553

/* Is epoll(7) supported? */
#undef NOTIFIER_EPOLL

/* Is kqueue(2) supported? */
#undef NOTIFIER_KQUEUE

/* Is Darwin CoreFoundation unavailable for 64-bit? */
#undef NO_COREFOUNDATION_64

/* Do we have <dirent.h>? */
#undef NO_DIRENT_H

/* Do we have <dlfcn.h>? */
#undef NO_DLFCN_H

/* Do we have fd_set? */
#undef NO_FD_SET

/* Do we have <float.h>? */
#undef NO_FLOAT_H

/* Do we have fstatfs()? */
#undef NO_FSTATFS

/* Do we have gettimeofday()? */
#undef NO_GETTOD

/* Do we have getwd() */
#undef NO_GETWD

/* Do we have a usable 'isnan'? */
#undef NO_ISNAN

/* Do we have <limits.h>? */
#undef NO_LIMITS_H

/* Do we have memmove()? */
#undef NO_MEMMOVE

/* Do we have realpath() */
#undef NO_REALPATH

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
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







+
+
+
















-
-
-







#undef NO_SYS_WAIT_H

/* Do we have uname() */
#undef NO_UNAME

/* Do we have a usable 'union wait'? */
#undef NO_UNION_WAIT

/* Do we have <values.h>? */
#undef NO_VALUES_H

/* Do we have wait3() */
#undef NO_WAIT3

/* Define to the address where bug reports for this package should be sent. */
#undef PACKAGE_BUGREPORT

/* Define to the full name of this package. */
#undef PACKAGE_NAME

/* Define to the full name and version of this package. */
#undef PACKAGE_STRING

/* Define to the one symbol short name of this package. */
#undef PACKAGE_TARNAME

/* Define to the home page for this package. */
#undef PACKAGE_URL

/* Define to the version of this package. */
#undef PACKAGE_VERSION

/* Is this a static build? */
#undef STATIC_BUILD

/* Define to 1 if you have the ANSI C header files. */
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
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
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
450







+
+
+
+
+
+












+
+
+
+
+
+
+
+
+







-
+





-
-
-














+
+
+
+
+
+
+
+
+
+
+
+




-
-
+
+
-
-
-
-
-
-
-
+
-
-
-
-
-







#undef TCL_CFG_OPTIMIZED

/* Is bytecode debugging enabled? */
#undef TCL_COMPILE_DEBUG

/* Are bytecode statistics enabled? */
#undef TCL_COMPILE_STATS

/* Are we cross-compiling? */
#undef TCL_CROSS_COMPILE

/* Are we to override what our default encoding is? */
#undef TCL_DEFAULT_ENCODING

/* Is Tcl built as a framework? */
#undef TCL_FRAMEWORK

/* Can this platform load code from memory? */
#undef TCL_LOAD_FROM_MEMORY

/* Is memory debugging enabled? */
#undef TCL_MEM_DEBUG

/* What is the default extension for shared libraries? */
#undef TCL_SHLIB_EXT

/* The C stack grows upwards in memory. */
#undef TCL_STACK_GROWS_UP

/* Are we building with threads enabled? */
#undef TCL_THREADS

/* Build libtommath? */
#undef TCL_TOMMATH

/* Do we allow unloading of shared libraries? */
#undef TCL_UNLOAD_DLLS

/* Does this platform have wide high-resolution clicks? */
#undef TCL_WIDE_CLICKS

/* Do 'long' and 'long long' have the same size (64-bit)? */
/* Are wide integers to be implemented with C 'long's? */
#undef TCL_WIDE_INT_IS_LONG

/* What type should be used to define wide integers? */
#undef TCL_WIDE_INT_TYPE

/* Tcl with external libtommath */
#undef TCL_WITH_EXTERNAL_TOMMATH

/* Define to 1 if you can safely include both <sys/time.h> and <time.h>. */
#undef TIME_WITH_SYS_TIME

/* Is getcwd Posix-compliant? */
#undef USEGETWD

/* May we include <dirent2.h>? */
#undef USE_DIRENT2_H

/* Are we building with DTrace support? */
#undef USE_DTRACE

/* Should we use FIONBIO? */
#undef USE_FIONBIO

/* Use the sgtty API for serial lines */
#undef USE_SGTTY

/* Use the termio API for serial lines */
#undef USE_TERMIO

/* Use the termios API for serial lines */
#undef USE_TERMIOS

/* Do we want to use the threaded memory allocator? */
#undef USE_THREAD_ALLOC

/* Should we use vfork() instead of fork()? */
#undef USE_VFORK

/* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most
   significant byte first (like Motorola and SPARC, unlike Intel). */
/* Define to 1 if your processor stores words with the most significant byte
   first (like Motorola and SPARC, unlike Intel and VAX). */
#if defined AC_APPLE_UNIVERSAL_BUILD
# if defined __BIG_ENDIAN__
#  define WORDS_BIGENDIAN 1
# endif
#else
# ifndef WORDS_BIGENDIAN
#  undef WORDS_BIGENDIAN
#undef WORDS_BIGENDIAN
# endif
#endif

/* Are we building with zipfs enabled? */
#undef ZIPFS_BUILD

/* Are Darwin SUSv3 extensions available? */
#undef _DARWIN_C_SOURCE

/* Add the _ISOC99_SOURCE flag when building */
#undef _ISOC99_SOURCE

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
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







-
-
-






-
+




+
+
+




-
-
-




-
-
+
+
+


/* Define to `__inline__' or `__inline' if that's what the C compiler
   calls it, or to nothing if 'inline' is not supported under any name.  */
#ifndef __cplusplus
#undef inline
#endif

/* Signed integer type wide enough to hold a pointer. */
#undef intptr_t

/* Define to `int' if <sys/types.h> does not define. */
#undef mode_t

/* Define to `int' if <sys/types.h> does not define. */
#undef pid_t

/* Define to `unsigned int' if <sys/types.h> does not define. */
/* Define to `unsigned' if <sys/types.h> does not define. */
#undef size_t

/* Define as int if socklen_t is not available */
#undef socklen_t

/* Do we want to use the strtod() in compat? */
#undef strtod

/* Define to `int' if <sys/types.h> doesn't define. */
#undef uid_t

/* Unsigned integer type wide enough to hold a pointer. */
#undef uintptr_t


    /* Undef unused package specific autoheader defines so that we can
     * include both tclConfig.h and tkConfig.h at the same time: */
    /* override */ #undef PACKAGE_NAME
    /* override */ #undef PACKAGE_STRING
    /* override */ #undef PACKAGE_TARNAME
    /* override */ #undef PACKAGE_TARNAME
    /* override */ #undef PACKAGE_VERSION
    /* override */ #undef PACKAGE_STRING
    #endif /* _TCLCONFIG */

Changes to unix/tclConfig.sh.in.

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
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







+
+
+
+















-
-
-







TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@'

# C compiler to use for compilation.
TCL_CC='@CC@'

# -D flags for use with the C compiler.
TCL_DEFS='@DEFS@'

# TCL_DBGX used to be used to distinguish debug vs. non-debug builds.
# This was a righteous pain so the core doesn't do that any more.
TCL_DBGX=

# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@'

# Default linker flags used in an optimized and debuggable build, respectively.
TCL_LDFLAGS_DEBUG='@LDFLAGS_DEBUG@'
TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'

# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
TCL_ZIP_FILE='@TCL_ZIP_FILE@'

# Additional libraries to use when linking Tcl.
TCL_LIBS='@TCL_LIBS@'

# Top-level directory in which Tcl's platform-independent files are
# installed.
TCL_PREFIX='@prefix@'

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
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







-
+














-
+







# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='@SHLIB_LD@'

# Base command to use for combining object files into a static library:
TCL_STLIB_LD='@STLIB_LD@'

# Either '$LIBS' (if dependent libraries should be included when linking
# shared libraries) or an empty string.  See Tcl's configure.ac for more
# shared libraries) or an empty string.  See Tcl's configure.in for more
# explanation.
TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'

# Suffix to use for the name of a shared library.
TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'

# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
TCL_DL_LIBS='@DL_LIBS@'

# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
TCL_LD_FLAGS='@LDFLAGS@'

# Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the
# Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
# run-time dynamic linker where to look for shared libraries such as
# libtcl.so.  Used when linking applications.  Only works if there
# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
TCL_CC_SEARCH_FLAGS='@CC_SEARCH_FLAGS@'
TCL_LD_SEARCH_FLAGS='@LD_SEARCH_FLAGS@'

# Additional object files linked with Tcl to provide compatibility
159
160
161
162
163
164
165



160
161
162
163
164
165
166
167
168
169







+
+
+
TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'

# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=@TCL_THREADS@

Deleted unix/tclEpollNotfy.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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





































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclEpollNotfy.c --
 *
 *	This file contains the implementation of the epoll()-based
 *	Linux-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if defined(NOTIFIER_EPOLL) && TCL_THREADS
#ifndef _GNU_SOURCE
#   define _GNU_SOURCE		/* For pipe2(2) */
#endif
#include <fcntl.h>
#include <signal.h>
#include <sys/epoll.h>
#ifdef HAVE_EVENTFD
#include <sys/eventfd.h>
#endif /* HAVE_EVENTFD */
#include <sys/queue.h>

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

struct PlatformEventData;
typedef struct FileHandler {
    int fd;
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
				 * FileHandler with epoll(7) events. */
} FileHandler;

/*
 * The following structure associates a FileHandler and the thread that owns
 * it with the file descriptors of interest and their event masks passed to
 * epoll_ctl(2) and their corresponding event(s) returned by epoll_wait(2).
 */

struct ThreadSpecificData;
struct PlatformEventData {
    FileHandler *filePtr;
    struct ThreadSpecificData *tsdPtr;
};

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */

typedef struct {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    int fd;			/* File descriptor that is ready. Used to find
				 * the FileHandler structure for the file
				 * (can't point directly to the FileHandler
				 * structure because it could go away while
				 * the event is queued). */
} FileHandlerEvent;

/*
 * The following static structure contains the state information for the
 * epoll based implementation of the Tcl notifier. One of these structures is
 * created for each thread that is using the notifier.
 */

LIST_HEAD(PlatformReadyFileHandlerList, FileHandler);
typedef struct ThreadSpecificData {
    FileHandler *triggerFilePtr;
    FileHandler *firstFileHandlerPtr;
				/* Pointer to head of file handler list. */
    struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
				/* Pointer to head of list of FileHandlers
				 * associated with regular files (S_IFREG)
				 * that are ready for I/O. */
    pthread_mutex_t notifierMutex;
				/* Mutex protecting notifier termination in
				 * PlatformEventsFinalize. */
#ifdef HAVE_EVENTFD
    int triggerEventFd;		/* eventfd(2) used by other threads to wake
				 * up this thread for inter-thread IPC. */
#else
    int triggerPipe[2];		/* pipe(2) used by other threads to wake
				 * up this thread for inter-thread IPC. */
#endif /* HAVE_EVENTFD */
    int eventsFd;		/* epoll(7) file descriptor used to wait for
				 * fds */
    struct epoll_event *readyEvents;
				/* Pointer to at most maxReadyEvents events
				 * returned by epoll_wait(2). */
    size_t maxReadyEvents;	/* Count of epoll_events in readyEvents. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations.
 */

static void		PlatformEventsControl(FileHandler *filePtr,
			    ThreadSpecificData *tsdPtr, int op, int isNew);
static void		PlatformEventsFinalize(void);
static void		PlatformEventsInit(void);
static int		PlatformEventsTranslate(struct epoll_event *event);
static int		PlatformEventsWait(struct epoll_event *events,
			    size_t numEvents, struct timeval *timePtr);

/*
 * Incorporate the base notifier API.
 */

#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * Results:
 *	Returns a handle to the notifier state for this thread.
 *
 * Side effects:
 *	If no initNotifierProc notifier hook exists, PlatformEventsInit
 *	is called.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	PlatformEventsInit();
	return tsdPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	This function is called to cleanup the notifier state before a thread
 *	is terminated.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If no finalizeNotifierProc notifier hook exists, PlatformEvents-
 *	Finalize is called.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
	PlatformEventsFinalize();
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsControl --
 *
 *	This function registers interest for the file descriptor and the mask
 *	of TCL_* bits associated with filePtr on the epoll file descriptor
 *	associated with tsdPtr.
 *
 *	Future calls to epoll_wait will return filePtr and tsdPtr alongside
 *	with the event registered here via the PlatformEventData struct.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	- If adding a new file descriptor, a PlatformEventData struct will be
 *	  allocated and associated with filePtr.
 *	- fstat is called on the file descriptor; if it is associated with a
 *	  regular file (S_IFREG,) filePtr is considered to be ready for I/O
 *	  and added to or deleted from the corresponding list in tsdPtr.
 *	- If it is not associated with a regular file, the file descriptor is
 *	  added, modified concerning its mask of events of interest, or
 *	  deleted from the epoll file descriptor of the calling thread.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsControl(
    FileHandler *filePtr,
    ThreadSpecificData *tsdPtr,
    int op,
    int isNew)
{
    struct epoll_event newEvent;
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    newEvent.events = 0;
    if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
	newEvent.events |= EPOLLIN;
    }
    if (filePtr->mask & TCL_WRITABLE) {
	newEvent.events |= EPOLLOUT;
    }
    if (isNew) {
        newPedPtr = (struct PlatformEventData *)Tcl_Alloc(sizeof(struct PlatformEventData));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
	filePtr->pedPtr = newPedPtr;
    }
    newEvent.data.ptr = filePtr->pedPtr;

    /*
     * N.B. As discussed in Tcl_WaitForEvent(), epoll(7) does not support
     * regular files (S_IFREG.) Therefore, filePtr is in these cases simply
     * added or deleted from the list of FileHandlers associated with regular
     * files belonging to tsdPtr.
     */

    if (fstat(filePtr->fd, &fdStat) == -1) {
	Tcl_Panic("fstat: %s", strerror(errno));
    } else if ((fdStat.st_mode & S_IFMT) == S_IFREG) {
	switch (op) {
	case EPOLL_CTL_ADD:
	    if (isNew) {
		LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
			readyNode);
	    }
	    break;
	case EPOLL_CTL_DEL:
	    LIST_REMOVE(filePtr, readyNode);
	    break;
	}
	return;
   } else if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) {
	Tcl_Panic("epoll_ctl: %s", strerror(errno));
   }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsFinalize --
 *
 *	This function closes the eventfd and the epoll file descriptor and
 *	frees the epoll_event structs owned by the thread of the caller.  The
 *	above operations are protected by tsdPtr->notifierMutex, which is
 *	destroyed thereafter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 * 	While tsdPtr->notifierMutex is held:
 *	- The per-thread eventfd(2) is closed, if non-zero, and set to -1.
 *	- The per-thread epoll(7) fd is closed, if non-zero, and set to 0.
 *	- The per-thread epoll_event structs are freed, if any, and set to 0.
 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
	void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
#ifdef HAVE_EVENTFD
    if (tsdPtr->triggerEventFd) {
	close(tsdPtr->triggerEventFd);
	tsdPtr->triggerEventFd = -1;
    }
#else /* !HAVE_EVENTFD */
    if (tsdPtr->triggerPipe[0]) {
	close(tsdPtr->triggerPipe[0]);
	tsdPtr->triggerPipe[0] = -1;
    }
    if (tsdPtr->triggerPipe[1]) {
	close(tsdPtr->triggerPipe[1]);
	tsdPtr->triggerPipe[1] = -1;
    }
#endif /* HAVE_EVENTFD */
    Tcl_Free(tsdPtr->triggerFilePtr->pedPtr);
    Tcl_Free(tsdPtr->triggerFilePtr);
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	Tcl_Free(tsdPtr->readyEvents);
	tsdPtr->maxReadyEvents = 0;
    }
    pthread_mutex_unlock(&tsdPtr->notifierMutex);
    if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
	Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsInit --
 *
 *	This function abstracts creating a kqueue fd via the epoll_create
 *	system call and allocating memory for the epoll_event structs in
 *	tsdPtr for the thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The following per-thread entities are initialised:
 *	- notifierMutex is initialised.
 *	- The eventfd(2) is created w/ EFD_CLOEXEC and EFD_NONBLOCK.
 *	- The epoll(7) fd is created w/ EPOLL_CLOEXEC.
 *	- A FileHandler struct is allocated and initialised for the
 *	  eventfd(2), registering interest for TCL_READABLE on it via
 *	  PlatformEventsControl().
 *	- readyEvents and maxReadyEvents are initialised with 512
 *	  epoll_events.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsInit(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (errno) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
    }
    filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
#ifdef HAVE_EVENTFD
    tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
    if (tsdPtr->triggerEventFd <= 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd");
    }
    filePtr->fd = tsdPtr->triggerEventFd;
#else /* !HAVE_EVENTFD */
    if (pipe2(tsdPtr->triggerPipe, O_CLOEXEC | O_NONBLOCK) != 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
    }
    filePtr->fd = tsdPtr->triggerPipe[0];
#endif /* HAVE_EVENTFD */
    tsdPtr->triggerFilePtr = filePtr;
    if ((tsdPtr->eventsFd = epoll_create1(EPOLL_CLOEXEC)) == -1) {
	Tcl_Panic("epoll_create1: %s", strerror(errno));
    }
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = (struct epoll_event *)Tcl_Alloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsTranslate --
 *
 *	This function translates the platform-specific mask of returned events
 *	in eventPtr to a mask of TCL_* bits.
 *
 * Results:
 *	Returns the translated mask.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsTranslate(
    struct epoll_event *eventPtr)
{
    int mask;

    mask = 0;
    if (eventPtr->events & (EPOLLIN | EPOLLHUP)) {
	mask |= TCL_READABLE;
    }
    if (eventPtr->events & EPOLLOUT) {
	mask |= TCL_WRITABLE;
    }
    if (eventPtr->events & EPOLLERR) {
	mask |= TCL_EXCEPTION;
    }
    return mask;
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsWait --
 *
 *	This function abstracts waiting for I/O events via epoll_wait.
 *
 * Results:
 *	Returns -1 if epoll_wait failed. Returns 0 if polling and if no events
 *	became available whilst polling. Returns a pointer to and the count of
 *	all returned events in all other cases.
 *
 * Side effects:
 *	gettimeofday(2), epoll_wait(2), and gettimeofday(2) are called, in the
 *	specified order.
 *	If timePtr specifies a positive value, it is updated to reflect the
 *	amount of time that has passed; if its value would {under, over}flow,
 *	it is set to zero.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsWait(
    struct epoll_event *events,
    size_t numEvents,
    struct timeval *timePtr)
{
    int numFound;
    struct timeval tv0, tv1, tv_delta;
    int timeout;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * If timePtr is NULL, epoll_wait(2) will wait indefinitely. If it
     * specifies a timeout of {0,0}, epoll_wait(2) will poll. Otherwise, the
     * timeout will simply be converted to milliseconds.
     */

    if (!timePtr) {
	timeout = -1;
    } else if (!timePtr->tv_sec && !timePtr->tv_usec) {
	timeout = 0;
    } else {
	timeout = (int)timePtr->tv_sec * 1000;
	if (timePtr->tv_usec) {
	    timeout += (int)timePtr->tv_usec / 1000;
	}
    }

    /*
     * Call (and possibly block on) epoll_wait(2) and substract the delta of
     * gettimeofday(2) before and after the call from timePtr if the latter is
     * not NULL. Return the number of events returned by epoll_wait(2).
     */

    gettimeofday(&tv0, NULL);
    numFound = epoll_wait(tsdPtr->eventsFd, events, (int)numEvents, timeout);
    gettimeofday(&tv1, NULL);
    if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) {
	timersub(&tv1, &tv0, &tv_delta);
	if (!timercmp(&tv_delta, timePtr, >)) {
	    timersub(timePtr, &tv_delta, timePtr);
	} else {
	    timePtr->tv_sec = 0;
	    timePtr->tv_usec = 0;
	}
    }
    return numFound;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This function registers a file handler with the epoll notifier of the
 *	thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *	PlatformEventsControl() is called for the new file handler structure.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateFileHandler(
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    int isNew;

    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
	filePtr->mask = mask;

	PlatformEventsControl(filePtr, tsdPtr,
		isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file on the
 *	epoll file descriptor of the thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *	PlatformEventsControl() is called for the file handler structure.
 *	The PlatformEventData struct associated with the new file handler
 *	structure is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * Find the entry for the given file (and return if there isn't one).
	 */

	for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
		prevPtr = filePtr, filePtr = filePtr->nextPtr) {
	    if (filePtr == NULL) {
		return;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
	if (filePtr->pedPtr) {
	    Tcl_Free(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This function is called by Tcl_DoOneEvent to wait for new events on
 *	the message queue. If the block time is 0, then Tcl_WaitForEvent just
 *	polls without blocking.
 *
 *	The waiting logic is implemented in PlatformEventsWait.
 *
 * Results:
 *	Returns -1 if PlatformEventsWait() would block forever, otherwise
 *	returns 0.
 *
 * Side effects:
 *	Queues file events that are detected by PlatformEventsWait().
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)	/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
	/*
	 * Impl. notes: timeout & timeoutPtr are used if, and only if threads
	 * are not enabled. They are the arguments for the regular epoll_wait()
	 * used when the core is not thread-enabled.
	 */

	struct timeval timeout, *timeoutPtr;
	int numFound, numEvent;
	struct PlatformEventData *pedPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	int numQueued;
	ssize_t i;

	/*
	 * Set up the timeout structure. Note that if there are no events to
	 * check for, we return with a negative result rather than blocking
	 * forever.
	 */

	if (timePtr != NULL) {
	    /*
	     * TIP #233 (Virtualized Time). Is virtual time in effect? And do
	     * we actually have something to scale? If yes to both then we
	     * call the handler to do this scaling.
	     */

	    if (timePtr->sec != 0 || timePtr->usec != 0) {
		vTime = *timePtr;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		timePtr = &vTime;
	    }
	    timeout.tv_sec = timePtr->sec;
	    timeout.tv_usec = timePtr->usec;
	    timeoutPtr = &timeout;
	} else {
	    timeoutPtr = NULL;
	}

	/*
	 * Walk the list of FileHandlers associated with regular files
	 * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and
	 * update their mask of events of interest.
	 *
	 * As epoll(7) does not support regular files, the behaviour of
	 * {select,poll}(2) is simply simulated here: fds associated with
	 * regular files are added to this list by PlatformEventsControl() and
	 * processed here before calling (and possibly blocking) on
	 * PlatformEventsWait().
	 */

	numQueued = 0;
	LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) {
	    mask = 0;
	    if (filePtr->mask & TCL_READABLE) {
		mask |= TCL_READABLE;
	    }
	    if (filePtr->mask & TCL_WRITABLE) {
		mask |= TCL_WRITABLE;
	    }

	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
	}

	/*
	 * If any events were queued in the above loop, force
	 * PlatformEventsWait() to poll as there already are events that need
	 * to be processed at this point.
	 */

	if (numQueued) {
	    timeout.tv_sec = 0;
	    timeout.tv_usec = 0;
	    timeoutPtr = &timeout;
	}

	/*
	 * Wait or poll for new events, queue Tcl events for the FileHandlers
	 * corresponding to them, and update the FileHandlers' mask of events
	 * of interest registered by the last call to Tcl_CreateFileHandler().
	 *
	 * Events for the eventfd(2)/trigger pipe are processed here in order
	 * to facilitate inter-thread IPC. If another thread intends to wake
	 * up this thread whilst it's blocking on PlatformEventsWait(), it
	 * write(2)s to the eventfd(2)/trigger pipe (see Tcl_AlertNotifier(),)
	 * which in turn will cause PlatformEventsWait() to return
	 * immediately.
	 */

	numFound = PlatformEventsWait(tsdPtr->readyEvents,
		tsdPtr->maxReadyEvents, timeoutPtr);
	for (numEvent = 0; numEvent < numFound; numEvent++) {
	    pedPtr = (struct PlatformEventData*)tsdPtr->readyEvents[numEvent].data.ptr;
	    filePtr = pedPtr->filePtr;
	    mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
#ifdef HAVE_EVENTFD
	    if (filePtr->fd == tsdPtr->triggerEventFd) {
		uint64_t eventFdVal;
		i = read(tsdPtr->triggerEventFd, &eventFdVal,
			sizeof(eventFdVal));
		if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) {
		    Tcl_Panic(
			    "Tcl_WaitForEvent: read from %p->triggerEventFd: %s",
			    (void *) tsdPtr, strerror(errno));
		}
		continue;
	    }
#else /* !HAVE_EVENTFD */
	    if (filePtr->fd == tsdPtr->triggerPipe[0]) {
		char triggerPipeVal;
		i = read(tsdPtr->triggerPipe[0], &triggerPipeVal,
			sizeof(triggerPipeVal));
		if ((i != sizeof(triggerPipeVal)) && (errno != EAGAIN)) {
		    Tcl_Panic(
			    "Tcl_WaitForEvent: read from %p->triggerPipe[0]: %s",
			    (void *) tsdPtr, strerror(errno));
		}
		continue;
	    }
#endif /* HAVE_EVENTFD */
	    if (!mask) {
		continue;
	    }

	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
	return 0;
    }
}

#endif /* NOTIFIER_EPOLL && TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted unix/tclKqueueNotfy.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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





















































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclKqueueNotfy.c --
 *
 *	This file contains the implementation of the kqueue()-based
 *	DragonFly/Free/Net/OpenBSD-specific notifier, which is the lowest-
 *	level part of the Tcl event loop. This file works together with
 *	generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if defined(NOTIFIER_KQUEUE) && TCL_THREADS

#include <signal.h>
#include <sys/types.h>
#include <sys/event.h>
#include <sys/queue.h>
#include <sys/time.h>

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

struct PlatformEventData;
typedef struct FileHandler {
    int fd;
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
    LIST_ENTRY(FileHandler) readyNode;
				/* Next/previous in list of FileHandlers asso-
				 * ciated with regular files (S_IFREG) that are
				 * ready for I/O. */
    struct PlatformEventData *pedPtr;
				/* Pointer to PlatformEventData associating this
				 * FileHandler with kevent(2) events. */
} FileHandler;

/*
 * The following structure associates a FileHandler and the thread that owns
 * it with the file descriptors of interest and their event masks passed to
 * kevent(2) and their corresponding event(s) returned by kevent(2).
 */

struct ThreadSpecificData;
struct PlatformEventData {
    FileHandler *filePtr;
    struct ThreadSpecificData *tsdPtr;
};

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */

typedef struct {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    int fd;			/* File descriptor that is ready. Used to find
				 * the FileHandler structure for the file
				 * (can't point directly to the FileHandler
				 * structure because it could go away while
				 * the event is queued). */
} FileHandlerEvent;

/*
 * The following static structure contains the state information for the
 * kqueue based implementation of the Tcl notifier. One of these structures is
 * created for each thread that is using the notifier.
 */

LIST_HEAD(PlatformReadyFileHandlerList, FileHandler);
typedef struct ThreadSpecificData {
    FileHandler *firstFileHandlerPtr;
				/* Pointer to head of file handler list. */
    struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
				/* Pointer to head of list of FileHandlers
				 * associated with regular files (S_IFREG)
				 * that are ready for I/O. */
    pthread_mutex_t notifierMutex;
				/* Mutex protecting notifier termination in
				 * PlatformEventsFinalize. */
    int triggerPipe[2];		/* pipe(2) used by other threads to wake
				 * up this thread for inter-thread IPC. */
    int eventsFd;		/* kqueue(2) file descriptor used to wait for
				 * fds. */
    struct kevent *readyEvents;	/* Pointer to at most maxReadyEvents events
				 * returned by kevent(2). */
    size_t maxReadyEvents;	/* Count of kevents in readyEvents. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * Forward declarations of internal functions.
 */

static void		PlatformEventsControl(FileHandler *filePtr,
			    ThreadSpecificData *tsdPtr, int op, int isNew);
static void		PlatformEventsFinalize(void);
static void		PlatformEventsInit(void);
static int		PlatformEventsTranslate(struct kevent *eventPtr);
static int		PlatformEventsWait(struct kevent *events,
			    size_t numEvents, struct timeval *timePtr);

#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * Results:
 *	Returns a handle to the notifier state for this thread.
 *
 * Side effects:
 *	If no initNotifierProc notifier hook exists, PlatformEventsInit
 *	is called.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	PlatformEventsInit();
	return tsdPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	This function is called to cleanup the notifier state before a thread
 *	is terminated.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If no finalizeNotifierProc notifier hook exists, PlatformEvents-
 *	Finalize is called.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
	PlatformEventsFinalize();
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsControl --
 *
 *	This function registers interest for the file descriptor and the mask
 *	of TCL_* bits associated with filePtr on the kqueue file descriptor
 *	associated with tsdPtr.
 *
 *	Future calls to kevent will return filePtr and tsdPtr alongside with
 *	the event registered here via the PlatformEventData struct.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	- If adding a new file descriptor, a PlatformEventData struct will be
 *	  allocated and associated with filePtr.
 *	- fstat is called on the file descriptor; if it is associated with
 *	  a regular file (S_IFREG,) filePtr is considered to be ready for I/O
 *	  and added to or deleted from the corresponding list in tsdPtr.
 *	- If it is not associated with a regular file, the file descriptor is
 *	  added, modified concerning its mask of events of interest, or
 *	  deleted from the epoll file descriptor of the calling thread.
 *	- If deleting a file descriptor, kevent(2) is called twice specifying
 *	  EVFILT_READ first and then EVFILT_WRITE (see note below.)
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsControl(
    FileHandler *filePtr,
    ThreadSpecificData *tsdPtr,
    int op,
    int isNew)
{
    int numChanges;
    struct kevent changeList[2];
    struct PlatformEventData *newPedPtr;
    struct stat fdStat;

    if (isNew) {
        newPedPtr = (struct PlatformEventData *)Tcl_Alloc(sizeof(struct PlatformEventData));
        newPedPtr->filePtr = filePtr;
        newPedPtr->tsdPtr = tsdPtr;
        filePtr->pedPtr = newPedPtr;
    }

    /*
     * N.B. As discussed in Tcl_WaitForEvent(), kqueue(2) does not reproduce
     * the `always ready' {select,poll}(2) behaviour for regular files
     * (S_IFREG) prior to FreeBSD 11.0-RELEASE. Therefore, filePtr is in these
     * cases simply added or deleted from the list of FileHandlers associated
     * with regular files belonging to tsdPtr.
     */

    if (fstat(filePtr->fd, &fdStat) == -1) {
	Tcl_Panic("fstat: %s", strerror(errno));
    } else if ((fdStat.st_mode & S_IFMT) == S_IFREG) {
	switch (op) {
	case EV_ADD:
	    if (isNew) {
		LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
			readyNode);
	    }
	    break;
	case EV_DELETE:
	    LIST_REMOVE(filePtr, readyNode);
	    break;
	}
	return;
    }

    numChanges = 0;
    switch (op) {
    case EV_ADD:
	if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
	    EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd,
		    EVFILT_READ, op, 0, 0, filePtr->pedPtr);
	    numChanges++;
	}
	if (filePtr->mask & TCL_WRITABLE) {
	    EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd,
		    EVFILT_WRITE, op, 0, 0, filePtr->pedPtr);
	    numChanges++;
	}
        if (numChanges) {
	    if (kevent(tsdPtr->eventsFd, changeList, numChanges, NULL, 0,
		    NULL) == -1) {
		Tcl_Panic("kevent: %s", strerror(errno));
	    }
	}
	break;
    case EV_DELETE:
	/*
	 * N.B. kqueue(2) has separate filters for readability and writability
	 * fd events. We therefore need to ensure that fds are ompletely
	 * removed from the kqueue(2) fd when deleting.  This is exacerbated
	 * by changes to filePtr->mask w/o calls to PlatforEventsControl()
	 * after e.g. an exec(3) in a child process.
	 *
	 * As one of these calls can fail, two separate kevent(2) calls are
	 * made for EVFILT_{READ,WRITE}.
	 */
	EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_READ, op, 0, 0,
		NULL);
	if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
		&& (errno != ENOENT)) {
	    Tcl_Panic("kevent: %s", strerror(errno));
	}
	EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_WRITE, op, 0, 0,
		NULL);
	if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
		&& (errno != ENOENT)) {
	    Tcl_Panic("kevent: %s", strerror(errno));
	}
	break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsFinalize --
 *
 *	This function closes the pipe and the kqueue file descriptors and
 *	frees the kevent structs owned by the thread of the caller.  The above
 *	operations are protected by tsdPtr->notifierMutex, which is destroyed
 *	thereafter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 * 	While tsdPtr->notifierMutex is held:
 *	The per-thread pipe(2) fds are closed, if non-zero, and set to -1.
 *	The per-thread kqueue(2) fd is closed, if non-zero, and set to 0.
 *	The per-thread kevent structs are freed, if any, and set to 0.
 *
 *	tsdPtr->notifierMutex is destroyed.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsFinalize(
    void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&tsdPtr->notifierMutex);
    if (tsdPtr->triggerPipe[0]) {
	close(tsdPtr->triggerPipe[0]);
	tsdPtr->triggerPipe[0] = -1;
    }
    if (tsdPtr->triggerPipe[1]) {
	close(tsdPtr->triggerPipe[1]);
	tsdPtr->triggerPipe[1] = -1;
    }
    if (tsdPtr->eventsFd > 0) {
	close(tsdPtr->eventsFd);
	tsdPtr->eventsFd = 0;
    }
    if (tsdPtr->readyEvents) {
	Tcl_Free(tsdPtr->readyEvents);
	tsdPtr->maxReadyEvents = 0;
    }
    pthread_mutex_unlock(&tsdPtr->notifierMutex);
    if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
	Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsInit --
 *
 *	This function abstracts creating a kqueue fd via the kqueue system
 *	call and allocating memory for the kevents structs in tsdPtr for the
 *	thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The following per-thread entities are initialised:
 *	- notifierMutex is initialised.
 *	- The pipe(2) is created; fcntl(2) is called on both fds to set
 *	  FD_CLOEXEC and O_NONBLOCK.
 *	- The kqueue(2) fd is created; fcntl(2) is called on it to set
 *	  FD_CLOEXEC.
 *	- A FileHandler struct is allocated and initialised for the event-
 *	  fd(2), registering interest for TCL_READABLE on it via Platform-
 *	  EventsControl().
 *	- readyEvents and maxReadyEvents are initialised with 512 kevents.
 *
 *----------------------------------------------------------------------
 */

void
PlatformEventsInit(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int i, fdFl;
    FileHandler *filePtr;

    errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
    if (errno) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
    }
    if (pipe(tsdPtr->triggerPipe) != 0) {
	Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
    } else for (i = 0; i < 2; i++) {
	if (fcntl(tsdPtr->triggerPipe[i], F_SETFD, FD_CLOEXEC) == -1) {
	    Tcl_Panic("fcntl: %s", strerror(errno));
	} else {
	    fdFl = fcntl(tsdPtr->triggerPipe[i], F_GETFL);
	    fdFl |= O_NONBLOCK;
	}
	if (fcntl(tsdPtr->triggerPipe[i], F_SETFL, fdFl) == -1) {
	    Tcl_Panic("fcntl: %s", strerror(errno));
	}
    }
    if ((tsdPtr->eventsFd = kqueue()) == -1) {
	Tcl_Panic("kqueue: %s", strerror(errno));
    } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) {
	Tcl_Panic("fcntl: %s", strerror(errno));
    }
    filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
    filePtr->fd = tsdPtr->triggerPipe[0];
    filePtr->mask = TCL_READABLE;
    PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1);
    if (!tsdPtr->readyEvents) {
        tsdPtr->maxReadyEvents = 512;
	tsdPtr->readyEvents = (struct kevent *)Tcl_Alloc(
		tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
    }
    LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsTranslate --
 *
 *	This function translates the platform-specific mask of returned
 *	events in eventPtr to a mask of TCL_* bits.
 *
 * Results:
 *	Returns the translated mask.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsTranslate(
    struct kevent *eventPtr)
{
    int mask;

    mask = 0;
    if (eventPtr->filter == EVFILT_READ) {
	mask |= TCL_READABLE;
	if (eventPtr->flags & EV_ERROR) {
	    mask |= TCL_EXCEPTION;
	}
    }
    if (eventPtr->filter == EVFILT_WRITE) {
	mask |= TCL_WRITABLE;
	if (eventPtr->flags & EV_ERROR) {
	    mask |= TCL_EXCEPTION;
	}
    }
    return mask;
}

/*
 *----------------------------------------------------------------------
 *
 * PlatformEventsWait --
 *
 *	This function abstracts waiting for I/O events via the kevent system
 *	call.
 *
 * Results:
 *	Returns -1 if kevent failed. Returns 0 if polling and if no events
 *	became available whilst polling. Returns a pointer to and the count of
 *	all returned events in all other cases.
 *
 * Side effects:
 *	gettimeofday(2), kevent(2), and gettimeofday(2) are called, in the
 *	specified order.
 *	If timePtr specifies a positive value, it is updated to reflect the
 *	amount of time that has passed; if its value would {under, over}flow,
 *	it is set to zero.
 *
 *----------------------------------------------------------------------
 */

int
PlatformEventsWait(
    struct kevent *events,
    size_t numEvents,
    struct timeval *timePtr)
{
    int numFound;
    struct timeval tv0, tv1, tv_delta;
    struct timespec timeout, *timeoutPtr;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * If timePtr is NULL, kevent(2) will wait indefinitely. If it specifies a
     * timeout of {0,0}, kevent(2) will poll. Otherwise, the timeout will
     * simply be converted to a timespec.
     */

    if (!timePtr) {
	timeoutPtr = NULL;
    } else if (!timePtr->tv_sec && !timePtr->tv_usec) {
	timeout.tv_sec = 0;
	timeout.tv_nsec = 0;
	timeoutPtr = &timeout;
    } else {
	timeout.tv_sec = timePtr->tv_sec;
	timeout.tv_nsec = timePtr->tv_usec * 1000;
	timeoutPtr = &timeout;
    }

    /*
     * Call (and possibly block on) kevent(2) and substract the delta of
     * gettimeofday(2) before and after the call from timePtr if the latter is
     * not NULL. Return the number of events returned by kevent(2).
     */

    gettimeofday(&tv0, NULL);
    numFound = kevent(tsdPtr->eventsFd, NULL, 0, events, (int) numEvents,
	    timeoutPtr);
    gettimeofday(&tv1, NULL);
    if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) {
	timersub(&tv1, &tv0, &tv_delta);
	if (!timercmp(&tv_delta, timePtr, >)) {
	    timersub(timePtr, &tv_delta, timePtr);
	} else {
	    timePtr->tv_sec = 0;
	    timePtr->tv_usec = 0;
	}
    }
    return numFound;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This function registers a file handler with the kqueue notifier
 *	of the thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *	PlatformEventsControl() is called for the new file handler structure.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateFileHandler(
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    int isNew;

    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	    isNew = 1;
	} else {
	    isNew = 0;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
	filePtr->mask = mask;

	PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file on the
 *	kqueue of the thread of the caller.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *	PlatformEventsControl() is called for the file handler structure.
 *	The PlatformEventData struct associated with the new file handler
 *	structure is freed.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * Find the entry for the given file (and return if there isn't one).
	 */

	for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
		prevPtr = filePtr, filePtr = filePtr->nextPtr) {
	    if (filePtr == NULL) {
		return;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}

	/*
	 * Update the check masks for this file.
	 */

	PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
	if (filePtr->pedPtr) {
	    Tcl_Free(filePtr->pedPtr);
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This function is called by Tcl_DoOneEvent to wait for new events on
 *	the message queue. If the block time is 0, then Tcl_WaitForEvent just
 *	polls without blocking.
 *
 *	The waiting logic is implemented in PlatformEventsWait.
 *
 * Results:
 *	Returns -1 if PlatformEventsWait() would block forever, otherwise
 *	returns 0.
 *
 * Side effects:
 *	Queues file events that are detected by PlatformEventsWait().
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
	/*
	 * Impl. notes: timeout & timeoutPtr are used if, and only if threads
	 * are not enabled. They are the arguments for the regular epoll_wait()
	 * used when the core is not thread-enabled.
	 */

	struct timeval timeout, *timeoutPtr;
	int numFound, numEvent;
	struct PlatformEventData *pedPtr;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	int numQueued;
	ssize_t i;
	char buf[1];

	/*
	 * Set up the timeout structure. Note that if there are no events to
	 * check for, we return with a negative result rather than blocking
	 * forever.
	 */

	if (timePtr != NULL) {
	    /*
	     * TIP #233 (Virtualized Time). Is virtual time in effect? And do
	     * we actually have something to scale? If yes to both then we
	     * call the handler to do this scaling.
	     */

	    if (timePtr->sec != 0 || timePtr->usec != 0) {
		vTime = *timePtr;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		timePtr = &vTime;
	    }
	    timeout.tv_sec = timePtr->sec;
	    timeout.tv_usec = timePtr->usec;
	    timeoutPtr = &timeout;
	} else {
	    timeoutPtr = NULL;
	}

	/*
	 * Walk the list of FileHandlers associated with regular files
	 * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and
	 * update their mask of events of interest.
	 *
	 * kqueue(2), unlike epoll(7), does support regular files, but
	 * EVFILT_READ only `[r]eturns when the file pointer is not at the end
	 * of file' as opposed to unconditionally. While FreeBSD 11.0-RELEASE
	 * adds support for this mode (NOTE_FILE_POLL,) this is not used for
	 * reasons of compatibility.
	 *
	 * Therefore, the behaviour of {select,poll}(2) is simply simulated
	 * here: fds associated with regular files are added to this list by
	 * PlatformEventsControl() and processed here before calling (and
	 * possibly blocking) on PlatformEventsWait().
	 */

	numQueued = 0;
	LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) {
	    mask = 0;
	    if (filePtr->mask & TCL_READABLE) {
		mask |= TCL_READABLE;
	    }
	    if (filePtr->mask & TCL_WRITABLE) {
		mask |= TCL_WRITABLE;
	    }

	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
		numQueued++;
	    }
	    filePtr->readyMask = mask;
	}

	/*
	 * If any events were queued in the above loop, force PlatformEvents-
	 * Wait() to poll as there already are events that need to be processed
	 * at this point.
	 */

	if (numQueued) {
	    timeout.tv_sec = 0;
	    timeout.tv_usec = 0;
	    timeoutPtr = &timeout;
	}

	/*
	 * Wait or poll for new events, queue Tcl events for the FileHandlers
	 * corresponding to them, and update the FileHandlers' mask of events
	 * of interest registered by the last call to Tcl_CreateFileHandler().
	 *
	 * Events for the trigger pipe are processed here in order to facilitate
	 * inter-thread IPC. If another thread intends to wake up this thread
	 * whilst it's blocking on PlatformEventsWait(), it write(2)s to the
	 * other end of the pipe (see Tcl_AlertNotifier(),) which in turn will
	 * cause PlatformEventsWait() to return immediately.
	 */

	numFound = PlatformEventsWait(tsdPtr->readyEvents,
		tsdPtr->maxReadyEvents, timeoutPtr);
	for (numEvent = 0; numEvent < numFound; numEvent++) {
	    pedPtr = (struct PlatformEventData *)
		    tsdPtr->readyEvents[numEvent].udata;
	    filePtr = pedPtr->filePtr;
	    mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
	    if (filePtr->fd == tsdPtr->triggerPipe[0]) {
		i = read(tsdPtr->triggerPipe[0], buf, 1);
		if ((i == -1) && (errno != EAGAIN)) {
		    Tcl_Panic("Tcl_WaitForEvent: read from %p->triggerPipe: %s",
			    (void *) tsdPtr, strerror(errno));
		}
		continue;
	    }
	    if (!mask) {
		continue;
	    }

	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr = (FileHandlerEvent *)
			Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask |= mask;
	}
	return 0;
    }
}

#endif /* NOTIFIER_KQUEUE && TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclLoadAix.c.

94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
94
95
96
97
98
99
100

101
102
103
104
105
106
107
108







-
+







static void *findMain(void);

void *
dlopen(
    const char *path,
    int mode)
{
    ModulePtr mp;
    register ModulePtr mp;
    static void *mainModule;

    /*
     * Upon the first call register a terminate handler that will close all
     * libraries. Also get a reference to the main module for use with
     * loadbind.
     */
130
131
132
133
134
135
136
137

138
139
140
141
142
143
144
130
131
132
133
134
135
136

137
138
139
140
141
142
143
144







-
+







    if (mp == NULL) {
	errvalid++;
	strcpy(errbuf, "calloc: ");
	strcat(errbuf, strerror(errno));
	return NULL;
    }

    mp->name = malloc(strlen(path) + 1);
    mp->name = malloc((unsigned) (strlen(path) + 1));
    strcpy(mp->name, path);

    /*
     * load should be declared load(const char *...). Thus we cast the path to
     * a normal char *. Ugly.
     */

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
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







-
+



















-
+












-
+


















-
+








    /*
     * If the user wants global binding, loadbind against all other loaded
     * modules.
     */

    if (mode & RTLD_GLOBAL) {
	ModulePtr mp1;
	register ModulePtr mp1;

	for (mp1 = mp->next; mp1; mp1 = mp1->next) {
	    if (loadbind(0, mp1->entry, mp->entry) == -1) {
		goto loadbindFailure;
	    }
	}
    }

    if (readExports(mp) == -1) {
	dlclose(mp);
	return NULL;
    }

    /*
     * If there is a dl_info structure, call the init function.
     */

    if (mp->info = (struct dl_info *)dlsym(mp, "dl_info")) {
	if (mp->info->init) {
	    mp->info->init();
	    (*mp->info->init)();
	}
    } else {
	errvalid = 0;
    }

    /*
     * If the shared object was compiled using xlC we will need to call static
     * constructors (and later on dlclose destructors).
     */

    if (mp->cdtors = (CdtorPtr) dlsym(mp, "__cdtors")) {
	while (mp->cdtors->init) {
	    mp->cdtors->init();
	    (*mp->cdtors->init)();
	    mp->cdtors++;
	}
    } else {
	errvalid = 0;
    }

    return (void *) mp;
}

/*
 * Attempt to decipher an AIX loader error message and append it to our static
 * error message buffer.
 */

static void
caterr(
    char *s)
{
    char *p = s;
    register char *p = s;

    while (*p >= '0' && *p <= '9') {
	p++;
    }
    switch (atoi(s)) {		/* INTL: "C", UTF safe. */
    case L_ERROR_TOOMANY:
	strcat(errbuf, "to many errors");
278
279
280
281
282
283
284
285
286
287



288
289
290
291
292
293
294
278
279
280
281
282
283
284



285
286
287
288
289
290
291
292
293
294







-
-
-
+
+
+







}

void *
dlsym(
    void *handle,
    const char *symbol)
{
    ModulePtr mp = (ModulePtr)handle;
    ExportPtr ep;
    int i;
    register ModulePtr mp = (ModulePtr)handle;
    register ExportPtr ep;
    register int i;

    /*
     * Could speed up the search, but I assume that one assigns the result to
     * function pointers anyways.
     */

    for (ep = mp->exports, i = mp->nExports; i; i--, ep++) {
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
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







-
+

-
+






-
+




-
+











-
-
+
+







    return NULL;
}

int
dlclose(
    void *handle)
{
    ModulePtr mp = (ModulePtr)handle;
    register ModulePtr mp = (ModulePtr)handle;
    int result;
    ModulePtr mp1;
    register ModulePtr mp1;

    if (--mp->refCnt > 0) {
	return 0;
    }

    if (mp->info && mp->info->fini) {
	mp->info->fini();
	(*mp->info->fini)();
    }

    if (mp->cdtors) {
	while (mp->cdtors->term) {
	    mp->cdtors->term();
	    (*mp->cdtors->term)();
	    mp->cdtors++;
	}
    }

    result = unload(mp->entry);
    if (result == -1) {
	errvalid++;
	strcpy(errbuf, strerror(errno));
    }

    if (mp->exports) {
	ExportPtr ep;
	int i;
	register ExportPtr ep;
	register int i;
	for (ep = mp->exports, i = mp->nExports; i; i--, ep++) {
	    if (ep->name) {
		free(ep->name);
	    }
	}
	free(mp->exports);
    }
537
538
539
540
541
542
543
544

545
546
547
548
549
550
551
537
538
539
540
541
542
543

544
545
546
547
548
549
550
551







-
+







	     * end.
	     */

	    strncpy(tmpsym, ls->l_name, SYMNMLEN);
	    tmpsym[SYMNMLEN] = '\0';
	    symname = tmpsym;
	}
	ep->name = malloc(strlen(symname) + 1);
	ep->name = malloc((unsigned) (strlen(symname) + 1));
	strcpy(ep->name, symname);
	ep->addr = (void *)((unsigned long)
		mp->entry + ls->l_value - shdata.s_vaddr);
	ep++;
    }
    free(ldbuf);
    while (ldclose(ldp) == FAILURE) {

Changes to unix/tclLoadDl.c.

1
2
3
4
5
6
7
8
9
10


11
12
13
14
15
16
17
1
2
3
4
5
6
7
8


9
10
11
12
13
14
15
16
17








-
-
+
+







/*
 * tclLoadDl.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	the "dlopen" and "dlsym" library procedures for dynamic loading.
 *
 * 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.
 * 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 NO_DLFCN_H
#   include "../compat/dlfcn.h"
#else
#   include <dlfcn.h>
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
28
29
30
31
32
33
34








35
36
37
38
39
40
41







-
-
-
-
-
-
-
-







#   define RTLD_NOW 1
#endif

#ifndef RTLD_LOCAL
#   define RTLD_LOCAL 0
#endif

/*
 * Static procedures defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		UnloadFile(Tcl_LoadHandle loadHandle);

/*
 *---------------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
 *	to the new code.
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
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







-
+



-


-
-
+
-







-
+

-
+

-
-
-
-
-
-
-
-
-
-
-
+








-
+



-
+

-
+











-
-
-
-
+
+
-


-
+
-
-
-
-
-
+
+
-






-
+












-
-
+
+


-
+

-
+
-
-
+
-
-
-
+
-
-
+
-








-
+
-
-
-
-
+
-
-
-
-

-
-

-
-
+
-
-
-
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-


-

-
-

-
-
-
-
-
-
-
-
-
-






-
+

-
-
+
+
+





-
+




-
-
+
+




-
+

+

-







TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
{
    void *handle;
    Tcl_LoadHandle newHandle;
    const char *native;
    CONST char *native;
    int dlopenflags = 0;

    /*
     * 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.
     */

    native = (const char *)Tcl_FSGetNativePath(pathPtr);
    native = Tcl_FSGetNativePath(pathPtr);
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
     * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
     */
    if (flags & TCL_LOAD_GLOBAL) {
    	dlopenflags |= RTLD_GLOBAL;
    } else {
    	dlopenflags |= RTLD_LOCAL;
    }
    if (flags & TCL_LOAD_LAZY) {
    	dlopenflags |= RTLD_LAZY;
    } else {
    	dlopenflags |= RTLD_NOW;
    }
    handle = dlopen(native, dlopenflags);
    handle = dlopen(native, RTLD_NOW | RTLD_LOCAL);
    if (handle == 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 = TclGetString(pathPtr);
	char *fileName = Tcl_GetString(pathPtr);

	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	/*
	 * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
	 * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
	 */
	handle = dlopen(native, dlopenflags);
	handle = dlopen(native, RTLD_NOW | RTLD_LOCAL);
	Tcl_DStringFree(&ds);
    }

    if (handle == NULL) {
	/*
	 * Write the string to a variable first to work around a compiler bug
	 * in the Sun Forte 6 compiler. [Bug 1503729]
	 */

	const char *errorStr = dlerror();

	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't load file \"%s\": %s",
		    TclGetString(pathPtr), errorStr));
	Tcl_AppendResult(interp, "couldn't load file \"",
		Tcl_GetString(pathPtr), "\": ", errorStr, NULL);
	}
	return TCL_ERROR;
    }
    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));

    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &TclpUnloadFile;
    *loadHandle = (Tcl_LoadHandle) handle;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --
 * TclpFindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	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_PackageInitProc *
TclpFindSymbol(
    Tcl_Interp *interp,		/* Place to put error messages. */
    Tcl_LoadHandle loadHandle,	/* Value from TcpDlopen(). */
    const char *symbol)		/* Symbol to look up. */
    CONST char *symbol)		/* Symbol to look up. */
{
    const char *native;		/* Name of the library to be loaded, in
    CONST char *native;
				 * system encoding */
    Tcl_DString newName, ds;	/* Buffers for converting the name to
    Tcl_DString newName, ds;
				 * system encoding and prepending an
				 * underscore*/
    void *handle = (void *) loadHandle->clientData;
    VOID *handle = (VOID*)loadHandle;
				/* Native handle to the loaded library */
    void *proc;			/* Address corresponding to the resolved
    Tcl_PackageInitProc *proc;
				 * symbol */

    /*
     * Some platforms still add an underscore to the beginning of symbol
     * names. If we can't find a name without an underscore, try again with
     * the underscore.
     */

    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
    proc = dlsym(handle, native);	/* INTL: Native. */
    proc = (Tcl_PackageInitProc *) dlsym(handle,	/* INTL: Native. */
    if (proc == NULL) {
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	native = Tcl_DStringAppend(&newName, native, -1);
	    native);
	proc = dlsym(handle, native);	/* INTL: Native. */
	Tcl_DStringFree(&newName);
    }
#ifdef __cplusplus
    if (proc == NULL) {
	char buf[32];
	sprintf(buf, "%d", (int)Tcl_DStringLength(&ds));
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "__Z");
	Tcl_DStringAppend(&newName, buf, -1);
	Tcl_DStringAppend(&newName, "_", 1);
	Tcl_DStringAppend(&newName, Tcl_DStringValue(&ds), -1);
	TclDStringAppendLiteral(&newName, "P10Tcl_Interp");
	native = Tcl_DStringValue(&newName);
	native = Tcl_DStringAppend(&newName, native, -1);
	proc = dlsym(handle, native + 1);	/* INTL: Native. */
	if (proc == NULL) {
	    proc = dlsym(handle, native);	/* INTL: Native. */
	proc = (Tcl_PackageInitProc *) dlsym(handle,	/* INTL: Native. */
	}
	if (proc == NULL) {
	    TclDStringAppendLiteral(&newName, "i");
	    native = Tcl_DStringValue(&newName);
		native);
	    proc = dlsym(handle, native + 1);	/* INTL: Native. */
	}
	if (proc == NULL) {
	    proc = dlsym(handle, native);	/* INTL: Native. */
	}
	Tcl_DStringFree(&newName);
    }
#endif
    Tcl_DStringFree(&ds);
    if (proc == NULL) {
	const char *errorStr = dlerror();

	if (interp) {
	    if (!errorStr) {
		errorStr = "unknown";
	    }
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "cannot find symbol \"%s\": %s", symbol, errorStr));
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
		    NULL);
	}
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 * TclpUnloadFile --
 *
 *	Unloads a dynamic shared object, after which all pointers to functions
 *	in the formerly-loaded object are no longer valid.
 *	Unloads a dynamically loaded binary code file from memory. Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory for the loaded object is deallocated.
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
void
TclpUnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    void *handle = loadHandle->clientData;
    void *handle;

    handle = (void *) loadHandle;
    dlclose(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
277
278
279
280
281
282
283
284
285




286
287
288
289
290
291
292
293
294
295
296
210
211
212
213
214
215
216


217
218
219
220
221
222
223
224
225
226
227
228
229
230
231







-
-
+
+
+
+











 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *) /*fileName*/,
    TCL_UNUSED(Tcl_DString *))
    CONST char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclLoadDyld.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



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
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







-
+


+



-
+
-
-
-
+

-
+


-
+



-
-
-
+
+
+
+
+


+
+
+

-
+

-
+
-
-
-
+
+
+
+
+


-
-
-






+





-
+

-
+
+

+






+
-
-
+
+


-
-
+
+
-
-
-
-
-
+
+
+
+
+
+

+

















-
-
+




















-
+







 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#define MODULE_SCOPE extern
#endif

#ifndef TCL_DYLD_USE_DLFCN
/*
 * Use preferred dlfcn API on 10.4 and later
 */

#   if !defined(NO_DLFCN_H) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1040
#ifndef TCL_DYLD_USE_DLFCN
#   ifdef NO_DLFCN_H
#	define TCL_DYLD_USE_DLFCN 0
#	define TCL_DYLD_USE_DLFCN 1
#   else
#	define TCL_DYLD_USE_DLFCN 1
#	define TCL_DYLD_USE_DLFCN 0
#   endif
#endif

#ifndef TCL_DYLD_USE_NSMODULE
/*
 * Use deprecated NSModule API only to support 10.3 and earlier:
 */

#ifndef TCL_DYLD_USE_NSMODULE
#   define TCL_DYLD_USE_NSMODULE 0
#   if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
#	define TCL_DYLD_USE_NSMODULE 1
#   else
#	define TCL_DYLD_USE_NSMODULE 0
#   endif
#endif

#if TCL_DYLD_USE_DLFCN
#include <dlfcn.h>
#if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1040
/*
 * Use includes for the API we're using.
 * Support for weakly importing dlfcn API.
 */

extern void *dlopen(const char *path, int mode) WEAK_IMPORT_ATTRIBUTE;
#if TCL_DYLD_USE_DLFCN
#   include <dlfcn.h>
#endif /* TCL_DYLD_USE_DLFCN */
extern void *dlsym(void *handle, const char *symbol) WEAK_IMPORT_ATTRIBUTE;
extern int dlclose(void *handle) WEAK_IMPORT_ATTRIBUTE;
extern char *dlerror(void) WEAK_IMPORT_ATTRIBUTE;
#endif
#endif

#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
#endif
#include <mach-o/dyld.h>
#include <mach-o/fat.h>
#include <mach-o/swap.h>
#include <mach-o/arch.h>
#include <libkern/OSByteOrder.h>
#include <mach/mach.h>
#include <stdbool.h>

typedef struct Tcl_DyldModuleHandle {
    struct Tcl_DyldModuleHandle *nextPtr;
    NSModule module;
} Tcl_DyldModuleHandle;
#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
#endif /* TCL_DYLD_USE_NSMODULE */

typedef struct {
typedef struct Tcl_DyldLoadHandle {
#if TCL_DYLD_USE_DLFCN
    void *dlHandle;
#endif
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
    const struct mach_header *dyldLibHeader;
    Tcl_DyldModuleHandle *modulePtr;
#endif
} Tcl_DyldLoadHandle;

#if (TCL_DYLD_USE_DLFCN && MAC_OS_X_VERSION_MIN_REQUIRED < 1040) || \
#if TCL_DYLD_USE_DLFCN || defined(TCL_LOAD_FROM_MEMORY)
MODULE_SCOPE long	tclMacOSXDarwinRelease;
	defined(TCL_LOAD_FROM_MEMORY)
MODULE_SCOPE long tclMacOSXDarwinRelease;
#endif

/*
 * Static functions defined in this file.
#ifdef TCL_DEBUG_LOAD
#define TclLoadDbgMsg(m, ...) do { \
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		UnloadFile(Tcl_LoadHandle handle);
	    fprintf(stderr, "%s:%d: %s(): " m ".\n", \
	    strrchr(__FILE__, '/')+1, __LINE__, __func__, ##__VA_ARGS__); \
	} while (0)
#else
#define TclLoadDbgMsg(m, ...)
#endif

#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
/*
 *----------------------------------------------------------------------
 *
 * DyldOFIErrorMsg --
 *
 *	Converts a numerical NSObjectFileImage error into an error message
 *	string.
 *
 * Results:
 *	Error message string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
static const char *
static CONST char*
DyldOFIErrorMsg(
    int err)
{
    switch(err) {
    case NSObjectFileImageSuccess:
	return NULL;
    case NSObjectFileImageFailure:
	return "object file setup failure";
    case NSObjectFileImageInappropriateFile:
	return "not a Mach-O MH_BUNDLE file";
    case NSObjectFileImageArch:
	return "no object for this architecture";
    case NSObjectFileImageFormat:
	return "bad object file format";
    case NSObjectFileImageAccess:
	return "can't read object file";
    default:
	return "unknown error";
    }
}
#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
#endif /* TCL_DYLD_USE_NSMODULE */

/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
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

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
450










451
452
453
454
455


456
457

458






459
460

461
462
463
464

465
466
467
468
469
470
471
472
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
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
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







-
+



-


-
+

+








-
+



+

-
-
-







-
+
-
-


+
+
+
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

+
+
+
+
+
-
-
+
+
+
+
+

+


+

-
+
-



-
+
+
+








+
+
+
+
+



-
+
+
+


+
















-
-
+
+
-
-
+
+
+


-
+
+


+



+



+
+





-
-
+
+
+
+


-
+

-
+
+
+

+



-
-
+
+
-
-
-
-
+
-


-
-
+
-
-
-
-


-
-
-
+
+

-
+
-


-
-
+
+
+






-
+












-
-
+
+


-
+

-
+






-

+
-
-
+
+
+
+

+

+

-
+









-
+






+
+





-










-
+
+











+




+
+
+
+
-
+
+

-
+
+
+
+
+
+





-
-
+
+
-
-
-

-
+





-
+
















-
-
+
+




-
+

+

+
-
-
-
-
+
+
+
+
+
+
+
+
+
+




-
+
+

-
+

+
+
+
+
+
+

-
+



-
+
-







TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
{
    Tcl_DyldLoadHandle *dyldLoadHandle;
    Tcl_LoadHandle newHandle;
#if TCL_DYLD_USE_DLFCN
    void *dlHandle = NULL;
#endif
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
    const struct mach_header *dyldLibHeader = NULL;
    Tcl_DyldModuleHandle *modulePtr = NULL;
#endif
#if TCL_DYLD_USE_NSMODULE
    NSLinkEditErrors editError;
    int errorNumber;
    const char *errorName, *objFileImageErrMsg = NULL;
#endif /* TCL_DYLD_USE_NSMODULE */
#endif
    const char *errMsg = NULL;
    int result;
    Tcl_DString ds;
    char *fileName = NULL;
    const char *nativePath, *nativeFileName = NULL;
#if TCL_DYLD_USE_DLFCN
    int dlopenflags = 0;
#endif /* TCL_DYLD_USE_DLFCN */

    /*
     * 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.
     */

    nativePath = (const char *)Tcl_FSGetNativePath(pathPtr);
    nativePath = Tcl_FSGetNativePath(pathPtr);
    nativeFileName = Tcl_UtfToExternalDString(NULL, TclGetString(pathPtr),
	    -1, &ds);

#if TCL_DYLD_USE_DLFCN
#if MAC_OS_X_VERSION_MIN_REQUIRED < 1040
    if (tclMacOSXDarwinRelease >= 8)
#endif
    {
    /*
     * Use (RTLD_NOW|RTLD_LOCAL) as default, see [Bug #3216070]
     * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
     */

    if (flags & TCL_LOAD_GLOBAL) {
    	dlopenflags |= RTLD_GLOBAL;
    } else {
    	dlopenflags |= RTLD_LOCAL;
    }
    if (flags & TCL_LOAD_LAZY) {
    	dlopenflags |= RTLD_LAZY;
    } else {
    	dlopenflags |= RTLD_NOW;
    }
    dlHandle = dlopen(nativePath, dlopenflags);
    if (!dlHandle) {
	/*
	 * 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.
	 */
	dlHandle = dlopen(nativePath, RTLD_NOW | RTLD_LOCAL);
	if (!dlHandle) {
	    /*
	     * 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.
	     */

	    fileName = Tcl_GetString(pathPtr);
	    nativeFileName = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	    /*
	     * Use (RTLD_NOW|RTLD_LOCAL) always, see [Bug #3216070]
	     */
	dlHandle = dlopen(nativeFileName, dlopenflags);
	if (!dlHandle) {
	    dlHandle = dlopen(nativeFileName, RTLD_NOW | RTLD_LOCAL);
	}
	if (dlHandle) {
	    TclLoadDbgMsg("dlopen() successful");
	} else {
	    errMsg = dlerror();
	    TclLoadDbgMsg("dlopen() failed: %s", errMsg);
	}
    }
    if (!dlHandle)
#endif /* TCL_DYLD_USE_DLFCN */

    {
    if (!dlHandle) {
#if TCL_DYLD_USE_NSMODULE
	dyldLibHeader = NSAddImage(nativePath,
		NSADDIMAGE_OPTION_RETURN_ON_ERROR);
	if (!dyldLibHeader) {
	if (dyldLibHeader) {
	    TclLoadDbgMsg("NSAddImage() successful");
	} else {
	    NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
	    if (editError == NSLinkEditFileAccessError) {
		/*
		 * The requested file was not found. 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.
		 */

		if (!fileName) {
		    fileName = Tcl_GetString(pathPtr);
		    nativeFileName = Tcl_UtfToExternalDString(NULL, fileName,
			    -1, &ds);
		}
		dyldLibHeader = NSAddImage(nativeFileName,
			NSADDIMAGE_OPTION_WITH_SEARCHING |
			NSADDIMAGE_OPTION_RETURN_ON_ERROR);
		if (!dyldLibHeader) {
		if (dyldLibHeader) {
		    TclLoadDbgMsg("NSAddImage() successful");
		} else {
		    NSLinkEditError(&editError, &errorNumber, &errorName,
			    &errMsg);
		    TclLoadDbgMsg("NSAddImage() failed: %s", errMsg);
		}
	    } else if ((editError == NSLinkEditFileFormatError
		    && errorNumber == EBADMACHO)
		    || editError == NSLinkEditOtherError){
		NSObjectFileImageReturnCode err;
		NSObjectFileImage dyldObjFileImage;
		NSModule module;

		/*
		 * The requested file was found but was not of type MH_DYLIB,
		 * attempt to load it as a MH_BUNDLE.
		 */

		err = NSCreateObjectFileImageFromFile(nativePath,
			&dyldObjFileImage);
		if (err == NSObjectFileImageSuccess && dyldObjFileImage) {
		    int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;
		    if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
		    TclLoadDbgMsg("NSCreateObjectFileImageFromFile() "
			    "successful");
		    if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
		    module = NSLinkModule(dyldObjFileImage, nativePath, nsflags);
		    module = NSLinkModule(dyldObjFileImage, nativePath,
			    NSLINKMODULE_OPTION_BINDNOW
			    | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
		    NSDestroyObjectFileImage(dyldObjFileImage);
		    if (module) {
			modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr = (Tcl_DyldModuleHandle *)
				ckalloc(sizeof(Tcl_DyldModuleHandle));
			modulePtr->module = module;
			modulePtr->nextPtr = NULL;
			TclLoadDbgMsg("NSLinkModule() successful");
		    } else {
			NSLinkEditError(&editError, &errorNumber, &errorName,
				&errMsg);
			TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg);
		    }
		} else {
		    objFileImageErrMsg = DyldOFIErrorMsg(err);
		    TclLoadDbgMsg("NSCreateObjectFileImageFromFile() failed: "
			    "%s", objFileImageErrMsg);
		}
	    }
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }

    if (dlHandle
    if (0
#if TCL_DYLD_USE_DLFCN
	    || dlHandle
#endif
#if TCL_DYLD_USE_NSMODULE
	    || dyldLibHeader || modulePtr
#endif /* TCL_DYLD_USE_NSMODULE */
#endif
    ) {
	dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle));
	dyldLoadHandle = (Tcl_DyldLoadHandle *)
		ckalloc(sizeof(Tcl_DyldLoadHandle));
#if TCL_DYLD_USE_DLFCN
	dyldLoadHandle->dlHandle = dlHandle;
#endif
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
	dyldLoadHandle->dyldLibHeader = dyldLibHeader;
	dyldLoadHandle->modulePtr = modulePtr;
#endif /* TCL_DYLD_USE_NSMODULE || TCL_LOAD_FROM_MEMORY */
	newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
#endif
	*loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
	newHandle->clientData = dyldLoadHandle;
	newHandle->findSymbolProcPtr = &FindSymbol;
	newHandle->unloadFileProcPtr = &UnloadFile;
	*unloadProcPtr = &UnloadFile;
	*unloadProcPtr = &TclpUnloadFile;
	*loadHandle = newHandle;
	result = TCL_OK;
    } else {
	Tcl_Obj *errObj;

	Tcl_AppendResult(interp, errMsg, NULL);
	TclNewObj(errObj);
	if (errMsg != NULL) {
	    Tcl_AppendToObj(errObj, errMsg, -1);
	}
#if TCL_DYLD_USE_NSMODULE
	if (objFileImageErrMsg) {
	    Tcl_AppendPrintfToObj(errObj,
		    "\nNSCreateObjectFileImageFromFile() error: %s",
		    objFileImageErrMsg);
	    Tcl_AppendResult(interp, "\nNSCreateObjectFileImageFromFile() "
		    "error: ", objFileImageErrMsg, NULL);
	}
#endif /* TCL_DYLD_USE_NSMODULE */
#endif
	Tcl_SetObjResult(interp, errObj);
	result = TCL_ERROR;
    }

    Tcl_DStringFree(&ds);
    if(fileName) {
	Tcl_DStringFree(&ds);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --
 * TclpFindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	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(
MODULE_SCOPE Tcl_PackageInitProc *
TclpFindSymbol(
    Tcl_Interp *interp,		/* For error reporting. */
    Tcl_LoadHandle loadHandle,	/* Handle from TclpDlopen. */
    const char *symbol)		/* Symbol name to look up. */
    CONST char *symbol)		/* Symbol name to look up. */
{
    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData;
    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;
    Tcl_PackageInitProc *proc = NULL;
    const char *errMsg = NULL;
    Tcl_DString ds;
    const char *native;

    native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
    if (dyldLoadHandle->dlHandle) {
#if TCL_DYLD_USE_DLFCN
    if (dyldLoadHandle->dlHandle) {
	proc = (Tcl_PackageInitProc *)dlsym(dyldLoadHandle->dlHandle, native);
	if (!proc) {
	proc = dlsym(dyldLoadHandle->dlHandle, native);
	if (proc) {
	    TclLoadDbgMsg("dlsym() successful");
	} else {
	    errMsg = dlerror();
	    TclLoadDbgMsg("dlsym() failed: %s", errMsg);
	}
    } else
#endif /* TCL_DYLD_USE_DLFCN */
    } else {
    {
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
	NSSymbol nsSymbol = NULL;
	Tcl_DString newName;

	/*
	 * dyld adds an underscore to the beginning of symbol names.
	 */

	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	Tcl_DStringAppend(&newName, "_", 1);
	native = Tcl_DStringAppend(&newName, native, -1);
	if (dyldLoadHandle->dyldLibHeader) {
	    nsSymbol = NSLookupSymbolInImage(dyldLoadHandle->dyldLibHeader,
		    native, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_NOW |
		    NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR);
	    if (nsSymbol) {
		TclLoadDbgMsg("NSLookupSymbolInImage() successful");
#ifdef DYLD_SUPPORTS_DYLIB_UNLOADING
		/*
		 * Until dyld supports unloading of MY_DYLIB binaries, the
		 * following is not needed.
		 */

#ifdef DYLD_SUPPORTS_DYLIB_UNLOADING
		NSModule module = NSModuleForSymbol(nsSymbol);
		Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;

		while (modulePtr != NULL) {
		    if (module == modulePtr->module) {
			break;
		    }
		    modulePtr = modulePtr->nextPtr;
		}
		if (modulePtr == NULL) {
		    modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
		    modulePtr = (Tcl_DyldModuleHandle *)
			    ckalloc(sizeof(Tcl_DyldModuleHandle));
		    modulePtr->module = module;
		    modulePtr->nextPtr = dyldLoadHandle->modulePtr;
		    dyldLoadHandle->modulePtr = modulePtr;
		}
#endif /* DYLD_SUPPORTS_DYLIB_UNLOADING */
	    } else {
		NSLinkEditErrors editError;
		int errorNumber;
		const char *errorName;

		NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
		TclLoadDbgMsg("NSLookupSymbolInImage() failed: %s", errMsg);
	    }
	} else if (dyldLoadHandle->modulePtr) {
	    nsSymbol = NSLookupSymbolInModule(
		    dyldLoadHandle->modulePtr->module, native);
	    if (nsSymbol) {
		TclLoadDbgMsg("NSLookupSymbolInModule() successful");
	    } else {
		TclLoadDbgMsg("NSLookupSymbolInModule() failed");
	}
	    }
	}
	if (nsSymbol) {
	    proc = (Tcl_PackageInitProc *)NSAddressOfSymbol(nsSymbol);
	    proc = NSAddressOfSymbol(nsSymbol);
	    if (proc) {
		TclLoadDbgMsg("NSAddressOfSymbol() successful");
	    } else {
		TclLoadDbgMsg("NSAddressOfSymbol() failed");
	    }
	}
	Tcl_DStringFree(&newName);
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    Tcl_DStringFree(&ds);
    if (errMsg && (interp != NULL)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
    if (errMsg) {
	Tcl_AppendResult(interp, errMsg, NULL);
		"cannot find symbol \"%s\": %s", symbol, errMsg));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol,
		NULL);
    }
    return (void *)proc;
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 * TclpUnloadFile --
 *
 *	Unloads a dynamically loaded binary code file from memory. Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Code dissapears from memory. Note that dyld currently only supports
 *	unloading of binaries of type MH_BUNDLE loaded with NSLinkModule() in
 *	TclpDlopen() above.
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
MODULE_SCOPE void
TclpUnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *)loadHandle->clientData;
    Tcl_DyldLoadHandle *dyldLoadHandle = (Tcl_DyldLoadHandle *) loadHandle;

#if TCL_DYLD_USE_DLFCN
    if (dyldLoadHandle->dlHandle) {
	int result;
#if TCL_DYLD_USE_DLFCN
	(void) dlclose(dyldLoadHandle->dlHandle);
#endif /* TCL_DYLD_USE_DLFCN */
    } else {

	result = dlclose(dyldLoadHandle->dlHandle);
	if (!result) {
	    TclLoadDbgMsg("dlclose() successful");
	} else {
	    TclLoadDbgMsg("dlclose() failed: %s", dlerror());
	}
    } else
#endif /* TCL_DYLD_USE_DLFCN */
    {
#if TCL_DYLD_USE_NSMODULE || defined(TCL_LOAD_FROM_MEMORY)
	Tcl_DyldModuleHandle *modulePtr = dyldLoadHandle->modulePtr;

	while (modulePtr != NULL) {
	    void *ptr = modulePtr;
	    void *ptr;
	    bool result;

	    (void) NSUnLinkModule(modulePtr->module,
	    result = NSUnLinkModule(modulePtr->module,
		    NSUNLINKMODULE_OPTION_RESET_LAZY_REFERENCES);
	    if (result) {
		TclLoadDbgMsg("NSUnLinkModule() successful");
	    } else {
		TclLoadDbgMsg("NSUnLinkModule() failed");
	    }
	    ptr = modulePtr;
	    modulePtr = modulePtr->nextPtr;
	    Tcl_Free(ptr);
	    ckfree(ptr);
	}
#endif /* TCL_DYLD_USE_NSMODULE */
    }
    Tcl_Free(dyldLoadHandle);
    ckfree((char*) dyldLoadHandle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
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
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







-
-
+
+
+
+




+
















-


-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *) /*fileName*/,
    TCL_UNUSED(Tcl_DString *) /*bufPtr*/)
    CONST char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

#ifdef TCL_LOAD_FROM_MEMORY
/*
 *----------------------------------------------------------------------
 *
 * TclpLoadMemoryGetBuffer --
 *
 *	Allocate a buffer that can be used with TclpLoadMemory() below.
 *
 * Results:
 *	Pointer to allocated buffer or NULL if an error occurs.
 *
 * Side effects:
 *	Buffer is allocated.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE void *
TclpLoadMemoryGetBuffer(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp,		/* Used for error reporting. */
    int size)			/* Size of desired buffer. */
{
    void *buffer = NULL;

    /*
     * NSCreateObjectFileImageFromMemory is available but always fails
     * prior to Darwin 7.
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
611

612
613
614

615
616
617
618
619

620
621
622

623





624

625
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
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
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
618

619

620
621
622
623
624

625
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
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
756

757
758
759
760
761
762
763






764
765
766
767
768
769
770
771
772
773
774
775
776







-



















-












-
+



-

-





-







-
+











-
+









+


-
+




-
+


-
+

+
+
+
+
+
-
+


+



-
+


+







+
-
+




+
+





-
+
+
+
+

+
+














-
-
-
+
+








-
-
-
+
+

-
+
+
+





+
-
+







-
+


-
+
+
+

+


-
-
-
-
-
-
+
+












	if (vm_allocate(mach_task_self(), (vm_address_t *) &buffer, size, 1)) {
	    buffer = NULL;
	}
    }
    return buffer;
}
#endif /* TCL_LOAD_FROM_MEMORY */

/*
 *----------------------------------------------------------------------
 *
 * TclpLoadMemory --
 *
 *	Dynamically loads binary code file from memory and returns a handle to
 *	the new code.
 *
 * Results:
 *	A standard Tcl completion code. If an error occurs, an error message
 *	is left in the interpreter's result.
 *
 * Side effects:
 *	New code is loaded from memory.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_LOAD_FROM_MEMORY
MODULE_SCOPE int
TclpLoadMemory(
    Tcl_Interp *interp,		/* Used for error reporting. */
    void *buffer,		/* Buffer containing the desired code
				 * (allocated with TclpLoadMemoryGetBuffer). */
    int size,			/* Allocation size of buffer. */
    int codeSize,		/* Size of code data read into buffer or -1 if
				 * an error occurred and the buffer should
				 * just be freed. */
    Tcl_LoadHandle *loadHandle, /* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
{
    Tcl_LoadHandle newHandle;
    Tcl_DyldLoadHandle *dyldLoadHandle;
    NSObjectFileImage dyldObjFileImage = NULL;
    Tcl_DyldModuleHandle *modulePtr;
    NSModule module;
    const char *objFileImageErrMsg = NULL;
    int nsflags = NSLINKMODULE_OPTION_RETURN_ON_ERROR;

    /*
     * Try to create an object file image that we can load from.
     */

    if (codeSize >= 0) {
	NSObjectFileImageReturnCode err = NSObjectFileImageSuccess;
	const struct fat_header *fh = (const struct fat_header *)buffer;
	const struct fat_header *fh = buffer;
	uint32_t ms = 0;
#ifndef __LP64__
	const struct mach_header *mh = NULL;
#	define mh_size  sizeof(struct mach_header)
#	define mh_magic MH_MAGIC
#	define arch_abi 0
#else
	const struct mach_header_64 *mh = NULL;
#	define mh_size  sizeof(struct mach_header_64)
#	define mh_magic MH_MAGIC_64
#	define arch_abi CPU_ARCH_ABI64
#endif /*  __LP64__ */
#endif

	if ((size_t) codeSize >= sizeof(struct fat_header)
		&& fh->magic == OSSwapHostToBigInt32(FAT_MAGIC)) {
	    uint32_t fh_nfat_arch = OSSwapBigToHostInt32(fh->nfat_arch);

	    /*
	     * Fat binary, try to find mach_header for our architecture
	     */

	    TclLoadDbgMsg("Fat binary, %d archs", fh_nfat_arch);
	    if ((size_t) codeSize >= sizeof(struct fat_header) +
		    fh_nfat_arch * sizeof(struct fat_arch)) {
		void *fatarchs = (char *)buffer + sizeof(struct fat_header);
		void *fatarchs = (char*)buffer + sizeof(struct fat_header);
		const NXArchInfo *arch = NXGetLocalArchInfo();
		struct fat_arch *fa;

		if (fh->magic != FAT_MAGIC) {
		    swap_fat_arch((struct fat_arch *)fatarchs, fh_nfat_arch, arch->byteorder);
		    swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder);
		}
		fa = NXFindBestFatArch(arch->cputype | arch_abi,
			arch->cpusubtype, (struct fat_arch *)fatarchs, fh_nfat_arch);
			arch->cpusubtype, fatarchs, fh_nfat_arch);
		if (fa) {
		    TclLoadDbgMsg("NXFindBestFatArch() successful: "
			    "local cputype %d subtype %d, "
			    "fat cputype %d subtype %d",
			    arch->cputype | arch_abi, arch->cpusubtype,
			    fa->cputype, fa->cpusubtype);
		    mh = (const struct mach_header_64 *)((char *) buffer + fa->offset);
		    mh = (void*)((char*)buffer + fa->offset);
		    ms = fa->size;
		} else {
		    TclLoadDbgMsg("NXFindBestFatArch() failed");
		    err = NSObjectFileImageInappropriateFile;
		}
		if (fh->magic != FAT_MAGIC) {
		    swap_fat_arch((struct fat_arch *)fatarchs, fh_nfat_arch, arch->byteorder);
		    swap_fat_arch(fatarchs, fh_nfat_arch, arch->byteorder);
		}
	    } else {
		TclLoadDbgMsg("Fat binary header failure");
		err = NSObjectFileImageInappropriateFile;
	    }
	} else {
	    /*
	     * Thin binary
	     */

	    TclLoadDbgMsg("Thin binary");
	    mh = (const struct mach_header_64 *)buffer;
	    mh = buffer;
	    ms = codeSize;
	}
	if (ms && !(ms >= mh_size && mh->magic == mh_magic &&
		 mh->filetype == MH_BUNDLE)) {
	    TclLoadDbgMsg("Inappropriate file: magic %x filetype %d",
		    mh->magic, mh->filetype);
	    err = NSObjectFileImageInappropriateFile;
	}
	if (err == NSObjectFileImageSuccess) {
	    err = NSCreateObjectFileImageFromMemory(buffer, codeSize,
		    &dyldObjFileImage);
	    if (err != NSObjectFileImageSuccess) {
	    if (err == NSObjectFileImageSuccess) {
		TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() "
			"successful");
	    } else {
		objFileImageErrMsg = DyldOFIErrorMsg(err);
		TclLoadDbgMsg("NSCreateObjectFileImageFromMemory() failed: %s",
			objFileImageErrMsg);
	    }
	} else {
	    objFileImageErrMsg = DyldOFIErrorMsg(err);
	}
    }

    /*
     * If it went wrong (or we were asked to just deallocate), get rid of the
     * memory block and create an error message.
     */

    if (dyldObjFileImage == NULL) {
	vm_deallocate(mach_task_self(), (vm_address_t) buffer, size);
	if (objFileImageErrMsg != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "NSCreateObjectFileImageFromMemory() error: %s",
		    objFileImageErrMsg));
	    Tcl_AppendResult(interp, "NSCreateObjectFileImageFromMemory() "
		    "error: ", objFileImageErrMsg, NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Extract the module we want from the image of the object file.
     */

    if (!(flags & 1)) nsflags |= NSLINKMODULE_OPTION_PRIVATE;
    if (!(flags & 2)) nsflags |= NSLINKMODULE_OPTION_BINDNOW;
    module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]", nsflags);
    module = NSLinkModule(dyldObjFileImage, "[Memory Based Bundle]",
	    NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_RETURN_ON_ERROR);
    NSDestroyObjectFileImage(dyldObjFileImage);
    if (!module) {
    if (module) {
	TclLoadDbgMsg("NSLinkModule() successful");
    } else {
	NSLinkEditErrors editError;
	int errorNumber;
	const char *errorName, *errMsg;

	NSLinkEditError(&editError, &errorNumber, &errorName, &errMsg);
	TclLoadDbgMsg("NSLinkModule() failed: %s", errMsg);
	Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
	Tcl_AppendResult(interp, errMsg, NULL);
	return TCL_ERROR;
    }

    /*
     * Stash the module reference within the load handle we create and return.
     */

    modulePtr = (Tcl_DyldModuleHandle *)Tcl_Alloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr = (Tcl_DyldModuleHandle *) ckalloc(sizeof(Tcl_DyldModuleHandle));
    modulePtr->module = module;
    modulePtr->nextPtr = NULL;
    dyldLoadHandle = (Tcl_DyldLoadHandle *)Tcl_Alloc(sizeof(Tcl_DyldLoadHandle));
    dyldLoadHandle = (Tcl_DyldLoadHandle *)
	    ckalloc(sizeof(Tcl_DyldLoadHandle));
#if TCL_DYLD_USE_DLFCN
    dyldLoadHandle->dlHandle = NULL;
#endif
    dyldLoadHandle->dyldLibHeader = NULL;
    dyldLoadHandle->modulePtr = modulePtr;
    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = dyldLoadHandle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = (Tcl_LoadHandle) dyldLoadHandle;
    *unloadProcPtr = &TclpUnloadFile;
    return TCL_OK;
}
#endif /* TCL_LOAD_FROM_MEMORY */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 79
 * End:
 */

Changes to unix/tclLoadNext.c.

1
2
3
4
5
6
7
8
9
10


11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
1
2
3
4
5
6
7
8


9
10
11
12
13
14
15






16
17
18
19
20
21
22








-
-
+
+





-
-
-
-
-
-







/*
 * tclLoadNext.c --
 *
 *	This procedure provides a version of the TclLoadFile that works with
 *	NeXTs rld_* dynamic loading. This file provided by Pedja Bogdanovich.
 *
 * 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.
 * 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 <mach-o/rld.h>
#include <streams/streams.h>

/* Static procedures defined within this file */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char* symbol);
static void		UnloadFile(Tcl_LoadHandle loadHandle);

/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
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
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







-
+



-

-



-
+




-
+







TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
{
    Tcl_LoadHandle newHandle;
    struct mach_header *header;
    char *fileName;
    char *files[2];
    const char *native;
    CONST char *native;
    int result = 1;

    NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);

    fileName = TclGetString(pathPtr);
    fileName = Tcl_GetString(pathPtr);

    /*
     * 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.
     */

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
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







-
-
-
+
+
+





-
-
-
-
-
-
+
+







-
+












-
-
+
+


-
+


-






-
+
-
-
-
-
-







-
+















-
+




-







	Tcl_DStringFree(&ds);
    }

    if (!result) {
	char *data;
	int len, maxlen;

	NXGetMemoryBuffer(errorStream, &data, &len, &maxlen);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s", fileName, data));
	NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
	Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
		data, NULL);
	NXCloseMemory(errorStream, NX_FREEBUFFER);
	return TCL_ERROR;
    }
    NXCloseMemory(errorStream, NX_FREEBUFFER);

    newHandle = (Tcl_LoadHandle) Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = INT2PTR(1);
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
    *unloadProcPtr = &TclpUnloadFile;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --
 * TclpFindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	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_PackageInitProc *
TclpFindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
    CONST char *symbol)
{
    Tcl_PackageInitProc *proc = NULL;

    if (symbol) {
	char sym[strlen(symbol) + 2];

	sym[0] = '_';
	sym[1] = 0;
	strcat(sym, symbol);
	rld_lookup(NULL, sym, (unsigned long *) &proc);
	rld_lookup(NULL, sym, (unsigned long *)&proc);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find symbol \"%s\"", symbol));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 * TclpUnloadFile --
 *
 *	Unloads a dynamically loaded binary code file from memory. Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Does nothing.  Can anything be done?
 *
 *----------------------------------------------------------------------
 */

void
UnloadFile(
TclpUnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
196
197
198
199
200
201
202
203

204
205
206
207
208
209
210
177
178
179
180
181
182
183

184
185
186
187
188
189
190
191







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
    CONST char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}


Changes to unix/tclLoadOSF.c.

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
31
32
33
34
35
36
37








38
39
40
41
42
43
44







-
-
-
-
-
-
-
-







 * 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 <sys/types.h>
#include <loader.h>

/*
 * Static functions defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char* symbol);
static void		UnloadFile(Tcl_LoadHandle handle);

/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
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
58
59
60
61
62
63
64

65
66
67
68

69

70
71


72
73
74
75
76
77
78
79
80







-
+



-

-


-
-
+
+







TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
{
    Tcl_LoadHandle newHandle;
    ldr_module_t lm;
    char *pkg;
    char *fileName = TclGetString(pathPtr);
    const char *native;
    char *fileName = Tcl_GetString(pathPtr);
    CONST char *native;

    /*
     * 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.
     */

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
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







-
-
-
+
+



















-
-
-
-
-
-
+
+






-
+












-
-
+
+


-
+

-
+
-
-
-
-
-
-
-





-
+














-
-
+
+




-








	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	lm = (Tcl_PackageInitProc *) load(native, LDR_NOFLAGS);
	Tcl_DStringFree(&ds);
    }

    if (lm == LDR_NULL_MODULE) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
		Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }

    *clientDataPtr = NULL;

    /*
     * My convention is to use a [OSF loader] package name the same as shlib,
     * since the idiots never implemented ldr_lookup() and it is otherwise
     * impossible to get a package name given a module.
     *
     * I build loadable modules with a makefile rule like
     *		ld ... -export $@: -o $@ $(OBJS)
     */

    if ((pkg = strrchr(fileName, '/')) == NULL) {
        pkg = fileName;
    } else {
	pkg++;
    }
    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
    newHandle->clientData = pkg;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = &UnloadFile;
    *loadHandle = newHandle;
    *unloadProcPtr = &UnloadFile;
    *loadHandle = pkg;
    *unloadProcPtr = &TclpUnloadFile;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --
 * TclpFindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	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_PackageInitProc *
TclpFindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
    CONST char *symbol)
{
    void *retval = ldr_lookup_package((char *) loadHandle, symbol);
    return ldr_lookup_package((char *)loadHandle, symbol);

    if (retval == NULL && interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find symbol \"%s\"", symbol));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
    }
    return retval;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 * TclpUnloadFile --
 *
 *	Unloads a dynamically loaded binary code file from memory. Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Does nothing.  Can anything be done?
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
void
TclpUnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
191
192
193
194
195
196
197

198
199
200
201
202
203
204
205







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
    CONST char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}


Changes to unix/tclLoadShl.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
9
10
11
12
13
14
15








16
17
18
19
20
21
22







-
-
-
-
-
-
-
-







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <dl.h>
#include "tclInt.h"

/*
 * Static functions defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);
static void		UnloadFile(Tcl_LoadHandle handle);

/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
44
45
46
47
48
49
50
51

52
53
54
55
56
57
58
59
60


61
62
63
64
65
66
67
36
37
38
39
40
41
42

43
44
45
46

47
48



49
50
51
52
53
54
55
56
57







-
+



-


-
-
-
+
+







TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    int flags)
{
    shl_t handle;
    Tcl_LoadHandle newHandle;
    const char *native;
    char *fileName = TclGetString(pathPtr);
    CONST char *native;
    char *fileName = Tcl_GetString(pathPtr);

    /*
     * The flags below used to be BIND_IMMEDIATE; they were changed at the
     * suggestion of Wolfgang Kechel (wolfgang@prs.de): "This enables
     * verbosity for missing symbols when loading a shared lib and allows to
     * load libtk8.0.sl into tclsh8.0 without problems.  In general, this
     * delays resolving symbols until they are actually needed.  Shared libs
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
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







-
-
-
+
+


-
+
-
-
-
+
-






-
+












-
-
+
+


-
+



-
+









-
+







-
-
-
-
-






-
+














-
-
+
+




-
+

+

-








	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
	handle = shl_load(native, BIND_DEFERRED|BIND_VERBOSE|DYNAMIC_PATH, 0L);
	Tcl_DStringFree(&ds);
    }

    if (handle == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't load file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't load file \"", fileName, "\": ",
		Tcl_PosixError(interp), (char *) NULL);
	return TCL_ERROR;
    }
    newHandle = (Tcl_LoadHandle)Tcl_Alloc(sizeof(*newHandle));
    *loadHandle = (Tcl_LoadHandle) handle;
    newHandle->clientData = handle;
    newHandle->findSymbolProcPtr = &FindSymbol;
    newHandle->unloadFileProcPtr = *unloadProcPtr = &UnloadFile;
    *unloadProcPtr = &TclpUnloadFile;
    *loadHandle = newHandle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FindSymbol --
 * TclpFindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	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_PackageInitProc *
TclpFindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
    CONST char *symbol)
{
    Tcl_DString newName;
    Tcl_PackageInitProc *proc = NULL;
    shl_t handle = (shl_t) loadHandle->clientData;
    shl_t handle = (shl_t)loadHandle;

    /*
     * Some versions of the HP system software still use "_" at the beginning
     * of exported symbols while others don't; try both forms of each name.
     */

    if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE,
	    (void *) &proc) != 0) {
	Tcl_DStringInit(&newName);
	TclDStringAppendLiteral(&newName, "_");
	Tcl_DStringAppend(&newName, "_", 1);
	Tcl_DStringAppend(&newName, symbol, -1);
	if (shl_findsym(&handle, Tcl_DStringValue(&newName),
		(short) TYPE_PROCEDURE, (void *) &proc) != 0) {
	    proc = NULL;
	}
	Tcl_DStringFree(&newName);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find symbol \"%s\": %s",
		symbol, Tcl_PosixError(interp)));
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 * TclpUnloadFile --
 *
 *	Unloads a dynamically loaded binary code file from memory.  Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
void
TclpUnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    shl_t handle = (shl_t) loadHandle->clientData;
    shl_t handle;

    handle = (shl_t) loadHandle;
    shl_unload(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
203
204
205
206
207
208
209
210

211
212
213
214
215
216
217
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    const char *fileName,	/* Name of file containing package (already
    CONST char *fileName,	/* Name of file containing package (already
				 * translated to local form if needed). */
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}


Deleted unix/tclSelectNotfy.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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




































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclSelectNotfy.c --
 *
 *	This file contains the implementation of the select()-based generic
 *	Unix notifier, which is the lowest-level part of the Tcl event loop.
 *	This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#if (!defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)) || !TCL_THREADS

#include <signal.h>

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

typedef struct FileHandler {
    int fd;
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure contains a set of select() masks to track readable,
 * writable, and exception conditions.
 */

typedef struct {
    fd_set readable;
    fd_set writable;
    fd_set exception;
} SelectMasks;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */

typedef struct {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    int fd;			/* File descriptor that is ready. Used to find
				 * the FileHandler structure for the file
				 * (can't point directly to the FileHandler
				 * structure because it could go away while
				 * the event is queued). */
} FileHandlerEvent;

/*
 * The following static structure contains the state information for the
 * select based implementation of the Tcl notifier. One of these structures is
 * created for each thread that is using the notifier.
 */

typedef struct ThreadSpecificData {
    FileHandler *firstFileHandlerPtr;
				/* Pointer to head of file handler list. */
    SelectMasks checkMasks;	/* This structure is used to build up the
				 * masks to be used in the next call to
				 * select. Bits are set in response to calls
				 * to Tcl_CreateFileHandler. */
    SelectMasks readyMasks;	/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
    int numFdBits;		/* Number of valid bits in checkMasks (one
				 * more than highest fd for which
				 * Tcl_WatchFile has been called). */
#if TCL_THREADS
    int onList;			/* True if it is in this list */
    unsigned int pollState;	/* pollState is used to implement a polling
				 * handshake between each thread and the
				 * notifier thread. Bits defined below. */
    struct ThreadSpecificData *nextPtr, *prevPtr;
				/* All threads that are currently waiting on
				 * an event have their ThreadSpecificData
				 * structure on a doubly-linked listed formed
				 * from these pointers. You must hold the
				 * notifierMutex lock before accessing these
				 * fields. */
#ifdef __CYGWIN__
    void *event;		/* Any other thread alerts a notifier that an
				 * event is ready to be processed by sending
				 * this event. */
    void *hwnd;			/* Messaging window. */
#else /* !__CYGWIN__ */
    pthread_cond_t waitCV;	/* Any other thread alerts a notifier that an
				 * event is ready to be processed by signaling
				 * this condition variable. */
#endif /* __CYGWIN__ */
    int waitCVinitialized;	/* Variable to flag initialization of the
				 * structure. */
    int eventReady;		/* True if an event is ready to be processed.
				 * Used as condition flag together with waitCV
				 * above. */
#endif /* TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#if TCL_THREADS
/*
 * The following static indicates the number of threads that have initialized
 * notifiers.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

static int notifierCount = 0;

/*
 * The following variable points to the head of a doubly-linked list of
 * ThreadSpecificData structures for all threads that are currently waiting on
 * an event.
 *
 * You must hold the notifierMutex lock before accessing this list.
 */

static ThreadSpecificData *waitingListPtr = NULL;

/*
 * The notifier thread spends all its time in select() waiting for a file
 * descriptor associated with one of the threads on the waitingListPtr list to
 * do something interesting. But if the contents of the waitingListPtr list
 * ever changes, we need to wake up and restart the select() system call. You
 * can wake up the notifier thread by writing a single byte to the file
 * descriptor defined below. This file descriptor is the input-end of a pipe
 * and the notifier thread is listening for data on the output-end of the same
 * pipe. Hence writing to this file descriptor will cause the select() system
 * call to return and wake up the notifier thread.
 *
 * You must hold the notifierMutex lock before writing to the pipe.
 */

static int triggerPipe = -1;

/*
 * The notifierMutex locks access to all of the global notifier state.
 */

static pthread_mutex_t notifierInitMutex = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t notifierMutex     = PTHREAD_MUTEX_INITIALIZER;
/*
 * The following static indicates if the notifier thread is running.
 *
 * You must hold the notifierInitMutex before accessing this variable.
 */

static int notifierThreadRunning = 0;

/*
 * The notifier thread signals the notifierCV when it has finished
 * initializing the triggerPipe and right before the notifier thread
 * terminates.
 */

static pthread_cond_t notifierCV = PTHREAD_COND_INITIALIZER;

/*
 * The pollState bits:
 *
 * POLL_WANT is set by each thread before it waits on its condition variable.
 *	It is checked by the notifier before it does select.
 *
 * POLL_DONE is set by the notifier if it goes into select after seeing
 *	POLL_WANT. The idea is to ensure it tries a select with the same bits
 *	the initial thread had set.
 */

#define POLL_WANT	0x1
#define POLL_DONE	0x2

/*
 * This is the thread ID of the notifier thread that does select.
 */

static Tcl_ThreadId notifierThread;
#endif /* TCL_THREADS */

/*
 * Static routines defined in this file.
 */

#if TCL_THREADS
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int atForkInit = 0;
static void		AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);

/*
 * Import of critical bits of Windows API when building threaded with Cygwin.
 */

#if defined(__CYGWIN__)
#ifdef __cplusplus
extern "C" {
#endif
typedef struct {
    void *hwnd;			/* Messaging window. */
    unsigned int *message;	/* Message payload. */
    size_t wParam;			/* Event-specific "word" parameter. */
    size_t lParam;			/* Event-specific "long" parameter. */
    int time;			/* Event timestamp. */
    int x;			/* Event location (where meaningful). */
    int y;
    int lPrivate;
} MSG;

typedef struct {
    unsigned int style;
    void *lpfnWndProc;
    int cbClsExtra;
    int cbWndExtra;
    void *hInstance;
    void *hIcon;
    void *hCursor;
    void *hbrBackground;
    const void *lpszMenuName;
    const void *lpszClassName;
} WNDCLASSW;

#ifdef __clang__
#pragma clang diagnostic ignored "-Wignored-attributes"
#endif
extern void __stdcall	CloseHandle(void *);
extern void *__stdcall	CreateEventW(void *, unsigned char, unsigned char,
			    void *);
extern void *__stdcall	CreateWindowExW(void *, const void *, const void *,
			    unsigned int, int, int, int, int, void *, void *, void *,
			    void *);
extern unsigned int __stdcall	DefWindowProcW(void *, int, void *, void *);
extern unsigned char __stdcall	DestroyWindow(void *);
extern int __stdcall	DispatchMessageW(const MSG *);
extern unsigned char __stdcall	GetMessageW(MSG *, void *, int, int);
extern void __stdcall	MsgWaitForMultipleObjects(unsigned int, void *,
			    unsigned char, unsigned int, unsigned int);
extern unsigned char __stdcall	PeekMessageW(MSG *, void *, int, int, int);
extern unsigned char __stdcall	PostMessageW(void *, unsigned int, void *,
				    void *);
extern void __stdcall	PostQuitMessage(int);
extern void *__stdcall	RegisterClassW(const WNDCLASSW *);
extern unsigned char __stdcall	ResetEvent(void *);
extern unsigned char __stdcall	TranslateMessage(const MSG *);

/*
 * Threaded-cygwin specific constants and functions in this file:
 */

static const wchar_t className[] = L"TclNotifier";
static unsigned int __stdcall	NotifierProc(void *hwnd, unsigned int message,
			    void *wParam, void *lParam);
#ifdef __cplusplus
}
#endif
#endif /* TCL_THREADS && __CYGWIN__ */


#include "tclUnixNotfy.c"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * Results:
 *	Returns a handle to the notifier state for this thread.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if TCL_THREADS
	tsdPtr->eventReady = 0;

	/*
	 * Initialize thread specific condition variable for this thread.
	 */
	if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
	    WNDCLASSW clazz;

	    clazz.style = 0;
	    clazz.cbClsExtra = 0;
	    clazz.cbWndExtra = 0;
	    clazz.hInstance = TclWinGetTclInstance();
	    clazz.hbrBackground = NULL;
	    clazz.lpszMenuName = NULL;
	    clazz.lpszClassName = className;
	    clazz.lpfnWndProc = (void *)NotifierProc;
	    clazz.hIcon = NULL;
	    clazz.hCursor = NULL;

	    RegisterClassW(&clazz);
	    tsdPtr->hwnd = CreateWindowExW(NULL, clazz.lpszClassName,
		    clazz.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
		    clazz.hInstance, NULL);
	    tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
		    0 /* !signaled */, NULL);
#else
	    pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif /* __CYGWIN__ */
	    tsdPtr->waitCVinitialized = 1;
	}

	pthread_mutex_lock(&notifierInitMutex);
#if defined(HAVE_PTHREAD_ATFORK)
	/*
	 * Install pthread_atfork handlers to clean up the notifier in the
	 * child of a fork.
	 */

	if (!atForkInit) {
	    int result = pthread_atfork(NULL, NULL, AtForkChild);

	    if (result) {
		Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	    }
	    atForkInit = 1;
	}
#endif /* HAVE_PTHREAD_ATFORK */

	notifierCount++;
	pthread_mutex_unlock(&notifierInitMutex);

#endif /* TCL_THREADS */
	return tsdPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	This function is called to cleanup the notifier state before a thread
 *	is terminated.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May terminate the background notifier thread if this is the last
 *	notifier instance.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	pthread_mutex_lock(&notifierInitMutex);
	notifierCount--;

	/*
	 * If this is the last thread to use the notifier, close the notifier
	 * pipe and wait for the background thread to terminate.
	 */

	if (notifierCount == 0 && triggerPipe != -1) {
	    if (write(triggerPipe, "q", 1) != 1) {
		Tcl_Panic("Tcl_FinalizeNotifier: %s",
			"unable to write 'q' to triggerPipe");
	    }
	    close(triggerPipe);
	    pthread_mutex_lock(&notifierMutex);
	    while(triggerPipe != -1) {
		pthread_cond_wait(&notifierCV, &notifierMutex);
	    }
	    pthread_mutex_unlock(&notifierMutex);
	    if (notifierThreadRunning) {
		int result = pthread_join((pthread_t) notifierThread, NULL);

		if (result) {
		    Tcl_Panic("Tcl_FinalizeNotifier: %s",
			    "unable to join notifier thread");
		}
		notifierThreadRunning = 0;
	    }
	}

	/*
	 * Clean up any synchronization objects in the thread local storage.
	 */

#ifdef __CYGWIN__
	DestroyWindow(tsdPtr->hwnd);
	CloseHandle(tsdPtr->event);
#else /* __CYGWIN__ */
	pthread_cond_destroy(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
	tsdPtr->waitCVinitialized = 0;

	pthread_mutex_unlock(&notifierInitMutex);
#endif /* TCL_THREADS */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This function registers a file handler with the select notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateFileHandler(
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    if (tclNotifierHooks.createFileHandlerProc) {
	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	FileHandler *filePtr;

	for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
		filePtr = filePtr->nextPtr) {
	    if (filePtr->fd == fd) {
		break;
	    }
	}
	if (filePtr == NULL) {
	    filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	    filePtr->fd = fd;
	    filePtr->readyMask = 0;
	    filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	    tsdPtr->firstFileHandlerPtr = filePtr;
	}
	filePtr->proc = proc;
	filePtr->clientData = clientData;
	filePtr->mask = mask;

	/*
	 * Update the check masks for this file.
	 */

	if (mask & TCL_READABLE) {
	    FD_SET(fd, &tsdPtr->checkMasks.readable);
	} else {
	    FD_CLR(fd, &tsdPtr->checkMasks.readable);
	}
	if (mask & TCL_WRITABLE) {
	    FD_SET(fd, &tsdPtr->checkMasks.writable);
	} else {
	    FD_CLR(fd, &tsdPtr->checkMasks.writable);
	}
	if (mask & TCL_EXCEPTION) {
	    FD_SET(fd, &tsdPtr->checkMasks.exception);
	} else {
	    FD_CLR(fd, &tsdPtr->checkMasks.exception);
	}
	if (tsdPtr->numFdBits <= fd) {
	    tsdPtr->numFdBits = fd+1;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    if (tclNotifierHooks.deleteFileHandlerProc) {
	tclNotifierHooks.deleteFileHandlerProc(fd);
	return;
    } else {
	FileHandler *filePtr, *prevPtr;
	int i;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * Find the entry for the given file (and return if there isn't one).
	 */

	for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
		prevPtr = filePtr, filePtr = filePtr->nextPtr) {
	    if (filePtr == NULL) {
		return;
	    }
	    if (filePtr->fd == fd) {
		break;
	    }
	}

	/*
	 * Update the check masks for this file.
	 */

	if (filePtr->mask & TCL_READABLE) {
	    FD_CLR(fd, &tsdPtr->checkMasks.readable);
	}
	if (filePtr->mask & TCL_WRITABLE) {
	    FD_CLR(fd, &tsdPtr->checkMasks.writable);
	}
	if (filePtr->mask & TCL_EXCEPTION) {
	    FD_CLR(fd, &tsdPtr->checkMasks.exception);
	}

	/*
	 * Find current max fd.
	 */

	if (fd+1 == tsdPtr->numFdBits) {
	    int numFdBits = 0;

	    for (i = fd-1; i >= 0; i--) {
		if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
			|| FD_ISSET(i, &tsdPtr->checkMasks.writable)
			|| FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
		    numFdBits = i+1;
		    break;
		}
	    }
	    tsdPtr->numFdBits = numFdBits;
	}

	/*
	 * Clean up information in the callback record.
	 */

	if (prevPtr == NULL) {
	    tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
	} else {
	    prevPtr->nextPtr = filePtr->nextPtr;
	}
	Tcl_Free(filePtr);
    }
}

#if defined(__CYGWIN__)

static unsigned int __stdcall
NotifierProc(
    void *hwnd,
    unsigned int message,
    void *wParam,
    void *lParam)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (message != 1024) {
	return DefWindowProcW(hwnd, message, wParam, lParam);
    }

    /*
     * Process all of the runnable events.
     */

    tsdPtr->eventReady = 1;
    Tcl_ServiceAll();
    return 0;
}
#endif /* TCL_THREADS && __CYGWIN__ */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This function is called by Tcl_DoOneEvent to wait for new events on
 *	the message queue. If the block time is 0, then Tcl_WaitForEvent just
 *	polls without blocking.
 *
 * Results:
 *	Returns -1 if the select would block forever, otherwise returns 0.
 *
 * Side effects:
 *	Queues file events that are detected by the select.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
#if TCL_THREADS
	int waitForFiles;
#   ifdef __CYGWIN__
	MSG msg;
#   endif /* __CYGWIN__ */
#else /* !TCL_THREADS */
	/*
	 * Impl. notes: timeout & timeoutPtr are used if, and only if threads
	 * are not enabled. They are the arguments for the regular select()
	 * used when the core is not thread-enabled.
	 */

	struct timeval timeout, *timeoutPtr;
	int numFound;
#endif /* TCL_THREADS */

	/*
	 * Set up the timeout structure. Note that if there are no events to
	 * check for, we return with a negative result rather than blocking
	 * forever.
	 */

	if (timePtr != NULL) {
	    /*
	     * TIP #233 (Virtualized Time). Is virtual time in effect? And do
	     * we actually have something to scale? If yes to both then we
	     * call the handler to do this scaling.
	     */

	    if (timePtr->sec != 0 || timePtr->usec != 0) {
		vTime = *timePtr;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		timePtr = &vTime;
	    }
#if !TCL_THREADS
	    timeout.tv_sec = timePtr->sec;
	    timeout.tv_usec = timePtr->usec;
	    timeoutPtr = &timeout;
	} else if (tsdPtr->numFdBits == 0) {
	    /*
	     * If there are no threads, no timeout, and no fds registered,
	     * then there are no events possible and we must avoid deadlock.
	     * Note that this is not entirely correct because there might be a
	     * signal that could interrupt the select call, but we don't
	     * handle that case if we aren't using threads.
	     */

	    return -1;
	} else {
	    timeoutPtr = NULL;
#endif /* !TCL_THREADS */
	}

#if TCL_THREADS
	/*
	 * Start notifier thread and place this thread on the list of
	 * interested threads, signal the notifier thread, and wait for a
	 * response or a timeout.
	 */
	StartNotifierThread("Tcl_WaitForEvent");

	pthread_mutex_lock(&notifierMutex);

	if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
#if defined(__APPLE__) && defined(__LP64__)
		/*
		 * On 64-bit Darwin, pthread_cond_timedwait() appears to have
		 * a bug that causes it to wait forever when passed an
		 * absolute time which has already been exceeded by the system
		 * time; as a workaround, when given a very brief timeout,
		 * just do a poll. [Bug 1457797]
		 */
		|| timePtr->usec < 10
#endif /* __APPLE__ && __LP64__ */
		)) {
	    /*
	     * Cannot emulate a polling select with a polling condition
	     * variable. Instead, pretend to wait for files and tell the
	     * notifier thread what we are doing. The notifier thread makes
	     * sure it goes through select with its select mask in the same
	     * state as ours currently is. We block until that happens.
	     */

	    waitForFiles = 1;
	    tsdPtr->pollState = POLL_WANT;
	    timePtr = NULL;
	} else {
	    waitForFiles = (tsdPtr->numFdBits > 0);
	    tsdPtr->pollState = 0;
	}

	if (waitForFiles) {
	    /*
	     * Add the ThreadSpecificData structure of this thread to the list
	     * of ThreadSpecificData structures of all threads that are
	     * waiting on file events.
	     */

	    tsdPtr->nextPtr = waitingListPtr;
	    if (waitingListPtr) {
		waitingListPtr->prevPtr = tsdPtr;
	    }
	    tsdPtr->prevPtr = 0;
	    waitingListPtr = tsdPtr;
	    tsdPtr->onList = 1;

	    if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
		Tcl_Panic("Tcl_WaitForEvent: %s",
			"unable to write to triggerPipe");
	    }
	}

	FD_ZERO(&tsdPtr->readyMasks.readable);
	FD_ZERO(&tsdPtr->readyMasks.writable);
	FD_ZERO(&tsdPtr->readyMasks.exception);

	if (!tsdPtr->eventReady) {
#ifdef __CYGWIN__
	    if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
		unsigned int timeout;

		if (timePtr) {
		    timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
		} else {
		    timeout = 0xFFFFFFFF;
		}
		pthread_mutex_unlock(&notifierMutex);
		MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
		pthread_mutex_lock(&notifierMutex);
	    }
#else /* !__CYGWIN__ */
	    if (timePtr != NULL) {
		Tcl_Time now;
		struct timespec ptime;

		Tcl_GetTime(&now);
		ptime.tv_sec = timePtr->sec + now.sec +
			(timePtr->usec + now.usec) / 1000000;
		ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);

		pthread_cond_timedwait(&tsdPtr->waitCV, &notifierMutex, &ptime);
	    } else {
		pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
	    }
#endif /* __CYGWIN__ */
	}
	tsdPtr->eventReady = 0;

#ifdef __CYGWIN__
	while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
	    /*
	     * Retrieve and dispatch the message.
	     */

	    unsigned int result = GetMessageW(&msg, NULL, 0, 0);

	    if (result == 0) {
		PostQuitMessage(msg.wParam);
		/* What to do here? */
	    } else if (result != (unsigned int) -1) {
		TranslateMessage(&msg);
		DispatchMessageW(&msg);
	    }
	}
	ResetEvent(tsdPtr->event);
#endif /* __CYGWIN__ */

	if (waitForFiles && tsdPtr->onList) {
	    /*
	     * Remove the ThreadSpecificData structure of this thread from the
	     * waiting list. Alert the notifier thread to recompute its select
	     * masks - skipping this caused a hang when trying to close a pipe
	     * which the notifier thread was still doing a select on.
	     */

	    if (tsdPtr->prevPtr) {
		tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
	    } else {
		waitingListPtr = tsdPtr->nextPtr;
	    }
	    if (tsdPtr->nextPtr) {
		tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
	    }
	    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
	    tsdPtr->onList = 0;
	    if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
		Tcl_Panic("Tcl_WaitForEvent: %s",
			"unable to write to triggerPipe");
	    }
	}
#else /* !TCL_THREADS */
	tsdPtr->readyMasks = tsdPtr->checkMasks;
	numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
		&tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
		timeoutPtr);

	/*
	 * Some systems don't clear the masks after an error, so we have to do
	 * it here.
	 */

	if (numFound == -1) {
	    FD_ZERO(&tsdPtr->readyMasks.readable);
	    FD_ZERO(&tsdPtr->readyMasks.writable);
	    FD_ZERO(&tsdPtr->readyMasks.exception);
	}
#endif /* TCL_THREADS */

	/*
	 * Queue all detected file events before returning.
	 */

	for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
		filePtr = filePtr->nextPtr) {
	    mask = 0;
	    if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) {
		mask |= TCL_READABLE;
	    }
	    if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) {
		mask |= TCL_WRITABLE;
	    }
	    if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) {
		mask |= TCL_EXCEPTION;
	    }

	    if (!mask) {
		continue;
	    }

	    /*
	     * Don't bother to queue an event if the mask was previously
	     * non-zero since an event must still be on the queue.
	     */

	    if (filePtr->readyMask == 0) {
		FileHandlerEvent *fileEvPtr =
			(FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent));

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
#if TCL_THREADS
	pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
	return 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NotifierThreadProc --
 *
 *	This routine is the initial (and only) function executed by the
 *	special notifier thread. Its job is to wait for file descriptors to
 *	become readable or writable or to have an exception condition and then
 *	to notify other threads who are interested in this information by
 *	signalling a condition variable. Other threads can signal this
 *	notifier thread of a change in their interests by writing a single
 *	byte to a special pipe that the notifier thread is monitoring.
 *
 * Result:
 *	None. Once started, this routine never exits. It dies with the overall
 *	process.
 *
 * Side effects:
 *	The trigger pipe used to signal the notifier thread is created when
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
static TCL_NORETURN void
NotifierThreadProc(
    TCL_UNUSED(ClientData))
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionMask;
    int i;
    int fds[2], receivePipe;
    long found;
    struct timeval poll = {0, 0}, *timePtr;
    char buf[2];
    int numFdBits = 0;

    if (pipe(fds) != 0) {
	Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
    }

    receivePipe = fds[0];

    if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make receive pipe non blocking");
    }
    if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make trigger pipe non blocking");
    }
    if (fcntl(receivePipe, F_SETFD, FD_CLOEXEC) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make receive pipe close-on-exec");
    }
    if (fcntl(fds[1], F_SETFD, FD_CLOEXEC) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make trigger pipe close-on-exec");
    }

    /*
     * Install the write end of the pipe into the global variable.
     */

    pthread_mutex_lock(&notifierMutex);
    triggerPipe = fds[1];

    /*
     * Signal any threads that are waiting.
     */

    pthread_cond_broadcast(&notifierCV);
    pthread_mutex_unlock(&notifierMutex);

    /*
     * Look for file events and report them to interested threads.
     */

    while (1) {
	FD_ZERO(&readableMask);
	FD_ZERO(&writableMask);
	FD_ZERO(&exceptionMask);

	/*
	 * Compute the logical OR of the masks from all the waiting
	 * notifiers.
	 */

	pthread_mutex_lock(&notifierMutex);
	timePtr = NULL;
	for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	    for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
		if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) {
		    FD_SET(i, &readableMask);
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) {
		    FD_SET(i, &writableMask);
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
		    FD_SET(i, &exceptionMask);
		}
	    }
	    if (tsdPtr->numFdBits > numFdBits) {
		numFdBits = tsdPtr->numFdBits;
	    }
	    if (tsdPtr->pollState & POLL_WANT) {
		/*
		 * Here we make sure we go through select() with the same mask
		 * bits that were present when the thread tried to poll.
		 */

		tsdPtr->pollState |= POLL_DONE;
		timePtr = &poll;
	    }
	}
	pthread_mutex_unlock(&notifierMutex);

	/*
	 * Set up the mask to include the receive pipe.
	 */

	if (receivePipe >= numFdBits) {
	    numFdBits = receivePipe + 1;
	}
	FD_SET(receivePipe, &readableMask);

	if (select(numFdBits, &readableMask, &writableMask, &exceptionMask,
		timePtr) == -1) {
	    /*
	     * Try again immediately on an error.
	     */

	    continue;
	}

	/*
	 * Alert any threads that are waiting on a ready file descriptor.
	 */

	pthread_mutex_lock(&notifierMutex);
	for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	    found = 0;

	    for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
		if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
			&& FD_ISSET(i, &readableMask)) {
		    FD_SET(i, &tsdPtr->readyMasks.readable);
		    found = 1;
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.writable)
			&& FD_ISSET(i, &writableMask)) {
		    FD_SET(i, &tsdPtr->readyMasks.writable);
		    found = 1;
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.exception)
			&& FD_ISSET(i, &exceptionMask)) {
		    FD_SET(i, &tsdPtr->readyMasks.exception);
		    found = 1;
		}
	    }

	    if (found || (tsdPtr->pollState & POLL_DONE)) {
		AlertSingleThread(tsdPtr);
	    }
	}
	pthread_mutex_unlock(&notifierMutex);

	/*
	 * Consume the next byte from the notifier pipe if the pipe was
	 * readable. Note that there may be multiple bytes pending, but to
	 * avoid a race condition we only read one at a time.
	 */

	do {
	    i = read(receivePipe, buf, 1);
	    if (i <= 0) {
		break;
	    } else if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
		/*
		 * Someone closed the write end of the pipe or sent us a Quit
		 * message [Bug: 4139] and then closed the write end of the
		 * pipe so we need to shut down the notifier thread.
		 */

		break;
	    }
	} while (1);
	if ((i == 0) || (buf[0] == 'q')) {
	    break;
	}
    }

    /*
     * Clean up the read end of the pipe and signal any threads waiting on
     * termination of the notifier thread.
     */

    close(receivePipe);
    pthread_mutex_lock(&notifierMutex);
    triggerPipe = -1;
    pthread_cond_broadcast(&notifierCV);
    pthread_mutex_unlock(&notifierMutex);

    TclpThreadExit(0);
}
#endif /* TCL_THREADS */

#endif /* (!NOTIFIER_EPOLL && !NOTIFIER_KQUEUE) || !TCL_THREADS */
#endif /* !HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixChan.c.

1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18
19










20
21
22
23
24
25
26





27
28
29
30
31
32
33
34

35
36
37
38
39
40
41















42
43
44
45
46
47

48
49






50





51

52
53


54
55
56
57


58
59
60
61
62
63
64
65
66
67
68
69
70
71

72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87


88
89
90
91







92


93
94
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109

110
111
112
113
114
115
116



















117































118
119
120
121






122
123
124
125
126
127






128
129

130


131

132
133

134
135

136
137
138















139
140

141
142

143
144
145




146
147

148

149
150

151
152
153




154
155
156
157
158
159

160
161
162

163
164
165

166
167
168
169
170

171
172
173
174
175
176

177
178
179
180
181
182
183
184
185

186
187
188

189
190
191
192
193
194
195
196

197
198
199
200
201
202

203
204

























205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227




228
229

230
231
232
233
234
235
236
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









-
-
+
+





-
-
-
+
+
+
+
+
+
+
+
+
+







+
+
+
+
+





-
-
-
+
-


-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






+

-
+
+
+
+
+
+

+
+
+
+
+
-
+
-
-
+
+

-
-
-
+
+
-
-











-
+
-


-
+







-
-

-
-
+
+
-
-
-
-
+
+
+
+
+
+
+
-
+
+

-
-






-
+






-
+


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+

-
+

+
+
-
+

-
+

-
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


+
-
-
-
+
+
+
+


+
-
+

-
+



+
+
+
+





-
+


-
+


-
+




-
+





-
+








-
+


-
+







-
+





-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















-
-
-
+
+
+
+

-
+







/*
 * tclUnixChan.c
 *
 *	Common channel driver for Unix channels based on files, command pipes
 *	and TCP sockets.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * 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.
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"	/* Internal definitions for Tcl. */
#include "tclIO.h"	/* To get Channel type declaration. */

#undef SUPPORTS_TTY
#if defined(HAVE_TERMIOS_H)
#   define SUPPORTS_TTY 1
#define SUPPORTS_TTY

#undef DIRECT_BAUD
#ifdef B4800
#   if (B4800 == 4800)
#	define DIRECT_BAUD
#   endif /* B4800 == 4800 */
#endif /* B4800 */

#ifdef USE_TERMIOS
#   include <termios.h>
#   ifdef HAVE_SYS_IOCTL_H
#	include <sys/ioctl.h>
#   endif /* HAVE_SYS_IOCTL_H */
#   ifdef HAVE_SYS_MODEM_H
#	include <sys/modem.h>
#   endif /* HAVE_SYS_MODEM_H */
#   define IOSTATE			struct termios
#   define GETIOSTATE(fd, statePtr)	tcgetattr((fd), (statePtr))
#   define SETIOSTATE(fd, statePtr)	tcsetattr((fd), TCSADRAIN, (statePtr))
#   define GETCONTROL(fd, intPtr)	ioctl((fd), TIOCMGET, (intPtr))
#   define SETCONTROL(fd, intPtr)	ioctl((fd), TIOCMSET, (intPtr))

#   ifdef FIONREAD
#	define GETREADQUEUE(fd, int)	ioctl((fd), FIONREAD, &(int))
#   elif defined(FIORDCHK)
#	define GETREADQUEUE(fd, int)	int = ioctl((fd), FIORDCHK, NULL)
#   else
#       define GETREADQUEUE(fd, int)    int = 0
#   endif
#   endif /* FIONREAD */

#   ifdef TIOCOUTQ
#	define GETWRITEQUEUE(fd, int)	ioctl((fd), TIOCOUTQ, &(int))
#   else
#	define GETWRITEQUEUE(fd, int)	int = 0
#   endif

#   endif /* TIOCOUTQ */
#   if defined(TIOCSBRK) && defined(TIOCCBRK)

/*
 * Can't use ?: operator below because that messes up types on either Linux or
 * Solaris (the two are mutually exclusive!)
 */

#	define SETBREAK(fd, flag) \
		if (flag) {				\
		    ioctl((fd), TIOCSBRK, NULL);	\
		} else {				\
		    ioctl((fd), TIOCCBRK, NULL);	\
		}
#   endif /* TIOCSBRK&TIOCCBRK */
#   if !defined(CRTSCTS) && defined(CNEW_RTSCTS)
#	define CRTSCTS CNEW_RTSCTS
#   endif /* !CRTSCTS&CNEW_RTSCTS */
#   if !defined(PAREXT) && defined(CMSPAR)
#	define PAREXT CMSPAR
#   endif /* !PAREXT&&CMSPAR */
#else	/* !USE_TERMIOS */

#endif	/* HAVE_TERMIOS_H */
#ifdef USE_TERMIO
#   include <termio.h>
#   define IOSTATE			struct termio
#   define GETIOSTATE(fd, statePtr)	ioctl((fd), TCGETA, (statePtr))
#   define SETIOSTATE(fd, statePtr)	ioctl((fd), TCSETAW, (statePtr))
#else	/* !USE_TERMIO */

#ifdef USE_SGTTY
#   include <sgtty.h>
#   define IOSTATE			struct sgttyb
#   define GETIOSTATE(fd, statePtr)	ioctl((fd), TIOCGETP, (statePtr))
#   define SETIOSTATE(fd, statePtr)	ioctl((fd), TIOCSETP, (statePtr))
/*
#else	/* !USE_SGTTY */
 * The bits supported for describing the closeMode field of TtyState.
 */
#   undef SUPPORTS_TTY
#endif	/* !USE_SGTTY */

enum CloseModeBits {
    CLOSE_DEFAULT,
    CLOSE_DRAIN,
#endif	/* !USE_TERMIO */
#endif	/* !USE_TERMIOS */
    CLOSE_DISCARD
};

/*
 * Helper macros to make parts of this file clearer. The macros do exactly
 * what they say on the tin. :-) They also only ever refer to their arguments
 * once, and so can be used without regard to side effects.
 */

#define SET_BITS(var, bits)	((var) |= (bits))
#define CLEAR_BITS(var, bits)	((var) &= ~(bits))

/*
 * These structures describe per-instance state of file-based and serial-based
 * This structure describes per-instance state of a file based channel.
 * channels.
 */

typedef struct {
typedef struct FileState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    int fd;			/* File handle. */
    int validMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which operations are valid on the file. */
} FileState;

typedef struct {
    FileState fileState;
#ifdef SUPPORTS_TTY
    int closeMode;		/* One of CLOSE_DEFAULT, CLOSE_DRAIN or
				 * CLOSE_DISCARD. */

/*
    int doReset;		/* Whether we should do a terminal reset on
				 * close. */
    struct termios initState;	/* The state of the terminal when it was
				 * opened. */
 * The following structure describes per-instance state of a tty-based
 * channel.
 */

typedef struct TtyState {
    FileState fs;		/* Per-instance state of the file descriptor.
				 * Must be the first field. */
#endif	/* SUPPORTS_TTY */
    IOSTATE savedState;		/* Initial state of device. Used to reset
				 * state when device closed. */
} TtyState;

#ifdef SUPPORTS_TTY

/*
 * The following structure is used to set or get the serial port attributes in
 * a platform-independent manner.
 */

typedef struct {
typedef struct TtyAttrs {
    int baud;
    int parity;
    int data;
    int stop;
} TtyAttrs;

#endif	/* SUPPORTS_TTY */
#endif	/* !SUPPORTS_TTY */

#define UNSUPPORTED_OPTION(detail) \
    if (interp) {							\
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(				\
		"%s not supported for this platform", (detail)));	\
	Tcl_SetErrorCode(interp, "TCL", "UNSUPPORTED", NULL);		\
    }
    if (interp) {						\
	Tcl_AppendResult(interp, (detail),			\
		" not supported for this platform", NULL);	\
    }

/*
 * This structure describes per-instance state of a tcp based channel.
 */

typedef struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    int fd;			/* The socket itself. */
    int flags;			/* ORed combination of the bitfields defined
				 * below. */
    int interest;		/* Events types of interest. */
    Tcl_TcpAcceptProc *acceptProc;
				/* Proc to call on accept. */
    ClientData acceptProcData;	/* The data for the accept proc. */
} TcpState;

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_ASYNC_SOCKET	(1<<0)	/* Asynchronous socket. */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */

/*
 * The following defines the maximum length of the listen queue. This is the
 * number of outstanding yet-to-be-serviced requests for a connection on a
 * server socket, more than this number of outstanding requests and the
 * connection request will fail.
 */

#ifndef SOMAXCONN
#   define SOMAXCONN	100
#endif /* SOMAXCONN */

#if (SOMAXCONN < 100)
#   undef  SOMAXCONN
#   define SOMAXCONN	100
#endif /* SOMAXCONN < 100 */

/*
 * The following defines how much buffer space the kernel should maintain for
 * a socket.
 */

#define SOCKET_BUFSIZE	4096

/*
 * Static routines for this file:
 */

static TcpState *	CreateSocket(Tcl_Interp *interp, int port,
			    const char *host, int server, const char *myaddr,
			    int myport, int async);
static int		CreateSocketAddress(struct sockaddr_in *sockaddrPtr,
			    const char *host, int port, int willBind,
			    const char **errorMsgPtr);
static int		FileBlockModeProc(void *instanceData, int mode);
static int		FileCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		FileGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		FileInputProc(void *instanceData, char *buf,
static int		FileBlockModeProc(ClientData instanceData, int mode);
static int		FileCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static int		FileGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		FileInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(void *instanceData,
static int		FileOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
static int		FileSeekProc(ClientData instanceData, long offset,
			    int mode, int *errorCode);
static int		FileTruncateProc(void *instanceData,
static int		FileTruncateProc(ClientData instanceData,
			    Tcl_WideInt length);
static Tcl_WideInt	FileWideSeekProc(void *instanceData,
static Tcl_WideInt	FileWideSeekProc(ClientData instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode);
static void		FileWatchProc(void *instanceData, int mask);
static void		FileWatchProc(ClientData instanceData, int mask);
#ifdef SUPPORTS_TTY
static int		TtyCloseProc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static void		TcpAccept(ClientData data, int mask);
static int		TcpBlockModeProc(ClientData data, int mode);
static int		TcpCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static int		TcpGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		TcpGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		TcpInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		TcpOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		TcpWatchProc(ClientData instanceData, int mask);
#ifdef SUPPORTS_TTY
static void		TtyGetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtyGetOptionProc(void *instanceData,
static int		TtyGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
#ifndef DIRECT_BAUD
static int		TtyGetBaud(speed_t speed);
static speed_t		TtyGetSpeed(int baud);
static void		TtyInit(int fd);
static int		TtyGetBaud(unsigned long speed);
static unsigned long	TtyGetSpeed(int baud);
#endif /* DIRECT_BAUD */
static FileState *	TtyInit(int fd, int initialize);
static void		TtyModemStatusStr(int status, Tcl_DString *dsPtr);
static int		TtyParseMode(Tcl_Interp *interp, const char *mode,
			    int *speedPtr, int *parityPtr, int *dataPtr,
			    TtyAttrs *ttyPtr);
			    int *stopPtr);
static void		TtySetAttributes(int fd, TtyAttrs *ttyPtr);
static int		TtySetOptionProc(void *instanceData,
static int		TtySetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
#endif	/* SUPPORTS_TTY */
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static Tcl_Channel	MakeTcpClientChannelMode(ClientData tcpSocket,
			    int mode);
static void		WrapNotify(ClientData clientData, int mask);

/*
 * This structure describes the channel type structure for file based IO:
 */

static const Tcl_ChannelType fileChannelType = {
static Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
	NULL,
    FileSeekProc,		/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    FileCloseProc,		/* close2proc. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* wide seek proc. */
    NULL,
    FileTruncateProc		/* truncate proc. */
    FileTruncateProc,		/* truncate proc. */
};

#ifdef SUPPORTS_TTY
/*
 * This structure describes the channel type structure for serial IO.
 * Note that this type is a subclass of the "file" type.
 */

static const Tcl_ChannelType ttyChannelType = {
static Tcl_ChannelType ttyChannelType = {
    "tty",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    TtySetOptionProc,		/* Set option proc. */
    TtyGetOptionProc,		/* Get option proc. */
    FileWatchProc,		/* Initialize notifier. */
    FileGetHandleProc,		/* Get OS handles out of channel. */
    TtyCloseProc,			/* close2proc. */
    NULL,			/* close2proc. */
    FileBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc. */
    NULL,			/* thread action proc. */
    NULL			/* truncate proc. */
    NULL,			/* truncate proc. */
};
#endif	/* SUPPORTS_TTY */

/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 */

static Tcl_ChannelType tcpChannelType = {
    "tcp",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    TcpCloseProc,		/* Close proc. */
    TcpInputProc,		/* Input proc. */
    TcpOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    TcpGetOptionProc,		/* Get option proc. */
    TcpWatchProc,		/* Initialize notifier. */
    TcpGetHandleProc,		/* Get OS handles out of channel. */
    NULL,			/* close2proc. */
    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc. */
    NULL,			/* thread action proc. */
    NULL,			/* truncate proc. */
};

/*
 *----------------------------------------------------------------------
 *
 * FileBlockModeProc --
 *
 *	Helper function to set blocking and nonblocking modes on a file based
 *	channel. Invoked by generic IO level code.
 *
 * Results:
 *	0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
FileBlockModeProc(
    void *instanceData,	/* File state. */
    int mode)			/* The mode to set. Can be TCL_MODE_BLOCKING
				 * or TCL_MODE_NONBLOCKING. */
    ClientData instanceData,	/* File state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;

    if (TclUnixSetBlockingMode(fsPtr->fd, mode) < 0) {
	return errno;
    }

    return 0;
}
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
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







-
+





-
+












-
-
+
+







 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileInputProc(
    void *instanceData,	/* File state. */
    ClientData instanceData,	/* File state. */
    char *buf,			/* Where to store data read. */
    int toRead,			/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;
    int bytesRead;		/* How many bytes were actually read from the
				 * input device? */

    *errorCodePtr = 0;

    /*
     * Assume there is always enough input available. This will block
     * appropriately, and read will unblock as soon as a short read is
     * possible, if the channel is in blocking mode. If the channel is
     * nonblocking, the read will never block.
     */

    bytesRead = read(fsPtr->fd, buf, toRead);
    if (bytesRead >= 0) {
    bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
    if (bytesRead > -1) {
	return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
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
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
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







-
+




-
+













-
-
+
+









-
+

-
-
+
+
-












-
-
+
+
-

-
+

-
-
-
-













-
+


-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+

-
-
+
+
-
-
-
+

-
+


-
-
+
+
-
-
+
+
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
+
+


-
+


+
+
+
-
-
+
+
+
+
-
+
+







 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileOutputProc(
    void *instanceData,	/* File state. */
    ClientData instanceData,	/* File state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;
    int written;

    *errorCodePtr = 0;

    if (toWrite == 0) {
	/*
	 * SF Tcl Bug 465765. Do not try to write nothing into a file. STREAM
	 * based implementations will considers this as EOF (if there is a
	 * pipe behind the file).
	 */

	return 0;
    }
    written = write(fsPtr->fd, buf, toWrite);
    if (written >= 0) {
    written = write(fsPtr->fd, buf, (size_t) toWrite);
    if (written > -1) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * FileCloseProc, TtyCloseProc --
 * FileCloseProc --
 *
 *	These functions are called from the generic IO level to perform
 *	channel-type-specific cleanup when a file- or tty-based channel is
 *	This function is called from the generic IO level to perform
 *	channel-type-specific cleanup when a file based channel is closed.
 *	closed.
 *
 * Results:
 *	0 if successful, errno if failed.
 *
 * Side effects:
 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
FileCloseProc(
    void *instanceData,	/* File state. */
    TCL_UNUSED(Tcl_Interp *),
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp)		/* For error reporting - unused. */
    int flags)
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;
    int errorCode = 0;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    Tcl_DeleteFileHandler(fsPtr->fd);

    /*
     * Do not close standard channels while in thread-exit.
     */

    if (!TclInThreadExit()
	    || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
	if (close(fsPtr->fd) < 0) {
	    errorCode = errno;
	}
    }
    Tcl_Free(fsPtr);
    ckfree((char *) fsPtr);
    return errorCode;
}

#ifdef SUPPORTS_TTY

/*
 *----------------------------------------------------------------------
 *
 * FileSeekProc --
 *
 *	This function is called by the generic IO level to move the access
 *	point in a file based channel.
 *
 * Results:
 *	-1 if failed, the new position if successful. An output argument
 *	contains the POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Moves the location at which the channel will be accessed in future
 *	operations.
 *
 *----------------------------------------------------------------------
 */

static int
TtyCloseProc(
    void *instanceData,
    Tcl_Interp *interp,
	int flags)
FileSeekProc(
    ClientData instanceData,	/* File state. */
    long offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? Can be
				 * one of SEEK_START, SEEK_SET or SEEK_END. */
    int *errorCodePtr)		/* To store error code. */
{
    TtyState *ttyPtr = (TtyState*)instanceData;

    FileState *fsPtr = (FileState *) instanceData;
    Tcl_WideInt oldLoc, newLoc;
    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    /*
     * If we've been asked by the user to drain or flush, do so now.
     * Save our current place in case we need to roll-back the seek.
     */

    switch (ttyPtr->closeMode) {
    case CLOSE_DRAIN:
    oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
    if (oldLoc == Tcl_LongAsWide(-1)) {
	tcdrain(ttyPtr->fileState.fd);
	break;
	/*
	 * Bad things are happening. Error out...
    case CLOSE_DISCARD:
	tcflush(ttyPtr->fileState.fd, TCIOFLUSH);
	 */
	break;
    default:
	/* Do nothing */
	break;
    }


	*errorCodePtr = errno;
    /*
     * If we've had our state changed from the default, reset now.
     */

	return -1;
    }
    if (ttyPtr->doReset) {
	tcsetattr(ttyPtr->fileState.fd, TCSANOW, &ttyPtr->initState);
    }

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    /*
     * Delegate to close for files.
     * Check for expressability in our return type, and roll-back otherwise.
     */

    if (newLoc > Tcl_LongAsWide(INT_MAX)) {
	*errorCodePtr = EOVERFLOW;
	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
    return FileCloseProc(instanceData, interp, flags);
}
	return -1;
    } else {
	*errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
    }
#endif /* SUPPORTS_TTY */
    return (int) Tcl_WideAsLong(newLoc);
}

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
 *	This function is called by the generic IO level to move the access
438
439
440
441
442
443
444
445

446
447
448
449
450
451

452
453
454
455
456
457
458
573
574
575
576
577
578
579

580
581
582
583
584
585

586
587
588
589
590
591
592
593







-
+





-
+







 *	operations.
 *
 *----------------------------------------------------------------------
 */

static Tcl_WideInt
FileWideSeekProc(
    void *instanceData,	/* File state. */
    ClientData instanceData,	/* File state. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? Can be
				 * one of SEEK_START, SEEK_CUR or SEEK_END. */
    int *errorCodePtr)		/* To store error code. */
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;
    Tcl_WideInt newLoc;

    newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);

    *errorCodePtr = (newLoc == -1) ? errno : 0;
    return newLoc;
}
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
607
608
609
610
611
612
613

614
615
616
617
618

619
620
621
622
623
624
625
626
627
628
629

630
631
632
633
634
635
636
637
638







-
+




-
+










-
+
+







 *	be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
FileWatchProc(
    void *instanceData,	/* The file state. */
    ClientData instanceData,	/* The file state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;

    /*
     * Make sure we only register for events that are valid on this file. Note
     * that we are passing Tcl_NotifyChannel directly to Tcl_CreateFileHandler
     * with the channel pointer as the client data.
     */

    mask &= fsPtr->validMask;
    if (mask) {
	Tcl_CreateFileHandler(fsPtr->fd, mask,
		(Tcl_FileProc *) Tcl_NotifyChannel, fsPtr->channel);
		(Tcl_FileProc *) Tcl_NotifyChannel,
		(ClientData) fsPtr->channel);
    } else {
	Tcl_DeleteFileHandler(fsPtr->fd);
    }
}

/*
 *----------------------------------------------------------------------
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
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







-
+

-
+

-
+


-
+






+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
FileGetHandleProc(
    void *instanceData,	/* The file state. */
    ClientData instanceData,	/* The file state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Where to store the handle. */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;

    if (direction & fsPtr->validMask) {
	*handlePtr = INT2PTR(fsPtr->fd);
	*handlePtr = (ClientData) INT2PTR(fsPtr->fd);
	return TCL_OK;
    }
    return TCL_ERROR;
}

#ifdef SUPPORTS_TTY
#ifdef USE_TERMIOS
/*
 *----------------------------------------------------------------------
 *
 * TtyModemStatusStr --
 *
 *	Converts a RS232 modem status list of readable flags
 *
560
561
562
563
564
565
566

567
568
569
570
571
572
573
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711







+







    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_RNG) ? "1" : "0");
#endif /* TIOCM_RNG */
#ifdef TIOCM_CD
    Tcl_DStringAppendElement(dsPtr, "DCD");
    Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CD) ? "1" : "0");
#endif /* TIOCM_CD */
}
#endif /* USE_TERMIOS */

/*
 *----------------------------------------------------------------------
 *
 * TtySetOptionProc --
 *
 *	Sets an option on a channel.
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
618


619
620
621
622
623
624
625
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
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
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
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
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
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
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
1065

1066
1067
1068
1069
1070
1071
1072
1073
1074







-
+




-
-
+
+

+
-
+

-
+
+







-

-
+
+







-
+


+
+










-
+




-
+
-
-
+
-
-
+

-
+






-
+




-
-
-
+
+
-
-
+



-
+








+


-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
-
-
+
-
-
-
-
-

-
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
+





-
+








-
-
+






-
-
-
+
+
-
-

-
+



-
+


-
+


-
+
+





+
+
+
+
+
-
+
+





+
+
+
+
+
-
+
-
-
-
-
+
+
+
-
-
-

-
+

-
+


-
-
-
+
+
+
-
-

-
+




-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+
+
+
+
+














-
-
+
+
+
+
+
+






-
+




-
-
+
+


-






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+




+









+

-

+
-
+


-
-
-
+
+
+

-
-
+
+
















+
-
-
-
-
+
+
+
+
+
+
+







-





-




-
+


-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
+
+
+
+
+


+
+
+
+
-
+
+







 *	calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
TtySetOptionProc(
    void *instanceData,	/* File state. */
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    TtyState *fsPtr = (TtyState *)instanceData;
    size_t len, vlen;
    FileState *fsPtr = (FileState *) instanceData;
    unsigned int len, vlen;
    TtyAttrs tty;
#ifdef USE_TERMIOS
    int argc;
    int flag, control, argc;
    const char **argv;
    struct termios iostate;
    IOSTATE iostate;
#endif /* USE_TERMIOS */

    len = strlen(optionName);
    vlen = strlen(value);

    /*
     * Option -mode baud,parity,databits,stopbits
     */

    if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
	if (TtyParseMode(interp, value, &tty) != TCL_OK) {
	if (TtyParseMode(interp, value, &tty.baud, &tty.parity, &tty.data,
		&tty.stop) != TCL_OK) {
	    return TCL_ERROR;
	}

	/*
	 * system calls results should be checked there. - dl
	 */

	TtySetAttributes(fsPtr->fileState.fd, &tty);
	TtySetAttributes(fsPtr->fd, &tty);
	return TCL_OK;
    }

#ifdef USE_TERMIOS

    /*
     * Option -handshake none|xonxoff|rtscts|dtrdsr
     */

    if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
	/*
	 * Reset all handshake options. DTR and RTS are ON by default.
	 */

	tcgetattr(fsPtr->fileState.fd, &iostate);
	GETIOSTATE(fsPtr->fd, &iostate);
	CLEAR_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
#ifdef CRTSCTS
	CLEAR_BITS(iostate.c_cflag, CRTSCTS);
#endif /* CRTSCTS */
	if (Tcl_UtfNcasecmp(value, "NONE", vlen) == 0) {
	if (strncasecmp(value, "NONE", vlen) == 0) {
	    /*
	     * Leave all handshake options disabled.
	    /* leave all handshake options disabled */
	     */
	} else if (Tcl_UtfNcasecmp(value, "XONXOFF", vlen) == 0) {
	} else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
	    SET_BITS(iostate.c_iflag, IXON | IXOFF | IXANY);
	} else if (Tcl_UtfNcasecmp(value, "RTSCTS", vlen) == 0) {
	} else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
#ifdef CRTSCTS
	    SET_BITS(iostate.c_cflag, CRTSCTS);
#else /* !CRTSTS */
	    UNSUPPORTED_OPTION("-handshake RTSCTS");
	    return TCL_ERROR;
#endif /* CRTSCTS */
	} else if (Tcl_UtfNcasecmp(value, "DTRDSR", vlen) == 0) {
	} else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
	    UNSUPPORTED_OPTION("-handshake DTRDSR");
	    return TCL_ERROR;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -handshake: must be one of"
			" xonxoff, rtscts, dtrdsr or none", -1));
		Tcl_AppendResult(interp, "bad value for -handshake: "
			"must be one of xonxoff, rtscts, dtrdsr or none",
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
			NULL);
	    }
	    return TCL_ERROR;
	}
	tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate);
	SETIOSTATE(fsPtr->fd, &iostate);
	return TCL_OK;
    }

    /*
     * Option -xchar {\x11 \x13}
     */

    if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
	GETIOSTATE(fsPtr->fd, &iostate);
	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	} else if (argc != 2) {
	badXchar:
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -xchar: should be a list of"
			" two elements with each a single 8-bit character", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
	    }
	    Tcl_Free(argv);
	}
	if (argc == 2) {
	    return TCL_ERROR;
	}

	    Tcl_DString ds;
	tcgetattr(fsPtr->fileState.fd, &iostate);

	    Tcl_DStringInit(&ds);
	iostate.c_cc[VSTART] = argv[0][0];
	iostate.c_cc[VSTOP] = argv[1][0];
	if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
	    Tcl_UniChar character = 0;
	    int charLen;

	    charLen = Tcl_UtfToUniChar(argv[0], &character);
	    Tcl_UtfToExternalDString(NULL, argv[0], -1, &ds);
	    if ((character > 0xFF) || argv[0][charLen]) {
		goto badXchar;
	    }
	    iostate.c_cc[VSTART] = character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    iostate.c_cc[VSTART] = *(const cc_t *) Tcl_DStringValue(&ds);
	    Tcl_DStringSetLength(&ds, 0);
	    if ((character > 0xFF) || argv[1][charLen]) {
		goto badXchar;
	    }
	    iostate.c_cc[VSTOP] = character;
	}
	Tcl_Free(argv);

	tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate);

	    Tcl_UtfToExternalDString(NULL, argv[1], -1, &ds);
	    iostate.c_cc[VSTOP] = *(const cc_t *) Tcl_DStringValue(&ds);
	    Tcl_DStringFree(&ds);
	} else {
	    if (interp) {
		Tcl_AppendResult(interp, "bad value for -xchar: "
			"should be a list of two elements", NULL);
	    }
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}
	SETIOSTATE(fsPtr->fd, &iostate);
	ckfree((char *) argv);
	return TCL_OK;
    }

    /*
     * Option -timeout msec
     */

    if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
	int msec;

	tcgetattr(fsPtr->fileState.fd, &iostate);
	GETIOSTATE(fsPtr->fd, &iostate);
	if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
	    return TCL_ERROR;
	}
	iostate.c_cc[VMIN] = 0;
	iostate.c_cc[VTIME] = (msec==0) ? 0 : (msec<100) ? 1 : (msec+50)/100;
	tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate);
	SETIOSTATE(fsPtr->fd, &iostate);
	return TCL_OK;
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
#if defined(TIOCMGET) && defined(TIOCMSET)
	int i, control, flag;
	int i;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -ttycontrol: should be a list of"
			" signal,value pairs", -1));
		Tcl_AppendResult(interp, "bad value for -ttycontrol: "
			"should be a list of signal,value pairs", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    Tcl_Free(argv);
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	ioctl(fsPtr->fileState.fd, TIOCMGET, &control);
	GETCONTROL(fsPtr->fd, &control);
	for (i = 0; i < argc-1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		Tcl_Free(argv);
		ckfree((char *) argv);
		return TCL_ERROR;
	    }
	    if (Tcl_UtfNcasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
	    if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
#ifdef TIOCM_DTR
		if (flag) {
		    SET_BITS(control, TIOCM_DTR);
		} else {
		    CLEAR_BITS(control, TIOCM_DTR);
		}
#else /* !TIOCM_DTR */
		UNSUPPORTED_OPTION("-ttycontrol DTR");
		ckfree((char *) argv);
		return TCL_ERROR;
#endif /* TIOCM_DTR */
	    } else if (Tcl_UtfNcasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
	    } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
#ifdef TIOCM_RTS
		if (flag) {
		    SET_BITS(control, TIOCM_RTS);
		} else {
		    CLEAR_BITS(control, TIOCM_RTS);
		}
#else /* !TIOCM_RTS*/
		UNSUPPORTED_OPTION("-ttycontrol RTS");
		ckfree((char *) argv);
		return TCL_ERROR;
#endif /* TIOCM_RTS*/
	    } else if (Tcl_UtfNcasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
	    } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
#if defined(TIOCSBRK) && defined(TIOCCBRK)
		if (flag) {
		    ioctl(fsPtr->fileState.fd, TIOCSBRK, NULL);
		} else {
#ifdef SETBREAK
		SETBREAK(fsPtr->fd, flag);
#else /* !SETBREAK */
		    ioctl(fsPtr->fileState.fd, TIOCCBRK, NULL);
		}
#else /* TIOCSBRK & TIOCCBRK */
		UNSUPPORTED_OPTION("-ttycontrol BREAK");
		Tcl_Free(argv);
		ckfree((char *) argv);
		return TCL_ERROR;
#endif /* TIOCSBRK & TIOCCBRK */
#endif /* SETBREAK */
	    } else {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal \"%s\" for -ttycontrol: must be"
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_AppendResult(interp, "bad signal \"", argv[i],
			    "\" for -ttycontrol: must be "
			    "DTR, RTS or BREAK", NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
		}
		Tcl_Free(argv);
		ckfree((char *) argv);
		return TCL_ERROR;
	    }
	} /* -ttycontrol options loop */

	ioctl(fsPtr->fileState.fd, TIOCMSET, &control);
	Tcl_Free(argv);
	return TCL_OK;
#else /* TIOCMGET&TIOCMSET */
	UNSUPPORTED_OPTION("-ttycontrol");
#endif /* TIOCMGET&TIOCMSET */
    }

	SETCONTROL(fsPtr->fd, &control);
    /*
     * Option -closemode drain|discard
     */

	ckfree((char *) argv);
    if ((len > 2) && (strncmp(optionName, "-closemode", len) == 0)) {
	if (Tcl_UtfNcasecmp(value, "DEFAULT", vlen) == 0) {
	    fsPtr->closeMode = CLOSE_DEFAULT;
	} else if (Tcl_UtfNcasecmp(value, "DRAIN", vlen) == 0) {
	    fsPtr->closeMode = CLOSE_DRAIN;
	} else if (Tcl_UtfNcasecmp(value, "DISCARD", vlen) == 0) {
	    fsPtr->closeMode = CLOSE_DISCARD;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad mode \"%s\" for -closemode: must be"
			" default, discard, or drain", value));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -inputmode normal|password|raw
     */

    if ((len > 2) && (strncmp(optionName, "-inputmode", len) == 0)) {
	if (tcgetattr(fsPtr->fileState.fd, &iostate) < 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read serial terminal control state: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	if (Tcl_UtfNcasecmp(value, "NORMAL", vlen) == 0) {
	    SET_BITS(iostate.c_iflag, BRKINT | IGNPAR | ISTRIP | ICRNL | IXON);
	    SET_BITS(iostate.c_oflag, OPOST);
	    SET_BITS(iostate.c_lflag, ECHO | ECHONL | ICANON | ISIG);
	} else if (Tcl_UtfNcasecmp(value, "PASSWORD", vlen) == 0) {
	    SET_BITS(iostate.c_iflag, BRKINT | IGNPAR | ISTRIP | ICRNL | IXON);
	    SET_BITS(iostate.c_oflag, OPOST);
	    CLEAR_BITS(iostate.c_lflag, ECHO);
	    /*
	     * Note: password input turns out to be best if you echo the
	     * newline that the user types. Theoretically we could get users
	     * to do the processing of this in their scripts, but it always
	     * feels highly unnatural to do so in practice.
	     */
	    SET_BITS(iostate.c_lflag, ECHONL | ICANON | ISIG);
	} else if (Tcl_UtfNcasecmp(value, "RAW", vlen) == 0) {
#ifdef HAVE_CFMAKERAW
	    cfmakeraw(&iostate);
#else /* !HAVE_CFMAKERAW */
	    CLEAR_BITS(iostate.c_iflag, IGNBRK | BRKINT | PARMRK | ISTRIP
		    | INLCR | IGNCR | ICRNL | IXON);
	    CLEAR_BITS(iostate.c_oflag, OPOST);
	    CLEAR_BITS(iostate.c_lflag, ECHO | ECHONL | ICANON | ISIG | IEXTEN);
	    CLEAR_BITS(iostate.c_cflag, CSIZE | PARENB);
	    SET_BITS(iostate.c_cflag, CS8);
#endif /* HAVE_CFMAKERAW */
	} else if (Tcl_UtfNcasecmp(value, "RESET", vlen) == 0) {
	    /*
	     * Reset to the initial state, whatever that is.
	     */

	    memcpy(&iostate, &fsPtr->initState, sizeof(struct termios));
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad mode \"%s\" for -inputmode: must be"
			" normal, password, raw, or reset", value));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    return TCL_ERROR;
	}
	if (tcsetattr(fsPtr->fileState.fd, TCSADRAIN, &iostate) < 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't update serial terminal control state: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}

	/*
	 * If we've changed the state from default, schedule a reset later.
	 * Note that this specifically does not detect changes made by calling
	 * an external stty program; that is deliberate, as it maintains
	 * compatibility with existing code!
	 *
	 * This mechanism in Tcl is not intended to be a full replacement for
	 * what stty does; it just handles a few common cases and tries not to
	 * leave things in a broken state.
	 */

	fsPtr->doReset = (memcmp(&iostate, &fsPtr->initState,
		sizeof(struct termios)) != 0);
	return TCL_OK;
    }

    return Tcl_BadChannelOption(interp, optionName,
	    "closemode inputmode mode handshake timeout ttycontrol xchar");
	    "mode handshake timeout ttycontrol xchar");

#else /* !USE_TERMIOS */
    return Tcl_BadChannelOption(interp, optionName, "mode");
#endif /* USE_TERMIOS */
}

/*
 *----------------------------------------------------------------------
 *
 * TtyGetOptionProc --
 *
 *	Gets a mode associated with an IO channel. If the optionName arg is
 *	non-NULL, retrieves the value of that option. If the optionName arg is
 *	NULL, retrieves a list of alternating option names and values for the
 *	given channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the supplied DString to the string
 *	value of the option(s) returned.  Sets error message if needed
 *	(by calling Tcl_BadChannelOption).
 *	value of the option(s) returned.
 *
 * Side effects:
 *	The string returned by this function is in static storage and may be
 *	reused at any time subsequent to the call. Sets error message if
 *	needed (by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
TtyGetOptionProc(
    void *instanceData,	/* File state. */
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    TtyState *fsPtr = (TtyState *)instanceData;
    size_t len;
    FileState *fsPtr = (FileState *) instanceData;
    unsigned int len;
    char buf[3*TCL_INTEGER_SPACE + 16];
    int valid = 0;		/* Flag if valid option parsed. */
    struct termios iostate;

    if (optionName == NULL) {
	len = 0;
    } else {
	len = strlen(optionName);
    }

    /*
     * Get option -closemode
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-closemode");
    }
    if (len==0 || (len>1 && strncmp(optionName, "-closemode", len)==0)) {
	switch (fsPtr->closeMode) {
	case CLOSE_DRAIN:
	    Tcl_DStringAppendElement(dsPtr, "drain");
	    break;
	case CLOSE_DISCARD:
	    Tcl_DStringAppendElement(dsPtr, "discard");
	    break;
	default:
	    Tcl_DStringAppendElement(dsPtr, "default");
	    break;
	}
    }

    /*
     * Get option -inputmode
     *
     * This is a great simplification of the underlying reality, but actually
     * represents what almost all scripts really want to know.
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-inputmode");
    }
    if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) {
	valid = 1;
	if (tcgetattr(fsPtr->fileState.fd, &iostate) < 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read serial terminal control state: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	if (iostate.c_lflag & ICANON) {
	    if (iostate.c_lflag & ECHO) {
		Tcl_DStringAppendElement(dsPtr, "normal");
	    } else {
		Tcl_DStringAppendElement(dsPtr, "password");
	    }
	} else {
	    Tcl_DStringAppendElement(dsPtr, "raw");
	}
    }

    /*
     * Get option -mode
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-mode");
    }
    if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) {
	TtyAttrs tty;

	valid = 1;
	TtyGetAttributes(fsPtr->fileState.fd, &tty);
	TtyGetAttributes(fsPtr->fd, &tty);
	sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

#ifdef USE_TERMIOS
    /*
     * Get option -xchar
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-xchar");
	Tcl_DStringStartSublist(dsPtr);
    }
    if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) {
	IOSTATE iostate;
	Tcl_DString ds;

	valid = 1;

	tcgetattr(fsPtr->fileState.fd, &iostate);
	GETIOSTATE(fsPtr->fd, &iostate);
	Tcl_DStringInit(&ds);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTART], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	TclDStringClear(&ds);
	Tcl_ExternalToUtfDString(NULL,  (const char *) &iostate.c_cc[VSTART], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, (const char *) Tcl_DStringValue(&ds));
	Tcl_DStringSetLength(&ds, 0);

	Tcl_ExternalToUtfDString(NULL, (char *) &iostate.c_cc[VSTOP], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
	Tcl_ExternalToUtfDString(NULL,  (const char *) &iostate.c_cc[VSTOP], 1, &ds);
	Tcl_DStringAppendElement(dsPtr, (const char *) Tcl_DStringValue(&ds));
	Tcl_DStringFree(&ds);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
    }

    /*
     * Get option -queue
     * Option is readonly and returned by [fconfigure chan -queue] but not
     * returned by unnamed [fconfigure chan].
     */

    if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
	int inQueue=0, outQueue=0, inBuffered, outBuffered;

	valid = 1;
#ifdef GETREADQUEUE
	GETREADQUEUE(fsPtr->fileState.fd, inQueue);
	GETWRITEQUEUE(fsPtr->fileState.fd, outQueue);
	inBuffered = Tcl_InputBuffered(fsPtr->fileState.channel);
	outBuffered = Tcl_OutputBuffered(fsPtr->fileState.channel);
	GETREADQUEUE(fsPtr->fd, inQueue);
#endif /* GETREADQUEUE */
#ifdef GETWRITEQUEUE
	GETWRITEQUEUE(fsPtr->fd, outQueue);
#endif /* GETWRITEQUEUE */
	inBuffered = Tcl_InputBuffered(fsPtr->channel);
	outBuffered = Tcl_OutputBuffered(fsPtr->channel);

	sprintf(buf, "%d", inBuffered+inQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
	sprintf(buf, "%d", outBuffered+outQueue);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

#if defined(TIOCMGET)
    /*
     * Get option -ttystatus
     * Option is readonly and returned by [fconfigure chan -ttystatus] but not
     * returned by unnamed [fconfigure chan].
     */

    if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) {
	int status;

	valid = 1;
	ioctl(fsPtr->fileState.fd, TIOCMGET, &status);
	GETCONTROL(fsPtr->fd, &status);
	TtyModemStatusStr(status, dsPtr);
    }
#endif /* TIOCMGET */
#endif /* USE_TERMIOS */

#if defined(TIOCGWINSZ)
    /*
     * Get option -winsize
     * Option is readonly and returned by [fconfigure chan -winsize] but not
     * returned by [fconfigure chan] without explicit option name.
     */

    if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) {
	struct winsize ws;

	valid = 1;
	if (ioctl(fsPtr->fileState.fd, TIOCGWINSZ, &ws) < 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read terminal size: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	sprintf(buf, "%d", ws.ws_col);
	Tcl_DStringAppendElement(dsPtr, buf);
	sprintf(buf, "%d", ws.ws_row);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
#endif /* TIOCGWINSZ */

    if (valid) {
	return TCL_OK;
    }
    return Tcl_BadChannelOption(interp, optionName,
		"closemode inputmode mode queue ttystatus winsize xchar");
    return Tcl_BadChannelOption(interp, optionName, "mode"
#ifdef USE_TERMIOS
	    " queue ttystatus xchar"
#endif /* USE_TERMIOS */
	    );
}

#ifdef DIRECT_BAUD
#   define TtyGetSpeed(baud)	((unsigned) (baud))
#   define TtyGetBaud(speed)	((int) (speed))
#else /* !DIRECT_BAUD */
static const struct {int baud; speed_t speed;} speeds[] = {

static CONST struct {int baud; unsigned long speed;} speeds[] = {
#ifdef B0
    {0, B0},
#endif
#ifdef B50
    {50, B50},
#endif
#ifdef B75
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
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







-
+





-
-
+
+
+



+
+
+




-
+







    {3500000,B3500000},
#endif
#ifdef B4000000
    {4000000,B4000000},
#endif
    {-1, 0}
};


/*
 *---------------------------------------------------------------------------
 *
 * TtyGetSpeed --
 *
 *	Given an integer baud rate, get the speed_t value that should be
 *	used to select that baud rate.
 *	Given a baud rate, get the mask value that should be stored in the
 *	termios, termio, or sgttyb structure in order to select that baud
 *	rate.
 *
 * Results:
 *	As above.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static speed_t
static unsigned long
TtyGetSpeed(
    int baud)			/* The baud rate to look up. */
{
    int bestIdx, bestDiff, i, diff;

    bestIdx = 0;
    bestDiff = 1000000;
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
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







+
-
+



+
+
+






-
+










+







}

/*
 *---------------------------------------------------------------------------
 *
 * TtyGetBaud --
 *
 *	Given a speed mask value from a termios, termio, or sgttyb structure,
 *	Return the integer baud rate corresponding to a given speed_t value.
 *	get the baus rate that corresponds to that mask value.
 *
 * Results:
 *	As above. If the mask value was not recognized, 0 is returned.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
TtyGetBaud(
    speed_t speed)		/* Speed mask value to look up. */
    unsigned long speed)	/* Speed mask value to look up. */
{
    int i;

    for (i = 0; speeds[i].baud >= 0; i++) {
	if (speeds[i].speed == speed) {
	    return speeds[i].baud;
	}
    }
    return 0;
}
#endif /* !DIRECT_BAUD */

/*
 *---------------------------------------------------------------------------
 *
 * TtyGetAttributes --
 *
 *	Get the current attributes of the specified serial device.
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
1356
1357
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
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358







-
+


-
+

+















-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







static void
TtyGetAttributes(
    int fd,			/* Open file descriptor for serial port to be
				 * queried. */
    TtyAttrs *ttyPtr)		/* Buffer filled with serial port
				 * attributes. */
{
    struct termios iostate;
    IOSTATE iostate;
    int baud, parity, data, stop;

    tcgetattr(fd, &iostate);
    GETIOSTATE(fd, &iostate);

#ifdef USE_TERMIOS
    baud = TtyGetBaud(cfgetospeed(&iostate));

    parity = 'n';
#ifdef PAREXT
    switch ((int) (iostate.c_cflag & (PARENB | PARODD | PAREXT))) {
    case PARENB			  : parity = 'e'; break;
    case PARENB | PARODD	  : parity = 'o'; break;
    case PARENB |	   PAREXT : parity = 's'; break;
    case PARENB | PARODD | PAREXT : parity = 'm'; break;
    }
#else /* !PAREXT */
    switch ((int) (iostate.c_cflag & (PARENB | PARODD))) {
    case PARENB		 : parity = 'e'; break;
    case PARENB | PARODD : parity = 'o'; break;
    }
#endif /* PAREXT */
#endif /* !PAREXT */

    data = iostate.c_cflag & CSIZE;
    data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;

    stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
#endif /* USE_TERMIOS */

#ifdef USE_TERMIO
    baud = TtyGetBaud(iostate.c_cflag & CBAUD);

    parity = 'n';
    switch (iostate.c_cflag & (PARENB | PARODD | PAREXT)) {
    case PARENB			  : parity = 'e'; break;
    case PARENB | PARODD	  : parity = 'o'; break;
    case PARENB |	   PAREXT : parity = 's'; break;
    case PARENB | PARODD | PAREXT : parity = 'm'; break;
    }

    data = iostate.c_cflag & CSIZE;
    data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;

    stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
#endif /* USE_TERMIO */

#ifdef USE_SGTTY
    baud = TtyGetBaud(iostate.sg_ospeed);

    parity = 'n';
    if (iostate.sg_flags & EVENP) {
	parity = 'e';
    } else if (iostate.sg_flags & ODDP) {
	parity = 'o';
    }

    data = (iostate.sg_flags & (EVENP | ODDP)) ? 7 : 8;

    stop = 1;
#endif /* USE_SGTTY */

    ttyPtr->baud    = baud;
    ttyPtr->parity  = parity;
    ttyPtr->data    = data;
    ttyPtr->stop    = stop;
}

1374
1375
1376
1377
1378
1379
1380
1381



1382
1383
1384

1385
1386
1387
1388
1389
1390
1391
1375
1376
1377
1378
1379
1380
1381

1382
1383
1384
1385
1386

1387
1388
1389
1390
1391
1392
1393
1394







-
+
+
+


-
+







static void
TtySetAttributes(
    int fd,			/* Open file descriptor for serial port to be
				 * modified. */
    TtyAttrs *ttyPtr)		/* Buffer containing new attributes for serial
				 * port. */
{
    struct termios iostate;
    IOSTATE iostate;

#ifdef USE_TERMIOS
    int parity, data, flag;

    tcgetattr(fd, &iostate);
    GETIOSTATE(fd, &iostate);
    cfsetospeed(&iostate, TtyGetSpeed(ttyPtr->baud));
    cfsetispeed(&iostate, TtyGetSpeed(ttyPtr->baud));

    flag = 0;
    parity = ttyPtr->parity;
    if (parity != 'n') {
	SET_BITS(flag, PARENB);
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
1439
1440
1441

1442
1443

1444
1445
1446
1447

1448
1449
1450
1451
1452


1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468


1469
1470
1471


1472
1473
1474
1475
1476
1477



1478
1479
1480
1481



1482
1483
1484
1485
1486
1487


1488
1489
1490
1491


1492
1493
1494
1495

1496
1497
1498

1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513







1514
1515
1516
1517


1518
1519
1520
1521
1522

1523
1524

1525

1526


1527
1528





1529

1530
1531
1532
1533
1534
1535








1536
1537
1538
1539

1540
1541

1542














1543
1544





1545
1546
1547
1548
1549
1550
1551
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495

1496
1497
1498
1499
1500

1501
1502

1503




1504
1505
1506



1507
1508
1509
1510
1511
1512
1513
1514
1515




1516
1517



1518
1519
1520


1521
1522

1523




1524
1525
1526
1527



1528
1529
1530

1531
1532
1533


1534
1535
1536



1537
1538
1539
1540
1541

1542
1543


1544

1545
1546
1547
1548
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
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







+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














+
+
+








+
+
-
+
+



-
+

-
+
-
-
-
-
+


-
-
-
+
+







-
-
-
-


-
-
-
+
+

-
-
+
+
-

-
-
-
-
+
+
+

-
-
-
+
+
+
-



-
-
+
+

-
-
-
+
+



-
+

-
-
+
-













-
+
+
+
+
+
+
+



-
+
+




-
+

-
+

+

+
+
-
-
+
+
+
+
+

+
-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
+


+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+







    if (ttyPtr->stop == 2) {
	SET_BITS(flag, CSTOPB);
    }

    CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | CSIZE | CSTOPB);
    SET_BITS(iostate.c_cflag, flag);

#endif	/* USE_TERMIOS */

#ifdef USE_TERMIO
    int parity, data, flag;

    tcsetattr(fd, TCSADRAIN, &iostate);
    GETIOSTATE(fd, &iostate);
    CLEAR_BITS(iostate.c_cflag, CBAUD);
    SET_BITS(iostate.c_cflag, TtyGetSpeed(ttyPtr->baud));

    flag = 0;
    parity = ttyPtr->parity;
    if (parity != 'n') {
	SET_BITS(flag, PARENB);
	if ((parity == 'm') || (parity == 's')) {
	    SET_BITS(flag, PAREXT);
	}
	if ((parity == 'm') || (parity == 'o')) {
	    SET_BITS(flag, PARODD);
	}
    }
    data = ttyPtr->data;
    SET_BITS(flag,
	    (data == 5) ? CS5 :
	    (data == 6) ? CS6 :
	    (data == 7) ? CS7 : CS8);
    if (ttyPtr->stop == 2) {
	SET_BITS(flag, CSTOPB);
    }

    CLEAR_BITS(iostate.c_cflag, PARENB | PARODD | PAREXT | CSIZE | CSTOPB);
    SET_BITS(iostate.c_cflag, flag);

#endif	/* USE_TERMIO */

#ifdef USE_SGTTY
    int parity;

    GETIOSTATE(fd, &iostate);
    iostate.sg_ospeed = TtyGetSpeed(ttyPtr->baud);
    iostate.sg_ispeed = TtyGetSpeed(ttyPtr->baud);

    parity = ttyPtr->parity;
    if (parity == 'e') {
	CLEAR_BITS(iostate.sg_flags, ODDP);
	SET_BITS(iostate.sg_flags, EVENP);
    } else if (parity == 'o') {
	CLEAR_BITS(iostate.sg_flags, EVENP);
	SET_BITS(iostate.sg_flags, ODDP);
    }
#endif	/* USE_SGTTY */

    SETIOSTATE(fd, &iostate);
}

/*
 *---------------------------------------------------------------------------
 *
 * TtyParseMode --
 *
 *	Parse the "-mode" argument to the fconfigure command. The argument is
 *	of the form baud,parity,data,stop.
 *
 * Results:
 *	The return value is TCL_OK if the argument was successfully parsed,
 *	TCL_ERROR otherwise. If TCL_ERROR is returned, an error message is
 *	left in the interp's result (if interp is non-NULL).
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
TtyParseMode(
    Tcl_Interp *interp,		/* If non-NULL, interp for error return. */
    const char *mode,		/* Mode string to be parsed. */
    int *speedPtr,		/* Filled with baud rate from mode string. */
    int *parityPtr,		/* Filled with parity from mode string. */
    TtyAttrs *ttyPtr)		/* Filled with data from mode string */
    int *dataPtr,		/* Filled with data bits from mode string. */
    int *stopPtr)		/* Filled with stop bits from mode string. */
{
    int i, end;
    char parity;
    const char *bad = "bad value for -mode";
    static const char *bad = "bad value for -mode";

    i = sscanf(mode, "%d,%c,%d,%d%n",
    i = sscanf(mode, "%d,%c,%d,%d%n", speedPtr, &parity, dataPtr,
	    &ttyPtr->baud,
	    &parity,
	    &ttyPtr->data,
	    &ttyPtr->stop, &end);
	    stopPtr, &end);
    if ((i != 4) || (mode[end] != '\0')) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s: should be baud,parity,data,stop", bad));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	    Tcl_AppendResult(interp, bad, ": should be baud,parity,data,stop",
		    NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Only allow setting mark/space parity on platforms that support it Make
     * sure to allow for the case where strchr is a macro. [Bug: 5089]
     *
     * We cannot if/else/endif the strchr arguments, it has to be the whole
     * function. On AIX this function is apparently a macro, and macros do
     * not allow pre-processor directives in their arguments.
     */

    if (
#if defined(PAREXT)
        strchr("noems", parity)
#if defined(PAREXT) || defined(USE_TERMIO)
    if (strchr("noems", parity) == NULL) {
#else
        strchr("noe", parity)
#endif /* PAREXT */
    if (strchr("noe", parity) == NULL) {
#endif /* PAREXT|USE_TERMIO */
                               == NULL) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s parity: should be %s", bad,
#if defined(PAREXT)
		    "n, o, e, m, or s"
	    Tcl_AppendResult(interp, bad, " parity: should be ",
#if defined(PAREXT) || defined(USE_TERMIO)
		    "n, o, e, m, or s",
#else
		    "n, o, or e"
#endif /* PAREXT */
		    ));
		    "n, o, or e",
#endif /* PAREXT|USE_TERMIO */
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	}
	return TCL_ERROR;
    }
    ttyPtr->parity = parity;
    if ((ttyPtr->data < 5) || (ttyPtr->data > 8)) {
    *parityPtr = parity;
    if ((*dataPtr < 5) || (*dataPtr > 8)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s data: should be 5, 6, 7, or 8", bad));
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	    Tcl_AppendResult(interp, bad, " data: should be 5, 6, 7, or 8",
		    NULL);
	}
	return TCL_ERROR;
    }
    if ((ttyPtr->stop < 0) || (ttyPtr->stop > 2)) {
    if ((*stopPtr < 0) || (*stopPtr > 2)) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "%s stop: should be 1 or 2", bad));
	    Tcl_AppendResult(interp, bad, " stop: should be 1 or 2", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * TtyInit --
 *
 *	Given file descriptor that refers to a serial port, initialize the
 *	serial port to a set of sane values so that Tcl can talk to a device
 *	located on the serial port.
 *	located on the serial port. Note that no initialization happens if the
 *	initialize flag is not set; this is necessary for the correct handling
 *	of UNIX console TTYs at startup.
 *
 * Results:
 *	A pointer to a FileState suitable for use with Tcl_CreateChannel and
 *	the ttyChannelType structure.
 *
 * Side effects:
 *	Serial device initialized to non-blocking raw mode, similar to sockets
 *	All other modes can be simulated on top of this in Tcl.
 *	(if initialize flag is non-zero.) All other modes can be simulated on
 *	top of this in Tcl.
 *
 *---------------------------------------------------------------------------
 */

static void
static FileState *
TtyInit(
    int fd)			/* Open file descriptor for serial port to be
    int fd,			/* Open file descriptor for serial port to be
				 * initialized. */
    int initialize)
{
    TtyState *ttyPtr;
    int stateUpdated = 0;
    struct termios iostate;
    tcgetattr(fd, &iostate);

    ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState));
    GETIOSTATE(fd, &ttyPtr->savedState);
    if (initialize) {
	IOSTATE iostate = ttyPtr->savedState;

#if defined(USE_TERMIOS) || defined(USE_TERMIO)
    if (iostate.c_iflag != IGNBRK
	    || iostate.c_oflag != 0
	    || iostate.c_lflag != 0
	    || iostate.c_cflag & CREAD
	    || iostate.c_cc[VMIN] != 1
	    || iostate.c_cc[VTIME] != 0) {
	if (iostate.c_iflag != IGNBRK ||
		iostate.c_oflag != 0 ||
		iostate.c_lflag != 0 ||
		iostate.c_cflag & CREAD ||
		iostate.c_cc[VMIN] != 1 ||
		iostate.c_cc[VTIME] != 0) {
	    stateUpdated = 1;
	}
	iostate.c_iflag = IGNBRK;
	iostate.c_oflag = 0;
	iostate.c_lflag = 0;
	iostate.c_cflag |= CREAD;
	SET_BITS(iostate.c_cflag, CREAD);
	iostate.c_cc[VMIN] = 1;
	iostate.c_cc[VTIME] = 0;
#endif	/* USE_TERMIOS|USE_TERMIO */

#ifdef USE_SGTTY
	if ((iostate.sg_flags & (EVENP | ODDP)) ||
		!(iostate.sg_flags & RAW)) {
	    ttyPtr->stateUpdated = 1;
	}
	iostate.sg_flags &= EVENP | ODDP;
	SET_BITS(iostate.sg_flags, RAW);
#endif	/* USE_SGTTY */

	/*
	 * Only update if we're changing anything to avoid possible blocking.
	 */

	if (stateUpdated) {
	tcsetattr(fd, TCSADRAIN, &iostate);
    }
	    SETIOSTATE(fd, &iostate);
	}
    }

    return &ttyPtr->fs;
}
#endif	/* SUPPORTS_TTY */

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenFileChannel --
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
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
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
1649
1650
1651
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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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







-
+


-
+




















-
+

















-
-
-
+
+










+
+



















-
+
-





-
+


-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-
+
+










-
-
-
+
+
+




-
+




















-
+



-
+


-
-
+
+
+





+
+


+




-
-
-
-
-
-
-
-
+
+
+
-
-
+
-
-

-

+



-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * NULL. */
    Tcl_Obj *pathPtr,		/* Name of file to open. */
    int mode,			/* POSIX open mode. */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    int fd, channelPermissions;
    TtyState *fsPtr;
    FileState *fsPtr;
    const char *native, *translation;
    char channelName[16 + TCL_INTEGER_SPACE];
    const Tcl_ChannelType *channelTypePtr;
    Tcl_ChannelType *channelTypePtr;

    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
    case O_RDONLY:
	channelPermissions = TCL_READABLE;
	break;
    case O_WRONLY:
	channelPermissions = TCL_WRITABLE;
	break;
    case O_RDWR:
	channelPermissions = (TCL_READABLE | TCL_WRITABLE);
	break;
    default:
	/*
	 * This may occurr if modeString was "", for example.
	 */

	Tcl_Panic("TclpOpenFileChannel: invalid mode value");
	return NULL;
    }

    native = (const char *)Tcl_FSGetNativePath(pathPtr);
    native = Tcl_FSGetNativePath(pathPtr);
    if (native == NULL) {
	if (interp != (Tcl_Interp *) NULL) {
	    Tcl_AppendResult(interp, "couldn't open \"",
	    TclGetString(pathPtr), "\": filename is invalid on this platform",
	    NULL);
	}
	return NULL;
    }

#ifdef DJGPP
    SET_BITS(mode, O_BINARY);
#endif

    fd = TclOSopen(native, mode, permissions);

    if (fd < 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
		    "\": ", Tcl_PosixError(interp), NULL);
	}
	return NULL;
    }

    /*
     * Set close-on-exec flag on the fd so that child processes will not
     * inherit this fd.
     */

    fcntl(fd, F_SETFD, FD_CLOEXEC);

    sprintf(channelName, "file%d", fd);

#ifdef SUPPORTS_TTY
    if (strcmp(native, "/dev/tty") != 0 && isatty(fd)) {
	/*
	 * Initialize the serial port to a set of sane parameters. Especially
	 * important if the remote device is set to echo and the serial port
	 * driver was also set to echo -- as soon as a char were sent to the
	 * serial port, the remote device would echo it, then the serial
	 * driver would echo it back to the device, etc.
	 *
	 * Note that we do not do this if we're dealing with /dev/tty itself,
	 * as that tends to cause Bad Things To Happen when you're working
	 * interactively. Strictly a better check would be to see if the FD
	 * being set up is a device and has the same major/minor as the
	 * initial std FDs (beware reopening!) but that's nearly as messy.
	 */

	translation = "auto crlf";
	channelTypePtr = &ttyChannelType;
	TtyInit(fd);
	fsPtr = TtyInit(fd, 1);
	sprintf(channelName, "serial%d", fd);
    } else
#endif	/* SUPPORTS_TTY */
    {
	translation = NULL;
	channelTypePtr = &fileChannelType;
	sprintf(channelName, "file%d", fd);
	fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
    }

    fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState));
    fsPtr->fileState.validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fileState.fd = fd;
    fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
    fsPtr->fd = fd;
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {
	fsPtr->closeMode = CLOSE_DEFAULT;
	fsPtr->doReset = 0;
	tcgetattr(fsPtr->fileState.fd, &fsPtr->initState);
    }

#endif /* SUPPORTS_TTY */

    fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, channelPermissions);
    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    (ClientData) fsPtr, channelPermissions);

    if (translation != NULL) {
	/*
	 * Gotcha. Most modems need a "\r" at the end of the command sequence.
	 * If you just send "at\n", the modem will not respond with "OK"
	 * because it never got a "\r" to actually invoke the command. So, by
	 * default, newlines are translated to "\r\n" on output to avoid "bug"
	 * reports that the serial port isn't working.
	 */

	if (Tcl_SetChannelOption(interp, fsPtr->fileState.channel,
		"-translation", translation) != TCL_OK) {
	    Tcl_CloseEx(NULL, fsPtr->fileState.channel, 0);
	if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
		translation) != TCL_OK) {
	    Tcl_Close(NULL, fsPtr->channel);
	    return NULL;
	}
    }

    return fsPtr->fileState.channel;
    return fsPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeFileChannel --
 *
 *	Makes a Tcl_Channel from an existing OS level file handle.
 *
 * Results:
 *	The Tcl_Channel created around the preexisting OS level file handle.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeFileChannel(
    void *handle,		/* OS level handle. */
    ClientData handle,		/* OS level handle. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TtyState *fsPtr;
    FileState *fsPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    int fd = PTR2INT(handle);
    const Tcl_ChannelType *channelTypePtr;
    struct stat buf;
    Tcl_ChannelType *channelTypePtr;
    struct sockaddr sockaddr;
    socklen_t sockaddrLen = sizeof(sockaddr);

    if (mode == 0) {
	return NULL;
    }

    sockaddr.sa_family = AF_UNSPEC;

#ifdef SUPPORTS_TTY
    if (isatty(fd)) {
	fsPtr = TtyInit(fd, 0);
	channelTypePtr = &ttyChannelType;
	sprintf(channelName, "serial%d", fd);
    } else
#endif /* SUPPORTS_TTY */
    if (fstat(fd, &buf) == 0 && S_ISSOCK(buf.st_mode)) {
	struct sockaddr sockaddr;
	socklen_t sockaddrLen = sizeof(sockaddr);

	sockaddr.sa_family = AF_UNSPEC;
	if ((getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0)
		&& (sockaddrLen > 0)
		&& (sockaddr.sa_family == AF_INET
    if (getsockname(fd, (struct sockaddr *)&sockaddr, &sockaddrLen) == 0
	    && sockaddrLen > 0
	    && sockaddr.sa_family == AF_INET) {
			|| sockaddr.sa_family == AF_INET6)) {
	    return (Tcl_Channel)TclpMakeTcpClientChannelMode(INT2PTR(fd), mode);
	return MakeTcpClientChannelMode((ClientData) INT2PTR(fd), mode);
	}
	goto normalChannelAfterAll;
    } else {
    normalChannelAfterAll:
	channelTypePtr = &fileChannelType;
	fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
	sprintf(channelName, "file%d", fd);
    }

    fsPtr = (TtyState *)Tcl_Alloc(sizeof(TtyState));
    fsPtr->fileState.fd = fd;
    fsPtr->fileState.validMask = mode | TCL_EXCEPTION;
    fsPtr->fileState.channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    fsPtr, mode);
#ifdef SUPPORTS_TTY
    if (channelTypePtr == &ttyChannelType) {
	fsPtr->closeMode = CLOSE_DEFAULT;
	fsPtr->doReset = 0;
	tcgetattr(fsPtr->fileState.fd, &fsPtr->initState);
    }
#endif /* SUPPORTS_TTY */
    fsPtr->fd = fd;
    fsPtr->validMask = mode | TCL_EXCEPTION;
    fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
	    (ClientData) fsPtr, mode);

    return fsPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpBlockModeProc --
 *
 *	This function is invoked by the generic IO level to set blocking and
 *	nonblocking mode on a TCP socket based channel.
 *
 * Results:
 *	0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
TcpBlockModeProc(
    ClientData instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = (TcpState *) instanceData;

    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
    } else {
	SET_BITS(statePtr->flags, TCP_ASYNC_SOCKET);
    }
    if (TclUnixSetBlockingMode(statePtr->fd, mode) < 0) {
	return errno;
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * WaitForConnect --
 *
 *	Waits for a connection on an asynchronously opened socket to be
 *	completed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The socket is connected after this function returns.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */
    int *errorCodePtr)		/* Where to store errors? */
{
    int timeOut;		/* How long to wait. */
    int state;			/* Of calling TclWaitForFile. */

    /*
     * If an asynchronous connect is in progress, attempt to wait for it to
     * complete before reading.
     */

    if (statePtr->flags & TCP_ASYNC_CONNECT) {
	if (statePtr->flags & TCP_ASYNC_SOCKET) {
	    timeOut = 0;
	} else {
	    timeOut = -1;
	}
	errno = 0;
	state = TclUnixWaitForFile(statePtr->fd,
		TCL_WRITABLE | TCL_EXCEPTION, timeOut);
	if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
	    (void) TclUnixSetBlockingMode(statePtr->fd, TCL_MODE_BLOCKING);
	}
	if (state & TCL_EXCEPTION) {
	    return -1;
	}
	if (state & TCL_WRITABLE) {
	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	} else if (timeOut == 0) {
	    *errorCodePtr = errno = EWOULDBLOCK;
	    return -1;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpInputProc --
 *
 *	This function is invoked by the generic IO level to read input from a
 *	TCP socket based channel.
 *
 *	NOTE: We cannot share code with FilePipeInputProc because here we must
 *	use recv to obtain the input from the channel, not read.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains the POSIX error code on error, or zero if no error
 *	occurred.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(
    ClientData instanceData,	/* Socket state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *) instanceData;
    int bytesRead, state;

    *errorCodePtr = 0;
    state = WaitForConnect(statePtr, errorCodePtr);
    if (state != 0) {
	return -1;
    }
    bytesRead = recv(statePtr->fd, buf, (size_t) bufSize, 0);
    if (bytesRead > -1) {
	return bytesRead;
    }
    if (errno == ECONNRESET) {
	/*
	 * Turn ECONNRESET into a soft EOF condition.
	 */

	return 0;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpOutputProc --
 *
 *	This function is invoked by the generic IO level to write output to a
 *	TCP socket based channel.
 *
 *	NOTE: We cannot share code with FilePipeOutputProc because here we
 *	must use send, not write, to get reliable error reporting.
 *
 * Results:
 *	The number of bytes written is returned. An output argument is set to
 *	a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(
    ClientData instanceData,	/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *) instanceData;
    int written;
    int state;				/* Of waiting for connection. */

    *errorCodePtr = 0;
    state = WaitForConnect(statePtr, errorCodePtr);
    if (state != 0) {
	return -1;
    }
    written = send(statePtr->fd, buf, (size_t) toWrite, 0);
    if (written > -1) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpCloseProc --
 *
 *	This function is invoked by the generic IO level to perform
 *	channel-type-specific cleanup when a TCP socket based channel is
 *	closed.
 *
 * Results:
 *	0 if successful, the value of errno if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpCloseProc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp)		/* For error reporting - unused. */
{
    TcpState *statePtr = (TcpState *) instanceData;
    int errorCode = 0;

    /*
     * Delete a file handler that may be active for this socket if this is a
     * server socket - the file handler was created automatically by Tcl as
     * part of the mechanism to accept new client connections. Channel
     * handlers are already deleted in the generic IO channel closing code
     * that called this function, so we do not have to delete them here.
     */

    Tcl_DeleteFileHandler(statePtr->fd);

    if (close(statePtr->fd) < 0) {
	errorCode = errno;
    }
    ckfree((char *) statePtr);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpGetOptionProc --
 *
 *	Computes an option value for a TCP socket based channel, or a list of
 *	all options and their values.
 *
 *	Note: This code is based on code contributed by John Haxby.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a list of
 *	all options and their values is returned in the supplied DString. Sets
 *	Error message if needed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{
    TcpState *statePtr = (TcpState *) instanceData;
    struct sockaddr_in sockname;
    struct sockaddr_in peername;
    struct hostent *hostEntPtr;
    socklen_t size = sizeof(struct sockaddr_in);
    size_t len = 0;
    char buf[TCL_INTEGER_SPACE];

    if (optionName != NULL) {
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {
	socklen_t optlen = sizeof(int);
	int err, ret;

	ret = getsockopt(statePtr->fd, SOL_SOCKET, SO_ERROR,
		(char *)&err, &optlen);
	if (ret < 0) {
	    err = errno;
	}
	if (err != 0) {
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
	}
	return TCL_OK;
    }

    if ((len == 0) ||
	    ((len > 1) && (optionName[1] == 'p') &&
		    (strncmp(optionName, "-peername", len) == 0))) {
	if (getpeername(statePtr->fd, (struct sockaddr *) &peername,
		&size) >= 0) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
	    }
	    Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
	    hostEntPtr = TclpGetHostByAddr(			/* INTL: Native. */
		    (char *) &peername.sin_addr,
		    sizeof(peername.sin_addr), AF_INET);
	    if (hostEntPtr != NULL) {
		Tcl_DString ds;

		Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
		Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
		Tcl_DStringFree(&ds);
	    } else {
		Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
	    }
	    TclFormatInt(buf, ntohs(peername.sin_port));
	    Tcl_DStringAppendElement(dsPtr, buf);
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	} else {
	    /*
	     * 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 (which have no peer).
	     * Same must be done on win&mac.
	     */

	    if (len) {
		if (interp) {
		    Tcl_AppendResult(interp, "can't get peername: ",
			    Tcl_PosixError(interp), NULL);
		}
		return TCL_ERROR;
	    }
	}
    }

    if ((len == 0) ||
	    ((len > 1) && (optionName[1] == 's') &&
	    (strncmp(optionName, "-sockname", len) == 0))) {
	if (getsockname(statePtr->fd, (struct sockaddr *) &sockname,
                        &size) >= 0) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-sockname");
		Tcl_DStringStartSublist(dsPtr);
	    }
	    Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
            if (sockname.sin_addr.s_addr == INADDR_ANY) {
		/*
		 * We don't want to resolve INADDR_ANY; it can sometimes cause
		 * problems (and never has a name).
		 */

                hostEntPtr = NULL;
            } else {
                hostEntPtr = TclpGetHostByAddr(		/* INTL: Native. */
                                               (char *) &sockname.sin_addr,
                                               sizeof(sockname.sin_addr), AF_INET);
            }
	    if (hostEntPtr != NULL) {
		Tcl_DString ds;

		Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
		Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
		Tcl_DStringFree(&ds);
	    } else {
		Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
	    }
	    TclFormatInt(buf, ntohs(sockname.sin_port));
	    Tcl_DStringAppendElement(dsPtr, buf);
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	} else {
	    if (interp) {
		Tcl_AppendResult(interp, "can't get sockname: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
    }

    if (len > 0) {
	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpWatchProc --
 *
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel will be
 *	seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
WrapNotify(
    ClientData clientData,
    int mask)
{
    TcpState *statePtr = (TcpState *) clientData;
    int newmask = mask & statePtr->interest;

    if (newmask == 0) {
	/*
	 * There was no overlap between the states the channel is
	 * interested in notifications for, and the states that are
	 * reported present on the file descriptor by select().  The
	 * only way that can happen is when the channel is interested
	 * in a writable condition, and only a readable state is reported
	 * present (see TcpWatchProc() below).  In that case, signal back
	 * to the caller the writable state, which is really an error
	 * condition.  As an extra check on that assumption, check for
	 * a non-zero value of errno before reporting an artificial
	 * writable state.
	 */
	if (errno == 0) {
	    return;
	}
	newmask = TCL_WRITABLE;
    }
    Tcl_NotifyChannel(statePtr->channel, newmask);
}

static void
TcpWatchProc(
    ClientData instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = (TcpState *) instanceData;

    /*
     * Make sure we don't mess with server sockets since they will never be
     * readable or writable at the Tcl level. This keeps Tcl scripts from
     * interfering with the -accept behavior.
     */

    if (!statePtr->acceptProc) {
	if (mask) {

	    /*
	     * Whether it is a bug or feature or otherwise, it is a fact
	     * of life that on at least some Linux kernels select() fails
	     * to report that a socket file descriptor is writable when
	     * the other end of the socket is closed.  This is in contrast
	     * to the guarantees Tcl makes that its channels become
	     * writable and fire writable events on an error conditon.
	     * This has caused a leak of file descriptors in a state of
	     * background flushing.  See Tcl ticket 1758a0b603.
	     *
	     * As a workaround, when our caller indicates an interest in
	     * writable notifications, we must tell the notifier built
	     * around select() that we are interested in the readable state
	     * of the file descriptor as well, as that is the only reliable
	     * means to get notified of error conditions.  Then it is the
	     * task of WrapNotify() above to untangle the meaning of these
	     * channel states and report the chan events as best it can.
	     * We save a copy of the mask passed in to assist with that.
	     */

	    statePtr->interest = mask;
	    Tcl_CreateFileHandler(statePtr->fd, mask|TCL_READABLE,
		    (Tcl_FileProc *) WrapNotify, (ClientData) statePtr);
	} else {
	    Tcl_DeleteFileHandler(statePtr->fd);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TcpGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
 *	TCP socket based channel.
 *
 * Results:
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
 *	handle for the specified direction.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetHandleProc(
    ClientData instanceData,	/* The socket state. */
    int direction,		/* Not used. */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    TcpState *statePtr = (TcpState *) instanceData;

    *handlePtr = (ClientData) INT2PTR(statePtr->fd);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CreateSocket --
 *
 *	This function opens a new socket in client or server mode and
 *	initializes the TcpState structure.
 *
 * Results:
 *	Returns a new TcpState, or NULL with an error in the interp's result,
 *	if interp is not NULL.
 *
 * Side effects:
 *	Opens a socket.
 *
 *----------------------------------------------------------------------
 */

static TcpState *
CreateSocket(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Name of host on which to open port. NULL
				 * implies INADDR_ANY */
    int server,			/* 1 if socket should be a server socket, else
				 * 0 for a client socket. */
    const char *myaddr,		/* Optional client-side address */
    int myport,			/* Optional client-side port */
    int async)			/* If nonzero and creating a client socket,
				 * attempt to do an async connect. Otherwise
				 * do a synchronous connect or bind. */
{
    int status, sock, asyncConnect, curState;
    struct sockaddr_in sockaddr;	/* socket address */
    struct sockaddr_in mysockaddr;	/* Socket address for client */
    TcpState *statePtr;
    const char *errorMsg = NULL;

    sock = -1;
    if (!CreateSocketAddress(&sockaddr, host, port, server, &errorMsg)) {
	goto addressError;
    }
    if ((myaddr != NULL || myport != 0) &&
	    !CreateSocketAddress(&mysockaddr, myaddr, myport, 1, &errorMsg)) {
	goto addressError;
    }

    sock = socket(AF_INET, SOCK_STREAM, 0);
    if (sock < 0) {
	goto addressError;
    }

    /*
     * Set the close-on-exec flag so that the socket will not get inherited by
     * child processes.
     */

    fcntl(sock, F_SETFD, FD_CLOEXEC);

    /*
     * Set kernel space buffering
     */

    TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);

    asyncConnect = 0;
    status = 0;
    if (server) {
	/*
	 * Set up to reuse server addresses automatically and bind to the
	 * specified port.
	 */

	status = 1;
	(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
		sizeof(status));
	status = bind(sock, (struct sockaddr *) &sockaddr,
		sizeof(struct sockaddr));
	if (status != -1) {
	    status = listen(sock, SOMAXCONN);
	}
    } else {
	if (myaddr != NULL || myport != 0) {
	    curState = 1;
	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
		    (char *) &curState, sizeof(curState));
	    status = bind(sock, (struct sockaddr *) &mysockaddr,
		    sizeof(struct sockaddr));
	    if (status < 0) {
		goto bindError;
	    }
	}

	/*
	 * Attempt to connect. The connect may fail at present with an
	 * EINPROGRESS but at a later time it will complete. The caller will
	 * set up a file handler on the socket if she is interested in being
	 * informed when the connect completes.
	 */

	if (async) {
	    status = TclUnixSetBlockingMode(sock, TCL_MODE_NONBLOCKING);
	} else {
	    status = 0;
	}
	if (status > -1) {
	    status = connect(sock, (struct sockaddr *) &sockaddr,
		    sizeof(sockaddr));
	    if (status < 0) {
		if (errno == EINPROGRESS) {
		    asyncConnect = 1;
		    status = 0;
		}
	    } else {
		/*
		 * Here we are if the connect succeeds. In case of an
		 * asynchronous connect we have to reset the channel to
		 * blocking mode. This appears to happen not very often, but
		 * e.g. on a HP 9000/800 under HP-UX B.11.00 we enter this
		 * stage. [Bug: 4388]
		 */

		if (async) {
		    status = TclUnixSetBlockingMode(sock, TCL_MODE_BLOCKING);
		}
	    }
	}
    }

  bindError:
    if (status < 0) {
	if (interp != NULL) {
	    Tcl_AppendResult(interp, "couldn't open socket: ",
		    Tcl_PosixError(interp), NULL);
	}
	if (sock != -1) {
	    close(sock);
	}
	return NULL;
    }

    /*
     * Allocate a new TcpState for this socket.
     */

    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
    statePtr->flags = 0;
    if (asyncConnect) {
	statePtr->flags = TCP_ASYNC_CONNECT;
    }
    statePtr->interest = 0;
    statePtr->fd = sock;

    return statePtr;

  addressError:
    if (sock != -1) {
	close(sock);
    }
    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
	if (errorMsg != NULL) {
	    Tcl_AppendResult(interp, " (", errorMsg, ")", NULL);
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * 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(
    struct sockaddr_in *sockaddrPtr,	/* Socket address */
    const char *host,			/* Host. NULL implies INADDR_ANY */
    int port,				/* Port number */
    int willBind,			/* Is this an address to bind() to or
					 * to connect() to? */
    const char **errorMsgPtr)		/* Place to store the error message
					 * detail, if available. */
{
#ifdef HAVE_GETADDRINFO
    struct addrinfo hints, *resPtr = NULL;
    char *native;
    Tcl_DString ds;
    int result;

    if (host == NULL) {
	sockaddrPtr->sin_family = AF_INET;
	sockaddrPtr->sin_addr.s_addr = INADDR_ANY;
    addPort:
	sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
    return fsPtr->fileState.channel;
	return 1;
    }

    (void) memset(&hints, 0, sizeof(struct addrinfo));
    hints.ai_family = AF_INET;
    hints.ai_socktype = SOCK_STREAM;
    if (willBind) {
	hints.ai_flags |= AI_PASSIVE;
    }

    /*
     * Note that getaddrinfo() *is* thread-safe. If a platform doesn't get
     * that right, it shouldn't use this part of the code.
     */

    native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
    result = getaddrinfo(native, NULL, &hints, &resPtr);
    Tcl_DStringFree(&ds);
    if (result == 0) {
	memcpy(sockaddrPtr, resPtr->ai_addr, sizeof(struct sockaddr_in));
	freeaddrinfo(resPtr);
	goto addPort;
    }

    /*
     * Ought to use gai_strerror() here...
     */

    switch (result) {
    case EAI_NONAME:
    case EAI_SERVICE:
#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
    case EAI_ADDRFAMILY:
#endif
#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
    case EAI_NODATA:
#endif
	*errorMsgPtr = gai_strerror(result);
	errno = EHOSTUNREACH;
	return 0;
    case EAI_SYSTEM:
	return 0;
    default:
	*errorMsgPtr = gai_strerror(result);
	errno = ENXIO;
	return 0;
    }
#else /* !HAVE_GETADDRINFO */
    struct in_addr addr;		/* For 64/32 bit madness */

    (void) memset(sockaddrPtr, '\0', sizeof(struct sockaddr_in));
    sockaddrPtr->sin_family = AF_INET;
    sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
    if (host == NULL) {
	addr.s_addr = INADDR_ANY;
    } else {
	struct hostent *hostent;	/* Host database entry */
	Tcl_DString ds;
	const char *native;

	if (host == NULL) {
	    native = NULL;
	} else {
	    native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
	}
	addr.s_addr = inet_addr(native);		/* INTL: Native. */

	/*
	 * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1 on
	 * either 32 or 64 bits systems.
	 */

	if (addr.s_addr == 0xFFFFFFFF) {
	    hostent = TclpGetHostByName(native);	/* INTL: Native. */
	    if (hostent != NULL) {
		memcpy(&addr, hostent->h_addr_list[0],
			(size_t) hostent->h_length);
	    } else {
#ifdef	EHOSTUNREACH
		errno = EHOSTUNREACH;
#else /* !EHOSTUNREACH */
#ifdef ENXIO
		errno = ENXIO;
#endif /* ENXIO */
#endif /* EHOSTUNREACH */
		if (native != NULL) {
		    Tcl_DStringFree(&ds);
		}
		return 0;	/* Error. */
	    }
	}
	if (native != NULL) {
	    Tcl_DStringFree(&ds);
	}
    }

    /*
     * 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 /* HAVE_GETADDRINFO */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpClient --
 *
 *	Opens a TCP client socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. An error message is returned in the
 *	interpreter on failure.
 *
 * Side effects:
 *	Opens a client socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpClient(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Host on which to open port. */
    const char *myaddr,		/* Client-side address */
    int myport,			/* Client-side port */
    int async)			/* If nonzero, attempt to do an asynchronous
				 * connect. Otherwise we do a blocking
				 * connect. */
{
    TcpState *statePtr;
    char channelName[16 + TCL_INTEGER_SPACE];

    /*
     * Create a new client socket and wrap it in a channel.
     */

    statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
    if (statePtr == NULL) {
	return NULL;
    }

    statePtr->acceptProc = NULL;
    statePtr->acceptProcData = NULL;

    sprintf(channelName, "sock%d", statePtr->fd);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close(NULL, statePtr->channel);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --
 *
 *	Creates a Tcl_Channel from an existing client TCP socket.
 *
 * Results:
 *	The Tcl_Channel wrapped around the preexisting TCP socket.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    ClientData sock)		/* The socket to wrap up into a channel. */
{
    return MakeTcpClientChannelMode(sock, (TCL_READABLE | TCL_WRITABLE));
}

/*
 *----------------------------------------------------------------------
 *
 * MakeTcpClientChannelMode --
 *
 *	Creates a Tcl_Channel from an existing client TCP socket
 *	with given mode.
 *
 * Results:
 *	The Tcl_Channel wrapped around the preexisting TCP socket.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_Channel
MakeTcpClientChannelMode(
    ClientData sock,		/* The socket to wrap up into a channel. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[16 + TCL_INTEGER_SPACE];

    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
    statePtr->fd = PTR2INT(sock);
    statePtr->flags = 0;
    statePtr->interest = 0;
    statePtr->acceptProc = NULL;
    statePtr->acceptProcData = NULL;

    sprintf(channelName, "sock%d", statePtr->fd);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) statePtr, mode);
    if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close(NULL, statePtr->channel);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpServer --
 *
 *	Opens a TCP server socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. If an error occurred, an error message
 *	is left in the interp's result if interp is not NULL.
 *
 * Side effects:
 *	Opens a server socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpServer(
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    int port,			/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    ClientData acceptProcData)	/* Data for the callback. */
{
    TcpState *statePtr;
    char channelName[16 + TCL_INTEGER_SPACE];

    /*
     * Create a new client socket and wrap it in a channel.
     */

    statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
    if (statePtr == NULL) {
	return NULL;
    }

    statePtr->acceptProc = acceptProc;
    statePtr->acceptProcData = acceptProcData;

    /*
     * Set up the callback mechanism for accepting connections from new
     * clients.
     */

    Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
	    (ClientData) statePtr);
    sprintf(channelName, "sock%d", statePtr->fd);
    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) statePtr, 0);
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpAccept --
 *	Accept a TCP socket connection.	 This is called by the event loop.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new connection socket. Calls the registered callback for the
 *	connection acceptance mechanism.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAccept(
    ClientData data,		/* Callback token. */
    int mask)			/* Not used. */
{
    TcpState *sockState;	/* Client data of server socket. */
    int newsock;		/* The new client socket */
    TcpState *newSockState;	/* State for new socket. */
    struct sockaddr_in addr;	/* The remote address */
    socklen_t len;		/* For accept interface */
    char channelName[16 + TCL_INTEGER_SPACE];

    sockState = (TcpState *) data;

    len = sizeof(struct sockaddr_in);
    newsock = accept(sockState->fd, (struct sockaddr *) &addr, &len);
    if (newsock < 0) {
	return;
    }

    /*
     * Set close-on-exec flag to prevent the newly accepted socket from being
     * inherited by child processes.
     */

    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);

    newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));

    newSockState->flags = 0;
    newSockState->interest = 0;
    newSockState->fd = newsock;
    newSockState->acceptProc = NULL;
    newSockState->acceptProcData = NULL;

    sprintf(channelName, "sock%d", newsock);
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));

    Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
	    "auto crlf");

    if (sockState->acceptProc != NULL) {
	(*sockState->acceptProc)(sockState->acceptProcData,
		newSockState->channel, inet_ntoa(addr.sin_addr),
		ntohs(addr.sin_port));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetDefaultStdChannel --
 *
1828
1829
1830
1831
1832
1833
1834
1835

1836
1837
1838
1839
1840
1841
1842
2962
2963
2964
2965
2966
2967
2968

2969
2970
2971
2972
2973
2974
2975
2976







-
+







	Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type");
	break;
    }

#undef ZERO_OFFSET
#undef ERROR_OFFSET

    channel = Tcl_MakeFileChannel(INT2PTR(fd), mode);
    channel = Tcl_MakeFileChannel((ClientData) INT2PTR(fd), mode);
    if (channel == NULL) {
	return NULL;
    }

    /*
     * Set up the normal channel options for stdio handles.
     */
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
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
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







-
-
+
+
+


-
+




-
+



-
+


-
+
-
-
+
-


-
+
-
-
+
-















-
+


-
+
+










-
-
+
-
-
+


-
+




-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+








int
Tcl_GetOpenFile(
    Tcl_Interp *interp,		/* Interpreter in which to find file. */
    const char *chanID,		/* String that identifies file. */
    int forWriting,		/* 1 means the file is going to be used for
				 * writing, 0 means for reading. */
    TCL_UNUSED(int),		/* Obsolete argument.
				 * Ignored, we always check that
    int checkUsage,		/* 1 means verify that the file was opened in
				 * a mode that allows the access specified by
				 * "forWriting". Ignored, we always check that
				 * the channel is open for the requested
				 * mode. */
    void **filePtr)	/* Store pointer to FILE structure here. */
    ClientData *filePtr)	/* Store pointer to FILE structure here. */
{
    Tcl_Channel chan;
    int chanMode, fd;
    const Tcl_ChannelType *chanTypePtr;
    void *data;
    ClientData data;
    FILE *f;

    chan = Tcl_GetChannel(interp, chanID, &chanMode);
    if (chan == NULL) {
    if (chan == (Tcl_Channel) NULL) {
	return TCL_ERROR;
    }
    if (forWriting && !(chanMode & TCL_WRITABLE)) {
    if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" wasn't opened for writing", chanID));
	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for writing",
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_WRITABLE",
		NULL);
	return TCL_ERROR;
    } else if (!forWriting && !(chanMode & TCL_READABLE)) {
    } else if ((!forWriting) && ((chanMode & TCL_READABLE) == 0)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"\"%s\" wasn't opened for reading", chanID));
	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for reading",
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NOT_READABLE",
		NULL);
	return TCL_ERROR;
    }

    /*
     * We allow creating a FILE * out of file based, pipe based and socket
     * based channels. We currently do not allow any other channel types,
     * because it is likely that stdio will not know what to do with them.
     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if ((chanTypePtr == &fileChannelType)
#ifdef SUPPORTS_TTY
	    || (chanTypePtr == &ttyChannelType)
#endif /* SUPPORTS_TTY */
	    || (strcmp(chanTypePtr->typeName, "tcp") == 0)
	    || (chanTypePtr == &tcpChannelType)
	    || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
	if (Tcl_GetChannelHandle(chan,
		(forWriting ? TCL_WRITABLE : TCL_READABLE), &data) == TCL_OK) {
		(forWriting ? TCL_WRITABLE : TCL_READABLE),
		(ClientData*) &data) == TCL_OK) {
	    fd = PTR2INT(data);

	    /*
	     * The call to fdopen below is probably dangerous, since it will
	     * truncate an existing file if the file is being opened for
	     * writing....
	     */

	    f = fdopen(fd, (forWriting ? "w" : "r"));
	    if (f == NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"cannot get a FILE * for \"%s\"", chanID));
		Tcl_AppendResult(interp, "cannot get a FILE * for \"", chanID,
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL",
			"FILE_FAILURE", NULL);
			"\"", NULL);
		return TCL_ERROR;
	    }
	    *filePtr = f;
	    *filePtr = (ClientData) f;
	    return TCL_OK;
	}
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "\"%s\" cannot be used to get a FILE *", chanID));
    Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "NO_DESCRIPTOR",
	    NULL);
    return TCL_ERROR;
    Tcl_AppendResult(interp, "\"", chanID,
	    "\" cannot be used to get a FILE *", NULL);
    return TCL_ERROR;
}

#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
/*
 *----------------------------------------------------------------------
 *
 * TclUnixWaitForFile --
 *
 *	This function waits synchronously for a file to become readable or
 *	writable, with an optional timeout.
 *
 * Results:
 *	The return value is an OR'ed combination of TCL_READABLE,
 *	TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
 *	present on file at the time of the return. This function will not
 *	return until either "timeout" milliseconds have elapsed or at least
 *	one of the conditions given by mask has occurred for file (a return
 *	value of 0 means that a timeout occurred). No normal events will be
 *	serviced during the execution of this function.
 *
 * Side effects:
 *	Time passes.
 *
 *----------------------------------------------------------------------
 */

int
TclUnixWaitForFile(
    int fd,			/* Handle for file on which to wait. */
    int mask,			/* What to wait for: OR'ed combination of
				 * TCL_READABLE, TCL_WRITABLE, and
				 * TCL_EXCEPTION. */
    int timeout)		/* Maximum amount of time to wait for one of
				 * the conditions in mask to occur, in
				 * milliseconds. A value of 0 means don't wait
				 * at all, and a value of -1 means wait
				 * forever. */
{
    Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
    struct timeval blockTime, *timeoutPtr;
    int numFound, result = 0;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionalMask;

#ifndef _DARWIN_C_SOURCE
    /*
     * Sanity check fd.
     */

    if (fd >= FD_SETSIZE) {
	Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd);
	/* must never get here, or select masks overrun will occur below */
    }
#endif

    /*
     * If there is a non-zero finite timeout, compute the time when we give
     * up.
     */

    if (timeout > 0) {
	Tcl_GetTime(&now);
	abortTime.sec = now.sec + timeout/1000;
	abortTime.usec = now.usec + (timeout%1000)*1000;
	if (abortTime.usec >= 1000000) {
	    abortTime.usec -= 1000000;
	    abortTime.sec += 1;
	}
	timeoutPtr = &blockTime;
    } else if (timeout == 0) {
	timeoutPtr = &blockTime;
	blockTime.tv_sec = 0;
	blockTime.tv_usec = 0;
    } else {
	timeoutPtr = NULL;
    }

    /*
     * Initialize the select masks.
     */

    FD_ZERO(&readableMask);
    FD_ZERO(&writableMask);
    FD_ZERO(&exceptionalMask);

    /*
     * Loop in a mini-event loop of our own, waiting for either the file to
     * become ready or a timeout to occur.
     */

    while (1) {
	if (timeout > 0) {
	    blockTime.tv_sec = abortTime.sec - now.sec;
	    blockTime.tv_usec = abortTime.usec - now.usec;
	    if (blockTime.tv_usec < 0) {
		blockTime.tv_sec -= 1;
		blockTime.tv_usec += 1000000;
	    }
	    if (blockTime.tv_sec < 0) {
		blockTime.tv_sec = 0;
		blockTime.tv_usec = 0;
	    }
	}

	/*
	 * Setup the select masks for the fd.
	 */

	if (mask & TCL_READABLE)  {
	    FD_SET(fd, &readableMask);
	}
	if (mask & TCL_WRITABLE)  {
	    FD_SET(fd, &writableMask);
	}
	if (mask & TCL_EXCEPTION) {
	    FD_SET(fd, &exceptionalMask);
	}

	/*
	 * Wait for the event or a timeout.
	 */

	numFound = select(fd + 1, &readableMask, &writableMask,
		&exceptionalMask, timeoutPtr);
	if (numFound == 1) {
	    if (FD_ISSET(fd, &readableMask))   {
		SET_BITS(result, TCL_READABLE);
	    }
	    if (FD_ISSET(fd, &writableMask))  {
		SET_BITS(result, TCL_WRITABLE);
	    }
	    if (FD_ISSET(fd, &exceptionalMask)) {
		SET_BITS(result, TCL_EXCEPTION);
	    }
	    result &= mask;
	    if (result) {
		break;
	    }
	}
	if (timeout == 0) {
	    break;
	}
	if (timeout < 0) {
	    continue;
	}

	/*
	 * The select returned early, so we need to recompute the timeout.
	 */

	Tcl_GetTime(&now);
	if ((abortTime.sec < now.sec)
		|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
	    break;
	}
    }
    return result;
}
#endif /* HAVE_COREFOUNDATION */

/*
 *----------------------------------------------------------------------
 *
 * FileTruncateProc --
 *
 *	Truncates a file to a given length.
1968
1969
1970
1971
1972
1973
1974
1975

1976
1977
1978

1979
1980
1981
1982
1983
1984
1985
3256
3257
3258
3259
3260
3261
3262

3263
3264
3265

3266
3267
3268
3269
3270
3271
3272
3273







-
+


-
+







 *	places later in the file than the truncate point.
 *
 *----------------------------------------------------------------------
 */

static int
FileTruncateProc(
    void *instanceData,
    ClientData instanceData,
    Tcl_WideInt length)
{
    FileState *fsPtr = (FileState *)instanceData;
    FileState *fsPtr = (FileState *) instanceData;
    int result;

#ifdef HAVE_TYPE_OFF64_T
    /*
     * We assume this goes with the type for now...
     */

1994
1995
1996
1997
1998
1999
2000


2001
2002
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292







+
+


}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to unix/tclUnixCompat.c.

1
2
3
4
5
6
7
8
9
10


11
12
13
14
15
16
17
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19










+
+







/*
 * tclUnixCompat.c
 *
 * Written by: Zoran Vasiljevic (vasiljevic@users.sourceforge.net).
 *
 * 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 <pwd.h>
#include <grp.h>
#include <errno.h>
#include <string.h>

/*
 * See also: SC_BLOCKING_STYLE in unix/tcl.m4
 */

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
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







-
-
-
-
+
+
+
+







-
+

-
+







 * This macro assumes that the pointer 'buffer' was created from an aligned
 * pointer by adding the 'length'. If this 'length' was not a multiple of the
 * 'size' the result is unaligned and PadBuffer corrects both the pointer,
 * _and_ the 'length'. The latter means that future increments of 'buffer' by
 * 'length' stay aligned.
 */

#define PadBuffer(buffer, length, size)			\
    if (((length) % (size))) {				\
	(buffer) += ((size) - ((length) % (size)));	\
	(length) += ((size) - ((length) % (size)));	\
#define PadBuffer(buffer, length, size)             \
    if (((length) % (size))) {                      \
	(buffer) += ((size) - ((length) % (size))); \
	(length) += ((size) - ((length) % (size))); \
    }

/*
 * Per-thread private storage used to store values returned from MT-unsafe
 * library calls.
 */

#if TCL_THREADS
#ifdef TCL_THREADS

typedef struct {
typedef struct ThreadSpecificData {
    struct passwd pwd;
#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5)
#define NEED_PW_CLEANER 1
    char *pbuf;
    int pbuflen;
#else
    char pbuf[2048];
112
113
114
115
116
117
118
119

120
121
122

123
124
125
126
127
128
129
114
115
116
117
118
119
120

121
122
123

124
125
126
127
128
129
130
131







-
+


-
+







static int		CopyHostent(struct hostent *tgtPtr, char *buf,
			    int buflen);
static int		CopyString(const char *src, char *buf, int buflen);

#endif

#ifdef NEED_PW_CLEANER
static void		FreePwBuf(ClientData dummy);
static void		FreePwBuf(ClientData ignored);
#endif
#ifdef NEED_GR_CLEANER
static void		FreeGrBuf(ClientData dummy);
static void		FreeGrBuf(ClientData ignored);
#endif
#endif /* TCL_THREADS */

/*
 *---------------------------------------------------------------------------
 *
 * TclUnixSetBlockingMode --
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
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







-
+


















-
+












-
+







 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwNam(
    const char *name)
{
#if !TCL_THREADS
#if !defined(TCL_THREADS)
    return getpwnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWNAM_R_5)
    struct passwd *pwPtr = NULL;

    /*
     * How to allocate a buffer of the right initial size. If you want the
     * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
     * and weep.
     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen);
	tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
	tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWNAM_R_4)
    return getpwnam_r(name, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
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
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







-
+


















-
+












-
+







 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwUid(
    uid_t uid)
{
#if !TCL_THREADS
#if !defined(TCL_THREADS)
    return getpwuid(uid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWUID_R_5)
    struct passwd *pwPtr = NULL;

    /*
     * How to allocate a buffer of the right initial size. If you want the
     * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
     * and weep.
     */

    if (tsdPtr->pbuf == NULL) {
	tsdPtr->pbuflen = (int) sysconf(_SC_GETPW_R_SIZE_MAX);
	if (tsdPtr->pbuflen < 1) {
	    tsdPtr->pbuflen = 1024;
	}
	tsdPtr->pbuf = (char *)Tcl_Alloc(tsdPtr->pbuflen);
	tsdPtr->pbuf = ckalloc(tsdPtr->pbuflen);
	Tcl_CreateThreadExitHandler(FreePwBuf, NULL);
    }
    while (1) {
	int e = getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, tsdPtr->pbuflen,
		&pwPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->pbuflen *= 2;
	tsdPtr->pbuf = (char *)Tcl_Realloc(tsdPtr->pbuf, tsdPtr->pbuflen);
	tsdPtr->pbuf = ckrealloc(tsdPtr->pbuf, tsdPtr->pbuflen);
    }
    return (pwPtr != NULL ? &tsdPtr->pwd : NULL);

#elif defined(HAVE_GETPWUID_R_4)
    return getpwuid_r(uid, &tsdPtr->pwd, tsdPtr->pbuf, sizeof(tsdPtr->pbuf));

#else
330
331
332
333
334
335
336
337

338
339
340
341

342
343
344
345
346
347
348
332
333
334
335
336
337
338

339
340
341
342

343
344
345
346
347
348
349
350







-
+



-
+







 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_PW_CLEANER
static void
FreePwBuf(
    TCL_UNUSED(ClientData))
    ClientData ignored)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_Free(tsdPtr->pbuf);
    ckfree(tsdPtr->pbuf);
}
#endif /* NEED_PW_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetGrNam --
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
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







-
+


















-
+












-
+







 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrNam(
    const char *name)
{
#if !TCL_THREADS
#if !defined(TCL_THREADS)
    return getgrnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRNAM_R_5)
    struct group *grPtr = NULL;

    /*
     * How to allocate a buffer of the right initial size. If you want the
     * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
     * and weep.
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = (char *)Tcl_Alloc(tsdPtr->gbuflen);
	tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = (char *)Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen);
	tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRNAM_R_4)
    return getgrnam_r(name, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
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
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







-
+


















-
+












-
+







 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrGid(
    gid_t gid)
{
#if !TCL_THREADS
#if !defined(TCL_THREADS)
    return getgrgid(gid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRGID_R_5)
    struct group *grPtr = NULL;

    /*
     * How to allocate a buffer of the right initial size. If you want the
     * gory detail, see http://www.opengroup.org/austin/docs/austin_328.txt
     * and weep.
     */

    if (tsdPtr->gbuf == NULL) {
	tsdPtr->gbuflen = (int) sysconf(_SC_GETGR_R_SIZE_MAX);
	if (tsdPtr->gbuflen < 1) {
	    tsdPtr->gbuflen = 1024;
	}
	tsdPtr->gbuf = (char *)Tcl_Alloc(tsdPtr->gbuflen);
	tsdPtr->gbuf = ckalloc(tsdPtr->gbuflen);
	Tcl_CreateThreadExitHandler(FreeGrBuf, NULL);
    }
    while (1) {
	int e = getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, tsdPtr->gbuflen,
		&grPtr);

	if (e == 0) {
	    break;
	} else if (e != ERANGE) {
	    return NULL;
	}
	tsdPtr->gbuflen *= 2;
	tsdPtr->gbuf = (char *)Tcl_Realloc(tsdPtr->gbuf, tsdPtr->gbuflen);
	tsdPtr->gbuf = ckrealloc(tsdPtr->gbuf, tsdPtr->gbuflen);
    }
    return (grPtr != NULL ? &tsdPtr->grp : NULL);

#elif defined(HAVE_GETGRGID_R_4)
    return getgrgid_r(gid, &tsdPtr->grp, tsdPtr->gbuf, sizeof(tsdPtr->gbuf));

#else
513
514
515
516
517
518
519
520

521
522
523
524

525
526
527
528
529
530
531
515
516
517
518
519
520
521

522
523
524
525

526
527
528
529
530
531
532
533







-
+



-
+







 *
 *---------------------------------------------------------------------------
 */

#ifdef NEED_GR_CLEANER
static void
FreeGrBuf(
    TCL_UNUSED(ClientData))
    ClientData ignored)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_Free(tsdPtr->gbuf);
    ckfree(tsdPtr->gbuf);
}
#endif /* NEED_GR_CLEANER */

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetHostByName --
542
543
544
545
546
547
548
549

550
551
552
553
554
555
556
544
545
546
547
548
549
550

551
552
553
554
555
556
557
558







-
+







 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByName(
    const char *name)
{
#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYNAME)
#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME)
    return gethostbyname(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYNAME_R_5)
    int h_errno;

612
613
614
615
616
617
618
619

620
621
622
623
624
625
626
614
615
616
617
618
619
620

621
622
623
624
625
626
627
628







-
+








struct hostent *
TclpGetHostByAddr(
    const char *addr,
    int length,
    int type)
{
#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYADDR)
#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR)
    return gethostbyaddr(addr, length, type);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYADDR_R_7)
    int h_errno;

679
680
681
682
683
684
685
686
687


688
689
690
691
692
693
694
681
682
683
684
685
686
687


688
689
690
691
692
693
694
695
696







-
-
+
+








static int
CopyGrp(
    struct group *tgtPtr,
    char *buf,
    int buflen)
{
    char *p = buf;
    int copied, len = 0;
    register char *p = buf;
    register int copied, len = 0;

    /*
     * Copy username.
     */

    copied = CopyString(tgtPtr->gr_name, p, buflen - len);
    if (copied == -1) {
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
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







-
+















-
+










-
+


-
+







    int elsize,			/* Size of each element, or -1 to indicate
				 * that they are C strings of dynamic
				 * length. */
    char *buf,			/* Buffer to copy into. */
    int buflen)			/* Size of buffer. */
{
    int i, j, len = 0;
    char *p, **newBuffer;
    char *p, **new;

    if (src == NULL) {
	return 0;
    }

    for (i = 0; src[i] != NULL; i++) {
	/*
	 * Empty loop to count how many.
	 */
    }
    len = sizeof(char *) * (i + 1);	/* Leave place for the array. */
    if (len >  buflen) {
	return -1;
    }

    newBuffer = (char **)buf;
    new = (char **) buf;
    p = buf + len;

    for (j = 0; j < i; j++) {
	int sz = (elsize<0 ? (int) strlen(src[j]) + 1 : elsize);

	len += sz;
	if (len > buflen) {
	    return -1;
	}
	memcpy(p, src[j], sz);
	newBuffer[j] = p;
	new[j] = p;
	p = buf + len;
    }
    newBuffer[j] = NULL;
    new[j] = NULL;

    return len;
}
#endif /* NEED_COPYARRAY */

/*
 *---------------------------------------------------------------------------
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
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







-
-
-
-
-
-
-
-



















-
-
+
+







	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.
 *
 * Side effects:
 *	If successful, stores EAX, EBX, ECX and EDX registers after the CPUID
 *	instruction in the four integers designated by 'regsPtr'
 *
 *----------------------------------------------------------------------
 */

int
TclWinCPUID(
    int index,		/* Which CPUID value to retrieve. */
    int *regsPtr)	/* Registers after the CPUID. */
    unsigned int index,		/* Which CPUID value to retrieve. */
    unsigned int *regsPtr)	/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

    /* See: <http://en.wikipedia.org/wiki/CPUID> */
#if defined(HAVE_CPUID)
#if defined(__x86_64__) || defined(_M_AMD64) || defined (_M_X64)
    __asm__ __volatile__("movq %%rbx, %%rsi     \n\t" /* save %rbx */
1006
1007
1008
1009
1010
1011
1012
1013

1014
1015
1016
1017
1018
1019
1020
1000
1001
1002
1003
1004
1005
1006

1007
1008
1009
1010
1011
1012
1013
1014







-
+







                 : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3])
                 : "a"(index));
#endif
    status = TCL_OK;
#endif
    return status;
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixEvent.c.

60
61
62
63
64
65
66
67

68
69
70
71
72
73
74
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74







-
+








	if (vdelay.usec < 0) {
	    vdelay.usec += 1000000;
	    vdelay.sec  -= 1;
	}

	if ((vdelay.sec != 0) || (vdelay.usec != 0)) {
	    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
	    (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
	}

	delay.tv_sec  = vdelay.sec;
	delay.tv_usec = vdelay.usec;

	/*
	 * Special note: must convert delay.tv_sec to int before comparing to

Changes to unix/tclUnixFCmd.c.

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
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







+
+




-
+













-
-
-
-
-
-
-
-
-
-



















-
-
-
+
+
+

-
+








-
+









-
+

+
+
+
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+


-
-
-




-
+


+
-
+
-
-
-
-
-
-
-
-
-
+
+


-
-
-






-
+
-
-
+
-

-
-
-


-
-
+
+
-
-
-








-
+




















-
-
+
+
-
-
-
-
+
+
+


-
+

-
+
-
-
+

-
+
-
-
+












-
+



-
+






-
-
+
+


-
+









-
+

-
+

-
-
-
-
-





-
+










-
+

-
+







 * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 * DAMAGE.
 */

#include "tclInt.h"
#include <utime.h>
#include <grp.h>
#ifndef HAVE_STRUCT_STAT_ST_BLKSIZE
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#endif
#ifdef HAVE_FTS
#include <fts.h>
#endif

/*
 * The following constants specify the type of callback when
 * TraverseUnixTree() calls the traverseProc()
 */

#define DOTREE_PRED	1	/* pre-order directory */
#define DOTREE_POSTD	2	/* post-order directory */
#define DOTREE_F	3	/* regular file */

/*
 * Fallback temporary file location the temporary file generation code. Can be
 * overridden at compile time for when it is known that temp files can't be
 * written to /tmp (hello, iOS!).
 */

#ifndef TCL_TEMPORARY_FILE_DIRECTORY
#define TCL_TEMPORARY_FILE_DIRECTORY	"/tmp"
#endif

/*
 * Callbacks for file attributes code.
 */

static int		GetGroupAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
static int		GetOwnerAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
static int		GetPermissionsAttribute(Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName,
			    Tcl_Obj **attributePtrPtr);
static int		SetGroupAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
static int		SetOwnerAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
static int		SetPermissionsAttribute(Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName,
			    Tcl_Obj *attributePtr);
static int		GetModeFromPermString(Tcl_Interp *interp,
			    const char *modeStringPtr, mode_t *modePtr);
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
static int		GetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
			    char *modeStringPtr, mode_t *modePtr);
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
static int		GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr);
static int		SetUnixFileAttributes(Tcl_Interp *interp, int objIndex,
static int		SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex,
			    Tcl_Obj *fileName, Tcl_Obj *attributePtr);
#endif

/*
 * Prototype for the TraverseUnixTree callback function.
 */

typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
	const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr);
	CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr);

/*
 * Constants and variables necessary for file attributes subcommand.
 *
 * IMPORTANT: The permissions attribute is assumed to be the third item (i.e.
 * to be indexed with '2' in arrays) in code in tclIOUtil.c and possibly
 * elsewhere in Tcl's core.
 */

#ifndef DJGPP
#ifdef DJGPP

/*
 * See contrib/djgpp/tclDjgppFCmd.c for definition.
 */
enum {
#if defined(__CYGWIN__)

extern TclFileAttrProcs tclpFileAttrProcs[];
extern char *tclpFileAttrStrings[];

    UNIX_ARCHIVE_ATTRIBUTE,
#endif
#else
    UNIX_GROUP_ATTRIBUTE,
#if defined(__CYGWIN__)
    UNIX_HIDDEN_ATTRIBUTE,
#endif
    UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
enum {
    UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
    UNIX_READONLY_ATTRIBUTE,
#endif
#if defined(__CYGWIN__)
    UNIX_SYSTEM_ATTRIBUTE,
#endif
#ifdef MAC_OSX_TCL
    MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE,
    MACOSX_RSRCLENGTH_ATTRIBUTE,
#endif
    UNIX_INVALID_ATTRIBUTE
    UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */
};

MODULE_SCOPE CONST char *tclpFileAttrStrings[];
const char *const tclpFileAttrStrings[] = {
CONST char *tclpFileAttrStrings[] = {
#if defined(__CYGWIN__)
    "-archive",
#endif
    "-group",
#if defined(__CYGWIN__)
    "-hidden",
#endif
    "-owner", "-permissions",
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
    "-group", "-owner", "-permissions",
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
    "-readonly",
#endif
#if defined(__CYGWIN__)
    "-system",
#endif
#ifdef MAC_OSX_TCL
    "-creator", "-type", "-hidden", "-rsrclength",
#endif
    NULL
};

const TclFileAttrProcs tclpFileAttrProcs[] = {
MODULE_SCOPE CONST TclFileAttrProcs tclpFileAttrProcs[];
#if defined(__CYGWIN__)
    {GetUnixFileAttributes, SetUnixFileAttributes},
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
#endif
    {GetGroupAttribute, SetGroupAttribute},
#if defined(__CYGWIN__)
    {GetUnixFileAttributes, SetUnixFileAttributes},
#endif
    {GetOwnerAttribute, SetOwnerAttribute},
    {GetPermissionsAttribute, SetPermissionsAttribute},
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__)
    {GetUnixFileAttributes, SetUnixFileAttributes},
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
    {GetReadOnlyAttribute, SetReadOnlyAttribute},
#endif
#if defined(__CYGWIN__)
    {GetUnixFileAttributes, SetUnixFileAttributes},
#endif
#ifdef MAC_OSX_TCL
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
#endif
};
#endif /* DJGPP */
#endif

/*
 * This is the maximum number of consecutive readdir/unlink calls that can be
 * made (with no intervening rewinddir or closedir/opendir) before triggering
 * a bug that makes readdir return NULL even though some directory entries
 * have not been processed. The bug afflicts SunOS's readdir when applied to
 * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the
 * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We
 * can't do a general rewind on failure as NFS can create special files that
 * recreate themselves when you try and delete them. 8.4.8 added a solution
 * that was affected by a single such NFS file, this solution should not be
 * affected by less than THRESHOLD such files. [Bug 1034337]
 */

#define MAX_READDIR_UNLINK_THRESHOLD 130

/*
 * Declarations for local procedures defined in this file:
 */

static int		CopyFileAtts(const char *src,
			    const char *dst, const Tcl_StatBuf *statBufPtr);
static int		CopyFileAtts(CONST char *src,
			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr);
static const char *	DefaultTempDir(void);
static int		DoCopyFile(const char *srcPtr, const char *dstPtr,
			    const Tcl_StatBuf *statBufPtr);
static int		DoCreateDirectory(const char *pathPtr);
static int		DoCopyFile(CONST char *srcPtr, CONST char *dstPtr,
			    CONST Tcl_StatBuf *statBufPtr);
static int		DoCreateDirectory(CONST char *pathPtr);
static int		DoRemoveDirectory(Tcl_DString *pathPtr,
			    int recursive, Tcl_DString *errorPtr);
static int		DoRenameFile(const char *src, const char *dst);
static int		DoRenameFile(CONST char *src, CONST char *dst);
static int		TraversalCopy(Tcl_DString *srcPtr,
			    Tcl_DString *dstPtr,
			    Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr,
			    const Tcl_StatBuf *statBufPtr, int type,
			    Tcl_DString *errorPtr);
			    int type, Tcl_DString *errorPtr);
static int		TraversalDelete(Tcl_DString *srcPtr,
			    Tcl_DString *dstPtr,
			    Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr,
			    const Tcl_StatBuf *statBufPtr, int type,
			    Tcl_DString *errorPtr);
			    int type, Tcl_DString *errorPtr);
static int		TraverseUnixTree(TraversalProc *traversalProc,
			    Tcl_DString *sourcePtr, Tcl_DString *destPtr,
			    Tcl_DString *errorPtr, int doRewind);

#ifdef PURIFY
/*
 * realpath and purify don't mix happily. It has been noted that realpath
 * should not be used with purify because of bogus warnings, but just
 * memset'ing the resolved path will squelch those. This assumes we are
 * passing the standard MAXPATHLEN size resolved arg.
 */

static char *		Realpath(const char *path, char *resolved);
static char *		Realpath(CONST char *path, char *resolved);

char *
Realpath(
    const char *path,
    CONST char *path,
    char *resolved)
{
    memset(resolved, 0, MAXPATHLEN);
    return realpath(path, resolved);
}
#else
#   define Realpath	realpath
#endif /* PURIFY */
#define Realpath realpath
#endif

#ifndef NO_REALPATH
#if defined(__APPLE__) && TCL_THREADS && \
#if defined(__APPLE__) && defined(TCL_THREADS) && \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1030
/*
 * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we
 * might potentially be running on pre-10.3 OSX, check Darwin release at
 * runtime before using realpath.
 */

MODULE_SCOPE long tclMacOSXDarwinRelease;
#   define haveRealpath	(tclMacOSXDarwinRelease >= 7)
#define haveRealpath (tclMacOSXDarwinRelease >= 7)
#else
#   define haveRealpath	1
#define haveRealpath 1
#endif
#else /* NO_REALPATH */
/*
 * At least TclpObjNormalizedPath now requires REALPATH
*/
#error NO_REALPATH is not supported
#endif /* NO_REALPATH */

#ifdef HAVE_FTS
#if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
/* fts doesn't do stat64 */
#   define noFtsStat	1
#define noFtsStat 1
#elif defined(__APPLE__) && defined(__LP64__) && \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1050
/*
 * Prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a
 * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check
 * Darwin release at runtime and do a separate stat() if necessary.
 */

MODULE_SCOPE long tclMacOSXDarwinRelease;
#   define noFtsStat	(tclMacOSXDarwinRelease < 9)
#define noFtsStat (tclMacOSXDarwinRelease < 9)
#else
#   define noFtsStat	0
#define noFtsStat 0
#endif
#endif /* HAVE_FTS */

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjRenameFile, DoRenameFile --
320
321
322
323
324
325
326
327
328


329
330
331
332
333

334
335

336
337
338
339
340
341
342
285
286
287
288
289
290
291


292
293
294
295
296
297

298
299

300
301
302
303
304
305
306
307







-
-
+
+




-
+

-
+







 */

int
TclpObjRenameFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    return DoRenameFile((const char *)Tcl_FSGetNativePath(srcPathPtr),
	    (const char *)Tcl_FSGetNativePath(destPathPtr));
    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
	    Tcl_FSGetNativePath(destPathPtr));
}

static int
DoRenameFile(
    const char *src,		/* Pathname of file or dir to be renamed
    CONST char *src,		/* Pathname of file or dir to be renamed
				 * (native). */
    const char *dst)		/* New pathname of file or directory
    CONST char *dst)		/* New pathname of file or directory
				 * (native). */
{
    if (rename(src, dst) == 0) {			/* INTL: Native. */
	return TCL_OK;
    }
    if (errno == ENOTEMPTY) {
	errno = EEXIST;
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
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







-
+






-
+




-
-
-
+
+
+







 */

int
TclpObjCopyFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    const char *src = (const char *)Tcl_FSGetNativePath(srcPathPtr);
    CONST char *src = Tcl_FSGetNativePath(srcPathPtr);
    Tcl_StatBuf srcStatBuf;

    if (TclOSlstat(src, &srcStatBuf) != 0) {		/* INTL: Native. */
	return TCL_ERROR;
    }

    return DoCopyFile(src, (const char *)Tcl_FSGetNativePath(destPathPtr), &srcStatBuf);
    return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf);
}

static int
DoCopyFile(
    const char *src,		/* Pathname of file to be copied (native). */
    const char *dst,		/* Pathname of file to copy to (native). */
    const Tcl_StatBuf *statBufPtr)
    CONST char *src,		/* Pathname of file to be copied (native). */
    CONST char *dst,		/* Pathname of file to copy to (native). */
    CONST Tcl_StatBuf *statBufPtr)
				/* Used to determine filetype. */
{
    Tcl_StatBuf dstStatBuf;

    if (S_ISDIR(statBufPtr->st_mode)) {
	errno = EISDIR;
	return TCL_ERROR;
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
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







-
+


-
+
-



-
-
+
+







-
+







	    return TCL_ERROR;
	}
    }

    switch ((int) (statBufPtr->st_mode & S_IFMT)) {
#ifndef DJGPP
    case S_IFLNK: {
	char linkBuf[MAXPATHLEN+1];
	char link[MAXPATHLEN];
	int length;

	length = readlink(src, linkBuf, MAXPATHLEN);
	length = readlink(src, link, sizeof(link));	/* INTL: Native. */
							/* INTL: Native. */
	if (length == -1) {
	    return TCL_ERROR;
	}
	linkBuf[length] = '\0';
	if (symlink(linkBuf, dst) < 0) {		/* INTL: Native. */
	link[length] = '\0';
	if (symlink(link, dst) < 0) {			/* INTL: Native. */
	    return TCL_ERROR;
	}
#ifdef MAC_OSX_TCL
	TclMacOSXCopyFileAttributes(src, dst, statBufPtr);
#endif
	break;
    }
#endif /* !DJGPP */
#endif
    case S_IFBLK:
    case S_IFCHR:
	if (mknod(dst, statBufPtr->st_mode,		/* INTL: Native. */
		statBufPtr->st_rdev) < 0) {
	    return TCL_ERROR;
	}
	return CopyFileAtts(src, dst, statBufPtr);
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
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







-
-
+
+

-
+




-
+







-
+
-
-







 *	A file is copied. Dst will be overwritten if it exists.
 *
 *----------------------------------------------------------------------
 */

int
TclUnixCopyFile(
    const char *src,		/* Pathname of file to copy (native). */
    const char *dst,		/* Pathname of file to create/overwrite
    CONST char *src,		/* Pathname of file to copy (native). */
    CONST char *dst,		/* Pathname of file to create/overwrite
				 * (native). */
    const Tcl_StatBuf *statBufPtr,
    CONST Tcl_StatBuf *statBufPtr,
				/* Used to determine mode and blocksize. */
    int dontCopyAtts)		/* If flag set, don't copy attributes. */
{
    int srcFd, dstFd;
    size_t blockSize;		/* Optimal I/O blocksize for filesystem */
    unsigned blockSize;		/* Optimal I/O blocksize for filesystem */
    char *buffer;		/* Data buffer for copy */
    size_t nread;

#ifdef DJGPP
#define BINMODE |O_BINARY
#else
#define BINMODE
#endif /* DJGPP */
#endif

#define DEFAULT_COPY_BLOCK_SIZE 4096

    if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */
	return TCL_ERROR;
    }

    dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY BINMODE, /* INTL: Native */
	    statBufPtr->st_mode);
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
618

619
620

621
622
623
624
625
626
627
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







-
+



-
+











-
+

-
+

-
-
+
+



-
+




-
+

-
+







#elif !defined(NO_FSTATFS)
    {
	struct statfs fs;

	if (fstatfs(srcFd, &fs) == 0) {
	    blockSize = fs.f_bsize;
	} else {
	    blockSize = DEFAULT_COPY_BLOCK_SIZE;
	    blockSize = 4096;
	}
    }
#else
    blockSize = DEFAULT_COPY_BLOCK_SIZE;
    blockSize = 4096;
#endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */

    /*
     * [SF Tcl Bug 1586470] Even if we HAVE_STRUCT_STAT_ST_BLKSIZE, there are
     * filesystems which report a bogus value for the blocksize. An example
     * is the Andrew Filesystem (afs), reporting a blocksize of 0. When
     * detecting such a situation we now simply fall back to a hardwired
     * default size.
     */

    if (blockSize <= 0) {
	blockSize = DEFAULT_COPY_BLOCK_SIZE;
	blockSize = 4096;
    }
    buffer = (char *)Tcl_Alloc(blockSize);
    buffer = ckalloc(blockSize);
    while (1) {
	nread = read(srcFd, buffer, blockSize);
	if ((nread == TCL_IO_FAILURE) || (nread == 0)) {
	nread = (size_t) read(srcFd, buffer, blockSize);
	if ((nread == (size_t) -1) || (nread == 0)) {
	    break;
	}
	if ((size_t) write(dstFd, buffer, nread) != nread) {
	    nread = TCL_IO_FAILURE;
	    nread = (size_t) -1;
	    break;
	}
    }

    Tcl_Free(buffer);
    ckfree(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == TCL_IO_FAILURE)) {
    if ((close(dstFd) != 0) || (nread == (size_t) -1)) {
	unlink(dst);					/* INTL: Native. */
	return TCL_ERROR;
    }
    if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
	/*
	 * The copy succeeded, but setting the permissions failed, so be in a
	 * consistent state, we remove the file that was created by the copy.
660
661
662
663
664
665
666
667

668
669

670
671
672
673
674
675
676
622
623
624
625
626
627
628

629
630

631
632
633
634
635
636
637
638







-
+

-
+







    Tcl_Obj *pathPtr)
{
    return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}

int
TclpDeleteFile(
    const void *path)		/* Pathname of file to be removed (native). */
    CONST char *path)		/* Pathname of file to be removed (native). */
{
    if (unlink((const char *)path) != 0) {
    if (unlink(path) != 0) {				/* INTL: Native. */
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
698
699
700
701
702
703
704
705

706
707
708
709
710

711
712
713
714
715
716
717
660
661
662
663
664
665
666

667
668
669
670
671

672
673
674
675
676
677
678
679







-
+




-
+







 *---------------------------------------------------------------------------
 */

int
TclpObjCreateDirectory(
    Tcl_Obj *pathPtr)
{
    return DoCreateDirectory((const char *)Tcl_FSGetNativePath(pathPtr));
    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}

static int
DoCreateDirectory(
    const char *path)		/* Pathname of directory to create (native). */
    CONST char *path)		/* Pathname of directory to create (native). */
{
    mode_t mode;

    mode = umask(0);
    umask(mode);

    /*
850
851
852
853
854
855
856
857

858
859
860
861
862
863
864
812
813
814
815
816
817
818

819
820
821
822
823
824
825
826







-
+







    int recursive,		/* If non-zero, removes directories that are
				 * nonempty. Otherwise, will only remove empty
				 * directories. */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    const char *path;
    CONST char *path;
    mode_t oldPerm = 0;
    int result;

    path = Tcl_DStringValue(pathPtr);

    if (recursive != 0) {
	/*
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
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







-
-
-
+
+
+





-
+






-
+











-
+












-
+






-
+



-
+







    				 * loop should be rewound whenever
    				 * traverseProc has returned TCL_OK; this is
    				 * required when traverseProc modifies the
    				 * source hierarchy, e.g. by deleting
    				 * files. */
{
    Tcl_StatBuf statBuf;
    const char *source, *errfile;
    int result;
    size_t targetLen, sourceLen;
    CONST char *source, *errfile;
    int result, sourceLen;
    int targetLen;
#ifndef HAVE_FTS
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    TclDIR *dirPtr;
#else
    const char *paths[2] = {NULL, NULL};
    CONST char *paths[2] = {NULL, NULL};
    FTS *fts = NULL;
    FTSENT *ent;
#endif

    errfile = NULL;
    result = TCL_OK;
    targetLen = 0;
    targetLen = 0;		/* lint. */

    source = Tcl_DStringValue(sourcePtr);
    if (TclOSlstat(source, &statBuf) != 0) {		/* INTL: Native. */
	errfile = source;
	goto end;
    }
    if (!S_ISDIR(statBuf.st_mode)) {
	/*
	 * Process the regular file
	 */

	return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F,
	return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F,
		errorPtr);
    }
#ifndef HAVE_FTS
    dirPtr = TclOSopendir(source);			/* INTL: Native. */
    if (dirPtr == NULL) {
	/*
	 * Can't read directory
	 */

	errfile = source;
	goto end;
    }
    result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
    result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED,
	    errorPtr);
    if (result != TCL_OK) {
	TclOSclosedir(dirPtr);
	return result;
    }

    TclDStringAppendLiteral(sourcePtr, "/");
    Tcl_DStringAppend(sourcePtr, "/", 1);
    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {
	TclDStringAppendLiteral(targetPtr, "/");
	Tcl_DStringAppend(targetPtr, "/", 1);
	targetLen = Tcl_DStringLength(targetPtr);
    }

    while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
	if ((dirEntPtr->d_name[0] == '.')
		&& ((dirEntPtr->d_name[1] == '\0')
			|| (strcmp(dirEntPtr->d_name, "..") == 0))) {
1062
1063
1064
1065
1066
1067
1068
1069

1070
1071
1072
1073
1074

1075
1076
1077
1078
1079
1080
1081
1024
1025
1026
1027
1028
1029
1030

1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1043







-
+




-
+








    if (result == TCL_OK) {
	/*
	 * Call traverseProc() on a directory after visiting all the files in
	 * that directory.
	 */

	result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD,
	result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD,
		errorPtr);
    }
#else /* HAVE_FTS */
    paths[0] = source;
    fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR |
    fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR |
	    (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL);
    if (fts == NULL) {
	errfile = source;
	goto end;
    }

    sourceLen = Tcl_DStringLength(sourcePtr);
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
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







-
+









-
+







		    errfile = ent->fts_path;
		    break;
		}
	    } else {
		statBufPtr = (Tcl_StatBuf *) ent->fts_statp;
	    }
	}
	result = traverseProc(sourcePtr, targetPtr, statBufPtr, type,
	result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type,
		errorPtr);
	if (result != TCL_OK) {
	    break;
	}
	Tcl_DStringSetLength(sourcePtr, sourceLen);
	if (targetPtr != NULL) {
	    Tcl_DStringSetLength(targetPtr, targetLen);
	}
    }
#endif /* !HAVE_FTS */
#endif /* HAVE_FTS */

  end:
    if (errfile != NULL) {
	if (errorPtr != NULL) {
	    Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr);
	}
	result = TCL_ERROR;
1166
1167
1168
1169
1170
1171
1172
1173

1174
1175
1176
1177
1178
1179
1180
1128
1129
1130
1131
1132
1133
1134

1135
1136
1137
1138
1139
1140
1141
1142







-
+







 *----------------------------------------------------------------------
 */

static int
TraversalCopy(
    Tcl_DString *srcPtr,	/* Source pathname to copy (native). */
    Tcl_DString *dstPtr,	/* Destination pathname of copy (native). */
    const Tcl_StatBuf *statBufPtr,
    CONST Tcl_StatBuf *statBufPtr,
				/* Stat info for file specified by srcPtr. */
    int type,			/* Reason for call - see TraverseUnixTree(). */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    switch (type) {
1229
1230
1231
1232
1233
1234
1235
1236
1237



1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1191
1192
1193
1194
1195
1196
1197


1198
1199
1200
1201
1202
1203
1204
1205

1206
1207
1208
1209
1210
1211
1212







-
-
+
+
+





-







 *
 *----------------------------------------------------------------------
 */

static int
TraversalDelete(
    Tcl_DString *srcPtr,	/* Source pathname (native). */
    TCL_UNUSED(Tcl_DString *),
    TCL_UNUSED(const Tcl_StatBuf *),
    Tcl_DString *ignore,	/* Destination pathname (not used). */
    CONST Tcl_StatBuf *statBufPtr,
				/* Stat info for file specified by srcPtr. */
    int type,			/* Reason for call - see TraverseUnixTree(). */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{

    switch (type) {
    case DOTREE_F:
	if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) {
	    return TCL_OK;
	}
	break;
    case DOTREE_PRED:
1278
1279
1280
1281
1282
1283
1284
1285
1286

1287
1288
1289
1290
1291


1292
1293
1294
1295
1296
1297
1298
1240
1241
1242
1243
1244
1245
1246


1247





1248
1249
1250
1251
1252
1253
1254
1255
1256







-
-
+
-
-
-
-
-
+
+







 *	access time are updated in the new file to reflect the old file.
 *
 *---------------------------------------------------------------------------
 */

static int
CopyFileAtts(
#ifdef MAC_OSX_TCL
    const char *src,	/* Path name of source file (native). */
    CONST char *src,		/* Path name of source file (native). */
#else
    TCL_UNUSED(const char *) /*src*/,
#endif
    const char *dst,		/* Path name of target file (native). */
    const Tcl_StatBuf *statBufPtr)
    CONST char *dst,		/* Path name of target file (native). */
    CONST Tcl_StatBuf *statBufPtr)
				/* Stat info for source file */
{
    struct utimbuf tval;
    mode_t newMode;

    newMode = statBufPtr->st_mode
	    & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);
1308
1309
1310
1311
1312
1313
1314
1315
1316


1317
1318
1319
1320
1321
1322
1323
1266
1267
1268
1269
1270
1271
1272


1273
1274
1275
1276
1277
1278
1279
1280
1281







-
-
+
+







    if (chmod(dst, newMode)) {				/* INTL: Native. */
	newMode &= ~(S_ISUID | S_ISGID);
	if (chmod(dst, newMode)) {			/* INTL: Native. */
	    return TCL_ERROR;
	}
    }

    tval.actime = Tcl_GetAccessTimeFromStat(statBufPtr);
    tval.modtime = Tcl_GetModificationTimeFromStat(statBufPtr);
    tval.actime = statBufPtr->st_atime;
    tval.modtime = statBufPtr->st_mtime;

    if (utime(dst, &tval)) {				/* INTL: Native. */
	return TCL_ERROR;
    }
#ifdef MAC_OSX_TCL
    TclMacOSXCopyFileAttributes(src, dst, statBufPtr);
#endif
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
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







-
+











-
-
-
+
+
+







-
+


-
+







 *
 *----------------------------------------------------------------------
 */

static int
GetGroupAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    struct group *groupPtr;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

    groupPtr = TclpGetGrGid(statBuf.st_gid);

    if (groupPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_gid);
	*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid);
    } else {
	Tcl_DString ds;
	const char *utf;
	CONST char *utf;

	utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds);
	*attributePtrPtr = Tcl_NewStringObj(utf, -1);
	Tcl_DStringFree(&ds);
    }
    return TCL_OK;
}
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
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
1385


1386
1387
1388
1389
1390
1391
1392
1393
1394
1395







-
+











-
-
-
+
+
+







-
+


+

-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
GetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    struct passwd *pwPtr;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	TclNewIntObj(*attributePtrPtr, statBuf.st_uid);
	*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
    } else {
	Tcl_DString ds;
	CONST char *utf;

	(void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
	*attributePtrPtr = TclDStringToObj(&ds);
	utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
	*attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+










-
-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
GetPermissionsAttribute(
    Tcl_Interp *interp,		    /* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		    /* The index of the attribute. */
    Tcl_Obj *fileName,		    /* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	    /* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_ObjPrintf(
	    "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF));
    return TCL_OK;
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
1531
1532
1533
1534
1535
1536



1537
1538
1539
1540
1541
1542
1543
1448
1449
1450
1451
1452
1453
1454

1455
1456
1457
1458

1459
1460

1461
1462

1463
1464
1465


1466
1467
1468

1469
1470
1471
1472
1473
1474
1475
1476


1477


1478


1479
1480
1481
1482
1483
1484
1485

1486
1487
1488
1489
1490



1491
1492
1493
1494
1495
1496
1497
1498
1499
1500







-
+



-
+

-
+

-
+


-
-
+
+

-
+







-
-
+
-
-
+
-
-
+






-
+




-
-
-
+
+
+







 *
 *---------------------------------------------------------------------------
 */

static int
SetGroupAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New group for file. */
{
    Tcl_WideInt gid;
    long gid;
    int result;
    const char *native;
    CONST char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) {
    if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
	Tcl_DString ds;
	struct group *groupPtr = NULL;
	const char *string;
	size_t length;
	CONST char *string;
	int length;

	string = TclGetStringFromObj(attributePtr, &length);
	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	groupPtr = TclpGetGrNam(native); /* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (groupPtr == NULL) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not set group for file \"%s\":"
		Tcl_AppendResult(interp, "could not set group for file \"",
			" group \"%s\" does not exist",
			TclGetString(fileName), string));
			TclGetString(fileName), "\": group \"", string,
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP",
			"NO_GROUP", NULL);
			"\" does not exist", NULL);
	    }
	    return TCL_ERROR;
	}
	gid = groupPtr->gr_gid;
    }

    native = (const char *)Tcl_FSGetNativePath(fileName);
    native = Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) -1, (gid_t) gid);	/* INTL: Native. */

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set group for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not set group for file \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
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
1596

1597
1598
1599
1600
1601
1602
1603



1604
1605
1606
1607
1608
1609
1610
1512
1513
1514
1515
1516
1517
1518

1519
1520
1521
1522

1523
1524

1525
1526

1527
1528
1529


1530
1531
1532

1533
1534
1535
1536
1537
1538
1539
1540


1541


1542


1543
1544
1545
1546
1547
1548
1549

1550
1551
1552
1553
1554



1555
1556
1557
1558
1559
1560
1561
1562
1563
1564







-
+



-
+

-
+

-
+


-
-
+
+

-
+







-
-
+
-
-
+
-
-
+






-
+




-
-
-
+
+
+







 *
 *---------------------------------------------------------------------------
 */

static int
SetOwnerAttribute(
    Tcl_Interp *interp,		/* The interp for error reporting. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* New owner for file. */
{
    Tcl_WideInt uid;
    long uid;
    int result;
    const char *native;
    CONST char *native;

    if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) {
    if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
	Tcl_DString ds;
	struct passwd *pwPtr = NULL;
	const char *string;
	size_t length;
	CONST char *string;
	int length;

	string = TclGetStringFromObj(attributePtr, &length);
	string = Tcl_GetStringFromObj(attributePtr, &length);

	native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
	pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
	Tcl_DStringFree(&ds);

	if (pwPtr == NULL) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not set owner for file \"%s\":"
		Tcl_AppendResult(interp, "could not set owner for file \"",
			" user \"%s\" does not exist",
			TclGetString(fileName), string));
			TclGetString(fileName), "\": user \"", string,
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN",
			"NO_USER", NULL);
			"\" does not exist", NULL);
	    }
	    return TCL_ERROR;
	}
	uid = pwPtr->pw_uid;
    }

    native = (const char *)Tcl_FSGetNativePath(fileName);
    native = Tcl_FSGetNativePath(fileName);
    result = chown(native, (uid_t) uid, (gid_t) -1);	/* INTL: Native. */

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set owner for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not set owner for file \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
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
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
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
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







-
+



-
+


-
-
+
+














-
+



-
+














-
-
-
+
+
+







-
-
-
+
+
-





-
+



-
-
-
+
+
+







 *
 *---------------------------------------------------------------------------
 */

static int
SetPermissionsAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    Tcl_WideInt mode;
    long mode;
    mode_t newMode;
    int result = TCL_ERROR;
    const char *native;
    const char *modeStringPtr = TclGetString(attributePtr);
    CONST char *native;
    char *modeStringPtr = TclGetString(attributePtr);
    int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);

    /*
     * First supply support for octal number format
     */

    if ((modeStringPtr[scanned] == '0')
	    && (modeStringPtr[scanned+1] >= '0')
	    && (modeStringPtr[scanned+1] <= '7')) {
	/* Leading zero - attempt octal interpretation */
	Tcl_Obj *modeObj;

	TclNewLiteralStringObj(modeObj, "0o");
	Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1);
	result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode);
	result = Tcl_GetLongFromObj(NULL, modeObj, &mode);
	Tcl_DecrRefCount(modeObj);
    }
    if (result == TCL_OK
	    || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	    || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) {
	newMode = (mode_t) (mode & 0x00007FFF);
    } else {
	Tcl_StatBuf buf;

	/*
	 * Try the forms "rwxrwxrwx" and "ugo=rwx"
	 *
	 * We get the current mode of the file, in order to allow for ug+-=rwx
	 * style chmod strings.
	 */

	result = TclpObjStat(fileName, &buf);
	if (result != 0) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"could not read \"%s\": %s",
			TclGetString(fileName), Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "could not read \"",
			TclGetString(fileName), "\": ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	newMode = (mode_t) (buf.st_mode & 0x00007FFF);

	if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"unknown permission string format \"%s\"",
			modeStringPtr));
		Tcl_AppendResult(interp, "unknown permission string format \"",
			modeStringPtr, "\"", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL);
	    }
	    return TCL_ERROR;
	}
    }

    native = (const char *)Tcl_FSGetNativePath(fileName);
    native = Tcl_FSGetNativePath(fileName);
    result = chmod(native, newMode);		/* INTL: Native. */
    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set permissions for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not set permissions for file \"",
		    TclGetString(fileName), "\": ",
		    Tcl_PosixError(interp), NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

#ifndef DJGPP
1716
1717
1718
1719
1720
1721
1722
1723

1724
1725
1726
1727
1728
1729
1730
1731
1668
1669
1670
1671
1672
1673
1674

1675

1676
1677
1678
1679
1680
1681
1682







-
+
-







 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpObjListVolumes(void)
{
    Tcl_Obj *resultPtr;
    Tcl_Obj *resultPtr = Tcl_NewStringObj("/", 1);
    TclNewLiteralStringObj(resultPtr, "/");

    Tcl_IncrRefCount(resultPtr);
    return resultPtr;
}
#endif

/*
1744
1745
1746
1747
1748
1749
1750
1751
1752


1753
1754
1755
1756
1757
1758
1759
1695
1696
1697
1698
1699
1700
1701


1702
1703
1704
1705
1706
1707
1708
1709
1710







-
-
+
+







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
GetModeFromPermString(
    TCL_UNUSED(Tcl_Interp *),
    const char *modeStringPtr, /* Permissions string */
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    char *modeStringPtr,	/* Permissions string */
    mode_t *modePtr)		/* pointer to the mode value */
{
    mode_t newMode;
    mode_t oldMode;		/* Storage for the value of the old mode (that
				 * is passed in), to allow for the chmod style
				 * manipulation. */
    int i,n, who, op, what, op_found, who_found;
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
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







-
+








-
+





-
+







	oldMode = *modePtr;
	who = op = what = op_found = who_found = 0;
	for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) {
	    if (!who_found) {
		/* who */
		switch (*(modeStringPtr+n+i)) {
		case 'u':
		    who |= 0x9C0;
		    who |= 0x9c0;
		    continue;
		case 'g':
		    who |= 0x438;
		    continue;
		case 'o':
		    who |= 0x207;
		    continue;
		case 'a':
		    who |= 0xFFF;
		    who |= 0xfff;
		    continue;
		}
	    }
	    who_found = 1;
	    if (who == 0) {
		who = 0xFFF;
		who = 0xfff;
	    }
	    if (!op_found) {
		/* op */
		switch (*(modeStringPtr+n+i)) {
		case '+':
		    op = 1;
		    op_found = 1;
1882
1883
1884
1885
1886
1887
1888
1889

1890
1891
1892
1893
1894
1895
1896
1833
1834
1835
1836
1837
1838
1839

1840
1841
1842
1843
1844
1845
1846
1847







-
+







	    case 'w':
		what |= 0x92;
		continue;
	    case 'x':
		what |= 0x49;
		continue;
	    case 's':
		what |= 0xC00;
		what |= 0xc00;
		continue;
	    case 't':
		what |= 0x200;
		continue;
	    case ',':
		break;
	    default:
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
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







-
-
+
+
+
+


-
-
+
+


+






-
-
+
+
-
-
+
-
-
-
-
-
+
-
-
+
+

-
-
+
-
-


+
+


+
+
+
+
+
+






-
-
-
-
+
+
+

+
-
+







-
+
-
-
-
+
-
-
-







}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjNormalizePath --
 *
 *	Replaces each component except that last one in a pathname that is a
 *	symbolic link with the fully resolved target of that link.
 *	This function scans through a path specification and replaces it, in
 *	place, with a normalized version. A normalized version is one in which
 *	all symlinks in the path are replaced with their expanded form (except
 *	a symlink at the very end of the path).
 *
 * Results:
 *	Stores the resulting path in pathPtr and returns the offset of the last
 *	byte processed to obtain the resulting path.
 *	The new 'nextCheckpoint' value, giving as far as we could understand
 *	in the path.
 *
 * Side effects:
 *	The pathPtr string, is modified.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *pathPtr,		/* An unshared object containing the path to
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr,
				 * normalize. */
    int nextCheckpoint)		/* offset to start at in pathPtr.  Must either
    int nextCheckpoint)
				 * be 0 or the offset of a directory separator
				 * at the end of a path part that is already
				 * normalized.  I.e. this is not the index of
				 * the byte just after the separator.  */

{
{
    const char *currentPathEndPosition;
    char *currentPathEndPosition;
    int pathLen;
    char cur;
    size_t pathLen;
    const char *path = TclGetStringFromObj(pathPtr, &pathLen);
    char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
    Tcl_DString ds;
    const char *nativePath;
#ifndef NO_REALPATH
    char normPath[MAXPATHLEN];
    Tcl_DString ds;
    CONST char *nativePath;
#endif

    /*
     * We add '1' here because if nextCheckpoint is zero we know that '/'
     * exists, and if it isn't zero, it must point at a directory separator
     * which we also know exists.
     */

    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
    }

#ifndef NO_REALPATH
    if (nextCheckpoint == 0 && haveRealpath) {
	/*
	 * Try to get the entire path in one go
	 */
    /*
     * For speed, try to get the entire path in one go.
     */

    if (nextCheckpoint == 0 && haveRealpath) {
	const char *lastDir = strrchr(currentPathEndPosition, '/');
	char *lastDir = strrchr(currentPathEndPosition, '/');

	if (lastDir != NULL) {
	    nativePath = Tcl_UtfToExternalDString(NULL, path,
		    lastDir-path, &ds);
	    if (Realpath(nativePath, normPath) != NULL) {
		if (*nativePath != '/' && *normPath == '/') {
		    /*
		     * realpath transformed a relative path into an
		     * realpath has transformed a relative path into an
		     * absolute path.  Fall back to the long way.
		     */

		     * absolute path, we do not know how to handle this.
		    /*
		     * To do: This logic seems to be out of date.  This whole
		     * routine should be reviewed and cleaed up.
		     */
		} else {
		    nextCheckpoint = lastDir - path;
		    goto wholeStringOk;
		}
	    }
	    Tcl_DStringFree(&ds);
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
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







+
+
















-
+





-
+








+
-
+
+
+




-
-
-
-
-
-
-
+
+
+
+
+
+

+



-
+

-
+






-
+





-
-
-
-
-
-
+
+
+
+
+
+
-










+
-
+



-
+



-
+








-
+
-











+
+
+
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+



-
+














-
+

-
+










-
-
-
+
+
+




+
-
+






-
+













-
+

-
+




-
-
+
+
+









-
-
-
+
+
+










-
+



-
-
-
+
+
+







    while (1) {
	cur = *currentPathEndPosition;
	if ((cur == '/') && (path != currentPathEndPosition)) {
	    /*
	     * Reached directory separator.
	     */

	    Tcl_DString ds;
	    CONST char *nativePath;
	    int accessOk;

	    nativePath = Tcl_UtfToExternalDString(NULL, path,
		    currentPathEndPosition - path, &ds);
	    accessOk = access(nativePath, F_OK);
	    Tcl_DStringFree(&ds);

	    if (accessOk != 0) {
		/*
		 * File doesn't exist.
		 */

		break;
	    }

	    /*
	     * Assign the end of the current component to nextCheckpoint
	     * Update the acceptable point.
	     */

	    nextCheckpoint = currentPathEndPosition - path;
	} else if (cur == 0) {
	    /*
	     * The end of the string.
	     * Reached end of string.
	     */

	    break;
	}
	currentPathEndPosition++;
    }

    /*
     * We should really now convert this to a canonical path. We do that with
     * Call 'realpath' to obtain a canonical path.
     * 'realpath' if we have it available. Otherwise we could step through
     * every single path component, checking whether it is a symlink, but that
     * would be a lot of work, and most modern OSes have 'realpath'.
     */

#ifndef NO_REALPATH
    if (haveRealpath) {
	if (nextCheckpoint == 0) {
	    /*
	     * The path contains at most one component, e.g. '/foo' or '/', so
	     * so there is nothing to resolve. Also, on some platforms
	     * 'Realpath' transforms an empty string into the normalized pwd,
	     * which is the wrong answer.
	     */
	/*
	 * If we only had '/foo' or '/' then we never increment nextCheckpoint
	 * and we don't need or want to go through 'Realpath'. Also, on some
	 * platforms, passing an empty string to 'Realpath' will give us the
	 * normalized pwd, which is not what we want at all!
	 */

	if (nextCheckpoint == 0) {
	    return 0;
	}

	nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
	nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
	if (Realpath(nativePath, normPath) != NULL) {
	    size_t newNormLen;
	    int newNormLen;

	wholeStringOk:
	    newNormLen = strlen(normPath);
	    if ((newNormLen == Tcl_DStringLength(&ds))
		    && (strcmp(normPath, nativePath) == 0)) {
		/*
		 * The original path is unchanged.
		 * String is unchanged.
		 */

		Tcl_DStringFree(&ds);

		/*
		 * Uncommenting this would mean that this native filesystem
		 * routine claims the path is normalized if the file exists,
		 * which would permit the caller to avoid iterating through
		 * other filesystems filesystems. Saving lots of calls is
		 * probably worth the extra access() time, but in the common
		 * case that no other filesystems are registered this is an
		 * Enable this to have the native FS claim normalization of
		 * the whole path for existing files. That would permit the
		 * caller to declare normalization complete without calls to
		 * additional filesystems. Saving lots of calls is probably
		 * worth the extra access() time here. When no other FS's are
		 * registered though, things are less clear.
		 * unnecessary expense.
		 *
		if (0 == access(normPath, F_OK)) {
		    return pathLen;
		}
		 */

		return nextCheckpoint;
	    }

	    /*
	     * Free up the native path and put in its place the converted,
	     * Free the original path and replace it with the normalized path.
	     * normalized path.
	     */

	    Tcl_DStringFree(&ds);
	    Tcl_ExternalToUtfDString(NULL, normPath, newNormLen, &ds);
	    Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds);

	    if (path[nextCheckpoint] != '\0') {
		/*
		 * Append the remaining path components.
		 * Not at end, append remaining path.
		 */

		int normLen = Tcl_DStringLength(&ds);

		Tcl_DStringAppend(&ds, path + nextCheckpoint,
			pathLen - nextCheckpoint);

		/*
		 * characters up to and including the directory separator have
		 * We recognise up to and including the directory separator.
		 * been processed
		 */

		nextCheckpoint = normLen + 1;
	    } else {
		/*
		 * We recognise the whole string.
		 */

		nextCheckpoint = Tcl_DStringLength(&ds);
	    }

	    /*
	     * Overwrite with the normalized path.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds),
		    Tcl_DStringLength(&ds));
	}
	Tcl_DStringFree(&ds);
    }
#endif	/* !NO_REALPATH */

    return nextCheckpoint;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenTemporaryFile, TclUnixOpenTemporaryFile --
 *
 *	Creates a temporary file, possibly based on the supplied bits and
 *	pieces of template supplied in the first three arguments. If the
 *	fourth argument is non-NULL, it contains a Tcl_Obj to store the name
 *	of the temporary file in (and it is caller's responsibility to clean
 *	up). If the fourth argument is NULL, try to arrange for the temporary
 *	file to go away once it is no longer needed.
 *
 * Results:
 *	A read-write Tcl Channel open on the file for TclpOpenTemporaryFile,
 *	or a file descriptor (or -1 on failure) for TclUnixOpenTemporaryFile.
 *
 * Side effects:
 *	Accesses the filesystem. Will set the contents of the Tcl_Obj fourth
 *	argument (if that is non-NULL).
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
TclpOpenTemporaryFile(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj,
    Tcl_Obj *extensionObj,
    Tcl_Obj *resultingNameObj)
{
    int fd = TclUnixOpenTemporaryFile(dirObj, basenameObj, extensionObj,
	    resultingNameObj);

    if (fd == -1) {
	return NULL;
    }
    return Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE);
}

int
TclUnixOpenTemporaryFile(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj,
    Tcl_Obj *extensionObj,
    Tcl_Obj *resultingNameObj)
{
    Tcl_DString templ, tmp;
    const char *string;
    int fd;
    size_t length;

    /*
     * We should also check against making more then TMP_MAX of these.
     */

    if (dirObj) {
	string = TclGetStringFromObj(dirObj, &length);
	Tcl_UtfToExternalDString(NULL, string, length, &templ);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */
    }

    TclDStringAppendLiteral(&templ, "/");

    if (basenameObj) {
	string = TclGetStringFromObj(basenameObj, &length);
	Tcl_UtfToExternalDString(NULL, string, length, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	Tcl_DStringFree(&tmp);
    } else {
	TclDStringAppendLiteral(&templ, "tcl");
    }

    TclDStringAppendLiteral(&templ, "_XXXXXX");

#ifdef HAVE_MKSTEMPS
    if (extensionObj) {
	string = TclGetStringFromObj(extensionObj, &length);
	Tcl_UtfToExternalDString(NULL, string, length, &tmp);
	TclDStringAppendDString(&templ, &tmp);
	fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else
#endif
    {
	fd = mkstemp(Tcl_DStringValue(&templ));
    }

    if (fd == -1) {
	Tcl_DStringFree(&templ);
	return -1;
    }

    if (resultingNameObj) {
	Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ),
		Tcl_DStringLength(&templ), &tmp);
	Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp));
	Tcl_DStringFree(&tmp);
    } else {
	/*
	 * Try to delete the file immediately since we're not reporting the
	 * name to anyone. Note that we're *not* handling any errors from
	 * this!
	 */

	unlink(Tcl_DStringValue(&templ));
	errno = 0;
    }
    Tcl_DStringFree(&templ);

    return fd;
}

/*
 * Helper that does *part* of what tempnam() does.
 */

static const char *
DefaultTempDir(void)
{
    const char *dir;
    struct stat buf;

    dir = getenv("TMPDIR");
    if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode)
	    && access(dir, W_OK) == 0) {
	return dir;
    }

#ifdef P_tmpdir
    dir = P_tmpdir;
    if (stat(dir, &buf)==0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)==0) {
	return dir;
    }
#endif

    /*
     * Assume that the default location ("/tmp" if not overridden) is always
     * an existing writable directory; we've no recovery mechanism if it
     * isn't.
     */

    return TCL_TEMPORARY_FILE_DIRECTORY;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateTemporaryDirectory --
 *
 *	Creates a temporary directory, possibly based on the supplied bits and
 *	pieces of template supplied in the arguments.
 *
 * Results:
 *	An object (refcount 0) containing the name of the newly-created
 *	directory, or NULL on failure.
 *
 * Side effects:
 *	Accesses the native filesystem. Makes a directory.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpCreateTemporaryDirectory(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj)
{
    Tcl_DString templ, tmp;
    const char *string;

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"

    /*
     * Build the template in writable memory from the user-supplied pieces and
     * some defaults.
     */

    if (dirObj) {
	string = TclGetString(dirObj);
	Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ);
    } else {
	Tcl_DStringInit(&templ);
	Tcl_DStringAppend(&templ, DefaultTempDir(), -1); /* INTL: native */
    }

    if (Tcl_DStringValue(&templ)[Tcl_DStringLength(&templ) - 1] != '/') {
	TclDStringAppendLiteral(&templ, "/");
    }

    if (basenameObj) {
	string = TclGetString(basenameObj);
	if (basenameObj->length) {
	    Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp);
	    TclDStringAppendDString(&templ, &tmp);
	    Tcl_DStringFree(&tmp);
	} else {
	    TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
	}
    } else {
	TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX);
    }

    TclDStringAppendLiteral(&templ, "_XXXXXX");

    /*
     * Make the temporary directory.
     */

    if (mkdtemp(Tcl_DStringValue(&templ)) == NULL) {
	Tcl_DStringFree(&templ);
	return NULL;
    }

    /*
     * The template has been updated. Tell the caller what it was.
     */

    Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ),
	    Tcl_DStringLength(&templ), &tmp);
    Tcl_DStringFree(&templ);
    return TclDStringToObj(&tmp);
}

#if defined(__CYGWIN__)

static void
StatError(
    Tcl_Interp *interp,		/* The interp that has the error */
    Tcl_Obj *fileName)		/* The name of the file which caused the
				 * error. */
{
    TclWinConvertError(GetLastError());
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
	    TclGetString(fileName), Tcl_PosixError(interp)));
}

static WCHAR *
winPathFromObj(
    Tcl_Obj *fileName)
{
    size_t size;
    const char *native =  (const char *)Tcl_FSGetNativePath(fileName);
    WCHAR *winPath;

    size = cygwin_conv_path(1, native, NULL, 0);
    winPath = (WCHAR *)Tcl_Alloc(size);
    cygwin_conv_path(1, native, winPath, size);

    return winPath;
}

static const int attributeArray[] = {
    0x20, 0, 2, 0, 0, 1, 4
};

/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes
 *
 *	Gets an attribute of a file.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	If there is no error assigns to *attributePtrPtr the address of a new
 *	Tcl_Obj having a refCount of zero and containing the value of the
 *	specified attribute.
 *
 *
 *----------------------------------------------------------------------
 */

static int
GetUnixFileAttributes(
    Tcl_Interp *interp,		/* The interp to report errors to. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The pathname of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* Where to store the result. */
{
    int fileAttributes;
    WCHAR *winPath = winPathFromObj(fileName);

    fileAttributes = GetFileAttributesW(winPath);
    Tcl_Free(winPath);

    if (fileAttributes == -1) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    TclNewIntObj(*attributePtrPtr,
	    (fileAttributes & attributeArray[objIndex]) != 0);
    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
 *
 *	Sets the readonly attribute of a file.
 *
 * Results:
 *	Standard TCL result.
 *
 * Side effects:
 *	The readonly attribute of the file is changed.
 *
 *---------------------------------------------------------------------------
 */

static int
SetUnixFileAttributes(
    Tcl_Interp *interp,	    /* The interp we are using for errors. */
    int objIndex,           /* The index of the attribute. */
    Tcl_Obj *fileName,      /* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)  /* The attribute to set. */
{
    int yesNo, fileAttributes, old;
    WCHAR *winPath;

    if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) {
	return TCL_ERROR;
    }

    winPath = winPathFromObj(fileName);

    fileAttributes = old = GetFileAttributesW(winPath);

    if (fileAttributes == -1) {
	Tcl_Free(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    if (yesNo) {
	fileAttributes |= attributeArray[objIndex];
    } else {
	fileAttributes &= ~attributeArray[objIndex];
    }

    if ((fileAttributes != old)
	    && !SetFileAttributesW(winPath, fileAttributes)) {
	Tcl_Free(winPath);
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    Tcl_Free(winPath);
    return TCL_OK;
}
#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
 *----------------------------------------------------------------------
 *
 * GetUnixFileAttributes
 * GetReadOnlyAttribute
 *
 *	Gets the readonly attribute (user immutable flag) of a file.
 *
 * Results:
 *	Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there
 *	is no error. The object will have ref count 0.
 *
 * Side effects:
 *	A new object is allocated.
 *
 *----------------------------------------------------------------------
 */

static int
GetUnixFileAttributes(
GetReadOnlyAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    Tcl_StatBuf statBuf;
    int result;

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }

    *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0);
    TclNewIntObj(*attributePtrPtr, (statBuf.st_flags & UF_IMMUTABLE) != 0);

    return TCL_OK;
}

/*
 *---------------------------------------------------------------------------
 *
 * SetUnixFileAttributes
 * SetReadOnlyAttribute
 *
 *	Sets the readonly attribute (user immutable flag) of a file.
 *
 * Results:
 *	Standard TCL result.
 *
 * Side effects:
 *	The readonly attribute of the file is changed.
 *
 *---------------------------------------------------------------------------
 */

static int
SetUnixFileAttributes(
SetReadOnlyAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file (UTF-8). */
    Tcl_Obj *attributePtr)	/* The attribute to set. */
{
    Tcl_StatBuf statBuf;
    int result, readonly;
    const char *native;
    int result;
    int readonly;
    CONST char *native;

    if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) {
	return TCL_ERROR;
    }

    result = TclpObjStat(fileName, &statBuf);

    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not read \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }

    if (readonly) {
	statBuf.st_flags |= UF_IMMUTABLE;
    } else {
	statBuf.st_flags &= ~UF_IMMUTABLE;
    }

    native = (const char *)Tcl_FSGetNativePath(fileName);
    native = Tcl_FSGetNativePath(fileName);
    result = chflags(native, statBuf.st_flags);		/* INTL: Native. */
    if (result != 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not set flags for file \"%s\": %s",
		    TclGetString(fileName), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "could not set flags for file \"",
		    TclGetString(fileName), "\": ", Tcl_PosixError(interp),
		    NULL);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}
#endif /* defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) */


Changes to unix/tclUnixFile.c.

1
2
3
4
5
6
7
8
9
10


11
12
13
14
15
16
17


18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40


41
42

43
44


45

46
47
48


49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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








-
-
+
+





-
-
+
+



















-


-
+
+


+
-
-
+
+

+

-
-
+
+








-

-
-
-
-
-
-







/*
 * tclUnixFile.c --
 *
 *	This file contains wrappers around UNIX file handling functions.
 *	These wrappers mask differences between Windows and UNIX.
 *
 * Copyright (c) 1995-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * 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 "tclFileSystem.h"

static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry,
	const char* nativeName, Tcl_GlobTypeData *types);
static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry,
	CONST char* nativeName, Tcl_GlobTypeData *types);

/*
 *---------------------------------------------------------------------------
 *
 * TclpFindExecutable --
 *
 *	This function computes the absolute path name of the current
 *	application, given its argv[0] value. For Cygwin, argv[0] is
 *	ignored and the path is determined the same as under win32.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The computed path name is stored as a ProcessGlobalValue.
 *
 *---------------------------------------------------------------------------
 */

#ifdef __CYGWIN__
void
TclpFindExecutable(
    TCL_UNUSED(const char *) /*argv0*/)
    CONST char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_Encoding encoding;
#ifdef __CYGWIN__
    size_t length;
    wchar_t buf[PATH_MAX];
    int length;
    wchar_t buf[PATH_MAX] = L"";
    char name[PATH_MAX * 3 + 1];
    (void)argv0;

    GetModuleFileNameW(NULL, buf, PATH_MAX);
    cygwin_conv_path(3, buf, name, PATH_MAX);
    GetModuleFileNameW(NULL, (void *)buf, sizeof(buf)/sizeof(wchar_t));
    cygwin_conv_path(3, buf, name, sizeof(name));
    length = strlen(name);
    if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
	/* Strip '.exe' part. */
	length -= 4;
    }
    encoding = Tcl_GetEncoding(NULL, NULL);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(name, length), encoding);
}
#else
void
TclpFindExecutable(
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    Tcl_Encoding encoding;
    const char *name, *p;
    Tcl_StatBuf statBuf;
    Tcl_DString buffer, nameString, cwd, utfName;

    if (argv0 == NULL) {
	return;
    }
108
109
110
111
112
113
114
115

116
117
118
119

120
121
122
123
124
125
126
103
104
105
106
107
108
109

110
111
112
113

114
115
116
117
118
119
120
121







-
+



-
+







	while (TclIsSpaceProcM(*p)) {
	    p++;
	}
	name = p;
	while ((*p != ':') && (*p != 0)) {
	    p++;
	}
	TclDStringClear(&buffer);
	Tcl_DStringSetLength(&buffer, 0);
	if (p != name) {
	    Tcl_DStringAppend(&buffer, name, p - name);
	    if (p[-1] != '/') {
		TclDStringAppendLiteral(&buffer, "/");
		Tcl_DStringAppend(&buffer, "/", 1);
	    }
	}
	name = Tcl_DStringAppend(&buffer, argv0, -1);

	/*
	 * INTL: The following calls to access() and stat() should not be
	 * converted to Tclp routines because they need to operate on native
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
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







-
+


+
-
+











-

+







    Tcl_DStringInit(&nameString);
    Tcl_DStringAppend(&nameString, name, -1);

    Tcl_DStringFree(&buffer);
    Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
	    Tcl_DStringLength(&cwd), &buffer);
    if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
	TclDStringAppendLiteral(&buffer, "/");
	Tcl_DStringAppend(&buffer, "/", 1);
    }
    Tcl_DStringFree(&cwd);
    Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString),
    TclDStringAppendDString(&buffer, &nameString);
	    Tcl_DStringLength(&nameString));
    Tcl_DStringFree(&nameString);

    encoding = Tcl_GetEncoding(NULL, NULL);
    Tcl_ExternalToUtfDString(encoding, Tcl_DStringValue(&buffer), -1,
	    &utfName);
    TclSetObjNameOfExecutable(
	    Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), encoding);
    Tcl_DStringFree(&utfName);

  done:
    Tcl_DStringFree(&buffer);
}
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpMatchInDirectory --
 *
 *	This routine is used by the globbing code to search a directory for
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
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







-
+




-
+




















-

-
+

-
+

-
+









-
-
+
+

+





-
+
-




-
+















-
+







 */

int
TclpMatchInDirectory(
    Tcl_Interp *interp,		/* Interpreter to receive errors. */
    Tcl_Obj *resultPtr,		/* List object to lappend results. */
    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
    const char *pattern,	/* Pattern to match against. */
    CONST char *pattern,	/* Pattern to match against. */
    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    const char *native;
    CONST char *native;
    Tcl_Obj *fileNamePtr;
    int matchResult = 0;

    if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) {
	/*
	 * The native filesystem never adds mounts.
	 */

	return TCL_OK;
    }

    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
    if (fileNamePtr == NULL) {
	return TCL_ERROR;
    }

    if (pattern == NULL || (*pattern == '\0')) {
	/*
	 * Match a file directly.
	 */

	Tcl_Obj *tailPtr;
	const char *nativeTail;
	CONST char *nativeTail;

	native = (const char *)Tcl_FSGetNativePath(pathPtr);
	native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
	tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL);
	nativeTail = (const char *)Tcl_FSGetNativePath(tailPtr);
	nativeTail = (CONST char*) Tcl_FSGetNativePath(tailPtr);
	matchResult = NativeMatchType(interp, native, nativeTail, types);
	if (matchResult == 1) {
	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	}
	Tcl_DecrRefCount(tailPtr);
	Tcl_DecrRefCount(fileNamePtr);
    } else {
	TclDIR *d;
	Tcl_DirEntry *entryPtr;
	const char *dirName;
	size_t dirLength, nativeDirLen;
	CONST char *dirName;
	int dirLength;
	int matchHidden, matchHiddenPat;
	int nativeDirLen;
	Tcl_StatBuf statBuf;
	Tcl_DString ds;		/* native encoding of dir */
	Tcl_DString dsOrig;	/* utf-8 encoding of dir */

	Tcl_DStringInit(&dsOrig);
	dirName = TclGetString(fileNamePtr);
	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
	dirLength = fileNamePtr->length;
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	/*
	 * Make sure that the directory part of the name really is a
	 * directory. If the directory name is "", use the name "." instead,
	 * directory.  If the directory name is "", use the name "." instead,
	 * because some UNIX systems don't treat "" like "." automatically.
	 * Keep the "" for use in generating file names, otherwise "glob
	 * foo.c" would return "./foo.c".
	 */

	if (dirLength == 0) {
	    dirName = ".";
	} else {
	    dirName = Tcl_DStringValue(&dsOrig);

	    /*
	     * Make sure we have a trailing directory delimiter.
	     */

	    if (dirName[dirLength-1] != '/') {
		dirName = TclDStringAppendLiteral(&dsOrig, "/");
		dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
		dirLength++;
	    }
	}

	/*
	 * Now open the directory for reading and iterate over the contents.
	 */
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
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







-
-
-
+
+
+
+


















-
+







-
+
-
-


-
+
-
-


-
+
-
-







	    return TCL_OK;
	}

	d = TclOSopendir(native);				/* INTL: Native. */
	if (d == NULL) {
	    Tcl_DStringFree(&ds);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read directory \"%s\": %s",
			Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't read directory \"",
			Tcl_DStringValue(&dsOrig), "\": ",
			Tcl_PosixError(interp), (char *) NULL);
	    }
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_ERROR;
	}

	nativeDirLen = Tcl_DStringLength(&ds);

	/*
	 * Check to see if -type or the pattern requests hidden files.
	 */

	matchHiddenPat = (pattern[0] == '.')
		|| ((pattern[0] == '\\') && (pattern[1] == '.'));
	matchHidden = matchHiddenPat
		|| (types && (types->perm & TCL_GLOB_PERM_HIDDEN));
	while ((entryPtr = TclOSreaddir(d)) != NULL) {	/* INTL: Native. */
	    Tcl_DString utfDs;
	    const char *utfname;
	    CONST char *utfname;

	    /*
	     * Skip this file if it doesn't agree with the hidden parameters
	     * requested by the user (via -type or pattern).
	     */

	    if (*entryPtr->d_name == '.') {
		if (!matchHidden) {
		if (!matchHidden) continue;
		    continue;
		}
	    } else {
#ifdef MAC_OSX_TCL
		if (matchHiddenPat) {
		if (matchHiddenPat) continue;
		    continue;
		}
		/* Also need to check HFS hidden flag in TclMacOSXMatchType. */
#else
		if (matchHidden) {
		if (matchHidden) continue;
		    continue;
		}
#endif
	    }

	    /*
	     * Now check to see if the file matches, according to both type
	     * and pattern. If so, add the file to the result.
	     */
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
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
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
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


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
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







-
-
+
+
+







-
-
+
+


-
-
-
+
+
+










-
-
+
+



-










-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
+



+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+
-
-
-
-
-
-

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+







	TclOSclosedir(d);
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&dsOrig);
	Tcl_DecrRefCount(fileNamePtr);
    }
    if (matchResult < 0) {
	return TCL_ERROR;
    }
    return TCL_OK;
    } else {
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NativeMatchType --
 *
 *	This routine is used by the globbing code to check if a file matches a
 *	given type description.
 *	This routine is used by the globbing code to check if a file
 *	matches a given type description.
 *
 * Results:
 *	The return value is 1, 0 or -1 indicating whether the file matches the
 *	given criteria, does not match them, or an error occurred (in which
 *	case an error is left in interp).
 *	The return value is 1, 0 or -1 indicating whether the file
 *	matches the given criteria, does not match them, or an error
 *	occurred (in wich case an error is left in interp).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
NativeMatchType(
    Tcl_Interp *interp,       /* Interpreter to receive errors. */
    const char *nativeEntry,  /* Native path to check. */
    const char *nativeName,   /* Native filename to check. */
    CONST char *nativeEntry,  /* Native path to check. */
    CONST char *nativeName,   /* Native filename to check. */
    Tcl_GlobTypeData *types)  /* Type description to match against. */
{
    Tcl_StatBuf buf;

    if (types == NULL) {
	/*
	 * Simply check for the file's existence, but do it with lstat, in
	 * case it is a link to a file which doesn't exist (since that case
	 * would not show up if we used 'access' or 'stat')
	 */

	if (TclOSlstat(nativeEntry, &buf) != 0) {
	    return 0;
	}
	return 1;
    }

    if (types->perm != 0) {
	if (TclOSstat(nativeEntry, &buf) != 0) {
	    /*
	     * Either the file has disappeared between the 'readdir' call and
	     * the 'stat' call, or the file is a link to a file which doesn't
	     * exist (which we could ascertain with lstat), or there is some
	     * other strange problem. In all these cases, we define this to
	     * mean the file does not match any defined permission, and
	     * therefore it is not added to the list of files to return.
	     */
    } else {
	if (types->perm != 0) {
	    if (TclOSstat(nativeEntry, &buf) != 0) {
		/*
		 * Either the file has disappeared between the 'readdir' call
		 * and the 'stat' call, or the file is a link to a file which
		 * doesn't exist (which we could ascertain with lstat), or
		 * there is some other strange problem. In all these cases, we
		 * define this to mean the file does not match any defined
		 * permission, and therefore it is not added to the list of
		 * files to return.
		 */

	    return 0;
	}
		return 0;
	    }

	/*
	 * readonly means that there are NO write permissions (even for user),
	 * but execute is OK for anybody OR that the user immutable flag is
	 * set (where supported).
	 */
	    /*
	     * readonly means that there are NO write permissions (even for
	     * user), but execute is OK for anybody OR that the user immutable
	     * flag is set (where supported).
	     */

	if (((types->perm & TCL_GLOB_PERM_RONLY) &&
	    if (((types->perm & TCL_GLOB_PERM_RONLY) &&
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
		!(buf.st_flags & UF_IMMUTABLE) &&
			!(buf.st_flags & UF_IMMUTABLE) &&
#endif
		(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
	    ((types->perm & TCL_GLOB_PERM_R) &&
		(access(nativeEntry, R_OK) != 0)) ||
	    ((types->perm & TCL_GLOB_PERM_W) &&
		(access(nativeEntry, W_OK) != 0)) ||
	    ((types->perm & TCL_GLOB_PERM_X) &&
		(access(nativeEntry, X_OK) != 0))
			(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
		((types->perm & TCL_GLOB_PERM_R) &&
			(access(nativeEntry, R_OK) != 0)) ||
		((types->perm & TCL_GLOB_PERM_W) &&
			(access(nativeEntry, W_OK) != 0)) ||
		((types->perm & TCL_GLOB_PERM_X) &&
			(access(nativeEntry, X_OK) != 0))
#ifndef MAC_OSX_TCL
	    || ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
		(*nativeName != '.'))
#endif /* MAC_OSX_TCL */
		|| ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
			(*nativeName != '.'))
#endif
		) {
	    return 0;
	}
    }
    if (types->type != 0) {
	if (types->perm == 0) {
	    /*
	     * We haven't yet done a stat on the file.
	     */
		return 0;
	    }
	}
	if (types->type != 0) {
	    if (types->perm == 0) {
		/*
		 * We haven't yet done a stat on the file.
		 */

	    if (TclOSstat(nativeEntry, &buf) != 0) {
		/*
		 * Posix error occurred. The only ok case is if this is a link
		 * to a nonexistent file, and the user did 'glob -l'. So we
		 * check that here:
		 */
		if (TclOSstat(nativeEntry, &buf) != 0) {
		    /*
		     * Posix error occurred. The only ok case is if this is a
		     * link to a nonexistent file, and the user did 'glob -l'.
		     * So we check that here:
		     */

		if ((types->type & TCL_GLOB_TYPE_LINK)
			&& (TclOSlstat(nativeEntry, &buf) == 0)
			&& S_ISLNK(buf.st_mode)) {
		    return 1;
		}
		return 0;
	    }
	}
		    if (types->type & TCL_GLOB_TYPE_LINK) {
			if (TclOSlstat(nativeEntry, &buf) == 0) {
			    if (S_ISLNK(buf.st_mode)) {
				return 1;
			    }
			}
		    }
		    return 0;
		}
	    }

	/*
	 * In order bcdpsfl as in 'find -t'
	 */
	    /*
	     * In order bcdpfls as in 'find -t'
	     */

	if (    ((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) ||
	    if (((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_CHAR) && S_ISCHR(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_DIR)  && S_ISDIR(buf.st_mode)) ||
		((types->type & TCL_GLOB_TYPE_PIPE) && S_ISFIFO(buf.st_mode))||
		((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))
#ifdef S_ISSOCK
		((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))||
		||((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))
#endif /* S_ISSOCK */
		((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))) {
	    /*
	     * Do nothing - this file is ok.
	     */
	} else {
		) {
		/*
		 * Do nothing - this file is ok.
		 */
	    } else {
#ifdef S_ISLNK
	    if ((types->type & TCL_GLOB_TYPE_LINK)
		    && (TclOSlstat(nativeEntry, &buf) == 0)
		    && S_ISLNK(buf.st_mode)) {
		goto filetypeOK;
	    }
		if (types->type & TCL_GLOB_TYPE_LINK) {
		    if (TclOSlstat(nativeEntry, &buf) == 0) {
			if (S_ISLNK(buf.st_mode)) {
			    goto filetypeOK;
			}
		    }
		}
#endif /* S_ISLNK */
	    return 0;
	}
    }
  filetypeOK:
		return 0;
	    }
	}
    filetypeOK: ;

    /*
     * If we're on OSX, we also have to worry about matching the file creator
     * code (if specified). Do that now.
     */

#ifdef MAC_OSX_TCL
    if (types->macType != NULL || types->macCreator != NULL ||
	    (types->perm & TCL_GLOB_PERM_HIDDEN)) {
	int matchResult;
	if (types->macType != NULL || types->macCreator != NULL ||
		(types->perm & TCL_GLOB_PERM_HIDDEN)) {
	    int matchResult;

	if (types->perm == 0 && types->type == 0) {
	    /*
	     * We haven't yet done a stat on the file.
	     */
	    if (types->perm == 0 && types->type == 0) {
		/*
		 * We haven't yet done a stat on the file.
		 */

	    if (TclOSstat(nativeEntry, &buf) != 0) {
		return 0;
	    }
	}
		if (TclOSstat(nativeEntry, &buf) != 0) {
		    return 0;
		}
	    }

	matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
		&buf, types);
	if (matchResult != 1) {
	    return matchResult;
	}
    }
	    matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
		    &buf, types);
	    if (matchResult != 1) {
		return matchResult;
	    }
	}
#else
    (void)interp;
#endif /* MAC_OSX_TCL */

#endif
    }
    return 1;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetUserHome --
586
587
588
589
590
591
592
593

594
595

596
597
598
599
600
601

602

603
604
605
606
607
608
609
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







-
+

-
+





-
+

+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
char *
TclpGetUserHome(
    const char *name,		/* User name for desired home directory. */
    CONST char *name,		/* User name for desired home directory. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    struct passwd *pwPtr;
    Tcl_DString ds;
    const char *native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
    CONST char *native;

    native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
    pwPtr = TclpGetPwNam(native);			/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (pwPtr == NULL) {
	return NULL;
    }
    Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
627
628
629
630
631
632
633
634

635
636
637
638
639



640
641
642
643
644
645
646
614
615
616
617
618
619
620

621

622
623


624
625
626
627
628
629
630
631
632
633







-
+
-


-
-
+
+
+







 */

int
TclpObjAccess(
    Tcl_Obj *pathPtr,		/* Path of file to access */
    int mode)			/* Permission setting. */
{
    const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);
    CONST char *path = Tcl_FSGetNativePath(pathPtr);

    if (path == NULL) {
	return -1;
    }
    return access(path, mode);
    } else {
	return access(path, mode);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpObjChdir --
 *
655
656
657
658
659
660
661
662

663
664
665
666
667



668
669
670
671
672
673
674
642
643
644
645
646
647
648

649

650
651


652
653
654
655
656
657
658
659
660
661







-
+
-


-
-
+
+
+







 *---------------------------------------------------------------------------
 */

int
TclpObjChdir(
    Tcl_Obj *pathPtr)		/* Path to new working directory */
{
    const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);
    CONST char *path = Tcl_FSGetNativePath(pathPtr);

    if (path == NULL) {
	return -1;
    }
    return chdir(path);
    } else {
	return chdir(path);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpObjLstat --
 *
684
685
686
687
688
689
690
691

692
693
694
695
696
697
698
671
672
673
674
675
676
677

678
679
680
681
682
683
684
685







-
+







 */

int
TclpObjLstat(
    Tcl_Obj *pathPtr,		/* Path of file to stat */
    Tcl_StatBuf *bufPtr)	/* Filled with results of stat call. */
{
    return TclOSlstat((const char *)Tcl_FSGetNativePath(pathPtr), bufPtr);
    return TclOSlstat(Tcl_FSGetNativePath(pathPtr), bufPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetNativeCwd --
 *
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
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







-
+
-
-

-
+
-
-
-
-
+
+
-
-
-
-
-
+

-
-
-
-
+
+
+
+

-
+
+
+
+
+
+







ClientData
TclpGetNativeCwd(
    ClientData clientData)
{
    char buffer[MAXPATHLEN+1];

#ifdef USEGETWD
    if (getwd(buffer) == NULL) {			/* INTL: Native. */
    if (getwd(buffer) == NULL)				/* INTL: Native. */
	return NULL;
    }
#else
    if (getcwd(buffer, MAXPATHLEN+1) == NULL) {		/* INTL: Native. */
    if (getcwd(buffer, MAXPATHLEN+1) == NULL)		/* INTL: Native. */
	return NULL;
    }
#endif /* USEGETWD */

#endif
    {
    if ((clientData == NULL) || strcmp(buffer, (const char *) clientData)) {
	char *newCd = (char *)Tcl_Alloc(strlen(buffer) + 1);

	strcpy(newCd, buffer);
	return newCd;
	return NULL;
    }

    /*
     * No change to pwd.
     */
    if ((clientData != NULL) && strcmp(buffer, (CONST char*)clientData) == 0) {
	/*
	 * No change to pwd.
	 */

    return clientData;
	return clientData;
    } else {
	char *newCd = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
	strcpy(newCd, buffer);
	return (ClientData) newCd;
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpGetCwd --
 *
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
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







-
+











-
+


-
-
-
+
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
CONST char *
TclpGetCwd(
    Tcl_Interp *interp,		/* If non-NULL, used for error reporting. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of current directory. */
{
    char buffer[MAXPATHLEN+1];

#ifdef USEGETWD
    if (getwd(buffer) == NULL)				/* INTL: Native. */
#else
    if (getcwd(buffer, MAXPATHLEN+1) == NULL)		/* INTL: Native. */
#endif /* USEGETWD */
#endif
    {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error getting working directory name: %s",
		    Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp,
		    "error getting working directory name: ",
		    Tcl_PosixError(interp), NULL);
	}
	return NULL;
    }
    return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
}

/*
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
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







-
+






-
+














-
+







 *	See readlink() documentation.
 *
 *---------------------------------------------------------------------------
 */

char *
TclpReadlink(
    const char *path,		/* Path of file to readlink (UTF-8). */
    CONST char *path,		/* Path of file to readlink (UTF-8). */
    Tcl_DString *linkPtr)	/* Uninitialized or free DString filled with
				 * contents of link (UTF-8). */
{
#ifndef DJGPP
    char link[MAXPATHLEN];
    int length;
    const char *native;
    CONST 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);
#else
    return NULL;
#endif /* !DJGPP */
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpObjStat --
 *
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
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







-
+
-


-
-
+
+
+




-
+






-
-
+
+







 */

int
TclpObjStat(
    Tcl_Obj *pathPtr,		/* Path of file to stat */
    Tcl_StatBuf *bufPtr)	/* Filled with results of stat call. */
{
    const char *path = (const char *)Tcl_FSGetNativePath(pathPtr);
    CONST char *path = Tcl_FSGetNativePath(pathPtr);

    if (path == NULL) {
	return -1;
    }
    return TclOSstat(path, bufPtr);
    } else {
	return TclOSstat(path, bufPtr);
    }
}

#ifdef S_IFLNK

Tcl_Obj *
Tcl_Obj*
TclpObjLink(
    Tcl_Obj *pathPtr,
    Tcl_Obj *toPtr,
    int linkAction)
{
    if (toPtr != NULL) {
	const char *src = (const char *)Tcl_FSGetNativePath(pathPtr);
	const char *target = NULL;
	CONST char *src = Tcl_FSGetNativePath(pathPtr);
	CONST char *target = NULL;

	if (src == NULL) {
	    return NULL;
	}

	/*
	 * If we're making a symbolic link and the path is relative, then we
915
916
917
918
919
920
921
922

923
924
925
926
927
928
929
899
900
901
902
903
904
905

906
907
908
909
910
911
912
913







-
+







	    /*
	     * Target exists; we'll construct the relative path we want below.
	     */

	    Tcl_DecrRefCount(absPtr);
	    Tcl_DecrRefCount(dirPtr);
	} else {
	    target = (const char*)Tcl_FSGetNativePath(toPtr);
	    target = Tcl_FSGetNativePath(toPtr);
	    if (target == NULL) {
		return NULL;
	    }
	    if (access(target, F_OK) == -1) {
		/*
		 * Target doesn't exist.
		 */
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
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







+


-











-
-
+
+







	}

	/*
	 * Check symbolic link flag first, since we prefer to create these.
	 */

	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    int targetLen;
	    Tcl_DString ds;
	    Tcl_Obj *transPtr;
	    size_t length;

	    /*
	     * Now we don't want to link to the absolute, normalized path.
	     * Relative links are quite acceptable (but links to ~user are not
	     * -- these must be expanded first).
	     */

	    transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
	    if (transPtr == NULL) {
		return NULL;
	    }
	    target = TclGetStringFromObj(transPtr, &length);
	    target = Tcl_UtfToExternalDString(NULL, target, length, &ds);
	    target = Tcl_GetStringFromObj(transPtr, &targetLen);
	    target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
	    Tcl_DecrRefCount(transPtr);

	    if (symlink(target, src) != 0) {
		toPtr = NULL;
	    }
	    Tcl_DStringFree(&ds);
	} else if (linkAction & TCL_CREATE_HARD_LINK) {
988
989
990
991
992
993
994
995

996
997
998
999
1000
1001
1002






1003
1004
1005
1006
1007
1008
1009
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







-
+





-
-
+
+
+
+
+
+








	transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (transPtr == NULL) {
	    return NULL;
	}
	Tcl_DecrRefCount(transPtr);

	length = readlink((const char *)Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	Tcl_ExternalToUtfDString(NULL, link, length, &ds);
	linkPtr = TclDStringToObj(&ds);
	Tcl_IncrRefCount(linkPtr);
	linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
	if (linkPtr != NULL) {
	    Tcl_IncrRefCount(linkPtr);
	}
	return linkPtr;
    }
}
#endif /* S_IFLNK */

/*
 *---------------------------------------------------------------------------
1022
1023
1024
1025
1026
1027
1028
1029

1030
1031
1032
1033
1034
1035
1036
1010
1011
1012
1013
1014
1015
1016

1017
1018
1019
1020
1021
1022
1023
1024







-
+







 *	None.
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
TclpFilesystemPathType(
    TCL_UNUSED(Tcl_Obj *))
    Tcl_Obj *pathPtr)
{
    /*
     * All native paths are of the same type.
     */

    return NULL;
}
1057
1058
1059
1060
1061
1062
1063


1064

1065
1066









1067
1068
1069
1070
1071
1072
1073
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







+
+

+
-
-
+
+
+
+
+
+
+
+
+







 */

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    int len;

    CONST char *copy;
    Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds);
    return TclDStringToObj(&ds);
    Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);

    copy = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);

    objPtr = Tcl_NewStringObj(copy,len);
    Tcl_DStringFree(&ds);

    return objPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeCreateNativeRep --
 *
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093


1094
1095
1096
1097
1098
1099
1100
1081
1082
1083
1084
1085
1086
1087

1088
1089

1090
1091
1092
1093
1094
1095
1096
1097
1098







-


-
+
+







 */

ClientData
TclNativeCreateNativeRep(
    Tcl_Obj *pathPtr)
{
    char *nativePathPtr;
    const char *str;
    Tcl_DString ds;
    Tcl_Obj *validPathPtr;
    size_t len;
    int len;
    char *str;

    if (TclFSCwdIsNative()) {
	/*
	 * The cwd is native, which means we can use the translated path
	 * without worrying about normalization (this will also usually be
	 * shorter so the utf-to-external conversion will be somewhat faster).
	 */
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
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







-
+









-
-
+
+


-
+







	validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (validPathPtr == NULL) {
	    return NULL;
	}
	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetStringFromObj(validPathPtr, &len);
    str = Tcl_GetStringFromObj(validPathPtr, &len);
    Tcl_UtfToExternalDString(NULL, str, len, &ds);
    len = Tcl_DStringLength(&ds) + sizeof(char);
    if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
	/* See bug [3118489]: NUL in filenames */
	Tcl_DecrRefCount(validPathPtr);
	Tcl_DStringFree(&ds);
	return NULL;
    }
    Tcl_DecrRefCount(validPathPtr);
    nativePathPtr = (char *)Tcl_Alloc(len);
    memcpy(nativePathPtr, Tcl_DStringValue(&ds), len);
    nativePathPtr = ckalloc((unsigned) len);
    memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len);

    Tcl_DStringFree(&ds);
    return nativePathPtr;
    return (ClientData)nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeDupInternalRep --
 *
1160
1161
1162
1163
1164
1165
1166
1167

1168
1169
1170
1171



1172
1173
1174
1175
1176
1177
1178
1158
1159
1160
1161
1162
1163
1164

1165
1166



1167
1168
1169
1170
1171
1172
1173
1174
1175
1176







-
+

-
-
-
+
+
+







	return NULL;
    }

    /*
     * ASCII representation when running on Unix.
     */

    len = (strlen((const char*) clientData) + 1) * sizeof(char);
    len = sizeof(char) + (strlen((CONST char*) clientData) * sizeof(char));

    copy = (char *)Tcl_Alloc(len);
    memcpy(copy, clientData, len);
    return copy;
    copy = (char *) ckalloc(len);
    memcpy((void *) copy, (void *) clientData, len);
    return (ClientData)copy;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpUtime --
 *
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1188
1189
1190
1191
1192
1193
1194

1195

1196
1197
1198
1199
1200
1201
1202







-

-







int
TclpUtime(
    Tcl_Obj *pathPtr,		/* File to modify */
    struct utimbuf *tval)	/* New modification date structure */
{
    return utime((const char *)Tcl_FSGetNativePath(pathPtr), tval);
}

#ifdef __CYGWIN__

int
TclOSstat(
    const char *name,
    void *cygstat)
{
    struct stat buf;
    Tcl_StatBuf *statBuf = (Tcl_StatBuf *)cygstat;

Changes to unix/tclUnixInit.c.

1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20











+
+







/*
 * tclUnixInit.c --
 *
 *	Contains the Unix-specific interpreter initialization functions.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation.
 * All rights reserved.
 */

#include "tclInt.h"
#include <stddef.h>
#include <locale.h>
#ifdef HAVE_LANGINFO
#   include <langinfo.h>
#   ifdef __APPLE__
#	if defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030
	    /* Support for weakly importing nl_langinfo on Darwin. */
#	    define WEAK_IMPORT_NL_LANGINFO
	    extern char *nl_langinfo(nl_item) WEAK_IMPORT_ATTRIBUTE;
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
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







-
-
-
-
-
-





-
-
+
-
-
-
+

-
-
+
+




-
+





-
+



-
-
-
+
+
+





-
-
-
-
-
+
+
+
+
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+







#   include <sys/param.h>
#   if _BSDI_VERSION > 199501
#	include <dlfcn.h>
#   endif
#endif

#ifdef __CYGWIN__
#ifdef __cplusplus
extern "C" {
#endif
#ifdef __clang__
#pragma clang diagnostic ignored "-Wignored-attributes"
#endif
DLLIMPORT extern __stdcall unsigned char GetVersionExW(void *);
DLLIMPORT extern __stdcall void *GetModuleHandleW(const void *);
DLLIMPORT extern __stdcall void FreeLibrary(void *);
DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *);
DLLIMPORT extern __stdcall void GetSystemInfo(void *);
#ifdef __cplusplus
}

#endif

#define NUMPROCESSORS 11
#define NUMPROCESSORS 15
static const char *const processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
    "i686", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "x86_64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64"
};

typedef struct {
  union {
    unsigned int  dwOemId;
    DWORD  dwOemId;
    struct {
      int wProcessorArchitecture;
      int wReserved;
    };
  };
  unsigned int     dwPageSize;
  DWORD     dwPageSize;
  void *lpMinimumApplicationAddress;
  void *lpMaximumApplicationAddress;
  void *dwActiveProcessorMask;
  unsigned int     dwNumberOfProcessors;
  unsigned int     dwProcessorType;
  unsigned int     dwAllocationGranularity;
  DWORD     dwNumberOfProcessors;
  DWORD     dwProcessorType;
  DWORD     dwAllocationGranularity;
  int      wProcessorLevel;
  int      wProcessorRevision;
} SYSTEM_INFO;

typedef struct {
  unsigned int dwOSVersionInfoSize;
  unsigned int dwMajorVersion;
  unsigned int dwMinorVersion;
  unsigned int dwBuildNumber;
  unsigned int dwPlatformId;
  DWORD dwOSVersionInfoSize;
  DWORD dwMajorVersion;
  DWORD dwMinorVersion;
  DWORD dwBuildNumber;
  DWORD dwPlatformId;
  wchar_t szCSDVersion[128];
} OSVERSIONINFOW;
#endif

#ifdef HAVE_COREFOUNDATION
#include <CoreFoundation/CoreFoundation.h>
#endif

/*
 * Define TCL_NO_STACK_CHECK in the compiler options if you want to revert to
 * the old behavior of never checking the stack.
 */

/*
 * Define this if you want to see a lot of output regarding stack checking.
 */

#undef TCL_DEBUG_STACK_CHECK

/*
 * Values used to compute how much space is really available for Tcl's use for
 * the stack.
 *
 * The getrlimit() function is documented to return the maximum stack size in
 * bytes. However, with threads enabled, the pthread library on some platforms
 * does bad things to the stack size limits. First, the limits cannot be
 * changed. Second, they appear to be sometimes reported incorrectly.
 *
 * The defines below may need to be adjusted if more platforms have this
 * broken behavior with threads enabled.
 */

#ifndef TCL_MAGIC_STACK_DIVISOR
#define TCL_MAGIC_STACK_DIVISOR		1
#endif
#ifndef TCL_RESERVED_STACK_PAGES
#define TCL_RESERVED_STACK_PAGES	8
#endif

/*
 * Thread specific data for stack checking.
 */

#ifndef TCL_NO_STACK_CHECK
typedef struct ThreadSpecificData {
    int *outerVarPtr;		/* The "outermost" stack frame pointer for
				 * this thread. */
    int *stackBound;            /* The current stack boundary */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
#ifdef TCL_CROSS_COMPILE
static int stackGrowsDown = -1;
static int StackGrowsDown(int *parent);
#elif defined(TCL_STACK_GROWS_UP)
#define stackGrowsDown 0
#else
#define stackGrowsDown 1
#endif
#endif /* TCL_NO_STACK_CHECK */

#ifdef TCL_DEBUG_STACK_CHECK
#define STACK_DEBUG(args) printf args
#else
#define STACK_DEBUG(args) (void)0
#endif /* TCL_DEBUG_STACK_CHECK */

/*
 * Tcl tries to use standard and homebrew methods to guess the right encoding
 * on the platform. However, there is always a final fallback, and this value
 * is it. Make sure it is a real Tcl encoding.
 */

#ifndef TCL_DEFAULT_ENCODING
#define TCL_DEFAULT_ENCODING "utf-8"
#define TCL_DEFAULT_ENCODING "iso8859-1"
#endif

/*
 * Default directory in which to look for Tcl library scripts. The symbol is
 * defined by Makefile.
 */

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
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







-
-
-
+
+
+












-
-
-
-
+
+
+
+







/*
 * The following table is used to map from Unix locale strings to encoding
 * files. If HAVE_LANGINFO is defined, then this is a fallback table when the
 * result from nl_langinfo isn't a recognized encoding. Otherwise this is the
 * first list checked for a mapping from env encoding to Tcl encoding name.
 */

typedef struct {
    const char *lang;
    const char *encoding;
typedef struct LocaleTable {
    CONST char *lang;
    CONST char *encoding;
} LocaleTable;

/*
 * The table below is sorted for the sake of doing binary searches on it. The
 * indenting reflects different categories of data. The leftmost data
 * represent the encoding names directly implemented by data files in Tcl's
 * default encoding directory. Indented by one TAB are the encoding names that
 * are common alternative spellings. Indented by two TABs are the accumulated
 * "bug fixes" that have been added to deal with the wide variability seen
 * among existing platforms.
 */

static const LocaleTable localeTable[] = {
    {"",		"iso8859-1"},
    {"ansi-1251",	"cp1251"},
    {"ansi_x3.4-1968",	"iso8859-1"},
static CONST LocaleTable localeTable[] = {
	    {"",		"iso8859-1"},
		    {"ansi-1251",	"cp1251"},
	    {"ansi_x3.4-1968",	"iso8859-1"},
    {"ascii",		"ascii"},
    {"big5",		"big5"},
    {"cp1250",		"cp1250"},
    {"cp1251",		"cp1251"},
    {"cp1252",		"cp1252"},
    {"cp1253",		"cp1253"},
    {"cp1254",		"cp1254"},
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
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
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







-
-
-
+
+
+



-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

-
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

-
+

-
-
-
-
+
+
+
+



-
-
-
-
-
+
+
+
+
+


-
+













-
-
-
-
+
+
+
+

-
+


-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


+
+
+






-
+







    {"cp949",		"cp949"},
    {"cp950",		"cp950"},
    {"dingbats",	"dingbats"},
    {"ebcdic",		"ebcdic"},
    {"euc-cn",		"euc-cn"},
    {"euc-jp",		"euc-jp"},
    {"euc-kr",		"euc-kr"},
    {"eucjp",		"euc-jp"},
    {"euckr",		"euc-kr"},
    {"euctw",		"euc-cn"},
		    {"eucjp",		"euc-jp"},
		    {"euckr",		"euc-kr"},
		    {"euctw",		"euc-cn"},
    {"gb12345",		"gb12345"},
    {"gb1988",		"gb1988"},
    {"gb2312",		"gb2312"},
    {"gb2312-1980",	"gb2312"},
		    {"gb2312-1980",	"gb2312"},
    {"gb2312-raw",	"gb2312-raw"},
    {"greek8",		"cp869"},
    {"ibm1250",		"cp1250"},
    {"ibm1251",		"cp1251"},
    {"ibm1252",		"cp1252"},
    {"ibm1253",		"cp1253"},
    {"ibm1254",		"cp1254"},
    {"ibm1255",		"cp1255"},
    {"ibm1256",		"cp1256"},
    {"ibm1257",		"cp1257"},
    {"ibm1258",		"cp1258"},
    {"ibm437",		"cp437"},
    {"ibm737",		"cp737"},
    {"ibm775",		"cp775"},
    {"ibm850",		"cp850"},
    {"ibm852",		"cp852"},
    {"ibm855",		"cp855"},
    {"ibm857",		"cp857"},
    {"ibm860",		"cp860"},
    {"ibm861",		"cp861"},
    {"ibm862",		"cp862"},
    {"ibm863",		"cp863"},
    {"ibm864",		"cp864"},
    {"ibm865",		"cp865"},
    {"ibm866",		"cp866"},
    {"ibm869",		"cp869"},
    {"ibm874",		"cp874"},
    {"ibm932",		"cp932"},
    {"ibm936",		"cp936"},
    {"ibm949",		"cp949"},
    {"ibm950",		"cp950"},
    {"iso-2022",	"iso2022"},
    {"iso-2022-jp",	"iso2022-jp"},
    {"iso-2022-kr",	"iso2022-kr"},
    {"iso-8859-1",	"iso8859-1"},
    {"iso-8859-10",	"iso8859-10"},
    {"iso-8859-13",	"iso8859-13"},
    {"iso-8859-14",	"iso8859-14"},
    {"iso-8859-15",	"iso8859-15"},
    {"iso-8859-16",	"iso8859-16"},
    {"iso-8859-2",	"iso8859-2"},
    {"iso-8859-3",	"iso8859-3"},
    {"iso-8859-4",	"iso8859-4"},
    {"iso-8859-5",	"iso8859-5"},
    {"iso-8859-6",	"iso8859-6"},
    {"iso-8859-7",	"iso8859-7"},
    {"iso-8859-8",	"iso8859-8"},
    {"iso-8859-9",	"iso8859-9"},
		    {"greek8",		"cp869"},
	    {"ibm1250",		"cp1250"},
	    {"ibm1251",		"cp1251"},
	    {"ibm1252",		"cp1252"},
	    {"ibm1253",		"cp1253"},
	    {"ibm1254",		"cp1254"},
	    {"ibm1255",		"cp1255"},
	    {"ibm1256",		"cp1256"},
	    {"ibm1257",		"cp1257"},
	    {"ibm1258",		"cp1258"},
	    {"ibm437",		"cp437"},
	    {"ibm737",		"cp737"},
	    {"ibm775",		"cp775"},
	    {"ibm850",		"cp850"},
	    {"ibm852",		"cp852"},
	    {"ibm855",		"cp855"},
	    {"ibm857",		"cp857"},
	    {"ibm860",		"cp860"},
	    {"ibm861",		"cp861"},
	    {"ibm862",		"cp862"},
	    {"ibm863",		"cp863"},
	    {"ibm864",		"cp864"},
	    {"ibm865",		"cp865"},
	    {"ibm866",		"cp866"},
	    {"ibm869",		"cp869"},
	    {"ibm874",		"cp874"},
	    {"ibm932",		"cp932"},
	    {"ibm936",		"cp936"},
	    {"ibm949",		"cp949"},
	    {"ibm950",		"cp950"},
	    {"iso-2022",	"iso2022"},
	    {"iso-2022-jp",	"iso2022-jp"},
	    {"iso-2022-kr",	"iso2022-kr"},
	    {"iso-8859-1",	"iso8859-1"},
	    {"iso-8859-10",	"iso8859-10"},
	    {"iso-8859-13",	"iso8859-13"},
	    {"iso-8859-14",	"iso8859-14"},
	    {"iso-8859-15",	"iso8859-15"},
	    {"iso-8859-16",	"iso8859-16"},
	    {"iso-8859-2",	"iso8859-2"},
	    {"iso-8859-3",	"iso8859-3"},
	    {"iso-8859-4",	"iso8859-4"},
	    {"iso-8859-5",	"iso8859-5"},
	    {"iso-8859-6",	"iso8859-6"},
	    {"iso-8859-7",	"iso8859-7"},
	    {"iso-8859-8",	"iso8859-8"},
	    {"iso-8859-9",	"iso8859-9"},
    {"iso2022",		"iso2022"},
    {"iso2022-jp",	"iso2022-jp"},
    {"iso2022-kr",	"iso2022-kr"},
    {"iso8859-1",	"iso8859-1"},
    {"iso8859-10",	"iso8859-10"},
    {"iso8859-13",	"iso8859-13"},
    {"iso8859-14",	"iso8859-14"},
    {"iso8859-15",	"iso8859-15"},
    {"iso8859-16",	"iso8859-16"},
    {"iso8859-2",	"iso8859-2"},
    {"iso8859-3",	"iso8859-3"},
    {"iso8859-4",	"iso8859-4"},
    {"iso8859-5",	"iso8859-5"},
    {"iso8859-6",	"iso8859-6"},
    {"iso8859-7",	"iso8859-7"},
    {"iso8859-8",	"iso8859-8"},
    {"iso8859-9",	"iso8859-9"},
    {"iso88591",	"iso8859-1"},
    {"iso885915",	"iso8859-15"},
    {"iso88592",	"iso8859-2"},
    {"iso88595",	"iso8859-5"},
    {"iso88596",	"iso8859-6"},
    {"iso88597",	"iso8859-7"},
    {"iso88598",	"iso8859-8"},
    {"iso88599",	"iso8859-9"},
		    {"iso88591",	"iso8859-1"},
		    {"iso885915",	"iso8859-15"},
		    {"iso88592",	"iso8859-2"},
		    {"iso88595",	"iso8859-5"},
		    {"iso88596",	"iso8859-6"},
		    {"iso88597",	"iso8859-7"},
		    {"iso88598",	"iso8859-8"},
		    {"iso88599",	"iso8859-9"},
#ifdef hpux
    {"ja",		"shiftjis"},
		    {"ja",		"shiftjis"},
#else
    {"ja",		"euc-jp"},
		    {"ja",		"euc-jp"},
#endif
    {"ja_jp",		"euc-jp"},
	{"ja_jp.euc",	"euc-jp"},
    {"ja_jp.eucjp",	"euc-jp"},
    {"ja_jp.jis",	"iso2022-jp"},
    {"ja_jp.mscode",	"shiftjis"},
    {"ja_jp.sjis",	"shiftjis"},
    {"ja_jp.ujis",	"euc-jp"},
    {"japan",		"euc-jp"},
		    {"ja_jp",		"euc-jp"},
		    {"ja_jp.euc",	"euc-jp"},
		    {"ja_jp.eucjp",	"euc-jp"},
		    {"ja_jp.jis",	"iso2022-jp"},
		    {"ja_jp.mscode",	"shiftjis"},
		    {"ja_jp.sjis",	"shiftjis"},
		    {"ja_jp.ujis",	"euc-jp"},
		    {"japan",		"euc-jp"},
#ifdef hpux
    {"japanese",	"shiftjis"},
		    {"japanese",	"shiftjis"},
#else
    {"japanese",	"euc-jp"},
		    {"japanese",	"euc-jp"},
#endif
    {"japanese-sjis",	"shiftjis"},
    {"japanese-ujis",	"euc-jp"},
    {"japanese.euc",	"euc-jp"},
    {"japanese.sjis",	"shiftjis"},
		    {"japanese-sjis",	"shiftjis"},
		    {"japanese-ujis",	"euc-jp"},
		    {"japanese.euc",	"euc-jp"},
		    {"japanese.sjis",	"shiftjis"},
    {"jis0201",		"jis0201"},
    {"jis0208",		"jis0208"},
    {"jis0212",		"jis0212"},
    {"jp_jp",		"shiftjis"},
    {"ko",		"euc-kr"},
    {"ko_kr",		"euc-kr"},
    {"ko_kr.euc",	"euc-kr"},
    {"ko_kw.euckw",	"euc-kr"},
		    {"jp_jp",		"shiftjis"},
		    {"ko",		"euc-kr"},
		    {"ko_kr",		"euc-kr"},
		    {"ko_kr.euc",	"euc-kr"},
		    {"ko_kw.euckw",	"euc-kr"},
    {"koi8-r",		"koi8-r"},
    {"koi8-u",		"koi8-u"},
    {"korean",		"euc-kr"},
		    {"korean",		"euc-kr"},
    {"ksc5601",		"ksc5601"},
    {"maccenteuro",	"macCentEuro"},
    {"maccroatian",	"macCroatian"},
    {"maccyrillic",	"macCyrillic"},
    {"macdingbats",	"macDingbats"},
    {"macgreek",	"macGreek"},
    {"maciceland",	"macIceland"},
    {"macjapan",	"macJapan"},
    {"macroman",	"macRoman"},
    {"macromania",	"macRomania"},
    {"macthai",		"macThai"},
    {"macturkish",	"macTurkish"},
    {"macukraine",	"macUkraine"},
    {"roman8",		"iso8859-1"},
    {"ru",		"iso8859-5"},
    {"ru_ru",		"iso8859-5"},
    {"ru_su",		"iso8859-5"},
		    {"roman8",		"iso8859-1"},
		    {"ru",		"iso8859-5"},
		    {"ru_ru",		"iso8859-5"},
		    {"ru_su",		"iso8859-5"},
    {"shiftjis",	"shiftjis"},
    {"sjis",		"shiftjis"},
		    {"sjis",		"shiftjis"},
    {"symbol",		"symbol"},
    {"tis-620",		"tis-620"},
    {"tis620",		"tis-620"},
    {"turkish8",	"cp857"},
    {"utf8",		"utf-8"},
    {"zh",		"cp936"},
    {"zh_cn.gb2312",	"euc-cn"},
    {"zh_cn.gbk",	"euc-cn"},
    {"zh_cz.gb2312",	"euc-cn"},
    {"zh_tw",		"euc-tw"},
    {"zh_tw.big5",	"big5"},
		    {"tis620",		"tis-620"},
		    {"turkish8",	"cp857"},
		    {"utf8",		"utf-8"},
		    {"zh",		"cp936"},
		    {"zh_cn.gb2312",	"euc-cn"},
		    {"zh_cn.gbk",	"euc-cn"},
		    {"zh_cz.gb2312",	"euc-cn"},
		    {"zh_tw",		"euc-tw"},
		    {"zh_tw.big5",	"big5"},
};

#ifndef TCL_NO_STACK_CHECK
static int		GetStackSize(size_t *stackSizePtr);
#endif /* TCL_NO_STACK_CHECK */
#ifdef HAVE_COREFOUNDATION
static int		MacOSXGetLibraryPath(Tcl_Interp *interp,
			    int maxPathLen, char *tclLibPath);
#endif /* HAVE_COREFOUNDATION */
#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \
	(TCL_THREADS && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
	(defined(TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
	(defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \
	(defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\
	)))
/*
 * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c:
 * initialize release global at startup from uname().
 */
389
390
391
392
393
394
395








396
397
398
399
400
401
402
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464







+
+
+
+
+
+
+
+







     */

#ifdef SIGPIPE
    (void) signal(SIGPIPE, SIG_IGN);
#endif /* SIGPIPE */

#if defined(__FreeBSD__) && defined(__GNUC__)
    /*
     * Adjust the rounding mode to be more conventional. Note that FreeBSD
     * only provides the __fpsetreg() used by the following two for the GNU
     * Compiler. When using, say, Intel's icc they break. (Partially based on
     * patch in BSD ports system from root@celsius.bychok.com)
     */

    fpsetround(FP_RN);
    (void) fpsetmask(0L);
#endif

#if defined(__bsdi__) && (_BSDI_VERSION > 199501)
    /*
     * Find local symbols. Don't report an error if we fail.
     */
414
415
416
417
418
419
420
421

422
423
424
425
426
427
428
476
477
478
479
480
481
482

483
484
485
486
487
488
489
490







-
+







     */

    setlocale(LC_CTYPE, "");

    /*
     * In case the initial locale is not "C", ensure that the numeric
     * processing is done in "C" locale regardless. This is needed because Tcl
     * relies on routines like strtol/strtoul, but should not have locale dependent
     * relies on routines like strtod, but should not have locale dependent
     * behavior.
     */

    setlocale(LC_NUMERIC, "C");

#ifdef GET_DARWIN_RELEASE
    {
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
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







-
+




-
+


-
+















-
+
















+
-
+













+
-
+
+

-
+







 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    32
    Tcl_Obj *pathPtr, *objPtr;
    const char *str;
    CONST char *str;
    Tcl_DString buffer;

    TclNewObj(pathPtr);
    pathPtr = Tcl_NewObj();

    /*
     * Look for the library relative to the TCL_LIBRARY env variable. If the
     * last dirname in the TCL_LIBRARY path does not match the last dirname in
     * the installLib variable, use the last dir name of installLib in
     * addition to the orginal TCL_LIBRARY path.
     */

    str = getenv("TCL_LIBRARY");			/* INTL: Native. */
    Tcl_ExternalToUtfDString(NULL, str, -1, &buffer);
    str = Tcl_DStringValue(&buffer);

    if ((str != NULL) && (str[0] != '\0')) {
	Tcl_DString ds;
	int pathc;
	const char **pathv;
	CONST char **pathv;
	char installLib[LIBRARY_SIZE];

	Tcl_DStringInit(&ds);

	/*
	 * Initialize the substrings used when locating an executable. The
	 * installLib variable computes the path as though the executable is
	 * installed.
	 */

	sprintf(installLib, "lib/tcl%s", TCL_VERSION);

	/*
	 * If TCL_LIBRARY is set, search there.
	 */

	objPtr = Tcl_NewStringObj(str, -1);
	Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, -1));
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);

	Tcl_SplitPath(str, &pathc, &pathv);
	if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
	    /*
	     * If TCL_LIBRARY is set but refers to a different tcl
	     * installation than the current version, try fiddling with the
	     * specified directory to make it refer to this installation by
	     * removing the old "tclX.Y" and substituting the current version
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	Tcl_Free(pathv);
	ckfree((char *) pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different
     * from the prefix.
     */
540
541
542
543
544
545
546
547
548
549



550
551
552
553
554
555
556
605
606
607
608
609
610
611



612
613
614
615
616
617
618
619
620
621







-
-
-
+
+
+







	    objPtr = Tcl_NewStringObj(str, -1);
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	}
    }
    Tcl_DStringFree(&buffer);

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    str = TclGetStringFromObj(pathPtr, lengthPtr);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, str, *lengthPtr + 1);
    str = Tcl_GetStringFromObj(pathPtr, lengthPtr);
    *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
    memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --
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
618
619
620
621
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
686
687
688
689
690
691
692







+
+
+
+
+
+
-
+

-
+




















-
+



-
-
+
+







{
    Tcl_DString encodingName;
    Tcl_SetSystemEncoding(NULL,
	    Tcl_GetEncodingNameFromEnvironment(&encodingName));
    Tcl_DStringFree(&encodingName);
}

void
TclpSetInterfaces(void)
{
    /* do nothing */
}

static const char *
static CONST char *
SearchKnownEncodings(
    const char *encoding)
    CONST char *encoding)
{
    int left = 0;
    int right = sizeof(localeTable)/sizeof(LocaleTable);

    while (left < right) {
	int test = (left + right)/2;
	int code = strcmp(localeTable[test].lang, encoding);

	if (code == 0) {
	    return localeTable[test].encoding;
	}
	if (code < 0) {
	    left = test+1;
	} else {
	    right = test-1;
	}
    }
    return NULL;
}

const char *
CONST char *
Tcl_GetEncodingNameFromEnvironment(
    Tcl_DString *bufPtr)
{
    const char *encoding;
    const char *knownEncoding;
    CONST char *encoding;
    CONST char *knownEncoding;

    Tcl_DStringInit(bufPtr);

    /*
     * Determine the current encoding from the LC_* or LANG environment
     * variables. We previously used setlocale() to determine the locale, but
     * this does not work on some systems (e.g. Linux/i386 RH 5.0).
663
664
665
666
667
668
669
670

671
672
673
674
675
676
677
734
735
736
737
738
739
740

741
742
743
744
745
746
747
748







-
+







	encoding = getenv("LANG");
    }
    if (encoding == NULL || encoding[0] == '\0') {
	encoding = NULL;
    }

    if (encoding != NULL) {
	const char *p;
	CONST char *p;
	Tcl_DString ds;

	Tcl_DStringInit(&ds);
	p = encoding;
	encoding = Tcl_DStringAppend(&ds, p, -1);
	Tcl_UtfToLower(Tcl_DStringValue(&ds));

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
897
898
899
900

901
902
903
904
905
906
907
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















+




+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+


-
-
-
+
+
+















-
+

-
+














-
+

-
+










-
+

-
+





-
+




-
+












-
+











-
+
-










-
+







 * Side effects:
 *	Sets "tclDefaultLibrary", "tcl_pkgPath", and "tcl_platform" Tcl
 *	variables.
 *
 *----------------------------------------------------------------------
 */

#if defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020
/*
 * Helper because whether CFLocaleCopyCurrent and CFLocaleGetIdentifier are
 * strongly or weakly bound varies by version of OSX, triggering warnings.
 */

static inline void
InitMacLocaleInfoVar(
    CFLocaleRef (*localeCopyCurrent)(void),
    CFStringRef (*localeGetIdentifier)(CFLocaleRef),
    Tcl_Interp *interp)
{
    CFLocaleRef localeRef;
    CFStringRef locale;
    char loc[256];

    if (localeCopyCurrent == NULL || localeGetIdentifier == NULL) {
	return;
    }

    localeRef = localeCopyCurrent();
    if (!localeRef) {
	return;
    }

    locale = localeGetIdentifier(localeRef);
    if (locale && CFStringGetCString(locale, loc, 256,
	    kCFStringEncodingUTF8)) {
	if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
	    Tcl_ResetResult(interp);
	}
	Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
    }
    CFRelease(localeRef);
}
#endif /*defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MAX_ALLOWED > 1020*/

void
TclpSetVariables(
    Tcl_Interp *interp)
{
#ifdef __CYGWIN__
    SYSTEM_INFO sysInfo;
    static OSVERSIONINFOW osInfo;
    static int osInfoInitialized = 0;
    char buffer[TCL_INTEGER_SPACE * 2];
#elif !defined(NO_UNAME)
    struct utsname name;
#endif
    int unameOK;
    Tcl_DString ds;

#ifdef HAVE_COREFOUNDATION
    char tclLibPath[MAXPATHLEN + 1];

#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
    /*
     * Set msgcat fallback locale to current CFLocale identifier.
     */

    CFLocaleRef localeRef;
#if MAC_OS_X_VERSION_MAX_ALLOWED > 1020
    InitMacLocaleInfoVar(CFLocaleCopyCurrent, CFLocaleGetIdentifier, interp);

    if (&CFLocaleCopyCurrent != NULL && &CFLocaleGetIdentifier != NULL &&
	    (localeRef = CFLocaleCopyCurrent())) {
	CFStringRef locale = CFLocaleGetIdentifier(localeRef);

	if (locale) {
	    char loc[256];

	    if (CFStringGetCString(locale, loc, 256, kCFStringEncodingUTF8)) {
		if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
		    Tcl_ResetResult(interp);
		}
		Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
	    }
	}
	CFRelease(localeRef);
    }
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED > 1020 */

    if (MacOSXGetLibraryPath(interp, MAXPATHLEN, tclLibPath) == TCL_OK) {
	const char *str;
	CONST char *str;
	CFBundleRef bundleRef;

	Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY);
	Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY);
	Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
	Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
	Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
	Tcl_SetVar(interp, "tcl_pkgPath", " ",
		TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);

	str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
	if ((str != NULL) && (str[0] != '\0')) {
	    char *p = Tcl_DStringValue(&ds);

	    /*
	     * Convert DYLD_FRAMEWORK_PATH from colon to space separated.
	     */

	    do {
		if (*p == ':') {
		    *p = ' ';
		}
	    } while (*p++);
	    Tcl_SetVar2(interp, "tcl_pkgPath", NULL, Tcl_DStringValue(&ds),
	    Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
		    TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
	    Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
	    Tcl_SetVar(interp, "tcl_pkgPath", " ",
		    TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
	    Tcl_DStringFree(&ds);
	}
	bundleRef = CFBundleGetMainBundle();
	if (bundleRef) {
	    CFURLRef frameworksURL;
	    Tcl_StatBuf statBuf;

	    frameworksURL = CFBundleCopyPrivateFrameworksURL(bundleRef);
	    if (frameworksURL) {
		if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
			(unsigned char*) tclLibPath, MAXPATHLEN) &&
			! TclOSstat(tclLibPath, &statBuf) &&
			S_ISDIR(statBuf.st_mode)) {
		    Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
		    Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
			    TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
		    Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
		    Tcl_SetVar(interp, "tcl_pkgPath", " ",
			    TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
		}
		CFRelease(frameworksURL);
	    }
	    frameworksURL = CFBundleCopySharedFrameworksURL(bundleRef);
	    if (frameworksURL) {
		if (CFURLGetFileSystemRepresentation(frameworksURL, TRUE,
			(unsigned char*) tclLibPath, MAXPATHLEN) &&
			! TclOSstat(tclLibPath, &statBuf) &&
			S_ISDIR(statBuf.st_mode)) {
		    Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
		    Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
			    TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
		    Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
		    Tcl_SetVar(interp, "tcl_pkgPath", " ",
			    TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
		}
		CFRelease(frameworksURL);
	    }
	}
	Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath,
	Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
		TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
    } else
#endif /* HAVE_COREFOUNDATION */
    {
	Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY);
	Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
    }

#ifdef DJGPP
    Tcl_SetVar2(interp, "tcl_platform", "platform", "dos", TCL_GLOBAL_ONLY);
#else
    Tcl_SetVar2(interp, "tcl_platform", "platform", "unix", TCL_GLOBAL_ONLY);
#endif

    unameOK = 0;
#ifdef __CYGWIN__
	unameOK = 1;
    if (!osInfoInitialized) {
	void *handle = GetModuleHandleW(L"NTDLL");
	HANDLE handle = GetModuleHandleW(L"NTDLL");
	int(__stdcall *getversion)(void *) =
		(int(__stdcall *)(void *))GetProcAddress(handle, "RtlGetVersion");
	osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
	if (!getversion || getversion(&osInfo)) {
	    GetVersionExW(&osInfo);
	}
	osInfoInitialized = 1;
    }

    GetSystemInfo(&sysInfo);

    Tcl_SetVar2(interp, "tcl_platform", "os",
    Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
	    "Windows NT", TCL_GLOBAL_ONLY);
    sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sysInfo.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }

#elif !defined NO_UNAME
    if (uname(&name) >= 0) {
	const char *native;
	CONST char *native;

	unameOK = 1;

	native = Tcl_ExternalToUtfDString(NULL, name.sysname, -1, &ds);
	Tcl_SetVar2(interp, "tcl_platform", "os", native, TCL_GLOBAL_ONLY);
	Tcl_DStringFree(&ds);

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
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







-
-
-
-
-
-












-
+









-
+

-
+

-
+




-
-
+
+







	} else {
	    user = Tcl_ExternalToUtfDString(NULL, pwEnt->pw_name, -1, &ds);
	}

	Tcl_SetVar2(interp, "tcl_platform", "user", user, TCL_GLOBAL_ONLY);
	Tcl_DStringFree(&ds);
    }

    /*
     * Define what the platform PATH separator is. [TIP #315]
     */

    Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ":", TCL_GLOBAL_ONLY);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensetive, on Windows this matches mixed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or TCL_INDEX_NONE if there is no such entry. The integer at *lengthPtr is
 *	"name", or -1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
int
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
    CONST char *name,		/* Name of desired environment variable
				 * (native). */
    size_t *lengthPtr)		/* Used to return length of name (for
    int *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    size_t i, result = TCL_INDEX_NONE;
    const char *env, *p1, *p2;
    int i, result = -1;
    register CONST char *env, *p1, *p2;
    Tcl_DString envString;

    Tcl_DStringInit(&envString);
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	p1 = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
	p2 = name;

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
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-






+
+
+
-
+


-
-
+
-
-
-
-
-
-
-
+
+

-









    *lengthPtr = i;

  done:
    Tcl_DStringFree(&envString);
    return result;
}

#ifndef TCL_NO_STACK_CHECK
/*
 *----------------------------------------------------------------------
 *
 * TclpGetCStackParams --
 *
 *	Determine the stack params for the current thread: in which
 *	direction does the stack grow, and what is the stack lower (resp.
 *	upper) bound for safe invocation of a new command? This is used to
 *	cache the values needed for an efficient computation of
 *	TclpCheckStackSpace() when the interp is known.
 *
 * Results:
 *	Returns 1 if the stack grows down, in which case a stack lower bound
 *	is stored at stackBoundPtr. If the stack grows up, 0 is returned and
 *	an upper bound is stored at stackBoundPtr. If a bound cannot be
 *	determined NULL is stored at stackBoundPtr.
 *
 *----------------------------------------------------------------------
 */

int
TclpGetCStackParams(
    int **stackBoundPtr)
{
    int result = TCL_OK;
    size_t stackSize = 0;	/* The size of the current stack. */
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
				/* Most variables are actually in a
				 * thread-specific data block to minimise the
				 * impact on the stack. */
#ifdef TCL_CROSS_COMPILE
    if (stackGrowsDown == -1) {
	/*
	 * Not initialised!
	 */

	stackGrowsDown = StackGrowsDown(NULL);
    }
#endif

    /*
     * The first time through in a thread: record the "outermost" stack
     * frame and inquire with the OS about the stack size.
     */

    if (tsdPtr->outerVarPtr == NULL) {
	tsdPtr->outerVarPtr = &result;
	result = GetStackSize(&stackSize);
	if (result != TCL_OK) {
	    /* Can't check, assume it always succeeds */
#ifdef TCL_CROSS_COMPILE
	    stackGrowsDown = 1;
#endif
	    tsdPtr->stackBound = NULL;
	    goto done;
	}
    }

    if (stackSize || (tsdPtr->stackBound &&
	    ((stackGrowsDown && (&result < tsdPtr->stackBound)) ||
	    (!stackGrowsDown && (&result > tsdPtr->stackBound))))) {
	/*
	 * Either the thread's first pass or stack failure: set the params
	 */

	if (!stackSize) {
	    /*
	     * Stack failure: if we didn't already blow up, we are within the
	     * safety area. Recheck with the OS in case the stack was grown.
	     */
	    result = GetStackSize(&stackSize);
	    if (result != TCL_OK) {
		/* Can't check, assume it always succeeds */
#ifdef TCL_CROSS_COMPILE
		stackGrowsDown = 1;
#endif
		tsdPtr->stackBound = NULL;
		goto done;
	    }
	}

	if (stackGrowsDown) {
	    tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr -
		    stackSize);
	    if (tsdPtr->stackBound > tsdPtr->outerVarPtr) {
	    	/* Overflow, that should never happen, just set it to NULL.
	    	 * See [Bug #3166410] */
	    	tsdPtr->stackBound = NULL;
	    }
	} else {
	    tsdPtr->stackBound = (int *) ((char *)tsdPtr->outerVarPtr +
		    stackSize);
	    if (tsdPtr->stackBound < tsdPtr->outerVarPtr) {
	    	/* Overflow, that should never happen, just set it to NULL.
	    	 * See [Bug #3166410] */
	    	tsdPtr->stackBound = NULL;
	    }
	}
    }

    done:
    *stackBoundPtr = tsdPtr->stackBound;
    return stackGrowsDown;
}

#ifdef TCL_CROSS_COMPILE
int
StackGrowsDown(
    int *parent)
{
    int here;
    if (!parent) {
	return StackGrowsDown(&here);
    }
    return (&here < parent);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * GetStackSize --
 *
 *	Discover what the stack size for the current thread/process actually
 *	is. Expects to only ever be called once per thread and then only at a
 *	point when there is a reasonable amount of space left on the current
 *	stack; TclpCheckStackSpace is called sufficiently frequently that that
 *	is true.
 *
 * Results:
 *	TCL_OK if the stack space was discovered, TCL_BREAK if the stack space
 *	was undiscoverable in a way that stack checks should fail, and
 *	TCL_CONTINUE if the stack space was undiscoverable in a way that stack
 *	checks should succeed.
 *
 * Side effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
GetStackSize(
    size_t *stackSizePtr)
{
    size_t rawStackSize;
    struct rlimit rLimit;	/* The result from getrlimit(). */

#ifdef TCL_THREADS
    rawStackSize = TclpThreadGetStackSize();
    if (rawStackSize == (size_t) -1) {
	/*
	 * Some kind of confirmed error in TclpThreadGetStackSize?! Fall back
	 * to whatever getrlimit can determine.
	 */
	STACK_DEBUG(("stack checks: TclpThreadGetStackSize failed in \n"));
    }
    if (rawStackSize > 0) {
	goto finalSanityCheck;
    }

    /*
     * If we have zero or an error, try the system limits instead. After all,
     * the pthread documentation states that threads should always be bound by
     * the system stack size limit in any case.
     */
#endif /* TCL_THREADS */

    if (getrlimit(RLIMIT_STACK, &rLimit) != 0) {
	/*
	 * getrlimit() failed, just fail the whole thing.
	 */
	STACK_DEBUG(("skipping stack checks with failure: getrlimit failed\n"));
	return TCL_BREAK;
    }
    if (rLimit.rlim_cur == RLIM_INFINITY) {
	/*
	 * Limit is "infinite"; there is no stack limit.
	 */
	STACK_DEBUG(("skipping stack checks with success: infinite limit\n"));
	return TCL_CONTINUE;
    }
    rawStackSize = rLimit.rlim_cur;

    /*
     * Final sanity check on the determined stack size. If we fail this,
     * assume there are bogus values about and that we can't actually figure
     * out what the stack size really is.
     */

#ifdef TCL_THREADS /* Stop warning... */
  finalSanityCheck:
#endif
    if (rawStackSize <= 0) {
	STACK_DEBUG(("skipping stack checks with success\n"));
	return TCL_CONTINUE;
    }

    /*
     * Calculate a stack size with a safety margin.
     */

    *stackSizePtr = (rawStackSize / TCL_MAGIC_STACK_DIVISOR)
	    - (getpagesize() * TCL_RESERVED_STACK_PAGES);

    return TCL_OK;
}
#endif /* TCL_NO_STACK_CHECK */

/*
 *----------------------------------------------------------------------
 *
 * MacOSXGetLibraryPath --
 *
 *	If we have a bundle structure for the Tcl installation, then check
 *	there first to see if we can find the libraries there.
 *
 * Results:
 *	TCL_OK if we have found the tcl library; TCL_ERROR otherwise.
 *
 * Side effects:
 *	Same as for Tcl_MacOSXOpenVersionedBundleResources.
 *
 *----------------------------------------------------------------------
 */

#ifdef HAVE_COREFOUNDATION
#ifdef TCL_FRAMEWORK
static int
MacOSXGetLibraryPath(
    Tcl_Interp *interp,
    int maxPathLen,
    char *tclLibPath)
{
    int foundInFramework = TCL_ERROR;

#ifdef TCL_FRAMEWORK
    return Tcl_MacOSXOpenVersionedBundleResources(interp,
    foundInFramework = Tcl_MacOSXOpenVersionedBundleResources(interp,
	    "com.tcltk.tcllibrary", TCL_FRAMEWORK_VERSION, 0, maxPathLen,
	    tclLibPath);
}
#else
#endif
static int
MacOSXGetLibraryPath(
    TCL_UNUSED(Tcl_Interp *),
    TCL_UNUSED(int),
    TCL_UNUSED(char *))
{
    return TCL_ERROR;

    return foundInFramework;
}
#endif
#endif /* HAVE_COREFOUNDATION */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixNotfy.c.



1
2

3
4

5


6
7
8
9
10
11
12
13
14
15






















































































































































































































































16
17
18

19
20
21
22
23
24
25
26
27
28

29
30
31


32

33
34
35
36
37
38

39
40
41
42
43
44
45
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
+
+

-
+

-
+
-
+
+


-





-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+


-
-
-
-
-
-
-
-
+
-
-
-
+
+

+





-
+







#define AT_FORK_INIT_VALUE 0
#define RESET_ATFORK_MUTEX 1
/*
 * tclUnixNotfy.c --
 * tclUnixNotify.c --
 *
 *	This file contains subroutines shared by all notifier backend
 *	This file contains the implementation of the select()-based
 *	implementations on *nix platforms.
 *	Unix-specific notifier, which is the lowest-level part of the Tcl
 *	event loop. This file works together with generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <poll.h>
#include "tclInt.h"
#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <signal.h>

/*
 * This code does deep stub magic to allow replacement of the notifier at
 * runtime.
 */

extern TclStubs tclStubs;
extern Tcl_NotifierProcs tclOriginalNotifier;

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
 */

typedef struct FileHandler {
    int fd;
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since
				 * the last time file handlers were invoked
				 * for this file. */
    Tcl_FileProc *proc;		/* Function to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */

typedef struct FileHandlerEvent {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    int fd;			/* File descriptor that is ready. Used to find
				 * the FileHandler structure for the file
				 * (can't point directly to the FileHandler
				 * structure because it could go away while
				 * the event is queued). */
} FileHandlerEvent;

/*
 * The following structure contains a set of select() masks to track readable,
 * writable, and exception conditions.
 */

typedef struct SelectMasks {
    fd_set readable;
    fd_set writable;
    fd_set exception;
} SelectMasks;

/*
 * The following static structure contains the state information for the
 * select based implementation of the Tcl notifier. One of these structures is
 * created for each thread that is using the notifier.
 */

typedef struct ThreadSpecificData {
    FileHandler *firstFileHandlerPtr;
				/* Pointer to head of file handler list. */
    SelectMasks checkMasks;	/* This structure is used to build up the
				 * masks to be used in the next call to
				 * select. Bits are set in response to calls
				 * to Tcl_CreateFileHandler. */
    SelectMasks readyMasks;	/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
    int numFdBits;		/* Number of valid bits in checkMasks (one
				 * more than highest fd for which
				 * Tcl_WatchFile has been called). */
#ifdef TCL_THREADS
    int onList;			/* True if it is in this list */
    unsigned int pollState;	/* pollState is used to implement a polling
				 * handshake between each thread and the
				 * notifier thread. Bits defined below. */
    struct ThreadSpecificData *nextPtr, *prevPtr;
				/* All threads that are currently waiting on
				 * an event have their ThreadSpecificData
				 * structure on a doubly-linked listed formed
				 * from these pointers. You must hold the
				 * notifierMutex lock before accessing these
				 * fields. */
#ifdef __CYGWIN__
    void *event;     /* Any other thread alerts a notifier
	 * that an event is ready to be processed
	 * by sending this event. */
    void *hwnd;			/* Messaging window. */
#else /* !__CYGWIN__ */
    pthread_cond_t waitCV;	/* Any other thread alerts a notifier that an
				 * event is ready to be processed by signaling
				 * this condition variable. */
#endif /* __CYGWIN__ */
    int waitCVinitialized;	/* Variable to flag initialization of the structure */
    int eventReady;		/* True if an event is ready to be processed.
				 * Used as condition flag together with waitCV
				 * above. */
#endif /* TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#ifdef TCL_THREADS
/*
 * The following static indicates the number of threads that have initialized
 * notifiers.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

static int notifierCount = 0;

/*
 * The following variable points to the head of a doubly-linked list of
 * ThreadSpecificData structures for all threads that are currently waiting on
 * an event.
 *
 * You must hold the notifierMutex lock before accessing this list.
 */

static ThreadSpecificData *waitingListPtr = NULL;

/*
 * The notifier thread spends all its time in select() waiting for a file
 * descriptor associated with one of the threads on the waitingListPtr list to
 * do something interesting. But if the contents of the waitingListPtr list
 * ever changes, we need to wake up and restart the select() system call. You
 * can wake up the notifier thread by writing a single byte to the file
 * descriptor defined below. This file descriptor is the input-end of a pipe
 * and the notifier thread is listening for data on the output-end of the same
 * pipe. Hence writing to this file descriptor will cause the select() system
 * call to return and wake up the notifier thread.
 *
 * You must hold the notifierMutex lock before writing to the pipe.
 */

static int triggerPipe = -1;

/*
 * The notifierMutex locks access to all of the global notifier state.
 */

static pthread_mutex_t notifierInitMutex = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t notifierMutex     = PTHREAD_MUTEX_INITIALIZER;
/*
 * The following static indicates if the notifier thread is running.
 *
 * You must hold the notifierInitMutex before accessing this variable.
 */

static int notifierThreadRunning = 0;

/*
 * The notifier thread signals the notifierCV when it has finished
 * initializing the triggerPipe and right before the notifier thread
 * terminates.
 */

static pthread_cond_t notifierCV = PTHREAD_COND_INITIALIZER;

/*
 * The pollState bits
 *	POLL_WANT is set by each thread before it waits on its condition
 *		variable. It is checked by the notifier before it does select.
 *	POLL_DONE is set by the notifier if it goes into select after seeing
 *		POLL_WANT. The idea is to ensure it tries a select with the
 *		same bits the initial thread had set.
 */

#define POLL_WANT	0x1
#define POLL_DONE	0x2

/*
 * This is the thread ID of the notifier thread that does select.
 */

static Tcl_ThreadId notifierThread;

#endif /* TCL_THREADS */

/*
 * Static routines defined in this file.
 */

#ifdef TCL_THREADS
static void	NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int	atForkInit = AT_FORK_INIT_VALUE;
static void	AtForkPrepare(void);
static void	AtForkParent(void);
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);

/*
 * Import of Windows API when building threaded with Cygwin.
 */

#if defined(TCL_THREADS) && defined(__CYGWIN__)
typedef struct {
    void *hwnd;
    unsigned int *message;
    int wParam;
    int lParam;
    int time;
    int x;
    int y;
} MSG;

typedef struct {
    unsigned int style;
    void *lpfnWndProc;
    int cbClsExtra;
    int cbWndExtra;
    void *hInstance;
    void *hIcon;
    void *hCursor;
    void *hbrBackground;
    void *lpszMenuName;
    const void *lpszClassName;
} WNDCLASS;

extern void __stdcall	CloseHandle(void *);
extern void *__stdcall	CreateEventW(void *, unsigned char, unsigned char,
			    void *);
extern void * __stdcall	CreateWindowExW(void *, const void *, const void *,
			    DWORD, int, int, int, int, void *, void *, void *, void *);
extern DWORD __stdcall	DefWindowProcW(void *, int, void *, void *);
extern unsigned char __stdcall	DestroyWindow(void *);
extern int __stdcall	DispatchMessageW(const MSG *);
extern unsigned char __stdcall	GetMessageW(MSG *, void *, int, int);
extern void __stdcall	MsgWaitForMultipleObjects(DWORD, void *,
			    unsigned char, DWORD, DWORD);
extern unsigned char __stdcall	PeekMessageW(MSG *, void *, int, int, int);
extern unsigned char __stdcall	PostMessageW(void *, unsigned int, void *,
				    void *);
extern void __stdcall	PostQuitMessage(int);
extern void *__stdcall	RegisterClassW(const WNDCLASS *);
extern unsigned char __stdcall	ResetEvent(void *);
extern unsigned char __stdcall	TranslateMessage(const MSG *);

/*
 * Static routines defined in this file.
 * Threaded-cygwin specific functions in this file:
 */

static int		FileHandlerEventProc(Tcl_Event *evPtr, int flags);
#if !TCL_THREADS
# undef NOTIFIER_EPOLL
# undef NOTIFIER_KQUEUE
# define NOTIFIER_SELECT
#elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)
# define NOTIFIER_SELECT
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
static DWORD __stdcall	NotifierProc(void *hwnd, unsigned int message,
# if defined(HAVE_PTHREAD_ATFORK)
static void		AtForkChild(void);
# endif /* HAVE_PTHREAD_ATFORK */
			    void *wParam, void *lParam);
#endif /* TCL_THREADS && __CYGWIN__ */

#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * StartNotifierThread --
 *
 *	Start a notifier thread and wait for the notifier pipe to be created.
 *	Start a notfier thread and wait for the notifier pipe to be created.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Running Thread.
 *
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
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+















-
-
+
-
-
-
-
-








-
-
-
-
-
-
-
+
+

-
-
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	    pthread_mutex_unlock(&notifierMutex);

	    notifierThreadRunning = 1;
	}
	pthread_mutex_unlock(&notifierInitMutex);
    }
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitNotifier --
 *
 *	Initializes the platform specific notifier state.
 *
 * Results:
 *	Returns a handle to the notifier state for this thread.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#ifdef TCL_THREADS
    tsdPtr->eventReady = 0;

    /*
     * Initialize thread specific condition variable for this thread.
     */
    if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
	WNDCLASS class;

	class.style = 0;
	class.cbClsExtra = 0;
	class.cbWndExtra = 0;
	class.hInstance = TclWinGetTclInstance();
	class.hbrBackground = NULL;
	class.lpszMenuName = NULL;
	class.lpszClassName = L"TclNotifier";
	class.lpfnWndProc = NotifierProc;
	class.hIcon = NULL;
	class.hCursor = NULL;

	RegisterClassW(&class);
	tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
		class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
		TclWinGetTclInstance(), NULL);
	tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
		0 /* !signaled */, NULL);
#else
	pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif /* NOTIFIER_SELECT */
#endif /* __CYGWIN__ */
	tsdPtr->waitCVinitialized = 1;
    }

    pthread_mutex_lock(&notifierInitMutex);
#if defined(HAVE_PTHREAD_ATFORK)
    /*
     * Install pthread_atfork handlers to clean up the notifier in the
     * child of a fork.
     */

    if (!atForkInit) {
	int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);

	if (result) {
	    Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
	}
	atForkInit = 1;
    }
#endif /* HAVE_PTHREAD_ATFORK */

	notifierCount++;

	pthread_mutex_unlock(&notifierInitMutex);

#endif /* TCL_THREADS */
    return (ClientData) tsdPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
 *	This function is called to cleanup the notifier state before a thread
 *	is terminated.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May terminate the background notifier thread if this is the last
 *	notifier instance.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)		/* Not used. */
{
#ifdef TCL_THREADS
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    pthread_mutex_lock(&notifierInitMutex);
    notifierCount--;

    /*
     * If this is the last thread to use the notifier, close the notifier
     * pipe and wait for the background thread to terminate.
     */

    if (notifierCount == 0) {

	if (triggerPipe != -1) {
	    if (write(triggerPipe, "q", 1) != 1) {
		Tcl_Panic("Tcl_FinalizeNotifier: %s",
			"unable to write q to triggerPipe");
	    }
	    close(triggerPipe);
	    pthread_mutex_lock(&notifierMutex);
	    while(triggerPipe != -1) {
		pthread_cond_wait(&notifierCV, &notifierMutex);
	    }
	    pthread_mutex_unlock(&notifierMutex);
	    if (notifierThreadRunning) {
		int result = pthread_join((pthread_t) notifierThread, NULL);

		if (result) {
		    Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
			    "thread");
		}
		notifierThreadRunning = 0;
	    }
	}
    }

    /*
     * Clean up any synchronization objects in the thread local storage.
     */

#ifdef __CYGWIN__
    DestroyWindow(tsdPtr->hwnd);
    CloseHandle(tsdPtr->event);
#else /* __CYGWIN__ */
    pthread_cond_destroy(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
    tsdPtr->waitCVinitialized = 0;

    pthread_mutex_unlock(&notifierInitMutex);
#endif /* TCL_THREADS */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
 *	Wake up the specified notifier from any thread. This routine is called
 *	by the platform independent notifier code whenever the Tcl_ThreadAlert
 *	routine is called. This routine is guaranteed not to be called on a
 *	given notifier after Tcl_FinalizeNotifier is called for that notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	select(2) notifier:
 *		signals the notifier condition variable for the specified
 *	Signals the notifier condition variable for the specified notifier.
 *		notifier.
 *	epoll(7) notifier:
 *		write(2)s to the eventfd(2) of the specified thread.
 *	kqueue(2) notifier:
 *		write(2)s to the trigger pipe(2) of the specified thread.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(
    ClientData clientData)
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;
#ifdef TCL_THREADS
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

	pthread_mutex_lock(&notifierMutex);
	tsdPtr->eventReady = 1;
    pthread_mutex_lock(&notifierMutex);
    tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
	PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#   else
	pthread_cond_broadcast(&tsdPtr->waitCV);
#   endif /* __CYGWIN__ */
	pthread_mutex_unlock(&notifierMutex);
#ifdef __CYGWIN__
    PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#else /* __CYGWIN__ */
    pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
    pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
#else /* !NOTIFIER_SELECT */
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData;
#if defined(NOTIFIER_EPOLL) && defined(HAVE_EVENTFD)
	uint64_t eventFdVal = 1;
	if (write(tsdPtr->triggerEventFd, &eventFdVal,
		sizeof(eventFdVal)) != sizeof(eventFdVal)) {
	    Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd",
		(void *)tsdPtr);
	}
#else
	if (write(tsdPtr->triggerPipe[1], "", 1) != 1) {
	    Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerPipe",
		(void *)tsdPtr);
	}
#endif /* NOTIFIER_EPOLL && HAVE_EVENTFD */
#endif /* NOTIFIER_SELECT */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
 *
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
518
519
520
521
522
523
524

525
526









527
528
529
530
531
532
533
534
535
536
537
538
539
540
541







-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
    Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
{
    if (tclNotifierHooks.setTimerProc) {
	tclNotifierHooks.setTimerProc(timePtr);
	return;
    } else {
	/*
	 * The interval timer doesn't do anything in this implementation,
	 * because the only event loop is via Tcl_DoOneEvent, which passes
	 * timeout values to Tcl_WaitForEvent.
	 */
    /*
     * The interval timer doesn't do anything in this implementation,
     * because the only event loop is via Tcl_DoOneEvent, which passes
     * timeout values to Tcl_WaitForEvent.
     */

    if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
	tclStubs.tcl_SetTimer(timePtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
190
191
192
193
194
195
196
197
198
199
200
201
202

203

204

205
206





































































































































































207
208
209
210
211
212
213
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
618
619
620
621
622
623
624
625
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
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







-
-
-
-
-

+

+

+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 */

void
Tcl_ServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else if (mode == TCL_SERVICE_ALL) {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
    if (mode == TCL_SERVICE_ALL) {
	StartNotifierThread("Tcl_ServiceModeHook");
    }
#endif
}
#endif /* NOTIFIER_SELECT */
    }

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This function registers a file handler with the select notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateFileHandler(
    int fd,			/* Handle of stream to watch. */
    int mask,			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
				 * conditions under which proc should be
				 * called. */
    Tcl_FileProc *proc,		/* Function to call for each selected
				 * event. */
    ClientData clientData)	/* Arbitrary data to pass to proc. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileHandler *filePtr;

    if (tclStubs.tcl_CreateFileHandler !=
	    tclOriginalNotifier.createFileHandlerProc) {
	tclStubs.tcl_CreateFileHandler(fd, mask, proc, clientData);
	return;
    }

    for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->readyMask = 0;
	filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
	tsdPtr->firstFileHandlerPtr = filePtr;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;
    filePtr->mask = mask;

    /*
     * Update the check masks for this file.
     */

    if (mask & TCL_READABLE) {
	FD_SET(fd, &tsdPtr->checkMasks.readable);
    } else {
	FD_CLR(fd, &tsdPtr->checkMasks.readable);
    }
    if (mask & TCL_WRITABLE) {
	FD_SET(fd, &tsdPtr->checkMasks.writable);
    } else {
	FD_CLR(fd, &tsdPtr->checkMasks.writable);
    }
    if (mask & TCL_EXCEPTION) {
	FD_SET(fd, &tsdPtr->checkMasks.exception);
    } else {
	FD_CLR(fd, &tsdPtr->checkMasks.exception);
    }
    if (tsdPtr->numFdBits <= fd) {
	tsdPtr->numFdBits = fd+1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for a file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteFileHandler(
    int fd)			/* Stream id for which to remove callback
				 * function. */
{
    FileHandler *filePtr, *prevPtr;
    int i;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tclStubs.tcl_DeleteFileHandler !=
	    tclOriginalNotifier.deleteFileHandlerProc) {
	tclStubs.tcl_DeleteFileHandler(fd);
	return;
    }

    /*
     * Find the entry for the given file (and return if there isn't one).
     */

    for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
	prevPtr = filePtr, filePtr = filePtr->nextPtr) {
	if (filePtr == NULL) {
	    return;
	}
	if (filePtr->fd == fd) {
	    break;
	}
    }

    /*
     * Update the check masks for this file.
     */

    if (filePtr->mask & TCL_READABLE) {
	FD_CLR(fd, &tsdPtr->checkMasks.readable);
    }
    if (filePtr->mask & TCL_WRITABLE) {
	FD_CLR(fd, &tsdPtr->checkMasks.writable);
    }
    if (filePtr->mask & TCL_EXCEPTION) {
	FD_CLR(fd, &tsdPtr->checkMasks.exception);
    }

    /*
     * Find current max fd.
     */

    if (fd+1 == tsdPtr->numFdBits) {
	int numFdBits = 0;

	for (i = fd-1; i >= 0; i--) {
	    if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
		    || FD_ISSET(i, &tsdPtr->checkMasks.writable)
		    || FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
		numFdBits = i+1;
		break;
	    }
	}
	tsdPtr->numFdBits = numFdBits;
    }

    /*
     * Clean up information in the callback record.
     */

    if (prevPtr == NULL) {
	tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }
    ckfree((char *) filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileHandlerEventProc --
 *
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
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
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
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
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
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

















1385
1386
1387
1388

1389
1390
1391
1392
1393
1394
1395







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+

-
-
-
+

-
+



-
+





-
+
-

-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+


-







	    filePtr->proc(filePtr->clientData, mask);
	}
	break;
    }
    return 1;
}

#if defined(TCL_THREADS) && defined(__CYGWIN__)

static DWORD __stdcall
NotifierProc(
    void *hwnd,
    unsigned int message,
    void *wParam,
    void *lParam)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (message != 1024) {
	return DefWindowProcW(hwnd, message, wParam, lParam);
    }

    /*
     * Process all of the runnable events.
     */

    tsdPtr->eventReady = 1;
    Tcl_ServiceAll();
    return 0;
}
#endif /* TCL_THREADS && __CYGWIN__ */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This function is called by Tcl_DoOneEvent to wait for new events on
 *	the message queue. If the block time is 0, then Tcl_WaitForEvent just
 *	polls without blocking.
 *
 * Results:
 *	Returns -1 if the select would block forever, otherwise returns 0.
 *
 * Side effects:
 *	Queues file events that are detected by the select.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    FileHandler *filePtr;
    int mask;
    Tcl_Time vTime;
#ifdef TCL_THREADS
    int waitForFiles;
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
#ifdef __CYGWIN__
    MSG msg;
#endif /* __CYGWIN__ */
#else
    /*
     * Impl. notes: timeout & timeoutPtr are used if, and only if threads
     * are not enabled. They are the arguments for the regular select()
     * used when the core is not thread-enabled.
     */

    struct timeval timeout, *timeoutPtr;
    int numFound;
#endif /* TCL_THREADS */
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
	return tclStubs.tcl_WaitForEvent(timePtr);
    }

    /*
     * Set up the timeout structure. Note that if there are no events to
     * check for, we return with a negative result rather than blocking
     * forever.
     */

    if (timePtr != NULL) {
	/*
     * TIP #233 (Virtualized Time). Is virtual time in effect? And do
     * we actually have something to scale? If yes to both then we
     * call the handler to do this scaling.
	 */

	if (timePtr->sec != 0 || timePtr->usec != 0) {
	    vTime = *timePtr;
	    tclScaleTimeProcPtr(&vTime, tclTimeClientData);
	    timePtr = &vTime;
	}
#ifndef TCL_THREADS
	timeout.tv_sec = timePtr->sec;
	timeout.tv_usec = timePtr->usec;
	timeoutPtr = &timeout;
    } else if (tsdPtr->numFdBits == 0) {
	/*
	 * If there are no threads, no timeout, and no fds registered,
	 * then there are no events possible and we must avoid deadlock.
	 * Note that this is not entirely correct because there might be a
	 * signal that could interrupt the select call, but we don't
	 * handle that case if we aren't using threads.
	 */

	return -1;
    } else {
	timeoutPtr = NULL;
#endif /* !TCL_THREADS */
    }

#ifdef TCL_THREADS
    /*
     * Start notifier thread and place this thread on the list of
     * interested threads, signal the notifier thread, and wait for a
     * response or a timeout.
     */
    StartNotifierThread("Tcl_WaitForEvent");

    pthread_mutex_lock(&notifierMutex);

    if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
#if defined(__APPLE__) && defined(__LP64__)
	    /*
	     * On 64-bit Darwin, pthread_cond_timedwait() appears to have
	     * a bug that causes it to wait forever when passed an
	     * absolute time which has already been exceeded by the system
	     * time; as a workaround, when given a very brief timeout,
	     * just do a poll. [Bug 1457797]
	     */
	    || timePtr->usec < 10
#endif /* __APPLE__ && __LP64__ */
	    )) {
	/*
	 * Cannot emulate a polling select with a polling condition
	 * variable. Instead, pretend to wait for files and tell the
	 * notifier thread what we are doing. The notifier thread makes
	 * sure it goes through select with its select mask in the same
	 * state as ours currently is. We block until that happens.
	 */

	waitForFiles = 1;
	tsdPtr->pollState = POLL_WANT;
	timePtr = NULL;
    } else {
	waitForFiles = (tsdPtr->numFdBits > 0);
	tsdPtr->pollState = 0;
    }

    if (waitForFiles) {
	/*
	 * Add the ThreadSpecificData structure of this thread to the list
	 * of ThreadSpecificData structures of all threads that are
	 * waiting on file events.
	 */

	tsdPtr->nextPtr = waitingListPtr;
	if (waitingListPtr) {
	    waitingListPtr->prevPtr = tsdPtr;
	}
	tsdPtr->prevPtr = 0;
	waitingListPtr = tsdPtr;
	tsdPtr->onList = 1;

	if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
	    Tcl_Panic("Tcl_WaitForEvent: %s",
		    "unable to write to triggerPipe");
	}
    }

    FD_ZERO(&tsdPtr->readyMasks.readable);
    FD_ZERO(&tsdPtr->readyMasks.writable);
    FD_ZERO(&tsdPtr->readyMasks.exception);

    if (!tsdPtr->eventReady) {
#ifdef __CYGWIN__
	if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
	    DWORD timeout;

	    if (timePtr) {
		timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	    } else {
		timeout = 0xFFFFFFFF;
	    }
	    pthread_mutex_unlock(&notifierMutex);
	    MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
	    pthread_mutex_lock(&notifierMutex);
	}
#else
	if (timePtr != NULL) {
	    Tcl_Time now;
	    struct timespec ptime;

	    Tcl_GetTime(&now);
	    ptime.tv_sec = timePtr->sec + now.sec + (timePtr->usec + now.usec) / 1000000;
	    ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);

	    pthread_cond_timedwait(&tsdPtr->waitCV, &notifierMutex, &ptime);
	} else {
	    pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
	}
#endif /* __CYGWIN__ */
    }
    tsdPtr->eventReady = 0;

#ifdef __CYGWIN__
    while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
	/*
	 * Retrieve and dispatch the message.
	 */

	DWORD result = GetMessageW(&msg, NULL, 0, 0);

	if (result == 0) {
	    PostQuitMessage(msg.wParam);
	    /* What to do here? */
	} else if (result != (DWORD) -1) {
	    TranslateMessage(&msg);
	    DispatchMessageW(&msg);
	}
    }
    ResetEvent(tsdPtr->event);
#endif /* __CYGWIN__ */

    if (waitForFiles && tsdPtr->onList) {
	/*
	 * Remove the ThreadSpecificData structure of this thread from the
	 * waiting list. Alert the notifier thread to recompute its select
	 * masks - skipping this caused a hang when trying to close a pipe
	 * which the notifier thread was still doing a select on.
	 */

	if (tsdPtr->prevPtr) {
	    tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
	} else {
	    waitingListPtr = tsdPtr->nextPtr;
	}
	if (tsdPtr->nextPtr) {
	    tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
	}
	tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
	tsdPtr->onList = 0;
	if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
	    Tcl_Panic("Tcl_WaitForEvent: %s",
		    "unable to write to triggerPipe");
	}
    }

#else
    tsdPtr->readyMasks = tsdPtr->checkMasks;
    numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
	    &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
	    timeoutPtr);

    /*
     * Some systems don't clear the masks after an error, so we have to do
     * it here.
     */

    if (numFound == -1) {
	FD_ZERO(&tsdPtr->readyMasks.readable);
	FD_ZERO(&tsdPtr->readyMasks.writable);
	FD_ZERO(&tsdPtr->readyMasks.exception);
    }
#endif /* TCL_THREADS */

    /*
     * Queue all detected file events before returning.
     */

    for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
	    filePtr = filePtr->nextPtr) {
	mask = 0;
	if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) {
	    mask |= TCL_READABLE;
	}
	if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) {
	    mask |= TCL_WRITABLE;
	}
	if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) {
	    mask |= TCL_EXCEPTION;
	}

	if (!mask) {
	    continue;
	}

	/*
	 * Don't bother to queue an event if the mask was previously
	 * non-zero since an event must still be on the queue.
	 */

	if (filePtr->readyMask == 0) {
	    FileHandlerEvent *fileEvPtr =
		    (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));

	    fileEvPtr->header.proc = FileHandlerEventProc;
	    fileEvPtr->fd = filePtr->fd;
	    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	}
	filePtr->readyMask = mask;
    }
#ifdef TCL_THREADS
    pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
    return 0;
}

#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * NotifierThreadProc --
 *
 *	This routine is the initial (and only) function executed by the
 *	special notifier thread. Its job is to wait for file descriptors to
 *	become readable or writable or to have an exception condition and then
 *	to notify other threads who are interested in this information by
 *	signalling a condition variable. Other threads can signal this
 *	notifier thread of a change in their interests by writing a single
 *	byte to a special pipe that the notifier thread is monitoring.
 *
 * Result:
 *	None. Once started, this routine never exits. It dies with the overall
 *	process.
 *
 * Side effects:
 *	The trigger pipe used to signal the notifier thread is created when
 *	the notifier thread first starts.
 *
 *----------------------------------------------------------------------
 */

static void
NotifierThreadProc(
    ClientData clientData)	/* Not used. */
{
    ThreadSpecificData *tsdPtr;
    fd_set readableMask;
    fd_set writableMask;
    fd_set exceptionMask;
    int fds[2];
    int i, numFdBits = 0, receivePipe;
    long found;
    struct timeval poll = {0., 0.}, *timePtr;
    char buf[2];

    if (pipe(fds) != 0) {
	Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
    }

    receivePipe = fds[0];

    if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make receive pipe non blocking");
    }
    if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make trigger pipe non blocking");
    }
    if (fcntl(receivePipe, F_SETFD, FD_CLOEXEC) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make receive pipe close-on-exec");
    }
    if (fcntl(fds[1], F_SETFD, FD_CLOEXEC) < 0) {
	Tcl_Panic("NotifierThreadProc: %s",
		"could not make trigger pipe close-on-exec");
    }

    /*
     * Install the write end of the pipe into the global variable.
     */

    pthread_mutex_lock(&notifierMutex);
    triggerPipe = fds[1];

    /*
     * Signal any threads that are waiting.
     */

    pthread_cond_broadcast(&notifierCV);
    pthread_mutex_unlock(&notifierMutex);

    /*
     * Look for file events and report them to interested threads.
     */

    while (1) {
	FD_ZERO(&readableMask);
	FD_ZERO(&writableMask);
	FD_ZERO(&exceptionMask);

	/*
	 * Compute the logical OR of the select masks from all the waiting
	 * notifiers.
	 */

	pthread_mutex_lock(&notifierMutex);
	timePtr = NULL;
	for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	    for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
		if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) {
		    FD_SET(i, &readableMask);
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) {
		    FD_SET(i, &writableMask);
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
		    FD_SET(i, &exceptionMask);
		}
	    }
	    if (tsdPtr->numFdBits > numFdBits) {
		numFdBits = tsdPtr->numFdBits;
	    }
	    if (tsdPtr->pollState & POLL_WANT) {
		/*
		 * Here we make sure we go through select() with the same mask
		 * bits that were present when the thread tried to poll.
		 */

		tsdPtr->pollState |= POLL_DONE;
		timePtr = &poll;
	    }
	}
	pthread_mutex_unlock(&notifierMutex);

	/*
	 * Set up the select mask to include the receive pipe.
	 */

	if (receivePipe >= numFdBits) {
	    numFdBits = receivePipe + 1;
	}
	FD_SET(receivePipe, &readableMask);

	if (select(numFdBits, &readableMask, &writableMask, &exceptionMask,
		timePtr) == -1) {
	    /*
	     * Try again immediately on an error.
	     */

	    continue;
	}

	/*
	 * Alert any threads that are waiting on a ready file descriptor.
	 */

	pthread_mutex_lock(&notifierMutex);
	for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
	    found = 0;

	    for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
		if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
			&& FD_ISSET(i, &readableMask)) {
		    FD_SET(i, &tsdPtr->readyMasks.readable);
		    found = 1;
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.writable)
			&& FD_ISSET(i, &writableMask)) {
		    FD_SET(i, &tsdPtr->readyMasks.writable);
		    found = 1;
		}
		if (FD_ISSET(i, &tsdPtr->checkMasks.exception)
			&& FD_ISSET(i, &exceptionMask)) {
		    FD_SET(i, &tsdPtr->readyMasks.exception);
		    found = 1;
		}
	    }

	    if (found || (tsdPtr->pollState & POLL_DONE)) {
		tsdPtr->eventReady = 1;
		if (tsdPtr->onList) {
		    /*
		     * Remove the ThreadSpecificData structure of this thread
		     * from the waiting list. This prevents us from
		     * continuously spining on select until the other threads
		     * runs and services the file event.
		     */

		    if (tsdPtr->prevPtr) {
			tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
		    } else {
			waitingListPtr = tsdPtr->nextPtr;
		    }
		    if (tsdPtr->nextPtr) {
			tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
		    }
		    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
		    tsdPtr->onList = 0;
		    tsdPtr->pollState = 0;
		}
#ifdef __CYGWIN__
		PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#else /* __CYGWIN__ */
		pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
	    }
	}
	pthread_mutex_unlock(&notifierMutex);

	/*
	 * Consume the next byte from the notifier pipe if the pipe was
	 * readable. Note that there may be multiple bytes pending, but to
	 * avoid a race condition we only read one at a time.
	 */

	if (FD_ISSET(receivePipe, &readableMask)) {
	    i = read(receivePipe, buf, 1);

	    if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
		/*
		 * Someone closed the write end of the pipe or sent us a Quit
		 * message [Bug: 4139] and then closed the write end of the
		 * pipe so we need to shut down the notifier thread.
		 */

		break;
	    }
	}
    }

    /*
     * Clean up the read end of the pipe and signal any threads waiting on
     * termination of the notifier thread.
     */

    close(receivePipe);
    pthread_mutex_lock(&notifierMutex);
    triggerPipe = -1;
    pthread_cond_broadcast(&notifierCV);
    pthread_mutex_unlock(&notifierMutex);

    TclpThreadExit(0);
}

#if defined(HAVE_PTHREAD_ATFORK)
/*
 *----------------------------------------------------------------------
 *
 * AtForkPrepare --
 *
 *	Lock the notifier in preparation for a fork.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
AtForkPrepare(void)
{
#if RESET_ATFORK_MUTEX == 0
    pthread_mutex_lock(&notifierInitMutex);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * AlertSingleThread --
 * AtForkParent --
 *
 *	Notify a single thread that is waiting on a file descriptor to become
 *	readable or writable or to have an exception condition.
 *	notifierMutex must be held.
 *	Unlock the notifier in the parent after a fork.
 *
 * Result:
 * Results:
 *	None.
 *
 * Side effects:
 *	The condition variable associated with the thread is broadcasted.
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
AlertSingleThread(
AtForkParent(void)
    ThreadSpecificData *tsdPtr)
{
    tsdPtr->eventReady = 1;
    if (tsdPtr->onList) {
        /*
         * Remove the ThreadSpecificData structure of this thread from the
         * waiting list. This prevents us from continuously spinning on
         * epoll_wait until the other threads runs and services the file
         * event.
         */

#if RESET_ATFORK_MUTEX == 0
        if (tsdPtr->prevPtr) {
    	    tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
        } else {
    	    waitingListPtr = tsdPtr->nextPtr;
        }
        if (tsdPtr->nextPtr) {
    	    tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
        }
        tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
        tsdPtr->onList = 0;
        tsdPtr->pollState = 0;
    }
#ifdef __CYGWIN__
    PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
#else /* !__CYGWIN__ */
    pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
    pthread_mutex_unlock(&notifierInitMutex);
#endif
}

#if defined(HAVE_PTHREAD_ATFORK)
/*
 *----------------------------------------------------------------------
 *
 * AtForkChild --
 *
 *	Unlock and reinstall the notifier in the child after a fork.
 *
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
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
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
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
1439
1440
1441
1442


1443
1444
1445
1446
1447


1448
1449
1450
1451

1452
1453
1454

1455

1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474



















































































































































1475

1476
1477
1478
1479
1480
1481
1482
1483







+
+
+


+



-
+
-

-
+




















-
-
+
+



-
-
+
+


-
+


-
+
-



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+








static void
AtForkChild(void)
{
    if (notifierThreadRunning == 1) {
	pthread_cond_destroy(&notifierCV);
    }
#if RESET_ATFORK_MUTEX == 0
    pthread_mutex_unlock(&notifierInitMutex);
#else
    pthread_mutex_init(&notifierInitMutex, NULL);
    pthread_mutex_init(&notifierMutex, NULL);
#endif
    pthread_cond_init(&notifierCV, NULL);

    /*
     * notifierThreadRunning == 1: thread is running, (there might be data in
     * notifierThreadRunning == 1: thread is running, (there might be data in notifier lists)
     *		notifier lists)
     * atForkInit == 0: InitNotifier was never called
     * notifierCount != 0: unbalanced InitNotifier() / FinalizeNotifier calls
     * notifierCount != 0: unbalanced  InitNotifier() / FinalizeNotifier calls
     * waitingListPtr != 0: there are threads currently waiting for events.
     */

    if (atForkInit == 1) {

	notifierCount = 0;
	if (notifierThreadRunning == 1) {
	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	    notifierThreadRunning = 0;

	    close(triggerPipe);
	    triggerPipe = -1;
	    /*
	     * The waitingListPtr might contain event info from multiple
	     * threads, which are invalid here, so setting it to NULL is not
	     * unreasonable.
	     */
	    waitingListPtr = NULL;

	    /*
	     * The tsdPtr from before the fork is copied as well. But since we
	     * are paranoic, we don't trust its condvar and reset it.
	     * The tsdPtr from before the fork is copied as well.  But since
	     * we are paranoic, we don't trust its condvar and reset it.
	     */
#ifdef __CYGWIN__
	    DestroyWindow(tsdPtr->hwnd);
	    tsdPtr->hwnd = CreateWindowExW(NULL, className,
		    className, 0, 0, 0, 0, 0, NULL, NULL,
	    tsdPtr->hwnd = CreateWindowExW(NULL, L"TclNotifier",
		    L"TclNotifier", 0, 0, 0, 0, 0, NULL, NULL,
		    TclWinGetTclInstance(), NULL);
	    ResetEvent(tsdPtr->event);
#else /* !__CYGWIN__ */
#else
	    pthread_cond_destroy(&tsdPtr->waitCV);
	    pthread_cond_init(&tsdPtr->waitCV, NULL);
#endif /* __CYGWIN__ */
#endif

	    /*
	     * In case, we had multiple threads running before the fork,
	     * make sure, we don't try to reach out to their thread local data.
	     */
	    tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;

	    /*
	     * The list of registered event handlers at fork time is in
	     * tsdPtr->firstFileHandlerPtr;
	     */
	}
    }

    Tcl_InitNotifier();
}
#endif /* HAVE_PTHREAD_ATFORK */

#endif /* TCL_THREADS */

#endif /* NOTIFIER_SELECT */
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
/*
 *----------------------------------------------------------------------
 *
 * TclUnixWaitForFile --
 *
 *	This function waits synchronously for a file to become readable or
 *	writable, with an optional timeout.
 *
 * Results:
 *	The return value is an OR'ed combination of TCL_READABLE,
 *	TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
 *	present on file at the time of the return. This function will not
 *	return until either "timeout" milliseconds have elapsed or at least
 *	one of the conditions given by mask has occurred for file (a return
 *	value of 0 means that a timeout occurred). No normal events will be
 *	serviced during the execution of this function.
 *
 * Side effects:
 *	Time passes.
 *
 *----------------------------------------------------------------------
 */

int
TclUnixWaitForFile(
    int fd,			/* Handle for file on which to wait. */
    int mask,			/* What to wait for: OR'ed combination of
				 * TCL_READABLE, TCL_WRITABLE, and
				 * TCL_EXCEPTION. */
    int timeout)		/* Maximum amount of time to wait for one of
				 * the conditions in mask to occur, in
				 * milliseconds. A value of 0 means don't wait
				 * at all, and a value of -1 means wait
				 * forever. */
{
    Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
    struct timeval blockTime, *timeoutPtr;
    struct pollfd pollFds[1];
    int numFound, result = 0, pollTimeout;

    /*
     * If there is a non-zero finite timeout, compute the time when we give
     * up.
     */

    if (timeout > 0) {
	Tcl_GetTime(&now);
	abortTime.sec = now.sec + timeout / 1000;
	abortTime.usec = now.usec + (timeout % 1000) * 1000;
	if (abortTime.usec >= 1000000) {
	    abortTime.usec -= 1000000;
	    abortTime.sec += 1;
	}
	timeoutPtr = &blockTime;
    } else if (timeout == 0) {
	timeoutPtr = &blockTime;
	blockTime.tv_sec = 0;
	blockTime.tv_usec = 0;
    } else {
	timeoutPtr = NULL;
    }

    /*
     * Setup the pollfd structure for the fd.
     */

    pollFds[0].fd = fd;
    pollFds[0].events = pollFds[0].revents = 0;
    if (mask & TCL_READABLE) {
	pollFds[0].events |= (POLLIN | POLLHUP);
    }
    if (mask & TCL_WRITABLE) {
	pollFds[0].events |= POLLOUT;
    }
    if (mask & TCL_EXCEPTION) {
	pollFds[0].events |= POLLERR;
    }

    /*
     * Loop in a mini-event loop of our own, waiting for either the file to
     * become ready or a timeout to occur.
     */

    do {
	if (timeout > 0) {
	    blockTime.tv_sec = abortTime.sec - now.sec;
	    blockTime.tv_usec = abortTime.usec - now.usec;
	    if (blockTime.tv_usec < 0) {
		blockTime.tv_sec -= 1;
		blockTime.tv_usec += 1000000;
	    }
	    if (blockTime.tv_sec < 0) {
		blockTime.tv_sec = 0;
		blockTime.tv_usec = 0;
	    }
	}

	/*
	 * Wait for the event or a timeout.
	 */

	if (!timeoutPtr) {
	    pollTimeout = -1;
	} else if (!timeoutPtr->tv_sec && !timeoutPtr->tv_usec) {
	    pollTimeout = 0;
	} else {
	    pollTimeout = (int) timeoutPtr->tv_sec * 1000;
	    if (timeoutPtr->tv_usec) {
		pollTimeout += (int) timeoutPtr->tv_usec / 1000;
	    }
	}
	numFound = poll(pollFds, 1, pollTimeout);
	if (numFound == 1) {
	    result = 0;
	    if (pollFds[0].revents & (POLLIN | POLLHUP)) {
		result |= TCL_READABLE;
	    }
	    if (pollFds[0].revents & POLLOUT) {
		result |= TCL_WRITABLE;
	    }
	    if (pollFds[0].revents & POLLERR) {
		result |= TCL_EXCEPTION;
	    }
	    if (result) {
		break;
	    }
	}
	if (timeout == 0) {
	    break;
	}
	if (timeout < 0) {
	    continue;
	}

	/*
	 * The select returned early, so we need to recompute the timeout.
	 */

	Tcl_GetTime(&now);
    } while ((abortTime.sec > now.sec)
	    || (abortTime.sec == now.sec && abortTime.usec > now.usec));
    return result;
}

#endif /* !HAVE_COREFOUNDATION */


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixPipe.c.

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
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







+
+
+
+
+
+
+
+
+
+













-
+

















+
-
-
-
-
-
-
+
+
+
+
+
+

-
+

-
+








-
+


-
+







-
+








#include "tclInt.h"

#ifdef USE_VFORK
#define fork vfork
#endif

/*
 * Fallback temporary file location the temporary file generation code. Can be
 * overridden at compile time for when it is known that temp files can't be
 * written to /tmp (hello, iOS!).
 */

#ifndef TCL_TEMPORARY_FILE_DIRECTORY
#define TCL_TEMPORARY_FILE_DIRECTORY	"/tmp"
#endif

/*
 * The following macros convert between TclFile's and fd's. The conversion
 * simple involves shifting fd's up by one to ensure that no valid fd is ever
 * the same as NULL.
 */

#define MakeFile(fd)	((TclFile) INT2PTR(((int) (fd)) + 1))
#define GetFd(file)	(PTR2INT(file) - 1)

/*
 * This structure describes per-instance state of a pipe based channel.
 */

typedef struct {
typedef struct PipeState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    TclFile inFile;		/* Output from pipe. */
    TclFile outFile;		/* Input to pipe. */
    TclFile errorFile;		/* Error output from pipe. */
    int numPids;		/* How many processes are attached to this
				 * pipe? */
    Tcl_Pid *pidPtr;		/* The process IDs themselves. Allocated by
				 * the creator of the pipe. */
    int isNonBlocking;		/* Nonzero when the pipe is in nonblocking
				 * mode. Used to decide whether to wait for
				 * the children at close time. */
} PipeState;

/*
 * Declarations for local functions defined in this file:
 */

static const char *	DefaultTempDir(void);
static int		PipeBlockModeProc(void *instanceData, int mode);
static int		PipeClose2Proc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		PipeGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		PipeInputProc(void *instanceData, char *buf,
static int		PipeBlockModeProc(ClientData instanceData, int mode);
static int		PipeCloseProc(ClientData instanceData,
			    Tcl_Interp *interp);
static int		PipeGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		PipeInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		PipeOutputProc(void *instanceData,
static int		PipeOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		PipeWatchProc(void *instanceData, int mask);
static void		PipeWatchProc(ClientData instanceData, int mask);
static void		RestoreSignals(void);
static int		SetupStdFile(TclFile file, int type);

/*
 * This structure describes the channel type structure for command pipe based
 * I/O:
 */

static const Tcl_ChannelType pipeChannelType = {
static Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    PipeCloseProc,		/* Close proc. */
    PipeInputProc,		/* Input proc. */
    PipeOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    PipeWatchProc,		/* Initialize notifier. */
    PipeGetHandleProc,		/* Get OS handles out of channel. */
    PipeClose2Proc,		/* close2proc. */
    NULL,			/* close2proc. */
    PipeBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc */
    NULL,			/* thread action proc */
    NULL			/* truncation */
};
103
104
105
106
107
108
109
110

111
112
113
114
115






116
117
118
119
120
121
122
123
114
115
116
117
118
119
120

121
122




123
124
125
126
127
128

129
130
131
132
133
134
135







-
+

-
-
-
-
+
+
+
+
+
+
-







 */

TclFile
TclpMakeFile(
    Tcl_Channel channel,	/* Channel to get file from. */
    int direction)		/* Either TCL_READABLE or TCL_WRITABLE. */
{
    void *data;
    ClientData data;

    if (Tcl_GetChannelHandle(channel, direction, &data) != TCL_OK) {
	return NULL;
    }

    if (Tcl_GetChannelHandle(channel, direction,
	    (ClientData *) &data) == TCL_OK) {
	return MakeFile(PTR2INT(data));
    } else {
	return (TclFile) NULL;
    }
    return MakeFile(PTR2INT(data));
}

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenFile --
 *
184
185
186
187
188
189
190




191




192






193
194
195
196
197
198
199

200

201
202
203
204
205
206
207
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







+
+
+
+
-
+
+
+
+

+
+
+
+
+
+




-
-
-
+

+







 *----------------------------------------------------------------------
 */

TclFile
TclpCreateTempFile(
    const char *contents)	/* String to write into temp file, or NULL. */
{
    char fileName[L_tmpnam + 9];
    const char *native;
    Tcl_DString dstring;
    int fd;
    int fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, NULL);

    /*
     * We should also check against making more then TMP_MAX of these.
     */

    strcpy(fileName, DefaultTempDir());			/* INTL: Native. */
    if (fileName[strlen(fileName) - 1] != '/') {
	strcat(fileName, "/");				/* INTL: Native. */
    }
    strcat(fileName, "tclXXXXXX");
    fd = mkstemp(fileName);				/* INTL: Native. */
    if (fd == -1) {
	return NULL;
    }
    fcntl(fd, F_SETFD, FD_CLOEXEC);
    if (contents != NULL) {
	Tcl_DString dstring;
	char *native;
    unlink(fileName);					/* INTL: Native. */

    if (contents != NULL) {
	native = Tcl_UtfToExternalDString(NULL, contents, -1, &dstring);
	if (write(fd, native, Tcl_DStringLength(&dstring)) == -1) {
	    close(fd);
	    Tcl_DStringFree(&dstring);
	    return NULL;
	}
	Tcl_DStringFree(&dstring);
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
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







+
-
+


+
+
+
-
+
-
-
+
+
+
+
+
+

-


-

+
-
+
+

-
-
-
+



-
+

-
+

-
+
-

-
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpTempFileName(void)
{
    char fileName[L_tmpnam + 9];
    Tcl_Obj *retVal, *nameObj;
    Tcl_Obj *result = NULL;
    int fd;

    /*
     * We should also check against making more then TMP_MAX of these.
     */
    TclNewObj(nameObj);

    Tcl_IncrRefCount(nameObj);
    fd = TclUnixOpenTemporaryFile(NULL, NULL, NULL, nameObj);
    strcpy(fileName, DefaultTempDir());	/* INTL: Native. */
    if (fileName[strlen(fileName) - 1] != '/') {
	strcat(fileName, "/");		/* INTL: Native. */
    }
    strcat(fileName, "tclXXXXXX");
    fd = mkstemp(fileName);		/* INTL: Native. */
    if (fd == -1) {
	Tcl_DecrRefCount(nameObj);
	return NULL;
    }

    fcntl(fd, F_SETFD, FD_CLOEXEC);
    unlink(fileName);			/* INTL: Native. */
    TclpObjDeleteFile(nameObj);

    result = TclpNativeToNormalized((ClientData) fileName);
    close(fd);
    retVal = Tcl_DuplicateObj(nameObj);
    Tcl_DecrRefCount(nameObj);
    return retVal;
    return result;
}

/*
 *----------------------------------------------------------------------------
 *----------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 * DefaultTempDir --
 *
 *	Constructs a file name in the native file system where a dynamically
 *	Helper that does *part* of what tempnam() does.
 *	loaded library may be placed.
 *
 * Results:
 *	Returns the constructed file name. If an error occurs, returns NULL
 *	and leaves an error message in the interpreter result.
 *
 *----------------------------------------------------------------------
 */
 * On Unix, it works to load a shared object from a file of any name, so this
 * function is merely a thin wrapper around TclpTempFileName().
 *

 *----------------------------------------------------------------------------
 */

Tcl_Obj *
TclpTempFileNameForLibrary(
    Tcl_Interp *interp,		/* Tcl interpreter. */
static const char *
DefaultTempDir(void)
{
    const char *dir;
    struct stat buf;

    dir = getenv("TMPDIR");
    if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode)
	    && access(dir, W_OK)) {
	return dir;
    TCL_UNUSED(Tcl_Obj *) /*path*/)
{
    Tcl_Obj *retval = TclpTempFileName();

    if (retval == NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't create temporary file: %s",
    }

#ifdef P_tmpdir
    dir = P_tmpdir;
    if (stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)) {
	return dir;
    }
#endif

    /*
     * Assume that the default location ("/tmp" if not overridden) is always
     * an existing writable directory; we've no recovery mechanism if it
     * isn't.
		Tcl_PosixError(interp)));
    }
    return retval;
     */

    return TCL_TEMPORARY_FILE_DIRECTORY;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreatePipe --
 *
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
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







-
-
+
+








+
-
-
+
+









-
-
+
+
-








    /*
     * Create a pipe that the child can use to return error information if
     * anything goes wrong.
     */

    if (TclpCreatePipe(&errPipeIn, &errPipeOut) == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't create pipe: %s", Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't create pipe: ",
		Tcl_PosixError(interp), NULL);
	goto error;
    }

    /*
     * We need to allocate and convert this before the fork so it is properly
     * deallocated later
     */

    dsArray = (Tcl_DString *)
    dsArray = (Tcl_DString *)TclStackAlloc(interp, argc * sizeof(Tcl_DString));
    newArgv = (char **)TclStackAlloc(interp, (argc+1) * sizeof(char *));
	    TclStackAlloc(interp, argc * sizeof(Tcl_DString));
    newArgv = (char **) TclStackAlloc(interp, (argc+1) * sizeof(char *));
    newArgv[argc] = NULL;
    for (i = 0; i < argc; i++) {
	newArgv[i] = Tcl_UtfToExternalDString(NULL, argv[i], -1, &dsArray[i]);
    }

#ifdef USE_VFORK
    /*
     * After vfork(), do not call code in the child that changes global state,
     * because it is using the parent's memory space at that point and writes
     * might corrupt the parent: so ensure standard channels are initialized
     * in the parent, otherwise SetupStdFile() might initialize them in the
     * might corrupt the parent: so ensure standard channels are initialized in
     * the parent, otherwise SetupStdFile() might initialize them in the child.
     * child.
     */

    if (!inputFile) {
	Tcl_GetStdChannel(TCL_STDIN);
    }
    if (!outputFile) {
        Tcl_GetStdChannel(TCL_STDOUT);
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
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







-
+













-
+

-
+

-
+














-
-
+
+













-
+


-


-
-
+








	if (!SetupStdFile(inputFile, TCL_STDIN)
		|| !SetupStdFile(outputFile, TCL_STDOUT)
		|| (!joinThisError && !SetupStdFile(errorFile, TCL_STDERR))
		|| (joinThisError &&
			((dup2(1,2) == -1) || (fcntl(2, F_SETFD, 0) != 0)))) {
	    sprintf(errSpace,
		    "%dforked process couldn't set up input/output", errno);
		    "%dforked process couldn't set up input/output: ", errno);
	    len = strlen(errSpace);
	    if (len != (size_t) write(fd, errSpace, len)) {
		    Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
	    }
	    _exit(1);
	}

	/*
	 * Close the input side of the error pipe.
	 */

	RestoreSignals();
	execvp(newArgv[0], newArgv);			/* INTL: Native. */
	sprintf(errSpace, "%dcouldn't execute \"%.150s\"", errno, argv[0]);
	sprintf(errSpace, "%dcouldn't execute \"%.150s\": ", errno, argv[0]);
	len = strlen(errSpace);
	if (len != (size_t) write(fd, errSpace, len)) {
    if (len != (size_t) write(fd, errSpace, len)) {
	    Tcl_Panic("TclpCreateProcess: unable to write to errPipeOut");
	}
    }
	_exit(1);
    }

    /*
     * Free the mem we used for the fork
     */

    for (i = 0; i < argc; i++) {
	Tcl_DStringFree(&dsArray[i]);
    }
    TclStackFree(interp, newArgv);
    TclStackFree(interp, dsArray);

    if (pid == -1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't fork child process: %s", Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't fork child process: ",
		Tcl_PosixError(interp), NULL);
	goto error;
    }

    /*
     * Read back from the error pipe to see if the child started up OK. The
     * info in the pipe (if any) consists of a decimal errno value followed by
     * an error message.
     */

    TclpCloseFile(errPipeOut);
    errPipeOut = NULL;

    fd = GetFd(errPipeIn);
    count = read(fd, errSpace, sizeof(errSpace) - 1);
    count = read(fd, errSpace, (size_t) (sizeof(errSpace) - 1));
    if (count > 0) {
	char *end;

	errSpace[count] = 0;
	errno = strtol(errSpace, &end, 10);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("%s: %s",
		end, Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, end, Tcl_PosixError(interp), NULL);
	goto error;
    }

    TclpCloseFile(errPipeIn);
    *pidPtr = (Tcl_Pid) INT2PTR(pid);
    return TCL_OK;

740
741
742
743
744
745
746
747

748
749
750
751
752
753
754
773
774
775
776
777
778
779

780
781
782
783
784
785
786
787







-
+







    Tcl_Pid *pidPtr)		/* An array of process identifiers. Allocated
				 * by the caller, freed when the channel is
				 * closed or the processes are detached (in a
				 * background exec). */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    int channelId;
    PipeState *statePtr = (PipeState *)Tcl_Alloc(sizeof(PipeState));
    PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
    int mode;

    statePtr->inFile = readFile;
    statePtr->outFile = writeFile;
    statePtr->errorFile = errorFile;
    statePtr->numPids = numPids;
    statePtr->pidPtr = pidPtr;
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
813
814
815
816
817
818
819

820
821
822











































823
824
825
826
827
828
829







-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







     * For backward compatibility with previous versions of Tcl, we use
     * "file%d" as the base name for pipes even though it would be more
     * natural to use "pipe%d".
     */

    sprintf(channelName, "file%d", channelId);
    statePtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
	    statePtr, mode);
	    (ClientData) statePtr, mode);
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreatePipe --
 *
 *	System dependent interface to create a pipe for the [chan pipe]
 *	command. Stolen from TclX.
 *
 * Results:
 *	TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *	Registers two channels.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CreatePipe(
    Tcl_Interp *interp,		/* Errors returned in result. */
    Tcl_Channel *rchan,		/* Returned read side. */
    Tcl_Channel *wchan,		/* Returned write side. */
    TCL_UNUSED(int) /*flags*/)	/* Reserved for future use. */
{
    int fileNums[2];

    if (pipe(fileNums) < 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("pipe creation failed: %s",
		Tcl_PosixError(interp)));
	return TCL_ERROR;
    }

    fcntl(fileNums[0], F_SETFD, FD_CLOEXEC);
    fcntl(fileNums[1], F_SETFD, FD_CLOEXEC);

    *rchan = Tcl_MakeFileChannel(INT2PTR(fileNums[0]), TCL_READABLE);
    Tcl_RegisterChannel(interp, *rchan);
    *wchan = Tcl_MakeFileChannel(INT2PTR(fileNums[1]), TCL_WRITABLE);
    Tcl_RegisterChannel(interp, *wchan);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetAndDetachPids --
 *
 *	This function is invoked in the generic implementation of a
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
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







-

+










-
+
-

-
-
-
+
+
+

-

-
+







void
TclGetAndDetachPids(
    Tcl_Interp *interp,		/* Interpreter to append the PIDs to. */
    Tcl_Channel chan)		/* Handle for the pipeline. */
{
    PipeState *pipePtr;
    const Tcl_ChannelType *chanTypePtr;
    Tcl_Obj *pidsObj;
    int i;
    char buf[TCL_INTEGER_SPACE];

    /*
     * Punt if the channel is not a command channel.
     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if (chanTypePtr != &pipeChannelType) {
	return;
    }

    pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan);
    pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
    TclNewObj(pidsObj);
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewWideIntObj(
		PTR2INT(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
	TclFormatInt(buf, (long) TclpGetPid(pipePtr->pidPtr[i]));
	Tcl_AppendElement(interp, buf);
	Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
	ckfree((char *) pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+




-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+










-
+


-
+
+











-
-
-
+
+
+
-

-
+





-
-
+
+


-
-


-
+
-
-
+

-
-

-
-
-
-
-
-
-
-







 *	Sets the device into blocking or non-blocking mode.
 *
 *----------------------------------------------------------------------
 */

static int
PipeBlockModeProc(
    void *instanceData,	/* Pipe state. */
    ClientData instanceData,	/* Pipe state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    PipeState *psPtr = instanceData;

    if (psPtr->inFile
	    && TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) {
	return errno;
    }
    if (psPtr->outFile
	    && TclUnixSetBlockingMode(GetFd(psPtr->outFile), mode) < 0) {
	return errno;
    if (psPtr->inFile) {
	if (TclUnixSetBlockingMode(GetFd(psPtr->inFile), mode) < 0) {
	    return errno;
	}
    }
    if (psPtr->outFile) {
	if (TclUnixSetBlockingMode(GetFd(psPtr->outFile), mode) < 0) {
	    return errno;
	}
    }

    psPtr->isNonBlocking = (mode == TCL_MODE_NONBLOCKING);

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * PipeClose2Proc
 * PipeCloseProc --
 *
 *	This function is invoked by the generic IO level to perform
 *	pipeline-type-specific half or full-close.
 *	channel-type-specific cleanup when a command pipeline channel is
 *	closed.
 *
 * Results:
 *	0 on success, errno otherwise.
 *
 * Side effects:
 *	Closes the command pipeline channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeClose2Proc(
    void *instanceData,	/* The pipe to close. */
    Tcl_Interp *interp,		/* For error reporting. */
PipeCloseProc(
    ClientData instanceData,	/* The pipe to close. */
    Tcl_Interp *interp)		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    PipeState *pipePtr = (PipeState *)instanceData;
    PipeState *pipePtr;
    Tcl_Channel errChan;
    int errorCode, result;

    errorCode = 0;
    result = 0;

    if (((!flags) || (flags & TCL_CLOSE_READ)) && (pipePtr->inFile != NULL)) {
    pipePtr = (PipeState *) instanceData;
    if (pipePtr->inFile) {
	if (TclpCloseFile(pipePtr->inFile) < 0) {
	    errorCode = errno;
	} else {
	    pipePtr->inFile = NULL;
	}
    }
    if (((!flags) || (flags & TCL_CLOSE_WRITE)) && (pipePtr->outFile != NULL)
    if (pipePtr->outFile) {
	    && (errorCode == 0)) {
	if (TclpCloseFile(pipePtr->outFile) < 0) {
	if ((TclpCloseFile(pipePtr->outFile) < 0) && (errorCode == 0)) {
	    errorCode = errno;
	} else {
	    pipePtr->outFile = NULL;
	}
    }

    /*
     * If half-closing, stop here.
     */

    if (flags) {
	return errorCode;
    }

    if (pipePtr->isNonBlocking || TclInExit()) {
	/*
	 * If the channel is non-blocking or Tcl is being cleaned up, just
	 * detach the children PIDs, reap them (important if we are in a
	 * dynamic load module), and discard the errorFile.
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
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







-
+
-








-
+

-
+







	/*
	 * Wrap the error file into a channel and give it to the cleanup
	 * routine.
	 */

	if (pipePtr->errorFile) {
	    errChan = Tcl_MakeFileChannel(
		    INT2PTR(GetFd(pipePtr->errorFile)),
		(ClientData) INT2PTR(GetFd(pipePtr->errorFile)), TCL_READABLE);
		    TCL_READABLE);
	} else {
	    errChan = NULL;
	}
	result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
		errChan);
    }

    if (pipePtr->numPids != 0) {
	Tcl_Free(pipePtr->pidPtr);
	ckfree((char *) pipePtr->pidPtr);
    }
    Tcl_Free(pipePtr);
    ckfree((char *) pipePtr);
    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

/*
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
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







-
+





-
+














-
+





-
-
+
+
+







 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeInputProc(
    void *instanceData,	/* Pipe state. */
    ClientData instanceData,	/* Pipe state. */
    char *buf,			/* Where to store data read. */
    int toRead,			/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    PipeState *psPtr = (PipeState *) instanceData;
    int bytesRead;		/* How many bytes were actually read from the
				 * input device? */

    *errorCodePtr = 0;

    /*
     * Assume there is always enough input available. This will block
     * appropriately, and read will unblock as soon as a short read is
     * possible, if the channel is in blocking mode. If the channel is
     * nonblocking, the read will never block. Some OSes can throw an
     * interrupt error, for which we should immediately retry. [Bug #415131]
     */

    do {
	bytesRead = read(GetFd(psPtr->inFile), buf, toRead);
	bytesRead = read(GetFd(psPtr->inFile), buf, (size_t) toRead);
    } while ((bytesRead < 0) && (errno == EINTR));

    if (bytesRead < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return bytesRead;
    } else {
	return bytesRead;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PipeOutputProc--
 *
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
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







-
+




-
+










-
+





-
-
+
+
+







 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
PipeOutputProc(
    void *instanceData,	/* Pipe state. */
    ClientData instanceData,	/* Pipe state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    PipeState *psPtr = (PipeState *) instanceData;
    int written;

    *errorCodePtr = 0;

    /*
     * Some OSes can throw an interrupt error, for which we should immediately
     * retry. [Bug #415131]
     */

    do {
	written = write(GetFd(psPtr->outFile), buf, toWrite);
	written = write(GetFd(psPtr->outFile), buf, (size_t) toWrite);
    } while ((written < 0) && (errno == EINTR));

    if (written < 0) {
	*errorCodePtr = errno;
	return -1;
    }
    return written;
    } else {
	return written;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PipeWatchProc --
 *
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
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
1140
1141
1142
1143
1144







-
+




-
+





-
-
+
+
+







-
-
+
+
+







 *	seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
PipeWatchProc(
    void *instanceData,	/* The pipe state. */
    ClientData instanceData,	/* The pipe state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    PipeState *psPtr = (PipeState *) instanceData;
    int newmask;

    if (psPtr->inFile) {
	newmask = mask & (TCL_READABLE | TCL_EXCEPTION);
	if (newmask) {
	    Tcl_CreateFileHandler(GetFd(psPtr->inFile), newmask,
		    (Tcl_FileProc *) Tcl_NotifyChannel, psPtr->channel);
	    Tcl_CreateFileHandler(GetFd(psPtr->inFile), mask,
		    (Tcl_FileProc *) Tcl_NotifyChannel,
		    (ClientData) psPtr->channel);
	} else {
	    Tcl_DeleteFileHandler(GetFd(psPtr->inFile));
	}
    }
    if (psPtr->outFile) {
	newmask = mask & (TCL_WRITABLE | TCL_EXCEPTION);
	if (newmask) {
	    Tcl_CreateFileHandler(GetFd(psPtr->outFile), newmask,
		    (Tcl_FileProc *) Tcl_NotifyChannel, psPtr->channel);
	    Tcl_CreateFileHandler(GetFd(psPtr->outFile), mask,
		    (Tcl_FileProc *) Tcl_NotifyChannel,
		    (ClientData) psPtr->channel);
	} else {
	    Tcl_DeleteFileHandler(GetFd(psPtr->outFile));
	}
    }
}

/*
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
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







-
+

-
+

-
+


-
+



-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
PipeGetHandleProc(
    void *instanceData,	/* The pipe state. */
    ClientData instanceData,	/* The pipe state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    void **handlePtr)	/* Where to store the handle. */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    PipeState *psPtr = (PipeState *)instanceData;
    PipeState *psPtr = (PipeState *) instanceData;

    if (direction == TCL_READABLE && psPtr->inFile) {
	*handlePtr = INT2PTR(GetFd(psPtr->inFile));
	*handlePtr = (ClientData) INT2PTR(GetFd(psPtr->inFile));
	return TCL_OK;
    }
    if (direction == TCL_WRITABLE && psPtr->outFile) {
	*handlePtr = INT2PTR(GetFd(psPtr->outFile));
	*handlePtr = (ClientData) INT2PTR(GetFd(psPtr->outFile));
	return TCL_OK;
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
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
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







-
+




-
-
-
-
-






-
+




+
+
+
+
+

-
-
+
+


-
+
+







-
-
+
+

+
-
+
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_PidObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Channel chan;
    PipeState *pipePtr;
    int i;
    Tcl_Obj *resultPtr;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }

    if (objc == 1) {
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid()));
	Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid()));
    } else {
	/*
	 * Get the channel and make sure that it refers to a pipe.
	 */
	Tcl_Channel chan;
	const Tcl_ChannelType *chanTypePtr;
	PipeState *pipePtr;
	int i;
	Tcl_Obj *resultPtr, *longObjPtr;

	chan = Tcl_GetChannel(interp, TclGetString(objv[1]), NULL);
	if (chan == NULL) {
	chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
	if (chan == (Tcl_Channel) NULL) {
	    return TCL_ERROR;
	}
	if (Tcl_GetChannelType(chan) != &pipeChannelType) {
	chanTypePtr = Tcl_GetChannelType(chan);
	if (chanTypePtr != &pipeChannelType) {
	    return TCL_OK;
	}

	/*
	 * Extract the process IDs from the pipe structure.
	 */

	pipePtr = (PipeState *)Tcl_GetChannelInstanceData(chan);
	TclNewObj(resultPtr);
	pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
	resultPtr = Tcl_NewObj();
	for (i = 0; i < pipePtr->numPids; i++) {
	    longObjPtr = Tcl_NewLongObj((long) TclpGetPid(pipePtr->pidPtr[i]));
	    Tcl_ListObjAppendElement(NULL, resultPtr,
	    Tcl_ListObjAppendElement(NULL, resultPtr, longObjPtr);
		    Tcl_NewWideIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
	}
	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*

Changes to unix/tclUnixPort.h.

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
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







+


+
+
+
+


-








-
-
-
-
-
-
-



+
+
+
+
+




-
-
-



















-
+















+
+
+
-
+
+


+
+
+

-
+

-

-
+
















-
+
-
-
-









+
-
+
+
+
+
+
+







#endif

#ifdef __CYGWIN__
#ifdef __cplusplus
extern "C" {
#endif
    /* Make some symbols available without including <windows.h> */
#   define DWORD unsigned int
#   define CP_UTF8 65001
#   define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004
#   define HANDLE void *
#   define HINSTANCE void *
#   define HMODULE void *
#   define MAX_PATH 260
#   define SOCKET unsigned int
#   define WSAEWOULDBLOCK 10035
    typedef unsigned short WCHAR;
#ifdef __clang__
#pragma clang diagnostic push
#pragma clang diagnostic ignored "-Wignored-attributes"
#endif
    __declspec(dllimport) extern __stdcall int GetModuleHandleExW(unsigned int, const void *, void *);
    __declspec(dllimport) extern __stdcall int GetModuleFileNameW(void *, const void *, int);
    __declspec(dllimport) extern __stdcall int WideCharToMultiByte(int, int, const void *, int,
	    char *, int, const char *, void *);
    __declspec(dllimport) extern __stdcall int MultiByteToWideChar(int, int, const char *, int,
	    WCHAR *, int);
    __declspec(dllimport) extern __stdcall void OutputDebugStringW(const WCHAR *);
    __declspec(dllimport) extern __stdcall int IsDebuggerPresent(void);
    __declspec(dllimport) extern __stdcall int GetLastError(void);
    __declspec(dllimport) extern __stdcall int GetFileAttributesW(const WCHAR *);
    __declspec(dllimport) extern __stdcall int SetFileAttributesW(const WCHAR *, int);
    __declspec(dllimport) extern int cygwin_conv_path(int, const void *, void *, int);
#ifdef __clang__
#pragma clang diagnostic pop
#endif
/* On Cygwin, the environment is imported from the Cygwin DLL. */
#ifndef __x86_64__
#   define environ __cygwin_environ
    extern char **__cygwin_environ;
#endif
#   define timezone _timezone
    extern int TclOSstat(const char *name, void *statBuf);
    extern int TclOSlstat(const char *name, void *statBuf);
#ifdef __cplusplus
}
#endif
#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
#   define TclOSstat(name, buf) stat64(name, (struct stat64 *)buf)
#   define TclOSlstat(name,buf) lstat64(name, (struct stat64 *)buf)
#else
#   define TclOSstat(name, buf) stat(name, (struct stat *)buf)
#   define TclOSlstat(name, buf) lstat(name, (struct stat *)buf)
#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>
#ifdef TIME_WITH_SYS_TIME
#if TIME_WITH_SYS_TIME
#   include <sys/time.h>
#   include <time.h>
#else
#ifdef HAVE_SYS_TIME_H
#   include <sys/time.h>
#else
#   include <time.h>
#endif
#endif
#ifndef NO_SYS_WAIT_H
#   include <sys/wait.h>
#endif
#ifdef HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#ifdef NO_LIMITS_H
#   include "../compat/limits.h"
#else
#include <limits.h>
#   include <limits.h>
#endif
#ifdef HAVE_STDINT_H
#   include <stdint.h>
#endif
#ifdef HAVE_UNISTD_H
#   include <unistd.h>
#else
#   include "../compat/stdint.h"
#   include "../compat/unistd.h"
#endif
#include <unistd.h>

MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
extern int TclUnixSetBlockingMode(int fd, int mode);

#include <utime.h>

/*
 *---------------------------------------------------------------------------
 * Socket support stuff: This likely needs more work to parameterize for each
 * system.
 *---------------------------------------------------------------------------
 */

#include <sys/socket.h>		/* struct sockaddr, SOCK_STREAM, ... */
#ifndef NO_UNAME
#   include <sys/utsname.h>	/* uname system call. */
#endif
#include <netinet/in.h>		/* struct in_addr, struct sockaddr_in */
#include <arpa/inet.h>		/* inet_ntoa() */
#include <netdb.h>		/* getaddrinfo() */
#include <netdb.h>		/* gethostbyname() */
#ifdef NEED_FAKE_RFC2553
# include "../compat/fake-rfc2553.h"
#endif

/*
 *---------------------------------------------------------------------------
 * Some platforms (e.g. SunOS) don't define FLT_MAX and FLT_MIN, so we look
 * for an alternative definition. If no other alternative is available we use
 * a reasonable guess.
 *---------------------------------------------------------------------------
 */

#ifndef NO_FLOAT_H
#include <float.h>
#   include <float.h>
#else
#ifndef NO_VALUES_H
#   include <values.h>
#endif
#endif

#ifndef FLT_MAX
#   ifdef MAXFLOAT
#	define FLT_MAX	MAXFLOAT
#   else
#	define FLT_MAX	3.402823466E+38F
#   endif
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
314
315
316
317
318
319
320




321
322
323
324
325
326
327







-
-
-
-







 * The stuff below is needed by the "time" command. If this system has no
 * gettimeofday call, then must use times() instead.
 *---------------------------------------------------------------------------
 */

#ifdef NO_GETTOD
#   include <sys/times.h>
#else
#   ifdef HAVE_BSDGETTIMEOFDAY
#	define gettimeofday BSDgettimeofday
#   endif
#endif

#ifdef GETTOD_NOT_DECLARED
extern int	gettimeofday(struct timeval *tp,
			    struct timezone *tzp);
#endif

443
444
445
446
447
448
449








450
451
452
453
454
455
456
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468







+
+
+
+
+
+
+
+







#   ifdef NAME_MAX
#	define MAXNAMLEN	NAME_MAX
#   else
#	define MAXNAMLEN	255
#   endif
#endif

/*
 * Make sure that L_tmpnam is defined.
 */

#ifndef L_tmpnam
#   define L_tmpnam 100
#endif

/*
 *---------------------------------------------------------------------------
 * The following macro defines the type of the mask arguments to select:
 *---------------------------------------------------------------------------
 */

#ifndef NO_FD_SET
540
541
542
543
544
545
546






547
548
549
550
551
552
553
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571







+
+
+
+
+
+







#else
#   if defined(_sgi) || defined(__sgi)
#	define environ	_environ
#   endif
extern char **		environ;
#endif

/*
 * There is no platform-specific panic routine for Unix in the Tcl internals.
 */

#define TclpPanic ((Tcl_PanicProc *) NULL)

/*
 *---------------------------------------------------------------------------
 * Darwin specifc configure overrides.
 *---------------------------------------------------------------------------
 */

#ifdef __APPLE__
566
567
568
569
570
571
572









573
574
575
576
577
578
579
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606







+
+
+
+
+
+
+
+
+







#	if __DARWIN_UNIX03
#	    undef HAVE_PUTENV_THAT_COPIES
#	else
#	    define HAVE_PUTENV_THAT_COPIES	1
#	endif
#   endif /* __DARWIN_UNIX03 */

/*
 * The termios configure test program relies on the configure script being run
 * from a terminal, which is not the case e.g. when configuring from Xcode.
 * Since termios is known to be present on all Mac OS X releases since 10.0,
 * override the configure defines for serial API here. [Bug 497147]
 */
#   define USE_TERMIOS 1
#   undef  USE_TERMIO
#   undef  USE_SGTTY
/*
 *---------------------------------------------------------------------------
 * Include AvailabilityMacros.h here (when available) to ensure any symbolic
 * MAC_OS_X_VERSION_* constants passed on the command line are translated.
 *---------------------------------------------------------------------------
 */

610
611
612
613
614
615
616

617
618



619
620
621
622
623
624
625
637
638
639
640
641
642
643
644


645
646
647
648
649
650
651
652
653
654







+
-
-
+
+
+







#	endif
#	if MAC_OS_X_VERSION_MAX_ALLOWED < 1040
#	    undef HAVE_OSSPINLOCKLOCK
#	    undef HAVE_PTHREAD_ATFORK
#	    undef HAVE_COPYFILE
#	endif
#	if MAC_OS_X_VERSION_MAX_ALLOWED < 1030
#	    ifdef TCL_THREADS
	    /* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
#	    define NO_REALPATH 1
		/* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
#		define NO_REALPATH 1
#	    endif
#	    undef HAVE_LANGINFO
#	endif
#   endif /* MAC_OS_X_VERSION_MAX_ALLOWED */
#   if defined(HAVE_COREFOUNDATION) && defined(__LP64__) && \
	    defined(HAVE_WEAK_IMPORT) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050
#	warning "Weak import of 64-bit CoreFoundation is not supported, will not run on Mac OS X < 10.5."
#   endif
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
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







-
-
-
+
+
+









-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-


-
-
-
-
-
-
+
+
+
+
+
+
-
-
-











/*
 *---------------------------------------------------------------------------
 * The following defines wrap the system memory allocation routines.
 *---------------------------------------------------------------------------
 */

#define TclpSysAlloc(size)		malloc(size)
#define TclpSysFree(ptr)		free(ptr)
#define TclpSysRealloc(ptr, size)	realloc(ptr, size)
#define TclpSysAlloc(size, isBin)	malloc((size_t)(size))
#define TclpSysFree(ptr)		free((char *)(ptr))
#define TclpSysRealloc(ptr, size)	realloc((char *)(ptr), (size_t)(size))

/*
 *---------------------------------------------------------------------------
 * The following macros and declaration wrap the C runtime library functions.
 *---------------------------------------------------------------------------
 */

#define TclpExit	exit

#if !defined(TCL_THREADS) || TCL_THREADS
#   include <pthread.h>
#endif /* TCL_THREADS */

#ifdef TCL_THREADS
#  include <pthread.h>
/* #define localtime(x)	TclpLocaltime(x)
 * #define gmtime(x)	TclpGmtime(x)    */
/* FIXME - Hyper-enormous platform assumption! */
#ifndef AF_INET6
#   define AF_INET6	10
#endif
#   undef inet_ntoa
#   define inet_ntoa(x)	TclpInetNtoa(x)
#   ifdef HAVE_PTHREAD_ATTR_GET_NP
#	define TclpPthreadGetAttrs	pthread_attr_get_np
#	ifdef ATTRGETNP_NOT_DECLARED
/*
 * Assume it is in pthread_np.h if it isn't in pthread.h. [Bug 1064882]
 * We might need to revisit this in the future. :^(
 */
#	    include <pthread_np.h>
#	endif
#   else
#	ifdef HAVE_PTHREAD_GETATTR_NP
#	    define TclpPthreadGetAttrs	pthread_getattr_np
#	    ifdef GETATTRNP_NOT_DECLARED
extern int pthread_getattr_np (pthread_t, pthread_attr_t *);
#	    endif
#	endif /* HAVE_PTHREAD_GETATTR_NP */
#   endif /* HAVE_PTHREAD_ATTR_GET_NP */
#endif /* TCL_THREADS */

/*
 *---------------------------------------------------------------------------
 * Set of MT-safe implementations of some known-to-be-MT-unsafe library calls.
 * Instead of returning pointers to the static storage, those return pointers
 * to the TSD data.
 *---------------------------------------------------------------------------
 */

#include <pwd.h>
#include <grp.h>

MODULE_SCOPE struct passwd *	TclpGetPwNam(const char *name);
MODULE_SCOPE struct group *	TclpGetGrNam(const char *name);
MODULE_SCOPE struct passwd *	TclpGetPwUid(uid_t uid);
MODULE_SCOPE struct group *	TclpGetGrGid(gid_t gid);
MODULE_SCOPE struct hostent *	TclpGetHostByName(const char *name);
MODULE_SCOPE struct hostent *	TclpGetHostByAddr(const char *addr,
extern struct passwd*  TclpGetPwNam(const char *name);
extern struct group*   TclpGetGrNam(const char *name);
extern struct passwd*  TclpGetPwUid(uid_t uid);
extern struct group*   TclpGetGrGid(gid_t gid);
extern struct hostent* TclpGetHostByName(const char *name);
extern struct hostent* TclpGetHostByAddr(const char *addr, int length, int type);
				    int length, int type);
MODULE_SCOPE void *TclpMakeTcpClientChannelMode(
				    void *tcpSocket, int mode);

#endif /* _TCLUNIXPORT */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixSock.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186

187
188
189
190
191
192
193

194
195
196
197
198
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
214
215
216

217
218
219
220
221
222

223
224
225

226
227
228
229
230
231
232

233
234
235
236
237
238
239
240
241
242
243
244

245
246

247
248
249

250
251
252
253
254
255
256
257



258

259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

275
276
277
278
279
280

281
282
283

284
285
286
287
288
289



290
291
292
293
294
295
296
297
298

299
300
301
302
303
304
305
306
307
308
309
310
311
312

313
314
315

316
317
318

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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
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
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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-

-
+









-
+





-
+


-
+






-
+











-
+

-
+


-
+








+
+
+
-
+















-
+





-
+


-
+


-
-
-
-
+
+
+
-
-
-
-
-



-
+













-
+


-
+


-
+
-



-
+











-
+




-
+





-
+











-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
-


/*
 * tclUnixSock.c --
 *
 *	This file contains Unix-specific socket related code.
 *
 * Copyright (c) 1995 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"

/*
 * Helper macros to make parts of this file clearer. The macros do exactly
 * what they say on the tin. :-) They also only ever refer to their arguments
 * once, and so can be used without regard to side effects.
 */

#define SET_BITS(var, bits)	((var) |= (bits))
#define CLEAR_BITS(var, bits)	((var) &= ~(bits))
#define GOT_BITS(var, bits)     (((var) & (bits)) != 0)

/* "sock" + a pointer in hex + \0 */
#define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
#define SOCK_TEMPLATE           "sock%lx"

#undef SOCKET   /* Possible conflict with win32 SOCKET */

/*
 * 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;

/*
 * This structure describes per-instance state of a tcp based channel.
 */

typedef struct TcpState TcpState;

typedef struct TcpFdList {
    TcpState *statePtr;
    int fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    int testFlags;              /* bit field for tests. Is set by testsocket
                                 * test procedure */
    TcpFdList fds;		/* The file descriptors of the sockets. */
    int flags;			/* ORed combination of the bitfields defined
				 * below. */
    int interest;		/* Event types of interest */

    /*
     * Only needed for server sockets
     */

    Tcl_TcpAcceptProc *acceptProc;
                                /* Proc to call on accept. */
    void *acceptProcData;  /* The data for the accept proc. */

    /*
     * Only needed for client sockets
     */

    struct addrinfo *addrlist;	/* Addresses to connect to. */
    struct addrinfo *addr;	/* Iterator over addrlist. */
    struct addrinfo *myaddrlist;/* Local address. */
    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
    int filehandlers;           /* Caches FileHandlers that get set up while
                                 * an async socket is not yet connected. */
    int connectError;           /* Cache SO_ERROR of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_NONBLOCKING		(1<<0)	/* Socket with non-blocking I/O */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
#define TCP_ASYNC_PENDING	(1<<4)	/* TcpConnect was called to
					 * process an async connect. This
					 * flag indicates that reentry is
					 * still pending */
#define TCP_ASYNC_FAILED	(1<<5)	/* An async connect finally failed */

/*
 * These bits may be ORed together into the "testFlags" field of a TcpState
 * structure.
 */

#define TCP_ASYNC_TEST_MODE	(1<<0)	/* Async testing activated.  Do not
					 * automatically continue connection
					 * process. */

/*
 * The following defines the maximum length of the listen queue. This is the
 * number of outstanding yet-to-be-serviced requests for a connection on a
 * server socket, more than this number of outstanding requests and the
 * connection request will fail.
 */

#ifndef SOMAXCONN
#   define SOMAXCONN	100
#elif (SOMAXCONN < 100)
#   undef  SOMAXCONN
#   define SOMAXCONN	100
#endif /* SOMAXCONN < 100 */

/*
 * The following defines how much buffer space the kernel should maintain for
 * a socket.
 */

#define SOCKET_BUFSIZE	4096

/*
 * Static routines for this file:
 */

static void		TcpAsyncCallback(void *clientData, int mask);
static int		TcpConnect(Tcl_Interp *interp, TcpState *state);
static void		TcpAccept(void *data, int mask);
static int		TcpBlockModeProc(void *data, int mode);
static int		TcpCloseProc(void *instanceData,
			    Tcl_Interp *interp);
static int		TcpClose2Proc(void *instanceData,
			    Tcl_Interp *interp, int flags);
static int		TcpGetHandleProc(void *instanceData,
			    int direction, void **handlePtr);
static int		TcpGetOptionProc(void *instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static int		TcpInputProc(void *instanceData, char *buf,
			    int toRead, int *errorCode);
static int		TcpOutputProc(void *instanceData,
			    const char *buf, int toWrite, int *errorCode);
static void		TcpThreadActionProc(void *instanceData, int action);
static void		TcpWatchProc(void *instanceData, int mask);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static void		WrapNotify(void *clientData, int mask);

/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 */

static const Tcl_ChannelType tcpChannelType = {
    "tcp",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    TcpInputProc,		/* Input proc. */
    TcpOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    TcpGetOptionProc,		/* Get option proc. */
    TcpWatchProc,		/* Initialize notifier. */
    TcpGetHandleProc,		/* Get OS handles out of channel. */
    TcpClose2Proc,		/* Close2 proc. */
    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc. */
    TcpThreadActionProc,	/* thread action proc. */
    NULL			/* truncate proc. */
};

/*
 * The following variable holds the network name of this host.
 */

static TclInitProcessGlobalValueProc InitializeHostName;
static ProcessGlobalValue hostName =
	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};


#if 0
/* printf debugging */
void
printaddrinfo(
    struct addrinfo *addrlist,
    char *prefix)
{

    char host[NI_MAXHOST], port[NI_MAXSERV];
    struct addrinfo *ai;

    for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
	getnameinfo(ai->ai_addr, ai->ai_addrlen,
		host, sizeof(host), port, sizeof(port),
		NI_NUMERICHOST|NI_NUMERICSERV);
	fprintf(stderr,"%s: %s:%s\n", prefix, host, port);
    }
}
#endif
/*
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 *
 * InitializeHostName --
 *
 * 	This routine sets the process global value of the name of the local
 * 	host on which the process is running.
 *
 * Results:
 *	None.
 *
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 */

static void
InitializeHostName(
    char **valuePtr,
    size_t *lengthPtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    const char *native = NULL;
    CONST char *native = NULL;

#ifndef NO_UNAME
    struct utsname u;
    struct hostent *hp;

    memset(&u, (int) 0, sizeof(struct utsname));
    if (uname(&u) >= 0) {				/* INTL: Native. */
    if (uname(&u) > -1) {				/* INTL: Native. */
        hp = TclpGetHostByName(u.nodename);		/* INTL: Native. */
	if (hp == NULL) {
	    /*
	     * Sometimes the nodename is fully qualified, but gets truncated
	     * as it exceeds SYS_NMLN. See if we can just get the immediate
	     * nodename and get a proper answer that way.
	     */

	    char *dot = strchr(u.nodename, '.');

	    if (dot != NULL) {
		char *node = (char *)Tcl_Alloc(dot - u.nodename + 1);
		char *node = ckalloc((unsigned) (dot - u.nodename + 1));

		memcpy(node, u.nodename, dot - u.nodename);
		memcpy(node, u.nodename, (size_t) (dot - u.nodename));
		node[dot - u.nodename] = '\0';
		hp = TclpGetHostByName(node);
		Tcl_Free(node);
		ckfree(node);
	    }
	}
        if (hp != NULL) {
	    native = hp->h_name;
        } else {
	    native = u.nodename;
        }
    }
    if (native == NULL) {
	native = tclEmptyStringRep;
    }
#else /* !NO_UNAME */
#else
    /*
     * Uname doesn't exist; try gethostname instead.
     *
     * There is no portable macro for the maximum length of host names
     * returned by gethostbyname(). We should only trust SYS_NMLN if it is at
     * least 255 + 1 bytes to comply with DNS host name limits.
     *
     * Note: SYS_NMLN is a restriction on "uname" not on gethostbyname!
     *
     * For example HP-UX 10.20 has SYS_NMLN == 9, while gethostbyname() can
     * return a fully qualified name from DNS of up to 255 bytes.
     *
     * Fix suggested by Viktor Dukhovni (viktor@esm.com)
     */

#    if defined(SYS_NMLN) && (SYS_NMLEN >= 256)
#    if defined(SYS_NMLN) && SYS_NMLEN >= 256
    char buffer[SYS_NMLEN];
#    else
    char buffer[256];
#    endif

    if (gethostname(buffer, sizeof(buffer)) >= 0) {	/* INTL: Native. */
    if (gethostname(buffer, sizeof(buffer)) > -1) {	/* INTL: Native. */
	native = buffer;
    }
#endif /* NO_UNAME */
#endif

    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
    if (native) {
	*lengthPtr = strlen(native);
	*valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
	memcpy(*valuePtr, native, *lengthPtr + 1);
    *lengthPtr = strlen(native);
    *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
    memcpy(*valuePtr, (void *) native, (size_t)(*lengthPtr)+1);
    } else {
	*lengthPtr = 0;
	*valuePtr = (char *)Tcl_Alloc(1);
	*valuePtr[0] = '\0';
    }
}

/*
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 *
 * Tcl_GetHostName --
 *
 *	Returns the name of the local host.
 *
 * Results:
 *	A string containing the network name for this machine, or an empty
 *	string if we can't figure out the name. The caller must not modify or
 *	free this string.
 *
 * Side effects:
 *	Caches the name to return for future calls.
 *
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 */

const char *
CONST char *
Tcl_GetHostName(void)
{
    Tcl_Obj *tclObj = TclGetProcessGlobalValue(&hostName);
    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
    return TclGetString(tclObj);
}

/*
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *
 *	Detect if sockets are available on this platform.
 *
 * Results:
 *	Returns TCL_OK.
 *
 * Side effects:
 *	None.
 *
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 */

int
TclpHasSockets(
    TCL_UNUSED(Tcl_Interp *))
    Tcl_Interp *interp)		/* Not used. */
{
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 *
 * TclpFinalizeSockets --
 *
 *	Performs per-thread socket subsystem finalization.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 * ----------------------------------------------------------------------
 *----------------------------------------------------------------------
 */

void
TclpFinalizeSockets(void)
{
    return;
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpBlockModeProc --
 *
 *	This function is invoked by the generic IO level to set blocking and
 *	nonblocking mode on a TCP socket based channel.
 *
 * Results:
 *	0 if successful, errno when failed.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *
 * ----------------------------------------------------------------------
 */

static int
TcpBlockModeProc(
    void *instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    if (mode == TCL_MODE_BLOCKING) {
	CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
    } else {
	SET_BITS(statePtr->flags, TCP_NONBLOCKING);
    }
    if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
        statePtr->cachedBlocking = mode;
        return 0;
    }
    if (TclUnixSetBlockingMode(statePtr->fds.fd, mode) < 0) {
	return errno;
    }
    return 0;
}

/*
 * ----------------------------------------------------------------------
 *
 * WaitForConnect --
 *
 *	Check the state of an async connect process. If a connection attempt
 *	terminated, process it, which may finalize it or may start the next
 *	attempt. If a connect error occures, it is saved in
 *	statePtr->connectError to be reported by 'fconfigure -error'.
 *
 *	There are two modes of operation, defined by errorCodePtr:
 *	 *  non-NULL: Called by explicite read/write command. Blocks if the
 *	    socket is blocking.
 *	    May return two error codes:
 *	     *	EWOULDBLOCK: if connect is still in progress
 *	     *	ENOTCONN: if connect failed. This would be the error message
 *		of a rect or sendto syscall so this is emulated here.
 *	 *  NULL: Called by a backround operation. Do not block and do not
 *	    return any error code.
 *
 * Results:
 * 	0 if the connection has completed, -1 if still in progress or there is
 * 	an error.
 *
 * Side effects:
 *	Processes socket events off the system queue. May process
 *	asynchroneous connects.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */
    int *errorCodePtr)
{
    int timeout;

    /*
     * Check if an async connect failed already and error reporting is
     * demanded, return the error ENOTCONN
     */

    if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
	*errorCodePtr = ENOTCONN;
	return -1;
    }

    /*
     * Check if an async connect is running. If not return ok
     */

    if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	return 0;
    }

    /*
     * In socket test mode do not continue with the connect.
     * Exceptions are:
     * - Call by recv/send and blocking socket
     *   (errorCodePtr != NULL && !GOT_BITS(flags, TCP_NONBLOCKING))
     */

    if (GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)
            && !(errorCodePtr != NULL
                    && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) {
	*errorCodePtr = EWOULDBLOCK;
	return -1;
    }

    if (errorCodePtr == NULL || GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
        timeout = 0;
    } else {
        timeout = -1;
    }
    do {
        if (TclUnixWaitForFile(statePtr->fds.fd,
                TCL_WRITABLE | TCL_EXCEPTION, timeout) != 0) {
            TcpConnect(NULL, statePtr);
        }

        /*
         * Do this only once in the nonblocking case and repeat it until the
         * socket is final when blocking.
         */
    } while (timeout == -1 && GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT));

    if (errorCodePtr != NULL) {
        if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
            *errorCodePtr = EAGAIN;
            return -1;
        } else if (statePtr->connectError != 0) {
            *errorCodePtr = ENOTCONN;
            return -1;
        }
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpInputProc --
 *
 *	This function is invoked by the generic IO level to read input from a
 *	TCP socket based channel.
 *
 *	NOTE: We cannot share code with FilePipeInputProc because here we must
 *	use recv to obtain the input from the channel, not read.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains the POSIX error code on error, or zero if no error
 *	occurred.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(
    void *instanceData,	/* Socket state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;

    *errorCodePtr = 0;
    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }
    bytesRead = recv(statePtr->fds.fd, buf, bufSize, 0);
    if (bytesRead >= 0) {
	return bytesRead;
    }
    if (errno == ECONNRESET) {
	/*
	 * Turn ECONNRESET into a soft EOF condition.
	 */

	return 0;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpOutputProc --
 *
 *	This function is invoked by the generic IO level to write output to a
 *	TCP socket based channel.
 *
 *	NOTE: We cannot share code with FilePipeOutputProc because here we
 *	must use send, not write, to get reliable error reporting.
 *
 * Results:
 *	The number of bytes written is returned. An output argument is set to
 *	a POSIX error code if an error occurred, or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(
    void *instanceData,	/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int written;

    *errorCodePtr = 0;
    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }
    written = send(statePtr->fds.fd, buf, toWrite, 0);

    if (written >= 0) {
	return written;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpCloseProc --
 *
 *	This function is invoked by the generic IO level to perform
 *	channel-type-specific cleanup when a TCP socket based channel is
 *	closed.
 *
 * Results:
 *	0 if successful, the value of errno if failed.
 *
 * Side effects:
 *	Closes the socket of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
TcpCloseProc(
    void *instanceData,	/* The socket to close. */
    TCL_UNUSED(Tcl_Interp *))
{
    TcpState *statePtr = (TcpState *)instanceData;
    int errorCode = 0;
    TcpFdList *fds;

    /*
     * Delete a file handler that may be active for this socket if this is a
     * server socket - the file handler was created automatically by Tcl as
     * part of the mechanism to accept new client connections. Channel
     * handlers are already deleted in the generic IO channel closing code
     * that called this function, so we do not have to delete them here.
     */

    for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
	if (fds->fd < 0) {
	    continue;
	}
	Tcl_DeleteFileHandler(fds->fd);
	if (close(fds->fd) < 0) {
	    errorCode = errno;
	}

    }
    fds = statePtr->fds.next;
    while (fds != NULL) {
	TcpFdList *next = fds->next;

	Tcl_Free(fds);
	fds = next;
    }
    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
        freeaddrinfo(statePtr->myaddrlist);
    }
    Tcl_Free(statePtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --
 *
 *	This function is called by the generic IO level to perform the channel
 *	type specific part of a half-close: namely, a shutdown() on a socket.
 *
 * Results:
 *	0 if successful, the value of errno if failed.
 *
 * Side effects:
 *	Shuts down one side of the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpClose2Proc(
    void *instanceData,	/* The socket to close. */
    TCL_UNUSED(Tcl_Interp *),
    int flags)			/* Flags that indicate which side to close. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int readError = 0;
    int writeError = 0;

    /*
     * Shutdown the OS socket handle.
     */
    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	return TcpCloseProc(instanceData, NULL);
    }
    if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->fds.fd, SHUT_RD) < 0)) {
	readError = errno;
    }
    if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->fds.fd, SHUT_WR) < 0)) {
	writeError = errno;
    }
    return (readError != 0) ? readError : writeError;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpHostPortList --
 *
 *	This function is called by the -gethostname and -getpeername switches
 *	of TcpGetOptionProc() to add three list elements with the textual
 *	representation of the given address to the given DString.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adds three elements do dsPtr
 *
 *----------------------------------------------------------------------
 */

#ifndef NEED_FAKE_RFC2553
#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wstrict-aliasing"
#endif
static inline int
IPv6AddressNeedsNumericRendering(
    struct in6_addr addr)
{
    if (IN6_ARE_ADDR_EQUAL(&addr, &in6addr_any)) {
        return 1;
    }

    /*
     * The IN6_IS_ADDR_V4MAPPED macro has a problem with aliasing warnings on
     * at least some versions of OSX.
     */

    if (!IN6_IS_ADDR_V4MAPPED(&addr)) {
        return 0;
    }

    return (addr.s6_addr[12] == 0 && addr.s6_addr[13] == 0
            && addr.s6_addr[14] == 0 && addr.s6_addr[15] == 0);
}
#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic pop
#endif
#endif /* NEED_FAKE_RFC2553 */

static void
TcpHostPortList(
    Tcl_Interp *interp,
    Tcl_DString *dsPtr,
    address addr,
    socklen_t salen)
{
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
    char host[NI_MAXHOST], nhost[NI_MAXHOST], nport[NI_MAXSERV];
    int flags = 0;

    getnameinfo(&addr.sa, salen, nhost, sizeof(nhost), nport, sizeof(nport),
            NI_NUMERICHOST | NI_NUMERICSERV);
    Tcl_DStringAppendElement(dsPtr, nhost);

    /*
     * We don't want to resolve INADDR_ANY and sin6addr_any; they can
     * sometimes cause problems (and never have a name).
     */

    if (addr.sa.sa_family == AF_INET) {
        if (addr.sa4.sin_addr.s_addr == INADDR_ANY) {
            flags |= NI_NUMERICHOST;
        }
#ifndef NEED_FAKE_RFC2553
    } else if (addr.sa.sa_family == AF_INET6) {
        if (IPv6AddressNeedsNumericRendering(addr.sa6.sin6_addr)) {
            flags |= NI_NUMERICHOST;
        }
#endif /* NEED_FAKE_RFC2553 */
    }

    /*
     * Check if reverse DNS has been switched off globally.
     */

    if (interp != NULL &&
            Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) {
        flags |= NI_NUMERICHOST;
    }
    if (getnameinfo(&addr.sa, salen, host, sizeof(host), NULL, 0,
            flags) == 0) {
        /*
         * Reverse mapping worked.
         */

        Tcl_DStringAppendElement(dsPtr, host);
    } else {
        /*
         * Reverse mapping failed - use the numeric rep once more.
         */

        Tcl_DStringAppendElement(dsPtr, nhost);
    }
    Tcl_DStringAppendElement(dsPtr, nport);
}

/*
 *----------------------------------------------------------------------
 *
 * TcpGetOptionProc --
 *
 *	Computes an option value for a TCP socket based channel, or a list of
 *	all options and their values.
 *
 *	Note: This code is based on code contributed by John Haxby.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a list of
 *	all options and their values is returned in the supplied DString. Sets
 *	Error message if needed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetOptionProc(
    void *instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    size_t len = 0;

    WaitForConnect(statePtr, NULL);

    if (optionName != NULL) {
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {
	socklen_t optlen = sizeof(int);

        if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
            /*
             * Suppress errors as long as we are not done.
             */

            errno = 0;
        } else if (statePtr->connectError != 0) {
            errno = statePtr->connectError;
            statePtr->connectError = 0;
        } else {
            int err;

            getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR, (char *) &err,
                    &optlen);
            errno = err;
        }
        if (errno != 0) {
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(errno), -1);
        }
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
        Tcl_DStringAppend(dsPtr,
                GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT) ? "1" : "0", -1);
        return TCL_OK;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
        address peername;
        socklen_t size = sizeof(peername);

	if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
	    /*
	     * In async connect output an empty string
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringAppendElement(dsPtr, "");
	    } else {
		return TCL_OK;
	    }
	} else if (getpeername(statePtr->fds.fd, &peername.sa, &size) >= 0) {
	    /*
	     * Peername fetch succeeded - output list
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
	    }
            TcpHostPortList(interp, dsPtr, peername, size);
	    if (len) {
                return TCL_OK;
            }
            Tcl_DStringEndSublist(dsPtr);
	} else {
	    /*
	     * 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 (which have no peer).
	     * Same must be done on win&mac.
	     */

	    if (len) {
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                            "can't get peername: %s",
			    Tcl_PosixError(interp)));
		}
		return TCL_ERROR;
	    }
	}
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
	    (strncmp(optionName, "-sockname", len) == 0))) {
	TcpFdList *fds;
        address sockname;
        socklen_t size;
	int found = 0;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-sockname");
	    Tcl_DStringStartSublist(dsPtr);
	}
	if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
	    /*
	     * In async connect output an empty string
	     */

            found = 1;
	} else {
	    for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
		size = sizeof(sockname);
		if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) {
		    found = 1;
		    TcpHostPortList(interp, dsPtr, sockname, size);
		}
	    }
	}
        if (found) {
            if (len) {
                return TCL_OK;
            }
            Tcl_DStringEndSublist(dsPtr);
        } else {
            if (interp) {
                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                        "can't get sockname: %s", Tcl_PosixError(interp)));
            }
	    return TCL_ERROR;
	}
    }

    if (len > 0) {
	return Tcl_BadChannelOption(interp, optionName,
                "connecting peername sockname");
    }

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpThreadActionProc --
 *
 *	Handles detach/attach for asynchronously connecting socket.
 *
 *	Reassigning the file handler associated with thread-related channel
 *	notification, responsible for callbacks (signaling that asynchronous
 *	connection attempt has succeeded or failed).
 *
 * Results:
 *	None.
 *
 * ----------------------------------------------------------------------
 */

static void
TcpThreadActionProc(
    void *instanceData,
    int action)
{
    TcpState *statePtr = (TcpState *)instanceData;

    if (GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
	/*
	 * Async-connecting socket must get reassigned handler if it have been
	 * transferred to another thread. Remove the handler if the socket is
	 * not managed by this thread anymore and create new handler (TSD related)
	 * so the callback will run in the correct thread, bug [f583715154].
	 */
	switch (action) {
	  case TCL_CHANNEL_THREAD_REMOVE:
	    CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);
	    Tcl_DeleteFileHandler(statePtr->fds.fd);
	  break;
	  case TCL_CHANNEL_THREAD_INSERT:
	    Tcl_CreateFileHandler(statePtr->fds.fd,
		TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback, statePtr);
	    SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
	  break;
	}
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpWatchProc --
 *
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel will be
 *	seen by Tcl.
 *
 * ----------------------------------------------------------------------
 */

static void
WrapNotify(
    void *clientData,
    int mask)
{
    TcpState *statePtr = (TcpState *) clientData;
    int newmask = mask & statePtr->interest;

    if (newmask == 0) {
	/*
	 * There was no overlap between the states the channel is interested
	 * in notifications for, and the states that are reported present on
	 * the file descriptor by select().  The only way that can happen is
	 * when the channel is interested in a writable condition, and only a
	 * readable state is reported present (see TcpWatchProc() below).  In
	 * that case, signal back to the caller the writable state, which is
	 * really an error condition.  As an extra check on that assumption,
	 * check for a non-zero value of errno before reporting an artificial
	 * writable state.
	 */

	if (errno == 0) {
	    return;
	}
	newmask = TCL_WRITABLE;
    }
    Tcl_NotifyChannel(statePtr->channel, newmask);
}

static void
TcpWatchProc(
    void *instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    if (statePtr->acceptProc != NULL) {
        /*
         * Make sure we don't mess with server sockets since they will never
         * be readable or writable at the Tcl level. This keeps Tcl scripts
         * from interfering with the -accept behavior (bug #3394732).
         */

    	return;
    }

    if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
        /*
         * Async sockets use a FileHandler internally while connecting, so we
         * need to cache this request until the connection has succeeded.
         */

        statePtr->filehandlers = mask;
    } else if (mask) {

	/*
	 * Whether it is a bug or feature or otherwise, it is a fact of life
	 * that on at least some Linux kernels select() fails to report that a
	 * socket file descriptor is writable when the other end of the socket
	 * is closed.  This is in contrast to the guarantees Tcl makes that
	 * its channels become writable and fire writable events on an error
	 * conditon.  This has caused a leak of file descriptors in a state of
	 * background flushing.  See Tcl ticket 1758a0b603.
	 *
	 * As a workaround, when our caller indicates an interest in writable
	 * notifications, we must tell the notifier built around select() that
	 * we are interested in the readable state of the file descriptor as
	 * well, as that is the only reliable means to get notified of error
	 * conditions.  Then it is the task of WrapNotify() above to untangle
	 * the meaning of these channel states and report the chan events as
	 * best it can.  We save a copy of the mask passed in to assist with
	 * that.
	 */

	statePtr->interest = mask;
        Tcl_CreateFileHandler(statePtr->fds.fd, mask|TCL_READABLE,
                (Tcl_FileProc *) WrapNotify, statePtr);
    } else {
        Tcl_DeleteFileHandler(statePtr->fds.fd);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
 *	TCP socket based channel.
 *
 * Results:
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
 *	handle for the specified direction.
 *
 * Side effects:
 *	None.
 *
 * ----------------------------------------------------------------------
 */

static int
TcpGetHandleProc(
    void *instanceData,	/* The socket state. */
    TCL_UNUSED(int) /*direction*/,
    void **handlePtr)	/* Where to store the handle. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    *handlePtr = INT2PTR(statePtr->fds.fd);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpAsyncCallback --
 *
 *	Called by the event handler that TcpConnect sets up internally for
 *	[socket -async] to get notified when the asynchronous connection
 *	attempt has succeeded or failed.
 *
 * ----------------------------------------------------------------------
 */

static void
TcpAsyncCallback(
    void *clientData,	/* The socket state. */
    TCL_UNUSED(int) /*mask*/)
{
    TcpConnect(NULL, (TcpState *)clientData);
}

/*
 * ----------------------------------------------------------------------
 *
 * TcpConnect --
 *
 *	This function opens a new socket in client mode.
 *
 * Results:
 *      TCL_OK, if the socket was successfully connected or an asynchronous
 *      connection is in progress. If an error occurs, TCL_ERROR is returned
 *      and an error message is left in interp.
 *
 * Side effects:
 *	Opens a socket.
 *
 * Remarks:
 *	A single host name may resolve to more than one IP address, e.g. for
 *	an IPv4/IPv6 dual stack host. For handling asynchronously connecting
 *	sockets in the background for such hosts, this function can act as a
 *	coroutine. On the first call, it sets up the control variables for the
 *	two nested loops over the local and remote addresses. Once the first
 *	connection attempt is in progress, it sets up itself as a writable
 *	event handler for that socket, and returns. When the callback occurs,
 *	control is transferred to the "reenter" label, right after the initial
 *	return and the loops resume as if they had never been interrupted.
 *	For synchronously connecting sockets, the loops work the usual way.
 *
 * ----------------------------------------------------------------------
 */

static int
TcpConnect(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    TcpState *statePtr)
{
    socklen_t optlen;
    int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
    int ret = -1, error = EHOSTUNREACH;
    int async = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
    static const int reuseaddr = 1;

    if (async_callback) {
        goto reenter;
    }

    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
            statePtr->addr = statePtr->addr->ai_next) {
        for (statePtr->myaddr = statePtr->myaddrlist;
                statePtr->myaddr != NULL;
                statePtr->myaddr = statePtr->myaddr->ai_next) {

	    /*
	     * No need to try combinations of local and remote addresses of
	     * different families.
	     */

	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
		continue;
	    }

            /*
             * Close the socket if it is still open from the last unsuccessful
             * iteration.
             */

            if (statePtr->fds.fd >= 0) {
		close(statePtr->fds.fd);
		statePtr->fds.fd = -1;
                errno = 0;
	    }

	    statePtr->fds.fd = socket(statePtr->addr->ai_family, SOCK_STREAM,
                    0);
	    if (statePtr->fds.fd < 0) {
		continue;
	    }

	    /*
	     * Set the close-on-exec flag so that the socket will not get
	     * inherited by child processes.
	     */

	    fcntl(statePtr->fds.fd, F_SETFD, FD_CLOEXEC);

	    /*
	     * Set kernel space buffering
	     */

	    TclSockMinimumBuffers(INT2PTR(statePtr->fds.fd), SOCKET_BUFSIZE);

	    if (async) {
                ret = TclUnixSetBlockingMode(statePtr->fds.fd,
                        TCL_MODE_NONBLOCKING);
                if (ret < 0) {
                    continue;
                }
            }

            /*
             * Must reset the error variable here, before we use it for the
             * first time in this iteration.
             */

            error = 0;

            (void) setsockopt(statePtr->fds.fd, SOL_SOCKET, SO_REUSEADDR,
                    (char *) &reuseaddr, sizeof(reuseaddr));
            ret = bind(statePtr->fds.fd, statePtr->myaddr->ai_addr,
                    statePtr->myaddr->ai_addrlen);
            if (ret < 0) {
                error = errno;
                continue;
            }

	    /*
	     * Attempt to connect. The connect may fail at present with an
	     * EINPROGRESS but at a later time it will complete. The caller
	     * will set up a file handler on the socket if she is interested
	     * in being informed when the connect completes.
	     */

	    ret = connect(statePtr->fds.fd, statePtr->addr->ai_addr,
                        statePtr->addr->ai_addrlen);
            if (ret < 0) {
                error = errno;
            }
	    if (ret < 0 && errno == EINPROGRESS) {
                Tcl_CreateFileHandler(statePtr->fds.fd,
                        TCL_WRITABLE | TCL_EXCEPTION, TcpAsyncCallback,
                        statePtr);
                errno = EWOULDBLOCK;
                SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
                return TCL_OK;

            reenter:
                CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);
                Tcl_DeleteFileHandler(statePtr->fds.fd);

                /*
                 * Read the error state from the socket to see if the async
                 * connection has succeeded or failed. As this clears the
                 * error condition, we cache the status in the socket state
                 * struct for later retrieval by [fconfigure -error].
                 */

                optlen = sizeof(int);

                getsockopt(statePtr->fds.fd, SOL_SOCKET, SO_ERROR,
                        (char *) &error, &optlen);
                errno = error;
            }
	    if (error == 0) {
		goto out;
	    }
	}
    }

  out:
    statePtr->connectError = error;
    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
    if (async_callback) {
        /*
         * An asynchonous connection has finally succeeded or failed.
         */

        TcpWatchProc(statePtr, statePtr->filehandlers);
        TclUnixSetBlockingMode(statePtr->fds.fd, statePtr->cachedBlocking);

        if (error != 0) {
            SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
        }

        /*
         * We need to forward the writable event that brought us here, bcasue
         * upon reading of getsockopt(SO_ERROR), at least some OSes clear the
         * writable state from the socket, and so a subsequent select() on
         * behalf of a script level [fileevent] would not fire. It doesn't
         * hurt that this is also called in the successful case and will save
         * the event mechanism one roundtrip through select().
         */

	if (statePtr->cachedBlocking == TCL_MODE_NONBLOCKING) {
	    Tcl_NotifyChannel(statePtr->channel, TCL_WRITABLE);
	}
    }
    if (error != 0) {
        /*
         * Failure for either a synchronous connection, or an async one that
         * failed before it could enter background mode, e.g. because an
         * invalid -myaddr was given.
         */

        if (interp != NULL) {
            errno = error;
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't open socket: %s", Tcl_PosixError(interp)));
        }
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpClient --
 *
 *	Opens a TCP client socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. An error message is returned in the
 *	interpreter on failure.
 *
 * Side effects:
 *	Opens a client socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpClient(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Host on which to open port. */
    const char *myaddr,		/* Client-side address */
    int myport,			/* Client-side port */
    int async)			/* If nonzero, attempt to do an asynchronous
				 * connect. Otherwise we do a blocking
				 * connect. */
{
    TcpState *statePtr;
    const char *errorMsg = NULL;
    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
    char channelName[SOCK_CHAN_LENGTH];

    /*
     * Do the name lookups for the local and remote addresses.
     */

    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
                    &errorMsg)) {
        if (addrlist != NULL) {
            freeaddrinfo(addrlist);
        }
        if (interp != NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't open socket: %s", errorMsg));
        }
        return NULL;
    }

    /*
     * Allocate a new TcpState for this socket.
     */

    statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
    statePtr->cachedBlocking = TCL_MODE_BLOCKING;
    statePtr->addrlist = addrlist;
    statePtr->myaddrlist = myaddrlist;
    statePtr->fds.fd = -1;

    /*
     * Create a new client socket and wrap it in a channel.
     */

    if (TcpConnect(interp, statePtr) != TCL_OK) {
        TcpCloseProc(statePtr, NULL);
        return NULL;
    }

    sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
            statePtr, TCL_READABLE | TCL_WRITABLE);
    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --
 *
 *	Creates a Tcl_Channel from an existing client TCP socket.
 *
 * Results:
 *	The Tcl_Channel wrapped around the preexisting TCP socket.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    void *sock)		/* The socket to wrap up into a channel. */
{
    return (Tcl_Channel) TclpMakeTcpClientChannelMode(sock,
            TCL_READABLE | TCL_WRITABLE);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpMakeTcpClientChannelMode --
 *
 *	Creates a Tcl_Channel from an existing client TCP socket
 *	with given mode.
 *
 * Results:
 *	The Tcl_Channel wrapped around the preexisting TCP socket.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
TclpMakeTcpClientChannelMode(
    void *sock,		/* The socket to wrap up into a channel. */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];

    statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->fds.fd = PTR2INT(sock);
    statePtr->flags = 0;

    sprintf(channelName, SOCK_TEMPLATE, (long)statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, mode);
    if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpServerEx --
 *
 *	Opens a TCP server socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. If an error occurred, an error message
 *	is left in the interp's result if interp is not NULL.
 *
 * Side effects:
 *	Opens a server socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpServerEx(
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    void *acceptProcData)	/* Data for the callback. */
{
    int status = 0, sock = -1, optvalue, port, chosenport;
    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 { LOOKUP, SOCKET, BIND, LISTEN } howfar = LOOKUP;
    int my_errno = 0;

    /*
     * If we were called with port 0 to listen on a random port number, we
     * copy the port number from the first member of the addrinfo list to all
     * subsequent members, so that IPv4 and IPv6 listen on the same port. This
     * might fail to bind() with EADDRINUSE if a port is free on the first
     * address family in the list but already used on the other. In this case
     * we revert everything we've done so far and start from scratch hoping
     * that next time we'll find a port number that is usable on all address
     * families. We try this at most MAXRETRY times to avoid an endless loop
     * if all ports are taken.
     */

    int retry = 0;
#define MAXRETRY 10

 repeat:
    if (retry > 0) {
        if (statePtr != NULL) {
            TcpCloseProc(statePtr, NULL);
            statePtr = NULL;
        }
        if (addrlist != NULL) {
            freeaddrinfo(addrlist);
            addrlist = NULL;
        }
        if (retry >= MAXRETRY) {
            goto error;
        }
    }
    retry++;
    chosenport = 0;

    if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
	errorMsg = "invalid port number";
	goto error;
    }

    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1,
            &errorMsg)) {
	my_errno = errno;
	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.
	 */

	fcntl(sock, F_SETFD, FD_CLOEXEC);

	/*
	 * Set kernel space buffering
	 */

	TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE);

	/*
	 * Set up to reuse server addresses and/or ports if requested.
	 */

	if (GOT_BITS(flags, TCL_TCPSERVER_REUSEADDR)) {
	    optvalue = 1;
	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
		    (char *) &optvalue, sizeof(optvalue));
	}

	if (GOT_BITS(flags, TCL_TCPSERVER_REUSEPORT)) {
#ifndef SO_REUSEPORT
	    /*
	     * If the platform doesn't support the SO_REUSEPORT flag we can't
	     * do much beside erroring out.
	     */

	    errorMsg = "SO_REUSEPORT isn't supported by this platform";
	    goto error;
#else
	    optvalue = 1;
	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEPORT,
		    (char *) &optvalue, sizeof(optvalue));
#endif
	}

        /*
         * Make sure we use the same port number when opening two server
         * sockets for IPv4 and IPv6 on a random port.
         *
         * 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);
	}

#ifdef IPV6_V6ONLY
	/*
         * Missing on: Solaris 2.8
         */

        if (addrPtr->ai_family == AF_INET6) {
            int v6only = 1;

            (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY,
                    &v6only, sizeof(v6only));
        }
#endif /* IPV6_V6ONLY */

	status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
        if (status == -1) {
	    if (howfar < BIND) {
		howfar = BIND;
		my_errno = errno;
	    }
            close(sock);
            sock = -1;
            if (port == 0 && errno == EADDRINUSE) {
                goto repeat;
            }
            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);
            sock = -1;
            if (port == 0 && errno == EADDRINUSE) {
                goto repeat;
            }
            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */

            statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));
            memset(statePtr, 0, sizeof(TcpState));
            statePtr->acceptProc = acceptProc;
            statePtr->acceptProcData = acceptProcData;
            sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);
            newfds = &statePtr->fds;
        } else {
            newfds = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
            memset(newfds, (int) 0, sizeof(TcpFdList));
            fds->next = newfds;
        }
        newfds->fd = sock;
        newfds->statePtr = statePtr;
        fds = newfds;

        /*
         * Set up the callback mechanism for accepting connections from new
         * clients.
         */

        Tcl_CreateFileHandler(sock, TCL_READABLE, TcpAccept, fds);
    }

  error:
    if (addrlist != NULL) {
	freeaddrinfo(addrlist);
    }
    if (statePtr != NULL) {
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	return statePtr->channel;
    }
    if (interp != NULL) {
        Tcl_Obj *errorObj = Tcl_NewStringObj("couldn't open socket: ", -1);

	if (errorMsg == NULL) {
            errno = my_errno;
            Tcl_AppendToObj(errorObj, Tcl_PosixError(interp), -1);
        } else {
	    Tcl_AppendToObj(errorObj, errorMsg, -1);
	}
        Tcl_SetObjResult(interp, errorObj);
    }
    if (sock != -1) {
	close(sock);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpAccept --
 *	Accept a TCP socket connection.	 This is called by the event loop.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new connection socket. Calls the registered callback for the
 *	connection acceptance mechanism.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAccept(
    void *data,		/* Callback token. */
    TCL_UNUSED(int) /*mask*/)
{
    TcpFdList *fds = (TcpFdList *)data;	/* Client data of server socket. */
    int newsock;		/* The new client socket */
    TcpState *newSockState;	/* State for new socket. */
    address addr;		/* The remote address */
    socklen_t len;		/* For accept interface */
    char channelName[SOCK_CHAN_LENGTH];
    char host[NI_MAXHOST], port[NI_MAXSERV];

    len = sizeof(addr);
    newsock = accept(fds->fd, &addr.sa, &len);
    if (newsock < 0) {
	return;
    }

    /*
     * Set close-on-exec flag to prevent the newly accepted socket from being
     * inherited by child processes.
     */

    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);

    newSockState = (TcpState *)Tcl_Alloc(sizeof(TcpState));
    memset(newSockState, 0, sizeof(TcpState));
    newSockState->flags = 0;
    newSockState->fds.fd = newsock;

    sprintf(channelName, SOCK_TEMPLATE, (long) newSockState);
    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newSockState, TCL_READABLE | TCL_WRITABLE);

    Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
	    "auto crlf");

    if (fds->statePtr->acceptProc != NULL) {
	getnameinfo(&addr.sa, len, host, sizeof(host), port, sizeof(port),
                NI_NUMERICHOST|NI_NUMERICSERV);
	fds->statePtr->acceptProc(fds->statePtr->acceptProcData,
                newSockState->channel, host, atoi(port));
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to unix/tclUnixTest.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12



13
14
15
16
17
18
19












-
-
-







/*
 * tclUnixTest.c --
 *
 *	Contains platform specific test commands for the Unix platform.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

/*
 * The headers are needed for the testalarm command that verifies the use of
 * SA_RESTART in signal handlers.
 */

33
34
35
36
37
38
39
40
41
42



43
44
45
46
47
48
49
30
31
32
33
34
35
36



37
38
39
40
41
42
43
44
45
46







-
-
-
+
+
+







#define GetFd(file)	(PTR2INT(file)-1)

/*
 * The stuff below is used to keep track of file handlers created and
 * exercised by the "testfilehandler" command.
 */

typedef struct {
    TclFile readFile;		/* File handle for reading from the pipe. NULL
				 * means pipe doesn't exist yet. */
typedef struct Pipe {
    TclFile readFile;		/* File handle for reading from the pipe.
				 * NULL means pipe doesn't exist yet. */
    TclFile writeFile;		/* File handle for writing from the pipe. */
    int readCount;		/* Number of times the file handler for this
				 * file has triggered and the file was
				 * readable. */
    int writeCount;		/* Number of times the file handler for this
				 * file has triggered and the file was
				 * writable. */
58
59
60
61
62
63
64
65

66
67
68
69
70
71
72
73






















74
75
76
77
78
79
80
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







-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








static const char *gotsig = "0";

/*
 * Forward declarations of functions defined later in this file:
 */

static Tcl_ObjCmdProc TestalarmCmd;
static void		TestFileHandlerProc(ClientData clientData, int mask);
static Tcl_ObjCmdProc TestchmodCmd;
static Tcl_ObjCmdProc TestfilehandlerCmd;
static Tcl_ObjCmdProc TestfilewaitCmd;
static Tcl_ObjCmdProc TestfindexecutableCmd;
static Tcl_ObjCmdProc TestforkCmd;
static Tcl_ObjCmdProc TestgotsigCmd;
static Tcl_FileProc TestFileHandlerProc;
static void AlarmHandler(int signum);
static int		TestfilehandlerCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
static int		TestfilewaitCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
static int		TestfindexecutableCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
static int		TestforkObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc, Tcl_Obj *CONST *argv);
static int		TestgetopenfileCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
static int		TestgetdefencdirCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
static int		TestsetdefencdirCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
int			TclplatformtestInit(Tcl_Interp *interp);
static int		TestalarmCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
static int		TestgotsigCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);
static void		AlarmHandler(int signum);
static int		TestchmodCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, CONST char **argv);

/*
 *----------------------------------------------------------------------
 *
 * TclplatformtestInit --
 *
 *	Defines commands that test platform specific functionality for Unix
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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

int
TclplatformtestInit(
    Tcl_Interp *interp)		/* Interpreter to add commands to. */
{
    Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfilehandler", TestfilehandlerCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfilewait", TestfilewaitCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfindexecutable", TestfindexecutableCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfork", TestforkCmd,
        NULL, NULL);
    Tcl_CreateObjCommand(interp, "testalarm", TestalarmCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testgotsig", TestgotsigCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd,
	    (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testfilehandler", TestfilehandlerCmd,
            (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testfilewait", TestfilewaitCmd,
            (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testfindexecutable", TestfindexecutableCmd,
            (ClientData) 0, NULL);
    Tcl_CreateObjCommand(interp, "testfork", TestforkObjCmd,
            (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
            (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
            (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
            (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
            (ClientData) 0, NULL);
    Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd,
            (ClientData) 0, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestfilehandlerCmd --
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
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







-
+

-
-
+
+



















-
-
+
+
+



-
-
+
+



-
+





-
+








-
-
-
+
+
+
+



-
+


-
-
+
+
+



-
-
-
-
+
+
+
+
+












-
-
+
+






-
+

-
-
+
+

-
+

-
+

-
+


-
+

-
-
+
+

-
+

-
+

-
+


-
-
-
+
+
+
+




-
+

-
-
-
+
+
+
+




-
-
-
-
+
+
+
+


-
-
+
+
+





-
-
+
+

-
-
-
+
+
+
+



-
+


-
+






-
+









-
+


-
+













-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilehandlerCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    Pipe *pipePtr;
    int i, mask, timeout;
    static int initialized = 0;
    char buffer[4000];
    TclFile file;

    /*
     * NOTE: When we make this code work on Windows also, the following
     * variable needs to be made Unix-only.
     */

    if (!initialized) {
	for (i = 0; i < MAX_PIPES; i++) {
	    testPipes[i].readFile = NULL;
	}
	initialized = 1;
    }

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ...");
    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
                " option ... \"", NULL);
        return TCL_ERROR;
    }
    pipePtr = NULL;
    if (objc >= 3) {
	if (Tcl_GetIntFromObj(interp, objv[2], &i) != TCL_OK) {
    if (argc >= 3) {
	if (Tcl_GetInt(interp, argv[2], &i) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (i >= MAX_PIPES) {
	    Tcl_AppendResult(interp, "bad index ", objv[2], NULL);
	    Tcl_AppendResult(interp, "bad index ", argv[2], NULL);
	    return TCL_ERROR;
	}
	pipePtr = &testPipes[i];
    }

    if (strcmp(Tcl_GetString(objv[1]), "close") == 0) {
    if (strcmp(argv[1], "close") == 0) {
	for (i = 0; i < MAX_PIPES; i++) {
	    if (testPipes[i].readFile != NULL) {
		TclpCloseFile(testPipes[i].readFile);
		testPipes[i].readFile = NULL;
		TclpCloseFile(testPipes[i].writeFile);
		testPipes[i].writeFile = NULL;
	    }
	}
    } else if (strcmp(Tcl_GetString(objv[1]), "clear") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
    } else if (strcmp(argv[1], "clear") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                    argv[0], " clear index\"", NULL);
	    return TCL_ERROR;
	}
	pipePtr->readCount = pipePtr->writeCount = 0;
    } else if (strcmp(Tcl_GetString(objv[1]), "counts") == 0) {
    } else if (strcmp(argv[1], "counts") == 0) {
	char buf[TCL_INTEGER_SPACE * 2];

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                    argv[0], " counts index\"", NULL);
	    return TCL_ERROR;
	}
	sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount);
	Tcl_AppendResult(interp, buf, NULL);
    } else if (strcmp(Tcl_GetString(objv[1]), "create") == 0) {
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index readMode writeMode");
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if (strcmp(argv[1], "create") == 0) {
	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                    argv[0], " create index readMode writeMode\"", NULL);
	    return TCL_ERROR;
	}
	if (pipePtr->readFile == NULL) {
	    if (!TclpCreatePipe(&pipePtr->readFile, &pipePtr->writeFile)) {
		Tcl_AppendResult(interp, "couldn't open pipe: ",
			Tcl_PosixError(interp), NULL);
		return TCL_ERROR;
	    }
#ifdef O_NONBLOCK
	    fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK);
	    fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK);
#else
	    Tcl_AppendResult(interp, "can't make pipes non-blocking",
		    NULL);
	    Tcl_SetResult(interp, "can't make pipes non-blocking",
		    TCL_STATIC);
	    return TCL_ERROR;
#endif
	}
	pipePtr->readCount = 0;
	pipePtr->writeCount = 0;

	if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) {
	if (strcmp(argv[3], "readable") == 0) {
	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), TCL_READABLE,
		    TestFileHandlerProc, pipePtr);
	} else if (strcmp(Tcl_GetString(objv[3]), "off") == 0) {
		    TestFileHandlerProc, (ClientData) pipePtr);
	} else if (strcmp(argv[3], "off") == 0) {
	    Tcl_DeleteFileHandler(GetFd(pipePtr->readFile));
	} else if (strcmp(Tcl_GetString(objv[3]), "disabled") == 0) {
	} else if (strcmp(argv[3], "disabled") == 0) {
	    Tcl_CreateFileHandler(GetFd(pipePtr->readFile), 0,
		    TestFileHandlerProc, pipePtr);
		    TestFileHandlerProc, (ClientData) pipePtr);
	} else {
	    Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[3]), "\"", NULL);
	    Tcl_AppendResult(interp, "bad read mode \"", argv[3], "\"", NULL);
	    return TCL_ERROR;
	}
	if (strcmp(Tcl_GetString(objv[4]), "writable") == 0) {
	if (strcmp(argv[4], "writable") == 0) {
	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), TCL_WRITABLE,
		    TestFileHandlerProc, pipePtr);
	} else if (strcmp(Tcl_GetString(objv[4]), "off") == 0) {
		    TestFileHandlerProc, (ClientData) pipePtr);
	} else if (strcmp(argv[4], "off") == 0) {
	    Tcl_DeleteFileHandler(GetFd(pipePtr->writeFile));
	} else if (strcmp(Tcl_GetString(objv[4]), "disabled") == 0) {
	} else if (strcmp(argv[4], "disabled") == 0) {
	    Tcl_CreateFileHandler(GetFd(pipePtr->writeFile), 0,
		    TestFileHandlerProc, pipePtr);
		    TestFileHandlerProc, (ClientData) pipePtr);
	} else {
	    Tcl_AppendResult(interp, "bad read mode \"", Tcl_GetString(objv[4]), "\"", NULL);
	    Tcl_AppendResult(interp, "bad read mode \"", argv[4], "\"", NULL);
	    return TCL_ERROR;
	}
    } else if (strcmp(Tcl_GetString(objv[1]), "empty") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
    } else if (strcmp(argv[1], "empty") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                    argv[0], " empty index\"", NULL);
	    return TCL_ERROR;
	}

        while (read(GetFd(pipePtr->readFile), buffer, 4000) > 0) {
	    /* Empty loop body. */
            /* Empty loop body. */
        }
    } else if (strcmp(Tcl_GetString(objv[1]), "fill") == 0) {
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
    } else if (strcmp(argv[1], "fill") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                    argv[0], " fill index\"", NULL);
	    return TCL_ERROR;
	}

	memset(buffer, 'a', 4000);
	while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
	    /* Empty loop body. */
	}
    } else if (strcmp(Tcl_GetString(objv[1]), "fillpartial") == 0) {
        while (write(GetFd(pipePtr->writeFile), buffer, 4000) > 0) {
            /* Empty loop body. */
        }
    } else if (strcmp(argv[1], "fillpartial") == 0) {
	char buf[TCL_INTEGER_SPACE];

	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index");
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                    argv[0], " fillpartial index\"", NULL);
	    return TCL_ERROR;
	}

	memset(buffer, 'b', 10);
	TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10));
	Tcl_AppendResult(interp, buf, NULL);
    } else if (strcmp(Tcl_GetString(objv[1]), "oneevent") == 0) {
	Tcl_SetResult(interp, buf, TCL_VOLATILE);
    } else if (strcmp(argv[1], "oneevent") == 0) {
	Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT);
    } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
	if (objc != 5) {
	    Tcl_WrongNumArgs(interp, 2, objv, "index readable|writable timeout");
    } else if (strcmp(argv[1], "wait") == 0) {
	if (argc != 5) {
	    Tcl_AppendResult(interp, "wrong # arguments: should be \"",
                    argv[0], " wait index readable|writable timeout\"", NULL);
	    return TCL_ERROR;
	}
	if (pipePtr->readFile == NULL) {
	    Tcl_AppendResult(interp, "pipe ", Tcl_GetString(objv[2]), " doesn't exist", NULL);
	    Tcl_AppendResult(interp, "pipe ", argv[2], " doesn't exist", NULL);
	    return TCL_ERROR;
	}
	if (strcmp(Tcl_GetString(objv[3]), "readable") == 0) {
	if (strcmp(argv[3], "readable") == 0) {
	    mask = TCL_READABLE;
	    file = pipePtr->readFile;
	} else {
	    mask = TCL_WRITABLE;
	    file = pipePtr->writeFile;
	}
	if (Tcl_GetIntFromObj(interp, objv[4], &timeout) != TCL_OK) {
	if (Tcl_GetInt(interp, argv[4], &timeout) != TCL_OK) {
	    return TCL_ERROR;
	}
	i = TclUnixWaitForFile(GetFd(file), mask, timeout);
	if (i & TCL_READABLE) {
	    Tcl_AppendElement(interp, "readable");
	}
	if (i & TCL_WRITABLE) {
	    Tcl_AppendElement(interp, "writable");
	}
    } else if (strcmp(Tcl_GetString(objv[1]), "windowevent") == 0) {
    } else if (strcmp(argv[1], "windowevent") == 0) {
	Tcl_DoOneEvent(TCL_WINDOW_EVENTS|TCL_DONT_WAIT);
    } else {
	Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be close, clear, counts, create, empty, fill, "
		"fillpartial, oneevent, wait, or windowevent", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

static void
TestFileHandlerProc(
    ClientData clientData,	/* Points to a Pipe structure. */
    int mask)			/* Indicates which events happened:
				 * TCL_READABLE or TCL_WRITABLE. */
{
    Pipe *pipePtr = (Pipe *)clientData;
    Pipe *pipePtr = (Pipe *) clientData;

    if (mask & TCL_READABLE) {
	pipePtr->readCount++;
    }
    if (mask & TCL_WRITABLE) {
	pipePtr->writeCount++;
    }
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
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







-
+

-
-
+
+






-
-
+
+
+


-
+



-
+

-
+

-
+


-
+






-
+



-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfilewaitCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    int mask, result, timeout;
    Tcl_Channel channel;
    int fd;
    ClientData data;

    if (objc != 4) {
	Tcl_WrongNumArgs(interp, 2, objv, "file readable|writable|both timeout");
    if (argc != 4) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" file readable|writable|both timeout\"", NULL);
	return TCL_ERROR;
    }
    channel = Tcl_GetChannel(interp, Tcl_GetString(objv[1]), NULL);
    channel = Tcl_GetChannel(interp, argv[1], NULL);
    if (channel == NULL) {
	return TCL_ERROR;
    }
    if (strcmp(Tcl_GetString(objv[2]), "readable") == 0) {
    if (strcmp(argv[2], "readable") == 0) {
	mask = TCL_READABLE;
    } else if (strcmp(Tcl_GetString(objv[2]), "writable") == 0){
    } else if (strcmp(argv[2], "writable") == 0){
	mask = TCL_WRITABLE;
    } else if (strcmp(Tcl_GetString(objv[2]), "both") == 0){
    } else if (strcmp(argv[2], "both") == 0){
	mask = TCL_WRITABLE|TCL_READABLE;
    } else {
	Tcl_AppendResult(interp, "bad argument \"", Tcl_GetString(objv[2]),
	Tcl_AppendResult(interp, "bad argument \"", argv[2],
		"\": must be readable, writable, or both", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(channel,
	    (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE,
	    (ClientData*) &data) != TCL_OK) {
	Tcl_AppendResult(interp, "couldn't get channel file", NULL);
	Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC);
	return TCL_ERROR;
    }
    fd = PTR2INT(data);
    if (Tcl_GetIntFromObj(interp, objv[3], &timeout) != TCL_OK) {
    if (Tcl_GetInt(interp, argv[3], &timeout) != TCL_OK) {
	return TCL_ERROR;
    }
    result = TclUnixWaitForFile(fd, mask, timeout);
    if (result & TCL_READABLE) {
	Tcl_AppendElement(interp, "readable");
    }
    if (result & TCL_WRITABLE) {
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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622







-
+

-
-
+
+



-
-
+
+
+






-
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+














-
-
+
+


-
+


















-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestfindexecutableCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    Tcl_Obj *saveName;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "argv0");
    if (argc != 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" argv0\"", NULL);
	return TCL_ERROR;
    }

    saveName = TclGetObjNameOfExecutable();
    Tcl_IncrRefCount(saveName);

    TclpFindExecutable(Tcl_GetString(objv[1]));
    TclpFindExecutable(argv[1]);
    Tcl_SetObjResult(interp, TclGetObjNameOfExecutable());

    TclSetObjNameOfExecutable(saveName, NULL);
    Tcl_DecrRefCount(saveName);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestgetopenfileCmd --
 *
 *	This function implements the "testgetopenfile" command. It is used to
 *	get a FILE * value from a registered channel.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetopenfileCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    ClientData filePtr;

    if (argc != 3) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " channelName forWriting\"", NULL);
        return TCL_ERROR;
    }
    if (Tcl_GetOpenFile(interp, argv[1], atoi(argv[2]), 1, &filePtr)
            == TCL_ERROR) {
        return TCL_ERROR;
    }
    if (filePtr == (ClientData) NULL) {
        Tcl_AppendResult(interp,
                "Tcl_GetOpenFile succeeded but FILE * NULL!", NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestsetdefencdirCmd --
 *
 *	This function implements the "testsetdefenc" command. It is used to
 *	test Tcl_SetDefaultEncodingDir().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestsetdefencdirCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                " defaultDir\"", NULL);
        return TCL_ERROR;
    }

    Tcl_SetDefaultEncodingDir(argv[1]);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestforkCmd --
 * TestforkObjCmd --
 *
 *	This function implements the "testfork" command. It is used to
 *	fork the Tcl process for specific test cases.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestforkCmd(
    TCL_UNUSED(ClientData),
TestforkObjCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
    Tcl_Obj *CONST *objv)		/* Argument strings. */
{
    pid_t pid;

    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, "");
        return TCL_ERROR;
    }
    pid = fork();
    if (pid == -1) {
        Tcl_AppendResult(interp,
                "Cannot fork", NULL);
        return TCL_ERROR;
    }
    /* Only needed when pthread_atfork is not present,
     * should not hurt otherwise. */
    if (pid==0) {
	Tcl_InitNotifier();
    }
    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(pid));
    Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestgetdefencdirCmd --
 *
 *	This function implements the "testgetdefenc" command. It is used to
 *	test Tcl_GetDefaultEncodingDir().
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestgetdefencdirCmd(
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    if (argc != 1) {
        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
        return TCL_ERROR;
    }

    Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestalarmCmd --
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
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







-
+

-
-
+
+


-
+


-
-
+
+
+
+


















-







 *	Sets up an signal and async handlers.
 *
 *----------------------------------------------------------------------
 */

static int
TestalarmCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
#ifdef SA_RESTART
    unsigned int sec = 1;
    unsigned int sec;
    struct sigaction action;

    if (objc > 1) {
	Tcl_GetIntFromObj(interp, objv[1], (int *)&sec);
    if (argc > 1) {
	Tcl_GetInt(interp, argv[1], (int *)&sec);
    } else {
	sec = 1;
    }

    /*
     * Setup the signal handling that automatically retries any interrupted
     * I/O system calls.
     */

    action.sa_handler = AlarmHandler;
    memset((void *) &action.sa_mask, 0, sizeof(sigset_t));
    action.sa_flags = SA_RESTART;

    if (sigaction(SIGALRM, &action, NULL) < 0) {
	Tcl_AppendResult(interp, "sigaction: ", Tcl_PosixError(interp), NULL);
	return TCL_ERROR;
    }
    (void) alarm(sec);
    return TCL_OK;
#else

    Tcl_AppendResult(interp,
	    "warning: sigaction SA_RESTART not support on this platform",
	    NULL);
    return TCL_ERROR;
#endif
}

550
551
552
553
554
555
556
557

558
559
560
561
562
563
564
688
689
690
691
692
693
694

695
696
697
698
699
700
701
702







-
+







 * 	Calls the Tcl Async handler.
 *
 *----------------------------------------------------------------------
 */

static void
AlarmHandler(
    TCL_UNUSED(int) /*signum*/)
    int signum)
{
    gotsig = "1";
}

/*
 *----------------------------------------------------------------------
 *
573
574
575
576
577
578
579
580

581
582
583


584
585
586
587
588
589
590
711
712
713
714
715
716
717

718
719


720
721
722
723
724
725
726
727
728







-
+

-
-
+
+







 *	Resets the value of gotsig back to '0'.
 *
 *----------------------------------------------------------------------
 */

static int
TestgotsigCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *))
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    Tcl_AppendResult(interp, gotsig, NULL);
    gotsig = "0";
    return TCL_OK;
}

/*
604
605
606
607
608
609
610
611

612
613
614


615
616

617
618
619




620
621
622
623

624


625
626
627

628
629

630
631

632
633
634
635

636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
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
















-
+

-
-
+
+


+

-
-
+
+
+
+



-
+
-
+
+


-
+

-
+

-
+



-
+








-
-
-
-
-
-
-
-
-
 *	Changes permissions of specified files.
 *
 *---------------------------------------------------------------------------
 */

static int
TestchmodCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,			/* Not used. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)		/* Argument strings. */
    int argc,				/* Number of arguments. */
    CONST char **argv)			/* Argument strings. */
{
    int i, mode;
    char *rest;

    if (objc < 2) {
    Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
    if (argc < 2) {
	usage:
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" mode file ?file ...?", NULL);
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {
    mode = (int) strtol(argv[1], &rest, 8);
	return TCL_ERROR;
    if ((rest == argv[1]) || (*rest != '\0')) {
	goto usage;
    }

    for (i = 2; i < objc; i++) {
    for (i = 2; i < argc; i++) {
	Tcl_DString buffer;
	const char *translated;
	CONST char *translated;

	translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer);
	translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
	if (translated == NULL) {
	    return TCL_ERROR;
	}
	if (chmod(translated, mode) != 0) {
	if (chmod(translated, (unsigned) mode) != 0) {
	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringFree(&buffer);
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to unix/tclUnixThrd.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17


18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63

64
65
66
67

68
69
70
71
72
73

74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

107
108
109

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164

165
166
167
168
169

170
171
172
173

174
175
176
177
178
179
180

181
182
183
184
185
186


187
188

189
190
191






192
193

194
195
196
197
198
199
200
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







-







-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+




-
+



-
+






-
+


-
-
-
-
+
+
-
-
+
-
-
-
+
+
+
+
+
+


+







/*
 * tclUnixThrd.c --
 *
 *	This file implements the UNIX-specific thread support.
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2008 by George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if TCL_THREADS

#ifdef TCL_THREADS

/*
 * TIP #509. Ensures that Tcl's mutexes are reentrant.
 *
 *----------------------------------------------------------------------
 *
 * PMutexInit --
 *
 *	Sets up the memory pointed to by its argument so that it contains the
 *	implementation of a recursive lock. Caller supplies the space.
 *
 *----------------------------------------------------------------------
 *
 * PMutexDestroy --
 *
 *	Tears down the implementation of a recursive lock (but does not
 *	deallocate the space holding the lock).
 *
 *----------------------------------------------------------------------
 *
 * PMutexLock --
 *
 *	Locks a recursive lock. (Similar to pthread_mutex_lock)
 *
 *----------------------------------------------------------------------
 *
 * PMutexUnlock --
 *
 *	Unlocks a recursive lock. (Similar to pthread_mutex_unlock)
 *
 *----------------------------------------------------------------------
 *
 * PCondWait --
 *
 *	Waits on a condition variable linked a recursive lock. (Similar to
 *	pthread_cond_wait)
 *
 *----------------------------------------------------------------------
 *
 * PCondTimedWait --
 *
 *	Waits for a limited amount of time on a condition variable linked to a
 *	recursive lock. (Similar to pthread_cond_timedwait)
 *
 *----------------------------------------------------------------------
 */

typedef struct ThreadSpecificData {
#ifndef HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE 0
#endif

    char nabuf[16];
#if HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
/*
 * Pthread has native reentrant (AKA recursive) mutexes. Use them for
 * Tcl_Mutex.
 */

} ThreadSpecificData;
typedef pthread_mutex_t PMutex;

static void
PMutexInit(
    PMutex *pmutexPtr)
{
    pthread_mutexattr_t attr;

    pthread_mutexattr_init(&attr);
    pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
    pthread_mutex_init(pmutexPtr, &attr);
}

#define PMutexDestroy	pthread_mutex_destroy
#define PMutexLock	pthread_mutex_lock
#define PMutexUnlock	pthread_mutex_unlock
#define PCondWait	pthread_cond_wait
#define PCondTimedWait	pthread_cond_timedwait

#else /* !HAVE_PTHREAD_MUTEX_RECURSIVE */

/*
 * No native support for reentrant mutexes. Emulate them with regular mutexes
 * and thread-local counters.
 */

typedef struct PMutex {
    pthread_mutex_t mutex;
    pthread_t thread;
    int counter;
} PMutex;

static void
static Tcl_ThreadDataKey dataKey;
PMutexInit(
    PMutex *pmutexPtr)
{

    pthread_mutex_init(&pmutexPtr->mutex, NULL);
    pmutexPtr->thread = 0;
    pmutexPtr->counter = 0;
}

static void
PMutexDestroy(
    PMutex *pmutexPtr)
{
    pthread_mutex_destroy(&pmutexPtr->mutex);
}

static void
PMutexLock(
    PMutex *pmutexPtr)
{
    if (pmutexPtr->thread != pthread_self() || pmutexPtr->counter == 0) {
	pthread_mutex_lock(&pmutexPtr->mutex);
	pmutexPtr->thread = pthread_self();
	pmutexPtr->counter = 0;
    }
    pmutexPtr->counter++;
}

static void
PMutexUnlock(
    PMutex *pmutexPtr)
{
    pmutexPtr->counter--;
    if (pmutexPtr->counter == 0) {
	pmutexPtr->thread = 0;
	pthread_mutex_unlock(&pmutexPtr->mutex);
    }
}

static void
PCondWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr)
{
    pthread_cond_wait(pcondPtr, &pmutexPtr->mutex);
}

static void
PCondTimedWait(
    pthread_cond_t *pcondPtr,
    PMutex *pmutexPtr,
    struct timespec *ptime)
{
    pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime);
}
#endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */

/*
 * globalLock is used to serialize creation of mutexes, condition variables,
 * masterLock is used to serialize creation of mutexes, condition variables,
 * and thread local storage. This is the only place that can count on the
 * ability to statically initialize the mutex.
 */

static pthread_mutex_t globalLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t masterLock = PTHREAD_MUTEX_INITIALIZER;

/*
 * initLock is used to serialize initialization and finalization of Tcl. It
 * cannot use any dynamically allocated storage.
 * cannot use any dyamically allocated storage.
 */

static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dynamically allocated storage.
 * obvious reasons, cannot use any dyamically allocated storage.
 */

static PMutex allocLock;
static pthread_once_t allocLockInitOnce = PTHREAD_ONCE_INIT;

static void
static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t *allocLockPtr = &allocLock;
allocLockInit(void)
{

    PMutexInit(&allocLock);
}
static PMutex *allocLockPtr = &allocLock;
/*
 * These are for the critical sections inside this file.
 */

#define MASTER_LOCK	pthread_mutex_lock(&masterLock)
#define MASTER_UNLOCK	pthread_mutex_unlock(&masterLock)

#endif /* TCL_THREADS */


/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
 *
 *	This procedure creates a new thread.
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
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







-
+

-
+



-
+









-
+















-




-
+

-
+
-
-
-
+
+


+

-
+

-
+







 *
 *----------------------------------------------------------------------
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    Tcl_ThreadCreateProc proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    size_t stackSize,		/* Size of stack for the new thread */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
#ifdef TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

#ifdef HAVE_PTHREAD_ATTR_SETSTACKSIZE
    if (stackSize != TCL_THREAD_STACK_DEFAULT) {
	pthread_attr_setstacksize(&attr, stackSize);
	pthread_attr_setstacksize(&attr, (size_t) stackSize);
#ifdef TCL_THREAD_STACK_MIN
    } else {
	/*
	 * Certain systems define a thread stack size that by default is too
	 * small for many operations. The user has the option of defining
	 * TCL_THREAD_STACK_MIN to a value large enough to work for their
	 * needs. This would look like (for 128K min stack):
	 *    make MEM_DEBUG_FLAGS=-DTCL_THREAD_STACK_MIN=131072L
	 *
	 * This solution is not optimal, as we should allow the user to
	 * specify a size at runtime, but we don't want to slow this function
	 * down, and that would still leave the main thread at the default.
	 */

	size_t size;

	result = pthread_attr_getstacksize(&attr, &size);
	if (!result && (size < TCL_THREAD_STACK_MIN)) {
	    pthread_attr_setstacksize(&attr, (size_t) TCL_THREAD_STACK_MIN);
	}
#endif /* TCL_THREAD_STACK_MIN */
#endif
    }
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */
#endif

    if (!(flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
    if (! (flags & TCL_THREAD_JOINABLE)) {
	pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
    }


    if (pthread_create(&theThread, &attr,
	    (void * (*)(void *))(void *)proc, (void *)clientData) &&
	    (void * (*)(void *))proc, (void *)clientData) &&
	    pthread_create(&theThread, NULL,
		    (void * (*)(void *))(void *)proc, (void *)clientData)) {
		    (void * (*)(void *))proc, (void *)clientData)) {
	result = TCL_ERROR;
    } else {
	*idPtr = (Tcl_ThreadId)theThread;
	result = TCL_OK;
    }
    pthread_attr_destroy(&attr);
    return result;
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
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







-
+













+




















-

+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















-
+







int
Tcl_JoinThread(
    Tcl_ThreadId threadId,	/* Id of the thread to wait upon. */
    int *state)			/* Reference to the storage the result of the
				 * thread we wait upon will be written into.
				 * May be NULL. */
{
#if TCL_THREADS
#ifdef TCL_THREADS
    int result;
    unsigned long retcode, *retcodePtr = &retcode;

    result = pthread_join((pthread_t) threadId, (void**) retcodePtr);
    if (state) {
	*state = (int) retcode;
    }
    return (result == 0) ? TCL_OK : TCL_ERROR;
#else
    return TCL_ERROR;
#endif
}

#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadExit --
 *
 *	This procedure terminates the current thread.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	This procedure terminates the current thread.
 *
 *----------------------------------------------------------------------
 */

void
TclpThreadExit(
    int status)
{
#if TCL_THREADS
    pthread_exit(INT2PTR(status));
}
#else /* TCL_THREADS */
    exit(status);
#endif /* TCL_THREADS */
}
#endif /* TCL_THREADS */

#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadGetStackSize --
 *
 *	This procedure returns the size of the current thread's stack.
 *
 * Results:
 *	Stack size (in bytes?) or -1 for error or 0 for undeterminable.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

size_t
TclpThreadGetStackSize(void)
{
    size_t stackSize = 0;
#if defined(HAVE_PTHREAD_ATTR_SETSTACKSIZE) && defined(TclpPthreadGetAttrs)
    pthread_attr_t threadAttr;	/* This will hold the thread attributes for
				 * the current thread. */
#ifdef __GLIBC__
    /*
     * Fix for [Bug 1815573]
     *
     * DESCRIPTION:
     * On linux TclpPthreadGetAttrs (which is pthread_attr_get_np) may return
     * bogus values on the initial thread.
     *
     * ASSUMPTIONS:
     * There seems to be no api to determine if we are on the initial
     * thread. The simple scheme implemented here assumes:
     *   1. The first Tcl interp to be created lives in the initial thread. If
     *      this assumption is not true, the fix is to call
     *      TclpThreadGetStackSize from the initial thread previous to
     *      creating any Tcl interpreter. In this case, especially if another
     *      Tcl interpreter may be created in the initial thread, it might be
     *      better to enable the second branch in the #if below
     *   2. There will be no races in creating the first Tcl interp - ie, the
     *      second Tcl interp will be created only after the first call to
     *      Tcl_CreateInterp returns.
     *
     * These assumptions are satisfied by tclsh. Embedders on linux may want
     * to check their validity, and possibly adapt the code on failing to meet
     * them.
     */

    static int initialized = 0;

    if (!initialized) {
	initialized = 1;
	return 0;
    } else {
#else
    {
#endif
	if (pthread_attr_init(&threadAttr) != 0) {
	    return -1;
	}
	if (TclpPthreadGetAttrs(pthread_self(), &threadAttr) != 0) {
	    pthread_attr_destroy(&threadAttr);
	    return (size_t)-1;
	}
    }


    if (pthread_attr_getstacksize(&threadAttr, &stackSize) != 0) {
	pthread_attr_destroy(&threadAttr);
	return (size_t)-1;
    }
    pthread_attr_destroy(&threadAttr);
#elif defined(HAVE_PTHREAD_GET_STACKSIZE_NP)
#ifdef __APPLE__
    /*
     * On Darwin, the API below does not return the correct stack size for the
     * main thread (which is not a real pthread), so fallback to getrlimit().
     */
    if (!pthread_main_np())
#endif
    stackSize = pthread_get_stacksize_np(pthread_self());
#else
    /*
     * Cannot determine the real stack size of this thread. The caller might
     * want to try looking at the process accounting limits instead.
     */
#endif
    return stackSize;
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCurrentThread --
 *
 *	This procedure returns the ID of the currently running thread.
 *
 * Results:
 *	A thread ID.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
#if TCL_THREADS
#ifdef TCL_THREADS
    return (Tcl_ThreadId) pthread_self();
#else
    return (Tcl_ThreadId) 0;
#endif
}

/*
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
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







-
+







-
+

















-
+



-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpInitLock(void)
{
#if TCL_THREADS
#ifdef TCL_THREADS
    pthread_mutex_lock(&initLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeLock
 * TclpFinalizeLock
 *
 *	This procedure is used to destroy all private resources used in this
 *	file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Destroys everything private. TclpInitLock must be held entering this
 *	function.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLock(void)
{
#if TCL_THREADS
#ifdef TCL_THREADS
    /*
     * You do not need to destroy mutexes that were created with the
     * PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
     * destruction: globalLock, allocLock, and initLock.
     * destruction: masterLock, allocLock, and initLock.
     */

    pthread_mutex_unlock(&initLock);
#endif
}

/*
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
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
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
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
524
525
526

527
528


529
530
531
532
533
534
535
536
537







-
+







-
+






-
+





-
+





-
+

-
-
+
+


+




-
+








-
+





-
+

-
-
+
+









-
+















-
-
+
+
-
-






-
+















-
+








-
+

-
+


-
+


-
+


-
-
-
+
+
+


-
+

-
-
+
+







 *
 *----------------------------------------------------------------------
 */

void
TclpInitUnlock(void)
{
#if TCL_THREADS
#ifdef TCL_THREADS
    pthread_mutex_unlock(&initLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGlobalLock
 * TclpMasterLock
 *
 *	This procedure is used to grab a lock that serializes creation and
 *	finalization of serialization objects. This interface is only needed
 *	in finalization; it is hidden during creation of the objects.
 *
 *	This lock must be different than the initLock because the initLock is
 *	held during creation of synchronization objects.
 *	held during creation of syncronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Acquire the global mutex.
 *	Acquire the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpGlobalLock(void)
TclpMasterLock(void)
{
#if TCL_THREADS
    pthread_mutex_lock(&globalLock);
#ifdef TCL_THREADS
    pthread_mutex_lock(&masterLock);
#endif
}


/*
 *----------------------------------------------------------------------
 *
 * TclpGlobalUnlock
 * TclpMasterUnlock
 *
 *	This procedure is used to release a lock that serializes creation and
 *	finalization of synchronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Release the global mutex.
 *	Release the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpGlobalUnlock(void)
TclpMasterUnlock(void)
{
#if TCL_THREADS
    pthread_mutex_unlock(&globalLock);
#ifdef TCL_THREADS
    pthread_mutex_unlock(&masterLock);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAllocMutex
 *
 *	This procedure returns a pointer to a statically initialized mutex for
 *	use by the memory allocator. The allocator must use this lock, because
 *	use by the memory allocator. The alloctor must use this lock, because
 *	all other locks are allocated...
 *
 * Results:
 *	A pointer to a mutex that is suitable for passing to Tcl_MutexLock and
 *	Tcl_MutexUnlock.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
    PMutex **allocLockPtrPtr = &allocLockPtr;
#ifdef TCL_THREADS
    pthread_mutex_t **allocLockPtrPtr = &allocLockPtr;

    pthread_once(&allocLockInitOnce, allocLockInit);
    return (Tcl_Mutex *) allocLockPtrPtr;
#else
    return NULL;
#endif
}

#if TCL_THREADS
#ifdef TCL_THREADS

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This procedure handles
 *	initializing the mutex, if necessary. The caller can rely on the fact
 *	that Tcl_Mutex is an opaque pointer. This routine will change that
 *	pointer from NULL after first use.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is acquired when this returns.
 *	May block the current thread. The mutex is aquired when this returns.
 *	Will allocate memory for a pthread_mutex_t and initialize this the
 *	first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* Really (PMutex **) */
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
{
    PMutex *pmutexPtr;
    pthread_mutex_t *pmutexPtr;

    if (*mutexPtr == NULL) {
	pthread_mutex_lock(&globalLock);
	MASTER_LOCK;
	if (*mutexPtr == NULL) {
	    /*
	     * Double inside global lock check to avoid a race condition.
	     * Double inside master lock check to avoid a race condition.
	     */

	    pmutexPtr = (PMutex *)Tcl_Alloc(sizeof(PMutex));
	    PMutexInit(pmutexPtr);
	    *mutexPtr = (Tcl_Mutex) pmutexPtr;
	    pmutexPtr = (pthread_mutex_t *)ckalloc(sizeof(pthread_mutex_t));
	    pthread_mutex_init(pmutexPtr, NULL);
	    *mutexPtr = (Tcl_Mutex)pmutexPtr;
	    TclRememberMutex(mutexPtr);
	}
	pthread_mutex_unlock(&globalLock);
	MASTER_UNLOCK;
    }
    pmutexPtr = *((PMutex **) mutexPtr);
    PMutexLock(pmutexPtr);
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pthread_mutex_lock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexUnlock --
 *
595
596
597
598
599
600
601
602

603
604
605
606


607
608
609
610
611
612
613
614
615
616
617

618
619
620
621
622
623
624
625
626
627
628
629
630
631
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
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
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
611
612
613


614
615
616
617

618
619
620
621

622
623
624
625
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







-
+

-
-
-
+
+










-
+














-
-
+

-
-
+
+



















-
+









-
-
+
+


-
+



-
+







-
+

-
+


-
+

-
+


-
+












-
+







 *	The mutex is released when this returns.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexUnlock(
    Tcl_Mutex *mutexPtr)	/* Really (PMutex **) */
    Tcl_Mutex *mutexPtr)	/* Really (pthread_mutex_t **) */
{
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    PMutexUnlock(pmutexPtr);
    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **)mutexPtr;
    pthread_mutex_unlock(pmutexPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeMutex --
 *
 *	This procedure is invoked to clean up one mutex. This is only safe to
 *	call at the end of time.
 *
 *	This assumes the Global Lock is held.
 *	This assumes the Master Lock is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The mutex list is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    PMutex *pmutexPtr = *(PMutex **) mutexPtr;

    pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **)mutexPtr;
    if (pmutexPtr != NULL) {
	PMutexDestroy(pmutexPtr);
	Tcl_Free(pmutexPtr);
	pthread_mutex_destroy(pmutexPtr);
	ckfree((char *) pmutexPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait --
 *
 *	This procedure is invoked to wait on a condition variable. The mutex
 *	is automically released as part of the wait, and automatically grabbed
 *	when the condition is signaled.
 *
 *	The mutex must be held when this procedure is called.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is acquired when this returns.
 *	May block the current thread. The mutex is aquired when this returns.
 *	Will allocate memory for a pthread_mutex_t and initialize this the
 *	first time this Tcl_Mutex is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionWait(
    Tcl_Condition *condPtr,	/* Really (pthread_cond_t **) */
    Tcl_Mutex *mutexPtr,	/* Really (PMutex **) */
    const Tcl_Time *timePtr) /* Timeout on waiting period */
    Tcl_Mutex *mutexPtr,	/* Really (pthread_mutex_t **) */
    Tcl_Time *timePtr)		/* Timeout on waiting period */
{
    pthread_cond_t *pcondPtr;
    PMutex *pmutexPtr;
    pthread_mutex_t *pmutexPtr;
    struct timespec ptime;

    if (*condPtr == NULL) {
	pthread_mutex_lock(&globalLock);
	MASTER_LOCK;

	/*
	 * Double check inside mutex to avoid race, then initialize condition
	 * variable if necessary.
	 */

	if (*condPtr == NULL) {
	    pcondPtr = (pthread_cond_t *)Tcl_Alloc(sizeof(pthread_cond_t));
	    pcondPtr = (pthread_cond_t *) ckalloc(sizeof(pthread_cond_t));
	    pthread_cond_init(pcondPtr, NULL);
	    *condPtr = (Tcl_Condition) pcondPtr;
	    *condPtr = (Tcl_Condition)pcondPtr;
	    TclRememberCondition(condPtr);
	}
	pthread_mutex_unlock(&globalLock);
	MASTER_UNLOCK;
    }
    pmutexPtr = *((PMutex **)mutexPtr);
    pmutexPtr = *((pthread_mutex_t **)mutexPtr);
    pcondPtr = *((pthread_cond_t **)condPtr);
    if (timePtr == NULL) {
	PCondWait(pcondPtr, pmutexPtr);
	pthread_cond_wait(pcondPtr, pmutexPtr);
    } else {
	Tcl_Time now;

	/*
	 * Make sure to take into account the microsecond component of the
	 * current time, including possible overflow situations. [Bug #411603]
	 */

	Tcl_GetTime(&now);
	ptime.tv_sec = timePtr->sec + now.sec +
	    (timePtr->usec + now.usec) / 1000000;
	ptime.tv_nsec = 1000 * ((timePtr->usec + now.usec) % 1000000);
	PCondTimedWait(pcondPtr, pmutexPtr, &ptime);
	pthread_cond_timedwait(pcondPtr, pmutexPtr, &ptime);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionNotify --
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
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
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
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







-




-
+












-
+















-


-
+



+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





+


-
+

-
-
+
+




-
-
+
+

-
+





-
+







-
-
+



-
+



-
-
-
-
-
-













-
+






+






+
+
+
+
+
+
+
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









 */

void
Tcl_ConditionNotify(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);

    if (pcondPtr != NULL) {
	pthread_cond_broadcast(pcondPtr);
    } else {
	/*
	 * No-one has used the condition variable, so there are no waiters.
	 * Noone has used the condition variable, so there are no waiters.
	 */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeCondition --
 *
 *	This procedure is invoked to clean up a condition variable. This is
 *	only safe to call at the end of time.
 *
 *	This assumes the Global Lock is held.
 *	This assumes the Master Lock is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The condition variable is deallocated.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;

    if (pcondPtr != NULL) {
	pthread_cond_destroy(pcondPtr);
	Tcl_Free(pcondPtr);
	ckfree((char *) pcondPtr);
	*condPtr = NULL;
    }
}
#endif /* TCL_THREADS */

/*
 *----------------------------------------------------------------------
 *
 * TclpReaddir, TclpInetNtoa --
 *
 *	These procedures replace core C versions to be used in a threaded
 *	environment.
 *
 * Results:
 *	See documentation of C functions.
 *
 * Side effects:
 *	See documentation of C functions.
 *
 * Notes:
 *	TclpReaddir is no longer used by the core (see 1095909), but it
 *	appears in the internal stubs table (see #589526).
 *
 *----------------------------------------------------------------------
 */

Tcl_DirEntry *
TclpReaddir(
    TclDIR * dir)
{
    return TclOSreaddir(dir);
}

char *
TclpInetNtoa(
    struct in_addr addr)
{
#ifdef TCL_THREADS
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    unsigned char *b = (unsigned char*) &addr.s_addr;

    sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]);
    return tsdPtr->nabuf;
#else
    return inet_ntoa(addr);
#endif
}

#ifdef TCL_THREADS
/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static volatile int initialized = 0;
static pthread_key_t key;

typedef struct {
typedef struct allocMutex {
    Tcl_Mutex tlock;
    PMutex plock;
} AllocMutex;
    pthread_mutex_t plock;
} allocMutex;

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    AllocMutex *lockPtr;
    PMutex *plockPtr;
    struct allocMutex *lockPtr;
    register pthread_mutex_t *plockPtr;

    lockPtr = (AllocMutex *)malloc(sizeof(AllocMutex));
    lockPtr = malloc(sizeof(struct allocMutex));
    if (lockPtr == NULL) {
	Tcl_Panic("could not allocate lock");
    }
    plockPtr = &lockPtr->plock;
    lockPtr->tlock = (Tcl_Mutex) plockPtr;
    PMutexInit(&lockPtr->plock);
    pthread_mutex_init(&lockPtr->plock, NULL);
    return &lockPtr->tlock;
}

void
TclpFreeAllocMutex(
    Tcl_Mutex *mutex)		/* The alloc mutex to free. */
{
    AllocMutex *lockPtr = (AllocMutex *)mutex;

    allocMutex* lockPtr = (allocMutex*) mutex;
    if (!lockPtr) {
	return;
    }
    PMutexDestroy(&lockPtr->plock);
    pthread_mutex_destroy(&lockPtr->plock);
    free(lockPtr);
}

void
TclpInitAllocCache(void)
{
    pthread_key_create(&key, NULL);
}

void
TclpFreeAllocCache(
    void *ptr)
{
    if (ptr != NULL) {
	/*
	 * Called by TclFinalizeThreadAllocThread() during the thread
	 * finalization initiated from Tcl_FinalizeThread()
	 */

	TclFreeAllocCache(ptr);
	pthread_setspecific(key, NULL);

    } else {
    } else if (initialized) {
	/*
	 * Called by TclFinalizeThreadAlloc() during the process
	 * finalization initiated from Tcl_Finalize()
	 */

	pthread_key_delete(key);
	initialized = 0;
    }
}

void *
TclpGetAllocCache(void)
{
    if (!initialized) {
	pthread_mutex_lock(allocLockPtr);
	if (!initialized) {
	    pthread_key_create(&key, NULL);
	    initialized = 1;
	}
	pthread_mutex_unlock(allocLockPtr);
    }
    return pthread_getspecific(key);
}

void
TclpSetAllocCache(
    void *arg)
{
    pthread_setspecific(key, arg);
}
#endif /* USE_THREAD_ALLOC */

void *
TclpThreadCreateKey(void)
{
    pthread_key_t *ptkeyPtr;

    ptkeyPtr = (pthread_key_t *)TclpSysAlloc(sizeof(pthread_key_t));
    if (NULL == ptkeyPtr) {
	Tcl_Panic("unable to allocate thread key!");
    }

    if (pthread_key_create(ptkeyPtr, NULL)) {
	Tcl_Panic("unable to create pthread key!");
    }

    return ptkeyPtr;
}

void
TclpThreadDeleteKey(
    void *keyPtr)
{
    pthread_key_t *ptkeyPtr = (pthread_key_t *)keyPtr;

    if (pthread_key_delete(*ptkeyPtr)) {
	Tcl_Panic("unable to delete key!");
    }

    TclpSysFree(keyPtr);
}

void
TclpThreadSetGlobalTSD(
    void *tsdKeyPtr,
    void *ptr)
{
    pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr;

    if (pthread_setspecific(*ptkeyPtr, ptr)) {
	Tcl_Panic("unable to set global TSD value");
    }
}

void *
TclpThreadGetGlobalTSD(
    void *tsdKeyPtr)
{
    pthread_key_t *ptkeyPtr = (pthread_key_t *)tsdKeyPtr;

    return pthread_getspecific(*ptkeyPtr);
}

#endif /* TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Added unix/tclUnixThrd.h.




















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * tclUnixThrd.h --
 *
 *      This header file defines things for thread support.
 *
 * Copyright (c) 1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef _TCLUNIXTHRD
#define _TCLUNIXTHRD

#ifdef TCL_THREADS


#endif /* TCL_THREADS */
#endif /* _TCLUNIXTHRD */

Changes to unix/tclUnixTime.c.

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17


























18
19
20
21


22
23
24
25
26
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52

53
54
55
56
57
58
59
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













+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
+











-
+


















-
+







/*
 * tclUnixTime.c --
 *
 *	Contains Unix specific versions of Tcl functions that obtain time
 *	values from the operating system.
 *
 * Copyright (c) 1995 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"
#include <locale.h>
#if defined(TCL_WIDE_CLICKS) && defined(MAC_OSX_TCL)
#include <mach/mach_time.h>
#endif

#define TM_YEAR_BASE 1900
#define IsLeapYear(x)	(((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0))

/*
 * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread
 * safety, this structure must be in thread-specific data. The 'tmKey'
 * variable is the key to this buffer.
 */

static Tcl_ThreadDataKey tmKey;
typedef struct ThreadSpecificData {
    struct tm gmtime_buf;
    struct tm localtime_buf;
} ThreadSpecificData;

/*
 * If we fall back on the thread-unsafe versions of gmtime and localtime, use
 * this mutex to try to protect them.
 */

TCL_DECLARE_MUTEX(tmMutex)

static char *lastTZ = NULL;	/* Holds the last setting of the TZ
				 * environment variable, or an empty string if
				 * the variable was not set. */

/*
 * Static functions declared in this file.
 */

static void		SetTZIfNecessary(void);
static void		CleanupMemory(ClientData clientData);
static void		NativeScaleTime(Tcl_Time *timebuf,
			    ClientData clientData);
static void		NativeGetTime(Tcl_Time *timebuf,
			    ClientData clientData);

/*
 * TIP #233 (Virtualized Time): Data for the time hooks, if any.
 */

Tcl_GetTimeProc *tclGetTimeProcPtr = NativeGetTime;
Tcl_ScaleTimeProc *tclScaleTimeProcPtr = NativeScaleTime;
void *tclTimeClientData = NULL;
ClientData tclTimeClientData = NULL;

/*
 *----------------------------------------------------------------------
 *
 * TclpGetSeconds --
 *
 *	This procedure returns the number of seconds from the epoch. On most
 *	Unix systems the epoch is Midnight Jan 1, 1970 GMT.
 *
 * Results:
 *	Number of seconds from the epoch.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long
TclpGetSeconds(void)
{
    return time(NULL);
}

/*
 *----------------------------------------------------------------------
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
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







-
+


-
+





-
-
+
+






-
+




-
-
+
+







-
+




-
+









-
+










-
+













-
+












-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long
TclpGetClicks(void)
{
	Tcl_WideUInt now;
    unsigned long now;

#ifdef NO_GETTOD
    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
	(*tclGetTimeProcPtr) (&time, tclTimeClientData);
	now = time.sec*1000000 + time.usec;
    } else {
	/*
	 * A semi-NativeGetTime, specialized to clicks.
	 */
	struct tms dummy;

	now = (Tcl_WideUInt) times(&dummy);
	now = (unsigned long) times(&dummy);
    }
#else
    Tcl_Time time;

    tclGetTimeProcPtr(&time, tclTimeClientData);
    now = (Tcl_WideUInt)time.sec*1000000 + time.usec;
    (*tclGetTimeProcPtr) (&time, tclTimeClientData);
    now = time.sec*1000000 + time.usec;
#endif

    return now;
}
#ifdef TCL_WIDE_CLICKS

/*
 *----------------------------------------------------------------------
 *-----------------------------------------------------------------------------
 *
 * TclpGetWideClicks --
 *
 *	This procedure returns a WideInt value that represents the highest
 *	resolution clock available on the system. There are no guarantees on
 *	resolution clock available on the system. There are no garantees on
 *	what the resolution will be. In Tcl we will call this value a "click".
 *	The start time is also system dependent.
 *
 * Results:
 *	Number of WideInt clicks from some start time.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 *-----------------------------------------------------------------------------
 */

Tcl_WideInt
TclpGetWideClicks(void)
{
    Tcl_WideInt now;

    if (tclGetTimeProcPtr != NativeGetTime) {
	Tcl_Time time;

	tclGetTimeProcPtr(&time, tclTimeClientData);
	(*tclGetTimeProcPtr) (&time, tclTimeClientData);
	now = ((Tcl_WideInt)time.sec)*1000000 + time.usec;
    } else {
#ifdef MAC_OSX_TCL
	now = (Tcl_WideInt) (mach_absolute_time() & INT64_MAX);
#else
#error Wide high-resolution clicks not implemented on this platform
#endif
    }

    return now;
}

/*
 *----------------------------------------------------------------------
 *-----------------------------------------------------------------------------
 *
 * TclpWideClicksToNanoseconds --
 *
 *	This procedure converts click values from the TclpGetWideClicks native
 *	resolution to nanosecond resolution.
 *
 * Results:
 *	Number of nanoseconds from some start time.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 *-----------------------------------------------------------------------------
 */

double
TclpWideClicksToNanoseconds(
    Tcl_WideInt clicks)
{
    double nsec;
262
263
264
265
266
267
268




















































































































269
270
271
272
273
274
275
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    }
}
#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
 *	beginning of the epoch: 00:00 UCT, January 1, 1970.
 *
 *	This function is hooked, allowing users to specify their own virtual
 *	system time.
283
284
285
286
287
288
289
290













































































































291
292
293
294
295
296
297
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
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







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
Tcl_GetTime(
    Tcl_Time *timePtr)		/* Location to store time information. */
{
    tclGetTimeProcPtr(timePtr, tclTimeClientData);
    (*tclGetTimeProcPtr) (timePtr, tclTimeClientData);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetDate --
 *
 *	This function converts between seconds and struct tm. If useGMT is
 *	true, then the returned date will be in Greenwich Mean Time (GMT).
 *	Otherwise, it will be in the local time zone.
 *
 * Results:
 *	Returns a static tm structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

struct tm *
TclpGetDate(
    CONST time_t *time,
    int useGMT)
{
    if (useGMT) {
	return TclpGmtime(time);
    } else {
	return TclpLocaltime(time);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGmtime --
 *
 *	Wrapper around the 'gmtime' library function to make it thread safe.
 *
 * Results:
 *	Returns a pointer to a 'struct tm' in thread-specific data.
 *
 * Side effects:
 *	Invokes gmtime or gmtime_r as appropriate.
 *
 *----------------------------------------------------------------------
 */

struct tm *
TclpGmtime(
    CONST time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * Get a thread-local buffer to hold the returned time.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey);

#ifdef HAVE_GMTIME_R
    gmtime_r(timePtr, &(tsdPtr->gmtime_buf));
#else
    Tcl_MutexLock(&tmMutex);
    memcpy(&(tsdPtr->gmtime_buf), gmtime(timePtr), sizeof(struct tm));
    Tcl_MutexUnlock(&tmMutex);
#endif

    return &(tsdPtr->gmtime_buf);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpLocaltime --
 *
 *	Wrapper around the 'localtime' library function to make it thread
 *	safe.
 *
 * Results:
 *	Returns a pointer to a 'struct tm' in thread-specific data.
 *
 * Side effects:
 *	Invokes localtime or localtime_r as appropriate.
 *
 *----------------------------------------------------------------------
 */

struct tm *
TclpLocaltime(
    CONST time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * Get a thread-local buffer to hold the returned time.
     */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tmKey);

    SetTZIfNecessary();
#ifdef HAVE_LOCALTIME_R
    localtime_r(timePtr, &(tsdPtr->localtime_buf));
#else
    Tcl_MutexLock(&tmMutex);
    memcpy(&(tsdPtr->localtime_buf), localtime(timePtr), sizeof(struct tm));
    Tcl_MutexUnlock(&tmMutex);
#endif

    return &(tsdPtr->localtime_buf);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *
366
367
368
369
370
371
372
373
374


375
376
377
378
379
380
381
619
620
621
622
623
624
625


626
627
628
629
630
631
632
633
634







-
-
+
+







 *	See above.
 *
 *----------------------------------------------------------------------
 */

static void
NativeScaleTime(
    TCL_UNUSED(Tcl_Time *),
    TCL_UNUSED(ClientData))
    Tcl_Time *timePtr,
    ClientData clientData)
{
    /* Native scale is 1:1. Nothing is done */
}

/*
 *----------------------------------------------------------------------
 *
392
393
394
395
396
397
398
399

400
401
402
403
404
405
406
































































407
408
409
410
411
412
413
414
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
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







-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








 *
 *----------------------------------------------------------------------
 */

static void
NativeGetTime(
    Tcl_Time *timePtr,
    TCL_UNUSED(ClientData))
    ClientData clientData)
{
    struct timeval tv;

    (void) gettimeofday(&tv, NULL);
    timePtr->sec = tv.tv_sec;
    timePtr->usec = tv.tv_usec;
}
/*
 *----------------------------------------------------------------------
 *
 * SetTZIfNecessary --
 *
 *	Determines whether a call to 'tzset' is needed prior to the next call
 *	to 'localtime' or examination of the 'timezone' variable.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If 'tzset' has never been called in the current process, or if the
 *	value of the environment variable TZ has changed since the last call
 *	to 'tzset', then 'tzset' is called again.
 *
 *----------------------------------------------------------------------
 */

static void
SetTZIfNecessary(void)
{
    CONST char *newTZ = getenv("TZ");

    Tcl_MutexLock(&tmMutex);
    if (newTZ == NULL) {
	newTZ = "";
    }
    if (lastTZ == NULL || strcmp(lastTZ, newTZ)) {
	tzset();
	if (lastTZ == NULL) {
	    Tcl_CreateExitHandler(CleanupMemory, (ClientData) NULL);
	} else {
	    Tcl_Free(lastTZ);
	}
	lastTZ = ckalloc(strlen(newTZ) + 1);
	strcpy(lastTZ, newTZ);
    }
    Tcl_MutexUnlock(&tmMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * CleanupMemory --
 *
 *	Releases the private copy of the TZ environment variable upon exit
 *	from Tcl.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Frees allocated memory.
 *
 *----------------------------------------------------------------------
 */

static void
CleanupMemory(
    ClientData ignored)
{
    ckfree(lastTZ);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclXtNotify.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
1
2
3
4
5
6
7
8
9
10
11
12



13
14
15
16
17
18
19












-
-
-







/*
 * tclXtNotify.c --
 *
 *	This file contains the notifier driver implementation for the Xt
 *	intrinsics.
 *
 * Copyright (c) 1997 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.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <X11/Intrinsic.h>
#include "tclInt.h"

/*
 * This structure is used to keep track of the notifier info for a a
 * registered file.
 */
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
35
36
37
38
39
40
41

42
43
44
45
46
47
48
49







-
+







} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when file
 * handlers are ready to fire.
 */

typedef struct {
typedef struct FileHandlerEvent {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    int fd;			/* File descriptor that is ready. Used to find
				 * the FileHandler structure for the file
				 * (can't point directly to the FileHandler
				 * structure because it could go away while
				 * the event is queued). */
80
81
82
83
84
85
86
87
88


89
90
91
92
93
94
95
77
78
79
80
81
82
83


84
85
86
87
88
89
90
91
92







-
-
+
+







static void		FileProc(XtPointer clientData, int *source,
			    XtInputId *id);
static void		NotifierExitHandler(ClientData clientData);
static void		TimerProc(XtPointer clientData, XtIntervalId *id);
static void		CreateFileHandler(int fd, int mask,
			    Tcl_FileProc *proc, ClientData clientData);
static void		DeleteFileHandler(int fd);
static void		SetTimer(const Tcl_Time * timePtr);
static int		WaitForEvent(const Tcl_Time * timePtr);
static void		SetTimer(Tcl_Time * timePtr);
static int		WaitForEvent(Tcl_Time * timePtr);

/*
 * Functions defined in this file for use by users of the Xt Notifier:
 */

MODULE_SCOPE void InitNotifier(void);
MODULE_SCOPE XtAppContext TclSetAppContext(XtAppContext ctx);
228
229
230
231
232
233
234
235

236
237
238
239
240
241
242
225
226
227
228
229
230
231

232
233
234
235
236
237
238
239







-
+







 *	Destroys the notifier window.
 *
 *----------------------------------------------------------------------
 */

static void
NotifierExitHandler(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Not used. */
{
    if (notifier.currentTimeout != 0) {
	XtRemoveTimeOut(notifier.currentTimeout);
    }
    for (; notifier.firstFileHandlerPtr != NULL; ) {
	Tcl_DeleteFileHandler(notifier.firstFileHandlerPtr->fd);
    }
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
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







-
+

-
+












-
+







 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

static void
SetTimer(
    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
    Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
{
    unsigned long timeout;
    long timeout;

    if (!initialized) {
	InitNotifier();
    }

    TclSetAppContext(NULL);
    if (notifier.currentTimeout != 0) {
	XtRemoveTimeOut(notifier.currentTimeout);
    }
    if (timePtr) {
	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	notifier.currentTimeout = XtAppAddTimeOut(notifier.appContext,
		timeout, TimerProc, NULL);
		(unsigned long) timeout, TimerProc, NULL);
    } else {
	notifier.currentTimeout = 0;
    }
}

/*
 *----------------------------------------------------------------------
301
302
303
304
305
306
307
308

309
310
311
312
313
314
315
298
299
300
301
302
303
304

305
306
307
308
309
310
311
312







-
+







 *	Processes all queued events.
 *
 *----------------------------------------------------------------------
 */

static void
TimerProc(
    TCL_UNUSED(XtPointer),
    XtPointer clientData, /* Not used. */
    XtIntervalId *id)
{
    if (*id != notifier.currentTimeout) {
	return;
    }
    notifier.currentTimeout = 0;

355
356
357
358
359
360
361
362

363
364
365
366
367
368
369
352
353
354
355
356
357
358

359
360
361
362
363
364
365
366







-
+







    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = (FileHandler *)Tcl_Alloc(sizeof(FileHandler));
	filePtr = (FileHandler*) ckalloc(sizeof(FileHandler));
	filePtr->fd = fd;
	filePtr->read = 0;
	filePtr->write = 0;
	filePtr->except = 0;
	filePtr->readyMask = 0;
	filePtr->mask = 0;
	filePtr->nextPtr = notifier.firstFileHandlerPtr;
466
467
468
469
470
471
472
473

474
475
476
477
478
479
480
463
464
465
466
467
468
469

470
471
472
473
474
475
476
477







-
+







    }
    if (filePtr->mask & TCL_WRITABLE) {
	XtRemoveInput(filePtr->write);
    }
    if (filePtr->mask & TCL_EXCEPTION) {
	XtRemoveInput(filePtr->except);
    }
    Tcl_Free(filePtr);
    ckfree((char *) filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileProc --
 *
521
522
523
524
525
526
527
528

529
530
531
532
533
534
535
518
519
520
521
522
523
524

525
526
527
528
529
530
531
532







-
+







    }

    /*
     * This is an interesting event, so put it onto the event queue.
     */

    filePtr->readyMask |= mask;
    fileEvPtr = (FileHandlerEvent *)Tcl_Alloc(sizeof(FileHandlerEvent));
    fileEvPtr = (FileHandlerEvent *) ckalloc(sizeof(FileHandlerEvent));
    fileEvPtr->header.proc = FileHandlerEventProc;
    fileEvPtr->fd = filePtr->fd;
    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);

    /*
     * Process events on the Tcl event queue before returning to Xt.
     */
597
598
599
600
601
602
603
604

605
606
607
608
609
610
611
594
595
596
597
598
599
600

601
602
603
604
605
606
607
608







-
+







	 *    zeroed when a new file handler is created for the newly opened
	 *    file.
	 */

	mask = filePtr->readyMask & filePtr->mask;
	filePtr->readyMask = 0;
	if (mask != 0) {
	    filePtr->proc(filePtr->clientData, mask);
	    (*filePtr->proc)(filePtr->clientData, mask);
	}
	break;
    }
    return 1;
}

/*
626
627
628
629
630
631
632
633

634
635
636
637
638
639
640
623
624
625
626
627
628
629

630
631
632
633
634
635
636
637







-
+







 *	Queues file events that are detected by the select.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    int timeout;

    if (!initialized) {
	InitNotifier();
    }

Changes to unix/tclXtTest.c.

1
2
3
4
5
6
7
8
9


10
11
12
13
14
15
16
17
18

19
20

21
22
23
24
25
26
27
28
29
30
31
32
33
1
2
3
4
5
6
7


8
9
10
11



12
13
14

15


16




17

18
19
20
21
22
23
24







-
-
+
+


-
-
-



-
+
-
-
+
-
-
-
-

-







/*
 * tclXtTest.c --
 *
 *	Contains commands for Xt notifier specific tests on Unix.
 *
 * Copyright (c) 1997 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.
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include <X11/Intrinsic.h>
#include "tcl.h"

static Tcl_ObjCmdProc TesteventloopCmd;
static int	TesteventloopCmd(ClientData clientData,
extern DLLEXPORT Tcl_PackageInitProc Tclxttest_Init;

		    Tcl_Interp *interp, int argc, CONST char **argv);
/*
 * Functions defined in tclXtNotify.c for use by users of the Xt Notifier:
 */

extern void	InitNotifier(void);
extern XtAppContext	TclSetAppContext(XtAppContext ctx);

/*
 *----------------------------------------------------------------------
 *
 * Tclxttest_Init --
 *
 *	This procedure performs application-specific initialization. Most
44
45
46
47
48
49
50
51

52
53
54
55
56
57


58
59
60
61
62
63
64
35
36
37
38
39
40
41

42
43
44
45
46


47
48
49
50
51
52
53
54
55







-
+




-
-
+
+







 *----------------------------------------------------------------------
 */

int
Tclxttest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	return TCL_ERROR;
    }
    XtToolkitInitialize();
    InitNotifier();
    Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd,
            (ClientData) 0, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TesteventloopCmd --
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
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







-
+

-
-
+
+





-
-
-
+
+
+
+

-
+

-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TesteventloopCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    int argc,			/* Number of arguments. */
    CONST char **argv)		/* Argument strings. */
{
    static int *framePtr = NULL;/* Pointer to integer on stack frame of
				 * innermost invocation of the "wait"
				 * subcommand. */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ...");
	return TCL_ERROR;
   if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
                " option ... \"", NULL);
        return TCL_ERROR;
    }
    if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
    if (strcmp(argv[1], "done") == 0) {
	*framePtr = 1;
    } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
    } else if (strcmp(argv[1], "wait") == 0) {
	int *oldFramePtr;
	int done;
	int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);

	/*
	 * Save the old stack frame pointer and set up the current frame.
	 */
113
114
115
116
117
118
119
120

121
122
123
124
125
126
127
128
129
130
131
132
133
134
105
106
107
108
109
110
111

112
113
114
115
116
117
















-
+





-
-
-
-
-
-
-
-
-
	done = 0;
	while (!done) {
	    XtAppProcessEvent(TclSetAppContext(NULL), XtIMAll);
	}
	(void) Tcl_SetServiceMode(oldMode);
	framePtr = oldFramePtr;
    } else {
	Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be done or wait", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Deleted unix/tclooConfig.sh.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# tclooConfig.sh --
#
# This shell script (for sh) is generated automatically by TclOO's configure
# script, or would be except it has no values that we substitute. It will
# create shell variables for most of the configuration options discovered by
# the configure script. This script is intended to be included by TEA-based
# configure scripts for TclOO extensions so that they don't have to figure
# this all out for themselves.
#
# The information in this file is specific to a single platform.

# These are mostly empty because no special steps are ever needed from Tcl 8.6
# onwards; all libraries and include files are just part of Tcl.
TCLOO_LIB_SPEC=""
TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
TCLOO_VERSION=1.2.0

Changes to win/Makefile.in.

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
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
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
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
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







-
-
-


















+
+
+












-
+












+
+
+




+


-
-
-
-










+


-
-
-

-
-
-
+
+
+
+















-
-
-
-
-








-


-
-
-
+
+
-
-
+
-
-

-
+



-








-
+






-
+




















-
+






-

-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-






-
+
















-









-
-





-

-














-






-



-
-
-
-
-
-
-

-









-







+









-
+
-
-


+
+
+
+


















-
-
+



-


+

-
+
+













-
-
+
+





+
+
-
-
-
-
+
+
+
+



-
-
-

-
-
-

-
+
-
-

















+
+





-
+
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
+



-
+








# Directory in which to install the .a or .so binary for the Tcl library:
LIB_INSTALL_DIR		= $(INSTALL_ROOT)$(libdir)

# Path name to use when installing library scripts.
SCRIPT_INSTALL_DIR	= $(INSTALL_ROOT)$(TCL_LIBRARY)

# Path name to use when installing Tcl modules.
MODULE_INSTALL_DIR	= $(SCRIPT_INSTALL_DIR)/../tcl9

# Directory in which to install the include file tcl.h:
INCLUDE_INSTALL_DIR	= $(INSTALL_ROOT)$(includedir)

# Directory in which to (optionally) install the private tcl headers:
PRIVATE_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(includedir)

# Top-level directory in which to install manual entries:
MAN_INSTALL_DIR		= $(INSTALL_ROOT)$(mandir)

# Directory in which to install manual entry for tclsh:
MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1

# Directory in which to install manual entries for Tcl's C library procedures:
MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3

# Directory in which to install manual entries for the built-in Tcl commands:
MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann

# Libraries built with optimization switches have this additional extension
TCL_DBGX = @TCL_DBGX@

# warning flags
CFLAGS_WARNING = @CFLAGS_WARNING@

# The default switches for optimization or debugging
CFLAGS_DEBUG    = @CFLAGS_DEBUG@
CFLAGS_OPTIMIZE	= @CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS = 		$(CFLAGS_DEBUG)
#CFLAGS = 		$(CFLAGS_OPTIMIZE)
#CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 -DMP_NO_STDINT
CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -D_ATL_XP_TARGETING=1 -D__USE_MINGW_ANSI_STDIO=0

# To compile without backward compatibility and deprecated code uncomment the
# following
NO_DEPRECATED_FLAGS	=
#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED

# To enable compilation debugging reverse the comment characters on one of the
# following lines.
COMPILE_DEBUG_FLAGS =
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG
#COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS

# Special compiler flags to use when building man2tcl on Windows.
MAN2TCLFLAGS =		@MAN2TCLFLAGS@

SRC_DIR			= @srcdir@
ROOT_DIR		= @srcdir@/..
TOP_DIR			= $(shell cd @srcdir@/..; pwd -W 2>/dev/null || pwd -P)
GENERIC_DIR		= $(TOP_DIR)/generic
TOMMATH_DIR		= $(TOP_DIR)/libtommath
WIN_DIR			= $(TOP_DIR)/win
COMPAT_DIR		= $(TOP_DIR)/compat
PKGS_DIR		= $(TOP_DIR)/pkgs
ZLIB_DIR		= $(COMPAT_DIR)/zlib
MINIZIP_DIR		= $(ZLIB_DIR)/contrib/minizip
TOMMATH_DIR		= $(TOP_DIR)/libtommath

# Converts a POSIX path to a Windows native path.
CYGPATH			= @CYGPATH@

libdir_native	= $(shell $(CYGPATH) '$(libdir)')
bindir_native	= $(shell $(CYGPATH) '$(bindir)')
includedir_native = $(shell $(CYGPATH) '$(includedir)')
mandir_native = $(shell $(CYGPATH) '$(mandir)')
TCL_LIBRARY_NATIVE	= $(shell $(CYGPATH) '$(TCL_LIBRARY)')
GENERIC_DIR_NATIVE	= $(shell $(CYGPATH) '$(GENERIC_DIR)')
TOMMATH_DIR_NATIVE	= $(shell $(CYGPATH) '$(TOMMATH_DIR)')
WIN_DIR_NATIVE		= $(shell $(CYGPATH) '$(WIN_DIR)')
ROOT_DIR_NATIVE		= $(shell $(CYGPATH) '$(ROOT_DIR)')
SCRIPT_INSTALL_DIR_NATIVE	= $(shell $(CYGPATH) '$(SCRIPT_INSTALL_DIR)')
INCLUDE_INSTALL_DIR_NATIVE	= $(shell $(CYGPATH) '$(INCLUDE_INSTALL_DIR)')
MAN_INSTALL_DIR_NATIVE	= $(shell $(CYGPATH) '$(MAN_INSTALL_DIR)')
ROOT_DIR_WIN_NATIVE	= $(shell cd '$(ROOT_DIR)' ; pwd -W 2>/dev/null || pwd -P)
ZLIB_DIR_NATIVE		= $(shell $(CYGPATH) '$(ZLIB_DIR)')
MINIZIP_DIR_NATIVE	= $(shell $(CYGPATH) '$(MINIZIP_DIR)')
TOMMATH_DIR_NATIVE	= $(shell $(CYGPATH) '$(TOMMATH_DIR)')
#GENERIC_DIR_NATIVE	= $(GENERIC_DIR)
#TOMMATH_DIR_NATIVE	= $(TOMMATH_DIR)
#WIN_DIR_NATIVE		= $(WIN_DIR)
#ROOT_DIR_NATIVE		= $(ROOT_DIR)

# Fully qualify library path so that `make test`
# does not depend on the current directory.
LIBRARY_DIR1		= $(shell cd '$(ROOT_DIR_NATIVE)/library' ; pwd -P)
LIBRARY_DIR             = $(shell $(CYGPATH) '$(LIBRARY_DIR1)')
DLLSUFFIX		= @DLLSUFFIX@
LIBSUFFIX		= @LIBSUFFIX@
EXESUFFIX		= @EXESUFFIX@

VER			= @TCL_MAJOR_VERSION@@TCL_MINOR_VERSION@
DOTVER			= @TCL_MAJOR_VERSION@.@TCL_MINOR_VERSION@
DDEVER			= @TCL_DDE_MAJOR_VERSION@@TCL_DDE_MINOR_VERSION@
DDEDOTVER		= @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
REGVER			= @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
REGDOTVER		= @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@

TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_PATH		= libtcl.vfs/tcl_library
TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcldde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tclreg$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclreg$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] dde];\
			  package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] registry]
TEST_LOAD_PRMS		= package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] Dde];\
			  package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] Registry]
TEST_LOAD_FACILITIES	= package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
			  $(TEST_LOAD_PRMS)
TEST_LOAD_FACILITIES	= $(TEST_LOAD_PRMS)
ZLIB_DLL_FILE		= zlib1.dll
TOMMATH_DLL_FILE		= libtommath.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@
SHARED_LIBRARIES 	= $(TCL_DLL_FILE)
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

TCLSH			= tclsh$(VER)${EXESUFFIX}
WINE			= @WINE@
CAT32			= cat32$(EXEEXT)
MAN2TCL			= man2tcl$(EXEEXT)

# For cross-compiled builds, TCL_EXE is the name of a tclsh executable that is
# available *BEFORE* running make for the first time. Certain build targets
# (make genstubs, make install) need it to be available on the PATH. This
# executable should *NOT* be required just to do a normal build although
# it can be required to run make dist.
TCL_EXE			= @TCL_EXE@
TCL_EXE			= tclsh

@SET_MAKE@

# Setting the VPATH variable to a list of paths will cause the Makefile to
# look into these paths when resolving .c to .obj dependencies.

VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR):$(ZLIB_DIR):$(TOMMATH_DIR)
VPATH = $(GENERIC_DIR):$(WIN_DIR):$(COMPAT_DIR):$(TOMMATH_DIR)

AR		= @AR@
RANLIB		= @RANLIB@
CC		= @CC@
RC		= @RC@
RES		= @RES@
AC_FLAGS	= @EXTRA_CFLAGS@ @DEFS@
CPPFLAGS	= @CPPFLAGS@
LDFLAGS_DEBUG   = @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@
LDFLAGS		= @LDFLAGS@ @LDFLAGS_DEFAULT@
LDFLAGS_CONSOLE	= @LDFLAGS_CONSOLE@
LDFLAGS_WINDOW	= @LDFLAGS_WINDOW@
EXEEXT		= @EXEEXT@
OBJEXT		= @OBJEXT@
STLIB_LD	= @STLIB_LD@
SHLIB_LD	= @SHLIB_LD@
SHLIB_LD_LIBS	= @SHLIB_LD_LIBS@
SHLIB_CFLAGS	= @SHLIB_CFLAGS@
SHLIB_SUFFIX	= @SHLIB_SUFFIX@
LIBS		= @LIBS@ $(shell $(CYGPATH) '@ZLIB_LIBS@') $(shell $(CYGPATH) '@TOMMATH_LIBS@')
LIBS		= @LIBS@

RMDIR		= rm -rf
MKDIR		= mkdir -p
SHELL		= @SHELL@
RM		= rm -f
COPY		= cp
LN		= ln

###
# Tip 430 - ZipFS Modifications
###

CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
TCL_ZIP_FILE		= @TCL_ZIP_FILE@
TCL_VFS_PATH		= libtcl.vfs/tcl_library
TCL_VFS_ROOT		= libtcl.vfs

HOST_CC		        = @CC_FOR_BUILD@
HOST_EXEEXT             = @EXEEXT_FOR_BUILD@
HOST_OBJEXT             = @OBJEXT_FOR_BUILD@
ZIPFS_BUILD	        = @ZIPFS_BUILD@
NATIVE_ZIP		= @ZIP_PROG@
ZIP_PROG_OPTIONS		= @ZIP_PROG_OPTIONS@
ZIP_PROG_VFSSEARCH  = @ZIP_PROG_VFSSEARCH@
SHARED_BUILD		= @SHARED_BUILD@
INSTALL_MSGS            = @INSTALL_MSGS@
INSTALL_LIBRARIES       = @INSTALL_LIBRARIES@

# Minizip
MINIZIP_OBJS = \
        adler32.$(HOST_OBJEXT) \
        compress.$(HOST_OBJEXT) \
        crc32.$(HOST_OBJEXT) \
        deflate.$(HOST_OBJEXT) \
        infback.$(HOST_OBJEXT) \
        inffast.$(HOST_OBJEXT) \
        inflate.$(HOST_OBJEXT) \
        inftrees.$(HOST_OBJEXT) \
        ioapi.$(HOST_OBJEXT) \
        iowin32.$(HOST_OBJEXT)  \
        trees.$(HOST_OBJEXT) \
        uncompr.$(HOST_OBJEXT) \
        zip.$(HOST_OBJEXT) \
        zutil.$(HOST_OBJEXT) \
        minizip.$(HOST_OBJEXT)

ZIP_INSTALL_OBJS =  @ZIP_INSTALL_OBJS@

CC_SWITCHES = -I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${ZLIB_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH \
-DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} -DMP_PREC=4 \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}

CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@

STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
-I"${GENERIC_DIR_NATIVE}" -I"${TOMMATH_DIR_NATIVE}" \
-I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
${COMPILE_DEBUG_FLAGS}

TCLTEST_OBJS = \
	tclTest.$(OBJEXT) \
	tclTestObj.$(OBJEXT) \
	tclTestProcBodyObj.$(OBJEXT) \
	tclThreadTest.$(OBJEXT) \
	tclWinTest.$(OBJEXT)

GENERIC_OBJS = \
	regcomp.$(OBJEXT) \
	regexec.$(OBJEXT) \
	regfree.$(OBJEXT) \
	regerror.$(OBJEXT) \
	tclAlloc.$(OBJEXT) \
	tclAssembly.$(OBJEXT) \
	tclAsync.$(OBJEXT) \
	tclBasic.$(OBJEXT) \
	tclBinary.$(OBJEXT) \
	tclCkalloc.$(OBJEXT) \
	tclClock.$(OBJEXT) \
	tclCmdAH.$(OBJEXT) \
	tclCmdIL.$(OBJEXT) \
	tclCmdMZ.$(OBJEXT) \
	tclCompCmds.$(OBJEXT) \
	tclCompCmdsGR.$(OBJEXT) \
	tclCompCmdsSZ.$(OBJEXT) \
	tclCompExpr.$(OBJEXT) \
	tclCompile.$(OBJEXT) \
	tclConfig.$(OBJEXT) \
	tclDate.$(OBJEXT) \
	tclDictObj.$(OBJEXT) \
	tclDisassemble.$(OBJEXT) \
	tclEncoding.$(OBJEXT) \
	tclEnsemble.$(OBJEXT) \
	tclEnv.$(OBJEXT) \
	tclEvent.$(OBJEXT) \
	tclExecute.$(OBJEXT) \
	tclFCmd.$(OBJEXT) \
	tclFileName.$(OBJEXT) \
	tclGet.$(OBJEXT) \
	tclHash.$(OBJEXT) \
	tclHistory.$(OBJEXT) \
	tclIndexObj.$(OBJEXT) \
	tclInterp.$(OBJEXT) \
	tclIO.$(OBJEXT) \
	tclIOCmd.$(OBJEXT) \
	tclIOGT.$(OBJEXT) \
	tclIORChan.$(OBJEXT) \
	tclIORTrans.$(OBJEXT) \
	tclIOSock.$(OBJEXT) \
	tclIOUtil.$(OBJEXT) \
	tclLink.$(OBJEXT) \
	tclLiteral.$(OBJEXT) \
	tclListObj.$(OBJEXT) \
	tclLoad.$(OBJEXT) \
	tclMainW.$(OBJEXT) \
	tclMain.$(OBJEXT) \
	tclNamesp.$(OBJEXT) \
	tclNotify.$(OBJEXT) \
	tclOO.$(OBJEXT) \
	tclOOBasic.$(OBJEXT) \
	tclOOCall.$(OBJEXT) \
	tclOODefineCmds.$(OBJEXT) \
	tclOOInfo.$(OBJEXT) \
	tclOOMethod.$(OBJEXT) \
	tclOOStubInit.$(OBJEXT) \
	tclObj.$(OBJEXT) \
	tclOptimize.$(OBJEXT) \
	tclPanic.$(OBJEXT) \
	tclParse.$(OBJEXT) \
	tclPathObj.$(OBJEXT) \
	tclPipe.$(OBJEXT) \
	tclPkg.$(OBJEXT) \
	tclPkgConfig.$(OBJEXT) \
	tclPosixStr.$(OBJEXT) \
	tclPreserve.$(OBJEXT) \
	tclProc.$(OBJEXT) \
	tclProcess.$(OBJEXT) \
	tclRegexp.$(OBJEXT) \
	tclResolve.$(OBJEXT) \
	tclResult.$(OBJEXT) \
	tclScan.$(OBJEXT) \
	tclStringObj.$(OBJEXT) \
	tclStrToD.$(OBJEXT) \
	tclStubInit.$(OBJEXT) \
	tclStubLib.$(OBJEXT) \
	tclThread.$(OBJEXT) \
	tclThreadAlloc.$(OBJEXT) \
	tclThreadJoin.$(OBJEXT) \
	tclThreadStorage.$(OBJEXT) \
	tclTimer.$(OBJEXT) \
	tclTomMathInterface.$(OBJEXT) \
	tclTrace.$(OBJEXT) \
	tclUtf.$(OBJEXT) \
	tclUtil.$(OBJEXT) \
	tclVar.$(OBJEXT) \
	tclVar.$(OBJEXT)
	tclZipfs.$(OBJEXT) \
	tclZlib.$(OBJEXT)

TOMMATH_OBJS = \
	bncore.${OBJEXT} \
	bn_reverse.${OBJEXT} \
	bn_fast_s_mp_mul_digs.${OBJEXT} \
	bn_fast_s_mp_sqr.${OBJEXT} \
	bn_mp_add.${OBJEXT} \
	bn_mp_add_d.${OBJEXT} \
	bn_mp_and.${OBJEXT} \
	bn_mp_clamp.${OBJEXT} \
	bn_mp_clear.${OBJEXT} \
	bn_mp_clear_multi.${OBJEXT} \
	bn_mp_cmp.${OBJEXT} \
	bn_mp_cmp_d.${OBJEXT} \
	bn_mp_cmp_mag.${OBJEXT} \
	bn_mp_cnt_lsb.${OBJEXT} \
	bn_mp_copy.${OBJEXT} \
	bn_mp_count_bits.${OBJEXT} \
	bn_mp_div.${OBJEXT} \
	bn_mp_div_d.${OBJEXT} \
	bn_mp_div_2.${OBJEXT} \
	bn_mp_div_2d.${OBJEXT} \
	bn_mp_div_3.${OBJEXT} \
	bn_mp_exch.${OBJEXT} \
	bn_mp_expt_u32.${OBJEXT} \
	bn_mp_get_mag_u64.${OBJEXT} \
	bn_mp_expt_d.${OBJEXT} \
	bn_mp_grow.${OBJEXT} \
	bn_mp_init.${OBJEXT} \
	bn_mp_init_copy.${OBJEXT} \
	bn_mp_init_i64.${OBJEXT} \
	bn_mp_init_multi.${OBJEXT} \
	bn_mp_init_set.${OBJEXT} \
	bn_mp_init_set_int.${OBJEXT} \
	bn_mp_init_size.${OBJEXT} \
	bn_mp_init_u64.${OBJEXT} \
	bn_mp_karatsuba_mul.${OBJEXT} \
	bn_mp_karatsuba_sqr.$(OBJEXT) \
	bn_mp_lshd.${OBJEXT} \
	bn_mp_mod.${OBJEXT} \
	bn_mp_mod_2d.${OBJEXT} \
	bn_mp_mul.${OBJEXT} \
	bn_mp_mul_2.${OBJEXT} \
	bn_mp_mul_2d.${OBJEXT} \
	bn_mp_mul_d.${OBJEXT} \
	bn_mp_neg.${OBJEXT} \
	bn_mp_or.${OBJEXT} \
	bn_mp_radix_size.${OBJEXT} \
	bn_mp_radix_smap.${OBJEXT} \
	bn_mp_read_radix.${OBJEXT} \
	bn_mp_rshd.${OBJEXT} \
	bn_mp_set_i64.${OBJEXT} \
	bn_mp_set_u64.${OBJEXT} \
	bn_mp_set.${OBJEXT} \
	bn_mp_set_int.${OBJEXT} \
	bn_mp_shrink.${OBJEXT} \
	bn_mp_sqr.${OBJEXT} \
	bn_mp_sqrt.${OBJEXT} \
	bn_mp_sub.${OBJEXT} \
	bn_mp_sub_d.${OBJEXT} \
	bn_mp_to_unsigned_bin.${OBJEXT} \
	bn_mp_to_unsigned_bin_n.${OBJEXT} \
	bn_mp_signed_rsh.${OBJEXT} \
	bn_mp_to_ubin.${OBJEXT} \
	bn_mp_to_radix.${OBJEXT} \
	bn_mp_ubin_size.${OBJEXT} \
	bn_mp_toom_mul.${OBJEXT} \
	bn_mp_toom_sqr.${OBJEXT} \
	bn_mp_toradix_n.${OBJEXT} \
	bn_mp_unsigned_bin_size.${OBJEXT} \
	bn_mp_xor.${OBJEXT} \
	bn_mp_zero.${OBJEXT} \
	bn_s_mp_add.${OBJEXT} \
	bn_s_mp_balance_mul.$(OBJEXT) \
	bn_s_mp_karatsuba_mul.${OBJEXT} \
	bn_s_mp_karatsuba_sqr.$(OBJEXT) \
	bn_s_mp_mul_digs.${OBJEXT} \
	bn_s_mp_mul_digs_fast.${OBJEXT} \
	bn_s_mp_reverse.${OBJEXT} \
	bn_s_mp_sqr_fast.${OBJEXT} \
	bn_s_mp_sqr.${OBJEXT} \
	bn_s_mp_sub.${OBJEXT} \
	bn_s_mp_sub.${OBJEXT}
	bn_s_mp_toom_mul.${OBJEXT} \
	bn_s_mp_toom_sqr.${OBJEXT}


WIN_OBJS = \
	tclWin32Dll.$(OBJEXT) \
	tclWinChan.$(OBJEXT) \
	tclWinConsole.$(OBJEXT) \
	tclWinSerial.$(OBJEXT) \
	tclWinError.$(OBJEXT) \
	tclWinFCmd.$(OBJEXT) \
	tclWinFile.$(OBJEXT) \
	tclWinInit.$(OBJEXT) \
	tclWinLoad.$(OBJEXT) \
	tclWinNotify.$(OBJEXT) \
	tclWinPipe.$(OBJEXT) \
	tclWinSock.$(OBJEXT) \
	tclWinThrd.$(OBJEXT) \
	tclWinTime.$(OBJEXT)

PIPE_OBJS = stub16.$(OBJEXT)

DDE_OBJS = tclWinDde.$(OBJEXT)

REG_OBJS = tclWinReg.$(OBJEXT)

STUB_OBJS = \
STUB_OBJS = tclStubLib.$(OBJEXT)
	tclStubLib.$(OBJEXT) \
	tclTomMathStubLib.$(OBJEXT) \
	tclOOStubLib.$(OBJEXT) \
	tclWinPanic.$(OBJEXT)

TCLSH_OBJS = tclAppInit.$(OBJEXT)

ZLIB_OBJS = \
	adler32.$(OBJEXT) \
	compress.$(OBJEXT) \
	crc32.$(OBJEXT) \
	deflate.$(OBJEXT) \
	infback.$(OBJEXT) \
	inffast.$(OBJEXT) \
	inflate.$(OBJEXT) \
	inftrees.$(OBJEXT) \
	trees.$(OBJEXT) \
	uncompr.$(OBJEXT) \
	zutil.$(OBJEXT)

TCL_OBJS = ${GENERIC_OBJS} ${WIN_OBJS} @ZLIB_OBJS@ @TOMMATH_OBJS@
TCL_OBJS = ${GENERIC_OBJS} $(TOMMATH_OBJS) ${WIN_OBJS}

TCL_DOCS = "$(ROOT_DIR_NATIVE)"/doc/*.[13n]

all: binaries libraries doc packages
all: binaries libraries doc

# Test-suite helper (can be used to test Tcl from build directory with all expected modules).
# To start from windows shell use:
#   > tcltest.cmd -verbose bps -file fileName.test
# or from mingw/msys shell:
#   $ ./tcltest -verbose bps -file fileName.test

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
595
596
597
598
599
600
601
602
603
604

605
606
607
608
609
610
611
612

613
614

615
616
617

618
619
620
621
622
623
624
625
626
627
628
629

630
631
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
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
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
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
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
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
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
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
611

612
613
614
615

616
617
618
619

620
621

622
623
624
625

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
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
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







-
+

-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+




-
+












-
+




-
-
-
-
-














-
-
-
-
-






-
-
+
-
-
-
-
-

-
-
+
-
-
+
-
-
-
+











-
+





-
+
+


-
+
+


-
+
-
-
-
+

-
+
-
-
-
-
-
+
-
-
-
-
-
-
-















-
+






-
-









-
-
-
-
-
-
-
-









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-












-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+


-
+

-
+

-
-
+
+





-
+

-
+



-
+






-
+








-
+

-
+



-
+



-
+

-
+



-
+


-
-
-
-
-

-
-
+
+

-
+

-
+



-
+

-
+

-
+



+
-
+
+
+
+

-
-
-
+
-
-






-
-
+
+

-
+

-
-
-
+
+
+




-
-
+
+

-
-
-
+
+
+

-
+

-
+






-
+



-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-









-
+



-
+





-
+





-
+















-
+

-
-
+
+
-
-


-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

















-
-
-

-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-

-
+
-
+












-


	  echo 'cd /tmp'; \
	  echo '#"$$BDP/$(TCLSH)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_FACILITIES)" "$$@"'; \
	  echo '"$$BDP/$(TEST_EXE_FILE)" "$(ROOT_DIR_WIN_NATIVE)/tests/all.tcl" $$TESTFLAGS -load "$(TEST_LOAD_PRMS)" "$$@"'; \
	) > tcltest.sh;

tcltest.sh: tcltest.cmd

tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd
tcltest: binaries $(TEST_EXE_FILE) $(CAT32) tcltest.cmd

binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)
binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH)

winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}

libraries:

doc:

tclzipfile: ${TCL_ZIP_FILE}

${TCL_ZIP_FILE}:  ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE}
	@rm -rf ${TCL_VFS_ROOT}
	@mkdir -p ${TCL_VFS_PATH}
	@echo "creating ${TCL_VFS_PATH} (prepare compression)"
	@( \
	  $(LN) $$(find $(TOP_DIR)/library/* -maxdepth 0 -type f) ${TCL_VFS_PATH}/ && \
	  (for D in $$(find $(TOP_DIR)/library/* -maxdepth 0 -type d); do \
	    mkdir -p "${TCL_VFS_PATH}/$$(basename $$D)"; \
	    $(LN) -s $$D/* ${TCL_VFS_PATH}/$$(basename $$D)/; \
	  done) && \
	  $(LN) ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl && \
	  $(LN) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde/ && \
	  $(LN) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg/ \
	) || ( \
	  $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \
	  $(COPY) -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \
	  $(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde; \
	  $(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg; \
	)
	(zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}') 2>/dev/null || \
	  (echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")`; \
	  cd ${TCL_VFS_ROOT} && \
	  $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null && \
	  echo "${TCL_ZIP_FILE} successful created with $$zip" && \
	  cd ..)

$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
	$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
	tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	$(COPY) tclsh.exe.manifest $(TCLSH).manifest
	@VC_MANIFEST_EMBED_EXE@

cat32.$(OBJEXT): cat.c
	$(CC) -c $(CC_SWITCHES) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
	$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)

$(CAT32): cat32.$(OBJEXT)
	$(CC) $(CFLAGS) cat32.$(OBJEXT) $(CC_EXENAME) $(LIBS) $(LDFLAGS_CONSOLE)

# The following targets are configured by autoconf to generate either a shared
# library or static library

${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
	@$(RM) ${TCL_STUB_LIB_FILE}
	@MAKE_STUB_LIB@ ${STUB_OBJS}
	@POST_MAKE_LIB@

${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ ${TCL_ZIP_FILE}
${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES)
	@$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
	@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TCL_DLL_FILE}.manifest
	@VC_MANIFEST_EMBED_DLL@
	@if test "${ZIPFS_BUILD}" = "1" ; then \
		cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}; \
		${NATIVE_ZIP} -A ${TCL_DLL_FILE} \
		  || echo 'ignore zip-error by adjust sfx process (not executable?)'; \
	fi

${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@$(RM) ${TCL_LIB_FILE}
	@MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
	@POST_MAKE_LIB@

${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
	@MAKE_DLL@ ${DDE_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE}.manifest

${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
	@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest

${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
	$(COPY) tclsh.exe.manifest ${TEST_DLL_FILE}.manifest

${TEST_EXE_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS} tclTestMain.${OBJEXT}
	@$(RM) ${TEST_EXE_FILE}
	$(CC) $(CFLAGS) $(TCLTEST_OBJS) tclTestMain.$(OBJEXT) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
	$(COPY) tclsh.exe.manifest ${TEST_EXE_FILE}.manifest

# use pre-built zlib1.dll
${ZLIB_DLL_FILE}: ${TCL_STUB_LIB_FILE}
# PIPE_DLL_FILE is actually an executable, don't build it like a DLL.
	@if test "@ZLIB_LIBS@set" != "${ZLIB_DIR_NATIVE}/win32/zdll.libset" ; then \
		$(COPY) $(ZLIB_DIR)/win64/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
	else \
		$(COPY) $(ZLIB_DIR)/win32/${ZLIB_DLL_FILE} ${ZLIB_DLL_FILE}; \
	fi;

# use pre-built libtommath.dll
${TOMMATH_DLL_FILE}: ${TCL_STUB_LIB_FILE}
${PIPE_DLL_FILE}: ${PIPE_OBJS}
	@if test "@TOMMATH_LIBS@set" != "${TOMMATH_DIR_NATIVE}/win32/tommath.libset" ; then \
		$(COPY) $(TOMMATH_DIR)/win64/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \
	@$(RM) ${PIPE_DLL_FILE}
	else \
		$(COPY) $(TOMMATH_DIR)/win32/${TOMMATH_DLL_FILE} ${TOMMATH_DLL_FILE}; \
	fi;
	@MAKE_EXE@ $(CFLAGS) ${PIPE_OBJS} $(LIBS) $(LDFLAGS_CONSOLE)

# Add the object extension to the implicit rules. By default .obj is not
# automatically added.

.SUFFIXES: .${OBJEXT}
.SUFFIXES: .$(RES)
.SUFFIXES: .rc

# Special case object targets

tclTestMain.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) -DTCL_TEST -DUNICODE -D_UNICODE $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
	$(CC) -c $(CC_SWITCHES) -DTCL_TEST -DBUILD_tcl $(EXTFLAGS) $(CC_OBJNAME) $(WIN_DIR)/tclAppInit.c

tclWinInit.${OBJEXT}: tclWinInit.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinPipe.${OBJEXT}: tclWinPipe.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_PIPE_DLL=\"$(PIPE_DLL_FILE)\" \
	    $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinReg.${OBJEXT}: tclWinReg.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
	$(CC) -c $(CC_SWITCHES) \
	    $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclWinDde.${OBJEXT}: tclWinDde.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
	$(CC) -c $(CC_SWITCHES) \

tclAppInit.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
	    $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)

tclMainW.${OBJEXT}: tclMain.c
testMain.${OBJEXT}: tclAppInit.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)

# TIP #430, ZipFS Support
tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl \
	$(CC) -c $(CC_SWITCHES) -DTCL_TEST @DEPARG@ $(CC_OBJNAME)
	-DCFG_RUNTIME_PATH="\"$(bindir_native)\"" \
	-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
	-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
	-DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \
	-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
	$(ZLIB_INCLUDE) -I$(MINIZIP_DIR_NATIVE)  @DEPARG@ $(CC_OBJNAME)


# TIP #59, embedding of configuration information into the binary library.
#
# 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.${OBJEXT}: tclPkgConfig.c
	$(CC)	-c $(CC_SWITCHES)			\
		-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR_NATIVE)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \
		\
		-DCFG_RUNTIME_LIBDIR="\"$(libdir_native)\"" \
		-DCFG_RUNTIME_BINDIR="\"$(bindir_native)\"" \
		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
		-DCFG_RUNTIME_INCDIR="\"$(includedir_native)\"" \
		-DCFG_RUNTIME_DOCDIR="\"$(mandir_native)\"" \
		-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
		-DBUILD_tcl \
		@DEPARG@ $(CC_OBJNAME)

# The following objects are part of the stub library and should not be built
# as DLL objects but none of the symbols should be exported

tclStubLib.${OBJEXT}: tclStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclOOStubLib.${OBJEXT}: tclOOStubLib.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

tclWinPanic.${OBJEXT}: tclWinPanic.c
	$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)

# Implicit rule for all object files that will end up in the Tcl library

%.${OBJEXT}: %.c
	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl @DEPARG@ $(CC_OBJNAME)

.rc.$(RES):
	$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@



#--------------------------------------------------------------------------
# Minizip implementation
#--------------------------------------------------------------------------
adler32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c

compress.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c

crc32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c

deflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c

ioapi.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c

iowin32.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c

infback.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c

inffast.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c

inflate.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c

inftrees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c

trees.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c

uncompr.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c

zip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c

zutil.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c

minizip.$(HOST_OBJEXT):
	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c

minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
	$(HOST_CC) -o $@ $(MINIZIP_OBJS)

# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
# the name of the .y file so that make doesn't try to automatically regenerate
# the .c file.

gendate:
	bison --output-file=$(GENERIC_DIR)/tclDate.c \
	--name-prefix=TclDate \
	--no-lines \
	$(GENERIC_DIR)/tclGetDate.y

INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
INSTALL_EXTRA_TARGETS =
INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)
# The following target generates the file generic/tclTomMath.h. It needs to be
# run (and the results checked) after updating to a new release of libtommath.

gentommath_h:
	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/fix_tommath_h.tcl" \
		"$(TOMMATH_DIR_NATIVE)/tommath.h" \
		> "$(GENERIC_DIR_NATIVE)/tclTomMath.h"

install: $(INSTALL_TARGETS)
install: all install-binaries install-libraries install-doc

install-binaries: binaries
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)"; \
	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
	    do \
	    if [ ! -d "$$i" ] ; then \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) "$$i"; \
		chmod 755 "$$i"; \
		$(MKDIR) $$i; \
		chmod 755 $$i; \
		else true; \
		fi; \
	    done;
	@for i in dde${DDEDOTVER} reg${REGDOTVER}; \
	    do \
	    if [ ! -d "$(LIB_INSTALL_DIR)/$$i" ] ; then \
	    if [ ! -d $(LIB_INSTALL_DIR)/$$i ] ; then \
		echo "Making directory $(LIB_INSTALL_DIR)/$$i"; \
		$(MKDIR) "$(LIB_INSTALL_DIR)/$$i"; \
		$(MKDIR) $(LIB_INSTALL_DIR)/$$i; \
		else true; \
		fi; \
	    done;
	@for i in $(TCL_DLL_FILE) $(ZLIB_DLL_FILE) $(TOMMATH_DLL_FILE) $(TCLSH); \
	@for i in $(TCL_DLL_FILE) $(TCLSH) $(PIPE_DLL_FILE); \
	    do \
	    if [ -f $$i ]; then \
		echo "Installing $$i to $(BIN_INSTALL_DIR)/"; \
		$(COPY) $$i "$(BIN_INSTALL_DIR)"; \
	    fi; \
	    done
	@for i in tclConfig.sh tclooConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
	@for i in tclConfig.sh $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE); \
	    do \
	    if [ -f $$i ]; then \
		echo "Installing $$i to $(LIB_INSTALL_DIR)/"; \
		$(COPY) $$i "$(LIB_INSTALL_DIR)"; \
	    fi; \
	    done
	@if [ -f $(DDE_DLL_FILE) ]; then \
	    echo Installing $(DDE_DLL_FILE); \
	    $(COPY) $(DDE_DLL_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
	    $(COPY) $(DDE_DLL_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
	    $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
		"$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
		$(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
	    fi
	@if [ -f $(DDE_LIB_FILE) ]; then \
	    echo Installing $(DDE_LIB_FILE); \
	    $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
	    $(COPY) $(DDE_LIB_FILE) $(LIB_INSTALL_DIR)/dde${DDEDOTVER}; \
	    fi
	@if [ -f $(REG_DLL_FILE) ]; then \
	    echo Installing $(REG_DLL_FILE); \
	    $(COPY) $(REG_DLL_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \
	    $(COPY) $(REG_DLL_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    $(COPY) $(ROOT_DIR)/library/reg/pkgIndex.tcl \
		"$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \
		$(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi
	@if [ -f $(REG_LIB_FILE) ]; then \
	    echo Installing $(REG_LIB_FILE); \
	    $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/reg${REGDOTVER}"; \
	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
	    fi

install-libraries-zipfs-shared: libraries

install-libraries-zipfs-static: install-libraries-zipfs-shared
	$(COPY) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"

install-libraries: libraries install-tzdata install-msgs
	@for i in "$(prefix)/lib" "$(INCLUDE_INSTALL_DIR)" \
		"$(SCRIPT_INSTALL_DIR)" "$(MODULE_INSTALL_DIR)"; \
	@for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
		$(SCRIPT_INSTALL_DIR); \
	    do \
	    if [ ! -d "$$i" ] ; then \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) "$$i"; \
		$(MKDIR) $$i; \
		else true; \
		fi; \
	    done;
	@for i in opt0.4 cookiejar0.2 encoding; \
	@for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4  ../tcl8/8.4/platform ../tcl8/8.5; \
	    do \
	    if [ ! -d "$(SCRIPT_INSTALL_DIR)/$$i" ] ; then \
	    if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
		echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)/$$i"; \
		$(MKDIR) $(SCRIPT_INSTALL_DIR)/$$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files";
	@for i in 9.0  9.0/platform; \
	@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
		"$(GENERIC_DIR)/tclPlatDecls.h" \
		"$(GENERIC_DIR)/tclTomMath.h" \
		"$(GENERIC_DIR)/tclTomMathDecls.h"; \
	    do \
	    if [ ! -d "$(MODULE_INSTALL_DIR)/$$i" ] ; then \
		echo "Making directory $(MODULE_INSTALL_DIR)/$$i"; \
		$(MKDIR) "$(MODULE_INSTALL_DIR)/$$i"; \
	    $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
		else true; \
		fi; \
	    done;
	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
	@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
	    do \
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package cookiejar 0.2"
	@for j in $(ROOT_DIR)/library/cookiejar/*.{tcl,txt.gz}; \
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.10.0a1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10.0a1.tm";
	@echo "Installing package opt 0.4.7";
	@echo "Installing package http 2.7.15 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.15.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.7.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/9.0/msgcat-1.7.1.tm";
	@echo "Installing package msgcat 1.5.2 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.5.2.tm;
	@echo "Installing package tcltest 2.5.3 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/9.0/tcltest-2.5.3.tm";
	@echo "Installing package platform 1.0.14 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/9.0/platform-1.0.14.tm";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.3.tm;
	@echo "Installing package platform 1.0.18 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.18.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/9.0/platform/shell-1.1.4.tm";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc; do \
	@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
	done;

install-tzdata:
	@echo "Installing time zone data"
	@$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
	    "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR_NATIVE)/tzdata"
	    "$(ROOT_DIR)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"

install-msgs:
	@echo "Installing message catalogs"
	$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
	    "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR_NATIVE)/msgs"
	@$(TCL_EXE) "$(ROOT_DIR)/tools/installData.tcl" \
	    "$(ROOT_DIR)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"

install-doc: doc

install-headers:
	@for i in "$(INCLUDE_INSTALL_DIR)"; \
	    do \
	    if [ ! -d "$$i" ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) "$$i"; \
		chmod 755 "$$i"; \
		else true; \
		fi; \
	    done;
	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
	@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
		$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
		$(GENERIC_DIR)/tclPlatDecls.h \
		$(GENERIC_DIR)/tclTomMath.h \
		$(GENERIC_DIR)/tclTomMathDecls.h \
		$(TOMMATH_DIR)/tommath.h ; \
	    do \
	    $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \
	    done;

# Optional target to install private headers
install-private-headers: libraries
	@for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \
	    do \
	    if [ ! -d $$i ] ; then \
		echo "Making directory $$i"; \
		$(MKDIR) $$i; \
		else true; \
		fi; \
	    done;
	@echo "Installing private header files";
	@for i in "$(GENERIC_DIR)/tclInt.h" "$(GENERIC_DIR)/tclIntDecls.h" \
		"$(GENERIC_DIR)/tclIntPlatDecls.h" "$(GENERIC_DIR)/tclPort.h" \
		"$(GENERIC_DIR)/tclOOInt.h" "$(GENERIC_DIR)/tclOOIntDecls.h" \
		"$(WIN_DIR)/tclWinPort.h" ; \
	    do \
	    $(COPY) "$$i" "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
	    done;

# Specifying TESTFLAGS on the command line is the standard way to pass args to
# tcltest, i.e.:
#	% make test TESTFLAGS="-verbose bps -file fileName.test"

test: test-tcl test-packages
test: test-tcl

test-tcl: tcltest
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	./$(TEST_EXE_FILE) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
	-load "$(TEST_LOAD_FACILITIES)"

# Useful target to launch a built tclsh with the proper path,...
runtest: tcltest
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT)
	./$(TEST_EXE_FILE) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT)

# This target can be used to run tclsh from the build directory via
# `make shell SCRIPT=foo.tcl`
shell: binaries
	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
	$(WINE) ./$(TCLSH) $(SCRIPT)
	./$(TCLSH) $(SCRIPT)

# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
	@echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run
	gdb ./$(TCLSH) --command=gdb.run
	rm gdb.run

depend:

Makefile: $(SRC_DIR)/Makefile.in
	./config.status

cleanhelp:
	$(RM) *.hlp *.cnt *.GID *.rtf man2tcl.exe

clean: cleanhelp clean-packages
clean: cleanhelp
	$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
	$(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest.sh
	$(RM) *.pch *.ilk *.pdb
	$(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) tcltest.cmd tcltest.sh
	$(RM) *.pch *.ilk *.pdb *.zip
	$(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT}
	$(RM) *.zip
	$(RMDIR) *.vfs

distclean: distclean-packages clean
distclean: clean
	$(RM) Makefile config.status config.cache config.log tclConfig.sh \
		tcl.hpj config.status.lineno tclsh.exe.manifest
		tcl.hpj config.status.lineno

#
# Bundled package targets
#

PKG_CFG_ARGS		= @PKG_CFG_ARGS@
PKG_DIR			= ./pkgs

packages:
	@builddir=`$(CYGPATH) $$(pwd -P)`; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ] ; then \
	    if [ -x $$i/configure ] ; then \
	      pkg=`basename $$i`; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        ( cd $(PKG_DIR)/$$pkg; \
	          echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \
	          $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared; ) \
	      fi ; \
	      echo "Building package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \
	    fi; \
	  fi; \
	done; \
	cd $$builddir

install-packages: packages
	@builddir=`pwd -P`; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        echo "Installing package '$$pkg'"; \
	        ( cd $(PKG_DIR)/$$pkg; $(MAKE) install "DESTDIR=$(INSTALL_ROOT)"; ) \
	    fi; \
	  fi; \
	done; \
	cd $$builddir

test-packages: tcltest packages
	@builddir=`pwd -P`; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        echo "Testing package '$$pkg'"; \
	        ( cd $(PKG_DIR)/$$pkg; $(MAKE) "LD_LIBRARY_PATH=$$builddir:${LD_LIBRARY_PATH}" "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" "TCLLIBPATH=$$builddir/pkgs" test "TCLSH_PROG=$$builddir/${TCLSH}"; ) \
	    fi; \
	  fi; \
	done; \
	cd $$builddir

clean-packages:
	@builddir=`pwd -P`; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
	    fi; \
	  fi; \
	done; \
	cd $$builddir

distclean-packages:
	@builddir=`pwd -P`; \
	for i in $(PKGS_DIR)/*; do \
	  if [ -d $$i ]; then \
	    pkg=`basename $$i`; \
	    if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
	    fi; \
	    cd $$builddir; \
	    rm -rf $(PKG_DIR)/$$pkg; \
	  fi; \
	done; \
	rm -rf $(PKG_DIR)

#
# Regenerate the stubs files.
#

$(GENERIC_DIR)/tclStubInit.c: $(GENERIC_DIR)/tcl.decls \
		$(GENERIC_DIR)/tclInt.decls
	@echo "Warning: tclStubInit.c may be out of date."
	@echo "Developers may want to run \"make genstubs\" to regenerate."
	@echo "This warning can be safely ignored, do not report as a bug!"

genstubs:
	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
	    "$(GENERIC_DIR_NATIVE)" \
	    "$(GENERIC_DIR_NATIVE)/tcl.decls" \
	    "$(GENERIC_DIR_NATIVE)/tclInt.decls" \
	    "$(GENERIC_DIR_NATIVE)/tclTomMath.decls"
	$(TCL_EXE) "$(ROOT_DIR_NATIVE)/tools/genStubs.tcl" \
	    "$(GENERIC_DIR_NATIVE)" \
	    "$(GENERIC_DIR_NATIVE)/tclOO.decls"

#
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
# tk8.* up two directories from the TOOL_DIR.
#

TOOL_DIR=$(ROOT_DIR)/tools
HTML_INSTALL_DIR=$(ROOT_DIR)/html
winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL)
	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
html:
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS)"

html-tcl: $(TCLSH)
	./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS)
	hcw /c /e tcl.hpj
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tcl"

html-tk: $(TCLSH)
$(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c
	$(MAKE) shell SCRIPT="$(TOOL_DIR)/tcltk-man2html.tcl --htmldir=$(HTML_INSTALL_DIR) --srcdir=$(ROOT_DIR)/.. $(BUILD_HTML_FLAGS) --tk"
	$(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c

#
# The list of all the targets that do not correspond to real files. This stops
# 'make' from getting confused when someone makes an error in a rule.
#

.PHONY: all tcltest binaries libraries doc gendate gentommath_h install
.PHONY: install-binaries install-libraries install-tzdata install-msgs
.PHONY: install-doc install-private-headers test test-tcl runtest shell
.PHONY: gdb depend cleanhelp clean distclean packages install-packages
.PHONY: test-packages clean-packages distclean-packages genstubs html
.PHONY: html-tcl html-tk
.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile

# DO NOT DELETE THIS LINE -- make depend depends on it.

Changes to win/README.

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

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
-
+

















-
+







Tcl 9.0 for Windows
Tcl 8.5 for Windows

1. Introduction
---------------

This is the directory where you configure and compile the Windows
version of Tcl.  This directory also contains source files for Tcl
that are specific to Microsoft Windows.

The information in this file is maintained on the web at:

	http://www.tcl.tk/doc/howto/compile.html#win

2. Compiling Tcl
----------------

In order to compile Tcl for Windows, you need the following:

	Tcl 9.0 Source Distribution (plus any patches)
	Tcl 8.5 Source Distribution (plus any patches)

	and

	Visual C++ 6 or newer

	or

75
76
77
78
79
80
81
82

83
84

85
86
87
88
89
90
91
75
76
77
78
79
80
81

82
83

84
85
86
87
88
89
90
91







-
+

-
+







and Msys, you can download a suitable win32 or win64 compiler 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 tclsh90.exe, you must ensure that tcl90.dll is
Note that in order to run tclsh85.exe, you must ensure that tcl85.dll is
on your path, in the system directory, or in the directory containing
tclsh90.exe.
tclsh85.exe.

Note: Tcl no longer provides support for Win32s.

3. Test suite
-------------

This distribution contains an extensive test suite for Tcl.  Some of the

Changes to win/buildall.vc.bat.

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
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







-
+
-
-




















-
-
-
+
+
+




-
-
+
+







if defined WINDOWSSDKDIR (goto :startBuilding)

:: We need to run the development environment batch script that comes
:: with developer studio (v4,5,6,7,etc...)  All have it.  This path
:: might not be correct.  You should call it yourself prior to running
:: this batchfile.
::
REM call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
set "VSCMD_START_DIR=%CD%"
call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\Common7\Tools\VsDevCmd.bat"
if errorlevel 1 (goto no_vcvars)

:startBuilding

echo.
echo Sit back and have a cup of coffee while this grinds through ;)
echo You asked for *everything*, remember?
echo.
title Building Tcl, please wait...


:: makefile.vc uses this for its default anyways, but show its use here
:: just to be explicit and convey understanding to the user.  Setting
:: the INSTALLDIR envar prior to running this batchfile affects all builds.
::
if "%INSTALLDIR%" == "" set INSTALLDIR=C:\Program Files\Tcl


:: Build the normal stuff along with the help file.
::
set OPTS=none
if not %SYMBOLS%.==. set OPTS=symbols
nmake -nologo -f makefile.vc release htmlhelp OPTS=%OPTS% %1
set OPTS=threads
if not %SYMBOLS%.==. set OPTS=symbols,threads
nmake -nologo -f makefile.vc release winhelp OPTS=%OPTS% %1
if errorlevel 1 goto error

:: Build the static core and shell.
::
set OPTS=static,msvcrt
if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt
set OPTS=static,msvcrt,threads
if not %SYMBOLS%.==. set OPTS=symbols,static,msvcrt,threads
nmake -nologo -f makefile.vc shell OPTS=%OPTS% %1
if errorlevel 1 goto error

set OPTS=
set SYMBOLS=
goto end

Changes to win/cat.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

25
26
27
28
29
30
31
1
2
3
4
5
6
7
8
9
10
11






12
13
14

15
16

17
18
19
20
21
22
23
24











-
-
-
-
-
-



-


-
+







/*
 * cat.c --
 *
 *	Program used when testing tclWinPipe.c
 *
 * Copyright (c) 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.
 */

#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)
main(void)
{
    char buf[1024];
    int n;
    const char *err;

    while (1) {
	n = _read(0, buf, sizeof(buf));

Added win/coffbase.txt.












































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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
;
; This file defines the virtual base addresses for the Dynamic Link Libraries
; that are part of the Tcl system.  The first token on a line is the key (or name
; of the DLL) and the second token is the virtual base address, in hexidecimal.
; The third token is the maximum size of the DLL image file, including symbols.
;
; Using a specified "prefered load address" should speed loading time by avoiding
; relocations (NT supported only).  It is assumed extension authors will contribute
; their modules to this grand-master list.  You can use the dumpbin utility with
; the /headers option to get the "size of image" data (already in hex).  If the
; maximum size is too small a linker warning will occur.  Modules can overlap when
; they're mutually exclusive.  This info is placed in the DLL's PE header by the
; linker with the `-base:@$(TCLDIR)\win\coffbase.txt,<key>` option.

tcl		0x10000000	0x00200000
tcldde		0x10200000	0x00010000
tclreg		0x10210000	0x00010000
tk		0x10220000	0x00200000
expect		0x10480000	0x00080000
itcl		0x10500000	0x00080000
itk		0x10580000	0x00080000
bltlite		0x10600000	0x00080000
blt		0x10680000	0x00080000
iocpsock	0x10700000	0x00080000
tls		0x10780000	0x00100000
winico		0x10880000	0x00010000
sample		0x108B0000	0x00010000
tile		0x10900000	0x00080000
memchan		0x109D0000	0x00010000
tdom		0x109E0000	0x00080000
tclvfs		0x10A70000	0x00010000
tkvideo		0x10B00000	0x00010000
tclsdl		0x10B20000	0x00080000
vqtcl		0x10C00000	0x00010000
tdbc		0x10C40000	0x00010000
thread		0x10C80000	0x00020000
nsf		0x10ca0000	0x00080000
;
; insert new packages here
;
snack		0x1E000000	0x00400000
sound		0x1E400000	0x00400000
snackogg	0x1E800000	0x00200000

Changes to win/configure.

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
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
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

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
611
612

613
614
615
616




617
618

619
620
621
622

623
624
625
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
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
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
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


-
+

-
-
+
-
-


-
-
-
+
+
+

-
+
-
-
+


-
+


-
-
-
+
-
-
+
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-

-
+
-
-
-

-
-
+
-
-
-
+
-
-
-





-
-
+
-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-





-
+





-
-
-
-
-

+
-
+


-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
+







+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
-
-
+
+
+
+
+
-
-
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+

-
-
+
+
+

-
-
-
-


-
-
+
+




-
+
-
-
-
+
-
-
+
-
-
+
-
-
-
+
+


-
-
+
-
+

-
-
+

+
+
-
-
+
+
-
-
+
-
-
+
-
-
-
+
+
+
-
-

-
+

+
+

-
+

-
+
-


-
+





-
-
+








+
+
+
+
+
-
-
+
+
+
+


-
+


+
+





-

-




+

+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-





-
+


-
+


-
+



-
+



-
-
+
+




-
+


-
+

-
-
-
+
+
+
+

-
+



-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-
-







#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69.
# Generated by GNU Autoconf 2.59 for tcl 8.5.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
# Copyright (C) 2003 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##
## --------------------- ##
## M4sh Initialization.  ##
## --------------------- ##

# Be more Bourne compatible
# Be Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
  *posix*) :
    set -o posix ;; #(
  set -o posix
  *) :
     ;;
esac
fi

DUALCASE=1; export DUALCASE # for MKS sh

as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '
    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi
  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'
fi

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  PATH_SEPARATOR=:
  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
      PATH_SEPARATOR=';'
  }

fi


# Support unset when possible.
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

  as_unset=unset
# Find who we are.  Look in the path if we contain no directory separator.
as_myself=
else
case $0 in #((
  *[\\/]* ) as_myself=$0 ;;
  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
  done
IFS=$as_save_IFS

  as_unset=false
     ;;
esac
# We did not find ourselves, most probably we were run as `sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
  as_myself=$0
fi
if test ! -f "$as_myself"; then

  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# Work around bugs in pre-3.0 UWIN ksh.
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
$as_unset ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
for as_var in \
LANGUAGE=C
export LANGUAGE

  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH

  LC_TELEPHONE LC_TIME
# Use a proper internal environment variable to ensure we don't fall
  # into an infinite loop, continuously re-executing ourselves.
  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
    _as_can_reexec=no; export _as_can_reexec;
    # We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
  *v*x* | *x*v* ) as_opts=-vx ;;
  *v* ) as_opts=-v ;;
  *x* ) as_opts=-x ;;
  * ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
  fi
  # We don't want this to propagate to other subprocesses.
          { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
  as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '\${1+\"\$@\"}'='\"\$@\"'
  setopt NO_GLOB_SUBST
else
  case \`(set -o) 2>/dev/null\` in #(
  *posix*) :
    set -o posix ;; #(
  *) :
     ;;
esac
fi
"
  as_required="as_fn_return () { (exit \$1); }
as_fn_success () { as_fn_return 0; }
as_fn_failure () { as_fn_return 1; }
as_fn_ret_success () { return 0; }
as_fn_ret_failure () { return 1; }

do
exitcode=0
as_fn_success || { exitcode=1; echo as_fn_success failed.; }
as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :

  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
else
  exitcode=1; echo positional parameters were not saved.
fi
test x\$exitcode = x0 || exit 1
test -x / || exit 1"
  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
test \$(( 1 + 1 )) = 2 || exit 1"
  if (eval "$as_required") 2>/dev/null; then :
  as_have_required=yes
else
  as_have_required=no
fi
  if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :

else
    eval $as_var=C; export $as_var
  else
  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
as_found=false
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  as_found=:
  case $as_dir in #(
	 /*)
	   for as_base in sh bash ksh sh5; do
	     # Try only shells that exist, to save several forks.
	     as_shell=$as_dir/$as_base
	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
		    { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
  CONFIG_SHELL=$as_shell as_have_required=yes
		   if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
  break 2
fi
fi
	   done;;
       esac
  as_found=false
done
$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
	      { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
  CONFIG_SHELL=$SHELL as_have_required=yes
fi; }
IFS=$as_save_IFS

    $as_unset $as_var

      if test "x$CONFIG_SHELL" != x; then :
  export CONFIG_SHELL
             # We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
  *v*x* | *x*v* ) as_opts=-vx ;;
  *v* ) as_opts=-v ;;
  *x* ) as_opts=-x ;;
  * ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi

    if test x$as_have_required = xno; then :
  $as_echo "$0: This script requires a shell more modern than all"
  $as_echo "$0: the shells that I found on your system."
  if test x${ZSH_VERSION+set} = xset ; then
    $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
    $as_echo "$0: be upgraded to zsh 4.3.4 or later."
  else
    $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
$0: including any error possibly output before this
$0: message. Then install a modern shell, or manually run
$0: the script under such a shell if you do have one."
  fi
  exit 1
fi
fi
  fi
fi
SHELL=${CONFIG_SHELL-/bin/sh}
export SHELL
# Unset more variables known to interfere with behavior of common tools.
CLICOLOR_FORCE= GREP_OPTIONS=
unset CLICOLOR_FORCE GREP_OPTIONS

## --------------------- ##
## M4sh Shell Functions. ##
## --------------------- ##
# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset

# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_mkdir_p
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(
      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *) as_qdir=$as_dir;;
      esac
      as_dirs="'$as_qdir' $as_dirs"
      as_dir=`$as_dirname -- "$as_dir" ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"


# Required to use basename.
} # as_fn_mkdir_p

# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else
  as_fn_append ()
  {
    eval $1=\$$1\$2
  }
fi # as_fn_append

# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
  as_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith


# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
{
  as_status=$1; test $as_status -eq 0 && as_status=1
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error

if expr a : '\(a\)' >/dev/null 2>&1 &&
if expr a : '\(a\)' >/dev/null 2>&1; then
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

# Name of the executable.
as_me=`$as_basename -- "$0" ||
as_me=`$as_basename "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	 X"$0" : 'X\(/\)$' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
  	  /^X\/\(\/\/\)$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
  	  /^X\/\(\/\).*/{ s//\1/; q; }
  	  s/.*/./; q'`


	  s/.*/./; q'`

# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  echo "#! /bin/sh" >conf$$.sh
  echo  "exit 0"   >>conf$$.sh
  chmod +x conf$$.sh
  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
    PATH_SEPARATOR=';'
  else
    PATH_SEPARATOR=:
  fi
  rm -f conf$$.sh
fi


  as_lineno_1=$LINENO as_lineno_1a=$LINENO
  as_lineno_2=$LINENO as_lineno_2a=$LINENO
  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2"  || {
  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)
  sed -n '
  # Find who we are.  Look in the path if we contain no path at all
  # relative or not.
  case $0 in
    p
    /[$]LINENO/=
  ' <$as_myself |
    sed '
    *[\\/]* ) as_myself=$0 ;;
    *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
      s/[$]LINENO.*/&-/
      t lineno
      b
      :lineno
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
done

       ;;
  esac
      N
      :loop
      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
  # We did not find ourselves, most probably we were run as `sh COMMAND'
  # in which case we are not to be found in the path.
  if test "x$as_myself" = x; then
    as_myself=$0
  fi
  if test ! -f "$as_myself"; then
    { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
   { (exit 1); exit 1; }; }
  fi
  case $CONFIG_SHELL in
  '')
    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  for as_base in sh bash ksh sh5; do
	 case $as_dir in
	 /*)
	   if ("$as_dir/$as_base" -c '
  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then
	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
	     CONFIG_SHELL=$as_dir/$as_base
	     export CONFIG_SHELL
	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}
	   fi;;
	 esac
       done
done
;;
  esac

  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
  # uniformly replaced by the line number.  The first 'sed' inserts a
  # line-number line before each line; the second 'sed' does the real
  # work.  The second script uses 'N' to pair each line-number line
  # with the numbered line, and appends trailing '-' during
  # substitution so that $LINENO is not a special case at line end.
  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
  # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)
  sed '=' <$as_myself |
    sed '
      N
      s,$,-,
      : loop
      s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
      t loop
      s/-\n.*//
      s,-$,,
      s,^['$as_cr_digits']*\n,,
    ' >$as_me.lineno &&
  chmod +x "$as_me.lineno" ||
    { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
  chmod +x $as_me.lineno ||
    { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
   { (exit 1); exit 1; }; }

  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
  # already done that, so ensure we don't try to do so again and fall
  # in an infinite loop.  This has already happened in practice.
  _as_can_reexec=no; export _as_can_reexec
  # Don't try to exec as it changes $[0], causing all sort of problems
  # (the dirname of $[0] is not the place where we might find the
  # original and so on.  Autoconf is especially sensitive to this).
  . "./$as_me.lineno"
  # original and so on.  Autoconf is especially sensible to this).
  . ./$as_me.lineno
  # Exit status is that of the last command.
  exit
}

ECHO_C= ECHO_N= ECHO_T=

case `echo -n x` in #(((((
-n*)
  case `echo 'xy\c'` in
case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
  xy)  ECHO_C='\c';;
  *c*,-n*) ECHO_N= ECHO_C='
  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
       ECHO_T='	';;
' ECHO_T='	' ;;
  esac;;
*)
  ECHO_N='-n';;
  *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;
  *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;
esac

rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
if expr a : '\(a\)' >/dev/null 2>&1; then
  rm -f conf$$.dir/conf$$.file
  as_expr=expr
else
  rm -f conf$$.dir
  mkdir conf$$.dir 2>/dev/null
  as_expr=false
fi

rm -f conf$$ conf$$.exe conf$$.file
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
echo >conf$$.file
if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
  # We could just check for DJGPP; but this test a) works b) is more generic
    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
  # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
    # In both cases, we have to default to `cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
      as_ln_s='cp -pR'
  if test -f conf$$.exe; then
    # Don't use ln at all; we don't have any links
    as_ln_s='cp -p'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
    as_ln_s='ln -s'
  fi
elif ln conf$$.file conf$$ 2>/dev/null; then
  as_ln_s=ln
else
  as_ln_s='cp -pR'
  as_ln_s='cp -p'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rm -f conf$$ conf$$.exe conf$$.file
rmdir conf$$.dir 2>/dev/null

if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
  as_mkdir_p=:
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi

as_test_x='test -x'
as_executable_p=as_fn_executable_p
as_executable_p="test -f"

# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"

# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"


# IFS
# We need space, tab and new line, in precisely that order.
as_nl='
'
IFS=" 	$as_nl"
test -n "$DJDIR" || exec 7<&0 </dev/null
exec 6>&1

# CDPATH.
$as_unset CDPATH


# Name of the host.
# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`

exec 6>&1

#
# Initializations.
#
ac_default_prefix=/usr/local
ac_clean_files=
ac_config_libobj_dir=.
LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
SHELL=${CONFIG_SHELL-/bin/sh}

# Maximum number of lines to put in a shell here document.
# This variable seems obsolete.  It should probably be removed, and
# only ac_max_sed_lines should be used.
: ${ac_max_here_lines=38}

# Identity of this package.
PACKAGE_NAME=
PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
PACKAGE_VERSION='8.5'
PACKAGE_STRING='tcl 8.5'
PACKAGE_BUGREPORT=''
PACKAGE_URL=

ac_unique_file="../generic/tcl.h"
# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
#if HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
#ifdef HAVE_SYS_STAT_H
#if HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
#ifdef STDC_HEADERS
#if STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
# ifdef HAVE_STDLIB_H
# if HAVE_STDLIB_H
#  include <stdlib.h>
# endif
#endif
#ifdef HAVE_STRING_H
# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
#if HAVE_STRING_H
# if !STDC_HEADERS && HAVE_MEMORY_H
#  include <memory.h>
# endif
# include <string.h>
#endif
#ifdef HAVE_STRINGS_H
#if HAVE_STRINGS_H
# include <strings.h>
#endif
#ifdef HAVE_INTTYPES_H
#if HAVE_INTTYPES_H
# include <inttypes.h>
#endif
#ifdef HAVE_STDINT_H
# include <stdint.h>
#else
# if HAVE_STDINT_H
#  include <stdint.h>
# endif
#endif
#ifdef HAVE_UNISTD_H
#if HAVE_UNISTD_H
# include <unistd.h>
#endif"

ac_subst_vars='LTLIBOBJS
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
LIBOBJS
RES
RC_DEFINES
RC_DEFINE
RC_INCLUDE
RC_TYPE
RC_OUT
TCL_REG_MINOR_VERSION
TCL_REG_MAJOR_VERSION
TCL_REG_VERSION
TCL_DDE_MINOR_VERSION
TCL_DDE_MAJOR_VERSION
TCL_DDE_VERSION
TCL_PACKAGE_PATH
TCL_LIB_VERSIONS_OK
TCL_EXP_FILE
TCL_BUILD_EXP_FILE
TCL_NEEDS_EXP_FILE
TCL_LD_SEARCH_FLAGS
TCL_CC_SEARCH_FLAGS
TCL_BUILD_LIB_SPEC
MAKE_EXE
MAKE_DLL
POST_MAKE_LIB
MAKE_STUB_LIB
MAKE_LIB
LIBRARIES
EXESUFFIX
LIBSUFFIX
LIBPREFIX
DLLSUFFIX
LIBS_GUI
TCL_SHARED_BUILD
SHLIB_SUFFIX
SHLIB_CFLAGS
SHLIB_LD_LIBS
SHLIB_LD
STLIB_LD
LDFLAGS_WINDOW
LDFLAGS_CONSOLE
LDFLAGS_OPTIMIZE
LDFLAGS_DEBUG
CC_EXENAME
CC_OBJNAME
DEPARG
EXTRA_CFLAGS
CFG_TCL_EXPORT_FILE_SUFFIX
CFG_TCL_UNSHARED_LIB_SUFFIX
CFG_TCL_SHARED_LIB_SUFFIX
TCL_BIN_DIR
TCL_SRC_DIR
TCL_DLL_FILE
TCL_BUILD_STUB_LIB_PATH
TCL_BUILD_STUB_LIB_SPEC
TCL_INCLUDE_SPEC
TCL_STUB_LIB_PATH
TCL_STUB_LIB_SPEC
TCL_STUB_LIB_FLAG
TCL_STUB_LIB_FILE
TCL_LIB_SPEC
TCL_IMPORT_LIB_FLAG
TCL_IMPORT_LIB_FILE
TCL_STATIC_LIB_FLAG
TCL_STATIC_LIB_FILE
TCL_LIB_FLAG
TCL_LIB_FILE
TCL_EXE
PKG_CFG_ARGS
TCL_PATCH_LEVEL
TCL_MINOR_VERSION
TCL_MAJOR_VERSION
TCL_VERSION
MACHINE
TCL_WIN_VERSION
VC_MANIFEST_EMBED_EXE
VC_MANIFEST_EMBED_DLL
LDFLAGS_DEFAULT
CFLAGS_DEFAULT
INSTALL_MSGS
INSTALL_LIBRARIES
TCL_ZIP_FILE
ZIPFS_BUILD
ZIP_INSTALL_OBJS
ZIP_PROG_VFSSEARCH
ZIP_PROG_OPTIONS
ZIP_PROG
TCLSH_PROG
EXEEXT_FOR_BUILD
CC_FOR_BUILD
TOMMATH_OBJS
ZLIB_OBJS
TOMMATH_LIBS
ZLIB_LIBS
TOMMATH_DLL_FILE
ZLIB_DLL_FILE
CFLAGS_WARNING
CFLAGS_OPTIMIZE
CFLAGS_DEBUG
DL_LIBS
WINE
CYGPATH
SHARED_BUILD
SET_MAKE
RC
RANLIB
AR
EGREP
GREP
CPP
OBJEXT
EXEEXT
ac_ct_CC
CPPFLAGS
LDFLAGS
CFLAGS
CC
target_alias
host_alias
build_alias
LIBS
ECHO_T
ECHO_N
ECHO_C
DEFS
mandir
localedir
libdir
psdir
pdfdir
dvidir
htmldir
infodir
docdir
oldincludedir
includedir
localstatedir
sharedstatedir
sysconfdir
datadir
datarootdir
libexecdir
sbindir
bindir
program_transform_name
prefix
exec_prefix
PACKAGE_URL
PACKAGE_BUGREPORT
PACKAGE_STRING
PACKAGE_VERSION
PACKAGE_TARNAME
PACKAGE_NAME
PATH_SEPARATOR
SHELL
OBJEXT_FOR_BUILD'
ac_subst_files=''
ac_user_opts='
enable_option_checking
with_encoding
enable_shared
enable_64bit
enable_zipfs
enable_symbols
enable_embedded_manifest
'
      ac_precious_vars='build_alias
host_alias
target_alias
CC
CFLAGS
LDFLAGS
LIBS
CPPFLAGS
CPP'


# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
ac_unrecognized_opts=
ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
exec_prefix=NONE
no_create=
no_recursion=
prefix=NONE
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
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







-



-
+
-



+


-
-
+
-
-
-
-
-
-
-
+


-




-
+




-
-
+
-
-
-



-
+
-
-







x_libraries=NONE

# Installation directory options.
# These are left unexpanded so users can "make install exec_prefix=/foo"
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datarootdir='${prefix}/share'
datadir='${prefix}/share'
datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE}'
infodir='${datarootdir}/info'
infodir='${prefix}/info'
htmldir='${docdir}'
dvidir='${docdir}'
pdfdir='${docdir}'
psdir='${docdir}'
libdir='${exec_prefix}/lib'
localedir='${datarootdir}/locale'
mandir='${datarootdir}/man'
mandir='${prefix}/man'

ac_prev=
ac_dashdash=
for ac_option
do
  # If the previous option needs an argument, assign it.
  if test -n "$ac_prev"; then
    eval $ac_prev=\$ac_option
    eval "$ac_prev=\$ac_option"
    ac_prev=
    continue
  fi

  case $ac_option in
  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
  ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
  *=)   ac_optarg= ;;
  *)    ac_optarg=yes ;;
  esac

  # Accept the important Cygnus configure options, so we can diagnose typos.

  case $ac_dashdash$ac_option in
  case $ac_option in
  --)
    ac_dashdash=yes ;;

  -bindir | --bindir | --bindi | --bind | --bin | --bi)
    ac_prev=bindir ;;
  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
    bindir=$ac_optarg ;;

  -build | --build | --buil | --bui | --bu)
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
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







-
+

-
+
-
-
-
-
+
-
-
-
-
+


-
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
+


-
+

-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-

-
+







  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
    cache_file=$ac_optarg ;;

  --config-cache | -C)
    cache_file=config.cache ;;

  -datadir | --datadir | --datadi | --datad)
  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
    ac_prev=datadir ;;
  -datadir=* | --datadir=* | --datadi=* | --datad=*)
  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
    datadir=$ac_optarg ;;

  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
  | --dataroo | --dataro | --datar)
  | --da=*)
    ac_prev=datarootdir ;;
  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
    datarootdir=$ac_optarg ;;
    datadir=$ac_optarg ;;

  -disable-* | --disable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
    ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: $ac_useropt"
    expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid feature name: $ac_feature" >&2
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
      *"
"enable_$ac_useropt"
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=no ;;

   { (exit 1); exit 1; }; }
  -docdir | --docdir | --docdi | --doc | --do)
    ac_prev=docdir ;;
  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
    docdir=$ac_optarg ;;

    ac_feature=`echo $ac_feature | sed 's/-/_/g'`
  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
    ac_prev=dvidir ;;
  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
    dvidir=$ac_optarg ;;
    eval "enable_$ac_feature=no" ;;

  -enable-* | --enable-*)
    ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
    ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid feature name: $ac_useropt"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
    expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid feature name: $ac_feature" >&2
   { (exit 1); exit 1; }; }
    ac_feature=`echo $ac_feature | sed 's/-/_/g'`
    case $ac_option in
      *"
"enable_$ac_useropt"
"*) ;;
      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
      *) ac_optarg=yes ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval enable_$ac_useropt=\$ac_optarg ;;
    eval "enable_$ac_feature='$ac_optarg'" ;;

  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
  | --exec | --exe | --ex)
    ac_prev=exec_prefix ;;
  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
435
436
437
438
439
440
441






442
443
444
445
446
447
448







-
-
-
-
-
-







    ac_init_help=short ;;

  -host | --host | --hos | --ho)
    ac_prev=host_alias ;;
  -host=* | --host=* | --hos=* | --ho=*)
    host_alias=$ac_optarg ;;

  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
    ac_prev=htmldir ;;
  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
  | --ht=*)
    htmldir=$ac_optarg ;;

  -includedir | --includedir | --includedi | --included | --include \
  | --includ | --inclu | --incl | --inc)
    ac_prev=includedir ;;
  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
  | --includ=* | --inclu=* | --incl=* | --inc=*)
    includedir=$ac_optarg ;;

992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005


1006
1007
1008


1009
1010
1011
1012
1013
1014
1015
459
460
461
462
463
464
465





466

467
468
469
470

471
472
473
474
475
476
477
478
479







-
-
-
-
-

-
+
+


-
+
+







  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
  | --libexe | --libex | --libe)
    ac_prev=libexecdir ;;
  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
  | --libexe=* | --libex=* | --libe=*)
    libexecdir=$ac_optarg ;;

  -localedir | --localedir | --localedi | --localed | --locale)
    ac_prev=localedir ;;
  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
    localedir=$ac_optarg ;;

  -localstatedir | --localstatedir | --localstatedi | --localstated \
  | --localstate | --localstat | --localsta | --localst | --locals)
  | --localstate | --localstat | --localsta | --localst \
  | --locals | --local | --loca | --loc | --lo)
    ac_prev=localstatedir ;;
  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
    localstatedir=$ac_optarg ;;

  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
    ac_prev=mandir ;;
  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
    mandir=$ac_optarg ;;

1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
530
531
532
533
534
535
536










537
538
539
540
541
542
543







-
-
-
-
-
-
-
-
-
-







  | --program-transform-n=* | --program-transform-=* \
  | --program-transform=* | --program-transfor=* \
  | --program-transfo=* | --program-transf=* \
  | --program-trans=* | --program-tran=* \
  | --progr-tra=* | --program-tr=* | --program-t=*)
    program_transform_name=$ac_optarg ;;

  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
    ac_prev=pdfdir ;;
  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
    pdfdir=$ac_optarg ;;

  -psdir | --psdir | --psdi | --psd | --ps)
    ac_prev=psdir ;;
  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
    psdir=$ac_optarg ;;

  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil)
    silent=yes ;;

  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
    ac_prev=sbindir ;;
  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
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
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
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

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
1439

1440
1441
1442

1443
1444
1445
1446
1447



1448
1449
1450
1451
1452
1453


1454
1455
1456

1457
1458
1459

1460

1461
1462
1463





1464
1465

1466
1467
1468
1469
1470















1471













1472














1473
1474
1475
1476
1477
1478
1479
1480
1481












1482
1483
1484
1485



1486
1487
1488
1489

1490
1491
1492
1493


1494
1495

1496
1497
1498
1499

1500
1501

1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
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
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
618
619
620
621
622
623
624
625


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
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
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
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







-
+

-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-

-
+


-
+

-
-
+
+
-
-
+
+
-
-
-
+
-
-
-
-
-



















-
-
+
+
+





-
-
-
-
-
+
+
+
+
+




-
+

-
-
+
+







-
+
-
-
+
-
-
-
-
-
-


-
-
+
+
-
-
-

-
+
-

-
+
-
-
+
+

+
+
-
+
+
+
+
+

-
-
+
+
+

-













+
+











-
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
+

-
+





-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-








-
+













-
+





+
+
+


-
+

-
+









-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
+
-
-
-
-
-







-
+
+
+



-


+

+

-
+








+






-
-
-
+
+





-

-




+

-
-
-
+


-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
+


-
+

+
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+



-
+


-
-
+
+

-
+



-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
+
+




-


















-
+











-
-
+
+
-







  -v | -verbose | --verbose | --verbos | --verbo | --verb)
    verbose=yes ;;

  -version | --version | --versio | --versi | --vers | -V)
    ac_init_version=: ;;

  -with-* | --with-*)
    ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
    ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid package name: $ac_useropt"
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
    case $ac_user_opts in
    expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid package name: $ac_package" >&2
   { (exit 1); exit 1; }; }
    ac_package=`echo $ac_package| sed 's/-/_/g'`
    case $ac_option in
      *"
"with_$ac_useropt"
"*) ;;
      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
      *) ac_optarg=yes ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval with_$ac_useropt=\$ac_optarg ;;
    eval "with_$ac_package='$ac_optarg'" ;;

  -without-* | --without-*)
    ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
    ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
    # Reject names that are not valid shell variable names.
    expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
      as_fn_error $? "invalid package name: $ac_useropt"
    expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid package name: $ac_package" >&2
    ac_useropt_orig=$ac_useropt
    ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
   { (exit 1); exit 1; }; }
    ac_package=`echo $ac_package | sed 's/-/_/g'`
    case $ac_user_opts in
      *"
"with_$ac_useropt"
    eval "with_$ac_package=no" ;;
"*) ;;
      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
	 ac_unrecognized_sep=', ';;
    esac
    eval with_$ac_useropt=no ;;

  --x)
    # Obsolete; use --with-x.
    with_x=yes ;;

  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
  | --x-incl | --x-inc | --x-in | --x-i)
    ac_prev=x_includes ;;
  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
    x_includes=$ac_optarg ;;

  -x-libraries | --x-libraries | --x-librarie | --x-librari \
  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
    ac_prev=x_libraries ;;
  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
    x_libraries=$ac_optarg ;;

  -*) as_fn_error $? "unrecognized option: \`$ac_option'
Try \`$0 --help' for more information"
  -*) { echo "$as_me: error: unrecognized option: $ac_option
Try \`$0 --help' for more information." >&2
   { (exit 1); exit 1; }; }
    ;;

  *=*)
    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
    # Reject names that are not valid shell variable names.
    case $ac_envvar in #(
      '' | [0-9]* | *[!_$as_cr_alnum]* )
      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
    esac
    eval $ac_envvar=\$ac_optarg
    expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
      { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
   { (exit 1); exit 1; }; }
    ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
    eval "$ac_envvar='$ac_optarg'"
    export $ac_envvar ;;

  *)
    # FIXME: should be removed in autoconf 3.0.
    $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    echo "$as_me: WARNING: you should use --build, --host, --target" >&2
    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
      $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
      echo "$as_me: WARNING: invalid host type: $ac_option" >&2
    : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
    ;;

  esac
done

if test -n "$ac_prev"; then
  ac_option=--`echo $ac_prev | sed 's/_/-/g'`
  as_fn_error $? "missing argument to $ac_option"
  { echo "$as_me: error: missing argument to $ac_option" >&2
fi

   { (exit 1); exit 1; }; }
if test -n "$ac_unrecognized_opts"; then
  case $enable_option_checking in
    no) ;;
    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
    *)     $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
  esac
fi

# Check all directory arguments for consistency.
for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
# Be sure to have absolute paths.
for ac_var in exec_prefix prefix
		datadir sysconfdir sharedstatedir localstatedir includedir \
		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
		libdir localedir mandir
do
  eval ac_val=\$$ac_var
  eval ac_val=$`echo $ac_var`
  # Remove trailing slashes.
  case $ac_val in
    */ )
    [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
      eval $ac_var=\$ac_val;;
    *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
   { (exit 1); exit 1; }; };;
  esac
done

  # Be sure to have absolute directory names.
# Be sure to have absolute paths.
for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
	      localstatedir libdir includedir oldincludedir infodir mandir
do
  eval ac_val=$`echo $ac_var`
  case $ac_val in
    [\\/$]* | ?:[\\/]* )  continue;;
    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
    [\\/$]* | ?:[\\/]* ) ;;
    *)  { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
   { (exit 1); exit 1; }; };;
  esac
  as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done

# There might be people who depend on the old broken behavior: `$host'
# used to hold the argument of --host etc.
# FIXME: To remove some day.
build=$build_alias
host=$host_alias
target=$target_alias

# FIXME: To remove some day.
if test "x$host_alias" != x; then
  if test "x$build_alias" = x; then
    cross_compiling=maybe
    echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
    If a cross compiler is detected then cross compile mode will be used." >&2
  elif test "x$build_alias" != "x$host_alias"; then
    cross_compiling=yes
  fi
fi

ac_tool_prefix=
test -n "$host_alias" && ac_tool_prefix=$host_alias-

test "$silent" = yes && exec 6>/dev/null


ac_pwd=`pwd` && test -n "$ac_pwd" &&
ac_ls_di=`ls -di .` &&
ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
  as_fn_error $? "working directory cannot be determined"
test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
  as_fn_error $? "pwd does not report name of working directory"


# Find the source files, if location was not specified.
if test -z "$srcdir"; then
  ac_srcdir_defaulted=yes
  # Try the directory containing this script, then the parent directory.
  ac_confdir=`$as_dirname -- "$as_myself" ||
$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_myself" : 'X\(//\)[^/]' \| \
	 X"$as_myself" : 'X\(//\)$' \| \
	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_myself" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
  # Try the directory containing this script, then its parent.
  ac_confdir=`(dirname "$0") 2>/dev/null ||
$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$0" : 'X\(//\)[^/]' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X"$0" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)$/{
  	  /^X\(\/\/\)$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\(\/\).*/{
  	  /^X\(\/\).*/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  	  s/.*/./; q'`
  srcdir=$ac_confdir
  if test ! -r "$srcdir/$ac_unique_file"; then
  if test ! -r $srcdir/$ac_unique_file; then
    srcdir=..
  fi
else
  ac_srcdir_defaulted=no
fi
if test ! -r "$srcdir/$ac_unique_file"; then
  test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
  as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
fi
if test ! -r $srcdir/$ac_unique_file; then
  if test "$ac_srcdir_defaulted" = yes; then
    { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
   { (exit 1); exit 1; }; }
  else
    { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
   { (exit 1); exit 1; }; }
  fi
ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
ac_abs_confdir=`(
	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
	pwd)`
# When building in place, set srcdir=.
if test "$ac_abs_confdir" = "$ac_pwd"; then
  srcdir=.
fi
# Remove unnecessary trailing slashes from srcdir.
# Double slashes in file names in object file debugging info
# mess up M-x gdb in Emacs.
case $srcdir in
*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
esac
for ac_var in $ac_precious_vars; do
  eval ac_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_env_${ac_var}_value=\$${ac_var}
  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
  eval ac_cv_env_${ac_var}_value=\$${ac_var}
(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
  { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
   { (exit 1); exit 1; }; }
srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
ac_env_build_alias_set=${build_alias+set}
ac_env_build_alias_value=$build_alias
ac_cv_env_build_alias_set=${build_alias+set}
ac_cv_env_build_alias_value=$build_alias
ac_env_host_alias_set=${host_alias+set}
ac_env_host_alias_value=$host_alias
ac_cv_env_host_alias_set=${host_alias+set}
ac_cv_env_host_alias_value=$host_alias
ac_env_target_alias_set=${target_alias+set}
ac_env_target_alias_value=$target_alias
ac_cv_env_target_alias_set=${target_alias+set}
ac_cv_env_target_alias_value=$target_alias
ac_env_CC_set=${CC+set}
ac_env_CC_value=$CC
ac_cv_env_CC_set=${CC+set}
ac_cv_env_CC_value=$CC
ac_env_CFLAGS_set=${CFLAGS+set}
ac_env_CFLAGS_value=$CFLAGS
ac_cv_env_CFLAGS_set=${CFLAGS+set}
ac_cv_env_CFLAGS_value=$CFLAGS
ac_env_LDFLAGS_set=${LDFLAGS+set}
ac_env_LDFLAGS_value=$LDFLAGS
ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
ac_cv_env_LDFLAGS_value=$LDFLAGS
ac_env_CPPFLAGS_set=${CPPFLAGS+set}
ac_env_CPPFLAGS_value=$CPPFLAGS
ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
ac_cv_env_CPPFLAGS_value=$CPPFLAGS
ac_env_CPP_set=${CPP+set}
ac_env_CPP_value=$CPP
ac_cv_env_CPP_set=${CPP+set}
ac_cv_env_CPP_value=$CPP
done

#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures this package to adapt to many kinds of systems.
\`configure' configures tcl 8.5 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.

Configuration:
  -h, --help              display this help and exit
      --help=short        display options specific to this package
      --help=recursive    display the short help of all the included packages
  -V, --version           display version information and exit
  -q, --quiet, --silent   do not print \`checking ...' messages
  -q, --quiet, --silent   do not print \`checking...' messages
      --cache-file=FILE   cache test results in FILE [disabled]
  -C, --config-cache      alias for \`--cache-file=config.cache'
  -n, --no-create         do not create output files
      --srcdir=DIR        find the sources in DIR [configure dir or \`..']

_ACEOF

  cat <<_ACEOF
Installation directories:
  --prefix=PREFIX         install architecture-independent files in PREFIX
                          [$ac_default_prefix]
			  [$ac_default_prefix]
  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
                          [PREFIX]
			  [PREFIX]

By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify
an installation prefix other than \`$ac_default_prefix' using \`--prefix',
for instance \`--prefix=\$HOME'.

For better control, use the options below.

Fine tuning of the installation directories:
  --bindir=DIR            user executables [EPREFIX/bin]
  --sbindir=DIR           system admin executables [EPREFIX/sbin]
  --libexecdir=DIR        program executables [EPREFIX/libexec]
  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
  --libdir=DIR            object code libraries [EPREFIX/lib]
  --includedir=DIR        C header files [PREFIX/include]
  --oldincludedir=DIR     C header files for non-gcc [/usr/include]
  --bindir=DIR           user executables [EPREFIX/bin]
  --sbindir=DIR          system admin executables [EPREFIX/sbin]
  --libexecdir=DIR       program executables [EPREFIX/libexec]
  --datadir=DIR          read-only architecture-independent data [PREFIX/share]
  --sysconfdir=DIR       read-only single-machine data [PREFIX/etc]
  --sharedstatedir=DIR   modifiable architecture-independent data [PREFIX/com]
  --localstatedir=DIR    modifiable single-machine data [PREFIX/var]
  --libdir=DIR           object code libraries [EPREFIX/lib]
  --includedir=DIR       C header files [PREFIX/include]
  --oldincludedir=DIR    C header files for non-gcc [/usr/include]
  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]
  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]
  --infodir=DIR           info documentation [DATAROOTDIR/info]
  --infodir=DIR          info documentation [PREFIX/info]
  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]
  --mandir=DIR            man documentation [DATAROOTDIR/man]
  --mandir=DIR           man documentation [PREFIX/man]
  --docdir=DIR            documentation root [DATAROOTDIR/doc/PACKAGE]
  --htmldir=DIR           html documentation [DOCDIR]
  --dvidir=DIR            dvi documentation [DOCDIR]
  --pdfdir=DIR            pdf documentation [DOCDIR]
  --psdir=DIR             ps documentation [DOCDIR]
_ACEOF

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then

  case $ac_init_help in
     short | recursive ) echo "Configuration of tcl 8.5:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-threads        build with threads (default: off)
  --enable-shared         build and link with shared libraries (default: on)
  --enable-time64bit      force 64-bit time_t for 32-bit build (default: off)
  --enable-64bit          enable 64bit support (where applicable)
  --enable-zipfs          build with Zipfs support (default: on)
  --enable-wince          enable Win/CE support (where applicable)
  --enable-symbols        build with debugging symbols (default: off)
  --enable-embedded-manifest
                          embed manifest if possible (default: yes)

Optional Packages:
  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]
  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
  --with-encoding         encoding for configuration values
  --with-celib=DIR        use Windows/CE support library from DIR

Some influential environment variables:
  CC          C compiler command
  CFLAGS      C compiler flags
  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a
              nonstandard directory <lib dir>
  LIBS        libraries to pass to the linker, e.g. -l<library>
  CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
              you have headers in a nonstandard directory <include dir>
  CPPFLAGS    C/C++ preprocessor flags, e.g. -I<include dir> if you have
              headers in a nonstandard directory <include dir>
  CPP         C preprocessor

Use these variables to override the choices made by `configure' or to help
it to find libraries and programs with nonstandard names/locations.

Report bugs to the package provider.
_ACEOF
ac_status=$?
fi

if test "$ac_init_help" = "recursive"; then
  # If there are subdirs, report their specific --help.
  ac_popdir=`pwd`
  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
    test -d "$ac_dir" ||
      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
      continue
    test -d $ac_dir || continue
    ac_builddir=.

case "$ac_dir" in
if test "$ac_dir" != .; then
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
  # A "../" for each directory in $ac_dir_suffix.
  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
else
  ac_dir_suffix= ac_top_builddir=
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix
fi

case $srcdir in
  .)  # We are building in place.
  .)  # No --srcdir option.  We are building in place.
    ac_srcdir=.
    if test -z "$ac_top_builddir"; then
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
       ac_top_srcdir=.
    else
       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
    fi ;;
  [\\/]* | ?:[\\/]* )  # Absolute path.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_top_srcdir=$srcdir ;;
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
  *) # Relative path.
    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_builddir$srcdir ;;
esac

# Do not use `cd foo && pwd` to compute absolute paths, because
# the directories may not exist.
case `pwd` in
.) ac_abs_builddir="$ac_dir";;
*)
  case "$ac_dir" in
  .) ac_abs_builddir=`pwd`;;
  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
  *) ac_abs_builddir=`pwd`/"$ac_dir";;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_builddir=${ac_top_builddir}.;;
*)
  case ${ac_top_builddir}. in
  .) ac_abs_top_builddir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_srcdir=$ac_srcdir;;
*)
  case $ac_srcdir in
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
  .) ac_abs_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_srcdir=$ac_top_srcdir;;
*)
  case $ac_top_srcdir in
  .) ac_abs_top_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
  esac;;
esac

    cd "$ac_dir" || { ac_status=$?; continue; }
    # Check for guested configure.
    if test -f "$ac_srcdir/configure.gnu"; then
      echo &&
      $SHELL "$ac_srcdir/configure.gnu" --help=recursive
    elif test -f "$ac_srcdir/configure"; then
      echo &&
      $SHELL "$ac_srcdir/configure" --help=recursive
    cd $ac_dir
    # Check for guested configure; otherwise get Cygnus style configure.
    if test -f $ac_srcdir/configure.gnu; then
      echo
      $SHELL $ac_srcdir/configure.gnu  --help=recursive
    elif test -f $ac_srcdir/configure; then
      echo
      $SHELL $ac_srcdir/configure  --help=recursive
    elif test -f $ac_srcdir/configure.ac ||
	   test -f $ac_srcdir/configure.in; then
      echo
      $ac_configure --help
    else
      $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
    fi || ac_status=$?
    cd "$ac_pwd" || { ac_status=$?; break; }
      echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
    fi
    cd $ac_popdir
  done
fi

test -n "$ac_init_help" && exit $ac_status
test -n "$ac_init_help" && exit 0
if $ac_init_version; then
  cat <<\_ACEOF
configure
generated by GNU Autoconf 2.69
tcl configure 8.5
generated by GNU Autoconf 2.59

Copyright (C) 2012 Free Software Foundation, Inc.
Copyright (C) 2003 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
  exit 0
fi

exec 5>config.log
## ------------------------ ##
## Autoconf initialization. ##
## ------------------------ ##

# ac_fn_c_try_compile LINENO
# --------------------------
# Try to compile conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_compile ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  rm -f conftest.$ac_objext
  if { { ac_try="$ac_compile"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_compile") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest.$ac_objext; then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	ac_retval=1
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_compile

# ac_fn_c_try_cpp LINENO
# ----------------------
# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_cpp ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  if { { ac_try="$ac_cpp conftest.$ac_ext"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } > conftest.i && {
	 test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
	 test ! -s conftest.err
       }; then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

    ac_retval=1
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_cpp

# ac_fn_c_try_run LINENO
# ----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
# that executables *can* be run.
ac_fn_c_try_run ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
  { { case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; }; then :
  ac_retval=0
else
  $as_echo "$as_me: program exited with status $ac_status" >&5
       $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

       ac_retval=$ac_status
fi
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_run

# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists, giving a warning if it cannot be compiled using
# the include files in INCLUDES and setting the cache variable VAR
# accordingly.
ac_fn_c_check_header_mongrel ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  if eval \${$3+:} false; then :
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
else
  # Is the header compilable?
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
$as_echo_n "checking $2 usability... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
#include <$2>
_ACEOF
cat >&5 <<_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  ac_header_compiler=yes
else
  ac_header_compiler=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
$as_echo "$ac_header_compiler" >&6; }

# Is the header present?
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
$as_echo_n "checking $2 presence... " >&6; }
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <$2>
_ACEOF
if ac_fn_c_try_cpp "$LINENO"; then :
  ac_header_preproc=yes
else
  ac_header_preproc=no
fi
rm -f conftest.err conftest.i conftest.$ac_ext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
$as_echo "$ac_header_preproc" >&6; }

# So?  What about this header?
case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
  yes:no: )
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
    ;;
  no:yes:* )
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     check for missing prerequisite headers?" >&5
$as_echo "$as_me: WARNING: $2:     check for missing prerequisite headers?" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&5
$as_echo "$as_me: WARNING: $2:     section \"Present But Cannot Be Compiled\"" >&2;}
    { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
    ;;
esac
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  eval "$3=\$ac_header_compiler"
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
fi
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_header_mongrel

# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
# -------------------------------------------------------
# Tests whether HEADER exists and can be compiled using the include files in
# INCLUDES, setting the cache variable VAR accordingly.
ac_fn_c_check_header_compile ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
#include <$2>
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  eval "$3=yes"
else
  eval "$3=no"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_header_compile

# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
# -------------------------------------------
# Tests whether TYPE exists after having included INCLUDES, setting cache
# variable VAR accordingly.
ac_fn_c_check_type ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
$as_echo_n "checking for $2... " >&6; }
if eval \${$3+:} false; then :
  $as_echo_n "(cached) " >&6
else
  eval "$3=no"
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
{
if (sizeof ($2))
	 return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
$4
int
main ()
{
if (sizeof (($2)))
	    return 0;
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

else
  eval "$3=yes"
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
eval ac_res=\$$3
	       { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
$as_echo "$ac_res" >&6; }
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_type
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was
It was created by tcl $as_me 8.5, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ $0 $@

_ACEOF
exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
## Platform. ##
## --------- ##

hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`
uname -m = `(uname -m) 2>/dev/null || echo unknown`
uname -r = `(uname -r) 2>/dev/null || echo unknown`
uname -s = `(uname -s) 2>/dev/null || echo unknown`
uname -v = `(uname -v) 2>/dev/null || echo unknown`

/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`
/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`

/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`
/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`
hostinfo               = `(hostinfo) 2>/dev/null               || echo unknown`
/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`
/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`
/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`

_ASUNAME

as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    $as_echo "PATH: $as_dir"
  done
  echo "PATH: $as_dir"
done
IFS=$as_save_IFS

} >&5

cat >&5 <<_ACEOF


## ----------- ##
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
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
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







+










-
-
+
+


-
+

-
+















-
+
+
+




-
-
+
+




-
-
+
+





+
-
+

-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+

-
-
-
+
+
+

+
-
+

-
+
-
-
+


+
-
+

-
+
+



-
+
-
-
-
-
+




+
-
-
-
+
+
+
+



-
+
-
-
-
-
+





+
-
+

-
+
+

-
+



-
-
+
+

-
-
+
+

-
+

-
+




-
-
-
+
+
+






+




+




+




+





-
-
-

-

-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
+
-
-
-
-
-
+
+
+

-
+
-
-
-
-




-
-
-
-
-
+
+
+
+
+

-
-
+
+



-
-
+
+






-
+
+


-
-
+
+


-
-
+
+


-
-
+
+




-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+





+
-
+




-
+




-
-
-
-
-
+
+
+
+
+

-
-
-









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
+
+
+
+












-
-
-
-
-
-
-







# Strip out --no-create and --no-recursion so they do not pile up.
# Strip out --silent because we don't want to record it for future runs.
# Also quote any args containing shell meta-characters.
# Make two passes to allow for proper duplicate-argument suppression.
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
ac_sep=
ac_must_keep_next=false
for ac_pass in 1 2
do
  for ac_arg
  do
    case $ac_arg in
    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;
    -q | -quiet | --quiet | --quie | --qui | --qu | --q \
    | -silent | --silent | --silen | --sile | --sil)
      continue ;;
    *\'*)
      ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
    *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
      ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
    esac
    case $ac_pass in
    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
    1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
    2)
      as_fn_append ac_configure_args1 " '$ac_arg'"
      ac_configure_args1="$ac_configure_args1 '$ac_arg'"
      if test $ac_must_keep_next = true; then
	ac_must_keep_next=false # Got value, back to normal.
      else
	case $ac_arg in
	  *=* | --config-cache | -C | -disable-* | --disable-* \
	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \
	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \
	  | -with-* | --with-* | -without-* | --without-* | --x)
	    case "$ac_configure_args0 " in
	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;
	    esac
	    ;;
	  -* ) ac_must_keep_next=true ;;
	esac
      fi
      as_fn_append ac_configure_args " '$ac_arg'"
      ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
      # Get rid of the leading space.
      ac_sep=" "
      ;;
    esac
  done
done
{ ac_configure_args0=; unset ac_configure_args0;}
{ ac_configure_args1=; unset ac_configure_args1;}
$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }

# When interrupted or exit'd, cleanup temporary files, and complete
# config.log.  We remove comments because anyway the quotes in there
# would cause problems or look ugly.
# WARNING: Use '\'' to represent an apostrophe within the trap.
# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
# WARNING: Be sure not to use single quotes in there, as some shells,
# such as our DU 5.0 friend, will then `close' the trap.
trap 'exit_status=$?
  # Save into config.log some information that might help in debugging.
  {
    echo

    cat <<\_ASBOX
    $as_echo "## ---------------- ##
## ---------------- ##
## Cache variables. ##
## ---------------- ##"
## ---------------- ##
_ASBOX
    echo
    # The following way of writing the cache mishandles newlines in values,
(
  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
    eval ac_val=\$$ac_var
    case $ac_val in #(
    *${as_nl}*)
      case $ac_var in #(
      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done
{
  (set) 2>&1 |
    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
    case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
    *ac_space=\ *)
      sed -n \
	"s/'\''/'\''\\\\'\'''\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
      ;; #(
	"s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
      ;;
    *)
      sed -n \
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
      ;;
    esac |
    esac;
    sort
)
}
    echo

    cat <<\_ASBOX
    $as_echo "## ----------------- ##
## ----------------- ##
## Output variables. ##
## ----------------- ##"
## ----------------- ##
_ASBOX
    echo
    for ac_var in $ac_subst_vars
    do
      eval ac_val=\$$ac_var
      eval ac_val=$`echo $ac_var`
      case $ac_val in
      *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
      esac
      $as_echo "$ac_var='\''$ac_val'\''"
      echo "$ac_var='"'"'$ac_val'"'"'"
    done | sort
    echo

    if test -n "$ac_subst_files"; then
      cat <<\_ASBOX
      $as_echo "## ------------------- ##
## File substitutions. ##
## ------------------- ##"
## ------------- ##
## Output files. ##
## ------------- ##
_ASBOX
      echo
      for ac_var in $ac_subst_files
      do
	eval ac_val=\$$ac_var
	eval ac_val=$`echo $ac_var`
	case $ac_val in
	*\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
	esac
	$as_echo "$ac_var='\''$ac_val'\''"
	echo "$ac_var='"'"'$ac_val'"'"'"
      done | sort
      echo
    fi

    if test -s confdefs.h; then
      cat <<\_ASBOX
      $as_echo "## ----------- ##
## ----------- ##
## confdefs.h. ##
## ----------- ##"
## ----------- ##
_ASBOX
      echo
      cat confdefs.h
      sed "/^$/d" confdefs.h | sort
      echo
    fi
    test "$ac_signal" != 0 &&
      $as_echo "$as_me: caught signal $ac_signal"
    $as_echo "$as_me: exit $exit_status"
      echo "$as_me: caught signal $ac_signal"
    echo "$as_me: exit $exit_status"
  } >&5
  rm -f core *.core core.conftest.* &&
    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
  rm -f core *.core &&
  rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
    exit $exit_status
' 0
     ' 0
for ac_signal in 1 2 13 15; do
  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
  trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
done
ac_signal=0

# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -f -r conftest* confdefs.h

$as_echo "/* confdefs.h */" > confdefs.h
rm -rf conftest* confdefs.h
# AIX cpp loses on an empty file, so make sure it contains at least a newline.
echo >confdefs.h

# Predefined preprocessor variables.

cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF


cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF

cat >>confdefs.h <<_ACEOF
#define PACKAGE_URL "$PACKAGE_URL"
_ACEOF


# Let the site file select an alternate cache file if it wants to.
# Prefer an explicitly selected file to automatically selected ones.
# Prefer explicitly selected file to automatically selected ones.
ac_site_file1=NONE
ac_site_file2=NONE
if test -n "$CONFIG_SITE"; then
if test -z "$CONFIG_SITE"; then
  # We do not want a PATH search for config.site.
  case $CONFIG_SITE in #((
    -*)  ac_site_file1=./$CONFIG_SITE;;
    */*) ac_site_file1=$CONFIG_SITE;;
    *)   ac_site_file1=./$CONFIG_SITE;;
  esac
elif test "x$prefix" != xNONE; then
  ac_site_file1=$prefix/share/config.site
  if test "x$prefix" != xNONE; then
    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
  ac_site_file2=$prefix/etc/config.site
else
  ac_site_file1=$ac_default_prefix/share/config.site
  else
    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
  ac_site_file2=$ac_default_prefix/etc/config.site
fi
for ac_site_file in "$ac_site_file1" "$ac_site_file2"
  fi
fi
for ac_site_file in $CONFIG_SITE; do
do
  test "x$ac_site_file" = xNONE && continue
  if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
$as_echo "$as_me: loading site script $ac_site_file" >&6;}
  if test -r "$ac_site_file"; then
    { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
echo "$as_me: loading site script $ac_site_file" >&6;}
    sed 's/^/| /' "$ac_site_file" >&5
    . "$ac_site_file" \
    . "$ac_site_file"
      || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "failed to load site script $ac_site_file
See \`config.log' for more details" "$LINENO" 5; }
  fi
done

if test -r "$cache_file"; then
  # Some versions of bash will fail to source /dev/null (special files
  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.
  if test /dev/null != "$cache_file" && test -f "$cache_file"; then
    { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
$as_echo "$as_me: loading cache $cache_file" >&6;}
  # Some versions of bash will fail to source /dev/null (special
  # files actually), so we avoid doing that.
  if test -f "$cache_file"; then
    { echo "$as_me:$LINENO: loading cache $cache_file" >&5
echo "$as_me: loading cache $cache_file" >&6;}
    case $cache_file in
      [\\/]* | ?:[\\/]* ) . "$cache_file";;
      *)                      . "./$cache_file";;
      [\\/]* | ?:[\\/]* ) . $cache_file;;
      *)                      . ./$cache_file;;
    esac
  fi
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
$as_echo "$as_me: creating cache $cache_file" >&6;}
  { echo "$as_me:$LINENO: creating cache $cache_file" >&5
echo "$as_me: creating cache $cache_file" >&6;}
  >$cache_file
fi

# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
for ac_var in $ac_precious_vars; do
for ac_var in `(set) 2>&1 |
	       sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
  eval ac_old_set=\$ac_cv_env_${ac_var}_set
  eval ac_new_set=\$ac_env_${ac_var}_set
  eval ac_old_val=\$ac_cv_env_${ac_var}_value
  eval ac_new_val=\$ac_env_${ac_var}_value
  eval ac_old_val="\$ac_cv_env_${ac_var}_value"
  eval ac_new_val="\$ac_env_${ac_var}_value"
  case $ac_old_set,$ac_new_set in
    set,)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
      { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,set)
      { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
      { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
      ac_cache_corrupted=: ;;
    ,);;
    *)
      if test "x$ac_old_val" != "x$ac_new_val"; then
	# differences in whitespace do not lead to failure.
	ac_old_val_w=`echo x $ac_old_val`
	ac_new_val_w=`echo x $ac_new_val`
	if test "$ac_old_val_w" != "$ac_new_val_w"; then
	  { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
	{ echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
	  ac_cache_corrupted=:
	else
	  { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
	  eval $ac_var=\$ac_old_val
	fi
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5
$as_echo "$as_me:   former value:  \`$ac_old_val'" >&2;}
	{ $as_echo "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5
$as_echo "$as_me:   current value: \`$ac_new_val'" >&2;}
	{ echo "$as_me:$LINENO:   former value:  $ac_old_val" >&5
echo "$as_me:   former value:  $ac_old_val" >&2;}
	{ echo "$as_me:$LINENO:   current value: $ac_new_val" >&5
echo "$as_me:   current value: $ac_new_val" >&2;}
	ac_cache_corrupted=:
      fi;;
  esac
  # Pass precious variables to config.status.
  if test "$ac_new_set" = set; then
    case $ac_new_val in
    *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
    *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
      ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
    *) ac_arg=$ac_var=$ac_new_val ;;
    esac
    case " $ac_configure_args " in
      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.
      *) as_fn_append ac_configure_args " '$ac_arg'" ;;
      *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
    esac
  fi
done
if $ac_cache_corrupted; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
  { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
  as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
  { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
echo "$as_me: error: changes in the environment can compromise the build" >&2;}
  { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
   { (exit 1); exit 1; }; }
fi
## -------------------- ##
## Main body of script. ##
## -------------------- ##

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu






























# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a2"
TCL_VERSION=8.5
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=5
TCL_PATCH_LEVEL=".19"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

PKG_CFG_ARGS=$@

#------------------------------------------------------------------------
# Empty slate for bundled packages, to avoid stale configuration
#------------------------------------------------------------------------
rm -Rf pkgs

#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
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
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
2658





2659

2660
2661
2662



2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729




2730
2731





2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750


2751
2752
2753
2754



2755
2756
2757

2758
2759
2760
2761
2762
2763

2764
2765
2766
2767
2768
2769





2770

2771
2772
2773
2774


2775
2776
2777
2778
2779
2780




2781
2782





2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795


2796




















2797
2798



2799

2800
2801

2802
2803
2804
2805
2806
2807



2808
2809
2810
2811
2812
2813

2814
2815
2816
2817




2818
2819

2820
2821
2822
2823




2824
2825
2826
2827
2828
2829
2830
2831
2832
2833


2834
2835


2836
2837
2838
2839
2840



2841
2842
2843
2844

2845
2846
2847
2848
2849
2850

2851
2852

2853
2854
2855
2856
2857
2858










2859
2860

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
1365
1366
1367
1368
1369
1370
1371




1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384


1385
1386
1387

1388
1389
1390
1391

1392

1393
1394
1395
1396
1397


1398
1399
1400


1401
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


1439
1440
1441
1442










1443

1444
1445
1446
1447
1448


1449
1450
1451




1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464


1465
1466
1467

1468
1469
1470
1471

1472

1473
1474
1475
1476
1477


1478
1479
1480


1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525

1526
1527
1528
1529
1530
1531




1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545


1546
1547
1548
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
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




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

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
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
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
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







-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+

-






-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+


-
-
-
-
-
-
-
-
-
-
+
-





-
-
+
+

-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+

+
+
+
-
+
+




-
-
-
-
+
+
+
+










-
-
+
+





-
+



-
+
-

















-
-
+
+

-
-
+
+

-




-
+



-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+

-






-
+



-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+

-




-
-
-
-
-
-
-
-
-
-
+
-





-
-
-
-
+
+
+
+
+


+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
-

-
+
+
+
+
+











-
+



-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+



-
+
+
+
+






-
-
-
-
-
+
+
+
+
+
-
-
-
-





-
-

-
-
-
-
-
-
+


-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
-

-
+

+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
+
+

-
-
+
+







-
+

+





-
-
-
-
+
+
+
+
+

+
-
-
-
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-
+
+
+
+
+











-
-
-
-
-
-
-
-
+
+

-
-
-
+
+
+
-

-
+





-
+


-
-
-
-
+
+
+
+
+

+


-
-
+
+


-
-
-
-
+
+
+
+

-
+
+
+
+
+













+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+



-
-
-
+
+
+
-
-
-
-


+
-
-
-
-
+
+
+
+

-
+
-
-
-
-
+
+
+
+










+
+
-
-
+
+
-
-
-
-
-
+
+
+
-
-
-
-
+
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
+
+
+
+
+
-
-
-
+

-
+

-
-
-
-
-
-
-
+
+















-
-
-
-
+
+
+
+

-
+

-
+
+
+
+
+



+
-
+







ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_CC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_CC="${ac_tool_prefix}gcc"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  echo "$as_me:$LINENO: result: $CC" >&5
echo "${ECHO_T}$CC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi


fi
if test -z "$ac_cv_prog_CC"; then
  ac_ct_CC=$CC
  # Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$ac_ct_CC"; then
  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_CC="gcc"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
  echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
echo "${ECHO_T}$ac_ct_CC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi

  if test "x$ac_ct_CC" = x; then
    CC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    CC=$ac_ct_CC
  CC=$ac_ct_CC
  fi
else
  CC="$ac_cv_prog_CC"
fi

if test -z "$CC"; then
          if test -n "$ac_tool_prefix"; then
    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
  if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_CC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_CC="${ac_tool_prefix}cc"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  echo "$as_me:$LINENO: result: $CC" >&5
echo "${ECHO_T}$CC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi

fi
if test -z "$ac_cv_prog_CC"; then
  ac_ct_CC=$CC
  # Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$ac_ct_CC"; then
  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_CC="cc"
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
done

fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
  echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
echo "${ECHO_T}$ac_ct_CC" >&6
else
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi

  CC=$ac_ct_CC
else
  CC="$ac_cv_prog_CC"
  fi
fi

fi
if test -z "$CC"; then
  # Extract the first word of "cc", so it can be a program name with args.
set dummy cc; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_CC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
  ac_prog_rejected=no
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
       ac_prog_rejected=yes
       continue
     fi
    ac_cv_prog_CC="cc"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

if test $ac_prog_rejected = yes; then
  # We found a bogon in the path, so make sure we never use it.
  set dummy $ac_cv_prog_CC
  shift
  if test $# != 0; then
    # We chose a different compiler from the bogus one.
    # However, it has the same basename, so the bogon will be chosen
    # first if we set CC to just the basename; use the full file name.
    shift
    ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@"
  fi
fi
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  echo "$as_me:$LINENO: result: $CC" >&5
echo "${ECHO_T}$CC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi


fi
if test -z "$CC"; then
  if test -n "$ac_tool_prefix"; then
  for ac_prog in cl.exe
  for ac_prog in cl
  do
    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_CC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$CC"; then
  ac_cv_prog_CC="$CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
$as_echo "$CC" >&6; }
  echo "$as_me:$LINENO: result: $CC" >&5
echo "${ECHO_T}$CC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi


    test -n "$CC" && break
  done
fi
if test -z "$CC"; then
  ac_ct_CC=$CC
  for ac_prog in cl.exe
  for ac_prog in cl
do
  # Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_CC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$ac_ct_CC"; then
  ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_CC="$ac_prog"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
$as_echo "$ac_ct_CC" >&6; }
  echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
echo "${ECHO_T}$ac_ct_CC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi


  test -n "$ac_ct_CC" && break
done

  if test "x$ac_ct_CC" = x; then
    CC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    CC=$ac_ct_CC
  CC=$ac_ct_CC
  fi
fi

fi


test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "no acceptable C compiler found in \$PATH
See \`config.log' for more details" "$LINENO" 5; }
test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
See \`config.log' for more details." >&5
echo "$as_me: error: no acceptable C compiler found in \$PATH
See \`config.log' for more details." >&2;}
   { (exit 1); exit 1; }; }

# Provide some information about the compiler.
echo "$as_me:$LINENO:" \
$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
set X $ac_compile
ac_compiler=$2
     "checking for C compiler version" >&5
ac_compiler=`set X $ac_compile; echo $2`
{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
for ac_option in --version -v -V -qversion; do
  { { ac_try="$ac_compiler $ac_option >&5"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_compiler $ac_option >&5") 2>conftest.err
  (eval $ac_compiler --version </dev/null >&5) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }
{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
  (eval $ac_compiler -v </dev/null >&5) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }
{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
  (eval $ac_compiler -V </dev/null >&5) 2>&5
  ac_status=$?
  if test -s conftest.err; then
    sed '10a\
... rest of stderr output deleted ...
         10q' conftest.err >conftest.er1
    cat conftest.er1 >&5
  fi
  rm -f conftest.er1 conftest.err
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }
done

cat confdefs.h - <<_ACEOF >conftest.$ac_ext
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
ac_clean_files="$ac_clean_files a.out a.exe b.out"
# Try to create an executable without -o first, disregard a.out.
# It will help us diagnose broken compilers, and finding out an intuition
# of exeext.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
$as_echo_n "checking whether the C compiler works... " >&6; }
ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`

echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
# The possible output files:
ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"

ac_rmfiles=
for ac_file in $ac_files
do
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
    * ) ac_rmfiles="$ac_rmfiles $ac_file";;
  esac
done
rm -f $ac_rmfiles

if { { ac_try="$ac_link_default"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link_default") 2>&5
  (eval $ac_link_default) 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; then :
  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
# in a Makefile.  We should not override ac_cv_exeext if it was cached,
# so that the user can short-circuit this test for compilers unknown to
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; then
  # Find the output, starting from the most likely.  This scheme is
# not robust to junk in `.', hence go to wildcards (a.*) only as a last
# resort.

# Be careful to initialize this variable, since it used to be cached.
# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
ac_cv_exeext=
# b.out is created by i960 compilers.
# Autoconf.
for ac_file in $ac_files ''
for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
do
  test -f "$ac_file" || continue
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
	;;
    conftest.$ac_ext )
	# This is the source file.
	;;
    [ab].out )
	# We found the default executable, but exeext='' is most
	# certainly right.
	break;;
    *.* )
	if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
	then :; else
	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
	fi
	# We set ac_cv_exeext here because the later test for it is not
	ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
	# FIXME: I believe we export ac_cv_exeext for Libtool,
	# but it would be cool to find out if it's true.  Does anybody
	# maintain Libtool? --akim.
	export ac_cv_exeext
	# safe: cross compilers may not add the suffix if given an `-o'
	# argument, so we may need to know it at that point already.
	# Even if this section looks crufty: it has the advantage of
	# actually working.
	break;;
    * )
	break;;
  esac
done
test "$ac_cv_exeext" = no && ac_cv_exeext=

else
  ac_file=''
fi
if test -z "$ac_file"; then :
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
$as_echo "$as_me: failed program was:" >&5
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error 77 "C compiler cannot create executables
See \`config.log' for more details" "$LINENO" 5; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
fi
{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
See \`config.log' for more details." >&5
echo "$as_me: error: C compiler cannot create executables
See \`config.log' for more details." >&2;}
   { (exit 77); exit 77; }; }
fi

ac_exeext=$ac_cv_exeext
echo "$as_me:$LINENO: result: $ac_file" >&5
echo "${ECHO_T}$ac_file" >&6

# Check the compiler produces executables we can run.  If not, either
# the compiler is broken, or we cross compile.
echo "$as_me:$LINENO: checking whether the C compiler works" >&5
echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
# If not cross compiling, check that we can run a simple program.
if test "$cross_compiling" != yes; then
  if { ac_try='./$ac_file'
  { (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
    cross_compiling=no
  else
    if test "$cross_compiling" = maybe; then
	cross_compiling=yes
    else
	{ { echo "$as_me:$LINENO: error: cannot run C compiled programs.
If you meant to cross compile, use \`--host'.
See \`config.log' for more details." >&5
echo "$as_me: error: cannot run C compiled programs.
If you meant to cross compile, use \`--host'.
See \`config.log' for more details." >&2;}
   { (exit 1); exit 1; }; }
    fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
$as_echo_n "checking for C compiler default output file name... " >&6; }
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
$as_echo "$ac_file" >&6; }
  fi
fi
echo "$as_me:$LINENO: result: yes" >&5
echo "${ECHO_T}yes" >&6
ac_exeext=$ac_cv_exeext

rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
rm -f a.out a.exe conftest$ac_cv_exeext b.out
ac_clean_files=$ac_clean_files_save
# Check the compiler produces executables we can run.  If not, either
# the compiler is broken, or we cross compile.
echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
echo "$as_me:$LINENO: result: $cross_compiling" >&5
echo "${ECHO_T}$cross_compiling" >&6

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
$as_echo_n "checking for suffix of executables... " >&6; }
echo "$as_me:$LINENO: checking for suffix of executables" >&5
echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
  (eval $ac_link) 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; then :
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; then
  # If both `conftest.exe' and `conftest' are `present' (well, observable)
# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will
# work properly (i.e., refer to `conftest.exe'), while it won't with
# `rm'.
for ac_file in conftest.exe conftest conftest.*; do
  test -f "$ac_file" || continue
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
	  export ac_cv_exeext
	  break;;
    * ) break;;
  esac
done
else
  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot compute suffix of executables: cannot compile and link
See \`config.log' for more details" "$LINENO" 5; }
  { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
See \`config.log' for more details." >&5
echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
See \`config.log' for more details." >&2;}
   { (exit 1); exit 1; }; }
fi

rm -f conftest conftest$ac_cv_exeext
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
$as_echo "$ac_cv_exeext" >&6; }
rm -f conftest$ac_cv_exeext
echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
echo "${ECHO_T}$ac_cv_exeext" >&6

rm -f conftest.$ac_ext
EXEEXT=$ac_cv_exeext
ac_exeext=$EXEEXT
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */
#include <stdio.h>
int
main ()
{
FILE *f = fopen ("conftest.out", "w");
 return ferror (f) || fclose (f) != 0;

  ;
  return 0;
}
_ACEOF
ac_clean_files="$ac_clean_files conftest.out"
# Check that the compiler produces executables we can run.  If not, either
# the compiler is broken, or we cross compile.
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
$as_echo_n "checking whether we are cross compiling... " >&6; }
if test "$cross_compiling" != yes; then
  { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }
  if { ac_try='./conftest$ac_cv_exeext'
  { { case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_try") 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; }; then
    cross_compiling=no
  else
    if test "$cross_compiling" = maybe; then
	cross_compiling=yes
    else
	{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot run C compiled programs.
If you meant to cross compile, use \`--host'.
See \`config.log' for more details" "$LINENO" 5; }
    fi
  fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
$as_echo "$cross_compiling" >&6; }

rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
ac_clean_files=$ac_clean_files_save
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
$as_echo_n "checking for suffix of object files... " >&6; }
if ${ac_cv_objext+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for suffix of object files" >&5
echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
if test "${ac_cv_objext+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.o conftest.obj
if { { ac_try="$ac_compile"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_compile") 2>&5
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; then :
  for ac_file in conftest.o conftest.obj conftest.*; do
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; then
  for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
  test -f "$ac_file" || continue;
  case $ac_file in
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
       break;;
  esac
done
else
  $as_echo "$as_me: failed program was:" >&5
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "cannot compute suffix of object files: cannot compile
See \`config.log' for more details" "$LINENO" 5; }
{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
See \`config.log' for more details." >&5
echo "$as_me: error: cannot compute suffix of object files: cannot compile
See \`config.log' for more details." >&2;}
   { (exit 1); exit 1; }; }
fi

rm -f conftest.$ac_cv_objext conftest.$ac_ext
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
$as_echo "$ac_cv_objext" >&6; }
echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
echo "${ECHO_T}$ac_cv_objext" >&6
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
if ${ac_cv_c_compiler_gnu+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
if test "${ac_cv_c_compiler_gnu+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

int
main ()
{
#ifndef __GNUC__
       choke me
#endif

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
if ac_fn_c_try_compile "$LINENO"; then :
  (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_compiler_gnu=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  ac_compiler_gnu=no
ac_compiler_gnu=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
$as_echo "$ac_cv_c_compiler_gnu" >&6; }
if test $ac_compiler_gnu = yes; then
echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
GCC=`test $ac_compiler_gnu = yes && echo yes`
  GCC=yes
else
  GCC=
fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
CFLAGS="-g"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
$as_echo_n "checking whether $CC accepts -g... " >&6; }
if ${ac_cv_prog_cc_g+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
if test "${ac_cv_prog_cc_g+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  ac_save_c_werror_flag=$ac_c_werror_flag
  cat >conftest.$ac_ext <<_ACEOF
   ac_c_werror_flag=yes
   ac_cv_prog_cc_g=no
   CFLAGS="-g"
   cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
if ac_fn_c_try_compile "$LINENO"; then :
  ac_cv_prog_cc_g=yes
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
else
  CFLAGS=""
      cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
int
main ()
{

  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :

  (exit $ac_status); } &&
else
  ac_c_werror_flag=$ac_save_c_werror_flag
	 { ac_try='test -z "$ac_c_werror_flag"
	 CFLAGS="-g"
	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

int
main ()
			 || 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
  ;
  return 0;
}
  (exit $ac_status); }; }; then
  ac_cv_prog_cc_g=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  ac_cv_prog_cc_g=yes
ac_cv_prog_cc_g=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
   ac_c_werror_flag=$ac_save_c_werror_flag
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
$as_echo "$ac_cv_prog_cc_g" >&6; }
echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
if test "$ac_test_CFLAGS" = set; then
  CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
  if test "$GCC" = yes; then
    CFLAGS="-g -O2"
  else
    CFLAGS="-g"
  fi
else
  if test "$GCC" = yes; then
    CFLAGS="-O2"
  else
    CFLAGS=
  fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
if ${ac_cv_prog_cc_c89+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
if test "${ac_cv_prog_cc_stdc+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  ac_cv_prog_cc_c89=no
  ac_cv_prog_cc_stdc=no
ac_save_CC=$CC
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <stdarg.h>
#include <stdio.h>
#include <sys/types.h>
struct stat;
#include <sys/stat.h>
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
static char *e (p, i)
     char **p;
     int i;
{
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
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







-
+


-
+


-
-
-
-
-














+
+
-
-
+
+
+
+
+
+


+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-

-
+



-
-
+
+
-
-
-
-
-
-
+
+
+

+
+
-
+
-
-

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
+
+
+
+



-
+
+
+
+
+








+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-



-
-
+
+
+







  va_end (v);
  return s;
}

/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has
   function prototypes and stuff, but not '\xHH' hex character constants.
   These don't provoke an error unfortunately, instead are silently treated
   as 'x'.  The following induces an error, until -std is added to get
   as 'x'.  The following induces an error, until -std1 is added to get
   proper ANSI mode.  Curiously '\x00'!='x' always comes out true, for an
   array size at least.  It's necessary to write '\x00'==0 to get something
   that's true only with -std.  */
   that's true only with -std1.  */
int osf4_cc_array ['\x00' == 0 ? 1 : -1];

/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
   inside strings and character constants.  */
#define FOO(x) 'x'
int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];

int test (int i, double x);
struct s1 {int (*f) (int a);};
struct s2 {int (*f) (double a);};
int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
int argc;
char **argv;
int
main ()
{
return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
  ;
  return 0;
}
_ACEOF
# Don't try gcc -ansi; that turns off useful extensions and
# breaks some systems' header files.
for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
	-Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
# AIX			-qlanglvl=ansi
# Ultrix and OSF/1	-std1
# HP-UX 10.20 and later	-Ae
# HP-UX older versions	-Aa -D_HPUX_SOURCE
# SVR4			-Xc -D__EXTENSIONS__
for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
  CC="$ac_save_CC $ac_arg"
  rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  if ac_fn_c_try_compile "$LINENO"; then :
  ac_cv_prog_cc_c89=$ac_arg
  (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_prog_cc_stdc=$ac_arg
break
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

fi
rm -f core conftest.err conftest.$ac_objext
rm -f conftest.err conftest.$ac_objext
  test "x$ac_cv_prog_cc_c89" != "xno" && break
done
rm -f conftest.$ac_ext
rm -f conftest.$ac_ext conftest.$ac_objext
CC=$ac_save_CC

fi
# AC_CACHE_VAL
case "x$ac_cv_prog_cc_c89" in

case "x$ac_cv_prog_cc_stdc" in
  x)
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
$as_echo "none needed" >&6; } ;;
  xno)
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
$as_echo "unsupported" >&6; } ;;
  x|xno)
    echo "$as_me:$LINENO: result: none needed" >&5
echo "${ECHO_T}none needed" >&6 ;;
  *)
    echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
    CC="$CC $ac_cv_prog_cc_c89"
    CC="$CC $ac_cv_prog_cc_stdc" ;;
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
if test "x$ac_cv_prog_cc_c89" != xno; then :


# Some people use a C++ compiler to compile C.  Since we use `exit',
# in C++ we need to declare it.  In case someone uses the same compiler
# for both compiling C and C++ we need to have the C++ compiler decide
# the declaration of exit, since it's the most demanding environment.
cat >conftest.$ac_ext <<_ACEOF
#ifndef __cplusplus
  choke me
#endif
_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
  for ac_declaration in \
   '' \
   'extern "C" void std::exit (int) throw (); using std::exit;' \
   'extern "C" void std::exit (int); using std::exit;' \
   'extern "C" void exit (int) throw ();' \
   'extern "C" void exit (int);' \
   'void exit (int);'
do
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
$ac_declaration
#include <stdlib.h>
int
main ()
{
exit (42);
  ;
  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
  :
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

continue
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
$ac_declaration
int
main ()

{
exit (42);
  ;
  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
  break
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
done
rm -f conftest*
if test -n "$ac_declaration"; then
  echo '#ifdef __cplusplus' >>confdefs.h
  echo $ac_declaration      >>confdefs.h
  echo '#endif'             >>confdefs.h
fi

else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5
$as_echo_n "checking for inline... " >&6; }
if ${ac_cv_c_inline+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for inline" >&5
echo $ECHO_N "checking for inline... $ECHO_C" >&6
if test "${ac_cv_c_inline+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  ac_cv_c_inline=no
for ac_kw in inline __inline__ __inline; do
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#ifndef __cplusplus
typedef int foo_t;
static $ac_kw foo_t static_foo () {return 0; }
$ac_kw foo_t foo () {return 0; }
#endif

_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
if ac_fn_c_try_compile "$LINENO"; then :
  ac_cv_c_inline=$ac_kw
  (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_c_inline=$ac_kw; break
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
  test "$ac_cv_c_inline" != no && break
done

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5
$as_echo "$ac_cv_c_inline" >&6; }
echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5
echo "${ECHO_T}$ac_cv_c_inline" >&6


case $ac_cv_c_inline in
  inline | yes) ;;
  *)
    case $ac_cv_c_inline in
      no) ac_val=;;
      *) ac_val=$ac_cv_c_inline;;
3029
3030
3031
3032
3033
3034
3035
3036
3037


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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666

2667
2668

2669
2670
2671
2672

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
2709
2710
2711
2712
2713
2714

2715
2716
2717

2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729







-
-
+
+





-
-
+
+













-
+
+
+
+
+








+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+

+
+
+



-
+

-
+

-
+
+
+
+
+



+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+



+
+
+




-
+



-
-
+
+











-
-
+
+









-
+
+
+
+
+








+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+

+
+
+



-
+

-
+

-
+
+
+
+
+



+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+



+
+
+




-
+



-
-
-
+
+
+

-
-
-
-
+
+
+
+
+









-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-

-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-
+
+
+
+
+














+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+



-
+
+
+
+
+





-
-
+
+









-
+
+
+
+
+





-
-
+
+









-
+


-
+
+
+
+
+







esac

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
$as_echo_n "checking how to run the C preprocessor... " >&6; }
echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
  CPP=
fi
if test -z "$CPP"; then
  if ${ac_cv_prog_CPP+:} false; then :
  $as_echo_n "(cached) " >&6
  if test "${ac_cv_prog_CPP+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
      # Double quotes because CPP needs to be expanded
    for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
    do
      ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
  # Use a header file that comes with gcc, so configuring glibc
  # with a fresh cross-compiler works.
  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
  # <limits.h> exists even on freestanding compilers.
  # On the NeXT, cc -E runs the code through the compiler's parser,
  # not just through cpp. "Syntax error" is here to catch this case.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
  (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
if ac_fn_c_try_cpp "$LINENO"; then :

  if test -s conftest.err; then
    ac_cpp_err=$ac_c_preproc_warn_flag
    ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
  else
    ac_cpp_err=
  fi
else
  ac_cpp_err=yes
fi
if test -z "$ac_cpp_err"; then
  :
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  # Broken: fails on valid input.
continue
fi
rm -f conftest.err conftest.i conftest.$ac_ext
rm -f conftest.err conftest.$ac_ext

  # OK, works on sane cases.  Now check whether nonexistent headers
  # OK, works on sane cases.  Now check whether non-existent headers
  # can be detected and how.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <ac_nonexistent.h>
_ACEOF
if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
  (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
if ac_fn_c_try_cpp "$LINENO"; then :
  if test -s conftest.err; then
    ac_cpp_err=$ac_c_preproc_warn_flag
    ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
  else
    ac_cpp_err=
  fi
else
  ac_cpp_err=yes
fi
if test -z "$ac_cpp_err"; then
  # Broken: success on invalid input.
continue
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  # Passes both tests.
ac_preproc_ok=:
break
fi
rm -f conftest.err conftest.i conftest.$ac_ext
rm -f conftest.err conftest.$ac_ext

done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
rm -f conftest.i conftest.err conftest.$ac_ext
if $ac_preproc_ok; then :
rm -f conftest.err conftest.$ac_ext
if $ac_preproc_ok; then
  break
fi

    done
    ac_cv_prog_CPP=$CPP

fi
  CPP=$ac_cv_prog_CPP
else
  ac_cv_prog_CPP=$CPP
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
$as_echo "$CPP" >&6; }
echo "$as_me:$LINENO: result: $CPP" >&5
echo "${ECHO_T}$CPP" >&6
ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
  # Use a header file that comes with gcc, so configuring glibc
  # with a fresh cross-compiler works.
  # Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
  # <limits.h> exists even on freestanding compilers.
  # On the NeXT, cc -E runs the code through the compiler's parser,
  # not just through cpp. "Syntax error" is here to catch this case.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#ifdef __STDC__
# include <limits.h>
#else
# include <assert.h>
#endif
		     Syntax error
_ACEOF
if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
  (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
if ac_fn_c_try_cpp "$LINENO"; then :

  if test -s conftest.err; then
    ac_cpp_err=$ac_c_preproc_warn_flag
    ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
  else
    ac_cpp_err=
  fi
else
  ac_cpp_err=yes
fi
if test -z "$ac_cpp_err"; then
  :
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  # Broken: fails on valid input.
continue
fi
rm -f conftest.err conftest.i conftest.$ac_ext
rm -f conftest.err conftest.$ac_ext

  # OK, works on sane cases.  Now check whether nonexistent headers
  # OK, works on sane cases.  Now check whether non-existent headers
  # can be detected and how.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <ac_nonexistent.h>
_ACEOF
if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
  (eval $ac_cpp conftest.$ac_ext) 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); } >/dev/null; then
if ac_fn_c_try_cpp "$LINENO"; then :
  if test -s conftest.err; then
    ac_cpp_err=$ac_c_preproc_warn_flag
    ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
  else
    ac_cpp_err=
  fi
else
  ac_cpp_err=yes
fi
if test -z "$ac_cpp_err"; then
  # Broken: success on invalid input.
continue
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  # Passes both tests.
ac_preproc_ok=:
break
fi
rm -f conftest.err conftest.i conftest.$ac_ext
rm -f conftest.err conftest.$ac_ext

done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
rm -f conftest.i conftest.err conftest.$ac_ext
if $ac_preproc_ok; then :

rm -f conftest.err conftest.$ac_ext
if $ac_preproc_ok; then
  :
else
  { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
See \`config.log' for more details" "$LINENO" 5; }
  { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
See \`config.log' for more details." >&5
echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
See \`config.log' for more details." >&2;}
   { (exit 1); exit 1; }; }
fi

ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
if ${ac_cv_path_GREP+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for egrep" >&5
echo $ECHO_N "checking for egrep... $ECHO_C" >&6
if test "${ac_cv_prog_egrep+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -z "$GREP"; then
  ac_path_GREP_found=false
  # Loop through the user's path and test for each of PROGNAME-LIST
  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_prog in grep ggrep; do
    for ac_exec_ext in '' $ac_executable_extensions; do
      ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
      as_fn_executable_p "$ac_path_GREP" || continue
# Check for GNU ac_path_GREP and select it if it is found.
  # Check for GNU $ac_path_GREP
case `"$ac_path_GREP" --version 2>&1` in
*GNU*)
  ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
*)
  ac_count=0
  $as_echo_n 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    $as_echo 'GREP' >> "conftest.nl"
    "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
  if echo a | (grep -E '(a|b)') >/dev/null 2>&1
    as_fn_arith $ac_count + 1 && ac_count=$as_val
    if test $ac_count -gt ${ac_path_GREP_max-0}; then
      # Best one so far, save it but keep looking for a better one
      ac_cv_path_GREP="$ac_path_GREP"
    then ac_cv_prog_egrep='grep -E'
      ac_path_GREP_max=$ac_count
    fi
    # 10*(2^10) chars as input seems more than enough
    test $ac_count -gt 10 && break
  done
  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac

    else ac_cv_prog_egrep='egrep'
      $ac_path_GREP_found && break 3
    done
  done
  done
IFS=$as_save_IFS
  if test -z "$ac_cv_path_GREP"; then
    as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
  fi
    fi
else
  ac_cv_path_GREP=$GREP
fi

echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
$as_echo "$ac_cv_path_GREP" >&6; }
 GREP="$ac_cv_path_GREP"


echo "${ECHO_T}$ac_cv_prog_egrep" >&6
 EGREP=$ac_cv_prog_egrep
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
$as_echo_n "checking for egrep... " >&6; }
if ${ac_cv_path_EGREP+:} false; then :
  $as_echo_n "(cached) " >&6
else
  if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
   then ac_cv_path_EGREP="$GREP -E"
   else
     if test -z "$EGREP"; then
  ac_path_EGREP_found=false
  # Loop through the user's path and test for each of PROGNAME-LIST
  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_prog in egrep; do
    for ac_exec_ext in '' $ac_executable_extensions; do
      ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
      as_fn_executable_p "$ac_path_EGREP" || continue
# Check for GNU ac_path_EGREP and select it if it is found.
  # Check for GNU $ac_path_EGREP
case `"$ac_path_EGREP" --version 2>&1` in
*GNU*)
  ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
*)
  ac_count=0
  $as_echo_n 0123456789 >"conftest.in"
  while :
  do
    cat "conftest.in" "conftest.in" >"conftest.tmp"
    mv "conftest.tmp" "conftest.in"
    cp "conftest.in" "conftest.nl"
    $as_echo 'EGREP' >> "conftest.nl"
    "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
    diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
    as_fn_arith $ac_count + 1 && ac_count=$as_val
    if test $ac_count -gt ${ac_path_EGREP_max-0}; then
      # Best one so far, save it but keep looking for a better one
      ac_cv_path_EGREP="$ac_path_EGREP"
      ac_path_EGREP_max=$ac_count
    fi
    # 10*(2^10) chars as input seems more than enough
    test $ac_count -gt 10 && break
  done
  rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
esac

      $ac_path_EGREP_found && break 3
    done
  done
  done
IFS=$as_save_IFS
  if test -z "$ac_cv_path_EGREP"; then
    as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
  fi
else
  ac_cv_path_EGREP=$EGREP
fi

   fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
$as_echo "$ac_cv_path_EGREP" >&6; }
 EGREP="$ac_cv_path_EGREP"


{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
$as_echo_n "checking for ANSI C header files... " >&6; }
if ${ac_cv_header_stdc+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for ANSI C header files" >&5
echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
if test "${ac_cv_header_stdc+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <float.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
if ac_fn_c_try_compile "$LINENO"; then :
  (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_header_stdc=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  ac_cv_header_stdc=no
ac_cv_header_stdc=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

if test $ac_cv_header_stdc = yes; then
  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <string.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "memchr" >/dev/null 2>&1; then :

  $EGREP "memchr" >/dev/null 2>&1; then
  :
else
  ac_cv_header_stdc=no
fi
rm -f conftest*

fi

if test $ac_cv_header_stdc = yes; then
  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <stdlib.h>

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "free" >/dev/null 2>&1; then :

  $EGREP "free" >/dev/null 2>&1; then
  :
else
  ac_cv_header_stdc=no
fi
rm -f conftest*

fi

if test $ac_cv_header_stdc = yes; then
  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
  if test "$cross_compiling" = yes; then :
  if test "$cross_compiling" = yes; then
  :
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
#include <ctype.h>
#include <stdlib.h>
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
#else
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
3775
3776






3777
3778
3779
3780


3781
3782
3783
3784


3785
3786

3787


3788
3789
3790
3791


















3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824






3825
3826
3827



3828

3829
3830















3831










3832
3833
3834

3835


3836
3837
3838
3839
3840
3841
3842
3843




3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854


3855
3856

3857
3858
3859
3860

3861
3862
3863
3864
3865
3866
3867
3868
3869


3870
3871
3872
3873
3874
3875


3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896

3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925




3926
3927





3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941


3942




















3943
3944



3945

3946
3947

3948
3949
3950
3951


3952
3953
3954
3955
3956

3957
3958
3959
3960
3961
3962
3963

3964
3965
3966
3967
3968
3969
3970
2738
2739
2740
2741
2742
2743
2744


2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755


2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766

2767
2768

2769

2770

2771
2772


2773
2774
2775
2776
2777

2778
2779
2780
2781
2782
2783
2784
2785
2786




2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799


2800
2801
2802

2803
2804
2805
2806

2807

2808
2809
2810
2811
2812


2813
2814
2815


2816
2817
2818

2819
2820
2821
2822
2823
2824




2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837


2838
2839
2840

2841
2842
2843
2844

2845

2846
2847
2848
2849
2850


2851
2852
2853


2854
2855
2856
2857










2858

2859
2860
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
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







-
-
+
+


+
+
+
+
+
+
+
-
-
+
+
+
+
+

+
+
+
+
+
-
+

-
+
-

-


-
-
+
+


+
-
+
+







-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+

-






-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+


-
-
-
-
-
-
-
-
-
-
+
-







-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+

-






-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+


-
-
-
-
-
-
-
-
-
-
+
-







-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+

-






-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-





-
-
+
+

-
-
+
+


-
-
-
-
-
-
-
-
-
-
+
-









-
-
+
+

-
-
-
+
+
+
















-
-
+
+


-
-
+
+










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
-
-
-
+
+
+
+
+
-







+
+
-
+
+










-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-

-
-
+
+


-
-
+
+


+
-
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-





-
-
-
-
-
+
+
+
+
+
+


-
+
+
+

+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+



+
-
+
+




-
-
-
-
+
+
+
+









-
-
+
+

-
+



-
+
-






-
-
+
+

-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
-
-
+
+
+
+

-
+
+
+
+
+














+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+


-
-
+
+




-
+






-
+







int
main ()
{
  int i;
  for (i = 0; i < 256; i++)
    if (XOR (islower (i), ISLOWER (i))
	|| toupper (i) != TOUPPER (i))
      return 2;
  return 0;
      exit(2);
  exit (0);
}
_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
if ac_fn_c_try_run "$LINENO"; then :

  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  :
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 )
  ac_cv_header_stdc=no
ac_cv_header_stdc=no
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi

fi
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
$as_echo "$ac_cv_header_stdc" >&6; }
echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
echo "${ECHO_T}$ac_cv_header_stdc" >&6
if test $ac_cv_header_stdc = yes; then

cat >>confdefs.h <<\_ACEOF
$as_echo "#define STDC_HEADERS 1" >>confdefs.h
#define STDC_HEADERS 1
_ACEOF

fi


if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
set dummy ${ac_tool_prefix}ar; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_AR+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_AR+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$AR"; then
  ac_cv_prog_AR="$AR" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_AR="${ac_tool_prefix}ar"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
AR=$ac_cv_prog_AR
if test -n "$AR"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
$as_echo "$AR" >&6; }
  echo "$as_me:$LINENO: result: $AR" >&5
echo "${ECHO_T}$AR" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi


fi
if test -z "$ac_cv_prog_AR"; then
  ac_ct_AR=$AR
  # Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_AR+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_ac_ct_AR+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$ac_ct_AR"; then
  ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_AR="ar"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
ac_ct_AR=$ac_cv_prog_ac_ct_AR
if test -n "$ac_ct_AR"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
$as_echo "$ac_ct_AR" >&6; }
  echo "$as_me:$LINENO: result: $ac_ct_AR" >&5
echo "${ECHO_T}$ac_ct_AR" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi

  if test "x$ac_ct_AR" = x; then
    AR=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    AR=$ac_ct_AR
  AR=$ac_ct_AR
  fi
else
  AR="$ac_cv_prog_AR"
fi

if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ac_tool_prefix}ranlib; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_RANLIB+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_RANLIB+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$RANLIB"; then
  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
RANLIB=$ac_cv_prog_RANLIB
if test -n "$RANLIB"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
$as_echo "$RANLIB" >&6; }
  echo "$as_me:$LINENO: result: $RANLIB" >&5
echo "${ECHO_T}$RANLIB" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi


fi
if test -z "$ac_cv_prog_RANLIB"; then
  ac_ct_RANLIB=$RANLIB
  # Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$ac_ct_RANLIB"; then
  ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_RANLIB="ranlib"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
if test -n "$ac_ct_RANLIB"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
$as_echo "$ac_ct_RANLIB" >&6; }
  echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
echo "${ECHO_T}$ac_ct_RANLIB" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi

  if test "x$ac_ct_RANLIB" = x; then
    RANLIB=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    RANLIB=$ac_ct_RANLIB
  RANLIB=$ac_ct_RANLIB
  fi
else
  RANLIB="$ac_cv_prog_RANLIB"
fi

if test -n "$ac_tool_prefix"; then
  # Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
set dummy ${ac_tool_prefix}windres; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_RC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_RC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$RC"; then
  ac_cv_prog_RC="$RC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_RC="${ac_tool_prefix}windres"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
RC=$ac_cv_prog_RC
if test -n "$RC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5
$as_echo "$RC" >&6; }
  echo "$as_me:$LINENO: result: $RC" >&5
echo "${ECHO_T}$RC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi


fi
if test -z "$ac_cv_prog_RC"; then
  ac_ct_RC=$RC
  # Extract the first word of "windres", so it can be a program name with args.
set dummy windres; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_ac_ct_RC+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_ac_ct_RC+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$ac_ct_RC"; then
  ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_ac_ct_RC="windres"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

fi
fi
ac_ct_RC=$ac_cv_prog_ac_ct_RC
if test -n "$ac_ct_RC"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5
$as_echo "$ac_ct_RC" >&6; }
  echo "$as_me:$LINENO: result: $ac_ct_RC" >&5
echo "${ECHO_T}$ac_ct_RC" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi

  if test "x$ac_ct_RC" = x; then
    RC=""
  else
    case $cross_compiling:$ac_tool_warned in
yes:)
{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
ac_tool_warned=yes ;;
esac
    RC=$ac_ct_RC
  RC=$ac_ct_RC
  fi
else
  RC="$ac_cv_prog_RC"
fi


#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
#--------------------------------------------------------------------

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5
echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6
set x ${MAKE-make}
ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then :
  $as_echo_n "(cached) " >&6
ac_make=`echo "" | sed 'y,:./+-,___p_,'`
if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.make <<\_ACEOF
SHELL = /bin/sh
all:
	@echo '@@@%%%=$(MAKE)=@@@%%%'
_ACEOF
# GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
case `${MAKE-make} -f conftest.make 2>/dev/null` in
  *@@@%%%=?*=@@@%%%*)
    eval ac_cv_prog_make_${ac_make}_set=yes;;
  *)
    eval ac_cv_prog_make_${ac_make}_set=no;;
esac
rm -f conftest.make
fi
if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
  echo "$as_me:$LINENO: result: yes" >&5
echo "${ECHO_T}yes" >&6
  SET_MAKE=
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  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.)
#--------------------------------------------------------------------




#--------------------------------------------------------------------
# Check whether --enable-threads or --disable-threads was given.
#--------------------------------------------------------------------


    echo "$as_me:$LINENO: checking for building with threads" >&5
echo $ECHO_N "checking for building with threads... $ECHO_C" >&6
    # Check whether --enable-threads or --disable-threads was given.
if test "${enable_threads+set}" = set; then
  enableval="$enable_threads"
  tcl_ok=$enableval
else
  tcl_ok=no
fi;

    if test "$tcl_ok" = "yes"; then
	echo "$as_me:$LINENO: result: yes" >&5
echo "${ECHO_T}yes" >&6
	TCL_THREADS=1
	cat >>confdefs.h <<\_ACEOF
#define TCL_THREADS 1
_ACEOF

	# USE_THREAD_ALLOC tells us to try the special thread-based
	# allocator that significantly reduces lock contention
	cat >>confdefs.h <<\_ACEOF
#define USE_THREAD_ALLOC 1
_ACEOF

    else
	TCL_THREADS=0
	echo "$as_me:$LINENO: result: no (default)" >&5
echo "${ECHO_T}no (default)" >&6
    fi



#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------



# Check whether --with-encoding was given.
if test "${with_encoding+set}" = set; then :
  withval=$with_encoding; with_tcencoding=${withval}
fi
# Check whether --with-encoding or --without-encoding was given.
if test "${with_encoding+set}" = set; then
  withval="$with_encoding"
  with_tcencoding=${withval}
fi;


    if test x"${with_tcencoding}" != x ; then
	cat >>confdefs.h <<_ACEOF
#define TCL_CFGVAL_ENCODING "${with_tcencoding}"
_ACEOF

    else
	# Default encoding on windows is not "iso8859-1"
	cat >>confdefs.h <<\_ACEOF
	$as_echo "#define TCL_CFGVAL_ENCODING \"utf-8\"" >>confdefs.h
#define TCL_CFGVAL_ENCODING "cp1252"
_ACEOF

    fi


#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
$as_echo_n "checking how to build libraries... " >&6; }
    # Check whether --enable-shared was given.
    echo "$as_me:$LINENO: checking how to build libraries" >&5
echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6
    # Check whether --enable-shared or --disable-shared was given.
if test "${enable_shared+set}" = set; then :
  enableval=$enable_shared; tcl_ok=$enableval
else
  tcl_ok=yes
fi


    if test "${enable_shared+set}" = set; then
	enableval="$enable_shared"
	tcl_ok=$enableval
    else
	tcl_ok=yes
    fi
if test "${enable_shared+set}" = set; then
  enableval="$enable_shared"
  tcl_ok=$enableval
else
  tcl_ok=yes
fi;

    if test "$tcl_ok" = "yes" ; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5
$as_echo "shared" >&6; }
	echo "$as_me:$LINENO: result: shared" >&5
echo "${ECHO_T}shared" >&6
	SHARED_BUILD=1
    else
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
$as_echo "static" >&6; }
	echo "$as_me:$LINENO: result: static" >&5
echo "${ECHO_T}static" >&6
	SHARED_BUILD=0

cat >>confdefs.h <<\_ACEOF
$as_echo "#define STATIC_BUILD 1" >>confdefs.h
#define STATIC_BUILD 1
_ACEOF

    fi


#--------------------------------------------------------------------
# Check whether --enable-time64bit was given.
#--------------------------------------------------------------------

echo "$as_me:$LINENO: checking force of 64-bit time_t" >&5
echo $ECHO_N "checking force of 64-bit time_t... $ECHO_C" >&6
# Check whether --enable-time64bit or --disable-time64bit was given.
if test "${enable_time64bit+set}" = set; then
  enableval="$enable_time64bit"
  tcl_ok=$enableval
else
  tcl_ok=no
fi;
echo "$as_me:$LINENO: result: \"$tcl_ok\"" >&5
echo "${ECHO_T}\"$tcl_ok\"" >&6
if test "$tcl_ok" = "yes"; then
    CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T"
fi

#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

# On IRIX 5.3, sys/types and inttypes.h are conflicting.
for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
		  inttypes.h stdint.h unistd.h
do :
  as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
"
if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
  cat >>confdefs.h <<_ACEOF
#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF

fi

done




    # Step 0: Enable 64 bit support?

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
$as_echo_n "checking if 64bit support is requested... " >&6; }
    # Check whether --enable-64bit was given.
if test "${enable_64bit+set}" = set; then :
  enableval=$enable_64bit; do64bit=$enableval
    echo "$as_me:$LINENO: checking if 64bit support is requested" >&5
echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6
    # Check whether --enable-64bit or --disable-64bit was given.
if test "${enable_64bit+set}" = set; then
  enableval="$enable_64bit"
  do64bit=$enableval
else
  do64bit=no
fi
fi;
    echo "$as_me:$LINENO: result: $do64bit" >&5
echo "${ECHO_T}$do64bit" >&6

    # Cross-compiling options for Windows/CE builds
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
$as_echo "$do64bit" >&6; }

    echo "$as_me:$LINENO: checking if Windows/CE build is requested" >&5
echo $ECHO_N "checking if Windows/CE build is requested... $ECHO_C" >&6
    # Check whether --enable-wince or --disable-wince was given.
if test "${enable_wince+set}" = set; then
  enableval="$enable_wince"
  doWince=$enableval
else
  doWince=no
fi;
    echo "$as_me:$LINENO: result: $doWince" >&5
echo "${ECHO_T}$doWince" >&6

    echo "$as_me:$LINENO: checking for Windows/CE celib directory" >&5
echo $ECHO_N "checking for Windows/CE celib directory... $ECHO_C" >&6

# Check whether --with-celib or --without-celib was given.
if test "${with_celib+set}" = set; then
  withval="$with_celib"
  CELIB_DIR=$withval
else
  CELIB_DIR=NO_CELIB
fi;
    echo "$as_me:$LINENO: result: $CELIB_DIR" >&5
echo "${ECHO_T}$CELIB_DIR" >&6

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""

cat >>confdefs.h <<\_ACEOF
$as_echo "#define MODULE_SCOPE extern" >>confdefs.h
#define MODULE_SCOPE extern
_ACEOF


    # Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_CYGPATH+:} false; then :
  $as_echo_n "(cached) " >&6
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_CYGPATH+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test -n "$CYGPATH"; then
  ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
  for ac_exec_ext in '' $ac_executable_extensions; do
  if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_CYGPATH="cygpath -m"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
done
  done
done
IFS=$as_save_IFS

  test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi
fi
CYGPATH=$ac_cv_prog_CYGPATH
if test -n "$CYGPATH"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
$as_echo "$CYGPATH" >&6; }
  echo "$as_me:$LINENO: result: $CYGPATH" >&5
echo "${ECHO_T}$CYGPATH" >&6
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi


  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
    # Extract the first word of "wine", so it can be a program name with args.
set dummy wine; ac_word=$2
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
$as_echo_n "checking for $ac_word... " >&6; }
if ${ac_cv_prog_WINE+:} false; then :
  $as_echo_n "(cached) " >&6
else
  if test -n "$WINE"; then
  ac_cv_prog_WINE="$WINE" # Let the user override the test.
else
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    for ac_exec_ext in '' $ac_executable_extensions; do
  if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
    ac_cv_prog_WINE="wine"
    $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
    break 2
  fi
fi
done
  done
IFS=$as_save_IFS

fi
fi
WINE=$ac_cv_prog_WINE
if test -n "$WINE"; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
$as_echo "$WINE" >&6; }
else
  { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
fi



    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

      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5
$as_echo_n "checking for cross-compile version of gcc... " >&6; }
if ${ac_cv_cross+:} false; then :
  $as_echo_n "(cached) " >&6
      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 confdefs.h - <<_ACEOF >conftest.$ac_ext
  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
if ac_fn_c_try_compile "$LINENO"; then :
  (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
ac_cv_cross=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5
$as_echo "$ac_cv_cross" >&6; }
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-${CC}"
		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-${CC}"
		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
3979
3980
3981
3982
3983
3984
3985
3986
3987


3988
3989
3990

3991
3992
3993
3994
3995
3996




3997
3998
3999


4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020




4021
4022





4023
4024
4025
4026
4027
4028
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
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







-
-
+
+


-
+


-
-
-
-
+
+
+
+

-
-
+
+

















-
-
-
-
+
+
+
+

-
+
+
+
+
+














+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+


-
-
+
+

-
+
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+



-
+
















-
-
+
+


-
+


-
-
+
+



+
+
-
-
+
+
+





-
+










-
-
-
+
+
+






-
+



-
-
-
-
-
-
-
-
-








    if test "$GCC" = "yes" && test "$CYGPATH" != "echo" ; then
	conftest=/tmp/conftest.rc
	echo "STRINGTABLE BEGIN" > $conftest
	echo "101 \"name\"" >> $conftest
	echo "END" >> $conftest

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows native path bug in windres" >&5
$as_echo_n "checking for Windows native path bug in windres... " >&6; }
	echo "$as_me:$LINENO: checking for Windows native path bug in windres" >&5
echo $ECHO_N "checking for Windows native path bug in windres... $ECHO_C" >&6
	cyg_conftest=`$CYGPATH $conftest`
	if { ac_try='$RC -o conftest.res.o $cyg_conftest'
  { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; }; } ; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } ; then
	    echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
	    echo "$as_me:$LINENO: result: yes" >&5
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
	extra_cflags="-pipe"
	extra_ldflags="-pipe -static-libgcc"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5
$as_echo_n "checking for mingw32 version of gcc... " >&6; }
if ${ac_cv_win32+:} false; then :
  $as_echo_n "(cached) " >&6
	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 confdefs.h - <<_ACEOF >conftest.$ac_ext
  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
if ac_fn_c_try_compile "$LINENO"; then :
  (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
ac_cv_win32=yes
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5
$as_echo "$ac_cv_win32" >&6; }
echo "$as_me:$LINENO: result: $ac_cv_win32" >&5
echo "${ECHO_T}$ac_cv_win32" >&6
	if test "$ac_cv_win32" != "yes"; then
	    as_fn_error $? "${CC} cannot produce win32 executables." "$LINENO" 5
	    { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5
	fi

echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;}
	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5
$as_echo_n "checking for working -municode linker flag... " >&6; }
if ${ac_cv_municode+:} false; then :
  $as_echo_n "(cached) " >&6
else

   { (exit 1); exit 1; }; }
# ac_fn_c_try_link LINENO
# -----------------------
# Try to link conftest.$ac_ext, and return whether this succeeded.
ac_fn_c_try_link ()
{
  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
  rm -f conftest.$ac_objext conftest$ac_exeext
  if { { ac_try="$ac_link"
case "(($ac_try" in
  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
  *) ac_try_echo=$ac_try;;
esac
eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
$as_echo "$ac_try_echo"; } >&5
  (eval "$ac_link") 2>conftest.err
  ac_status=$?
  if test -s conftest.err; then
    grep -v '^ *+' conftest.err >conftest.er1
    cat conftest.er1 >&5
    mv -f conftest.er1 conftest.err
  fi
	fi
  $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
  test $ac_status = 0; } && {
	 test -z "$ac_c_werror_flag" ||
	 test ! -s conftest.err
       } && test -s conftest$ac_exeext && {
	 test "$cross_compiling" = yes ||
	 test -x conftest$ac_exeext
       }; then :
  ac_retval=0
else
  $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

	ac_retval=1
fi
    fi
  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
  # interfere with the next link command; also delete a directory that is
  # left behind by Apple's compiler.  We do this before executing the actions.
  rm -rf conftest.dSYM conftest_ipa8_conftest.oo
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
  as_fn_set_status $ac_retval

} # ac_fn_c_try_link
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h.  */

	#include <windows.h>
	int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  ac_cv_municode=yes
else
  ac_cv_municode=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5
$as_echo "$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

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5
$as_echo_n "checking compiler flags... " >&6; }
    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 -luserenv -lws2_32"
	LIBS="-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} \$@"
	MAKE_STUB_LIB="\${STLIB_LD} \$@"
	POST_MAKE_LIB="\${RANLIB} \$@"
	MAKE_EXE="\${CC} -o \$@"
	LIBPREFIX="lib"

	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
$as_echo "using static flags" >&6; }
            echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	    EXESUFFIX="s\${DBGX}.exe"
	else
	    # dynamic
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
$as_echo "using shared flags" >&6; }
            echo "$as_me:$LINENO: result: using shared flags" >&5
echo "${ECHO_T}using shared flags" >&6

	    # ad-hoc check to see if CC supports -shared.
	    if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
		{ { echo "$as_me:$LINENO: error: ${CC} does not support the -shared option.
                You will need to upgrade to a newer version of the toolchain." >&5
		as_fn_error $? "${CC} does not support the -shared option.
                You will need to upgrade to a newer version of the toolchain." "$LINENO" 5
echo "$as_me: error: ${CC} does not support the -shared option.
                You will need to upgrade to a newer version of the toolchain." >&2;}
   { (exit 1); exit 1; }; }
	    fi

	    runtime=
	    # Add SHLIB_LD_LIBS to the Make rule, not here.

	    EXESUFFIX=".exe"
	    EXESUFFIX="\${DBGX}.exe"
	    LIBRARIES="\${SHARED_LIBRARIES}"
	fi
	# Link with gcc since ld does not link to default libs like
	# -luser32 and -lmsvcrt by default.
	SHLIB_LD='${CC} -shared'
	SHLIB_LD_LIBS='${LIBS}'
	MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \$@ ${extra_ldflags} \
	    -Wl,--out-implib,\$(patsubst %.dll,lib%.dll.a,\$@)"
	# DLLSUFFIX is separate because it is the building block for
	# users of tclConfig.sh that may build shared or static.
	DLLSUFFIX=".dll"
	LIBSUFFIX=".a"
	LIBFLAGSUFFIX=""
	DLLSUFFIX="\${DBGX}.dll"
	LIBSUFFIX="\${DBGX}.a"
	LIBFLAGSUFFIX="\${DBGX}"
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith"
	CFLAGS_WARNING="-Wall -Wdeclaration-after-statement -Wpointer-arith"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \$@"
	CC_EXENAME="-o \$@"

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	#
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
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







-
-
+
+



-
-
+
+


-
+
+
+
+
+














+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+


-
+

-
-
-
-
+
+
+
+






-
-
+
+


-
+


-
-
+
+



-
+











-
-
-
+
+
+










-
-
+
+


-
+







	#LDFLAGS_WINDOW="-mwindows -e _WinMain@16 ${extra_ldflags}"
	LDFLAGS_CONSOLE="-mconsole ${extra_ldflags}"
	LDFLAGS_WINDOW="-mwindows ${extra_ldflags}"

	case "$do64bit" in
	    amd64|x64|yes)
		MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		echo "$as_me:$LINENO: result:    Using 64-bit $MACHINE mode" >&5
echo "${ECHO_T}   Using 64-bit $MACHINE mode" >&6
		;;
	    ia64)
		MACHINE="IA64"
		{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		echo "$as_me:$LINENO: result:    Using 64-bit $MACHINE mode" >&5
echo "${ECHO_T}   Using 64-bit $MACHINE mode" >&6
		;;
	    *)
		cat confdefs.h - <<_ACEOF >conftest.$ac_ext
		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;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
if ac_fn_c_try_compile "$LINENO"; then :
  (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_win_64bit=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  tcl_win_64bit=no
tcl_win_64bit=no

fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
		if test "$tcl_win_64bit" = "yes" ; then
			do64bit=amd64
			MACHINE="AMD64"
			{ $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
		    do64bit=amd64
		    MACHINE="AMD64"
		    echo "$as_me:$LINENO: result:    Using 64-bit $MACHINE mode" >&5
echo "${ECHO_T}   Using 64-bit $MACHINE mode" >&6
		fi
		;;
	esac
    else
	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
$as_echo "using static flags" >&6; }
            echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
	    runtime=-MT
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	    EXESUFFIX="s\${DBGX}.exe"
	else
	    # dynamic
            { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
$as_echo "using shared flags" >&6; }
            echo "$as_me:$LINENO: result: using shared flags" >&5
echo "${ECHO_T}using shared flags" >&6
	    runtime=-MD
	    # Add SHLIB_LD_LIBS to the Make rule, not here.
	    LIBRARIES="\${SHARED_LIBRARIES}"
	    EXESUFFIX=".exe"
	    EXESUFFIX="\${DBGX}.exe"
	    case "x`echo \${VisualStudioVersion}`" in
		x1[4-9]*)
		    lflags="${lflags} -nodefaultlib:libucrt.lib"
		    ;;
		*)
		    ;;
	    esac
	fi
	MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\$@"
	# DLLSUFFIX is separate because it is the building block for
	# users of tclConfig.sh that may build shared or static.
	DLLSUFFIX=".dll"
	LIBSUFFIX=".lib"
	LIBFLAGSUFFIX=""
	DLLSUFFIX="\${DBGX}.dll"
	LIBSUFFIX="\${DBGX}.lib"
	LIBFLAGSUFFIX="\${DBGX}"

	if test "$do64bit" != "no" ; then
	    case "$do64bit" in
		amd64|x64|yes)
		    MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
		    ;;
		ia64)
		    MACHINE="IA64"
		    ;;
	    esac
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result:    Using 64-bit $MACHINE mode" >&5
$as_echo "   Using 64-bit $MACHINE mode" >&6; }
	    echo "$as_me:$LINENO: result:    Using 64-bit $MACHINE mode" >&5
echo "${ECHO_T}   Using 64-bit $MACHINE mode" >&6
	fi

	LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
	LIBS="user32.lib advapi32.lib ws2_32.lib"

	case "x`echo \${VisualStudioVersion}`" in
		x1[4-9]*)
		    LIBS="$LIBS ucrt.lib"
		    ;;
		*)
		    ;;
4341
4342
4343
4344
4345
4346
4347







































































































4348


4349
4350
4351
4352
4353
4354
4355
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
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804

3805
3806
3807
3808
3809
3810
3811
3812
3813







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+







	    CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
	    # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
	    CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
	    lflags="${lflags} -nologo"
	    LINKBIN="link"
	fi

	if test "$doWince" != "no" ; then
	    # Set defaults for common evc4/PPC2003 setup
	    # Currently Tcl requires 300+, possibly 420+ for sockets
	    CEVERSION=420; 		# could be 211 300 301 400 420 ...
	    TARGETCPU=ARMV4;	# could be ARMV4 ARM MIPS SH3 X86 ...
	    ARCH=ARM;		# could be ARM MIPS X86EM ...
	    PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
	    if test "$doWince" != "yes"; then
		# If !yes then the user specified something
		# Reset ARCH to allow user to skip specifying it
		ARCH=
		eval `echo $doWince | awk -F "," '{ \
	if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \
	if ($1 < 400)	  { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
	if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \
	if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \
	if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \
		}'`
		if test "x${ARCH}" = "x" ; then
		    ARCH=$TARGETCPU;
		fi
	    fi
	    OSVERSION=WCE$CEVERSION;
	    if test "x${WCEROOT}" = "x" ; then
		WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
		if test ! -d "${WCEROOT}" ; then
		    WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
		fi
	    fi
	    if test "x${SDKROOT}" = "x" ; then
		SDKROOT="C:/Program Files/Windows CE Tools"
		if test ! -d "${SDKROOT}" ; then
		    SDKROOT="C:/Windows CE Tools"
		fi
	    fi
	    # The space-based-path will work for the Makefile, but will
	    # not work if AC_TRY_COMPILE is called.
	    WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
	    SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
	    CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
	    if test ! -d "${CELIB_DIR}/inc"; then
		{ { echo "$as_me:$LINENO: error: Invalid celib directory \"${CELIB_DIR}\"" >&5
echo "$as_me: error: Invalid celib directory \"${CELIB_DIR}\"" >&2;}
   { (exit 1); exit 1; }; }
	    fi
	    if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
		-o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
		{ { echo "$as_me:$LINENO: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&5
echo "$as_me: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&2;}
   { (exit 1); exit 1; }; }
	    else
		CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
		if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
		    CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
		fi
		CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
	    fi
	fi

	if test "$doWince" != "no" ; then
	    CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
	    if test "${TARGETCPU}" = "X86"; then
		CC="${CEBINROOT}/cl.exe"
	    else
		CC="${CEBINROOT}/cl${ARCH}.exe"
	    fi
	    CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
	    RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
	    arch=`echo ${ARCH} | awk '{print tolower($0)}'`
	    defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
	    for i in $defs ; do
		cat >>confdefs.h <<_ACEOF
#define $i 1
_ACEOF

	    done
#	    if test "${ARCH}" = "X86EM"; then
#		AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
#	    fi
	    cat >>confdefs.h <<_ACEOF
#define _WIN32_WCE $CEVERSION
_ACEOF

	    cat >>confdefs.h <<_ACEOF
#define UNDER_CE $CEVERSION
_ACEOF

	    CFLAGS_DEBUG="-nologo -Zi -Od"
	    CFLAGS_OPTIMIZE="-nologo -O2"
	    lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'`
	    lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo"
	    LINKBIN="\"${CEBINROOT}/link.exe\""

	    if test "${CEVERSION}" -lt 400 ; then
		LIBS="coredll.lib corelibc.lib winsock.lib"
	    else
		LIBS="coredll.lib corelibc.lib ws2.lib"
	    fi
	    # celib currently stuck at wce300 status
	    #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
	    LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
	    LIBS_GUI="commctrl.lib commdlg.lib"
	else
	LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	    LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	fi

	SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
	SHLIB_LD_LIBS='${LIBS}'
	# link -lib only works when -lib is the first arg
	STLIB_LD="${LINKBIN} -lib ${lflags}"
	RC_OUT=-fo
	RC_TYPE=-r
4372
4373
4374
4375
4376
4377
4378
4379

4380
4381
4382
4383
4384
4385
4386
4387
4388

4389


4390
4391
4392
4393
4394
4395
4396
4397




4398
4399

4400
4401
4402





4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420







4421




4422
4423





4424

4425
4426

4427
4428
4429
4430
4431
4432
4433


4434
4435

4436


4437
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449




4450
4451





4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467


4468




















4469
4470



4471

4472
4473

4474
4475
4476
4477


4478
4479

4480


4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491




4492
4493





4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512


4513




















4514
4515



4516

4517
4518

4519
4520
4521
4522


4523
4524

4525
4526


4527
4528
4529
4530
4531
4532
4533
4534

4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545




4546
4547





4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560


4561




















4562
4563



4564

4565
4566

4567
4568
4569
4570


4571
4572

4573


4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592








4593
4594
4595
4596
4597
4598
4599
4600






4601










4602




4603
4604
4605





















4606
4607

4608

4609

4610
4611
4612

4613
4614

4615
4616
4617
4618
4619





4620
4621

4622
4623
4624

4625
4626
4627

4628
4629
4630
4631




4632
4633

4634
4635

4636
4637
4638
4639
4640
4641
4642











4643
4644

4645
4646
4647


4648
4649
4650
4651
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
4955
4956
4957
4958
4959
4960
4961
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
5016
5017


5018
5019
5020
5021
5022

5023
5024

5025
5026
5027
5028
5029

5030
5031
5032
5033

5034
5035

5036
5037

5038
5039
5040

5041
5042
5043
5044
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
5095
5096
5097
5098
5099
5100
5101
5102
5103
5104
5105
5106
5107
5108
5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123

5124
5125

5126
5127
5128
5129


5130
5131

5132


5133
5134
5135
5136
5137
5138
5139
5140
5141
5142
5143
5144
5145
5146
5147






5148
5149
5150

5151
5152
5153
5154
5155

5156

5157


5158
5159
5160


5161

5162


5163
5164
5165
5166

5167
5168
5169


5170
5171
5172
5173
5174
5175
5176

5177


5178
5179
5180
5181
5182

5183


5184
5185

5186


5187
5188
5189
5190
5191
5192
5193


5194
5195
5196


5197
5198
5199


5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210






5211
5212
5213

5214
5215
5216
5217
5218
5219
5220
5221
5222





5223
5224
5225
5226
5227
5228
5229
5230
5231

5232
5233
5234
5235
5236
5237
5238
5239
5240
5241
5242
5243
5244
5245
5246
5247
5248
5249
5250
5251


5252
5253
5254
5255
5256
5257
5258
5259
5260
5261
5262
5263
5264
5265




5266
5267
5268










5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288
5289
5290





5291
5292
5293
5294
5295
5296
5297
5298
5299
5300
5301



5302


5303



5304


5305
5306
5307
5308
5309
5310
5311
5312
5313
5314
5315

5316
5317

5318
5319
5320
5321
5322
5323
5324
3830
3831
3832
3833
3834
3835
3836

3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847

3848
3849
3850
3851
3852
3853




3854
3855
3856
3857
3858

3859
3860
3861

3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891

3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902

3903
3904

3905

3906
3907

3908


3909
3910
3911
3912
3913

3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924




3925
3926
3927
3928
3929

3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
3944
3945
3946
3947
3948
3949
3950
3951
3952

3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977

3978
3979

3980
3981
3982


3983
3984
3985
3986
3987

3988
3989
3990
3991
3992
3993
3994
3995
3996




3997
3998
3999
4000
4001

4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027

4028
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
4328
4329
4330
4331
4332
4333

4334
4335

4336
4337
4338
4339


4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362


4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411

4412
4413
4414
4415
4416




4417
4418
4419
4420
4421
4422
4423
4424
4425

4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436

4437

4438
4439
4440
4441
4442
4443
4444

4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469

4470
4471

4472
4473
4474
4475


4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487











































































































































































































4488
4489
4490
4491
4492
4493
4494
4495




4496
4497
4498
4499
4500

4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522







4523
4524





4525
4526


4527


4528



4529
4530





4531


4532





4533




4534


4535


4536



4537







4538
4539
4540





4541


4542


4543


4544



4545

4546
4547

4548

4549

























































4550
4551

4552
4553
4554


4555
4556
4557
4558
4559

4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571





4572
4573
4574
4575
4576
4577
4578
4579

4580

4581
4582
4583
4584
4585
4586
4587

4588
4589
4590


4591
4592
4593
4594

4595
4596
4597
4598
4599
4600
4601
4602


4603
4604
4605
4606
4607
4608
4609
4610
4611
4612

4613
4614
4615
4616
4617
4618
4619
4620

4621
4622
4623
4624
4625

4626
4627
4628
4629
4630
4631
4632


4633
4634
4635


4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648





4649
4650
4651
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







-
+









+
-
+
+




-
-
-
-
+
+
+
+

-
+


-
+
+
+
+
+


















+
+
+
+
+
+
+
-
+
+
+
+


+
+
+
+
+
-
+

-
+
-


-

-
-
+
+


+
-
+
+









-
-
-
-
+
+
+
+

-
+
+
+
+
+
















+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+


-
-
+
+


+
-
+
+







-
-
-
-
+
+
+
+

-
+
+
+
+
+



















+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+


-
-
+
+


+
-
-
+
+
-

-
-
-
-
-
-
+
-
-





-
-
-
-
+
+
+
+

-
+
+
+
+
+













+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+


-
-
+
+


+
-
+
+











-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-

-
-
-
-
-

+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
+

+

-
-
+
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
+

-
-
+
-

-
+

-

-
+
+
+
+

-
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+

-
+
-
-
-
-
-
+
+
+
+


+
-
+
+



-
-
-
-
+
+
+
+




-
+
+
+
+
+






-
+
-





+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+



-
-
+
+










+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+

+
+
-
+
+



-
-
-
-
+
+
+
+





-
+
+
+
+
+






-
+
-





+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+

-
+



-
-
+
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-
+
+
+
+

-
+
+
+
+
+

















-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
+
-
-
+
-
-
-
+
+
-
-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-
-
+
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
+
-
-
+
-
-
+
-
-
+
-
-
-
+
-

+
-
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
+


-
-
+
+


+
-
+
+










-
-
-
-
-
+
+
+
+
+
+


-
+
-




+

+
-
+
+

-
-
+
+

+
-
+
+




+

-
-
+
+







+
-
+
+





+
-
+
+


+
-
+
+





-
-
+
+

-
-
+
+



+
+






-
-
-
-
-
+
+
+
+
+
+


-
+
-







-
+
+
+
+
+








-
+


















-
-
+
+














+
+
+
+



+
+
+
+
+
+
+
+
+
+








-
-
-
-
-
-
-
-



-
-
-
+
+
+
+
+











+
+
+
-
+
+

+
+
+
-
+
+










-
+

-
+








	# Specify the CC output file names based on the target name
	CC_OBJNAME="-Fo\$@"
	CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\$@')\""

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	if test "${TARGETCPU}" != "X86"; then
	if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
	    LDFLAGS_CONSOLE="-link ${lflags}"
	    LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
	else
	    LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
	    LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
	fi
    fi

    if test "$do64bit" != "no" ; then
	cat >>confdefs.h <<\_ACEOF
	$as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h
#define TCL_CFG_DO64BIT 1
_ACEOF

    fi

    if test "${GCC}" = "yes" ; then
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5
$as_echo_n "checking for SEH support in compiler... " >&6; }
if ${tcl_cv_seh+:} false; then :
  $as_echo_n "(cached) " >&6
	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 :
  if test "$cross_compiling" = yes; then
  tcl_cv_seh=no
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  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
if ac_fn_c_try_run "$LINENO"; then :
  (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
tcl_cv_seh=no
fi
rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
  conftest.$ac_objext conftest.beam conftest.$ac_ext
fi


fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5
$as_echo "$tcl_cv_seh" >&6; }
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
$as_echo "#define HAVE_NO_SEH 1" >>confdefs.h
#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.
	#
	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5
$as_echo_n "checking for EXCEPTION_DISPOSITION support in include files... " >&6; }
if ${tcl_cv_eh_disposition+:} false; then :
  $as_echo_n "(cached) " >&6
	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 confdefs.h - <<_ACEOF >conftest.$ac_ext
  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
if ac_fn_c_try_compile "$LINENO"; then :
  (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
tcl_cv_eh_disposition=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
$as_echo "$tcl_cv_eh_disposition" >&6; }
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
$as_echo "#define EXCEPTION_DISPOSITION int" >>confdefs.h
#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.

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5
$as_echo_n "checking for winnt.h that ignores VOID define... " >&6; }
if ${tcl_cv_winnt_ignore_void+:} false; then :
  $as_echo_n "(cached) " >&6
	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 confdefs.h - <<_ACEOF >conftest.$ac_ext
  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
if ac_fn_c_try_compile "$LINENO"; then :
  (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
tcl_cv_winnt_ignore_void=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5
$as_echo "$tcl_cv_winnt_ignore_void" >&6; }
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
$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h

#define HAVE_WINNT_IGNORE_VOID 1
_ACEOF
	fi

	ac_fn_c_check_header_mongrel "$LINENO" "stdbool.h" "ac_cv_header_stdbool_h" "$ac_includes_default"
if test "x$ac_cv_header_stdbool_h" = xyes; then :

$as_echo "#define HAVE_STDBOOL_H 1" >>confdefs.h

fi
	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.

	{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5
$as_echo_n "checking for cast to union support... " >&6; }
if ${tcl_cv_cast_to_union+:} false; then :
  $as_echo_n "(cached) " >&6
	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 confdefs.h - <<_ACEOF >conftest.$ac_ext
  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
if ac_fn_c_try_compile "$LINENO"; then :
  (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
tcl_cv_cast_to_union=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5
$as_echo "$tcl_cv_cast_to_union" >&6; }
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
$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h
#define HAVE_CAST_TO_UNION 1
_ACEOF

	fi
    fi

    # DL_LIBS is empty, but then we match the Unix version






# Cross-compiling
case ${host_alias} in
*mingw32*)
    TCL_EXE="tclsh"
    ;;
*)
    TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
    ;;
# On IRIX 5.3, sys/types and inttypes.h are conflicting.







esac

#------------------------------------------------------------------------
#	Add stuff for zlib/libtommath; note that this is mostly done in the
#	makefile now as we just assume that the platform hasn't got usable
#   z.lib/tommath.lib
#------------------------------------------------------------------------

for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
		  inttypes.h stdint.h unistd.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_header" >&5
echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
if test "${enable_shared+set}" = "set"; then :
if eval "test \"\${$as_ac_Header+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.  */
$ac_includes_default

#include <$ac_header>
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  enableval="$enable_shared"
  tcl_ok=$enableval

  (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
  eval "$as_ac_Header=yes"
else

  echo "$as_me: failed program was:" >&5
  tcl_ok=yes
sed 's/^/| /' conftest.$ac_ext >&5

eval "$as_ac_Header=no"
fi
if test "$tcl_ok" = "yes"; then :

rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
  ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}

fi
  TOMMATH_DLL_FILE=\${TOMMATH_DLL_FILE}


$as_echo "#define TCL_WITH_EXTERNAL_TOMMATH 1" >>confdefs.h

echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
if test `eval echo '${'$as_ac_Header'}'` = yes; then
  cat >>confdefs.h <<_ACEOF
#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
  if test "$do64bit" != "no"; then :

_ACEOF

$as_echo "#define MP_64BIT 1" >>confdefs.h

fi
    if test "$GCC" == "yes"; then :

      ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a
done

      TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a


echo "$as_me:$LINENO: checking for intptr_t" >&5
echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
if test "${ac_cv_type_intptr_t+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else

  cat >conftest.$ac_ext <<_ACEOF
      ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/zdll.lib

/* confdefs.h.  */
      TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win64/tommath.lib


fi

else

_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
if ((intptr_t *) 0)
  return 0;
if (sizeof (intptr_t))
    ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib

  return 0;
    TOMMATH_LIBS=\${TOMMATH_DIR_NATIVE}/win32/tommath.lib


  ;
  return 0;
fi

else

  ZLIB_OBJS=\${ZLIB_OBJS}

  TOMMATH_OBJS=\${TOMMATH_OBJS}

}
_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_type_intptr_t=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

ac_cv_type_intptr_t=no
fi

rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
$as_echo "#define HAVE_ZLIB 1" >>confdefs.h


ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default"
if test "x$ac_cv_type_intptr_t" = xyes; then :
fi
echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5
echo "${ECHO_T}$ac_cv_type_intptr_t" >&6
if test $ac_cv_type_intptr_t = yes; then


cat >>confdefs.h <<\_ACEOF
$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h
#define HAVE_INTPTR_T 1
_ACEOF

else

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5
$as_echo_n "checking for pointer-size signed integer type... " >&6; }
if ${tcl_cv_intptr_t+:} false; then :
  $as_echo_n "(cached) " >&6
    echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5
echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6
if test "${tcl_cv_intptr_t+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else

    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
	    cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))];
test_array [0] = 0;
test_array [0] = 0
return test_array [0];

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
if ac_fn_c_try_compile "$LINENO"; then :
  (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_ok=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  tcl_ok=no
tcl_ok=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
	    test "$tcl_ok" = yes && break; fi
    done
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5
$as_echo "$tcl_cv_intptr_t" >&6; }
echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5
echo "${ECHO_T}$tcl_cv_intptr_t" >&6
    if test "$tcl_cv_intptr_t" != none; then

cat >>confdefs.h <<_ACEOF
#define intptr_t $tcl_cv_intptr_t
_ACEOF

    fi

fi

echo "$as_me:$LINENO: checking for uintptr_t" >&5
echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
if test "${ac_cv_type_uintptr_t+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.  */
ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default"
if test "x$ac_cv_type_uintptr_t" = xyes; then :
$ac_includes_default
int
main ()
{
if ((uintptr_t *) 0)
  return 0;
if (sizeof (uintptr_t))
  return 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
  ac_cv_type_uintptr_t=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

ac_cv_type_uintptr_t=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
fi
echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
if test $ac_cv_type_uintptr_t = yes; then


cat >>confdefs.h <<\_ACEOF
$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h
#define HAVE_UINTPTR_T 1
_ACEOF

else

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5
$as_echo_n "checking for pointer-size unsigned integer type... " >&6; }
if ${tcl_cv_uintptr_t+:} false; then :
  $as_echo_n "(cached) " >&6
    echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5
echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6
if test "${tcl_cv_uintptr_t+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else

    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    cat confdefs.h - <<_ACEOF >conftest.$ac_ext
	    cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))];
test_array [0] = 0;
test_array [0] = 0
return test_array [0];

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
if ac_fn_c_try_compile "$LINENO"; then :
  (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_ok=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

  tcl_ok=no
tcl_ok=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
	    test "$tcl_ok" = yes && break; fi
    done
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5
$as_echo "$tcl_cv_uintptr_t" >&6; }
echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5
echo "${ECHO_T}$tcl_cv_uintptr_t" >&6
    if test "$tcl_cv_uintptr_t" != none; then

cat >>confdefs.h <<_ACEOF
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

fi



#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
# Check whether --enable-zipfs was given.
if test "${enable_zipfs+set}" = set; then :
  enableval=$enable_zipfs; tcl_ok=$enableval
else
  tcl_ok=yes
fi

if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    # Put a plausible default for CC_FOR_BUILD in Makefile.
if test -z "$CC_FOR_BUILD"; then
  if test "x$cross_compiling" = "xno"; then
    CC_FOR_BUILD='$(CC)'
  else
    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
$as_echo_n "checking for gcc... " >&6; }
    if ${ac_cv_path_cc+:} false; then :
  $as_echo_n "(cached) " >&6
else

	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/gcc 2> /dev/null` \
		    `ls -r $dir/gcc 2> /dev/null` ; do
		if test x"$ac_cv_path_cc" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_cc=$j
			break
		    fi
		fi
	    done
	done

fi

  fi
fi

# Also set EXEEXT_FOR_BUILD.
if test "x$cross_compiling" = "xno"; then
  EXEEXT_FOR_BUILD='$(EXEEXT)'
  OBJEXT_FOR_BUILD='$(OBJEXT)'
else
  OBJEXT_FOR_BUILD='.no'
  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
$as_echo_n "checking for build system executable suffix... " >&6; }
if ${bfd_cv_build_exeext+:} false; then :
  $as_echo_n "(cached) " >&6
else
  rm -f conftest*
     echo 'int main () { return 0; }' > conftest.c
     bfd_cv_build_exeext=
     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
     for file in conftest.*; do
       case $file in
       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
       esac
     done
     rm -f conftest*
     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
$as_echo "$bfd_cv_build_exeext" >&6; }
  EXEEXT_FOR_BUILD=""
  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
fi

    #
    # Find a native zip implementation
    #

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
$as_echo_n "checking for tclsh... " >&6; }

    if ${ac_cv_path_tclsh+:} false; then :
  $as_echo_n "(cached) " >&6
else

	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \
		    `ls -r $dir/tclsh* 2> /dev/null` ; do
		if test x"$ac_cv_path_tclsh" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_tclsh=$j
			break
		    fi
		fi
	    done
	done

fi


    if test -f "$ac_cv_path_tclsh" ; then
	TCLSH_PROG="$ac_cv_path_tclsh"
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
$as_echo "$TCLSH_PROG" >&6; }
    else
	# It is not an error if an installed version of Tcl can't be located.
	TCLSH_PROG=""
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
$as_echo "No tclsh found on PATH" >&6; }
    fi



    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
$as_echo_n "checking for zip... " >&6; }
    if ${ac_cv_path_zip+:} false; then :
  $as_echo_n "(cached) " >&6
else

    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done

fi

    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
$as_echo "$ZIP_PROG" >&6; }
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="*"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
$as_echo "Found INFO Zip in environment" >&6; }
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="*"
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
$as_echo "No zip found on PATH building minizip" >&6; }
    fi





	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
$as_echo_n "checking for building with zipfs... " >&6; }
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;

$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h

       INSTALL_LIBRARIES=install-libraries-zipfs-static
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
     else

$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
$as_echo "yes" >&6; }
    fi
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
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.

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
if ${tcl_cv_findex_enums+:} false; then :
  $as_echo_n "(cached) " >&6
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 confdefs.h - <<_ACEOF >conftest.$ac_ext
  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
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_findex_enums=yes
else
  tcl_cv_findex_enums=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
$as_echo "$tcl_cv_findex_enums" >&6; }
if test "$tcl_cv_findex_enums" = "no"; then

  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h

  grep -v '^ *+' conftest.er1 >conftest.err
fi

  rm -f conftest.er1
# See if the compiler supports intrinsics.

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for intrinsics support in compiler" >&5
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
$as_echo_n "checking for intrinsics support in compiler... " >&6; }
if ${tcl_cv_intrinsics+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
  (exit $ac_status); } &&
/* end confdefs.h.  */

	 { ac_try='test -z "$ac_c_werror_flag"
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <intrin.h>

			 || test ! -s conftest.err'
int
main ()
{

  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  __cpuidex(0,0,0);

  (eval $ac_try) 2>&5
  ;
  return 0;
  ac_status=$?
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  tcl_cv_intrinsics=yes
else
  tcl_cv_intrinsics=no
fi
rm -f core conftest.err conftest.$ac_objext \
    conftest$ac_exeext conftest.$ac_ext

  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5
$as_echo "$tcl_cv_intrinsics" >&6; }
if test "$tcl_cv_intrinsics" = "yes"; then

  (eval $ac_try) 2>&5
$as_echo "#define HAVE_INTRIN_H 1" >>confdefs.h

  ac_status=$?
fi

  echo "$as_me:$LINENO: \$? = $ac_status" >&5
# See if the <wspiapi.h> header file is present

  (exit $ac_status); }; }; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for wspiapi.h" >&5
$as_echo_n "checking for wspiapi.h... " >&6; }
if ${tcl_cv_wspiapi_h+:} false; then :
  tcl_cv_findex_enums=yes
  $as_echo_n "(cached) " >&6
else
  echo "$as_me: failed program was:" >&5
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
sed 's/^/| /' conftest.$ac_ext >&5
/* end confdefs.h.  */

#include <wspiapi.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_wspiapi_h=yes
else
  tcl_cv_wspiapi_h=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5
$as_echo "$tcl_cv_wspiapi_h" >&6; }
if test "$tcl_cv_wspiapi_h" = "yes"; then

$as_echo "#define HAVE_WSPIAPI_H 1" >>confdefs.h

fi

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
if ${tcl_cv_findex_enums+:} false; then :
  $as_echo_n "(cached) " >&6
else
  cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* 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
if ac_fn_c_try_compile "$LINENO"; then :
  tcl_cv_findex_enums=yes
else
  tcl_cv_findex_enums=no
tcl_cv_findex_enums=no
fi
rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
$as_echo "$tcl_cv_findex_enums" >&6; }
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
$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h
#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.
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
$as_echo_n "checking for build with symbols... " >&6; }
    # Check whether --enable-symbols was given.
if test "${enable_symbols+set}" = set; then :
  enableval=$enable_symbols; tcl_ok=$enableval
    echo "$as_me:$LINENO: checking for build with symbols" >&5
echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6
    # Check whether --enable-symbols or --disable-symbols was given.
if test "${enable_symbols+set}" = set; then
  enableval="$enable_symbols"
  tcl_ok=$enableval
else
  tcl_ok=no
fi
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
$as_echo "#define NDEBUG 1" >>confdefs.h
#define NDEBUG 1
_ACEOF

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
$as_echo "no" >&6; }
	echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6

	cat >>confdefs.h <<\_ACEOF
	$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h
#define TCL_CFG_OPTIMIZED 1
_ACEOF

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	DBGX=g
	if test "$tcl_ok" = "yes"; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
$as_echo "yes (standard debugging)" >&6; }
	    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
$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h
#define TCL_MEM_DEBUG 1
_ACEOF

    fi

    if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then

cat >>confdefs.h <<\_ACEOF
$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h
#define TCL_COMPILE_DEBUG 1
_ACEOF


cat >>confdefs.h <<\_ACEOF
$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h
#define TCL_COMPILE_STATS 1
_ACEOF

    fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
$as_echo "enabled symbols mem compile debugging" >&6; }
	    echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5
echo "${ECHO_T}enabled symbols mem compile debugging" >&6
	else
	    { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
$as_echo "enabled $tcl_ok debugging" >&6; }
	    echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5
echo "${ECHO_T}enabled $tcl_ok debugging" >&6
	fi
    fi


TCL_DBGX=${DBGX}

#--------------------------------------------------------------------
# Embed the manifest if we can determine how
#--------------------------------------------------------------------


    { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5
$as_echo_n "checking whether to embed manifest... " >&6; }
    # Check whether --enable-embedded-manifest was given.
if test "${enable_embedded_manifest+set}" = set; then :
  enableval=$enable_embedded_manifest; embed_ok=$enableval
    echo "$as_me:$LINENO: checking whether to embed manifest" >&5
echo $ECHO_N "checking whether to embed manifest... $ECHO_C" >&6
    # Check whether --enable-embedded-manifest or --disable-embedded-manifest was given.
if test "${enable_embedded_manifest+set}" = set; then
  enableval="$enable_embedded_manifest"
  embed_ok=$enableval
else
  embed_ok=yes
fi
fi;


    VC_MANIFEST_EMBED_DLL=
    VC_MANIFEST_EMBED_EXE=
    result=no
    if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \
       -a "$GCC" != "yes" ; then
	# Add the magic to embed the manifest into the dll/exe
	cat confdefs.h - <<_ACEOF >conftest.$ac_ext
	cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#if defined(_MSC_VER) && _MSC_VER >= 1400
print("manifest needed")
#endif

_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
  $EGREP "manifest needed" >/dev/null 2>&1; then :
  $EGREP "manifest needed" >/dev/null 2>&1; then

	# Could do a CHECK_PROG for mt, but should always be with MSVC8+
	# Could add 'if test -f' check, but manifest should be created
	# in this compiler case
	# Add in a manifest argument that may be specified
	# XXX Needs improvement so that the test for existence accounts
	# XXX for a provided (known) manifest
	VC_MANIFEST_EMBED_DLL="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest  -outputresource:\$@\;2 ; fi"
	VC_MANIFEST_EMBED_EXE="if test -f \$@.manifest ; then mt.exe -nologo -manifest \$@.manifest  -outputresource:\$@\;1 ; fi"
	result=yes
	if test "x" != x ; then
	    result="yes ()"
	fi

fi
rm -f conftest*

    fi
    { $as_echo "$as_me:${as_lineno-$LINENO}: result: $result" >&5
$as_echo "$result" >&6; }
    echo "$as_me:$LINENO: result: $result" >&5
echo "${ECHO_T}$result" >&6




#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}

#--------------------------------------------------------------------
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------

TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"

eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""

eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"

if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
else
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\""
fi

eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\""
eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\""

eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""

if test ${SHARED_BUILD} = 0 ; then
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
else
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\""
fi
eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\""
eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""

# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"

eval "DLLSUFFIX=${DLLSUFFIX}"
eval "LIBPREFIX=${LIBPREFIX}"
eval "LIBSUFFIX=${LIBSUFFIX}"
eval "EXESUFFIX=${EXESUFFIX}"

CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}

#--------------------------------------------------------------------
# Adjust the defines for how the resources are built depending
# on symbols and static vs. shared.
#--------------------------------------------------------------------

if test ${SHARED_BUILD} = 0 ; then
    if test "${DBGX}" = "g"; then
        RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
    else
    RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
        RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
    fi
else
    if test "${DBGX}" = "g"; then
        RC_DEFINES="${RC_DEFINE} DEBUG"
    else
    RC_DEFINES=""
        RC_DEFINES=""
    fi
fi

#--------------------------------------------------------------------
#	The statements below define the symbol TCL_PACKAGE_PATH, which
#	gives a list of directories that may contain packages.  The list
#	consists of one directory for machine-dependent binaries and
#	another for platform-independent scripts.
#--------------------------------------------------------------------

if test "$prefix/lib" != "$libdir"; then
    TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib}"
    TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
else
    TCL_PACKAGE_PATH="{${prefix}/lib}"
    TCL_PACKAGE_PATH="${prefix}/lib"
fi

# The tclsh.exe.manifest requires these
# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs
# the release level, and must account for interim release versioning
case "$TCL_PATCH_LEVEL" in
     *a*) TCL_RELEASE_LEVEL=0 ;;
5333
5334
5335
5336
5337
5338
5339
5340

5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
4796
4797
4798
4799
4800
4801
4802

4803
4804





4805
4806
4807
4808
4809
4810
4811







-
+

-
-
-
-
-















# empty on win





# empty on win







5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427

5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447

5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466

5467
5468
5469
5470
5471




5472
5473
5474
5475

5476
5477

5478

5479
5480

5481
5482

5483
5484
5485
5486

5487
5488
5489
5490
5491
5492
5493





5494
5495
5496
5497
5498


5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510

5511
5512
5513
5514
5515
5516
5517















5518
5519
5520
5521
5522
5523
5524

5525
5526

5527
5528
5529
5530
5531
5532
5533
5534
5535


5536
5537

5538
5539
5540
5541
5542
5543
5544






5545
5546
5547
5548
5549
5550
5551

5552
5553
5554










5555
5556
5557
5558
5559
5560
5561

5562

5563
5564

5565
5566
5567


5568
5569
5570
5571
5572
5573
5574
5575

5576
5577
5578
5579
5580


5581
5582

5583
5584
5585
5586
5587
5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599






5600
5601

5602
5603

5604
5605
5606

5607
5608
5609
5610
5611

5612
5613

5614
5615
5616
5617
5618

5619
5620
5621
5622
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
5645
5646
5647
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664

5665
5666
5667


5668
5669
5670
5671
5672
5673
5674

5675
5676

5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687

5688
5689
5690
5691
5692
5693
5694
5695

5696
5697
5698
5699
5700
5701

5702
5703
5704

5705
5706
5707
5708
5709
5710
5711
5712
5713
5714
5715
5716
5717





5718
5719
5720
5721


5722
5723
5724
5725
5726
5727

5728
5729

5730
5731
5732
5733
5734
5735
5736
5737

5738
5739
5740
5741
5742
5743
5744
5745
5746

5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801

5802
5803
5804
5805
5806
5807
5808

5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819

5820

5821
5822
5823
5824
5825




5826
5827
5828
5829

5830
5831
5832
5833
5834
5835
5836




5837
5838

5839
5840
5841
5842
5843
5844
5845
5846
5847



5848
5849
5850
5851
5852
5853
5854





























5855
5856
5857
5858



5859
5860

5861
5862

5863
5864
5865

5866
5867
5868
5869
5870
5871
5872
5873

5874
5875
5876
5877
5878



5879








5880
5881
5882














5883
5884
5885
5886
5887



5888
5889
5890
5891
5892

5893
5894
5895
5896
5897
5898
5899







5900
5901
5902
5903
5904











5905
5906
5907
5908
5909










5910
5911
5912
5913
5914
5915
5916












5917
5918
5919


5920
5921
5922
5923
5924




5925
5926
5927
5928
5929















5930
5931


5932
5933
5934
5935

5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
5950

5951
5952
5953
5954
5955
5956
5957
5958
5959
5960
5961
5962
5963
5964








5965

5966
5967


5968
5969
5970
5971
5972












5973
5974
5975
5976
5977
5978
5979

5980

5981
5982

5983
5984

5985
5986


5987

5988



5989



5990

5991

5992
5993

5994
5995

5996
5997
5998
5999
6000


6001
6002
6003

6004
6005
6006

6007
6008
6009

6010
6011
6012
6013


6014
6015
6016
6017
6018

6019
6020

6021

6022
6023
6024
6025
6026



6027
6028

6029
6030
6031
6032
6033

6034
6035
6036
6037
6038



6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050



6051
6052
6053

6054
6055
6056
6057




6058
6059
6060
6061


6062
6063
6064
6065
6066
6067
6068












6069
6070
6071
6072
6073
6074
6075
6076





6077
6078
6079
6080
6081
6082
6083
6084


6085
6086



6087
6088

6089
6090
6091
6092
6093
6094
6095
6096
6097
6098
6099
6100
6101
6102
6103

6104

6105

6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116



6117
6118
6119
6120
6121
6122
6123
6124
6125
6126
6127
6128

6129
6130
6131
6132
6133
6134
6135
6136
6137
6138
6139









6140
6141
6142
6143
6144
6145
6146
6147
6148
6149
6150
6151
6152
6153

6154
6155

6156
6157
6158
6159
6160
6161

6162
6163
6164
6165

6166

6167
6168
6169
6170
6171


6172
6173
6174
6175
6176





6177
6178
6179
6180
6181
6182
6183










6184
6185
6186
6187
6188
6189
6190
6191


6192
6193

6194
6195
6196
6197
6198
6199
6200
6201
6202






6203
6204
6205
6206
6207
6208
6209
6210
6211
6212












6213
6214
6215
6216




















6217
6218






6219
6220
6221




6222
6223
6224
6225
6226
6227
6228
6229






6230
6231


6232
6233
6234



6235
6236
6237
6238




6239
6240
6241
6242
6243





6244
6245
6246



6247
6248


6249
6250
6251
6252

6253
6254
6255
6256
6257





6258
6259
6260
6261




6262
6263
6264
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
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
6390
6391
6392
6393
6394
6395
6396
6397
6398

6399
6400
6401
6402
6403
6404
6405
6406
6407


6408
6409
6410
6411
6412
6413
6414





6415
6416
6417
6418
6419



6420
6421
6422

















6423
6424
6425

6426
6427
6428
6429
6430







6431
6432
6433

6434
6435
6436
6437
6438



6439
6440
6441
6442
6443
6444


6445
6446
6447

6448
6449
6450

6451

6452
6453
6454





6455
6456

6457
6458
6459
6460
6461










































6462
6463

6464
6465




















6466
6467


6468
6469


6470
6471

6472
6473
6474
6475
6476
6477







6478
6479

6480
6481
6482
6483
6484


6485
6486

6487
6488
6489
6490
6491
6492



6493
6494
6495
6496
6497
6498
6499
6500
6501
6502




6503
6504
6505
6506
6507
6508
6509


6510
6511
6512

6513
6514
6515

6516
6517
6518
6519
6520
6521
6522
6523
6524







6525
6526
6527
6528
6529

6530
6531
6532
6533
6534
6535
6536
6537
6538
6539
6540



6541
6542
6543


6544
6545
6546
6547
6548



6549
6550
6551


6552

6553
6554

6555

6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
6569
6570
6571
6572
6573
6574
6575
6576
6577
6578
6579
6580

6581
6582
6583
6584
6585
6586
6587
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
4955
4956
4957
4958
4959
4960
4961
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
5016
5017
5018
5019
5020
5021
5022
5023

5024






5025
5026
5027
5028
5029
5030
5031

5032


5033
5034
5035

5036
5037
5038



5039


5040



5041

5042














































5043



5044
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
5095
5096
5097


5098
5099
5100
5101
5102
5103
5104
5105


5106
5107
5108







5109
5110
5111
5112
5113
5114
5115
5116
5117
5118
5119
5120
5121
5122
5123
5124
5125
5126
5127
5128
5129
5130
5131
5132
5133
5134
5135
5136
5137




5138
5139
5140


5141


5142



5143








5144





5145
5146
5147
5148
5149
5150
5151
5152
5153
5154
5155
5156



5157
5158
5159
5160
5161
5162
5163
5164
5165
5166
5167
5168
5169
5170





5171
5172
5173





5174


5175




5176
5177
5178
5179
5180
5181
5182





5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193





5194
5195
5196
5197
5198
5199
5200
5201
5202
5203







5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215



5216
5217





5218
5219
5220
5221





5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233
5234
5235
5236


5237
5238
5239

5240

5241
5242
5243
5244
5245
5246










5247
5248
5249
5250
5251
5252
5253
5254
5255






5256
5257
5258
5259
5260
5261
5262
5263
5264
5265


5266
5267
5268




5269
5270
5271
5272
5273
5274
5275
5276
5277
5278
5279
5280
5281
5282
5283
5284
5285
5286
5287
5288

5289


5290
5291
5292
5293


5294
5295

5296
5297
5298
5299
5300
5301
5302
5303
5304
5305
5306

5307


5308
5309

5310
5311

5312


5313
5314

5315

5316
5317
5318

5319



5320
5321
5322


5323
5324
5325
5326
5327
5328

5329

5330
5331

5332

5333



5334
5335
5336
5337

5338
5339
5340



5341

5342
5343


5344
5345
5346
5347
5348
5349
5350








5351
5352
5353
5354
5355

5356
5357
5358
5359
5360
5361
5362
5363
5364
5365
5366
5367
5368
5369
5370
5371
5372





5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387





5388
5389
5390
5391
5392
5393


5394
5395
5396
5397
5398
5399
5400


5401
5402
5403
5404

5405

5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418

5419
5420
5421

5422





5423
5424
5425



5426
5427
5428






5429



5430

5431


5432
5433







5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444

5445
5446
5447
5448
5449
5450
5451
5452
5453
5454

5455
5456

5457


5458
5459


5460




5461
5462
5463
5464
5465
5466


5467
5468
5469
5470



5471
5472
5473
5474
5475







5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486







5487
5488


5489









5490
5491
5492
5493
5494
5495










5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507




5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527


5528
5529
5530
5531
5532
5533



5534
5535
5536
5537








5538
5539
5540
5541
5542
5543


5544
5545



5546
5547
5548




5549
5550
5551
5552





5553
5554
5555
5556
5557



5558
5559
5560


5561
5562




5563





5564
5565
5566
5567
5568




5569
5570
5571
5572





5573
5574
5575
5576
5577



5578
5579
5580






5581
5582
5583
5584
5585
5586



5587
















5588
5589
5590
5591
5592
5593
5594
5595
5596
5597
5598
5599
5600
5601
5602
5603




5604
5605
5606
5607
5608
5609
5610
5611
5612
5613
5614
5615
5616
5617
5618
5619
5620


5621
5622




5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635


5636



5637






5638
5639



5640
5641
5642
5643
5644
5645





5646
5647
5648
5649










5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661


5662
5663


5664



















5665
5666



5667




5668












5669


5670





5671



5672
5673










5674
5675








5676
5677
5678
5679
5680




5681
5682
5683
5684
5685





5686
5687
5688



5689
5690
5691
5692
5693
5694
5695
5696
5697
5698
5699
5700
5701
5702
5703
5704
5705



5706





5707
5708
5709
5710
5711
5712
5713
5714
5715

5716





5717
5718
5719






5720
5721



5722
5723
5724

5725
5726
5727



5728
5729
5730
5731
5732
5733

5734





5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777

5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800


5801
5802


5803
5804


5805






5806
5807
5808
5809
5810
5811
5812


5813





5814
5815


5816






5817
5818
5819










5820
5821
5822
5823
5824






5825
5826
5827
5828

5829
5830
5831

5832









5833
5834
5835
5836
5837
5838
5839





5840











5841
5842
5843



5844
5845





5846
5847
5848

5849

5850
5851
5852
5853
5854

5855
5856
5857
5858



5859
5860
5861
5862
5863
5864
5865
5866
5867
5868
5869
5870
5871
5872
5873
5874
5875
5876
5877
5878

5879




5880
5881
5882







-
















-
+



















-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
+
+
+
+



-
+


+
-
+

-
+
-
-
+

-

-
+


-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+

-
+
-
-
-
-
-
-

-
-
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
+
+
+
+
+
+




-


+
-
+
-
-
+
-
-
-
+
+







-
+
-


-
-
+
+
-
-
+









-

-
-
-
-
-
-
+
+
+
+
+
+

-
+
-
-
+


-
+


-
-
-
+
-
-
+
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-

-
+
-
-
-

-
-
+
-
-
-
+
-
-
-





-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
+
-
-
-

-
-
-
-
+

-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-





-
+





-
-
-
-
-

+
-
+


-
-
-
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
+







-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
+

+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
+
-
-

-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+

-

-
+





-
-
-
-
-
-
-
-
-
-
+








-
-
-
-
-
-
+
+
+
+
+
+
+
+

+
-
-
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+







+
-
+
-
-
+


+
-
-
+
+
-
+

+
+
+

+
+
+

+
-
+
-
-
+

-
+

-

-
-
+
+
-

-
+


-
+
-
-
-
+


-
-
+
+




-
+
-

+
-
+
-

-
-
-
+
+
+

-
+


-
-
-
+
-


-
-
+
+
+




-
-
-
-
-
-
-
-
+
+
+


-
+




+
+
+
+




+
+


-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+

-
-





+
+
-
-
+
+
+

-
+
-













-
+

+
-
+
-
-
-
-
-



-
-
-
+
+
+
-
-
-
-
-
-

-
-
-

-
+
-
-


-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-










-
+

-
+
-
-


-
-
+
-
-
-
-
+

+



-
-
+
+


-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
+
+
-
-
-
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
+
+
-
-
-
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-

+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
+
+



-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+


-
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
+


-
+

+
-
-
-
+
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+


-
+


-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
-
-
-
-
-
+
+
+
-

-
+
+

+

-
+

+

-
-
-




















-
+
-
-
-
-











# win only















ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest"
                                        ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest"

cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs, see configure's option --config-cache.
# It is not useful on other systems.  If it contains results you don't
# want to keep, you may remove or edit it.
#
# config.status only pays attention to the cache file if you give it
# the --recheck option to rerun configure.
#
# `ac_cv_env_foo' variables (set or unset) will be overridden when
# loading this file, other *unset* `ac_cv_foo' will be assigned the
# following values.

_ACEOF

# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
# So, we kill variables containing newlines.
# So, don't put newlines in cache variables' values.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(
  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
    eval ac_val=\$$ac_var
    case $ac_val in #(
    *${as_nl}*)
      case $ac_var in #(
      *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
      esac
      case $ac_var in #(
      _ | IFS | as_nl) ;; #(
      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
      *) { eval $ac_var=; unset $ac_var;} ;;
      esac ;;
    esac
  done

{
  (set) 2>&1 |
    case $as_nl`(ac_space=' '; set) 2>&1` in #(
    *${as_nl}ac_space=\ *)
      # `set' does not quote correctly, so add quotes: double-quote
      # substitution turns \\\\ into \\, and sed turns \\ into \.
    case `(ac_space=' '; set | grep ac_space) 2>&1` in
    *ac_space=\ *)
      # `set' does not quote correctly, so add quotes (double-quote
      # substitution turns \\\\ into \\, and sed turns \\ into \).
      sed -n \
	"s/'/'\\\\''/g;
	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
      ;; #(
      ;;
    *)
      # `set' quotes correctly as required by POSIX, so do not add quotes.
      sed -n \
      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
	"s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
      ;;
    esac |
    esac;
    sort
) |
} |
  sed '
     /^ac_cv_env_/b end
     t clear
     :clear
     : clear
     s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
     t end
     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
     :end' >>confcache
if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
  if test -w "$cache_file"; then
    if test "x$cache_file" != "x/dev/null"; then
     /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
     : end' >>confcache
if diff $cache_file confcache >/dev/null 2>&1; then :; else
  if test -w $cache_file; then
    test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
      { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
$as_echo "$as_me: updating cache $cache_file" >&6;}
      if test ! -f "$cache_file" || test -h "$cache_file"; then
	cat confcache >"$cache_file"
      else
    cat confcache >$cache_file
  else
        case $cache_file in #(
        */* | ?:*)
	  mv -f confcache "$cache_file"$$ &&
	  mv -f "$cache_file"$$ "$cache_file" ;; #(
        *)
	  mv -f confcache "$cache_file" ;;
	esac
      fi
    fi
  else
    { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
    echo "not updating unwritable cache $cache_file"
  fi
fi
rm -f confcache

test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'

# VPATH may cause trouble with some makes, so we remove $(srcdir),
# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
  ac_vpsub='/^[	 ]*VPATH[	 ]*=/{
s/:*\$(srcdir):*/:/;
s/:*\${srcdir}:*/:/;
s/:*@srcdir@:*/:/;
s/^\([^=]*=[	 ]*\):*/\1/;
s/:*$//;
s/^[^=]*=[	 ]*$//;
}'
fi

# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
# take arguments), then branch to the quote section.  Otherwise,
# take arguments), then we branch to the quote section.  Otherwise,
# look for a macro that doesn't take arguments.
ac_script='
cat >confdef2opt.sed <<\_ACEOF
:mline
/\\$/{
 N
 s,\\\n,,
 b mline
}
t clear
:clear
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\)/-D\1=\2/g
: clear
s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 (][^	 (]*([^)]*)\)[	 ]*\(.*\),-D\1=\2,g
t quote
s/^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\)/-D\1=\2/g
s,^[	 ]*#[	 ]*define[	 ][	 ]*\([^	 ][^	 ]*\)[	 ]*\(.*\),-D\1=\2,g
t quote
b any
:quote
s/[	 `~#$^&*(){}\\|;'\''"<>?]/\\&/g
s/\[/\\&/g
s/\]/\\&/g
s/\$/$$/g
d
: quote
s,[	 `~#$^&*(){}\\|;'"<>?],\\&,g
s,\[,\\&,g
s,\],\\&,g
s,\$,$$,g
H
:any
${
	g
	s/^\n//
	s/\n/ /g
	p
p
}
'
DEFS=`sed -n "$ac_script" confdefs.h`
_ACEOF
# We use echo to avoid assuming a particular line-breaking character.
# The extra dot is to prevent the shell from consuming trailing
# line-breaks from the sub-command output.  A line-break within
# single-quotes doesn't work because, if this script is created in a
# platform that uses two characters for line-breaks (e.g., DOS), tr
# would break.
ac_LF_and_DOT=`echo; echo .`
DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
rm -f confdef2opt.sed


ac_libobjs=
ac_ltlibobjs=
U=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
  # 1. Remove the extension, and $U if already installed.
  ac_i=`echo "$ac_i" |
  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
	 sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
  ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
  # 2. Add them.
  #    will be set to the directory where LIBOBJS objects are built.
  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
  ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
  ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs

LTLIBOBJS=$ac_ltlibobjs



: "${CONFIG_STATUS=./config.status}"
: ${CONFIG_STATUS=./config.status}
ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
echo "$as_me: creating $CONFIG_STATUS" >&6;}
as_write_fail=0
cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
cat >$CONFIG_STATUS <<_ACEOF
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
# Compiler output produced by configure, useful for debugging
# configure, is in config.log if it exists.

debug=false
ac_cs_recheck=false
ac_cs_silent=false

SHELL=\${CONFIG_SHELL-$SHELL}
export SHELL
_ASEOF
cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
## -------------------- ##
## M4sh Initialization. ##
## -------------------- ##
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF
## --------------------- ##
## M4sh Initialization.  ##
## --------------------- ##

# Be more Bourne compatible
# Be Bourne compatible
DUALCASE=1; export DUALCASE # for MKS sh
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
  emulate sh
  NULLCMD=:
  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
  # is contrary to our usage.  Disable this feature.
  alias -g '${1+"$@"}'='"$@"'
  setopt NO_GLOB_SUBST
else
  case `(set -o) 2>/dev/null` in #(
elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
  *posix*) :
    set -o posix ;; #(
  set -o posix
  *) :
     ;;
esac
fi

DUALCASE=1; export DUALCASE # for MKS sh

as_nl='
'
export as_nl
# Printing a long string crashes Solaris 7 /usr/bin/printf.
as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
# Prefer a ksh shell builtin over an external printf program on Solaris,
# but without wasting forks for bash or zsh.
if test -z "$BASH_VERSION$ZSH_VERSION" \
    && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='print -r --'
  as_echo_n='print -rn --'
elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
  as_echo='printf %s\n'
  as_echo_n='printf %s'
else
  if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
    as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
    as_echo_n='/usr/ucb/echo -n'
  else
    as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
    as_echo_n_body='eval
      arg=$1;
      case $arg in #(
      *"$as_nl"*)
	expr "X$arg" : "X\\(.*\\)$as_nl";
	arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
      esac;
      expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
    '
    export as_echo_n_body
    as_echo_n='sh -c $as_echo_n_body as_echo'
  fi
  export as_echo_body
  as_echo='sh -c $as_echo_body as_echo'
fi

# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  PATH_SEPARATOR=:
  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
      PATH_SEPARATOR=';'
  }

fi


# Support unset when possible.
if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
# IFS
# We need space, tab and new line, in precisely that order.  Quoting is
# there to prevent editors from complaining about space-tab.
# (If _AS_PATH_WALK were called with IFS unset, it would disable word
# splitting by setting IFS to empty value.)
IFS=" ""	$as_nl"

  as_unset=unset
# Find who we are.  Look in the path if we contain no directory separator.
as_myself=
else
case $0 in #((
  *[\\/]* ) as_myself=$0 ;;
  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
    test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
  done
IFS=$as_save_IFS

  as_unset=false
     ;;
esac
# We did not find ourselves, most probably we were run as `sh COMMAND'
# in which case we are not to be found in the path.
if test "x$as_myself" = x; then
  as_myself=$0
fi
if test ! -f "$as_myself"; then

  $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
  exit 1
fi

# Unset variables that we do not need and which cause bugs (e.g. in
# pre-3.0 UWIN ksh).  But do not cause bugs in bash 2.01; the "|| exit 1"
# Work around bugs in pre-3.0 UWIN ksh.
# suppresses any "Segmentation fault" message there.  '((' could
# trigger a bug in pdksh 5.2.14.
for as_var in BASH_ENV ENV MAIL MAILPATH
$as_unset ENV MAIL MAILPATH
do eval test x\${$as_var+set} = xset \
  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
done
PS1='$ '
PS2='> '
PS4='+ '

# NLS nuisances.
LC_ALL=C
export LC_ALL
LANGUAGE=C
export LANGUAGE

for as_var in \
  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
  LC_TELEPHONE LC_TIME
do
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH


  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
    eval $as_var=C; export $as_var
# as_fn_error STATUS ERROR [LINENO LOG_FD]
# ----------------------------------------
# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
# script with STATUS, using 1 if that was 0.
as_fn_error ()
  else
{
  as_status=$1; test $as_status -eq 0 && as_status=1
    $as_unset $as_var
  if test "$4"; then
    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
    $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
  fi
  $as_echo "$as_me: error: $2" >&2
  as_fn_exit $as_status
} # as_fn_error

done

# as_fn_set_status STATUS
# -----------------------
# Set $? to STATUS, without forking.
as_fn_set_status ()
{
  return $1
} # as_fn_set_status

# Required to use basename.
# as_fn_exit STATUS
# -----------------
# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
as_fn_exit ()
{
  set +e
  as_fn_set_status $1
  exit $1
} # as_fn_exit

# as_fn_unset VAR
# ---------------
# Portably unset VAR.
as_fn_unset ()
{
  { eval $1=; unset $1;}
}
as_unset=as_fn_unset
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
# advantage of any shell optimizations that allow amortized linear growth over
# repeated appends, instead of the typical quadratic growth present in naive
# implementations.
if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
  eval 'as_fn_append ()
  {
    eval $1+=\$2
  }'
else
  as_fn_append ()
  {
    eval $1=\$$1\$2
  }
fi # as_fn_append

# as_fn_arith ARG...
# ------------------
# Perform arithmetic evaluation on the ARGs, and store the result in the
# global $as_val. Take advantage of shells that can avoid forks. The arguments
# must be portable across $(()) and expr.
if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
  eval 'as_fn_arith ()
  {
    as_val=$(( $* ))
  }'
else
  as_fn_arith ()
  {
    as_val=`expr "$@" || test $? -eq 1`
  }
fi # as_fn_arith


if expr a : '\(a\)' >/dev/null 2>&1 &&
if expr a : '\(a\)' >/dev/null 2>&1; then
   test "X`expr 00001 : '.*\(...\)'`" = X001; then
  as_expr=expr
else
  as_expr=false
fi

if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
  as_basename=basename
else
  as_basename=false
fi

if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
  as_dirname=dirname
else
  as_dirname=false
fi

# Name of the executable.
as_me=`$as_basename -- "$0" ||
as_me=`$as_basename "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
	 X"$0" : 'X\(//\)$' \| \
	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{
	 X"$0" : 'X\(/\)$' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X/"$0" |
    sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\/\)$/{
  	  /^X\/\(\/\/\)$/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  /^X\/\(\/\).*/{
	    s//\1/
	    q
	  }
  	  /^X\/\(\/\).*/{ s//\1/; q; }
  	  s/.*/./; q'`


	  s/.*/./; q'`

# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits

ECHO_C= ECHO_N= ECHO_T=
case `echo -n x` in #(((((
# The user is always right.
if test "${PATH_SEPARATOR+set}" != set; then
  echo "#! /bin/sh" >conf$$.sh
-n*)
  case `echo 'xy\c'` in
  *c*) ECHO_T='	';;	# ECHO_T is single tab character.
  xy)  ECHO_C='\c';;
  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null
       ECHO_T='	';;
  esac;;
  echo  "exit 0"   >>conf$$.sh
  chmod +x conf$$.sh
  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
    PATH_SEPARATOR=';'
  else
    PATH_SEPARATOR=:
  fi
  rm -f conf$$.sh
fi


  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2"  || {
  # Find who we are.  Look in the path if we contain no path at all
  # relative or not.
  case $0 in
    *[\\/]* ) as_myself=$0 ;;
    *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
done

       ;;
*)
  ECHO_N='-n';;
esac

  esac
  # We did not find ourselves, most probably we were run as `sh COMMAND'
  # in which case we are not to be found in the path.
rm -f conf$$ conf$$.exe conf$$.file
if test -d conf$$.dir; then
  if test "x$as_myself" = x; then
  rm -f conf$$.dir/conf$$.file
else
    as_myself=$0
  rm -f conf$$.dir
  mkdir conf$$.dir 2>/dev/null
fi
  fi
if (echo >conf$$.file) 2>/dev/null; then
  if ln -s conf$$.file conf$$ 2>/dev/null; then
    as_ln_s='ln -s'
    # ... but there are two gotchas:
    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
    # In both cases, we have to default to `cp -pR'.
    ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
  if test ! -f "$as_myself"; then
      as_ln_s='cp -pR'
  elif ln conf$$.file conf$$ 2>/dev/null; then
    as_ln_s=ln
  else
    as_ln_s='cp -pR'
    { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
   { (exit 1); exit 1; }; }
  fi
  case $CONFIG_SHELL in
  '')
    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
  IFS=$as_save_IFS
  test -z "$as_dir" && as_dir=.
  for as_base in sh bash ksh sh5; do
else
  as_ln_s='cp -pR'
fi
	 case $as_dir in
	 /*)
	   if ("$as_dir/$as_base" -c '
  as_lineno_1=$LINENO
  as_lineno_2=$LINENO
  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
  test "x$as_lineno_1" != "x$as_lineno_2" &&
  test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then
	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
	     CONFIG_SHELL=$as_dir/$as_base
	     export CONFIG_SHELL
	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}
	   fi;;
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null


# as_fn_mkdir_p
	 esac
       done
done
# -------------
# Create "$as_dir" as a directory, including parents if necessary.
as_fn_mkdir_p ()
{

;;
  case $as_dir in #(
  -*) as_dir=./$as_dir;;
  esac
  test -d "$as_dir" || eval $as_mkdir_p || {
    as_dirs=
    while :; do
      case $as_dir in #(

  # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
  # uniformly replaced by the line number.  The first 'sed' inserts a
  # line-number line before each line; the second 'sed' does the real
  # work.  The second script uses 'N' to pair each line-number line
  # with the numbered line, and appends trailing '-' during
  # substitution so that $LINENO is not a special case at line end.
      *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
      *) as_qdir=$as_dir;;
      esac
      as_dirs="'$as_qdir' $as_dirs"
      as_dir=`$as_dirname -- "$as_dir" ||
  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
  # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)
  sed '=' <$as_myself |
    sed '
      N
      s,$,-,
      : loop
      s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
      t loop
      s,-$,,
      s,^['$as_cr_digits']*\n,,
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$as_dir" |
    ' >$as_me.lineno &&
  chmod +x $as_me.lineno ||
    { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
   { (exit 1); exit 1; }; }

  # Don't try to exec as it changes $[0], causing all sort of problems
  # (the dirname of $[0] is not the place where we might find the
  # original and so on.  Autoconf is especially sensible to this).
  . ./$as_me.lineno
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
  # Exit status is that of the last command.
  exit
}


case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
  *c*,-n*) ECHO_N= ECHO_C='
' ECHO_T='	' ;;
  *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;
  *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;
esac

	  }
	  /^X\(\/\/\)$/{
	    s//\1/
if expr a : '\(a\)' >/dev/null 2>&1; then
  as_expr=expr
	    q
	  }
	  /^X\(\/\).*/{
	    s//\1/
	    q
else
  as_expr=false
fi

	  }
	  s/.*/./; q'`
      test -d "$as_dir" && break
    done
    test -z "$as_dirs" || eval "mkdir $as_dirs"
rm -f conf$$ conf$$.exe conf$$.file
echo >conf$$.file
if ln -s conf$$.file conf$$ 2>/dev/null; then
  # We could just check for DJGPP; but this test a) works b) is more generic
  # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
  if test -f conf$$.exe; then
    # Don't use ln at all; we don't have any links
    as_ln_s='cp -p'
  else
    as_ln_s='ln -s'
  fi
elif ln conf$$.file conf$$ 2>/dev/null; then
  as_ln_s=ln
else
  as_ln_s='cp -p'
  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"

fi
rm -f conf$$ conf$$.exe conf$$.file

} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
  as_mkdir_p='mkdir -p "$as_dir"'
  as_mkdir_p=:
else
  test -d ./-p && rmdir ./-p
  as_mkdir_p=false
fi


# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
  test -f "$1" && test -x "$1"
} # as_fn_executable_p
as_test_x='test -x'
as_executable_p=as_fn_executable_p
as_executable_p="test -f"

# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"

# Sed expression to map a string onto a valid variable name.
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"


exec 6>&1
## ----------------------------------- ##
## Main body of $CONFIG_STATUS script. ##
## ----------------------------------- ##
_ASEOF
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
# IFS
# We need space, tab and new line, in precisely that order.
as_nl='
'
IFS=" 	$as_nl"

# CDPATH.
$as_unset CDPATH

exec 6>&1
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to

# Open the log real soon, to keep \$[0] and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by $as_me, which was
generated by GNU Autoconf 2.69.  Invocation command line was
# values after options handling.  Logging --version etc. is OK.
exec 5>>config.log
{
  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
} >&5
cat >&5 <<_CSEOF

This file was extended by tcl $as_me 8.5, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 $@

_CSEOF
on `(hostname || uname -n) 2>/dev/null | sed 1q`
echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
"

echo >&5
_ACEOF

# Files that config.status was made for.
case $ac_config_files in *"
"*) set x $ac_config_files; shift; ac_config_files=$*;;
if test -n "$ac_config_files"; then
  echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
esac
fi

if test -n "$ac_config_headers"; then
  echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
fi

if test -n "$ac_config_links"; then
  echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
fi

if test -n "$ac_config_commands"; then
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
  echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
# Files that config.status was made for.
config_files="$ac_config_files"
fi

_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
\`$as_me' instantiates files and other configuration actions
from templates according to the current configuration.  Unless the files
\`$as_me' instantiates files from templates according to the
current configuration.
and actions are specified as TAGs, all are instantiated by default.

Usage: $0 [OPTION]... [TAG]...
Usage: $0 [OPTIONS] [FILE]...

  -h, --help       print this help, then exit
  -V, --version    print version number and configuration settings, then exit
  -V, --version    print version number, then exit
      --config     print configuration, then exit
  -q, --quiet, --silent
                   do not print progress messages
  -q, --quiet      do not print progress messages
  -d, --debug      don't remove temporary files
      --recheck    update $as_me by reconfiguring in the same conditions
      --file=FILE[:TEMPLATE]
                   instantiate the configuration file FILE
  --file=FILE[:TEMPLATE]
		   instantiate the configuration file FILE

Configuration files:
$config_files

Report bugs to the package provider."
Report bugs to <bug-autoconf@gnu.org>."

_ACEOF

cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
config.status
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"
tcl config.status 8.5
configured by $0, generated by GNU Autoconf 2.59,
  with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2012 Free Software Foundation, Inc.
Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

ac_pwd='$ac_pwd'
srcdir='$srcdir'
srcdir=$srcdir
test -n "\$AWK" || AWK=awk
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# The default lists apply if the user does not specify any file.
cat >>$CONFIG_STATUS <<\_ACEOF
# If no file are specified by the user, then we need to provide default
# value.  By we need to know if files were specified by the user.
ac_need_defaults=:
while test $# != 0
do
  case $1 in
  --*=?*)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
    ac_shift=:
    ;;
  --*=)
    ac_option=`expr "X$1" : 'X\([^=]*\)='`
    ac_optarg=
  --*=*)
    ac_option=`expr "x$1" : 'x\([^=]*\)='`
    ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
    ac_shift=:
    ;;
  *)
  -*)
    ac_option=$1
    ac_optarg=$2
    ac_shift=shift
    ;;
  *) # This is not an option, so the user has probably given explicit
     # arguments.
     ac_option=$1
     ac_need_defaults=false;;
  esac

  case $ac_option in
  # Handling of the options.
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
    ac_cs_recheck=: ;;
  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
    $as_echo "$ac_cs_version"; exit ;;
  --config | --confi | --conf | --con | --co | --c )
    $as_echo "$ac_cs_config"; exit ;;
  --debug | --debu | --deb | --de | --d | -d )
  --version | --vers* | -V )
    echo "$ac_cs_version"; exit 0 ;;
  --he | --h)
    # Conflict between --help and --header
    { { echo "$as_me:$LINENO: error: ambiguous option: $1
Try \`$0 --help' for more information." >&5
echo "$as_me: error: ambiguous option: $1
Try \`$0 --help' for more information." >&2;}
   { (exit 1); exit 1; }; };;
  --help | --hel | -h )
    echo "$ac_cs_usage"; exit 0 ;;
  --debug | --d* | -d )
    debug=: ;;
  --file | --fil | --fi | --f )
    $ac_shift
    case $ac_optarg in
    *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
    '') as_fn_error $? "missing file argument" ;;
    esac
    as_fn_append CONFIG_FILES " '$ac_optarg'"
    CONFIG_FILES="$CONFIG_FILES $ac_optarg"
    ac_need_defaults=false;;
  --header | --heade | --head | --hea )
    $ac_shift
    CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
    ac_need_defaults=false;;
  --he | --h |  --help | --hel | -h )
    $as_echo "$ac_cs_usage"; exit ;;
  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
  | -silent | --silent | --silen | --sile | --sil | --si | --s)
    ac_cs_silent=: ;;

  # This is an error.
  -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
Try \`$0 --help' for more information." >&5
  -*) as_fn_error $? "unrecognized option: \`$1'
Try \`$0 --help' for more information." ;;
echo "$as_me: error: unrecognized option: $1
Try \`$0 --help' for more information." >&2;}
   { (exit 1); exit 1; }; } ;;

  *) as_fn_append ac_config_targets " $1"
  *) ac_config_targets="$ac_config_targets $1" ;;
     ac_need_defaults=false ;;

  esac
  shift
done

ac_configure_extra_args=

if $ac_cs_silent; then
  exec 6>/dev/null
  ac_configure_extra_args="$ac_configure_extra_args --silent"
fi

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<_ACEOF
if \$ac_cs_recheck; then
  echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
  exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
  shift
  \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
  CONFIG_SHELL='$SHELL'
  export CONFIG_SHELL
  exec "\$@"
fi

_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
exec 5>>config.log
{



  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
  $as_echo "$ac_log"
} >&5

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<\_ACEOF

# Handling of arguments.
for ac_config_target in $ac_config_targets
do
  case $ac_config_target in
    "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
    "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;;
    "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
    "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;;

  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
  case "$ac_config_target" in
  # Handling of arguments.
  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
  "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;;
  "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
  "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;;
  *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
   { (exit 1); exit 1; }; };;
  esac
done


# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used.  Set only those that are not.
# We use the long form for the default assignment because of an extremely
# bizarre bug on SunOS 4.1.3.
if $ac_need_defaults; then
  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
fi

# Have a temporary directory for convenience.  Make it in the build tree
# simply because there is no reason against having it here, and in addition,
# simply because there is no reason to put it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
# Hook for its removal unless debugging.
# Create a temporary directory, and hook for its removal unless debugging.
# Note that there is a small window in which the directory will not be cleaned:
# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
  tmp= ac_tmp=
  trap 'exit_status=$?
  trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
  : "${ac_tmp:=$tmp}"
  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
' 0
  trap 'as_fn_exit 1' 1 2 13 15
  trap '{ (exit 1); exit 1; }' 1 2 13 15
}

# Create a (secure) tmp directory for tmp files.

{
  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
  test -d "$tmp"
  tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
  test -n "$tmp" && test -d "$tmp"
}  ||
{
  tmp=./conf$$-$RANDOM
  (umask 077 && mkdir "$tmp")
} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
  tmp=./confstat$$-$RANDOM
  (umask 077 && mkdir $tmp)
} ||
{
   echo "$me: cannot create a temporary directory in ." >&2
ac_tmp=$tmp

# Set up the scripts for CONFIG_FILES section.
# No need to generate them if there are no CONFIG_FILES.
# This happens for instance with `./config.status config.h'.
if test -n "$CONFIG_FILES"; then

   { (exit 1); exit 1; }
}

_ACEOF

cat >>$CONFIG_STATUS <<_ACEOF

#
# CONFIG_FILES section.
#

ac_cr=`echo X | tr X '\015'`
# On cygwin, bash can eat \r inside `` if the user requested igncr.
# But we know of no other shell where ac_cr would be empty at this
# point, so we can use a bashism as a fallback.
if test "x$ac_cr" = x; then
  eval ac_cr=\$\'\\r\'
fi
# No need to generate the scripts if there are no CONFIG_FILES.
# This happens for instance when ./config.status config.h
ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
if test -n "\$CONFIG_FILES"; then
  ac_cs_awk_cr='\\r'
else
  ac_cs_awk_cr=$ac_cr
fi

echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
_ACEOF


  # Protect against being on the right side of a sed subst in config.status.
  sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
   s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
s,@SHELL@,$SHELL,;t t
s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
{
  echo "cat >conf$$subs.awk <<_ACEOF" &&
  echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
  echo "_ACEOF"
} >conf$$subs.sh ||
  as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
ac_delim='%!_!# '
for ac_last_try in false false false false false :; do
  . ./conf$$subs.sh ||
s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
s,@exec_prefix@,$exec_prefix,;t t
s,@prefix@,$prefix,;t t
s,@program_transform_name@,$program_transform_name,;t t
s,@bindir@,$bindir,;t t
s,@sbindir@,$sbindir,;t t
s,@libexecdir@,$libexecdir,;t t
s,@datadir@,$datadir,;t t
s,@sysconfdir@,$sysconfdir,;t t
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5

  ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
  if test $ac_delim_n = $ac_delim_num; then
s,@sharedstatedir@,$sharedstatedir,;t t
s,@localstatedir@,$localstatedir,;t t
s,@libdir@,$libdir,;t t
s,@includedir@,$includedir,;t t
s,@oldincludedir@,$oldincludedir,;t t
s,@infodir@,$infodir,;t t
s,@mandir@,$mandir,;t t
s,@build_alias@,$build_alias,;t t
s,@host_alias@,$host_alias,;t t
s,@target_alias@,$target_alias,;t t
s,@DEFS@,$DEFS,;t t
s,@ECHO_C@,$ECHO_C,;t t
s,@ECHO_N@,$ECHO_N,;t t
s,@ECHO_T@,$ECHO_T,;t t
s,@LIBS@,$LIBS,;t t
s,@CC@,$CC,;t t
s,@CFLAGS@,$CFLAGS,;t t
s,@LDFLAGS@,$LDFLAGS,;t t
s,@CPPFLAGS@,$CPPFLAGS,;t t
s,@ac_ct_CC@,$ac_ct_CC,;t t
    break
  elif $ac_last_try; then
s,@EXEEXT@,$EXEEXT,;t t
s,@OBJEXT@,$OBJEXT,;t t
s,@CPP@,$CPP,;t t
s,@EGREP@,$EGREP,;t t
s,@AR@,$AR,;t t
s,@ac_ct_AR@,$ac_ct_AR,;t t
    as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
  else
    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
s,@RANLIB@,$RANLIB,;t t
s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
s,@RC@,$RC,;t t
s,@ac_ct_RC@,$ac_ct_RC,;t t
  fi
done
rm -f conf$$subs.sh

cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
_ACEOF
sed -n '
s,@SET_MAKE@,$SET_MAKE,;t t
s,@TCL_THREADS@,$TCL_THREADS,;t t
s,@CYGPATH@,$CYGPATH,;t t
s,@CELIB_DIR@,$CELIB_DIR,;t t
s,@DL_LIBS@,$DL_LIBS,;t t
s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t
h
s/^/S["/; s/!.*/"]=/
s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t
s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t
p
g
s/^[^!]*!//
s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t
s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t
s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t
:repl
t repl
s/'"$ac_delim"'$//
t delim
s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t
s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t
s,@MACHINE@,$MACHINE,;t t
s,@TCL_VERSION@,$TCL_VERSION,;t t
:nl
h
s/\(.\{148\}\)..*/\1/
t more1
s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t
s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t
s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t
s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t
p
n
b repl
s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t
s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t
s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t
:more1
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t
s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t
p
g
s/.\{148\}//
t nl
s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t
:delim
h
s/\(.\{148\}\)..*/\1/
t more2
s/["\\]/\\&/g; s/^/"/; s/$/"/
s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t
s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t
s,@TCL_DLL_FILE@,$TCL_DLL_FILE,;t t
s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t
s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t
p
b
:more2
s/["\\]/\\&/g; s/^/"/; s/$/"\\/
s,@TCL_DBGX@,$TCL_DBGX,;t t
s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t
s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t
s,@CFG_TCL_EXPORT_FILE_SUFFIX@,$CFG_TCL_EXPORT_FILE_SUFFIX,;t t
p
g
s/.\{148\}//
t delim
' <conf$$subs.awk | sed '
s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t
s,@DEPARG@,$DEPARG,;t t
s,@CC_OBJNAME@,$CC_OBJNAME,;t t
s,@CC_EXENAME@,$CC_EXENAME,;t t
s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t
/^[^""]/{
  N
  s/\n//
s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t
s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t
s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t
}
' >>$CONFIG_STATUS || ac_write_fail=1
rm -f conf$$subs.awk
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
_ACAWK
cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
s,@STLIB_LD@,$STLIB_LD,;t t
s,@SHLIB_LD@,$SHLIB_LD,;t t
s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t
s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t
s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t
s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t
  for (key in S) S_is_set[key] = 1
  FS = ""

s,@LIBS_GUI@,$LIBS_GUI,;t t
}
{
  line = $ 0
  nfields = split(line, field, "@")
  substed = 0
  len = length(field[1])
  for (i = 2; i < nfields; i++) {
    key = field[i]
    keylen = length(key)
    if (S_is_set[key]) {
      value = S[key]
      line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
      len += length(value) + length(field[++i])
      substed = 1
    } else
      len += 1 + keylen
s,@DLLSUFFIX@,$DLLSUFFIX,;t t
s,@LIBPREFIX@,$LIBPREFIX,;t t
s,@LIBSUFFIX@,$LIBSUFFIX,;t t
s,@EXESUFFIX@,$EXESUFFIX,;t t
s,@LIBRARIES@,$LIBRARIES,;t t
s,@MAKE_LIB@,$MAKE_LIB,;t t
s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t
s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t
s,@MAKE_DLL@,$MAKE_DLL,;t t
s,@MAKE_EXE@,$MAKE_EXE,;t t
s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t
s,@TCL_LD_SEARCH_FLAGS@,$TCL_LD_SEARCH_FLAGS,;t t
s,@TCL_NEEDS_EXP_FILE@,$TCL_NEEDS_EXP_FILE,;t t
s,@TCL_BUILD_EXP_FILE@,$TCL_BUILD_EXP_FILE,;t t
s,@TCL_EXP_FILE@,$TCL_EXP_FILE,;t t
s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t
  }

  print line
}
s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t
s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t
s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t
s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t
s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t
s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t
s,@RC_OUT@,$RC_OUT,;t t
s,@RC_TYPE@,$RC_TYPE,;t t
s,@RC_INCLUDE@,$RC_INCLUDE,;t t
s,@RC_DEFINE@,$RC_DEFINE,;t t
s,@RC_DEFINES@,$RC_DEFINES,;t t
s,@RES@,$RES,;t t
s,@LIBOBJS@,$LIBOBJS,;t t
s,@LTLIBOBJS@,$LTLIBOBJS,;t t
CEOF


_ACAWK
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
  sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
else
  cat >>$CONFIG_STATUS <<\_ACEOF
  # Split the substitutions into bite-sized pieces for seds with
  # small command number limits, like on Digital OSF/1 and HP-UX.
  ac_max_sed_lines=48
  ac_sed_frag=1 # Number of current file.
  ac_beg=1 # First line for current file.
  ac_end=$ac_max_sed_lines # Line after last line for current file.
  ac_more_lines=:
  ac_sed_cmds=
  while $ac_more_lines; do
    if test $ac_beg -gt 1; then
      sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
    else
  cat
fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
      sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
  || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF

    fi
# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
# trailing colons and then remove the whole line if VPATH becomes empty
# (actually we leave an empty line to preserve line numbers).
if test "x$srcdir" = x.; then
  ac_vpsub='/^[	 ]*VPATH[	 ]*=[	 ]*/{
    if test ! -s $tmp/subs.frag; then
      ac_more_lines=false
h
s///
s/^/:/
    else
      # The purpose of the label and of the branching condition is to
      # speed up the sed processing (if there are no `@' at all, there
      # is no need to browse any of the substitutions).
      # These are the two extra sed commands mentioned above.
      (echo ':t
s/[	 ]*$/:/
s/:\$(srcdir):/:/g
s/:\${srcdir}:/:/g
s/:@srcdir@:/:/g
s/^:*//
  /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
      if test -z "$ac_sed_cmds"; then
	ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
      else
s/:*$//
x
s/\(=[	 ]*\).*/\1/
G
s/\n//
s/^[^=]*=[	 ]*$//
}'
fi

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
	ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
      fi
      ac_sed_frag=`expr $ac_sed_frag + 1`
      ac_beg=$ac_end
      ac_end=`expr $ac_end + $ac_max_sed_lines`
    fi
  done
  if test -z "$ac_sed_cmds"; then
    ac_sed_cmds=cat
  fi
fi # test -n "$CONFIG_FILES"


eval set X "  :F $CONFIG_FILES      "
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF
shift
for ac_tag
for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
do
  case $ac_tag in
  :[FHLC]) ac_mode=$ac_tag; continue;;
  esac
  case $ac_mode$ac_tag in
  :[FHL]*:*);;
  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
  :[FH]-) ac_tag=-:-;;
  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
  esac
  ac_save_IFS=$IFS
  IFS=:
  set x $ac_tag
  IFS=$ac_save_IFS
  shift
  ac_file=$1
  shift

  case $ac_mode in
  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
  case $ac_file in
  :L) ac_source=$1;;
  :[FH])
    ac_file_inputs=
  - | *:- | *:-:* ) # input from stdin
    for ac_f
    do
      case $ac_f in
      -) ac_f="$ac_tmp/stdin";;
	cat >$tmp/stdin
      *) # Look for the file first in the build tree, then in the source tree
	 # (if the path is not absolute).  The absolute path cannot be DOS-style,
	 # because $ac_f cannot contain `:'.
	 test -f "$ac_f" ||
	   case $ac_f in
	   [\\/$]*) false;;
	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
	   esac ||
	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
      esac
      case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
      as_fn_append ac_file_inputs " '$ac_f'"
	ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
    done

	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
    # Let's still pretend it is `configure' which instantiates (i.e., don't
    # use $as_me), people would be surprised to read:
    #    /* config.h.  Generated by config.status.  */
    configure_input='Generated from '`
	  $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
  *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
	`' by configure.'
    if test x"$ac_file" != x-; then
      configure_input="$ac_file.  $configure_input"
	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
  * )   ac_file_in=$ac_file.in ;;
      { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
$as_echo "$as_me: creating $ac_file" >&6;}
    fi
    # Neutralize special characters interpreted by sed in replacement strings.
    case $configure_input in #(
    *\&* | *\|* | *\\* )
       ac_sed_conf_input=`$as_echo "$configure_input" |
       sed 's/[\\\\&|]/\\\\&/g'`;; #(
    *) ac_sed_conf_input=$configure_input;;
    esac
  esac

    case $ac_tag in
    *:-:* | *:-) cat >"$ac_tmp/stdin" \
      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
    esac
    ;;
  esac

  ac_dir=`$as_dirname -- "$ac_file" ||
  # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
  ac_dir=`(dirname "$ac_file") 2>/dev/null ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$ac_file" : 'X\(//\)[^/]' \| \
	 X"$ac_file" : 'X\(//\)$' \| \
	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
$as_echo X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
	    s//\1/
	 X"$ac_file" : 'X\(/\)' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X"$ac_file" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
	    q
	  }
	  /^X\(\/\/\)[^/].*/{
	    s//\1/
	    q
  	  /^X\(\/\/\)$/{ s//\1/; q; }
  	  /^X\(\/\).*/{ s//\1/; q; }
  	  s/.*/./; q'`
	  }
	  /^X\(\/\/\)$/{
	    s//\1/
  { if $as_mkdir_p; then
    mkdir -p "$ac_dir"
  else
    as_dir="$ac_dir"
    as_dirs=
    while test ! -d "$as_dir"; do
      as_dirs="$as_dir $as_dirs"
      as_dir=`(dirname "$as_dir") 2>/dev/null ||
$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
	 X"$as_dir" : 'X\(//\)[^/]' \| \
	 X"$as_dir" : 'X\(//\)$' \| \
	 X"$as_dir" : 'X\(/\)' \| \
	 .     : '\(.\)' 2>/dev/null ||
echo X"$as_dir" |
    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
  	  /^X\(\/\/\)$/{ s//\1/; q; }
	    q
	  }
	  /^X\(\/\).*/{
  	  /^X\(\/\).*/{ s//\1/; q; }
	    s//\1/
	    q
	  }
	  s/.*/./; q'`
  as_dir="$ac_dir"; as_fn_mkdir_p
  	  s/.*/./; q'`
    done
    test ! -n "$as_dirs" || mkdir $as_dirs
  fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
   { (exit 1); exit 1; }; }; }

  ac_builddir=.

case "$ac_dir" in
if test "$ac_dir" != .; then
.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
*)
  ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
  # A ".." for each directory in $ac_dir_suffix.
  ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
  # A "../" for each directory in $ac_dir_suffix.
  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
  case $ac_top_builddir_sub in
  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;
  esac ;;
esac
ac_abs_top_builddir=$ac_pwd
else
  ac_dir_suffix= ac_top_builddir=
ac_abs_builddir=$ac_pwd$ac_dir_suffix
# for backward compatibility:
ac_top_builddir=$ac_top_build_prefix
fi

case $srcdir in
  .)  # We are building in place.
  .)  # No --srcdir option.  We are building in place.
    ac_srcdir=.
    if test -z "$ac_top_builddir"; then
    ac_top_srcdir=$ac_top_builddir_sub
    ac_abs_top_srcdir=$ac_pwd ;;
  [\\/]* | ?:[\\/]* )  # Absolute name.
       ac_top_srcdir=.
    else
       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
    fi ;;
  [\\/]* | ?:[\\/]* )  # Absolute path.
    ac_srcdir=$srcdir$ac_dir_suffix;
    ac_top_srcdir=$srcdir
    ac_top_srcdir=$srcdir ;;
    ac_abs_top_srcdir=$srcdir ;;
  *) # Relative name.
    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_build_prefix$srcdir
    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
  *) # Relative path.
    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
    ac_top_srcdir=$ac_top_builddir$srcdir ;;
esac

# Do not use `cd foo && pwd` to compute absolute paths, because
# the directories may not exist.
case `pwd` in
.) ac_abs_builddir="$ac_dir";;
*)
  case "$ac_dir" in
  .) ac_abs_builddir=`pwd`;;
  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
  *) ac_abs_builddir=`pwd`/"$ac_dir";;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_builddir=${ac_top_builddir}.;;
*)
  case ${ac_top_builddir}. in
  .) ac_abs_top_builddir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_srcdir=$ac_srcdir;;
*)
  case $ac_srcdir in
  .) ac_abs_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
  esac;;
esac
case $ac_abs_builddir in
.) ac_abs_top_srcdir=$ac_top_srcdir;;
*)
  case $ac_top_srcdir in
  .) ac_abs_top_srcdir=$ac_abs_builddir;;
  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
  esac;;
esac
ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix



  if test x"$ac_file" != x-; then
    { echo "$as_me:$LINENO: creating $ac_file" >&5
echo "$as_me: creating $ac_file" >&6;}
    rm -f "$ac_file"
  fi
  # Let's still pretend it is `configure' which instantiates (i.e., don't
  # use $as_me), people would be surprised to read:
  #    /* config.h.  Generated by config.status.  */
  if test x"$ac_file" = x-; then
    configure_input=
  else
    configure_input="$ac_file.  "
  fi
  configure_input=$configure_input"Generated from `echo $ac_file_in |
				     sed 's,.*/,,'` by configure."

  # First look for the input files in the build tree, otherwise in the
  # src tree.
  ac_file_inputs=`IFS=:
    for f in $ac_file_in; do
  case $ac_mode in
  :F)
      case $f in
      -) echo $tmp/stdin ;;
  #
  # CONFIG_FILE
      [\\/$]*)
	 # Absolute (can't be DOS-style, as IFS=:)
  #

	 test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# If the template does not know about datarootdir, expand it.
# FIXME: This hack should be removed a few years after 2.60.
ac_datarootdir_hack=; ac_datarootdir_seen=
echo "$as_me: error: cannot find input file: $f" >&2;}
   { (exit 1); exit 1; }; }
	 echo "$f";;
      *) # Relative
	 if test -f "$f"; then
	   # Build tree
	   echo "$f"
ac_sed_dataroot='
/datarootdir/ {
	 elif test -f "$srcdir/$f"; then
  p
  q
}
/@datadir@/p
/@docdir@/p
	   # Source tree
	   echo "$srcdir/$f"
/@infodir@/p
/@localedir@/p
	 else
/@mandir@/p'
case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
*datarootdir*) ac_datarootdir_seen=yes;;
*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
	   # /dev/null tree
	   { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
echo "$as_me: error: cannot find input file: $f" >&2;}
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
  ac_datarootdir_hack='
  s&@datadir@&$datadir&g
  s&@docdir@&$docdir&g
  s&@infodir@&$infodir&g
  s&@localedir@&$localedir&g
  s&@mandir@&$mandir&g
  s&\\\${datarootdir}&$datarootdir&g' ;;
esac
   { (exit 1); exit 1; }; }
	 fi;;
      esac
    done` || { (exit 1); exit 1; }
_ACEOF

# Neutralize VPATH when `$srcdir' = `.'.
# Shell code in configure.ac might set extrasub.
# FIXME: do we really want to maintain this feature?
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_sed_extra="$ac_vpsub
cat >>$CONFIG_STATUS <<_ACEOF
  sed "$ac_vpsub
$extrasub
_ACEOF
cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
cat >>$CONFIG_STATUS <<\_ACEOF
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
s|@configure_input@|$ac_sed_conf_input|;t t
s,@configure_input@,$configure_input,;t t
s&@top_builddir@&$ac_top_builddir_sub&;t t
s&@top_build_prefix@&$ac_top_build_prefix&;t t
s&@srcdir@&$ac_srcdir&;t t
s&@abs_srcdir@&$ac_abs_srcdir&;t t
s&@top_srcdir@&$ac_top_srcdir&;t t
s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
s&@builddir@&$ac_builddir&;t t
s&@abs_builddir@&$ac_abs_builddir&;t t
s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
s,@srcdir@,$ac_srcdir,;t t
s,@abs_srcdir@,$ac_abs_srcdir,;t t
s,@top_srcdir@,$ac_top_srcdir,;t t
s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
s,@builddir@,$ac_builddir,;t t
s,@abs_builddir@,$ac_abs_builddir,;t t
s,@top_builddir@,$ac_top_builddir,;t t
$ac_datarootdir_hack
"
eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
  >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5

s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
  { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
  { ac_out=`sed -n '/^[	 ]*datarootdir[	 ]*:*=/p' \
      "$ac_tmp/out"`; test -z "$ac_out"; } &&
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined.  Please make sure it is defined" >&5
$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
which seems to be undefined.  Please make sure it is defined" >&2;}

  rm -f "$ac_tmp/stdin"
  case $ac_file in
" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
  rm -f $tmp/stdin
  if test x"$ac_file" != x-; then
  -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
  *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
  esac \
    mv $tmp/out $ac_file
  else
  || as_fn_error $? "could not create $ac_file" "$LINENO" 5
 ;;



    cat $tmp/out
    rm -f $tmp/out
  fi
  esac

done # for ac_tag
done
_ACEOF

cat >>$CONFIG_STATUS <<\_ACEOF

as_fn_exit 0
{ (exit 0); exit 0; }
_ACEOF
chmod +x $CONFIG_STATUS
ac_clean_files=$ac_clean_files_save

test $ac_write_fail = 0 ||
  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5


# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
# Unfortunately, on DOS this fails, as config.log is still kept open
# by configure, so config.status won't be able to write to it; its
# output is simply discarded.  So we exec the FD to /dev/null,
# effectively closing config.log, so it can be properly (re)opened and
# appended to by config.status.  When coming back to configure, we
# need to make the FD available again.
if test "$no_create" != yes; then
  ac_cs_success=:
  ac_config_status_args=
  test "$silent" = yes &&
    ac_config_status_args="$ac_config_status_args --quiet"
  exec 5>/dev/null
  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false
  exec 5>>config.log
  # Use ||, not &&, to avoid exiting from the if with $? = 1, which
  # would make configure fail if this is the last instruction.
  $ac_cs_success || as_fn_exit 1
  $ac_cs_success || { (exit 1); exit 1; }
fi
if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
  { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi


Deleted win/configure.ac.

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
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
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






















































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#! /bin/bash -norc
# This file is an input file used by the GNU "autoconf" program to
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.

AC_INIT(../generic/tcl.h)
AC_PREREQ(2.69)

# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh

TCL_VERSION=9.0
TCL_MAJOR_VERSION=9
TCL_MINOR_VERSION=0
TCL_PATCH_LEVEL="a2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

PKG_CFG_ARGS=$@

#------------------------------------------------------------------------
# Empty slate for bundled packages, to avoid stale configuration
#------------------------------------------------------------------------
rm -Rf pkgs

#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix
fi
# libdir must be a fully qualified path (not ${exec_prefix}/lib)
eval libdir="$libdir"

#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------

# If the user did not set CFLAGS, set it now to keep
# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi

AC_PROG_CC
AC_C_INLINE
AC_HEADER_STDC

AC_CHECK_TOOL(AR, ar)
AC_CHECK_TOOL(RANLIB, ranlib)
AC_CHECK_TOOL(RC, windres)

#--------------------------------------------------------------------
# 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

#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING

#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------

SC_ENABLE_SHARED

#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

SC_CONFIG_CFLAGS

# Cross-compiling
case ${host_alias} in
*mingw32*)
    TCL_EXE="tclsh"
    ;;
*)
    TCL_EXE="TCL_LIBRARY=\"\${LIBRARY_DIR}\"; export TCL_LIBRARY; ./\${TCLSH}"
    ;;
esac

#------------------------------------------------------------------------
#	Add stuff for zlib/libtommath; note that this is mostly done in the
#	makefile now as we just assume that the platform hasn't got usable
#   z.lib/tommath.lib
#------------------------------------------------------------------------

AS_IF([test "${enable_shared+set}" = "set"], [
  enableval="$enable_shared"
  tcl_ok=$enableval
], [
  tcl_ok=yes
])
AS_IF([test "$tcl_ok" = "yes"], [
  AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
  AC_SUBST(TOMMATH_DLL_FILE,[\${TOMMATH_DLL_FILE}])
  AC_DEFINE(TCL_WITH_EXTERNAL_TOMMATH, 1, [Tcl with external libtommath])
  AS_IF([test "$do64bit" != "no"], [
    AC_DEFINE(MP_64BIT, 1, [Using libtommath.dll in 64-bit mode])
    AS_IF([test "$GCC" == "yes"],[
      AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
      AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/libtommath.dll.a])
    ], [
      AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/zdll.lib])
      AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win64/tommath.lib])
    ])
  ], [
    AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win32/zdll.lib])
    AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win32/tommath.lib])
  ])
], [
  AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}])
  AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}])
])
AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?])

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_intptr_t" != none; then
	AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
	   type wide enough to hold a pointer.])
    fi
])
AC_CHECK_TYPE([uintptr_t], [
    AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    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
])


#--------------------------------------------------------------------
#	Zipfs support - Tip 430
#--------------------------------------------------------------------
AC_ARG_ENABLE(zipfs,
    AC_HELP_STRING([--enable-zipfs],
	[build with Zipfs support (default: on)]),
    [tcl_ok=$enableval], [tcl_ok=yes])
if test "$tcl_ok" = "yes" ; then
    #
    # Find a native compiler
    #
    AX_CC_FOR_BUILD
    #
    # Find a native zip implementation
    #
    SC_PROG_TCLSH
    SC_ZIPFS_SUPPORT
	ZIPFS_BUILD=1
	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
else
	ZIPFS_BUILD=0
	TCL_ZIP_FILE=
fi
# Do checking message here to not mess up interleaved configure output
AC_MSG_CHECKING([for building with zipfs])
if test "${ZIPFS_BUILD}" = 1; then
    if test "${SHARED_BUILD}" = 0; then
       ZIPFS_BUILD=2;
       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
       INSTALL_LIBRARIES=install-libraries-zipfs-static
       AC_MSG_RESULT([yes])
     else
       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
       INSTALL_LIBRARIES=install-libraries-zipfs-shared
       AC_MSG_RESULT([yes])
    fi
else
AC_MSG_RESULT([no])
INSTALL_LIBRARIES=install-libraries
INSTALL_MSGS=install-msgs
fi
AC_SUBST(ZIPFS_BUILD)
AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(INSTALL_LIBRARIES)
AC_SUBST(INSTALL_MSGS)


#--------------------------------------------------------------------
# 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

#--------------------------------------------------------------------
# Embed the manifest if we can determine how
#--------------------------------------------------------------------

SC_EMBED_MANIFEST

#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}

#--------------------------------------------------------------------
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------

eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""

eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"

eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""

if test ${SHARED_BUILD} = 0 ; then
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
else
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\""
fi
eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` -ltcl${VER}${FLAGSUFFIX}\""
eval "TCL_LIB_SPEC=\"-L${libdir} -ltcl${VER}${FLAGSUFFIX}\""

# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""

TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"

CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}

#--------------------------------------------------------------------
# Adjust the defines for how the resources are built depending
# on symbols and static vs. shared.
#--------------------------------------------------------------------

if test ${SHARED_BUILD} = 0 ; then
    RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
else
    RC_DEFINES=""
fi

#--------------------------------------------------------------------
#	The statements below define the symbol TCL_PACKAGE_PATH, which
#	gives a list of directories that may contain packages.  The list
#	consists of one directory for machine-dependent binaries and
#	another for platform-independent scripts.
#--------------------------------------------------------------------

if test "$prefix/lib" != "$libdir"; then
    TCL_PACKAGE_PATH="{${libdir}} {${prefix}/lib}"
else
    TCL_PACKAGE_PATH="{${prefix}/lib}"
fi

# The tclsh.exe.manifest requires these
# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs
# the release level, and must account for interim release versioning
case "$TCL_PATCH_LEVEL" in
     *a*) TCL_RELEASE_LEVEL=0 ;;
     *b*) TCL_RELEASE_LEVEL=1 ;;
     *)   TCL_RELEASE_LEVEL=2 ;;
esac
TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
AC_SUBST(TCL_WIN_VERSION)
# X86|AMD64|IA64 for manifest
AC_SUBST(MACHINE)

AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(PKG_CFG_ARGS)
AC_SUBST(TCL_EXE)

AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_STATIC_LIB_FILE)
AC_SUBST(TCL_STATIC_LIB_FLAG)
AC_SUBST(TCL_IMPORT_LIB_FILE)
AC_SUBST(TCL_IMPORT_LIB_FLAG)
# empty on win
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_PATH)
AC_SUBST(TCL_INCLUDE_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
AC_SUBST(TCL_DLL_FILE)

AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)

# win/tcl.m4 doesn't set (CFLAGS)
AC_SUBST(CFLAGS_DEFAULT)
AC_SUBST(EXTRA_CFLAGS)
AC_SUBST(CYGPATH)
AC_SUBST(DEPARG)
AC_SUBST(CC_OBJNAME)
AC_SUBST(CC_EXENAME)

# win/tcl.m4 doesn't set (LDFLAGS)
AC_SUBST(LDFLAGS_DEFAULT)
AC_SUBST(LDFLAGS_DEBUG)
AC_SUBST(LDFLAGS_OPTIMIZE)
AC_SUBST(LDFLAGS_CONSOLE)
AC_SUBST(LDFLAGS_WINDOW)
AC_SUBST(AR)
AC_SUBST(RANLIB)

AC_SUBST(STLIB_LD)
AC_SUBST(SHLIB_LD)
AC_SUBST(SHLIB_LD_LIBS)
AC_SUBST(SHLIB_CFLAGS)
AC_SUBST(SHLIB_SUFFIX)
AC_SUBST(TCL_SHARED_BUILD)

AC_SUBST(LIBS)
AC_SUBST(LIBS_GUI)
AC_SUBST(DLLSUFFIX)
AC_SUBST(LIBPREFIX)
AC_SUBST(LIBSUFFIX)
AC_SUBST(EXESUFFIX)
AC_SUBST(LIBRARIES)
AC_SUBST(MAKE_LIB)
AC_SUBST(MAKE_STUB_LIB)
AC_SUBST(POST_MAKE_LIB)
AC_SUBST(MAKE_DLL)
AC_SUBST(MAKE_EXE)

# empty on win, but needs sub'ing
AC_SUBST(TCL_BUILD_LIB_SPEC)
AC_SUBST(TCL_CC_SEARCH_FLAGS)
AC_SUBST(TCL_LD_SEARCH_FLAGS)
AC_SUBST(TCL_NEEDS_EXP_FILE)
AC_SUBST(TCL_BUILD_EXP_FILE)
AC_SUBST(TCL_EXP_FILE)
AC_SUBST(DL_LIBS)
AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_PACKAGE_PATH)

# win only
AC_SUBST(TCL_DDE_VERSION)
AC_SUBST(TCL_DDE_MAJOR_VERSION)
AC_SUBST(TCL_DDE_MINOR_VERSION)
AC_SUBST(TCL_REG_VERSION)
AC_SUBST(TCL_REG_MAJOR_VERSION)
AC_SUBST(TCL_REG_MINOR_VERSION)

AC_SUBST(RC)
AC_SUBST(RC_OUT)
AC_SUBST(RC_TYPE)
AC_SUBST(RC_INCLUDE)
AC_SUBST(RC_DEFINE)
AC_SUBST(RC_DEFINES)
AC_SUBST(RES)

AC_OUTPUT(Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest)

dnl Local Variables:
dnl mode: autoconf;
dnl End:

Added win/configure.in.
























































































































































































































































































































































































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
363
364
365
366
367
368
369
370
371
372
373
374
375
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#! /bin/bash -norc
# This file is an input file used by the GNU "autoconf" program to
# generate the file "configure", which is run during Tcl installation
# to configure the system for the local environment.

AC_INIT([tcl],[8.5])
AC_CONFIG_SRCDIR([../generic/tcl.h])
AC_PREREQ([2.59])

# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh

TCL_VERSION=8.5
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=5
TCL_PATCH_LEVEL=".19"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION

TCL_DDE_VERSION=1.4
TCL_DDE_MAJOR_VERSION=1
TCL_DDE_MINOR_VERSION=4
DDEVER=$TCL_DDE_MAJOR_VERSION$TCL_DDE_MINOR_VERSION

TCL_REG_VERSION=1.3
TCL_REG_MAJOR_VERSION=1
TCL_REG_MINOR_VERSION=3
REGVER=$TCL_REG_MAJOR_VERSION$TCL_REG_MINOR_VERSION

#------------------------------------------------------------------------
# Handle the --prefix=... option
#------------------------------------------------------------------------

if test "${prefix}" = "NONE"; then
    prefix=/usr/local
fi
if test "${exec_prefix}" = "NONE"; then
    exec_prefix=$prefix
fi
# libdir must be a fully qualified path (not ${exec_prefix}/lib)
eval libdir="$libdir"

#------------------------------------------------------------------------
# Standard compiler checks
#------------------------------------------------------------------------

# If the user did not set CFLAGS, set it now to keep
# the AC_PROG_CC macro from adding "-g -O2".
if test "${CFLAGS+set}" != "set" ; then
    CFLAGS=""
fi

AC_PROG_CC
AC_C_INLINE
AC_HEADER_STDC

AC_CHECK_TOOL(AR, ar)
AC_CHECK_TOOL(RANLIB, ranlib)
AC_CHECK_TOOL(RC, windres)

#--------------------------------------------------------------------
# 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

#--------------------------------------------------------------------
# Check whether --enable-threads or --disable-threads was given.
#--------------------------------------------------------------------

SC_ENABLE_THREADS

#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------

SC_TCL_CFG_ENCODING

#--------------------------------------------------------------------
# The statements below define a collection of symbols related to
# building libtcl as a shared library instead of a static library.
#--------------------------------------------------------------------

SC_ENABLE_SHARED

#--------------------------------------------------------------------
# Check whether --enable-time64bit was given.
#--------------------------------------------------------------------

AC_MSG_CHECKING([force of 64-bit time_t])
AC_ARG_ENABLE(time64bit,
    AS_HELP_STRING([--enable-time64bit],
	[force 64-bit time_t for 32-bit build (default: off)]),
    [tcl_ok=$enableval], [tcl_ok=no])
AC_MSG_RESULT("$tcl_ok")
if test "$tcl_ok" = "yes"; then
    CFLAGS="${CFLAGS} -D_USE_64BIT_TIME_T"
fi

#--------------------------------------------------------------------
# The statements below define a collection of compile flags.  This
# macro depends on the value of SHARED_BUILD, and should be called
# after SC_ENABLE_SHARED checks the configure switches.
#--------------------------------------------------------------------

SC_CONFIG_CFLAGS

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_intptr_t" != none; then
	AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
	   type wide enough to hold a pointer.])
    fi
])
AC_CHECK_TYPE([uintptr_t], [
    AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    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_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#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

TCL_DBGX=${DBGX}

#--------------------------------------------------------------------
# Embed the manifest if we can determine how
#--------------------------------------------------------------------

SC_EMBED_MANIFEST

#------------------------------------------------------------------------
# tclConfig.sh refers to this by a different name
#------------------------------------------------------------------------

TCL_SHARED_BUILD=${SHARED_BUILD}

#--------------------------------------------------------------------
# Perform final evaluations of variables with possible substitutions.
#--------------------------------------------------------------------

TCL_SHARED_LIB_SUFFIX="\${NODOT_VERSION}${DLLSUFFIX}"
TCL_UNSHARED_LIB_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"
TCL_EXPORT_FILE_SUFFIX="\${NODOT_VERSION}${LIBSUFFIX}"

eval "TCL_SRC_DIR=\"`cd $srcdir/..; $CYGPATH $(pwd)`\""

eval "TCL_DLL_FILE=tcl${VER}${DLLSUFFIX}"

if test ${SHARED_BUILD} = 0 -o "$GCC" != "yes" ; then
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${LIBSUFFIX}\""
else
 eval "TCL_LIB_FILE=\"${LIBPREFIX}tcl${VER}${DLLSUFFIX}.a\""
fi

eval "TCL_LIB_FLAG=\"-ltcl${VER}${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_LIB_FLAG}\""
eval "TCL_LIB_SPEC=\"-L${libdir} ${TCL_LIB_FLAG}\""

eval "TCL_STUB_LIB_FILE=\"${LIBPREFIX}tclstub${VER}${LIBSUFFIX}\""
eval "TCL_STUB_LIB_FLAG=\"-ltclstub${VER}${LIBFLAGSUFFIX}\""
eval "TCL_BUILD_STUB_LIB_SPEC=\"-L`$CYGPATH $(pwd)` ${TCL_STUB_LIB_FLAG}\""
eval "TCL_STUB_LIB_SPEC=\"-L${libdir} ${TCL_STUB_LIB_FLAG}\""
eval "TCL_BUILD_STUB_LIB_PATH=\"`$CYGPATH $(pwd)`/${TCL_STUB_LIB_FILE}\""
eval "TCL_STUB_LIB_PATH=\"${libdir}/${TCL_STUB_LIB_FILE}\""

# Install time header dir can be set via --includedir
eval "TCL_INCLUDE_SPEC=\"-I${includedir}\""


eval "DLLSUFFIX=${DLLSUFFIX}"
eval "LIBPREFIX=${LIBPREFIX}"
eval "LIBSUFFIX=${LIBSUFFIX}"
eval "EXESUFFIX=${EXESUFFIX}"

CFG_TCL_SHARED_LIB_SUFFIX=${TCL_SHARED_LIB_SUFFIX}
CFG_TCL_UNSHARED_LIB_SUFFIX=${TCL_UNSHARED_LIB_SUFFIX}
CFG_TCL_EXPORT_FILE_SUFFIX=${TCL_EXPORT_FILE_SUFFIX}

#--------------------------------------------------------------------
# Adjust the defines for how the resources are built depending
# on symbols and static vs. shared.
#--------------------------------------------------------------------

if test ${SHARED_BUILD} = 0 ; then
    if test "${DBGX}" = "g"; then
        RC_DEFINES="${RC_DEFINE} STATIC_BUILD ${RC_DEFINE} DEBUG"
    else
        RC_DEFINES="${RC_DEFINE} STATIC_BUILD"
    fi
else
    if test "${DBGX}" = "g"; then
        RC_DEFINES="${RC_DEFINE} DEBUG"
    else
        RC_DEFINES=""
    fi
fi

#--------------------------------------------------------------------
#	The statements below define the symbol TCL_PACKAGE_PATH, which
#	gives a list of directories that may contain packages.  The list
#	consists of one directory for machine-dependent binaries and
#	another for platform-independent scripts.
#--------------------------------------------------------------------

if test "$prefix/lib" != "$libdir"; then
    TCL_PACKAGE_PATH="${libdir} ${prefix}/lib"
else
    TCL_PACKAGE_PATH="${prefix}/lib"
fi

# The tclsh.exe.manifest requires these
# TCL_WIN_VERSION is the 4 dotted pair Windows version format which needs
# the release level, and must account for interim release versioning
case "$TCL_PATCH_LEVEL" in
     *a*) TCL_RELEASE_LEVEL=0 ;;
     *b*) TCL_RELEASE_LEVEL=1 ;;
     *)   TCL_RELEASE_LEVEL=2 ;;
esac
TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d ab.`"
AC_SUBST(TCL_WIN_VERSION)
# X86|AMD64|IA64 for manifest
AC_SUBST(MACHINE)

AC_SUBST(TCL_VERSION)
AC_SUBST(TCL_MAJOR_VERSION)
AC_SUBST(TCL_MINOR_VERSION)
AC_SUBST(TCL_PATCH_LEVEL)

AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
# empty on win
AC_SUBST(TCL_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_FILE)
AC_SUBST(TCL_STUB_LIB_FLAG)
AC_SUBST(TCL_STUB_LIB_SPEC)
AC_SUBST(TCL_STUB_LIB_PATH)
AC_SUBST(TCL_INCLUDE_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_SPEC)
AC_SUBST(TCL_BUILD_STUB_LIB_PATH)
AC_SUBST(TCL_DLL_FILE)

AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_DBGX)
AC_SUBST(CFG_TCL_SHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(CFG_TCL_EXPORT_FILE_SUFFIX)

# win/tcl.m4 doesn't set (CFLAGS)
AC_SUBST(CFLAGS_DEFAULT)
AC_SUBST(EXTRA_CFLAGS)
AC_SUBST(CYGPATH)
AC_SUBST(DEPARG)
AC_SUBST(CC_OBJNAME)
AC_SUBST(CC_EXENAME)

# win/tcl.m4 doesn't set (LDFLAGS)
AC_SUBST(LDFLAGS_DEFAULT)
AC_SUBST(LDFLAGS_DEBUG)
AC_SUBST(LDFLAGS_OPTIMIZE)
AC_SUBST(LDFLAGS_CONSOLE)
AC_SUBST(LDFLAGS_WINDOW)
AC_SUBST(AR)
AC_SUBST(RANLIB)

AC_SUBST(STLIB_LD)
AC_SUBST(SHLIB_LD)
AC_SUBST(SHLIB_LD_LIBS)
AC_SUBST(SHLIB_CFLAGS)
AC_SUBST(SHLIB_SUFFIX)
AC_SUBST(TCL_SHARED_BUILD)

AC_SUBST(LIBS)
AC_SUBST(LIBS_GUI)
AC_SUBST(DLLSUFFIX)
AC_SUBST(LIBPREFIX)
AC_SUBST(LIBSUFFIX)
AC_SUBST(EXESUFFIX)
AC_SUBST(LIBRARIES)
AC_SUBST(MAKE_LIB)
AC_SUBST(MAKE_STUB_LIB)
AC_SUBST(POST_MAKE_LIB)
AC_SUBST(MAKE_DLL)
AC_SUBST(MAKE_EXE)

# empty on win, but needs sub'ing
AC_SUBST(TCL_BUILD_LIB_SPEC)
AC_SUBST(TCL_LD_SEARCH_FLAGS)
AC_SUBST(TCL_NEEDS_EXP_FILE)
AC_SUBST(TCL_BUILD_EXP_FILE)
AC_SUBST(TCL_EXP_FILE)
AC_SUBST(DL_LIBS)
AC_SUBST(TCL_LIB_VERSIONS_OK)
AC_SUBST(TCL_PACKAGE_PATH)

# win only
AC_SUBST(TCL_DDE_VERSION)
AC_SUBST(TCL_DDE_MAJOR_VERSION)
AC_SUBST(TCL_DDE_MINOR_VERSION)
AC_SUBST(TCL_REG_VERSION)
AC_SUBST(TCL_REG_MAJOR_VERSION)
AC_SUBST(TCL_REG_MINOR_VERSION)

AC_SUBST(RC)
AC_SUBST(RC_OUT)
AC_SUBST(RC_TYPE)
AC_SUBST(RC_INCLUDE)
AC_SUBST(RC_DEFINE)
AC_SUBST(RC_DEFINES)
AC_SUBST(RES)

AC_CONFIG_FILES([Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest])
AC_OUTPUT

dnl Local Variables:
dnl mode: autoconf
dnl End:

Added win/makefile.bc.






















































































































































































































































































































































































































































































































































































































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
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
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
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
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
#
# Makefile for Borland C++ 5.5 (or C++ Builder 5), adapted from the makefile
#   for Visual C++ that came with tcl 8.3.3
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.

# TIP #59 information.
#
# This makefile does not set the following configuration cpp
# defines. Behind the defines are the makefile variables listed to set
# to -D... when that feature is enabled.
#
# - TCL_CFG_PROFILED		PROFDEFINES
# - TCL_CFG_OPTIMIZED		OPTDEFINES
# - TCL_CFG_DO64BIT		SIXFOURDEFINES

# Have a look at the complete description on how to build and test Tcl with
# the current Borland compilers at www.ratiosoft.com/tcl/borland.
#
# Usage:
#   - Adapt the paths below to match your compiler's location
#   - Make sure the compiler's bin directory is on your path
#   - Open a console
#   - To make a debug version enter
#       make -fmakefile.bc -DNODEBUG=0 xxx
#     where 'xxx' is the target you want (e.g. 'all', 'test', ...)
#     Please note: I omitted the 'd' suffix for debug versions because Tcl
#     will always call tclpip83.dll and not tclpip83d.dll, causing an error.
#                                                   ^
#     Besides, the debug version goes into a separate directory, so there
#     should be no problem having DLLs and EXEs with the same name.
#     If you prefer your debug version having the 'd' suffix just uncomment
#     the line
#         #DBGX        = d
#
#   - To make a 'normal' version enter
#       make -fmakefile.bc xxx
#     where 'xxx' is the target you want (e.g. 'all', 'test', ...)
#
# DISCLAIMER:
# This makefile has an experimental status - that is those targets which
# have been modified do in fact compile and link with Borland's C++
# Builder 5 and with the free Borland compiler (Borland C++ 5.5).
# However the author assumes no responsiblity for any effect which the use of
# this makefile or of the resulting programs might have on your system.
#
# Not yet modified:
#   - The 'plug-in-DLL' and the associated shell.
#   - The programs to create the windows help files.
#
# Suggestions and / or improvements are always welcome.
#
# May 2001, H. Giese (hgiese@ratiosoft.com)
#

# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from
# location of the compiler directories.

#
# Project directories
#
# ROOT    = top of source tree
#
# TOOLS32 = location of Borland development tools.
#
# INSTALLDIR = where the install-targets should copy the binaries and
#     support files
#

ROOT		= ..
INSTALLDIR	= c:\program files\tcl

# If you have C++ Builder 5 or the free Borland C++ 5.5 compiler
# adapt the following paths as appropriate for your system
TOOLS32		= c:\dev\bcc55
TOOLS32_rc	= c:\dev\bcc55
#TOOLS32	= c:\bc55
#TOOLS32_rc	= c:\bc55

cc32		= "$(TOOLS32)\bin\bcc32.exe"
link32		= "$(TOOLS32)\bin\ilink32.exe"
lib32		= "$(TOOLS32)\bin\tlib.exe"
rc32		= "$(TOOLS32_rc)\bin\brcc32.exe"
include32	= -I"$(TOOLS32)\include"
libpath32	= -L"$(TOOLS32)\lib"

# Uncomment the following line to compile with thread support
#THREADDEFINES	= -DTCL_THREADS=1

# Allow definition of NDEBUG via command line
# Set NODEBUG to 0 to compile with symbols
!if !defined(NODEBUG)
NODEBUG		= 1
!endif

#	CFG_ENCODING=encoding
#		name of encoding for configuration information. Defaults
#		to cp1252
!if !defined(CFG_ENCODING)
CFG_ENCODING	= \"cp1252\"
!endif

# The following defines can be used to control the amount of debugging
# code that is added to the compilation.
#
# -DTCL_MEM_DEBUG   Enables the debugging memory allocator.
# -DTCL_COMPILE_DEBUG Enables byte compilation logging.
# -DTCL_COMPILE_STATS Enables byte compilation statistics gathering.
# -DUSE_TCLALLOC=0  Disables the Tcl memory allocator in favor
#       of the native malloc implementation.  This is
#       needed when using Purify.
#
#DEBUGDEFINES	= -DTCL_MEM_DEBUG -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
#DEBUGDEFINES	= -DUSE_TCLALLOC=0

######################################################################
# Do not modify below this line
######################################################################

NAMEPREFIX	= tcl
STUBPREFIX	= $(NAMEPREFIX)stub
DOTVERSION	= 8.5
VERSION		= 85

DDEVERSION = 14
DDEDOTVERSION = 1.4

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)
OUTDIRNAME	= $(TMPDIRNAME)
OUTDIR		= $(TMPDIR)

TCLLIB		= $(OUTDIR)\$(NAMEPREFIX)$(VERSION)$(DBGX).lib
TCLDLLNAME	= $(NAMEPREFIX)$(VERSION)$(DBGX).dll
TCLDLL		= $(OUTDIR)\$(TCLDLLNAME)

TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION)$(DBGX).lib
TCLSTUBLIB	= $(OUTDIR)\$(TCLSTUBLIBNAME)

TCLPLUGINLIB	= $(OUTDIR)\$(NAMEPREFIX)$(VERSION)p$(DBGX).lib
TCLPLUGINDLLNAME	= $(NAMEPREFIX)$(VERSION)p$(DBGX).dll
TCLPLUGINDLL	= $(OUTDIR)\$(TCLPLUGINDLLNAME)
TCLSH		= $(OUTDIR)\$(NAMEPREFIX)sh$(VERSION)$(DBGX).exe
TCLSHP		= $(OUTDIR)\$(NAMEPREFIX)shp$(VERSION)$(DBGX).exe
TCLPIPEDLLNAME	= $(NAMEPREFIX)pip$(VERSION)$(DBGX).dll
TCLPIPEDLL	= $(OUTDIR)\$(TCLPIPEDLLNAME)
TCLREGDLLNAME	= $(NAMEPREFIX)reg$(REGVERSION)$(DBGX).dll
TCLREGDLL	= $(OUTDIR)\$(TCLREGDLLNAME)
TCLDDEDLLNAME	= $(NAMEPREFIX)dde$(DDEVERSION)$(DBGX).dll
TCLDDEDLL	= $(OUTDIR)\$(TCLDDEDLLNAME)
TCLTEST		= $(OUTDIR)\$(NAMEPREFIX)test.exe
CAT32		= $(TMPDIR)\cat32.exe
RMDIR		= .\rmd.bat
MKDIR		= .\mkd.bat
RM		= del

LIB_INSTALL_DIR	= $(INSTALLDIR)\lib
BIN_INSTALL_DIR	= $(INSTALLDIR)\bin
SCRIPT_INSTALL_DIR	= $(INSTALLDIR)\lib\tcl$(DOTVERSION)
INCLUDE_INSTALL_DIR	= $(INSTALLDIR)\include

TCLSHOBJS	= \
	$(TMPDIR)\tclAppInit.obj

TCLTESTOBJS	= \
	$(TMPDIR)\tclTest.obj \
	$(TMPDIR)\tclTestObj.obj \
	$(TMPDIR)\tclTestProcBodyObj.obj \
	$(TMPDIR)\tclThreadTest.obj \
	$(TMPDIR)\tclWinTest.obj \
	$(TMPDIR)\testMain.obj

TCLOBJS	= \
	$(TMPDIR)\regcomp.obj \
	$(TMPDIR)\regexec.obj \
	$(TMPDIR)\regfree.obj \
	$(TMPDIR)\regerror.obj \
	$(TMPDIR)\tclAlloc.obj \
	$(TMPDIR)\tclAsync.obj \
	$(TMPDIR)\tclBasic.obj \
	$(TMPDIR)\tclBinary.obj \
	$(TMPDIR)\tclCkalloc.obj \
	$(TMPDIR)\tclClock.obj \
	$(TMPDIR)\tclCmdAH.obj \
	$(TMPDIR)\tclCmdIL.obj \
	$(TMPDIR)\tclCmdMZ.obj \
	$(TMPDIR)\tclCompCmds.obj \
	$(TMPDIR)\tclCompExpr.obj \
	$(TMPDIR)\tclCompile.obj \
	$(TMPDIR)\tclConfig.obj \
	$(TMPDIR)\tclDate.obj \
	$(TMPDIR)\tclDictObj.obj \
	$(TMPDIR)\tclEncoding.obj \
	$(TMPDIR)\tclEnv.obj \
	$(TMPDIR)\tclEvent.obj \
	$(TMPDIR)\tclExecute.obj \
	$(TMPDIR)\tclFCmd.obj \
	$(TMPDIR)\tclFileName.obj \
	$(TMPDIR)\tclGet.obj \
	$(TMPDIR)\tclHash.obj \
	$(TMPDIR)\tclHistory.obj \
	$(TMPDIR)\tclIndexObj.obj \
	$(TMPDIR)\tclInterp.obj \
	$(TMPDIR)\tclIO.obj \
	$(TMPDIR)\tclIOCmd.obj \
	$(TMPDIR)\tclIOGT.obj \
	$(TMPDIR)\tclIOSock.obj \
	$(TMPDIR)\tclIOUtil.obj \
	$(TMPDIR)\tclLink.obj \
	$(TMPDIR)\tclLiteral.obj \
	$(TMPDIR)\tclListObj.obj \
	$(TMPDIR)\tclLoad.obj \
	$(TMPDIR)\tclMain.obj \
	$(TMPDIR)\tclNamesp.obj \
	$(TMPDIR)\tclNotify.obj \
	$(TMPDIR)\tclObj.obj \
	$(TMPDIR)\tclPanic.obj \
	$(TMPDIR)\tclParse.obj \
	$(TMPDIR)\tclPipe.obj \
	$(TMPDIR)\tclPkg.obj \
	$(TMPDIR)\tclPkgConfig.obj \
	$(TMPDIR)\tclPosixStr.obj \
	$(TMPDIR)\tclPreserve.obj \
	$(TMPDIR)\tclProc.obj \
	$(TMPDIR)\tclRegexp.obj \
	$(TMPDIR)\tclResolve.obj \
	$(TMPDIR)\tclResult.obj \
	$(TMPDIR)\tclScan.obj \
	$(TMPDIR)\tclStringObj.obj \
	$(TMPDIR)\tclStubInit.obj \
	$(TMPDIR)\tclStubLib.obj \
	$(TMPDIR)\tclThread.obj \
	$(TMPDIR)\tclThreadJoin.obj \
	$(TMPDIR)\tclTimer.obj \
	$(TMPDIR)\tclTrace.obj \
	$(TMPDIR)\tclUtf.obj \
	$(TMPDIR)\tclUtil.obj \
	$(TMPDIR)\tclVar.obj \
	$(TMPDIR)\tclWin32Dll.obj \
	$(TMPDIR)\tclWinChan.obj \
	$(TMPDIR)\tclWinConsole.obj \
	$(TMPDIR)\tclWinSerial.obj \
	$(TMPDIR)\tclWinError.obj \
	$(TMPDIR)\tclWinFCmd.obj \
	$(TMPDIR)\tclWinFile.obj \
	$(TMPDIR)\tclWinInit.obj \
	$(TMPDIR)\tclWinLoad.obj \
	$(TMPDIR)\tclWinNotify.obj \
	$(TMPDIR)\tclWinPipe.obj \
	$(TMPDIR)\tclWinSock.obj \
	$(TMPDIR)\tclWinThrd.obj \
	$(TMPDIR)\tclWinTime.obj

TCLSTUBOBJS	= $(TMPDIR)\tclStubLib.obj

WIN_DIR		= $(ROOT)\win
GENERICDIR	= $(ROOT)\generic

TCL_INCLUDES	= -I"$(WIN_DIR)" -I"$(GENERICDIR)"
TCL_DEFINES	= $(DEBUGDEFINES) $(THREADDEFINES) $(SYMDEFINES) \
			$(PROFDEFINES) $(OPTDEFINES) $(SIXFOURDEFINES) \
			-DTCL_CFGVAL_ENCODING=${CFG_ENCODING}

######################################################################
# Compiler flags
######################################################################

!IF "$(NODEBUG)" == "1"
# these macros cause maximum optimization and no symbols
cdebug	= -v- -vi- -O2 -D_DEBUG
!ELSE
# these macros enable debugging
cdebug	= -k -Od -r- -v -vi- -y
!ENDIF

SYSDEFINES	= _MT;NO_STRICT;_NO_VCL

# declarations common to all compiler options
cbase	= -c -q -3 -a4 -g0 -tWM -Ve -Vx -X-
WARNINGS	= -w-rch -w-pch -w-par -w-dup -w-pro -w-dpu

ccons	= -tWC

INCLUDEPATH	= $(include32) $(TCL_INCLUDES)

CFLAGS	= $(cdebug) $(cbase) $(INCLUDEPATH) $(WARNINGS) -D$(SYSDEFINES)
TCL_CFLAGS	= $(CFLAGS) $(TCL_DEFINES)
CONS_CFLAGS	= $(CFLAGS) $(TCL_DEFINES) $(ccons)

######################################################################
# Linker flags
######################################################################

!IF "$(NODEBUG)" == "1"
ldebug	=
!ELSE
ldebug	= -v
!ENDIF

# declarations common to all linker options
LNFLAGS	= -D"" -Gn -I$(TMPDIR) -x $(ldebug) $(libpath32)
# -Gi: create lib file (is -Gl in doc)
# -aa: Windows app, -ap: Windows console app
LNFLAGS_DLL	= -ap -Gi -Tpd
LNFLAGS_CONS	= -ap -Tpe

LNLIBS	= import32 cw32mt


######################################################################
# Project specific targets
######################################################################

release:	setup $(TCLSH) dlls
dlls:		setup $(TCLPIPEDLL) $(TCLREGDLL) $(TCLDDEDLL)
all:		setup $(TCLSH) dlls $(CAT32)
tcltest:	setup $(TCLTEST) dlls $(CAT32)
plugin:		setup $(TCLPLUGINDLL) $(TCLSHP)
install:	install-binaries install-libraries

test:		setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT)/library
	$(TCLTEST) $(ROOT)/tests/all.tcl

setup:
	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\
		echo *** Created directory '$(OUT_DIR)'
	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\
		echo *** Created directory '$(TMP_DIR)'


$(TCLLIB): $(TCLDLL)

$(TCLDLL): $(TCLOBJS) $(TMPDIR)\$(NAMEPREFIX).res
	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 @&&!
		$(TCLOBJS), $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res
!

$(TCLSTUBLIB): $(TCLSTUBOBJS)
	$(lib32) /u $@ $(TCLSTUBOBJS)

$(TCLPLUGINLIB): $(TCLPLUGINDLL)

$(TCLPLUGINDLL): $(TCLOBJS) $(TMPDIR)\tcl.res
	$(link32) $(ldebug) $(dlllflags) \
		-out:$@ $(TMPDIR)\tcl.res $(guilibsdll) @&&!
$(TCLOBJS)
!

$(TCLSH): $(TCLSHOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
	$(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
		$(TCLSHOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
!

$(TCLSHP): $(TCLSHOBJS) $(TCLPLUGINLIB) $(TMPDIR)\tclsh.res
	$(link32) $(ldebug) $(conlflags) $(TMPDIR)\tclsh.res -stack:2300000 \
		-out:$@ $(conlibsdll) $(TCLPLUGINLIB) $(TCLSHOBJS)

$(TCLTEST): $(TCLTESTOBJS) $(TCLLIB) $(TMPDIR)\$(NAMEPREFIX)sh.res
	$(link32) $(ldebug) -S:2400000 $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 @&&!
		$(TCLTESTOBJS), $@, -x, $(LNLIBS) $(TCLLIB),, $(TMPDIR)\$(NAMEPREFIX)sh.res
!

$(TCLPIPEDLL): $(WIN_DIR)\stub16.c
	$(cc32) $(CFLAGS) -o$(TMPDIR)\stub16.obj $(WIN_DIR)\stub16.c
	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
		$(TMPDIR)\stub16.obj, $@, -x, $(LNLIBS),, $(TMPDIR)\$(NAMEPREFIX).res

$(TCLDDEDLL): $(TMPDIR)\tclWinDde.obj $(TCLSTUBLIB)
	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
		$(TMPDIR)\tclWinDde.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
		$(TMPDIR)\$(NAMEPREFIX).res

$(TCLREGDLL): $(TMPDIR)\tclWinReg.obj $(TCLSTUBLIB)
	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_DLL) $(TOOLS32)\lib\c0d32 \
		$(TMPDIR)\tclWinReg.obj, $@, -x, $(LNLIBS) $(TCLSTUBLIB),, \
		$(TMPDIR)\$(NAMEPREFIX).res

$(CAT32): $(WIN_DIR)\cat.c
	$(cc32) $(CONS_CFLAGS) -o$(TMPDIR)\cat.obj $?
	$(link32) $(ldebug) $(LNFLAGS) $(LNFLAGS_CONS) $(TOOLS32)\lib\c0x32 \
		$(TMPDIR)\cat.obj, $@, -x, $(LNLIBS),,

install-binaries: $(TCLSH)
	$(MKDIR) "$(BIN_INSTALL_DIR)"
	$(MKDIR) "$(LIB_INSTALL_DIR)"
	@echo Installing $(TCLDLLNAME)
	@copy "$(TCLDLL)" "$(BIN_INSTALL_DIR)"
	@copy "$(TCLLIB)" "$(LIB_INSTALL_DIR)"
	@echo Installing "$(TCLSH)"
	@copy "$(TCLSH)" "$(BIN_INSTALL_DIR)"
	@echo Installing $(TCLPIPEDLLNAME)
	@copy "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)"
	@echo Installing $(TCLSTUBLIBNAME)
	@copy "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)"

install-libraries:
	-@$(MKDIR) "$(LIB_INSTALL_DIR)"
	-@$(MKDIR) "$(INCLUDE_INSTALL_DIR)"
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
	@echo Installing http1.0
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http1.0"
	-@copy "$(ROOT)\library\http1.0\http.tcl"     "$(SCRIPT_INSTALL_DIR)\http1.0"
	-@copy "$(ROOT)\library\http1.0\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http1.0"
	@echo Installing http2.7
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\http2.7"
	-@copy "$(ROOT)\library\http\http.tcl"     "$(SCRIPT_INSTALL_DIR)\http2.7"
	-@copy "$(ROOT)\library\http\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\http2.7"
	@echo Installing opt0.4
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
	-@copy "$(ROOT)\library\opt\optparse.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
	-@copy "$(ROOT)\library\opt\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\opt0.4"
	@echo Installing msgcat1.5
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
	-@copy "$(ROOT)\library\msgcat\msgcat.tcl"   "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
	-@copy "$(ROOT)\library\msgcat\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\msgcat1.5"
	@echo Installing tcltest2.5
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\tcltest2.5"
	-@copy "$(ROOT)\library\tcltest\tcltest.tcl"   "$(SCRIPT_INSTALL_DIR)\tcltest2.5"
	-@copy "$(ROOT)\library\tcltest\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\tcltest2.5"
	@echo Installing platform1.0
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\platform1.0"
	-@copy "$(ROOT)\library\platform\platform.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
	-@copy "$(ROOT)\library\platform\shell.tcl"    "$(SCRIPT_INSTALL_DIR)\platform1.0"
	-@copy "$(ROOT)\library\platform\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\platform1.0"
	@echo Installing $(TCLDDEDLLNAME)
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\dde1.3"
	-@copy "$(TCLDDEDLL)" "$(SCRIPT_INSTALL_DIR)\dde1.3"
	-@copy "$(ROOT)\library\dde\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\dde1.3"
	@echo Installing $(TCLREGDLLNAME)
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\reg1.2"
	-@copy "$(TCLREGDLL)" "$(SCRIPT_INSTALL_DIR)\reg1.2"
	-@copy "$(ROOT)\library\reg\pkgIndex.tcl" "$(SCRIPT_INSTALL_DIR)\reg1.2"
	@echo Installing encoding files
	-@$(MKDIR) "$(SCRIPT_INSTALL_DIR)\encoding"
	-@copy "$(ROOT)\library\encoding\*.enc" "$(SCRIPT_INSTALL_DIR)\encoding"
	@echo Installing library files
	-@copy "$(GENERICDIR)\tcl.h"         "$(INCLUDE_INSTALL_DIR)"
	-@copy "$(GENERICDIR)\tclDecls.h"    "$(INCLUDE_INSTALL_DIR)"
	-@copy "$(GENERICDIR)\tclPlatDecls.h" "$(INCLUDE_INSTALL_DIR)"
	-@copy "$(ROOT)\library\history.tcl" "$(SCRIPT_INSTALL_DIR)"
	-@copy "$(ROOT)\library\init.tcl"    "$(SCRIPT_INSTALL_DIR)"
	-@copy "$(ROOT)\library\parray.tcl"  "$(SCRIPT_INSTALL_DIR)"
	-@copy "$(ROOT)\library\safe.tcl"    "$(SCRIPT_INSTALL_DIR)"
	-@copy "$(ROOT)\library\tclIndex"    "$(SCRIPT_INSTALL_DIR)"
	-@copy "$(ROOT)\library\package.tcl" "$(SCRIPT_INSTALL_DIR)"
	-@copy "$(ROOT)\library\word.tcl"    "$(SCRIPT_INSTALL_DIR)"
	-@copy "$(ROOT)\library\auto.tcl"    "$(SCRIPT_INSTALL_DIR)"

#
# Regenerate the stubs files.
#

genstubs:
	tclsh$(VERSION) $(ROOT)\tools\genStubs.tcl $(GENERICDIR) \
		$(GENERICDIR)\tcl.decls $(GENERICDIR)\tclInt.decls

#
# Regenerate the windows help files.
#

TCLTOOLS	= $(ROOT)/tools
MAN2TCL		= $(TCLTOOLS)/man2tcl
TCLRTF		= $(TCLTOOLS)/tcl.rtf
TCLHPJ		= $(TCLTOOLS)/tcl.hpj
MAN2HELP	= $(TCLTOOLS)/man2help.tcl
HCRTF		= $(TOOLS32)/bin/hcrtf.exe

winhelp: $(TCLRTF)
	cd $(TCLTOOLS)
	start /wait $(HCRTF) -xn $(TCLHPJ)

$(MAN2TCL).exe: $(MAN2TCL).obj
	cd $(TCLTOOLS)
	$(cc32) /nologo /G4 /ML /O2 $(MAN2TCL).c

$(TCLRTF): $(MAN2TCL).exe $(TCLSH)
	cd $(TCLTOOLS)
	..\win\$(TCLSH) $(MAN2HELP) $(NAMEPREFIX) $(VERSION) $(ROOT)/doc ../../tk$(DOTVERSION)/doc

#
# Special case object file targets
#
$(TMPDIR)\tclWinInit.obj: $(WIN_DIR)\tclWinInit.c
	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?

$(TMPDIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c
	$(cc32) $(TCL_CFLAGS) -DTCL_TEST -o$(TMPDIR)\testMain.obj $?

$(TMPDIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?

$(TMPDIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?

$(TMPDIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?

$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
	$(cc32) $(TCL_CFLAGS) \
		-DCFG_INSTALL_EXEC_PREFIX=\"$(INSTALL_EXEC_PREFIX)\"	\
		-DCFG_INSTALL_PREFIX=\"$(INSTALL_PREFIX)\"		\
		-DCFG_RUNTIME_EXEC_PREFIX=\"$(RUNTIME_EXEC_PREFIX)\"	\
		-DCFG_RUNTIME_PREFIX=\"$(RUNTIME_PREFIX)\"		\
	 -o$(TMPDIR)\$@ $?

$(TMPDIR)\tclAppInit.obj : $(WIN_DIR)\tclAppInit.c
	$(cc32) $(TCL_CFLAGS) -o$(TMPDIR)\$@ $?

# The following objects should be built using the stub interfaces

# tclWinReg: Produces errors in ANSI mode
$(TMPDIR)\tclWinReg.obj : $(WIN_DIR)\tclWinReg.c
	$(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?

# tclWinDde: Produces errors in ANSI mode
$(TMPDIR)\tclWinDde.obj : $(WIN_DIR)\tclWinDde.c
	$(cc32) $(TCL_CFLAGS) -DUSE_TCL_STUBS -o$(TMPDIR)\$@ $?


# The following objects are part of the stub library and should not
# be built as DLL objects but none of the symbols should be exported

$(TMPDIR)\tclStubLib.obj : $(GENERICDIR)\tclStubLib.c
	$(cc32) $(TCL_CFLAGS) -DSTATIC_BUILD -o$(TMPDIR)\$@ $?


# Dedependency rules

$(GENERICDIR)\regcomp.c: \
	$(GENERICDIR)\regguts.h \
	$(GENERICDIR)\regc_lex.c \
	$(GENERICDIR)\regc_color.c \
	$(GENERICDIR)\regc_nfa.c \
	$(GENERICDIR)\regc_cvec.c \
	$(GENERICDIR)\regc_locale.c

$(GENERICDIR)\regcustom.h: \
	$(GENERICDIR)\tclInt.h \
	$(GENERICDIR)\tclPort.h \
	$(GENERICDIR)\regex.h

$(GENERICDIR)\regexec.c: \
	$(GENERICDIR)\rege_dfa.c \
	$(GENERICDIR)\regguts.h

$(GENERICDIR)\regerror.c: $(GENERICDIR)\regguts.h
$(GENERICDIR)\regfree.c: $(GENERICDIR)\regguts.h
$(GENERICDIR)\regfronts.c: $(GENERICDIR)\regguts.h
$(GENERICDIR)\regguts.h: $(GENERICDIR)\regcustom.h

#
# Implicit rules
#

{$(WIN_DIR)}.c{$(TMPDIR)}.obj:
	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<

{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<

{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
	$(cc32) -DBUILD_tcl $(TCL_CFLAGS) -o$@ $<

{$(WIN_DIR)}.rc{$(TMPDIR)}.res:
	$(rc32) $(INCLUDEPATH) -D$(USERDEFINES);$(SYSDEFINES) -fo$@ $<

clean:
	-@$(RM) $(OUTDIR)\*.exp
	-@$(RM) $(OUTDIR)\*.lib
	-@$(RM) $(OUTDIR)\*.dll
	-@$(RM) $(OUTDIR)\*.exe
	-@$(RM) $(OUTDIR)\*.pdb
	-@$(RM) $(TMPDIR)\*.pch
	-@$(RM) $(TMPDIR)\*.obj
	-@$(RM) $(TMPDIR)\*.res
	-@$(RM) $(TMPDIR)\*.exe
	-@$(RMDIR) $(OUTDIR)
	-@$(RMDIR) $(TMPDIR)

Changes to win/makefile.vc.

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
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












-


+
+
+
+
+
+
+
+
-
-
+
+
+
+

-
-
+
+
+
+
+

+
+
+
+
+
+
+
+
+
-
+

-
+
+

















-
-
+
+
-
-
-
-

-
-
-
-
+
+
+
+

-
-
+




+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
-
+

+
+
+

-
-
+
+
+
+







#------------------------------------------------------------- -*- makefile -*-
#
#	Microsoft Visual C++ makefile for building Tcl with nmake
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001-2005 ActiveState Corporation.
# Copyright (c) 2001-2004 David Gravereaux.
# Copyright (c) 2003-2008 Pat Thoyts.
# Copyright (c) 2017 Ashok P. Nadkarni
#------------------------------------------------------------------------------

# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)
!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
MSG = ^
You need to run vcvars32.bat from Developer Studio or setenv.bat from the^
Platform SDK first to setup the environment.  Jump to this line to read^
the build instructions.
!error $(MSG)
# General usage:
#   nmake [-nologo] -f makefile.vc [TARGET|MACRODEF [TARGET|MACRODEF] [...]]
!endif

#------------------------------------------------------------------------------
# HOW TO USE this makefile:
#
# For MACRODEF, see TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md)
# or examine Sections 6-8 in rules.vc.
# 1)  It is now necessary to have MSVCDir, MSDevDir or MSSDK set in the
#     environment.  This is used as a check to see if vcvars32.bat had been
#     run prior to running nmake or during the installation of Microsoft
#     Visual C++, MSVCDir had been set globally and the PATH adjusted.
#     Either way is valid.
#
#     You'll need to run vcvars32.bat contained in the MsDev's vc(98)/bin
#     directory to setup the proper environment, if needed, for your
#     current setup.  This is a needed bootstrap requirement and allows the
#     swapping of different environments to be easier.
#
# 2)  To use the Platform SDK (not expressly needed), run setenv.bat after
#     vcvars32.bat according to the instructions for it.  This can also
#     turn on the 64-bit compiler, if your SDK has it.
#
# Possible values of TARGET are:
# 3)  Targets are:
#	release  -- Builds the core, the shell and the dlls. (default)
#	dlls     -- Just builds the windows extensions
#	dlls     -- Just builds the windows extensions and the 16-bit DOS
#		    pipe/thunk helper app.
#	shell    -- Just builds the shell and the core.
#	core     -- Only builds the core [tclXX.(dll|lib)].
#	all      -- Builds everything.
#	test     -- Builds and runs the test suite.
#	tcltest  -- Just builds the test shell.
#	install  -- Installs the built binaries and libraries to $(INSTALLDIR)
#		    as the root of the install tree.
#	tidy/clean/hose -- varying levels of cleaning.
#	genstubs -- Rebuilds the Stubs table and support files (dev only).
#	depend   -- Generates an accurate set of source dependancies for this
#		    makefile.  Helpful to avoid problems when the sources are
#		    refreshed and you rebuild, but can "overbuild" when common
#		    headers like tclInt.h just get small changes.
#	htmlhelp -- Builds a Windows .chm help file for Tcl and Tk from the
#		    troff manual pages found in $(ROOT)\doc. You need to
#		    have installed the HTML Help Compiler package from Microsoft
#		    to produce the .chm file.
#
# The steps to setup a Visual C++ environment depend on which
#	winhelp  -- Builds the windows .hlp file for Tcl from the troff man
#		    files found in $(ROOT)\doc.
# version of Visual Studio and/or the Windows SDK you are building
# against and are not described here. The simplest method is generally
# to start a command shell using one of the short cuts installed by
# Visual Studio/Windows SDK for the appropriate target architecture.
#
# NOTE: For older (Visual C++ 6 or the 2003 SDK), to use the Platform
# SDK (not expressly needed), run setenv.bat after
# vcvars32.bat according to the instructions for it.  This can also
# turn on the 64-bit compiler, if your SDK has it.
# 4)  Macros usable on the commandline:
#	INSTALLDIR=<path>
#		Sets where to install Tcl from the built binaries.
#		C:\Progra~1\Tcl is assumed when not specified.
#
# Basic macros and options usable on the commandline (see rules.vc for more info):
#	OPTS=msvcrt,nothreads,pdbs,profile,static,staticpkg,symbols,thrdalloc,unchecked,none
#	OPTS=loimpact,msvcrt,static,staticpkg,symbols,threads,profile,unchecked,time64bit,none
#		Sets special options for the core.  The default is for none.
#		Any combination of the above may be used (comma separated).
#		'none' will over-ride everything to nothing.
#
#		loimpact = Adds a flag for how NT treats the heap to keep memory
#			   in use, low.  This is said to impact alloc performance.
#		msvcrt    = Affects the static option only to switch it from
#			    using libcmt(d) as the C runtime [by default] to
#			    msvcrt(d). This is useful for static embedding
#			    support.
#		msvcrt   = Affects the static option only to switch it from
#			   using libcmt(d) as the C runtime [by default] to
#			   msvcrt(d). This is useful for static embedding
#			   support.
#		nothreads = Turns off full multithreading support (default on).
#		pbds      =  Produce separate debug symbol files.
#		profile   =  Adds profiling hooks.  Map file is assumed.
#		static    = Builds a static library of the core instead of a
#			    dll.  The shell will be static (and large), as well.
#		staticpkg = Affects the static option only to switch
#			    tclshXX.exe to have the dde and reg extension linked
#			    inside it.
#		static   = Builds a static library of the core instead of a
#			   dll.  The shell will be static (and large), as well.
#		staticpkg= Affects the static option only to switch
#			   tclshXX.exe to have the dde and reg extension linked
#			   inside it.
#		symbols   =  Adds symbols for step debugging.
#		threads  = Turns on full multithreading support.
#		thrdalloc = Use the thread allocator (shared global free pool).
#		thrdstorage = Use the generic thread storage support.
#		symbols =  Adds symbols for step debugging.
#		profile =  Adds profiling hooks.  Map file is assumed.
#		unchecked = Allows a symbols build to not use the debug
#			    enabled runtime (msvcrt.dll not msvcrtd.dll
#			    or libcmt.lib not libcmtd.lib).
#			   enabled runtime (msvcrt.dll not msvcrtd.dll
#			   or libcmt.lib not libcmtd.lib).
#		time64bit = Forces a build using 64-bit time_t for 32-bit build
#			   (CRT library should support this).
#
#	STATS=compdbg,memdbg,none
#		Sets optional memory and bytecode compiler debugging code added
#		to the core.  The default is for none.  Any combination of the
#		above may be used (comma separated).  'none' will over-ride
#		everything to nothing.
#
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
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
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

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
611
612
613
614
615
616

617
618

619
620
621
622
623
624
625
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

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
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
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
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




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
611


612










613








614
615

616





617



618








619








620







621
622
623
624
625
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
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



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







+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+

+
+
-
-
+
+
+
+
+

+
+
+

-
+
-
-
+
+
+
+
+

-
-
-

-
-
-
+
+
+

-
-
+
+
+
+
+
+

-
-
+


-
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-



-









-




-
-


-
+





-









-
-





-

-
















-




-



-
-
-
-
-
-
-

-









-







+










-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
-
-


















-
+
-



-
-
-
+
+
+

-
+
+













-
-
+
+





+
+
-
-
-
-
+
+
+
+



-
-
-

-
-

-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-



-
-

-
+
-
-
-

-
+
-
+
+
+

+
-
+

+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+














-
+


-
-
-
-
+
+
+
+
-
-
-
-

-
-
+
+

+

-
-
+
+

+
+
+
+
+
+
+
+

-
+







+
+
+
+
-
+
+
+


+
-
+


-

-
+
-
-
+



+
+

-
-
+
+
-

-
-
-

-
+



-
+


+
+
+
+
+


-
+


+
-
+

+
+




-
+


+
-
+

-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-


-
+
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-












-
-


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+
-
-
-
-
-
+
+

-
+







-
+

-
+



-


-

-
+



-
-
-
-
-
-
+
+
+
+
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
-
-
-
-







-









-
+




+


-
+








-
+



-













+







#		changed.  $(OUT_DIR) is assumed to be
#		$(BINROOT)\(Release|Debug) based on if symbols are requested.
#		$(TMP_DIR) will de $(OUT_DIR)\<buildtype> by default.
#
#	TESTPAT=<file>
#		Reads the tests requested to be run from this file.
#
#	CFG_ENCODING=encoding
#		name of encoding for configuration information. Defaults
#		to cp1252
#
# Examples:
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc test
# 5)  Examples:
#
#	Basic syntax of calling nmake looks like this:
#	nmake [-nologo] -f makefile.vc [target|macrodef [target|macrodef] [...]]
#
#                        Standard (no frills)
#       c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
#       Setting environment for using Microsoft Visual C++ tools.
#       c:\tcl_src\win\>nmake -f makefile.vc release
#       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
#
#                         Building for Win64
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
#       c:\tcl_src\win\>c:\progra~1\micros~1\vc98\bin\vcvars32.bat
#       Setting environment for using Microsoft Visual C++ tools.
#       c:\tcl_src\win\>c:\progra~1\platfo~1\setenv.bat /pre64 /RETAIL
#       Targeting Windows pre64 RETAIL
#       c:\tcl_src\win\>nmake -f makefile.vc MACHINE=IA64
#
#------------------------------------------------------------------------------
#==============================================================================
###############################################################################

# NOTE:

# Before modifying this file, check whether the modification is applicable
# to building extensions as well and if so, modify rules.vc instead.
#    //==================================================================\\
#   >>[               -> Do not modify below this line. <-               ]<<
#   >>[  Please, use the commandline macros to modify how Tcl is built.  ]<<
#   >>[  If you need more features, send us a patch for more macros.     ]<<
#    \\==================================================================//

# The PROJECT macro is used by rules.vc for generating appropriate
# macros and rules.
PROJECT = tcl

# Default target to build if no target is specified. If unspecified, the
# rules.vc file will set up "all" as the target.
DEFAULT_BUILD_TARGET = release
###############################################################################
#==============================================================================
#------------------------------------------------------------------------------

# We want to use our own resource file, not the standard template one.
RCFILE = tcl.rc
!if !exist("makefile.vc")
MSG = ^
You must run this makefile only from the directory it is in.^
Please `cd` to its location first.
!error $(MSG)
!endif

# The rules.vc file does most of the hard work in terms of defining
# the build configuration, macros, output directories etc.
PROJECT = tcl
!include "rules.vc"

# Tcl version info based on macros set up by rules.vc
STUBPREFIX      = $(PROJECT)stub
DOTVERSION      = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION         = $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)

# We need versions of various core packages to generate appropriate
# file names during installation.
!if [echo REM = This file is generated from makefile.vc > versions.vc]
!endif
!if [echo PKG_HTTP_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
!endif
!if [echo PKG_OPT_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\opt\pkgIndex.tcl opt >> versions.vc]
!endif
!if [echo PKG_COOKIEJAR_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\cookiejar\pkgIndex.tcl cookiejar >> versions.vc]
!endif
!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
!endif
!if [echo PKG_MSGCAT_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc]
!endif
!if [echo PKG_PLATFORM_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc]
!endif
!if [echo PKG_SHELL_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc]
!endif
!if [echo PKG_DDE_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
!endif
!if [echo PKG_REG_VER =\>> versions.vc] \
   && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
!endif

!include versions.vc

DDEDOTVERSION = 1.4
DDEVERSION = $(DDEDOTVERSION:.=)

REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)

BINROOT		= .
ROOT		= ..

TCLIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
TCLLIB		= $(OUT_DIR)\$(TCLLIBNAME)

TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)

TCLSHNAME	= $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH		= $(OUT_DIR)\$(TCLSHNAME)
TCLPIPEDLLNAME	= $(PROJECT)pip$(VERSION)$(SUFX:t=).dll
TCLPIPEDLL	= $(OUT_DIR)\$(TCLPIPEDLLNAME)

TCLREGLIBNAME	= $(PROJECT)reg$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)

TCLDDELIBNAME	= $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB	= $(OUT_DIR)\$(TCLDDELIBNAME)

TCLTEST		= $(OUT_DIR)\$(PROJECT)test.exe
CAT32		= $(OUT_DIR)\cat32.exe

# Can we run what we build? IX86 runs on all architectures.
!ifndef TCLSH_NATIVE
!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
TCLSH_NATIVE	= $(TCLSH)
!else
!error You must explicitly set TCLSH_NATIVE for cross-compilation
!endif
!endif

### Make sure we use backslash only.
LIB_INSTALL_DIR		= $(_INSTALLDIR)\lib
BIN_INSTALL_DIR		= $(_INSTALLDIR)\bin
DOC_INSTALL_DIR		= $(_INSTALLDIR)\doc
SCRIPT_INSTALL_DIR	= $(_INSTALLDIR)\lib\tcl$(DOTVERSION)
INCLUDE_INSTALL_DIR	= $(_INSTALLDIR)\include

TCLSHOBJS = \
	$(TMP_DIR)\tclAppInit.obj \
!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \
!endif
!endif
	$(TMP_DIR)\tclsh.res

TCLTESTOBJS = \
	$(TMP_DIR)\tclTest.obj \
	$(TMP_DIR)\tclTestObj.obj \
	$(TMP_DIR)\tclTestProcBodyObj.obj \
	$(TMP_DIR)\tclThreadTest.obj \
	$(TMP_DIR)\tclWinTest.obj \
!if !$(STATIC_BUILD)
!if $(TCL_USE_STATIC_PACKAGES)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \
!endif
	$(OUT_DIR)\tommath.lib \
!endif
	$(TMP_DIR)\testMain.obj

COREOBJS = \
TCLOBJS = \
	$(TMP_DIR)\regcomp.obj \
	$(TMP_DIR)\regerror.obj \
	$(TMP_DIR)\regexec.obj \
	$(TMP_DIR)\regfree.obj \
	$(TMP_DIR)\tclAlloc.obj \
	$(TMP_DIR)\tclAssembly.obj \
	$(TMP_DIR)\tclAsync.obj \
	$(TMP_DIR)\tclBasic.obj \
	$(TMP_DIR)\tclBinary.obj \
	$(TMP_DIR)\tclCkalloc.obj \
	$(TMP_DIR)\tclClock.obj \
	$(TMP_DIR)\tclCmdAH.obj \
	$(TMP_DIR)\tclCmdIL.obj \
	$(TMP_DIR)\tclCmdMZ.obj \
	$(TMP_DIR)\tclCompCmds.obj \
	$(TMP_DIR)\tclCompCmdsGR.obj \
	$(TMP_DIR)\tclCompCmdsSZ.obj \
	$(TMP_DIR)\tclCompExpr.obj \
	$(TMP_DIR)\tclCompile.obj \
	$(TMP_DIR)\tclConfig.obj \
	$(TMP_DIR)\tclDate.obj \
	$(TMP_DIR)\tclDictObj.obj \
	$(TMP_DIR)\tclDisassemble.obj \
	$(TMP_DIR)\tclEncoding.obj \
	$(TMP_DIR)\tclEnsemble.obj \
	$(TMP_DIR)\tclEnv.obj \
	$(TMP_DIR)\tclEvent.obj \
	$(TMP_DIR)\tclExecute.obj \
	$(TMP_DIR)\tclFCmd.obj \
	$(TMP_DIR)\tclFileName.obj \
	$(TMP_DIR)\tclGet.obj \
	$(TMP_DIR)\tclHash.obj \
	$(TMP_DIR)\tclHistory.obj \
	$(TMP_DIR)\tclIndexObj.obj \
	$(TMP_DIR)\tclInterp.obj \
	$(TMP_DIR)\tclIO.obj \
	$(TMP_DIR)\tclIOCmd.obj \
	$(TMP_DIR)\tclIOGT.obj \
	$(TMP_DIR)\tclIOSock.obj \
	$(TMP_DIR)\tclIOUtil.obj \
	$(TMP_DIR)\tclIORChan.obj \
	$(TMP_DIR)\tclIORTrans.obj \
	$(TMP_DIR)\tclLink.obj \
	$(TMP_DIR)\tclListObj.obj \
	$(TMP_DIR)\tclLiteral.obj \
	$(TMP_DIR)\tclLoad.obj \
	$(TMP_DIR)\tclMainW.obj \
	$(TMP_DIR)\tclMain.obj \
	$(TMP_DIR)\tclNamesp.obj \
	$(TMP_DIR)\tclNotify.obj \
	$(TMP_DIR)\tclOO.obj \
	$(TMP_DIR)\tclOOBasic.obj \
	$(TMP_DIR)\tclOOCall.obj \
	$(TMP_DIR)\tclOODefineCmds.obj \
	$(TMP_DIR)\tclOOInfo.obj \
	$(TMP_DIR)\tclOOMethod.obj \
	$(TMP_DIR)\tclOOStubInit.obj \
	$(TMP_DIR)\tclObj.obj \
	$(TMP_DIR)\tclOptimize.obj \
	$(TMP_DIR)\tclPanic.obj \
	$(TMP_DIR)\tclParse.obj \
	$(TMP_DIR)\tclPathObj.obj \
	$(TMP_DIR)\tclPipe.obj \
	$(TMP_DIR)\tclPkg.obj \
	$(TMP_DIR)\tclPkgConfig.obj \
	$(TMP_DIR)\tclPosixStr.obj \
	$(TMP_DIR)\tclPreserve.obj \
	$(TMP_DIR)\tclProc.obj \
	$(TMP_DIR)\tclProcess.obj \
	$(TMP_DIR)\tclRegexp.obj \
	$(TMP_DIR)\tclResolve.obj \
	$(TMP_DIR)\tclResult.obj \
	$(TMP_DIR)\tclScan.obj \
	$(TMP_DIR)\tclStringObj.obj \
	$(TMP_DIR)\tclStrToD.obj \
	$(TMP_DIR)\tclStubInit.obj \
	$(TMP_DIR)\tclStubLib.obj \
	$(TMP_DIR)\tclThread.obj \
	$(TMP_DIR)\tclThreadAlloc.obj \
	$(TMP_DIR)\tclThreadJoin.obj \
	$(TMP_DIR)\tclThreadStorage.obj \
	$(TMP_DIR)\tclTimer.obj \
	$(TMP_DIR)\tclTomMathInterface.obj \
	$(TMP_DIR)\tclTrace.obj \
	$(TMP_DIR)\tclUtf.obj \
	$(TMP_DIR)\tclUtil.obj \
	$(TMP_DIR)\tclVar.obj \
	$(TMP_DIR)\tclZipfs.obj \
	$(TMP_DIR)\tclZlib.obj

!if $(STATIC_BUILD)
	$(TMP_DIR)\tclWin32Dll.obj \
	$(TMP_DIR)\tclWinChan.obj \
	$(TMP_DIR)\tclWinConsole.obj \
	$(TMP_DIR)\tclWinSerial.obj \
ZLIBOBJS = \
	$(TMP_DIR)\adler32.obj \
	$(TMP_DIR)\compress.obj \
	$(TMP_DIR)\crc32.obj \
	$(TMP_DIR)\deflate.obj \
	$(TMP_DIR)\infback.obj \
	$(TMP_DIR)\inffast.obj \
	$(TMP_DIR)\inflate.obj \
	$(TMP_DIR)\inftrees.obj \
	$(TMP_DIR)\trees.obj \
	$(TMP_DIR)\uncompr.obj \
	$(TMP_DIR)\zutil.obj
!else
ZLIBOBJS = $(OUT_DIR)\zdll.lib
	$(TMP_DIR)\tclWinError.obj \
	$(TMP_DIR)\tclWinFCmd.obj \
	$(TMP_DIR)\tclWinFile.obj \
	$(TMP_DIR)\tclWinInit.obj \
	$(TMP_DIR)\tclWinLoad.obj \
	$(TMP_DIR)\tclWinNotify.obj \
	$(TMP_DIR)\tclWinPipe.obj \
	$(TMP_DIR)\tclWinSock.obj \
	$(TMP_DIR)\tclWinThrd.obj \
	$(TMP_DIR)\tclWinTime.obj \
	$(TMP_DIR)\bncore.obj \
	$(TMP_DIR)\bn_reverse.obj \
	$(TMP_DIR)\bn_fast_s_mp_mul_digs.obj \
!endif

	$(TMP_DIR)\bn_fast_s_mp_sqr.obj \
!if $(STATIC_BUILD)
TOMMATHOBJS = \
	$(TMP_DIR)\bn_mp_add.obj \
	$(TMP_DIR)\bn_mp_add_d.obj \
	$(TMP_DIR)\bn_mp_and.obj \
	$(TMP_DIR)\bn_mp_clamp.obj \
	$(TMP_DIR)\bn_mp_clear.obj \
	$(TMP_DIR)\bn_mp_clear_multi.obj \
	$(TMP_DIR)\bn_mp_cmp.obj \
	$(TMP_DIR)\bn_mp_cmp_d.obj \
	$(TMP_DIR)\bn_mp_cmp_mag.obj \
	$(TMP_DIR)\bn_mp_cnt_lsb.obj \
	$(TMP_DIR)\bn_mp_copy.obj \
	$(TMP_DIR)\bn_mp_count_bits.obj \
	$(TMP_DIR)\bn_mp_div.obj \
	$(TMP_DIR)\bn_mp_div_d.obj \
	$(TMP_DIR)\bn_mp_div_2.obj \
	$(TMP_DIR)\bn_mp_div_2d.obj \
	$(TMP_DIR)\bn_mp_div_3.obj \
	$(TMP_DIR)\bn_mp_exch.obj \
	$(TMP_DIR)\bn_mp_expt_u32.obj \
	$(TMP_DIR)\bn_mp_expt_d.obj \
	$(TMP_DIR)\bn_mp_get_mag_u64.obj \
	$(TMP_DIR)\bn_mp_grow.obj \
	$(TMP_DIR)\bn_mp_init.obj \
	$(TMP_DIR)\bn_mp_init_copy.obj \
	$(TMP_DIR)\bn_mp_init_i64.obj \
	$(TMP_DIR)\bn_mp_init_multi.obj \
	$(TMP_DIR)\bn_mp_init_set.obj \
	$(TMP_DIR)\bn_mp_init_multi.obj \
	$(TMP_DIR)\bn_mp_init_set.obj \
	$(TMP_DIR)\bn_mp_init_set_int.obj \
	$(TMP_DIR)\bn_mp_init_size.obj \
	$(TMP_DIR)\bn_mp_init_u64.obj \
	$(TMP_DIR)\bn_mp_karatsuba_mul.obj \
	$(TMP_DIR)\bn_mp_karatsuba_sqr.obj \
	$(TMP_DIR)\bn_mp_lshd.obj \
	$(TMP_DIR)\bn_mp_mod.obj \
	$(TMP_DIR)\bn_mp_mod_2d.obj \
	$(TMP_DIR)\bn_mp_mul.obj \
	$(TMP_DIR)\bn_mp_mul_2.obj \
	$(TMP_DIR)\bn_mp_mul_2d.obj \
	$(TMP_DIR)\bn_mp_mul_d.obj \
	$(TMP_DIR)\bn_mp_neg.obj \
	$(TMP_DIR)\bn_mp_or.obj \
	$(TMP_DIR)\bn_mp_radix_size.obj \
	$(TMP_DIR)\bn_mp_radix_smap.obj \
	$(TMP_DIR)\bn_mp_read_radix.obj \
	$(TMP_DIR)\bn_mp_rshd.obj \
	$(TMP_DIR)\bn_mp_set_i64.obj \
	$(TMP_DIR)\bn_mp_set_u64.obj \
	$(TMP_DIR)\bn_mp_set.obj \
	$(TMP_DIR)\bn_mp_set_int.obj \
	$(TMP_DIR)\bn_mp_shrink.obj \
	$(TMP_DIR)\bn_mp_sqr.obj \
	$(TMP_DIR)\bn_mp_sqrt.obj \
	$(TMP_DIR)\bn_mp_sub.obj \
	$(TMP_DIR)\bn_mp_sub_d.obj \
	$(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
	$(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
	$(TMP_DIR)\bn_mp_signed_rsh.obj \
	$(TMP_DIR)\bn_mp_to_ubin.obj \
	$(TMP_DIR)\bn_mp_to_radix.obj \
	$(TMP_DIR)\bn_mp_ubin_size.obj \
	$(TMP_DIR)\bn_mp_toom_mul.obj \
	$(TMP_DIR)\bn_mp_toom_sqr.obj \
	$(TMP_DIR)\bn_mp_toradix_n.obj \
	$(TMP_DIR)\bn_mp_unsigned_bin_size.obj \
	$(TMP_DIR)\bn_mp_xor.obj \
	$(TMP_DIR)\bn_mp_zero.obj \
	$(TMP_DIR)\bn_s_mp_add.obj \
	$(TMP_DIR)\bn_s_mp_balance_mul.obj \
	$(TMP_DIR)\bn_s_mp_karatsuba_mul.obj \
	$(TMP_DIR)\bn_s_mp_karatsuba_sqr.obj \
	$(TMP_DIR)\bn_s_mp_mul_digs.obj \
	$(TMP_DIR)\bn_s_mp_mul_digs_fast.obj \
	$(TMP_DIR)\bn_s_mp_reverse.obj \
	$(TMP_DIR)\bn_s_mp_sqr.obj \
	$(TMP_DIR)\bn_s_mp_sqr_fast.obj \
	$(TMP_DIR)\bn_s_mp_sub.obj \
	$(TMP_DIR)\bn_s_mp_toom_sqr.obj \
	$(TMP_DIR)\bn_s_mp_toom_mul.obj
!else
TOMMATHOBJS = $(OUT_DIR)\tommath.lib
!endif

PLATFORMOBJS = \
	$(TMP_DIR)\tclWin32Dll.obj \
	$(TMP_DIR)\tclWinChan.obj \
	$(TMP_DIR)\tclWinConsole.obj \
	$(TMP_DIR)\tclWinError.obj \
	$(TMP_DIR)\tclWinFCmd.obj \
	$(TMP_DIR)\tclWinFile.obj \
	$(TMP_DIR)\tclWinInit.obj \
	$(TMP_DIR)\tclWinLoad.obj \
	$(TMP_DIR)\tclWinNotify.obj \
	$(TMP_DIR)\tclWinPipe.obj \
	$(TMP_DIR)\tclWinSerial.obj \
	$(TMP_DIR)\tclWinSock.obj \
	$(TMP_DIR)\tclWinThrd.obj \
	$(TMP_DIR)\tclWinTime.obj \
!if $(STATIC_BUILD)
!if !$(STATIC_BUILD)
	$(TMP_DIR)\tclWinReg.obj \
	$(TMP_DIR)\tclWinDde.obj \
!else
	$(TMP_DIR)\tcl.res
!endif

TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)

TCLSTUBOBJS = \
	$(TMP_DIR)\tclStubLib.obj \
	$(TMP_DIR)\tclStubLib.obj
	$(TMP_DIR)\tclTomMathStubLib.obj \
	$(TMP_DIR)\tclOOStubLib.obj \
	$(TMP_DIR)\tclWinPanic.obj

### The following paths CANNOT have spaces in them as they appear on
### The following paths CANNOT have spaces in them.
### the left side of implicit rules.
COMPATDIR	= $(ROOT)\compat
DOCDIR		= $(ROOT)\doc
GENERICDIR	= $(ROOT)\generic
TOMMATHDIR	= $(ROOT)\libtommath
TOOLSDIR	= $(ROOT)\tools
PKGSDIR		= $(ROOT)\pkgs
WIN_DIR		= $(ROOT)\win

#---------------------------------------------------------------------
# Compile flags
#---------------------------------------------------------------------
# Additional include and C macro definitions for the implicit rules
# defined in rules.vc
PRJ_INCLUDES	= -I"$(TOMMATHDIR)"
PRJ_DEFINES	= /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS

!if !$(DEBUG)
!if $(OPTIMIZING)
### This cranks the optimization level to maximize speed
cdebug	= -O2 $(OPTIMIZATIONS)
!else
cdebug	=
!endif
!if $(SYMBOLS)
cdebug	= $(cdebug) -Zi
!endif
!else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
### Warnings are too many, can't support warnings into errors.
cdebug	= -Zi -Od $(DEBUGFLAGS)
!else
cdebug	= -Zi -WX $(DEBUGFLAGS)
!endif

### Declarations common to all compiler options
cwarn = $(WARNINGS) /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE
cflags = -nologo -c $(COMPILERFLAGS) $(cwarn) -Fp$(TMP_DIR)^\

!if $(MSVCRT)
!if $(DEBUG) && !$(UNCHECKED)
crt = -MDd
!else
crt = -MD
!endif
!else
!if $(DEBUG) && !$(UNCHECKED)
crt = -MTd
!else
crt = -MT
!endif
!endif

TCL_INCLUDES	= -I"$(WIN_DIR)" -I"$(GENERICDIR)" -I"$(TOMMATHDIR)"
TCL_DEFINES	= /DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline
BASE_CFLAGS	= $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES)
CON_CFLAGS	= $(cflags) $(cdebug) $(crt) /DCONSOLE
TCL_CFLAGS	= $(BASE_CFLAGS) $(OPTDEFINES)
STUB_CFLAGS     = $(cflags) $(cdebug) $(OPTDEFINES)


#---------------------------------------------------------------------
# Link flags
#---------------------------------------------------------------------
# Additional Link libraries needed beyond those in rules.vc
PRJ_LIBS   = netapi32.lib user32.lib userenv.lib ws2_32.lib

!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3
!if $(SYMBOLS)
ldebug	= $(ldebug) -debug -debugtype:cv
!endif
!endif

### Declarations common to all linker options
lflags	= -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)

!if $(PROFILE)
lflags	= $(lflags) -profile
!endif

!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
lflags	= $(lflags) -nodefaultlib:libucrt.lib
!endif

!if $(LOIMPACT)
lflags	= $(lflags) -ws:aggressive
!endif

dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows

baselibs   = kernel32.lib user32.lib ws2_32.lib
# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500
baselibs   = $(baselibs) bufferoverflowU.lib
!endif
!endif
!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
baselibs   = $(baselibs) ucrt.lib
!endif

#---------------------------------------------------------------------
# TclTest flags
#---------------------------------------------------------------------

!if "$(TESTPAT)" != ""
TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
!endif


#---------------------------------------------------------------------
# Project specific targets
#---------------------------------------------------------------------

release:    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
release:    setup $(TCLSH) $(TCLSTUBLIB) dlls
core:	    setup $(TCLLIB) $(TCLSTUBLIB)
shell:	    setup $(TCLSH)
dlls:	    setup $(TCLREGLIB) $(TCLDDELIB) $(OUT_DIR)\zlib1.dll $(OUT_DIR)\libtommath.dll
all:	    setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
tcltest:    setup $(TCLTEST) dlls
install:    install-binaries install-libraries install-docs install-pkgs
dlls:	    setup $(TCLPIPEDLL) $(TCLREGLIB) $(TCLDDELIB)
all:	    setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32)
tcltest:    setup $(TCLTEST) dlls $(CAT32)
install:    install-binaries install-libraries install-docs
!if $(SYMBOLS)
install:    install-pdbs
!endif
setup:      default-setup

test: test-core test-pkgs
test-core: setup $(TCLTEST) dlls
test: test-core
test-core: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
!if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
	$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
		package ifneeded dde 1.4.3 [list load "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" registry]
		package ifneeded dde 1.4.3 [list load "$(TCLDDELIB:\=/)" Dde]
		package ifneeded registry 1.3.5 [list load "$(TCLREGLIB:\=/)" Registry]
<<
!else
	@echo Please wait while the tests are collected...
	$(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile << > tests.log
		package ifneeded dde 1.4.3 "$(TCLDDELIB:\=/)" dde]
		package ifneeded registry 1.3.5 "$(TCLREGLIB:\=/)" registry]
<<
	type tests.log | more
!endif

runtest: setup $(TCLTEST) dlls
runtest: setup $(TCLTEST) dlls $(CAT32)
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLTEST) $(SCRIPT)

runshell: setup $(TCLSH) dlls
	set TCL_LIBRARY=$(ROOT:\=/)/library
	$(DEBUGGER) $(TCLSH) $(SCRIPT)

setup:
	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)

!if $(STATIC_BUILD)
!if !$(STATIC_BUILD)
$(TCLIMPLIB): $(TCLLIB)
!endif

$(TCLLIB): $(TCLOBJS)
!if $(STATIC_BUILD)
	$(LIBCMD) @<<
	$(lib32) -nologo $(LINKERFLAGS) -out:$@ @<<
$**
<<

!else

	$(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tcl -out:$@ \
$(TCLLIB): $(TCLOBJS)
	$(DLLCMD) @<<
		$(baselibs) @<<
$**
<<
	$(_VC_MANIFEST_EMBED_DLL)
	-@del $*.exp
!endif

$(TCLIMPLIB): $(TCLLIB)

$(TCLSTUBLIB): $(TCLSTUBOBJS)
	$(lib32) -nologo $(LINKERFLAGS) -nodefaultlib -out:$@ $(TCLSTUBOBJS)
!endif # $(STATIC_BUILD)

$(TCLSTUBLIB): $(TCLSTUBOBJS)
	$(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)

$(TCLSH): $(TCLSHOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
	$(CONEXECMD) -stack:2300000 $**
	$(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
	$(_VC_MANIFEST_EMBED_EXE)

$(TCLTEST): $(TCLTESTOBJS) $(TCLSTUBLIB) $(TCLIMPLIB)
	$(CONEXECMD) -stack:2300000 $**
	$(link32) $(conlflags) -stack:2300000 -out:$@ $(baselibs) $**
	$(_VC_MANIFEST_EMBED_EXE)

$(TCLPIPEDLL): $(WIN_DIR)\stub16.c
	$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $(WIN_DIR)\stub16.c
	$(link32) $(conlflags) -out:$@ $(TMP_DIR)\stub16.obj $(baselibs)
	$(_VC_MANIFEST_EMBED_DLL)

!if $(STATIC_BUILD)
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj
	$(LIBCMD) $**
	$(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
!else
$(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB)
	$(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tcldde -out:$@ \
	$(DLLCMD) $**
		$** $(baselibs)
	$(_VC_MANIFEST_EMBED_DLL)
	-@del $*.exp
	-@del $*.lib
!endif

!if $(STATIC_BUILD)
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj
	$(LIBCMD) $**
	$(lib32) -nologo $(LINKERFLAGS) -out:$@ $**
!else
$(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(TCLSTUBLIB)
	$(link32) $(dlllflags) -base:@$(WIN_DIR)\coffbase.txt,tclreg -out:$@ \
	$(DLLCMD) $**
		$** $(baselibs)
	$(_VC_MANIFEST_EMBED_DLL)
!endif

	-@del $*.exp
!if "$(MACHINE)" == "AMD64"
$(OUT_DIR)\zlib1.dll:	$(COMPATDIR)\zlib\win64\zlib1.dll
	$(COPY) $(COMPATDIR)\zlib\win64\zlib1.dll $(OUT_DIR)\zlib1.dll
$(OUT_DIR)\zdll.lib:	$(COMPATDIR)\zlib\win64\zdll.lib
	$(COPY) $(COMPATDIR)\zlib\win64\zdll.lib $(OUT_DIR)\zdll.lib
$(OUT_DIR)\libtommath.dll:	$(TOMMATHDIR)\win64\libtommath.dll
	$(COPY) $(TOMMATHDIR)\win64\libtommath.dll $(OUT_DIR)\libtommath.dll
$(OUT_DIR)\tommath.lib:	$(TOMMATHDIR)\win64\tommath.lib
	$(COPY) $(TOMMATHDIR)\win64\tommath.lib $(OUT_DIR)\tommath.lib
!else
	-@del $*.lib
$(OUT_DIR)\zlib1.dll:	$(COMPATDIR)\zlib\win32\zlib1.dll
	$(COPY) $(COMPATDIR)\zlib\win32\zlib1.dll $(OUT_DIR)\zlib1.dll
$(OUT_DIR)\zdll.lib:	$(COMPATDIR)\zlib\win32\zdll.lib
	$(COPY) $(COMPATDIR)\zlib\win32\zdll.lib $(OUT_DIR)\zdll.lib
$(OUT_DIR)\libtommath.dll:	$(TOMMATHDIR)\win32\libtommath.dll
	$(COPY) $(TOMMATHDIR)\win32\libtommath.dll $(OUT_DIR)\libtommath.dll
$(OUT_DIR)\tommath.lib:	$(TOMMATHDIR)\win32\tommath.lib
	$(COPY) $(TOMMATHDIR)\win32\tommath.lib $(OUT_DIR)\tommath.lib
!endif


$(CAT32): $(WIN_DIR)\cat.c
pkgs:
	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
	    $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) &\
	$(cc32) $(CON_CFLAGS) -Fo$(TMP_DIR)\ $?
	    popd \
	  )

	$(link32) $(conlflags) -out:$@ -stack:16384 $(TMP_DIR)\cat.obj \
test-pkgs:
	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
	    $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) test &\
	    popd \
	  )

		$(baselibs)
install-pkgs:
	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
	    $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) install &\
	    popd \
	  )

	$(_VC_MANIFEST_EMBED_EXE)
clean-pkgs:
	@for /d %d in ($(PKGSDIR)\*) do \
	  @if exist "%~fd\win\makefile.vc" ( \
	    pushd "%~fd\win" & \
	    $(MAKE) -$(MAKEFLAGS) -f makefile.vc TCLDIR=$(ROOT) clean &\
	    popd \
	  )

#---------------------------------------------------------------------
# Regenerate the stubs files.  [Development use only]
#---------------------------------------------------------------------

genstubs:
!if !exist($(TCLSH))
	@echo Build tclsh first!
!else
	$(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
		$(GENERICDIR:\=/)/tcl.decls $(GENERICDIR:\=/)/tclInt.decls \
		$(GENERICDIR:\=/)/tclTomMath.decls
	$(TCLSH) $(TOOLSDIR:\=/)/genStubs.tcl $(GENERICDIR:\=/) \
		$(GENERICDIR:\=/)/tclOO.decls
!endif


#----------------------------------------------------------------------
# The following target generates the file generic/tclTomMath.h.
# It needs to be run (and the results checked) after updating
# to a new release of libtommath.
#----------------------------------------------------------------------

gentommath_h:
!if !exist($(TCLSH))
	@echo Build tclsh first!
!else
	$(TCLSH) "$(TOOLSDIR:\=/)/fix_tommath_h.tcl" \
		"$(TOMMATHDIR:\=/)/tommath.h" \
		> "$(GENERICDIR)\tclTomMath.h"
!endif

#---------------------------------------------------------------------
# Build the Windows HTML help file.
#---------------------------------------------------------------------

# NOTE: you can define HHC on the command-line to override this.
# NOTE: you can define HHC on the command-line to override this
# nmake does not set macro values if already set on the command line.
!if defined(PROCESSOR_ARCHITECTURE) && "$(PROCESSOR_ARCHITECTURE)" == "AMD64"
HHC="%ProgramFiles(x86)%\HTML Help Workshop\hhc.exe"
!else
HHC="%ProgramFiles%\HTML Help Workshop\hhc.exe"
!ifndef HHC
HHC=""%ProgramFiles%\HTML Help Workshop\hhc.exe""
!endif
HTMLDIR=$(OUT_DIR)\html
HTMLDIR=$(ROOT)\html
HTMLBASE=TclTk$(VERSION)
HHPFILE=$(HTMLDIR)\$(HTMLBASE).hhp
CHMFILE=$(HTMLDIR)\$(HTMLBASE).chm

htmlhelp: chmsetup $(CHMFILE)

$(CHMFILE): $(DOCDIR)\*
	@$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl "--htmldir=$(HTMLDIR)"
	@$(TCLSH) $(TOOLSDIR)\tcltk-man2html.tcl
	@echo Compiling HTML help project
	-"$(HHC)" <<$(HHPFILE) >NUL
	@$(HHC) <<$(HHPFILE) >NUL
[OPTIONS]
Compatibility=1.1 or later
Compiled file=$(HTMLBASE).chm
Default topic=contents.htm
Display compile progress=no
Error log file=$(HTMLBASE).log
Full-text search=Yes
Language=0x409 English (United States)
Title=Tcl/Tk $(DOTVERSION) Help
Title=Tcl/Tk $(DOT_VERSION) Help
[FILES]
contents.htm
docs.css
Keywords\*.htm
TclCmd\*.htm
TclLib\*.htm
TkCmd\*.htm
TkLib\*.htm
UserCmd\*.htm
Keywords
TclCmd
TclLib
TkCmd
TkLib
UserCmd
<<

chmsetup:
	@if not exist $(HTMLDIR)\nul mkdir $(HTMLDIR)

#-------------------------------------------------------------------------
# Build the old-style Windows .hlp file
#-------------------------------------------------------------------------

TCLHLPBASE	= $(PROJECT)$(VERSION)
HELPFILE	= $(OUT_DIR)\$(TCLHLPBASE).hlp
HELPCNT		= $(OUT_DIR)\$(TCLHLPBASE).cnt
DOCTMP_DIR	= $(OUT_DIR)\$(PROJECT)_docs
HELPRTF		= $(DOCTMP_DIR)\$(PROJECT).rtf
MAN2HELP	= $(DOCTMP_DIR)\man2help.tcl
MAN2HELP2	= $(DOCTMP_DIR)\man2help2.tcl
INDEX		= $(DOCTMP_DIR)\index.tcl
BMP		= $(DOCTMP_DIR)\feather.bmp
BMP_NOPATH	= feather.bmp
MAN2TCL		= $(DOCTMP_DIR)\man2tcl.exe

winhelp: docsetup $(HELPFILE)

docsetup:
	@if not exist $(DOCTMP_DIR)\nul mkdir $(DOCTMP_DIR)

$(MAN2HELP) $(MAN2HELP2) $(INDEX) $(BMP): $(TOOLSDIR)\$$(@F)
	@$(CPY) $(TOOLSDIR)\$(@F) $(@D)

$(HELPFILE): $(HELPRTF) $(BMP)
	cd $(DOCTMP_DIR)
	start /wait hcrtf.exe -x <<$(PROJECT).hpj
[OPTIONS]
COMPRESS=12 Hall Zeck
LCID=0x409 0x0 0x0 ; English (United States)
TITLE=Tcl/Tk Reference Manual
BMROOT=.
CNT=$(@B).cnt
HLP=$(@B).hlp

[FILES]
$(PROJECT).rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,27648,(r15263976),(r65535)

[CONFIG]
BrowseButtons()
CreateButton(1, "Web", ExecFile("http://www.tcl.tk"))
CreateButton(2, "SF", ExecFile("http://sf.net/projects/tcl"))
CreateButton(3, "Wiki", ExecFile("http://wiki.tcl.tk"))
CreateButton(4, "FAQ", ExecFile("http://www.purl.org/NET/Tcl-FAQ/"))
<<
	cd $(MAKEDIR)
	@$(CPY) "$(DOCTMP_DIR)\$(@B).hlp" "$(OUT_DIR)"
	@$(CPY) "$(DOCTMP_DIR)\$(@B).cnt" "$(OUT_DIR)"

$(MAN2TCL): $(TOOLSDIR)\$$(@B).c
	$(cc32) $(TCL_CFLAGS) -Fo$(@D)\ $(TOOLSDIR)\$(@B).c
	$(link32) $(conlflags) -out:$@ -stack:16384 $(@D)\man2tcl.obj
	$(_VC_MANIFEST_EMBED_EXE)

$(HELPRTF): $(MAN2TCL) $(MAN2HELP) $(MAN2HELP2) $(INDEX) $(DOCDIR)\*
	$(TCLSH) $(MAN2HELP) -bitmap $(BMP_NOPATH) $(PROJECT) $(VERSION) $(DOCDIR:\=/)

install-docs:
!if exist("$(CHMFILE)")
	@echo Installing compiled HTML help
	@$(CPY) "$(CHMFILE)" "$(DOC_INSTALL_DIR)\"
!endif

# "emacs font-lock highlighting fix

!if exist("$(HELPFILE)")
	@echo Installing Windows help
	@$(CPY) "$(HELPFILE)" "$(DOC_INSTALL_DIR)\"
#---------------------------------------------------------------------
# Generate the tcl.nmake file which contains the options used to build
# Tcl itself. This is used when building extensions.
#---------------------------------------------------------------------
tcl-nmake: $(OUT_DIR)\tcl.nmake
$(OUT_DIR)\tcl.nmake:
	@type << >$@
	@$(CPY) "$(HELPCNT)" "$(DOC_INSTALL_DIR)\"
!endif
CORE_MACHINE = $(MACHINE)
CORE_DEBUG = $(DEBUG)
CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC)
<<

#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------

tclConfig: $(OUT_DIR)\tclConfig.sh

# TBD - is this tclConfig.sh file ever used? The values are incorrect!
$(OUT_DIR)\tclConfig.sh: $(WIN_DIR)\tclConfig.sh.in
	@echo Creating tclConfig.sh
        @nmakehlp -s << $** >$@
@TCL_DLL_FILE@       $(TCLLIBNAME)
@TCL_VERSION@        $(DOTVERSION)
@TCL_MAJOR_VERSION@  $(TCL_MAJOR_VERSION)
@TCL_MINOR_VERSION@  $(TCL_MINOR_VERSION)
@TCL_PATCH_LEVEL@    $(TCL_PATCH_LEVEL)
@CC@                 $(CC)
@DEFS@               $(pkgcflags)
@DEFS@               $(TCL_CFLAGS)
@CFLAGS_DEBUG@       -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MDd
@CFLAGS_OPTIMIZE@    -nologo -c -W3 -YX -Fp$(TMP_DIR)\ -MD
@LDFLAGS_DEBUG@      -nologo -machine:$(MACHINE) -debug -debugtype:cv
@LDFLAGS_OPTIMIZE@   -nologo -machine:$(MACHINE) -release -opt:ref -opt:icf,3
@TCL_DBGX@           $(SUFX)
@TCL_LIB_FILE@       $(PROJECT)$(VERSION)$(SUFX).lib
@TCL_NEEDS_EXP_FILE@
@LIBS@               $(baselibs) $(PRJ_LIBS)
@LIBS@               $(baselibs)
@prefix@             $(_INSTALLDIR)
@exec_prefix@        $(BIN_INSTALL_DIR)
@SHLIB_CFLAGS@
@STLIB_CFLAGS@
@CFLAGS_WARNING@     -W3
@EXTRA_CFLAGS@       -YX
@SHLIB_LD@           $(link32) $(dlllflags)
@STLIB_LD@           $(lib32) -nologo
@SHLIB_LD_LIBS@      $(baselibs) $(PRJ_LIBS)
@SHLIB_LD_LIBS@      $(baselibs)
@SHLIB_SUFFIX@       .dll
@DL_LIBS@
@LDFLAGS@
@TCL_CC_SEARCH_FLAGS@
@TCL_LD_SEARCH_FLAGS@
@LIBOBJS@
@RANLIB@
@TCL_LIB_FLAG@
@TCL_BUILD_LIB_SPEC@
@TCL_LIB_SPEC@       $(LIB_INSTALL_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
@TCL_INCLUDE_SPEC@   -I$(INCLUDE_INSTALL_DIR)
@TCL_LIB_VERSIONS_OK@
@TCL_SRC_DIR@        $(ROOT)
@TCL_PACKAGE_PATH@
@TCL_STUB_LIB_FILE@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_FLAG@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_SPEC@  -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
@TCL_THREADS@        $(TCL_THREADS)
@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
@TCL_STUB_LIB_PATH@  $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
@CFG_TCL_EXPORT_FILE_SUFFIX@  $(VERSION)$(SUFX).lib
@CFG_TCL_SHARED_LIB_SUFFIX@   $(VERSION)$(SUFX).dll
@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
!if $(STATIC_BUILD)
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
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







-
+



-
-
-
-

-
+


-
+


-
-
+
-
-

-
-
-

-
+










-
-



-
+




+


+
+
+
-
+
+



+
+
+
-
+
+







-
-
+
-
-
-
-
-
-
-
-




















-
+







	$(GENERICDIR)/tclGetDate.y

#---------------------------------------------------------------------
# Special case object file targets
#---------------------------------------------------------------------

$(TMP_DIR)\testMain.obj: $(WIN_DIR)\tclAppInit.c
	$(cc32) $(appcflags) /DTCL_TEST /DUNICODE /D_UNICODE \
	$(cc32) $(TCL_CFLAGS) /DTCL_TEST \
	    /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

$(TMP_DIR)\tclMainW.obj: $(GENERICDIR)\tclMain.c
	$(cc32) $(pkgcflags) /DUNICODE /D_UNICODE \
	    -Fo$@ $?

$(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c
	$(cc32) $(appcflags) -Fo$@ $?
	$(cc32) $(TCL_CFLAGS) -Fo$@ $?

$(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
	$(cc32) $(appcflags) -Fo$@ $?
	$(cc32) $(TCL_CFLAGS) -Fo$@ $?

$(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c
	$(CCAPPCMD) $?

	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
$(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -Fo$@ $?

$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
	$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $?

$(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
	$(cc32) $(pkgcflags) \
	$(cc32) /DBUILD_tcl $(TCL_CFLAGS) \
	/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="\"$(DOC_INSTALL_DIR:\=\\)\""	\
	/DCFG_RUNTIME_LIBDIR="\"$(LIB_INSTALL_DIR:\=\\)\"" \
	/DCFG_RUNTIME_BINDIR="\"$(BIN_INSTALL_DIR:\=\\)\"" \
	/DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
	/DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
	/DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\""     \
	/DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\""     \
	/DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\""     \
	-Fo$@ $?

$(TMP_DIR)\tclAppInit.obj: $(WIN_DIR)\tclAppInit.c
	$(cc32) $(appcflags) /DUNICODE /D_UNICODE \
	$(cc32) $(TCL_CFLAGS) \
	    /DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

### The following objects should be built using the stub interfaces
### *ALL* extensions need to built with /DTCL_THREADS=1

$(TMP_DIR)\tclWinReg.obj: $(WIN_DIR)\tclWinReg.c
!if $(STATIC_BUILD)
	$(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DSTATIC_BUILD -Fo$@ $?
!else
	$(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
	$(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DUSE_TCL_STUBS -Fo$@ $?
!endif


$(TMP_DIR)\tclWinDde.obj: $(WIN_DIR)\tclWinDde.c
!if $(STATIC_BUILD)
	$(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DSTATIC_BUILD -Fo$@ $?
!else
	$(cc32) $(appcflags) /DUSE_TCL_STUBS -Fo$@ $?
	$(cc32) $(TCL_CFLAGS) /DTCL_THREADS=1 /DUSE_TCL_STUBS -Fo$@ $?
!endif


### The following objects are part of the stub library and should not
### be built as DLL objects.  -Zl is used to avoid a dependency on any
### specific C run-time.

$(TMP_DIR)\tclStubLib.obj: $(GENERICDIR)\tclStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?

	$(cc32) $(STUB_CFLAGS) -Zl /DSTATIC_BUILD $(TCL_INCLUDES) -Fo$@ $?
$(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclWinPanic.obj: $(WIN_DIR)\tclWinPanic.c
	$(cc32) $(stubscflags) -Fo$@ $?

$(TMP_DIR)\tclsh.exe.manifest: $(WIN_DIR)\tclsh.exe.manifest.in
	@nmakehlp -s << $** >$@
@MACHINE@	  $(MACHINE:IX86=X86)
@TCL_WIN_VERSION@  $(DOTVERSION).0.0
<<

#---------------------------------------------------------------------
# Generate the source dependencies.  Having dependency rules will
# improve incremental build accuracy without having to resort to a
# full rebuild just because some non-global header file like
# tclCompile.h was changed.  These rules aren't needed when building
# from scratch.
#---------------------------------------------------------------------

depend:
!if !exist($(TCLSH))
	@echo Build tclsh first!
!else
	$(TCLSH) $(TOOLSDIR:\=/)/mkdepend.tcl -vc32 -out:"$(OUT_DIR)\depend.mk" \
		-passthru:"/DBUILD_tcl $(TCL_INCLUDES) $(PRJ_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
		-passthru:"/DBUILD_tcl $(TCL_INCLUDES)" $(GENERICDIR),$$(GENERICDIR) \
		$(COMPATDIR),$$(COMPATDIR) $(TOMMATHDIR),$$(TOMMATHDIR) $(WIN_DIR),$$(WIN_DIR) @<<
$(TCLOBJS)
<<
!endif

#---------------------------------------------------------------------
# Dependency rules
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
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







-
+
-
-
-


+
+
+
+
+

-
+



+
+
+
+
+
-
-
+
+



+
+
+
+
+
+
+
-
+
+
+
+













-
-




+
+
+
+



+
+
-
-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-



-
-



-
+
+












-
-
-
-
-
-
+
-
-
-
-
-
+
+
+




-
+


-
+


-
+


-
+


-
+







!endif

### add a spacer in the output
!message


#---------------------------------------------------------------------
# Implicit rules that are not covered by the common ones defined in
# Implicit rules
# rules.vc. A limitation exists with nmake that requires that
# source directory can not contain spaces in the path.  This an
# absolute.
#---------------------------------------------------------------------

{$(WIN_DIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(TOMMATHDIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
	$(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(COMPATDIR)\zlib}.c{$(TMP_DIR)}.obj::
	$(cc32) $(pkgcflags) -Fo$(TMP_DIR)\ @<<
{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
	$(cc32) $(TCL_CFLAGS) /DBUILD_tcl -Fo$(TMP_DIR)\ @<<
$<
<<

{$(WIN_DIR)}.rc{$(TMP_DIR)}.res:
	$(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
	    -d DEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
	    -d TCL_THREADS=$(TCL_THREADS) \
	    -d STATIC_BUILD=$(STATIC_BUILD) \
	    $<

$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest $(WIN_DIR)\tclsh.rc
$(TMP_DIR)\tclsh.res: $(TMP_DIR)\tclsh.exe.manifest

.SUFFIXES:
.SUFFIXES:.c .rc


#---------------------------------------------------------------------
# Installation.
#---------------------------------------------------------------------

install-binaries:
	@echo Installing to '$(_INSTALLDIR)'
	@echo Installing $(TCLLIBNAME)
!if "$(TCLLIB)" != "$(TCLIMPLIB)"
	@$(CPY) "$(TCLLIB)" "$(BIN_INSTALL_DIR)\"
!endif
	@$(CPY) "$(TCLIMPLIB)" "$(LIB_INSTALL_DIR)\"
	@$(CPY) "$(OUT_DIR)\zlib1.dll" "$(BIN_INSTALL_DIR)\"
	@$(CPY) "$(OUT_DIR)\libtommath.dll" "$(BIN_INSTALL_DIR)\"
!if exist($(TCLSH))
	@echo Installing $(TCLSHNAME)
	@$(CPY) "$(TCLSH)" "$(BIN_INSTALL_DIR)\"
!endif
!if exist($(TCLPIPEDLL))
	@echo Installing $(TCLPIPEDLLNAME)
	@$(CPY) "$(TCLPIPEDLL)" "$(BIN_INSTALL_DIR)\"
!endif
	@echo Installing $(TCLSTUBLIBNAME)
	@$(CPY) "$(TCLSTUBLIB)" "$(LIB_INSTALL_DIR)\"

#" emacs fix

install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
	@if not exist "$(SCRIPT_INSTALL_DIR)" \
install-libraries: tclConfig install-msgs install-tzdata
	@if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
	@if not exist "$(SCRIPT_INSTALL_DIR)\opt0.4$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\opt0.4"
	@if not exist "$(SCRIPT_INSTALL_DIR)\cookiejar0.2$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\cookiejar0.2"
	@if not exist "$(MODULE_INSTALL_DIR)$(NULL)" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)"
	@if not exist "$(MODULE_INSTALL_DIR)\9.0$(NULL)" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)\9.0"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
	@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
		$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
	@if not exist "$(MODULE_INSTALL_DIR)\9.0\platform$(NULL)" \
		$(MKDIR) "$(MODULE_INSTALL_DIR)\9.0\platform"
	@echo Installing header files
	@$(CPY) "$(GENERICDIR)\tcl.h"             "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclDecls.h"        "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclOO.h"           "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclOODecls.h"      "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclPlatDecls.h"    "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclTomMath.h"      "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(GENERICDIR)\tclTomMathDecls.h" "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(TOMMATHDIR)\tommath.h"         "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(TOMMATHDIR)\tommath_class.h"   "$(INCLUDE_INSTALL_DIR)\"
	@$(CPY) "$(TOMMATHDIR)\tommath_superclass.h" "$(INCLUDE_INSTALL_DIR)\"
	@echo Installing library files to $(SCRIPT_INSTALL_DIR)
	@$(CPY) "$(ROOT)\library\history.tcl"     "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\init.tcl"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\clock.tcl"       "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\tm.tcl"          "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\parray.tcl"      "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\safe.tcl"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\tclIndex"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\package.tcl"     "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\word.tcl"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(ROOT)\library\auto.tcl"        "$(SCRIPT_INSTALL_DIR)\"
	@$(CPY) "$(OUT_DIR)\tclConfig.sh"         "$(LIB_INSTALL_DIR)\"
	@$(CPY) "$(WIN_DIR)\tclooConfig.sh"        "$(LIB_INSTALL_DIR)\"
	@$(CPY) "$(WIN_DIR)\rules.vc"              "$(LIB_INSTALL_DIR)\nmake\"
	@$(CPY) "$(WIN_DIR)\targets.vc"              "$(LIB_INSTALL_DIR)\nmake\"
	@$(CPY) "$(WIN_DIR)\nmakehlp.c"            "$(LIB_INSTALL_DIR)\nmake\"
	@$(CPY) "$(OUT_DIR)\tcl.nmake"            "$(LIB_INSTALL_DIR)\nmake\"
	@echo Installing package cookiejar $(PKG_COOKIEJAR_VER)
	@echo Installing library http1.0 directory
	@$(CPY) "$(ROOT)\library\cookiejar\*.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
	@$(CPY) "$(ROOT)\library\cookiejar\*.gz" \
	    "$(SCRIPT_INSTALL_DIR)\cookiejar0.2\"
	@echo Installing package opt $(PKG_OPT_VER)
	@$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\http1.0\"
	@echo Installing library opt0.4 directory
	@$(CPY) "$(ROOT)\library\opt\*.tcl" \
	    "$(SCRIPT_INSTALL_DIR)\opt0.4\"
	@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\http\http.tcl" \
	    "$(MODULE_INSTALL_DIR)\9.0\http-$(PKG_HTTP_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\http-$(PKG_HTTP_VER).tm"
	@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
	    "$(MODULE_INSTALL_DIR)\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
	@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
	    "$(MODULE_INSTALL_DIR)\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
	@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
	    "$(MODULE_INSTALL_DIR)\9.0\platform-$(PKG_PLATFORM_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm"
	@echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
	@$(COPY) "$(ROOT)\library\platform\shell.tcl" \
	    "$(MODULE_INSTALL_DIR)\9.0\platform\shell-$(PKG_SHELL_VER).tm"
	    "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
	@echo Installing $(TCLDDELIBNAME)
!if $(STATIC_BUILD)
!if !$(TCL_USE_STATIC_PACKAGES)
	@$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\"
!endif
!else
	@$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\"
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


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







-
+
+













-
-
-
-
-




















-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
-
+
-
+
+
	@$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
	@$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \
	    "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\"
!endif
	@echo Installing encodings
	@$(CPY) "$(ROOT)\library\encoding\*.enc" \
		"$(SCRIPT_INSTALL_DIR)\encoding\"
# "emacs font-lock highlighting fix

#" emacs fix

install-tzdata:
	@echo Installing time zone data
	@set TCL_LIBRARY=$(ROOT:\=/)/library
	@$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
	    "$(ROOT:\=/)/library/tzdata" "$(SCRIPT_INSTALL_DIR)/tzdata"

install-msgs:
	@echo Installing message catalogs
	@set TCL_LIBRARY=$(ROOT:\=/)/library
	@$(TCLSH_NATIVE) "$(ROOT:\=/)/tools/installData.tcl" \
	    "$(ROOT:\=/)/library/msgs" "$(SCRIPT_INSTALL_DIR)/msgs"

install-pdbs:
	@echo Installing debug symbols
	@$(CPY) "$(OUT_DIR)\*.pdb" "$(BIN_INSTALL_DIR)\"
# "emacs font-lock highlighting fix

#---------------------------------------------------------------------
# Clean up
#---------------------------------------------------------------------

tidy:
!if "$(TCLLIB)" != "$(TCLIMPLIB)"
	@echo Removing $(TCLLIB) ...
	@if exist $(TCLLIB) del $(TCLLIB)
!endif
	@echo Removing $(TCLIMPLIB) ...
	@if exist $(TCLIMPLIB) del $(TCLIMPLIB)
	@echo Removing $(TCLSH) ...
	@if exist $(TCLSH) del $(TCLSH)
	@echo Removing $(TCLTEST) ...
	@if exist $(TCLTEST) del $(TCLTEST)
	@echo Removing $(TCLDDELIB) ...
	@if exist $(TCLDDELIB) del $(TCLDDELIB)
	@echo Removing $(TCLREGLIB) ...
	@if exist $(TCLREGLIB) del $(TCLREGLIB)

clean: default-clean clean-pkgs
hose: default-hose
clean:
	@echo Cleaning $(TMP_DIR)\* ...
	@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
	@echo Cleaning $(WIN_DIR)\nmakehlp.obj ...
	@if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj
	@echo Cleaning $(WIN_DIR)\nmakehlp.exe ...
	@if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe
	@echo Cleaning $(WIN_DIR)\_junk.pch ...
	@if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch
	@echo Cleaning $(WIN_DIR)\vercl.x ...
	@if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x
	@echo Cleaning $(WIN_DIR)\vercl.i ...
	@if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i
	@echo Cleaning $(WIN_DIR)\versions.vc ...
	@if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc

realclean: hose

# Local Variables:
# mode: makefile
hose:
# End:
	@echo Hosing $(OUT_DIR)\* ...
	@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)

Changes to win/nmakehlp.c.

10
11
12
13
14
15
16

17
18

19
20
21
22
23
24
25
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27







+


+







 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 * ----------------------------------------------------------------------------
 */

#define _CRT_SECURE_NO_DEPRECATE
#include <windows.h>
#ifdef _MSC_VER
#pragma comment (lib, "user32.lib")
#pragma comment (lib, "kernel32.lib")
#endif
#include <stdio.h>
#include <math.h>

/*
 * This library is required for x64 builds with _some_ versions of MSVC
 */
#if defined(_M_IA64) || defined(_M_AMD64)
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
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







-
+
















-
-
+
+







#define   snprintf	_snprintf
#endif


/* protos */

static int CheckForCompilerFeature(const char *option);
static int CheckForLinkerFeature(const char **options, int count);
static int CheckForLinkerFeature(char **options, int count);
static int IsIn(const char *string, const char *substring);
static int SubstituteFile(const char *substs, const char *filename);
static int QualifyPath(const char *path);
static int LocateDependency(const char *keyfile);
static const char *GetVersionFromFile(const char *filename, const char *match, int numdots);
static DWORD WINAPI ReadFromPipe(LPVOID args);

/* globals */

#define CHUNK	25
#define STATICBUFFERSIZE    1000
typedef struct {
    HANDLE pipe;
    char buffer[STATICBUFFERSIZE];
} pipeinfo;

pipeinfo Out = {INVALID_HANDLE_VALUE, '\0'};
pipeinfo Err = {INVALID_HANDLE_VALUE, '\0'};
pipeinfo Out = {INVALID_HANDLE_VALUE, ""};
pipeinfo Err = {INVALID_HANDLE_VALUE, ""};

/*
 * exitcodes: 0 == no, 1 == yes, 2 == error
 */

int
main(
269
270
271
272
273
274
275
276

277
278
279
280
281
282
283
271
272
273
274
275
276
277

278
279
280
281
282
283
284
285







-
+








    if (!ok) {
	DWORD err = GetLastError();
	int chars = snprintf(msg, sizeof(msg) - 1,
		"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);

	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
		(300-chars), 0);
	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
	return 2;
    }

    /*
     * Close our references to the write handles that have now been inherited.
322
323
324
325
326
327
328
329

330
331
332
333
334
335
336
324
325
326
327
328
329
330

331
332
333
334
335
336
337
338







-
+







             || strstr(Err.buffer, "D9002") != NULL
             || strstr(Out.buffer, "D2021") != NULL
             || strstr(Err.buffer, "D2021") != NULL);
}

static int
CheckForLinkerFeature(
    const char **options,
    char **options,
    int count)
{
    STARTUPINFO si;
    PROCESS_INFORMATION pi;
    SECURITY_ATTRIBUTES sa;
    DWORD threadID;
    char msg[300];
403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
405
406
407
408
409
410
411

412
413
414
415
416
417
418
419







-
+








    if (!ok) {
	DWORD err = GetLastError();
	int chars = snprintf(msg, sizeof(msg) - 1,
		"Tried to launch: \"%s\", but got error [%u]: ", cmdline, err);

	FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM|FORMAT_MESSAGE_IGNORE_INSERTS|
		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPVOID)&msg[chars],
		FORMAT_MESSAGE_MAX_WIDTH_MASK, 0L, err, 0, (LPSTR)&msg[chars],
		(300-chars), 0);
	WriteFile(GetStdHandle(STD_ERROR_HANDLE), msg, lstrlen(msg), &err,NULL);
	return 2;
    }

    /*
     * Close our references to the write handles that have now been inherited.
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
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







-









-
+









-
+








-
-
+
+



-
-
-
+
+








static const char *
GetVersionFromFile(
    const char *filename,
    const char *match,
    int numdots)
{
    size_t cbBuffer = 100;
    static char szBuffer[100];
    char *szResult = NULL;
    FILE *fp = fopen(filename, "rt");

    if (fp != NULL) {
	/*
	 * Read data until we see our match string.
	 */

	while (fgets(szBuffer, cbBuffer, fp) != NULL) {
	while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
	    LPSTR p, q;

	    p = strstr(szBuffer, match);
	    if (p != NULL) {
		/*
		 * Skip to first digit after the match.
		 */

		p += strlen(match);
		while (*p && !isdigit(*p)) {
		while (*p && !isdigit((unsigned char)*p)) {
		    ++p;
		}

		/*
		 * Find ending whitespace.
		 */

		q = p;
		while (*q && (strchr("0123456789.ab", *q)) && ((!strchr(".ab", *q)
			    && (!strchr("ab", q[-1])) || --numdots))) {
		while (*q && (strchr("0123456789.ab", *q)) && (((!strchr(".ab", *q)
			    && !strchr("ab", q[-1])) || --numdots))) {
		    ++q;
		}

		memcpy(szBuffer, p, q - p);
		szBuffer[q-p] = 0;
		szResult = szBuffer;
		*q = 0;
		szResult = p;
		break;
	    }
	}
	fclose(fp);
    }
    return szResult;
}
558
559
560
561
562
563
564
565

566
567
568
569
570
571
572
558
559
560
561
562
563
564

565
566
567
568
569
570
571
572







-
+







    char * value;
} list_item_t;

/* insert a list item into the list (list may be null) */
static list_item_t *
list_insert(list_item_t **listPtrPtr, const char *key, const char *value)
{
    list_item_t *itemPtr = malloc(sizeof(list_item_t));
    list_item_t *itemPtr = (list_item_t *)malloc(sizeof(list_item_t));
    if (itemPtr) {
	itemPtr->key = strdup(key);
	itemPtr->value = strdup(value);
	itemPtr->nextPtr = NULL;

	while(*listPtrPtr) {
	    listPtrPtr = &(*listPtrPtr)->nextPtr;
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629

630
631
632
633
634
635
636
607
608
609
610
611
612
613

614

615
616
617
618
619
620
621
622
623
624
625
626

627
628
629
630
631
632
633
634







-

-












-
+







 */

static int
SubstituteFile(
    const char *substitutions,
    const char *filename)
{
    size_t cbBuffer = 1024;
    static char szBuffer[1024], szCopy[1024];
    char *szResult = NULL;
    list_item_t *substPtr = NULL;
    FILE *fp, *sp;

    fp = fopen(filename, "rt");
    if (fp != NULL) {

	/*
	 * Build a list of substutitions from the first filename
	 */

	sp = fopen(substitutions, "rt");
	if (sp != NULL) {
	    while (fgets(szBuffer, cbBuffer, sp) != NULL) {
	    while (fgets(szBuffer, sizeof(szBuffer), sp) != NULL) {
		unsigned char *ks, *ke, *vs, *ve;
		ks = (unsigned char*)szBuffer;
		while (ks && *ks && isspace(*ks)) ++ks;
		ke = ks;
		while (ke && *ke && !isspace(*ke)) ++ke;
		vs = ke;
		while (vs && *vs && isspace(*vs)) ++vs;
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
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







-
+
















-
+







	}
#endif

	/*
	 * Run the substitutions over each line of the input
	 */

	while (fgets(szBuffer, cbBuffer, fp) != NULL) {
	while (fgets(szBuffer, sizeof(szBuffer), fp) != NULL) {
	    list_item_t *p = NULL;
	    for (p = substPtr; p != NULL; p = p->nextPtr) {
		char *m = strstr(szBuffer, p->key);
		if (m) {
		    char *cp, *op, *sp;
		    cp = szCopy;
		    op = szBuffer;
		    while (op != m) *cp++ = *op++;
		    sp = p->value;
		    while (sp && *sp) *cp++ = *sp++;
		    op += strlen(p->key);
		    while (*op) *cp++ = *op++;
		    *cp = 0;
		    memcpy(szBuffer, szCopy, sizeof(szCopy));
		}
	    }
	    printf(szBuffer);
	    printf("%s", szBuffer);
	}

	list_free(&substPtr);
    }
    fclose(fp);
    return 0;
}
721
722
723
724
725
726
727

728

729
730
731
732
733
734
735
719
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734







+
-
+







 * Returns 2 on any kind of error
 * Basically, these are used as exit codes for the process.
 */
static int LocateDependencyHelper(const char *dir, const char *keypath)
{
    HANDLE hSearch;
    char path[MAX_PATH+1];
    size_t dirlen;
    int dirlen, keylen, ret;
    int keylen, ret;
    WIN32_FIND_DATA finfo;

    if (dir == NULL || keypath == NULL)
	return 2; /* Have no real error reporting mechanism into nmake */
    dirlen = strlen(dir);
    if ((dirlen + 3) > sizeof(path))
	return 2;
788
789
790
791
792
793
794

795

796
797
798
799
800
801
802
787
788
789
790
791
792
793
794

795
796
797
798
799
800
801
802







+
-
+







 *      the parent and grandparent of the current working directory.
 *      If found, the command prints
 *         name_DIRPATH=<full path of located directory>
 *      and returns 0. If not found, does not print anything and returns 1.
 */
static int LocateDependency(const char *keypath)
{
    size_t i;
    int i, ret;
    int ret;
    static const char *paths[] = {"..", "..\\..", "..\\..\\.."};

    for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
	ret = LocateDependencyHelper(paths[i], keypath);
	if (ret == 0)
	    return ret;
    }

Deleted win/rules-ext.vc.

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






















































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# This file should only be included in makefiles for Tcl extensions,
# NOT in the makefile for Tcl itself.

!ifndef _RULES_EXT_VC

# We need to run from the directory the parent makefile is located in.
# nmake does not tell us what makefile was used to invoke it so parent
# makefile has to set the MAKEFILEVC macro or we just make a guess and
# warn if we think that is not the case.
!if "$(MAKEFILEVC)" == ""

!if exist("$(PROJECT).vc")
MAKEFILEVC = $(PROJECT).vc
!elseif exist("makefile.vc")
MAKEFILEVC = makefile.vc
!endif
!endif # "$(MAKEFILEVC)" == ""

!if !exist("$(MAKEFILEVC)")
MSG = ^
You must run nmake from the directory containing the project makefile.^
If you are doing that and getting this message, set the MAKEFILEVC^
macro to the name of the project makefile.
!message WARNING: $(MSG)
!endif

!if "$(PROJECT)" == "tcl"
!error The rules-ext.vc file is not intended for Tcl itself.
!endif

# We extract version numbers using the nmakehlp program. For now use
# the local copy of nmakehlp. Once we locate Tcl, we will use that
# one if it is newer.
!if [$(CC) -nologo "nmakehlp.c" -link -subsystem:console > nul]
!endif

# First locate the Tcl directory that we are working with.
!if "$(TCLDIR)" != ""

_RULESDIR = $(TCLDIR:/=\)

!else

# If an installation path is specified, that is also the Tcl directory.
# Also Tk never builds against an installed Tcl, it needs Tcl sources
!if defined(INSTALLDIR) && "$(PROJECT)" != "tk"
_RULESDIR=$(INSTALLDIR:/=\)
!else
# Locate Tcl sources
!if [echo _RULESDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
_RULESDIR = ..\..\tcl
!else
!include nmakehlp.out
!endif

!endif # defined(INSTALLDIR)....

!endif # ifndef TCLDIR

# Now look for the targets.vc file under the Tcl root. Note we check this
# file and not rules.vc because the latter also exists on older systems.
!if exist("$(_RULESDIR)\lib\nmake\targets.vc") # Building against installed Tcl
_RULESDIR = $(_RULESDIR)\lib\nmake
!elseif exist("$(_RULESDIR)\win\targets.vc")   # Building against Tcl sources
_RULESDIR = $(_RULESDIR)\win
!else
# If we have not located Tcl's targets file, most likely we are compiling
# against an older version of Tcl and so must use our own support files.
_RULESDIR = .
!endif

!if "$(_RULESDIR)" != "."
# Potentially using Tcl's support files. If this extension has its own
# nmake support files, need to compare the versions and pick newer.

!if exist("rules.vc") # The extension has its own copy

!if [echo TCL_RULES_MAJOR = \> versions.vc] \
   && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MAJOR >> versions.vc]
!endif
!if [echo TCL_RULES_MINOR = \>> versions.vc] \
   && [nmakehlp -V "$(_RULESDIR)\rules.vc" RULES_VERSION_MINOR >> versions.vc]
!endif

!if [echo OUR_RULES_MAJOR = \>> versions.vc] \
   && [nmakehlp -V "rules.vc" RULES_VERSION_MAJOR >> versions.vc]
!endif
!if [echo OUR_RULES_MINOR = \>> versions.vc] \
   && [nmakehlp -V "rules.vc" RULES_VERSION_MINOR >> versions.vc]
!endif
!include versions.vc
# We have a newer version of the support files, use them
!if ($(TCL_RULES_MAJOR) != $(OUR_RULES_MAJOR)) || ($(TCL_RULES_MINOR) < $(OUR_RULES_MINOR))
_RULESDIR = .
!endif

!endif # if exist("rules.vc")

!endif # if $(_RULESDIR) != "."

# Let rules.vc know what copy of nmakehlp.c to use.
NMAKEHLPC = $(_RULESDIR)\nmakehlp.c

# Get rid of our internal defines before calling rules.vc
!undef TCL_RULES_MAJOR
!undef TCL_RULES_MINOR
!undef OUR_RULES_MAJOR
!undef OUR_RULES_MINOR

!if exist("$(_RULESDIR)\rules.vc")
!message *** Using $(_RULESDIR)\rules.vc
!include "$(_RULESDIR)\rules.vc"
!else
!error *** Could not locate rules.vc in $(_RULESDIR)
!endif

!endif # _RULES_EXT_VC

Changes to win/rules.vc.

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
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
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
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
611
612
613
614
615
616
617
618
619
620
621
622
623
624

625
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
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
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
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
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
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
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

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
1439
1440
1441
1442

1443
1444
1445
1446
1447

1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469
1470



1471
1472
1473

1474
1475
1476

1477
1478
1479

1480
1481
1482
1483

1484
1485
1486
1487
1488

1489
1490
1491
1492
1493
1494
1495

1496
1497
1498
1499

1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511



1512


1513


1514
1515

1516
1517

1518
1519
1520
1521

1522
1523
1524
1525
1526




1527
1528
1529
1530
1531
1532
1533
1534








1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546

1547
1548



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
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
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
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
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


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
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
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
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





611


612
613





614
615


616




617



618







619
620
621
622
623
624
625
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
686
687
688






689
690

691
692

693
694
695
696
697

698
-
+


-
-
+
+
-
-
-
-
-






-





-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-







+

+
+
+
+
+

-

+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-











-
+

-




-
-
-
-

-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
-
-
-
-

-
-
+
+
-
+

-
-

-
-
+
-
-
-
-

-
-
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
+
+
-
-
-
-
+
-
-
-
+
-

-
-
-
-


-
-
+
+
-
-
-
-
-
-
-
+


+
-
+
-
-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
-
+




-
-
-


-
-
-
-
-

-

-
+

-
-






+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
-
+
+
+
+
+
+
+
+
+
-
-

-
+




-
-

-
+

-

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
+

-
+





+

-
+

-
-
-

-
-
-
-
-
-
-
-
-



-
-
+
+
-
-
-

-
-
-
-
+
+
+

-
+
-
+

-



-
-



+
+

-
-
-
+
+
+
+
+

-
+

-
-




-
-
-
-
-
-
-
-
-






-






-






-









-

-
+
+
+
+

-
-




-

+


-






-
-
-
-
-


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+















-
+




















-
+















-
-
-
-
-
-
-
-
-
-

+
-
+
-
-
+
-
-

-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
+
+

-
-
+
+
+
-
-
-
-
-
+
+

-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-

-
-
+
-
+
+

-
-
-
-
-
+
+
+

-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
-
-
-
-
-
-
-
+
-
-
+

-
-
+
-
-
-
+
+
-
-
+
-
-
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
-
-
+
-
-
-
-

+
+
-
+
-

-
-
-
-
-

-
-
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-
-
-
-
-
-
-







-
+

-
+





-
-
-
-
-





-
-
-
-
-
-
-
-
-
-
-









-
+



-
+


-

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+

-
-
+



-
-
+
+
-
+


-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
-
+
-
-
+
-
-
-

-
+
-
-
-
+
+
-
-

-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
-
-
-
-
-
-
-
-
+
+
+

-
-
+
-

-
+
-
-
-
+
-
-

-
+
-
-
-
-
-
+
-
-
-
-

-
-
+
-
-
-
-
+
-
-
-
-
-
-

-
-
-
-
-
+
+
+
-
+
+

+
+

-
+
-
-
+
-
-

-
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-

-
-
-
+

-
+
+
+

-
+
-
-
-
-
-
-
-
-

-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
-
+
-
-
-
-
-
+
-
-
+

-
-
-
-
-
+
+
-
-
+
-
-
-
-
+
-
-
-

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
-
-


-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-

-
-
-
-
-
+
-
-

-
-
-
+
-
-
-
+
-
-
-
+
+
+

+
+
+

-
-
-
-
-
-
+

+
+
-
-
-
-
-
-
-
-
-

-
+
-
-
-
+
+
-
-
-
-
+
+
+
+
+
-
+
+
+

-
-

-

-
+
-
-
-





-
-
-
-
-
-


-

+
-
+
+
+
+

-
+
#------------------------------------------------------------- -*- makefile -*-
#------------------------------------------------------------------------------
# rules.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file does all the hard work in terms of parsing build options,
#	Microsoft Visual C++ makefile include for decoding the commandline
#	macros.  This file does not need editing to build Tcl.
# compiler switches, defining common targets and macros. The Tcl makefile
# directly includes this. Extensions include it via "rules-ext.vc".
#
# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for
# detailed documentation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 2001-2003 David Gravereaux.
# Copyright (c) 2003-2008 Patrick Thoyts
# Copyright (c) 2017      Ashok P. Nadkarni
#------------------------------------------------------------------------------

!ifndef _RULES_VC
_RULES_VC = 1

# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
RULES_VERSION_MINOR = 6

cc32		= $(CC)   # built-in default.
# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
!endif

link32		= link
!if "$(PRJ_PACKAGE_TCLNAME)" == ""
PRJ_PACKAGE_TCLNAME = $(PROJECT)
!endif

lib32		= lib
# Also special case Tcl and Tk to save some typing later
DOING_TCL = 0
DOING_TK  = 0
!if "$(PROJECT)" == "tcl"
DOING_TCL = 1
!elseif "$(PROJECT)" == "tk"
DOING_TK = 1
!endif

rc32		= $(RC)   # built-in default.
!ifndef NEED_TK
# Backwards compatibility
!ifdef PROJECT_REQUIRES_TK
NEED_TK = $(PROJECT_REQUIRES_TK)
!else
NEED_TK = 0
!endif
!endif

!ifndef NEED_TCL_SOURCE
NEED_TCL_SOURCE = 0
!endif

!ifdef NEED_TK_SOURCE
!if $(NEED_TK_SOURCE)
NEED_TK = 1
!endif
!else
NEED_TK_SOURCE = 0
!endif

################################################################
# Nmake is a pretty weak environment in syntax and capabilities
# so this file is necessarily verbose. It's broken down into
# the following parts.
#
# 0. Sanity check that compiler environment is set up and initialize
#    any built-in settings from the parent makefile
# 1. First define the external tools used for compiling, copying etc.
#    as this is independent of everything else.
# 2. Figure out our build structure in terms of the directory, whether
#    we are building Tcl or an extension, etc.
# 3. Determine the compiler and linker versions
# 4. Build the nmakehlp helper application
# 5. Determine the supported compiler options and features
# 6. Parse the OPTS macro value for user-specified build configuration
# 7. Parse the STATS macro value for statistics instrumentation
# 8. Parse the CHECKS macro for additional compilation checks
# 9. Extract Tcl, and possibly Tk, version numbers from the headers
# 10. Based on this selected configuration, construct the output
#     directory and file paths
# 11. Construct the paths where the package is to be installed
# 12. Set up the actual options passed to compiler and linker based
#     on the information gathered above.
# 13. Define some standard build targets and implicit rules. These may
#     be optionally disabled by the parent makefile.
# 14. (For extensions only.) Compare the configuration of the target
#     Tcl and the extensions and warn against discrepancies.
#

# One final note about the macro names used. They are as they are
# for historical reasons. We would like legacy extensions to
# continue to work with this make include file so be wary of
# changing them for consistency or clarity.

!ifndef INSTALLDIR
# 0. Sanity check compiler environment

### Assume the normal default.
# Check to see we are configured to build with MSVC (MSDEVDIR, MSVCDIR or
# VCINSTALLDIR) or with the MS Platform SDK (MSSDK or WindowsSDKDir)

_INSTALLDIR	= C:\Program Files\Tcl
!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCINSTALLDIR) && !defined(MSSDK) && !defined(WINDOWSSDKDIR)
MSG = ^
Visual C++ compiler environment not initialized.
!error $(MSG)
!endif

!else
### Fix the path separators.
# We need to run from the directory the parent makefile is located in.
# nmake does not tell us what makefile was used to invoke it so parent
# makefile has to set the MAKEFILEVC macro or we just make a guess and
# warn if we think that is not the case.
!if "$(MAKEFILEVC)" == ""

_INSTALLDIR	= $(INSTALLDIR:/=\)
!if exist("$(PROJECT).vc")
MAKEFILEVC = $(PROJECT).vc
!elseif exist("makefile.vc")
MAKEFILEVC = makefile.vc
!endif
!endif # "$(MAKEFILEVC)" == ""

!if !exist("$(MAKEFILEVC)")
MSG = ^
You must run nmake from the directory containing the project makefile.^
If you are doing that and getting this message, set the MAKEFILEVC^
macro to the name of the project makefile.
!message WARNING: $(MSG)
!endif


################################################################
# 1. Define external programs being used

#----------------------------------------------------------
# Set the proper copy method to avoid overwrite questions
# to the user when copying files and selecting the right
# "delete all" method.
#----------------------------------------------------------

!if "$(OS)" == "Windows_NT"
RMDIR	= rmdir /S /Q
ERRNULL  = 2>NUL
!if ![ver | find "4.0" > nul]
CPY	= echo y | xcopy /i >NUL
COPY	= copy >NUL
!else
CPY	= xcopy /i /y >NUL
CPYDIR  = xcopy /e /i /y >NUL
COPY	= copy /y >NUL
!endif
!else # "$(OS)" != "Windows_NT"
CPY	= xcopy /i >_JUNK.OUT # On Win98 NUL does not work here.
COPY	= copy >_JUNK.OUT # On Win98 NUL does not work here.
RMDIR	= deltree /Y
NULL    = \NUL # Used in testing directory existence
ERRNULL = >NUL # Win9x shell cannot redirect stderr
!endif
MKDIR   = mkdir

######################################################################
# 2. Figure out our build environment in terms of what we're building.
#
# (a) Tcl itself
# (b) Tk
# (c) a Tcl extension using libraries/includes from an *installed* Tcl
# (d) a Tcl extension using libraries/includes from Tcl source directory
#
# This last is needed because some extensions still need
# some Tcl interfaces that are not publicly exposed.
#
# The fragment will set the following macros:
# ROOT - root of this module sources
# COMPATDIR - source directory that holds compatibility sources
# DOCDIR - source directory containing documentation files
# GENERICDIR - platform-independent source directory
# WIN_DIR - Windows-specific source directory
# TESTDIR - directory containing test files
# TOOLSDIR - directory containing build tools
# _TCLDIR - root of the Tcl installation OR the Tcl sources. Not set
#    when building Tcl itself.
# _INSTALLDIR - native form of the installation path. For Tcl
#    this will be the root of the Tcl installation. For extensions
#    this will be the lib directory under the root.
# TCLINSTALL  - set to 1 if _TCLDIR refers to
#    headers and libraries from an installed Tcl, and 0 if built against
#    Tcl sources. Not set when building Tcl itself. Yes, not very well
#    named.
# _TCL_H - native path to the tcl.h file
#
# If Tk is involved, also sets the following
# _TKDIR - native form Tk installation OR Tk source. Not set if building
#    Tk itself.
# TKINSTALL - set 1 if _TKDIR refers to installed Tk and 0 if Tk sources
# _TK_H - native path to the tk.h file

#------------------------------------------------------------------------------
# Root directory for sources and assumed subdirectories
ROOT = $(MAKEDIR)\..
# The following paths CANNOT have spaces in them as they appear on the
# left side of implicit rules.
!ifndef COMPATDIR
COMPATDIR	= $(ROOT)\compat
!endif
!ifndef DOCDIR
DOCDIR		= $(ROOT)\doc
!endif
!ifndef GENERICDIR
GENERICDIR	= $(ROOT)\generic
!endif
!ifndef TOOLSDIR
TOOLSDIR	= $(ROOT)\tools
!endif
!ifndef TESTDIR
TESTDIR	= $(ROOT)\tests
!endif
!ifndef LIBDIR
!if exist("$(ROOT)\library")
LIBDIR          = $(ROOT)\library
!else
LIBDIR          = $(ROOT)\lib
!endif
!endif
!ifndef DEMODIR
!if exist("$(LIBDIR)\demos")
DEMODIR		= $(LIBDIR)\demos
!else
DEMODIR		= $(ROOT)\demos
!endif
!endif # ifndef DEMODIR
# Do NOT use WINDIR because it is Windows internal environment
# variable to point to c:\windows!
WIN_DIR		= $(ROOT)\win

# Determine the host and target architectures and compiler version.
!ifndef RCDIR
!if exist("$(WIN_DIR)\rc")
RCDIR           = $(WIN_DIR)\rc
!else
RCDIR           = $(WIN_DIR)
!endif
!endif
RCDIR = $(RCDIR:/=\)

# The target directory where the built packages and binaries will be installed.
# INSTALLDIR is the (optional) path specified by the user.
# _INSTALLDIR is INSTALLDIR using the backslash separator syntax
!ifdef INSTALLDIR
### Fix the path separators.
_INSTALLDIR	= $(INSTALLDIR:/=\)
!else
### Assume the normal default.
_INSTALLDIR	= $(HOMEDRIVE)\Tcl
!endif

!if $(DOING_TCL)

# BEGIN Case 2(a) - Building Tcl itself

# Only need to define _TCL_H
_TCL_H = ..\generic\tcl.h

# END Case 2(a) - Building Tcl itself

!elseif $(DOING_TK)

# BEGIN Case 2(b) - Building Tk

TCLINSTALL = 0 # Tk always builds against Tcl source, not an installed Tcl
!if "$(TCLDIR)" == ""
!if [echo TCLDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
!error *** Could not locate Tcl source directory.
!endif
!include nmakehlp.out
!endif # TCLDIR == ""

_TCLDIR	= $(TCLDIR:/=\)
_TCL_H  = $(_TCLDIR)\generic\tcl.h
!if !exist("$(_TCL_H)")
!error Could not locate tcl.h. Please set the TCLDIR macro to point to the Tcl *source* directory.
!endif

_TK_H = ..\generic\tk.h

# END Case 2(b) - Building Tk

!else

# BEGIN Case 2(c) or (d) - Building an extension other than Tk

# If command line has specified Tcl location through TCLDIR, use it
# else default to the INSTALLDIR setting
!if "$(TCLDIR)" != ""

_TCLDIR	= $(TCLDIR:/=\)
!if exist("$(_TCLDIR)\include\tcl.h") # Case 2(c) with TCLDIR defined
TCLINSTALL	= 1
_TCL_H          = $(_TCLDIR)\include\tcl.h
!elseif exist("$(_TCLDIR)\generic\tcl.h") # Case 2(d) with TCLDIR defined
TCLINSTALL	= 0
_TCL_H          = $(_TCLDIR)\generic\tcl.h
!endif

!else  #  # Case 2(c) for extensions with TCLDIR undefined

# Need to locate Tcl depending on whether it needs Tcl source or not.
# If we don't, check the INSTALLDIR for an installed Tcl first

!if exist("$(_INSTALLDIR)\include\tcl.h") && !$(NEED_TCL_SOURCE)

TCLINSTALL	= 1
TCLDIR          = $(_INSTALLDIR)\..
# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
# later so the \.. accounts for the /lib
_TCLDIR		= $(_INSTALLDIR)\..
_TCL_H          = $(_TCLDIR)\include\tcl.h

!else # exist(...) && !$(NEED_TCL_SOURCE)

!if [echo _TCLDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tcl.h >> nmakehlp.out]
!error *** Could not locate Tcl source directory.
!endif
!include nmakehlp.out
TCLINSTALL      = 0
TCLDIR         = $(_TCLDIR)
_TCL_H          = $(_TCLDIR)\generic\tcl.h

!endif # exist(...) && !$(NEED_TCL_SOURCE)

!endif # TCLDIR

!ifndef _TCL_H
MSG =^
Failed to find tcl.h. The TCLDIR macro is set incorrectly or is not set and default path does not contain tcl.h.
!error $(MSG)
!endif

# Now do the same to locate Tk headers and libs if project requires Tk
!if $(NEED_TK)

!if "$(TKDIR)" != ""

_TKDIR = $(TKDIR:/=\)
!if exist("$(_TKDIR)\include\tk.h")
TKINSTALL      = 1
_TK_H          = $(_TKDIR)\include\tk.h
!elseif exist("$(_TKDIR)\generic\tk.h")
TKINSTALL      = 0
_TK_H          = $(_TKDIR)\generic\tk.h
!endif

!else # TKDIR not defined

# Need to locate Tcl depending on whether it needs Tcl source or not.
# If we don't, check the INSTALLDIR for an installed Tcl first

!if exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)

TKINSTALL      = 1
# NOTE: we will be resetting _INSTALLDIR to _INSTALLDIR/lib for extensions
# later so the \.. accounts for the /lib
_TKDIR         = $(_INSTALLDIR)\..
_TK_H          = $(_TKDIR)\include\tk.h
TKDIR          = $(_TKDIR)

!else # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)

!if [echo _TKDIR = \> nmakehlp.out] \
   || [nmakehlp -L generic\tk.h >> nmakehlp.out]
!error *** Could not locate Tk source directory.
!endif
!include nmakehlp.out
TKINSTALL      = 0
TKDIR          = $(_TKDIR)
_TK_H          = $(_TKDIR)\generic\tk.h

!endif # exist("$(_INSTALLDIR)\include\tk.h") && !$(NEED_TK_SOURCE)

!endif # TKDIR

!ifndef _TK_H
MSG =^
Failed to find tk.h. The TKDIR macro is set incorrectly or is not set and default path does not contain tk.h.
!error $(MSG)
!endif

!endif # NEED_TK

!if $(NEED_TCL_SOURCE) && $(TCLINSTALL)
MSG = ^
*** Warning: This extension requires the source distribution of Tcl.^
*** Please set the TCLDIR macro to point to the Tcl sources.
!error $(MSG)
!endif

!if $(NEED_TK_SOURCE)
!if $(TKINSTALL)
MSG = ^
*** Warning: This extension requires the source distribution of Tk.^
*** Please set the TKDIR macro to point to the Tk sources.
!error $(MSG)
!endif
!endif


# If INSTALLDIR set to Tcl installation root dir then reset to the
# lib dir for installing extensions
!if exist("$(_INSTALLDIR)\include\tcl.h")
_INSTALLDIR=$(_INSTALLDIR)\lib
!endif

# END Case 2(c) or (d) - Building an extension
!endif # if $(DOING_TCL)

################################################################
# 3. Determine compiler version and architecture
# In this section, we figure out the compiler version and the
# architecture for which we are building. This sets the
# following macros:
# VCVERSION - the internal compiler version as 1200, 1400, 1910 etc.
#     This is also printed by the compiler in dotted form 19.10 etc.
# VCVER - the "marketing version", for example Visual C++ 6 for internal
#     compiler version 1200. This is kept only for legacy reasons as it
#     does not make sense for recent Microsoft compilers. Only used for
#     output directory names.
# ARCH - set to IX86 or AMD64 depending on 32- or 64-bit target
# NATIVE_ARCH - set to IX86 or AMD64 for the host machine
# MACHINE - same as $(ARCH) - legacy
# _VC_MANIFEST_EMBED_{DLL,EXE} - commands for embedding a manifest if needed

cc32		= $(CC)   # built-in default.
link32		= link
lib32		= lib
rc32		= $(RC)   # built-in default.

#----------------------------------------------------------------
#------------------------------------------------------------------------------
# Figure out the compiler architecture and version by writing
# the C macros to a file, preprocessing them with the C
# preprocessor and reading back the created file

_HASH=^#
_VC_MANIFEST_EMBED_EXE=
_VC_MANIFEST_EMBED_DLL=
VCVER=0
!if ![echo VCVERSION=_MSC_VER > vercl.x] \
    && ![echo $(_HASH)if defined(_M_IX86) >> vercl.x] \
    && ![echo ARCH=IX86 >> vercl.x] \
    && ![echo $(_HASH)elif defined(_M_AMD64) >> vercl.x] \
    && ![echo ARCH=AMD64 >> vercl.x] \
    && ![echo $(_HASH)endif >> vercl.x] \
    && ![$(cc32) -nologo -TC -P vercl.x 2>NUL]
    && ![cl -nologo -TC -P vercl.x $(ERRNULL)]
!include vercl.i
!if $(VCVERSION) < 1900
!if ![echo VCVER= ^\> vercl.vc] \
    && ![set /a $(VCVERSION) / 100 - 6 >> vercl.vc]
!include vercl.vc
!endif
!else
# The simple calculation above does not apply to new Visual Studio releases
# Keep the compiler version in its native form.
VCVER = $(VCVERSION)
!endif
!endif

!if ![del 2>NUL /q/f vercl.x vercl.i vercl.vc]
!if ![del $(ERRNUL) /q/f vercl.x vercl.i vercl.vc]
!endif

#----------------------------------------------------------------
# The MACHINE macro is used by legacy makefiles so set it as well
!ifdef MACHINE
!if "$(MACHINE)" == "x86"
!undef MACHINE
MACHINE = IX86
!elseif "$(MACHINE)" == "x64"
!undef MACHINE
MACHINE = AMD64
!endif
!if "$(MACHINE)" != "$(ARCH)"
!error Specified MACHINE macro $(MACHINE) does not match detected target architecture $(ARCH).
!endif
!else
MACHINE=$(ARCH)
!endif

#---------------------------------------------------------------
# The PLATFORM_IDENTIFY macro matches the values returned by
# the Tcl platform::identify command
!if "$(MACHINE)" == "AMD64"
PLATFORM_IDENTIFY = win32-x86_64
!else
PLATFORM_IDENTIFY = win32-ix86
!endif

# The MULTIPLATFORM macro controls whether binary extensions are installed
# in platform-specific directories. Intended to be set/used by extensions.
!ifndef MULTIPLATFORM_INSTALL
MULTIPLATFORM_INSTALL = 0
!endif

#------------------------------------------------------------
# Figure out the *host* architecture by reading the registry

!if ![reg query HKLM\Hardware\Description\System\CentralProcessor\0 /v Identifier | findstr /i x86]
NATIVE_ARCH=IX86
!else
NATIVE_ARCH=AMD64
!endif

# Since MSVC8 we must deal with manifest resources.
!if $(VCVERSION) >= 1400
_VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
_VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
!endif

################################################################
# 4. Build the nmakehlp program
# This is a helper app we need to overcome nmake's limiting
# environment. We will call out to it to get various bits of
# information about supported compiler options etc.
#
# Tcl itself will always use the nmakehlp.c program which is
# in its own source. It will be kept updated there.
#
# Extensions built against an installed Tcl will use the installed
# copy of Tcl's nmakehlp.c if there is one and their own version
# otherwise. In the latter case, they would also be using their own
# rules.vc. Note that older versions of Tcl do not install nmakehlp.c
# or rules.vc.
#
# Extensions built against Tcl sources will use the one from the Tcl source.
#
# When building an extension using a sufficiently new version of Tcl,
# rules-ext.vc will define NMAKEHLPC appropriately to point to the
# copy of nmakehlp.c to be used.

!ifndef NMAKEHLPC
!ifndef MACHINE
# Default to the one in the current directory (the extension's own nmakehlp.c)
NMAKEHLPC = nmakehlp.c

MACHINE=$(ARCH)
!if !$(DOING_TCL)
!if $(TCLINSTALL)
!if exist("$(_TCLDIR)\lib\nmake\nmakehlp.c")
NMAKEHLPC = $(_TCLDIR)\lib\nmake\nmakehlp.c
!endif
!else # !$(TCLINSTALL)
!if exist("$(_TCLDIR)\win\nmakehlp.c")

!ifndef CFG_ENCODING
NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
CFG_ENCODING	= \"cp1252\"
!endif
!endif # $(TCLINSTALL)
!endif # !$(DOING_TCL)

!endif # NMAKEHLPC

!message ===============================================================================
# We always build nmakehlp even if it exists since we do not know
# what source it was built from.
!if [$(cc32) -nologo "$(NMAKEHLPC)" -link -subsystem:console > nul]
!endif

################################################################
# 5. Test for compiler features
# Visual C++ compiler options have changed over the years. Check
# which options are supported by the compiler in use.
#
# The following macros are set:
# OPTIMIZATIONS - the compiler flags to be used for optimized builds
#----------------------------------------------------------
# build the helper app we need to overcome nmake's limiting
# DEBUGFLAGS - the compiler flags to be used for debug builds
# LINKERFLAGS - Flags passed to the linker
#
# environment.
# Note that these are the compiler settings *available*, not those
# that will be *used*. The latter depends on the OPTS macro settings
# which we have not yet parsed.
#
#----------------------------------------------------------

# Also note that some of the flags in OPTIMIZATIONS are not really
# related to optimization. They are placed there only for legacy reasons
# as some extensions expect them to be included in that macro.

!if !exist(nmakehlp.exe)
# -Op improves float consistency. Note only needed for older compilers
# Newer compilers do not need or support this option.
!if [nmakehlp -c -Op]
!if [$(cc32) -nologo nmakehlp.c -link -subsystem:console > nul]
FPOPTS  = -Op
!endif

# Strict floating point semantics - present in newer compilers in lieu of -Op
!if [nmakehlp -c -fp:strict]
FPOPTS  = $(FPOPTS) -fp:strict
!endif

!if "$(MACHINE)" == "IX86"
### test for pentium errata
#----------------------------------------------------------
# Test for compiler features
!if [nmakehlp -c -QI0f]
!message *** Compiler has 'Pentium 0x0f fix'
FPOPTS  = $(FPOPTS) -QI0f
!else
!message *** Compiler does not have 'Pentium 0x0f fix'
!endif
!endif
#----------------------------------------------------------

### test for optimizations
!if [nmakehlp -c -Ot]
# /O2 optimization includes /Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy as per
!message *** Compiler has 'Optimizations'
# documentation. Note we do NOT want /Gs as that inserts a _chkstk
# stack probe at *every* function entry, not just those with more than
# a page of stack allocation resulting in a performance hit.  However,
# /O2 documentation is misleading as its stack probes are simply the
# default page size locals allocation probes and not what is implied
# by an explicit /Gs option.
OPTIMIZING	= 1
!else
!message *** Compiler does not have 'Optimizations'
OPTIMIZING	= 0
!endif

OPTIMIZATIONS = $(FPOPTS)
OPTIMIZATIONS   =

!if [nmakehlp -c -O2]
OPTIMIZING = 1
OPTIMIZATIONS   = $(OPTIMIZATIONS) -O2
!else
# Legacy, really. All modern compilers support this
!message *** Compiler does not have 'Optimizations'
OPTIMIZING = 0
!if [nmakehlp -c -Ot]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Ot
!endif

!if [nmakehlp -c -Oi]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Oi
!endif

!if [nmakehlp -c -Op]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Op
!endif

!if [nmakehlp -c -fp:strict]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -fp:strict
!endif

!if [nmakehlp -c -Gs]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -Gs
!endif
# Checks for buffer overflows in local arrays

!if [nmakehlp -c -GS]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -GS
!endif

# Link time optimization. Note that this option (potentially) makes
# generated libraries only usable by the specific VC++ version that
# created it. Requires /LTCG linker option
!if [nmakehlp -c -GL]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -GL
CC_GL_OPT_ENABLED = 1
!else
# In newer compilers -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -YX
!endif
!endif # [nmakehlp -c -GL]

DEBUGFLAGS     = $(FPOPTS)
DEBUGFLAGS     =

# Run time error checks. Not available or valid in a release, non-debug build
# RTC is for modern compilers, -GZ is legacy
!if [nmakehlp -c -RTC1]
DEBUGFLAGS     = $(DEBUGFLAGS) -RTC1
!elseif [nmakehlp -c -GZ]
DEBUGFLAGS     = $(DEBUGFLAGS) -GZ
!endif

COMPILERFLAGS  =-W3 /D_ATL_XP_TARGETING
#----------------------------------------------------------------
# Linker flags

# In v13 -GL and -YX are incompatible.
!if [nmakehlp -c -YX]
!if ![nmakehlp -c -GL]
OPTIMIZATIONS  = $(OPTIMIZATIONS) -YX
!endif
!endif

!if "$(MACHINE)" == "IX86"
### test for pentium errata
!if [nmakehlp -c -QI0f]
!message *** Compiler has 'Pentium 0x0f fix'
COMPILERFLAGS  = $(COMPILERFLAGS) -QI0f
!else
!message *** Compiler does not have 'Pentium 0x0f fix'
!endif
!endif

!if "$(MACHINE)" == "IA64"
### test for Itanium errata
# LINKER_TESTFLAGS are for internal use when we call nmakehlp to test
# if the linker supports a specific option. Without these flags link will
# return "LNK1561: entry point must be defined" error compiling from VS-IDE:
!if [nmakehlp -c -QIA64_Bx]
!message *** Compiler has 'B-stepping errata workarounds'
COMPILERFLAGS   = $(COMPILERFLAGS) -QIA64_Bx
!else
!message *** Compiler does not have 'B-stepping errata workarounds'
!endif
!endif

# Prevents "LNK1561: entry point must be defined" error compiling from VS-IDE:
# They are not passed through to the actual application / extension
# link rules.
!ifndef LINKER_TESTFLAGS
LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmakehlp.out
LINKER_TESTFLAGS = /DLL /NOENTRY /OUT:nmhlp-out.txt
!endif

LINKERFLAGS     =

# If compiler has enabled link time optimization, linker must too with -ltcg
!ifdef CC_GL_OPT_ENABLED
!if [nmakehlp -l -ltcg $(LINKER_TESTFLAGS)]
LINKERFLAGS     = $(LINKERFLAGS) -ltcg
LINKERFLAGS     =-ltcg
!endif
!endif

########################################################################
# 6. Parse the OPTS macro to work out the requested build configuration.
#----------------------------------------------------------
# Decode the options requested.
# Based on this, we will construct the actual switches to be passed to the
# compiler and linker using the macros defined in the previous section.
# The following macros are defined by this section based on OPTS
# STATIC_BUILD - 0 -> Tcl is to be built as a shared library
#                1 -> build as a static library and shell
# TCL_THREADS - legacy but always 1 on Windows since winsock requires it.
# DEBUG - 1 -> debug build, 0 -> release builds
# SYMBOLS - 1 -> generate PDB's, 0 -> no PDB's
# PROFILE - 1 -> generate profiling info, 0 -> no profiling
# PGO     - 1 -> profile based optimization, 0 -> no
# MSVCRT  - 1 -> link to dynamic C runtime even when building static Tcl build
#           0 -> link to static C runtime for static Tcl build.
#           Does not impact shared Tcl builds (STATIC_BUILD == 0)
# TCL_USE_STATIC_PACKAGES - 1 -> statically link the registry and dde extensions
#           in the Tcl shell. 0 -> keep them as shared libraries
#           Does not impact shared Tcl builds.
# USE_THREAD_ALLOC - 1 -> Use a shared global free pool for allocation.
#           0 -> Use the non-thread allocator.
# UNCHECKED - 1 -> when doing a debug build with symbols, use the release
#           C runtime, 0 -> use the debug C runtime.
# USE_STUBS - 1 -> compile to use stubs interfaces, 0 -> direct linking
# CONFIG_CHECK - 1 -> check current build configuration against Tcl
#           configuration (ignored for Tcl itself)
# _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build
#           (CRT library should support this, not needed for Tcl 9.x)
# TCL_UTF_MAX=4 - forces a build allowing 4-byte UTF-8 sequences internally.
#           (Not needed for Tcl 9.x)
# Further, LINKERFLAGS are modified based on above.
#----------------------------------------------------------

# Default values for all the above
!if "$(OPTS)" == "" || [nmakehlp -f "$(OPTS)" "none"]
STATIC_BUILD	= 0
TCL_THREADS	= 1
TCL_THREADS	= 0
DEBUG		= 0
SYMBOLS		= 0
PROFILE		= 0
PGO		= 0
MSVCRT		= 1
LOIMPACT	= 0
TCL_USE_STATIC_PACKAGES	= 0
USE_THREAD_ALLOC = 1
USE_THREAD_ALLOC = 0
UNCHECKED	= 0
CONFIG_CHECK    = 1
!if $(DOING_TCL)
USE_STUBS       = 0
!else
USE_STUBS       = 1
!endif

# If OPTS is not empty AND does not contain "none" which turns off all OPTS
# set the above macros based on OPTS content
!if "$(OPTS)" != "" && ![nmakehlp -f "$(OPTS)" "none"]

# OPTS are specified, parse them

!if [nmakehlp -f $(OPTS) "static"]
!message *** Doing static
STATIC_BUILD	= 1
!endif

!else
STATIC_BUILD	= 0
!if [nmakehlp -f $(OPTS) "nostubs"]
!message *** Not using stubs
USE_STUBS	= 0
!endif

!if [nmakehlp -f $(OPTS) "nomsvcrt"]
!message *** Doing nomsvcrt
MSVCRT		= 0
!if [nmakehlp -f $(OPTS) "msvcrt"]
!message *** Doing msvcrt
MSVCRT		= 1
!else
!if [nmakehlp -f $(OPTS) "msvcrt"]
!if !$(STATIC_BUILD)
!message *** Doing msvcrt
MSVCRT		= 1
!else
!if $(STATIC_BUILD)
MSVCRT		= 0
!endif
!endif
!endif # [nmakehlp -f $(OPTS) "nomsvcrt"]

!if [nmakehlp -f $(OPTS) "staticpkg"] && $(STATIC_BUILD)
!message *** Doing staticpkg
TCL_USE_STATIC_PACKAGES	= 1
!else
TCL_USE_STATIC_PACKAGES	= 0
!endif

!if [nmakehlp -f $(OPTS) "nothreads"]
!message *** Compile explicitly for non-threaded tcl
!if [nmakehlp -f $(OPTS) "threads"]
!message *** Doing threads
TCL_THREADS = 1
USE_THREAD_ALLOC = 1
!else
TCL_THREADS = 0
USE_THREAD_ALLOC= 0
USE_THREAD_ALLOC = 0
!endif

!if "$(TCL_MAJOR_VERSION)" == "8"
!if [nmakehlp -f $(OPTS) "time64bit"]
!message *** Force 64-bit time_t
_USE_64BIT_TIME_T = 1
!endif

!if [nmakehlp -f $(OPTS) "utfmax"]
!message *** Force allowing 4-byte UTF-8 sequences internally
TCL_UTF_MAX = 4
!endif
!endif

# Yes, it's weird that the "symbols" option controls DEBUG and
# the "pdbs" option controls SYMBOLS. That's historical.
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
DEBUG		= 1
!else
DEBUG		= 0
!endif

!if [nmakehlp -f $(OPTS) "pdbs"]
!message *** Doing pdbs
SYMBOLS		= 1
!else
SYMBOLS		= 0
!endif

!if [nmakehlp -f $(OPTS) "profile"]
!message *** Doing profile
PROFILE		= 1
!else
PROFILE		= 0
!endif

!if [nmakehlp -f $(OPTS) "pgi"]
!message *** Doing profile guided optimization instrumentation
PGO		= 1
!elseif [nmakehlp -f $(OPTS) "pgo"]
!message *** Doing profile guided optimization
PGO		= 2
!else
PGO		= 0
!endif

!if [nmakehlp -f $(OPTS) "loimpact"]
!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows.
!message *** Doing loimpact
LOIMPACT	= 1
!else
LOIMPACT	= 0
!endif

# TBD - should get rid of this option
!if [nmakehlp -f $(OPTS) "thrdalloc"]
!message *** Doing thrdalloc
USE_THREAD_ALLOC = 1
!endif

!if [nmakehlp -f $(OPTS) "tclalloc"]
!message *** Doing tclalloc
USE_THREAD_ALLOC = 0
!endif

!if [nmakehlp -f $(OPTS) "unchecked"]
!message *** Doing unchecked
UNCHECKED = 1
!else
UNCHECKED = 0
!endif

!if [nmakehlp -f $(OPTS) "noconfigcheck"]
CONFIG_CHECK = 1
!else
CONFIG_CHECK = 0
!endif

!endif # "$(OPTS)" != ""  && ... parsing of OPTS

# Set linker flags based on above

!if $(PGO) > 1
!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)]
LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
!else
MSG=^
This compiler does not support profile guided optimization.
!error $(MSG)
!endif
!elseif $(PGO) > 0
!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)]
LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
!else
MSG=^
This compiler does not support profile guided optimization.
!error $(MSG)
!endif
!endif

################################################################
# 7. Parse the STATS macro to configure code instrumentation
# The following macros are set by this section:
# TCL_MEM_DEBUG - 1 -> enables memory allocation instrumentation
#                 0 -> disables
# TCL_COMPILE_DEBUG - 1 -> enables byte compiler logging
#                     0 -> disables

# Default both are off
TCL_MEM_DEBUG	    = 0
TCL_COMPILE_DEBUG   = 0

!if "$(STATS)" != "" && ![nmakehlp -f "$(STATS)" "none"]

!if [nmakehlp -f $(STATS) "memdbg"]
!message *** Doing memdbg
TCL_MEM_DEBUG	    = 1
!else
TCL_MEM_DEBUG	    = 0
!endif

!if [nmakehlp -f $(STATS) "compdbg"]
!message *** Doing compdbg
TCL_COMPILE_DEBUG   = 1
!else
TCL_COMPILE_DEBUG   = 0
!endif

!endif

####################################################################
# 8. Parse the CHECKS macro to configure additional compiler checks
# The following macros are set by this section:
# WARNINGS - compiler switches that control the warnings level
# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
#                     0 -> enable deprecated functions

# Defaults - Permit deprecated functions and warning level 3
TCL_NO_DEPRECATED	    = 0
WARNINGS		    = -W3

!if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]

!if [nmakehlp -f $(CHECKS) "nodep"]
!message *** Doing nodep check
TCL_NO_DEPRECATED	    = 1
!endif

!if [nmakehlp -f $(CHECKS) "fullwarn"]
!message *** Doing full warnings check
WARNINGS		    = -W4
!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
LINKERFLAGS		    = $(LINKERFLAGS) -warn:3
!endif
!endif

!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
!message *** Doing 64bit portability warnings
WARNINGS		    = $(WARNINGS) -Wp64
!endif

!endif

################################################################
# 9. Extract various version numbers
# For Tcl and Tk, version numbers are extracted from tcl.h and tk.h
# respectively. For extensions, versions are extracted from the
# configure.in or configure.ac from the TEA configuration if it
# exists, and unset otherwise.
# Sets the following macros:
# TCL_MAJOR_VERSION
# TCL_MINOR_VERSION
# TCL_PATCH_LEVEL
# TCL_VERSION
# TK_MAJOR_VERSION
# TK_MINOR_VERSION
# TK_PATCH_LEVEL
# TK_VERSION
# DOTVERSION - set as (for example) 2.5
# VERSION - set as (for example 25)
#--------------------------------------------------------------
#----------------------------------------------------------

!if [echo REM = This file is generated from rules.vc > versions.vc]
!endif
!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
!endif
!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
!endif
!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
!endif

!if defined(_TK_H)
!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
!endif
!if [echo TK_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
!endif
!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
!endif
!endif # _TK_H

!include versions.vc

TCL_VERSION	= $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
TCL_DOTVERSION	= $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
!if defined(_TK_H)
TK_VERSION	= $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
TK_DOTVERSION	= $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
!endif

# Set DOTVERSION and VERSION
!if $(DOING_TCL)

DOTVERSION = $(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
VERSION = $(TCL_VERSION)

!elseif $(DOING_TK)

DOTVERSION = $(TK_DOTVERSION)
VERSION = $(TK_VERSION)

!else # Doing a non-Tk extension

# If parent makefile has not defined DOTVERSION, try to get it from TEA
# first from a configure.in file, and then from configure.ac
!ifndef DOTVERSION
!if [echo DOTVERSION = \> versions.vc] \
   || [nmakehlp -V $(ROOT)\configure.in ^[$(PROJECT)^] >> versions.vc]
!if [echo DOTVERSION = \> versions.vc] \
   || [nmakehlp -V $(ROOT)\configure.ac ^[$(PROJECT)^] >> versions.vc]
!error *** Could not figure out extension version. Please define DOTVERSION in parent makefile before including rules.vc.
!endif
!endif
!include versions.vc
!endif # DOTVERSION
VERSION         = $(DOTVERSION:.=)

!endif # $(DOING_TCL) ... etc.

# Windows RC files have 3 version components. Ensure this irrespective
# of how many components the package has specified. Basically, ensure
# minimum 4 components by appending 4 0's and then pick out the first 4.
# Also take care of the fact that DOTVERSION may have "a" or "b" instead
# of "." separating the version components.
DOTSEPARATED=$(DOTVERSION:a=.)
DOTSEPARATED=$(DOTSEPARATED:b=.)
!if [echo RCCOMMAVERSION = \> versions.vc] \
  || [for /f "tokens=1,2,3,4,5* delims=." %a in ("$(DOTSEPARATED).0.0.0.0") do echo %a,%b,%c,%d >> versions.vc]
!error *** Could not generate RCCOMMAVERSION ***
!endif
!include versions.vc

################################################################
# 10. Construct output directory and file paths
# Figure-out how to name our intermediate and output directories.
# In order to avoid inadvertent mixing of object files built using
# different compilers, build configurations etc.,
#
# Naming convention (suffixes):
#   t = full thread support. (Not used for Tcl >= 8.7)
#   s = static library (as opposed to an import library)
#   g = linked to the debug enabled C run-time.
#   x = special static build when it links to the dynamic C run-time.
# We wouldn't want different builds to use the same .obj files
# by accident.
#----------------------------------------------------------

#----------------------------------------
# Naming convention:
#   t = full thread support.
#   s = static library (as opposed to an
#	import library)
#   g = linked to the debug enabled C
#	run-time.
#   x = special static build when it
#
# The following macros are set in this section:
# SUFX - the suffix to use for binaries based on above naming convention
# BUILDDIRTOP - the toplevel default output directory
#	links to the dynamic C run-time.
#      is of the form {Release,Debug}[_AMD64][_COMPILERVERSION]
# TMP_DIR - directory where object files are created
# OUT_DIR - directory where output executables are created
# Both TMP_DIR and OUT_DIR are defaulted only if not defined by the
# parent makefile (or command line). The default values are
# based on BUILDDIRTOP.
# STUBPREFIX - name of the stubs library for this project
# PRJIMPLIB - output path of the generated project import library
# PRJLIBNAME - name of generated project library
# PRJLIB     - output path of generated project library
# PRJSTUBLIBNAME - name of the generated project stubs library
# PRJSTUBLIB - output path of the generated project stubs library
# RESFILE - output resource file (only if not static build)

#----------------------------------------
SUFX	    = tsgx

!if $(DEBUG)
BUILDDIRTOP = Debug
!else
BUILDDIRTOP = Release
!endif

!if "$(MACHINE)" != "IX86"
BUILDDIRTOP =$(BUILDDIRTOP)_$(MACHINE)
!endif
!if $(VCVER) > 6
BUILDDIRTOP =$(BUILDDIRTOP)_VC$(VCVER)
!endif

!if !$(DEBUG) || $(TCL_VERSION) > 86 || $(DEBUG) && $(UNCHECKED)
!if !$(DEBUG) || $(DEBUG) && $(UNCHECKED)
SUFX	    = $(SUFX:g=)
!endif

TMP_DIRFULL = .\$(BUILDDIRTOP)\$(PROJECT)_ThreadedDynamicStaticX

!if !$(STATIC_BUILD)
TMP_DIRFULL = $(TMP_DIRFULL:Static=)
SUFX	    = $(SUFX:s=)
EXT	    = dll
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX	    = $(SUFX:x=)
!else
TMP_DIRFULL = $(TMP_DIRFULL:Dynamic=)
EXT	    = lib
!if !$(MSVCRT)
TMP_DIRFULL = $(TMP_DIRFULL:X=)
SUFX	    = $(SUFX:x=)
!endif
!endif

!if !$(TCL_THREADS) || $(TCL_VERSION) > 86
!if !$(TCL_THREADS)
TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
SUFX	    = $(SUFX:t=)
!endif

!ifndef TMP_DIR
TMP_DIR	    = $(TMP_DIRFULL)
!ifndef OUT_DIR
OUT_DIR	    = .\$(BUILDDIRTOP)
!endif
!else
!ifndef OUT_DIR
OUT_DIR	    = $(TMP_DIR)
!endif
!endif

# Relative paths -> absolute
!if [echo OUT_DIR = \> nmakehlp.out] \
   || [nmakehlp -Q "$(OUT_DIR)" >> nmakehlp.out]
!error *** Could not fully qualify path OUT_DIR=$(OUT_DIR)
!endif
!if [echo TMP_DIR = \>> nmakehlp.out] \
   || [nmakehlp -Q "$(TMP_DIR)" >> nmakehlp.out]
!error *** Could not fully qualify path TMP_DIR=$(TMP_DIR)
!endif
!include nmakehlp.out

#----------------------------------------------------------
# The name of the stubs library for the project being built
# Decode the statistics requested.
STUBPREFIX      = $(PROJECT)stub

#----------------------------------------------------------
# Set up paths to various Tcl executables and libraries needed by extensions
!if $(DOING_TCL)

TCLSHNAME       = $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH		= $(OUT_DIR)\$(TCLSHNAME)
TCLIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
TCLLIB		= $(OUT_DIR)\$(TCLLIBNAME)

!if "$(STATS)" == "" || [nmakehlp -f "$(STATS)" "none"]
TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)
TCL_INCLUDES    = -I"$(WIN_DIR)" -I"$(GENERICDIR)"

!else # !$(DOING_TCL)

!if $(TCLINSTALL) # Building against an installed Tcl

TCL_MEM_DEBUG	    = 0
TCL_COMPILE_DEBUG   = 0
!else
!if [nmakehlp -f $(STATS) "memdbg"]
!message *** Doing memdbg
TCL_MEM_DEBUG	    = 1
# When building extensions, we need to locate tclsh. Depending on version
# of Tcl we are building against, this may or may not have a "t" suffix.
# Try various possibilities in turn.
TCLSH		= $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist("$(TCLSH)")
TCLSH           = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!else
TCL_MEM_DEBUG	    = 0
!endif

TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
!if [nmakehlp -f $(STATS) "compdbg"]
!message *** Doing compdbg
TCL_COMPILE_DEBUG   = 1
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!else
TCL_COMPILE_DEBUG   = 0
!endif
TCL_LIBRARY	= $(_TCLDIR)\lib
TCLREGLIB	= $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES    = -I"$(_TCLDIR)\include"

!endif
!else # Building against Tcl sources

TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist($(TCLSH))
TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\library
TCLREGLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= $(_TCLDIR)\tools
TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"

!endif # TCLINSTALL

tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"

#----------------------------------------------------------
!endif # $(DOING_TCL)
# Decode the checks requested.
#----------------------------------------------------------

# We need a tclsh that will run on the host machine as part of the build.
# IX86 runs on all architectures.
!ifndef TCLSH_NATIVE
!if "$(MACHINE)" == "IX86" || "$(MACHINE)" == "$(NATIVE_ARCH)"
TCLSH_NATIVE	= $(TCLSH)
!if "$(CHECKS)" == "" || [nmakehlp -f "$(CHECKS)" "none"]
TCL_NO_DEPRECATED	    = 0
WARNINGS		    = -W3
!else
!error You must explicitly set TCLSH_NATIVE for cross-compilation
!endif
!endif

!if [nmakehlp -f $(CHECKS) "nodep"]
# Do the same for Tk and Tk extensions that require the Tk libraries
!if $(DOING_TK) || $(NEED_TK)
WISHNAMEPREFIX = wish
WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
TKLIBNAME	= $(PROJECT)$(TK_VERSION)$(SUFX).$(EXT)
TKSTUBLIBNAME	= tkstub$(TK_VERSION).lib
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX).lib

!message *** Doing nodep check
!if $(DOING_TK)
WISH 		= $(OUT_DIR)\$(WISHNAME)
TKSTUBLIB	= $(OUT_DIR)\$(TKSTUBLIBNAME)
TKIMPLIB	= $(OUT_DIR)\$(TKIMPLIBNAME)
TKLIB		= $(OUT_DIR)\$(TKLIBNAME)
TK_INCLUDES    = -I"$(WIN_DIR)" -I"$(GENERICDIR)"

!else # effectively NEED_TK

TCL_NO_DEPRECATED	    = 1
!else
TCL_NO_DEPRECATED	    = 0
!if $(TKINSTALL) # Building against installed Tk
WISH		= $(_TKDIR)\bin\$(WISHNAME)
TKSTUBLIB	= $(_TKDIR)\lib\$(TKSTUBLIBNAME)
TKIMPLIB	= $(_TKDIR)\lib\$(TKIMPLIBNAME)
# When building extensions, may be linking against Tk that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TKIMPLIB)")
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX:t=).lib
!endif
!if [nmakehlp -f $(CHECKS) "fullwarn"]
!message *** Doing full warnings check
TKIMPLIB	= $(_TKDIR)\lib\$(TKIMPLIBNAME)
!endif
TK_INCLUDES     = -I"$(_TKDIR)\include"
WARNINGS		    = -W4
!else # Building against Tk sources
WISH		= $(_TKDIR)\win\$(BUILDDIRTOP)\$(WISHNAME)
TKSTUBLIB	= $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKSTUBLIBNAME)
TKIMPLIB	= $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
# When building extensions, may be linking against Tk that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TKIMPLIB)")
!if [nmakehlp -l -warn:3 $(LINKER_TESTFLAGS)]
TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX:t=).lib
TKIMPLIB	= $(_TKDIR)\win\$(BUILDDIRTOP)\$(TKIMPLIBNAME)
LINKERFLAGS		    = $(LINKERFLAGS) -warn:3
!endif
TK_INCLUDES     = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
!endif # TKINSTALL
!else
tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"

!endif # $(DOING_TK)
WARNINGS		    = -W3
!endif
!endif # $(DOING_TK) || $(NEED_TK)

!if [nmakehlp -f $(CHECKS) "64bit"] && [nmakehlp -c -Wp64]
# Various output paths
PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
PRJLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
PRJLIB		= $(OUT_DIR)\$(PRJLIBNAME)

!message *** Doing 64bit portability warnings
PRJSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
PRJSTUBLIB	= $(OUT_DIR)\$(PRJSTUBLIBNAME)

WARNINGS		    = $(WARNINGS) -Wp64
# If extension parent makefile has not defined a resource definition file,
# we will generate one from standard template.
!if !$(DOING_TCL) && !$(DOING_TK) && !$(STATIC_BUILD)
!ifdef RCFILE
RESFILE = $(TMP_DIR)\$(RCFILE:.rc=.res)
!else
RESFILE = $(TMP_DIR)\$(PROJECT).res
!endif
!endif

###################################################################
# 11. Construct the paths for the installation directories
# The following macros get defined in this section:
# LIB_INSTALL_DIR - where libraries should be installed
# BIN_INSTALL_DIR - where the executables should be installed
# DOC_INSTALL_DIR - where documentation should be installed
# SCRIPT_INSTALL_DIR - where scripts should be installed
# INCLUDE_INSTALL_DIR - where C include files should be installed
# DEMO_INSTALL_DIR - where demos should be installed
# PRJ_INSTALL_DIR - where package will be installed (not set for Tcl and Tk)

!if $(DOING_TCL) || $(DOING_TK)
LIB_INSTALL_DIR		= $(_INSTALLDIR)\lib
BIN_INSTALL_DIR		= $(_INSTALLDIR)\bin
DOC_INSTALL_DIR		= $(_INSTALLDIR)\doc
!if $(DOING_TCL)
SCRIPT_INSTALL_DIR	= $(_INSTALLDIR)\lib\$(PROJECT)$(TCL_MAJOR_VERSION).$(TCL_MINOR_VERSION)
MODULE_INSTALL_DIR	= $(_INSTALLDIR)\lib\tcl$(TCL_MAJOR_VERSION)
!else # DOING_TK
SCRIPT_INSTALL_DIR	= $(_INSTALLDIR)\lib\$(PROJECT)$(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
!if $(PGO) > 1
!if [nmakehlp -l -ltcg:pgoptimize $(LINKER_TESTFLAGS)]
LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pgoptimize
!else
MSG=^
This compiler does not support profile guided optimization.
!error $(MSG)
!endif
DEMO_INSTALL_DIR	= $(SCRIPT_INSTALL_DIR)\demos
INCLUDE_INSTALL_DIR	= $(_INSTALLDIR)\include

!elseif $(PGO) > 0
!if [nmakehlp -l -ltcg:pginstrument $(LINKER_TESTFLAGS)]
!else # extension other than Tk

LINKERFLAGS	= $(LINKERFLAGS:-ltcg=) -ltcg:pginstrument
PRJ_INSTALL_DIR         = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION)
!if $(MULTIPLATFORM_INSTALL)
LIB_INSTALL_DIR		= $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY)
BIN_INSTALL_DIR		= $(PRJ_INSTALL_DIR)\$(PLATFORM_IDENTIFY)
!else
MSG=^
This compiler does not support profile guided optimization.
LIB_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
!error $(MSG)
BIN_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
!endif
DOC_INSTALL_DIR		= $(PRJ_INSTALL_DIR)
SCRIPT_INSTALL_DIR	= $(PRJ_INSTALL_DIR)
DEMO_INSTALL_DIR	= $(PRJ_INSTALL_DIR)\demos
INCLUDE_INSTALL_DIR	= $(_INSTALLDIR)\..\include

!endif

###################################################################
# 12. Set up actual options to be passed to the compiler and linker
# Now we have all the information we need, set up the actual flags and
# options that we will pass to the compiler and linker. The main

#----------------------------------------------------------
# Set our defines now armed with our options.
# makefile should use these in combination with whatever other flags
# and switches are specific to it.
#----------------------------------------------------------
# The following macros are defined, names are for historical compatibility:
# OPTDEFINES - /Dxxx C macro flags based on user-specified OPTS
# COMPILERFLAGS - /Dxxx C macro flags independent of any configuration opttions
# crt - Compiler switch that selects the appropriate C runtime
# cdebug - Compiler switches related to debug AND optimizations
# cwarn - Compiler switches that set warning levels
# cflags - complete compiler switches (subsumes cdebug and cwarn)
# ldebug - Linker switches controlling debug information and optimization
# lflags - complete linker switches (subsumes ldebug) except subsystem type
# dlllflags - complete linker switches to build DLLs (subsumes lflags)
# conlflags - complete linker switches for console program (subsumes lflags)
# guilflags - complete linker switches for GUI program (subsumes lflags)
# baselibs - minimum Windows libraries required. Parent makefile can
#    define PRJ_LIBS before including rules.rc if additional libs are needed

OPTDEFINES	= /DSTDC_HEADERS
OPTDEFINES	= /DTCL_CFGVAL_ENCODING=$(CFG_ENCODING) /DSTDC_HEADERS /DUSE_NMAKE=1
!if $(VCVERSION) >= 1600
OPTDEFINES	= $(OPTDEFINES) /DHAVE_STDINT_H=1
!else
OPTDEFINES	= $(OPTDEFINES) /DMP_NO_STDINT=1
!endif
!if $(VCVERSION) >= 1800
OPTDEFINES	= $(OPTDEFINES) /DHAVE_INTTYPES_H=1 /DHAVE_STDBOOL_H=1
!endif

!if $(TCL_MEM_DEBUG)
OPTDEFINES	= $(OPTDEFINES) /DTCL_MEM_DEBUG
!endif
!if $(TCL_COMPILE_DEBUG)
OPTDEFINES	= $(OPTDEFINES) /DTCL_COMPILE_DEBUG /DTCL_COMPILE_STATS
!endif
!if $(TCL_THREADS) && $(TCL_VERSION) < 87
!if $(TCL_THREADS)
OPTDEFINES	= $(OPTDEFINES) /DTCL_THREADS=1
!if $(USE_THREAD_ALLOC) && $(TCL_VERSION) < 87
!if $(USE_THREAD_ALLOC)
OPTDEFINES	= $(OPTDEFINES) /DUSE_THREAD_ALLOC=1
!endif
!endif
!if $(STATIC_BUILD)
OPTDEFINES	= $(OPTDEFINES) /DSTATIC_BUILD
!elseif $(TCL_VERSION) > 86
OPTDEFINES	= $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH
!if "$(MACHINE)" == "AMD64"
OPTDEFINES	= $(OPTDEFINES) /DMP_64BIT
!endif
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES	= $(OPTDEFINES) /DTCL_NO_DEPRECATED
!endif

!if $(USE_STUBS)
# Note we do not define USE_TCL_STUBS even when building tk since some
# test targets in tk do not use stubs
!if !$(DOING_TCL)
USE_STUBS_DEFS  = /DUSE_TCL_STUBS /DUSE_TCLOO_STUBS
!if $(NEED_TK)
USE_STUBS_DEFS  = $(USE_STUBS_DEFS) /DUSE_TK_STUBS
!endif
!endif
!endif # USE_STUBS

!if !$(DEBUG)
OPTDEFINES	= $(OPTDEFINES) /DNDEBUG
!if $(OPTIMIZING)
OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_OPTIMIZED
!endif
!endif
!if $(PROFILE)
OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_PROFILED
!endif
!if "$(MACHINE)" == "AMD64"
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
OPTDEFINES	= $(OPTDEFINES) /DNO_STRTOI64=1
OPTDEFINES	= $(OPTDEFINES) /DNO_STRTOI64
!endif

!if "$(TCL_MAJOR_VERSION)" == "8"
!if "$(_USE_64BIT_TIME_T)" == "1"
OPTDEFINES	= $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
OPTDEFINES	= $(OPTDEFINES) /D_USE_64BIT_TIME_T
!endif
!if "$(TCL_UTF_MAX)" == "4"
OPTDEFINES	= $(OPTDEFINES) /DTCL_UTF_MAX=4
!endif

# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
COMPILERFLAGS  = /D_ATL_XP_TARGETING
!endif

# Like the TEA system only set this non empty for non-Tk extensions
# Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
# so we pass both
!if !$(DOING_TCL) && !$(DOING_TK)
PKGNAMEFLAGS = /DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
               /DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
               /DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
               /DMODULE_SCOPE=extern
!endif

# crt picks the C run time based on selected OPTS
!if $(MSVCRT)
#----------------------------------------------------------
# Locate the Tcl headers to build against
!if $(DEBUG) && !$(UNCHECKED)
crt = -MDd
!else
crt = -MD
!endif
!else
!if $(DEBUG) && !$(UNCHECKED)
crt = -MTd
!else
crt = -MT
!endif
!endif
#----------------------------------------------------------

# cdebug includes compiler options for debugging as well as optimization.
!if $(DEBUG)
!if "$(PROJECT)" == "tcl"

# In debugging mode, optimizations need to be disabled
cdebug = -Zi -Od $(DEBUGFLAGS)
_TCL_H          = ..\generic\tcl.h

!else

cdebug = $(OPTIMIZATIONS)
!if $(SYMBOLS)
# If INSTALLDIR set to tcl root dir then reset to the lib dir.
!if exist("$(_INSTALLDIR)\include\tcl.h")
cdebug = $(cdebug) -Zi
_INSTALLDIR=$(_INSTALLDIR)\lib
!endif

!endif # $(DEBUG)

!if !defined(TCLDIR)
!if exist("$(_INSTALLDIR)\..\include\tcl.h")
# cwarn includes default warning levels.
cwarn = $(WARNINGS)

TCLINSTALL	= 1
_TCLDIR		= $(_INSTALLDIR)\..
!if "$(MACHINE)" == "AMD64"
# Disable pointer<->int warnings related to cast between different sizes
# There are a gadzillion of these due to use of ClientData and
# clutter up compiler
# output increasing chance of a real warning getting lost. So disable them.
# Eventually some day, Tcl will be 64-bit clean.
cwarn = $(cwarn) -wd4311 -wd4312
_TCL_H          = $(_INSTALLDIR)\..\include\tcl.h
!endif

TCLDIR          = $(_INSTALLDIR)\..
### Common compiler options that are architecture specific
!if "$(MACHINE)" == "ARM"
carch = /D_ARM_WINAPI_PARTITION_DESKTOP_SDK_AVAILABLE
!else
carch =
MSG=^
!endif

!if $(DEBUG)
Failed to find tcl.h.  Set the TCLDIR macro.
!error $(MSG)
# Turn warnings into errors
cwarn = $(cwarn) -WX
!endif

!else
INCLUDES = $(TCL_INCLUDES) $(TK_INCLUDES) $(PRJ_INCLUDES)
!if !$(DOING_TCL) && !$(DOING_TK)
INCLUDES = $(INCLUDES) -I"$(GENERICDIR)" -I"$(WIN_DIR)" -I"$(COMPATDIR)"
!endif

_TCLDIR	= $(TCLDIR:/=\)
!if exist("$(_TCLDIR)\include\tcl.h")
TCLINSTALL	= 1
_TCL_H          = $(_TCLDIR)\include\tcl.h
!elseif exist("$(_TCLDIR)\generic\tcl.h")
TCLINSTALL	= 0
_TCL_H          = $(_TCLDIR)\generic\tcl.h
!else
MSG =^
# These flags are defined roughly in the order of the pre-reform
# rules.vc/makefile.vc to help visually compare that the pre- and
# post-reform build logs

Failed to find tcl.h.  The TCLDIR macro does not appear correct.
# cflags contains generic flags used for building practically all object files
cflags = -nologo -c $(COMPILERFLAGS) $(carch) $(cwarn) -Fp$(TMP_DIR)^\ $(cdebug)

# appcflags contains $(cflags) and flags for building the application
!error $(MSG)
!endif
# object files (e.g. tclsh, or wish) pkgcflags contains $(cflags) plus
# flags used for building shared object files The two differ in the
# BUILD_$(PROJECT) macro which should be defined only for the shared
# library *implementation* and not for its caller interface

!endif
appcflags_nostubs = $(cflags) $(crt) $(INCLUDES) $(TCL_DEFINES) $(PRJ_DEFINES) $(OPTDEFINES)
appcflags = $(appcflags_nostubs) $(USE_STUBS_DEFS)
pkgcflags = $(appcflags) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT)
pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) /DBUILD_$(PROJECT)

!endif
# stubscflags contains $(cflags) plus flags used for building a stubs
# library for the package.  Note: /DSTATIC_BUILD is defined in
# $(OPTDEFINES) only if the OPTS configuration indicates a static
# library. However the stubs library is ALWAYS static hence included
# here irrespective of the OPTS setting.
#
# TBD - tclvfs has a comment that stubs libs should not be compiled with -GL
# without stating why. Tcl itself compiled stubs libs with this flag.
# so we do not remove it from cflags. -GL may prevent extensions
# compiled with one VC version to fail to link against stubs library
# compiled with another VC version. Check for this and fix accordingly.
stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl /DSTATIC_BUILD $(INCLUDES) $(USE_STUBS_DEFS)

# Link flags

#--------------------------------------------------------------
!if $(DEBUG)
ldebug	= -debug -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3
!if $(SYMBOLS)
ldebug	= $(ldebug) -debug -debugtype:cv
!endif
!endif
# Extract various version numbers from tcl headers
# The generated file is then included in the makefile.
#--------------------------------------------------------------

# Note: Profiling is currently only possible with the Visual Studio Enterprise
!if $(PROFILE)
!if [echo REM = This file is generated from rules.vc > versions.vc]
ldebug= $(ldebug) -profile
!endif

!if [echo TCL_MAJOR_VERSION = \>> versions.vc] \
### Declarations common to all linker versions
lflags	= -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)

   && [nmakehlp -V "$(_TCL_H)" TCL_MAJOR_VERSION >> versions.vc]
!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
lflags	= $(lflags) -nodefaultlib:libucrt.lib
!endif

!if [echo TCL_MINOR_VERSION = \>> versions.vc] \
# Old linkers (Visual C++ 6 in particular) will link for fast loading
# on Win98. Since we do not support Win98 any more, we specify nowin98
# as recommended for NT and later. However, this is only required by
# IX86 on older compilers and only needed if we are not doing a static build.

   && [nmakehlp -V "$(_TCL_H)" TCL_MINOR_VERSION >> versions.vc]
!if "$(MACHINE)" == "IX86" && !$(STATIC_BUILD)
!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
# Align sections for PE size savings.
lflags	= $(lflags) -opt:nowin98
!endif
!endif

!if [echo TCL_PATCH_LEVEL = \>> versions.vc] \
dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows

   && [nmakehlp -V "$(_TCL_H)" TCL_PATCH_LEVEL >> versions.vc]
# Libraries that are required for every image.
# Extensions should define any additional libraries with $(PRJ_LIBS)
winlibs   = kernel32.lib advapi32.lib

!if $(NEED_TK)
winlibs = $(winlibs) gdi32.lib user32.lib uxtheme.lib
!endif

# Avoid 'unresolved external symbol __security_cookie' errors.
# c.f. http://support.microsoft.com/?id=894573
!if "$(MACHINE)" == "AMD64"
!if $(VCVERSION) > 1399 && $(VCVERSION) < 1500

# If building the tcl core then we need additional package versions
!if "$(PROJECT)" == "tcl"
winlibs   = $(winlibs) bufferoverflowU.lib
!if [echo PKG_HTTP_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\http\pkgIndex.tcl http >> versions.vc]
!endif
!if [echo PKG_TCLTEST_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\tcltest\pkgIndex.tcl tcltest >> versions.vc]
!endif

!if [echo PKG_MSGCAT_VER = \>> versions.vc] \
baselibs = $(winlibs) $(PRJ_LIBS)

   && [nmakehlp -V ..\library\msgcat\pkgIndex.tcl msgcat >> versions.vc]
!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
baselibs   = $(baselibs) ucrt.lib
!endif

!if [echo PKG_PLATFORM_VER = \>> versions.vc] \
################################################################
# 13. Define standard commands, common make targets and implicit rules

CCPKGCMD = $(cc32) $(pkgcflags) -Fo$(TMP_DIR)^\
CCAPPCMD = $(cc32) $(appcflags) -Fo$(TMP_DIR)^\
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform " >> versions.vc]
!endif
!if [echo PKG_SHELL_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc]
CCSTUBSCMD = $(cc32) $(stubscflags) -Fo$(TMP_DIR)^\

LIBCMD = $(lib32) -nologo $(LINKERFLAGS) -out:$@
DLLCMD = $(link32) $(dlllflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)

CONEXECMD = $(link32) $(conlflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
GUIEXECMD = $(link32) $(guilflags) -out:$@ $(baselibs) $(tcllibs) $(tklibs)
RESCMD  = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
!endif
!if [echo PKG_DDE_VER = \>> versions.vc] \
   && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc]
!endif
!if [echo PKG_REG_VER =\>> versions.vc] \
   && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc]
!endif
!endif
	    $(TCL_INCLUDES) \
	    /DDEBUG=$(DEBUG) -d UNCHECKED=$(UNCHECKED) \
	    /DCOMMAVERSION=$(RCCOMMAVERSION) \
	    /DDOTVERSION=\"$(DOTVERSION)\" \
	    /DVERSION=\"$(VERSION)\" \
	    /DSUFX=\"$(SUFX)\" \
	    /DPROJECT=\"$(PROJECT)\" \
	    /DPRJLIBNAME=\"$(PRJLIBNAME)\"

!ifndef DEFAULT_BUILD_TARGET
DEFAULT_BUILD_TARGET = $(PROJECT)
!endif
!include versions.vc

default-target: $(DEFAULT_BUILD_TARGET)
#--------------------------------------------------------------
# Setup tcl version dependent stuff headers
#--------------------------------------------------------------

!if $(MULTIPLATFORM_INSTALL)
!if "$(PROJECT)" != "tcl"
default-pkgindex:
	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PLATFORM_IDENTIFY) $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
!else
default-pkgindex:
	@echo package ifneeded $(PRJ_PACKAGE_TCLNAME) $(DOTVERSION) \
	    [list load [file join $$dir $(PRJLIBNAME)]] > $(OUT_DIR)\pkgIndex.tcl
!endif

default-pkgindex-tea:
	@if exist $(ROOT)\pkgIndex.tcl.in nmakehlp -s << $(ROOT)\pkgIndex.tcl.in > $(OUT_DIR)\pkgIndex.tcl
@PACKAGE_VERSION@    $(DOTVERSION)
TCL_VERSION	= $(TCL_MAJOR_VERSION)$(TCL_MINOR_VERSION)
@PACKAGE_NAME@       $(PRJ_PACKAGE_TCLNAME)
@PACKAGE_TCLNAME@    $(PRJ_PACKAGE_TCLNAME)
@PKG_LIB_FILE@       $(PRJLIBNAME)
<<

default-install: default-install-binaries default-install-libraries
!if $(SYMBOLS)
default-install: default-install-pdbs
!endif

# Again to deal with historical brokenness, there is some confusion
# in terminlogy. For extensions, the "install-binaries" was used to
# locate target directory for *binary shared libraries* and thus
# the appropriate macro is LIB_INSTALL_DIR since BIN_INSTALL_DIR is
# for executables (exes). On the other hand the "install-libraries"
# target is for *scripts* and should have been called "install-scripts".
default-install-binaries: $(PRJLIB)
	@echo Installing binaries to '$(LIB_INSTALL_DIR)'
	@if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)"
	@$(CPY) $(PRJLIB) "$(LIB_INSTALL_DIR)" >NUL

# Alias for default-install-scripts
default-install-libraries: default-install-scripts

default-install-scripts: $(OUT_DIR)\pkgIndex.tcl
	@echo Installing libraries to '$(SCRIPT_INSTALL_DIR)'
	@if exist $(LIBDIR) $(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)"
	@echo Installing package index in '$(SCRIPT_INSTALL_DIR)'
	@$(CPY) $(OUT_DIR)\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)

default-install-stubs:
	@echo Installing stubs library to '$(SCRIPT_INSTALL_DIR)'
	@if not exist "$(SCRIPT_INSTALL_DIR)" mkdir "$(SCRIPT_INSTALL_DIR)"
	@$(CPY) $(PRJSTUBLIB) "$(SCRIPT_INSTALL_DIR)" >NUL

default-install-pdbs:
	@echo Installing PDBs to '$(LIB_INSTALL_DIR)'
	@if not exist "$(LIB_INSTALL_DIR)" mkdir "$(LIB_INSTALL_DIR)"
	@$(CPY) "$(OUT_DIR)\*.pdb" "$(LIB_INSTALL_DIR)\"

!if $(TCLINSTALL)
TCLSH		= "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
!if !exist($(TCLSH)) && $(TCL_THREADS)
TCLSH           = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe"
!endif
TCLSTUBLIB	= "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
TCLIMPLIB	= "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY	= $(_TCLDIR)\lib
TCLREGLIB	= "$(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib"
default-install-docs-html:
	@echo Installing documentation files to '$(DOC_INSTALL_DIR)'
	@if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
	@if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.html" "$(DOCDIR)\*.css" "$(DOCDIR)\*.png") do @$(COPY) %f "$(DOC_INSTALL_DIR)"

default-install-docs-n:
	@echo Installing documentation files to '$(DOC_INSTALL_DIR)'
	@if not exist "$(DOC_INSTALL_DIR)" mkdir "$(DOC_INSTALL_DIR)"
	@if exist $(DOCDIR) for %f in ("$(DOCDIR)\*.n") do @$(COPY) %f "$(DOC_INSTALL_DIR)"

default-install-demos:
	@echo Installing demos to '$(DEMO_INSTALL_DIR)'
	@if not exist "$(DEMO_INSTALL_DIR)" mkdir "$(DEMO_INSTALL_DIR)"
	@if exist $(DEMODIR) $(CPYDIR) "$(DEMODIR)" "$(DEMO_INSTALL_DIR)"

TCLDDELIB	= "$(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib"
COFFBASE	= \must\have\tcl\sources\to\build\this\target
TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES    = -I"$(_TCLDIR)\include"
!else
TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
!if !exist($(TCLSH)) && $(TCL_THREADS)
TCLSH		= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe"
!endif
TCLSTUBLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
TCLIMPLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
TCL_LIBRARY	= $(_TCLDIR)\library
TCLREGLIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib"
TCLDDELIB	= "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib"
default-clean:
	@echo Cleaning $(TMP_DIR)\* ...
	@if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
	@echo Cleaning $(WIN_DIR)\nmakehlp.obj, nmakehlp.exe ...
COFFBASE	= "$(_TCLDIR)\win\coffbase.txt"
TCLTOOLSDIR	= $(_TCLDIR)\tools
TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
!endif
	@if exist $(WIN_DIR)\nmakehlp.obj del $(WIN_DIR)\nmakehlp.obj
	@if exist $(WIN_DIR)\nmakehlp.exe del $(WIN_DIR)\nmakehlp.exe
	@if exist $(WIN_DIR)\nmakehlp.out del $(WIN_DIR)\nmakehlp.out
	@echo Cleaning $(WIN_DIR)\nmhlp-out.txt ...
	@if exist $(WIN_DIR)\nmhlp-out.txt del $(WIN_DIR)\nmhlp-out.txt
	@echo Cleaning $(WIN_DIR)\_junk.pch ...
	@if exist $(WIN_DIR)\_junk.pch del $(WIN_DIR)\_junk.pch
	@echo Cleaning $(WIN_DIR)\vercl.x, vercl.i ...
	@if exist $(WIN_DIR)\vercl.x del $(WIN_DIR)\vercl.x
	@if exist $(WIN_DIR)\vercl.i del $(WIN_DIR)\vercl.i
	@echo Cleaning $(WIN_DIR)\versions.vc, version.vc ...
	@if exist $(WIN_DIR)\versions.vc del $(WIN_DIR)\versions.vc
	@if exist $(WIN_DIR)\version.vc del $(WIN_DIR)\version.vc

default-hose: default-clean
	@echo Hosing $(OUT_DIR)\* ...
	@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)

# Only for backward compatibility
default-distclean: default-hose

default-setup:
	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR)
	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR)

!if "$(TESTPAT)" != ""
TESTFLAGS = $(TESTFLAGS) -file $(TESTPAT)
!endif

default-test: default-setup $(PROJECT)
	@set TCLLIBPATH=$(OUT_DIR:\=/)
	@if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
	cd "$(TESTDIR)" && $(DEBUGGER) $(TCLSH) all.tcl $(TESTFLAGS)

#-------------------------------------------------------------------------
default-shell: default-setup $(PROJECT)
	@set TCLLIBPATH=$(OUT_DIR:\=/)
	@if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
	$(DEBUGGER) $(TCLSH)

# Locate the Tk headers to build against
# Generation of Windows version resource
!ifdef RCFILE
#-------------------------------------------------------------------------

# Note: don't use $** in below rule because there may be other dependencies
# and only the "main" rc must be passed to the resource compiler
$(TMP_DIR)\$(PROJECT).res: $(RCDIR)\$(PROJECT).rc
	$(RESCMD) $(RCDIR)\$(PROJECT).rc

!if "$(PROJECT)" == "tk"
_TK_H          = ..\generic\tk.h
!else

_INSTALLDIR    = $(_INSTALLDIR)\..
# If parent makefile has not defined a resource definition file,
# we will generate one from standard template.
$(TMP_DIR)\$(PROJECT).res: $(TMP_DIR)\$(PROJECT).rc

!endif
$(TMP_DIR)\$(PROJECT).rc:
	@$(COPY) << $(TMP_DIR)\$(PROJECT).rc
#include <winver.h>

VS_VERSION_INFO VERSIONINFO
 FILEVERSION	COMMAVERSION
 PRODUCTVERSION	COMMAVERSION
 FILEFLAGSMASK	0x3fL
#ifdef DEBUG
 FILEFLAGS	VS_FF_DEBUG
#else
!ifdef PROJECT_REQUIRES_TK
!if !defined(TKDIR)
!if exist("$(_INSTALLDIR)\..\include\tk.h")
TKINSTALL      = 1
_TKDIR         = $(_INSTALLDIR)\..
_TK_H          = $(_TKDIR)\include\tk.h
TKDIR          = $(_TKDIR)
!elseif exist("$(_TCLDIR)\include\tk.h")
 FILEFLAGS	0x0L
#endif
TKINSTALL      = 1
_TKDIR         = $(_TCLDIR)
_TK_H          = $(_TKDIR)\include\tk.h
TKDIR          = $(_TKDIR)
!endif
 FILEOS		VOS_NT_WINDOWS32
 FILETYPE	VFT_DLL
 FILESUBTYPE	0x0L
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0"
!else
_TKDIR = $(TKDIR:/=\)
!if exist("$(_TKDIR)\include\tk.h")
        BEGIN
            VALUE "FileDescription",  "Tcl extension " PROJECT
            VALUE "OriginalFilename", PRJLIBNAME
            VALUE "FileVersion",      DOTVERSION
            VALUE "ProductName",      "Package " PROJECT " for Tcl"
            VALUE "ProductVersion",   DOTVERSION
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200
    END
END

TKINSTALL      = 1
_TK_H          = $(_TKDIR)\include\tk.h
!elseif exist("$(_TKDIR)\generic\tk.h")
TKINSTALL      = 0
_TK_H          = $(_TKDIR)\generic\tk.h
<<

!endif # ifdef RCFILE

!else
MSG =^
Failed to find tk.h. The TKDIR macro does not appear correct.
!error $(MSG)
!endif
!endif
!ifndef DISABLE_IMPLICIT_RULES
DISABLE_IMPLICIT_RULES = 0
!endif

!if !$(DISABLE_IMPLICIT_RULES)
# Implicit rule definitions - only for building library objects. For stubs and
# main application, the makefile should define explicit rules.

#-------------------------------------------------------------------------
{$(ROOT)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

# Extract Tk version numbers
{$(WIN_DIR)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

#-------------------------------------------------------------------------
{$(GENERICDIR)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

{$(COMPATDIR)}.c{$(TMP_DIR)}.obj::
	$(CCPKGCMD) @<<
$<
<<

!if defined(PROJECT_REQUIRES_TK) || "$(PROJECT)" == "tk"
{$(RCDIR)}.rc{$(TMP_DIR)}.res:
	$(RESCMD) $<

{$(WIN_DIR)}.rc{$(TMP_DIR)}.res:
	$(RESCMD) $<

!if [echo TK_MAJOR_VERSION = \>> versions.vc] \
{$(TMP_DIR)}.rc{$(TMP_DIR)}.res:
	$(RESCMD) $<

   && [nmakehlp -V $(_TK_H) TK_MAJOR_VERSION >> versions.vc]
.SUFFIXES:
.SUFFIXES:.c .rc

!endif
!if [echo TK_MINOR_VERSION = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_MINOR_VERSION >> versions.vc]
!endif
!if [echo TK_PATCH_LEVEL = \>> versions.vc] \
   && [nmakehlp -V $(_TK_H) TK_PATCH_LEVEL >> versions.vc]
!endif

################################################################
# 14. Sanity check selected options against Tcl build options
# When building an extension, certain configuration options should
# match the ones used when Tcl was built. Here we check and
# warn on a mismatch.
!if !$(DOING_TCL)
!include versions.vc

TK_DOTVERSION	= $(TK_MAJOR_VERSION).$(TK_MINOR_VERSION)
TK_VERSION	= $(TK_MAJOR_VERSION)$(TK_MINOR_VERSION)
!if $(TCLINSTALL) # Building against an installed Tcl
!if exist("$(_TCLDIR)\lib\nmake\tcl.nmake")
TCLNMAKECONFIG = "$(_TCLDIR)\lib\nmake\tcl.nmake"
!endif
!else # !$(TCLINSTALL) - building against Tcl source
!if exist("$(OUT_DIR)\tcl.nmake")
TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
!endif
!endif # TCLINSTALL

!if $(CONFIG_CHECK)
!if "$(PROJECT)" != "tk"
!ifdef TCLNMAKECONFIG
!include $(TCLNMAKECONFIG)

!if $(TKINSTALL)
WISH		= "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
!if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)"
!error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)).
!endif
!if $(TCL_VERSION) < 87 && defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC)
TKSTUBLIB	= "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
TKIMPLIB	= "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
TK_INCLUDES     = -I"$(_TKDIR)\include"
!else
WISH		= "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
!message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)).
TKSTUBLIB	= "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
TKIMPLIB	= "$(_TKDIR)\win\$(BUILDDIRTOP)\tk$(TCL_VERSION)$(SUFX).lib"
TK_INCLUDES     = -I"$(_TKDIR)\generic" -I"$(_TKDIR)\win" -I"$(_TKDIR)\xlib"
!endif
!if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG)
!message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)).
!endif
!endif

!endif # TCLNMAKECONFIG
!endif

!endif # !$(DOING_TCL)


#----------------------------------------------------------
# Display stats being used.
#----------------------------------------------------------

!if !$(DOING_TCL)
!message *** Building against Tcl at '$(_TCLDIR)'
!endif
!if !$(DOING_TK) && $(NEED_TK)
!message *** Building against Tk at '$(_TKDIR)'
!endif
!message *** Intermediate directory will be '$(TMP_DIR)'
!message *** Output directory will be '$(OUT_DIR)'
!message *** Installation, if selected, will be in '$(_INSTALLDIR)'
!message *** Suffix for binaries will be '$(SUFX)'
!message *** Optional defines are '$(OPTDEFINES)'
!message *** Compiler version $(VCVER). Target $(MACHINE), host $(NATIVE_ARCH).
!message *** Compiler version $(VCVER). Target machine is $(MACHINE)
!message *** Host architecture is $(NATIVE_ARCH)
!message *** Compiler options '$(COMPILERFLAGS) $(OPTIMIZATIONS) $(DEBUGFLAGS) $(WARNINGS)'
!message *** Link options '$(LINKERFLAGS)'

!endif # ifdef _RULES_VC
!endif

Added win/stub16.c.




































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
/*
 * stub16.c
 *
 *	A helper program used for running 16-bit DOS applications under
 *	Windows 95.
 *
 * Copyright (c) 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.
 */

#define STRICT

#include <windows.h>
#include <stdio.h>

static HANDLE		CreateTempFile(void);

/*
 *---------------------------------------------------------------------------
 *
 * main
 *
 *	Entry point for the 32-bit console mode app used by Windows 95 to help
 *	run the 16-bit program specified on the command line.
 *
 *	1. EOF on a pipe that connects a detached 16-bit process and a 32-bit
 *	process is never seen. So, this process runs the 16-bit process
 *	_attached_, and then it is run detached from the calling 32-bit
 *	process.
 *
 *	2. If a 16-bit process blocks reading from or writing to a pipe, it
 *	never wakes up, and eventually brings the whole system down with it if
 *	you try to kill the process. This app simulates pipes. If any of the
 *	stdio handles is a pipe, this program accumulates information into
 *	temp files and forwards it to or from the DOS application as
 *	appropriate. This means that this program must receive EOF from a
 *	stdin pipe before it will actually start the DOS app, and the DOS app
 *	must finish generating stdout or stderr before the data will be sent
 *	to the next stage of the pipe. If the stdio handles are not pipes, no
 *	accumulation occurs and the data is passed straight through to and
 *	from the DOS application.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The child process is created and this process waits for it to
 *	complete.
 *
 *---------------------------------------------------------------------------
 */

int
main(void)
{
    DWORD dwRead, dwWrite;
    char *cmdLine;
    HANDLE hStdInput, hStdOutput, hStdError;
    HANDLE hFileInput, hFileOutput, hFileError;
    STARTUPINFO si;
    PROCESS_INFORMATION pi;
    char buf[8192];
    DWORD result;

    hFileInput = INVALID_HANDLE_VALUE;
    hFileOutput = INVALID_HANDLE_VALUE;
    hFileError = INVALID_HANDLE_VALUE;
    result = 1;

    /*
     * Don't get command line from argc, argv, because the command line
     * tokenizer will have stripped off all the escape sequences needed for
     * quotes and backslashes, and then we'd have to put them all back in
     * again. Get the raw command line and parse off what we want ourselves.
     * The command line should be of the form:
     *
     * stub16.exe program arg1 arg2 ...
     */

    cmdLine = strchr(GetCommandLine(), ' ');
    if (cmdLine == NULL) {
	return 1;
    }
    cmdLine++;

    hStdInput = GetStdHandle(STD_INPUT_HANDLE);
    hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE);
    hStdError = GetStdHandle(STD_ERROR_HANDLE);

    if (GetFileType(hStdInput) == FILE_TYPE_PIPE) {
	hFileInput = CreateTempFile();
	if (hFileInput == INVALID_HANDLE_VALUE) {
	    goto cleanup;
	}
	while (ReadFile(hStdInput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
	    if (dwRead == 0) {
		break;
	    }
	    if (WriteFile(hFileInput, buf, dwRead, &dwWrite, NULL) == FALSE) {
		goto cleanup;
	    }
	}
	SetFilePointer(hFileInput, 0, 0, FILE_BEGIN);
	SetStdHandle(STD_INPUT_HANDLE, hFileInput);
    }
    if (GetFileType(hStdOutput) == FILE_TYPE_PIPE) {
	hFileOutput = CreateTempFile();
	if (hFileOutput == INVALID_HANDLE_VALUE) {
	    goto cleanup;
	}
	SetStdHandle(STD_OUTPUT_HANDLE, hFileOutput);
    }
    if (GetFileType(hStdError) == FILE_TYPE_PIPE) {
	hFileError = CreateTempFile();
	if (hFileError == INVALID_HANDLE_VALUE) {
	    goto cleanup;
	}
	SetStdHandle(STD_ERROR_HANDLE, hFileError);
    }

    ZeroMemory(&si, sizeof(si));
    si.cb = sizeof(si);
    if (CreateProcess(NULL, cmdLine, NULL, NULL, TRUE, 0, NULL, NULL, &si,
	    &pi) == FALSE) {
	goto cleanup;
    }

    WaitForInputIdle(pi.hProcess, 5000);
    WaitForSingleObject(pi.hProcess, INFINITE);
    GetExitCodeProcess(pi.hProcess, &result);
    CloseHandle(pi.hProcess);
    CloseHandle(pi.hThread);

    if (hFileOutput != INVALID_HANDLE_VALUE) {
	SetFilePointer(hFileOutput, 0, 0, FILE_BEGIN);
	while (ReadFile(hFileOutput, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
	    if (dwRead == 0) {
		break;
	    }
	    if (WriteFile(hStdOutput, buf, dwRead, &dwWrite, NULL) == FALSE) {
		break;
	    }
	}
    }
    if (hFileError != INVALID_HANDLE_VALUE) {
	SetFilePointer(hFileError, 0, 0, FILE_BEGIN);
	while (ReadFile(hFileError, buf, sizeof(buf), &dwRead, NULL) != FALSE) {
	    if (dwRead == 0) {
		break;
	    }
	    if (WriteFile(hStdError, buf, dwRead, &dwWrite, NULL) == FALSE) {
		break;
	    }
	}
    }

  cleanup:
    if (hFileInput != INVALID_HANDLE_VALUE) {
	CloseHandle(hFileInput);
    }
    if (hFileOutput != INVALID_HANDLE_VALUE) {
	CloseHandle(hFileOutput);
    }
    if (hFileError != INVALID_HANDLE_VALUE) {
	CloseHandle(hFileError);
    }
    CloseHandle(hStdInput);
    CloseHandle(hStdOutput);
    CloseHandle(hStdError);
    ExitProcess(result);
    return 1;
}

static HANDLE
CreateTempFile(void)
{
    char name[MAX_PATH];
    SECURITY_ATTRIBUTES sa;

    if (GetTempPath(sizeof(name), name) == 0) {
	return INVALID_HANDLE_VALUE;
    }
    if (GetTempFileName(name, "tcl", 0, name) == 0) {
	return INVALID_HANDLE_VALUE;
    }

    sa.nLength = sizeof(sa);
    sa.lpSecurityDescriptor = NULL;
    sa.bInheritHandle = TRUE;
    return CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, &sa,
	    CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
	    NULL);
}

Deleted win/targets.vc.

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


































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
#------------------------------------------------------------- -*- makefile -*-
# targets.vc --
#
# Part of the nmake based build system for Tcl and its extensions.
# This file defines some standard targets for the convenience of extensions
# and can be optionally included by the extension makefile.
# See TIP 477 (https://core.tcl-lang.org/tips/doc/trunk/tip/477.md) for docs.

$(PROJECT): setup pkgindex $(PRJLIB)

!ifdef PRJ_STUBOBJS
$(PROJECT): $(PRJSTUBLIB)
$(PRJSTUBLIB): $(PRJ_STUBOBJS)
	$(LIBCMD) $**

$(PRJ_STUBOBJS):
	$(CCSTUBSCMD) %s
!endif # PRJ_STUBOBJS

!ifdef PRJ_MANIFEST
$(PROJECT): $(PRJLIB).manifest
$(PRJLIB).manifest: $(PRJ_MANIFEST)
	@nmakehlp -s << $** >$@
@MACHINE@	  $(MACHINE:IX86=X86)
<<
!endif

!if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
$(PRJLIB): $(PRJ_OBJS) $(RESFILE)
!if $(STATIC_BUILD)
       $(LIBCMD) $**
!else
       $(DLLCMD) $**
       $(_VC_MANIFEST_EMBED_DLL)
!endif
       -@del $*.exp
!endif

!if "$(PRJ_HEADERS)" != "" && "$(PRJ_OBJS)" != ""
$(PRJ_OBJS): $(PRJ_HEADERS)
!endif

# If parent makefile has defined stub objects, add their installation
# to the default install
!if "$(PRJ_STUBOBJS)" != ""
default-install: default-install-stubs
!endif

# Unlike the other default targets, these cannot be in rules.vc because
# the executed command depends on existence of macro PRJ_HEADERS_PUBLIC
# that the parent makefile will not define until after including rules-ext.vc
!if "$(PRJ_HEADERS_PUBLIC)" != ""
default-install: default-install-headers
default-install-headers:
	@echo Installing headers to '$(INCLUDE_INSTALL_DIR)'
	@for %f in ($(PRJ_HEADERS_PUBLIC)) do @$(COPY) %f "$(INCLUDE_INSTALL_DIR)"
!endif

!if "$(DISABLE_STANDARD_TARGETS)" == ""
DISABLE_STANDARD_TARGETS = 0
!endif

!if "$(DISABLE_TARGET_setup)" == ""
DISABLE_TARGET_setup = 0
!endif
!if "$(DISABLE_TARGET_install)" == ""
DISABLE_TARGET_install = 0
!endif
!if "$(DISABLE_TARGET_clean)" == ""
DISABLE_TARGET_clean = 0
!endif
!if "$(DISABLE_TARGET_test)" == ""
DISABLE_TARGET_test = 0
!endif
!if "$(DISABLE_TARGET_shell)" == ""
DISABLE_TARGET_shell = 0
!endif

!if !$(DISABLE_STANDARD_TARGETS)
!if !$(DISABLE_TARGET_setup)
setup: default-setup
!endif
!if !$(DISABLE_TARGET_install)
install: default-install
!endif
!if !$(DISABLE_TARGET_clean)
clean: default-clean
realclean: hose
hose: default-hose
distclean: realclean default-distclean
!endif
!if !$(DISABLE_TARGET_test)
test: default-test
!endif
!if !$(DISABLE_TARGET_shell)
shell: default-shell
!endif
!endif # DISABLE_STANDARD_TARGETS

Changes to win/tcl.dsp.

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
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







-
+








-
+











-
+








-
+











-
+








-
+











-
+








-
+








# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir "Release"
# PROP BASE Intermediate_Dir "Release\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=none MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
# PROP BASE Target_File "Release\tclsh90.exe"
# PROP BASE Target_File "Release\tclsh85.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir "Release"
# PROP Intermediate_Dir "Release\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
# PROP Target_File "Release\tclsh90t.exe"
# PROP Target_File "Release\tclsh85t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ELSEIF  "$(CFG)" == "tcl - Win32 Debug"

# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 1
# PROP BASE Output_Dir "Debug"
# PROP BASE Intermediate_Dir "Debug\tcl_Dynamic"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
# PROP BASE Target_File "Debug\tclsh90g.exe"
# PROP BASE Target_File "Debug\tclsh85g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 1
# PROP Output_Dir "Debug"
# PROP Intermediate_Dir "Debug\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
# PROP Target_File "Debug\tclsh90tg.exe"
# PROP Target_File "Debug\tclsh85tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ELSEIF  "$(CFG)" == "tcl - Win32 Debug Static"

# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 1
# PROP BASE Output_Dir "Debug"
# PROP BASE Intermediate_Dir "Debug\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
# PROP BASE Target_File "Debug\tclsh90sg.exe"
# PROP BASE Target_File "Debug\tclsh85sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 1
# PROP Output_Dir "Debug"
# PROP Intermediate_Dir "Debug\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=symbols,static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
# PROP Target_File "Debug\tclsh90sg.exe"
# PROP Target_File "Debug\tclsh85sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ELSEIF  "$(CFG)" == "tcl - Win32 Release Static"

# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir "Release"
# PROP BASE Intermediate_Dir "Release\tcl_Static"
# PROP BASE Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP BASE Rebuild_Opt "-a"
# PROP BASE Target_File "Release\tclsh90s.exe"
# PROP BASE Target_File "Release\tclsh85s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir "Release"
# PROP Intermediate_Dir "Release\tcl_Static"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=static MSVCDIR=IDE"
# PROP Rebuild_Opt "-a"
# PROP Target_File "Release\tclsh90s.exe"
# PROP Target_File "Release\tclsh85s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ENDIF

# Begin Target

143
144
145
146
147
148
149








150
151
152
153
154
155
156
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164







+
+
+
+
+
+
+
+







SOURCE=..\compat\dirent2.h
# End Source File
# Begin Source File

SOURCE=..\compat\dlfcn.h
# End Source File
# Begin Source File

SOURCE=..\compat\fixstrtod.c
# End Source File
# Begin Source File

SOURCE=..\compat\float.h
# End Source File
# Begin Source File

SOURCE=..\compat\gettod.c
# End Source File
# Begin Source File

SOURCE=..\compat\limits.h
# End Source File
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
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







+
+
+
+












+
+
+
+







SOURCE=..\compat\strncasecmp.c
# End Source File
# Begin Source File

SOURCE=..\compat\strstr.c
# End Source File
# Begin Source File

SOURCE=..\compat\strtod.c
# End Source File
# Begin Source File

SOURCE=..\compat\strtol.c
# End Source File
# Begin Source File

SOURCE=..\compat\strtoul.c
# End Source File
# Begin Source File

SOURCE=..\compat\tclErrno.h
# End Source File
# Begin Source File

SOURCE=..\compat\unistd.h
# End Source File
# Begin Source File

SOURCE=..\compat\waitpid.c
# End Source File
# End Group
# Begin Group "doc"

# PROP Default_Filter ""
344
345
346
347
348
349
350
351

352
353
354
355
356
357
358
360
361
362
363
364
365
366

367
368
369
370
371
372
373
374







-
+







# End Source File
# Begin Source File

SOURCE=..\doc\CrtObjCmd.3
# End Source File
# Begin Source File

SOURCE=..\doc\CrtAlias.3
SOURCE=..\doc\CrtSlave.3
# End Source File
# Begin Source File

SOURCE=..\doc\CrtTimerHdlr.3
# End Source File
# Begin Source File

1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1264
1265
1266
1267
1268
1269
1270




1271
1272
1273
1274
1275
1276
1277







-
-
-
-







# End Source File
# Begin Source File

SOURCE=..\generic\tclProc.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclProcess.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclRegexp.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclRegexp.h
# End Source File
# Begin Source File
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1294
1295
1296
1297
1298
1299
1300








1301
1302
1303
1304
1305
1306
1307







-
-
-
-
-
-
-
-








SOURCE=..\generic\tclStubInit.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclStubLib.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclOOStubLib.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclTomMathStubLib.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclTest.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclTestObj.c
1408
1409
1410
1411
1412
1413
1414
1415





1416
1417
1418
1419
1420
1421
1422
1412
1413
1414
1415
1416
1417
1418

1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430







-
+
+
+
+
+







# End Source File
# Begin Source File

SOURCE=.\configure
# End Source File
# Begin Source File

SOURCE=.\configure.ac
SOURCE=.\configure.in
# End Source File
# Begin Source File

SOURCE=.\makefile.bc
# End Source File
# Begin Source File

SOURCE=.\Makefile.in
# End Source File
# Begin Source File

1437
1438
1439
1440
1441
1442
1443




1444
1445
1446
1447
1448
1449
1450
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462







+
+
+
+







# Begin Source File

SOURCE=.\rmd.bat
# End Source File
# Begin Source File

SOURCE=.\rules.vc
# End Source File
# Begin Source File

SOURCE=.\stub16.c
# End Source File
# Begin Source File

SOURCE=.\tcl.hpj.in
# End Source File
# Begin Source File

1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1522
1523
1524
1525
1526
1527
1528




1529
1530
1531
1532
1533
1534
1535







-
-
-
-








SOURCE=.\tclWinLoad.c
# End Source File
# Begin Source File

SOURCE=.\tclWinNotify.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPanic.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPipe.c
# End Source File
# Begin Source File

SOURCE=.\tclWinPort.h

Changes to win/tcl.hpj.in.

1
2
3
4
5
6
7
8

9
10

11
12
13
14
15
16
17
1
2
3
4
5
6
7

8
9

10
11
12
13
14
15
16
17







-
+

-
+







; This file is maintained by HCW. Do not modify this file directly.

[OPTIONS]
HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
CNT=tcl90.cnt
CNT=tcl85.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
HLP=tcl90.hlp
HLP=tcl85.hlp

[FILES]
tcl.rtf

[WINDOWS]
main="Tcl/Tk Reference Manual",,0

Changes to win/tcl.m4.

24
25
26
27
28
29
30
31

32
33

34
35
36
37
38
39
40
24
25
26
27
28
29
30

31
32

33
34
35
36
37
38
39
40







-
+

-
+







    # the alternative search directory is invoked by --with-tcl
    #

    if test x"${no_tcl}" = x ; then
	# we reset no_tcl in case something fails here
	no_tcl=true
	AC_ARG_WITH(tcl,
	    AC_HELP_STRING([--with-tcl],
	    AS_HELP_STRING([--with-tcl],
		[directory containing tcl configuration (tclConfig.sh)]),
	    with_tclconfig="${withval}")
	    [with_tclconfig="${withval}"])
	AC_MSG_CHECKING([for Tcl configuration])
	AC_CACHE_VAL(ac_cv_c_tclconfig,[

	    # First check to see if --with-tcl was specified.
	    if test x"${with_tclconfig}" != x ; then
		case "${with_tclconfig}" in
		    */tclConfig.sh )
142
143
144
145
146
147
148
149

150
151

152
153
154
155
156
157
158
142
143
144
145
146
147
148

149
150

151
152
153
154
155
156
157
158







-
+

-
+







    # the alternative search directory is invoked by --with-tk
    #

    if test x"${no_tk}" = x ; then
	# we reset no_tk in case something fails here
	no_tk=true
	AC_ARG_WITH(tk,
	    AC_HELP_STRING([--with-tk],
	    AS_HELP_STRING([--with-tk],
		[directory containing tk configuration (tkConfig.sh)]),
	    with_tkconfig="${withval}")
	    [with_tkconfig="${withval}"])
	AC_MSG_CHECKING([for Tk configuration])
	AC_CACHE_VAL(ac_cv_c_tkconfig,[

	    # First check to see if --with-tkconfig was specified.
	    if test x"${with_tkconfig}" != x ; then
		case "${with_tkconfig}" in
		    */tkConfig.sh )
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
247
248
249
250
251
252
253

254
255
256
257
258
259
260







-







#
# Results:
#
#	Substitutes the following vars:
#		TCL_BIN_DIR
#		TCL_SRC_DIR
#		TCL_LIB_FILE
#		TCL_ZIP_FILE
#
#------------------------------------------------------------------------

AC_DEFUN([SC_LOAD_TCLCONFIG], [
    AC_MSG_CHECKING([for existence of ${TCL_BIN_DIR}/tclConfig.sh])

    if test -f "${TCL_BIN_DIR}/tclConfig.sh" ; then
276
277
278
279
280
281
282








283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
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







+
+
+
+
+
+
+
+








-








    if test -f $TCL_BIN_DIR/Makefile ; then
        TCL_LIB_SPEC=${TCL_BUILD_LIB_SPEC}
        TCL_STUB_LIB_SPEC=${TCL_BUILD_STUB_LIB_SPEC}
        TCL_STUB_LIB_PATH=${TCL_BUILD_STUB_LIB_PATH}
    fi

    #
    # eval is required to do the TCL_DBGX substitution
    #

    eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
    eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
    eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""

    eval "TCL_STUB_LIB_FILE=\"${TCL_STUB_LIB_FILE}\""
    eval "TCL_STUB_LIB_FLAG=\"${TCL_STUB_LIB_FLAG}\""
    eval "TCL_STUB_LIB_SPEC=\"${TCL_STUB_LIB_SPEC}\""

    AC_SUBST(TCL_VERSION)
    AC_SUBST(TCL_BIN_DIR)
    AC_SUBST(TCL_SRC_DIR)

    AC_SUBST(TCL_ZIP_FILE)
    AC_SUBST(TCL_LIB_FILE)
    AC_SUBST(TCL_LIB_FLAG)
    AC_SUBST(TCL_LIB_SPEC)

    AC_SUBST(TCL_STUB_LIB_FILE)
    AC_SUBST(TCL_STUB_LIB_FLAG)
    AC_SUBST(TCL_STUB_LIB_SPEC)
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
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







-
-
-
-
-
-
-
-








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+







#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_SHARED], [
    AC_MSG_CHECKING([how to build libraries])
    AC_ARG_ENABLE(shared,
	[  --enable-shared         build and link with shared libraries (default: on)],
	[tcl_ok=$enableval], [tcl_ok=yes])

    if test "${enable_shared+set}" = set; then
	enableval="$enable_shared"
	tcl_ok=$enableval
    else
	tcl_ok=yes
    fi

    if test "$tcl_ok" = "yes" ; then
	AC_MSG_RESULT([shared])
	SHARED_BUILD=1
    else
	AC_MSG_RESULT([static])
	SHARED_BUILD=0
	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
    fi
])

#------------------------------------------------------------------------
# SC_ENABLE_THREADS --
#
#	Specify if thread support should be enabled
#
# Arguments:
#	none
#
# Results:
#
#	Adds the following arguments to configure:
#		--enable-threads=yes|no
#
#	Defines the following vars:
#		TCL_THREADS
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_THREADS], [
    AC_MSG_CHECKING(for building with threads)
    AC_ARG_ENABLE(threads, [  --enable-threads        build with threads (default: off)],
	[tcl_ok=$enableval], [tcl_ok=no])

    if test "$tcl_ok" = "yes"; then
	AC_MSG_RESULT(yes)
	TCL_THREADS=1
	AC_DEFINE(TCL_THREADS)
	# USE_THREAD_ALLOC tells us to try the special thread-based
	# allocator that significantly reduces lock contention
	AC_DEFINE(USE_THREAD_ALLOC)
    else
	TCL_THREADS=0
	AC_MSG_RESULT([no (default)])
    fi
    AC_SUBST(SHARED_BUILD)
    AC_SUBST(TCL_THREADS)
])

#------------------------------------------------------------------------
# SC_ENABLE_SYMBOLS --
#
#	Specify if debugging symbols should be used.
#	Memory (TCL_MEM_DEBUG) and compile (TCL_COMPILE_DEBUG) debugging
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
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







+










+







+







#		--enable-symbols
#
#	Defines the following vars:
#		CFLAGS_DEFAULT	Sets to $(CFLAGS_DEBUG) if true
#				Sets to $(CFLAGS_OPTIMIZE) if false
#		LDFLAGS_DEFAULT	Sets to $(LDFLAGS_DEBUG) if true
#				Sets to $(LDFLAGS_OPTIMIZE) if false
#		DBGX		Debug library extension
#
#------------------------------------------------------------------------

AC_DEFUN([SC_ENABLE_SYMBOLS], [
    AC_MSG_CHECKING([for build with symbols])
    AC_ARG_ENABLE(symbols, [  --enable-symbols        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.
    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)

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
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







+
+
+
+
+
+
+
+
+
+
+






-











-
+



-
-
-
+
+
+





-
+






-
+







AC_DEFUN([SC_CONFIG_CFLAGS], [

    # Step 0: Enable 64 bit support?

    AC_MSG_CHECKING([if 64bit support is requested])
    AC_ARG_ENABLE(64bit,[  --enable-64bit          enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no])
    AC_MSG_RESULT($do64bit)

    # Cross-compiling options for Windows/CE builds

    AC_MSG_CHECKING([if Windows/CE build is requested])
    AC_ARG_ENABLE(wince,[  --enable-wince          enable Win/CE support (where applicable)], [doWince=$enableval], [doWince=no])
    AC_MSG_RESULT($doWince)

    AC_MSG_CHECKING([for Windows/CE celib directory])
    AC_ARG_WITH(celib,[  --with-celib=DIR        use Windows/CE support library from DIR],
	    CELIB_DIR=$withval, CELIB_DIR=NO_CELIB)
    AC_MSG_RESULT([$CELIB_DIR])

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""
	AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])

    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
    AC_CHECK_PROG(WINE, wine, wine,)

    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([
	AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
	    #ifndef _WIN32
		#error cross-compiler
	    #endif
	], [],
	ac_cv_cross=no,
	ac_cv_cross=yes)
	]], [[]])],
	[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-${CC}"
		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-${CC}"
		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
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
618
619
620
621
622

623
624
625
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
686
687
688
689
690
691
692
693
694
695
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
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







-
+



-
-
-
+
+
+




-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+



















-
+













-
+










-
-
-
+
+
+






-
+



-
-
-
-
-
-
-
-
-







    # set various compiler flags depending on whether we are using gcc or cl

    if test "${GCC}" = "yes" ; then
	extra_cflags="-pipe"
	extra_ldflags="-pipe -static-libgcc"
	AC_CACHE_CHECK(for mingw32 version of gcc,
	    ac_cv_win32,
	    AC_TRY_COMPILE([
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#ifdef _WIN32
		    #error win32
		#endif
	    ], [],
	    ac_cv_win32=no,
	    ac_cv_win32=yes)
	    ]], [[]])],
	    [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 -luserenv -lws2_32"
	LIBS="-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} \[$]@"
	MAKE_STUB_LIB="\${STLIB_LD} \[$]@"
	POST_MAKE_LIB="\${RANLIB} \[$]@"
	MAKE_EXE="\${CC} -o \[$]@"
	LIBPREFIX="lib"

	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            AC_MSG_RESULT([using static flags])
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	    EXESUFFIX="s\${DBGX}.exe"
	else
	    # dynamic
            AC_MSG_RESULT([using shared flags])

	    # ad-hoc check to see if CC supports -shared.
	    if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
		AC_MSG_ERROR([${CC} does not support the -shared option.
                You will need to upgrade to a newer version of the toolchain.])
	    fi

	    runtime=
	    # Add SHLIB_LD_LIBS to the Make rule, not here.

	    EXESUFFIX=".exe"
	    EXESUFFIX="\${DBGX}.exe"
	    LIBRARIES="\${SHARED_LIBRARIES}"
	fi
	# Link with gcc since ld does not link to default libs like
	# -luser32 and -lmsvcrt by default.
	SHLIB_LD='${CC} -shared'
	SHLIB_LD_LIBS='${LIBS}'
	MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -o \[$]@ ${extra_ldflags} \
	    -Wl,--out-implib,\$(patsubst %.dll,lib%.dll.a,\[$]@)"
	# DLLSUFFIX is separate because it is the building block for
	# users of tclConfig.sh that may build shared or static.
	DLLSUFFIX=".dll"
	LIBSUFFIX=".a"
	LIBFLAGSUFFIX=""
	DLLSUFFIX="\${DBGX}.dll"
	LIBSUFFIX="\${DBGX}.a"
	LIBFLAGSUFFIX="\${DBGX}"
	SHLIB_SUFFIX=.dll

	EXTRA_CFLAGS="${extra_cflags}"

	CFLAGS_DEBUG=-g
	CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
	CFLAGS_WARNING="-Wall -Wextra -Wshadow -Wundef -Wwrite-strings -Wpointer-arith"
	CFLAGS_WARNING="-Wall -Wdeclaration-after-statement -Wpointer-arith"
	LDFLAGS_DEBUG=
	LDFLAGS_OPTIMIZE=

	case "${CC}" in
	    *++)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wno-format"
		;;
	    *)
		CFLAGS_WARNING="${CFLAGS_WARNING} -Wc++-compat -Wdeclaration-after-statement"
		;;
	esac

	# Specify the CC output file names based on the target name
	CC_OBJNAME="-o \[$]@"
	CC_EXENAME="-o \[$]@"

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	#
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
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







-
+



-
-
-
+
+
+


-
-
-
+
+
+









-
+






-
+











-
-
-
+
+
+













-
+







		AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		;;
	    ia64)
		MACHINE="IA64"
		AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		;;
	    *)
		AC_TRY_COMPILE([
		AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		    #ifndef _WIN64
			#error 32-bit
		    #endif
		], [],
			tcl_win_64bit=yes,
			tcl_win_64bit=no
		]], [[]])],
		    [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])
		    do64bit=amd64
		    MACHINE="AMD64"
		    AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		fi
		;;
	esac
    else
	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            AC_MSG_RESULT([using static flags])
	    runtime=-MT
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s.exe"
	    EXESUFFIX="s\${DBGX}.exe"
	else
	    # dynamic
            AC_MSG_RESULT([using shared flags])
	    runtime=-MD
	    # Add SHLIB_LD_LIBS to the Make rule, not here.
	    LIBRARIES="\${SHARED_LIBRARIES}"
	    EXESUFFIX=".exe"
	    EXESUFFIX="\${DBGX}.exe"
	    case "x`echo \${VisualStudioVersion}`" in
		x1[[4-9]]*)
		    lflags="${lflags} -nodefaultlib:libucrt.lib"
		    ;;
		*)
		    ;;
	    esac
	fi
	MAKE_DLL="\${SHLIB_LD} \$(LDFLAGS) -out:\[$]@"
	# DLLSUFFIX is separate because it is the building block for
	# users of tclConfig.sh that may build shared or static.
	DLLSUFFIX=".dll"
	LIBSUFFIX=".lib"
	LIBFLAGSUFFIX=""
	DLLSUFFIX="\${DBGX}.dll"
	LIBSUFFIX="\${DBGX}.lib"
	LIBFLAGSUFFIX="\${DBGX}"

	if test "$do64bit" != "no" ; then
	    case "$do64bit" in
		amd64|x64|yes)
		    MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
		    ;;
		ia64)
		    MACHINE="IA64"
		    ;;
	    esac
	    AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
	fi

	LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
	LIBS="user32.lib advapi32.lib ws2_32.lib"

	case "x`echo \${VisualStudioVersion}`" in
		x1[[4-9]]*)
		    LIBS="$LIBS ucrt.lib"
		    ;;
		*)
		    ;;
800
801
802
803
804
805
806


























































































807


808
809
810
811
812
813
814
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+







	    CFLAGS_DEBUG="-nologo -Z7 -Od -WX ${runtime}d"
	    # -O2 - create fast code (/Og /Oi /Ot /Oy /Ob2 /Gs /GF /Gy)
	    CFLAGS_OPTIMIZE="-nologo -O2 ${runtime}"
	    lflags="${lflags} -nologo"
	    LINKBIN="link"
	fi

	if test "$doWince" != "no" ; then
	    # Set defaults for common evc4/PPC2003 setup
	    # Currently Tcl requires 300+, possibly 420+ for sockets
	    CEVERSION=420; 		# could be 211 300 301 400 420 ...
	    TARGETCPU=ARMV4;	# could be ARMV4 ARM MIPS SH3 X86 ...
	    ARCH=ARM;		# could be ARM MIPS X86EM ...
	    PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
	    if test "$doWince" != "yes"; then
		# If !yes then the user specified something
		# Reset ARCH to allow user to skip specifying it
		ARCH=
		eval `echo $doWince | awk -F "," '{ \
	if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \
	if ([$]1 < 400)	  { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
	if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \
	if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \
	if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \
		}'`
		if test "x${ARCH}" = "x" ; then
		    ARCH=$TARGETCPU;
		fi
	    fi
	    OSVERSION=WCE$CEVERSION;
	    if test "x${WCEROOT}" = "x" ; then
		WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
		if test ! -d "${WCEROOT}" ; then
		    WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
		fi
	    fi
	    if test "x${SDKROOT}" = "x" ; then
		SDKROOT="C:/Program Files/Windows CE Tools"
		if test ! -d "${SDKROOT}" ; then
		    SDKROOT="C:/Windows CE Tools"
		fi
	    fi
	    # The space-based-path will work for the Makefile, but will
	    # not work if AC_TRY_COMPILE is called.
	    WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
	    SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
	    CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
	    if test ! -d "${CELIB_DIR}/inc"; then
		AC_MSG_ERROR([Invalid celib directory "${CELIB_DIR}"])
	    fi
	    if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
		-o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
		AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]])
	    else
		CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
		if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
		    CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
		fi
		CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
	    fi
	fi

	if test "$doWince" != "no" ; then
	    CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
	    if test "${TARGETCPU}" = "X86"; then
		CC="${CEBINROOT}/cl.exe"
	    else
		CC="${CEBINROOT}/cl${ARCH}.exe"
	    fi
	    CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
	    RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
	    arch=`echo ${ARCH} | awk '{print tolower([$]0)}'`
	    defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
	    for i in $defs ; do
		AC_DEFINE_UNQUOTED($i)
	    done
#	    if test "${ARCH}" = "X86EM"; then
#		AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
#	    fi
	    AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION)
	    AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION)
	    CFLAGS_DEBUG="-nologo -Zi -Od"
	    CFLAGS_OPTIMIZE="-nologo -O2"
	    lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'`
	    lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo"
	    LINKBIN="\"${CEBINROOT}/link.exe\""
	    AC_SUBST(CELIB_DIR)
	    if test "${CEVERSION}" -lt 400 ; then
		LIBS="coredll.lib corelibc.lib winsock.lib"
	    else
		LIBS="coredll.lib corelibc.lib ws2.lib"
	    fi
	    # celib currently stuck at wce300 status
	    #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
	    LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
	    LIBS_GUI="commctrl.lib commdlg.lib"
	else
	LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	    LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
	fi

	SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
	SHLIB_LD_LIBS='${LIBS}'
	# link -lib only works when -lib is the first arg
	STLIB_LD="${LINKBIN} -lib ${lflags}"
	RC_OUT=-fo
	RC_TYPE=-r
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
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







-
+















-
+














-
-
-
-
+
+
+
+














-
+



-
+

-
-
-
+
+
+












-
+




-
+



-
-
-
+
+
+






-
-






-
+
-


-
-
-
+
+
+








	# Specify the CC output file names based on the target name
	CC_OBJNAME="-Fo\[$]@"
	CC_EXENAME="-Fe\"\$(shell \$(CYGPATH) '\[$]@')\""

	# Specify linker flags depending on the type of app being
	# built -- Console vs. Window.
	if test "${TARGETCPU}" != "X86"; then
	if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
	    LDFLAGS_CONSOLE="-link ${lflags}"
	    LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
	else
	    LDFLAGS_CONSOLE="-link -subsystem:console ${lflags}"
	    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([
	AC_RUN_IFELSE([AC_LANG_SOURCE([[
	    #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)
	]])],
	    [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([
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
#	    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)
	    ]])],
	    [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([
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
		#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)
	    ]])],
	    [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

	AC_CHECK_HEADER(stdbool.h, [AC_DEFINE(HAVE_STDBOOL_H, 1, [Do we have <stdbool.h>?])],)

	# 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([],
	    AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[]], [[
	    [
		  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)
	    ]])],
	    [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

966
967
968
969
970
971
972
973
974


975
976

977
978
979

980
981
982
983
984
985
986
1073
1074
1075
1076
1077
1078
1079


1080
1081
1082

1083
1084
1085

1086
1087
1088
1089
1090
1091
1092
1093







-
-
+
+

-
+


-
+







#		--with-tcl=...
#
#	Defines the following vars:
#		TCL_BIN_DIR	Full path to the tcl build dir.
#------------------------------------------------------------------------

AC_DEFUN([SC_WITH_TCL], [
    if test -d ../../tcl9.0$1/win;  then
	TCL_BIN_DEFAULT=../../tcl9.0$1/win
    if test -d ../../tcl8.5$1/win;  then
	TCL_BIN_DEFAULT=../../tcl8.5$1/win
    else
	TCL_BIN_DEFAULT=../../tcl9.0/win
	TCL_BIN_DEFAULT=../../tcl8.5/win
    fi

    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 9.0 binaries from DIR],
    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.5 binaries from DIR],
	    TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_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/Makefile; then
	AC_MSG_ERROR(There is no Makefile in $TCL_BIN_DIR:  perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
    else
1053
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1160
1161
1162
1163
1164
1165
1166

1167
1168
1169
1170
1171
1172
1173
1174







-
+







# Results
#	Subst's the following values:
#		BUILD_TCLSH
#------------------------------------------------------------------------

AC_DEFUN([SC_BUILD_TCLSH], [
    AC_MSG_CHECKING([for tclsh in Tcl build directory])
    BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${EXEEXT}
    BUILD_TCLSH=${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}
    AC_MSG_RESULT($BUILD_TCLSH)
    AC_SUBST(BUILD_TCLSH)
])

#--------------------------------------------------------------------
# SC_TCL_CFG_ENCODING	TIP #59
#
1081
1082
1083
1084
1085
1086
1087

1088

1089
1090
1091
1092
1093
1094
1095
1188
1189
1190
1191
1192
1193
1194
1195

1196
1197
1198
1199
1200
1201
1202
1203







+
-
+








AC_DEFUN([SC_TCL_CFG_ENCODING], [
    AC_ARG_WITH(encoding, [  --with-encoding         encoding for configuration values], with_tcencoding=${withval})

    if test x"${with_tcencoding}" != x ; then
	AC_DEFINE_UNQUOTED(TCL_CFGVAL_ENCODING,"${with_tcencoding}")
    else
	# Default encoding on windows is not "iso8859-1"
	AC_DEFINE(TCL_CFGVAL_ENCODING,"utf-8")
	AC_DEFINE(TCL_CFGVAL_ENCODING,"cp1252")
    fi
])

#--------------------------------------------------------------------
# SC_EMBED_MANIFEST
#
#	Figure out if we can embed the manifest where necessary
1103
1104
1105
1106
1107
1108
1109
1110

1111
1112
1113
1114
1115
1116
1117
1211
1212
1213
1214
1215
1216
1217

1218
1219
1220
1221
1222
1223
1224
1225







-
+







#		VC_MANIFEST_EMBED_EXE
#
#--------------------------------------------------------------------

AC_DEFUN([SC_EMBED_MANIFEST], [
    AC_MSG_CHECKING(whether to embed manifest)
    AC_ARG_ENABLE(embedded-manifest,
	AC_HELP_STRING([--enable-embedded-manifest],
	AS_HELP_STRING([--enable-embedded-manifest],
		[embed manifest if possible (default: yes)]),
	[embed_ok=$enableval], [embed_ok=yes])

    VC_MANIFEST_EMBED_DLL=
    VC_MANIFEST_EMBED_EXE=
    result=no
    if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \
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
1258
1259
1260
1261
1262
1263
1264
1265
1244
1245
1246
1247
1248
1249
1250


































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
	fi
	])
    fi
    AC_MSG_RESULT([$result])
    AC_SUBST(VC_MANIFEST_EMBED_DLL)
    AC_SUBST(VC_MANIFEST_EMBED_EXE)
])

#------------------------------------------------------------------------
# SC_CC_FOR_BUILD
#	For cross compiles, locate a C compiler that can generate native binaries.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		CC_FOR_BUILD
#		EXEEXT_FOR_BUILD
#------------------------------------------------------------------------

dnl Get a default for CC_FOR_BUILD to put into Makefile.
AC_DEFUN([AX_CC_FOR_BUILD],
[# Put a plausible default for CC_FOR_BUILD in Makefile.
if test -z "$CC_FOR_BUILD"; then
  if test "x$cross_compiling" = "xno"; then
    CC_FOR_BUILD='$(CC)'
  else
    AC_MSG_CHECKING([for gcc])
    AC_CACHE_VAL(ac_cv_path_cc, [
	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
	for dir in $search_path ; do
	    for j in `ls -r $dir/gcc 2> /dev/null` \
		    `ls -r $dir/gcc 2> /dev/null` ; do
		if test x"$ac_cv_path_cc" = x ; then
		    if test -f "$j" ; then
			ac_cv_path_cc=$j
			break
		    fi
		fi
	    done
	done
    ])
  fi
fi
AC_SUBST(CC_FOR_BUILD)
# Also set EXEEXT_FOR_BUILD.
if test "x$cross_compiling" = "xno"; then
  EXEEXT_FOR_BUILD='$(EXEEXT)'
  OBJEXT_FOR_BUILD='$(OBJEXT)'
else
  OBJEXT_FOR_BUILD='.no'
  AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
    [rm -f conftest*
     echo 'int main () { return 0; }' > conftest.c
     bfd_cv_build_exeext=
     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
     for file in conftest.*; do
       case $file in
       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
       esac
     done
     rm -f conftest*
     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
  EXEEXT_FOR_BUILD=""
  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
fi
AC_SUBST(EXEEXT_FOR_BUILD)])dnl
AC_SUBST(OBJEXT_FOR_BUILD)])dnl



#------------------------------------------------------------------------
# SC_ZIPFS_SUPPORT
#	Locate a zip encoder installed on the system path, or none.
#
# Arguments:
#	none
#
# Results:
#	Substitutes the following vars:
#		ZIP_PROG
#       ZIP_PROG_OPTIONS
#       ZIP_PROG_VFSSEARCH
#       ZIP_INSTALL_OBJS
#------------------------------------------------------------------------

AC_DEFUN([SC_ZIPFS_SUPPORT], [
    ZIP_PROG=""
    ZIP_PROG_OPTIONS=""
    ZIP_PROG_VFSSEARCH=""
    ZIP_INSTALL_OBJS=""

    AC_MSG_CHECKING([for zip])
    AC_CACHE_VAL(ac_cv_path_zip, [
    search_path=`echo ${PATH} | sed -e 's/:/ /g'`
    for dir in $search_path ; do
        for j in `ls -r $dir/zip 2> /dev/null` \
            `ls -r $dir/zip 2> /dev/null` ; do
        if test x"$ac_cv_path_zip" = x ; then
            if test -f "$j" ; then
            ac_cv_path_zip=$j
            break
            fi
        fi
        done
    done
    ])
    if test -f "$ac_cv_path_zip" ; then
        ZIP_PROG="$ac_cv_path_zip"
        AC_MSG_RESULT([$ZIP_PROG])
        ZIP_PROG_OPTIONS="-rq"
        ZIP_PROG_VFSSEARCH="*"
        AC_MSG_RESULT([Found INFO Zip in environment])
        # Use standard arguments for zip
    else
        # It is not an error if an installed version of Zip can't be located.
        # We can use the locally distributed minizip instead
        ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
        ZIP_PROG_OPTIONS="-o -r"
        ZIP_PROG_VFSSEARCH="*"
        ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
        AC_MSG_RESULT([No zip found on PATH building minizip])
    fi
    AC_SUBST(ZIP_PROG)
    AC_SUBST(ZIP_PROG_OPTIONS)
    AC_SUBST(ZIP_PROG_VFSSEARCH)
    AC_SUBST(ZIP_INSTALL_OBJS)
])

Changes to win/tcl.rc.

1
2
3
4
5
6
7
8
9






10
11
12
13
14
15
16

17
18
19
20
21
22
23
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









+
+
+
+
+
+






-
+







// Version Resource Script
//

#include <winver.h>
#include <tcl.h>

//
// build-up the name suffix that defines the type of build this is.
//
#if TCL_THREADS
#define SUFFIX_THREADS	    "t"
#else
#define SUFFIX_THREADS	    ""
#endif

#if DEBUG && !UNCHECKED
#define SUFFIX_DEBUG	    "g"
#else
#define SUFFIX_DEBUG	    ""
#endif

#define SUFFIX		    SUFFIX_DEBUG
#define SUFFIX		    SUFFIX_THREADS SUFFIX_DEBUG


LANGUAGE 0x9, 0x1	/* LANG_ENGLISH, SUBLANG_DEFAULT */

VS_VERSION_INFO VERSIONINFO
 FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
 PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL

Changes to win/tclAppInit.c.

1
2
3
4
5
6


7
8
9
10
11


12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

29
30
31
32
33
34
35
36




37
38

39
40
41
42

43
44
45
46
47
48
49
50
51
52
53

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

78
79
80
81

82
83
84
85
86
87
88
89
90


91

92
93
94
95




96
97
98
99
100




101

102
103
104
105



106
107



108


109
110
111
112


113
114
115
116


117

118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

137
138
139
140
141
142
143
144
145

146
147

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

174
175
176
177
178
179
180
181
182
183









184
185


















186
187

188
189
190
191
192
193
194

195
196
197
198
199
200

201
202
203
204
205
206
207
208
209
210

211
212
213
214
215
216
217
218
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




-
-
+
+
-

-
-
-
+
+






-
-

-
-

-
-


-
+
-
-
-
-
-
-
-
-
+
+
+
+

-
+

-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
+



-
+




-


-
-
+
+

+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
+

+


-
-
+
+
+


+
+
+
-
+
+

-

-
+
+


-
-
+
+

+













-
-
-



+








-
+

-
+















-
-
-
-
-
-
-
-
-
-
-
+


-
-





-
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+






-
+
-




-
+









-
+
-







/*
 * tclAppInit.c --
 *
 *	Provides a default version of the main program and Tcl_AppInit
 *	procedure for tclsh and other Tcl-based applications (without Tk).
 *	Note that this program must be built in Win32 console mode to work
 *	function for Tcl applications (without Tk). Note that this program
 *	must be built in Win32 console mode to work properly.
 *	properly.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
 * 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 "tcl.h"
#define WIN32_LEAN_AND_MEAN
#define STRICT			/* See MSDN Article Q83456 */
#include <windows.h>
#undef STRICT
#undef WIN32_LEAN_AND_MEAN
#include <locale.h>
#include <stdlib.h>
#include <tchar.h>

#ifdef TCL_TEST
extern Tcl_PackageInitProc Tcltest_Init;
extern Tcl_PackageInitProc	Procbodytest_Init;
extern Tcl_PackageInitProc Tcltest_SafeInit;
#endif /* TCL_TEST */

#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
extern Tcl_PackageInitProc Registry_Init;
extern Tcl_PackageInitProc Dde_Init;
extern Tcl_PackageInitProc Dde_SafeInit;
#endif
extern Tcl_PackageInitProc	Procbodytest_SafeInit;
extern Tcl_PackageInitProc	Tcltest_Init;
extern Tcl_PackageInitProc	TclObjTest_Init;
#endif /* TCL_TEST */

#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
#if defined(__GNUC__)
int _CRT_glob = 0;
#endif /* __GNUC__ || TCL_BROKEN_MAINARGS */
#ifdef TCL_BROKEN_MAINARGS
static void setargv(int *argcPtr, TCHAR ***argvPtr);
static void		setargv(int *argcPtr, char ***argvPtr);
#endif /* TCL_BROKEN_MAINARGS */

/*
 * The following #if block allows you to change the AppInit function by using
 * a #define of TCL_LOCAL_APPINIT instead of rewriting this entire file. The
 * #if checks for that #define and uses Tcl_AppInit if it does not exist.
 */

#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
#endif /* __GNUC__ */
#ifndef MODULE_SCOPE
#   define MODULE_SCOPE extern
#endif
MODULE_SCOPE int TCL_LOCAL_APPINIT(Tcl_Interp *);

/*
 * The following #if block allows you to change how Tcl finds the startup
 * script, prime the library or encoding paths, fiddle with the argv, etc.,
 * without needing to rewrite Tcl_Main()
 */

#ifdef TCL_LOCAL_MAIN_HOOK
MODULE_SCOPE int TCL_LOCAL_MAIN_HOOK(int *argc, TCHAR ***argv);
#endif

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.
 *
 * Results:
 *	None: Tcl_Main never returns here, so this procedure never returns
 *	None: Tcl_Main never returns here, so this function never returns
 *	either.
 *
 * Side effects:
 *	Just about anything, since from here we call arbitrary Tcl code.
 *	Whatever the application does.
 *
 *----------------------------------------------------------------------
 */

#ifdef TCL_BROKEN_MAINARGS
int
main(
    int argc,			/* Number of command-line arguments. */
    char **argv1)
    int argc,
    char *argv[])
{
    /*
    TCHAR **argv;
    TCHAR *p;
#else
int
     * The following #if block allows you to change the AppInit function by
     * using a #define of TCL_LOCAL_APPINIT instead of rewriting this entire
     * file. The #if checks for that #define and uses Tcl_AppInit if it
     * doesn't exist.
_tmain(
    int argc,			/* Number of command-line arguments. */
    TCHAR *argv[])		/* Values of command-line arguments. */
{
    TCHAR *p;
     */

#ifndef TCL_LOCAL_APPINIT
#define TCL_LOCAL_APPINIT Tcl_AppInit
#endif
    extern int TCL_LOCAL_APPINIT (Tcl_Interp *interp);

    /*
     * Set up the default locale to be standard "C" locale so parsing is
     * performed correctly.
     * The following #if block allows you to change how Tcl finds the startup
     * script, prime the library or encoding paths, fiddle with the argv,
     * etc., without needing to rewrite Tcl_Main()
     */

#ifdef TCL_LOCAL_MAIN_HOOK
    extern int TCL_LOCAL_MAIN_HOOK (int *argc, char ***argv);
#endif
    setlocale(LC_ALL, "C");

    char *p;

#ifdef TCL_BROKEN_MAINARGS
    /*
     * Get our args from the c-runtime. Ignore command line.
     * Set up the default locale to be standard "C" locale so parsing is
     * performed correctly.
     */

    (void)argv1;
    setargv(&argc, &argv);
#if defined(__GNUC__)
    setargv( &argc, &argv );
#endif
    setlocale(LC_ALL, "C");

    /*
     * Forward slashes substituted for backslashes.
     */

    for (p = argv[0]; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }

#ifdef TCL_LOCAL_MAIN_HOOK
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
#elif !defined(_WIN32) || defined(UNICODE)
    /* This doesn't work on Windows without UNICODE */
    TclZipfs_AppHook(&argc, &argv);
#endif

    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);

    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization. Most
 *	This function performs application-specific initialization. Most
 *	applications, especially those that incorporate additional packages,
 *	will have their own version of this procedure.
 *	will have their own version of this function.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error message in
 *	the interp's result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AppInit(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if ((Tcl_Init)(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES) && TCL_USE_STATIC_PACKAGES
    if (Registry_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);

    if (Dde_Init(interp) == TCL_ERROR) {
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
#endif

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, NULL);
    if (TclObjTest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
	    Procbodytest_SafeInit);
#endif /* TCL_TEST */

#if defined(STATIC_BUILD) && TCL_USE_STATIC_PACKAGES
    {
	extern Tcl_PackageInitProc Registry_Init;
	extern Tcl_PackageInitProc Dde_Init;
	extern Tcl_PackageInitProc Dde_SafeInit;

	if (Registry_Init(interp) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	Tcl_StaticPackage(interp, "Registry", Registry_Init, NULL);

	if (Dde_Init(interp) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	Tcl_StaticPackage(interp, "Dde", Dde_Init, Dde_SafeInit);
   }
#endif

    /*
     * Call the init procedures for included packages. Each call should look
     * Call the init functions for included packages. Each call should look
     * like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module. (Dynamically-loadable packages
     * where "Mod" is the name of the module.
     * should have the same entry-point name.)
     */

    /*
     * Call Tcl_CreateCommand for application-specific commands, if they
     * weren't already created by the init procedures called above.
     * weren't already created by the init functions called above.
     */

    /*
     * Specify a user-specific startup file to invoke if the application is
     * run interactively. Typically the startup file is "~/.apprc" where "app"
     * is the name of the application. If this line is deleted then no
     * user-specific startup file will be run under any conditions.
     */

    (Tcl_ObjSetVar2)(interp, Tcl_NewStringObj("tcl_rcFileName", -1), NULL,
    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
	    Tcl_NewStringObj("~/tclshrc.tcl", -1), TCL_GLOBAL_ONLY);
    return TCL_OK;
}

/*
 *-------------------------------------------------------------------------
 *
 * setargv --
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
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







-
+



-
+

-
-
+
+


-
+


















-
+
-
-
-
-
+
-
-
-
+
+







 *
 * Side effects:
 *	Memory allocated.
 *
 *--------------------------------------------------------------------------
 */

#ifdef TCL_BROKEN_MAINARGS
#if defined(__GNUC__)
static void
setargv(
    int *argcPtr,		/* Filled with number of argument strings. */
    TCHAR ***argvPtr)		/* Filled with argument strings (malloc'd). */
    char ***argvPtr)		/* Filled with argument strings (malloc'd). */
{
    TCHAR *cmdLine, *p, *arg, *argSpace;
    TCHAR **argv;
    char *cmdLine, *p, *arg, *argSpace;
    char **argv;
    int argc, size, inquote, copy, slashes;

    cmdLine = GetCommandLine();
    cmdLine = GetCommandLine();	/* INTL: BUG */

    /*
     * Precompute an overly pessimistic guess at the number of arguments in
     * the command line by counting non-space spans.
     */

    size = 2;
    for (p = cmdLine; *p != '\0'; p++) {
	if ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
	    size++;
	    while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
		p++;
	    }
	    if (*p == '\0') {
		break;
	    }
	}
    }

    argSpace = (char *) ckalloc(
    /* Make sure we don't call Tcl_Alloc through the (not yet initialized) stub table */
#   undef Tcl_Alloc

    argSpace = (TCHAR *)Tcl_Alloc(size * sizeof(char *)
	    (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
	    + (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
    argv = (TCHAR **) argSpace;
    argSpace += size * (sizeof(char *)/sizeof(TCHAR));
    argv = (char **) argSpace;
    argSpace += size * sizeof(char *);
    size--;

    p = cmdLine;
    for (argc = 0; argc < size; argc++) {
	argv[argc] = arg = argSpace;
	while ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
	    p++;
329
330
331
332
333
334
335
336

337
338
339
340
341
342
343
344
303
304
305
306
307
308
309

310
311
312
313
314
315
316
317
318







-
+








	argSpace = arg + 1;
    }
    argv[argc] = NULL;

    *argcPtr = argc;
    *argvPtr = argv;
}
#endif /* TCL_BROKEN_MAINARGS */
#endif /* __GNUC__ */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclConfig.sh.in.

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
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







+
+
+
+















-
-
-







TCL_PATCH_LEVEL='@TCL_PATCH_LEVEL@'

# C compiler to use for compilation.
TCL_CC='@CC@'

# -D flags for use with the C compiler.
TCL_DEFS='@DEFS@'

# If TCL was built with debugging symbols, generated libraries contain
# this string at the end of the library name (before the extension).
TCL_DBGX=@TCL_DBGX@

# Default flags used in an optimized and debuggable build, respectively.
TCL_CFLAGS_DEBUG='@CFLAGS_DEBUG@'
TCL_CFLAGS_OPTIMIZE='@CFLAGS_OPTIMIZE@'

# Default linker flags used in an optimized and debuggable build, respectively.
TCL_LDFLAGS_DEBUG='@LDFLAGS_DEBUG@'
TCL_LDFLAGS_OPTIMIZE='@LDFLAGS_OPTIMIZE@'

# Flag, 1: we built a shared lib, 0 we didn't
TCL_SHARED_BUILD=@TCL_SHARED_BUILD@

# The name of the Tcl library (may be either a .a file or a shared library):
TCL_LIB_FILE='@TCL_LIB_FILE@'

# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
TCL_ZIP_FILE='@TCL_ZIP_FILE@'

# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@

# String that can be evaluated to generate the part of the export file
# name that comes after the "libxxx" (includes version number, if any,
# extension, and anything else needed).  May depend on the variables
# VERSION.  On most UNIX systems this is ${VERSION}.exp.
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
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







-
+














-
+



-







# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='@SHLIB_LD@'

# Base command to use for combining object files into a static library:
TCL_STLIB_LD='@STLIB_LD@'

# Either '$LIBS' (if dependent libraries should be included when linking
# shared libraries) or an empty string.  See Tcl's configure.ac for more
# shared libraries) or an empty string.  See Tcl's configure.in for more
# explanation.
TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'

# Suffix to use for the name of a shared library.
TCL_SHLIB_SUFFIX='@SHLIB_SUFFIX@'

# Library file(s) to include in tclsh and other base applications
# in order to provide facilities needed by DLOBJ above.
TCL_DL_LIBS='@DL_LIBS@'

# Flags to pass to the compiler when linking object files into
# an executable tclsh or tcltest binary.
TCL_LD_FLAGS='@LDFLAGS@'

# Flags to pass to cc/ld, such as "-R /usr/local/tcl/lib", that tell the
# Flags to pass to ld, such as "-R /usr/local/tcl/lib", that tell the
# run-time dynamic linker where to look for shared libraries such as
# libtcl.so.  Used when linking applications.  Only works if there
# is a variable "LIB_RUNTIME_DIR" defined in the Makefile.
TCL_CC_SEARCH_FLAGS='@TCL_CC_SEARCH_FLAGS@'
TCL_LD_SEARCH_FLAGS='@TCL_LD_SEARCH_FLAGS@'

# Additional object files linked with Tcl to provide compatibility
# with standard facilities from ANSI C or POSIX.
TCL_COMPAT_OBJS='@LIBOBJS@'

# Name of the ranlib program to use.
170
171
172
173
174
175
176




170
171
172
173
174
175
176
177
178
179
180







+
+
+
+
TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'

# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=@TCL_THREADS@

Changes to win/tclWin32Dll.c.

8
9
10
11
12
13
14
15
16
17
























18
19
20
21
22
23
24
25

26
27
28
29
30
31

32
33
34









































































































































35
36
37
38
39
40

41
42
43
44
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
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







-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








+





-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






+








-
-
+
+


















+
+
-
+







 * Copyright (c) 1998-2000 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"
#if defined(HAVE_INTRIN_H)
#   include <intrin.h>
#endif

#ifndef TCL_NO_STACK_CHECK
/*
 * The following functions implement stack depth checking
 */
typedef struct ThreadSpecificData {
    int *stackBound;            /* The current stack boundary */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
#endif /* TCL_NO_STACK_CHECK */

/*
 * The following data structures are used when loading the thunking library
 * for execing child processes under Win32s.
 */

typedef DWORD (WINAPI UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
	LPVOID *lpTranslationList);

typedef BOOL (WINAPI UTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
	LPCSTR InitName, LPCSTR ProcName, UT32PROC **ThirtyTwoBitThunk,
	FARPROC UT32Callback, LPVOID Buff);

typedef VOID (WINAPI UTUNREGISTER)(HANDLE hModule);

/*
 * The following variables keep track of information about this DLL on a
 * per-instance basis. Each time this DLL is loaded, it gets its own new data
 * segment with its own copy of all static and global information.
 */

static HINSTANCE hInstance;	/* HINSTANCE of this DLL. */
static int platformId;		/* Running under NT, or 95/98? */

/*
 * VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it
 */

#if defined(_MSC_VER) && (_MSC_VER <= 1100) && defined (_M_IX86)
#if defined(_MSC_VER) && (_MSC_VER <= 1100)
#define cpuid	__asm __emit 0fh __asm __emit 0a2h
#endif

/*
 * The following function tables are used to dispatch to either the
 * wide-character or multi-byte versions of the operating system calls,
 * depending on whether the Unicode calls are available.
 */

static TclWinProcs asciiProcs = {
    0,

    (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBA,
    (TCHAR *(WINAPI *)(TCHAR *)) CharLowerA,
    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileA,
    (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryA,
    (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
	    DWORD, DWORD, HANDLE)) CreateFileA,
    (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
	    LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
	    LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
    (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileA,
    (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileA,
    (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileA,
    (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameA,
    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryA,
    (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
    (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
	    TCHAR **)) GetFullPathNameA,
    (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameA,
    (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
    (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
	    WCHAR *)) GetTempFileNameA,
    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathA,
    (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
	    WCHAR *, DWORD)) GetVolumeInformationA,
    (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExA,
    (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyA,
    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileA,
    (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryA,
    (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
	    WCHAR *, TCHAR **)) SearchPathA,
    (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryA,
    (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesA,

    /*
     * The three NULL function pointers will only be set when
     * Tcl_FindExecutable is called. If you don't ever call that function, the
     * application will crash whenever WinTcl tries to call functions through
     * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is
     * mandatory in recent Tcl releases.
     */

    NULL,
    NULL,
    /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _utime, */
    NULL,
    NULL,
    /* getLongPathNameProc */
    NULL,
    /* Security SDK - not available on 95,98,ME */
    NULL, NULL, NULL, NULL, NULL, NULL,
    /* ReadConsole and WriteConsole */
    (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleA,
    (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleA,
    (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameA
};

static TclWinProcs unicodeProcs = {
    1,

    (BOOL (WINAPI *)(CONST TCHAR *, LPDCB)) BuildCommDCBW,
    (TCHAR *(WINAPI *)(TCHAR *)) CharLowerW,
    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *, BOOL)) CopyFileW,
    (BOOL (WINAPI *)(CONST TCHAR *, LPSECURITY_ATTRIBUTES)) CreateDirectoryW,
    (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *,
	    DWORD, DWORD, HANDLE)) CreateFileW,
    (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES,
	    LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *,
	    LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
    (BOOL (WINAPI *)(CONST TCHAR *)) DeleteFileW,
    (HANDLE (WINAPI *)(CONST TCHAR *, WIN32_FIND_DATAT *)) FindFirstFileW,
    (BOOL (WINAPI *)(HANDLE, WIN32_FIND_DATAT *)) FindNextFileW,
    (BOOL (WINAPI *)(WCHAR *, LPDWORD)) GetComputerNameW,
    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetCurrentDirectoryW,
    (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
    (DWORD (WINAPI *)(CONST TCHAR *, DWORD nBufferLength, WCHAR *,
	    TCHAR **)) GetFullPathNameW,
    (DWORD (WINAPI *)(HMODULE, WCHAR *, int)) GetModuleFileNameW,
    (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
    (UINT (WINAPI *)(CONST TCHAR *, CONST TCHAR *, UINT uUnique,
	    WCHAR *)) GetTempFileNameW,
    (DWORD (WINAPI *)(DWORD, WCHAR *)) GetTempPathW,
    (BOOL (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD, LPDWORD, LPDWORD, LPDWORD,
	    WCHAR *, DWORD)) GetVolumeInformationW,
    (HINSTANCE (WINAPI *)(CONST TCHAR *, HANDLE, DWORD)) LoadLibraryExW,
    (TCHAR (WINAPI *)(WCHAR *, CONST TCHAR *)) lstrcpyW,
    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR *)) MoveFileW,
    (BOOL (WINAPI *)(CONST TCHAR *)) RemoveDirectoryW,
    (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD,
	    WCHAR *, TCHAR **)) SearchPathW,
    (BOOL (WINAPI *)(CONST TCHAR *)) SetCurrentDirectoryW,
    (BOOL (WINAPI *)(CONST TCHAR *, DWORD)) SetFileAttributesW,

    /*
     * The three NULL function pointers will only be set when
     * Tcl_FindExecutable is called. If you don't ever call that function, the
     * application will crash whenever WinTcl tries to call functions through
     * these null pointers. That is not a bug in Tcl - Tcl_FindExecutable is
     * mandatory in recent Tcl releases.
     */

    NULL,
    NULL,
    /* deleted (int (__cdecl*)(CONST TCHAR *, struct _utimbuf *)) _wutime, */
    NULL,
    NULL,
    /* getLongPathNameProc */
    NULL,
    /* Security SDK - will be filled in on NT,XP,2000,2003 */
    NULL, NULL, NULL, NULL, NULL, NULL,
    /* ReadConsole and WriteConsole */
    (BOOL (WINAPI *)(HANDLE, LPVOID, DWORD, LPDWORD, LPVOID)) ReadConsoleW,
    (BOOL (WINAPI *)(HANDLE, const VOID*, DWORD, LPDWORD, LPVOID)) WriteConsoleW,
    (BOOL (WINAPI *)(LPTSTR, LPDWORD)) GetUserNameW
};

TclWinProcs *tclWinProcs;
static Tcl_Encoding tclWinTCharEncoding;

#ifdef HAVE_NO_SEH
/*
 * Need to add noinline flag to DllMain declaration so that gcc -O3 does not
 * inline asm code into DllEntryPoint and cause a compile time error because
 * of redefined local labels.
 */

BOOL APIENTRY		DllMain(HINSTANCE hInst, DWORD reason,
			    LPVOID reserved) __attribute__ ((noinline));
#else
/*
 * The following declaration is for the VC++ DLL entry point.
 */

BOOL APIENTRY		DllMain(HINSTANCE hInst, DWORD reason,
			    LPVOID reserved);
#endif /* HAVE_NO_SEH */

/*
 * The following structure and linked list is to allow us to map between
 * volume mount points and drive letters on the fly (no Win API exists for
 * this).
 */

typedef struct MountPointMap {
    WCHAR *volumeName;		/* Native wide string volume name. */
    WCHAR driveLetter;		/* Drive letter corresponding to the volume
    CONST WCHAR *volumeName;	/* Native wide string volume name. */
    char driveLetter;		/* Drive letter corresponding to the volume
				 * name. */
    struct MountPointMap *nextPtr;
				/* Pointer to next structure in list, or
				 * NULL. */
} MountPointMap;

/*
 * This is the head of the linked list, which is protected by the mutex which
 * follows, for thread-enabled builds.
 */

MountPointMap *driveLetterLookup = NULL;
TCL_DECLARE_MUTEX(mountPointMap)

/*
 * We will need this below.
 */

extern Tcl_FSDupInternalRepProc TclNativeDupInternalRep;

#ifdef _WIN32
#ifdef __WIN32__
#ifndef STATIC_BUILD

/*
 *----------------------------------------------------------------------
 *
 * DllEntryPoint --
 *
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
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







-
+

















-
+
+
+
+








-
+

+
+
+
+






+

+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+

















-
+







 *----------------------------------------------------------------------
 */

BOOL APIENTRY
DllEntryPoint(
    HINSTANCE hInst,		/* Library instance handle. */
    DWORD reason,		/* Reason this function is being called. */
    LPVOID reserved)
    LPVOID reserved)		/* Not used. */
{
    return DllMain(hInst, reason, reserved);
}

/*
 *----------------------------------------------------------------------
 *
 * DllMain --
 *
 *	This routine is called by the VC++ C run time library init code, or
 *	the DllEntryPoint routine. It is responsible for initializing various
 *	dynamically loaded libraries.
 *
 * Results:
 *	TRUE on sucess, FALSE on failure.
 *
 * Side effects:
 *	Initializes most rudimentary Windows bits.
 *	Establishes 32-to-16 bit thunk and initializes sockets library. This
 *	might call some sycronization functions, but MSDN documentation
 *	states: "Waiting on synchronization objects in DllMain can cause a
 *	deadlock."
 *
 *----------------------------------------------------------------------
 */

BOOL APIENTRY
DllMain(
    HINSTANCE hInst,		/* Library instance handle. */
    DWORD reason,		/* Reason this function is being called. */
    TCL_UNUSED(LPVOID))
    LPVOID reserved)		/* Not used. */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
    TCLEXCEPTION_REGISTRATION registration;
#endif

    switch (reason) {
    case DLL_PROCESS_ATTACH:
	DisableThreadLibraryCalls(hInst);
	TclWinInit(hInst);
	return TRUE;

    case DLL_PROCESS_DETACH:
	/*
	 * Protect the call to Tcl_Finalize. The OS could be unloading us from
	 * an exception handler and the state of the stack might be unstable.
	 */
	 * DLL_PROCESS_DETACH is unnecessary as the user should call
	 * Tcl_Finalize explicitly before unloading Tcl.
	 */
    }

#if defined(HAVE_NO_SEH) && !defined(_WIN64)
	__asm__ __volatile__ (

	    /*
	     * Construct an TCLEXCEPTION_REGISTRATION to protect the call to
	     * Tcl_Finalize
	     */

	    "leal	%[registration], %%edx"		"\n\t"
	    "movl	%%fs:0,		%%eax"		"\n\t"
	    "movl	%%eax,		0x0(%%edx)"	"\n\t" /* link */
	    "leal	1f,		%%eax"		"\n\t"
	    "movl	%%eax,		0x4(%%edx)"	"\n\t" /* handler */
	    "movl	%%ebp,		0x8(%%edx)"	"\n\t" /* ebp */
	    "movl	%%esp,		0xc(%%edx)"	"\n\t" /* esp */
	    "movl	%[error],	0x10(%%edx)"	"\n\t" /* status */

	    /*
	     * Link the TCLEXCEPTION_REGISTRATION on the chain
	     */

	    "movl	%%edx,		%%fs:0"		"\n\t"

	    /*
	     * Call Tcl_Finalize
	     */

	    "call	_Tcl_Finalize"			"\n\t"

	    /*
	     * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION
	     * and store a TCL_OK status
	     */

	    "movl	%%fs:0,		%%edx"		"\n\t"
	    "movl	%[ok],		%%eax"		"\n\t"
	    "movl	%%eax,		0x10(%%edx)"	"\n\t"
	    "jmp	2f"				"\n"

	    /*
	     * Come here on an exception. Get the TCLEXCEPTION_REGISTRATION that
	     * we previously put on the chain.
	     */

	    "1:"					"\t"
	    "movl	%%fs:0,		%%edx"		"\n\t"
	    "movl	0x8(%%edx),	%%edx"		"\n"


	    /*
	     * Come here however we exited. Restore context from the
	     * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
	     */

	    "2:"					"\t"
	    "movl	0xc(%%edx),	%%esp"		"\n\t"
	    "movl	0x8(%%edx),	%%ebp"		"\n\t"
	    "movl	0x0(%%edx),	%%eax"		"\n\t"
	    "movl	%%eax,		%%fs:0"		"\n\t"

	    :
	    /* No outputs */
	    :
	    [registration]	"m"	(registration),
	    [ok]		"i"	(TCL_OK),
	    [error]		"i"	(TCL_ERROR)
	    :
	    "%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "memory"
	    );

#else
#ifndef HAVE_NO_SEH
	__try {
#endif
	    Tcl_Finalize();
#ifndef HAVE_NO_SEH
	} __except (EXCEPTION_EXECUTE_HANDLER) {
	    /* empty handler body. */
	}
#endif
#endif

	break;
    }

    return TRUE;
}
#endif /* !STATIC_BUILD */
#endif /* _WIN32 */
#endif /* __WIN32__ */

/*
 *----------------------------------------------------------------------
 *
 * TclWinGetTclInstance --
 *
 *	Retrieves the global library instance handle.
 *
 * Results:
 *	Returns the global library instance handle.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void *
HINSTANCE
TclWinGetTclInstance(void)
{
    return hInstance;
}

/*
 *----------------------------------------------------------------------
179
180
181
182
183
184
185

186
187
188
189


190
191
192
193


194




























195
196
197
198
199
200
201
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







+


-
-
+
+


-
-
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    HINSTANCE hInst)		/* Library instance handle. */
{
    OSVERSIONINFOW os;

    hInstance = hInst;
    os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
    GetVersionExW(&os);
    platformId = os.dwPlatformId;

    /*
     * We no longer support Win32s or Win9x or Windows CE, so just in case
     * someone manages to get a runtime there, make sure they know that.
     * We no longer support Win32s, so just in case someone manages to get a
     * runtime there, make sure they know that.
     */

    if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) {
	Tcl_Panic("Windows NT is the only supported platform");
    if (platformId == VER_PLATFORM_WIN32s) {
	Tcl_Panic("Win32s is not a supported platform");
    }

    tclWinProcs = &asciiProcs;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinGetPlatformId --
 *
 *	Determines whether running under NT, 95, or Win32s, to allow runtime
 *	conditional code.
 *
 * Results:
 *	The return value is one of:
 *	    VER_PLATFORM_WIN32s		Win32s on Windows 3.1. (not supported)
 *	    VER_PLATFORM_WIN32_WINDOWS	Win32 on Windows 95, 98, ME.
 *	    VER_PLATFORM_WIN32_NT	Win32 on Windows NT, 2000, XP
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclWinGetPlatformId(void)
{
    return platformId;
}

/*
 *-------------------------------------------------------------------------
 *
 * TclWinNoBackslash --
 *
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
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609

610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
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
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
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+











-
+


+
+
+
+









-
-
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    for (p = path; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
    return path;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetStackParams --
 *
 *	Determine the stack params for the current thread: in which
 *	direction does the stack grow, and what is the stack lower (resp.
 *	upper) bound for safe invocation of a new command? This is used to
 *	cache the values needed for an efficient computation of
 *	TclpCheckStackSpace() when the interp is known.
 *
 * Results:
 *	Returns 1 if the stack grows down, in which case a stack lower bound
 *	is stored at stackBoundPtr. If the stack grows up, 0 is returned and
 *	an upper bound is stored at stackBoundPtr. If a bound cannot be
 *	determined NULL is stored at stackBoundPtr.
 *
 *----------------------------------------------------------------------
 */

#ifndef TCL_NO_STACK_CHECK
int
TclpGetCStackParams(
    int **stackBoundPtr)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    SYSTEM_INFO si;		/* The system information, used to
				 * determine the page size */
    MEMORY_BASIC_INFORMATION mbi;
				/* The information about the memory
				 * area in which the stack resides */

    if (!tsdPtr->stackBound
	|| ((UINT_PTR)&tsdPtr < (UINT_PTR)tsdPtr->stackBound)) {

	/*
	 * Either we haven't determined the stack bound in this thread,
	 * or else we've overflowed the bound that we previously
	 * determined.  We need to find a new stack bound from
	 * Windows.
	 */

	GetSystemInfo(&si);
	if (VirtualQuery((LPCVOID) &tsdPtr, &mbi, sizeof(mbi)) == 0) {

	    /* For some reason, the system didn't let us query the
	     * stack size.  Nevertheless, we got here and haven't
	     * blown up yet.  Don't update the calculated stack bound.
	     * If there is no calculated stack bound yet, set it to
	     * the base of the current page of stack. */

	    if (!tsdPtr->stackBound) {
		tsdPtr->stackBound =
		    (int*) ((UINT_PTR)(&tsdPtr)
			    & ~ (UINT_PTR)(si.dwPageSize - 1));
	    }

	} else {

	    /* The allocation base of the stack segment has to be advanced
	     * by one page (to allow for the guard page maintained in the
	     * C runtime) and then by TCL_WIN_STACK_THRESHOLD (to allow
	     * for the amount of stack that Tcl needs).
	     */

	    tsdPtr->stackBound =
		(int*) ((UINT_PTR)(mbi.AllocationBase)
			+ (UINT_PTR)(si.dwPageSize)
			+ TCL_WIN_STACK_THRESHOLD);
	}
    }
    *stackBoundPtr = tsdPtr->stackBound;
    return 1;
}
#endif


/*
 *---------------------------------------------------------------------------
 *
 * TclWinSetInterfaces --
 *
 *	A helper proc that allows the test library to change the tclWinProcs
 *	structure to dispatch to either the wide-character or multi-byte
 *	versions of the operating system calls, depending on whether Unicode
 *	is the system encoding.
 *
 *	As well as this, we can also try to load in some additional procs
 *	which may/may not be present depending on the current Windows version
 *	(e.g. Win95 will not have the procs below).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
 * TclWinEncodingsCleanup --

void
TclWinSetInterfaces(
    int wide)			/* Non-zero to use wide interfaces, 0
				 * otherwise. */
{
    Tcl_FreeEncoding(tclWinTCharEncoding);

    if (wide) {
	tclWinProcs = &unicodeProcs;
	tclWinTCharEncoding = Tcl_GetEncoding(NULL, "unicode");
	if (tclWinProcs->getFileAttributesExProc == NULL) {
	    HMODULE handle = GetModuleHandle(TEXT("KERNEL32"));
	    tclWinProcs->getFileAttributesExProc =
		    (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
		    LPVOID)) GetProcAddress(handle,
		    "GetFileAttributesExW");
	    tclWinProcs->createHardLinkProc =
		    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
		    LPSECURITY_ATTRIBUTES)) GetProcAddress(handle,
		    "CreateHardLinkW");
	    tclWinProcs->findFirstFileExProc =
		    (HANDLE (WINAPI *)(CONST TCHAR*, UINT, LPVOID, UINT,
		    LPVOID, DWORD)) GetProcAddress(handle,
		    "FindFirstFileExW");
	    tclWinProcs->getVolumeNameForVMPProc =
		    (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
		    DWORD)) GetProcAddress(handle,
		    "GetVolumeNameForVolumeMountPointW");
	    tclWinProcs->getLongPathNameProc =
		    (DWORD (WINAPI *)(CONST TCHAR*, TCHAR*,
		    DWORD)) GetProcAddress(handle, "GetLongPathNameW");

	    handle = GetModuleHandle(TEXT("ADVAPI32"));
	    tclWinProcs->getFileSecurityProc = (BOOL (WINAPI *)(
		    LPCTSTR lpFileName,
		    SECURITY_INFORMATION RequestedInformation,
		    PSECURITY_DESCRIPTOR pSecurityDescriptor,
		    DWORD nLength, LPDWORD lpnLengthNeeded))
		    GetProcAddress(handle, "GetFileSecurityW");
	    tclWinProcs->impersonateSelfProc = (BOOL (WINAPI *) (
		    SECURITY_IMPERSONATION_LEVEL ImpersonationLevel))
		    GetProcAddress(handle, "ImpersonateSelf");
	    tclWinProcs->openThreadTokenProc = (BOOL (WINAPI *) (
		    HANDLE ThreadHandle, DWORD DesiredAccess,
		    BOOL OpenAsSelf, PHANDLE TokenHandle))
		    GetProcAddress(handle, "OpenThreadToken");
	    tclWinProcs->revertToSelfProc = (BOOL (WINAPI *) (void))
		    GetProcAddress(handle, "RevertToSelf");
	    tclWinProcs->mapGenericMaskProc = (VOID (WINAPI *) (
		    PDWORD AccessMask, PGENERIC_MAPPING GenericMapping))
		    GetProcAddress(handle, "MapGenericMask");
	    tclWinProcs->accessCheckProc = (BOOL (WINAPI *)(
		    PSECURITY_DESCRIPTOR pSecurityDescriptor,
		    HANDLE ClientToken, DWORD DesiredAccess,
		    PGENERIC_MAPPING GenericMapping,
		    PPRIVILEGE_SET PrivilegeSet,
		    LPDWORD PrivilegeSetLength, LPDWORD GrantedAccess,
		    LPBOOL AccessStatus)) GetProcAddress(handle,
		    "AccessCheck");
	}
    } else {
	tclWinProcs = &asciiProcs;
	tclWinTCharEncoding = NULL;
	if (tclWinProcs->getFileAttributesExProc == NULL) {
	    HMODULE handle = GetModuleHandle(TEXT("KERNEL32"));
	    tclWinProcs->getFileAttributesExProc =
		    (BOOL (WINAPI *)(CONST TCHAR *, GET_FILEEX_INFO_LEVELS,
		    LPVOID)) GetProcAddress(handle,
		    "GetFileAttributesExA");
	    tclWinProcs->createHardLinkProc =
		    (BOOL (WINAPI *)(CONST TCHAR *, CONST TCHAR*,
		    LPSECURITY_ATTRIBUTES)) GetProcAddress(handle,
		    "CreateHardLinkA");
	    tclWinProcs->findFirstFileExProc = NULL;
	    tclWinProcs->getLongPathNameProc = NULL;
	    /*
	     * The 'findFirstFileExProc' function exists on some of
	     * 95/98/ME, but it seems not to work as anticipated.
	     * Therefore we don't set this function pointer. The relevant
	     * code will fall back on a slower approach using the normal
	     * findFirstFileProc.
	     *
	     * (HANDLE (WINAPI *)(CONST TCHAR*, UINT,
	     * LPVOID, UINT, LPVOID, DWORD)) GetProcAddress(handle,
	     * "FindFirstFileExA");
	     */
	    tclWinProcs->getVolumeNameForVMPProc =
		    (BOOL (WINAPI *)(CONST TCHAR*, TCHAR*,
		    DWORD)) GetProcAddress(handle,
		    "GetVolumeNameForVolumeMountPointA");
	}
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinResetInterfaceEncodings --
 *
 *	Called during finalization to free up any encodings we use. The
 *	tclWinProcs-> look up table is still ok to use after this call,
 *	provided no encoding conversion is required.
 *
 *	Called during finalization to clean up any memory allocated in our
 *	mount point map which is used to follow certain kinds of symlinks.
 *	We also clean up any memory allocated in our mount point map which is
 *	used to follow certain kinds of symlinks. That code should never be
 *	used once encodings are taken down.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

void
TclWinEncodingsCleanup(void)
TclWinResetInterfaceEncodings(void)
{
    MountPointMap *dlIter, *dlIter2;
    if (tclWinTCharEncoding != NULL) {
	Tcl_FreeEncoding(tclWinTCharEncoding);
	tclWinTCharEncoding = NULL;
    }

    /*
     * Clean up the mount point map.
     */

    Tcl_MutexLock(&mountPointMap);
    dlIter = driveLetterLookup;
    while (dlIter != NULL) {
	dlIter2 = dlIter->nextPtr;
	Tcl_Free(dlIter->volumeName);
	Tcl_Free(dlIter);
	ckfree((char*)dlIter->volumeName);
	ckfree((char*)dlIter);
	dlIter = dlIter2;
    }
    Tcl_MutexUnlock(&mountPointMap);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinResetInterfaces --
 *
 *	Called during finalization to reset us to a safe state for reuse.
 *	After this call, it is best not to use the tclWinProcs-> look up table
 *	since it is likely to be different to what is expected.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */
void
TclWinResetInterfaces(void)
{
    tclWinProcs = &asciiProcs;
}

/*
 *--------------------------------------------------------------------
 *
 * TclWinDriveLetterForVolMountPoint
 *
 *	Unfortunately, Windows provides no easy way at all to get hold of the
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
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







-
+



-
+

















-
+





-
-
-
+
+
+





-
+







 *	mount point.
 *
 *--------------------------------------------------------------------
 */

char
TclWinDriveLetterForVolMountPoint(
    const WCHAR *mountPoint)
    CONST WCHAR *mountPoint)
{
    MountPointMap *dlIter, *dlPtr2;
    WCHAR Target[55];		/* Target of mount at mount point */
    WCHAR drive[4] = L"A:\\";
    WCHAR drive[4] = { L'A', L':', L'\\', L'\0' };

    /*
     * Detect the volume mounted there. Unfortunately, there is no simple way
     * to map a unique volume name to a DOS drive letter. So, we have to build
     * an associative array.
     */

    Tcl_MutexLock(&mountPointMap);
    dlIter = driveLetterLookup;
    while (dlIter != NULL) {
	if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
	    /*
	     * We need to check whether this information is still valid, since
	     * either the user or various programs could have adjusted the
	     * mount points on the fly.
	     */

	    drive[0] = (WCHAR) dlIter->driveLetter;
	    drive[0] = L'A' + (dlIter->driveLetter - 'A');

	    /*
	     * Try to read the volume mount point and see where it points.
	     */

	    if (GetVolumeNameForVolumeMountPointW(drive,
		    Target, 55) != 0) {
		if (wcscmp(dlIter->volumeName, Target) == 0) {
	    if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
		    (TCHAR*)Target, 55) != 0) {
		if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
		    /*
		     * Nothing has changed.
		     */

		    Tcl_MutexUnlock(&mountPointMap);
		    return (char) dlIter->driveLetter;
		    return dlIter->driveLetter;
		}
	    }

	    /*
	     * If we reach here, unfortunately, this mount point is no longer
	     * valid at all.
	     */
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
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







-
-
+
+

















-
+




-
-
+
+




-
+





-
-
-
+
+
+

-
+












-
+








-
-
+
+


-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		}
	    }

	    /*
	     * Now dlPtr2 points to the structure to free.
	     */

	    Tcl_Free(dlPtr2->volumeName);
	    Tcl_Free(dlPtr2);
	    ckfree((char*)dlPtr2->volumeName);
	    ckfree((char*)dlPtr2);

	    /*
	     * Restart the loop - we could try to be clever and continue half
	     * way through, but the logic is a bit messy, so it's cleanest
	     * just to restart.
	     */

	    dlIter = driveLetterLookup;
	    continue;
	}
	dlIter = dlIter->nextPtr;
    }

    /*
     * We couldn't find it, so we must iterate over the letters.
     */

    for (drive[0] = 'A'; drive[0] <= 'Z'; drive[0]++) {
    for (drive[0] = L'A'; drive[0] <= L'Z'; drive[0]++) {
	/*
	 * Try to read the volume mount point and see where it points.
	 */

	if (GetVolumeNameForVolumeMountPointW(drive,
		Target, 55) != 0) {
	if ((*tclWinProcs->getVolumeNameForVMPProc)((TCHAR*)drive,
		(TCHAR*)Target, 55) != 0) {
	    int alreadyStored = 0;

	    for (dlIter = driveLetterLookup; dlIter != NULL;
		    dlIter = dlIter->nextPtr) {
		if (wcscmp(dlIter->volumeName, Target) == 0) {
		if (wcscmp((WCHAR*)dlIter->volumeName, Target) == 0) {
		    alreadyStored = 1;
		    break;
		}
	    }
	    if (!alreadyStored) {
		dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
		dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = (char) drive[0];
		dlPtr2 = (MountPointMap *) ckalloc(sizeof(MountPointMap));
		dlPtr2->volumeName = TclNativeDupInternalRep(Target);
		dlPtr2->driveLetter = 'A' + (drive[0] - L'A');
		dlPtr2->nextPtr = driveLetterLookup;
		driveLetterLookup = dlPtr2;
		driveLetterLookup  = dlPtr2;
	    }
	}
    }

    /*
     * Try again.
     */

    for (dlIter = driveLetterLookup; dlIter != NULL;
	    dlIter = dlIter->nextPtr) {
	if (wcscmp(dlIter->volumeName, mountPoint) == 0) {
	    Tcl_MutexUnlock(&mountPointMap);
	    return (char) dlIter->driveLetter;
	    return dlIter->driveLetter;
	}
    }

    /*
     * The volume doesn't appear to correspond to a drive letter - we remember
     * that fact and store '-1' so we don't have to look it up each time.
     */

    dlPtr2 = (MountPointMap *)Tcl_Alloc(sizeof(MountPointMap));
    dlPtr2->volumeName = (WCHAR *)TclNativeDupInternalRep((void *)mountPoint);
    dlPtr2 = (MountPointMap*) ckalloc(sizeof(MountPointMap));
    dlPtr2->volumeName = TclNativeDupInternalRep((ClientData)mountPoint);
    dlPtr2->driveLetter = -1;
    dlPtr2->nextPtr = driveLetterLookup;
    driveLetterLookup = dlPtr2;
    driveLetterLookup  = dlPtr2;
    Tcl_MutexUnlock(&mountPointMap);
    return -1;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_WinUtfToTChar, Tcl_WinTCharToUtf --
 *
 *	Convert between UTF-8 and Unicode when running Windows NT or the
 *	current ANSI code page when running Windows 95.
 *
 *	On Mac, Unix, and Windows 95, all strings exchanged between Tcl and
 *	the OS are "char" oriented. We need only one Tcl_Encoding to convert
 *	between UTF-8 and the system's native encoding. We use NULL to
 *	represent that encoding.
 *
 *	On NT, some strings exchanged between Tcl and the OS are "char"
 *	oriented, while others are in Unicode. We need two Tcl_Encoding APIs
 *	depending on whether we are targeting a "char" or Unicode interface.
 *
 *	Calling Tcl_UtfToExternal() or Tcl_ExternalToUtf() with an encoding of
 *	NULL should always used to convert between UTF-8 and the system's
 *	"char" oriented encoding. The following two functions are used in
 *	Windows-specific code to convert between UTF-8 and Unicode strings
 *	(NT) or "char" strings(95). This saves you the trouble of writing the
 *	following type of fragment over and over:
 *
 *		if (running NT) {
 *		    encoding <- Tcl_GetEncoding("unicode");
 *		    nativeBuffer <- UtfToExternal(encoding, utfBuffer);
 *		    Tcl_FreeEncoding(encoding);
 *		} else {
 *		    nativeBuffer <- UtfToExternal(NULL, utfBuffer);
 *		}
 *
 *	By convention, in Windows a TCHAR is a character in the ANSI code page
 *	on Windows 95, a Unicode character on Windows NT. If you plan on
 *	targeting a Unicode interfaces when running on NT and a "char"
 *	oriented interface while running on 95, these functions should be
 *	used. If you plan on targetting the same "char" oriented function on
 *	both 95 and NT, use Tcl_UtfToExternal() with an encoding of NULL.
 *
 * Results:
 *	The result is a pointer to the string in the desired target encoding.
 *	Storage for the result string is allocated in dsPtr; the caller must
 *	call Tcl_DStringFree() when the result is no longer needed.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

TCHAR *
Tcl_WinUtfToTChar(
    CONST char *string,		/* Source string in UTF-8. */
    int len,			/* Source string length in bytes, or < 0 for
				 * strlen(). */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    return (TCHAR *) Tcl_UtfToExternalDString(tclWinTCharEncoding,
	    string, len, dsPtr);
}

char *
Tcl_WinTCharToUtf(
    CONST TCHAR *string,	/* Source string in Unicode when running NT,
				 * ANSI when running 95. */
    int len,			/* Source string length in bytes, or < 0 for
				 * platform-specific string length. */
    Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
				 * converted string is stored. */
{
    return Tcl_ExternalToUtfDString(tclWinTCharEncoding,
	    (CONST char *) string, len, dsPtr);
}

/*
 *------------------------------------------------------------------------
 *
 * TclWinCPUID --
 *
 *	Get CPU ID information on an Intel box under Windows
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
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







-
-
+
+



-
-
-
-
-
-
+



-
+














-
+







 *	instruction in the four integers designated by 'regsPtr'
 *
 *----------------------------------------------------------------------
 */

int
TclWinCPUID(
    int index,		/* Which CPUID value to retrieve. */
    int *regsPtr)	/* Registers after the CPUID. */
    unsigned int index,		/* Which CPUID value to retrieve. */
    unsigned int *regsPtr)	/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

#if defined(HAVE_INTRIN_H) && defined(_WIN64)

    __cpuid((int *)regsPtr, index);
    status = TCL_OK;

#elif defined(__GNUC__)
#if defined(__GNUC__)
#   if defined(_WIN64)
    /*
     * Execute the CPUID instruction with the given index, and store results
     * off 'regPtr'.
     * off 'regsPtr'.
     */

    __asm__ __volatile__(
	/*
	 * Do the CPUID instruction, and save the results in the 'regsPtr'
	 * area.
	 */

	"movl	%[rptr],	%%edi"		"\n\t"
	"movl	%[index],	%%eax"		"\n\t"
	"cpuid"					"\n\t"
	"movl	%%eax,		0x0(%%edi)"	"\n\t"
	"movl	%%ebx,		0x4(%%edi)"	"\n\t"
	"movl	%%ecx,		0x8(%%edi)"	"\n\t"
	"movl	%%edx,		0xC(%%edi)"	"\n\t"
	"movl	%%edx,		0xc(%%edi)"	"\n\t"

	:
	/* No outputs */
	:
	[index]		"m"	(index),
	[rptr]		"m"	(regsPtr)
	:
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
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







-
+



















-
+








	"leal	%[registration], %%edx"		"\n\t"
	"movl	%%fs:0,		%%eax"		"\n\t"
	"movl	%%eax,		0x0(%%edx)"	"\n\t" /* link */
	"leal	1f,		%%eax"		"\n\t"
	"movl	%%eax,		0x4(%%edx)"	"\n\t" /* handler */
	"movl	%%ebp,		0x8(%%edx)"	"\n\t" /* ebp */
	"movl	%%esp,		0xC(%%edx)"	"\n\t" /* esp */
	"movl	%%esp,		0xc(%%edx)"	"\n\t" /* esp */
	"movl	%[error],	0x10(%%edx)"	"\n\t" /* status */

	/*
	 * Link the TCLEXCEPTION_REGISTRATION on the chain
	 */

	"movl	%%edx,		%%fs:0"		"\n\t"

	/*
	 * Do the CPUID instruction, and save the results in the 'regsPtr'
	 * area.
	 */

	"movl	%[rptr],	%%edi"		"\n\t"
	"movl	%[index],	%%eax"		"\n\t"
	"cpuid"					"\n\t"
	"movl	%%eax,		0x0(%%edi)"	"\n\t"
	"movl	%%ebx,		0x4(%%edi)"	"\n\t"
	"movl	%%ecx,		0x8(%%edi)"	"\n\t"
	"movl	%%edx,		0xC(%%edi)"	"\n\t"
	"movl	%%edx,		0xc(%%edi)"	"\n\t"

	/*
	 * Come here on a normal exit. Recover the TCLEXCEPTION_REGISTRATION and
	 * store a TCL_OK status.
	 */

	"movl	%%fs:0,		%%edx"		"\n\t"
544
545
546
547
548
549
550
551

552
553
554
555
556
557
558
1123
1124
1125
1126
1127
1128
1129

1130
1131
1132
1133
1134
1135
1136
1137







-
+








	/*
	 * Come here however we exited. Restore context from the
	 * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
	 */

	"2:"					"\t"
	"movl	0xC(%%edx),	%%esp"		"\n\t"
	"movl	0xc(%%edx),	%%esp"		"\n\t"
	"movl	0x8(%%edx),	%%ebp"		"\n\t"
	"movl	0x0(%%edx),	%%eax"		"\n\t"
	"movl	%%eax,		%%fs:0"		"\n\t"

	:
	/* No outputs */
	:
568
569
570
571
572
573
574
575

576
577
578
579
580
581
582
1147
1148
1149
1150
1151
1152
1153

1154
1155
1156
1157
1158
1159
1160
1161







-
+







#   endif /* !_WIN64 */
#elif defined(_MSC_VER)
#   if defined(_WIN64)

    __cpuid(regsPtr, index);
    status = TCL_OK;

#   elif defined (_M_IX86)
#   else
    /*
     * Define a structure in the stack frame to hold the registers.
     */

    struct {
	DWORD dw0;
	DWORD dw1;

Changes to win/tclWinChan.c.

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
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







-
+
-

















-
+














-
+
















-
+







-
+
+
+









-
+
-




-
+


-
+


-
+




-
+





-
+

-
-
-
-
-
-
-
-







#define FILE_ASYNC	(1<<1)	/* Channel is non-blocking. */
#define FILE_APPEND	(1<<2)	/* File is in append mode. */

#define FILE_TYPE_SERIAL  (FILE_TYPE_PIPE+1)
#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)

/*
 * The following structure contains per-instance data for a file based
 * The following structure contains per-instance data for a file based channel.
 * channel.
 */

typedef struct FileInfo {
    Tcl_Channel channel;	/* Pointer to channel structure. */
    int validMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which operations are valid on the file. */
    int watchMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which events should be reported. */
    int flags;			/* State flags, see above for a list. */
    HANDLE handle;		/* Input/output file. */
    struct FileInfo *nextPtr;	/* Pointer to next registered file. */
    int dirty;			/* Boolean flag. Set if the OS may have data
				 * pending on the channel. */
} FileInfo;

typedef struct {
typedef struct ThreadSpecificData {
    /*
     * List of all file channels currently open.
     */

    FileInfo *firstFilePtr;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following structure is what is added to the Tcl event queue when file
 * events are generated.
 */

typedef struct {
typedef struct FileEvent {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    FileInfo *infoPtr;		/* Pointer to file info structure. Note that
				 * we still have to verify that the file
				 * exists before dereferencing this
				 * pointer. */
} FileEvent;

/*
 * Static routines for this file:
 */

static int		FileBlockProc(ClientData instanceData, int mode);
static void		FileChannelExitHandler(ClientData clientData);
static void		FileCheckProc(ClientData clientData, int flags);
static int		FileCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
			    Tcl_Interp *interp);
static int		FileEventProc(Tcl_Event *evPtr, int flags);
static int		FileGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static ThreadSpecificData *FileInit(void);
static int		FileInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		FileOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
			    CONST char *buf, int toWrite, int *errorCode);
static int		FileSeekProc(ClientData instanceData, long offset,
			    int mode, int *errorCode);
static Tcl_WideInt	FileWideSeekProc(ClientData instanceData,
			    Tcl_WideInt offset, int mode, int *errorCode);
static void		FileSetupProc(ClientData clientData, int flags);
static void		FileWatchProc(ClientData instanceData, int mask);
static void		FileThreadActionProc(ClientData instanceData,
			    int action);
static int		FileTruncateProc(ClientData instanceData,
			    Tcl_WideInt length);
static DWORD		FileGetType(HANDLE handle);
static int		NativeIsComPort(const WCHAR *nativeName);
static int		NativeIsComPort(CONST TCHAR *nativeName);

/*
 * This structure describes the channel type structure for file based IO.
 */

static const Tcl_ChannelType fileChannelType = {
static Tcl_ChannelType fileChannelType = {
    "file",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    FileCloseProc,		/* Close proc. */
    FileInputProc,		/* Input proc. */
    FileOutputProc,		/* Output proc. */
	NULL,
    FileSeekProc,		/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    FileWatchProc,		/* Set up the notifier to watch the channel. */
    FileGetHandleProc,		/* Get an OS handle from channel. */
    FileCloseProc,		/* close2proc. */
    NULL,			/* close2proc. */
    FileBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    FileWideSeekProc,		/* Wide seek proc. */
    FileThreadActionProc,	/* Thread action proc. */
    FileTruncateProc		/* Truncate proc. */
    FileTruncateProc,		/* Truncate proc. */
};

/*
 * General useful clarification macros.
 */

#define SET_FLAG(var, flag)	((var) |= (flag))
#define CLEAR_FLAG(var, flag)	((var) &= ~(flag))
#define TEST_FLAG(value, flag)	(((value) & (flag)) != 0)

/*
 *----------------------------------------------------------------------
 *
 * FileInit --
 *
 *	This function creates the window used to simulate file events.
144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
136
137
138
139
140
141
142

143
144
145
146
147
148
149
150







-
+







 *----------------------------------------------------------------------
 */

static ThreadSpecificData *
FileInit(void)
{
    ThreadSpecificData *tsdPtr =
	    (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
	    (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr->firstFilePtr = NULL;
	Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
	Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
    }
174
175
176
177
178
179
180
181

182
183
184
185
186
187
188
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180







-
+







 *	Destroys the communication window.
 *
 *----------------------------------------------------------------------
 */

static void
FileChannelExitHandler(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Old window proc */
{
    Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *
198
199
200
201
202
203
204
205

206
207
208
209
210
211
212

213
214
215
216
217
218
219
190
191
192
193
194
195
196

197
198
199
200
201
202
203

204
205
206
207
208
209
210
211







-
+






-
+







 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
FileSetupProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    FileInfo *infoPtr;
    Tcl_Time blockTime = { 0, 0 };
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Check to see if there is a ready file. If so, poll.
     */

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
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







-
+






-
+










-
-
-
+
+
+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
FileCheckProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    FileEvent *evPtr;
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready files that don't already have events queued
     * (caused by persistent states that won't generate WinSock events).
     */

    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
	    SET_FLAG(infoPtr->flags, FILE_PENDING);
	    evPtr = (FileEvent *)Tcl_Alloc(sizeof(FileEvent));
	if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
	    infoPtr->flags |= FILE_PENDING;
	    evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
	    evPtr->header.proc = FileEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

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
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







-
+













-
+







    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    FileEvent *fileEvPtr = (FileEvent *)evPtr;
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }

    /*
     * Search through the list of watched files for the one whose handle
     * matches the event. We do this rather than simply dereferencing the
     * handle in the event so that files can be deleted while the event is in
     * the queue.
     */

    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (fileEvPtr->infoPtr == infoPtr) {
	    CLEAR_FLAG(infoPtr->flags, FILE_PENDING);
	    infoPtr->flags &= ~(FILE_PENDING);
	    Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
	    break;
	}
    }
    return 1;
}

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
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







-
+









-
+

-
+








static int
FileBlockProc(
    ClientData instanceData,	/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr = (FileInfo *) instanceData;

    /*
     * Files on Windows can not be switched between blocking and nonblocking,
     * hence we have to emulate the behavior. This is done in the input
     * function by checking against a bit in the state. We set or unset the
     * bit here to cause the input function to emulate the correct behavior.
     */

    if (mode == TCL_MODE_NONBLOCKING) {
	SET_FLAG(infoPtr->flags, FILE_ASYNC);
	infoPtr->flags |= FILE_ASYNC;
    } else {
	CLEAR_FLAG(infoPtr->flags, FILE_ASYNC);
	infoPtr->flags &= ~(FILE_ASYNC);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
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
372
373
374
375
376
377
378

379

380

381
382
383
384
385




386
387
388
389
390
391
392







-
+
-

-
+




-
-
-
-







 *
 *----------------------------------------------------------------------
 */

static int
FileCloseProc(
    ClientData instanceData,	/* Pointer to FileInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp)		/* Not used. */
    int flags)
{
    FileInfo *fileInfoPtr = (FileInfo *)instanceData;
    FileInfo *fileInfoPtr = (FileInfo *) instanceData;
    FileInfo *infoPtr;
    ThreadSpecificData *tsdPtr;
    int errorCode = 0;

    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    /*
     * Remove the file from the watch list.
     */

    FileWatchProc(instanceData, 0);

    /*
433
434
435
436
437
438
439
440

441
442














































































443
444
445
446
447
448
449
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
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







-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	     * pointer on the thread local list.
	     */

	    FileThreadActionProc(fileInfoPtr,TCL_CHANNEL_THREAD_REMOVE);
	    break;
	}
    }
    Tcl_Free(fileInfoPtr);
    ckfree((char *)fileInfoPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * FileSeekProc --
 *
 *	Seeks on a file-based channel. Returns the new position.
 *
 * Results:
 *	-1 if failed, the new position if successful. If failed, it also sets
 *	*errorCodePtr to the error code.
 *
 * Side effects:
 *	Moves the location at which the channel will be accessed in future
 *	operations.
 *
 *----------------------------------------------------------------------
 */

static int
FileSeekProc(
    ClientData instanceData,	/* File state. */
    long offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? */
    int *errorCodePtr)		/* To store error code. */
{
    FileInfo *infoPtr = (FileInfo *) instanceData;
    LONG newPos, newPosHigh, oldPos, oldPosHigh;
    DWORD moveMethod;

    *errorCodePtr = 0;
    if (mode == SEEK_SET) {
	moveMethod = FILE_BEGIN;
    } else if (mode == SEEK_CUR) {
	moveMethod = FILE_CURRENT;
    } else {
	moveMethod = FILE_END;
    }

    /*
     * Save our current place in case we need to roll-back the seek.
     */

    oldPosHigh = 0;
    oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
    if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }

    newPosHigh = (offset < 0 ? -1 : 0);
    newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
    if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }

    /*
     * Check for expressability in our return type, and roll-back otherwise.
     */

    if (newPosHigh != 0) {
	*errorCodePtr = EOVERFLOW;
	SetFilePointer(infoPtr->handle, oldPos, &oldPosHigh, FILE_BEGIN);
	return -1;
    }
    return (int) newPos;
}

/*
 *----------------------------------------------------------------------
 *
 * FileWideSeekProc --
 *
 *	Seeks on a file-based channel. Returns the new position.
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
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







-
+












-
-
+
+

-
+








-
+
-







static Tcl_WideInt
FileWideSeekProc(
    ClientData instanceData,	/* File state. */
    Tcl_WideInt offset,		/* Offset to seek to. */
    int mode,			/* Relative to where should we seek? */
    int *errorCodePtr)		/* To store error code. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr = (FileInfo *) instanceData;
    DWORD moveMethod;
    LONG newPos, newPosHigh;

    *errorCodePtr = 0;
    if (mode == SEEK_SET) {
	moveMethod = FILE_BEGIN;
    } else if (mode == SEEK_CUR) {
	moveMethod = FILE_CURRENT;
    } else {
	moveMethod = FILE_END;
    }

    newPosHigh = (LONG)(offset >> 32);
    newPos = SetFilePointer(infoPtr->handle, (LONG)offset,
    newPosHigh = Tcl_WideAsLong(offset >> 32);
    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
	    &newPosHigh, moveMethod);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
    if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    *errorCodePtr = errno;
	    return -1;
	}
    }
    return (((Tcl_WideInt)((unsigned)newPos))
    return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32));
	    | ((Tcl_WideInt)newPosHigh << 32));
}

/*
 *----------------------------------------------------------------------
 *
 * FileTruncateProc --
 *
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
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







-
+








-
+

-










-
-
+
+

-
+

-







 */

static int
FileTruncateProc(
    ClientData instanceData,	/* File state. */
    Tcl_WideInt length)		/* Length to truncate at. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr = (FileInfo *) instanceData;
    LONG newPos, newPosHigh, oldPos, oldPosHigh;

    /*
     * Save where we were...
     */

    oldPosHigh = 0;
    oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
    if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
    if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    return errno;
	}
    }

    /*
     * Move to where we want to truncate
     */

    newPosHigh = (LONG)(length >> 32);
    newPos = SetFilePointer(infoPtr->handle, (LONG)length,
    newPosHigh = Tcl_WideAsLong(length >> 32);
    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
	    &newPosHigh, FILE_BEGIN);
    if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
    if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
	DWORD winError = GetLastError();

	if (winError != NO_ERROR) {
	    TclWinConvertError(winError);
	    return errno;
	}
    }

    /*
590
591
592
593
594
595
596
597

598
599
600

601
602
603
604
605
606
607
608
609
610
611
612
613
652
653
654
655
656
657
658

659
660
661
662
663
664
665




666
667
668
669
670
671
672







-
+



+


-
-
-
-







static int
FileInputProc(
    ClientData instanceData,	/* File state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* Num bytes available in buffer. */
    int *errorCode)		/* Where to store error code. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr;
    DWORD bytesRead;

    *errorCode = 0;
    infoPtr = (FileInfo *) instanceData;

    /*
     * TODO: This comment appears to be out of date. We *do* have a console
     * driver, over in tclWinConsole.c. After some Windows developer confirms,
     * this comment should be revised.
     *
     * Note that we will block on reads from a console buffer until a full
     * line has been entered. The only way I know of to get around this is to
     * write a console driver. We should probably do this at some point, but
     * for now, we just block. The same problem exists for files being read
     * over the network.
     */

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
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







-
+



-
+









-
+







 *
 *----------------------------------------------------------------------
 */

static int
FileOutputProc(
    ClientData instanceData,	/* File state. */
    const char *buf,		/* The data buffer. */
    CONST char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr = (FileInfo *) instanceData;
    DWORD bytesWritten;

    *errorCode = 0;

    /*
     * If we are writing to a file that was opened with O_APPEND, we need to
     * seek to the end of the file before writing the current buffer.
     */

    if (TEST_FLAG(infoPtr->flags, FILE_APPEND)) {
    if (infoPtr->flags & FILE_APPEND) {
	SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
    }

    if (WriteFile(infoPtr->handle, (LPVOID) buf, (DWORD) toWrite,
	    &bytesWritten, (LPOVERLAPPED) NULL) == FALSE) {
	TclWinConvertError(GetLastError());
	*errorCode = errno;
692
693
694
695
696
697
698
699

700
701
702
703
704
705
706
751
752
753
754
755
756
757

758
759
760
761
762
763
764
765







-
+







static void
FileWatchProc(
    ClientData instanceData,	/* File state. */
    int mask)			/* What events to watch for; OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr = (FileInfo *) instanceData;
    Tcl_Time blockTime = { 0, 0 };

    /*
     * Since the file is always ready for events, we set the block time to
     * zero so we will poll.
     */

730
731
732
733
734
735
736
737

738
739
740
741
742






743
744
745
746
747
748
749
750
751
789
790
791
792
793
794
795

796
797




798
799
800
801
802
803


804
805
806
807
808
809
810







-
+

-
-
-
-
+
+
+
+
+
+
-
-








static int
FileGetHandleProc(
    ClientData instanceData,	/* The file state. */
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle.  */
{
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr = (FileInfo *) instanceData;

    if (!TEST_FLAG(direction, infoPtr->validMask)) {
	return TCL_ERROR;
    }

    if (direction & infoPtr->validMask) {
	*handlePtr = (ClientData) infoPtr->handle;
	return TCL_OK;
    } else {
	return TCL_ERROR;
    }
    *handlePtr = (ClientData) infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenFileChannel --
 *
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
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







-
+




-
+

-
-
-
-
+
+
+
+







    int mode,			/* POSIX mode. */
    int permissions)		/* If the open involves creating a file, with
				 * what modes to create it? */
{
    Tcl_Channel channel = 0;
    int channelPermissions = 0;
    DWORD accessMode = 0, createMode, shareMode, flags;
    const WCHAR *nativeName;
    CONST TCHAR *nativeName;
    HANDLE handle;
    char channelName[16 + TCL_INTEGER_SPACE];
    TclFile readFile = NULL, writeFile = NULL;

    nativeName = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
    nativeName = (TCHAR*) Tcl_FSGetNativePath(pathPtr);
    if (nativeName == NULL) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open \"%s\": filename is invalid on this platform",
		    TclGetString(pathPtr)));
	if (interp != (Tcl_Interp *) NULL) {
	    Tcl_AppendResult(interp, "couldn't open \"",
	    TclGetString(pathPtr), "\": filename is invalid on this platform",
	    NULL);
	}
	return NULL;
    }

    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
    case O_RDONLY:
	accessMode = GENERIC_READ;
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
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







-
-
-
+
+
+


-
+
+



-
+
-
-
-
+
+
+





-
-
+
+
-





-





-
-
+
+





-
+















-
-
+
+




-
+
-
-
+


-
+
-
-
-
+
+









-
-
+
+
+
-








-
+
-
-
-
+
+
+











-
+


-
+








-
+
-









-
-
+
+
-
-
-







	break;
    default:
	createMode = OPEN_EXISTING;
	break;
    }

    /*
     * [2413550] Avoid double-open of serial ports on Windows.  Special
     * handling for Windows serial ports by a "name-hint" to directly open it
     * with the OVERLAPPED flag set.
     * [2413550] Avoid double-open of serial ports on Windows
     * Special handling for Windows serial ports by a "name-hint"
     * to directly open it with the OVERLAPPED flag set.
     */

    if (NativeIsComPort(nativeName)) {
    if( NativeIsComPort(nativeName) ) {

	handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
	if (handle == INVALID_HANDLE_VALUE) {
	    TclWinConvertError(GetLastError());
	    if (interp) {
	    if (interp != (Tcl_Interp *) NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't open serial \"%s\": %s",
			TclGetString(pathPtr), Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "couldn't open serial \"",
			TclGetString(pathPtr), "\": ",
			Tcl_PosixError(interp), NULL);
	    }
	    return NULL;
	}

	/*
	 * For natively named Windows serial ports we are done.
	 */
	* For natively named Windows serial ports we are done.
	*/

	channel = TclWinOpenSerialChannel(handle, channelName,
		channelPermissions);

	return channel;
    }

    /*
     * If the file is being created, get the file attributes from the
     * permissions argument, else use the existing file attributes.
     */

    if (TEST_FLAG(mode, O_CREAT)) {
	if (TEST_FLAG(permissions, S_IWRITE)) {
    if (mode & O_CREAT) {
	if (permissions & S_IWRITE) {
	    flags = FILE_ATTRIBUTE_NORMAL;
	} else {
	    flags = FILE_ATTRIBUTE_READONLY;
	}
    } else {
	flags = GetFileAttributesW(nativeName);
	flags = (*tclWinProcs->getFileAttributesProc)(nativeName);
	if (flags == 0xFFFFFFFF) {
	    flags = 0;
	}
    }

    /*
     * Set up the file sharing mode.  We want to allow simultaneous access.
     */

    shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;

    /*
     * Now we get to create the file.
     */

    handle = CreateFileW(nativeName, accessMode, shareMode,
	    NULL, createMode, flags, (HANDLE) NULL);
    handle = (*tclWinProcs->createFileProc)(nativeName, accessMode,
	    shareMode, NULL, createMode, flags, (HANDLE) NULL);

    if (handle == INVALID_HANDLE_VALUE) {
	DWORD err = GetLastError();

	if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) {
	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
	    err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS
		    : ERROR_FILE_NOT_FOUND;
	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
	}
	TclWinConvertError(err);
	if (interp) {
	if (interp != (Tcl_Interp *) NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open \"%s\": %s",
		    TclGetString(pathPtr), Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
		    "\": ", Tcl_PosixError(interp), NULL);
	}
	return NULL;
    }

    channel = NULL;

    switch (FileGetType(handle)) {
    case FILE_TYPE_SERIAL:
	/*
	 * Natively named serial ports "com1-9", "\\\\.\\comXX" are already
	 * done with the code above.  Here we handle all other serial port
	 * Natively named serial ports "com1-9", "\\\\.\\comXX" are
	 * already done with the code above.
	 * Here we handle all other serial port names.
	 * names.
	 *
	 * Reopen channel for OVERLAPPED operation. Normally this shouldn't
	 * fail, because the channel exists.
	 */

	handle = TclWinSerialOpen(handle, nativeName, accessMode);
	if (handle == INVALID_HANDLE_VALUE) {
	    TclWinConvertError(GetLastError());
	    if (interp) {
	    if (interp != (Tcl_Interp *) NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't reopen serial \"%s\": %s",
			TclGetString(pathPtr), Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "couldn't reopen serial \"",
			TclGetString(pathPtr), "\": ",
			Tcl_PosixError(interp), NULL);
	    }
	    return NULL;
	}
	channel = TclWinOpenSerialChannel(handle, channelName,
		channelPermissions);
	break;
    case FILE_TYPE_CONSOLE:
	channel = TclWinOpenConsoleChannel(handle, channelName,
		channelPermissions);
	break;
    case FILE_TYPE_PIPE:
	if (TEST_FLAG(channelPermissions, TCL_READABLE)) {
	if (channelPermissions & TCL_READABLE) {
	    readFile = TclWinMakeFile(handle);
	}
	if (TEST_FLAG(channelPermissions, TCL_WRITABLE)) {
	if (channelPermissions & TCL_WRITABLE) {
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;
    case FILE_TYPE_CHAR:
    case FILE_TYPE_DISK:
    case FILE_TYPE_UNKNOWN:
	channel = TclWinOpenFileChannel(handle, channelName,
		channelPermissions,
		channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0);
		TEST_FLAG(mode, O_APPEND) ? FILE_APPEND : 0);
	break;

    default:
	/*
	 * The handle is of an unknown type, probably /dev/nul equivalent or
	 * possibly a closed handle.
	 */

	channel = NULL;
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't open \"%s\": bad file type",
	Tcl_AppendResult(interp, "couldn't open \"", TclGetString(pathPtr),
		"\": bad file type", NULL);
		TclGetString(pathPtr)));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "CHANNEL", "BAD_TYPE",
		NULL);
	break;
    }

    return channel;
}

/*
989
990
991
992
993
994
995
996

997
998
999
1000
1001
1002
1003
1041
1042
1043
1044
1045
1046
1047

1048
1049
1050
1051
1052
1053
1054
1055







-
+








Tcl_Channel
Tcl_MakeFileChannel(
    ClientData rawHandle,	/* OS level handle */
    int mode)			/* ORed combination of TCL_READABLE and
				 * TCL_WRITABLE to indicate file mode. */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__)
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
    TCLEXCEPTION_REGISTRATION registration;
#endif
    char channelName[16 + TCL_INTEGER_SPACE];
    Tcl_Channel channel = NULL;
    HANDLE handle = (HANDLE) rawHandle;
    HANDLE dupedHandle;
    TclFile readFile = NULL, writeFile = NULL;
1011
1012
1013
1014
1015
1016
1017
1018

1019
1020
1021

1022
1023
1024
1025
1026
1027
1028
1063
1064
1065
1066
1067
1068
1069

1070
1071
1072

1073
1074
1075
1076
1077
1078
1079
1080







-
+


-
+







    case FILE_TYPE_SERIAL:
	channel = TclWinOpenSerialChannel(handle, channelName, mode);
	break;
    case FILE_TYPE_CONSOLE:
	channel = TclWinOpenConsoleChannel(handle, channelName, mode);
	break;
    case FILE_TYPE_PIPE:
	if (TEST_FLAG(mode, TCL_READABLE)) {
	if (mode & TCL_READABLE) {
	    readFile = TclWinMakeFile(handle);
	}
	if (TEST_FLAG(mode, TCL_WRITABLE)) {
	if (mode & TCL_WRITABLE) {
	    writeFile = TclWinMakeFile(handle);
	}
	channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
	break;

    case FILE_TYPE_DISK:
    case FILE_TYPE_CHAR:
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
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







-
+












-
+








	result = DuplicateHandle(GetCurrentProcess(), handle,
		GetCurrentProcess(), &dupedHandle, 0, FALSE,
		DUPLICATE_SAME_ACCESS);

	if (result == 0) {
	    /*
	     * Unable to make a duplicate. It's definitely invalid at this
	     * Unable to make a duplicate. It's definately invalid at this
	     * point.
	     */

	    return NULL;
	}

	/*
	 * Use structured exception handling (Win32 SEH) to protect the close
	 * of this duped handle which might throw EXCEPTION_INVALID_HANDLE.
	 */

	result = 0;
#if defined(HAVE_NO_SEH) && !defined(_WIN64) && !defined(__clang__)
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
	/*
	 * Don't have SEH available, do things the hard way. Note that this
	 * needs to be one block of asm, to avoid stack imbalance; also, it is
	 * illegal for one asm block to contain a jump to another.
	 */

	__asm__ __volatile__ (
1081
1082
1083
1084
1085
1086
1087
1088

1089
1090
1091
1092
1093
1094
1095
1133
1134
1135
1136
1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1147







-
+








	    "leal       %[registration], %%edx"         "\n\t"
	    "movl       %%fs:0,         %%eax"          "\n\t"
	    "movl       %%eax,          0x0(%%edx)"     "\n\t" /* link */
	    "leal       1f,             %%eax"          "\n\t"
	    "movl       %%eax,          0x4(%%edx)"     "\n\t" /* handler */
	    "movl       %%ebp,          0x8(%%edx)"     "\n\t" /* ebp */
	    "movl       %%esp,          0xC(%%edx)"     "\n\t" /* esp */
	    "movl       %%esp,          0xc(%%edx)"     "\n\t" /* esp */
	    "movl       $0,             0x10(%%edx)"    "\n\t" /* status */

	    /*
	     * Link the TCLEXCEPTION_REGISTRATION on the chain.
	     */

	    "movl       %%edx,          %%fs:0"         "\n\t"
1121
1122
1123
1124
1125
1126
1127
1128

1129
1130
1131
1132
1133
1134
1135
1173
1174
1175
1176
1177
1178
1179

1180
1181
1182
1183
1184
1185
1186
1187







-
+








	    /*
	     * Come here however we exited. Restore context from the
	     * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
	     */

	    "2:"                                        "\t"
	    "movl       0xC(%%edx),     %%esp"          "\n\t"
	    "movl       0xc(%%edx),     %%esp"          "\n\t"
	    "movl       0x8(%%edx),     %%ebp"          "\n\t"
	    "movl       0x0(%%edx),     %%eax"          "\n\t"
	    "movl       %%eax,          %%fs:0"         "\n\t"

	    :
	    /* No outputs */
	    :
1186
1187
1188
1189
1190
1191
1192
1193
1194


1195
1196
1197
1198
1199
1200
1201
1238
1239
1240
1241
1242
1243
1244


1245
1246
1247
1248
1249
1250
1251
1252
1253







-
-
+
+







TclpGetDefaultStdChannel(
    int type)			/* One of TCL_STDIN, TCL_STDOUT, or
				 * TCL_STDERR. */
{
    Tcl_Channel channel;
    HANDLE handle;
    int mode = -1;
    const char *bufMode = NULL;
    DWORD handleId = (DWORD) -1;
    char *bufMode = NULL;
    DWORD handleId = (DWORD)-1;
				/* Standard handle to retrieve. */

    switch (type) {
    case TCL_STDIN:
	handleId = STD_INPUT_HANDLE;
	mode = TCL_READABLE;
	bufMode = "line";
1236
1237
1238
1239
1240
1241
1242
1243

1244
1245
1246
1247
1248
1249
1250
1288
1289
1290
1291
1292
1293
1294

1295
1296
1297
1298
1299
1300
1301
1302







-
+







    /*
     * Set up the normal channel options for stdio handles.
     */

    if (Tcl_SetChannelOption(NULL,channel,"-translation","auto")!=TCL_OK ||
	    Tcl_SetChannelOption(NULL,channel,"-eofchar","\032 {}")!=TCL_OK ||
	    Tcl_SetChannelOption(NULL,channel,"-buffering",bufMode)!=TCL_OK) {
	Tcl_CloseEx(NULL, channel, 0);
	Tcl_Close(NULL, channel);
	return (Tcl_Channel) NULL;
    }
    return channel;
}

/*
 *----------------------------------------------------------------------
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
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







-
+













-
+


-
+







    for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->handle == (HANDLE) handle) {
	    return (permissions==infoPtr->validMask) ? infoPtr->channel : NULL;
	}
    }

    infoPtr = (FileInfo *)Tcl_Alloc(sizeof(FileInfo));
    infoPtr = (FileInfo *) ckalloc((unsigned) sizeof(FileInfo));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */

    infoPtr->nextPtr = NULL;
    infoPtr->validMask = permissions;
    infoPtr->watchMask = 0;
    infoPtr->flags = appendMode;
    infoPtr->handle = handle;
    infoPtr->dirty = 0;
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t)infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
	    infoPtr, permissions);
	    (ClientData) infoPtr, permissions);

    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.
     */

    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
1377
1378
1379
1380
1381
1382
1383
1384

1385
1386
1387
1388
1389
1390
1391
1429
1430
1431
1432
1433
1434
1435

1436
1437
1438
1439
1440
1441
1442
1443







-
+








static void
FileThreadActionProc(
    ClientData instanceData,
    int action)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    FileInfo *infoPtr = (FileInfo *)instanceData;
    FileInfo *infoPtr = (FileInfo *) instanceData;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
	infoPtr->nextPtr = tsdPtr->firstFilePtr;
	tsdPtr->firstFilePtr = infoPtr;
    } else {
	FileInfo **nextPtrPtr;
	int removed = 0;
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471




1472
1473
1474


1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485

1486




1487
1488


1489
1490
1491
1492



1493

1494
1495
1496
1497




1498
1499
1500
1501
1502
1503








1504
1505
1506
1507























1508

























1509
1510
1511
1512





1513
1514
1515
1516
1517
1518
1519







1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1513
1514
1515
1516
1517
1518
1519




1520
1521
1522
1523

1524

1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536

1537
1538
1539
1540
1541
1542


1543
1544
1545



1546
1547
1548
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
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
1631
1632
1633
1634
1635
1636
1637







-
-
-
-
+
+
+
+
-

-
+
+










-
+

+
+
+
+
-
-
+
+

-
-
-
+
+
+

+
-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+











}

 /*
 *----------------------------------------------------------------------
 *
 * NativeIsComPort --
 *
 *	Determines if a path refers to a Windows serial port.  A simple and
 *	efficient solution is to use a "name hint" to detect COM ports by
 *	their filename instead of resorting to a syscall to detect serialness
 *	after the fact.
 *	Determines if a path refers to a Windows serial port.
 *	A simple and efficient solution is to use a "name hint" to detect
 *      COM ports by their filename instead of resorting to a syscall
 *	to detect serialness after the fact.
 *
 *	The following patterns cover common serial port names:
 *	    COM[1-9]
 *	    COM[1-9]:?
 *	    //./COM[0-9]+
 *	    \\.\COM[0-9]+
 *
 * Results:
 *	1 = serial port, 0 = not.
 *
 *----------------------------------------------------------------------
 */

static int
NativeIsComPort(
    const WCHAR *nativePath)	/* Path of file to access, native encoding. */
    const TCHAR *nativePath)	/* Path of file to access, native encoding. */
{
    /*
     * Use wide-char or plain character case-insensitive comparison
     */
    if (tclWinProcs->useWide) {
    const WCHAR *p = (const WCHAR *) nativePath;
    int i, len = wcslen(p);
	const WCHAR *p = (const WCHAR *) nativePath;
	int i, len = wcslen(p);

    /*
     * 1. Look for com[1-9]:?
     */
	/*
	 * 1. Look for com[1-9]:?
	 */

	if ( (len >= 4) && (len <= 5)
    if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) {
	/*
	 * The 4th character must be a digit 1..9
	 */
		&& (_wcsnicmp(p, L"com", 3) == 0) ) {
	    /*
	    * The 4th character must be a digit 1..9 optionally followed by a ":"
	    */

	if ((p[3] < '1') || (p[3] > '9')) {
	    return 0;
	}
	return 1;
    }
	    if ( (p[3] < L'1') || (p[3] > L'9') ) {
		return 0;
	    }
	    if ( (len == 5) && (p[4] != L':') ) {
		return 0;
	    }
	    return 1;
	}

    /*
     * 2. Look for \\.\com[0-9]+
     */
	/*
	 * 2. Look for //./com[0-9]+ or \\.\com[0-9]+
	 */

	if ( (len >= 8) && (
		   (_wcsnicmp(p, L"//./com", 7) == 0)
		|| (_wcsnicmp(p, L"\\\\.\\com", 7) == 0) ) )
	{
	    /*
	    * Charaters 8..end must be a digits 0..9
	    */

	    for ( i=7; i<len; i++ ) {
		if ( (p[i] < '0') || (p[i] > '9') ) {
		    return 0;
		}
	    }
	    return 1;
	}

    } else {
	const char *p = (const char *) nativePath;
	int   i, len = strlen(p);

	/*
	 * 1. Look for com[1-9]:?
	 */

	if ( (len >= 4) && (len <= 5)
		&& (strnicmp(p, "com", 3) == 0) ) {
	    /*
	    * The 4th character must be a digit 1..9 optionally followed by a ":"
	    */

	    if ( (p[3] < '1') || (p[3] > '9') ) {
		return 0;
	    }
	    if ( (len == 5) && (p[4] != ':') ) {
		return 0;
	    }
	    return 1;
	}

	/*
	 * 2. Look for //./com[0-9]+ or \\.\com[0-9]+
	 */

	if ( (len >= 8) && (
		   (strnicmp(p, "//./com", 7) == 0)
    if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) {
	/*
	 * Charaters 8..end must be a digits 0..9
	 */
		|| (strnicmp(p, "\\\\.\\com", 7) == 0) ) )
	{
	    /*
	    * Charaters 8..end must be a digits 0..9
	    */

	for (i=7; i<len; i++) {
	    if ((p[i] < '0') || (p[i] > '9')) {
		return 0;
	    }
	}
	return 1;
	    for ( i=7; i<len; i++ ) {
		if ( (p[i] < '0') || (p[i] > '9') ) {
		    return 0;
		}
	    }
	    return 1;
	}
    }
    return 0;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinConsole.c.

8
9
10
11
12
13
14



15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35


36
37
38
39
40
41
42
43
44
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
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







+
+
+



















-
-
+
+
-
-











-
-
-
-
-
-
-
-
-
-
-
-
-



















-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+














-
-
+
+
-




-
+















-
+












-
+
-


-
+




-
-
-




-
+

-
-
-







-
-
-
-
-






-
+


-
+



-
-
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+





-
+
-
-
-
+
+
-
-

-

-
+







-
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-




-
+

-
+





-
-
+
+
+
+
-
-
-
+
+
-







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"

#include <fcntl.h>
#include <io.h>

/*
 * The following variable is used to tell whether this module has been
 * initialized.
 */

static int initialized = 0;

/*
 * The consoleMutex locks around access to the initialized variable, and it is
 * used to protect background threads from being terminated while they are
 * using APIs that hold locks.
 */

TCL_DECLARE_MUTEX(consoleMutex)

/*
 * Bit masks used in the flags field of the ConsoleInfo structure below.
 */

#define CONSOLE_PENDING	 (1<<0)	/* Message is pending in the queue. */
#define CONSOLE_ASYNC	 (1<<1)	/* Channel is non-blocking. */
#define CONSOLE_PENDING	(1<<0)	/* Message is pending in the queue. */
#define CONSOLE_ASYNC	(1<<1)	/* Channel is non-blocking. */
#define CONSOLE_READ_OPS (1<<4)	/* Channel supports read-related ops. */
#define CONSOLE_RESET    (1<<5)	/* Console mode needs to be reset. */

/*
 * Bit masks used in the sharedFlags field of the ConsoleInfo structure below.
 */

#define CONSOLE_EOF	  (1<<2)  /* Console has reached EOF. */
#define CONSOLE_BUFFERED  (1<<3)  /* Data was read into a buffer by the reader
				   * thread. */

#define CONSOLE_BUFFER_SIZE (8*1024)

/*
 * Structure containing handles associated with one of the special console
 * threads.
 */

typedef struct {
    HANDLE thread;		/* Handle to reader or writer thread. */
    HANDLE readyEvent;		/* Manual-reset event to signal _to_ the main
				 * thread when the worker thread has finished
				 * waiting for its normal work to happen. */
    TclPipeThreadInfo *TI;	/* Thread info structure of writer and reader. */
} ConsoleThreadInfo;

/*
 * This structure describes per-instance data for a console based channel.
 */

typedef struct ConsoleInfo {
    HANDLE handle;
    int type;
    struct ConsoleInfo *nextPtr;/* Pointer to next registered console. */
    Tcl_Channel channel;	/* Pointer to channel structure. */
    int validMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which operations are valid on the file. */
    int watchMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which events should be reported. */
    int flags;			/* State flags, see above for a list. */
    Tcl_ThreadId threadId;	/* Thread to which events should be reported.
				 * This value is used by the reader/writer
				 * threads. */
    ConsoleThreadInfo writer;	/* A specialized thread for handling
				 * asynchronous writes to the console; the
				 * waiting starts when a control event is sent,
				 * and a reset event is sent back to the main
				 * thread when the write is done. */
    ConsoleThreadInfo reader;	/* A specialized thread for handling
				 * asynchronous reads from the console; the
    HANDLE writeThread;		/* Handle to writer thread. */
    HANDLE readThread;		/* Handle to reader thread. */
    HANDLE writable;		/* Manual-reset event to signal when the
				 * writer thread has finished waiting for the
				 * current buffer to be written. */
    HANDLE readable;		/* Manual-reset event to signal when the
				 * reader thread has finished waiting for
				 * input. */
    HANDLE startWriter;		/* Auto-reset event used by the main thread to
				 * signal when the writer thread should
				 * attempt to write to the console. */
    HANDLE stopWriter;		/* Auto-reset event used by the main thread to
				 * signal when the writer thread should exit */
    HANDLE startReader;		/* Auto-reset event used by the main thread to
				 * signal when the reader thread should
				 * attempt to read from the console. */
				 * waiting starts when a control event is sent,
				 * and a reset event is sent back to the main
				 * thread when input is available. */
    HANDLE stopReader;		/* Auto-reset event used by the main thread to
				 * signal when the reader thread should exit */
    DWORD writeError;		/* An error caused by the last background
				 * write. Set to 0 if no error has been
				 * detected. This word is shared with the
				 * writer thread so access must be
				 * synchronized with the writable object. */
    char *writeBuf;		/* Current background output buffer. Access is
				 * synchronized with the writable object. */
    int writeBufLen;		/* Size of write buffer. Access is
				 * synchronized with the writable object. */
    int toWrite;		/* Current amount to be written. Access is
				 * synchronized with the writable object. */
    int readFlags;		/* Flags that are shared with the reader
				 * thread. Access is synchronized with the
				 * readable object. */
    int bytesRead;		/* Number of bytes in the buffer. */
    int offset;			/* Number of bytes read out of the buffer. */
    int bytesRead;		/* number of bytes in the buffer */
    int offset;			/* number of bytes read out of the buffer */
    DWORD initMode;		/* Initial console mode. */
    char buffer[CONSOLE_BUFFER_SIZE];
				/* Data consumed by reader thread. */
} ConsoleInfo;

typedef struct {
typedef struct ThreadSpecificData {
    /*
     * The following pointer refers to the head of the list of consoles that
     * are being watched for file events.
     */

    ConsoleInfo *firstConsolePtr;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following structure is what is added to the Tcl event queue when
 * console events are generated.
 */

typedef struct {
typedef struct ConsoleEvent {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    ConsoleInfo *infoPtr;	/* Pointer to console info structure. Note
				 * that we still have to verify that the
				 * console exists before dereferencing this
				 * pointer. */
} ConsoleEvent;

/*
 * Declarations for functions used only in this file.
 */

static int		ConsoleBlockModeProc(ClientData instanceData,
static int		ConsoleBlockModeProc(ClientData instanceData,int mode);
			    int mode);
static void		ConsoleCheckProc(ClientData clientData, int flags);
static int		ConsoleCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
			    Tcl_Interp *interp);
static int		ConsoleEventProc(Tcl_Event *evPtr, int flags);
static void		ConsoleExitHandler(ClientData clientData);
static int		ConsoleGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static int		ConsoleGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_DString *dsPtr);
static void		ConsoleInit(void);
static int		ConsoleInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		ConsoleOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
			    CONST char *buf, int toWrite, int *errorCode);
static DWORD WINAPI	ConsoleReaderThread(LPVOID arg);
static int		ConsoleSetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
static void		ConsoleSetupProc(ClientData clientData, int flags);
static void		ConsoleWatchProc(ClientData instanceData, int mask);
static DWORD WINAPI	ConsoleWriterThread(LPVOID arg);
static void		ProcExitHandler(ClientData clientData);
static int		WaitForRead(ConsoleInfo *infoPtr, int blocking);
static void		ConsoleThreadActionProc(ClientData instanceData,
			    int action);
static BOOL		ReadConsoleBytes(HANDLE hConsole, LPVOID lpBuffer,
			    DWORD nbytes, LPDWORD nbytesread);
static BOOL		WriteConsoleBytes(HANDLE hConsole,
			    const void *lpBuffer, DWORD nbytes,
			    LPDWORD nbyteswritten);

/*
 * This structure describes the channel type structure for command console
 * based IO.
 */

static const Tcl_ChannelType consoleChannelType = {
static Tcl_ChannelType consoleChannelType = {
    "console",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    ConsoleCloseProc,		/* Close proc. */
    ConsoleInputProc,		/* Input proc. */
    ConsoleOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    ConsoleSetOptionProc,	/* Set option proc. */
    ConsoleGetOptionProc,	/* Get option proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    ConsoleWatchProc,		/* Set up notifier to watch the channel. */
    ConsoleGetHandleProc,	/* Get an OS handle from channel. */
    ConsoleCloseProc,		/* close2proc. */
    ConsoleBlockModeProc,	/* Set blocking or non-blocking mode. */
    NULL,			/* Flush proc. */
    NULL,			/* Handler proc. */
    NULL,			/* Wide seek proc. */
    ConsoleThreadActionProc,	/* Thread action proc. */
    NULL			/* Truncation proc. */
    NULL,			/* close2proc. */
    ConsoleBlockModeProc,	/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc */
    ConsoleThreadActionProc,    /* thread action proc */
    NULL,                       /* truncation */
};

/*
 *----------------------------------------------------------------------
 *
 * ReadConsoleBytes, WriteConsoleBytes --
 * readConsoleBytes, writeConsoleBytes --
 *
 *	Wrapper for ReadConsoleW, that takes and returns number of bytes
 *	instead of number of WCHARS.
 * Wrapper for ReadConsole{A,W}, that takes and returns number of bytes
 * instead of number of TCHARS
 *
 *----------------------------------------------------------------------
 */

static BOOL
ReadConsoleBytes(
readConsoleBytes(
    HANDLE hConsole,
    LPVOID lpBuffer,
    DWORD nbytes,
    LPDWORD nbytesread)
{
    DWORD ntchars;
    BOOL result;

    int tcharsize;
    /*
     * If user types a Ctrl-Break or Ctrl-C, ReadConsole will return
    tcharsize = tclWinProcs->useWide? 2 : 1;
    result = tclWinProcs->readConsoleProc(
     * success with ntchars == 0 and GetLastError() will be
     * ERROR_OPERATION_ABORTED. We do not want to treat this case
     * as EOF so we will loop around again. If no Ctrl signal handlers
     * have been established, the default signal OS handler in a separate
     * thread will terminate the program. If a Ctrl signal handler
     * has been established (through an extension for example), it
     * will run and take whatever action it deems appropriate.
     */
    do {
        result = ReadConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars,
	    hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
                             NULL);
    } while (result && ntchars == 0 && GetLastError() == ERROR_OPERATION_ABORTED);
    if (nbytesread != NULL) {
	*nbytesread = ntchars * sizeof(WCHAR);
    if (nbytesread)
	*nbytesread = (ntchars*tcharsize);
    }
    return result;
}

static BOOL
WriteConsoleBytes(
writeConsoleBytes(
    HANDLE hConsole,
    const void *lpBuffer,
    const VOID *lpBuffer,
    DWORD nbytes,
    LPDWORD nbyteswritten)
{
    DWORD ntchars;
    BOOL result;

    result = WriteConsoleW(hConsole, lpBuffer, nbytes / sizeof(WCHAR), &ntchars,
    int tcharsize;
    tcharsize = tclWinProcs->useWide? 2 : 1;
    result = tclWinProcs->writeConsoleProc(
	    hConsole, lpBuffer, nbytes / tcharsize, &ntchars, NULL);
	    NULL);
    if (nbyteswritten != NULL) {
	*nbyteswritten = ntchars * sizeof(WCHAR);
    if (nbyteswritten)
	*nbyteswritten = (ntchars*tcharsize);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleInit --
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
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







+
+














-
-
+
+
+
-







 *
 *----------------------------------------------------------------------
 */

static void
ConsoleInit(void)
{
    ThreadSpecificData *tsdPtr;

    /*
     * Check the initialized flag first, then check again in the mutex. This
     * is a speed enhancement.
     */

    if (!initialized) {
	Tcl_MutexLock(&consoleMutex);
	if (!initialized) {
	    initialized = 1;
	    Tcl_CreateExitHandler(ProcExitHandler, NULL);
	}
	Tcl_MutexUnlock(&consoleMutex);
    }

    if (TclThreadDataKeyGet(&dataKey) == NULL) {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);

	tsdPtr->firstConsolePtr = NULL;
	Tcl_CreateEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
	Tcl_CreateThreadExitHandler(ConsoleExitHandler, NULL);
    }
}

/*
313
314
315
316
317
318
319
320

321
322
323
324
325
326
327
282
283
284
285
286
287
288

289
290
291
292
293
294
295
296







-
+







 *	Removes the console event source.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleExitHandler(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Old window proc */
{
    Tcl_DeleteEventSource(ConsoleSetupProc, ConsoleCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *
337
338
339
340
341
342
343
344

345
346
347
348
349
350
351
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320







-
+







 *	Resets the process list.
 *
 *----------------------------------------------------------------------
 */

static void
ProcExitHandler(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Old window proc */
{
    Tcl_MutexLock(&consoleMutex);
    initialized = 0;
    Tcl_MutexUnlock(&consoleMutex);
}

/*
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
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







-
+


















-
+
-







 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
ConsoleSetupProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleInfo *infoPtr;
    Tcl_Time blockTime = { 0, 0 };
    int block = 1;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Look to see if any events are already pending. If they are, poll.
     */

    for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->watchMask & TCL_WRITABLE) {
	    if (WaitForSingleObject(infoPtr->writer.readyEvent,
	    if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
		    0) != WAIT_TIMEOUT) {
		block = 0;
	    }
	}
	if (infoPtr->watchMask & TCL_READABLE) {
	    if (WaitForRead(infoPtr, 0) >= 0) {
		block = 0;
	    }
417
418
419
420
421
422
423
424

425
426
427

428
429
430
431
432
433
434
385
386
387
388
389
390
391

392
393
394
395
396
397
398
399
400
401
402
403







-
+



+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
ConsoleCheckProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    ConsoleInfo *infoPtr;
    ConsoleEvent *evPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

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
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







-
+
-











-
-

+






+








	/*
	 * Queue an event if the console is signaled for reading or writing.
	 */

	needEvent = 0;
	if (infoPtr->watchMask & TCL_WRITABLE) {
	    if (WaitForSingleObject(infoPtr->writer.readyEvent,
	    if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
		    0) != WAIT_TIMEOUT) {
		needEvent = 1;
	    }
	}

	if (infoPtr->watchMask & TCL_READABLE) {
	    if (WaitForRead(infoPtr, 0) >= 0) {
		needEvent = 1;
	    }
	}

	if (needEvent) {
	    ConsoleEvent *evPtr = (ConsoleEvent *)Tcl_Alloc(sizeof(ConsoleEvent));

	    infoPtr->flags |= CONSOLE_PENDING;
	    evPtr = (ConsoleEvent *) ckalloc(sizeof(ConsoleEvent));
	    evPtr->header.proc = ConsoleEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}


/*
 *----------------------------------------------------------------------
 *
 * ConsoleBlockModeProc --
 *
 *	Set blocking or non-blocking mode on channel.
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
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







-
+












-
+








static int
ConsoleBlockModeProc(
    ClientData instanceData,	/* Instance data for channel. */
    int mode)			/* TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;

    /*
     * Consoles on Windows can not be switched between blocking and
     * nonblocking, hence we have to emulate the behavior. This is done in the
     * input function by checking against a bit in the state. We set or unset
     * the bit here to cause the input function to emulate the correct
     * behavior.
     */

    if (mode == TCL_MODE_NONBLOCKING) {
	infoPtr->flags |= CONSOLE_ASYNC;
    } else {
	infoPtr->flags &= ~CONSOLE_ASYNC;
	infoPtr->flags &= ~(CONSOLE_ASYNC);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
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
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
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624










625
626
627
628
629
630
631







-
+
-

-
-
+
+


-
+
-
-
-
+
+







-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+



-
+


-
+


+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-







 *
 *----------------------------------------------------------------------
 */

static int
ConsoleCloseProc(
    ClientData instanceData,	/* Pointer to ConsoleInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp)		/* For error reporting. */
    int flags)
{
    ConsoleInfo *consolePtr = (ConsoleInfo *)instanceData;
    int errorCode = 0;
    ConsoleInfo *consolePtr = (ConsoleInfo *) instanceData;
    int errorCode;
    ConsoleInfo *infoPtr, **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    DWORD exitCode;
    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }

    errorCode = 0;

    /*
     * Clean up the background thread if necessary. Note that this must be
     * done before we can close the file, since the thread may be blocking
     * trying to read from the console.
     */

    if (consolePtr->reader.thread) {
	TclPipeThreadStop(&consolePtr->reader.TI, consolePtr->reader.thread);
	CloseHandle(consolePtr->reader.thread);
	CloseHandle(consolePtr->reader.readyEvent);
	consolePtr->reader.thread = NULL;
    if (consolePtr->readThread) {
	/*
	 * The thread may already have closed on it's own. Check it's exit
	 * code.
	 */

	GetExitCodeThread(consolePtr->readThread, &exitCode);

	if (exitCode == STILL_ACTIVE) {
	    /*
	     * Set the stop event so that if the reader thread is blocked in
	     * ConsoleReaderThread on WaitForMultipleEvents, it will exit
	     * cleanly.
	     */

	    SetEvent(consolePtr->stopReader);

	    /*
	     * Wait at most 20 milliseconds for the reader thread to close.
	     */

	    if (WaitForSingleObject(consolePtr->readThread, 20)
		    == WAIT_TIMEOUT) {
		/*
		 * Forcibly terminate the background thread as a last resort.
		 * Note that we need to guard against terminating the thread
		 * while it is in the middle of Tcl_ThreadAlert because it
		 * won't be able to release the notifier lock.
		 */

		Tcl_MutexLock(&consoleMutex);

		/* BUG: this leaks memory. */
		TerminateThread(consolePtr->readThread, 0);
		Tcl_MutexUnlock(&consoleMutex);
	    }
	}

	CloseHandle(consolePtr->readThread);
	CloseHandle(consolePtr->readable);
	CloseHandle(consolePtr->startReader);
	CloseHandle(consolePtr->stopReader);
	consolePtr->readThread = NULL;
    }
    consolePtr->validMask &= ~TCL_READABLE;

    /*
     * Wait for the writer thread to finish the current buffer, then terminate
     * the thread and close the handles. If the channel is nonblocking, there
     * should be no pending write operations.
     */

    if (consolePtr->writer.thread) {
    if (consolePtr->writeThread) {
	if (consolePtr->toWrite) {
	    /*
	     * We only need to wait if there is something to write. This may
	     * prevent infinite wait on exit. [Python Bug 216289]
	     * prevent infinite wait on exit. [python bug 216289]
	     */

	    WaitForSingleObject(consolePtr->writer.readyEvent, 5000);
	    WaitForSingleObject(consolePtr->writable, INFINITE);
	}

	/*
	 * The thread may already have closed on it's own. Check it's exit
	 * code.
	 */
	TclPipeThreadStop(&consolePtr->writer.TI, consolePtr->writer.thread);
	CloseHandle(consolePtr->writer.thread);
	CloseHandle(consolePtr->writer.readyEvent);
	consolePtr->writer.thread = NULL;

	GetExitCodeThread(consolePtr->writeThread, &exitCode);

	if (exitCode == STILL_ACTIVE) {
	    /*
	     * Set the stop event so that if the reader thread is blocked in
	     * ConsoleWriterThread on WaitForMultipleEvents, it will exit
	     * cleanly.
	     */

	    SetEvent(consolePtr->stopWriter);

	    /*
	     * Wait at most 20 milliseconds for the writer thread to close.
	     */

	    if (WaitForSingleObject(consolePtr->writeThread, 20)
		    == WAIT_TIMEOUT) {
		/*
		 * Forcibly terminate the background thread as a last resort.
		 * Note that we need to guard against terminating the thread
		 * while it is in the middle of Tcl_ThreadAlert because it
		 * won't be able to release the notifier lock.
		 */

		Tcl_MutexLock(&consoleMutex);

		/* BUG: this leaks memory. */
		TerminateThread(consolePtr->writeThread, 0);
		Tcl_MutexUnlock(&consoleMutex);
	    }
	}

	CloseHandle(consolePtr->writeThread);
	CloseHandle(consolePtr->writable);
	CloseHandle(consolePtr->startWriter);
	CloseHandle(consolePtr->stopWriter);
	consolePtr->writeThread = NULL;
    }
    consolePtr->validMask &= ~TCL_WRITABLE;

    /*
     * If the user has been tinkering with the mode, reset it now. We ignore
     * any errors from this; we're quite possibly about to close or exit
     * anyway.
     */

    if ((consolePtr->flags & CONSOLE_READ_OPS) &&
	    (consolePtr->flags & CONSOLE_RESET)) {
	SetConsoleMode(consolePtr->handle, consolePtr->initMode);
    }

    /*
     * Don't close the Win32 handle if the handle is a standard channel during
     * the thread exit process. Otherwise, one thread may kill the stdio of
     * another.
     */

609
610
611
612
613
614
615
616

617
618
619

620
621
622
623
624
625

626
627
628

629
630
631
632
633
634
635
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







-
+


-
+





-
+


-
+








    consolePtr->watchMask &= consolePtr->validMask;

    /*
     * Remove the file from the list of watched files.
     */

    for (nextPtrPtr = &tsdPtr->firstConsolePtr, infoPtr = *nextPtrPtr;
    for (nextPtrPtr = &(tsdPtr->firstConsolePtr), infoPtr = *nextPtrPtr;
	    infoPtr != NULL;
	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
	if (infoPtr == (ConsoleInfo *) consolePtr) {
	if (infoPtr == (ConsoleInfo *)consolePtr) {
	    *nextPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    if (consolePtr->writeBuf != NULL) {
	Tcl_Free(consolePtr->writeBuf);
	ckfree(consolePtr->writeBuf);
	consolePtr->writeBuf = 0;
    }
    Tcl_Free(consolePtr);
    ckfree((char*) consolePtr);

    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
652
653
654
655
656
657
658
659

660
661
662
663
664
665
666
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698







-
+







ConsoleInputProc(
    ClientData instanceData,	/* Console state. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
    DWORD count, bytesRead = 0;
    int result;

    *errorCode = 0;

    /*
     * Synchronize with the reader thread.
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
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







-
+



-
+



-
+















-
-
+
+
-
-
-
-
-
-
-








    if (infoPtr->readFlags & CONSOLE_BUFFERED) {
	/*
	 * Data is stored in the buffer.
	 */

	if (bufSize < (infoPtr->bytesRead - infoPtr->offset)) {
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
	    bytesRead = bufSize;
	    infoPtr->offset += bufSize;
	} else {
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], bufSize);
	    memcpy(buf, &infoPtr->buffer[infoPtr->offset], (size_t) bufSize);
	    bytesRead = infoPtr->bytesRead - infoPtr->offset;

	    /*
	     * Reset the buffer.
	     * Reset the buffer
	     */

	    infoPtr->readFlags &= ~CONSOLE_BUFFERED;
	    infoPtr->offset = 0;
	}

	return bytesRead;
    }

    /*
     * Attempt to read bufSize bytes. The read will return immediately if
     * there is any data available. Otherwise it will block until at least one
     * byte is available or an EOF occurs.
     */

    if (ReadConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize,
	    &count) == TRUE) {
    if (readConsoleBytes(infoPtr->handle, (LPVOID) buf, (DWORD) bufSize, &count)
	    == TRUE) {
	/*
	 * TODO: This potentially writes beyond the limits specified
	 * by the caller.  In practice this is harmless, since all writes
	 * are into ChannelBuffers, and those have padding, but still
	 * ought to remove this, unless some Windows wizard can give
	 * a reason not to.
	 */
	buf[count] = '\0';
	return count;
    }

    return -1;
}

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
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







-
+



-
+
-



-
-
-
+
-
-
+





-
+







 *
 *----------------------------------------------------------------------
 */

static int
ConsoleOutputProc(
    ClientData instanceData,	/* Console state. */
    const char *buf,		/* The data buffer. */
    CONST char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
    ConsoleThreadInfo *threadInfo = &infoPtr->writer;
    DWORD bytesWritten, timeout;

    *errorCode = 0;

    /* avoid blocking if pipe-thread exited */
    timeout = (infoPtr->flags & CONSOLE_ASYNC) || !TclPipeThreadIsAlive(&threadInfo->TI)
    timeout = (infoPtr->flags & CONSOLE_ASYNC) ? 0 : INFINITE;
	|| TclInExit() || TclInThreadExit() ? 0 : INFINITE;
    if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) {
    if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
	/*
	 * The writer thread is blocked waiting for a write to complete and
	 * the channel is in non-blocking mode.
	 */

	errno = EWOULDBLOCK;
	errno = EAGAIN;
	goto error;
    }

    /*
     * Check for a background error on the last write.
     */

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
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







-
+


-
+

-
+

-
-
+
+







-
-
+
+
+








	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
	    infoPtr->writeBuf = ckalloc((size_t)toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	memcpy(infoPtr->writeBuf, buf, (size_t)toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(threadInfo->readyEvent);
	TclPipeThreadSignal(&threadInfo->TI);
	ResetEvent(infoPtr->writable);
	SetEvent(infoPtr->startWriter);
	bytesWritten = toWrite;
    } else {
	/*
	 * In the blocking case, just try to write the buffer directly. This
	 * avoids an unnecessary copy.
	 */

	if (WriteConsoleBytes(infoPtr->handle, buf, (DWORD) toWrite,
		&bytesWritten) == FALSE) {
	if (writeConsoleBytes(infoPtr->handle, buf, (DWORD)toWrite,
			      &bytesWritten)
		== FALSE) {
	    TclWinConvertError(GetLastError());
	    goto error;
	}
    }
    return bytesWritten;

  error:
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
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







-
+


















-
+




















-
+
-








static int
ConsoleEventProc(
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    ConsoleEvent *consoleEvPtr = (ConsoleEvent *) evPtr;
    ConsoleEvent *consoleEvPtr = (ConsoleEvent *)evPtr;
    ConsoleInfo *infoPtr;
    int mask;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }

    /*
     * Search through the list of watched consoles for the one whose handle
     * matches the event. We do this rather than simply dereferencing the
     * handle in the event so that consoles can be deleted while the event is
     * in the queue.
     */

    for (infoPtr = tsdPtr->firstConsolePtr; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if (consoleEvPtr->infoPtr == infoPtr) {
	    infoPtr->flags &= ~CONSOLE_PENDING;
	    infoPtr->flags &= ~(CONSOLE_PENDING);
	    break;
	}
    }

    /*
     * Remove stale events.
     */

    if (!infoPtr) {
	return 1;
    }

    /*
     * Check to see if the console is readable. Note that we can't tell if a
     * console is writable, so we always report it as being writable unless we
     * have detected EOF.
     */

    mask = 0;
    if (infoPtr->watchMask & TCL_WRITABLE) {
	if (WaitForSingleObject(infoPtr->writer.readyEvent,
	if (WaitForSingleObject(infoPtr->writable, 0) != WAIT_TIMEOUT) {
		0) != WAIT_TIMEOUT) {
	    mask = TCL_WRITABLE;
	}
    }

    if (infoPtr->watchMask & TCL_READABLE) {
	if (WaitForRead(infoPtr, 0) >= 0) {
	    if (infoPtr->readFlags & CONSOLE_EOF) {
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
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







-
+











-







ConsoleWatchProc(
    ClientData instanceData,	/* Console state. */
    int mask)			/* What events to watch for, OR-ed combination
				 * of TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    ConsoleInfo **nextPtrPtr, *ptr;
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;
    int oldMask = infoPtr->watchMask;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Since most of the work is handled by the background threads, we just
     * need to update the watchMask and then force the notifier to poll once.
     */

    infoPtr->watchMask = mask & infoPtr->validMask;
    if (infoPtr->watchMask) {
	Tcl_Time blockTime = { 0, 0 };

	if (!oldMask) {
	    infoPtr->nextPtr = tsdPtr->firstConsolePtr;
	    tsdPtr->firstConsolePtr = infoPtr;
	}
	Tcl_SetMaxBlockTime(&blockTime);
    } else if (oldMask) {
	/*
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







-
+


-
+

-
+







 *
 *----------------------------------------------------------------------
 */

static int
ConsoleGetHandleProc(
    ClientData instanceData,	/* The console state. */
    TCL_UNUSED(int) /*direction*/,
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;

    *handlePtr = infoPtr->handle;
    *handlePtr = (ClientData) infoPtr->handle;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * WaitForRead --
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
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







-
+
-







-
+
-
-
-
+





-
+
















-
+







static int
WaitForRead(
    ConsoleInfo *infoPtr,	/* Console state. */
    int blocking)		/* Indicates whether call should be blocking
				 * or not. */
{
    DWORD timeout, count;
    HANDLE *handle = (HANDLE *)infoPtr->handle;
    HANDLE *handle = infoPtr->handle;
    ConsoleThreadInfo *threadInfo = &infoPtr->reader;
    INPUT_RECORD input;

    while (1) {
	/*
	 * Synchronize with the reader thread.
	 */

	/* avoid blocking if pipe-thread exited */
	timeout = blocking ? INFINITE : 0;
	timeout = (!blocking || !TclPipeThreadIsAlive(&threadInfo->TI)
		|| TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
	if (WaitForSingleObject(threadInfo->readyEvent, timeout) == WAIT_TIMEOUT) {
	if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
	    /*
	     * The reader thread is blocked waiting for data and the channel
	     * is in non-blocking mode.
	     */

	    errno = EWOULDBLOCK;
	    errno = EAGAIN;
	    return -1;
	}

	/*
	 * At this point, the two threads are synchronized, so it is safe to
	 * access shared state.
	 */

	/*
	 * If the console has hit EOF, it is always readable.
	 */

	if (infoPtr->readFlags & CONSOLE_EOF) {
	    return 1;
	}

	if (PeekConsoleInputW(handle, &input, 1, &count) == FALSE) {
	if (PeekConsoleInput(handle, &input, 1, &count) == FALSE) {
	    /*
	     * Check to see if the peek failed because of EOF.
	     */

	    TclWinConvertError(GetLastError());

	    if (errno == EOF) {
1092
1093
1094
1095
1096
1097
1098
1099
1100


1101
1102
1103
1104
1105
1106
1107
1109
1110
1111
1112
1113
1114
1115


1116
1117
1118
1119
1120
1121
1122
1123
1124







-
-
+
+







	    return 1;
	}

	/*
	 * There wasn't any data available, so reset the thread and try again.
	 */

	ResetEvent(threadInfo->readyEvent);
	TclPipeThreadSignal(&threadInfo->TI);
	ResetEvent(infoPtr->readable);
	SetEvent(infoPtr->startReader);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleReaderThread --
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
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
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







-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

-
+


-
+
-
-
-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+






-
+







+
-
+

-
+


-







-
+













-





-
-
-







 *----------------------------------------------------------------------
 */

static DWORD WINAPI
ConsoleReaderThread(
    LPVOID arg)
{
    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
    ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */
    HANDLE *handle = NULL;
    ConsoleThreadInfo *threadInfo = NULL;
    int done = 0;
    ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
    HANDLE *handle = infoPtr->handle;
    DWORD waitResult;
    HANDLE wEvents[2];

    /* The first event takes precedence. */
    wEvents[0] = infoPtr->stopReader;
    wEvents[1] = infoPtr->startReader;

    while (!done) {
    for (;;) {
	/*
	 * Wait for the main thread to signal before attempting to read.
	 * Wait for the main thread to signal before attempting to wait.
	 */

	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
	    /* exit */
	    break;
	}
	if (!infoPtr) {

	if (waitResult != (WAIT_OBJECT_0 + 1)) {
	    infoPtr = (ConsoleInfo *)pipeTI->clientData;
	    handle = (HANDLE *)infoPtr->handle;
	    threadInfo = &infoPtr->reader;
	}

	    /*
	     * The start event was not signaled. It must be the stop event or
	     * an error, so exit this thread.
	     */

	    break;
	}

	/*
	 * Look for data on the console, but first ignore any events that are
	 * not KEY_EVENTs.
	 */

	if (ReadConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
	if (readConsoleBytes(handle, infoPtr->buffer, CONSOLE_BUFFER_SIZE,
		(LPDWORD) &infoPtr->bytesRead) != FALSE) {
	    /*
	     * Data was stored in the buffer.
	     */

	    infoPtr->readFlags |= CONSOLE_BUFFERED;
	} else {
	    DWORD err;
	    DWORD err = GetLastError();
	    err = GetLastError();

	    if (err == (DWORD) EOF) {
	    if (err == (DWORD)EOF) {
		infoPtr->readFlags = CONSOLE_EOF;
	    }
	    done = 1;
	}

	/*
	 * Signal the main thread by signalling the readable event and then
	 * waking up the notifier thread.
	 */

	SetEvent(threadInfo->readyEvent);
	SetEvent(infoPtr->readable);

	/*
	 * Alert the foreground thread. Note that we need to treat this like a
	 * critical section so the foreground thread does not terminate this
	 * thread while we are holding a mutex in the notifier code.
	 */

	Tcl_MutexLock(&consoleMutex);
	if (infoPtr->threadId != NULL) {
	    /*
	     * TIP #218. When in flight ignore the event, no one will receive
	     * it anyway.
	     */

	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&consoleMutex);
    }

    /* Worker exit, so inform the main thread or free TI-structure (if owned) */
    TclPipeThreadExit(&pipeTI);

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleWriterThread --
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
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
1385
1386
1387

1388




1389
1390
1391
1392
1393
1394
1395
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
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



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







-
-
-
+
+
+
-
-
+

+
-
+
+
+
+

-
+



-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+










-
-
+
+

-

-
-
-
+
+
+
+







-
+



















-
-
-
















-
+












-
+







-
+
















-
+


-
+








-
-
+
-




-
-
+
+
+
+
-
-
-
+
+



-
-
-
+
+
+
+
-
-
-
+
+









+
-
+
+
+
+







 *----------------------------------------------------------------------
 */

static DWORD WINAPI
ConsoleWriterThread(
    LPVOID arg)
{
    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
    ConsoleInfo *infoPtr = NULL; /* access info only after success init/wait */
    HANDLE *handle = NULL;

    ConsoleInfo *infoPtr = (ConsoleInfo *)arg;
    HANDLE *handle = infoPtr->handle;
    ConsoleThreadInfo *threadInfo = NULL;
    DWORD count, toWrite;
    DWORD count, toWrite, waitResult;
    char *buf;
    HANDLE wEvents[2];
    int done = 0;

    /* The first event takes precedence. */
    wEvents[0] = infoPtr->stopWriter;
    wEvents[1] = infoPtr->startWriter;

    while (!done) {
    for (;;) {
	/*
	 * Wait for the main thread to signal before attempting to write.
	 */
	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
	    /* exit */

	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
	    break;
	}
	if (!infoPtr) {
	    infoPtr = (ConsoleInfo *)pipeTI->clientData;
	    handle = (HANDLE *)infoPtr->handle;
	    threadInfo = &infoPtr->writer;

	if (waitResult != (WAIT_OBJECT_0 + 1)) {
	    /*
	     * The start event was not signaled. It must be the stop event or
	     * an error, so exit this thread.
	     */

	    break;
	}

	buf = infoPtr->writeBuf;
	toWrite = infoPtr->toWrite;

	/*
	 * Loop until all of the bytes are written or an error occurs.
	 */

	while (toWrite > 0) {
	    if (WriteConsoleBytes(handle, buf, (DWORD) toWrite,
		    &count) == FALSE) {
	    if (writeConsoleBytes(handle, buf, (DWORD)toWrite,
				  &count) == FALSE) {
		infoPtr->writeError = GetLastError();
		done = 1;
		break;
	    }
	    toWrite -= count;
	    buf += count;
	    } else {
		toWrite -= count;
		buf += count;
	    }
	}

	/*
	 * Signal the main thread by signalling the writable event and then
	 * waking up the notifier thread.
	 */

	SetEvent(threadInfo->readyEvent);
	SetEvent(infoPtr->writable);

	/*
	 * Alert the foreground thread. Note that we need to treat this like a
	 * critical section so the foreground thread does not terminate this
	 * thread while we are holding a mutex in the notifier code.
	 */

	Tcl_MutexLock(&consoleMutex);
	if (infoPtr->threadId != NULL) {
	    /*
	     * TIP #218. When in flight ignore the event, no one will receive
	     * it anyway.
	     */

	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&consoleMutex);
    }

    /* Worker exit, so inform the main thread or free TI-structure (if owned) */
    TclPipeThreadExit(&pipeTI);

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinOpenConsoleChannel --
 *
 *	Constructs a Console channel for the specified standard OS handle.
 *	This is a helper function to break up the construction of channels
 *	into File, Console, or Serial.
 *
 * Results:
 *	Returns the new channel, or NULL.
 *
 * Side effects:
 *	May open the channel.
 *	May open the channel
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
TclWinOpenConsoleChannel(
    HANDLE handle,
    char *channelName,
    int permissions)
{
    char encoding[4 + TCL_INTEGER_SPACE];
    ConsoleInfo *infoPtr;
    DWORD modes;
    DWORD id, modes;

    ConsoleInit();

    /*
     * See if a channel with this handle already exists.
     */

    infoPtr = (ConsoleInfo *)Tcl_Alloc(sizeof(ConsoleInfo));
    infoPtr = (ConsoleInfo *) ckalloc((unsigned) sizeof(ConsoleInfo));
    memset(infoPtr, 0, sizeof(ConsoleInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;

    wsprintfA(encoding, "cp%d", GetConsoleCP());

    infoPtr->threadId = Tcl_GetCurrentThread();

    /*
     * Use the pointer for the name of the result channel. This keeps the
     * channel names unique, since some may share handles (stdin/stdout/stderr
     * for instance).
     */

    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t)infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
	    infoPtr, permissions);
	    (ClientData) infoPtr, permissions);

    if (permissions & TCL_READABLE) {
	/*
	 * Make sure the console input buffer is ready for only character
	 * input notifications and the buffer is set for line buffering. IOW,
	 * we only want to catch when complete lines are ready for reading.
	 */

	infoPtr->flags |= CONSOLE_READ_OPS;
	GetConsoleMode(infoPtr->handle, &infoPtr->initMode);
	GetConsoleMode(infoPtr->handle, &modes);
	modes = infoPtr->initMode;
	modes &= ~(ENABLE_WINDOW_INPUT | ENABLE_MOUSE_INPUT);
	modes |= ENABLE_LINE_INPUT;
	SetConsoleMode(infoPtr->handle, modes);

	infoPtr->reader.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->reader.thread = CreateThread(NULL, 256, ConsoleReaderThread,
	infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
	infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->stopReader = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->readThread = CreateThread(NULL, 256, ConsoleReaderThread,
		TclPipeThreadCreateTI(&infoPtr->reader.TI, infoPtr,
			infoPtr->reader.readyEvent), 0, NULL);
	SetThreadPriority(infoPtr->reader.thread, THREAD_PRIORITY_HIGHEST);
		infoPtr, 0, &id);
	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
    }

    if (permissions & TCL_WRITABLE) {

	infoPtr->writer.readyEvent = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->writer.thread = CreateThread(NULL, 256, ConsoleWriterThread,
	infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
	infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->stopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->writeThread = CreateThread(NULL, 256, ConsoleWriterThread,
		TclPipeThreadCreateTI(&infoPtr->writer.TI, infoPtr,
			infoPtr->writer.readyEvent), 0, NULL);
	SetThreadPriority(infoPtr->writer.thread, THREAD_PRIORITY_HIGHEST);
		infoPtr, 0, &id);
	SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
    }

    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.
     */

    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
    if (tclWinProcs->useWide)
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "utf-16");
	Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
    else
	Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);

    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleThreadActionProc --
1406
1407
1408
1409
1410
1411
1412
1413

1414
1415
1416

1417
1418
1419
1420
1421
1422
1423
1427
1428
1429
1430
1431
1432
1433

1434
1435


1436
1437
1438
1439
1440
1441
1442
1443







-
+

-
-
+







 */

static void
ConsoleThreadActionProc(
    ClientData instanceData,
    int action)
{
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    ConsoleInfo *infoPtr = (ConsoleInfo *) instanceData;

    /*
     * We do not access firstConsolePtr in the thread structures. This is not
    /* We do not access firstConsolePtr in the thread structures. This is not
     * for all serials managed by the thread, but only those we are watching.
     * Removal of the filevent handlers before transfer thus takes care of
     * this structure.
     */

    Tcl_MutexLock(&consoleMutex);
    if (action == TCL_CHANNEL_THREAD_INSERT) {
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
1454
1455
1456
1457
1458
1459
1460















































































































































































































1461
1462
1463
1464
1465
1466
1467
1468







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	    infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
	}
    } else {
	infoPtr->threadId = NULL;
    }
    Tcl_MutexUnlock(&consoleMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleSetOptionProc --
 *
 *	Sets an option on a channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the interp's result on error if
 *	interp is not NULL.
 *
 * Side effects:
 *	May modify an option on a console. Sets Error message if needed (by
 *	calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleSetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
{
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    int len = strlen(optionName);
    int vlen = strlen(value);

    /*
     * Option -inputmode normal|password|raw
     */

    if ((infoPtr->flags & CONSOLE_READ_OPS) && (len > 1) &&
	    (strncmp(optionName, "-inputmode", len) == 0)) {
	DWORD mode;

	if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
	    TclWinConvertError(GetLastError());
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read console mode: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	if (Tcl_UtfNcasecmp(value, "NORMAL", vlen) == 0) {
	    mode |= ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT;
	} else if (Tcl_UtfNcasecmp(value, "PASSWORD", vlen) == 0) {
	    mode |= ENABLE_LINE_INPUT;
	    mode &= ~ENABLE_ECHO_INPUT;
	} else if (Tcl_UtfNcasecmp(value, "RAW", vlen) == 0) {
	    mode &= ~(ENABLE_ECHO_INPUT | ENABLE_LINE_INPUT);
	} else if (Tcl_UtfNcasecmp(value, "RESET", vlen) == 0) {
	    /*
	     * Reset to the initial mode, whatever that is.
	     */

	    mode = infoPtr->initMode;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad mode \"%s\" for -inputmode: must be"
			" normal, password, raw, or reset", value));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    return TCL_ERROR;
	}
	if (SetConsoleMode(infoPtr->handle, mode) == 0) {
	    TclWinConvertError(GetLastError());
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set console mode: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}

	/*
	 * If we've changed the mode from default, schedule a reset later.
	 */

	if (mode == infoPtr->initMode) {
	    infoPtr->flags &= ~CONSOLE_RESET;
	} else {
	    infoPtr->flags |= CONSOLE_RESET;
	}
	return TCL_OK;
    }

    if (infoPtr->flags & CONSOLE_READ_OPS) {
	return Tcl_BadChannelOption(interp, optionName, "inputmode");
    } else {
	return Tcl_BadChannelOption(interp, optionName, "");
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ConsoleGetOptionProc --
 *
 *	Gets a mode associated with an IO channel. If the optionName arg is
 *	non-NULL, retrieves the value of that option. If the optionName arg is
 *	NULL, retrieves a list of alternating option names and values for the
 *	given channel.
 *
 * Results:
 *	A standard Tcl result. Also sets the supplied DString to the string
 *	value of the option(s) returned.  Sets error message if needed
 *	(by calling Tcl_BadChannelOption).
 *
 *----------------------------------------------------------------------
 */

static int
ConsoleGetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    ConsoleInfo *infoPtr = (ConsoleInfo *)instanceData;
    int valid = 0;		/* Flag if valid option parsed. */
    unsigned int len;
    char buf[TCL_INTEGER_SPACE];

    if (optionName == NULL) {
	len = 0;
    } else {
	len = strlen(optionName);
    }

    /*
     * Get option -inputmode
     *
     * This is a great simplification of the underlying reality, but actually
     * represents what almost all scripts really want to know.
     */

    if (infoPtr->flags & CONSOLE_READ_OPS) {
	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-inputmode");
	}
	if (len==0 || (len>1 && strncmp(optionName, "-inputmode", len)==0)) {
	    DWORD mode;

	    valid = 1;
	    if (GetConsoleMode(infoPtr->handle, &mode) == 0) {
		TclWinConvertError(GetLastError());
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "couldn't read console mode: %s",
			    Tcl_PosixError(interp)));
		}
		return TCL_ERROR;
	    }
	    if (mode & ENABLE_LINE_INPUT) {
		if (mode & ENABLE_ECHO_INPUT) {
		    Tcl_DStringAppendElement(dsPtr, "normal");
		} else {
		    Tcl_DStringAppendElement(dsPtr, "password");
		}
	    } else {
		Tcl_DStringAppendElement(dsPtr, "raw");
	    }
	}
    }

    /*
     * Get option -winsize
     * Option is readonly and returned by [fconfigure chan -winsize] but not
     * returned by [fconfigure chan] without explicit option name.
     */

    if ((len > 1) && (strncmp(optionName, "-winsize", len) == 0)) {
	CONSOLE_SCREEN_BUFFER_INFO consoleInfo;

	valid = 1;
	if (!GetConsoleScreenBufferInfo(infoPtr->handle, &consoleInfo)) {
	    TclWinConvertError(GetLastError());
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read console size: %s",
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	sprintf(buf, "%d",
		consoleInfo.srWindow.Right - consoleInfo.srWindow.Left + 1);
	Tcl_DStringAppendElement(dsPtr, buf);
	sprintf(buf, "%d",
		consoleInfo.srWindow.Bottom - consoleInfo.srWindow.Top + 1);
	Tcl_DStringAppendElement(dsPtr, buf);
    }

    if (valid) {
	return TCL_OK;
    }
    if (infoPtr->flags & CONSOLE_READ_OPS) {
	return Tcl_BadChannelOption(interp, optionName, "inputmode winsize");
    } else {
	return Tcl_BadChannelOption(interp, optionName, "");
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

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
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













+
+




-
+







/*
 * 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"
#include "tclPort.h"

/*
 * The following table contains the mapping from Win32 errors to errno errors.
 */

static const unsigned char errorTable[] = {
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 */
287
288
289
290
291
292
293
294

295
296
297
298
299
300
301
289
290
291
292
293
294
295

296
297
298
299
300
301
302
303







-
+







};

/*
 * The following table contains the mapping from WinSock errors to
 * errno errors.
 */

static const unsigned char wsaErrorTable[] = {
static CONST int wsaErrorTable[] = {
    EWOULDBLOCK,	/* WSAEWOULDBLOCK */
    EINPROGRESS,	/* WSAEINPROGRESS */
    EALREADY,		/* WSAEALREADY */
    ENOTSOCK,		/* WSAENOTSOCK */
    EDESTADDRREQ,	/* WSAEDESTADDRREQ */
    EMSGSIZE,		/* WSAEMSGSIZE */
    EPROTOTYPE,		/* WSAEPROTOTYPE */
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
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







-
+

-
+

-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








 *	Sets the errno global variable.
 *
 *----------------------------------------------------------------------
 */

void
TclWinConvertError(
    int errCode)		/* Win32 error code. */
    DWORD errCode)		/* Win32 error code. */
{
    if ((unsigned)errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
    if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
	errCode -= WSAEWOULDBLOCK;
	if ((unsigned)errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
	if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
	    Tcl_SetErrno(errorTable[1]);
	} else {
	    Tcl_SetErrno(wsaErrorTable[errCode]);
	}
    } 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(
    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 * 3];

	vsnprintf(buf, sizeof(buf), format, argList);
	msgString[TCL_MAX_WARN_LEN-1] = '\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] != '\0') {
	    memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
	}
	OutputDebugStringW(msgString);
    } else {
	if (!isatty(fileno(stderr))) {
	    fprintf(stderr, "\xef\xbb\xbf");
	}
	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/tclWinFCmd.c.

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
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







-
+




-
+











-
+










-
-
-
+
+
+



-
-
-
+
+
+

-
-
+
+







    WIN_SYSTEM_ATTRIBUTE
};

static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN,
	0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM};


const char *const tclpFileAttrStrings[] = {
CONST char *tclpFileAttrStrings[] = {
	"-archive", "-hidden", "-longname", "-readonly",
	"-shortname", "-system", (char *) NULL
};

const TclFileAttrProcs tclpFileAttrProcs[] = {
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
	{GetWinFileAttributes, SetWinFileAttributes},
	{GetWinFileAttributes, SetWinFileAttributes},
	{GetWinFileLongName, CannotSetAttribute},
	{GetWinFileAttributes, SetWinFileAttributes},
	{GetWinFileShortName, CannotSetAttribute},
	{GetWinFileAttributes, SetWinFileAttributes}};

/*
 * Prototype for the TraverseWinTree callback function.
 */

typedef int (TraversalProc)(const WCHAR *srcPtr, const WCHAR *dstPtr,
typedef int (TraversalProc)(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
	int type, Tcl_DString *errorPtr);

/*
 * Declarations for local functions defined in this file:
 */

static void		StatError(Tcl_Interp *interp, Tcl_Obj *fileName);
static int		ConvertFileNameFormat(Tcl_Interp *interp,
			    int objIndex, Tcl_Obj *fileName, int longShort,
			    Tcl_Obj **attributePtrPtr);
static int		DoCopyFile(const WCHAR *srcPtr, const WCHAR *dstPtr);
static int		DoCreateDirectory(const WCHAR *pathPtr);
static int		DoRemoveJustDirectory(const WCHAR *nativeSrc,
static int		DoCopyFile(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr);
static int		DoCreateDirectory(CONST TCHAR *pathPtr);
static int		DoRemoveJustDirectory(CONST TCHAR *nativeSrc,
			    int ignoreError, Tcl_DString *errorPtr);
static int		DoRemoveDirectory(Tcl_DString *pathPtr, int recursive,
			    Tcl_DString *errorPtr);
static int		DoRenameFile(const WCHAR *nativeSrc,
			    const WCHAR *dstPtr);
static int		TraversalCopy(const WCHAR *srcPtr, const WCHAR *dstPtr,
static int		DoRenameFile(CONST TCHAR *nativeSrc,
			    CONST TCHAR *dstPtr);
static int		TraversalCopy(CONST TCHAR *srcPtr, CONST TCHAR *dstPtr,
			    int type, Tcl_DString *errorPtr);
static int		TraversalDelete(const WCHAR *srcPtr,
			    const WCHAR *dstPtr, int type,
static int		TraversalDelete(CONST TCHAR *srcPtr,
			    CONST TCHAR *dstPtr, int type,
			    Tcl_DString *errorPtr);
static int		TraverseWinTree(TraversalProc *traverseProc,
			    Tcl_DString *sourcePtr, Tcl_DString *dstPtr,
			    Tcl_DString *errorPtr);

/*
 *---------------------------------------------------------------------------
141
142
143
144
145
146
147
148
149


150
151
152
153
154

155
156

157
158
159
160
161
162
163
141
142
143
144
145
146
147


148
149
150
151
152
153

154
155

156
157
158
159
160
161
162
163







-
-
+
+




-
+

-
+







 */

int
TclpObjRenameFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    return DoRenameFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr),
	    (const WCHAR *)Tcl_FSGetNativePath(destPathPtr));
    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
	    Tcl_FSGetNativePath(destPathPtr));
}

static int
DoRenameFile(
    const WCHAR *nativeSrc,	/* Pathname of file or dir to be renamed
    CONST TCHAR *nativeSrc,	/* Pathname of file or dir to be renamed
				 * (native). */
    const WCHAR *nativeDst)	/* New pathname for file or directory
    CONST TCHAR *nativeDst)	/* New pathname for file or directory
				 * (native). */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
    TCLEXCEPTION_REGISTRATION registration;
#endif
    DWORD srcAttr, dstAttr;
    int retval = -1;
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
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







-
+









-
+




-
+








	"leal	    %[registration], %%edx"	    "\n\t"
	"movl	    %%fs:0,	    %%eax"	    "\n\t"
	"movl	    %%eax,	    0x0(%%edx)"	    "\n\t" /* link */
	"leal	    1f,		    %%eax"	    "\n\t"
	"movl	    %%eax,	    0x4(%%edx)"	    "\n\t" /* handler */
	"movl	    %%ebp,	    0x8(%%edx)"	    "\n\t" /* ebp */
	"movl	    %%esp,	    0xC(%%edx)"	    "\n\t" /* esp */
	"movl	    %%esp,	    0xc(%%edx)"	    "\n\t" /* esp */
	"movl	    $0,		    0x10(%%edx)"    "\n\t" /* status */

	/*
	 * Link the TCLEXCEPTION_REGISTRATION on the chain.
	 */

	"movl	    %%edx,	    %%fs:0"	    "\n\t"

	/*
	 * Call MoveFileW(nativeSrc, nativeDst)
	 * Call MoveFile(nativeSrc, nativeDst)
	 */

	"pushl	    %%ebx"			    "\n\t"
	"pushl	    %%ecx"			    "\n\t"
	"movl	    %[moveFileW],    %%eax"	    "\n\t"
	"movl	    %[moveFile],    %%eax"	    "\n\t"
	"call	    *%%eax"			    "\n\t"

	/*
	 * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and
	 * put the status return from MoveFile into it.
	 */

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
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







-
+










-
+










-
+













-
-
-
-
+
+
+
+






-
-
+
+














-
-
+
+




-
+

-
+




-
+




-
-
+
+

-
-
-
-
+
+







-
+








	/*
	 * Come here however we exited. Restore context from the
	 * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
	 */

	"2:"					    "\t"
	"movl	    0xC(%%edx),	    %%esp"	    "\n\t"
	"movl	    0xc(%%edx),	    %%esp"	    "\n\t"
	"movl	    0x8(%%edx),	    %%ebp"	    "\n\t"
	"movl	    0x0(%%edx),	    %%eax"	    "\n\t"
	"movl	    %%eax,	    %%fs:0"	    "\n\t"

	:
	/* No outputs */
	:
	[registration]	"m"	(registration),
	[nativeDst]	"m"	(nativeDst),
	[nativeSrc]	"m"	(nativeSrc),
	[moveFileW]	"r"	(MoveFileW)
	[moveFile]	"r"	(tclWinProcs->moveFileProc)
	:
	"%eax", "%ebx", "%ecx", "%edx", "memory"
	);
    if (registration.status != FALSE) {
	retval = TCL_OK;
    }
#else
#ifndef HAVE_NO_SEH
    __try {
#endif
	if ((*MoveFileW)(nativeSrc, nativeDst) != FALSE) {
	if ((*tclWinProcs->moveFileProc)(nativeSrc, nativeDst) != FALSE) {
	    retval = TCL_OK;
	}
#ifndef HAVE_NO_SEH
    } __except (EXCEPTION_EXECUTE_HANDLER) {}
#endif
#endif

    if (retval != -1) {
	return retval;
    }

    TclWinConvertError(GetLastError());

    srcAttr = GetFileAttributesW(nativeSrc);
    dstAttr = GetFileAttributesW(nativeDst);
    if (srcAttr == 0xFFFFFFFF) {
	if (GetFullPathNameW(nativeSrc, 0, NULL,
    srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
    dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
    if (srcAttr == 0xffffffff) {
	if ((*tclWinProcs->getFullPathNameProc)(nativeSrc, 0, NULL,
		NULL) >= MAX_PATH) {
	    errno = ENAMETOOLONG;
	    return TCL_ERROR;
	}
	srcAttr = 0;
    }
    if (dstAttr == 0xFFFFFFFF) {
	if (GetFullPathNameW(nativeDst, 0, NULL,
    if (dstAttr == 0xffffffff) {
	if ((*tclWinProcs->getFullPathNameProc)(nativeDst, 0, NULL,
		NULL) >= MAX_PATH) {
	    errno = ENAMETOOLONG;
	    return TCL_ERROR;
	}
	dstAttr = 0;
    }

    if (errno == EBADF) {
	errno = EACCES;
	return TCL_ERROR;
    }
    if (errno == EACCES) {
    decode:
	if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) {
	    WCHAR *nativeSrcRest, *nativeDstRest;
	    const char **srcArgv, **dstArgv;
	    TCHAR *nativeSrcRest, *nativeDstRest;
	    CONST char **srcArgv, **dstArgv;
	    int size, srcArgc, dstArgc;
	    WCHAR nativeSrcPath[MAX_PATH];
	    WCHAR nativeDstPath[MAX_PATH];
	    Tcl_DString srcString, dstString;
	    const char *src, *dst;
	    CONST char *src, *dst;

	    size = GetFullPathNameW(nativeSrc, MAX_PATH,
	    size = (*tclWinProcs->getFullPathNameProc)(nativeSrc, MAX_PATH,
		    nativeSrcPath, &nativeSrcRest);
	    if ((size == 0) || (size > MAX_PATH)) {
		return TCL_ERROR;
	    }
	    size = GetFullPathNameW(nativeDst, MAX_PATH,
	    size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
		    nativeDstPath, &nativeDstRest);
	    if ((size == 0) || (size > MAX_PATH)) {
		return TCL_ERROR;
	    }
	    CharLowerW(nativeSrcPath);
	    CharLowerW(nativeDstPath);
	    (*tclWinProcs->charLowerProc)((TCHAR *) nativeSrcPath);
	    (*tclWinProcs->charLowerProc)((TCHAR *) nativeDstPath);

	    Tcl_DStringInit(&srcString);
	    Tcl_DStringInit(&dstString);
	    src = Tcl_WCharToUtfDString(nativeSrcPath, -1, &srcString);
	    dst = Tcl_WCharToUtfDString(nativeDstPath, -1, &dstString);
	    src = Tcl_WinTCharToUtf((TCHAR *) nativeSrcPath, -1, &srcString);
	    dst = Tcl_WinTCharToUtf((TCHAR *) nativeDstPath, -1, &dstString);

	    /*
	     * Check whether the destination path is actually inside the
	     * source path. This is true if the prefix matches, and the next
	     * character is either end-of-string or a directory separator
	     */

	    if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0)
	    if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
		    && (dst[Tcl_DStringLength(&srcString)] == '\\'
		    || dst[Tcl_DStringLength(&srcString)] == '/'
		    || dst[Tcl_DStringLength(&srcString)] == '\0')) {
		/*
		 * Trying to move a directory into itself.
		 */

374
375
376
377
378
379
380
381
382


383
384
385
386
387
388
389
372
373
374
375
376
377
378


379
380
381
382
383
384
385
386
387







-
-
+
+







		 * The MoveFile system call already handles the case of moving
		 * a file between filesystems.
		 */

		Tcl_SetErrno(EXDEV);
	    }

	    Tcl_Free((void *)srcArgv);
	    Tcl_Free((void *)dstArgv);
	    ckfree((char *) srcArgv);
	    ckfree((char *) dstArgv);
	}

	/*
	 * Other types of access failure is that dst is a read-only
	 * filesystem, that an open file referred to src or dest, or that src
	 * or dest specified the current working directory on the current
	 * filesystem. EACCES is returned for those cases.
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
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







-
+










-
-
+
+







		if (DoRemoveJustDirectory(nativeDst, 0, NULL) == TCL_OK) {
		    /*
		     * Now that that empty directory is gone, we can try
		     * renaming again. If that fails, we'll put this empty
		     * directory back, for completeness.
		     */

		    if (MoveFileW(nativeSrc,
		    if ((*tclWinProcs->moveFileProc)(nativeSrc,
			    nativeDst) != FALSE) {
			return TCL_OK;
		    }

		    /*
		     * Some new error has occurred. Don't know what it could
		     * be, but report this one.
		     */

		    TclWinConvertError(GetLastError());
		    CreateDirectoryW(nativeDst, NULL);
		    SetFileAttributesW(nativeDst, dstAttr);
		    (*tclWinProcs->createDirectoryProc)(nativeDst, NULL);
		    (*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
		    if (Tcl_GetErrno() == EACCES) {
			/*
			 * Decode the EACCES to a more meaningful error.
			 */

			goto decode;
		    }
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
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







-
+



-
+




-
-
+
+
+


-
-
-
+
+
+
+







-
-
-
-
-
-
+
+
+
+
+
+
+
+
+


-
-
+
+







		 *
		 * 1. Rename existing file to temp name.
		 * 2. Rename old file to new name.
		 * 3. If success, delete temp file. If failure, put temp file
		 *    back to old name.
		 */

		WCHAR *nativeRest, *nativeTmp, *nativePrefix;
		TCHAR *nativeRest, *nativeTmp, *nativePrefix;
		int result, size;
		WCHAR tempBuf[MAX_PATH];

		size = GetFullPathNameW(nativeDst, MAX_PATH,
		size = (*tclWinProcs->getFullPathNameProc)(nativeDst, MAX_PATH,
			tempBuf, &nativeRest);
		if ((size == 0) || (size > MAX_PATH) || (nativeRest == NULL)) {
		    return TCL_ERROR;
		}
		nativeTmp = (WCHAR *) tempBuf;
		nativeRest[0] = '\0';
		nativeTmp = (TCHAR *) tempBuf;
		((char *) nativeRest)[0] = '\0';
		((char *) nativeRest)[1] = '\0';    /* In case it's Unicode. */

		result = TCL_ERROR;
		nativePrefix = (WCHAR *)L"tclr";
		if (GetTempFileNameW(nativeTmp, nativePrefix,
			0, tempBuf) != 0) {
		nativePrefix = (tclWinProcs->useWide)
			? (TCHAR *) L"tclr" : (TCHAR *) "tclr";
		if ((*tclWinProcs->getTempFileNameProc)(nativeTmp,
			nativePrefix, 0, tempBuf) != 0) {
		    /*
		     * Strictly speaking, need the following DeleteFile and
		     * MoveFile to be joined as an atomic operation so no
		     * other app comes along in the meantime and creates the
		     * same temp file.
		     */

		    nativeTmp = tempBuf;
		    DeleteFileW(nativeTmp);
		    if (MoveFileW(nativeDst, nativeTmp) != FALSE) {
			if (MoveFileW(nativeSrc, nativeDst) != FALSE) {
			    SetFileAttributesW(nativeTmp, FILE_ATTRIBUTE_NORMAL);
			    DeleteFileW(nativeTmp);
		    nativeTmp = (TCHAR *) tempBuf;
		    (*tclWinProcs->deleteFileProc)(nativeTmp);
		    if ((*tclWinProcs->moveFileProc)(nativeDst,
			    nativeTmp) != FALSE) {
			if ((*tclWinProcs->moveFileProc)(nativeSrc,
				nativeDst) != FALSE) {
			    (*tclWinProcs->setFileAttributesProc)(nativeTmp,
				    FILE_ATTRIBUTE_NORMAL);
			    (*tclWinProcs->deleteFileProc)(nativeTmp);
			    return TCL_OK;
			} else {
			    DeleteFileW(nativeDst);
			    MoveFileW(nativeTmp, nativeDst);
			    (*tclWinProcs->deleteFileProc)(nativeDst);
			    (*tclWinProcs->moveFileProc)(nativeTmp, nativeDst);
			}
		    }

		    /*
		     * Can't backup dst file or move src file. Return that
		     * error. Could happen if an open file refers to dst.
		     */
532
533
534
535
536
537
538
539
540


541
542
543
544
545
546


547
548
549
550
551
552
553
535
536
537
538
539
540
541


542
543
544
545
546
547


548
549
550
551
552
553
554
555
556







-
-
+
+




-
-
+
+







 */

int
TclpObjCopyFile(
    Tcl_Obj *srcPathPtr,
    Tcl_Obj *destPathPtr)
{
    return DoCopyFile((const WCHAR *)Tcl_FSGetNativePath(srcPathPtr),
	    (const WCHAR *)Tcl_FSGetNativePath(destPathPtr));
    return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
	    Tcl_FSGetNativePath(destPathPtr));
}

static int
DoCopyFile(
    const WCHAR *nativeSrc,	/* Pathname of file to be copied (native). */
    const WCHAR *nativeDst)	/* Pathname of file to copy to (native). */
    CONST TCHAR *nativeSrc,	/* Pathname of file to be copied (native). */
    CONST TCHAR *nativeDst)	/* Pathname of file to copy to (native). */
{
#if defined(HAVE_NO_SEH) && !defined(_WIN64)
    TCLEXCEPTION_REGISTRATION registration;
#endif
    int retval = -1;

    /*
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
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
618
619







-
+









-
+


-
+








	"leal	    %[registration], %%edx"	    "\n\t"
	"movl	    %%fs:0,	    %%eax"	    "\n\t"
	"movl	    %%eax,	    0x0(%%edx)"	    "\n\t" /* link */
	"leal	    1f,		    %%eax"	    "\n\t"
	"movl	    %%eax,	    0x4(%%edx)"	    "\n\t" /* handler */
	"movl	    %%ebp,	    0x8(%%edx)"	    "\n\t" /* ebp */
	"movl	    %%esp,	    0xC(%%edx)"	    "\n\t" /* esp */
	"movl	    %%esp,	    0xc(%%edx)"	    "\n\t" /* esp */
	"movl	    $0,		    0x10(%%edx)"    "\n\t" /* status */

	/*
	 * Link the TCLEXCEPTION_REGISTRATION on the chain.
	 */

	"movl	    %%edx,	    %%fs:0"	    "\n\t"

	/*
	 * Call CopyFileW(nativeSrc, nativeDst, 0)
	 * Call CopyFile(nativeSrc, nativeDst, 0)
	 */

	"movl	    %[copyFileW],    %%eax"	    "\n\t"
	"movl	    %[copyFile],    %%eax"	    "\n\t"
	"pushl	    $0"				    "\n\t"
	"pushl	    %%ebx"			    "\n\t"
	"pushl	    %%ecx"			    "\n\t"
	"call	    *%%eax"			    "\n\t"

	/*
	 * Come here on normal exit. Recover the TCLEXCEPTION_REGISTRATION and
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
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
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
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







-
+










-
+










-
+



















-
-
-
-
+
+
+
+













-
+

-
+










-
+








	/*
	 * Come here however we exited. Restore context from the
	 * TCLEXCEPTION_REGISTRATION in case the stack is unbalanced.
	 */

	"2:"					    "\t"
	"movl	    0xC(%%edx),	    %%esp"	    "\n\t"
	"movl	    0xc(%%edx),	    %%esp"	    "\n\t"
	"movl	    0x8(%%edx),	    %%ebp"	    "\n\t"
	"movl	    0x0(%%edx),	    %%eax"	    "\n\t"
	"movl	    %%eax,	    %%fs:0"	    "\n\t"

	:
	/* No outputs */
	:
	[registration]	"m"	(registration),
	[nativeDst]	"m"	(nativeDst),
	[nativeSrc]	"m"	(nativeSrc),
	[copyFileW]	"r"	(CopyFileW)
	[copyFile]	"r"	(tclWinProcs->copyFileProc)
	:
	"%eax", "%ebx", "%ecx", "%edx", "memory"
	);
    if (registration.status != FALSE) {
	retval = TCL_OK;
    }
#else
#ifndef HAVE_NO_SEH
    __try {
#endif
	if (CopyFileW(nativeSrc, nativeDst, 0) != FALSE) {
	if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst, 0) != FALSE) {
	    retval = TCL_OK;
	}
#ifndef HAVE_NO_SEH
    } __except (EXCEPTION_EXECUTE_HANDLER) {}
#endif
#endif

    if (retval != -1) {
	return retval;
    }

    TclWinConvertError(GetLastError());
    if (Tcl_GetErrno() == EBADF) {
	Tcl_SetErrno(EACCES);
	return TCL_ERROR;
    }
    if (Tcl_GetErrno() == EACCES) {
	DWORD srcAttr, dstAttr;

	srcAttr = GetFileAttributesW(nativeSrc);
	dstAttr = GetFileAttributesW(nativeDst);
	if (srcAttr != 0xFFFFFFFF) {
	    if (dstAttr == 0xFFFFFFFF) {
	srcAttr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
	dstAttr = (*tclWinProcs->getFileAttributesProc)(nativeDst);
	if (srcAttr != 0xffffffff) {
	    if (dstAttr == 0xffffffff) {
		dstAttr = 0;
	    }
	    if ((srcAttr & FILE_ATTRIBUTE_DIRECTORY) ||
		    (dstAttr & FILE_ATTRIBUTE_DIRECTORY)) {
		if (srcAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
		    /* Source is a symbolic link -- copy it */
		    if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst)==0) {
			return TCL_OK;
		    }
		}
		Tcl_SetErrno(EISDIR);
	    }
	    if (dstAttr & FILE_ATTRIBUTE_READONLY) {
		SetFileAttributesW(nativeDst,
		(*tclWinProcs->setFileAttributesProc)(nativeDst,
			dstAttr & ~((DWORD)FILE_ATTRIBUTE_READONLY));
		if (CopyFileW(nativeSrc, nativeDst,
		if ((*tclWinProcs->copyFileProc)(nativeSrc, nativeDst,
			0) != FALSE) {
		    return TCL_OK;
		}

		/*
		 * Still can't copy onto dst. Return that error, and restore
		 * attributes of dst.
		 */

		TclWinConvertError(GetLastError());
		SetFileAttributesW(nativeDst, dstAttr);
		(*tclWinProcs->setFileAttributesProc)(nativeDst, dstAttr);
	    }
	}
    }
    return TCL_ERROR;
}

/*
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
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







-
+


-






-
+




-
+





-
-
+
+





-
+













-
-
+
+

-
-
+
+




-
+




-
-
+
+







    Tcl_Obj *pathPtr)
{
    return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr));
}

int
TclpDeleteFile(
    const void *nativePath)	/* Pathname of file to be removed (native). */
    CONST TCHAR *nativePath)	/* Pathname of file to be removed (native). */
{
    DWORD attr;
    const WCHAR *path = (const WCHAR *)nativePath;

    /*
     * The DeleteFile API acts differently under Win95/98 and NT WRT NULL and
     * "". Avoid passing these values.
     */

    if (path == NULL || path[0] == '\0') {
    if (nativePath == NULL || nativePath[0] == '\0') {
	Tcl_SetErrno(ENOENT);
	return TCL_ERROR;
    }

    if (DeleteFileW(path) != FALSE) {
    if ((*tclWinProcs->deleteFileProc)(nativePath) != FALSE) {
	return TCL_OK;
    }
    TclWinConvertError(GetLastError());

    if (Tcl_GetErrno() == EACCES) {
	attr = GetFileAttributesW(path);
	if (attr != 0xFFFFFFFF) {
	attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
	if (attr != 0xffffffff) {
	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
		if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
		    /*
		     * It is a symbolic link - remove it.
		     */
		    if (TclWinSymLinkDelete(path, 0) == 0) {
		    if (TclWinSymLinkDelete(nativePath, 0) == 0) {
			return TCL_OK;
		    }
		}

		/*
		 * If we fall through here, it is a directory.
		 *
		 * Windows NT reports removing a directory as EACCES instead
		 * of EISDIR.
		 */

		Tcl_SetErrno(EISDIR);
	    } else if (attr & FILE_ATTRIBUTE_READONLY) {
		int res = SetFileAttributesW(path,
			attr & ~((DWORD) FILE_ATTRIBUTE_READONLY));
		int res = (*tclWinProcs->setFileAttributesProc)(nativePath,
			attr & ~((DWORD)FILE_ATTRIBUTE_READONLY));

		if ((res != 0) &&
			(DeleteFileW(path) != FALSE)) {
		if ((res != 0) && ((*tclWinProcs->deleteFileProc)(nativePath)
			!= FALSE)) {
		    return TCL_OK;
		}
		TclWinConvertError(GetLastError());
		if (res != 0) {
		    SetFileAttributesW(path, attr);
		    (*tclWinProcs->setFileAttributesProc)(nativePath, attr);
		}
	    }
	}
    } else if (Tcl_GetErrno() == ENOENT) {
	attr = GetFileAttributesW(path);
	if (attr != 0xFFFFFFFF) {
	attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
	if (attr != 0xffffffff) {
	    if (attr & FILE_ATTRIBUTE_DIRECTORY) {
		/*
		 * Windows 95 reports removing a directory as ENOENT instead
		 * of EISDIR.
		 */

		Tcl_SetErrno(EISDIR);
852
853
854
855
856
857
858
859

860
861
862
863
864

865

866
867


868
869
870
871
872
873
874
875
854
855
856
857
858
859
860

861
862
863
864
865

866
867
868


869
870

871
872
873
874
875
876
877







-
+




-
+

+
-
-
+
+
-







 *---------------------------------------------------------------------------
 */

int
TclpObjCreateDirectory(
    Tcl_Obj *pathPtr)
{
    return DoCreateDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr));
    return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr));
}

static int
DoCreateDirectory(
    const WCHAR *nativePath)	/* Pathname of directory to create (native). */
    CONST TCHAR *nativePath)	/* Pathname of directory to create (native). */
{
    DWORD error;
    if (CreateDirectoryW(nativePath, NULL) == 0) {
	DWORD error = GetLastError();
    if ((*tclWinProcs->createDirectoryProc)(nativePath, NULL) == 0) {
	error = GetLastError();

	TclWinConvertError(error);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
909
910
911
912
913
914
915
916
917
918
919


920
921
922
923
924
925
926
911
912
913
914
915
916
917




918
919
920
921
922
923
924
925
926







-
-
-
-
+
+








    normSrcPtr = Tcl_FSGetNormalizedPath(NULL,srcPathPtr);
    normDestPtr = Tcl_FSGetNormalizedPath(NULL,destPathPtr);
    if ((normSrcPtr == NULL) || (normDestPtr == NULL)) {
	return TCL_ERROR;
    }

    Tcl_DStringInit(&srcString);
    Tcl_DStringInit(&dstString);
    Tcl_UtfToWCharDString(TclGetString(normSrcPtr), -1, &srcString);
    Tcl_UtfToWCharDString(TclGetString(normDestPtr), -1, &dstString);
    Tcl_WinUtfToTChar(Tcl_GetString(normSrcPtr), -1, &srcString);
    Tcl_WinUtfToTChar(Tcl_GetString(normDestPtr), -1, &dstString);

    ret = TraverseWinTree(TraversalCopy, &srcString, &dstString, &ds);

    Tcl_DStringFree(&srcString);
    Tcl_DStringFree(&dstString);

    if (ret != TCL_OK) {
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
1065
1066
1067
1068
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
1065
1066
1067







-
-
+



-
+



-
+
+




-
+











-
+
















-
+
-


-
+













-
+







-
-
+
+







	 */

	Tcl_DString native;
	normPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (normPtr == NULL) {
	    return TCL_ERROR;
	}
	Tcl_DStringInit(&native);
	Tcl_UtfToWCharDString(TclGetString(normPtr), -1, &native);
	Tcl_WinUtfToTChar(Tcl_GetString(normPtr), -1, &native);
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory((const WCHAR *)Tcl_FSGetNativePath(pathPtr), 0, &ds);
	ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
	if (Tcl_DStringLength(&ds) > 0) {
	int len = Tcl_DStringLength(&ds);
	if (len > 0) {
	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
	    } else {
		*errorPtr = TclDStringToObj(&ds);
		*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
	    }
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }

    return ret;
}

static int
DoRemoveJustDirectory(
    const WCHAR *nativePath,	/* Pathname of directory to be removed
    CONST TCHAR *nativePath,	/* Pathname of directory to be removed
				 * (native). */
    int ignoreError,		/* If non-zero, don't initialize the errorPtr
				 * under some circumstances on return. */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    DWORD attr;

    /*
     * The RemoveDirectory API acts differently under Win95/98 and NT WRT NULL
     * and "". Avoid passing these values.
     */

    if (nativePath == NULL || nativePath[0] == '\0') {
	Tcl_SetErrno(ENOENT);
	Tcl_DStringInit(errorPtr);
	goto end;
	return TCL_ERROR;
    }

    attr = GetFileAttributesW(nativePath);
    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);

    if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
	/*
	 * It is a symbolic link - remove it.
	 */
	if (TclWinSymLinkDelete(nativePath, 0) == 0) {
	    return TCL_OK;
	}
    } else {
	/*
	 * Ordinary directory.
	 */

	if (RemoveDirectoryW(nativePath) != FALSE) {
	if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
	    return TCL_OK;
	}
    }

    TclWinConvertError(GetLastError());

    if (Tcl_GetErrno() == EACCES) {
	attr = GetFileAttributesW(nativePath);
	if (attr != 0xFFFFFFFF) {
	attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
	if (attr != 0xffffffff) {
	    if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
		/*
		 * Windows 95 reports calling RemoveDirectory on a file as an
		 * EACCES, not an ENOTDIR.
		 */

		Tcl_SetErrno(ENOTDIR);
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
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
1140
1141
1142
1143







-
+



-
+



-
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







		if (TclWinSymLinkDelete(nativePath, 1) != 0) {
		    goto end;
		}
	    }

	    if (attr & FILE_ATTRIBUTE_READONLY) {
		attr &= ~FILE_ATTRIBUTE_READONLY;
		if (SetFileAttributesW(nativePath,
		if ((*tclWinProcs->setFileAttributesProc)(nativePath,
			attr) == FALSE) {
		    goto end;
		}
		if (RemoveDirectoryW(nativePath) != FALSE) {
		if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
		    return TCL_OK;
		}
		TclWinConvertError(GetLastError());
		SetFileAttributesW(nativePath,
		(*tclWinProcs->setFileAttributesProc)(nativePath,
			attr | FILE_ATTRIBUTE_READONLY);
	    }

	    /*
	     * Windows 95 and Win32s report removing a non-empty directory as
	     * EACCES, not EEXIST. If the directory is not empty, change errno
	     * so caller knows what's going on.
	     */

	    if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
		CONST char *path, *find;
		HANDLE handle;
		WIN32_FIND_DATAA data;
		Tcl_DString buffer;
		int len;

		path = (CONST char *) nativePath;

		Tcl_DStringInit(&buffer);
		len = strlen(path);
		find = Tcl_DStringAppend(&buffer, path, len);
		if ((len > 0) && (find[len - 1] != '\\')) {
		    Tcl_DStringAppend(&buffer, "\\", 1);
		}
		find = Tcl_DStringAppend(&buffer, "*.*", 3);
		handle = FindFirstFileA(find, &data);
		if (handle != INVALID_HANDLE_VALUE) {
		    while (1) {
			if ((strcmp(data.cFileName, ".") != 0)
				&& (strcmp(data.cFileName, "..") != 0)) {
			    /*
			     * Found something in this directory.
			     */

			    Tcl_SetErrno(EEXIST);
			    break;
			}
			if (FindNextFileA(handle, &data) == FALSE) {
			    break;
			}
		    }
		    FindClose(handle);
		}
		Tcl_DStringFree(&buffer);
	    }
	}
    }

    if (Tcl_GetErrno() == ENOTEMPTY) {
	/*
	 * The caller depends on EEXIST to signify that the directory is not
	 * empty, not ENOTEMPTY.
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
1140

1141
1142
1143
1144
1145
1146
1147
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







-
-
+
+
-



















-
+







	 */
	return TCL_ERROR;
    }

  end:
    if (errorPtr != NULL) {
	char *p;

	Tcl_DStringInit(errorPtr);
	Tcl_WinTCharToUtf(nativePath, -1, errorPtr);
	p = Tcl_DStringValue(errorPtr);
	p = Tcl_WCharToUtfDString(nativePath, -1, errorPtr);
	for (; *p; ++p) {
	    if (*p == '\\') *p = '/';
	}
    }
    return TCL_ERROR;

}

static int
DoRemoveDirectory(
    Tcl_DString *pathPtr,	/* Pathname of directory to be removed
				 * (native). */
    int recursive,		/* If non-zero, removes directories that are
				 * nonempty. Otherwise, will only remove empty
				 * directories. */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    int res = DoRemoveJustDirectory((const WCHAR *)Tcl_DStringValue(pathPtr), recursive,
    int res = DoRemoveJustDirectory(Tcl_DStringValue(pathPtr), recursive,
	    errorPtr);

    if ((res == TCL_ERROR) && (recursive != 0) && (Tcl_GetErrno() == EEXIST)) {
	/*
	 * The directory is nonempty, but the recursive flag has been
	 * specified, so we recursively remove all the files in the directory.
	 */
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
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
1348
1349
1350
1351
1352
1353
1354
1355







-
+


-
+



-
+

-
-
+
+



-
-
+
+









-
+








-
+


+
-
-
-
-
-
+
+
+
+
+
+
+
+










-
+

-
+






-
-
-
+
+
+
+
+
+
+
+
+
+




+
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
+
+


+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







				 * parallel with source directory (native),
				 * may be NULL. */
    Tcl_DString *errorPtr)	/* If non-NULL, uninitialized or free DString
				 * filled with UTF-8 name of file causing
				 * error. */
{
    DWORD sourceAttr;
    WCHAR *nativeSource, *nativeTarget, *nativeErrfile;
    TCHAR *nativeSource, *nativeTarget, *nativeErrfile;
    int result, found, sourceLen, targetLen = 0, oldSourceLen, oldTargetLen;
    HANDLE handle;
    WIN32_FIND_DATAW data;
    WIN32_FIND_DATAT data;

    nativeErrfile = NULL;
    result = TCL_OK;
    oldTargetLen = 0;
    oldTargetLen = 0;		/* lint. */

    nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr);
    nativeTarget = (WCHAR *)
    nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
    nativeTarget = (TCHAR *)
	    (targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr));

    oldSourceLen = Tcl_DStringLength(sourcePtr);
    sourceAttr = GetFileAttributesW(nativeSource);
    if (sourceAttr == 0xFFFFFFFF) {
    sourceAttr = (*tclWinProcs->getFileAttributesProc)(nativeSource);
    if (sourceAttr == 0xffffffff) {
	nativeErrfile = nativeSource;
	goto end;
    }

    if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
	/*
	 * Process the symbolic link
	 */

	return traverseProc(nativeSource, nativeTarget, DOTREE_LINK,
	return (*traverseProc)(nativeSource, nativeTarget, DOTREE_LINK,
		errorPtr);
    }

    if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
	/*
	 * Process the regular file
	 */

	return traverseProc(nativeSource, nativeTarget, DOTREE_F, errorPtr);
	return (*traverseProc)(nativeSource, nativeTarget, DOTREE_F, errorPtr);
    }

    if (tclWinProcs->useWide) {
    Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
    Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);

    nativeSource = (WCHAR *) Tcl_DStringValue(sourcePtr);
    handle = FindFirstFileW(nativeSource, &data);
	Tcl_DStringAppend(sourcePtr, (char *) L"\\*.*", 4 * sizeof(WCHAR) + 1);
	Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
    } else {
	Tcl_DStringAppend(sourcePtr, "\\*.*", 4);
    }

    nativeSource = (TCHAR *) Tcl_DStringValue(sourcePtr);
    handle = (*tclWinProcs->findFirstFileProc)(nativeSource, &data);
    if (handle == INVALID_HANDLE_VALUE) {
	/*
	 * Can't read directory.
	 */

	TclWinConvertError(GetLastError());
	nativeErrfile = nativeSource;
	goto end;
    }

    Tcl_DStringSetLength(sourcePtr, oldSourceLen + 1);
    nativeSource[oldSourceLen + 1] = '\0';
    Tcl_DStringSetLength(sourcePtr, oldSourceLen);
    result = traverseProc(nativeSource, nativeTarget, DOTREE_PRED,
    result = (*traverseProc)(nativeSource, nativeTarget, DOTREE_PRED,
	    errorPtr);
    if (result != TCL_OK) {
	FindClose(handle);
	return result;
    }

    sourceLen = oldSourceLen + sizeof(WCHAR);
    Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
    Tcl_DStringSetLength(sourcePtr, sourceLen);
    sourceLen = oldSourceLen;

    if (tclWinProcs->useWide) {
	sourceLen += sizeof(WCHAR);
	Tcl_DStringAppend(sourcePtr, (char *) L"\\", sizeof(WCHAR) + 1);
	Tcl_DStringSetLength(sourcePtr, sourceLen);
    } else {
	sourceLen += 1;
	Tcl_DStringAppend(sourcePtr, "\\", 1);
    }
    if (targetPtr != NULL) {
	oldTargetLen = Tcl_DStringLength(targetPtr);

	targetLen = oldTargetLen;
	if (tclWinProcs->useWide) {
	targetLen += sizeof(WCHAR);
	Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
	Tcl_DStringSetLength(targetPtr, targetLen);
    }

	    targetLen += sizeof(WCHAR);
	    Tcl_DStringAppend(targetPtr, (char *) L"\\", sizeof(WCHAR) + 1);
	    Tcl_DStringSetLength(targetPtr, targetLen);
	} else {
	    targetLen += 1;
	    Tcl_DStringAppend(targetPtr, "\\", 1);
	}
    }

    found = 1;
    for (; found; found = FindNextFileW(handle, &data)) {
	WCHAR *nativeName;
    for (; found; found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
	TCHAR *nativeName;
	int len;

	if (tclWinProcs->useWide) {
	WCHAR *wp = data.cFileName;
	if (*wp == '.') {
	    wp++;
	    if (*wp == '.') {
		wp++;
	    }
	    if (*wp == '\0') {
		continue;
	    }
	}
	nativeName = (WCHAR *) data.cFileName;
	len = wcslen(data.cFileName) * sizeof(WCHAR);
	    WCHAR *wp;

	    wp = data.w.cFileName;
	    if (*wp == '.') {
		wp++;
		if (*wp == '.') {
		    wp++;
		}
		if (*wp == '\0') {
		    continue;
		}
	    }
	    nativeName = (TCHAR *) data.w.cFileName;
	    len = wcslen(data.w.cFileName) * sizeof(WCHAR);
	} else {
	    if ((strcmp(data.a.cFileName, ".") == 0)
		    || (strcmp(data.a.cFileName, "..") == 0)) {
		continue;
	    }
	    nativeName = (TCHAR *) data.a.cFileName;
	    len = strlen(data.a.cFileName);
	}

	/*
	 * Append name after slash, and recurse on the file.
	 */

	Tcl_DStringAppend(sourcePtr, (char *) nativeName, len + 1);
	Tcl_DStringSetLength(sourcePtr, Tcl_DStringLength(sourcePtr) - 1);
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
1386
1387
1388
1389
1390
1391
1392


1393
1394
1395
1396
1397
1398
1399
1400
1401


1402
1403
1404
1405
1406
1407
1408
1409







-
-
+
+







-
-
+







    }
    if (result == TCL_OK) {
	/*
	 * Call traverseProc() on a directory after visiting all the
	 * files in that directory.
	 */

	result = traverseProc((const WCHAR *)Tcl_DStringValue(sourcePtr),
		(const WCHAR *)(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
	result = (*traverseProc)(Tcl_DStringValue(sourcePtr),
		(targetPtr == NULL ? NULL : Tcl_DStringValue(targetPtr)),
		DOTREE_POSTD, errorPtr);
    }

  end:
    if (nativeErrfile != NULL) {
	TclWinConvertError(GetLastError());
	if (errorPtr != NULL) {
	    Tcl_DStringInit(errorPtr);
	    Tcl_WCharToUtfDString(nativeErrfile, -1, errorPtr);
	    Tcl_WinTCharToUtf(nativeErrfile, -1, errorPtr);
	}
	result = TCL_ERROR;
    }

    return result;
}

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
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401

1402
1403
1404
1405
1406
1407
1408
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
1458
1459
1460
1461
1462
1463
1464
1465
1466


1467
1468
1469
1470
1471
1472
1473
1474







-
-
+
+

















-
+

-
+
















-
-
+







 *	Depending on the value of type, src may be copied to dst.
 *
 *----------------------------------------------------------------------
 */

static int
TraversalCopy(
    const WCHAR *nativeSrc,	/* Source pathname to copy. */
    const WCHAR *nativeDst,	/* Destination pathname of copy. */
    CONST TCHAR *nativeSrc,	/* Source pathname to copy. */
    CONST TCHAR *nativeDst,	/* Destination pathname of copy. */
    int type,			/* Reason for call - see TraverseWinTree() */
    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString filled
				 * with UTF-8 name of file causing error. */
{
    switch (type) {
    case DOTREE_F:
	if (DoCopyFile(nativeSrc, nativeDst) == TCL_OK) {
	    return TCL_OK;
	}
	break;
    case DOTREE_LINK:
	if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) {
	    return TCL_OK;
	}
	break;
    case DOTREE_PRED:
	if (DoCreateDirectory(nativeDst) == TCL_OK) {
	    DWORD attr = GetFileAttributesW(nativeSrc);
	    DWORD attr = (tclWinProcs->getFileAttributesProc)(nativeSrc);

	    if (SetFileAttributesW(nativeDst,
	    if ((tclWinProcs->setFileAttributesProc)(nativeDst,
		    attr) != FALSE) {
		return TCL_OK;
	    }
	    TclWinConvertError(GetLastError());
	}
	break;
    case DOTREE_POSTD:
	return TCL_OK;
    }

    /*
     * There shouldn't be a problem with src, because we already checked it to
     * get here.
     */

    if (errorPtr != NULL) {
	Tcl_DStringInit(errorPtr);
	Tcl_WCharToUtfDString(nativeDst, -1, errorPtr);
	Tcl_WinTCharToUtf(nativeDst, -1, errorPtr);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
1422
1423
1424
1425
1426
1427
1428
1429
1430


1431
1432
1433
1434
1435
1436
1437
1488
1489
1490
1491
1492
1493
1494


1495
1496
1497
1498
1499
1500
1501
1502
1503







-
-
+
+







 *	set accordingly.
 *
 *----------------------------------------------------------------------
 */

static int
TraversalDelete(
    const WCHAR *nativeSrc,	/* Source pathname to delete. */
    TCL_UNUSED(const WCHAR *) /*dstPtr*/,
    CONST TCHAR *nativeSrc,	/* Source pathname to delete. */
    CONST TCHAR *dstPtr,	/* Not used. */
    int type,			/* Reason for call - see TraverseWinTree() */
    Tcl_DString *errorPtr)	/* If non-NULL, initialized DString filled
				 * with UTF-8 name of file causing error. */
{
    switch (type) {
    case DOTREE_F:
	if (TclpDeleteFile(nativeSrc) == TCL_OK) {
1449
1450
1451
1452
1453
1454
1455
1456
1457

1458
1459
1460
1461
1462
1463
1464
1515
1516
1517
1518
1519
1520
1521


1522
1523
1524
1525
1526
1527
1528
1529







-
-
+







	if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
	    return TCL_OK;
	}
	break;
    }

    if (errorPtr != NULL) {
	Tcl_DStringInit(errorPtr);
	Tcl_WCharToUtfDString(nativeSrc, -1, errorPtr);
	Tcl_WinTCharToUtf(nativeSrc, -1, errorPtr);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
1479
1480
1481
1482
1483
1484
1485
1486
1487


1488
1489
1490
1491
1492
1493
1494
1544
1545
1546
1547
1548
1549
1550


1551
1552
1553
1554
1555
1556
1557
1558
1559







-
-
+
+







static void
StatError(
    Tcl_Interp *interp,		/* The interp that has the error */
    Tcl_Obj *fileName)		/* The name of the file which caused the
				 * error. */
{
    TclWinConvertError(GetLastError());
    Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s",
	    TclGetString(fileName), Tcl_PosixError(interp)));
    Tcl_AppendResult(interp, "could not read \"", TclGetString(fileName),
	    "\": ", Tcl_PosixError(interp), (char *) NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * GetWinFileAttributes --
 *
1510
1511
1512
1513
1514
1515
1516
1517

1518
1519
1520
1521


1522
1523

1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539


1540
1541
1542
1543
1544
1545
1546
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







-
+


-
-
+
+

-
+














-
-
+
+







GetWinFileAttributes(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    DWORD result;
    const WCHAR *nativeName;
    CONST TCHAR *nativeName;
    int attr;

    nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName);
    result = GetFileAttributesW(nativeName);
    nativeName = Tcl_FSGetNativePath(fileName);
    result = (*tclWinProcs->getFileAttributesProc)(nativeName);

    if (result == 0xFFFFFFFF) {
    if (result == 0xffffffff) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    attr = (int)(result & attributeArray[objIndex]);
    if ((objIndex == WIN_HIDDEN_ATTRIBUTE) && (attr != 0)) {
	/*
	 * It is hidden. However there is a bug on some Windows OSes in which
	 * root volumes (drives) formatted as NTFS are declared hidden when
	 * they are not (and cannot be).
	 *
	 * We test for, and fix that case, here.
	 */

	size_t len;
	const char *str = TclGetStringFromObj(fileName, &len);
	int len;
	char *str = Tcl_GetStringFromObj(fileName,&len);

	if (len < 4) {
	    if (len == 0) {
		/*
		 * Not sure if this is possible, but we pass it on anyway.
		 */
	    } else if (len == 1 && (str[0] == '/' || str[0] == '\\')) {
1556
1557
1558
1559
1560
1561
1562
1563

1564
1565
1566
1567
1568
1569
1570
1621
1622
1623
1624
1625
1626
1627

1628
1629
1630
1631
1632
1633
1634
1635







-
+







		 */

		attr = 0;
	    }
	}
    }

    TclNewIntObj(*attributePtrPtr, attr != 0);
    *attributePtrPtr = Tcl_NewBooleanObj(attr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertFileNameFormat --
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
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
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
1651
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
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







-
+






-





-
-
-
+
+
+
-
-














+



-
-
+
+




















-
-
-
+
+
+
+











-

+
-
+

-
+


-
+





-
+













+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+











-
+
-






-
+


-

-
+
+


+
+







 *
 *----------------------------------------------------------------------
 */

static int
ConvertFileNameFormat(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    TCL_UNUSED(int) /*objIndex*/,
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file. */
    int longShort,		/* 0 to short name, 1 to long name. */
    Tcl_Obj **attributePtrPtr)	/* A pointer to return the object with. */
{
    int pathc, i;
    Tcl_Obj *splitPath;
    size_t length;

    splitPath = Tcl_FSSplitPath(fileName, &pathc);

    if (splitPath == NULL || pathc == 0) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "could not read \"%s\": no such file or directory",
		    TclGetString(fileName)));
	    Tcl_AppendResult(interp, "could not read \"",
		    Tcl_GetString(fileName), "\": no such file or directory",
		    (char *) NULL);
	    errno = ENOENT;
	    Tcl_PosixError(interp);
	}
	goto cleanup;
    }

    /*
     * We will decrement this again at the end.	 It is safer to do this in
     * case any of the calls below retain a reference to splitPath.
     */

    Tcl_IncrRefCount(splitPath);

    for (i = 0; i < pathc; i++) {
	Tcl_Obj *elt;
	char *pathv;
	int pathLen;

	Tcl_ListObjIndex(NULL, splitPath, i, &elt);

	pathv = TclGetStringFromObj(elt, &length);
	if ((pathv[0] == '/') || ((length == 3) && (pathv[1] == ':'))
	pathv = Tcl_GetStringFromObj(elt, &pathLen);
	if ((pathv[0] == '/') || ((pathLen == 3) && (pathv[1] == ':'))
		|| (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
	    /*
	     * Handle "/", "//machine/export", "c:/", "." or ".." by just
	     * copying the string literally.  Uppercase the drive letter, just
	     * because it looks better under Windows to do so.
	     */

	simple:
	    /*
	     * Here we are modifying the string representation in place.
	     *
	     * I believe this is legal, since this won't affect any file
	     * representation this thing may have.
	     */

	    pathv[0] = (char) Tcl_UniCharToUpper(UCHAR(pathv[0]));
	} else {
	    Tcl_Obj *tempPath;
	    Tcl_DString ds;
	    Tcl_DString dsTemp;
	    const WCHAR *nativeName;
	    const char *tempString;
	    WIN32_FIND_DATAW data;
	    TCHAR *nativeName;
	    char *tempString;
	    int tempLen;
	    WIN32_FIND_DATAT data;
	    HANDLE handle;
	    DWORD attr;

	    tempPath = Tcl_FSJoinPath(splitPath, i+1);
	    Tcl_IncrRefCount(tempPath);

	    /*
	     * We'd like to call Tcl_FSGetNativePath(tempPath) but that is
	     * likely to lead to infinite loops.
	     */

	    tempString = TclGetStringFromObj(tempPath, &length);
	    Tcl_DStringInit(&ds);
	    tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
	    nativeName = Tcl_UtfToWCharDString(tempString, length, &ds);
	    nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
	    Tcl_DecrRefCount(tempPath);
	    handle = FindFirstFileW(nativeName, &data);
	    handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
	    if (handle == INVALID_HANDLE_VALUE) {
		/*
		 * FindFirstFileW() doesn't like root directories. We would
		 * FindFirstFile() doesn't like root directories. We would
		 * only get a root directory here if the caller specified "c:"
		 * or "c:." and the current directory on the drive was the
		 * root directory
		 */

		attr = GetFileAttributesW(nativeName);
		attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
		if ((attr!=0xFFFFFFFF) && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
		    Tcl_DStringFree(&ds);
		    goto simple;
		}
	    }

	    if (handle == INVALID_HANDLE_VALUE) {
		Tcl_DStringFree(&ds);
		if (interp != NULL) {
		    StatError(interp, fileName);
		}
		goto cleanup;
	    }
	    if (tclWinProcs->useWide) {
		nativeName = (TCHAR *) data.w.cAlternateFileName;
		if (longShort) {
		    if (data.w.cFileName[0] != '\0') {
			nativeName = (TCHAR *) data.w.cFileName;
		    }
		} else {
	    nativeName = data.cAlternateFileName;
	    if (longShort) {
		if (data.cFileName[0] != '\0') {
		    nativeName = data.cFileName;
		}
	    } else {
		if (data.cAlternateFileName[0] == '\0') {
		    nativeName = (WCHAR *) data.cFileName;
		    if (data.w.cAlternateFileName[0] == '\0') {
			nativeName = (TCHAR *) data.w.cFileName;
		    }
		}
	    } else {
		nativeName = (TCHAR *) data.a.cAlternateFileName;
		if (longShort) {
		    if (data.a.cFileName[0] != '\0') {
			nativeName = (TCHAR *) data.a.cFileName;
		    }
		} else {
		    if (data.a.cAlternateFileName[0] == '\0') {
			nativeName = (TCHAR *) data.a.cFileName;
		    }
		}
	    }

	    /*
	     * Purify reports a extraneous UMR in Tcl_WCharToUtfDString() trying
	     * Purify reports a extraneous UMR in Tcl_WinTCharToUtf() trying
	     * to dereference nativeName as a Unicode string. I have proven to
	     * myself that purify is wrong by running the following example
	     * when nativeName == data.w.cAlternateFileName and noting that
	     * purify doesn't complain about the first line, but does complain
	     * about the second.
	     *
	     *	fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
	     *	fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
	     */

	    Tcl_DStringInit(&dsTemp);
	    Tcl_WCharToUtfDString(nativeName, -1, &dsTemp);
	    Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
	    Tcl_DStringFree(&ds);

	    /*
	     * Deal with issues of tildes being absolute.
	     */

	    if (Tcl_DStringValue(&dsTemp)[0] == '~') {
		TclNewLiteralStringObj(tempPath, "./");
		tempPath = Tcl_NewStringObj("./",2);
		Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
			Tcl_DStringLength(&dsTemp));
		Tcl_DStringFree(&dsTemp);
	    } else {
		tempPath = TclDStringToObj(&dsTemp);
		tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
			Tcl_DStringLength(&dsTemp));
	    }
	    Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dsTemp);
	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);

    if (splitPath != NULL) {
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
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







-
-
-
+
+
+
+

-
-
+
+

-
+















-
-
+







static int
SetWinFileAttributes(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file. */
    Tcl_Obj *attributePtr)	/* The new value of the attribute. */
{
    DWORD fileAttributes, old;
    int yesNo, result;
    const WCHAR *nativeName;
    DWORD fileAttributes;
    int yesNo;
    int result;
    CONST TCHAR *nativeName;

    nativeName = (const WCHAR *)Tcl_FSGetNativePath(fileName);
    fileAttributes = old = GetFileAttributesW(nativeName);
    nativeName = Tcl_FSGetNativePath(fileName);
    fileAttributes = (*tclWinProcs->getFileAttributesProc)(nativeName);

    if (fileAttributes == 0xFFFFFFFF) {
    if (fileAttributes == 0xffffffff) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    result = Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo);
    if (result != TCL_OK) {
	return result;
    }

    if (yesNo) {
	fileAttributes |= (attributeArray[objIndex]);
    } else {
	fileAttributes &= ~(attributeArray[objIndex]);
    }

    if ((fileAttributes != old)
	    && !SetFileAttributesW(nativeName, fileAttributes)) {
    if (!(*tclWinProcs->setFileAttributesProc)(nativeName, fileAttributes)) {
	StatError(interp, fileName);
	return TCL_ERROR;
    }

    return result;
}

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
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







-
+

-
-
-
+
+
-
-
+
+


+

















-
+







-
+









-
+


-
+







 */

static int
CannotSetAttribute(
    Tcl_Interp *interp,		/* The interp we are using for errors. */
    int objIndex,		/* The index of the attribute. */
    Tcl_Obj *fileName,		/* The name of the file. */
    TCL_UNUSED(Tcl_Obj *) /*attributePtr*/)
    Tcl_Obj *attributePtr)	/* The new value of the attribute. */
{
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "cannot set attribute \"%s\" for file \"%s\": attribute is readonly",
	    tclpFileAttrStrings[objIndex], TclGetString(fileName)));
    Tcl_AppendResult(interp, "cannot set attribute \"",
	    tclpFileAttrStrings[objIndex], "\" for file \"",
    errno = EINVAL;
    Tcl_PosixError(interp);
	    Tcl_GetString(fileName), "\": attribute is readonly",
	    (char *) NULL);
    return TCL_ERROR;
}


/*
 *---------------------------------------------------------------------------
 *
 * TclpObjListVolumes --
 *
 *	Lists the currently mounted volumes
 *
 * Results:
 *	The list of volumes.
 *
 * Side effects:
 *	None
 *
 *---------------------------------------------------------------------------
 */

Tcl_Obj *
Tcl_Obj*
TclpObjListVolumes(void)
{
    Tcl_Obj *resultPtr, *elemPtr;
    char buf[40 * 4];		/* There couldn't be more than 30 drives??? */
    int i;
    char *p;

    TclNewObj(resultPtr);
    resultPtr = Tcl_NewObj();

    /*
     * On Win32s:
     * GetLogicalDriveStrings() isn't implemented.
     * GetLogicalDrives() returns incorrect information.
     */

    if (GetLogicalDriveStringsA(sizeof(buf), buf) == 0) {
	/*
	 * GetVolumeInformationW() will detects all drives, but causes
	 * GetVolumeInformation() will detects all drives, but causes
	 * chattering on empty floppy drives. We only do this if
	 * GetLogicalDriveStrings() didn't work. It has also been reported
	 * that on some laptops it takes a while for GetVolumeInformationW() to
	 * that on some laptops it takes a while for GetVolumeInformation() to
	 * return when pinging an empty floppy drive, another reason to try to
	 * avoid calling it.
	 */

	buf[1] = ':';
	buf[2] = '/';
	buf[3] = '\0';
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
2041
2042
2043
2044
2045
2046
2047
2048
2049



















































































































2050
2051
2052
2053
2054
2055









-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






	    Tcl_ListObjAppendElement(NULL, resultPtr, elemPtr);
	}
    }

    Tcl_IncrRefCount(resultPtr);
    return resultPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateTemporaryDirectory --
 *
 *	Creates a temporary directory, possibly based on the supplied bits and
 *	pieces of template supplied in the arguments.
 *
 * Results:
 *	An object (refcount 0) containing the name of the newly-created
 *	directory, or NULL on failure.
 *
 * Side effects:
 *	Accesses the native filesystem. Makes a directory.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpCreateTemporaryDirectory(
    Tcl_Obj *dirObj,
    Tcl_Obj *basenameObj)
{
    Tcl_DString base, name;	/* Contains WCHARs */
    int baseLen;
    DWORD error;
    WCHAR tempBuf[MAX_PATH + 1];
    DWORD len = GetTempPathW(MAX_PATH, tempBuf);

    /*
     * Build the path in writable memory from the user-supplied pieces and
     * some defaults. First, the parent temporary directory.
     */

    if (dirObj) {
	Tcl_GetString(dirObj);
	if (dirObj->length < 1) {
	    goto useSystemTemp;
	}
	Tcl_DStringInit(&base);
	Tcl_UtfToWCharDString(Tcl_GetString(dirObj), -1, &base);
	if (dirObj->bytes[dirObj->length - 1] != '\\') {
	    Tcl_UtfToWCharDString("\\", -1, &base);
	}
    } else {
    useSystemTemp:
	Tcl_DStringInit(&base);
	Tcl_DStringAppend(&base, (char *) tempBuf, len * sizeof(WCHAR));
    }

    /*
     * Next, the base of the directory name.
     */

#define DEFAULT_TEMP_DIR_PREFIX	"tcl"
#define SUFFIX_LENGTH	8

    if (basenameObj) {
	Tcl_UtfToWCharDString(Tcl_GetString(basenameObj), -1, &base);
    } else {
	Tcl_UtfToWCharDString(DEFAULT_TEMP_DIR_PREFIX, -1, &base);
    }
    Tcl_UtfToWCharDString("_", -1, &base);

    /*
     * Now we keep on trying random suffixes until we get one that works
     * (i.e., that doesn't trigger the ERROR_ALREADY_EXISTS error). Note that
     * SUFFIX_LENGTH is longer than on Unix because we expect to be not on a
     * case-sensitive filesystem.
     */

    baseLen = Tcl_DStringLength(&base);
    do {
	char tempbuf[SUFFIX_LENGTH + 1];
	int i;
	static const char randChars[] =
	    "QWERTYUIOPASDFGHJKLZXCVBNM1234567890";
	static const int numRandChars = sizeof(randChars) - 1;

	/*
	 * Put a random suffix on the end.
	 */

	error = ERROR_SUCCESS;
	tempbuf[SUFFIX_LENGTH] = '\0';
	for (i = 0 ; i < SUFFIX_LENGTH; i++) {
	    tempbuf[i] = randChars[(int) (rand() % numRandChars)];
	}
	Tcl_DStringSetLength(&base, baseLen);
	Tcl_UtfToWCharDString(tempbuf, -1, &base);
    } while (!CreateDirectoryW((LPCWSTR) Tcl_DStringValue(&base), NULL)
	    && (error = GetLastError()) == ERROR_ALREADY_EXISTS);

    /*
     * Check for other errors. The big ones are ERROR_PATH_NOT_FOUND and
     * ERROR_ACCESS_DENIED.
     */

    if (error != ERROR_SUCCESS) {
	TclWinConvertError(error);
	Tcl_DStringFree(&base);
	return NULL;
    }

    /*
     * We actually made the directory, so we're done! Report what we made back
     * as a (clean) Tcl_Obj.
     */

    Tcl_DStringInit(&name);
    Tcl_WCharToUtfDString((LPCWSTR) Tcl_DStringValue(&base), -1, &name);
    Tcl_DStringFree(&base);
    return TclDStringToObj(&name);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinFile.c.

12
13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30
31
32
12
13
14
15
16
17
18


19

20



21
22
23
24
25
26
27







-
-
+
-

-
-
-







 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"
#include "tclFileSystem.h"
#include <winioctl.h>
#include <shlobj.h>
#include <lm.h>		        /* For TclpGetUserHome(). */
#include <userenv.h>		/* For TclpGetUserHome(). */
#include <lmaccess.h>		/* For TclpGetUserHome(). */
#include <aclapi.h>             /* For GetNamedSecurityInfo */

#ifdef _MSC_VER
#   pragma comment(lib, "userenv.lib")
#endif
/*
 * The number of 100-ns intervals between the Windows system epoch (1601-01-01
 * on the proleptic Gregorian calendar) and the Posix epoch (1970-01-01).
 */

#define POSIX_EPOCH_AS_FILETIME	\
	((Tcl_WideInt) 116444736 * (Tcl_WideInt) 1000000000)
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
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+



-
-
+
+

-
+


-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-













-
-
+
+



-
+






-
-
+
+












-
+









-
-
+
+












-
+






+
+





+
+
+
+
+

+
-
+
-
-
+
+
-
-
-
-
+
+
+
-
-






+


+
















+


+


-














-
+


-
+






-
-
+
+












-
+















-
-
-
+
+
+







#endif

typedef struct {
    REPARSE_DATA_BUFFER dummy;
    WCHAR dummyBuf[MAX_PATH * 3];
} DUMMY_REPARSE_BUFFER;

#if defined(_MSC_VER) && (_MSC_VER <= 1100)
#undef	HAVE_NO_FINDEX_ENUMS
#define HAVE_NO_FINDEX_ENUMS
#elif !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0400)
#undef	HAVE_NO_FINDEX_ENUMS
#define HAVE_NO_FINDEX_ENUMS
#endif

#ifdef HAVE_NO_FINDEX_ENUMS
/* These two aren't in VC++ 5.2 headers */
typedef enum _FINDEX_INFO_LEVELS {
    FindExInfoStandard,
    FindExInfoMaxInfoLevel
} FINDEX_INFO_LEVELS;
typedef enum _FINDEX_SEARCH_OPS {
    FindExSearchNameMatch,
    FindExSearchLimitToDirectories,
    FindExSearchLimitToDevices,
    FindExSearchMaxSearchOp
} FINDEX_SEARCH_OPS;
#endif /* HAVE_NO_FINDEX_ENUMS */

/*
 * Other typedefs required by this code.
 */

static __time64_t		ToCTime(FILETIME fileTime);
static void		FromCTime(__time64_t posixTime, FILETIME *fileTime);
static time_t		ToCTime(FILETIME fileTime);
static void		FromCTime(time_t posixTime, FILETIME *fileTime);

typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC(
	LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);

typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC(LPVOID Buffer);

typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC(
	LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);

typedef BOOL WINAPI GETPROFILESDIRECTORYPROC(
	LPWSTR  lpProfilesDir, LPDWORD lpcchSize
);

/*
 * Declarations for local functions defined in this file:
 */

static int		NativeAccess(const WCHAR *path, int mode);
static int		NativeDev(const WCHAR *path);
static int		NativeStat(const WCHAR *path, Tcl_StatBuf *statPtr,
static int		NativeAccess(const TCHAR *path, int mode);
static int		NativeDev(const TCHAR *path);
static int		NativeStat(const TCHAR *path, Tcl_StatBuf *statPtr,
			    int checkLinks);
static unsigned short	NativeStatMode(DWORD attr, int checkLinks,
			    int isExec);
static int		NativeIsExec(const WCHAR *path);
static int		NativeReadReparse(const WCHAR *LinkDirectory,
static int		NativeIsExec(const TCHAR *path);
static int		NativeReadReparse(const TCHAR *LinkDirectory,
			    REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess);
static int		NativeWriteReparse(const WCHAR *LinkDirectory,
static int		NativeWriteReparse(const TCHAR *LinkDirectory,
			    REPARSE_DATA_BUFFER *buffer);
static int		NativeMatchType(int isDrive, DWORD attr,
			    const WCHAR *nativeName, Tcl_GlobTypeData *types);
static int		WinIsDrive(const char *name, size_t nameLen);
			    const TCHAR *nativeName, Tcl_GlobTypeData *types);
static int		WinIsDrive(const char *name, int nameLen);
static int		WinIsReserved(const char *path);
static Tcl_Obj *	WinReadLink(const WCHAR *LinkSource);
static Tcl_Obj *	WinReadLinkDirectory(const WCHAR *LinkDirectory);
static int		WinLink(const WCHAR *LinkSource,
			    const WCHAR *LinkTarget, int linkAction);
static int		WinSymLinkDirectory(const WCHAR *LinkDirectory,
			    const WCHAR *LinkTarget);
static Tcl_Obj *	WinReadLink(const TCHAR *LinkSource);
static Tcl_Obj *	WinReadLinkDirectory(const TCHAR *LinkDirectory);
static int		WinLink(const TCHAR *LinkSource,
			    const TCHAR *LinkTarget, int linkAction);
static int		WinSymLinkDirectory(const TCHAR *LinkDirectory,
			    const TCHAR *LinkTarget);
MODULE_SCOPE void	tclWinDebugPanic(const char *format, ...);

/*
 *--------------------------------------------------------------------
 *
 * WinLink --
 *
 *	Make a link from source to target.
 *
 *--------------------------------------------------------------------
 */

static int
WinLink(
    const WCHAR *linkSourcePath,
    const WCHAR *linkTargetPath,
    const TCHAR *linkSourcePath,
    const TCHAR *linkTargetPath,
    int linkAction)
{
    WCHAR tempFileName[MAX_PATH];
    WCHAR *tempFilePart;
    TCHAR *tempFilePart;
    DWORD attr;

    /*
     * Get the full path referenced by the target.
     */

    if (!GetFullPathNameW(linkTargetPath, MAX_PATH, tempFileName,
	    &tempFilePart)) {
    if (!(*tclWinProcs->getFullPathNameProc)(linkTargetPath, MAX_PATH,
	    tempFileName, &tempFilePart)) {
	/*
	 * Invalid file.
	 */

	TclWinConvertError(GetLastError());
	return -1;
    }

    /*
     * Make sure source file doesn't exist.
     */

    attr = GetFileAttributesW(linkSourcePath);
    attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
    if (attr != INVALID_FILE_ATTRIBUTES) {
	Tcl_SetErrno(EEXIST);
	return -1;
    }

    /*
     * Get the full path referenced by the source file/directory.
     */

    if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
	    &tempFilePart)) {
    if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
	    tempFileName, &tempFilePart)) {
	/*
	 * Invalid file.
	 */

	TclWinConvertError(GetLastError());
	return -1;
    }

    /*
     * Check the target.
     */

    attr = GetFileAttributesW(linkTargetPath);
    attr = (*tclWinProcs->getFileAttributesProc)(linkTargetPath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The target doesn't exist.
	 */

	TclWinConvertError(GetLastError());
	return -1;

    } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
	/*
	 * It is a file.
	 */

	if (tclWinProcs->createHardLinkProc == NULL) {
	    Tcl_SetErrno(ENOTDIR);
	    return -1;
	}

	if (linkAction & TCL_CREATE_HARD_LINK) {
	    if (!(*tclWinProcs->createHardLinkProc)(linkSourcePath,
	    if (CreateHardLinkW(linkSourcePath, linkTargetPath, NULL)) {
		    linkTargetPath, NULL)) {
		/*
		 * Success!
		TclWinConvertError(GetLastError());
		return -1;
		 */

		return 0;
	    }
	    }
	    return 0;


	    TclWinConvertError(GetLastError());
	} else if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    /*
	     * Can't symlink files.
	     */

	    Tcl_SetErrno(ENOTDIR);
	    return -1;
	} else {
	    Tcl_SetErrno(ENODEV);
	    return -1;
	}
    } else {
	/*
	 * We've got a directory. Now check whether what we're trying to do is
	 * reasonable.
	 */

	if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
	    return WinSymLinkDirectory(linkSourcePath, linkTargetPath);

	} else if (linkAction & TCL_CREATE_HARD_LINK) {
	    /*
	     * Can't hard link directories.
	     */

	    Tcl_SetErrno(EISDIR);
	    return -1;
	} else {
	    Tcl_SetErrno(ENODEV);
	    return -1;
	}
    }
    return -1;
}

/*
 *--------------------------------------------------------------------
 *
 * WinReadLink --
 *
 *	What does 'LinkSource' point to?
 *
 *--------------------------------------------------------------------
 */

static Tcl_Obj *
WinReadLink(
    const WCHAR *linkSourcePath)
    const TCHAR *linkSourcePath)
{
    WCHAR tempFileName[MAX_PATH];
    WCHAR *tempFilePart;
    TCHAR *tempFilePart;
    DWORD attr;

    /*
     * Get the full path referenced by the target.
     */

    if (!GetFullPathNameW(linkSourcePath, MAX_PATH, tempFileName,
	    &tempFilePart)) {
    if (!(*tclWinProcs->getFullPathNameProc)(linkSourcePath, MAX_PATH,
	    tempFileName, &tempFilePart)) {
	/*
	 * Invalid file.
	 */

	TclWinConvertError(GetLastError());
	return NULL;
    }

    /*
     * Make sure source file does exist.
     */

    attr = GetFileAttributesW(linkSourcePath);
    attr = (*tclWinProcs->getFileAttributesProc)(linkSourcePath);
    if (attr == INVALID_FILE_ATTRIBUTES) {
	/*
	 * The source doesn't exist.
	 */

	TclWinConvertError(GetLastError());
	return NULL;

    } else if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
	/*
	 * It is a file - this is not yet supported.
	 */

	Tcl_SetErrno(ENOTDIR);
	return NULL;
    }

    return WinReadLinkDirectory(linkSourcePath);
    } else {
	return WinReadLinkDirectory(linkSourcePath);
    }
}

/*
 *--------------------------------------------------------------------
 *
 * WinSymLinkDirectory --
 *
366
367
368
369
370
371
372
373
374


375
376
377
378
379
380
381
402
403
404
405
406
407
408


409
410
411
412
413
414
415
416
417







-
-
+
+







 *	Zero on success.
 *
 *--------------------------------------------------------------------
 */

static int
WinSymLinkDirectory(
    const WCHAR *linkDirPath,
    const WCHAR *linkTargetPath)
    const TCHAR *linkDirPath,
    const TCHAR *linkTargetPath)
{
    DUMMY_REPARSE_BUFFER dummy;
    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
    int len;
    WCHAR nativeTarget[MAX_PATH];
    WCHAR *loop;

391
392
393
394
395
396
397
398
399


400
401
402

403
404
405
406
407
408
409
427
428
429
430
431
432
433


434
435
436
437

438
439
440
441
442
443
444
445







-
-
+
+


-
+







    /*
     * We must have backslashes only. This is VERY IMPORTANT. If we have any
     * forward slashes everything appears to work, but the resulting symlink
     * is useless!
     */

    for (loop = nativeTarget; *loop != 0; loop++) {
	if (*loop == '/') {
	    *loop = '\\';
	if (*loop == L'/') {
	    *loop = L'\\';
	}
    }
    if ((nativeTarget[len-1] == '\\') && (nativeTarget[len-2] != ':')) {
    if ((nativeTarget[len-1] == L'\\') && (nativeTarget[len-2] != L':')) {
	nativeTarget[len-1] = 0;
    }

    /*
     * Build the reparse info.
     */

438
439
440
441
442
443
444
445
446


447
448
449
450
451
452
453
474
475
476
477
478
479
480


481
482
483
484
485
486
487
488
489







-
-
+
+







 *	Zero on success.
 *
 *--------------------------------------------------------------------
 */

int
TclWinSymLinkCopyDirectory(
    const WCHAR *linkOrigPath,	/* Existing junction - reparse point */
    const WCHAR *linkCopyPath)	/* Will become a duplicate junction */
    const TCHAR *linkOrigPath,	/* Existing junction - reparse point */
    const TCHAR *linkCopyPath)	/* Will become a duplicate junction */
{
    DUMMY_REPARSE_BUFFER dummy;
    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;

    if (NativeReadReparse(linkOrigPath, reparseBuffer, GENERIC_READ)) {
	return -1;
    }
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
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







-
+













+
-
-
+
+













-
+







 *	Zero on success.
 *
 *--------------------------------------------------------------------
 */

int
TclWinSymLinkDelete(
    const WCHAR *linkOrigPath,
    const TCHAR *linkOrigPath,
    int linkOnly)
{
    /*
     * It is a symbolic link - remove it.
     */

    DUMMY_REPARSE_BUFFER dummy;
    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
    HANDLE hFile;
    DWORD returnedLength;

    memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER));
    reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT;
    hFile = (*tclWinProcs->createFileProc)(linkOrigPath, GENERIC_WRITE, 0,
    hFile = CreateFileW(linkOrigPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING,
	    FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);

    if (hFile != INVALID_HANDLE_VALUE) {
	if (!DeviceIoControl(hFile, FSCTL_DELETE_REPARSE_POINT, reparseBuffer,
		REPARSE_MOUNTPOINT_HEADER_SIZE,NULL,0,&returnedLength,NULL)) {
	    /*
	     * Error setting junction.
	     */

	    TclWinConvertError(GetLastError());
	    CloseHandle(hFile);
	} else {
	    CloseHandle(hFile);
	    if (!linkOnly) {
		RemoveDirectoryW(linkOrigPath);
		(*tclWinProcs->removeDirectoryProc)(linkOrigPath);
	    }
	    return 0;
	}
    }
    return -1;
}

534
535
536
537
538
539
540
541

542
543
544
545
546
547
548
549
550

551
552
553
554
555
556
557
571
572
573
574
575
576
577

578
579
580
581
582
583
584
585
586

587
588
589
590
591
592
593
594







-
+








-
+







#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Warray-bounds"
#endif

static Tcl_Obj *
WinReadLinkDirectory(
    const WCHAR *linkDirPath)
    const TCHAR *linkDirPath)
{
    int attr, len, offset;
    DUMMY_REPARSE_BUFFER dummy;
    REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
    Tcl_Obj *retVal;
    Tcl_DString ds;
    const char *copy;

    attr = GetFileAttributesW(linkDirPath);
    attr = (*tclWinProcs->getFileAttributesProc)(linkDirPath);
    if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
	goto invalidError;
    }
    if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) {
	return NULL;
    }

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
605
606
607
608
609
610
611

612
613
614
615
616
617
618
619
620
621
622
623
624
625

626
627
628
629
630
631
632
633







-
+













-
+







	 * There is an assumption in this code that 'wide' interfaces are
	 * being used (see tclWin32Dll.c), which is true for the only systems
	 * which support reparse tags at present. If that changes in the
	 * future, this code will have to be generalised.
	 */

	offset = 0;
	if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == '\\') {
	if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
	    /*
	     * Check whether this is a mounted volume.
	     */

	    if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer,
		    L"\\??\\Volume{",11) == 0) {
		char drive;

		/*
		 * There is some confusion between \??\ and \\?\ which we have
		 * to fix here. It doesn't seem very well documented.
		 */

		reparseBuffer->MountPointReparseBuffer.PathBuffer[1] = '\\';
		reparseBuffer->MountPointReparseBuffer.PathBuffer[1]=L'\\';

		/*
		 * Check if a corresponding drive letter exists, and use that
		 * if it is found
		 */

		drive = TclWinDriveLetterForVolMountPoint(
630
631
632
633
634
635
636
637
638

639
640
641


642
643
644
645
646
647
648
667
668
669
670
671
672
673


674
675


676
677
678
679
680
681
682
683
684







-
-
+

-
-
+
+







		 * Strip off the prefix.
		 */

		offset = 4;
	    }
	}

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(
	Tcl_WinTCharToUtf((const char *)
		reparseBuffer->MountPointReparseBuffer.PathBuffer,
		reparseBuffer->MountPointReparseBuffer
		.SubstituteNameLength>>1, &ds);
		(int) reparseBuffer->MountPointReparseBuffer
		.SubstituteNameLength, &ds);

	copy = Tcl_DStringValue(&ds)+offset;
	len = Tcl_DStringLength(&ds)-offset;
	retVal = Tcl_NewStringObj(copy,len);
	Tcl_IncrRefCount(retVal);
	Tcl_DStringFree(&ds);
	return retVal;
670
671
672
673
674
675
676
677

678
679
680
681
682
683
684
685
686



687
688
689
690
691
692
693
706
707
708
709
710
711
712

713
714
715
716
717
718
719



720
721
722
723
724
725
726
727
728
729







-
+






-
-
-
+
+
+







 *	Zero on success.
 *
 *--------------------------------------------------------------------
 */

static int
NativeReadReparse(
    const WCHAR *linkDirPath,	/* The junction to read */
    const TCHAR *linkDirPath,	/* The junction to read */
    REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */
    DWORD desiredAccess)
{
    HANDLE hFile;
    DWORD returnedLength;

    hFile = CreateFileW(linkDirPath, desiredAccess, FILE_SHARE_READ, NULL,
	    OPEN_EXISTING,
	    FILE_FLAG_OPEN_REPARSE_POINT | FILE_FLAG_BACKUP_SEMANTICS, NULL);
    hFile = (*tclWinProcs->createFileProc)(linkDirPath, desiredAccess, FILE_SHARE_READ,
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);

    if (hFile == INVALID_HANDLE_VALUE) {
	/*
	 * Error creating directory.
	 */

	TclWinConvertError(GetLastError());
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
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







-
+









-
+







-
-
-
+
+
+







 *	Assumption that LinkDirectory does not exist.
 *
 *--------------------------------------------------------------------
 */

static int
NativeWriteReparse(
    const WCHAR *linkDirPath,
    const TCHAR *linkDirPath,
    REPARSE_DATA_BUFFER *buffer)
{
    HANDLE hFile;
    DWORD returnedLength;

    /*
     * Create the directory - it must not already exist.
     */

    if (CreateDirectoryW(linkDirPath, NULL) == 0) {
    if ((*tclWinProcs->createDirectoryProc)(linkDirPath, NULL) == 0) {
	/*
	 * Error creating directory.
	 */

	TclWinConvertError(GetLastError());
	return -1;
    }
    hFile = CreateFileW(linkDirPath, GENERIC_WRITE, 0, NULL,
	    OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT
	    | FILE_FLAG_BACKUP_SEMANTICS, NULL);
    hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0,
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
    if (hFile == INVALID_HANDLE_VALUE) {
	/*
	 * Error creating directory.
	 */

	TclWinConvertError(GetLastError());
	return -1;
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
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







-
+










-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




















-
-
+
+


-
-
+
+
+
+
+
+

-
-
+
+
+
+
+
+
+
+
+
+
+







	    NULL, 0, &returnedLength, NULL)) {
	/*
	 * Error setting junction.
	 */

	TclWinConvertError(GetLastError());
	CloseHandle(hFile);
	RemoveDirectoryW(linkDirPath);
	(*tclWinProcs->removeDirectoryProc)(linkDirPath);
	return -1;
    }
    CloseHandle(hFile);

    /*
     * We succeeded.
     */

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * tclWinDebugPanic --
 *
 *	Display a message. If a debugger is present, present it directly to
 *	the debugger, otherwise use a MessageBox.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
tclWinDebugPanic(
    const char *format, ...)
{
#define TCL_MAX_WARN_LEN 1024
    va_list argList;
    char buf[TCL_MAX_WARN_LEN * 3];
    WCHAR msgString[TCL_MAX_WARN_LEN];

    va_start(argList, format);
    vsnprintf(buf, sizeof(buf), format, argList);

    msgString[TCL_MAX_WARN_LEN-1] = '\0';
    MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);

    /*
     * Truncate MessageBox string if it is too long to not overflow the screen
     * and cause possible oversized window error.
     */

    if (msgString[TCL_MAX_WARN_LEN-1] != '\0') {
	memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
    }
    if (IsDebuggerPresent()) {
	OutputDebugStringW(msgString);
    } else {
	MessageBeep(MB_ICONEXCLAMATION);
	MessageBoxW(NULL, msgString, L"Fatal Error",
		MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpFindExecutable --
 *
 *	This function computes the absolute path name of the current
 *	application.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The computed path is stored.
 *
 *---------------------------------------------------------------------------
 */

void
TclpFindExecutable(
    const char *argv0)		/* If NULL, install PanicMessageBox, otherwise
				 * ignore. */
    const char *argv0)		/* The value of the application's argv[0]
				 * (native). */
{
    WCHAR wName[MAX_PATH];
    char name[MAX_PATH * 3];
    (void)argv0;
    char name[MAX_PATH * TCL_UTF_MAX];

    /*
     * Under Windows we ignore argv0, and return the path for the file used to
     * create this process.
     */

    GetModuleFileNameW(NULL, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
    if (GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR)) == 0) {
	GetModuleFileNameA(NULL, name, sizeof(name));

	/*
	 * Convert to WCHAR to get out of ANSI codepage
	 */

	MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
    }

    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL,NULL);
    TclWinNoBackslash(name);
    TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+











-





+

-
-
-
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+


-
+







    Tcl_Obj *resultPtr,		/* List object to lappend results. */
    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
    const char *pattern,	/* Pattern to match against. */
    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    const WCHAR *native;
    const TCHAR *native;

    if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) {
	/*
	 * The native filesystem never adds mounts.
	 */

	return TCL_OK;
    }

    if (pattern == NULL || (*pattern == '\0')) {
	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	if (norm != NULL) {
	    /*
	     * Match a single file directly.
	     */

	    int len;
	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    size_t length = 0;
	    const char *str = TclGetStringFromObj(norm, &length);
	    const char *str = Tcl_GetStringFromObj(norm,&len);

	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	    native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesExW(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }
	    attr = data.dwFileAttributes;

	    if (NativeMatchType(WinIsDrive(str, length), attr, native, types)) {
	    if (tclWinProcs->getFileAttributesExProc == NULL) {
		attr = (*tclWinProcs->getFileAttributesProc)(native);
		if (attr == 0xffffffff) {
		    return TCL_OK;
		}
	    } else {
		WIN32_FILE_ATTRIBUTE_DATA data;
		if ((*tclWinProcs->getFileAttributesExProc)(native,
			GetFileExInfoStandard, &data) != TRUE) {
		    return TCL_OK;
		}
		attr = data.dwFileAttributes;
	    }

	    if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	    }
	}
	return TCL_OK;
    } else {
	DWORD attr;
	HANDLE handle;
	WIN32_FIND_DATAW data;
	WIN32_FIND_DATAT data;
	const char *dirName;	/* UTF-8 dir name, later with pattern
				 * appended. */
	size_t dirLength;
	int dirLength;
	int matchSpecialDots;
	Tcl_DString ds;		/* Native encoding of dir, also used
				 * temporarily for other things. */
	Tcl_DString dsOrig;	/* UTF-8 encoding of dir. */
	Tcl_Obj *fileNamePtr;
	char lastChar;

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
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







-
+



-
+

-
-
+









-
+




-
+



















-
+


-
-
-
-
+
+
+
+





-
+






-













-
-
-
+
+
+
+







	    return TCL_ERROR;
	}

	/*
	 * Verify that the specified path exists and is actually a directory.
	 */

	native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	native = Tcl_FSGetNativePath(pathPtr);
	if (native == NULL) {
	    return TCL_OK;
	}
	attr = GetFileAttributesW(native);
	attr = (*tclWinProcs->getFileAttributesProc)(native);

	if ((attr == INVALID_FILE_ATTRIBUTES)
	    || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
	if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
	    return TCL_OK;
	}

	/*
	 * Build up the directory name for searching, including a trailing
	 * directory separator.
	 */

	Tcl_DStringInit(&dsOrig);
	dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
	dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	lastChar = dirName[dirLength -1];
	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
	    TclDStringAppendLiteral(&dsOrig, "/");
	    Tcl_DStringAppend(&dsOrig, "/", 1);
	    dirLength++;
	}
	dirName = Tcl_DStringValue(&dsOrig);

	/*
	 * We need to check all files in the directory, so we append '*.*' to
	 * the path, unless the pattern we've been given is rather simple,
	 * when we can use that instead.
	 */

	if (strpbrk(pattern, "[]\\") == NULL) {
	    /*
	     * The pattern is a simple one containing just '*' and/or '?'.
	     * This means we can get the OS to help us, by passing it the
	     * pattern.
	     */

	    dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
	} else {
	    dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
	    dirName = Tcl_DStringAppend(&dsOrig, "*.*", 3);
	}

	Tcl_DStringInit(&ds);
	native = Tcl_UtfToWCharDString(dirName, -1, &ds);
	if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
	    handle = FindFirstFileW(native, &data);
	native = Tcl_WinUtfToTChar(dirName, -1, &ds);
	if (tclWinProcs->findFirstFileExProc == NULL || (types == NULL)
		|| (types->type != TCL_GLOB_TYPE_DIR)) {
	    handle = (*tclWinProcs->findFirstFileProc)(native, &data);
	} else {
	    /*
	     * We can be more efficient, for pure directory requests.
	     */

	    handle = FindFirstFileExW(native,
	    handle = (*tclWinProcs->findFirstFileExProc)(native,
		    FindExInfoStandard, &data,
		    FindExSearchLimitToDirectories, NULL, 0);
	}

	if (handle == INVALID_HANDLE_VALUE) {
	    DWORD err = GetLastError();

	    Tcl_DStringFree(&ds);
	    if (err == ERROR_FILE_NOT_FOUND) {
		/*
		 * We used our 'pattern' above, and matched nothing. This
		 * means we just return TCL_OK, indicating no results found.
		 */

		Tcl_DStringFree(&dsOrig);
		return TCL_OK;
	    }

	    TclWinConvertError(err);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't read directory \"%s\": %s",
			Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
		Tcl_ResetResult(interp);
		Tcl_AppendResult(interp, "couldn't read directory \"",
			Tcl_DStringValue(&dsOrig), "\": ",
			Tcl_PosixError(interp), NULL);
	    }
	    Tcl_DStringFree(&dsOrig);
	    return TCL_ERROR;
	}
	Tcl_DStringFree(&ds);

	/*
1071
1072
1073
1074
1075
1076
1077

1078


1079
1080
1081
1082







1083
1084
1085
1086
1087
1088
1089
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







+

+
+
-
-
-
-
+
+
+
+
+
+
+







	 * Now iterate over all of the files in the directory, starting with
	 * the first one we found.
	 */

	do {
	    const char *utfname;
	    int checkDrive = 0, isDrive;
	    DWORD attr;

	    if (tclWinProcs->useWide) {
		native = (const TCHAR *) data.w.cFileName;
	    native = data.cFileName;
	    attr = data.dwFileAttributes;
	    Tcl_DStringInit(&ds);
	    utfname = Tcl_WCharToUtfDString(native, -1, &ds);
		attr = data.w.dwFileAttributes;
	    } else {
		native = (const TCHAR *) data.a.cFileName;
		attr = data.a.dwFileAttributes;
	    }

	    utfname = Tcl_WinTCharToUtf(native, -1, &ds);

	    if (!matchSpecialDots) {
		/*
		 * If it is exactly '.' or '..' then we ignore it.
		 */

		if ((utfname[0] == '.') && (utfname[1] == '\0'
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
1152
1153
1154
1155
1156
1157
1158
1159

1160
1161
1162
1163
1164
1165
1166
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







-

















-
+
















-
+







		 * If the file matches, then we need to process the remainder
		 * of the path.
		 */

		if (checkDrive) {
		    const char *fullname = Tcl_DStringAppend(&dsOrig, utfname,
			    Tcl_DStringLength(&ds));

		    isDrive = WinIsDrive(fullname, Tcl_DStringLength(&dsOrig));
		    Tcl_DStringSetLength(&dsOrig, dirLength);
		} else {
		    isDrive = 0;
		}
		if (NativeMatchType(isDrive, attr, native, types)) {
		    Tcl_ListObjAppendElement(interp, resultPtr,
			    TclNewFSPathObj(pathPtr, utfname,
				    Tcl_DStringLength(&ds)));
		}
	    }

	    /*
	     * Free ds here to ensure that native is valid above.
	     */

	    Tcl_DStringFree(&ds);
	} while (FindNextFileW(handle, &data) == TRUE);
	} while ((*tclWinProcs->findNextFileProc)(handle, &data) == TRUE);

	FindClose(handle);
	Tcl_DStringFree(&dsOrig);
	return TCL_OK;
    }
}

/*
 * Does the given path represent a root volume? We need this special case
 * because for NTFS root volumes, the getFileAttributesProc returns a 'hidden'
 * attribute when it should not.
 */

static int
WinIsDrive(
    const char *name,		/* Name (UTF-8) */
    size_t len)			/* Length of name */
    int len)			/* Length of name */
{
    int remove = 0;

    while (len > 4) {
	if ((name[len-1] != '.' || name[len-2] != '.')
		|| (name[len-3] != '/' && name[len-3] != '\\')) {
	    /*
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
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
1385
1386
1387
1388
1389
1390











1391
1392
1393






1394
1395
1396
1397
1398
1399
1400
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
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





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







-
+














-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+

-
+

-
-
-
+
+
+

-
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+



+
+
+
+
+
+







 */

static int
NativeMatchType(
    int isDrive,		/* Is this a drive. */
    DWORD attr,			/* We already know the attributes for the
				 * file. */
    const WCHAR *nativeName,	/* Native path to check. */
    const TCHAR *nativeName,	/* Native path to check. */
    Tcl_GlobTypeData *types)	/* Type description to match against. */
{
    /*
     * 'attr' represents the attributes of the file, but we only want to
     * retrieve this info if it is absolutely necessary because it is an
     * expensive call. Unfortunately, to deal with hidden files properly, we
     * must always retrieve it.
     */

    if (types == NULL) {
	/*
	 * If invisible, don't return the file.
	 */

	return !(attr & FILE_ATTRIBUTE_HIDDEN && !isDrive);
    }

    if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
	/*
	 * If invisible.
	 */
	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
	    return 0;
	}
    } else {
	if (attr & FILE_ATTRIBUTE_HIDDEN && !isDrive) {
	    /*
	     * If invisible.
	     */

	if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
	    return 0;
	}
    } else {
	/*
	 * Visible.
	 */
	    if ((types->perm == 0) || !(types->perm & TCL_GLOB_PERM_HIDDEN)) {
		return 0;
	    }
	} else {
	    /*
	     * Visible.
	     */

	if (types->perm & TCL_GLOB_PERM_HIDDEN) {
	    return 0;
	}
    }
	    if (types->perm & TCL_GLOB_PERM_HIDDEN) {
		return 0;
	    }
	}

    if (types->perm != 0) {
	if (((types->perm & TCL_GLOB_PERM_RONLY) &&
		    !(attr & FILE_ATTRIBUTE_READONLY)) ||
		((types->perm & TCL_GLOB_PERM_R) &&
		    (0 /* File exists => R_OK on Windows */)) ||
		((types->perm & TCL_GLOB_PERM_W) &&
		    (attr & FILE_ATTRIBUTE_READONLY)) ||
		((types->perm & TCL_GLOB_PERM_X) &&
		    (!(attr & FILE_ATTRIBUTE_DIRECTORY)
		    && !NativeIsExec(nativeName)))) {
	    return 0;
	}
    }
	if (types->perm != 0) {
	    if (((types->perm & TCL_GLOB_PERM_RONLY) &&
			!(attr & FILE_ATTRIBUTE_READONLY)) ||
		    ((types->perm & TCL_GLOB_PERM_R) &&
			(0 /* File exists => R_OK on Windows */)) ||
		    ((types->perm & TCL_GLOB_PERM_W) &&
			(attr & FILE_ATTRIBUTE_READONLY)) ||
		    ((types->perm & TCL_GLOB_PERM_X) &&
			(!(attr & FILE_ATTRIBUTE_DIRECTORY)
			 && !NativeIsExec(nativeName)))) {
		return 0;
	    }
	}

    if ((types->type & TCL_GLOB_TYPE_DIR)
	    && (attr & FILE_ATTRIBUTE_DIRECTORY)) {
	/*
	 * Quicker test for directory, which is a common case.
	 */
	if ((types->type & TCL_GLOB_TYPE_DIR)
		&& (attr & FILE_ATTRIBUTE_DIRECTORY)) {
	    /*
	     * Quicker test for directory, which is a common case.
	     */

	return 1;
	    return 1;

    } else if (types->type != 0) {
	unsigned short st_mode;
	int isExec = NativeIsExec(nativeName);
	} else if (types->type != 0) {
	    unsigned short st_mode;
	    int isExec = NativeIsExec(nativeName);

	st_mode = NativeStatMode(attr, 0, isExec);
	    st_mode = NativeStatMode(attr, 0, isExec);

	/*
	 * In order bcdpfls as in 'find -t'
	 */
	    /*
	     * In order bcdpfls as in 'find -t'
	     */

	if (((types->type&TCL_GLOB_TYPE_BLOCK)    && S_ISBLK(st_mode)) ||
		((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) ||
		((types->type&TCL_GLOB_TYPE_DIR)  && S_ISDIR(st_mode)) ||
		((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) ||
	    if (((types->type&TCL_GLOB_TYPE_BLOCK)    && S_ISBLK(st_mode)) ||
		    ((types->type&TCL_GLOB_TYPE_CHAR) && S_ISCHR(st_mode)) ||
		    ((types->type&TCL_GLOB_TYPE_DIR)  && S_ISDIR(st_mode)) ||
		    ((types->type&TCL_GLOB_TYPE_PIPE) && S_ISFIFO(st_mode)) ||
#ifdef S_ISSOCK
		((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) ||
		    ((types->type&TCL_GLOB_TYPE_SOCK) && S_ISSOCK(st_mode)) ||
#endif
		((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) {
	    /*
	     * Do nothing - this file is ok.
	     */
	} else {
		    ((types->type&TCL_GLOB_TYPE_FILE) && S_ISREG(st_mode))) {
		/*
		 * Do nothing - this file is ok.
		 */
	    } else {
#ifdef S_ISLNK
	    if (types->type & TCL_GLOB_TYPE_LINK) {
		st_mode = NativeStatMode(attr, 1, isExec);
		if (S_ISLNK(st_mode)) {
		    return 1;
		}
	    }
#endif /* S_ISLNK */
	    return 0;
	}
    }
		if (types->type & TCL_GLOB_TYPE_LINK) {
		    st_mode = NativeStatMode(attr, 1, isExec);
		    if (S_ISLNK(st_mode)) {
			return 1;
		    }
		}
#endif
		return 0;
	    }
	}
    }
    return 1;
}

static void
FreeLoadLibHandle(
    ClientData clientData)
{
    FreeLibrary((HMODULE)clientData);
}
/*
 *----------------------------------------------------------------------
 *
 * TclpGetUserHome --
 *
 *	This function takes the passed in user name and finds the
 *	corresponding home directory specified in the password file.
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
1439
1440
1441


1442
1443


1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
























1469
1470
1471


1472
1473
1474
1475
1476

1477
1478
1479
1480


1481
1482
1483
1484
1485
1486




1487
1488
1489
1490
1491
1492





1493
1494
1495
1496
1497




1498
1499
1500
1501
1502
1503
1504






1505
1506
1507

1508
1509
1510
1511


1512
1513
1514
1515
1516
1517
1518
1519
1520







1521
1522
1523
1524
1525
1526
1527
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
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484




1485
1486
1487

1488
1489
1490




1491
1492
1493
1494
1495


1496




1497
1498


1499
1500

























1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524



1525
1526





1527




1528
1529






1530
1531
1532
1533






1534
1535
1536
1537
1538





1539
1540
1541
1542







1543
1544
1545
1546
1547
1548



1549




1550
1551

1552







1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566







-
+





-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-

+
+
-
-
-
-
+
+
+
+

-
-
+
-
-
-
-
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
-
-
-
-
+
+
-

-
-
-
-
-
-
-
+
+
+
+
+
+
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

const char *
char *
TclpGetUserHome(
    const char *name,		/* User name for desired home directory. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    char *result = NULL;
    USER_INFO_1 *uiPtr;
    Tcl_DString ds;
    int nameLen = -1;
    char *result;

    static NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
    static NETGETDCNAMEPROC *netGetDCNameProc;
    static NETUSERGETINFOPROC *netUserGetInfoProc;
    static GETPROFILESDIRECTORYPROC *getProfilesDirectoryProc;
    static int apistubs = 0;

    result = NULL;
    Tcl_DStringInit(bufferPtr);

    if (!apistubs) {
	HINSTANCE handle;
	TCL_DECLARE_MUTEX(initializeMutex)
	Tcl_MutexLock(&initializeMutex);
	if (!apistubs) {
	    handle = LoadLibraryA("netapi32.dll");
	    if (handle) {
		netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
			GetProcAddress(handle, "NetApiBufferFree");
		netGetDCNameProc = (NETGETDCNAMEPROC *)
			GetProcAddress(handle, "NetGetDCName");
		netUserGetInfoProc = (NETUSERGETINFOPROC *)
			GetProcAddress(handle, "NetUserGetInfo");
		Tcl_CreateExitHandler(FreeLoadLibHandle, handle);
	    }
	    handle = LoadLibraryA("userenv.dll");
	    if (handle) {
		getProfilesDirectoryProc = (GETPROFILESDIRECTORYPROC *)
			GetProcAddress(handle, "GetProfilesDirectoryW");
		Tcl_CreateExitHandler(FreeLoadLibHandle, handle);
	    }

	    apistubs = -1;
	    if ( (netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
	      && (netApiBufferFreeProc != NULL) && (getProfilesDirectoryProc != NULL)
	    ) {
		apistubs = 1;
	    }
	}
	Tcl_MutexUnlock(&initializeMutex);
    }

    if (apistubs == 1) {
	USER_INFO_1 *uiPtr;
	Tcl_DString ds;
	int nameLen, rc;
    int rc = 0;
    const char *domain;
    WCHAR *wName, *wHomeDir, *wDomain;

	const char *domain;
	WCHAR *wName, *wHomeDir, *wDomain;
	WCHAR buf[MAX_PATH];
    Tcl_DStringInit(bufferPtr);

	rc = 0;
	nameLen = -1;
    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;
	wDomain = NULL;
	domain = Tcl_UtfFindFirst(name, '@');
	if (domain == NULL) {
	    const char *ptr;

	/*
	 * No domain. Firstly check it's the current user
	    /* no domain - firstly check it's the current user */
	 */

	ptr = TclpGetUserName(&ds);
	if (ptr != NULL && strcasecmp(name, ptr) == 0) {
	    if ( (ptr = TclpGetUserName(&ds)) != NULL
	      && strcasecmp(name, ptr) == 0
	    /*
	     * Try safest and fastest way to get current user home
	    ) {
		/* try safest and fastest way to get current user home */
	     */

	    ptr = TclGetEnv("HOME", &ds);
	    if (ptr != NULL) {
		Tcl_JoinPath(1, &ptr, bufferPtr);
		rc = 1;
		result = Tcl_DStringValue(bufferPtr);
	    }
	}
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToWCharDString(domain + 1, -1, &ds);
	rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (rc == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToWCharDString(name, nameLen, &ds);
	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
	    /*
	     * User does not exist; if domain was not specified, try again
	     * using current domain.
	     */
		ptr = TclGetEnv("HOME", &ds);
		if (ptr != NULL) {
		    Tcl_JoinPath(1, &ptr, bufferPtr);
		    rc = 1;
		    result = Tcl_DStringValue(bufferPtr);
		}
	    }
	    Tcl_DStringFree(&ds);
	} else {
	    Tcl_DStringInit(&ds);
	    wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
	    rc = (netGetDCNameProc)(NULL, wName, (LPBYTE *) &wDomain);
	    Tcl_DStringFree(&ds);
	    nameLen = domain - name;
	}
	if (rc == 0) {
	    Tcl_DStringInit(&ds);
	    wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
	    while ((netUserGetInfoProc)(wDomain, wName, 1,
		    (LPBYTE *) &uiPtr) != 0) {
		/*
		 * user does not exists - if domain was not specified,
		 * try again using current domain.
		 */

	    rc = 1;
	    if (domain != NULL) {
		rc = 1;
		if (domain != NULL) break;
		break;
	    }

	    /*
	     * Get current domain
		/* get current domain */
	     */

	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
	    if (rc != 0) {
		rc = (netGetDCNameProc)(NULL, NULL, (LPBYTE *) &wDomain);
		if (rc != 0) break;
		break;
	    }
	    domain = (const char *)INT2PTR(-1); /* repeat once */
	}
	if (rc == 0) {
	    DWORD i, size = MAX_PATH;
		domain = INT2PTR(-1); /* repeat once */
	    }
	    if (rc == 0) {
		DWORD i, size = MAX_PATH;

	    wHomeDir = uiPtr->usri1_home_dir;
	    if ((wHomeDir != NULL) && (wHomeDir[0] != '\0')) {
		size = lstrlenW(wHomeDir);
		Tcl_WCharToUtfDString(wHomeDir, size, bufferPtr);
	    } else {
		wHomeDir = uiPtr->usri1_home_dir;
		if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
		    size = lstrlenW(wHomeDir);
		    Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr);
		} else {
		WCHAR buf[MAX_PATH];
		/*
		 * User exists but has no home dir. Return
		 * "{GetProfilesDirectory}/<user>".
		 */
		    /*
		     * User exists but has no home dir. Return
		     * "{GetProfilesDirectory}/<user>".
		     */

		GetProfilesDirectoryW(buf, &size);
		Tcl_WCharToUtfDString(buf, size-1, bufferPtr);
		Tcl_DStringAppend(bufferPtr, "/", 1);
		Tcl_DStringAppend(bufferPtr, name, nameLen);
	    }
	    result = Tcl_DStringValue(bufferPtr);
		    getProfilesDirectoryProc(buf, &size);
		    Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
		    Tcl_DStringAppend(bufferPtr, "/", 1);
		    Tcl_DStringAppend(bufferPtr, name, nameLen);
		}
		result = Tcl_DStringValue(bufferPtr);

	    /*
	     * Be sure we return normalized path
		/* be sure we returns normalized path */
	     */

	    for (i = 0; i < size; ++i) {
		if (result[i] == '\\') {
		for (i = 0; i < size; ++i){
		    if (result[i] == '\\') result[i] = '/';
		    result[i] = '/';
		}
	    }
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {
	NetApiBufferFree((void *) wDomain);
		(*netApiBufferFreeProc)((void *) uiPtr);
	    }
	    Tcl_DStringFree(&ds);
	}
	if (wDomain != NULL) {
	    (*netApiBufferFreeProc)((void *) wDomain);
	}
    }
    if (result == NULL) {
	/*
	 * Look in the "Password Lists" section of system.ini for the local
	 * user. There are also entries in that section that begin with a "*"
	 * character that are used by Windows for other purposes; ignore user
	 * names beginning with a "*".
1564
1565
1566
1567
1568
1569
1570
1571

1572
1573
1574
1575
1576

1577
1578

1579
1580
1581
1582
1583
1584
1585
1603
1604
1605
1606
1607
1608
1609

1610
1611
1612
1613
1614

1615
1616

1617
1618
1619
1620
1621
1622
1623
1624







-
+




-
+

-
+







 *	See access documentation.
 *
 *---------------------------------------------------------------------------
 */

static int
NativeAccess(
    const WCHAR *nativePath,	/* Path of file to access, native encoding. */
    const TCHAR *nativePath,	/* Path of file to access, native encoding. */
    int mode)			/* Permission setting. */
{
    DWORD attr;

    attr = GetFileAttributesW(nativePath);
    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);

    if (attr == INVALID_FILE_ATTRIBUTES) {
    if (attr == 0xffffffff) {
	/*
	 * File might not exist.
	 */

	DWORD lasterror = GetLastError();
	if (lasterror != ERROR_SHARING_VIOLATION) {
	    TclWinConvertError(lasterror);
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
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
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
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
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







-




-
+


-
-
+
+

-





-
-
+
-
-




-
-
-
+
-
-



-
-
+
-
-
-
+
-
-
-
+
-
-
-
+
+
-
-
-
+
+




-
-
-
+
-
-





-
-
-
+
-
-









-
+














-
+



-
+








	return 0;
    }

    /*
     * If it's not a directory (assume file), do several fast checks:
     */

    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
	/*
	 * If the attributes say this is not writable at all.  The file is a
	 * regular file (i.e., not a directory), then the file is not
	 * writable, full stop.  For directories, the read-only bit is
	 * writable, full stop.	 For directories, the read-only bit is
	 * (mostly) ignored by Windows, so we can't ascertain anything about
	 * directory access from the attrib data.  However, if we have the
	 * advanced 'getFileSecurityProc', then more robust ACL checks will be
	 * done below.
	 * advanced 'getFileSecurityProc', then more robust ACL checks
	 * will be done below.
	 */

	if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
	    Tcl_SetErrno(EACCES);
	    return -1;
	}

	/*
	 * If doesn't have the correct extension, it can't be executable
	/* If doesn't have the correct extension, it can't be executable */
	 */

	if ((mode & X_OK) && !NativeIsExec(nativePath)) {
	    Tcl_SetErrno(EACCES);
	    return -1;
	}

	/*
	 * Special case for read/write/executable check on file
	/* Special case for read/write/executable check on file */
	 */

	if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) {
	    DWORD mask = 0;
	    HANDLE hFile;

	    if (mode & R_OK) {
	    if (mode & R_OK) { mask |= GENERIC_READ;  }
		mask |= GENERIC_READ;
	    }
	    if (mode & W_OK) {
	    if (mode & W_OK) { mask |= GENERIC_WRITE; }
		mask |= GENERIC_WRITE;
	    }
	    if (mode & X_OK) {
	    if (mode & X_OK) { mask |= GENERIC_EXECUTE; }
		mask |= GENERIC_EXECUTE;
	    }


	    hFile = (tclWinProcs->createFileProc)(nativePath, mask,
	    hFile = CreateFileW(nativePath, mask,
		    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
		    NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
		FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
		OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL);
	    if (hFile != INVALID_HANDLE_VALUE) {
		CloseHandle(hFile);
		return 0;
	    }

	    /*
	     * Fast exit if access was denied
	    /* fast exit if access was denied */
	     */

	    if (GetLastError() == ERROR_ACCESS_DENIED) {
		Tcl_SetErrno(EACCES);
		return -1;
	    }
	}

	/*
	 * We cannnot verify the access fast, check it below using security
	/* We cannnot verify the access fast, check it below using security info. */
	 * info.
	 */
    }

    /*
     * It looks as if the permissions are ok, but if we are on NT, 2000 or XP,
     * we have a more complex permissions structure so we try to check that.
     * The code below is remarkably complex for such a simple thing as finding
     * what permissions the OS has set for a file.
     */

    {
    if (tclWinProcs->getFileSecurityProc != NULL) {
	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;

	/*
	 * First find out how big the buffer needs to be.
	 * First find out how big the buffer needs to be
	 */

	size = 0;
	GetFileSecurityW(nativePath,
	(*tclWinProcs->getFileSecurityProc)(nativePath,
		OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
		| DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
		0, 0, &size);

	/*
	 * Should have failed with ERROR_INSUFFICIENT_BUFFER
	 */
1719
1720
1721
1722
1723
1724
1725
1726

1727
1728
1729

1730
1731
1732
1733
1734
1735
1736
1734
1735
1736
1737
1738
1739
1740

1741
1742
1743

1744
1745
1746
1747
1748
1749
1750
1751







-
+


-
+







	sdPtr = (SECURITY_DESCRIPTOR *) HeapAlloc(GetProcessHeap(), 0, size);

	if (sdPtr == NULL) {
	    goto accessError;
	}

	/*
	 * Call GetFileSecurityW() for real.
	 * Call GetFileSecurity() for real.
	 */

	if (!GetFileSecurityW(nativePath,
	if (!(*tclWinProcs->getFileSecurityProc)(nativePath,
		OWNER_SECURITY_INFORMATION | GROUP_SECURITY_INFORMATION
		| DACL_SECURITY_INFORMATION | LABEL_SECURITY_INFORMATION,
		sdPtr, size, &size)) {
	    /*
	     * Error getting owner SD
	     */

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
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







-
+






-
+








-
+







	}

	/*
	 * Perform security impersonation of the user and open the resulting
	 * thread token.
	 */

	if (!ImpersonateSelf(SecurityImpersonation)) {
	if (!(*tclWinProcs->impersonateSelfProc)(SecurityImpersonation)) {
	    /*
	     * Unable to perform security impersonation.
	     */

	    goto accessError;
	}
	if (!OpenThreadToken(GetCurrentThread(),
	if (!(*tclWinProcs->openThreadTokenProc)(GetCurrentThread(),
		TOKEN_DUPLICATE | TOKEN_QUERY, FALSE, &hToken)) {
	    /*
	     * Unable to get current thread's token.
	     */

	    goto accessError;
	}

	RevertToSelf();
	(*tclWinProcs->revertToSelfProc)();

	/*
	 * Setup desiredAccess according to the access priveleges we are
	 * checking.
	 */

	if (mode & R_OK) {
1801
1802
1803
1804
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







-
+







	genMap.GenericExecute = FILE_GENERIC_EXECUTE;
	genMap.GenericAll = FILE_ALL_ACCESS;

	/*
	 * Perform access check using the token.
	 */

	if (!AccessCheck(sdPtr, hToken, desiredAccess,
	if (!(*tclWinProcs->accessCheckProc)(sdPtr, hToken, desiredAccess,
		&genMap, &privSet, &privSetSize, &grantedAccess,
		&accessYesNo)) {
	    /*
	     * Unable to perform access check.
	     */

	accessError:
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
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







-
+

+
+
-
+

-
-
-
+
+
+

-
-
-
+
+
+

+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *	1 = executable, 0 = not.
 *
 *----------------------------------------------------------------------
 */

static int
NativeIsExec(
    const WCHAR *path)
    const TCHAR *nativePath)
{
    if (tclWinProcs->useWide) {
	const WCHAR *path = (const WCHAR *) nativePath;
    int len = wcslen(path);
	int len = wcslen(path);

    if (len < 5) {
	return 0;
    }
	if (len < 5) {
	    return 0;
	}

    if (path[len-4] != '.') {
	return 0;
    }
	if (path[len-4] != L'.') {
	    return 0;
	}

	/*
	 * Use wide-char case-insensitive comparison
	 */

    path += len-3;
    if ((_wcsicmp(path, L"exe") == 0)
	    || (_wcsicmp(path, L"com") == 0)
	    || (_wcsicmp(path, L"cmd") == 0)
	    || (_wcsicmp(path, L"cmd") == 0)
	    || (_wcsicmp(path, L"bat") == 0)) {
	return 1;
	path += len-3;
	if ((_wcsicmp(path, L"exe") == 0)
		|| (_wcsicmp(path, L"com") == 0)
		|| (_wcsicmp(path, L"cmd") == 0)
		|| (_wcsicmp(path, L"bat") == 0)) {
	    return 1;
	}
    } else {
	const char *p;

	/*
	 * We are only looking for pure ascii.
	 */

	p = strrchr((const char *) nativePath, '.');
	if (p != NULL) {
	    p++;

	    /*
	     * Note: in the old code, stat considered '.pif' files as
	     * executable, whereas access did not.
	     */

	    if ((strcasecmp(p, "exe") == 0)
		    || (strcasecmp(p, "com") == 0)
		    || (strcasecmp(p, "cmd") == 0)
		    || (strcasecmp(p, "ps1") == 0)
		    || (strcasecmp(p, "bat") == 0)) {
		/*
		 * File that ends with .exe, .com, or .bat is executable.
		 */

		return 1;
	    }
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
1894
1895
1896
1897
1898
1899
1900
1901

1902
1903

1904
1905
1906
1907
1908

1909
1910
1911
1912
1913
1914
1915
1943
1944
1945
1946
1947
1948
1949

1950
1951

1952
1953
1954
1955
1956

1957
1958
1959
1960
1961
1962
1963
1964







-
+

-
+




-
+







 */

int
TclpObjChdir(
    Tcl_Obj *pathPtr)	/* Path to new working directory. */
{
    int result;
    const WCHAR *nativePath;
    const TCHAR *nativePath;

    nativePath = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
    nativePath = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);

    if (!nativePath) {
	return -1;
    }
    result = SetCurrentDirectoryW(nativePath);
    result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);

    if (result == 0) {
	TclWinConvertError(GetLastError());
	return -1;
    }
    return 0;
}
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
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







-

-
+


-
-
-
+
+








+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







TclpGetCwd(
    Tcl_Interp *interp,		/* If non-NULL, used for error reporting. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of current directory. */
{
    WCHAR buffer[MAX_PATH];
    char *p;
    WCHAR *native;

    if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
    if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
	TclWinConvertError(GetLastError());
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "error getting working directory name: %s",
		    Tcl_PosixError(interp)));
	    Tcl_AppendResult(interp, "error getting working directory name: ",
		    Tcl_PosixError(interp), NULL);
	}
	return NULL;
    }

    /*
     * Watch for the weird Windows c:\\UNC syntax.
     */

    if (tclWinProcs->useWide) {
	WCHAR *native;

    native = (WCHAR *) buffer;
    if ((native[0] != '\0') && (native[1] == ':')
	    && (native[2] == '\\') && (native[3] == '\\')) {
	native += 2;
    }
    Tcl_DStringInit(bufferPtr);
    Tcl_WCharToUtfDString(native, -1, bufferPtr);
	native = (WCHAR *) buffer;
	if ((native[0] != '\0') && (native[1] == ':')
		&& (native[2] == '\\') && (native[3] == '\\')) {
	    native += 2;
	}
	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
    } else {
	char *native;

	native = (char *) buffer;
	if ((native[0] != '\0') && (native[1] == ':')
		&& (native[2] == '\\') && (native[3] == '\\')) {
	    native += 2;
	}
	Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
    }

    /*
     * Convert to forward slashes for easier use in scripts.
     */

    for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
	if (*p == '\\') {
1989
1990
1991
1992
1993
1994
1995
1996


1997
1998
1999
2000
2001
2002
2003
2048
2049
2050
2051
2052
2053
2054

2055
2056
2057
2058
2059
2060
2061
2062
2063







-
+
+







     * Ensure correct file sizes by forcing the OS to write any pending data
     * to disk. This is done only for channels which are dirty, i.e. have been
     * written to since the last flush here.
     */

    TclWinFlushDirtyChannels();

    return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 0);
    return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
	    statPtr, 0);
}

/*
 *----------------------------------------------------------------------
 *
 * NativeStat --
 *
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
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







-
+








-







-
-
-
-
-
-
-


-
+








-
-
+
-
-
-
-
+
+
+
+

-
-
-
+

-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-


















-
+






-
+


-
+






-
+















+
+
+
+
+
-
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+







 *	See stat documentation.
 *
 *----------------------------------------------------------------------
 */

static int
NativeStat(
    const WCHAR *nativePath,	/* Path of file to stat */
    const TCHAR *nativePath,	/* Path of file to stat */
    Tcl_StatBuf *statPtr,	/* Filled with results of stat call. */
    int checkLinks)		/* If non-zero, behave like 'lstat' */
{
    DWORD attr;
    int dev, nlink = 1;
    unsigned short mode;
    unsigned int inode = 0;
    HANDLE fileHandle;
    DWORD fileType = FILE_TYPE_UNKNOWN;

    /*
     * If we can use 'createFile' on this, then we can use the resulting
     * fileHandle to read more information (nlink, ino) than we can get from
     * other attributes reading APIs. If not, then we try to fall back on the
     * 'getFileAttributesExProc', and if that isn't available, then on even
     * simpler routines.
     *
     * Special consideration must be given to Windows hardcoded names like
     * CON, NULL, COM1, LPT1 etc. For these, we still need to do the
     * CreateFile as some may not exist (e.g. there is no CON in wish by
     * default). However the subsequent GetFileInformationByHandle will
     * fail. We do a WinIsReserved to see if it is one of the special names,
     * and if successful, mock up a BY_HANDLE_FILE_INFORMATION structure.
     */

    fileHandle = CreateFileW(nativePath, GENERIC_READ,
    fileHandle = (tclWinProcs->createFileProc)(nativePath, GENERIC_READ,
	    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
	    NULL, OPEN_EXISTING,
	    FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);

    if (fileHandle != INVALID_HANDLE_VALUE) {
	BY_HANDLE_FILE_INFORMATION data;

	if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {
            fileType = GetFileType(fileHandle);
            CloseHandle(fileHandle);
	    CloseHandle(fileHandle);
            if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) {
                Tcl_SetErrno(ENOENT);
                return -1;
            }
	    Tcl_SetErrno(ENOENT);
	    return -1;
	}
	CloseHandle(fileHandle);

            /*
	     * Mock up the expected structure
	     */
	attr = data.dwFileAttributes;

            memset(&data, 0, sizeof(data));
            statPtr->st_atime = 0;
	statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
            statPtr->st_mtime = 0;
            statPtr->st_ctime = 0;
        } else {
            CloseHandle(fileHandle);
            statPtr->st_atime = ToCTime(data.ftLastAccessTime);
            statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
            statPtr->st_ctime = ToCTime(data.ftCreationTime);
		(((Tcl_WideInt) data.nFileSizeHigh) << 32);
	statPtr->st_atime = ToCTime(data.ftLastAccessTime);
	statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
	statPtr->st_ctime = ToCTime(data.ftCreationTime);
        }
	attr = data.dwFileAttributes;
	statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
		(((Tcl_WideInt) data.nFileSizeHigh) << 32);

	/*
	 * On Unix, for directories, nlink apparently depends on the number of
	 * files in the directory.  We could calculate that, but it would be a
	 * bit of a performance penalty, I think. Hence we just use what
	 * Windows gives us, which is the same as Unix for files, at least.
	 */

	nlink = data.nNumberOfLinks;

	/*
	 * Unfortunately our stat definition's inode field (unsigned short)
	 * will throw away most of the precision we have here, which means we
	 * can't rely on inode as a unique identifier of a file. We'd really
	 * like to do something like how we handle 'st_size'.
	 */

	inode = data.nFileIndexHigh | data.nFileIndexLow;
    } else {
    } else if (tclWinProcs->getFileAttributesExProc != NULL) {
	/*
	 * Fall back on the less capable routines. This means no nlink or ino.
	 */

	WIN32_FILE_ATTRIBUTE_DATA data;

	if (GetFileAttributesExW(nativePath,
	if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
		GetFileExInfoStandard, &data) != TRUE) {
	    HANDLE hFind;
	    WIN32_FIND_DATAW ffd;
	    WIN32_FIND_DATAT ffd;
	    DWORD lasterror = GetLastError();

	    if (lasterror != ERROR_SHARING_VIOLATION) {
		TclWinConvertError(lasterror);
		return -1;
		}
	    hFind = FindFirstFileW(nativePath, &ffd);
	    hFind = (*tclWinProcs->findFirstFileProc)(nativePath, &ffd);
	    if (hFind == INVALID_HANDLE_VALUE) {
		TclWinConvertError(GetLastError());
		return -1;
	    }
	    memcpy(&data, &ffd, sizeof(data));
	    FindClose(hFind);
	}

	attr = data.dwFileAttributes;

	statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
		(((Tcl_WideInt) data.nFileSizeHigh) << 32);
	statPtr->st_atime = ToCTime(data.ftLastAccessTime);
	statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
	statPtr->st_ctime = ToCTime(data.ftCreationTime);
    } else {
	/*
	 * We don't have the faster attributes proc, so we're probably running
	 * on Win95.
	 */
    }

	WIN32_FIND_DATAT data;
	HANDLE handle;

    dev = NativeDev(nativePath);
    mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
    if (fileType == FILE_TYPE_CHAR) {
        mode &= ~S_IFMT;
        mode |= S_IFCHR;
    } else if (fileType == FILE_TYPE_DISK) {
        mode &= ~S_IFMT;
        mode |= S_IFBLK;
	handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
	if (handle == INVALID_HANDLE_VALUE) {
	    /*
	     * FindFirstFile() doesn't work on root directories, so call
	     * GetFileAttributes() to see if the specified file exists.
	     */

	    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
	    if (attr == INVALID_FILE_ATTRIBUTES) {
		Tcl_SetErrno(ENOENT);
		return -1;
	    }

	    /*
	     * Make up some fake information for this file. It has the correct
	     * file attributes and a time of 0.
	     */

	    memset(&data, 0, sizeof(data));
	    data.a.dwFileAttributes = attr;
	} else {
	    FindClose(handle);
	}

	attr = data.a.dwFileAttributes;

	statPtr->st_size = ((Tcl_WideInt) data.a.nFileSizeLow) |
		(((Tcl_WideInt) data.a.nFileSizeHigh) << 32);
	statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
	statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
	statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
    }

    dev = NativeDev(nativePath);
    mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));

    statPtr->st_dev	= (dev_t) dev;
    statPtr->st_ino	= inode;
    statPtr->st_mode	= mode;
    statPtr->st_nlink	= nlink;
    statPtr->st_uid	= 0;
    statPtr->st_gid	= 0;
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
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







-
+




-
+


+
-
-
-
+
+
+




-
+






-
+



-
+




-
-
+

+
-
+


-
-
+
+







 *	Calculate just the 'st_dev' field of a 'stat' structure.
 *
 *----------------------------------------------------------------------
 */

static int
NativeDev(
    const WCHAR *nativePath)	/* Full path of file to stat */
    const TCHAR *nativePath)	/* Full path of file to stat */
{
    int dev;
    Tcl_DString ds;
    WCHAR nativeFullPath[MAX_PATH];
    WCHAR *nativePart;
    TCHAR *nativePart;
    const char *fullPath;

    (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH,
    GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart);
    Tcl_DStringInit(&ds);
    fullPath = Tcl_WCharToUtfDString(nativeFullPath, -1, &ds);
	    nativeFullPath, &nativePart);

    fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);

    if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
	const char *p;
	DWORD dw;
	const WCHAR *nativeVol;
	const TCHAR *nativeVol;
	Tcl_DString volString;

	p = strchr(fullPath + 2, '\\');
	p = strchr(p + 1, '\\');
	if (p == NULL) {
	    /*
	     * Add terminating backslash to fullpath or GetVolumeInformationW()
	     * Add terminating backslash to fullpath or GetVolumeInformation()
	     * won't work.
	     */

	    fullPath = TclDStringAppendLiteral(&ds, "\\");
	    fullPath = Tcl_DStringAppend(&ds, "\\", 1);
	    p = fullPath + Tcl_DStringLength(&ds);
	} else {
	    p++;
	}
	Tcl_DStringInit(&volString);
	nativeVol = Tcl_UtfToWCharDString(fullPath, p - fullPath, &volString);
	nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
	dw = (DWORD) -1;
	(*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
	GetVolumeInformationW(nativeVol, NULL, 0, &dw, NULL, NULL, NULL, 0);
		NULL, NULL, NULL, 0);

	/*
	 * GetFullPathNameW() turns special devices like "NUL" into "\\.\NUL",
	 * but GetVolumeInformationW() returns failure for "\\.\NUL". This will
	 * GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
	 * but GetVolumeInformation() returns failure for "\\.\NUL". This will
	 * cause "NUL" to get a drive number of -1, which makes about as much
	 * sense as anything since the special devices don't live on any
	 * drive.
	 */

	dev = dw;
	Tcl_DStringFree(&volString);
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
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







-
+







-
+








-
+








-
+









-
+



-

-
+







}

/*
 *------------------------------------------------------------------------
 *
 * ToCTime --
 *
 *	Converts a Windows FILETIME to a __time64_t in UTC.
 *	Converts a Windows FILETIME to a time_t in UTC.
 *
 * Results:
 *	Returns the count of seconds from the Posix epoch.
 *
 *------------------------------------------------------------------------
 */

static __time64_t
static time_t
ToCTime(
    FILETIME fileTime)		/* UTC time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.LowPart = fileTime.dwLowDateTime;
    convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;

    return (__time64_t) ((convertedTime.QuadPart -
    return (time_t) ((convertedTime.QuadPart -
	    (Tcl_WideInt) POSIX_EPOCH_AS_FILETIME) / (Tcl_WideInt) 10000000);
}

/*
 *------------------------------------------------------------------------
 *
 * FromCTime --
 *
 *	Converts a __time64_t to a Windows FILETIME
 *	Converts a time_t to a Windows FILETIME
 *
 * Results:
 *	Returns the count of 100-ns ticks seconds from the Windows epoch.
 *
 *------------------------------------------------------------------------
 */

static void
FromCTime(
    __time64_t posixTime,
    time_t posixTime,
    FILETIME *fileTime)		/* UTC Time */
{
    LARGE_INTEGER convertedTime;

    convertedTime.QuadPart = ((LONGLONG) posixTime) * 10000000
	    + POSIX_EPOCH_AS_FILETIME;
	+ POSIX_EPOCH_AS_FILETIME;
    fileTime->dwLowDateTime = convertedTime.LowPart;
    fileTime->dwHighDateTime = convertedTime.HighPart;
}

/*
 *---------------------------------------------------------------------------
 *
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
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







-
+





+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+



-
+







-
+















-
+
+











-
-
+
+






-
+











-
+







-
+








ClientData
TclpGetNativeCwd(
    ClientData clientData)
{
    WCHAR buffer[MAX_PATH];

    if (GetCurrentDirectoryW(MAX_PATH, buffer) == 0) {
    if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
	TclWinConvertError(GetLastError());
	return NULL;
    }

    if (clientData != NULL) {
	if (tclWinProcs->useWide) {
	    /*
	     * Unicode representation when running on NT/2K/XP.
	     */

	if (wcscmp((const WCHAR *) clientData, buffer) == 0) {
	    return clientData;
	    if (wcscmp((const WCHAR*)clientData, (const WCHAR*)buffer) == 0) {
		return clientData;
	    }
	} else {
	    /*
	     * ANSI representation when running on 95/98/ME.
	     */

	    if (strcmp((const char*) clientData, (const char*) buffer) == 0) {
		return clientData;
	    }
	}
    }

    return TclNativeDupInternalRep(buffer);
    return TclNativeDupInternalRep((ClientData) buffer);
}

int
TclpObjAccess(
    Tcl_Obj *pathPtr,
    int mode)
{
    return NativeAccess((const WCHAR *)Tcl_FSGetNativePath(pathPtr), mode);
    return NativeAccess((const TCHAR *) Tcl_FSGetNativePath(pathPtr), mode);
}

int
TclpObjLstat(
    Tcl_Obj *pathPtr,
    Tcl_StatBuf *statPtr)
{
    /*
     * Ensure correct file sizes by forcing the OS to write any pending data
     * to disk. This is done only for channels which are dirty, i.e. have been
     * written to since the last flush here.
     */

    TclWinFlushDirtyChannels();

    return NativeStat((const WCHAR *)Tcl_FSGetNativePath(pathPtr), statPtr, 1);
    return NativeStat((const TCHAR *) Tcl_FSGetNativePath(pathPtr),
	    statPtr, 1);
}

#ifdef S_IFLNK
Tcl_Obj *
TclpObjLink(
    Tcl_Obj *pathPtr,
    Tcl_Obj *toPtr,
    int linkAction)
{
    if (toPtr != NULL) {
	int res;
	const WCHAR *LinkTarget;
	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	TCHAR *LinkTarget;
	TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);
	Tcl_Obj *normalizedToPtr = Tcl_FSGetNormalizedPath(NULL, toPtr);

	if (normalizedToPtr == NULL) {
	    return NULL;
	}

	LinkTarget = (const WCHAR *)Tcl_FSGetNativePath(normalizedToPtr);
	LinkTarget = (TCHAR *) Tcl_FSGetNativePath(normalizedToPtr);

	if (LinkSource == NULL || LinkTarget == NULL) {
	    return NULL;
	}
	res = WinLink(LinkSource, LinkTarget, linkAction);
	if (res == 0) {
	    return toPtr;
	} else {
	    return NULL;
	}
    } else {
	const WCHAR *LinkSource = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
	TCHAR *LinkSource = (TCHAR *) Tcl_FSGetNativePath(pathPtr);

	if (LinkSource == NULL) {
	    return NULL;
	}
	return WinReadLink(LinkSource);
    }
}
#endif /* S_IFLNK */
#endif

/*
 *---------------------------------------------------------------------------
 *
 * TclpFilesystemPathType --
 *
 *	This function is part of the native filesystem support, and returns
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
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







-
+






+
-
-
+
+




+
-
-
+
+







+

+
+
-
-
-
+
+
+







    char *firstSeparator;
    const char *path;
    Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);

    if (normPath == NULL) {
	return NULL;
    }
    path = TclGetString(normPath);
    path = Tcl_GetString(normPath);
    if (path == NULL) {
	return NULL;
    }

    firstSeparator = strchr(path, '/');
    if (firstSeparator == NULL) {
	found = tclWinProcs->getVolumeInformationProc(
	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr),
		NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
		Tcl_FSGetNativePath(pathPtr), NULL, 0, NULL, NULL, NULL,
		(WCHAR *) volType, VOL_BUF_SIZE);
    } else {
	Tcl_Obj *driveName = Tcl_NewStringObj(path, firstSeparator - path+1);

	Tcl_IncrRefCount(driveName);
	found = tclWinProcs->getVolumeInformationProc(
	found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(driveName),
		NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
		Tcl_FSGetNativePath(driveName), NULL, 0, NULL, NULL, NULL,
		(WCHAR *) volType, VOL_BUF_SIZE);
	Tcl_DecrRefCount(driveName);
    }

    if (found == 0) {
	return NULL;
    } else {
	Tcl_DString ds;
	Tcl_Obj *objPtr;

	Tcl_WinTCharToUtf((const char *) volType, -1, &ds);
	objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString(volType, -1, &ds);
	return TclDStringToObj(&ds);
		Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
	return objPtr;
    }
#undef VOL_BUF_SIZE
}

/*
 * This define can be turned on to experiment with a different way of
 * normalizing paths (using a different Windows API). Unfortunately the new
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
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
2658
2659
2660
2661
2662
2663





2664
2665
2666


2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713






2714
2715
2716
2717
2718




2719
2720
2721
2722
2723
2724
2725
2726
2727
2728









2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739










2740
2741
2742
2743
2744




2745
2746
2747
2748




2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764





2765
2766
2767
2768
2769
2770


2771
2772

2773
2774
2775
2776

2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794





2795
2796
2797
2798
2799


2800
2801
2802
2803

2804
2805
2806
2807


2808
2809
2810
2811
2812
2813
2814


2815
2816

2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2611
2612
2613
2614
2615
2616
2617


2618
2619


2620
2621
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791






2792
2793
2794
2795
2796
2797
2798




2799
2800
2801
2802
2803

2804





2805
2806
2807





2808
2809
2810
2811
2812
2813


2814
2815
2816




2817
2818
2819
2820
2821

2822
2823


2824
2825
2826






2827
2828
2829
2830
2831
2832




2833
2834
2835




2836
2837
2838
2839








2840
2841
2842
2843
2844
2845
2846





2847
2848
2849
2850
2851
2852






2853
2854
2855
2856
2857
2858
2859
2860



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
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







-
-
+
+
-
-
+





+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
+
-
-
-
-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
+
+
+
+

-
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+
-
-
-
-
-
-
+
+
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+
+








-
-
-
-
-
-
-
-
+
+
+
+
+




-
-
+
+

-
+
-


-
+














-
-
-
-
+
+
+
+
+





+
+

-

-
+


-
-
+
+






-
+
+

-
+











-







 *	modified in place.
 *
 *---------------------------------------------------------------------------
 */

int
TclpObjNormalizePath(
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Obj *pathPtr,	        /* An unshared object containing the path to
    Tcl_Interp *interp,
    Tcl_Obj *pathPtr,
				 * normalize */
    int nextCheckpoint)	        /* offset to start at in pathPtr */
    int nextCheckpoint)
{
    char *lastValidPathEnd = NULL;
    Tcl_DString dsNorm;		/* This will hold the normalized string. */
    char *path, *currentPathEndPosition;
    Tcl_Obj *temp = NULL;

    Tcl_DStringInit(&dsNorm);
    path = Tcl_GetString(pathPtr);

    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) {
	/*
	 * We're on Win95, 98 or ME. There are two assumptions in this block
	 * of code. First that the native (NULL) encoding is basically ascii,
	 * and second that symbolic links are not possible. Both of these
	 * assumptions appear to be true of these operating systems.
	 */

    int isDrive = 1;
    Tcl_DString ds;		/* Some workspace. */
	int isDrive = 1;
	Tcl_DString ds;

	currentPathEndPosition = path + nextCheckpoint;
	if (*currentPathEndPosition == '/') {
	    currentPathEndPosition++;
	}

	while (1) {
	    char cur = *currentPathEndPosition;

	    if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
		/*
		 * Reached directory separator, or end of string.
		 */

		const char *nativePath = Tcl_UtfToExternalDString(NULL, path,
			currentPathEndPosition - path, &ds);

		/*
		 * Now we convert the tail of the current path to its 'long
		 * form', and append it to 'dsNorm' which holds the current
		 * normalized path, if the file exists.
		 */

		if (isDrive) {
		    if (GetFileAttributesA(nativePath)
			    == INVALID_FILE_ATTRIBUTES) {
			/*
			 * File doesn't exist.
			 */

			if (isDrive) {
			    int len = WinIsReserved(path);

			    if (len > 0) {
				/*
				 * Actually it does exist - COM1, etc.
				 */

				int i;

				for (i=0 ; i<len ; i++) {
				    if (nativePath[i] >= 'a') {
					((char *) nativePath)[i] -= ('a'-'A');
				    }
				}
				Tcl_DStringAppend(&dsNorm, nativePath, len);
				lastValidPathEnd = currentPathEndPosition;
			    } else if (nextCheckpoint == 0) {
				/* Path starts with a drive designation
				 * that's not actually on the system.
				 * We still must normalize up past the
				 * first separator.  [Bug 3603434] */
				currentPathEndPosition++;
			    }
			}
    Tcl_DStringInit(&dsNorm);
    path = TclGetString(pathPtr);
			Tcl_DStringFree(&ds);
			break;
		    }
		    if (nativePath[0] >= 'a') {
			((char *) nativePath)[0] -= ('a' - 'A');
		    }
		    Tcl_DStringAppend(&dsNorm, nativePath,
			    Tcl_DStringLength(&ds));
		} else {
		    char *checkDots = NULL;

		    if (lastValidPathEnd[1] == '.') {
			checkDots = lastValidPathEnd + 1;
			while (checkDots < currentPathEndPosition) {
			    if (*checkDots != '.') {
				checkDots = NULL;
				break;
			    }
			    checkDots++;
			}
		    }
		    if (checkDots != NULL) {
			int dotLen = currentPathEndPosition-lastValidPathEnd;

			/*
			 * Path is just dots. We shouldn't really ever see a
			 * path like that. However, to be nice we at least
			 * don't mangle the path - we just add the dots as a
			 * path segment and continue
			 */

			Tcl_DStringAppend(&dsNorm, (TCHAR *)
				(nativePath + Tcl_DStringLength(&ds)-dotLen),
				dotLen);
		    } else {
			/*
			 * Normal path.
			 */

			WIN32_FIND_DATA fData;
			HANDLE handle;

			handle = FindFirstFileA(nativePath, &fData);
			if (handle == INVALID_HANDLE_VALUE) {
			    if (GetFileAttributesA(nativePath)
				    == INVALID_FILE_ATTRIBUTES) {
				/*
				 * File doesn't exist.
				 */

				Tcl_DStringFree(&ds);
				break;
			    }

			    /*
			     * This is usually the '/' in 'c:/' at end of
			     * string.
			     */

			    Tcl_DStringAppend(&dsNorm,"/", 1);
			} else {
			    char *nativeName;

			    if (fData.cFileName[0] != '\0') {
				nativeName = fData.cFileName;
			    } else {
				nativeName = fData.cAlternateFileName;
			    }
			    FindClose(handle);
			    Tcl_DStringAppend(&dsNorm,"/", 1);
			    Tcl_DStringAppend(&dsNorm,nativeName,-1);
			}
		    }
		}
		Tcl_DStringFree(&ds);
		lastValidPathEnd = currentPathEndPosition;
		if (cur == 0) {
		    break;
		}

		/*
		 * If we get here, we've got past one directory delimiter, so
		 * we know it is no longer a drive.
		 */

		isDrive = 0;
	    }
	    currentPathEndPosition++;
	}
    } else {
	/*
	 * We're on WinNT (or 2000 or XP; something with an NT core).
	 */

	int isDrive = 1;
	Tcl_DString ds;

    currentPathEndPosition = path + nextCheckpoint;
    if (*currentPathEndPosition == '/') {
	currentPathEndPosition++;
    }
    while (1) {
	char cur = *currentPathEndPosition;
	currentPathEndPosition = path + nextCheckpoint;
	if (*currentPathEndPosition == '/') {
	    currentPathEndPosition++;
	}
	while (1) {
	    char cur = *currentPathEndPosition;

	if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
	    /*
	     * Reached directory separator, or end of string.
	     */
	    if ((cur=='/' || cur==0) && (path != currentPathEndPosition)) {
		/*
		 * Reached directory separator, or end of string.
		 */

	    WIN32_FILE_ATTRIBUTE_DATA data;
		WIN32_FILE_ATTRIBUTE_DATA data;
	    const WCHAR *nativePath;

	    Tcl_DStringInit(&ds);
	    nativePath = Tcl_UtfToWCharDString(path,
		    currentPathEndPosition - path, &ds);
		const char *nativePath = Tcl_WinUtfToTChar(path,
			currentPathEndPosition - path, &ds);

	    if (GetFileAttributesExW(nativePath,
		    GetFileExInfoStandard, &data) != TRUE) {
		/*
		 * File doesn't exist.
		 */
		if ((*tclWinProcs->getFileAttributesExProc)(nativePath,
			GetFileExInfoStandard, &data) != TRUE) {
		    /*
		     * File doesn't exist.
		     */

		if (isDrive) {
		    int len = WinIsReserved(path);
		    if (isDrive) {
			int len = WinIsReserved(path);

		    if (len > 0) {
			/*
			 * Actually it does exist - COM1, etc.
			 */
			if (len > 0) {
			    /*
			     * Actually it does exist - COM1, etc.
			     */

			int i;
			    int i;

			for (i=0 ; i<len ; i++) {
			    WCHAR wc = ((WCHAR *) nativePath)[i];
			    for (i=0 ; i<len ; i++) {
				WCHAR wc = ((WCHAR *) nativePath)[i];

			    if (wc >= 'a') {
				wc -= ('a' - 'A');
				((WCHAR *) nativePath)[i] = wc;
			    }
			}
			Tcl_DStringAppend(&dsNorm,
				if (wc >= L'a') {
				    wc -= (L'a' - L'A');
				    ((WCHAR *) nativePath)[i] = wc;
				}
			    }
			    Tcl_DStringAppend(&dsNorm, nativePath,
				(const char *)nativePath,
				(int)(sizeof(WCHAR) * len));
			lastValidPathEnd = currentPathEndPosition;
		    } else if (nextCheckpoint == 0) {
				    (int)(sizeof(WCHAR) * len));
			    lastValidPathEnd = currentPathEndPosition;
			} else if (nextCheckpoint == 0) {
			/*
			 * Path starts with a drive designation that's not
			 * actually on the system. We still must normalize up
			 * past the first separator. [Bug 3603434]
			    /* Path starts with a drive designation
			     * that's not actually on the system.
			     * We still must normalize up past the
			     * first separator.  [Bug 3603434] */
			 */

			currentPathEndPosition++;
		    }
		}
		Tcl_DStringFree(&ds);
		break;
	    }
			    currentPathEndPosition++;
			}
		    }
		    Tcl_DStringFree(&ds);
		    break;
		}

	    /*
	     * File 'nativePath' does exist if we get here. We now want to
	     * check if it is a symlink and otherwise continue with the
	     * rest of the path.
	     */
		/*
		 * File 'nativePath' does exist if we get here. We now want to
		 * check if it is a symlink and otherwise continue with the
		 * rest of the path.
		 */

	    /*
	     * Check for symlinks, except at last component of path (we don't
	     * follow final symlinks). Also a drive (C:/) for example, may
	     * sometimes have the reparse flag set for some reason I don't
	     * understand. We therefore don't perform this check for drives.
	     */
		/*
		 * Check for symlinks, except at last component of path (we
		 * don't follow final symlinks). Also a drive (C:/) for
		 * example, may sometimes have the reparse flag set for some
		 * reason I don't understand. We therefore don't perform this
		 * check for drives.
		 */

	    if (cur != 0 && !isDrive &&
		    data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){
		Tcl_Obj *to = WinReadLinkDirectory(nativePath);
		if (cur != 0 && !isDrive &&
			data.dwFileAttributes & FILE_ATTRIBUTE_REPARSE_POINT){
		    Tcl_Obj *to = WinReadLinkDirectory(nativePath);

		if (to != NULL) {
		    /*
		     * Read the reparse point ok. Now, reparse points need not
		     * be normalized, otherwise we could use:
		     *
		     * Tcl_GetStringFromObj(to, &pathLen);
		     * nextCheckpoint = pathLen;
		     *
		     * So, instead we have to start from the beginning.
		     */
		    if (to != NULL) {
			/*
			 * Read the reparse point ok. Now, reparse points need
			 * not be normalized, otherwise we could use:
			 *
			 * Tcl_GetStringFromObj(to, &pathLen);
			 * nextCheckpoint = pathLen
			 *
			 * So, instead we have to start from the beginning.
			 */

		    nextCheckpoint = 0;
		    Tcl_AppendToObj(to, currentPathEndPosition, -1);
			nextCheckpoint = 0;
			Tcl_AppendToObj(to, currentPathEndPosition, -1);

		    /*
		     * Convert link to forward slashes.
		     */
			/*
			 * Convert link to forward slashes.
			 */

		    for (path = TclGetString(to); *path != 0; path++) {
			if (*path == '\\') {
			    *path = '/';
			}
		    }
		    path = TclGetString(to);
		    currentPathEndPosition = path + nextCheckpoint;
		    if (temp != NULL) {
			Tcl_DecrRefCount(temp);
		    }
		    temp = to;
			for (path = Tcl_GetString(to); *path != 0; path++) {
			    if (*path == '\\') {
				*path = '/';
			    }
			}
			path = Tcl_GetString(to);
			currentPathEndPosition = path + nextCheckpoint;
			if (temp != NULL) {
			    Tcl_DecrRefCount(temp);
			}
			temp = to;

		    /*
		     * Reset variables so we can restart normalization.
		     */
			/*
			 * Reset variables so we can restart normalization.
			 */

		    isDrive = 1;
		    Tcl_DStringFree(&dsNorm);
		    Tcl_DStringFree(&ds);
		    continue;
		}
	    }
			isDrive = 1;
			Tcl_DStringFree(&dsNorm);
			Tcl_DStringInit(&dsNorm);
			Tcl_DStringFree(&ds);
			continue;
		    }
		}

#ifndef TclNORM_LONG_PATH
	    /*
	     * Now we convert the tail of the current path to its 'long form',
	     * and append it to 'dsNorm' which holds the current normalized
	     * path
	     */
		/*
		 * Now we convert the tail of the current path to its 'long
		 * form', and append it to 'dsNorm' which holds the current
		 * normalized path
		 */

	    if (isDrive) {
		WCHAR drive = ((WCHAR *) nativePath)[0];
		if (isDrive) {
		    WCHAR drive = ((WCHAR *) nativePath)[0];

		if (drive >= 'a') {
		    drive -= ('a' - 'A');
		    ((WCHAR *) nativePath)[0] = drive;
		}
		Tcl_DStringAppend(&dsNorm, (const char *)nativePath,
			Tcl_DStringLength(&ds));
	    } else {
		char *checkDots = NULL;
		    if (drive >= L'a') {
			drive -= (L'a' - L'A');
			((WCHAR *) nativePath)[0] = drive;
		    }
		    Tcl_DStringAppend(&dsNorm, nativePath,
			    Tcl_DStringLength(&ds));
		} else {
		    char *checkDots = NULL;

		if (lastValidPathEnd[1] == '.') {
		    checkDots = lastValidPathEnd + 1;
		    while (checkDots < currentPathEndPosition) {
			if (*checkDots != '.') {
			    checkDots = NULL;
			    break;
			}
			checkDots++;
		    }
		}
		if (checkDots != NULL) {
		    int dotLen = currentPathEndPosition-lastValidPathEnd;
		    if (lastValidPathEnd[1] == '.') {
			checkDots = lastValidPathEnd + 1;
			while (checkDots < currentPathEndPosition) {
			    if (*checkDots != '.') {
				checkDots = NULL;
				break;
			    }
			    checkDots++;
			}
		    }
		    if (checkDots != NULL) {
			int dotLen = currentPathEndPosition-lastValidPathEnd;

		    /*
		     * Path is just dots. We shouldn't really ever see a path
		     * like that. However, to be nice we at least don't mangle
		     * the path - we just add the dots as a path segment and
		     * continue.
		     */
			/*
			 * Path is just dots. We shouldn't really ever see a
			 * path like that. However, to be nice we at least
			 * don't mangle the path - we just add the dots as a
			 * path segment and continue.
			 */

		    Tcl_DStringAppend(&dsNorm, ((const char *)nativePath)
			    + Tcl_DStringLength(&ds)
			Tcl_DStringAppend(&dsNorm, (TCHAR *)
				((WCHAR*)(nativePath + Tcl_DStringLength(&ds))
			    - (dotLen * sizeof(WCHAR)),
			    dotLen * sizeof(WCHAR));
		} else {
		    /*
		     * Normal path.
		     */
				- dotLen), (int)(dotLen * sizeof(WCHAR)));
		    } else {
			/*
			 * Normal path.
			 */

		    WIN32_FIND_DATAW fData;
		    HANDLE handle;
			WIN32_FIND_DATAW fData;
			HANDLE handle;

		    handle = FindFirstFileW((WCHAR *) nativePath, &fData);
		    if (handle == INVALID_HANDLE_VALUE) {
			/*
			 * This is usually the '/' in 'c:/' at end of string.
			 */
			handle = FindFirstFileW((WCHAR *) nativePath, &fData);
			if (handle == INVALID_HANDLE_VALUE) {
			    /*
			     * This is usually the '/' in 'c:/' at end of
			     * string.
			     */

			Tcl_DStringAppend(&dsNorm, (const char *) L"/",
				sizeof(WCHAR));
		    } else {
			WCHAR *nativeName;
			    Tcl_DStringAppend(&dsNorm, (const char *) L"/",
				    sizeof(WCHAR));
			} else {
			    WCHAR *nativeName;

			if (fData.cFileName[0] != '\0') {
			    nativeName = fData.cFileName;
			} else {
			    nativeName = fData.cAlternateFileName;
			}
			FindClose(handle);
			Tcl_DStringAppend(&dsNorm, (const char *) L"/",
				sizeof(WCHAR));
			Tcl_DStringAppend(&dsNorm,
			    if (fData.cFileName[0] != '\0') {
				nativeName = fData.cFileName;
			    } else {
				nativeName = fData.cAlternateFileName;
			    }
			    FindClose(handle);
			    Tcl_DStringAppend(&dsNorm, (const char *) L"/",
				    sizeof(WCHAR));
			    Tcl_DStringAppend(&dsNorm, (TCHAR *) nativeName,
				(const char *) nativeName,
				(int) (wcslen(nativeName)*sizeof(WCHAR)));
		    }
		}
	    }
#endif /* !TclNORM_LONG_PATH */
	    Tcl_DStringFree(&ds);
	    lastValidPathEnd = currentPathEndPosition;
	    if (cur == 0) {
		break;
	    }
				    (int) (wcslen(nativeName)*sizeof(WCHAR)));
			}
		    }
		}
#endif
		Tcl_DStringFree(&ds);
		lastValidPathEnd = currentPathEndPosition;
		if (cur == 0) {
		    break;
		}

	    /*
	     * If we get here, we've got past one directory delimiter, so we
	     * know it is no longer a drive.
	     */
		/*
		 * If we get here, we've got past one directory delimiter, so
		 * we know it is no longer a drive.
		 */

	    isDrive = 0;
	}
	currentPathEndPosition++;
		isDrive = 0;
	    }
	    currentPathEndPosition++;
	}

#ifdef TclNORM_LONG_PATH
	/*
	 * Convert the entire known path to long form.
	 */

	if (1) {
	    WCHAR wpath[MAX_PATH];
	    const WCHAR *nativePath;
	    DWORD wpathlen;

	    Tcl_DStringInit(&ds);
	    nativePath =
		    Tcl_UtfToWCharDString(path, lastValidPathEnd - path, &ds);
	    wpathlen = GetLongPathNameProc(nativePath,
		    (WCHAR *) wpath, MAX_PATH);
	    const char *nativePath =
		    Tcl_WinUtfToTChar(path, lastValidPathEnd - path, &ds);
	    DWORD wpathlen = (*tclWinProcs->getLongPathNameProc)(
		    nativePath, (TCHAR *) wpath, MAX_PATH);

	    /*
	     * We have to make the drive letter uppercase.
	     */

	    if (wpath[0] >= 'a') {
		wpath[0] -= ('a' - 'A');
	    if (wpath[0] >= L'a') {
		wpath[0] -= (L'a' - L'A');
	    }
	    Tcl_DStringAppend(&dsNorm, (const char *) wpath,
	    Tcl_DStringAppend(&dsNorm, (TCHAR*)wpath, wpathlen*sizeof(WCHAR));
		    wpathlen * sizeof(WCHAR));
	    Tcl_DStringFree(&ds);
	}
#endif /* TclNORM_LONG_PATH */
#endif
    }

    /*
     * Common code path for all Windows platforms.
     */

    nextCheckpoint = currentPathEndPosition - path;
    if (lastValidPathEnd != NULL) {
	/*
	 * Concatenate the normalized string in dsNorm with the tail of the
	 * path which we didn't recognise. The string in dsNorm is in the
	 * native encoding, so we have to convert it to Utf.
	 */

	Tcl_DStringInit(&ds);
	Tcl_WCharToUtfDString((const WCHAR *) Tcl_DStringValue(&dsNorm),
		Tcl_DStringLength(&dsNorm)>>1, &ds);
	nextCheckpoint = Tcl_DStringLength(&ds);
	Tcl_DString dsTemp;

	Tcl_WinTCharToUtf(Tcl_DStringValue(&dsNorm),
		Tcl_DStringLength(&dsNorm), &dsTemp);
	nextCheckpoint = Tcl_DStringLength(&dsTemp);
	if (*lastValidPathEnd != 0) {
	    /*
	     * Not the end of the string.
	     */

	    int len;
	    char *path;
	    Tcl_Obj *tmpPathPtr;
	    size_t length;

	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
	    path = TclGetStringFromObj(tmpPathPtr, &length);
	    Tcl_SetStringObj(pathPtr, path, length);
	    path = Tcl_GetStringFromObj(tmpPathPtr, &len);
	    Tcl_SetStringObj(pathPtr, path, len);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);
	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&dsTemp),
		    nextCheckpoint);
	}
	Tcl_DStringFree(&ds);
	Tcl_DStringFree(&dsTemp);
    }
    Tcl_DStringFree(&dsNorm);

    /*
     * This must be done after we are totally finished with 'path' as we are
     * sharing the same underlying string.
     */

    if (temp != NULL) {
	Tcl_DecrRefCount(temp);
    }

    return nextCheckpoint;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinVolumeRelativeNormalize --
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
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







-
+














-
-
+
+
+








    if (path[0] == '/') {
	/*
	 * Path of form /foo/bar which is a path in the root directory of the
	 * current volume.
	 */

	const char *drive = TclGetString(useThisCwd);
	const char *drive = Tcl_GetString(useThisCwd);

	absolutePath = Tcl_NewStringObj(drive,2);
	Tcl_AppendToObj(absolutePath, path, -1);
	Tcl_IncrRefCount(absolutePath);

	/*
	 * We have a refCount on the cwd.
	 */
    } else {
	/*
	 * Path of form C:foo/bar, but this only makes sense if the cwd is
	 * also on drive C.
	 */

	size_t cwdLen;
	const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen);
	int cwdLen;
	const char *drive =
		Tcl_GetStringFromObj(useThisCwd, &cwdLen);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {
	    absolutePath = Tcl_DuplicateObj(useThisCwd);
2957
2958
2959
2960
2961
2962
2963
2964

2965
2966
2967
2968

2969
2970
2971
2972
2973
2974
2975
3204
3205
3206
3207
3208
3209
3210

3211
3212
3213


3214
3215
3216
3217
3218
3219
3220
3221







-
+


-
-
+








Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    size_t len;
    int len;
    char *copy, *p;

    Tcl_DStringInit(&ds);
    Tcl_WCharToUtfDString((const WCHAR *) clientData, -1, &ds);
    Tcl_WinTCharToUtf((const char *) clientData, -1, &ds);
    copy = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);

    /*
     * Certain native path representations on Windows have this special prefix
     * to indicate that they are to be treated specially. For example
     * extremely long paths, or symlinks.
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
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
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







-
+








-
-
+
+

-
+
-












-
-
-
-
-









-
-
-
-
-
-



-
-
+
+
-
-
-
-
-
+
-
-
-
+
-
-
+
-
-
-
-
+
+
+

-
-
-
-
+
+
+
+
-
-
+
+
+
+
+
-

-
-
-
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+

-

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+







 *
 *	Create a native representation for the given path.
 *
 * Results:
 *	The nativePath representation.
 *
 * Side effects:
 *	Memory will be allocated. The path might be normalized.
 *	Memory will be allocated. The path may need to be normalized.
 *
 *---------------------------------------------------------------------------
 */

ClientData
TclNativeCreateNativeRep(
    Tcl_Obj *pathPtr)
{
    WCHAR *nativePathPtr = NULL;
    const char *str;
    char *nativePathPtr, *str;
    Tcl_DString ds;
    Tcl_Obj *validPathPtr;
    size_t len;
    int len;
    WCHAR *wp;

    if (TclFSCwdIsNative()) {
	/*
	 * The cwd is native, which means we can use the translated path
	 * without worrying about normalization (this will also usually be
	 * shorter so the utf-to-external conversion will be somewhat faster).
	 */

	validPathPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr);
	if (validPathPtr == NULL) {
	    return NULL;
	}

	/*
	 * refCount of validPathPtr was already incremented in
	 * Tcl_FSGetTranslatedPath
	 */
    } else {
	/*
	 * Make sure the normalized path is set.
	 */

	validPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
	if (validPathPtr == NULL) {
	    return NULL;
	}

	/*
	 * validPathPtr returned from Tcl_FSGetNormalizedPath is owned by Tcl,
	 * so incr refCount here
	 */

	Tcl_IncrRefCount(validPathPtr);
    }

    str = TclGetStringFromObj(validPathPtr, &len);

    str = Tcl_GetStringFromObj(validPathPtr, &len);
    Tcl_WinUtfToTChar(str, len, &ds);
    if (strlen(str) != len) {
	/*
	 * String contains NUL-bytes. This is invalid.
	 */

    if (tclWinProcs->useWide) {
	goto done;
    }

	WCHAR *wp = (WCHAR *) Tcl_DStringValue(&ds);
    /*
     * For a reserved device, strip a possible postfix ':'
	/* For a reserved device, strip a possible postfix ':' */
     */

    len = WinIsReserved(str);
    if (len == 0) {
	len = WinIsReserved(str);
	/* For normal devices */
	if (len == 0) len = Tcl_DStringLength(&ds)>>1;
	/*
	 * Let MultiByteToWideChar check for other invalid sequences, like
	 * 0xC0 0x80 (== overlong NUL). See bug [3118489]: NUL in filenames
	 */

	** If path starts with "//?/" or "\\?\" (extended path), translate
	** any slashes to backslashes but accept the '?' as being valid.
	*/
	if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
	len = MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, 0, 0);
	if (len==0) {
		&& str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
	    wp[0] = wp[1] = wp[3] = '\\';
	    str += 4;
	    wp += 4;
	    len -= 4;
	    goto done;
	}
    }

    /*
	/*
     * Overallocate 6 chars, making some room for extended paths
     */

	** If there is a drive prefix, the ':' must be considered valid.
	**/
	if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
    wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR));
    if (nativePathPtr==0) {
      goto done;
    }
    MultiByteToWideChar(CP_UTF8, MB_ERR_INVALID_CHARS, str, -1, nativePathPtr,
	    len + 1);

    /*
		&& str[1]==':') {
	    wp += 2;
	    len -= 2;
	}
	while (len-->0) {
	    if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
		Tcl_DecrRefCount(validPathPtr);
		Tcl_DStringFree(&ds);
		return NULL;
	    } else if (*wp=='/') {
		*wp = '\\';
     * If path starts with "//?/" or "\\?\" (extended path), translate any
     * slashes to backslashes but leave the '?' intact
     */

	    }
    if ((str[0] == '\\' || str[0] == '/') && (str[1] == '\\' || str[1] == '/')
	    && str[2] == '?' && (str[3] == '\\' || str[3] == '/')) {
	wp[0] = wp[1] = wp[3] = '\\';
	str += 4;
	wp += 4;
    }

    /*
	    ++wp;
	}
	len = Tcl_DStringLength(&ds) + sizeof(WCHAR);
    } else {
	char *p = Tcl_DStringValue(&ds);
	len = Tcl_DStringLength(&ds);
	/*
     * If there is no "\\?\" prefix but there is a drive or UNC path prefix
     * and the path is larger than MAX_PATH chars, no Win32 API function can
     * handle that unless it is prefixed with the extended path prefix. See:
	** If path starts with "//?/" or "\\?\" (extended path), translate
     * <http://msdn.microsoft.com/en-us/library/aa365247(VS.85).aspx#maxpath>
     */

    if (((str[0] >= 'A' && str[0] <= 'Z') || (str[0] >= 'a' && str[0] <= 'z'))
	    && str[1] == ':') {
	if (wp == nativePathPtr && len > MAX_PATH
	** any slashes to backslashes but accept the '?' as being valid.
	*/
	if ((str[0]=='\\' || str[0]=='/') && (str[1]=='\\' || str[1]=='/')
		&& str[2]=='?' && (str[3]=='\\' || str[3]=='/')) {
	    p[0] = p[1] = p[3] = '\\';
	    str += 4;
		&& (str[2] == '\\' || str[2] == '/')) {
	    memmove(wp + 4, wp, len * sizeof(WCHAR));
	    memcpy(wp, L"\\\\?\\", 4 * sizeof(WCHAR));
	    wp += 4;
	    p += 4;
	    len -= 4;
	}

	/*
	 * If (remainder of) path starts with "<drive>:", leave the ':'
	 * intact.
	 */

	wp += 2;
	** If there is a drive prefix, the ':' must be considered valid.
	**/
	if (((str[0]>='A'&&str[0]<='Z') || (str[0]>='a'&&str[0]<='z'))
		&& str[1]==':') {
	    p += 2;
	    len -= 2;
	}
	while (len-->0) {
	    if ((*p < ' ') || strchr("\"*:<>?|", *p)) {
		Tcl_DecrRefCount(validPathPtr);
		Tcl_DStringFree(&ds);
		return NULL;
    } else if (wp == nativePathPtr && len > MAX_PATH
	    && (str[0] == '\\' || str[0] == '/')
	    && (str[1] == '\\' || str[1] == '/') && str[2] != '?') {
	memmove(wp + 6, wp, len * sizeof(WCHAR));
	memcpy(wp, L"\\\\?\\UNC", 7 * sizeof(WCHAR));
	wp += 7;
    }

    /*
     * In the remainder of the path, translate invalid characters to
     * characters in the Unicode private use area.
     */

    while (*wp != '\0') {
	if ((*wp < ' ') || wcschr(L"\"*:<>?|", *wp)) {
	    *wp |= 0xF000;
	} else if (*wp == '/') {
	    *wp = '\\';
	}
	++wp;
    }

	    } else if (*p=='/') {
		*p = '\\';
	    }
	    ++p;
	}
	len = Tcl_DStringLength(&ds) + sizeof(char);
    }
  done:
    TclDecrRefCount(validPathPtr);
    return nativePathPtr;
    Tcl_DecrRefCount(validPathPtr);
    nativePathPtr = ckalloc((unsigned) len);
    memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);

    Tcl_DStringFree(&ds);
    return (ClientData) nativePathPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeDupInternalRep --
 *
3184
3185
3186
3187
3188
3189
3190





3191





3192



3193

3194
3195

3196
3197
3198
3199
3200
3201
3202
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







+
+
+
+
+
-
+
+
+
+
+

+
+
+
-
+

-
+







    char *copy;
    size_t len;

    if (clientData == NULL) {
	return NULL;
    }

    if (tclWinProcs->useWide) {
	/*
	 * Unicode representation when running on NT/2K/XP.
	 */

    len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);
	len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);
    } else {
	/*
	 * ANSI representation when running on 95/98/ME.
	 */

	len = sizeof(char) * (strlen((const char *) clientData) + 1);
    }

    copy = (char *)Tcl_Alloc(len);
    copy = (char *) ckalloc(len);
    memcpy(copy, clientData, len);
    return copy;
    return (ClientData) copy;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpUtime --
 *
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
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







-
+







-
+

-
+










-
-
+
+













-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






int
TclpUtime(
    Tcl_Obj *pathPtr,		/* File to modify */
    struct utimbuf *tval)	/* New modification date structure */
{
    int res = 0;
    HANDLE fileHandle;
    const WCHAR *native;
    const TCHAR *native;
    DWORD attr = 0;
    DWORD flags = FILE_ATTRIBUTE_NORMAL;
    FILETIME lastAccessTime, lastModTime;

    FromCTime(tval->actime, &lastAccessTime);
    FromCTime(tval->modtime, &lastModTime);

    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
    native = (const TCHAR *) Tcl_FSGetNativePath(pathPtr);

    attr = GetFileAttributesW(native);
    attr = (*tclWinProcs->getFileAttributesProc)(native);

    if (attr != INVALID_FILE_ATTRIBUTES && attr & FILE_ATTRIBUTE_DIRECTORY) {
	flags = FILE_FLAG_BACKUP_SEMANTICS;
    }

    /*
     * We use the native APIs (not 'utime') because there are some daylight
     * savings complications that utime gets wrong.
     */

    fileHandle = CreateFileW(native, FILE_WRITE_ATTRIBUTES, 0, NULL,
	    OPEN_EXISTING, flags, NULL);
    fileHandle = (tclWinProcs->createFileProc)(native, FILE_WRITE_ATTRIBUTES,
	    0, NULL, OPEN_EXISTING, flags, NULL);

    if (fileHandle == INVALID_HANDLE_VALUE ||
	    !SetFileTime(fileHandle, NULL, &lastAccessTime, &lastModTime)) {
	TclWinConvertError(GetLastError());
	res = -1;
    }
    if (fileHandle != INVALID_HANDLE_VALUE) {
	CloseHandle(fileHandle);
    }
    return res;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinFileOwned --
 *
 *	Returns 1 if the specified file exists and is owned by the current
 *      user and 0 otherwise. Like the Unix case, the check is made using
 *      the real process SID, not the effective (impersonation) one.
 *
 *---------------------------------------------------------------------------
 */

int
TclWinFileOwned(
    Tcl_Obj *pathPtr)		/* File whose ownership is to be checked */
{
    const WCHAR *native;
    PSID ownerSid = NULL;
    PSECURITY_DESCRIPTOR secd = NULL;
    HANDLE token;
    LPBYTE buf = NULL;
    DWORD bufsz;
    int owned = 0;

    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);

    if (GetNamedSecurityInfoW((LPWSTR) native, SE_FILE_OBJECT,
	    OWNER_SECURITY_INFORMATION, &ownerSid, NULL, NULL, NULL,
	    &secd) != ERROR_SUCCESS) {
        /*
	 * Either not a file, or we do not have access to it in which case we
	 * are in all likelihood not the owner.
	 */

        return 0;
    }

    /*
     * Getting the current process SID is a multi-step process.  We make the
     * assumption that if a call fails, this process is so underprivileged it
     * could not possibly own anything. Normally a process can *always* look
     * up its own token.
     */

    if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) {
        /*
	 * Find out how big the buffer needs to be.
	 */

        bufsz = 0;
        GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
        if (bufsz) {
            buf = (LPBYTE)Tcl_Alloc(bufsz);
            if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
                owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
            }
        }
        CloseHandle(token);
    }

    /*
     * Free allocations and be done.
     */

    if (secd) {
        LocalFree(secd);            /* Also frees ownerSid */
    }
    if (buf) {
        Tcl_Free(buf);
    }

    return (owned != 0);        /* Convert non-0 to 1 */
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinInit.c.

13
14
15
16
17
18
19
20

21
22
23
24
25
26
27
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27







-
+








#include "tclWinInt.h"
#include <winnt.h>
#include <winbase.h>
#include <lmcons.h>

/*
 * GetUserNameW() is found in advapi32.dll
 * GetUserName() is found in advapi32.dll
 */
#ifdef _MSC_VER
#   pragma comment(lib, "advapi32.lib")
#endif

/*
 * The following declaration is a workaround for some Microsoft brain damage.
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
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







-

-
+
+

-
+

-
-
-
+
+
-
+
+

-
-
+
+

-
+














-
+
+







#ifndef PROCESSOR_ARCHITECTURE_IA32_ON_WIN64
#define PROCESSOR_ARCHITECTURE_IA32_ON_WIN64	10
#endif
#ifndef PROCESSOR_ARCHITECTURE_UNKNOWN
#define PROCESSOR_ARCHITECTURE_UNKNOWN		0xFFFF
#endif


/*
 * Windows version dependend functions
 * The following arrays contain the human readable strings for the Windows
 * platform and processor values.
 */
TclWinProcs tclWinProcs;


/*
 * The following arrays contain the human readable strings for the
 * processor values.
#define NUMPLATFORMS 4
static char* platforms[NUMPLATFORMS] = {
 */
    "Win32s", "Windows 95", "Windows NT", "Windows CE"
};

#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
#define NUMPROCESSORS 15
static char* processors[NUMPROCESSORS] = {
    "intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
    "amd64", "ia32_on_win64"
    "amd64", "ia32_on_win64", "neutral", "arm64", "arm32_on_win64", "ia32_on_arm64"
};

/*
 * The default directory in which the init.tcl file is expected to be found.
 */

static TclInitProcessGlobalValueProc	InitializeDefaultLibraryDir;
static ProcessGlobalValue defaultLibraryDir =
	{0, 0, NULL, NULL, InitializeDefaultLibraryDir, NULL, NULL};

static TclInitProcessGlobalValueProc	InitializeSourceLibraryDir;
static ProcessGlobalValue sourceLibraryDir =
	{0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};

static void		AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
static void		AppendEnvironment(Tcl_Obj *listPtr, CONST char *lib);
static int		ToUtf(CONST WCHAR *wSrc, char *dst);

/*
 *---------------------------------------------------------------------------
 *
 * TclpInitPlatform --
 *
 *	Initialize all the platform-dependent things like signals,
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
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







-



-
-
-
-
-
+
+
+
+
+








-
+

-
-
-
-
-
-
-
-







 */

void
TclpInitPlatform(void)
{
    WSADATA wsaData;
    WORD wVersionRequested = MAKEWORD(2, 2);
    HMODULE handle;

    tclPlatform = TCL_PLATFORM_WINDOWS;

    /*
     * Initialize the winsock library. On Windows XP and higher this
     * can never fail.
     */
    WSAStartup(wVersionRequested, &wsaData);
	/*
	 * Initialize the winsock library. On Windows XP and higher this
	 * can never fail.
	 */
	WSAStartup(wVersionRequested, &wsaData);

#ifdef STATIC_BUILD
    /*
     * If we are in a statically linked executable, then we need to explicitly
     * initialize the Windows function tables here since DllMain() will not be
     * invoked.
     */

    TclWinInit(GetModuleHandleW(NULL));
    TclWinInit(GetModuleHandle(NULL));
#endif

    /*
     * Fill available functions depending on windows version
     */
    handle = GetModuleHandleW(L"KERNEL32");
    tclWinProcs.cancelSynchronousIo =
	    (BOOL (WINAPI *)(HANDLE))(void *)GetProcAddress(handle,
	    "CancelSynchronousIo");
}

/*
 *-------------------------------------------------------------------------
 *
 * TclpInitLibraryPath --
 *
176
177
178
179
180
181
182
183

184
185
186
187
188
189

190
191
192

193
194
195
196
197
198
199
168
169
170
171
172
173
174

175
176
177
178
179
180

181

182

183
184
185
186
187
188
189
190







-
+





-
+
-

-
+







 *
 *-------------------------------------------------------------------------
 */

void
TclpInitLibraryPath(
    char **valuePtr,
    size_t *lengthPtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE	    64
    Tcl_Obj *pathPtr;
    char installLib[LIBRARY_SIZE];
    const char *bytes;
    char *bytes;
    size_t length;

    TclNewObj(pathPtr);
    pathPtr = Tcl_NewObj();

    /*
     * Initialize the substring used when locating the script library. The
     * installLib variable computes the script library path relative to the
     * installed DLL.
     */

219
220
221
222
223
224
225
226
227


228
229

230
231
232
233
234
235
236
210
211
212
213
214
215
216


217
218


219
220
221
222
223
224
225
226







-
-
+
+
-
-
+







     * Look for the library in its source checkout location.
     */

    Tcl_ListObjAppendElement(NULL, pathPtr,
	    TclGetProcessGlobalValue(&sourceLibraryDir));

    *encodingPtr = NULL;
    bytes = TclGetStringFromObj(pathPtr, &length);
    *lengthPtr = length++;
    bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
    *valuePtr = ckalloc((unsigned int)(*lengthPtr)+1);
    *valuePtr = (char *)Tcl_Alloc(length);
    memcpy(*valuePtr, bytes, length);
    memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
    Tcl_DecrRefCount(pathPtr);
}

/*
 *---------------------------------------------------------------------------
 *
 * AppendEnvironment --
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
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







-
+



-
+


-
+









-
+















-
-
+
+
+
+
+
+









-
+




+
+









-
-
+
+
+




-
+







 *
 *---------------------------------------------------------------------------
 */

static void
AppendEnvironment(
    Tcl_Obj *pathPtr,
    const char *lib)
    CONST char *lib)
{
    int pathc;
    WCHAR wBuf[MAX_PATH];
    char buf[MAX_PATH * 3];
    char buf[MAX_PATH * TCL_UTF_MAX];
    Tcl_Obj *objPtr;
    Tcl_DString ds;
    const char **pathv;
    CONST char **pathv;
    char *shortlib;

    /*
     * The shortlib value needs to be the tail component of the lib path. For
     * example, "lib/tcl8.4" -> "tcl8.4" while "usr/share/tcl8.5" -> "tcl8.5".
     */

    for (shortlib = (char *) &lib[strlen(lib)-1]; shortlib>lib ; shortlib--) {
	if (*shortlib == '/') {
	    if ((size_t)(shortlib - lib) == strlen(lib) - 1) {
	    if ((unsigned)(shortlib - lib) == strlen(lib) - 1) {
		Tcl_Panic("last character in lib cannot be '/'");
	    }
	    shortlib++;
	    break;
	}
    }
    if (shortlib == lib) {
	Tcl_Panic("no '/' character found in lib");
    }

    /*
     * The "L" preceeding the TCL_LIBRARY string is used to tell VC++ that
     * this is a unicode string.
     */

    GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL);
    if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
	buf[0] = '\0';
	GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
    } else {
	ToUtf(wBuf, buf);
    }

    if (buf[0] != '\0') {
	objPtr = Tcl_NewStringObj(buf, -1);
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);

	TclWinNoBackslash(buf);
	Tcl_SplitPath(buf, &pathc, &pathv);

	/*
	 * The lstrcmpiA() will work even if pathv[pathc-1] is random UTF-8
	 * The lstrcmpi() will work even if pathv[pathc-1] is random UTF-8
	 * chars because I know shortlib is ascii.
	 */

	if ((pathc > 0) && (lstrcmpiA(shortlib, pathv[pathc - 1]) != 0)) {
	    CONST char *str;

	    /*
	     * TCL_LIBRARY is set but refers to a different tcl installation
	     * than the current version. Try fiddling with the specified
	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */

	    pathv[pathc - 1] = shortlib;
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = TclDStringToObj(&ds);
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, -1);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	Tcl_Free((void *)pathv);
	ckfree((char *) pathv);
    }
}

/*
 *---------------------------------------------------------------------------
 *
 * InitializeDefaultLibraryDir --
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
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







-
+


-
+




-
-
+
+
+
+
+












-
+

-
+







 *
 *---------------------------------------------------------------------------
 */

static void
InitializeDefaultLibraryDir(
    char **valuePtr,
    size_t *lengthPtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE hModule = (HMODULE)TclWinGetTclInstance();
    HMODULE hModule = TclWinGetTclInstance();
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char name[(MAX_PATH + LIBRARY_SIZE) * 3];
    char *end, *p;

    GetModuleFileNameW(hModule, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
    if (GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)) == 0) {
	GetModuleFileNameA(hModule, name, sizeof(name));
    } else {
	ToUtf(wName, name);
    }

    end = strrchr(name, '\\');
    *end = '\0';
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "lib/tcl%s", TCL_VERSION);
    *lengthPtr = strlen(name);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    *valuePtr = ckalloc(*lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
    memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * InitializeSourceLibraryDir --
 *
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
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
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







-
+


-
+




-
-
+
+
+
+
+












-
+

-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 *---------------------------------------------------------------------------
 */

static void
InitializeSourceLibraryDir(
    char **valuePtr,
    size_t *lengthPtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    HMODULE hModule = (HMODULE)TclWinGetTclInstance();
    HMODULE hModule = TclWinGetTclInstance();
    WCHAR wName[MAX_PATH + LIBRARY_SIZE];
    char name[(MAX_PATH + LIBRARY_SIZE) * 3];
    char *end, *p;

    GetModuleFileNameW(hModule, wName, MAX_PATH);
    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
    if (GetModuleFileNameW(hModule, wName, sizeof(wName)/sizeof(WCHAR)) == 0) {
	GetModuleFileNameA(hModule, name, sizeof(name));
    } else {
	ToUtf(wName, name);
    }

    end = strrchr(name, '\\');
    *end = '\0';
    p = strrchr(name, '\\');
    if (p != NULL) {
	end = p;
    }
    *end = '\\';

    TclWinNoBackslash(name);
    sprintf(end + 1, "../library");
    *lengthPtr = strlen(name);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    *valuePtr = ckalloc((unsigned int) *lengthPtr + 1);
    *encodingPtr = NULL;
    memcpy(*valuePtr, name, *lengthPtr + 1);
    memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
}

/*
 *---------------------------------------------------------------------------
 *
 * ToUtf --
 *
 *	Convert a char string to a UTF string.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *---------------------------------------------------------------------------
 */

static int
ToUtf(
    CONST WCHAR *wSrc,
    char *dst)
{
    char *start;

    start = dst;
    while (*wSrc != '\0') {
	dst += Tcl_UniCharToUtf(*wSrc, dst);
	wSrc++;
    }
    *dst = '\0';
    return (int) (dst - start);
}

/*
 *---------------------------------------------------------------------------
 *
 * TclWinEncodingsCleanup --
 *
 *	Reset information to its original state in finalization to allow for
 *	reinitialization to be possible. This must not be called until after
 *	the filesystem has been finalised, or exit crashes may occur when
 *	using virtual filesystems.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Static information reset to startup state.
 *
 *---------------------------------------------------------------------------
 */

void
TclWinEncodingsCleanup(void)
{
    TclWinResetInterfaceEncodings();
}

/*
 *---------------------------------------------------------------------------
 *
 * TclpSetInitialEncodings --
 *
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
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







+





+
+
+
+
+
+
+
+
+
+
+
-
+



-
-

-
-
-
-
-
-
+
+
+
-














-
+



-
-
+
+







 */

void
TclpSetInitialEncodings(void)
{
    Tcl_DString encodingName;

    TclpSetInterfaces();
    Tcl_SetSystemEncoding(NULL,
	    Tcl_GetEncodingNameFromEnvironment(&encodingName));
    Tcl_DStringFree(&encodingName);
}

void
TclpSetInterfaces(void)
{
    int platformId, useWide;

    platformId = TclWinGetPlatformId();
    useWide = ((platformId == VER_PLATFORM_WIN32_NT)
	    || (platformId == VER_PLATFORM_WIN32_CE));
    TclWinSetInterfaces(useWide);
}

const char *
CONST char *
Tcl_GetEncodingNameFromEnvironment(
    Tcl_DString *bufPtr)
{
    UINT acp = GetACP();

    Tcl_DStringInit(bufPtr);
    if (acp == CP_UTF8) {
	Tcl_DStringAppend(bufPtr, "utf-8", 5);
    } else {
	Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
	wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
	Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
    wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
    Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    }
    return Tcl_DStringValue(bufPtr);
}

const char *
TclpGetUserName(
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * the name of user. */
{
    Tcl_DStringInit(bufferPtr);

    if (TclGetEnv("USERNAME", bufferPtr) == NULL) {
	WCHAR szUserName[UNLEN+1];
	DWORD cchUserNameLen = UNLEN;

	if (!GetUserNameW(szUserName, &cchUserNameLen)) {
	if (!tclWinProcs->getUserName((LPTSTR)szUserName, &cchUserNameLen)) {
	    return NULL;
	}
	cchUserNameLen--;
	Tcl_DStringInit(bufferPtr);
	Tcl_WCharToUtfDString(szUserName, cchUserNameLen, bufferPtr);
	if (tclWinProcs->useWide) cchUserNameLen *= sizeof(WCHAR);
	Tcl_WinTCharToUtf((LPTSTR)szUserName, cchUserNameLen, bufferPtr);
    }
    return Tcl_DStringValue(bufferPtr);
}

/*
 *---------------------------------------------------------------------------
 *
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
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
618







-
+













-
+

-
+














+
-
-
+
+
+







 *----------------------------------------------------------------------
 */

void
TclpSetVariables(
    Tcl_Interp *interp)		/* Interp to initialize. */
{
    const char *ptr;
    CONST char *ptr;
    char buffer[TCL_INTEGER_SPACE * 2];
    union {
	SYSTEM_INFO info;
	OemId oemId;
    } sys;
    static OSVERSIONINFOW osInfo;
    static int osInfoInitialized = 0;
    Tcl_DString ds;

    Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);

    if (!osInfoInitialized) {
	HMODULE handle = GetModuleHandleW(L"NTDLL");
	HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
	int(__stdcall *getversion)(void *) =
		(int(__stdcall *)(void *))(void *)GetProcAddress(handle, "RtlGetVersion");
		(int(__stdcall *)(void *)) GetProcAddress(handle, "RtlGetVersion");
	osInfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
	if (!getversion || getversion(&osInfo)) {
	    GetVersionExW(&osInfo);
	}
	osInfoInitialized = 1;
    }
    GetSystemInfo(&sys.info);

    /*
     * Define the tcl_platform array.
     */

    Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
	    TCL_GLOBAL_ONLY);
    if (osInfo.dwPlatformId < NUMPLATFORMS) {
    Tcl_SetVar2(interp, "tcl_platform", "os",
	    "Windows NT", TCL_GLOBAL_ONLY);
	Tcl_SetVar2(interp, "tcl_platform", "os",
		platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
    }
    wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
    Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
    if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
	Tcl_SetVar2(interp, "tcl_platform", "machine",
		processors[sys.oemId.wProcessorArchitecture],
		TCL_GLOBAL_ONLY);
    }
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
618
619



620
621
622
623
624
625
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
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







-
-
-
-
-
-








-
+



-
-
-
+
+
+
-







-
-
-
+
-

-
+

-
+




-
+
-
-
+








-
-
+
+



-
+
-
-






-
+
-




-
+







     * Note: cchUserNameLen is number of characters including nul terminator.
     */

    ptr = TclpGetUserName(&ds);
    Tcl_SetVar2(interp, "tcl_platform", "user", ptr ? ptr : "",
	    TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);

    /*
     * Define what the platform PATH separator is. [TIP #315]
     */

    Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFindVariable --
 *
 *	Locate the entry in environ for a given name. On Unix this routine is
 *	case sensitive, on Windows this matches mixed case.
 *	case sensitive, on Windows this matches mioxed case.
 *
 * Results:
 *	The return value is the index in environ of an entry with the name
 *	"name", or TCL_INDEX_NONE if there is no such entry. The integer
 *	at *lengthPtr is filled in with the length of name (if a matching
 *	entry is found) or the length of the environ array (if no
 *	"name", or -1 if there is no such entry. The integer at *lengthPtr is
 *	filled in with the length of name (if a matching entry is found) or
 *	the length of the environ array (if no matching entry is found).
 *	matching entry is found).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#  define tenviron2utfdstr(string, len, dsPtr) \
		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr))

int
size_t
TclpFindVariable(
    const char *name,		/* Name of desired environment variable
    CONST char *name,		/* Name of desired environment variable
				 * (UTF-8). */
    size_t *lengthPtr)		/* Used to return length of name (for
    int *lengthPtr)		/* Used to return length of name (for
				 * successful searches) or number of non-NULL
				 * entries in environ (for unsuccessful
				 * searches). */
{
    size_t i, length, result = TCL_INDEX_NONE;
    int i, length, result = -1;
    const WCHAR *env;
    const char *p1, *p2;
    register CONST char *env, *p1, *p2;
    char *envUpper, *nameUpper;
    Tcl_DString envString;

    /*
     * Convert the name to all upper case for the case insensitive comparison.
     */

    length = strlen(name);
    nameUpper = (char *)Tcl_Alloc(length + 1);
    memcpy(nameUpper, name, length+1);
    nameUpper = (char *) ckalloc((unsigned) length+1);
    memcpy(nameUpper, name, (size_t) length+1);
    Tcl_UtfToUpper(nameUpper);

    Tcl_DStringInit(&envString);
    for (i = 0, env = _wenviron[i];
    for (i = 0, env = environ[i]; env != NULL; i++, env = environ[i]) {
	env != NULL;
	i++, env = _wenviron[i]) {
	/*
	 * Chop the env string off after the equal sign, then Convert the name
	 * to all upper case, so we do not have to convert all the characters
	 * after the equal sign.
	 */

	Tcl_DStringInit(&envString);
	envUpper = Tcl_ExternalToUtfDString(NULL, env, -1, &envString);
	envUpper = Tcl_WCharToUtfDString(env, -1, &envString);
	p1 = strchr(envUpper, '=');
	if (p1 == NULL) {
	    continue;
	}
	length = p1 - envUpper;
	length = (int) (p1 - envUpper);
	Tcl_DStringSetLength(&envString, length+1);
	Tcl_UtfToUpper(envUpper);

	p1 = envUpper;
	p2 = nameUpper;
	for (; *p2 == *p1; p1++, p2++) {
	    /* NULL loop body. */
686
687
688
689
690
691
692
693

694
695
696
697
698
699
700
701
702
703
740
741
742
743
744
745
746

747
748
749
750
751
752
753
754
755
756
757







-
+










	Tcl_DStringFree(&envString);
    }

    *lengthPtr = i;

  done:
    Tcl_DStringFree(&envString);
    Tcl_Free(nameUpper);
    ckfree(nameUpper);
    return result;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinInt.h.

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
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







+
+
+
+
-
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+







-
-
+
+








+
-
+

-
-
-
+
+
+

+
+
-
+
+
+
+
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

    void *ebp;
    void *esp;
    int status;
} TCLEXCEPTION_REGISTRATION;
#endif

/*
 * The following specifies how much stack space TclpCheckStackSpace()
 * ensures is available.  TclpCheckStackSpace() is called by Tcl_EvalObj()
 * to help avoid overflowing the stack in the case of infinite recursion.
 */
 * Windows version dependend functions

#define TCL_WIN_STACK_THRESHOLD 0x8000

/*
 * Some versions of Borland C have a define for the OSVERSIONINFO for
 * Win32s and for NT, but not for Windows 95.
 * Define VER_PLATFORM_WIN32_CE for those without newer headers.
 */

#ifndef VER_PLATFORM_WIN32_WINDOWS
#define VER_PLATFORM_WIN32_WINDOWS 1
#endif
#ifndef VER_PLATFORM_WIN32_CE
#define VER_PLATFORM_WIN32_CE 3
#endif

#ifndef TCL_Z_MODIFIER
#   ifdef _WIN64
#	if defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
#         define TCL_Z_MODIFIER        "ll"
#	else
#         define TCL_Z_MODIFIER        "I"
#	endif
#   else
#         define TCL_Z_MODIFIER        ""
#   endif
#endif
#define TCL_I_MODIFIER TCL_Z_MODIFIER

/*
 * The following structure keeps track of whether we are using the
 * multi-byte or the wide-character interfaces to the operating system.
 * System calls should be made through the following function table.
 */

typedef union {
    WIN32_FIND_DATAA a;
    WIN32_FIND_DATAW w;
} WIN32_FIND_DATAT;

typedef struct TclWinProcs {
    int useWide;

    BOOL (WINAPI *buildCommDCBProc)(CONST TCHAR *, LPDCB);
    TCHAR *(WINAPI *charLowerProc)(TCHAR *);
    BOOL (WINAPI *copyFileProc)(CONST TCHAR *, CONST TCHAR *, BOOL);
    BOOL (WINAPI *createDirectoryProc)(CONST TCHAR *, LPSECURITY_ATTRIBUTES);
    HANDLE (WINAPI *createFileProc)(CONST TCHAR *, DWORD, DWORD,
	    LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE);
    BOOL (WINAPI *createProcessProc)(CONST TCHAR *, TCHAR *,
	    LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD,
	    LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION);
    BOOL (WINAPI *deleteFileProc)(CONST TCHAR *);
    HANDLE (WINAPI *findFirstFileProc)(CONST TCHAR *, WIN32_FIND_DATAT *);
    BOOL (WINAPI *findNextFileProc)(HANDLE, WIN32_FIND_DATAT *);
    BOOL (WINAPI *getComputerNameProc)(WCHAR *, LPDWORD);
    DWORD (WINAPI *getCurrentDirectoryProc)(DWORD, WCHAR *);
    DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *);
    DWORD (WINAPI *getFullPathNameProc)(CONST TCHAR *, DWORD nBufferLength,
	    WCHAR *, TCHAR **);
    DWORD (WINAPI *getModuleFileNameProc)(HMODULE, WCHAR *, int);
    DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *, WCHAR *, DWORD);
    UINT (WINAPI *getTempFileNameProc)(CONST TCHAR *, CONST TCHAR *, UINT,
	    WCHAR *);
    DWORD (WINAPI *getTempPathProc)(DWORD, WCHAR *);
    BOOL (WINAPI *getVolumeInformationProc)(CONST TCHAR *, WCHAR *, DWORD,
	    LPDWORD, LPDWORD, LPDWORD, WCHAR *, DWORD);
    HINSTANCE (WINAPI *loadLibraryExProc)(CONST TCHAR *, HANDLE, DWORD);
    TCHAR (WINAPI *lstrcpyProc)(WCHAR *, CONST TCHAR *);
    BOOL (WINAPI *moveFileProc)(CONST TCHAR *, CONST TCHAR *);
    BOOL (WINAPI *removeDirectoryProc)(CONST TCHAR *);
    DWORD (WINAPI *searchPathProc)(CONST TCHAR *, CONST TCHAR *,
	    CONST TCHAR *, DWORD, WCHAR *, TCHAR **);
    BOOL (WINAPI *setCurrentDirectoryProc)(CONST TCHAR *);
    BOOL (WINAPI *setFileAttributesProc)(CONST TCHAR *, DWORD);
    /*
     * These two function pointers will only be set when
     * Tcl_FindExecutable is called.  If you don't ever call that
     * function, the application will crash whenever WinTcl tries to call
     * functions through these null pointers.  That is not a bug in Tcl
     * -- Tcl_FindExecutable is obligatory in recent Tcl releases.
     */
    BOOL (WINAPI *getFileAttributesExProc)(CONST TCHAR *,
	    GET_FILEEX_INFO_LEVELS, LPVOID);
    BOOL (WINAPI *createHardLinkProc)(CONST TCHAR*, CONST TCHAR*,
				      LPSECURITY_ATTRIBUTES);

    /* deleted INT (__cdecl *utimeProc)(CONST TCHAR*, struct _utimbuf *); */
    /* These two are also NULL at start; see comment above */
    HANDLE (WINAPI *findFirstFileExProc)(CONST TCHAR*, UINT,
					 LPVOID, UINT,
					 LPVOID, DWORD);
    BOOL (WINAPI *getVolumeNameForVMPProc)(CONST TCHAR*, TCHAR*, DWORD);
    DWORD (WINAPI *getLongPathNameProc)(CONST TCHAR*, TCHAR*, DWORD);
    /*
     * These six are for the security sdk to get correct file
     * permissions on NT, 2000, XP, etc.  On 95,98,ME they are
     * always null.
     */
    BOOL (WINAPI *getFileSecurityProc)(LPCTSTR lpFileName,
		     SECURITY_INFORMATION RequestedInformation,
		     PSECURITY_DESCRIPTOR pSecurityDescriptor,
		     DWORD nLength,
		     LPDWORD lpnLengthNeeded);
    BOOL (WINAPI *impersonateSelfProc) (SECURITY_IMPERSONATION_LEVEL
		      ImpersonationLevel);
    BOOL (WINAPI *openThreadTokenProc) (HANDLE ThreadHandle,
		      DWORD DesiredAccess, BOOL OpenAsSelf,
		      PHANDLE TokenHandle);
    BOOL (WINAPI *revertToSelfProc) (void);
    VOID (WINAPI *mapGenericMaskProc) (PDWORD AccessMask,
		      PGENERIC_MAPPING GenericMapping);
    BOOL (WINAPI *accessCheckProc)(PSECURITY_DESCRIPTOR pSecurityDescriptor,
		    HANDLE ClientToken, DWORD DesiredAccess,
		    PGENERIC_MAPPING GenericMapping,
		    PPRIVILEGE_SET PrivilegeSet,
		    LPDWORD PrivilegeSetLength,
		    LPDWORD GrantedAccess,
		    LPBOOL AccessStatus);
    /*
     * Unicode console support. WriteConsole and ReadConsole
     */
    BOOL (WINAPI *cancelSynchronousIo)(HANDLE);
    BOOL (WINAPI *readConsoleProc)(
      HANDLE hConsoleInput,
      LPVOID lpBuffer,
      DWORD nNumberOfCharsToRead,
      LPDWORD lpNumberOfCharsRead,
      LPVOID lpReserved
    );
    BOOL (WINAPI *writeConsoleProc)(
      HANDLE hConsoleOutput,
      const VOID* lpBuffer,
      DWORD nNumberOfCharsToWrite,
      LPDWORD lpNumberOfCharsWritten,
      LPVOID lpReserved
    );
    BOOL (WINAPI *getUserName)(LPTSTR lpBuffer, LPDWORD lpnSize);
} TclWinProcs;

MODULE_SCOPE TclWinProcs tclWinProcs;
MODULE_SCOPE TclWinProcs *tclWinProcs;

/*
 * Declarations of functions that are not accessible by way of the
 * stubs table.
 */

MODULE_SCOPE char	TclWinDriveLetterForVolMountPoint(
			    const WCHAR *mountPoint);
MODULE_SCOPE void	TclWinEncodingsCleanup(void);
			    CONST WCHAR *mountPoint);
MODULE_SCOPE void	TclWinEncodingsCleanup();
MODULE_SCOPE void	TclWinInit(HINSTANCE hInst);
MODULE_SCOPE TclFile	TclWinMakeFile(HANDLE handle);
MODULE_SCOPE Tcl_Channel TclWinOpenConsoleChannel(HANDLE handle,
			    char *channelName, int permissions);
MODULE_SCOPE Tcl_Channel TclWinOpenFileChannel(HANDLE handle, char *channelName,
			    int permissions, int appendMode);
MODULE_SCOPE Tcl_Channel TclWinOpenSerialChannel(HANDLE handle,
			    char *channelName, int permissions);
MODULE_SCOPE void	TclWinResetInterfaceEncodings();
MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, const WCHAR *name,
MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, CONST TCHAR *name,
			    DWORD access);
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const WCHAR *LinkOriginal,
			    const WCHAR *LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(const WCHAR *LinkOriginal,
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(CONST TCHAR* LinkOriginal,
			    CONST TCHAR* LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(CONST TCHAR* LinkOriginal,
			    int linkOnly);
#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
MODULE_SCOPE void	TclWinFreeAllocCache(void);
MODULE_SCOPE int        TclWinFileOwned(Tcl_Obj *);
MODULE_SCOPE void	TclFreeAllocCache(void *);
MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
MODULE_SCOPE void *	TclpGetAllocCache(void);
MODULE_SCOPE void	TclpSetAllocCache(void *);
#endif /* TCL_THREADS */

MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr);

/* Needed by tclWinFile.c and tclWinFCmd.c */
#ifndef FILE_ATTRIBUTE_REPARSE_POINT
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#endif

/*
 *----------------------------------------------------------------------
 * Declarations of helper-workers threaded facilities for a pipe based channel.
 *
 * Corresponding functionality provided in "tclWinPipe.c".
 *----------------------------------------------------------------------
 */

typedef struct TclPipeThreadInfo {
    HANDLE evControl;		/* Auto-reset event used by the main thread to
				 * signal when the pipe thread should attempt
				 * to do read/write operation. Additionally
				 * used as signal to stop (state set to -1) */
    volatile LONG state;	/* Indicates current state of the thread */
    void *clientData;	/* Referenced data of the main thread */
    HANDLE evWakeUp;		/* Optional wake-up event worker set by shutdown */
} TclPipeThreadInfo;


/* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without
 * more overhead for finalize thread (should be executed anyway)
 *
 * #define _PTI_USE_CKALLOC 1
 */

/*
 * State of the pipe-worker.
 *
 * State PTI_STATE_STOP possible from idle state only, worker owns TI structure.
 * Otherwise PTI_STATE_END used (main thread hold ownership of the TI).
 */

#define PTI_STATE_IDLE	0	/* idle or not yet initialzed */
#define PTI_STATE_WORK	1	/* in work */
#define PTI_STATE_STOP	2	/* thread should stop work (owns TI structure) */
#define PTI_STATE_END	4	/* thread should stop work (worker is busy) */
#define PTI_STATE_DOWN  8	/* worker is down */


MODULE_SCOPE
TclPipeThreadInfo *	TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr,
			    void *clientData, HANDLE wakeEvent);
MODULE_SCOPE int	TclPipeThreadWaitForSignal(TclPipeThreadInfo **pipeTIPtr);

static inline void
TclPipeThreadSignal(
    TclPipeThreadInfo **pipeTIPtr)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
    if (pipeTI) {
	SetEvent(pipeTI->evControl);
    }
};

static inline int
TclPipeThreadIsAlive(
    TclPipeThreadInfo **pipeTIPtr)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
    return (pipeTI && pipeTI->state != PTI_STATE_DOWN);
};

MODULE_SCOPE int	TclPipeThreadStopSignal(TclPipeThreadInfo **pipeTIPtr, HANDLE wakeEvent);
MODULE_SCOPE void	TclPipeThreadStop(TclPipeThreadInfo **pipeTIPtr, HANDLE hThread);
MODULE_SCOPE void	TclPipeThreadExit(TclPipeThreadInfo **pipeTIPtr);

#endif	/* _TCLWININT */

Changes to win/tclWinLoad.c.

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
9
10
11
12
13
14
15

















16
17
18
19
20
21
22







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







 *
 * 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
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
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







-
+



-

-
-
+
+
-
-







-
+
-
-
-
+
+
-
-
+







-
+
-
-
-
-
-
-

-
-
-
+
+




+
+
-
-
+
+
-

+
-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+

-
-
+
+








-
-
-
+
+
-
-
-
+
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
-
-


-
-
+
+
-
-
-
-
+
-
-
-
-
-
-






-
+












-
-
+
+


-
+

-
-
+
+






-
+


-


-
-
-
+
+
+


-
-
-
-
-






-
+














-
-
+
+




-
+

+
-
+
-







TclpDlopen(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tcl_Obj *pathPtr,		/* Name of the file containing the desired
				 * code (UTF-8). */
    Tcl_LoadHandle *loadHandle,	/* Filled with token for dynamically loaded
				 * file which will be passed back to
				 * (*unloadProcPtr)() to unload the file. */
    Tcl_FSUnloadFileProc **unloadProcPtr,
    Tcl_FSUnloadFileProc **unloadProcPtr)
				/* Filled with address of Tcl_FSUnloadFileProc
				 * function which should be used for this
				 * file. */
    TCL_UNUSED(int) /*flags*/)
{
    HINSTANCE hInstance = NULL;
    const WCHAR *nativeName;
    HINSTANCE handle;
    CONST TCHAR *nativeName;
    Tcl_LoadHandle handlePtr;
    DWORD firstError;

    /*
     * 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 = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
    nativeName = Tcl_FSGetNativePath(pathPtr);
    if (nativeName != NULL) {
	hInstance = LoadLibraryExW(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
    handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
	    LOAD_WITH_ALTERED_SEARCH_PATH);
    }
    if (hInstance == NULL) {
    if (handle == 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;

	char *fileName = Tcl_GetString(pathPtr);
        /*
         * Remember the first error on load attempt to be used if the
         * second load attempt below also fails.
        */
        firstError = (nativeName == NULL) ?
		ERROR_MOD_NOT_FOUND : GetLastError();

	Tcl_DStringInit(&ds);
	nativeName = Tcl_UtfToWCharDString(TclGetString(pathPtr), -1, &ds);
	hInstance = LoadLibraryExW(nativeName, NULL,
	nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
	handle = (*tclWinProcs->loadLibraryExProc)(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    *loadHandle = (Tcl_LoadHandle) handle;

    if (hInstance == NULL) {
	DWORD lastError;
    if (handle == NULL) {
	DWORD lastError = GetLastError();
        Tcl_Obj *errMsg;

#if 0
        /*
	/*
         * We choose to only use the error from the second call if the first
         * call failed due to the file not being found. Else stick to the
         * first error for reporting purposes.
         */
        if (firstError == ERROR_MOD_NOT_FOUND ||
            firstError == ERROR_DLL_NOT_FOUND)
            lastError = GetLastError();
	 * 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,
        else
            lastError = firstError;
		(LPTSTR) &lpMsgBuf, 0, NULL);
	buf = (char *) ckalloc((unsigned) TCL_INTEGER_SPACE + size + 1);
	sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
#endif

	errMsg = Tcl_ObjPrintf("couldn't load library \"%s\": ",
		TclGetString(pathPtr));
	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
	 * better if there was a way to get what DLLs
	 */

	if (interp) {
	    switch (lastError) {
	    case ERROR_MOD_NOT_FOUND:
	switch (lastError) {
	case ERROR_MOD_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "MOD_NOT_FOUND", NULL);
		goto notFoundMsg;
	    case ERROR_DLL_NOT_FOUND:
	case ERROR_DLL_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_NOT_FOUND", NULL);
	    notFoundMsg:
		Tcl_AppendToObj(errMsg, "this library or a dependent library"
			" could not be found in library path", -1);
		break;
	    case ERROR_PROC_NOT_FOUND:
	    Tcl_AppendResult(interp, "this library or a dependent library"
		    " could not be found in library path", NULL);
	    break;
	case ERROR_PROC_NOT_FOUND:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "PROC_NOT_FOUND", NULL);
		Tcl_AppendToObj(errMsg, "A function specified in the import"
			" table could not be resolved by the system. Windows"
			" is not telling which one, I'm sorry.", -1);
		break;
	    case ERROR_INVALID_DLL:
	    Tcl_AppendResult(interp, "A function specified in the import"
		    " table could not be resolved by the system.  Windows"
		    " is not telling which one, I'm sorry.", NULL);
	    break;
	case ERROR_INVALID_DLL:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "INVALID_DLL", NULL);
		Tcl_AppendToObj(errMsg, "this library or a dependent library"
			" is damaged", -1);
		break;
	    case ERROR_DLL_INIT_FAILED:
	    Tcl_AppendResult(interp, "this library or a dependent library"
		    " is damaged", NULL);
	    break;
	case ERROR_DLL_INIT_FAILED:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "DLL_INIT_FAILED", NULL);
		Tcl_AppendToObj(errMsg, "the library initialization"
			" routine failed", -1);
		break;
	    Tcl_AppendResult(interp, "the library initialization"
		    " routine failed", NULL);
	    break;
            case ERROR_BAD_EXE_FORMAT:
		Tcl_SetErrorCode(interp, "WIN_LOAD", "BAD_EXE_FORMAT", NULL);
		Tcl_AppendToObj(errMsg, "Bad exe format. Possibly a 32/64-bit mismatch.", -1);
                break;
            default:
		TclWinConvertError(lastError);
		Tcl_AppendToObj(errMsg, Tcl_PosixError(interp), -1);
	default:
	    TclWinConvertError(lastError);
	    Tcl_AppendResult(interp, Tcl_PosixError(interp), NULL);
	    }
	    Tcl_SetObjResult(interp, errMsg);
	}
	return TCL_ERROR;
    }

    } else {
	*unloadProcPtr = &TclpUnloadFile;
    /*
     * Succeded; package everything up for Tcl.
     */

    }
    handlePtr = (Tcl_LoadHandle)Tcl_Alloc(sizeof(struct Tcl_LoadHandle_));
    handlePtr->clientData = (ClientData) hInstance;
    handlePtr->findSymbolProcPtr = &FindSymbol;
    handlePtr->unloadFileProcPtr = &UnloadFile;
    *loadHandle = handlePtr;
    *unloadProcPtr = &UnloadFile;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * FindSymbol --
 * TclpFindSymbol --
 *
 *	Looks up a symbol, by name, through a handle associated with a
 *	previously loaded piece of code (shared library).
 *
 * Results:
 *	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_PackageInitProc *
TclpFindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
    CONST char *symbol)
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
    void *proc = NULL;
    Tcl_PackageInitProc *proc = NULL;
    HINSTANCE handle = (HINSTANCE)loadHandle;

    /*
     * For each symbol, check for both Symbol and _Symbol, since Borland
     * generates C symbols with a leading '_' by default.
     */

    proc = (void *)GetProcAddress(hInstance, symbol);
    proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
    if (proc == NULL) {
	Tcl_DString ds;
	const char *sym2;

	Tcl_DStringInit(&ds);
	TclDStringAppendLiteral(&ds, "_");
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (void *)GetProcAddress(hInstance, sym2);
	Tcl_DStringAppend(&ds, "_", 1);
	symbol = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"cannot find symbol \"%s\"", symbol));
	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LOAD_SYMBOL", symbol, NULL);
    }
    return proc;
}

/*
 *----------------------------------------------------------------------
 *
 * UnloadFile --
 * TclpUnloadFile --
 *
 *	Unloads a dynamically loaded binary code file from memory. Code
 *	pointers in the formerly loaded file are no longer valid after calling
 *	this function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
void
TclpUnloadFile(
    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;
    HINSTANCE handle;

    handle = (HINSTANCE) loadHandle;
    FreeLibrary(hInstance);
    FreeLibrary(handle);
    Tcl_Free(loadHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclGuessPackageName --
 *
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
226
227
228
229
230
231
232






233



















234








235












236




237









238
239















































































240
241
242
243
244
245
246
247







-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclGuessPackageName(
    TCL_UNUSED(const char *),
    TCL_UNUSED(Tcl_DString *))
{
    return 0;
}

    CONST char *fileName,	/* Name of file containing package (already
/*
 *----------------------------------------------------------------------
 *
 * 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.
 *
 *----------------------------------------------------------------------
 */

				 * translated to local form if needed). */
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_DString *bufPtr)	/* Initialized empty dstring. Append package
    Tcl_MutexLock(&dllDirectoryNameMutex);
    if (dllDirectoryName == NULL) {
	if (InitDLLDirectoryName() == TCL_ERROR) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't create temporary directory: %s",
		    Tcl_PosixError(interp)));
	    Tcl_MutexUnlock(&dllDirectoryNameMutex);
	    return NULL;
	}
    }
    Tcl_MutexUnlock(&dllDirectoryNameMutex);

				 * name to this if possible. */
    /*
     * 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;
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 = (WCHAR *)Tcl_Alloc((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/tclWinNotify.c.

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
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







-
+








+





+
+
+








-
-
-
+







				 * Tcl_AlertNotifier. */
/*
 * The following static structure contains the state information for the
 * Windows implementation of the Tcl notifier. One of these structures is
 * created for each thread that is using the notifier.
 */

typedef struct {
typedef struct ThreadSpecificData {
    CRITICAL_SECTION crit;	/* Monitor for this notifier. */
    DWORD thread;		/* Identifier for thread associated with this
				 * notifier. */
    HANDLE event;		/* Event object used to wake up the notifier
				 * thread. */
    int pending;		/* Alert message pending, this field is locked
				 * by the notifierMutex. */
    HWND hwnd;			/* Messaging window. */
    int timeout;		/* Current timeout value. */
    int timerActive;		/* 1 if interval timer is running. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

extern TclStubs tclStubs;
extern Tcl_NotifierProcs tclOriginalNotifier;

/*
 * The following static indicates the number of threads that have initialized
 * notifiers. It controls the lifetime of the TclNotifier window class.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

static int notifierCount = 0;
static const WCHAR className[] = L"TclNotifier";
static int initialized = 0;
static CRITICAL_SECTION notifierMutex;
TCL_DECLARE_MUTEX(notifierMutex)

/*
 * Static routines defined in this file.
 */

static LRESULT CALLBACK		NotifierProc(HWND hwnd, UINT message,
				    WPARAM wParam, LPARAM lParam);
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
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







-
-
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
-
+
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
+
+

-
+

-
-
-
-
+
+
+
+

-
+
-







 *
 *----------------------------------------------------------------------
 */

ClientData
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    WNDCLASS class;
	TclpGlobalLock();
	if (!initialized) {
	    initialized = 1;
	    InitializeCriticalSection(&notifierMutex);
	}

	TclpGlobalUnlock();

	/*
	 * Register Notifier window class if this is the first thread to use
	 * this module.
	 */
    /*
     * Register Notifier window class if this is the first thread to use this
     * module.
     */

	EnterCriticalSection(&notifierMutex);
	if (notifierCount == 0) {
    Tcl_MutexLock(&notifierMutex);
    if (notifierCount == 0) {
	    WNDCLASSW clazz;

	    clazz.style = 0;
	    clazz.cbClsExtra = 0;
	    clazz.cbWndExtra = 0;
	    clazz.hInstance = (HINSTANCE)TclWinGetTclInstance();
	    clazz.hbrBackground = NULL;
	    clazz.lpszMenuName = NULL;
	    clazz.lpszClassName = className;
	    clazz.lpfnWndProc = NotifierProc;
	    clazz.hIcon = NULL;
	    clazz.hCursor = NULL;
	class.style = 0;
	class.cbClsExtra = 0;
	class.cbWndExtra = 0;
	class.hInstance = TclWinGetTclInstance();
	class.hbrBackground = NULL;
	class.lpszMenuName = NULL;
	class.lpszClassName = "TclNotifier";
	class.lpfnWndProc = NotifierProc;
	class.hIcon = NULL;
	class.hCursor = NULL;

	    if (!RegisterClassW(&clazz)) {
		Tcl_Panic("Unable to register TclNotifier window class");
	    }
	}
	notifierCount++;
	LeaveCriticalSection(&notifierMutex);
	if (!RegisterClassA(&class)) {
	    Tcl_Panic("Unable to register TclNotifier window class");
	}
    }
    notifierCount++;
    Tcl_MutexUnlock(&notifierMutex);

	tsdPtr->pending = 0;
	tsdPtr->timerActive = 0;
    tsdPtr->pending = 0;
    tsdPtr->timerActive = 0;

	InitializeCriticalSection(&tsdPtr->crit);
    InitializeCriticalSection(&tsdPtr->crit);

	tsdPtr->hwnd = NULL;
	tsdPtr->thread = GetCurrentThreadId();
	tsdPtr->event = CreateEventW(NULL, TRUE /* manual */,
		FALSE /* !signaled */, NULL);
    tsdPtr->hwnd = NULL;
    tsdPtr->thread = GetCurrentThreadId();
    tsdPtr->event = CreateEvent(NULL, TRUE /* manual */,
	    FALSE /* !signaled */, NULL);

	return tsdPtr;
    return (ClientData) tsdPtr;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FinalizeNotifier --
 *
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
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







-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
+
-
-
-
-
-
+
+
+
+
-
-
+
-







 *----------------------------------------------------------------------
 */

void
Tcl_FinalizeNotifier(
    ClientData clientData)	/* Pointer to notifier data. */
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

	/*
	 * Only finalize the notifier if a notifier was installed in the
	 * current thread; there is a route in which this is not guaranteed to
	 * be true (when tclWin32Dll.c:DllMain() is called with the flag
	 * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread
	 * that's never previously been involved with Tcl, e.g. the task
	 * manager) so this check is important.
	 *
	 * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
	 */
    /*
     * Only finalize the notifier if a notifier was installed in the current
     * thread; there is a route in which this is not guaranteed to be true
     * (when tclWin32Dll.c:DllMain() is called with the flag
     * DLL_PROCESS_DETACH by the OS, which could be doing so from a thread
     * that's never previously been involved with Tcl, e.g. the task manager)
     * so this check is important.
     *
     * Fixes Bug #217982 reported by Hugh Vu and Gene Leache.
     */

	if (tsdPtr == NULL) {
	    return;
	}
    if (tsdPtr == NULL) {
	return;
    }

	DeleteCriticalSection(&tsdPtr->crit);
	CloseHandle(tsdPtr->event);
    DeleteCriticalSection(&tsdPtr->crit);
    CloseHandle(tsdPtr->event);

	/*
	 * Clean up the timer and messaging window for this thread.
	 */
    /*
     * Clean up the timer and messaging window for this thread.
     */

	if (tsdPtr->hwnd) {
	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	    DestroyWindow(tsdPtr->hwnd);
	}
    if (tsdPtr->hwnd) {
	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	DestroyWindow(tsdPtr->hwnd);
    }

	/*
	 * If this is the last thread to use the notifier, unregister the
	 * notifier window class.
	 */
    /*
     * If this is the last thread to use the notifier, unregister the notifier
     * window class.
     */

	EnterCriticalSection(&notifierMutex);
    Tcl_MutexLock(&notifierMutex);
	if (notifierCount) {
	    notifierCount--;
	    if (notifierCount == 0) {
		UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance());
	    }
    notifierCount--;
    if (notifierCount == 0) {
	UnregisterClassA("TclNotifier", TclWinGetTclInstance());
    }
	}
	LeaveCriticalSection(&notifierMutex);
    Tcl_MutexUnlock(&notifierMutex);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
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
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







-
-
-
-
-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-







 *----------------------------------------------------------------------
 */

void
Tcl_AlertNotifier(
    ClientData clientData)	/* Pointer to thread data. */
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) clientData;

	/*
	 * Note that we do not need to lock around access to the hwnd because
	 * the race condition has no effect since any race condition implies
	 * that the notifier thread is already awake.
	 */
    /*
     * Note that we do not need to lock around access to the hwnd because the
     * race condition has no effect since any race condition implies that the
     * notifier thread is already awake.
     */

	if (tsdPtr->hwnd) {
	    /*
	     * We do need to lock around access to the pending flag.
	     */
    if (tsdPtr->hwnd) {
	/*
	 * We do need to lock around access to the pending flag.
	 */

	    EnterCriticalSection(&tsdPtr->crit);
	    if (!tsdPtr->pending) {
		PostMessageW(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
	    }
	    tsdPtr->pending = 1;
	    LeaveCriticalSection(&tsdPtr->crit);
	} else {
	    SetEvent(tsdPtr->event);
	EnterCriticalSection(&tsdPtr->crit);
	if (!tsdPtr->pending) {
	    PostMessage(tsdPtr->hwnd, WM_WAKEUP, 0, 0);
	}
	tsdPtr->pending = 1;
	LeaveCriticalSection(&tsdPtr->crit);
    } else {
	SetEvent(tsdPtr->event);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
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
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







-
+

-
-
-
-
-
-
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
-







 *	Replaces any previous timer.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimer(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.setTimerProc) {
	tclNotifierHooks.setTimerProc(timePtr);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	UINT timeout;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    UINT timeout;

	/*
	 * We only need to set up an interval timer if we're being called from
	 * an external event loop. If we don't have a window handle then we
	 * just return immediately and let Tcl_WaitForEvent handle timeouts.
	 */
    /*
     * Allow the notifier to be hooked. This may not make sense on Windows,
     * but mirrors the UNIX hook.
     */

    if (tclStubs.tcl_SetTimer != tclOriginalNotifier.setTimerProc) {
	tclStubs.tcl_SetTimer(timePtr);
	return;
    }

    /*
     * We only need to set up an interval timer if we're being called from an
     * external event loop. If we don't have a window handle then we just
     * return immediately and let Tcl_WaitForEvent handle timeouts.
     */

	if (!tsdPtr->hwnd) {
	    return;
	}
    if (!tsdPtr->hwnd) {
	return;
    }

	if (!timePtr) {
	    timeout = 0;
	} else {
	    /*
	     * Make sure we pass a non-zero value into the timeout argument.
	     * Windows seems to get confused by zero length timers.
	     */
    if (!timePtr) {
	timeout = 0;
    } else {
	/*
	 * Make sure we pass a non-zero value into the timeout argument.
	 * Windows seems to get confused by zero length timers.
	 */

	    timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	    if (timeout == 0) {
		timeout = 1;
	    }
	}
	if (timeout != 0) {
	    tsdPtr->timerActive = 1;
	    SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
		    timeout, NULL);
	} else {
	    tsdPtr->timerActive = 0;
	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
	if (timeout == 0) {
	    timeout = 1;
	}
    }
    tsdPtr->timeout = timeout;
    if (timeout != 0) {
	tsdPtr->timerActive = 1;
	SetTimer(tsdPtr->hwnd, INTERVAL_TIMER, (unsigned long) tsdPtr->timeout,
		NULL);
    } else {
	tsdPtr->timerActive = 0;
	KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ServiceModeHook --
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
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







-
-
-
-
-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+

-
-
-
+
+
+
-

-
-
-
-
-
-
+
+
+
+
+
+

-
+
-







 */

void
Tcl_ServiceModeHook(
    int mode)			/* Either TCL_SERVICE_ALL, or
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * If this is the first time that the notifier has been used from a
	 * modal loop, then create a communication window. Note that after this
	 * point, the application needs to service events in a timely fashion
	 * or Windows will hang waiting for the window to respond to
	 * synchronous system messages. At some point, we may want to consider
	 * destroying the window if we leave the modal loop, but for now we'll
    /*
     * If this is the first time that the notifier has been used from a modal
     * loop, then create a communication window. Note that after this point,
     * the application needs to service events in a timely fashion or Windows
     * will hang waiting for the window to respond to synchronous system
     * messages. At some point, we may want to consider destroying the window
     * if we leave the modal loop, but for now we'll leave it around.
	 * leave it around.
	 */
     */

	if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
	    tsdPtr->hwnd = CreateWindowW(className, className,
		    WS_TILED, 0, 0, 0, 0, NULL, NULL, (HINSTANCE)TclWinGetTclInstance(),
    if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
	tsdPtr->hwnd = CreateWindowA("TclNotifier", "TclNotifier", WS_TILED,
		0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(), NULL);
		    NULL);

	    /*
	     * Send an initial message to the window to ensure that we wake up
	     * the notifier once we get into the modal loop. This will force
	     * the notifier to recompute the timeout value and schedule a timer
	     * if one is needed.
	     */
	/*
	 * Send an initial message to the window to ensure that we wake up the
	 * notifier once we get into the modal loop. This will force the
	 * notifier to recompute the timeout value and schedule a timer if one
	 * is needed.
	 */

	    Tcl_AlertNotifier(tsdPtr);
	Tcl_AlertNotifier((ClientData)tsdPtr);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * NotifierProc --
403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
380
381
382
383
384
385
386

387
388
389
390
391
392
393
394







-
+







    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (message == WM_WAKEUP) {
	EnterCriticalSection(&tsdPtr->crit);
	tsdPtr->pending = 0;
	LeaveCriticalSection(&tsdPtr->crit);
    } else if (message != WM_TIMER) {
	return DefWindowProcW(hwnd, message, wParam, lParam);
	return DefWindowProc(hwnd, message, wParam, lParam);
    }

    /*
     * Process all of the runnable events.
     */

    Tcl_ServiceAll();
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
524
525
526
527
528
529
530
531
532









533
534
535
536



537
538
539
540
541
542
543
544
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
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
524
525
526







-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+

-
-
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
-







 *	Dispatches a message to a window procedure, which could do anything.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(
    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
    Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	MSG msg;
	DWORD timeout, result;
	int status;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    MSG msg;
    DWORD timeout, result;
    int status;

    /*
     * Allow the notifier to be hooked. This may not make sense on windows,
     * but mirrors the UNIX hook.
     */

    if (tclStubs.tcl_WaitForEvent != tclOriginalNotifier.waitForEventProc) {
	return tclStubs.tcl_WaitForEvent(timePtr);
    }

	/*
	 * Compute the timeout in milliseconds.
	 */
    /*
     * Compute the timeout in milliseconds.
     */

	if (timePtr) {
	    /*
	     * TIP #233 (Virtualized Time). Convert virtual domain delay to
	     * real-time.
	     */
    if (timePtr) {
	/*
	 * TIP #233 (Virtualized Time). Convert virtual domain delay to
	 * real-time.
	 */

	    Tcl_Time myTime;
	Tcl_Time myTime;

	    myTime.sec  = timePtr->sec;
	    myTime.usec = timePtr->usec;
	myTime.sec  = timePtr->sec;
	myTime.usec = timePtr->usec;

	    if (myTime.sec != 0 || myTime.usec != 0) {
		tclScaleTimeProcPtr(&myTime, tclTimeClientData);
	    }
	if (myTime.sec != 0 || myTime.usec != 0) {
	    (*tclScaleTimeProcPtr) (&myTime, tclTimeClientData);
	}

	    timeout = myTime.sec * 1000 + myTime.usec / 1000;
	} else {
	    timeout = INFINITE;
	}
	timeout = myTime.sec * 1000 + myTime.usec / 1000;
    } else {
	timeout = INFINITE;
    }

	/*
	 * Check to see if there are any messages in the queue before waiting
	 * because MsgWaitForMultipleObjects will not wake up if there are
	 * events currently sitting in the queue.
	 */
    /*
     * Check to see if there are any messages in the queue before waiting
     * because MsgWaitForMultipleObjects will not wake up if there are events
     * currently sitting in the queue.
     */

	if (!PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	    /*
	     * Wait for something to happen (a signal from another thread, a
	     * message, or timeout) or loop servicing asynchronous procedure
	     * calls queued to this thread.
	     */
    if (!PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	/*
	 * Wait for something to happen (a signal from another thread, a
	 * message, or timeout) or loop servicing asynchronous procedure calls
	 * queued to this thread.
	 */

	again:
	    result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
		    QS_ALLINPUT, MWMO_ALERTABLE);
	    if (result == WAIT_IO_COMPLETION) {
		goto again;
	    } else if (result == WAIT_FAILED) {
		status = -1;
		goto end;
	    }
	}
    again:
	result = MsgWaitForMultipleObjectsEx(1, &tsdPtr->event, timeout,
		QS_ALLINPUT, MWMO_ALERTABLE);
	if (result == WAIT_IO_COMPLETION) {
	    goto again;
	} else if (result == WAIT_FAILED) {
	    status = -1;
	    goto end;
	}
    }

	/*
	 * Check to see if there are any messages to process.
	 */
    /*
     * Check to see if there are any messages to process.
     */

	if (PeekMessageW(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	    /*
	     * Retrieve and dispatch the first message.
	     */
    if (PeekMessage(&msg, NULL, 0, 0, PM_NOREMOVE)) {
	/*
	 * Retrieve and dispatch the first message.
	 */

	    result = GetMessageW(&msg, NULL, 0, 0);
	    if (result == 0) {
		/*
		 * We received a request to exit this thread (WM_QUIT), so
		 * propagate the quit message and start unwinding.
		 */
	result = GetMessage(&msg, NULL, 0, 0);
	if (result == 0) {
	    /*
	     * We received a request to exit this thread (WM_QUIT), so
	     * propagate the quit message and start unwinding.
	     */

		PostQuitMessage((int) msg.wParam);
		status = -1;
	    } else if (result == (DWORD)-1) {
		/*
		 * We got an error from the system. I have no idea why this
		 * would happen, so we'll just unwind.
		 */
	    PostQuitMessage((int) msg.wParam);
	    status = -1;
	} else if (result == (DWORD)-1) {
	    /*
	     * We got an error from the system. I have no idea why this would
	     * happen, so we'll just unwind.
	     */

		status = -1;
	    } else {
		TranslateMessage(&msg);
		DispatchMessageW(&msg);
		status = 1;
	    }
	} else {
	    status = 0;
	}
	    status = -1;
	} else {
	    TranslateMessage(&msg);
	    DispatchMessage(&msg);
	    status = 1;
	}
    } else {
	status = 0;
    }

      end:
	ResetEvent(tsdPtr->event);
	return status;
  end:
    ResetEvent(tsdPtr->event);
    return status;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Sleep --
 *
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
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







-
+



-
+










-
+











	desired.usec -= 1000000;
    }

    /*
     * TIP #233: Scale delay from virtual to real-time.
     */

    tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
    (*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
    sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;

    for (;;) {
	SleepEx(sleepTime, TRUE);
	Sleep(sleepTime);
	Tcl_GetTime(&now);
	if (now.sec > desired.sec) {
	    break;
	} else if ((now.sec == desired.sec) && (now.usec >= desired.usec)) {
	    break;
	}

	vdelay.sec  = desired.sec  - now.sec;
	vdelay.usec = desired.usec - now.usec;

	tclScaleTimeProcPtr(&vdelay, tclTimeClientData);
	(*tclScaleTimeProcPtr) (&vdelay, tclTimeClientData);
	sleepTime = vdelay.sec * 1000 + vdelay.usec / 1000;
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Deleted win/tclWinPanic.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
























































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
 /*
 * tclWinPanic.c --
 *
 *	Contains the Windows-specific command-line panic proc.
 *
 * Copyright (c) 2013 by Jan Nijtmans.
 * 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"
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConsolePanic --
 *
 *	Display a message. If a debugger is present, present it directly to
 *	the debugger, otherwise send it to stderr.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

TCL_NORETURN1 void
Tcl_ConsolePanic(
    const char *format, ...)
{
#define TCL_MAX_WARN_LEN 26000
    va_list argList;
    WCHAR msgString[TCL_MAX_WARN_LEN];
    char buf[TCL_MAX_WARN_LEN * 3];
    HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
    DWORD dummy;

    va_start(argList, format);
    vsnprintf(buf+3, sizeof(buf)-3, format, argList);
    buf[sizeof(buf)-1] = 0;
    msgString[TCL_MAX_WARN_LEN-1] = '\0';
    MultiByteToWideChar(CP_UTF8, 0, buf+3, -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] != '\0') {
	memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
    }

    if (IsDebuggerPresent()) {
	OutputDebugStringW(msgString);
    } else if (_isatty(2)) {
	WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
    } else {
	buf[0] = '\xEF'; buf[1] = '\xBB'; buf[2] = '\xBF'; /* UTF-8 bom */
	WriteFile(handle, buf, strlen(buf), &dummy, 0);
	WriteFile(handle, "\n", 1, &dummy, 0);
	FlushFileBuffers(handle);
    }
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();
#   elif defined(_MSC_VER)
	_asm {int 3}
#   else
	DebugBreak();
#   endif
#if defined(_WIN32)
	ExitProcess(1);
#else
	abort();
#endif
}
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to win/tclWinPipe.c.

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
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







-
+










-
+



















-
-
-
-
-
-







#define WIN_FILE	3	/* Basic Win32 file. */

/*
 * This structure encapsulates the common state associated with all file types
 * used in a pipeline.
 */

typedef struct {
typedef struct WinFile {
    int type;			/* One of the file types defined above. */
    HANDLE handle;		/* Open file handle. */
} WinFile;

/*
 * This list is used to map from pids to process handles.
 */

typedef struct ProcInfo {
    HANDLE hProcess;
    size_t dwProcessId;
    DWORD dwProcessId;
    struct ProcInfo *nextPtr;
} ProcInfo;

static ProcInfo *procList;

/*
 * Bit masks used in the flags field of the PipeInfo structure below.
 */

#define PIPE_PENDING	(1<<0)	/* Message is pending in the queue. */
#define PIPE_ASYNC	(1<<1)	/* Channel is non-blocking. */

/*
 * Bit masks used in the sharedFlags field of the PipeInfo structure below.
 */

#define PIPE_EOF	(1<<2)	/* Pipe has reached EOF. */
#define PIPE_EXTRABYTE	(1<<3)	/* The reader thread has consumed one byte. */

/*
 * TODO: It appears the whole EXTRABYTE machinery is in place to support
 * outdated Win 95 systems.  If this can be confirmed, much code can be
 * deleted.
 */

/*
 * This structure describes per-instance data for a pipe based channel.
 */

typedef struct PipeInfo {
    struct PipeInfo *nextPtr;	/* Pointer to next registered pipe. */
    Tcl_Channel channel;	/* Pointer to channel structure. */
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
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







-
-


-






+
+
+
+
+
+
+
+
+
+




-
+
+















-
+















-
+







    TclFile writeFile;		/* Input from pipe. */
    TclFile errorFile;		/* Error output from pipe. */
    int numPids;		/* Number of processes attached to pipe. */
    Tcl_Pid *pidPtr;		/* Pids of attached processes. */
    Tcl_ThreadId threadId;	/* Thread to which events should be reported.
				 * This value is used by the reader/writer
				 * threads. */
    TclPipeThreadInfo *writeTI;	/* Thread info of writer and reader, this */
    TclPipeThreadInfo *readTI;	/* structure owned by corresponding thread. */
    HANDLE writeThread;		/* Handle to writer thread. */
    HANDLE readThread;		/* Handle to reader thread. */

    HANDLE writable;		/* Manual-reset event to signal when the
				 * writer thread has finished waiting for the
				 * current buffer to be written. */
    HANDLE readable;		/* Manual-reset event to signal when the
				 * reader thread has finished waiting for
				 * input. */
    HANDLE startWriter;		/* Auto-reset event used by the main thread to
				 * signal when the writer thread should
				 * attempt to write to the pipe. */
    HANDLE stopWriter;		/* Manual-reset event used to alert the reader
				 * thread to fall-out and exit */
    HANDLE startReader;		/* Auto-reset event used by the main thread to
				 * signal when the reader thread should
				 * attempt to read from the pipe. */
    HANDLE stopReader;		/* Manual-reset event used to alert the reader
				 * thread to fall-out and exit */
    DWORD writeError;		/* An error caused by the last background
				 * write. Set to 0 if no error has been
				 * detected. This word is shared with the
				 * writer thread so access must be
				 * synchronized with the writable object. */
				 * synchronized with the writable object.
				 */
    char *writeBuf;		/* Current background output buffer. Access is
				 * synchronized with the writable object. */
    int writeBufLen;		/* Size of write buffer. Access is
				 * synchronized with the writable object. */
    int toWrite;		/* Current amount to be written. Access is
				 * synchronized with the writable object. */
    int readFlags;		/* Flags that are shared with the reader
				 * thread. Access is synchronized with the
				 * readable object.  */
    char extraByte;		/* Buffer for extra character consumed by
				 * reader thread. This byte is shared with the
				 * reader thread so access must be
				 * synchronized with the readable object. */
} PipeInfo;

typedef struct {
typedef struct ThreadSpecificData {
    /*
     * The following pointer refers to the head of the list of pipes that are
     * being watched for file events.
     */

    PipeInfo *firstPipePtr;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following structure is what is added to the Tcl event queue when pipe
 * events are generated.
 */

typedef struct {
typedef struct PipeEvent {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    PipeInfo *infoPtr;		/* Pointer to pipe info structure. Note that
				 * we still have to verify that the pipe
				 * exists before dereferencing this
				 * pointer. */
} PipeEvent;
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
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







-
+


-
+













-
+







			    int action);

/*
 * This structure describes the channel type structure for command pipe based
 * I/O.
 */

static const Tcl_ChannelType pipeChannelType = {
static Tcl_ChannelType pipeChannelType = {
    "pipe",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    TCL_CLOSE2PROC,		/* Close proc. */
    PipeInputProc,		/* Input proc. */
    PipeOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    NULL,			/* Set option proc. */
    NULL,			/* Get option proc. */
    PipeWatchProc,		/* Set up notifier to watch the channel. */
    PipeGetHandleProc,		/* Get an OS handle from channel. */
    PipeClose2Proc,		/* close2proc */
    PipeBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc */
    PipeThreadActionProc,	/* thread action proc */
    NULL			/* truncate */
    NULL,                       /* truncate */
};

/*
 *----------------------------------------------------------------------
 *
 * PipeInit --
 *
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
308
309
310
311
312
313
314

315
316
317
318
319
320
321
322







-
+







 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
PipeSetupProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    PipeInfo *infoPtr;
    Tcl_Time blockTime = { 0, 0 };
    int block = 1;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

359
360
361
362
363
364
365
366

367
368
369
370
371
372
373
361
362
363
364
365
366
367

368
369
370
371
372
373
374
375







-
+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
PipeCheckProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    PipeInfo *infoPtr;
    PipeEvent *evPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

398
399
400
401
402
403
404
405

406
407
408
409
410
411
412
400
401
402
403
404
405
406

407
408
409
410
411
412
413
414







-
+







	if ((infoPtr->watchMask & TCL_READABLE) &&
		(WaitForRead(infoPtr, 0) >= 0)) {
	    needEvent = 1;
	}

	if (needEvent) {
	    infoPtr->flags |= PIPE_PENDING;
	    evPtr = (PipeEvent *)Tcl_Alloc(sizeof(PipeEvent));
	    evPtr = (PipeEvent *) ckalloc(sizeof(PipeEvent));
	    evPtr->header.proc = PipeEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

429
430
431
432
433
434
435
436

437
438
439
440
441
442
443
431
432
433
434
435
436
437

438
439
440
441
442
443
444
445







-
+








TclFile
TclWinMakeFile(
    HANDLE handle)		/* Type-specific data. */
{
    WinFile *filePtr;

    filePtr = (WinFile *)Tcl_Alloc(sizeof(WinFile));
    filePtr = (WinFile *) ckalloc(sizeof(WinFile));
    filePtr->type = WIN_FILE;
    filePtr->handle = handle;

    return (TclFile)filePtr;
}

/*
461
462
463
464
465
466
467
468
469
470






471
472
473




474
475
476





477
478
479
480
481
482
483
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







-
-
-
+
+
+
+
+
+



+
+
+
+
-
-
-
+
+
+
+
+







 */

static int
TempFileName(
    WCHAR name[MAX_PATH])	/* Buffer in which name for temporary file
				 * gets stored. */
{
    const WCHAR *prefix = L"TCL";
    if (GetTempPathW(MAX_PATH, name) != 0) {
	if (GetTempFileNameW(name, prefix, 0, name) != 0) {
    TCHAR *prefix;

    prefix = (tclWinProcs->useWide) ? (TCHAR *) L"TCL" : (TCHAR *) "TCL";
    if ((*tclWinProcs->getTempPathProc)(MAX_PATH, name) != 0) {
	if ((*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
		name) != 0) {
	    return 1;
	}
    }
    if (tclWinProcs->useWide) {
	((WCHAR *) name)[0] = '.';
	((WCHAR *) name)[1] = '\0';
    } else {
    name[0] = '.';
    name[1] = '\0';
    return GetTempFileNameW(name, prefix, 0, name);
	((char *) name)[0] = '.';
	((char *) name)[1] = '\0';
    }
    return (*tclWinProcs->getTempFileNameProc)((TCHAR *) name, prefix, 0,
	    name);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpMakeFile --
 *
528
529
530
531
532
533
534
535

536
537
538
539
540
541
542
539
540
541
542
543
544
545

546
547
548
549
550
551
552
553







-
+







TclpOpenFile(
    const char *path,		/* The name of the file to open. */
    int mode)			/* In what mode to open the file? */
{
    HANDLE handle;
    DWORD accessMode, createMode, shareMode, flags;
    Tcl_DString ds;
    const WCHAR *nativePath;
    const TCHAR *nativePath;

    /*
     * Map the access bits to the NT access mode.
     */

    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
    case O_RDONLY:
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
618
619
620
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
618
619
620
621
622

623
624
625
626
627
628
629
630







-
-
+







-
+















-
-
+
+






-
+







	createMode = TRUNCATE_EXISTING;
	break;
    default:
	createMode = OPEN_EXISTING;
	break;
    }

    Tcl_DStringInit(&ds);
    nativePath = Tcl_UtfToWCharDString(path, -1, &ds);
    nativePath = Tcl_WinUtfToTChar(path, -1, &ds);

    /*
     * If the file is not being created, use the existing file attributes.
     */

    flags = 0;
    if (!(mode & O_CREAT)) {
	flags = GetFileAttributesW(nativePath);
	flags = (*tclWinProcs->getFileAttributesProc)(nativePath);
	if (flags == 0xFFFFFFFF) {
	    flags = 0;
	}
    }

    /*
     * Set up the file sharing mode.  We want to allow simultaneous access.
     */

    shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;

    /*
     * Now we get to create the file.
     */

    handle = CreateFileW(nativePath, accessMode, shareMode,
	    NULL, createMode, flags, NULL);
    handle = (*tclWinProcs->createFileProc)(nativePath, accessMode,
	    shareMode, NULL, createMode, flags, NULL);
    Tcl_DStringFree(&ds);

    if (handle == INVALID_HANDLE_VALUE) {
	DWORD err;

	err = GetLastError();
	if ((err & 0xFFFFL) == ERROR_OPEN_FAILED) {
	if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
	    err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
	}
	TclWinConvertError(err);
	return NULL;
    }

    /*
655
656
657
658
659
660
661
662

663
664
665
666
667
668
669
665
666
667
668
669
670
671

672
673
674
675
676
677
678
679







-
+







    Tcl_DString dstring;
    HANDLE handle;

    if (TempFileName(name) == 0) {
	return NULL;
    }

    handle = CreateFileW(name,
    handle = (*tclWinProcs->createFileProc)((TCHAR *) name,
	    GENERIC_READ | GENERIC_WRITE, 0, NULL, CREATE_ALWAYS,
	    FILE_ATTRIBUTE_TEMPORARY|FILE_FLAG_DELETE_ON_CLOSE, NULL);
    if (handle == INVALID_HANDLE_VALUE) {
	goto error;
    }

    /*
717
718
719
720
721
722
723
724

725
726
727
728
729
730
731
727
728
729
730
731
732
733

734
735
736
737
738
739
740
741







-
+








    if (contents != NULL) {
	Tcl_DStringFree(&dstring);
    }

    TclWinConvertError(GetLastError());
    CloseHandle(handle);
    DeleteFileW(name);
    (*tclWinProcs->deleteFileProc)((TCHAR *) name);
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpTempFileName --
746
747
748
749
750
751
752
753

754
755
756
757
758
759
760
756
757
758
759
760
761
762

763
764
765
766
767
768
769
770







-
+







{
    WCHAR fileName[MAX_PATH];

    if (TempFileName(fileName) == 0) {
	return NULL;
    }

    return TclpNativeToNormalized(fileName);
    return TclpNativeToNormalized((ClientData) fileName);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreatePipe --
 *
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
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







-
+









-
+














-
+







-
+









-
+





-
+














-
+







	if (!TclInThreadExit()
		|| ((GetStdHandle(STD_INPUT_HANDLE) != filePtr->handle)
		    && (GetStdHandle(STD_OUTPUT_HANDLE) != filePtr->handle)
		    && (GetStdHandle(STD_ERROR_HANDLE) != filePtr->handle))) {
	    if (filePtr->handle != NULL &&
		    CloseHandle(filePtr->handle) == FALSE) {
		TclWinConvertError(GetLastError());
		Tcl_Free(filePtr);
		ckfree((char *) filePtr);
		return -1;
	    }
	}
	break;

    default:
	Tcl_Panic("TclpCloseFile: unexpected file type");
    }

    Tcl_Free(filePtr);
    ckfree((char *) filePtr);
    return 0;
}

/*
 *--------------------------------------------------------------------------
 *
 * TclpGetPid --
 *
 *	Given a HANDLE to a child process, return the process id for that
 *	child process.
 *
 * Results:
 *	Returns the process id for the child process. If the pid was not known
 *	by Tcl, either because the pid was not created by Tcl or the child
 *	process has already been reaped, TCL_INDEX_NONE is returned.
 *	process has already been reaped, -1 is returned.
 *
 * Side effects:
 *	None.
 *
 *--------------------------------------------------------------------------
 */

size_t
int
TclpGetPid(
    Tcl_Pid pid)		/* The HANDLE of the child process. */
{
    ProcInfo *infoPtr;

    PipeInit();

    Tcl_MutexLock(&pipeMutex);
    for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
	if (infoPtr->dwProcessId == (size_t) pid) {
	if (infoPtr->hProcess == (HANDLE) pid) {
	    Tcl_MutexUnlock(&pipeMutex);
	    return infoPtr->dwProcessId;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);
    return TCL_INDEX_NONE;
    return (unsigned long) -1;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateProcess --
 *
 *	Create a child process that has the specified files as its standard
 *	input, output, and error. The child process runs asynchronously under
 *	Windows NT and Windows 9x, and runs with the same environment
 *	variables as the creating process.
 *
 *	The complete Windows search path is searched to find the specified
 *	executable. If an executable by the given name is not found,
 *	automatically tries appending standard extensions to the
 *	automatically tries appending ".com", ".exe", ".bat" and ".cmd" to the
 *	executable name.
 *
 * Results:
 *	The return value is TCL_ERROR and an error message is left in the
 *	interp's result if there was a problem creating the child process.
 *	Otherwise, the return value is TCL_OK and *pidPtr is filled with the
 *	process id of the child process.
932
933
934
935
936
937
938
939
940


941
942
943
944

945
946
947
948
949
950
951
942
943
944
945
946
947
948


949
950
951
952
953

954
955
956
957
958
959
960
961







-
-
+
+



-
+







				 * from the child will be discarded. errorFile
				 * may be the same as outputFile. */
    Tcl_Pid *pidPtr)		/* If this function is successful, pidPtr is
				 * filled with the process id of the child
				 * process. */
{
    int result, applType, createFlags;
    Tcl_DString cmdLine;	/* Complete command line (WCHAR). */
    STARTUPINFOW startInfo;
    Tcl_DString cmdLine;	/* Complete command line (TCHAR). */
    STARTUPINFOA startInfo;
    PROCESS_INFORMATION procInfo;
    SECURITY_ATTRIBUTES secAtts;
    HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
    char execPath[MAX_PATH * 3];
    char execPath[MAX_PATH * TCL_UTF_MAX];
    WinFile *filePtr;

    PipeInit();

    applType = ApplicationType(interp, argv[0], execPath);
    if (applType == APPL_NONE) {
	return TCL_ERROR;
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
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
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







-
-
-
+
+


















+
+
+
+
+
+
-
-
+
+
+






-
-
-
+
+









-
+







-
-
-
+
+
















+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	}
    } else {
	DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
		0, TRUE, DUPLICATE_SAME_ACCESS);
    }
    if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't duplicate input handle: %s",
		Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't duplicate input handle: ",
		Tcl_PosixError(interp), (char *) NULL);
	goto end;
    }

    if (outputHandle == INVALID_HANDLE_VALUE) {
	/*
	 * If handle was not set, output should be sent to an infinitely deep
	 * sink. Under Windows 95, some 16 bit applications cannot have stdout
	 * redirected to NUL; they send their output to the console instead.
	 * Some applications, like "more" or "dir /p", when outputting
	 * multiple pages to the console, also then try and read from the
	 * console to go the next page. When running tk, this is fatal because
	 * the child process would hang forever waiting for input from the
	 * unmapped console window used by the helper application.
	 *
	 * Fortunately, the helper application will detect a closed pipe as a
	 * sink.
	 */

	if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS)
		&& (applType == APPL_DOS)) {
	    if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
		CloseHandle(h);
	    }
	} else {
	startInfo.hStdOutput = CreateFileW(L"NUL:", GENERIC_WRITE, 0,
		&secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
	    startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
		    &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
	}
    } else {
	DuplicateHandle(hProcess, outputHandle, hProcess,
		&startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
    }
    if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't duplicate output handle: %s",
		Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't duplicate output handle: ",
		Tcl_PosixError(interp), (char *) NULL);
	goto end;
    }

    if (errorHandle == INVALID_HANDLE_VALUE) {
	/*
	 * If handle was not set, errors should be sent to an infinitely deep
	 * sink.
	 */

	startInfo.hStdError = CreateFileW(L"NUL:", GENERIC_WRITE, 0,
	startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
		&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
    } else {
	DuplicateHandle(hProcess, errorHandle, hProcess, &startInfo.hStdError,
		0, TRUE, DUPLICATE_SAME_ACCESS);
    }
    if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't duplicate error handle: %s",
		Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't duplicate error handle: ",
		Tcl_PosixError(interp), (char *) NULL);
	goto end;
    }

    /*
     * If we do not have a console window, then we must run DOS and WIN32
     * console mode applications as detached processes. This tells the loader
     * that the child application should not inherit the console, and that it
     * should not create a new console window for the child application. The
     * child application should get its stdio from the redirection handles
     * provided by this application, and run in the background.
     *
     * If we are starting a GUI process, they don't automatically get a
     * console, so it doesn't matter if they are started as foreground or
     * detached processes. The GUI window will still pop up to the foreground.
     */

    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
    if (HasConsole()) {
	if (HasConsole()) {
	    createFlags = 0;
	} else if (applType == APPL_DOS) {
	    /*
	     * Under NT, 16-bit DOS applications will not run unless they can
	     * be attached to a console. If we are running without a console,
	     * run the 16-bit program as an normal process inside of a hidden
	     * console application, and then run that hidden console as a
	     * detached process.
	     */

	    startInfo.wShowWindow = SW_HIDE;
	    startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	    createFlags = CREATE_NEW_CONSOLE;
	    Tcl_DStringAppend(&cmdLine, "cmd.exe /c", -1);
	} else {
	    createFlags = DETACHED_PROCESS;
	}
    } else {
	if (HasConsole()) {
	    createFlags = 0;
	} else {
	    createFlags = DETACHED_PROCESS;
	}

    } else if (applType == APPL_DOS) {
	/*
	 * Under NT, 16-bit DOS applications will not run unless they can
	if (applType == APPL_DOS) {
	    /*
	     * Under Windows 95, 16-bit DOS applications do not work well with
	 * be attached to a console. If we are running without a console,
	 * run the 16-bit program as an normal process inside of a hidden
	 * console application, and then run that hidden console as a
	 * detached process.
	 */

	startInfo.wShowWindow = SW_HIDE;
	startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	createFlags = CREATE_NEW_CONSOLE;
	TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
    } else {
	createFlags = DETACHED_PROCESS;
	     * pipes:
	     *
	     * 1. EOF on a pipe between a detached 16-bit DOS application and
	     * another application is not seen at the other end of the pipe,
	     * so the listening process blocks forever on reads. This inablity
	     * to detect EOF happens when either a 16-bit app or the 32-bit
	     * app is the listener.
	     *
	     * 2. If a 16-bit DOS application (detached or not) blocks when
	     * writing to a pipe, it will never wake up again, and it
	     * eventually brings the whole system down around it.
	     *
	     * The 16-bit application is run as a normal process inside of a
	     * hidden helper console app, and this helper may be run as a
	     * detached process. If any of the stdio handles is a pipe, the
	     * helper application accumulates information into temp files and
	     * forwards it to or from the DOS application as appropriate.
	     * This means that DOS apps must receive EOF from a stdin pipe
	     * before they will actually begin, and must finish generating
	     * stdout or stderr before the data will be sent to the next stage
	     * of the pipe.
	     *
	     * The helper app should be located in the same directory as the
	     * tcl dll.
	     */
	    Tcl_Obj *tclExePtr, *pipeDllPtr;
	    char *start, *end;
	    int i, fileExists;
	    Tcl_DString pipeDll;

	    if (createFlags != 0) {
		startInfo.wShowWindow = SW_HIDE;
		startInfo.dwFlags |= STARTF_USESHOWWINDOW;
		createFlags = CREATE_NEW_CONSOLE;
	    }

	    Tcl_DStringInit(&pipeDll);
	    Tcl_DStringAppend(&pipeDll, TCL_PIPE_DLL, -1);
	    tclExePtr = TclGetObjNameOfExecutable();
	    Tcl_IncrRefCount(tclExePtr);
	    start = Tcl_GetStringFromObj(tclExePtr, &i);
	    for (end = start + (i-1); end > start; end--) {
		if (*end == '/') {
		    break;
		}
	    }
	    if (*end != '/') {
		Tcl_AppendResult(interp, "no / in executable path name \"",
			start, "\"", (char *) NULL);
		Tcl_DecrRefCount(tclExePtr);
		Tcl_DStringFree(&pipeDll);
		goto end;
	    }
	    i = (end - start) + 1;
	    pipeDllPtr = Tcl_NewStringObj(start, i);
	    Tcl_AppendToObj(pipeDllPtr, Tcl_DStringValue(&pipeDll), -1);
	    Tcl_IncrRefCount(pipeDllPtr);
	    if (Tcl_FSConvertToPathType(interp, pipeDllPtr) != TCL_OK) {
		Tcl_Panic("Tcl_FSConvertToPathType failed");
	    }
	    fileExists = (Tcl_FSAccess(pipeDllPtr, F_OK) == 0);
	    if (!fileExists) {
		Tcl_AppendResult(interp, "Tcl pipe dll \"",
			Tcl_DStringValue(&pipeDll), "\" not found",
			(char *) NULL);
		Tcl_DecrRefCount(tclExePtr);
		Tcl_DecrRefCount(pipeDllPtr);
		Tcl_DStringFree(&pipeDll);
		goto end;
	    }
	    Tcl_DStringAppend(&cmdLine, Tcl_DStringValue(&pipeDll), -1);
	    Tcl_DecrRefCount(tclExePtr);
	    Tcl_DecrRefCount(pipeDllPtr);
	    Tcl_DStringFree(&pipeDll);
	}
    }

    /*
     * cmdLine gets the full command line used to invoke the executable,
     * including the name of the executable itself. The command line arguments
     * in argv[] are stored in cmdLine separated by spaces. Special characters
     * in individual arguments from argv[] must be quoted when being stored in
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
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







+
-
-
+
+
-

-
-
+
+
















-
+






-
+







     * Additionally, when calling a 16-bit dos or windows application, all
     * path names must use the short, cryptic, path format (e.g., using
     * ab~1.def instead of "a b.default").
     */

    BuildCommandLine(execPath, argc, argv, &cmdLine);

    if ((*tclWinProcs->createProcessProc)(NULL,
    if (CreateProcessW(NULL, (WCHAR *) Tcl_DStringValue(&cmdLine),
	    NULL, NULL, TRUE, (DWORD) createFlags, NULL, NULL, &startInfo,
	    (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
	    (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
	    &procInfo) == 0) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
		argv[0], Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't execute \"", argv[0],
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	goto end;
    }

    /*
     * This wait is used to force the OS to give some time to the DOS process.
     */

    if (applType == APPL_DOS) {
	WaitForSingleObject(procInfo.hProcess, 50);
    }

    /*
     * "When an application spawns a process repeatedly, a new thread instance
     * will be created for each process but the previous instances may not be
     * cleaned up. This results in a significant virtual memory loss each time
     * the process is spawned. If there is a WaitForInputIdle() call between
     * CreateProcessW() and CloseHandle(), the problem does not occur." PSS ID
     * CreateProcess() and CloseHandle(), the problem does not occur." PSS ID
     * Number: Q124121
     */

    WaitForInputIdle(procInfo.hProcess, 5000);
    CloseHandle(procInfo.hThread);

    *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId;
    *pidPtr = (Tcl_Pid) procInfo.hProcess;
    if (*pidPtr != 0) {
	TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
    }
    result = TCL_OK;

  end:
    Tcl_DStringFree(&cmdLine);
1201
1202
1203
1204
1205
1206
1207
1208

1209
1210
1211
1212
1213
1214
1215
1302
1303
1304
1305
1306
1307
1308

1309
1310
1311
1312
1313
1314
1315
1316







-
+







 */

static BOOL
HasConsole(void)
{
    HANDLE handle;

    handle = CreateFileW(L"CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
    handle = CreateFileA("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE,
	    NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);

    if (handle != INVALID_HANDLE_VALUE) {
	CloseHandle(handle);
	return TRUE;
    } else {
	return FALSE;
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
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
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







-
+





-
+








-
+















-
-
+

-
-
+
+










-
-
+
+


-
-
+




-
+




-
+







    Tcl_Interp *interp,		/* Interp, for error message. */
    const char *originalName,	/* Name of the application to find. */
    char fullName[])		/* Filled with complete path to
				 * application. */
{
    int applType, i, nameLen, found;
    HANDLE hFile;
    WCHAR *rest;
    TCHAR *rest;
    char *ext;
    char buf[2];
    DWORD attr, read;
    IMAGE_DOS_HEADER header;
    Tcl_DString nameBuf, ds;
    const WCHAR *nativeName;
    const TCHAR *nativeName;
    WCHAR nativeFullPath[MAX_PATH];
    static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};

    /*
     * Look for the program as an external program. First try the name as it
     * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name,
     * looking for an executable.
     *
     * Using the raw SearchPathW() function doesn't do quite what is necessary.
     * Using the raw SearchPath() function doesn't do quite what is necessary.
     * If the name of the executable already contains a '.' character, it will
     * not try appending the specified extension when searching (in other
     * words, SearchPath will not find the program "a.b.exe" if the arguments
     * specified "a.b" and ".exe"). So, first look for the file as it is
     * named. Then manually append the extensions, looking for a match.
     */

    applType = APPL_NONE;
    Tcl_DStringInit(&nameBuf);
    Tcl_DStringAppend(&nameBuf, originalName, -1);
    nameLen = Tcl_DStringLength(&nameBuf);

    for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
	Tcl_DStringSetLength(&nameBuf, nameLen);
	Tcl_DStringAppend(&nameBuf, extensions[i], -1);
	Tcl_DStringInit(&ds);
	nativeName = Tcl_UtfToWCharDString(Tcl_DStringValue(&nameBuf),
	nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf),
		Tcl_DStringLength(&nameBuf), &ds);
	found = SearchPathW(NULL, nativeName, NULL, MAX_PATH,
		nativeFullPath, &rest);
	found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL,
		MAX_PATH, nativeFullPath, &rest);
	Tcl_DStringFree(&ds);
	if (found == 0) {
	    continue;
	}

	/*
	 * Ignore matches on directories or data files, return if identified a
	 * known type.
	 */

	attr = GetFileAttributesW(nativeFullPath);
	if ((attr == 0xFFFFFFFF) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
	attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
	if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
	    continue;
	}
	Tcl_DStringInit(&ds);
	strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds));
	strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
	Tcl_DStringFree(&ds);

	ext = strrchr(fullName, '.');
	if ((ext != NULL) &&
            (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) {
	    (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) {
	    applType = APPL_DOS;
	    break;
	}

	hFile = CreateFileW(nativeFullPath,
	hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath,
		GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING,
		FILE_ATTRIBUTE_NORMAL, NULL);
	if (hFile == INVALID_HANDLE_VALUE) {
	    continue;
	}

	header.e_magic = 0;
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454

1455

1456
1457

1458
1459
1460
1461

1462
1463
1464
1465

1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476

1477

1478
1479
1480

1481
1482
1483
1484
1485
1486
1487

1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498




1499
1500
1501
1502

1503
1504
1505
1506
1507
1508

1509
1510
1511
1512

1513
1514
1515
1516
1517
1518
1519

1520
1521
1522
1523
1524
1525

1526
1527
1528
1529
1530
1531

1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542

1543
1544
1545
1546
1547
1548


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
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
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
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
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
1531
1532

1533



1534
1535


1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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

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
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




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







-
-
+
+











+
-
+
-
-
+











-
+















-
+
-
-
-
+
+
-
-














-
+
-
+

-
+



-
+



-
+










-
+
-
+

-
-
+
-
-



-
-
+
-
-



-

-
-
-
-
+
+
+
+
-

-
-
+




-
-
+
-
-

-
+
-
-



-
-
+
-
-


-
-
+
-
-
-


-
+










-
+




-
-
+
+
-
-
-
-
+
+
+
+
-
-
+












-
+

-
+







-
+







+
+

-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+






-
+



-
+




-
+









-
-
+
-
-
-
+


-
-
+
-
-




-
-
+
-
-
-

-
-
+
-
-

-
+
-
-
+
-


-
-
-
-
-
+
-
-
-
+
-
-


-
-
-
+
-
-
-
+



-
-
-
+
-
-
-

-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-
-

-
+
-
-
-
-
+
-
-



-
-
-
+
-
-
-
+
-


-
-
-
+
-
-
-

-
+


-
-
+
-
-
-
+



-
-
+







	}
	break;
    }
    Tcl_DStringFree(&nameBuf);

    if (applType == APPL_NONE) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("couldn't execute \"%s\": %s",
		originalName, Tcl_PosixError(interp)));
	Tcl_AppendResult(interp, "couldn't execute \"", originalName,
		"\": ", Tcl_PosixError(interp), (char *) NULL);
	return APPL_NONE;
    }

    if (applType == APPL_WIN3X) {
	/*
	 * Replace long path name of executable with short path name for
	 * 16-bit applications. Otherwise the application may not be able to
	 * correctly parse its own command line to separate off the
	 * application name from the arguments.
	 */

	(*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
	GetShortPathNameW(nativeFullPath, nativeFullPath, MAX_PATH);
		nativeFullPath, MAX_PATH);
	Tcl_DStringInit(&ds);
	strcpy(fullName, Tcl_WCharToUtfDString(nativeFullPath, -1, &ds));
	strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
	Tcl_DStringFree(&ds);
    }
    return applType;
}

/*
 *----------------------------------------------------------------------
 *
 * BuildCommandLine --
 *
 *	The command line arguments are stored in linePtr separated by spaces,
 *	in a form that CreateProcessW() understands. Special characters in
 *	in a form that CreateProcess() understands. Special characters in
 *	individual arguments from argv[] must be quoted when being stored in
 *	cmdLine.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static const char *
BuildCmdLineBypassBS(
    const char *current,
    const char **bspos)
    const char **bspos
{
    /*
     * Mark first backslash position.
) {
    /* mark first backslash possition */
     */

    if (!*bspos) {
	*bspos = current;
    }
    do {
	current++;
    } while (*current == '\\');
    return current;
}

static void
QuoteCmdLineBackslash(
    Tcl_DString *dsPtr,
    const char *start,
    const char *current,
    const char *bspos)
    const char *bspos
{
) {
    if (!bspos) {
	if (current > start) {	/* part before current (special) */
	if (current > start) { /* part before current (special) */
	    Tcl_DStringAppend(dsPtr, start, (int) (current - start));
	}
    } else {
    	if (bspos > start) {	/* part before first backslash */
    	if (bspos > start) { /* part before first backslash */
	    Tcl_DStringAppend(dsPtr, start, (int) (bspos - start));
	}
	while (bspos++ < current) { /* each backslash twice */
	    TclDStringAppendLiteral(dsPtr, "\\\\");
	    Tcl_DStringAppend(dsPtr, "\\\\", 2);
	}
    }
}

static const char *
QuoteCmdLinePart(
    Tcl_DString *dsPtr,
    const char *start,
    const char *special,
    const char *specMetaChars,
    const char **bspos)
    const char **bspos
{
) {
    if (!*bspos) {
	/*
	 * Rest before special (before quote).
	/* rest before special (before quote) */
	 */

	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
	start = special;
    } else {
	/*
	 * Rest before first backslash and backslashes into new quoted block.
	/* rest before first backslash and backslashes into new quoted block */
	 */

	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
	start = *bspos;
    }

    /*
     * escape all special chars enclosed in quotes like `"..."`, note that
     * here we don't must escape `\` (with `\`), because it's outside of the
     * main quotes, so `\` remains `\`, but important - not at end of part,
     * because results as before the quote, so `%\%\` should be escaped as
     * escape all special chars enclosed in quotes like `"..."`, note that here we
     * don't must escape `\` (with `\`), because it's outside of the main quotes,
     * so `\` remains `\`, but important - not at end of part, because results as
     * before the quote,  so `%\%\` should be escaped as `"%\%"\\`).
     * `"%\%"\\`).
     */

    TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
    Tcl_DStringAppend(dsPtr, "\"", 1); /* opening escape quote-char */
    do {
    	*bspos = NULL;
	special++;
	if (*special == '\\') {
	    /*
	     * Bypass backslashes (and mark first backslash position).
	    /* bypass backslashes (and mark first backslash possition)*/
	     */

	    special = BuildCmdLineBypassBS(special, bspos);
	    if (*special == '\0') {
	    if (*special == '\0') break;
		break;
	    }
	}
    } while (*special && strchr(specMetaChars, *special));
    if (!*bspos) {
	/*
	 * Unescaped rest before quote.
	/* unescaped rest before quote */
	 */

	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
    } else {
	/*
	 * Unescaped rest before first backslash (rather belongs to the main
	/* unescaped rest before first backslash (rather belongs to the main block) */
	 * block).
	 */

	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
    }
    TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */
    Tcl_DStringAppend(dsPtr, "\"", 1); /* closing escape quote-char */
    return special;
}

static void
BuildCommandLine(
    const char *executable,	/* Full path of executable (including
				 * extension). Replacement for argv[0]. */
    int argc,			/* Number of arguments. */
    const char **argv,		/* Argument strings in UTF. */
    Tcl_DString *linePtr)	/* Initialized Tcl_DString that receives the
				 * command line (WCHAR). */
				 * command line (TCHAR). */
{
    const char *arg, *start, *special, *bspos;
    int quote = 0, i;
    Tcl_DString ds;
    static const char specMetaChars[] = "&|^<>!()%";
				/* Characters to enclose in quotes if unpaired

    /* characters to enclose in quotes if unpaired quote flag set */
				 * quote flag set. */
    static const char specMetaChars2[] = "%";
				/* Character to enclose in quotes in any case
				 * (regardless of unpaired-flag). */
    static const char specMetaChars[] = "&|^<>!()%";
    /* character to enclose in quotes in any case (regardless unpaired-flag) */
    static const char specMetaChars2[] = "%";

    /*
     * Quote flags:
    /* Quote flags:
     *   CL_ESCAPE   - escape argument;
     *   CL_QUOTE    - enclose in quotes;
     *   CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
     */
    enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4};

    Tcl_DStringInit(&ds);

    /*
     * Prime the path. Add a space separator if we were primed with something.
     */

    TclDStringAppendDString(&ds, linePtr);
    Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
    if (Tcl_DStringLength(linePtr) > 0) {
	TclDStringAppendLiteral(&ds, " ");
	Tcl_DStringAppend(&ds, " ", 1);
    }

    for (i = 0; i < argc; i++) {
	if (i == 0) {
	    arg = executable;
	} else {
	    arg = argv[i];
	    TclDStringAppendLiteral(&ds, " ");
	    Tcl_DStringAppend(&ds, " ", 1);
	}

	quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */
	bspos = NULL;
	if (arg[0] == '\0') {
	    quote = CL_QUOTE;
	} else {
	    int count;
	    Tcl_UniChar ch;
	    for (start = arg;
		    *start != '\0' &&
			(quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
		    start++) {
		if (*start & 0x80) {
		    continue;
		*start != '\0' &&
		    (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
		start += count
	    ) {
		count = Tcl_UtfToUniChar(start, &ch);
		if (count > 1) continue;
		}
		if (TclIsSpaceProc(*start)) {
		    quote |= CL_QUOTE;	/* quote only */
		    if (bspos) {	/* if backslash found, escape & quote */
		if (Tcl_UniCharIsSpace(ch)) {
		    quote |= CL_QUOTE; /* quote only */
		    if (bspos) { /* if backslash found - escape & quote */
			quote |= CL_ESCAPE;
			break;
		    }
		    continue;
		}
		if (strchr(specMetaChars, *start)) {
		    quote |= (CL_ESCAPE|CL_QUOTE); /* escape & quote */
		    quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
		    break;
		}
		if (*start == '"') {
		    quote |= CL_ESCAPE;		/* escape only */
		    quote |= CL_ESCAPE; /* escape only */
		    continue;
		}
		if (*start == '\\') {
		    bspos = start;
		    if (quote & CL_QUOTE) {	/* if quote, escape & quote */
		    if (quote & CL_QUOTE) { /* if quote - escape & quote */
			quote |= CL_ESCAPE;
			break;
		    }
		    continue;
		}
	    }
	    bspos = NULL;
	}
	if (quote & CL_QUOTE) {
	    /*
	     * Start of argument (main opening quote-char).
	    /* start of argument (main opening quote-char) */
	     */

	    TclDStringAppendLiteral(&ds, "\"");
	    Tcl_DStringAppend(&ds, "\"", 1);
	}
	if (!(quote & CL_ESCAPE)) {
	    /*
	     * Nothing to escape.
	    /* nothing to escape */
	     */

	    Tcl_DStringAppend(&ds, arg, -1);
	} else {
	    start = arg;
	    for (special = arg; *special != '\0'; ) {
		/*
		 * Position of `\` is important before quote or at end (equal
		/* position of `\` is important before quote or at end (equal `\"` because quoted) */
		 * `\"` because quoted).
		 */

		if (*special == '\\') {
		    /*
		     * Bypass backslashes (and mark first backslash position)
		    /* bypass backslashes (and mark first backslash possition)*/
		     */

		    special = BuildCmdLineBypassBS(special, &bspos);
		    if (*special == '\0') {
		    if (*special == '\0') break;
			break;
		    }
		}
		}
		/* ["] */
		if (*special == '"') {
		    /*
		     * Invert the unpaired flag - observe unpaired quotes
		     */

		    quote ^= CL_UNPAIRED;
		    quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */

		    /*
		     * Add part before (and escape backslashes before quote).
		    /* add part before (and escape backslashes before quote) */
		     */

		    QuoteCmdLineBackslash(&ds, start, special, bspos);
		    bspos = NULL;

		    /*
		     * Escape using backslash
		    /* escape using backslash */
		     */

		    TclDStringAppendLiteral(&ds, "\\\"");
		    Tcl_DStringAppend(&ds, "\\\"", 2);
		    start = ++special;
		    continue;
		}

		/*
		 * Unpaired (escaped) quote causes special handling on
		/* unpaired (escaped) quote causes special handling on meta-chars */
		 * meta-chars
		 */

		if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
		    special = QuoteCmdLinePart(&ds, start, special,
			    specMetaChars, &bspos);

		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
		    /* start to current or first backslash */
		    start = !bspos ? special : bspos;
		    continue;
		}
		    /*
		     * Start to current or first backslash
		     */

		    start = !bspos ? special : bspos;
		    continue;
		}

		/*
		 * Special case for % - should be enclosed always (paired
		/* special case for % - should be enclosed always (paired also) */
		 * also)
		 */

		if (strchr(specMetaChars2, *special)) {
		    special = QuoteCmdLinePart(&ds, start, special,
		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos);
			    specMetaChars2, &bspos);

		    /*
		     * Start to current or first backslash.
		    /* start to current or first backslash */
		     */

		    start = !bspos ? special : bspos;
		    continue;
		}

		/*
		 * Other not special (and not meta) character
		/* other not special (and not meta) character */
		 */

		bspos = NULL;		/* reset last backslash position (not
		bspos = NULL; /* reset last backslash possition (not interesting) */
					 * interesting) */
		special++;
	    }

	    /*
	     * Rest of argument (and escape backslashes before closing main
	    /* rest of argument (and escape backslashes before closing main quote) */
	     * quote)
	     */

	    QuoteCmdLineBackslash(&ds, start, special,
		    (quote & CL_QUOTE) ? bspos : NULL);
	    	(quote & CL_QUOTE) ? bspos : NULL);
	}
	if (quote & CL_QUOTE) {
	    /*
	     * End of argument (main closing quote-char)
	    /* end of argument (main closing quote-char) */
	     */

	    TclDStringAppendLiteral(&ds, "\"");
	    Tcl_DStringAppend(&ds, "\"", 1);
	}
    }
    Tcl_DStringFree(linePtr);
    Tcl_DStringInit(linePtr);
    Tcl_UtfToWCharDString(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpCreateCommandChannel --
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
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
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
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







+
-
+














-
+










-
+
+
+

-
-
+



-







-
+
+
+

-
-
+


-
-
-









-
+

-
+







+
-
-
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







    TclFile writeFile,		/* If non-null, gives the file for writing. */
    TclFile errorFile,		/* If non-null, gives the file where errors
				 * can be read. */
    int numPids,		/* The number of pids in the pid array. */
    Tcl_Pid *pidPtr)		/* An array of process identifiers. */
{
    char channelName[16 + TCL_INTEGER_SPACE];
    DWORD id;
    PipeInfo *infoPtr = (PipeInfo *)Tcl_Alloc(sizeof(PipeInfo));
    PipeInfo *infoPtr = (PipeInfo *) ckalloc((unsigned) sizeof(PipeInfo));

    PipeInit();

    infoPtr->watchMask = 0;
    infoPtr->flags = 0;
    infoPtr->readFlags = 0;
    infoPtr->readFile = readFile;
    infoPtr->writeFile = writeFile;
    infoPtr->errorFile = errorFile;
    infoPtr->numPids = numPids;
    infoPtr->pidPtr = pidPtr;
    infoPtr->writeBuf = 0;
    infoPtr->writeBufLen = 0;
    infoPtr->writeError = 0;
    infoPtr->channel = NULL;
    infoPtr->channel = (Tcl_Channel) NULL;

    infoPtr->validMask = 0;

    infoPtr->threadId = Tcl_GetCurrentThread();

    if (readFile != NULL) {
	/*
	 * Start the background reader thread.
	 */

	infoPtr->readable = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->readable = CreateEvent(NULL, TRUE, TRUE, NULL);
	infoPtr->startReader = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->stopReader = CreateEvent(NULL, TRUE, FALSE, NULL);
	infoPtr->readThread = CreateThread(NULL, 256, PipeReaderThread,
	    TclPipeThreadCreateTI(&infoPtr->readTI, infoPtr, infoPtr->readable),
	    0, NULL);
		infoPtr, 0, &id);
	SetThreadPriority(infoPtr->readThread, THREAD_PRIORITY_HIGHEST);
	infoPtr->validMask |= TCL_READABLE;
    } else {
    	infoPtr->readTI = NULL;
	infoPtr->readThread = 0;
    }
    if (writeFile != NULL) {
	/*
	 * Start the background writer thread.
	 */

	infoPtr->writable = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->writable = CreateEvent(NULL, TRUE, TRUE, NULL);
	infoPtr->startWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->stopWriter = CreateEvent(NULL, TRUE, FALSE, NULL);
	infoPtr->writeThread = CreateThread(NULL, 256, PipeWriterThread,
	    TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr, infoPtr->writable),
	    0, NULL);
		infoPtr, 0, &id);
	SetThreadPriority(infoPtr->writeThread, THREAD_PRIORITY_HIGHEST);
	infoPtr->validMask |= TCL_WRITABLE;
    } else {
    	infoPtr->writeTI = NULL;
    	infoPtr->writeThread = 0;
    }

    /*
     * For backward compatibility with previous versions of Tcl, we use
     * "file%d" as the base name for pipes even though it would be more
     * natural to use "pipe%d". Use the pointer to keep the channel names
     * unique, in case channels share handles (stdin/stdout).
     */

    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t)infoPtr);
    infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
	    infoPtr, infoPtr->validMask);
	    (ClientData) infoPtr, infoPtr->validMask);

    /*
     * Pipes have AUTO translation mode on Windows and ^Z eof char, which
     * means that a ^Z will be appended to them at close. This is needed for
     * Windows programs that expect a ^Z at EOF.
     */

    Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
	    "-translation", "auto");
    Tcl_SetChannelOption((Tcl_Interp *) NULL, infoPtr->channel,
	    "-eofchar", "\032 {}");
    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreatePipe --
 *
 *	System dependent interface to create a pipe for the [chan pipe]
 *	command. Stolen from TclX.
 *
 * Results:
 *	TCL_OK or TCL_ERROR.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_CreatePipe(
    Tcl_Interp *interp,		/* Errors returned in result.*/
    Tcl_Channel *rchan,		/* Where to return the read side. */
    Tcl_Channel *wchan,		/* Where to return the write side. */
    TCL_UNUSED(int) /*flags*/)	/* Reserved for future use. */
{
    HANDLE readHandle, writeHandle;
    SECURITY_ATTRIBUTES sec;

    sec.nLength = sizeof(SECURITY_ATTRIBUTES);
    sec.lpSecurityDescriptor = NULL;
    sec.bInheritHandle = FALSE;

    if (!CreatePipe(&readHandle, &writeHandle, &sec, 0)) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"pipe creation failed: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }

    *rchan = Tcl_MakeFileChannel((ClientData) readHandle, TCL_READABLE);
    Tcl_RegisterChannel(interp, *rchan);

    *wchan = Tcl_MakeFileChannel((ClientData) writeHandle, TCL_WRITABLE);
    Tcl_RegisterChannel(interp, *wchan);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclGetAndDetachPids --
 *
 *	Stores a list of the command PIDs for a command channel in the
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
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







-

+










-
+
-

-
-
-
-
+
+
+

-

-
+







void
TclGetAndDetachPids(
    Tcl_Interp *interp,
    Tcl_Channel chan)
{
    PipeInfo *pipePtr;
    const Tcl_ChannelType *chanTypePtr;
    Tcl_Obj *pidsObj;
    int i;
    char buf[TCL_INTEGER_SPACE];

    /*
     * Punt if the channel is not a command channel.
     */

    chanTypePtr = Tcl_GetChannelType(chan);
    if (chanTypePtr != &pipeChannelType) {
	return;
    }

    pipePtr = (PipeInfo *)Tcl_GetChannelInstanceData(chan);
    pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
    TclNewObj(pidsObj);
    for (i = 0; i < pipePtr->numPids; i++) {
	Tcl_ListObjAppendElement(NULL, pidsObj,
		Tcl_NewWideIntObj(
			TclpGetPid(pipePtr->pidPtr[i])));
	Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
	wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
	Tcl_AppendElement(interp, buf);
	Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
    }
    Tcl_SetObjResult(interp, pidsObj);
    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
	ckfree((char *) pipePtr->pidPtr);
	pipePtr->numPids = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
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
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







-
+




-
+







+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+


+
+








-
+
+

-

-
-
-
+
+
+
-

-
+
+

+
+
+
+
-
-
+
+

+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
-
+
+
+


-
-
-
-
+
+
+
+







    int flags)			/* Flags that indicate which side to close. */
{
    PipeInfo *pipePtr = (PipeInfo *) instanceData;
    Tcl_Channel errChan;
    int errorCode, result;
    PipeInfo *infoPtr, **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int inExit = (TclInExit() || TclInThreadExit());
    DWORD exitCode;

    errorCode = 0;
    result = 0;

    if ((!flags || flags & TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) {
    if ((!flags || flags == TCL_CLOSE_READ) && (pipePtr->readFile != NULL)) {
	/*
	 * Clean up the background thread if necessary. Note that this must be
	 * done before we can close the file, since the thread may be blocking
	 * trying to read from the pipe.
	 */

	if (pipePtr->readThread) {
	    /*
	     * The thread may already have closed on its own. Check its exit
	     * code.
	     */

	    GetExitCodeThread(pipePtr->readThread, &exitCode);

	    if (exitCode == STILL_ACTIVE) {
		/*
		 * Set the stop event so that if the reader thread is blocked
		 * in PipeReaderThread on WaitForMultipleEvents, it will exit
		 * cleanly.
		 */

		SetEvent(pipePtr->stopReader);

		/*
		 * Wait at most 20 milliseconds for the reader thread to
		 * close.
		 */

		if (WaitForSingleObject(pipePtr->readThread,
			20) == WAIT_TIMEOUT) {
		    /*
		     * The thread must be blocked waiting for the pipe to
		     * become readable in ReadFile(). There isn't a clean way
		     * to exit the thread from this condition. We should
		     * terminate the child process instead to get the reader
		     * thread to fall out of ReadFile with a FALSE. (below) is
		     * not the correct way to do this, but will stay here
		     * until a better solution is found.
		     *
		     * Note that we need to guard against terminating the
		     * thread while it is in the middle of Tcl_ThreadAlert
		     * because it won't be able to release the notifier lock.
		     */

		    Tcl_MutexLock(&pipeMutex);

		    /* BUG: this leaks memory */
	    TclPipeThreadStop(&pipePtr->readTI, pipePtr->readThread);
		    TerminateThread(pipePtr->readThread, 0);
		    Tcl_MutexUnlock(&pipeMutex);
		}
	    }

	    CloseHandle(pipePtr->readThread);
	    CloseHandle(pipePtr->readable);
	    CloseHandle(pipePtr->startReader);
	    CloseHandle(pipePtr->stopReader);
	    pipePtr->readThread = NULL;
	}
	if (TclpCloseFile(pipePtr->readFile) != 0) {
	    errorCode = errno;
	}
	pipePtr->validMask &= ~TCL_READABLE;
	pipePtr->readFile = NULL;
    }
    if ((!flags || flags & TCL_CLOSE_WRITE) && (pipePtr->writeFile != NULL)) {
    if ((!flags || flags & TCL_CLOSE_WRITE)
	    && (pipePtr->writeFile != NULL)) {
	if (pipePtr->writeThread) {

	    /*
	     * Wait for the  writer thread to finish the  current buffer, then
	     * terminate the thread  and close the handles. If  the channel is
	     * nonblocking or may block during exit, bail out since the worker
	     * Wait for the writer thread to finish the current buffer, then
	     * terminate the thread and close the handles. If the channel is
	     * nonblocking, there should be no pending write operations.
	     * thread is not interruptible and we want TIP#398-fast-exit.
	     */
	    if ((pipePtr->flags & PIPE_ASYNC) && inExit) {

	    WaitForSingleObject(pipePtr->writable, INFINITE);

	    /*
	     * The thread may already have closed on it's own. Check its exit
	     * code.
	     */
		/* give it a chance to leave honorably */
		TclPipeThreadStopSignal(&pipePtr->writeTI, pipePtr->writable);

	    GetExitCodeThread(pipePtr->writeThread, &exitCode);

	    if (exitCode == STILL_ACTIVE) {
		/*
		 * Set the stop event so that if the reader thread is blocked
		 * in PipeReaderThread on WaitForMultipleEvents, it will exit
		 * cleanly.
		 */
		if (WaitForSingleObject(pipePtr->writable, 20) == WAIT_TIMEOUT) {
		    return EWOULDBLOCK;
		}

	    } else {

		SetEvent(pipePtr->stopWriter);

		/*
		 * Wait at most 20 milliseconds for the reader thread to
		 * close.
		 */

		if (WaitForSingleObject(pipePtr->writeThread,
			20) == WAIT_TIMEOUT) {
		    /*
		     * The thread must be blocked waiting for the pipe to
		     * consume input in WriteFile(). There isn't a clean way
		     * to exit the thread from this condition. We should
		     * terminate the child process instead to get the writer
		     * thread to fall out of WriteFile with a FALSE. (below)
		     * is not the correct way to do this, but will stay here
		     * until a better solution is found.
		     *
		     * Note that we need to guard against terminating the
		     * thread while it is in the middle of Tcl_ThreadAlert
		     * because it won't be able to release the notifier lock.
		     */

		    Tcl_MutexLock(&pipeMutex);

		    /* BUG: this leaks memory */
		WaitForSingleObject(pipePtr->writable, inExit ? 5000 : INFINITE);

		    TerminateThread(pipePtr->writeThread, 0);
		    Tcl_MutexUnlock(&pipeMutex);
		}
	    }

	    TclPipeThreadStop(&pipePtr->writeTI, pipePtr->writeThread);

	    CloseHandle(pipePtr->writable);
	    CloseHandle(pipePtr->writeThread);
	    CloseHandle(pipePtr->writeThread);
	    CloseHandle(pipePtr->writable);
	    CloseHandle(pipePtr->startWriter);
	    CloseHandle(pipePtr->stopWriter);
	    pipePtr->writeThread = NULL;
	}
	if (TclpCloseFile(pipePtr->writeFile) != 0) {
	    if (errorCode == 0) {
		errorCode = errno;
	    }
	}
2081
2082
2083
2084
2085
2086
2087
2088

2089
2090
2091
2092
2093
2094
2095
2127
2128
2129
2130
2131
2132
2133

2134
2135
2136
2137
2138
2139
2140
2141







-
+







	    nextPtrPtr = &infoPtr->nextPtr, infoPtr = *nextPtrPtr) {
	if (infoPtr == (PipeInfo *)pipePtr) {
	    *nextPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }

    if ((pipePtr->flags & PIPE_ASYNC) || inExit) {
    if ((pipePtr->flags & PIPE_ASYNC) || TclInExit()) {
	/*
	 * If the channel is non-blocking or Tcl is being cleaned up, just
	 * detach the children PIDs, reap them (important if we are in a
	 * dynamic load module), and discard the errorFile.
	 */

	Tcl_DetachPids(pipePtr->numPids, pipePtr->pidPtr);
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
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







-
+

+


-
+









-
+



-
+


-
+







    } else {
	/*
	 * Wrap the error file into a channel and give it to the cleanup
	 * routine.
	 */

	if (pipePtr->errorFile) {
	    WinFile *filePtr = (WinFile *) pipePtr->errorFile;
	    WinFile *filePtr;

	    filePtr = (WinFile*)pipePtr->errorFile;
	    errChan = Tcl_MakeFileChannel((ClientData) filePtr->handle,
		    TCL_READABLE);
	    Tcl_Free(filePtr);
	    ckfree((char *) filePtr);
	} else {
	    errChan = NULL;
	}

	result = TclCleanupChildren(interp, pipePtr->numPids,
		pipePtr->pidPtr, errChan);
    }

    if (pipePtr->numPids > 0) {
	Tcl_Free(pipePtr->pidPtr);
	ckfree((char *) pipePtr->pidPtr);
    }

    if (pipePtr->writeBuf != NULL) {
	Tcl_Free(pipePtr->writeBuf);
	ckfree(pipePtr->writeBuf);
    }

    Tcl_Free(pipePtr);
    ckfree((char*) pipePtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

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
2306
2307
2308
2309
2310
2311
2312



2313


2314
2315
2316
2317
2318
2319

2320
2321
2322
2323
2324
2325
2326
2327







-
-
-
+
-
-






-
+







    int *errorCode)		/* Where to store error code. */
{
    PipeInfo *infoPtr = (PipeInfo *) instanceData;
    WinFile *filePtr = (WinFile*) infoPtr->writeFile;
    DWORD bytesWritten, timeout;

    *errorCode = 0;

    /* avoid blocking if pipe-thread exited */
    timeout = ((infoPtr->flags & PIPE_ASYNC)
    timeout = (infoPtr->flags & PIPE_ASYNC) ? 0 : INFINITE;
	    || !TclPipeThreadIsAlive(&infoPtr->writeTI)
	    || TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
    if (WaitForSingleObject(infoPtr->writable, timeout) == WAIT_TIMEOUT) {
	/*
	 * The writer thread is blocked waiting for a write to complete and
	 * the channel is in non-blocking mode.
	 */

	errno = EWOULDBLOCK;
	errno = EAGAIN;
	goto error;
    }

    /*
     * Check for a background error on the last write.
     */

2296
2297
2298
2299
2300
2301
2302
2303

2304
2305
2306

2307
2308

2309
2310
2311

2312
2313
2314
2315
2316
2317
2318
2339
2340
2341
2342
2343
2344
2345

2346
2347
2348

2349
2350

2351
2352
2353

2354
2355
2356
2357
2358
2359
2360
2361







-
+


-
+

-
+


-
+








	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
	    infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->writable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	SetEvent(infoPtr->startWriter);
	bytesWritten = toWrite;
    } else {
	/*
	 * In the blocking case, just try to write the buffer directly. This
	 * avoids an unnecessary copy.
	 */

2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2492
2493
2494
2495
2496
2497
2498

2499
2500
2501
2502
2503
2504
2505







-







     * Since most of the work is handled by the background threads, we just
     * need to update the watchMask and then force the notifier to poll once.
     */

    infoPtr->watchMask = mask & infoPtr->validMask;
    if (infoPtr->watchMask) {
	Tcl_Time blockTime = { 0, 0 };

	if (!oldMask) {
	    infoPtr->nextPtr = tsdPtr->firstPipePtr;
	    tsdPtr->firstPipePtr = infoPtr;
	}
	Tcl_SetMaxBlockTime(&blockTime);
    } else {
	if (oldMask) {
2561
2562
2563
2564
2565
2566
2567
2568

2569
2570
2571
2572
2573
2574
2575
2603
2604
2605
2606
2607
2608
2609

2610
2611
2612
2613
2614
2615
2616
2617







-
+







     * Find the process and cut it from the process list.
     */

    Tcl_MutexLock(&pipeMutex);
    prevPtrPtr = &procList;
    for (infoPtr = procList; infoPtr != NULL;
	    prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
	 if (infoPtr->dwProcessId == (size_t) pid) {
	 if (infoPtr->hProcess == (HANDLE) pid) {
	    *prevPtrPtr = infoPtr->nextPtr;
	    break;
	}
    }
    Tcl_MutexUnlock(&pipeMutex);

    /*
2679
2680
2681
2682
2683
2684
2685
2686

2687
2688
2689
2690
2691
2692
2693
2721
2722
2723
2724
2725
2726
2727

2728
2729
2730
2731
2732
2733
2734
2735







-
+







    }

    /*
     * Officially close the process handle.
     */

    CloseHandle(infoPtr->hProcess);
    Tcl_Free(infoPtr);
    ckfree((char*)infoPtr);

    return result;
}

/*
 *----------------------------------------------------------------------
 *
2705
2706
2707
2708
2709
2710
2711
2712

2713
2714

2715
2716
2717
2718
2719
2720
2721
2747
2748
2749
2750
2751
2752
2753

2754
2755

2756
2757
2758
2759
2760
2761
2762
2763







-
+

-
+







 *
 *----------------------------------------------------------------------
 */

void
TclWinAddProcess(
    void *hProcess,		/* Handle to process */
    size_t id)		/* Global process identifier */
    unsigned long id)	/* Global process identifier */
{
    ProcInfo *procPtr = (ProcInfo*)Tcl_Alloc(sizeof(ProcInfo));
    ProcInfo *procPtr = (ProcInfo *) ckalloc(sizeof(ProcInfo));

    PipeInit();

    procPtr->hProcess = hProcess;
    procPtr->dwProcessId = id;
    Tcl_MutexLock(&pipeMutex);
    procPtr->nextPtr = procList;
2738
2739
2740
2741
2742
2743
2744
2745

2746
2747
2748
2749
2750
2751
2752
2753
2754

2755
2756
2757
2758
2759
2760

2761

2762
2763

2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774

2775

2776
2777

2778
2779
2780
2781
2782
2783
2784
2785
2780
2781
2782
2783
2784
2785
2786

2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804

2805
2806

2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817

2818
2819
2820
2821

2822

2823
2824
2825
2826
2827
2828
2829







-
+









+






+
-
+

-
+










-
+

+

-
+
-







 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_PidObjCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const *objv)	/* Argument strings. */
{
    Tcl_Channel chan;
    const Tcl_ChannelType *chanTypePtr;
    PipeInfo *pipePtr;
    int i;
    Tcl_Obj *resultPtr;
    char buf[TCL_INTEGER_SPACE];

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?channelId?");
	return TCL_ERROR;
    }
    if (objc == 1) {
	wsprintfA(buf, "%lu", (unsigned long) getpid());
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj((unsigned) getpid()));
	Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1));
    } else {
	chan = Tcl_GetChannel(interp, TclGetString(objv[1]),
	chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
		NULL);
	if (chan == (Tcl_Channel) NULL) {
	    return TCL_ERROR;
	}
	chanTypePtr = Tcl_GetChannelType(chan);
	if (chanTypePtr != &pipeChannelType) {
	    return TCL_OK;
	}

	pipePtr = (PipeInfo *) Tcl_GetChannelInstanceData(chan);
	TclNewObj(resultPtr);
	resultPtr = Tcl_NewObj();
	for (i = 0; i < pipePtr->numPids; i++) {
	    wsprintfA(buf, "%lu", TclpGetPid(pipePtr->pidPtr[i]));
	    Tcl_ListObjAppendElement(/*interp*/ NULL, resultPtr,
		    Tcl_NewWideIntObj((unsigned)
		    Tcl_NewStringObj(buf, -1));
			    TclpGetPid(pipePtr->pidPtr[i])));
	}
	Tcl_SetObjResult(interp, resultPtr);
    }
    return TCL_OK;
}

/*
2807
2808
2809
2810
2811
2812
2813
2814

2815
2816
2817
2818
2819
2820
2821

2822
2823
2824
2825
2826
2827
2828
2829
2830

2831
2832
2833
2834
2835
2836
2837
2851
2852
2853
2854
2855
2856
2857

2858
2859
2860
2861
2862
2863
2864

2865


2866
2867
2868
2869
2870
2871

2872
2873
2874
2875
2876
2877
2878
2879







-
+






-
+
-
-






-
+







static int
WaitForRead(
    PipeInfo *infoPtr,		/* Pipe state. */
    int blocking)		/* Indicates whether call should be blocking
				 * or not. */
{
    DWORD timeout, count;
    HANDLE *handle = (HANDLE *)((WinFile *) infoPtr->readFile)->handle;
    HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;

    while (1) {
	/*
	 * Synchronize with the reader thread.
	 */

	/* avoid blocking if pipe-thread exited */
	timeout = blocking ? INFINITE : 0;
	timeout = (!blocking || !TclPipeThreadIsAlive(&infoPtr->readTI)
		|| TclInExit() || TclInThreadExit()) ? 0 : INFINITE;
	if (WaitForSingleObject(infoPtr->readable, timeout) == WAIT_TIMEOUT) {
	    /*
	     * The reader thread is blocked waiting for data and the channel
	     * is in non-blocking mode.
	     */

	    errno = EWOULDBLOCK;
	    errno = EAGAIN;
	    return -1;
	}

	/*
	 * At this point, the two threads are synchronized, so it is safe to
	 * access shared state.
	 */
2890
2891
2892
2893
2894
2895
2896
2897

2898
2899
2900
2901
2902
2903
2904
2932
2933
2934
2935
2936
2937
2938

2939
2940
2941
2942
2943
2944
2945
2946







-
+







	}

	/*
	 * There wasn't any data available, so reset the thread and try again.
	 */

	ResetEvent(infoPtr->readable);
	TclPipeThreadSignal(&infoPtr->readTI);
	SetEvent(infoPtr->startReader);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * PipeReaderThread --
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
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







-
-
-
+
+


+
+
+
+
+







-
+
-
-
-
+
+
+
+
+
+

-
-
-
+







 *----------------------------------------------------------------------
 */

static DWORD WINAPI
PipeReaderThread(
    LPVOID arg)
{
    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *) arg;
    PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
    HANDLE handle = NULL;
    PipeInfo *infoPtr = (PipeInfo *)arg;
    HANDLE *handle = ((WinFile *) infoPtr->readFile)->handle;
    DWORD count, err;
    int done = 0;
    HANDLE wEvents[2];
    DWORD waitResult;

    wEvents[0] = infoPtr->stopReader;
    wEvents[1] = infoPtr->startReader;

    while (!done) {
	/*
	 * Wait for the main thread to signal before attempting to wait on the
	 * pipe becoming readable.
	 */

	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);
	    /* exit */
	    break;
	}

	if (waitResult != (WAIT_OBJECT_0 + 1)) {
	    /*
	     * The start event was not signaled. It might be the stop event or
	     * an error, so exit.
	     */

	if (!infoPtr) {
	    infoPtr = (PipeInfo *) pipeTI->clientData;
	    handle = ((WinFile *) infoPtr->readFile)->handle;
	    break;
	}

	/*
	 * Try waiting for 0 bytes. This will block until some data is
	 * available on NT, but will return immediately on Win 95. So, if no
	 * data is available after the first read, we block until we can read
	 * a single byte off of the pipe.
2959
2960
2961
2962
2963
2964
2965
2966

2967
2968
2969
2970
2971
2972
2973
3006
3007
3008
3009
3010
3011
3012

3013
3014
3015
3016
3017
3018
3019
3020







-
+







	     */

	    err = GetLastError();
	    if (err == ERROR_BROKEN_PIPE) {
		infoPtr->readFlags |= PIPE_EOF;
		done = 1;
	    } else if (err == ERROR_INVALID_HANDLE) {
		done = 1;
		break;
	    }
	} else if (count == 0) {
	    if (ReadFile(handle, &(infoPtr->extraByte), 1, &count, NULL)
		    != FALSE) {
		/*
		 * One byte was consumed as a side effect of waiting for the
		 * pipe to become readable.
2981
2982
2983
2984
2985
2986
2987
2988

2989
2990
2991

2992
2993
2994
2995
2996
2997
2998
3028
3029
3030
3031
3032
3033
3034

3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046







-
+



+







		     * The error is a result of an EOF condition, so set the
		     * EOF bit before signalling the main thread.
		     */

		    infoPtr->readFlags |= PIPE_EOF;
		    done = 1;
		} else if (err == ERROR_INVALID_HANDLE) {
		    done = 1;
		    break;
		}
	    }
	}


	/*
	 * Signal the main thread by signalling the readable event and then
	 * waking up the notifier thread.
	 */

	SetEvent(infoPtr->readable);
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3059
3060
3061
3062
3063
3064
3065






3066
3067
3068
3069
3070
3071
3072







-
-
-
-
-
-







	     */

	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&pipeMutex);
    }

    /*
     * If state of thread was set to stop, we can sane free info structure,
     * otherwise it is shared with main thread, so main thread will own it
     */
    TclPipeThreadExit(&pipeTI);

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * PipeWriterThread --
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
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







-
-
-
+
+



+
+
+
+
+





-
-
-
-
+
+

-
-
-
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

static DWORD WINAPI
PipeWriterThread(
    LPVOID arg)
{
    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
    PipeInfo *infoPtr = NULL; /* access info only after success init/wait */
    HANDLE handle = NULL;
    PipeInfo *infoPtr = (PipeInfo *)arg;
    HANDLE *handle = ((WinFile *) infoPtr->writeFile)->handle;
    DWORD count, toWrite;
    char *buf;
    int done = 0;
    HANDLE wEvents[2];
    DWORD waitResult;

    wEvents[0] = infoPtr->stopWriter;
    wEvents[1] = infoPtr->startWriter;

    while (!done) {
	/*
	 * Wait for the main thread to signal before attempting to write.
	 */
	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
	    /* exit */
	    break;
	}

	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);

	if (!infoPtr) {
	    infoPtr = (PipeInfo *)pipeTI->clientData;
	    handle = ((WinFile *) infoPtr->writeFile)->handle;
	if (waitResult != (WAIT_OBJECT_0 + 1)) {
	    /*
	     * The start event was not signaled. It might be the stop event or
	     * an error, so exit.
	     */

	    break;
	}

	buf = infoPtr->writeBuf;
	toWrite = infoPtr->toWrite;

	/*
	 * Loop until all of the bytes are written or an error occurs.
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3153
3154
3155
3156
3157
3158
3159






3160
3161
3162
3163
3164
3165
3166







-
-
-
-
-
-







	     */

	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&pipeMutex);
    }

    /*
     * If state of thread was set to stop, we can sane free info structure,
     * otherwise it is shared with main thread, so main thread will own it.
     */
    TclPipeThreadExit(&pipeTI);

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * PipeThreadActionProc --
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
3205
3206
3207
3208
3209
3210
3211




























































































































































































































































































































































































































































































































































3212
3213
3214
3215
3216
3217
3218
3219







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	    infoPtr->threadId = Tcl_GetChannelThread(infoPtr->channel);
	}
    } else {
	infoPtr->threadId = NULL;
    }
    Tcl_MutexUnlock(&pipeMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpOpenTemporaryFile --
 *
 *	Creates a temporary file, possibly based on the supplied bits and
 *	pieces of template supplied in the first three arguments. If the
 *	fourth argument is non-NULL, it contains a Tcl_Obj to store the name
 *	of the temporary file in (and it is caller's responsibility to clean
 *	up). If the fourth argument is NULL, try to arrange for the temporary
 *	file to go away once it is no longer needed.
 *
 * Results:
 *	A read-write Tcl Channel open on the file.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
TclpOpenTemporaryFile(
    TCL_UNUSED(Tcl_Obj *) /*dirObj*/,
    Tcl_Obj *basenameObj,
    TCL_UNUSED(Tcl_Obj *) /*extensionObj*/,
    Tcl_Obj *resultingNameObj)
{
    WCHAR name[MAX_PATH];
    char *namePtr;
    HANDLE handle;
    DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
    size_t length;
    int counter, counter2;
    Tcl_DString buf;

    if (!resultingNameObj) {
	flags |= FILE_FLAG_DELETE_ON_CLOSE;
    }

    namePtr = (char *) name;
    length = GetTempPathW(MAX_PATH, name);
    if (length == 0) {
	goto gotError;
    }
    namePtr += length * sizeof(WCHAR);
    if (basenameObj) {
	const char *string = TclGetStringFromObj(basenameObj, &length);

	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(string, length, &buf);
	memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf));
	namePtr += Tcl_DStringLength(&buf);
	Tcl_DStringFree(&buf);
    } else {
	const WCHAR *baseStr = L"TCL";
	length = 3 * sizeof(WCHAR);

	memcpy(namePtr, baseStr, length);
	namePtr += length;
    }
    counter = TclpGetClicks() % 65533;
    counter2 = 1024;			/* Only try this many times! Prevents
					 * an infinite loop. */

    do {
	char number[TCL_INTEGER_SPACE + 4];

	sprintf(number, "%d.TMP", counter);
	counter = (unsigned short) (counter + 1);
	Tcl_DStringInit(&buf);
	Tcl_UtfToWCharDString(number, strlen(number), &buf);
	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf) + 1);
	memcpy(namePtr, Tcl_DStringValue(&buf), Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);

	handle = CreateFileW(name,
		GENERIC_READ|GENERIC_WRITE, 0, NULL, CREATE_NEW, flags, NULL);
    } while (handle == INVALID_HANDLE_VALUE
	    && --counter2 > 0
	    && GetLastError() == ERROR_FILE_EXISTS);
    if (handle == INVALID_HANDLE_VALUE) {
	goto gotError;
    }

    if (resultingNameObj) {
	Tcl_Obj *tmpObj = TclpNativeToNormalized(name);

	Tcl_AppendObjToObj(resultingNameObj, tmpObj);
	TclDecrRefCount(tmpObj);
    }

    return Tcl_MakeFileChannel((ClientData) handle,
	    TCL_READABLE|TCL_WRITABLE);

  gotError:
    TclWinConvertError(GetLastError());
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadCreateTI --
 *
 *	Creates a thread info structure, can be owned by worker.
 *
 * Results:
 *	Pointer to created TI structure.
 *
 *----------------------------------------------------------------------
 */

TclPipeThreadInfo *
TclPipeThreadCreateTI(
    TclPipeThreadInfo **pipeTIPtr,
    ClientData clientData,
    HANDLE wakeEvent)
{
    TclPipeThreadInfo *pipeTI;
#ifndef _PTI_USE_CKALLOC
    pipeTI = (TclPipeThreadInfo *)malloc(sizeof(TclPipeThreadInfo));
#else
    pipeTI = (TclPipeThreadInfo *)Tcl_Alloc(sizeof(TclPipeThreadInfo));
#endif /* !_PTI_USE_CKALLOC */
    pipeTI->evControl = CreateEventW(NULL, FALSE, FALSE, NULL);
    pipeTI->state = PTI_STATE_IDLE;
    pipeTI->clientData = clientData;
    pipeTI->evWakeUp = wakeEvent;
    return (*pipeTIPtr = pipeTI);
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadWaitForSignal --
 *
 *	Wait for work/stop signals inside pipe worker.
 *
 * Results:
 *	1 if signaled to work, 0 if signaled to stop.
 *
 * Side effects:
 *	If this function returns 0, TI-structure pointer given via pipeTIPtr
 *	may be NULL, so not accessible (can be owned by main thread).
 *
 *----------------------------------------------------------------------
 */

int
TclPipeThreadWaitForSignal(
    TclPipeThreadInfo **pipeTIPtr)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
    LONG state;
    DWORD waitResult;
    HANDLE wakeEvent;

    if (!pipeTI) {
	return 0;
    }

    wakeEvent = pipeTI->evWakeUp;

    /*
     * Wait for the main thread to signal before attempting to do the work.
     */

    /*
     * Reset work state of thread (idle/waiting)
     */

    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_IDLE,
	    PTI_STATE_WORK);
    if (state & (PTI_STATE_STOP|PTI_STATE_END)) {
	/*
	 * End of work, check the owner of structure.
	 */

	goto end;
    }

    /*
     * Entering wait
     */

    waitResult = WaitForSingleObject(pipeTI->evControl, INFINITE);
    if (waitResult != WAIT_OBJECT_0) {
	/*
	 * The control event was not signaled, so end of work (unexpected
	 * behaviour, main thread can be dead?).
	 */

	goto end;
    }

    /*
     * Try to set work state of thread
     */

    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_WORK,
	    PTI_STATE_IDLE);
    if (state & (PTI_STATE_STOP|PTI_STATE_END)) {
	/*
	 * End of work
	 */

	goto end;
    }

    /*
     * Signaled to work.
     */

    return 1;

  end:
    /*
     * End of work, check the owner of the TI structure.
     */

    if (state != PTI_STATE_STOP) {
	*pipeTIPtr = NULL;
    } else {
    	pipeTI->evWakeUp = NULL;
    }
    if (wakeEvent) {
    	SetEvent(wakeEvent);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadStopSignal --
 *
 *	Send stop signal to the pipe worker (without waiting).
 *
 *	After calling of this function, TI-structure pointer given via pipeTIPtr
 *	may be NULL.
 *
 * Results:
 *	1 if signaled (or pipe-thread is down), 0 if pipe thread still working.
 *
 *----------------------------------------------------------------------
 */

int
TclPipeThreadStopSignal(
    TclPipeThreadInfo **pipeTIPtr,
    HANDLE wakeEvent)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
    HANDLE evControl;
    int state;

    if (!pipeTI) {
	return 1;
    }
    evControl = pipeTI->evControl;
    pipeTI->evWakeUp = wakeEvent;
    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
	    PTI_STATE_IDLE);
    switch (state) {
    case PTI_STATE_IDLE:
	/*
	 * Thread was idle/waiting, notify it goes teardown
	 */

	SetEvent(evControl);
	*pipeTIPtr = NULL;
	/* FALLTHRU */
    case PTI_STATE_DOWN:
	return 1;

    default:
	/*
	 * Thread works currently, we should try to end it, own the TI
	 * structure (because of possible sharing the joint structures with
	 * thread)
	 */

	InterlockedExchange(&pipeTI->state, PTI_STATE_END);
	break;
    }

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadStop --
 *
 *	Send stop signal to the pipe worker and wait for thread completion.
 *
 *	May be combined with TclPipeThreadStopSignal.
 *
 *	After calling of this function, TI-structure pointer given via pipeTIPtr
 *	is not accessible (owned by pipe worker or released here).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Can terminate pipe worker (and / or stop its synchronous operations).
 *
 *----------------------------------------------------------------------
 */

void
TclPipeThreadStop(
    TclPipeThreadInfo **pipeTIPtr,
    HANDLE hThread)
{
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;
    HANDLE evControl;
    int state;

    if (!pipeTI) {
	return;
    }
    pipeTI = *pipeTIPtr;
    evControl = pipeTI->evControl;
    pipeTI->evWakeUp = NULL;

    /*
     * Try to sane stop the pipe worker, corresponding its current state
     */

    state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_STOP,
	    PTI_STATE_IDLE);
    switch (state) {
    case PTI_STATE_IDLE:
	/*
	 * Thread was idle/waiting, notify it goes teardown
	 */

	SetEvent(evControl);

	/*
	 * We don't need to wait for it at all, thread frees himself (owns the
	 * TI structure)
	 */

	pipeTI = NULL;
	break;

    case PTI_STATE_STOP:
	/*
	 * Already stopped, thread frees himself (owns the TI structure)
	 */

	pipeTI = NULL;
	break;
    case PTI_STATE_DOWN:
	/*
	 * Thread already down (?), do nothing
	 */

	/*
	 * We don't need to wait for it, but we should free pipeTI
	 */
	hThread = NULL;
	break;

	/* case PTI_STATE_WORK: */
    default:
	/*
	 * Thread works currently, we should try to end it, own the TI
	 * structure (because of possible sharing the joint structures with
	 * thread)
	 */

	state = InterlockedCompareExchange(&pipeTI->state, PTI_STATE_END,
		PTI_STATE_WORK);
	if (state == PTI_STATE_DOWN) {
	    /*
	     * We don't need to wait for it, but we should free pipeTI
	     */
	    hThread = NULL;
	}
	break;
    }

    if (pipeTI && hThread) {
	DWORD exitCode;

	/*
	 * The thread may already have closed on its own. Check its exit
	 * code.
	 */

	GetExitCodeThread(hThread, &exitCode);

	if (exitCode == STILL_ACTIVE) {
	    int inExit = (TclInExit() || TclInThreadExit());

	    /*
	     * Set the stop event so that if the pipe thread is blocked
	     * somewhere, it may hereafter sane exit cleanly.
	     */

	    SetEvent(evControl);

	    /*
	     * Cancel all sync-IO of this thread (may be blocked there).
	     */

	    if (tclWinProcs.cancelSynchronousIo) {
		tclWinProcs.cancelSynchronousIo(hThread);
	    }

	    /*
	     * Wait at most 20 milliseconds for the reader thread to close
	     * (regarding TIP#398-fast-exit).
	     */

	    /*
	     * If we want TIP#398-fast-exit.
	     */

	    if (WaitForSingleObject(hThread, inExit ? 0 : 20) == WAIT_TIMEOUT) {
		/*
		 * The thread must be blocked waiting for the pipe to become
		 * readable in ReadFile(). There isn't a clean way to exit the
		 * thread from this condition. We should terminate the child
		 * process instead to get the reader thread to fall out of
		 * ReadFile with a FALSE. (below) is not the correct way to do
		 * this, but will stay here until a better solution is found.
		 *
		 * Note that we need to guard against terminating the thread
		 * while it is in the middle of Tcl_ThreadAlert because it
		 * won't be able to release the notifier lock.
		 *
		 * Also note that terminating threads during their
		 * initialization or teardown phase may result in ntdll.dll's
		 * LoaderLock to remain locked indefinitely.  This causes
		 * ntdll.dll's LdrpInitializeThread() to deadlock trying to
		 * acquire LoaderLock.  LdrpInitializeThread() is executed
		 * within new threads to perform initialization and to execute
		 * DllMain() of all loaded dlls.  As a result, all new threads
		 * are deadlocked in their initialization phase and never
		 * execute, even though CreateThread() reports successful
		 * thread creation.  This results in a very weird process-wide
		 * behavior, which is extremely hard to debug.
		 *
		 * THREADS SHOULD NEVER BE TERMINATED. Period.
		 *
		 * But for now, check if thread is exiting, and if so, let it
		 * die peacefully.
		 *
		 * Also don't terminate if in exit (otherwise deadlocked in
		 * ntdll.dll's).
		 */

		if (pipeTI->state != PTI_STATE_DOWN
			&& WaitForSingleObject(hThread,
				inExit ? 50 : 5000) != WAIT_OBJECT_0) {
		    /* BUG: this leaks memory */
		    if (inExit || !TerminateThread(hThread, 0)) {
			/*
			 * in exit or terminate fails, just give thread a
			 * chance to exit
			 */

			if (InterlockedExchange(&pipeTI->state,
				PTI_STATE_STOP) != PTI_STATE_DOWN) {
			    pipeTI = NULL;
			}
		    }
		}
	    }
	}
    }

    *pipeTIPtr = NULL;
    if (pipeTI) {
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
	CloseHandle(pipeTI->evControl);
#ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#else
	Tcl_Free(pipeTI);
#endif /* !_PTI_USE_CKALLOC */
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclPipeThreadExit --
 *
 *	Clean-up for the pipe thread (removes owned TI-structure in worker).
 *
 *	Should be executed on worker exit, to inform the main thread or
 *	free TI-structure (if owned).
 *
 *	After calling of this function, TI-structure pointer given via pipeTIPtr
 *	is not accessible (owned by main thread or released here).
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
TclPipeThreadExit(
    TclPipeThreadInfo **pipeTIPtr)
{
    LONG state;
    TclPipeThreadInfo *pipeTI = *pipeTIPtr;

    /*
     * If state of thread was set to stop (exactly), we can sane free its info
     * structure, otherwise it is shared with main thread, so main thread will
     * own it.
     */

    if (!pipeTI) {
	return;
    }
    *pipeTIPtr = NULL;
    state = InterlockedExchange(&pipeTI->state, PTI_STATE_DOWN);
    if (state == PTI_STATE_STOP) {
	CloseHandle(pipeTI->evControl);
	if (pipeTI->evWakeUp) {
	    SetEvent(pipeTI->evWakeUp);
	}
#ifndef _PTI_USE_CKALLOC
	free(pipeTI);
#else
	Tcl_Free(pipeTI);
	/* be sure all subsystems used are finalized */
	Tcl_FinalizeThread();
#endif /* !_PTI_USE_CKALLOC */
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinPort.h.

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
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







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


















-
-
-
-

-
-
+
-
-
-
+
+
+
-
-
+

-
-
-
-
-
+
+









-
-
+
+
+






+
-
+



-
-
-
-
-







#ifndef _TCLWINPORT
#define _TCLWINPORT

#if !defined(_WIN64) && !defined(__MINGW_USE_VC2005_COMPAT)
/* See [Bug 3354324]: file mtime sets wrong time */
#   define __MINGW_USE_VC2005_COMPAT
#endif
#if defined(_MSC_VER) && defined(_WIN64) && !defined(STATIC_BUILD) \
	&& !defined(MP_32BIT) && !defined(MP_64BIT)
#   define MP_64BIT
#endif

/*
 * We must specify the lower version we intend to support.
 *
 * WINVER = 0x0501 means Windows XP and above
 */

#ifndef WINVER
#   define WINVER 0x0501
#endif
#ifndef _WIN32_WINNT
#   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.
 */
#ifndef INCL_WINSOCK_API_TYPEDEFS
#   define INCL_WINSOCK_API_TYPEDEFS   1
#endif
#include <winsock2.h>
#include <ws2tcpip.h>
#ifdef HAVE_WSPIAPI_H
#   include <wspiapi.h>
#endif

/*
 *  Pull in the typedef of TCHAR for windows.
#ifdef CHECK_UNICODE_CALLS
 */
#include <tchar.h>
#ifndef _TCHAR_DEFINED
#   define _UNICODE
#   define UNICODE
#   define __TCHAR_DEFINED
    /* Borland seems to forget to set this. */
    typedef _TCHAR TCHAR;
    typedef float *_TCHAR;
#   define _TCHAR_DEFINED
#endif
#if defined(_MSC_VER) && defined(__STDC__)
    /* VS2005 SP1 misses this. See [Bug #3110161] */
    typedef _TCHAR TCHAR;
#endif
    typedef float *TCHAR;
#endif /* CHECK_UNICODE_CALLS */

/*
 *---------------------------------------------------------------------------
 * The following sets of #includes and #ifdefs are required to get Tcl to
 * compile under the windows compilers.
 *---------------------------------------------------------------------------
 */

#include <time.h>
#include <wchar.h>
#include <io.h>
#include <io.h>
#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <fcntl.h>
#include <float.h>
#include <malloc.h>
#include <process.h>
#include <signal.h>
#include <string.h>
#ifdef HAVE_INTTYPES_H
#if HAVE_INTTYPES_H
#   include <inttypes.h>
#endif
#include <limits.h>
#ifdef HAVE_STDINT_H
#   include <stdint.h>
#else
#   include "../compat/stdint.h"
#endif

#ifndef __GNUC__
#    define strncasecmp _strnicmp
#    define strcasecmp _stricmp
#endif

/*
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
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-
-
-
+
+
-

+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-







#   ifdef __BORLANDC__
#	include <utime.h>
#   else
#	include <sys/utime.h>
#   endif /* __BORLANDC__ */
#endif /* __MWERKS__ */

/*
 * Define EINPROGRESS in terms of WSAEINPROGRESS.
 */

#undef	EINPROGRESS
#define EINPROGRESS	WSAEINPROGRESS

/*
 * Define ENOTSUP to a value that will never occur.
 */

#undef ENOTSUP
#define ENOTSUP	-1030507

/* Those codes, from Visual Studio 2010, conflict with other values */
#undef ENODATA
#undef ENOMSG
#undef ENOSR
#undef ENOSTR
#undef EPROTO

/*
 * 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 */
#endif
#ifndef EREMOTE
#   define EREMOTE	66	/* The object is remote */
#undef EWOULDBLOCK
#define EWOULDBLOCK	EAGAIN
#endif
#ifndef EPFNOSUPPORT
#   define EPFNOSUPPORT	96	/* Protocol family not supported */
#endif
#ifndef EADDRINUSE
#   define EADDRINUSE	100	/* Address already in use */
#endif
#ifndef EADDRNOTAVAIL
#   define EADDRNOTAVAIL 101	/* Can't assign requested address */
#endif
#ifndef EAFNOSUPPORT
#   define EAFNOSUPPORT	102	/* Address family not supported */
#endif
#ifndef EALREADY
#   define EALREADY	103	/* Operation already in progress */
#undef EALREADY
#define EALREADY	149	/* operation already in progress */
#endif
#ifndef EBADMSG
#   define EBADMSG	104	/* Not a data message */
#undef ENOTSOCK
#define ENOTSOCK	95	/* Socket operation on non-socket */
#endif
#ifndef ECANCELED
#   define ECANCELED	105	/* Canceled */
#undef EDESTADDRREQ
#define EDESTADDRREQ	96	/* Destination address required */
#endif
#ifndef ECONNABORTED
#   define ECONNABORTED	106	/* Software caused connection abort */
#undef EMSGSIZE
#define EMSGSIZE	97	/* Message too long */
#endif
#ifndef ECONNREFUSED
#   define ECONNREFUSED	107	/* Connection refused */
#undef EPROTOTYPE
#define EPROTOTYPE	98	/* Protocol wrong type for socket */
#endif
#ifndef ECONNRESET
#   define ECONNRESET	108	/* Connection reset by peer */
#undef ENOPROTOOPT
#define ENOPROTOOPT	99	/* Protocol not available */
#endif
#ifndef EDESTADDRREQ
#   define EDESTADDRREQ	109	/* Destination address required */
#endif
#ifndef EHOSTUNREACH
#   define EHOSTUNREACH	110	/* No route to host */
#undef EPROTONOSUPPORT
#define EPROTONOSUPPORT 120	/* Protocol not supported */
#undef ESOCKTNOSUPPORT
#define ESOCKTNOSUPPORT 121	/* Socket type not supported */
#undef EOPNOTSUPP
#define EOPNOTSUPP	122	/* Operation not supported on socket */
#endif
#ifndef EIDRM
#   define EIDRM	111	/* Identifier removed */
#undef EPFNOSUPPORT
#define EPFNOSUPPORT	123	/* Protocol family not supported */
#endif
#ifndef EINPROGRESS
#   define EINPROGRESS	112	/* Operation now in progress */
#endif
#ifndef EISCONN
#   define EISCONN	113	/* Socket is already connected */
#undef EAFNOSUPPORT
#define EAFNOSUPPORT	124	/* Address family not supported */
#endif
#ifndef ELOOP
#   define ELOOP	114	/* Symbolic link loop */
#undef EADDRINUSE
#define EADDRINUSE	125	/* Address already in use */
#endif
#ifndef EMSGSIZE
#   define EMSGSIZE	115	/* Message too long */
#undef EADDRNOTAVAIL
#define EADDRNOTAVAIL 126	/* Can't assign requested address */
#endif
#ifndef ENETDOWN
#   define ENETDOWN	116	/* Network is down */
#undef ENETDOWN
#define ENETDOWN	127	/* Network is down */
#endif
#ifndef ENETRESET
#   define ENETRESET	117	/* Network dropped connection on reset */
#endif
#ifndef ENETUNREACH
#   define ENETUNREACH	118	/* Network is unreachable */
#undef ENETUNREACH
#define ENETUNREACH	128	/* Network is unreachable */
#endif
#ifndef ENOBUFS
#   define ENOBUFS	119	/* No buffer space available */
#undef ENETRESET
#define ENETRESET	129	/* Network dropped connection on reset */
#endif
#ifndef ENODATA
#   define ENODATA	120	/* No data available */
#undef ECONNABORTED
#define ECONNABORTED	130	/* Software caused connection abort */
#endif
#ifndef ENOLINK
#   define ENOLINK	121	/* Link has be severed */
#endif
#ifndef ENOMSG
#   define ENOMSG	122	/* No message of desired type */
#undef ECONNRESET
#define ECONNRESET	131	/* Connection reset by peer */
#endif
#ifndef ENOPROTOOPT
#   define ENOPROTOOPT	123	/* Protocol not available */
#endif
#ifndef ENOSR
#   define ENOSR	124	/* Out of stream resources */
#undef ENOBUFS
#define ENOBUFS	132	/* No buffer space available */
#endif
#ifndef ENOSTR
#   define ENOSTR	125	/* Not a stream device */
#undef EISCONN
#define EISCONN	133	/* Socket is already connected */
#endif
#ifndef ENOTCONN
#   define ENOTCONN	126	/* Socket is not connected */
#undef ENOTCONN
#define ENOTCONN	134	/* Socket is not connected */
#endif
#ifndef ENOTRECOVERABLE
#   define ENOTRECOVERABLE	127	/* Not recoverable */
#undef ESHUTDOWN
#define ESHUTDOWN	143	/* Can't send after socket shutdown */
#endif
#ifndef ENOTSOCK
#   define ENOTSOCK	128	/* Socket operation on non-socket */
#undef ETOOMANYREFS
#define ETOOMANYREFS	144	/* Too many references: can't splice */
#endif
#ifndef ENOTSUP
#   define ENOTSUP	129	/* Operation not supported */
#undef ETIMEDOUT
#define ETIMEDOUT	145	/* Connection timed out */
#endif
#ifndef EOPNOTSUPP
#   define EOPNOTSUPP	130	/* Operation not supported on socket */
#endif
#ifndef EOTHER
#   define EOTHER	131	/* Other error */
#undef ECONNREFUSED
#define ECONNREFUSED	146	/* Connection refused */
#endif
#ifndef EOVERFLOW
#   define EOVERFLOW	132	/* File too big */
#undef ELOOP
#define ELOOP	90	/* Symbolic link loop */
#endif
#ifndef EOWNERDEAD
#   define EOWNERDEAD	133	/* Owner dead */
#undef EHOSTDOWN
#define EHOSTDOWN	147	/* Host is down */
#endif
#ifndef EPROTO
#   define EPROTO	134	/* Protocol error */
#undef EHOSTUNREACH
#define EHOSTUNREACH	148	/* No route to host */
#endif
#ifndef EPROTONOSUPPORT
#   define EPROTONOSUPPORT 135	/* Protocol not supported */
#endif
#ifndef EPROTOTYPE
#   define EPROTOTYPE	136	/* Protocol wrong type for socket */
#undef ENOTEMPTY
#define ENOTEMPTY 	93	/* directory not empty */
#endif
#ifndef ETIME
#   define ETIME	137	/* Timer expired */
#undef EUSERS
#define EUSERS	94	/* Too many users (for UFS) */
#endif
#ifndef ETIMEDOUT
#   define ETIMEDOUT	138	/* Connection timed out */
#undef EDQUOT
#define EDQUOT	69	/* Disc quota exceeded */
#endif
#ifndef ETXTBSY
#   define ETXTBSY	139	/* Text file or pseudo-device busy */
#undef ESTALE
#define ESTALE	151	/* Stale NFS file handle */
#endif
#ifndef EWOULDBLOCK
#   define EWOULDBLOCK	140	/* Operation would block */
#undef EREMOTE
#define EREMOTE	66	/* The object is remote */
#endif

/*
 * It is very hard to determine how Windows reacts to attempting to
 * set a file pointer outside the input datatype's representable
 * region.  So we fake the error code ourselves.
 */

/* 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
#undef EOVERFLOW
#   define EUSERS	244	/* Too many users (for UFS) */
#endif
#ifndef EDQUOT
#   define EDQUOT	245	/* Disc quota exceeded */
#define EOVERFLOW	EFBIG	/* The object couldn't fit in the datatype */
#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
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
274
275
276
277
278
279
280














281
282
283
284
285
286
287







-
-
-
-
-
-
-
-
-
-
-
-
-
-







 * defined.
 */

#ifndef S_IFLNK
#   define S_IFLNK        0120000  /* Symbolic Link */
#endif

/*
 * Windows compilers do not define S_IFBLK. However, Tcl uses it in
 * GetTypeFromMode to identify blockSpecial devices based on the
 * value in the statsbuf st_mode field. We have no other way to pass this
 * from NativeStat on Windows so are forced to define it here.
 * The definition here is essentially what is seen on Linux and MingW.
 * XXX - the root problem is Tcl using Unix definitions instead of
 * abstracting the structure into a platform independent one. Sigh - perhaps
 * Tcl 9
 */
#ifndef S_IFBLK
#   define S_IFBLK (S_IFDIR | S_IFCHR)
#endif

#ifndef S_ISREG
#   ifdef S_IFREG
#       define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
#   else
#       define S_ISREG(m) 0
#   endif
#endif /* !S_ISREG */
484
485
486
487
488
489
490
491
492
493
494
495


496
497
498
499






500
501
502
503
504
505
506
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







-
-
-


+
+




+
+
+
+
+
+







 * MSVC 8.0 started to mark many standard C library functions depreciated
 * including the *printf family and others. Tell it to shut up.
 * (_MSC_VER is 1200 for VC6, 1300 or 1310 for vc7.net, 1400 for 8.0)
 */
#if defined(_MSC_VER)
#   pragma warning(disable:4146)
#   pragma warning(disable:4244)
#if !defined(_WIN64)
#   pragma warning(disable:4305)
#endif
#   if _MSC_VER >= 1400
#	pragma warning(disable:4267)
#	pragma warning(disable:4311)
#	pragma warning(disable:4312)
#	pragma warning(disable:4996)
#   endif
#endif

/*
 * There is no platform-specific panic routine for Windows in the Tcl internals.
 */

#define TclpPanic ((Tcl_PanicProc *) NULL)

/*
 *---------------------------------------------------------------------------
 * The following macros and declarations represent the interface between
 * generic and windows-specific parts of Tcl.  Some of the macros may
 * override functions declared in tclInt.h.
 *---------------------------------------------------------------------------
 */
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
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







-
+















-
+
















+
+
+

#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#define TclpSysAlloc(size)		((void*)HeapAlloc(GetProcessHeap(), \
#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))

/* This type is not defined in the Windows headers */
#define socklen_t       int


/*
 * The following macros have trivial definitions, allowing generic code to
 * address platform-specific issues.
 */

#define TclpReleaseFile(file)	Tcl_Free(file)
#define TclpReleaseFile(file)	ckfree((char *) file)

/*
 * The following macros and declarations wrap the C runtime library
 * functions.
 */

#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

#define Tcl_DirEntry void
#define TclDIR void

#endif /* _TCLWINPORT */

Changes to win/tclWinSerial.c.

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
39
40
41
42
43
44
45









46
47
48
49
50
51
52







-
-
-
-
-
-
-
-
-







/*
 * Bit masks used in the sharedFlags field of the SerialInfo structure below.
 */

#define SERIAL_EOF	(1<<2)	/* Serial has reached EOF. */
#define SERIAL_ERROR	(1<<4)

/*
 * Bit masks used for noting whether to drain or discard output on close. They
 * are disjoint from each other; at most one may be set at a time.
 */

#define SERIAL_CLOSE_DRAIN   (1<<6)	/* Drain all output on close. */
#define SERIAL_CLOSE_DISCARD (1<<7)	/* Discard all output on close. */
#define SERIAL_CLOSE_MASK    (3<<6)	/* Both two bits above. */

/*
 * Default time to block between checking status on the serial port.
 */

#define SERIAL_DEFAULT_BLOCKTIME 10	/* 10 msec */

/*
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
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







-





+
+
+
+
+
+
















-
+















-
+







				 * default=4096 */

    Tcl_ThreadId threadId;	/* Thread to which events should be reported.
				 * This value is used by the reader/writer
				 * threads. */
    OVERLAPPED osRead;		/* OVERLAPPED structure for read operations. */
    OVERLAPPED osWrite;		/* OVERLAPPED structure for write operations */
    TclPipeThreadInfo *writeTI;	/* Thread info structure of writer worker. */
    HANDLE writeThread;		/* Handle to writer thread. */
    CRITICAL_SECTION csWrite;	/* Writer thread synchronisation. */
    HANDLE evWritable;		/* Manual-reset event to signal when the
				 * writer thread has finished waiting for the
				 * current buffer to be written. */
    HANDLE evStartWriter;	/* Auto-reset event used by the main thread to
				 * signal when the writer thread should
				 * attempt to write to the serial. */
    HANDLE evStopWriter;	/* Auto-reset event used by the main thread to
				 * signal when the writer thread should close.
				 */
    DWORD writeError;		/* An error caused by the last background
				 * write. Set to 0 if no error has been
				 * detected. This word is shared with the
				 * writer thread so access must be
				 * synchronized with the evWritable object. */
    char *writeBuf;		/* Current background output buffer. Access is
				 * synchronized with the evWritable object. */
    int writeBufLen;		/* Size of write buffer. Access is
				 * synchronized with the evWritable object. */
    int toWrite;		/* Current amount to be written. Access is
				 * synchronized with the evWritable object. */
    int writeQueue;		/* Number of bytes pending in output queue.
				 * Offset to DCB.cbInQue. Used to query
				 * [fconfigure -queue] */
} SerialInfo;

typedef struct {
typedef struct ThreadSpecificData {
    /*
     * The following pointer refers to the head of the list of serials that
     * are being watched for file events.
     */

    SerialInfo *firstSerialPtr;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * The following structure is what is added to the Tcl event queue when serial
 * events are generated.
 */

typedef struct {
typedef struct SerialEvent {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    SerialInfo *infoPtr;	/* Pointer to serial info structure. Note that
				 * we still have to verify that the serial
				 * exists before dereferencing this
				 * pointer. */
} SerialEvent;
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
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







-
+








-
+




-
+


-
-
+
+














-
+


-
+







-
+





-
+







/*
 * Declarations for functions used only in this file.
 */

static int		SerialBlockProc(ClientData instanceData, int mode);
static void		SerialCheckProc(ClientData clientData, int flags);
static int		SerialCloseProc(ClientData instanceData,
			    Tcl_Interp *interp, int flags);
			    Tcl_Interp *interp);
static int		SerialEventProc(Tcl_Event *evPtr, int flags);
static void		SerialExitHandler(ClientData clientData);
static int		SerialGetHandleProc(ClientData instanceData,
			    int direction, ClientData *handlePtr);
static ThreadSpecificData *SerialInit(void);
static int		SerialInputProc(ClientData instanceData, char *buf,
			    int toRead, int *errorCode);
static int		SerialOutputProc(ClientData instanceData,
			    const char *buf, int toWrite, int *errorCode);
			    CONST char *buf, int toWrite, int *errorCode);
static void		SerialSetupProc(ClientData clientData, int flags);
static void		SerialWatchProc(ClientData instanceData, int mask);
static void		ProcExitHandler(ClientData clientData);
static int		SerialGetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    Tcl_Interp *interp, CONST char *optionName,
			    Tcl_DString *dsPtr);
static int		SerialSetOptionProc(ClientData instanceData,
			    Tcl_Interp *interp, const char *optionName,
			    const char *value);
			    Tcl_Interp *interp, CONST char *optionName,
			    CONST char *value);
static DWORD WINAPI	SerialWriterThread(LPVOID arg);
static void		SerialThreadActionProc(ClientData instanceData,
			    int action);
static int		SerialBlockingRead(SerialInfo *infoPtr, LPVOID buf,
			    DWORD bufSize, LPDWORD lpRead, LPOVERLAPPED osPtr);
static int		SerialBlockingWrite(SerialInfo *infoPtr, LPVOID buf,
			    DWORD bufSize, LPDWORD lpWritten,
			    LPOVERLAPPED osPtr);

/*
 * This structure describes the channel type structure for command serial
 * based IO.
 */

static const Tcl_ChannelType serialChannelType = {
static Tcl_ChannelType serialChannelType = {
    "serial",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    SerialCloseProc,		/* Close proc. */
    SerialInputProc,		/* Input proc. */
    SerialOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    SerialSetOptionProc,	/* Set option proc. */
    SerialGetOptionProc,	/* Get option proc. */
    SerialWatchProc,		/* Set up notifier to watch the channel. */
    SerialGetHandleProc,	/* Get an OS handle from channel. */
    SerialCloseProc,		/* close2proc. */
    NULL,			/* close2proc. */
    SerialBlockProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc */
    SerialThreadActionProc,	/* thread action proc */
    NULL                       /* truncate */
    NULL,                       /* truncate */
};

/*
 *----------------------------------------------------------------------
 *
 * SerialInit --
 *
281
282
283
284
285
286
287
288

289
290
291
292
293
294
295
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291







-
+







 *	Removes the serial event source.
 *
 *----------------------------------------------------------------------
 */

static void
SerialExitHandler(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Old window proc */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    SerialInfo *infoPtr;

    /*
     * Clear all eventually pending output. Otherwise Tcl's exit could totally
     * block, because it performs a blocking flush on all open channels. Note
319
320
321
322
323
324
325
326

327
328
329
330
331
332
333
315
316
317
318
319
320
321

322
323
324
325
326
327
328
329







-
+







 *	Resets the process list.
 *
 *----------------------------------------------------------------------
 */

static void
ProcExitHandler(
    TCL_UNUSED(ClientData))
    ClientData clientData)	/* Old window proc */
{
    Tcl_MutexLock(&serialMutex);
    initialized = 0;
    Tcl_MutexUnlock(&serialMutex);
}

/*
374
375
376
377
378
379
380
381

382
383
384
385
386
387
388
370
371
372
373
374
375
376

377
378
379
380
381
382
383
384







-
+







 */

static unsigned int
SerialGetMilliseconds(void)
{
    Tcl_Time time;

    Tcl_GetTime(&time);
    TclpGetTime(&time);

    return (time.sec * 1000 + time.usec / 1000);
}

/*
 *----------------------------------------------------------------------
 *
396
397
398
399
400
401
402
403
404
405
406
407
408
409

410
411
412
413
414
415
416
392
393
394
395
396
397
398




399
400

401
402
403
404
405
406
407
408







-
-
-
-


-
+







 *
 * Side effects:
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

#ifdef __cplusplus
#define min(a, b)  (((a) < (b)) ? (a) : (b))
#endif

void
SerialSetupProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    SerialInfo *infoPtr;
    int block = 1;
    int msec = INT_MAX;		/* min. found block time */
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
449
450
451
452
453
454
455

456
457
458
459
460
461
462
463







-
+







 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
SerialCheckProc(
    TCL_UNUSED(ClientData),
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    SerialInfo *infoPtr;
    SerialEvent *evPtr;
    int needEvent;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    COMSTAT cStat;
531
532
533
534
535
536
537
538

539
540
541
542
543
544
545
523
524
525
526
527
528
529

530
531
532
533
534
535
536
537







-
+








	/*
	 * Queue an event if the serial is signaled for reading or writing.
	 */

	if (needEvent) {
	    infoPtr->flags |= SERIAL_PENDING;
	    evPtr = (SerialEvent *)Tcl_Alloc(sizeof(SerialEvent));
	    evPtr = (SerialEvent *) ckalloc(sizeof(SerialEvent));
	    evPtr->header.proc = SerialEventProc;
	    evPtr->infoPtr = infoPtr;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
}

597
598
599
600
601
602
603
604

605
606
607
608

609
610
611

612
613
614
615


616
617
618
619
620
621
622
623
624








































625





626
627

628

629
630
631
632
633
634
635
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
618
619
620
621
622
623
624
625
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







-
+
-


-
+


-
+
-
-
-
-
+
+







-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+


+
-
+







 *
 *----------------------------------------------------------------------
 */

static int
SerialCloseProc(
    ClientData instanceData,    /* Pointer to SerialInfo structure. */
    TCL_UNUSED(Tcl_Interp *),
    Tcl_Interp *interp)		/* For error reporting. */
    int flags)
{
    SerialInfo *serialPtr = (SerialInfo *) instanceData;
    int errorCode = 0, result = 0;
    int errorCode, result = 0;
    SerialInfo *infoPtr, **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    DWORD exitCode;
    if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) != 0) {
	return EINVAL;
    }


    errorCode = 0;

    if (serialPtr->validMask & TCL_READABLE) {
	PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR);
	CloseHandle(serialPtr->osRead.hEvent);
    }
    serialPtr->validMask &= ~TCL_READABLE;

    if (serialPtr->writeThread) {
    	TclPipeThreadStop(&serialPtr->writeTI, serialPtr->writeThread);
    if (serialPtr->validMask & TCL_WRITABLE) {
	/*
	 * Generally we cannot wait for a pending write operation because it
	 * may hang due to handshake
	 *    WaitForSingleObject(serialPtr->evWritable, INFINITE);
	 */

	/*
	 * The thread may have already closed on it's own. Check it's exit
	 * code.
	 */

	GetExitCodeThread(serialPtr->writeThread, &exitCode);

	if (exitCode == STILL_ACTIVE) {
	    /*
	     * Set the stop event so that if the writer thread is blocked in
	     * SerialWriterThread on WaitForMultipleEvents, it will exit
	     * cleanly.
	     */

	    SetEvent(serialPtr->evStopWriter);

	    /*
	     * Wait at most 20 milliseconds for the writer thread to close.
	     */

	    if (WaitForSingleObject(serialPtr->writeThread,
		    20) == WAIT_TIMEOUT) {
		/*
		 * Forcibly terminate the background thread as a last resort.
		 * Note that we need to guard against terminating the thread
		 * while it is in the middle of Tcl_ThreadAlert because it
		 * won't be able to release the notifier lock.
		 */

		Tcl_MutexLock(&serialMutex);

		/* BUG: this leaks memory */
		TerminateThread(serialPtr->writeThread, 0);

		Tcl_MutexUnlock(&serialMutex);
	    }
	}

	CloseHandle(serialPtr->writeThread);
	CloseHandle(serialPtr->osWrite.hEvent);
	CloseHandle(serialPtr->evWritable);
	CloseHandle(serialPtr->evStartWriter);
	CloseHandle(serialPtr->writeThread);
	CloseHandle(serialPtr->evStopWriter);
	serialPtr->writeThread = NULL;

	PurgeComm(serialPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
    }
    serialPtr->validMask &= ~TCL_WRITABLE;

    DeleteCriticalSection(&serialPtr->csWrite);
666
667
668
669
670
671
672
673

674
675
676

677
678
679
680
681
682
683
699
700
701
702
703
704
705

706
707
708

709
710
711
712
713
714
715
716







-
+


-
+







    }

    /*
     * Wrap the error file into a channel and give it to the cleanup routine.
     */

    if (serialPtr->writeBuf != NULL) {
	Tcl_Free(serialPtr->writeBuf);
	ckfree(serialPtr->writeBuf);
	serialPtr->writeBuf = NULL;
    }
    Tcl_Free(serialPtr);
    ckfree((char*) serialPtr);

    if (errorCode == 0) {
	return result;
    }
    return errorCode;
}

895
896
897
898
899
900
901
902

903
904
905
906
907
908
909
928
929
930
931
932
933
934

935
936
937
938
939
940
941
942







-
+







	     */

	    if (cStat.cbInQue > 0) {
		if ((DWORD) bufSize > cStat.cbInQue) {
		    bufSize = cStat.cbInQue;
		}
	    } else {
		errno = *errorCode = EWOULDBLOCK;
		errno = *errorCode = EAGAIN;
		return -1;
	    }
	} else {
	    /*
	     * BLOCKING mode: Tcl trys to read a full buffer of 4 kBytes here.
	     */

959
960
961
962
963
964
965
966

967
968
969
970
971
972
973
992
993
994
995
996
997
998

999
1000
1001
1002
1003
1004
1005
1006







-
+







 *
 *----------------------------------------------------------------------
 */

static int
SerialOutputProc(
    ClientData instanceData,	/* Serial state. */
    const char *buf,		/* The data buffer. */
    CONST char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCode)		/* Where to store error code. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;
    DWORD bytesWritten, timeout;

    *errorCode = 0;
1031
1032
1033
1034
1035
1036
1037
1038

1039
1040
1041

1042
1043

1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
1064
1065
1066
1067
1068
1069
1070

1071
1072
1073

1074
1075

1076
1077
1078

1079
1080
1081
1082
1083
1084
1085
1086







-
+


-
+

-
+


-
+








	if (toWrite > infoPtr->writeBufLen) {
	    /*
	     * Reallocate the buffer to be large enough to hold the data.
	     */

	    if (infoPtr->writeBuf) {
		Tcl_Free(infoPtr->writeBuf);
		ckfree(infoPtr->writeBuf);
	    }
	    infoPtr->writeBufLen = toWrite;
	    infoPtr->writeBuf = (char *)Tcl_Alloc(toWrite);
	    infoPtr->writeBuf = ckalloc((unsigned int) toWrite);
	}
	memcpy(infoPtr->writeBuf, buf, toWrite);
	memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
	infoPtr->toWrite = toWrite;
	ResetEvent(infoPtr->evWritable);
	TclPipeThreadSignal(&infoPtr->writeTI);
	SetEvent(infoPtr->evStartWriter);
	bytesWritten = (DWORD) toWrite;

    } else {
	/*
	 * In the blocking case, just try to write the buffer directly. This
	 * avoids an unnecessary copy.
	 */
1246
1247
1248
1249
1250
1251
1252
1253

1254
1255
1256
1257
1258
1259
1260
1279
1280
1281
1282
1283
1284
1285

1286
1287
1288
1289
1290
1291
1292
1293







-
+







 *
 *----------------------------------------------------------------------
 */

static int
SerialGetHandleProc(
    ClientData instanceData,	/* The serial state. */
    TCL_UNUSED(int) /*direction*/,
    int direction,		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    SerialInfo *infoPtr = (SerialInfo *) instanceData;

    *handlePtr = (ClientData) infoPtr->handle;
    return TCL_OK;
}
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
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

1348
1349
1350
1351
1352
1353
1354
1355







-
-
-
+
+


+
+
+
+
+
+
+
+





-
-
+
+
+
+
+
+
+
+
+


-




-
+







 *----------------------------------------------------------------------
 */

static DWORD WINAPI
SerialWriterThread(
    LPVOID arg)
{
    TclPipeThreadInfo *pipeTI = (TclPipeThreadInfo *)arg;
    SerialInfo *infoPtr = NULL; /* access info only after success init/wait */
    DWORD bytesWritten, toWrite;
    SerialInfo *infoPtr = (SerialInfo *)arg;
    DWORD bytesWritten, toWrite, waitResult;
    char *buf;
    OVERLAPPED myWrite;		/* Have an own OVERLAPPED in this thread. */
    HANDLE wEvents[2];

    /*
     * The stop event takes precedence by being first in the list.
     */

    wEvents[0] = infoPtr->evStopWriter;
    wEvents[1] = infoPtr->evStartWriter;

    for (;;) {
	/*
	 * Wait for the main thread to signal before attempting to write.
	 */
	if (!TclPipeThreadWaitForSignal(&pipeTI)) {
	    /* exit */

	waitResult = WaitForMultipleObjects(2, wEvents, FALSE, INFINITE);

	if (waitResult != (WAIT_OBJECT_0 + 1)) {
	    /*
	     * The start event was not signaled. It might be the stop event or
	     * an error, so exit.
	     */

	    break;
	}
	infoPtr = (SerialInfo *) pipeTI->clientData;

	buf = infoPtr->writeBuf;
	toWrite = infoPtr->toWrite;

	myWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
	myWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);

	/*
	 * Loop until all of the bytes are written or an error occurs.
	 */

	while (toWrite > 0) {
	    /*
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
1385
1386
1387
1388
1400
1401
1402
1403
1404
1405
1406





















1407
1408
1409
1410
1411
1412
1413







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







	     */

	    Tcl_ThreadAlert(infoPtr->threadId);
	}
	Tcl_MutexUnlock(&serialMutex);
    }

    /*
     * We're about to close, so do any drain or discard required.
     */

    if (infoPtr) {
	switch (infoPtr->flags & SERIAL_CLOSE_MASK) {
	case SERIAL_CLOSE_DRAIN:
	    FlushFileBuffers(infoPtr->handle);
	    break;
	case SERIAL_CLOSE_DISCARD:
	    PurgeComm(infoPtr->handle, PURGE_TXABORT | PURGE_TXCLEAR);
	    break;
	}
    }

    /*
     * Worker exit, so inform the main thread or free TI-structure (if owned).
     */

    TclPipeThreadExit(&pipeTI);

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinSerialOpen --
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
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







-
+








-
+









-
-
+
+







 *
 *----------------------------------------------------------------------
 */

HANDLE
TclWinSerialOpen(
    HANDLE handle,
    const WCHAR *name,
    CONST TCHAR *name,
    DWORD access)
{
    SerialInit();

    /*
     * If an open channel is specified, close it
     */

    if (handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) {
    if ( handle != INVALID_HANDLE_VALUE && CloseHandle(handle) == FALSE) {
	return INVALID_HANDLE_VALUE;
    }

    /*
     * Multithreaded I/O needs the overlapped flag set otherwise
     * ClearCommError blocks under Windows NT/2000 until serial output is
     * finished
     */

    handle = CreateFileW(name, access, 0, 0, OPEN_EXISTING,
	    FILE_FLAG_OVERLAPPED, 0);
    handle = (*tclWinProcs->createFileProc)(name, access, 0, 0,
	    OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);

    return handle;
}

/*
 *----------------------------------------------------------------------
 *
1448
1449
1450
1451
1452
1453
1454

1455
1456
1457
1458

1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479

1480
1481
1482

1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497

1498
1499
1500
1501
1502
1503
1504
1505




1506
1507
1508

1509
1510
1511
1512
1513
1514
1515
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
1531
1532
1533
1534


1535
1536
1537
1538
1539
1540
1541
1542







+



-
+




















-
+


-
+














-
+






-
-
+
+
+
+

-
-
+







Tcl_Channel
TclWinOpenSerialChannel(
    HANDLE handle,
    char *channelName,
    int permissions)
{
    SerialInfo *infoPtr;
    DWORD id;

    SerialInit();

    infoPtr = (SerialInfo *)Tcl_Alloc(sizeof(SerialInfo));
    infoPtr = (SerialInfo *) ckalloc((unsigned) sizeof(SerialInfo));
    memset(infoPtr, 0, sizeof(SerialInfo));

    infoPtr->validMask = permissions;
    infoPtr->handle = handle;
    infoPtr->channel = (Tcl_Channel) NULL;
    infoPtr->readable = 0;
    infoPtr->writable = 1;
    infoPtr->toWrite = infoPtr->writeQueue = 0;
    infoPtr->blockTime = SERIAL_DEFAULT_BLOCKTIME;
    infoPtr->lastEventTime = 0;
    infoPtr->lastError = infoPtr->error = 0;
    infoPtr->threadId = Tcl_GetCurrentThread();
    infoPtr->sysBufRead = 4096;
    infoPtr->sysBufWrite = 4096;

    /*
     * Use the pointer to keep the channel names unique, in case the handles
     * are shared between multiple channels (stdin/stdout).
     */

    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
    sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t)infoPtr);

    infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
	    infoPtr, permissions);
	    (ClientData) infoPtr, permissions);


    SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite);
    PurgeComm(handle,
	    PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR);

    /*
     * Default is blocking.
     */

    SetCommTimeouts(handle, &no_timeout);

    InitializeCriticalSection(&infoPtr->csWrite);
    if (permissions & TCL_READABLE) {
	infoPtr->osRead.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
	infoPtr->osRead.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
    }
    if (permissions & TCL_WRITABLE) {
	/*
	 * Initially the channel is writable and the writeThread is idle.
	 */

	infoPtr->osWrite.hEvent = CreateEventW(NULL, TRUE, FALSE, NULL);
	infoPtr->evWritable = CreateEventW(NULL, TRUE, TRUE, NULL);
	infoPtr->osWrite.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
	infoPtr->evWritable = CreateEvent(NULL, TRUE, TRUE, NULL);
	infoPtr->evStartWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->evStopWriter = CreateEvent(NULL, FALSE, FALSE, NULL);
	infoPtr->writeThread = CreateThread(NULL, 256, SerialWriterThread,
		TclPipeThreadCreateTI(&infoPtr->writeTI, infoPtr,
			infoPtr->evWritable), 0, NULL);
		infoPtr, 0, &id);
    }

    /*
     * Files have default translation of AUTO and ^Z eof char, which means
     * that a ^Z will be accepted as EOF when reading.
     */

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
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
1644
1645
1646
1647
1648
1649
1650


1651
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







-
-
+
+






-
+

-
+











-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






+
-
-
+
+
-
-
-
+
+
+
+




-
-
+
+
-
-














+
-
+
+
+










+
-
+
+
+







 *----------------------------------------------------------------------
 */

static int
SerialSetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Which option to set? */
    const char *value)		/* New value for option. */
    CONST char *optionName,	/* Which option to set? */
    CONST char *value)		/* New value for option. */
{
    SerialInfo *infoPtr;
    DCB dcb;
    BOOL result, flag;
    size_t len, vlen;
    Tcl_DString ds;
    const WCHAR *native;
    CONST TCHAR *native;
    int argc;
    const char **argv;
    CONST char **argv;

    infoPtr = (SerialInfo *) instanceData;

    /*
     * Parse options. This would be far easier if we had Tcl_Objs to work with
     * as that would let us use Tcl_GetIndexFromObj()...
     */

    len = strlen(optionName);
    vlen = strlen(value);

    /*
     * Option -closemode drain|discard|default
     */

    if ((len > 2) && (strncmp(optionName, "-closemode", len) == 0)) {
	if (Tcl_UtfNcasecmp(value, "DEFAULT", vlen) == 0) {
	    infoPtr->flags &= ~SERIAL_CLOSE_MASK;
	} else if (Tcl_UtfNcasecmp(value, "DRAIN", vlen) == 0) {
	    infoPtr->flags &= ~SERIAL_CLOSE_MASK;
	    infoPtr->flags |= SERIAL_CLOSE_DRAIN;
	} else if (Tcl_UtfNcasecmp(value, "DISCARD", vlen) == 0) {
	    infoPtr->flags &= ~SERIAL_CLOSE_MASK;
	    infoPtr->flags |= SERIAL_CLOSE_DISCARD;
	} else {
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad mode \"%s\" for -closemode: must be"
			" default, discard, or drain", value));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FCONFIGURE",
			"VALUE", NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -mode baud,parity,databits,stopbits
     */

    if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto getStateFailed;
	}
		Tcl_AppendResult(interp, "can't get comm state", NULL);
	    }
	Tcl_DStringInit(&ds);
	native = Tcl_UtfToWCharDString(value, -1, &ds);
	result = BuildCommDCBW(native, &dcb);
	    return TCL_ERROR;
	}
	native = Tcl_WinUtfToTChar(value, -1, &ds);
	result = (*tclWinProcs->buildCommDCBProc)(native, &dcb);
	Tcl_DStringFree(&ds);

	if (result == FALSE) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -mode: should be baud,parity,data,stop",
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -mode: should be baud,parity,data,stop", NULL);
			value));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SERIALMODE", NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Default settings for serial communications.
	 */

	dcb.fBinary = TRUE;
	dcb.fErrorChar = FALSE;
	dcb.fNull = FALSE;
	dcb.fAbortOnError = FALSE;

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto setStateFailed;
		Tcl_AppendResult(interp, "can't set comm state", NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -handshake none|xonxoff|rtscts|dtrdsr
     */

    if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto getStateFailed;
		Tcl_AppendResult(interp, "can't get comm state", NULL);
	    }
	    return TCL_ERROR;
	}

	/*
	 * Reset all handshake options. DTR and RTS are ON by default.
	 */

	dcb.fOutX = dcb.fInX = FALSE;
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

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



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
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
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
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
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







-
-
-
+
+
+
-





+
-
+
+
+










+
-
+
+
+








-
-
-
-
+
+
+

-
+
















-
+



-
+




-
+




-
+


+
-
+
+
+









-
+






-
-
-
+
+
+
-

-
+





-
+






-
-
+
-
-

-
+






-
-
+
-
-

-
+






-
-
+
-
-

-
+




-
-
+
+
-
-


-
+




-
-
+
+












-
+











-
+



-
-
-
+
+
+
-






-
-
-
+
-












+
-
+
+
+




+
-
+
+
+







	    dcb.fOutxCtsFlow = TRUE;
	    dcb.fRtsControl = RTS_CONTROL_HANDSHAKE;
	} else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
	    dcb.fOutxDsrFlow = TRUE;
	    dcb.fDtrControl = DTR_CONTROL_HANDSHAKE;
	} else {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -handshake: must be one of"
			" xonxoff, rtscts, dtrdsr or none", value));
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -handshake: must be one of xonxoff, rtscts, "
			"dtrdsr or none", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "HANDSHAKE", NULL);
	    }
	    return TCL_ERROR;
	}

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto setStateFailed;
		Tcl_AppendResult(interp, "can't set comm state", NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -xchar {\x11 \x13}
     */

    if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto getStateFailed;
		Tcl_AppendResult(interp, "can't get comm state", NULL);
	    }
	    return TCL_ERROR;
	}

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (argc != 2) {
	badXchar:
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"bad value for -xchar: should be a list of"
			" two elements with each a single 8-bit character", -1));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "XCHAR", NULL);
		Tcl_AppendResult(interp, "bad value for -xchar: should be "
			"a list of two elements with each a single character",
			NULL);
	    }
	    Tcl_Free((void *)argv);
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	/*
	 * These dereferences are safe, even in the zero-length string cases,
	 * because that just makes the xon/xoff character into NUL. When the
	 * character looks like it is UTF-8 encoded, decode it before casting
	 * into the format required for the Win guts. Note that this does not
	 * convert character sets; it is expected that when people set the
	 * control characters to something large and custom, they'll know the
	 * hex/octal value rather than the printable form.
	 */

	dcb.XonChar = argv[0][0];
	dcb.XoffChar = argv[1][0];
	if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
	    Tcl_UniChar character = 0;
	    Tcl_UniChar character;
	    int charLen;

	    charLen = Tcl_UtfToUniChar(argv[0], &character);
	    if ((character > 0xFF) || argv[0][charLen]) {
	    if (argv[0][charLen]) {
		goto badXchar;
	    }
	    dcb.XonChar = (char) character;
	    charLen = Tcl_UtfToUniChar(argv[1], &character);
	    if ((character > 0xFF) || argv[1][charLen]) {
	    if (argv[1][charLen]) {
		goto badXchar;
	    }
	    dcb.XoffChar = (char) character;
	}
	Tcl_Free((void *)argv);
	ckfree((char *) argv);

	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto setStateFailed;
		Tcl_AppendResult(interp, "can't set comm state", NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
     */

    if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
	int i, res = TCL_OK;
	int i, result = TCL_OK;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if ((argc % 2) == 1) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -ttycontrol: should be "
			"a list of signal,value pairs", value));
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -ttycontrol: should be a list of "
			"signal,value pairs", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTYCONTROL", NULL);
	    }
	    Tcl_Free((void *)argv);
	    ckfree((char *) argv);
	    return TCL_ERROR;
	}

	for (i = 0; i < argc - 1; i += 2) {
	    if (Tcl_GetBoolean(interp, argv[i+1], &flag) == TCL_ERROR) {
		res = TCL_ERROR;
		result = TCL_ERROR;
		break;
	    }
	    if (strncasecmp(argv[i], "DTR", strlen(argv[i])) == 0) {
		if (!EscapeCommFunction(infoPtr->handle,
			(DWORD) (flag ? SETDTR : CLRDTR))) {
		    if (interp != NULL) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"can't set DTR signal", -1));
			Tcl_AppendResult(interp, "can't set DTR signal", NULL);
			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    res = TCL_ERROR;
		    result = TCL_ERROR;
		    break;
		}
	    } else if (strncasecmp(argv[i], "RTS", strlen(argv[i])) == 0) {
		if (!EscapeCommFunction(infoPtr->handle,
			(DWORD) (flag ? SETRTS : CLRRTS))) {
		    if (interp != NULL) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"can't set RTS signal", -1));
			Tcl_AppendResult(interp, "can't set RTS signal", NULL);
			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    res = TCL_ERROR;
		    result = TCL_ERROR;
		    break;
		}
	    } else if (strncasecmp(argv[i], "BREAK", strlen(argv[i])) == 0) {
		if (!EscapeCommFunction(infoPtr->handle,
			(DWORD) (flag ? SETBREAK : CLRBREAK))) {
		    if (interp != NULL) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(
				"can't set BREAK signal", -1));
			Tcl_AppendResult(interp,"can't set BREAK signal",NULL);
			Tcl_SetErrorCode(interp, "TCL", "OPERATION",
				"FCONFIGURE", "TTY_SIGNAL", NULL);
		    }
		    res = TCL_ERROR;
		    result = TCL_ERROR;
		    break;
		}
	    } else {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bad signal name \"%s\" for -ttycontrol: must be"
		    Tcl_AppendResult(interp, "bad signal name \"", argv[i],
			    "\" for -ttycontrol: must be DTR, RTS or BREAK",
			    " DTR, RTS or BREAK", argv[i]));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "TTY_SIGNAL",
			    NULL);
		}
		res = TCL_ERROR;
		result = TCL_ERROR;
		break;
	    }
	}

	Tcl_Free((void *)argv);
	return res;
	ckfree((char *) argv);
	return result;
    }

    /*
     * Option -sysbuffer {read_size write_size}
     * Option -sysbuffer read_size
     */

    if ((len > 1) && (strncmp(optionName, "-sysbuffer", len) == 0)) {
	/*
	 * -sysbuffer 4096 or -sysbuffer {64536 4096}
	 */

	int inSize = -1, outSize = -1;
	size_t inSize = (size_t) -1, outSize = (size_t) -1;

	if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
	    return TCL_ERROR;
	}
	if (argc == 1) {
	    inSize = atoi(argv[0]);
	    outSize = infoPtr->sysBufWrite;
	} else if (argc == 2) {
	    inSize  = atoi(argv[0]);
	    outSize = atoi(argv[1]);
	}
	Tcl_Free((void *)argv);
	ckfree((char *) argv);

	if ((argc < 1) || (argc > 2) || (inSize <= 0) || (outSize <= 0)) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad value \"%s\" for -sysbuffer: should be "
			"a list of one or two integers > 0", value));
		Tcl_AppendResult(interp, "bad value \"", value,
			"\" for -sysbuffer: should be a list of one or two "
			"integers > 0", NULL);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "SYS_BUFFER", NULL);
	    }
	    return TCL_ERROR;
	}

	if (!SetupComm(infoPtr->handle, inSize, outSize)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't setup comm buffers: %s",
		Tcl_AppendResult(interp, "can't setup comm buffers", NULL);
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}
	infoPtr->sysBufRead  = inSize;
	infoPtr->sysBufWrite = outSize;

	/*
	 * Adjust the handshake limits. Yes, the XonXoff limits seem to
	 * influence even hardware handshake.
	 */

	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto getStateFailed;
		Tcl_AppendResult(interp, "can't get comm state", NULL);
	    }
	    return TCL_ERROR;
	}
	dcb.XonLim = (WORD) (infoPtr->sysBufRead*1/2);
	dcb.XoffLim = (WORD) (infoPtr->sysBufRead*1/4);
	if (!SetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
	    goto setStateFailed;
		Tcl_AppendResult(interp, "can't set comm state", NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    /*
     * Option -pollinterval msec
     */
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
1987
1988
1989
1990
1991
1992
1993



1994

1995
1996
1997
1998
1999
2000
2001
2002

2003

















2004
2005
2006
2007
2008
2009
2010







-
-
-
+
-








-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








	if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
	    return TCL_ERROR;
	}
	tout.ReadTotalTimeoutConstant = msec;
	if (!SetCommTimeouts(infoPtr->handle, &tout)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't set comm timeouts: %s",
		Tcl_AppendResult(interp, "can't set comm timeouts", NULL);
			Tcl_PosixError(interp)));
	    }
	    return TCL_ERROR;
	}

	return TCL_OK;
    }

    return Tcl_BadChannelOption(interp, optionName,
	    "closemode mode handshake pollinterval sysbuffer timeout "
	    "mode handshake pollinterval sysbuffer timeout ttycontrol xchar");
	    "ttycontrol xchar");

  getStateFailed:
    if (interp != NULL) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't get comm state: %s", Tcl_PosixError(interp)));
    }
    return TCL_ERROR;

  setStateFailed:
    if (interp != NULL) {
	TclWinConvertError(GetLastError());
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't set comm state: %s", Tcl_PosixError(interp)));
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * SerialGetOptionProc --
 *
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
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







-
+















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
+




-
-
-
+







 *----------------------------------------------------------------------
 */

static int
SerialGetOptionProc(
    ClientData instanceData,	/* File state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Option to get. */
    CONST char *optionName,	/* Option to get. */
    Tcl_DString *dsPtr)		/* Where to store value(s). */
{
    SerialInfo *infoPtr;
    DCB dcb;
    size_t len;
    int valid = 0;		/* Flag if valid option parsed. */

    infoPtr = (SerialInfo *) instanceData;

    if (optionName == NULL) {
	len = 0;
    } else {
	len = strlen(optionName);
    }

    /*
     * Get option -closemode
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-closemode");
    }
    if (len==0 || (len>1 && strncmp(optionName, "-closemode", len)==0)) {
	switch (infoPtr->flags & SERIAL_CLOSE_MASK) {
	case SERIAL_CLOSE_DRAIN:
	    Tcl_DStringAppendElement(dsPtr, "drain");
	    break;
	case SERIAL_CLOSE_DISCARD:
	    Tcl_DStringAppendElement(dsPtr, "discard");
	    break;
	default:
	    Tcl_DStringAppendElement(dsPtr, "default");
	    break;
	}
    }

    /*
     * Get option -mode
     */

    if (len == 0) {
	Tcl_DStringAppendElement(dsPtr, "-mode");
    }
    if (len==0 || (len>2 && (strncmp(optionName, "-mode", len) == 0))) {
	char parity;
	const char *stop;
	char *stop;
	char buf[2 * TCL_INTEGER_SPACE + 16];

	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get comm state: %s", Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "can't get comm state", NULL);
	    }
	    return TCL_ERROR;
	}

	valid = 1;
	parity = 'n';
	if (dcb.Parity <= 4) {
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170

2171
2172
2173
2174

2175
2176

2177
2178
2179
2180
2181
2182
2183
2122
2123
2124
2125
2126
2127
2128



2129
2130
2131
2132

2133
2134

2135
2136
2137
2138
2139
2140
2141
2142







-
-
-
+



-
+

-
+







    }
    if (len==0 || (len>1 && strncmp(optionName, "-xchar", len) == 0)) {
	char buf[4];
	valid = 1;

	if (!GetCommState(infoPtr->handle, &dcb)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get comm state: %s", Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "can't get comm state", NULL);
	    }
	    return TCL_ERROR;
	}
	buf[Tcl_UniCharToUtf(UCHAR(dcb.XonChar), buf)] = '\0';
	sprintf(buf, "%c", dcb.XonChar);
	Tcl_DStringAppendElement(dsPtr, buf);
	buf[Tcl_UniCharToUtf(UCHAR(dcb.XoffChar), buf)] = '\0';
	sprintf(buf, "%c", dcb.XoffChar);
	Tcl_DStringAppendElement(dsPtr, buf);
    }
    if (len == 0) {
	Tcl_DStringEndSublist(dsPtr);
    }

    /*
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
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







-
-
-
+









-
-
-
+
+
+
-
+







     */

    if (len>4 && strncmp(optionName, "-ttystatus", len)==0) {
	DWORD status;

	if (!GetCommModemStatus(infoPtr->handle, &status)) {
	    if (interp != NULL) {
		TclWinConvertError(GetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get tty status: %s", Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "can't get tty status", NULL);
	    }
	    return TCL_ERROR;
	}
	valid = 1;
	SerialModemStatusStr(status, dsPtr);
    }

    if (valid) {
	return TCL_OK;
    }
    return Tcl_BadChannelOption(interp, optionName,
	    "closemode mode pollinterval lasterror queue sysbuffer ttystatus "
    } else {
	return Tcl_BadChannelOption(interp, optionName,
		"mode pollinterval lasterror queue sysbuffer ttystatus xchar");
	    "xchar");
    }
}

/*
 *----------------------------------------------------------------------
 *
 * SerialThreadActionProc --
 *

Changes to win/tclWinSock.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
1
2
3
4
5
6
7
8
9
10



11
12
13
14
15
16
17










-
-
-







/*
 * tclWinSock.c --
 *
 *	This file contains Windows-specific socket related code.
 *
 * 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.
 *
 * -----------------------------------------------------------------------
 * The order and naming of functions in this file should minimize
 * the file diff to tclUnixSock.c.
 * -----------------------------------------------------------------------
 *
 * General information on how this module works.
 *
 * - Each Tcl-thread with its sockets maintains an internal window to receive
 *   socket messages from the OS.
 *
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
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
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
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



450
451
452
453
454




455














456




457
458
459
460
461
462
463







+
+














-
-
+
+
-


-
-
-
-
-
+
+
-
-
+








-



+
+
+
+
+
+
+
+
+



-
-
-
-
-
+
+
+
+
+


-
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-


-
-
-
+
-
-
-
-
-
-

-
-
-
-
+
+






-
+
-
-






-
+
-
-



-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-










-
-
+
+










+
+
+
+
+
+
+
+
+
+
+










-
+



-
+




-
+


-
+


-
-
+
+
+
+
+

-
+




-
+
-
-
+

-
-



-




-
-
+
+









-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
+
+
+
+
+

+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+

-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+



-
+

-
+
-
+
+
+



+
+
+





-
+
-
-
-

-
-
-
+

-
-
-
-
-
-
+
-
-
+
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
-
-
-
+
+
+
+
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-







 *          all the OS messages are translated to through the EventSource (2)
 *          driven by the OS messages.
 *
 *   (Ad 2) The main functions for this are SocketSetupProc() and
 *          SocketCheckProc().
 */

#include <winsock2.h>
#include <ws2tcpip.h>
#include "tclWinInt.h"

#ifdef _MSC_VER
#   pragma comment (lib, "ws2_32")
#endif

/*
 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
 * currently disabled.
 */

#undef TCL_FEATURE_KEEPALIVE_NAGLE

/*
 * Helper macros to make parts of this file clearer. The macros do exactly
 * what they say on the tin. :-) They also only ever refer to their arguments
 * Make sure to remove the redirection defines set in tclWinPort.h that is in
 * use in other sections of the core, except for us.
 * once, and so can be used without regard to side effects.
 */

#define SET_BITS(var, bits)	((var) |= (bits))
#define CLEAR_BITS(var, bits)	((var) &= ~(bits))
#define GOT_BITS(var, bits)     (((var) & (bits)) != 0)

/* "sock" + a pointer in hex + \0 */
#undef getservbyname
#undef getsockopt
#define SOCK_CHAN_LENGTH        (4 + sizeof(void *) * 2 + 1)
#define SOCK_TEMPLATE           "sock%p"
#undef setsockopt

/*
 * The following variable is used to tell whether this module has been
 * initialized.  If 1, initialization of sockets was successful, if -1 then
 * socket initialization failed (WSAStartup failed).
 */

static int initialized = 0;
static const WCHAR className[] = L"TclSocket";
TCL_DECLARE_MUTEX(socketMutex)

/*
 * The following variable holds the network name of this host.
 */

static TclInitProcessGlobalValueProc InitializeHostName;
static ProcessGlobalValue hostName = {
    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
#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.
 */

 * The following structure is used to store the data associated with each
typedef union {
    struct sockaddr sa;
 * socket.
    struct sockaddr_in sa4;
    struct sockaddr_in6 sa6;
    struct sockaddr_storage sas;
} address;

 * All members modified by the notifier thread are defined as volatile.
#ifndef IN6_ARE_ADDR_EQUAL
#define IN6_ARE_ADDR_EQUAL IN6_ADDR_EQUAL
#endif

/*
 * This structure describes per-instance state of a tcp based channel.
 */

typedef struct TcpState TcpState;

typedef struct TcpFdList {
typedef struct SocketInfo {
    TcpState *statePtr;
    SOCKET fd;
    struct TcpFdList *next;
} TcpFdList;

struct TcpState {
    Tcl_Channel channel;	/* Channel associated with this socket. */
    int testFlags;              /* bit field for tests. Is set by testsocket
                                 * test procedure */
    struct TcpFdList *sockets;	/* Windows SOCKET handle. */
    int flags;			/* Bit field comprised of the flags described
    SOCKET socket;		/* Windows SOCKET handle. */
    volatile int flags;		/* Bit field comprised of the flags described
				 * below. */
    int watchEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
				 * indicate which events are interesting. */
    volatile int readyEvents;	/* OR'ed combination of FD_READ, FD_WRITE,
				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
				 * indicate which events have occurred.
				 * indicate which events have occurred. */
				 * Set by notifier thread, access must be
				 * protected by semaphore */
    int selectEvents;		/* OR'ed combination of FD_READ, FD_WRITE,
				 * FD_CLOSE, FD_ACCEPT and FD_CONNECT that
				 * indicate which events are currently being
				 * selected. */
    volatile int acceptEventCount;
				/* Count of the current number of FD_ACCEPTs
				 * that have arrived and not yet processed.
				 * that have arrived and not yet processed. */
				 * Set by notifier thread, access must be
				 * protected by semaphore */
    Tcl_TcpAcceptProc *acceptProc;
				/* Proc to call on accept. */
    ClientData acceptProcData;	/* The data for the accept proc. */

    volatile int lastError;	/* Error code from last message. */
    /*
     * Only needed for client sockets
     */

    struct addrinfo *addrlist;	/* Addresses to connect to. */
    struct addrinfo *addr;	/* Iterator over addrlist. */
    struct addrinfo *myaddrlist;/* Local address. */
    struct addrinfo *myaddr;	/* Iterator over myaddrlist. */
    int connectError;		/* Cache status of async socket. */
    int cachedBlocking;         /* Cache blocking mode of async socket. */
    volatile int notifierConnectError;
				/* Async connect error set by notifier thread.
				 * This error is still a windows error code.
				 * Access must be protected by semaphore */
    struct TcpState *nextPtr;	/* The next socket on the per-thread socket
    struct SocketInfo *nextPtr;	/* The next socket on the per-thread socket
				 * list. */
};

/*
 * These bits may be ORed together into the "flags" field of a TcpState
 * structure.
 */

#define TCP_NONBLOCKING		(1<<0)	/* Socket with non-blocking I/O */
#define TCP_ASYNC_CONNECT	(1<<1)	/* Async connect in progress. */
#define SOCKET_EOF		(1<<2)	/* A zero read happened on the
					 * socket. */
} SocketInfo;
#define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
					 * socket */
#define TCP_ASYNC_PENDING	(1<<4)	/* TcpConnect was called to
					 * process an async connect. This
					 * flag indicates that reentry is
					 * still pending */
#define TCP_ASYNC_FAILED	(1<<5)	/* An async connect finally failed */

/*
 * These bits may be ORed together into the "testFlags" field of a TcpState
 * structure.
 */

#define TCP_ASYNC_TEST_MODE	(1<<0)	/* Async testing activated.  Do not
					 * automatically continue connection
					 * process */

/*
 * The following structure is what is added to the Tcl event queue when a
 * socket event occurs.
 */

typedef struct {
    Tcl_Event header;		/* Information that is standard for all
				 * events. */
    SOCKET socket;		/* Socket descriptor that is ready. Used to
				 * find the TcpState structure for the file
				 * (can't point directly to the TcpState
				 * find the SocketInfo structure for the file
				 * (can't point directly to the SocketInfo
				 * structure because it could go away while
				 * the event is queued). */
} SocketEvent;

/*
 * This defines the minimum buffersize maintained by the kernel.
 */

#define TCP_BUFFER_SIZE 4096

/*
 * The following macros may be used to set the flags field of a SocketInfo
 * structure.
 */

#define SOCKET_ASYNC		(1<<0)	/* The socket is in blocking mode. */
#define SOCKET_EOF		(1<<1)	/* A zero read happened on the
					 * socket. */
#define SOCKET_ASYNC_CONNECT	(1<<2)	/* This socket uses async connect. */
#define SOCKET_PENDING		(1<<3)	/* A message has been sent for this
					 * socket */

typedef struct {
    HWND hwnd;			/* Handle to window for socket messages. */
    HANDLE socketThread;	/* Thread handling the window */
    Tcl_ThreadId threadId;	/* Parent thread. */
    HANDLE readyEvent;		/* Event indicating that a socket event is
				 * ready. Also used to indicate that the
				 * socketThread has been initialized and has
				 * started. */
    HANDLE socketListLock;	/* Win32 Event to lock the socketList */
    TcpState *pendingTcpState;
    SocketInfo *pendingSocketInfo;
				/* This socket is opened but not jet in the
				 * list. This value is also checked by
				 * the event structure. */
    TcpState *socketList;	/* Every open socket in this thread has an
    SocketInfo *socketList;	/* Every open socket in this thread has an
				 * entry on this list. */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
static WNDCLASSW windowClass;
static WNDCLASS windowClass;

/*
 * Static routines for this file:
 * Static functions defined in this file.
 */

static int		TcpConnect(Tcl_Interp *interp,
			    TcpState *state);
static SocketInfo *	CreateSocket(Tcl_Interp *interp, int port,
			    const char *host, int server, const char *myaddr,
			    int myport, int async);
static int		CreateSocketAddress(struct sockaddr_in *sockaddrPtr,
			    const char *host, int port, int willBind);
static void		InitSockets(void);
static TcpState *	NewSocketInfo(SOCKET socket);
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, SOCKET newSocket, address addr);
static void		TcpAccept(SocketInfo *infoPtr);
static int		WaitForConnect(TcpState *statePtr, int *errorCodePtr);
static int		WaitForSocketEvent(TcpState *statePtr, int events,
static int		WaitForSocketEvent(SocketInfo *infoPtr, int events,
			    int *errorCodePtr);
static void		AddSocketInfoFd(TcpState *statePtr,  SOCKET socket);
static int		FindFDInList(TcpState *statePtr, SOCKET socket);
static DWORD WINAPI	SocketThread(LPVOID arg);
static void		TcpThreadActionProc(ClientData instanceData,
			    int action);
static int		TcpCloseProc(void *, Tcl_Interp *);

static Tcl_EventCheckProc	SocketCheckProc;
static Tcl_EventProc		SocketEventProc;
static Tcl_EventSetupProc	SocketSetupProc;
static Tcl_DriverBlockModeProc	TcpBlockModeProc;
static Tcl_DriverClose2Proc	TcpClose2Proc;
static Tcl_DriverBlockModeProc	TcpBlockProc;
static Tcl_DriverCloseProc	TcpCloseProc;
static Tcl_DriverSetOptionProc	TcpSetOptionProc;
static Tcl_DriverGetOptionProc	TcpGetOptionProc;
static Tcl_DriverInputProc	TcpInputProc;
static Tcl_DriverOutputProc	TcpOutputProc;
static Tcl_DriverWatchProc	TcpWatchProc;
static Tcl_DriverGetHandleProc	TcpGetHandleProc;

/*
 * This structure describes the channel type structure for TCP socket
 * based IO:
 * based IO.
 */

static const Tcl_ChannelType tcpChannelType = {
    "tcp",			/* Type name. */
    TCL_CHANNEL_VERSION_5,	/* v5 channel */
    NULL,		/* Close proc. */
    TcpInputProc,		/* Input proc. */
    TcpOutputProc,		/* Output proc. */
    NULL,			/* Seek proc. */
    TcpSetOptionProc,		/* Set option proc. */
    TcpGetOptionProc,		/* Get option proc. */
    TcpWatchProc,		/* Initialize notifier. */
    TcpGetHandleProc,		/* Get OS handles out of channel. */
    TcpClose2Proc,		/* Close2 proc. */
    TcpBlockModeProc,		/* Set blocking or non-blocking mode.*/
    NULL,			/* flush proc. */
    NULL,			/* handler proc. */
    NULL,			/* wide seek proc. */
    TcpThreadActionProc,	/* thread action proc. */
    NULL			/* truncate proc. */
static Tcl_ChannelType tcpChannelType = {
    "tcp",		    /* Type name. */
    TCL_CHANNEL_VERSION_5,  /* v5 channel */
    TcpCloseProc,	    /* Close proc. */
    TcpInputProc,	    /* Input proc. */
    TcpOutputProc,	    /* Output proc. */
    NULL,		    /* Seek proc. */
    TcpSetOptionProc,	    /* Set option proc. */
    TcpGetOptionProc,	    /* Get option proc. */
    TcpWatchProc,	    /* Set up notifier to watch this channel. */
    TcpGetHandleProc,	    /* Get an OS handle from channel. */
    NULL,		    /* close2proc. */
    TcpBlockProc,	    /* Set socket into (non-)blocking mode. */
    NULL,		    /* flush proc. */
    NULL,		    /* handler proc. */
    NULL,		    /* wide seek proc */
    TcpThreadActionProc,    /* thread action proc */
    NULL,		    /* truncate */
};

/*
 *----------------------------------------------------------------------
 *
 * InitSockets --
 *
 *	Initialize the socket module.  If winsock startup is successful,
 *	registers the event window for the socket notifier code.
 *
 *	Assumes socketMutex is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Initializes winsock, registers a new window class and creates a
 *	window for use in asynchronous socket notification.
 *
 *----------------------------------------------------------------------
 */

static void
InitSockets(void)
{
    DWORD id;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);

    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, (ClientData) NULL);

/*
	/*
 * The following variable holds the network name of this host.
 */
	 * Create the async notification window with a new class. We must
	 * create a new class to avoid a Windows 95 bug that causes us to get
	 * the wrong message number for socket events if the message window is
	 * a subclass of a static control.
	 */

	windowClass.style = 0;
	windowClass.cbClsExtra = 0;
	windowClass.cbWndExtra = 0;
	windowClass.hInstance = TclWinGetTclInstance();
	windowClass.hbrBackground = NULL;
	windowClass.lpszMenuName = NULL;
	windowClass.lpszClassName = "TclSocket";
static TclInitProcessGlobalValueProc InitializeHostName;
static ProcessGlobalValue hostName =
	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};

/*
	windowClass.lpfnWndProc = SocketProc;
	windowClass.hIcon = NULL;
	windowClass.hCursor = NULL;

	if (!RegisterClassA(&windowClass)) {
	    TclWinConvertError(GetLastError());
	    goto initFailure;
	}

    }

    /*
 * Simple wrapper round the SendMessage syscall.
 */
     * Check for per-thread initialization.
     */

#define SendSelectMessage(tsdPtr, message, payload)     \
    SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT,          \
    if (tsdPtr == NULL) {
	tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr->pendingSocketInfo = NULL;
	tsdPtr->socketList = NULL;
	tsdPtr->hwnd       = NULL;
                (WPARAM) (message), (LPARAM) (payload))


/*
	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);

	/*
 * Address print debug functions
 */
#if 0
void
printaddrinfo(
	 * 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 */
	}

    struct addrinfo *ai,
    char *prefix)
{
	Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
    }
    return;

    char host[NI_MAXHOST], port[NI_MAXSERV];

  initFailure:
    TclpFinalizeSockets();
    initialized = -1;
    return;
}
    getnameinfo(ai->ai_addr, ai->ai_addrlen,
	    host, sizeof(host), port, sizeof(port),
	    NI_NUMERICHOST|NI_NUMERICSERV);
}

void
printaddrinfolist(
    struct addrinfo *addrlist,

/*
 *----------------------------------------------------------------------
 *
 * SocketsEnabled --
 *
 *	Check that the WinSock was successfully initialized.
 *
 * Results:
 *	1 if it is.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
    char *prefix)
SocketsEnabled(void)
{
    struct addrinfo *ai;

    for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
	printaddrinfo(ai, prefix);
    }
}
    int enabled;
    Tcl_MutexLock(&socketMutex);
    enabled = (initialized == 1);
    Tcl_MutexUnlock(&socketMutex);
    return enabled;
}


/*
 *----------------------------------------------------------------------
 *
 * SocketExitHandler --
 *
 *	Callback invoked during exit clean up to delete the socket
 *	communication window and to release the WinSock DLL.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

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.
     */

#endif

    TclpFinalizeSockets();
    UnregisterClass("TclSocket", TclWinGetTclInstance());
    initialized = 0;
    Tcl_MutexUnlock(&socketMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * InitializeHostName --
 * TclpFinalizeSockets --
 *
 *	This routine sets the process global value of the name of the local
 *	This function is called from Tcl_FinalizeThread to finalize the
 *	host on which the process is running.
 *	platform specific socket subsystem. Also, it may be called from within
 *	this module to cleanup the state if unable to initialize the sockets
 *	subsystem.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the event source and destroys the socket thread.
 *
 *----------------------------------------------------------------------
 */

void
InitializeHostName(
TclpFinalizeSockets(void)
    char **valuePtr,
    size_t *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    WCHAR wbuf[256];
    DWORD length = sizeof(wbuf)/sizeof(WCHAR);
    Tcl_DString ds;
    ThreadSpecificData *tsdPtr;

    Tcl_DStringInit(&ds);
    if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) {
	/*
	 * Convert string from native to UTF then change to lowercase.
	 */

    tsdPtr = (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
	Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, -1, &ds));

    if (tsdPtr != NULL) {
    } else {
	if (TclpHasSockets(NULL) == TCL_OK) {
	    /*
	if (tsdPtr->socketThread != NULL) {
	    if (tsdPtr->hwnd != NULL) {
		if (PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0)) {
		    /*
	     * The buffer size of 256 is recommended by the MSDN page that
	     * documents gethostname() as being always adequate.
	     */

		     * Wait for the thread to exit. This ensures that we are
		     * completely cleaned up before we leave this function.
		     */
		    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
	    Tcl_DString inDs;

		}
	    Tcl_DStringInit(&inDs);
	    Tcl_DStringSetLength(&inDs, 256);
	    if (gethostname(Tcl_DStringValue(&inDs),
		    Tcl_DStringLength(&inDs)) == 0) {
		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
			&ds);
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

		tsdPtr->hwnd = NULL;
	    }
	    CloseHandle(tsdPtr->socketThread);
	    tsdPtr->socketThread = NULL;
	}
	if (tsdPtr->readyEvent != NULL) {
    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
	    CloseHandle(tsdPtr->readyEvent);
	    tsdPtr->readyEvent = NULL;
    Tcl_DStringFree(&ds);
}

	}
	if (tsdPtr->socketListLock != NULL) {
	    CloseHandle(tsdPtr->socketListLock);
	    tsdPtr->socketListLock = NULL;
	}
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetHostName --
	Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
 *
 *	Returns the name of the local host.
 *
 * Results:
 *	A string containing the network name for this machine, or an empty
 *	string if we can't figure out the name. The caller must not modify or
 *	free this string.
 *
 * Side effects:
 *	Caches the name to return for future calls.
 *
 *----------------------------------------------------------------------
 */

    }
const char *
Tcl_GetHostName(void)
{
    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
}

/*
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *
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
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

611
612
613
614



615
616


617
618
619
620







621
622
623
624
625
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
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
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
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
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
595
596
597
598

599
600







601




602



603
604
605
606

607

608
609
610
611

612

613
614
615
616
617




618
619
620
621
622
623
624



625
626
627
628





629



630
631



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



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


756
757










758


759






760





761
































































































762
763


764































































































765






766





767









768
769
770
771
772
773
774
775







-
-
+
+







-
+

-
+
-
-
-
+





-
+





-
+
+
+

+
+
-
+

-
-
-
-
+
-



-
-
-
-
-
+
-
-
-
+
+

-
-
+
+
-
-
-
-
+
+
+
+
+
-
-
-

-
-
+
-
-
-





-
+

-
-
+
+


-
+


-
+




-
-
-
-
+
+
+
+
-
-

+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
+


+
-
+
-
+
+


-
+
-





-
-
-
-
+
+
+
+

+
+
-
-
-
+
+
+

-
-
-
-
-
+
-
-
-
+

-
-
-
+
+
+


+
+
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
+

-
-
-
-
-
-
-
-
+
+
+
+
-
-
-

-
+


-
+


+
-
+
-
-
+
-
-
+
-
-

-
+
-
-
-
+
-
-
-
-
+
+

-
+

+
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-

-
-
+
+
-
-
+
-
-
-
+
+
-
-
-
+
+

-
+

-
-
-
-
+
-

-
-
+
+
-
+

-
-
+
-
-
-
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
+
-
-
-
-

+
-
-
-
+
+
+
+
-
-
-
+
-
-
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
+
-
-
-
+

-
+
-
-
-
+
+

-
+
-
-
-
+
+

-
-
-
-
-
+
+

+





-
+

-
-
+


-
-
-
+


-
+





-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
+







    InitSockets();
    Tcl_MutexUnlock(&socketMutex);

    if (SocketsEnabled()) {
	return TCL_OK;
    }
    if (interp != NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"sockets are not available on this system", -1));
	Tcl_AppendResult(interp, "sockets are not available on this system",
		NULL);
    }
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeSockets --
 * SocketSetupProc --
 *
 *	This function is called from Tcl_FinalizeThread to finalize the
 *	This function is invoked before Tcl_DoOneEvent blocks waiting for an
 *	platform specific socket subsystem. Also, it may be called from within
 *	this module to cleanup the state if unable to initialize the sockets
 *	subsystem.
 *	event.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Deletes the event source and destroys the socket thread.
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
TclpFinalizeSockets(void)
SocketSetupProc(
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    SocketInfo *infoPtr;
    Tcl_Time blockTime = { 0, 0 };
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Careful! This is a finalizer!
     */

    if (!(flags & TCL_FILE_EVENTS)) {
    if (tsdPtr == NULL) {
	return;
    }

    if (tsdPtr->socketThread != NULL) {
	if (tsdPtr->hwnd != NULL) {
	    PostMessageW(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.
	     */
     * Check to see if there is a ready socket.	 If so, poll.
     */

	    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
	    tsdPtr->hwnd = NULL;
    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
	}
	CloseHandle(tsdPtr->socketThread);
	tsdPtr->socketThread = NULL;
    }
	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->readyEvents & infoPtr->watchEvents) {
	    Tcl_SetMaxBlockTime(&blockTime);
	    break;
	}
    if (tsdPtr->readyEvent != NULL) {
	CloseHandle(tsdPtr->readyEvent);
	tsdPtr->readyEvent = NULL;
    }
    if (tsdPtr->socketListLock != NULL) {
	CloseHandle(tsdPtr->socketListLock);
    SetEvent(tsdPtr->socketListLock);
	tsdPtr->socketListLock = NULL;
    }
    Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * TcpBlockModeProc --
 * SocketCheckProc --
 *
 *	This function is invoked by the generic IO level to set blocking and
 *	nonblocking mode on a TCP socket based channel.
 *	This function is called by Tcl_DoOneEvent to check the socket event
 *	source for events.
 *
 * Results:
 *	0 if successful, errno when failed.
 *	None.
 *
 * Side effects:
 *	Sets the device into blocking or nonblocking mode.
 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static int
TcpBlockModeProc(
    ClientData instanceData,	/* Socket state. */
    int mode)			/* The mode to set. Can be one of
static void
SocketCheckProc(
    ClientData data,		/* Not used. */
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
				 * TCL_MODE_BLOCKING or
				 * TCL_MODE_NONBLOCKING. */
{
    SocketInfo *infoPtr;
    SocketEvent *evPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TcpState *statePtr = (TcpState *)instanceData;

    if (mode == TCL_MODE_NONBLOCKING) {
	SET_BITS(statePtr->flags, TCP_NONBLOCKING);

    if (!(flags & TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready sockets that don't already have events
     * queued (caused by persistent states that won't generate WinSock
     * events).
     */

    } else {
        CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
    }
    return 0;
    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
	    infoPtr = infoPtr->nextPtr) {
	if ((infoPtr->readyEvents & infoPtr->watchEvents)
		&& !(infoPtr->flags & SOCKET_PENDING)) {
	    infoPtr->flags |= SOCKET_PENDING;
	    evPtr = (SocketEvent *) ckalloc(sizeof(SocketEvent));
	    evPtr->header.proc = SocketEventProc;
	    evPtr->socket = infoPtr->socket;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
    SetEvent(tsdPtr->socketListLock);
}

/*
 *----------------------------------------------------------------------
 *
 * WaitForConnect --
 * SocketEventProc --
 *
 *	Check the state of an async connect process. If a connection attempt
 *	terminated, process it, which may finalize it or may start the next
 *	attempt. If a connect error occures, it is saved in
 *	statePtr->connectError to be reported by 'fconfigure -error'.
 *
 *	There are two modes of operation, defined by errorCodePtr:
 *	 *  non-NULL: Called by explicite read/write command. Block if socket
 *	This function is called by Tcl_ServiceEvent when a socket event
 *	    is blocking.
 *	    May return two error codes:
 *	     *	EWOULDBLOCK: if connect is still in progress
 *	     *	ENOTCONN: if connect failed. This would be the error message
 *	reaches the front of the event queue. This function is responsible for
 *		of a rect or sendto syscall so this is emulated here.
 *	 *  Null: Called by a backround operation. Do not block and don't
 *	    return any error code.
 *	notifying the generic channel code.
 *
 * Results:
 *	Returns 1 if the event was handled, meaning it should be removed from
 * 	0 if the connection has completed, -1 if still in progress or there is
 *	the queue. Returns 0 if the event was not handled, meaning it should
 * 	an error.
 *	stay on the queue. The only time the event isn't handled is if the
 *	TCL_FILE_EVENTS flag bit isn't set.
 *
 * Side effects:
 *	Processes socket events off the system queue. May process
 *	Whatever the channel callback functions do.
 *	asynchroneous connect.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForConnect(
    TcpState *statePtr,		/* State of the socket. */
    int *errorCodePtr)		/* Where to store errors? A passed
				 * null-pointer activates background mode. */
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 result;
    int oldMode;
    ThreadSpecificData *tsdPtr;
    int mask = 0;
    int events;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Check if an async connect failed already and error reporting is
     * demanded, return the error ENOTCONN.
     */

    if (!(flags & TCL_FILE_EVENTS)) {
    if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
	*errorCodePtr = ENOTCONN;
	return -1;
	return 0;
    }

    /*
     * Check if an async connect is running. If not return ok

    /*
     * Find the specified socket on the socket list.
     */

    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
    if (!GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
	return 0;
    }

	    infoPtr = infoPtr->nextPtr) {
	if (infoPtr->socket == eventPtr->socket) {
	    break;
	}
    }
    SetEvent(tsdPtr->socketListLock);

    /*
     * In socket test mode do not continue with the connect
     * Exceptions are:
     * - Call by recv/send and blocking socket
     *   (errorCodePtr != NULL && !GOT_BITS(flags, TCP_NONBLOCKING))
     * - Call by the event queue (errorCodePtr == NULL)
     * Discard events that have gone stale.
     */

    if (GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)
	    && errorCodePtr != NULL
            && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
	*errorCodePtr = EWOULDBLOCK;
	return -1;
    }


    if (!infoPtr) {
	return 1;
    }
    /*
     * Be sure to disable event servicing so we are truly modal.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);
    infoPtr->flags &= ~SOCKET_PENDING;

    /*
     * Loop in the blocking case until the connect signal is present
     * Handle connection requests directly.
     */

    if (infoPtr->readyEvents & FD_ACCEPT) {
    while (1) {
	TcpAccept(infoPtr);
	/*
	 * Get the statePtr lock.
	return 1;
	 */

    }
	tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
    /*
         * Check for connect event.
         */

     * Mask off unwanted events and compute the read/write mask so we can
	if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
	    /*
             * Consume the connect event.
             */
     * notify the channel.
     */

	    CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);
    events = infoPtr->readyEvents & infoPtr->watchEvents;

    if (events & FD_CLOSE) {
	    /*
	     * For blocking sockets and foreground processing, disable async
	     * connect as we continue now synchoneously.
	     */
	/*
	 * If the socket was closed and the channel is still interested in
	 * read events, then we need to ensure that we keep polling for this
	 * event until someone does something with the channel. Note that we
	 * 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.
	 */

	    if (errorCodePtr != NULL &&
		    !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
		CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
	    }

	    /*
             * Free list lock.
	Tcl_Time blockTime = { 0, 0 };
	Tcl_SetMaxBlockTime(&blockTime);
             */

	mask |= TCL_READABLE|TCL_WRITABLE;
	    SetEvent(tsdPtr->socketListLock);

	    /*
    } else if (events & FD_READ) {
	/*
	     * Continue connect. If switched to synchroneous connect, the
	     * connect is terminated.
	     */
	 * Throw the readable event if an async connect failed.
	 */

	    result = TcpConnect(NULL, statePtr);
	if (infoPtr->lastError) {

	    /*
             * Restore event service mode.
             */

	    mask |= TCL_READABLE;
	    (void) Tcl_SetServiceMode(oldMode);

	    /*
	     * Check for Succesfull connect or async connect restart
	} else {
	    fd_set readFds;
	     */
	    struct timeval timeout;

	    if (result == TCL_OK) {
		/*
	    /*
		 * Check for async connect restart (not possible for
		 * foreground blocking operation)
		 */
	     * We must check to see if data is really available, since someone
	     * could have consumed the data in the meantime. Turn off async
	     * notification so select will work correctly. If the socket is still
	     * readable, notify the channel driver, otherwise reset the async
	     * select handler and keep waiting.
	     */

		if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
		    if (errorCodePtr != NULL) {
			*errorCodePtr = EWOULDBLOCK;
		    }
		    return -1;
		}
		return 0;
	    }

		    (WPARAM) UNSELECT, (LPARAM) infoPtr);
	    /*
	     * Connect finally failed. For foreground operation return
	     * ENOTCONN.
	     */

	    FD_ZERO(&readFds);
	    if (errorCodePtr != NULL) {
		*errorCodePtr = ENOTCONN;
	    }
	    FD_SET(infoPtr->socket, &readFds);
	    timeout.tv_usec = 0;
	    timeout.tv_sec = 0;

	    return -1;
	}

	    if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
        /*
         * Free list lock.
		mask |= TCL_READABLE;
	    } else {
         */

        SetEvent(tsdPtr->socketListLock);

		infoPtr->readyEvents &= ~(FD_READ);
		SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
			(WPARAM) SELECT, (LPARAM) infoPtr);
	    }
	/*
	 * Background operation returns with no action as there was no connect
	 * event
	 */

	}
	if (errorCodePtr == NULL) {
	    return -1;
	}
    }

	/*
    /*
	 * A non blocking socket waiting for an asynchronous connect
	 * returns directly the error EWOULDBLOCK
	 */
     * writable event
     */

	if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
    if (events & FD_WRITE) {
	    *errorCodePtr = EWOULDBLOCK;
	    return -1;
	}
	mask |= TCL_WRITABLE;
    }

	/*
	 * Wait until something happens.
	 */

	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
    if (mask) {
	Tcl_NotifyChannel(infoPtr->channel, mask);
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpInputProc --
 * TcpBlockProc --
 *
 *	This function is invoked by the generic IO level to read input from a
 *	TCP socket based channel.
 *	Sets a socket into blocking or non-blocking mode.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains the POSIX error code on error, or zero if no error
 *	occurred.
 *	0 if successful, errno if there was an error.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(
    ClientData instanceData,	/* Socket state. */
TcpBlockProc(
    ClientData instanceData,	/* The socket to block/un-block. */
    char *buf,			/* Where to store data read. */
    int bufSize,		/* How much space is available in the
				 * buffer? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int bytesRead;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    int mode)			/* TCL_MODE_BLOCKING or
    *errorCodePtr = 0;

				 * TCL_MODE_NONBLOCKING. */
    /*
     * 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()) {
	*errorCodePtr = EFAULT;
	return -1;
    }

    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    /*
     * First check to see if EOF was already detected, to prevent calling the
     * socket stack after the first time EOF is detected.
     */

    if (GOT_BITS(statePtr->flags, SOCKET_EOF)) {
	return 0;
    }

    /*
     * Check if there is an async connect running.
     * For blocking sockets terminate connect, otherwise do one step.
     * For a non blocking socket return EWOULDBLOCK if connect not terminated
     */

    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }

    /*
     * No EOF, and it is connected, so try to read more from the socket. Note
     * that we clear the FD_READ bit because read events are level triggered
     * so a new event will be generated if there is still data available to be
     * read. We have to simulate blocking behavior here since we are always
     * using non-blocking sockets.
     */

    while (1) {
	SendSelectMessage(tsdPtr, UNSELECT, statePtr);

	/*
         * Single fd operation: this proc is only called for a connected
         * socket.
         */

	bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0);
	CLEAR_BITS(statePtr->readyEvents, FD_READ);

	/*
	 * Check for end-of-file condition or successful read.
	 */

	if (bytesRead == 0) {
	    SET_BITS(statePtr->flags, SOCKET_EOF);
	}
	if (bytesRead != SOCKET_ERROR) {
	    break;
	}

	/*
	 * If an error occurs after the FD_CLOSE has arrived, then ignore the
	 * error and report an EOF.
	 */

	if (GOT_BITS(statePtr->readyEvents, FD_CLOSE)) {
	    SET_BITS(statePtr->flags, SOCKET_EOF);
	    bytesRead = 0;
	    break;
	}

	error = WSAGetLastError();

	/*
	 * If an RST comes, then ignore the error and report an EOF just like
	 * on unix.
	 */

	if (error == WSAECONNRESET) {
	    SET_BITS(statePtr->flags, SOCKET_EOF);
	    bytesRead = 0;
	    break;
	}

	/*
	 * Check for error condition or underflow in non-blocking case.
	 */

	if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)
                || (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(statePtr, FD_READ|FD_CLOSE, errorCodePtr)) {
	    bytesRead = -1;
	    break;
	}
    }


    if (mode == TCL_MODE_NONBLOCKING) {
    SendSelectMessage(tsdPtr, SELECT, statePtr);

	infoPtr->flags |= SOCKET_ASYNC;
    return bytesRead;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpOutputProc --
 *
 *	This function is called by the generic IO level to write data to a
 *	socket based channel.
 *
 * Results:
 *	The number of bytes written or -1 on failure.
 *
 * Side effects:
 *	Produces output on the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpOutputProc(
    ClientData instanceData,	/* Socket state. */
    const char *buf,		/* The data buffer. */
    int toWrite,		/* How many bytes to write? */
    int *errorCodePtr)		/* Where to store error code. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int written;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * 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()) {
	*errorCodePtr = EFAULT;
	return -1;
    }

    /*
     * Check if there is an async connect running.
     * For blocking sockets terminate connect, otherwise do one step.
     * For a non blocking socket return EWOULDBLOCK if connect not terminated
     */

    if (WaitForConnect(statePtr, errorCodePtr) != 0) {
	return -1;
    }

    while (1) {
	SendSelectMessage(tsdPtr, UNSELECT, statePtr);

	/*
         * Single fd operation: this proc is only called for a connected
         * socket.
         */

	written = send(statePtr->sockets->fd, buf, toWrite, 0);
	if (written != SOCKET_ERROR) {
	    /*
	     * Since Windows won't generate a new write event until we hit an
	     * overflow condition, we need to force the event loop to poll
	     * until the condition changes.
	     */

	    if (GOT_BITS(statePtr->watchEvents, FD_WRITE)) {
		Tcl_Time blockTime = { 0, 0 };

		Tcl_SetMaxBlockTime(&blockTime);
	    }
	    break;
	}

	/*
	 * Check for error condition or overflow. In the event of overflow, we
	 * need to clear the FD_WRITE flag so we can detect the next writable
	 * event. Note that Windows only sends a new writable event after a
	 * send fails with WSAEWOULDBLOCK.
	 */

	error = WSAGetLastError();
	if (error == WSAEWOULDBLOCK) {
	    CLEAR_BITS(statePtr->readyEvents, FD_WRITE);
	    if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
		*errorCodePtr = EWOULDBLOCK;
		written = -1;
		break;
	    }
	} else {
    } else {
	    TclWinConvertError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    written = -1;
	    break;
	}

	infoPtr->flags &= ~(SOCKET_ASYNC);
	/*
	 * In the blocking case, wait until the file becomes writable or
	 * closed and try again.
	 */

    }
	if (!WaitForSocketEvent(statePtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
	    written = -1;
	    break;
	}
    }

    SendSelectMessage(tsdPtr, SELECT, statePtr);

    return written;
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpCloseProc --
 *
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




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
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
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
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
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
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
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
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
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
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
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832







-
+

-
+

















-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-




-



-
-
-
-
-
+
+
+
+
-
-


-
+

-
-
+
-
-










-
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+


-
+


-
+





-
-
-
-
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+


+
+
+
+
-
+
+
+
+
+
+
+
+


+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

static int
TcpCloseProc(
    ClientData instanceData,	/* The socket to close. */
    TCL_UNUSED(Tcl_Interp *))
    Tcl_Interp *interp)		/* Unused. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    /* TIP #218 */
    int errorCode = 0;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&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()) {
	/*
	 * Clean up the OS socket handle. The default Windows setting for a
	 * socket is SO_DONTLINGER, which does a graceful shutdown in the
	 * background.
	 */

	while (statePtr->sockets != NULL) {
	    TcpFdList *thisfd = statePtr->sockets;

	    statePtr->sockets = thisfd->next;
	    if (closesocket(thisfd->fd) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		errorCode = Tcl_GetErrno();
	    }
	if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
	    TclWinConvertWSAError((DWORD) WSAGetLastError());
	    errorCode = Tcl_GetErrno();
	}
	    Tcl_Free(thisfd);
	}
    }

    if (statePtr->addrlist != NULL) {
        freeaddrinfo(statePtr->addrlist);
    }
    if (statePtr->myaddrlist != NULL) {
        freeaddrinfo(statePtr->myaddrlist);
    }

    /*
     * Clear an eventual tsd info list pointer.
     *
     * This may be called, if an async socket connect fails or is closed
     * between connect and thread action callback.
     */

    if (tsdPtr->pendingTcpState != NULL
	    && tsdPtr->pendingTcpState == statePtr) {
	/*
         * Get infoPtr lock, because this concerns the notifier thread.
    if (tsdPtr->pendingSocketInfo != NULL
	    && tsdPtr->pendingSocketInfo == infoPtr) {

	/* get infoPtr lock, because this concerns the notifier thread */
         */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	tsdPtr->pendingTcpState = NULL;
	tsdPtr->pendingSocketInfo = NULL;

	/*
         * Free list lock.
	/* Free list lock */
         */

	SetEvent(tsdPtr->socketListLock);
    }

    /*
     * TIP #218. Removed the code removing the structure from the global
     * socket list. This is now done by the thread action callbacks, and only
     * there. This happens before this code is called. We can free without
     * fear of damaging the list.
     */

    Tcl_Free(statePtr);
    ckfree((char *) infoPtr);
    return errorCode;
}

/*
 *----------------------------------------------------------------------
 *
 * NewSocketInfo --
 *
 *	This function allocates and initializes a new SocketInfo structure.
 *
 * Results:
 *	Returns a newly allocated SocketInfo.
 *
 * Side effects:
 *	None, except for allocation of memory.
 *
 *----------------------------------------------------------------------
 */

static SocketInfo *
NewSocketInfo(
    SOCKET socket)
{
    SocketInfo *infoPtr;
    /* ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); */

    infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
    infoPtr->channel = 0;
    infoPtr->socket = socket;
    infoPtr->flags = 0;
    infoPtr->watchEvents = 0;
    infoPtr->readyEvents = 0;
    infoPtr->selectEvents = 0;
    infoPtr->acceptEventCount = 0;
    infoPtr->acceptProc = NULL;
    infoPtr->acceptProcData = NULL;
    infoPtr->lastError = 0;

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */

    infoPtr->nextPtr = NULL;

    return infoPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CreateSocket --
 *
 *	This function opens a new socket and initializes the SocketInfo
 *	structure.
 *
 * Results:
 *	Returns a new SocketInfo, or NULL with an error in interp.
 *
 * Side effects:
 *	None, except for allocation of memory.
 *
 *----------------------------------------------------------------------
 */

static SocketInfo *
CreateSocket(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Name of host on which to open port. */
    int server,			/* 1 if socket should be a server socket, else
				 * 0 for a client socket. */
    const char *myaddr,		/* Optional client-side address */
    int myport,			/* Optional client-side port */
    int async)			/* If nonzero, connect client socket
				 * asynchronously. */
{
    u_long flag = 1;		/* Indicates nonblocking mode. */
    struct sockaddr_in sockaddr;   /* Socket address */
    struct sockaddr_in mysockaddr; /* Socket address for client */
    SOCKET sock = INVALID_SOCKET;
    SocketInfo *infoPtr=NULL;	/* The returned value. */
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    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 (!CreateSocketAddress(&sockaddr, host, port, server)) {
	goto error;
    }
    if ((myaddr != NULL || myport != 0) &&
	    !CreateSocketAddress(&mysockaddr, myaddr, myport, 1)) {
	goto error;
    }

    sock = socket(AF_INET, SOCK_STREAM, 0);
    if (sock == INVALID_SOCKET) {
	goto error;
    }

    /*
     * 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);

    if (server) {
	/*
	 * 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, (SOCKADDR *) &sockaddr, sizeof(SOCKADDR_IN))
		== SOCKET_ERROR) {
	    goto error;
	}

	/*
	 * 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) {
	    goto error;
	}

	/*
	 * Add this socket to the global list of sockets.
	 */

	infoPtr = NewSocketInfo(sock);

	/*
	 * Set up the select mask for connection request events.
	 */

	infoPtr->selectEvents = FD_ACCEPT;
	infoPtr->watchEvents |= FD_ACCEPT;

	/*
	 * Register for interest in events in the select mask. Note that this
	 * automatically places the socket into non-blocking mode.
	 */

	ioctlsocket(sock, (long) FIONBIO, &flag);
	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
		(LPARAM) infoPtr);

    } else {
	/*
	 * Try to bind to a local port, if specified.
	 */

	if (myaddr != NULL || myport != 0) {
	    if (bind(sock, (SOCKADDR *) &mysockaddr, sizeof(SOCKADDR_IN))
		    == SOCKET_ERROR) {
		goto error;
	    }
	}

	/*
	 * Allocate socket info structure
	 */

	infoPtr = NewSocketInfo(sock);

	/*
	 * Set the socket into nonblocking mode if the connect should be done
	 * in the background. Activate connect notification.
	 */

	if (async) {

	    /* get infoPtr lock */
	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	    /*
	     * Buffer new infoPtr in the tsd memory as long as it is not in
	     * the info list. This allows the event procedure to process the
	     * event.
	     * Bugfig for 336441ed59 to not ignore notifications until the
	     * infoPtr is in the list..
	     */

	    tsdPtr->pendingSocketInfo = infoPtr;

	    /*
	     * Set connect mask to connect events
	     * This is activated by a SOCKET_SELECT message to the notifier
	     * thread.
	     */

	    infoPtr->selectEvents |= FD_CONNECT | FD_READ | FD_WRITE | FD_CLOSE;
	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;

	    /*
	     * Free list lock
	     */
	    SetEvent(tsdPtr->socketListLock);

	    /*
	     * Activate accept notification and put in async mode
	     * Bug 336441ed59: activate notification before connect
	     * so we do not miss a notification of a fialed connect.
	     */
	    ioctlsocket(sock, (long) FIONBIO, &flag);
	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	            (LPARAM) infoPtr);

	}

	/*
	 * Attempt to connect to the remote socket.
	 */

	if (connect(sock, (SOCKADDR *) &sockaddr,
		sizeof(SOCKADDR_IN)) == SOCKET_ERROR) {
	    TclWinConvertWSAError((DWORD) WSAGetLastError());
	    if (Tcl_GetErrno() != EWOULDBLOCK) {
		goto error;
	    }

	    /*
	     * The connection is progressing in the background.
	     */

	} else {

	    /*
	     * 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;

	    /*
	     * Register for interest in events in the select mask. Note that this
	     * automatically places the socket into non-blocking mode.
	     */

	    ioctlsocket(sock, (long) FIONBIO, &flag);
	    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
		    (LPARAM) infoPtr);
	}
    }

    return infoPtr;

  error:
    TclWinConvertWSAError((DWORD) WSAGetLastError());
    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
    }
    if (infoPtr != NULL) {
	/*
	 * Free the allocated socket info structure and close the socket
	 */
	TcpCloseProc(infoPtr, interp);
    } else if (sock != INVALID_SOCKET) {
	/*
	 * No socket structure jet - just close
	 */
	closesocket(sock);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * 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 */
    int willBind)		/* Is this an address to bind() to or
				 * to connect() to? */
{
    struct addrinfo hints, *resPtr = NULL;
    char *native;
    Tcl_DString ds;
    int result;

    if (host == NULL) {
	sockaddrPtr->sin_family = AF_INET;
	sockaddrPtr->sin_addr.s_addr = INADDR_ANY;
    addPort:
	sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
	return 1;
    }

    (void) memset(&hints, 0, sizeof(struct addrinfo));
    hints.ai_family = AF_INET;
    hints.ai_socktype = SOCK_STREAM;
    if (willBind) {
	hints.ai_flags |= AI_PASSIVE;
    }

    /*
     * Note that getaddrinfo() *is* thread-safe. If a platform doesn't get
     * that right, it shouldn't use this part of the code.
     */

    native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
    result = getaddrinfo(native, NULL, &hints, &resPtr);
    Tcl_DStringFree(&ds);
    if (result == 0) {
	memcpy(sockaddrPtr, resPtr->ai_addr, sizeof(struct sockaddr_in));
	freeaddrinfo(resPtr);
	goto addPort;
    }

    /*
     * errno corresponding result ...
     */

    switch (result) {
    case EAI_NONAME:
    case EAI_SERVICE:
#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
    case EAI_ADDRFAMILY:
#endif
#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
    case EAI_NODATA:
#endif
#ifdef	EHOSTUNREACH
	Tcl_SetErrno(EHOSTUNREACH);
	return 0;
#endif
    default:
#ifdef ENXIO
	Tcl_SetErrno(ENXIO);
#endif
	return 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * WaitForSocketEvent --
 *
 *	Waits until one of the specified events occurs on a socket.
 *
 * Results:
 *	Returns 1 on success or 0 on failure, with an error code in
 *	errorCodePtr.
 *
 * Side effects:
 *	Processes socket events off the system queue.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForSocketEvent(
    SocketInfo *infoPtr,	/* Information about this socket. */
    int events,			/* Events to look for. */
    int *errorCodePtr)		/* Where to store errors? */
{
    int result = 1;
    int oldMode;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);

    /*
     * Be sure to disable event servicing so we are truly modal.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);

    /*
     * Reset WSAAsyncSelect so we have a fresh set of events pending.
     * Don't do that if we are waiting for a connect as we may miss
     * a connect (bug 336441ed59).
     */

    if ( 0 == (events & FD_CONNECT) ) {
        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.
	 */

	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
    }

    (void) Tcl_SetServiceMode(oldMode);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpClient --
 *
 *	Opens a TCP client socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. An error message is returned in the
 *	interpreter on failure.
 *
 * Side effects:
 *	Opens a client socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpClient(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Host on which to open port. */
    const char *myaddr,		/* Client-side address */
    int myport,			/* Client-side port */
    int async)			/* If nonzero, should connect client socket
				 * asynchronously. */
{
    SocketInfo *infoPtr;
    char channelName[16 + TCL_INTEGER_SPACE];

    if (TclpHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * Create a new client socket and wrap it in a channel.
     */

    infoPtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
    if (infoPtr == NULL) {
	return NULL;
    }

    sprintf(channelName, "sock%" TCL_Z_MODIFIER "u", (size_t)infoPtr->socket);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) 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;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --
 *
 *	Creates a Tcl_Channel from an existing client TCP socket.
 *
 * Results:
 *	The Tcl_Channel wrapped around the preexisting TCP socket.
 *
 * Side effects:
 *	None.
 *
 * NOTE: Code contributed by Mark Diekhans (markd@grizzly.com)
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    ClientData sock)		/* The socket to wrap up into a channel. */
{
    SocketInfo *infoPtr;
    char channelName[16 + TCL_INTEGER_SPACE];
    ThreadSpecificData *tsdPtr;

    if (TclpHasSockets(NULL) != TCL_OK) {
	return NULL;
    }

    tsdPtr = (ThreadSpecificData *)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%" TCL_Z_MODIFIER "u", (size_t)infoPtr->socket);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpServer --
 *
 *	Opens a TCP server socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. An error message is returned in the
 *	interpreter on failure.
 *
 * Side effects:
 *	Opens a server socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpServer(
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Name of local host. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    ClientData acceptProcData)	/* Data for the callback. */
{
    SocketInfo *infoPtr;
    char channelName[16 + TCL_INTEGER_SPACE];

    if (TclpHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * Create a new client socket and wrap it in a channel.
     */

    infoPtr = CreateSocket(interp, port, host, 1, NULL, 0, 0);
    if (infoPtr == NULL) {
	return NULL;
    }

    infoPtr->acceptProc = acceptProc;
    infoPtr->acceptProcData = acceptProcData;

    sprintf(channelName, "sock%" TCL_Z_MODIFIER "u", (size_t)infoPtr->socket);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) 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;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpAccept --
 *
 *	Accept a TCP socket connection. This is called by SocketEventProc and
 *	it in turns calls the registered accept function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Invokes the accept proc which may invoke arbitrary Tcl code.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAccept(
    SocketInfo *infoPtr)	/* Socket to accept. */
{
    SOCKET newSocket;
    SocketInfo *newInfoPtr;
    SOCKADDR_IN addr;
    int len;
    char channelName[16 + TCL_INTEGER_SPACE];
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);

    /*
     * Accept the incoming connection request.
     */

    len = sizeof(SOCKADDR_IN);

    newSocket = accept(infoPtr->socket, (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.
     */

    if (newSocket == INVALID_SOCKET) {
	infoPtr->acceptEventCount = 0;
	infoPtr->readyEvents &= ~(FD_ACCEPT);

	SetEvent(tsdPtr->socketListLock);
	return;
    }

    /*
     * It is possible that more than one FD_ACCEPT has been sent, so an extra
     * count must be kept. Decrement the count, and reset the readyEvent bit
     * if the count is no longer > 0.
     */

    infoPtr->acceptEventCount--;

    if (infoPtr->acceptEventCount <= 0) {
	infoPtr->readyEvents &= ~(FD_ACCEPT);
    }

    SetEvent(tsdPtr->socketListLock);

    /*
     * Win-NT has a misfeature that sockets are inherited in child processes
     * by default. Turn off the inherit bit.
     */

    SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);

    /*
     * Allocate socket info structure
     */

    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%" TCL_Z_MODIFIER "u", (size_t)newInfoPtr->socket);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    (ClientData) 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.
     */

    if (infoPtr->acceptProc != NULL) {
	(infoPtr->acceptProc) (infoPtr->acceptProcData, newInfoPtr->channel,
		inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TcpClose2Proc --
 * TcpInputProc --
 *
 *	This function is called by the generic IO level to read data from a
 *	socket based channel.
 *
 * Results:
 *	The number of bytes read or -1 on error.
 *
 * Side effects:
 *	Consumes input from the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpInputProc(
    ClientData instanceData,	/* The socket state. */
    char *buf,			/* Where to store data. */
    int toRead,			/* Maximum number of bytes to read. */
    int *errorCodePtr)		/* Where to store error codes. */
{
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    int bytesRead;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * 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()) {
	*errorCodePtr = EFAULT;
	return -1;
    }

    /*
     * First check to see if EOF was already detected, to prevent calling the
     * socket stack after the first time EOF is detected.
     */

    if (infoPtr->flags & SOCKET_EOF) {
	return 0;
    }

    /*
     * Check to see if the socket is connected before trying to read.
     */

    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
	return -1;
    }

    /*
     * No EOF, and it is connected, so try to read more from the socket. Note
     * that we clear the FD_READ bit because read events are level triggered
     * so a new event will be generated if there is still data available to be
     * read. We have to simulate blocking behavior here since we are always
     * using non-blocking sockets.
     */

    while (1) {
	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
		(WPARAM) UNSELECT, (LPARAM) infoPtr);
	bytesRead = recv(infoPtr->socket, buf, toRead, 0);
	infoPtr->readyEvents &= ~(FD_READ);

	/*
	 * Check for end-of-file condition or successful read.
	 */

	if (bytesRead == 0) {
	    infoPtr->flags |= SOCKET_EOF;
	}
	if (bytesRead != SOCKET_ERROR) {
	    break;
	}

	/*
	 * If an error occurs after the FD_CLOSE has arrived, then ignore the
	 * error and report an EOF.
	 */

	if (infoPtr->readyEvents & FD_CLOSE) {
	    infoPtr->flags |= SOCKET_EOF;
	    bytesRead = 0;
	    break;
	}

	error = WSAGetLastError();

	/*
	 * If an RST comes, then ignore the error and report an EOF just like
	 * on unix.
	 */

	if (error == WSAECONNRESET) {
	    infoPtr->flags |= SOCKET_EOF;
	    bytesRead = 0;
	    break;
	}

	/*
	 * 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;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpOutputProc --
 *
 *	This function is called by the generic IO level to perform the channel
 *	type specific part of a half-close: namely, a shutdown() on a socket.
 *	This function is called by the generic IO level to write data to a
 *	socket based channel.
 *
 * Results:
 *	0 if successful, the value of errno if failed.
 *	The number of bytes written or -1 on failure.
 *
 * Side effects:
 *	Shuts down one side of the socket.
 *	Produces output on the socket.
 *
 *----------------------------------------------------------------------
 */

static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
TcpOutputProc(
    ClientData instanceData,	/* The socket state. */
    const char *buf,		/* Where to get data. */
    int toWrite,		/* Maximum number of bytes to write. */
    int *errorCodePtr)		/* Where to store error codes. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    int readError = 0;
    int writeError = 0;
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    int bytesWritten;
    DWORD error;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
	    TclThreadDataKeyGet(&dataKey);

    *errorCodePtr = 0;

    /*
     * 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.
     */
     * Shutdown the OS socket handle.

    if (!SocketsEnabled()) {
	*errorCodePtr = EFAULT;
	return -1;
    }

    /*
     * Check to see if the socket is connected before trying to write.
     */

    if ((infoPtr->flags & SOCKET_ASYNC_CONNECT)
	    && !WaitForSocketEvent(infoPtr, FD_CONNECT, errorCodePtr)) {
	return -1;
    }
    if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) {
	return TcpCloseProc(instanceData, interp);
    }

    /*

    while (1) {
	SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
		(WPARAM) UNSELECT, (LPARAM) infoPtr);

	bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
	if (bytesWritten != SOCKET_ERROR) {
	    /*
	     * Since Windows won't generate a new write event until we hit an
	     * overflow condition, we need to force the event loop to poll
	     * until the condition changes.
	     */

	    if (infoPtr->watchEvents & FD_WRITE) {
		Tcl_Time blockTime = { 0, 0 };
		Tcl_SetMaxBlockTime(&blockTime);
	    }
	    break;
	}

	/*
     * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
     * TCL_WRITABLE so this should never be called for a server socket.
     */
	 * Check for error condition or overflow. In the event of overflow, we
	 * need to clear the FD_WRITE flag so we can detect the next writable
	 * event. Note that Windows only sends a new writable event after a
	 * send fails with WSAEWOULDBLOCK.
	 */

    if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) {
	TclWinConvertError((DWORD) WSAGetLastError());
	readError = Tcl_GetErrno();
    }
    if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) {
	TclWinConvertError((DWORD) WSAGetLastError());
	writeError = Tcl_GetErrno();
    }
    return (readError != 0) ? readError : writeError;
	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;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpSetOptionProc --
 *
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
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







-
+


-
+

-
-
-
+









-
-
+





-
-
+
+














-
+

-
-
-
+
+

















-
+

-
-
-
+
+







 */

static int
TcpSetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    const char *optionName,	/* Name of the option to set. */
    TCL_UNUSED(const char *) /*value*/)		/* New value for option. */
    const char *value)		/* New value for option. */
{
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    TcpState *statePtr = instanceData;
    SocketInfo *infoPtr;
    SOCKET sock;
#else
    (void)instanceData;
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
#endif

    /*
     * 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()) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "winsock is not initialized", -1));
	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
	}
	return TCL_ERROR;
    }

#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
#error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
    sock = statePtr->sockets->fd;
    infoPtr = (SocketInfo *) instanceData;
    sock = infoPtr->socket;

    if (!strcasecmp(optionName, "-keepalive")) {
	BOOL val = FALSE;
	int boolVar, rtn;

	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (boolVar) {
	    val = TRUE;
	}
	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
		(const char *) &val, sizeof(BOOL));
	if (rtn != 0) {
	    TclWinConvertError(WSAGetLastError());
	    TclWinConvertWSAError(WSAGetLastError());
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set socket option: %s",
			Tcl_PosixError(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());
	    TclWinConvertWSAError(WSAGetLastError());
	    if (interp) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't set socket option: %s",
			Tcl_PosixError(interp)));
		Tcl_AppendResult(interp, "couldn't set socket option: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    }

    return Tcl_BadChannelOption(interp, optionName, "keepalive nagle");
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
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
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
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451

1452
1453
1454
1455


1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472





1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490


1491
1492

1493
1494
1495
1496

1497
1498
1499


1500
1501

1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513

1514
1515
1516
1517




1518
1519
1520
1521





1522
1523
1524
1525
1526
1527
1528
1529



1530
1531
1532
1533
1534
1535
1536
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







-
+
-










-
+






-
-
+
+
+
+

+

-
-
+









-
-
+




-
-
-
-
-
-
-
+
-
-
-
-
-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
+
+
-
-
-

-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
+
-
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
+
-
-
-
-
-


-
+
-
-

-
-
-
-
-
-
-
-
+
-
-
-
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
+
+
+
+
+














-
+

-
-
-
+
+








-
-
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
+
-
-
-
-
+
-
-
-
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
+


-


-
-
-
+
+
+







 *	Computes an option value for a TCP socket based channel, or a list of
 *	all options and their values.
 *
 *	Note: This code is based on code contributed by John Haxby.
 *
 * Results:
 *	A standard Tcl result. The value of the specified option or a list of
 *	all options and their values is returned in the supplied DString. Sets
 *	all options and their values is returned in the supplied DString.
 *	Error message if needed.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetOptionProc(
    ClientData instanceData,	/* Socket state. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL. */
    Tcl_Interp *interp,		/* For error reporting - can be NULL */
    const char *optionName,	/* Name of the option to retrieve the value
				 * for, or NULL to get all options and their
				 * values. */
    Tcl_DString *dsPtr)		/* Where to store the computed value;
				 * initialized by caller. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    char host[NI_MAXHOST], port[NI_MAXSERV];
    SocketInfo *infoPtr;
    SOCKADDR_IN sockname;
    SOCKADDR_IN peername;
    struct hostent *hostEntPtr;
    SOCKET sock;
    int size = sizeof(SOCKADDR_IN);
    size_t len = 0;
    int reverseDNS = 0;
#define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS"
    char buf[TCL_INTEGER_SPACE];

    /*
     * 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()) {
	if (interp) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "winsock is not initialized", -1));
	    Tcl_AppendResult(interp, "winsock is not initialized", NULL);
	}
	return TCL_ERROR;
    }

    /*
     * Go one step in async connect
     *
     * If any error is thrown save it as backround error to report eventually
     * below.
     */

    infoPtr = (SocketInfo *) instanceData;
    if (!GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)) {
	WaitForConnect(statePtr, NULL);
    }

    sock = statePtr->sockets->fd;
    sock = (int) infoPtr->socket;
    if (optionName != NULL) {
	len = strlen(optionName);
    }

    if ((len > 1) && (optionName[1] == 'e') &&
	    (strncmp(optionName, "-error", len) == 0)) {
	/*
         * Do not return any errors if async connect is running.
         */

	if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
		/*
		 * In case of a failed async connect, eventually report the
		 * connect error only once.  Do not report the system error,
		 * as this comes again and again.
		 */

		if (statePtr->connectError != 0) {
		    Tcl_DStringAppend(dsPtr,
			    Tcl_ErrnoMsg(statePtr->connectError), -1);
		    statePtr->connectError = 0;
		}
	    } else {
		/*
		 * Report an eventual last error of the socket system.
		 */

		int optlen;
	int optlen;
		int ret;
		DWORD err;

	DWORD err;
	int ret;
		/*
		 * Populate the err variable with a POSIX error
		 */

		optlen = sizeof(int);
		ret = getsockopt(sock, SOL_SOCKET, SO_ERROR,
			(char *)&err, &optlen);
	optlen = sizeof(int);
	ret = TclWinGetSockOpt((int)sock, SOL_SOCKET, SO_ERROR,
		(char *)&err, &optlen);

		/*
		 * The error was not returned directly but should be taken
		 * from WSA.
		 */

		if (ret == SOCKET_ERROR) {
		    err = WSAGetLastError();
		}
	if (ret == SOCKET_ERROR) {
	    err = WSAGetLastError();
	}

		/*
		 * Return error message.
		 */

		if (err) {
		    TclWinConvertError(err);
		    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()),
	if (err) {
	    TclWinConvertWSAError(err);
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
                            -1);
		}
	    }
	}
	return TCL_OK;
    }

	}
	return TCL_OK;
    }

    if ((len > 1) && (optionName[1] == 'c') &&
	    (strncmp(optionName, "-connecting", len) == 0)) {
	Tcl_DStringAppend(dsPtr,
		GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)
		? "1" : "0", -1);
        return TCL_OK;
    }

    if (interp != NULL
            && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 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, &size) == 0) {
	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * In async connect output an empty string
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringAppendElement(dsPtr, "");
		Tcl_DStringStartSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	} else if (getpeername(sock, (LPSOCKADDR) &(peername.sa),
                &size) == 0) {
	    /*
	     * Peername fetch succeeded - output list
	     */

	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
	    Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
		Tcl_DStringStartSublist(dsPtr);
	    }


	    if (peername.sin_addr.s_addr == 0) {
		hostEntPtr = NULL;
	    } else {
		hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
			sizeof(peername.sin_addr), AF_INET);
	    }
	    getnameinfo(&(peername.sa), size, host, sizeof(host),
		    NULL, 0, NI_NUMERICHOST);
	    Tcl_DStringAppendElement(dsPtr, host);
	    if (hostEntPtr != NULL) {
		Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
	    getnameinfo(&(peername.sa), size, host, sizeof(host),
		    port, sizeof(port), reverseDNS | NI_NUMERICSERV);
	    Tcl_DStringAppendElement(dsPtr, host);
	    Tcl_DStringAppendElement(dsPtr, port);
	    } else {
		Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
	    }
	    TclFormatInt(buf, ntohs(peername.sin_port));
	    Tcl_DStringAppendElement(dsPtr, buf);
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	} else {
	    /*
	     * 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());
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		if (interp) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "can't get peername: %s",
			    Tcl_PosixError(interp)));
		    Tcl_AppendResult(interp, "can't get peername: ",
			    Tcl_PosixError(interp), NULL);
		}
		return TCL_ERROR;
	    }
	}
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 's') &&
	    (strncmp(optionName, "-sockname", len) == 0))) {
	TcpFdList *fds;
	address sockname;
	socklen_t size;
	int found = 0;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-sockname");
	    Tcl_DStringStartSublist(dsPtr);
	}
	if (getsockname(sock, (LPSOCKADDR) &sockname, &size) == 0) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-sockname");
		Tcl_DStringStartSublist(dsPtr);
	    }
	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * In async connect output an empty string
	     */

            found = 1;
	} else {
	    for (fds = statePtr->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);

	    Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
	    if (sockname.sin_addr.s_addr == 0) {
		    /*
		     * We don't want to resolve INADDR_ANY and sin6addr_any;
		hostEntPtr = NULL;
		     * they can sometimes cause problems (and never have a
		     * name).
		     */

	    } else {
		    flags |= NI_NUMERICSERV;
		    if (sockname.sa.sa_family == AF_INET) {
			if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
		hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
			sizeof(peername.sin_addr), AF_INET);
			    flags |= NI_NUMERICHOST;
			}
	    }
		    } else if (sockname.sa.sa_family == AF_INET6) {
			if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
				    &in6addr_any)) ||
				(IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
				&& sockname.sa6.sin6_addr.s6_addr[12] == 0
				&& sockname.sa6.sin6_addr.s6_addr[13] == 0
				&& sockname.sa6.sin6_addr.s6_addr[14] == 0
				&& sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
			    flags |= NI_NUMERICHOST;
			}
		    }
		    getnameinfo(&sockname.sa, size, host, sizeof(host),
	    if (hostEntPtr != NULL) {
			    port, sizeof(port), flags);
		    Tcl_DStringAppendElement(dsPtr, host);
		    Tcl_DStringAppendElement(dsPtr, port);
		}
		Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
	    } else {
		Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
	    }
	    }
	}
	if (found) {
	    if (len) {
	    TclFormatInt(buf, ntohs(sockname.sin_port));
	    Tcl_DStringAppendElement(dsPtr, buf);
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	    Tcl_DStringEndSublist(dsPtr);
	} else {
	    if (interp) {
		TclWinConvertError((DWORD) WSAGetLastError());
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't get sockname: %s", Tcl_PosixError(interp)));
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		Tcl_AppendResult(interp, "can't get sockname: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
    }

#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
    if (len == 0 || !strncmp(optionName, "-keepalive", len)) {
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
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







-
+
+














-
+

-
+
-







	int optlen;
	BOOL opt = FALSE;

	if (len == 0) {
	    Tcl_DStringAppendElement(dsPtr, "-nagle");
	}
	optlen = sizeof(BOOL);
	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt, &optlen);
	getsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *)&opt,
		&optlen);
	if (opt) {
	    Tcl_DStringAppendElement(dsPtr, "0");
	} else {
	    Tcl_DStringAppendElement(dsPtr, "1");
	}
	if (len > 0) {
	    return TCL_OK;
	}
    }
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/

    if (len > 0) {
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
	return Tcl_BadChannelOption(interp, optionName,
		"connecting peername sockname keepalive nagle");
		"peername sockname keepalive nagle");
#else
	return Tcl_BadChannelOption(interp, optionName,
	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
                "connecting peername sockname");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
    }

    return TCL_OK;
}

/*
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
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

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
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
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
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
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
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
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
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770

2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
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
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
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







-
+



-
+


-
-
-
-
+
+
+
+

-
-
+
+







-
+

-








-
+

-
-
+
+


-
+
-










-
+


-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-







static void
TcpWatchProc(
    ClientData instanceData,	/* The socket state. */
    int mask)			/* Events of interest; an OR-ed combination of
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    TcpState *statePtr = (TcpState *)instanceData;
    SocketInfo *infoPtr = (SocketInfo *) instanceData;

    /*
     * Update the watch events mask. Only if the socket is not a server
     * socket. [Bug 557878]
     * socket. Fix for SF Tcl Bug #557878.
     */

    if (!statePtr->acceptProc) {
	statePtr->watchEvents = 0;
	if (GOT_BITS(mask, TCL_READABLE)) {
	    SET_BITS(statePtr->watchEvents, FD_READ | FD_CLOSE);
    if (!infoPtr->acceptProc) {
	infoPtr->watchEvents = 0;
	if (mask & TCL_READABLE) {
	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
	}
	if (GOT_BITS(mask, TCL_WRITABLE)) {
	    SET_BITS(statePtr->watchEvents, FD_WRITE | FD_CLOSE);
	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 (statePtr->readyEvents & statePtr->watchEvents) {
	if (infoPtr->readyEvents & infoPtr->watchEvents) {
	    Tcl_Time blockTime = { 0, 0 };

	    Tcl_SetMaxBlockTime(&blockTime);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TcpGetHandleProc --
 * TcpGetProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
 *	TCP socket based channel.
 *	Called from Tcl_GetChannelHandle to retrieve an OS handle from inside
 *	a TCP socket based channel.
 *
 * Results:
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
 *	Returns TCL_OK with the socket in handlePtr.
 *	handle for the specified direction.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TcpGetHandleProc(
    ClientData instanceData,	/* The socket state. */
    TCL_UNUSED(int) /*direction*/,
    int direction,		/* Not used. */
    ClientData *handlePtr)	/* Where to store the handle. */
{
    TcpState *statePtr = (TcpState *)instanceData;

    SocketInfo *statePtr = (SocketInfo *) instanceData;
    *handlePtr = INT2PTR(statePtr->sockets->fd);
    return TCL_OK;
}



/*
 *----------------------------------------------------------------------
 *
 * TcpConnect --
 *
 *	This function opens a new socket in client mode.
 *
 *	This might be called in 3 circumstances:
 *	-   By a regular socket command
 *	-   By the event handler to continue an asynchronously connect
 *	-   By a blocking socket function (gets/puts) to terminate the
 *	    connect synchronously
 *
 * Results:
 *      TCL_OK, if the socket was successfully connected or an asynchronous
 *      connection is in progress. If an error occurs, TCL_ERROR is returned
 *      and an error message is left in interp.
 *
 * Side effects:
 *	Opens a socket.
 *
 * Remarks:
 *	A single host name may resolve to more than one IP address, e.g. for
 *	an IPv4/IPv6 dual stack host. For handling asynchronously connecting
 *	sockets in the background for such hosts, this function can act as a
 *	coroutine. On the first call, it sets up the control variables for the
 *	two nested loops over the local and remote addresses. Once the first
 *	connection attempt is in progress, it sets up itself as a writable
 *	event handler for that socket, and returns. When the callback occurs,
 *	control is transferred to the "reenter" label, right after the initial
 *	return and the loops resume as if they had never been interrupted.
 *	For synchronously connecting sockets, the loops work the usual way.
 *
 *----------------------------------------------------------------------
 */

static int
TcpConnect(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    TcpState *statePtr)
{
    DWORD error;
    int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
                                /* We are started with async connect and the
                                 * connect notification was not yet
                                 * received. */
    int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
                                /* We were called by the event procedure and
                                 * continue our loop. */
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (async_callback) {
        goto reenter;
    }

    for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
	    statePtr->addr = statePtr->addr->ai_next) {
        for (statePtr->myaddr = statePtr->myaddrlist;
                statePtr->myaddr != NULL;
                statePtr->myaddr = statePtr->myaddr->ai_next) {
	    /*
	     * No need to try combinations of local and remote addresses
	     * of different families.
	     */

	    if (statePtr->myaddr->ai_family != statePtr->addr->ai_family) {
		continue;
	    }

            /*
             * Close the socket if it is still open from the last unsuccessful
             * iteration.
             */

	    if (statePtr->sockets->fd != INVALID_SOCKET) {
		closesocket(statePtr->sockets->fd);
	    }

	    /*
             * Get statePtr lock.
             */

	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	    /*
	     * Reset last error from last try
	     */

	    statePtr->notifierConnectError = 0;
	    Tcl_SetErrno(0);

	    statePtr->sockets->fd = socket(statePtr->myaddr->ai_family,
                    SOCK_STREAM, 0);

	    /*
             * Free list lock.
             */

	    SetEvent(tsdPtr->socketListLock);

	    /*
             * Continue on socket creation error.
             */

	    if (statePtr->sockets->fd == 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) statePtr->sockets->fd,
                    HANDLE_FLAG_INHERIT, 0);

	    /*
	     * Set kernel space buffering
	     */

	    TclSockMinimumBuffers((void *) statePtr->sockets->fd,
                    TCP_BUFFER_SIZE);

	    /*
	     * Try to bind to a local port.
	     */

	    if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
		    statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * For asynchroneous connect set the socket in nonblocking mode
	     * and activate connect notification
	     */

	    if (async_connect) {
		TcpState *statePtr2;
		int in_socket_list = 0;

		/*
                 * Get statePtr lock.
                 */

		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

		/*
		 * Bugfig for 336441ed59 to not ignore notifications until the
		 * infoPtr is in the list.
		 * Check if my statePtr is already in the tsdPtr->socketList
		 * It is set after this call by TcpThreadActionProc and is set
		 * on a second round.
		 *
		 * If not, we buffer my statePtr in the tsd memory so it is
		 * not lost by the event procedure
		 */

		for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL;
			statePtr2 = statePtr2->nextPtr) {
		    if (statePtr2 == statePtr) {
			in_socket_list = 1;
			break;
		    }
		}
		if (!in_socket_list) {
		    tsdPtr->pendingTcpState = statePtr;
		}

		/*
		 * Set connect mask to connect events
                 *
		 * This is activated by a SOCKET_SELECT message to the
		 * notifier thread.
		 */

		SET_BITS(statePtr->selectEvents, FD_CONNECT);

		/*
		 * Free list lock.
		 */

		SetEvent(tsdPtr->socketListLock);

    		/*
                 * Activate accept notification.
                 */

		SendSelectMessage(tsdPtr, SELECT, statePtr);
	    }

	    /*
	     * Attempt to connect to the remote socket.
	     */

	    connect(statePtr->sockets->fd, statePtr->addr->ai_addr,
		    statePtr->addr->ai_addrlen);

	    error = WSAGetLastError();
	    TclWinConvertError(error);

	    if (async_connect && error == WSAEWOULDBLOCK) {
		/*
		 * Asynchroneous connect
		 *
		 * Remember that we jump back behind this next round
		 */

		SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
		return TCL_OK;

	    reenter:
		/*
		 * Re-entry point for async connect after connect event or
		 * blocking operation
		 *
		 * Clear the reenter flag
		 */

		CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);

		/*
                 * Get statePtr lock.
                 */

		WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

		/*
                 * Get signaled connect error.
                 */

		TclWinConvertError((DWORD) statePtr->notifierConnectError);

		/*
                 * Clear eventual connect flag.
                 */

		CLEAR_BITS(statePtr->selectEvents, FD_CONNECT);

		/*
                 * Free list lock.
                 */

		SetEvent(tsdPtr->socketListLock);
	    }

	    /*
	     * Clear the tsd socket list pointer if we did not wait for
	     * the FD_CONNECT asynchroneously
	     */

	    tsdPtr->pendingTcpState = NULL;

	    if (Tcl_GetErrno() == 0) {
		goto out;
	    }
	}
    }

  out:
    /*
     * Socket connected or connection failed
     */

    /*
     * Async connect terminated
     */

    CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);

    if (Tcl_GetErrno() == 0) {
	/*
	 * Succesfully connected
	 *
	 * Set up the select mask for read/write events.
	 */

	statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;

	/*
	 * Register for interest in events in the select mask. Note that this
	 * automatically places the socket into non-blocking mode.
	 */

	SendSelectMessage(tsdPtr, SELECT, statePtr);
    } else {
	/*
	 * Connect failed
	 *
	 * For async connect schedule a writable event to report the fail.
	 */

	if (async_callback) {
	    /*
	     * Set up the select mask for read/write events.
	     */

	    statePtr->selectEvents = FD_WRITE|FD_READ;

	    /*
             * Get statePtr lock.
             */

	    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	    /*
             * Signal ready readable and writable events.
             */

	    SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ);

	    /*
             * Flag error to event routine.
             */

	    SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);

	    /*
             * Save connect error to be reported by 'fconfigure -error'.
             */

	    statePtr->connectError = Tcl_GetErrno();

	    /*
             * Free list lock.
             */

	    SetEvent(tsdPtr->socketListLock);
	}

	/*
	 * Error message on synchroneous connect
	 */

	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't open socket: %s", Tcl_PosixError(interp)));
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpClient --
 *
 *	Opens a TCP client socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. An error message is returned in the
 *	interpreter on failure.
 *
 * Side effects:
 *	Opens a client socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpClient(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Host on which to open port. */
    const char *myaddr,		/* Client-side address */
    int myport,			/* Client-side port */
    int async)			/* If nonzero, attempt to do an asynchronous
				 * connect. Otherwise we do a blocking
				 * connect. */
{
    TcpState *statePtr;
    const char *errorMsg = NULL;
    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
    char channelName[SOCK_CHAN_LENGTH];

    if (TclpHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * 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;
    }

    /*
     * Do the name lookups for the local and remote addresses.
     */

    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
                    &errorMsg)) {
        if (addrlist != NULL) {
            freeaddrinfo(addrlist);
        }
        if (interp != NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't open socket: %s", errorMsg));
        }
        return NULL;
    }

    statePtr = NewSocketInfo(INVALID_SOCKET);
    statePtr->addrlist = addrlist;
    statePtr->myaddrlist = myaddrlist;
    if (async) {
	SET_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
    }

    /*
     * Create a new client socket and wrap it in a channel.
     */
    if (TcpConnect(interp, statePtr) != TCL_OK) {
	TcpCloseProc(statePtr, NULL);
	return NULL;
    }

    sprintf(channelName, SOCK_TEMPLATE, statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, (TCL_READABLE | TCL_WRITABLE));
    if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
	    "-translation", "auto crlf")) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;
    } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, statePtr->channel,
	    "-eofchar", "")) {
	Tcl_CloseEx(NULL, statePtr->channel, 0);
	return NULL;
    }
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeTcpClientChannel --
 *
 *	Creates a Tcl_Channel from an existing client TCP socket.
 *
 * Results:
 *	The Tcl_Channel wrapped around the preexisting TCP socket.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_MakeTcpClientChannel(
    ClientData sock)		/* The socket to wrap up into a channel. */
{
    TcpState *statePtr;
    char channelName[SOCK_CHAN_LENGTH];
    ThreadSpecificData *tsdPtr;

    if (TclpHasSockets(NULL) != TCL_OK) {
	return NULL;
    }

    tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);

    statePtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendSelectMessage(tsdPtr, SELECT, statePtr);

    sprintf(channelName, SOCK_TEMPLATE, statePtr);
    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    statePtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, statePtr->channel, "-translation", "auto crlf");
    return statePtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_OpenTcpServerEx --
 *
 *	Opens a TCP server socket and creates a channel around it.
 *
 * Results:
 *	The channel or NULL if failed. If an error occurred, an error message
 *	is left in the interp's result if interp is not NULL.
 *
 * Side effects:
 *	Opens a server socket and creates a new channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
Tcl_OpenTcpServerEx(
    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
    const char *service,	/* Port number to open. */
    const char *myHost,		/* Name of local host. */
    unsigned int flags,		/* Flags. */
    Tcl_TcpAcceptProc *acceptProc,
				/* Callback for accepting connections from new
				 * clients. */
    ClientData acceptProcData)	/* Data for the callback. */
{
    SOCKET sock = INVALID_SOCKET;
    unsigned short chosenport = 0;
    struct addrinfo *addrlist = NULL;
    struct addrinfo *addrPtr;	/* Socket address to listen on. */
    TcpState *statePtr = NULL;	/* The returned value. */
    char channelName[SOCK_CHAN_LENGTH];
    u_long flag = 1;		/* Indicates nonblocking mode. */
    const char *errorMsg = NULL;
    int optvalue, port;

    if (TclpHasSockets(interp) != TCL_OK) {
	return NULL;
    }

    /*
     * 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 (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
	errorMsg = "invalid port number";
	goto error;
    }

    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 == 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);
	}

	/*
	 * The SO_REUSEADDR option on Windows behaves like SO_REUSEPORT on
	 * unix systems.
	 */

	if (GOT_BITS(flags, TCL_TCPSERVER_REUSEPORT)) {
	    optvalue = 1;
	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
		    (char *) &optvalue, sizeof(optvalue));
	}

	/*
	 * Bind to the specified port.
	 *
	 * 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 (statePtr == NULL) {
	    /*
	     * Add this socket to the global list of sockets.
	     */

	    statePtr = NewSocketInfo(sock);
	} else {
	    AddSocketInfoFd(statePtr, sock);
	}
    }

  error:
    if (addrlist != NULL) {
	freeaddrinfo(addrlist);
    }

    if (statePtr != NULL) {
	ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

	statePtr->acceptProc = acceptProc;
	statePtr->acceptProcData = acceptProcData;
	sprintf(channelName, SOCK_TEMPLATE, statePtr);
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	/*
	 * Set up the select mask for connection request events.
	 */

	statePtr->selectEvents = FD_ACCEPT;

	/*
	 * Register for interest in events in the select mask. Note that this
	 * automatically places the socket into non-blocking mode.
	 */

	ioctlsocket(sock, (long) FIONBIO, &flag);
	SendSelectMessage(tsdPtr, SELECT, statePtr);
	if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	    Tcl_CloseEx(NULL, statePtr->channel, 0);
	    return NULL;
	}
	return statePtr->channel;
    }

    if (interp != NULL) {
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't open socket: %s",
		(errorMsg ? errorMsg : Tcl_PosixError(interp))));
    }

    if (sock != INVALID_SOCKET) {
	closesocket(sock);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TcpAccept --
 *	Accept a TCP socket connection.	 This is called by the event loop.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new connection socket. Calls the registered callback for the
 *	connection acceptance mechanism.
 *
 *----------------------------------------------------------------------
 */

static void
TcpAccept(
    TcpFdList *fds,	/* Server socket that accepted newSocket. */
    SOCKET newSocket,   /* Newly accepted socket. */
    address addr)       /* Address of new socket. */
{
    TcpState *newInfoPtr;
    TcpState *statePtr = fds->statePtr;
    int len = sizeof(addr);
    char channelName[SOCK_CHAN_LENGTH];
    char host[NI_MAXHOST], port[NI_MAXSERV];
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Win-NT has a misfeature that sockets are inherited in child processes
     * by default. Turn off the inherit bit.
     */

    SetHandleInformation((HANDLE) newSocket, HANDLE_FLAG_INHERIT, 0);

    /*
     * Add this socket to the global list of sockets.
     */

    newInfoPtr = NewSocketInfo(newSocket);

    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    SendSelectMessage(tsdPtr, SELECT, newInfoPtr);

    sprintf(channelName, SOCK_TEMPLATE, newInfoPtr);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
	return;
    }
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_CloseEx(NULL, newInfoPtr->channel, 0);
	return;
    }

    /*
     * Invoke the accept callback function.
     */

    if (statePtr->acceptProc != NULL) {
	getnameinfo(&(addr.sa), len, host, sizeof(host), port, sizeof(port),
                    NI_NUMERICHOST|NI_NUMERICSERV);
	statePtr->acceptProc(statePtr->acceptProcData, newInfoPtr->channel,
			    host, atoi(port));
    }
}

/*
 *----------------------------------------------------------------------
 *
 * InitSockets --
 *
 *	Registers the event window for the socket notifier code.
 *
 *	Assumes socketMutex is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Register a new window class and creates a
 *	window for use in asynchronous socket notification.
 *
 *----------------------------------------------------------------------
 */

static void
InitSockets(void)
{
    DWORD id;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, NULL);

	/*
	 * Create the async notification window with a new class. We must
	 * create a new class to avoid a Windows 95 bug that causes us to get
	 * the wrong message number for socket events if the message window is
	 * a subclass of a static control.
	 */

	windowClass.style = 0;
	windowClass.cbClsExtra = 0;
	windowClass.cbWndExtra = 0;
	windowClass.hInstance = (HINSTANCE)TclWinGetTclInstance();
	windowClass.hbrBackground = NULL;
	windowClass.lpszMenuName = NULL;
	windowClass.lpszClassName = className;
	windowClass.lpfnWndProc = SocketProc;
	windowClass.hIcon = NULL;
	windowClass.hCursor = NULL;

	if (!RegisterClassW(&windowClass)) {
	    TclWinConvertError(GetLastError());
	    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->pendingTcpState = NULL;
    tsdPtr->socketList = NULL;
    tsdPtr->hwnd       = NULL;
    tsdPtr->threadId   = Tcl_GetCurrentThread();
    tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL);
    if (tsdPtr->readyEvent == NULL) {
	goto initFailure;
    }
    tsdPtr->socketListLock = CreateEventW(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;
}

/*
 *----------------------------------------------------------------------
 *
 * SocketsEnabled --
 *
 *	Check that the WinSock was successfully initialized.
 *
 * Warning:
 *	This check was useful in times of Windows98 where WinSock may
 *	not be available. This is not the case any more.
 *	This function may be removed with TCL 9.0
 *
 * Results:
 *	1 if it is.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
SocketsEnabled(void)
{
    int enabled;

    Tcl_MutexLock(&socketMutex);
    enabled = (initialized == 1);
    Tcl_MutexUnlock(&socketMutex);
    return enabled;
}


/*
 *----------------------------------------------------------------------
 *
 * SocketExitHandler --
 *
 *	Callback invoked during exit clean up to delete the socket
 *	communication window.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static void
SocketExitHandler(
    TCL_UNUSED(ClientData))
{
    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */

    TclpFinalizeSockets();
    UnregisterClassW(className, (HINSTANCE)TclWinGetTclInstance());
    initialized = 0;
    Tcl_MutexUnlock(&socketMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * SocketSetupProc --
 *
 *	This function is invoked before Tcl_DoOneEvent blocks waiting for an
 *	event.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Adjusts the block time if needed.
 *
 *----------------------------------------------------------------------
 */

void
SocketSetupProc(
    TCL_UNUSED(ClientData),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    Tcl_Time blockTime = { 0, 0 };
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Check to see if there is a ready socket.	 If so, poll.
     */
    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (GOT_BITS(statePtr->readyEvents,
                statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) {
	    Tcl_SetMaxBlockTime(&blockTime);
	    break;
	}
    }
    SetEvent(tsdPtr->socketListLock);
}

/*
 *----------------------------------------------------------------------
 *
 * SocketCheckProc --
 *
 *	This function is called by Tcl_DoOneEvent to check the socket event
 *	source for events.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May queue an event.
 *
 *----------------------------------------------------------------------
 */

static void
SocketCheckProc(
    TCL_UNUSED(ClientData),
    int flags)			/* Event flags as passed to Tcl_DoOneEvent. */
{
    TcpState *statePtr;
    SocketEvent *evPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
	return;
    }

    /*
     * Queue events for any ready sockets that don't already have events
     * queued (caused by persistent states that won't generate WinSock
     * events).
     */

    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (GOT_BITS(statePtr->readyEvents,
		statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
                && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
	    SET_BITS(statePtr->flags, SOCKET_PENDING);
	    evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent));
	    evPtr->header.proc = SocketEventProc;
	    evPtr->socket = statePtr->sockets->fd;
	    Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
	}
    }
    SetEvent(tsdPtr->socketListLock);
}

/*
 *----------------------------------------------------------------------
 *
 * SocketEventProc --
 *
 *	This function is called by Tcl_ServiceEvent when a socket event
 *	reaches the front of the event queue. This function is responsible for
 *	notifying the generic channel code.
 *
 * Results:
 *	Returns 1 if the event was handled, meaning it should be removed from
 *	the queue. Returns 0 if the event was not handled, meaning it should
 *	stay on the queue. The only time the event isn't handled is if the
 *	TCL_FILE_EVENTS flag bit isn't set.
 *
 * Side effects:
 *	Whatever the channel callback functions do.
 *
 *----------------------------------------------------------------------
 */

static int
SocketEventProc(
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    TcpState *statePtr;
    SocketEvent *eventPtr = (SocketEvent *) evPtr;
    int mask = 0, events;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TcpFdList *fds;
    SOCKET newSocket;
    address addr;
    int len;

    if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
	return 0;
    }

    /*
     * Find the specified socket on the socket list.
     */

    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
    for (statePtr = tsdPtr->socketList; statePtr != NULL;
	    statePtr = statePtr->nextPtr) {
	if (statePtr->sockets->fd == eventPtr->socket) {
	    break;
	}

    }

    /*
     * Discard events that have gone stale.
     */

    if (!statePtr) {
        SetEvent(tsdPtr->socketListLock);
	return 1;
    }

    /*
     * Clear flag that (this) event is pending
     */

    CLEAR_BITS(statePtr->flags, SOCKET_PENDING);

    /*
     * Continue async connect if pending and ready
     */

    if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
	if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
	    /*
	     * Do one step and save eventual connect error
	     */

	    SetEvent(tsdPtr->socketListLock);
	    WaitForConnect(statePtr,NULL);
	} else {
	    /*
	     * No async connect reenter pending. Just clear event.
	     */

	    CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);
	    SetEvent(tsdPtr->socketListLock);
	}
	return 1;
    }

    /*
     * Handle connection requests directly.
     */

    if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) {
	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
	    /*
             * Accept the incoming connection request.
             */

	    len = sizeof(address);
	    newSocket = accept(fds->fd, &(addr.sa), &len);

	    /*
             * On Tcl server sockets with multiple OS fds we loop over the fds
	     * trying an accept() on each, so we expect INVALID_SOCKET.  There
	     * are also other network stack conditions that can result in
	     * FD_ACCEPT but a subsequent failure on accept() by the time we
	     * get around to it.
             *
	     * Access to sockets (acceptEventCount, readyEvents) in socketList
	     * is still protected by the lock (prevents reintroduction of
	     * SF Tcl Bug 3056775.
	     */

	    if (newSocket == INVALID_SOCKET) {
		/* int err = WSAGetLastError(); */
		continue;
	    }

	    /*
	     * It is possible that more than one FD_ACCEPT has been sent, so
	     * an extra count must be kept. Decrement the count, and reset the
	     * readyEvent bit if the count is no longer > 0.
	     */

	    statePtr->acceptEventCount--;

	    if (statePtr->acceptEventCount <= 0) {
		CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);
	    }

	    SetEvent(tsdPtr->socketListLock);

	    /*
             * Caution: TcpAccept() has the side-effect of evaluating the
	     * server accept script (via AcceptCallbackProc() in tclIOCmd.c),
	     * which can close the server socket and invalidate statePtr and
	     * fds. If TcpAccept() accepts a socket we must return immediately
	     * and let SocketCheckProc queue additional FD_ACCEPT events.
	     */

	    TcpAccept(fds, newSocket, addr);
	    return 1;
	}

	/*
         * Loop terminated with no sockets accepted; 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.
	 */

	statePtr->acceptEventCount = 0;
	CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);

	SetEvent(tsdPtr->socketListLock);
	return 1;
    }

    SetEvent(tsdPtr->socketListLock);

    /*
     * Mask off unwanted events and compute the read/write mask so we can
     * notify the channel.
     */

    events = statePtr->readyEvents & statePtr->watchEvents;

    if (GOT_BITS(events, FD_CLOSE)) {
	/*
	 * If the socket was closed and the channel is still interested in
	 * read events, then we need to ensure that we keep polling for this
	 * event until someone does something with the channel. Note that we
	 * 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);
	SET_BITS(mask, TCL_READABLE | TCL_WRITABLE);
    } else if (GOT_BITS(events, FD_READ)) {
	/*
	 * Throw the readable event if an async connect failed.
	 */

	if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
	    SET_BITS(mask, TCL_READABLE);
	} else {
	    fd_set readFds;
	    struct timeval timeout;

	    /*
	     * We must check to see if data is really available, since someone
	     * could have consumed the data in the meantime. Turn off async
	     * notification so select will work correctly. If the socket is
	     * still readable, notify the channel driver, otherwise reset the
	     * async select handler and keep waiting.
	     */

	    SendSelectMessage(tsdPtr, UNSELECT, statePtr);

	    FD_ZERO(&readFds);
	    FD_SET(statePtr->sockets->fd, &readFds);
    *handlePtr = (ClientData) statePtr->socket;
	    timeout.tv_usec = 0;
	    timeout.tv_sec = 0;

	    if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
		SET_BITS(mask, TCL_READABLE);
	    } else {
		CLEAR_BITS(statePtr->readyEvents, FD_READ);
		SendSelectMessage(tsdPtr, SELECT, statePtr);
	    }
	}
    }

    /*
     * writable event
     */

    if (GOT_BITS(events, FD_WRITE)) {
	SET_BITS(mask, TCL_WRITABLE);
    }

    /*
     * Call registered event procedures
     */

    if (mask) {
	Tcl_NotifyChannel(statePtr->channel, mask);
    }
    return 1;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * AddSocketInfoFd --
 *
 *	This function adds a SOCKET file descriptor to the 'sockets' linked
 *	list of a TcpState structure.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None, except for allocation of memory.
 *
 *----------------------------------------------------------------------
 */

static void
AddSocketInfoFd(
    TcpState *statePtr,
    SOCKET socket)
{
    TcpFdList *fds = statePtr->sockets;

    if (fds == NULL) {
	/*
         * Add the first FD.
         */

	statePtr->sockets = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
	fds = statePtr->sockets;
    } else {
	/*
         * Find end of list and append FD.
         */

	while (fds->next != NULL) {
	    fds = fds->next;
	}

	fds->next = (TcpFdList *)Tcl_Alloc(sizeof(TcpFdList));
	fds = fds->next;
    }

    /*
     * Populate new FD.
     */

    fds->fd = socket;
    fds->statePtr = statePtr;
    fds->next = NULL;
}


/*
 *----------------------------------------------------------------------
 *
 * NewSocketInfo --
 *
 *	This function allocates and initializes a new TcpState structure.
 *
 * Results:
 *	Returns a newly allocated TcpState.
 *
 * Side effects:
 *	None, except for allocation of memory.
 *
 *----------------------------------------------------------------------
 */

static TcpState *
NewSocketInfo(SOCKET socket)
{
    TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState));

    memset(statePtr, 0, sizeof(TcpState));

    /*
     * TIP #218. Removed the code inserting the new structure into the global
     * list. This is now handled in the thread action callbacks, and only
     * there.
     */

    AddSocketInfoFd(statePtr, socket);

    return statePtr;
}

/*
 *----------------------------------------------------------------------
 *
 * WaitForSocketEvent --
 *
 *	Waits until one of the specified events occurs on a socket.
 *	For event FD_CONNECT use WaitForConnect.
 *
 * Results:
 *	Returns 1 on success or 0 on failure, with an error code in
 *	errorCodePtr.
 *
 * Side effects:
 *	Processes socket events off the system queue.
 *
 *----------------------------------------------------------------------
 */

static int
WaitForSocketEvent(
    TcpState *statePtr,	/* Information about this socket. */
    int events,			/* Events to look for. May be one of
				 * FD_READ or FD_WRITE.
				 */
    int *errorCodePtr)		/* Where to store errors? */
{
    int result = 1;
    int oldMode;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);

    /*
     * Be sure to disable event servicing so we are truly modal.
     */

    oldMode = Tcl_SetServiceMode(TCL_SERVICE_NONE);

    /*
     * Reset WSAAsyncSelect so we have a fresh set of events pending.
     */

    SendSelectMessage(tsdPtr, UNSELECT, statePtr);
    SendSelectMessage(tsdPtr, SELECT, statePtr);

    while (1) {
	int event_found;

	/*
         * Get statePtr lock.
         */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
         * Check if event occured.
         */

	event_found = GOT_BITS(statePtr->readyEvents, events);

	/*
         * Free list lock.
         */

	SetEvent(tsdPtr->socketListLock);

	/*
         * Exit loop if event occured.
         */

	if (event_found) {
	    break;
	}

	/*
         * Exit loop if event did not occur but this is a non-blocking channel
         */

	if (statePtr->flags & TCP_NONBLOCKING) {
	    *errorCodePtr = EWOULDBLOCK;
	    result = 0;
	    break;
	}

	/*
	 * Wait until something happens.
	 */

	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
    }

    (void) Tcl_SetServiceMode(oldMode);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * SocketThread --
 *
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
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







-
+





-
-
+
+


















-
+


-
-
+
+







 */

static DWORD WINAPI
SocketThread(
    LPVOID arg)
{
    MSG msg;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)arg;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)(arg);

    /*
     * Create a dummy window receiving socket events.
     */

    tsdPtr->hwnd = CreateWindowW(className, className, WS_TILED, 0, 0, 0, 0,
	    NULL, NULL, windowClass.hInstance, arg);
    tsdPtr->hwnd = CreateWindow("TclSocket", "TclSocket",
	    WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);

    /*
     * Signalize thread creator that we are done creating the window.
     */

    SetEvent(tsdPtr->readyEvent);

    /*
     * If unable to create the window, exit this thread immediately.
     */

    if (tsdPtr->hwnd == NULL) {
	return 1;
    }

    /*
     * Process all messages on the socket window until WM_QUIT. This threads
     * exits only when instructed to do so by the call to
     * PostMessageW(SOCKET_TERMINATE) in TclpFinalizeSockets().
     * PostMessage(SOCKET_TERMINATE) in TclpFinalizeSockets().
     */

    while (GetMessageW(&msg, NULL, 0, 0) > 0) {
	DispatchMessageW(&msg);
    while (GetMessage(&msg, NULL, 0, 0) > 0) {
	DispatchMessage(&msg);
    }

    /*
     * This releases waiters on thread exit in TclpFinalizeSockets()
     */

    SetEvent(tsdPtr->readyEvent);
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
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







-
+

-


-
+

-
+




-
+









-
+


-
+













-
-





+
-
-
-
+
+
+




-

-
+
+

-
-
-
-
-
+
+
+
+



+




-
-
+
+


-
-
-
-
-
+
+
+
+
+


-
+
+
+
+
+
+
+
+






-
+
+
+
+
+

-
+
+
+

-
-
-
-
-
+
+
+












-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+
-














+
+
+
+
-
+
+
+

+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+

+
+
+
+
+

+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+




+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

+
+
-
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







    HWND hwnd,
    UINT message,
    WPARAM wParam,
    LPARAM lParam)
{
    int event, error;
    SOCKET socket;
    TcpState *statePtr;
    SocketInfo *infoPtr;
    int info_found = 0;
    TcpFdList *fds = NULL;
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)
#ifdef _WIN64
	    GetWindowLongPtrW(hwnd, GWLP_USERDATA);
	    GetWindowLongPtr(hwnd, GWLP_USERDATA);
#else
	    GetWindowLongW(hwnd, GWL_USERDATA);
	    GetWindowLong(hwnd, GWL_USERDATA);
#endif

    switch (message) {
    default:
	return DefWindowProcW(hwnd, message, wParam, lParam);
	return DefWindowProc(hwnd, message, wParam, lParam);
	break;

    case WM_CREATE:
	/*
	 * Store the initial tsdPtr, it's from a different thread, so it's not
	 * directly accessible, but needed.
	 */

#ifdef _WIN64
	SetWindowLongPtrW(hwnd, GWLP_USERDATA,
	SetWindowLongPtr(hwnd, GWLP_USERDATA,
		(LONG_PTR) ((LPCREATESTRUCT)lParam)->lpCreateParams);
#else
	SetWindowLongW(hwnd, GWL_USERDATA,
	SetWindowLong(hwnd, GWL_USERDATA,
		(LONG) ((LPCREATESTRUCT)lParam)->lpCreateParams);
#endif
	break;

    case WM_DESTROY:
	PostQuitMessage(0);
	break;

    case SOCKET_MESSAGE:
	event = WSAGETSELECTEVENT(lParam);
	error = WSAGETSELECTERROR(lParam);
	socket = (SOCKET) wParam;

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

	/*
	 * Find the specified socket on the socket list and update its
	 * eventState flag.
	 */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
	for (statePtr = tsdPtr->socketList; statePtr != NULL;
		statePtr = statePtr->nextPtr) {
	    if (FindFDInList(statePtr, socket)) {
	for (infoPtr = tsdPtr->socketList; infoPtr != NULL;
		infoPtr = infoPtr->nextPtr) {
	    if (infoPtr->socket == socket) {
		info_found = 1;
		break;
	    }
	}

	/*
	 * Check if there is a pending info structure not jet in the list.
	 * Check if there is a pending info structure not jet in the
	 * list
	 */

	if (!info_found
		&& tsdPtr->pendingTcpState != NULL
		&& FindFDInList(tsdPtr->pendingTcpState, socket)) {
	    statePtr = tsdPtr->pendingTcpState;
	if ( !info_found
		&& tsdPtr->pendingSocketInfo != NULL
		&& tsdPtr->pendingSocketInfo->socket ==socket ) {
	    infoPtr = tsdPtr->pendingSocketInfo;
	    info_found = 1;
	}
	if (info_found) {

	    /*
	     * Update the socket state.
	     *
	     * A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
	     * happens, then clear the FD_ACCEPT count. Otherwise, increment
	     * the count if the current event is an FD_ACCEPT.
	     * happens, then clear the FD_ACCEPT count. Otherwise,
	     * increment the count if the current event is an FD_ACCEPT.
	     */

	    if (GOT_BITS(event, FD_CLOSE)) {
		statePtr->acceptEventCount = 0;
		CLEAR_BITS(statePtr->readyEvents, FD_WRITE | FD_ACCEPT);
	    } else if (GOT_BITS(event, FD_ACCEPT)) {
		statePtr->acceptEventCount++;
	    if (event & FD_CLOSE) {
	        infoPtr->acceptEventCount = 0;
	        infoPtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
	    } else if (event & FD_ACCEPT) {
		infoPtr->acceptEventCount++;
	    }

	    if (GOT_BITS(event, FD_CONNECT)) {
	    if (event & FD_CONNECT) {
		/*
		 * The socket is now connected, clear the async connect
		 * flag.
		 */

		infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);

		/*
		 * Remember any error that occurred so we can report
		 * connection failures.
		 */

		if (error != ERROR_SUCCESS) {
		    statePtr->notifierConnectError = error;
		    /* Async Connect error */
		    TclWinConvertWSAError((DWORD) error);
		    infoPtr->lastError = Tcl_GetErrno();
		    /* Fire also readable event on connect failure */
		    infoPtr->readyEvents |= FD_READ;
		}
	    }

		/* fire writable event on connect */
		infoPtr->readyEvents |= FD_WRITE;

	    /*
	     * Inform main thread about signaled events
	     */

	    SET_BITS(statePtr->readyEvents, event);
	    }

	    infoPtr->readyEvents |= event;

	    /*
	     * Wake up the Main Thread.
	     */

	    SetEvent(tsdPtr->readyEvent);
	    Tcl_ThreadAlert(tsdPtr->threadId);
	}
	SetEvent(tsdPtr->socketListLock);
	break;

    case SOCKET_SELECT:
	statePtr = (TcpState *) lParam;
	infoPtr = (SocketInfo *) lParam;
	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
	    if (wParam == SELECT) {
		WSAAsyncSelect(fds->fd, hwnd,
			SOCKET_MESSAGE, statePtr->selectEvents);
	    } else {
		/*
		 * Clear the selection mask
		 */
	if (wParam == SELECT) {
            /*
             * Start notification by windows messages on socket events
             */

	    WSAAsyncSelect(infoPtr->socket, hwnd,
		    SOCKET_MESSAGE, infoPtr->selectEvents);
	} else {
	    /*
	     * UNSELECT: Clear the selection mask
	     */

		WSAAsyncSelect(fds->fd, hwnd, 0, 0);
	    WSAAsyncSelect(infoPtr->socket, hwnd, 0, 0);
	    }
	}
	break;

    case SOCKET_TERMINATE:
	DestroyWindow(hwnd);
	break;
    }

    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetHostName --
 *
 *	Returns the name of the local host.
 *
 * FindFDInList --
 * Results:
 *	A string containing the network name for this machine. The caller must
 *	not modify or free this string.
 *
 * Side effects:
 *	Caches the name to return for future calls.
 *
 *----------------------------------------------------------------------
 */
 *	Return true, if the given file descriptior is contained in the
 *	file descriptor list.

const char *
Tcl_GetHostName(void)
{
    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
}

/*
 *----------------------------------------------------------------------
 *
 * InitializeHostName --
 *
 *	This routine sets the process global value of the name of the local
 *	host on which the process is running.
 *
 * Results:
 *	None.
 *
 *----------------------------------------------------------------------
 */
 *	true if found.
 *

void
InitializeHostName(
    char **valuePtr,
    int *lengthPtr,
    Tcl_Encoding *encodingPtr)
{
    WCHAR wbuf[MAX_COMPUTERNAME_LENGTH + 1];
    DWORD length = sizeof(wbuf) / sizeof(WCHAR);
    Tcl_DString ds;

    if ((*tclWinProcs->getComputerNameProc)(wbuf, &length) != 0) {
	/*
	 * Convert string from native to UTF then change to lowercase.
	 */

	Tcl_UtfToLower(Tcl_WinTCharToUtf((TCHAR *) wbuf, -1, &ds));

    } else {
	Tcl_DStringInit(&ds);
	if (TclpHasSockets(NULL) == TCL_OK) {
	    /*
	     * The buffer size of 256 is recommended by the MSDN page that
	     * documents gethostname() as being always adequate.
	     */

	    Tcl_DString inDs;

	    Tcl_DStringInit(&inDs);
	    Tcl_DStringSetLength(&inDs, 256);
	    if (gethostname(Tcl_DStringValue(&inDs),
		    Tcl_DStringLength(&inDs)) == 0) {
		Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&inDs), -1,
			&ds);
	    }
	    Tcl_DStringFree(&inDs);
	}
    }

    *encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
    *lengthPtr = Tcl_DStringLength(&ds);
    *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
    memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinGetSockOpt, et al. --
 *
 *	These functions are wrappers that let us bind the WinSock API
 *	dynamically so we can run on systems that don't have the wsock32.dll.
 *	We need wrappers for these interfaces because they are called from the
 *	generic Tcl code.
 *
 * Results:
 *	As defined for each function.
 *
 * Side effects:
 *	As defined for each function.
 *
 *----------------------------------------------------------------------
 */

#undef TclWinGetSockOpt
static int
FindFDInList(
    TcpState *statePtr,
    SOCKET socket)
int
TclWinGetSockOpt(SOCKET s, int level, int optname, char *optval,
	int *optlen)
{
    return getsockopt(s, level, optname, optval, optlen);
}

#undef TclWinSetSockOpt
int
TclWinSetSockOpt(SOCKET s, int level, int optname, const char *optval,
    int optlen)
{
    return setsockopt(s, level, optname, optval, optlen);
}
    TcpFdList *fds;

    for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
	if (fds->fd == socket) {
	    return 1;
	}
    }
    return 0;
char *
TclpInetNtoa(struct in_addr addr)
{
    return inet_ntoa(addr);
}

#undef TclWinGetServByName
struct servent *
TclWinGetServByName(
    const char *name,
    const char *proto)
{
    return getservbyname(name, proto);
}

/*
 *----------------------------------------------------------------------
 *
 * TcpThreadActionProc --
 *
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
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

2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643


2644
2645
2646
2647
2648
2649
2650
2651
2652







-
+















-
-
+
+

-
-
+
+






-
+












-
-
+
+








static void
TcpThreadActionProc(
    ClientData instanceData,
    int action)
{
    ThreadSpecificData *tsdPtr;
    TcpState *statePtr = (TcpState *)instanceData;
    SocketInfo *infoPtr = (SocketInfo *) instanceData;
    int notifyCmd;

    if (action == TCL_CHANNEL_THREAD_INSERT) {
	/*
	 * Ensure that socket subsystem is initialized in this thread, or else
	 * sockets will not work.
	 */

	Tcl_MutexLock(&socketMutex);
	InitSockets();
	Tcl_MutexUnlock(&socketMutex);

	tsdPtr = TCL_TSD_INIT(&dataKey);

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
	statePtr->nextPtr = tsdPtr->socketList;
	tsdPtr->socketList = statePtr;
	infoPtr->nextPtr = tsdPtr->socketList;
	tsdPtr->socketList = infoPtr;

	if (statePtr == tsdPtr->pendingTcpState) {
	    tsdPtr->pendingTcpState = NULL;
	if (infoPtr == tsdPtr->pendingSocketInfo) {
	    tsdPtr->pendingSocketInfo = NULL;
	}

	SetEvent(tsdPtr->socketListLock);

	notifyCmd = SELECT;
    } else {
	TcpState **nextPtrPtr;
	SocketInfo **nextPtrPtr;
	int removed = 0;

	tsdPtr = TCL_TSD_INIT(&dataKey);

	/*
	 * TIP #218, Bugfix: All access to socketList has to be protected by
	 * the lock.
	 */

	WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
	for (nextPtrPtr = &(tsdPtr->socketList); (*nextPtrPtr) != NULL;
		nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	    if ((*nextPtrPtr) == statePtr) {
		(*nextPtrPtr) = statePtr->nextPtr;
	    if ((*nextPtrPtr) == infoPtr) {
		(*nextPtrPtr) = infoPtr->nextPtr;
		removed = 1;
		break;
	    }
	}
	SetEvent(tsdPtr->socketListLock);

	/*
3472
3473
3474
3475
3476
3477
3478
3479


3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
2663
2664
2665
2666
2667
2668
2669

2670
2671
2672
2673
2674
2675
2676
2677
2678


2679
2680







-
+
+







-
-


    }

    /*
     * Ensure that, or stop, notifications for the socket occur in this
     * thread.
     */

    SendSelectMessage(tsdPtr, notifyCmd, statePtr);
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) notifyCmd, (LPARAM) infoPtr);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * indent-tabs-mode: nil
 * End:
 */

Changes to win/tclWinTest.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
33
34
35
36
37
38
39

40
41
42
43









44
45
46


47
48
49
50
51
52
53
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











-
-
-

-
-
-
-
-




-
+














+
-
-
-
-
+
+
+
+
+
+
+
+
+


-
+
+







/*
 * tclWinTest.c --
 *
 *	Contains commands for platform specific tests on Windows.
 *
 * Copyright (c) 1996 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"
#ifdef TCL_WITH_EXTERNAL_TOMMATH
#   include "tommath.h"
#else
#   include "tclTomMath.h"
#endif

/*
 * For TestplatformChmod on Windows
 */
#ifdef _WIN32
#ifdef __WIN32__
#include <aclapi.h>
#endif

/*
 * MinGW 3.4.2 does not define this.
 */
#ifndef INHERITED_ACE
#define INHERITED_ACE (0x10)
#endif

/*
 * Forward declarations of functions defined later in this file:
 */

int			TclplatformtestInit(Tcl_Interp *interp);
static Tcl_ObjCmdProc	TesteventloopCmd;
static Tcl_ObjCmdProc	TestvolumetypeCmd;
static Tcl_ObjCmdProc	TestwinclockCmd;
static Tcl_ObjCmdProc	TestwinsleepCmd;
static int		TesteventloopCmd(ClientData dummy, Tcl_Interp *interp,
			    int argc, const char **argv);
static int		TestvolumetypeCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestwinclockCmd(ClientData dummy, Tcl_Interp* interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
			    int objc, Tcl_Obj *const objv[]);
static Tcl_ObjCmdProc	TestExceptionCmd;
static int		TestplatformChmod(const char *nativePath, int pmode);
static Tcl_ObjCmdProc	TestchmodCmd;
static int		TestchmodCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);

/*
 *----------------------------------------------------------------------
 *
 * TclplatformtestInit --
 *
 *	Defines commands that test platform specific functionality for Windows
66
67
68
69
70
71
72
73
74


75
76
77
78
79
80
81
65
66
67
68
69
70
71


72
73
74
75
76
77
78
79
80







-
-
+
+







TclplatformtestInit(
    Tcl_Interp *interp)		/* Interpreter to add commands to. */
{
    /*
     * Add commands for platform specific tests for Windows here.
     */

    Tcl_CreateObjCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testchmod", TestchmodCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testeventloop", TesteventloopCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testvolumetype", TestvolumetypeCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testwinclock", TestwinclockCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testwinsleep", TestwinsleepCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testexcept", TestExceptionCmd, NULL, NULL);
    return TCL_OK;
}
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
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







-
+

-
-
+
+





-
-
+
+
+


-
+

-
+



















-
+









-
+




-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TesteventloopCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    static int *framePtr = NULL;/* Pointer to integer on stack frame of
				 * innermost invocation of the "wait"
				 * subcommand. */

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "option ...");
    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0],
		" option ... \"", NULL);
	return TCL_ERROR;
    }
    if (strcmp(Tcl_GetString(objv[1]), "done") == 0) {
    if (strcmp(argv[1], "done") == 0) {
	*framePtr = 1;
    } else if (strcmp(Tcl_GetString(objv[1]), "wait") == 0) {
    } else if (strcmp(argv[1], "wait") == 0) {
	int *oldFramePtr, done;
	int oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);

	/*
	 * Save the old stack frame pointer and set up the current frame.
	 */

	oldFramePtr = framePtr;
	framePtr = &done;

	/*
	 * Enter a standard Windows event loop until the flag changes. Note
	 * that we do not explicitly call Tcl_ServiceEvent().
	 */

	done = 0;
	while (!done) {
	    MSG msg;

	    if (!GetMessageW(&msg, NULL, 0, 0)) {
	    if (!GetMessage(&msg, NULL, 0, 0)) {
		/*
		 * The application is exiting, so repost the quit message and
		 * start unwinding.
		 */

		PostQuitMessage((int) msg.wParam);
		break;
	    }
	    TranslateMessage(&msg);
	    DispatchMessageW(&msg);
	    DispatchMessage(&msg);
	}
	(void) Tcl_SetServiceMode(oldMode);
	framePtr = oldFramePtr;
    } else {
	Tcl_AppendResult(interp, "bad option \"", Tcl_GetString(objv[1]),
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be done or wait", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
172
173
174
175
176
177
178
179

180
181
182
183
184
185
186
187

188
189
190
191
192
193
194
172
173
174
175
176
177
178

179
180
181
182
183
184
185
186

187
188
189
190
191
192
193
194







-
+







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestvolumetypeCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
#define VOL_BUF_SIZE 32
    int found;
    char volType[VOL_BUF_SIZE];
    const char *path;
    char *path;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?name?");
	return TCL_ERROR;
    }
    if (objc == 2) {
	/*
205
206
207
208
209
210
211
212

213
214
215
216
217
218
219
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219







-
+








    if (found == 0) {
	Tcl_AppendResult(interp, "could not get volume type for \"",
		(path?path:""), "\"", NULL);
	TclWinConvertError(GetLastError());
	return TCL_ERROR;
    }
    Tcl_AppendResult(interp, volType, NULL);
    Tcl_SetResult(interp, volType, TCL_VOLATILE);
    return TCL_OK;
#undef VOL_BUF_SIZE
}

/*
 *----------------------------------------------------------------------
 *
238
239
240
241
242
243
244
245

246
247
248
249
250
251
252
238
239
240
241
242
243
244

245
246
247
248
249
250
251
252







-
+







 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestwinclockCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Argument count */
    Tcl_Obj *const objv[])	/* Argument vector */
{
    static const FILETIME posixEpoch = { 0xD53E8000, 0x019DB1DE };
				/* The Posix epoch, expressed as a Windows
				 * FILETIME */
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
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







-
+

-
-
-
+
+
+











-
+







    t2.HighPart = sysTime.dwHighDateTime;
    t2.QuadPart -= t1.QuadPart;

    QueryPerformanceCounter(&p2);

    result = Tcl_NewObj();
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewWideIntObj(t2.QuadPart / 10000000));
	    Tcl_NewIntObj((int) (t2.QuadPart / 10000000)));
    Tcl_ListObjAppendElement(interp, result,
	    Tcl_NewWideIntObj((t2.QuadPart / 10) % 1000000));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(tclTime.sec));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(tclTime.usec));
	    Tcl_NewIntObj((int) ((t2.QuadPart / 10) % 1000000)));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.sec));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(tclTime.usec));

    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart));
    Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));

    Tcl_SetObjResult(interp, result);

    return TCL_OK;
}

static int
TestwinsleepCmd(
    TCL_UNUSED(ClientData),
    ClientData clientData,	/* Unused */
    Tcl_Interp* interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
{
    int ms;

    if (objc != 2) {
330
331
332
333
334
335
336
337

338
339
340
341
342

343
344
345
346
347
348
349
330
331
332
333
334
335
336

337
338
339
340
341

342
343
344
345
346
347
348
349







-
+




-
+







 *	This Tcl process closes, hard... Bang!
 *
 *----------------------------------------------------------------------
 */

static int
TestExceptionCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,			/* Unused */
    Tcl_Interp* interp,			/* Tcl interpreter */
    int objc,				/* Argument count */
    Tcl_Obj *const objv[])		/* Argument vector */
{
    static const char *const cmds[] = {
    static const char *cmds[] = {
	"access_violation", "datatype_misalignment", "array_bounds",
	"float_denormal", "float_divbyzero", "float_inexact",
	"float_invalidop", "float_overflow", "float_stack", "float_underflow",
	"int_divbyzero", "int_overflow", "private_instruction", "inpageerror",
	"illegal_instruction", "noncontinue", "stack_overflow",
	"invalid_disp", "guard_page", "invalid_handle", "ctrl+c",
	NULL
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
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
524
525
526
527
528

529
530
531
532
533
534
535
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
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
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

611
612
613
614
615
616
617
618

619
620
621
622
623
624
625
626
627
628

629
630
631
632
633
634
635
636







+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+



-
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+












-
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+





-
+





-
+
+


-
+















-
+






-
-
+
+










-
-
-
+
+
+





-
+






-
+









-
-
+
+





-
+







-
+









-
+







     * main() where the process will now be terminated with this exception
     * code by the default handler the C run-time provides.
     */

    /* SMASH! */
    RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);

    /* NOTREACHED */
    return TCL_OK;
}

static int
TestplatformChmod(
    const char *nativePath,
    int pmode)
{
    typedef DWORD (WINAPI *getSidLengthRequiredDef)(UCHAR);
    typedef BOOL (WINAPI *initializeSidDef)(PSID, PSID_IDENTIFIER_AUTHORITY,
	    BYTE);
    typedef PDWORD (WINAPI *getSidSubAuthorityDef)(PSID, DWORD);
    typedef DWORD (WINAPI *setNamedSecurityInfoADef)(IN LPSTR,
	    IN SE_OBJECT_TYPE, IN SECURITY_INFORMATION, IN PSID, IN PSID,
	    IN PACL, IN PACL);
    typedef BOOL (WINAPI *getAceDef)(PACL, DWORD, LPVOID *);
    typedef BOOL (WINAPI *addAceDef)(PACL, DWORD, DWORD, LPVOID, DWORD);
    typedef BOOL (WINAPI *equalSidDef)(PSID, PSID);
    typedef BOOL (WINAPI *addAccessDeniedAceDef)(PACL, DWORD, DWORD, PSID);
    typedef BOOL (WINAPI *initializeAclDef)(PACL, DWORD, DWORD);
    typedef DWORD (WINAPI *getLengthSidDef)(PSID);
    typedef BOOL (WINAPI *getAclInformationDef)(PACL, LPVOID, DWORD,
	    ACL_INFORMATION_CLASS);
    typedef BOOL (WINAPI *getSecurityDescriptorDaclDef)(PSECURITY_DESCRIPTOR,
	    LPBOOL, PACL *, LPBOOL);
    typedef BOOL (WINAPI *lookupAccountNameADef)(LPCSTR, LPCSTR, PSID,
	    PDWORD, LPSTR, LPDWORD, PSID_NAME_USE);
    typedef BOOL (WINAPI *getFileSecurityADef)(LPCSTR, SECURITY_INFORMATION,
	    PSECURITY_DESCRIPTOR, DWORD, LPDWORD);

    static const SECURITY_INFORMATION infoBits = OWNER_SECURITY_INFORMATION
	    | GROUP_SECURITY_INFORMATION | DACL_SECURITY_INFORMATION;
    /* don't reset change permissions mask (WRITE_DAC, allow test-cases restore it to cleanup) */
    /* don't deny DELETE mask (reset writable only, allow test-cases cleanup) */
    static const DWORD readOnlyMask = FILE_DELETE_CHILD | FILE_ADD_FILE
	    | FILE_ADD_SUBDIRECTORY | FILE_WRITE_EA | FILE_APPEND_DATA
	    | FILE_WRITE_DATA
	    | DELETE;
	    /* | DELETE */;

    /*
     * References to security functions (only available on NT and later).
     */

    static getSidLengthRequiredDef getSidLengthRequiredProc;
    static initializeSidDef initializeSidProc;
    static getSidSubAuthorityDef getSidSubAuthorityProc;
    static setNamedSecurityInfoADef setNamedSecurityInfoProc;
    static getAceDef getAceProc;
    static addAceDef addAceProc;
    static equalSidDef equalSidProc;
    static addAccessDeniedAceDef addAccessDeniedAceProc;
    static initializeAclDef initializeAclProc;
    static getLengthSidDef getLengthSidProc;
    static getAclInformationDef getAclInformationProc;
    static getSecurityDescriptorDaclDef getSecurityDescriptorDaclProc;
    static lookupAccountNameADef lookupAccountNameProc;
    static getFileSecurityADef getFileSecurityProc;
    static int initialized = 0;

    const BOOL set_readOnly = !(pmode & 0222);
    BOOL acl_readOnly_found = FALSE, curAclPresent, curAclDefaulted;
    SID_IDENTIFIER_AUTHORITY userSidAuthority = {
	SECURITY_WORLD_SID_AUTHORITY
    };
    BYTE *secDesc = 0;
    DWORD secDescLen, attr, newAclSize;
    ACL_SIZE_INFORMATION ACLSize;
    PACL curAcl, newAcl = 0;
    WORD j;
    SID *userSid = 0;
    char *userDomain = 0;
    TCHAR *userDomain = 0;
    int res = 0;

    /*
     * One time initialization, dynamically load Windows NT features
     */

    if (!initialized) {
	TCL_DECLARE_MUTEX(initializeMutex)
	Tcl_MutexLock(&initializeMutex);
	if (!initialized) {
	    HMODULE handle = GetModuleHandle(TEXT("ADVAPI32"));
	    if (handle == NULL) {
	    	handle = GetModuleHandle(TEXT("ADVAPI"));
	    }

	    if (handle != NULL) {
		setNamedSecurityInfoProc = (setNamedSecurityInfoADef)
			GetProcAddress(handle, "SetNamedSecurityInfoA");
		getFileSecurityProc = (getFileSecurityADef)
			GetProcAddress(handle, "GetFileSecurityA");
		getAceProc = (getAceDef)
			GetProcAddress(handle, "GetAce");
		addAceProc = (addAceDef)
			GetProcAddress(handle, "AddAce");
		equalSidProc = (equalSidDef)
			GetProcAddress(handle, "EqualSid");
		addAccessDeniedAceProc = (addAccessDeniedAceDef)
			GetProcAddress(handle, "AddAccessDeniedAce");
		initializeAclProc = (initializeAclDef)
			GetProcAddress(handle, "InitializeAcl");
		getLengthSidProc = (getLengthSidDef)
			GetProcAddress(handle, "GetLengthSid");
		getAclInformationProc = (getAclInformationDef)
			GetProcAddress(handle, "GetAclInformation");
		getSecurityDescriptorDaclProc = (getSecurityDescriptorDaclDef)
			GetProcAddress(handle, "GetSecurityDescriptorDacl");
		lookupAccountNameProc = (lookupAccountNameADef)
			GetProcAddress(handle, "LookupAccountNameA");
		getSidLengthRequiredProc = (getSidLengthRequiredDef)
			GetProcAddress(handle, "GetSidLengthRequired");
		initializeSidProc = (initializeSidDef)
			GetProcAddress(handle, "InitializeSid");
		getSidSubAuthorityProc = (getSidSubAuthorityDef)
			GetProcAddress(handle, "GetSidSubAuthority");

		if (setNamedSecurityInfoProc && getAceProc && addAceProc
			&& equalSidProc && addAccessDeniedAceProc
			&& initializeAclProc && getLengthSidProc
			&& getAclInformationProc
			&& getSecurityDescriptorDaclProc
			&& lookupAccountNameProc && getFileSecurityProc
			&& getSidLengthRequiredProc && initializeSidProc
			&& getSidSubAuthorityProc) {
		    initialized = 1;
		}
	    }
	    if (!initialized) {
		initialized = -1;
	    }
	}
	Tcl_MutexUnlock(&initializeMutex);
    }

    /*
     * Process the chmod request.
     */

    attr = GetFileAttributesA(nativePath);
    attr = GetFileAttributes(nativePath);

    /*
     * nativePath not found
     */

    if (attr == 0xFFFFFFFF) {
    if (attr == 0xffffffff) {
	res = -1;
	goto done;
    }

    /*
     * If nativePath is not a directory, there is no special handling.
     * If no ACL API is present or nativePath is not a directory, there is no
     * special handling.
     */

    if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
    if (initialized < 0 || !(attr & FILE_ATTRIBUTE_DIRECTORY)) {
	goto done;
    }

    /*
     * Set the result to error, if the ACL change is successful it will be
     * reset to 0.
     */

    res = -1;

    /*
     * Read the security descriptor for the directory. Note the first call
     * obtains the size of the security descriptor.
     */

    if (!GetFileSecurityA(nativePath, infoBits, NULL, 0, &secDescLen)) {
    if (!getFileSecurityProc(nativePath, infoBits, NULL, 0, &secDescLen)) {
	DWORD secDescLen2 = 0;

	if (GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
	    goto done;
	}

	secDesc = (BYTE *)Tcl_Alloc(secDescLen);
	if (!GetFileSecurityA(nativePath, infoBits,
	secDesc = (BYTE *) ckalloc(secDescLen);
	if (!getFileSecurityProc(nativePath, infoBits,
		(PSECURITY_DESCRIPTOR) secDesc, secDescLen, &secDescLen2)
		|| (secDescLen < secDescLen2)) {
	    goto done;
	}
    }

    /*
     * Get the World SID.
     */

    userSid = (SID *)Tcl_Alloc(GetSidLengthRequired((UCHAR) 1));
    InitializeSid(userSid, &userSidAuthority, (BYTE) 1);
    *(GetSidSubAuthority(userSid, 0)) = SECURITY_WORLD_RID;
    userSid = (SID *) ckalloc(getSidLengthRequiredProc((UCHAR) 1));
    initializeSidProc(userSid, &userSidAuthority, (BYTE) 1);
    *(getSidSubAuthorityProc(userSid, 0)) = SECURITY_WORLD_RID;

    /*
     * If curAclPresent == false then curAcl and curAclDefaulted not valid.
     */

    if (!GetSecurityDescriptorDacl((PSECURITY_DESCRIPTOR) secDesc,
    if (!getSecurityDescriptorDaclProc((PSECURITY_DESCRIPTOR) secDesc,
	    &curAclPresent, &curAcl, &curAclDefaulted)) {
	goto done;
    }
    if (!curAclPresent || !curAcl) {
	ACLSize.AclBytesInUse = 0;
	ACLSize.AceCount = 0;
    } else if (!GetAclInformation(curAcl, &ACLSize, sizeof(ACLSize),
    } else if (!getAclInformationProc(curAcl, &ACLSize, sizeof(ACLSize),
	    AclSizeInformation)) {
	goto done;
    }

    /*
     * Allocate memory for the new ACL.
     */

    newAclSize = ACLSize.AclBytesInUse + sizeof(ACCESS_DENIED_ACE)
	    + GetLengthSid(userSid) - sizeof(DWORD);
    newAcl = (PACL) Tcl_Alloc(newAclSize);
	    + getLengthSidProc(userSid) - sizeof(DWORD);
    newAcl = (ACL *) ckalloc(newAclSize);

    /*
     * Initialize the new ACL.
     */

    if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
    if (!initializeAclProc(newAcl, newAclSize, ACL_REVISION)) {
	goto done;
    }

    /*
     * Add denied to make readonly, this will be known as a "read-only tag".
     */

    if (set_readOnly && !AddAccessDeniedAce(newAcl, ACL_REVISION,
    if (set_readOnly && !addAccessDeniedAceProc(newAcl, ACL_REVISION,
	    readOnlyMask, userSid)) {
	goto done;
    }

    acl_readOnly_found = FALSE;
    for (j = 0; j < ACLSize.AceCount; j++) {
	LPVOID pACE2;
	ACE_HEADER *phACE2;

	if (!GetAce(curAcl, j, &pACE2)) {
	if (!getAceProc(curAcl, j, &pACE2)) {
	    goto done;
	}

	phACE2 = (ACE_HEADER *) pACE2;

	/*
	 * Do NOT propagate inherited ACEs.
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
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
686
687

688
689
690

691
692
693
694
695
696
697
698







-
+









-
+










-
+








-
+


-
+


-
+


-
+







	 * being removed).
	 */

	if (phACE2->AceType == ACCESS_DENIED_ACE_TYPE) {
	    ACCESS_DENIED_ACE *pACEd = (ACCESS_DENIED_ACE *) phACE2;

	    if (pACEd->Mask == readOnlyMask
		    && EqualSid(userSid, (PSID) &pACEd->SidStart)) {
		    && equalSidProc(userSid, (PSID) &pACEd->SidStart)) {
		acl_readOnly_found = TRUE;
		continue;
	    }
	}

	/*
	 * Copy the current ACE from the old to the new ACL.
	 */

	if (!AddAce(newAcl, ACL_REVISION, MAXDWORD, (PACL *) pACE2,
	if (!addAceProc(newAcl, ACL_REVISION, MAXDWORD, (PACL *)pACE2,
		((PACE_HEADER) pACE2)->AceSize)) {
	    goto done;
	}
    }

    /*
     * Apply the new ACL. Note PROTECTED_DACL_SECURITY_INFORMATION can be used
     * to remove inherited ACL (we need to overwrite the default ACL's in this case)
     */

    if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
    if (set_readOnly == acl_readOnly_found || setNamedSecurityInfoProc(
	    (LPSTR) nativePath, SE_FILE_OBJECT,
	    DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
	    NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
	res = 0;
    }

  done:
    if (secDesc) {
	Tcl_Free(secDesc);
	ckfree((char *) secDesc);
    }
    if (newAcl) {
	Tcl_Free(newAcl);
	ckfree((char *) newAcl);
    }
    if (userSid) {
	Tcl_Free(userSid);
	ckfree((char *) userSid);
    }
    if (userDomain) {
	Tcl_Free(userDomain);
	ckfree(userDomain);
    }

    if (res != 0) {
	return res;
    }

    /*
618
619
620
621
622
623
624
625

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
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







-
+

-
-
+
+


+

-
-
+
+
+
+



-
-
+
+
+


-
+



-
+







 *	Changes permissions of specified files.
 *
 *---------------------------------------------------------------------------
 */

static int
TestchmodCmd(
    TCL_UNUSED(ClientData),
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Parameter count */
    Tcl_Obj *const * objv)	/* Parameter vector */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int i, mode;
    char *rest;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
    if (argc < 2) {
    usage:
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" mode file ?file ...?", NULL);
	return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[1], &mode) != TCL_OK) {
	return TCL_ERROR;
    mode = (int) strtol(argv[1], &rest, 8);
    if ((rest == argv[1]) || (*rest != '\0')) {
	goto usage;
    }

    for (i = 2; i < objc; i++) {
    for (i = 2; i < argc; i++) {
	Tcl_DString buffer;
	const char *translated;

	translated = Tcl_TranslateFileName(interp, Tcl_GetString(objv[i]), &buffer);
	translated = Tcl_TranslateFileName(interp, argv[i], &buffer);
	if (translated == NULL) {
	    return TCL_ERROR;
	}
	if (TestplatformChmod(translated, mode) != 0) {
	    Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
		    NULL);
	    return TCL_ERROR;

Changes to win/tclWinThrd.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14


15
16
17
18
19
20
21
22
23
24
25

26
27
28
29
30




31

32
33

34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51
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







-






+
+










-
+



-
-
+
+
+
+

+

-
+










-
+







/*
 * tclWinThread.c --
 *
 *	This file implements the Windows-specific thread operations.
 *
 * Copyright (c) 1998 by Sun Microsystems, Inc.
 * Copyright (c) 1999 by Scriptics Corporation
 * Copyright (c) 2008 by George Peter Staplin
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"

#include <float.h>

/* Workaround for mingw versions which don't provide this in float.h */
#ifndef _MCW_EM
#   define	_MCW_EM		0x0008001F	/* Error masks */
#   define	_MCW_RC		0x00000300	/* Rounding */
#   define	_MCW_PC		0x00030000	/* Precision */
_CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask);
#endif

/*
 * This is the global lock used to serialize access to other serialization
 * This is the master lock used to serialize access to other serialization
 * data structures.
 */

static CRITICAL_SECTION globalLock;
static int initialized = 0;
static CRITICAL_SECTION masterLock;
static int init = 0;
#define MASTER_LOCK TclpMasterLock()
#define MASTER_UNLOCK TclpMasterUnlock()


/*
 * This is the global lock used to serialize initialization and finalization
 * This is the master lock used to serialize initialization and finalization
 * of Tcl as a whole.
 */

static CRITICAL_SECTION initLock;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */

#if TCL_THREADS
#ifdef TCL_THREADS

static struct Tcl_Mutex_ {
    CRITICAL_SECTION crit;
} allocLock;
static Tcl_Mutex allocLockPtr = &allocLock;
static int allocOnce = 0;

72
73
74
75
76
77
78
79

80
81
82
83
84
85
86
76
77
78
79
80
81
82

83
84
85
86
87
88
89
90







-
+







 * Condition Variable implementation.
 */

/*
 * The per-thread event and queue pointers.
 */

#if TCL_THREADS
#ifdef TCL_THREADS

typedef struct ThreadSpecificData {
    HANDLE condEvent;			/* Per-thread condition event */
    struct ThreadSpecificData *nextPtr;	/* Queue pointers */
    struct ThreadSpecificData *prevPtr;
    int flags;				/* See flags below */
} ThreadSpecificData;
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
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







-
+











+


-
+










-
+







#define WIN_THREAD_BLOCKED	0x2

/*
 * The per condition queue pointers and the Mutex used to serialize access to
 * the queue.
 */

typedef struct {
typedef struct WinCondition {
    CRITICAL_SECTION condLock;	/* Lock to serialize queuing on the
				 * condition. */
    struct ThreadSpecificData *firstPtr;	/* Queue pointers */
    struct ThreadSpecificData *lastPtr;
} WinCondition;

/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static int once;
static DWORD tlsKey;

typedef struct {
typedef struct allocMutex {
    Tcl_Mutex	     tlock;
    CRITICAL_SECTION wlock;
} allocMutex;
#endif /* USE_THREAD_ALLOC */

/*
 * The per thread data passed from TclpThreadCreate
 * to TclWinThreadStart.
 */

typedef struct {
typedef struct WinThread {
  LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */
  LPVOID lpParameter;		/* Original startup data */
  unsigned int fpControl;	/* Floating point control word from the
				 * main thread */
} WinThread;


174
175
176
177
178
179
180
181

182
183
184
185
186
187
188
179
180
181
182
183
184
185

186
187
188
189
190
191
192
193







-
+







	    | _MCW_PC
#endif
    );

    lpOrigStartAddress = winThreadPtr->lpStartAddress;
    lpOrigParameter = winThreadPtr->lpParameter;

    Tcl_Free(winThreadPtr);
    ckfree((char *)winThreadPtr);
    return lpOrigStartAddress(lpOrigParameter);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
198
199
200
201
202
203
204
205

206
207

208
209
210
211
212
213
214

215
216
217
218
219
220
221
203
204
205
206
207
208
209

210
211

212
213
214
215
216
217
218

219
220
221
222
223
224
225
226







-
+

-
+






-
+







 *
 *----------------------------------------------------------------------
 */

int
TclpThreadCreate(
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread. */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread. */
    Tcl_ThreadCreateProc proc,	/* Main() function of the thread. */
    ClientData clientData,	/* The one argument to Main(). */
    size_t stackSize,		/* Size of stack for the new thread. */
    int stackSize,		/* Size of stack for the new thread. */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
    winThreadPtr = (WinThread *)ckalloc(sizeof(WinThread));
    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
    winThreadPtr->lpParameter = clientData;
    winThreadPtr->fpControl = _controlfp(0, 0);

    EnterCriticalSection(&joinLock);

    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
237
238
239
240
241
242
243
244

245
246
247
248
249
250
251
242
243
244
245
246
247
248

249
250
251
252
253
254
255
256







-
+







    } else {
	if (flags & TCL_THREAD_JOINABLE) {
	    TclRememberJoinableThread(*idPtr);
	}

	/*
	 * The only purpose of this is to decrement the reference count so the
	 * OS resources will be reacquired when the thread closes.
	 * OS resources will be reaquired when the thread closes.
	 */

	CloseHandle(tHandle);
	LeaveCriticalSection(&joinLock);
	return TCL_OK;
    }
}
322
323
324
325
326
327
328
329

330
331
332
333
334
335
336
327
328
329
330
331
332
333

334
335
336
337
338
339
340
341







-
+







 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
    return (Tcl_ThreadId)(size_t)GetCurrentThreadId();
    return (Tcl_ThreadId) INT2PTR(GetCurrentThreadId());
}

/*
 *----------------------------------------------------------------------
 *
 * TclpInitLock
 *
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
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







-
+







-
+


-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpInitLock(void)
{
    if (!initialized) {
    if (!init) {
	/*
	 * There is a fundamental race here that is solved by creating the
	 * first Tcl interpreter in a single threaded environment. Once the
	 * interpreter has been created, it is safe to create more threads
	 * that create interpreters in parallel.
	 */

	initialized = 1;
	init = 1;
	InitializeCriticalSection(&joinLock);
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&globalLock);
	InitializeCriticalSection(&masterLock);
    }
    EnterCriticalSection(&initLock);
}

/*
 *----------------------------------------------------------------------
 *
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
450

451
452

453
454
455
456
457
458
459
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
450
451
452
453
454

455
456

457
458
459
460
461
462
463
464







-
+





-
+





-
+





-
+

-
+







-
+


-
+

-
+





-
+








-
+





-
+

-
+







{
    LeaveCriticalSection(&initLock);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGlobalLock
 * TclpMasterLock
 *
 *	This procedure is used to grab a lock that serializes creation of
 *	mutexes, condition variables, and thread local storage keys.
 *
 *	This lock must be different than the initLock because the initLock is
 *	held during creation of synchronization objects.
 *	held during creation of syncronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Acquire the global mutex.
 *	Acquire the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpGlobalLock(void)
TclpMasterLock(void)
{
    if (!initialized) {
    if (!init) {
	/*
	 * There is a fundamental race here that is solved by creating the
	 * first Tcl interpreter in a single threaded environment. Once the
	 * interpreter has been created, it is safe to create more threads
	 * that create interpreters in parallel.
	 */

	initialized = 1;
	init = 1;
	InitializeCriticalSection(&joinLock);
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&globalLock);
	InitializeCriticalSection(&masterLock);
    }
    EnterCriticalSection(&globalLock);
    EnterCriticalSection(&masterLock);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGlobalUnlock
 * TclpMasterUnlock
 *
 *	This procedure is used to release a lock that serializes creation and
 *	deletion of synchronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Release the global mutex.
 *	Release the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpGlobalUnlock(void)
TclpMasterUnlock(void)
{
    LeaveCriticalSection(&globalLock);
    LeaveCriticalSection(&masterLock);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAllocMutex
 *
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
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
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
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







-
+













-
+

















-
+






-
-
+
+

-
+















-
+
















-
+











-
+


-
+



-
+




-
+







 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
#ifdef TCL_THREADS
    if (!allocOnce) {
	InitializeCriticalSection(&allocLock.crit);
	allocOnce = 1;
    }
    return &allocLockPtr;
#else
    return NULL;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeLock
 * TclpFinalizeLock
 *
 *	This procedure is used to destroy all private resources used in this
 *	file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Destroys everything private. TclpInitLock must be held entering this
 *	function.
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLock(void)
{
    TclpGlobalLock();
    MASTER_LOCK;
    DeleteCriticalSection(&joinLock);

    /*
     * Destroy the critical section that we are holding!
     */

    DeleteCriticalSection(&globalLock);
    initialized = 0;
    DeleteCriticalSection(&masterLock);
    init = 0;

#if TCL_THREADS
#ifdef TCL_THREADS
    if (allocOnce) {
	DeleteCriticalSection(&allocLock.crit);
	allocOnce = 0;
    }
#endif

    LeaveCriticalSection(&initLock);

    /*
     * Destroy the critical section that we were holding.
     */

    DeleteCriticalSection(&initLock);
}

#if TCL_THREADS
#ifdef TCL_THREADS

/* locally used prototype */
static void		FinalizeConditionEvent(ClientData data);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This is a self initializing
 *	mutex that is automatically finalized during Tcl_Finalize.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is acquired when this returns.
 *	May block the current thread. The mutex is aquired when this returns.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* The lock */
{
    CRITICAL_SECTION *csPtr;

    if (*mutexPtr == NULL) {
	TclpGlobalLock();
	MASTER_LOCK;

	/*
	 * Double inside global lock check to avoid a race.
	 * Double inside master lock check to avoid a race.
	 */

	if (*mutexPtr == NULL) {
	    csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION));
	    csPtr = (CRITICAL_SECTION *) ckalloc(sizeof(CRITICAL_SECTION));
	    InitializeCriticalSection(csPtr);
	    *mutexPtr = (Tcl_Mutex)csPtr;
	    TclRememberMutex(mutexPtr);
	}
	TclpGlobalUnlock();
	MASTER_UNLOCK;
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
    EnterCriticalSection(csPtr);
}

/*
 *----------------------------------------------------------------------
625
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

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
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
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







-
+



















-
+










-
+














-
+






-
+






-
+




-
+

-
+


-
+
+




-
+






-
+






-
+







TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;

    if (csPtr != NULL) {
	DeleteCriticalSection(csPtr);
	Tcl_Free(csPtr);
	ckfree((char *) csPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait --
 *
 *	This procedure is invoked to wait on a condition variable. The mutex
 *	is atomically released as part of the wait, and automatically grabbed
 *	when the condition is signaled.
 *
 *	The mutex must be held when this procedure is called.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May block the current thread. The mutex is acquired when this returns.
 *	May block the current thread. The mutex is aquired when this returns.
 *	Will allocate memory for a HANDLE and initialize this the first time
 *	this Tcl_Condition is used.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionWait(
    Tcl_Condition *condPtr,	/* Really (WinCondition **) */
    Tcl_Mutex *mutexPtr,	/* Really (CRITICAL_SECTION **) */
    const Tcl_Time *timePtr) /* Timeout on waiting period */
    Tcl_Time *timePtr)		/* Timeout on waiting period */
{
    WinCondition *winCondPtr;	/* Per-condition queue head */
    CRITICAL_SECTION *csPtr;	/* Caller's Mutex, after casting */
    DWORD wtime;		/* Windows time value */
    int timeout;		/* True if we got a timeout */
    int doExit = 0;		/* True if we need to do exit setup */
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /*
     * Self initialize the two parts of the condition. The per-condition and
     * per-thread parts need to be handled independently.
     */

    if (tsdPtr->flags == WIN_THREAD_UNINIT) {
	TclpGlobalLock();
	MASTER_LOCK;

	/*
	 * Create the per-thread event and queue pointers.
	 */

	if (tsdPtr->flags == WIN_THREAD_UNINIT) {
	    tsdPtr->condEvent = CreateEventW(NULL, TRUE /* manual reset */,
	    tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */,
		    FALSE /* non signaled */, NULL);
	    tsdPtr->nextPtr = NULL;
	    tsdPtr->prevPtr = NULL;
	    tsdPtr->flags = WIN_THREAD_RUNNING;
	    doExit = 1;
	}
	TclpGlobalUnlock();
	MASTER_UNLOCK;

	if (doExit) {
	    /*
	     * Create a per-thread exit handler to clean up the condEvent. We
	     * must be careful to do this outside the Global Lock because
	     * must be careful to do this outside the Master Lock because
	     * Tcl_CreateThreadExitHandler uses its own ThreadSpecificData,
	     * and initializing that may drop back into the Global Lock.
	     * and initializing that may drop back into the Master Lock.
	     */

	    Tcl_CreateThreadExitHandler(FinalizeConditionEvent, tsdPtr);
	    Tcl_CreateThreadExitHandler(FinalizeConditionEvent,
		    (ClientData) tsdPtr);
	}
    }

    if (*condPtr == NULL) {
	TclpGlobalLock();
	MASTER_LOCK;

	/*
	 * Initialize the per-condition queue pointers and Mutex.
	 */

	if (*condPtr == NULL) {
	    winCondPtr = (WinCondition *)Tcl_Alloc(sizeof(WinCondition));
	    winCondPtr = (WinCondition *) ckalloc(sizeof(WinCondition));
	    InitializeCriticalSection(&winCondPtr->condLock);
	    winCondPtr->firstPtr = NULL;
	    winCondPtr->lastPtr = NULL;
	    *condPtr = (Tcl_Condition) winCondPtr;
	    TclRememberCondition(condPtr);
	}
	TclpGlobalUnlock();
	MASTER_UNLOCK;
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
    winCondPtr = *((WinCondition **)condPtr);
    if (timePtr == NULL) {
	wtime = INFINITE;
    } else {
	wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
756
757
758
759
760
761
762
763
764

765
766
767
768
769
770
771
762
763
764
765
766
767
768


769
770
771
772
773
774
775
776







-
-
+







     */

    LeaveCriticalSection(csPtr);
    timeout = 0;
    while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
	ResetEvent(tsdPtr->condEvent);
	LeaveCriticalSection(&winCondPtr->condLock);
	if (WaitForSingleObjectEx(tsdPtr->condEvent, wtime,
		TRUE) == WAIT_TIMEOUT) {
	if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) {
	    timeout = 1;
	}
	EnterCriticalSection(&winCondPtr->condLock);
    }

    /*
     * Be careful on timeouts because the signal might arrive right around the
892
893
894
895
896
897
898
899

900
901
902
903
904
905
906
897
898
899
900
901
902
903

904
905
906
907
908
909
910
911







-
+







 *----------------------------------------------------------------------
 *
 * TclpFinalizeCondition --
 *
 *	This procedure is invoked to clean up a condition variable. This is
 *	only safe to call at the end of time.
 *
 *	This assumes the Global Lock is held.
 *	This assumes the Master Lock is held.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The condition variable is deallocated.
 *
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
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







-
+















-
+

-
+







     * The per-thread condition waiting event is reclaimed earlier in a
     * per-thread exit handler, which is called before thread local storage is
     * reclaimed.
     */

    if (winCondPtr != NULL) {
	DeleteCriticalSection(&winCondPtr->condLock);
	Tcl_Free(winCondPtr);
	ckfree((char *) winCondPtr);
	*condPtr = NULL;
    }
}




/*
 * Additions by AOL for specialized thread memory allocator.
 */
#ifdef USE_THREAD_ALLOC

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    allocMutex *lockPtr;
    struct allocMutex *lockPtr;

    lockPtr = (allocMutex *)malloc(sizeof(allocMutex));
    lockPtr = malloc(sizeof(struct allocMutex));
    if (lockPtr == NULL) {
	Tcl_Panic("could not allocate lock");
    }
    lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
    InitializeCriticalSection(&lockPtr->wlock);
    return &lockPtr->tlock;
}
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
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







-
-
+
+

+
+
+
-
-
-
-
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+

-
-
-
-







    if (!lockPtr) {
	return;
    }
    DeleteCriticalSection(&lockPtr->wlock);
    free(lockPtr);
}

void
TclpInitAllocCache(void)
void *
TclpGetAllocCache(void)
{
    VOID *result;

    if (!once) {
    /*
     * We need to make sure that TclpFreeAllocCache is called on each
     * thread that calls this, but only on threads that call this.
     */
	/*
	 * We need to make sure that TclpFreeAllocCache is called on each
	 * thread that calls this, but only on threads that call this.
	 */

    tlsKey = TlsAlloc();
    if (tlsKey == TLS_OUT_OF_INDEXES) {
	Tcl_Panic("could not allocate thread local storage");
    }
}
	tlsKey = TlsAlloc();
	once = 1;
	if (tlsKey == TLS_OUT_OF_INDEXES) {
	    Tcl_Panic("could not allocate thread local storage");
	}
    }

void *
TclpGetAllocCache(void)
{
    void *result;
    result = TlsGetValue(tlsKey);
    if ((result == NULL) && (GetLastError() != NO_ERROR)) {
	Tcl_Panic("TlsGetValue failed from TclpGetAllocCache");
    }
    return result;
}

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
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
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







-
+
-
-
+
-







-
+









-
-
-
-
-
+
+
-
-
-
+
-
-
+
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









TclpFreeAllocCache(
    void *ptr)
{
    BOOL success;

    if (ptr != NULL) {
	/*
	 * Called by TclFinalizeThreadAlloc() and
	 * Called by us in TclpFinalizeThreadData when a thread exits and
	 * TclFinalizeThreadAllocThread() during Tcl_Finalize() or
	 * Tcl_FinalizeThread(). This function destroys the tsd key which
	 * destroys the tsd key which stores allocator caches.
	 * stores allocator caches in thread local storage.
	 */

	TclFreeAllocCache(ptr);
	success = TlsSetValue(tlsKey, NULL);
	if (!success) {
	    Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache");
	}
    } else {
    } else if (once) {
	/*
	 * Called by us in TclFinalizeThreadAlloc() during the library
	 * finalization initiated from Tcl_Finalize()
	 */

	success = TlsFree(tlsKey);
	if (!success) {
	    Tcl_Panic("TlsFree failed from TclpFreeAllocCache");
	}
    }
}
#endif /* USE_THREAD_ALLOC */


	once = 0; /* reset for next time. */
    }
void *
TclpThreadCreateKey(void)
{

    DWORD *key;

}
    key = (DWORD *)TclpSysAlloc(sizeof *key);
    if (key == NULL) {
	Tcl_Panic("unable to allocate thread key!");
    }

#endif /* USE_THREAD_ALLOC */
    *key = TlsAlloc();

    if (*key == TLS_OUT_OF_INDEXES) {
	Tcl_Panic("unable to allocate thread-local storage");
    }

    return key;
}

void
TclpThreadDeleteKey(
    void *keyPtr)
{
    DWORD *key = (DWORD *)keyPtr;

    if (!TlsFree(*key)) {
	Tcl_Panic("unable to delete key");
    }

    TclpSysFree(keyPtr);
}

void
TclpThreadSetGlobalTSD(
    void *tsdKeyPtr,
    void *ptr)
{
    DWORD *key = (DWORD *)tsdKeyPtr;

    if (!TlsSetValue(*key, ptr)) {
	Tcl_Panic("unable to set global TSD value");
    }
}

void *
TclpThreadGetGlobalTSD(
    void *tsdKeyPtr)
{
    DWORD *key = (DWORD *)tsdKeyPtr;

    return TlsGetValue(*key);
}

#endif /* TCL_THREADS */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinTime.c.

8
9
10
11
12
13
14




15
16
17
18
19
20



















21
22
23
24
25

26
27
28
29
30
31
32
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







+
+
+
+






+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+







 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#define SECSPERDAY	(60L * 60L * 24L)
#define SECSPERYEAR	(SECSPERDAY * 365L)
#define SECSPER4YEAR	(SECSPERYEAR * 4L + SECSPERDAY)

/*
 * Number of samples over which to estimate the performance counter.
 */

#define SAMPLES		64

/*
 * The following arrays contain the day of year for the last day of each
 * month, where index 1 is January.
 */

static const int normalDays[] = {
    -1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
};

static const int leapDays[] = {
    -1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
};

typedef struct ThreadSpecificData {
    char tzName[64];		/* Time zone name */
    struct tm tm;		/* time information */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

/*
 * Data for managing high-resolution timers.
 */

typedef struct {
typedef struct TimeInfo {
    CRITICAL_SECTION cs;	/* Mutex guarding this structure. */
    int initialized;		/* Flag == 1 if this structure is
				 * initialized. */
    int perfCounterAvailable;	/* Flag == 1 if the hardware has a performance
				 * counter. */
    DWORD calibrationInterv;	/* Calibration interval in seconds (start 1 sec) */
    HANDLE calibrationThread;	/* Handle to the thread that keeps the virtual
69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
92
93
94
95
96
97
98

99
100
101
102
103
104
105
106







-
+







    { NULL, 0, 0, NULL, NULL, 0 },
    0,
    0,
    1,
    (HANDLE) NULL,
    (HANDLE) NULL,
    (HANDLE) NULL,
#if defined(HAVE_CAST_TO_UNION) && !defined(__cplusplus)
#ifdef HAVE_CAST_TO_UNION
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (ULARGE_INTEGER) (DWORDLONG) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
    (LARGE_INTEGER) (Tcl_WideInt) 0,
#else
    {0, 0},
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







-
+
+








+








/*
 * Scale to convert wide click values from the TclpGetWideClicks native
 * resolution to microsecond resolution and back.
 */
static struct {
    int initialized;		/* 1 if initialized, 0 otherwise */
    int perfCounter;		/* 1 if performance counter usable for wide clicks */
    int perfCounter;		/* 1 if performance counter usable for wide
				 * clicks */
    double microsecsScale;	/* Denominator scale between clock / microsecs */
} wideClick = {0, 0, 0.0};


/*
 * Declarations for functions defined later in this file.
 */

static struct tm *	ComputeGMT(const time_t *tp);
static void		StopCalibration(ClientData clientData);
static DWORD WINAPI	CalibrationThread(LPVOID arg);
static void 		UpdateTimeEachSecond(void);
static void		ResetCounterSamples(Tcl_WideUInt fileTime,
			    Tcl_WideInt perfCounter, Tcl_WideInt perfFreq);
static Tcl_WideInt	AccumulateSample(Tcl_WideInt perfCounter,
			    Tcl_WideUInt fileTime);
140
141
142
143
144
145
146
147

148
149
150
151
152
153
154
165
166
167
168
169
170
171

172
173
174
175
176
177
178
179







-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long
TclpGetSeconds(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
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
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







-
+








-
+









-
+







 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_WideUInt
unsigned long
TclpGetClicks(void)
{
    Tcl_WideInt usecSincePosixEpoch;

    /* Try to use high resolution timer */
    if ( tclGetTimeProcPtr == NativeGetTime
      && (usecSincePosixEpoch = NativeGetMicroseconds())
    ) {
	return (Tcl_WideUInt)usecSincePosixEpoch;
	return (unsigned long)usecSincePosixEpoch;
    } else {
	/*
	* Use the Tcl_GetTime abstraction to get the time in microseconds, as
	* nearly as we can, and return it.
	*/

	Tcl_Time now;		/* Current Tcl time */

	tclGetTimeProcPtr(&now, tclTimeClientData);	/* Tcl_GetTime inlined */
	return (Tcl_WideUInt)(now.sec * 1000000) + now.usec;
	return (unsigned long)(now.sec * 1000000) + now.usec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetWideClicks --
326
327
328
329
330
331
332





























333
334
335
336
337
338
339
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







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	return (((Tcl_WideInt)now.sec) * 1000000) + now.usec;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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.
381
382
383
384
385
386
387
388
389


390
391
392
393
394
395
396
435
436
437
438
439
440
441


442
443
444
445
446
447
448
449
450







-
-
+
+







 *	See above.
 *
 *----------------------------------------------------------------------
 */

static void
NativeScaleTime(
    TCL_UNUSED(Tcl_Time *),
    TCL_UNUSED(ClientData))
    Tcl_Time *timePtr,
    ClientData clientData)
{
    /*
     * Native scale is 1:1. Nothing is done.
     */
}

/*
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
490
491
492
493
494
495
496

497
498
499
500
501
502
503







-







     * Note: Outer check for 'initialized' is a performance win since it
     * avoids an extra mutex lock in the common case.
     */

    if (!timeInfo.initialized) {
	TclpInitLock();
	if (!timeInfo.initialized) {

	    timeInfo.posixEpoch.LowPart = 0xD53E8000;
	    timeInfo.posixEpoch.HighPart = 0x019DB1DE;

	    timeInfo.perfCounterAvailable =
		    QueryPerformanceFrequency(&timeInfo.nominalFreq);

	    /*
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
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







-
+



-
-
-
+
+
+





-
+
















-
-
+
+













-
+







		 * As an exception, if every logical processor on the system
		 * is on the same chip, we use the performance counter anyway,
		 * presuming that everyone's TSC is locked to the same
		 * oscillator.
		 */

		SYSTEM_INFO systemInfo;
		int regs[4];
		unsigned int regs[4];

		GetSystemInfo(&systemInfo);
		if (TclWinCPUID(0, regs) == TCL_OK
			&& regs[1] == 0x756E6547	/* "Genu" */
			&& regs[3] == 0x49656E69	/* "ineI" */
			&& regs[2] == 0x6C65746E	/* "ntel" */
			&& regs[1] == 0x756e6547	/* "Genu" */
			&& regs[3] == 0x49656e69	/* "ineI" */
			&& regs[2] == 0x6c65746e	/* "ntel" */
			&& TclWinCPUID(1, regs) == TCL_OK
			&& ((regs[0]&0x00000F00) == 0x00000F00 /* Pentium 4 */
			|| ((regs[0] & 0x00F00000)	/* Extended family */
			&& (regs[3] & 0x10000000)))	/* Hyperthread */
			&& (((regs[1]&0x00FF0000) >> 16)/* CPU count */
			    == (int)systemInfo.dwNumberOfProcessors)) {
			    == systemInfo.dwNumberOfProcessors)) {
		    timeInfo.perfCounterAvailable = TRUE;
		} else {
		    timeInfo.perfCounterAvailable = FALSE;
		}
	    }
#endif /* above code is Win32 only */

	    /*
	     * If the performance counter is available, start a thread to
	     * calibrate it.
	     */

	    if (timeInfo.perfCounterAvailable) {
		DWORD id;

		InitializeCriticalSection(&timeInfo.cs);
		timeInfo.readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL);
		timeInfo.exitEvent = CreateEventW(NULL, FALSE, FALSE, NULL);
		timeInfo.readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
		timeInfo.exitEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
		timeInfo.calibrationThread = CreateThread(NULL, 256,
			CalibrationThread, (LPVOID) NULL, 0, &id);
		SetThreadPriority(timeInfo.calibrationThread,
			THREAD_PRIORITY_HIGHEST);

		/*
		 * Wait for the thread just launched to start running, and
		 * create an exit handler that kills it so that it doesn't
		 * outlive unloading tclXX.dll
		 */

		WaitForSingleObject(timeInfo.readyEvent, INFINITE);
		CloseHandle(timeInfo.readyEvent);
		Tcl_CreateExitHandler(StopCalibration, NULL);
		Tcl_CreateExitHandler(StopCalibration, (ClientData) NULL);
	    }
	    timeInfo.initialized = TRUE;
	}
	TclpInitUnlock();
    }

    if (timeInfo.perfCounterAvailable && timeInfo.curCounterFreq.QuadPart!=0) {
567
568
569
570
571
572
573

574

575



576
577
578
579
580
581
582
620
621
622
623
624
625
626
627
628
629

630
631
632
633
634
635
636
637
638
639







+

+
-
+
+
+







	curCounterFreq = timeInfo.curCounterFreq.QuadPart;

	LeaveCriticalSection(&timeInfo.cs);

	/*
	 * If calibration cycle occurred after we get curCounter
	 */

	if (curCounter.QuadPart <= perfCounterLastCall) {
	    /*
	    /* Calibrated file-time is saved from posix in 100-ns ticks */
	     * Calibrated file-time is saved from posix in 100-ns ticks
	     */

	    return fileTimeLastCall / 10;
	}

	/*
	 * If it appears to be more than 1.1 seconds since the last trip
	 * through the calibration loop, the performance counter may have
	 * jumped forward. (See MSDN Knowledge Base article Q274323 for a
617
618
619
620
621
622
623
624

625
626
627
628
629
630
631
674
675
676
677
678
679
680

681
682
683
684
685
686
687
688







-
+







 *
 *----------------------------------------------------------------------
 */

static void
NativeGetTime(
    Tcl_Time *timePtr,
    TCL_UNUSED(ClientData))
    ClientData clientData)
{
    Tcl_WideInt usecSincePosixEpoch;

    /*
     * Try to use high resolution timer.
     */
    if ( (usecSincePosixEpoch = NativeGetMicroseconds()) ) {
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
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
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
1065
1066
1067







-
+












+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void TclWinResetTimerResolution(void);

static void
StopCalibration(
    TCL_UNUSED(ClientData))
    ClientData unused)		/* Client data is unused */
{
    SetEvent(timeInfo.exitEvent);

    /*
     * If Tcl_Finalize was called from DllMain, the calibration thread is in a
     * 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
 *	true, then the returned date will be in Greenwich Mean Time (GMT).
 *	Otherwise, it will be in the local time zone.
 *
 * Results:
 *	Returns a static tm structure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

struct tm *
TclpGetDate(
    CONST time_t *t,
    int useGMT)
{
    struct tm *tmPtr;
    time_t time;
#if defined(_WIN64) || (defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400))
#   define  t2 *t /* no need to cripple time to 32-bit */
#else
    time_t t2 = *(__time32_t *)t;
#endif

    if (!useGMT) {
#if defined(_MSC_VER) && (_MSC_VER >= 1900)
#	undef timezone /* prevent conflict with timezone() function */
	long timezone = 0;
#endif

	tzset();

	/*
	 * If we are in the valid range, let the C run-time library handle it.
	 * Otherwise we need to fake it. Note that this algorithm ignores
	 * daylight savings time before the epoch.
	 */

	/*
	 * Hm, Borland's localtime manages to return NULL under certain
	 * circumstances (e.g. wintime.test, test 1.2). Nobody tests for this,
	 * since 'localtime' isn't supposed to do this, possibly leading to
	 * crashes.
	 *
	 * Patch: We only call this function if we are at least one day into
	 * the epoch, else we handle it ourselves (like we do for times < 0).
	 * H. Giese, June 2003
	 */

#ifdef __BORLANDC__
#define LOCALTIME_VALIDITY_BOUNDARY	SECSPERDAY
#else
#define LOCALTIME_VALIDITY_BOUNDARY	0
#endif

	if (t2 >= LOCALTIME_VALIDITY_BOUNDARY) {
	    return TclpLocaltime(&t2);
	}

#if defined(_MSC_VER) && (_MSC_VER >= 1900)
	_get_timezone(&timezone);
#endif

	time = t2 - timezone;

	/*
	 * If we aren't near to overflowing the long, just add the bias and
	 * use the normal calculation. Otherwise we will need to adjust the
	 * result at the end.
	 */

	if (t2 < (LONG_MAX - 2*SECSPERDAY) && t2 > (LONG_MIN + 2*SECSPERDAY)) {
	    tmPtr = ComputeGMT(&time);
	} else {
	    tmPtr = ComputeGMT(&t2);

	    tzset();

	    /*
	     * Add the bias directly to the tm structure to avoid overflow.
	     * Propagate seconds overflow into minutes, hours and days.
	     */

	    time = tmPtr->tm_sec - timezone;
	    tmPtr->tm_sec = (int)(time % 60);
	    if (tmPtr->tm_sec < 0) {
		tmPtr->tm_sec += 60;
		time -= 60;
	    }

	    time = tmPtr->tm_min + time/60;
	    tmPtr->tm_min = (int)(time % 60);
	    if (tmPtr->tm_min < 0) {
		tmPtr->tm_min += 60;
		time -= 60;
	    }

	    time = tmPtr->tm_hour + time/60;
	    tmPtr->tm_hour = (int)(time % 24);
	    if (tmPtr->tm_hour < 0) {
		tmPtr->tm_hour += 24;
		time -= 24;
	    }

	    time /= 24;
	    tmPtr->tm_mday += (int)time;
	    tmPtr->tm_yday += (int)time;
	    tmPtr->tm_wday = (tmPtr->tm_wday + (int)time) % 7;
	}
    } else {
	tmPtr = ComputeGMT(&t2);
    }
    return tmPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ComputeGMT --
 *
 *	This function computes GMT given the number of seconds since the epoch
 *	(midnight Jan 1 1970).
 *
 * Results:
 *	Returns a (per thread) statically allocated struct tm.
 *
 * Side effects:
 *	Updates the values of the static struct tm.
 *
 *----------------------------------------------------------------------
 */

static struct tm *
ComputeGMT(
    const time_t *tp)
{
    struct tm *tmPtr;
    long tmp, rem;
    int isLeap;
    const int *days;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tmPtr = &tsdPtr->tm;

    /*
     * Compute the 4 year span containing the specified time.
     */

    tmp = (long)(*tp / SECSPER4YEAR);
    rem = (long)(*tp % SECSPER4YEAR);

    /*
     * Correct for weird mod semantics so the remainder is always positive.
     */

    if (rem < 0) {
	tmp--;
	rem += SECSPER4YEAR;
    }

    /*
     * Compute the year after 1900 by taking the 4 year span and adjusting for
     * the remainder. This works because 2000 is a leap year, and 1900/2100
     * are out of the range.
     */

    tmp = (tmp * 4) + 70;
    isLeap = 0;
    if (rem >= SECSPERYEAR) {			  /* 1971, etc. */
	tmp++;
	rem -= SECSPERYEAR;
	if (rem >= SECSPERYEAR) {		  /* 1972, etc. */
	    tmp++;
	    rem -= SECSPERYEAR;
	    if (rem >= SECSPERYEAR + SECSPERDAY) { /* 1973, etc. */
		tmp++;
		rem -= SECSPERYEAR + SECSPERDAY;
	    } else {
		isLeap = 1;
	    }
	}
    }
    tmPtr->tm_year = tmp;

    /*
     * Compute the day of year and leave the seconds in the current day in the
     * remainder.
     */

    tmPtr->tm_yday = rem / SECSPERDAY;
    rem %= SECSPERDAY;

    /*
     * Compute the time of day.
     */

    tmPtr->tm_hour = rem / 3600;
    rem %= 3600;
    tmPtr->tm_min = rem / 60;
    tmPtr->tm_sec = rem % 60;

    /*
     * Compute the month and day of month.
     */

    days = (isLeap) ? leapDays : normalDays;
    for (tmp = 1; days[tmp] < tmPtr->tm_yday; tmp++) {
	/* empty body */
    }
    tmPtr->tm_mon = --tmp;
    tmPtr->tm_mday = tmPtr->tm_yday - days[tmp];

    /*
     * Compute day of week.  Epoch started on a Thursday.
     */

    tmPtr->tm_wday = (long)(*tp / SECSPERDAY) + 4;
    if ((*tp % SECSPERDAY) < 0) {
	tmPtr->tm_wday--;
    }
    tmPtr->tm_wday %= 7;
    if (tmPtr->tm_wday < 0) {
	tmPtr->tm_wday += 7;
    }

    return tmPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * CalibrationThread --
 *
 *	Thread that manages calibration of the hi-resolution time derived from
704
705
706
707
708
709
710
711

712
713
714
715
716
717
718
1083
1084
1085
1086
1087
1088
1089

1090
1091
1092
1093
1094
1095
1096
1097







-
+







 * body of this procedure.
 *
 *----------------------------------------------------------------------
 */

static DWORD WINAPI
CalibrationThread(
    TCL_UNUSED(LPVOID))
    LPVOID arg)
{
    FILETIME curFileTime;
    DWORD waitResult;

    /*
     * Get initial system time and performance counter.
     */
778
779
780
781
782
783
784
785


786
787
788
789
790
791
792
1157
1158
1159
1160
1161
1162
1163

1164
1165
1166
1167
1168
1169
1170
1171
1172







-
+
+







static void
UpdateTimeEachSecond(void)
{
    LARGE_INTEGER curPerfCounter;
				/* Current value returned from
				 * QueryPerformanceCounter. */
    FILETIME curSysTime;	/* Current system time. */
    static LARGE_INTEGER lastFileTime; /* File time of the previous calibration */
    static LARGE_INTEGER lastFileTime;
				/* File time of the previous calibration */
    LARGE_INTEGER curFileTime;	/* File time at the time this callback was
				 * scheduled. */
    Tcl_WideInt estFreq;	/* Estimated perf counter frequency. */
    Tcl_WideInt vt0;		/* Tcl time right now. */
    Tcl_WideInt vt1;		/* Tcl time one second from now. */
    Tcl_WideInt tdiff;		/* Difference between system clock and Tcl
				 * time. */
837
838
839
840
841
842
843
844

845
846
847
848
849
850
851
1217
1218
1219
1220
1221
1222
1223

1224
1225
1226
1227
1228
1229
1230
1231







-
+







     * frequency (not the actual, because the actual has probably run slow in
     * the first case). Our estimated frequency will be the nominal frequency.
     *
     * Store the current sample into the circular buffer of samples, and
     * estimate the performance counter frequency.
     */

    estFreq = AccumulateSample(curPerfCounter.QuadPart,
     estFreq = AccumulateSample(curPerfCounter.QuadPart,
	    (Tcl_WideUInt) curFileTime.QuadPart);

    /*
     * We want to adjust things so that time appears to be continuous.
     * Virtual file time, right now, is
     *
     * vt0 = 10000000 * (curPerfCounter - perfCounterLastCall)
1063
1064
1065
1066
1067
1068
1069






































































1070
1071
1072
1073
1074
1075
1076
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







	if (++timeInfo.sampleNo >= SAMPLES) {
	    timeInfo.sampleNo = 0;
	}

	return estFreq;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGmtime --
 *
 *	Wrapper around the 'gmtime' library function to make it thread safe.
 *
 * Results:
 *	Returns a pointer to a 'struct tm' in thread-specific data.
 *
 * Side effects:
 *	Invokes gmtime or gmtime_r as appropriate.
 *
 *----------------------------------------------------------------------
 */

struct tm *
TclpGmtime(
    CONST time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */
{
    /*
     * The MS implementation of gmtime is thread safe because it returns the
     * time in a block of thread-local storage, and Windows does not provide a
     * Posix gmtime_r function.
     */

#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)
    return gmtime(timePtr);
#else
    return _gmtime32((CONST __time32_t *)timePtr);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * TclpLocaltime --
 *
 *	Wrapper around the 'localtime' library function to make it thread
 *	safe.
 *
 * Results:
 *	Returns a pointer to a 'struct tm' in thread-specific data.
 *
 * Side effects:
 *	Invokes localtime or localtime_r as appropriate.
 *
 *----------------------------------------------------------------------
 */

struct tm *
TclpLocaltime(
    CONST time_t *timePtr)	/* Pointer to the number of seconds since the
				 * local system's epoch */

{
    /*
     * The MS implementation of localtime is thread safe because it returns
     * the time in a block of thread-local storage, and Windows does not
     * provide a Posix localtime_r function.
     */

#if defined(_WIN64) || defined(_USE_64BIT_TIME_T) || (defined(_MSC_VER) && _MSC_VER < 1400)
    return localtime(timePtr);
#else
    return _localtime32((CONST __time32_t *)timePtr);
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimeProc --
 *
 *	TIP #233 (Virtualized Time): Registers two handlers for the

Deleted win/tclooConfig.sh.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# tclooConfig.sh --
#
# This shell script (for sh) is generated automatically by TclOO's configure
# script, or would be except it has no values that we substitute. It will
# create shell variables for most of the configuration options discovered by
# the configure script. This script is intended to be included by TEA-based
# configure scripts for TclOO extensions so that they don't have to figure
# this all out for themselves.
#
# The information in this file is specific to a single platform.

# These are mostly empty because no special steps are ever needed from Tcl 8.6
# onwards; all libraries and include files are just part of Tcl.
TCLOO_LIB_SPEC=""
TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
TCLOO_VERSION=1.2.0

Changes to win/tclsh.ico.

cannot compute difference between binary files

Changes to win/tclsh.rc.

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
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










+
+
+
+
+
+












-
+







//
// Version Resource Script
//

#include <winver.h>
#include <tcl.h>

//
// build-up the name suffix that defines the type of build this is.
//
#if TCL_THREADS
#define SUFFIX_THREADS	    "t"
#else
#define SUFFIX_THREADS	    ""
#endif

#if STATIC_BUILD
#define SUFFIX_STATIC	    "s"
#else
#define SUFFIX_STATIC	    ""
#endif

#if DEBUG && !UNCHECKED
#define SUFFIX_DEBUG	    "g"
#else
#define SUFFIX_DEBUG	    ""
#endif

#define SUFFIX		    SUFFIX_STATIC SUFFIX_DEBUG
#define SUFFIX		    SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG


LANGUAGE 0x9, 0x1	/* LANG_ENGLISH, SUBLANG_DEFAULT */

VS_VERSION_INFO VERSIONINFO
 FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
 PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL